From a156735ca2593fa67ab17580a5cb932792249213 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 17 May 2018 16:10:59 -0600 Subject: [PATCH] 'CAM6 initial release Imported from https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk@89219 Committed by Cheryl Craig at 2018-05-17 16:10:59 -0600 Original svn commit message: CAM6 initial release' --- .config_files.xml | 30 + .gitignore | 20 + CODE_OF_CONDUCT.md | 49 + Externals.cfg | 60 + Externals_CAM.cfg | 31 + README.md | 9 + README_EXTERNALS | 49 + bld/Makefile.in | 1145 + bld/build-namelist | 4821 + bld/config_files/definition.xml | 314 + bld/config_files/definition.xsl | 37 + bld/config_files/horiz_grid.xml | 50 + bld/configure | 3666 + bld/mkDepends | 449 + bld/mkSrcfiles | 128 + bld/namelist_files/master_aer_drydep_list.xml | 92 + bld/namelist_files/master_aer_wetdep_list.xml | 93 + bld/namelist_files/master_gas_drydep_list.xml | 103 + bld/namelist_files/master_gas_wetdep_list.xml | 84 + bld/namelist_files/namelist_defaults_cam.xml | 1948 + bld/namelist_files/namelist_definition.xml | 7329 + .../use_cases/1850-2005_cam5.xml | 91 + bld/namelist_files/use_cases/1850_cam4.xml | 57 + bld/namelist_files/use_cases/1850_cam6.xml | 62 + .../1950-2010_ccmi_refc1_waccmx_ma.xml | 174 + .../use_cases/2000_cam4_trop_chem.xml | 74 + bld/namelist_files/use_cases/2000_cam6.xml | 68 + .../use_cases/2000_trop_strat_vbs_cam6.xml | 271 + bld/namelist_files/use_cases/2010_cam6.xml | 48 + .../use_cases/2010_trop_strat_vbs_cam6.xml | 271 + .../use_cases/aquaplanet_cam3.xml | 81 + .../use_cases/aquaplanet_cam4.xml | 48 + .../use_cases/aquaplanet_cam5.xml | 53 + .../use_cases/aquaplanet_cam6.xml | 52 + bld/namelist_files/use_cases/dabi_p2004.xml | 40 + .../use_cases/dctest_baro_kessler.xml | 26 + .../use_cases/dctest_baro_moist.xml | 26 + .../use_cases/held_suarez_1994.xml | 26 + bld/namelist_files/use_cases/hist_cam6.xml | 31 + .../use_cases/hist_trop_strat_vbs_cam6.xml | 170 + bld/namelist_files/use_cases/scam_arm95.xml | 22 + bld/namelist_files/use_cases/scam_arm97.xml | 22 + bld/namelist_files/use_cases/scam_gateIII.xml | 20 + bld/namelist_files/use_cases/scam_mpace.xml | 30 + .../use_cases/scam_sparticus.xml | 20 + bld/namelist_files/use_cases/scam_togaII.xml | 20 + bld/namelist_files/use_cases/scam_twp06.xml | 20 + .../use_cases/sd_trop_strat_vbs_cam6.xml | 176 + .../use_cases/sd_waccm5_mad_geos5.xml | 114 + .../use_cases/sd_waccm_ma_cam6.xml | 110 + .../use_cases/sd_waccm_sulfur.xml | 175 + .../use_cases/sd_waccm_tsmlt_cam6.xml | 205 + .../use_cases/sd_waccmx_ma_cam4.xml | 183 + .../use_cases/soa_chem_megan_emis.xml | 110 + .../use_cases/waccm_carma_bc_2013_cam4.xml | 165 + .../use_cases/waccm_ma_1850_cam6.xml | 113 + .../use_cases/waccm_ma_2000_cam6.xml | 106 + .../use_cases/waccm_ma_hist_cam6.xml | 103 + .../use_cases/waccm_sc_2000_cam4.xml | 97 + .../use_cases/waccm_sc_hist_cam6.xml | 73 + .../use_cases/waccm_tsmlt_1850_cam6.xml | 205 + .../use_cases/waccm_tsmlt_2000_cam6.xml | 203 + .../use_cases/waccm_tsmlt_hist_cam6.xml | 196 + .../use_cases/waccmx_ma_2000_cam4.xml | 153 + .../use_cases/waccmxie_ma_2000_cam4.xml | 189 + bld/perl5lib/Build/ChemNamelist.pm | 313 + bld/perl5lib/Build/ChemPreprocess.pm | 618 + bld/perl5lib/Build/Config.pm | 437 + bld/perl5lib/Build/Namelist.pm | 953 + bld/perl5lib/Build/NamelistDefaults.pm | 337 + bld/perl5lib/Build/NamelistDefinition.pm | 665 + bld/perl5lib/XML/Changes | 27 + bld/perl5lib/XML/Lite.pm | 550 + bld/perl5lib/XML/Lite/Element.pm | 491 + bld/perl5lib/XML/README | 20 + bld/perl5lib/XML/man3/XML_Lite.3 | 213 + bld/perl5lib/XML/man3/XML_Lite_Element.3 | 206 + bld/scripts/camfv2iop.ncl | 190 + bld/scripts/create_scam6_iop | 137 + bld/scripts/create_scam6_iop_multi | 142 + cime_config/buildcpp | 128 + cime_config/buildlib | 84 + cime_config/buildnml | 215 + cime_config/config_archive.xml | 27 + cime_config/config_component.xml | 289 + cime_config/config_compsets.xml | 599 + cime_config/config_pes.xml | 1643 + cime_config/testdefs/testlist_cam.xml | 839 + .../testmods_dirs/cam/cam4_port/user_nl_cam | 15 + .../cam/cam5_port_f45/user_nl_cam | 15 + .../cam/cam5_port_ne30/user_nl_cam | 15 + .../cam/cam6_port_f09/user_nl_cam | 22 + .../cam/cam6_port_f09/user_nl_clm | 22 + .../testmods_dirs/cam/cosp/shell_commands | 6 + .../cam/dartcambigens/shell_commands | 3 + .../cam/dartcambigens/user_nl_cam | 4 + .../cam/dartcambigens/user_nl_cice | 1 + .../cam/dartcambigens/user_nl_clm | 9 + .../testmods_dirs/cam/fire_emis/user_nl_cam | 16 + .../testmods_dirs/cam/fire_emis/user_nl_clm | 33 + .../testmods_dirs/cam/outfrq1d/shell_commands | 1 + .../testmods_dirs/cam/outfrq1d/user_nl_cam | 3 + .../testmods_dirs/cam/outfrq1d/user_nl_clm | 27 + .../cam/outfrq1d_newyear/shell_commands | 2 + .../cam/outfrq1d_newyear/user_nl_cam | 4 + .../cam/outfrq1d_newyear/user_nl_clm | 27 + .../testmods_dirs/cam/outfrq1m/user_nl_cam | 4 + .../testmods_dirs/cam/outfrq1m/user_nl_clm | 26 + .../testmods_dirs/cam/outfrq3d/shell_commands | 1 + .../testmods_dirs/cam/outfrq3d/user_nl_cam | 3 + .../testmods_dirs/cam/outfrq3d/user_nl_clm | 27 + .../cam/outfrq3s_refined/shell_commands | 3 + .../cam/outfrq3s_refined/user_nl_cam | 8 + .../cam/outfrq3s_refined/user_nl_clm | 27 + .../testmods_dirs/cam/outfrq9s/shell_commands | 2 + .../testmods_dirs/cam/outfrq9s/user_nl_cam | 4 + .../testmods_dirs/cam/outfrq9s/user_nl_clm | 27 + .../cam/reduced_hist1d/user_nl_cam | 27 + .../cam/reduced_hist3s/user_nl_cam | 27 + .../cam/reduced_hist5d/user_nl_cam | 27 + .../cam/scam_mpace_outfrq9s/include_user_mods | 1 + .../cam/scam_mpace_outfrq9s/shell_commands | 2 + .../cam/scam_mpace_outfrq9s/user_nl_cam | 4 + .../cam/scam_mpace_outfrq9s/user_nl_clm | 27 + cime_config/user_nl_cam | 3 + cime_config/usermods_dirs/aquap/user_nl_cpl | 28 + .../usermods_dirs/scam_arm95/shell_commands | 16 + .../usermods_dirs/scam_arm95/user_nl_cam | 16 + .../usermods_dirs/scam_arm97/shell_commands | 16 + .../usermods_dirs/scam_arm97/user_nl_cam | 16 + .../usermods_dirs/scam_atex/shell_commands | 16 + .../usermods_dirs/scam_atex/user_nl_cam | 15 + .../usermods_dirs/scam_bomex/shell_commands | 16 + .../usermods_dirs/scam_bomex/user_nl_cam | 15 + .../scam_cgilsS11/shell_commands | 16 + .../usermods_dirs/scam_cgilsS11/user_nl_cam | 15 + .../scam_cgilsS12/shell_commands | 16 + .../usermods_dirs/scam_cgilsS12/user_nl_cam | 15 + .../usermods_dirs/scam_cgilsS6/shell_commands | 16 + .../usermods_dirs/scam_cgilsS6/user_nl_cam | 15 + .../scam_dycomsRF01/shell_commands | 16 + .../usermods_dirs/scam_dycomsRF01/user_nl_cam | 16 + .../scam_dycomsRF02/shell_commands | 16 + .../usermods_dirs/scam_dycomsRF02/user_nl_cam | 16 + .../usermods_dirs/scam_gateIII/shell_commands | 16 + .../usermods_dirs/scam_gateIII/user_nl_cam | 15 + .../scam_mandatory/shell_commands | 12 + .../usermods_dirs/scam_mpace/shell_commands | 17 + .../usermods_dirs/scam_mpace/user_nl_cam | 15 + .../usermods_dirs/scam_rico/shell_commands | 16 + .../usermods_dirs/scam_rico/user_nl_cam | 16 + .../scam_sparticus/shell_commands | 16 + .../usermods_dirs/scam_sparticus/user_nl_cam | 15 + .../usermods_dirs/scam_togaII/shell_commands | 16 + .../usermods_dirs/scam_togaII/user_nl_cam | 15 + .../usermods_dirs/scam_twp06/shell_commands | 16 + .../usermods_dirs/scam_twp06/user_nl_cam | 15 + cime_config/usermods_dirs/waccmx/user_nl_clm | 3 + doc/ChangeLog | 107275 +++++++++++++++ doc/ChangeLog_template | 65 + doc/ReleaseNotes | 300 + manage_externals/.dir_locals.el | 12 + manage_externals/.github/ISSUE_TEMPLATE.md | 6 + .../.github/PULL_REQUEST_TEMPLATE.md | 17 + manage_externals/.gitignore | 14 + manage_externals/.travis.yml | 32 + manage_externals/LICENSE.txt | 34 + manage_externals/README.md | 211 + manage_externals/README_FIRST | 54 + manage_externals/checkout_externals | 36 + manage_externals/manic/__init__.py | 9 + manage_externals/manic/checkout.py | 409 + .../manic/externals_description.py | 790 + manage_externals/manic/externals_status.py | 164 + manage_externals/manic/global_constants.py | 18 + manage_externals/manic/repository.py | 97 + manage_externals/manic/repository_factory.py | 29 + manage_externals/manic/repository_git.py | 790 + manage_externals/manic/repository_svn.py | 284 + manage_externals/manic/sourcetree.py | 350 + manage_externals/manic/utils.py | 330 + manage_externals/test/.coveragerc | 7 + manage_externals/test/.gitignore | 7 + manage_externals/test/.pylint.rc | 426 + manage_externals/test/Makefile | 124 + manage_externals/test/README.md | 77 + manage_externals/test/doc/.gitignore | 2 + manage_externals/test/doc/Makefile | 20 + manage_externals/test/doc/conf.py | 172 + manage_externals/test/doc/develop.rst | 202 + manage_externals/test/doc/index.rst | 22 + manage_externals/test/doc/testing.rst | 123 + .../test/repos/container.git/HEAD | 1 + .../test/repos/container.git/config | 6 + .../test/repos/container.git/description | 1 + .../test/repos/container.git/info/exclude | 6 + .../41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 | Bin 0 -> 133 bytes .../71/5b8f3e4afe1802a178e1d603af404ba45d59de | Bin 0 -> 136 bytes .../b0/f87705e2b9601cb831878f3d51efa78b910d7b | Bin 0 -> 89 bytes .../f9/e08370a737e941de6f6492e3f427c2ef4c1a03 | Bin 0 -> 81 bytes .../repos/container.git/refs/heads/master | 1 + manage_externals/test/repos/error/readme.txt | 3 + .../test/repos/mixed-cont-ext.git/HEAD | 1 + .../test/repos/mixed-cont-ext.git/config | 6 + .../test/repos/mixed-cont-ext.git/description | 1 + .../repos/mixed-cont-ext.git/info/exclude | 6 + .../00/437ac2000d5f06fb8a572a01a5bbdae98b17cb | Bin 0 -> 172 bytes .../01/97458f2dbe5fcd6bc44fa46983be0a30282379 | Bin 0 -> 171 bytes .../06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 | Bin 0 -> 136 bytes .../14/368b701616a8c53820b610414a4b9a07540cf6 | 1 + .../15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 | 2 + .../1f/01fa46c17b1f38b37e6259f6e9d041bda3144f | Bin 0 -> 167 bytes .../37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 | Bin 0 -> 89 bytes .../38/9a2b876b8965d3c91a3db8d28a483eaf019d5c | Bin 0 -> 130 bytes .../41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 | Bin 0 -> 133 bytes .../6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 | Bin 0 -> 129 bytes .../6f/c379457ecb4e576a13c7610ae1fa73f845ee6a | 1 + .../93/a159deb9175bfeb2820a0006ddd92d78131332 | Bin 0 -> 169 bytes .../95/80ecc12f16334ce44e42287d5d46f927bb7b75 | 1 + .../a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd | Bin 0 -> 130 bytes .../e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 | Bin 0 -> 130 bytes .../fd/15a5ad5204356229c60a831d2a8120a43ac901 | 2 + .../mixed-cont-ext.git/refs/heads/master | 1 + .../mixed-cont-ext.git/refs/heads/new-feature | 1 + .../test/repos/simple-ext-fork.git/HEAD | 1 + .../test/repos/simple-ext-fork.git/config | 8 + .../repos/simple-ext-fork.git/description | 1 + .../repos/simple-ext-fork.git/info/exclude | 6 + .../00/fd13e76189f9134b0506b4b8ed3172723b467f | Bin 0 -> 89 bytes .../0b/15e8af3d4615b42314216efeae3fff184046a8 | Bin 0 -> 89 bytes .../0b/67df4e7e8e6e1c6e401542738b352d18744677 | Bin 0 -> 167 bytes .../11/a76e3d9a67313dec7ce1230852ab5c86352c5c | 2 + .../16/5506a7408a482f50493434e13fffeb44af893f | Bin 0 -> 89 bytes .../24/4386e788c9bc608613e127a329c742450a60e4 | Bin 0 -> 164 bytes .../32/7e97d86e941047d809dba58f2804740c6c30cf | Bin 0 -> 89 bytes .../36/418b4e5665956a90725c9a1b5a8e551c5f3d48 | Bin 0 -> 159 bytes .../3d/7099c35404ae6c8640ce263b38bef06e98cc26 | 2 + .../3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b | 2 + .../41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 | Bin 0 -> 133 bytes .../4d/837135915ed93eed6fff6b439f284ce317296f | Bin 0 -> 89 bytes .../56/175e017ad38bf3d33d74b6bd7c74624b28466a | Bin 0 -> 89 bytes .../5f/1d4786d12e52d7ab28d2f2f1118c1059a9f1ae | Bin 0 -> 93 bytes .../67/136e5ab4d5c1c65d10c8048763b96b0e53c1d6 | Bin 0 -> 165 bytes .../7b/0bd630ac13865735a1dff3437a137d8ab50663 | Bin 0 -> 119 bytes .../88/cf20868e0cc445f5642a480ed034c71e0d7e9f | 2 + .../8d/2b3b35126224c975d23f109aa1e3cbac452989 | 2 + .../9b/75494003deca69527bb64bcaa352e801611dd2 | Bin 0 -> 138 bytes .../a2/2a5da9119328ea6d693f88861457c07e14ac04 | 1 + .../a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 | 3 + .../b9/3737be3ea6b19f6255983748a0a0f4d622f936 | Bin 0 -> 89 bytes .../c5/32bc8fde96fa63103a52057f0baffcc9f00c6b | 1 + .../c5/b315915742133dbdfbeed0753e481b55c1d364 | 1 + .../f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca | 1 + .../repos/simple-ext-fork.git/packed-refs | 5 + .../simple-ext-fork.git/refs/heads/feature2 | 1 + .../refs/tags/abandoned-feature | 1 + .../refs/tags/forked-feature-v1 | 1 + .../test/repos/simple-ext.git/HEAD | 1 + .../test/repos/simple-ext.git/config | 6 + .../test/repos/simple-ext.git/description | 1 + .../test/repos/simple-ext.git/info/exclude | 6 + .../00/fd13e76189f9134b0506b4b8ed3172723b467f | Bin 0 -> 89 bytes .../09/0e1034746b2c865f7b0280813dbf4061a700e8 | Bin 0 -> 164 bytes .../0b/15e8af3d4615b42314216efeae3fff184046a8 | Bin 0 -> 89 bytes .../11/a76e3d9a67313dec7ce1230852ab5c86352c5c | 2 + .../31/dbcd6de441e671a467ef317146539b7ffabb11 | Bin 0 -> 90 bytes .../36/418b4e5665956a90725c9a1b5a8e551c5f3d48 | Bin 0 -> 159 bytes .../41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 | Bin 0 -> 133 bytes .../60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 | 2 + .../63/a99393d1baff97ccef967af30380659867b139 | 1 + .../95/3256da5612fcd9263590a353bc18c6f224e74f | 1 + .../9b/75494003deca69527bb64bcaa352e801611dd2 | Bin 0 -> 138 bytes .../a2/2a5da9119328ea6d693f88861457c07e14ac04 | 1 + .../c5/b315915742133dbdfbeed0753e481b55c1d364 | 1 + .../df/312890f93ba4d2c694208599b665c4a08afeff | Bin 0 -> 89 bytes .../repos/simple-ext.git/refs/heads/feature2 | 1 + .../repos/simple-ext.git/refs/heads/feature3 | 1 + .../repos/simple-ext.git/refs/heads/master | 1 + .../test/repos/simple-ext.git/refs/tags/tag1 | 1 + manage_externals/test/requirements.txt | 5 + manage_externals/test/test_sys_checkout.py | 1827 + .../test/test_sys_repository_git.py | 238 + .../test/test_unit_externals_description.py | 401 + .../test/test_unit_externals_status.py | 299 + manage_externals/test/test_unit_repository.py | 197 + .../test/test_unit_repository_git.py | 807 + .../test/test_unit_repository_svn.py | 501 + manage_externals/test/test_unit_utils.py | 350 + src/advection/slt/bandij.F90 | 85 + src/advection/slt/basdy.F90 | 55 + src/advection/slt/basdz.F90 | 53 + src/advection/slt/basiy.F90 | 44 + src/advection/slt/difcor.F90 | 115 + src/advection/slt/engy_tdif.F90 | 58 + src/advection/slt/engy_te.F90 | 64 + src/advection/slt/extx.F90 | 66 + src/advection/slt/extys.F90 | 137 + src/advection/slt/extyv.F90 | 177 + src/advection/slt/flxint.F90 | 45 + src/advection/slt/grdxy.F90 | 124 + src/advection/slt/hadvtest.h | 2 + src/advection/slt/hordif1.F90 | 92 + src/advection/slt/kdpfnd.F90 | 66 + src/advection/slt/lcbas.F90 | 58 + src/advection/slt/lcdbas.F90 | 71 + src/advection/slt/omcalc.F90 | 146 + src/advection/slt/pdelb0.F90 | 49 + src/advection/slt/phcs.F90 | 238 + src/advection/slt/plevs0.F90 | 63 + src/advection/slt/qmassa.F90 | 111 + src/advection/slt/qmassd.F90 | 69 + src/advection/slt/reordp.F90 | 57 + src/advection/slt/scm0.F90 | 57 + src/advection/slt/xqmass.F90 | 150 + src/chemistry/aerosol/cldaero_mod.F90 | 148 + src/chemistry/aerosol/drydep_mod.F90 | 268 + src/chemistry/aerosol/dust_common.F90 | 253 + src/chemistry/aerosol/dust_sediment_mod.F90 | 501 + src/chemistry/aerosol/mo_setsox.F90 | 879 + src/chemistry/aerosol/soil_erod_mod.F90 | 121 + src/chemistry/aerosol/sslt_sections.F90 | 120 + src/chemistry/aerosol/wetdep.F90 | 1195 + src/chemistry/bulk_aero/aero_model.F90 | 1153 + src/chemistry/bulk_aero/aerosol_depvel.F90 | 113 + src/chemistry/bulk_aero/dust_model.F90 | 167 + src/chemistry/bulk_aero/mo_aerosols.F90 | 270 + src/chemistry/bulk_aero/mo_setsoa.F90 | 1222 + src/chemistry/bulk_aero/seasalt_model.F90 | 131 + src/chemistry/bulk_aero/sox_cldaero_mod.F90 | 141 + src/chemistry/modal_aero/aero_model.F90 | 2784 + src/chemistry/modal_aero/dust_model.F90 | 187 + src/chemistry/modal_aero/modal_aero_coag.F90 | 2897 + .../modal_aero/modal_aero_convproc.F90 | 2866 + src/chemistry/modal_aero/modal_aero_data.F90 | 1204 + .../modal_aero/modal_aero_gasaerexch.F90 | 1881 + .../modal_aero/modal_aero_newnuc.F90 | 1727 + .../modal_aero/modal_aero_rename.F90 | 1820 + src/chemistry/modal_aero/seasalt_model.F90 | 127 + src/chemistry/modal_aero/sox_cldaero_mod.F90 | 520 + src/chemistry/mozart/cfc11star.F90 | 158 + src/chemistry/mozart/charge_neutrality.F90 | 163 + src/chemistry/mozart/chem_prod_loss_diags.F90 | 121 + src/chemistry/mozart/chemistry.F90 | 1507 + .../mozart/chlorine_loading_data.F90 | 298 + src/chemistry/mozart/clybry_fam.F90 | 289 + src/chemistry/mozart/epp_ionization.F90 | 508 + src/chemistry/mozart/euvac.F90 | 127 + src/chemistry/mozart/fire_emissions.F90 | 272 + src/chemistry/mozart/gas_wetdep_opts.F90 | 76 + src/chemistry/mozart/gcr_ionization.F90 | 163 + src/chemistry/mozart/lin_strat_chem.F90 | 300 + src/chemistry/mozart/linoz_data.F90 | 315 + src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 | 85 + src/chemistry/mozart/m_sad_data.F90 | 53 + src/chemistry/mozart/mo_aero_settling.F90 | 232 + src/chemistry/mozart/mo_airglow.F90 | 104 + src/chemistry/mozart/mo_airmas.F90 | 94 + src/chemistry/mozart/mo_airplane.F90 | 350 + src/chemistry/mozart/mo_apex.F90 | 400 + src/chemistry/mozart/mo_aurora.F90 | 103 + src/chemistry/mozart/mo_calcoe.F90 | 45 + src/chemistry/mozart/mo_chem_utls.F90 | 162 + src/chemistry/mozart/mo_chemini.F90 | 244 + src/chemistry/mozart/mo_chm_diags.F90 | 886 + src/chemistry/mozart/mo_cph.F90 | 166 + src/chemistry/mozart/mo_drydep.F90 | 3300 + src/chemistry/mozart/mo_extfrc.F90 | 416 + src/chemistry/mozart/mo_fstrat.F90 | 1013 + src/chemistry/mozart/mo_gas_phase_chemdr.F90 | 1176 + src/chemistry/mozart/mo_ghg_chem.F90 | 213 + src/chemistry/mozart/mo_heatnirco2.F90 | 559 + src/chemistry/mozart/mo_inter.F90 | 332 + src/chemistry/mozart/mo_jeuv.F90 | 662 + src/chemistry/mozart/mo_jlong.F90 | 961 + src/chemistry/mozart/mo_jpl.F90 | 41 + src/chemistry/mozart/mo_jshort.F90 | 1876 + src/chemistry/mozart/mo_lightning.F90 | 403 + src/chemistry/mozart/mo_lymana.F90 | 97 + src/chemistry/mozart/mo_mass_xforms.F90 | 222 + src/chemistry/mozart/mo_mean_mass.F90 | 94 + src/chemistry/mozart/mo_negtrc.F90 | 45 + src/chemistry/mozart/mo_neu_wetdep.F90 | 1765 + src/chemistry/mozart/mo_params.F90 | 34 + src/chemistry/mozart/mo_pchem.F90 | 137 + src/chemistry/mozart/mo_photo.F90 | 1769 + src/chemistry/mozart/mo_photoin.F90 | 463 + src/chemistry/mozart/mo_ps2str.F90 | 331 + src/chemistry/mozart/mo_rtlink.F90 | 265 + src/chemistry/mozart/mo_sad.F90 | 1644 + src/chemistry/mozart/mo_schu.F90 | 289 + src/chemistry/mozart/mo_setaer.F90 | 1191 + src/chemistry/mozart/mo_setair.F90 | 105 + src/chemistry/mozart/mo_setcld.F90 | 480 + src/chemistry/mozart/mo_setext.F90 | 332 + src/chemistry/mozart/mo_sethet.F90 | 884 + src/chemistry/mozart/mo_setinv.F90 | 153 + src/chemistry/mozart/mo_seto2.F90 | 394 + src/chemistry/mozart/mo_setozo.F90 | 111 + src/chemistry/mozart/mo_setz.F90 | 160 + src/chemistry/mozart/mo_snoe.F90 | 505 + src/chemistry/mozart/mo_sphers.F90 | 121 + src/chemistry/mozart/mo_srf_emissions.F90 | 451 + src/chemistry/mozart/mo_strato_rates.F90 | 886 + src/chemistry/mozart/mo_sulf.F90 | 236 + src/chemistry/mozart/mo_synoz.F90 | 233 + src/chemistry/mozart/mo_tgcm_ubc.F90 | 176 + src/chemistry/mozart/mo_tracname.F90 | 14 + src/chemistry/mozart/mo_trislv.F90 | 156 + src/chemistry/mozart/mo_tuv_inti.F90 | 341 + src/chemistry/mozart/mo_usrrxt.F90 | 1577 + src/chemistry/mozart/mo_waccm_hrates.F90 | 462 + src/chemistry/mozart/mo_waveall.F90 | 18 + src/chemistry/mozart/mo_wavelab.F90 | 11 + src/chemistry/mozart/mo_wavelen.F90 | 15 + src/chemistry/mozart/mo_waveo3.F90 | 11 + src/chemistry/mozart/mo_xsections.F90 | 1392 + src/chemistry/mozart/mo_zadj.F90 | 10 + src/chemistry/mozart/noy_ubc.F90 | 247 + src/chemistry/mozart/photo_bkgrnd.F90 | 217 + src/chemistry/mozart/rate_diags.F90 | 175 + src/chemistry/mozart/set_cp.F90 | 128 + src/chemistry/mozart/short_lived_species.F90 | 180 + src/chemistry/mozart/species_sums_diags.F90 | 138 + src/chemistry/mozart/spehox.F90 | 188 + src/chemistry/mozart/sums_utils.F90 | 125 + src/chemistry/mozart/sv_decomp.F90 | 364 + src/chemistry/mozart/tracer_cnst.F90 | 371 + src/chemistry/mozart/tracer_srcs.F90 | 296 + src/chemistry/mozart/upper_bc.F90 | 377 + src/chemistry/pp_none/chem_mech.in | 50 + src/chemistry/pp_none/chem_mods.F90 | 49 + src/chemistry/pp_none/chemistry.F90 | 234 + src/chemistry/pp_none/m_spc_id.F90 | 3 + src/chemistry/pp_none/mo_adjrxt.F90 | 17 + src/chemistry/pp_none/mo_exp_sol.F90 | 79 + src/chemistry/pp_none/mo_imp_sol.F90 | 392 + src/chemistry/pp_none/mo_indprd.F90 | 21 + src/chemistry/pp_none/mo_lin_matrix.F90 | 20 + src/chemistry/pp_none/mo_lu_factor.F90 | 13 + src/chemistry/pp_none/mo_lu_solve.F90 | 15 + src/chemistry/pp_none/mo_nln_matrix.F90 | 18 + src/chemistry/pp_none/mo_phtadj.F90 | 24 + src/chemistry/pp_none/mo_prod_loss.F90 | 33 + src/chemistry/pp_none/mo_rxt_rates_conv.F90 | 12 + src/chemistry/pp_none/mo_setrxt.F90 | 52 + .../pp_super_fast_llnl/chem_mech.doc | 131 + src/chemistry/pp_super_fast_llnl/chem_mech.in | 89 + .../pp_super_fast_llnl/chem_mods.F90 | 50 + src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 | 33 + src/chemistry/pp_super_fast_llnl/m_spc_id.F90 | 18 + .../pp_super_fast_llnl/mo_adjrxt.F90 | 43 + .../pp_super_fast_llnl/mo_exp_sol.F90 | 79 + .../pp_super_fast_llnl/mo_imp_sol.F90 | 392 + .../pp_super_fast_llnl/mo_indprd.F90 | 46 + .../pp_super_fast_llnl/mo_lin_matrix.F90 | 61 + .../pp_super_fast_llnl/mo_lu_factor.F90 | 161 + .../pp_super_fast_llnl/mo_lu_solve.F90 | 135 + .../pp_super_fast_llnl/mo_nln_matrix.F90 | 181 + .../pp_super_fast_llnl/mo_phtadj.F90 | 24 + .../pp_super_fast_llnl/mo_prod_loss.F90 | 80 + .../pp_super_fast_llnl/mo_rxt_rates_conv.F90 | 42 + .../pp_super_fast_llnl/mo_setrxt.F90 | 104 + .../pp_super_fast_llnl/mo_sim_dat.F90 | 130 + .../pp_super_fast_llnl_mam3/chem_mech.doc | 179 + .../pp_super_fast_llnl_mam3/chem_mech.in | 113 + .../pp_super_fast_llnl_mam3/chem_mods.F90 | 50 + .../pp_super_fast_llnl_mam3/m_rxt_id.F90 | 31 + .../pp_super_fast_llnl_mam3/m_spc_id.F90 | 34 + .../pp_super_fast_llnl_mam3/mo_adjrxt.F90 | 40 + .../pp_super_fast_llnl_mam3/mo_exp_sol.F90 | 79 + .../pp_super_fast_llnl_mam3/mo_imp_sol.F90 | 392 + .../pp_super_fast_llnl_mam3/mo_indprd.F90 | 62 + .../pp_super_fast_llnl_mam3/mo_lin_matrix.F90 | 77 + .../pp_super_fast_llnl_mam3/mo_lu_factor.F90 | 171 + .../pp_super_fast_llnl_mam3/mo_lu_solve.F90 | 144 + .../pp_super_fast_llnl_mam3/mo_nln_matrix.F90 | 206 + .../pp_super_fast_llnl_mam3/mo_phtadj.F90 | 24 + .../pp_super_fast_llnl_mam3/mo_prod_loss.F90 | 112 + .../mo_rxt_rates_conv.F90 | 40 + .../pp_super_fast_llnl_mam3/mo_setrxt.F90 | 100 + .../pp_super_fast_llnl_mam3/mo_sim_dat.F90 | 146 + src/chemistry/pp_terminator/chem_mech.doc | 41 + src/chemistry/pp_terminator/chem_mech.in | 53 + src/chemistry/pp_terminator/chem_mods.F90 | 50 + src/chemistry/pp_terminator/chemistry.F90 | 432 + src/chemistry/pp_terminator/m_rxt_id.F90 | 5 + src/chemistry/pp_terminator/m_spc_id.F90 | 6 + src/chemistry/pp_terminator/mo_adjrxt.F90 | 18 + src/chemistry/pp_terminator/mo_exp_sol.F90 | 79 + src/chemistry/pp_terminator/mo_imp_sol.F90 | 392 + src/chemistry/pp_terminator/mo_indprd.F90 | 29 + src/chemistry/pp_terminator/mo_lin_matrix.F90 | 40 + src/chemistry/pp_terminator/mo_lu_factor.F90 | 27 + src/chemistry/pp_terminator/mo_lu_solve.F90 | 57 + src/chemistry/pp_terminator/mo_nln_matrix.F90 | 61 + src/chemistry/pp_terminator/mo_phtadj.F90 | 24 + src/chemistry/pp_terminator/mo_prod_loss.F90 | 42 + .../pp_terminator/mo_rxt_rates_conv.F90 | 14 + src/chemistry/pp_terminator/mo_setrxt.F90 | 52 + src/chemistry/pp_terminator/mo_sim_dat.F90 | 81 + src/chemistry/pp_trop_bam/chem_mech.doc | 96 + src/chemistry/pp_trop_bam/chem_mech.in | 73 + src/chemistry/pp_trop_bam/chem_mods.F90 | 50 + src/chemistry/pp_trop_bam/m_rxt_id.F90 | 12 + src/chemistry/pp_trop_bam/m_spc_id.F90 | 19 + src/chemistry/pp_trop_bam/mo_adjrxt.F90 | 28 + src/chemistry/pp_trop_bam/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_bam/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_bam/mo_indprd.F90 | 42 + src/chemistry/pp_trop_bam/mo_lin_matrix.F90 | 56 + src/chemistry/pp_trop_bam/mo_lu_factor.F90 | 40 + src/chemistry/pp_trop_bam/mo_lu_solve.F90 | 72 + src/chemistry/pp_trop_bam/mo_nln_matrix.F90 | 71 + src/chemistry/pp_trop_bam/mo_phtadj.F90 | 24 + src/chemistry/pp_trop_bam/mo_prod_loss.F90 | 68 + .../pp_trop_bam/mo_rxt_rates_conv.F90 | 21 + src/chemistry/pp_trop_bam/mo_setrxt.F90 | 75 + src/chemistry/pp_trop_bam/mo_sim_dat.F90 | 120 + src/chemistry/pp_trop_ghg/chem_mech.doc | 51 + src/chemistry/pp_trop_ghg/chem_mech.in | 57 + src/chemistry/pp_trop_ghg/chem_mods.F90 | 50 + src/chemistry/pp_trop_ghg/m_rxt_id.F90 | 8 + src/chemistry/pp_trop_ghg/m_spc_id.F90 | 8 + src/chemistry/pp_trop_ghg/mo_adjrxt.F90 | 17 + src/chemistry/pp_trop_ghg/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_ghg/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_ghg/mo_indprd.F90 | 31 + src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 | 42 + src/chemistry/pp_trop_ghg/mo_lu_factor.F90 | 28 + src/chemistry/pp_trop_ghg/mo_lu_solve.F90 | 58 + src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 | 46 + src/chemistry/pp_trop_ghg/mo_phtadj.F90 | 24 + src/chemistry/pp_trop_ghg/mo_prod_loss.F90 | 46 + .../pp_trop_ghg/mo_rxt_rates_conv.F90 | 17 + src/chemistry/pp_trop_ghg/mo_setrxt.F90 | 52 + src/chemistry/pp_trop_ghg/mo_sim_dat.F90 | 83 + src/chemistry/pp_trop_mam3/chem_mech.doc | 114 + src/chemistry/pp_trop_mam3/chem_mech.in | 82 + src/chemistry/pp_trop_mam3/chem_mods.F90 | 50 + src/chemistry/pp_trop_mam3/m_rxt_id.F90 | 10 + src/chemistry/pp_trop_mam3/m_spc_id.F90 | 24 + src/chemistry/pp_trop_mam3/mo_adjrxt.F90 | 28 + src/chemistry/pp_trop_mam3/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_mam3/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_mam3/mo_indprd.F90 | 47 + src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 | 60 + src/chemistry/pp_trop_mam3/mo_lu_factor.F90 | 44 + src/chemistry/pp_trop_mam3/mo_lu_solve.F90 | 76 + src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 | 80 + src/chemistry/pp_trop_mam3/mo_phtadj.F90 | 24 + src/chemistry/pp_trop_mam3/mo_prod_loss.F90 | 78 + .../pp_trop_mam3/mo_rxt_rates_conv.F90 | 19 + src/chemistry/pp_trop_mam3/mo_setrxt.F90 | 73 + src/chemistry/pp_trop_mam3/mo_sim_dat.F90 | 128 + src/chemistry/pp_trop_mam4/chem_mech.doc | 127 + src/chemistry/pp_trop_mam4/chem_mech.in | 86 + src/chemistry/pp_trop_mam4/chem_mods.F90 | 50 + src/chemistry/pp_trop_mam4/m_rxt_id.F90 | 10 + src/chemistry/pp_trop_mam4/m_spc_id.F90 | 28 + src/chemistry/pp_trop_mam4/mo_adjrxt.F90 | 28 + src/chemistry/pp_trop_mam4/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_mam4/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_mam4/mo_indprd.F90 | 51 + src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 | 64 + src/chemistry/pp_trop_mam4/mo_lu_factor.F90 | 48 + src/chemistry/pp_trop_mam4/mo_lu_solve.F90 | 80 + src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 | 88 + src/chemistry/pp_trop_mam4/mo_phtadj.F90 | 24 + src/chemistry/pp_trop_mam4/mo_prod_loss.F90 | 86 + .../pp_trop_mam4/mo_rxt_rates_conv.F90 | 19 + src/chemistry/pp_trop_mam4/mo_setrxt.F90 | 73 + src/chemistry/pp_trop_mam4/mo_sim_dat.F90 | 128 + src/chemistry/pp_trop_mam7/chem_mech.doc | 167 + src/chemistry/pp_trop_mam7/chem_mech.in | 110 + src/chemistry/pp_trop_mam7/chem_mods.F90 | 50 + src/chemistry/pp_trop_mam7/m_rxt_id.F90 | 11 + src/chemistry/pp_trop_mam7/m_spc_id.F90 | 41 + src/chemistry/pp_trop_mam7/mo_adjrxt.F90 | 29 + src/chemistry/pp_trop_mam7/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_mam7/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_mam7/mo_indprd.F90 | 64 + src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 | 78 + src/chemistry/pp_trop_mam7/mo_lu_factor.F90 | 62 + src/chemistry/pp_trop_mam7/mo_lu_solve.F90 | 94 + src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 | 115 + src/chemistry/pp_trop_mam7/mo_phtadj.F90 | 24 + src/chemistry/pp_trop_mam7/mo_prod_loss.F90 | 112 + .../pp_trop_mam7/mo_rxt_rates_conv.F90 | 20 + src/chemistry/pp_trop_mam7/mo_setrxt.F90 | 74 + src/chemistry/pp_trop_mam7/mo_sim_dat.F90 | 140 + src/chemistry/pp_trop_mozart/chem_mech.doc | 778 + src/chemistry/pp_trop_mozart/chem_mech.in | 355 + src/chemistry/pp_trop_mozart/chem_mods.F90 | 50 + src/chemistry/pp_trop_mozart/m_rxt_id.F90 | 215 + src/chemistry/pp_trop_mozart/m_spc_id.F90 | 106 + src/chemistry/pp_trop_mozart/mo_adjrxt.F90 | 192 + src/chemistry/pp_trop_mozart/mo_exp_sol.F90 | 79 + src/chemistry/pp_trop_mozart/mo_imp_sol.F90 | 392 + src/chemistry/pp_trop_mozart/mo_indprd.F90 | 148 + .../pp_trop_mozart/mo_lin_matrix.F90 | 264 + src/chemistry/pp_trop_mozart/mo_lu_factor.F90 | 2394 + src/chemistry/pp_trop_mozart/mo_lu_solve.F90 | 910 + .../pp_trop_mozart/mo_nln_matrix.F90 | 1349 + src/chemistry/pp_trop_mozart/mo_phtadj.F90 | 26 + src/chemistry/pp_trop_mozart/mo_prod_loss.F90 | 452 + .../pp_trop_mozart/mo_rxt_rates_conv.F90 | 224 + src/chemistry/pp_trop_mozart/mo_setrxt.F90 | 279 + src/chemistry/pp_trop_mozart/mo_sim_dat.F90 | 299 + .../pp_trop_strat_mam4_vbs/chem_mech.doc | 1761 + .../pp_trop_strat_mam4_vbs/chem_mech.in | 1163 + .../pp_trop_strat_mam4_vbs/chem_mods.F90 | 51 + .../pp_trop_strat_mam4_vbs/m_rxt_id.F90 | 531 + .../pp_trop_strat_mam4_vbs/m_spc_id.F90 | 224 + .../pp_trop_strat_mam4_vbs/mo_adjrxt.F90 | 416 + .../pp_trop_strat_mam4_vbs/mo_exp_sol.F90 | 81 + .../pp_trop_strat_mam4_vbs/mo_imp_sol.F90 | 435 + .../pp_trop_strat_mam4_vbs/mo_indprd.F90 | 276 + .../pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 | 618 + .../pp_trop_strat_mam4_vbs/mo_lu_factor.F90 | 7314 + .../pp_trop_strat_mam4_vbs/mo_lu_solve.F90 | 2252 + .../pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 | 3256 + .../pp_trop_strat_mam4_vbs/mo_phtadj.F90 | 27 + .../pp_trop_strat_mam4_vbs/mo_prod_loss.F90 | 1170 + .../mo_rxt_rates_conv.F90 | 540 + .../pp_trop_strat_mam4_vbs/mo_setrxt.F90 | 680 + .../pp_trop_strat_mam4_vbs/mo_sim_dat.F90 | 793 + src/chemistry/pp_waccm_ma/chem_mech.doc | 714 + src/chemistry/pp_waccm_ma/chem_mech.in | 438 + src/chemistry/pp_waccm_ma/chem_mods.F90 | 50 + src/chemistry/pp_waccm_ma/m_rxt_id.F90 | 292 + src/chemistry/pp_waccm_ma/m_spc_id.F90 | 77 + src/chemistry/pp_waccm_ma/mo_adjrxt.F90 | 214 + src/chemistry/pp_waccm_ma/mo_exp_sol.F90 | 79 + src/chemistry/pp_waccm_ma/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_ma/mo_indprd.F90 | 123 + src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 | 265 + src/chemistry/pp_waccm_ma/mo_lu_factor.F90 | 2527 + src/chemistry/pp_waccm_ma/mo_lu_solve.F90 | 716 + src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 | 1027 + src/chemistry/pp_waccm_ma/mo_phtadj.F90 | 33 + src/chemistry/pp_waccm_ma/mo_prod_loss.F90 | 397 + .../pp_waccm_ma/mo_rxt_rates_conv.F90 | 301 + src/chemistry/pp_waccm_ma/mo_setrxt.F90 | 366 + src/chemistry/pp_waccm_ma/mo_sim_dat.F90 | 472 + src/chemistry/pp_waccm_ma_mam4/chem_mech.doc | 812 + src/chemistry/pp_waccm_ma_mam4/chem_mech.in | 493 + src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 | 50 + src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 | 301 + src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 | 101 + src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 | 222 + src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 | 79 + src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 | 147 + .../pp_waccm_ma_mam4/mo_lin_matrix.F90 | 287 + .../pp_waccm_ma_mam4/mo_lu_factor.F90 | 3071 + .../pp_waccm_ma_mam4/mo_lu_solve.F90 | 821 + .../pp_waccm_ma_mam4/mo_nln_matrix.F90 | 1191 + src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 | 33 + .../pp_waccm_ma_mam4/mo_prod_loss.F90 | 458 + .../pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 | 310 + src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 | 360 + src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 | 504 + .../pp_waccm_ma_sulfur/chem_mech.doc | 644 + src/chemistry/pp_waccm_ma_sulfur/chem_mech.in | 378 + .../pp_waccm_ma_sulfur/chem_mods.F90 | 50 + src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 | 257 + src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 | 69 + .../pp_waccm_ma_sulfur/mo_adjrxt.F90 | 195 + .../pp_waccm_ma_sulfur/mo_exp_sol.F90 | 79 + .../pp_waccm_ma_sulfur/mo_imp_sol.F90 | 392 + .../pp_waccm_ma_sulfur/mo_indprd.F90 | 111 + .../pp_waccm_ma_sulfur/mo_lin_matrix.F90 | 208 + .../pp_waccm_ma_sulfur/mo_lu_factor.F90 | 2213 + .../pp_waccm_ma_sulfur/mo_lu_solve.F90 | 674 + .../pp_waccm_ma_sulfur/mo_nln_matrix.F90 | 962 + .../pp_waccm_ma_sulfur/mo_phtadj.F90 | 33 + .../pp_waccm_ma_sulfur/mo_prod_loss.F90 | 351 + .../pp_waccm_ma_sulfur/mo_rxt_rates_conv.F90 | 266 + .../pp_waccm_ma_sulfur/mo_setrxt.F90 | 322 + .../pp_waccm_ma_sulfur/mo_sim_dat.F90 | 368 + src/chemistry/pp_waccm_mad_mam4/chem_mech.doc | 1491 + src/chemistry/pp_waccm_mad_mam4/chem_mech.in | 825 + src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 | 50 + src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 | 596 + src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 | 138 + src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 | 545 + .../pp_waccm_mad_mam4/mo_exp_sol.F90 | 79 + .../pp_waccm_mad_mam4/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 | 182 + .../pp_waccm_mad_mam4/mo_lin_matrix.F90 | 377 + .../pp_waccm_mad_mam4/mo_lu_factor.F90 | 13543 ++ .../pp_waccm_mad_mam4/mo_lu_solve.F90 | 2095 + .../pp_waccm_mad_mam4/mo_nln_matrix.F90 | 2981 + src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 | 33 + .../pp_waccm_mad_mam4/mo_prod_loss.F90 | 879 + .../pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 | 605 + src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 | 592 + .../pp_waccm_mad_mam4/mo_sim_dat.F90 | 691 + src/chemistry/pp_waccm_sc/chem_mech.doc | 51 + src/chemistry/pp_waccm_sc/chem_mech.in | 57 + src/chemistry/pp_waccm_sc/chem_mods.F90 | 50 + src/chemistry/pp_waccm_sc/m_rxt_id.F90 | 8 + src/chemistry/pp_waccm_sc/m_spc_id.F90 | 8 + src/chemistry/pp_waccm_sc/mo_adjrxt.F90 | 17 + src/chemistry/pp_waccm_sc/mo_exp_sol.F90 | 79 + src/chemistry/pp_waccm_sc/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_sc/mo_indprd.F90 | 31 + src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 | 42 + src/chemistry/pp_waccm_sc/mo_lu_factor.F90 | 28 + src/chemistry/pp_waccm_sc/mo_lu_solve.F90 | 58 + src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 | 46 + src/chemistry/pp_waccm_sc/mo_phtadj.F90 | 24 + src/chemistry/pp_waccm_sc/mo_prod_loss.F90 | 46 + .../pp_waccm_sc/mo_rxt_rates_conv.F90 | 17 + src/chemistry/pp_waccm_sc/mo_setrxt.F90 | 52 + src/chemistry/pp_waccm_sc/mo_sim_dat.F90 | 83 + src/chemistry/pp_waccm_sc_mam4/chem_mech.doc | 148 + src/chemistry/pp_waccm_sc_mam4/chem_mech.in | 98 + src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 | 50 + src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 | 15 + src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 | 32 + src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 | 28 + src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 | 79 + src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 | 55 + .../pp_waccm_sc_mam4/mo_lin_matrix.F90 | 69 + .../pp_waccm_sc_mam4/mo_lu_factor.F90 | 52 + .../pp_waccm_sc_mam4/mo_lu_solve.F90 | 85 + .../pp_waccm_sc_mam4/mo_nln_matrix.F90 | 97 + src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 | 24 + .../pp_waccm_sc_mam4/mo_prod_loss.F90 | 94 + .../pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 | 24 + src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 | 73 + src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 | 137 + src/chemistry/pp_waccm_tsmlt/chem_mech.doc | 1433 + src/chemistry/pp_waccm_tsmlt/chem_mech.in | 779 + src/chemistry/pp_waccm_tsmlt/chem_mods.F90 | 50 + src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 | 475 + src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 | 186 + src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 | 348 + src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 | 79 + src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 | 392 + src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 | 241 + .../pp_waccm_tsmlt/mo_lin_matrix.F90 | 440 + src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 | 5327 + src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 | 1625 + .../pp_waccm_tsmlt/mo_nln_matrix.F90 | 2340 + src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 | 33 + src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 | 819 + .../pp_waccm_tsmlt/mo_rxt_rates_conv.F90 | 484 + src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 | 602 + src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 | 709 + .../pp_waccm_tsmlt_mam4/chem_mech.doc | 1877 + .../pp_waccm_tsmlt_mam4/chem_mech.in | 1259 + .../pp_waccm_tsmlt_mam4/chem_mods.F90 | 51 + .../pp_waccm_tsmlt_mam4/m_rxt_id.F90 | 586 + .../pp_waccm_tsmlt_mam4/m_spc_id.F90 | 234 + .../pp_waccm_tsmlt_mam4/mo_adjrxt.F90 | 444 + .../pp_waccm_tsmlt_mam4/mo_exp_sol.F90 | 81 + .../pp_waccm_tsmlt_mam4/mo_imp_sol.F90 | 435 + .../pp_waccm_tsmlt_mam4/mo_indprd.F90 | 289 + .../pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 | 653 + .../pp_waccm_tsmlt_mam4/mo_lu_factor.F90 | 7992 ++ .../pp_waccm_tsmlt_mam4/mo_lu_solve.F90 | 2421 + .../pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 | 3510 + .../pp_waccm_tsmlt_mam4/mo_phtadj.F90 | 33 + .../pp_waccm_tsmlt_mam4/mo_prod_loss.F90 | 1252 + .../pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 | 595 + .../pp_waccm_tsmlt_mam4/mo_setrxt.F90 | 728 + .../pp_waccm_tsmlt_mam4/mo_sim_dat.F90 | 877 + .../pp_waccm_tsmlt_sulfur/chem_mech.doc | 1417 + .../pp_waccm_tsmlt_sulfur/chem_mech.in | 782 + .../pp_waccm_tsmlt_sulfur/chem_mods.F90 | 50 + .../pp_waccm_tsmlt_sulfur/m_rxt_id.F90 | 480 + .../pp_waccm_tsmlt_sulfur/m_spc_id.F90 | 177 + .../pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 | 360 + .../pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 | 79 + .../pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 | 392 + .../pp_waccm_tsmlt_sulfur/mo_indprd.F90 | 232 + .../pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 | 471 + .../pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 | 5864 + .../pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 | 1709 + .../pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 | 2450 + .../pp_waccm_tsmlt_sulfur/mo_phtadj.F90 | 33 + .../pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 | 816 + .../mo_rxt_rates_conv.F90 | 489 + .../pp_waccm_tsmlt_sulfur/mo_setrxt.F90 | 600 + .../pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 | 712 + src/chemistry/utils/aerodep_flx.F90 | 502 + src/chemistry/utils/aircraft_emit.F90 | 423 + src/chemistry/utils/apex.F90 | 2274 + .../utils/horizontal_interpolate.F90 | 246 + src/chemistry/utils/input_data_utils.F90 | 474 + src/chemistry/utils/m_types.F90 | 25 + src/chemistry/utils/mo_constants.F90 | 44 + src/chemistry/utils/mo_flbc.F90 | 834 + src/chemistry/utils/mo_msis_ubc.F90 | 284 + src/chemistry/utils/mo_util.F90 | 81 + src/chemistry/utils/modal_aero_calcsize.F90 | 1589 + src/chemistry/utils/modal_aero_deposition.F90 | 330 + .../utils/modal_aero_wateruptake.F90 | 1088 + src/chemistry/utils/msise00.F90 | 3052 + src/chemistry/utils/prescribed_aero.F90 | 668 + src/chemistry/utils/prescribed_ghg.F90 | 326 + src/chemistry/utils/prescribed_ozone.F90 | 293 + src/chemistry/utils/prescribed_strataero.F90 | 507 + src/chemistry/utils/prescribed_volcaero.F90 | 324 + src/chemistry/utils/solar_data.F90 | 134 + src/chemistry/utils/solar_euv_data.F90 | 158 + src/chemistry/utils/solar_irrad_data.F90 | 272 + src/chemistry/utils/solar_parms_data.F90 | 143 + src/chemistry/utils/solar_wind_data.F90 | 131 + src/chemistry/utils/time_utils.F90 | 71 + src/chemistry/utils/tracer_data.F90 | 2400 + src/control/cam_comp.F90 | 473 + src/control/cam_control_mod.F90 | 175 + src/control/cam_history.F90 | 5863 + src/control/cam_history_buffers.F90 | 543 + src/control/cam_history_support.F90 | 1987 + src/control/cam_initfiles.F90 | 307 + src/control/cam_instance.F90 | 31 + src/control/cam_logfile.F90 | 37 + src/control/cam_restart.F90 | 186 + src/control/camsrfexch.F90 | 579 + src/control/filenames.F90 | 205 + src/control/history_defaults.F90 | 143 + src/control/history_scam.F90 | 106 + src/control/ncdio_atm.F90 | 903 + src/control/runtime_opts.F90 | 194 + src/control/sat_hist.F90 | 1220 + src/control/scamMod.F90 | 312 + src/cpl/atm_comp_mct.F90 | 849 + src/cpl/atm_import_export.F90 | 284 + src/cpl/cam_cpl_indices.F90 | 209 + src/dynamics/eul/bndexch.F90 | 248 + src/dynamics/eul/commap.F90 | 23 + src/dynamics/eul/comspe.F90 | 43 + src/dynamics/eul/comsta.h | 15 + src/dynamics/eul/courlim.F90 | 170 + src/dynamics/eul/cubxdr.F90 | 80 + src/dynamics/eul/cubydr.F90 | 130 + src/dynamics/eul/cubzdr.F90 | 99 + src/dynamics/eul/diag_dynvar_ic.F90 | 67 + src/dynamics/eul/dp_coupling.F90 | 474 + src/dynamics/eul/dycore.F90 | 28 + src/dynamics/eul/dyn.F90 | 124 + src/dynamics/eul/dyn_comp.F90 | 1113 + src/dynamics/eul/dyn_grid.F90 | 1198 + src/dynamics/eul/dyndrv.F90 | 142 + src/dynamics/eul/dynpkg.F90 | 153 + src/dynamics/eul/eul_control_mod.F90 | 55 + src/dynamics/eul/getinterpnetcdfdata.F90 | 358 + src/dynamics/eul/grcalc.F90 | 513 + src/dynamics/eul/grmult.F90 | 322 + src/dynamics/eul/hdinti.F90 | 80 + src/dynamics/eul/herxin.F90 | 143 + src/dynamics/eul/heryin.F90 | 129 + src/dynamics/eul/herzin.F90 | 107 + src/dynamics/eul/hordif.F90 | 154 + src/dynamics/eul/hrintp.F90 | 139 + src/dynamics/eul/interp_mod.F90 | 65 + src/dynamics/eul/iop.F90 | 1153 + src/dynamics/eul/lagyin.F90 | 151 + src/dynamics/eul/limdx.F90 | 100 + src/dynamics/eul/limdy.F90 | 126 + src/dynamics/eul/limdz.F90 | 96 + src/dynamics/eul/linemsdyn.F90 | 563 + src/dynamics/eul/massfix.F90 | 37 + src/dynamics/eul/parslt.h | 13 + src/dynamics/eul/pmgrid.F90 | 29 + src/dynamics/eul/prognostics.F90 | 113 + src/dynamics/eul/pspect.F90 | 18 + src/dynamics/eul/quad.F90 | 278 + src/dynamics/eul/realloc4.F90 | 423 + src/dynamics/eul/realloc7.F90 | 213 + src/dynamics/eul/restart_dynamics.F90 | 557 + src/dynamics/eul/scan2.F90 | 774 + src/dynamics/eul/scandyn.F90 | 207 + src/dynamics/eul/scanslt.F90 | 1430 + src/dynamics/eul/scmforecast.F90 | 562 + src/dynamics/eul/settau.F90 | 543 + src/dynamics/eul/spegrd.F90 | 512 + src/dynamics/eul/spetru.F90 | 1287 + src/dynamics/eul/sphdep.F90 | 765 + src/dynamics/eul/spmd_dyn.F90 | 1111 + src/dynamics/eul/stats.F90 | 110 + src/dynamics/eul/stepon.F90 | 371 + src/dynamics/eul/tfilt_massfix.F90 | 489 + src/dynamics/eul/trjmps.F90 | 71 + src/dynamics/eul/tstep.F90 | 153 + src/dynamics/fv/FVperf_module.F90 | 156 + src/dynamics/fv/advect_tend.F90 | 74 + src/dynamics/fv/benergy.F90 | 346 + src/dynamics/fv/cd_core.F90 | 1967 + src/dynamics/fv/commap.F90 | 17 + src/dynamics/fv/ctem.F90 | 606 + src/dynamics/fv/d2a3dijk.F90 | 267 + src/dynamics/fv/d2a3dikj.F90 | 357 + src/dynamics/fv/diag_dynvar_ic.F90 | 110 + src/dynamics/fv/diag_module.F90 | 582 + src/dynamics/fv/dp_coupling.F90 | 978 + src/dynamics/fv/dryairm.F90 | 232 + src/dynamics/fv/dycore.F90 | 30 + src/dynamics/fv/dyn_comp.F90 | 3187 + src/dynamics/fv/dyn_grid.F90 | 1158 + src/dynamics/fv/dyn_internal_state.F90 | 52 + src/dynamics/fv/dynamics_vars.F90 | 1090 + src/dynamics/fv/epvd.F90 | 273 + src/dynamics/fv/fill_module.F90 | 622 + src/dynamics/fv/fv_prints.F90 | 441 + src/dynamics/fv/geopk.F90 | 1053 + src/dynamics/fv/gravity_waves_sources.F90 | 297 + src/dynamics/fv/interp_mod.F90 | 65 + src/dynamics/fv/mapz_module.F90 | 1285 + src/dynamics/fv/mean_module.F90 | 208 + src/dynamics/fv/metdata.F90 | 1996 + src/dynamics/fv/p_d_adjust.F90 | 350 + src/dynamics/fv/par_vecsum.F90 | 110 + src/dynamics/fv/par_xsum.F90 | 238 + src/dynamics/fv/pfixer.F90 | 577 + src/dynamics/fv/pft_module.F90 | 432 + src/dynamics/fv/pkez.F90 | 231 + src/dynamics/fv/pmgrid.F90 | 31 + src/dynamics/fv/restart_dynamics.F90 | 502 + src/dynamics/fv/spmd_dyn.F90 | 1044 + src/dynamics/fv/stepon.F90 | 495 + src/dynamics/fv/sw_core.F90 | 1662 + src/dynamics/fv/te_map.F90 | 1200 + src/dynamics/fv/tp_core.F90 | 2610 + src/dynamics/fv/trac2d.F90 | 433 + src/dynamics/fv/uv3s_update.F90 | 214 + src/dynamics/fv/zonal_mean.F90 | 56 + src/dynamics/se/dp_coupling.F90 | 901 + src/dynamics/se/dp_mapping.F90 | 667 + src/dynamics/se/dycore.F90 | 26 + src/dynamics/se/dycore/bndry_mod.F90 | 960 + .../se/dycore/comp_ctr_vol_around_gll_pts.F90 | 2310 + src/dynamics/se/dycore/control_mod.F90 | 123 + .../se/dycore/coordinate_systems_mod.F90 | 919 + src/dynamics/se/dycore/cube_mod.F90 | 2332 + src/dynamics/se/dycore/derivative_mod.F90 | 2474 + src/dynamics/se/dycore/dimensions_mod.F90 | 127 + src/dynamics/se/dycore/dof_mod.F90 | 402 + src/dynamics/se/dycore/edge_mod.F90 | 2629 + src/dynamics/se/dycore/edgetype_mod.F90 | 94 + src/dynamics/se/dycore/element_mod.F90 | 378 + src/dynamics/se/dycore/fvm_analytic_mod.F90 | 1217 + .../se/dycore/fvm_consistent_se_cslam.F90 | 1947 + .../se/dycore/fvm_control_volume_mod.F90 | 312 + src/dynamics/se/dycore/fvm_mapping.F90 | 1152 + src/dynamics/se/dycore/fvm_mod.F90 | 862 + src/dynamics/se/dycore/fvm_overlap_mod.F90 | 877 + .../se/dycore/fvm_reconstruction_mod.F90 | 1753 + src/dynamics/se/dycore/gbarrier.c | 109 + src/dynamics/se/dycore/gbarrier_mod.F90 | 79 + src/dynamics/se/dycore/gbarriertype_mod.F90 | 8 + src/dynamics/se/dycore/global_norms_mod.F90 | 1042 + src/dynamics/se/dycore/gridgraph_mod.F90 | 555 + src/dynamics/se/dycore/hybrid_mod.F90 | 530 + src/dynamics/se/dycore/hybvcoord_mod.F90 | 28 + src/dynamics/se/dycore/interpolate_mod.F90 | 1828 + src/dynamics/se/dycore/ll_mod.F90 | 149 + src/dynamics/se/dycore/mass_matrix_mod.F90 | 120 + src/dynamics/se/dycore/mesh_mod.F90 | 1289 + src/dynamics/se/dycore/metagraph_mod.F90 | 375 + src/dynamics/se/dycore/namelist_mod.F90 | 193 + src/dynamics/se/dycore/parallel_mod.F90 | 246 + src/dynamics/se/dycore/params_mod.F90 | 11 + src/dynamics/se/dycore/prim_advance_mod.F90 | 2034 + src/dynamics/se/dycore/prim_advection_mod.F90 | 1124 + src/dynamics/se/dycore/prim_driver_mod.F90 | 598 + src/dynamics/se/dycore/prim_init.F90 | 394 + src/dynamics/se/dycore/prim_si_mod.F90 | 217 + src/dynamics/se/dycore/prim_state_mod.F90 | 251 + src/dynamics/se/dycore/quadrature_mod.F90 | 955 + src/dynamics/se/dycore/reduction_mod.F90 | 447 + src/dynamics/se/dycore/schedtype_mod.F90 | 59 + src/dynamics/se/dycore/schedule_mod.F90 | 714 + src/dynamics/se/dycore/spacecurve_mod.F90 | 1274 + src/dynamics/se/dycore/thread_mod.F90 | 74 + src/dynamics/se/dycore/time_mod.F90 | 133 + src/dynamics/se/dycore/vertremap_mod.F90 | 733 + src/dynamics/se/dycore/viscosity_mod.F90 | 873 + src/dynamics/se/dyn_comp.F90 | 2096 + src/dynamics/se/dyn_grid.F90 | 1572 + src/dynamics/se/gravity_waves_sources.F90 | 215 + src/dynamics/se/interp_mod.F90 | 769 + src/dynamics/se/native_mapping.F90 | 534 + src/dynamics/se/pmgrid.F90 | 15 + src/dynamics/se/restart_dynamics.F90 | 1048 + src/dynamics/se/spmd_dyn.F90 | 34 + src/dynamics/se/stepon.F90 | 382 + src/dynamics/se/test_fvm_mapping.F90 | 735 + src/dynamics/tests/dyn_tests_utils.F90 | 23 + src/dynamics/tests/inic_analytic.F90 | 570 + src/dynamics/tests/inic_analytic_utils.F90 | 126 + .../initial_conditions/ic_baroclinic.F90 | 689 + .../initial_conditions/ic_held_suarez.F90 | 155 + src/ionosphere/ionosphere_interface.F90 | 93 + src/ionosphere/waccmx/dpie_coupling.F90 | 911 + src/ionosphere/waccmx/edyn_esmf.F90 | 1061 + src/ionosphere/waccmx/edyn_geogrid.F90 | 73 + src/ionosphere/waccmx/edyn_init.F90 | 394 + src/ionosphere/waccmx/edyn_maggrid.F90 | 150 + src/ionosphere/waccmx/edyn_mpi.F90 | 2081 + src/ionosphere/waccmx/edyn_mud.F90 | 1403 + src/ionosphere/waccmx/edyn_mudcom.F90 | 2260 + src/ionosphere/waccmx/edyn_mudmod.F90 | 794 + src/ionosphere/waccmx/edyn_muh2cr.F90 | 2024 + src/ionosphere/waccmx/edyn_params.F90 | 53 + src/ionosphere/waccmx/edyn_solve.F90 | 916 + src/ionosphere/waccmx/edynamo.F90 | 2277 + src/ionosphere/waccmx/filter.F90 | 230 + src/ionosphere/waccmx/getapex.F90 | 341 + src/ionosphere/waccmx/heelis.F90 | 273 + .../waccmx/ionosphere_interface.F90 | 1143 + src/ionosphere/waccmx/oplus.F90 | 1756 + src/ionosphere/waccmx/savefield_waccm.F90 | 98 + src/ionosphere/waccmx/wei05sc.F90 | 1501 + src/physics/cam/CMakeLists.txt | 5 + src/physics/cam/aer_rad_props.F90 | 724 + src/physics/cam/aoa_tracers.F90 | 425 + src/physics/cam/beljaars_drag.F90 | 152 + src/physics/cam/beljaars_drag_cam.F90 | 154 + src/physics/cam/boundarydata.F90 | 936 + src/physics/cam/cam3_aero_data.F90 | 1021 + src/physics/cam/cam3_ozone_data.F90 | 220 + src/physics/cam/cam_diagnostics.F90 | 2214 + src/physics/cam/carma_flags_mod.F90 | 191 + src/physics/cam/carma_intr.F90 | 186 + src/physics/cam/carma_model_flags_mod.F90 | 85 + src/physics/cam/check_energy.F90 | 972 + src/physics/cam/chem_surfvals.F90 | 643 + src/physics/cam/cldfrc2m.F90 | 1158 + src/physics/cam/cldwat.F90 | 1286 + src/physics/cam/cldwat2m_macro.F90 | 2396 + src/physics/cam/cloud_cover_diags.F90 | 192 + src/physics/cam/cloud_diagnostics.F90 | 521 + src/physics/cam/cloud_fraction.F90 | 813 + src/physics/cam/clubb_intr.F90 | 3665 + src/physics/cam/cmparray_mod.F90 | 483 + src/physics/cam/co2_cycle.F90 | 340 + src/physics/cam/co2_data_flux.F90 | 409 + src/physics/cam/const_init.F90 | 223 + src/physics/cam/constituent_burden.F90 | 88 + src/physics/cam/constituents.F90 | 533 + src/physics/cam/conv_water.F90 | 435 + src/physics/cam/convect_deep.F90 | 318 + src/physics/cam/convect_shallow.F90 | 922 + src/physics/cam/cospsimulator_intr.F90 | 3543 + src/physics/cam/cpslec.F90 | 81 + src/physics/cam/dadadj.F90 | 174 + src/physics/cam/dadadj_cam.F90 | 137 + src/physics/cam/diffusion_solver.F90 | 989 + src/physics/cam/eddy_diff.F90 | 3326 + src/physics/cam/eddy_diff_cam.F90 | 955 + src/physics/cam/flux_avg.F90 | 224 + src/physics/cam/geopotential.F90 | 215 + src/physics/cam/ghg_data.F90 | 268 + src/physics/cam/gw_common.F90 | 983 + src/physics/cam/gw_convect.F90 | 327 + src/physics/cam/gw_diffusion.F90 | 192 + src/physics/cam/gw_drag.F90 | 2500 + src/physics/cam/gw_front.F90 | 209 + src/physics/cam/gw_oro.F90 | 177 + src/physics/cam/gw_rdg.F90 | 1048 + src/physics/cam/gw_utils.F90 | 77 + src/physics/cam/hb_diff.F90 | 690 + src/physics/cam/hetfrz_classnuc.F90 | 733 + src/physics/cam/hetfrz_classnuc_cam.F90 | 1365 + src/physics/cam/hk_conv.F90 | 1109 + src/physics/cam/iondrag.F90 | 97 + src/physics/cam/iop_forcing.F90 | 97 + src/physics/cam/macrop_driver.F90 | 1182 + src/physics/cam/micro_mg1_0.F90 | 3742 + src/physics/cam/micro_mg2_0.F90 | 3170 + src/physics/cam/micro_mg_cam.F90 | 3046 + src/physics/cam/micro_mg_data.F90 | 550 + src/physics/cam/micro_mg_utils.F90 | 1607 + src/physics/cam/microp_aero.F90 | 737 + src/physics/cam/microp_driver.F90 | 200 + src/physics/cam/modal_aer_opt.F90 | 1613 + src/physics/cam/molec_diff.F90 | 394 + src/physics/cam/ndrop.F90 | 1971 + src/physics/cam/ndrop_bam.F90 | 499 + src/physics/cam/nucleate_ice.F90 | 573 + src/physics/cam/nucleate_ice_cam.F90 | 856 + src/physics/cam/pbl_utils.F90 | 411 + src/physics/cam/phys_control.F90 | 399 + src/physics/cam/phys_debug.F90 | 424 + src/physics/cam/phys_debug_util.F90 | 129 + src/physics/cam/phys_gmean.F90 | 147 + src/physics/cam/phys_grid.F90 | 4934 + src/physics/cam/phys_prop.F90 | 1314 + src/physics/cam/physics_buffer.F90.in | 1714 + src/physics/cam/physics_types.F90 | 1943 + src/physics/cam/physpkg.F90 | 2374 + src/physics/cam/pkg_cld_sediment.F90 | 784 + src/physics/cam/pkg_cldoptics.F90 | 400 + src/physics/cam/polar_avg.F90 | 221 + src/physics/cam/ppgrid.F90 | 44 + src/physics/cam/qbo.F90 | 57 + src/physics/cam/qneg_module.F90 | 491 + src/physics/cam/rad_constituents.F90 | 2517 + src/physics/cam/radheat.F90 | 126 + src/physics/cam/radiation_data.F90 | 1179 + src/physics/cam/rayleigh_friction.F90 | 191 + src/physics/cam/ref_pres.F90 | 174 + src/physics/cam/restart_physics.F90 | 595 + src/physics/cam/rk_stratiform.F90 | 1220 + src/physics/cam/spcam_drivers.F90 | 54 + src/physics/cam/sslt_rebin.F90 | 142 + src/physics/cam/subcol.F90 | 500 + src/physics/cam/subcol_pack_mod.F90.in | 325 + src/physics/cam/subcol_tstcp.F90 | 393 + src/physics/cam/subcol_utils.F90.in | 1097 + src/physics/cam/tidal_diag.F90 | 233 + src/physics/cam/tracers.F90 | 454 + src/physics/cam/tracers_suite.F90 | 357 + src/physics/cam/trb_mtn_stress.F90 | 180 + src/physics/cam/trb_mtn_stress_cam.F90 | 158 + src/physics/cam/tropopause.F90 | 1512 + src/physics/cam/unicon.F90 | 10302 ++ src/physics/cam/unicon_cam.F90 | 1412 + src/physics/cam/unicon_utils.F90 | 1936 + src/physics/cam/uwshcu.F90 | 5111 + src/physics/cam/vdiff_lu_solver.F90 | 207 + src/physics/cam/vertical_diffusion.F90 | 1540 + src/physics/cam/waccmx_phys_intr.F90 | 101 + src/physics/cam/wv_sat_methods.F90 | 484 + src/physics/cam/wv_saturation.F90 | 802 + src/physics/cam/zm_conv.F90 | 4722 + src/physics/cam/zm_conv_intr.F90 | 1379 + src/physics/cam/zm_microphysics.F90 | 2445 + src/physics/camrt/rad_solar_var.F90 | 143 + src/physics/camrt/radae.F90 | 4237 + src/physics/camrt/radconstants.F90 | 308 + src/physics/camrt/radiation.F90 | 1339 + src/physics/camrt/radlw.F90 | 1114 + src/physics/camrt/radsw.F90 | 2285 + src/physics/carma/cam/carma_cloudfraction.F90 | 47 + src/physics/carma/cam/carma_constants_mod.F90 | 152 + src/physics/carma/cam/carma_getH2O.F90 | 40 + src/physics/carma/cam/carma_getH2SO4.F90 | 40 + src/physics/carma/cam/carma_getT.F90 | 40 + src/physics/carma/cam/carma_intr.F90 | 2723 + src/physics/carma/cam/carma_precision_mod.F90 | 38 + .../carma/models/bc_strat/carma_model_mod.F90 | 420 + .../models/cirrus/carma_cloudfraction.F90 | 142 + .../models/cirrus/carma_model_flags_mod.F90 | 79 + .../carma/models/cirrus/carma_model_mod.F90 | 2067 + src/physics/carma/models/cirrus/growevapl.F90 | 264 + .../cirrus_dust/carma_cloudfraction.F90 | 142 + .../carma/models/cirrus_dust/carma_mod.F90 | 1478 + .../cirrus_dust/carma_model_flags_mod.F90 | 82 + .../models/cirrus_dust/carma_model_mod.F90 | 2721 + .../carma/models/cirrus_dust/growevapl.F90 | 264 + .../carma/models/cirrus_dust/hetnucl.F90 | 178 + .../models/dust/carma_model_flags_mod.F90 | 79 + .../carma/models/dust/carma_model_mod.F90 | 828 + .../meteor_impact/carma_model_flags_mod.F90 | 99 + .../models/meteor_impact/carma_model_mod.F90 | 808 + .../meteor_smoke/carma_model_flags_mod.F90 | 86 + .../models/meteor_smoke/carma_model_mod.F90 | 768 + .../mixed_sulfate/carma_model_flags_mod.F90 | 89 + .../models/mixed_sulfate/carma_model_mod.F90 | 847 + .../models/pmc/carma_model_flags_mod.F90 | 89 + .../carma/models/pmc/carma_model_mod.F90 | 885 + .../pmc_sulfate/carma_model_flags_mod.F90 | 92 + .../models/pmc_sulfate/carma_model_mod.F90 | 956 + .../models/sea_salt/carma_model_flags_mod.F90 | 81 + .../carma/models/sea_salt/carma_model_mod.F90 | 820 + .../carma/models/sulfate/carma_model_mod.F90 | 453 + .../models/test_detrain/carma_model_mod.F90 | 475 + .../models/test_growth/carma_model_mod.F90 | 473 + .../models/test_passive/carma_model_mod.F90 | 392 + .../models/test_radiative/carma_model_mod.F90 | 400 + .../models/test_swelling/carma_model_mod.F90 | 401 + .../test_tracers/carma_model_flags_mod.F90 | 80 + .../models/test_tracers/carma_model_mod.F90 | 585 + .../test_tracers2/carma_model_flags_mod.F90 | 80 + .../models/test_tracers2/carma_model_mod.F90 | 593 + .../models/tholin/carma_model_flags_mod.F90 | 80 + .../carma/models/tholin/carma_model_mod.F90 | 643 + src/physics/cosp2/Makefile.in | 187 + src/physics/cosp2/cosp_errorHandling.F90 | 50 + src/physics/cosp2/cosp_kinds.F90 | 40 + src/physics/cosp2/optics/array_lib.F90 | 103 + src/physics/cosp2/optics/cosp_optics.F90 | 488 + src/physics/cosp2/optics/cosp_utils.F90 | 89 + src/physics/cosp2/optics/math_lib.F90 | 404 + src/physics/cosp2/optics/mrgrnk.F90 | 645 + src/physics/cosp2/optics/optics_lib.F90 | 771 + src/physics/cosp2/optics/quickbeam_optics.F90 | 1397 + src/physics/cosp2/subcol/mo_rng.F90 | 151 + src/physics/cosp2/subcol/prec_scops.F90 | 277 + src/physics/cosp2/subcol/scops.F90 | 240 + .../rrtmg/aer_src/mcica_subcol_gen_lw.f90 | 425 + .../rrtmg/aer_src/mcica_subcol_gen_sw.f90 | 461 + src/physics/rrtmg/aer_src/parrrsw.f90 | 123 + src/physics/rrtmg/aer_src/parrrtm.f90 | 111 + src/physics/rrtmg/aer_src/rrlw_con.f90 | 40 + src/physics/rrtmg/aer_src/rrlw_kg01.f90 | 74 + src/physics/rrtmg/aer_src/rrlw_kg02.f90 | 70 + src/physics/rrtmg/aer_src/rrlw_kg03.f90 | 75 + src/physics/rrtmg/aer_src/rrlw_kg04.f90 | 64 + src/physics/rrtmg/aer_src/rrlw_kg05.f90 | 76 + src/physics/rrtmg/aer_src/rrlw_kg06.f90 | 74 + src/physics/rrtmg/aer_src/rrlw_kg07.f90 | 76 + src/physics/rrtmg/aer_src/rrlw_kg08.f90 | 100 + src/physics/rrtmg/aer_src/rrlw_kg09.f90 | 78 + src/physics/rrtmg/aer_src/rrlw_kg10.f90 | 71 + src/physics/rrtmg/aer_src/rrlw_kg11.f90 | 79 + src/physics/rrtmg/aer_src/rrlw_kg12.f90 | 60 + src/physics/rrtmg/aer_src/rrlw_kg13.f90 | 76 + src/physics/rrtmg/aer_src/rrlw_kg14.f90 | 71 + src/physics/rrtmg/aer_src/rrlw_kg15.f90 | 65 + src/physics/rrtmg/aer_src/rrlw_kg16.f90 | 70 + src/physics/rrtmg/aer_src/rrlw_ref.f90 | 31 + src/physics/rrtmg/aer_src/rrlw_tbl.f90 | 47 + src/physics/rrtmg/aer_src/rrlw_wvn.f90 | 76 + src/physics/rrtmg/aer_src/rrsw_con.f90 | 40 + src/physics/rrtmg/aer_src/rrsw_kg16.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg17.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg18.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg19.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg20.f90 | 69 + src/physics/rrtmg/aer_src/rrsw_kg21.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg22.f90 | 65 + src/physics/rrtmg/aer_src/rrsw_kg23.f90 | 64 + src/physics/rrtmg/aer_src/rrsw_kg24.f90 | 77 + src/physics/rrtmg/aer_src/rrsw_kg25.f90 | 63 + src/physics/rrtmg/aer_src/rrsw_kg26.f90 | 48 + src/physics/rrtmg/aer_src/rrsw_kg27.f90 | 63 + src/physics/rrtmg/aer_src/rrsw_kg28.f90 | 57 + src/physics/rrtmg/aer_src/rrsw_kg29.f90 | 69 + src/physics/rrtmg/aer_src/rrsw_ref.f90 | 29 + src/physics/rrtmg/aer_src/rrsw_tbl.f90 | 42 + src/physics/rrtmg/aer_src/rrsw_wvn.f90 | 57 + src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 | 1988 + src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 | 76246 ++++++++++ src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 | 668 + src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 | 504 + .../rrtmg/aer_src/rrtmg_lw_setcoef.f90 | 1266 + src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 | 3164 + .../rrtmg/aer_src/rrtmg_sw_cldprmc.f90 | 119 + src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 | 1407 + src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 | 63576 +++++++++ src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 | 882 + src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 | 296 + .../rrtmg/aer_src/rrtmg_sw_setcoef.f90 | 346 + src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 | 726 + src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 | 1490 + src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 | 161 + src/physics/rrtmg/cloud_rad_props.F90 | 773 + src/physics/rrtmg/ebert_curry.F90 | 408 + src/physics/rrtmg/oldcloud.F90 | 643 + src/physics/rrtmg/rad_solar_var.F90 | 152 + src/physics/rrtmg/radconstants.F90 | 255 + src/physics/rrtmg/radiation.F90 | 1403 + src/physics/rrtmg/radlw.F90 | 302 + src/physics/rrtmg/radsw.F90 | 663 + src/physics/rrtmg/rrtmg_state.F90 | 272 + src/physics/rrtmg/slingo.F90 | 409 + src/physics/simple/held_suarez.F90 | 166 + src/physics/simple/held_suarez_cam.F90 | 114 + src/physics/simple/kessler_cam.F90 | 196 + src/physics/simple/kessler_mod.F90 | 251 + src/physics/simple/physpkg.F90 | 788 + src/physics/simple/radconstants.F90 | 40 + src/physics/simple/radiation.F90 | 57 + src/physics/simple/restart_physics.F90 | 115 + .../crm/ADV_MPDATA/crmx_advect_scalar.F90 | 47 + .../crm/ADV_MPDATA/crmx_advect_scalar2D.F90 | 182 + .../crm/ADV_MPDATA/crmx_advect_scalar3D.F90 | 302 + .../spcam/crm/ADV_MPDATA/crmx_advection.F90 | 3 + .../spcam/crm/CLUBB/crmx_Skw_module.F90 | 71 + .../spcam/crm/CLUBB/crmx_T_in_K_module.F90 | 86 + .../crm/CLUBB/crmx_advance_helper_module.F90 | 136 + .../crmx_advance_windm_edsclrm_module.F90 | 1909 + .../crm/CLUBB/crmx_advance_wp2_wp3_module.F90 | 4427 + .../crm/CLUBB/crmx_advance_xm_wpxp_module.F90 | 3213 + .../CLUBB/crmx_advance_xp2_xpyp_module.F90 | 3417 + src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 | 228 + .../spcam/crm/CLUBB/crmx_array_index.F90 | 37 + src/physics/spcam/crm/CLUBB/crmx_calendar.F90 | 250 + .../spcam/crm/CLUBB/crmx_clip_explicit.F90 | 859 + .../crm/CLUBB/crmx_clip_semi_implicit.F90 | 660 + .../spcam/crm/CLUBB/crmx_clubb_core.F90 | 3105 + .../spcam/crm/CLUBB/crmx_clubb_precision.F90 | 24 + .../spcam/crm/CLUBB/crmx_constants_clubb.F90 | 375 + .../crm/CLUBB/crmx_corr_matrix_module.F90 | 181 + .../CLUBB/crmx_csr_matrix_class_3array.F90 | 522 + .../crmx_diagnose_correlation_module.f90 | 489 + .../spcam/crm/CLUBB/crmx_diffusion.F90 | 800 + src/physics/spcam/crm/CLUBB/crmx_endian.F90 | 173 + .../spcam/crm/CLUBB/crmx_error_code.F90 | 227 + .../spcam/crm/CLUBB/crmx_extrapolation.F90 | 90 + .../spcam/crm/CLUBB/crmx_file_functions.F90 | 156 + .../spcam/crm/CLUBB/crmx_fill_holes.F90 | 487 + .../spcam/crm/CLUBB/crmx_gmres_cache.F90 | 171 + .../spcam/crm/CLUBB/crmx_gmres_wrap.F90 | 391 + .../spcam/crm/CLUBB/crmx_grid_class.F90 | 2036 + .../crm/CLUBB/crmx_hydrostatic_module.F90 | 746 + .../CLUBB/crmx_hyper_diffusion_4th_ord.F90 | 1685 + .../spcam/crm/CLUBB/crmx_input_names.F90 | 81 + .../spcam/crm/CLUBB/crmx_input_reader.F90 | 857 + .../spcam/crm/CLUBB/crmx_interpolation.F90 | 620 + .../spcam/crm/CLUBB/crmx_lapack_wrap.F90 | 740 + .../crm/CLUBB/crmx_matrix_operations.F90 | 540 + src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 | 505 + .../spcam/crm/CLUBB/crmx_mixing_length.F90 | 817 + .../spcam/crm/CLUBB/crmx_model_flags.F90 | 401 + .../crm/CLUBB/crmx_mono_flux_limiter.F90 | 1838 + src/physics/spcam/crm/CLUBB/crmx_mt95.f90 | 1317 + .../spcam/crm/CLUBB/crmx_numerical_check.F90 | 1072 + .../spcam/crm/CLUBB/crmx_output_grads.F90 | 754 + .../spcam/crm/CLUBB/crmx_output_netcdf.F90 | 835 + .../crm/CLUBB/crmx_parameter_indices.F90 | 108 + .../crm/CLUBB/crmx_parameters_microphys.F90 | 191 + .../spcam/crm/CLUBB/crmx_parameters_model.F90 | 160 + .../crm/CLUBB/crmx_parameters_radiation.F90 | 78 + .../crm/CLUBB/crmx_parameters_tunable.F90 | 1246 + .../crm/CLUBB/crmx_pdf_closure_module.F90 | 1208 + .../crm/CLUBB/crmx_pdf_parameter_module.F90 | 58 + .../crm/CLUBB/crmx_pos_definite_module.F90 | 220 + .../spcam/crm/CLUBB/crmx_saturation.F90 | 789 + .../crm/CLUBB/crmx_sigma_sqd_w_module.F90 | 64 + .../crm/CLUBB/crmx_sponge_layer_damping.F90 | 211 + .../spcam/crm/CLUBB/crmx_stat_file_module.F90 | 94 + .../spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 | 106 + .../spcam/crm/CLUBB/crmx_stats_LH_zt.F90 | 478 + .../spcam/crm/CLUBB/crmx_stats_rad_zm.F90 | 157 + .../spcam/crm/CLUBB/crmx_stats_rad_zt.F90 | 163 + .../spcam/crm/CLUBB/crmx_stats_sfc.F90 | 469 + .../spcam/crm/CLUBB/crmx_stats_subs.F90 | 2679 + .../spcam/crm/CLUBB/crmx_stats_type.F90 | 524 + .../spcam/crm/CLUBB/crmx_stats_variables.F90 | 1116 + src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 | 1724 + src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 | 3221 + .../crm/CLUBB/crmx_surface_varnce_module.F90 | 409 + .../crmx_variables_diagnostic_module.F90 | 654 + .../crmx_variables_prognostic_module.F90 | 560 + .../CLUBB/crmx_variables_radiation_module.F90 | 203 + src/physics/spcam/crm/CLUBB/recl.inc | 26 + .../spcam/crm/MICRO_M2005/README.MICRO_M2005 | 121 + .../crm/MICRO_M2005/crmx_drop_activation.F90 | 373 + .../crm/MICRO_M2005/crmx_microphysics.F90 | 1660 + .../MICRO_M2005/crmx_module_mp_graupel.F90 | 6884 + .../spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 | 133 + .../crm/MICRO_SAM1MOM/crmx_micro_params.F90 | 88 + .../crm/MICRO_SAM1MOM/crmx_microphysics.F90 | 463 + .../crm/MICRO_SAM1MOM/crmx_precip_init.F90 | 117 + .../crm/MICRO_SAM1MOM/crmx_precip_proc.F90 | 136 + .../MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 | 202 + ...eadme_codes_merging_sam6.8.2_sam6.10.4.txt | 141 + .../crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 | 2366 + .../SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 | 60 + .../crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 | 115 + .../crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 | 24 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 | 128 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 | 57 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 | 125 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 | 164 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 | 82 + .../SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 | 134 + .../SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 | 46 + .../SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 | 103 + .../crmx_diffuse_scalar2D_xy.F90 | 79 + .../crmx_diffuse_scalar2D_z.F90 | 66 + .../SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 | 177 + .../crmx_diffuse_scalar3D_xy.F90 | 146 + .../crmx_diffuse_scalar3D_z.F90 | 76 + .../crmx_diffuse_scalar_xy.F90 | 53 + .../SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 | 70 + .../SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 | 64 + .../spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 | 661 + .../crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 | 109 + .../crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 | 155 + .../crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 | 1479 + .../crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 | 147 + .../spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 | 20 + .../spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 | 114 + .../spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 | 150 + .../spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 | 42 + .../crm/SGS_TKE/crmx_diffuse_scalar2D.F90 | 103 + .../crm/SGS_TKE/crmx_diffuse_scalar3D.F90 | 177 + src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 | 422 + .../spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 | 109 + .../spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 | 155 + .../spcam/crm/SGS_TKE/crmx_tke_full.F90 | 147 + src/physics/spcam/crm/crmx_abcoefs.F90 | 28 + src/physics/spcam/crm/crmx_adams.F90 | 45 + src/physics/spcam/crm/crmx_advect2_mom_xy.F90 | 95 + src/physics/spcam/crm/crmx_advect2_mom_z.F90 | 93 + .../spcam/crm/crmx_advect_all_scalars.F90 | 73 + src/physics/spcam/crm/crmx_advect_mom.F90 | 19 + src/physics/spcam/crm/crmx_atmosphere.F90 | 71 + src/physics/spcam/crm/crmx_bound_duvdt.F90 | 28 + src/physics/spcam/crm/crmx_bound_exchange.F90 | 206 + src/physics/spcam/crm/crmx_boundaries.F90 | 20 + src/physics/spcam/crm/crmx_buoyancy.F90 | 34 + src/physics/spcam/crm/crmx_compress3D.F90 | 165 + src/physics/spcam/crm/crmx_coriolis.F90 | 48 + src/physics/spcam/crm/crmx_crm_module.F90 | 1792 + src/physics/spcam/crm/crmx_crmsurface.F90 | 155 + src/physics/spcam/crm/crmx_crmtracers.F90 | 142 + src/physics/spcam/crm/crmx_damping.F90 | 68 + src/physics/spcam/crm/crmx_diagnose.F90 | 197 + src/physics/spcam/crm/crmx_domain.F90 | 33 + src/physics/spcam/crm/crmx_ecppvars.F90 | 52 + src/physics/spcam/crm/crmx_forcing.F90 | 48 + src/physics/spcam/crm/crmx_grid.F90 | 167 + src/physics/spcam/crm/crmx_ice_fall.F90 | 124 + src/physics/spcam/crm/crmx_kurant.F90 | 56 + .../spcam/crm/crmx_module_ecpp_crm_driver.F90 | 773 + .../spcam/crm/crmx_module_ecpp_stats.F90 | 1805 + src/physics/spcam/crm/crmx_params.F90 | 180 + src/physics/spcam/crm/crmx_periodic.F90 | 107 + src/physics/spcam/crm/crmx_precip_fall.F90 | 229 + src/physics/spcam/crm/crmx_press_grad.F90 | 69 + src/physics/spcam/crm/crmx_press_rhs.F90 | 105 + src/physics/spcam/crm/crmx_pressure.F90 | 517 + src/physics/spcam/crm/crmx_random.F90 | 62 + src/physics/spcam/crm/crmx_sat.F90 | 122 + src/physics/spcam/crm/crmx_setparm.F90 | 140 + src/physics/spcam/crm/crmx_setperturb.F90 | 59 + src/physics/spcam/crm/crmx_stepout.F90 | 196 + src/physics/spcam/crm/crmx_task_init.F90 | 69 + .../spcam/crm/crmx_task_util_NOMPI.F90 | 230 + src/physics/spcam/crm/crmx_utils.F90 | 145 + src/physics/spcam/crm/crmx_uvw.F90 | 13 + src/physics/spcam/crm/crmx_vars.F90 | 259 + src/physics/spcam/crm/crmx_zero.F90 | 16 + src/physics/spcam/crm/fft.F | 787 + src/physics/spcam/crm/gammafff.c | 18 + src/physics/spcam/crm_physics.F90 | 2480 + src/physics/spcam/crmclouds_camaerosols.F90 | 744 + src/physics/spcam/crmdims.F90 | 11 + .../spcam/ecpp/ecpp_modal_aero_activate.F90 | 660 + .../spcam/ecpp/ecpp_modal_cloudchem.F90 | 700 + src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 | 1898 + src/physics/spcam/ecpp/module_data_ecpp1.F90 | 229 + .../spcam/ecpp/module_data_mosaic_asect.F90 | 131 + src/physics/spcam/ecpp/module_data_radm2.F90 | 178 + .../spcam/ecpp/module_ecpp_ppdriver2.F90 | 1454 + src/physics/spcam/ecpp/module_ecpp_td2clm.F90 | 5149 + src/physics/spcam/ecpp/module_ecpp_util.F90 | 112 + src/physics/spcam/spcam_drivers.F90 | 2396 + src/physics/waccm/efield.F90 | 1575 + src/physics/waccm/exbdrift.F90 | 419 + src/physics/waccm/iondrag.F90 | 1415 + src/physics/waccm/mag_parms.F90 | 80 + src/physics/waccm/mo_aurora.F90 | 1178 + src/physics/waccm/nlte_fomichev.F90 | 2559 + src/physics/waccm/nlte_lw.F90 | 360 + src/physics/waccm/qbo.F90 | 972 + src/physics/waccm/radheat.F90 | 424 + src/physics/waccm/waccm_forcing.F90 | 288 + src/physics/waccm/wei05sc.F90 | 10 + src/physics/waccm/wei96.F90 | 1059 + src/physics/waccmx/ion_electron_temp.F90 | 1422 + src/physics/waccmx/majorsp_diffusion.F90 | 858 + src/unit_drivers/aur/unit_driver.F90 | 157 + src/unit_drivers/drv_input_data.F90 | 319 + src/unit_drivers/offline_driver.F90 | 186 + src/unit_drivers/rad/README | 12 + src/unit_drivers/rad/unit_driver.F90 | 109 + src/unit_drivers/stub/unit_driver.F90 | 46 + src/utils/CMakeLists.txt | 4 + src/utils/bnddyi.F90 | 60 + src/utils/buffer.F90.in | 284 + src/utils/cam_abortutils.F90 | 11 + src/utils/cam_aqua/cpl/ocn_comp_mct.F90 | 328 + src/utils/cam_aqua/ocn_comp.F90 | 350 + src/utils/cam_aqua/ocn_types.F90 | 12 + src/utils/cam_dom/ocn_comp.F90 | 536 + src/utils/cam_dom/ocn_comp_mct.F90 | 432 + src/utils/cam_dom/ocn_filenames.F90 | 136 + src/utils/cam_dom/ocn_spmd.F90 | 66 + src/utils/cam_dom/ocn_time_manager.F90 | 1229 + src/utils/cam_dom/ocn_types.F90 | 31 + src/utils/cam_dom/sst_data.F90 | 714 + src/utils/cam_grid_support.F90 | 4206 + src/utils/cam_map_utils.F90 | 1217 + src/utils/cam_pio_utils.F90 | 1692 + src/utils/coords_1d.F90 | 151 + src/utils/datetime.F90 | 53 + src/utils/dtypes.h | 5 + src/utils/error_messages.F90 | 151 + src/utils/fft99.F90 | 1264 + src/utils/gauaw_mod.F90 | 252 + src/utils/gmean_mod.F90 | 310 + src/utils/hycoef.F90 | 394 + src/utils/infnan.F90 | 33 + src/utils/interpolate_data.F90 | 1230 + src/utils/intp_util.F90 | 53 + src/utils/ioFileMod.F90 | 182 + src/utils/linear_1d_operators.F90 | 1180 + src/utils/marsaglia.F90 | 43 + src/utils/mpishorthand.F | 45 + src/utils/namelist_utils.F90 | 6 + src/utils/orbit.F90 | 56 + src/utils/physconst.F90 | 404 + src/utils/pilgrim/Makefile | 104 + src/utils/pilgrim/Makefile.conf.AIX | 45 + src/utils/pilgrim/Makefile.conf.IRIX64 | 45 + src/utils/pilgrim/Makefile.conf.Linux | 46 + src/utils/pilgrim/Makefile.conf.Linux.FFC | 46 + src/utils/pilgrim/Makefile.conf.Linux.LF95 | 42 + src/utils/pilgrim/Makefile.conf.Linux.PGI | 45 + src/utils/pilgrim/README | 71 + src/utils/pilgrim/configure | 51 + src/utils/pilgrim/debug.h | 60 + src/utils/pilgrim/debugutilitiesmodule.F90 | 253 + src/utils/pilgrim/decompmodule.F90 | 1767 + src/utils/pilgrim/ghostmodule.F90 | 1049 + src/utils/pilgrim/memstuff.c | 279 + src/utils/pilgrim/mlp_ptr.h | 60 + src/utils/pilgrim/mod_comm.F90 | 6717 + src/utils/pilgrim/mp_assign_to_cpu.c | 291 + src/utils/pilgrim/parutilitiesmodule.F90 | 5104 + src/utils/pilgrim/pilgrim.h | 27 + src/utils/pilgrim/puminterfaces.F90 | 225 + src/utils/pilgrim/redistributemodule.F90 | 506 + src/utils/pilgrim/unit_testers/Makefile | 50 + src/utils/pilgrim/unit_testers/README | 54 + src/utils/pilgrim/unit_testers/decomptest.F90 | 281 + src/utils/pilgrim/unit_testers/ghosttest.F90 | 539 + .../pilgrim/unit_testers/parpatterntest.F90 | 474 + .../pilgrim/unit_testers/parutilitiestest.F90 | 477 + .../pilgrim/unit_testers/redistributetest.F90 | 451 + .../pilgrim/unit_testers/unstructured.F90 | 220 + src/utils/quicksort.F90 | 110 + src/utils/sgexx.F90 | 11089 ++ src/utils/spmd_utils.F90 | 1665 + src/utils/srchutil.F90 | 57 + src/utils/string_utils.F90 | 243 + src/utils/time_manager.F90 | 1154 + src/utils/units.F90 | 36 + src/utils/vrtmap.F90 | 77 + src/utils/wrap_mpi.F90 | 1302 + src/utils/wrap_nf.F90 | 921 + src/utils/xpavg_mod.F90 | 57 + test/system/CAM_compare.sh | 39 + test/system/CAM_runcmnd.sh | 60 + test/system/CAM_utils.sh | 46 + test/system/TBL.sh | 144 + test/system/TBL_ccsm.sh | 147 + test/system/TBR.sh | 253 + test/system/TCB.sh | 120 + test/system/TCB_ccsm.sh | 145 + test/system/TDD.sh | 65 + test/system/TEQ.sh | 98 + test/system/TEQ_ccsm.sh | 127 + test/system/TER.sh | 240 + test/system/TER_ccsm.sh | 147 + test/system/TFM.sh | 97 + test/system/TGIT.sh | 90 + test/system/TMC.sh | 85 + test/system/TNE_ccsm.sh | 101 + test/system/TPF.sh | 125 + test/system/TR8.sh | 125 + test/system/TSC.sh | 94 + test/system/TSM.sh | 182 + test/system/TSM_ccsm.sh | 121 + test/system/archive_baseline.sh | 183 + test/system/config_files/e48adh | 6 + test/system/config_files/e48c4paqdm | 8 + test/system/config_files/e48idh | 6 + test/system/config_files/e64addh | 6 + test/system/config_files/e64adh | 5 + test/system/config_files/e64c4aqiopdm | 8 + test/system/config_files/e64c5aqiopdm | 8 + test/system/config_files/e64c6aqiopdm | 9 + test/system/config_files/e64hsdh | 6 + test/system/config_files/e8c3aqdm | 7 + test/system/config_files/e8c4aqdm | 7 + test/system/config_files/e8c5aqt5mdm | 9 + test/system/config_files/e8idm | 6 + test/system/config_files/f1.9c4aqbamm | 7 + test/system/config_files/f1.9c4aqh | 7 + test/system/config_files/f1.9c4aqmozdh | 8 + test/system/config_files/f1.9c4aqwmxdh | 9 + test/system/config_files/f1.9c4aqwmxidh | 10 + test/system/config_files/f1.9c4cdm | 7 + test/system/config_files/f1.9c4h | 5 + test/system/config_files/f1.9c4portdh | 7 + test/system/config_files/f1.9c4portdm | 7 + test/system/config_files/f1.9c4wmdh | 7 + test/system/config_files/f1.9c4wmh | 6 + test/system/config_files/f1.9c4wmm | 6 + test/system/config_files/f1.9c4wscdm | 7 + test/system/config_files/f1.9c4wtsmltdh | 8 + test/system/config_files/f1.9c4wtsmlth | 6 + test/system/config_files/f1.9c5aqm | 6 + test/system/config_files/f1.9c5carmdusdm | 7 + test/system/config_files/f1.9c5carmdusm | 6 + test/system/config_files/f1.9c6aqcdh | 8 + test/system/config_files/f1.9c6aqcdm | 8 + test/system/config_files/f1.9c6aqtsvbsdh | 8 + test/system/config_files/f1.9c6aqwmth | 7 + test/system/config_files/f1.9c6aqwscdh | 9 + test/system/config_files/f10adhterm | 7 + test/system/config_files/f10c3aqdm | 7 + test/system/config_files/f10c4aqwmxdm | 9 + test/system/config_files/f10c4aqwscdm | 8 + test/system/config_files/f10c5aqcdm | 8 + test/system/config_files/f10c5aqcmtt1dm | 8 + test/system/config_files/f10c5aqdm | 7 + test/system/config_files/f10c5aqpbadm | 8 + test/system/config_files/f10c5aqscdm | 8 + test/system/config_files/f10c5aqt5mdm | 9 + test/system/config_files/f10c5aqudm | 8 + test/system/config_files/f10c6aqcdm | 8 + test/system/config_files/f10c6aqdm | 7 + test/system/config_files/f10c6aqt5mdm | 9 + test/system/config_files/f10c6aqtsvbsdm | 8 + test/system/config_files/f10c6aqwmadm | 8 + test/system/config_files/f10idm | 6 + test/system/config_files/f10spmaqdm | 11 + test/system/config_files/f10spsaqdm | 13 + test/system/config_files/f4adh | 6 + test/system/config_files/f4c4aqdh | 7 + test/system/config_files/f4c4aqprgspcdm | 8 + test/system/config_files/f4c4aqwmxdm | 9 + test/system/config_files/f4c4aqwmxidm | 10 + test/system/config_files/f4c4aqwmxiedm | 11 + test/system/config_files/f4c4paqdh | 8 + test/system/config_files/f4c4wtsmltdh | 8 + test/system/config_files/f4c5dh | 6 + test/system/config_files/f4c5portdh | 8 + test/system/config_files/f4c5portdm | 8 + test/system/config_files/f4c6aqwmadm | 8 + test/system/config_files/f4c6aqwmtdm | 8 + test/system/config_files/f4idm | 6 + test/system/config_files/fsd1.9c4mozdh | 9 + test/system/config_files/fsd1.9c4wmdh | 9 + test/system/config_files/fsd1.9c4wmh | 9 + test/system/config_files/fsd1.9c4wtsmltdh | 10 + test/system/config_files/fsd1.9c4wtsmlth | 9 + test/system/config_files/h16.3c4aqdm | 7 + test/system/config_files/h16.3c5aqt5dh | 8 + test/system/config_files/h16adh | 6 + test/system/config_files/h16adtermdh | 7 + test/system/config_files/h16c3aqdh | 9 + test/system/config_files/h16c4aqdm | 7 + test/system/config_files/h16c5aqdm | 7 + test/system/config_files/h16c5naqdm | 10 + test/system/config_files/h16c6aqdm | 7 + test/system/config_files/h16c6aqh | 7 + test/system/config_files/h16idm | 7 + test/system/config_files/h16kstich | 7 + test/system/config_files/h30c4aqdm | 9 + test/system/config_files/h5.2addm | 6 + test/system/config_files/h5.3addm | 6 + test/system/config_files/h5.3adds | 6 + test/system/config_files/h5.3adicdm | 7 + test/system/config_files/h5.3c5aqdm | 7 + test/system/config_files/h5.3c5aqt5mdm | 9 + test/system/config_files/h5.4addm | 6 + test/system/config_files/h5addm | 6 + test/system/config_files/h5adds | 6 + test/system/config_files/h5adicdm | 7 + test/system/config_files/h5c5aqbamdm | 8 + test/system/config_files/h5c5aqdm | 7 + test/system/config_files/h5c5aqt5mdm | 9 + test/system/config_files/scmc4aqds | 8 + test/system/config_files/scmc5aqds | 8 + test/system/config_files/scmc6aqds | 9 + test/system/config_files/testmech | 349 + test/system/find_mergeinfo.sh | 113 + test/system/gen-test-coverage | 257 + test/system/gen-test-style.css | 18 + test/system/gen-test-table | 192 + test/system/input_tests_master | 357 + test/system/nl_files/adia | 6 + test/system/nl_files/aqpgro | 10 + test/system/nl_files/aqua | 9 + test/system/nl_files/co2rmp | 19 + test/system/nl_files/fcase | 8 + test/system/nl_files/ghgrmp | 35 + test/system/nl_files/ghgrmp_e8 | 36 + test/system/nl_files/ghgrmp_f4 | 35 + test/system/nl_files/ghgrmp_unstruct | 44 + test/system/nl_files/idphys | 7 + test/system/nl_files/outfrq1m | 5 + test/system/nl_files/outfrq1s | 6 + test/system/nl_files/outfrq1s_carma | 15 + test/system/nl_files/outfrq1s_clubb | 12 + test/system/nl_files/outfrq1s_hist | 19 + test/system/nl_files/outfrq24h | 5 + test/system/nl_files/outfrq24h_carma | 11 + test/system/nl_files/outfrq24h_epp | 9 + test/system/nl_files/outfrq24h_port | 18 + test/system/nl_files/outfrq3s | 10 + test/system/nl_files/outfrq3s_2005 | 13 + test/system/nl_files/outfrq3s_NEUwetdep | 11 + test/system/nl_files/outfrq3s_am | 18 + test/system/nl_files/outfrq3s_bwic | 11 + test/system/nl_files/outfrq3s_carma | 15 + test/system/nl_files/outfrq3s_carma2000 | 15 + test/system/nl_files/outfrq3s_carma_fractal | 16 + test/system/nl_files/outfrq3s_convmic | 11 + test/system/nl_files/outfrq3s_cosp | 9 + test/system/nl_files/outfrq3s_diags | 18 + test/system/nl_files/outfrq3s_epp | 19 + test/system/nl_files/outfrq3s_euv | 11 + test/system/nl_files/outfrq3s_f19c6aqwsc | 12 + test/system/nl_files/outfrq3s_gw_igw | 12 + test/system/nl_files/outfrq3s_gw_sh | 11 + test/system/nl_files/outfrq3s_ionos | 13 + test/system/nl_files/outfrq3s_lb0 | 11 + test/system/nl_files/outfrq3s_lb2 | 11 + test/system/nl_files/outfrq3s_megan | 11 + test/system/nl_files/outfrq3s_modalstrat | 12 + test/system/nl_files/outfrq3s_mozEOOH | 15 + test/system/nl_files/outfrq3s_neu | 11 + test/system/nl_files/outfrq3s_newyear | 11 + test/system/nl_files/outfrq3s_sd | 10 + test/system/nl_files/outfrq3s_subcol | 14 + test/system/nl_files/outfrq3s_sums | 28 + test/system/nl_files/outfrq3s_unstruct | 11 + test/system/nl_files/outfrq9s | 6 + test/system/nl_files/port_cam4 | 17 + test/system/nl_files/rad_diag | 49 + test/system/nl_files/rad_diag_mam | 46 + test/system/nl_files/sat_hist | 18 + test/system/nl_files/scm_b4b_o1 | 14 + test/system/nl_files/scm_prep | 8 + test/system/nl_files/scmarm | 12 + test/system/nl_files/terminator | 7 + test/system/nl_files/ttrac | 9 + test/system/nl_files/ttrac_lb0 | 9 + test/system/nl_files/ttrac_lb1 | 9 + test/system/nl_files/ttrac_lb2 | 9 + test/system/nl_files/ttrac_lb3 | 9 + test/system/nl_files/volc | 6 + test/system/tag_email.sh | 52 + test/system/test_driver.sh | 974 + test/system/tests_carma | 3 + test/system/tests_chem_hybrid | 2 + test/system/tests_chem_mpi | 4 + test/system/tests_pretag_cheyenne | 16 + test/system/tests_pretag_hobart_nag | 24 + test/system/tests_pretag_hobart_pgi | 15 + test/system/tests_pretag_leehill | 1 + test/system/tests_waccm_hybrid | 3 + test/system/tests_waccm_mpi | 8 + test/unit/CMakeLists.txt | 45 + test/unit/README.txt | 15 + test/unit/coords_1d/CMakeLists.txt | 14 + test/unit/coords_1d/test_coords_1d.pf | 117 + test/unit/linear_1d_operators/CMakeLists.txt | 21 + .../linear_1d_operators/test_arithmetic.pf | 227 + .../linear_1d_operators/test_derivatives.pf | 579 + .../unit/linear_1d_operators/test_diagonal.pf | 76 + test/unit/micro_mg_data/CMakeLists.txt | 14 + .../micro_mg_data/test_MGFieldPostProc.pf | 308 + test/unit/micro_mg_data/test_MGPacker.pf | 387 + test/unit/micro_mg_data/test_MGPostProc.pf | 147 + test/unit/micro_mg_utils/CMakeLists.txt | 21 + test/unit/micro_mg_utils/test_mg_processes.pf | 1654 + .../unit/micro_mg_utils/test_mg_size_utils.pf | 282 + test/unit/vdiff_lu_solver/CMakeLists.txt | 14 + test/unit/vdiff_lu_solver/test_fd_solver.pf | 272 + test/unit/vdiff_lu_solver/test_fv_solver.pf | 306 + tools/README | 45 + tools/definehires/Makefile | 127 + tools/definehires/README | 114 + tools/definehires/gtopo30_to_10min.F90 | 721 + tools/definehires/shr_kind_mod.F90 | 20 + tools/definesurf/Makefile | 144 + tools/definesurf/README | 156 + tools/definesurf/ao.f90 | 141 + tools/definesurf/ao_i.f90 | 178 + tools/definesurf/area_ave.f90 | 59 + tools/definesurf/binf2c.f90 | 218 + tools/definesurf/cell_area.f90 | 51 + tools/definesurf/chkdims.f90 | 52 + tools/definesurf/endrun.f90 | 7 + tools/definesurf/fmain.f90 | 458 + tools/definesurf/handle_error.f90 | 11 + tools/definesurf/inimland.f90 | 205 + tools/definesurf/interplandm.f90 | 92 + tools/definesurf/lininterp.f90 | 174 + tools/definesurf/map2f.f90 | 1039 + tools/definesurf/map_i.f90 | 136 + tools/definesurf/max_ovr.f90 | 93 + tools/definesurf/sghphis.f90 | 340 + tools/definesurf/shr_kind_mod.f90 | 20 + tools/definesurf/sm121.f90 | 86 + tools/definesurf/terrain_filter.f90 | 320 + tools/definesurf/varf2c.f90 | 219 + tools/definesurf/wrap_nf.f90 | 146 + tools/icesst/Makefile | 7 + tools/icesst/README | 177 + tools/icesst/bcgen/Makefile | 97 + tools/icesst/bcgen/bcgen.f90 | 763 + tools/icesst/bcgen/calcclim.f90 | 185 + tools/icesst/bcgen/calcfull.f90 | 128 + tools/icesst/bcgen/driver.f90 | 352 + tools/icesst/bcgen/namelist | 18 + tools/icesst/bcgen/output_dateinfo.f90 | 62 + tools/icesst/bcgen/prec.f90 | 9 + tools/icesst/bcgen/setup_outfile.f90 | 136 + tools/icesst/bcgen/solver.f90 | 950 + tools/icesst/bcgen/types.f90 | 46 + tools/icesst/bcgen/types.inc | 44 + tools/icesst/bcgen/wrap_nf.f90 | 386 + tools/icesst/regrid/CREATE_DIMS_GAU.ncl | 45 + tools/icesst/regrid/CREATE_DIMS_REG.ncl | 49 + tools/icesst/regrid/Makefile | 101 + tools/icesst/regrid/REGRID.pl | 171 + tools/icesst/regrid/ao.f90 | 141 + tools/icesst/regrid/ao_i.f90 | 178 + tools/icesst/regrid/area_ave.f90 | 59 + tools/icesst/regrid/binf2c.f90 | 92 + tools/icesst/regrid/cell_area.f90 | 51 + tools/icesst/regrid/err_exit.f90 | 8 + tools/icesst/regrid/interp_driver.f90 | 131 + tools/icesst/regrid/lininterp.f90 | 174 + tools/icesst/regrid/map_i.f90 | 136 + tools/icesst/regrid/max_ovr.f90 | 93 + tools/icesst/regrid/precision.f90 | 9 + tools/icesst/regrid/regrid.f90 | 770 + tools/icesst/regrid/wrap_nf.f90 | 380 + tools/interpaerosols/CREATE_DIMS_GAU.ncl | 46 + tools/interpaerosols/CREATE_DIMS_REG.ncl | 52 + tools/interpaerosols/Makefile | 132 + tools/interpaerosols/README | 24 + tools/interpaerosols/REGRID.pl | 186 + tools/interpaerosols/addglobal.F90 | 82 + tools/interpaerosols/driver.f90 | 454 + tools/interpaerosols/fmain.F90 | 236 + tools/interpaerosols/globals.f90 | 27 + tools/interpaerosols/preserve_mean.f90 | 154 + tools/interpic/Makefile | 129 + tools/interpic/README | 95 + tools/interpic/addglobal.f90 | 61 + tools/interpic/compare_var.f90 | 32 + tools/interpic/control.f90 | 8 + tools/interpic/cpvar.f90 | 56 + tools/interpic/create_template.ncl | 206 + tools/interpic/dimensions.f90 | 220 + tools/interpic/driver.f90 | 263 + tools/interpic/err_exit.f90 | 8 + tools/interpic/fill_positions.f90 | 175 + tools/interpic/fmain.f90 | 211 + tools/interpic/handle_special_cases.f90 | 75 + tools/interpic/interp_driver.f90 | 121 + tools/interpic/is_special_case.f90 | 43 + tools/interpic/lininterp.f90 | 174 + tools/interpic/shr_kind_mod.f90 | 20 + tools/interpic/template.ncl | 413 + tools/interpic/varspecs_mod.f90 | 23 + tools/interpic/wrap_nf.f90 | 333 + tools/interpic_new/Makefile | 134 + tools/interpic_new/README | 91 + tools/interpic_new/addglobal.F90 | 61 + tools/interpic_new/compare_var.F90 | 32 + tools/interpic_new/control.F90 | 156 + tools/interpic_new/cpvar.F90 | 53 + tools/interpic_new/dimensions.F90 | 274 + tools/interpic_new/driver.F90 | 418 + tools/interpic_new/err_exit.F90 | 8 + tools/interpic_new/fill_positions.F90 | 208 + tools/interpic_new/fmain.F90 | 245 + tools/interpic_new/handle_special_cases.F90 | 109 + tools/interpic_new/interp.F90 | 183 + tools/interpic_new/interpolate_data.F90 | 1083 + tools/interpic_new/is_special_case.F90 | 28 + tools/interpic_new/shr_kind_mod.F90 | 22 + tools/interpic_new/wrap_nf.F90 | 333 + tools/mkatmsrffile/Makefile | 11 + tools/mkatmsrffile/README | 25 + tools/mkatmsrffile/mkatmsrffile.F90 | 383 + tools/mkatmsrffile/mkatmsrffile.rc | 24 + tools/se_grid/make_se_grid.sh | 533 + tools/topo_tool/bin_to_cube/Makefile | 82 + tools/topo_tool/bin_to_cube/README | 23 + tools/topo_tool/bin_to_cube/bin_to_cube.F90 | 931 + tools/topo_tool/bin_to_cube/shr_kind_mod.F90 | 20 + tools/topo_tool/cube_to_target/Makefile | 69 + tools/topo_tool/cube_to_target/README | 20 + .../cube_to_target/cube_to_target.F90 | 2008 + .../topo_tool/cube_to_target/reconstruct.F90 | 2675 + tools/topo_tool/cube_to_target/remap.F90 | 1561 + .../topo_tool/cube_to_target/shr_kind_mod.F90 | 20 + tools/topo_tool/gen_netCDF_from_USGS/Makefile | 80 + tools/topo_tool/gen_netCDF_from_USGS/README | 14 + .../create_netCDF_from_USGS.F90 | 830 + .../gen_netCDF_from_USGS/shr_kind_mod.F90 | 20 + 1893 files changed, 1039523 insertions(+) create mode 100644 .config_files.xml create mode 100644 .gitignore create mode 100644 CODE_OF_CONDUCT.md create mode 100644 Externals.cfg create mode 100644 Externals_CAM.cfg create mode 100644 README.md create mode 100644 README_EXTERNALS create mode 100644 bld/Makefile.in create mode 100755 bld/build-namelist create mode 100644 bld/config_files/definition.xml create mode 100644 bld/config_files/definition.xsl create mode 100644 bld/config_files/horiz_grid.xml create mode 100755 bld/configure create mode 100755 bld/mkDepends create mode 100755 bld/mkSrcfiles create mode 100644 bld/namelist_files/master_aer_drydep_list.xml create mode 100644 bld/namelist_files/master_aer_wetdep_list.xml create mode 100644 bld/namelist_files/master_gas_drydep_list.xml create mode 100644 bld/namelist_files/master_gas_wetdep_list.xml create mode 100644 bld/namelist_files/namelist_defaults_cam.xml create mode 100644 bld/namelist_files/namelist_definition.xml create mode 100644 bld/namelist_files/use_cases/1850-2005_cam5.xml create mode 100644 bld/namelist_files/use_cases/1850_cam4.xml create mode 100644 bld/namelist_files/use_cases/1850_cam6.xml create mode 100644 bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml create mode 100644 bld/namelist_files/use_cases/2000_cam4_trop_chem.xml create mode 100644 bld/namelist_files/use_cases/2000_cam6.xml create mode 100644 bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml create mode 100644 bld/namelist_files/use_cases/2010_cam6.xml create mode 100644 bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml create mode 100644 bld/namelist_files/use_cases/aquaplanet_cam3.xml create mode 100644 bld/namelist_files/use_cases/aquaplanet_cam4.xml create mode 100644 bld/namelist_files/use_cases/aquaplanet_cam5.xml create mode 100644 bld/namelist_files/use_cases/aquaplanet_cam6.xml create mode 100644 bld/namelist_files/use_cases/dabi_p2004.xml create mode 100644 bld/namelist_files/use_cases/dctest_baro_kessler.xml create mode 100644 bld/namelist_files/use_cases/dctest_baro_moist.xml create mode 100644 bld/namelist_files/use_cases/held_suarez_1994.xml create mode 100644 bld/namelist_files/use_cases/hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml create mode 100644 bld/namelist_files/use_cases/scam_arm95.xml create mode 100644 bld/namelist_files/use_cases/scam_arm97.xml create mode 100644 bld/namelist_files/use_cases/scam_gateIII.xml create mode 100644 bld/namelist_files/use_cases/scam_mpace.xml create mode 100644 bld/namelist_files/use_cases/scam_sparticus.xml create mode 100644 bld/namelist_files/use_cases/scam_togaII.xml create mode 100644 bld/namelist_files/use_cases/scam_twp06.xml create mode 100644 bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml create mode 100644 bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml create mode 100644 bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml create mode 100644 bld/namelist_files/use_cases/sd_waccm_sulfur.xml create mode 100644 bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml create mode 100644 bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml create mode 100644 bld/namelist_files/use_cases/soa_chem_megan_emis.xml create mode 100644 bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml create mode 100644 bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml create mode 100644 bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml create mode 100644 bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml create mode 100644 bld/perl5lib/Build/ChemNamelist.pm create mode 100644 bld/perl5lib/Build/ChemPreprocess.pm create mode 100644 bld/perl5lib/Build/Config.pm create mode 100644 bld/perl5lib/Build/Namelist.pm create mode 100644 bld/perl5lib/Build/NamelistDefaults.pm create mode 100644 bld/perl5lib/Build/NamelistDefinition.pm create mode 100644 bld/perl5lib/XML/Changes create mode 100644 bld/perl5lib/XML/Lite.pm create mode 100644 bld/perl5lib/XML/Lite/Element.pm create mode 100644 bld/perl5lib/XML/README create mode 100644 bld/perl5lib/XML/man3/XML_Lite.3 create mode 100644 bld/perl5lib/XML/man3/XML_Lite_Element.3 create mode 100644 bld/scripts/camfv2iop.ncl create mode 100755 bld/scripts/create_scam6_iop create mode 100755 bld/scripts/create_scam6_iop_multi create mode 100644 cime_config/buildcpp create mode 100755 cime_config/buildlib create mode 100755 cime_config/buildnml create mode 100644 cime_config/config_archive.xml create mode 100644 cime_config/config_component.xml create mode 100644 cime_config/config_compsets.xml create mode 100644 cime_config/config_pes.xml create mode 100644 cime_config/testdefs/testlist_cam.xml create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cice create mode 100644 cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3d/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm create mode 100644 cime_config/user_nl_cam create mode 100644 cime_config/usermods_dirs/aquap/user_nl_cpl create mode 100755 cime_config/usermods_dirs/scam_arm95/shell_commands create mode 100644 cime_config/usermods_dirs/scam_arm95/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_arm97/shell_commands create mode 100644 cime_config/usermods_dirs/scam_arm97/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_atex/shell_commands create mode 100644 cime_config/usermods_dirs/scam_atex/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_bomex/shell_commands create mode 100644 cime_config/usermods_dirs/scam_bomex/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_cgilsS11/shell_commands create mode 100644 cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_cgilsS12/shell_commands create mode 100644 cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_cgilsS6/shell_commands create mode 100644 cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_dycomsRF01/shell_commands create mode 100644 cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_dycomsRF02/shell_commands create mode 100644 cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_gateIII/shell_commands create mode 100644 cime_config/usermods_dirs/scam_gateIII/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_mandatory/shell_commands create mode 100755 cime_config/usermods_dirs/scam_mpace/shell_commands create mode 100644 cime_config/usermods_dirs/scam_mpace/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_rico/shell_commands create mode 100644 cime_config/usermods_dirs/scam_rico/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_sparticus/shell_commands create mode 100644 cime_config/usermods_dirs/scam_sparticus/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_togaII/shell_commands create mode 100644 cime_config/usermods_dirs/scam_togaII/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_twp06/shell_commands create mode 100644 cime_config/usermods_dirs/scam_twp06/user_nl_cam create mode 100644 cime_config/usermods_dirs/waccmx/user_nl_clm create mode 100644 doc/ChangeLog create mode 100644 doc/ChangeLog_template create mode 100644 doc/ReleaseNotes create mode 100644 manage_externals/.dir_locals.el create mode 100644 manage_externals/.github/ISSUE_TEMPLATE.md create mode 100644 manage_externals/.github/PULL_REQUEST_TEMPLATE.md create mode 100644 manage_externals/.gitignore create mode 100644 manage_externals/.travis.yml create mode 100644 manage_externals/LICENSE.txt create mode 100644 manage_externals/README.md create mode 100644 manage_externals/README_FIRST create mode 100755 manage_externals/checkout_externals create mode 100644 manage_externals/manic/__init__.py create mode 100755 manage_externals/manic/checkout.py create mode 100644 manage_externals/manic/externals_description.py create mode 100644 manage_externals/manic/externals_status.py create mode 100644 manage_externals/manic/global_constants.py create mode 100644 manage_externals/manic/repository.py create mode 100644 manage_externals/manic/repository_factory.py create mode 100644 manage_externals/manic/repository_git.py create mode 100644 manage_externals/manic/repository_svn.py create mode 100644 manage_externals/manic/sourcetree.py create mode 100644 manage_externals/manic/utils.py create mode 100644 manage_externals/test/.coveragerc create mode 100644 manage_externals/test/.gitignore create mode 100644 manage_externals/test/.pylint.rc create mode 100644 manage_externals/test/Makefile create mode 100644 manage_externals/test/README.md create mode 100644 manage_externals/test/doc/.gitignore create mode 100644 manage_externals/test/doc/Makefile create mode 100644 manage_externals/test/doc/conf.py create mode 100644 manage_externals/test/doc/develop.rst create mode 100644 manage_externals/test/doc/index.rst create mode 100644 manage_externals/test/doc/testing.rst create mode 100644 manage_externals/test/repos/container.git/HEAD create mode 100644 manage_externals/test/repos/container.git/config create mode 100644 manage_externals/test/repos/container.git/description create mode 100644 manage_externals/test/repos/container.git/info/exclude create mode 100644 manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 create mode 100644 manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de create mode 100644 manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b create mode 100644 manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 create mode 100644 manage_externals/test/repos/container.git/refs/heads/master create mode 100644 manage_externals/test/repos/error/readme.txt create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/HEAD create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/config create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/description create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/info/exclude create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master create mode 100644 manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature create mode 100644 manage_externals/test/repos/simple-ext-fork.git/HEAD create mode 100644 manage_externals/test/repos/simple-ext-fork.git/config create mode 100644 manage_externals/test/repos/simple-ext-fork.git/description create mode 100644 manage_externals/test/repos/simple-ext-fork.git/info/exclude create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/4d/837135915ed93eed6fff6b439f284ce317296f create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/56/175e017ad38bf3d33d74b6bd7c74624b28466a create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/5f/1d4786d12e52d7ab28d2f2f1118c1059a9f1ae create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/67/136e5ab4d5c1c65d10c8048763b96b0e53c1d6 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/7b/0bd630ac13865735a1dff3437a137d8ab50663 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/88/cf20868e0cc445f5642a480ed034c71e0d7e9f create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/8d/2b3b35126224c975d23f109aa1e3cbac452989 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca create mode 100644 manage_externals/test/repos/simple-ext-fork.git/packed-refs create mode 100644 manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 create mode 100644 manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature create mode 100644 manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 create mode 100644 manage_externals/test/repos/simple-ext.git/HEAD create mode 100644 manage_externals/test/repos/simple-ext.git/config create mode 100644 manage_externals/test/repos/simple-ext.git/description create mode 100644 manage_externals/test/repos/simple-ext.git/info/exclude create mode 100644 manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f create mode 100644 manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c create mode 100644 manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f create mode 100644 manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 create mode 100644 manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff create mode 100644 manage_externals/test/repos/simple-ext.git/refs/heads/feature2 create mode 100644 manage_externals/test/repos/simple-ext.git/refs/heads/feature3 create mode 100644 manage_externals/test/repos/simple-ext.git/refs/heads/master create mode 100644 manage_externals/test/repos/simple-ext.git/refs/tags/tag1 create mode 100644 manage_externals/test/requirements.txt create mode 100644 manage_externals/test/test_sys_checkout.py create mode 100644 manage_externals/test/test_sys_repository_git.py create mode 100644 manage_externals/test/test_unit_externals_description.py create mode 100644 manage_externals/test/test_unit_externals_status.py create mode 100644 manage_externals/test/test_unit_repository.py create mode 100644 manage_externals/test/test_unit_repository_git.py create mode 100644 manage_externals/test/test_unit_repository_svn.py create mode 100644 manage_externals/test/test_unit_utils.py create mode 100644 src/advection/slt/bandij.F90 create mode 100644 src/advection/slt/basdy.F90 create mode 100644 src/advection/slt/basdz.F90 create mode 100644 src/advection/slt/basiy.F90 create mode 100644 src/advection/slt/difcor.F90 create mode 100644 src/advection/slt/engy_tdif.F90 create mode 100644 src/advection/slt/engy_te.F90 create mode 100644 src/advection/slt/extx.F90 create mode 100644 src/advection/slt/extys.F90 create mode 100644 src/advection/slt/extyv.F90 create mode 100644 src/advection/slt/flxint.F90 create mode 100644 src/advection/slt/grdxy.F90 create mode 100644 src/advection/slt/hadvtest.h create mode 100644 src/advection/slt/hordif1.F90 create mode 100644 src/advection/slt/kdpfnd.F90 create mode 100644 src/advection/slt/lcbas.F90 create mode 100644 src/advection/slt/lcdbas.F90 create mode 100644 src/advection/slt/omcalc.F90 create mode 100644 src/advection/slt/pdelb0.F90 create mode 100644 src/advection/slt/phcs.F90 create mode 100644 src/advection/slt/plevs0.F90 create mode 100644 src/advection/slt/qmassa.F90 create mode 100644 src/advection/slt/qmassd.F90 create mode 100644 src/advection/slt/reordp.F90 create mode 100644 src/advection/slt/scm0.F90 create mode 100644 src/advection/slt/xqmass.F90 create mode 100644 src/chemistry/aerosol/cldaero_mod.F90 create mode 100644 src/chemistry/aerosol/drydep_mod.F90 create mode 100644 src/chemistry/aerosol/dust_common.F90 create mode 100644 src/chemistry/aerosol/dust_sediment_mod.F90 create mode 100644 src/chemistry/aerosol/mo_setsox.F90 create mode 100644 src/chemistry/aerosol/soil_erod_mod.F90 create mode 100644 src/chemistry/aerosol/sslt_sections.F90 create mode 100644 src/chemistry/aerosol/wetdep.F90 create mode 100644 src/chemistry/bulk_aero/aero_model.F90 create mode 100644 src/chemistry/bulk_aero/aerosol_depvel.F90 create mode 100644 src/chemistry/bulk_aero/dust_model.F90 create mode 100644 src/chemistry/bulk_aero/mo_aerosols.F90 create mode 100644 src/chemistry/bulk_aero/mo_setsoa.F90 create mode 100644 src/chemistry/bulk_aero/seasalt_model.F90 create mode 100644 src/chemistry/bulk_aero/sox_cldaero_mod.F90 create mode 100644 src/chemistry/modal_aero/aero_model.F90 create mode 100644 src/chemistry/modal_aero/dust_model.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_coag.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_convproc.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_data.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_gasaerexch.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_newnuc.F90 create mode 100644 src/chemistry/modal_aero/modal_aero_rename.F90 create mode 100644 src/chemistry/modal_aero/seasalt_model.F90 create mode 100644 src/chemistry/modal_aero/sox_cldaero_mod.F90 create mode 100644 src/chemistry/mozart/cfc11star.F90 create mode 100644 src/chemistry/mozart/charge_neutrality.F90 create mode 100644 src/chemistry/mozart/chem_prod_loss_diags.F90 create mode 100644 src/chemistry/mozart/chemistry.F90 create mode 100644 src/chemistry/mozart/chlorine_loading_data.F90 create mode 100644 src/chemistry/mozart/clybry_fam.F90 create mode 100644 src/chemistry/mozart/epp_ionization.F90 create mode 100644 src/chemistry/mozart/euvac.F90 create mode 100644 src/chemistry/mozart/fire_emissions.F90 create mode 100644 src/chemistry/mozart/gas_wetdep_opts.F90 create mode 100644 src/chemistry/mozart/gcr_ionization.F90 create mode 100644 src/chemistry/mozart/lin_strat_chem.F90 create mode 100644 src/chemistry/mozart/linoz_data.F90 create mode 100644 src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 create mode 100644 src/chemistry/mozart/m_sad_data.F90 create mode 100644 src/chemistry/mozart/mo_aero_settling.F90 create mode 100644 src/chemistry/mozart/mo_airglow.F90 create mode 100644 src/chemistry/mozart/mo_airmas.F90 create mode 100644 src/chemistry/mozart/mo_airplane.F90 create mode 100644 src/chemistry/mozart/mo_apex.F90 create mode 100644 src/chemistry/mozart/mo_aurora.F90 create mode 100644 src/chemistry/mozart/mo_calcoe.F90 create mode 100644 src/chemistry/mozart/mo_chem_utls.F90 create mode 100644 src/chemistry/mozart/mo_chemini.F90 create mode 100644 src/chemistry/mozart/mo_chm_diags.F90 create mode 100644 src/chemistry/mozart/mo_cph.F90 create mode 100644 src/chemistry/mozart/mo_drydep.F90 create mode 100644 src/chemistry/mozart/mo_extfrc.F90 create mode 100644 src/chemistry/mozart/mo_fstrat.F90 create mode 100644 src/chemistry/mozart/mo_gas_phase_chemdr.F90 create mode 100644 src/chemistry/mozart/mo_ghg_chem.F90 create mode 100644 src/chemistry/mozart/mo_heatnirco2.F90 create mode 100644 src/chemistry/mozart/mo_inter.F90 create mode 100644 src/chemistry/mozart/mo_jeuv.F90 create mode 100644 src/chemistry/mozart/mo_jlong.F90 create mode 100644 src/chemistry/mozart/mo_jpl.F90 create mode 100644 src/chemistry/mozart/mo_jshort.F90 create mode 100644 src/chemistry/mozart/mo_lightning.F90 create mode 100644 src/chemistry/mozart/mo_lymana.F90 create mode 100644 src/chemistry/mozart/mo_mass_xforms.F90 create mode 100644 src/chemistry/mozart/mo_mean_mass.F90 create mode 100644 src/chemistry/mozart/mo_negtrc.F90 create mode 100644 src/chemistry/mozart/mo_neu_wetdep.F90 create mode 100644 src/chemistry/mozart/mo_params.F90 create mode 100644 src/chemistry/mozart/mo_pchem.F90 create mode 100644 src/chemistry/mozart/mo_photo.F90 create mode 100644 src/chemistry/mozart/mo_photoin.F90 create mode 100644 src/chemistry/mozart/mo_ps2str.F90 create mode 100644 src/chemistry/mozart/mo_rtlink.F90 create mode 100644 src/chemistry/mozart/mo_sad.F90 create mode 100644 src/chemistry/mozart/mo_schu.F90 create mode 100644 src/chemistry/mozart/mo_setaer.F90 create mode 100644 src/chemistry/mozart/mo_setair.F90 create mode 100644 src/chemistry/mozart/mo_setcld.F90 create mode 100644 src/chemistry/mozart/mo_setext.F90 create mode 100644 src/chemistry/mozart/mo_sethet.F90 create mode 100644 src/chemistry/mozart/mo_setinv.F90 create mode 100644 src/chemistry/mozart/mo_seto2.F90 create mode 100644 src/chemistry/mozart/mo_setozo.F90 create mode 100644 src/chemistry/mozart/mo_setz.F90 create mode 100644 src/chemistry/mozart/mo_snoe.F90 create mode 100644 src/chemistry/mozart/mo_sphers.F90 create mode 100644 src/chemistry/mozart/mo_srf_emissions.F90 create mode 100644 src/chemistry/mozart/mo_strato_rates.F90 create mode 100644 src/chemistry/mozart/mo_sulf.F90 create mode 100644 src/chemistry/mozart/mo_synoz.F90 create mode 100644 src/chemistry/mozart/mo_tgcm_ubc.F90 create mode 100644 src/chemistry/mozart/mo_tracname.F90 create mode 100644 src/chemistry/mozart/mo_trislv.F90 create mode 100644 src/chemistry/mozart/mo_tuv_inti.F90 create mode 100644 src/chemistry/mozart/mo_usrrxt.F90 create mode 100644 src/chemistry/mozart/mo_waccm_hrates.F90 create mode 100644 src/chemistry/mozart/mo_waveall.F90 create mode 100644 src/chemistry/mozart/mo_wavelab.F90 create mode 100644 src/chemistry/mozart/mo_wavelen.F90 create mode 100644 src/chemistry/mozart/mo_waveo3.F90 create mode 100644 src/chemistry/mozart/mo_xsections.F90 create mode 100644 src/chemistry/mozart/mo_zadj.F90 create mode 100644 src/chemistry/mozart/noy_ubc.F90 create mode 100644 src/chemistry/mozart/photo_bkgrnd.F90 create mode 100644 src/chemistry/mozart/rate_diags.F90 create mode 100644 src/chemistry/mozart/set_cp.F90 create mode 100644 src/chemistry/mozart/short_lived_species.F90 create mode 100644 src/chemistry/mozart/species_sums_diags.F90 create mode 100644 src/chemistry/mozart/spehox.F90 create mode 100644 src/chemistry/mozart/sums_utils.F90 create mode 100644 src/chemistry/mozart/sv_decomp.F90 create mode 100644 src/chemistry/mozart/tracer_cnst.F90 create mode 100644 src/chemistry/mozart/tracer_srcs.F90 create mode 100644 src/chemistry/mozart/upper_bc.F90 create mode 100644 src/chemistry/pp_none/chem_mech.in create mode 100644 src/chemistry/pp_none/chem_mods.F90 create mode 100644 src/chemistry/pp_none/chemistry.F90 create mode 100644 src/chemistry/pp_none/m_spc_id.F90 create mode 100644 src/chemistry/pp_none/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_none/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_none/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_none/mo_indprd.F90 create mode 100644 src/chemistry/pp_none/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_none/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_none/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_none/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_none/mo_phtadj.F90 create mode 100644 src/chemistry/pp_none/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_none/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_none/mo_setrxt.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/chem_mech.doc create mode 100644 src/chemistry/pp_super_fast_llnl/chem_mech.in create mode 100644 src/chemistry/pp_super_fast_llnl/chem_mods.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/m_spc_id.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_indprd.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 create mode 100644 src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 create mode 100644 src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_terminator/chem_mech.doc create mode 100644 src/chemistry/pp_terminator/chem_mech.in create mode 100644 src/chemistry/pp_terminator/chem_mods.F90 create mode 100644 src/chemistry/pp_terminator/chemistry.F90 create mode 100644 src/chemistry/pp_terminator/m_rxt_id.F90 create mode 100644 src/chemistry/pp_terminator/m_spc_id.F90 create mode 100644 src/chemistry/pp_terminator/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_terminator/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_terminator/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_terminator/mo_indprd.F90 create mode 100644 src/chemistry/pp_terminator/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_terminator/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_terminator/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_terminator/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_terminator/mo_phtadj.F90 create mode 100644 src/chemistry/pp_terminator/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_terminator/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_terminator/mo_setrxt.F90 create mode 100644 src/chemistry/pp_terminator/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_bam/chem_mech.doc create mode 100644 src/chemistry/pp_trop_bam/chem_mech.in create mode 100644 src/chemistry/pp_trop_bam/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_bam/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_bam/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_bam/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_ghg/chem_mech.doc create mode 100644 src/chemistry/pp_trop_ghg/chem_mech.in create mode 100644 src/chemistry/pp_trop_ghg/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_ghg/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_ghg/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_ghg/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_mam3/chem_mech.doc create mode 100644 src/chemistry/pp_trop_mam3/chem_mech.in create mode 100644 src/chemistry/pp_trop_mam3/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_mam3/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_mam3/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_mam3/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_mam4/chem_mech.doc create mode 100644 src/chemistry/pp_trop_mam4/chem_mech.in create mode 100644 src/chemistry/pp_trop_mam4/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_mam4/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_mam4/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_mam4/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_mam7/chem_mech.doc create mode 100644 src/chemistry/pp_trop_mam7/chem_mech.in create mode 100644 src/chemistry/pp_trop_mam7/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_mam7/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_mam7/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_mam7/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_mozart/chem_mech.doc create mode 100644 src/chemistry/pp_trop_mozart/chem_mech.in create mode 100644 src/chemistry/pp_trop_mozart/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_mozart/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_mozart/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_mozart/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_ma/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_ma/chem_mech.in create mode 100644 src/chemistry/pp_waccm_ma/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_ma/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_ma/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_ma_mam4/chem_mech.in create mode 100644 src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_ma_sulfur/chem_mech.in create mode 100644 src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_mad_mam4/chem_mech.in create mode 100644 src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_sc/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_sc/chem_mech.in create mode 100644 src/chemistry/pp_waccm_sc/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_sc/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_sc/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_sc/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_sc_mam4/chem_mech.in create mode 100644 src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_tsmlt/chem_mech.in create mode 100644 src/chemistry/pp_waccm_tsmlt/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 create mode 100644 src/chemistry/utils/aerodep_flx.F90 create mode 100644 src/chemistry/utils/aircraft_emit.F90 create mode 100644 src/chemistry/utils/apex.F90 create mode 100644 src/chemistry/utils/horizontal_interpolate.F90 create mode 100644 src/chemistry/utils/input_data_utils.F90 create mode 100644 src/chemistry/utils/m_types.F90 create mode 100644 src/chemistry/utils/mo_constants.F90 create mode 100644 src/chemistry/utils/mo_flbc.F90 create mode 100644 src/chemistry/utils/mo_msis_ubc.F90 create mode 100644 src/chemistry/utils/mo_util.F90 create mode 100644 src/chemistry/utils/modal_aero_calcsize.F90 create mode 100644 src/chemistry/utils/modal_aero_deposition.F90 create mode 100644 src/chemistry/utils/modal_aero_wateruptake.F90 create mode 100644 src/chemistry/utils/msise00.F90 create mode 100644 src/chemistry/utils/prescribed_aero.F90 create mode 100644 src/chemistry/utils/prescribed_ghg.F90 create mode 100644 src/chemistry/utils/prescribed_ozone.F90 create mode 100644 src/chemistry/utils/prescribed_strataero.F90 create mode 100644 src/chemistry/utils/prescribed_volcaero.F90 create mode 100644 src/chemistry/utils/solar_data.F90 create mode 100644 src/chemistry/utils/solar_euv_data.F90 create mode 100644 src/chemistry/utils/solar_irrad_data.F90 create mode 100644 src/chemistry/utils/solar_parms_data.F90 create mode 100644 src/chemistry/utils/solar_wind_data.F90 create mode 100644 src/chemistry/utils/time_utils.F90 create mode 100644 src/chemistry/utils/tracer_data.F90 create mode 100644 src/control/cam_comp.F90 create mode 100644 src/control/cam_control_mod.F90 create mode 100644 src/control/cam_history.F90 create mode 100644 src/control/cam_history_buffers.F90 create mode 100644 src/control/cam_history_support.F90 create mode 100644 src/control/cam_initfiles.F90 create mode 100644 src/control/cam_instance.F90 create mode 100644 src/control/cam_logfile.F90 create mode 100644 src/control/cam_restart.F90 create mode 100644 src/control/camsrfexch.F90 create mode 100644 src/control/filenames.F90 create mode 100644 src/control/history_defaults.F90 create mode 100644 src/control/history_scam.F90 create mode 100644 src/control/ncdio_atm.F90 create mode 100644 src/control/runtime_opts.F90 create mode 100644 src/control/sat_hist.F90 create mode 100644 src/control/scamMod.F90 create mode 100644 src/cpl/atm_comp_mct.F90 create mode 100644 src/cpl/atm_import_export.F90 create mode 100644 src/cpl/cam_cpl_indices.F90 create mode 100644 src/dynamics/eul/bndexch.F90 create mode 100644 src/dynamics/eul/commap.F90 create mode 100644 src/dynamics/eul/comspe.F90 create mode 100644 src/dynamics/eul/comsta.h create mode 100644 src/dynamics/eul/courlim.F90 create mode 100644 src/dynamics/eul/cubxdr.F90 create mode 100644 src/dynamics/eul/cubydr.F90 create mode 100644 src/dynamics/eul/cubzdr.F90 create mode 100644 src/dynamics/eul/diag_dynvar_ic.F90 create mode 100644 src/dynamics/eul/dp_coupling.F90 create mode 100644 src/dynamics/eul/dycore.F90 create mode 100644 src/dynamics/eul/dyn.F90 create mode 100644 src/dynamics/eul/dyn_comp.F90 create mode 100644 src/dynamics/eul/dyn_grid.F90 create mode 100644 src/dynamics/eul/dyndrv.F90 create mode 100644 src/dynamics/eul/dynpkg.F90 create mode 100644 src/dynamics/eul/eul_control_mod.F90 create mode 100644 src/dynamics/eul/getinterpnetcdfdata.F90 create mode 100644 src/dynamics/eul/grcalc.F90 create mode 100644 src/dynamics/eul/grmult.F90 create mode 100644 src/dynamics/eul/hdinti.F90 create mode 100644 src/dynamics/eul/herxin.F90 create mode 100644 src/dynamics/eul/heryin.F90 create mode 100644 src/dynamics/eul/herzin.F90 create mode 100644 src/dynamics/eul/hordif.F90 create mode 100644 src/dynamics/eul/hrintp.F90 create mode 100644 src/dynamics/eul/interp_mod.F90 create mode 100644 src/dynamics/eul/iop.F90 create mode 100644 src/dynamics/eul/lagyin.F90 create mode 100644 src/dynamics/eul/limdx.F90 create mode 100644 src/dynamics/eul/limdy.F90 create mode 100644 src/dynamics/eul/limdz.F90 create mode 100644 src/dynamics/eul/linemsdyn.F90 create mode 100644 src/dynamics/eul/massfix.F90 create mode 100644 src/dynamics/eul/parslt.h create mode 100644 src/dynamics/eul/pmgrid.F90 create mode 100644 src/dynamics/eul/prognostics.F90 create mode 100644 src/dynamics/eul/pspect.F90 create mode 100644 src/dynamics/eul/quad.F90 create mode 100644 src/dynamics/eul/realloc4.F90 create mode 100644 src/dynamics/eul/realloc7.F90 create mode 100644 src/dynamics/eul/restart_dynamics.F90 create mode 100644 src/dynamics/eul/scan2.F90 create mode 100644 src/dynamics/eul/scandyn.F90 create mode 100644 src/dynamics/eul/scanslt.F90 create mode 100644 src/dynamics/eul/scmforecast.F90 create mode 100644 src/dynamics/eul/settau.F90 create mode 100644 src/dynamics/eul/spegrd.F90 create mode 100644 src/dynamics/eul/spetru.F90 create mode 100644 src/dynamics/eul/sphdep.F90 create mode 100644 src/dynamics/eul/spmd_dyn.F90 create mode 100644 src/dynamics/eul/stats.F90 create mode 100644 src/dynamics/eul/stepon.F90 create mode 100644 src/dynamics/eul/tfilt_massfix.F90 create mode 100644 src/dynamics/eul/trjmps.F90 create mode 100644 src/dynamics/eul/tstep.F90 create mode 100644 src/dynamics/fv/FVperf_module.F90 create mode 100644 src/dynamics/fv/advect_tend.F90 create mode 100644 src/dynamics/fv/benergy.F90 create mode 100644 src/dynamics/fv/cd_core.F90 create mode 100644 src/dynamics/fv/commap.F90 create mode 100644 src/dynamics/fv/ctem.F90 create mode 100644 src/dynamics/fv/d2a3dijk.F90 create mode 100644 src/dynamics/fv/d2a3dikj.F90 create mode 100644 src/dynamics/fv/diag_dynvar_ic.F90 create mode 100644 src/dynamics/fv/diag_module.F90 create mode 100644 src/dynamics/fv/dp_coupling.F90 create mode 100644 src/dynamics/fv/dryairm.F90 create mode 100644 src/dynamics/fv/dycore.F90 create mode 100644 src/dynamics/fv/dyn_comp.F90 create mode 100644 src/dynamics/fv/dyn_grid.F90 create mode 100644 src/dynamics/fv/dyn_internal_state.F90 create mode 100644 src/dynamics/fv/dynamics_vars.F90 create mode 100644 src/dynamics/fv/epvd.F90 create mode 100644 src/dynamics/fv/fill_module.F90 create mode 100644 src/dynamics/fv/fv_prints.F90 create mode 100644 src/dynamics/fv/geopk.F90 create mode 100644 src/dynamics/fv/gravity_waves_sources.F90 create mode 100644 src/dynamics/fv/interp_mod.F90 create mode 100644 src/dynamics/fv/mapz_module.F90 create mode 100644 src/dynamics/fv/mean_module.F90 create mode 100644 src/dynamics/fv/metdata.F90 create mode 100644 src/dynamics/fv/p_d_adjust.F90 create mode 100644 src/dynamics/fv/par_vecsum.F90 create mode 100644 src/dynamics/fv/par_xsum.F90 create mode 100644 src/dynamics/fv/pfixer.F90 create mode 100644 src/dynamics/fv/pft_module.F90 create mode 100644 src/dynamics/fv/pkez.F90 create mode 100644 src/dynamics/fv/pmgrid.F90 create mode 100644 src/dynamics/fv/restart_dynamics.F90 create mode 100644 src/dynamics/fv/spmd_dyn.F90 create mode 100644 src/dynamics/fv/stepon.F90 create mode 100644 src/dynamics/fv/sw_core.F90 create mode 100644 src/dynamics/fv/te_map.F90 create mode 100644 src/dynamics/fv/tp_core.F90 create mode 100644 src/dynamics/fv/trac2d.F90 create mode 100644 src/dynamics/fv/uv3s_update.F90 create mode 100644 src/dynamics/fv/zonal_mean.F90 create mode 100644 src/dynamics/se/dp_coupling.F90 create mode 100644 src/dynamics/se/dp_mapping.F90 create mode 100644 src/dynamics/se/dycore.F90 create mode 100644 src/dynamics/se/dycore/bndry_mod.F90 create mode 100644 src/dynamics/se/dycore/comp_ctr_vol_around_gll_pts.F90 create mode 100644 src/dynamics/se/dycore/control_mod.F90 create mode 100644 src/dynamics/se/dycore/coordinate_systems_mod.F90 create mode 100644 src/dynamics/se/dycore/cube_mod.F90 create mode 100644 src/dynamics/se/dycore/derivative_mod.F90 create mode 100644 src/dynamics/se/dycore/dimensions_mod.F90 create mode 100644 src/dynamics/se/dycore/dof_mod.F90 create mode 100644 src/dynamics/se/dycore/edge_mod.F90 create mode 100644 src/dynamics/se/dycore/edgetype_mod.F90 create mode 100644 src/dynamics/se/dycore/element_mod.F90 create mode 100644 src/dynamics/se/dycore/fvm_analytic_mod.F90 create mode 100644 src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 create mode 100644 src/dynamics/se/dycore/fvm_control_volume_mod.F90 create mode 100644 src/dynamics/se/dycore/fvm_mapping.F90 create mode 100644 src/dynamics/se/dycore/fvm_mod.F90 create mode 100644 src/dynamics/se/dycore/fvm_overlap_mod.F90 create mode 100644 src/dynamics/se/dycore/fvm_reconstruction_mod.F90 create mode 100644 src/dynamics/se/dycore/gbarrier.c create mode 100644 src/dynamics/se/dycore/gbarrier_mod.F90 create mode 100644 src/dynamics/se/dycore/gbarriertype_mod.F90 create mode 100644 src/dynamics/se/dycore/global_norms_mod.F90 create mode 100644 src/dynamics/se/dycore/gridgraph_mod.F90 create mode 100644 src/dynamics/se/dycore/hybrid_mod.F90 create mode 100644 src/dynamics/se/dycore/hybvcoord_mod.F90 create mode 100644 src/dynamics/se/dycore/interpolate_mod.F90 create mode 100644 src/dynamics/se/dycore/ll_mod.F90 create mode 100644 src/dynamics/se/dycore/mass_matrix_mod.F90 create mode 100644 src/dynamics/se/dycore/mesh_mod.F90 create mode 100644 src/dynamics/se/dycore/metagraph_mod.F90 create mode 100644 src/dynamics/se/dycore/namelist_mod.F90 create mode 100644 src/dynamics/se/dycore/parallel_mod.F90 create mode 100644 src/dynamics/se/dycore/params_mod.F90 create mode 100644 src/dynamics/se/dycore/prim_advance_mod.F90 create mode 100644 src/dynamics/se/dycore/prim_advection_mod.F90 create mode 100644 src/dynamics/se/dycore/prim_driver_mod.F90 create mode 100644 src/dynamics/se/dycore/prim_init.F90 create mode 100644 src/dynamics/se/dycore/prim_si_mod.F90 create mode 100644 src/dynamics/se/dycore/prim_state_mod.F90 create mode 100644 src/dynamics/se/dycore/quadrature_mod.F90 create mode 100644 src/dynamics/se/dycore/reduction_mod.F90 create mode 100644 src/dynamics/se/dycore/schedtype_mod.F90 create mode 100644 src/dynamics/se/dycore/schedule_mod.F90 create mode 100644 src/dynamics/se/dycore/spacecurve_mod.F90 create mode 100644 src/dynamics/se/dycore/thread_mod.F90 create mode 100644 src/dynamics/se/dycore/time_mod.F90 create mode 100644 src/dynamics/se/dycore/vertremap_mod.F90 create mode 100644 src/dynamics/se/dycore/viscosity_mod.F90 create mode 100644 src/dynamics/se/dyn_comp.F90 create mode 100644 src/dynamics/se/dyn_grid.F90 create mode 100644 src/dynamics/se/gravity_waves_sources.F90 create mode 100644 src/dynamics/se/interp_mod.F90 create mode 100644 src/dynamics/se/native_mapping.F90 create mode 100644 src/dynamics/se/pmgrid.F90 create mode 100644 src/dynamics/se/restart_dynamics.F90 create mode 100644 src/dynamics/se/spmd_dyn.F90 create mode 100644 src/dynamics/se/stepon.F90 create mode 100644 src/dynamics/se/test_fvm_mapping.F90 create mode 100644 src/dynamics/tests/dyn_tests_utils.F90 create mode 100644 src/dynamics/tests/inic_analytic.F90 create mode 100644 src/dynamics/tests/inic_analytic_utils.F90 create mode 100644 src/dynamics/tests/initial_conditions/ic_baroclinic.F90 create mode 100644 src/dynamics/tests/initial_conditions/ic_held_suarez.F90 create mode 100644 src/ionosphere/ionosphere_interface.F90 create mode 100644 src/ionosphere/waccmx/dpie_coupling.F90 create mode 100644 src/ionosphere/waccmx/edyn_esmf.F90 create mode 100644 src/ionosphere/waccmx/edyn_geogrid.F90 create mode 100644 src/ionosphere/waccmx/edyn_init.F90 create mode 100644 src/ionosphere/waccmx/edyn_maggrid.F90 create mode 100644 src/ionosphere/waccmx/edyn_mpi.F90 create mode 100644 src/ionosphere/waccmx/edyn_mud.F90 create mode 100644 src/ionosphere/waccmx/edyn_mudcom.F90 create mode 100644 src/ionosphere/waccmx/edyn_mudmod.F90 create mode 100644 src/ionosphere/waccmx/edyn_muh2cr.F90 create mode 100644 src/ionosphere/waccmx/edyn_params.F90 create mode 100644 src/ionosphere/waccmx/edyn_solve.F90 create mode 100644 src/ionosphere/waccmx/edynamo.F90 create mode 100644 src/ionosphere/waccmx/filter.F90 create mode 100644 src/ionosphere/waccmx/getapex.F90 create mode 100644 src/ionosphere/waccmx/heelis.F90 create mode 100644 src/ionosphere/waccmx/ionosphere_interface.F90 create mode 100644 src/ionosphere/waccmx/oplus.F90 create mode 100644 src/ionosphere/waccmx/savefield_waccm.F90 create mode 100644 src/ionosphere/waccmx/wei05sc.F90 create mode 100644 src/physics/cam/CMakeLists.txt create mode 100644 src/physics/cam/aer_rad_props.F90 create mode 100644 src/physics/cam/aoa_tracers.F90 create mode 100644 src/physics/cam/beljaars_drag.F90 create mode 100644 src/physics/cam/beljaars_drag_cam.F90 create mode 100644 src/physics/cam/boundarydata.F90 create mode 100644 src/physics/cam/cam3_aero_data.F90 create mode 100644 src/physics/cam/cam3_ozone_data.F90 create mode 100644 src/physics/cam/cam_diagnostics.F90 create mode 100644 src/physics/cam/carma_flags_mod.F90 create mode 100644 src/physics/cam/carma_intr.F90 create mode 100644 src/physics/cam/carma_model_flags_mod.F90 create mode 100644 src/physics/cam/check_energy.F90 create mode 100644 src/physics/cam/chem_surfvals.F90 create mode 100644 src/physics/cam/cldfrc2m.F90 create mode 100644 src/physics/cam/cldwat.F90 create mode 100644 src/physics/cam/cldwat2m_macro.F90 create mode 100644 src/physics/cam/cloud_cover_diags.F90 create mode 100644 src/physics/cam/cloud_diagnostics.F90 create mode 100644 src/physics/cam/cloud_fraction.F90 create mode 100644 src/physics/cam/clubb_intr.F90 create mode 100644 src/physics/cam/cmparray_mod.F90 create mode 100644 src/physics/cam/co2_cycle.F90 create mode 100644 src/physics/cam/co2_data_flux.F90 create mode 100644 src/physics/cam/const_init.F90 create mode 100644 src/physics/cam/constituent_burden.F90 create mode 100644 src/physics/cam/constituents.F90 create mode 100644 src/physics/cam/conv_water.F90 create mode 100644 src/physics/cam/convect_deep.F90 create mode 100644 src/physics/cam/convect_shallow.F90 create mode 100644 src/physics/cam/cospsimulator_intr.F90 create mode 100644 src/physics/cam/cpslec.F90 create mode 100644 src/physics/cam/dadadj.F90 create mode 100644 src/physics/cam/dadadj_cam.F90 create mode 100644 src/physics/cam/diffusion_solver.F90 create mode 100644 src/physics/cam/eddy_diff.F90 create mode 100644 src/physics/cam/eddy_diff_cam.F90 create mode 100644 src/physics/cam/flux_avg.F90 create mode 100644 src/physics/cam/geopotential.F90 create mode 100644 src/physics/cam/ghg_data.F90 create mode 100644 src/physics/cam/gw_common.F90 create mode 100644 src/physics/cam/gw_convect.F90 create mode 100644 src/physics/cam/gw_diffusion.F90 create mode 100644 src/physics/cam/gw_drag.F90 create mode 100644 src/physics/cam/gw_front.F90 create mode 100644 src/physics/cam/gw_oro.F90 create mode 100644 src/physics/cam/gw_rdg.F90 create mode 100644 src/physics/cam/gw_utils.F90 create mode 100644 src/physics/cam/hb_diff.F90 create mode 100644 src/physics/cam/hetfrz_classnuc.F90 create mode 100644 src/physics/cam/hetfrz_classnuc_cam.F90 create mode 100644 src/physics/cam/hk_conv.F90 create mode 100644 src/physics/cam/iondrag.F90 create mode 100644 src/physics/cam/iop_forcing.F90 create mode 100644 src/physics/cam/macrop_driver.F90 create mode 100644 src/physics/cam/micro_mg1_0.F90 create mode 100644 src/physics/cam/micro_mg2_0.F90 create mode 100644 src/physics/cam/micro_mg_cam.F90 create mode 100644 src/physics/cam/micro_mg_data.F90 create mode 100644 src/physics/cam/micro_mg_utils.F90 create mode 100644 src/physics/cam/microp_aero.F90 create mode 100644 src/physics/cam/microp_driver.F90 create mode 100644 src/physics/cam/modal_aer_opt.F90 create mode 100644 src/physics/cam/molec_diff.F90 create mode 100644 src/physics/cam/ndrop.F90 create mode 100644 src/physics/cam/ndrop_bam.F90 create mode 100644 src/physics/cam/nucleate_ice.F90 create mode 100644 src/physics/cam/nucleate_ice_cam.F90 create mode 100644 src/physics/cam/pbl_utils.F90 create mode 100644 src/physics/cam/phys_control.F90 create mode 100644 src/physics/cam/phys_debug.F90 create mode 100644 src/physics/cam/phys_debug_util.F90 create mode 100644 src/physics/cam/phys_gmean.F90 create mode 100644 src/physics/cam/phys_grid.F90 create mode 100644 src/physics/cam/phys_prop.F90 create mode 100644 src/physics/cam/physics_buffer.F90.in create mode 100644 src/physics/cam/physics_types.F90 create mode 100644 src/physics/cam/physpkg.F90 create mode 100644 src/physics/cam/pkg_cld_sediment.F90 create mode 100644 src/physics/cam/pkg_cldoptics.F90 create mode 100644 src/physics/cam/polar_avg.F90 create mode 100644 src/physics/cam/ppgrid.F90 create mode 100644 src/physics/cam/qbo.F90 create mode 100644 src/physics/cam/qneg_module.F90 create mode 100644 src/physics/cam/rad_constituents.F90 create mode 100644 src/physics/cam/radheat.F90 create mode 100644 src/physics/cam/radiation_data.F90 create mode 100644 src/physics/cam/rayleigh_friction.F90 create mode 100644 src/physics/cam/ref_pres.F90 create mode 100644 src/physics/cam/restart_physics.F90 create mode 100644 src/physics/cam/rk_stratiform.F90 create mode 100644 src/physics/cam/spcam_drivers.F90 create mode 100644 src/physics/cam/sslt_rebin.F90 create mode 100644 src/physics/cam/subcol.F90 create mode 100644 src/physics/cam/subcol_pack_mod.F90.in create mode 100644 src/physics/cam/subcol_tstcp.F90 create mode 100644 src/physics/cam/subcol_utils.F90.in create mode 100644 src/physics/cam/tidal_diag.F90 create mode 100644 src/physics/cam/tracers.F90 create mode 100644 src/physics/cam/tracers_suite.F90 create mode 100644 src/physics/cam/trb_mtn_stress.F90 create mode 100644 src/physics/cam/trb_mtn_stress_cam.F90 create mode 100644 src/physics/cam/tropopause.F90 create mode 100644 src/physics/cam/unicon.F90 create mode 100644 src/physics/cam/unicon_cam.F90 create mode 100644 src/physics/cam/unicon_utils.F90 create mode 100644 src/physics/cam/uwshcu.F90 create mode 100644 src/physics/cam/vdiff_lu_solver.F90 create mode 100644 src/physics/cam/vertical_diffusion.F90 create mode 100644 src/physics/cam/waccmx_phys_intr.F90 create mode 100644 src/physics/cam/wv_sat_methods.F90 create mode 100644 src/physics/cam/wv_saturation.F90 create mode 100644 src/physics/cam/zm_conv.F90 create mode 100644 src/physics/cam/zm_conv_intr.F90 create mode 100644 src/physics/cam/zm_microphysics.F90 create mode 100644 src/physics/camrt/rad_solar_var.F90 create mode 100644 src/physics/camrt/radae.F90 create mode 100644 src/physics/camrt/radconstants.F90 create mode 100644 src/physics/camrt/radiation.F90 create mode 100644 src/physics/camrt/radlw.F90 create mode 100644 src/physics/camrt/radsw.F90 create mode 100644 src/physics/carma/cam/carma_cloudfraction.F90 create mode 100644 src/physics/carma/cam/carma_constants_mod.F90 create mode 100644 src/physics/carma/cam/carma_getH2O.F90 create mode 100644 src/physics/carma/cam/carma_getH2SO4.F90 create mode 100644 src/physics/carma/cam/carma_getT.F90 create mode 100644 src/physics/carma/cam/carma_intr.F90 create mode 100644 src/physics/carma/cam/carma_precision_mod.F90 create mode 100644 src/physics/carma/models/bc_strat/carma_model_mod.F90 create mode 100644 src/physics/carma/models/cirrus/carma_cloudfraction.F90 create mode 100644 src/physics/carma/models/cirrus/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/cirrus/carma_model_mod.F90 create mode 100644 src/physics/carma/models/cirrus/growevapl.F90 create mode 100644 src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 create mode 100644 src/physics/carma/models/cirrus_dust/carma_mod.F90 create mode 100644 src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/cirrus_dust/carma_model_mod.F90 create mode 100644 src/physics/carma/models/cirrus_dust/growevapl.F90 create mode 100644 src/physics/carma/models/cirrus_dust/hetnucl.F90 create mode 100644 src/physics/carma/models/dust/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/dust/carma_model_mod.F90 create mode 100644 src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 create mode 100755 src/physics/carma/models/meteor_impact/carma_model_mod.F90 create mode 100644 src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/meteor_smoke/carma_model_mod.F90 create mode 100644 src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 create mode 100644 src/physics/carma/models/pmc/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/pmc/carma_model_mod.F90 create mode 100644 src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 create mode 100644 src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/sea_salt/carma_model_mod.F90 create mode 100644 src/physics/carma/models/sulfate/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_detrain/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_growth/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_passive/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_radiative/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_swelling/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/test_tracers/carma_model_mod.F90 create mode 100644 src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/test_tracers2/carma_model_mod.F90 create mode 100644 src/physics/carma/models/tholin/carma_model_flags_mod.F90 create mode 100755 src/physics/carma/models/tholin/carma_model_mod.F90 create mode 100644 src/physics/cosp2/Makefile.in create mode 100644 src/physics/cosp2/cosp_errorHandling.F90 create mode 100644 src/physics/cosp2/cosp_kinds.F90 create mode 100644 src/physics/cosp2/optics/array_lib.F90 create mode 100644 src/physics/cosp2/optics/cosp_optics.F90 create mode 100644 src/physics/cosp2/optics/cosp_utils.F90 create mode 100644 src/physics/cosp2/optics/math_lib.F90 create mode 100644 src/physics/cosp2/optics/mrgrnk.F90 create mode 100644 src/physics/cosp2/optics/optics_lib.F90 create mode 100644 src/physics/cosp2/optics/quickbeam_optics.F90 create mode 100644 src/physics/cosp2/subcol/mo_rng.F90 create mode 100644 src/physics/cosp2/subcol/prec_scops.F90 create mode 100644 src/physics/cosp2/subcol/scops.F90 create mode 100644 src/physics/rrtmg/aer_src/mcica_subcol_gen_lw.f90 create mode 100644 src/physics/rrtmg/aer_src/mcica_subcol_gen_sw.f90 create mode 100644 src/physics/rrtmg/aer_src/parrrsw.f90 create mode 100644 src/physics/rrtmg/aer_src/parrrtm.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_con.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg01.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg02.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg03.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg04.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg05.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg06.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg07.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg08.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg09.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg10.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg11.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg12.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg13.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg14.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg15.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_kg16.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_ref.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_tbl.f90 create mode 100644 src/physics/rrtmg/aer_src/rrlw_wvn.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_con.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg16.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg17.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg18.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg19.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg20.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg21.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg22.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg23.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg24.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg25.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg26.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg27.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg28.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_kg29.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_ref.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_tbl.f90 create mode 100644 src/physics/rrtmg/aer_src/rrsw_wvn.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_setcoef.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_setcoef.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 create mode 100644 src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 create mode 100644 src/physics/rrtmg/cloud_rad_props.F90 create mode 100644 src/physics/rrtmg/ebert_curry.F90 create mode 100644 src/physics/rrtmg/oldcloud.F90 create mode 100644 src/physics/rrtmg/rad_solar_var.F90 create mode 100644 src/physics/rrtmg/radconstants.F90 create mode 100644 src/physics/rrtmg/radiation.F90 create mode 100644 src/physics/rrtmg/radlw.F90 create mode 100644 src/physics/rrtmg/radsw.F90 create mode 100644 src/physics/rrtmg/rrtmg_state.F90 create mode 100644 src/physics/rrtmg/slingo.F90 create mode 100644 src/physics/simple/held_suarez.F90 create mode 100644 src/physics/simple/held_suarez_cam.F90 create mode 100644 src/physics/simple/kessler_cam.F90 create mode 100644 src/physics/simple/kessler_mod.F90 create mode 100644 src/physics/simple/physpkg.F90 create mode 100644 src/physics/simple/radconstants.F90 create mode 100644 src/physics/simple/radiation.F90 create mode 100644 src/physics/simple/restart_physics.F90 create mode 100644 src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 create mode 100644 src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 create mode 100644 src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 create mode 100644 src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_array_index.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_calendar.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_endian.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_error_code.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_input_names.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_mt95.f90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_saturation.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 create mode 100644 src/physics/spcam/crm/CLUBB/recl.inc create mode 100644 src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 create mode 100644 src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 create mode 100644 src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 create mode 100644 src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 create mode 100644 src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 create mode 100644 src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 create mode 100644 src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 create mode 100644 src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 create mode 100644 src/physics/spcam/crm/crmx_abcoefs.F90 create mode 100644 src/physics/spcam/crm/crmx_adams.F90 create mode 100644 src/physics/spcam/crm/crmx_advect2_mom_xy.F90 create mode 100644 src/physics/spcam/crm/crmx_advect2_mom_z.F90 create mode 100644 src/physics/spcam/crm/crmx_advect_all_scalars.F90 create mode 100644 src/physics/spcam/crm/crmx_advect_mom.F90 create mode 100644 src/physics/spcam/crm/crmx_atmosphere.F90 create mode 100644 src/physics/spcam/crm/crmx_bound_duvdt.F90 create mode 100644 src/physics/spcam/crm/crmx_bound_exchange.F90 create mode 100644 src/physics/spcam/crm/crmx_boundaries.F90 create mode 100644 src/physics/spcam/crm/crmx_buoyancy.F90 create mode 100644 src/physics/spcam/crm/crmx_compress3D.F90 create mode 100644 src/physics/spcam/crm/crmx_coriolis.F90 create mode 100644 src/physics/spcam/crm/crmx_crm_module.F90 create mode 100644 src/physics/spcam/crm/crmx_crmsurface.F90 create mode 100644 src/physics/spcam/crm/crmx_crmtracers.F90 create mode 100644 src/physics/spcam/crm/crmx_damping.F90 create mode 100644 src/physics/spcam/crm/crmx_diagnose.F90 create mode 100644 src/physics/spcam/crm/crmx_domain.F90 create mode 100644 src/physics/spcam/crm/crmx_ecppvars.F90 create mode 100644 src/physics/spcam/crm/crmx_forcing.F90 create mode 100644 src/physics/spcam/crm/crmx_grid.F90 create mode 100644 src/physics/spcam/crm/crmx_ice_fall.F90 create mode 100644 src/physics/spcam/crm/crmx_kurant.F90 create mode 100644 src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 create mode 100644 src/physics/spcam/crm/crmx_module_ecpp_stats.F90 create mode 100644 src/physics/spcam/crm/crmx_params.F90 create mode 100644 src/physics/spcam/crm/crmx_periodic.F90 create mode 100644 src/physics/spcam/crm/crmx_precip_fall.F90 create mode 100644 src/physics/spcam/crm/crmx_press_grad.F90 create mode 100644 src/physics/spcam/crm/crmx_press_rhs.F90 create mode 100644 src/physics/spcam/crm/crmx_pressure.F90 create mode 100644 src/physics/spcam/crm/crmx_random.F90 create mode 100644 src/physics/spcam/crm/crmx_sat.F90 create mode 100644 src/physics/spcam/crm/crmx_setparm.F90 create mode 100644 src/physics/spcam/crm/crmx_setperturb.F90 create mode 100644 src/physics/spcam/crm/crmx_stepout.F90 create mode 100644 src/physics/spcam/crm/crmx_task_init.F90 create mode 100644 src/physics/spcam/crm/crmx_task_util_NOMPI.F90 create mode 100644 src/physics/spcam/crm/crmx_utils.F90 create mode 100644 src/physics/spcam/crm/crmx_uvw.F90 create mode 100644 src/physics/spcam/crm/crmx_vars.F90 create mode 100644 src/physics/spcam/crm/crmx_zero.F90 create mode 100644 src/physics/spcam/crm/fft.F create mode 100644 src/physics/spcam/crm/gammafff.c create mode 100644 src/physics/spcam/crm_physics.F90 create mode 100644 src/physics/spcam/crmclouds_camaerosols.F90 create mode 100644 src/physics/spcam/crmdims.F90 create mode 100644 src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 create mode 100644 src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 create mode 100644 src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 create mode 100644 src/physics/spcam/ecpp/module_data_ecpp1.F90 create mode 100644 src/physics/spcam/ecpp/module_data_mosaic_asect.F90 create mode 100644 src/physics/spcam/ecpp/module_data_radm2.F90 create mode 100644 src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 create mode 100644 src/physics/spcam/ecpp/module_ecpp_td2clm.F90 create mode 100644 src/physics/spcam/ecpp/module_ecpp_util.F90 create mode 100644 src/physics/spcam/spcam_drivers.F90 create mode 100644 src/physics/waccm/efield.F90 create mode 100644 src/physics/waccm/exbdrift.F90 create mode 100644 src/physics/waccm/iondrag.F90 create mode 100644 src/physics/waccm/mag_parms.F90 create mode 100644 src/physics/waccm/mo_aurora.F90 create mode 100644 src/physics/waccm/nlte_fomichev.F90 create mode 100644 src/physics/waccm/nlte_lw.F90 create mode 100644 src/physics/waccm/qbo.F90 create mode 100644 src/physics/waccm/radheat.F90 create mode 100644 src/physics/waccm/waccm_forcing.F90 create mode 100644 src/physics/waccm/wei05sc.F90 create mode 100644 src/physics/waccm/wei96.F90 create mode 100644 src/physics/waccmx/ion_electron_temp.F90 create mode 100644 src/physics/waccmx/majorsp_diffusion.F90 create mode 100644 src/unit_drivers/aur/unit_driver.F90 create mode 100644 src/unit_drivers/drv_input_data.F90 create mode 100644 src/unit_drivers/offline_driver.F90 create mode 100644 src/unit_drivers/rad/README create mode 100644 src/unit_drivers/rad/unit_driver.F90 create mode 100644 src/unit_drivers/stub/unit_driver.F90 create mode 100644 src/utils/CMakeLists.txt create mode 100644 src/utils/bnddyi.F90 create mode 100644 src/utils/buffer.F90.in create mode 100644 src/utils/cam_abortutils.F90 create mode 100644 src/utils/cam_aqua/cpl/ocn_comp_mct.F90 create mode 100644 src/utils/cam_aqua/ocn_comp.F90 create mode 100644 src/utils/cam_aqua/ocn_types.F90 create mode 100644 src/utils/cam_dom/ocn_comp.F90 create mode 100644 src/utils/cam_dom/ocn_comp_mct.F90 create mode 100644 src/utils/cam_dom/ocn_filenames.F90 create mode 100644 src/utils/cam_dom/ocn_spmd.F90 create mode 100644 src/utils/cam_dom/ocn_time_manager.F90 create mode 100644 src/utils/cam_dom/ocn_types.F90 create mode 100644 src/utils/cam_dom/sst_data.F90 create mode 100644 src/utils/cam_grid_support.F90 create mode 100644 src/utils/cam_map_utils.F90 create mode 100644 src/utils/cam_pio_utils.F90 create mode 100644 src/utils/coords_1d.F90 create mode 100644 src/utils/datetime.F90 create mode 100644 src/utils/dtypes.h create mode 100644 src/utils/error_messages.F90 create mode 100644 src/utils/fft99.F90 create mode 100644 src/utils/gauaw_mod.F90 create mode 100644 src/utils/gmean_mod.F90 create mode 100644 src/utils/hycoef.F90 create mode 100644 src/utils/infnan.F90 create mode 100644 src/utils/interpolate_data.F90 create mode 100644 src/utils/intp_util.F90 create mode 100644 src/utils/ioFileMod.F90 create mode 100644 src/utils/linear_1d_operators.F90 create mode 100644 src/utils/marsaglia.F90 create mode 100644 src/utils/mpishorthand.F create mode 100644 src/utils/namelist_utils.F90 create mode 100644 src/utils/orbit.F90 create mode 100644 src/utils/physconst.F90 create mode 100644 src/utils/pilgrim/Makefile create mode 100644 src/utils/pilgrim/Makefile.conf.AIX create mode 100644 src/utils/pilgrim/Makefile.conf.IRIX64 create mode 100644 src/utils/pilgrim/Makefile.conf.Linux create mode 100644 src/utils/pilgrim/Makefile.conf.Linux.FFC create mode 100644 src/utils/pilgrim/Makefile.conf.Linux.LF95 create mode 100644 src/utils/pilgrim/Makefile.conf.Linux.PGI create mode 100644 src/utils/pilgrim/README create mode 100755 src/utils/pilgrim/configure create mode 100644 src/utils/pilgrim/debug.h create mode 100644 src/utils/pilgrim/debugutilitiesmodule.F90 create mode 100644 src/utils/pilgrim/decompmodule.F90 create mode 100644 src/utils/pilgrim/ghostmodule.F90 create mode 100644 src/utils/pilgrim/memstuff.c create mode 100644 src/utils/pilgrim/mlp_ptr.h create mode 100644 src/utils/pilgrim/mod_comm.F90 create mode 100644 src/utils/pilgrim/mp_assign_to_cpu.c create mode 100644 src/utils/pilgrim/parutilitiesmodule.F90 create mode 100644 src/utils/pilgrim/pilgrim.h create mode 100644 src/utils/pilgrim/puminterfaces.F90 create mode 100644 src/utils/pilgrim/redistributemodule.F90 create mode 100644 src/utils/pilgrim/unit_testers/Makefile create mode 100644 src/utils/pilgrim/unit_testers/README create mode 100644 src/utils/pilgrim/unit_testers/decomptest.F90 create mode 100644 src/utils/pilgrim/unit_testers/ghosttest.F90 create mode 100644 src/utils/pilgrim/unit_testers/parpatterntest.F90 create mode 100644 src/utils/pilgrim/unit_testers/parutilitiestest.F90 create mode 100644 src/utils/pilgrim/unit_testers/redistributetest.F90 create mode 100644 src/utils/pilgrim/unit_testers/unstructured.F90 create mode 100644 src/utils/quicksort.F90 create mode 100644 src/utils/sgexx.F90 create mode 100644 src/utils/spmd_utils.F90 create mode 100644 src/utils/srchutil.F90 create mode 100644 src/utils/string_utils.F90 create mode 100644 src/utils/time_manager.F90 create mode 100644 src/utils/units.F90 create mode 100644 src/utils/vrtmap.F90 create mode 100644 src/utils/wrap_mpi.F90 create mode 100644 src/utils/wrap_nf.F90 create mode 100644 src/utils/xpavg_mod.F90 create mode 100755 test/system/CAM_compare.sh create mode 100755 test/system/CAM_runcmnd.sh create mode 100755 test/system/CAM_utils.sh create mode 100755 test/system/TBL.sh create mode 100755 test/system/TBL_ccsm.sh create mode 100755 test/system/TBR.sh create mode 100755 test/system/TCB.sh create mode 100755 test/system/TCB_ccsm.sh create mode 100755 test/system/TDD.sh create mode 100755 test/system/TEQ.sh create mode 100755 test/system/TEQ_ccsm.sh create mode 100755 test/system/TER.sh create mode 100755 test/system/TER_ccsm.sh create mode 100755 test/system/TFM.sh create mode 100755 test/system/TGIT.sh create mode 100755 test/system/TMC.sh create mode 100755 test/system/TNE_ccsm.sh create mode 100755 test/system/TPF.sh create mode 100755 test/system/TR8.sh create mode 100755 test/system/TSC.sh create mode 100755 test/system/TSM.sh create mode 100755 test/system/TSM_ccsm.sh create mode 100755 test/system/archive_baseline.sh create mode 100644 test/system/config_files/e48adh create mode 100644 test/system/config_files/e48c4paqdm create mode 100644 test/system/config_files/e48idh create mode 100644 test/system/config_files/e64addh create mode 100644 test/system/config_files/e64adh create mode 100644 test/system/config_files/e64c4aqiopdm create mode 100644 test/system/config_files/e64c5aqiopdm create mode 100644 test/system/config_files/e64c6aqiopdm create mode 100644 test/system/config_files/e64hsdh create mode 100644 test/system/config_files/e8c3aqdm create mode 100644 test/system/config_files/e8c4aqdm create mode 100644 test/system/config_files/e8c5aqt5mdm create mode 100644 test/system/config_files/e8idm create mode 100644 test/system/config_files/f1.9c4aqbamm create mode 100644 test/system/config_files/f1.9c4aqh create mode 100644 test/system/config_files/f1.9c4aqmozdh create mode 100644 test/system/config_files/f1.9c4aqwmxdh create mode 100644 test/system/config_files/f1.9c4aqwmxidh create mode 100644 test/system/config_files/f1.9c4cdm create mode 100644 test/system/config_files/f1.9c4h create mode 100755 test/system/config_files/f1.9c4portdh create mode 100755 test/system/config_files/f1.9c4portdm create mode 100755 test/system/config_files/f1.9c4wmdh create mode 100644 test/system/config_files/f1.9c4wmh create mode 100644 test/system/config_files/f1.9c4wmm create mode 100644 test/system/config_files/f1.9c4wscdm create mode 100755 test/system/config_files/f1.9c4wtsmltdh create mode 100755 test/system/config_files/f1.9c4wtsmlth create mode 100644 test/system/config_files/f1.9c5aqm create mode 100644 test/system/config_files/f1.9c5carmdusdm create mode 100644 test/system/config_files/f1.9c5carmdusm create mode 100644 test/system/config_files/f1.9c6aqcdh create mode 100644 test/system/config_files/f1.9c6aqcdm create mode 100644 test/system/config_files/f1.9c6aqtsvbsdh create mode 100644 test/system/config_files/f1.9c6aqwmth create mode 100644 test/system/config_files/f1.9c6aqwscdh create mode 100644 test/system/config_files/f10adhterm create mode 100644 test/system/config_files/f10c3aqdm create mode 100644 test/system/config_files/f10c4aqwmxdm create mode 100644 test/system/config_files/f10c4aqwscdm create mode 100644 test/system/config_files/f10c5aqcdm create mode 100644 test/system/config_files/f10c5aqcmtt1dm create mode 100644 test/system/config_files/f10c5aqdm create mode 100644 test/system/config_files/f10c5aqpbadm create mode 100644 test/system/config_files/f10c5aqscdm create mode 100644 test/system/config_files/f10c5aqt5mdm create mode 100644 test/system/config_files/f10c5aqudm create mode 100644 test/system/config_files/f10c6aqcdm create mode 100644 test/system/config_files/f10c6aqdm create mode 100644 test/system/config_files/f10c6aqt5mdm create mode 100644 test/system/config_files/f10c6aqtsvbsdm create mode 100644 test/system/config_files/f10c6aqwmadm create mode 100644 test/system/config_files/f10idm create mode 100644 test/system/config_files/f10spmaqdm create mode 100644 test/system/config_files/f10spsaqdm create mode 100644 test/system/config_files/f4adh create mode 100644 test/system/config_files/f4c4aqdh create mode 100755 test/system/config_files/f4c4aqprgspcdm create mode 100644 test/system/config_files/f4c4aqwmxdm create mode 100644 test/system/config_files/f4c4aqwmxidm create mode 100644 test/system/config_files/f4c4aqwmxiedm create mode 100644 test/system/config_files/f4c4paqdh create mode 100755 test/system/config_files/f4c4wtsmltdh create mode 100644 test/system/config_files/f4c5dh create mode 100755 test/system/config_files/f4c5portdh create mode 100755 test/system/config_files/f4c5portdm create mode 100644 test/system/config_files/f4c6aqwmadm create mode 100644 test/system/config_files/f4c6aqwmtdm create mode 100644 test/system/config_files/f4idm create mode 100644 test/system/config_files/fsd1.9c4mozdh create mode 100755 test/system/config_files/fsd1.9c4wmdh create mode 100755 test/system/config_files/fsd1.9c4wmh create mode 100755 test/system/config_files/fsd1.9c4wtsmltdh create mode 100755 test/system/config_files/fsd1.9c4wtsmlth create mode 100644 test/system/config_files/h16.3c4aqdm create mode 100644 test/system/config_files/h16.3c5aqt5dh create mode 100644 test/system/config_files/h16adh create mode 100644 test/system/config_files/h16adtermdh create mode 100644 test/system/config_files/h16c3aqdh create mode 100644 test/system/config_files/h16c4aqdm create mode 100644 test/system/config_files/h16c5aqdm create mode 100644 test/system/config_files/h16c5naqdm create mode 100644 test/system/config_files/h16c6aqdm create mode 100644 test/system/config_files/h16c6aqh create mode 100644 test/system/config_files/h16idm create mode 100644 test/system/config_files/h16kstich create mode 100644 test/system/config_files/h30c4aqdm create mode 100644 test/system/config_files/h5.2addm create mode 100644 test/system/config_files/h5.3addm create mode 100644 test/system/config_files/h5.3adds create mode 100644 test/system/config_files/h5.3adicdm create mode 100644 test/system/config_files/h5.3c5aqdm create mode 100644 test/system/config_files/h5.3c5aqt5mdm create mode 100644 test/system/config_files/h5.4addm create mode 100644 test/system/config_files/h5addm create mode 100644 test/system/config_files/h5adds create mode 100644 test/system/config_files/h5adicdm create mode 100644 test/system/config_files/h5c5aqbamdm create mode 100644 test/system/config_files/h5c5aqdm create mode 100644 test/system/config_files/h5c5aqt5mdm create mode 100644 test/system/config_files/scmc4aqds create mode 100644 test/system/config_files/scmc5aqds create mode 100644 test/system/config_files/scmc6aqds create mode 100644 test/system/config_files/testmech create mode 100755 test/system/find_mergeinfo.sh create mode 100755 test/system/gen-test-coverage create mode 100644 test/system/gen-test-style.css create mode 100755 test/system/gen-test-table create mode 100644 test/system/input_tests_master create mode 100644 test/system/nl_files/adia create mode 100644 test/system/nl_files/aqpgro create mode 100644 test/system/nl_files/aqua create mode 100644 test/system/nl_files/co2rmp create mode 100644 test/system/nl_files/fcase create mode 100644 test/system/nl_files/ghgrmp create mode 100644 test/system/nl_files/ghgrmp_e8 create mode 100644 test/system/nl_files/ghgrmp_f4 create mode 100644 test/system/nl_files/ghgrmp_unstruct create mode 100644 test/system/nl_files/idphys create mode 100644 test/system/nl_files/outfrq1m create mode 100644 test/system/nl_files/outfrq1s create mode 100644 test/system/nl_files/outfrq1s_carma create mode 100644 test/system/nl_files/outfrq1s_clubb create mode 100644 test/system/nl_files/outfrq1s_hist create mode 100644 test/system/nl_files/outfrq24h create mode 100644 test/system/nl_files/outfrq24h_carma create mode 100644 test/system/nl_files/outfrq24h_epp create mode 100644 test/system/nl_files/outfrq24h_port create mode 100644 test/system/nl_files/outfrq3s create mode 100644 test/system/nl_files/outfrq3s_2005 create mode 100644 test/system/nl_files/outfrq3s_NEUwetdep create mode 100644 test/system/nl_files/outfrq3s_am create mode 100644 test/system/nl_files/outfrq3s_bwic create mode 100644 test/system/nl_files/outfrq3s_carma create mode 100644 test/system/nl_files/outfrq3s_carma2000 create mode 100644 test/system/nl_files/outfrq3s_carma_fractal create mode 100644 test/system/nl_files/outfrq3s_convmic create mode 100644 test/system/nl_files/outfrq3s_cosp create mode 100644 test/system/nl_files/outfrq3s_diags create mode 100644 test/system/nl_files/outfrq3s_epp create mode 100644 test/system/nl_files/outfrq3s_euv create mode 100644 test/system/nl_files/outfrq3s_f19c6aqwsc create mode 100644 test/system/nl_files/outfrq3s_gw_igw create mode 100644 test/system/nl_files/outfrq3s_gw_sh create mode 100644 test/system/nl_files/outfrq3s_ionos create mode 100644 test/system/nl_files/outfrq3s_lb0 create mode 100644 test/system/nl_files/outfrq3s_lb2 create mode 100644 test/system/nl_files/outfrq3s_megan create mode 100644 test/system/nl_files/outfrq3s_modalstrat create mode 100644 test/system/nl_files/outfrq3s_mozEOOH create mode 100644 test/system/nl_files/outfrq3s_neu create mode 100644 test/system/nl_files/outfrq3s_newyear create mode 100644 test/system/nl_files/outfrq3s_sd create mode 100644 test/system/nl_files/outfrq3s_subcol create mode 100644 test/system/nl_files/outfrq3s_sums create mode 100644 test/system/nl_files/outfrq3s_unstruct create mode 100644 test/system/nl_files/outfrq9s create mode 100644 test/system/nl_files/port_cam4 create mode 100644 test/system/nl_files/rad_diag create mode 100644 test/system/nl_files/rad_diag_mam create mode 100644 test/system/nl_files/sat_hist create mode 100644 test/system/nl_files/scm_b4b_o1 create mode 100644 test/system/nl_files/scm_prep create mode 100644 test/system/nl_files/scmarm create mode 100644 test/system/nl_files/terminator create mode 100644 test/system/nl_files/ttrac create mode 100644 test/system/nl_files/ttrac_lb0 create mode 100644 test/system/nl_files/ttrac_lb1 create mode 100644 test/system/nl_files/ttrac_lb2 create mode 100644 test/system/nl_files/ttrac_lb3 create mode 100644 test/system/nl_files/volc create mode 100755 test/system/tag_email.sh create mode 100755 test/system/test_driver.sh create mode 100644 test/system/tests_carma create mode 100644 test/system/tests_chem_hybrid create mode 100644 test/system/tests_chem_mpi create mode 100644 test/system/tests_pretag_cheyenne create mode 100644 test/system/tests_pretag_hobart_nag create mode 100644 test/system/tests_pretag_hobart_pgi create mode 100644 test/system/tests_pretag_leehill create mode 100644 test/system/tests_waccm_hybrid create mode 100644 test/system/tests_waccm_mpi create mode 100644 test/unit/CMakeLists.txt create mode 100644 test/unit/README.txt create mode 100644 test/unit/coords_1d/CMakeLists.txt create mode 100644 test/unit/coords_1d/test_coords_1d.pf create mode 100644 test/unit/linear_1d_operators/CMakeLists.txt create mode 100644 test/unit/linear_1d_operators/test_arithmetic.pf create mode 100644 test/unit/linear_1d_operators/test_derivatives.pf create mode 100644 test/unit/linear_1d_operators/test_diagonal.pf create mode 100644 test/unit/micro_mg_data/CMakeLists.txt create mode 100644 test/unit/micro_mg_data/test_MGFieldPostProc.pf create mode 100644 test/unit/micro_mg_data/test_MGPacker.pf create mode 100644 test/unit/micro_mg_data/test_MGPostProc.pf create mode 100644 test/unit/micro_mg_utils/CMakeLists.txt create mode 100644 test/unit/micro_mg_utils/test_mg_processes.pf create mode 100644 test/unit/micro_mg_utils/test_mg_size_utils.pf create mode 100644 test/unit/vdiff_lu_solver/CMakeLists.txt create mode 100644 test/unit/vdiff_lu_solver/test_fd_solver.pf create mode 100644 test/unit/vdiff_lu_solver/test_fv_solver.pf create mode 100644 tools/README create mode 100644 tools/definehires/Makefile create mode 100644 tools/definehires/README create mode 100644 tools/definehires/gtopo30_to_10min.F90 create mode 100644 tools/definehires/shr_kind_mod.F90 create mode 100644 tools/definesurf/Makefile create mode 100644 tools/definesurf/README create mode 100644 tools/definesurf/ao.f90 create mode 100644 tools/definesurf/ao_i.f90 create mode 100644 tools/definesurf/area_ave.f90 create mode 100644 tools/definesurf/binf2c.f90 create mode 100644 tools/definesurf/cell_area.f90 create mode 100644 tools/definesurf/chkdims.f90 create mode 100644 tools/definesurf/endrun.f90 create mode 100644 tools/definesurf/fmain.f90 create mode 100644 tools/definesurf/handle_error.f90 create mode 100644 tools/definesurf/inimland.f90 create mode 100644 tools/definesurf/interplandm.f90 create mode 100644 tools/definesurf/lininterp.f90 create mode 100644 tools/definesurf/map2f.f90 create mode 100644 tools/definesurf/map_i.f90 create mode 100644 tools/definesurf/max_ovr.f90 create mode 100644 tools/definesurf/sghphis.f90 create mode 100644 tools/definesurf/shr_kind_mod.f90 create mode 100644 tools/definesurf/sm121.f90 create mode 100644 tools/definesurf/terrain_filter.f90 create mode 100644 tools/definesurf/varf2c.f90 create mode 100644 tools/definesurf/wrap_nf.f90 create mode 100644 tools/icesst/Makefile create mode 100644 tools/icesst/README create mode 100644 tools/icesst/bcgen/Makefile create mode 100644 tools/icesst/bcgen/bcgen.f90 create mode 100644 tools/icesst/bcgen/calcclim.f90 create mode 100644 tools/icesst/bcgen/calcfull.f90 create mode 100644 tools/icesst/bcgen/driver.f90 create mode 100644 tools/icesst/bcgen/namelist create mode 100644 tools/icesst/bcgen/output_dateinfo.f90 create mode 100644 tools/icesst/bcgen/prec.f90 create mode 100644 tools/icesst/bcgen/setup_outfile.f90 create mode 100644 tools/icesst/bcgen/solver.f90 create mode 100644 tools/icesst/bcgen/types.f90 create mode 100644 tools/icesst/bcgen/types.inc create mode 100644 tools/icesst/bcgen/wrap_nf.f90 create mode 100644 tools/icesst/regrid/CREATE_DIMS_GAU.ncl create mode 100644 tools/icesst/regrid/CREATE_DIMS_REG.ncl create mode 100644 tools/icesst/regrid/Makefile create mode 100755 tools/icesst/regrid/REGRID.pl create mode 100644 tools/icesst/regrid/ao.f90 create mode 100644 tools/icesst/regrid/ao_i.f90 create mode 100644 tools/icesst/regrid/area_ave.f90 create mode 100644 tools/icesst/regrid/binf2c.f90 create mode 100644 tools/icesst/regrid/cell_area.f90 create mode 100644 tools/icesst/regrid/err_exit.f90 create mode 100644 tools/icesst/regrid/interp_driver.f90 create mode 100644 tools/icesst/regrid/lininterp.f90 create mode 100644 tools/icesst/regrid/map_i.f90 create mode 100644 tools/icesst/regrid/max_ovr.f90 create mode 100644 tools/icesst/regrid/precision.f90 create mode 100644 tools/icesst/regrid/regrid.f90 create mode 100644 tools/icesst/regrid/wrap_nf.f90 create mode 100644 tools/interpaerosols/CREATE_DIMS_GAU.ncl create mode 100644 tools/interpaerosols/CREATE_DIMS_REG.ncl create mode 100644 tools/interpaerosols/Makefile create mode 100644 tools/interpaerosols/README create mode 100755 tools/interpaerosols/REGRID.pl create mode 100644 tools/interpaerosols/addglobal.F90 create mode 100644 tools/interpaerosols/driver.f90 create mode 100644 tools/interpaerosols/fmain.F90 create mode 100644 tools/interpaerosols/globals.f90 create mode 100644 tools/interpaerosols/preserve_mean.f90 create mode 100644 tools/interpic/Makefile create mode 100644 tools/interpic/README create mode 100644 tools/interpic/addglobal.f90 create mode 100644 tools/interpic/compare_var.f90 create mode 100644 tools/interpic/control.f90 create mode 100644 tools/interpic/cpvar.f90 create mode 100644 tools/interpic/create_template.ncl create mode 100644 tools/interpic/dimensions.f90 create mode 100644 tools/interpic/driver.f90 create mode 100644 tools/interpic/err_exit.f90 create mode 100644 tools/interpic/fill_positions.f90 create mode 100644 tools/interpic/fmain.f90 create mode 100644 tools/interpic/handle_special_cases.f90 create mode 100644 tools/interpic/interp_driver.f90 create mode 100644 tools/interpic/is_special_case.f90 create mode 100644 tools/interpic/lininterp.f90 create mode 100644 tools/interpic/shr_kind_mod.f90 create mode 100644 tools/interpic/template.ncl create mode 100644 tools/interpic/varspecs_mod.f90 create mode 100644 tools/interpic/wrap_nf.f90 create mode 100644 tools/interpic_new/Makefile create mode 100644 tools/interpic_new/README create mode 100644 tools/interpic_new/addglobal.F90 create mode 100644 tools/interpic_new/compare_var.F90 create mode 100644 tools/interpic_new/control.F90 create mode 100644 tools/interpic_new/cpvar.F90 create mode 100644 tools/interpic_new/dimensions.F90 create mode 100644 tools/interpic_new/driver.F90 create mode 100644 tools/interpic_new/err_exit.F90 create mode 100644 tools/interpic_new/fill_positions.F90 create mode 100644 tools/interpic_new/fmain.F90 create mode 100644 tools/interpic_new/handle_special_cases.F90 create mode 100644 tools/interpic_new/interp.F90 create mode 100644 tools/interpic_new/interpolate_data.F90 create mode 100644 tools/interpic_new/is_special_case.F90 create mode 100644 tools/interpic_new/shr_kind_mod.F90 create mode 100644 tools/interpic_new/wrap_nf.F90 create mode 100644 tools/mkatmsrffile/Makefile create mode 100644 tools/mkatmsrffile/README create mode 100644 tools/mkatmsrffile/mkatmsrffile.F90 create mode 100644 tools/mkatmsrffile/mkatmsrffile.rc create mode 100755 tools/se_grid/make_se_grid.sh create mode 100644 tools/topo_tool/bin_to_cube/Makefile create mode 100644 tools/topo_tool/bin_to_cube/README create mode 100644 tools/topo_tool/bin_to_cube/bin_to_cube.F90 create mode 100644 tools/topo_tool/bin_to_cube/shr_kind_mod.F90 create mode 100644 tools/topo_tool/cube_to_target/Makefile create mode 100644 tools/topo_tool/cube_to_target/README create mode 100644 tools/topo_tool/cube_to_target/cube_to_target.F90 create mode 100644 tools/topo_tool/cube_to_target/reconstruct.F90 create mode 100644 tools/topo_tool/cube_to_target/remap.F90 create mode 100644 tools/topo_tool/cube_to_target/shr_kind_mod.F90 create mode 100644 tools/topo_tool/gen_netCDF_from_USGS/Makefile create mode 100644 tools/topo_tool/gen_netCDF_from_USGS/README create mode 100644 tools/topo_tool/gen_netCDF_from_USGS/create_netCDF_from_USGS.F90 create mode 100644 tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 diff --git a/.config_files.xml b/.config_files.xml new file mode 100644 index 0000000000..b7ce80c599 --- /dev/null +++ b/.config_files.xml @@ -0,0 +1,30 @@ + + + + + + + + + char + unset + + $SRCROOT + $CIMEROOT/src/components/data_comps/dlnd + $CIMEROOT/src/components/stub_comps/slnd + $CIMEROOT/src/components/xcpl_comps/xlnd + + case_comps + env_case.xml + Root directory of the case atmosphere model component + $CIMEROOT/config/xml_schemas/config_compsets.xsd + + + diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000000..18ee78968c --- /dev/null +++ b/.gitignore @@ -0,0 +1,20 @@ +# Ignore externals +chem_proc +cime +components +manage_externals.log +src/physics/carma/base +src/physics/clubb +src/physics/cosp2/src +src/physics/silhs + + +# Ignore compiled python +buildnmlc +buildcppc + +# Ignore editor temporaries and backups +*~ +.#* +\#*# +*.swp diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md new file mode 100644 index 0000000000..b6078c2117 --- /dev/null +++ b/CODE_OF_CONDUCT.md @@ -0,0 +1,49 @@ +# Contributor Covenant Code of Conduct + +## Our Pledge + +In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, politcal affiliation, veteran status, pregnancy, genetic information, personal appearance, choice of text editor or operating system, race, religion, or sexual identity and orientation, or any other characteristic protected under applicable US federal or state law. + +## Our Standards + +Examples of behavior that contributes to creating a positive environment include: + +* Using welcoming and inclusive language +* Being respectful of differing viewpoints and experiences +* Gracefully accepting constructive criticism +* Focusing on what is best for the community +* Showing empathy towards other community members + +Examples of unacceptable behavior by participants include: + +* The use of sexualized language or imagery and unwelcome sexual attention or advances +* Trolling, insulting/derogatory comments, and personal or political attacks +* Public or private harassment +* Publishing others' private information, such as a physical or electronic address, without explicit permission +* Other conduct which could reasonably be considered inappropriate in a professional setting +* Refusing to use the pronouns that someone requests +* Intimidating, threatening, or hostile conduct; physical or verbal abuse; vandalism; arson; and sabotage +* Alarming or threatening comments that might refer to, suggest, or promote a violent, intimidating, or threatening action + +## Our Responsibilities + +Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. + +Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. + +## Scope + +This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. + +## Enforcement + +Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at cam-core@ucar.edu. Alternatively, this behavior can be reported to individuals on the CAM team, who will then have the responsibility to talk about the behavior to the core team. Another alternative for NCAR employees (when all individuals involved are NCAR employees) is to use the reporting methods of NCAR for this behavior (these options include anonymous reporting methods). The project team will review and investigate all complaints, and will respond in a way that it deems appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Retaliation against a person who initiates a complaint or an inquiry about such behaviors is equally prohibited. + +Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. + +## Attribution + +This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version] + +[homepage]: http://contributor-covenant.org +[version]: http://contributor-covenant.org/version/1/4/ diff --git a/Externals.cfg b/Externals.cfg new file mode 100644 index 0000000000..3de7a971c7 --- /dev/null +++ b/Externals.cfg @@ -0,0 +1,60 @@ +[externals_description] +schema_version = 1.0.0 + +[cice] +tag = cice5_20180418 +protocol = git +repo_url = https://github.com/ESCOMP/CESM_CICE5 +required = True +local_path = components/cice + +[cime] +tag = cime5.6.6 +protocol = git +repo_url = https://github.com/ESMCI/cime +required = True +local_path = cime + +[cism] +tag = cism2_1_53 +protocol = git +repo_url = https://github.com/ESCOMP/cism-wrapper +externals = Externals_CISM.cfg +required = True +local_path = components/cism + +[clm] +tag = clm5.0.dev008 +protocol = git +repo_url = https://github.com/ESCOMP/ctsm +externals = Externals_CLM.cfg +required = True +local_path = components/clm + +[mosart] +tag = mosart1_0_30 +protocol = git +repo_url = https://github.com/ESCOMP/mosart +required = True +local_path = components/mosart + +[rtm] +tag = rtm1_0_65 +protocol = git +repo_url = https://github.com/ESCOMP/rtm +required = True +local_path = components/rtm + +[ww3] +tag = ww3_180115 +protocol = svn +repo_url = https://svn-ccsm-models.cgd.ucar.edu/ww3/trunk_tags +required = True +local_path = components/ww3 + +[cam] +local_path = . +protocol = externals_only +externals = Externals_CAM.cfg +required = True + diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg new file mode 100644 index 0000000000..966585259a --- /dev/null +++ b/Externals_CAM.cfg @@ -0,0 +1,31 @@ +[chem_proc] +local_path = chem_proc +protocol = svn +repo_url = https://svn-ccsm-models.cgd.ucar.edu/tools/proc_atm/chem_proc/trunk_tags/ +tag = chem_proc5_0_03 +required = True + +[carma] +local_path = src/physics/carma/base +protocol = svn +repo_url = https://svn-ccsm-models.cgd.ucar.edu/carma/trunk_tags/ +tag = carma3_49 +required = True + +[clubb] +local_path = src/physics/clubb +protocol = svn +repo_url = https://svn-ccsm-models.cgd.ucar.edu/clubb_core/branch_tags/ +tag = vendor_clubb_r8099_tags/vendor_clubb_r8099_n02 +required = True + +[cosp2] +local_path = src/physics/cosp2/src +protocol = svn +repo_url = https://github.com/CFMIP/COSPv2.0/tags/ +tag = v2.0.3/src +required = True + +[externals_description] +schema_version = 1.0.0 + diff --git a/README.md b/README.md new file mode 100644 index 0000000000..99d0dceb22 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# CAM: The Community Atmosphere Model + +## NOTE: This is unsupported development code and is subject to the [CESM developer's agreement](http://www.cgd.ucar.edu/cseg/development-code.html). + +CAM Documentation - https://ncar.github.io/CAM/doc/build/html/index.html + +CAM6 namelist settings - http://www.cesm.ucar.edu/models/cesm2/settings/current/cam_nml.html + +Please see the [wiki](https://github.com/ESCOMP/CAM/wiki) for information. diff --git a/README_EXTERNALS b/README_EXTERNALS new file mode 100644 index 0000000000..2b6c2bc4e3 --- /dev/null +++ b/README_EXTERNALS @@ -0,0 +1,49 @@ +Example taken from bulletin board forum for "Subversion Issues" in the +thread for "Introduction to Subversion"...(070208) + + +Working with externals: + +checkout the HEAD of cam's trunk into working copy directory +> svn co $SVN/cam1/trunk cam_trunk_head_wc + +view the property set for cam's external definitions +> svn propget svn:externals cam_trunk_head_wc + +view revision, URL and other useful information specific to external files +> cd cam_trunk_head_wc/models/lnd/clm2/src +> svn info main + +create new clm branch for mods required of cam +> svn copy $SVN/clm2/trunk_tags/ $SVN/clm2/branches/ -m "appropriate message" + +have external directories in working copy refer to new clm branch to make changes +> svn switch $SVN/clm2/branches//src/main main + +--make changes to clm files-- + +when satisfied with changes and testing, commit to HEAD of clm branch +> svn commit main -m "appropriate message" + +tag new version of clm branch - review naming conventions! +> svn copy $SVN/clm2/branches/ $SVN/clm2/branch_tags/_tags/ -m "appropriate message" + +have external directories in working copy refer to new clm tag +> svn switch $SVN/clm2/branch_tags/_tags//src/main main + +modify cam's property for external definitions in working copy +> emacs cam_trunk_head_wc/SVN_EXTERNAL_DIRECTORIES + +--point definition to URL of new-tag-name-- + +set the property - don't forget the 'dot' at the end! +> svn propset svn:externals -F SVN_EXTERNAL_DIRECTORIES cam_trunk_head_wc + +--continue with other cam mods-- + +commit changes from working copy directory to HEAD of cam trunk - NOTE: a commit from here will *NOT* recurse to external directories +> cd cam_trunk_head_wc +> svn commit -m "appropriate message" + +tag new version of cam trunk +> svn copy $SVN/cam1/trunk $SVN/cam1/trunk_tags/ -m "appropriate message" diff --git a/bld/Makefile.in b/bld/Makefile.in new file mode 100644 index 0000000000..9f16f305b8 --- /dev/null +++ b/bld/Makefile.in @@ -0,0 +1,1145 @@ +#----------------------------------------------------------------------- +# Makefile template for building CAM on various platforms. +# +# This makefile assumes the existence the file: +# +# Filepath The directories, listed one per line, that contain the source +# code required to build CAM. This list is used to set the +# VPATH variable which is used by GNU make to search for +# dependencies (after it looks in the directory from which +# it was invoked). This list of directories, prepended with ./, +# is also used to construct the list of search directories +# used by the preprocessor (as specified by -I command-line options). +# +# The following macros are set by CAM's configure script. They should only be hand edited +# by experts. +# +# UNAMES Result of the "uname -s" command on the target platform. +# ROOTDIR Root directory for the CAM source distribution. +# EXENAME Name of the executable. +# MODEL_EXEDIR Directory to build the executable in. +# INC_NETCDF Directory containing the NetCDF include files. +# LIB_NETCDF Directory containing the NetCDF library. +# NC_LDFLAGS NetCDF linking flags. +# MOD_NETCDF Directory containing the NetCDF module files. +# INC_MPI Directory containing the MPI include files. +# LIB_MPI Directory containing the MPI library. +# MPI_LIB_NAME Name of MPI library. +# LAPACK_LIBDIR Directory containing the LAPACK library. +# ESMF_LIBDIR Directory containing the ESMF library (for use with external library only). +# DEBUG Set to TRUE to turn on compiler debugging options. Default: FALSE +# SPMD Whether to build in SPMD mode or not. [values TRUE FALSE] +# SMP Set to TRUE to enable building in SMP mode (uses OpenMP). +# FC Fortran compiler +# FC_TYPE Type of Fortran compiler invoked by generic wrapper script such as mpif90. +# CC C compiler +# USER_LINKER Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS Additional CPP defines. +# USER_CFLAGS Additional C compiler flags that the user wishes to set. +# USER_FFLAGS Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS Additional load flags that the user wishes to set. +# F_OPTIMIZATION_OVERRIDE +# Use this to replace default Fortran compiler optimization. +# COSP_LIBDIR Directory where COSP library will be built. +# MCT_LIBDIR Directory where MCT library will be built. +# PIO_BUILD_DIR Directory where PIO will be built (pio2 only) +# PIO_INSTALL_DIR Directory containing PIO libraries and include files (pio2 only) +# +# Note: An internal implementation of the ESMF time-manager interface is provided +# with the CESM distribution in $ROOTDIR/cime/src/share/esmf_wrf_timemgr. +# +#------------------------------------------------------------------------ + +# Set up special characters +null := +space := $(null) $(null) +comma := $(null),$(null) + +# Initialize macros that allow a user override. + +# Set user override of default Fortran compiler optimizations +ifneq ($(strip $(F_OPTIMIZATION_OVERRIDE)),) + FORTRAN_OPTIMIZATION := $(F_OPTIMIZATION_OVERRIDE) +endif + +# Set user specified linker +ifneq ($(strip $(USER_LINKER)),) + LINKER := $(USER_LINKER) +endif + +# Check for build of PIO in separate library. +ifneq ($(strip $(PIO_INSTALL_DIR)),) + PIO_INC := $(PIO_INSTALL_DIR)/include +endif + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(INC_MPI) $(INC_PNETCDF) $(PIO_INC) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +VPATH := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +VPATH := $(subst $(space),:,$(VPATH)) + +# Files to be excluded from build: +# GPTL files +EXCLUDE_SOURCES := f_wrappers_pmpi.c,pmpi.c,printmpistatussize.F90 +EXCLUDE_SOURCES := $(EXCLUDE_SOURCES),process_namelist.F90,timingModule.F90 + +#------------------------------------------------------------------------ +# Primary target: build the model +#------------------------------------------------------------------------ +#touch filepath to ensure Depends and Srcfiles are regenerated +all: $(MODEL_EXEDIR)/$(EXENAME) touch_filepath + +touch_filepath: + touch $(CURDIR)/Filepath + +# Get list of files and build dependency file for all .o files +# using perl scripts mkSrcfiles and mkDepends + +SOURCES := $(shell cat Srcfiles) + +# if a source is of form .F90.in strip the .in before creating the list of objects +SOURCES := $(SOURCES:%.F90.in=%.F90) + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +# Generate Make dependencies. +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + if [ -d "${ROOTDIR}/components/cam" ]; then \ + $(ROOTDIR)/components/cam/bld/mkDepends Filepath Srcfiles > $@; \ + else \ + $(ROOTDIR)/bld/mkDepends Filepath Srcfiles > $@; \ + fi + +# Generate list of source files. +$(CURDIR)/Srcfiles: $(CURDIR)/Filepath + if [ -d "${ROOTDIR}/components/cam" ]; then \ + $(ROOTDIR)/components/cam/bld/mkSrcfiles -e $(EXCLUDE_SOURCES) > $@; \ + else \ + $(ROOTDIR)/bld/mkSrcfiles -e $(EXCLUDE_SOURCES) > $@; \ + fi + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +CPPDEF := -DNO_C_SIZEOF $(USER_CPPDEFS) +ifeq ($(SPMD),TRUE) + # HAVE_MPI is used in the timing lib code + CPPDEF += -DSPMD -DHAVE_MPI +endif + +ifneq ($(strip $(LIB_PNETCDF)),) + CPPDEF += -D_PNETCDF -DUSEMPIIO + #dont use LDFLAGS here, it will be overwritten below + USER_LDFLAGS += -L$(LIB_PNETCDF) -lpnetcdf +endif + +CONTIGUOUS_FLAG := -DUSE_CONTIGUOUS=contiguous, +NO_CONTIGUOUS_FLAG := -DUSE_CONTIGUOUS= + +$(MODEL_EXEDIR)/$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) $(NC_LDFLAGS) + +ifneq ($(strip $(COSP_LIBDIR)),) +# Rules to build COSP in its own library. Add cam_abortutils dependency so +# cosp code can make use of subroutine endrun. +$(COSP_LIBDIR)/libcosp.a: cam_abortutils.o + $(MAKE) -C $(COSP_LIBDIR) + +cospsimulator_intr.o: $(COSP_LIBDIR)/libcosp.a +endif + +# Rules to build MCT library. +# SRCDIR is passed via the commandline because of a bug in the MCT configure. +$(MCT_LIBDIR)/mct/libmct.a: + $(MAKE) -C $(MCT_LIBDIR) SRCDIR=$(ROOTDIR)/cime/src/externals/mct +shr_kind_mod.o: $(MCT_LIBDIR)/mct/libmct.a +perf_utils.o: $(MCT_LIBDIR)/mct/libmct.a +RtmSpmd.o: $(MCT_LIBDIR)/mct/libmct.a + +# Rules to build PIO library. If not building the library then need +# to add the dependency on pio for the cam parallel build. +ifneq ($(strip $(PIO_INC)),) + # Depends on MCT only for the mpi-serial library + $(PIO_INSTALL_DIR)/lib/libpiof.a: $(MCT_LIBDIR)/mct/libmct.a + $(MAKE) -C $(PIO_BUILD_DIR) + $(MAKE) -C $(PIO_BUILD_DIR) install + shr_pio_mod.o: $(PIO_INSTALL_DIR)/lib/libpiof.a + shr_pcdf_mod.o: $(PIO_INSTALL_DIR)/lib/libpiof.a + cam_map_utils.o: $(PIO_INSTALL_DIR)/lib/libpiof.a + +else + # If not building the library then need to + # add a dependency on pio for the cam parallel build. + pio_kinds.o: $(MCT_LIBDIR)/mct/libmct.a +endif + +# Compilation rules: +.SUFFIXES: +.SUFFIXES: .F .F90 .f90 .c .s .o + +.F.o: + $(FC) -c $(FIXEDFLAGS) $(FFLAGS) $< + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) $< + +.f90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + +.s.o: + $(AS) -m $< + +%.F90: %.F90.in + $(ROOTDIR)/cime/src/externals/genf90/genf90.pl $< > $@ + +# Rules used for the tests run by "configure -test" +test_fc: test_fc.o + $(LINKER) -o $@ $(FFLAGS) test_fc.o +test_nc: test_nc.o + $(LINKER) -o $@ $(FFLAGS) test_nc.o $(NC_LDFLAGS) + + +MPI_LINK_TEST := +ifneq ($(strip $(LIB_MPI)),) + MPI_LINK_TEST += -L$(LIB_MPI) -l$(MPI_LIB_NAME) +endif + +test_mpi: test_mpi.o + $(LINKER) -o $@ $(FFLAGS) test_mpi.o $(MPI_LINK_TEST) + +ESMF_LINK_TEST = +ifneq ($(strip $(ESMF_LIBDIR)),) + ESMF_LINK_TEST += $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) +endif +test_esmf: test_esmf.o + $(LINKER) -o $@ $(FFLAGS) test_esmf.o $(ESMF_LINK_TEST) + + +debug: $(OBJS) + echo "FC: $(FC)" + echo "FFLAGS: $(FFLAGS)" + echo "LINKER: $(LINKER)" + echo "LDFLAGS: $(LDFLAGS)" + echo "OBJS: $(OBJS)" + + +clean: + $(RM) $(MODEL_EXEDIR)/$(EXENAME) $(OBJS) + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) + +CPPDEF += -DAIX -DCPRIBM $(NO_CONTIGUOUS_FLAG) +ifeq ($(SMP),TRUE) + # THREADED_OMP is used by the timing library + CPPDEF += -DTHREADED_OMP +endif + +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(subst $(comma),\\$(comma),$(CPPDEF)) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(FPPFLAGS)) + +CFLAGS := -q64 -g $(cpp_path) $(CPPDEF) + +mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu +ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial +endif +ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) +endif +ifneq ($(strip $(COSP_LIBDIR)),) + mod_path += -I$(COSP_LIBDIR) +endif + +FC_FLAGS := -q64 -qarch=auto -qspillsize=2500 -g -qfullpath +FC_FLAGS_NOOPT := $(FC_FLAGS) +FREEFLAGS := -qsuffix=f=f90:cpp=F90 +FIXEDFLAGS := -qfixed=132 +LDFLAGS := -q64 -lmassv -bdatapsize:64k -bstackpsize:64k -btextpsize:32k + +ifeq ($(SMP),TRUE) + FC_FLAGS_NOOPT += -qsmp=omp:noopt + + # -qsmp implicitly turns on -O2. Explicitly disable this for debugging. + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -qsmp=omp:noopt + CFLAGS += -qsmp=omp:noopt + LDFLAGS += -qsmp=omp:noopt + else + FC_FLAGS += -qsmp=omp + CFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp + endif +endif + +ifeq ($(SPMD),TRUE) + LDFLAGS += -lmpi_r +else + FPPFLAGS += -WF,-DHIDE_MPI,-D_MPISERIAL,-DNO_MPIMOD,-DNO_MPI2 +endif + +ifeq ($(DEBUG),TRUE) + # Bounds checking is unreliable on the IBM. + # Sometimes you can get it to go if you turn threading off. + # Only turn float-trapping on for debug mode as it's a 20% performance hit. + FC_FLAGS += -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en + + # As of Apr/15/2003 cam2_0_2_dev18 xlfrte8.1.0.3 using -lmass causes the code to core-dump + # when using DEBUG compiler options. +else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + # Inline when not debugging + FORTRAN_OPTIMIZATION := -O2 -qstrict -Q + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + CFLAGS += -O2 + LDFLAGS += -lmass +endif + +ifneq ($(strip $(LAPACK_LIBDIR)),) + LDFLAGS += -L$(LAPACK_LIBDIR) -llapack -lblas +endif + +FFLAGS := $(cpp_path) $(mod_path) $(FPPFLAGS) $(FC_FLAGS) +FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(FPPFLAGS) $(FC_FLAGS_NOOPT) +FC_AUTO_R8 := -qrealsize=8 + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + +CPPDEF += -DLINUX + +ifeq ($(SMP),TRUE) + # THREADED_PTHREADS and THREADED_OMP are used by the timing library + ifeq ($(FC_TYPE), nag) + CPPDEF += -DTHREADED_PTHREADS + else + CPPDEF += -DTHREADED_OMP + endif +endif + +CFLAGS = $(cpp_path) $(CPPDEF) + +# Set search path for module files for external libraries. +mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu +ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial +endif +ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) +endif +ifneq ($(strip $(COSP_LIBDIR)),) + mod_path += -I$(COSP_LIBDIR) +endif + +# PGI + +ifeq ($(FC_TYPE),pgi) + + CPPDEF += -DNO_R16 -DCPRPGI $(NO_CONTIGUOUS_FLAG) + CFLAGS += -gopt -O2 + FC_FLAGS := -i4 -Mdalign -Mextend -byteswapio + FC_FLAGS_NOOPT:= $(FC_FLAGS) + FREEFLAGS := -Mfree + FIXEDFLAGS := -Mfixed + LDFLAGS := -Bdynamic + + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -g -Ktrap=fp -Mbounds -Kieee -traceback + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -gopt -O2 -Kieee + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + endif + + ifeq ($(SMP),TRUE) + FC_FLAGS += -mp + FC_FLAGS_NOOPT += -mp + CFLAGS += -mp + LDFLAGS += -mp + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + FC_AUTO_R8 := -r8 + +# These RRTMG files cause a compiler error when using optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +# Intel + +ifeq ($(FC_TYPE),intel) + + CPPDEF += -DCPRINTEL $(NO_CONTIGUOUS_FLAG) + CFLAGS += -std=gnu99 + FC_FLAGS := -ftz -convert big_endian -fp-model source -no-fma \ + -qno-opt-dynamic-align -assume realloc_lhs -xHost + FC_FLAGS_O3OPT:= $(FC_FLAGS) + FC_FLAGS_NOOPT:= -ftz -convert big_endian -O0 + FREEFLAGS := + FIXEDFLAGS := -fixed -132 + LDFLAGS := + + ifeq ($(DEBUG),TRUE) + FC_DEBUG := -check all -check noarg_temp_created -fpe0 -g -traceback + FC_FLAGS += $(FC_DEBUG) + FC_FLAGS_O3OPT += $(FC_DEBUG) + CFLAGS += -g + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O2 + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + FC_FLAGS_O3OPT += -O3 -no-prec-div + endif + + ifeq ($(SMP),TRUE) + FC_FLAGS += -qopenmp + FC_FLAGS_NOOPT += -qopenmp + FC_FLAGS_O3OPT += -qopenmp + CFLAGS += -qopenmp + LDFLAGS += -qopenmp + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT:= $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + FFLAGS_O3OPT:= $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_O3OPT) + FC_AUTO_R8 := -autodouble + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +shr_scam_mod.o: shr_scam_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +# 3 April 2014: The optimization in following files has been validated by testing +# on yellowstone in a CESM context. +prim_advection_mod.o: prim_advection_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_O3OPT) $< +edge_mod.o: edge_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_O3OPT) $< +derivative_mod.o: derivative_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_O3OPT) $< +bndry_mod.o: bndry_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_O3OPT) $< +prim_advance_mod.o: prim_advance_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_O3OPT) $< + +endif + +# Pathscale + +ifeq ($(FC_TYPE),pathscale) + + CPPDEF += -DNO_R16 -DCPRPATHSCALE $(NO_CONTIGUOUS_FLAG) + FC_FLAGS := -extend_source -ftpp -fno-second-underscore + FC_FLAGS_NOOPT:= $(FC_FLAGS) -O0 + FREEFLAGS := + FIXEDFLAGS := + LDFLAGS := + + ifeq ($(SMP),TRUE) + FC_FLAGS += -mp + FC_FLAGS_NOOPT += -mp + CFLAGS += -mp + LDFLAGS += -mp + endif + + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -g -trapuv -Wuninitialized + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + FC_AUTO_R8 := -r8 + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +# gfortran + +ifeq ($(FC_TYPE),gnu) + + CPPDEF += -DNO_R16 -DCPRGNU $(NO_CONTIGUOUS_FLAG) + CFLAGS += -std=gnu99 + FC_FLAGS := -fno-range-check -fcray-pointer + FC_FLAGS_NOOPT:= $(FC_FLAGS) -O0 + FREEFLAGS := -ffree-form -ffree-line-length-none + FIXEDFLAGS := -ffixed-form -ffixed-line-length-132 + LDFLAGS := + + ifeq ($(SMP),TRUE) + FC_FLAGS += -fopenmp + FC_FLAGS_NOOPT += -fopenmp + CFLAGS += -fopenmp + LDFLAGS += -fopenmp + endif + + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -g -ggdb -ffpe-trap='invalid,zero,overflow' -finit-real=snan + CFLAGS += -g -ggdb + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + FC_AUTO_R8 := -fdefault-real-8 -fdefault-double-8 + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +# CCE + +ifeq ($(FC_TYPE),cray) + + CPPDEF += -DNO_R16 -DCPRCRAY $(CONTIGUOUS_FLAG) + CFLAGS += -O1,vector0 + FC_FLAGS := -e m -N 255 + FC_FLAGS_NOOPT:= $(FC_FLAGS) + FREEFLAGS := -f free + FIXEDFLAGS := -f fixed + LDFLAGS := + + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -g + CFLAGS += -g + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O2,vector1,fp1 + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + endif + + ifeq ($(SMP),TRUE) + FC_FLAGS += -O omp + FC_FLAGS_NOOPT += -O omp + CFLAGS += -O omp + LDFLAGS += -O omp + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + +# These RRTMG files cause a compiler error when using optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +# NAG + +ifeq ($(FC_TYPE), nag) + + # NAG doesn't do Cray pointers. + CPPDEF += -DCPRNAG -DNO_CRAY_POINTERS $(NO_CONTIGUOUS_FLAG) + CFLAGS += -std=gnu99 + + # Bit of a pain: MPI functions are overloaded, so must specify + # not to check them. -mismatch_all is alternative, but less + # targeted option. + nag_mismatch_flag := -wmismatch=mpi_send,mpi_recv,mpi_bcast,mpi_allreduce,mpi_reduce,mpi_isend,mpi_irecv,mpi_irsend,mpi_rsend,mpi_gatherv,mpi_scatterv,mpi_allgather,mpi_alltoall,mpi_alltoallv,mpi_alltoallw,mpibcast,mpiscatterv + FC_FLAGS := $(nag_mismatch_flag) -Wp,-macro=no_com + FC_FLAGS_NOOPT:= $(FC_FLAGS) + + FREEFLAGS := -free + FIXEDFLAGS := -fixed + LDFLAGS := + + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -g -time -f2003 -ieee=stop -nan + FC_FLAGS_NOOPT += -g -time -f2003 -ieee=stop -nan + CFLAGS += -g + + # Turns on all checks except -C=undefined (which is not binary-compatible + # with the same libraries, and is not expected to work with OpenMP). + # Actually, in this version, many runtime checks are broken with OpenMP, + # so make an explicit list. + # "-gline" is nice, but not supported with OpenMP. + ifneq ($(SMP),TRUE) + FC_FLAGS += -gline -C=all + FC_FLAGS_NOOPT += -gline + else + FC_FLAGS += -C=array -C=bits -C=calls -C=do -C=intovf -C=present -C=pointer + endif + + else + FC_FLAGS += -ieee=full + FC_FLAGS_NOOPT += -ieee=full + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O2 + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) + endif + + ifeq ($(SMP),TRUE) + FC_FLAGS += -openmp + FC_FLAGS_NOOPT += -openmp + # nagfor doesn't deal well with OpenMP functions called from C code. + # This will not work unless you add a wrapper of Fortran OpenMP code to + # work with gptl. + LDFLAGS += -openmp + endif + + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS) + FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(CPPDEF) $(FC_FLAGS_NOOPT) + FC_AUTO_R8 := -r8 + +# A bit hack-ish. Turn off procedure checking by just using the NOOPT +# flags. This also turns off debug flags, meaning that -C=all is not +# used. +# Must turn off procedure checking to use F77-style rank-agnostic +# arguments, or else duplicate the nightmarish MPI F90 bindings. +wrap_mpi.o: wrap_mpi.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +# This is (almost earlier than) F77 code that treats array inputs as +# rank-less pointers, so can't check this. +fft99.o: fft99.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +# These RRTMG files take a very long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +# Flags common to all compilers +ifneq ($(strip $(LAPACK_LIBDIR)),) + LDFLAGS += -L$(LAPACK_LIBDIR) -llapack -lblas +endif + +ifeq ($(SPMD),TRUE) + FFLAGS += + ifneq ($(strip $(LIB_MPI)),) + # Some things seem broken if this comes after -lmpeu. + # Putting this at the end of USER_LDFLAGS guarantees that that + # won't happen. + USER_LDFLAGS += -L$(LIB_MPI) -l$(MPI_LIB_NAME) + endif +else + FFLAGS += -DHIDE_MPI -D_MPISERIAL -DNO_MPIMOD -DNO_MPI2 -DNO_SIZEOF +endif + +endif + + +#------------------------------------------------------------------------ +# Darwin +# PowerPC = XLF compiler (serial only, no MPI multi-tasking or OpenMP threading) +# Intel = Intel Fortran Compiler +# +# For MPI, assumes that MPICH2 has been installed. +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + + #---------------------------------------------------------------------- + # Common stuff + #---------------------------------------------------------------------- + CPPDEF += -DSYSDARWIN + + ifeq ($(NESTED_OMP),TRUE) + CPPDEF += -DNESTED_PAR -DSYSDARWIN + endif + + #-------------------------------------------------------------------- + # ifort + #-------------------------------------------------------------------- + ifeq ($(findstring ifort,$(FC)),ifort) +# ADDRESS := Q32 + ADDRESS := Q64 + ifeq ($(ADDRESS),Q32) + QCMP := + endif + + ifeq ($(ADDRESS),Q64) + QCMP := -m64 + QLDR := -m64 + endif + + CPPDEF += -DLINUX -DDarwin + CFLAGS := $(cpp_path) $(CPPDEF) -O2 $(QCMP) -gdwarf-2 + mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu + ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial + endif + ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) + endif + # Needed for COSP, since it builds in its own directory. + ifneq ($(strip $(COSP_LIBDIR)),) + mod_path += -I$(COSP_LIBDIR) + endif + + # COSP needs to autopromote to get its precision to match CAM + FC_AUTO_R8 := -autodouble + + # NOTE: use-asm is require to work with Xcode 3.2.2 and ifort 11.1.088. Perhaps this + # will not be needed with future versions. + FFLAGS := $(cpp_path) $(mod_path) $(CPPDEF) -ftz -g -traceback -fp-model precise -use-asm -convert big_endian + LDFLAGS := -Xlinker -map -Xlinker ./cam_map.txt + + FREEFLAGS := -FR + FIXEDFLAGS := -fixed -132 + + ifeq ($(SMP),TRUE) + FFLAGS += -qopenmp + LDFLAGS += -qopenmp + endif + + ifeq ($(SPMD),TRUE) + # Works with MPICH2-1.1.1p1 +# LDFLAGS += -L$(LIB_MPI) -l$(MPI_LIB_NAME)f90 -lp$(MPI_LIB_NAME) -l$(MPI_LIB_NAME) + + # Updated for MPICH2-1.4.1p1, which has an extra library. + LDFLAGS += -L$(LIB_MPI) -l$(MPI_LIB_NAME)f90 -lp$(MPI_LIB_NAME) -l$(MPI_LIB_NAME) -lmpl + else + FFLAGS += -DHIDE_MPI -D_MPISERIAL -DNO_MPIMOD -DNO_MPI2 + endif + + ifeq ($(DEBUG),TRUE) + + FFLAGS_NOCHK = $(FFLAGS) -O0 + +# FFLAGS += -fp-stack-check -check bounds -check pointers -check uninit -O0 -fpe0 -debug -ftrapuv + FFLAGS += -fp-stack-check -check bounds -check uninit -O0 -fpe0 -ftrapuv + + # To work with idb on Lion ... + LDFLAGS += -no_pie + + FFLAGS_NOOPT := $(FFLAGS) + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O2 + endif + + FFLAGS_NOOPT := $(FFLAGS) -O0 + FFLAGS += $(FORTRAN_OPTIMIZATION) + + FFLAGS_NOCHK = $(FFLAGS) + endif + + # For OSX 10.7 to stop address-space layout randomization (ASLR) + LDFLAGS += -no_pie + + endif + + #-------------------------------------------------------------------- + # xlf + #-------------------------------------------------------------------- + ifeq ($(findstring xlf,$(FC)),xlf) + CPPDEF += -DAIX -DDarwin + + CFLAGS := $(cpp_path) $(CPPDEF) -O2 + + mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu + ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial + endif + ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) + endif + # Needed for COSP, since it builds in its own directory. + ifneq ($(strip $(COSP_LIBDIR)),) + mod_path += -I$(COSP_LIBDIR) + endif + + # COSP needs to autopromote to get its precision to match CAM + FC_AUTO_R8 := -qrealsize=8 + + FFLAGS := $(cpp_path) $(mod_path) $(FPPFLAGS) -qspillsize=2500 + FREEFLAGS := -qsuffix=f=f90:cpp=F90 + FIXEDFLAGS := -qfixed=132 + + ifeq ($(SPMD),TRUE) + LDFLAGS += -L$(LIB_MPI) -l$(MPI_LIB_NAME)f90 -lp$(MPI_LIB_NAME) -l$(MPI_LIB_NAME) + else + FFLAGS += -WF -DHIDE_MPI -D_MPISERIAL -DNO_MPIMOD -DNO_MPI2 + endif + + ifeq ($(DEBUG),TRUE) + # Only turn float-trapping on for debug mode as it's a performance hit. + FFLAGS += -qinitauto=FF911299 -qflttrap=ov:zero:inv:en -C -qfullpath -qhalt=e + + ifeq ($(NESTED_OMP),TRUE) + FFLAGS += -qsmp=omp:noopt:nested_par + LDFLAGS += -qsmp=omp:noopt:nested_par + else + FFLAGS += -qsmp=omp:noopt + LDFLAGS += -qsmp=omp:noopt + endif + + FFLAGS_NOOPT := $(FFLAGS) + else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + FORTRAN_OPTIMIZATION := -O3 -qstrict + endif + + FFLAGS_NOOPT := $(FFLAGS) -O0 + FFLAGS += $(FORTRAN_OPTIMIZATION) + + ifeq ($(NESTED_OMP),TRUE) + FFLAGS += -qsmp=omp:nested_par + LDFLAGS += -qsmp=omp:nested_par + else + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp + endif + endif + endif + + #---------------------------------------------------------------------- + # Common stuff + #---------------------------------------------------------------------- +# No longer needed as of OSX Lion +# LDFLAGS += -lSystemStubs -lSystemStubs_profile + + ifeq ($(SMP),TRUE) + # THREADED_PTHREADS is used by the timing library + CFLAGS += -DTHREADED_PTHREADS + endif + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +shr_scam_mod.o: shr_scam_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS) -O1 $< + +# Work around problem for debug errors in ifort with -chem none +mo_gas_phase_chemdr.o: mo_gas_phase_chemdr.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOCHK) $< +mo_waccm_hrates.o: mo_waccm_hrates.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOCHK) $< + +# Work around a compiler bug in ifort 12.1 update 7 (optimization problem) +setupgkern.o: setupgkern.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +#------------------------------------------------------------------------ +# BGQ +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),BGQ) + +CPPDEF += -DLINUX -DBGQ -DCPRIBM -DnoI8 -DPIO_GPFS_HINTS $(CONTIGUOUS_FLAG) +ifeq ($(SMP),TRUE) + # THREADED_OMP is used by the timing library + CPPDEF += -DTHREADED_OMP +endif + +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(subst $(comma),\\$(comma),$(CPPDEF)) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(FPPFLAGS)) + +CFLAGS := $(cpp_path) $(CPPDEF) -g -qfullpath -qmaxmem=-1 -O2 + +mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu +ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial +endif +ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) +endif + +FC_FLAGS := -g -qfullpath -qmaxmem=-1 -qspillsize=2500 -qextname=flush +FC_FLAGS_NOOPT := $(FC_FLAGS) +FREEFLAGS := -qsuffix=f=f90:cpp=F90 +FIXEDFLAGS := -qfixed=132 +LDFLAGS := -Wl,--relax -L/bgsys/drivers/ppcfloor/comm/sys/lib + +ifeq ($(SMP),TRUE) + FC_FLAGS_NOOPT += -qsmp=omp:noopt + + # -qsmp implicitly turns on -O2. Explicitly disable this for debugging. + ifeq ($(DEBUG),TRUE) + FC_FLAGS += -qsmp=omp:noopt + CFLAGS += -qsmp=omp:noopt + LDFLAGS += -qsmp=omp:noopt + else + FC_FLAGS += -qsmp=omp + CFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp + endif +endif + +ifeq ($(DEBUG),TRUE) + FC_FLAGS += -O0 -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en + FC_FLAGS_NOOPT += -O0 -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en +else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + # Inline when not debugging + FORTRAN_OPTIMIZATION := -O3 -qstrict -Q + endif + FC_FLAGS += $(FORTRAN_OPTIMIZATION) +endif + +ifneq ($(strip $(LAPACK_LIBDIR)),) + LDFLAGS += -L$(LAPACK_LIBDIR) -llapack -lblas +endif + +FFLAGS := $(cpp_path) $(mod_path) $(FPPFLAGS) $(FC_FLAGS) +FFLAGS_NOOPT := $(cpp_path) $(mod_path) $(FPPFLAGS) $(FC_FLAGS_NOOPT) +FC_AUTO_R8 := -qrealsize=8 + +# These RRTMG files take an extraordinarily long time to compile with optimization. +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +# 1 May 2014. These rules (from the CESM scripts) are apparently needed to +# get around compiler bugs +shr_reprosum_mod.o: shr_reprosum_mod.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +mo_sethet.o: mo_sethet.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +mo_drydep.o: mo_drydep.F90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +#------------------------------------------------------------------------ +# BGL +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),BGL) + +CPPDEF += -DAIX -DBGL $(NO_CONTIGUOUS_FLAG) +BGLPATH=/bgl/BlueLight/ppcfloor/bglsys +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(subst $(comma),\\$(comma),$(CPPDEF)) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(FPPFLAGS)) + +CFLAGS := $(cpp_path) $(CPPDEF) -O2 \ + -I$(BGLPATH)/include + +mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu +ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial +endif +ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) +endif + +FFLAGS := -I$(BGLPATH)/include \ + $(cpp_path) $(mod_path) $(FPPFLAGS) -qarch=440 \ + -qspillsize=2500 -g -qfullpath +FREEFLAGS := -qsuffix=f=f90:cpp=F90 +FIXEDFLAGS := -qfixed=132 +LDFLAGS := -L$(BGLPATH)/lib -lmpich.rts -lmsglayer.rts \ + -lrts.rts -ldevices.rts + +ifeq ($(DEBUG),TRUE) + FFLAGS += -qinitauto=FF911299 -qflttrap=ov:zero:inv:en +else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + # Inline when not debugging + FORTRAN_OPTIMIZATION := -O3 -qstrict -Q + endif + FFLAGS += $(FORTRAN_OPTIMIZATION) +endif + +ifneq ($(strip $(LAPACK_LIBDIR)),) + LDFLAGS += -L$(LAPACK_LIBDIR) -llapack -lblas +endif + +endif + +#------------------------------------------------------------------------ +# BGP +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),BGP) + +CPPDEF += -DAIX -DBGP $(NO_CONTIGUOUS_FLAG) +ifeq ($(SMP),TRUE) + # THREADED_OMP is used by the timing library + CPPDEF += -DTHREADED_OMP +endif + +cpp_path += -I/bgsys/drivers/ppcfloor/arch/include + +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(subst $(comma),\\$(comma),$(CPPDEF)) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(FPPFLAGS)) + +CFLAGS := $(cpp_path) $(CPPDEF) -O2 + +mod_path := -I$(MCT_LIBDIR)/mct -I$(MCT_LIBDIR)/mpeu +ifeq ($(SPMD),FALSE) + mod_path += -I$(MCT_LIBDIR)/mpi-serial +endif +ifneq ($(strip $(MOD_NETCDF)),) + mod_path += -I$(MOD_NETCDF) +endif + +FFLAGS := $(cpp_path) $(mod_path) $(FPPFLAGS) \ + -qspillsize=2500 -g -qfullpath +FFLAGS_NOOPT := $(FFLAGS) +FREEFLAGS := -qsuffix=f=f90:cpp=F90 +FIXEDFLAGS := -qfixed=132 +LDFLAGS := $(FFLAGS) -Wl,--relax + +ifeq ($(SMP),TRUE) + FFLAGS_NOOPT += -qsmp=omp:noopt + + # -qsmp implicitly turns on -O2. Explicitly disable this for debugging. + ifeq ($(DEBUG),TRUE) + FFLAGS += -qsmp=omp:noopt + CFLAGS += -qsmp=omp:noopt + LDFLAGS += -qsmp=omp:noopt + else + FFLAGS += -qsmp=omp + CFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp + endif +endif + +ifeq ($(DEBUG),TRUE) + FFLAGS += -O0 -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en + FFLAGS_NOOPT += -O0 -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en +else + # Check for override of default Fortran compiler optimizations + ifeq ($(F_OPTIMIZATION_OVERRIDE),$(null)) + # Inline when not debugging + FORTRAN_OPTIMIZATION := -qarch=450 -O3 -Q -qstrict + endif + FFLAGS += $(FORTRAN_OPTIMIZATION) +endif + +ifneq ($(strip $(LAPACK_LIBDIR)),) + LDFLAGS += -L$(LAPACK_LIBDIR) -llapack -lblas +endif + +# Compile these RRTMG files without optim +# Until mods are made to read the data from files, just remove optimization from +# their compilation. +rrtmg_lw_k_g.o: rrtmg_lw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< +rrtmg_sw_k_g.o: rrtmg_sw_k_g.f90 + $(FC) -c $(FREEFLAGS) $(FFLAGS_NOOPT) $< + +endif + +#------------------------------------------------------------------------ + +# Default linker is the Fortran compiler +ifeq ($(strip $(LINKER)),) + LINKER := $(FC) +endif + +# For compiling and linking with external ESMF. +# If linking to external ESMF library then include esmf.mk to provide the macros: +# ESMF_F90COMPILEPATHS +# ESMF_F90LINKPATHS +# ESMF_F90LINKRPATHS +# ESMF_F90ESMFLINKLIBS +ifneq ($(strip $(ESMF_LIBDIR)),) + include $(ESMF_LIBDIR)/esmf.mk + FFLAGS += $(ESMF_F90COMPILEPATHS) + LDFLAGS += $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) + #override default linker with ESMF recommendation unless user has set linker + ifeq ($(strip $(USER_LINKER)),) + LINKER = $(ESMF_F90LINKER) + endif +endif + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# export variables needed by sub-Make +export FC +export FC_FLAGS +export FC_AUTO_R8 +export FREEFLAGS +export FIXEDFLAGS + +include $(CURDIR)/Depends diff --git a/bld/build-namelist b/bld/build-namelist new file mode 100755 index 0000000000..2e516f5580 --- /dev/null +++ b/bld/build-namelist @@ -0,0 +1,4821 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# build-namelist +# +# This script builds the namelists for the standalone CAM configuration of CCSM4. +# Eventually the system's build will be reworked so that individual components are responsible +# for building their own namelists. +# +# build-namelist is designed to be used in conjuction with configure. By default configure +# produces a config_cache.xml file that contains all information needed at build time to procduce +# a CAM executable. build-namelist reads this file to obtain information it needs to provide +# default values that are consistent with the CAM executable. For example, the grid resolution +# is obtained from the cache file and used to determine appropriate defaults for boundary datasets +# that are resolution dependent. +# +# The simplest use of build-namelist is to execute it from the build directory where configure +# was run. By default it will use the config_cache.xml file that was written by configure to +# determine the build time properties of the executable, and will write the files that contain +# the output namelists in that same directory. But if multiple runs are to made using the +# same executable, successive invocations of build-namelist will overwrite previously generated +# namelist files. So generally the best strategy is to invoke build-namelist from the run +# directory and use the -config option to provide the filepath of the config_cache.xml file. +# +# +# Date Contributor Modification +# ------------------------------------------------------------------------------------------- +# 2007-12-31 Brian Eaton Original version +# 2008-02-02 B. Eaton Restore -test functionality. +# 2008-07-01 Sean Santos Added -inputdata functionality. +# 2008-07-09 B. Eaton Provide default values for rad_climate variable which +# specifies the radiatively active constituents. +# 2008-08-26 B. Eaton Add the driver namelist group ccsm_pes to specify the +# task/thread layout for all components. +# 2008-11-14 B. Eaton Extend use_case functionality. +# 2009-09-02 B. Eaton Allow namelist definition, defaults, and use case files +# to come from the user source mod directories. +#-------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use Cwd; +use English; +use File::Basename; +use Getopt::Long; +use IO::File; +use FindBin qw($Bin); +use lib "$Bin/perl5lib"; +use Build::ChemNamelist qw(set_dep_lists set_aero_modes_info chem_has_species); +#----------------------------------------------------------------------------------------------- + +sub usage { + die < Specify the number of MPI tasks being used by the run. This is used + to set a default decomposition for the FV dycore only (npr_yz). + -runtype "type" Type of simulation (startup, continue, or branch) + -silent [-s] Turns on silent mode - only fatal messages issued. + -test Enable checking that input datasets exist on local filesystem. + -use_case Specify a use case. Default: present day climatology + -verbose [or -v] Turn on verbose echoing of informational messages. + -version Echo the CVS tag name used to check out this CAM distribution. + +Note: The precedence for setting the values of namelist variables is (highest to lowest): + 1. namelist values set by specific command-line options, i.e., -case, + -runtype + 2. values set on the command-line using the -namelist option, + 3. values read from the file specified by -infile, + 4. values specified by the -use_case option, + 5. values from the namelist defaults file. +EOF +} + +#----------------------------------------------------------------------------------------------- +# Set the directory that contains the CAM configuration scripts. If the command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +$ProgName = "CAM $ProgName"; # Since multiple components are now using a build-namelist + # utility add "CAM" qualifier to the name. This helps when + # looking at error output from the whole CCSM system. +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script is in + # the user's PATH +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +if ($ProgDir) { + $cfgdir = absolute_path($ProgDir); +} else { + $cfgdir = $cwd; +} + +# CAM root directory. +my $cam_root = absolute_path("$cfgdir/../../.."); + +my $cfg_cache = "config_cache.xml"; # Default name of configuration cache file +my $outdirname = "."; # Default name of output directory name + +#----------------------------------------------------------------------------------------------- +# Save commandline +my $commandline = "$cfgdir/build-namelist @ARGV"; + +#----------------------------------------------------------------------------------------------- + +# Process command-line options. + +my %opts = ( config => $cfg_cache, + csmdata => undef, + help => 0, + dir => $outdirname, + silent => 0, + test => 0, + ); + +GetOptions( + "case=s" => \$opts{'case'}, + "config=s" => \$opts{'config'}, + "csmdata=s" => \$opts{'csmdata'}, + "d|dir=s" => \$opts{'dir'}, + "h|help" => \$opts{'help'}, + "ignore_ic_date" => \$opts{'ignore_ic_date'}, + "ignore_ic_year" => \$opts{'ignore_ic_year'}, + "infile=s" => \$opts{'infile'}, + "inputdata=s" => \$opts{'inputdata'}, + "namelist=s" => \$opts{'namelist'}, + "ntasks=s" => \$opts{'ntasks'}, + "runtype=s" => \$opts{'runtype'}, + "s|silent" => \$opts{'silent'}, + "test" => \$opts{'test'}, + "uc|use_case=s" => \$opts{'use_case'}, + "v|verbose" => \$opts{'verbose'}, + "version" => \$opts{'version'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Echo version info. +if ($opts{'version'}) { + version($cfgdir); + exit; +} + +# Check for unparsed arguments +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +# Define print levels: +# 0 - only issue fatal error messages +# 1 - only informs what files are created (default) +# 2 - verbose +my $print = 1; +if ($opts{'silent'}) { $print = 0; } +if ($opts{'verbose'}) { $print = 2; } +my $eol = "\n"; + +if ($print>=2) { print "Setting CAM configuration script directory to $cfgdir$eol"; } +if ($print>=2) { print "build-namelist was invoked with the commandline:\n $commandline$eol"; } + +# Check that configuration cache file exists. +(-f $opts{'config'}) or die <<"EOF"; +** $ProgName - ERROR: Cannot find configuration cache file: \"$opts{'config'}\" ** +EOF + +if ($print>=2) { print "Using CAM configuration cache file $opts{'config'}$eol"; } + +# Check that the CCSM inputdata root directory has been specified. +my $inputdata_rootdir = undef; +if (defined($opts{'csmdata'})) { + $inputdata_rootdir = $opts{'csmdata'}; +} +elsif (defined $ENV{'CSMDATA'}) { + $inputdata_rootdir = $ENV{'CSMDATA'}; +} +else { + die "$ProgName - ERROR: CCSM inputdata root directory must be specified by either -csmdata argument\n" . + " or by the CSMDATA environment variable. :"; +} + +if ($print>=2) { print "CCSM inputdata root directory: $inputdata_rootdir$eol"; } + +# If the -test option is specified, then the inputdata root directory must be local or nfs mounted. +if ($opts{'test'}) { +(-d $inputdata_rootdir) or die <<"EOF"; +** $ProgName - ERROR: CCSM inputdata root is not a directory: \"$inputdata_rootdir\" ** +EOF +} + +#----------------------------------------------------------------------------------------------- +# Make sure we can find required perl modules, definition, and defaults files. +# Look for them under the directory that contains the configure script. + +# The XML::Lite module is required to parse the XML files. +(-f "$cfgdir/perl5lib/XML/Lite.pm") or die <<"EOF"; +** $ProgName - ERROR: Cannot find perl module \"XML/Lite.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +# The Build::Config module provides utilities to access the configuration information +# in the config_cache.xml file +(-f "$cfgdir/perl5lib/Build/Config.pm") or die <<"EOF"; +** $ProgName - ERROR: Cannot find perl module \"Build/Config.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +# The Build::NamelistDefinition module provides utilities to validate that the output +# namelists are consistent with the namelist definition file +(-f "$cfgdir/perl5lib/Build/NamelistDefinition.pm") or die <<"EOF"; +** $ProgName - ERROR: Cannot find perl module \"Build/NamelistDefinition.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +# The Build::NamelistDefaults module provides a utility to obtain default values of namelist +# variables based on finding a best fit with the attributes specified in the defaults file. +(-f "$cfgdir/perl5lib/Build/NamelistDefaults.pm") or die <<"EOF"; +** $ProgName - ERROR: Cannot find perl module \"Build/NamelistDefaults.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +# The Build::Namelist module provides utilities to parse input namelists, to query and modify +# namelists, and to write output namelists. +(-f "$cfgdir/perl5lib/Build/Namelist.pm") or die <<"EOF"; +** $ProgName - ERROR: Cannot find perl module \"Build/Namelist.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +#----------------------------------------------------------------------------------------------- +# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules +unshift @INC, "$cfgdir/perl5lib"; +require XML::Lite; +require Build::Config; +require Build::NamelistDefinition; +require Build::NamelistDefaults; +require Build::Namelist; + +#----------------------------------------------------------------------------------------------- +# Create a configuration object from CAM's config_cache.xml file. This object contains +# all the build-time specifications of the CAM executable. +my $cfg = Build::Config->new($opts{'config'}); + +#----------------------------------------------------------------------------------------------- +# Create a namelist definition object. This object provides a method for verifying that the +# output namelist variables are in the definition file, and are output in the correct +# namelist groups. Requires a namelist definition file... +# +# The namelist definition file contains entries for all namelist variables that +# can be output by build-namelist. The version of the file that is associate with a +# fixed CAM tag is $cfgdir/namelist_files/namelist_definition.xml. To aid developers +# who make use of the source mods directory (via -usr_src arg to configure) we allow +# the definition file to come from one of those directories. + +my $nl_definition_file; +my @usr_src_dirs = split ',', $cfg->get('usr_src'); +if (@usr_src_dirs) { + foreach my $dir (@usr_src_dirs) { + if (-f "$dir/namelist_definition.xml") { + $nl_definition_file = "$dir/namelist_definition.xml"; + last; + } + } +} +if (! defined $nl_definition_file) { + # default location of namelist definition file + $nl_definition_file = "$cfgdir/namelist_files/namelist_definition.xml"; + (-f "$nl_definition_file") or die <<"EOF"; + ** $ProgName - ERROR: Cannot find namelist definition file \"$nl_definition_file\" ** +EOF +} + +if ($print>=2) { print "Using namelist definition file $nl_definition_file$eol"; } + +my $definition = Build::NamelistDefinition->new($nl_definition_file); + +#----------------------------------------------------------------------------------------------- +# Create a namelist defaults object. This object provides default values for variables +# contained in the input defaults file. The configuration object provides attribute +# values that are relevent for the CAM executable for which the namelist is being produced. +# These attributes are used along with optional user specified attributes to find the +# best match when looking for default values. +# +# The namelist defaults file contains default values for all required namelist variables. +# Analogously to the definition file, we allow a user modified version of this file to +# be present in one of the usr_src directories. + +my $nl_defaults_file; +if (@usr_src_dirs) { + foreach my $dir (@usr_src_dirs) { + if (-f "$dir/namelist_defaults_cam.xml") { + $nl_defaults_file = "$dir/namelist_defaults_cam.xml"; + last; + } + } +} +if (! defined $nl_defaults_file) { + # default location of namelist defaults file + $nl_defaults_file = "$cfgdir/namelist_files/namelist_defaults_cam.xml"; + (-f "$nl_defaults_file") or die <<"EOF"; + ** $ProgName - ERROR: Cannot find namelist defaults file \"$nl_defaults_file\" ** +EOF +} + +if ($print>=2) { print "Using namelist defaults file $nl_defaults_file$eol"; } + +my $defaults = Build::NamelistDefaults->new($nl_defaults_file, $cfg); + +#----------------------------------------------------------------------------------------------- +# Similarly to the namelist definition and defaults files, the use case file +# may also come from the usr_src directories. Determine the location of the +# use case file. + +my $use_case_file; +if (defined $opts{'use_case'}) { + + if (@usr_src_dirs) { + foreach my $dir (@usr_src_dirs) { + if (-f "$dir/$opts{'use_case'}.xml") { + $use_case_file = "$dir/$opts{'use_case'}.xml"; + last; + } + } + } + + if (! defined $use_case_file) { + # default location of namelist use case files + $opts{'use_case_dir'} = "$cfgdir/namelist_files/use_cases"; + validate_use_case("commandline", \%opts); + $use_case_file = "$opts{'use_case_dir'}/$opts{'use_case'}.xml"; + } + + if ($print>=2) { print "Using namelist use case file $use_case_file$eol"; } +} + +#----------------------------------------------------------------------------------------------- +# Create an empty namelist object. Add values to it in order of precedence. +my $nl = Build::Namelist->new(); + +#----------------------------------------------------------------------------------------------- + +# Some regular expressions... +# **N.B.** the use of qr// for precompiling regexps isn't supported until perl 5.005. +my $TRUE = "\.true\."; +my $FALSE = "\.false\."; + +#----------------------------------------------------------------------------------------------- + +# Process the user input in order of precedence. At each point we'll only add new +# values to the namelist and not overwrite previously specified specified values which +# have higher precedence. + +# Process the commandline args that provide specific namelist values. + +# Case name +if (defined $opts{'case'}) { add_default($nl, 'case_name', 'val'=>$opts{'case'}); } + +# Run type +if (defined $opts{'runtype'}) { add_default($nl, 'start_type', 'val'=>$opts{'runtype'}); } + +# Process the -namelist arg. + +if (defined $opts{'namelist'}) { + # Parse commandline namelist + my $nl_arg = Build::Namelist->new($opts{'namelist'}); + + # Validate input namelist -- trap exceptions + my $nl_arg_valid; + eval { $nl_arg_valid = $definition->validate($nl_arg); }; + if ($@) { + die "$ProgName - ERROR: Invalid namelist variable in commandline arg '-namelist'.\n $@"; + } + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_arg_valid); +} + +# Process the -infile arg. + +if (defined $opts{'infile'}) { + # Parse namelist input from a file + my $nl_infile = Build::Namelist->new($opts{'infile'}); + + # Validate input namelist -- trap exceptions + my $nl_infile_valid; + eval { $nl_infile_valid = $definition->validate($nl_infile); }; + if ($@) { + die "$ProgName - ERROR: Invalid namelist variable in '-infile' $opts{'infile'}.\n $@"; + } + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_infile_valid); +} + +# Process the -use_case arg. +# Declare global symbol $uc_defaults even if it's not defined, because we check whether it's +# defined before using it in the get_default_value method below. + +my $uc_defaults; +if (defined $use_case_file) { + + # The use case definition is contained in an xml file with the same format as the defaults file. + # Create a new NamelistDefaults object. + $uc_defaults = Build::NamelistDefaults->new($use_case_file, $cfg); + + # Loop over the variables specified in the use case. + # A defaults file may contain information for variables that are not namelist variables. + # Check each name in the defaults file, and add each namelist variable to the namelist. + my @vars = $uc_defaults->get_variable_names(); + VAR: foreach my $var (@vars) { + + # Query the definition to find which group the variable belongs to. Skip if not found. + my $group = $definition->get_group_name($var); + if ($group) { + # Get the value of $var from the use case defaults + my $val = $uc_defaults->get_value($var); + if (defined $val) { + add_default($nl, $var, 'val'=>$val); + } + # If the use case doesn't provide a default value, then just ignore. This allows the + # use case mechanism to provide defaults for some attributes (e.g. a specific grid), and + # not for others. + } + } +} + +#----------------------------------------------------------------------------------------------- + +# Add default values for required namelist variables that have not been previously set. +# This is done either by using the namelist default object, or directly with inline logic. + +# Are we building namelists for the CESM scripts or for standalone CAM scripts. If +# CESM then only produce namelists for the CAM component. If CAM standalone then produce +# output for the required non-cam components as well. + +my $ccsm_build = $cfg->get('ccsm_seq'); +my $cam_build = $ccsm_build ? 0 : 1; +if ($print>=2) { + if ($ccsm_build) { + print "Writing namelist files for cesm scripts$eol"; + } + elsif ($cam_build) { + print "Writing namelist files for cam standalone scripts$eol"; + } +} + +# Start with the driver component. These settings are communicated by the driver to +# all subcomponents. + +#################################### +# namelist group: cime_driver_inst # +#################################### + +add_default($nl, 'ninst_driver', 'val'=>'1'); + +###################################### +# namelist group: seq_cplflds_inparm # +###################################### +add_default($nl, 'flds_co2_dmsa', 'val'=>'.false.'); +add_default($nl, 'flds_co2a', 'val'=>'.true.'); +add_default($nl, 'flds_co2b', 'val'=>'.false.'); +add_default($nl, 'flds_co2c', 'val'=>'.false.'); +add_default($nl, 'cplflds_custom', 'val'=>''); + +############################ +# namelist group: ccsm_pes # +############################ + +# By default the driver sets all components to use all tasks. This is the +# appropriate default for the standalone CAM configuration. + +# By default the driver sets all components to use 1 thread. This should be +# reset either to user specified values, or by default use the OMP_NUM_THREADS +# environment variable to set the thread count for each component. + +# Is this an smp build? +my $smp = $cfg->get('smp'); +if ($smp) { + + # If user has set the specific variables for component threads on the commandline + # those values will be used. If not, the highest precedence will be given the the + # value of the environment variable OMP_NUM_THREADS. That is because the number of + # threads specified on the configure commandline is used to determine an appropriate + # decomposition for the CICE model, but that decomposition may be valid for a range + # of ntask/nthread settings. + + # Check for OMP_NUM_THREADS + my $nthreads; + if (defined $ENV{'OMP_NUM_THREADS'}) { + $nthreads = $ENV{'OMP_NUM_THREADS'}; + } + + if ($nthreads) { + add_default($nl, 'atm_nthreads', 'val'=>$nthreads); + add_default($nl, 'cpl_nthreads', 'val'=>$nthreads); + add_default($nl, 'ice_nthreads', 'val'=>$nthreads); + add_default($nl, 'lnd_nthreads', 'val'=>$nthreads); + add_default($nl, 'ocn_nthreads', 'val'=>$nthreads); + add_default($nl, 'rof_nthreads', 'val'=>$nthreads); + } +} + +####################################### +# namelist group: seq_infodata_inparm # +####################################### +# Case name +add_default($nl, 'case_name'); + +# Run type +add_default($nl, 'start_type'); + +# CIME model version +add_default($nl, 'cime_model', 'val'=>'cesm'); + +# CESM driver defaults +add_default($nl, 'coldair_outbreak_mod', 'val'=>'.true.'); +add_default($nl, 'flux_max_iteration', 'val'=>'5'); +add_default($nl, 'gust_fac', 'val'=>'0'); + +# Spectral Element dycore +my $dyn = $cfg->get('dyn'); +if ($dyn =~ /se/) {add_default($nl, 'vect_map', 'val'=>'cart3d');} + +# Physics package checks done here since aqua_planet setting is in +# the seq_infodata_inparm group +my $phys_mode_flags = 0; +my $adia_mode = 0; +my $aqua_mode = 0; + +my $phys = $cfg->get('phys'); + +# Aqua planet + +my $aqua_mode = $cfg->get('aquaplanet'); +my $nl_aqua_flag = $nl->get_value('aqua_planet'); + +# Consistency check between configuration and namelist variables used for aquaplanet. +if ($aqua_mode and defined $nl_aqua_flag and ($nl_aqua_flag =~ m/$FALSE/io)) { + die "$ProgName - ERROR: Configured CAM for aquaplanet but aqua_planet set to FALSE in the namelist. \n"; +} +if (!($aqua_mode) and defined $nl_aqua_flag and ($nl_aqua_flag =~ m/$TRUE/io)) { + die "$ProgName - ERROR: CAM not configured for aquaplanet but aqua_planet set to TRUE in the namelist. \n"; +} + +if ($aqua_mode) { + add_default($nl, 'aqua_planet', 'val'=>'.true.'); + ++$phys_mode_flags; +} + +# Consistency check for namelist variables used to implement physics modes. +if ($phys eq 'adiabatic') { + $adia_mode = 1; + ++$phys_mode_flags; +} +my $ideal_mode = 0; +if ($phys eq 'kessler' or $phys eq 'held_suarez') { + $ideal_mode = 1; + ++$phys_mode_flags; +} +if ($phys_mode_flags > 1) { + die "$ProgName - ERROR: Only one of the variables atm_adiabatic, atm_ideal_phys, and aqua_planet can be set .true. \n"; +} + +# Set convenience flag to indicate that one of the ideal or adiabatic +# modes is being used. +my $simple_phys = 0; +if ($adia_mode or $ideal_mode) { $simple_phys = 1; } + +# Note that the prescribed SSTs +# used by aqua-planet mode are implemented in the cam_aqua component.) + +# Single column mode +my $scam = $cfg->get('scam'); +if ($scam) { + add_default($nl, 'single_column', 'val'=>'.true.'); + add_default($nl, 'scmlat'); + add_default($nl, 'scmlon'); +} + +###################################### +# namelist group: seq_timemgr_inparm # +###################################### + +# Length of simulation +add_default($nl, 'stop_option'); +unless (defined $nl->get_value('stop_ymd')) { add_default($nl, 'stop_n'); } + +# Restart interval +add_default($nl, 'restart_option'); + +# Start date +# The following check should be done for CAM standalone builds only. +if ($cam_build) { + # When the user specifies ncdata there is no default for start_ymd since there is + # no way to determine the corresponding date of the ncdata file. So only add + # a default for start_ymd if the user has not specified ncdata. + if (defined $nl->get_value('ncdata')) { + unless (defined $nl->get_value('start_ymd')) { + die "$ProgName - ERROR: It is not allowed to set ncdata without also setting start_ymd. \n"; + } + } + else { + add_default($nl, 'start_ymd'); + } +} + +# Orbit (if not coupled) +# If orbital parameters have not been specified then check for orbit year. +# If orbit year has not been specified, then set a default value. +if ($cam_build) { + if (not defined $nl->get_value('orb_obliq') or + not defined $nl->get_value('orb_eccen') or + not defined $nl->get_value('orb_mvelp') ) { + if (not defined $nl->get_value('orb_iyear')) { + add_default($nl, 'orb_iyear'); + } + } +} + +add_default($nl, 'cpl_seq_option'); + +# Coupling interval +# The default is for CAM to couple to the surface components every CAM timestep. +# So start by making sure CAM's dtime is set. +add_default($nl, 'dtime'); +my $dtime = $nl->get_value('dtime'); +add_default($nl, 'atm_cpl_dt', 'val'=>$dtime); + +#----------------------------------------------------------------------------------------------- +# Add defaults for the CAM component + +my $chem = $cfg->get('chem'); +my $waccm_chem = ($chem =~ "waccm_"); +my $waccm_phys = $cfg->get('waccm_phys'); +my $carma = $cfg->get('carma'); + +my $prog_species = $cfg->get('prog_species'); +my $prog_ghg1 = ($chem =~ "trop_mozart" or $chem =~ "trop_strat" or $chem =~ "ghg" or $chem =~ "_sc" or $prog_species =~ "GHG"); +my $prog_ghg2 = ($chem =~ "ghg" or $chem =~ "_sc" or $prog_species =~ "GHG"); +my $ghg_chem = ($chem =~ "ghg" or $chem =~ "_sc"); +my $aero_chem = ($chem =~ "aero" or $chem eq 'trop_mozart' or $chem =~ 'trop_strat' or $chem =~ 'tsmlt' or $chem eq 'trop_bam'); + +my $chem_rad_passive = ($nl->get_value('chem_rad_passive') =~ /$TRUE/io); +my $ipcc_aircraft_emis = ($nl->get_value('ipcc_aircraft_emis') =~ /$TRUE/io); + +my $rad_prog_ocarb = (($prog_species =~ "OC" or $aero_chem) and !($chem_rad_passive)); +my $rad_prog_bcarb = (($prog_species =~ "BC" or $aero_chem) and !($chem_rad_passive)); +my $rad_prog_sulf = (($prog_species =~ "SO4" or $aero_chem or $chem =~ "super_fast_llnl") and !($chem_rad_passive)); +my $rad_prog_dust = (($prog_species =~ "DST" or $aero_chem) and !($chem_rad_passive)); +my $rad_prog_sslt = (($prog_species =~ "SSLT" or $aero_chem) and !($chem_rad_passive)); +my $rad_prog_ozone = (($chem =~ "mozart" or $chem =~ "waccm_ma" or $chem =~ "tsmlt" or $chem =~ "trop_strat" or $chem =~ "super_fast_llnl") and !($chem_rad_passive)); + +# Check for eruptive volcano emissions. These will be radiatively active by default, but +# only if using BAM and the camrt radiation package +# or if using MAM and the rrtmg package +(my $volcaero_file = $nl->get_value('prescribed_volcaero_file')) =~ s/\s//g; # strip white space +$volcaero_file =~ s/['"]//g; # strip quotes "' +my $rad_volcaero = ($volcaero_file and $volcaero_file ne 'NONE' ) ? 1 : 0; +################# +# CAM namelists # +################# + +# Print conservation errors +# Turn this off for PERGRO runs or for WACCM runs +if ($cfg->get('pergro') or ($chem ne 'none')) { + add_default($nl, 'print_energy_errors', 'val'=>'.false.'); +} + +# Set default for QNEG warnings +add_default($nl, 'print_qneg_warn', 'val'=>'summary'); + +# Turn on debugging checks +if ($cfg->get('debug')) { + add_default($nl, 'state_debug_checks', 'val'=> '.true.') +} + +my $prescribe_aerosols = $TRUE; +if ($simple_phys) {$prescribe_aerosols = $FALSE;} + +# Chemistry deposition lists +if ( ($chem ne 'none') or ( $prog_species ) ){ + my $chem_proc_src = $cfg->get('chem_proc_src'); + my $chem_src_dir = $cfg->get('chem_src_dir'); + + my ( $gas_wetdep_list, $aer_wetdep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, + $aer_drydep_list, $gas_drydep_list ) = + set_dep_lists( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print ); + + if (length($gas_wetdep_list)>2){ + add_default($nl, 'gas_wetdep_method' ); + add_default($nl, 'gas_wetdep_list', 'val'=>$gas_wetdep_list ); + } + if (length($aer_wetdep_list)>2){ + # determine if prescribed aerosols are not needed ... + if ($aer_wetdep_list =~ /so4/i && + $aer_wetdep_list =~ /dst/i && + ($aer_wetdep_list =~ /bc/i || $aer_wetdep_list =~ /cb/i) && + ($aer_wetdep_list =~ /ncl/i || $aer_wetdep_list =~ /sslt/i)) { + $prescribe_aerosols = $FALSE; + } + + add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list ); + + if (!($chem =~ /_mam/)) { + if (!defined $nl->get_value('aer_sol_facti')) { + add_default($nl, 'aer_sol_facti', val=>$aer_sol_facti ); + } + if (!defined $nl->get_value('aer_sol_factb')) { + add_default($nl, 'aer_sol_factb', val=>$aer_sol_factb ); + } + if (!defined $nl->get_value('aer_scav_coef')) { + add_default($nl, 'aer_scav_coef', val=>$aer_scav_coef ); + } + } + } + if (length($gas_drydep_list)>2){ + add_default($nl, 'drydep_list', 'val'=>$gas_drydep_list ); + add_default($nl, 'depvel_file' ); + add_default($nl, 'depvel_lnd_file' ); + add_default($nl, 'clim_soilw_file' ); + add_default($nl, 'season_wes_file' ); + } + if (length($aer_drydep_list)>2){ + add_default($nl, 'aer_drydep_list', 'val'=>$aer_drydep_list ); + } +} +if ($chem) { + # Dry Deposition -- The responsibility for dry deposition is shared between CAM and CLM. + # The namelist is read by a driver module, seq_drydep_mod, and the information is shared + # between CAM and CLM by use association of that module. + add_default($nl, 'drydep_method'); + + # drydep_srf_file is only needed for prognostic MAM when the grid is unstructured. + # structured grids can do interpolation on the fly. + if ($chem =~ /_mam/ and $dyn =~ /se/) { + add_default($nl, 'drydep_srf_file'); + } +} + +# Initial conditions +# +# Most of the attributes that are matched to determine the default initial file are +# build time options that come from the configuration object. But there are also a couple +# of run time options that need to be considered. Set those in the optional hash argument +# to add_default. +my %atts = (); + +# The initial date is an attribute in the defaults file which should be matched unless +# the user explicitly requests to ignore the initial date via the -ignore_ic_date option, +# or just ignore the year of the initial date via the -ignore_ic_year option. +my $ic_date = $nl->get_value('start_ymd'); +if ($opts{'ignore_ic_date'}) { + # Don't set any attribute for date matching. By putting this option first it + # will take precedence in the case that the user has set both -ignore_ic_date + # and -ignore_ic_year +} +elsif ($opts{'ignore_ic_year'}) { + $atts{'ic_md'} = $ic_date; +} +else { + # if neither option specified then match full date + $atts{'ic_ymd'} = $ic_date; +} +add_default($nl, 'ncdata', %atts); + +# analytic ICs +my $analytic_ic = $cfg->get('analytic_ic'); +if ($analytic_ic) { + add_default($nl, 'analytic_ic_type'); +} + +# +# Simulated years: sim_year and sim_year_start +# +# sim_year +# This is used to identify appropriate defaults for climatological or transient +# forcing datasets. If user hasn't specified then default to 2000 (present day climatology). +my $sim_year = '2000'; +if (defined $nl->get_value('sim_year')) { + $sim_year = $nl->get_value('sim_year'); + # strip quotes to use the value in attribute matching. + $sim_year =~ s/['"]//g; #"' +} + +# sim_year_start +# If sim_year is input as a range of years, then select the first year +# to use with some datasets +my $sim_year_start = $sim_year; +if ($sim_year =~ /(\d+)-(\d+)/) { + $sim_year_start = $1; +} + +# Topography +add_default($nl, 'use_topo_file'); +my $use_topo_file = $nl->get_value('use_topo_file'); +if (!defined $use_topo_file or ($use_topo_file =~ m/$TRUE/io)) { + # Add the topo file unless the "do not use" override has been set. + add_default($nl, 'bnd_topo'); +} + +# Radiation +my $rad_pkg = $cfg->get('rad'); +if ($rad_pkg eq 'camrt') { + add_default($nl, 'absems_data'); +} + +# Solar irradiance + +# First check that solar_const and solar_irrad_data_file are not both defined +if (defined $nl->get_value('solar_const') and + defined $nl->get_value('solar_irrad_data_file')) { + + die "$ProgName - ERROR: It is not allowed to set both solar_const and solar_irrad_data_file.\n"; + +} + +if ($rad_pkg eq 'rrtmg' or $chem =~ /waccm/) { + + if (defined $nl->get_value('solar_const')) { + die "$ProgName - ERROR: Specifying solar_const with RRTMG or WACCM is not allowed.\n" + } + + # use solar data file as the default for rrtmg and waccm_ma + add_default($nl, 'solar_irrad_data_file'); + add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.true.'); + +} +elsif (!$simple_phys) { + + if ($chem eq 'none' and !($prog_species =~ /SO4/) ) { # Spectral solar data is needed for photolysis + # this preserves the default cam3 and cam4 configurations which do not have chemistry + unless (defined $nl->get_value('solar_irrad_data_file')) { + add_default($nl, 'solar_const'); + } + } else { + # use solar data file as the default for all chem conifigurations + unless (defined $nl->get_value('solar_const')) { + add_default($nl, 'solar_irrad_data_file'); + } + } + + add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.false.'); +} + + +# COSP simulator +if ($cfg->get('cosp')) { + add_default($nl, 'docosp', 'val'=>'.true.'); +} + + +# Constituents +# ============ + +# Carbon cycle constituents +my $co2_cycle = $cfg->get('co2_cycle'); + +if ($co2_cycle) { + + # co2_flag turns on the co2_cycle code in CAM + add_default($nl, 'co2_flag', 'val'=>'.true.'); + + + # Supply a fossil fuel dataset if the co2_cycle is active and it's a + # transient run ... + if ($sim_year =~ /(\d+)-(\d+)/) { + + add_default($nl, 'co2_readflux_fuel', 'val'=>'.true.'); + + # Check whether user has explicitly turned off reading the fossil fuel dataset. + # (user specification has higher precedence than the true value set above) + if ($nl->get_value('co2_readflux_fuel') =~ /$TRUE/io) { + add_default($nl, 'co2flux_fuel_file', 'sim_year'=>$sim_year); + } + } +} + +# By default the prognostic co2_cycle CO2 will be radiative active, unless the +# the user sets this override variable. This is used below to construct the +# rad_climate variable. +my $co2_cycle_rad_passive = ($nl->get_value('co2_cycle_rad_passive') =~ /$TRUE/io); + + +# Set number of test tracers requested via -nadv_tt option to configure +my $test_tracer_num = $cfg->get('nadv_tt'); +if ($test_tracer_num > 0) { + add_default($nl, 'test_tracer_num', 'val'=>$test_tracer_num); +} + +if ($cfg->get('age_of_air_trcs')) { add_default($nl, 'aoa_tracers_flag', 'val'=>'.true.'); } + +# If phys option is "cam3" then turn on the CAM3 prescribed ozone and aerosols +if ($phys eq 'cam3' and !$aqua_mode) { + add_default($nl, 'cam3_ozone_data_on', 'val'=>'.true.'); + add_default($nl, 'cam3_aero_data_on', 'val'=>'.true.'); +} + +# Defaults for radiatively active constituents + +my $cam3_ozone_data = $FALSE; +my $cam3_aero_data = $FALSE; + +my $moz_ozone_data = $FALSE; +if (!$rad_prog_ozone) { + $moz_ozone_data = $TRUE; +} + +my $moz_aero_data = $FALSE; +if (!($rad_prog_ocarb) or !($rad_prog_bcarb) or !($rad_prog_sulf) or !($rad_prog_dust) or !($rad_prog_sslt)){ + $moz_aero_data = $TRUE; +} + +# CAM3 prescribed ozone only by request +if (defined $nl->get_value('cam3_ozone_data_on') and + $nl->get_value('cam3_ozone_data_on') =~ /$TRUE/io) { + add_default($nl, 'bndtvo'); + $cam3_ozone_data = $TRUE; + $moz_ozone_data = $FALSE; +} + +# CAM3 prescribed aerosols only by request +if (defined $nl->get_value('cam3_aero_data_on') and + $nl->get_value('cam3_aero_data_on') =~ /$TRUE/io) { + + # CAM3 aerosol mass climatology dataset (horizontal resolution dependent) + add_default($nl, 'bndtvaer'); + $cam3_aero_data = $TRUE; + $moz_aero_data = $FALSE; +} + +if ($chem_rad_passive or $aqua_mode) { + add_default($nl, 'atm_dep_flux', 'val'=>'.false.'); +} + +# The aerosol optics depend on which radiative transfer model is used due to differing +# wavelength bands used. +my $rrtmg = $rad_pkg eq 'rrtmg' ? 1 : 0; + +# @aero_names contains the names of the entities (bulk aerosols and modes) +# that are externally mixed in aerosol optics calculation. These entities are all +# associated with a file that contains their physical and optical properties. +my @aero_names = (); + +# @aerosources contains a source identifier corresponding to each entity in @aero_names. +# The values are 'A', 'N', or 'M' +my @aerosources = (); + +## Start assembling the gas contributions to the rad_climate specifier. + +# $radval contains the "list of strings" value (stored as a scalar string with embedded quotes +# and commas) that will be assigned to the namelist variable rad_climate. +my $radval = "'A:Q:H2O'"; + +if (($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) and !$chem_rad_passive) { + $radval .= ",'A:O2:O2','A:CO2:CO2'"; +} +elsif ($chem =~ /trop_strat/ and !$chem_rad_passive) { + $radval .= ",'N:O2:O2','A:CO2:CO2'"; +} +elsif ($co2_cycle and !$co2_cycle_rad_passive) { + $radval .= ",'N:O2:O2','A:CO2:CO2'"; +} +else { + $radval .= ",'N:O2:O2','N:CO2:CO2'"; +} + +if ($rad_prog_ozone) { + $radval .= ",'A:O3:O3'"; +} elsif ($moz_ozone_data =~ /$TRUE/io) { + $radval .= ",'N:ozone:O3'"; + if (!defined $nl->get_value('prescribed_ozone_file') and !$simple_phys) { + add_default($nl, 'prescribed_ozone_datapath'); + add_default($nl, 'prescribed_ozone_file'); + add_default($nl, 'prescribed_ozone_name'); + } + if (!defined $nl->get_value('prescribed_ozone_type') and !$simple_phys) { + add_default($nl, 'prescribed_ozone_type'); + add_default($nl, 'prescribed_ozone_cycle_yr'); + } +} elsif ($cam3_ozone_data =~ /$TRUE/io) { + $radval .= ",'N:O3:O3'"; +} else { + die "ERROR: can not set ozone rad_climate specification\n"; +} + +if (($chem =~ /super_fast_llnl/) and !$chem_rad_passive ) { + $radval .= ",'N:N2O:N2O','N:prsd_ch4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; +} elsif ((($chem =~ /waccm_ma/) or ($chem =~ /waccm_sc_mam/) or ($chem =~ /waccm_tsmlt/) or ($chem =~ /trop_strat/)) and !$chem_rad_passive ) { + $radval .= ",'A:N2O:N2O','A:CH4:CH4','N:CFC11STAR:CFC11','A:CFC12:CFC12'"; +} elsif ($prog_ghg1 and $prog_ghg2 and !$chem_rad_passive ) { + $radval .= ",'A:N2O:N2O','A:CH4:CH4','A:CFC11:CFC11','A:CFC12:CFC12'"; +} elsif ($prog_ghg1 and !$prog_ghg2 and !$chem_rad_passive ) { + $radval .= ",'A:N2O:N2O','A:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; +} else { + $radval .= ",'N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; +} + +# Aerosol contributions to rad_climate + +# The aerosol "model" is either bulk or modal. If the aerosols are prescribed +# we can't tell (without looking in datasets) what the aerosol model is, so the +# prescribed_aero_model namelist variable is provided to allow the user to +# override the default which is based on the physics package setting. +my $prescribed_aero_model = $nl->get_value('prescribed_aero_model'); +if (defined $prescribed_aero_model) { + # Strip the quotes from namelist input + $prescribed_aero_model =~ s/['"]//g; #"' +} +else { + $prescribed_aero_model = 'none'; + if ($prescribe_aerosols =~ /$TRUE/io) { + # if the chemistry does not include prognostic aerosols then + # prescribed aerosols need to be specified unless using simple physics. + # The only supported prescribed aerosols are 'bulk'. Set that as the + # default which can be overridden by the user. + $prescribed_aero_model = 'bulk'; + } +} + +# $aer_model is either 'bam' or 'mam'. This token is used in the element names that +# are constructed to get the default physprops files. +my $aer_model = 'bam'; +if ($prescribed_aero_model eq 'modal' or $chem =~ /_mam/) {$aer_model = 'mam';} + +if ($aer_model eq 'mam' ) { + + my $aero_modes = '3mode'; + if ($chem =~ /_mam7/) {$aero_modes = '7mode';} + if ($chem =~ /_mam4/) {$aero_modes = '4mode';} + + my @mode_names; + my @mode_types; + my @mode_num; + my @mode_num_cw ; + my @mode_spec ; + my @mode_spec_type; + my @mode_spec_cw; + my @mode_num_src; + my @mode_spec_src; + my %modal_groups; + my %modal_species = ( 'so4'=>'sulfate', + 'nh4'=>'ammonium', + 'pom'=>'p-organic', + 'soa'=>'s-organic', + 'bc' =>'black-c', + 'dst'=>'dust', + 'ncl'=>'seasalt' ); + + if ($aero_modes eq '3mode' ) { + # MAM rad_climate settings. The externally mixed quantities in the modal aerosol + # model are the modes. + push @aero_names, qw(mam3_mode1 mam3_mode2 mam3_mode3); + push @aerosources, qw(M: M: M:); + + # Each of the mode names put into the @aero_names array needs to be defined. + @mode_names = qw(mam3_mode1 mam3_mode2 mam3_mode3); + @mode_types = qw(accum aitken coarse); + @mode_num = qw(num_a1 num_a2 num_a3); + @mode_num_cw = qw(num_c1 num_c2 num_c3); + + %modal_groups = ( 'accum' => [qw(so4 pom soa bc dst ncl)], + 'aitken' => [qw(so4 soa ncl)], + 'coarse' => [qw(dst ncl so4)] ); + + + if ($chem =~ /_mam3/) { + @mode_num_src = qw(A A A); + } + else { + @mode_num_src = qw(N N N); + } + + } elsif($aero_modes eq '4mode') { + # For 4 modes + + # MAM rad_climate settings. The externally mixed quantities in the modal aerosol + # model are the modes. + push @aero_names, qw(mam4_mode1 mam4_mode2 mam4_mode3 mam4_mode4); + push @aerosources, qw(M: M: M: M:); + + # Each of the mode names put into the @aero_names array needs to be defined. + @mode_names = qw(mam4_mode1 mam4_mode2 mam4_mode3 mam4_mode4); + @mode_types = qw(accum aitken coarse primary_carbon); + @mode_num = qw(num_a1 num_a2 num_a3 num_a4); + @mode_num_cw = qw(num_c1 num_c2 num_c3 num_c4); + + %modal_groups = ( 'accum' => [qw(so4 pom soa bc dst ncl)], + 'aitken' => [qw(so4 soa ncl dst)], + 'coarse' => [qw(dst ncl so4)], + 'primary_carbon' => [qw(pom bc)] ); + + @mode_num_src = qw(A A A A); + + } elsif($aero_modes eq '7mode') { + + # For 7 modes + + # MAM rad_climate settings. The externally mixed quantities in the modal aerosol + # model are the modes. + push @aero_names, qw(mam7_mode1 mam7_mode2 mam7_mode3 mam7_mode4 mam7_mode5 mam7_mode6 mam7_mode7); + push @aerosources, qw(M: M: M: M: M: M: M:); + + # Each of the mode names put into the @aero_names array needs to be defined. + @mode_names = qw(mam7_mode1 mam7_mode2 mam7_mode3 mam7_mode4 mam7_mode5 mam7_mode6 mam7_mode7); + @mode_types = qw(accum aitken primary_carbon fine_seasalt fine_dust coarse_seasalt coarse_dust); + @mode_num = qw(num_a1 num_a2 num_a3 num_a4 num_a5 num_a6 num_a7); + @mode_num_cw = qw(num_c1 num_c2 num_c3 num_c4 num_c5 num_c6 num_c7); + + %modal_groups = ( 'accum' => [qw(so4 nh4 pom soa bc ncl)], + 'aitken' => [qw(so4 nh4 soa ncl)], + 'primary_carbon' => [qw(pom bc)], + 'fine_seasalt' => [qw(ncl so4 nh4)], + 'fine_dust' => [qw(dst so4 nh4)], + 'coarse_seasalt' => [qw(ncl so4 nh4)], + 'coarse_dust' => [qw(dst so4 nh4)] ); + + @mode_num_src = qw(A A A A A A A); + + } + + set_aero_modes_info( $cfg, @mode_num_src[0], $print, \@mode_types, \%modal_species, \%modal_groups, + \@mode_spec_type, \@mode_spec, \@mode_spec_cw, \@mode_spec_src); + + my $mode_defs = create_mode_defs(\@mode_names, \@mode_types, \@mode_num, \@mode_num_cw, \@mode_num_src, + \@mode_spec, \@mode_spec_type, \@mode_spec_cw, \@mode_spec_src); + + add_default($nl, 'mode_defs', 'val'=>$mode_defs); + + # Top level for MAM processes that impact CAM climate. + add_default($nl, 'clim_modal_aero_top_press'); + + # water refractive index properties needed for modal optics calculations + add_default($nl, 'water_refindex_file'); + +} else { + + # bulk aerosol contributions + + if ($rad_prog_sulf) { + push(@aero_names, "SO4" ); + push(@aerosources, "A:" ); + } elsif ($moz_aero_data =~ /$TRUE/io) { + push(@aero_names, "sulf"); + push(@aerosources, "N:" ); + } elsif ($cam3_aero_data =~ /$TRUE/io) { + push(@aero_names, "cam3_sul" ); + push(@aerosources, "N:" ); + } else { + die "ERROR: can not set sulf rad_climate specification\n"; + } + + if ($rad_prog_dust) { + push(@aero_names, "DST01", "DST02", "DST03", "DST04" ); + push(@aerosources, "A:", "A:", "A:", "A:" ); + } elsif ($moz_aero_data =~ /$TRUE/io) { + push(@aero_names, "dust1", "dust2", "dust3", "dust4"); + push(@aerosources, "N:", "N:", "N:", "N:" ); + } elsif ($cam3_aero_data =~ /$TRUE/io) { + push(@aero_names, "cam3_dust1", "cam3_dust2", "cam3_dust3", "cam3_dust4" ); + push(@aerosources, "N:", "N:", "N:", "N:" ); + } else { + die "ERROR: can not set dust rad_climate specification\n"; + } + + if ($rad_prog_bcarb) { + push(@aero_names, "CB1", "CB2" ); + push(@aerosources, "A:", "A:" ); + } elsif ($moz_aero_data =~ /$TRUE/io) { + push(@aero_names, "bcar1", "bcar2"); + push(@aerosources, "N:", "N:" ); + } elsif ($cam3_aero_data =~ /$TRUE/io) { + push(@aero_names, "cam3_bcpho", "cam3_bcphi"); + push(@aerosources, "N:", "N:" ); + } else { + die "ERROR: can not set black carbon rad_climate specification\n"; + } + + if ($rad_prog_ocarb) { + push(@aero_names, "OC1", "OC2" ); + push(@aerosources, "A:", "A:" ); + } elsif ($moz_aero_data =~ /$TRUE/io) { + push(@aero_names, "ocar1", "ocar2"); + push(@aerosources, "N:", "N:" ); + } elsif ($cam3_aero_data =~ /$TRUE/io) { + push(@aero_names, "cam3_ocpho", "cam3_ocphi"); + push(@aerosources, "N:", "N:" ); + } else { + die "ERROR: can not set organic carbon rad_climate specification\n"; + } + + if ($rad_prog_sslt) { + if ($rrtmg) { + push(@aero_names, "SSLT01", "SSLT02", "SSLT03", "SSLT04"); + push(@aerosources, "A:", "A:", "A:", "A:" ); + } else { + push(@aero_names, "SSLTA", "SSLTC"); + push(@aerosources, "N:", "N:"); + } + } elsif ($moz_aero_data =~ /$TRUE/io ) { + if ($rrtmg) { + push(@aero_names, "sslt1", "sslt2", "sslt3", "sslt4"); + push(@aerosources, "N:", "N:", "N:", "N:" ); + } else { + push(@aero_names, "SSLTA", "SSLTC"); + push(@aerosources, "N:", "N:"); + } + } elsif ($cam3_aero_data =~ /$TRUE/io ) { + push(@aero_names, "cam3_ssam", "cam3_sscm"); + push(@aerosources, "N:", "N:" ); + } else { + die "ERROR: can not set sslt rad_climate specification\n"; + } +} + +if ( $prescribed_aero_model ne 'none' ) { + # Prescribed aerosols -- bulk or modal + if ($moz_aero_data =~ /$TRUE/io ) { + # If user has not set prescribed_aero_file, then use defaults + unless (defined $nl->get_value('prescribed_aero_file')) { + my @settings = ('prescribed_aero_datapath', 'prescribed_aero_file', 'prescribed_aero_type', + 'prescribed_aero_cycle_yr'); + foreach my $setting (@settings) { + add_default($nl, $setting, 'aer_model'=>$aer_model); + } + } + } + + # Prescribed aerosol deposition fluxes. + # Not needed if in aquaplanet mode. + if ( (($moz_aero_data =~ /$TRUE/io) or ($cam3_aero_data =~ /$TRUE/io)) and !$aqua_mode ) { + # If user has not set aerodep_flx_file, then use defaults + unless (defined $nl->get_value('aerodep_flx_file')) { + my @settings = ('aerodep_flx_datapath', 'aerodep_flx_file', 'aerodep_flx_type', + 'aerodep_flx_cycle_yr'); + foreach my $setting (@settings) { + add_default($nl, $setting, 'aer_model'=>$aer_model); + } + } + } +} + +# Construct the aerosol part of the rad_climate string array by looping over +# the aerosol names and getting the default properties file for each: + +# For modal aerosols the mode definitions and emission tuning parameters are +# influenced by the value of modal_accum_coarse_exch. This value is set by certain +# waccm use_case files, but it is now also used by the cam6 physics package. So +# need to make sure a default is set. +if ($aer_model eq 'mam' ) { + add_default($nl, 'modal_accum_coarse_exch'); +} + +foreach my $name (@aero_names) { + my $source = shift(@aerosources); + my $file; + if ($source =~ 'M') { + $file = "${name}_file"; + } + else { + $file = "${aer_model}_$name"; + } + my $defversion = ''; # mode definition version + if ($nl->get_value('modal_accum_coarse_exch') =~ /$TRUE/io) { + $defversion = 'strat'; + } + my $rel_filepath = get_default_value($file, {'ver'=>$defversion} ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string($source . $name . ":" . $abs_filepath); +} + +# Eruptive volcanic aerosols can be run with either BAM or MAM. +if ($rad_volcaero) { + my $rel_filepath = get_default_value("VOLC_MMR"); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string("N:VOLC_MMR:" . $abs_filepath); +} + +# CARMA RRTMG and CAMRT +# +# Stratospheric black carbon +if ($carma eq 'bc_strat') { + my $rel_filepath; + if ($aer_model eq 'bam') { + $rel_filepath = get_default_value("${aer_model}_bcar1"); + } else { + $rel_filepath = get_default_value("${aer_model}_bc_a1"); + } + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + my @val = ('SOOT01'); + foreach my $val (@val) { + $radval .= "," . quote_string("A:" . $val . ":" . $abs_filepath); + } +} + +if ($rrtmg) { + + # CARMA Microphysics - RRTMG Only + # + # New CARMA models that have radiatively active tracers need to define the name of + # each of the radiatively active constituents. + + if ($carma eq 'meteor_impact') { + my @val = ('CRDUST01', 'CRDUST02', 'CRDUST03', 'CRDUST04', 'CRDUST05', 'CRDUST06', 'CRDUST07', + 'CRDUST08', 'CRDUST09', 'CRDUST10', 'CRDUST11', 'CRDUST12', 'CRDUST13', 'CRDUST14', + 'CRDUST15', 'CRDUST16', 'CRDUST17', 'CRDUST18', 'CRDUST19', 'CRDUST20', 'CRDUST21'); + + foreach my $val (@val) { + $radval .= "," . quote_string("A:" . $val . ":" . $carma . "_" . $val . "_rrtmg.nc"); + } + + my @val = ('CRSOOT01', 'CRSOOT02', 'CRSOOT03', 'CRSOOT04', 'CRSOOT05', 'CRSOOT06', 'CRSOOT07', + 'CRSOOT08', 'CRSOOT09', 'CRSOOT10', 'CRSOOT11', 'CRSOOT12', 'CRSOOT13', 'CRSOOT14', + 'CRSOOT15', 'CRSOOT16', 'CRSOOT17', 'CRSOOT18', 'CRSOOT19', 'CRSOOT20', 'CRSOOT21'); + + foreach my $val (@val) { + $radval .= "," . quote_string("A:" . $val . ":" . $carma . "_" . $val . "_rrtmg.nc"); + } + } + + if ($carma eq 'test_radiative') { + my @val = ('DUST01', 'DUST02', 'DUST03', 'DUST04', 'DUST05', 'DUST06', 'DUST07', 'DUST08', + 'DUST09', 'DUST10', 'DUST11', 'DUST12', 'DUST13', 'DUST14', 'DUST15', 'DUST16'); + + foreach my $val (@val) { + $radval .= "," . quote_string("A:" . $val . ":" . $carma . "_" . $val . "_rrtmg.nc"); + } + } +} +# CARMA microphysics +# +# Each CARMA model may require a different set of default +# namelist values to enable the processes that correspond +# to the desired microphysics. +if ($carma ne 'none') { + add_default($nl, 'carma_model', 'val'=>$carma); + add_default($nl, 'carma_flag', 'val'=>'.true.'); + add_default($nl, 'history_carma', 'val'=>'.true.'); +} +if ($carma eq 'bc_strat') { + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.false.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); +} +if ($carma eq 'cirrus') { + add_default($nl, 'carma_do_cldice', 'val'=>'.true.'); + add_default($nl, 'carma_do_aerosol', 'val'=>'.false.'); + add_default($nl, 'carma_do_cldliq', 'val'=>'.false.'); + add_default($nl, 'carma_do_clearsky', 'val'=>'.false.'); + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_detrain', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_incloud', 'val'=>'.true.'); + add_default($nl, 'carma_do_pheat', 'val'=>'.false.'); + add_default($nl, 'carma_do_optics', 'val'=>'.false.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_conmax', 'val'=>'0.25'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'1'); + add_default($nl, 'carma_dt_threshold','val'=>'2.'); + add_default($nl, 'carma_gsticki', 'val'=>'0.5'); + add_default($nl, 'carma_rhcrit', 'val'=>'0.7'); + add_default($nl, 'wv_sat_scheme', 'val'=>'MurphyKoop'); + add_default($nl, 'macro_park_do_cldice', 'val'=>'.false.'); + add_default($nl, 'macro_park_do_cldliq', 'val'=>'.true.'); + add_default($nl, 'macro_park_do_detrain', 'val'=>'.false.'); + add_default($nl, 'micro_mg_do_cldice','val'=>'.false.'); + add_default($nl, 'micro_mg_do_cldliq','val'=>'.true.'); + add_default($nl, 'spectralflux', 'val'=>'.false.'); +} +if ($carma eq 'cirrus_dust') { + add_default($nl, 'carma_do_cldice', 'val'=>'.true.'); + add_default($nl, 'carma_do_aerosol', 'val'=>'.false.'); + add_default($nl, 'carma_do_cldliq', 'val'=>'.false.'); + add_default($nl, 'carma_do_clearsky', 'val'=>'.false.'); + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_detrain', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.false.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_incloud', 'val'=>'.true.'); + add_default($nl, 'carma_do_pheat', 'val'=>'.false.'); + add_default($nl, 'carma_do_optics', 'val'=>'.false.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_conmax', 'val'=>'0.25'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'1'); + add_default($nl, 'carma_dt_threshold','val'=>'2.'); + add_default($nl, 'carma_gsticki', 'val'=>'0.5'); + add_default($nl, 'carma_rhcrit', 'val'=>'0.7'); + add_default($nl, 'wv_sat_scheme', 'val'=>'MurphyKoop'); + add_default($nl, 'macro_park_do_cldice', 'val'=>'.false.'); + add_default($nl, 'macro_park_do_cldliq', 'val'=>'.true.'); + add_default($nl, 'macro_park_do_detrain', 'val'=>'.false.'); + add_default($nl, 'micro_mg_do_cldice','val'=>'.false.'); + add_default($nl, 'micro_mg_do_cldliq','val'=>'.true.'); + add_default($nl, 'spectralflux', 'val'=>'.false.'); + add_default($nl, 'carma_soilerosion_file'); + add_default($nl, 'carma_fields', 'val'=>'Sl_soilw'); +} +elsif ($carma eq 'dust') { + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_optics', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_soilerosion_file'); + add_default($nl, 'carma_fields', 'val'=>'Sl_soilw'); +} +elsif ($carma eq 'meteor_impact') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit', 'val'=>'.true.'); + add_default($nl, 'carma_do_optics', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_emis_dust', 'val'=>'0.0'); + add_default($nl, 'carma_emis_soot', 'val'=>'2.8e10'); + add_default($nl, 'carma_emis_startdate', 'val'=>'1'); + add_default($nl, 'carma_emis_starttime', 'val'=>'43200'); + add_default($nl, 'carma_emis_stopdate', 'val'=>'2'); + add_default($nl, 'carma_emis_stoptime', 'val'=>'43200'); + add_default($nl, 'carma_emis_minlat', 'val'=>'-5.85'); + add_default($nl, 'carma_emis_maxlat', 'val'=>'-0.15'); + add_default($nl, 'carma_emis_minlon', 'val'=>'-58.75'); + add_default($nl, 'carma_emis_maxlon', 'val'=>'-51.25'); + add_default($nl, 'carma_fractal_soot', 'val'=>'.false.'); + add_default($nl, 'irad_always', 'val'=>'-48'); +} +elsif ($carma eq 'meteor_smoke') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_emis_total', 'val'=>'16.0'); + add_default($nl, 'carma_emis_file'); + add_default($nl, 'carma_do_escale', 'val'=>'.false.'); + add_default($nl, 'carma_escale_file'); +} +elsif ($carma eq 'mixed_sulfate') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_partialinit','val'=>'.true.'); + add_default($nl, 'carma_do_pheat', 'val'=>'.false.'); + add_default($nl, 'carma_do_pheatatm', 'val'=>'.false.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'1'); + add_default($nl, 'carma_neutral_h2so4','val'=>'.true.'); + add_default($nl, 'carma_emis_total', 'val'=>'16.0'); + add_default($nl, 'carma_emis_file'); + add_default($nl, 'carma_do_escale', 'val'=>'.false.'); + add_default($nl, 'carma_escale_file'); + add_default($nl, 'spectralflux', 'val'=>'.false.'); + add_default($nl, 'carma_dt_threshold','val'=>'5.'); +} +elsif ($carma eq 'pmc') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_pheat', 'val'=>'.false.'); + add_default($nl, 'carma_do_pheatatm', 'val'=>'.false.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_maxretries', 'val'=>'12'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'1'); + add_default($nl, 'carma_emis_total', 'val'=>'16.0'); + add_default($nl, 'carma_emis_file'); + add_default($nl, 'carma_do_escale', 'val'=>'.false.'); + add_default($nl, 'carma_escale_file'); + add_default($nl, 'carma_mice_file'); + add_default($nl, 'spectralflux', 'val'=>'.false.'); + add_default($nl, 'carma_dt_threshold','val'=>'5.'); +} +elsif ($carma eq 'pmc_sulfate') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_partialinit','val'=>'.true.'); + add_default($nl, 'carma_do_pheat', 'val'=>'.false.'); + add_default($nl, 'carma_do_pheatatm', 'val'=>'.false.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'1'); + add_default($nl, 'carma_neutral_h2so4','val'=>'.true.'); + add_default($nl, 'carma_emis_total', 'val'=>'16.0'); + add_default($nl, 'carma_emis_file'); + add_default($nl, 'carma_do_escale', 'val'=>'.false.'); + add_default($nl, 'carma_escale_file'); + add_default($nl, 'carma_mice_file'); + add_default($nl, 'spectralflux', 'val'=>'.false.'); + add_default($nl, 'carma_dt_threshold','val'=>'5.'); +} +elsif ($carma eq 'sea_salt') { + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_do_WeibullK', 'val'=>'.false.'); + add_default($nl, 'carma_seasalt_emis', 'val'=>'Gong'); +} +elsif ($carma eq 'sulfate') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_hetchem_feedback','val'=>'.true.'); + add_default($nl, 'carma_rad_feedback','val'=>'.true.'); + add_default($nl, 'carma_do_partialinit','val'=>'.true.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'2'); + add_default($nl, 'carma_dt_threshold','val'=>'2.'); +} +elsif ($carma eq 'test_detrain') { + add_default($nl, 'carma_do_detrain', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); +} +elsif ($carma eq 'test_growth') { + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_maxretries', 'val'=>'12'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'4'); +} +elsif ($carma eq 'test_passive') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); +} +elsif ($carma eq 'test_radiative') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_optics', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); +} +elsif ($carma eq 'test_swelling') { + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); +} +elsif ($carma eq 'test_tracers') { + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_launch_doy', 'val'=>'1'); + add_default($nl, 'carma_emission_rate','val'=>'-1e-12'); +} +elsif ($carma eq 'test_tracers2') { + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_launch_doy', 'val'=>'1'); + add_default($nl, 'carma_emission_rate','val'=>'-1e-12'); +} +elsif ($carma eq 'tholin') { + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'carma_do_fixedinit','val'=>'.true.'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.true.'); + add_default($nl, 'carma_emis_total', 'val'=>'1e5'); + add_default($nl, 'carma_emis_file'); +} + +# Stratospheric sulfur aerosols + +# turn on stratospheric aerosol forcings in CAM6 configurations +my $chem_has_ocs = chem_has_species($cfg, 'OCS'); +if ($phys =~ /cam6/) { + # turn on volc forcings in cam6 -- prognostic or prescribed + if ( $chem_has_ocs ) { + # turn on prognostic stratospheric aerosols + add_default($nl, 'modal_strat_sulfate','val'=>'.true.'); + } else { + # turn on prescribed stratospheric aerosols + add_default($nl, 'prescribed_strataero_feedback','val'=>'.true.'); + add_default($nl, 'prescribed_strataero_3modes','val'=>'.true.'); + } +} +if ( $nl->get_value('modal_strat_sulfate')=~ /$TRUE/io and + $nl->get_value('prescribed_strataero_feedback') =~ /$TRUE/io ) { + die "Cannot set both modal_strat_sulfate and prescribed_strataero_feedback to TRUE \n"; +} + +# stratospheric aerosols are needed for heterogeneous chemistry as well as radiation feedback +my $het_chem = chem_has_species($cfg, 'N2O5'); + +# Default for CAM6, is that prescribed_strataero_3modes is TRUE, but allow user to override +my $prescribed_strataero_3modes = $FALSE; +if ($phys =~ /cam6/) { + $prescribed_strataero_3modes = $TRUE; +} +if (defined $nl->get_value('prescribed_strataero_3modes')) { + $prescribed_strataero_3modes = $nl->get_value('prescribed_strataero_3modes'); +} + +# determine if prescribed stratospheric aerosol data is needed +if ( ($het_chem) || ($nl->get_value('prescribed_strataero_feedback') =~ /$TRUE/io ) ){ + if ( ($carma ne 'sulfate') && !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols + + unless (defined $nl->get_value('prescribed_strataero_type')) { + add_default($nl, 'prescribed_strataero_type','val'=>'CYCLICAL'); + my %valhash = ('val'=>'2000'); + if ($prescribed_strataero_3modes =~ /$TRUE/io) {%valhash = ('val'=>'1990')} + add_default($nl, 'prescribed_strataero_cycle_yr', %valhash ); + } + unless (defined $nl->get_value('prescribed_strataero_file')) { + my %verhash ; + if ($prescribed_strataero_3modes =~ /$TRUE/io) {%verhash = ('ver'=>'3modes')} + add_default($nl, 'prescribed_strataero_file', %verhash ); + add_default($nl, 'prescribed_strataero_datapath', %verhash ); + } + } +} +# add to rad_climate the contributions from stratospheric aerosols if feedback is switched on +if (($nl->get_value('prescribed_strataero_feedback') =~ /$TRUE/io) + || ($nl->get_value('carma_rad_feedback') =~ /$TRUE/io)) { + if ($prescribed_strataero_3modes =~ /$TRUE/io) { + my $rel_filepath = get_default_value("VOLC_MMR1"); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string("N:VOLC_MMR1:" . $abs_filepath); + + $rel_filepath = get_default_value("VOLC_MMR2"); + $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string("N:VOLC_MMR2:" . $abs_filepath); + + $rel_filepath = get_default_value("VOLC_MMR3"); + $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string("N:VOLC_MMR3:" . $abs_filepath); + } else { + my $rel_filepath = get_default_value("VOLC_MMR"); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $radval .= "," . quote_string("N:VOLC_MMR:" . $abs_filepath); + } +} +# check for inadvertent setting of both old and new prescribed volcanoes +my $strataero_file = $nl->get_value('prescribed_strataero_file'); +$strataero_file =~ s/\s//g; # strip white space +$strataero_file =~ s/['"]//g; # strip quotes "' +if ( (defined $nl->get_value('prescribed_volcaero_file')) and + (defined $nl->get_value('prescribed_strataero_file')) ) { + if ($volcaero_file ne 'NONE' and $strataero_file ne 'NONE') { + die "Cannot set both prescribed_volcaero_file and prescribed_strataero_file \n"; + } +} +if (defined $nl->get_value('prescribed_strataero_file')) { + if ($strataero_file ne 'NONE') { + add_default($nl, 'prescribed_strataero_use_chemtrop'); + } +} + +if ($rad_pkg ne 'none') { + add_default($nl, 'rad_climate', 'val'=>$radval); +} + +# Cloud optics +if ($rrtmg) { + add_default($nl, 'liqcldoptics'); + add_default($nl, 'icecldoptics'); + add_default($nl, 'liqopticsfile'); + add_default($nl, 'iceopticsfile'); +} + +# Volcanic Aerosol Mass climatology dataset +if ($nl->get_value('strat_volcanic')) { add_default($nl, 'bndtvvolc'); } + +# Greenhouse gas production/loss rates +if ($ghg_chem) { + add_default($nl, 'bndtvg'); + add_default($nl, 'ghg_chem', 'val'=>".true."); +} + +# WACCM-SC options (specified chemical heating) +if ($chem =~ /waccm_sc/) { + # *** Note *** this dataset only needed for waccm_sc. + # O2,O1,N2, CO2 Constituents for non-LTE calculations and heating rates below 200 nm + unless (defined $nl->get_value('waccm_forcing_file')) { + add_default($nl, 'waccm_forcing_datapath'); + add_default($nl, 'waccm_forcing_file'); + } + add_default($nl, 'nlte_use_mo', 'val'=>".false."); + add_default($nl, 'h2orates'); + add_default($nl, 'solar_parms_data_file'); +} + +if ( $prog_species ) { + my $ddval; + my $emisval; + my $xfrcval; + my $emisfirst = 1; my $emispre = ""; + my $xfrcfirst = 1; my $xfrcpre = ""; + if ( $prog_species =~ /SO4/ ) { + my %emis = ('DMS -> ' => 'dms_emis_bam', + 'SO2 -> ' => 'so2_emis_bam', + 'SO4 -> ' => 'so4_emis_bam', ); + foreach my $id (sort keys %emis) { + my $rel_filepath = get_default_value($emis{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $emisval .= $emispre . quote_string($id . $abs_filepath); + if ($emisfirst) { $emispre = ","; $emisfirst = 0; } + } + my %xfrc = ('SO2 -> ' => 'so2_vrt_emis_file', + 'SO4 -> ' => 'so4_vrt_emis_file', ); + foreach my $id (sort keys %xfrc) { + my $rel_filepath = get_default_value($xfrc{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $xfrcval .= $xfrcpre . quote_string($id . $abs_filepath); + if ($xfrcfirst) { $xfrcpre = ","; $xfrcfirst = 0; } + } + # Prescribed oxidants + my $val = "'O3','OH','NO3','HO2'"; + add_default($nl, 'tracer_cnst_specifier', 'val'=>$val); + my @files = ( 'tracer_cnst_datapath','tracer_cnst_file'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ox'); + } + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox'); + } + # Datasets + my @files = ( 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file', 'exo_coldens_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } + } + + if ( $prog_species =~ /OC/ ) { + my %emis = ('OC1 -> ' => 'oc1_emis_bam', ); + foreach my $id (sort keys %emis) { + my $rel_filepath = get_default_value($emis{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $emisval .= $emispre . quote_string($id . $abs_filepath); + if ($emisfirst) { $emispre = ","; $emisfirst = 0; } + } + } + if ( $prog_species =~ /BC/ ) { + my %emis = ('CB1 -> ' => 'cb1_emis_bam', ); + foreach my $id (sort keys %emis) { + my $rel_filepath = get_default_value($emis{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $emisval .= $emispre . quote_string($id . $abs_filepath); + if ($emisfirst) { $emispre = ","; $emisfirst = 0; } + } + } + if ( $prog_species =~ /GHG/ ) { + add_default($nl, 'ghg_chem', 'val'=>".true."); + add_default($nl, 'bndtvg'); + } + if ( $prog_species =~ /DST/ ) { + add_default($nl, 'soil_erod_file' ); + } + + if ( $emisval ) { + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_specifier', 'val'=>$emisval); + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + } + } + if ( $xfrcval ) { + add_default($nl, 'ext_frc_specifier', 'val'=>$xfrcval); + add_default($nl, 'ext_frc_type', 'val'=>'CYCLICAL'); + } +} + +# if prescribed aerosol deposition fluxes then set aerodep_flx_specifier +# depending on prescribed_aero_model -- bulk type is the default +if (defined $nl->get_value('aerodep_flx_file')) { + unless (defined $nl->get_value('aerodep_flx_specifier')) { + my $val; + if ( $prescribed_aero_model eq 'modal' ) { + $val = "'bc_a1DDF','bc_c1DDF','pom_a1DDF','pom_c1DDF','soa_a1DDF','soa_c1DDF'," + . "'soa_a2DDF','soa_c2DDF','dst_a1DDF','dst_c1DDF','dst_a3DDF','dst_c3DDF'," + . "'bc_a1SFWET','bc_c1SFWET','pom_a1SFWET','pom_c1SFWET','soa_a1SFWET','soa_c1SFWET'," + . "'dst_a1SFWET','dst_c1SFWET','dst_a3SFWET','dst_c3SFWET'"; + } else { + $val = "'BCDEPWET','BCPHODRY','BCPHIDRY','OCDEPWET','OCPHODRY', 'OCPHIDRY'," + . "'DSTX01DD','DSTX02DD','DSTX03DD','DSTX04DD'," + . "'DSTX01WD','DSTX02WD','DSTX03WD','DSTX04WD'"; + } + add_default($nl, 'aerodep_flx_specifier', 'val'=>$val); + } +} +# if prescribed aerosol concentrations then set prescribed_aero_specifier +# depending on prescribed_aero_model -- bulk type is the default +if (defined $nl->get_value('prescribed_aero_file')) { + unless (defined $nl->get_value('prescribed_aero_specifier')) { + my $val; + if ( $prescribed_aero_model eq 'modal' ) { + #*_a1, *_a2 and *_a3 are now computed using *_logm and *logv, therefore they are removed + $val ="'num_c1','bc_c1', 'dst_c1','ncl_c1'," + . "'pom_c1','so4_c1','soa_c1','num_c2'," + . "'ncl_c2','so4_c2','soa_c2','num_c3'," + . "'dst_c3','ncl_c3','so4_c3'," + #Adding log mean quantities (only for interstitial aerosols) + . "'num_a1_logm','bc_a1_logm', 'dst_a1_logm','ncl_a1_logm'," + . "'pom_a1_logm','so4_a1_logm','soa_a1_logm','num_a2_logm'," + . "'ncl_a2_logm','so4_a2_logm','soa_a2_logm','num_a3_logm'," + . "'dst_a3_logm','ncl_a3_logm','so4_a3_logm'," + #Adding log variance quantities (only for interstitial aerosols) + . "'num_a1_logv','bc_a1_logv', 'dst_a1_logv','ncl_a1_logv'," + . "'pom_a1_logv','so4_a1_logv','soa_a1_logv','num_a2_logv'," + . "'ncl_a2_logv','so4_a2_logv','soa_a2_logv','num_a3_logv'," + . "'dst_a3_logv','ncl_a3_logv','so4_a3_logv'"; + } else { + $val = "'sulf:SO4','bcar1:CB1','bcar2:CB2','ocar1:OC1','ocar2:OC2'," + . "'sslt1:SSLT01','sslt2:SSLT02','sslt3:SSLT03','sslt4:SSLT04'," + . "'dust1:DST01','dust2:DST02','dust3:DST03','dust4:DST04'"; + } + add_default($nl, 'prescribed_aero_specifier', 'val'=>$val); + } +} + +my $megan_emis = defined $nl->get_value('megan_specifier'); +if ( $megan_emis ) { add_default($nl, 'megan_factors_file'); } + +# Tropospheric full chemistry options +if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { + + # Surface emission datasets: + my %verhash; + my $val; + my %species = ('CH3COCH3 -> ' => 'acetone_emis_file', + 'BIGALK -> ' => 'bigalk_emis_file', + 'BIGENE -> ' => 'bigene_emis_file', + 'C2H4 -> ' => 'c2h4_emis_file', + 'C2H5OH -> ' => 'c2h5oh_emis_file', + 'C2H6 -> ' => 'c2h6_emis_file', + 'C3H6 -> ' => 'c3h6_emis_file', + 'C3H8 -> ' => 'c3h8_emis_file', + 'CH2O -> ' => 'ch2o_emis_file', + 'CH3CHO -> ' => 'ch3cho_emis_file', + 'CH3OH -> ' => 'ch3oh_emis_file', + 'CO -> ' => 'co_emis_file', + 'DMS -> ' => 'dms_emis_file', + 'MEK -> ' => 'mek_emis_file', + 'NO -> ' => 'nox_emis_file', + 'SO2 -> ' => 'so2_emis_file', + 'HCN -> ' => 'hcn_emis_file', + 'HCOOH -> ' => 'hcooh_emis_file', + 'CH3CN -> ' => 'ch3cn_emis_file', + 'C2H2 -> ' => 'c2h2_emis_file', + 'CH3COOH -> ' => 'ch3cooh_emis_file', + 'ISOP -> ' => 'isop_emis_file', + 'TOLUENE -> ' => 'toluene_emis_file', + ); + if (!($chem =~ /_vbs/) and !($chem =~ /_tsmlt/)) { + %species = (%species, + 'NH3 -> ' => 'nh3_emis_file'); + } + if (!($chem =~ /_vbs/) and !($chem =~ /_tsmlt/)) { + %species = (%species, + 'C10H16 -> ' => 'c10h16_emis_file', ); + } + if ($chem =~ /mam3/) { + %species = (%species, + 'SOAG -> ' => 'soag_emis_file', + 'bc_a1 -> ' => 'bc_a1_emis_file', + 'pom_a1 -> ' => 'pom_a1_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + ); + %verhash = ('ver'=>'mam'); + } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /mam4_vbs/) { + %species = (%species, + 'BENZENE -> ' => 'soa_benzene_emis_file', + 'XYLENES -> ' => 'soa_xylene_emis_file', + 'TOLUENE -> ' => 'soa_toluene_emis_file', + 'IVOC -> ' => 'ivocbb_emis_file', + 'bc_a4 -> ' => 'bc_a4_emis_file', + 'pom_a4 -> ' => 'pom_a4_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'mam4_num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + 'num_a4 -> ' => 'mam4_num_a4_emis_file', + ); + } elsif ($chem =~ /mam4/) { + %species = (%species, + 'SOAG -> ' => 'soag_emis_file', + 'bc_a4 -> ' => 'bc_a4_emis_file', + 'pom_a4 -> ' => 'pom_a4_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'mam4_num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + 'num_a4 -> ' => 'mam4_num_a4_emis_file', + ); + } elsif ($chem =~ /mam7/) { + %species = (%species, + 'SOAG -> ' => 'soag_emis_file', + 'bc_a3 -> ' => 'bc_a3_emis_file', + 'num_a1 -> ' => 'mam7_num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + 'num_a3 -> ' => 'mam7_num_a3_emis_file', + 'pom_a3 -> ' => 'pom_a3_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + ); + %verhash = ('ver'=>'mam'); + } else { + %species = (%species, + 'CB1 -> ' => 'cb1_emis_file', + 'CB2 -> ' => 'cb2_emis_file', + 'OC1 -> ' => 'oc1_emis_file', + 'OC2 -> ' => 'oc2_emis_file', + ); + } + + my $first = 1; my $pre = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id},\%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr','val'=>'2000'); + } + + # aircraft emission datasets: + %species = (); + my $cyc_yr = '1999'; + if ($chem =~ /mam3/) { + %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', + 'SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a1 -> ' => 'pom_a1_ext_file', + 'bc_a1 -> ' => 'bc_a1_ext_file', + 'num_a1 -> ' => 'num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', ); + $cyc_yr = '2000'; + } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /mam4_vbs/) { + %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', + 'SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a4 -> ' => 'pom_a4_ext_file', + 'bc_a4 -> ' => 'bc_a4_ext_file', + 'num_a1 -> ' => 'mam4_num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', + 'num_a4 -> ' => 'mam4_num_a4_ext_file', + 'SVOC -> ' => 'svocbb_ext_file' ); + $cyc_yr = '2000'; + } elsif ($chem =~ /mam4/) { + %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', + 'SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a4 -> ' => 'pom_a4_ext_file', + 'bc_a4 -> ' => 'bc_a4_ext_file', + 'num_a1 -> ' => 'mam4_num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', + 'num_a4 -> ' => 'mam4_num_a4_ext_file' ); + $cyc_yr = '2000'; + } elsif ($chem =~ /mam7/) { + %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a3 -> ' => 'pom_a3_ext_file', + 'bc_a3 -> ' => 'bc_a3_ext_file', + 'num_a1 -> ' => 'mam7_num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', + 'num_a3 -> ' => 'mam7_num_a3_ext_file', ); + $cyc_yr = '2000'; + } else { + %species = ( 'CO -> ' => 'co_aircraft_emis', + 'NO -> ' => 'no_aircraft_emis', + 'SO2 -> ' => 'so2_aircraft_emis', ); + } + + $first = 1; + $pre = ""; + $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id},\%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>$cyc_yr); + } +} + +if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { + + my $val; + + if ($chem =~ /trop_mozart/) { + # Species with fixed stratosphere values + $val = "'O3','NO','NO2','HNO3','CO','CH4','N2O','N2O5'"; + add_default($nl, 'fstrat_list', 'val'=>$val); + add_default($nl, 'fstrat_file'); + } + + # Species with fixed lower boundary + if ($chem =~ /_tsmlt_mam/ or $chem =~ /trop_strat/) { + $val = "'CCL4','CF2CLBR','CF3BR','CFC11','CFC113','CFC12','CH3BR','CH3CCL3','CH3CL','CH4','CO2'" + .",'H2','HCFC22','N2O','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; + } else { + $val = "'CH4','H2','N2O','CO2','CFC11','CFC12'"; + } + if ($chem_has_ocs) { + $val .= ",'OCS'"; + } + if (chem_has_species($cfg, 'SF6')) { + $val .= ",'SF6'"; + } + add_default($nl, 'flbc_list', 'val'=>$val); + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); + } + + my @files; + # Datasets + if ($chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { + @files = ( 'soil_erod_file', 'flbc_file', + 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file' ); + } else { + @files = ( 'soil_erod_file', 'flbc_file', + 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file', 'exo_coldens_file', 'sulf_file' ); + } + foreach my $file (@files) { + add_default($nl, $file); + } +} + +# Prognostic aerosols via CAM-Chem package. +# BAM settings +if ($chem eq 'trop_bam') { + + my %species; + + # Surface emission datasets: + %species = (); + %species = ('CB1 -> ' => 'cb1_emis_bam', + 'DMS -> ' => 'dms_emis_bam', + 'OC1 -> ' => 'oc1_emis_bam', + 'SO2 -> ' => 'so2_emis_bam', + 'SO4 -> ' => 'so4_emis_bam', ); + my $first = 1; + my $pre = ""; + my $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + + # Surface emission datasets: + %species = (); + %species = ('SO2 -> ' => 'so2_vrt_emis_file', + 'SO4 -> ' => 'so4_vrt_emis_file', ); + $first = 1; + $pre = ""; + $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + add_default($nl, 'ext_frc_type', 'val'=>'CYCLICAL'); + + # Prescribed species + add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2'"); + + my @files = ('tracer_cnst_datapath', 'tracer_cnst_file'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ox'); + } + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox'); + } + + add_default($nl, 'fstrat_list', 'val'=>"' '"); + add_default($nl, 'flbc_list', 'val'=>"' '"); + + # Datasets + my @files = ( 'soil_erod_file','xs_coef_file','xs_short_file','xs_long_file', 'rsf_file', 'exo_coldens_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } +} + +if ($chem eq 'super_fast_llnl') { + # Surface emission datasets: + my $val; + my %species; + %species = ( + 'CH2O -> ' => 'ch2o_emis_file', + 'CO -> ' => 'co_emis_file', + 'DMS -> ' => 'dms_emis_file', + 'NO -> ' => 'nox_emis_file', + 'SO2 -> ' => 'so2_emis_file', + ); + if (! $megan_emis ) { + %species = ( %species, + 'ISOP -> ' => 'isop_emis_file', ); + } + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_cycle_yr', 'val'=>'1997'); + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + } + my $first = 1; my $pre = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + + # vertical emissions... + %species = (); + %species = ('SO2 -> ' => 'so2_vrt_emis_file', + 'SO4 -> ' => 'so4_vrt_emis_file' ); + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + + if ($ipcc_aircraft_emis) { + %species = ('SO2 -> ' => 'so2_vrt_emis_file', + 'SO4 -> ' => 'so4_vrt_emis_file', + 'NO2 -> ' => 'no2_aircraft_emis_file' ); + } + + $first = 1; $pre = ""; $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + + # Species with fixed stratosphere values + $val = "'NO','NO2','HNO3','CO'"; + add_default($nl, 'fstrat_list', 'val'=>$val); + + # Datasets + my @files = ('airpl_emis_file', 'soil_erod_file', 'flbc_file', 'fstrat_file', + 'sulf_file', 'tuv_xsect_file', 'o2_xsect_file', 'xs_long_file', 'rsf_file', + 'exo_coldens_file', 'linoz_data_path', 'linoz_data_file', 'chlorine_loading_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'1990'); + } + unless (defined $nl->get_value('chlorine_loading_type')) { + add_default($nl, 'chlorine_loading_type', 'val'=>'FIXED'); + add_default($nl, 'chlorine_loading_fixed_ymd','val'=>'19900101'); + } + + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + # Prescribed methane + my $val = "'CH4'"; + add_default($nl, 'tracer_cnst_specifier', 'val'=>$val); + my @files = ( 'tracer_cnst_datapath','tracer_cnst_file', 'tracer_cnst_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ch4'); + } + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ch4'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ch4'); + } + + my $val = "'prsd_ch4:CH4'"; + add_default($nl, 'prescribed_ghg_specifier', 'val'=>$val); + my @files = ( 'prescribed_ghg_datapath','prescribed_ghg_file', 'prescribed_ghg_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ch4'); + } + unless (defined $nl->get_value('prescribed_ghg_type')) { + add_default($nl, 'prescribed_ghg_type', 'ver'=>'fixed_ch4'); + add_default($nl, 'prescribed_ghg_cycle_yr','ver'=>'fixed_ch4'); + } +} + +# MAM settings + +if ($chem eq 'super_fast_llnl_mam3') { + + # Surface emission datasets: + my $val; + my %species; + my %verhash = ('ver'=>'mam'); + %species = ( + 'CH2O -> ' => 'ch2o_emis_file', + 'CO -> ' => 'co_emis_file', + 'DMS -> ' => 'dms_emis_file', + 'NO -> ' => 'nox_emis_file', + 'SO2 -> ' => 'so2_emis_file', + 'SOAG -> ' => 'soag_emis_file', + 'bc_a1 -> ' => 'bc_a1_emis_file', + 'pom_a1 -> ' => 'pom_a1_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + ); + if (! $megan_emis ) { + %species = ( %species, + 'ISOP -> ' => 'isop_emis_file', ); + } + + my $first = 1; my $pre = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + } + + # vertical emissions... + %species = (); + %species = ('SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a1 -> ' => 'pom_a1_ext_file', + 'bc_a1 -> ' => 'bc_a1_ext_file', + 'num_a1 -> ' => 'num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', ); + + $first = 1; $pre = ""; $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } + + # Species with fixed stratosphere values + $val = "'NO','NO2','HNO3','CO'"; + add_default($nl, 'fstrat_list', 'val'=>$val); + + # Datasets + my @files = ('airpl_emis_file', 'soil_erod_file', 'flbc_file', 'fstrat_file', + 'sulf_file', 'tuv_xsect_file', 'o2_xsect_file', 'xs_long_file', 'rsf_file', + 'exo_coldens_file', + 'linoz_data_path' , 'linoz_data_file', 'chlorine_loading_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); + } + unless (defined $nl->get_value('linoz_data_type')) { + add_default($nl, 'linoz_data_type', 'val'=>'CYCLICAL'); + add_default($nl, 'linoz_data_cycle_yr', 'val'=>'0'); + } + unless (defined $nl->get_value('chlorine_loading_type')) { + add_default($nl, 'chlorine_loading_type', 'val'=>'FIXED'); + add_default($nl, 'chlorine_loading_fixed_ymd', 'val'=>'20000101'); + } + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + # Prescribed methane + my $val = "'CH4'"; + add_default($nl, 'tracer_cnst_specifier', 'val'=>$val); + my @files = ( 'tracer_cnst_datapath','tracer_cnst_file', 'tracer_cnst_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ch4'); + } + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ch4'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ch4'); + } + + my $val = "'prsd_ch4:CH4'"; + add_default($nl, 'prescribed_ghg_specifier', 'val'=>$val); + my @files = ( 'prescribed_ghg_datapath','prescribed_ghg_file', 'prescribed_ghg_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ch4'); + } + unless (defined $nl->get_value('prescribed_ghg_type')) { + add_default($nl, 'prescribed_ghg_type', 'ver'=>'fixed_ch4'); + add_default($nl, 'prescribed_ghg_cycle_yr','ver'=>'fixed_ch4'); + } +} + +if ($chem eq 'trop_mam3') { + + my %species; + + # Surface emission datasets: + %species = (); + %species = ('DMS -> ' => 'dms_emis_file', + 'SO2 -> ' => 'so2_emis_file', + 'SOAG -> ' => 'soag_emis_file', + 'bc_a1 -> ' => 'bc_a1_emis_file', + 'pom_a1 -> ' => 'pom_a1_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + ); + my %verhash = ('ver'=>'mam'); + my $first = 1; + my $pre = ""; + my $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + } + + # Vertical emission datasets: + %species = (); + if (defined $nl->get_value('fire_emis_specifier')){ # without prescribed forest fire and grass fire sources + %species = ('SO2 -> ' => 'so2_ext_wofire_file', + 'so4_a1 -> ' => 'so4_a1_ext_wofire_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', # background volc emissions + 'num_a1 -> ' => 'num_a1_ext_wofire_file', + 'num_a2 -> ' => 'num_a2_ext_file', ); # background volc emissions + } else { # default prescribed sources + %species = ('SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', # background volc emissions + 'pom_a1 -> ' => 'pom_a1_ext_file', # only forest fire and grass fire emissions + 'bc_a1 -> ' => 'bc_a1_ext_file', # only forest fire and grass fire emissions + 'num_a1 -> ' => 'num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', ); # background volc emissions + } + # for mechanisms without OCS use prescribed OCS oxidation rates for + # precursers of prognostic stratosphere aerosols + if ($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) { + %species = (%species, 'SO2 -> ' => 'so2_ocs_ox_file'); + } + $first = 1; + $pre = ""; + $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } + # Prescribed species + add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2'"); + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox'); + } + + my @files = ('tracer_cnst_datapath', 'tracer_cnst_file', 'tracer_cnst_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ox'); + } + + add_default($nl, 'fstrat_list', 'val'=>"' '"); + add_default($nl, 'flbc_list', 'val'=>"' '"); + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + # Datasets + my @files = ('soil_erod_file', + 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } +} + +# CMIP6 emissions +if ($chem =~ /_mam4/ and $phys =~ /cam6/) { + my %species; + + # Surface emission datasets: + %species = ('dms_ot_srf_file' => 'DMS', + 'dms_bb_srf_file' => 'DMS', + 'so2_ag_sh_file' => 'SO2', + 'so2_an_srf_file' => 'SO2', + 'so2_bb_srf_file' => 'SO2', + 'so4_a1_an_srf_file' => 'so4_a1', + 'so4_a1_bb_srf_file' => 'so4_a1', + 'so4_a2_an_srf_file' => 'so4_a2', + 'num_a1_sh_srf_file' => 'num_a1', + 'num_a1_bb_srf_file' => 'num_a1', + 'num_a2_an_srf_file' => 'num_a2', + 'bc_a4_an_srf_file' => 'bc_a4', + 'bc_a4_bb_srf_file' => 'bc_a4', + 'num_a4_bc_srf_file' => 'num_a4', + 'num_a4_oc_srf_file' => 'num_a4', + 'num_a4_bb_srf_file' => 'num_a4', + 'num_pom_bb_srf_file' => 'num_a4', + 'pom_a4_an_srf_file' => 'pom_a4', + 'pom_a4_bb_srf_file' => 'pom_a4' ); + + # for mechanism missing full tropospheric chemistry + if ($chem =~ /trop_mam/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_sc/) { + %species = (%species, + 'soag_an_srf_file' => 'SOAG', + 'soag_bg_srf_file' => 'SOAG', + 'soag_bb_srf_file' => 'SOAG' ); + } + + # for mid-atmos gas-phase chemistry + if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/ or $chem =~ /waccm_ma/) { + %species = (%species, + 'NO_an_srf_file' => 'NO', + 'NO_bb_srf_file' => 'NO', + 'NO_ot_srf_file' => 'NO', + 'CO_an_srf_file' => 'CO', + 'CO_bb_srf_file' => 'CO', + 'CO_ot_srf_file' => 'CO', + 'CH2O_an_srf_file' => 'CH2O', + 'CH2O_bb_srf_file' => 'CH2O' ); + } + + # for troposphere gas-phase chemistry + if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/) { + %species = (%species, + 'BENZENE_an_srf_file' => 'BENZENE', + 'BENZENE_bb_srf_file' => 'BENZENE', + 'BIGALK_an_srf_file' => 'BIGALK', + 'BIGALK_bb_srf_file' => 'BIGALK', + 'BIGENE_an_srf_file' => 'BIGENE', + 'BIGENE_bb_srf_file' => 'BIGENE', + 'C2H2_an_srf_file' => 'C2H2', + 'C2H2_bb_srf_file' => 'C2H2', + 'C2H4_an_srf_file' => 'C2H4', + 'C2H4_bb_srf_file' => 'C2H4', + 'C2H4_ot_srf_file' => 'C2H4', + 'C2H5OH_an_srf_file' => 'C2H5OH', + 'C2H5OH_bb_srf_file' => 'C2H5OH', + 'C2H6_an_srf_file' => 'C2H6', + 'C2H6_bb_srf_file' => 'C2H6', + 'C2H6_ot_srf_file' => 'C2H6', + 'C3H6_an_srf_file' => 'C3H6', + 'C3H6_bb_srf_file' => 'C3H6', + 'C3H6_ot_srf_file' => 'C3H6', + 'C3H8_an_srf_file' => 'C3H8', + 'C3H8_bb_srf_file' => 'C3H8', + 'C3H8_ot_srf_file' => 'C3H8', + 'CH3CHO_an_srf_file' => 'CH3CHO', + 'CH3CHO_bb_srf_file' => 'CH3CHO', + 'CH3CN_an_srf_file' => 'CH3CN', + 'CH3CN_bb_srf_file' => 'CH3CN', + 'CH3COCH3_an_srf_file' => 'CH3COCH3', + 'CH3COCH3_bb_srf_file' => 'CH3COCH3', + 'CH3COCHO_bb_srf_file' => 'CH3COCHO', + 'CH3COOH_an_srf_file' => 'CH3COOH', + 'CH3COOH_bb_srf_file' => 'CH3COOH', + 'CH3OH_an_srf_file' => 'CH3OH', + 'CH3OH_bb_srf_file' => 'CH3OH', + 'GLYALD_bb_srf_file' => 'GLYALD', + 'HCN_an_srf_file' => 'HCN', + 'HCN_bb_srf_file' => 'HCN', + 'HCOOH_an_srf_file' => 'HCOOH', + 'HCOOH_bb_srf_file' => 'HCOOH', + 'ISOP_bb_srf_file' => 'ISOP', + 'MEK_an_srf_file' => 'MEK', + 'MEK_bb_srf_file' => 'MEK', + 'MTERP_bb_srf_file' => 'MTERP', + 'NH3_an_srf_file' => 'NH3', + 'NH3_bb_srf_file' => 'NH3', + 'NH3_ot_srf_file' => 'NH3', + 'TOLUENE_an_srf_file' => 'TOLUENE', + 'TOLUENE_bb_srf_file' => 'TOLUENE', + 'XYLENES_an_srf_file' => 'XYLENES', + 'XYLENES_bb_srf_file' => 'XYLENES', + 'IVOC_an_srf_file' => 'IVOC', + 'IVOC_bb_srf_file' => 'IVOC', + 'SVOC_an_srf_file' => 'SVOC', + 'SVOC_bb_srf_file' => 'SVOC', + 'E90_srf_file' => 'E90' ); + } + + my %verhash = ('ver'=>'cam6'); + my $first = 1; + my $pre = ""; + my $val = ""; + + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($id, \%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string("$species{$id} -> " . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + } + + # Vertical emission datasets: + %species = ('so2_cv_ext_file' => 'SO2', + 'so4_a1_an_ext_file' => 'so4_a1', + 'so4_a1_cv_ext_file' => 'so4_a1', + 'so4_a2_cv_ext_file' => 'so4_a2', + 'num_a1_an_ext_file' => 'num_a1', + 'num_a1_cv_ext_file' => 'num_a1', + 'num_a2_cv_ext_file' => 'num_a2', + ); + + # air craft emissions + if ($chem !~ /trop_mam/ and $chem !~ /waccm_sc/) { + %species = (%species, + 'bc_a4_ar_ext_file' => 'bc_a4', + 'num_a4_ar_ext_file' => 'num_a4', + 'no2_ar_ext_file' => 'NO2', + 'so2_ar_ext_file' => 'SO2' ); + } + + # for transient cases include volcanic emissions + if ( ($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) and + (defined $nl->get_value('ext_frc_type')) ) { + if ( $nl->get_value('ext_frc_type') !~ /CYCLICAL/ ) { + my $hgrid = $cfg->get('hgrid'); + if ($hgrid =~ /1.9x2.5/) { + %species = (%species, 'so2_volc_2deg_ext_file' => 'SO2' ); + } else { + %species = (%species, 'so2_volc_1deg_ext_file' => 'SO2' ); + } + } + if ( $sim_year eq '1850' ) { + # add background volcanic emissoins for pre-industrial spinup + %species = (%species, 'so2_volc_pi_ext_file' => 'SO2' ); + } + } + + # for cam6 add h2o source from methane oxidation + if ($chem =~ /trop_mam/) { + %species = (%species, 'h2o_ch4ox_ext_file' => 'H2O'); + } + # for mechanisms without OCS use prescribed OCS oxidation rates for + # precursers of prognostic stratosphere aerosols + if (($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) and ($chem =~ /trop_mam/)) { + %species = (%species, 'so2_ocs_ox_file' => 'SO2'); + } + + $first = 1; + $pre = ""; + $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($id, \%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string("$species{$id} -> " . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } + + # MEGAN emissions + if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/) { + my $val = "'ISOP = isoprene'," + . "'MTERP = pinene_a + carene_3 + thujene_a + 2met_styrene + cymene_p + cymene_o + terpinolene + bornene " + . "+ fenchene_a + ocimene_al + pinene_b + sabinene + camphene + limonene + phellandrene_a + terpinene_g " + . "+ terpinene_a + phellandrene_b + myrcene + ocimene_t_b + ocimene_c_b'," + . "'BCARY = caryophyllene_b + bergamotene_a + bisabolene_b + farnescene_b + humulene_a'," + . "'CH3OH = methanol'," + . "'C2H5OH = ethanol'," + . "'CH2O = formaldehyde'," + . "'CH3CHO = acetaldehyde'," + . "'CH3COOH = acetic_acid'," + . "'CH3COCH3 = acetone'," + . "'HCOOH = formic_acid'," + . "'HCN = hydrogen_cyanide'," + . "'CO = carbon_monoxide'," + . "'C2H6 = ethane'," + . "'C2H4 = ethene'," + . "'C3H8 = propane'," + . "'C3H6 = propene'," + . "'BIGALK = pentane + hexane + heptane + tricyclene'," + . "'BIGENE = butene'," + . "'TOLUENE = toluene'"; + add_default($nl, 'megan_specifier', 'val'=>$val); + add_default($nl, 'megan_factors_file'); + add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); + } + if ($chem =~ /waccm_ma/) { + my $val = "'CH2O = formaldehyde', 'CO = carbon_monoxide'"; + add_default($nl, 'megan_specifier', 'val'=>$val); + add_default($nl, 'megan_factors_file'); + add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); + } +} + +if ($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4') { + + # Prescribed species + if ($chem eq 'waccm_sc_mam4') { + add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2','HALONS'"); + add_default($nl, 'tracer_cnst_file'); + add_default($nl, 'tracer_cnst_datapath'); + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type'); + add_default($nl, 'tracer_cnst_cycle_yr'); + } + } + else { + add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2'"); + add_default($nl, 'tracer_cnst_file', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_datapath','ver'=>'fixed_ox'); + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox'); + } + } + + add_default($nl, 'fstrat_list', 'val'=>"' '"); + add_default($nl, 'flbc_list', 'val'=>"' '"); + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + # Datasets + my @files = ('soil_erod_file', + 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } +} +if ($chem eq 'trop_mam7') { + + my %species; + + # Surface emission datasets: + %species = (); + %species = ('DMS -> ' => 'dms_emis_file', + 'NH3 -> ' => 'nh3_emis_file', + 'SO2 -> ' => 'so2_emis_file', + 'SOAG -> ' => 'soag_emis_file', + 'bc_a3 -> ' => 'bc_a3_emis_file', + 'num_a1 -> ' => 'mam7_num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + 'num_a3 -> ' => 'mam7_num_a3_emis_file', + 'pom_a3 -> ' => 'pom_a3_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + ); + my %verhash = ('ver'=>'mam'); + my $first = 1; + my $pre = ""; + my $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr','val'=>'2000'); + } + + # Vertical emission datasets: + %species = (); + %species = ('SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a3 -> ' => 'pom_a3_ext_file', + 'bc_a3 -> ' => 'bc_a3_ext_file', + 'num_a1 -> ' => 'mam7_num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', + 'num_a3 -> ' => 'mam7_num_a3_ext_file', + ); + $first = 1; + $pre = ""; + $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}, \%verhash ); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } + + # Prescribed species + add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2'"); + unless (defined $nl->get_value('tracer_cnst_type')) { + add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox'); + add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox'); + } + + + my @files = ('tracer_cnst_datapath', 'tracer_cnst_file', 'tracer_cnst_filelist'); + foreach my $file (@files) { + add_default($nl, $file, 'ver'=>'fixed_ox'); + } + + add_default($nl, 'fstrat_list', 'val'=>"' '"); + add_default($nl, 'flbc_list', 'val'=>"' '"); + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + # Datasets + my @files = ('soil_erod_file', + 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } +} + +my $waccmx = $cfg->get('waccmx'); + +# WACCM options. +if ($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) { + + # Species with fixed lower boundary + my $val = "'CCL4','CF2CLBR','CF3BR','CFC11','CFC113','CFC12','CH3BR','CH3CCL3','CH3CL','CH4','CO2'" + .",'H2','HCFC22','N2O','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; + if ($chem =~ /waccm_ma/) { + $val .= ",'H1202'"; + } + if ($chem_has_ocs) { + $val .= ",'OCS'"; + } + if (chem_has_species($cfg, 'SF6')) { + $val .= ",'SF6'"; + } + + add_default($nl, 'flbc_list', 'val'=>$val); + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'1990'); + } + + # Datasets + my @files = ('flbc_file', 'efield_lflux_file', 'efield_hflux_file', 'efield_wei96_file', + 'photon_file', 'electron_file', 'igrf_geomag_coefs_file', + 'euvac_file', 'solar_parms_data_file', + 'depvel_lnd_file', 'clim_soilw_file', 'season_wes_file', + 'xs_coef_file', 'xs_short_file','xs_long_file', 'rsf_file', + 'soil_erod_file' ); + + if (!$waccmx) { @files = (@files, 'tgcm_ubc_file', 'snoe_ubc_file' ); } + + if ($chem =~ /_mozart/) { + @files = (@files, 'sulf_file' ); + } + + foreach my $file (@files) { + add_default($nl, $file); + } + + # aircraft (vertical) emissions... + my %species = (); + if ($ipcc_aircraft_emis) { + %species = ('NO2 -> ' => 'no2_aircraft_emis_file' ); + } else { + %species = ('CO -> ' => 'co_aircraft_emis', + 'NO -> ' => 'no_aircraft_emis' ); + } + my $first = 1; my $pre = ""; my $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>'1999'); + } + + # Surface emission datasets: + my $val; + my %species = ('CO -> ' => 'co_emis_file', + 'CH2O -> ' => 'ch2o_emis_file', + 'NO -> ' => 'nox_emis_file' ); + if ($chem eq 'waccm_ma_sulfur') { + $species{ 'SO2 -> ' } = ( 'so2_emis_file' ); + } + + my $first = 1; my $pre = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($species{$id}); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string($id . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>'1997'); + } + + add_default($nl, 'xactive_prates', 'val'=>'.false.'); + + if ($dyn eq 'fv') { + add_default($nl, 'do_circulation_diags', 'val'=>'.true.'); + } +} + +# Determine the source of the prescribed GHG values. + +my $lbc_file = $nl->get_value('flbc_file'); +my $scenario_ghg = $nl->get_value('scenario_ghg'); + +if (defined $lbc_file) { + + # If a WACCM/CAM-Chem LBC file is specified then use it for the prescribed + # GHGs. Set scenario_ghg='CHEM_LBC_FILE'. + + # If scenario_ghg has been set inconsistently then exit + if (defined $scenario_ghg and $scenario_ghg !~ /CHEM_LBC_FILE/) { + die "$ProgName - ERROR: When flbc_file is used cannot set scenario_ghg = $scenario_ghg \n"; + } + # Otherwise make sure its set. + add_default($nl, 'scenario_ghg', 'val'=>'CHEM_LBC_FILE'); + + # If any individual GHG values are set then remove them and issue info message + # that they will be ignored. + foreach my $ghg_vmr ('co2vmr','ch4vmr','n2ovmr','f11vmr','f12vmr') { + my $val = $nl->get_value($ghg_vmr); + if (defined $val) { + print "$ProgName - INFO: Chem flbc_file in use. $ghg_vmr = $val removed from namelist.\n"; + + if ($nl->delete_variable('chem_surfvals_nl', $ghg_vmr) != 0) { + die "$ProgName - ERROR: not able to delete $ghg_vmr from group chem_surfvals_nl.\n"; + } + } + } + + # Make sure the flbc_list specifies all the GHGs needed for radiation. + my $flbc_list = $nl->get_value('flbc_list'); + if (defined $flbc_list) { + # If flbc_list has already been defined, check that it contains all + # the GHGs needed by the radiation code. + foreach my $ghg ('CO2','CH4','N2O','CFC11','CFC12') { + if ($flbc_list !~ /$ghg/) { + die "$ProgName - ERROR: $ghg is missing from flbc_list \n"; + } + } + } + else { + my $val = "'CO2','CH4','N2O','CFC11','CFC12'"; + add_default($nl, 'flbc_list', 'val'=>$val); + } + +} +else { + + # If no chemistry then set prescribed GHG surface values using + # one of the remaining scenario_ghg values. + + if ((defined $scenario_ghg) and $scenario_ghg =~ /RAMPED/) { + # read values from dataset + add_default($nl, 'bndtvghg'); + } + else { + # If scenario_ghg is 'FIXED' or 'RAMP_CO2_ONLY' then the prescribed + # values are set using the xxxvmr variables. For 'RAMP_CO2_ONLY' + # the co2vmr value is just the starting value. + if (!$simple_phys) { + add_default($nl, 'co2vmr'); + add_default($nl, 'ch4vmr'); + add_default($nl, 'n2ovmr'); + add_default($nl, 'f11vmr'); + add_default($nl, 'f12vmr'); + } + } +} + +# Physics options + +# Add the name of the physics package based on the info in configure. If the user tries +# to explicitly specify this namelist variable issue error. +my $cam_physpkg = $nl->get_value('cam_physpkg'); +if (defined $cam_physpkg) { + die "CAM Namelist ERROR: User may not specify the value of cam_physpkg.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} +$cam_physpkg = "'" . "$phys" . "'"; # add quotes to this string value +$nl->set_variable_value('phys_ctl_nl', 'cam_physpkg', $cam_physpkg); + +my $use_simple_phys = $nl->get_value('use_simple_phys'); +if (defined $use_simple_phys) { + die "CAM Namelist ERROR: User may not specify the value of use_simple_phys.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} +$use_simple_phys = '.false.'; +if ($simple_phys) {$use_simple_phys = '.true.';} +$nl->set_variable_value('phys_ctl_nl', 'use_simple_phys', $use_simple_phys); + +# WACCM-X runtime options +add_default($nl, 'waccmx_opt'); + +if ($waccmx) { + my $wmx_opt = $nl->get_value('waccmx_opt'); + my $ionos = $cfg->get('ionosphere'); + + if (($ionos eq 'none') and ($wmx_opt =~ /ionosphere/) ) { + die "CAM Namelist ERROR: WACCMX must be configured with an active ionosphere wmx_opt is set to ionosphere\n"; + } + if (($ionos ne 'none') and ($wmx_opt =~ /neutral/) ) { + die "CAM Namelist ERROR: WACCMX cannot be configured with an active ionosphere wmx_opt is set to neutral\n"; + } + + if (($ionos eq 'wxie') and ($wmx_opt =~ /ionosphere/) and ($dyn eq 'fv')) { + # turn on electro-dynamo generated ion drift velocities + add_default($nl, 'ionos_xport_active', 'val'=>'.true.'); + add_default($nl, 'ionos_edyn_active', 'val'=>'.true.'); + add_default($nl, 'empirical_ion_velocities', 'val'=>'.false.'); + } elsif (($ionos eq 'wxi') and ($wmx_opt =~ /ionosphere/) and ($dyn eq 'fv')) { + # turn off electro-dynamo generated ion drift velocities + add_default($nl, 'ionos_xport_active', 'val'=>'.true.'); + add_default($nl, 'ionos_edyn_active', 'val'=>'.false.'); + add_default($nl, 'empirical_ion_velocities', 'val'=>'.true.'); + } elsif (($ionos eq 'none') and ($wmx_opt =~ /neutral/)) { + add_default($nl, 'ionos_xport_active', 'val'=>'.false.'); + add_default($nl, 'ionos_edyn_active', 'val'=>'.false.'); + add_default($nl, 'empirical_ion_velocities', 'val'=>'.true.'); + } else { + die "CAM Namelist ERROR: Incompatible WACCMX settings \n" ; + } + if ($dyn eq 'fv') { + add_default($nl, 'fv_high_altitude', 'val'=>'.true.'); + } + add_default($nl,'dadadj_niter'); + add_default($nl,'ionos_epotential_model'); + if ($nl->get_value('ionos_epotential_model') =~ 'weimer') { + add_default($nl,'wei05_coefs_file'); + add_default($nl,'solar_wind_data_file'); + } +} + +# Chemistry options + +# EPP namelist sanity checks + +(my $epp_all_file = $nl->get_value('epp_all_filepath')) =~ s/\s//g; +(my $epp_spe_file = $nl->get_value('epp_spe_filepath')) =~ s/\s//g; +(my $epp_gcr_file = $nl->get_value('epp_gcr_filepath')) =~ s/\s//g; +(my $epp_mee_file = $nl->get_value('epp_mee_filepath')) =~ s/\s//g; +(my $gcr_ion_file = $nl->get_value('gcr_ionization_filename')) =~ s/\s//g; +$epp_all_file =~ s/['"]//g; # strip quotes "' +$epp_spe_file =~ s/['"]//g; # strip quotes "' +$epp_gcr_file =~ s/['"]//g; # strip quotes "' +$epp_mee_file =~ s/['"]//g; # strip quotes "' +$gcr_ion_file =~ s/['"]//g; # strip quotes "' + +if ($gcr_ion_file and $gcr_ion_file ne 'NONE') { + if (($epp_all_file and $epp_all_file ne 'NONE') or ($epp_gcr_file and $epp_gcr_file ne 'NONE')) { + die "CAM Namelist ERROR: Conflicting GCR inputs specified. Variable gcr_ionization_filename". + " is set while epp_all_filepath or epp_gcr_filepath is set.\n"; + } +} +if ($epp_all_file and $epp_all_file ne 'NONE') { + if (($epp_gcr_file and $epp_gcr_file ne 'NONE') or + ($epp_spe_file and $epp_spe_file ne 'NONE') or + ($epp_mee_file and $epp_mee_file ne 'NONE') ) { + die "CAM Namelist ERROR: Conflicting EPP inputs specified. Variable epp_all_filepath". + " is set while epp_gcr_filepath or epp_spe_filepath or epp_mee_filepath is set.\n"; + } +} + +# Add the name of the chemistry package based on the info in configure. If the user tries +# to explicitly specify this namelist variable issue error. +my $cam_chempkg = $nl->get_value('cam_chempkg'); +if (defined $cam_chempkg) { + die "CAM Namelist ERROR: User may not specify the value of cam_chempkg.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} +$cam_chempkg = "'" . "$chem" . "'"; # add quotes to this string value + +$nl->set_variable_value('phys_ctl_nl', 'cam_chempkg', $cam_chempkg); + +# Tropopause climatology +if (!$simple_phys) { + add_default($nl, 'tropopause_climo_file'); +} + +# tropopause level used in gas-phase / aerosol processes +if (($chem ne 'none') and ($chem ne 'terminator')) { + add_default($nl, 'chem_use_chemtrop'); +} + +# Deep convection scheme +add_default($nl, 'deep_scheme'); + +# Radiation scheme +add_default($nl, 'radiation_scheme', 'val'=>$rad_pkg); + +# Eddy scheme (vertical diffusion) +add_default($nl, 'eddy_scheme'); + +# Default for shallow convection scheme depends +# on the value of the eddy scheme. +my $eddy_scheme = $nl->get_value('eddy_scheme'); +$eddy_scheme =~ s/['"]//g; # strip quotes "' +add_default($nl, 'shallow_scheme', 'eddy_scheme'=>$eddy_scheme); + +add_default($nl, 'srf_flux_avg', 'val'=>0); + +# Microphysics scheme +add_default($nl, 'use_subcol_microp'); +add_default($nl, 'microp_scheme'); + +if ($cfg->get('microphys') =~ /^mg/) { + add_default($nl, 'micro_mg_version'); + add_default($nl, 'micro_mg_sub_version'); + add_default($nl, 'micro_mg_num_steps'); + add_default($nl, 'micro_mg_adjust_cpt'); + add_default($nl, 'nucleate_ice_subgrid'); + add_default($nl, 'nucleate_ice_subgrid_strat'); + add_default($nl, 'nucleate_ice_use_troplev'); + add_default($nl, 'cld_macmic_num_steps', 'dtime'=>$dtime); + add_default($nl, 'micro_mg_dcs'); + add_default($nl, 'micro_mg_precip_frac_method'); + add_default($nl, 'micro_mg_berg_eff_factor'); + add_default($nl, 'nucleate_ice_incloud'); + add_default($nl, 'nucleate_ice_strat'); + + # For CESM2, the decision was made to set micro_do_sb_physics to false + add_default($nl, 'micro_do_sb_physics', 'val'=>'.false.'); +} + +# Ice nucleation options +if (!$simple_phys) { + add_default($nl, 'use_hetfrz_classnuc'); + add_default($nl, 'use_preexisting_ice'); + if ($chem =~ /_mam7/) { + if ($nl->get_value('use_preexisting_ice') =~ m/$TRUE/io) { + die "$ProgName - Error: use_preexisting_ice is not supported by MAM7 \n"; + } + } +} + +# Macrophysics scheme +add_default($nl, 'macrop_scheme'); + +# Sub-column switches for physics packages +# Check that a subcol_scheme is specified if use_subcol_microp is turned on (true) +my $use_subcol_microp = $nl->get_value('use_subcol_microp'); +my $subcol_scheme; +if (defined $use_subcol_microp and $use_subcol_microp =~ m/$TRUE/io) { + add_default($nl, 'subcol_scheme'); + $subcol_scheme = $nl->get_value('subcol_scheme'); + $subcol_scheme =~ s/['"]//g; # strip quotes "' + if ($subcol_scheme =~ /off/) { + die "$ProgName - Error: use_subcol_microp set to .true. but no subcol_scheme is set\n"; + } + elsif ($subcol_scheme !~ /tstcp|SILHS|vamp|CloudObj/) { + die "$ProgName - Error: subcol_scheme not recognized: $subcol_scheme\n"; + } +} + +if ($subcol_scheme eq 'tstcp') { + add_default($nl, 'subcol_tstcp_noavg'); + add_default($nl, 'subcol_tstcp_filter'); + add_default($nl, 'subcol_tstcp_weight'); + add_default($nl, 'subcol_tstcp_perturb'); + add_default($nl, 'subcol_tstcp_restart'); +} + +if ($subcol_scheme eq 'SILHS') { + add_default($nl, 'subcol_silhs_weight'); +} + +if ($subcol_scheme eq 'vamp') { + add_default($nl, 'subcol_vamp_ctyp'); + add_default($nl, 'subcol_vamp_otyp'); + add_default($nl, 'subcol_vamp_nsubc'); +} + +# Set microp_uniform based on use_subcol_microp +if ($use_subcol_microp =~ /$TRUE/io) { + add_default($nl, 'microp_uniform', 'val'=>'.true.'); +} + +# CLUBB_SGS +add_default($nl, 'do_clubb_sgs'); +my $clubb_sgs = $nl->get_value('do_clubb_sgs'); +if ($clubb_sgs =~ /$TRUE/io) { + my $clubb_do_adv = $cfg->get('clubb_do_adv'); + if($clubb_do_adv == '1') { + add_default($nl, 'clubb_do_adv', 'val'=>'.true.'); + } + add_default($nl, 'clubb_history'); + add_default($nl, 'clubb_rad_history'); + + if ($nl->get_value('clubb_history') =~ "true" && $nl->get_value('atm_nthreads') != 1) { + die "$ProgName - ERROR: clubb_history = .true. with multiple threads is not supported. \n"; + } + + add_default($nl, 'clubb_expldiff'); + add_default($nl, 'clubb_rainevap_turb'); + add_default($nl, 'clubb_cloudtop_cooling'); + add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_rnevap_effic'); + add_default($nl, 'clubb_stabcorrect'); + + add_default($nl, 'clubb_c11'); + add_default($nl, 'clubb_c11b'); + add_default($nl, 'clubb_c14'); + add_default($nl, 'clubb_mult_coef'); + add_default($nl, 'clubb_gamma_coef'); + add_default($nl, 'clubb_c_K10'); + add_default($nl, 'clubb_c_K10h'); + add_default($nl, 'clubb_beta'); + add_default($nl, 'clubb_C2rt'); + add_default($nl, 'clubb_C2thl'); + add_default($nl, 'clubb_C2rtthl'); + add_default($nl, 'clubb_C8'); + add_default($nl, 'clubb_C7'); + add_default($nl, 'clubb_C7b'); + add_default($nl, 'clubb_lambda0_stability_coef'); + add_default($nl, 'clubb_Skw_denom_coef'); + add_default($nl, 'clubb_l_lscale_plume_centered'); + add_default($nl, 'clubb_l_use_ice_latent'); + add_default($nl, 'clubb_do_liqsupersat'); +} + +# Tuning for wet scavenging of modal aerosols +if ($chem =~ /_mam/) { + add_default($nl, 'sol_facti_cloud_borne'); + add_default($nl, 'sol_factb_interstitial'); + add_default($nl, 'sol_factic_interstitial'); +} + +# Turbulent Mountain Stress +my $do_tms; +if (!$simple_phys) { + add_default($nl, 'do_tms'); + $do_tms = $nl->get_value('do_tms'); + # Check to be sure that do_tms has been set to true if the user sets a customized + # value of tms_orocnst or tms_z0fac. + if (defined $nl->get_value('tms_orocnst') or defined $nl->get_value('tms_z0fac')) { + # a tms parameter has been set in the namelist. Make sure do_tms is true. + if ( $do_tms =~ /$FALSE/io ) { + die "$ProgName - ERROR: If tms_oroconst or tms_z0fac is set do_tms must be .true..\n". + "Either remove these from the namelist or add do_tms=.true.\n"; + } + } + if ( $do_tms =~ /$TRUE/io ) { + add_default($nl, 'tms_orocnst'); + add_default($nl, 'tms_z0fac'); + } +} + +# Beljaars +if (!$simple_phys) { + add_default($nl, 'do_beljaars'); + my $do_beljaars = $nl->get_value('do_beljaars'); + if ($do_tms =~ /$TRUE/io and $do_beljaars =~ /$TRUE/io) { + die "$ProgName - ERROR: by default, do_beljaars and do_tms cannot be set to \n". + "true at the same time. If you really want to set do_beljaars and do_tms \n". + "to true at the same time, remove this check from the build-namelist. \n"; + } +} + +# Implicit Turbulent Surface Stress +if (!$simple_phys) { + add_default($nl, 'do_iss'); +} + +# Convective water in radiation +if (!$simple_phys) { + add_default($nl, 'conv_water_in_rad'); + add_default($nl, 'conv_water_frac_limit'); +} + +# Cloud fraction +if (!$simple_phys) { + add_default($nl, 'cldfrc_freeze_dry'); + add_default($nl, 'cldfrc_ice'); + add_default($nl, 'cldfrc_rhminl'); + add_default($nl, 'cldfrc_rhminl_adj_land'); + add_default($nl, 'cldfrc_rhminh'); + add_default($nl, 'cldfrc_sh1'); + add_default($nl, 'cldfrc_sh2'); + add_default($nl, 'cldfrc_dp1'); + add_default($nl, 'cldfrc_dp2'); + add_default($nl, 'cldfrc_premit'); + add_default($nl, 'cldfrc_premib'); + add_default($nl, 'cldfrc_iceopt'); + add_default($nl, 'cldfrc_icecrit'); + add_default($nl, 'cldfrc2m_rhmini'); + add_default($nl, 'cldfrc2m_rhmaxi'); + add_default($nl, 'cldfrc2m_rhminis'); + add_default($nl, 'cldfrc2m_rhmaxis'); + add_default($nl, 'cldfrc2m_do_subgrid_growth'); +} + +my $rk_strat_polstrat_rhmin = $nl->get_value('rk_strat_polstrat_rhmin'); +if ($rk_strat_polstrat_rhmin and !($cfg->get('microphys') eq 'rk')) { + die "$ProgName - ERROR: rk_strat_polstrat_rhmin is valid only for RK microphysics scheme\n"; +} + +# condensate to rain autoconversion coefficients +if (!$simple_phys) { + add_default($nl, 'zmconv_momcu'); + add_default($nl, 'zmconv_momcd'); + add_default($nl, 'zmconv_c0_lnd'); + add_default($nl, 'zmconv_c0_ocn'); + add_default($nl, 'zmconv_ke'); + add_default($nl, 'zmconv_ke_lnd'); + add_default($nl, 'zmconv_org'); + add_default($nl, 'zmconv_microp'); + add_default($nl, 'zmconv_num_cin'); +} + +# moist convection rainwater coefficients +my $shallow_scheme = $nl->get_value('shallow_scheme'); +$shallow_scheme =~ s/['"]//g; # strip quotes "' +if ($shallow_scheme eq 'Hack') { + add_default($nl, 'hkconv_cmftau'); + add_default($nl, 'hkconv_c0'); +} + +if ($shallow_scheme eq 'UW') { + add_default($nl, 'uwshcu_rpen'); +} + +# cldwat ice coefficients +if ($cfg->get('microphys') eq 'rk') { + add_default($nl, 'rk_strat_icritc'); + add_default($nl, 'rk_strat_icritw'); + add_default($nl, 'rk_strat_conke'); + add_default($nl, 'rk_strat_r3lcrit'); +} + +# Eddy Diffusivity Adjustments +if ($cfg->get('pbl') eq "uw" or $cfg->get('pbl') eq "spcam_m2005") { + add_default($nl, 'kv_top_pressure'); + add_default($nl, 'kv_top_scale'); + add_default($nl, 'kv_freetrop_scale'); + add_default($nl, 'eddy_lbulk_max'); + add_default($nl, 'eddy_leng_max'); + add_default($nl, 'eddy_max_bot_pressure'); + add_default($nl, 'eddy_moist_entrain_a2l'); +} + +if (!$simple_phys) { + # Pressure limits for molecular diffusion. + add_default($nl, 'do_molec_press'); + add_default($nl, 'molec_diff_bot_press'); + + # Top level pressure for troposphere cloud physics + add_default($nl, 'trop_cloud_top_press'); + + add_default($nl, 'diff_cnsrv_mass_check'); +} + +if ($cfg->get('microphys') eq 'rk') { + # Cloud sedimentation + add_default($nl, 'cldsed_ice_stokes_fac'); +} + +# Dust emissions tuning factor +# If dust is prognostic ==> supply the tuning factor +if ( length($nl->get_value('soil_erod_file'))>0 ) { + # check whether turbulent mountain stress parameterization is on + if ($nl->get_value('do_tms') =~ /$TRUE/io) { + add_default($nl, 'dust_emis_fact', 'tms'=>'1'); + } + else { + if ($chem =~ /trop_strat/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { + add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); + # set scaling of lightning NOx production + add_default($nl, 'lght_no_prd_factor' ); + } + else { + add_default($nl, 'dust_emis_fact'); + } + } +} + +# Seasalt emissions tuning factor +if ($chem =~ /_mam(\d)/) { + my $ver = undef; + if ($nl->get_value('modal_accum_coarse_exch') =~ /$TRUE/io) { + # Check for accumulation/coarse mode exchange. + $ver = 'strat'; + } + elsif ($1 eq '7') { + # Check for mam7 + $ver = 'mam7'; + } + if (defined $ver) { + add_default($nl, 'seasalt_emis_scale', 'ver'=>$ver); + } + else { + add_default($nl, 'seasalt_emis_scale'); + } +} + +# Gravity wave drag settings + +# By default, orographic waves are always on +if (!$simple_phys) { + + if ($phys =~ /cam6/) { + + add_default($nl, 'use_gw_oro', 'val'=>'.false.'); + + # Only add ridges if topo file is available + if ($use_topo_file =~ m/$FALSE/io) { + add_default($nl, 'use_gw_rdg_beta', 'val'=>'.false.'); + } + else { + add_default($nl, 'use_gw_rdg_beta', 'val'=>'.true.'); + } + } + else { + add_default($nl, 'use_gw_oro', 'val'=>'.true.'); + add_default($nl, 'use_gw_rdg_beta', 'val'=>'.false.'); + } + + add_default($nl, 'use_gw_rdg_gamma' , 'val'=>'.false.'); + add_default($nl, 'use_gw_front_igw' , 'val'=>'.false.'); + add_default($nl, 'use_gw_convect_sh', 'val'=>'.false.'); + add_default($nl, 'gw_lndscl_sgh'); + add_default($nl, 'gw_oro_south_fac'); + add_default($nl, 'gw_limit_tau_without_eff'); + add_default($nl, 'gw_apply_tndmax'); + + # Gravity wave ridge settings + # By default, gw_rdg_do_divstream is set to true + add_default($nl, 'gw_rdg_do_divstream' , 'val'=>'.true.'); +} + +if ($waccm_phys or + (!$simple_phys and $cfg->get('nlev') >= 60)) { + # Spectral gravity waves are part of WACCM physics, and also drive the + # QBO in the high vertical resolution configuration. + add_default($nl, 'use_gw_front' , 'val'=>'.true.'); + add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); + my $hdepth_scaling = '0.25D0' ; + if ($nl->get_value('qbo_use_forcing') =~ /$TRUE/io) { + $hdepth_scaling = '1.D0' ; + add_default($nl, 'qbo_cyclic','val'=>'.true.'); + add_default($nl, 'qbo_forcing_file'); + } + add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>$hdepth_scaling); +} else { + add_default($nl, 'use_gw_front' , 'val'=>'.false.'); + add_default($nl, 'use_gw_convect_dp', 'val'=>'.false.'); +} + +# We need a lot of logic to use these below, so make flags for them. +my $do_gw_oro = ($nl->get_value('use_gw_oro') =~ /$TRUE/io); +my $do_gw_front = ($nl->get_value('use_gw_front') =~ /$TRUE/io); +my $do_gw_front_igw = ($nl->get_value('use_gw_front_igw') =~ /$TRUE/io); +my $do_gw_convect_dp = ($nl->get_value('use_gw_convect_dp') =~ /$TRUE/io); +my $do_gw_convect_sh = ($nl->get_value('use_gw_convect_sh') =~ /$TRUE/io); +my $do_gw_rdg_beta = ($nl->get_value('use_gw_rdg_beta') =~ /$TRUE/io); +my $do_gw_rdg_gamma = ($nl->get_value('use_gw_rdg_gamma') =~ /$TRUE/io); + +my $do_divstream = ($nl->get_value('gw_rdg_do_divstream') =~ /$TRUE/io); + +if (!$simple_phys) { + # GW option used only for backwards compatibility with CAM3. + add_default($nl, 'fcrit2', 'val'=>'1.0'); +} +# Mid-scale wavelength settings. +if ($do_gw_front or $do_gw_convect_dp or $do_gw_convect_sh) { + add_default($nl, 'pgwv', 'val'=>'32'); + add_default($nl, 'gw_dc','val'=>'2.5D0'); +} elsif (!$simple_phys) { + add_default($nl, 'pgwv', 'val'=>'0'); + add_default($nl, 'gw_dc','val'=>'0.D0'); +} + +# Long wavelength settings (for IGWs). +if ($do_gw_front_igw) { + add_default($nl, 'pgwv_long', 'val'=>'10'); + add_default($nl, 'gw_dc_long', 'val'=>'2.0D0'); +} elsif (!$simple_phys) { + add_default($nl, 'pgwv_long', 'val'=>'0'); + add_default($nl, 'gw_dc_long','val'=>'0.D0'); +} + +if ($do_gw_oro) { + add_default($nl, 'effgw_oro'); +} + +if ($do_gw_front) { + add_default($nl, 'effgw_cm'); + add_default($nl, 'taubgnd'); + add_default($nl, 'gw_polar_taper'); +} + +if ($do_gw_front_igw) { + add_default($nl, 'effgw_cm_igw'); + add_default($nl, 'taubgnd_igw'); +} + +if ($do_gw_front or $do_gw_front_igw) { + add_default($nl, 'frontgfc'); +} + +if ($do_gw_convect_dp) { + add_default($nl, 'gw_drag_file'); + add_default($nl, 'effgw_beres_dp'); +} + +if ($do_gw_convect_sh) { + add_default($nl, 'gw_drag_file_sh'); + add_default($nl, 'effgw_beres_sh'); +} + +if ($do_gw_rdg_beta) { + if ($use_topo_file =~ m/$FALSE/io) { + die "$ProgName - ERROR: beta ridge scheme requires data from a topo file.\n"; + } + add_default($nl, 'n_rdg_beta', 'val'=>'10'); + add_default($nl, 'effgw_rdg_beta', 'val'=>'1.0D0'); + add_default($nl, 'effgw_rdg_beta_max', 'val'=>'1.0D0'); + add_default($nl, 'trpd_leewv_rdg_beta', 'val'=>'.false.'); + add_default($nl, 'rdg_beta_cd_llb', 'val'=>'1.0D0'); +} + +if ($do_gw_rdg_beta) { + add_default($nl, 'gw_prndl', 'val'=>'0.5D0'); +} elsif (!$simple_phys) { + add_default($nl, 'gw_prndl'); +} + +if ($do_gw_rdg_gamma) { + add_default($nl, 'n_rdg_gamma', 'val'=>'-1'); + add_default($nl, 'effgw_rdg_gamma', 'val'=>'1.0D0'); + add_default($nl, 'effgw_rdg_gamma_max', 'val'=>'1.0D0'); + add_default($nl, 'trpd_leewv_rdg_gamma', 'val'=>'.true.'); + add_default($nl, 'rdg_gamma_cd_llb', 'val'=>'1.0D0'); + add_default($nl, 'bnd_rdggm'); +} + +if (($do_gw_rdg_beta or $do_gw_rdg_gamma) and $do_gw_oro) { + die "$ProgName - ERROR: both orographic wave and ridge scheme are on. \n" ; + "Turn off one of them.\n"; +} + +if (($do_gw_rdg_beta or $do_gw_rdg_gamma)) { + if ($do_divstream) { + add_default($nl, 'gw_rdg_FR_c', 'val'=>'1.0D0'); + add_default($nl, 'gw_rdg_do_backward_compat', 'val'=>'.false.'); + } else { + add_default($nl, 'gw_rdg_FR_c', 'val'=>'0.7D0'); + add_default($nl, 'gw_rdg_do_backward_compat', 'val'=>'.true.'); + } + + add_default($nl, 'gw_rdg_do_smooth_regimes'); + add_default($nl, 'gw_rdg_do_adjust_tauoro'); + add_default($nl, 'gw_rdg_C_BetaMax_DS'); + add_default($nl, 'gw_rdg_C_GammaMax'); + add_default($nl, 'gw_rdg_Frx0'); + add_default($nl, 'gw_rdg_Frx1'); + add_default($nl, 'gw_rdg_C_BetaMax_SM'); + add_default($nl, 'gw_rdg_orohmin'); + add_default($nl, 'gw_rdg_orovmin'); + add_default($nl, 'gw_rdg_orostratmin'); + add_default($nl, 'gw_rdg_orom2min'); +} + +# Some complexity to unpack. +# 1. In WACCM, we want tau_0_ubc = .false., because it hasn't been tuned +# for that option. +# 2. In the low top model with most gravity waves on, we want tau_0_ubc to +# be .true., to get a QBO. +# 3. If only orographic waves are on, we can't get a QBO regardless, so +# use tau_0_ubc = .false. to avoid changing answers. +if ((not $waccm_phys) and + ($do_gw_front or $do_gw_front_igw or + $do_gw_convect_dp or $do_gw_convect_sh)) { + add_default($nl, 'tau_0_ubc', 'val'=>'.true.'); +} elsif (!$simple_phys) { + add_default($nl, 'tau_0_ubc', 'val'=>'.false.'); +} + +# FV dycore +if ($dyn eq 'fv') { + add_default($nl, 'fv_fft_flt'); + add_default($nl, 'fv_div24del2flag'); + add_default($nl, 'fv_del2coef'); + add_default($nl, 'fv_filtcw'); + add_default($nl, 'fv_nspltvrm'); + if ($waccm_phys) { + add_default($nl, 'fv_nsplit'); + add_default($nl, 'fv_nspltrac'); + } + # If the -ntasks argument has been set, then use it to set the default + # FV decomposition unless the user has already set it. + my $npr_yz = $nl->get_value('npr_yz'); + if (defined $opts{'ntasks'} and ! defined $npr_yz ) { + $npr_yz = fv_decomp_set(); + add_default($nl, 'npr_yz', 'val'=>$npr_yz); + } +} + +# EUL dycore +if ($dyn eq 'eul') { + add_default($nl, 'eul_dif2_coef'); + add_default($nl, 'eul_hdif_order'); + add_default($nl, 'eul_hdif_kmnhdn'); + add_default($nl, 'eul_hdif_coef'); + add_default($nl, 'eul_divdampn'); + add_default($nl, 'eul_tfilt_eps'); + add_default($nl, 'eul_kmxhdc'); + add_default($nl, 'eul_nsplit'); +} + +# SLD dycore +if ($dyn eq 'sld') { + add_default($nl, 'sld_dif2_coef'); + add_default($nl, 'sld_dif4_coef'); + add_default($nl, 'sld_divdampn'); + add_default($nl, 'sld_tfilt_eps'); + add_default($nl, 'sld_kmxhdc'); +} + +# Single column model +if ($cfg->get('scam')) { + add_default($nl, 'iopfile'); +} + +# CAM generates IOP file for SCAM +if ($cfg->get('camiop')) { + add_default($nl, 'inithist', 'val'=>'CAMIOP'); + add_default($nl, 'ndens', 'val'=>'1,1'); + add_default($nl, 'mfilt', 'val'=>'1,10'); + add_default($nl, 'nhtfrq', 'val'=>'0,1'); +} + +# Spectral Element dycore +# ============ + +if ($dyn =~ /se/) { + + #################################################### + # namelist group: dyn_se_inparm (for CAM_SE) # + #################################################### + + my $csne = $cfg->get('csne'); + my $se_ne = $nl->get_value('se_ne'); + if (defined($se_ne) and $se_ne != $csne) { + die "$ProgName - ERROR: se_ne should not be set by the user\n"; + } + add_default($nl, 'se_ne', 'val'=>$csne); + + my $npg = $cfg->get('npg'); + my $se_fv_nphys = $nl->get_value('se_fv_nphys'); + if (defined($se_fv_nphys) and $se_fv_nphys != $npg) { + die "$ProgName - ERROR: se_fv_nphys should not be set by the user\n"; + } + add_default($nl, 'se_fv_nphys', 'val'=>$npg); + + my $cslam = ($npg > 0) ? 1 : 0; + add_default($nl, 'se_ftype', 'cslam'=>$cslam); + + my @vars = qw( + se_horz_num_threads + se_hypervis_on_plevs + se_hypervis_subcycle + se_hypervis_subcycle_q + se_limiter_option + se_nsplit + se_nu + se_nu_div + se_nu_p + se_nu_top + se_qsize_condensate_loading + se_qsplit + se_rsplit + se_statediag_numtrac + se_statefreq + se_tracer_num_threads + se_tstep_type + se_vert_num_threads + se_vert_remap_q_alg + ); + + my %opts; + + # Do we need special refined mesh processing? + add_default($nl, 'se_refined_mesh'); + my $refined_mesh = $nl->get_value('se_refined_mesh'); + if ($refined_mesh =~ m/$TRUE/i) { + $opts{'refined_mesh'} = "1"; + add_default($nl, 'se_mesh_file'); + my $se_mesh_file = $nl->get_value('se_mesh_file'); + if (!defined $se_mesh_file or ($refined_mesh =~ m/none/i) or ((length $refined_mesh) == 0)) { + die "$ProgName - ERROR: se_mesh_file is required for a refined mesh run\n"; + } + # We are in a refined mesh situation, set appropriate defaults + $nl->set_variable_value('dyn_se_inparm', 'se_ne', 0); + add_default($nl, 'se_hypervis_power'); + my $hypervis_power = $nl->get_value('se_hypervis_power'); + if ($hypervis_power == 0) { + # Configure default tensor hyperviscosity + $opts{'hypervis_type'} = 'tensor'; + push @vars, 'se_hypervis_scaling'; + } + else { + # Configure scalar hyperviscosity + $opts{'hypervis_type'} = 'scalar'; + if ($hypervis_power != 3.322) { + # This is unsupported territory, allow chaos to reign + print "$ProgName - WARNING: Unsupported value for hypervis_power, assuming scalar hyperviscosity\n"; + } + push @vars, 'se_fine_ne'; + push @vars, 'se_max_hypervis_courant'; + } + } + # Add the collected vars + foreach my $var (@vars) { + add_default($nl, $var, %opts); + } +} + +# Defaults for history output +add_default($nl, 'history_amwg'); +add_default($nl, 'history_vdiag'); +add_default($nl, 'history_aerosol'); +add_default($nl, 'history_aero_optics'); +add_default($nl, 'history_budget'); +add_default($nl, 'history_eddy'); +add_default($nl, 'history_waccm'); +add_default($nl, 'history_waccmx'); +add_default($nl, 'history_chemistry'); +add_default($nl, 'history_chemspecies_srf'); +add_default($nl, 'history_clubb'); + +# The history output for the AMWG variability diagnostics assumes that auxilliary history +# files h1, h2, and h3 contain daily, 6-hrly, and 3-hrly output respectively. If this output +# has been requested, then make sure the user has not already set nhtfrq to something +# inconsistent with this requirement. +my $history_vdiag = $nl->get_value('history_vdiag'); +if ($history_vdiag =~ m/$TRUE/io) { + + # Check for consistent setting of nhtfrq. + my $nhtfrq = $nl->get_value('nhtfrq'); + if (defined $nhtfrq) { # + # If already set, check for consistency + my @nhtfrq = split /,/, $nhtfrq; + if ($nhtfrq[1] != -24 or $nhtfrq[2] != -6 or $nhtfrq[3] != -3) { + die "$ProgName - ERROR: history_vdiag is .true., but nhtfrq is set to $nhtfrq\n". + "The first 4 elements of nhtfrq must be 0,-24,-6,-3. Note that the use case may\n". + "be the source of the inconsistent nhtfrq values.\n"; + } + } + else { + # set the default + add_default($nl, 'nhtfrq', 'val'=>'0, -24, -6, -3'); + } +} +# Check incompatible history options +my $interpolate_output = $nl->get_value('interpolate_output'); +my @interp_output = split /,/, $interpolate_output; +for my $i (0 .. $#interp_output) { + if ($interp_output[$i] =~ /$TRUE/io) { + # Currently, interpolated output is only supported for the SE dycore + if ( ! ($dyn =~ /se/) ) { + die "$ProgName - ERROR: interpolate_output is not supported for $dyn dycore"; + } + # Currently, interpolated output is incompatible with regional output + my $region = $nl->get_value('fincl${i}lonlat'); + if (defined $region) { + die "$ProgName - ERROR: interpolate_output is currently incompatible with regional output (e.g., fincl${i}lonlat)"; + } + } +} + +my $offline_drv = $cfg->get('offline_drv'); +if ($offline_drv ne 'stub') { + + add_default($nl, 'offline_driver', 'val'=>'.true.'); + + if ($offline_drv eq 'rad') { + add_default($nl, 'iradsw', 'val'=>'1'); + add_default($nl, 'iradlw', 'val'=>'1'); + } +} + +if ($phys eq 'spcam_sam1mom' or $phys eq 'spcam_m2005') { + add_default($nl, 'iradsw', 'val'=>'1'); + add_default($nl, 'iradlw', 'val'=>'1'); +} + +#----------------------------------------------------------------------------------------------- +# Add defaults for the ocean component. + +# Which ocean model? +my $ocn_comp = $cfg->get('ocn'); + +# The aquaplanet namelist is written only for standalone runs. The 'aquaplanet' component +# is implemented by CAM. The cesm scripts use the 'docn' component to implement aquaplanet +# functionality. +my $aqua_planet_sst; +if ($aqua_mode) { + add_default($nl, 'aqua_planet_sst', 'val'=>'1'); + $aqua_planet_sst = $nl->get_value('aqua_planet_sst'); +} + +# The following variables are set by namelist variables in the special camexp namelist +# group. They are used to ensure consistency between the setting of namelist variables +# in the ocean and sea ice components. +my $bndtvs = ''; +my $bndtvs_domain = ''; +my $focndomain = ''; + +# Namelist settings for CAMDOM or DOCN +if ($cam_build and ($ocn_comp =~ /docn|dom|som/)) { + + # bndtvs + add_default($nl, 'bndtvs', 'sim_year'=>$sim_year); + $bndtvs = $nl->get_value('bndtvs'); + + # bndtvs_domain + if ($dyn =~ /se/){ + add_default($nl, 'bndtvs_domain', 'sim_year'=>$sim_year); + $bndtvs_domain = $nl->get_value('bndtvs_domain'); + } + + # focndomain + # For CAM in standalone mode, CAM determines the focndomain file to use, and then specifies + # that file to DOM or DOCN. + add_default($nl, 'focndomain'); + $focndomain = $nl->get_value('focndomain'); + + ############################## + # namelist group: dom_inparm # + ############################## + if ($ocn_comp eq 'dom') { + $nl->set_variable_value('dom_inparm', 'bndtvs', $bndtvs); + $nl->set_variable_value('dom_inparm', 'focndomain', $focndomain); + } + +} + +# Create docn namelists and stream txt file + +if ($cam_build and ($ocn_comp =~ /docn|som/)) { + + my $fh = new IO::File; + + my $stream_year_first = $nl->get_value('stream_year_first'); + unless (defined $stream_year_first) { $stream_year_first = 0; } + my $stream_year_last = $nl->get_value('stream_year_last'); + unless (defined $stream_year_last) { $stream_year_last = 0; } + + my $temp = $focndomain; + $temp =~ s/['"]//g; #"' + my $focndomain_file = basename($temp); + my $focndomain_path = dirname($temp); + + $temp = $bndtvs; + $temp =~ s/['"]//g; #"' + my $sstdata_file = basename($temp); + my $sstdata_path = dirname($temp); + + my $fsstdomain_file=$focndomain_file; + my $fsstdomain_path=$focndomain_path; + if ($ocn_comp eq 'som') { + $fsstdomain_file=$sstdata_file; + $fsstdomain_path=$sstdata_path; + } + + if ($dyn =~ /se/){ + $temp = $bndtvs_domain; + $temp =~ s/['"]//g; #"' + $fsstdomain_file = basename($temp); + $fsstdomain_path = dirname($temp); + } + + # add docn variables + # ------------------ + + add_default($nl, 'decomp', 'val'=>'1d'); + if ($ocn_comp eq 'som') { + add_default($nl, 'force_prognostic_true', 'val'=>'.false.'); + } + + my $datamode = 'SSTDATA'; + if ($aqua_mode) { $datamode = "SST_AQUAP$aqua_planet_sst";} + if ($ocn_comp eq 'som') { $datamode = 'SOM';} + add_default($nl, 'dataMode', 'val'=>$datamode); + + add_default($nl, 'domainFile', 'val'=>$focndomain); + + my $ocn_str = 'null'; + if (!$aqua_mode) { + $ocn_str = "docn.stream.txt $stream_year_first $stream_year_first $stream_year_last" ; + } + add_default($nl, 'streams', 'val'=> $ocn_str); + + if ($ocn_comp eq 'docn') { + add_default($nl, 'vectors', 'val'=>'null'); + } + elsif ($ocn_comp eq 'som') { + add_default($nl, 'fillalgo', 'val'=>'nn'); + add_default($nl, 'fillmask', 'val'=>'nomask'); + add_default($nl, 'mapalgo', 'val'=>'bilinear'); + add_default($nl, 'mapmask', 'val'=>'dstmask'); + add_default($nl, 'taxmode', 'val'=>'cycle'); + add_default($nl, 'tintalgo', 'val'=>'linear'); + } + + # Create docn.stream.txt + # ---------------------- + if (!$aqua_mode) { + my $outfile = "$opts{'dir'}/docn.stream.txt"; + $fh->open(">$outfile") or die "** can't open file: $outfile\n"; + + my $datasource = 'DATASET'; + if ($ocn_comp eq 'som') { $datasource = 'GENERIC';} + + + print $fh <<"EOF"; + + + + $datasource + + + + time time + xc lon + yc lat + area area + mask mask + + + $fsstdomain_path + + + $fsstdomain_file + + +EOF + if ($ocn_comp eq 'docn') { + print $fh <<"EOF"; + + + SST_cpl t + + + $sstdata_path + + + $sstdata_file + + + + +EOF + } + elsif ($ocn_comp eq 'som') { + print $fh <<"EOF"; + + + T t + S s + U u + V v + dhdx dhdx + dhdy dhdy + hblt h + qdp qbot + + + $sstdata_path + + + $sstdata_file + + + 0 + + + + +EOF + } + + $fh->close; + if ($print>=1) { print "Writing DOCN stream file to $outfile $eol"; } + + } # if (!$aqua_mode) + +} + +#----------------------------------------------------------------------------------------------- +# Rename component logfiles. +# +# This requires special handling because the logfiles are coordinated using +# share code. Each component is using shr_file_mod::shr_file_setIO to attach +# a unique Fortran unit to a named file. shr_file_setIO reads the namelist +# group /modelio/ and hence each component is using the same variable names. +# To work around this component specific names have been added to the special +# namelist group /camexp/. Check for those variables and write the component +# specific versions of /modelio/ to files whose names are hardwired in the top +# level component interface, e.g., atm_comp_mct, lnd_comp_mct, and seq_ccsm_drv. + +my @comps = qw(atm cpl lnd rof); +foreach my $comp (@comps) { + + my $logfile = "${comp}_logfile"; + my $logfiledir = "${comp}_logfile_diro"; + my $outfile = "${comp}_modelio.nml"; + + # check to see if user requests renaming this component logfile + my $logfile_val = $nl->get_variable_value('camexp', $logfile); + if (defined $logfile_val) { + + # create namelist object for /modelio/ + my $modelio = Build::Namelist->new("&modelio logfile=$logfile_val /"); + + # check whether a directory has been specified... if so add to namelist + my $logfiledir_val = $nl->get_variable_value('camexp', $logfiledir); + if (defined $logfiledir_val) { + $modelio->set_variable_value('modelio', 'diro', $logfiledir_val); + } + + # write the namelist to the component specific file + $modelio->write($outfile); + if ($print>=1) { print "Writing modelio namelist to $outfile $eol"; } + } +} + +#----------------------------------------------------------------------------------------------- +# Write output files + +# Get array of group names that have been defined in the namelist. +my @nl_groups = $nl->get_group_names(); + +# Temp vars reused for each component. +my @comp_groups; +my $outfile; + +# Create a hash with the group names as keys. This makes it easy to remove +# names from the list. +my %nl_group = (); +foreach my $name (@nl_groups) { $nl_group{$name} = ''; } + +# Write fixed sets of namelist groups for the components other than CAM. +# Remove the group names from %nl_group as they are written. + +# Driver +@comp_groups = qw(cime_driver_inst seq_cplflds_inparm seq_cplflds_userspec ccsm_pes + seq_infodata_inparm seq_timemgr_inparm prof_inparm papi_inparm pio_default_inparm); +$outfile = "$opts{'dir'}/drv_in"; +if ($cam_build) { + $nl->write($outfile, 'groups'=>\@comp_groups); + if ($print>=1) { print "Writing driver namelist to $outfile $eol"; } +} +delete @nl_group{@comp_groups}; + +# Dry deposition and MEGAN VOC emis namelists +@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm); +$outfile = "$opts{'dir'}/drv_flds_in"; +$nl->write($outfile, 'groups'=>\@comp_groups); +if ($print>=1) { print "CAM writing dry deposition namelist to drv_flds_in $eol"; } +delete @nl_group{@comp_groups}; + +# Ocean component (dom, docn, or aquaplanet) +if ($ocn_comp eq 'dom') { + @comp_groups = qw(dom_inparm); + $outfile = "$opts{'dir'}/ocn_in"; +} +elsif ($ocn_comp eq 'docn' or $ocn_comp eq 'som') { + @comp_groups = qw(docn_nml shr_strdata_nml); + $outfile = "$opts{'dir'}/docn_in"; +} +elsif ($ocn_comp eq 'aquaplanet') { + @comp_groups = qw(aquap_nl); + $outfile = "$opts{'dir'}/aquap_in"; +} +if (@comp_groups) { + $nl->write($outfile, 'groups'=>\@comp_groups); + delete @nl_group{@comp_groups}; + if ($print>=1) { print "Writing ocean component namelist to $outfile $eol"; } +} + +# CAM +# +# Have removed the group names for components not associated with CAM, so write +# the remaining groups to the CAM namelist file. +# *** N.B. *** The assumption that all remaining groups belong to CAM allows adding +# new groups to CAM's definition file without requiring a code modification +# here to have that group written to the namelist file. + +# First remove the camexp group since it's a special purpose group that's not +# read by CAM +if (defined $nl_group{'camexp'}) { delete $nl_group{'camexp'}; } +@comp_groups = sort keys %nl_group; +$outfile = "$opts{'dir'}/atm_in"; +$nl->write($outfile, 'groups'=>\@comp_groups); +if ($print>=1) { print "CAM writing namelist to atm_in $eol"; } + +#----------------------------------------------------------------------------------------------- +# Test that input files exist locally. +if ($opts{'test'}) { + print "Checking whether input datasets exist locally...$eol"; + check_input_files($nl); +} + +# Write the input dataset filepaths to the file specified by $opts{'inputdata'}. +if ($opts{'inputdata'}) { + check_input_files($nl, $inputdata_rootdir, $opts{'inputdata'}); +} + +# END OF MAIN SCRIPT +#=============================================================================================== + +sub create_mode_defs { + +# create the list of strings used to define the MAM modes + + my $names = shift; # $names->[$m] - name of mode $m + my $types = shift; # $types->[$m] - type of mode $m + my $num = shift; # $num->[$m] - name of intersitial number m.r. for mode $m + my $num_cw = shift; # $num_cw->[$m] - name of cloud borne number m.r. for mode $m + my $num_src = shift; # $num_src->[$m] - source of interstitial number m.r. for mode $m + my $spec = shift; # $spec->[$m][$i] - name of interstitial species $i in mode $m + my $spec_type = shift; # $spec_type->[$m][$i] - type of species $i in mode $m + my $spec_cw = shift; # $spec_cw->[$m][$i] - name of cloud borne species $i in mode $m + my $spec_src = shift; # $spec_src->[$m][$i] - source of interstitial species $i in mode $m + + my $mode_def; + + # number of modes + my $nmodes = scalar(@$names); + my $aero_modes = "${nmodes}mode"; + + for (my $m=0; $m < $nmodes; ++$m) { + + # initial mode definition string + $mode_def .= "'$names->[$m]:$types->[$m]:=',"; + + # add the number mixing ratio field names. the source of the number conc + # of cloud borne aerosol defaults to N + $mode_def .= "'$num_src->[$m]:$num->[$m]:N:$num_cw->[$m]:num_mr:+',"; + + # number of species in mode + my $nspec = scalar(@{$spec->[$m]}); + for (my $i=0; $i < $nspec; ++$i) { + + my $term = ":+',"; # more species to come + if ($i == $nspec - 1) { + if ($m == $nmodes - 1) { + $term = "'"; # last specie and no more modes + } + else { + $term = "',"; # last specie but more modes to come + } + } + + # get default properties file + my $spec_name = $spec->[$m][$i]; + my %aero_modes_hash = ('mam'=>$aero_modes); + (my $constituent = $spec_name) =~ s/_.*//; + $constituent = substr( $constituent, 0, 3 ); + my $rel_filepath = get_default_value("mam_${constituent}",\%aero_modes_hash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + + # add species info. the source of the mixing ratio + # for cloud borne species defaults to N + $mode_def .= "'" . + $spec_src->[$m][$i] . ":" . + $spec->[$m][$i] . ":N:" . + $spec_cw->[$m][$i] . ":" . + $spec_type->[$m][$i] . ":" . + $abs_filepath . $term; + } + + + } + + return $mode_def; +} + +#=============================================================================================== +sub add_default { + +# Add a value for the specified variable to the specified namelist object. The variables +# already in the object have the higher precedence, so if the specified variable is already +# defined in the object then don't overwrite it, just return. +# +# This method checks the definition file and adds the variable to the correct +# namelist group. +# +# The value can be provided by using the optional argument key 'val' in the +# calling list. Otherwise a default value is obtained from the namelist +# defaults object. If no default value is found this method throws an exception +# unless the 'nofail' option is set true. +# +# Additional optional keyword=>value pairs may be specified. If the keyword 'val' is +# not present, then any other keyword=>value pairs that are specified will be used to +# match attributes in the defaults file. +# +# Example 1: Specify the default value $val for the namelist variable $var in namelist +# object $nl: +# +# add_default($nl, $var, 'val'=>$val) +# +# Example 2: Add a default for variable $var if an appropriate value is found. Otherwise +# don't add the variable +# +# add_default($nl, $var, 'nofail'=>1) +# +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object +# $inputdata_rootdir -- CCSM inputdata root directory + + my $nl = shift; # namelist object + my $var = shift; # name of namelist variable + my %opts = @_; # options + + my $val = undef; + + # Query the definition to find which group the variable belongs to. Exit if not found. + my $group = $definition->get_group_name($var); + unless ($group) { + my $fname = $definition->get_file_name(); + die "$ProgName - ERROR: variable \"$var\" not found in namelist definition file $fname.\n"; + } + + # check whether the variable has a value in the namelist object -- if so then return + $val = $nl->get_variable_value($group, $var); + if (defined $val) {return;} + + # Look for a specified value in the options hash + if (defined $opts{'val'}) { + $val = $opts{'val'}; + } + # or else get a value from namelist defaults object. + # Note that if the 'val' key isn't in the hash, then just pass anything else + # in %opts to the get_value method to be used as attributes that are matched + # when looking for default values. + else { + $val = get_default_value($var, \%opts); + } + + # if no value is found then exit w/ error (unless 'nofail' option set) + unless (defined $val) { + unless ($opts{'nofail'}) { + print "$ProgName - ERROR: No default value found for $var\n". + "user defined attributes:\n"; + foreach my $key (keys(%opts)) { + if ($key ne 'nofail' and $key ne 'val') { + print "key=$key val=$opts{$key}\n"; + } + } + die; + } + else { + return; + } + } + + # query the definition to find out if the variable is an input pathname + my $is_input_pathname = $definition->is_input_pathname($var); + + # The default values for input pathnames are relative. If the namelist + # variable is defined to be an absolute pathname, then prepend + # the CCSM inputdata root directory. + if ($is_input_pathname eq 'abs') { + $val = set_abs_filepath($val, $inputdata_rootdir); + } + + # Some complex namelist variables set in use cases may have "$INPUTDATA_ROOT" + # in the data path specifications. Subsitute the resolved path here for these cases. + $val =~ s/\$INPUTDATA_ROOT/$inputdata_rootdir/g ; + + # query the definition to find out if the variable takes a string value. + # The returned string length will be >0 if $var is a string, and 0 if not. + my $str_len = $definition->get_str_len($var); + + # If the variable is a string, then add quotes if they're missing + if ($str_len > 0) { + $val = quote_string($val); + } + + # set the value in the namelist + $nl->set_variable_value($group, $var, $val); +} + +#----------------------------------------------------------------------------------------------- + +sub get_default_value { + +# Return a default value for the requested variable. +# Return undef if no default found. +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $defaults -- the namelist defaults object +# $uc_defaults -- the use case defaults object + + my $var_name = lc(shift); # name of namelist variable (case insensitive interface) + my $usr_att_ref = shift; # reference to hash containing user supplied attributes + + # Check first in the use case defaults + if (defined $uc_defaults) { + my $val = $uc_defaults->get_value($var_name, $usr_att_ref); + if ($val) {return $val;} + } + + # Check in the namelist defaults + return $defaults->get_value($var_name, $usr_att_ref); + +} + +#----------------------------------------------------------------------------------------------- + +sub fv_decomp_set{ + +# Return a decomposition for the FV dycore, expressed as the value for the namelist +# variable npr_yz. The value of npr_yz is ny,nz,nx,ny where ny, nz, and nx are +# respecitively the number of y, z, and x subdomains in the multi-2D decomposition. +# The following constraints must be observed: +# 1) ny*nz = ntasks (ny*nz can be less than ntasks in the case that the dynamics runs +# on a subset of the total tasks. Assume the user will set the +# decomp explicitly if that is what is desired.) +# 2) nx=nz (this is an empirically determined constraint for efficiency in the +# dycore communications) +# 3) ny*3 <= nlat (these constraints are imposed by the dycore) +# nz <= nlev +# +# The strategy for setting the default decomposition is to use the smallest possible +# number of z subdomains. Start with 1 (which is the 1D decomposition). If that works +# then done. If not, increase nz, check that it divides ntasks, if so does resulting +# ny satisfy ny*3 <= nlat, if so then done. Etc. + + my $ntasks = $opts{'ntasks'}; + my $nlat = $cfg->get('nlat'); + my $nlev = $cfg->get('nlev'); + my ($ny, $nz); + + # die if bad input + if ($ntasks < 1) { + die "$ProgName - ERROR: fv_decomp_set: bad input: ntasks=$ntasks.\n" . + " -ntask argument to build-namelist is wrong."; + } + + NZ: for ($nz = 1; $nz <= $nlev; ++$nz) { + + # test that $nz divides $ntasks + if ($ntasks%$nz == 0) { + + $ny = $ntasks/$nz; + + # test that y subdomains contain at least 3 latitudes + # if so then done + if (3*$ny <= $nlat) {last NZ;} + } + } + + # die if algorithm failed + if ($nz > $nlev or $ny*$nz != $ntasks) { + die "$ProgName - ERROR: fv_decomp_set failed to find a decomposition.\n" . + " npr_yz needs to be set by the user."; + } + + return "$ny,$nz,$nz,$ny"; +} + +#----------------------------------------------------------------------------------------------- + +sub check_input_files { + +# For each variable in the namelist which is an input dataset, or contains filepaths +# for input datasets, either: +# 1) check to see if the input dataset exists on local disk, or +# 2) write the input dataset filepath to a file. +# +# In "test" mode (1) the routine is called with just one argument. +# In "inputdata" mode (2) the routine is called with three arguments. +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object + + my $nl = shift; # namelist object + my $inputdata_rootdir = shift; # if false prints test, else creates inputdata file + my $outfile = shift; + + my $fh; + if (defined $inputdata_rootdir) { + open $fh, '>', $outfile or die "check_input_files: error opening $outfile: $!"; + } + + # Look through all namelist groups + my @groups = $nl->get_group_names(); + foreach my $group (@groups) { + + # Look through all variables in each group + my @vars = $nl->get_variable_names($group); + foreach my $var (@vars) { + + # Is the variable an input dataset? + my $input_pathname_type = $definition->is_input_pathname($var); + + # If it is, check whether it exists locally and print status + if ($input_pathname_type) { + + # Get pathname of input dataset + my $pathname = $nl->get_variable_value($group, $var); + # Need to strip the quotes + $pathname =~ s/['"]//g; + + if ($input_pathname_type eq 'abs') { + if ($inputdata_rootdir) { + print $fh "$var = $pathname\n"; + } + else { + if (-e $pathname) { # use -e rather than -f since the absolute pathname + # might be a directory + print "OK -- found $var = $pathname\n"; + } + else { + print "NOT FOUND: $var = $pathname\n"; + } + } + } + elsif ($input_pathname_type =~ m/rel:(.+)/o) { + # The match provides the namelist variable that contains the + # root directory for a relative filename + my $rootdir_var = $1; + my $rootdir = $nl->get_variable_value($group, $rootdir_var); + $rootdir =~ s/['"]//g; #"' + if ($inputdata_rootdir) { + $pathname = "$rootdir/$pathname"; + print $fh "$var = $pathname\n"; + } + else { + if (-f "$rootdir/$pathname") { + print "OK -- found $var = $rootdir/$pathname\n"; + } + else { + print "NOT FOUND: $var = $rootdir/$pathname\n"; + } + } + } + } + } + } + + # Treat special cases... + + # These namelist variables are arrays of strings. + my @vars = qw(ext_frc_specifier srf_emis_specifier mode_defs rad_climate rad_diag_1 rad_diag_2 + rad_diag_3 rad_diag_4 rad_diag_5 rad_diag_6 rad_diag_7 rad_diag_8 + rad_diag_9 rad_diag_10); + + foreach my $var (@vars) { + + # Is the variable in the namelist? + my $value = $nl->get_value($var); + if (defined $value) { + + # The current namelist parser stores all values as a single + # string, so start by extracting each quoted string. + + while ($value =~ m/['"] # opening quote + ([^'"]+) # capture all non-quote characters up to + ['"] # closing quote + (.*) # capture rest of string including newlines + /sxo) { # the s modifier lets . match newlines + my $spec = $1; + $value = $2; + + # Look for values of the form 'name -> filepath' + # Extract name and filename + if ($spec =~ m/\s*(\w+) # name of species preceded by optional whitespace + \s*->\s* # -> separator surrounded by optional whitespace + (\S+) # filename (all characters up to optional whitespace) + /xo) { + my $name = $1; + my $file = $2; + + # look for coefficient multiplier proceeding the filepath in the form ' X * filepath ' + if ($file =~ m/\s*(\w+) # coeffecient preceded by optional whitespace + \s*\*\s* # '*' separator surrounded by optional whitespace + (\S+) # filepath (all characters up to optional whitespace) + /xo) { + my $coef = $1; + $file = $2; + } + + if ($inputdata_rootdir) { + print $fh "$var for $name = $file\n"; + } + else { + if (-f $file) { + print "OK -- found $var for $name = $file\n"; + } + else { + print "NOT FOUND: $var for $name = $file\n"; + } + } + } + # Look for values that begin with 'X:name:name2' where X is one of [AMN] + # Extract name and filename + elsif ($spec =~ m/^\s*[AMN]:(\w+) # name of species preceded by optional whitespace and X: + : # : separator + (\S+) # name2 + /xo) { + my $name = $1; + my $name2 = $2; + + # If $name2 starts with a slash, then it is an absolute filepath. + # If $name2 starts with a $, then it is an unresolved filepath + # (generated when run from CCSM scripts). + # Otherwise check for more fields + if ($name2 =~ m:^[/\$]:) { + + my $file = $name2; + if ($inputdata_rootdir) { + print $fh "$var for $name = $file\n"; + } + else { + if (-f $file) { + print "OK -- found $var for $name = $file\n"; + } + else { + print "NOT FOUND: $var for $name = $file\n"; + } + } + } + else { + # If this value is from a mode_defs string that defined + # a mode specie, then breaking it up into colon separated + # fields will provide a filepath in the 4rd field (index 3). + my @flds = split /:/, $name2; + if (scalar(@flds) >= 4) { + + if ($flds[3] =~ m:^[/\$]:) { + + my $file = $flds[3]; + if ($inputdata_rootdir) { + print $fh "$var for $name = $file\n"; + } + else { + if (-f $file) { + print "OK -- found $var for $name = $file\n"; + } + else { + print "NOT FOUND: $var for $name = $file\n"; + } + } + } + } + } + + } + # Look for values that end with "=". These are the initial strings in mode + # definitions and should just be ignored. + elsif ($spec =~ m/^\s*(\S+)=\s*$/) { # string which ends with "=" and has optional + # begining and trailing whitespace + # ignore it + } + else { + print "Failed to parse \'$spec\'\n"; + } + + } # end of while loop + } + } + + close $fh if defined $inputdata_rootdir; + + return 0; +} + +#----------------------------------------------------------------------------------------------- + +sub strip_rootdir { + +# Strip a root directory from the begining of a filepath. +# Allow for the possibility that the root directory is specified as a shell variable +# to support a CCSM script requirement. + + my ($filepath, $rootdir) = @_; + + # Check whether the rootdir is specified as a shell variable. + if ($rootdir =~ m/^\$(\w*)/) { + + my $rootname = $1; + + # Strip off the root directory with the following regexp that + # avoids the problem of $rootdir being interpolated to a scalar variable + # name... + #$filepath =~ s:^\$$rootname::; + + # The CCSM scripts are currently set up to expect the shell variable in the + # output file that contains the list of inputdata files. So in this case + # do nothing. + + } + else { + # Strip off the rootdir specified as a resolved pathname + $filepath =~ s:^$rootdir::; + } + return $filepath; +} + +#----------------------------------------------------------------------------------------------- + +sub set_abs_filepath { + +# check whether the input filepath is an absolute path, and if it isn't then +# prepend a root directory + + my ($filepath, $rootdir) = @_; + + # strip any leading/trailing whitespace + $filepath =~ s/^\s+//; + $filepath =~ s/\s+$//; + $rootdir =~ s/^\s+//; + $rootdir =~ s/\s+$//; + + # strip any leading/trailing quotes + $filepath =~ s/^['"]+//; + $filepath =~ s/["']+$//; + $rootdir =~ s/^['"]+//; + $rootdir =~ s/["']+$//; + + my $out = $filepath; + unless ( $filepath =~ /^\// ) { # unless $filepath starts with a / + $out = "$rootdir/$filepath"; # prepend the root directory + } + return $out; +} + +#----------------------------------------------------------------------------------------------- + + +sub absolute_path { +# +# Convert a pathname into an absolute pathname, expanding any . or .. characters. +# Assumes pathnames refer to a local filesystem. +# Assumes the directory separator is "/". +# + my $path = shift; + my $cwd = getcwd(); # current working directory + my $abspath; # resulting absolute pathname + +# Strip off any leading or trailing whitespace. (This pattern won't match if +# there's embedded whitespace. + $path =~ s!^\s*(\S*)\s*$!$1!; + +# Convert relative to absolute path. + + if ($path =~ m!^\.$!) { # path is "." + return $cwd; + } elsif ($path =~ m!^\./!) { # path starts with "./" + $path =~ s!^\.!$cwd!; + } elsif ($path =~ m!^\.\.$!) { # path is ".." + $path = "$cwd/.."; + } elsif ($path =~ m!^\.\./!) { # path starts with "../" + $path = "$cwd/$path"; + } elsif ($path =~ m!^[^/]!) { # path starts with non-slash character + $path = "$cwd/$path"; + } + + my ($dir, @dirs2); + my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls + # This enables correct processing of the input "/". + + # Remove any "" that are not leading. + for (my $i=0; $i<=$#dirs; ++$i) { + if ($i == 0 or $dirs[$i] ne "") { + push @dirs2, $dirs[$i]; + } + } + @dirs = (); + + # Remove any "." + foreach $dir (@dirs2) { + unless ($dir eq ".") { + push @dirs, $dir; + } + } + @dirs2 = (); + + # Remove the "subdir/.." parts. + foreach $dir (@dirs) { + if ( $dir !~ /\.\./ ) { + push @dirs2, $dir; + } else { + pop @dirs2; # remove previous dir when current dir is .. + } + } + if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; } + $abspath = join '/', @dirs2; + return( $abspath ); +} + +#------------------------------------------------------------------------------- + +sub valid_option { + + my ($val, @expect) = @_; + my ($expect); + + $val =~ s/^\s+//; + $val =~ s/\s+$//; + foreach $expect (@expect) { + if ($val =~ /^$expect$/i) { return $expect; } + } + return undef; +} + +#------------------------------------------------------------------------------- + +sub validate_use_case { + + my $source = shift; # text string declaring the source of the options being validated + my $opts = shift; # reference to hash that contains the options + + my ($opt, $old, @expect); + + # use_case + $opt = 'use_case'; + if (defined $opts->{$opt}) { + + # create the @expect array by listing the files in $use_case_dir + # and strip off the ".xml" part of the filename + @expect = (); + my @files = glob("$opts->{'use_case_dir'}/*.xml"); + foreach my $file (@files) { + $file =~ m{.*/(.*)\.xml}; + push @expect, $1; + } + + $old = $opts->{$opt}; + $opts->{$opt} = valid_option($old, @expect) + or die "$ProgName - ERROR: invalid value of $opt ($old) specified in $source\n". + "expected one of: @expect\n"; + } + +} + +#------------------------------------------------------------------------------- + +sub quote_string { + my $str = shift; + $str =~ s/^\s+//; + $str =~ s/\s+$//; + unless ($str =~ /^['"]/) { #"' + $str = "\'$str\'"; + } + return $str; +} + +#------------------------------------------------------------------------------- + +sub version { +# The version is found in CAM's ChangeLog file. +# $cfgdir is set by the configure script to the name of its directory. + + my ($cfgdir) = @_; + + my $logfile = "$cfgdir/../doc/ChangeLog"; + + my $fh = IO::File->new($logfile, '<') or die "** $ProgName - ERROR: can't open ChangeLog file: $logfile\n"; + + while (my $line = <$fh>) { + + if ($line =~ /^Tag name:\s*(\w+)/ ) { + print "$1\n"; + last; + } + } + +} + +#------------------------------------------------------------------------------- diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml new file mode 100644 index 0000000000..3510c7b3d0 --- /dev/null +++ b/bld/config_files/definition.xml @@ -0,0 +1,314 @@ + + + + + + + +CAM build directory; contains .o and .mod files. + + +Directory where CAM executable will be created. + + +Root directory of CAM source distribution + + +Root directory of CAM model source.. + + +User source directories to prepend to the filepath. Multiple directories +are specified as a comma separated list with no embedded white space. + + +Switch specifies whether CAM is being built by the CCSM sequential scripts. 0 => no, 1 => yes. + + +Component interfaces: mct or esmf. Default: mct. + + +Dynamics package: eul, fv, or se. + + +Switch to turn on waccm physics: 0 => no, 1 => yes. + + +Switch to turn on FV offline driver: 0 => no, 1 => yes. + + + Offline unit driver: + aur : aurora module unit test + rad : radiation offline unit driver + stub : stub offline unit driver + + +Switch to turn on analytic initial conditions for the dynamics state: + 0 => no + 1 => yes. + + +Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes + + +Ionosphere model used in WACCMX. + + +Physics package: cam3, cam4, cam5, cam6, held_suarez, adiabatic, spcam_sam1mom, spcam_m2005. + + +Microphysics package: rk (Rasch and Kristjansson), mg1 and mg2 (Morrison and Gettelman), +SPCAM_m2005, SPCAM_sam1mom. + + +Macrophysics package: RK, Park, CLUBB_SGS, SPCAM_sam1mom, SPCAM_m2005. + + +Switch to turn on CLUBB_SGS package: 0 => no, 1 => yes + + +Switch to turn on UNICON package: 0 => off, 1 => on + + +Switch to turn on/off advecting CLUBB moments: 0 => no, 1 => yes + + +Switch to turn on/off parameterization for sub-grid scale convective organization for the ZM deep convective scheme based +on Mapes and Neale (2011): 0 => no, 1 => yes + + +PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr + (Holtslag, Boville, and Rasch), clubb_sgs, spcam_sam1om, spcam_m2005, none. + + +Radiative transfer calculation: +camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER). + + +CARMA sectional microphysics: +none (disabled), bc_strat (Stratospheric Black Carbon), cirrus (Cirrus Clouds), +cirrus_dust (Cirrus Clouds with dust), dust (Dust), meteor_impact (Meteor Impact), +meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Polar Mesospheric Clouds), pmc_sulfate (PMC and Sulfate), sea_salt (Sea Salt), +sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust), +test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam). + + +Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_bam trop_ghg waccm_ma waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt waccm_tsmlt_mam4 waccm_tsmlt_sulfur super_fast_llnl super_fast_llnl_mam3 terminator none + + +Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 + + +Switch to allow user to edit chem mechanism file: 0 => no, 1 => yes. + + +Path and file name of the user supplied chemistry mechanism file. + + +Switch to force the build of the chemistry preprocessor. + + +Chemistry preprocessor build directory; contains .o and .mod files. + + +Chemistry source directory generated by the chemistry preprocessor; contains F90 files. + + +Chemistry source directory; contains F90 files. + + +Use data ocean model (docn or dom), stub ocean (socn), or aqua planet ocean +(aquaplanet) in cam build. When built from the CESM scripts the value of +ocn may be set to pop. This doesn't impact how CAM is built, only how +attributes are matched when searching for namelist defaults. If ocn is set +to som then the docn component is used. + + +Switch for aquaplanet mode. By default this switch sets the ocn component +to use an analytic expression for SST. To use aquaplanet with time varying +SSTs read from a dataset, or with a slab ocean, the ocean component should +be set to DOCN. + + +Turn on CO2 cycle in biogeochemistry model: 0 => no, 1 => yes. + + +Modifications that allow perturbation growth testing: 0=off, 1=on. + + +Configure CAM for single column mode: 0=off, 1=on. This option only +supported for the Eulerian dycore. + + +Configure CAM to generate an IOP file that can be used to drive SCAM: 0=no, 1=yes. +This option only supported for the Eulerian dycore. + + +Horizontal grid specifier. The recognized values depend on +the dynamics type and are contained in the horiz_grid.xml file. + + +Number of unique longitude points in rectangular lat/lon grid. + + +Number of unique latitude points in rectangular lat/lon grid. + + +Number of elements along one edge of a cubed sphere grid. + + +Number of points on each edge of the elements in a cubed sphere grid. + + +Number of physics grid cells on each edge of the elements in a cubed sphere grid. + + +Number of vertical levels. + + +Total number of advected constituents. By default this is computed by +configure. However, configure has a commandline argument to allow the user +to override the default. + + +Total number of advected test tracers. + + +Switch on (off) age of air tracers: 0=off, 1=on. + + +Maximum number of constituents that are radiatively active or in any one +diagnostic list. + + +Maximum Fourier wavenumber. + + +Highest degree of the Legendre polynomials for m=0. + + +Highest degree of the associated Legendre polynomials. + + +Maximum number of columns in a chunk (physics data structure). + + +Maximum number of sub-columns in a column (physics data structure). + + +Name of CAM executable. + + +User specified CPP defines to append to Makefile defaults. + + +User specified C compiler overrides Makefile default (linux only). + + +User specified C compiler options to append to Makefile defaults. + + +User specified Fortran compiler overrides Makefile default. + + +Type of Fortran compiler. Used when -fc specifies a generic wrapper script +such as mpif90 or ftn. + + +Switch to enable debugging options for Fortran compiler: 0=off, 1=on. + + +User specified Fortran compiler flags to append to Makefile defaults. + + +User specified Fortran optimization flags to override Makefile defaults. + + +User specified linker. Overrides the Makefile default $(FC). + + +User specified load options to append to Makefile defaults. + + +Switch to enable or disable building SPMD version of CAM: 0=off, 1=on. + + +Switch to enable or disable building SMP version (OPENMP) of CAM: 0=off, 1=on. + + +Directory containing NetCDF include files. + + +Directory containing NetCDF library. + + +Arguments for linking NetCDF libraries. + + +Directory containing NetCDF module files. + + +Directory containing pNetCDF include files. + + +Directory containing pNetCDF library. + + +Directory containing LAPACK library. + + +Directory containing ESMF library (for linking to external ESMF). + + +Version of ESMF library. + + +Directory containing MCT library (for linking to external MCT). + + +Directory containing MPI include files. + + +Directory containing MPI library. + + +Name of MPI library. + + +Directory where PIO will be built (pio2 only). + + +Directory containing PIO libraries and include files (pio2 only). + + +Switch to enable building COSP simulator package. 1 => build COSP. + + +Directory containing COSP library. + + +OS for which CAM is being built. The default value is the name contained +in Perl's $OSNAME variable. This parameter allows the user to override +that setting to allow for cross-compilation, and for instances where the +$OSNAME value is too generic. For example, currently on both cray-xt and +bluegene systems $OSNAME has the value "linux". + + +Switch to turn on SPCAM version of CLUBB_SGS package: 0 => no, 1 => yes + + +SPCAM number of grid points in x + + +SPCAM number of grid points in y + + +SPCAM number of grid points in z + + +SPCAM horizontal grid spacing, m + + +SPCAM time step, s + + + diff --git a/bld/config_files/definition.xsl b/bld/config_files/definition.xsl new file mode 100644 index 0000000000..1a23645190 --- /dev/null +++ b/bld/config_files/definition.xsl @@ -0,0 +1,37 @@ + + + + + + + + + + + + + Configuration Definition + + +

Configuration Definition

+ + + + + + +
NameValueDescription
+ + + + + + + + + + + + + + diff --git a/bld/config_files/horiz_grid.xml b/bld/config_files/horiz_grid.xml new file mode 100644 index 0000000000..19c8eab0fd --- /dev/null +++ b/bld/config_files/horiz_grid.xml @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/bld/configure b/bld/configure new file mode 100755 index 0000000000..c5b11ecfee --- /dev/null +++ b/bld/configure @@ -0,0 +1,3666 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# configure +# +# +# This utility allows the CAM user to specify compile-time configuration +# options via a commandline interface. The output from configure is a +# Makefile and a cache file that contains all configuration parameters +# required to produce the Makefile. A subsequent invocation of configure +# can use the cache file as input (via the -defaults argument) to reproduce +# the CAM configuration contained in it. Note that when a cache file is +# used to set default values only the model parameters are used. The +# parameters that are platform dependent (e.g., compiler options, library +# locations, etc) are ignored. +# +# As the build time configurable options of CAM are changed, this script +# must also be changed. Thus configure is maintained under revision +# control in the CAM source tree and it is assumed that only the version of +# configure in the source tree will be used to build CAM. Thus we assume +# that the root of the source tree can be derived from the location of this +# script. +# +# configure has an optional test mode to check that the Fortran90 compiler +# works and that external references to the netCDF and MPI libraries can be +# resolved at link time. +# +# +# Date Contributor Modification +# ----------------------------------------------------------------------------------------------------- +# 2012-09-10 Fischer Use MCT configure script, and build as seperate library. +# 2011-08-18 Eaton Produce a config.h file needed by the latest PIO and MCT source. +# +# 2011-08-05 Fischer Set number of instances when running cam stand alone. Otherwise use +# values set by CESM1 scripts. +# +# 2010-01-22 Kay, Eaton Added COSP simulator option. +# +# 2008-09-22 Edwards Removed obsolete macros DYN_STATE_INTERFACE and LSMLON, LSMLAT +# +# 2008-08-26 Edwards Added support for external pnetcdf library (-pnc_inc and -pnc_lib) as +# well as PIO support for Spectral Element dycore +# +# 2008-07-30 Eaton Revise the default calculation of nadv. Add new option to specify +# the number of test tracers. Add new option to specify a non-default +# microphysics option. +# +# 2007-04-13 Eaton Restore the commandline option -phys so that it can be used with the +# adiabatic and held_suarez physics options. +# +# 2007-03-04 Eaton The script has been refactored to move the generic configuration file +# functionality into a separate module (Build::Config). +# +# 2006-09-14 Eaton Add support for linking to external ESMF library. +# Deprecate interactive mode. +# +# 2006-02-14 Eaton Remove -cam_cfg option and CAM_CFGDIR environment variable: require all +# configuration files to be in the same directory as the configure script. +# Remove -cam_root option and CAM_ROOT environment variable: require +# configure to be located in the CAM src tree. +# Modifications for CCSM build: delete setting of locations for all +# external include/mod/lib directories. These are only needed for the +# CAM Makefile which is not produced when doing a CCSM build. +# Remove -esmf_* options. This was used with the ESMF prototype +# library which is no longer supported. Will re-implement ESMF options +# when we start linking the new ESMF library. +# +# 2005-05-05 Eaton Add -lapack_libdir option to specify directory that contains +# lapack and blas libraries. Can also set LAPACK_LIBDIR environment +# variable. Currently only used by waccm_mozart on IBM. +# +# 2004-12-01 Eaton Add phys option waccm. Because this must be consistent +# with the -chem option, remove commandline option -phys. +# phys="waccm" is needed so that WACCM specific initial files +# can be present in DefaultCAMEXPNamelist.xml. +# +# 2004-11-15 Eaton Add -chem options waccm_ghg or waccm_mozart. Remove old code +# for ccm366 and lsm options. +# +# 2002-05-03 Brian Eaton Original version +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use Cwd; +use English; +use Getopt::Long; +use IO::File; +use IO::Handle; + +use FindBin qw($Bin); +use lib "$Bin/perl5lib"; +use Build::ChemPreprocess qw(chem_preprocess chem_number_adv); +use File::Copy; + +#----------------------------------------------------------------------------------------------- + +sub usage { + die <). Any value that contains + white-space must be quoted. Long option names may be supplied with either single + or double leading dashes. A consequence of this is that single letter options may + NOT be bundled. + + Options used to determine the CAM model configuration. These options will have an + effect whether running CAM as part of CCSM or running in a CAM standalone mode: + + -[no]age_of_air_trcs Switch on [off] age of air tracers. Default: on for waccm_phys, otherwise off. + -analytic_ic Enables the (namelist controlled) dycore testing infrastructure + -aquaplanet Switch on aqua-planet mode. + -build_chem_proc Switch forces the build of the chemistry preprocessor (primarily for testing). + -carma Build CAM with specified CARMA microphysics model + [ none | bc_strat | cirrus | cirrus_dust | dust | meteor_impact | + meteor_smoke | mixed_sulfate | pmc | pmc_sulfate | sea_salt | sulfate | tholin | + test_detrain | test_growth | test_passive | test_radiative | test_swelling | + test_tracers, test_tracers2]. + Default: none. + -chem Build CAM with specified prognostic chemistry package + [ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_vbs | + trop_bam | trop_ghg | waccm_ma | waccm_mad_mam4 | waccm_ma_mam4 | + waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt | waccm_tsmlt_mam4 | + waccm_tsmlt_sulfur | super_fast_llnl | super_fast_llnl_mam3 | terminator | none ]. + Default: trop_mam4 for cam6 and trop_mam3 for cam5. + -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off. + -clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off. + Current option is: clubb_do_adv (Advect CLUBB moments) + -co2_cycle This option is meant to be used with the -ccsm_seq option. It modifies the + CAM configuration by increasing the number of advected constituents by 4. + -cosp Enable the COSP simulator. + -cppdefs A string of user specified CPP defines. Appended to + Makefile defaults. E.g. -cppdefs '-DVAR1 -DVAR2' + -dyn Dynamical core option: [eul | fv | se]. Default: fv. + -edit_chem_mech Invokes CAMCHEM_EDITOR to allow the user to edit the chemistry mechanism file + -hgrid Specify horizontal grid. Use nlatxnlon for spectral grids; + dlatxdlon for fv grids (dlat and dlon are the grid cell size + in degrees for latitude and longitude respectively); nexnp for + se grids. + -ionosphere Ionophere module used in WACCMX [ none | wxi | wxie ]. + -macrophys Specify the macrophysics option [rk | park | clubb_sgs]. + -max_n_rad_cnst Maximum number of constituents that are either radiatively + active, or in any single diagnostic list for the radiation. + -microphys Specify the microphysics option [mg1 | mg2 | rk]. + -nadv Set total number of advected species to . + -nadv_tt Set number of advected test tracers . + -nlev Set number of levels to . + -offline_dyn Switch enables the use of offline driver for FV dycore. + -pbl Specify the PBL option [uw | hb | hbr]. + -pcols Set maximum number of columns in a chunk to . + -pergro Switch enables building CAM for perturbation growth tests. + -phys Physics option [cam3 | cam4 | cam5 | cam6 | held_suarez | adiabatic | kessler | + spcam_sam1mom | spcam_m2005]. Default: cam6 + -prog_species Comma-separate list of prognostic mozart species packages. + Currently available: DST,SSLT,SO4,GHG,OC,BC,CARBON16 + -psubcols Maximum number of sub-columns in a run - set to 1 if not using sub-columns (default) + -rad Specify the radiation package [rrtmg | camrt] + -spcam_clubb_sgs Turn on the SPCAM version of CLUBB + -spcam_nx SPCAM x-grid. - defaults to 4 (note the CRM requires spcam_nx to be greater than or equal to 4) + -spcam_ny SPCAM y-grid. - defaults to 1 + -spcam_dx SPCAM horizontal grid spacing. + -spcam_dt SPCAM timestep. + -unicon Switch to turn on the UNICON scheme. Default: off. + -usr_mech_infile Path and file name of the user supplied chemistry mechanism file. + -waccm_phys Switch enables the use of WACCM physics in any chemistry configuration. + The user does not need to set this if one of the waccm chemistry options + is chosen. + -waccmx Build CAM/WACCM with WACCM upper Thermosphere/Ionosphere extended package + -zmconv_org Include parameterization for sub-grid scale convective organization for the ZM deep convective scheme based + on Mapes and Neale (2011) + + + Options relevent to SCAM mode: + + -camiop Configure CAM to generate an IOP file that can be used to drive SCAM. + This switch only works with the Eulerian dycore. + -scam Compiles model in single column mode. Only works with Eulerian dycore. + + CAM parallelization: + + -[no]smp Switch on [off] SMP parallelism. + -[no]spmd Switch on [off] SPMD parallelism. + + Configure options: + + -cache Name of output cache file (default: config_cache.xml). + -cachedir Name of directory where output cache file is written (default: CAM build directory). + -ccsm_seq Switch to specify that CAM is being built from within sequential CCSM scripts. + -help [or -h] Print usage to STDOUT. + -silent [or -s] Turns on silent mode - only fatal messages issued. + -test Switch on testing of Fortran compiler and external libraries. + -verbose [or -v] Turn on verbose echoing of settings made by configure. + -version Echo the CVS tag name used to check out this CAM distribution. + + Options for surface components used in standalone CAM mode: + + -ocn Build CAM with ocean model [docn | dom | som | socn | aquaplanet | pop]. Default: aquaplanet + + Options for building CAM via standalone scripts: + + -cam_bld Directory where CAM will be built. This is where configure will write the + output files it generates (Makefile, Filepath, etc...) + -cam_exe Name of the CAM executable (default: cam). + -cam_exedir Directory where CAM executable will be created (default: CAM build directory). + -cc User specified C compiler (linux only). Overrides Makefile default. + -cflags A string of user specified C compiler options. Appended to + Makefile defaults. + -debug Switch to turn on building CAM with debugging compiler options. + -cosp_libdir Directory containing COSP library. + -esmf_libdir Directory containing ESMF library and esmf.mk file. + -fc User specified Fortran compiler. Overrides Makefile default. + -fc_type Type of Fortran compiler [pgi | intel | gnu | pathscale + | ibm | nag]. This argument is used in conjunction + with the -fc argument when the name of the fortran + compiler refers to a wrapper script (e.g., mpif90 + or ftn). In this case the user needs to specify + the type of Fortran compiler that is being invoked + by the wrapper script. Default: pgi + -fflags A string of user specified Fortran compiler flags. Appended to + Makefile defaults. See -fopt to override optimization flags. + -fopt A string of user specified Fortran compiler optimization flags. + Overrides Makefile defaults. + -gmake Name of the GNU make program on your system. Supply the absolute + pathname if the program is not in your path (or fix your path). + -lapack_libdir + Directory containing LAPACK library. + -ldflags A string of user specified load options. Appended to + Makefile defaults. + -linker User specified linker. Overrides Makefile default of \$(FC). + -mct_libdir Directory containing MCT library. Default: build the library from source + in a subdirectory of \$cam_bld. + -mpi_inc Directory containing MPI include files. + -mpi_lib Directory containing MPI library. + -nc_inc Directory containing netCDF include files. + -nc_lib Directory containing netCDF library. + -nc_mod Directory containing netCDF module files. + -pio2 Switch to turn on building PIO2. PIO2 is built as a separate library. + Default: Use PIO1 and build as part of cam executable. + -pio2_install_dir Directory to install PIO2 libraries and include files. If the libraries + already exist then configure will use them in the build. + -pnc_inc Directory containing PnetCDF include files. + -pnc_lib Directory containing PnetCDF library. + -target_os Override the os setting for cross platform compilation [aix | darwin | dec_osf | + irix | linux | solaris | super-ux | unicosmp | bgl | bgp | bgq]. + Default: OS on which configure is executing as defined by the + perl \$OSNAME variable. + -usr_src [,[,[...]]] + Directories containing user source code. + -offline_drv Specify offline unit driver [ aur | rad | stub ] + +EOF +} + +#----------------------------------------------------------------------------------------------- +# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging. It forces the test +# descriptions to be printed to STDOUT before the error messages start. + +*STDOUT->autoflush(); + +#----------------------------------------------------------------------------------------------- +# Set the directory that contains the CAM configuration scripts. If the configure command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script is in + # the user's PATH +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +if ($ProgDir) { + $cfgdir = absolute_path($ProgDir); +} else { + $cfgdir = $cwd; +} + +#----------------------------------------------------------------------------------------------- +# Save commandline +my $commandline = "$cfgdir/configure @ARGV"; + +#----------------------------------------------------------------------------------------------- +# Parse command-line options. +my %opts = ( + cache => "config_cache.xml", + ); +GetOptions( + "age_of_air_trcs!" => \$opts{'age_of_air_trcs'}, + "analytic_ic" => \$opts{'analytic_ic'}, + "aquaplanet" => \$opts{'aquaplanet'}, + "build_chem_proc" => \$opts{'build_chem_proc'}, + "cache=s" => \$opts{'cache'}, + "cachedir=s" => \$opts{'cachedir'}, + "carma=s" => \$opts{'carma'}, + "cam_bld=s" => \$opts{'cam_bld'}, + "cam_exe=s" => \$opts{'cam_exe'}, + "cam_exedir=s" => \$opts{'cam_exedir'}, + "camiop" => \$opts{'camiop'}, + "cc=s" => \$opts{'cc'}, + "ccsm_seq" => \$opts{'ccsm_seq'}, + "cflags=s" => \$opts{'cflags'}, + "chem=s" => \$opts{'chem'}, + "clubb_sgs!" => \$opts{'clubb_sgs'}, + "clubb_opts=s" => \$opts{'clubb_opts'}, + "co2_cycle" => \$opts{'co2_cycle'}, + "cosp" => \$opts{'cosp'}, + "cosp_libdir=s" => \$opts{'cosp_libdir'}, + "cppdefs=s" => \$opts{'cppdefs'}, + "spcam_clubb_sgs" => \$opts{'spcam_clubb_sgs'}, + "debug" => \$opts{'debug'}, + "dyn=s" => \$opts{'dyn'}, + "edit_chem_mech" => \$opts{'edit_chem_mech'}, + "esmf_libdir=s" => \$opts{'esmf_libdir'}, + "fc=s" => \$opts{'fc'}, + "fc_type=s" => \$opts{'fc_type'}, + "fflags=s" => \$opts{'fflags'}, + "fopt=s" => \$opts{'fopt'}, + "gmake=s" => \$opts{'gmake'}, + "h|help" => \$opts{'help'}, + "hgrid=s" => \$opts{'hgrid'}, + "ionosphere=s" => \$opts{'ionosphere'}, + "lapack_libdir=s" => \$opts{'lapack_libdir'}, + "ldflags=s" => \$opts{'ldflags'}, + "linker=s" => \$opts{'linker'}, + "macrophys=s" => \$opts{'macrophys'}, + "max_n_rad_cnst=s" => \$opts{'max_n_rad_cnst'}, + "mct_libdir=s" => \$opts{'mct_libdir'}, + "microphys=s" => \$opts{'microphys'}, + "mpi_inc=s" => \$opts{'mpi_inc'}, + "mpi_lib=s" => \$opts{'mpi_lib'}, + "nadv=s" => \$opts{'nadv'}, + "nadv_tt=s" => \$opts{'nadv_tt'}, + "nc_inc=s" => \$opts{'nc_inc'}, + "nc_lib=s" => \$opts{'nc_lib'}, + "nc_mod=s" => \$opts{'nc_mod'}, + "nlev=s" => \$opts{'nlev'}, + "ocn=s" => \$opts{'ocn'}, + "offline_dyn" => \$opts{'offline_dyn'}, + "pbl=s" => \$opts{'pbl'}, + "pcols=s" => \$opts{'pcols'}, + "p|pergro" => \$opts{'pergro'}, + "phys=s" => \$opts{'phys'}, + "pio2" => \$opts{'pio2'}, + "pio2_install_dir=s" => \$opts{'pio2_install_dir'}, + "pnc_inc=s" => \$opts{'pnc_inc'}, + "pnc_lib=s" => \$opts{'pnc_lib'}, + "prog_species=s" => \$opts{'prog_species'}, + "psubcols=s" => \$opts{'psubcols'}, + "rad=s" => \$opts{'rad'}, + "offline_drv=s" => \$opts{'offline_drv'}, + "scam" => \$opts{'scam'}, + "s|silent" => \$opts{'silent'}, + "smp!" => \$opts{'smp'}, + "spcam_nx=s" => \$opts{'spcam_nx'}, + "spcam_ny=s" => \$opts{'spcam_ny'}, + "spcam_dx=s" => \$opts{'spcam_dx'}, + "spcam_dt=s" => \$opts{'spcam_dt'}, + "spmd!" => \$opts{'spmd'}, + "target_os=s" => \$opts{'target_os'}, + "test" => \$opts{'test'}, + "unicon" => \$opts{'unicon'}, + "usr_mech_infile=s" => \$opts{'usr_mech_infile'}, + "usr_src=s" => \$opts{'usr_src'}, + "v|verbose" => \$opts{'verbose'}, + "version" => \$opts{'version'}, + "waccm_phys" => \$opts{'waccm_phys'}, + "waccmx" => \$opts{'waccmx'}, + "zmconv_org" => \$opts{'zmconv_org'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Echo version info. +version($cfgdir) if $opts{'version'}; + +# Check for unparsed argumentss +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +# Define 3 print levels: +# 0 - only issue fatal error messages +# 1 - only informs what files are created (default) +# 2 - verbose +my $print = 1; +if ($opts{'silent'}) { $print = 0; } +if ($opts{'verbose'}) { $print = 2; } +my $eol = "\n"; + +my %cfg = (); # build configuration + +#----------------------------------------------------------------------------------------------- +# Make sure we can find required perl modules and configuration files. +# Look for them in the directory that contains the configure script. + +# Check for the configuration definition file. +my $config_def_file = "config_files/definition.xml"; +(-f "$cfgdir/$config_def_file") or die <<"EOF"; +** Cannot find configuration definition file \"$config_def_file\" in directory \"$cfgdir\" ** +EOF + + +# Horizontal grid and spectral resolution parameters. +my $horiz_grid_file = 'config_files/horiz_grid.xml'; +(-f "$cfgdir/$horiz_grid_file") or die <<"EOF"; +** Cannot find horizonal grid parameters file \"$horiz_grid_file\" in directory \"$cfgdir\" ** +EOF + +# The XML::Lite module is required to parse the XML configuration files. +(-f "$cfgdir/perl5lib/XML/Lite.pm") or die <<"EOF"; +** Cannot find perl module \"XML/Lite.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +# The Build::Config module provides utilities to store and manipulate the configuration. +(-f "$cfgdir/perl5lib/Build/Config.pm") or die <<"EOF"; +** Cannot find perl module \"Build/Config.pm\" in directory \"$cfgdir/perl5lib\" ** +EOF + +if ($print>=2) { print "CAM configuration script directory: $cfgdir$eol"; } + +#----------------------------------------------------------------------------------------------- +# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules +unshift @INC, "$cfgdir/perl5lib"; +unshift @INC, "$cfgdir"; +require XML::Lite; +require Build::Config; + +# Initialize the configuration. The $config_def_file provides the definition of a CAM +# configuration. $cfg_ref is a reference to the new configuration object. +my $cfg_ref = Build::Config->new("$cfgdir/$config_def_file"); + +#----------------------------------------------------------------------------------------------- +# Building from within ccsm scripts? +my $ccsm_seq = (defined $opts{'ccsm_seq'}) ? 1 : 0; +$cfg_ref->set('ccsm_seq', $ccsm_seq); + +# Note that when building within the CESM scripts the CAM Makefile is not written +# since the CESM build does not use it. Many of the checks to ensure that a working +# CAM Makefile is produced are disabled when the ccsm option is set. Use the $cam_build +# variable to turn on CAM specific tests. +my $cam_build = 1; +if (($ccsm_seq)) { + $cam_build = 0; +} + +#----------------------------------------------------------------------------------------------- +# CAM root directory. +# Check for standalone or CESM checkout +my $cam_root = absolute_path("$cfgdir/.."); +my $cam_dir = $cam_root; +if (! -d "$cam_root/cime") { + $cam_root = absolute_path("$cfgdir/../../.."); +} +if (-d "$cam_root/components/cam/src") { + $cfg_ref->set('cam_root', $cam_root); + $cam_dir = "$cam_root/components/cam"; + $cfg_ref->set('cam_dir', $cam_dir); +} +elsif (-d "$cam_root/src") { + $cfg_ref->set('cam_root', $cam_root); + $cfg_ref->set('cam_dir', $cam_dir); +} else { + die <<"EOF"; +** Invalid CAM root directory: $cam_root +** +** The CAM root directory must contain the subdirectory components/cam/src/ +** (CESM checkout) or the subdirectory src (standalone checkout). +** For CESM checkouts, it is derived from "config_dir/../../..". +** For CAM standalone checkouts, it is derived from"config_dir/..", +** where config_dir is the directory in the CAM distribution that +** contains the configuration scripts. +** scripts. +EOF +} + +if ($print>=2) { print "CAM root directory: $cam_root$eol"; } + +#----------------------------------------------------------------------------------------------- +# CAM build directory. +my $cam_bld; +if (defined $opts{'cam_bld'}) { + $cam_bld = absolute_path($opts{'cam_bld'}); +} +else { # use default value + $cam_bld = absolute_path($cfg_ref->get('cam_bld')); +} + +if (-d $cam_bld or mkdirp($cam_bld)) { + # If the build directory exists or can be made then set the value... + $cfg_ref->set('cam_bld', $cam_bld); +} +else { + die <<"EOF"; +** Could not create the specified CAM build directory: $cam_bld +EOF +} + +if ($print>=2) { print "CAM build directory: $cam_bld$eol"; } + +#----------------------------------------------------------------------------------------------- +# CAM install directory. +my $cam_exedir; +if (defined $opts{'cam_exedir'}) { + $cam_exedir = absolute_path($opts{'cam_exedir'}); +} +else { # use default value + $cam_exedir = absolute_path($cfg_ref->get('cam_exedir')); +} + +if ($cam_build) { + + if (-d $cam_exedir or mkdirp($cam_exedir)) { + # If the install directory exists or can be made then set the value... + $cfg_ref->set('cam_exedir', $cam_exedir); + } else { + die <<"EOF"; +** Could not create the specified CAM installation directory: $cam_exedir +EOF + } + + if ($print>=2) { print "CAM executable will be created in: $cam_exedir$eol"; } +} + +#----------------------------------------------------------------------------------------------- +# User source directories. +my $usr_src = ''; +if (defined $opts{'usr_src'}) { + my @dirs = split ',', $opts{'usr_src'}; + my @adirs; + while ( my $dir = shift @dirs ) { + if (-d "$dir") { + push @adirs, absolute_path($dir); + } else { + die "** User source directory does not exist: $dir\n"; + } + } + $usr_src = join ',', @adirs; + $cfg_ref->set('usr_src', $usr_src); +} + +if ($print>=2) { print "User source directories: $usr_src$eol"; } + +#----------------------------------------------------------------------------------------------- +# configuration cache directory and file. +my $config_cache_dir; +my $config_cache_file; +if (defined $opts{'cachedir'}) { + $config_cache_dir = absolute_path($opts{'cachedir'}); +} +else { + $config_cache_dir = $cfg_ref->get('cam_bld'); +} + +if (-d $config_cache_dir or mkdirp($config_cache_dir)) { + $config_cache_file = "$config_cache_dir/$opts{'cache'}"; +} else { + die <<"EOF"; +** Could not create the specified directory for configuration cache file: $config_cache_dir +EOF +} + +if ($print>=2) { print "Configuration cache file: $config_cache_file$eol"; } + +#----------------------------------------------------------------------------------------------- +# Platform properties ########################################################################## +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# Determine target OS -- allow cross compilation only if target_os is specified on commandline. +my $target_os = $OSNAME; +if (defined $opts{'target_os'}) { + $target_os = $opts{'target_os'}; +} +$cfg_ref->set('target_os', $target_os); + +if ($print>=2) { print "Target OS: $target_os$eol"; } + +#----------------------------------------------------------------------------------------------- +# SPMD +my $spmd_val = 0; +if (defined $opts{'spmd'}) { + $spmd_val = $opts{'spmd'}; +} +$cfg_ref->set('spmd', $spmd_val); + +my $spmd = $spmd_val ? 'ON': 'OFF'; +if ($print>=2) { print "SPMD parallelism: $spmd$eol";} + +#----------------------------------------------------------------------------------------------- +# SMP +my $smp_val = 0; +if (defined $opts{'smp'}) { + $smp_val = $opts{'smp'} +} +$cfg_ref->set('smp', $smp_val); + +my $smp = $smp_val ? 'ON': 'OFF'; +if ($print>=2) { print "SMP parallelism: $smp$eol";} + +#----------------------------------------------------------------------------------------------- +# Determine which packages/component to include ############################################### +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# Physics package +# +# The default physics package is cam6. Physics packages >=cam5 use chemistry packages +# that include modal aerosols, i.e., the -chem value matches /_mam/. If the chem_pkg +# name doesn't match /_mam/ then set the default physics package to cam4. +my $phys_pkg = 'cam6'; +if (defined $opts{'chem'} and $opts{'chem'} !~ /_mam/) { + $phys_pkg = 'cam4'; +} +elsif (defined $opts{'waccmx'}) { + $phys_pkg = 'cam4'; +} + +# user override +if (defined $opts{'phys'}) { + $phys_pkg = lc($opts{'phys'}); +} + +# Add to the config object. +$cfg_ref->set('phys', $phys_pkg); + +if ($print>=2) { print "Physics package: $phys_pkg$eol"; } + + +# Set flag to indicate a simple physics option +my $simple_phys = 0; +if ($phys_pkg =~ m/^adiabatic$|^held_suarez$|^kessler$/) { + $simple_phys = 1; +} + +#----------------------------------------------------------------------------------------------- +# Chemistry package + +my $chem_pkg = 'trop_mam4'; + +# defaults based on physics package +if ($simple_phys or $phys_pkg =~ m/^cam[34]$/ or $phys_pkg eq 'spcam_sam1mom') { + $chem_pkg = 'none'; +} +elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { + $chem_pkg = 'trop_mam3'; +} + +# some overrides for special configurations +if (defined $opts{'prog_species'}) { + $chem_pkg = 'none'; +} +elsif (defined $opts{'waccmx'}) { + $chem_pkg = 'waccm_ma'; +} + +# Allow the user to override the default chemistry via the commandline. +if (defined $opts{'chem'}) { + $chem_pkg = lc($opts{'chem'}); + + # But do some consistency checks... + + # If the user has specified a simple physics package... + if ($simple_phys) { + # the only valid chemistry options are 'none' and 'terminator' + if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator')) { + die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". + " -chem can only be set to 'none' or 'terminator'.\n"; + } + } + elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { + # The modal aerosols are not valid with cam3 or cam4 physics + if ($chem_pkg =~ /_mam/) { + die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". + " -chem cannot be set to a modal aerosol option.\n"; + } + } + + if (defined $opts{'prog_species'}) { + if ($chem_pkg !~ /none/) { + die "configure ERROR: -prog_species=$opts{'prog_species'} -chem=$chem_pkg\n". + " -chem must be set 'none' with the prog_species option.\n"; + } + } + + if (defined $opts{'waccmx'}) { + if ($chem_pkg ne 'waccm_ma') { + die "configure ERROR: -waccmx=$opts{'waccmx'} -chem=$chem_pkg\n". + " -chem must be set 'waccm_ma' with the waccmx option.\n"; + } + } + +} + +# Add to the config object. +$cfg_ref->set('chem', $chem_pkg); + +if ($print>=2) { print "Chemistry package: $chem_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# Dynamics package +$cfg_ref->set('dyn', 'fv'); + +if (defined $opts{'dyn'}) { + $cfg_ref->set('dyn', lc($opts{'dyn'}) ); +} +my $dyn_pkg = $cfg_ref->get('dyn'); + +if ($print>=2) { print "Dynamics package: $dyn_pkg$eol"; } + +$cfg_ref->set('analytic_ic', (defined $opts{'analytic_ic'}) ? $opts{'analytic_ic'} : 0); + +# offline driver +if (defined $opts{'offline_dyn'}) { + $cfg_ref->set('offline_dyn', $opts{'offline_dyn'}); +} +my $offline_dyn = $cfg_ref->get('offline_dyn'); + +# offline driver only runs with FV dycore +if ( ($offline_dyn) and ($dyn_pkg ne 'fv') ) { + die <<"EOF"; +** ERROR: Offline driver only applicable to the FV dycore. +EOF +} + +#----------------------------------------------------------------------------------------------- +# Test tracer package +if (defined $opts{'nadv_tt'}) { + $cfg_ref->set('nadv_tt', $opts{'nadv_tt'}); +} +my $ttrac_nadv = $cfg_ref->get('nadv_tt'); + +if ($print>=2) { print "Number of user requested test tracers: $ttrac_nadv$eol"; } + + +#----------------------------------------------------------------------------------------------- +# Radiatively active constituents. +if (defined $opts{'max_n_rad_cnst'}) { + $cfg_ref->set('max_n_rad_cnst', $opts{'max_n_rad_cnst'}); +} +my $max_n_rad_cnst = $cfg_ref->get('max_n_rad_cnst'); + +if ($print>=2) { print "Maximum radiatively active tracers: $max_n_rad_cnst$eol"; } + +#----------------------------------------------------------------------------------------------- +# waccm physics +my $waccm_phys = 0; +if ($chem_pkg =~ /waccm_/) { + $waccm_phys = 1; +} +$cfg_ref->set('waccm_phys', $waccm_phys); + +# user override +if (defined $opts{'waccm_phys'}) { + $cfg_ref->set('waccm_phys', $opts{'waccm_phys'}); +} +$waccm_phys = $cfg_ref->get('waccm_phys'); + +if ($print>=2) { print "WACCM physics: $waccm_phys$eol"; } + + +# WACCM physics only runs with FV or SE dycores +if ( ($waccm_phys) and ($dyn_pkg ne 'fv') and ($dyn_pkg ne 'se') ) { + die <<"EOF"; +** ERROR: WACCM physics only runs with FV or Spectral Element as the dycore. +EOF +} + +# WACCM includes 4 age of air tracers by default +if ($chem_pkg =~ /waccm_ma/ or $chem_pkg =~ /waccm_tsmlt/) { + $cfg_ref->set('age_of_air_trcs', 1); +} + +# Allow user to override WACCM default, or turn on the age of air tracers +# in non-WACCM runs. +if (defined $opts{'age_of_air_trcs'}) { + $cfg_ref->set('age_of_air_trcs', $opts{'age_of_air_trcs'}); +} +my $age_of_air_trcs = $cfg_ref->get('age_of_air_trcs') ? "ON" : "OFF"; + +if ($print>=2) { print "Age of air tracer package: $age_of_air_trcs$eol"; } + +# waccmx option +if (defined $opts{'waccmx'}) { + $cfg_ref->set('waccmx', $opts{'waccmx'}); + if (defined $opts{'ionosphere'}) { + $cfg_ref->set('ionosphere', $opts{'ionosphere'}); + } +} +my $waccmx = $cfg_ref->get('waccmx'); +my $ionos = $cfg_ref->get('ionosphere'); + +#----------------------------------------------------------------------------------------------- + +# Prognostic species package(s) +if (defined $opts{'prog_species'}) { + $cfg_ref->set('prog_species', $opts{'prog_species'}); + if ($chem_pkg ne 'none'){ + die "ERROR: chem and prog_species cannot be both specified.\n"; + } +} +if (defined $opts{'edit_chem_mech'}) { + $cfg_ref->set('edit_chem_mech', $opts{'edit_chem_mech'}); +} +if (defined $opts{'usr_mech_infile'}) { + $cfg_ref->set('usr_mech_infile', $opts{'usr_mech_infile'}); +} + +#----------------------------------------------------------------------------------------------- +# Prognostic aerosol/GHG package(s) +my $prog_species = $cfg_ref->get('prog_species'); + +if (($waccm_phys) and ($chem_pkg eq 'none') and !($prog_species)) { + die <<"EOF"; +** ERROR: WACCM physics only runs with chemistry. +EOF +} + +#----------------------------------------------------------------------------------------------- +# Biogeochemistry option +if (defined $opts{'co2_cycle'}) { + $cfg_ref->set('co2_cycle', $opts{'co2_cycle'}); +} +my $co2_cycle = $cfg_ref->get('co2_cycle'); + +if ($co2_cycle and $print>=2) { print "co2_cycle option: ON$eol"; } + +#----------------------------------------------------------------------------------------------- +# Superparameterization mode (SPCAM) +# +# These values all default to 1 unless specified by the user during configure + +if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { + + if ($smp eq 'ON') { + die "ERROR: SPCAM may not be used with threading $eol"; + } + + if ($print>=2) {print "Configure CAM for SPCAM (superparameterization) mode: $phys_pkg.$eol"; } + + if (defined $opts{'spcam_nx'}) { + $cfg_ref->set('spcam_nx', $opts{'spcam_nx'}); + my $spcam_nx = $cfg_ref->get('spcam_nx'); + if ($spcam_nx < 4) { + die "configure ERROR: spcam_nx must be greater than or equal to 4\n"; + } + if ($print>=2) {print "spcam_nx= $spcam_nx $eol"; } + } + if (defined $opts{'spcam_ny'}) { + $cfg_ref->set('spcam_ny', $opts{'spcam_ny'}); + my $spcam_ny = $cfg_ref->get('spcam_ny'); + if ($print>=2) {print "spcam_ny= $spcam_ny $eol"; } + } + if (defined $opts{'spcam_dx'}) { + $cfg_ref->set('spcam_dx', $opts{'spcam_dx'}); + my $spcam_dx = $cfg_ref->get('spcam_dx'); + if ($print>=2) {print "spcam_nx= $spcam_dx $eol"; } + } + if (defined $opts{'spcam_dt'}) { + $cfg_ref->set('spcam_dt', $opts{'spcam_dt'}); + my $spcam_dt = $cfg_ref->get('spcam_dt'); + if ($print>=2) {print "spcam_nt= $spcam_dt $eol"; } + } + +} + + +#----------------------------------------------------------------------------------------------- +# Micro-physics package + +# Set default +my $microphys_pkg = 'none'; +if ($phys_pkg =~ m/^cam[34]$/) { + $microphys_pkg = 'rk'; +} +elsif ($phys_pkg eq 'cam5') { + $microphys_pkg = 'mg1'; +} +elsif ($phys_pkg eq 'cam6') { + $microphys_pkg = 'mg2'; +} +elsif ($phys_pkg eq 'spcam_sam1mom') { + $microphys_pkg = 'spcam_sam1mom'; +} +elsif ($phys_pkg eq 'spcam_m2005') { + $microphys_pkg = 'spcam_m2005'; +} + +# Allow the user to override the default via the commandline. +if (defined $opts{'microphys'}) { + $microphys_pkg = lc($opts{'microphys'}); +} + +$cfg_ref->set('microphys', $microphys_pkg); + +if ($print>=2) { print "Microphysics package: $microphys_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# CARMA sectional microphysics package +# The default for the current physics package is: +my $carma_pkg = 'none'; + +# Allow the user to override the default via the commandline. +if (defined $opts{'carma'}) { + $carma_pkg = lc($opts{'carma'}); +} + +if ($carma_pkg =~ m/cirrus/i) { + unless ($microphys_pkg =~ /^mg/) { + die <<"EOF"; +** ERROR: microphysics package set to: $microphys_pkg +** The CARMA cirrus model only works with MG microphysics. +EOF + } +} + +$cfg_ref->set('carma', $carma_pkg); + +if ($print>=2) { print "CARMA microphysical model: $carma_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# CLUBB +my $clubb_sgs = 0; +if ($phys_pkg eq 'cam6') { + $clubb_sgs = 1; +} + +# user override +if (defined $opts{'clubb_sgs'}) { + $clubb_sgs = $opts{'clubb_sgs'}; +} + +# consistency checks... + +# CLUBB_SGS only works with mg microphysics +if ($clubb_sgs and not ($microphys_pkg =~ m/^mg/ )) { + die <<"EOF"; +** ERROR: microphysics package set to: $microphys_pkg +** CLUBB_SGS only works with MG microphysics. +EOF +} + +$cfg_ref->set('clubb_sgs', $clubb_sgs); + +if ($print>=2) { print "clubb_sgs: $clubb_sgs$eol"; } + + +#----------------------------------------------------------------------------------------------- +# SPCAM version of CLUBB +if (defined $opts{'spcam_clubb_sgs'}) { + $cfg_ref->set('spcam_clubb_sgs', $opts{'spcam_clubb_sgs'}); +} +my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); + + +#----------------------------------------------------------------------------------------------- +# Break apart CLUBB options into separate fields + +if (defined $opts{'clubb_opts'}) { + my @clubb_temp_opts = split /,/, $opts{'clubb_opts'}; + foreach (@clubb_temp_opts) { + $cfg_ref->set("$_", '1'); + } +} +my $clubb_do_adv = $cfg_ref->get('clubb_do_adv'); +if ($print>=2) { print "clubb_do_adv: $clubb_do_adv$eol"; } + +#----------------------------------------------------------------------------------------------- +# ZM convective organization + +if (defined $opts{'zmconv_org'}) { + $cfg_ref->set('zmconv_org', $opts{'zmconv_org'}); +} + +my $zmconv_org = $cfg_ref->get('zmconv_org'); +if ($print>=2) { print "zmconv_org: $zmconv_org$eol"; } + +#----------------------------------------------------------------------------------------------- +# Macro-physics package + +# Set default +my $macrophys_pkg = 'none'; +if ($phys_pkg =~ /cam[34]/) { + $macrophys_pkg = 'rk'; +} +elsif ($phys_pkg =~ /cam5/) { + $macrophys_pkg = 'park'; +} +elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { + $macrophys_pkg = 'clubb_sgs'; +} +elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { + $macrophys_pkg = 'park'; +} +elsif ($phys_pkg eq 'spcam_sam1mom') { + $macrophys_pkg = 'spcam_sam1mom'; +} +elsif ($phys_pkg eq 'spcam_m2005') { + $macrophys_pkg = 'spcam_m2005'; +} + +# user overrides +if ($clubb_sgs or $spcam_clubb_sgs) { + $macrophys_pkg = 'clubb_sgs'; +} + +if (defined $opts{'macrophys'}) { + $macrophys_pkg = lc($opts{'macrophys'}); +} + +$cfg_ref->set('macrophys', $macrophys_pkg); + +if ($print>=2) { print "Macrophysics package: $macrophys_pkg$eol"; } + + +#----------------------------------------------------------------------------------------------- +# PBL package + +# Set default: +my $pbl_pkg = 'none'; +if ($phys_pkg =~ m/^cam[34]$/) { + $pbl_pkg = 'hb'; +} +elsif ($phys_pkg =~ /cam5/) { + $pbl_pkg = 'uw'; +} +elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { + $pbl_pkg = 'clubb_sgs'; +} +elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { + $pbl_pkg = 'uw'; +} +elsif ($phys_pkg eq 'spcam_sam1mom') { + $pbl_pkg = 'spcam_sam1mom'; +} +elsif ($phys_pkg eq 'spcam_m2005') { + $pbl_pkg = 'spcam_m2005'; +} + +# Allow the user to override the default via the commandline. +if ($clubb_sgs == 1) { + $pbl_pkg = 'clubb_sgs'; +} +if (defined $opts{'pbl'}) { + $pbl_pkg = lc($opts{'pbl'}); +} + +# consistency checks... + +# UW PBL only works with mg microphysics +if ($pbl_pkg =~ m/uw/i) { + unless ($microphys_pkg =~ /^mg/) { + die <<"EOF"; +** ERROR: microphysics package set to: $microphys_pkg +** The UW PBL scheme only works with MG microphysics. +EOF + } +} + +$cfg_ref->set('pbl', $pbl_pkg); + +if ($print>=2) { print "PBL package: $pbl_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# UNICON + +if (defined $opts{'unicon'}) { + $cfg_ref->set('unicon', $opts{'unicon'}); +} +my $unicon = $cfg_ref->get('unicon'); + +# consistency checks... + +# UNICON assumes park macrophysics, uw pbl, and mg microphysics +if ($unicon and + ($macrophys_pkg ne 'park' or $pbl_pkg ne 'uw' or $microphys_pkg !~ m/^mg/) ) { + die <<"EOF"; +** ERROR: UNICON assumes macrophys='park', pbl='uw', microphys='mg*'. Current values are: +** macrophys: $macrophys_pkg, pbl: $pbl_pkg, microphys: $microphys_pkg. +EOF +} + +if ($unicon and $print>=2) { print "Using UNICON scheme.$eol"; } + +#----------------------------------------------------------------------------------------------- +# Radiation package + +# Set default +my $rad_pkg = 'none'; +if ($phys_pkg =~ m/^cam[34]$|^spcam_sam1mom$/) { + $rad_pkg = 'camrt'; +} +elsif ($phys_pkg =~ m/^cam[56]$|^spcam_m2005$/) { + $rad_pkg = 'rrtmg'; +} + +# Allow the user to override the default via the commandline. +if (defined $opts{'rad'}) { + $rad_pkg = lc($opts{'rad'}); +} + +# consistency checks... + +if ($rad_pkg eq 'camrt') { + + # The camrt radiation doesn't work with the modal aerosols + if ($chem_pkg =~ /_mam/) { + die "configure ERROR: radiation package: $rad_pkg is not compatible\n". + " with aerosol package $chem_pkg\n"; + } +} +elsif ($rad_pkg eq 'rrtmg') { + + # The rrtmg package doesn't work with the CAM3 prescribed aerosols + if ($phys_pkg eq 'cam3') { + die "configure ERROR: radiation package: $rad_pkg is not compatible\n". + " with physics package $phys_pkg\n"; + } +} + +$cfg_ref->set('rad', $rad_pkg); + +if ($print>=2) { print "Radiation package: $rad_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# Option to build the COSP simulator +if (defined $opts{'cosp'}) { + $cfg_ref->set('cosp', $opts{'cosp'}); +} +my $cosp = $cfg_ref->get('cosp'); + +# cosp is only implemented with the cam5 and cam6 physics packages +if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6')) { + die "configure ERROR: cosp not implemented for the $phys_pkg physics package \n"; +} + +if ($cosp and $print>=2) { print "COSP simulator enabled$eol"; } + +#----------------------------------------------------------------------------------------------- +# Checks for SPCAM compatability + +if ($phys_pkg eq 'spcam_sam1mom') { + if ($rad_pkg ne 'camrt') { + die "configure ERROR: radiation package: $rad_pkg is not compatible\n". + " with sam1mom -- it should be camrt\n"; + } + if ($chem_pkg ne 'none') { + die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". + " with sam1mom -- it should be none\n"; + } +} + +if ($phys_pkg eq 'spcam_m2005') { + if ($rad_pkg ne 'rrtmg') { + die "configure ERROR: radiation package: $rad_pkg is not compatible\n". + " with m2005 -- it should be rrtmg\n"; + } + if ($chem_pkg ne 'trop_mam3') { + die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". + " with m2005 -- it should be trop_mam3\n"; + } +} + +#----------------------------------------------------------------------------------------------- +# offline unit driver +if (defined $opts{'offline_drv'}) { + $cfg_ref->set('offline_drv', $opts{'offline_drv'}); +} + +#----------------------------------------------------------------------------------------------- +# Aquaplanet mode +# This provides a flag to CAM to let it know that it's running in aquaplanet mode. +# This flag is mainly used by the dycore to set the fixed dry mass of the atmosphere. +# It is independent of which model is used to specify the aquaplanet surface properties. +my $aquaplanet = 0; + +# aquaplanet mode is the default for CAM standalone builds unless using +# simple physics +if ($cam_build and !$simple_phys) {$aquaplanet = 1;} + +# user override +if (defined $opts{'aquaplanet'}) { + $aquaplanet = 1; +} + +$cfg_ref->set('aquaplanet', $aquaplanet); + +my $aqua_mode = $aquaplanet ? "ON" : "OFF"; +if ($print>=2) { print "Aqua-planet mode: $aqua_mode$eol"; } + +#----------------------------------------------------------------------------------------------- +# Ocean model +my $ocn_pkg = 'socn'; +if ($aquaplanet) { + # Default for aquaplanet mode is to use an analytic expression for fixed SST. + $ocn_pkg = 'aquaplanet'; +} + +# Allow the user to override the default via the commandline. +# For aquaplanet with SOM the option '-ocn som' should be used to override +# aquaplanet's default ocean component setting. +if (defined $opts{'ocn'}) { + $ocn_pkg = lc($opts{'ocn'}); +} + +$cfg_ref->set('ocn', $ocn_pkg); + +if ($print>=2) { print "Ocean package: $ocn_pkg$eol"; } + +#----------------------------------------------------------------------------------------------- +# Use modifications for perturbation growth testing? +if (defined $opts{'pergro'}) { + $cfg_ref->set('pergro', $opts{'pergro'}); +} +my $pergro = $cfg_ref->get('pergro') ? "ON" : "OFF"; + +if ($print>=2) { print "Perturbation growth testing: $pergro$eol"; } + +#----------------------------------------------------------------------------------------------- +# Single column mode +if (defined $opts{'scam'}) { + $cfg_ref->set('scam', 1); +} +my $scam = $cfg_ref->get('scam') ? "ON" : "OFF"; + +# The only dycore supported in SCAM mode is Eulerian +if ($scam eq 'ON' and $dyn_pkg ne 'eul') { + die <<"EOF"; +** ERROR: SCAM mode only works with Eulerian dycore. +** Requested dycore is: $dyn_pkg +EOF +} + +if ($print>=2) { print "CAM single column mode (SCAM): $scam$eol"; } + +#----------------------------------------------------------------------------------------------- +# Generate IOP +if (defined $opts{'camiop'}) { + $cfg_ref->set('camiop', 1); +} +my $camiop = $cfg_ref->get('camiop') ? "ON" : "OFF"; + +# The only dycore supported in CAMIOP mode is Eulerian +if ($camiop eq 'ON' and $dyn_pkg ne 'eul') { + die <<"EOF"; +** ERROR: CAMIOP mode only works with Eulerian dycore. +** Requested dycore is: $dyn_pkg +EOF +} + +if ($print>=2) { print "Produce IOP file for SCAM: $camiop$eol"; } + +#----------------------------------------------------------------------------------------------- +# Horizontal grid parameters +# Dycore dependent defaults: +my $hgrid; +if ($dyn_pkg eq 'fv') { + $hgrid = '1.9x2.5'; +} +elsif ($dyn_pkg eq 'eul') { + $hgrid = '64x128'; +} +elsif ($dyn_pkg eq 'se') { + $hgrid = 'ne16np4'; +} +$cfg_ref->set('hgrid', $hgrid); + +# User override. +if (defined $opts{'hgrid'}) { + $cfg_ref->set('hgrid', $opts{'hgrid'}); +} +my $hgrid = $cfg_ref->get('hgrid'); + +# set_horiz_grid sets the parameters for specific dycore/hgrid combinations. +set_horiz_grid("$cfgdir/$horiz_grid_file", $cfg_ref); + +if ($print>=2) { print "Horizontal grid specifier: $hgrid$eol"; } + +#----------------------------------------------------------------------------------------------- +# Maximum number of columns in a chunk. +if (defined $opts{'pcols'}) { + $cfg_ref->set('pcols', $opts{'pcols'}); +} +my $pcols = $cfg_ref->get('pcols'); + +# Override PCOLS setting if configuring for SCAM +if ($scam eq 'ON') { + $pcols = 1; + $cfg_ref->set('pcols', $pcols); +} + +# Check valid value of pcols +unless ( $pcols >= 1 ) { + die <<"EOF"; +** ERROR: invalid chunk size: $pcols +EOF +} + +if ($print>=2) { print "Maximum number of columns in a chunk: $pcols$eol"; } + +#----------------------------------------------------------------------------------------------- +# Maximum number of sub-columns in a chunk. +if (defined $opts{'psubcols'}) { + $cfg_ref->set('psubcols', $opts{'psubcols'}); +} +my $psubcols = $cfg_ref->get('psubcols'); + +# Check valid value of psubcols +unless ( $psubcols >= 1 ) { + die <<"EOF"; +** ERROR: invalid size for sub-columns: $psubcols +EOF +} + +if ($print>=2) { print "Maximum number of sub-columns per column: $psubcols$eol"; } + +#----------------------------------------------------------------------------------------------- +# Number of vertical levels +my $nlev = 0; + +# Defaults +if ($waccmx) { + if ($ionos =~ /wxie/) { + $nlev = 126; + } + else { + $nlev = 81; + } +} +elsif ($chem_pkg =~ /waccm_/) { + if ($phys_pkg eq 'cam4') { + $nlev = 66; + } + else { + $nlev = 70; + } +} +elsif ($phys_pkg eq 'cam6') { + $nlev = 32; +} +elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { + $nlev = 30; +} +elsif ($phys_pkg eq 'cam4' or $phys_pkg eq 'spcam_sam1mom') { + $nlev = 26; +} +elsif ($phys_pkg eq 'cam3') { + $nlev = 26; +} +else { + # This will be used for Held-Suarez and other 'simple' physics + # We may change this to 32 once IC files are available. + $nlev = 30; +} + +# user override +if (defined $opts{'nlev'}) { + $nlev = $opts{'nlev'}; +} + +# Check valid value of nlev +unless ( $nlev >= 1 ) { + die <<"EOF"; +** ERROR: invalid number of vertical levels: $nlev +EOF +} + +$cfg_ref->set('nlev', $nlev); + +if ($print>=2) { print "Number of vertical levels: $nlev$eol"; } + +if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { + $cfg_ref->set('spcam_nz', $nlev-2); +} + +#------------------------------------------------------------------------------------------------ +# chemistry preprocessor.... +# -- avoid using the chem_preprocessor unless it's required +#------------------------------------------------------------------------------------------------ +my $chem_nadv = 0; +my $chem_cppdefs = ''; +my $chem_src_dir = ''; + +if (!$prog_species) { + $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg"; + $cfg_ref->set('chem_src_dir', $chem_src_dir); +} + +# customize chemistry +my $edit_chem_mech = $cfg_ref->get('edit_chem_mech'); +my $usr_mech_infile = $cfg_ref->get('usr_mech_infile'); +my $customize = $prog_species || $edit_chem_mech || $usr_mech_infile; + +if ($customize) { + # build_chem_proc option used to force a build even if an executable exists + if (defined $opts{'build_chem_proc'}) { + $cfg_ref->set('build_chem_proc', $opts{'build_chem_proc'}); + } else { + $cfg_ref->set('build_chem_proc', 0); + } + my $chem_proc_src ; + $chem_proc_src = "$cam_bld/chem_proc/source"; + $cfg_ref->set('chem_proc_src', $chem_proc_src) ; + my $chemproc_fc; + # determine which fortran compiler to use for building the preprocessor + if (defined $opts{'fc_type'}) { + $chemproc_fc = $opts{'fc_type'}; + if ($print>=2) { print "Chem preprocessor compiler set from fc config opt$eol"; } + } + if ($print>=2) { print "Chem preprocessor compiler: $chemproc_fc $eol"; } + ($chem_nadv) = chem_preprocess($cfg_ref,$print,$chemproc_fc); +} elsif ($chem_pkg ne 'none') { + # copy over chem docs + copy("$chem_src_dir/chem_mech.doc",$cam_bld) or die "copy failed $! \n"; + copy("$chem_src_dir/chem_mech.in" ,$cam_bld) or die "copy failed $! \n"; + ($chem_nadv) = chem_number_adv($chem_src_dir); +} + +if ($chem_pkg =~ '_mam3') { + $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_3MODE '; +} elsif ($chem_pkg =~ '_mam4') { + $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_4MODE '; +} elsif ($chem_pkg =~ '_mam7') { + $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; +} + +# CARMA sectional microphysics +# +# New CARMA models need to define the number of advected constituents. +# +# New CARMA models that want to do dry depostion need to provide the ccp_def PROGSSLT, so that +# clm will return aerodynamic resistances and surface friction velocity. +my $carma_nadv = 0; +my $carma_cppdefs = ''; + +if ($carma_pkg eq 'bc_strat') { + $carma_nadv = 1; +} +elsif ($carma_pkg eq 'cirrus') { + $carma_nadv = 84; +} +elsif ($carma_pkg eq 'cirrus_dust') { + $carma_nadv = 140; +} +elsif ($carma_pkg eq 'dust') { + $carma_nadv = 16; +} +elsif ($carma_pkg eq 'meteor_impact') { + $carma_nadv = 42; +} +elsif ($carma_pkg eq 'meteor_smoke') { + $carma_nadv = 28; +} +elsif ($carma_pkg eq 'mixed_sulfate') { + $carma_nadv = 84; +} +elsif ($carma_pkg eq 'pmc') { + $carma_nadv = 84; +} +elsif ($carma_pkg eq 'pmc_sulfate') { + $carma_nadv = 140; +} +elsif ($carma_pkg eq 'sea_salt') { + $carma_nadv = 16; +} +elsif ($carma_pkg eq 'sulfate') { + $carma_nadv = 30; +} +elsif ($carma_pkg eq 'tholin') { + $carma_nadv = 40; +} +elsif ($carma_pkg eq 'test_detrain') { + $carma_nadv = 66; +} +elsif ($carma_pkg eq 'test_growth') { + $carma_nadv = 32; +} +elsif ($carma_pkg eq 'test_passive') { + $carma_nadv = 16; +} +elsif ($carma_pkg eq 'test_radiative') { + $carma_nadv = 16; +} +elsif ($carma_pkg eq 'test_swelling') { + $carma_nadv = 48; +} +elsif ($carma_pkg eq 'test_tracers') { + $carma_nadv = 372; +} +elsif ($carma_pkg eq 'test_tracers2') { + $carma_nadv = 434; +} + + +#----------------------------------------------------------------------------------------------- +# Number of advected constituents +my $nadv; +if (defined $opts{'nadv'}) { + $cfg_ref->set('nadv', $opts{'nadv'}); +} +else { + + # If the user hasn't specified the number of advected constituents via the -nadv + # commandline arg, then determine the default number. + + # There is always at least one advected constituent, the specific humidity, even + # if it's set to zero which is the case for adiabatic or Held-Suarez physics. + $nadv = 1; + + # Chemistry package: + $nadv += $chem_nadv; + if ($print>=2) { print "Advected constituents added by chemistry $chem_pkg: $chem_nadv$eol"; } + + # If no 'simple' (e.g., Held-Suarez) physics package is used, + # then accumulate advected constituents from the moist physics and + # chemistry processes. + + unless ($simple_phys) { + + # Microphysics parameterization + if ($microphys_pkg eq 'rk' or $microphys_pkg eq 'spcam_sam1mom') { + $nadv += 2; + if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 2$eol"; } + } + elsif ($microphys_pkg =~ /^mg1/ or $microphys_pkg eq 'spcam_m2005') { + $nadv += 4; + if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 4$eol"; } + } + elsif ($microphys_pkg =~/^mg2/) { + $nadv += 8; + if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } + } + + if ($zmconv_org == 1 ) { + $nadv += 1; + if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } + } + + if ($clubb_do_adv) { + $nadv += 9; + if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } + } + + # co2_cycle + if ($co2_cycle) { + $nadv += 4; + if ($print>=2) { print "Advected constituents added by co2_cycle: 4$eol"; } + } + + # CARMA package: + if ($carma_nadv > 0) { + $nadv += $carma_nadv; + if ($print>=2) { print "Advected constituents added by CARMA model $carma_pkg: $carma_nadv$eol"; } + } + + # UNICON tracers + if ($unicon) { + $nadv += 5; + if ($print>=2) { print "Advected constituents added by UNICON: 5$eol"; } + } + + } + + # Special case for Kessler physics, need ice and water tracers + if ($phys_pkg eq "kessler") { + $nadv += 2 + } + + # Add in specified test tracers. These may be present with 'simple' (e.g., Held-Suarez) physics. + $nadv += $ttrac_nadv; + if ($print>=2 and $ttrac_nadv) { print "Advected constituents added by test tracer package: $ttrac_nadv$eol"; } + + if ($age_of_air_trcs eq "ON") { + $nadv += 4; + if ($print>=2) { print "Advected constituents added by the age of air tracer package: 4$eol"; } + } + + $cfg_ref->set('nadv', $nadv); +} + +$nadv = $cfg_ref->get('nadv'); +if ($print>=2) { print "Total advected constituents: $nadv$eol"; } + +#----------------------------------------------------------------------------------------------- +# Makefile configuration ####################################################################### +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# Check for GNU make in the user's path +if ($print) { print "Looking for a valid GNU make... "; } +my @makenames = qw(gmake gnumake make); +if ($opts{'gmake'}) { unshift @makenames, $opts{'gmake'}; } +my $gmake = get_gmake(@makenames); +if ($gmake) { + if ($print) { print "using $gmake$eol"; } +} else { + print "\n". + "** Cannot find a valid GNU make. Tried:\n". + "@makenames\n"; + die "The name of GNU make on your system can be specified to configure via\n". + "the -gmake option. Make sure this\n". + "name is in your path (add the appropriate directory to your PATH\n". + "environment variable) or specify an absolute pathname.\n"; +} + +#----------------------------------------------------------------------------------------------- +# Name of CAM executable. +if (defined $opts{'cam_exe'}) { + $cfg_ref->set('cam_exe', $opts{'cam_exe'}); +} +my $cam_exe = $cfg_ref->get('cam_exe'); + +if ($print>=2) { print "Name of CAM executable: $cam_exe$eol"; } + +#----------------------------------------------------------------------------------------------- +# Set default Fortran and C compilers +my $fc = ''; +my $fc_type = ''; +my $cc = ''; + +if ($target_os eq 'aix') { + if ($spmd eq 'ON') { + $fc = 'mpxlf95_r'; + } + else { + $fc = 'xlf95_r'; + } + $fc_type = 'ibm'; + $cc = 'mpcc_r'; +} +elsif ($target_os eq 'linux') { + $fc='gfortran'; +} +elsif ($target_os eq 'darwin') { + + my $uname_m = `uname -m`; + if ($uname_m =~ /ppc/) { + + if ($spmd eq 'ON') { + $fc = 'mpxlf95_r;' + } + else { + $fc = 'xlf95_r'; + } + $fc_type = 'ibm'; + $cc = 'xlc'; + } + else { + $fc = 'ifort'; + $cc = 'gcc'; + } +} +elsif ($target_os eq 'bgl') { + $fc = 'blrts_xlf95'; + $cc = 'blrts_xlc'; +} +elsif ($target_os eq 'bgp') { + $fc = 'mpixlf95_r'; + $cc = 'mpixlc_r'; +} +elsif ($target_os eq 'bgq') { + $fc = 'mpixlf2003_r'; + $cc = 'mpixlc_r'; +} + +# User override for Fortran compiler +if (defined $opts{'fc'}) { $fc = $opts{'fc'}; } + +if ($fc) { + $cfg_ref->set('fc', $fc); + if ($print>=2) { print "Fortran compiler: $fc$eol"; } +} +else { + # If no default or user specification for Fortran compiler then die. + die "Default for Fortran compiler not found. Specify using the '-fc' argument.$eol"; +} + +# fc_type is used to identify the type of fortran compiler when it is being invoked +# using a generic name such as mpif90 or ftn. This is currently only used in the Linux +# section of the Makefile. + +if ($fc =~ /pgf/) { $fc_type = 'pgi'; } +elsif ($fc =~ /ifort/) { $fc_type = 'intel'; } +elsif ($fc =~ /^nag/) { $fc_type = 'nag'; } +elsif ($fc =~ /path/) { $fc_type = 'pathscale'; } +elsif ($fc =~ /gfort/) { $fc_type = 'gnu'; } +elsif ($fc =~ /xlf/) { $fc_type = 'ibm'; } + +# User override for Fortran compiler type +if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } + +if ($fc_type) { + $cfg_ref->set('fc_type', $fc_type); + if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } +} +else { + + # The Linux section of the Makefile depends on the FC_TYPE macro. Fail if + # target_os is linux and fc_type hasn't been set. + if ($target_os eq 'linux') { + die "Fortran compiler type must be set on Linux platform. Specify using the '-fc_type' argument.$eol"; + } +} + +# If a default hasn't been set yet for CC then set one now. +if ($cc eq '') { + + # On platforms where the programming environment is set up using a package managing + # tool like "module" or "dotkit" then the compilers are invoked using scripts with + # generic names like "ftn" and "cc". The following code to set the default CC + # compiler recognizes this special case: + + if ($fc eq 'ftn') { + + $cc = 'cc'; + + } + elsif ($fc eq 'mpif90') { + + $cc = 'mpicc'; + + } + else { + + # Set default C compiler based on fc_type + if ($fc_type eq 'pgi') { $cc = 'pgcc'; } + elsif ($fc_type eq 'intel') { $cc = 'icc'; } + elsif ($fc_type eq 'nag') { $cc = 'gcc'; } + elsif ($fc_type eq 'pathscale') { $cc = 'pathcc'; } + elsif ($fc_type eq 'gnu') { $cc = 'gcc'; } + elsif ($fc_type eq 'ibm') { $cc = 'xlc'; } + } +} + +# User override for C compiler +if (defined $opts{'cc'}) { $cc = $opts{'cc'}; } + +# If the C compiler has not been set yet... +unless ($cc) { $cc = 'cc';} + +$cfg_ref->set('cc', $cc); +if ($print>=2) { print "C compiler: $cc$eol"; } + + +#----------------------------------------------------------------------------------------------- +# Allow override of Makefile default linker +my $linker = ''; +if (defined $opts{'linker'}) { + $linker = $opts{'linker'}; +} +$cfg_ref->set('linker', $linker); + +if ($linker and $print>=2) { print "Setting linker to: $linker$eol"; } + +#----------------------------------------------------------------------------------------------- +# Use compiler debugging options? +my $debug_opt = (defined $opts{'debug'}) ? 1 : 0; +$cfg_ref->set('debug', $debug_opt); +my $debug = $debug_opt ? 'ON': 'OFF'; + +if ($print>=2) { print "Compiler debugging options: $debug$eol"; } + +#----------------------------------------------------------------------------------------------- +# Append to Makefile default C compiler options +my $cflags = ''; +if (defined $opts{'cflags'}) { + $cflags = $opts{'cflags'}; +} +$cfg_ref->set('cflags', $cflags); + +if ($cflags and $print>=2) { print "Setting additional C compiler options: \'$cflags\'$eol"; } + +#----------------------------------------------------------------------------------------------- +# Append to Makefile default Fortran compiler options +my $fflags = ''; +if (defined $opts{'fflags'}) { + $fflags = $opts{'fflags'}; +} +$cfg_ref->set('fflags', $fflags); + +if ($fflags and $print>=2) { print "Setting additional Fortran compiler options: \'$fflags\'$eol"; } + +#----------------------------------------------------------------------------------------------- +# Fortran compiler optimization overrides Makefile defaults +my $fopt = ''; +if (defined $opts{'fopt'}) { + $fopt = $opts{'fopt'}; +} +$cfg_ref->set('fopt', $fopt); + +if ($fopt and $print>=2) { print "Override default Fortran optimization flags with: \'$fopt\'$eol"; } + +#----------------------------------------------------------------------------------------------- +# Load options appended to Makefile defaults +my $ldflags = ''; +my $usr_ldflags = ''; +if (defined $opts{'ldflags'}) { + $ldflags = $opts{'ldflags'}; + # Save off the user specification to pass to the MCT configure + $usr_ldflags = $opts{'ldflags'}; +} +$cfg_ref->set('ldflags', $ldflags); + +if ($ldflags and $print>=2) { print "Load options appended to Makefile defaults: \'$ldflags\'$eol"; } + +#----------------------------------------------------------------------------------------------- +# For the CPP tokens, start with the specifications from the commandline. +my $usr_cppdefs = ' '; +if (defined $opts{'cppdefs'}) { + $usr_cppdefs .= " $opts{'cppdefs'}"; +} +$cfg_ref->set('cppdefs', $usr_cppdefs); + +if ($usr_cppdefs and $print>=2) { print "Commandline CPP definitions: \'$usr_cppdefs\'$eol";} + +# The following CPP macro definitions are used to implement the compile-time options. They are +# determined by the configuration parameters that have been set above. They will be appended to +# the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. +my $cfg_cppdefs = ' '; + +# Fortran name mangling +if ($cam_build) { + if ( $fc_type eq 'ibm') { + $cfg_cppdefs .= " -DFORTRAN_SAME"; + } + else { + $cfg_cppdefs .= " -DFORTRANUNDERSCORE"; + } +} + +# Building for perturbation growth tests +if ($pergro eq "ON") { $cfg_cppdefs .= " -DPERGRO"; } + +# Building for superparameterization +my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); +my $spcam_nx = $cfg_ref->get('spcam_nx'); +my $spcam_ny = $cfg_ref->get('spcam_ny'); +my $spcam_nz = $cfg_ref->get('spcam_nz'); +my $spcam_dx = $cfg_ref->get('spcam_dx'); +my $spcam_dt = $cfg_ref->get('spcam_dt'); + +my $yes3Dval = 1; # default to 3D for spcam +if ($spcam_ny eq 1) {$yes3Dval = 0;} #Turn off if not using 3D + +if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { + $cfg_cppdefs .= " -DSPCAM_NX=$spcam_nx -DSPCAM_NY=$spcam_ny -DSPCAM_NZ=$spcam_nz -DSPCAM_DX=$spcam_dx -DSPCAM_DT=$spcam_dt -DYES3DVAL=$yes3Dval -DCRM "; + if ( $spcam_clubb_sgs == 1 ) { + $cfg_cppdefs .= "-DSPCAM_CLUBB_SGS -DCLUBB_CRM -DCLUBB_REAL_TYPE=dp -DCLUBB_SAM"; ## -DNO_LAPACK_ISNAN"; + } +} + +if ($phys_pkg eq 'spcam_m2005') {$cfg_cppdefs .= " -DECPP -Dm2005";} + +if ($phys_pkg eq 'spcam_sam1mom') {$cfg_cppdefs .= " -Dsam1mom";} + +# Configure CAM to produce IOP files for SCAM +if ($camiop eq 'ON') { $cfg_cppdefs .= " -DBFB_CAM_SCAM_IOP"; } + +# Resolution parameters for rectangular lat/lon grids +my $nlon = $cfg_ref->get('nlon'); +my $nlat = $cfg_ref->get('nlat'); +$cfg_cppdefs .= " -DPLON=$nlon -DPLAT=$nlat"; + +# Parameters for multiple instances +if (!$ccsm_seq){ + $cfg_cppdefs .= " -DNUM_COMP_INST_ATM=1 -DNUM_COMP_INST_LND=1 -DNUM_COMP_INST_OCN=1 -DNUM_COMP_INST_ICE=1"; + $cfg_cppdefs .= " -DNUM_COMP_INST_GLC=1 -DNUM_COMP_INST_ROF=1 -DNUM_COMP_INST_WAV=1 -DNUM_COMP_INST_ESP=1"; +} + +# Parameters for spectral element dycore. +# HAVE_F2003_PTR_BND_REMAP definition turns on standard-conforming method of causing edge +# buffers to overlap. This method works in all CAM compilers. +if ($dyn_pkg eq 'se') { + + my $csnp = $cfg_ref->get('csnp'); + $cfg_cppdefs .= " -DCAM -D_WK_GRAD -DNP=$csnp -DHAVE_F2003_PTR_BND_REMAP"; + + # Check to see if physics grid is being used + my $npg = $cfg_ref->get('npg'); + if ($npg > 0) { + $cfg_cppdefs .= " -DFVM_TRACERS"; + } + + if ($smp eq 'ON') { + $cfg_cppdefs .= " -D_OPENMP"; + } + + if ($spmd eq 'ON') { + $cfg_cppdefs .= " -D_MPI"; + } +} + +# Resolution parameters for vertical grid, number of constituents, chunk size +my $nlev = $cfg_ref->get('nlev'); +my $nadv = $cfg_ref->get('nadv'); +my $pcols = $cfg_ref->get('pcols'); +my $psubcols = $cfg_ref->get('psubcols'); +$cfg_cppdefs .= " -DPLEV=$nlev -DPCNST=$nadv -DPCOLS=$pcols -DPSUBCOLS=$psubcols"; + +# Radiatively active constituent number +$cfg_cppdefs .= " -DN_RAD_CNST=$max_n_rad_cnst"; + +# Spectral truncation parameters +my $trm = $cfg_ref->get('trm'); +my $trn = $cfg_ref->get('trn'); +my $trk = $cfg_ref->get('trk'); +$cfg_cppdefs .= " -DPTRM=$trm -DPTRN=$trn -DPTRK=$trk"; + +# offline driver for FV dycore +if ($offline_dyn) { $cfg_cppdefs .= ' -DOFFLINE_DYN'; } + +# -DSPMD only added for CESM build. The CAM Makefile has a separate SPMD macro. +if ( ($ccsm_seq) and ($spmd eq 'ON') ) { $cfg_cppdefs .= " -DSPMD"; } + +# Chem CPP defs +$cfg_cppdefs .= $chem_cppdefs; + +# CARMA CPP defs +$cfg_cppdefs .= $carma_cppdefs; + +#Analytic initial conditions for dynamics state? +if ($cfg_ref->get('analytic_ic')) { + $cfg_cppdefs .= ' -DANALYTIC_IC'; +} + +#WACCM-X extended thermosphere/ionosphere model +if ($waccmx) { + $cfg_cppdefs .= ' -DWACCMX_PHYS'; + if (($dyn_pkg ne 'fv') and ($ionos ne 'none')) { + die "ERROR: Ionosphere is only available for FV dycore \n"; + } + if ($ionos =~ /wxi/) { + $cfg_cppdefs .= ' -DWACCMX_IONOS'; + } + if ($ionos =~ /wxie/) { + $cfg_cppdefs .= ' -DWACCMX_EDYN_ESMF'; + } +} + +# PIO +my $pio2_build = (defined $opts{'pio2'}) ? 1 : 0; +if ($cam_build) { + if (!$pio2_build) { + # Only needed for pio1 + $cfg_cppdefs .= " -D_USEBOX"; + } +} + +# COSP simulator +if ($cosp) { $cfg_cppdefs .= ' -DUSE_COSP'; } + +# CLUBB, hardcode CLUBB precision to kind=8 +if ($clubb_sgs == 1) { + $cfg_cppdefs .= ' -DCLUBB_SGS'; + $cfg_cppdefs .= ' -DCLUBB_CAM'; + $cfg_cppdefs .= ' -DNO_LAPACK_ISNAN'; + $cfg_cppdefs .= " -DCLUBB_REAL_TYPE=dp"; +} + +# UNICON +if ($unicon) { $cfg_cppdefs .= ' -DUSE_UNICON'; } + +# GPTL Timing library +# The GPTL configure script in timing/gptl/suggestions may help +# if modifications are needed here. +$cfg_cppdefs .= ' -DHAVE_VPRINTF -DHAVE_TIMES -DHAVE_GETTIMEOFDAY -DHAVE_COMM_F2C'; +unless ($target_os eq 'aix' or $target_os =~ 'bg' or $target_os eq 'darwin') { + $cfg_cppdefs .= ' -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC'; +} +#----------------------------------------------------------------------------------------------- +# External libraries ########################################################################### +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# NetCDF include +my $nc_inc = ''; +if ($cam_build) { + if (defined $opts{'nc_inc'}) { + $nc_inc = $opts{'nc_inc'}; + } + elsif (defined $ENV{INC_NETCDF}) { + $nc_inc = $ENV{INC_NETCDF}; + } + + $cfg_ref->set('nc_inc', $nc_inc); + + if ($nc_inc and $print>=2) { print "Will look for NetCDF include file in: $nc_inc$eol"; } +} + +# NetCDF library +my $nc_lib = ''; +my $nc_ldflags = ''; +if ($cam_build) { + if (defined $opts{'nc_lib'}) { + $nc_lib = $opts{'nc_lib'}; + } + elsif (defined $ENV{LIB_NETCDF}) { + $nc_lib = $ENV{LIB_NETCDF}; + } + + $cfg_ref->set('nc_lib', $nc_lib); + if ($nc_lib and $print>=2) { print "Will look for netCDF library in: $nc_lib$eol"; } + + # If the location of the NetCDF libraries has not been specified, then + # assume the compiler wrapper script is providing the information. + # Otherwise we attempt to set the necessary link arguments in the + # nc_ldflags variable using the nc-config utility. We check that + # nc-config returns at least the netcdff and netcdf libraries, and + # if not then attempt using a generic setting. + + if ($nc_lib ne '') { + if (-f "$nc_lib/../bin/nc-config") { + $nc_ldflags = `$nc_lib/../bin/nc-config --flibs --libs`; + $nc_ldflags =~ s/\n/ /g; # replace newlines with spaces + if ($?) { + if ($print >= 2) {print "INFO: error return from: nc-config --flibs --libs \n";} + $nc_ldflags = ''; + } + } + + # If the nc-config script was not found, or if it returned an error + # status, or if they return a string that doesn't contain two + # library (-l) specifiers, then try default link args. + + if ($nc_ldflags !~ m/-l.*-l/) { + $nc_ldflags = "-L$nc_lib -lnetcdff -lnetcdf"; + } + + # Set rpath for shared libs. First check whether the nc-config script + # has already set an arg to be passed to the linker. + if ($nc_ldflags !~ m/-Wl/) { + if ($fc_type eq 'nag') { + $nc_ldflags .= " -Wl,-Wl,,-rpath -Wl,-Wl,,$nc_lib"; + } + else { + $nc_ldflags .= " -Wl,-rpath -Wl,$nc_lib"; + } + } + + } + + $cfg_ref->set('nc_ldflags', $nc_ldflags); + if ($nc_ldflags and $print>=2) { print "Link flags for netCDF library: $nc_ldflags$eol"; } + + # PIO Support + if (!$pio2_build) { + # Only needed for pio1 + $cfg_cppdefs .= " -D_NETCDF "; + } +} + +# NetCDF module files +my $nc_mod = ''; +if ($cam_build) { + if (defined $opts{'nc_mod'}) { + $nc_mod = $opts{'nc_mod'}; + } + elsif (defined $ENV{MOD_NETCDF}) { + $nc_mod = $ENV{MOD_NETCDF}; + } + + # check for the mod files in the user specified location + if ($nc_mod and (-f "$nc_mod/netcdf.mod" or -f "$nc_mod/NETCDF.mod") + and (-f "$nc_mod/typesizes.mod" or -f "$nc_mod/TYPESIZES.mod") ) { + } + # if not there check in the netcdf lib directory + elsif ($nc_lib and (-f "$nc_lib/netcdf.mod" or -f "$nc_lib/NETCDF.mod") + and (-f "$nc_lib/typesizes.mod" or -f "$nc_lib/TYPESIZES.mod") ) { + $nc_mod = $nc_lib; + } + # then check in the netcdf include directory + elsif ($nc_inc and (-f "$nc_inc/netcdf.mod" or -f "$nc_inc/NETCDF.mod") + and (-f "$nc_inc/typesizes.mod" or -f "$nc_inc/TYPESIZES.mod") ) { + $nc_mod = $nc_inc; + } + else { + $nc_mod = ''; + } + $cfg_ref->set('nc_mod', $nc_mod); + + if ($nc_mod and $print>=2) { print "Found netCDF module files in: $nc_mod$eol"; } +} + +# PNetCDF include +my $pnc_inc = ''; +if ($cam_build) { + if (defined $opts{'pnc_inc'}) { + $pnc_inc = $opts{'pnc_inc'}; + } + elsif (defined $ENV{INC_PNETCDF}) { + $pnc_inc = $ENV{INC_PNETCDF}; + } + else { + $pnc_inc = '/usr/local/include'; + } + + if (-f "$pnc_inc/pnetcdf.inc") { + $cfg_ref->set('pnc_inc', $pnc_inc); + if ($print>=2) { print "Found PnetCDF include file in: $pnc_inc$eol"; } + }else{ + undef $pnc_inc; + } +} + +# PNetCDF library +my $pnc_lib = ''; +if ($cam_build) { + if (defined $opts{'pnc_lib'}) { + $pnc_lib = $opts{'pnc_lib'}; + } + elsif (defined $ENV{LIB_PNETCDF}) { + $pnc_lib = $ENV{LIB_PNETCDF}; + } + else { + $pnc_lib = '/usr/local/lib'; + } + + if (-f "$pnc_lib/libpnetcdf.a" and $spmd eq 'ON') { + $cfg_ref->set('pnc_lib', $pnc_lib); + if ($print>=2) { print "Found PnetCDF library in: $pnc_lib$eol"; } + # PIO Support + $cfg_cppdefs .= " -D_PNETCDF "; + }else{ + undef $pnc_lib; + } +} + +#----------------------------------------------------------------------------------------------- +# LAPACK library +my $lapack_libdir = ''; +if ($cam_build) { + if (defined $opts{'lapack_libdir'}) { + $lapack_libdir = $opts{'lapack_libdir'}; + } + elsif (defined $ENV{LAPACK_LIBDIR}) { + $lapack_libdir = $ENV{LAPACK_LIBDIR}; + } + + if ($lapack_libdir ne '') { + if (-f "$lapack_libdir/liblapack.a") { + $cfg_ref->set('lapack_libdir', $lapack_libdir); + } + elsif (-f "$lapack_libdir/liblapack.so") { + $cfg_ref->set('lapack_libdir', $lapack_libdir); + } + elsif (-f "$lapack_libdir/liblapack.dylib") { + $cfg_ref->set('lapack_libdir', $lapack_libdir); + } + else { + die <<"EOF"; +** Cannot find liblapack.a in specified directory: $lapack_libdir +** +** The LAPACK library directory is determined from the following set of options listed +** from highest to lowest precedence: +** * by the command-line option -lapack_libdir +** * by the environment variable LAPACK_LIBDIR +EOF + } + } + + if ($lapack_libdir and $print>=2) { print "Found LAPACK library in: $lapack_libdir$eol"; } +} + +#----------------------------------------------------------------------------------------------- +# ESSL library -- add this library to the LDFLAGS for CAMChem when we're on an AIX system. +# Assume that the xlf compiler is used to link. +if ($cam_build) { + if ($chem_pkg and $target_os eq 'aix') { + my $ldflags = $cfg_ref->get('ldflags'); + $ldflags .= " -lessl"; + $cfg_ref->set('ldflags', $ldflags); + } +} + +#----------------------------------------------------------------------------------------------- +# MPI +# Only check for the MPI include or library files if the user has explicitly specified +# where to look. Often the Fortran compiler knows where to look for these files and so +# not specifying them is the best strategy. +my $mpi_inc = ''; +my $mpi_lib = ''; +my $mpi_lib_name = ''; +if ($cam_build and $spmd eq 'ON') { + + # MPI include + if (defined $opts{'mpi_inc'}) { + $mpi_inc = $opts{'mpi_inc'}; + } + elsif (defined $ENV{INC_MPI}) { + $mpi_inc = $ENV{INC_MPI}; + } + + if ($mpi_inc eq '' or -f "$mpi_inc/mpif.h") { + $cfg_ref->set('mpi_inc', $mpi_inc); + } + else { + die <<"EOF"; +** Cannot find mpif.h in specified directory: $mpi_inc +** +** The MPI include directory is determined from the following set of options listed +** from highest to lowest precedence: +** * by the command-line option -mpi_inc +** * by the environment variable INC_MPI +EOF + } + + if ($mpi_inc and $print>=2) { print "Found MPI include file in: $mpi_inc$eol"; } + + # MPI library + if (defined $opts{'mpi_lib'}) { + $mpi_lib = $opts{'mpi_lib'}; + } + elsif (defined $ENV{LIB_MPI}) { + $mpi_lib = $ENV{LIB_MPI}; + } + + if ($mpi_lib eq '') { + $cfg_ref->set('mpi_lib', $mpi_lib); + $cfg_ref->set('mpi_lib_name', ''); + } + elsif (-f "$mpi_lib/libmpi.a" or -f "$mpi_lib/libmpi.so") { + $cfg_ref->set('mpi_lib', $mpi_lib); + $cfg_ref->set('mpi_lib_name', 'mpi'); + } + elsif (-f "$mpi_lib/libmpich.a") { + $cfg_ref->set('mpi_lib', $mpi_lib); + $cfg_ref->set('mpi_lib_name', 'mpich'); + if (-f "$mpi_lib/../bin/mpich2version") { + $cfg_cppdefs .= " -DNO_SIZEOF"; + } else { + $cfg_cppdefs .= " -DNO_MPI2 -DNO_MPIMOD -DNO_SIZEOF"; + } + } + else { + die <<"EOF"; +** Cannot find libmpi.a, libmpi.so or libmpich.a in specified directory: $mpi_lib +** +** The MPI library directory is determined from the following set of options listed +** from highest to lowest precedence: +** * by the command-line option -mpi_lib +** * by the environment variable LIB_MPI +EOF + } + + if ($mpi_lib and $print>=2) { print "Found MPI library in: $mpi_lib$eol"; } + +} + +#----------------------------------------------------------------------------------------------- +# ESMF library. + +my $esmf_libdir = ''; +if (defined $opts{'esmf_libdir'}) { + $esmf_libdir = $opts{'esmf_libdir'}; +} +elsif (defined $ENV{ESMF_LIBDIR}) { + $esmf_libdir = $ENV{ESMF_LIBDIR}; +} + +if ($cam_build and $esmf_libdir) { + + # Check that both the library and the esmf.mk file are found. Makefile macros + # defined in esmf.mk are referenced by the Makefile. + if ( (-f "$esmf_libdir/libesmf.a" or -f "$esmf_libdir/libesmf.so") and -f "$esmf_libdir/esmf.mk" ) { + $cfg_ref->set('esmf_libdir', $esmf_libdir); + + $cfg_cppdefs .= " -DUSE_ESMF_LIB"; + + if ($print>=2 ) { print "Found ESMF library in: $esmf_libdir$eol"; } + } + else { + die <<"EOF"; +** Cannot find libesmf.a, libesmf.so, or esmf.mk in specified directory: $esmf_libdir +** +** The ESMF library directory is determined from the following set of options listed +** from highest to lowest precedence: +** * by the command-line option -esmf_libdir +** * by the environment variable ESMF_LIBDIR +EOF + } + +} + +#----------------------------------------------------------------------------------------------- +# CPP defines to put on Makefile + +my $make_cppdefs = "$usr_cppdefs $cfg_cppdefs"; + +if ($print>=2) { print "CPP definitions set by configure: \'$cfg_cppdefs\'$eol"; } + + +#----------------------------------------------------------------------------------------------- +# COSP library. +if ($cosp) { + + # Set the directory used to build cosp. Add location and library name + # to the user specified load flags. + my $cosp_libdir = ''; + if (defined $opts{'cosp_libdir'}) { + $cosp_libdir = $opts{'cosp_libdir'}; + } else + { + $cosp_libdir = "$cam_bld/cosp"; + } + + $cfg_ref->set('cosp_libdir', "$cosp_libdir"); + + my $ldflags = $cfg_ref->get('ldflags'); + $ldflags .= " -L$cosp_libdir -lcosp "; + $cfg_ref->set('ldflags', $ldflags); + + # create the build directory for cosp + my $bld_dir = $cosp_libdir; + unless (-d $bld_dir or mkdirp($bld_dir)) { + die "** Could not create the cosp build directory: $bld_dir\n"; + } + + # Create the COSP Makefile from a template and copy it into the cosp bld directory + write_cosp_makefile("$cfgdir/../src/physics/cosp2/Makefile.in", "$cosp_libdir/Makefile"); + if ($print) { print "creating $cosp_libdir/Makefile\n"; } +} + + +#----------------------------------------------------------------------------------------------- +# MCT library. +# Only build MCT as a separate library if doing a CAM standalone build. +# If -mct_libdir is specified, then check for existing libs and build +# only if necessary. Note that separate versions of the lib must be built +# for parallel and serial use. + +if ($cam_build) { + + my $mct_libdir = "$cam_bld/mct"; + if (defined $opts{'mct_libdir'}) { + $mct_libdir = $opts{'mct_libdir'}; + } + elsif (defined $ENV{MCT_LIBDIR}) { + $mct_libdir = $ENV{MCT_LIBDIR}; + } + + # strip a trailing slash + $mct_libdir =~ s!/$!!; + + # modify the name of the serial version so it can be made in the same + # directory as the parallel version + if ($spmd eq 'OFF') { + $mct_libdir .= '-serial'; + } + $cfg_ref->set('mct_libdir', $mct_libdir); + + my $ldflags = $cfg_ref->get('ldflags'); + $ldflags .= " -L$mct_libdir/mct -lmct -L$mct_libdir/mpeu -lmpeu "; + if ($spmd eq 'OFF') { + $ldflags .= " -L$mct_libdir/mpi-serial -lmpi-serial "; + } + $cfg_ref->set('ldflags', $ldflags); + + # Check whether the MCT libs already exist. The MCT configuration here is + # set up to build mct, mpeu, and mpi-serial libs. So either they all should + # exist, or non of them should exist. Otherwise it's an error. + my $libs_exist = 0; + my $libs_expected = 2; + if (-f "$mct_libdir/mct/libmct.a" or + -f "$mct_libdir/mct/libmct.so") {++$libs_exist;} + if (-f "$mct_libdir/mpeu/libmpeu.a" or + -f "$mct_libdir/mpeu/libmpeu.so") {++$libs_exist;} + if ($spmd eq 'OFF') { + $libs_expected = 3; + if (-f "$mct_libdir/mpi-serial/libmpi-serial.a" or + -f "$mct_libdir/mpi-serial/libmpi-serial.so") {++$libs_exist;} + } + + my $build_mct; + if ($libs_exist == 0) { + $build_mct = 1; + } + elsif ($libs_exist == $libs_expected) { + $build_mct = 0; + } + else { + die <<"EOF"; +** The MCT build in $mct_libdir is incomplete. Remove the contents of + $mct_libdir and run the CAM configure script again. ** +EOF + } + + + if ($build_mct) { + + # If the libdirs do not exist then create them. + if (! -d "$mct_libdir/mct") { + mkdirp("$mct_libdir/mct") or + die "** Could not create the mct build directory: $mct_libdir/mct\n"; + } + if (! -d "$mct_libdir/mpeu") { + mkdirp("$mct_libdir/mpeu") or + die "** Could not create the mct build directory: $mct_libdir/mpeu\n"; + } + + if ($spmd eq 'OFF') { + # The mpi-serial lib is only built when the mct and mpeu libs are configured + # to run in a serial mode (with the --enable-mpiserial option). + if (! -d "$mct_libdir/mpi-serial") { + mkdirp("$mct_libdir/mpi-serial") or + die "** Could not create the mct build directory: $mct_libdir/mpi-serial\n"; + } + } + + system("cp $cam_root/cime/src/externals/mct/Makefile $mct_libdir/.") == 0 + or die "Unable to copy mct top level Makefile\n"; + system("cp $cam_root/cime/src/externals/mct/mct/Makefile $mct_libdir/mct/.") == 0 + or die "Unable to copy mct Makefile\n"; + system("cp $cam_root/cime/src/externals/mct/mpeu/Makefile $mct_libdir/mpeu/.") == 0 + or die "Unable to copy mpeu Makefile\n"; + if ($spmd eq 'OFF') { + system("cp $cam_root/cime/src/externals/mct/mpi-serial/Makefile $mct_libdir/mpi-serial/.") == 0 + or die "Unable to copy mpi-serial Makefile\n"; + system("cp $cam_root/cime/src/externals/mct/mpi-serial/mpif.h $mct_libdir/mpi-serial/.") == 0 + or die "Unable to copy mpi-serial/mpif.h \n"; + system("cp $cam_root/cime/src/externals/mct/mpi-serial/mpi.h $mct_libdir/mpi-serial/.") == 0 + or die "Unable to copy mpi-serial/mpi.h\n"; + } + + my $mct_quiet = '> /dev/null 2>&1'; + if ($print >= 2) {$mct_quiet = '';} + + my $mct_debug = ''; + if ($debug eq 'ON') {$mct_debug = '--enable-debugging';} + + my $mpi_serial = '--enable-mpiserial'; + if ($spmd eq 'ON') {$mpi_serial = '';} + + my $mpi_hdr = ''; + if ($spmd eq 'ON') { + if ($mpi_inc) {$mpi_hdr = "MPIHEADER=-I$mpi_inc"; } + } + + # Set F[C]FLAGS for MCT for compilers where the defaults won't work. + # Blank string does nothing, letting MCT's configure decide. + my $mct_flags_str = " "; + my $mct_ldflags = " "; + if ($fc_type eq "nag") { + # Take options from CESM's Machines directory. + $mct_flags_str = " -O2 -wmismatch=mpi_send,mpi_recv,mpi_bcast,". + "mpi_allreduce,mpi_reduce,mpi_isend,mpi_irecv,mpi_irsend,mpi_rsend,mpi_gatherv,". + "mpi_gather,mpi_scatterv,mpi_allgather,mpi_alltoallv,mpi_file_read_all,". + "mpi_file_write_all,mpibcast,mpiscatterv "; + + if ($debug eq 'ON') { $mct_flags_str .= " -g -gline -time -f95 -C=all "; } + + # Set to both FFLAGS and FCFLAGS to ensure all files use this. + $mct_flags_str = " FFLAGS=\"$mct_flags_str\" ". + "FCFLAGS=\"$mct_flags_str\" "; + + # This workaround tells gcc how to link to the NAG runtime, + # which is the only way to run MCT's configure with runtime + # checks enabled. + # Note that this hard-codes the NAG path, lib60rts for NAG6.0. + if ($debug eq 'ON') { + $mct_flags_str .= " CFLAGS=\" -g -Wl,--as-needed,--allow-shlib-undefined\" "; + $mct_flags_str .= " LIBS=\" -L/usr/local/nag/lib/NAG_Fortran -lf60rts \" "; + } + } + elsif ($fc_type eq "pgi") { + + # 11 Feb 2014: This is a workaround for a problem with PGI-13 + # on the CGD cluster when pgf90 is invoked by the openmpi + # version of mpif90 (undefined omp_set_schedule in pgf90rtl lib) + $mct_ldflags = "-Wl,--allow-shlib-undefined "; + } + + $mct_ldflags = "LDFLAGS=\'$mct_ldflags\' "; + + my $cfg_cmnd = "$cam_root/cime/src/externals/mct/configure FC=$fc CC=$cc ". + "$mct_flags_str --srcdir=$cam_root/cime/src/externals/mct $mpi_hdr ". + "$mpi_serial $mct_debug $mct_quiet $mct_ldflags "; + + chdir $mct_libdir or die "FAILURE: cd to $mct_libdir\n"; + system($cfg_cmnd) == 0 or die "FAILURE: MCT configure\n"; + chdir $cam_bld or die "FAILURE: cd to $cam_bld\n"; + + if ($print) {print "MCT configure is done.\n";} + } + else { + if ($print) {print "Using MCT libs in $mct_libdir.\n";} + } +} + +#----------------------------------------------------------------------------------------------- +# PIO library. +# Only build PIO as a separate library if doing a CAM standalone build with PIO2. +# If -pio2_install_dir is specified, then check for existing libs and build +# only if necessary. Note that separate versions of the lib must be built +# for parallel and serial use. + +if ($cam_build and $pio2_build) { + + my $pio_build_dir = "$cam_bld/pio_bld"; + my $pio_install_dir = "$cam_bld/pio"; + if (defined $opts{'pio2_install_dir'}) { + $pio_install_dir = $opts{'pio2_install_dir'}; + } + elsif (defined $ENV{PIO2_INSTALL_DIR}) { + $pio_install_dir = $ENV{PIO2_INSTALL_DIR}; + } + + # strip a trailing slash + $pio_install_dir =~ s!/$!!; + + # modify the name of the serial version so it can be made in the same + # directory as the parallel version + if ($spmd eq 'OFF') { + $pio_build_dir .= '-serial'; + $pio_install_dir .= '-serial'; + } + $cfg_ref->set('pio_build_dir', $pio_build_dir); + $cfg_ref->set('pio_install_dir', $pio_install_dir); + + my $ldflags = $cfg_ref->get('ldflags'); + # prepend the pio libs. The serial build which depends on the MCT mpi-serial + # lib needs to come after the pio libs to properly resolve mpi references. + $ldflags = " -L$pio_install_dir/lib -lpiof -lpioc $ldflags "; + $cfg_ref->set('ldflags', $ldflags); + + # Check whether the PIO libs already exist. + my $libs_exist = 0; + my $libs_expected = 2; + if (-f "$pio_install_dir/lib/libpioc.a" or + -f "$pio_install_dir/lib/libpioc.so") {++$libs_exist;} + if (-f "$pio_install_dir/lib/libpiof.a" or + -f "$pio_install_dir/lib/libpiof.so") {++$libs_exist;} + + my $build_pio; + if ($libs_exist == 0) { + $build_pio = 1; + } + elsif ($libs_exist == $libs_expected) { + $build_pio = 0; + } + else { + die <<"EOF"; +** PIO build in $pio_install_dir is incomplete. Remove the contents of + $pio_install_dir and run the CAM configure script again. ** +EOF + } + + if ($build_pio) { + + # The PIO configuration requires CMake. Check return from --version just as a way + # to make sure it is found in user path. + if ($print) { print "Looking for a valid CMake... "; } + my $cmake_ver = get_cmake_version(); + if ($cmake_ver) { + if ($print) { print "using cmake version $cmake_ver$eol"; } + } else { + print "\n** Cannot find a valid CMake.\n"; + die "** CMake must be installed on your system and the cmake command in your PATH\n"; + } + + # If the build directory does not exist then create it. + if (! -d "$pio_build_dir") { + mkdirp("$pio_build_dir") or + die "** Could not create the PIO build directory: $pio_build_dir\n"; + } + + # If the install directory does not exist then create it. + if (! -d "$pio_install_dir") { + mkdirp("$pio_install_dir") or + die "** Could not create the PIO install directory: $pio_install_dir\n"; + } + + # Root directory for PIO source code + my $pio_src_dir = "$cam_root/cime/src/externals/pio2"; + + # Set compilers + my $compilers = "FC=$fc CC=$cc"; + + # Set options + my $opts; + + my $nc_lib = $cfg_ref->get('nc_lib'); + if ($nc_lib) {$opts .= "-DNetCDF_PATH=$nc_lib ";} + + $opts .= '-DCMAKE_VERBOSE_MAKEFILE=1 -DPIO_ENABLE_TIMING=OFF -DWITH_PNETCDF=OFF -DPIO_ENABLE_TESTS=OFF '; + + $opts .= "-DCMAKE_INSTALL_PREFIX=$pio_install_dir "; + + # For serial runs the MPI library is supplied by MCT: + # If the mpi-serial library is already built then specifying MPISERIAL_PATH is + # sufficient since CMake will find what it needs by looking there. But if the + # mpi-serial lib hasn't been built yet, then the MPISERIAL_C_* and MPISERIAL_Fortran_* + # options must be specified to tell CMake where the include and lib files will be + # found after the build is done. + if ($spmd eq 'OFF') { + my $mct_libdir = $cfg_ref->get('mct_libdir'); + $opts .= "-DPIO_USE_MPISERIAL=TRUE "; + $opts .= "-DMPISERIAL_PATH=$mct_libdir/mpi-serial "; + $opts .= "-DMPISERIAL_C_INCLUDE_PATH=$mct_libdir/mpi-serial "; + $opts .= "-DMPISERIAL_C_LIBRARY=$mct_libdir/mpi-serial/libmpi-serial.a "; + $opts .= "-DMPISERIAL_Fortran_INCLUDE_PATH=$mct_libdir/mpi-serial "; + $opts .= "-DMPISERIAL_Fortran_LIBRARY=$mct_libdir/mpi-serial/libmpi-serial.a "; + } + + # Configure command + my $cfg_cmnd = "env $compilers cmake $opts $pio_src_dir >| pio_cmake_log 2>&1 "; + + + chdir $pio_build_dir or die "FAILURE: cd to $pio_build_dir\n"; + system($cfg_cmnd) == 0 or die "FAILURE: PIO configure: see $pio_build_dir/pio_cmake_log \n"; + chdir $cam_bld or die "FAILURE: cd to $cam_bld\n"; + + if ($print) {print "PIO configure is done.\n";} + } + else { + if ($print) {print "Using PIO libs in $pio_install_dir.\n";} + } +} + + +#----------------------------------------------------------------------------------------------- +# Write configuration files #################################################################### +#----------------------------------------------------------------------------------------------- + +my $fp_filename = 'Filepath'; # name of output filepath file +my $cpp_filename = 'CESM_cppdefs'; # name of output file for cam's cppdefs in ccsm + +# Write the filepath file. +write_filepath("$cam_bld/$fp_filename", $cfg_ref); +if ($print) { print "creating $cam_bld/$fp_filename\n"; } + +if (($ccsm_seq)) { + + # Write the file for cam's cppdefs needed in ccsm. + write_cppdefs("$cam_bld/$cpp_filename", $make_cppdefs); + if ($print) { print "creating $cam_bld/$cpp_filename\n"; } + +} else { + + # Write the Makefile. + write_makefile("$cfgdir/Makefile.in", "$cam_bld/Makefile", $cfg_ref, $make_cppdefs); + if ($print) { print "creating $cam_bld/Makefile\n"; } + + # Write the config.h file for PIO and MCT + write_config_h("$cam_bld/config.h"); + if ($print) { print "creating $cam_bld/config.h\n"; } + +} + +# Write the configuration cache file. +$cfg_ref->write_file($config_cache_file, $commandline); +if ($print) { print "creating $config_cache_file\n"; } + +#----------------------------------------------------------------------------------------------- +# Finished unless testing requested ############################################################ +#----------------------------------------------------------------------------------------------- +unless ($cam_build and $opts{'test'}) { + if ($print) { print "CAM configure done.\n"; } + exit; +} + +# create a subdirectory of the current directory for testing +my $test_dir = "$cam_bld/configure-tests"; +unless (-d $test_dir or mkdirp($test_dir)) { + die <<"EOF"; +** Could not create the testing directory: $test_dir +EOF +} +chdir( $test_dir ) || die <<"EOF"; +** Trouble changing directory to $test_dir +** +EOF + +# The CAM Makefile requires a Filepath file. To run the tests construct a Filepath file +# that contains only the test directory. +write_tests_filepath($test_dir); + +# Test for Fortran 90 compatible compiler +if ($print) { print "Testing for Fortran 90 compatible compiler... "; } +my $fc = check_fc($gmake, "$cam_bld/Makefile"); +if ($fc) { + if ($print) { print "using $fc$eol"; } +} + +# Test NetCDF library +if ($print) { print "Test linking to NetCDF library... "; } +if (check_netcdf($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } + +# Test MPI library +if ($spmd eq 'ON') { + if ($print) { print "Test linking to MPI library... "; } + if (check_mpi($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } +} + +# Test ESMF library +if ($esmf_libdir) { + if ($print) { print "Test linking to ESMF library... "; } + if (check_esmf($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } +} + +#----------------------------------------------------------------------------------------------- +# Done testing. +chdir( $cwd ) || die <<"EOF"; +** Trouble changing directory back to $cwd +** +EOF +if ($print) { print "CAM configure done.\n"; } +exit; + +#----------------------------------------------------------------------------------------------- +# REALLY FINISHED ############################################################################## +#----------------------------------------------------------------------------------------------- + +sub write_filepath +{ + my ($file, $cfg_ref) = @_; + my $fh = new IO::File; + + $fh->open(">$file") or die "** can't open filepath file: $file\n"; + + # configuration parameters used to determine paths + my $cam_root = $cfg_ref->get('cam_root'); + my $usr_src = $cfg_ref->get('usr_src'); + my $chem_proc_src = $cfg_ref->get('chem_proc_src'); + my $chem_src_dir = $cfg_ref->get('chem_src_dir'); + my $chem = $cfg_ref->get('chem'); + my $waccm_phys = $cfg_ref->get('waccm_phys'); + my $waccmx = $cfg_ref->get('waccmx'); + my $ionos = $cfg_ref->get('ionosphere'); + my $carma = $cfg_ref->get('carma'); + my $rad = $cfg_ref->get('rad'); + my $dyn = $cfg_ref->get('dyn'); + my $cppdefs = $cfg_ref->get('cppdefs'); + my $cosp = $cfg_ref->get('cosp'); + my $spmd = $cfg_ref->get('spmd'); + my $esmf_libdir = $cfg_ref->get('esmf_libdir'); + my $ocn = $cfg_ref->get('ocn'); + my $offline_drv = $cfg_ref->get('offline_drv'); + my $inic_val = $cfg_ref->get('analytic_ic'); + + # Root directory + my $camsrcdir = $cfg_ref->get('cam_dir'); + + # Start writing paths to the file. *** Order is important *** The + # sequence of paths will be used to set the GNU Makefile's VPATH macro + # which tells make where to search for dependencies. + + # User specified source directories. + if ($usr_src =~ /\S+/) { + my @dirs = split ',', $usr_src; + while ( my $dir = shift @dirs ) { + print $fh "$dir\n"; + } + } + + # CESM has a standard source mods location. + if ($ccsm_seq) { + my $CASEROOT = "$ENV{'CASEROOT'}"; + print $fh "$CASEROOT/SourceMods/src.cam\n"; + } + + # offline unit driver (defaults to stub) + print $fh "$camsrcdir/src/unit_drivers\n"; + print $fh "$camsrcdir/src/unit_drivers/${offline_drv}\n"; + + if ($simple_phys) { + print $fh "$camsrcdir/src/physics/simple\n"; + } + + if ($carma ne 'none') { + # This directory needs to precede physics/cam/ to replace + # the CARMA stub package with CARMA. Putting it first allows + # any CAM file to be overridden by a particular CARMA model. + print $fh "$camsrcdir/src/physics/carma/models/$carma\n"; + print $fh "$camsrcdir/src/physics/carma/cam\n"; + print $fh "$camsrcdir/src/physics/carma/base\n"; + } + + # CAM chemistry, dynamics, physics, control and shared utilities. + if ($chem_proc_src) { + print $fh "$chem_proc_src\n"; + } + if ($chem_src_dir) { + print $fh "$chem_src_dir\n"; + } + if ($chem =~ /_mam/) { + print $fh "$camsrcdir/src/chemistry/modal_aero\n"; + } else { + print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; + } + print $fh "$camsrcdir/src/chemistry/aerosol\n"; + + if ($waccmx) { + print $fh "$camsrcdir/src/physics/waccmx\n"; + if ($ionos =~ /wxi/) { + print $fh "$camsrcdir/src/ionosphere/waccmx\n"; + } + } + if ($waccm_phys) { + print $fh "$camsrcdir/src/physics/waccm\n"; + } + print $fh "$camsrcdir/src/ionosphere\n"; + + print $fh "$camsrcdir/src/chemistry/mozart\n"; + print $fh "$camsrcdir/src/chemistry/utils\n"; + + if ($rad eq 'rrtmg') { + print $fh "$camsrcdir/src/physics/rrtmg\n"; + print $fh "$camsrcdir/src/physics/rrtmg/aer_src\n"; + } + elsif ($rad eq 'camrt') { + print $fh "$camsrcdir/src/physics/camrt\n"; + } + + if ($clubb_sgs eq '1') { + print $fh "$camsrcdir/src/physics/clubb\n"; + } + + # Superparameterization + if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { + print $fh "$camsrcdir/src/physics/spcam\n"; + print $fh "$camsrcdir/src/physics/spcam/crm\n"; + + # add additional directories for sam6.10.4 + print $fh "$camsrcdir/src/physics/spcam/crm/ADV_MPDATA\n"; + if ($phys_pkg eq 'spcam_sam1mom') { + print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_SAM1MOM\n"; + } + if ($phys_pkg eq 'spcam_m2005') { + print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_M2005\n"; + print $fh "$camsrcdir/src/physics/spcam/ecpp\n"; + } + if ( $spcam_clubb_sgs == 1 ) { + print $fh "$camsrcdir/src/physics/spcam/crm/CLUBB\n"; + print $fh "$camsrcdir/src/physics/spcam/crm/SGS_CLUBBkvhkvm\n" + } + else { + print $fh "$camsrcdir/src/physics/spcam/crm/SGS_TKE\n"; + } + } + + # This directory contains much of the code for physics packages, + # as well as the cam specific interface modules that may need to + # be overridden by modules from directories that occur earlier + # in the list of filepaths. + print $fh "$camsrcdir/src/physics/cam\n"; + + # Dynamics package and test utilities + print $fh "$camsrcdir/src/dynamics/$dyn\n"; + if($dyn eq 'se') { + print $fh "$camsrcdir/src/dynamics/se/dycore\n"; + } + print $fh "$camsrcdir/src/dynamics/tests\n"; + if($inic_val) { + print $fh "$camsrcdir/src/dynamics/tests/initial_conditions\n"; + } + + # Parallelization utilies + if ($dyn eq 'fv' or $cppdefs =~ /MODCM_DP_TRANSPOSE/) { + print $fh "$camsrcdir/src/utils/pilgrim\n"; + } + + # Advective transport + if ($dyn eq 'eul') { + print $fh "$camsrcdir/src/advection/slt\n"; + } + + print $fh "$camsrcdir/src/cpl\n"; + print $fh "$camsrcdir/src/control\n"; + print $fh "$camsrcdir/src/utils\n"; + + if ($cam_build) { + + # These paths are only needed for CAM standalone builds + + if (!$pio2_build) { + print $fh "$cam_root/cime/src/externals/pio1/pio\n"; + } + + unless ($esmf_libdir) { + print $fh "$cam_root/cime/src/share/esmf_wrf_timemgr\n"; + } + + # Sequential Driver + print $fh "$cam_root/cime/src/drivers/mct/main\n"; + print $fh "$cam_root/cime/src/drivers/mct/shr\n"; + + # Ocean package. + if ($ocn eq 'dom') { + print $fh "$camsrcdir/src/utils/cam_dom\n"; + } + elsif ($ocn eq 'docn' or $ocn eq 'som') { + print $fh "$cam_root/cime/src/components/data_comps/docn\n"; + print $fh "$cam_root/cime/src/components/data_comps/docn/mct\n"; + } + elsif ($ocn eq 'aquaplanet') { + print $fh "$camsrcdir/src/utils/cam_aqua\n"; + print $fh "$camsrcdir/src/utils/cam_aqua/cpl\n"; + } + elsif ($ocn eq 'socn') { + print $fh "$cam_root/cime/src/components/stub_comps/socn/cpl\n"; + } + + # Land package + print $fh "$cam_root/cime/src/components/stub_comps/slnd/cpl\n"; + + # Sea ice package + print $fh "$cam_root/cime/src/components/stub_comps/sice/cpl\n"; + + # Land ice package + print $fh "$cam_root/cime/src/components/stub_comps/sglc/cpl\n"; + + # include stub ESP component + print $fh "$cam_root/cime/src/components/stub_comps/sesp/cpl/\n"; + + # Runoff package + print $fh "$cam_root/cime/src/components/stub_comps/srof/cpl\n"; + + # Wave package + print $fh "$cam_root/cime/src/components/stub_comps/swav/cpl\n"; + + # Share utilities + print $fh "$cam_root/cime/src/share/util\n"; + print $fh "$cam_root/cime/src/share/streams\n"; + print $fh "$cam_root/cime/src/share/include\n"; + print $fh "$cam_root/cime/src/share/RandNum/include\n"; + print $fh "$cam_root/cime/src/share/RandNum/src\n"; + print $fh "$cam_root/cime/src/share/RandNum/src/dsfmt_f03\n"; + print $fh "$cam_root/cime/src/share/RandNum/src/kissvec\n"; + print $fh "$cam_root/cime/src/share/RandNum/src/mt19937\n"; + + # GPTL and timing code +# print $fh "$cam_root/cime/src/externals/pio2/src/gptl\n"; + print $fh "$cam_root/cime/src/share/timing\n"; + + } + + $fh->close; +} + +#------------------------------------------------------------------------------- + +sub write_cppdefs +{ + my ($file, $make_cppdefs) = @_; + my $fh = new IO::File; + + $fh->open(">$file") or die "** can't open cpp defs file: $file\n"; + + print $fh "$make_cppdefs\n"; + + $fh->close; +} + +#------------------------------------------------------------------------------- + +sub write_makefile +{ + # Add macro definitions to the beginning of the Makefile + # in the CAM configuration script directory + + my ($file_in, $file_out, $cfg_ref, $make_cppdefs) = @_; + my $fh_in = new IO::File; + my $fh_out = new IO::File; + + $fh_out->open(">$file_out") or die "** can't open file: $file_out\n"; + + # configuration parameters + my $target_os = $cfg_ref->get('target_os'); + my $cam_root = $cfg_ref->get('cam_root'); + my $cam_exe = $cfg_ref->get('cam_exe'); + my $cam_exedir = $cfg_ref->get('cam_exedir'); + my $nc_inc = $cfg_ref->get('nc_inc'); + my $nc_lib = $cfg_ref->get('nc_lib'); + my $nc_mod = $cfg_ref->get('nc_mod'); + my $mpi_inc = $cfg_ref->get('mpi_inc'); + my $mpi_lib = $cfg_ref->get('mpi_lib'); + my $mpi_lib_name = $cfg_ref->get('mpi_lib_name'); + my $debug = $cfg_ref->get('debug') ? 'TRUE' : 'FALSE'; + my $spmd = $cfg_ref->get('spmd') ? 'TRUE' : 'FALSE'; + my $smp = $cfg_ref->get('smp') ? 'TRUE' : 'FALSE'; + my $fc = $cfg_ref->get('fc'); + my $fc_type = $cfg_ref->get('fc_type'); + my $cc = $cfg_ref->get('cc'); + my $linker = $cfg_ref->get('linker'); + my $cflags = $cfg_ref->get('cflags'); + my $fflags = $cfg_ref->get('fflags'); + my $fopt = $cfg_ref->get('fopt'); + my $ldflags = $cfg_ref->get('ldflags'); + my $cosp_libdir = $cfg_ref->get('cosp_libdir'); + my $mct_libdir = $cfg_ref->get('mct_libdir'); + my $pio_build_dir = $cfg_ref->get('pio_build_dir'); + my $pio_install_dir = $cfg_ref->get('pio_install_dir'); + + # map between local os names ($OSNAME) and names which are + # used in the Makefile (return value from "uname -s" command). + my %uname_map = ( 'aix' => 'AIX', + 'darwin' => 'Darwin', + 'dec_osf' => 'OSF1', + 'es' => 'ES', + 'irix' => 'IRIX64', + 'linux' => 'Linux', + 'solaris' => 'SunOS', + 'super-ux' => 'SUPER-UX', + 'unicosmp' => 'UNICOS/mp', + 'bgl' => 'BGL', + 'bgp' => 'BGP', + 'bgq' => 'BGQ', + ); + + print $fh_out <<"EOF"; +# Make macros for CAM. + +UNAMES := $uname_map{$target_os} +ROOTDIR := $cam_root +EXENAME := $cam_exe +MODEL_EXEDIR := $cam_exedir +INC_NETCDF := $nc_inc +LIB_NETCDF := $nc_lib +NC_LDFLAGS := $nc_ldflags +MOD_NETCDF := $nc_mod +INC_PNETCDF := $pnc_inc +LIB_PNETCDF := $pnc_lib +INC_MPI := $mpi_inc +LIB_MPI := $mpi_lib +MPI_LIB_NAME := $mpi_lib_name +LAPACK_LIBDIR := $lapack_libdir +ESMF_LIBDIR := $esmf_libdir +DEBUG := $debug +SPMD := $spmd +SMP := $smp +FC := $fc +FC_TYPE := $fc_type +CC := $cc +USER_LINKER := $linker +USER_CPPDEFS := $make_cppdefs +USER_CFLAGS := $cflags +USER_FFLAGS := $fflags +F_OPTIMIZATION_OVERRIDE := $fopt +USER_LDFLAGS := $ldflags +COSP_LIBDIR := $cosp_libdir +MCT_LIBDIR := $mct_libdir +PIO_BUILD_DIR := $pio_build_dir +PIO_INSTALL_DIR := $pio_install_dir +#GPTL_SRCDIR := $cam_root/cime/src/externals/pio2/gptl +TIMING_SRCDIR := $cam_root/cime/src/share/timing + +EOF + + # Copy the "template" makefile to the new makefile. + $fh_in->open("<$file_in") or die "** can't open file: $file_in\n"; + while (<$fh_in>) { + print $fh_out $_; + } + + $fh_out->close; + $fh_in->close; +} + +#------------------------------------------------------------------------------- + +sub write_cosp_makefile +{ + + my ($file_in, $file_out) = @_; + my $fh_in = new IO::File; + my $fh_out = new IO::File; + + $fh_out->open(">$file_out") or die "** can't open file: $file_out\n"; + + print $fh_out <<"EOF"; + +CAM_BLD := $cam_bld +COSP_PATH := $cam_dir/src/physics/cosp2 +ISCCP_PATH := $cam_dir/src/physics/cosp2/src/simulator/icarus +RS_PATH := $cam_dir/src/physics/cosp2/src/simulator/quickbeam +RT_PATH := $cam_dir/src/physics/cosp2/src/simulator/rttov +CS_PATH := $cam_dir/src/physics/cosp2/src/simulator/actsim +MISR_PATH := $cam_dir/src/physics/cosp2/src/simulator/MISR_simulator +MODIS_PATH := $cam_dir/src/physics/cosp2/src/simulator/MODIS_simulator +PARASOL_PATH := $cam_dir/src/physics/cosp2/src/simulator/parasol + +EOF + + # Copy the "template" makefile to the new makefile. + $fh_in->open("<$file_in") or die "** can't open file: $file_in\n"; + while (<$fh_in>) { + print $fh_out $_; + } + + $fh_out->close; + $fh_in->close; +} + + +#------------------------------------------------------------------------------- + +sub write_config_h +{ + my ($file) = @_; + my $fh = new IO::File; + + $fh->open(">$file") or die "** can't open config.h file for MCT: $file\n"; + + print $fh <<"EOF"; +#ifdef FORTRAN_SAME +#define FC_FUNC(name,NAME) name +#elif FORTRANUNDERSCORE +#define FC_FUNC(name,NAME) name ##_ +#elif FORTRANDOUBLEUNDERSCORE +#define FC_FUNC(name,NAME) name ##__ +#endif +EOF + + $fh->close; +} + +#------------------------------------------------------------------------------- + +sub set_horiz_grid +{ + # Set the parameters for the specified dycore and horizontal grid. The + # parameters are read from an input file, and if no dycore/grid matches are + # found then issue error message. + # This routine uses the configuration defined at the package level ($cfg_ref). + + my ($hgrid_file, $cfg_ref) = @_; + my $xml = XML::Lite->new( $hgrid_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "config_horiz_grid" or die + "file $hgrid_file is not a horizontal grid parameters file\n"; + + # Get dycore/grid from the package's configuration + my $dyn_pkg = $cfg_ref->get('dyn'); + my $hgrid = $cfg_ref->get('hgrid'); + + # Read the grid parameters from $hgrid_file. + my @e = $xml->elements_by_name( "horiz_grid" ); + my %a = (); + + # Search for matching dycore/grid. + my $found = 0; + HGRID: + while ( my $e = shift @e ) { + %a = $e->get_attributes(); + if ( $dyn_pkg eq $a{'dyn'} and $hgrid eq $a{'hgrid'} ) { + $found = 1; + last HGRID; + } + } + + # Die unless search was successful. + unless ($found) { die "set_horiz_grid: no match for dycore $dyn_pkg and hgrid $hgrid\n"; } + + # Set parameter values -- dycore specific. + if ( $dyn_pkg =~ m/eul/ ) { + $cfg_ref->set('nlat', $a{'nlat'}); + $cfg_ref->set('nlon', $a{'nlon'}); + $cfg_ref->set('trm', $a{'m'}); + $cfg_ref->set('trn', $a{'n'}); + $cfg_ref->set('trk', $a{'k'}); + } + elsif ( $dyn_pkg eq 'fv' ) { + $cfg_ref->set('nlat', $a{'nlat'}); + $cfg_ref->set('nlon', $a{'nlon'}); + } + elsif ( $dyn_pkg eq 'fvcubed' ) { + $cfg_ref->set('csnp', $a{'csnp'}); + } + elsif ( $dyn_pkg eq 'se') { + $cfg_ref->set('csne', $a{'csne'}); + $cfg_ref->set('csnp', $a{'csnp'}); + $cfg_ref->set('npg', $a{'npg'}); + + # To allow more flexibility when matching grid attributes in the namelist + # defaults file split the GLL and physics grid specifiers in the hgrid + # argument to configure, and just store the GLL part in the hgrid parameter of + # the config_cache file. The physics grid specifier is stored separately + # in the npg parameter. + + $hgrid =~ s/\.pg\d//; # strip the '.pgN' extension + $cfg_ref->set('hgrid', $hgrid); + } + + # Override resolution settings to configure for SCAM mode. The override is needed + # because in SCAM mode the -hgrid option is used to specify the resolution of default + # datasets from which single data columns are extracted. + my $scam = $cfg_ref->get('scam'); + if ($scam) { + $cfg_ref->set('nlat', 1); + $cfg_ref->set('nlon', 1); + $cfg_ref->set('trm', 1); + $cfg_ref->set('trn', 1); + $cfg_ref->set('trk', 1); + } + +} + +#------------------------------------------------------------------------------- + +sub absolute_path { +# +# Convert a pathname into an absolute pathname, expanding any . or .. characters. +# Assumes pathnames refer to a local filesystem. +# Assumes the directory separator is "/". +# + my $path = shift; + my $cwd = getcwd(); # current working directory + my $abspath; # resulting absolute pathname + +# Strip off any leading or trailing whitespace. (This pattern won't match if +# there's embedded whitespace. + $path =~ s!^\s*(\S*)\s*$!$1!; + +# Convert relative to absolute path. + + if ($path =~ m!^\.$!) { # path is "." + return $cwd; + } elsif ($path =~ m!^\./!) { # path starts with "./" + $path =~ s!^\.!$cwd!; + } elsif ($path =~ m!^\.\.$!) { # path is ".." + $path = "$cwd/.."; + } elsif ($path =~ m!^\.\./!) { # path starts with "../" + $path = "$cwd/$path"; + } elsif ($path =~ m!^[^/]!) { # path starts with non-slash character + $path = "$cwd/$path"; + } + + my ($dir, @dirs2); + my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls + # This enables correct processing of the input "/". + + # Remove any "" that are not leading. + for (my $i=0; $i<=$#dirs; ++$i) { + if ($i == 0 or $dirs[$i] ne "") { + push @dirs2, $dirs[$i]; + } + } + @dirs = (); + + # Remove any "." + foreach $dir (@dirs2) { + unless ($dir eq ".") { + push @dirs, $dir; + } + } + @dirs2 = (); + + # Remove the "subdir/.." parts. + foreach $dir (@dirs) { + if ( $dir !~ /^\.\.$/ ) { + push @dirs2, $dir; + } else { + pop @dirs2; # remove previous dir when current dir is .. + } + } + if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; } + $abspath = join '/', @dirs2; + return( $abspath ); +} + +#------------------------------------------------------------------------------- + +sub subst_env_path { +# +# Substitute for any environment variables contained in a pathname. +# Assumes the directory separator is "/". +# + my $path = shift; + my $newpath; # resulting pathname + +# Strip off any leading or trailing whitespace. (This pattern won't match if +# there's embedded whitespace. + $path =~ s!^\s*(\S*)\s*$!$1!; + + my ($dir, @dirs2); + my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls + # This enables correct processing of the input "/". + + foreach $dir (@dirs) { + if ( $dir =~ /^\$(.+)$/ ) { + push @dirs2, $ENV{$1}; + } else { + push @dirs2, $dir; + } + } + $newpath = join '/', @dirs2; + return( $newpath ); +} + +#------------------------------------------------------------------------------- + +sub mkdirp { + my ($dir) = @_; + my (@dirs) = split /\//, $dir; + my (@subdirs, $path); + + # if $dir is absolute pathname then @dirs will start with "" + if ($dirs[0] eq "") { push @subdirs, shift @dirs; } + + while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't + push @subdirs, shift @dirs; + $path = join '/', @subdirs; + unless (-d $path or mkdir($path, 0777)) { return 0; } + } + return 1; +} + +#------------------------------------------------------------------------------- + +sub get_cmake_version { + +# Return CMake version. Null string returned if cmake not found. + + my $retval = `cmake --version 2>&1`; + $retval =~ /cmake version (\d+.*)/; # use loose match for version string + return $1; +} + +#------------------------------------------------------------------------------- + +sub get_gmake { + +# check for a valid version of GNU make in the user's path + + my @makenames = @_; + my ($make, $retval); + + foreach $make (@makenames) { + $retval = `$make -v 2>&1`; + return $make if ($retval =~ /GNU Make/); + } + return; +} + +#------------------------------------------------------------------------------- + +sub write_tests_filepath +{ + my ($test_dir) = @_; + my $fh = new IO::File; + + $fh->open(">Filepath") or die "** can't open file: $test_dir/Filepath\n"; + + print $fh "$test_dir\n"; + + $fh->close; +} + +#------------------------------------------------------------------------------- + +sub run_test +{ + # Return true if the test should be run after a successful build. + # Note that this function is depending on the main package variables + # main::$spmd and main:: $target_os. + + # Default is to try running a test that's been successfully built. + my $result = 1; + + # But don't attempt to run a test if... + if ( $spmd eq 'ON' # SPMD is enabled + or $target_os ne $OSNAME # cross compilation + ) {$result = 0;} + + return $result; +} + +#------------------------------------------------------------------------------- + +sub check_fc { + +# Create a "hello world" test code in Fortran 90 syntax to check the compiler. +# If successful then the name of the compiler used is returned. + + my ($gmake, $makefile) = @_; + my $fh = new IO::File; + my $file = 'test_fc.F90'; + + # create test program + $fh->open(">$file") or die "** can't open file: $file\n"; + print $fh <<"EOF"; +module m1 + private + public :: hello +contains +subroutine hello() + implicit none + print *, 'hello world' +end subroutine hello +end module m1 +program main + use m1, only: hello + implicit none + call hello +end program main +EOF + $fh->close; + + # Build the test_fc target in the CAM Makefile + my $cmd = "$gmake -f $makefile test_fc 2>&1"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + + # search make output for name of Fortran compiler -- Assume that the Makefile + # rule has the syntax "$(FC) -c ..." + $out =~ m{ ^\s* # leading whitespace + (\w+) # 1st word (name of compiler) + \s+ # followed by one or more spaces + -c # and the -c option + \s + }xm; + + my $fc_compiler_name = $1; + + if (run_test()) { + # Run test_fc. + my $cmd = "./test_fc"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + } + + # clean-up (Srcfiles and Depends are created by the makefile) + unlink 'test_fc.F90', 'test_fc.o', 'test_fc', 'Depends', 'Srcfiles', glob("[Mm]1.[Mm][Oo][Dd]"); + + return $fc_compiler_name; +} + +#------------------------------------------------------------------------------- + +sub check_netcdf { + +# Create a test code that has an external reference to the netCDF library +# and check that the Makefile can build it. Returns 0 on success. + + my ($gmake, $makefile) = @_; + my $fh = new IO::File; + my $file = 'test_nc.F90'; + + # create test program + $fh->open(">$file") or die "** can't open file: $file\n"; + print $fh <<"EOF"; +program main + use netcdf + implicit none + integer :: ncid, ret + ret = nf90_create('foo.nc', NF90_CLOBBER, ncid) + if ( ret == NF90_NOERR ) then + print *, 'created foo.nc' + else + print *, nf90_strerror( ret ) + end if +end program main +EOF + $fh->close; + + # Build the test_nc target in the CAM Makefile + my $cmd = "$gmake -f $makefile test_nc 2>&1"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + + if (run_test()) { + # Run test_nc. + my $cmd = "./test_nc"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + } + + # clean-up + unlink 'test_nc.F90', 'test_nc.o', 'test_nc', 'foo.nc', 'Depends', 'Srcfiles'; + + return 0; +} + +#------------------------------------------------------------------------------- + +sub check_mpi { + +# Create a test code that has an external reference to the MPI library +# and check that the Makefile can build it. Returns 0 on success. + + my ($gmake, $makefile) = @_; + my $fh = new IO::File; + my $file = 'test_mpi.F90'; + + # create the test program + $fh->open(">$file") or die "** can't open file: $file\n"; + print $fh <<"EOF"; + program test_mpi + implicit none +#include + integer :: ierr + call mpi_init(ierr) + if ( ierr == MPI_SUCCESS ) then + print *, 'successfully called mpi_init' + else + print *, 'ERROR returned from mpi_init' + end if + end program test_mpi +EOF + $fh->close; + + # Build the test_mpi target in the CAM Makefile + my $cmd = "$gmake -f $makefile test_mpi 2>&1"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + + if (run_test()) { + # Run test_mpi. + my $cmd = "./test_mpi"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + } + + # clean-up + unlink 'test_mpi.F90', 'test_mpi.o', 'test_mpi', 'Depends', 'Srcfiles'; + + return 0; +} + +#------------------------------------------------------------------------------- + +sub check_esmf { + +# Create a test code that has an external reference to the ESMF library +# and check that the Makefile can build it. Returns 0 on success. + + my ($gmake, $makefile) = @_; + my $fh = new IO::File; + my $file = 'test_esmf.F90'; + + # create the test program + $fh->open(">$file") or die "** can't open file: $file\n"; + print $fh <<"EOF"; + program test_esmf + use ESMF + implicit none + integer :: ierr + + ! Writes a log called ESMF_LogFile to bld/configure-tests + call ESMF_Initialize(rc=ierr,logkindflag=ESMF_LOGKIND_SINGLE) + + if ( ierr == ESMF_SUCCESS ) then + print *, 'successfully called ESMF_Initialize' + else + print *, 'ERROR returned from ESMF_Initialize' + end if + + ! Close the log file in order to flush it + call ESMF_Finalize(rc=ierr) + + end program test_esmf +EOF + $fh->close; + + # Build the test_esmf target in the CAM Makefile + my $cmd = "$gmake -f $makefile test_esmf 2>&1"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + + if (run_test()) { + # Run test_esmf. + $cmd = "./test_esmf"; + my $out = `$cmd`; + my $cmd_error = $CHILD_ERROR; + my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; + + + if ($cmd_error) { + die "**** FAILED ****\n$test_output"; + } elsif ($print>=2) { + print "**** PASS ****\n$test_output"; + } + } + + # clean-up + unlink 'test_esmf.F90', 'test_esmf.o', 'test_esmf', 'Depends', 'Srcfiles'; + + return 0; +} +#------------------------------------------------------------------------------- + +#------------------------------------------------------------------------------- + +sub version { +# The version is found in CAM's ChangeLog file. +# $cfgdir is set by the configure script to the name of its directory. + + my ($cfgdir) = @_; + + my $logfile = "$cfgdir/../doc/ChangeLog"; + + my $fh = IO::File->new($logfile, '<') or die "** can't open ChangeLog file: $logfile\n"; + + while (my $line = <$fh>) { + + if ($line =~ /^Tag name:\s*(\w+)/ ) { + print "$1\n"; + exit; + } + } + +} + + +#------------------------------------------------------------------------------- + +sub print_hash { + my %h = @_; + my ($k, $v); + while ( ($k,$v) = each %h ) { print "$k => $v\n"; } +} diff --git a/bld/mkDepends b/bld/mkDepends new file mode 100755 index 0000000000..3d71400c27 --- /dev/null +++ b/bld/mkDepends @@ -0,0 +1,449 @@ +#!/usr/bin/env perl + +# Generate dependencies in a form suitable for inclusion into a Makefile. +# The source filenames are provided in a file, one per line. Directories +# to be searched for the source files and for their dependencies are provided +# in another file, one per line. Output is written to STDOUT. +# +# For CPP type dependencies (lines beginning with #include), or for Fortran +# include dependencies, the dependency search is recursive. Only +# dependencies that are found in the specified directories are included. +# So, for example, the standard include file stdio.h would not be included +# as a dependency unless /usr/include were one of the specified directories +# to be searched. +# +# For Fortran module USE dependencies (lines beginning with a case +# insensitive "USE", possibly preceded by whitespace) the Fortran compiler +# must be able to access the .mod file associated with the .o file that +# contains the module. In order to correctly generate these dependencies +# the following restriction must be observed. +# +# ** All modules that are to be contained in the dependency list must be +# ** contained in one of the source files in the list provided on the command +# ** line. +# +# The reason for this restriction is that the modules have a nominal dependence +# on the .o files. If a module is being used for which the source code is not +# available (e.g., a module from a library), then adding a .o dependency for +# that module is a mistake because make will attempt to build that .o file, and +# will fail if the source code is not available. +# +# Original version: B. Eaton +# Climate Modelling Section, NCAR +# Feb 2001 +# +# ChangeLog: +# ----------------------------------------------------------------------------- +# Modifications to Brian Eaton's original to relax the restrictions on +# source file name matching module name and only one module per source +# file. Also added a new "-d depfile" option which allows an additional +# file to be added to every dependence. +# +# +# Tom Henderson +# Global Systems Division, NOAA/OAR +# Mar 2011 +# ----------------------------------------------------------------------------- +# Several updates: +# +# - Remove limitation that modules cannot be named "procedure". +# +# - Allow optional "::" in use statement (Fortran 2003). +# +# - Instead of having .o files depend on other .o files directly, +# have them depend indirectly through the .mod files. This allows +# the compiler to have discretion over whether to update a .mod, +# and prevents cascading recompilation when it does not. +# +# +# Sean Santos +# CESM Software Engineering Group, NCAR +# Mar 2013 +# ----------------------------------------------------------------------------- +# More updates: +# +# - Restore ability to recognize .mod files in the path, if there's no source +# file that provides the same module. +# +# - Allow "non_intrinsic" keyword (Fortran 2003). +# +# Sean Santos +# CESM Software Engineering Group, NCAR +# Mar 2013 +# ----------------------------------------------------------------------------- + + +use Getopt::Std; +use File::Basename; + +# Check for usage request. +@ARGV >= 2 or usage(); + +# Process command line. +my %opt = (); +getopts( "t:wd:m:", \%opt ) or usage(); +my $filepath_arg = shift() or usage(); +my $srcfile_arg = shift() or usage(); +@ARGV == 0 or usage(); # Check that all args were processed. + +my $obj_dir = ""; +if ( defined $opt{'t'} ) { $obj_dir = $opt{'t'}."/"; } + +my $additional_file = ""; +if ( defined $opt{'d'} ) { $additional_file = $opt{'d'}; } + +my $mangle_scheme = "lower"; +if ( defined $opt{'m'} ) { $mangle_scheme = $opt{'m'}; } + +open(FILEPATH, $filepath_arg) or die "Can't open $filepath_arg: $!\n"; +open(SRCFILES, $srcfile_arg) or die "Can't open $srcfile_arg: $!\n"; + +# Make list of paths to use when looking for files. +# Prepend "." so search starts in current directory. This default is for +# consistency with the way GNU Make searches for dependencies. +my @file_paths = ; +close(FILEPATH); +chomp @file_paths; +unshift(@file_paths,'.'); +foreach $dir (@file_paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Make list of files containing source code. +my @src = ; +close(SRCFILES); +chomp @src; + +my %module_files = (); + +# Attempt to parse each file for /^\s*module/ and extract module names +# for each file. +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.[fF]90', '\.[fF]','\.F90\.in' ); +foreach $f (@src) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + # find the file in the list of directorys (in @file_paths) + my $file_path = find_file($f); + open(FH, $file_path) or die "Can't open $file_path: $!\n"; + while ( ) { + # Search for module definitions. + if ( /^\s*MODULE\s+(\w+)\s*(\!.*)?$/i ) { + ($mod = $1) =~ tr/A-Z/a-z/; + if ( defined $module_files{$mod} ) { + die "Duplicate definitions of module $mod in $module_files{$mod} and $name: $!\n"; + } + $module_files{$mod} = $name; + } + } + close( FH ); +} + +# Now make a list of .mod files in the file_paths. If a source dependency +# can't be found based on the module_files list above, then maybe a .mod +# module dependency can if the mod file is visible. +my %trumod_files = (); +my ($dir); +my ($f, $name, $path, $suffix, $mod); +# This might not be clear: we want to mangle a "\" so that it will escape +# the "." in .mod or .MOD +my @suffixes = (mangle_modfile("\\")); +foreach $dir (@file_paths) { + # Similarly, this gets us $dir/*.mod or $dir/*.MOD + @filenames = (glob("$dir/".mangle_modfile("*"))); + foreach $f (@filenames) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/A-Z/a-z/; + $trumod_files{$mod} = $name; + } +} + +#print STDERR "\%module_files\n"; +#while ( ($k,$v) = each %module_files ) { +# print STDERR "$k => $v\n"; +#} + +# Find module and include dependencies of the source files. +my ($file_path, $rmods, $rincs); +my %file_modules = (); +my %file_includes = (); +my @check_includes = (); +my %modules_used = (); +foreach $f ( @src ) { + + # Find the file in the seach path (@file_paths). + unless ($file_path = find_file($f)) { + if (defined $opt{'w'}) {print STDERR "$f not found\n";} + next; + } + + # Find the module and include dependencies. + ($rmods, $rincs) = find_dependencies( $file_path ); + + # Remove redundancies (a file can contain multiple procedures that have + # the same dependencies). + $file_modules{$f} = rm_duplicates($rmods); + $file_includes{$f} = rm_duplicates($rincs); + + # Make a list of all include files. + push @check_includes, @{$file_includes{$f}}; +} + +#print STDERR "\%file_modules\n"; +#while ( ($k,$v) = each %file_modules ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\@check_includes\n"; +#print STDERR "@check_includes\n"; + +# Find include file dependencies. +my %include_depends = (); +while (@check_includes) { + $f = shift @check_includes; + if (defined($include_depends{$f})) { next; } + + # Mark files not in path so they can be removed from the dependency list. + unless ($file_path = find_file($f)) { + $include_depends{$f} = -1; + next; + } + + # Find include file dependencies. + ($rmods, $include_depends{$f}) = find_dependencies($file_path); + + # Add included include files to the back of the check_includes list so + # that their dependencies can be found. + push @check_includes, @{$include_depends{$f}}; + + # Add included modules to the include_depends list. + if ( @$rmods ) { push @{$include_depends{$f}}, @$rmods; } +} + +#print STDERR "\%include_depends\n"; +#while ( ($k,$v) = each %include_depends ) { +# print STDERR (ref $v ? "$k => @$v\n" : "$k => $v\n"); +#} + +# Remove include file dependencies that are not in the Filepath. +my $i, $ii; +foreach $f (keys %include_depends) { + + unless (ref $include_depends{$f}) { next; } + $rincs = $include_depends{$f}; + unless (@$rincs) { next; } + $ii = 0; + $num_incs = @$rincs; + for ($i = 0; $i < $num_incs; ++$i) { + if ($include_depends{$$rincs[$ii]} == -1) { + splice @$rincs, $ii, 1; + next; + } + ++$ii; + } +} + +# Substitute the include file dependencies into the %file_includes lists. +foreach $f (keys %file_includes) { + my @expand_incs = (); + + # Initialize the expanded %file_includes list. + my $i; + unless (@{$file_includes{$f}}) { next; } + foreach $i (@{$file_includes{$f}}) { + push @expand_incs, $i unless ($include_depends{$i} == -1); + } + unless (@expand_incs) { + $file_includes{$f} = []; + next; + } + + # Expand + for ($i = 0; $i <= $#expand_incs; ++$i) { + push @expand_incs, @{ $include_depends{$expand_incs[$i]} }; + } + + $file_includes{$f} = rm_duplicates(\@expand_incs); +} + +#print STDERR "expanded \%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} + +# Print dependencies to STDOUT. + +print "# Declare all module files used to build each object.\n"; + +foreach $f (sort keys %file_modules) { + my $file; + my $addf90=0; + if($f =~ /\.F90\.in$/){ + $f =~ /(.+)\.F90\.in/; + $file = $1; + $addf90=1; + }else{ + $f =~ /(.+)\./; + $file = $1; + } + $target = $obj_dir."$file.o"; + print "$target : @{$file_modules{$f}} @{$file_includes{$f}} $additional_file "; + print "$file.F90" if($addf90==1); + print "\n"; +} + +print "# The following section relates each module to the corresponding file.\n"; +$target = mangle_modfile("%"); +print "$target : \n"; +print "\t\@\:\n"; + +foreach $mod (sort keys %modules_used) { + my $mod_fname = $obj_dir.mangle_modfile($mod); + my $obj_fname = $obj_dir.$module_files{$mod}.".o"; + print "$mod_fname : $obj_fname\n"; + +} + +#-------------------------------------------------------------------------------------- + +sub find_dependencies { + + # Find dependencies of input file. + # Use'd Fortran 90 modules are returned in \@mods. + # Files that are "#include"d by the cpp preprocessor are returned in \@incs. + + # Check for circular dependencies in \@mods. This type of dependency + # is a consequence of having multiple modules defined in the same file, + # and having one of those modules depend on the other. + + my( $file ) = @_; + my( @mods, @incs ); + + open(FH, $file) or die "Can't open $file: $!\n"; + + # Construct the makefile target associated with this file. This is used to + # check for circular dependencies. + my ($name, $path, $suffix, $target); + my @suffixes = ('\.[fF]90', '\.[fF]','\.F90\.in' ); + ($name, $path, $suffix) = fileparse($file, @suffixes); + $target = "$name.o"; + + while ( ) { + # Search for "#include" and strip filename when found. + if ( /^#include\s+[<"](.*)[>"]/ ) { + push @incs, $1; + } + # Search for Fortran include dependencies. + elsif ( /^\s*include\s+['"](.*)['"]/ ) { #" for emacs fontlock + push @incs, $1; + } + # Search for module dependencies. + elsif ( /^\s*USE(?:\s+|\s*\:\:\s*|\s*,\s*non_intrinsic\s*\:\:\s*)(\w+)/i ) { + # Return dependency in the form of a .mod file + ($module = $1) =~ tr/A-Z/a-z/; + if ( defined $module_files{$module} ) { + # Check for circular dependency + unless ("$module_files{$module}.o" eq $target) { + $modules_used{$module} = (); + push @mods, "$obj_dir".mangle_modfile($module); + } + } + # If we already have a .mod file around. + elsif ( defined $trumod_files{$module} ) { + push @mods, "$obj_dir".mangle_modfile($trumod_files{$module}); + } + } + } + close( FH ); + return (\@mods, \@incs); +} + +#-------------------------------------------------------------------------------------- + +sub find_file { + +# Search for the specified file in the list of directories in the global +# array @file_paths. Return the first occurance found, or the null string if +# the file is not found. + + my($file) = @_; + my($dir, $fname); + + foreach $dir (@file_paths) { + $fname = "$dir/$file"; + if ( -f $fname ) { return $fname; } + } + return ''; # file not found +} + +#-------------------------------------------------------------------------------------- + +sub rm_duplicates { + +# Return a list with duplicates removed. + + my ($in) = @_; # input arrary reference + my @out = (); + my $i; + my %h = (); + foreach $i (@$in) { + $h{$i} = ''; + } + @out = keys %h; + return \@out; +} + +#-------------------------------------------------------------------------------------- + +sub mangle_modfile { + +# Return the name of the module file corresponding +# to a given module. + + my ($mod) = @_; + my $fname; + + if ($mangle_scheme eq "lower") { + ($fname = $mod) =~ tr/A-Z/a-z/; + $fname .= ".mod"; + } elsif ($mangle_scheme eq "upper") { + ($fname = $mod) =~ tr/a-z/A-Z/; + $fname .= ".MOD"; + } else { + die "Unrecognized mangle_scheme!\n"; + } + + return $fname; + +} + +#-------------------------------------------------------------------------------------- + +sub usage { + ($ProgName = $0) =~ s!.*/!!; # name of program + die <; + close( FILEPATH ); +} +chomp @paths; +unshift(@paths, '.'); +foreach my $dir (@paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Loop through the directories and add each filename as a hash key. This +# automatically eliminates redunancies. +my %src = (); +foreach my $dir (@paths) { + my @filenames = (glob("$dir/*.[Ffc]"), glob("$dir/*.[Ff]90"), glob("$dir/*.cpp")); + foreach my $filename (@filenames) { + $filename =~ s!.*/!!; # remove part before last slash + $src{$filename} = 1; + } + + # Files with a .in suffix will be preprocessed using the genf90 utility. + # If a directory contains files with both .F90 and .F90.in suffixes, remove + # the .F90 version from the Srcfiles list. The Makefile will convert filenames + # with .F90.in to filenames with a .F90 suffix. If the directory did not contain + # the .F90 version then Make will produce it using its rule to generate .F90 files + # from .F90.in files. If the .F90 version exists then it will be used as is. + my @templates = glob("$dir/*.F90.in"); + foreach my $filename (@templates) { + $filename =~ s!.*/!!; # remove part before last slash + my $dfile = $filename; + $dfile =~ s/\.in//; + delete $src{$dfile} if(defined $src{$dfile}); + $src{$filename} = 1; + } + + # Remove files that have be specified for exclusion + foreach my $filename (@exclude_files) { + if (defined $src{$filename}) { + delete $src{$filename}; + } + } +} + +# If Srcfiles exists, then check whether or not it contains all the files in %src. +# If it does then don't rewrite it. If the creation date of Srcfiles is not modified +# then Make won't need to redo the dependency generation, which results in a faster +# make update. +my @srcfiles; +my $foundcnt=0; +my $writenew=1; +if(-e "Srcfiles"){ # file already exists, do not update if no changes are required + open(SRC,"Srcfiles"); + @srcfiles = ; + close(SRC); + $writenew=0; + foreach my $file (@srcfiles){ + chomp $file; + if($src{$file}){ + $src{$file}=0; + }else{ + $writenew=1; # A srcfile was removed + last; + } + + } + foreach my $file (keys %src){ + if($src{$file} == 1){ + $writenew=1; # A srcfile was added + last; + } + } +} + +if($writenew==1){ + open(SRC,"> Srcfiles") or die "Can't open Srcfiles\n"; + + foreach my $file ( sort keys %src ) { + print SRC "$file\n"; + } + + close( SRC ); +} +#-------------------------------------------------------------------------------------- + +sub usage { + my $ProgName; + ($ProgName = $0) =~ s!.*/!!; # name of program + die < + + + + + + DST01,DST02,DST03,DST04 + SSLT01,SSLT02,SSLT03,SSLT04 + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/master_aer_wetdep_list.xml b/bld/namelist_files/master_aer_wetdep_list.xml new file mode 100644 index 0000000000..ee7513de3f --- /dev/null +++ b/bld/namelist_files/master_aer_wetdep_list.xml @@ -0,0 +1,93 @@ + + + + + + CB2,DST01,DST02,DST03,DST04,OC2,SO4,SOA,SSLT01,SSLT02,SSLT03,SSLT04 + + + SOAM,SOAI,SOAT,SOAB,SOAX + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/master_gas_drydep_list.xml b/bld/namelist_files/master_gas_drydep_list.xml new file mode 100644 index 0000000000..38de9eceb4 --- /dev/null +++ b/bld/namelist_files/master_gas_drydep_list.xml @@ -0,0 +1,103 @@ + + + + + + + ALKOOH + BENZOOH + BZOOH + C2H5OH + C2H5OOH + C3H7OOH + C6H5OOH + CH2O + CH3CHO + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CO + GLYALD + H2O2 + HCN + HCOOH + HNO3 + HO2NO2 + HPALD + HYAC + HYDRALD + IEPOX + ISOPNO3 + ISOPOOH + MACROOH + MEKOOH + MPAN + NH3 + NO + NO2 + O3 + O3S + ONIT + ONITR + PAN + PHENOOH + POOH + ROOH + SO2 + H2SO4 + TERPOOH + TERP2OOH + TERPROD1 + TERPROD2 + TOLOOH + XOOH + XYLENOOH + XYLOLOOH + Pb + EOOH + HI, HOI, IONO2, INO2, I2O2, I2O3, I2O4, BR2 + NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR + ISOPNOOH, NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH + SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 + SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, + SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 + IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff + + + + + + CB1 + CB2 + NH4 + NH4NO3 + OC1 + OC2 + SO4 + SOA + + + + SOAM,SOAI,SOAT,SOAB,SOAX + SOGM,SOGI,SOGT,SOGB,SOGX + + + + + XNO + XNO2 + XHNO3 + XONIT + XONITR + XPAN + XMPAN + XHO2NO2 + XNH4NO3 + O3A + + + diff --git a/bld/namelist_files/master_gas_wetdep_list.xml b/bld/namelist_files/master_gas_wetdep_list.xml new file mode 100644 index 0000000000..538ff7af74 --- /dev/null +++ b/bld/namelist_files/master_gas_wetdep_list.xml @@ -0,0 +1,84 @@ + + + + + + NH4, NH4NO3 + + + XNH4NO3 + + + + HCN + CH3CN + ALKOOH + BRONO2 + C2H5OH + C2H5OOH + C3H7OOH + CH2O + CH3CHO + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CLONO2 + GLYALD + H2O2 + HBR + HCL + HCOOH + HNO3 + HO2NO2 + HOBR + HOCL + HYAC + HYDRALD + ISOPNO3 + ISOPOOH + MACR + MACROOH + MEKOOH + MVK + NH3 + ONIT + ONITR + Pb + POOH + ROOH + SO2 + H2SO4 + TERPOOH + TOLOOH + XOOH + COF2 + COFCL + HF + EOOH + IBR, ICL, BRNO2, CLNO2, HI, HOI, IONO2, BR2, IO, OIO, I2O2, I2O3, I2O4 + NH_50W, SO2t + BENZOOH, BZOOH, C6H5OOH, HMPROP, HPALD, IEPOX, MBOOOH, PHENOOH, TERP2OOH + TERPROD1, TERPROD2, XYLENOOH, XYLOLOOH, NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR, ISOPNOOH + NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH, + SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 + SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, + SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 + IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff + NDEP, NHDEP + + + SOGM,SOGI,SOGT,SOGB,SOGX + + + + XHNO3 + XHO2NO2 + XONIT + XONITR + XISOPNO3 + + + diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml new file mode 100644 index 0000000000..eb985c55cf --- /dev/null +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -0,0 +1,1948 @@ + + + + + +1200 +300 +600 +1200 +1800 +1800 +1800 + +1800 +300 + +1800 +1800 +1800 +1800 +1800 +900 +600 +600 + + + +atm/cam/inic/cam_vcoords_L26_c180105.nc +atm/cam/inic/cam_vcoords_L30_c180105.nc +atm/cam/inic/cam_vcoords_L32_c180105.nc + +atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc +atm/cam/inic/fv/cami_0000-09-01_0.23x0.31_L26_c061106.nc +atm/cam/inic/fv/cami_1980-01-01_0.47x0.63_L26_c071226.nc +atm/cam/inic/fv/cami_0000-09-01_0.47x0.63_L26_c061106.nc +atm/cam/inic/fv/cami_0000-10-01_0.5x0.625_L26_c031204.nc +atm/cam/inic/fv/cami_1987-01-01_0.9x1.25_L26_c060703.nc +atm/cam/inic/fv/cami_0000-09-01_0.9x1.25_L26_c051205.nc +atm/cam/inic/fv/cami_0000-01-01_1.9x2.5_L26_c070408.nc +atm/cam/inic/fv/cami_0000-09-01_1.9x2.5_L26_c040809.nc +atm/cam/inic/fv/cami_0000-01-01_2.5x3.33_L26_c110309.nc +atm/cam/inic/fv/cami_0000-09-01_2.5x3.33_L26_c091007.nc +atm/cam/inic/fv/cami_0001-01-01_4x5_L26_c060608.nc +atm/cam/inic/fv/cami_0000-01-01_10x15_L26_c030918.nc + +atm/cam/inic/fv/cami-mam3_0000-01-01_0.23x0.31_L30_c110527.nc +atm/cam/inic/fv/cami-mam3_0000-01-01_0.47x0.63_L30_c100929.nc +atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L30_c100618.nc +atm/cam/inic/fv/cami-mam3_0000-01-01_1.9x2.5_L30_c090306.nc +atm/cam/inic/fv/cami_0000-09-01_1.9x2.5_L30_c070109.nc +atm/cam/inic/fv/cami_0000-01-01_2.5x3.33_L30_c110309.nc +atm/cam/inic/fv/cami_0000-09-01_2.5x3.33_L30_c100831.nc +atm/cam/inic/fv/cami_0000-01-01_4x5_L30_c090108.nc +atm/cam/inic/fv/cami_0000-01-01_10x15_L30_c081013.nc + +atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L32_c141031.nc +atm/cam/inic/fv/cami-mam3_0000-01-01_1.9x2.5_L32_c150407.nc +atm/cam/inic/fv/cami-mam4_0000-01-01_10x15_L32_c170914.nc + +atm/cam/inic/fv/cami_0000-01-01_0.47x0.63_L26_APE_c080227.nc +atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L26_c161020.nc +atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L26_c161020.nc +atm/cam/inic/fv/aqua_0000-01-01_10x15_L26_c161230.nc + +atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L30_c161020.nc +atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L30_c161020.nc +atm/cam/inic/fv/aqua_0000-01-01_10x15_L30_c170103.nc + +atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L32_c161020.nc +atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L32_c161020.nc +atm/cam/inic/fv/aqua_0000-01-01_10x15_L32_c170103.nc + +atm/cam/inic/fv/cami-chem_1990-01-01_0.9x1.25_L30_c080724.nc +atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L26_c080114.nc +atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L30_c080215.nc + +atm/cam/inic/fv/camchemi_0012-01-01_10x15_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_10x15_L30_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_4x5_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_4x5_L30_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L30_c081104.nc + +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_10x15_L30_c121015.nc +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_4x5_L30_c121015.nc +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_1.9x2.5_L30_c121015.nc + +atm/cam/inic/fv/camchemi_0012-01-01_10x15_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_10x15_L30_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_4x5_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_4x5_L30_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L26_c081104.nc +atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L30_c081104.nc + +atm/cam/chem/trop_mozart/ic/cami_0000-09-01_4x5_L26_c060217.nc +atm/cam/chem/trop_mozart/ic/cami_0000-09-01_10x15_L26_c060216.nc + +atm/waccm/ic/cami_2000-02-01_0.9x1.25_L66_c040928.nc +atm/waccm/ic/cami_2000-07-01_1.9x2.5_L66_c040928.nc +atm/waccm/ic/FWT2000_f09_spinup01.cam.i.0001-01-02-00000_c160315.nc +atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc +atm/waccm/ic/aqua.cam6.waccmsc_1.9x2.5_L70.2000-01-01.c170123.nc +atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc +atm/waccm/ic/f2000.waccm-mam3_10x15_L70.cam2.i.0017-01-01.c141016.nc +atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc +atm/waccm/ic/cami_2000-05-01_1.9x2.5_L103_c040928.nc +atm/waccm/ic/wa3_4x5_1950_spinup.cam2.i.1960-01-01-00000.nc +atm/waccm/ic/cami_2000-01-01_10x15_L66_c041121.nc +atm/waccm/ic/f40.2000.4deg.wcm.carma.sulf.004.cam2.i.0008-01-01-00000.nc +atm/waccm/ic/f40.2deg.wcm.carma.sulf.L66.cam2.i.2010-01-01.nc +atm/waccm/ic/f40.2000.10deg.wcm.carma.sulf.004.cam2.i.0008-01-01-00000.nc +atm/waccm/ic/f40.2000.4deg.wcm.carma.sulf.004.cam2.i.0008-01-01-00000.nc +atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_L81_c110906.nc +atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_4x5_L81_c160630.nc +atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_10x15_L81_c141027.nc +atm/waccm/ic/waccmx_aqua_4x5_L126_c170705.nc + +atm/cam/inic/gaus/T341clim01.cam2.i.0024-01-01-00000.nc +atm/cam/inic/gaus/cami_0000-01-01_256x512_L26_c030918.nc + +atm/cam/inic/gaus/cami_0000-01-01_128x256_L26_c030918.nc +atm/cam/inic/gaus/cami_0000-09-01_128x256_L26_c040422.nc + +atm/cam/inic/gaus/cami_0000-01-01_64x128_T42_L26_c031110.nc +atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc +atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/inic/gaus/cami_0000-01-01_64x128_L32_c170510.nc +atm/cam/inic/gaus/cami_0000-01-01_48x96_L26_c091218.nc +atm/cam/inic/gaus/cami_0000-09-01_48x96_L26_c040420.nc +atm/cam/inic/gaus/cami_0000-01-01_48x96_L30_c100426.nc +atm/cam/inic/gaus/cami_0000-09-01_32x64_L26_c030918.nc +atm/cam/inic/gaus/cami_0000-01-01_32x64_L30_c090107.nc +atm/cam/inic/gaus/cami_0000-01-01_8x16_L26_c030228.nc +atm/cam/inic/gaus/cami_0000-09-01_8x16_L26_c030918.nc +atm/cam/inic/gaus/cami_0000-01-01_8x16_L30_c090102.nc + + +atm/cam/inic/homme/cami-mam3_0000-01_ne5np4_L30.140707.nc +atm/cam/inic/se/ape_topo_cam4_ne16np4_L26_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne16np4_L30_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne16np4_L32_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne30np4_L26_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne30np4_L30_c171020.nc +atm/cam/inic/se/ape_topo_cam6_ne30np4_L32_c171023.nc +atm/cam/inic/se/ape_topo_cam4_ne60np4_L26_c171018.nc +atm/cam/inic/se/ape_topo_cam4_ne60np4_L30_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne60np4_L32_c171020.nc +atm/cam/inic/se/ape_topo_cam4_ne120np4_L26_c171018.nc +atm/cam/inic/se/ape_topo_cam4_ne120np4_L30_c171024.nc +atm/cam/inic/se/ape_topo_cam4_ne120np4_L32_c171023.nc +atm/cam/inic/homme/cami_1850-01-01_ne240np4_L26_c110314.nc +atm/cam/inic/homme/cami_0000-09-01_ne240np4_L26_c061106.nc + +atm/cam/inic/homme/cami-mam3_0000-01-ne240np4_L30_c111004.nc + +atm/cam/inic/se/ape_cam4_ne5np4_L26_c170517.nc +atm/cam/inic/se/ape_cam4_ne16np4_L26_c170417.nc +atm/cam/inic/se/ape_cam4_ne30np4_L26_c170417.nc +atm/cam/inic/se/ape_cam4_ne60np4_L26_c171023.nc +atm/cam/inic/se/ape_cam4_ne120np4_L26_c170419.nc +atm/cam/inic/se/ape_cam4_ne240np4_L26_c170613.nc + +atm/cam/inic/se/ape_cam5_ne5np4_L30_c170517.nc +atm/cam/inic/se/ape_cam5_ne16np4_L30_c170417.nc +atm/cam/inic/se/ape_cam5_ne30np4_L30_c170417.nc +atm/cam/inic/se/ape_cam5_ne120np4_L30_c170419.nc + +atm/cam/inic/se/ape_cam6_ne5np4_L32_c170517.nc +atm/cam/inic/se/ape_cam6_ne16np4_L32_c170509.nc +atm/cam/inic/se/ape_cam6_ne30np4_L32_c170509.nc +atm/cam/inic/se/ape_cam6_ne120np4_L32_c170908.nc +atm/cam/inic/se/ape_cam6_ne240np4_L32_c170908.nc + +atm/waccm/ic/wa3_ne5np4_1950_spinup.cam2.i.1960-01-01-00000_c150810.nc +atm/waccm/ic/waccm5_1850_ne30np4_L70_0001-01-11-00000_c151217.nc +atm/cam/inic/se/f_asd2017.cam6_clm5_ne0conus30x8_t12_1980-01-01-00000.nc + + +atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc +atm/cam/topo/USGS-gtopo30_128x256_c050520.nc +atm/cam/topo/T42_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20180111.nc +atm/cam/topo/USGS-gtopo30_48x96_c050520.nc +atm/cam/topo/USGS-gtopo30_32x64_c050520.nc +atm/cam/topo/USGS-gtopo30_8x16_c050520.nc + +atm/cam/topo/USGS_gtopo30_0.23x0.31_remap_c061107.nc +atm/cam/topo/USGS_gtopo30_0.47x0.63_remap_c061106.nc +atm/cam/topo/topo-from-cami_0000-10-01_0.5x0.625_L26_c031204.nc +atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc +atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_061116.nc +atm/cam/topo/USGS-gtopo30_2.5x3.33_remap_c100204.nc +atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc +atm/cam/topo/fv_10x15_nc0540_Nsw042_Nrs008_Co060_Fi001_20171220.nc + +atm/cam/topo/se/ne5np4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170515.nc +atm/cam/topo/se/ne16np4_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc +atm/cam/topo/se/ne30np4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171020.nc +atm/cam/topo/se/ne60np4_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc +atm/cam/topo/se/ne120np4_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171011.nc +atm/cam/topo/se/ne240np4_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc + +atm/cam/topo/se/ne5pg2_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw060_20170706.nc +atm/cam/topo/se/ne30pg2_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc +atm/cam/topo/se/ne60pg2_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171014.nc +atm/cam/topo/se/ne120pg2_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171012.nc +atm/cam/topo/se/ne240pg2_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc + +atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc +atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc +atm/cam/topo/se/ne30pg3_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc +atm/cam/topo/se/ne60pg3_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc +atm/cam/topo/se/ne120pg3_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc +atm/cam/topo/se/ne240pg3_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171015.nc + +atm/cam/topo/se/ne5pg4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw060_20170707.nc +atm/cam/topo/se/ne30pg4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc +atm/cam/topo/se/ne60pg4_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171018.nc +atm/cam/topo/se/ne120pg4_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc + + +atm/cam/topo/conus_30_x8_nc3000_Co060_Fi001_MulG_PF_CONUS_Nsw042_20170417.nc + + +atm/cam/topo/fv_0.9x1.25_nc3000_Nsw006_Nrs002_Co008_Fi001_ZR_c160505.nc +atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_061116.nc + + + .true. + .false. + .false. + .false. + + + none +atm/cam/coords/ne0np4CONUS.ne30x8.g +atm/cam/coords/ne0np4EQFACE.ne5x4.g + + + none + held_suarez_1994 + held_suarez_1994 + baroclinic_wave + + + + +atm/cam/physprops/sul_cam3_c080918.nc +atm/cam/physprops/dustv1b1_cam3_c080918.nc +atm/cam/physprops/dustv1b2_cam3_c080918.nc +atm/cam/physprops/dustv1b3_cam3_c080918.nc +atm/cam/physprops/dustv1b4_cam3_c080918.nc +atm/cam/physprops/bcpho_cam3_c080918.nc +atm/cam/physprops/bcphi_cam3_c080918.nc +atm/cam/physprops/ocpho_cam3_c080918.nc +atm/cam/physprops/ocphi_cam3_c080918.nc +atm/cam/physprops/ssam_cam3_c080918.nc +atm/cam/physprops/sscm_cam3_c080918.nc + + + +atm/cam/physprops/sulfate_camrt_c080918.nc +atm/cam/physprops/sulfate_camrt_c080918.nc +atm/cam/physprops/dust1_camrt_c120518.nc +atm/cam/physprops/dust1_camrt_c120518.nc +atm/cam/physprops/dust2_camrt_c120518.nc +atm/cam/physprops/dust2_camrt_c120518.nc +atm/cam/physprops/dust3_camrt_c120518.nc +atm/cam/physprops/dust3_camrt_c120518.nc +atm/cam/physprops/dust4_camrt_c120518.nc +atm/cam/physprops/dust4_camrt_c120518.nc +atm/cam/physprops/bcpho_camrt_c080918.nc +atm/cam/physprops/bcpho_camrt_c080918.nc +atm/cam/physprops/bcphi_camrt_c080918.nc +atm/cam/physprops/bcphi_camrt_c080918.nc +atm/cam/physprops/ocpho_camrt_c080918.nc +atm/cam/physprops/ocpho_camrt_c080918.nc +atm/cam/physprops/ocphi_camrt_c080918.nc +atm/cam/physprops/ocphi_camrt_c080918.nc +atm/cam/physprops/ssam_camrt_c080918.nc +atm/cam/physprops/sscm_camrt_c080918.nc + + + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/ssam_rrtmg_c080918.nc +atm/cam/physprops/sscm_rrtmg_c080918.nc + + + + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c101112.nc +atm/cam/physprops/ocpho_rrtmg_c130709.nc +atm/cam/physprops/ocphi_rrtmg_c100508.nc +atm/cam/physprops/bcpho_rrtmg_c100508.nc +atm/cam/physprops/ssam_rrtmg_c100508.nc +atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc + + +atm/cam/physprops/volc_camRT_byradius_sigma1.6_c130724.nc +atm/cam/physprops/sulfuricacid_cam3_c080918.nc +atm/cam/physprops/sulfuricacid_cam3_c080918.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c170214.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c170214.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c170214.nc + + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + +atm/cam/physprops/mam7_mode1_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode2_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode3_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode4_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode5_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc + +atm/cam/physprops/water_refindex_rrtmg_c080910.nc + +.false. +.true. + + +slingo +ebertcurry +gammadist +mitchell +atm/cam/physprops/iceoptics_c080917.nc +atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + + +atm/cam/rad/abs_ems_factors_fastvx.c030508.nc + + +atm/waccm/emis/meteor_smoke_kalashnikova.nc +atm/waccm/emis/smoke_grf_frentzke.nc +atm/waccm/emis/meteor_smoke_kalashnikova.nc +atm/waccm/emis/smoke_grf_frentzke.nc +atm/waccm/emis/meteor_smoke_kalashnikova.nc +atm/waccm/emis/smoke_grf_frentzke.nc +atm/cam/physprops/mice_warren2008.nc +atm/waccm/emis/meteor_smoke_kalashnikova.nc +atm/waccm/emis/smoke_grf_frentzke.nc +atm/cam/physprops/mice_warren2008.nc +atm/cam/dst/soil_erosion_factor_1x1_c120907.nc +atm/cam/dst/soil_erosion_factor_1x1_c120907.nc +atm/waccm/emis/early_earth_haze.nc + + +atm/cam/ozone +ozone_1.9x2.5_L26_2000clim_c091112.nc +O3 +CYCLICAL +2000 + + +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc + +waccm_ozone_c121126.nc +0 +ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc +atm/cam/ozone_strataero + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_2000clim_c091112.nc +CYCLICAL +2000 +aero_1.9x2.5_L26_list_c070514.txt +atm/cam/chem/trop_mam/aero +mam3_1.9x2.5_L30_2000clim_c130319.nc +CYCLICAL +2000 +aero_1.9x2.5_L26_list_c070514.txt + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_monthly_1849-2006_1.9x2.5_c090803.nc +CYCLICAL +2000 +atm/cam/chem/trop_mam/aero +mam3_1.9x2.5_L30_2000clim_c130319.nc +CYCLICAL +2000 + + +atm/cam/rad/VolcanicMass_1870-1999_64x1_L18_c040115.nc + + +atm/cam/chem/trop_mozart/ub/clim_p_trop.nc + + + +1361.27 +atm/cam/solar/solar_ave_sc19-sc23.c090810.nc +atm/cam/solar/solar_ave_sc19-sc23.c090810.nc +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc + + + +367.0e-6 +1760.0e-9 +316.0e-9 +653.45e-12 +535.0e-12 + + +atm/cam/ggas/ghg_hist_1765-2005_c091218.nc +atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_RNOCStrend_c141002.nc + + +atm/cam/ggas/co2flux_fossil_1751-2006-monthly_0.9x1.25_c20100204.nc + + +atm/cam/scyc/DMS_emissions_128x256_clim_c040122.nc +atm/cam/scyc/DMS_emissions_64x128_c030722.nc +atm/cam/scyc/DMS_emissions_32x64_c030722.nc +atm/cam/scyc/DMS_emissions_4x5_noncon_c050306.nc + + +atm/cam/scyc/oxid_128x256_L26_clim_c040112.nc +atm/cam/scyc/oxid_3d_64x128_L26_c030722.nc +atm/cam/scyc/oxid_3d_32x64_L26_c030722.nc +atm/cam/scyc/oxid_4x5_L26_noncon_c050306.nc + + +atm/cam/scyc/SOx_emissions_128x256_L2_1850-2000_c040321.nc +atm/cam/scyc/SOx_emissions_64x128_L2_c030722.nc +atm/cam/scyc/SOx_emissions_32x64_L2_c030722.nc +atm/cam/scyc/SOx_emissions_4x5_noncon_c050306.nc + + +atm/cam/ggas/noaamisc.r8.nc + + +atm/waccm/phot/xh2o_c080826.nc +atm/waccm/phot/xh2o_c080826.nc + + +atm/waccm/ub +ghg_forcing_2000_c110321.nc +atm/waccm/waccm_forcing +SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c180216.nc + + +atm/waccm/efld/coeff_lflux.dat +atm/waccm/efld/coeff_hflux.dat +atm/waccm/efld/wei96.cofcnts + + +atm/waccm/geomag/igrf_ceofs_c160412.nc + + +atm/waccm/phot/photon_c130710.dat +atm/waccm/phot/electron_121129.dat +atm/waccm/phot/EUVAC_reference_c170222.nc + + +atm/waccm/phot/wasolar_ave.nc + +atm/waccm/solar/wasolar_c140408.nc +atm/waccm/solar/wasolar_c140408.nc +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc + +atm/waccm/solar/solar_wind_imf_OMNI_WACCMX_2000001-2016366_c170907.nc + + +atm/waccm/qbo/qbocyclic28months.nc + + +0.125D0 + +1.D0 +1.5D-3 +1.0D-3 +2.5D-3 + +0.1D0 +12.0D-3 + +1.25D-15 +7.5D-16 +3.0D-15 + + + +.false. +.true. + + +0.1D0 +0.4D0 +0.55D0 +0.5D0 +0.5D0 +0.0625D0 + + +0.03D0 + + +atm/waccm/gw/newmfspectra40_dc25.nc +atm/waccm/gw/mfspectra_shallow_c140530.nc +0.25d0 +0.5d0 +0.5d0 +1.d0 +2.d0 +2.d0 +.true. +.false. +.false. +.false. +.true. +.true. +.true. +.false. +.false. + + +.true. +.false. +.true. + 0.0d0 + 2.0d0 + 2.0d0 + 3.0d0 + 2.0d0 + 0.01d0 + 1.0d-3 + 0.002d0 + 0.1d0 + + +15 + + +off +ionosphere +neutral +heelis +atm/waccm/efld/wei05sc_c080415.nc + + +1.00D0 +2.00D0 +1.50D0 +1.30D0 +1.60D0 +0.32D0 + + +atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc + + +atm/cam/chem/trop_mozart/emis/emissions.aircraft.T42LR.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_aircraft_NO2_1850-2000_1.9x2.5_c090729.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_aircraft_BC_1850-2000_1.9x2.5.c090729.nc + +atm/cam/chem/trop_mozart/emis/extfrc.CO.1.9x2.5_c101206.nc +atm/cam/chem/trop_mozart/emis/extfrc.NO.1.9x2.5_c101206.nc +atm/cam/chem/trop_mozart/emis/extfrc.SO2.1.9x2.5_c101206.nc + + +atm/cam/chem/emis/1992-2010/emissions.BIGALK.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.BIGENE.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C10H16.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C2H2.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C2H4.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C2H5OH.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C2H6.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C3H6.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.C3H8.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CB1.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CB2.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH2O.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3CHO.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3CN.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3COCH3.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3COCH3.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3COOH.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CH3OH.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.CO.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.DMS.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.HCN.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.HCOOH.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.ISOP.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.MEK.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.NH3.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.NO.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.NO.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.SO2.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.TOLUENE.surface.1.9x2.5_c110426.nc +atm/cam/chem/emis/1992-2010/emissions.SOA_BENZENE.surface.1.9x2.5_c120313.nc +atm/cam/chem/emis/1992-2010/emissions.SOA_XYLENE.surface.1.9x2.5_c120313.nc +atm/cam/chem/emis/1992-2010/emissions.SOA_TOLUENE.surface.1.9x2.5_c120313.nc +atm/cam/chem/2000_emis/IPCC_emissions_houw_BENZENE_2000_1.9x2.5_c120227.nc +atm/cam/chem/2000_emis/IPCC_emissions_houw_XYLENE_2000_1.9x2.5_c120227.nc + + +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_SO2_1850-2000_1.9x2.5.c090522.nc + +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_SO2_1850-2000_1.9x2.5.c090522.nc + + +atm/cam/chem/trop_mozart/emis/emissions.CH2O.surface.T42LR.nc +atm/cam/chem/trop_mozart/emis/emissions.CO.surface.T42LR.nc +atm/cam/chem/trop_mozart/emis/emissions.DMS.surface.T42LR.nc +atm/cam/chem/trop_mozart/emis/emissions.NO.surface.T42LR.nc +atm/cam/chem/trop_mozart/emis/emissions.SO2.surface.T42LR.nc +atm/cam/chem/trop_mozart/emis/emissions.ISOP.surface.T42LR.nc + + +atm/cam/chem/trop_mozart_aero/emis/aerocom_DMS_2000.c080417.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_CB1_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_OC1_2000.nosoa.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_surface_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_surface_2000.c080807.nc + +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_vertical_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_vertical_2000.c080807.nc + + +atm/cam/chem/trop_mozart_aero/emis/emis_NH3_2000_c111014.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_2000_c120315.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc + + + +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_DMS_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_DMS_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ag-ship-res_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ene_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_bb_surface_1750-2015_0.9x1.25_c20170509.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_biogenic_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_bb_surface_1750-2015_0.9x1.25_c20170322.nc + +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H2_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H2_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H5OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H5OH_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH2O_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH2O_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CHO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CHO_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CN_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCH3_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCHO_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COOH_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3OH_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_anthro_surface_1750-2015_0.9x1.25_c20180504.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_GLYALD_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCN_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCOOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCOOH_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_ISOP_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MEK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MEK_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MTERP_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_other_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_TOLUENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_TOLUENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_XYLENES_anthro_surface_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_XYLENES_bb_surface_1750-2015_0.9x1.25_c20170322.nc + +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc + +atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP6_0_c160219.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc + +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO2_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc +atm/cam/chem/stratvolc/VolcanEESMv3.10_SO2_850-2016_Mscale_Zreduc_1deg_c180416.nc +atm/cam/chem/stratvolc/VolcanEESMv3.10_SO2_850-2016_Mscale_Zreduc_2deg_c180416.nc +atm/cam/chem/stratvolc/VolcanEESMv3.10_piControl_SO2_1850-2014average_1deg_ZeroTrop_c180416.nc + + + + + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_2000climo_CCMI_RCP6_0_c160219.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc + + + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_2000climo_CCMI_RCP6_0_c160219.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc + +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc + + + + + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_2000_wofire_c150317.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_2000_wofire_c150317.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_2000_wofire_c150317.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_elev_2000_wofire_c150722.nc + +atm/cam/chem/emis/elev/SO2_emission_OCS_oxidation_elev_1849-2101_WACCM5_c150302.nc +atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP6_0_c160219.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_surf_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_surf_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_elev_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_elev_2000_c120716.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a1_surf_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a3_surf_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a1_elev_2000_c120716.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a3_elev_2000_c120716.nc + +atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCbb.surface.1.9x2.5_c20150914.nc +atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCff.surface.1.9x2.5_c20150914.nc +atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCbb.elev.1.9x2.5_mol_c20150914.nc +atm/cam/chem/emis/rcp85_finn_2002-2014/rcp85_finn_2000.SVOCbb.elev.1.9x2.5_c160601.nc + + +oxid_1.9x2.5_L26_1850-2005_c091123.nc + + +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 + +atm/cam/chem/trop_mozart_aero/oxid +CYCLICAL +2000 +oxid_1.9x2.5_L26_clim_list.c090805.txt + + +halons_oxid_1.9x2.5zm_L66_1849-2099_c160714.nc +atm/waccm/halons +CYCLICAL +2000 + + +CH4_1990-1999_clim_c090605.nc +filelist_c090605.txt +atm/cam/chem/methane +CYCLICAL +1995 + +tracer_cnst_halons_WACCM6_3Dmonthly_L70_1975-2014_c180216.nc +atm/cam/tracer_cnst +CYCLICAL +2000 + +CH4_1990-1999_clim_c090605.nc +filelist_c090605.txt +atm/cam/chem/methane +CYCLICAL +1995 + + +CESM_1949_2100_sad_V2_c130627.nc +atm/waccm/sulf +CESM_1849_2100_sad_V3_c160211.nc +atm/cam/volc +ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc +atm/cam/ozone +ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc +atm/cam/ozone_strataero + + +atm/waccm/sulf/sulfate.ar5_camchem_c130304.nc + + +NEU +MOZ +OFF + + +xactive_lnd + + +atm/cam/chem/trop_mam/atmsrf_ne5np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne16np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne30np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne60np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne120np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne240np4_110920.nc + +atm/cam/chem/trop_mam/atmsrf_ne0np4conus30x8_161116.nc + + +atm/cam/chem/trop_mozart/dvel/depvel_monthly.nc +atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc +atm/cam/chem/trop_mozart/dvel/regrid_vegetation_all_zero_aquaplanet_1deg_regularGrid_c20170421.nc +atm/cam/chem/trop_mozart/dvel/clim_soilw.nc +atm/cam/chem/trop_mozart/dvel/season_wes.nc + + +atm/waccm/phot/effxstex.txt +atm/cam/chem/trop_mozart/phot/tuv_xsect.nc +atm/cam/chem/trop_mozart/phot/o2src.nc +atm/waccm/phot/xs_short_jpl10_c140303.nc +atm/waccm/phot/temp_prs_GT200nm_JPL10_c140624.nc +atm/waccm/phot/RSF_GT200nm_v3.0_c080811.nc +atm/cam/chem/trop_mozart/phot/exo_coldens.nc + + +atm/waccm/ub/tgcm_ubc_1993_c100204.nc +atm/waccm/ub/snoe_eof.nc + + +atm/cam/chem/trop_mozart/ub/ubvals_b40.20th.track1_1996-2005_c110315.nc +atm/cam/chem/trop_mozart/ub +linoz2004_2006jpl_c081216.nc +atm/cam/chem/trop_mozart/ub/EESC_1850-2100_c090603.nc + + + +atm/cam/rad/carbon_penner_cooke_doubled_64x128_c021120.nc +atm/cam/rad/carbon_penner_cooke_doubled_32x64_c021120.nc +atm/cam/rad/carbon_penner_cooke_doubled_4x5_c021120.nc + + +atm/cam/dst/dst_source2x2tunedcam6-2x2-04062017.nc +atm/cam/dst/dst_source2x2_cam5.4_c150327.nc +atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc +atm/cam/dst/dst_source1x1tuned-cam4-06202012.nc + + + .false. + .true. + .true. + .false. + .true. + + 0.075D0 + 0.100D0 + 0.100D0 + + 1.0D0 + + + .false. + .true. + + + .false. + .true. + .true. + .true. + + + 0 + 1 + 1 + 1 + + 0.01d0 + 0.001d0 + + + .false. + .true. + .true. + + + .false. + .false. + + + .false. + .false. + .false. + .true. + .false. + 300.0D0 + 1.0D0 + 0.7D0 + 0.35D0 + 2.2D0 + 0.308 + 0.5 + 0.3 + 2.4 + 1.0 + 1.0 + 1.3 + 4.2 + 0.5 + 0.5 + 0.0 + 1.0D0 + 0.04 + .false. + .false. + .false. + + + +NONE +RK +MG +MG +SPCAM_m2005 +SPCAM_sam1mom + + 1 + 0 + 1 + 400.D-6 + + 2 + 0 + 1 + 500.D-6 + + max_overlap + in_cloud + + 1.0D0 + 1.0D0 + + 1 + 3 + + + 2 + 1 + 1 + + +1.0D0 +1.2D0 +1.2D0 + +1.0D0 +1.2D0 +1.2D0 + +.false. +.true. + +.false. +.true. + +.true. +.false. +1.0D0 +.true. + +.true. + +.false. + + +none +rk +park +CLUBB_SGS +SPCAM_sam1mom +SPCAM_m2005 + + + + 1.D2 + + + + 1.D-4 + + + + +0.D0 + +1.D0 +0.D0 +0.D0 + +1.D0 + +40.D3 + +40.D3 +30.D0 +100.D0 +100.D0 + +100.D3 +100.D0 +100.D0 + +30.D0 +40.D0 + + .false. + + + + 0.1D0 + 50.D0 + + +0.37D0 +0.35D0 +0.35D0 +0.45D0 +0.45D0 +0.45D0 +0.35D0 +0.45D0 +0.45D0 +0.45D0 + +0.55D0 +0.22D0 +0.55D0 +0.70D0 +0.13D0 + +0.26D0 +0.7D0 +0.24D0 +0.9D0 + + + +1.35D0 +1.62D0 +0.90D0 +1.00D0 +1.2D0 + + +1.0D0 +0.6D0 +1.0D0 + +0.1D0 +1.0D0 + +0.4D0 +1.0D0 + +1.00D0 +1.00D0 + + +.false. +off + + +.false. +.false. +.false. +.false. +.false. + + + 3 + 1 + 10 + + +.true. +4 + + +NONE +diag_TKE +HB +HBR +CLUBB_SGS +SPCAM_m2005 +SPCAM_sam1mom + + +ZM +UNICON +NONE +SPCAM +SPCAM + +NONE +UW +UNICON +Hack +Hack +CLUBB_SGS +SPCAM +SPCAM + + +.true. + +.false. +.true. +.true. + + 0.900D0 + 0.910D0 + 0.850D0 + 0.850D0 + 0.950D0 + 0.8975D0 + 0.8875D0 + 0.9125D0 + + 0.910D0 + 0.950D0 + 0.8975D0 + 0.8875D0 + 0.9125D0 + + 0.910D0 + 0.920D0 + 0.920D0 + + 0.913D0 + 0.903D0 + 0.905D0 + 0.880D0 + 0.910D0 + + 0.100D0 + 0.000D0 + 0.000D0 + + 0.800D0 + 0.770D0 + 0.700D0 + 0.770D0 + 0.500D0 + 0.900D0 + 0.900D0 + 0.680D0 + 0.680D0 + 0.650D0 + + 0.07D0 + 0.04D0 + 0.10D0 + 0.04D0 + + 500.0D0 + + 0.14D0 + 0.10D0 + 0.10D0 + 0.10D0 + 0.10D0 + + 500.0D0 + + 75000.0D0 + 25000.0D0 + 25000.0D0 + 25000.0D0 + 25000.0D0 + 25000.0D0 + 25000.0D0 + 25000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + 40000.0D0 + + 750.0D2 + 700.0D2 + 700.0D2 + + 1 + 5 + 5 + 4 + 4 + 4 + + 0.95D0 + 0.93D0 + 0.93D0 + 0.70D0 + 0.70D0 + 0.70D0 + + 0.80D0 + 0.85D0 + 0.80D0 + + 1.0D0 + 0.85D0 + + 1.1D0 + 1.0D0 + 1.0D0 + 1.1D0 + 1.0D0 + 1.0D0 + +.false. + +.false. +.true. + + + 5.0e-6 + 9.5e-6 + 45.0e-6 + 45.0e-6 + 45.0e-6 + 18.0e-6 + 18.0e-6 + 9.5e-6 + 9.5e-6 + 9.5e-6 + 9.5e-6 + + 30.0e-6 + 20.0e-6 + 16.0e-6 + 1.0e-6 + 18.0e-6 + + 4.0e-4 + 2.0e-4 + 2.0e-6 + 2.0e-4 + + 10.0e-6 + 5.0e-6 + 5.0e-6 + 5.0e-6 + 5.0e-6 + 5.0e-6 + + 10.0e-6 + 1.0e-6 + + + 1800.0D0 + 1.0e-4 + 5.0e-5 + 5.0e-5 + 5.0e-5 + 2.0e-4 + + 2.0e-4 + 1.0e-5 + 1.0e-5 + 1.0e-4 + 1.0e-4 + 1.0e-4 + + + 10.0 + 5.0 + + 5.0 + + + + 0.4000D0 + 0.7000D0 + + 0.4000D0 + 0.7000D0 + + 0.0030D0 + 0.0059D0 + 0.0035D0 + 0.0075D0 + 0.0059D0 + 0.0035D0 + 0.0075D0 + 0.0035D0 + 0.0035D0 + 0.0020D0 + 0.0040D0 + 0.0040D0 + 0.0040D0 + + 0.0030D0 + 0.0450D0 + 0.0035D0 + 0.0450D0 + 0.0035D0 + 0.0300D0 + 0.0035D0 + 0.0035D0 + 0.0020D0 + 0.0040D0 + 0.0040D0 + 0.0040D0 + + 3.0E-6 + 1.0E-5 + + 3.0E-6 + 5.0E-6 + 5.0E-6 + 5.0E-6 + 5.0E-6 + 5.0E-6 + + .false. + .true. + + .false. + 5 + 1 + + + + 1.0D0 + 0.5D0 + 0.5D0 + + +0 +1 + + 2 + 4 + 4 + 4 +42 +42 +42 +42 +42 +42 +42 +42 +42 +42 + +1 +2 +2 +2 +2 +4 + +2 +4 + + 8 +16 + +3.e+5 + +0 +1 + + +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/scam/iop/ARM97_4scam.nc + 36.6 + 262.5 + 19970618 + 84585 + 2088 + 1500 + 9 + nsteps + .true. + slt + + + + 2.5D5 + 2.5D7 + + + 4 + + 4 + + 1.0D18 + 2.0D16 + 2.0D16 + 1.17D16 + 7.14D14 + 1.5D14 + 1.5D13 + + 0.0D0 + 0.06D0 + 5 + + 1 + 12 + + +atm/cam/scam/iop/ARM95_4scam.nc + + + 3 + + + .true. + .false. + .false. + .false. + .false. + .false. + .false. + .true. + .false. + .true. + .true. + .true. + .true. + + + + + + 0 + 120 + + 0 + 2 + + .true. + + 3.322 + + 3.2 + + 3 + 1 + 1 + + 4 + + 1 + + 8 + + 1.0e99 + 1.9 + + none + + 2 + 1 + + 5 + 5 + 10 + 20 + 20 + 25 + + 5 + +-1 + 8.0e-8 + 1.0e13 + + -1 + 15.8e-8 + 1.5625e13 + +-1 + 8.0e-8 + 1.5625e13 + + 2.5e5 + 1.0e5 + 2.0e5 + + 3 + 3 + 3 + 5 + 1 + 1 + 1 + + 1 + + .false. + .true. + .true. + + 3 + +3 + + 0 + + 4 + + 1 + + + 2.0e-5 + 2.0e-5 + 0.0 + 0 + + + no + + + 0 + 0 + 0 + + + + + + +camrun + + +startup + + + + + + +ndays +1 + + +'monthly' + + + +101 + + +1990 + +'CESM1_MOD_TIGHT' + + + + + + + +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c061106.nc +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926a.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc +atm/cam/sst/sst_HadOIBl_bc_2.5x3.33_clim_c091210.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c061031.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_clim_c050526.nc + +atm/cam/sst/sst_HadOIBl_bc_256x512_clim_c031031.nc +atm/cam/sst/sst_HadOIBl_bc_128x256_clim_c050526.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_clim_c050526.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_clim_c050526.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_clim_c050526.nc + +atm/cam/sst/sst_HadOIBl_bc_1x1_clim_c101029.nc + + +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_clim_pi_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_clim_pi_c100127.nc + +atm/cam/sst/sst_HadOIBl_bc_128x256_clim_pi_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_clim_pi_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_clim_pi_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_clim_pi_c100128.nc + +atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c100129.nc + + +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2012_c130411.nc + +atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2012_c130411.nc + +atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2012_c130411.nc + +atm/cam/som/cam4.som.forcing.aquaplanet.QzaFix_h50Fix_TspunFix.fv19.nc + + +ocn/docn7/domain.ocn.1x1.111007.nc + + +atm/cam/ocnfrac/domain.camocn.128x256_USGS_070807.nc +share/domains/domain.ocn.T42_gx1v7.170629.nc +share/domains/domain.ocn.48x96_gx3v7_100114.nc +atm/cam/ocnfrac/domain.camocn.32x64_USGS_070807.nc +atm/cam/ocnfrac/domain.camocn.8x16_USGS_070807.nc + +atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc +atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc +share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc +share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc +share/domains/domain.ocn.4x5_gx3v7_100120.nc +atm/cam/ocnfrac/domain.camocn.10x15_USGS_070807.nc + +share/domains/domain.ocn.ne5np4_gx3v7.140810.nc +share/domains/domain.ocn.ne16np4_gx1v7.171018.nc +share/domains/domain.ocn.ne30_gx1v7.171003.nc +share/domains/domain.ocn.ne60np4_gx1v6.121113.nc +share/domains/domain.ocn.ne120np4_gx1v6.121113.nc +share/domains/domain.ocn.ne240np4_gx1v6.111226.nc + +atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc + + diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml new file mode 100644 index 0000000000..654098fe11 --- /dev/null +++ b/bld/namelist_files/namelist_definition.xml @@ -0,0 +1,7329 @@ + + + + + + + + + + + +Full pathname of time-variant boundary dataset for aerosol masses. +Default: set by build-namelist. + + + +Add CAM3 prescribed aerosols to the physics buffer. +Default: FALSE + + + + + +Dynamics/physics transpose method for nonlocal load-balance. +0: use mpi_alltoallv. +1: use point-to-point MPI-1 two-sided implementation. +2: use point-to-point MPI-2 one-sided implementation if supported, otherwise use + MPI-1 implementation. +3: use Co-Array Fortran implementation if supported, otherwise use MPI-1 implementation. +11-13: use mod_comm, choosing any of several methods internal to mod_comm. The method + within mod_comm (denoted mod_method) has possible values 0,1,2 and is set according + to mod_method = phys_alltoall - modmin_alltoall, where modmin_alltoall is 11. +-1: use option 1 when each process communicates with less than half of the other + processes, otherwise use option 0 (if max_nproc_smpx and nproc_busy_d are both > npes/2). +Default: -1 + + + +Select target number of chunks per thread. Must be positive. +Default: 1 + + + +Physics grid decomposition options. +-1: each chunk is a dynamics block. + 0: chunk definitions and assignments do not require interprocess comm. + 1: chunk definitions and assignments do not require internode comm. + 2: optimal diurnal, seasonal, and latitude load-balanced chunk definition and assignments. + 3: chunk definitions and assignments only require communication with one other process. + 4: concatenated blocks, no load balancing, no interprocess communication. +Default: 2 + + + +Physics grid decomposition options. + 0: assign columns to chunks as single columns, wrap mapped across chunks + 1: use (day/night; north/south) twin algorithm to determine load-balanced pairs of + columns and assign columns to chunks in pairs, wrap mapped +Default: 0 for unstructured grid dycores, 1 for lat/lon grid dycores + + + + + +Output constituent tendencies due to convection. Set to +'none', 'q_only' or 'all'. +Default: 'q_only' + + + +Turns on TEM circulation diagnostics history output. Only valid for FV dycore. + +Default: .false., unless it is overridden (WACCM with interactive chemistry and a few other specific + configurations do this) + + + +Turn on verbose output identifying columns that fail energy/water +conservation checks. +Default: FALSE + + + +Control the writing of qneg3 and qneg4 warning messages. +'summary' causes a summary of QNEG3 and QNEG4 errors to be + printed at the end of the run +'timestep' causes a summary of QNEG3 and QNEG4 errors to be printed at the + end of each timestep. The total is reset at the end of each timestep. +'off' causes the qneg3 and qneg4 warnings to be supressed. +Note that these settings do not affect the availability of qneg + history variables. +Default: 'summary' + + + + + +Number of layers from the top of the model over which to do dry convective +adjustment. Must be less than plev (the number of vertical levels). +Default: 3 + + + +The maximum number of iterations to achieve convergence in dry adiabatic adjustment. +For WACCM-X it can be advantageous to use a number which is much higher than the CAM +default. +Default: 15 + + + + + +Number of dynamics timesteps per physics timestep. If zero, a best-estimate +will be automatically calculated. +Default: 0 + + + +Number of tracer advection timesteps per physics timestep. +Nsplit is partitioned into nspltrac and nsplit/nspltrac, +with the latter being the number of dynamics timesteps per +tracer timestep, possibly rounded upward; after initialization, +the code quantity nsplit is redefined to be the number of +dynamics timesteps per tracer timestep. +Default: 0 + + + +Number of vertical re-mapping timesteps per physics timestep. +Nspltrac is partitioned into nspltvrm and nspltrac/nspltvrm, +with the latter being the number of tracer timesteps per +re-mapping timestep, possibly rounded upward; after initialization, +the code quantity nspltrac is redefined to be the number of +tracer timesteps per re-mapping timestep. +Default: 0 + + + +Order (mode) of X interpolation (1,..,6). +East-West transport scheme. + = 1: first order upwind + = 2: 2nd order van Leer (Lin et al 1994) + = 3: standard PPM + = 4: enhanced PPM (default) +Default: 4 + + + +Order (mode) of Y interpolation (1,..,6). +North-South transport scheme. + = 1: first order upwind + = 2: 2nd order van Leer (Lin et al 1994) + = 3: standard PPM + = 4: enhanced PPM (default) +Default: 4 + + + +Scheme to be used for vertical mapping. + = 1: first order upwind + = 2: 2nd order van Leer (Lin et al 1994) + = 3: standard PPM + = 4: enhanced PPM (default) +Default: 4 + + + +Flag indicating whether the dynamics uses internal algorithm for energy +conservation. +Default: .false. + + + +Enables optional filter for intermediate c-grid winds, (courtesy of Bill Putman). +Default: 0 + + + +1 for FFT filter always, 0 for combined algebraic/FFT filter. The value 0 +is used for CAM3, otherwise it is using the value 1. +Default: set by build-namelist + + + +Chooses type of divergence damping and velocity diffusion. +div24del2flag = 2 for ldiv2 (default), + = 4 for ldiv4, + = 42 for ldiv4 + ldel2 +where +ldiv2: 2nd-order divergence damping everywhere and increasing in top layers +ldiv4: 4th-order divergence damping +ldel2: 2nd-order velocity-component damping targetted to top layers, + with coefficient del2coef + +Default: set by build-namelist + + + +Chooses level of velocity diffusion. +Default: 3.0e5 + + + +Flag to turn on corrections that improve angular momentum conservation. +Default: .false. + + + +Flag to apply an arbitrary fix based on solid-body rotation to the zonal +velocity fields to improve conservation of angular momentum. +Default: .false. + + + +Flag to apply the fixer turned on by fv_am_fixer level by level. The +intent is to not contaminate the stratospheric circulation with +tropospheric AM loss, where it is most likely greatest (due to the larger +divergence fields). This option is experimental. +Default: .false. + + + +Flag to turn on a diagnostic calculation of angular momentum which is +written to the log file at each time step. Also enables calculation of +fields written to history file which are used in conjuction with those +enabled by do_circulation_diags for detailed analysis. +Default: .false. + + + +Switch to apply variable physics appropriate for the thermosphere and ionosphere +Default: set by build-namelist + + + +Flag to determine how to handle dpcoup warning messages +Default: off + + + + + +Set to 1 to force the 2D transpose computation when a 1D decomposition is +used. This is intended for debugging purposes only. +Default: 0 + + + +Geopotential method (routines geopk, geopk16, or geopk_d). + =0 for transpose method; + =1 for method using semi-global z communication with optional 16-byte arithmetic; + =2 for method using local z communication; +method 0, method 1 with 16-byte arithmetic and method 2 are all bit-for-bit across decompositions; +method 0 scales better than method 1 with npr_z, and method 1 is superior to method 0 for small npr_z; +The optimum speed is attained using either method 1 with 8-byte +arithmetic (standard for geopk16) or method 2 when utilizing the +optimal value for the associated parameter geopkblocks; for the last +two subcycles of a timestep, method 0 is automatically used; see +geopk.F90 and cd_core.F90. + +Default: 0 + + + +Geopotential method 2 pipeline parameter (routine geopk_d). +geopk_d implements a pipeline algorithm by dividing the +information that must be moved between processes into blocks. geopkblocks +specifies the number of blocks to use. The larger the number of blocks, +the greater the opportunity for overlapping communication with computation +and for decreasing instantaneous bandwidth requirements. The smaller the +number of blocks, the fewer MPI messages sent, decreasing MPI total latency. +See geopk_d within geopk.F90. +Default: 1 + + + +Mod_comm irregular underlying communication method for dyn_run/misc. +0 for original mp_sendirr/mp_recvirr +1 for mp_swapirr and a point-to-point implementation of communication pattern +2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern +Default: 0 + + + +True for mod_comm irregular communication handshaking for dyn_run/misc +Default: .true. + + + +True for mod_comm irregular communication blocking send for dyn_run/misc, +false for nonblocking send +Default: .true. + + + +Maximum number of outstanding nonblocking MPI requests to allow when +using mp_swapirr and point-to-point communications for dyn_run/misc. +Setting this less than the maximum can improve robustness for large process +count runs. If set to less than zero, then do not limit the number of +outstanding send/receive requests. +Default: -1 (so no limit) + + + +Mod_comm irregular underlying communication method for cd_core/geopk +0 for original mp_sendirr/mp_recvirr +1 for mp_swapirr and a point-to-point implementation of communication pattern +2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern +Default: 0 + + + +True for mod_comm irregular communication handshaking for cd_core/geopk +Default: .true. + + + +True for geopk_d and mod_comm irregular communication blocking send for +cd_core/geopk; false for nonblocking send. +Default: .true. + + + +Maximum number of outstanding nonblocking MPI requests to allow when +using mp_swapirr and point-to-point communications for cd_core/geopk. +Setting this less than the maximum can improve robustness for large process +count runs. If set to less than zero, then do not limit the number of +outstanding send/receive requests. +Default: -1 (so no limit) + + + +Mod_comm irregular underlying communication method for gather +0 for original mp_sendirr/mp_recvirr +1 for mp_swapirr and a point-to-point implementation of communication pattern +2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern +Default: 1 + + + +True for mod_comm irregular communication handshaking for gather +Default: .true. + + + +True for mod_comm irregular communication blocking send for gather, +false for nonblocking send +Default: .true. + + + +Maximum number of outstanding nonblocking MPI requests to allow when +using mp_swapirr and point-to-point communications for gather. +Setting this less than the maximum can improve robustness for large process +count runs. If set to less than zero, then do not limit the number of +outstanding send/receive requests. +Default: 64 + + + +Mod_comm irregular underlying communication method for scatter +0 for original mp_sendirr/mp_recvirr +1 for mp_swapirr and a point-to-point implementation of communication pattern +2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern +Default: 0 + + + +True for mod_comm irregular communication handshaking for scatter +Default: .false. + + + +True for mod_comm irregular communication blocking send for scatter, +false for nonblocking send +Default: .true. + + + +Maximum number of outstanding nonblocking MPI requests to allow when +using mp_swapirr and point-to-point communications for scatter. +Setting this less than the maximum can improve robustness for large process +count runs. If set to less than zero, then do not limit the number of +outstanding send/receive requests. +Default: -1 (so no limit) + + + +Mod_comm irregular underlying communication method for multiple tracers +0 for original mp_sendtrirr/mp_recvtrirr +1 for mp_swaptrirr and point-to-point communications +2 for mp_swaptrirr and all-to-all communications +Default: 0 + + + +True for mod_comm irregular communication handshaking for multiple tracers +Default: .true. + + + +True for mod_comm irregular communication blocking send for multiple +tracers, false for nonblocking send +Default: .true. + + + +Maximum number of outstanding nonblocking MPI requests to allow when +using mp_swaptrirr and point-to-point communications for multiple tracers. +Setting this less than the maximum can improve robustness for large process +count runs. If set to less than zero, then do not limit the number of +outstanding send/receive requests. +Default: -1 (so no limit) + + + +One or two simultaneous mod_comm irregular communications (excl. tracers) +Default: 2 + + + +Max number of tracers for simultaneous mod_comm irregular communications +Default: 3 + + + +For mod_comm gather/scatters, 0 for temporary contiguous buffers; 1 for mpi derived +types. +Default: 0 + + + +For geopk (geopktrans=1) messages, 0 for temporary contiguous buffers; 1 for mpi derived +types. +Default: 0 + + + +For mod_comm transposes, 0 for temporary contiguous buffers; 1 for mpi derived +types. +Default: 0 + + + +A four element integer array which specifies the YZ and XY decompositions. +The first two elements are the number of Y subdomains and number of Z +subdomains in the YZ decomposition. The second two elements are the number +of X subdomains and the number of Y subdomains in the XY decomposition. +Note that both the X and Y subdomains must contain at least 3 grid points. +For example, a grid with 96 latitudes can contain no more than 32 Y +subdomains. There is no restriction on the number of grid points (levels) +in a Z subdomain, but note that the threading parallelism in the FV dycore +is over levels, so for parallel efficiency it is best to have at least the +number of levels in each Z subdomain as there are threads available. + +There are a couple of rough rules of thumb to follow when setting the 2D +decompositions. The first is that the number of Y subdomains in the YZ +decomposition should be the same as the number of Y subdomains in the XY +decomposition (npr_yz(1) == npr_yz(4)). The second is that the total +number of YZ subdomains (npr_yz(1)*npr_yz(2)) should equal the total number +of XY subdomains (npr_yz(3)*npr_yz(4)). + +Default: ntask,1,1,ntask where ntask is the number of MPI tasks. This is a +1D decomposition in latitude. + + + +Overlapping of trac2d and cd_core subcycles. +Default: 0 + + + +Size of tracer domain decomposition for trac2d. +Default: 1 + + + +Control the writing of filew warning messages. +Default: 'off' + + + + + +TRUE => the offline meteorology winds are defined on the model grid cell walls. +Default: FALSE + + + +Name of file that contains the offline meteorology data. +Default: none + + + +Name of directory that contains the offline meteorology data. +Default: none + + + +Name of file that contains names of the offline meteorology data files. +Default: none + + + +TRUE => the offline meteorology file will be removed from local disk when no longer needed. +Default: FALSE + + + +(km) top of relaxation region of winds for offline waccm +Default: 60. + + + +(km) bottom of relaxation region of winds for offline waccm +Default: 50. + + + +Relaxation time (hours) applied to specified meteorology. + - positive values less then time step size gives 100% nudging + - negative values gives 0.0% nudging (infinite relaxation time) +Default: 0.0 + + + +switch to turn on/off mass fixer for offline driver +Default: true + + + +srf heat flux field name in met data file +Default: 'SHFLX' + + + +water vapor flux field name in met data file +Default: 'QFLX' + + + +multiplication factor for srf heat flux +Default: 1.0 + + + +multiplication factor for water vapor flux +Default: 1.0 + + + +multiplication factor for snow hieght +Default: 1.0 + + + +if false then do not allow surface models feedbacks influence climate +Default: true + + + +if true nudge meteorology surface fields TAUX, TAUY, SHFLX, QFLX rather than force +Default: true + + + + + +del^2 horizontal diffusion coefficient. This is used above the Nth order +diffusion. +Default: set by build-namelist + + + +Order (N) of horizontal diffusion operator used below the sponge layers. +N must be a positive multiple of 2. +Default: 4 + + + +The order N horizontal diffusion operator will be used in and below the +layer specified by this variable. +Default: 4 + + + +Nth order horizontal diffusion coefficient. +Default: set by build-namelist + + + +Number of days (from timestep 0) to run divergence damper. Use only if spectral +model becomes dynamicallly unstable during initialization. Suggested value: +2. (Value must be >= 0.) Default: 0. + + + +Time filter coefficient. Default: 0.06 + + + +Number of levels over which to apply Courant limiter, starting at top of +model. +Default: 5 + + + +Number of dynamics timesteps per physics timestep. If zero, a best-estimate +will be automatically calculated. +Default: 1 + + + + + +Spectral dynamics gather option. + 0: use mpi_allgatherv + 1: use point-to-point MPI-1 two-sided implementation + 2: use point-to-point MPI-2 one-sided implementation if supported, + otherwise use MPI-1 implementation + 3: use Co-Array Fortran implementation if supported, + otherwise use MPI-1 implementation +Default: 0 + + + +Spectral dynamics transpose option. + 0: use mpi_alltoallv + 1: use point-to-point MPI-1 two-sided implementation + 2: use point-to-point MPI-2 one-sided implementation if supported, + otherwise use MPI-1 implementation + 3: use Co-Array Fortran implementation if supported, + otherwise use MPI-1 implementation +Default: 0 + + + +Flag indicating whether to assign latitudes to equidistribute columns or +latitudes. This only matters when using a reduced grid. +Default: TRUE + + + +Number of processes assigned to dynamics (SE, EUL and SLD dycores). +Default: Total number of processes assigned to job. + + + +Stride for dynamics processes (EUL and SLD dycores). +E.g., if stride=2, assign every second process to the dynamics. +Default: 1 + + + + + +Whether or not to enable gravity waves produced by orography. +Default: set by build-namelist. + + + +Whether or not to enable gravity waves produced by frontogenesis. +Default: set by build-namelist. + + + +Whether or not to enable inertial gravity waves produced by frontogenesis. +Default: set by build-namelist. + + + +Whether or not to enable gravity waves produced by deep convection. +Default: set by build-namelist. + + + +Whether or not to enable gravity waves produced by shallow convection. +Default: .false. + + + +Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). +Default: set by build-namelist. + + + +Width of speed bins (delta c) for gravity wave spectrum (reference wave +speeds are from -pgwv*dc to pgwv*dc). +Default: set by build-namelist. + + + +Dimension for long wavelength gravity wave spectrum (wave numbers are from +-pgwv_long to pgwv_long). +Default: set by build-namelist. + + + +Width of speed bins (delta c) for long wavelength gravity wave spectrum +(reference wave speeds are from -pgwv_long*dc_long to pgwv_long*dc_long). +Default: set by build-namelist. + + + +Force the stress due to gravity waves to be zero at the top of the model. +In the low-top model, this helps to conserve momentum and produce a QBO. +Default: set by build-namelist. + + + +Apply limiters to tau before applying the efficiency factor, rather than +afterward. +Default: set by build-namelist + + + +Apply limiter on maximum wind tendency from stress divergence in gravity wave drag scheme. +Default: set by build-namelist + + + +Efficiency associated with convective gravity waves from the Beres +scheme (deep convection). +Default: set by build-namelist. + + + +Efficiency associated with convective gravity waves from the Beres +scheme (shallow convection). +Default: set by build-namelist. + + + +Efficiency associated with gravity waves from frontogenesis. +Default: set by build-namelist. + + + +Efficiency associated with inertial gravity waves from frontogenesis. +Default: set by build-namelist. + + + +Efficiency associated with orographic gravity waves. +Default: set by build-namelist. + + + +Whether or not to enable gravity waves produced by meso-Beta Ridges. +Default: set by build-namelist + + + +Number of meso-Beta ridges (per gridbox) to invoke. +Default: 10 (set by build-namelist) + + + +Efficiency scaling factor associated with anisotropic OGW. +Default: set by build-namelist. + + + +Max efficiency associated with anisotropic OGW. +Default: 1.0 + + + +Drag coefficient for obstacles in low-level flow. +Default: 1.0 + + + +Whether or not to allow trapping for meso-Beta Ridges. +Default: FALSE (set by build-namelist) + + + +Whether or not to enable gravity waves produced by meso-gamma Ridges. +Default: FALSE (set by build-namelist) + + + +Number of meso-gamma ridges (per gridbox) to invoke. +Default: -1 (set by build-namelist) + + + +Efficiency scaling factor associated with anisotropic OGW. +Default: set by build-namelist. + + + +Max efficiency associated with anisotropic OGW. +Default: 1.0 + + + +Drag coefficient for obstacles in low-level flow. +Default: 1.0 + + + +Whether or not to allow trapping for meso-gamma Ridges. +Default: set by build-namelist + + + +Full pathname of boundary dataset for meso-gamma ridges. +Default: set by build-namelist. + + + +Critical Froude number squared (used only for orographic waves). +Default: set by build-namelist. + + + +Factor to multiply tau by, for orographic waves in the southern hemisphere. +Default: 1._r8 + + + +Inverse Prandtl number used in gravity wave diffusion +Default: set by build-namelist + + + +Scaling factor for heating depth in gravity waves from convection. If less than 1.0 +this acts as an effective reduction of the gravity wave phase speeds needed to drive +the QBO. +Default: set by build-namelist + + + +Scale SGH by land fraction in gravity wave drag +Default: set by build-namelist + + + +Frontogenesis function critical threshold. +Default: set by build-namelist. + + + +Full pathname of Beres lookup table data file for gravity waves sourced +from deep convection. +Default: set by build-namelist. + + + +Full pathname of Beres lookup table data file for gravity waves sourced +from shallow convection. +Default: set by build-namelist. + + + +Background source strength (used for waves from frontogenesis). +Default: set by build-namelist. + + + +Background source strength (used for inertial waves from frontogenesis). +Default: set by build-namelist. + + + +Whether or not to use tapering at the poles to reduce the effects of +mid-scale gravity waves from frontogenesis. +Default: set by build-namelist. + + + + + +If .true. use separate dividing streamlines for downslope wind and flow +splitting regimes ("DS" configuration). +If .false. use single dividing streamline as in Scinocca & McFarlane +2000 ("SM" configuration). +Default: set by build-namelist. + + + +If true, then use smooth regimes +Default: set by build-namelist. + + + +If true, then adujust tauoro +Default: set by build-namelist. + + + +If true, then adjust for bit-for-bit answers with the ("N5") configuration +Default: set by build-namelist. + + + +Enhancement factor for downslope wind stress in DS configuration. +Default: set by build-namelist. + + + +Enhancement factor for depth of downslope wind regime in DS configuration +Default: set by build-namelist. + + + +Lower inverse Froude number limits on linear ramp terminating downslope wind regime for high mountains in DS configuration +Default: set by build-namelist. + + + +Upper inverse Froude number limits on linear ramp terminating downslope wind regime for high mountains in DS configuration +Default: set by build-namelist. + + + +Enhancement factor for downslope wind stress in SM configuration. +Default: set by build-namelist. + + + +Critical inverse4 Froude number +Default: set by build-namelist. + + + +minimum surface displacement height for orographic waves (m) +Default: set by build-namelist. + + + +Minimum wind speed for orographic waves +Default: set by build-namelist. + + + +Minimum stratification allowing wave behavior +Default: set by build-namelist. + + + +Minimum stratification allowing wave behavior +Default: set by build-namelist. + + + +If TRUE gravity wave ridge scheme will contribute to vertical diffusion tendencies. +Default: TRUE + + + + + +Full pathname of time-variant boundary dataset for greenhouse gas surface +values. +Default: set by build-namelist. + + + +CH4 volume mixing ratio. This is used as the time invariant surface value +of CH4 if no time varying values are specified. +Default: set by build-namelist. + + + +CO2 volume mixing ratio. This is used as the time invariant surface value +of CO2 if no time varying values are specified. +Default: set by build-namelist. + + + +User override for the prescribed CO2 volume mixing ratio used by the radiation +calculation. Note however that the prescribed value of CO2 which is sent +to the surface models is still the one that is set using either the +{{ hilight }}co2vmr{{ closehilight }} or the {{ hilight }}scenario_ghg{{ closehilight }} variables. +Default: not used + + + +CFC11 volume mixing ratio adjusted to reflect contributions from many GHG +species. This is used as the time invariant surface value of F11 if no +time varying values are specified. +Default: set by build-namelist. + + + +CFC12 volume mixing ratio. This is used as the time invariant surface value +of CFC12 if no time varying values are specified. +Default: set by build-namelist. + + + +N2O volume mixing ratio. This is used as the time invariant surface value +of N2O if no time varying values are specified. +Default: set by build-namelist + + + +Data start year. Use in conjunction +with {{ hilight }}ghg_yearstart_model{{ closehilight }}. +Default: 0 + + + +Model start year. Use in conjunction +with {{ hilight }}ghg_yearstart_data{{ closehilight }}. +Default: 0 + + + +Amount of co2 ramping per year (percent). Only used +if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' +Default: 1.0 + + + +CO2 cap if > 0, floor otherwise. Specified as multiple or fraction of +inital value; e.g., setting to 4.0 will cap at 4x initial CO2 setting. +Only used if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' +Default: boundless if {{ hilight }}ramp_co2_annual_rate{{ closehilight }} > 0, zero otherwise. + + + +Date on which ramping of co2 begins. The date is encoded as an integer in +the form YYYYMMDD. Only used if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' +Default: 0 + + + +If {{ hilight }}scenario_ghg{{ closehilight }} is set to "RAMPED" then the greenhouse +gas surface values are interpolated between the annual average values +read from the file specified by {{ hilight }}bndtvghg{{ closehilight }}. +In that case, the value of this variable (> 0) fixes the year of the +lower bounding value (i.e., the value for calendar day 1.0) used in the +interpolation. For example, if rampyear_ghg = 1950, then the GHG surface +values will be the result of interpolating between the values for 1950 and +1951 from the dataset. +Default: 0 + + + +Controls treatment of prescribed co2, ch4, n2o, cfc11, cfc12 volume mixing +ratios. May be set to 'FIXED', 'RAMPED', 'RAMP_CO2_ONLY', or 'CHEM_LBC_FILE'. +FIXED => volume mixing ratios are fixed and have either default or namelist + input values. +RAMPED => volume mixing ratios are time interpolated from the dataset + specified by {{ hilight }}bndtvghg{{ closehilight }}. +RAMP_CO2_ONLY => only co2 mixing ratios are ramped at a rate determined by + the variables {{ hilight }}ramp_co2_annual_rate{{ closehilight }}, {{ hilight }}ramp_co2_cap{{ closehilight }}, + and {{ hilight }}ramp_co2_start_ymd{{ closehilight }}. +CHEM_LBC_FILE => volume mixing ratios are set from the chemistry lower boundary + conditions dataset specified by {{ hilight }}flbc_file{{ closehilight }}. +Default: FIXED + + + + + +Full pathname of time-variant boundary dataset for greenhouse gas production/loss +rates. Only used by the simple prognostic GHG chemistry scheme that is +enabled via the argument "-prog_species GHG" to configure. +Default: set by build-namelist. + + + +This variable should not be set by the user. It is set by build-namelist +when the user specifies the argument "-prog_species GHG" to configure which +turns on a simple prognostic chemistry scheme for CH4, N2O, CFC11 and +CFC12. +Default: set by build-namelist + + + + + + +Flag to set rad_climate variable so that the prognostic CO2 controlled by +the co2_cycle module is radiatively passive. +Default: FALSE + + + +If TRUE turn on CO2 code. +Default: set by build-namelist + + + +If TRUE read co2 flux from fuel. +Default: set by build-namelist + + + +If TRUE read co2 flux from ocn. +Default: FALSE + + + +Filepath for dataset containing CO2 flux from ocn. +Default: none + + + +Filepath for dataset containing CO2 flux from fossil fuel. +Default: none + + + + + +Sets the averaging flag for all variables on a particular history file +series. Valid values are: + + A ==> Average + B ==> GMT 00:00:00 average + I ==> Instantaneous + M ==> Minimum + X ==> Maximum + L ==> Local-time + S ==> Standard deviation + +The default is to use the averaging flags for each variable that are set in +the code via calls to subroutine addfld. + +Defaults: set in code via the addfld and add_default subroutine calls. + + + +If true don't put any of the variables on the history tapes by +default. Only output the variables that the user explicitly lists in +the {{ hilight }}fincl#{{ closehilight }} namelist items. +Default: FALSE + + + +List of fields to exclude from the 1st history file (by default the name +of this file contains the string "h0"). +Default: none + + +List of fields to exclude from the 2nd history file (by default the name +of this file contains the string "h1"). +Default: none + + +List of fields to exclude from the 3rd history file (by default the name +of this file contains the string "h2"). +Default: none + + +List of fields to exclude from the 4th history file (by default the name +of this file contains the string "h3"). +Default: none + + +List of fields to exclude from the 5th history file (by default the name +of this file contains the string "h4"). +Default: none + + +List of fields to exclude from the 6th history file (by default the name +of this file contains the string "h5"). +Default: none + + +List of fields to exclude from the 7th history file (by default the name +of this file contains the string "h6"). +Default: none + + +List of fields to exclude from the 8th history file (by default the name +of this file contains the string "h7"). +Default: none + + +List of fields to exclude from the 9th history file (by default the name +of this file contains the string "h8"). +Default: none + + +List of fields to exclude from the 10th history file (by default the name +of this file contains the string "h9"). +Default: none + + + +List of fields to include on the first history file (by default the name of +this file contains the string "h0"). The added fields must be in Master +Field List. The averaging flag for the output field can be specified by +appending a ":" and a valid averaging flag to the field name. Valid flags +are: + + A ==> Average + B ==> GMT 00:00:00 average + I ==> Instantaneous + M ==> Minimum + X ==> Maximum + L ==> Local-time + S ==> Standard deviation + +Default: set in code via the addfld and add_default subroutine calls. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 2nd history file (by default +the name of this file contains the string "h1"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 3rd history file (by default +the name of this file contains the string "h2"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 4th history file (by default +the name of this file contains the string "h3"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 5th history file (by default +the name of this file contains the string "h4"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 6th history file (by default +the name of this file contains the string "h5"). +Default: none. + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 7th history file (by default +the name of this file contains the string "h6"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 8th history file (by default +the name of this file contains the string "h7"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 9th history file (by default +the name of this file contains the string "h8"). +Default: none. + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for the 10th history file (by default +the name of this file contains the string "h9"). +Default: none. + + + +if .true. then output CLUBBs history statistics +Default: false + + + +if .true. then output CLUBBs radiative history statistics +Default: false + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zt grid. +Default: none. + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zm grid. +Default: none. + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zt grid. +Default: none. + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zm grid. +Default: none. + + + +Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on surface. +Default: none. + + + +Collect all column data into a single field and output in ncol format, +much faster than default when you have a lot of columns. +Default: false + + + +List of columns or contiguous columns at which the fincl1 fields will be +output. Individual columns are specified as a string using a longitude +degree (greater or equal to 0.) followed by a single character +(e)ast/(w)est identifer, an underscore '_' , and a latitude degree followed +by a single character (n)orth/(s)outh identifier. For example, '10e_20n' +would pick the model column closest to 10 degrees east longitude by 20 +degrees north latitude. A group of contiguous columns can be specified +using bounding latitudes and longitudes separated by a colon. For example, +'10e:20e_15n:20n' would select the model columns which fall with in the +longitude range from 10 east to 20 east and the latitude range from 15 +north to 20 north. +Default: none + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 2nd history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 3rd history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 4th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 5th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 6th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 7th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 8th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 9th history file. + + +Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 10th history file. + + + +Specific fields which will be written using the non-default precision on +the 1st history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 2nd history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 3rd history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 4th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 5th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 6th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 7th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 8th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 9th history file. +Default: none + + +Specific fields which will be written using the non-default precision on +the 10th history file. +Default: none + + + + +Array of history filename specifiers. The filenames of up to six history +output files can be controlled via this variable. Filename specifiers give +generic formats for the filenames with specific date and time components, +file series number (0-5), and caseid, filled in when the files are +created. The following strings are expanded when the filename is created: +%c=caseid; %t=file series number (0-5); %y=year (normally 4 digits, more +digits if needed); %m=month; %d=day; %s=seconds into current day; %%=% +symbol. Note that the caseid may be set using the namelist +variable {{ hilight }}case_name{{ closehilight }}. + +For example, for a simulation with caseid="test" and current date and time +of 0000-12-31 0:00UT, a filename specifier of "%c.cam2.h%t.%y-%m.nc" would +expand into "test.cam2.h0.0000-12.nc" for the first history file. The +filename specifier "%c.cam2.h%t.%y-%m-%d-%s.nc" would expand to +"test.cam2.h1.0000-12-31-00000.nc" for the second history file. Spaces are +not allowed in filename specifiers. Although the character "/" is allowed +in the specifier, it will be interpreted as a directory name and the +corresponding directories will have to be created in the model execution +directory (directory given to configure with -cam_exedir option) before +model execution. The first element is for the primary history file which +is output by default as a monthly history file. Entries 2 through 6 are +user specified auxilliary output files. + +Defaults: "%c.cam2.h0.%y-%m.nc", "%c.cam2.h1.%y-%m-%d-%s.nc", ..., + "%c.cam2.h5.%y-%m-%d-%s.nc" + + + +Full pathname of the satellite track data used by the satellite track history +output feature. +Default: none + + +Satellite track history filename specifier. See {{ hilight }}hfilename_spec{{ closehilight }} +Default: "%c.cam2.sat.%y-%m-%d-%s.nc" + + +List of history fields to output along the satellite track specified by {{ hilight }}sathist_track_infile{{ closehilight }} +Default: none + + +Sets the maximum number of observation columns written to the satellite track history file +series. +Default: 100000 + + + +Sets the number of columns closest to the observation that should be output. Setting +this to a number greater than 1 allows for spatial interpolation in the post processing. +Default: 1 + + + +Sets the number of timesteps closest to the observation that should be output. Setting +this to a number greater than 1 allows for temporal interpolation in the post processing. +Default: 1 + + + +Frequency that initial files will be output: 6-hourly, daily, monthly, +yearly, or never. Valid values: 'NONE', '6-HOURLY', 'DAILY', 'MONTHLY', +'YEARLY', 'CAMIOP', 'ENDOFRUN'. +Default: 'YEARLY' + + + +If false then include only REQUIRED fields on IC file. If true then +include required AND optional fields on IC file. +Default: FALSE + + + +Array containing the maximum number of time samples written to a history +file. The first value applies to the primary history file, the second +through tenth to the auxillary history files. +Default: 1,30,30,30,30,30,30,30,30,30 + + + +Array containing the starting time of day for local time history averaging. +Used in conjuction with lcltod_stop. If lcltod_stop is less than lcltod_start, +then the time range wraps around 24 hours. The start time is included in the +interval. Time is in seconds and defaults to 39600 (11:00 AM). The first value +applies to the primary hist. file, the second to the first aux. hist. file, etc. +Default: none + + + +Array containing the stopping time of day for local time history averaging. +Used in conjuction with lcltod_start. If lcltod_stop is less than lcltod_start, +then the time range wraps around 24 hours. The stop time is not included in the +interval. Time is in seconds and defaults to 0 (midnight). The first value +applies to the primary hist. file, the second to the first aux. hist. file, etc. +Default: none + + + + +Array specifying the precision of real data written to each history file +series. Valid values are 1 or 2. '1' implies output real values are 8-byte +and '2' implies output real values are 4-byte. + +Default: 2,2,2,2,2,2,2,2,2,2 + + + + + +Array of write frequencies for each history file series. +If {{ hilight }}nhtfrq(1){{ closehilight }} = 0, the file will be a monthly average. +Only the first file series may be a monthly average. If +{{ hilight }}nhtfrq(i){{ closehilight }} > 0, frequency is specified as number of +timesteps. If {{ hilight }}nhtfrq(i){{ closehilight }} < 0, frequency is specified +as number of hours. + +Default: 0,-24,-24,-24,-24,-24,-24,-24,-24,-24 + + + +If interpolate_output(k) = .true., then the k'th history file will be +interpolated to a lat/lon grid before output. +Default: .false. + + + +Size of latitude dimension of grid for interpolated output. +If interpolate_nlat and interpolate_nlon are zero, reasonable values +will be chosen by the dycore based on the run resolution. +Default: 0 + + + +Size of longitude dimension of grid for interpolated output. +If interpolate_nlat and interpolate_nlon are zero, reasonable values +will be chosen by the dycore based on the run resolution. +Default: 0 + + + +Selects interpolation method for output on lat/lon grid. +0: Use SE's native high-order method. +1: Use a bilinear method. +Default: 1 (bilinear) + + + +Selects output grid type for lat/lon interpolated output. +1: Equally spaced, including poles (FV scalars output grid). +2: Gauss grid (CAM Eulerian). +3: Equally spaced, no poles (FV staggered velocity). +Default: 1 + + + + + +Full pathname of initial atmospheric state dataset (NetCDF format). +Default: set by build-namelist. + + + +Perturb the initial conditions for temperature randomly by up to the given +amount. Only applied for initial simulations. +Default: 0.0 + + + +Full pathname of master restart file from which to branch. Setting is +Required for branch run. +Default: none + + + +If TRUE, try to initialize data for all consituents by reading from the +initial conditions dataset. If variable not found then data will be +initialized using internally-specified default values. If FALSE then don't +try reading constituent data from the IC file; just use the +internally-specified defaults. +Default: TRUE + + + + + + +If true, the COSP cloud simulator is run. +Setting this namelist variable happens automatically if you compile with COSP. +COSP will not run unless this is set to .true. in the namelist! +Turn on the desired simulators using lXXX_sim namelist vars +If no specific simulators are specified, all of the simulators +are run on all columns and all output is saved. (useful for testing). +COSP is available with CAM4, CAM5 and CAM6 physics. +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + + + +If true, COSP cloud simulators are run to produce +all output required for the COSP plots in the AMWG diagnostics package. +sets cosp_ncolumns=10 and cosp_nradsteps=3 +(appropriate for COSP statistics derived from seasonal averages), +and runs MISR, ISCCP, MODIS, CloudSat radar and CALIPSO lidar simulators +(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., +cosp_lmodis_sim=.true.,cosp_lradar_sim=.true.,cosp_llidar_sim=.true.). +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + + + +If true, the COSP cloud simulators are run to produce +select output for the AMWG diagnostics package. +sets cosp_ncolumns=10 and cosp_nradsteps=3 +(appropriate for COSP statistics derived from seasonal averages), +and runs MISR, ISCCP, MODIS, and CALIPSO lidar simulators +(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., +cosp_lmodis_sim=.true.,cosp_llidar_sim=.true.). +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + + + +If true, the passive COSP cloud simulators are run to produce +select output for the AMWG diagnostics package. +sets cosp_ncolumns=10 and cosp_nradsteps=3 +(appropriate for COSP statistics derived from seasonal averages), +and runs MISR, ISCCP, and MODIS simulators +(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true.,cosp_lmodis_sim=.true.). +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + + + +If true, the active COSP cloud simulators are run to produce +select output for the AMWG diagnostics package. +sets cosp_ncolumns=10 and cosp_nradsteps=3 +(appropriate for COSP statistics derived from seasonal averages), +and runs CloudSat radar and CALIPSO lidar simulators +(cosp_lradar_sim=.true.,cosp_llidar_sim=.true.). +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + + + +If true, the ISCCP cloud simulator is run to produce +select output for the AMWG diagnostics package. +sets cosp_ncolumns=10 and cosp_nradsteps=3 +(appropriate for COSP statistics derived from seasonal averages), +and runs ISCCP simulator +(cosp_lmisr_sim=.false.,cosp_lisccp_sim=.true., +cosp_lmodis_sim=.false.,cosp_lradar_sim=.false.,cosp_llidar_sim=.false.). +This default logical is set in cospsimulator_intr.F90. +1236: Default: FALSE + + + +If true, run all simulators using the default values cosp_ncolumns=50 and +cosp_nradsteps=1. This option is mainly intended for testing, but it also +must be used in order to output the input fields needed to run the +simulator in an offline mode (via setting cosp_histfile_aux=.true.). +Default: FALSE + + + +If true, COSP radar simulator will be run and all non-subcolumn output +will be saved. +Default: FALSE + + + +If true, COSP lidar simulator will be run and all non-subcolumn output +will be saved +Default: FALSE + + + +If true, COSP ISCCP simulator will be run and all non-subcolumn output +will be saved. ISCCP simulator is run on only daylight +columns. +Default: FALSE + + + +If true, MISR simulator will be run and all non-subcolumn output +will be saved. MISR simulator is run on only daylight +columns. +Default: FALSE + + + +If true, MODIS simulator will be run and all non-subcolumn output +will be saved. + +Default: FALSE + + + + + +If true, the COSP cloud simulator is run for CFMIP 3-hourly +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + +If true, the COSP cloud simulator is run for CFMIP daily +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + +If true, the COSP cloud simulator is run for CFMIP off-line +monthly experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + +If true, the COSP cloud simulator is run for CFMIP monthly +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + + + +Number of subcolumns in SCOPS +This default logical is set in cospsimulator_intr.F90 +Default: 50 + + + + + +Turns on sampling along a-train orbit for radar and lidar simulators. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + +Full pathname for the Atrain orbit data file. +cosp_atrainorbitdata is requiref if cosp_sample_atrain is TRUE. +Default: NONE + + + + + +This specifies the CAM history tape where COSP diagnostics will be written. +Ignored/not used if any of the cosp_cfmip_* namelist variables are invoked. + +This default is set in cospsimulator_intr.F90 +Default: 1 + + +If true, additional output is added to make it possible to +run COSP off-line. + +This default is set in cospsimulator_intr.F90 +Default: FALSE + + +This specifies the CAM history tape where extra COSP diagnostics will be written. + +This default is set in cospsimulator_intr.F90 +Default: -1 + + + +This specifies the frequency at which is COSP is called, +every cosp_nradsteps radiation timestep. + +This default is set in cospsimulator_intr.F90 +Default: 1 + + + +Turns on sub-column output from COSP. +If both the isccp/misr simulators and the lidar/radar simulators +are run, lfrac_out is from the isccp/misr simulators columns. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + + + + +Number of macrophysics/microphysics substeps. +Default: 1 + + + + +Threshold for autoconversion of cold ice in RK microphysics scheme. +Default: set by build-namelist + + + +Threshold for autoconversion of warm ice in RK microphysics scheme. +Default: set by build-namelist + + + +Tunable constant for evaporation of precip in RK microphysics scheme. +Default: set by build-namelist + + + +Critical radius at which autoconversion become efficient in RK microphysics +scheme. +Default: set by build-namelist + + + +Relative humidity threshold for stratospheric cloud water condensation in RK microphysics +poleward of 50 degrees. +Default: none + + + + +Switch to control whether Park macrophysics should prognose +cloud ice (cldice). +Default: .true., except for carma=cirrus and carma=carma_dust + + + +Switch to control whether Park macrophysics should prognose +cloud liquid (cldliq). +Default: .true. + + + +Switch to control whether Park macrophysics should perform +detrainment into the stratiform cloud scheme. +Default: .true., except for carma=cirrus and carma=carma_dust + + + + + +Version number for MG microphysics. This value is set automatically based +on settings in configure and passed to build-namelist +Default: 1 for CAM5 and 2 for CAM6 + + + +Sub-version number for MG microphysics +Default: 0 + + + +Autoconversion size threshold +Default: set by build-namelist + + + +Switch to control whether MG microphysics should prognose +cloud ice (cldice). +Default: .true., except for carma=cirrus and carma=carma_dust + + + +Switch to control whether MG microphysics should prognose +cloud liquid (cldliq). +Default: .true. + + + +Number of substeps over MG microphysics. +Default: 1 + + + +Type of precipitation fraction. +Default: for CLUBB runs => in_cloud; + all others => max_overlap + + + +Efficiency factor for berg +Default: 1 + + + +Do Seifert and Behang (2001) autoconversion and accretion physics when set to true. +Default: .false. + + + +Switch to control whether MG microphysics performs a uniform calculation or not +(useful for sub-columns) +Default: .false. unless use_subcol_microp is true + + + +Switch to control whether MG microphysics should adjust the temperature +at the level containing the cold point tropopause by using the value +obtain by extrapolating between levels. +Default: set by build-namelist + + + +Set .true. to hold cloud droplet number constant. +Default: .false. + + + +Set .true. to hold cloud ice number constant. +Default: .false. + + + +In-cloud droplet number concentration when micro_mg_nccons=.true. +Default: 100.e6 m-3 + + + +In-cloud ice number concentration when micro_mg_nicons=.true. +Default: 0.1e6 m-3 + + + + +prescribed aerosol bulk sulfur scale factor +Default: 2 + + + +Switch to turn on heterogeneous freezing code. +Default: .false. + + + +Add diagnostic output for heterogeneous freezing code. +Default: .false. + + + +Switch to turn on treatment of pre-existing ice in the ice nucleation code. +Default: .false., except .true. for CAM6 + + + +Add diagnostics for pre-existing ice option in ice nucleation code to history output. +Default: .false. + + + +Subgrid scaling factor for relative humidity in ice nucleation code. If it has +a value of -1, then indicates that the subgrid scaling factor will be +calculated on the fly as 1 / qsatfac (i.e. the saturation scaling factor). +Default: set by build-namelist + + + +Subgrid scaling factor for relative humidity in ice nucleation code in the +stratosphere. If it has a value of -1, then indicates that the subgrid +scaling factor will be calculated on the fly as 1 / qsatfac (i.e. the +saturation scaling factor). +Default: set by build-namelist + + + +Switch to determine whether ice nucleation happens using the incloud (true) or +the gridbox average (false) relative humidity. When true, it is assumed that +the incloud relative humidity for nucleation is 1. +Default: .true., except .false. for CAM6 + + + +Fraction of Aitken mode sulfate particles assumed to nucleate ice in the polar +stratospheric. Provides an increase in homogeneous freezing over the Liu&Penner method. +Temporary solution to adjust ice surface area density and dehydration in the +polar stratosphere where there doesn't seem to be enough nucleation. A value of +zero means Liu&Penner is used. +Default: 1.0 + + + +Indicates whether to use the tropopause level to determine where to adjust +nucleation for the stratosphere (true) or whether to use a hard coded transition +level from 100 to 125 hPa applied only in the polar regions (false). +Default: .true. + + + + + + + +Characteristic adjustment time scale for Hack shallow scheme. +Default: 1800.0 + + + +Rain water autoconversion coefficient for Hack shallow scheme. +Default: set by build-namelist + + + + +Penetrative entrainment efficiency in UW shallow scheme. +Default: set by build-namelist + + + + + +Switch for Vavrus "freeze dry" adjustment in cloud fraction. Set to FALSE to +turn the adjustment off. +Default: .true. + + + +Switch for ice cloud fraction calculation. +Default: .true. for CAM5 and CAM6, otherwise .false. + + + +Minimum rh for low stable clouds. +Default: set by build-namelist + + + +Adjustment to rhminl for land without snow cover. +Default: 0.0 for CAM6; + all others => 0.10 + + + +Minimum rh for high stable clouds. +Default: set by build-namelist + + + +parameter for shallow convection cloud fraction. +Default: set by build-namelist + + + +parameter for shallow convection cloud fraction. +Default: set by build-namelist + + + +parameter for deep convection cloud fraction. +Default: set by build-namelist + + + +parameter for deep convection cloud fraction. +Default: set by build-namelist + + + +top pressure bound for mid level cloud. +Default: set by build-namelist + + + +Bottom height (Pa) for mid-level liquid stratus fraction. +Default: 700.e2 for CAM5 and CAM6; all others=> 750.e2 + + + +Scheme for ice cloud fraction: 1=wang & sassen, 2=schiller (iciwc), +3=wood & field, 4=Wilson (based on smith), 5=modified slingo (ssat & empyt cloud) +Default: set by build-namelist + + + +Critical RH for ice clouds (Wilson & Ballard scheme). +Default: set by build-namelist + + + +Minimum rh for ice cloud fraction > 0. +Default: set by build-namelist + + + +rhi at which ice cloud fraction = 1. +Default: set by build-namelist + + + +Minimum rh for ice cloud fraction > 0 in the stratosphere. +Default: set by build-namelist + + + +rhi at which ice cloud fraction = 1 in the stratosphere. +Default: set by build-namelist + + + +Use cloud fraction to determine whether to do growth of ice clouds below +RHice of 1 down to RHice = rhmini. +Default: .true. for CAM6; all others => .false. + + + +Convective momentum transport parameter (upward) +Default: set by build-namelist + + + +Convective momentum transport parameter (downward) +Default: set by build-namelist + + + + +Autoconversion coefficient over land in ZM deep convection scheme. +Default: set by build-namelist + + + +Autoconversion coefficient over ocean in ZM deep convection scheme. +Default: set by build-namelist + + + +Tunable evaporation efficiency for land in ZM deep convection scheme. +Default: set by build-namelist + + + +Tunable evaporation efficiency in ZM deep convection scheme. +Default: set by build-namelist + + + +Include organization parameterization in ZM. This value is set to true automatically +if -zmconv_org is set in configure. +Default: .false., unless -zmconv_org set in configure + + + +Turn on convective microphysics +Default: .false. + + + +The number of negative buoyancy regions that are allowed before the convection top and CAPE calculations are completed. +Default: => 1 for CAM6; + => 5 for all other + + + + + + +Factor applied to the ice fall velocity computed from +Stokes terminal velocity. +Default: set by build-namelist + + + + + +Type of water vapor saturation vapor pressure scheme employed. 'GoffGratch' for +Goff and Gratch (1946); 'MurphyKoop' for Murphy & Koop (2005) +Default: GoffGratch; except MurphyKoop for carma=cirrus or carma=cirrus_dust + + + + + +Control use of sub-columns within macro/micro physics; +'false' for no subcolumns. +Default: 'false' + + + +Type of sub-column generator scheme employed. + 'SIHLS' Sub-columns generated with Latin Hypercube sampling of the CLUBB PDF; + 'CloudObj' Create sub-columns where most water is assigned to cloud sub-columns; + 'tstcp' testing; + 'vamp' Variation Across Microphysics Profiles simple deterministic scheme; + 'off' None +Default: 'off' + + + +Turns off averaging and assigns first subcolumn back to grid. Needed for BFB comparisons +'true' for no averaging. +Default: '.false.' + + + +Turns on/off filtering during averaing in tstcp +'true' to use filtering. +Default: '.false.' + + + +Turns on/off use of weights during averaging in tstcp +'true' to use weights. +Default: '.false.' + + + +Perturbs the temperatures in state after copying for testing purposes +'true' to perturb temperatures. +Default: '.false.' + + + +Tests the restart capabilities of weights with a more adequate test +'true' to set the weights to a slightly more complicated pattern for restart testing +Default: '.false.' + + + +Turns on/off use of weights during averaging in tstcp +'true' to use weights. +Default: '.true.' + + + +Number of subcolumns/samples to use in this simulation. Must be less than psubcols. +Default: 4 + + + + + +Type of condensate to assume in VAMP Generator +1 Uniform Condensate +2 Variable Condensate Uniform Number +3 Variable Condensate Variable Number +Default: 3 + + + +Type of overlap to assume in VAMP Generator 1 Maximum +Default: 1 + + + +Number of subcolumns in VAMP Generator +Default: 10 + + + + + + + +Type of deep convection scheme employed. 'ZM' for Zhang-McFarlane; +'off' for none; or 'UNICON' which doesn't distinquish shallow and deep. +Default: 'ZM' unless using 'UNICON', 'SPCAM' or 'pbl=none' + + + +Type of microphysics scheme employed. 'RK' for Rasch and Kristjansson +(1998); 'MG' for Morrison and Gettelman (2008), Gettelman et al (2010) +two moment scheme for CAM5 and CAM6 +SPCAM has two different microphysics schemes: SPCAM_m2005 (Morrison et al 2005), +SPCAM_sam1mom (Khairoutinov 2003) +Default: set by build-namelist (depends on value set in configure). + + + +Type of macrophysics scheme employed. 'park' for Park +(1998); 'RK' for Rasch and Kristjansson (1998); 'CLUBB_SGS' clubb. +Default: set by build-namelist + + + +Switch for CLUBB_SGS +Default: set by build-namelist + + + +Type of shallow convection scheme employed. + 'Hack' for Hack shallow convection; + 'UW' for original McCaa UW pbl scheme, modified by Sungsu Park; + 'CLUBB_SGS' for CLUBB_SGS + 'UNICON' which doesn't distinquish shallow and deep. + 'SPCAM_m2005' for SPCAM double moment + 'SPCAM_sam1mom' for SPCAM single moment +Default: set by build-namelist (depends on {{ hilight }}eddy_scheme{{ closehilight }}). + + + +Logical switch to turn on the beljaars scheme +Default: set by build-namelist + + + +Logical switch to turn on turbulent mountain stress calculation in +vertical diffusion routine. +Default: set by build-namelist + + + +Turbulent mountain stress parameter used when turbulent mountain stress calculation +is turned on. See {{ hilight }}do_tms{{ closehilight }}. +Default: 1.0 for CAM, set by build-namelist for WACCM, T31 + + + +Factor determining z_0 from orographic standard deviation [ no unit ] +Used when turbulent mountain stress calc is turned on. See {{ hilight }}do_tms{{ closehilight }}. +Default: set by build-namelist for WACCM, T31 + + + +Maximum master length scale designed to address issues in diag_TKE outside the +boundary layer. +In order not to disturb turbulence characteristics in the lower troposphere, +this should be set at least larger than a few km. However, this does not +significantly improve the values outside of the boundary layer. Smaller values +make some improvement, but it is also noisy. Better results are seen using +eddy_leng_max or kv_freetrop_scale. +Default: 40.e3 (m) + + + +Maximum dissipation length scale designed to address issues with diag_TKE outside +the boundary layer, where the default value generates large diffusivities. A value +of 30 m is consistent with the length scales used in the HB scheme; however, this +will also reduce value in the boundary layer. +Default: 40.e3 (m) + + + +Bottom pressure level at which namelist values for eddy_leng_max and +eddy_lbulk_max are applied. Default values are used at lower levels (i.e. the +boundary layer). +Default: 100.e3 (hPa) + + + +Moist entrainment enhancement parameter. +Default: set by build-namelist + + + +Pressure (Pa) that defined the upper atmosphere for adjustment of +eddy diffusivities from diag_TKE using kv_top_scale. +Default: 0. + + + +Scaling factor that is applied (multiplied) to the eddy diffusivities +in the upper atmosphere (see kv_top_pressure). +Default: 1.0 + + + +Scaling factor that is applied (multiplied) to the eddy diffusivities +in the free troposphere (boundary layer to kv_top_pressure) +Default: 1.0 + + + +Perform mass conservation check on eddy diffusion operation. +Default: FALSE + + + +Logical switch to turn on implicit turbulent surface stress calculation in +diffusion solver routine. +Default: set by build-namelist + + + +Produce output for the offline unicon driver. +Default: .false. + + + +History file number for offline unicon driver output. +Default: 2 (i.e., h1 history file) + + + +Apply cloud top radiative cooling parameterization +Default: .false. + + + +Include effects of precip evaporation on turbulent moments +Default: .false. + + + +Explicit diffusion on temperature and moisture when CLUBB is on +Default: .false. + + + +CLUBB do explicit diffusion with a stability correction +Default: .false. + + + + +CLUBB timestep. +Default: set by build-namelist + + + +Rain evaporation efficiency factor. +Default: set by build-namelist + + + +Switch for CLUBB_ADV +Default: FALSE + + + + +Low Skewness in C11 Skw. Function +Default: 0.7D0 + + + +High Skewness in C11 Skw. Function +Default: 0.35D0 + + + +Constant for u'^2 and v'^2 terms +Default: 2.2D0 + + + +Coef. applied to log(avg dz/thresh) +Default: 1.0D0 + + + +Low Skw.: gamma coef. Skw. Fnct. +Default: 0.308 + + + +Momentum coefficient of Kh_zm +Default: 0.5 + + + +Thermo of Kh_zm +Default: 0.3 + + + +Plume widths for theta_l and rt +Default: 2.4 + + + +C2 coef. for the rtp2_dp1 term +Default: 1.0 + + + +C2 coef. for the thlp2_dp1 term +Default: 1.0 + + + +C2 coef. for the rtpthlp_dp1 term +Default: 1.3 + + + +Coef. #1 in C8 Skewness Equation +Default: 4.2 + + + +Low Skewness in C7 Skw. Function +Default: 0.5 + + + +High Skewness in C7 Skw. Function +Default: 0.5 + + + +Factor to decrease sensitivity in the denominator of Skw calculation +Default: 0.0 + + + +Intensity of stability correction applied to C1 and C6 +Default: 0.04 + + + +Uses PDF to compute perturbed values for l_avg_Lscale code +Default: .false. + + + +Include the effects of ice latent heating in turbulence terms +Default: .false. + + + +Apply liquid supersaturation adjustment code +Default: false + + + + + +The name of the active CARMA microphysics model or none when CARMA +is not active. +Default: none + + + +A fraction that scales how tight the convergence criteria are to +determine that the substepping has resulted in a valid solution. +Smaller values will force more substepping. +CARMA particles. +Default: 0.1 + + + +When non-zero, the largest change in temperature (K) +allowed per substep. +Default: 0. + + + +Flag indicating that the CARMA model is an aerosol model, and +should be called in tphysac. +Default: TRUE + + + +Flag indicating that CARMA is a cloud ice model and should +be called in tphysbc. +Default: FALSE + + + +Flag indicating that CARMA is a cloud liquid model and should +be called in tphysbc. +Default: FALSE + + + +Flag indicating that CARMA should do clear sky calculations for +particles that are not part of a cloud in addition to doing a +separate calculation for incloud particles. Only valid when +carma_do_incloud is true. +Default: FALSE + + + +Flag indicating whether the coagulation process is enabled for +CARMA particles. +Default: FALSE + + + +Flag indicating that CARMA is responsible for detrain condensate +from convection into the model. +Default: FALSE + + + +Flag indicating that the dry deposition process is enabled for +CARMA particles. +Default: FALSE + + + +Flag indicating that the emission of particles is enabled for +CARMA. +Default: FALSE + + + +Flag indicating that sedimentation should be calculated using an +explicit technique where the substepping is used to keep the CFL +condition from being violated rather than the default PPM scheme. +Default: FALSE + + + +Flag indicating CARMA coefficients should only be initialized once from +a fixed temperature profile rather than recomputed for each column. This +improves performance, but reduces accuracy. By default the temperature +profile used is calculated as the average of the initial condition file, +but a predefined profile can be provided. +Default: FALSE + + + +Flag indicating used in cunjunction with carma_do_fixedinit to indicate +that only the coagulation coefficients should only be initialized from +a fixed temperature profile and all other coeeficients will be recalculated. +Coagulation is the slowest initialization, so this improves performance while +still retaining accuracy for most processes. +Default: FALSE + + + +Flag indicating that the condensational growth process is enabled for +CARMA particles. +Default: FALSE + + + +Flag indicating that CARMA sulfate mass mixing ratio will be used +in radiation calculation. +Default: FALSE + + + +Flag indicating that CARMA sulfate surface area density will be used +in heterogeneous chemistry rate calculation. +Default: FALSE + + + +Flag indicating that CARMA should treat cloud particles as incloud +rather than gridbox average calculations. +Default: FALSE + + + +Flag indicating that carma should generate optical properties files +for the CAM radiation code. +Default: FALSE + + + +Flag indicating that particle heating will be used for the condensational +growth process. +Default: FALSE + + + +Flag indicating that particle heating will affect the atmospheric +temperature. +Default: FALSE + + + +Flag indicating that substepping will be used for the condensational +growth process. +Default: FALSE + + + +Flag indicating that changes in heating will be calculated as a result +CARMA processes and will affect the CAM heating tendency. +Default: FALSE + + + +Flag indicating that the wet deposition process is enabled for +CARMA particles. +Default: FALSE + + + +Flag indicating that the effect of Brownian diffusion will be calculated for +CARMA particles. NOTE: This needs to be used in conjunction with CARMA +sedimentation. +Default: FALSE + + + +Flag indicating that the sedimentation process is enabled for +CARMA particles. +Default: FALSE + + + +Flag indicating whether CARMA is enabled. If CARMA has been included +in the build (configure -carma with something other than none), then +this will cause all of the CARMA constituents and field names to be +registered, but no other CARMA process will be preformed. This overrides +the individual CARMA process flags. +Default: FALSE + + + +Specifies the maximum number of retry attempts to be used when +condensational growth requires substepping, but the original estimate +for the amount of substepping was insufficient. +Default: 8 + + + +Specifies the maximum number of substeps that could be used for the +first guess when condensational growth requires substepping. +Default: 1 + + + +Specifies the name of the reference temperature file that will be +used (and created if necessary) for initialization of CARMA to a +fixed temperature profile. +Default: carma_reft.nc + + + +Accommodation coefficient for coagulation. +Default: 1.0 + + + +Accommodation coefficient for growth with ice. +Default: 0.93 + + + +Accommodation coefficient for growth with liquid. +Default: 1.0 + + + +Accommodation coefficient for temperature. +Default: 1.0 + + + +Critical relative humidity for liquid cloud formation, used +for sub-grid scale in-cloud saturation. +Default: 1.0 + + + + + +Global mass of dust emission for the event. +Default: 0. (kg) + + + +Global mass of dust emission for the event. +Default: 0. (kg) + + + +Starting date for emissions in the form of (yyyyddd) where yyyy is a year and +ddd is a day of year. +Default: 1 (yyyyddd) + + + +Starting time for the emission event in GMT. +Default: 0. (s Z) + + + +Stopping date for emissions in the form of (yyyyddd) where yyyy is a year and +ddd is a day of year. +Default: 1 (yyyyddd) + + + +Stoping time for the emission event in GMT. +Default: 0. (s) + + + +Minimum latitude of the area for emssions from the event. +Default: -90. (degrees north) + + + +Maximum latitude of the area for emssions from the event. +Default: 90. (degrees north) + + + +Minimum longitude of the area for emssions from the event. +Default: 0. (degrees east) + + + +Maximum longitude of the area for emssions from the event. +Default: 360. (degrees east) + + + +Are the soot particles treated as fractals? +Default: FALSE + + + + + +Flag indicating that meteor smoke emission will be scaled by a +global relative flux based upon the carma_escale_file. +Default: FALSE + + + +The total meteor smoke emission rate in kt/year. The flux will be +scaled to total that value. +Default: 16.0 + + + +Specifies the name of the file containing the meteor smoke emission +(ablation) profile. +Default: set by build-namelist. + + + +Specifies the name of the file containing the global realtive flux +specification. +Default: set by build-namelist. + + + +Specifies the day of year when tracers will start being emitted for the tracer test. +Default: 1 + + + +The emission rate of inert tracers used in the test. A positive value indicates that +the rate is a column mass (kg/m2/s) and a negative value indicate that it is a mass +mixing ratio (kg/kg/s). +Default: 1e-9 + + + +Flag indicating that h2so4 vapor pressures should be calculated as if they were +over sulfates that have been totally neutralized. +Default: FALSE + + + + + + +Specifies the method to use to get the prescribed sulfate aerosols for use with nucleation +of cirrus clouds. This can be different than the sulfate aerosols that are used with the +climate. +Default: fixed + + + + + +Specifies the name of the file containing ice refrative indicies as a function of wavelength +used for the particle heating calculation. +Default: set by build-namelist. + + + + + +Specifies the name of the file containing soil erosion factors. This is used by +the dust model. +Default: set by build-namelist. + + + + + + +Flag indicating that a calculated Weibull K should be used. +Default: FALSE + + + +Specifies the name of the sea salt emission parameterization. +Default: Gong + + + +======= + + + +Full pathname of time-variant ozone mixing ratio boundary dataset. +Default: set by build-namelist. + + + +Add CAM3 prescribed ozone to the physics buffer. +Default: FALSE + + + +Flag for yearly cycling of ozone data. If set to FALSE, a multi-year +dataset is assumed, otherwise a single-year dataset is assumed, and ozone +will be cycled over the 12 monthly averages in the file. +Default: TRUE + + + + + +String identifying a hardware counter to the papi library. +Default: PAPI_TOT_CYC + + + +String identifying a hardware counter to the papi library. +Default: PAPI_FP_OPS + + + +String identifying a hardware counter to the papi library. +Default: PAPI_FP_INS + + + +String identifying a hardware counter to the papi library. +Default: PAPI_NO_CTR + + + +Flag indicating whether the mpi_barrier in t_barrierf should be called. +Default: FALSE + + + +Maximum number of levels of timer nesting . +Default: 99999 + + + +Maximum detail level to profile. +Default: 1 + + + +Flag indicating whether timers are disabled. +Default: FALSE + + + +Collect and print out global performance statistics (for this component communicator). +Default: FALSE + + + +Maximum number of processes writing out timing data (for this component communicator). +Default: -1 + + + +Separation between process ids for processes that are writing out timing data +(for this component communicator). +Default: 1 + + + +Flag indicating whether the PAPI namelist should be read and HW performance counters +used in profiling. +Default: FALSE + + + +Flag indicating whether the performance timer output should be written to a +single file (per component communicator) or to a separate file for each +process. +Default: TRUE + + + +Initialization of GPTL timing library. +Default: GPTLmpiwtime + + + +Swap communication protocol option (reduced set): + 3, 5: nonblocking send + 2, 3, 4, 5: nonblocking receive + 4, 5: ready send +Default: 4 + + + +Swap communication maximum request count: + <=0: do not limit number of outstanding send/receive requests + >0: do not allow more than swap_comm_maxreq outstanding + nonblocking send requests or nonblocking receive requests +Default: 128 + + + +fc_gather flow control option: + < 0 : use MPI_Gather + >= 0: use point-to-point with handshaking messages and preposting + receive requests up to + max(min(1,fc_gather_flow_cntl),max_gather_block_size) + ahead. Default value is defined by private parameter + max_gather_block_size, which is currently set to 64. +Default: 64 + + + + + +Allocate all buffers as global. This is a performance optimization on +machines for which allocation/deallocation of physpkg scope buffers on +every timestep was slow (Cray-X1). +Default: TRUE + + + + + +Name of the CAM physics package. N.B. this variable may not be set by +the user. It is set by build-namelist via information in the configure +cache file to be consistent with how CAM was built. +Default: set by build-namelist + + + +Flag for simple physics package. N.B. this variable may not be set by +the user. It is set by build-namelist via information in the configure +cache file to be consistent with how CAM was built. +Default: set by build-namelist + + + +Name of the CAM chemistry package. N.B. this variable may not be set by +the user. It is set by build-namelist via information in the configure +cache file to be consistent with how CAM was built. +Default: set by build-namelist + + + +Runtime options of upper thermosphere WACCM-X. 'ionosphere' for +full ionosphere and neutral thermosphere, 'neutral' for just +neutral thermosphere, and off for no WACCM-X. +Default: 'off' + + + +Limiter for ambipolar diffusion coefficient used in O+ transport in the +ionosphere. +Default: 1.5e+8 + + + +Shapiro constant for spatial smoother used in O+ transport in the +ionosphere. +Default: 0.03 + + + +Switch to apply floor to O+ concentrations within in ionosphere O+ transport. +Default: TRUE + + + +Switch to to turn on/off O+ transport in ionosphere. +Default: set by build-namelist + + + +Number of ion transport steps per physics timestep. +Default: 5 + + + +Switch to invoke electro-dynamo to compute ion drift velocities used in +O+ transport in ionosphere. If false, ExB empirical model is used to +provide the ion drift velocities for O+ transport. +Default: set by build-namelist + + + +Electric potential model used in the waccmx ionosphere. +Default: set by build-namelist + + +Full pathname of dataset for coefficient data used in Weimer05 +high latitude electric potential model. +Default: set by build-namelist. + + + + + +Troposphere cloud physics will be done only below the top defined +by this pressure (Pa). +Default: set by build-namelist + + + +MAM affects climate only below the top defined by this pressure (Pa). +Default: 0 for non-MAM cases, otherwise set by build-namelist + + + +Molecular diffusion will be done only if the lowest pressure is +below this limit (Pa). +Default: 0.1 + + + +The level closest to this pressure (Pa) is the bottom of the region +where molecular diffusion is done. +Default: 50. + + + + + +Use this variable to specify the latitude (in degrees) of a column to +debug. The closest column in the physics grid will be used. +Default: none + + + +Use this variable to specify the longitude (in degrees) of a column to +debug. The closest column in the physics grid will be used. +Default: none + + + +If set to .true., turns on extra validation of physics_state objects +in physics_update. Used mainly to track down which package is the +source of invalid data in state. +Default: .false. + + + + + + +Switch to turn on adjustment of the surface fluxes to reduce instabilities +in the surface layer. Set to 1 to turn on the adjustments. +Default: 0 + + + +Type of eddy scheme employed by the vertical diffusion package. 'HB' for +Holtslag and Boville; 'diag_TKE' for diagnostic tke version of Grenier and +Bretherton; 'HBR' for Rasch modified version of 'HB'. +Default: set by build-namelist + + + + + +Switch to use new convective scavenging for modal aerosols. This scheme +replaces the call to ZM's convtran for the the modal aerosol number and +mass mixing ratio constituents. +Default: .false. + + + + + +Produce output for the AMWG diagnostic package. +Default: .true. + + + +Produce output for the AMWG variability diagnostics. +Default: .false. + + + +Switch for diagnostic output of the aerosol tendencies +Default: .false. + + + +Switch for diagnostic output of the aerosol optics +Default: .false. + + + +Switch for diagnostic output of eddy variables +Default: .false. + + + +Switch for cam4 T/Q budget diagnostic output +Default: .false. + + + +History tape number T/Q budget output is written to. +Default: 1 + + + +Switch for diagnostic output used primarily for WACCM runs. +Default: .true. if WACCM physics is on, .false. otherwise. + + + +Switch for diagnostic output used primarily for WACCM-X runs. +Default: .true. if WACCM-X is on, .false. otherwise. + + + +Switch for diagnostics specific to the current chemistry package or +configuration. +Default: .true. + + + +Switch for diagnostics specific to the current CARMA model. +Default: .true. + + + +Switch for diagnostics specific to CLUBB. +Default: .true. + + + +Switch to turn on/off default output specific to CESM forcings. +Default: .false. + + + +Switch to turn on/off default output specific to WACCM-SC forcings. +Default: .false. + + + +Switch to turn on/off default output chemical species mixing ratios in the surface layer. +Default: .false. + + + +True when model is configured to use an offline driver. +Default: Set by build-namelist. + + + + +Type of radiation scheme employed. +Default: set by build-namelist + + + +Convective water used in radiation? +0 ==> No +1 ==> Yes - Arithmetic average. +2 ==> Yes - Average in emissivity. +Default: set by build-namelist + + + +Lower limit of cumulus cloud fraction. +Default: set by build-namelist + + + +Full pathname of absorption/emission dataset. Used only by camrt scheme. +It consists of terms used for determining the absorptivity and +emissivity of water vapor in the longwave parameterization of radiation. +Default: set by build-namelist. + + + +Frequency of absorptivity/emissivity calculations in time steps (if +positive) or model hours (if negative). To avoid having the abs/ems values +saved on the restart output, make sure that the interval of the abs/ems +calculation evenly divides the restart interval. +Default: -12 + + + +Frequency of long-wave radiation calculation in timesteps (if positive) or +model hours (if negative). +Default: -1 + + + +Frequency of short-wave radiation calculation in timesteps (if positive) or +model hours (if negative). +Default: -1 + + + +Specifies length of time in timesteps (positive) or hours (negative) SW/LW +radiation will be run for every timestep from the start of an initial run. +Default: 0 + + + +Return fluxes per band in addition to the total fluxes. +Default: FALSE + + + +If true, then average the zenith angle over the radiation timestep rather +than using instantaneous values. +Default: FALSE + + + +Definitions for the aerosol modes that may be used in the rad_climate and +rad_diag_* variables. +Default: set by build-namelist + + + +A list of the radiatively active species, i.e., species that affect the +climate simulation via the radiative heating rate calculation. +Default: set by build-namelist + + + +A list of species to be used in the first diagnostic radiative heating rate +calculation. These species are not the ones affecting the climate +simulation. This is a hook for performing radiative forcing calculations. +Default: none + + + +Analogous to rad_diag_1, but for the 2nd diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 3rd diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 4th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 5th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 6th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 7th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 8th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 9th diagnostic calculation. +Default: none + + + +Analogous to rad_diag_1, but for the 10th diagnostic calculation. +Default: none + + + + +output data needed for off-line radiation calculations +Default: FALSE + + + +History tape number radiation driver output data is written to. +Default: 0 + + + +Averaging flag for radiation driver output data. +Default: 'A' + + + +Switch to turn on Fixed Dynamical Heating in the offline radiation tool (PORT). +Default: false + + + + + +Full pathname of dataset for water refractive indices used in modal aerosol optics +Default: none + + + + +Dry deposition surface values interpolated to model grid, required for unstructured atmospheric grids +with modal chemistry. +Default: none + + + +filepath and name for ice optics data for rrtmg +Default: none + + + +filepath and name for ice optics data for rrtmg +Default: none + + + +filepath and name for ice optics data for rrtmg +Default: none + + + +filepath and name for ice optics data for rrtmg +Default: none + + + +filepath and name for liquid cloud (gamma distributed) optics data for rrtmg +Default: none + + + + + + +Variable to specify the vertical index at which the +Rayleigh friction term is centered (the peak value). +Default: 2 + + + +Rayleigh friction parameter to determine the width of the profile. If set +to 0 then a width is chosen by the algorithm (see rayleigh_friction.F90). +Default: 0. + + + +Rayleigh friction parameter to determine the approximate value of the decay +time (days) at model top. If 0.0 then no Rayleigh friction is applied. +Default: 0. + + + + + + +Full pathname of IOP dataset. +Default: set by build-namelist. + + + +Column bfb match with cam generated IOP. +Default: FALSE + + + +Column radiation mode. +Default: FALSE + + + +Use the specified surface properties. +Default: FALSE + + + +IOP name for CLUBB running in single column mode +Default: "" + + + +Use relaxation. +Default: FALSE + + + +List of fields that will be relaxed to obs +Default: none + + + +Use relaxation. Linearly interpolate the timescale within specified +pressure range. (bpm) +Default: FALSE + + + +Upper most pressure that will be relaxed. +Default: 1e36 + + + +Lower most pressure that will be relaxed. +Default: -1e36 + + + +SCAM relaxation time constant in seconds +Default: 10800 + + + +SCAM relaxation time constant in seconds that will be used at +top of pressure range (i.e., the smaller pressure value). Will +be used from top of pressure range to model top. +Default: 10800 + + + +SCAM relaxation time constant in seconds that will be used at +bottom of pressure range (i.e., the larger pressure value). +Default: 10800 + + + +Use the SCAM-IOP specified T instead of using forecasted T at each time step. +Default: FALSE + + + +Use the SCAM-IOP specified u,v instead of using forecasted u,v at each time step. +Default: TRUE + + + +Use specific type of vertical advection for T. Possible choices are 'iop', 'eulc' and 'off' +Default: 'eulc' + + + +Use specific type of vertical advection for uv. Possible choices are 'iop', 'eulc' and 'off' +Default: 'eulc' + + + +Use specific type of vertical advection for q. Possible choices are 'iop', 'eulc', 'slt' and 'off' +Default: 'slt' + + + +Use the SCAM-IOP specified surface LHFLX/SHFLX/ustar/Tg instead of using internally-computed values +Default: FALSE + + + +Use the SCAM-IOP specified observed water vapor at each time step instead of forecast value +Default: FALSE + + + +Force scam to use the lat lon fields specified in the scam namelist not what is closest to IOP avail lat lon +Default: FALSE + + + + + +Total solar irradiance (W/m2). +Default: 1361.27 + + + +Full pathname of dataset for file that contains the solar photon energy spectra or TSI data +as a time series +Default: set by build-namelist + + + +Full pathname of dataset for file that contains the solar EUV data +as a time series +Default: none + + + +Full pathname of time-variant dataset for the time-dependent proxies for +solar and geomagnetic activity( F10.7, F10.7a, Kp, Ap ). +Default: set by build-namelist. + + + +Full pathname of time-variant dataset for the time-dependent solar wind parameters +(solar wind velocity and density; IMF By and Bz components). +Default: set by build-namelist. + + + +Type of time interpolation for data in {{ hilight }}solar_irrad_data_file{{ closehilight }}. +Can be set to "FIXED" or "SERIAL". +Default: SERIAL + + + +If {{ hilight }}solar_data_type{{ closehilight }} is "FIXED" then solar_data_ymd +is the date the solar data is fixed to. If {{ hilight }}solar_data_type{{ closehilight }} +is "SERIAL" the solar_data_ymd is the start date of the time series +of solar data. +Format: YYYYMMDD +Default: none + + + +Seconds of the day corresponding to {{ hilight }}solar_data_ymd{{ closehilight }} +Default: current model time of day + + + +Use spectral scaling in the radiation heating +Default: set by build-namelist + + + + + +User can specify names for test tracers to be read from the initial file. +The number of names specified should be given as the value of the -nadv_tt +option to configure. +Default: '' + + + +This variable should not be set by the user. If configure has been invoked +with the '-nadv_tt N' option then build-namelist will set this variable to +the value N. If {{ hilight }}test_tracer_names{{ closehilight }} have been specified +then N should be the number of names supplied. +If {{ hilight }}test_tracer_names{{ closehilight }} have not been specified, then the +tracer_suite module generates the tracer names and supplies the initial +values. +Default: set by configure + + + +If true age of air tracers are included. This variable should not be set +by the user. It will be set by build-namelist to be consistent with the +'-age_of_air_trcs' argument specified to configure. +Default: set by configure + + + +If true age of air tracers are read from the initial conditions file. +If this is not specified then they are not read from IC file. +Default: TRUE + + + + + +The length (in seconds) of the atm time step, i.e., the driver calls the +atm component once every dtime seconds. This is also the coupling interval +between the dynamics and physics packages. This variable is not actually +used in the atm model, but rather is used by build-namelist to set the +value of {{ hilight }}atm_cpl_dt{{ closehilight }}. So it will have an effect only +when running CAM using standalone scripts. The CESM scripts have their own +method for setting {{ hilight }}atm_cpl_dt{{ closehilight }}. +Default: is resolution and dycore dependent and is set by build-namelist. + + + + + +Full pathname of time-invariant boundary dataset for topography fields. +Default: set by build-namelist. + + + +Setting use_topo_file=.false. allows the user to specify that PHIS, SGH, +SGH30, and LANDM_COSLAT are all zero without having to supply a topo file +full of zeros. +Default: set by build-namelist. + + + + + +Full pathname of boundary dataset for tropopause climatology. +Default: set by build-namelist. + + + + + +Flag to tell build-namelist to use time-dependent external forcing +files for the aircraft emissions. +Default: FALSE + + + +Flag to set rad_climate variable so that the chemical tracers are +radiatively passive. +Default: FALSE + + + +Wet deposition method used + MOZ --> mozart scheme is used + NEU --> J Neu's scheme is used + OFF --> wet deposition is turned off +Default: NEU except for SPCAM runs + + + +List of gas-phase species that undergo wet deposition via the wet deposition scheme. +Default: NONE + + + +Turns on accumulation to coarse mode exchange appropriate for the stratosphere. +This also changes the default mode definitions (widths and edges) via default +aerosol property input files. +Default: FALSE + + + +Turns on prognostic modal sulfate aerosols in the stratosphere. +Default: FALSE + + + +List of aerosol species that undergo wet deposition. +Default: set by build-namelist. + + + +In-cloud solubility factor used in SO4 wet removal +Default: set by build-namelist. + + +Below-cloud solubility factor used in SO4 wet removal +Default: set by build-namelist. + + +In-cloud solubility factor used in NH4 wet removal +Default: set by build-namelist. + + +Below-cloud solubility factor used in NH4 wet removal +Default: set by build-namelist. + + +In-cloud solubility factor used in NH4NO3 wet removal +Default: set by build-namelist. + + +Below-cloud solubility factor used in NH4NO3 wet removal +Default: set by build-namelist. + + +In-cloud solubility factor used in CB2 wet removal +Default: set by build-namelist. + + +Below-cloud solubility factor used in CB2 wet removal +Default: set by build-namelist. + + +In-cloud solubility factor used in OC2 wet removal +Default: set by build-namelist. + + +Below-cloud solubility factor used in OC2 wet removal +Default: set by build-namelist. + + +In-cloud solubility factor used in wet removal of BULK dust +Default: set by build-namelist. + + +Below-cloud solubility factor used in wet removal of BULK dust +Default: set by build-namelist. + + +In-cloud solubility factor used in wet removal of BULK sea salt +Default: set by build-namelist. + + +Below-cloud solubility factor used in wet removal of BULK sea salt +Default: set by build-namelist. + + + +List of aerosol species that undergo sediment (dry deposition). +Default: set by build-namelist. + + + +Tuning for below cloud scavenging of interstitial modal aerosols. +Default: set by build-namelist. + + + +Tuning for in-cloud scavenging of interstitial modal aerosols. +Default: set by build-namelist. + + + +Tuning for in-cloud scavenging of cloud-borne modal aerosols. +Default: set by build-namelist. + + + +Tuning for seasalt_emis +Default: set by build-namelist. + + + +In-cloud solubility factor used in BULK aerosol wet removal +Default: set by build-namelist. + + + +Below-cloud solubility factor used in BULK aerosol wet removal +Default: set by build-namelist. + + + +Scavenging coefficient used in BULK aerosol wet removal +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of SO4 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of NH4 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of CB2 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of OC2 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of DST01 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of DST02 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of DST03 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of DST04 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of SSLT01 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of SSLT02 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of SSLT03 +Default: set by build-namelist. + + + +Scavenging coefficient used in the wet removal of SSLT04 +Default: set by build-namelist. + + + +Full pathname of boundary dataset for airplane emissions. +Default: set by build-namelist. + + + +Full pathname of dataset containing soil moisture fraction information used in 'xactive_atm' +method of calculating dry deposition of chemical tracers. +Default: set by build-namelist. + + + +Full pathname of dataset which contains the prescribed deposition velocities used +in the 'table' method of calculating dry deposition of chemical tracers. +Default: set by build-namelist. + + + +Full pathname of dataset which contains land vegitation information used in 'xactive_atm' +method of calculating dry deposition of chemical tracers. +Default: set by build-namelist. + + + +Full pathname of dataset which contains season information used in 'xactive_atm' +method of calculating dry deposition of chemical tracers. +Default: set by build-namelist. + + + +Tuning parameter for dust emissions. +Default: set by build-namelist. + + + +Full pathname of dataset for coefficient data used in WACCM to calculate ion drag +for high solar fluxes from the Scherliess low latitude electric potential model. +Default: set by build-namelist. + + + +Full pathname of dataset for coefficient data used in WACCM to calculate ion drag +for low solar fluxes from the Scherliess low latitude electric potential model. +Default: set by build-namelist. + + + +Full pathname of dataset for coefficient data used in WACCM to calculate ion drag +from the Weimer96 high latitude electric potential model. +Default: set by build-namelist. + + + +Switch to turn on empirical ExB ion drift velocities model for use in ion drag +parameterizations. If this is false then it is assumed ion drift velocities are +supplied by an active ionosphere model. +Default: set by build-namelist. + + + +Full pathname of dataset for the neutral species absorption cross sections for EUV +photo reactions producing electrons. +Default: set by build-namelist. + + + +Type of time interpolation of emission datasets specified. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +by {{ hilight }}srf_emis_specifier{{ closehilight }}. +Default: 'CYCLICAL' + + + +The cycle year of the surface emissions data +if {{ hilight }}srf_emis_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the surface emissions are fixed +if {{ hilight }}srf_emis_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}srf_emis_fixed_ymd{{ closehilight }} +at which the surface emissions are fixed +if {{ hilight }}srf_emis_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of dataset for EUVAC solar EUV model (0.05-121nm). +Default: set by build-namelist. + + + +The cycle year of the external forcings (3D emissions) data +if {{ hilight }}ext_frc_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +Default: current model date +The date at which the external forcings are fixed +if {{ hilight }}ext_frc_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}ext_frc_fixed_ymd{{ closehilight }} +at which the external forcings are fixed +if {{ hilight }}ext_frc_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +List of full pathnames of elevated emission (or external chemical forcings) datasets. + +The chemistry package reads in elevated emission data from a set of netcdf files in +units of "molecules/cm3/s". Each tracer species emissions is read from its +own file as directed by the namelist variable {{ hilight }}ext_frc_specifier{{ closehilight }}. The +{{ hilight }}ext_frc_specifier{{ closehilight }} variable tells the model which species have elevated +emissions and the file path for the corresponding species. That is, the +{{ hilight }}ext_frc_specifier{{ closehilight }} variable is set something like: + + ext_frc_specifier = 'SO2 -> /path/vrt.emis.so2.nc', + 'SO4 -> /path/vrt.emis.so4.nc', etc... + +Each emission file can have more than one source. When the emission are +read in the sources are summed to give a total emission field for the +corresponding species. The emission can be read in as time series of data, +cycle over a given year, or be fixed to a given date. + +The vertical coordinate in these emissions files should be 'altitude' (km) so that the +vertical redistribution to the model layers is done using a mass conserving method. +If the vertical coordinate is altitude then data needs to be ordered from the +surface to the top (increasing altitude). + +Default: set by build-namelist. + + + +Type of time interpolation for fixed lower boundary data. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'CYCLICAL' + + + +The cycle year of the fixed lower boundary data +if {{ hilight }}flbc_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + +The date at which the fixed lower boundary data is fixed +if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'.. +Format: YYYYMMDD +Default: 0 + + +The time of day (seconds) corresponding to {{ hilight }}flbc_fixed_ymd{{ closehilight }} +at which the fixed lower boundary data is fixed +if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of dataset for fixed lower boundary conditions. +Default: set by build-namelist. + + + +List of species that are fixed at the lower boundary. +Default: set by build-namelist. + + + +Type of time interpolation for fixed lower boundary data. +Default: 'CYCLICAL' + + + +File name of dataset for NOy upper boundary conditions. +Default: set by build-namelist. + + + +Full pathname of the directory that contains the NOy upper boundary conditions files specified in +{{ hilight }}noy_ubc_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed NOy upper boundary conditions. +The filenames in this file are relative to the directory specified by {{ hilight }}noy_ubc_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Type of time interpolation for NOy upper boundary conditions. +Default: 'SERIAL' + + + +The cycle year of the NOy upper boundary data +if {{ hilight }}flbc_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the NOy upper boundary data is fixed +if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'.. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}noy_ubc_fixed_ymd{{ closehilight }} +at which the NOy upper boundary data is fixed +if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of dataset for chemical tracers constrained in the stratosphere +Default: set by build-namelist. + + + +List of species that are constrained in the stratosphere. +Default: set by build-namelist. + + + +Full pathname of dataset for land mask applied to the lighting NOx production +Default: set by build-namelist. + + + +Multiplication factor applied to the lighting NOx production +Default: 1.0. + + + +Multiplication factor applied to the upper boundary NO mass mixing ratio. +Default: 1.0 + + + +Full pathname of dataset for the neutral species absorption cross sections. +Default: set by build-namelist. + + + +Full pathname of dataset for fast-tuv photolysis cross sections +Default: set by build-namelist. + + + +Full pathname of dataset of O2 cross sections for fast-tuv photolysis +Default: set by build-namelist. + + + +Full pathname of dataset of O2 and 03 column densities above the model for look-up-table photolysis +Default: set by build-namelist. + + + +Full pathname of the aircraft input file list +Default: none + + + +Type of time interpolation for data in aircraft aerosol files. +Default: 'CYCLICAL_LIST' + + + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}gcr_ionization_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for ionization rates by galactic cosmic rays. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for ionization +rates by galactic cosmic rays. The filenames in this file are relative +to the directory specified by {{ hilight }}gcr_ionization_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Names of variables containing ionization rates (/cm3/sec) in the cosmic rays datasets. +Default: none + + + +Type of time interpolation for data in gcr_ionization files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed green house gas data +if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed green house gas data is fixed +if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}gcr_ionization_fixed_ymd{{ closehilight }} +at which the prescribed green house gas data is fixed +if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}prescribed_aero_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Switch used to indicate which type of aerosols are prescribed -- bulk or modal. +This is used to set the default {{ hilight }}prescribed_aero_specifier{{ closehilight }} and +{{ hilight }}aerodep_flx_specifier{{ closehilight }} namelist variables. +Default: set by build-namelist + + + +Filename of dataset for prescribed aerosols. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +aerosols. The filenames in this file are relative to the directory specified +by {{ hilight }}prescribed_aero_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed aerosol concentrations from local disk when no longer needed. +Default: FALSE + + + +A list of variable names of the concentration fields in the prescribed aerosol datasets +and corresponding names used in the physics buffer seperated by colons. For example: + + prescribed_aero_specifier = 'pbuf_name1:ncdf_fld_name1','pbuf_name2:ncdf_fld_name2', ... + +If there is no colon seperater then the specified name is used as both the pbuf_name and ncdf_fld_name, + +Default: none + + + +Type of time interpolation for data in prescribed_aero files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed aerosol data +if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed aerosol data is fixed +if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}prescribed_aero_fixed_ymd{{ closehilight }} +at which the prescribed aerosol data is fixed +if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}aerodep_flx_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for prescribed aerosols. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +aerosols. The filenames in this file are relative to the directory specified +by {{ hilight }}aerodep_flx_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed aerosol deposition fluxes from local disk when no longer needed. +Default: FALSE + + + +Names of variables containing aerosol data in the prescribed aerosol datasets. +Default: none + + + +Type of time interpolation for data in aerodep_flx files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed aerosol flux data +if {{ hilight }}aerodep_flx_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed aerosol flux data is fixed +if {{ hilight }}aerodep_flx_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}ssaerodep_flx_fixed_ymd{{ closehilight }} +at which the prescribed aerosol flux data is fixed +if {{ hilight }}saerodep_flx_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}prescribed_ghg_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for prescribed GHGs. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +GHGs. The filenames in this file are relative to the directory specified +by {{ hilight }}prescribed_ghg_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed green house gas concentrations from local disk when no longer needed. +Default: FALSE + + + +Names of variables containing GHG data in the prescribed GHG datasets. +Default: none + + + +Type of time interpolation for data in prescribed_ghg files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed green house gas data +if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed green house gas data is fixed +if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}prescribed_ghg_fixed_ymd{{ closehilight }} +at which the prescribed green house gas data is fixed +if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}prescribed_ozone_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for prescribed ozone. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +ozone. The filenames in this file are relative to the directory specified +by {{ hilight }}prescribed_ozone_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Name of variable containing ozone data in the prescribed ozone datasets. +Default: 'ozone' + + + +Remove the file containing prescribed ozone concentrations from local disk when no longer needed. +Default: FALSE + + + +Type of time interpolation for data in prescribed_ozone files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed ozone data +if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed ozone data is fixed +if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}prescribed_ozone_fixed_ymd{{ closehilight }} +at which the prescribed ozone data is fixed +if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}prescribed_volcaero_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for prescribed volcaero. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +volcanic aerosols. The filenames in this file are relative to the directory specified +by {{ hilight }}prescribed_volcaero_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Name of variable containing volcaero data in the prescribed volcaero datasets. +Default: 'MMRVOLC' + + + +Remove the file containing prescribed volcanic aerosol concentrations from local disk when no longer needed. +Default: FALSE + + + +Type of time interpolation for data in prescribed_volcaero files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed volcanic aerosol data +if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed volcanic aerosol data is fixed +if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}prescribed_volcaero_fixed_ymd{{ closehilight }} +at which the prescribed volcanic aerosol data is fixed +if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}prescribed_strataero_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for prescribed volcaero. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +stratospheric aerosols. The filenames in this file are relative to the directory specified +by {{ hilight }}prescribed_strataero_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Name of variable containing prescribed stratospheric aerosol specifiers +Default: set by the CAM program + + + +Remove the file containing prescribed volcanic aerosol concentrations from local disk when no longer needed. +Default: FALSE + + + +Type of time interpolation for data in prescribed_strataero files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the prescribed volcanic aerosol data +if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed volcanic aerosol data is fixed +if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}prescribed_strataero_fixed_ymd{{ closehilight }} +at which the prescribed volcanic aerosol data is fixed +if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Switch to turn on climate feed backs due to prescribed stratospheric aerosols via +the rad_climate namelist variable. +Default: false + + + +If true the prescribed stratospheric aerosols have three distribution modes. +Default: true for CAM6, otherwise false + + + +Indicates whether to use the unified chemistry tropopause method to set prescribed +stratospheric aerosols below the tropopause to zero. This has a maximum altitude +level corresponding to 300 hPa for latitudes poleward of 50 degrees. +Default: set by build-namelist + + + +Full pathname of dataset for radiative source function used in look up table photloysis +Default: set by build-namelist. + + + +Full pathname of dataset for the coefficients of the NOEM nitric oxide model used +to calculate its upper boundary concentration. +Default: set by build-namelist. + + + +Full pathname of boundary dataset for soil erodibility factors. +Default: set by build-namelist. + + + +List of full pathnames of surface emission datasets. + +The chemistry package reads in emission data from a set of netcdf files in +units of "molecules/cm2/s". Each tracer species emissions is read from its +own file as directed by the namelist variable {{ hilight }}srf_emis_specifier{{ closehilight }}. The +{{ hilight }}srf_emis_specifier{{ closehilight }} variable tells the model which species have emissions +and the file path for the corresponding species. That is, the +{{ hilight }}srf_emis_specifier{{ closehilight }} variable is set something like: + + srf_emis_specifier = 'CH4 -> /path/emis.ch4.nc', + 'CO -> /path/emis.co.nc', etc... + +Each emission file can have more than one source. When the emission are +read in the sources are summed to give a total emission field for the +corresponding species. The emission can be read in as time series of data, +cycle over a given year, or be fixed to a given date. + +Default: set by build-namelist. + + + + +Full pathname of dataset containing tropopheric sulfate aerosols +Default: set by build-namelist. + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}sulf_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for prescribed +sulfate. The filenames in this file are relative to the directory specified +by {{ hilight }}sulf_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Name of variable containing sulfate data in the prescribed sulfate datasets. +Default: 'SULFATE' + + + +Remove the file containing prescribed sulfate concentrations from local disk when no longer needed. +Default: FALSE + + + +Type of time interpolation for data in prescribed sulfate files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'CYCLICAL' + + + +The cycle year of the prescribed sulfate data +if {{ hilight }}sulf_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed sulfate data is fixed +if {{ hilight }}sulf_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}sulf_fixed_ymd{{ closehilight }} +at which the prescribed sulfate data is fixed +if {{ hilight }}sulf_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + + + + + + +Full pathname of dataset for TGCM upper boundary +Default: set by build-namelist. + + +Type of time interpolation for data in TGCM upper boundary file. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +The cycle year of the TGCM upper boundary data +if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the TGCM upper boundary data is fixed +if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. +Format: YYYY +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}tgcm_ubc_fixed_ymd{{ closehilight }} +at which the TGCM upper boundary data is fixed +if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Perturbation applied to the upper boundary temperature. +Default: 0.0 + + + +Frequency in time steps at which the chemical equations are solved. +Default: 1 + + + +Filename of dataset for linoz cholirine loading. +Default: none. + + +Type of time interpolation type for data in {{ hilight }}chlorine_loading_file{{ closehilight }} +Default: 'SERIAL' + + +The time of day (seconds) corresponding to {{ hilight }}chlorine_loading_fixed_ymd{{ closehilight }} +at which the chlorine loading data is fixed +if {{ hilight }}chlorine_loading_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + +The date at which the chlorine loading data is fixed +if {{ hilight }}chlorine_loading_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}linoz_data_filelist{{ closehilight }}. +Default: none. + + + +Filename of dataset for LINOZ data. +Default: none. + + + +Filename of file that contains a sequence of filenames of the linoz data. +The filenames in this file are relative to the directory specified +by {{ hilight }}linoz_data_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Type of time interpolation for data in linoz_data files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'SERIAL' + + + +Remove the file containing LINOZ data from local disk when no longer needed. +Default: FALSE + + + +The cycle year of the LINOZ data +if {{ hilight }}linoz_data_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the LINOZ data is fixed +if {{ hilight }}linoz_data_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}linoz_data_fixed_ymd{{ closehilight }} +at which the LINOZ data is fixed +if {{ hilight }}linoz_data_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}tracer_cnst_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for the prescribed chemical constituents. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of filenames for the prescribed chemical constituents. +The filenames in this file are relative to the directory specified +by {{ hilight }}tracer_cnst_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed chemical constituents from local disk when no longer needed. +Default: FALSE + + + +List of prescribed chemical constituents. +Default: set by build-namelist. + + + +Type of time interpolation for data in tracer_cnst files. +Default: 'SERIAL' + + + +The cycle year of the prescribed chemical constituents data +if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the chemical constituents data is fixed +if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}tracer_cnst_fixed_ymd{{ closehilight }} +at which the chemical constituents data is fixed +if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}tracer_srcs_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +Filename of dataset for the prescribed chemical sources. +Default: set by build-namelist. + + + +Filename of file that contains a sequence of datasets for the prescribed chemical sources. +The filenames in this file are relative to the directory specified +by {{ hilight }}tracer_srcs_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed chemical sources from local disk when no longer needed. +Default: FALSE + + + +List of prescribed chemical sources +Default: set by build-namelist. + + + +Type of time interpolation for data in tracer_srcs files. +Default: 'SERIAL' + + + +The cycle year of the prescribed chemical sources data +if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the chemical sources data is fixed +if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}tracer_srcs_fixed_ymd{{ closehilight }} +at which the chemical sources data is fixed +if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +If TRUE then use the FTUV method to calculate the photolysis reactions rates, +otherwise use the look up table method. +Default: FALSE + + + +Full pathname of dataset for Chebyshev polynomial Coeff data used for photolysis +cross sections. +Default: set by build-namelist. + + + +Full pathname of cross section dataset for long wavelengh photolysis +Default: set by build-namelist. + + + +Full pathname of cross section dataset for short wavelengh photolysis +Default: set by build-namelist. + + + + + +List of species that undergo dry deposition. +Default: set by build-namelist. + + + +Dry deposition method used. This specifies the method used to calculate dry +deposition velocities of gas-phase chemical species. The available methods +are: + 'table' - prescribed method in CAM + 'xactive_atm' - interactive method in CAM + 'xactive_lnd' - interactive method in CLM +Default: set by build-namelist + + + + +Give the user the ability to specify rate families (or groupings) diagnostics based +on reaction tag names. These group names can be added to history fincl variables. +A "+" character at the end of a string indicates that the summation will continue with the next string. +Example: + rate_sums = + 'OX_P = NO_HO2 + CH3O2_NO + 2*jo2_b ... ', + 'OX_L = NO2_O_M + HO2_O3 + CLO_O ...', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 +', + 'CH3CO3_CH3CO3 + CH3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 ...', + fincl1 = 'OX_P','OX_L', 'RO2_RO2_sum', ... +Default: none + + + +Give the user the ability to specify species families (or groupings) diagnostics in volume mixing ratio. +These group names can be added to history fincl variables. The units are mole/mole. +A "+" character at the end of a string indicates that the summation will continue with the next string. +Example: + vmr_sums = + 'SOAG = SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4', + 'NOy = N + NO + NO2 + NO3 + 2*N2O5 + HNO3 + HO2NO2 + CLONO2 +', + 'BRONO2 + PAN + MPAN + ISOPNO3 + ONITR +', + 'HONITR + ALKNIT + ISOPNITA + ISOPNITB + ISOPNOOH + NC4CH2OH +', + 'NC4CHO + NOA + NTERPOOH + PBZNIT + TERPNIT' + fincl1 = 'NOy','SOAG', ... +Default: none + + + +Give the user the ability to specify species families (or groupings) diagnostics in mass mixing ratio. +These group names can be added to history fincl variables. The units are kg/kg. +A "+" character at the end of a string indicates that the summation will continue with the next string. +Example: + mmr_sums = + 'soa_a1 = soa1_a1 + soa2_a1 + soa3_a1 + soa4_a1 + soa5_a1', + 'soa_a2 = soa1_a2 + soa2_a2 + soa3_a2 + soa4_a2 + soa5_a2' + fincl1 = 'soa_a1','soa_a2', ... +Default: none + + + +Indicates whether to use the unified chemistry tropopause method to set the +tropopause used in gas phase and aerosol chemical processes. This has a maximum altitude +level corresponding to 300 hPa for latitudes poleward of 50 degrees. +Default: set by build-namelist + + + +File containing fire emissions factors. +Default: none + + + +Fire emissions specifier. +Default: none + + + +If true fire emissions are input into atmosphere as elevated forcings. +Otherwise they are treated as surface emissions. +Default: TRUE + + + +List of nitrogen deposition fluxes to be sent from CAM to surface models. +Default: set by build-namelist. + + + +File containing MEGAN emissions factors. +Default: set by build-namelist. + + + +MEGAN specifier. +Default: set by build-namelist. + + + +MEGAN mapped isoprene emissions facters switch +If true then use mapped MEGAN emissions facters for isoprene. +Default: .false. + + + +List of fluxes needed by the CARMA model, from CLM to CAM. +Default: set by build-namelist. + + + + + +Filename of the prescribed waccm forcing data used with waccm_sc chemistry. +This contains prescribed constituents for non-LTE calculations and heating rates +for wavelengths less than 200 nm. +Default: set by build-namelist. + + + +Full pathname of the directory that contains the files specified in +{{ hilight }}waccm_forcing_filelist{{ closehilight }}. +Default: set by build-namelist. + + + +A file that contains a sequence of filenames for prescribed waccm forcing data. +The filenames in this file are relative to the directory specified +by {{ hilight }}waccm_forcing_datapath{{ closehilight }}. +Default: set by build-namelist. + + + +Remove the file containing prescribed waccm forcing data from local disk when no longer needed. +Default: FALSE + + + +Names of variables containing concentrations and heating rate in the prescribed waccm forcing datasets. +Default: none + + + +Type of time interpolation for data in waccm_forcing files. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: 'CYCLICAL' + + + +The cycle year of the prescribed waccm forcing data +if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the prescribed waccm forcing data is fixed +if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}waccm_forcing_fixed_ymd{{ closehilight }} +at which the prescribed waccm forcing data is fixed +if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + + +Full pathname of time-variant boundary dataset for H2O production/loss rates. +Default: set by build-namelist. + + + + + +Determines which constituents are used from non-LTE calculations. +TRUE implies use prognostic constituents. +FALSE implies use constituents from dataset specified by {{ hilight }}waccm_forcing_file{{ closehilight }}. +Default: TRUE for full chemistry WACCM; FALSE for WACCM_SC. + + + +If TRUE apply upper limit to CO2 concentrations passed to the Formichev non-LTE cooling calculation +(code not intended for values greater than 720 ppmv). Running with flag set to TRUE could lead to +incorrect cooling rates if model CO2 exceeds 720 ppmv. If FALSE simulation will abort if CO2 levels +exceed this value at altitudes above 1 mbar. The 720 ppmv CO2 limiter in the Formichev non-LTE cooling +scheme is applied to all vertical levels regardless of this setting. +Default: FALSE + + + +TRUE implies assume cyclic qbo data. +Default: FALSE + + + +Filepath for qbo forcing dataset. +Default: Set by build-namelist. + + + +TRUE implies qbo package is active. +Default: FALSE + + + +If set this year is used for setting geomagnetic coordinates through out the +simulation. If not set the model simulation year is used. +Default: none + + + +International Geomagnetic Reference Field (IGRF) coefficients. +Default: None. + + + +Filepath input dataset for ionization due to energetic particle precipitation. +Default: None. + + +Variable name in netCDF file {{ hilight }}epp_all_filepath{{ closehilight }} which contains +ion pairs production rates. +Default: None. + + + +Filepath input dataset for ionization due to solar proton events. +Default: None. + + +Variable name in netCDF file {{ hilight }}epp_spe_filepath{{ closehilight }} which contains +ion pairs production rates. +Default: None. + + + +Filepath input dataset for ionization due to medium energy electrons. +Default: None. + + +Variable name in netCDF file {{ hilight }}epp_mee_filepath{{ closehilight }} which contains +ion pairs production rates. +Default: None. + + + +Filepath input dataset for ionization due to galactic cosmic rays. +Default: None. + + +Variable name in netCDF file {{ hilight }}epp_gcr_filepath{{ closehilight }} which contains +ion pairs production rates. +Default: None. + + + + + +Number of water tracers active in condensate-loading terms in dynamical core +1: water vapor only +2: water vapor and cloud liquid +3: water vapor, cloud liquid and cloud ice +4: water vapor, cloud liquid, cloud ice and rain +5: water vapor, cloud liquid, cloud ice, rain and snow +6: water vapor, cloud liquid, cloud ice, rain, snow and graupel +Default: 3 for CAM4, CAM5; 5 for CAM6; 1 for Held_Suarez, Adiabatic and Kessler + + + +Set for refined exodus meshes (variable viscosity). +Viscosity in namelist specified for regions with a resolution equivilant +to a uniform grid with se_ne = se_fine_ne. +Default: -1 (not used) + + + +CAM physics forcing option: +0: tendencies +1: adjustments +2: hybrid +Default: Set by build-namelist. + + + +Scalar viscosity with variable coefficient. +Use variable hyperviscosity based on element area limited by +se_max_hypervis_courant. +Default: 0 + + + +Use tensor hyperviscosity. +Citation: Guba, O., Taylor, M. A., Ullrich, P. A., Overfelt, J. R., and +Levy, M. N.: The spectral element method (SEM) on variable-resolution +grids: evaluating grid sensitivity and resolution-aware numerical +viscosity, Geosci. Model Dev., 7, 2803-2816, +doi:10.5194/gmd-7-2803-2014, 2014. +Default: 0 (i.e., not used) + + + +Number of hyperviscosity subcycles per dynamics timestep. +Default: Set by build-namelist + + + +Number of hyperviscosity subcycles done in tracer advection code. +The only supported value in CAM is 1. +Default: Set by build-namelist. + + + +Limiter used for horizontal tracer advection: +0: None +4: Sign-preserving limiter. +8: Monotone limiter. +Default: 8 + + + +Upper bound for Courant number, used to limit se_hypervis_power. +Default: 1.0e99 (i.e., not used) unless se_refined_mesh=TRUE + + + +Filename of exodus file to read grid from (generated by CUBIT or SQuadGen). +Default: "" + + + +Number of elements along a cube edge. +Must match value of grid. Set this to zero to use a refined mesh. +Default: Set by build-namelist. + + + +Number of PEs to be used by SE dycore. +Default: Number of PEs used by CAM. + + + +Number of dynamics steps per physics timestep. +Default: Set by build-namelist. + + + +Hyperviscosity coefficient for u,v, T [m^4/s]. +If < 0, se_nu is automatically set. +Default: Set by build-namelist. + + + +Hyperviscosity applied to divergence component of winds [m^4/s]. +If < 0, uses se_nu_p. +Default: Set by build-namelist. + + + +Hyperviscosity coefficient applied to pressure-level thickness [m^4/s]. +If < 0, se_nu_p is automatically set. +Default: Set by build-namelist. + + + +Second-order viscosity applied only near the model top [m^2/s]. +Default: Set by build-namelist. + + + +If TRUE hyperviscosity operators for u,v,T are applied on approximate pressure levels +If TRUE and se_nu_p>0 then hyperviscosity is also applied to difference between a +reference dp and dp +If FALSE all hyperviscosity operators are applied on eta levels +Default: TRUE + + + +Tracer advection is done every qsplit dynamics timesteps. +Default: Set by build-namelist. + + + +TRUE specified use of a refined grid (mesh) for this run. +Default: FALSE + + + +Vertically lagrangian code vertically remaps every rsplit tracer timesteps. +Default: Set by build-namelist. + + + +Frequency with which diagnostic output is written to log (output every +statefreq dynamics timesteps). +Default: Set by build-namelist. + + + +Time stepping method for SE dycore +se_tstep_type=1 RK2 followed by qsplit-1 Leapfrog steps; second-order accurate in time (CESM1.2.0 setting) +se_tstep_type=2 RK2-SSP 3 stage (as used by tracers) +se_tstep_type=3 classic Runga-Kutta (RK) 3 stage +se_tstep_type=4 Kinnmark&Gray Runga-Kutta (RK) 4 stage +Default: 4 + + + +Number of tracers to include in logfile diagnostics for SE dycore +Default: 3 + + + +CAM-SE vertical remap algorithm +0: Zerroukat monotonic splines +1: PPM vertical remap with mirroring at the boundaries + (solid wall bc's, high-order throughout) +2: PPM vertical remap without mirroring at the boundaries + (no bc's enforced, first-order at two cells bordering top and bottom + boundaries) +Default: Set by build-namelist. + + + +Set .true. to allow writing SE dynamics fields to the restart file using the +unstructured grid format. This allows the restart file to be used as an +initial file, but its use as a restart file will introduce roundoff size +differences into the simulation. +Default: .false. + + + + +Nudging factor for prescribed winds in SE dycore +Units: 1/sec +Default: 2e-5 + + + +Nudging factor for prescribed temperature in SE dycore +Units: 1/sec +Default: 2e-5 + + + +Nudging factor for prescribed surface pressure in SE dycore +Units: 1/sec +Default: 0.0 + + + +Switch to turn on/off time evolution of dynamics nudging +Default: 0 + + + + +Number of equally-spaced horizontal physics points per spectral +element. A number greater than zero will define [se_fv_nphys] equally +spaced physics points in each direction (e.g., se_fv_nphys = 3 will +result in 9 equally-spaced physics points per element). +Default: 0 = feature disabled, use dynamics GLL points. + + + + +If 'SCRIP', write a NetCDF file with the grid in SCRIP format. +If using a finite-volume physics grid, write the FVM grid, otherwise +write the native GLL grid. +Note that if this option is used, the simulation will exit after writing. +Default: 'no' + + + +Name of grid file to write if se_write_grid_file is set. +Default: Set according to active grid + + + +Set to true to write the SEMapping.nc file. +Default: .false. + + + +List of SCRIP grid filenames each representing a destination grid. If provided during a CAM simulation running the spectral element dycore, mapping files will be created from the native cubed-sphere grid to each destination grid. Both native mapping (using the internal spectral element basis functions) and bilinear maps are created. +Default: none + + + + +Number of threads to use for loops over elements. +Default: Set by build-namelist. + + + +Number of threads to use when processing vertical loops. Normally +equal to se_tracer_num_threads. +Default: Set by build-namelist. + + + +Number of threads to use when processing loops over threads. +Normally equal to se_vert_num_threads. +Default: Set by build-namelist. + + + + + +The analytic initial conditions to use for this run: +none: Do not use analytic initial conditions (i.e., read IC from file) +held_suarez_1994: Dynamics state will be set to Held-Suarez (1994) initial conditions. +baroclinic_wave: Dynamics state will be set to a baroclinic wave initial condition. +dry_baroclinic_wave: Dynamics state will be set to a dry baroclinic wave initial condition. +Default: 'none' + + + + + +Default: 4 + + + +Default: 1 + + + +Default: -1 + + + +Default: "netcdf" + + + +Default: .false. + + + +Default: 0 + + + +Default: -1 + + + +Default: 0 + + + +pio_rearranger = 1 for box rearranger + = 2 for subset rearranger +Default: box rearranger used by pio1, subset is default for pio2. + + + + + +Full pathname of docn restart file. +Default: set by build-namelist. + + + +Full pathname of docn restart file. +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + +Default: set by build-namelist. + + + + + + + +Full pathname of time-variant sea-surface temperature and sea-ice +concentration boundary dataset. +Default: set by build-namelist. + + + +Full pathname of +Default: set by build-namelist. + + + +Full pathname of grid file for time-variant sea-surface temperature and sea-ice +concentration boundary dataset. +Default: set by build-namelist. + + + + + + +The first year of the multi-year SST dataset which is read by CICE for +the prescribed ice fraction. This needs to be set for AMIP simulations. +Default: 0 + + + +The last year of the multi-year SST dataset which is read by CICE for +the prescribed ice fraction. This needs to be set for AMIP simulations. +Default: 0 + + + + + +Full pathname of master restart file from which to branch. Setting is +Required for branch run. +Default: none + + + +Flag for yearly cycling of SST data. If set to FALSE, a multi-year dataset +is assumed, otherwise a single-year dataset is assumed, and SSTs will be +cycled over the first 12 values in the file. This variable is only recognized +by the old CAM DOM component. +Default: TRUE + + + + + + +Name of file that the atmosphere component log messages will be written to. By +default all log messages are written to stdout. +Default: "" + + + +Absolute pathname of directory that the file specified by {{ hilight }}atm_logfile{{ closehilight }} +will be written to. +Default: "." + + + +Name of file that the driver component log messages will be written to. By +default all log messages are written to stdout. +Default: "" + + + +Absolute pathname of directory that the file specified by {{ hilight }}cpl_logfile{{ closehilight }} +will be written to. +Default: "." + + + +Name of file that the land component log messages will be written to. By +default all log messages are written to stdout. +Default: "" + + + +Absolute pathname of directory that the file specified by {{ hilight }}lnd_logfile{{ closehilight }} +will be written to. +Default: "." + + + +Name of file that the runoff component log messages will be written to. By +default all log messages are written to stdout. +Default: "" + + + +Absolute pathname of directory that the file specified by {{ hilight }}rof_logfile{{ closehilight }} +will be written to. +Default: "." + + + + + + + +Default: 1 + + + + + +Default: FALSE + + +Default: FALSE + + +Default: FALSE + + +Default: FALSE + + +Default: + + + + + +Stride used in selecting the processes in the atm communicator group. +Default: 1 + + + +Root process of the atm communicator group. +Default: 0 + + + +Number of atm tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each atm task. +Default: 1 + + + +Stride used in selecting the processes in the lnd communicator group. +Default: 1 + + + +Root process of the lnd communicator group. +Default: 0 + + + +Number of lnd tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each lnd task. +Default: 1 + + + +Stride used in selecting the processes in the ice communicator group. +Default: 1 + + + +Root process of the ice communicator group. +Default: 0 + + + +Number of ice tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each ice task. +Default: 1 + + + +Stride used in selecting the processes in the ocn communicator group. +Default: 1 + + + +Root process of the ocn communicator group. +Default: 0 + + + +Number of ocn tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each ocn task. +Default: 1 + + + +Stride used in selecting the processes in the rof communicator group. +Default: 1 + + + +Root process of the rof communicator group. +Default: 0 + + + +Number of rof tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each rof task. +Default: 1 + + + +Stride used in selecting the processes in the cpl communicator group. +Default: 1 + + + +Root process of the cpl communicator group. +Default: 0 + + + +Number of cpl tasks. +Default: total number of tasks assigned to job. + + + +Number of threads in each cpl task. +Default: 1 + + + + + +If true, run model in "aqua planet" mode. Only one of +{{ hilight }}atm_adiabatic{{ closehilight }}, {{ hilight }}atm_ideal_phys{{ closehilight }}, or +{{ hilight }}aqua_planet{{ closehilight }} can be true. +Default: FALSE + + + +Set the sst to a particular analytic solution. +Default: 1 + + + +If FALSE then CAM will set the deposition fluxes to zero before sending +them to the coupler. A side effect of setting the +variable {{ hilight }}chem_rad_passive{{ closehilight }} to TRUE is that this variable +will be set to FALSE (the deposition fluxes must be set to zero in order +for the chemistry not to impact the climate). +Default: TRUE + + + +bit for bit flag +Default: FALSE + + + +If TRUE, use the pre-existing case name for a branch run. +Default: FALSE + + + +annual budget level +Default: 1 + + + +daily budget level +Default: 0 + + + +instantaneous budget level +Default: 0 + + + +long term budget level written at end of year +Default: 1 + + + +long term budget level written at end of run +Default: 0 + + + +monthly budget level +Default: 1 + + + +Case title. +Default: none. + + + +cime model version. +Default: cesm. + + + +Enable cold air outbreak modification based on Mahrt and Sun, MWR, 1995. +Default: TRUE + + + +gust_fac value - for CESM is 0 +Default: 0. + + + +Case identifier. The value of {{ hilight }}case_name{{ closehilight }} is used in the +default filenames of both the history and restart files (see +the {{ hilight }}hfilename_spec{{ closehilight }} namelist option). The "%c" string in +the {{ hilight }}hfilename_spec{{ closehilight }} templates are expanded using the +value of {{ hilight }}case_name{{ closehilight }} when history filenames are created. +Default: set by build-namelist. + + + +Use netcdf 64 bit offset, large file support. +Default: FALSE + + + +T => do heat/water budget diagnostics +Default: FALSE + + + +T => enable run time setting of thread count for each component +Default: FALSE + + + +T => no diurnal cycle in ocn albedos. +Default: FALSE + + + +Selects E,P,R adjustment technique. +Default: 'off' + + + +Default: 5 + + + +Current machine. +Default: 'unknown' + + + +Debug flag. +Default: 1 + + + +Postfix for output log files. +Default: '.log' + + + +Model version. +Default: 'unknown' + + + +Coupler sequence option - CESM1_MOD_TIGHT is identical to old ocean_tight_coupling. +Default: 'CESM1_MOD_TIGHT' + + + +Earth's eccentricity of orbit. (unitless: typically 0. to 0.1). Setting is +Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used when running +as part of CCSM. +Default: none + + + +Mode to specify how orbital parameters are to be set. +Not used when running as part of CCSM. +Default: fixed_year + + + +Year (AD) used to compute earth's orbital parameters. If not set, then use +the values from +the {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, +and {{ hilight }}orb_obliq{{ closehilight }} namelist parameters. If only +{{ hilight }}orb_iyear{{ closehilight }} is set, orbital parameters will be computed +automatically (based on Berger, 1977). If one +of {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, or +{{ hilight }}orb_obliq{{ closehilight }} is set, all three must be set. If all four of +the above are set by the user, {{ hilight }}orb_iyear{{ closehilight }} takes +precedence. Setting is Required +unless {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, +and {{ hilight }}orb_obliq{{ closehilight }} are set. Not used when running as part of +CCSM. +Default: 1990. + + + +Earth's moving vernal equinox at perihelion (degrees: 0. to 360.0). +Setting is Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used +when running as part of CCSM. +Default: none + + + +Earth's orbital angle of obliquity (degrees: -90. to +90., typically 22. to 26.). +Setting is Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used +when running as part of CCSM. +Default: none + + + +Root output files +Default: './' + + + +Set to TRUE to specify that the run will use a perpetual calendar, i.e., a +diurnal cycle will be present for the fixed calendar day specified +by {{ hilight }}perpetual_ymd{{ closehilight }}. +Default: FALSE + + + +Perpetual date encoded in an integer as (year*1000 + month*100 + day). +If {{ hilight }}aqua_planet{{ closehilight }} = .true. then perpetual_ymd is ignored +and the perpetual date is set to 321. +Default: none. + + + +Restart filename. +Default: none + + + +List of namelist variables that may be overridden on a restart run. +Default: none + + + +Restart pointer filename. +Default: 'rpointer.drv' + + + +are ocean and ice grids same lat/lon/size +Default: TRUE + + + +Latitude value of single column. +Default: none. + + + +Longitude value of single column. +Default: none. + + + +Set to TRUE to turn on single column mode. +Default: FALSE + + + +Run type. 'startup' is an initial run. 'continue' is a restart run. +'branch' is a restart run in which properties of the output history files +may be changed. +Default: 'startup' + + + +Current user. +Default: 'unknown' + + + +Invoke vector mapping option +Default: 'cart3d' + + + + + +Flag to indicate whether to use the double-double distributed sum algorithm +rather than the (almost) infinite precision reproducible distributed sum algorithm. +Default: FALSE + + + +Flag to indicate whether a distributed sum that violates the difference +tolerance specified by reprosum_diffmax should be recomputed using +a floating point-based (but nonscalable) reproducible algorithm. +Default: FALSE + + + +Relative difference between repro and nonrepro algorithms that will +generate a warning. This will also force a recompute using a nonscalable +algorithm if reprosum_recompute is true. If less than zero, then +the difference will not be evaluated (and the nonrepro algorithm will not +be computed). +Default: -1.0 + + + + + +Coupling interval between the atmosphere and other system components. This +is how frequently information can be communicated between the atmosphere +and the surface models. +Default: set by build-namelist. + + + +Calendar type "NO_LEAP" for consistent 365-days per year or "GREGORIAN" to +include leap-years. Note that if "GREGORIAN" is selected +leap-years will be used in the time manager, but the calculation of the +earth's orbit still assumes 365 day years. Valid values are "NO_LEAP" or +"GREGORIAN". +Default: "NO_LEAP" + + + +Write restart at end of run. +Default: TRUE + + + +Default: set by build-namelist. + + + +Default: + + + +Default: set by build-namelist. + + + +Default: + + + +Default: set by build-namelist. + + + +Default: + + + +Default: set by build-namelist. + + + +Default: + + + +Reference time-of-day expressed as seconds past midnight. Used in +conjuction with {{ hilight }}ref_ymd{{ closehilight }} to set the reference time. +Default: set to {{ hilight }}start_tod{{ closehilight }}. + + + +Reference date encoded in an integer as (year*1000 + month*100 + day). +Used in +conjuction with {{ hilight }}ref_tod{{ closehilight }} to set the reference time which +is used to define a time coordinate for the output history files. The +convention for the unit string of a time coordinate is of the form +"time-unit since reference-time", for example, "days since 1990-01-01 +00:00:00". The reference-time part of this string is specified by the +{{ hilight }}ref_ymd{{ closehilight }} and {{ hilight }}ref_tod{{ closehilight }} variables. + +Default: set to {{ hilight }}start_ymd{{ closehilight }}. + + + +Set the restart interval as a number of elapsed time units which are specified +by {{ hilight }}restart_option{{ closehilight }}. +Default: 1 + + + +Set the interval between writing restart files +using one of the options 'nsteps', +'ndays', 'nmonths', or 'nyears', in conjuction +with {{ hilight }}stop_n{{ closehilight }} to set the number of time units. +A convenience option allows specifying that restart files be written at the +end of each month or at the end of each year by using the options +'monthly' or 'yearly' respectively. It is also possible to request that no +restart files be written via the option 'none', or that restart files be +written only at the end of the run via the option 'end'. +Default: 'monthly' + + + +Start time-of-day expressed as seconds past midnight. Used in +conjuction with {{ hilight }}start_ymd{{ closehilight }} to set the start time. +Default: 0. + + + +Start date encoded in an integer as (year*1000 + month*100 + day). +Used in +conjuction with {{ hilight }}start_tod{{ closehilight }} to set the start date of +the simulation. +Default: set by build-namelist. + + + +Set the length of run as a number of elapsed time units which are specified +by {{ hilight }}stop_option{{ closehilight }}. +Default: 1 + + + +Set the length of run as an elapsed time using one of the options 'nsteps', +'ndays', 'nmonths', or 'nyears', in conjuction +with {{ hilight }}stop_n{{ closehilight }} to set the number of elapsed time units. +Alternatively, set the final simulation time in absolute terms by using the +option 'date' in conjuction with {{ hilight }}stop_ymd{{ closehilight }}, +and {{ hilight }}stop_tod{{ closehilight }} to specify a date and time of day at which +the simulation should stop. +Default: 'ndays' + + + +Stop time-of-day expressed as seconds past midnight. Used in +conjuction with {{ hilight }}stop_ymd{{ closehilight }} to set the stop time. +Default: 0. + + + +Stop date encoded in an integer as (year*1000 + month*100 + day). +Used in +conjuction with {{ hilight }}stop_tod{{ closehilight }} to set the stop date of +the simulation. +Default: none. + + + +This varible is only used internally by build-namelist to determine +appropriate defaults for climatological or transient forcing datasets. +Default: set by build-namelist. + + + + + + +Length of siderial day [seconds]. +Default: set to shr_const value + + + +Radius of Earth [m]. +Default: set to shr_const value + + + +Acceleration of gravity [m/s**2]. +Default: set to shr_const value + + + +Molecular weight of dry air [g/mol] +Default: set to shr_const value + + + +Heat capacity of dry air at constant pressure [J/kg/K]. +Default: set to shr_const value + + + +Molecular weight of water [g/mol]. +Default: set to shr_const value + + + +Heat capacity of water vapor at constant pressure [J/kg/K]. +Default: set to shr_const value + + + +Freezing point of water [K]. +Default: set to shr_const value + + + + + +Filepath for dataset for offline unit driver. +Default: none + + + +List of filepaths for dataset for offline unit driver. +Default: none + + + diff --git a/bld/namelist_files/use_cases/1850-2005_cam5.xml b/bld/namelist_files/use_cases/1850-2005_cam5.xml new file mode 100644 index 0000000000..17761ed2b7 --- /dev/null +++ b/bld/namelist_files/use_cases/1850-2005_cam5.xml @@ -0,0 +1,91 @@ + + + + +18500101 + + +atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc +SERIAL + + +RAMPED +atm/cam/ggas/ghg_hist_1765-2005_c091218.nc + + +INTERP_MISSING_MONTHS + +atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_1849-2006_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_1850-2005_c130424.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_1850-2005_c130424.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_1850-2005_c130424.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_1850-2005_c090804.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_surf_1850-2005_c150205.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_surf_1850-2005_c150205.nc + + +INTERP_MISSING_MONTHS +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_1850-2005_c130424.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_1850-2005_c130424.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_1850-2005_c090804.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_1850-2005_c090804.nc + +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_elev_1850-2005_c150205.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_elev_1850-2005_c150205.nc + + +atm/cam/volc +CCSM4_volcanic_1850-2008_prototype1.nc + + + atm/cam/ozone + ozone_1.9x2.5_L26_1850-2005_c090803.nc + O3 + INTERP_MISSING_MONTHS + + + atm/cam/chem/trop_mozart_aero/oxid + oxid_1.9x2.5_L26_1850-2005_c091123.nc + INTERP_MISSING_MONTHS + + +1850-2000 + + +.false. +1850 +2012 +2008 + +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2012_c130411.nc + +atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2012_c130411.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2012_c130411.nc + + +.true. +0 +0 +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc + + diff --git a/bld/namelist_files/use_cases/1850_cam4.xml b/bld/namelist_files/use_cases/1850_cam4.xml new file mode 100644 index 0000000000..902081728c --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam4.xml @@ -0,0 +1,57 @@ + + + + + +1360.89 + + +284.7e-6 +791.6e-9 +275.68e-9 +12.48e-12 +0.0 + + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_1850clim_c091112.nc +aero_1.9x2.5_L26_1850clim_c090420.nc +CYCLICAL +1850 + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_monthly_1850_mean_1.9x2.5_c090421.nc +CYCLICAL +1850 + + + +atm/cam/ozone +ozone_1.9x2.5_L26_1850clim_c091112.nc +ozone_1.9x2.5_L26_1850clim_c090420.nc +O3 +CYCLICAL +1850 + + +1850 + + +1,365,30,120,240 +0,-24,-24,-6,-3 + + +.false. +.true. +'U' +'MSKtem','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','UTGWORO' + + +'TREFHTMN','TREFHTMX','TREFHT','PRECC','PRECL','PSL' + + + + + diff --git a/bld/namelist_files/use_cases/1850_cam6.xml b/bld/namelist_files/use_cases/1850_cam6.xml new file mode 100644 index 0000000000..1500ba6e69 --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam6.xml @@ -0,0 +1,62 @@ + + + + + + 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc' + 18500101 + FIXED + + + 284.7e-6 + 791.6e-9 + 275.68e-9 + 12.48e-12 + 0.0 + + + 1850 + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM6_L70_zm5day_1850climo_295_c180426.nc' + 'O3' + 'CYCLICAL' + + + CYCLICAL + 1850 + + + CYCLICAL + 1850 + + + 1850 + 'atm/cam/tracer_cnst' + 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climo295_c180426.nc' + 'O3','OH','NO3','HO2' + 'CYCLICAL' + '' + + + 1850 + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM6_L70_zm5day_1850climo_295_c180426.nc' + .true. + 'CYCLICAL' + + + 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climo295_c180426.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc' + + + + + 1850 + + diff --git a/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml new file mode 100644 index 0000000000..0897d3822a --- /dev/null +++ b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml @@ -0,0 +1,174 @@ + + + + +20000101 + + +atm/waccm/ic/f.c54137.FXHIST.f19_f19.001.cam.i.2000-01-01-00000_c170817.nc + +1.3 + + +atm/cam/solar/spectral_irradiance_Lean_1950-2014_daily_GOME-Mg_Leap_c150623.nc + + +atm/waccm/solar/waxsolar_3hr_c170504.nc + + +atm/waccm/solar/spes_1963-2014_c150717.nc +'Prod'' + + +atm/waccm/gcrs +gcr_prod_NO_1949-2142_c150309.nc + + +.false. +atm/waccm/qbo/qbocoefficients_c151023.nc +.true. + + +atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc +'SERIAL' + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H1202', 'H2402','SF6' + + + +atm/waccm/sulf/sulfate_b.e11.TSREFC2.f19.g16.ccmi23.001_c150908.nc +SERIAL + + +.true. +SERIAL + + +atm/cam/chem/trop_mozart_aero/aero +aero_b.e11.TSREFC2.f19.f19.ccmi23.001_c141030.nc +INTERP_MISSING_MONTHS + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_rcp6.0_monthly_1849-2104_1.9x2.5_c100830.nc +'INTERP_MISSING_MONTHS' +0 + + + + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/CCMI_emissions_aircraft_NO2_1850-2100_1.9x2.5_c130314.nc', + +'SERIAL' + + + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CH2O_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CO_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_NO_1960-2008_1.9x2.5_mol_c130314.nc', + +'INTERP_MISSING_MONTHS' + + +atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20120313.nc +.false. + + 'CH2O = formaldehyde', + 'CO = carbon_monoxide' + + + + 'A', 'I', 'I', 'A', 'A', 'A' + 0, -1, -24, -24, -120, -24 + 1, 24, 7, 7, 10, 365 + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', + 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', + 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', + 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', + 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', + 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', + 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' + + + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' + + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + +42 + + + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa +', + ' 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b', + 'O3_Prod = NO_HO2 + CH3O2_NO', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO', + 'RO2_HO2_sum = CH3O2_HO2', + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', + 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + + +0.90D0 +'MONTHLY' + monthly +'ionosphere' +0.3 +0.3 +'' +.true. +-1 +2 +atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc +atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc +1.200D0 +.false. + + diff --git a/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml b/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml new file mode 100644 index 0000000000..1323330be0 --- /dev/null +++ b/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml @@ -0,0 +1,74 @@ + + + + +00010101 + +367.0e-6 + +atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L26_c080114.nc + + +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +20000101 +FIXED + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_1850-2005_c091112.nc +CYCLICAL +2000 + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_monthly_2000_mean_1.9x2.5_c090421.nc +CYCLICAL +2000 + + + atm/cam/ozone + ozone_1.9x2.5_L26_1850-2005_c090803.nc + O3 + CYCLICAL + 2000 + +.true. +'xactive_lnd' + + +2000 + + +2000 +atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc +CYCLICAL + + + + +'CYCLICAL' +2000 + + + 1 + 0 + 'A' + + + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', 'TROP_P','PBLH','PRECC','PRECL','PHIS', 'QFLX', 'SHFLX', 'TAUX', 'TAUY', + 'O3', 'O', 'O1D', 'N2O', 'NO', 'NO2', 'NO3', 'HNO3', 'HO2NO2', 'N2O5', 'H2', 'OH', 'HO2', 'H2O2', + 'CH4', 'CO', 'CH3O2', 'CH3OOH', 'CH2O', 'CH3OH', 'C2H5OH', 'C2H4', 'EO', 'EO2', 'CH3COOH', 'GLYALD', 'C2H6', + 'C2H5O2', 'C2H5OOH', 'CH3CHO', 'CH3CO3', 'CH3COOOH', 'C3H6', 'C3H8', 'C3H7O2', 'C3H7OOH', 'PO2', 'POOH', + 'CH3COCH3', 'RO2', 'ROOH', 'BIGENE', 'ENEO2', 'MEK', 'MEKO2', 'MEKOOH', 'BIGALK', 'ALKO2', 'ALKOOH', 'ISOP', + 'ISOPO2', 'ISOPOOH', 'MVK', 'MACR', 'MACRO2', 'MACROOH', 'MCO3', 'HYDRALD', 'HYAC', 'CH3COCHO', 'XO2', 'XOOH', + 'C10H16', 'TERPO2', 'TERPOOH', 'TOLUENE', 'CRESOL', 'TOLO2', 'TOLOOH', 'XOH', 'BIGALD', 'GLYOXAL', 'PAN', + 'ONIT', 'MPAN', 'ISOPNO3', 'ONITR', 'CB1', 'CB2', 'OC1', 'OC2', 'SOA', 'SO2', 'SO4', 'DMS', 'NH3', 'NH4', 'NH4NO3', + 'SSLT01', 'SSLT02', 'SSLT03', 'SSLT04', 'DST01', 'DST02', 'DST03', 'DST04', 'Rn', 'Pb','HCN','CH3CN', + 'SFNO','SFNO2','SFCO','SFBIGALK','SFBIGENE','SFC10H16','SFC2H4','SFC2H5OH','SFC2H6','SFC3H6','SFC3H8', + 'SFCH2O','SFCH3CHO','SFCH3COCH3','SFCH3OH','SFDMS','SFISOP','SFMEK','SFNH3', + 'SFCB1','SFCB2','SFOC1','SFOC2','SFSO2','SFTOLUENE','SFHCN','SFCH3CN', + 'DV_HCN','DV_CH3CN','WD_HCN','WD_CH3CN','WD_SO2','WD_HNO3','WD_H2O2','WD_CH2O', + 'O3_CHMP','O3_CHML','CO_CHMP','CO_CHML','CH4_CHML','SO4_CHMP','SO4_CHML', + + + diff --git a/bld/namelist_files/use_cases/2000_cam6.xml b/bld/namelist_files/use_cases/2000_cam6.xml new file mode 100644 index 0000000000..8d91b5a661 --- /dev/null +++ b/bld/namelist_files/use_cases/2000_cam6.xml @@ -0,0 +1,68 @@ + + + + +367.0e-6 + + 2000 + atm/cam/ozone + tracer_cnst_CAM6chem_2000climo_3D_monthly_c171004.nc + '' + 'O3','OH','NO3','HO2' + 'CYCLICAL' + + 2000 + atm/cam/ozone + ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc + 'O3' + 'CYCLICAL' + + 2000 + atm/cam/ozone + ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc + 'CYCLICAL' + + 'atm/cam/solar/SolarForcing1995-2005avg_c160929.nc' + 20000101 + FIXED + + + 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2000climo_c180511.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc ', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc' + + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc ', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc' + + 'atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc' + 'CO2','CH4','N2O','CFC11eq','CFC12' + 'CYCLICAL' + 2000 + + diff --git a/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml new file mode 100644 index 0000000000..21c3fa5568 --- /dev/null +++ b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml @@ -0,0 +1,271 @@ + + + + +00010101 + +atm/cam/inic/fv/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +20000101 +FIXED + + +.true. +.true. +.false. +0.25D0 + +CYCLICAL +2000 +atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc + +2000 + + + +CYCLICAL +2000 + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_vertical_2000climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc' + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', + + +CYCLICAL +2000 + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COCHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc', + 'GLYALD -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'ISOP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'MTERP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc' + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', + 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', + 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', + 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', + 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', + 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', + 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', + 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', + 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', + 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', + 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', + 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', + 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', + 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', + 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', + 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', + 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', + 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', + 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', + 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', + 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', + 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', + 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', + 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', + 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', + 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', + 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', + 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', + 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', + 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', + 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', + 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', + 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', + 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', + 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', + 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', + 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', + 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', + 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', + 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', + 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', + 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', + 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', + 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', + 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', 'OddOx_HOx_Loss', + 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', + 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', + 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', + 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', + 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', + 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', + 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', + 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', + 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/2010_cam6.xml b/bld/namelist_files/use_cases/2010_cam6.xml new file mode 100644 index 0000000000..face1eae95 --- /dev/null +++ b/bld/namelist_files/use_cases/2010_cam6.xml @@ -0,0 +1,48 @@ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +CHERYL'S NOTE -- to be removed when fully implemented +The tracer, ozone and strataero files are from Mike Mill's 10/4/17 email +I updated the cycle_yr to 2010 +NOTE - the solar_data_ymd is still 2000 +Everything else was copied from 2000_cam6.xml +This has not been verified with Cecile and is not ready to be used +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + + + 367.0e-6 + + .false. + .true. + + + 2010 + atm/cam/ozone + tracer_cnst_CAM6chem_2010climo_3D_monthly_c171004.nc + '' + 'O3','OH','NO3','HO2' + 'CYCLICAL' + + 2010 + atm/cam/ozone + ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc + 'O3' + 'CYCLICAL' + + .false. + .true. + + 1 + + 2010 + atm/cam/ozone + ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc + 'CYCLICAL' + + 'atm/cam/solar/SolarForcing1995-2005avg_c160929.nc' + 20000101 + FIXED + + diff --git a/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml new file mode 100644 index 0000000000..6da1add20e --- /dev/null +++ b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml @@ -0,0 +1,271 @@ + + + + +00010101 + +atm/cam/inic/fv/f.e20.FC2010.f09_f09.144.TS1.001.cam.i.0007-01-01-00000.nc + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +20100101 +FIXED + + +.true. +.true. +.false. +0.25D0 + +CYCLICAL +2010 +atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc + +2010 + + + +CYCLICAL +2010 + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_aircraft_vertical_2010climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2010climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2010climo_0.9x1.25_c20170616.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2010climo_0.9x1.25_c20170322.nc', + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NO2_aircraft_vertical_2010climo_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_bb_vertical_2010climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_aircraft_vertical_2010climo_0.9x1.25_c20170322.nc' + + +CYCLICAL +2010 + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BIGALK_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BIGALK_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BIGENE_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BIGENE_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H2_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H2_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H4_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H4_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H4_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H5OH_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H5OH_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H6_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H6_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C2H6_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H6_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H6_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H6_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H8_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H8_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_C3H8_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH2O_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH2O_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3CHO_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3CHO_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3CN_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3CN_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3COCH3_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3COCH3_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3COCHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3COCHO_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3COOH_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3COOH_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3OH_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CH3OH_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CO_anthro_surface_2010climo_0.9x1.25_c20180504.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CO_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_CO_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc', + 'GLYALD -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_GLYALD_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_HCN_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_HCN_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_HCOOH_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_HCOOH_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'ISOP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_ISOP_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_MEK_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_MEK_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'MTERP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_MTERP_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NH3_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NH3_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NH3_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NO_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NO_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_NO_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_other_surface_2010climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_bc_a4_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_bc_a4_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_pom_a4_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_pom_a4_bb_surface_2010climo_0.9x1.25_c20170509.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_pom_a4_anthro_surface_2010climo_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_pom_a4_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2010climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_anthro-ene_surface_2010climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_bb_surface_2010climo_0.9x1.25_c20170322.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20170616.nc' + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', + 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', + 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', + 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', + 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', + 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', + 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', + 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', + 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', + 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', + 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', + 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', + 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', + 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', + 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', + 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', + 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', + 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', + 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', + 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', + 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', + 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', + 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', + 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', + 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', + 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', + 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', + 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', + 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', + 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', + 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', + 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', + 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', + 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', + 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', + 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', + 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', + 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', + 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', + 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', + 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', + 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', + 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', + 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', + 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', 'OddOx_HOx_Loss', + 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', + 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', + 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', + 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', 'bc_a1SFWET', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', + 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', + 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', + 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', + 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', + 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/aquaplanet_cam3.xml b/bld/namelist_files/use_cases/aquaplanet_cam3.xml new file mode 100644 index 0000000000..3fd3d876cb --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_cam3.xml @@ -0,0 +1,81 @@ + + + + + +300 +150 + + +0. +0. +0. +fixed_parameters + + + false + + +348.0e-6 +1650.0e-9 +306.0e-9 +280.e-12 +503.e-12 + + + .false. + + + 4.0e-4 + 16.0e-6 + 5.0e-6 + 0.910D0 + 0.700D0 + 0.070D0 + 500.0D0 + 0.140D0 + 500.0D0 + 25000.0D0 + 1800.0D0 + 1.0e-4 + 0.0040D0 + 0.0040D0 + 1.0E-6 + + + +1365.0 +/ + + +apeozone_cam3_5_54.nc +atm/cam/ozone +OZONE +CYCLICAL +1990 + + + + + +.true. + + +86164.10063718943 +6.37100e6 +9.79764 +28.96623324623746 +18.01618112892741 +1.846e3 +273.16 + +'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11','N:CFC12:CFC12' + + + 0.5 + + + 0 + + + diff --git a/bld/namelist_files/use_cases/aquaplanet_cam4.xml b/bld/namelist_files/use_cases/aquaplanet_cam4.xml new file mode 100644 index 0000000000..ceeb951609 --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_cam4.xml @@ -0,0 +1,48 @@ + + + + + + +0. +0. +0. +fixed_parameters + + + false + + +1.650e-6 +0.306e-6 +348.0e-6 + + +1365.0 +/ + + +apeozone_cam3_5_54.nc +atm/cam/ozone +OZONE +CYCLICAL +1990 + + + + + +.true. + +86164.10063718943 +6.37100e6 +9.79764 +28.96623324623746 +18.01618112892741 +1.846e3 + +'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11','N:CFC12:CFC12' + +.false. + + diff --git a/bld/namelist_files/use_cases/aquaplanet_cam5.xml b/bld/namelist_files/use_cases/aquaplanet_cam5.xml new file mode 100644 index 0000000000..afc820ecef --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_cam5.xml @@ -0,0 +1,53 @@ + + + + + + +0. +0. +0. +fixed_parameters + + + false + + +1.650e-6 +0.306e-6 +348.0e-6 + + +atm/cam/solar/ape_solar_ave_tsi_1365.nc +.true. +/ + + +apeozone_cam3_5_54.nc +atm/cam/ozone +OZONE +CYCLICAL +1990 + + +.true. + + + +86164.10063718943 +6.37100e6 +9.79764 +28.96623324623746 +18.01618112892741 +1.846e3 + +.false. + +.true. +.true. + "" + "" + "" + + + diff --git a/bld/namelist_files/use_cases/aquaplanet_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_cam6.xml new file mode 100644 index 0000000000..cbe41e8cee --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_cam6.xml @@ -0,0 +1,52 @@ + + + + + + +0. +0. +0. +fixed_parameters + + + false + + +1.650e-6 +0.306e-6 +348.0e-6 + + +atm/cam/solar/ape_solar_ave_tsi_1365.nc +.true. +/ + + +apeozone_cam3_5_54.nc +atm/cam/ozone +OZONE +CYCLICAL +1990 + + +.true. + + +86164.10063718943 +6.37100e6 +9.79764 +28.96623324623746 +18.01618112892741 +1.846e3 + +.false. + +.true. +.true. + "" + "" + "" + + + diff --git a/bld/namelist_files/use_cases/dabi_p2004.xml b/bld/namelist_files/use_cases/dabi_p2004.xml new file mode 100644 index 0000000000..113209a1aa --- /dev/null +++ b/bld/namelist_files/use_cases/dabi_p2004.xml @@ -0,0 +1,40 @@ + + + + + 10101 + + +atm/cam/inic/gaus/DABIp2004.128x256.L30.nc +atm/cam/inic/gaus/DABIp2004.128x256.L60.nc +atm/cam/inic/gaus/DABIp2004.64x128.L30.nc + + +.false. + + + 9.806D0 + 6.371D6 + + 86165.45950602833D0 + + 28.97027035191638D0 + + 1004.5D0 + + + 2 + 1 + 7.D5 + 0 + + +.true. +'I' +-24 +30 + + 'U','V','T','PS','OMEGA' + + + diff --git a/bld/namelist_files/use_cases/dctest_baro_kessler.xml b/bld/namelist_files/use_cases/dctest_baro_kessler.xml new file mode 100644 index 0000000000..d6a26b5526 --- /dev/null +++ b/bld/namelist_files/use_cases/dctest_baro_kessler.xml @@ -0,0 +1,26 @@ + + + + + 10101 + + +.false. + + +.true. +'I' +-24 + + 'PS','PRECL' + + + 'Q','CLDLIQ','RAINQM','T','U','V','iCLy','iCL','iCL2','OMEGA' + +'baroclinic_wave' + + + 'TT_SLOT','TT_GBALL','TT_TANH','TT_EM8','TT_Y2_2','TT_Y32_16' + + + diff --git a/bld/namelist_files/use_cases/dctest_baro_moist.xml b/bld/namelist_files/use_cases/dctest_baro_moist.xml new file mode 100644 index 0000000000..bd9ff23faa --- /dev/null +++ b/bld/namelist_files/use_cases/dctest_baro_moist.xml @@ -0,0 +1,26 @@ + + + + + 10101 + + +.false. + + +.true. +-24,-24 +'I' + + 'PS' + + + 'Q','T','U','V','CL','CL2','k1:I','k2:I' + +'baroclinic_wave' + + + 'TT_SLOT','TT_GBALL','TT_TANH','TT_EM8','TT_Y2_2','TT_Y32_16' + + + diff --git a/bld/namelist_files/use_cases/held_suarez_1994.xml b/bld/namelist_files/use_cases/held_suarez_1994.xml new file mode 100644 index 0000000000..4f6ffe13a8 --- /dev/null +++ b/bld/namelist_files/use_cases/held_suarez_1994.xml @@ -0,0 +1,26 @@ + + + + + 10101 + + +atm/cam/inic/gaus/HS1994.128x256.L30_c062216.nc +atm/cam/inic/gaus/HS1994.128x256.L60_c061516.nc +atm/cam/inic/gaus/HS1994.64x128.L30_c061616.nc + + + 1.0D-5 + + + 4 + 1.17D16 + 7.14D14 + + +0,-6 + + 'U:I','V:I','T:I' + + + diff --git a/bld/namelist_files/use_cases/hist_cam6.xml b/bld/namelist_files/use_cases/hist_cam6.xml new file mode 100644 index 0000000000..84c24c05d3 --- /dev/null +++ b/bld/namelist_files/use_cases/hist_cam6.xml @@ -0,0 +1,31 @@ + + + + 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc' + + 'atm/cam/ozone/' + 'tracer_cnst_CAM6chem_1849-2014_3D_monthly_c170925.nc' + 'O3','OH','NO3','HO2' + 'SERIAL' + '' + + 'atm/cam/ozone/' + 'ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc' + 'O3' + 'SERIAL' + + INTERP_MISSING_MONTHS + INTERP_MISSING_MONTHS + + 'SERIAL' + 'atm/cam/ozone/' + 'ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc' + .true. + + 'CHEM_LBC_FILE' + + atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + 'SERIAL' + 'CO2','CH4','N2O','CFC11eq','CFC12' + + diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml new file mode 100644 index 0000000000..81631eea3e --- /dev/null +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml @@ -0,0 +1,170 @@ + + + + +00010101 + +atm/cam/inic/fv/f.e20.FW1850.f09_f09.CESMpiControlForcingSST141.003.veclen64.cam.i.0009_32L_c170412.nc +atm/cam/inic/se/f.e20.FCHIST.ne30_ne30.chem01_cam5_4_152.001.cam.i.2011-01-01-00000_c171215.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +.true. +.true. +.false. +0.25D0 + +SERIAL +atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc + + SERIAL + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', + 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', + 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', + 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', + 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', + 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', + 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', + 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', + 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', + 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', + 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', + 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', + 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', + 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', + 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', + 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', + 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', + 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', + 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', + 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', + 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', + 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', + 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', + 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', + 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', + 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', + 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', + 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', + 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', + 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', + 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', + 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', + 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', + 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', + 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', + 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', + 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', + 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', + 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', + 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', + 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', + 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', + 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', + 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', + 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', 'OddOx_HOx_Loss', + 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', + 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', + 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', + 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', 'bc_a1SFWET', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', + 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', + 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', + 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', + 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', + 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/scam_arm95.xml b/bld/namelist_files/use_cases/scam_arm95.xml new file mode 100644 index 0000000000..bf9ebc7391 --- /dev/null +++ b/bld/namelist_files/use_cases/scam_arm95.xml @@ -0,0 +1,22 @@ + + + + + +368.9e-6 + +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/scam/iop/ARM95_4scam.nc + 36.6 + 262.5 + 19950718 + 19800 + 1259 + 1500 + 1 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_arm97.xml b/bld/namelist_files/use_cases/scam_arm97.xml new file mode 100644 index 0000000000..7508853f08 --- /dev/null +++ b/bld/namelist_files/use_cases/scam_arm97.xml @@ -0,0 +1,22 @@ + + + + + +368.9e-6 + +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/scam/iop/ARM97_4scam.nc + 36.6 + 262.5 + 19970618 + 84585 + 2088 + 1500 + 9 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_gateIII.xml b/bld/namelist_files/use_cases/scam_gateIII.xml new file mode 100644 index 0000000000..c5c822d5e3 --- /dev/null +++ b/bld/namelist_files/use_cases/scam_gateIII.xml @@ -0,0 +1,20 @@ + + + + + +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/scam/iop/GATEIII_4scam.nc + 9.00 + 336.0 + 19740830 + 0 + 1440 + 1500 + 9 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_mpace.xml b/bld/namelist_files/use_cases/scam_mpace.xml new file mode 100644 index 0000000000..a559a8489e --- /dev/null +++ b/bld/namelist_files/use_cases/scam_mpace.xml @@ -0,0 +1,30 @@ + + + + + +atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc +atm/cam/scam/iop/MPACE_4scam.nc + 70.5 + 206.0 + 20041005 + 7171 + 1242 + 1500 + 9 + nsteps + 'CLDST', 'CNVCLD', + 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', + 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', + 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', + 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', + 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', + 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', + 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', + 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', + 'TGCLDLWP','GCLDLWP' + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_sparticus.xml b/bld/namelist_files/use_cases/scam_sparticus.xml new file mode 100644 index 0000000000..105994b36b --- /dev/null +++ b/bld/namelist_files/use_cases/scam_sparticus.xml @@ -0,0 +1,20 @@ + + + + + +atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc +atm/cam/scam/iop/SPARTICUS_4scam.nc + 36.6 + 262.51 + 20100401 + 3599 + 2156 + 1500 + 9 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_togaII.xml b/bld/namelist_files/use_cases/scam_togaII.xml new file mode 100644 index 0000000000..9b2706382b --- /dev/null +++ b/bld/namelist_files/use_cases/scam_togaII.xml @@ -0,0 +1,20 @@ + + + + + +atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc +atm/cam/scam/iop/TOGAII_4scam.nc + -2.10 + 154.69 + 19921218 + 64800 + 1512 + 1500 + 9 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/scam_twp06.xml b/bld/namelist_files/use_cases/scam_twp06.xml new file mode 100644 index 0000000000..e599a45b16 --- /dev/null +++ b/bld/namelist_files/use_cases/scam_twp06.xml @@ -0,0 +1,20 @@ + + + + + +atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc +atm/cam/scam/iop/TWP06_4scam.nc + -12.43 + 130.89 + 20060117 + 10800 + 1926 + 1500 + 9 + nsteps + + +2000 + + diff --git a/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml new file mode 100644 index 0000000000..b5f1b2042c --- /dev/null +++ b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml @@ -0,0 +1,176 @@ + + + + +20050101 + +atm/cam/inic/fv/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_56L_c170403.nc +atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_geos5_c160702.nc + +50. +.true. +'2005/MERRA2_0.9x1.25_20050101.nc' +atm/cam/met/MERRA2/0.9x1.25 +atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c180430.txt + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +SERIAL + + +.true. +.true. +.false. +0.25D0 + + +SERIAL +atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', + 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', + 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', + 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', + 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', + 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', + 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', + 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', + 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', + 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', + 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', + 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', + 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', + 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', + 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', + 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', + 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', + 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', + 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', + 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', + 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', + 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', + 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', + 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', + 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', + 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', + 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', + 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', + 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', + 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', + 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', + 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', + 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', + 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', + 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', + 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', + 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', + 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', + 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', + 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', + 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', + 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', + 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', + 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', + 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', 'OddOx_HOx_Loss', + 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', + 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', + 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', + 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', 'bc_a1SFWET', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', + 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', + 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', + 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', + 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', + 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml b/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml new file mode 100644 index 0000000000..dfc2700be1 --- /dev/null +++ b/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml @@ -0,0 +1,114 @@ + + + + + +atm/cam/solar/solarforcing_ref_day_3.1_SSI_c160505.nc + +19900101 + yearly + + +atm/waccm/ic/wa4_cesm1_1_b02_geos5_2x_sim153f.cam2.i.1990-01-01-00000_mam3_c130828.nc + + +'xactive_atm' + + +atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_RNOCStrend_c141002.nc +'SERIAL' + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H1202', 'H2402', 'OCS' + + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +INTERP_MISSING_MONTHS + + + .true. +.true. + + +.false. +' ' +.false. + + +.false. + + + + +.true. +'INTERP_MISSING_MONTHS' +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_RCP45_aircraft_NO2_2000-2100_1.9x2.5.nc + + + + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/CCMI_emissions_aircraft_NO2_1850-2100_1.9x2.5_c130314.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/IPCC_emissions_volc_SO2_1850-2100_1.9x2.5_c141106.nc', + 'bc_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_bc_elev_1850-2300_c20150128.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_num_a2_elev_1850-2300_c20150128.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_num_a1_elev_1850-2300_c20150128.nc', + 'pom_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_pom_elev_1850-2300_c20150128.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_so4_a1_elev_1850-2300_c20150128.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_so4_a2_elev_1850-2300_c20150128.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/stratvolc/GlobalVolcSO2Emis1850-2015_VEI_Pin10Tg_2deg_c151111.nc' + +'INTERP_MISSING_MONTHS' + + + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_CH2O_surface_1850-2100_1.9x2.5_c130806.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_CO_surface_1850-2100_1.9x2.5_c150128.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_NO_surface_1850-2100_1.9x2.5_c130806.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_DMS_surface_1850-2100_1.9x2.5_c130814.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_SO2_surface_1850-2100_1.9x2.5_c130814.nc', + 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_SOAG_surface_1850-2100_1.9x2.5_c150128.nc', + 'bc_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_bc_surf_1850-2300_c20150128.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_num_a1_surf_1850-2300_c20150128.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_num_a2_surf_1850-2300_c20150128.nc', + 'pom_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_pom_surf_1850-2300_c20150128.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_so4_a1_surf_1850-2300_c20150128.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/RCP60_mam3_so4_a2_surf_1850-2300_c20150128.nc' + +'INTERP_MISSING_MONTHS' + + +atm/waccm/solar/wasolar_c150720.nc + + +atm/cam/solar/solarforcing_ref_day_3.1_EPP_c160505.nc + + + +1,10,20,73,365 +0,-240,-240,-24,-24 +'A','I','I','A','A' + + + 'ELECDEN','QIONSUM','QSUM','ALONM','ALATM','BNORTH','BEAST','BDOWN', + 'BMAG','SIGMAPED','SIGMAHAL', + 'EPOTEN','EF_EAST','EF_WEST','EF_UP','EF1_MAP','EF2_MAP', + 'UI','VI','WI', + + + 'EPP_ionpairs','QSUM', + 'MSIS_T','MSIS_H','MSIS_O','MSIS_O2' + + +50. +60. +50. +.true. +'1990/MERRA_19x2_19900101.nc' +atm/cam/met/MERRA +atm/cam/met/MERRA/CCMI_sd_filenames.txt + + +atm/cam/met/USGS-gtopo30_1.9x2.5_phys_geos5_c100929.nc + +0.89D0 + + + diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml new file mode 100644 index 0000000000..2f038cae91 --- /dev/null +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml @@ -0,0 +1,110 @@ + + + + +20050101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +'epp_ion_rates' + + +cesm2_init/f.e20.FWSD.f09_f09_mg17.262/2005-01-01/f.e20.FWSD.f09_f09_mg17.262.cam.i.2005-01-01-00000.nc + +50. +60. +50. +.true. +'2005/GEOS5_09x125_20050101.nc' +atm/cam/met/GEOS5/0.9x1.25 +atm/cam/met/GEOS5/0.9x1.25/filenames_list.txt + + +atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_geos5_c160702.nc + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'H1202', 'OCS', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +'INTERP_MISSING_MONTHS' + + +.true. +.false. +.true. +atm/waccm/qbo/qbocyclic28months.nc + + + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 + 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + + + 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', + 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', + 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', + 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', + 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Lightning', 'QNO', 'QRS_AUR', + 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', 'TTGW', + 'UTGWORO', 'UTGWSPEC', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'HOX', 'NOX', 'NOY', 'CLOX', + 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', + 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', + 'OMEGA_12_COS', 'OMEGA_12_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', + 'PS_12_SIN', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', + 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', + 'TROPP_FD', 'NITROP_PD', 'TROP_P', 'TROP_T', 'TROP_Z', 'SAD_AERO', 'REFF_AERO', + 'AODVISstdn', 'EXTINCTdn', 'EXTxASYMdn', 'AODUVstdn', 'AODNIRstdn', 'AODVISdn', 'MASS', + 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', + 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', + 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', + 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + +.true. +.true. +.true. +.true. +.false. +.false. +.false. +.false. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml new file mode 100644 index 0000000000..d74dd2892e --- /dev/null +++ b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml @@ -0,0 +1,175 @@ + + + + + +atm/cam/solar/spectral_irradiance_Lean_1950-2012_daily_Leap_c130227.nc + + +atm/cam/chem/trop_mozart_aero/aero +aero_rcp45_v1_1.9x2.5_L26_1995-2105_c100316.nc +INTERP_MISSING_MONTHS + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_rcp4.5_monthly_1849-2104_1.9x2.5_c100402.nc +'INTERP_MISSING_MONTHS' +0 + +20100101 + yearly + + +atm/waccm/ic/f40.2008-2011.2deg.wcm.sd.carma.sulf.002.cam2.i.2010-01-01-00000.nc + + +'xactive_atm' + + + + + +atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc +'SERIAL' + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +INTERP_MISSING_MONTHS + + +CYCLICAL +2000 + + +.false. +' ' +.false. + + +.false. + + + + +.true. +'SERIAL' +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_RCP45_aircraft_NO2_2000-2100_1.9x2.5.nc + +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CH2O_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CO_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_NOx_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_SO2_2000-2100_1.9x2.5.nc +'SERIAL' + + + +atm/waccm/solar/wasolar_1947-2012_daily_c130227.nc + + +atm/waccm/solar/spes_1963-2012_c130307.nc +'Prod' + + + +1,10,20,73,365 +0,-240,-240,-24,-24 +'A','I','I','A','A' + + + + 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', + 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', + 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', + 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', + 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', + 'VI', 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', + 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', + 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', + 'SFCH2O','CFC11STAR' + + + + + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3BR', 'CF3BR', 'CF2CLBR', + 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', + 'O3', 'O', 'O1D', + 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', + 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', + 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', + 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' + + + + + 'PS:B', 'T:B', 'Z3:B', 'U:B', 'V:B', 'CO:B', 'CO2:B', + 'H2:B', 'O:B', 'O2:B', 'O3:B', 'H:B', 'OH:B', 'HO2:B', 'H2O:B', + 'N:B', 'NO:B', 'NO2:B', 'O1D:B', 'O2_1S:B', 'O2_1D:B', 'N2D:B', + 'Np:B', 'N2p:B', 'Op:B', 'O2p:B', 'NOp:B', 'e:B', 'QRL_TOT:B', + 'QRS_TOT:B', 'QJOULE:B', 'jno3_a:B', 'jno3_b:B', 'jcl2o2:B', 'CL2O2:B', 'CLO:B', + 'BRO:B', 'NO3:B', 'DTCORE:B', 'DTV:B', 'TTGW:B','OMEGA:B' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' + + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + +50. +60. +0.1 +.true. +'2010/GEOS5.2_19x2_20100101.nc' +atm/cam/met/GEOS5 +atm/cam/met/GEOS5_filenames_list_c120516.txt + + +atm/cam/met/USGS-gtopo30_1.9x2.5_phys_geos5_c100929.nc + + +1850-2000 + + +.false. +1850 +2008 + +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2008_c100127.nc + +atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2008_c100128.nc + + +.true. +0 +0 +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc + + + diff --git a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml new file mode 100644 index 0000000000..22f94af643 --- /dev/null +++ b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml @@ -0,0 +1,205 @@ + + + + +20050101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +'epp_ion_rates' + + yearly + + +cesm2_init/f.e20.FWSD.f09_f09_mg17.262/2005-01-01/f.e20.FWSD.f09_f09_mg17.262.cam.i.2005-01-01-00000.nc + +50. +60. +50. +.true. +'2005/GEOS5_09x125_20050101.nc' +atm/cam/met/GEOS5/0.9x1.25 +atm/cam/met/GEOS5/0.9x1.25/filenames_list.txt + +atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_geos5_c160702.nc + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +'INTERP_MISSING_MONTHS' + + +.true. +.true. +.true. +.false. + + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 +'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + +.true. +.false. +.false. +.false. +.false. +.false. +.true. +.true. +.true. + + + + 'CFC11STAR', 'E90', 'ST80_25', 'AOA_NH', 'NH_5', 'NH_50', + 'AODDUST', 'AODDUST2', 'T', 'TSMN:M', 'TSMX:X', 'SST', 'U', 'V', 'O3', + 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', + 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', + 'CH3COCH3', 'CH3OH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', + 'MTERP', 'N2O', 'O3', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', + 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', + 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', + 'C2H2', 'C2H4', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', + 'CH3COOOH', 'CH3OH', 'CH3OOH', 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', + 'CLONO2', 'CLY', 'CO', 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', + 'F', 'GLYALD', 'GLYOXAL', 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', + 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', + 'HOBR', 'HOCL', 'HONITR', 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', + 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', + 'MPAN', 'MTERP', 'MVK', 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', + 'NH4', 'NO', 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'O2', + 'O3', 'OCLO', 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', + 'PHENOOH', 'POOH', 'ROOH', 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', + 'SOAG1', 'SOAG2', 'SOAG3', 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', + 'TERPROD1', 'TERPROD2', 'TOLOOH', 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', + 'NHDEP', 'NDEP', 'ACBZO2', 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', + 'CH3CO3', 'CH3O2', 'DICARBO2', 'e', 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', + 'ISOPAO2', 'ISOPBO2', 'MACRO2', 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'N2D', 'N2p', + 'NOp', 'Np', 'NTERPO2', 'O1D', 'O2_1D', 'O2_1S', 'O2p', 'OH', 'Op', + 'PHENO2', 'PO2', 'RO2', 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', + 'H2O', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', + 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', + 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', + 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', + 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', + 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', + 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', + 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COCH3', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', + 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', + 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', + 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', + 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', + 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', + 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', + 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', + 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', + 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', + 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', + 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', + 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', + 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', + 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', + 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', + 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CO2_CHML', + 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', + 'SOAG4_CHMP', 'IVOC_CHML', 'SVOC_CHML', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'SO2_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', + 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', + 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', + 'OddOx_HOx_Loss', 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', + 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', + 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', + 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', + 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', + 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', + 'soa1_a2', 'soa2_a2', 'soa3_a2', 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', + 'dst_c3', 'ncl_c1', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', + 'so4_c3', 'soa1_c1', 'soa2_c1', 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', + 'soa4_c2', 'soa5_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', + 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', + 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', + 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', + 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', + 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', + 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', + 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', + 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', + 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', + 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', + 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', + 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', + 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', + 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', + 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', + 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', + 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', + 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', + 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', + 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml new file mode 100644 index 0000000000..254d881d8f --- /dev/null +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml @@ -0,0 +1,183 @@ + + + + +20000101 + + +atm/waccm/ic/f.c54137.FXSD.f19_f19.001.cam.i.2000-01-01-00000_c170817.nc + +1.0 + + +atm/cam/solar/spectral_irradiance_Lean_1950-2014_daily_GOME-Mg_Leap_c150623.nc + + +atm/waccm/solar/waxsolar_3hr_c170504.nc + + +atm/waccm/solar/spes_1963-2014_c150717.nc +'Prod'' + + +atm/waccm/gcrs +gcr_prod_NO_1949-2142_c150309.nc + + +.false. +atm/waccm/qbo/qbocoefficients_c151023.nc +.true. + + +atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc +'SERIAL' + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H1202', 'H2402','SF6' + + + +atm/waccm/sulf/sulfate_b.e11.TSREFC2.f19.g16.ccmi23.001_c150908.nc +SERIAL + + +.true. +SERIAL + + +atm/cam/chem/trop_mozart_aero/aero +aero_b.e11.TSREFC2.f19.f19.ccmi23.001_c141030.nc +INTERP_MISSING_MONTHS + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_rcp6.0_monthly_1849-2104_1.9x2.5_c100830.nc +'INTERP_MISSING_MONTHS' +0 + + + + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/CCMI_emissions_aircraft_NO2_1850-2100_1.9x2.5_c130314.nc', + +'SERIAL' + + + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CH2O_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CO_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_NO_1960-2008_1.9x2.5_mol_c130314.nc', + +'INTERP_MISSING_MONTHS' + + +atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20120313.nc +.false. + + 'CH2O = formaldehyde', + 'CO = carbon_monoxide' + + + + 'A', 'I', 'I', 'A', 'A', 'A' + 0, -1, -24, -24, -120, -24 + 1, 24, 7, 7, 10, 365 + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', + 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', + 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', + 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', + 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', + 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', + 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' + + + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' + + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + +0.84 +45. +55. +50. +.true. +'2000/MERRA_19x2_20000101.nc' +atm/cam/met/MERRA +atm/cam/met/MERRA/CCMI_sd_filenames.txt + +42 + + + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa +', + '2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b', + 'O3_Prod = NO_HO2 + CH3O2_NO', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO', + 'RO2_HO2_sum = CH3O2_HO2', + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', + 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + + +0.90D0 +'MONTHLY' + monthly +'ionosphere' +0.3 +0.3 +'' +.true. +-1 +2 +atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc +atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc +1.200D0 +.false. + + diff --git a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml new file mode 100644 index 0000000000..512d95fcc9 --- /dev/null +++ b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml @@ -0,0 +1,110 @@ + + + + +0101 +'atm/cam/chem/ic/f2000_tropbam_soa_alpha03c_chem2_1.9x2.5_L26_0011-01-01-00000_c130328.nc' +'atm/cam/chem/ic/f2000_tropbam_soa_alpha03c_chem2_4x5_L26_0011-01-01-00000_c130328.nc' + + + + 'ISOP = isoprene', + 'CH3OH = methanol', + 'CH3COCH3 = acetone', + 'CH3CHO = acetaldehyde', + 'CH2O = formaldehyde', + 'CO = carbon_monoxide', + 'C2H6 = ethane', + 'C3H8 = propane', + 'C2H4 = ethene', + 'C3H6 = propene', + 'C2H5OH = ethanol', + 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a + 2met_styrene + cymene_p + cymene_o + phellandrene_a + thujene_a + terpinene_a + terpinene_g + terpinolene + phellandrene_b + camphene + bornene + fenchene_a + ocimene_al + ocimene_c_b' + + +'atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20130304.nc' + + + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.SOA_BENZENE.surface.1.9x2.5_c120313.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.BIGALK.surface.1.9x2.5_c110426.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.BIGENE.surface.1.9x2.5_c110426.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C2H2.surface.1.9x2.5_c110426.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C2H4_no_bg.surface.1.9x2.5_c121022.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C2H5OH.surface.1.9x2.5_c110426.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C2H6_no_bg.surface.1.9x2.5_c121022.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C3H6_no_bg.surface.1.9x2.5_c121022.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.C3H8_no_bg.surface.1.9x2.5_c121022.nc', + 'CB1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CB1.surface.1.9x2.5_c110426.nc', + 'CB2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CB2.surface.1.9x2.5_c110426.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH2O.surface.1.9x2.5_c110426.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH3CHO.surface.1.9x2.5_c110426.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH3CN.surface.1.9x2.5_c110426.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH3COCH3.surface.1.9x2.5_c110426.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH3COOH.surface.1.9x2.5_c110426.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CH3OH_no_bg.surface.1.9x2.5_c121022.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.CO_no_bg.surface.1.9x2.5_c121022.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.DMS.surface.1.9x2.5_c110426.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.HCN.surface.1.9x2.5_c110426.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.HCOOH.surface.1.9x2.5_c110426.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.MEK.surface.1.9x2.5_c110426.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.NH3.surface.1.9x2.5_c110426.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.NO.surface.1.9x2.5_c110426.nc', + 'OC1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc', + 'OC2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.SO2.surface.1.9x2.5_c110426.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.SOA_TOLUENE.surface.1.9x2.5_c120313.nc', + 'XYLENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/1992-2010/emissions.SOA_XYLENE.surface.1.9x2.5_c120313.nc' + + +.false. + + +NEU + + + 'AEROD_v', 'AOA1', 'AOA2', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', + 'CO', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O2', 'HNO3_GAS', + 'HNO3_STS', 'HNO3_NAT', 'HNO3', 'HO2', 'HO2NO2', 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', + 'O3', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', + 'T', 'U', 'V', 'Z3', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'CLDLIQ', 'CLDICE', 'CONCLD', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'C2H4', 'C2H6', + 'C2H5O2', 'C2H5OOH', 'CH3CO3', 'CH3COOH', 'CH3CHO', 'C2H5OH', 'GLYALD', 'GLYOXAL', 'CH3COOOH', 'EO2', 'EO', + 'PAN', 'C3H6', 'C3H8', 'C3H7O2', 'C3H7OOH', 'CH3COCH3', 'PO2', 'POOH', 'HYAC', 'RO2', 'CH3COCHO', 'ROOH', + 'BIGENE', 'BIGALK', 'MEK', 'ENEO2', 'MEKO2', 'MEKOOH', 'MCO3', 'MVK', 'MACR', 'MACRO2', 'MACROOH', 'MPAN', 'ONIT', + 'ISOP', 'ALKO2', 'ALKOOH', 'BIGALD', 'HYDRALD', 'ISOPO2', 'ISOPNO3', 'ONITR', 'XO2', 'XOOH', 'CH3CN', 'ISOPOOH', + 'TOLUENE', 'CRESOL', 'TOLO2', 'TOLOOH', 'XOH', 'C10H16', 'TERPO2', 'TERPOOH', 'HCN', + 'C2H2', 'HCOOH', 'HOCH2OO', 'BENZENE', + 'XYLENE', 'LNO_PROD', 'LNO_COL_PROD', 'OC1', 'OC2', 'CB1', 'CB2', 'SO4', 'NH4', 'NH4NO3', 'EOOH', 'SFISOP', + 'SFC10H16', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', + 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFTOLUENE', 'SFCO', 'SFNO', 'SFNO2', 'SFCH2O', + 'SFC2H2', 'SFHCOOH', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3COCH3', 'SFCH3OH', 'SFDMS', 'SFMEK', 'SFNH3', 'SFCB1', + 'SFCB2', 'SFOC1', 'SFOC2', 'SFSO2', 'SFRn', 'SFBENZENE', 'SFXYLENE', 'SFSSLT01', 'SFSSLT02', 'SFSSLT03', + 'SFSSLT04', 'SFDST01', 'SFDST02', 'SFDST03', 'SFDST04', 'MEG_CH3COCH3', 'MEG_CH3CHO', 'MEG_CH2O', + 'MEG_CO', 'MEG_C2H6', 'MEG_C3H8', 'MEG_C2H4', 'MEG_C3H6', 'MEG_C2H5OH', 'MEG_C10H16', 'MEG_ISOP', + 'MEG_CH3OH', 'DTWR_ALKOOH', 'DTWR_C2H5OH', 'DTWR_C2H5OOH', 'DTWR_C3H7OOH', 'DTWR_CH2O', 'DTWR_CH3CHO', + 'DTWR_CH3CN', 'DTWR_CH3COCHO', 'DTWR_CH3COOH', 'DTWR_CH3COOOH', 'DTWR_CH3OH', 'DTWR_CH3OOH', + 'DTWR_EOOH', 'DTWR_GLYALD', 'DTWR_H2O2', 'DTWR_HCN', 'DTWR_HCOOH', 'DTWR_HNO3', 'DTWR_HO2NO2', + 'DTWR_HYAC', 'DTWR_HYDRALD', 'DTWR_ISOPNO3', 'DTWR_ISOPOOH', 'DTWR_MACR', + 'DTWR_MACROOH', 'DTWR_MEKOOH', 'DTWR_MVK', 'DTWR_NH3', 'DTWR_ONIT', 'DTWR_ONITR', 'DTWR_POOH', + 'DTWR_Pb', 'DTWR_ROOH', 'DTWR_SO2', 'DTWR_TERPOOH', 'DTWR_TOLOOH', 'DTWR_XOOH', 'DV_CH3OOH', 'DV_CH2O', + 'DV_CO', 'DV_H2O2', 'DV_CH3COOOH', 'DV_PAN', 'DV_MPAN', 'DV_C2H5OOH', 'DV_ONIT', 'DV_ONITR', 'DV_MACROOH', + 'DV_POOH', 'DV_C3H7OOH', 'DV_ROOH', 'DV_CH3COCHO', 'DV_CH3COCH3', 'DV_XOOH', 'DV_ISOPOOH', 'DV_CH3OH', + 'DV_C2H5OH', 'DV_CH3CHO', 'DV_EOOH', 'DV_GLYALD', 'DV_HYAC', 'DV_HYDRALD', 'DV_ALKOOH', 'DV_MEKOOH', + 'DV_TOLOOH', 'DV_TERPOOH', 'DV_CH3COOH', 'DV_HCN', 'DV_CH3CN', 'DV_HCOOH', 'DV_NO2', 'DV_HNO3', 'DV_NO', + 'DV_HO2NO2', 'DV_DST01', 'DV_DST02', 'DV_DST03', 'DV_DST04', 'DV_SSLT01', 'DV_SSLT02', 'DV_SSLT03', + 'DV_SSLT04', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'O3_CHMP', 'O3_CHML', 'OH_CHML', 'H2O2_CHML', + 'H2O2_CHMP', 'HNO3_CHML', 'HNO3_CHMP', 'CH4_CHML', 'HCN_CHML', 'CO_CHMP', 'CO_CHML', 'N2O_CHML', + 'OC2SFWET', 'OC2WET', 'SO4SFWET', 'SOAISFWET', 'SOATSFWET', 'SOABSFWET', 'SOAXSFWET', 'SOAMSFWET', 'jno2', + 'jpan', 'jh2o2', 'jo3_a', 'DST02', 'DST03', 'DST04', 'ODV_SO4', 'SSLT01', 'SSLT02', 'SSLT03', 'ODV_DST01', + 'ODV_DST02', 'ODV_DST03', 'ODV_DST04', 'ODV_CB1', 'ODV_CB2', 'ODV_OC1', 'ODV_OC2', 'DST01', 'ODV_SSLTA', + 'ODV_SSLTC', 'a2x_DSTWET1', 'a2x_DSTWET2', 'a2x_DSTWET3', 'a2x_DSTWET4', 'SSLT04', 'SSLT01WET', + 'SSLT02WET', 'SSLT03WET', 'SSLT04WET', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX', 'TMSOAM', 'TMSOAI', 'TMSOAT', + 'TMSOAB', 'TMSOAX', 'SOGM', 'SOGI', 'SOGT', 'SOGB', 'SOGX', 'TMSOGM', 'TMSOGI', 'TMSOGT', 'TMSOGB', 'TMSOGX', + 'SOAM', 'SOAM_CHMP', 'SOAI_CHMP', 'SOAT_CHMP', 'SOAB_CHMP', 'SOAX_CHMP', 'SOAM_PROD', 'SOAI_PROD', + 'SOAT_PROD', 'SOAB_PROD', 'SOAX_PROD', 'SOAI_dens', 'SOAT_dens', 'SOAB_dens', 'SOAX_dens', 'SOAM_dens' + + +.true. + + diff --git a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml new file mode 100644 index 0000000000..db29e12cb0 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml @@ -0,0 +1,165 @@ + + + + +'aerosoldep_rcp4.5_monthly_1849-2104_1.9x2.5_c100402.nc' +'SERIAL' + + +atm/cam/solar/spectral_irradiance_Lean_1950-2140_daily_c100804.nc + + +atm/waccm/solar/spe_data_1963-2140_c100823.nc +'Prod' + + +atm/cam/chem/trop_mozart_aero/aero +aero_rcp45_v1_1.9x2.5_L26_1995-2105_c100316.nc +INTERP_MISSING_MONTHS + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_monthly_1849-2006_1.9x2.5_c090803.nc +INTERP_MISSING_MONTHS + +20130101 + yearly + + +0.90D0 + + +atm/waccm/ic/b40.rcp4_5.2deg.wcm.carma.bc5tg.IndPak.002.cam2.i.2013-01-01-00000.nc + + + + + + +atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc +'SERIAL' + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +INTERP_MISSING_MONTHS + + +atm/waccm/sulf/SAD_SULF_1849-2100_1.9x2.5_c090817.nc +'SERIAL' + + +.false. +atm/waccm/qbo/qbocoefficients_c091230.nc' +.true. + + +.true. + + + + +.true. +'SERIAL' +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_RCP45_aircraft_NO2_2000-2100_1.9x2.5.nc +atm/waccm/emis/emis.air.1870.nc + +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CH2O_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CO_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_NOx_2000-2100_1.9x2.5.nc +'SERIAL' + + +atm/waccm/solar/wasolar_1948-2140_daily_c120306.nc + + + + 1, 10, 20, 7, 365 + 0, -240, -240, -24, -24 + 'A', 'I', 'I', 'A', 'A' + + + + 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', + 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', + 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', + 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', + 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', + 'VI', 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', + 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', + 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', + 'SFCH2O','CFC11STAR','TROPP_FD' + + + + + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3BR', 'CF3BR', 'CF2CLBR', + 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', + 'O3', 'O', 'O1D', + 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', + 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', + 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', + 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' + + + + + 'PS:B', 'T:B', 'Z3:B', 'U:B', 'V:B', 'CO:B', 'CO2:B', + 'H2:B', 'O:B', 'O2:B', 'O3:B', 'H:B', 'OH:B', 'HO2:B', 'H2O:B', + 'N:B', 'NO:B', 'NO2:B', 'O1D:B', 'O2_1S:B', 'O2_1D:B', 'N2D:B', + 'Np:B', 'N2p:B', 'Op:B', 'O2p:B', 'NOp:B', 'e:B', 'QRL_TOT:B', + 'QRS_TOT:B', 'QJOULE:B', 'jno3_a:B', 'jno3_b:B', 'jcl2o2:B', 'CL2O2:B', 'CLO:B', + 'BRO:B', 'NO3:B', 'DTCORE:B', 'DTV:B', 'TTGW:B','OMEGA:B' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' + + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + + +1850-2000 + + +.false. +1850 +2008 + +atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2008_c100127.nc +atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2008_c100127.nc + +atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2008_c100128.nc +atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2008_c100128.nc + + +.true. +0 +0 +atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc + + diff --git a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml new file mode 100644 index 0000000000..ae981e3a99 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml @@ -0,0 +1,113 @@ + + + + +00010101 + +1850 + + +atm/waccm/ic/f.e20.FW1850.f09_f09.CESMpiControlForcingSST141.003.veclen64.cam.i.0021-01-01-00000_c170426.nc +atm/waccm/ic/b.e20.BW1850.f19_g17.alpha07b.002.cam.i.1851-01-01-00000_c170911.nc +atm/waccm/ic/b1850.waccm-mam3_4x5_L70.cam2.i.0156-01-01.c141201.nc + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc +18500101 +FIXED + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc +epp_ion_rates + + + +CYCLICAL +1850 +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'H1202', 'OCS', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850_c100204.nc +CYCLICAL + + +.true. +.false. +.false. +atm/waccm/qbo/qbocoefficients_c091230.nc + + + + + +CYCLICAL +1850 + + +CYCLICAL +1850 + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 + 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + + + 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', + 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', + 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', + 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', + 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Lightning', 'QNO', 'QRS_AUR', + 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', 'TTGW', + 'UTGWORO', 'UTGWSPEC', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'HOX', 'NOX', 'NOY', 'CLOX', + 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', + 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', + 'OMEGA_12_COS', 'OMEGA_12_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', + 'PS_12_SIN', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', + 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', + 'TROPP_FD', 'NITROP_PD', 'TROP_P', 'TROP_T', 'TROP_Z', 'SAD_AERO', 'REFF_AERO', + 'AODVISstdn', 'EXTINCTdn', 'EXTxASYMdn', 'AODUVstdn', 'AODNIRstdn', 'AODVISdn', 'MASS', + 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', + 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', + 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', + 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + +.true. +.true. +.true. +.true. +.false. +.false. +.false. +.false. +.false. +.false. + +1850 + + diff --git a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml new file mode 100644 index 0000000000..83b46f457b --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml @@ -0,0 +1,106 @@ + + + + +00010101 + +2000 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +20000101 +FIXED + + +atm/waccm/phot/wa_smax_c100517.nc + + +atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +CYCLICAL +2000 +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'H1202', 'OCS', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc.2000.c100203.nc +CYCLICAL + + +.true. +.false. +.false. +atm/waccm/qbo/qbocoefficients_c091230.nc + + + + + +CYCLICAL +2000 + + +CYCLICAL +2000 + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 + 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + + + 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', + 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', + 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', + 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', + 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Lightning', 'QNO', 'QRS_AUR', + 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', 'TTGW', + 'UTGWORO', 'UTGWSPEC', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'HOX', 'NOX', 'NOY', 'CLOX', + 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', + 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', + 'OMEGA_12_COS', 'OMEGA_12_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', + 'PS_12_SIN', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', + 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', + 'TROPP_FD', 'NITROP_PD', 'TROP_P', 'TROP_T', 'TROP_Z', 'SAD_AERO', 'REFF_AERO', + 'AODVISstdn', 'EXTINCTdn', 'EXTxASYMdn', 'AODUVstdn', 'AODNIRstdn', 'AODVISdn', 'MASS', + 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', + 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', + 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', + 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + +.true. +.true. +.true. +.true. +.false. +.false. +.false. +.false. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml new file mode 100644 index 0000000000..ce53049f42 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml @@ -0,0 +1,103 @@ + + + + +19790101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +'epp_ion_rates' + + +atm/waccm/ic/f.e20.FW1850.f09_f09.CESMpiControlForcingSST141.003.veclen64.cam.i.0021-01-01-00000_c170426.nc +atm/waccm/ic/f.e15.FWmaAMIP.f19_f19.misc08_cam5_4_81.003.cam.i.1980-01-01-00000_c160928.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'H1202', 'OCS', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +'INTERP_MISSING_MONTHS' + + +.true. +.false. +.false. +atm/waccm/qbo/qbocoefficients_c091230.nc + + + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 + 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + + + 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', + 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', + 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', + 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', + 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Lightning', 'QNO', 'QRS_AUR', + 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', 'TTGW', + 'UTGWORO', 'UTGWSPEC', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'HOX', 'NOX', 'NOY', 'CLOX', + 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', + 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', + 'OMEGA_12_COS', 'OMEGA_12_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', + 'PS_12_SIN', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', + 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', + 'TROPP_FD', 'NITROP_PD', 'TROP_P', 'TROP_T', 'TROP_Z', 'SAD_AERO', 'REFF_AERO', + 'AODVISstdn', 'EXTINCTdn', 'EXTxASYMdn', 'AODUVstdn', 'AODNIRstdn', 'AODVISdn', 'MASS', + 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', + 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', + 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', + 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + +.true. +.true. +.true. +.true. +.false. +.false. +.false. +.false. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml b/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml new file mode 100644 index 0000000000..434e30a76c --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml @@ -0,0 +1,97 @@ + + + + +00010101 + + +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +20000101 +FIXED + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_1850-2005_c091112.nc +CYCLICAL +2000 + + +18500101 + yearly + + +0.90D0 + + +atm/waccm/ic/f2000.e10r02.2deg.waccm.005.cam2.i.0017-01-01-00000.nc +atm/waccm/ic/f40.2000.track1.4deg.001.cam2.i.0013-01-01-00000.nc + +atm/waccm/ic/f.e11.FWSC.ne30_ne30.wm_SE.003.cam.i.0006-01-01-00000.nc + + + + + + +'CO2','CH4','N2O','CFC11','CFC12' +atm/waccm/lb/LBC_1765-2005_1.9x2.5_CMIP5_za_c091204.nc +CYCLICAL +2000 + + +.true. +atm/waccm/qbo/qbocyclic28months.nc' +.true. + + +atm/waccm/phot/wa_smax_c100517.nc + + + + 1, 10, 20, 73, 365 + 0, -240, -240, -24, -24 + 'A', 'I', 'I', 'A', 'A' + + + + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', + 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'OCNFRAC', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', + 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', + 'QRL_TOT', 'QRS_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', + 'QNO', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VTGWORO', 'VTGWSPEC', 'Z3', + 'TOTH', + 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', + 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', + 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC', + 'WFRC_O','WFRC_O2','WFRC_O3','WFRC_NO','WFRC_H','WFRC_CO2','WFRC_QRS_TOT' + + + + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', + 'CFC11', 'CFC12', 'CH4', 'N2O', + 'CLDLIQ', 'CLDICE', 'ASDIR' + + + + + 'PS:B', 'T:B', 'Z3:B', 'U:B', 'V:B', + 'QRL_TOT:B', 'QRS_TOT:B', 'DTCORE:B', 'DTV:B', 'TTGW:B','OMEGA:B' + + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' + + + +2000 + + diff --git a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml new file mode 100644 index 0000000000..5828f5ade7 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml @@ -0,0 +1,73 @@ + + + + +19790101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/waccm/ic/f.e20.FWscAMIP.f09_f09.cesm2_0_beta04_compsets.007.GRNLtopo.cam.i.1980-01-01-00000.nc +atm/waccm/ic/f.e15.FWmaAMIP.f19_f19.misc08_cam5_4_81.003.cam.i.1980-01-01-00000_c160928.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc +'SERIAL' +'CO2','CH4','N2O','CFC11eq','CFC12' + + +.true. +.false. +.false. +atm/waccm/qbo/qbocoefficients_c091230.nc + + .true. + + + +SERIAL + +SERIAL + +INTERP_MISSING_MONTHS + +SERIAL + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +.true. +.true. + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 + 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + + + 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', + 'NCTENDICE', 'FQTENDICE', 'MASS' + + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + + + 'BTAUN', 'BTAUS', 'BTAUE', 'BTAUW', 'BTAUNET', 'BUTEND1', 'BUTEND2', 'BUTEND3', 'BUTEND4', 'BUTEND5', 'BVTGWSPEC', + 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', + 'UTEND4', 'UTEND5', 'FRONTGF', 'FRONTGFA', 'EKGW', 'QNO', 'QRLNLTE', 'QRL_TOT', 'DUV', 'DVV', 'TTPXMLC' + + + diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml new file mode 100644 index 0000000000..4f45d4e1d3 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml @@ -0,0 +1,205 @@ + + + + +00010101 + +1850 + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc +18500701 +FIXED + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc +epp_ion_rates + + +cesm2_init/f.e20.FW1850.f09_f09_mg17.265/0021-01-01/f.e20.FW1850.f09_f09_mg17.265.cam.i.0021-01-01-00000.nc +atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +CYCLICAL +1850 +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850_c100204.nc +CYCLICAL + + +.true. +.true. +.true. +.false. + + + + +CYCLICAL +1850 + +CYCLICAL +1850 + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 +'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + +.true. +.false. +.false. +.false. +.false. +.false. +.true. +.true. +.true. + + + + 'CFC11STAR', 'E90', 'ST80_25', 'AOA_NH', 'NH_5', 'NH_50', + 'AODDUST', 'AODDUST2', 'T', 'TSMN:M', 'TSMX:X', 'SST', 'U', 'V', 'O3', + 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', + 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', + 'CH3COCH3', 'CH3OH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', + 'MTERP', 'N2O', 'O3', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', + 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', + 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', + 'C2H2', 'C2H4', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', + 'CH3COOOH', 'CH3OH', 'CH3OOH', 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', + 'CLONO2', 'CLY', 'CO', 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', + 'F', 'GLYALD', 'GLYOXAL', 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', + 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', + 'HOBR', 'HOCL', 'HONITR', 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', + 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', + 'MPAN', 'MTERP', 'MVK', 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', + 'NH4', 'NO', 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'O2', + 'O3', 'OCLO', 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', + 'PHENOOH', 'POOH', 'ROOH', 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', + 'SOAG1', 'SOAG2', 'SOAG3', 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', + 'TERPROD1', 'TERPROD2', 'TOLOOH', 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', + 'NHDEP', 'NDEP', 'ACBZO2', 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', + 'CH3CO3', 'CH3O2', 'DICARBO2', 'e', 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', + 'ISOPAO2', 'ISOPBO2', 'MACRO2', 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'N2D', 'N2p', + 'NOp', 'Np', 'NTERPO2', 'O1D', 'O2_1D', 'O2_1S', 'O2p', 'OH', 'Op', + 'PHENO2', 'PO2', 'RO2', 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', + 'H2O', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', + 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', + 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', + 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', + 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', + 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', + 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', + 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COCH3', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', + 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', + 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', + 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', + 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', + 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', + 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', + 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', + 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', + 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', + 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', + 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', + 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', + 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', + 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', + 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', + 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CO2_CHML', + 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', + 'SOAG4_CHMP', 'IVOC_CHML', 'SVOC_CHML', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'SO2_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', + 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', + 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', + 'OddOx_HOx_Loss', 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', + 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', + 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', + 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', + 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', + 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', + 'soa1_a2', 'soa2_a2', 'soa3_a2', 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', + 'dst_c3', 'ncl_c1', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', + 'so4_c3', 'soa1_c1', 'soa2_c1', 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', + 'soa4_c2', 'soa5_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', + 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', + 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', + 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', + 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', + 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', + 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', + 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', + 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', + 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', + 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', + 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', + 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', + 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', + 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', + 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', + 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', + 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', + 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', + 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', + 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + +1850 + + diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml new file mode 100644 index 0000000000..f4a03cdfa4 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml @@ -0,0 +1,203 @@ + + + + +00010101 + +2000 + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +20000101 +FIXED + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +epp_ion_rates + + +cesm2_init/f.e20.FWHIST.f09_f09_mg17.262a/2000-01-01/f.e20.FWHIST.f09_f09_mg17.262a.cam.i.2000-01-01-00000.nc +atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +CYCLICAL +2000 +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc.2000.c100203.nc +CYCLICAL + + +.true. +.true. +.true. +.false. + + + + +CYCLICAL +2000 + +CYCLICAL +2000 + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 +'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + +.true. +.false. +.false. +.false. +.false. +.false. +.true. +.true. +.true. + + + + 'CFC11STAR', 'E90', 'ST80_25', 'AOA_NH', 'NH_5', 'NH_50', + 'AODDUST', 'AODDUST2', 'T', 'TSMN:M', 'TSMX:X', 'SST', 'U', 'V', 'O3', + 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', + 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', + 'CH3COCH3', 'CH3OH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', + 'MTERP', 'N2O', 'O3', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', + 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', + 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', + 'C2H2', 'C2H4', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', + 'CH3COOOH', 'CH3OH', 'CH3OOH', 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', + 'CLONO2', 'CLY', 'CO', 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', + 'F', 'GLYALD', 'GLYOXAL', 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', + 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', + 'HOBR', 'HOCL', 'HONITR', 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', + 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', + 'MPAN', 'MTERP', 'MVK', 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', + 'NH4', 'NO', 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'O2', + 'O3', 'OCLO', 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', + 'PHENOOH', 'POOH', 'ROOH', 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', + 'SOAG1', 'SOAG2', 'SOAG3', 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', + 'TERPROD1', 'TERPROD2', 'TOLOOH', 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', + 'NHDEP', 'NDEP', 'ACBZO2', 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', + 'CH3CO3', 'CH3O2', 'DICARBO2', 'e', 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', + 'ISOPAO2', 'ISOPBO2', 'MACRO2', 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'N2D', 'N2p', + 'NOp', 'Np', 'NTERPO2', 'O1D', 'O2_1D', 'O2_1S', 'O2p', 'OH', 'Op', + 'PHENO2', 'PO2', 'RO2', 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', + 'H2O', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', + 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', + 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', + 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', + 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', + 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', + 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', + 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COCH3', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', + 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', + 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', + 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', + 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', + 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', + 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', + 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', + 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', + 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', + 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', + 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', + 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', + 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', + 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', + 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', + 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CO2_CHML', + 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', + 'SOAG4_CHMP', 'IVOC_CHML', 'SVOC_CHML', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'SO2_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', + 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', + 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', + 'OddOx_HOx_Loss', 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', + 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', + 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', + 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', + 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', + 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', + 'soa1_a2', 'soa2_a2', 'soa3_a2', 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', + 'dst_c3', 'ncl_c1', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', + 'so4_c3', 'soa1_c1', 'soa2_c1', 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', + 'soa4_c2', 'soa5_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', + 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', + 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', + 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', + 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', + 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', + 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', + 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', + 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', + 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', + 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', + 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', + 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', + 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', + 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', + 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', + 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', + 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', + 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', + 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', + 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml new file mode 100644 index 0000000000..b2285af591 --- /dev/null +++ b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml @@ -0,0 +1,196 @@ + + + + +19900101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc +'epp_ion_rates' + + +cesm2_init/f.e20.FWHIST.f09_f09_mg17.262a/1975-01-03/f.e20.FWHIST.f09_f09_mg17.262a.cam.i.1975-01-03-00000.nc +atm/waccm/ic/f.e15.FWmaAMIP.f19_f19.misc08_cam5_4_81.003.cam.i.1980-01-01-00000_c160928.nc +atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc + + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180227.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc +'INTERP_MISSING_MONTHS' + + +.true. +.true. +.true. +.false. + + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + + + 1, 30, 120, 240, 240, 480, 365, 73, 30 + 0, -24, -6, -3, -1, 1, -24,-120,-240 +'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' + +.true. +.false. +.false. +.false. +.false. +.false. +.true. +.true. +.true. + + + + 'CFC11STAR', 'E90', 'ST80_25', 'AOA_NH', 'NH_5', 'NH_50', + 'AODDUST', 'AODDUST2', 'T', 'TSMN:M', 'TSMX:X', 'SST', 'U', 'V', 'O3', + 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', + 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', + 'CH3COCH3', 'CH3OH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', + 'MTERP', 'N2O', 'O3', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', + 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', + 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', + 'C2H2', 'C2H4', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', + 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', + 'CH3COOOH', 'CH3OH', 'CH3OOH', 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', + 'CLONO2', 'CLY', 'CO', 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', + 'F', 'GLYALD', 'GLYOXAL', 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', + 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', + 'HOBR', 'HOCL', 'HONITR', 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', + 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', + 'MPAN', 'MTERP', 'MVK', 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', + 'NH4', 'NO', 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'O2', + 'O3', 'OCLO', 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', + 'PHENOOH', 'POOH', 'ROOH', 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', + 'SOAG1', 'SOAG2', 'SOAG3', 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', + 'TERPROD1', 'TERPROD2', 'TOLOOH', 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', + 'NHDEP', 'NDEP', 'ACBZO2', 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', + 'CH3CO3', 'CH3O2', 'DICARBO2', 'e', 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', + 'ISOPAO2', 'ISOPBO2', 'MACRO2', 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'N2D', 'N2p', + 'NOp', 'Np', 'NTERPO2', 'O1D', 'O2_1D', 'O2_1S', 'O2p', 'OH', 'Op', + 'PHENO2', 'PO2', 'RO2', 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', + 'H2O', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', + 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', + 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', + 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', + 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', + 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', + 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', + 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COCH3', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', + 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', + 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', + 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', + 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', + 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', + 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', + 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', + 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', + 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', + 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', + 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', + 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', + 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', + 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', + 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', + 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', + 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CO2_CHML', + 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', + 'SOAG4_CHMP', 'IVOC_CHML', 'SVOC_CHML', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', + 'SO2_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', + 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', + 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', + 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_Prod', 'O3_Loss', 'OddOx_Ox_Loss', + 'OddOx_HOx_Loss', 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', 'r_HO2_O3', 'r_OH_O3', + 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', + 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', + 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', + 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', + 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', + 'soa1_a2', 'soa2_a2', 'soa3_a2', 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', + 'dst_c3', 'ncl_c1', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', + 'so4_c3', 'soa1_c1', 'soa2_c1', 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', + 'soa4_c2', 'soa5_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', + 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', + 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', + 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', + 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', + 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', + 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', + 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', + 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', + 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', + 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', + 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', + 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', + 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', + 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', + 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', + 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', + 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', + 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', + 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn' + + + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' + + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', + 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' + + + + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa + MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + '.9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO + .9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO +', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO + HOCH2OO_NO + EO2_NO + C2H5O2_NO + CH3CO3_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ENEO2_NOb + MEKO2_NO + MACRO2_NOa + MACRO2_NOb +', + 'MCO3_NO + ISOPAO2_NO + ISOPBO2_NO + ALKO2_NO + ALKO2_NOb + XO2_NO + TOLO2_NO + PHENO2_NO + C6H5O2_NO + BENZO2_NO + MALO2_NO + BZOO_NO + ACBZO2_NO + DICARBO2_NO +', + 'MDIALO2_NO + XYLOLO2_NO + XYLENO2_NO + TERPO2_NO + TERP2O2_NO + NTERPO2_NO', + 'RO2_NO3_sum = NO3_HO2 + MACRO2_NO3 + MCO3_NO3 + ISOPAO2_NO3 + ISOPBO2_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + HOCH2OO_HO2 + EO2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MEKO2_HO2 + MACRO2_HO2 + ISOPAO2_HO2 + ISOPBO2_HO2 + ALKO2_HO2 +', + 'XO2_HO2 + TOLO2_HO2 + PHENO2_HO2 + C6H5O2_HO2 + BENZO2_HO2 + MALO2_HO2 + BZOO_HO2 + ACBZO2_HO2 + DICARBO2_HO2 + MDIALO2_HO2 + XYLOLO2_HO2 + XYLENO2_HO2 + TERPO2_HO2 +', + 'TERP2O2_HO2 + NTERPO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 +', + ' MCO3_CH3CO3 + MCO3_MCO3 + ISOPAO2_CH3O2 + ISOPBO2_CH3O2 + ISOPAO2_CH3CO3 + ISOPBO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb +', + ' 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b' + + + diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml new file mode 100644 index 0000000000..459aa6e93d --- /dev/null +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -0,0 +1,153 @@ + + + + +00010101 + + +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +20000101 +FIXED + +2000 + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_1850-2005_c091112.nc +CYCLICAL +2000 + + monthly + + + +6 +300 + + +0.90D0 + + +atm/waccm/ic/f_2000_waccmx_cesm1_1_beta08.cam.i.2019-01-01-00000_c140827.nc + +atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc + + + + + + +CYCLICAL +2000 + +atm/waccm/ub/tgcm_ubc.2000.c100203.nc +CYCLICAL + + +CYCLICAL +2000 + + +.true. +atm/waccm/qbo/qbocyclic28months.nc' +.true. + + +.true. + + + + +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc +atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc +CYCLICAL +2000 + + +atm/waccm/phot/wa_smax_quiet_c120118.nc + + + + 1, 8, 1 + 0, -3, -24 + 'A', 'I', 'I' + + + + 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', + 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', + 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', + 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', + 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE','UI','VI','WI', + 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', + 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', + 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', + 'SFCH2O','CFC11STAR','TROPP_FD', 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e' + + + + + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3BR', 'CF3BR', 'CF2CLBR', + 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', + 'O3', 'O', 'O1D', + 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', + 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', + 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', + 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem', + 'O2_1S', 'O2_1D', + 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', + 'UIONTEND', 'VIONTEND', 'UTGWSPEC', 'UTGWORO', 'VTGWSPEC', 'VTGWORO', 'TTGW', + 'DTV', 'DUV', 'DVV', 'EKGW', + 'QJOULE', 'QCP', 'QRL_TOT', 'QRS_TOT', 'UI', 'VI', 'WI' + + + + + 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', + 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', + 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', + 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', + 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', + 'O', 'O1D', 'O2', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', + 'PS', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', + 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', + 'QNO', 'QO3P','QRLNLTE','QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'Qbkgndtot','Qbkgnd_o1','Qbkgnd_o2','Qbkgnd_n2','Qbkgnd_n1','Qbkgnd_no', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', 'TTGW', 'U', + 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', 'O2_1D', 'NOX', 'NOY', + 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UIONTEND', 'VIONTEND', + 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', + 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', + 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'Op', 'O2p', 'Np', 'NOp', + 'N2p', 'e', 'UI', 'VI', 'WI' + + + +2000 + + +'neutral' + + + diff --git a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml new file mode 100644 index 0000000000..dbe93247e0 --- /dev/null +++ b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml @@ -0,0 +1,189 @@ + + + + +00010101 + + +atm/waccm/ic/f.c54137.FX2000climo.f19_f19.ZGTest.001.cam.i.0002-01-01-00000_c170817.nc + +1.0 + + + +atm/cam/solar/spectral_irradiance_Lean_1950-2014_daily_GOME-Mg_Leap_c150623.nc +20000101 +FIXED + + +atm/waccm/phot/wa_avg_c20170519.nc + + +atm/waccm/solar/spes_1963-2014_c150717.nc +'Prod'' + + +atm/waccm/gcrs +gcr_prod_NO_1949-2142_c150309.nc +FIXED +20000101 + +2000 + + +.true. +atm/waccm/qbo/qbocyclic28months.nc +.true. + + +atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc +CYCLICAL +2000 + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H1202', 'H2402','SF6' + + + +atm/waccm/sulf/sulfate_b.e11.TSREFC2.f19.g16.ccmi23.001_c150908.nc +CYCLICAL +2000 + + +CYCLICAL +2000 + + +.true. + + +atm/cam/chem/trop_mozart_aero/aero +aero_b.e11.TSREFC2.f19.f19.ccmi23.001_c141030.nc +CYCLICAL +2000 + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_rcp6.0_monthly_1849-2104_1.9x2.5_c100830.nc +CYCLICAL +2000 + + + + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/CCMI_emissions_aircraft_NO2_1850-2100_1.9x2.5_c130314.nc', + +CYCLICAL +2000 + + + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CH2O_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_CO_woBiog_1960-2008_1.9x2.5_mol_c130314.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1960-2008/maccity_maccity_corrdates_NO_1960-2008_1.9x2.5_mol_c130314.nc', + +CYCLICAL +2000 + + +atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20120313.nc +.false. + + 'CH2O = formaldehyde', + 'CO = carbon_monoxide' + + + + 'A', 'I', 'I', 'A', 'A', 'A' + 0, -1, -24, -24, -120, -24 + 1, 24, 7, 7, 10, 365 + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', + 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', + 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', + 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', + 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', + 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', + 'Z3GM', 'OpDens', 'EDens' + + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', + 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' + + + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', + 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' + + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + +42 + + + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa +', + '2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b', + 'O3_Prod = NO_HO2 + CH3O2_NO', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3', + 'RO2_NO_sum = NO_HO2 + CH3O2_NO', + 'RO2_HO2_sum = CH3O2_HO2', + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', + 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + + +0.90D0 +'MONTHLY' + monthly +'ionosphere' +0.3 +0.3 +'' +.true. +-1 +2 +atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc +atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc +1.200D0 +.false. + + diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm new file mode 100644 index 0000000000..3584b98be0 --- /dev/null +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -0,0 +1,313 @@ +package Build::ChemNamelist; + +#------------------------------------------------------------------------------------- +# generates species lists for chemistry namelist settings +#------------------------------------------------------------------------------------- +# Date Contributor Modification +#------------------------------------------------------------------------------------- +# 26 Jan 2011 Francis Vitt Created +#------------------------------------------------------------------------------------- +#------------------------------------------------------------------------------------- + +use strict; +use Exporter; +use FindBin qw($Bin); +use lib "$Bin/perl5lib"; +use Build::ChemPreprocess qw(get_species_list); + +our @ISA = qw(Exporter); +our @EXPORT = qw(set_dep_lists set_aero_modes_info chem_has_species); +our $VERSION = 1.00; + +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub chem_has_species +{ + my ( $cfg, $species ) = @_; + my $chem_proc_src = $cfg->get('chem_proc_src'); + my $chem_src_dir = $cfg->get('chem_src_dir'); + my @species_list; + if ($chem_proc_src) { + @species_list = get_species_list($chem_proc_src); + } else { + @species_list = get_species_list($chem_src_dir); + } + my %hash; + @hash{@species_list}=(); + + return ( exists $hash{$species} ); + +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub set_dep_lists +{ + my ( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print_lvl ) = @_; + + my ( $gas_wetdep_list, $aer_wetdep_list, $aer_drydep_list, $aer_sol_facti, $aer_sol_factb, + $aer_scav_coef, $gas_drydep_list ) ; + + my @species_list ; + if ($chem_proc_src) { + if (defined $ENV{CASEBUILD}) { + #needed to expand $CASEBUILD in $chem_proc_src for CESM scripts + my $root = $ENV{CASEBUILD}; + $chem_proc_src =~ s/\$CASEBUILD/$root/; + } + @species_list = get_species_list($chem_proc_src); + } else { + if (defined $ENV{CODEROOT}) { + #needed to expand $CODEROOT in $chem_src_dir for CESM scripts + my $root = $ENV{CODEROOT}; + $chem_src_dir =~ s/\$CODEROOT/$root/; + } + @species_list = get_species_list($chem_src_dir); + } + if ($print_lvl>=2) {print "Chemistry species : @species_list \n" ;} + + $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, @species_list ); + + $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, @species_list ); + + $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, @species_list ); + + $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, @species_list ); + + # set solubility factors for aerosols + if (length($aer_wetdep_list)>2){ + my @values = split(',', $aer_wetdep_list); + my $first = 1; my $pre = ""; + foreach my $val (@values){ + $val =~ tr/'//d; + my $sol_facti; + my $sol_factb; + if ($val =~ /DST/) { + $sol_facti = $nl->get_value('dust_sol_facti'); + if (!defined $sol_facti) { $sol_facti = 0.3; } + $sol_factb = $nl->get_value('dust_sol_factb'); + if (!defined $sol_factb) { $sol_factb = 0.3; } + } elsif ($val =~ /SSLT/) { + $sol_facti = $nl->get_value('sslt_sol_facti'); + if (!defined $sol_facti) { $sol_facti = 0.3; } + $sol_factb = $nl->get_value('sslt_sol_factb'); + if (!defined $sol_factb) { $sol_factb = 0.3; } + } else { + $sol_facti = $nl->get_value(${val}.'_sol_facti'); + if (!defined $sol_facti) { $sol_facti = 0.3; } + $sol_factb = $nl->get_value(${val}.'_sol_factb'); + if (!defined $sol_factb) { $sol_factb = 0.3; } + } + $aer_sol_facti .= $pre . $sol_facti ; + $aer_sol_factb .= $pre . $sol_factb ; + + my $scav_coef = $nl->get_value(${val}.'_scav_coef'); + if (!defined $scav_coef) { + if ($val =~ /DST03/ or $val =~ /DST04/) { $scav_coef = 0.3; } + else { $scav_coef = 0.1; } + } + $aer_scav_coef .= $pre . $scav_coef ; + + if ($first) { $pre = ","; $first = 0; } + } + } + + return ( $gas_wetdep_list, $aer_wetdep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, + $aer_drydep_list, $gas_drydep_list ); +} + +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub set_aero_modes_info +{ + my ( $cfg, $data_src, $print_lvl, $mode_types, $modal_species, $modal_groups, + $mode_spec_type, $mode_spec, $mode_spec_cw, $mode_spec_src ) = @_; + + my $chem_proc_src = $cfg->get('chem_proc_src'); + my $chem_src_dir = $cfg->get('chem_src_dir'); + my @species_list; + if ($chem_proc_src) { + @species_list = get_species_list($chem_proc_src); + } else { + @species_list = get_species_list($chem_src_dir); + } + + my %mymodal_species = %$modal_species; + my $nmodes = scalar(@$mode_types); + my $found_modal_species = 0; + + for (my $i = 1; $i <= $nmodes; $i++) { + my @type ; + my @spec ; + my @spec_cw ; + my @src ; + my $modal_species = 0; + my @species = @{ $$modal_groups{ @$mode_types[$i-1] } } ; + foreach my $spc (@species) { + if ($data_src eq 'A') { + foreach my $tracer (@species_list) { + if ($tracer =~ /^${spc}.*_a${i}$/) { + $found_modal_species = 1; + push @spec, $tracer ; + push @src , $data_src ; + my $tracer_cw = $tracer; $tracer_cw =~ s/_a/_c/g; + push @spec_cw, $tracer_cw; + push @type, $mymodal_species{$spc}; + } + } + } else { # for prescribed modal aerosols do not check against the species list .... + my $tracer = ${spc}.'_a'.${i}; + $found_modal_species = 1; + push @spec, $tracer ; + push @src , $data_src ; + my $tracer_cw = $tracer; $tracer_cw =~ s/_a/_c/g; + push @spec_cw, $tracer_cw; + push @type, $mymodal_species{$spc}; + } + } + if ($found_modal_species) { + push @$mode_spec, [ @spec ]; + push @$mode_spec_cw, [ @spec_cw ]; + push @$mode_spec_type, [ @type ]; + push @$mode_spec_src, [ @src ]; + } + } + + if ($print_lvl>=2) { print_modal_info( "mode_spec", @$mode_spec ); } + if ($print_lvl>=2) { print_modal_info( "mode_spec_cw", @$mode_spec_cw ); } + if ($print_lvl>=2) { print_modal_info( "mode_spec_type", @$mode_spec_type ); } + if ($print_lvl>=2) { print_modal_info( "mode_spec_src", @$mode_spec_src ); } + + return ; +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub print_modal_info +{ + my ( $string, @array ) = @_; + print "-------------------------------------------------------------------\n"; + print "$string :\n"; + foreach my $row (@array) { + print " "; + foreach my $item (@$row) { + print $item, " "; + } + print "\n"; + } + print "-------------------------------------------------------------------\n"; +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub get_gas_drydep_list +{ + my ($cfg_dir,$print_lvl,@species_list) = @_; + + my $master_file = "$cfg_dir/namelist_files/master_gas_drydep_list.xml"; + + my $list = get_dep_list($master_file,$print_lvl,@species_list); + + if ($print_lvl>=2) {print " dry dep list : $list \n" ;} + + return ($list); +} + +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub get_aer_drydep_list +{ + my ($cfg_dir,$print_lvl,@species_list) = @_; + + my $master_file = "$cfg_dir/namelist_files/master_aer_drydep_list.xml"; + + my $list = get_dep_list($master_file,$print_lvl,@species_list); + + if ($print_lvl>=2) {print " aer drydep list : $list \n" ;} + return ($list); +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub get_aer_wetdep_list +{ + my ($cfg_dir,$print_lvl,@species_list) = @_; + + my $master_file = "$cfg_dir/namelist_files/master_aer_wetdep_list.xml"; + + my $list = get_dep_list($master_file,$print_lvl,@species_list); + + if ($print_lvl>=2) {print " aer wet dep list : $list \n" ;} + return ($list); +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub get_gas_wetdep_list +{ + my ($cfg_dir,$print_lvl,@species_list) = @_; + + my $master_file = "$cfg_dir/namelist_files/master_gas_wetdep_list.xml"; + + my $list = get_dep_list($master_file,$print_lvl,@species_list); + + if ($print_lvl>=2) {print " gas wet dep list : $list \n" ;} + + return ($list); +} +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub get_dep_list +{ + my ($master_file,$print_lvl,@species_list) = @_; + + if ($print_lvl>=2){ print "Using chemistry master list file $master_file \n"; } + + my @master_list = read_master_list_file($master_file); + + my $list = ''; + my $first = 1; my $pre = ""; + foreach my $name (sort @species_list) { + foreach my $item (@master_list) { + if ($name eq $item) { + $list .= $pre . quote_string($name) ; + if ($first) { $pre = ","; $first = 0; } + } + } + } + + if ( length($list)<1 ) {$list = quote_string(' ') ;} + + return ($list); +} + +#------------------------------------------------------------------------------- +sub read_master_list_file +{ + my ($master_file) = @_; + + require XML::Lite; + + my @master_list ; + my $xml = XML::Lite->new($master_file); + my $root = $xml->root_element(); + my @children = $root->get_children(); + foreach my $child (@children) { + my $content = $child->get_content(); + my @list = split( ('\s+|\s*,+\s*') ,$content); + foreach my $item (@list) { + if ( length( $item) > 0 ){ + push ( @master_list, $item ); + } + } + } + + return (@master_list); +} +#------------------------------------------------------------------------------- + +sub quote_string { + my $str = shift; + $str =~ s/^\s+//; + $str =~ s/\s+$//; + unless ($str =~ /^['"]/) { #"' + $str = "\'$str\'"; + } + return $str; +} +1; # to appease require diff --git a/bld/perl5lib/Build/ChemPreprocess.pm b/bld/perl5lib/Build/ChemPreprocess.pm new file mode 100644 index 0000000000..a514d3a7dc --- /dev/null +++ b/bld/perl5lib/Build/ChemPreprocess.pm @@ -0,0 +1,618 @@ +package Build::ChemPreprocess; +#------------------------------------------------------------------------------------- +# ($chem_nadv) = chem_preprocess( $cfg_ref, $prnt_lvl, $fc_type ) +# +# This routine does the following: +# - Invokes the chemistry preprocessor +# - Checks consistency of configure options +# - Determines the number of transported chemical tracers +# - Sets the chemistry CPP definitions +# +# Date Contributor Modification +#------------------------------------------------------------------------------------- +# 19 Sep 2008 Francis Vitt Created +# 23 Oct 2009 Francis Vitt moved to perl5lib/Build directory +# renamed to ChemPreprocess.pm and implemented as a module +#------------------------------------------------------------------------------------- + +use strict; +use Exporter; +use File::Copy; +use File::Compare; + +our @ISA = qw(Exporter); +our @EXPORT = qw(chem_preprocess chem_number_adv get_species_list); +our $VERSION = 1.00; + +my $print ; + +sub chem_preprocess +{ + my ($cfg_ref,$prnt_lvl,$fc_type) = @_; + + $print = $prnt_lvl; + + my $chem_nadv = 0; + + my $edit_chem_mech = $cfg_ref->get('edit_chem_mech'); + my $usr_mech_infile = $cfg_ref->get('usr_mech_infile'); + my $prog_species = $cfg_ref->get('prog_species'); + my $chem_pkg = $cfg_ref->get('chem'); + my $cam_root = $cfg_ref->get('cam_root'); + my $cam_bld = $cfg_ref->get('cam_bld'); + my $chem_proc_src = $cfg_ref->get('chem_proc_src'); + my $force_build = $cfg_ref->get('build_chem_proc'); + + if (defined $ENV{CASEBUILD}) { + #needed to expand $CASEBUILD in $chem_proc_src for CESM scripts + my $root = $ENV{CASEBUILD}; + $chem_proc_src =~ s/\$CASEBUILD/$root/; + } + + my $chem_proc_bld = "$cam_bld/chem_proc"; + + my $chem_preprocessor = "$cam_root/components/cam/chem_proc"; + + my $chem_mech_infile; + + if ($print>=2){ print "chem_preprocess: prog_species = $prog_species \n"; } + if ($print>=2){ print "chem_preprocess: chem_pkg = $chem_pkg \n"; } + if ($print>=2){ print "chem_preprocess: usr_mech_infile = $usr_mech_infile \n"; } + if ($print>=2){ print "chem_preprocess: edit_chem_mech = $edit_chem_mech \n"; } + + if ($prog_species) { + if ($chem_pkg =~ /"mozart"/) { + die "ERROR: -prog_species $prog_species is NOT allowed with -chem $chem_pkg \n"; + } + if ($usr_mech_infile) { + die "ERROR: -prog_species $prog_species is NOT allowed with -usr_mech_infile $usr_mech_infile \n"; + } + } + if (!$chem_pkg) { + if ($usr_mech_infile) { + die "ERROR: -usr_mech_infile $usr_mech_infile is NOT allowed without -chem option. \n"; + } + } + + # create chem proc directory tree + my $cmd = "mkdir -p $chem_proc_bld/tmp"; + run_shell_command($cmd) or die "Failed: $cmd"; + my $cmd = "mkdir -p $chem_proc_bld/obj"; + run_shell_command($cmd) or die "Failed: $cmd"; + + if (!$usr_mech_infile) { + if ($prog_species) { + if ($usr_mech_infile) { + die "ERROR: *** Cannot specify usr_mech_infile with prog_species *** \n" ; + } + $usr_mech_infile = "$chem_proc_bld/chem_mech.in"; + write_chem_preproc($usr_mech_infile, $cfg_ref, $chem_preprocessor , $chem_proc_bld); + } else { + $usr_mech_infile = "$cam_root/components/cam/src/chemistry/pp_${chem_pkg}/chem_mech.in"; + } + } + + if ($edit_chem_mech) { + edit_chem_preproc($usr_mech_infile); + } + + $chem_mech_infile = "$chem_proc_bld/chem_mech.inp"; + write_chem_mech($usr_mech_infile, $chem_mech_infile, $chem_preprocessor , $chem_proc_bld ); + + $cfg_ref->set('chem_proc_bld', $chem_proc_bld); + + my $chem_proc_exe = "campp"; + + my $needtorun = 1; + if ( -e "$cam_bld/chem_mech.in") { + $needtorun = compare("$usr_mech_infile","$cam_bld/chem_mech.in"); + } + if ($needtorun or $force_build) { + my $proc_exe_path ; + if ( -e "$chem_preprocessor/$chem_proc_exe" ) { + $proc_exe_path = "$chem_preprocessor/$chem_proc_exe" ; + } else { + $proc_exe_path = "$chem_proc_bld/$chem_proc_exe" ; + } + if ($force_build) { unlink($proc_exe_path); } + if (! -e $proc_exe_path) { + my $gmake = 'gmake'; + build_chem_preproc($gmake,$chem_preprocessor ,$chem_proc_bld,$chem_proc_exe,$fc_type); + # attempt to copy to public location + copy( "$chem_proc_bld/$chem_proc_exe", $chem_preprocessor ); + if ( -e "$chem_preprocessor/$chem_proc_exe" ) { + chmod 0555, "$chem_preprocessor/$chem_proc_exe"; + if ($print) { print "creating $chem_preprocessor/$chem_proc_exe \n"; } + } + } + + run_chem_preproc($chem_proc_bld,$proc_exe_path,$chem_mech_infile,$chem_proc_src,$cam_bld); + + copy( $usr_mech_infile,"$cam_bld/chem_mech.in") or die "copy failed $! \n"; + copy( "$chem_proc_bld/chem_mech.doc" ,$cam_bld) or die "copy failed $! \n"; + } + + return (chem_number_adv($chem_proc_src)); +} +sub chem_number_adv +{ + + my ($chem_proc_src) = @_; + + my $chem_nadv = 0; + # determine the number of transported chemical tracers + open INPUT, "$chem_proc_src/chem_mods.F90"; + while ( my $line = ) { + if ( $line =~ m/gas_pcnst\s*=/ ) { + if($line =~ m/(\d+)/) { # extract the number of chem species + $chem_nadv += $1; + if ($print>=2) { print "total number of chemical species = $chem_nadv \n"; } + } else { + die "**** Not able to determine total number of chemical species ****\n"; + } + } + if ( $line =~ /nslvd\s*=/ ) { + if($line =~ m/(\d+)/) { # extract the number of chem species + $chem_nadv = $chem_nadv - $1; + if ($print>=2) { print "number of short-lived chemical species = $1 \n"; } + if ($print>=2) { print "number of transported chemical species = $chem_nadv \n"; } + } else { + die "**** Not able to determine number of short-lived species ****\n"; + } + } + } + close INPUT; + + my $chem_nwat = 0; + + my @species = get_species_list($chem_proc_src); + foreach my $tracer (@species) { + if ( $tracer eq 'H2O' ) { + $chem_nwat = 1; + } + } + + if ($print>=2) { print "number of water vapor species = $chem_nwat \n"; } + $chem_nadv -= $chem_nwat ; + + if ($print>=2) { print "Number of chem adv tracers: $chem_nadv \n"; } + + return ($chem_nadv); +} + +#----------------------------------------------------------------------------------------------- +# Utility routines +#----------------------------------------------------------------------------------------------- + +sub get_species_list +{ + my ($chem_src_dir) = @_; + + if (! -e $chem_src_dir ) { + die "**** ERROR ****\n ChemPreprocess::get_species_list cannot find $chem_src_dir \n"; + } + + my @species_list ; + + my $end_of_rec = $/; + $/ = "/)"; + + open INPUT, "$chem_src_dir/mo_sim_dat.F90"; + + while ( my $data = ) { + if ( $data =~ /\s*solsym\(:/ ) { + chomp $data ; + + my @list = split( /\//, $data ); + my @spec_list = split( /\W+/, @list[ $#list ] ); + foreach my $item (@spec_list) { + if ( length($item) > 0 ){ + push ( @species_list, $item ); + } + } + + } + } + close INPUT; + $/ = $end_of_rec; + + return ( @species_list ); +} + +sub run_shell_command { + + my ($cmd) = @_; + + if ($print>=2) { print "cmd = $cmd\n";} + + my @out = `$cmd`; + my $cmd_error = $? ; #CHILD_ERROR; + foreach my $i (@out) { + if ($print>=2) { print "$i";} + if ($cmd_error || $i =~ /abort/ || $i =~ /Failed/ ) { + #die "**** FAILED ****\n$i\n"; + return 0; + } + } + return 1; +} + +#----------------------------------------------------------------------------------------------- + +sub edit_chem_preproc +{ + my ($chem_proc_inp) = @_; + my $cam_chem_editor = 'vi'; + + if ($print>=2) { print "edit chemistry mechanism file.... \n";} + + if (defined $ENV{CAMCHEM_EDITOR}) { + $cam_chem_editor = $ENV{CAMCHEM_EDITOR}; + } + + my $command = "$cam_chem_editor $chem_proc_inp"; + + my $status = system("$command"); + if (($status >>=8) != 0) { + die "Failed to run $command"; + } + + if ($print>=2) { print "edit chemistry mechanism file complete. \n";} +} + +#----------------------------------------------------------------------------------------------- + +sub run_chem_preproc +{ + my ($chem_proc_bld,$chem_proc_exe,$chem_proc_inp,$src_dir,$cam_bld) = @_; + + if ($print>=2) { print "run_chem_preproc.... \n";} + + # clean out old version + my $cmd = "rm -rf $src_dir $chem_proc_bld/cam.subs.tar"; + run_shell_command($cmd); + # run chem preprocessor + my $cmd = "$chem_proc_exe $chem_proc_inp 2>&1"; + run_shell_command($cmd) or die " *** Chem preprocessor FAILED.\n See: $chem_proc_bld/chem_mech.doc \n" ; + + if ($print) { print "creating $src_dir\n"; } + + # create dir to for new code + my $cmd = "mkdir -p $src_dir"; + run_shell_command($cmd) or die "Failed: $cmd"; + + # extract new code from tar file + my $cmd = "cd $src_dir && tar -xf $chem_proc_bld/cam.subs.tar"; + run_shell_command($cmd) or die "Failed: $cmd"; + + # remove some garbage files produced when compiled with gfortran on hobart + my $cmd = "rm -f $src_dir/.F90 $src_dir/mo_.F90 "; + run_shell_command($cmd) or die "Failed: $cmd"; + + if ($print>=2) { print "run_chem_preproc complete\n"; } +} + +#----------------------------------------------------------------------------------------------- + +sub build_chem_preproc +{ + my ($gmake,$chem_proc_src,$chem_proc_bld,$chem_proc_exe,$fc_type) = @_; + + if ($print) { print "creating $chem_proc_bld/$chem_proc_exe ...\n"; } + if ($print>=2) { + print " **************************************************** \n"; + print " ** arg fc_type = $fc_type \n"; + print " **************************************************** \n"; + } + + $ENV{'MODEL_EXEDIR'} = "$chem_proc_bld"; + $ENV{'EXENAME'} = "$chem_proc_exe"; + $ENV{'SRCLIST'} = "$chem_proc_src/src/Base_Srclist_f"; + $ENV{'SRCDIRS'} = "$chem_proc_src/src/cam_chempp"; + $ENV{'OBJ_DIR'} = "$chem_proc_bld/obj"; + + my $cmplr; + if (!$fc_type) { + die " ERROR: build_chem_preproc: configure arg fc_type must be specified\n". + " to build the chemistry preprocessor"; + } + + if ($fc_type eq 'pgi') { $cmplr = 'pgf90'; } + elsif ($fc_type eq 'intel') { $cmplr = 'ifort'; } + elsif ($fc_type eq 'gnu') { $cmplr = 'gfortran'; } + elsif ($fc_type eq 'ibm') { $cmplr = 'xlf95'; } + + # check path for $cmplr + my $check = check_preproc_compiler($cmplr); + + if ($cmplr and $check == 1) { + if ($print>=2) { + print " **************************************************** \n"; + print " ** user specified compiler : $fc_type --> $cmplr\n"; + print " **************************************************** \n"; + } + $ENV{'USER_FC'} = $cmplr ; + } else { + if ($print>=2) { + print " **************************************************** \n"; + print " ** $cmplr does not seem to be in PATH \n"; + print " ** try to find a suitable compiler ....\n"; + } + # try to find a suitable compiler + my $cmplr = find_preproc_compiler(); + if ($print>=2) { + print " ** found : $cmplr \n"; + print " **************************************************** \n"; + } + if ($cmplr) { + $ENV{'USER_FC'} = $cmplr ; + } else { + die "** Not able to find fortran compiler for chemistry preprocessor ** \n"; + } + } + if ($print) { + print " **************************************************** \n"; + print " ** chemistry preprocessor fortran compiler :\n"; + print " ** env var USER_FC = $ENV{'USER_FC'} \n"; + print " **************************************************** \n"; + } + my $log_file = "$chem_proc_bld/MAKE.out"; + my $makefile = "$chem_proc_src/src/Makefile"; + my $cmd = "$gmake -f $makefile > $log_file 2>&1"; + run_shell_command($cmd) or die "Failed: $cmd"; + + # do some clean up + my $cmd = "rm -f $chem_proc_bld/obj/*.o $chem_proc_bld/obj/*.mod $chem_proc_bld/../*.mod"; + run_shell_command($cmd); + + if ($print>=2) { print "build_chem_preproc complete\n"; } +} + +#----------------------------------------------------------------------------------------------- + +sub write_chem_mech +{ + + my ($file_in, $chem_proc_file, $proc_src, $proc_bld) = @_; + + my $fh_in = new IO::File; + my $fh_out = new IO::File; + + if ($print) { print "creating $chem_proc_file\n"; } + + $fh_out->open(">$chem_proc_file") or die "** can't open chem preprocessor input file: $chem_proc_file\n"; + +print $fh_out <<"EOF"; + +BEGSIM +output_unit_number = 7 +output_file = chem_mech.doc +temp_path = $proc_bld/tmp/ +procout_path = $proc_bld/ +output_path = $proc_bld/ +src_path = $proc_src/bkend/ +procfiles_path = $proc_src/procfiles/cam/ +sim_dat_path = $proc_bld/ +sim_dat_filename = chem_mech.dat + +EOF + + # Copy the chemistry mechanism. + $fh_in->open("<$file_in") or die "** can't open file: $file_in\n"; + while (<$fh_in>) { + print $fh_out $_; + } + $fh_in->close; + +print $fh_out <<"EOF"; + +ENDSIM + +EOF + + $fh_out->close; +} + +#----------------------------------------------------------------------------------------------- +# searches $PATH for available compiler for the preprocessor +sub find_preproc_compiler { + # these are the compilers the preprocessor Makefile is setup for : + my @compilers = qw(xlf95 pgf90 pgf95 ifort gfortran g95 f90 f95); + my $path = $ENV{'PATH'}; + my @dirs = split(':',$path); + foreach my $fc (@compilers) { + foreach my $dir (@dirs) { + if ( -e "$dir\/$fc" ) { return $fc; } + } + } +} +#----------------------------------------------------------------------------------------------- +# checks for specified compiler in $PATH +sub check_preproc_compiler { + my ($fc) = @_; + + my $path = $ENV{'PATH'}; + my @dirs = split(':',$path); + foreach my $dir (@dirs) { + if ( -e "$dir\/${fc}" ) { return 1; } + } + return 0; +} + +#----------------------------------------------------------------------------------------------- + +sub write_chem_preproc +{ + + my ($chem_proc_file, $cfg_ref, $proc_src, $proc_bld) = @_; + + my $prog_species = $cfg_ref->get('prog_species'); + my $fh = new IO::File; + + if ($print) { print "creating $chem_proc_file\n"; } + + $fh->open(">$chem_proc_file") or die "** can't open chem preprocessor input file: $chem_proc_file\n"; + +print $fh <<"EOF"; + +Comments + "This is a CAM simulation with : $prog_species" +End Comments + + SPECIES + + Solution +EOF + + if ( $prog_species =~ /SO4/ ) { + print $fh " H2O2, SO2, SO4, DMS -> CH3SCH3\n"; + } + if ( $prog_species =~ /OC/ ) { + print $fh " OC1 -> C, OC2 -> C\n"; + } + if ( $prog_species =~ /BC/ ) { + print $fh " CB1 -> C, CB2 -> C\n"; + } + if ( $prog_species =~ /GHG/ ) { + print $fh " CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2, H2O\n"; + } + if ( $prog_species =~ /SSLT/ ) { + print $fh " SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl\n"; + } + if ( $prog_species =~ /DST/ ) { + print $fh " DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5\n"; + } + if ( $prog_species =~ /CARBON16/ ) { + print $fh " OFPHO -> C, BFPHO -> C, OBPHO -> C, BBPHO -> C \n"; + print $fh " OOPHO -> C, BOPHO -> C, NOPHO -> C, MMPHO -> C \n"; + print $fh " OFPHI -> C, BFPHI -> C, OBPHI -> C, BBPHI -> C \n"; + print $fh " OOPHI -> C, BOPHI -> C, NOPHI -> C, MMPHI -> C \n"; + } + +print $fh <<"EOF"; + End Solution + + Fixed + M, N2, O2, H2O +EOF + if ( $prog_species =~ /SO4/ ) { + print $fh " O3, OH, NO3, HO2\n"; + } +print $fh <<"EOF"; + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit +EOF + if ( $prog_species =~ /SO4/ ) { + print $fh " H2O2, SO2, SO4, DMS\n"; + } + if ( $prog_species =~ /CARBON16/ ) { + print $fh " OFPHO,BFPHO,OBPHO,BBPHO,OOPHO,BOPHO,NOPHO,MMPHO \n"; + print $fh " OFPHI,BFPHI,OBPHI,BBPHI,OOPHI,BOPHI,NOPHI,MMPHI \n"; + } + if ( $prog_species =~ /BC/ ) { + print $fh " CB1, CB2\n"; + } + if ( $prog_species =~ /OC/ ) { + print $fh " OC1, OC2\n"; + } + if ( $prog_species =~ /GHG/ ) { + print $fh " CH4, N2O, CFC11, CFC12, H2O\n"; + } + if ( $prog_species =~ /SSLT/ ) { + print $fh " SSLT01, SSLT02, SSLT03, SSLT04\n"; + } + if ( $prog_species =~ /DST/ ) { + print $fh " DST01, DST02, DST03, DST04\n"; + } +print $fh <<"EOF"; + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis +EOF + if ( $prog_species =~ /SO4/ ) { + print $fh " [jh2o2] H2O2 + hv -> 2*OH \n"; + } +print $fh <<"EOF"; + End Photolysis + + Reactions +EOF + if ( $prog_species =~ /SO4/ ) { + print $fh " [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 \n"; + print $fh " H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 \n"; + print $fh " [usr_SO2_OH] SO2 + OH -> SO4 \n"; + print $fh " DMS + OH -> SO2 ; 9.6e-12,-234. \n"; + print $fh " [usr_DMS_OH] DMS + OH -> .5 * SO2 \n"; + print $fh " DMS + NO3 -> SO2 ; 1.9e-13, 520. \n"; + } + if ( $prog_species =~ /CARBON16/ ) { + print $fh " OFPHO -> OFPHI ; 1.006e-05 \n"; + print $fh " BFPHO -> BFPHI ; 1.006e-05 \n"; + print $fh " OBPHO -> OBPHI ; 1.006e-05 \n"; + print $fh " BBPHO -> BBPHI ; 1.006e-05 \n"; + print $fh " OOPHO -> OOPHI ; 1.006e-05 \n"; + print $fh " BOPHO -> BOPHI ; 1.006e-05 \n"; + print $fh " NOPHO -> NOPHI ; 1.006e-05 \n"; + print $fh " MMPHO -> MMPHI ; 1.006e-05 \n"; + } + if ( $prog_species =~ /BC/ ) { + print $fh " CB1 -> CB2 ; 1.006e-05 \n"; + } + if ( $prog_species =~ /OC/ ) { + print $fh " OC1 -> OC2 ; 1.006e-05 \n"; + } + if ( $prog_species =~ /GHG/ ) { + print $fh " [ch4_loss] CH4 -> 2.* H2O\n"; + print $fh " [n2o_loss] N2O -> \n"; + print $fh " [cfc11_loss] CFC11 -> \n"; + print $fh " [cfc12_loss] CFC12 -> \n"; + print $fh " [lyman_alpha] H2O -> \n"; + } +print $fh <<"EOF"; + End Reactions + + Ext Forcing +EOF + if ( $prog_species =~ /SO4/ ) { + print $fh " SO2 <- dataset\n"; + print $fh " SO4 <- dataset\n"; + } +print $fh <<"EOF"; + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS + +EOF + + $fh->close; +} + + +1; # to appease require diff --git a/bld/perl5lib/Build/Config.pm b/bld/perl5lib/Build/Config.pm new file mode 100644 index 0000000000..f5a38505d8 --- /dev/null +++ b/bld/perl5lib/Build/Config.pm @@ -0,0 +1,437 @@ +package Build::Config; +#----------------------------------------------------------------------------------------------- +# +# SYNOPSIS +# +# use Build::Config; +# +# # read the configuration definition and defaults xml files. +# my $cfg = Build::Config->new("config_definition.xml", "config_setup.xml"); +# +# # set configuration parameters +# $cfg->set('dyn', 'fv'); +# $cfg->set('hgrid', '2x2.5'); +# +# # query configuration parameters +# my $exe = $cfg->get('cam_exe'); +# +# # write a configuration cache file +# $cfg->write_file("config_cache.xml", "configure commandline"); +# +# DESCRIPTION +# +# Build::Config objects are used to represent features of a model +# configuration that must be specified at build time. +# +# new() Reads xml files that contain the configuration definition and +# default values of the configuration parameters. +# +# The "config_definition.xml" file contains all the allowable +# parameters with a description of each one. Where appropriate a +# list of valid values of a parameter is given. Generic default +# values that are useful across many model configurations are +# provided for some parameters. +# +# The generic default values that are provided in the definition file +# may be overridden by values in a setup file ("config_setup.xml") +# that is assumed to provide appropriate values for a specific model +# configuration. This setup file is optional. +# +# ======================== +# Query methods: +# ======================== +# +# is_valid_name() Returns true if the specified parameter name is contained in +# the configuration definition file. +# +# is_valid_value() Returns true if the specified parameter name is contained in +# the configuration definition file, and either 1) the specified value is +# listed as a valid_value in the definition file, or 2) the definition file +# doesn't specify the valid values. +# +# get() Return the value of the specified configuration parameter. Triggers +# an exception if the parameter name is not valid. +# ***NOTE*** If you don't want to trap exceptions, then use the query +# functions before calling this routine. +# +# get_names() Return the list of valid names in the configuration definition file. +# +# get_valid_values( ) Returns list of valid values for the specified parameter name. +# +# ======================== +# Put and I/O methods: +# ======================== +# +# set() Sets values of the configuration parameters. It takes the +# parameter name and its value as arguments. An invalid parameter +# name (i.e., a name not present in the definition file) triggers an +# exception. If the definition file contains valid values of a +# parameter, then the set method checks for a valid input value. If +# and invalid value is found then an exception is thrown. +# ***NOTE*** If you don't want to trap exceptions, then use the query +# functions before calling this routine. +# +# write_file() Write a configuration xml file. The first argument is the +# filename. The second argument, if present, is the commandline of the +# configure command that was invoked to produce the output configuration +# file. It is written to the output file to help document the procedure +# used to configure the executable. +# +# print() Print the configuration to STDOUT. +# +# COLLABORATORS +# +# IO::File +# XML::Lite +#----------------------------------------------------------------------------------------------- +# +# Date Author Modification +#----------------------------------------------------------------------------------------------- +# 2007-Aug Erik Kluzek Add get_names method +# 2006-Nov Brian Eaton Original version +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use IO::File; +use XML::Lite; + +sub new +{ + my $class = shift; + my ($definition_file, $default_file) = @_; + + # bless the object here so the initialization has access to object methods + my $cfg = {}; + bless( $cfg, $class ); + + # Initialize the object with the configuration definition and its initial setup. + if ( defined($definition_file) ) { + $cfg->_initialize($definition_file, $default_file); + } + else { + die "ERROR: $class new method requires a definition file\n"; + } + + return $cfg; +} + +#----------------------------------------------------------------------------------------------- + +sub is_valid_name +{ +# Return true if the requested name is contained in the configuration definition. + + my ($self, $name) = @_; + + return defined($self->{$name}) ? 1 : 0; +} + +#----------------------------------------------------------------------------------------------- + +sub get +{ +# Return requested value. + + my ($self, $name) = @_; + + defined($self->{$name}) or die "ERROR: unknown parameter name: $name\n"; + + return $self->{$name}->{'value'}; +} + +#----------------------------------------------------------------------------------------------- + +sub get_names +{ +# Return list of valid names. + + my ($self) = @_; + + + my @names = sort( keys( %$self ) ); + + return @names; +} + + +#----------------------------------------------------------------------------------------------- + +sub is_valid_value +{ +# Return true if the specified parameter name is contained in +# the configuration definition file, and either 1) the specified value is +# listed as a valid_value in the definition file, or 2) the definition file +# doesn't specify the valid values. + + my ($self, $id, $value) = @_; + + # Check that the parameter name is in the configuration definition + unless ($self->is_valid_name($id)) { return 0; } + + # Check that a list value is not supplied when parameter takes a scalar value. + my $is_list_value = $self->{$id}->{'list'}; + unless ($is_list_value) { # this conditional is satisfied when the list attribute is false, i.e., for scalars + if ($value =~ /.*,.*/) { return 0; } # the pattern matches when $value contains a comma, i.e., is a list + } + + # Check that the value is valid + my @valid_values = $self->get_valid_values( $id ); + if ( @valid_values ) { # if no valid values are specified, then $value is automatically valid + if ($is_list_value) { + unless (_list_value_ok($value, @valid_values)) { return 0; } + } + else { + unless (_value_ok($value, @valid_values)) { return 0; } + } + + } + + return 1; +} + +#----------------------------------------------------------------------------------------------- + +sub get_valid_values +{ +# Return list of valid values for a given id + + my ($self, $id) = @_; + + my @return_array; + # Check that the parameter name is in the configuration definition + if ($self->is_valid_name($id)) { + + my $valid_values = $self->{$id}->{'valid_values'}; + if ( $valid_values ) { + @return_array = split /,/, $valid_values; #/ + } + } + + return( @return_array ); + +} + +#----------------------------------------------------------------------------------------------- + +sub set +{ +# Set requested value. +# +# This routine handles errors by throwing exceptions. It will report exactly what problem was +# found in either the parameter name or requested value. +# +# To avoid dealing with exceptions use the is_valid_name(), is_valid_value() methods to get a +# true/false return before calling the set method. + + my ($self, $id, $value) = @_; + + # Check that the parameter name is in the configuration definition + $self->is_valid_name($id) or die + "ERROR: parameter name $id is not in the configuration definition\n"; + + # Check that the value is valid + my $valid_values = $self->{$id}->{'valid_values'}; + $self->is_valid_value($id, $value) or die + "ERROR: $value is not a valid value for parameter $id: valid values are $valid_values\n"; + + # Add the new value to the object's internal data structure. + $self->{$id}->{'value'} = $value; + + return 1; +} + +#----------------------------------------------------------------------------------------------- + +sub write_file +{ +# Write a configuration definition file. + + my ($self, $filename, $commandline) = @_; + + my $fh = IO::File->new($filename, '>') or die "** can't open file: $filename\n"; + + # head of the xml file + print $fh <<"EOD"; + + + + +EOD + + # add commandline if present + if (defined $commandline) { + print $fh <<"EOD"; + +$commandline + +EOD + } + + # add the entry elements + my @ids = keys %$self; + foreach my $id (sort @ids) { + print $fh <<"EOD"; + +$self->{$id}->{'definition'} + +EOD + } + + # tail of the xml file + print $fh <<"EOD"; + + +EOD + + +} + +#----------------------------------------------------------------------------------------------- + +sub print +{ +# Print the configuration to STDOUT. + + my ($self) = @_; + + my @ids = keys %$self; + foreach my $id (sort @ids) { + printf "%12s = %s\n", $id, $self->{$id}->{'value'}; + } +} + +#----------------------------------------------------------------------------------------------- +# Private methods +#----------------------------------------------------------------------------------------------- + +sub _initialize +{ +# Read the configuration definition file. Create an anonymous hash with the following +# structure: +# { id1 => {value => "xxx", list => "XXX", valid_values => "yyy", definition => "zzz"}, +# id2 => {value => "xxx", list => "XXX", valid_values => "yyy", definition => "zzz"}, +# ... +# idn => {value => "xxx", list => "XXX", valid_values => "yyy", definition => "zzz"}, +# } + + + my ($self, $definition_file, $setup_file) = @_; + + # Process the definition file + my $xml = XML::Lite->new( $definition_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "config_definition" or die + "ERROR: $definition_file is not a configuration definition file\n"; + + # Each parameter is contained in an "entry" element. Get all these elements. + my @elements = $xml->elements_by_name('entry'); + + # Loop over the elements... + foreach my $e (@elements) { + + # and extract the attributes and element content. + my %attributes = $e->get_attributes(); + my $content = $e->get_content(); + # if present strip initial and final newlines from content + $content =~ s/^\n{1}//; + $content =~ s/\n{1}$//; + + # Look for the specific attributes that are contained in the configuration definition. + my $id = $attributes{'id'}; + my $value = $attributes{'value'}; + my $list = $attributes{'list'}; + my $valid_values = defined $attributes{'valid_values'} ? $attributes{'valid_values'} : ""; + + # Now add the attributes and content to the object's internal data structure. + $self->{$id} = {'value' => $value, 'list' => $list, 'valid_values' => $valid_values, 'definition' => $content}; + } + + # Process the setup file + if (defined $setup_file) { + my $xml = XML::Lite->new( $setup_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "config_definition" or die + "ERROR: $definition_file is not a configuration definition file\n"; + + # Each parameter is contained in an "entry" element. Get all these elements. + @elements = (); + @elements = $xml->elements_by_name('entry'); + + # Loop over the elements... + foreach my $e (@elements) { + + # and extract the attributes + my %attributes = $e->get_attributes(); + + # just get the parameter name and value + my $id = $attributes{'id'}; + my $value = $attributes{'value'}; + + # set new value + $self->set($id, $value); + } + } # end processing setup file +} + +#----------------------------------------------------------------------------------------------- + +sub _list_value_ok +{ +# Check that all input values ($values_in may be a comma separated list) +# are contained in the list of valid values (@valid_values). +# Return 1 (true) if all input values are valid, Otherwise return 0 (false). + + my ($values_in, @valid_values) = @_; + + my @values = split /,/, $values_in; #/ + + my $num_vals = scalar(@values); + my $values_ok = 0; + + foreach my $value (@values) { + + if (_value_ok($value, @valid_values)) { ++$values_ok; } + + } + + ($num_vals == $values_ok) ? return 1 : return 0; +} + +#----------------------------------------------------------------------------------------------- + +sub _value_ok +{ + +# Check that the input value is contained in list of +# valid values (@valid_values). Return 1 (true) if input value is valid, +# Otherwise return 0 (false). + + my ($value, @valid_values) = @_; + + # If the valid value list is null, all values are valid. + unless (@valid_values) { return 1; } + + $value =~ s/^\s+//; + $value =~ s/\s+$//; + foreach my $expect (@valid_values) { + if ($value =~ /^$expect$/i) { return 1; } + } + + return 0; +} + +#----------------------------------------------------------------------------------------------- + + +#----------------------------------------------------------------------------------------------- + +1; # to make use or require happy diff --git a/bld/perl5lib/Build/Namelist.pm b/bld/perl5lib/Build/Namelist.pm new file mode 100644 index 0000000000..b93b655127 --- /dev/null +++ b/bld/perl5lib/Build/Namelist.pm @@ -0,0 +1,953 @@ +package Build::Namelist; +my $pkg_nm = 'Build::Namelist'; +#----------------------------------------------------------------------------------------------- +# +# SYNOPSIS +# +# use Build::Namelist; +# +# # create empty object +# my $nl = Build::Namelist->new(); +# +# # initialize object with namelist read from a file +# my $nl = Build::Namelist->new($namelist_file_in); +# +# # initialize object with a namelist formatted string +# my $nl = Build::Namelist->new("&nl1 var1=val1 var2=val2 /"); +# +# # get array of namelist group names defined in $nl +# my @groups = $nl->get_group_names(); +# +# # get array of variable names for a specified namelist group +# my @vars = $nl->get_variable_names('group_name'); +# +# # get value of a group variable +# my $val = $nl->get_variable_value('group_name', 'variable_name'); +# +# # set value of a group variable +# $nl->set_variable_value('group_name', 'variable_name', $val); +# +# # delete a variable from a specified group +# $nl->delete_variable('group_name', 'variable_name'); +# +# # write the namelist group(s) to an output file +# $nl->write($namelist_file_out); +# +# # append the namelist group(s) to an existing output file +# $nl->write($namelist_file_out, 'append'=>1); +# +# # write a subset of the groups to the output file +# $nl->write($namelist_file_out, 'groups'=>['name1','name2']) +# +# +# DESCRIPTION +# +# Build::Namelist objects are used to: +# 1. Parse Fortran namelist input (can handle multiple namelist groups). +# 2. Get group name, variable names, variable values. +# 3. Set new groups, name/value pairs. +# 4. Write output namelist. +# +# N.B.: FORTRAN is case insensitive. So all variable names and group names in the +# namelist object are converted to lower case. +# Method arguments for variable and group names are not assumed to be lower case. +# These names are converted to lower case internally. +# +# The simple parser employed in this module treats all values as scalar strings. It +# doesn't keep track of whether the values are string or numeric, nor whether the values +# are scalar or arrays. So it is up to the user to explicitly provide the quotes that +# a string (charecter(len=*)) in a Fortran namelist requires. When reading values from +# a user supplied namelist, these quotes are preserved by the parser. +# +# new() +# Create a new Build::Namelist object. Can initialize the object with data +# from a namelist formatted string or by reading a namelist(s) from a file. +# +# get_group_names() +# Returns an array containing the namelist group name(s) defined in the object. +# +# get_variable_names($group_name) +# Returns an array containing the variable names in the specified namelist group. +# +# get_variable_value($group_name, $variable_name) +# Returns a scalar containing the value of variable in the specified namelist group. +# +# get_value($variable_name) +# Convenience function to get the value of a variable assuming there is only +# one group with that variable name in it. +# +# set_variable_value($group_name, $variable_name, $value) +# Set the value of the specified variable in the specified group. +# +# delete_variable($group_name, $variable_name) +# Delete the specified variable in the specified group. If the group is empty after +# the variable is deleted, then delete the group as well. +# +# merge_nl($new_nl) +# Merge a separate namelist object into this one. +# +# write($filename, ['append']) +# Write the namelist group(s) to $filename. Default is to overwrite an existing file. +# Append to an existing file by supplying the optional argument 'append'. +# +# Build::Namelist::validate_variable_value($var, $value, \%type_definition) +# Validate that the given variable value corresponds to the FORTRAN description +# given in the input type_definition hash for this variable. +# **** N.B. **** This is a class method. +# +# COLLABORATORS +# +#----------------------------------------------------------------------------------------------- +# +# Date Author Modification +#----------------------------------------------------------------------------------------------- +# 2001 Erik Kluzek Original version of namelist parsing code. +# +# 2007-May Brian Eaton Took the namelist parsing code from the original and used +# it in a completely redesigned module. +# 2008-May Erik Kluzek Add methods to validate data types. +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use IO::File; + +# package variables + +# As the parser recognizes pieces of the input namelist, it uses these variables +# to keep track of the current namelist entry. +my $group_name; # namelist group for current parser state +my $variable_name; # variable name for current parser state +my $variable_value; # variable value for current parser state + +sub new +{ + my $class = shift; + my $in = shift; # input namelist as either a string or the name of a file + + my $nm = "$class\:\:new"; + my $self = {}; + + # if new is invoked with no argument, create empty namelist object + if ( ! defined($in) ) { return bless($self, $class); } + + # Determine which form of input has been used. If a filename has been given then + # read the namelist file before invoking the parser. + + # Pass the parser an array of lines. If the namelist input has been provided in + # a string, then put it into $line[0]. It the namelist has been provided by a + # file, then read the file into @lines. + + my @lines; + + if ($in =~ m/^\s*&/) { # if the input is a formatted namelist string, the first + # character must be an '&' optionally preceeded by blanks + + # Replace embedded newlines by spaces as the parsing code seems to assume input + # lines that only have newlines as terminating characters. + $in =~ s/\n/ /g; + + $lines[0] = $in; + } + else { # a filename was input + + # check that the file exists + (-f $in) or die "$nm: failed to find namelist file $in"; + + # read the file + my $fh = IO::File->new($in, '<') or die "$nm: can't open file: $in\n"; + @lines = <$fh>; + $fh->close; + } + + _parse($self, \@lines); + + return bless($self, $class); +} + +#----------------------------------------------------------------------------------------------- + +sub get_group_names { + +# Return an array of namelist group names + + my $self = shift; + + return( keys %$self ); +} + +#----------------------------------------------------------------------------------------------- + +sub get_variable_names { + +# Return an array of variable names for the specified namelist group + + my $self = shift; + my $group_name = shift; + + my $lc_group = lc($group_name); + + return( keys %{$self->{$lc_group}} ); +} + +#----------------------------------------------------------------------------------------------- + +sub get_variable_value { + +# Return variable value for specified namelist group and variable name + + my $self = shift; + my $group_name = shift; + my $variable_name = shift; + + my $lc_group = lc($group_name); + my $lc_var = lc($variable_name); + + return( $self->{$lc_group}->{$lc_var} ); +} + +#----------------------------------------------------------------------------------------------- + +sub get_value { + +# This is a convenience function which assumes that the requested variable only +# exists in one group in the namelist object. So search through the groups until +# the variable name is found, and return the value for that occurance of the name. + + my $self = shift; + my $variable_name = shift; + + my $lc_var = lc($variable_name); + + my @groups = $self->get_group_names(); + foreach my $group (@groups) { + if (defined $self->{$group}->{$lc_var}) { + return $self->{$group}->{$lc_var}; + } + } + + # Variable name not found. + return undef; +} + +#----------------------------------------------------------------------------------------------- + +sub set_variable_value { + +# Set variable value for specified namelist group and variable name + +# N.B. This routine does no validity checking. New group names and new +# variable names can be added, as well as overwriting the values of +# existing variables. + + my $self = shift; + my $group_name = shift; + my $variable_name = shift; + my $variable_value = shift; + + my $lc_group = lc($group_name); + my $lc_var = lc($variable_name); + + $self->{$lc_group}->{$lc_var} = $variable_value; + + return 1; +} + +#----------------------------------------------------------------------------------------------- + +sub delete_variable { + +# Delete a variable from a specified group + + my $self = shift; + my $group_name = shift; + my $variable_name = shift; + + my $lc_group = lc($group_name); + my $lc_var = lc($variable_name); + + # Check that the variable is defined. If not then return error. + if (! defined $self->{$lc_group}->{$lc_var}) { + return -1; + } + else { + # delete the variable + delete $self->{$lc_group}->{$lc_var}; + } + + # Check whether the group has any other variables. If not then delete the + # group as well. + my @vars = $self->get_variable_names($lc_group); + unless (@vars) {delete $self->{$lc_group};} + + return 0; +} + +#----------------------------------------------------------------------------------------------- + +sub merge_nl { + +# Merge the contents of the namelist object argument into the object invoking the method. +# The variables in the invoking object have higher precedence and are not overwritten. + + my $self = shift; # namelist object to merge into + my $nl = shift; # namelist object to merge from + + # loop over groups in namelist argument + my @groups = $nl->get_group_names(); + foreach my $group (@groups) { + + # loop over variables in each group + my @vars = $nl->get_variable_names($group); + foreach my $var (@vars) { + + # check whether variable is defined in the invoking object + unless (defined $self->get_variable_value($group, $var)) { + + # add the variables to the invoking namelist without overwriting + # existing values + my $val = $nl->get_variable_value($group, $var); + $self->set_variable_value($group, $var, $val); + } + } + } +} + +#----------------------------------------------------------------------------------------------- + +sub write { + +# Write namelist to file. +# +# The default is to overwrite an existing file. To append +# to existing file set the optional argument 'append' to true, e.g., +# +# $nl->write('filepath', 'append'=>1) +# +# The default is to write all the groups in the namelist to the +# specified output file. To only write a subset of the groups +# supply the optional argument 'groups'=>['name1','name2',...], i.e., +# +# $nl->write('filepath', 'groups'=>['name1','name2']) +# +# To write a note at the end of the file: +# +# $nl->write('filepath', 'note=>"write this note to end of file") +# + + my $self = shift; + my $file = shift; # filepath for output namelist + my %opts = @_; # options + + my $class = ref($self); + my $nm = "$class\:\:Write"; + + + my $fh; + if (defined($opts{'append'}) && $opts{'append'}) { + $fh = IO::File->new($file, '>>' ) or die "$nm: can't open namelist file: $file\n"; + } else { + if ( -f $file ) { unlink( $file ); } + $fh = IO::File->new($file, '>' ) or die "$nm: can't open namelist file: $file\n"; + } + + # determine which groups to write + my @groups; + if (defined($opts{'groups'})) { + @groups = @{$opts{'groups'}}; + } + else { + @groups = sort(keys(%$self)); + } + + # loop over namelist groups + for my $name (@groups) { + + # $self->{$name} is a reference to the hash containing namelist group $name + my $nl_ref = $self->{$name}; + + print $fh "&$name\n"; + + for my $key ( sort( keys(%$nl_ref) ) ) { + if ( defined($nl_ref->{$key}) ) { + my $value = _split_namelist_value($self, $nl_ref->{$key}); + print $fh " $key\t\t= $value\n"; + } + } + + print $fh "/\n"; + } + if (defined($opts{'note'}) && $opts{'note'}) { + $self->_AppendNote( $fh, $file, $opts{'note'} ); + } + + $fh->close; +} + +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# Perl regular expressions to match Fortran namelist tokens. + +# Variable names. +# % for derived types, () for arrays +#my $varmatch = "[A-Za-z_]{1,31}[A-Za-z0-9_]{0,30}[(0-9)%a-zA-Z_]*"; + +# 7 June 2012, eaton +# +# First, note that the $varmatch regexp will match many things that are +# not valid Fortran variable names. We are delegating the responsibility +# for determining whether a variable name is valid in a namelist to the +# NamelistDefinition module. +# +# Extend the $varmatch regexp for matching variable names so that it +# will match multidimensional array elements. Also, extend the character +# set for valid fortran names by including the '&'. This is a special +# feature for creating namelists by the CESM scripts. A design goal of the +# user interface is to simply specifying namelist variables by not requiring +# that the namelist group be specified. The responsibility of putting variables +# in the correct namelist group is delegated to the NamelistDefinition module. +# But this design breaks down when different namelist groups contain variables +# of the same name. This doesn't happen very often, so to deal with this as +# a special case we allow the group name to be prepended to the variable name +# and use the & as the seperator. + +my $varmatch = "[A-Za-z_]+[A-Za-z_%(0-9,)&]*"; + +# Integer data. +my $valint = "[+-]?[0-9]+"; +my $valint_repeat = "${valint}\\*$valint"; + +# Logical data. +my $vallogical1 = "\\.[Tt][Rr][Uu][Ee]\\."; +my $vallogical2 = "\\.[Ff][Aa][Ll][Ss][Ee]\\."; +my $vallogical = "$vallogical1|$vallogical2"; +my $vallogical_repeat = "${valint}\\*$vallogical1|${valint}\\*$vallogical2"; + +# Real data. +# "_" are for f90 precision specification +my $valreal1 = "[+-]?[0-9]*\\.[0-9]+[EedDqQ]?[0-9+-]*"; +my $valreal2 = "[+-]?[0-9]+\\.?[EedDqQ]?[0-9+-]*"; +my $valreal = "$valreal1|$valreal2"; +my $valreal_repeat = "${valint}\\*$valreal1|${valint}\\*$valreal2"; + +# String data. +# One problem with below is strings that have \" or \' in them +my $valstring1 = '\'[^\']*\''; +my $valstring2 = '"[^"]*"'; +my $valstring = "$valstring1|$valstring2"; +my $valstring_repeat = "${valint}\\*$valstring1|${valint}\\*$valstring2"; + +# Complex data. +my $valcomplex1 = "\\(\\s*$valreal1\\s*,\\s*$valreal1\\s*\\)"; +my $valcomplex2 = "\\(\\s*$valreal1\\s*,\\s*$valreal2\\s*\\)"; +my $valcomplex3 = "\\(\\s*$valreal2\\s*,\\s*$valreal1\\s*\\)"; +my $valcomplex4 = "\\(\\s*$valreal2\\s*,\\s*$valreal2\\s*\\)"; +my $valcomplex = "$valcomplex1|$valcomplex2|$valcomplex3|$valcomplex4"; +my $valcomplex_repeat = "${valint}\\*$valcomplex1|${valint}\\*$valcomplex2|${valint}\\*$valcomplex3|${valint}\\*$valcomplex4"; + +# Match for all valid data-types: integer, real, complex, logical, or string data +# note: valreal MUST come before valint in this string to prevent integer portion of real +# being separated from decimal portion +my $valall = "$vallogical|$valstring|$valreal|$valint|$valcomplex"; + +# Match for all valid data-types with repeater: integer, real, complex, logical, or string data +# note: valrepeat MUST come before valall in this string to prevent integer repeat specifier +# being accepted alone as a value +my $valrepeat = "$vallogical_repeat|$valstring_repeat|$valreal_repeat|$valint_repeat|$valcomplex_repeat"; + +# Match for all valid data-types with or without numberic repeater at the lead +my $valmatch = "$valrepeat|$valall"; + +# Same as above when a match isn't required +my $nrvalmatch = $valmatch. "||"; + +#----------------------------------------------------------------------------------------------- + +# 6 October 2008, bee -- this method doesn't belong here. The parser should be storing +# the type of the values so that the definition object can ask for +# that information and the validation takes place in the definition +# object which knows what the type is supposed to be. + +sub validate_variable_value +# +# Validate that a given value matches the expected input type definition +# Expected description of keys for the input type hash is: +# type type description (char, logical, integer, or real) (string) +# strlen Length of string (if type char) (integer) +# arrayNDims Number of dimensions (0=scalar,1=array,2=2D array, etc.) (integer) +# arrayDims Reference to size of dimension for each dimension (integer) +# validValues Reference to array of valid values (string) +# +{ + my $var = shift; + my $value = shift; + my $type_ref = shift; + my $nm = "validate_variable_value"; + + # Ensure type hash has required variables + if ( ref($type_ref) !~ /HASH/ ) { + die "ERROR: in $nm (package $pkg_nm): Input type is not a HASH reference.\n" . + "defined in input type hash.\n"; + } + foreach my $item ( "arrayNDims", "arrayDims", "type", "strlen", "validValues" ) { + if ( ! exists($$type_ref{$item}) ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $item not " . + "defined in input type hash.\n"; + } + } + # if multi-dimensional array -- signal an error + if ( $$type_ref{'arrayNDims'} > 1 ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var is defined " . + "as a multidimensional array -- which is invalid for a namelist.\n"; + } + + # If not string -- check that array size is smaller than definition + my $str_len = $$type_ref{'strlen'}; + my @values; + if ( $str_len == 0 && $$type_ref{'type'} ne "complex") { + @values = split( /,/, $value ); + # Now check that values are correct for the given type + foreach my $i ( @values ) { + my $compare; + if ( $$type_ref{'type'} eq "logical" ) { + $compare = $vallogical; + } elsif ( $$type_ref{'type'} eq "integer" ) { + $compare = $valint; + } elsif ( $$type_ref{'type'} eq "real" ) { + $compare = $valreal; + } else { + die "ERROR: in $nm (package $pkg_nm): Type of variable name $var is " . + "not a valid FORTRAN type (logical, integer, real, complex or char).\n"; + } + if ( $i !~ /^\s*${compare}$/ ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a value ($i) that is not a valid FORTRAN " . $$type_ref{'type'} . "\n"; + } + } + # Otherwise if a complex array + } elsif ( $str_len == 0 && $$type_ref{'type'} eq "complex") { + my $val = $value; + while( $val ) { + if ( $val !~ /^[\s,]*(.+?)$/ ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a value ($val) that has improper spacing\n"; + } + $val = $1; + if ( ! $val ) { last; } + if ( $val =~ /^($valcomplex)(.*?)$/ ) { + push( @values, $1 ); + } else { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a value ($val) that is not a valid FORTRAN complex\n"; + } + $val = $2; + } + # Otherwise if a string + } else { + if ( $$type_ref{'type'} ne "char" ) { + die "ERROR: in $nm (package $pkg_nm): Type of variable name $var is " . + "not a valid FORTRAN type (logical, integer, real, complex or char).\n"; + } + my $val = $value; + while( $val ) { + if ( $val !~ /^[\s,]*(.+?)$/ ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a value ($val) that has improper spacing\n"; + } + $val = $1; + if ( ! $val ) { last; } + if ( $val =~ /^($valstring)(.*?)$/ ) { + push( @values, $1 ); + } else { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a value ($val) that is not a valid FORTRAN character string\n"; + } + if ( length($1) > ($str_len+2) ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var " . + "has a string element that is too long: $1\n"; + } + $val = $2; + } + } + # Check that array size not exceeded + my $arr_ref = $$type_ref{'arrayDims'}; + # Check only if this is an integer and not a variable. + if ( $$arr_ref[0] =~ m/^-?\d+$/ and $#values > $$arr_ref[0] ) { + die "ERROR: in $nm (package $pkg_nm): Variable name $var has exceeded " . + "the dimension size of the array.\n"; + } + + # Match to valid values... + # Put this last so can return if find a match + my $valid_values_ref = $$type_ref{'validValues'}; + if ( $#$valid_values_ref > -1 ) { + foreach my $variable_value ( @values ) { + foreach my $valid_val ( @$valid_values_ref ) { + if ( $variable_value eq $valid_val ) { + return 1; + } + } + } + die "ERROR: in $nm (package $pkg_nm): Variable name $var has values that " . + "does NOT match any of the valid values: @$valid_values_ref.\n"; + } + return( 1 ); +} + +#=============================================================================================== +# PRIVATE methods +#=============================================================================================== + +#----------------------------------------------------------------------------------------------- + +sub _AppendNote { +# +# Append a note to the end of the namelist file to add documentation. +# + my ($self,$fh,$filename,$note) = @_; + + (my $file = $filename) =~ s!(.*)/!!; + my $class = ref($self); + my $nm = "$class::AppendNote"; + + $note =~ s/\n/\n\#\! /g; + print $fh "#!--------------------------------------------------------------------------------------------------------------------------\n"; + print $fh "#! ${file}:: $note\n"; + print $fh "#!--------------------------------------------------------------------------------------------------------------------------\n"; +} + +#----------------------------------------------------------------------------------------------- + +sub _parse { + +# Parse a namelist formatted string. The string may contain more than one +# namelist group. + + my ($self, $lines_ref) = @_; + + my $nm = "$pkg_nm\:\:_parse"; + + # The control structure is set up to loop over lines read in from a file. + my @lines = @$lines_ref; + + # First item expected is the namelist group name. The parser will process + # input lines until it finds one that starts with a group name. + + my $expect = "group_name"; + + # Loop over each line in the namelist. + while ( defined(my $line = shift @lines) ) { + + # The local variable $line is modified by the parser. It removes tokens + # from $line as they are recognized. Loop over line until all recognized + # tokens have been removed. + while ( defined($line) ) { + + my $err = _parse_next($self, \$line, \$expect); + + if ( $expect eq "error" ) { + die "$nm::ERROR::$err"; + } + + } + + } + +} + + +#----------------------------------------------------------------------------------------------- + +sub _parse_next { +# +# _parse_next($self, \$line, \$expect ) +# +# Parse the input $line for the next item of type $expect. +# +# Loads variable names and values into the package variables $variable_name +# and $variable_value. When a name, value pair have been identified, a +# call to the internal method _setkeypair puts the values from the package +# variables into the object's internal hash. + +# This parser stores all input values as strings. It doesn't keep track of +# the data types of the parsed values, nor does it keep track of whether +# the input was scalar or an array. Array input is maintained as a string +# of comma separated values. The quotes from the input file are maintained +# as part of the value. + + +# +# Returns information on an error, if $expect changes to "error" +# otherwise returns "success". +# + my $self = shift; + my $line_ref = shift; # Current state of a line read from file + my $expect_ref = shift; # Type of item you expect next + # ("group", "variable", "varorvalue", "=", or "value") + + my $line = $$line_ref; + $_ = $$line_ref; + + my $expect = $$expect_ref; + + my $nm = "$pkg_nm\:\:_parse_next"; + + my $err; + + + # Blank line or first non-blank character is comment token; return and continue + if ( /^\s*$/ or /^\s*!/ ) { + $$line_ref = undef; + return( "success" ); + } + # + # Switch based on what type of item you expect + # + SWITCH: { + # Expect a "group" + ( $expect eq "group_name" ) && do { + if ( $line =~ /^\s*[\$\&](\w+)(.*)/i ) { + $group_name = lc($1); + $$line_ref = $2; + $$expect_ref = "variable"; + } + else { + # if the line doesn't start with a group name, throw it out and continue + $$line_ref = undef; + return( "success" ); + } + last SWITCH; + }; + + # Expect a variable + ( ($expect eq "variable") || ($expect eq "varorvalue") ) && do { + + # End-designator (F90 form "/" and non-standard F77 forms (&end) ) + if ( $line =~ /^\s*\/(.*)/ || $line =~ /^\s*[\$\&]end(.*)/i ) { + $$line_ref = $1; + _setkeypair($self); + # After finding the end of a namelist group, start searching for the next group. + $$expect_ref = "group_name"; + return( "success" ); + } + + # variable + if ( /^\s*,?\s*($varmatch)(.*?)$/ ) { + $$line_ref = $2; + $$expect_ref = "="; + _setkeypair($self); + $variable_name = lc($1); + } + elsif ( $expect ne "varorvalue" ) { + $err = "ERROR($nm): expect a variable instead got: $_\n"; + $$expect_ref = "error"; + return( $err ); + } + # value + elsif ( $expect eq "varorvalue" + && /^\s*([\s,]*)($nrvalmatch)([\s,]*)(.*?)$/ ) { + $$line_ref = $4; + $$expect_ref = "varorvalue"; + my $val = $2; + my $repeat = undef; + if ( $val =~ /($valint)\*($valall)/ ) { + $repeat = $1; + $val = $2; + } + $variable_value = $variable_value . ",$val"; + if ( defined($repeat) ) { + for( my $i = 0; $i < ($repeat-1); $i++ ) { + $variable_value = $variable_value . ",$val"; + } + } + # Comments, only can follow a value + if ( $$line_ref =~ /^([\s,])*![^!]*$/ ) { + $$line_ref = undef; + } + } + else { + $err = "ERROR($nm): expect a F90 namelist constant or variable instead got: $_\n"; + $$expect_ref = "error"; + return( $err ); + } + last SWITCH; + }; + + # Expect a "=" + ($expect eq "=") && do { + if ( /^\s*=(.*?)$/ ) { + $$line_ref = $1; + $$expect_ref = "value"; + } + else { + $err = "ERROR($nm): expect a equal \'=\' sign instead got: $_\n"; + $$expect_ref = "error"; + return( $err ); + } + last SWITCH; + }; + + # Expect a value + ($expect eq "value") && do { + # value + if ( /^\s*(${valmatch})([\s,]*)(.*?)$/ ) { + $$line_ref = $3; + $$expect_ref = "varorvalue"; + my $val = $1; + my $repeat = undef; + if ( $val =~ /(${valint})\*($valall)/ ) { + $repeat = $1; + $val = $2; + } + $variable_value = "$val"; + if ( defined($repeat) ) { + for( my $i = 0; $i < ($repeat-1); $i++ ) { + $variable_value = $variable_value . ",$val"; + } + } + # FORTRAN only allows comments after values + if ( $$line_ref =~ /^\s*![^!]*$/ ) { + $$line_ref = undef; + } + } + else { + $err = "ERROR($nm): expect a F90 constant for a namelist instead got: $_\n"; + $$expect_ref = "error"; + return( $err ); + } + last SWITCH; + }; + + # default + $err = "ERROR($nm): Bad type to expect: $$expect\n"; + $$expect_ref = "error"; + return( $err ); + } +} + +#----------------------------------------------------------------------------------------------- + +sub _setkeypair { + +# Set the keyword pair into the hash for the current namelist group +# Called from _parse_next when a variable assignment is complete. + + my $self = shift; + + my $nm = "$pkg_nm\:\:_setkeypair"; + +# print "set: group=$group_name var=$variable_name val=$variable_value\n"; + + if ( defined( $variable_name ) ) { + if ( ! defined($variable_value) ) { + die "ERROR::($nm) Value not defined for variable: $variable_name\n"; + } + + $self->{$group_name}->{$variable_name} = $variable_value; + + # reset the package variables used by the parser + $variable_name = undef; + $variable_value = undef; + } +} + +#----------------------------------------------------------------------------------------------- + +sub _split_namelist_value { + +# Return a namelist value split up if longer than max_length characters (typically 90) + + my $self = shift; + my $value = shift; + + my $nm = "$pkg_nm\:\:_split_namelist_value"; + my $max_length = 90; + + if ( length($value) > $max_length ) { + + my $originalvalue = $value; + my $expect = "value"; + my @list; + + # Replace embedded newlines by spaces as the parsing code seems to assume input + # lines that only have newlines as terminating characters. + # + # This needs to be done here as well as in the namelist object initializer + # to deal with values that were added by the set_variable_value method + $value =~ s/\n/ /g; + + # parse the long string and if it contains multiple values + # then split the string into an array of single value strings + while ( $value =~ /./ ) { + my $err = _parse_next($self, \$value, \$expect) ; + if ( $expect eq "error" ) { die "$nm::ERROR::$err"; } + push( @list, $variable_value ); + $expect = "value"; + } + + # insert newlines into the output string value + my $numberonline = ( $max_length*($#list+1) ) / length($originalvalue); + my $i = 0; + $value = shift @list; + for my $item ( @list ) { + if ( ++$i >= $numberonline ) { + $value = $value . ",\n $item"; + $i = 0; + } else { + $value = $value . ", $item"; + } + } + } + return( $value ); +} + +#----------------------------------------------------------------------------------------------- + +# Quoting should be done in the Write method rather +# than when string values are added to the namelist hash. +# But the namelist variable type isn't known in the Write method. +sub quote_string { + my $str = shift; + $str =~ s/^\s+//; + $str =~ s/\s+$//; + unless ($str =~ /^['"]/) { #"' + $str = "\'$str\'"; + } + return $str; +} + +#----------------------------------------------------------------------------------------------- + +sub convert_case { +# +# Convert the case of the keys in the main associative arrays to lowercase. +# Also terminate if there are two keys with the same name but different case. +# + my $self = shift; + + my $class = ref($self); + my $nm = "$class\:\:convert_case"; + + my $ref = $self->{'NLREF'}; + my $key; + foreach $key ( keys(%$ref) ) { + if ( defined($$ref{$key}) ) { + my $lckey = $key; + $lckey =~ tr/[A-Z]/[a-z]/; + my $value = $$ref{$key}; + if ( $key ne $lckey && defined($$ref{$lckey}) ) { + print "$lckey already defined\n"; + die "$nm: Fix your namelist so that two definitions of $lckey do not exist"; + } + $$ref{$key} = undef; + $$ref{$lckey} = $value; + } + } +} + +#----------------------------------------------------------------------------------------------- + +1 # to make use or require happy diff --git a/bld/perl5lib/Build/NamelistDefaults.pm b/bld/perl5lib/Build/NamelistDefaults.pm new file mode 100644 index 0000000000..5351a7614b --- /dev/null +++ b/bld/perl5lib/Build/NamelistDefaults.pm @@ -0,0 +1,337 @@ +package Build::NamelistDefaults; +my $pkg = 'Build::NamelistDefaults'; +#----------------------------------------------------------------------------------------------- +# +# SYNOPSIS +# +# use Build::Config; +# use Build::NamelistDefaults; +# +# # Create an object containing the configuration from a previous run of configure +# # (the config_cache.xml file written by configure contains all the parameters needed +# # to build an executable). +# my $cfg = Build::Config->new('config_cache.xml'); +# +# # Create a namelist defaults object (read the namelist defaults XML file). +# my $defaults = Build::NamelistDefaults->new("namelist_defaults.xml", $cfg); +# +# # Get the default value for the specified namelist variable +# my $nl_var_default = $defaults->get_value('nl_variable'); +# +# # To add additional defaults from a separate file +# $defaults->add('namelist_defaults.xml',$cfg); +# +# DESCRIPTION +# +# Build::NamelistDefaults objects are used to represent the default values of namelist +# variables that are stored in an XML file. Default values may depend on a number of +# attributes that are listed in the XML file. For example, default values may depend +# on specific parameters that were specified when building the executable code, such +# as the horizontal grid resolution. + +# +# METHODS +# +# new() Reads xml file that contains the namelist defaults, and stores +# A pointer to the object that contains the configuration information. +# +# add() Adds additional defaults from a separate file. +# +# get_value() +# +# +# +# COLLABORATORS +# +# IO::File +# XML::Lite +# Build::Config +#----------------------------------------------------------------------------------------------- +# +# Date Author Modification +#----------------------------------------------------------------------------------------------- +# 2007-Sep Brian Eaton Original version +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use XML::Lite; +use Build::Namelist; + +#----------------------------------------------------------------------------------------------- +# Public methods +#----------------------------------------------------------------------------------------------- + +sub new +{ + my $class = shift; + my $defaults_filepath = shift; # the xml file containing the defaults + my $cfg = shift; # a reference to a config object + + # bless the object here so the initialization has access to object methods + my $nl_defaults = {}; + bless( $nl_defaults, $class ); + + # Add the filepath of the defaults file to the object attributes (this is for error reporting). + $nl_defaults->{'defaults_filepath'} = $defaults_filepath; + + # Add the configuration object to the object attributes + $nl_defaults->{'cfg_ref'} = $cfg; + + # Initialize the object with the namelist defaults. + $nl_defaults->_initialize($defaults_filepath); + + return $nl_defaults; +} + +#----------------------------------------------------------------------------------------------- + +sub add +{ + my $self = shift; + my $defaults_filepath = shift; # the xml file containing the defaults + + # Append the filepath of the defaults file. + $self->{'defaults_filepath'} .= ", " . $defaults_filepath; + + # Add the additional namelist defaults. + $self->_initialize($defaults_filepath); +} + +#----------------------------------------------------------------------------------------------- + +sub get_value +{ +# Return a default value for the requested namelist variable. +# Return undef if no default found. + + my $self = shift; + my $var_name = lc(shift); # name of namelist variable (case insensitive interface) + my $usr_att_ref = shift; # reference to hash containing user supplied attributes + + # convenience variables + my $cfg = $self->{'cfg_ref'}; # configuration object + my %usr_att = (); # hash of user supplied attributes + + if (defined $usr_att_ref) { + ref($usr_att_ref) eq "HASH" or die + "ERROR: $pkg\:\:get_value -- user attributes arg must be a hash reference\n"; + %usr_att = %$usr_att_ref; + } + + # Return now if this variable name is not in the list of names + my $names_ref = $self->{'names'}; # list of names + if ( ! exists($$names_ref{$var_name}) ) { + return( undef ); + } + + # get all the elements that contain defaults for the requested namelist variable + my $all_elements_ref = $self->{'elements'}; # list of elements + my $elements_ref = $$all_elements_ref{$var_name}; + my @elements = @$elements_ref; + + # examine the attributes of each element to determine the "best fit" + # keep track of the number of attributes that match the configuration + my @fit = (); + ELEMENT: for (my $i = 0; $i <= $#elements; $i++) { + + my $e = $elements[$i]; + my $matches = 0; + + # extract the element attributes + my %attributes = $e->get_attributes(); + + # Check each attribute; first against the configuration, then against values supplied + # via the optional argument. + # If an attribute doesn't match, then eliminate the element from further consideration + foreach my $att_name (keys %attributes) { + + # Is the attribute part of the configuration? + if ($cfg->is_valid_name($att_name)) { + + # Get the value for the attribute from the configuration + my $cfg_val = $cfg->get($att_name); + + # Check for a match. If the attributes don't match then skip this element + # and move to the next after recording the no-match status + if ($attributes{$att_name} eq $cfg_val) { + $matches++; + } + else { + $fit[$i] = -1; + next ELEMENT; + } + + } + else { + + # If the attribute isn't part of the configuration then do addition + # checks here. + # + # Start with attributes that require special handling... + + if ($att_name eq "ic_ymd") { + + # Has this attribute been supplied by the user? + if (defined $usr_att{'ic_ymd'}) { + + # Check for match (numeric) + if ($attributes{$att_name} == $usr_att{'ic_ymd'}) { + $matches++; + } + else { + $fit[$i] = -1; + next ELEMENT; + } + } + # Did user specify that only the month/day needs to match? + elsif (defined $usr_att{'ic_md'}) { + + # Check for match (numeric) against month/day part of ic_ymd + my $ic_md = $attributes{$att_name} % 10000; + if ($ic_md == $usr_att{'ic_md'} % 10000) { + $matches++; + } + else { + $fit[$i] = -1; + next ELEMENT; + } + + } + + } + # Continue from here with generic checking of user supplied attributes + else { + # Has this attribute been supplied by the user? + if (defined $usr_att{$att_name}) { + + # Check for a match. If the attributes don't match then skip this element + # and move to the next after recording the no-match status + if ($attributes{$att_name} eq $usr_att{$att_name}) { + $matches++; + } + else { + $fit[$i] = -1; + next ELEMENT; + } + } + + } # Finished checking user specified attributes + + } # Finished attribute checks + + } # Finished loop over attributes + + # At this point the attribute checking has been successful. Record the matches. + $fit[$i] = $matches; + + } # Finished loop over elements in defaults file. + + # All elements have been examined. Return the value from the best fit. That's the + # index of the max value of @fit. In case of a tie it's the first one found. + my $max_val = $fit[0]; + my $max_idx = 0; + for (my $i = 1; $i <= $#elements; $i++) { + if ($fit[$i] > $max_val) { + $max_val = $fit[$i]; + $max_idx = $i; + } + } + + # If "best fit" is $max_val = -1, then no match was found. + if ($max_val >= 0) { + return $elements[$max_idx]->get_content(); + } + else { + return undef; + } + +} + +#----------------------------------------------------------------------------------------------- + +sub get_variable_names +{ +# Return a list of the varible names found in the defaults file. + + my $self = shift; + + my $names_ref = $self->{'names'}; + + return( sort( keys( %$names_ref ) ) ); +} + +#----------------------------------------------------------------------------------------------- +# Private methods +#----------------------------------------------------------------------------------------------- + +sub _initialize +{ +# Extract the element objects from the XML namelist defaults file and store internally. Each element +# from the file contains a default value for a namelist variable. There may be multiple elements for +# a single variable since the default value may depend on certain attributes. The xml elements contain +# the default values along with all the attributes. +# +# This method adds (or merges) the following attributes to a NamelistDefaults object: +# 'names' -- Reference to a hash whose keys are the namelist variable names. The names have +# been converted to lower case to implement a case insensitive lookup. +# 'elements' -- Reference to a hash that contains all the element objects extracted from the xml +# file(s). The keys are the namelist variable names (lowercase) and the values are +# references to arrays that contain all the element objects for that variable. + + my ($self, $defaults_file) = @_; + + # Process the definition file + my $xml = XML::Lite->new( $defaults_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "namelist_defaults" or die + "ERROR: $defaults_file is not a namelist defaults file\n"; + + # The children of the XML root object are xml elements, each of which contains a default + # value for a namelist variable along with attributes that determine the configuration for + # which the default is appropriate. + my @children = $root->get_children(); + + # If this object has already been initialized then set some convenience variables. + my %names; + my %elements; + if ( exists( $self->{'names'}) ) { + my $names_ref = $self->{'names'}; + my $elements_ref = $self->{'elements'}; + %names = %$names_ref; + %elements = %$elements_ref; + } + + # Store the elements in the definition file in a hash using the namelist variable + # name (converted to lowercase) as the key. + + foreach my $e (@children) { + my $name = lc $e->get_name(); + $names{$name} = 1; + + # If there have been previous elements for this variable, then append it to + # the existing array. Otherwise create a new array. + if (defined $elements{$name}) { + push @{$elements{$name}}, $e; + } + else { + $elements{$name} = [$e]; + } + } + + $self->{'names'} = \%names; + $self->{'elements'} = \%elements; + +} + +#----------------------------------------------------------------------------------------------- + + +#----------------------------------------------------------------------------------------------- + +1; # to make use or require happy diff --git a/bld/perl5lib/Build/NamelistDefinition.pm b/bld/perl5lib/Build/NamelistDefinition.pm new file mode 100644 index 0000000000..7a8d05a845 --- /dev/null +++ b/bld/perl5lib/Build/NamelistDefinition.pm @@ -0,0 +1,665 @@ +package Build::NamelistDefinition; +my $pkg = 'Build::NamelistDefinition'; +#----------------------------------------------------------------------------------------------- +# +# SYNOPSIS +# +# use Build::Namelist; +# use Build::NamelistDefinition; +# +# # Create a namelist definition object (read the namelist definition file). +# my $nldef = Build::NamelistDefinition->new("namelist_definition.xml"); +# +# # Create a namelist object from an input file that contains one or more namelist groups. +# my $nl = Build::Namelist->new('namelist.in'); +# +# # Validate the namelist object. +# my $nl_valid = $nldef->validate($nl); +# +# # Query the definition object for the filepath of the definition file +# my $definition_file = $nldef->get_file_name(); +# +# # Query the definition object to find which group a variable belongs to. +# my $group = $nldef->get_group_name('variable_name'); +# +# # Query the definition object for the string length of a requested variable. +# # get_str_len returns 0 if the requested variable isn't a character type +# my $strlen = $nldef->get_str_len('variable_name'); +# +# # Query the definition object whether the requested variable is the pathname of +# # an input dataset. If it is return the input_pathname attribute. If not +# # return "". +# my $pathname_type = $nldef->is_input_pathname('variable_name'); +# +# # Write validated namelist to output file. +# $nl_valid->write('namelist.out'); +# +# # If some of your namelist definition are in different files -- use Add +# $nldef->Add("namelist_definition2.xml"); +# +# DESCRIPTION +# +# Build::NamelistDefinition objects encapsulate a namelist definition. +# They provide a method used to validate a namelist object (created by the +# Build::Namelist module) against a namelist definition file. The +# validation currently consists of making sure that each variable in the +# namelist object is defined in the definition file. +# +# All variables are checked and problems reported to stdout. If any +# problems were encountered the object will throw an exception. +# +# If all variables are successfully validated, then the returned namelist +# object will have all variables in the namelist group(s) that are +# specified in the definition file. This means that the namelist groups in +# the input namelist object are ignored. +# +# The module also provides accessor methods to extract data from the +# namelist definition file. This is useful for scripts that produce +# namelist documentation from the definition file. +# +# METHODS +# +# new() +# Reads xml file that contains the namelist definition. +# The "namelist_definition.xml" file contains all the allowable +# variables with a description of each one. Where appropriate a +# list of valid values of a variable is given. +# +# add() +# Adds definitions from an additional file. +# +# validate() +# Validate a namelist object (created by the Build::Namelist module) +# against a namelist definition file. Each variable is checked to +# verify that it is defined in the definition file. Also the value +# of each variable is checked to verify that it's a string or a numeric +# type. +# +# The returned namelist object will have all variables contained in +# the correct namelist group as specified by the definition file. +# +# get_file_name() +# Return the filepath of the file that contains the namelist definition. +# +# get_group_name() +# If the requested variable name is contained in the namelist +# definition then return its namelist group. Otherwise return an +# empty string. +# +# get_str_len() +# Return 'str_len' attribute for requested variable. This is the +# length from the type declaration in the definition. If the +# variable is not a character type then the return value is 0. +# +# get_var_names() +# Return an alphabetized list of all variable names that are +# contained in the definition file. If the category is specified +# (via the optional argument pair 'category'=>'cat_name') then only +# the variables whose 'category' attribute have the value 'cat_name' +# are returned. This option is designed for producing documentation. +# +# get_var_type() +# Return the type declaration for the requested variable. +# +# get_var_doc() +# Return the documentation for the requested variable. +# +# get_var_doc_html() +# Return the documentation for the requested variable. Insert html tags +# for presentation in a table. +# +# get_valid_values() +# Get list of valid values. +# +# is_input_pathname() +# Return 'input_pathname' attribute for requested variable. The +# value is 'abs' if the variable contains the absolute pathname for +# an input dataset. A value of 'rel:var_name' means the variable +# contains a relative pathname and var_name is the name of another +# namelist variable that contains the root directory for the relative +# pathname. A value of '' is returned if the requested variable is +# not the pathname of an input dataset. +# +# is_valid_value() +# Check if a single (non-array, non-split) input value for a variable +# is valid. +# +# COLLABORATORS +# +# IO::File +# XML::Lite +# Build::Namelist +#----------------------------------------------------------------------------------------------- +# +# Date Author Modification +#----------------------------------------------------------------------------------------------- +# 2007-Sep Brian Eaton Original version +# 2008-May Erik Kluzek Add methods to validate data types +# 2008-Sep Erik Kluzek Add add method +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; + +use IO::File; +use XML::Lite; +use Build::Namelist; + +#----------------------------------------------------------------------------------------------- +# Public methods +#----------------------------------------------------------------------------------------------- + +sub new +{ + my $class = shift; + my ($definition_filepath) = @_; + + # bless the object here so the initialization has access to object methods + my $nl_definition = {}; + bless( $nl_definition, $class ); + + # Add the filepath of the definition file to the object attributes. + $nl_definition->{'definition_filepath'} = $definition_filepath; + + # Initialize the object with the namelist definition. + $nl_definition->_initialize($definition_filepath); + + return $nl_definition; +} + +#----------------------------------------------------------------------------------------------- + +sub add +{ + my $self = shift; + my ($definition_filepath) = @_; + + # Append the filepath of the definition file to the object attributes. + $self->{'definition_filepath'} .= ", " . $definition_filepath; + + # Add additional namelist definitions. + $self->_initialize($definition_filepath); +} + +#----------------------------------------------------------------------------------------------- + +sub validate +{ + +# Validate a namelist object (created by the Build::Namelist module) +# against a namelist definition file. All variables are checked and +# problems reported to stdout. If any problems were encountered the object +# will throw an exception. +# +# If all variables are successfully validated, then the returned namelist +# object will have all variables in the namelist group(s) that are +# specified in the definition file. This means that the namelist groups +# in the input namelist object are ignored. + + my $self = shift; + my $nl = shift; # namelist to be validated + + # Create an empty namelist which will be populated with variables from the + # input namelist as they are validated. + my $nl_valid = Build::Namelist->new(); + + # Loop over the groups in the input namelist + my @groups = $nl->get_group_names(); + for my $group (@groups) { + + # Loop over the variables in the namelist group + my @vars = $nl->get_variable_names($group); + for my $var (@vars) { + + # Get the variable's value + my $value = $nl->get_variable_value($group, $var); + + # Validate the variable/value pair. This method throws an exception + # when an error is encountered. If the validation is successful, then + # the valid group name for the variable is returned. + my $valid_group = $self->_validate_pair($var, $value); + + # Add the validated variable to the output namelist + $nl_valid->set_variable_value($valid_group, $var, $value); + } + } + + return $nl_valid; +} + +#----------------------------------------------------------------------------------------------- + +sub get_file_name +{ +# Return the name of the file that contains the namelist definition. + + my $self = shift; + + return $self->{'definition_filepath'}; +} + +#----------------------------------------------------------------------------------------------- + +sub get_group_name +{ +# If the requested name is contained in the namelist definition then return its +# namelist group. Otherwise return an empty string. + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return defined($self->{$lc_name}) ? $self->{$lc_name}->{'group'} : ""; +} + +#----------------------------------------------------------------------------------------------- + +sub get_str_len +{ +# Return 'str_len' attribute for requested variable + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return $self->{$lc_name}->{'str_len'}; +} + + +#----------------------------------------------------------------------------------------------- + +sub is_input_pathname +{ +# Return 'input_pathname' attribute for requested variable + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return $self->{$lc_name}->{'input_pathname'}; +} + +#----------------------------------------------------------------------------------------------- + +sub get_var_names +{ +# Return alphabetized list of all variable names that are contained in the definition file. +# If the optional argument pair 'category'=>'cat_name' are supplied then only variables +# whose 'category' attribute has the value 'cat_name' will be returned. + + my $self = shift; + my %opt = @_; # options + + # Put all keys from the definition object except for 'definition_filepath' into a new + # hash. Then return the sorted keys. + my %var = (); + foreach my $k (keys %$self) { + unless ($k eq 'definition_filepath') { + + # If a specific category has been requested then only add variables in + # that category. + if ( defined $opt{'category'} ) { + if ( $opt{'category'} eq $self->{$k}->{'category'} ) { $var{$k} = ''; } + } + else { + $var{$k} = ''; + } + } + } + return sort keys %var; +} + +#----------------------------------------------------------------------------------------------- + +sub get_var_type +{ +# Return 'type' attribute for requested variable + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return $self->{$lc_name}->{'type'}; +} + +#----------------------------------------------------------------------------------------------- + +sub get_var_doc +{ +# Return documentation for requested variable + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return $self->{$lc_name}->{'doc'}; +} + +#----------------------------------------------------------------------------------------------- + +sub get_var_doc_html +{ +# Return documentation for requested variable with html tags included. + + my ($self, $name) = @_; + my $lc_name = lc $name; + + my $doc = $self->{$lc_name}->{'doc'}; + + # Insert a line break in front of the 'Default:' token. + $doc =~ s/(defaults?:)/$1/i; + + return $doc; +} + +#----------------------------------------------------------------------------------------------- + +sub get_valid_values +{ +# Return list of valid_values as an array for requested variable +# To return without quotes use the 'noquotes'=>1 option. + my ($self, $name, %opts) = @_; + my $lc_name = lc $name; + + my $valid_values = $self->{$lc_name}->{'valid_values'}; + my @values = split( /,/, $valid_values ); + my $str_len = $self->get_str_len( $lc_name ); + # if string type and NOT noquote option and have a list -- add quotes around values + if ( ! defined($opts{'noquotes'}) || ! $opts{'noquotes'} ) { + if ( $#values > -1 && ($str_len > 0) ) { + for( my $i=0; $i <= $#values; $i++ ) { + $values[$i] = "'$values[$i]'"; + } + } + } + return( @values ); +} + +#----------------------------------------------------------------------------------------------- + +sub is_valid_value { + +# Check that a given single variable value matches the input list +# NOTE: This only works for a single value entered (NOT a list of values) + + my $self = shift; + my $variable_name = lc shift; + my $variable_value = shift; + + my @valid_values = $self->get_valid_values( $variable_name ); + if ( $#valid_values > -1 ) { + foreach my $val ( @valid_values ) { + if ( $variable_value eq $val ) { + return 1; + } + } + return 0; + } else { + return 1; + } +} + +#----------------------------------------------------------------------------------------------- +# Private methods +#----------------------------------------------------------------------------------------------- + +sub _initialize +{ +# Read the namelist definition file. Add a hash entry to the object for each +# namelist entry in the definition file. The hash entries look like this: +# +# id => # id is the name of the namelist variable +# {type => "...", # variable's type +# str_len => "...", # length of a string type, 0 if not a string +# arr_len => "...", # size of an array type, 0 if not an array +# input_pathname => "...", # if value is an input pathname then this attribute is +# # set to either 'abs' for an absolute pathname, or 'rel:var_name' +# # for a relative pathname. If the pathname is relative, +# # var_name specifies the namelist variable that contains the +# # root directory that the pathname is relative to. If variable +# # is not an input pathname this entry is set to ''. +# category => "...", # category used in documentation +# group => "...", # namelist group +# valid_values => "...", # valid values (if easy to list) +# doc => "..."} # documentation for variable +# + + my ($self, $definition_file) = @_; + + # Process the definition file + my $xml = XML::Lite->new( $definition_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "namelist_definition" or die + "ERROR: $definition_file is not a namelist definition file\n"; + + # Each namelist variable is contained in an "entry" element. Get all these elements. + my @elements = $xml->elements_by_name('entry'); + + # Loop over the elements... + foreach my $e (@elements) { + + # and extract the attributes and element content. + my %attributes = $e->get_attributes(); + my $content = $e->get_content(); + + # Look for the specific attributes that are contained in the namelist definition. + my $id = lc $attributes{'id'}; # make interfaces case insensitive + my $type = $attributes{'type'}; + my $input_pathname = defined $attributes{'input_pathname'} ? $attributes{'input_pathname'} : ""; + my $category = $attributes{'category'}; + my $group = $attributes{'group'}; + my $valid_values = defined $attributes{'valid_values'} ? $attributes{'valid_values'} : ""; + + # Parse the type specification for the following info: + + # Is the type string or numeric? A string type will be indicated by $str_len > 0. + # $str_len = 0 indicates a numeric type. + my $str_len = 0; + if ( $type =~ m/char\*(\d+)/ ) { + $str_len = $1; + } + + # Is the type an array or a scalar? An array will be indicated by $arr_len > 0 + # where $arr_len is the size of the array. $arr_len = 0 indicates a scalar. + my $arr_len = 0; + if ( $type =~ m{\( # opening paren + (.*) # capture everything between the parens in $1 + \) # closing paren + }x ) { + # split the dimensions between the parenthesis on "," and multiply the + # dimensions together to get the array size + my @dims = split /,/, $1; #/ + $arr_len = 1; + foreach my $dim (@dims) { + # If any of the array dimensions are variables, turn array + # size checking off via a hack (set limit to a big number). + if ($dim =~ m/[a-zA-Z_]/ ) { + $arr_len = 1000000; + last; + } + $arr_len *= $dim; + } + } + + # Now add the attributes and content to the object's internal data structure. + $self->{$id} = {'type' => $type, + 'str_len' => $str_len, + 'arr_len' => $arr_len, + 'input_pathname' => $input_pathname, + 'category' => $category, + 'group' => $group, + 'valid_values' => $valid_values, + 'doc' => $content, + }; + } + +} + +#----------------------------------------------------------------------------------------------- + +sub _validate_pair +{ + +# The validation consists of the following checks: +# +# . The variable must be defined in the namelist definition file. +# . The variable's value is verified as string or numeric. +# + + my $self = shift; + my $var_in = lc shift; # namelist variable + my $value = shift; # namelist variable's value + + my $def = $self->{'definition_filepath'}; + + # Is variable in namelist definition file? + # If the variable is an array, and an array element has been specified in the namelist, + # then we need to strip off the index specification before checking whether or not the + # name is valid. + my $var; + if ($var_in =~ m/(\w[\w%]*) # capture the array name (allow it to be an element in a derived type + \( # opening paren for index spec + [\d,]+ # 1 or more digits and commas + \) # closing paren of index spec + /ix) { + $var = $1; + } + else { + $var = $var_in; + } + + $self->_is_valid_name($var) or die + "ERROR: in _validate_pair (package $pkg): Variable name $var not found in $def \n"; + + # Parse the value string + + # Is the input value a string or numeric type? + # A string type must start with a quote with optional leading whitespace. + my $value_is_string = 0; + if ( $value =~ m{^\s*['"]} ) { $value_is_string = 1; } + + # Get string length from definition file (returns 0 for a numeric type) + my $str_len_def = $self->get_str_len($var); + my $type_def = $self->_get_type($var); + + # Check for mismatch + if ( $value_is_string and ($str_len_def == 0) ) { + die "ERROR: in _validate_pair (package $pkg): Variable name $var has an input value of type string, \n". + "$value \n". + "but is defined as type $type_def in $def \n"; + } + elsif ( ! $value_is_string and ($str_len_def > 0) ) { + die "ERROR: in _validate_pair (package $pkg): Variable name $var has an input value of type numeric, \n". + "$value \n". + "but is defined as type $type_def in $def \n"; + } + + # 22 September 2007, bee + # The intention is to include more rigorous checking for valid input values. + # But postpone this for now. It requires re-parsing the value that's currently + # only available as a string from the namelist parser. The functionality of + # breaking input values into arrays of the input type belongs in the namelist + # parser and shouldn't be done here. + # The following validations depend on breaking the input value string into + # an array of elements. + # . The variable's value is checked to verify that list values aren't specified for scalar + # variables. + # . For string input check that the length of input strings doesn't exceed the declared + # string length + # . The variable's value is checked against any valid values specified by the definition. + + # 6 Oct 2008, bee + # Checking has been added for valid values that puts the validation in + # the namelist object rather than here. The reason is to make use of + # the regexps that are defined in the namelist object to do the + # parsing. Rather than using those regexps to re-parse the values, the + # namelist parser should be refactored to store that information during + # the initial parsing. Then the namelist object can then be queried + # for the type of the input values, and the validation done here, i.e., + # in the module that knows the definition of the variable's type. + + + # Get the type description hash for the variable + # and validate the value with the datatype in the namelist object + # This method throws an exception when an error is encountered. + my %type_ref = $self->_get_datatype($var); + #$nl->validate_variable_value($var, $value, \%type_ref); + Build::Namelist::validate_variable_value($var, $value, \%type_ref); + + # Checks all passed. Return valid group name. + return $self->get_group_name($var); +} + +#----------------------------------------------------------------------------------------------- + +sub _is_valid_name +{ +# Return true if the requested name is contained in the namelist definition. + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return defined($self->{$lc_name}) ? 1 : 0; +} + +#----------------------------------------------------------------------------------------------- + +sub _get_type +{ +# Return 'type' attribute for requested variable + + my ($self, $name) = @_; + my $lc_name = lc $name; + + return $self->{$lc_name}->{'type'}; +} + +#----------------------------------------------------------------------------------------------- + +sub _get_datatype +# +# Return hash of description of data type read in from the file: +# Hash keys are: +# type type description (char, logical, integer, or real) (string) +# strlen Length of string (if type char) (integer) +# arrayNDims Number of dimensions (0=scalar,1=array,2=2D array, etc.) (integer) +# arrayDims Reference to array of size of each dimension (integer) +# validValues Reference to array of valid values (string) +# +{ + my ($self, $name) = @_; + my $lc_name = lc $name; + my $nm = "_get_datatype"; + + my %datatype; + my $type_def = $self->_get_type($lc_name); + $datatype{'strlen'} = $self->get_str_len($lc_name); + if ( $type_def =~ /^(char|logical|integer|complex|real)/ ) { + $datatype{'type'} = $1; + } else { + die "ERROR: in $nm (package $pkg): datatype $type_def is NOT valid\n"; + } + # Arrays + if ( $type_def =~ /\(/ ) { + # Note: This used to only allow [0-9, ], but since some sizes can be + # determined at configure time, allow variable names too. + if ( $type_def =~ /\(([a-zA-Z0-9_, ]+)\)$/ ) { + my @dimSizes = split( /,[ ]*/, $1 ); + $datatype{'arrayNDims'} = $#dimSizes + 1; + $datatype{'arrayDims'} = \@dimSizes; + } else { + die "ERROR: in $nm (package $pkg): datatype $type_def is NOT valid\n"; + } + # Scalars + } else { + my @dimSizes; + push( @dimSizes, "1" ); + $datatype{'arrayNDims'} = 0; + $datatype{'arrayDims'} = \@dimSizes; + } + my @valid_values = $self->get_valid_values( $lc_name ); + $datatype{'validValues'} = \@valid_values; + return( %datatype ); +} + + +1; # to make use or require happy diff --git a/bld/perl5lib/XML/Changes b/bld/perl5lib/XML/Changes new file mode 100644 index 0000000000..d0be5104f7 --- /dev/null +++ b/bld/perl5lib/XML/Changes @@ -0,0 +1,27 @@ +Revision history for Perl extension XML::Lite. + +0.14 31 January 2003 + - Fixed a major bug in parsing empty elements + - Fixed some typos in documenation + - Fixed error in documentation of XML::Element::get_attributes interface +0.13 13 November 2001 + - Minor bug fixes? +0.12 15 November 2001 + - Fixed bugs in test that failed on CPAN Testers + - Fixed warnings in XML::Lite::Element->_find_self + - Fixed bug where mutiple child lists failed (problem in opt code) + - Added tests for above + - Removed from CPAN because Matt Sergeant got upset +0.11 6 November 2001 + - XML::Lite::Element->get_text() now removes CDATA tags (but leaves content) +0.10 6 November 2001 + - Fixed children() and text() methods by re-vamping the + tree. + - Built tests for all exposed methods of all objects + - Built tests for all contructor calls +0.05 4 November 2001 + - Added get_text method +0.01 Sat Aug 25 13:31:48 2001 + - original version; created by h2xs 1.20 with options + -XA -n XML::Lite + diff --git a/bld/perl5lib/XML/Lite.pm b/bld/perl5lib/XML/Lite.pm new file mode 100644 index 0000000000..d6aa32e978 --- /dev/null +++ b/bld/perl5lib/XML/Lite.pm @@ -0,0 +1,550 @@ +############################################################ +# +# Module: XML::Lite +# +# Created: 25 August 2001 by Jeremy Wadsack for Wadsack-Allen Digital Group +# Copyright (C) 2001 Wadsack-Allen. All rights reserved. +# +# TODO +# * Need to support for doctypes, and doctype delarations +# * Could add a method 'element' that accepts path-like syntax +# * Could add write_to_file, to_string, etc. methods (requires that the orig doc be preserved!) +# * Could improve support for comments, CDATA, PI's etc as objects? +# * Expose handler interface +# * Expose a method to provide better error handling +# +############################################################ +# Date Modification Author +# ---------------------------------------------------------- +# 04.Sep.2001 Fixed lots of bugs and built tests JW +# 08.Sep.2001 Added linked list & handlers to parser JW +# 04.Nov.2001 Fixed bug in parameter handling JW +############################################################ +package XML::Lite; +use strict; +#$^W=1; # 'use warnings;' in perl 5.005_62 and later + +=head1 NAME + +XML::Lite - A lightweight XML parser for simple files + +=head1 SYNOPSIS + +use XML::Lite; +my $xml = new XML::Lite( xml => 'a_file.xml' ); + +=head1 DESCRIPTION + +XML::Lite is a lightweight XML parser, with basic element traversing +methods. It is entirely self-contained, pure Perl (i.e. I based on +expat). It provides useful methods for reading most XML files, including +traversing and finding elements, reading attributes and such. It is +designed to take advantage of Perl-isms (Attribute lists are returned as +hashes, rather than, say, lists of objects). It provides only methods +for reading a file, currently. + +=head1 METHODS + +The following methods are available: + +=over 4 + +=cut + +use XML::Lite::Element; +BEGIN { + use vars qw( $VERSION @ISA ); + $VERSION = '0.14'; + @ISA = qw(); +} # end BEGIN + +# non-exported package globals go here +use vars qw( %ERRORS ); + +# Predefined error messages in English +%ERRORS = ( + NO_START => "A closing tag (\%1) was found with no corresponding start tag at position \%0 in your XML file.\n", + NO_ROOT => "Your XML document must begin with a root element.\n", + ROOT_NOT_CLOSED => "The root element of your XML document (starting at position \%0) is incomplete.\n", + ELM_NOT_CLOSED => "The XML-like element starting at position \%0 is incomplete. (Did you forget to escape a '<'?)\n", +); +############################ +## The object constructor ## +############################ + +=item my $xml = new XML::Lite( xml => $source[, ...] ); + +Creates a new XML::Lite object. The XML::Lite object acts as the document +object for the $source that is sent to it to parse. This means that you +create a new object for each document (or document sub-section). As the +objects are lightweight this should not be a performance consideration. + +The object constructor can take several named parameters. Parameter names +may begin with a '-' (as in the example above) but are not required to. The +following parameters are recognized. + + xml The source XML to parse. This can be a filename, a scalar that + contains the document (or document fragment), or an IO handle. + + +As a convenince, if only on parameter is given, it is assumed to be the source. +So you can use this, if you wish: + + my $xml = new XML::Lite( 'file.xml' ); + +=cut + +sub new { + my $self = {}; + my $proto = shift; + my %parms; + my $class = ref($proto) || $proto; + + # Parse parameters + $self->{settings} = {}; + if( @_ > 1 ) { + my($k, $v); + local $_; + %parms = @_; + while( ($k, $v) = each %parms ) { + $k =~ s/^-//; # Removed leading '-' if it exists. (Why do Perl programmers use this?) + $self->{settings}{$k} = $v; + } # end while + } else { + $self->{settings}{xml} = $_[0]; + } # end if; + + bless ($self, $class); + + # Some defaults + $self->{doc_offset} = 0; + $self->{doc} = ''; + $self->{_CDATA} = []; + $self->{handlers} = {}; + + # Refer to global error messages + $self->{ERRORS} = $self->{settings}{error_messages} || \%ERRORS; + + # Now parse the XML document and build look-up tables + return undef unless $self->_parse_it(); + + return $self; +} # end new + +########################## +## ## +## Public Methods ## +## ## +########################## + +=item my $elm = $xml->root_element() + +Returns a reference to an XML::Lite::Element object that represents +the root element of the document. + +Returns C on errors. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 04Sep2001 Added root alias JW +# 08Sep2001 Modified to use tree instead of element list JW +# 05Nov2001 Added additional aliases JW +# ---------------------------------------------------------- +sub root; +*root = \&root_element; +sub get_root; +*get_root = \&root_element; +sub get_root_element; +*get_root_element = \&root_element; +sub root_element { + my $self = shift; + return undef unless defined $self->{doc}; + + # Find the first thing in the root of tree that's an element + my $root; + foreach( @{$self->{tree}} ) { + if( @$_ == 4 ) { + $root = $_; + last; + } # end if + } # end foreach + return undef unless defined $root; + return XML::Lite::Element->new( $self, $root ); +} # end root_element + + +=item @list = $xml->elements_by_name( $name ) + +Returns a list of all elements that match C<$name>. +C<@list> is a list of L objects +If called in a scalar context, this will return the +first element found that matches (it's more efficient +to call in a scalar context than assign the results +to a list of one scalar). + +If no matching elements are found then returns C +in scalar context or an empty list in array context. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 27Aug2001 Added method. JW +# 04Sep2001 Added element_by_name alias JW +# ---------------------------------------------------------- +sub element_by_name; +*element_by_name = \&elements_by_name; +sub elements_by_name { + my $self = shift; + my( $name ) = @_; + + if( wantarray ) { + my @list = (); + foreach( @{$self->{elements}{$name}} ) { + my $elm = new XML::Lite::Element( $self, $_, ); + push @list, $elm if defined $elm; + } # end foreach + return @list; + } else { + return new XML::Lite::Element( $self, $self->{elements}{$name}[0] ); + } # end if +} # end elements_by_name + + +########################## +## ## +## Private Methods ## +## ## +########################## +# ---------------------------------------------------------- +# Sub: _parse_it +# +# Args: (None) +# +# Returns: True value on success, false on failure +# +# Description: Parses the XML file in $self->{settings}{xml} +# If this is an IO reference or filename, then reads from that, +# else if it starts with '<' assumes it's an XML document. +# During parsing, stores an internal database of named elements +# for lookups ($self->{elements}) and an internal linked list +# of elements and text nodes ($self->{tree}) for traversal. +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 08Sep2001 Added linked list tree to internal objects JW +# 30Jan2003 Fixed bug in child tree with EMTPY elements JW +# ---------------------------------------------------------- +sub _parse_it { + my $self = shift; + + # Get the xml content + if( $self->{settings}{xml} =~ /^\s*{doc} = $self->{settings}{xml}; + } else { + $self->{doc} = $self->_get_a_file( $self->{settings}{xml} ); + } # end if + return 0 unless defined $self->{doc}; + delete $self->{settings}{xml}; # Just save some memory + + # -- Normalize the document to make things easier to find + # Remove comments (but replace with spaces to maintain positioning for messages + $self->{doc} =~ s/()/' ' x length($1)/sge; + + # Move CDATA to hash and insert a reference to it (so it doesn't mess up regexp parsing) + $self->{doc} =~ s//'_store_cdata($1).']]\/>'/sge; + + # Remove processing instructions (but replace with spaces to maintain positioning for messages + # (Perhaps we could do something with these -- they are instructions for processors...) + $self->{doc} =~ s/(<\?.+?\?>)/' ' x length($1)/sge; + + # NOTE: This makes it not possible to save the same formatting + # -- will also remove the space from the processing instruction! + if( $self->{doc} =~ s/^(\s+)// ) { + $self->{doc_offset} = length $1; # Store the number of removed chars for messages + } # end if + $self->{doc} =~ s/\s+$//; + + + # Build lookup tables + $self->{elements} = {}; + $self->{tree} = []; + # - These are used in the building process + my $element_list = []; + my $current_element = $self->{tree}; + + # Call init handler if defined + &{$self->{handlers}{init}}($self) if defined $self->{handlers}{init}; + + # Make a table of offsets to each element start and end point + # Table is a hash of element names to lists of offsets: + # [start_tag_start, start_tag_end, end_tag_start, end_tag_end] + # where tags include the '<' and '>' + + # Also make a tree of linked lists. List contains root element + # and other nodes. Each node consits of a list ref (the position list) + # and a following list containing the child element. Text nodes are + # a list ref (with just two positions). + + # Find the opening and closing of the XML, giving errors if not well-formed + my $start_pos = index( $self->{doc}, '<' ); + $self->_error( 'NO_ROOT' ) if $start_pos == -1; + my $end_pos = index( $self->{doc}, '>', $start_pos + 1 ); + $self->_error( 'ROOT_NOT_CLOSED', $start_pos + $self->{doc_offset} ) if $end_pos == -1; + my $doc_end = rindex( $self->{doc}, '>' ); + $self->_error( 'ROOT_NOT_CLOSED' ) if $doc_end == -1; + + # Now walk through the document, one tag at a time, building up our + # lookup tables + while( $end_pos <= $doc_end ) { + + # Get a tag + my $tag = substr( $self->{doc}, $start_pos, $end_pos - $start_pos + 1 ); + + # Get the tag name and see if it's an end tag (starts with \s]+)}; + + if( $end ) { + # If there is no start tag for this end tag then throw an error + $self->_error( 'NO_START', $start_pos + $self->{doc_offset}, $tag ) unless defined $self->{elements}{$name}; + + # Otherwise, add the end point to the array for the last element in + # the by-name lookup hash + my( $x, $found ) = (@{$self->{elements}{$name}} - 1, 0); + while( $x >= 0 ) { + + # Close the last open element (ignore elements already closed) + if( @{$self->{elements}{$name}[$x]} < 4 ) { + $self->{elements}{$name}[$x][2] = $start_pos; + $self->{elements}{$name}[$x][3] = $end_pos; + $found = 1; + last; + } # end if + $x--; + } # end while + + # If we didn't find an open element then throw an error + $self->_error( 'NO_START', $start_pos + $self->{doc_offset}, $tag ) unless $found; + + # Call an end-tag handler if defined (not yet exposed) + &{$self->{handlers}{end}}($self, $name) if defined $self->{handlers}{end}; + + # Close element in linked list (tree) + $current_element = pop @$element_list; + + } else { + # Make a new list in the by-name lookup hash if none found by this name yet + $self->{elements}{$name} = [] unless defined $self->{elements}{$name}; + + # Add start points to the array of positions and push it on the hash + my $pos_list = [$start_pos, $end_pos]; + push @{$self->{elements}{$name}}, $pos_list; + + # Call start-tag handler if defined (not yet exposed) + &{$self->{handlers}{start}}($self, $name) if defined $self->{handlers}{start}; + + # If this is a single-tag element (e.g. <.../>) then close it immediately + if( $tag =~ m{/\s*>$} ) { + push @$current_element, $pos_list; + $pos_list->[2] = undef; + $pos_list->[3] = undef; + # Call an end-tag handler now too + &{$self->{handlers}{end}}($self, $name) if defined $self->{handlers}{end}; + } else { + # Now add the element to the linked list (tree) + push @$element_list, $current_element; + # Otherwise, put this on the list and start a sublist for children + my $new_element = []; + push @$current_element, $pos_list, $new_element; + $current_element = $new_element; + } # end if + + } # end if + + # Move the start pointer to beginning of next element + $start_pos = index( $self->{doc}, '<', $start_pos + 1 ); + last if $start_pos == -1 || $end_pos == $doc_end; + + # Now $end_pos is end of old tag and $start_pos is start of new + # So do things on the data between the tags as needed + if( $start_pos - $end_pos > 1 ) { + # Call any character data handler + &{$self->{handlers}{char}}($self, substr($self->{doc}, $end_pos + 1, $start_pos - $end_pos - 1)) if defined $self->{handlers}{char}; + + # Inserting the text into the linked list as well +# push @$current_element, [$end_pos + 1, $start_pos - 1]; + } # end if + + # Now finish by incrementing the parser to the next element + $end_pos = index( $self->{doc}, '>', $start_pos + 1 ); + + # If there is no next element, and we're not at the end of the document, + # then throw an error + $self->_error( 'ELM_NOT_CLOSED', $start_pos + $self->{doc_offset} ) if $end_pos == -1; + } # end while + + # Call finalization handler if defined and return it's value + return &{$self->{handlers}{final}}($self) if defined $self->{handlers}{final}; + + # Else return the tree pointer + return $self->{tree}; +} # end _parse_it + +# ---------------------------------------------------------- +# Sub: _get_a_file +# +# Args: $file +# +# Returns: Scalar content of $file, undef on error +# +# Description: Reads from $file and returns the content. +# $file may be either a filename or an IO handle +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 28Aug2001 Added scalar and IO handling JW +# ---------------------------------------------------------- +sub _get_a_file { + my $self = shift; + my $file = shift; + my $content = undef; + + # If it's a ref and a handle, then read that + if( ref($file) ) { + $content = join '', <$file>; + } + # If it's a scalar and the file exits then open it + elsif( -e $file ) { + open( XML, $file ) || return undef; + $content = join '', ; + close XML || return undef; + } + # Don't know how to handle this type of parameter + else { + return undef; + } # end if + + return $content; +} # end _get_a_file + +# ---------------------------------------------------------- +# Sub: _error +# +# Args: $code [, @args] +# $code A code representing the message to send +# +# Returns: Does not. Dies. +# +# Description: Outputs an error message and dies +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# ---------------------------------------------------------- +sub _error { + my $self = shift; + my( $code, @args ) = @_; + my $msg = $self->{ERRORS}{$code}; + + # Handle replacement codes + $msg =~ s/\%(\d+)/$args[$1]/g; + + # Throw exception + die ref($self) . ":$msg\n"; +} # end _error + + +# ---------------------------------------------------------- +# Sub: _store_cdata +# +# Args: $content +# +# Returns: A reference to the CDATA element, padded to +# original size. +# +# Description: Stores the CDATA element in the internal +# hash, and returns a reference plus padding to replace it +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 28Aug2001 Added to support CDATA JW +# ---------------------------------------------------------- +sub _store_cdata { + my $self = shift; + my( $content ) = @_; + my $ref = @{$self->{_CDATA}}; + $self->{_CDATA}[$ref] = $content; + return $ref . ' ' x (length($content) - length($ref)); +} # end _store_cdata + + +# ---------------------------------------------------------- +# Sub: _dump_tree +# +# Args: $node +# $node A starting node, or the root, if not given +# +# Returns: The string to print +# +# Description: Builds a printable tree in a debugging format +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 06Nov2001 Added for debugging tree JW +# ---------------------------------------------------------- +sub _dump_tree { + my $self = shift; + my $node = shift || $self->{tree}; + + my $tree = ''; + for( my $i = 0; $i < scalar(@$node) && defined $node->[$i]; $i++ ) { + if( (scalar(@{$node->[$i]}) == 4) && (defined $node->[$i][2]) ) { + $tree .= '[' . join( ',', @{$node->[$i]} ) . "] " + . substr($self->{doc}, $node->[$i][0], $node->[$i][1] - $node->[$i][0] + 1) + . "..." + . substr($self->{doc}, $node->[$i][2], $node->[$i][3] - $node->[$i][2] + 1) . " (child $i)\n"; + # Do child list + $i++; + $tree .= join( '', map( " $_\n", split( "\n", $self->_dump_tree( $node->[$i] ) ) ) ); + } elsif( (scalar(@{$node->[$i]}) == 4) ) { + $tree .= '[' . join( ',', $node->[$i][0], $node->[$i][1] ) . "] " + . substr($self->{doc}, $node->[$i][0], $node->[$i][1] - $node->[$i][0] + 1) . "\n"; + } else { + $tree .= "ERROR! Invalid node: [" . join( ',', @{$node->[$i]} ) . "]\n"; + } # end for + } # end for + + return $tree; +} # end _dump_tree + +# module clean-up code here (global destructor) +END { } + +1; # so the require or use succeeds + +=back + +=head1 BUGS + +Lots. This 'parser' (Matt Sergeant takes umbrance to my us of that word) will handle some XML +documents, but not all. + +=head1 VERSION + +0.14 + +=head1 AUTHOR + +Jeremy Wadsack for Wadsack-Allen Digital Group (dgsupport@wadsack-allen.com) + +=head1 COPYRIGHT + +Copyright 2001-2003 Wadsack-Allen. All rights reserved. +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + diff --git a/bld/perl5lib/XML/Lite/Element.pm b/bld/perl5lib/XML/Lite/Element.pm new file mode 100644 index 0000000000..388511d89a --- /dev/null +++ b/bld/perl5lib/XML/Lite/Element.pm @@ -0,0 +1,491 @@ +############################################################ +# +# Module: XML::Lite::Element +# +# Created: 27 August 2001 by Jeremy Wadsack for Wadsack-Allen Digital Group +# Copyright (C) 2001 Wadsack-Allen. All rights reserved. +# +# TODO +# * firstChild, lastChild, previousSibling, nextSibling? +# * Equivalent 'parent' method to return enclosing element. +# * Could add to_string methods to reproduce original XML content (incl. tags) (requires that original doc be preserved!) +# * Could add open_tag, close_tag methods to get those parts of content +# +############################################################ +# Date Modification Author +# ---------------------------------------------------------- +# 08Sep2001 Changed ->{parent} to ->{doc} JW +# Changed ->{_positions} to ->{node} JW +############################################################ +package XML::Lite::Element; + +=head1 NAME + +XML::Lite::Element - A class representing an XML element in an XML::Lite +document + +=head1 SYNOPSIS + +use XML::Lite; +my $xml = new XML::Lite( -xml => 'a_file.xml' ); +my $elm = $xml->elements_by_name( 'element_name' ); +print $elm->get_attribute( 'attribute_name' ); + +=head1 DESCRIPTION + +C objects contain rudimentary methods for querying XML +elements in an XML document as parsed by XML::Lite. Usually these objects +are returned by method calls in XML::Lite. + +=head1 METHODS + +The following methods are available. All methods like 'get_name' can be +abbeviated as 'name.' + +=over 4 + +=cut + +use strict; +BEGIN { + use vars qw( $VERSION @ISA ); + $VERSION = '0.14'; + @ISA = qw(); +} # end BEGIN +# non-exported package globals go here +use vars qw(); + +############################ +## The object constructor ## +############################ + +=item my $element = new XML::Lite::Element( $owner_document, \@pointers ); + +Creates a new XML::Lite::Element object from the XML::Lite object, C<$owner_document>. + +Currently, you must not call this manually. You can create an object with one of +the 'factory' methods in XML::Lite, such as C or C +or with one of the XML::Lite::Element 'factory' methods below, like C. + +=cut + +sub new { + my $self = {}; + my $proto = shift; + my $class = ref($proto) || $proto; + + # The arguments are as follows: + # $owner_document is an XML::Lite object within which this element lives + # \@pointers is a two or four element array ref containing the offsets + # into the original document of the start and end points of + # the opening and closing (when it exists) tags for the element + + # Validate arguments + return undef unless @_ >= 2; + return undef unless ref($_[0]) && (ref($_[1]) eq 'ARRAY'); + + # Load 'em up + + # The data structure for the ::Element object has these properties + # doc A reference to the containing XML::Lite object + # node A reference to an array of pointers to our element in the document + # self A pointer to our own entry in the owner doc's tree + # parent A pointer to our parent elemenet's entry in the owner doc's tree + # name The name on our tag + # _attrs A string of the attibutes in our tag (unparsed) + # attrs A hash ref of attributes in our tag + + $self->{doc} = $_[0]; + $self->{node} = $_[1]; + + # Using the pointers, find out tag name, and attribute list from the + # opening tag (if there are any attributes). + my $tag = substr( $self->{doc}{doc}, $self->{node}[0], $self->{node}[1] - $self->{node}[0] + 1 ); + if( $tag =~ m{^<\s*([^/>\s]+)\s+([^>]+)\s*/?\s*>$} ) { + $self->{name} = $1; + $self->{_attrs} = $2; # Store the attributes as a scalar. Parse when asked + } elsif( $tag =~ m{^<\s*([^/>\s]+)\s*/?\s*>$} ) { + $self->{name} = $1; + $self->{_attrs} = ''; + } else { + # Should have been caught in the parsing! maybe an assert? + $self->{doc}->_error( 'ELM_NOT_CLOSED', $self->{node}[0] + $self->{doc}->{doc_offset} ); + } # end if + + # Good. Now returns it. + bless ($self, $class); + return $self; +} # end new + + +########################## +## ## +## Public Methods ## +## ## +########################## + +=item my $content = $element->get_content() + +Returns the content of the XML element. This may include other XML tags. The +entire content is returned as a scalar. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 28Aug2001 Added CDATA retoration JW +# 06Nov2001 Added <.../> optimization JW +# ---------------------------------------------------------- +sub content; +*content = \&get_content; +sub get_content { + my $self = shift; + + # If we don't have any content, then we should return + # '' right away. + return '' unless defined $self->{node}[2]; + + # Using our pointers, find everything between our tags + my $content = substr( $self->{doc}{doc}, $self->{node}[1] + 1, $self->{node}[2] - $self->{node}[1] - 1 ); + + # Now, restore any CDATA chunks that may have been pulled out + $content =~ s//{doc}{_CDATA}[$1]]]>/g; + + # And return the content + return $content; +} # end get_content + + +=item my %attributes = $element->get_attributes() + +Returns a hash of name - value pairs for the attributes in this element. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 13Mar2002 Return empty hash if no attributes EBK +# 31Jan2003 Fixed docs - return hash, not ref JW +# ---------------------------------------------------------- +sub attributes; +*attributes = \&get_attributes; +sub get_attributes { + my $self = shift; + + # Parse the attribute string into a hash of name-value pairs + # unless we've already done that. + $self->_parse_attrs() unless defined $self->{attrs}; + + # Just return a *copy* of the hash (this is read-only after all!) + if ( defined($self->{attrs}) ) { + return %{$self->{attrs}}; + } else { + my %empty; + return %empty; + } +} # end get_attributes + +=item my $value = $element->get_attribute( $name ) + +Returns the value of the named attribute for this element. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# ---------------------------------------------------------- +sub attribute; +*attribute = \&get_attribute; +sub get_attribute { + my $self = shift; + my( $name ) = @_; + + # If we haven't parsed the attribute string into a hash, then do that. + $self->_parse_attrs() unless defined $self->{attrs}; + + # Now return the requested attribute. If it's not there + # then 'undef' is returned + return $self->{attrs}{$name}; +} # end get_attribute + + +=item my $name = $element->get_name() + +Returns the name of the element tag + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# ---------------------------------------------------------- +sub name; +*name = \&get_name; +sub get_name { + my $self = shift; + # Just look it up. We got this in the contructor + return $self->{name}; +} # end get_name + + +=item my @children = $element->get_children() + +Returns a list of XML::Lite::Element objects for each element contained +within the current element. This does not return any text or CDATA in +the content of this element. You can parse that through the L +method. + +If no child elements exist then an empty list is returned. + +=cut + +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 06Sep2001 Added to support tree-like iteration JW +# 04Nov2001 Changed to get_children (with alias) JW +# 05Nov2001 Fixed so that it actually works JW +# 06Nov2001 Added comments, optimizations and bug fixes JW +# ---------------------------------------------------------- +sub children; +*children = \&get_children; +sub get_children { + my $self = shift; + my @children = (); + + # If we don't have any content, then we should return an emtpty + # list right away -- we have no children. + return @children unless defined $self->{node}[2]; + + # We need to traverse the document tree and find our own node + # This will also load {children} and {parent} as well + $self->_find_self() unless defined $self->{self}; + + # Now that we know who we are (if this didn't fail) we can + # iterate through the sub nodes (our child list) and make + # XML::Lite::Elements objects for each child + if( defined $self->{children} ) { + my $i = 0; + my $node = $self->{children}[$i]; + while( defined $node ) { + push @children, XML::Lite::Element->new( $self->{doc}, $node ); + $i++ if (@$node == 4) && (defined $node->[2]); # Skip element's child list if it exists + $node = $self->{children}[++$i]; + } # end while + } # end if + + return @children; +} # end get_children + + +=item my $text = $element->get_text() + +Returns a scalar of the text within an element sans children elements. +This effectively takes the content of the element and strips all XML +elements. All text is concatenated into a single string. White space +is preserved. CDATA elements are included without the optimization JW +# 06Nov2001 Included CDATA text recovery JW +# ---------------------------------------------------------- +sub text; +*text = \&get_text; +sub get_text { + my $self = shift; + my $content = ''; + + # If we don't have any content, then we should return + # $content right away -- we have no text + return $content unless defined $self->{node}[2]; + + # Otherwise get out content and children + my @children = $self->get_children; + my $orig_content = $self->get_content; + + # Then remove the child elements from our content + my $start = 0; + foreach( @children ) { + my $end = $_->{node}[0] - $self->{node}[1] - 1; + $content .= substr( $orig_content, $start, $end - $start); + $start = ($_->{node}[3] || $_->{node}[1]) - $self->{node}[1]; + } # end foreach + $content .= substr( $orig_content, $start ) if $start < length($orig_content); + + # Remove the CDATA wrapper, preserving the content + $content =~ s//$1/g; + + # Return the left-over text + return $content; +} # end get_text + +########################## +## ## +## Private Methods ## +## ## +########################## +# ---------------------------------------------------------- +# Sub: _parse_attrs +# +# Args: (None) +# +# Returns: True value on success, false on failure +# +# Description: Pares the attributes in the element into a hash +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 18Nov2006 Allow whitespace between = and attribute BEE +# value. Allow values to use either single +# or double quotes. +# 08Apr2002 Allow null strings as valid values BEE +# 13Mar2002 Don't do anything if not defined EBK +# ---------------------------------------------------------- +sub _parse_attrs { + my $self = shift; + + my $attrs = $self->{_attrs}; + if ( defined($attrs) ) { + $attrs =~ s/^\s+//; + $attrs =~ s/\s+$//; + $self->{attrs} = {}; + while( $attrs =~ s/^(\S+)\s*=\s*["']([^"]*)["']// ) #" For syntax highlighter + { + $self->{attrs}{$1} = $2; + $attrs =~ s/^\s+//; + } # end while + } + + return 1; +} # end _parse_atttrs + +# ---------------------------------------------------------- +# Sub: _find_self +# +# Args: (None) +# +# Returns: A reference to our node or undef on error +# +# Description: Traverses the owner document's tree to find +# the node that references the current element. Sets +# $self-{self} as a side-effect. Even if this is already set, +# _find_self will traverse again, so don't call unless needed. +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 06Nov2001 Added to support children() method JW +# 13Mar2002 Check that nodes are defined EBK +# ---------------------------------------------------------- +sub _find_self { + my $self = shift; + + # We actually just call this recusively, so the first + # argument can be a starting point to descend from + # but we don't doc that above + my $node = shift || $self->{doc}{tree}; + return undef unless defined $node; + + # Our owner XML::Lite document has a tree (list of lists) that + # tracks all elements in the document. Starting at the root + # of the tree, walk through each node until we find one with + # the same offsets as our $self->{node} has. + + # Walk through the nodes in this node and compare to our selves + for( my $i = 0; $i < scalar(@$node) && defined $node->[$i]; $i++ ) { + + # If this is our self, then we're done! + # NOTE: Since the list references are the same in the by-name hash + # and tree objects, we can just do a reference compare here. + # If objects are ever created with non-factory methods then we need to + # use a _compare_lists call. +# if( _compare_lists( $node->[$i], $self->{node} ) ) { + if( $node->[$i] eq $self->{node} ) { + $self->{parent} = $node; + $self->{self} = $node->[$i]; + # If this list has children, then add a pointer to that list + $self->{children} = $node->[$i + 1] if (scalar(@{$node->[$i]}) == 4) && (defined $node->[$i][2]); + last; + } # end if + + # For efficiency, we only need look at nodes that start before + # our node does + if ( defined($node->[$i][0]) && defined($self->{node}->[3]) ) { + last if $node->[$i][0] > ($self->{node}->[3] || $self->{node}->[1]); + } + + # If this is a node with content (start and end tag) then check children + if( (scalar(@{$node->[$i]}) == 4) && (defined $node->[$i][2]) ) { + # This is a node with content (start and end tag) + # So look at the child node list that follows and see what it's got + $i++; + last if defined $self->_find_self( $node->[$i] ); + } # end for + + } # end for + + # And return it + return $self->{self}; +} # end _find_self + +# ---------------------------------------------------------- +# Sub: _compare_lists +# +# Args: $list_ref_1, $list_ref_2 +# +# Returns: True if the same elements, false otherwise +# +# Description: Compare the contents of two lists and returns +# whether they are the same +# NOTE: This is a CLASS METHOD (or sub) +# ---------------------------------------------------------- +# Date Modification Author +# ---------------------------------------------------------- +# 06Nov2001 Added to support node lookups JW +# ---------------------------------------------------------- +sub _compare_lists { + my( $rA, $rB ) = @_; + + # Lists are not equal unless same size + return 0 unless scalar(@$rA) == scalar(@$rB); + + # Now compare item by item. + my $i; + for( $i = 0; $i < scalar(@$rA); $i++ ) { + return 0 unless $rA->[$i] eq $rB->[$i]; + } # end for + + return 1; +} # end _compare_lists + +# module clean-up code here (global destructor) +END { } + +1; # so the require or use succeeds + +=back + +=head1 VERSION + +0.14 + +=head1 AUTHOR + +Jeremy Wadsack for Wadsack-Allen Digital Group (dgsupport@wadsack-allen.com) + +=head1 COPYRIGHT + +Copyright 2001 Wadsack-Allen. All rights reserved. +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + diff --git a/bld/perl5lib/XML/README b/bld/perl5lib/XML/README new file mode 100644 index 0000000000..6234a760ce --- /dev/null +++ b/bld/perl5lib/XML/README @@ -0,0 +1,20 @@ +XML::Lite + +A light-weight, read-only XML parser for small files + +This XML parser is written in pure perl and provides basic methods +for most things you need to do with XML files. + +It is not dependent on any other modules or external programs for installation. + +NOTE that this parser will do many things that you want with XML but +not everything. It is not a validating parser! It will not handle +international characters (unless run on those systems). Use +at your own risk. + +Copyright 2001-2003 Wadsack-Allen. All rights reserved. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + diff --git a/bld/perl5lib/XML/man3/XML_Lite.3 b/bld/perl5lib/XML/man3/XML_Lite.3 new file mode 100644 index 0000000000..f2b3912ed7 --- /dev/null +++ b/bld/perl5lib/XML/man3/XML_Lite.3 @@ -0,0 +1,213 @@ +.\" Automatically generated by Pod::Man version 1.02 +.\" Tue Mar 18 09:37:35 2003 +.\" +.\" Standard preamble: +.\" ====================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Ip \" List item +.br +.ie \\n(.$>=3 .ne \\$3 +.el .ne 3 +.IP "\\$1" \\$2 +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R + +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. | will give a +.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used +.\" to do unbreakable dashes and therefore won't be available. \*(C` and +.\" \*(C' expand to `' in nroff, nothing in troff, for use with C<> +.tr \(*W-|\(bv\*(Tr +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` ` +. ds C' ' +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr +.\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and +.\" index entries marked with X<> in POD. Of course, you'll have to process +.\" the output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +. . +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it +.\" makes way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +.bd B 3 +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ====================================================================== +.\" +.IX Title "Lite 3" +.TH Lite 3 "perl v5.6.0" "2003-03-17" "User Contributed Perl Documentation" +.UC +.SH "NAME" +\&\s-1XML:\s0:Lite \- A lightweight \s-1XML\s0 parser for simple files +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use \s-1XML:\s0:Lite; +my \f(CW$xml\fR = new \s-1XML:\s0:Lite( xml => 'a_file.xml' ); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +\&\s-1XML:\s0:Lite is a lightweight \s-1XML\s0 parser, with basic element traversing +methods. It is entirely self-contained, pure Perl (i.e. \fInot\fR based on +expat). It provides useful methods for reading most \s-1XML\s0 files, including +traversing and finding elements, reading attributes and such. It is +designed to take advantage of Perl-isms (Attribute lists are returned as +hashes, rather than, say, lists of objects). It provides only methods +for reading a file, currently. +.SH "METHODS" +.IX Header "METHODS" +The following methods are available: +.Ip "my \f(CW$xml\fR = new \s-1XML:\s0:Lite( xml => \f(CW$source\fR[, ...] );" 4 +.IX Item "my $xml = new XML::Lite( xml => $source[, ...] );" +Creates a new \s-1XML:\s0:Lite object. The \s-1XML:\s0:Lite object acts as the document +object for the \f(CW$source\fR that is sent to it to parse. This means that you +create a new object for each document (or document sub-section). As the +objects are lightweight this should not be a performance consideration. +.Sp +The object constructor can take several named parameters. Parameter names +may begin with a '\-' (as in the example above) but are not required to. The +following parameters are recognized. +.Sp +.Vb 2 +\& xml The source XML to parse. This can be a filename, a scalar that +\& contains the document (or document fragment), or an IO handle. +.Ve +As a convenince, if only on parameter is given, it is assumed to be the source. +So you can use this, if you wish: +.Sp +.Vb 1 +\& my $xml = new XML::Lite( 'file.xml' ); +.Ve +.Ip "my \f(CW$elm\fR = \f(CW$xml\fR->\fIroot_element()\fR" 4 +.IX Item "my $elm = $xml->root_element()" +Returns a reference to an \s-1XML:\s0:Lite::Element object that represents +the root element of the document. +.Sp +Returns \f(CW\*(C`undef\*(C'\fR on errors. +.Ip "@list = \f(CW$xml\fR->elements_by_name( \f(CW$name\fR )" 4 +.IX Item "@list = $xml->elements_by_name( $name )" +Returns a list of all elements that match \f(CW\*(C`$name\*(C'\fR. +\&\f(CW\*(C`@list\*(C'\fR is a list of the XML::Lite::Element manpage objects +If called in a scalar context, this will return the +first element found that matches (it's more efficient +to call in a scalar context than assign the results +to a list of one scalar). +.Sp +If no matching elements are found then returns \f(CW\*(C`undef\*(C'\fR +in scalar context or an empty list in array context. +.SH "BUGS" +.IX Header "BUGS" +Lots. This 'parser' (Matt Sergeant takes umbrance to my us of that word) will handle some \s-1XML\s0 +documents, but not all. +.SH "VERSION" +.IX Header "VERSION" +0.14 +.SH "AUTHOR" +.IX Header "AUTHOR" +Jeremy Wadsack for Wadsack-Allen Digital Group (dgsupport@wadsack-allen.com) +.SH "COPYRIGHT" +.IX Header "COPYRIGHT" +Copyright 2001\-2003 Wadsack-Allen. All rights reserved. +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. diff --git a/bld/perl5lib/XML/man3/XML_Lite_Element.3 b/bld/perl5lib/XML/man3/XML_Lite_Element.3 new file mode 100644 index 0000000000..5eaf684214 --- /dev/null +++ b/bld/perl5lib/XML/man3/XML_Lite_Element.3 @@ -0,0 +1,206 @@ +.\" Automatically generated by Pod::Man version 1.02 +.\" Tue Mar 18 09:37:36 2003 +.\" +.\" Standard preamble: +.\" ====================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Ip \" List item +.br +.ie \\n(.$>=3 .ne \\$3 +.el .ne 3 +.IP "\\$1" \\$2 +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R + +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. | will give a +.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used +.\" to do unbreakable dashes and therefore won't be available. \*(C` and +.\" \*(C' expand to `' in nroff, nothing in troff, for use with C<> +.tr \(*W-|\(bv\*(Tr +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` ` +. ds C' ' +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr +.\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and +.\" index entries marked with X<> in POD. Of course, you'll have to process +.\" the output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +. . +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it +.\" makes way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +.bd B 3 +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ====================================================================== +.\" +.IX Title "Lite::Element 3" +.TH Lite::Element 3 "perl v5.6.0" "2003-01-31" "User Contributed Perl Documentation" +.UC +.SH "NAME" +\&\s-1XML:\s0:Lite::Element \- A class representing an \s-1XML\s0 element in an \s-1XML:\s0:Lite +document +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use \s-1XML:\s0:Lite; +my \f(CW$xml\fR = new \s-1XML:\s0:Lite( \-xml => 'a_file.xml' ); +my \f(CW$elm\fR = \f(CW$xml\fR->elements_by_name( 'element_name' ); +print \f(CW$elm\fR->get_attribute( 'attribute_name' ); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +\&\f(CW\*(C`XML::Lite::Element\*(C'\fR objects contain rudimentary methods for querying \s-1XML\s0 +elements in an \s-1XML\s0 document as parsed by \s-1XML:\s0:Lite. Usually these objects +are returned by method calls in \s-1XML:\s0:Lite. +.SH "METHODS" +.IX Header "METHODS" +The following methods are available. All methods like 'get_name' can be +abbeviated as 'name.' +.Ip "my \f(CW$element\fR = new \s-1XML:\s0:Lite::Element( \f(CW$owner_document\fR, \e@pointers );" 4 +.IX Item "my $element = new XML::Lite::Element( $owner_document, @pointers );" +Creates a new \s-1XML:\s0:Lite::Element object from the \s-1XML:\s0:Lite object, \f(CW\*(C`$owner_document\*(C'\fR. +.Sp +Currently, you must not call this manually. You can create an object with one of +the 'factory' methods in \s-1XML:\s0:Lite, such as \f(CW\*(C`element_by_name\*(C'\fR or \f(CW\*(C`root_element\*(C'\fR +or with one of the \s-1XML:\s0:Lite::Element 'factory' methods below, like \f(CW\*(C`get_children\*(C'\fR. +.Ip "my \f(CW$content\fR = \f(CW$element\fR->\fIget_content()\fR" 4 +.IX Item "my $content = $element->get_content()" +Returns the content of the \s-1XML\s0 element. This may include other \s-1XML\s0 tags. The +entire content is returned as a scalar. +.Ip "my \f(CW%attributes\fR = \f(CW$element\fR->\fIget_attributes()\fR" 4 +.IX Item "my %attributes = $element->get_attributes()" +Returns a hash of name \- value pairs for the attributes in this element. +.Ip "my \f(CW$value\fR = \f(CW$element\fR->get_attribute( \f(CW$name\fR )" 4 +.IX Item "my $value = $element->get_attribute( $name )" +Returns the value of the named attribute for this element. +.Ip "my \f(CW$name\fR = \f(CW$element\fR->\fIget_name()\fR" 4 +.IX Item "my $name = $element->get_name()" +Returns the name of the element tag +.Ip "my \f(CW@children\fR = \f(CW$element\fR->\fIget_children()\fR" 4 +.IX Item "my @children = $element->get_children()" +Returns a list of \s-1XML:\s0:Lite::Element objects for each element contained +within the current element. This does not return any text or \s-1CDATA\s0 in +the content of this element. You can parse that through the the get_content manpage +method. +.Sp +If no child elements exist then an empty list is returned. +.Ip "my \f(CW$text\fR = \f(CW$element\fR->\fIget_text()\fR" 4 +.IX Item "my $text = $element->get_text()" +Returns a scalar of the text within an element sans children elements. +This effectively takes the content of the element and strips all \s-1XML\s0 +elements. All text is concatenated into a single string. White space +is preserved. \s-1CDATA\s0 elements are included without the $utmp$ + v = infile[:]->$vtmp$ + t = infile[:]->$ttmp$ + q = infile[:]->$qtmp$ + omega = infile[:]->$otmp$ + + p0= 100000 + p0!0 = "ncl_scalar" + hyam= infile[0]->hyam + hybm= infile[0]->hybm + hyai= infile[0]->hyai + hybi= infile[0]->hybi + ps= infile[:]->$pstmp$ + +;Convert lev to Pa + + lev= infile[0]->lev*100 + lev!0 = "lev" + lev&lev = lev + ilev= infile[0]->ilev*100 + ilev!0 = "ilev" + ilev&ilev = ilev + + divq = infile[:]->$taqtmp$ + +; Calculate divT + + divq!2="lat" + divq!3="lon" +; printVarSummary(divq) +; exit + + divT = divq + divT@long_name="T horz + vert + fixer tendency (TTEND_TOT-PTTEND)" + divT@mdims=1 + divT@units="K/s" + + ttendtot = infile[:]->$tttmp$ + pttend = infile[:]->$pttmp$ + divT=ttendtot-pttend +; +; create tsec +; + atime=infile[:]->time + datestrs = str_split(atime@units," ") + yyyymmddstr=str_split(datestrs(2),"-") + yyyy=tointeger(yyyymmddstr(0)) + mm=tointeger(yyyymmddstr(1)) + dd=tointeger(yyyymmddstr(2)) + nbdate=yyyy*10000+mm*100+dd + nbdate!0 = "ncl_scalar" + if (dimsizes(datestrs).le.3) then + nbsec=0 + tounits="seconds "+datestrs(1)+" "+datestrs(2) + else + hhmmssstrs=str_split(datestrs(3),":") + nbsec=tointeger(hhmmssstrs(0))*3600+tointeger(hhmmssstrs(1))*60+tointeger(hhmmssstrs(2)) + tounits="seconds "+datestrs(1)+" "+datestrs(2)+" "+datestrs(3) + end if + tsec=(cd_convert(atime,tounits)) + tsec!0="time" + tsec&time=atime + tsec@units=tounits + tsec@long_name=tounits +; +; output new variables directly +; + outfile->omega = omega + outfile->tsec = tsec + outfile->bdate = nbdate + outfile->nbdate = infile[0]->nbdate + outfile->nbsec = infile[0]->nbsec + outfile->u = u + outfile->v = v + outfile->t = t + outfile->q = infile[:]->$qtmp$ + outfile->Ps = infile[:]->$pstmp$ + outfile->Tsair = infile[:]->$tstmp$ + outfile->lev = lev + outfile->ilev = ilev + outfile->p0 = p0 + outfile->hyam= infile[0]->hyam + outfile->hybm= infile[0]->hybm + outfile->hyai= infile[0]->hyai + outfile->hybi= infile[0]->hybi + +;Rename dimensions in output file. + + system("ncrename -d lat_physgrid"+locy+",lat "+opth+outfilename) + system("ncrename -d lon_physgrid"+locx+",lon "+opth+outfilename) + system("ncrename -v lat_physgrid"+locy+",lat "+opth+outfilename) + system("ncrename -v lon_physgrid"+locx+",lon "+opth+outfilename) + +;add global atribute + + system("ncatted -a CAM_GENERATED_FORCING,global,c,c,'yes' "+opth+outfilename) + +;now write the fields with correct dimensions + + delete(outfile) + outfile2 = addfile(opth+outfilename,"w") + + outfile2->Q_dten = divq + outfile2->divT3d = divT + +end diff --git a/bld/scripts/create_scam6_iop b/bld/scripts/create_scam6_iop new file mode 100755 index 0000000000..45eb46c2a7 --- /dev/null +++ b/bld/scripts/create_scam6_iop @@ -0,0 +1,137 @@ +#!/bin/csh -fv + +#********************************************************************** +# Run SCAM with a single IOP +# This script will build and run one IOP +# If a user wishes to run more than one IOP, use create_scam6_iop_multi +# +# Usage: +# ./create_scam6_iop # where IOP name is from list below +# - or - +# ./create_scam6_iop # IOP is specified in the script below +#********************************************************************** + +#------------------ +# User sets options in this section +#------------------ + +### Full path of cesm source code and case (output) directories (see examples) + +# set CESMDIR=/project/amp/$USER/collections/cam5_4_175 +# set CASEDIR=/project/amp/$USER/cases +set CESMDIR= +set CASEDIR= + +### Case Name + +#set CASETITLE=scam_test +set CASETITLE= + +### Set location of user source mods (if any) +setenv this_dir `pwd` +setenv usrsrc ${this_dir}/mods/$CASETITLE + +### Standard Run Settings +set RES=T42_T42 +set COMPSET=FSCAM +set COMPILER=intel + +### Set Desired IOP +### $1 means read from command line. Or put one of the names in: +### arm95 arm97 atex bomex cgilsS11 cgilsS12 cgilsS6 dycomsRF01 dycomsRF02 gateIII mpace rico sparticus togaII twp06 + +set IOP = $1 + +#------------------ +# User should not need to set any options in this section +#------------------ + +cd $CASEDIR + +set IOPNAME = scam_$IOP + +## location of IOP data in CESM Tag +set MODSDIR = $CESMDIR/components/cam/cime_config/usermods_dirs + +#Create full casename +set CASENAME=${CASETITLE}.${COMPSET}.${IOP} + +#------------------ +# create case +#------------------ + +$CESMDIR/cime/scripts/create_newcase --compset $COMPSET --res $RES --compiler $COMPILER --case $CASEDIR/$CASENAME --user-mods-dir ${MODSDIR}/${IOPNAME} --run-unsupported + +cd $CASEDIR/$CASENAME + +### Set build and run directories to be under case directory. + +set RUNDIR=${CASEDIR}/${CASENAME}/run +./xmlchange RUNDIR=$RUNDIR + +./xmlchange EXEROOT=${CASEDIR}/${CASENAME}/bld + +#------------------ +# XMLCHANGE OPTIONS HERE +#------------------ + +### Append to CAM configure options +# ./xmlchange --append CAM_CONFIG_OPTS=' ' + +### DEBUG +#./xmlchange DEBUG='TRUE' + +#------------------ +# Setup Case +#------------------ + +./case.setup +# ./case.setup -d -v #-d -v for verbose and debug file + +#------------------ +# source mods: copy them into case directory +#------------------ + +/bin/cp ${usrsrc}/* SourceMods/src.cam/ + +#------------------ +# Build +#------------------ + +./case.build +# ./case.build -d -v #-d -v for verbose and debug file + +### make timing dir kludge [REMOVE WHEN FIXED] +mkdir -p $RUNDIR/timing/checkpoints + +#------------------ +# Add all user specific cam namelist changes here +# +# Users should add all user specific namelist changes below in the form of +# namelist_var = new_namelist_value +# Namelist settings which appear in usermods_dir and here will use the values +# specified below +# Other namelist settings from usermods_dirs will be unchanged +# Output can also be specified here (e.g. fincl1) +#------------------ + +cat >> user_nl_cam << EOF + use_topo_file = .true. + mfilt = 2500 + nhtfrq = 1 + fincl1= 'CDNUMC', 'AQSNOW','ANSNOW','FREQSL','LS_FLXPRC' +EOF + +#------------------ +# Choose type of job submission (batch or interactive) +#------------------ + +### Submit to Queue (If you have one) +#./case.submit + +### OR you can run interactively instead of going through the queue +#cd $RUNDIR +#../bld/cesm.exe + + + diff --git a/bld/scripts/create_scam6_iop_multi b/bld/scripts/create_scam6_iop_multi new file mode 100755 index 0000000000..08bd383bda --- /dev/null +++ b/bld/scripts/create_scam6_iop_multi @@ -0,0 +1,142 @@ +#!/bin/csh -fv + +#********************************************************************** +# Run SCAM with one of more IOPs in an efficient manner +# This script will build the code once and loop over the running of the IOPs +# +# Usage: +# ./create_scam6_iop_multi # IOP(s) are specified in the script below +#********************************************************************** + +#------------------ +# User sets options in this section +#------------------ + +### Full path of cesm source code and case (output) directories + +# set CESMDIR=/project/amp/$USER/collections/cam5_4_175 +# set CASEDIR=/project/amp/$USER/cases +set CESMDIR= +set CASEDIR= + +### Case Name + +#set CASETITLE=scam_test +set CASETITLE= + +### Set location of user source mods (if any) +setenv this_dir `pwd` +setenv usrsrc ${this_dir}/mods/$CASETITLE + +### Standard Run Settings +set RES=T42_T42 +set COMPSET=FSCAM +set COMPILER=intel + +#------------------ +# User should not need to set any options in this section +#------------------ + +cd $CASEDIR + +## location of IOP data in CESM Tag +set MODSDIR = $CESMDIR/components/cam/cime_config/usermods_dirs + +set CASENAME=${CASETITLE}.${COMPSET} + + +#------------------ +# create case +# scam_mandatory sets up the SCAM run for use with subsequent IOP(s) +#------------------ +$CESMDIR/cime/scripts/create_newcase --compset $COMPSET --res $RES --compiler $COMPILER --case $CASEDIR/$CASENAME.base --user-mods-dir ${MODSDIR}/scam_mandatory --run-unsupported + +cd $CASEDIR/$CASENAME.base + +### Set build and run directories to be under case directory. + +set RUNDIR=${CASEDIR}/${CASENAME}.base/run +./xmlchange RUNDIR=$RUNDIR + +./xmlchange EXEROOT=${CASEDIR}/${CASENAME}.base/bld + +#------------------ +# XMLCHANGE OPTIONS HERE +#------------------ + +### Append to CAM configure options +# ./xmlchange --append CAM_CONFIG_OPTS=' ' + +### DEBUG +#./xmlchange DEBUG='TRUE' + +#------------------ +# Setup Case +#------------------ + +./case.setup +# ./case.setup -d -v #-d -v for verbose and debug file + +#------------------ +# source mods: copy them into case directory +#------------------ + +/bin/cp ${usrsrc}/* SourceMods/src.cam/ + +#------------------ +# Build +#------------------ + +./case.build +# ./case.build -d -v #-d -v for verbose and debug file + +#------------------ +# Set Desired IOP(s) +# Available IOPs for CESM2/SCAM6: +# arm95 arm97 atex bomex cgilsS11 cgilsS12 cgilsS6 dycomsRF01 dycomsRF02 gateIII mpace rico sparticus togaII twp06 +#------------------ + +foreach IOP (arm95 arm97 atex bomex cgilsS11 cgilsS12 cgilsS6 dycomsRF01 dycomsRF02 gateIII mpace rico sparticus togaII twp06) + + cd $CASEDIR + + #------------------ + # create and run case + #------------------ + + $CESMDIR/cime/scripts/create_clone --clone $CASEDIR/$CASENAME.base --case $CASEDIR/$CASENAME.$IOP --user-mods-dir ${MODSDIR}/scam_$IOP --keepexe + + cd $CASEDIR/$CASENAME.$IOP + + ### set run directory (here under case directory) + set RUNDIR=${CASEDIR}/${CASENAME}.$IOP/run + ./xmlchange RUNDIR=$RUNDIR + + ### make timing dir kludge [REMOVE WHEN FIXED] + mkdir -p $RUNDIR/timing/checkpoints + + #------------------ + # Add all user specific cam namelist changes here + # + # Users should add all user specific namelist changes below in the form of + # namelist_var = new_namelist_value + # Namelist settings which appear in usermods_dir and here will use the values + # specified below + # Other namelist settings from usermods_dirs will be unchanged + # Output can also be specified here (e.g. fincl1) + #------------------ + + cat >> user_nl_cam << EOF + use_topo_file = .true. + mfilt = 2500 + nhtfrq = 1 + fincl1= 'CDNUMC', 'AQSNOW','ANSNOW','FREQSL','LS_FLXPRC' +EOF + + #------------------ + # Submit to Queue + #------------------ + + ./case.submit + +end #foreach iop diff --git a/cime_config/buildcpp b/cime_config/buildcpp new file mode 100644 index 0000000000..c2e3f03d0d --- /dev/null +++ b/cime_config/buildcpp @@ -0,0 +1,128 @@ +#!/usr/bin/env python + +""" +API for cam's configure +""" + +import os, sys, re + +CIMEROOT = os.environ.get("CIMEROOT") +if CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") +sys.path.append(os.path.join(CIMEROOT, "scripts", "Tools")) + +from standard_script_setup import * + +from CIME.utils import run_cmd_no_fail, expect +from CIME.utils import run_cmd +from CIME.case import Case +from CIME.buildnml import parse_input + +import glob, shutil +logger = logging.getLogger(__name__) + +############################################################################### +def buildcpp(case): +############################################################################### + """ + Invoke cam configure - output goes in `caseroot`/Buildconf/camconf + """ + caseroot = case.get_value("CASEROOT") + srcroot = case.get_value("SRCROOT") + exeroot = case.get_value("EXEROOT") + atm_grid = case.get_value("ATM_GRID") + pts_mode = case.get_value("PTS_MODE") + cam_dycore = case.get_value("CAM_DYCORE") + comp_ocn = case.get_value("COMP_OCN") + docn_mode = case.get_value("DOCN_MODE") + mpilib = case.get_value("MPILIB") + compiler = case.get_value("COMPILER") # for chem preprocessor + nthrds_atm = case.get_value("NTHRDS_ATM") + cam_config_opts = case.get_value("CAM_CONFIG_OPTS") + + # level information for CAM is part of the atm grid name - and must be stripped out + nlev = '' + match = re.match('(.+)z(\d+)',atm_grid) + if match: + atm_grid = match.groups()[0] + nlev = match.groups()[1] + + # The following translation is hard-wired for backwards compatibility + # to support the differences between how the scripts specify the land grid + # and how it is specified internally + + if atm_grid == 'T31': + atm_grid = '48x96' + if atm_grid == 'T42': + atm_grid = '64x128' + if atm_grid == 'T85': + atm_grid = '128x256' + if atm_grid == 'T341': + atm_grid = '512x1024' + + # if need to build - then construct configure command + config_opts = ["-s", "-fc_type", compiler, "-ccsm_seq", + "-dyn", cam_dycore, "-hgrid", atm_grid, + "-usr_src", os.path.join(caseroot, "SourceMods", "src.cam")] + + if nlev: + config_opts += ["-nlev", nlev] + + # Some settings for single column mode. + if pts_mode: + config_opts.append("-scam") + + if mpilib == 'mpi-serial': + config_opts.append("-nospmd") + else: + config_opts.append("-spmd") + + if int(nthrds_atm) == 1: + config_opts.append("-nosmp") + else: + config_opts.append("-smp") + + # The ocean component setting is only used by CAM to do attribute matching for + # setting default tuning parameter values. In SOM mode we want to use the same + # tunings as the fully coupled B compset, so set the ocean component to pop in + # that case. + + ocn = comp_ocn + if docn_mode == 'som': + config_opts += ["-ocn", "pop"] + else: + config_opts += ["-ocn", comp_ocn] + + # Add user options. + config_opts += cam_config_opts.split(" ") + + if "-cosp" in config_opts: + config_opts += ["-cosp_libdir", os.path.join(exeroot,"atm","obj","cosp")] + + camconf = os.path.join(caseroot, "Buildconf", "camconf") + if not os.path.isdir(camconf): + os.makedirs(camconf) + + # Construct the command itself. + cmd = os.path.join(srcroot,"components","cam","bld","configure") + " " + " ".join(config_opts) + run_cmd_no_fail(cmd, from_dir=camconf) + + # determine cppdefs - caseroot/camconf/CESM_cppdefs is created by the call to configure + with open(os.path.join(camconf, "CESM_cppdefs"), 'r') as f: + user_cppdefs = f.readline().rstrip() + if user_cppdefs: + case.set_value("CAM_CPPDEFS",user_cppdefs) + case.flush() + + return user_cppdefs + +############################################################################### +def _main_func(): + + caseroot = parse_input(sys.argv) + with Case(caseroot) as case: + cam_cppdefs = buildcpp(case) + logger.info("CAM_CPPDEFS: %s" %cam_cppdefs) + +if __name__ == "__main__": + _main_func() diff --git a/cime_config/buildlib b/cime_config/buildlib new file mode 100755 index 0000000000..6545615958 --- /dev/null +++ b/cime_config/buildlib @@ -0,0 +1,84 @@ +#!/usr/bin/env python + +""" +create the cam library +""" +import sys, os, filecmp, shutil, re, imp + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") + +_LIBDIR = os.path.join(_CIMEROOT, "scripts", "Tools") +sys.path.append(_LIBDIR) + +from standard_script_setup import * +from CIME.case import Case +from CIME.utils import run_cmd, expect +from CIME.buildlib import parse_input + +logger = logging.getLogger(__name__) + +############################################################################### +def _build_cam(): +############################################################################### + + caseroot, libroot, bldroot = parse_input(sys.argv) + + with Case(caseroot) as case: + + casetools = case.get_value("CASETOOLS") + srcroot = case.get_value("SRCROOT") + gmake_j = case.get_value("GMAKE_J") + gmake = case.get_value("GMAKE") + mach = case.get_value("MACH") + + #------------------------------------------------------- + # Call cam's buildcpp + #------------------------------------------------------- + cmd = os.path.join(os.path.join(srcroot,"components","cam","cime_config","buildcpp")) + logger.info(" ...calling cam buildcpp to set build time options") + try: + mod = imp.load_source("buildcpp", cmd) + cam_cppdefs = mod.buildcpp(case) + except: + raise + + #------------------------------------------------------- + # Filepath is created in caseroot/camconf by the call + # to buildcpp - this needs to be copied to bldroot + #------------------------------------------------------- + filesrc = os.path.join(caseroot, "Buildconf", "camconf", "Filepath") + filedst = os.path.join(bldroot, "Filepath_tmp") + shutil.copy(filesrc,filedst) + + filedst = os.path.join(bldroot, "Filepath") + filedst_tmp = os.path.join(bldroot, "Filepath_tmp") + if os.path.isfile(filedst): + if not filecmp.cmp(filedst_tmp, filedst): + shutil.move(filedst_tmp, filedst) + else: + shutil.move(filedst_tmp, filedst) + + #------------------------------------------------------- + # build the library + #------------------------------------------------------- + complib = os.path.join(libroot, "libatm.a") + makefile = os.path.join(casetools, "Makefile") + macfile = os.path.join(caseroot, "Macros.%s" % mach) + + if cam_cppdefs: + cmd = "%s complib -j %d MODEL=cam COMPLIB=%s -f %s MACFILE=%s USER_CPPDEFS='%s'" \ + % (gmake, gmake_j, complib, makefile, macfile, cam_cppdefs ) + else: + cmd = "%s complib -j %d MODEL=cam COMPLIB=%s -f %s MACFILE=%s " \ + % (gmake, gmake_j, complib, makefile, macfile ) + + rc, out, err = run_cmd(cmd) + logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n"%(cmd,out,err)) + expect(rc == 0, "Command %s failed with rc=%s" % (cmd, rc)) + +############################################################################### + +if __name__ == "__main__": + _build_cam() diff --git a/cime_config/buildnml b/cime_config/buildnml new file mode 100755 index 0000000000..d05e3df84a --- /dev/null +++ b/cime_config/buildnml @@ -0,0 +1,215 @@ +#!/usr/bin/env python + +""" +CAM namelist creator +""" +import sys, os, time, shutil, re, filecmp, imp + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") + +_LIBDIR = os.path.join(_CIMEROOT, "scripts", "Tools") +sys.path.append(_LIBDIR) + +from standard_script_setup import * +from CIME.XML.standard_module_setup import * +from CIME.buildnml import create_namelist_infile, parse_input +from CIME.case import Case +from CIME.utils import expect, run_cmd + +logger = logging.getLogger(__name__) + +############################################################################### +def buildnml(case, caseroot, compname): +############################################################################### + """Build the cam namelist """ + + # Build the component namelist + if compname != "cam": + raise AttributeError + + srcroot = case.get_value("SRCROOT") + rundir = case.get_value("RUNDIR") + din_loc_root = case.get_value("DIN_LOC_ROOT") + atm_ncpl = case.get_value("ATM_NCPL") + CAM_NAMELIST_OPTS = case.get_value("CAM_NAMELIST_OPTS") + CAM_NML_USE_CASE = case.get_value("CAM_NML_USE_CASE") + DEBUG = case.get_value("DEBUG") + NTASKS_ATM = case.get_value("NTASKS_ATM") + NINST_ATM = case.get_value("NINST_ATM") + RUN_TYPE = case.get_value("RUN_TYPE") + RUN_STARTDATE = case.get_value("RUN_STARTDATE") + RUN_REFCASE = case.get_value("RUN_REFCASE") + RUN_REFDATE = case.get_value("RUN_REFDATE") + RUN_REFTOD = case.get_value("RUN_REFTOD") + + testsrc = os.path.join(srcroot, "components", "cam") + if os.path.exists(testsrc): + srcroot = testsrc + + #-------------------------------------------------------------------- + # call buildcpp to set both cppdefs and config_cache.xml file for generating namelist + #-------------------------------------------------------------------- + call_buildcpp = False + if not os.path.exists(os.path.join(caseroot,"LockedFiles","env_build.xml")): + call_buildcpp = True + else: + file1 = os.path.join(caseroot,"env_build.xml") + file2 = os.path.join(caseroot,"LockedFiles","env_build.xml") + if not filecmp.cmp(file1, file2): + call_buildcpp = True + if call_buildcpp: + cmd = os.path.join(os.path.join(srcroot,"cime_config","buildcpp")) + logger.info(" ...calling cam buildcpp to set build time options") + try: + mod = imp.load_source("buildcpp", cmd) + mod.buildcpp(case) + except: + raise + + # Verify that we have a config_cache file (generated by the call to buildcpp) + camconf = os.path.join(caseroot, "Buildconf", "camconf") + filename = os.path.join(camconf, "config_cache.xml") + expect(os.path.isfile(filename), + " Missing config_cache.xml - cannot run build-namelist") + + #-------------------------------------------------------------------- + # Invoke cam build-namelist - output will go in $CASEROOT/Buildconf/camconf + #-------------------------------------------------------------------- + + ninst = int(NINST_ATM) + for inst_counter in range(1, ninst+1): + + # ----------------------------------------------------- + # determine instance string + # ----------------------------------------------------- + + inst_string = "" + if ninst > 1: + single_case_rpointer = os.path.join(rundir, "rpointer.atm") + inst_string = '_%04d' % inst_counter + instance_rpointer = os.path.join(rundir,"rpointer.atm"+inst_string) + + # If multi-instance case does not have restart file, use + # single-case restart for each instance + + if os.path.isfile(single_case_rpointer) and \ + not os.path.isfile(instance_rpointer): + shutil.copy(single_case_rpointer, instance_rpointer) + + # ----------------------------------------------------- + # create camconf/namelist + # ----------------------------------------------------- + + infile_lines = [] + + # This simplifies the filename mangling for different cases. + def create_ic_filename(inst_string, i_or_r): + return "%s.cam%s.%s.%s-%s.nc" % \ + (RUN_REFCASE, inst_string, i_or_r, RUN_REFDATE, RUN_REFTOD) + + if RUN_TYPE == 'hybrid': + ncdata = create_ic_filename(inst_string, 'i') + # Fallback if no instance-specific file is found. + if not os.path.isfile(os.path.join(rundir, ncdata)): + ncdata = create_ic_filename('', 'i') + infile_lines.append(" ncdata = '" + ncdata + "'") + if ninst > 1: + logger.info("%s is being used for ncdata" % ncdata) + + if RUN_TYPE == 'branch': + cam_branch_file = create_ic_filename(inst_string, 'r') + # Fallback if no instance-specific file is found. + if not os.path.isfile(os.path.join(rundir, cam_branch_file)): + cam_branch_file = create_ic_filename('', 'r') + infile_lines.append(" cam_branch_file = '" + cam_branch_file + "'") + if ninst > 1: + logger.info("%s is being used for cam_branch_file" % cam_branch_file) + + dtime = ( 3600 * 24 ) / int(atm_ncpl) + infile_lines.append(" dtime = " + str(dtime)) + start_ymd = RUN_STARTDATE.replace('-','') + infile_lines.append(" start_ymd = " + start_ymd) + + if DEBUG: + infile_lines.append(" state_debug_checks = .true.") + + user_nl_file = os.path.join(caseroot, "user_nl_cam" + inst_string) + namelist_infile = os.path.join(camconf, "namelist") + + create_namelist_infile(case, user_nl_file, namelist_infile, "\n".join(infile_lines)) + + # ----------------------------------------------------- + # call build-namelist + # ----------------------------------------------------- + + ntasks = int(NTASKS_ATM) / ninst +# waiting for cime to implement this +# ntasks = int(case.get_value("NTASKS_PER_INST_ATM")) + + buildnl_opts = ["-ntasks", str(ntasks), "-csmdata", din_loc_root, + "-infile", os.path.join(camconf, "namelist")] + + if ('-01-01' in RUN_STARTDATE) or ('-09-01' in RUN_STARTDATE): + buildnl_opts.append("-ignore_ic_year") + else: + buildnl_opts.append("-ignore_ic_date") + + if CAM_NML_USE_CASE != 'UNSET': + buildnl_opts += ["-use_case", CAM_NML_USE_CASE] + + input_data_list = os.path.join(caseroot, "Buildconf", "cam.input_data_list") + if os.path.isfile(input_data_list): + os.remove(input_data_list) + buildnl_opts += ["-inputdata", input_data_list] + + buildnl_opts += ["-namelist", + '" &atmexp ' + CAM_NAMELIST_OPTS + '/" '] + + cmd = os.path.join(srcroot, "bld", "build-namelist") + cmd += " " + " ".join(buildnl_opts) + + rc, out, err = run_cmd(cmd, from_dir=camconf) + expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + + # ----------------------------------------------------- + # copy resolved namelist, atm_in, to rundir + # ----------------------------------------------------- + + if os.path.isdir(rundir): + file1 = os.path.join(camconf, "atm_in") + file2 = os.path.join(rundir, "atm_in") + if ninst > 1: + file2 += inst_string + logger.info("CAM namelist copy: file1 %s file2 %s " %(file1, file2)) + shutil.copy(file1,file2) + + # ----------------------------------------------------- + # copy drv_flds_in to rundir if it does not exist + # ----------------------------------------------------- + + file1 = os.path.join(camconf, "drv_flds_in") + file2 = os.path.join(rundir, "drv_flds_in") + if (os.path.isfile(file1)) and (not os.path.isfile(file2)): + shutil.copy(file1,file2) + + # ----------------------------------------------------- + # copy aquap_in to rundir if it exists + # ----------------------------------------------------- + + file1 = os.path.join(camconf, "aquap_in") + file2 = os.path.join(rundir, "aquap_in") + if (os.path.isfile(file1)): + shutil.copy(file1,file2) + +############################################################################### +def _main_func(): + + caseroot = parse_input(sys.argv) + with Case(caseroot) as case: + buildnml(case, caseroot, "cam") + +if __name__ == "__main__": + _main_func() + diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml new file mode 100644 index 0000000000..076e946351 --- /dev/null +++ b/cime_config/config_archive.xml @@ -0,0 +1,27 @@ + + + + [ri] + rh\d* + rs + h\d*.*\.nc$ + e + nhfil + + rpointer.atm$NINST_STRING + $CASE.cam$NINST_STRING.r.$DATENAME.nc + + + rpointer.atm + rpointer.atm_9999 + casename.cam.r.1976-01-01-00000.nc + casename.cam.rh4.1976-01-01-00000.nc + casename.cam.h0.1976-01-01-00000.nc + casename.cam.h0.1976-01-01-00000.nc.base + casename.cam_0002.e.postassim.1976-01-01-00000.nc + casename.cam_0002.e.preassim.1976-01-01-00000.nc + casename.cam.i.1976-01-01-00000.nc + anothercasename.cam.i.1976-01-01-00000.nc + + + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml new file mode 100644 index 0000000000..2de6b0275e --- /dev/null +++ b/cime_config/config_component.xml @@ -0,0 +1,289 @@ + + + + + + + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: + CAM simplified and non-versioned physics : + + + CAM stand-alone single column mode -- need to define usermods directory with IOP settings: + CAM winds and temperature nudged towards prescribed meteorology: + + CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and modal aersols : + CAM CLUBB - turned on by default in CAM60: + CAM CO2 ramp: + CAM super-parameterized CAM one moment SAM microphysics + CAM super-parameterized CAM one moment SAM microphysics using CLUBB + CAM super-parameterized CAM double moment m2005 SAM microphysics + CAM super-parameterized CAM double moment m2005 SAM microphysics using CLUBB + CAM tropospheric chemistry with bulk aerosols: + + + WACCM with middle atmosphere chemistry: + WACCM with middle atmosphere chemistry with enhanced D-region ion chemistry: + WACCM-X enhanced ionosphere, transport, and electrodynamics: + WACCM specified chemistry: + WACCM with tropospheric, stratospheric, mesospheric, and lower thermospheric chemistry: + + + CAM adiabatic physics: + CAM dry adiabatic baroclinic instability (Polvani 2004): + CAM dynamical core test with baroclinic wave IC and terminator chemistry: + CAM Held-Suarez forcing: + CAM dynamical core test with baroclinic wave IC and Kessler physics: + + + CAM Parallel Offline Radiation Tool: + + + + char + cam + cam + case_comp + env_case.xml + Name of atmospheric component + + + + char + + UNSET + build_component_cam + env_build.xml + CAM cpp definitions (setup automatically - DO NOT EDIT) + + + + char + eul,fv,se + fv + + eul + se + + build_component_cam + env_build.xml + CAM dynamical core + + + + char + + + + -phys cam4 + -phys cam5 + -phys cam6 + + + -chem trop_strat_mam4_vbs + -clubb_sgs + -dyn eul -scam + -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom + -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -spcam_clubb_sgs + -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 + -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs + -chem trop_mozart + + -co2_cycle + + + + -age_of_air_trcs + -chem waccm_ma + -chem waccm_ma_mam4 + -chem waccm_mad_mam4 + -chem waccm_sc_mam4 + -chem waccm_tsmlt_mam4 + -chem waccm_ma -waccmx + -ionosphere wxie + + -offline_dyn + -nlev 56 + -nlev 88 + -nlev 145 + + + -analytic_ic + -phys adiabatic + -phys adiabatic + -phys held_suarez -chem terminator -analytic_ic + -phys held_suarez + -phys kessler -chem terminator -analytic_ic + + + -aquaplanet + -aquaplanet + + + -offline_drv rad + + build_component_cam + env_build.xml + + CAM configure options, see CAM configure utility for details + Provides option(s) for the CAM configure utility. + CAM_CONFIG_OPTS are normally set as compset variables (e.g., -phys cam4 -chem waccm_ma) + and in general should not be modified for supported compsets. It is recommended that if you want + to modify this value for your experiment, you should use your own user-defined + component sets via using create_newcase with a compset_file argument + + + + + char + + UNSET + + 1850_cam4 + 1850_cam5 + + 1850_cam6 + waccm_tsmlt_1850_cam6 + waccm_ma_1850_cam6 + + 2000_cam4_trop_chem + waccmxie_ma_2000_cam4 + + 2000_cam6 + waccm_tsmlt_2000_cam6 + waccm_ma_2000_cam6 + 2000_trop_strat_vbs_cam6 + + aquaplanet_cam4 + aquaplanet_cam4 + aquaplanet_cam5 + aquaplanet_cam5 + aquaplanet_cam6 + aquaplanet_cam6 + + 2010_trop_strat_vbs_cam6 + + 1850-2005_cam5 + 1850-2005_cam4 + + 1850-2005_cam4 + 1850-2005_cam4_bgc + 1950-2010_ccmi_refc1_waccmx_ma + 1850-2005_cam5 + hist_cam6 + waccm_tsmlt_hist_cam6 + waccm_sc_hist_cam6 + waccm_ma_hist_cam6 + waccm_ma_hist_cam6 + hist_trop_strat_vbs_cam6 + + 1850-PD_cam5 + + 2005-2100_cam4_rcp26 + 2005-2100_cam4_rcp45 + 2005-2100_cam4_rcp45_bgc + 2005-2100_cam4_rcp60 + 2005-2100_cam4_rcp85 + 2005-2100_cam4_rcp85_bgc + + 2006-2100_cam5_rcp26 + 2006-2100_cam5_rcp45 + 2006-2100_cam5_rcp60 + 2006-2100_cam5_rcp85 + + sd_waccmx_ma_cam4 + sd_waccm_tsmlt_cam6 + sd_waccm_ma_cam6 + sd_waccm_ma_cam6 + sd_trop_strat_vbs_cam6 + + dabi_p2004 + held_suarez_1994 + dctest_baro_moist + dctest_baro_kessler + + + scam_arm97 + + run_component_cam + env_run.xml + CAM namelist use_case. Provides the use_case option for the + CAM build-namelist utility (which is called from + $CASEROOT/Buildconf/cam.buildnml). The CAM build-namelist + leverages groups of namelist options (use cases) that are often + paired with the CAM configure options. These use cases are xml + files located in + $CIMEROOT/../components/cam/bld/namelist_files/use_cases. + In general, this variable should not be modified for supported + component sets (compsets). Recommendation: If you want to + modify this value for your experiment, use your own user-defined + component sets. + + + + char + + + + scenario_ghg='RAMP_CO2_ONLY'ramp_co2_annual_rate=1 + co2_cycle_rad_passive=.true. + + ncdata='$DIN_LOC_ROOT/cesm2_init/f.e20.FWSD.f09_f09_mg17.262/2005-01-01/f.e20.FWSD.f09_f09_mg17.262.cam.i.2005-01-01-00000.nc' + + + run_component_cam + env_run.xml + CAM specific namelist settings for -namelist option Provides + options to the -namelist argument for the CAM build-namelist + utility. This should be reserved for component set + specification. Users should modify CAM namelists only via the + $CASEROOT/user_nl_cam file. + + + + char + + + + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/waccmx + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory + + run_component_cam + env_case.xml + User mods to apply to specific compset matches. + + + + ========================================= + CAM naming conventions + ========================================= + + + diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml new file mode 100644 index 0000000000..f7e544ebe7 --- /dev/null +++ b/cime_config/config_compsets.xml @@ -0,0 +1,599 @@ + + + + + + ========================================= + compset naming convention + ========================================= + The compset longname below has the specified order + atm, lnd, ice, ocn, river, glc wave cesm-options + + The notation for the compset longname is + TIME_ATM[%phys]_LND[%phys]_ICE[%phys]_OCN[%phys]_ROF[%phys]_GLC[%phys]_WAV[%phys][_BGC%phys] + Where for the CAM specific compsets below the following is supported + TIME = Time period (e.g. 2000, HIST, RCP8...) + ATM = [CAM40, CAM50, CAM60] + LND = [CLM45, CLM50, SLND] + ICE = [CICE, DICE, SICE] + OCN = [DOCN, ,AQUAP, SOCN] + ROF = [RTM, SROF] + GLC = [CISM1, CISM2, SGLC] + WAV = [SWAV] + BGC = optional BGC scenario + + The OPTIONAL %phys attributes specify submodes of the given system + For example DOCN%DOM is the data ocean model for DOCN + ALL the possible %phys choices for each component are listed + with the -list command for create_newcase + ALL data models must have a %phys option that corresponds to the data model mode + + Each compset node is associated with the following elements + - lname + - alias + - support (optional description of the support level for this compset) + Each compset node can also have the following attributes + - grid (optional regular expression match for grid to work with the compset) + + + + + + + + F2000climo + 2000_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + + FHIST + HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + + + + FDABIP04 + 2000_CAM%DABIP04_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + + + + FSCAM + 2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FHS94 + 2000_CAM%HS94_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + + + + + + QPC6 + 2000_CAM60_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + + + + QSC6 + 2000_CAM60_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + + + + + + + + + + F1850_DONOTUSE + 1850_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FSPCAMM + 2000_CAM%SPCAMM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + FSPCAMS + 2000_CAM%SPCAMS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + + FADIAB + 2000_CAM%ADIAB_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + + FHIST_DARTC6 + HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + FDCBAROMOIST + 2000_CAM%DCTBM_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + FKESSLER + 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + + PC4 + 2000_CAM40%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + PC5 + 2000_CAM50%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + PC6 + 2000_CAM60%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + + + + + + + FSPCAMCLBS + 2000_CAM%SPCAMCLBS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + FSPCAMCLBM + 2000_CAM%SPCAMCLBM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + + + FC2000climo + 2000_CAM60%CCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FC2010climo + 2010_CAM60%CCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FCHIST + HIST_CAM60%CCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FCSD + SDYN_CAM60%CCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FMOZ + 2000_CAM40%TMOZ_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + + QPC4 + 2000_CAM40_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + + QPC5 + 2000_CAM50_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + + QSC4 + 2000_CAM40_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + + + + QSC5 + 2000_CAM50_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + + + + + + + + FWHIST + HIST_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + + FWscHIST + HIST_CAM60%WCSC_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + + FW1850 + 1850_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + + + + + + FW2000 + 2000_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FWSD + SDYN_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + + + + + + FWmaHIST + HIST_CAM60%WCCM_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FWmaSD + SDYN_CAM60%WCCM_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FWmadHIST + HIST_CAM60%WCMD_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + + + FWmadSD + SDYN_CAM60%WCMD_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + + + + + FX2000 + 2000_CAM40%WXIE_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + FXHIST + HIST_CAM40%WXIE_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + FXSD + SDYN_CAM40%WXIE_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + + + + + + + 1997-06-18 + 1979-01-01 + 2000-01-01 + 1979-01-01 + 1974-01-01 + 1976-01-01 + 1850-01-01 + 2005-01-01 + 2005-01-01 + 2000-01-01 + + 2004-01-01 + 1950-01-01 + + + + + + 84585 + + + + + + + 288 + + + + + + TRUE + + + + + + + GREGORIAN + GREGORIAN + + + + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c110526.nc + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2017_c180507.nc + $DIN_LOC_ROOT/atm/cam/sst/"sst_HadOIBl_bc_48x96_1850_2017_c180507.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2017_c180507.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2017_c180507.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2017_c180507.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2017_c180507.nc + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c101029.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c101028.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c101028.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c101028.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c101028.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c101028.nc + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2000climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2000climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2000climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2000climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2000climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2000climo_c180511.nc + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc + $DIN_LOC_ROOT/atm/cam/sst/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2010climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2010climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2010climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2010climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2010climo_c180511.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2010climo_c180511.nc + + + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2016_c170525.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2016_c170525.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2016_c170525.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2016_c170525.nc + + + + + + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc + $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc + $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc + $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc + + + + + 1850 + + + + + 1850 + + + + + 2016 + + + + + 20thC_transient + + + + + + use_init_interp=.true. + + + + + + hybrid + hybrid + hybrid + hybrid + + hybrid + hybrid + hybrid + hybrid + hybrid + hybrid + + + + + + b.e20.BHIST.f09_g17.20thC.297_01_v2 + b.e20.BHIST.f09_g17.20thC.297_01_v2 + b.e16.B1850_WW3.f09_g16.lang_redi_2hr_frz_chl.003 + b.e20.B1850.f09_g16.pi_control.all.123 + + b.e16.B1850_WW3.f09_g16.lang_redi_2hr_frz_chl.003 + b.e20.B1850.f09_g16.pi_control.all.123 + f.e20.FWSD.f09_f09_mg17.cesm2_0_exp10j.c180508 + f.e20.FWHIST.f09_f09_mg17.262a_v2 + f.e20.FWHIST.f09_f09_mg17.exp10j.298 + f.e20.FW1850.f09_f09_mg17.295_v2 + f.e20.FWHIST.f09_f09_mg17.262a_v2 + + + + + + 1979-01-01 + 2000-01-01 + 0097-01-01 + 0010-01-01 + 0097-01-01 + 0010-01-01 + 2005-01-03 + 1976-01-01 + 1974-01-01 + 0021-01-01 + 2000-01-01 + + + + + + cesm2_init + cesm2_init + cesm2_init + cesm2_init + cesm2_init + cesm2_init + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + 1 + 1 + + + + + + + + TRUE + + + + + + 36.6 + + + + + + 262.5 + + + + + + diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml new file mode 100644 index 0000000000..e4f717549e --- /dev/null +++ b/cime_config/config_pes.xml @@ -0,0 +1,1643 @@ + + + + + + + + none + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -40 + -40 + -40 + -40 + -40 + -40 + -40 + -40 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -40 + -40 + -40 + -40 + -40 + -40 + -40 + -40 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 16 + 32 + none + + 630 + 630 + 630 + 630 + 630 + 630 + 630 + 630 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 16 + 32 + none + + 900 + 900 + 900 + 900 + 900 + 900 + 900 + 900 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + none + 36 + 36 + + -100 + -100 + -100 + -100 + -100 + -100 + -100 + -100 + + + 3 + 3 + 3 + 3 + 3 + 3 + 3 + 3 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 16 + 32 + none + + 7680 + 3040 + 3040 + 3840 + 7680 + 7680 + 7680 + 7680 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 3040 + 0 + 0 + 0 + 0 + + + + + + + + none + + -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 32 + 32 + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 12 + 12 + 12 + 12 + 12 + 12 + 12 + 12 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 64 + 64 + 64 + 64 + 64 + 64 + 64 + 64 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -2 + -2 + -2 + -2 + -2 + -2 + -2 + -2 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 96 + 96 + 96 + 96 + 96 + 96 + 96 + 96 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 224 + 224 + 224 + 224 + 224 + 224 + 224 + 224 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 240 + 240 + 240 + 240 + 240 + 240 + 240 + 240 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 36 + none + + -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 + + + 3 + 3 + 3 + 3 + 3 + 3 + 3 + 3 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + 36 + 36 + none + + 144 + 144 + 144 + 144 + 144 + 144 + 144 + 144 + + + 3 + 3 + 3 + 3 + 3 + 3 + 3 + 3 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + 16 + 32 + none + + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + 16 + 32 + none + + 256 + 256 + 256 + 256 + 256 + 256 + 256 + 256 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + 16 + 32 + none + + 128 + 128 + 128 + 128 + 128 + 128 + 128 + 128 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -208 + -208 + -208 + -208 + -208 + -208 + -208 + -208 + + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -64 + -64 + -64 + -64 + -64 + -64 + -64 + -64 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + 8 + 32 + + 256 + 256 + 256 + 256 + 256 + 256 + 256 + 256 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + 8 + 32 + + 512 + 512 + 512 + 512 + 512 + 512 + 512 + 512 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + none + 36 + 36 + + 384 + 384 + 384 + 384 + 384 + 384 + 384 + 384 + + + 3 + 3 + 3 + 3 + 3 + 3 + 3 + 3 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 480 + 480 + 480 + 480 + 480 + 480 + 480 + 480 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 960 + 960 + 960 + 960 + 960 + 960 + 960 + 960 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + + + + + + + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + + + 1 + + + 1 + + + + + + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml new file mode 100644 index 0000000000..3321aafbca --- /dev/null +++ b/cime_config/testdefs/testlist_cam.xml @@ -0,0 +1,839 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam new file mode 100644 index 0000000000..1b86d5d825 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam @@ -0,0 +1,15 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam4_2deg.doubleCO2.cam.h1.0001-01-01-00000_c140808.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam new file mode 100644 index 0000000000..e42183057a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam @@ -0,0 +1,15 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam5_4deg.doubleCO2.h1.0001-01-01-00000_c150807.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam new file mode 100644 index 0000000000..150660c7f4 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam @@ -0,0 +1,15 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam5_ne30.doubleCO2.h1.0001-01-01-00000_c150806.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam new file mode 100644 index 0000000000..e99e90fc96 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam @@ -0,0 +1,22 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam6_3mode_1deg.doubleCO2.cam.h1.0001-01-01-00000_c170526.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 + + prescribed_strataero_3modes = .true. + prescribed_strataero_cycle_yr = 1999 + prescribed_strataero_datapath = '$DIN_LOC_ROOT/atm/cam/volc' + prescribed_strataero_file = 'f.e15.FSDW5.f09_f09.beta02_waccm.cam5_4.03.volc_PrescribedMAM_19891231-2000_zm_5day_c170216.nc' + prescribed_strataero_type = 'CYCLICAL' + prescribed_strataero_use_chemtrop = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm new file mode 100644 index 0000000000..5350271264 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm @@ -0,0 +1,22 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set co2_ppmv with CCSM_CO2_PPMV option +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- + + finidat = '$DIN_LOC_ROOT/lnd/clm2/initdata_map/clmi.IGM2000GSWP3CLM50BGCCROPIRR.2011-01-01.1.9x2.5_gx1v6_gl5_simyr2000_c170419.nc' + use_init_interp = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands new file mode 100644 index 0000000000..0215bb1362 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands @@ -0,0 +1,6 @@ +CAM_CONFIG_OPTS=`./xmlquery CAM_CONFIG_OPTS --value` +if [[ $CAM_CONFIG_OPTS != *"-cosp"* ]]; then + ./xmlchange -append CAM_CONFIG_OPTS="-cosp" +fi +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands new file mode 100644 index 0000000000..f487150a19 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands @@ -0,0 +1,3 @@ +./xmlchange CALENDAR=GREGORIAN +./xmlchange PIO_TYPENAME=pnetcdf +./xmlchange ATM_NCPL=48 diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cam new file mode 100644 index 0000000000..008f853d1c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cam @@ -0,0 +1,4 @@ +inithist = 'ENDOFRUN' +empty_htapes = .true. +fincl1 = 'PHIS:I' +nhtfrq = -1 diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cice b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cice new file mode 100644 index 0000000000..2f3c092d40 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cice @@ -0,0 +1 @@ +ice_ic = 'default' diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_clm new file mode 100644 index 0000000000..22c0f0b52a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_clm @@ -0,0 +1,9 @@ +use_init_interp = .true. +check_finidat_year_consistency = .false. +hist_empty_htapes = .true. +hist_fincl1 = 'TSA' +hist_nhtfrq = -1 +hist_mfilt = 1 +hist_avgflag_pertape = 'I' +urban_hac = 'OFF' +building_temp_method = 0 diff --git a/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cam new file mode 100644 index 0000000000..2ba0527928 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cam @@ -0,0 +1,16 @@ + + fire_emis_factors_file = '$DIN_LOC_ROOT/lnd/clm2/firedata/fire_emis_factors_c140116.nc' + fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC', 'SO2 = SO2' + fire_emis_elevated = .true. + + fincl1 = 'FireFrc_SO2','FireFrc_bc_a1','FireFrc_pom_a1','FireFrc_pom_a1_num_a1','FireFrc_bc_a1_num_a1', + 'FireVFLX_SO2','FireVFLX_bc_a1','FireVFLX_pom_a1', + 'FireSFLX_SO2','FireSFLX_bc_a1','FireSFLX_pom_a1','Fire_ZTOP', + fincl2 = 'FireFrc_SO2','FireFrc_bc_a1','FireFrc_pom_a1','FireFrc_pom_a1_num_a1','FireFrc_bc_a1_num_a1', + 'FireVFLX_SO2','FireVFLX_bc_a1','FireVFLX_pom_a1', + 'FireSFLX_SO2','FireSFLX_bc_a1','FireSFLX_pom_a1','Fire_ZTOP', + + mfilt=1,24 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-1 + inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_clm new file mode 100644 index 0000000000..265def3620 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_clm @@ -0,0 +1,33 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +!---------------------------------------------------------------------------------- + + hist_ndens = 1,1 + hist_mfilt = 1,24 + hist_nhtfrq = -24,-1 + hist_avgflag_pertape = 'A','A' + hist_fincl1 = 'M_LEAFC_TO_FIRE','M_LEAFC_STORAGE_TO_FIRE','M_LEAFC_XFER_TO_FIRE','M_LIVESTEMC_TO_FIRE', + 'M_LIVESTEMC_STORAGE_TO_FIRE','M_LIVESTEMC_XFER_TO_FIRE','M_DEADSTEMC_TO_FIRE','M_DEADSTEMC_STORAGE_TO_FIRE', + 'M_DEADSTEMC_XFER_TO_FIRE','M_FROOTC_TO_FIRE','M_FROOTC_STORAGE_TO_FIRE','M_FROOTC_XFER_TO_FIRE', + 'M_LIVEROOTC_TO_FIRE','M_LIVEROOTC_STORAGE_TO_FIRE','M_LIVEROOTC_XFER_TO_FIRE','M_DEADROOTC_TO_FIRE', + 'M_DEADROOTC_STORAGE_TO_FIRE','M_DEADROOTC_XFER_TO_FIRE','M_GRESP_STORAGE_TO_FIRE','M_GRESP_XFER_TO_FIRE', + 'FireEmis_ZTOP','FireEmis_TOT','FireComp_BC','FireComp_OC','FireComp_SO2','FireMech_bc_a1','FireMech_pom_a1','FireMech_SO2', + hist_fincl2 = 'M_LEAFC_TO_FIRE','M_LEAFC_STORAGE_TO_FIRE','M_LEAFC_XFER_TO_FIRE','M_LIVESTEMC_TO_FIRE', + 'M_LIVESTEMC_STORAGE_TO_FIRE','M_LIVESTEMC_XFER_TO_FIRE','M_DEADSTEMC_TO_FIRE','M_DEADSTEMC_STORAGE_TO_FIRE', + 'M_DEADSTEMC_XFER_TO_FIRE','M_FROOTC_TO_FIRE','M_FROOTC_STORAGE_TO_FIRE','M_FROOTC_XFER_TO_FIRE', + 'M_LIVEROOTC_TO_FIRE','M_LIVEROOTC_STORAGE_TO_FIRE','M_LIVEROOTC_XFER_TO_FIRE','M_DEADROOTC_TO_FIRE', + 'M_DEADROOTC_STORAGE_TO_FIRE','M_DEADROOTC_XFER_TO_FIRE','M_GRESP_STORAGE_TO_FIRE','M_GRESP_XFER_TO_FIRE', + 'FireEmis_ZTOP','FireEmis_TOT','FireComp_BC','FireComp_OC','FireComp_SO2','FireMech_bc_a1','FireMech_pom_a1','FireMech_SO2' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/shell_commands new file mode 100644 index 0000000000..a371a33c20 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/shell_commands @@ -0,0 +1 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam new file mode 100644 index 0000000000..1d7042c597 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam @@ -0,0 +1,3 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_clm new file mode 100644 index 0000000000..5634334558 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = -24 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/shell_commands new file mode 100644 index 0000000000..e61407646b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE=2005-12-31 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam new file mode 100644 index 0000000000..25a71f377b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24 +fincl6='ElecColDens','EPHI3D','ELAM3D' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_clm new file mode 100644 index 0000000000..5634334558 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = -24 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_cam new file mode 100644 index 0000000000..c6b69736a2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,30,30,30,30,30 +ndens=2,2,2,2,2,2 +nhtfrq=0,-24,-24,-24,-24,-24 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_clm new file mode 100644 index 0000000000..f0f2da1988 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 0 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3d/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/shell_commands new file mode 100644 index 0000000000..a371a33c20 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/shell_commands @@ -0,0 +1 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cam new file mode 100644 index 0000000000..a9f64dfa29 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cam @@ -0,0 +1,3 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-72,-72,-72,-72,-72,-72 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_clm new file mode 100644 index 0000000000..7ade9197ed --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = -72 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/shell_commands new file mode 100644 index 0000000000..712d59a3d4 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange --append CAM_CONFIG_OPTS="-analytic_ic -nlev 32" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cam new file mode 100644 index 0000000000..b29e84d7b7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +se_refined_mesh=.true. +se_qsize_condensate_loading = 1 +analytic_ic_type = 'baroclinic_wave' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_clm new file mode 100644 index 0000000000..f3ac27f1e6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 3 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam new file mode 100644 index 0000000000..eeb2417bec --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam @@ -0,0 +1,27 @@ + + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 + + fincl1 = ' ' + fincl2 = ' ' + fincl3 = ' ' + fincl4 = ' ' + fincl5 = ' ' + fincl6 = ' ' + fincl7 = ' ' + fincl8 = ' ' + fincl9 = ' ' + fincl10 = ' ' + + history_aero_optics = .false. + history_aerosol = .false. + history_amwg = .false. + history_budget = .false. + history_carma = .false. + history_chemistry = .false. + history_clubb = .false. + history_eddy = .false. + history_vdiag = .false. + history_waccm = .false. + history_waccmx = .false. diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/user_nl_cam new file mode 100644 index 0000000000..3906ec0210 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/user_nl_cam @@ -0,0 +1,27 @@ + + mfilt = 1,1,1,1,1,1,1,1,1,1 + ndens = 1,1,1,1,1,1,1,1,1,1 + nhtfrq= 3,3,3,3,3,3,3,3,3,3 + + fincl1 = ' ' + fincl2 = ' ' + fincl3 = ' ' + fincl4 = ' ' + fincl5 = ' ' + fincl6 = ' ' + fincl7 = ' ' + fincl8 = ' ' + fincl9 = ' ' + fincl10 = ' ' + + history_aero_optics = .false. + history_aerosol = .false. + history_amwg = .false. + history_budget = .false. + history_carma = .false. + history_chemistry = .false. + history_clubb = .false. + history_eddy = .false. + history_vdiag = .false. + history_waccm = .false. + history_waccmx = .false. diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cam new file mode 100644 index 0000000000..a5c27497be --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cam @@ -0,0 +1,27 @@ + + mfilt=1,1,1,1,1,1,1,1,1,1 + ndens=1,1,1,1,1,1,1,1,1,1 + nhtfrq=-120,-120,-120,-120,-120,-120,-120,-120,-120,-120 + + fincl1 = ' ' + fincl2 = ' ' + fincl3 = ' ' + fincl4 = ' ' + fincl5 = ' ' + fincl6 = ' ' + fincl7 = ' ' + fincl8 = ' ' + fincl9 = ' ' + fincl10 = ' ' + + history_aero_optics = .false. + history_aerosol = .false. + history_amwg = .false. + history_budget = .false. + history_carma = .false. + history_chemistry = .false. + history_clubb = .false. + history_eddy = .false. + history_vdiag = .false. + history_waccm = .false. + history_waccmx = .false. diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods new file mode 100644 index 0000000000..4b0f7f1abb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods @@ -0,0 +1 @@ +../../../../usermods_dirs/scam_mpace diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/user_nl_cam b/cime_config/user_nl_cam new file mode 100644 index 0000000000..22cfcb929d --- /dev/null +++ b/cime_config/user_nl_cam @@ -0,0 +1,3 @@ +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value + diff --git a/cime_config/usermods_dirs/aquap/user_nl_cpl b/cime_config/usermods_dirs/aquap/user_nl_cpl new file mode 100644 index 0000000000..64e3272597 --- /dev/null +++ b/cime_config/usermods_dirs/aquap/user_nl_cpl @@ -0,0 +1,28 @@ +!------------------------------------------------------------------------ +! Users should ONLY USE user_nl_cpl to change namelists variables +! for namelist variables in drv_in (except for the ones below) and +! any keyword/values in seq_maps.rc +! Users should add ALL user specific namelist and seq_maps.rc changes below +! using the following syntax +! namelist_var = new_namelist_value +! or +! mapname = new_map_name +! For example to change the default value of ocn2atm_fmapname to 'foo' use +! ocn2atm_fmapname = 'foo' +! +! Note that some namelist variables MAY NOT be changed in user_nl_cpl - +! they are defined in a $CASEROOT xml file and must be changed with +! xmlchange. +! +! For example, rather than set username to 'foo' in user_nl_cpl, call +! ./xmlchange USER=foo +!------------------------------------------------------------------------ +! +! SPECIAL NOTE FOR AQUAPLANET +! Do not modify any of the following orb_ entries +! co2vmr is not specified via the namelist but rather in the env_run.xml +! +orb_eccen = 0. +orb_obliq = 0. +orb_mvelp = 0. +orb_mode = "fixed_parameters" diff --git a/cime_config/usermods_dirs/scam_arm95/shell_commands b/cime_config/usermods_dirs/scam_arm95/shell_commands new file mode 100755 index 0000000000..e902f2be49 --- /dev/null +++ b/cime_config/usermods_dirs/scam_arm95/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=262.5 +./xmlchange PTS_LAT=36.6 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1995-07-18 +./xmlchange START_TOD=19800 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=1259 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm95/user_nl_cam b/cime_config/usermods_dirs/scam_arm95/user_nl_cam new file mode 100644 index 0000000000..7c38a064fd --- /dev/null +++ b/cime_config/usermods_dirs/scam_arm95/user_nl_cam @@ -0,0 +1,16 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM95_4scam.nc" +mfilt=1500 +nhtfrq=1 +co2vmr=368.9e-6 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_arm97/shell_commands b/cime_config/usermods_dirs/scam_arm97/shell_commands new file mode 100755 index 0000000000..a695db6d58 --- /dev/null +++ b/cime_config/usermods_dirs/scam_arm97/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=262.5 +./xmlchange PTS_LAT=36.6 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1997-06-18 +./xmlchange START_TOD=84585 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=2088 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm97/user_nl_cam b/cime_config/usermods_dirs/scam_arm97/user_nl_cam new file mode 100644 index 0000000000..f5ed87bba5 --- /dev/null +++ b/cime_config/usermods_dirs/scam_arm97/user_nl_cam @@ -0,0 +1,16 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM97_4scam.nc" +mfilt=2088 +nhtfrq=1 +co2vmr=368.9e-6 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_atex/shell_commands b/cime_config/usermods_dirs/scam_atex/shell_commands new file mode 100755 index 0000000000..cea0583b9b --- /dev/null +++ b/cime_config/usermods_dirs/scam_atex/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=345. +./xmlchange PTS_LAT=15. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1969-02-15 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=2 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_atex/user_nl_cam b/cime_config/usermods_dirs/scam_atex/user_nl_cam new file mode 100644 index 0000000000..2361da6b90 --- /dev/null +++ b/cime_config/usermods_dirs/scam_atex/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ATEX_48hr_4scam.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_bomex/shell_commands b/cime_config/usermods_dirs/scam_bomex/shell_commands new file mode 100755 index 0000000000..6d2bb04886 --- /dev/null +++ b/cime_config/usermods_dirs/scam_bomex/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=300. +./xmlchange PTS_LAT=15. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1969-06-25 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=5 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_bomex/user_nl_cam b/cime_config/usermods_dirs/scam_bomex/user_nl_cam new file mode 100644 index 0000000000..c3569227d9 --- /dev/null +++ b/cime_config/usermods_dirs/scam_bomex/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/BOMEX_5day_4scam.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands b/cime_config/usermods_dirs/scam_cgilsS11/shell_commands new file mode 100755 index 0000000000..37056ed761 --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS11/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=231. +./xmlchange PTS_LAT=32. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1997-07-15 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=30 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam new file mode 100644 index 0000000000..11a4404cae --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands b/cime_config/usermods_dirs/scam_cgilsS12/shell_commands new file mode 100755 index 0000000000..fefce8216e --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS12/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=235. +./xmlchange PTS_LAT=35. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1997-07-15 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=30 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam new file mode 100644 index 0000000000..a57eedf366 --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands b/cime_config/usermods_dirs/scam_cgilsS6/shell_commands new file mode 100755 index 0000000000..5ecc09e2a4 --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS6/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=211. +./xmlchange PTS_LAT=17. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1997-07-15 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=30 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam new file mode 100644 index 0000000000..a96ddcce11 --- /dev/null +++ b/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S6_CTL_reduced.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands new file mode 100755 index 0000000000..241e785227 --- /dev/null +++ b/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=238.5 +./xmlchange PTS_LAT=31.5 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1999-07-11 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=144 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam new file mode 100644 index 0000000000..f24d4d4063 --- /dev/null +++ b/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam @@ -0,0 +1,16 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_use_obs_T =.true. +scm_relaxation = .true. +scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands new file mode 100755 index 0000000000..241e785227 --- /dev/null +++ b/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=238.5 +./xmlchange PTS_LAT=31.5 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1999-07-11 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=144 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam new file mode 100644 index 0000000000..f24d4d4063 --- /dev/null +++ b/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam @@ -0,0 +1,16 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_use_obs_T =.true. +scm_relaxation = .true. +scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_gateIII/shell_commands b/cime_config/usermods_dirs/scam_gateIII/shell_commands new file mode 100755 index 0000000000..03642e292a --- /dev/null +++ b/cime_config/usermods_dirs/scam_gateIII/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=336.0 +./xmlchange PTS_LAT=9.00 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1974-08-30 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=1440 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam b/cime_config/usermods_dirs/scam_gateIII/user_nl_cam new file mode 100644 index 0000000000..75471063fb --- /dev/null +++ b/cime_config/usermods_dirs/scam_gateIII/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/GATEIII_4scam_c170809.nc" +mfilt=1440 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_mandatory/shell_commands b/cime_config/usermods_dirs/scam_mandatory/shell_commands new file mode 100755 index 0000000000..5d0732be92 --- /dev/null +++ b/cime_config/usermods_dirs/scam_mandatory/shell_commands @@ -0,0 +1,12 @@ +# Do not change options below +# these are necessary for scam runs. +#======================================== + +# SCAM works in SPMD mode with a single task, but the default is to run serially. +./xmlchange MPILIB=mpi-serial + +# SCAM doesn't have restart functionality yet. +./xmlchange REST_OPTION=never + +# Note that clm cannot use initial conditions with SCAM -so will only use specified phenology +./xmlchange CLM_FORCE_COLDSTART='on' diff --git a/cime_config/usermods_dirs/scam_mpace/shell_commands b/cime_config/usermods_dirs/scam_mpace/shell_commands new file mode 100755 index 0000000000..d9d0e50837 --- /dev/null +++ b/cime_config/usermods_dirs/scam_mpace/shell_commands @@ -0,0 +1,17 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=206.0 +./xmlchange PTS_LAT=70.5 + + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=2004-10-05 +./xmlchange START_TOD=7171 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=1242 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_mpace/user_nl_cam b/cime_config/usermods_dirs/scam_mpace/user_nl_cam new file mode 100644 index 0000000000..92dc964a21 --- /dev/null +++ b/cime_config/usermods_dirs/scam_mpace/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/MPACE_4scam.nc" +mfilt=1242 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_rico/shell_commands b/cime_config/usermods_dirs/scam_rico/shell_commands new file mode 100755 index 0000000000..ad424f951b --- /dev/null +++ b/cime_config/usermods_dirs/scam_rico/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=298.5 +./xmlchange PTS_LAT=18. + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1995-07-15 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=216 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_rico/user_nl_cam b/cime_config/usermods_dirs/scam_rico/user_nl_cam new file mode 100644 index 0000000000..7a8eaea50a --- /dev/null +++ b/cime_config/usermods_dirs/scam_rico/user_nl_cam @@ -0,0 +1,16 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/RICO_3day_4scam.nc" +mfilt=2088 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_use_obs_T =.true. +scm_relaxation = .true. +scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_sparticus/shell_commands b/cime_config/usermods_dirs/scam_sparticus/shell_commands new file mode 100755 index 0000000000..68dbd4467c --- /dev/null +++ b/cime_config/usermods_dirs/scam_sparticus/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=262.51 +./xmlchange PTS_LAT=36.6 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=2010-04-01 +./xmlchange START_TOD=3599 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=2156 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam b/cime_config/usermods_dirs/scam_sparticus/user_nl_cam new file mode 100644 index 0000000000..d2c2198270 --- /dev/null +++ b/cime_config/usermods_dirs/scam_sparticus/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SPARTICUS_4scam.nc" +mfilt=2156 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_togaII/shell_commands b/cime_config/usermods_dirs/scam_togaII/shell_commands new file mode 100755 index 0000000000..6ab21646b1 --- /dev/null +++ b/cime_config/usermods_dirs/scam_togaII/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=154.69 +./xmlchange PTS_LAT=-2.10 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=1992-12-18 +./xmlchange START_TOD=64800 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=1512 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_togaII/user_nl_cam b/cime_config/usermods_dirs/scam_togaII/user_nl_cam new file mode 100644 index 0000000000..f95c12f7da --- /dev/null +++ b/cime_config/usermods_dirs/scam_togaII/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TOGAII_4scam.nc" +mfilt=9 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_twp06/shell_commands b/cime_config/usermods_dirs/scam_twp06/shell_commands new file mode 100755 index 0000000000..7787ba2453 --- /dev/null +++ b/cime_config/usermods_dirs/scam_twp06/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./xmlchange PTS_LON=130.89 +./xmlchange PTS_LAT=-12.32 + +# Specify the starting/ending time for the IOP +# The complete time slice of IOP file is specified below +# but you may simulate any within the IOP start and end times. +./xmlchange RUN_STARTDATE=2006-01-17 +./xmlchange START_TOD=10800 +./xmlchange STOP_OPTION=nsteps +./xmlchange STOP_N=1926 + +# usermods_dir/scam_mandatory will be included for all single column +# runs by default. This usermods directory contains mandatory settings +# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_twp06/user_nl_cam b/cime_config/usermods_dirs/scam_twp06/user_nl_cam new file mode 100644 index 0000000000..d2a56d290e --- /dev/null +++ b/cime_config/usermods_dirs/scam_twp06/user_nl_cam @@ -0,0 +1,15 @@ +scmlon=$PTS_LON +scmlat=$PTS_LAT +iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TWP06_4scam.nc" +mfilt=1926 +nhtfrq=1 +scm_use_obs_uv = .true. +scm_relaxation = .true. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/waccmx/user_nl_clm b/cime_config/usermods_dirs/waccmx/user_nl_clm new file mode 100644 index 0000000000..09fd9bf389 --- /dev/null +++ b/cime_config/usermods_dirs/waccmx/user_nl_clm @@ -0,0 +1,3 @@ + +finidat = '$DIN_LOC_ROOT/lnd/clm2/initdata/f.e11.FWTREFC1SD.f19.f19.ccmi30.001.clm2.r.2000-01-01-00000.nc' + diff --git a/doc/ChangeLog b/doc/ChangeLog new file mode 100644 index 0000000000..45641992c8 --- /dev/null +++ b/doc/ChangeLog @@ -0,0 +1,107275 @@ + +=============================================================== + +Tag name:cam6_0_000 +Originator(s): cacraig (and MANY other developers) +Date: May 17, 2018 +One-line Summary: CAM6 initial release + +Purpose of changes: + - This is an duplicate tag for cam5_4_191 and represents the CAM6 release code + - Bug fixes may still occur + +List all existing files that have been modified, and describe the changes: NONE + +=============================================================== +=============================================================== + +Tag name:cam5_4_191 + (also known as cam_cesm2_0_rel_00) +Originator(s): cacraig, hannay +Date: May 17, 2018 +One-line Summary: Final mods for the CESM2.0 release + +Purpose of changes: + - Update the SST files + - Update the F2000climo and FHIST compsets + - Remove metadata which is unset in CAM's history files + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update cime + +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml + - modified emission file + - added flbc file info + +M components/cam/cime_config/config_compsets.xml + - Change F2000_Dev to F2000climo + - Change FHIST_Dev to FHIST + - remove obsolete FC5L45BGC compset + - update SST files + - add missing "CROP" to CLM longnames + +M components/cam/cime_config/testdefs/testlist_cam.xml + - Change F2000_Dev to F2000climo + - Change FHIST_Dev to FHIST + - remove camchem test from DART (should not have been there) + - FWSD has a higher wallclock time + - various mods for test_release tests + +M components/cam/src/control/cam_history.F90 + - commented out all of the metadata fields which are not being currently set properly + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB + +cheyenne/intel/aux_cam: All tests had namelist changes due to changes in cime + The following tests had namelist changes (due to new SST file) as well as baseline changes + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: This will have answer changes over the ocean + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + The following tests were renamed and had no namelist or baselines to compare against (but + changes were expected due to new SST files) + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + The following test did not have a baseline as the required input file did not exist until now + SMS_Ld1.f09_f09_mg17.FW2000.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + +hobart/nag: all BFB + +hobart/pgi: all BFB + +Additional tests run: + Ran test_release testing for every CAM compset to make sure that they compile and run for at least 9 time steps (not all tests + made it into the machine prior to this tag being made) + +=============================================================== +=============================================================== + +Tag name: cam5_4_190 +Originator(s): fvitt +Date: 14 May 2018 +One-line Summary: Update CIMP6 CO anthropogenic surface emissions and other misc updates + +Purpose of changes: + + - update CIMP6 CO emissions (1750-2015, 2000climo, 2010climo) + - update 2000climo and 2010clim LBC files for FC2000climo and FC2010climo compsets + - update FW1850 run reference case + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fvitt + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - update CIMP6 CO emissions + +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml + - update 2000climo CO emissions and LBC files + +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml + - update 2010climo CO emissions and LBC files + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/config_component.xml + - update FW1850 run reference case to f.e20.FW1850.f09_f09_mg17.295_v2 + -- no longer need to specify ncdata separately + +M components/cam/cime_config/testdefs/testlist_cam.xml + - minor correction for the FX2000 compset test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Mon May 14 17:00:22 MDT 2018 + - expected failure due to change in default CO surface emissions file + +cheyenne/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_189 + - FWHIST baseline is expected to fail due to updates to CO emissions file + + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_189: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/cesm_baselines/cam5_4_189/SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d' does not exist + - FW1850 baseline is expected to fail due to updates to CO emissions file and refernce case files + +hobart/nag: +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon May 14 14:37:52 MDT 2018 + - expected failure due to change in default CO surface emissions file + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: changes are larger than roundoff for CAM-Chem and WACCM, impact on climate is expected to be small + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_189 +Originator(s): cacraig, hannay, fvitt, goldy, raeder, mmills, jet, jedwards +Date: May 13, 2018 +One-line Summary: misc changes for CAM6 release branch + +Purpose of changes: + - updates to use CLM new refcases + - update manage_externals + - changes to allow SCAM tests to perform the comparison with the camiop + - updates to 1850 use case to mimic Cecile's 297 run + - CAM now has its own config_archive.xml file + - added science_support flags for CAM compsets + +NOTE -- FW1850 is currently BROKEN and will be fixed in an upcoming tag + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton (parts) + +List all files eliminated: + +List all files added and what they do: +A components/cam/cime_config/config_archive.xml + - CAM now has config_archive information in its source tree + +A components/cam/cime_config/testdefs/testmods_dirs/cam/dartcambigens +A components/cam/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cice +A components/cam/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_clm + - Filex to support DART + +A components/cam/test/system/config_files/e64c6aqiopdm +A components/cam/test/system/config_files/scmc6aqds + - Files to support SCAM and CAM IOP testing + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - new manage_externals + +M Externals.cfg + - update cime and CLM + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - updates for SCAM IOP testing + - updates for WACCM GW calculations + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml + - mods to match Cecile's 297 run + +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml + - changes to support WACCM GW calculation + +M components/cam/cime_config/config_compsets.xml + - added science support flag, revised names and added DART and FWmad compsets + +M components/cam/cime_config/testdefs/testlist_cam.xml + - reverted back change which should not have been introduced in previous tag + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_hobart_pgi + - added new SCAM test + +M components/cam/test/system/test_driver.sh + - bump up the time limit for cheyenne testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB + +cheyenne/intel/aux_cam: all namelist fail due to changes in cime + +ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_188: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/cesm_baselines/cam5_4_188/ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s' does not exist + - testing at new resolution so no previous baseline + + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - Fails baseline due to modifications to match Cecile's 297 run + + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + - All of these tests fail baselines due to changes in CLM. Verified this was the case by + running this same source code tree using the CLM rev005 and these tests were all BFB + + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: FAIL) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d RUN time=11 + - THIS TEST IS FAILING DUE TO INPUT ISSUES + +hobart/nag: all BFB + +hobart/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +All changes to answers for 1850 were made to mimic Cecile's 297 run. This tag will be independently +checked by Cecile after its commit. + +=============================================================== +=============================================================== + +Tag name: cam5_4_188 +Originator(s): jet +Date: Fri May 4 +One-line Summary: SCAM updates + +Purpose of changes: + +. IOP namelist parameters were modified so that aerosols will be + relaxed to initial conditions using a new feature added in a + previous tag. Additionally the prognostic SCAM temperature + calculation is being relaxed to IOP observations to compensate for + errors in advective forcing near the top of the column in the IOP + forcing datasets. For the radiative equilibrium cases, the + observed IOP temperature is used. + +. Add script camfv2iop.ncl which will allow user to create SCAM + IOP boundary data from CAM fv history files. + +. New default emission boundary data were provide for SCAM. These + files have a much smaller footprint than the standard CAM + emissions. (Better for remote users who need to download emission + boundary data to their machines. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: SCAM IOP namelists now include + options to relax emissions to initial condition by default. + +List any changes to the defaults for the boundary datasets: SCAM emission + datasets now default to 2000climo versions instead of the much + larger multiyear boundary data used by cam6. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton,cacraig + +List all files eliminated: none + +List all files added and what they do: +A components/cam/bld/scripts/camfv2iop.ncl + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/usermods_dirs/scam_arm95/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_arm97/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_atex/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_bomex/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_mpace/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_rico/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_togaII/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_twp06/user_nl_cam +. Mods to relax emission profile to initial condition. + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +. Update SCAM emission boundary data defaults to use 2000climo versions. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except: +041 sc001 TSC.sh e64c5aqiopdm scm_prep scmc5aqds scm_b4b_o1 7s ................................FAIL! rc= 6 at Mon May 7 22:16:15 MDT 2018 + CAM6 scam no longer passes the bfb test due to Clubb. Clubb has CPP defines that run different code depending on whether you are running + from cam6 or single column. The SCAM specific code mode seem to be tuning for single column runs but one or more of these cause + bfb test to fail. + +cheyenne/intel/aux_cam: All PASS except: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_187 + Test failures due to non bfb changes in SCAM namelist settings (relax emissions, use different emission datasets) + +hobart/nag: All PASS + +hobart/pgi: All PASS except: +039 sc002 TSC.sh e64c4aqiopdm scm_prep scmc4aqds scm_b4b_o1 7s ................................FAIL! rc= 6 at Fri May 4 15:03:56 MDT 2018 + CAM6 scam no longer passes the bfb test due to Clubb. Clubb has CPP defines that run different code depending on whether you are running + from cam6 or single column. The SCAM specific code mode seem to be tuning for single column runs but one or more of these cause + bfb test to fail. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB for CAM, Non BFB for SCAM due to different emission files and relaxation settings. BFB cam iop test fails + due to CPP SCAM defines in Clubb. + +=============================================================== +=============================================================== + +Tag name: cam5_4_187 +Originator(s): eaton +Date: Fri May 4 11:56:01 MDT 2018 +One-line Summary: update COSP2 code; misc fixes + +Purpose of changes: + +. Update COSP2 code to use its github source as an svn external. The only + significant code change is to use the COSP2 version of the MODIS + simulator rather than the previous COSP1.4 version. This changes answers + for the MODIS diagnostics. + +. Add check to print message and exit when fields are requested for sathist + output that can't be output due to hardcoded constraints in sat_hist module. + +. Add PSDRY and PMID to default SE output when running with moist physics. + +. Some mods in Eulerian dycore for use with analytic ICs. This + functionality is not yet fully implemented. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all files eliminated: +components/cam/src/physics/cosp2/src/hooks/cosp_constants.F90 +components/cam/src/physics/cosp2/src/hooks/cosp_errorHandling.F90 +components/cam/src/physics/cosp2/src/hooks/cosp_kinds.F90 +components/cam/src/physics/cosp2/src/simulator/icarus-scops-4.1-bsd/icarus.F90 +. change to github source + +List all files added and what they do: +components/cam/src/physics/cosp2/cosp_errorHandling.F90 +components/cam/src/physics/cosp2/cosp_kinds.F90 +components/cam/src/physics/cosp2/src/README +components/cam/src/physics/cosp2/src/cosp_constants.F90 +components/cam/src/physics/cosp2/src/simulator/README +components/cam/src/physics/cosp2/src/simulator/icarus/README +components/cam/src/physics/cosp2/src/simulator/icarus/icarus.F90 +components/cam/src/physics/cosp2/src/simulator/icarus/license +. change to github source + +List all existing files that have been modified, and describe the changes: +components/cam/SVN_EXTERNAL_DIRECTORIES +. add COSP2 from its github source + +components/cam/bld/configure +. filepath change due to change to COSP2 github source + +components/cam/cime_config/testdefs/testlist_cam.xml +. change wallclock on 1 test + +components/cam/doc/ChangeLog_template +. update to reflect current testing + +components/cam/src/control/sat_hist.F90 +. add check that fields requested for sathist output do not contain extra + mdims in addition to the vertical coordinate. + +components/cam/src/cpl/atm_comp_mct.F90 +. fix accessing model_doi_url value + +components/cam/src/dynamics/eul/dyn_comp.F90 +. move check on dimensions of fields in IC file to read_inidat +. in process_inidat don't do the branch that calls cnst_init_default if the + analytic ICs are active. + +components/cam/src/dynamics/eul/dyn_grid.F90 +. move the check on IC field dimensions to read_inidat + +components/cam/src/dynamics/fv/dyn_comp.F90 +. improve a comment + +components/cam/src/physics/cam/cam_diagnostics.F90 +. add PSDRY and PMID to the default output when running SE with moist + physics. + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. modify the add_hist_coord call for cosp_ht to indicate that this is a + vertical coordinate. + +components/cam/src/physics/cosp2/Makefile.in +components/cam/src/physics/cosp2/src/cosp.F90 +components/cam/src/physics/cosp2/src/cosp_config.F90 +components/cam/src/physics/cosp2/src/simulator/MODIS_simulator/modis_simulator.F90 +components/cam/src/physics/cosp2/src/simulator/actsim/lidar_simulator.F90 +components/cam/src/physics/cosp2/src/simulator/cosp_modis_interface.F90 +. change to github source + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except: +020 bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Fri May 4 07:32:06 MDT 2018 + +cheyenne/intel/aux_cam: All PASS + +hobart/nag: All PASS except: +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Fri May 4 09:05:39 MDT 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Fri May 4 09:14:43 MDT 2018 + +hobart/pgi: All PASS + +The baseline test failures are due to changes in MODIS diagnostic fields. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Only MODIS diagnostic fields have +diffs. + +=============================================================== +=============================================================== + +Tag name: cam5_4_186 +Originator(s): cacraig, goldy, sacks, olson +Date: May 3, 2018 +One-line Summary: Update externals to alpha10e, regression test cleanup, add DOI info and correct diagnostics + +Purpose of changes: + - Use the externals in cesm2_0_alpha10e, with the exception of cime which is using a newer tag + - Now that the supported="false" flag is available, tests that are for unsupported runs now use this flag, but can be + in the aux_cam test suite. + - Use the 10 degree files for the 13 month regression test + - Turn on using the DOI info + - Remove invalid 60 level ncdata file from 30 level specification + - In buildnml, have informative message use the logger.info instead of logger.debug setting + - Fix a couple of diagnostics in clubb and gw_drag + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to match cesm2_0_alpha10e (with updated bug-fixed cime tag) + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - remove invalid ncdata file (60 level file specified for a 30 level setup) + +M components/cam/cime_config/buildnml + - change logger.debug to logger.info so informative messages are written + +M components/cam/cime_config/testdefs/testlist_cam.xml + - modify 13 month test to use 10 degree files + - use new supported="false" flag for test-only compsets and removed test_cam designator + +M components/cam/src/cpl/atm_comp_mct.F90 + - Use the model_doi_url supplied by cime + +M components/cam/src/physics/cam/clubb_intr.F90 + - fix the DPDLFT diagnostic output + +M components/cam/src/physics/cam/gw_drag.F90 + - remove TTGWORO from history_budget setting + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - fix output units for ACTNL and ACTNI + +M components/cam/test/system/test_driver.sh + - remove test_cam testing (all done in aux_cam now) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB + +cheyenne/intel/aux_cam: All tests had namelist changes + + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_185 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_185 + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_185 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_185 + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_185 + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_185 + - Answer changes due to external components + + SMS_Lm13.f10_f10_mg37.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000_DEV.cheyenne_intel.cam-outfrq1m BASELINE cam5_4_185: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/cesm_baselines/cam5_4_185/SMS_Lm13.f10_f10_mg37.F2000_DEV.cheyenne_intel.cam-outfrq1m' does not exist + - Now running with 10 degree files + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_185 +Originator(s): fvitt, joemci, goldy +Date: 1 May 2018 +One-line Summary: Removed O3S from WACCM and CAM-Chem chemistry mechanisms and other misc changes + +Purpose of changes: + +- remove diagnostic O3S species from WACCM and CAM-Chem chemical mechanisms +- add default CTEM history fields to the h0 monthly files +- use MERRA2 meteorology data in FCSD compset +- minor changes in history specifiers in WACCMX compsets +- correct typo in qneg4 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM code review team + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml + - remove O3S from fincl lists + +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml + - use MERRA2 meteorology data + - remove O3S from fincl lists + +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml + - move IC file to standard relative inputdata relative path + - remove O3S from fincl lists + +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml + - minor changes in history specifiers + +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +- remove diagnostics O3S species from waccm and cam-chem chemical mechanisms + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +- remove diagnostics O3S species from waccm and cam-chem chemical mechanisms + +M components/cam/src/dynamics/fv/ctem.F90 +- add default CTEM history fields to the h0 monthly files + +M components/cam/src/physics/cam/qneg_module.F90 +- replace t_stopf ('qneg3') with t_stopf ('qneg4') in subroutine qneg4 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS + +cheyenne/intel/aux_cam: All bit-for-bit + + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_184 + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_184 + These WACCM compsets are actually bit-for-bit unchanged. The removal of O3S from the dry deposition list caused + differences to be detected only in the dry deposition fields cpl.hi.* file (the dry dep states are shifted by one). + The CAM histories are bit-for-bit idendical. + + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_184 + WACCMX is bit-for-bit unchanged. Moving history fields from h5 to h6 caused the baseline test to fail. + + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + Memory usage increase is not believed -- there are no code changes which will increase memory footprint + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam5_4_184 +Originator(s): eaton, goldy +Date: Fri Apr 27 09:31:09 MDT 2018 +One-line Summary: mods for DART mode + +Purpose of changes: + +. Mods to allow running CAM with DART. The main issue is that CAM needs to + be able to run as an initial run when the model is restarted as a + continuation run. CAM examines data in the atm_resume component of the + infodata structure passed from the driver to determine when it is running + in DART mode. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/src/cpl/atm_comp_mct.F90 +. Initialize dart_mode from the atm_resume data (in infodata structure) + passed from the driver, then pass to cam_init. +. Access logical variable dart_mode from cam_control_mod +. Use dart_mode conditional to modify creating the name of the .rs. file to + use the current caseid rather than the caseid from a restart file. + +components/cam/src/control/cam_control_mod.F90 +. add dart_mode to module data (public, protected) +. cam_ctrl_init + - add dart_mode as intent(in) arg and when dart_mode=.true. then force + CAM to use a start type of "initial run" + +components/cam/src/control/cam_comp.F90 +. cam_init + - add dart_mode to intent(in) args + - pass dart_mode to cam_ctrl_init + +components/cam/src/utils/time_manager.F90 +. timemgr_init + - enforce start_date to equal curr_date on an initial run. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS + +cheyenne/intel/aux_cam: All PASS + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_183 +Originator(s): fvitt, mmills +Date: 18 Apr 2018 +One-line Summary: Update volcanic forcings for WACCM + +Purpose of changes: + Updates to volcanic forcing input datasets: + . minor updates to some eruptions in the 1875-1912 period based on revision by Ryan Neely + . updating the piControl averaged volcanic eruptions to be consistent with the historical update + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fvitt + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - update default waccm6 volcanic forcing files + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS + +cheyenne/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_182 + - the namelist compare test failed due to updates to the volcanic forcing input files + - there are slight changes in pre-industrial volcanic forcing + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_182 +Originator(s): fvitt +Date: 17 Apr 2018 +One-line Summary: Add option to turn off ridge scheme vertical diffusion, adjust non-LTE Fomichev CO2 limiter, fix TROP_Z + +Purpose of changes: + - add namelist option to give the user the ability to switch off vertical diffusion + in ridge scheme + - in non-LTE Fomichev abort the run if CO2 exceeds the limit at altitudes above 1 mbar + unless apply_co2_limit=.true + - add height of surface (above sea level) to TROP_Z (height of tropopause) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +D components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml + - remove this obsolete use case file + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/physics/cam/gw_rdg.F90 +M components/cam/src/physics/cam/gw_common.F90 +M components/cam/src/physics/cam/gw_drag.F90 + - add option to turn off ridge scheme contribution to vertical diffusion + +M components/cam/bld/namelist_files/namelist_definition.xml + - add namelist option "gw_rdg_do_vdiff" + - adjust discription of "nlte_limit_co2" namelist option + +M components/cam/src/physics/cam/tropopause.F90 + - add height of surface (above sea level) to TROP_Z (height of tropopause) + +M components/cam/src/physics/waccm/nlte_fomichev.F90 + - abort the run if CO2 exceeds the limit at altitudes above the 1 mbar level unless apply_co2_limit=.true + - some code cleanup + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all PASS + +cheyenne/intel/aux_cam: + FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + - the baseline namelist files were missing + +cheyenne/intel/test_cam: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + +hobart/nag: all PASS + +hobart/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_181 +Originator(s): cacraig, goldy +Date: 2018-04-16 +One-line Summary: qneg modularized, added readnl, history and namelist cleanup + +Purpose of changes: + - Modularize QNEG output. Provide summary output and convert detailed output + to history output + - Namelist cleanup in preparation for relase + - Addition of model DOI to CAM history files (pending CIME upgrade) + - Delay endrun for bad history field entries until all bad entries are logged + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + - New qneg_nl namelist to configure QNEG output + - Cleanup of descriptions and formatting change for documentation output + - Added fv_print_dpcoup_warn (see below) + - Added print_filew_warn (see below) + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, cacraig + +List all subroutines eliminated: NA + +List all subroutines added and what they do: + - history_initialized: logical function so routines called both during + initialization and runtime can avoid making history calls too early. + - fill_nl: new namelist reader to control fv fill warning output + - qneg_init: Initialize qneg output and history processing + - subcol_pack_allocate: Allocate internal packing memory + - subcol_pack_init_restart: Create restart variables for internal state + - subcol_pack_write_restart: Write restart variables for internal state + - subcol_pack_read_restart: Read restart variables for internal state + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES + - Updated manage_externals to v1.1.3 +M components/cam/bld/build-namelist + - Add default for print_qneg_warn +M components/cam/bld/namelist_files/namelist_definition.xml + - Description cleanup + - Format change for documentation output + - Addition of qneg_nl with print_qneg_warn variable +M components/cam/doc/ChangeLog + - Removed extraneous line-ending spaces +M components/cam/src/chemistry/mozart/mo_airplane.F90 +M components/cam/src/chemistry/utils/mo_flbc.F90 + - Use gmean from new gmean_mod +M components/cam/src/control/cam_comp.F90 + - Pass model_doi_url to intht (history initialization) + - Print QNEG summary output depending on value of print_qneg_warn +M components/cam/src/control/cam_history.F90 + - Added history_initialized function + - Add model_doi_url attribute to all output files (if present) + - Delay calling endrun for invalid history output entries (e.g., fincl, fexcl) + until all invalid entries have been logged. +M components/cam/src/control/runtime_opts.F90 + - Add call to qneg_readnl +M components/cam/src/cpl/atm_comp_mct.F90 + - Add infrastructure to collect model_doi_url and make it available to + the history infrastructure. Needs to be finalized after model_doi_url is + available from seq_infodata. +M components/cam/src/dynamics/eul/dp_coupling.F90 +M components/cam/src/dynamics/eul/dyn_comp.F90 +M components/cam/src/dynamics/eul/tfilt_massfix.F90 + - Add use statement for qneg3 +M components/cam/src/dynamics/fv/dp_coupling.F90 + - Remove no-longer-used debug_adjust_print variable +M components/cam/src/dynamics/fv/dyn_comp.F90 + - Move lat/lon dim check on ncdata to read_inidat from dyn_grid_init + - Added fv_print_dpcoup_warn namelist variable to control constituent warning + output. +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Moved lat/lon dim check on ncdata to read_inidat as this check is not always + possible at this stage (analytic initial condition ncdata files do not have + horizontal coordinate information and therefore, cannot be incorrect in + those dimensions). +M components/cam/src/dynamics/fv/fill_module.F90 + - Added fill_readnl with the new print_filew_warn control namelist variable + - Use print_filew_warn to control fill warning output +M components/cam/src/dynamics/fv/fv_prints.F90 + - Use gmean from new gmean_mod +M components/cam/src/dynamics/se/dp_coupling.F90 + - Use gmean from new gmean_mod + - Add use statement for qneg3 +M components/cam/src/dynamics/se/native_mapping.F90 + - Fixed bug that was leaving namelist file open if the native_mapping_nl + namelist is not present in atm_in +M components/cam/src/physics/cam/check_energy.F90 + - Use gmean from new gmean_mod +M components/cam/src/physics/cam/phys_gmean.F90 + - Moved gmean interface and supporting code to new gmean_mod module +M components/cam/src/physics/cam/physics_buffer.F90.in + - Use subcol_pack and subcol_unpack from the new subcol_pack_mod module +M components/cam/src/physics/cam/physics_types.F90 + - Add use statement for qneg3 + - Fix array bounds and cleaned up call to qneg3 +M components/cam/src/physics/cam/physpkg.F90 + - Add call to qneg_init + - Add use statement for qneg4 +D components/cam/src/physics/cam/qneg3.F90 +D components/cam/src/physics/cam/qneg4.F90 + - Moved to qneg_module +A components/cam/src/physics/cam/qneg_module.F90 + - Moved qneg3 and qneg4 to this new module + - Removed all log print statements + - Added summary statistics processing + - Added history variables for all constituents for qneg3 and qneg4. For qneg3 + each constituent has a 3D variable (_qneg3) and a column sum 2D + variable (__qneg3_col). For qneg4, the new variable is qflux_exceeded. +A components/cam/src/physics/cam/subcol_pack_mod.F90.in + - Moved subcol_unpack, subcol_pack, subcol_get_nsubcol, subcol_set_nsubcol, + and subcol_get_indcol here from subcol_utils to avoid a circular + dependency caused by adding history to qneg_module. + - Added new interfaces (subcol_pack_allocate, subcol_pack_init_restart, + subcol_pack_write_restart, and subcol_pack_read_restart) for use by + subcol_utils +M components/cam/src/physics/cam/subcol_tstcp.F90 + - Move use statement for subcol_get_nsubcol to subcol_pack_mod +M components/cam/src/physics/cam/subcol_utils.F90.in + - Moved subcol_unpack, subcol_pack, subcol_get_nsubcol, subcol_set_nsubcol, + and subcol_get_indcol to subcol_pack_mod to avoid a circular + dependency caused by adding history to qneg_module. + - Call the new interfaces (subcol_pack_allocate, subcol_pack_init_restart, + subcol_pack_write_restart, and subcol_pack_read_restart) to properly + handle subcol's pack and unpack internal state. +M components/cam/src/physics/simple/physpkg.F90 + - Add call to qneg_init +M components/cam/src/physics/spcam/spcam_drivers.F90 + - Add use statement for qneg3 +A components/cam/src/utils/gmean_mod.F90 + - Moved gmean interface and supporting code from phys_gmean to avoid a + circular dependency caused by adding history to qneg_module. +M components/cam/test/system/test_driver.sh + - Removed a walltime argument to aux_cam testargs. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: ALL PASS + +cheyenne/intel/aux_cam: Failure (expected) only due to new qneg_nl namelist + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m NLCOMP + +cheyenne/intel/test_cam: Failure (expected) only due to new qneg_nl namelist + FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + +hobart/nag: ALL PASS + +hobart/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_180 +Originator(s): cacraig, mmills, hannay +Date: April 6, 2018 +One-line Summary: Fix for CAM's cold model top (and other changes to match Cecile's #289 run) + +Purpose of changes: + - Changes were made to reduce the assumed attenuation of solar fluxes above the CAM model top. For + this purpose, ozone mixing ratios are now assumed to decrease linearly from the values in the top + layer of CAM to zero at 0.5 hPa. Previously, solar fluxes were attenuated assuming ozone mixing + ratios were constant above the CAM top. + + - Changes to some of the files used by default for 1850 CAM6 runs + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - updated H2O ext_frc file for CAM6 + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml + - updated tracer_cnst, prescribed_strataero, prescribed_ozone, and H2O ext_frc files + +M components/cam/src/physics/rrtmg/radiation.F90 + - added addfld for O3colAbove variable + +M components/cam/src/physics/rrtmg/rrtmg_state.F90 + - changes to fix CAM's cold model top + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB except: +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Thu Apr 5 18:09:03 MDT 2018 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Thu Apr 5 18:32:07 MDT 2018 +020 bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Thu Apr 5 18:49:26 MDT 2018 +029 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Thu Apr 5 20:04:34 MDT 2018 + - Changes expected due to fix for CAM's cold water top + +cheyenne/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 BASELINE cam5_4_179 + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m BASELINE cam5_4_179 + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + - Changes expected due to fix for CAM's cold water top + + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_179 + - Changes expected due to fix for CAM's cold water top + - Modified ext_frc_specifier for H2O for 1850 cases + +cheyenne/intel/test_cam: PASS + +hobart/nag: all BFB except: +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Thu Apr 5 17:06:20 MDT 2018 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Thu Apr 5 17:24:07 MDT 2018 +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Thu Apr 5 17:34:58 MDT 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Thu Apr 5 17:48:39 MDT 2018 +030 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Thu Apr 5 17:52:38 MDT 2018 +036 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Thu Apr 5 17:56:48 MDT 2018 +039 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Thu Apr 5 18:02:23 MDT 2018 +042 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Thu Apr 5 18:08:15 MDT 2018 +045 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Thu Apr 5 18:13:06 MDT 2018 +051 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Thu Apr 5 18:37:13 MDT 2018 +067 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Thu Apr 5 19:13:42 MDT 2018 + - Changes expected due to fix for CAM's cold water top + +hobart/pgi: +011 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Apr 5 17:55:37 MDT 2018 +017 bl320 TBL.sh f10c5aqpbadm rad_diag 9s .....................................................FAIL! rc= 7 at Thu Apr 5 18:16:13 MDT 2018 +020 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Apr 5 18:29:35 MDT 2018 +034 bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s ......................................FAIL! rc= 7 at Thu Apr 5 19:18:46 MDT 2018 + - Changes expected due to fix for CAM's cold water top + +Summarize any changes to answers, i.e., +- what code configurations: all which use rrtmg +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): New climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- case: + /glade/p/cesmdata/cseg/runs/cesm2_0/b.e20.B1850.f09_g17.pi_control.all.289 +- platform/compilers: cheyenne/intel +- MSS location of output: /glade/p/cesm0005/archive/b.e20.B1850.f09_g17.pi_control.all.289 + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/B1850/b.e20.B1850.f09_g17.pi_control.all.289/atm + +=============================================================== +=============================================================== + +Tag name: cam5_4_179 +Originator(s): cacraig +Date: April 3, 2018 +One-line Summary: Cleanup of files in inputdata and namelist_definition file + +Purpose of changes: + - In preparation for release, verified that all files referenced in the CAM code reside in + inputdata and if they do not, they were removed from the CAM code + + - Completed the verification/corrections for the namelist_definition.xml file (which will be used to generate the + namelist documentation for the release) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml + - this use_case is no longer used and the files it referenced no longer existed + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - removed obsolete files + - Renamed mice_warren_2008.nc to mice_warren2008 which it was stored as in the svn repository + +M components/cam/bld/namelist_files/namelist_definition.xml + - Replaced prescribed_strataero_name with prescribed_strataero_specifier (which is what it is in the Fortran code) + - Corrected/added comments as needed + - Updated defaults to match the actual settings + +M components/cam/src/chemistry/utils/prescribed_strataero.F90 + - corrected prescribed_strataero_specifier length in mpibast call + +M components/cam/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 +M components/cam/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 +M components/cam/src/physics/carma/models/pmc/carma_model_flags_mod.F90 +M components/cam/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 + - Renamed mice_warren_2008.nc to mice_warren2008 which it was stored as in the svn repository + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB + +cheyenne/intel/aux_cam: all PASS + +cheyenne/intel/test_cam: PASS + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_178 +Originator(s): dswales, eaton +Date: Wed Mar 28 09:50:54 MDT 2018 +One-line Summary: fix cosp_ht coordinate in history files + +Purpose of changes: + +. Fix cosp_ht coordinate output to history files. The fix has no + impact on the COSP diagnostic fields. + +Bugs fixed (include bugzilla ID): above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/scripts/create_scam6_iop_multi +. fix EOF indentation + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. fix for vertical coordinate cosp_ht + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except +020 bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Tue Mar 27 13:56:34 MDT 2018 + +cheyenne/intel/aux_cam: PASS + +cheyenne/intel/test_cam: PASS + +hobart/nag: All PASS except +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Tue Mar 27 12:37:34 MDT 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Tue Mar 27 12:50:15 MDT 2018 + +hobart/pgi: PASS + +The failed baselines are due to changes in the cosp_ht coordinate +variable. The COSP diagnostics are not affected. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_177 +Originator(s): eaton +Date: Mon Mar 26 14:41:02 MDT 2018 +One-line Summary: fix for ideal physics w/ >=60 levels + +Purpose of changes: + +. fix bug that caused ideal physics configurations to fail if the number of + vertical layers was >=60. + +Bugs fixed (include bugzilla ID): above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +. modify conditional that turns on gwdrag options for nlev>=60 + +components/cam/bld/namelist-files/use_cases/held_suarez_1994.xml +. add dyn="eul" attribute to setting of eul_hdif_order. This is just a + cleanup so that namelist variables for EUL dycore don't show up in atm_in + when non-Eulerian dycore is used. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS + +cheyenne/intel/aux_cam: All PASS + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam5_4_176 +Originator(s): fvitt, mmills, emmons +Date: 22 Mar 2018 +One-line Summary: Corrections to wet removal of gas-phase constituents and other misc changes + +Purpose of changes: + - corrections to NEU wet removal routine + -- correct setting of flag for mass-limited (HNO3,etc.) vs Henry's Law washout + - in CAM HIST compset (use case file hist_cam6.xml) + -- use WACCM LBC file + -- use corrected solar forcing file -- datesec shifted by half day + - additional chemistry diagnostics when history_scwaccm_forcing is set to .true. + - include O3S list of species which are dry deposited + +Bugs fixed (include bugzilla ID): + - washout corrections -- correct setting of flag for mass-limited (HNO3,etc.) vs Henry's Law washout + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + In compset FHIST_DEV: + - use WACCM LBC file + - use corrected solar forcing file + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - correct setting of flag for mass-limited (HNO3,etc.) vs Henry's Law washout + +M components/cam/src/chemistry/utils/mo_flbc.F90 + - can handle zonal mean files without longitude coordinate variable + +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - use WACCM LBC file + - use corrected solar forcing file -- datesec shifted by half day + +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml + - use corrected solar forcing file -- datesec shifted by half day + +M components/cam/src/chemistry/mozart/chem_prod_loss_diags.F90 +M components/cam/src/chemistry/mozart/mo_chemini.F90 +M components/cam/src/chemistry/mozart/rate_diags.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 + - include chemistry diagnostics when history_scwaccm_forcing is set to .true. + +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml + - use better documented LBC file + +M components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml + - use CFC11eq LBC + +M components/cam/bld/namelist_files/master_gas_drydep_list.xml + - include O3S list of species which are dry deposited + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Wed Mar 21 15:06:34 MDT 2018 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Wed Mar 21 15:08:07 MDT 2018 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Wed Mar 21 15:27:59 MDT 2018 +020 bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Wed Mar 21 15:44:46 MDT 2018 +023 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Wed Mar 21 16:21:02 MDT 2018 +026 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Wed Mar 21 16:54:42 MDT 2018 +029 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Wed Mar 21 16:59:39 MDT 2018 + These baseline failures are due to corrections in the gas phase 'NUE' wet removal routine. + +cheyenne/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_175 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_175 + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_175 + SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m BASELINE cam5_4_175 + These baseline failures are mostly due to corrections in the gas phase 'NUE' wet removal routine. + In compset FHIST_DEV the use of WACCM LBC file and corrected solar forcing file also contribute to answer changes. + +cheyenne/intel/test_cam: All PASS + +hobart/nag: +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Wed Mar 21 14:30:59 MDT 2018 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Wed Mar 21 14:57:20 MDT 2018 +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Wed Mar 21 15:11:42 MDT 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Wed Mar 21 15:25:35 MDT 2018 +030 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Wed Mar 21 15:33:41 MDT 2018 +036 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Wed Mar 21 15:38:48 MDT 2018 +039 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Wed Mar 21 15:46:48 MDT 2018 +042 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Wed Mar 21 15:51:33 MDT 2018 +045 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Wed Mar 21 15:59:15 MDT 2018 +048 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Wed Mar 21 16:11:24 MDT 2018 +051 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Wed Mar 21 16:25:53 MDT 2018 +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Mar 21 16:52:03 MDT 2018 +067 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Wed Mar 21 17:44:27 MDT 2018 + These baseline failures are due to corrections in the gas phase 'NUE' wet removal routine. + +hobart/pgi: +020 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 21 15:52:19 MDT 2018 + This baseline failure is due to corrections in SO2 wet removal. + +Summarize any changes to answers, i.e., +- what code configurations: cases where gas_wetdep_method = 'NEU' +- what platforms/compilers: all +- nature of change: larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/misc_cam5_4_170_tags/misc03_cam5_4_170 +- platform/compilers: + cheyenne, intel +- configure commandline: + ./create_newcase --compset FW2000 --res f09_f09_mg17 --case /glade/p/work/fvitt/cesm/cases/fw2000_wetdep_test01 + +URL for AMWG diagnostics output used to validate new climate: + + CAM climate validation: + http://webext.cgd.ucar.edu/B1850/b.e20.B1850.f09_g17.pi_control.all.280/atm/b.e20.B1850.f09_g17.pi_control.all.280_yrs5-29-b.e20.B1850.f09_g17.pi_control.all.279_yrs5-29 + + WACCM climate validation: + https://acomstaff.acom.ucar.edu/tilmes/amwg/cesm2/fw2000_wetdep_test01.2_7-fw2000_wetdep_cntl01.2_7 + https://acomstaff.acom.ucar.edu/tilmes/amwg/cesm2/aerosol/fw2000_wetdep_test01.cam.h0.0002-0007.-fw2000_wetdep_cntl01.cam.h0.0002-0007./aerosol.html + +=============================================================== +=============================================================== + +Tag name: cam5_4_175 +Originator(s): cacraig, eaton, jet +Date: March 21, 2018 +One-line Summary: Updates to SCAM + +Purpose of changes: + + - SCAM now uses CAM6 physics + - Mods to allow SCAM to run in a single MPI task. Previously it was only + allowed to be configured with the -nospmd flag. + - Added 8 new IOP test cases for SCAM + - Expanded the functionality of the scam relaxation feature + + There is now a new scam namelist parameter "scm_relax_fincl" which is a list of strings containing + the names of fields which are to be relaxed. Previously a user was only able to apply a relaxation + tendency to the group of four forecast profiles for U,V,T, and Q by setting scm_relaxation = .true. + Now, if relaxation is requested (scm_relaxation = .true.) and scm_relax_fincl remains empty then + the default prognostic fields of T,U,V,Q will be relaxed just as before. If scm_relaxation = .true. + and scm_relax_fincl contains one or more fields then the defaults are ignored and only the fields in + scm_relax_fincl will be relaxed. Additionally, SCAM can now apply a relaxation tendency for every + registered tracer field. The relaxation tendency for tracers is derived relative to the initial + condition profile. For the prognostic variables T,U,V, and Q the relaxation tendency is derived + relative to the observed values on the IOP dataset. If no relaxation tendency is requested + (scm_relaxation = .false.) then scm_relax_fincl will be ignored. + + Usage example: + + The following set of commands will apply a relaxation tendency to the prognostic variables T,U and + V as well as the tracer fields num_a1,num_a2,num_a3. + + scm_relaxation = .true. + scm_relax_fincl = 'T','U','V','num_a1',num_a2','num_a3' + + The interface for controlling relaxation to observations is undergoing review and will likely be modified + in an upcoming commit. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - SCAM is now allowed to run with a single MPI task + +Describe any changes made to the namelist: + - Added namelist scm_relax_fincl (list of fields that will be relaxed to obs) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/bld/scripts + - added new scripts directory for sample run_scripts + +A components/cam/bld/scripts/create_scam6_iop + - sample script for single IOP SCAM run + +A components/cam/bld/scripts/create_scam6_iop_multi + - sample script for multiple IOPs SCAM run + +A components/cam/cime_config/usermods_dirs/scam_atex +A components/cam/cime_config/usermods_dirs/scam_atex/shell_commands +A components/cam/cime_config/usermods_dirs/scam_atex/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_bomex +A components/cam/cime_config/usermods_dirs/scam_bomex/shell_commands +A components/cam/cime_config/usermods_dirs/scam_bomex/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_cgilsS11 +A components/cam/cime_config/usermods_dirs/scam_cgilsS11/shell_commands +A components/cam/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_cgilsS12 +A components/cam/cime_config/usermods_dirs/scam_cgilsS12/shell_commands +A components/cam/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_cgilsS6 +A components/cam/cime_config/usermods_dirs/scam_cgilsS6/shell_commands +A components/cam/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_dycomsRF01 +A components/cam/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands +A components/cam/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_dycomsRF02 +A components/cam/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands +A components/cam/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_rico +A components/cam/cime_config/usermods_dirs/scam_rico/shell_commands +A components/cam/cime_config/usermods_dirs/scam_rico/user_nl_cam + + - Added IOP locations ATEX, BOMEX, CGILSS6, CGILSS11, CDILSS12, + DYCOMSRF02, DYCOMSRF01, RICO + + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - updated manage_externals to manic-v1.0.1 + +M components/cam/bld/configure + - allow SCAM build with -spmd + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - add/update files to support CAM6 SCAM + +M components/cam/bld/namelist_files/namelist_definition.xml + - added namelist variable to control SCAM expanded relaxation functionality + +M components/cam/cime_config/buildcpp + - remove dependence of spmd and smp settings on pts_mode + +M components/cam/cime_config/config_compsets.xml + - change SCAM run to use CAM6 now that it is supported + +M components/cam/cime_config/usermods_dirs/scam_arm95/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_arm97/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_mpace/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_togaII/user_nl_cam +M components/cam/cime_config/usermods_dirs/scam_twp06/user_nl_cam + - Added scm_use_obs_uv = .true. + +M components/cam/cime_config/usermods_dirs/scam_mandatory/shell_commands + - update comment to indicate that SCAM can run in SPMD mode + +M components/cam/src/control/scamMod.F90 +M components/cam/src/dynamics/eul/iop.F90 +M components/cam/src/dynamics/eul/scmforecast.F90 + - Allow expanded relaxation functionality + +M components/cam/src/dynamics/eul/spmd_dyn.F90 + - modify checks on problem size to allow single column in spmd mode + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB + +cheyenne/intel/aux_cam: all PASS except: + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_170 + - Updated SCAM to use CAM6 and new support files, expected namelist and answers to change + +cheyenne/intel/test_cam: all PASS + +hobart/nag: all BFB + +hobart/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_170 + +=============================================================== + +=============================================================== + +Tag name: cam5_4_174 +Originator(s): cacraig +Date: March 7, 2018 +One-line Summary: Add changes to allow manage_externals to work within CESM as well as CAM + +Purpose of changes: + - This is expected to be the final commit of CAM to update to using checkout_externals. + + - Made modifications so that checkout_externals will now work within CESM checkouts as well as CAM standalone checkouts + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/Externals_CAM.cfg + - Will revert back to using SVN_EXTERNAL_DIRECTORIES to manage the CAM externals. This file will + be introduced when CAM moves to git + +List all subroutines added and what they do: +A components/cam/SVN_EXTERNAL_DIRECTORIES + - Resume using this file to manage CAM's externals until CAM moves to git. + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Remove the reference to Externals_CAM.cfg + + M components/cam + - svn:external modifications to bring back in SVN_EXTERNAL_DIRECTORIES + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: none run + +cheyenne/intel/aux_cam: none run + +cheyenne/intel/test_cam: none run + +hobart/nag: none run + +hobart/pgi: none run + +Ran tests both on CAM standalone checkouts as well as CESM checkouts and compared them with ones +which did not use manage_externals. The code bases were identical. + +=============================================================== +=============================================================== + +Tag name: cam5_4_172 +Originator(s): cacraig +Date: March 6, 2018 +One-line Summary: Minor fixes to enable checkout_externals to work properly + +Purpose of changes: + Inadvertently committed a broken tag. This commit corrects that problem. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Added components/cam to the path for Externals_CAM.cfg information + +M components/cam/Externals_CAM.cfg + - Removed extraneous line which was being ignored, but shouldn't be in the file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: none run + +cheyenne/intel/aux_cam: none run + +cheyenne/intel/test_cam: none run + +hobart/nag: none run + +hobart/pgi: none run + +Since this is just checking out externals, compared this code +base with cam5_4_172 to make sure they were identical. + +=============================================================== +=============================================================== + +Tag name: cam5_4_171 +Originator(s): cacraig +Date: March 6, 2018 +One-line Summary: Update CAM to use checkout_externals for management of externals + +Purpose of changes: + + *** IMPORTANT CHANGE TO CAM CHECKOUTS ***** + + Checkouts of CAM code no longer automatically populate all of the + externals (cime,clm,cice,cism etc.) as well as the externals included + in CAM (clubb, carma and chem_proc). + + To get the externals, users need to cd to the main CAM directory and + run: + + manage_externals/checkout_externals + + This will create and populate all of the external directories. + + Note -- You will get an error message if you try to cd into manage_externals + and run checkout_externals from that directory. + + This change is being made to bring CAM external management into line with the + rest of CESM. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/SVN_EXTERNAL_DIRECTORIES + - Removed SVN_EXTERNAL_DIRECTORIES - it is replaced with Externals_CAM.cfg + +List all subroutines added and what they do: +A + Externals.cfg + - high level externals used by CAM checkouts to get other components + +A + components/cam/Externals_CAM.cfg + - list of externals used internally by CAM + +List all existing files that have been modified, and describe the changes: + + M . +M SVN_EXTERNAL_DIRECTORIES + - All references to other components is now in Externals.cfg + + M components/cam + - svn externals are now removed and are created via checkout_externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: not run + +cheyenne/intel/aux_cam: not run + +cheyenne/intel/test_cam: not run + +hobart/nag: not run + +hobart/pgi: not run + +As these changes are just to file checkout, no regression tests were run. Instead the +checked out directory was compared to cam5_4_170 by hand to verify the code tree. A +comparison was also made to a cesm checkout using a branch tag of this commit. + +=============================================================== +=============================================================== + +Tag name:cam5_4_170 +Originator(s): cacraig +Date: Feb 28, 2018 +One-line Summary: Update externals to match cesm2_0_beta09 + +Purpose of changes: + - Update externals to match cesm2_0_beta09 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - Update externals to match cesm2_0_beta09 + - Add glimmer as a separate listing due to CISM now being in git and using + manage_externals to bring in its externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All BFB + +cheyenne/intel/aux_cam: BFB and namelist failures due to changes in externals + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_169 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_169 + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_169 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_169 + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_169 + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_169 + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_169 + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m BASELINE cam5_4_169 + - drv_in has additional namelist parameters due to change in coupler + - CLM said all CLM50 runs will have different results + +cheyenne/intel/test_cam: BFB except for NLCOMP failures + - drv_in has additional namelist parameters due to change in coupler + +hobart/nag: All BFB + +hobart/pgi: All BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_169 +Originator(s): dennis, pel, eaton +Date: Tue Feb 27 10:53:18 MST 2018 +One-line Summary: Mods for SE/CSLAM optimization + +Purpose of changes: + +. Add mods for SE/CSLAM optimization from John Dennis. + +. misc fixes + - modify component definition to apply the held_suarez_1994 use case to + all FHS94 compsets regardless of dycore. + - attach the weights of the FV staggered latitude coordinate to the + correct grid. + - remove namelist setting for se_hypervis_order. It's not implemented. + +Bugs fixed (include bugzilla ID): +. The FV variable w_stag was being output with the wrong dimension (lat + instead of slat). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. remove se_hypervis_order + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: goldy, eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +components/cam/bld/namelist_files/namelist_defaults_cam.xml +components/cam/bld/namelist_files/namelist_definition.xml +. remove se_hypervis_order + +components/cam/bld/namelist_files/use_cases/held_suarez_1994.xml +. remove unneeded specification of use_topo_file + +components/cam/cime_config/config_component.xml +. remove grid attribute on CAM%HS94 match so that the use case is applied + to all dycores + +components/cam/src/dynamics/fv/dyn_grid.F90 +. move the w_stag attribute from the fv_v_stagger grid to fv_u_stagger. + w_stag are latitude weights associated with the slat coordinate. + +components/cam/src/dynamics/se/dycore/control_mod.F90 +. remove hypervis_order. only 2nd order is implemented + +components/cam/src/dynamics/se/dp_coupling.F90 +components/cam/src/dynamics/se/dycore/bndry_mod.F90 +components/cam/src/dynamics/se/dycore/comp_ctr_vol_around_gll_pts.F90 +components/cam/src/dynamics/se/dycore/derivative_mod.F90 +components/cam/src/dynamics/se/dycore/dimensions_mod.F90 +components/cam/src/dynamics/se/dycore/dof_mod.F90 +components/cam/src/dynamics/se/dycore/edge_mod.F90 +components/cam/src/dynamics/se/dycore/edgetype_mod.F90 +components/cam/src/dynamics/se/dycore/element_mod.F90 +components/cam/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 +components/cam/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +components/cam/src/dynamics/se/dycore/fvm_mapping.F90 +components/cam/src/dynamics/se/dycore/fvm_mod.F90 +components/cam/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +components/cam/src/dynamics/se/dycore/global_norms_mod.F90 +components/cam/src/dynamics/se/dycore/interpolate_mod.F90 +components/cam/src/dynamics/se/dycore/mass_matrix_mod.F90 +components/cam/src/dynamics/se/dycore/parallel_mod.F90 +components/cam/src/dynamics/se/dycore/prim_advance_mod.F90 +components/cam/src/dynamics/se/dycore/prim_advection_mod.F90 +components/cam/src/dynamics/se/dycore/prim_driver_mod.F90 +components/cam/src/dynamics/se/dycore/prim_init.F90 +components/cam/src/dynamics/se/dycore/prim_state_mod.F90 +components/cam/src/dynamics/se/dycore/schedtype_mod.F90 +components/cam/src/dynamics/se/dycore/schedule_mod.F90 +components/cam/src/dynamics/se/dycore/viscosity_mod.F90 +components/cam/src/dynamics/se/dyn_comp.F90 +components/cam/src/dynamics/se/dyn_grid.F90 +components/cam/src/dynamics/se/gravity_waves_sources.F90 +components/cam/src/dynamics/se/interp_mod.F90 +components/cam/src/dynamics/se/restart_dynamics.F90 +. optimization mods + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except: +010 bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s .................................................FAIL! rc= 7 at Mon Feb 26 15:02:12 MST 2018 +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Mon Feb 26 15:13:59 MST 2018 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Tue Feb 27 09:35:35 MST 2018 +023 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Tue Feb 27 09:36:38 MST 2018 +026 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Tue Feb 27 09:37:05 MST 2018 + +These baselines fail due to a different dimension for w_stag in the IC file. + +cheyenne/intel/aux_cam: All PASS + +cheyenne/intel/test_cam: PASS except +FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + +namelists are different due to removal of se_hypervis_order + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_168 +Originator(s): fvitt, mmills, tilmes +Date: 26 Feb 2018 +One-line Summary: WACCM and CAM-Chem compset updates + +Purpose of changes: + +- Set WACCM6 / CAM-Chem6 emissions (megan and emis files) in cam namelist_defaults + . remove the emissions from use case files and let build namelist set these + via cam namelist_defaults + . for sim_year=1850 use include background volcanic emissions + +- Add "-CROP" to compset definitions + +- Move CO2 to implicit solver in waccm_mad_mam4 chemistry mechanism + + - Updates to build-namelist use case files: + . update WACCM volcanic emissions + . turn on use of CFC11_eq (scale CFC11* to concentrations prescribed in CAM) + . use CAM default topography file + +- Add history fields to fincl lists in WACCM and camchem use case files: + WD_CH3COCH3, CFC11STAR, E90, ST80_25 AOA_NH, NH_5, NH_50, BURDENBCdn, NITROP_PD + + - Enable the use of CFC11eq in the LBC for CAM via the flbc mechanism + + - Minor updates to trop_strat_mam4_vbs and waccm_tsmlt_mam4 chemistry mechanisms + . add passive diagnostic tracers (AOA_NH, E90, NH_5, NH_50, ST80_25) + . change molecular weight of TERP2OOH (C10H6O4 -> C10H18O3) + . correct O3S loss reactions + - Include CH3COCH3 in wet deposition species lists + - Removed gw, tms, beljaars, etc namelist settings from use case files + -- use the cam6 defaults + + - Improve error message in fomichev CO2 limit check including grid location + + - Update waccm_sc_hist use case + + - Remove lght_no_prd_factor and dust_emis_fact from CAM-Chem and WACCM + build-namelist use case files -- build-namelist sets these according + to the namelist defaults as follows: + free-running : + res 1.9x2.5: + lght_no_prd_factor = 1.0 + dust_emis_fact = 0.26 + res 0.9x1.25: + lght_no_prd_factor = 1.5 + dust_emis_fact = 0.7 + res ne30 + lght_no_prd_factor = 2.0 + specified-dynamics : + res 1.9x2.5: + lght_no_prd_factor = 1.3 + dust_emis_fact = 0.24 + res 0.9x1.25: + lght_no_prd_factor = 1.6 + dust_emis_fact = 0.7 + res 0.45x0.63: + lght_no_prd_factor = 0.32 + dust_emis_fact = 0.9 + + - Provide some support for CAMChem with SE: + . add regression test for ne30 (SE) FCHIST compset + . give reasonable PE layout on cheyenne when SE ne30 grid is selected for + CAM-Chem and WACCM + + - CIME configure updates: + . WACCM-tsmlt and WACCM-ma HIST compsets at f09 resolution are setup + as hybrid run type with 1972-01-01 start date + . set RUN_SARTDATE=1976-01-01 for WACCM HIST compsets + . hybrid run type for WACCM 1850 and 2000 compsets as well as WACCM SD MA compset + . specify IC file for hybrid run type in WACCM compsets + . set FCHIST run start date to 1850-01-01 + . set SSTICE_YEAR_END to 2016 for the HIST and SD compsets + + - Correct logic in chemdr for resetting the surface mixing ratios of test tracers + + - Restore sim_year namelist option which had been removed in tag cam5_4_157 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM code review team + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d + - for 5-day FWmadSD test + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + - set default WACCM and camchem emissions and NOx lightning production factors + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - set default WACCM and camchem emissions and NOx lightning production factors + - include some default GW settings + +M components/cam/bld/namelist_files/master_gas_wetdep_list.xml + - include CH3COCH3 in wet deposition species lists + +M components/cam/bld/namelist_files/namelist_definition.xml + - restore the sim_year option that was removed in cam5_4_157 + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml + - use case updates and cleanup for WACCM and CAMChem compsets + +M components/cam/cime_config/config_component.xml + - override IC file setting for WACCM compsets set up as hybrid run start type + +M components/cam/cime_config/config_compsets.xml + - include the "-CROP" CLM configuration option in WACCM and CAMChem compsets + - set WACCM HIST compsets start date to 1976-01-01 + - set CAMChem HIST compsets start date to 1850-01-01 + - set SST_YEAR_END to 2016 -- the end of the sst data file + - setup WACCM and CAMChem compsets as hybrid run start typ + +M components/cam/cime_config/config_pes.xml +- give reasonable default PE layout on cheyenne when SE ne30 grid is selected for CAM-Chem and WACCM + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add regression test for ne30 (SE) FCHIST compset + - change the FWmadSD test to run 5 days + +M components/cam/src/physics/waccm/nlte_fomichev.F90 +M components/cam/src/physics/waccm/nlte_lw.F90 + - improved error message when co2 is out of expected range + +M components/cam/src/chemistry/utils/mo_flbc.F90 + - enable the use of CFC11eq in the LBC + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - corrected logic for resetting the surface mixing ratios of test tracers + +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 + - move CO2 to the implicit solver list + CO2 in the upper atmosphere is more stable in this configuration + +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 + - CAMChem and WACCM chemistry mechanism updates: + . add passive diagnostic tracers (AOA_NH, E90, NH_5, NH_50, ST80_25) + . change molecular weight of TERP2OOH (C10H6O4 -> C10H18O3) + . correct O3S loss reactions + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: + 013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Fri Feb 23 20:05:19 MST 2018 + - expected failure due to inclusion of CH3COCH3 in wet deposition + + 017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Fri Feb 23 20:27:08 MST 2018 + - expected failure due to updated chemistry mechanism, emissions, and inclusion of CH3COCH3 in wet deposition + + 034 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Fri Feb 23 22:00:15 MST 2018 + - pre-existing failure -- w_stag fill_value issue + +cheyenne/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_167 + - expected baseline failure due to updated chemistry mechanism, emissions, and inclusion of CH3COCH3 in wet deposition + + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s NLCOMP + - SSTICE_YEAR_END changed to 2016 (the end of the SST file), otherwise bit-for-bit unchanged + + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_167 + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + - expected baseline failure due to updated chemistry mechanism, emissions, and inclusion of CH3COCH3 in wet deposition + - Memory usage increase is not believed -- there are no code changes which will increase memory footprint + +cheyenne/intel/test_cam: All PASS + +hobart/nag: +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Feb 23 20:01:40 MST 2018 + -expected failure due to changes in default emissions for WACCM6 + +hobart/pgi: All PASS + +=============================================================== +=============================================================== + +Tag name: cam5_4_167 +Originator(s): cacraig, jedwards +Date: Feb 22, 2018 +One-line Summary: Misc changes to support pio2 and testing + +Purpose of changes: + - Incorporate changes to support pio2 with _FillValue attribute + - Fix timings for alpha tests + - Add timings for beta tests + - Correct units for addfld for TTGWSPEC + - Add aux_cime_baselines tests + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/testdefs/testlist_cam.xml + - Added aux_cime_baselines tests + - Fixed timings for alpha tests + - Added timings for beta tests + +M components/cam/src/physics/cam/gw_drag.F90 + - Set units to 'K/s' for TTGWSPEC addfld + +M components/cam/src/utils/cam_grid_support.F90 + - Changes from Jim and augmented by Cheryl: + pio2 requires changes for _FillValue attribute + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: all BFB, except: +034 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Wed Feb 21 17:48:37 MST 2018 + - Discrepancy in fill value in field w_stag between CESM and CAM run. Brian will fix in a future tag. + +cheyenne/intel/aux_cam: all BFB + +cheyenne/intel/test_cam: all BFB + +hobart/nag: all BFB + +hobart/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam5_4_166 +Originator(s): eaton +Date: Wed Feb 14 09:59:05 MST 2018 +One-line Summary: fix for COSP (cloudsat) threading + +Purpose of changes: + +. Fix for cloudsat simulator so that it runs in debug mode with threading + on. The test on cheyenne is changed from pure MPI to hybrid mode. + +Bugs fixed (include bugzilla ID): + +. bugz 171: fixed discrepency between definition and output of VZ + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/Makefile.in +. remove unneeded link options from intel + +components/cam/src/physics/cam/cam_diagnostics.F90 +. make definition and output of VZ consistent. Definition changed from + "geopotential energy" to "geopotential height", and the output is no + longer multiplied by the gravitational constant. + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. add chunk dimension for module storage of sd and rcfg_cloudsat +. add check of error messages returned from cosp_simulator +. refactor calc of gas absorption for cloudsat simulator + +components/cam/src/physics/cosp2/optics/quickbeam_optics.F90 +. remove calc of gas absorption + +components/cam/test/system/input_tests_master +. change *380 to use hybrid config rather than pure mpi + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: +020 bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Tue Feb 13 16:02:35 MST 2018 + +Missing baseline due to changed test definition. + +cheyenne/intel/aux_cam: All PASS + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_165 +Originator(s): fvitt +Date: 8 Feb 2018 +One-line Summary: Corrections to WACCM solar forcings + +Purpose of changes: + + - Use time_coordinate utility class in epp_ionization module to manage time interpolations + -- this corrects the timing of energetic particle forcings (leap day issue) + - Vertically interpolate ionization rates over log pressure rather than pressure + - Implement capability in time_coordinate utility to time-interpolate to some delta-time + which is not current model time, such as delta_days=-1 for the previous day (24 hrs prior) + - Pass in previous day's F10.7cm radio flux scaled by earth-sun distance factor to MSIS + for WACCM upper boundary (time interpolated to 24 hours prior to the current model time) + - Time-interpolate WACCM "solar parms" input data (space weather indices Kp, F10.7, Ap) + -- these had been held constant between data times + - Use corrected solar forcing files in WACCM compsets + - Add "f107p" to CAM history files (previous day's F10.7cm radio flux) + + +Bugs fixed (include bugzilla ID): + Fixes an issue with the timing of solar proton events when the model calendar is + set to noleap and the ionization input file includes leap days. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml + - use corrected solar forcing file for transient cases + +M components/cam/cime_config/testdefs/testlist_cam.xml + - move a camchem test from yellowstone to cheyenne + +M components/cam/src/chemistry/mozart/epp_ionization.F90 + - use time_coordinate utility class + - vertically interpolate with respect to log-pressure + - add EPPions diagnostic + +M components/cam/src/chemistry/mozart/upper_bc.F90 + - pass previous day's F10.7 cm radio flux to MSIS + +M components/cam/src/chemistry/utils/input_data_utils.F90 + - add the ability to specify a delta-time (in days) to time interpolate to + - improved error messaging + - add logic to skip over leap days in input data when the model calendar is no_leap + +M components/cam/src/chemistry/utils/mo_msis_ubc.F90 + - use previous day's F10.7 cm radio flux + - scale the F10.7 cm radio flux by earth-sun distance factor + +M components/cam/src/chemistry/utils/solar_irrad_data.F90 + - minor clean up + +M components/cam/src/chemistry/utils/solar_parms_data.F90 + - include F10.7 cm radio flux time interpolated to the previous day + - time interpolate the space weather indices (Kp, F10.7, Ap) + +M components/cam/src/control/cam_history.F90 +M components/cam/src/control/cam_history_support.F90 + - add f107p (previous day's F10.7 cm radio flux) to history streams + +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/input_tests_master + - removed a redundant waccmx test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except: +026 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Thu Feb 8 11:29:15 MST 2018 + - expected failure due to switch to time-interpolate "solar parms" (space weather indices) + and use of previous day's F10.7 cm radio flux in MSIS upper boundary + +cheyenne/intel/aux_cam: All PASS except: + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_164 + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_164 + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_164 + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + - namelist compare failure is due to change in solar forcing input file + - the baseline failures are due to the all the corrections to the solar forcings listed above + - the memory usage failures are assumed to be not accurate (the same memory failures were observed with the unmodified trunk code) + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS except: +048 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Wed Feb 7 17:01:27 MST 2018 +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Feb 7 17:21:31 MST 2018 + - expected failures due to switch to time-interpolate "solar parms" (space weather indices) + and use of previous day's F10.7 cm radio flux in MSIS upper boundary + +hobart/pgi: All PASS except: +014 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Thu Feb 8 10:26:59 MST 2018 + - expected failure due to switch to time-interpolate "solar parms" (space weather indices) + and use of previous day's F10.7 cm radio flux in MSIS upper boundary + +Summarize any changes to answers: larger than roundoff but same climate for WACCM, CAM is bit-for-bit unchanged + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/solar_cam5_4_155_tags/solar02_cam5_4_155 +- platform/compilers: + cheyenne intel +- configure commandline: + --compset FWHIST --res f09_f09_mg17 + SRCROOT: /glade/p/work/fvitt/cesm/cesm2_0_alpha08f_cime5.4.0-alpha.18_solar02_cam5_4_155 + CASEROOT: /glade/p/work/fvitt/cesm/cases/f.e20.FWHIST.f09_f09_mg17.262a_solar01 + create_clone --clone /glade/p/work/mmills/case/f.e20.FWHIST.f09_f09_mg17.262a \ + --case /glade/p/work/fvitt/cesm/cases/f.e20.FWHIST.f09_f09_mg17.262a_solar01 \ + --cime-output-root /glade/scratch/fvitt + (create_newcase --compset FWHIST --res f09_f09_mg17 --case /glade/p/work/mmills/case/f.e20.FWHIST.f09_f09_mg17.262a) + +URL for AMWG diagnostics output used to validate new climate: + https://acomstaff.acom.ucar.edu/mmills/diagnostics/WACCM6/FWHIST/262EPP2000-3003/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_164 +Originator(s): eaton +Date: Wed Feb 7 09:47:35 MST 2018 +One-line Summary: update driver namelist to match CESM settings + +Purpose of changes: + +. Update the namelist settings for coldair_outbreak_mod and + flux_max_iteration to match setting made by CESM scripts. + +. allow NAG build to use threads + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. added variables coldair_outbreak_mod and flux_max_iteration for driver + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/Makefile.in +. threaded NAG build needs THREADED_PTHREADS defined rather than THREADED_OMP + +components/cam/bld/build-namelist +. add defaults for coldair_outbreak_mod and flux_max_iteration + +components/cam/bld/configure +. allow NAG to build with threads + +components/cam/bld/namelist_files/namelist_definition.xml +. add variables coldair_outbreak_mod and flux_max_iteration to group + seq_infodata_inparm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except +010 bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s .................................................FAIL! rc= 7 at Fri Feb 2 11:46:18 MST 2018 +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Fri Feb 2 12:00:07 MST 2018 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Fri Feb 2 12:02:09 MST 2018 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Fri Feb 2 12:20:40 MST 2018 +020 bl380 TBL.sh f1.9c6aqcdm outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Fri Feb 2 12:33:13 MST 2018 +023 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Fri Feb 2 13:11:03 MST 2018 +026 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Fri Feb 2 13:46:28 MST 2018 +029 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Fri Feb 2 13:53:37 MST 2018 + +cheyenne/intel/aux_cam: All PASS + +cheyenne/intel/test_cam: All PASS + +hobart/nag: All PASS except +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Fri Feb 2 10:32:50 MST 2018 +010 bl113 TBL.sh e8c4aqdm outfrq3s+aquaplanet_cam4 9s .........................................FAIL! rc= 7 at Fri Feb 2 10:35:19 MST 2018 +013 bl221 TBL.sh f10spsaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 2 10:44:22 MST 2018 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Fri Feb 2 10:49:45 MST 2018 +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Fri Feb 2 10:59:48 MST 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Fri Feb 2 11:12:06 MST 2018 +030 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Fri Feb 2 11:16:19 MST 2018 +036 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Fri Feb 2 11:20:20 MST 2018 +039 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Fri Feb 2 11:25:56 MST 2018 +042 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Fri Feb 2 11:29:37 MST 2018 +045 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Fri Feb 2 11:33:36 MST 2018 +048 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Fri Feb 2 11:40:51 MST 2018 +051 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Fri Feb 2 11:50:24 MST 2018 +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Feb 2 12:00:30 MST 2018 +067 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Fri Feb 2 12:19:50 MST 2018 +073 bl720 TBL.sh h16c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Fri Feb 2 12:33:00 MST 2018 +076 bl721 TBL.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 9s ......................................FAIL! rc= 7 at Fri Feb 2 12:41:21 MST 2018 + +hobart/pgi: All PASS except +004 bl112 TBL.sh e8c3aqdm outfrq3s+aquaplanet_cam3 9s .........................................FAIL! rc= 7 at Fri Feb 2 10:35:07 MST 2018 +008 bl114 TBL.sh e8c4aqdm co2rmp 9s ...........................................................FAIL! rc= 7 at Fri Feb 2 10:42:19 MST 2018 +011 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 2 11:24:08 MST 2018 +014 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Fri Feb 2 11:33:33 MST 2018 +017 bl320 TBL.sh f10c5aqpbadm rad_diag 9s .....................................................FAIL! rc= 7 at Fri Feb 2 11:41:48 MST 2018 +020 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 2 11:52:38 MST 2018 +034 bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s ......................................FAIL! rc= 7 at Fri Feb 2 12:41:33 MST 2018 + +All aquaplanet baselines fail due to changes in driver settings which +impact flux calculations. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: CAM is BFB. The driver has answer + changes that affect any configuration which passes fluxes to the atm. + +=============================================================== +=============================================================== + +Tag name: cam5_4_163 +Originator(s): eaton +Date: Wed Jan 31 09:55:58 MST 2018 +One-line Summary: updates to cam regression test scripts; revert ptimelevels implementation + +Purpose of changes: + +. cleanup of scripts used for CAM regression testing. + +. return ptimelevels to dyn_grid and fix the circular dependency problem by + removing a redundant grid check. + +. update testlist_cam.xml to accomodate cime changes + +. some cosp updates to get that code closer to the current git trunk version. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/test/system/CAM_decomp.sh +. the setting of npr_yz for the FV 2D decomp is moved to CAM's + build-namelist utility. This script is not needed. + +List all subroutines added and what they do: + +components/cam/test/system/CAM_utils.sh +. add function get_run_mode to tell driver scripts whether the test is + configured to be serial, openmp, mpi, or hybrid. This is code that was + previously duplicated in several scripts. + +components/cam/test/system/nl_files/outfrq3s_cosp +. standard outfrq3s template plus fexcl of CFAD_DBZE94_CS CLDTOT_CALCS + CLD_CAL_NOTCS + +List all existing files that have been modified, and describe the changes: + +components/cam/cime_config/testdefs/testlist_cam.xml +. remove yellowstone entries and update the testlist_cam.xml schema by + moving options elements that were nested inside machines elements to be + outside. + +components/cam/src/dynamics/eul/dyn_comp.F90 +. access ptimelevels from dyn_grid + +components/cam/src/dynamics/eul/dyn_grid.F90 +components/cam/src/dynamics/fv/dyn_grid.F90 +. add parameter ptimelevels + +components/cam/src/dynamics/se/dyn_grid.F90 +. add parameter ptimelevels +. remove redundant check for ncol or ncol_d dimension in IC file. The + check is also done in dyn_comp::check_file_layout. + +components/cam/src/dynamics/eul/pmgrid.F90 +components/cam/src/dynamics/fv/pmgrid.F90 +components/cam/src/dynamics/se/pmgrid.F90 +. remove parameter ptimelevels + +components/cam/src/physics/cam/physics_buffer.F90.in +. access ptimelevels from dyn_grid, not pmgrid + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. change associated queries to allocated for the structure components that + were changed from pointers to allocatables. + +components/cam/src/physics/cam/polar_avg.F90 +. initialize n_pole, s_pole work arrays + +components/cam/src/physics/cosp2/src/cosp.F90 +components/cam/src/physics/cosp2/src/cosp_config.F90 +. pull in changes from the github trunk + +components/cam/test/system/CAM_runcmnd.sh +. refactor to share common functionality needed for all machines. +. remove yellowstone + +components/cam/test/system/input_tests_master +. change COSP tests to remove comparison of simulator fields that are not + independent of domain decomposition (CFAD_DBZE94_CS CLDTOT_CALCS + CLD_CAL_NOTCS) + - in *317 change outfrq3s_diags to outfrq3s_cosp + - in *380 change outfrq3s to outfrq3s_cosp + +components/cam/test/system/TBR.sh +components/cam/test/system/TER.sh +components/cam/test/system/TSM.sh +. cleanup and refactor how task and thread counts are set +. add arg to build-namelist for setting FV decomp when needed + +components/cam/test/system/nl_files/sat_hist +. add fexcl of CFAD_DBZE94_CS CLDTOT_CALCS CLD_CAL_NOTCS + +components/cam/test/system/test_driver.sh +. remove broken code for automatic setting of valid account on cheyenne. + Fail with error message if user doesn't supply environment variable + CAM_ACCOUNT. +. Change the 'cb' script on cheyenne to use a dedicated compute node. This + allows increasing max build threads from 18 to 36. +. Change the cime test script on cheyenne to use a dedicated compute node. +. Remove min_cpus_per_task functionality (this appears to have been a + cludge to deal with hyperthreading). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except +020 bl380 TBL.sh f1.9c6aqcdm outfrq3s_cosp 9s .................................................FAIL! rc= 7 at Tue Jan 30 19:47:53 MST 2018 +034 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Tue Jan 30 21:10:56 MST 2018 +036 eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s ...................FAIL! rc= 7 at Tue Jan 30 21:13:46 MST 2018 + +bl380 is new, so no baseline for comparison +TEQ failures are pre-existing. + +cheyenne/intel/aux_cam: All pass except. + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + +There were no memory changes in this commit. I suspect this is a broken test. + +cheyenne/intel/test_cam: PASS + +hobart/nag: All PASS except +024 bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s ..................................................FAIL! rc= 7 at Tue Jan 30 11:25:42 MST 2018 + +This is a new test; no baseline for comparison. + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_162 +Originator(s): goldy +Date: 2018-01-23 +One-line Summary: Fixes to CAM-SE including vertical info in history output + +Purpose of changes: Fix history output of vertical profile, fix some + mpi-serial issues. + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: + - Fixed Cheyenne module loads to be independent of user's environment + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: + - bndry_exchange_put1: unused + - bndry_exchange_put2: unused + - bndry_exchange_get1: unused + - bndry_exchange_get2: unused + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/config_files/horiz_grid.xml + - Added low-resolution refined CAM-SE grid (ne0np4TESTONLY.ne5x4) +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Added new initial data defults containing only vertical coordinates + - Changed refined_mesh to se_refined_mesh + - Added se_refined_mesh=.true. for ne0np4TESTONLY.ne5x4 +M components/cam/cime_config/config_component.xml + - Took out CAM%CSLAMTEST entry +M components/cam/cime_config/config_compsets.xml + - Removed FCSLAMTEST compset (not needed, should use a nexx.pg3 grid) + - Removed EPS_AGRID override (aquaplanet code fixed in docn) +M components/cam/cime_config/testdefs/testlist_cam.xml + - Added new tests (only low-res refined mesh test is currently part of + regression testing) +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined + - Testmods for low-res refined mesh test (shell_commands, user_nl_cam, + user_nl_clm) +M components/cam/src/control/cam_history_support.F90 + - Added option to have history coordinate not be a coordinate variable + (i.e., optional dimension name for variable) +M components/cam/src/control/ncdio_atm.F90 + - Removed unused imports +M components/cam/src/control/runtime_opts.F90 + - Moved import of analytic_ic_readnl (circular dependency issue) +M components/cam/src/dynamics/eul/dyn_comp.F90 + - Import ptimelevels from pmgrid (was dyn_grid) +M components/cam/src/dynamics/eul/dyn_grid.F90 + - Removed ptimelevels (moved to pmgrid) +M components/cam/src/dynamics/eul/pmgrid.F90 + - Moved ptimelevels parameter here (to avoid dependency loop in SE) +M components/cam/src/dynamics/eul/scanslt.F90 + - Remove unused imports of ptimelevels +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Moved ptimelevels definition to pmgrid + - Forward the definition of ptimelevels from pmgrid +M components/cam/src/dynamics/fv/pmgrid.F90 + - Moved ptimelevels parameter here (to avoid dependency loop in SE) +D components/cam/src/dynamics/se/README + - Was 100% obsolete (maybe more) +M components/cam/src/dynamics/se/dycore/bndry_mod.F90 + - Removed unused imports and subroutines +M components/cam/src/dynamics/se/dycore/edge_mod.F90 + - Removed unused logic +M components/cam/src/dynamics/se/dycore/parallel_mod.F90 + - Removed unused parameters +M components/cam/src/dynamics/se/dyn_comp.F90 + - Added error checks (and messages) in dyn_readnl +M components/cam/src/dynamics/se/dyn_grid.F90 + - Removed ptimelevels (moved to pmgrid) + - Do not check for 'ncol' dimension when using analytic initial + conditions (could be using new vertical-only initial data file) + - Changed size (Fortran keyword) to asize +M components/cam/src/dynamics/se/pmgrid.F90 + - Moved ptimelevels parameter here (to avoid dependency loop) +M components/cam/src/dynamics/tests/inic_analytic.F90 + - Moved analytic_ic_active to init_analytic_utils (avoid circular dependency) + - Moved analytic_ic_readnl to init_analytic_utils (avoid circular + dependency) +A + components/cam/src/dynamics/tests/inic_analytic_utils.F90 + - Moved analytic_ic_active to new module (circular dependency issue) + - Moved analytic_ic_readnl to new module (circular dependency issue) +M +components/cam/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 + - Removed ic_baroclinic_init (not needed anymore) +M components/cam/src/physics/cam/aoa_tracers.F90 + - Removed unused imports + - Replaced unknown characters with ASCII +M components/cam/src/physics/cam/physics_buffer.F90.in + - Import ptimelevels from pmgrid (was dyn_grid) +M components/cam/src/utils/cam_grid_support.F90 + - Make sure iodesc is NULL +M components/cam/src/utils/hycoef.F90 + - Do not write hyam, hybm, hyai, and hybi as coordinate variables when + using a dry mass vertical coordinate. +M components/cam/test/system/CAM_runcmnd.sh + - Remove Yellowstone option +M components/cam/test/system/archive_baseline.sh + - Remove Yellowstone +D components/cam/test/system/config_files/h030x8ad + - Test removed (too expensive) +M components/cam/test/system/input_tests_master + - Removed 760 tests (too expensive) +D components/cam/test/system/nl_files/outfrq3s_conus + - Test removed (too expensive) +M components/cam/test/system/test_driver.sh + - Added test_cam as a default test category in test_driver.sh (to allow + for tests which do not cause the compset / resolution combination to + become 'supported'. + - Removed Yellowstone +M components/cam/test/system/tests_pretag_cheyenne + - Removed 760 tests (too expensive) +D components/cam/test/system/tests_pretag_yellowstone + - Removed Yellowstone +M components/cam/test/unit/README.txt + - Removed Yellowstone + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: +034 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Sun Jan 21 02:43:12 MST 2018 +036 eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s ...................FAIL! rc= 7 at Sun Jan 21 02:46:04 MST 2018 + +cheyenne/intel/aux_cam: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + - Expected fail due to change in EPS_AGRID (see config_compsets.xml) + +cheyenne/intel/test_cam: Namelist / baseline failure due to test being new + FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined BASELINE cam5_4_161: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/cesm_baselines/cam5_4_161/ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined' does not exist + +hobart/nag: ALL PASS + +hobart/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== + +=============================================================== + +Tag name: cam5_4_161 +Originator(s): andrew, cacraig +Date: Jan 19, 2018 +One-line Summary: Fix for surface water flux in CLUBB + +Purpose of changes: + - CLUBB was using approximate water flux from the latent heat flux and not the + actual water flux. The actual water flux is now being used. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - revert CICE back to last tag CAM was using (due to bug in current CICE tag) until bug is fixed + +M components/cam/src/physics/cam/clubb_intr.F90 + - changed references from cam_in%lhf to cam_in%cflx(,1) + +M components/cam/src/physics/cam/physpkg.F90 + - changed references from cam_in%lhf to cam_in%cflx(,1) in clubb call + +M components/cam/src/physics/cam/vertical_diffusion.F90 + - changed references from cam_in%lhf to cam_in%cflx(,1) in energy check call to clubb + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Fri Jan 19 17:03:34 MST 2018 +020 bl380 TBL.sh f1.9c6aqcdm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Jan 19 17:03:50 MST 2018 + - All CAM6 jobs expect answer changes + +037 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Fri Jan 19 17:04:23 MST 2018 +039 eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s ...................FAIL! rc= 7 at Fri Jan 19 17:07:15 MST 2018 + - Previously failing tests + + +yellowstone/intel/aux_cam: all baselines FAIL as expected because all runs using CLUBB will have different results + +hobart/nag: +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Fri Jan 19 14:52:29 MST 2018 +039 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Fri Jan 19 14:52:41 MST 2018 +042 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Fri Jan 19 14:54:57 MST 2018 +045 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Fri Jan 19 14:55:07 MST 2018 +054 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Jan 19 14:55:29 MST 2018 + - all CAM6 tests will have different answers due to bug fix in calls to CLUBB + + +hobart/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all runs using CLUBB +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +Cecile has been using this fix in her most recent runs. It was a bug that needed to be corrected. + +=============================================================== +=============================================================== + +Tag name: cam5_4_160 +Originator(s): cacraig +Date: Jan 18, 2018 +One-line Summary: Update externals + +Purpose of changes: + + ** IMPORTANT NOTE ** + - There is a bug in the CICE external component which causes answer changes + when the number of PEs are changed. The CICE external will be updated in a future tag. + + - Update all externals to match current latest version for all components + - This change allows FSCAM to run properly again (eliminates mismatch between cime and CLM versions) + - Fixed the CAM internal TSM_ccsm test + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update externals to match the current latest version of each component + +M components/cam/test/system/TCB_ccsm.sh +M components/cam/test/system/TER_ccsm.sh +M components/cam/test/system/TSM_ccsm.sh + - Remove obsolete RUN_WITH_SUBMIT flag + - Change runs from "case.run" to "case.submit --no-batch" + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +037 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Wed Jan 17 22:36:45 MST 2018 +039 eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s ...................FAIL! rc= 7 at Wed Jan 17 22:39:24 MST 2018 + - It is unknown what change occurred that does not allow these tests to pass. Brian agreed that this + tag could be made with these two tests failing + +yellowstone/intel/aux_cam: + - All namelist and baselines changed with this tag + - All ERP tests fail due to issue with CICE tag + +hobart/nag: all PASS + +hobart/pgi: all PASS + +=============================================================== +=============================================================== + +Tag name: cam5_4_159 +Originator(s): cacraig +Date: Jan 17, 2018 +One-line Summary: Remove user_nl_XXX settings and other misc changes + +Purpose of changes: + +** IMPORTANT NOTE** FSCAM is broken with this tag due to an incompatability between the cime and CLM versions used in this + tag. The next tag will update all externals and allow FSCAM to work again. + + - To duplicate Cecile's runs, user_nl_clm and user_nl_cpl were setup in several use_cases. These + were out-of-date and components are now setting the appropriate values. Removed these files. + - Updated cime and cime_config to fix the issue which hindered saving baselines using the bless_test_results script + - Updated ncdata and topo files for 10x15 test case + - Minor edit to interpic-new/README to indicate where coordinate files are stored in inputdata + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/cime_config/usermods_dirs/1850 +D components/cam/cime_config/usermods_dirs/1850/user_nl_clm +D components/cam/cime_config/usermods_dirs/1850/user_nl_cpl +D components/cam/cime_config/usermods_dirs/f2000 +D components/cam/cime_config/usermods_dirs/f2000/user_nl_clm +D components/cam/cime_config/usermods_dirs/fhist +D components/cam/cime_config/usermods_dirs/fhist/user_nl_clm + - remove all settings which had been setup to duplicate Cecile's run + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update cime and cime_config externals (note the is an incompatibility with the CLM version for some tests) + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - updated ncdata and topo file for 10x15 test case + +M components/cam/cime_config/config_component.xml + - removed user_nl_XXX from 1850, f2000 and fhist test cases + +M components/cam/tools/interpic_new/README + - Amended README to include location of coordinate files + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +036 sm991 TSM_ccsm.sh f19_f19_mg17 QPC4 9s ....................................................FAIL! rc= 6 at Wed Jan 17 13:54:54 MST 2018 +037 eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s ....................FAIL! rc= 4 at Wed Jan 17 13:54:54 MST 2018 +038 sm994 TSM_ccsm.sh ne16_ne16_mg17 QPC6 9s ..................................................FAIL! rc= 6 at Wed Jan 17 13:54:55 MST 2018 +039 eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s ...................FAIL! rc= 4 at Wed Jan 17 13:54:55 MST 2018 +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 6 at Wed Jan 17 13:54:56 MST 2018 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Wed Jan 17 13:54:56 MST 2018 + - cime removed an XML variable (RUN_WITH_SUBMIT) which was being set in these scripts. Will fix in the next tag + + +yellowstone/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_158 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.cheyenne_intel.cam-outfrq9s BASELINE cam5_4_158 + SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist1d BASELINE cam5_4_158 + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m BASELINE cam5_4_158 + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.cheyenne_intel.cam-outfrq1m MEMCOMP Error: Memory usage increase > 10% from baseline + - All tests had namelist changes due to changes in cime and removal of user_nl_XXX files. These changes + resulted in baseline failures for most tests. + + + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s SHAREDLIB_BUILD time=1 + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s SHAREDLIB_BUILD time=3 + - These tests failed to build due to incompatibility between cime and CLM versions (errored out in build-namelist) + +hobart/nag: all BFB + +hobart/pgi: all BFB except: +023 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Tue Jan 16 23:22:16 MST 2018 + - Update 10x15 topo yields different results (tested with old topo file and it was BFB) + + +=============================================================== +=============================================================== + +Tag name: cam5_4_158 +Originator(s): eaton, swales, pincus +Date: Tue Jan 9 14:32:44 MST 2018 +One-line Summary: replace COSP-1.4 with COSP2 + +Purpose of changes: + +. replace COSP-1.4 with COSP2. Note that COSP2 only works with the cam5 + and cam6 physics packages. It has not been implemented for cam4. + +. allow use of DOCN component to supply analytic SSTs for aquaplanet mode. + This is how the compsets work. This allowed fixing the regression test + that compares the output of a CESM run with a CAM standalone run for + aquaplanet. + +Bugs fixed (include bugzilla ID): + +. Got the aquaplanet TEQ_ccsm test fixed by using DOCN component and + specifying the focndomain files with the mg17 mask. + +Describe any changes made to build system: + +. update cosp build for cosp2. The cosp code is still built as a separate + library. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. focndomain datasets updated to mg17 versions where available. + +Describe any substantial timing or memory changes: not sure about cosp. + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/physics/cosp/* +components/cam/src/physics/icarus-scops/* +. old COSP-1.4 code + +components/cam/test/system/config_files/f10c4aqcdm +. unused config + +components/cam/test/system/nl_files/atrain +. unused namelist + +List all subroutines added and what they do: + +components/cam/test/system/config_files/f10c6aqcdm +components/cam/test/system/config_files/f1.9c6aqcdm +components/cam/test/system/config_files/h16c6aqh +. new test configurations + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES +. remove cosp and icarus-scops as externals + +components/cam/bld/configure +. check that cosp is only enabled with cam5 or cam6 physics +. modify filepaths for cosp2 + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. update focndomain files to use new land masks when available. This + allows using the DOCN component to supply the analytic SSTs for + aquaplanet mode which is how the compsets work. + +components/cam/bld/namelist_files/namelist_definition.xml +. change occurances of '>' to '>' + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. implement new interfaces for COSP2 + +components/cam/src/physics/camrt/radiation.F90 +. remove calls to COSP -- not supported in cam4 physics package + +components/cam/test/system/input_tests_master +. change *318 from f10c4aqcdm to f10c6aqcdm +. remove *321 +. change *380 from f1.9c6aqcdh to f1.9c6aqcdm +. change *380 from atrain to outfrq3s +. change *991 from f19_f19 to f19_f19_mg17 +. add sm994: ne16_ne16_mg17 QPC6 +. add eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s + +components/cam/test/system/nl_files/sat_hist +. remove 'TKE' from fincls. + +components/cam/test/system/tests_pretag_cheyenne +. replace *993 by *994 + +components/cam/test/system/tests_pretag_hobart_nag +. add *317 + +components/cam/test/system/tests_pretag_hobart_pgi +. remove *317 and *321 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: All PASS except +020 bl380 TBL.sh f1.9c6aqcdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Jan 9 12:19:01 MST 2018 + +new test, no baseline available + +cheyenne/intel/aux_cam: All PASS + +hobart/nag: All PASS except +024 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s .................................................FAIL! rc= 7 at Wed Jan 3 15:18:44 MST 2018 +027 bl318 TBL.sh f10c6aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Wed Jan 3 15:18:45 MST 2018 + +new tests, no baselines available + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except COSP diagnostics. + +=============================================================== +=============================================================== + +Tag name: cam5_4_157 +Originator(s): cacraig +Date: Dec 20, 2017 +One-line Summary: Begin the cleanup of namelist_definition.xml file + +Purpose of changes: + - The descriptions in the namelist_definition.xml file are used to document the + namelist variables on the web pages. It is easy for these descriptions to fall + out of sync with the actual implementations. The first 4276 lines of this file + have been investigated and updated as appropriate. The rest of the file will be + fixed at a later date. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist + - add papi_inparm to list of namelists for driver namelist generator + +M components/cam/bld/namelist_files/namelist_definition.xml + - Updated namelist settings through line 4276 + - removed all CLM namelist variables which were in CAM's list + - removed the RTM namelist variable from CAM's list + +M components/cam/src/control/scamMod.F90 + - remove obsolete variable scm_diurnal_avg + +M components/cam/src/dynamics/fv/metdata.F90 + - update documentation + +M components/cam/test/system/TBR.sh + - removed CLM nrevsn variable from the test as it is no longer in CAM's namelist + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Wed Dec 20 08:04:12 MST 2017 + - preexisting failure + +yellowstone/intel/aux_cam: all BFB +(Note for 13 month test: It ran out of time right after it successfully completed, but + before the baselines were compared. I hand compared the cam h0 02-01 file with the + baseline and it was BFB.) + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_156 +Originator(s): eaton +Date: Fri Dec 15 10:03:44 MST 2017 +One-line Summary: Allow below surface extrapolation in T, Z pressure level + diagnostics; update cime externals. + +Purpose of changes: + +. update cime and cime-config externals to versions in cesm2_0_alpha08e + +. Change diagnostic pressure level output for temperature and geopotential + height to use ECMWF algorithm for extrapolating below the surface rather + than setting the below surface locations to the value at the surface as + is presently done. + +. Allow aquaplanet mode to use the docn component for setting prescribed + SST values. The default is still to use the special 'aquaplanet' + component which doesn't require the domain files that are needed for + running with docn. + +Bugs fixed (include bugzilla ID): + +. Fix bug in TEQ_ccsm.sh script to allow the auxiliary history files to be + compared. The existing code was only correct for comparing h0 files. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/cpl/atm_comp_esmf.F90 +components/cam/test/system/config_files/h16c5aqh +. not used + +List all subroutines added and what they do: + +components/cam/test/system/config_files/h16kstich +. new test config + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. cime5.4.0-alpha.05 -> cime5.4.0-alpha.14 + cime_config0.1.0.alpha.02 -> cime_config0.1.0.alpha.06 + +components/cam/bld/build-namelist +. Add capability to have DOCN provide the analytic SSTs use by aquaplanet + mode. The default is still to use a separate 'aquaplanet' ocean + component. Maintain the use of the variable aqua_planet_sst to set the + identifier of the analytic function to use. + +components/cam/bld/configure +. Fix Filepath for DOCN +. Fix Filepath for building share code (cime change) + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. update focndomain entries + +components/cam/src/physics/cam/cam_diagnostics.F90 +. Change output for the fields Z1000, Z700, Z500, T850, T500, T400 to extrapolate below + surface locations using ECMWF algorithms. Previously the surface value + was used at below surface locations. +. Change output for the fields Z1000, Z700, Z500, Z300, Z200, Z100, Z050 to + interpolate linearly in log pressure rather than linear in pressure. + +components/cam/src/utils/interpolate_data.F90 +. vertinterp + - allow extrapolation of T or Z below surface using ECMWF algorithm + - allow linear interpolation in log(pressure) coordinate. + +components/cam/test/system/config_files/f1.9c4aqh +. modify to use docn for ocean component + +components/cam/test/system/input_tests_master +. remove unused test eq992 +. modify eq993 to test SE w/ KESSLER/terminator/analytic_ic + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Dec 15 09:13:30 MST 2017 + +pre-existing failure + +yellowstone/intel/aux_cam: All PASS except NLCOMP checks fail due to update +in cime tag. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam5_4_155 +Originator(s): fvitt +Date: 11 Dec 2017 +One-line Summary: Fix chemistry preprocessor bug and other misc updates + +Purpose of changes: + +- update chemistry preprocessor external + . fix indexing bug in cls_rxt_map -- in larger chemical mechanisms, 99th species in + the implicit solver list may have incorrect production and loss terms due to a bug + in the species-reactions index mapping + . expose the number of reactants so that the reaction rate constants diagnostics + can be set to have correct units + . limit the number of continued fortran lines that set reaction tag names in + mo_sim_dat.F90 by breaking up the string array + . increase the max number of reactions and other limits +- enable scaling of CFC11star radiative active constituent by CFC11eq in LBC file + (default off for now) +- include HOX diagnostic +- correct units in reaction rate constant diagnostics +- some corrections to namelist docs +- use file name 'NONE' to turn off inputs +- add species sums diagnostics capability +- add trap on CO2 concentrations passed to Formichev scheme to prevent the use of CO2 + greater than 720 ppmv + +Bugs fixed (include bugzilla ID): +- chemistry preprocessor bug (bugzilla ID 2535) + . fix indexing bug in cls_rxt_map -- in larger chemical mechanisms, 99th species in + the implicit solver list may have incorrect production and loss terms due to a bug + in the species-reactions index mapping +- correct units in reaction rate constant diagnostics +- fix external forcing history field name truncation error for long species names + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A + components/cam/src/chemistry/mozart/species_sums_diags.F90 + - manages the species sumations diagnostics + +A + components/cam/src/chemistry/mozart/sums_utils.F90 + - common code for species_sums_diags and rate_diags + +A + components/cam/test/system/config_files/f10c6aqtsvbsdm + - add low res cam-chem test which can be run on hobart with NAG compiler + +A components/cam/test/system/nl_files/outfrq3s_sum + - for summations diagnostics test (cam test 375) + +List all existing files that have been modified, and describe the changes: + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - update chem preprocessor + . expose the number of reactants so that the reaction rate constants diagnostics + can be set to have correct units + . limit the number of continued fortran lines that set reaction tag names in + mo_sim_dat.F90 by breaking up the string array + . increase the max number of reactions and other limits + . fix indexing bug in cls_rxt_map -- in larger chemical mechanisms, 99th species in + the implicit solver list may have incorrect production and loss terms due to a bug + in the species-reactions index mapping + +M components/cam/bld/build-namelist + - user can set update files to "NONE" to disable the input + +M components/cam/bld/configure + - allow the use of the chemistry preprocessor when chem is 'none' + +M components/cam/bld/namelist_files/namelist_definition.xml + - corrections to descriptions of namelist variables + - new namelist variable definitions: + - vmr_sums + - mmr_sums + - nlte_limit_co2 + +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml + - add HOX diagnostic to fincl1 list + - update IC file + - correct topo file + +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml + - update IC file + - update solar inputs + - remove bnd_topo -- use cam default + - include HOX, CO2, H20, N2O, CH4, N2O5, NO2, NO in fincl1 + +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml + - include HOX, CO2, H20, N2O, CH4, N2O5, NO2, NO in fincl1 + - don't set bnd_topo -- use cam default + - update volcanic vertical emissions in transient cases + +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - rxn_rate_sums continued line indicator changed from trailing "&" to trailing "+" + +M components/cam/cime_config/config_compsets.xml + - cannot use CISM glacier model in specified compsets where calendar is 'GREGORIAN' + -- will not have a version of CISM that can handle gregorian calendar anytime soon + - no need to override SST file setting in waccmx compset + +M components/cam/cime_config/config_pes.xml + - use 3 threads rather than 4 on cheyenne in waccm and cam-chem compsets + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - remove the "GS_" history defaults + +M components/cam/src/chemistry/mozart/cfc11star.F90 + - enable scaling of CFC11star according to CFC11eq specified in LBC file + +M components/cam/src/chemistry/mozart/chemistry.F90 + - euvac_file defaults to 'NONE' + - invoke species_sums_readnl + +M components/cam/src/chemistry/mozart/epp_ionization.F90 +M components/cam/src/chemistry/mozart/euvac.F90 +M components/cam/src/chemistry/mozart/gcr_ionization.F90 +M components/cam/src/chemistry/mozart/linoz_data.F90 +M components/cam/src/chemistry/mozart/mo_sulf.F90 +M components/cam/src/chemistry/mozart/noy_ubc.F90 + - input files default to 'NONE' + +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 + - include HOX diagnostic + - added default output of num_a2, num_a3, dst_a3, and ncl_a3 to fincl8 when + history_cesm_forcing is true. + - invoke species_sums_output + +M components/cam/src/chemistry/mozart/mo_extfrc.F90 + - fix history field name truncation error for long species names + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - correct the units in diagnostics of reaction rate constants according to the + number of reactants in the reactions (from chem preprocessor) + +M components/cam/src/chemistry/mozart/rate_diags.F90 + - share common code with species_sums + +M components/cam/src/chemistry/utils/aerodep_flx.F90 +M components/cam/src/chemistry/utils/prescribed_aero.F90 +M components/cam/src/chemistry/utils/prescribed_ghg.F90 +M components/cam/src/chemistry/utils/prescribed_ozone.F90 +M components/cam/src/chemistry/utils/prescribed_strataero.F90 +M components/cam/src/chemistry/utils/prescribed_volcaero.F90 +M components/cam/src/physics/cam/chem_surfvals.F90 + - input files default to 'NONE' + +M components/cam/src/chemistry/utils/mo_flbc.F90 + - enable the ability to include 'CFC11eq' in the list of LBC species + if it is not a member of the chemical mechanism + + +M components/cam/src/physics/waccm/nlte_fomichev.F90 +M components/cam/src/physics/waccm/nlte_lw.F90 +M components/cam/src/physics/waccm/radheat.F90 + - add nlte_limit_co2 option -- if true apply a limit to CO2 in formichev scheme + +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_terminator/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_terminator/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_none/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 + - updates to chemistry packages resulting from preprocessor updates + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Sun Dec 10 15:48:55 MST 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16_mg17 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Sun Dec 10 15:50:44 MST 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: All B4B + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + - these namelist compare tests failed due to change in rxn_rate_sums + +hobart/nag: All PASS + +hobart/pgi: All PASS + +=============================================================== +=============================================================== + +Tag name: cam5_4_154 +Originator(s): eaton +Date: Fri Dec 8 11:47:12 MST 2017 +One-line Summary: Add checks for CLUBB timestep; fix for SE running WACCM compsets. + +Purpose of changes: + +. Modify default values of cld_macmic_num_steps for some dtime values to + allow CLUBB to always substep with a 300 second timestep. Add a check to + the clubb run subroutine to exit with a verbose message if the computed + substep size is less than the timestep set by the namelist variable + clubb_timestep. This leaves open the ability of a user to run CLUBB + using less than the default 300 second timestep, but this must be done by + explicitly setting the value of clubb_timestep and possibly + cld_macmic_num_steps. We have removed the 'feature' of clubb silently + running with a smaller than 300 second timestep. + +. Fix several waccm use case files so that zonal average output fields are + only included for FV dycore. + +. Remove the deprecated '-res' option from configure. Change the default + compilers on linux systems from pgi to gnu. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/test/system/config_files/s32adh +components/cam/test/system/config_files/s32idh +components/cam/test/system/config_files/s48adh +components/cam/test/system/config_files/s48idh +components/cam/test/system/config_files/s64adh +components/cam/test/system/config_files/s64idh +components/cam/test/system/config_files/s8c5aqt5mdm +. remove old SLD files + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +. add value of 'dtime' as an attribute for determining appropriate default + value of cld_macmic_num_steps. + +components/cam/bld/configure +. Remove the deprecated '-res' option. +. Change the default compilers on linux systems from pgi to gnu. + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. add entries for cld_macmic_num_steps which depend on the attribute 'dtime' +. remove entries using the attribute dyn="sld", and some old sld specific + variables. + +components/cam/bld/namelist_files/namelist_definition.xml +. fix documentation for use_topo_file + +components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +. add the attribute dyn="fv" to the fincl7 elements containing zonally + averaged fields. + +components/cam/cime_config/buildcpp +. change -res to -hgrid + +components/cam/src/physics/cam/clubb_intr.F90 +. call endrun if the computed timestep is less than the namelist specified + value of clubb_timestep + +components/cam/src/physics/cam/physpkg.F90 +. fix a comment + +components/cam/test/system/config_files/e48adh +components/cam/test/system/config_files/e48c4paqdm +components/cam/test/system/config_files/e48idh +components/cam/test/system/config_files/e64addh +components/cam/test/system/config_files/e64adh +components/cam/test/system/config_files/e64c4aqiopdm +components/cam/test/system/config_files/e64c5aqiopdm +components/cam/test/system/config_files/e64hsdh +components/cam/test/system/config_files/e8c3aqdm +components/cam/test/system/config_files/e8c4aqdm +components/cam/test/system/config_files/e8c5aqt5mdm +components/cam/test/system/config_files/e8idm +components/cam/test/system/config_files/f1.9c4aqbamm +components/cam/test/system/config_files/f1.9c4cdm +components/cam/test/system/config_files/f1.9c4h +components/cam/test/system/config_files/f1.9c4portdh +components/cam/test/system/config_files/f1.9c4portdm +components/cam/test/system/config_files/f1.9c4wmdh +components/cam/test/system/config_files/f1.9c4wmh +components/cam/test/system/config_files/f1.9c4wmm +components/cam/test/system/config_files/f1.9c4wscdm +components/cam/test/system/config_files/f1.9c4wtsmltdh +components/cam/test/system/config_files/f1.9c4wtsmlth +components/cam/test/system/config_files/f1.9c5aqm +components/cam/test/system/config_files/f1.9c5carmdusdm +components/cam/test/system/config_files/f1.9c5carmdusm +components/cam/test/system/config_files/f1.9c6aqtsvbsdh +components/cam/test/system/config_files/f1.9c6aqwmth +components/cam/test/system/config_files/f1.9c6aqwscdh +components/cam/test/system/config_files/f10adhterm +components/cam/test/system/config_files/f10c3aqdm +components/cam/test/system/config_files/f10c4aqcdm +components/cam/test/system/config_files/f10c4aqwmxdm +components/cam/test/system/config_files/f10c4aqwscdm +components/cam/test/system/config_files/f10c5aqcdm +components/cam/test/system/config_files/f10c5aqcmtt1dm +components/cam/test/system/config_files/f10c5aqdm +components/cam/test/system/config_files/f10c5aqpbadm +components/cam/test/system/config_files/f10c5aqscdm +components/cam/test/system/config_files/f10c5aqt5mdm +components/cam/test/system/config_files/f10c5aqudm +components/cam/test/system/config_files/f10c6aqdm +components/cam/test/system/config_files/f10c6aqt5mdm +components/cam/test/system/config_files/f10c6aqwmadm +components/cam/test/system/config_files/f10idm +components/cam/test/system/config_files/f10spmaqdm +components/cam/test/system/config_files/f10spsaqdm +components/cam/test/system/config_files/f4adh +components/cam/test/system/config_files/f4c4aqdh +components/cam/test/system/config_files/f4c4aqprgspcdm +components/cam/test/system/config_files/f4c4aqwmxdm +components/cam/test/system/config_files/f4c4aqwmxidm +components/cam/test/system/config_files/f4c4aqwmxiedm +components/cam/test/system/config_files/f4c4paqdh +components/cam/test/system/config_files/f4c4wtsmltdh +components/cam/test/system/config_files/f4c5dh +components/cam/test/system/config_files/f4c5portdh +components/cam/test/system/config_files/f4c5portdm +components/cam/test/system/config_files/f4c6aqwmadm +components/cam/test/system/config_files/f4c6aqwmtdm +components/cam/test/system/config_files/f4idm +components/cam/test/system/config_files/fsd1.9c4mozdh +components/cam/test/system/config_files/fsd1.9c4wmdh +components/cam/test/system/config_files/fsd1.9c4wmh +components/cam/test/system/config_files/fsd1.9c4wtsmltdh +components/cam/test/system/config_files/fsd1.9c4wtsmlth +components/cam/test/system/config_files/h16adh +components/cam/test/system/config_files/h16adtermdh +components/cam/test/system/config_files/h16idm +components/cam/test/system/config_files/scmc4aqds +components/cam/test/system/config_files/scmc5aqds +. change -res to -hgrid + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Dec 8 11:30:14 MST 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16_mg17 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Fri Dec 8 11:32:04 MST 2017 + +. these are pre-existing failures + +yellowstone/intel/aux_cam: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None. + +=============================================================== +=============================================================== + +Tag name: cam5_4_153 +Originator(s): cacraig +Date: 30 November 2017 +One-line Summary: Remove CAM6 settings from use_cases and make them defaults + +Purpose of changes: + - Over time, a number of settings were being made in all CAM6 use_cases. These are now being set + automatically by build-namelist for cam6. Removed these settings from the CAM use_cases (did not + modify any WACCM use_cases) + - For CAM6, set the following as defaults: + - do_tms=false + - do_beljaars=true + - zm_conv_num_cin=1 + - use_gw_oro=false + - use_gw_rdg_beta=true (as long as a topo file is provided, otherwise it is false) + + - Removed a good number of obsolete use_cases which are no longer being tested + +Bugs fixed (include bugzilla ID): + - UTGW_TOTAL addfld call needs to always be done - moved out of if block in gw_drag.F90 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - The above five listed namelist settings are now the default for CAM6 instead of being set in every CAM6 use_case file + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +D components/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml +D components/cam/bld/namelist_files/use_cases/1850_cam4_2xco2.xml +D components/cam/bld/namelist_files/use_cases/1850_cam5.xml +D components/cam/bld/namelist_files/use_cases/1850_cam55.xml +D components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam6.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45_bgc.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85_bgc.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +D components/cam/bld/namelist_files/use_cases/2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp26.xml +D components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp45.xml +D components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp60.xml +D components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp85.xml +D components/cam/bld/namelist_files/use_cases/cam3.xml + - eliminate use_cases which are no longer being tested + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Set use_gw_oro=false for CAM6, and use_gw_rdg_beta=true if a topo file is supplied + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - Removed settings for do_tms, do_beljaars, use_gw_oro, use_gw_rdg_beta and zmconv_num_cin + +M components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml + - Removed extraneous comma from end of fincl5 list + +M components/cam/src/physics/cam/beljaars_drag.F90 + - Add 1:ncol for the array arithmetic to prevent NAG from complaining about NaN's + +M components/cam/src/physics/cam/gw_drag.F90 + - UTGW_TOTAL addfld call needs to always be done - moved out of if block + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Thu Nov 30 13:33:46 MST 2017 +020 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Thu Nov 30 13:34:04 MST 2017 + - CAM6 regression tests were not using the CAM6 defaults. Using them causes answer changes + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Thu Nov 30 14:17:28 MST 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16_mg17 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Thu Nov 30 14:19:17 MST 2017 + - continued preexisting failures + +yellowstone/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_152 + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_152 + - Aquaplanet CAM6 runs were not using CAM6 defaults. Brian Mederios and Jim Benedict said they should use these + CAM6 defaults. + + - All other jobs were using the new CAM6 defaults in use_cases. Answers for these runs were not expected to change + with the removal of the settings from the use_cases (and they did not) + +hobart/nag: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Wed Nov 29 15:03:56 MST 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Wed Nov 29 15:07:40 MST 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Wed Nov 29 15:11:27 MST 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Nov 29 15:38:47 MST 2017 + - CAM6 regression tests were not using the CAM6 defaults. Using them causes answer changes + + +hobart/pgi: all PASS (no CAM6 tests) + +Additional testing: + Due to the extensive changes with use_cases and the interdependecies of namelist defaults, additional testing of + namelists was conducted. + - Created all prealpha and prebeta namelists and compared them with namelists generated with cam5_4_152. + The only failures: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s NLCOMP + - Changed Aquaplanet CAM6 runs to use all the CAM6 default settings + - All other tests have identical namelists as expected + +=============================================================== +=============================================================== + +Tag name: cam5_4_152 +Originator(s): pel, goldy, dennis, bdobbins, eaton +Date: Mon Nov 20 10:29:24 MST 2017 +One-line Summary: update SE dycore, add CSLAM and physics grid capability + +Purpose of changes: + +. The spectral element dycore has been updated to use a dry mass vertical + coordinate. There are also changes to the hyperviscosity and to account + for water substance in the evaluation of heat capacity. The code base is + now part of the CAM source tree rather than an external which was derived + from the HOMME repo. + +. The CSLAM advection scheme may be used instead of the native SE + advection. This is tighly coupled to the use of a physics grid which is + distinct from the GLL grid used by the dycore. The new physics grids + divide the spectral elements into n**2 equal area cells, where n = 2, 3, + or 4 are currently implemented. These grids are identified by suffixes + to the GLL grid specifiers, in the form pg2, pg3, or pg4 (pg stands for + physgrid). So the combination of the ne30np4 GLL grid with the pg3 + physics grid is expressed as ne30np4.pg3. This is the form of the grid + specifier that is used with the -hres option to configure. CSLAM always + operates on the pg3 grid, but it is possible to run the physics + parameterizations on any of the physics grids. Hence the argument '-hres + ne30np4.pg2' indicates that the dynamics uses the ne30np4 grid, CSLAM is + enabled (and uses the pg3 grid), and the physics is run on the pg2 grid. + +. Extend the test tracer module to include a new set of analytic ICs useful + for dycore testing. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. add extension to SE grid specifier to indicate use of the physics grid. + +Describe any changes made to the namelist: + +. new variables for SE + +List any changes to the defaults for the boundary datasets: + +. new ncdata, bnd_topo files for SE grids + +Describe any substantial timing or memory changes: +. evaluation of the new dycore is ongoing. + +Code reviewed by: eaton, goldy + +List all subroutines eliminated: + +components/cam/bld/get_nxny.pl +components/cam/bld/run-cray.csh +components/cam/bld/run-darwin.csh +components/cam/bld/run-ibm.csh +components/cam/bld/run-lynx.csh +components/cam/bld/run-pc.csh +components/cam/bld/run-scam.csh +components/cam/bld/run-yellowstone.csh +. deprecated run scripts + +components/cam/src/dynamics/se/nctopo_util_mod.F90 +. unused utility code + +components/cam/src/dynamics/se/share/* +. old dycore source + +List all subroutines added and what they do: + +components/cam/src/dynamics/se/dp_mapping.F90 +. code for mapping between the GLL and the physics grids + +components/cam/src/dynamics/se/dycore/* +. new SE dycore source + +components/cam/src/dynamics/se/test_fvm_mapping.F90 +. test code for the new mapping infrastructure + +components/cam/test/system/config_files/h030x8ad +components/cam/test/system/config_files/h16.3c4aqdm +components/cam/test/system/config_files/h16.3c5aqt5dh +components/cam/test/system/config_files/h16c4aqdm +components/cam/test/system/config_files/h16idm +components/cam/test/system/config_files/h5.2addm +components/cam/test/system/config_files/h5.3addm +components/cam/test/system/config_files/h5.3adds +components/cam/test/system/config_files/h5.3adicdm +components/cam/test/system/config_files/h5.3c5aqdm +components/cam/test/system/config_files/h5.3c5aqt5mdm +components/cam/test/system/config_files/h5.4addm +components/cam/test/system/config_files/h5addm +components/cam/test/system/config_files/h5adds +components/cam/test/system/config_files/h5adicdm +components/cam/test/system/nl_files/outfrq3s_bwic +components/cam/test/system/nl_files/outfrq3s_conus +components/cam/test/system/nl_files/outfrq3s_unstruct +. new test configurations + +components/cam/tools/se_grid/make_se_grid.sh +. se grid tool + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES +. remove old external for SE dycore + +components/cam/bld/build-namelist +. turn off aerosols for simple physics configurations +. add check that topo file is being used if beta ridge scheme is on. +. refactor setting variables for SE + +components/cam/bld/config_files/definition.xml +. add parameter npg to store the physics grid designator (currently 2, 3, + or 4) + +components/cam/bld/config_files/horiz_grid.xml +. add definitions for new SE grids, and remove some old ones. + +components/cam/bld/configure +. update CPP macros and Filepath for SE code +. extend grid specifier parsing for SE to extract the physics grid + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. update dtime, ncdata, bnd_topo for SE grids +. update SE namelist defaults + +components/cam/bld/namelist_files/namelist_definition.xml +. fix some non-conforming characters +. add new SE variables +. add SE nudging variables +. add dry_baroclinic_wave to valid values for analytic_ic_type + +components/cam/bld/namelist_files/use_cases/dctest_baro_kessler.xml +components/cam/bld/namelist_files/use_cases/dctest_baro_moist.xml +. update history output and turn on new test tracers + +components/cam/cime_config/config_component.xml +. update regexp for SE grid matching +. update %HS94 to add -analytic_ic when using SE grid, and only use + held_suarez_1994 use case for global spectral grids. +. add %CSLAMTEST + +components/cam/cime_config/config_compsets.xml +. add FCSLAMTEST + +components/cam/src/chemistry/modal_aero/aero_model.F90 +. mod to allow vlc_dry=0 + +components/cam/src/chemistry/mozart/mo_drydep.F90 +. if the drydep_srf_file doesn't contain fraction_landuse on the correct + grid then set it to zero. This is a hack for the SE physgrid option. + +components/cam/src/chemistry/pp_terminator/chemistry.F90 +. add diagnostic output + +components/cam/src/chemistry/utils/prescribed_strataero.F90 +. fix log output that should only be written from masterproc + +components/cam/src/control/cam_history.F90 +. add error messages to endrun calls + +components/cam/src/control/ncdio_atm.F90 +. mods to make use of info from the grid object to check for correct + number of columns in unstructured grid input files +. add log output to help trace which code is responsible for reading input + data fields. + +components/cam/src/dynamics/eul/dycore.F90 +components/cam/src/dynamics/fv/dycore.F90 +components/cam/src/dynamics/se/dycore.F90 +. remove unused function get_resolution() + +components/cam/src/dynamics/eul/dyn_comp.F90 +components/cam/src/dynamics/fv/dryairm.F90 +. Set global dry mass to flat earth value when no topo file is used rather + than based on aquaplanet mode. This is for running aquaplanet with + topography. + +components/cam/src/dynamics/fv/dyn_comp.F90 +. set phis=0 only based on whether topo file is present. +. bugfix for number of dyn pes < total pes + +components/cam/src/dynamics/se/dp_coupling.F90 +components/cam/src/dynamics/se/dyn_comp.F90 +components/cam/src/dynamics/se/dyn_grid.F90 +components/cam/src/dynamics/se/gravity_waves_sources.F90 +components/cam/src/dynamics/se/interp_mod.F90 +components/cam/src/dynamics/se/native_mapping.F90 +components/cam/src/dynamics/se/pmgrid.F90 +components/cam/src/dynamics/se/restart_dynamics.F90 +components/cam/src/dynamics/se/stepon.F90 +. SE interfaces refactored and updated for new dycore +. There is a lot of new code to support the physics grid option and for + interpolation between the physics grids and the GLL grid. +. There are changes to allow reading/writing data on the physics grid. + This grid does not require any boundary exchanges. + +components/cam/src/dynamics/tests/inic_analytic.F90 +components/cam/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 +. add dry baroclinic wave option + +components/cam/src/physics/cam/cam_diagnostics.F90 +. add calls to register vector fields +. add new energy and angular momentum diagnostics +. move calls to output constituents from diag_phys_writeout_moist to + diag_phys_writeout_dry + +components/cam/src/physics/cam/check_energy.F90 +. add subroutine calc_te_and_aam_budgets + +components/cam/src/physics/cam/cldwat.F90 +components/cam/src/physics/cam/cloud_fraction.F90 +components/cam/src/physics/cam/zm_conv.F90 +. remove unused reference to get_resolution + +components/cam/src/physics/cam/const_init.F90 +. cleanup + +components/cam/src/physics/cam/macrop_driver.F90 +components/cam/src/physics/cam/rk_stratiform.F90 +. add initializers for qcwat and tcwat if they were not initialized in + phys_inidat. + +components/cam/src/physics/cam/micro_mg2_0.F90 +. replace a bunch of unspecified dimension ranges by 1:mgncol. Workaround + for intel bug. + +components/cam/src/physics/cam/phys_grid.F90 +. phys_grid_init + - code to add the 'area' attribute to the physgrid object on the physics + decomposition for unstructured grids. + +components/cam/src/physics/cam/physics_types.F90 +. remove check for FV dycore inside physics_dme_adjust. this call is also + made for SE. + +components/cam/src/physics/cam/physpkg.F90 +. tphysac and tphysbc + - add calls to calc_te_and_aam_budgets + +components/cam/src/physics/cam/tracers.F90 +. extend functionality by providing a new set of tracers which are useful + for dycore testing. + +components/cam/src/physics/cam/tracers_suite.F90 +. change interfaces to use lat/lon coords in radians rather than degrees. + The old test tracers didn't need lat/lon values, so no backwards + compatibility issues. + +components/cam/src/physics/simple/physpkg.F90 +. no longer call set_dry_to_wet and physics_dme_adjust for SE dycore + +components/cam/src/utils/cam_grid_support.F90 +. add public function cam_grid_attr_exists +. add interface for cam_grid_get_dim_names and allow access by grid name or + id. + +components/cam/src/utils/cam_map_utils.F90 +. remove debug code + +components/cam/src/utils/cam_pio_utils.F90 +. add dump_field_4d_d +. add optional fill_value args to dump_field_* routines + +components/cam/src/utils/hycoef.F90 +. change ps0/psr from parameters to protected. Read them from the initial + or restart file if they're present. +. add optional argument to specify that the hybrid coordinate is dry + pressure based. In this case the formula_terms attribute is not attached + to the coordinate object since there is no CF convention for this + coordinate type. + +components/cam/src/utils/physconst.F90 +. add cpice + +components/cam/src/utils/spmd_utils.F90 +. add more mpi names for forwarding from mpif.h + +components/cam/test/system/CAM_runcmnd.sh +. add OMP_STACKSIZE=128M for yellowstone hybrid run + +components/cam/test/system/input_tests_master +. new SE tests + +components/cam/test/system/nl_files/outfrq3s_f19c6aqwsc +. turn off beta ridges in aquaplanet test + +components/cam/test/system/tests_pretag_cheyenne +components/cam/test/system/tests_pretag_hobart_nag +components/cam/test/system/tests_pretag_hobart_pgi +components/cam/test/system/tests_pretag_yellowstone +. add SE tests + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS except +029 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Fri Nov 17 23:19:45 MST 2017 +032 bl736 TBL.sh h16adtermdh terminator 9s ....................................................FAIL! rc= 7 at Fri Nov 17 23:22:33 MST 2017 +035 bl760 TBL.sh h030x8ad outfrq3s_conus 9s ...................................................FAIL! rc= 7 at Sat Nov 18 01:03:22 MST 2017 +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Sat Nov 18 01:04:03 MST 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16_mg17 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Sat Nov 18 01:05:46 MST 2017 + +All SE baselines fail due to changed dycore or new test. +eq991 and eq993 are pre-existing failures. + +yellowstone/intel/aux_cam: all PASS except + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + +diff in eps_agrid. + +hobart/nag: all PASS except +055 bl700 TBL.sh h5adicdm outfrq3s_bwic 9s ....................................................FAIL! rc= 7 at Fri Nov 17 16:08:08 MST 2017 +059 bl702 TBL.sh h5.3adicdm outfrq3s_bwic 9s ..................................................FAIL! rc= 7 at Fri Nov 17 16:11:45 MST 2017 +066 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Fri Nov 17 16:24:16 MST 2017 +072 bl720 TBL.sh h16c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Fri Nov 17 16:36:23 MST 2017 +075 bl721 TBL.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 9s ......................................FAIL! rc= 7 at Fri Nov 17 16:44:12 MST 2017 + +All SE baselines fail due to changed dycore or new test. + +hobart/pgi: +029 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Fri Nov 17 16:29:46 MST 2017 +032 bl704 TBL.sh h5.4addm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Nov 17 16:37:21 MST 2017 +037 bl707 TBL.sh h5.2addm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Nov 17 17:04:02 MST 2017 +040 bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s ......................................FAIL! rc= 7 at Fri Nov 17 17:13:35 MST 2017 + +bl339 fails due to a difference in RHO which doesn't feed back into the +simulation. +All SE baselines fail due to changed dycore or new test. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for SE + +=============================================================== +=============================================================== + +Tag name: cam5_4_151 +Originator(s): cacraig, gettelman, Vince Larson, eaton +Date: Nov 16, 2017 +One-line Summary: Misc bit-for-bit changes (answer changing just for KHV_CLUBB diagnostic) + +Purpose of changes: + - Change KVH_CLUBB field to output khzm instead of khzt (answer changing just for KVH_CLUBB diagnostic variable) + - Cleanup the ice sublimation calculation to better illustrate not reducing ice number on ice sublimation (bit-for-bit change) + - Bug fix for deep_scheme='off' + - update cime external version used for CAM checkouts + - Add default setting for prescribed_strataero_3modes in build-namelist + - Comment and cleanup changes in several files + +Bugs fixed (include bugzilla ID): + - deep_scheme='off' was broken and was fixed by restoring pbuf_add_field calls to vertical diffusion when 'off' is specified + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/bld/run-cray.csh +D components/cam/bld/run-darwin.csh +D components/cam/bld/run-ibm.csh +D components/cam/bld/run-lynx.csh +D components/cam/bld/run-pc.csh +D components/cam/bld/run-scam.csh +D components/cam/bld/run-yellowstone.csh + - eliminate obsolete, unsupported run scripts + +D components/cam/test/system/tests_cam_phys + - remove test which should not have been committed + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cime5.4.0-alpha.05 + +M components/cam/bld/build-namelist + - add default for prescribed_strataero_3modes + Keeps the logic for how prescribed_strataero_xxx should be treated in cam6 in one place + +M components/cam/bld/config_files/definition.xml + - removed obsolete definition for clubb_do_deep (was removed in previous tag) + - horiz_grid.xml file is config_horiz_grid.xml in CAM6 - changed the comment to reflect this + +M components/cam/bld/configure + - Change the documentation for the default for -chem flag to reflect both cam6 and cam5 settings + +M components/cam/cime_config/config_compsets.xml + - Put back in FDCBAROMOIST compset which should not have been removed in previous tag + - Remove all AMIP and PIPD references + +M components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam +M components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm + - Replace hardcoded glade path with $DIN_LOC_ROOT + +M components/cam/src/physics/cam/clubb_intr.F90 + - Change KVH_CLUBB field to output khzm instead of khzt + - Vince provided updated comments + +M components/cam/src/physics/cam/convect_deep.F90 + - fix for deep_scheme='off' by reintroducing pbuf_add_field calls for several fields when deep_scheme='off' or 'UNICON' + (this was removed in an SPCAM organizational tag) + +M components/cam/src/physics/cam/unicon_cam.F90 + - Removed the pbuf_add_field calls which is now returned to convect_deep + +M components/cam/src/physics/cam/micro_mg2_0.F90 + - cleanup the ice sublimation calculation to better illustrate not reducing ice number + on ice sublimation (bit-for-bit change) + +M components/cam/src/physics/cam/vertical_diffusion.F90 + - only add the pbuf field 'kvh' if not running CLUBB + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Wed Nov 15 23:00:49 MST 2017 + - This job outputs KVH_CLUBB and it changed answers + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Thu Nov 16 01:06:30 MST 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16_mg17 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Thu Nov 16 01:08:17 MST 2017 + - Previous tag broke these two tests + +yellowstone/intel/aux_cam: all PASS + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_150 +Originator(s): andrew, lamar, hannay, cacraig +Date: Nov 6, 2017 +One-line Summary: Update CAM namelists and CAM source mods to match Cecile's #202 run + +Purpose of changes: + - Incorporate changes to CAM settings to match Cecile's run #202 -- Note these changes are climate changing + - Update the external components to match what was in run #215 (Cecile didn't want to backtrack to what was used in #202) + NOTE - Cecile's runs #202 and #215 also had modifications to CLM and CICE settings + so this tag will not reproduce either of those runs. + - Hardwire micro_do_sb_physics namelist to false for all versions of MG + - Update namelist settings for clubb_gamma_coef, micro_mg_dcs, micro_mg_berg_eff_factor, + seasalt_emis_scale and zmconv_ke + - Increase in dry deposition of SO2 to improve bias over US/Europe + - Update KK2000 autoconversion to use latest CESM2 proposed modifications + - Update relative dispersion (pgam) in micro_mg_utils to use Liu and Rotstayn + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - Change the following namelists: + seasalt_emis_scale = 1.0D0 (for strat and clubb runs only) + clubb_gamma_coef = 0.308 (for all clubb runs) + micro_mg_berg_eff_factor = 1.0 (for MG2 only) + micro_mg_dcs = 500.D-6 (for MG2 only) + micro_do_sb_physics = .false. (for all MG versions) + zmconv_ke = 5.0E-6 (for all dyn=fv, dyn=se, hgrid=128x256, hgrid=256x512 or hgrid=512x1024) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - Update the external components to match what was in run #215 + Note -- there were additional changes made in #215 to other components + +M components/cam/bld/build-namelist + - Hardwire micro_do_sb_physics namelist to false for all versions of MG + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Update namelist settings for clubb_gamma_coef, micro_mg_dcs, micro_mg_berg_eff_factor, + seasalt_emis_scale and zmconv_ke + +M components/cam/src/chemistry/mozart/mo_drydep.F90 + - Increase in dry deposition of SO2 to improve bias over US/Europe + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - Update KK2000 autoconversion to use latest CESM2 proposed modifications + - Update relative dispersion (pgam) in micro_mg_utils to use Liu and Rotstayn + +M components/cam/test/system/input_tests_master + - Update grid for CAM 993 test (the version of cime in this tag has a bug for ne16_ne16_mg17. Updated it to the + the correct grid version name) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +010 bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s .................................................FAIL! rc= 7 at Mon Oct 30 15:56:22 MDT 2017 +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Mon Oct 30 16:11:44 MDT 2017 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Mon Oct 30 16:14:26 MDT 2017 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Mon Oct 30 16:53:03 MDT 2017 +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Mon Oct 30 17:32:03 MDT 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Mon Oct 30 17:48:44 MDT 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Mon Oct 30 18:36:32 MDT 2017 +029 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Mon Oct 30 19:22:14 MDT 2017 +032 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Mon Oct 30 19:35:26 MDT 2017 + - All CAM6 tests as well as tests which use the changed namelist settings are expected to change answers + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Mon Oct 30 19:38:20 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 4 at Mon Oct 30 19:38:20 MDT 2017 + - Continued failures + +038 sm993 TSM_ccsm.sh ne16_ne16_mg17 QPC5 9s ..................................................FAIL! rc= 4 at Mon Nov 6 10:00:37 MST 2017 + - ne16_ne16_mg17 is misnamed in this version of cime (will fail until update to newer cime tag) + +yellowstone/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_149 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_149 + SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_149 + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_149 + - All CAM6 runs have namelist and answer changes + +hobart/nag: +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Mon Oct 30 12:02:13 MDT 2017 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Mon Oct 30 12:21:19 MDT 2017 +024 bl318 TBL.sh f10c4aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Mon Oct 30 12:33:15 MDT 2017 +027 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Mon Oct 30 12:38:06 MDT 2017 +033 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Mon Oct 30 12:42:47 MDT 2017 +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Mon Oct 30 12:51:03 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Mon Oct 30 12:55:25 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Mon Oct 30 12:59:49 MDT 2017 +045 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Mon Oct 30 13:07:36 MDT 2017 +048 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Mon Oct 30 13:19:08 MDT 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Oct 30 13:30:35 MDT 2017 + - All CAM6 tests as well as tests which use the changed namelist settings are expected to change answers + +hobart/pgi: +011 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Oct 30 12:53:39 MDT 2017 +014 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Mon Oct 30 13:03:18 MDT 2017 +017 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s .................................................FAIL! rc= 7 at Mon Oct 30 13:17:17 MDT 2017 +020 bl320 TBL.sh f10c5aqpbadm rad_diag 9s .....................................................FAIL! rc= 7 at Mon Oct 30 13:25:41 MDT 2017 +023 bl321 TBL.sh f10c5aqcdm atrain 9s .........................................................FAIL! rc= 7 at Mon Oct 30 13:29:01 MDT 2017 +026 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Oct 30 13:39:49 MDT 2017 +032 bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s ......................................FAIL! rc= 7 at Mon Oct 30 13:54:24 MDT 2017 + - All tests which use the changed namelist settings are expected to change answers + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all CAM6 and runs which use the changed namelist settings +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +It is important to note that cam5_4_150 does not replicate Cecile's #202 run as she used different externals +and specialized namelist settings and source mods for other components than CAM. cam5_4_150 is meant to capture +the changes that were made in #202 (and the same CAM settings/mods were used in #215). Cecile has provided +the diagnostics from the #202 run to justify the CAM changes for the cam5_4_150 tag. She plans on using +cam5_4_150 for another climate run after this tag is made. + +Notes from Cecile for her comparison run (#202): + +Comparison Tag is: +/glade/p/work/hannay/cesm_tags/cesm2_0_alpha07c_cam5_4_138_cime_config0.0.1.alpha.16 + +This used cesm2_0_alpha07c with the modified externals: +cime https://github.com/CESM-Development/cime/tags/cime5.3.0-alpha.31 +#cime_config https://github.com/CESM-Development/cime_config/tags/cime_config0.0.1.alpha.15/ +cime_config https://github.com/CESM-Development/cime_config/tags/cime_config0.0.1.alpha.16/ +#components/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_4_137/components/cam +components/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_4_138/components/cam +components/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_16_r253/components/clm +components/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice5_20170727 +components/pop https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20170808 +components/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_38 +components/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/branch_tags/rtm1_0_62_cimeupdate_tags/n01 +components/ww3 https://svn-ccsm-models.cgd.ucar.edu/ww3/trunk_tags/ww3_170731 +components/mosart https://svn-ccsm-models.cgd.ucar.edu/mosart/branch_tags/mosart1_0_26_cimeupdates_tags/n01 + +The case direcory is in: +/glade/p/cesmdata/cseg/runs/cesm2_0/b.e20.B1850.f09_g17.pi_control.all.202 + +There are some namelists mods: +/glade/p/cesmdata/cseg/runs/cesm2_0/b.e20.B1850.f09_g17.pi_control.all.202/user_nl_* +and some source mods: +/glade/p/cesmdata/cseg/runs/cesm2_0/b.e20.B1850.f09_g17.pi_control.all.202/SourceMods + +Diags are in: +http://webext.cgd.ucar.edu/B1850/b.e20.B1850.f09_g17.pi_control.all.202/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_149 +Originator(s): jet, mvertens, cacraig, eaton +Date: Oct 26,2016 +One-line Summary: Updates to SCAM to allow it to run with CESM scripts + +Purpose of changes: + - Modifications were made to allow SCAM to run with CESM scripts + - Behind the scenes, all SCAM runs, using CESM scripts, use the scam_mandatory usermods_dir + in addition to the IOP specific directory. The scam_mandatory settings should not + be changed by the user. + - archive_baseline has been modified to allow storage of baselines when runs are made on cheyenne + - Put back in missing filepath in use_case where it was inadvertently removed + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s +A components/cam/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods +A components/cam/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm + - added test directory for testing a SCAM IOP other than the default ARM97. + Note the additional file "include_user_mods" which points to the directory + where the actual usermods_dirs settings are located. + +A components/cam/cime_config/usermods_dirs/scam_arm95 +A components/cam/cime_config/usermods_dirs/scam_arm95/shell_commands +A components/cam/cime_config/usermods_dirs/scam_arm95/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_arm97 +A components/cam/cime_config/usermods_dirs/scam_arm97/shell_commands +A components/cam/cime_config/usermods_dirs/scam_arm97/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_gateIII +A components/cam/cime_config/usermods_dirs/scam_gateIII/shell_commands +A components/cam/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_mandatory +A components/cam/cime_config/usermods_dirs/scam_mandatory/shell_commands +A components/cam/cime_config/usermods_dirs/scam_mpace +A components/cam/cime_config/usermods_dirs/scam_mpace/shell_commands +A components/cam/cime_config/usermods_dirs/scam_mpace/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_sparticus +A components/cam/cime_config/usermods_dirs/scam_sparticus/shell_commands +A components/cam/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_togaII +A components/cam/cime_config/usermods_dirs/scam_togaII/shell_commands +A components/cam/cime_config/usermods_dirs/scam_togaII/user_nl_cam +A components/cam/cime_config/usermods_dirs/scam_twp06 +A components/cam/cime_config/usermods_dirs/scam_twp06/shell_commands +A components/cam/cime_config/usermods_dirs/scam_twp06/user_nl_cam + - added usermods_dirs to control each of the IOPs for CESM runs + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist +M components/cam/cime_config/buildcpp +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/config_pes.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - updates to have SCAM run using CESM scripts + +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml + - add filepath for solar_irrad_data file which was inadvertently deleted + +M components/cam/test/system/archive_baseline.sh + - updates from eaton to allow archiving data for cheyenne runs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Thu Oct 26 00:26:23 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Thu Oct 26 00:28:10 MDT 2017 + - continued pre-existing failures + +yellowstone/intel/aux_cam: all BFB except: + SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_148: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_148/SMS_D_Ln9.T42_T42.FSCAM.yellowstone_intel.cam-outfrq9s' does not exist + - new test and no baselines for comparison + +hobart/nag: all BFB + +hobart/pgi: all BFB + + +=============================================================== +=============================================================== + +Tag name: cam5_4_148 +Originator(s): eaton +Date: Tue Oct 24 2017 +One-line Summary: test_driver updates for cheyenne + +Purpose of changes: + +. modify test_driver.sh: + - To improve throughput of both standalone and the aux_cam tests. + config_pes was modified to use 32 nodes on cheyenne for FV 1-deg grids + which allows the 13-month test to complete in just over 2 hours. + - Added intel compiler flag to get agreement between standalone and CESM + script runs. + - Added a new argument to allow the aux_cam tests to archive their + baselines as part of the test. When this option is used then the + bless_test_results script does not need to be run after testing is + finished. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/Makefile.in +. add -no-fma to FC_FLAGS for intel. + +components/cam/cime_config/config_pes.xml +. change config for 0.9x1.25 grid on cheyenne to use 32 nodes, 12 + tasks/node, 3 threads/task. This PE layout allows the 13 month aux_cam + test to run in about 2 hours. + +components/cam/test/system/test_driver.sh +. add --archive-cime argument to allow archiving the results of the aux_cam + tests while they run. In that case running the bless_test_results script is + unnecessary. +. add creation of a separate script for running the aux_cam tests (cheyenne + only). This script is submitted to the share queue just like the + build-only script. +. Set up the cam regressions to use 2 nodes on cheyenne. The current test + list is taking about 2:40 to build (highly variable) and about 3:30 to run. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS except +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Mon Oct 23 23:12:36 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Mon Oct 23 23:14:22 MDT 2017 + +pre-existing failures + +yellowstone/intel/aux_cam: all PASS + +hobart/nag: all PASS + +hobart/pgi: all PASS + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_147 +Originator(s): fvitt, joemci +Date: 20 Oct 2017 +One-line Summary: Enable use of weimer electric potential model in WACCMX and other misc updates + +Purpose of changes: + + - Enable the use of "weimer" cross cap electric potential model which is more + realistic during solar storm conditions than the default "heelis" potential model. + The potential model can be selected via namelist option: + ionos_epontential_model = 'weimer' | 'heelis'. + + - Provide namelist option for the number of sub-steps used to transport ions. + The default is 5 sub-steps. + + - Unify the namelist controls of the timing of the solar forcings. Use solar_data_ymd + and solar_data_type to control inputs for solar_parms and solar euv data in addition + to solar irradiance data. Solar forcings (space weather indices (solar_parms), + irradiance, and EUV) now share: + solar_data_type (FIXED | SERIAL) + solar_data_ymd + solar_data_tod + + - Fix bug for cases where solar_parms data is more frequent than daily. Need to + update EUVAC, mo_msis_ubc, and mo_snoe module every timestep rather than daily. + +Bugs fixed (include bugzilla ID): + + - Use solar_data_ymd and solar_data_type to control inputs for solar_parms and + solar euv data in addition to solar irradiance data (bugzilla ID 2466). + + - Bug fix for cases where solar_parms data is more frequent than daily. Need to + update EUVAC, mo_msis_ubc, and mo_snoe module every timestep rather than daily. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D components/cam/src/chemistry/utils/mo_solar_parms.F90 + - mo_solar_parms replaced by solar_parms_data + - refactored to use time_coordinate utility class + +List all subroutines added and what they do: + +A components/cam/src/chemistry/utils/solar_parms_data.F90 + - mo_solar_parms replaced by solar_parms_data + - refactored to use time_coordinate utility class + +A components/cam/src/chemistry/utils/input_data_utils.F90 + - new utility module which contains time_coordinate class + +A components/cam/src/chemistry/utils/solar_irrad_data.F90 + - renamed solar_data module to solar_irrad_data + - refactored to use time_coordinate utility class + +A components/cam/src/chemistry/utils/solar_wind_data.F90 + - new module for solar wind conditions, IMF components + +A components/cam/test/system/config_files/f1.9c6aqwmth + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + - if user specifies both solar_const and solar_irrad_data_file then die + rather the issue warning + - if ionos_epontential_model is 'weimer' the set defaults for: + . wei05_coefs_file + . solar_wind_data_file + - change names of namelist varibles: + solar_data_file -> solar_irrad_data_file + solar_parms_file -> solar_parms_data_file + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - correction to the name of default IC file for waccm-sc aqua-planet 1.9x2.5 + - add default IC file for waccm-tsmlt aqua-planet 1.9x2.5 + - change names of namelist varibles: + solar_data_file -> solar_irrad_data_file + solar_parms_file -> solar_parms_data_file + - provide defaults for: + . solar_wind_data_file + . ionos_epotential_model + . wei05_coefs_file + +M components/cam/bld/namelist_files/namelist_definition.xml + - new namelist options: + . ionos_xport_nsplit + . ionos_epotential_model + . wei05_coefs_file + . solar_wind_data_file + - change name of "solar_inparm" group to "solar_data_opts" + - change names of namelist varibles: + solar_data_file -> solar_irrad_data_file + solar_parms_file -> solar_parms_data_file + +M components/cam/src/chemistry/mozart/chemistry.F90 + - solar_parms now advanced by solar_data_advance + - remove call to solar_parms_readnl -- merged with solar_data + - default chem_name rename to 'NONE' + +M components/cam/src/chemistry/mozart/mo_chemini.F90 + - solar_parms_init now invoked by solar_data_init + - no longer need to pass F10.7cm for EUVAC model + +M components/cam/src/chemistry/mozart/mo_jshort.F90 +M components/cam/src/chemistry/mozart/mo_jlong.F90 + - solar_data -> solar_irrad_data + - removed unused reference to time_manager->is_end_curr_day + - pass F10.7 index to phota_bkgrnd_calc + +M components/cam/src/chemistry/mozart/mo_photo.F90 + - solar_data -> solar_irrad_data + - removed call to solar_euv_data_init -- moved to solar_data_init + - removed call to solar_euv_data_advance -- moved to solar_data_advance + - removed unused reference to time_manager->is_end_curr_day -- need to update more frequently when + space weather indices (solar parms) then daily. + - removed call to solar_parms_get + +M components/cam/src/chemistry/utils/mo_msis_ubc.F90 +M components/cam/src/chemistry/mozart/mo_snoe.F90 + - remove check for end-of-day -- need to update more frequently when + space weather indices (solar parms) then daily. + +M components/cam/src/chemistry/mozart/photo_bkgrnd.F90 + - pass in F 10.7 cm index + +M components/cam/src/chemistry/mozart/upper_bc.F90 + - remove call to obsolete solar_parms_get subroutine + +M components/cam/src/chemistry/utils/solar_data.F90 + - module which manages options for: + . solar_irrad_data + . solar_parms_data + . solar_euv_data + . solar_wind_data + +M components/cam/src/chemistry/utils/solar_euv_data.F90 + - refactored to use time_coordinate utility class + +M components/cam/src/control/cam_history.F90 + - reference space weather parmeters directly rather than call + obsolete subroutine solar_parms_get + - solar_data -> solar_irrad_data + +M components/cam/src/control/runtime_opts.F90 + - removed call solar_euv_data_readnl -- options now managed by solar_data module + +M components/cam/src/ionosphere/waccmx/dpie_coupling.F90 + - moved advancement of electric potential model from d_pie_coupling to + new subroutine d_pie_epotent so that the electric potential can be + updated before physics is invoked -- mo_aurora need updated electric + potential information + - pass in number of sub-steps for ion transport (oplus_nsplit) + +M components/cam/src/ionosphere/waccmx/ionosphere_interface.F90 + - added namelist options + . ionos_xport_nsplit + . ionos_epotential_model + . wei05_coefs_file + - invoke d_pie_epotent in ionosphere_run1 -- before physics + +M components/cam/src/ionosphere/waccmx/wei05sc.F90 + - some cleanup + - initialize ceofs and other data to NaN to ensure that the + coefs are actually read in and the module is initialized + +M components/cam/src/physics/cam/physpkg.F90 + - removed call to obsolete subroutine waccmx_phys_ion_elec_temp_stepinit + +M components/cam/src/physics/cam/waccmx_phys_intr.F90 + - removed obsolete subroutine waccmx_phys_ion_elec_temp_stepinit + +M components/cam/src/physics/camrt/rad_solar_var.F90 +M components/cam/src/physics/camrt/radsw.F90 +M components/cam/src/physics/rrtmg/rad_solar_var.F90 + - solar_data -> solar_irrad_data + +M components/cam/src/physics/waccm/efield.F90 + - access f017 via solar_parms_data use association + +M components/cam/src/physics/waccm/mag_parms.F90 + - access f017 via solar_parms_data use association + - ability to set the high latitude electric potential model + +M components/cam/src/physics/waccmx/ion_electron_temp.F90 + - access f017 via solar_parms_data use association + - remove subroutine ion_electron_temp_timestep_init + +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/input_tests_master + - add waccm6 test at 2-degrees + +M components/cam/test/system/nl_files/outfrq3s_ionos + - modified to turn on 'weimer' potential model and increase + ion transport substeps + +M components/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +M components/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45_bgc.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85_bgc.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +M components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp26.xml +M components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp45.xml +M components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp60.xml +M components/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp85.xml +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml +M components/cam/bld/namelist_files/use_cases/aquaplanet_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml + - solar_data_file -> solar_irrad_data_file + +M components/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - solar_data_file -> solar_irrad_data_file + - solar_parms_file -> solar_parms_data_file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Thu Oct 19 18:32:06 MDT 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Thu Oct 19 20:59:09 MDT 2017 + - expected failures due to removal of following unnecessary code block for fixed solar data + ! this assures that FIXED data are b4b on restarts + if ( fixed_solar ) then + delt = dble(int(delt*cday+.5_r8))/dble(cday) + endif + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Thu Oct 19 22:00:40 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Thu Oct 19 22:02:26 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: All B4B + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: NLFAIL) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + - namelist compare tests fail due to variables change: + "solar_data_file" --> "solar_irrad_data_file" + "solar_parms_file" -> "solar_parms_data_file" + +hobart/nag: All PASS + +hobart/pgi: All PASS + +=============================================================== +=============================================================== + +Tag name: cam5_4_146 +Originator(s): cacraig, kluzek +Date: Oct 18, 2017 +One-line Summary: Changes to support removal of CLM irrig namelist and specify BGC-CROP in CAM's compsets + +Purpose of changes: + - CLM no longer permits specifying the irrig namelist (clm4_4_16_r259) and was halting when it was + specified in the CAM compsets. Removed setting this for the FHIST_DEV and F2000_DEV compsets + - Now specify "-bgc bgc -crop" using the preferred %BGC-CROP in the compset definition + - Update CLM external to clm4_5_16_r259 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/cime_config/usermods_dirs/f2000/shell_commands +D components/cam/cime_config/usermods_dirs/fhist/shell_commands + - No longer need to set CLM namelists + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to the CLM tag which has the irrigation change + +M components/cam/cime_config/config_compsets.xml + - Use %BGC-CROP to turn on crop for F2000_DEV and FHIST_DEV + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB (no CLM used) + +yellowstone/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_145 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_145 + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_145 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_145 + ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_145 + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_145 + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_145 + - all jobs which use CLM have namelist changes and answer changes due to updated external + +hobart/nag: all BFB (no CLM used) + +hobart/pgi: all BFB (no CLM used) + +=============================================================== + +Tag name: cam5_4_145 +Originator(s): Vince Larson, Erik Kluzek, cacraig +Date: Oct 17, 2017 +One-line Summary: Fix for wp2_wp3 band solver in CLUBB (fix Himalaya's crash) + +Purpose of changes: + + From Vince Larson: + I clipped temperature within the Goff-Gratch functions for saturation over liquid and ice. + The goal was to avoid the creation of NaNs that caused CAM to crash over the Himalayas. + The result of applying a minimal threshold on temperature is to set saturation to the same small + value in all cold areas. + + To test the code change, I ran the priority single-column cases and determined that the new code + produces bin-diff identical results for these cases. That just means that these cases are not cold. + However, the code change might increase + saturation in cold areas in CAM, thereby diminishing condensation in the upper atmosphere. + It would be prudent to check a WACCM simulation for degradation. If there is degradation, + the minimum temperatures could be set to smaller values. + +Bugs fixed (include bugzilla ID): Bugzilla 2491 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + -update to CLUBB external which contains Vince Larson's bug fix + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Mon Oct 16 20:14:11 MD +T 2017 +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Mon Oct 16 20:53:53 MD +T 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Mon Oct 16 21:10:28 MDT 2017 + - all runs which use CLUBB will have different results + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Mon Oct 16 22:59:32 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Mon Oct 16 23:01:14 MDT 2017 + - failing test from previous tag + +yellowstone/intel/aux_cam: + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_144 + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_144 + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_144 + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_144 + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_144 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_144 + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_144 + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_144 + - all runs which use CLUBB will have different results + +hobart/nag: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Mon Oct 16 17:17:37 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Mon Oct 16 17:21:28 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Mon Oct 16 17:25:39 MDT 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Oct 16 17:54:09 MDT 2017 + - all runs which use CLUBB will have different results + +hobart/pgi: all BFB (no PGI tests use CLUBB) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all runs with CLUBB +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): WACCM reported that the answer changes were larger than roundoff, but same climate + +=============================================================== +=============================================================== + +Tag name: cam5_4_144 +Originator(s): cacraig, hannay +Date: Oct 9, 2017 +One-line Summary: First set of updates to match Cecile's 197_5-day_volc runs + +Purpose of changes: +- These changes are the first tag to attempt to match Cecile's 197_5-day_volc runs. + **************** + THIS TAG STILL NEEDS TO BE VERIFIED BY CECILE AND USERS MUST CAREFULLY CHECK ALL + NAMELIST SETTINGS BEFORE USING FOR ANY SCIENTIFIC RUNS USING THIS TAG + **************** + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/cime_config/usermods_dirs/f2000/user_nl_cam +D components/cam/cime_config/usermods_dirs/fhist/user_nl_cam + - The hardcoded emission files are no longer needed as they all reside in inputdata + +List all subroutines added and what they do: +A components/cam/bld/namelist_files/use_cases/2010_cam6.xml + - The start of making a 2010 compset -- It is not ready for using yet + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist + - According to Mike Mills, all CAM6 runs should use prescribed_strataero_3modes - made + changes to set this as the default for cam6 + - Updated the surface and vertical emission datasets + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Update the surface and vertical emission files to match Cecile's runs + - Update the default prescribed_strataero_file for 3modes + +M components/cam/bld/namelist_files/namelist_definition.xml + - Update the comment for prescribed_strataero_3modes default settings + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - Update the use_cases to match Cecile's 197_5-day_volc runs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Fri Oct 6 11:53:52 MDT 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Fri Oct 6 12:10:39 MDT 2017 + - Various input files have been changed with this tag and leads to different answers for CAM6 runs + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Oct 6 12:10:41 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Fri Oct 6 12:10:47 MDT 2017 + - Continued failing test from previous tag + +yellowstone/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_143 + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_143 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_143 + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_143 + - These compsets have Cecile's namelist changes and answers are expected to change with them + +hobart/nag: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Fri Oct 6 13:31:49 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Fri Oct 6 13:35:46 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Fri Oct 6 13:40:07 MDT 2017 + - Various input files have been changed with this tag and leads to different answers for CAM6 runs + +hobart/pgi: all BFB + - No CAM6 runs are made with the PGI compiler + +To validate these answer changes, Cecile will use this tag in her future runs and check the resulting CAM namelist files. + +=============================================================== +=============================================================== + +Tag name: cam5_4_143 +Originator(s): eaton +Date: Mon Sep 25 10:45:27 MDT 2017 +One-line Summary: update test_driver.sh for cheyenne; update cime, cime_config + +Purpose of changes: + +. update cam regression testing for cheyenne (haven't switched over yet) +. update cime and cime_config externals and make associated changes in CAM + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add ninst_driver to group cime_driver_inst + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +components/cam/cime_config/usermods_dirs/1850/shell_commands +. had unintended side effects on CESM testing + +components/cam/test/system/nl_files/fv1d_4tsk +components/cam/test/system/nl_files/fv1d_8tsk +components/cam/test/system/nl_files/fv1d_lb2 +components/cam/test/system/nl_files/fvvp_lb0 +components/cam/test/system/nl_files/fvvp_lb2 +. no longer used + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update cime to cime5.3.0-alpha.35 +. update cime_config to cime_config0.0.1.alpha.22 + +components/cam/bld/build-namelist +. add default for ninst_driver +. add check that -ntasks arg is positive + +components/cam/bld/namelist_files/namelist_definition.xml +. add variable ninst_driver to group cime_driver_inst + +components/cam/bld/Makefile.in +. Note that the change the CONTIGUOUS_FLAG for the intel compiler to + NO_CONTIGUOUS_FLAG committed in cam5_4_141 is a workaround to a compiler + bug in intel-17. + +components/cam/cime_config/config_pes.xml +components/cam/cime_config/usermods_dirs/1850/shell_commands +. replace PES_PER_NODE by MAX_MPITASKS_PER_NODE +. change the MAX_TASKS_PER_NODE settings to 32 on yellowstone, and adjust + MAX_MPITASKS_PER_NODE to account for the specified thread count. + +components/cam/test/system/CAM_decomp.sh +. add condition to set levels for cam6 to 32. +. back out change that set the default number of levels to 32. We want to + retain (for now) the default for the ideal models to be 30. + +components/cam/test/system/CAM_runcmnd.sh +. remove code for unused machines. +. update cheyenne run commands + +components/cam/test/system/nl_files/fcase +. add aqua_planet_sst=3 for the TEQ_ccsm tests + +components/cam/test/system/TER.sh +. remove unused condition on npr_yz + +components/cam/test/system/config_files/f1.9c6aqcdh +. bugfix: change -nosmp to -smp + +components/cam/test/system/test_driver.sh +. mods in cheyenne scripts -- simplify both the cb and the run scripts +. remove edison section +. remove unused cb_flag and chey_comp variables +. add a start time to the cam_status file +. fix the qsub command for submitting the run script +. change submit of cheyenne cb script from interactive back to using the + share queue. +. add OMP_STACKSIZE=256M to the yellowstone run script. This is needed for + running hybrid with COSP. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: PASS except +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Wed Sep 20 21:02:17 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Wed Sep 20 21:03:58 MDT 2017 + +These are pre-existing failures. I tried to fix this by changing the CAM +standalone part of the test to use the analytic SST option 3 like the +compset does. There are still roundoff level diffs causing the compare to +fail. Will need to update the standalone run to use DOCN for the analytic +SSTs to get this test to pass. + +yellowstone/intel/aux_cam: +aux_cam_20170921162337 + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_142 + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m TPUTCOMP Error: Computation time increase > 25% from baselin + +(Reran all aux_cam tests due to change in PE layout - these notes are from that run) + +namelist comparison failures due to new namelist group, cime_driver_inst + +The timing test fails because the resource devoted to the test is +substantially reduced. The test had been running on 240 nodes (1920 tasks, +8 tasks/node). It is now using 64 nodes (960 tasks, 15 tasks/node). It +now takes about 2:40 to run. + +The baseline test fails due to a change in PE layout. The coupler is not bit-for-bit with change in PE layouts. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_142 +Originator(s): cacraig +Date: Sept 13, 2017 +One-line Summary: Update F2000_DEV and FHIST_DEV to use #195 REFCASE and add version info back into PORT tests + +Purpose of changes: + - Update F2000_DEV and FHIST_DEV to use #195 REFCASE. This includes removing the setting of CISM_OBSERVED_IC + which was breaking ERI testing and had been used as a temporary workaround that is no longer needed + - For testing, put back in the CAM version information for PORT tests - the version should not have been + removed in the previous tag. + - Additional changes for CAM regression testing to support testing on cheyenne, but this is not completely working yet + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam4_port + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f19 +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f45 +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_ne30 +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f09 + - Include CAM version information back into PORT testing (this should not have + been removed in the previous tag) + - The cam4_port version now has the version number in the name + +List all existing files that have been modified, and describe the changes: + + M . +M SVN_EXTERNAL_DIRECTORIES + - update cime_config version + - this version contains the v2 B1850 refcase which no longer needs to use CISM_OBSERVED_IC + +M components/cam/bld/Makefile.in + - set up NO_CONTIGUOUS_FLAG for intel compilations (cheyenne does not handle the CONTIGUOUS_FLAG properly) + +M components/cam/cime_config/config_component.xml + - PORT is an option in every version of CAM + +M components/cam/cime_config/config_compsets.xml + - update the REFCASEs for FHIST_DEV and F2000_DEV to use the #195 configuration + - put back in PC4, PC5 and PC6 + +M components/cam/cime_config/testdefs/testlist_cam.xml + - put back in PC4, PC5 and PC6 testing + +M components/cam/cime_config/usermods_dirs/1850/shell_commands +M components/cam/cime_config/usermods_dirs/f2000/shell_commands +M components/cam/cime_config/usermods_dirs/fhist/shell_commands + - removed CISM_OBSERVED_IC settings as they were breaking ERI tests and were a temporary fix to get jobs running + +M components/cam/test/system/CAM_decomp.sh + - add internal setting of cam6 32 levels + +M components/cam/test/system/CAM_runcmnd.sh + - add commands to use ddt as commented out code to document how to do so + +M components/cam/test/system/test_driver.sh + - More work on cheyenne setups, but is still not completely working + - update to the versions that CESM is using for intel jobs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Tue Sep 12 18:59:47 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Tue Sep 12 19:01:29 MDT 2017 + - previously broken tests + +yellowstone/intel/aux_cam: all BFB except: + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_141 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_141 + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m BASELINE cam5_4_141 + - Changed REFCASE and elimination of CISM_OBSERVED_IC namelist setting changes answers + - IMPORTANT NOTE -- As these changes were limited, these runs have not been validated by + Cecile. Answers will be validated by Cecile at a later date. + +hobart/nag: all BFB + +hobart/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: F2000_DEV and FHIST_DEV +- what platforms/compilers: all + - These changes have not been validated by Cecile. She plans to do this at a later date, but + she wanted this new REFCASE to be used. + + +=============================================================== +=============================================================== + +Tag name: cam5_4_141 +Originator(s): cacraig +Date: Sept 6, 2017 +One-line Summary: Changes to support CESM testing of WACCM and PORT + +Purpose of changes: + - Made all PORT tests independent of CAM version + - Add WCMD WACCM option to CAM6 compset + - Commit changes which were tested in cam5_4_140 for WACCM, but were + accidentally not committed. + - Update cime and cime_config externals + - Additional updates to running CAM testing on cheyenne (still not ready for use) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f09 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09 +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f19 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam4_port +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_f45 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45 +A + components/cam/cime_config/testdefs/testmods_dirs/cam/cam_port_ne30 + > moved from components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30 + - Made PORT compsets CAM version independent + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - Update cime and cime_config externals + +M components/cam/cime_config/config_component.xml + - Change $ to % typo in CAM60 descriptor + - Add grid for B1850 SWAV + (Note - above two changes were in cam5_4_140 testing, but were accidentally not committed) + - Add WCMD option and description + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - eliminate CAM version from PORT runs + +M components/cam/test/system/test_driver.sh + - Clock on cheyenne is hour:min:sec, instead of hour:min + - Run compilation in background on cheyenne + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Wed Sep 6 07:10:36 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Wed Sep 6 07:12:17 MDT 2017 + - continuing failed test + +yellowstone/intel/aux_cam: + - all tests had changed Namelist (due to cime change) + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_140 +Originator(s): cacraig, hannay, sacks, thomas.toniazzo@uni.no +Date: August 31, 2017 +One-line Summary: misc changes including updated SST files, config_component to V3, B1850 2deg bug fix and update cd_core + +Purpose of changes: + - Update SST files + - Using updated REFCASE for B1850 compsets + - Remove %PM qualifier for compsets + - Add V3 descriptors to config_component.xml + - Add science support designator for 1 degree F2000_DEV and FHIST_DEV compsets + - unit test cleanup + - No longer supporting the %PM option for CAM compsets + - F1850_DONOTUSE is running again, but is not recommended for use + +Bugs fixed (include bugzilla ID): + - 2 degree B1850 was attempting to use 1 degree files. This has been fixed. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + - Using update SST files + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/bld/namelist_files/use_cases/1850_cam5_pm.xml + - no longer supporting the %PM option for CAM compsets + +D components/cam/cime_config/usermods_dirs/1850/user_nl_cam +D components/cam/cime_config/usermods_dirs/1850/user_nl_cice +D components/cam/cime_config/usermods_dirs/1850/user_nl_mosart + - REFCASE now gets files automatically + +D components/cam/test/unit/mock +D components/cam/test/unit/mock/CMakeLists.txt +D components/cam/test/unit/mock/shr_sys_mod.nompi_abortthrows.F90 + - unit test cleanup + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update cime_config to get the current REFCASE for B1850 + +M components/cam/cime_config/config_component.xml + - add V3 descriptors to config_component.xml + - remove %PM qualifier + - add CAM to %SPCAM qualifiers + - correct 1 degree grid specification in 1850_CAM60%BGC specifier + +M components/cam/cime_config/config_compsets.xml + - add science_support designator to F2000_DEV and FHIST_DEV 1 degree compsets + - update SST files + +M components/cam/cime_config/config_pes.xml + - update to config_pes version 2 + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add timing information for prealpha tests + +M components/cam/cime_config/usermods_dirs/1850/user_nl_clm + - REFCASE now gets the file automatically + +M components/cam/src/dynamics/fv/cd_core.F90 + - fix anugular-momentum corrections near the poles + +M components/cam/test/unit/CMakeLists.txt + - unit test cleanup + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Tue Aug 29 23:24:48 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Tue Aug 29 23:26:35 MDT 2017 + - tests which were previously failing + +yellowstone/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d BASELINE cam5_4_139 + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_139 + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_139 + - updated SST files yield different results -- Ran these tests again with the old SST files and they were BFB + + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_139 + - F1850 is no longer using the B150 setup and runs again + +hobart/nag: +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Tue Aug 29 17:57:29 MDT 2017 + - angular momementum test which has expected answer changes due to change in cd_core + +hobart/pgi: all BFB + +Additional test - Ran B1850 (using cesm_pop_2_1_20170703) and it was BFB with the previous tag's version + +=============================================================== +=============================================================== + +Tag name: cam5_4_139 +Originator(s): fvitt, joemci, mmills +Date: 25 Aug 2017 +One-line Summary: Updates for WACCM and WACCMX + +Purpose of changes: + + Add new WACCM compsets with specified dynamics: + FWmaSD - middle atmosphere chemistry + FWmadSD - middle atmosphere and D-region ion chemistry + + Add geometric height diagnostic for WACCMX + + Update IC files and use trop_cloud_top_press default (100 Pa) in WACCMX compsets + + Update default PE layouts on NAS pleiades machines + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM review team + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml + for compsets FWmaSD and FWmadSD + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/dynamics/fv/dyn_comp.F90 + - need to check mpi rank is less than npes_yz for high_alt + +M components/cam/src/ionosphere/waccmx/ionosphere_interface.F90 + - pass geopotential height at layer midpoints to dpie_coupling + +M components/cam/src/ionosphere/waccmx/dpie_coupling.F90 + - added diagnostics for geometric height, O-plus and electron densities + - misc cleanup + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml + - added compsets FWmaSD and FWmadSD + +M components/cam/cime_config/config_pes.xml + - updates for pleiades + +M components/cam/cime_config/testdefs/testlist_cam.xml + - added WACCMX (FXHIST) 1 day smoke test to aux_cam test suite + - change FXHIST ERS test to ERP + +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml + - remove trop_cloud_top_press -- use default + - update IC file + - added diagnostics + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Aug 25 05:56:34 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Fri Aug 25 05:58:20 MDT 2017 + These are pre-existing failures + +yellowstone/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s SUBMIT + This test was broken in previous tag. + + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_138 + This WACCMX baseline failure is expected due to change in IC file and trop_cloud_top_press setting + +hobart/nag: All pass + +hobart/pgi: All pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_138 +Originator(s): cacraig, hannay, andrew, katec +Date: Aug 16, 2017 +One-line Summary: MG2 bug fix and changes to B1850 to incorporate settings Cecile has been using + +Purpose of changes: + + - Bug fix for micro_mg_2_0.F90 (moved misplaced parenthesis) + + - Implemented changes which Cecile used in the B1850 #189 run + - Updated vertical and surface emission files defaults for all runs + - Updated 1850 tracer_cnst_file and prescribed_zone_file + - Set prescribed_strataero_3mods to true for 1850 runs + + - Updated externals to a mixture of what was used in #189 and tags which + contained updates that were being hardcoded in #189 + + - Will NOT match the #189 due to additional changes in CLM external + - CLM introduced a bugfix in UrbanAlbedoMod.F90 in clm4_5_16_r252 which was answer changing + - CLM updated the paramfile + - CLM stream_fld_FileName_ndep filename/location changed + - CLM namelist calc_human_stress_indices is no longer being explicitly set by CAM run + + - F2000_DEV has updates which matched Cecile's #188 run, but CLM and CICE + modifications change answers from this run. Users of this compset should independently + verify their setup until a future tag can validate these results with a corresponding + run by Cecile. + + - F1850_DONOTUSE is currently broken + +Bugs fixed (include bugzilla ID): + - MG2 had a misplaced parenthesis which has an impact on final results + +Describe any changes made to build system: + - B1850 recreates Cecile's #189 out-of-the-box with additional modifications + +Describe any changes made to the namelist: + - Default surface and vertical emmission files have been updated + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/usermods_dirs/1850 +A components/cam/cime_config/usermods_dirs/1850/shell_commands +A components/cam/cime_config/usermods_dirs/1850/user_nl_cam +A components/cam/cime_config/usermods_dirs/1850/user_nl_cice +A components/cam/cime_config/usermods_dirs/1850/user_nl_clm +A components/cam/cime_config/usermods_dirs/1850/user_nl_cpl +A components/cam/cime_config/usermods_dirs/1850/user_nl_mosart + - Added settings to match Cecile's #189 run + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES +M components/cam/bld/build-namelist + - updates to support new surface and vertical emission files + - added missing "." to true/false in micro_do_sb_physics variable + +M components/cam/bld/configure + - Added new directory in cime with required share code + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - updated defaults for surface and vertical emission files + - updated prescribed strataero file + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml + - updates to match #189 run + - updated prescribed_ozone_file and tracer_cnst_file + - using prescribed_strataero_3modes + - no longer forcing the surface emission files here, using the default + +M components/cam/cime_config/config_component.xml + - Added hooks for 1850 user_mods + - Fixed Aquaplanet so it can run with any mode, not just "3" + +M components/cam/cime_config/config_compsets.xml + - minor reorder + +M components/cam/cime_config/config_pes.xml + - Bump up the ntasks for yellowstone 1 degree + +M components/cam/cime_config/testdefs/testlist_cam.xml + - Add aquaplanet aux_cam runs on yellowstone + +M components/cam/cime_config/usermods_dirs/f2000/shell_commands +M components/cam/cime_config/usermods_dirs/f2000/user_nl_cam +M components/cam/cime_config/usermods_dirs/f2000/user_nl_clm + - Modifications to match Cecile's F2000 #188 run + +M components/cam/src/physics/cam/micro_mg2_0.F90 + - bug fix - moved misplaced parenthesis + +M components/cam/test/system/test_driver.sh + - modifications to allow cheyenne compilation to occur on a compute node + This is still not working completely, but saving this incremental version + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Tue Aug 15 16:49:03 MDT 2017 +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Tue Aug 15 17:28:26 MDT 2017 + - Answer changes expected for CAM6 runs due to changed emission files and MG2 bug fix + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Tue Aug 15 19:30:51 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Tue Aug 15 19:32:38 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: + +aux_cam_20170815134725 + ERP_D_Ln9.f19_f19_mg17.QPC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QSC6.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: DIFF) details: + Failed namelist and baselines due to emission file updates and MG2 bug fix + + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s SUBMIT + F1850_DONOTUSE is broken due to B1850 using a hybrid run and F1850 has not been updated accordingly + Since this is not a supported compset, we are not attempting to fix it right now + + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + - NOTE - Baselines are unchanged + +hobart/nag: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Tue Aug 15 14:53:05 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Tue Aug 15 14:56:54 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Tue Aug 15 15:00:50 MDT 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Aug 15 15:28:35 MDT 2017 + - CAM 6 runs change answers due to MG2 bug fix and changed emission files + +hobart/pgi: all BFB + + +CAM tag used for the baseline comparison tests if different than previous +tag: At key points in development of this tag, B1850 and F2000 were compared against Cecile's + runs to verify the setups were correct. B1850 was verified very late in the process and + right before updating the CLM version, so there is a high level of confidence in the settings + for B1850. F2000 was verified in an earlier tag, but due to the changes, it was not easy to + verify it one last time prior to the tag. For this reason, users should examine their F2000 + runs prior to using in any substantial runs. F2000 will be validated once again with Cecile's + setups in a future tag. + B1850: + /glade/p/cesmdata/cseg/runs/cesm2_0/b.e20.B1850.f09_g17.pi_control.all.188 + F2000: + /glade/p/cesmdata/cseg/runs/cesm2_0/f.e20.F2000.f09_f09.188 + +Summarize any changes to answers, i.e., +- what code configurations: all CAM6 due to MG2 bug fix and emission file updates +- what platforms/compilers: all + +=============================================================== +=============================================================== + +Tag name: cam5_4_137 +Originator(s): fvitt +Date: 7 July 2017 +One-line Summary: Improve performance of WACCM-X, include ion drift velocities in IC files + +Purpose of changes: + + Improve the scalability of WACCM-X ionosphere with regards to the number of MPI tasks. + + Include input and output of ion drift velocities in IC files for WACCM-X. For backwards + compatibility, if WACCM-X is started from an IC file that does not include ion drift + velocities then ExB ion drag will use the empirical model to compute ion drift velocities + in the first time step. + + Provide a default IC file for WACCM-X at 4x5 degrees horizontal resolution + in aquaplanet mode. + + Miscellaneous code clean up. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/physics/waccm/iondrag.F90 + - read ion drift velocities from IC file + - misc clean up + +M components/cam/src/physics/cam/waccmx_phys_intr.F90 + - add call to read in ion drift velocities from IC file + +M components/cam/src/ionosphere/waccmx/ionosphere_interface.F90 + - output ion drift velocities to history and ic files after dynamo when + the dyanmo is active + +M components/cam/src/ionosphere/waccmx/edyn_mpi.F90 + - improve the scalability of WACCMX dynamo by using mpi_reduce rather than mpi_gather + - misc clean up + +M components/cam/src/ionosphere/waccmx/oplus.F90 +M components/cam/src/ionosphere/waccmx/dpie_coupling.F90 + - misc clean up + +M components/cam/cime_config/config_pes.xml + - increase the number of nodes on cheyenne for WACCMX compsets + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - include defaut IC for waccmx aquaplanet at 4x5 horizontal resolution + +M components/cam/test/system/config_files/f4c4aqwmxiedm + - configure with default number of levels (126) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +td.634459.status:037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Jul 7 06:35:12 MDT 2017 +td.634459.status:039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Fri Jul 7 06:37:04 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_136 + - WACCM-X is bit-for-bit unchanged -- this baseline failure is due to the change in ion velocities diagnostics + +hobart/nag: all pass + +hobart/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + cam5_4_135 on yellowstone + cam5_4_136 on hobart + +=============================================================== +=============================================================== + +Tag name: cam5_4_136 +Originator(s): cacraig +Date: June 28, 2017 +One-line Summary: Misc changes to CESM testing for CAM tags + +Purpose of changes: + - Reintroduced the 1 degree 13 month test until can get the files required for a 10 degree version + - Added a tag for testing all of the CAM compsets prior to the release. Tested all currently defined compsets + - Since SILHS will not be a part of the CESM2.0 release, removed it from the SVN_EXTERNAL_DIRECTORIES + - Organized the compsets in config_compsets.xml, for better visibility into the compsets it contains + - Fixed error with cosp restart test (prebeta testing failure) + +Bugs fixed (include bugzilla ID): + - Set coupling for GLC to match ATM for the short cosp test. The default GLC coupling step was too long + for this test, and failed on restart. This was just a bug for the test and not a problem with cosp + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m/user_nl_clm + - reintroduced settings for the 13 month test + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES +M components/cam/bld/configure + - Removed SILHS external since it will not be part of the CESM2.0 release + +M components/cam/cime_config/config_component.xml + - Updated incorrect comment + +M components/cam/cime_config/config_compsets.xml + - Organized the compsets into separate sections and alphabetical within the sections + +M components/cam/cime_config/testdefs/testlist_cam.xml + - added aux_cam_one test for cheyenne as well as yellowstone + +M components/cam/cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands + - set GLC coupling interval to match ATM in this test for cosp + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: none run +As these changes were mainly confined to the CESM testing, the CAM standalone testing was not run + +yellowstone/intel/aux_cam: all BFB, except for reintroduced 13 month test as it + did not have a baseline or namelist for comparison + +hobart/nag: All BFB + +hobart/pgi: All BFB + Since had time and there is no computer charge on hobart, went ahead and ran hobart test as a sanity check for + the removal of the SILHS external + + +Additional test: ran create_test using the test_release tag for all of the currently defined compsets and + they all ran successfully to completion + +=============================================================== +=============================================================== + +Tag name: cam5_4_135 +Originator(s): fvitt, joemci +Date: 20 Jun 2017 +One-line Summary: Use CLM40 in WACCM-X compsets and add ionosphere diagnostics + +Purpose of changes: + + Use CLM40 in WACCM-X compsets rather than CLM45. Use the same land model that + was used in the validated WACCM4 climate simulations. + + Add ionosphere "F2 layer" diagnostics + HMF2 -- Height of the F2 Layer + NMF2'-- Peak Density of the F2 Layer + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/cime_config/usermods_dirs/waccmx/user_nl_clm +A components/cam/cime_config/usermods_dirs/waccmx + - provides appropriate clm40 IC file for 2000-01-01 + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - update clm tag and include clm40 source code + +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml + - use megan factors file which is compatible with clm40 + +M components/cam/cime_config/config_component.xml + - add usrmods directory for WACCMX compsets + -- this is needed to set clm40 IC file to 2000 conditions + +M components/cam/cime_config/config_compsets.xml + - switch CLM45 to CLM40 in WACCMX compsets + - correct RUN_STARTDATE for FXHIST compset + +M components/cam/src/ionosphere/waccmx/dpie_coupling.F90 + - add ionosphere "F2 layer" diagnostics + +M components/cam/src/physics/waccm/iondrag.F90 + - correct metadata for history field WI (vertical ion drift velocity) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +td.135576.status:037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Mon Jun 19 20:34:42 MDT 2017 +td.135576.status:039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Mon Jun 19 20:36:32 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_134 + - expected failure due to switch to clm40 + + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: FAIL) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m CREATE_NEWCASE + - broken in the previous tag + +hobart/nag: all pass + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_134 +Originator(s): cacraig, eaton, thomas.toniazzo@uni.no +Date: June 16, 2017 +One-line Summary: misc updates + +Purpose of changes: + - eliminated old compsets (per Julio and Rich's agreement) + - update cime, cime_config, cice and mosart externals + - removed aquaplanet external as it is no longer needed + - bug fixes for angular momentum code + - add "first" or "last" match designator for each set of values in config_XXX files + - reintroduced the SSTICE_DATA_FILENAME files in config_compsets.xml + - removed the setting of various CLM settings which were just temporary workarounds + - bumped up the number of default tasks when running on cheyenne with 1 degree + - update to using PGI 17.05 on hobart + - cleanup of unused testmods + +Bugs fixed (include bugzilla ID): + - bug fixes for angular momentum code + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port +D components/cam/cime_config/testdefs/testmods_dirs/cam/cam5_port/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/chemproc +D components/cam/cime_config/testdefs/testmods_dirs/cam/chemproc/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/chemproc/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/mam4_fire_emis +D components/cam/cime_config/testdefs/testmods_dirs/cam/mam4_fire_emis/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/mam4_fire_emis/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5 +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5 +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday +D components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday/shell_commands +D components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/tssoa_fire_emis +D components/cam/cime_config/testdefs/testmods_dirs/cam/tssoa_fire_emis/user_nl_cam + - cleanup of testmods which are no longer used + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update cime, cime_config, cice and mosart to externals which were being used in alpha06o at one time + (cime and cime_config advanced beyond this point) + - removed aquaplanet external as it is no longer needed + +M components/cam/cime_config/config_component.xml + - add "first" or "last" match designator for each set of values + - performed some organizational cleanup + +M components/cam/cime_config/config_compsets.xml + - eliminated old compsets (per Julio and Rich's agreement) + - did not reorganize this file yet, as did not want to make it hard to see the deletions + - removed the setting of the CLM_NAMELIST_OPTS: init_interp_fill_missing_with_natveg=.true. + as this was a temporary fix for CAM runs + - added version="2.0" for the compsets version + - add "first" or "last" match designator for each set of values + - reintroduced the SSTICE_DATA_FILENAME files, now that can specify the match ordering + +M components/cam/cime_config/config_pes.xml + - bumped up the number of default tasks when running on cheyenne with 1 degree + - it was core dumping in CLM code + +M components/cam/cime_config/testdefs/testlist_cam.xml + - no longer using the outfrq9s_clm to set a few CLM settings which were temporary to + allow CAM to run + +M components/cam/src/dynamics/fv/cd_core.F90 + - xakap only set to 1/cap3vc when am_correction=.true. + - dpr, ddpu, dpns, ddus only allocated when am_correction=.true. + +M components/cam/src/dynamics/fv/diag_module.F90 + - L 179: ip_b -> plevp (this is consistent with ctem code) + +M components/cam/src/dynamics/fv/dyn_comp.F90 + - L1728: resetting of arrays du_fix_s, uc_s, and vc_s + wrongly removed before tracer loop - these are accumulators + within that loop, before remapping (e.g. L1966). + - Remove diagnostic output to log file. + +M components/cam/test/system/test_driver.sh + - restore the queue setting for create_test (was temporarily broken) + - update to using PGI 17.05 on hobart + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Jun 16 10:31:25 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Fri Jun 16 10:33:15 MDT 2017 + - continued failures (pre-existing) + +yellowstone/intel/aux_cam: all PASS except: + - all NLCOMP fail due to + - elimination of setting CLM init_interp_fill_missing_with_natveg=.true. + - updated cice, drv and mosart had namelist changes + ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_133: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_133/ERP_Ln9.f09_f09_mg17.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s' does not exist + ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_133: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_133/ERP_Ln9.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq9s' does not exist + ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_133: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_133/ERP_Ln9.f09_f09_mg17.FHIST_DEV.yellowstone_intel.cam-outfrq9s' does not exist + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_133 + - all of these tests are now using outfrq9s instead of outfrq9s_clm + + SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m (Overall: FAIL) details: + FAIL SMS_Lm13.f09_f09_mg17.F2000_DEV.yellowstone_intel.cam-outfrq1m CREATE_NEWCASE + - missing usecase for the 13 month run. Awaiting feedback on whether to continue running this test or not. + +hobart/nag: all BFB with PGI 15.1, updating to 17.05 changes answers for all tests (ran both, saving baselines for 17.05) + +hobart/pgi: all BFB + +FHIST_DEV and F2000_DEV: Since the aux_cam versions of these could not be compared due to the elimination of + unneeded CLM settings, ran one month of each of these and compared with Cecile's 163 runs. They continue to be BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_133 +Originator(s): fvitt, joemci +Date: 9 Jun 2017 +One-line Summary: Updates to WACCM-X compsets + +Purpose of changes: + + Apply updates to WACCM-X build-namelist use cases + Clean up WACCM-X log messages + Add gravity wave drag diagnostic UTGW_TOTAL + Change default number of threads on cheyenne to 3 for WACCM-X compsets + Fix bug in wet deposition specification when species names are + longer than 8 characters + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy + +List all subroutines eliminated: +D components/cam/test/system/config_files/f4c5.5aqwmtdm + - replaced by f4c6aqwmtdm + +List all subroutines added and what they do: +A components/cam/test/system/config_files/f4c6aqwmtdm + - cam5.5 phys became cam6 physics in tag cam5_4_128 + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml + - use updated space weather indices + - tweak history streams + - change start dates of FXSD to 2000-01-01 + - update ICs for FX2000climo + +M components/cam/cime_config/config_compsets.xml + - change start date for FXHIST and FXSD to 2000-01-01 + - FRC1 --> HIST + +M components/cam/cime_config/config_pes.xml + - use 3 threads (rather than 4) per MPI task on cheyenne for WACCMX compsets to improve the cost + +M components/cam/cime_config/testdefs/testlist_cam.xml + - change ocean mask to mg17 + - adjust the waccmx tests + +M components/cam/cime_config/config_component.xml + - FRC1 --> HIST + +M components/cam/src/physics/cam/gw_drag.F90 + - added UTGW_TOTAL diagnostic + +M components/cam/src/chemistry/mozart/gas_wetdep_opts.F90 + - increase character length of species names + +M components/cam/src/ionosphere/waccmx/edynamo.F90 +M components/cam/src/ionosphere/waccmx/oplus.F90 +M components/cam/src/ionosphere/waccmx/edyn_mpi.F90 +M components/cam/src/ionosphere/waccmx/edyn_esmf.F90 +M components/cam/src/ionosphere/waccmx/dpie_coupling.F90 +M components/cam/src/ionosphere/waccmx/edyn_init.F90 +M components/cam/src/ionosphere/waccmx/edyn_maggrid.F90 + - clean up of log messages + +M components/cam/test/system/input_tests_master + - f4c5.5aqwmtdm was replaced with f4c6aqwmtdm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +td.882745.status:037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Fri Jun 9 16:25:01 MDT 2017 +td.882745.status:039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Fri Jun 9 16:26:49 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: + ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s BASELINE cam5_4_132: ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_132/ERS_Ln9.f19_f19_mg16.FXHIST.yellowstone_intel.cam-outfrq9s' does not exist + - new test -- no baseline to compare to + +hobart/nag: all pass + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_132 +Originator(s): fvitt +Date: 8 Jun 2017 +One-line Summary: Fix bug in PORT and add CAM6-PORT compset + +Purpose of changes: + + Include geometric mean radius of the stratospheric aerosols used in + radiative forcings of CAM6 physics in the radiation data. This needed + to be included in both the radiation data output of a base cam simulation + and in the input of PORT. + + Include a CAM6 PORT compset and associated aux_cam test. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_clm +A components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09 + - test PC6 + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/config_compsets.xml + - add new PORT compset PC6 + +M components/cam/cime_config/testdefs/testlist_cam.xml + - test PC6 + +M components/cam/src/physics/cam/radiation_data.F90 + - include geometric mean radius of stratospheric aerosols that are used in cam6 physcis + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +td.854914.status:037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Thu Jun 8 16:54:36 MDT 2017 +td.854914.status:039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Thu Jun 8 16:56:24 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: all pass + +hobart/nag: all pass + +hobart/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: stand-alone cam tests were compared to cam5_4_130 baselines on both hobart and yellowstone + +=============================================================== +=============================================================== + +Tag name: cam5_4_131 +Originator(s): cacraig +Date: June 8, 2017 +One-line Summary: Add two missing files for F2000 use case which should be in cam5_4_130 + +Purpose of changes: + - Inadvertently committed cam5_4_130 without two files needed to + correctly build the F2000 compset. Added these files + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/usermods_dirs/f2000/user_nl_cam +A components/cam/cime_config/usermods_dirs/f2000/user_nl_clm + - set namelists to match Cecile's 163 run + +List all existing files that have been modified, and describe the changes: + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: not run + +yellowstone/intel/aux_cam: all PASS (was run with this configuration, but + what was committed did not allow to reproduce these results) + +hobart/nag: not run + +hobart/pgi: not run + +Reran the special tests comparing F2000 and FHIST with Cecile's 163 run and they + continue to be BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_130 +Originator(s): cacraig, hannay, fvitt +Date: June 6, 2017 +One-line Summary: update to cesm2_0_alpha06m and match Cecile's 163 FHIST and F2000 runs + +Purpose of changes: + - update externals to cesm2_0_alpha06m (CLM was moved to one tag newer due to bug) + - Make changes to have runs match Cecile's 163 FHIST and F2000 runs + - bug fix for misplaced mpi_bcast call + - change f45_f45_mg17 to f45_f45_mg37 per Chris Fischer's request + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/usermods_dirs/f2000/shell_commands + - turn on crop and irrigation + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cesm2_0_alpha06m + - update to CLM r243 due to bug in r242 + +M components/cam/bld/build-namelist + - add new surface SO2 bb emission file and delete SO2 bb vertical emission file + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - update emission files to match Cecile's 163 run + +M components/cam/cime_config/config_component.xml + - add usermods for FHIST and F2000 + +M components/cam/cime_config/config_compsets.xml + - delete user_mods for fhist (moved to config_component) + - add REFCASE for F2000 + - update REFCASE for FHIST + +M components/cam/cime_config/testdefs/testlist_cam.xml + - change f45_f45_mg17 to f45_f45_mg37 per Chris Fischer's request + +M components/cam/cime_config/usermods_dirs/fhist/shell_commands + - remove SSTICE file and set CISM_OBSERVED_IC to false + +M components/cam/cime_config/usermods_dirs/fhist/user_nl_cam + - update to Cecile's 163 emission files + **NOTE** this includes 2 files in emmons directory as they sort + differently if they are replaced with the files in inputdata and + the answers change + +M components/cam/cime_config/usermods_dirs/fhist/user_nl_clm + - change a few CLM namelist settings to match Cecile's run + +M components/cam/src/chemistry/mozart/mo_extfrc.F90 +M components/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - sort the filenames so that emission files are always read in the same order + regardless of the order they are specified in the namelist (preserves BFB) + +M components/cam/src/dynamics/tests/inic_analytic.F90 + - move mpi_bcast call earlier to eliminate a bug found in CESM testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Tue Jun 6 02:41:01 MDT 2017 + - Changes are due to new emission files + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Tue Jun 6 04:29:57 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Tue Jun 6 04:31:39 MDT 2017 + - continued failing tests - in previous tag + +yellowstone/intel/aux_cam: all NLCOMP and BASELINE fail due to new emission files + + SMS_D_Ln9.f19_f19_mg17.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.yellowstone_intel.cam-outfrq9s RUN time=334 + - continued failing tests - in previous tag + +hobart/nag: all BFB except: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Tue Jun 6 15:06:57 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Tue Jun 6 15:10:47 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Tue Jun 6 15:14:48 MDT 2017 + +hobart/pgi: all BFB + +Additional tests run: + FHIST_DEV - BFB result: ran one month and compared with + Cecile's /glade/p/cesmdata/cseg/runs/cesm2_0/f.e20.FHIST.f09_f09.163_02 + + F2000_DEV - BFB result: ran one month and compared with + Cecile's /glade/p/cesmdata/cseg/runs/cesm2_0/f.e20.F2000.f09_f09.163 + +=============================================================== +=============================================================== + +Tag name: cam5_4_129 +Originator(s): cacraig, hannay, katec, sacks +Date: May 27, 2017 +One-line Summary: Match Cecile's 157 run and make FHIST_DEV compset + +Purpose of changes: + - Made code and namelist modifications to match Cecile's 157 run + - Create FHIST_DEV which matches Cecile's 157 run + - Included changes needed to fix CAM standalone tests (from Bill Sacks) + - IMPORTANT NOTE -- To match Cecile's run, various externals were regressed + -- Aquaplanet compsets will NOT work properly with this tag + This will be fixed when the external are updated in a future tag + - adds _mg17 version to all grid designators in the CESM testlist + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - micro_do_sb_physics - now defaults to true for MG2 and later + - emission files are updated to match what Cecile used in 157 + - dust_emis_fact is now defaulting to 0.7 for CAM6 + - prescribed_strataero_use_chemtrop now defaults to false + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/usermods_dirs/fhist +A components/cam/cime_config/usermods_dirs/fhist/shell_commands +A components/cam/cime_config/usermods_dirs/fhist/user_nl_cam +A components/cam/cime_config/usermods_dirs/fhist/user_nl_clm + - Added directives needed to simulate Cecile's 157 run + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - Set the externals to the ones which Cecile was using in her 157 run + +M components/cam/bld/build-namelist + - Added logic to allow multiple files per emission file species + - micro_do_sb_physics now keys off of the MG version and defaults to true for version 2 or greater + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Update the topo file to the one which contains the metadata + - Add CAM emission files to match ones used by Cecile in run 157 + - Update the soil_erod file used if not CAM4 or CAM5 + - prescribed_strataero_use_chemtrop is set to false + - dust_emis_fact is now set to 0.7 for CAM6 + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - removed bnd_topo, dust_emis_fact and micro_do_sb_physics from use_case + +M components/cam/cime_config/config_component.xml + - moved Description section to top of file + +M components/cam/cime_config/config_compsets.xml + - Change FHIST_DONOTUSE to FHIST_DEV as it now reflects Cecile's run + - get rid of "grid=g%gland" at Jim Edward's request + +M components/cam/cime_config/testdefs/testlist_cam.xml + - Major reorganization of testlist + - Add FHIST_DEV test + - add _mg17 version to all grids + +M components/cam/src/dynamics/fv/mapz_module.F90 + - add missing 0.5 factor to two equations + +M components/cam/test/system/test_driver.sh + - temporarily remove the queue setting from the cesm submit + +M components/cam/test/unit/CMakeLists.txt +M components/cam/test/unit/README.txt + - bug fixes supplied by Bill Sacks + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +010 bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s .................................................FAIL! rc= 7 at Sat May 27 18:58:58 MDT 2017 +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Sat May 27 18:59:22 MDT 2017 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Sat May 27 19:01:31 MDT 2017 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Sat May 27 19:39:33 MDT 2017 +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Sat May 27 20:18:00 MDT 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Sat May 27 20:34:29 MDT 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Sat May 27 21:21:56 MDT 2017 +029 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Sat May 27 22:07:45 MDT 2017 + - all FV compsets will have answer changes due to change in mapz_module + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Sat May 27 22:22:18 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Sat May 27 22:23:38 MDT 2017 + - continuing failures + +yellowstone/intel/aux_cam: all baselines FAIL due to changes in namelist settings + +hobart/nag: all BFB except: +013 bl221 TBL.sh f10spsaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Sat May 27 16:12:28 MDT 2017 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Sat May 27 16:18:36 MDT 2017 +024 bl318 TBL.sh f10c4aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Sat May 27 16:29:19 MDT 2017 +027 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Sat May 27 16:33:32 MDT 2017 +033 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Sat May 27 16:37:37 MDT 2017 +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Sat May 27 16:45:05 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Sat May 27 16:48:47 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Sat May 27 16:52:39 MDT 2017 +045 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Sat May 27 17:00:08 MDT 2017 +048 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Sat May 27 17:09:29 MDT 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Sat May 27 17:19:22 MDT 2017 + - all FV compsets will have answer changes due to change in mapz_module + +hobart/pgi: +011 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Sat May 27 16:47:01 MDT 2017 +014 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Sat May 27 16:54:31 MDT 2017 +017 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s .................................................FAIL! rc= 7 at Sat May 27 17:05:15 MDT 2017 +020 bl320 TBL.sh f10c5aqpbadm rad_diag 9s .....................................................FAIL! rc= 7 at Sat May 27 17:11:59 MDT 2017 +023 bl321 TBL.sh f10c5aqcdm atrain 9s .........................................................FAIL! rc= 7 at Sat May 27 17:14:33 MDT 2017 +026 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Sat May 27 17:23:01 MDT 2017 +029 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Sat May 27 17:27:50 MDT 2017 + - all FV compsets will have answer changes due to change in mapz_module + +Summarize any changes to answers, i.e., +- what code configurations: all FV +- what platforms/compilers: any +- nature of change (roundoff; larger than roundoff but same climate; new + climate): matches Cecile's 157 run + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +command which duplicates Cecile's 157 run: + ./create_newcase --case compset_n02_try18 --compset FHIST_DEV --res f09_f09_mg17 --run-unsupported + +Compared one month of data with her run and they were BFB except for three WD diagnostic fields due to cam5_4_124 + +=============================================================== +=============================================================== + +Tag name: cam5_4_128 +Originator(s): eaton +Date: Mon May 22 16:47:46 MDT 2017 +One-line Summary: update configure and build-namelist for CAM6; fixes for AM mods + +Purpose of changes: + +. Implement '-phys cam6' option to configure. This was previously + implemented with '-phys cam5.5'. + +. Substantial cleanup in both configure and build-namelist. Remove code + that supported the F compset configurations from the standalone build. + Only aquaplanet, simple models, scam, and offline drivers are currently + supported with the standalone build. + +. Remove SLD dycore option. + +. Aquaplanet mode is now the default configuration with any of the full + physics packages, i.e. with cam3, cam4, cam5, or cam6. + +. Aquaplanet mode is the default when running PORT in standalone mode. The + previous default was to use the stub ocean. + +. The default for prescribed aerosols is set to bulk (bam). The option of + prescribed modal aerosols still exists, but this functionality was never + fully implemented. + +. Fixed logic in several namelist readers to avoid errors when the required + namelist group is missing. This enables changes in build-namelist + designed to avoid writing namelist groups for parameterizations which are + not being used. + +. Modify the optional code for angular momemtum conservation to remove all + memory and computational overhead when the option is not being used. + + +Bugs fixed (include bugzilla ID): + +. fix memory leak introduced with AM conservation mods in cam5_4_123. + +. in nucleate_ice_cam.F90 + - add ".and. clim_modal_aero" to conditional at line 759 to protect from + using the uninitialized array num_accum. The error condition occured + when using bulk aerosols. + +Describe any changes made to build system: + +. configure option "-phys cam5.4" has been removed. +. configure option "-phys cam5.5" has been replaced by "-phys cam6" +. add switch "-noclubb_sgs" to allow turning off clubb which is turned on + by default with cam6 physics. +. configure option "-dyn sld" has been removed. +. configure options -nthreads and -ntasks have been removed (they were only + needed for the cice configuration) + +Describe any changes made to the namelist: + +. Doing a better job of not putting namelist groups into atm_in which are + not used. More to do on this task. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. Some static memory use for the AM calc and diagnosics has been refactored + to be allocatable. Also put some unnecessary calculations inside + conditionals so only done when AM calc and diagnostics are enabled. This + was impacting only the FV dycore. + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/bld/config_files/defaults_eul.xml +components/cam/bld/config_files/defaults_fv.xml +components/cam/bld/config_files/defaults_se.xml +components/cam/bld/config_files/defaults_sld.xml +components/cam/bld/config_files/defaults_waccm.xml +components/cam/bld/config_files/defaults_waccm5.xml +components/cam/bld/config_files/defaults_waccmx.xml +components/cam/bld/config_files/defaults_waccmxie.xml +components/cam/bld/config_files/sys_defaults.xml +. these defaults now set internally in configure + +components/cam/src/dynamics/sld/basiz.F90 +components/cam/src/dynamics/sld/commap.F90 +components/cam/src/dynamics/sld/comspe.F90 +components/cam/src/dynamics/sld/comsta.h +components/cam/src/dynamics/sld/courlim.F90 +components/cam/src/dynamics/sld/depinc.F90 +components/cam/src/dynamics/sld/diag_dynvar_ic.F90 +components/cam/src/dynamics/sld/dp_coupling.F90 +components/cam/src/dynamics/sld/dycore.F90 +components/cam/src/dynamics/sld/dyn.F90 +components/cam/src/dynamics/sld/dyn_comp.F90 +components/cam/src/dynamics/sld/dyn_grid.F90 +components/cam/src/dynamics/sld/dyndrv.F90 +components/cam/src/dynamics/sld/dynpkg.F90 +components/cam/src/dynamics/sld/etadt0.F90 +components/cam/src/dynamics/sld/etadtn.F90 +components/cam/src/dynamics/sld/grcalc.F90 +components/cam/src/dynamics/sld/grmult.F90 +components/cam/src/dynamics/sld/hdinti.F90 +components/cam/src/dynamics/sld/hordif.F90 +components/cam/src/dynamics/sld/interp_mod.F90 +components/cam/src/dynamics/sld/linemsdyn.F90 +components/cam/src/dynamics/sld/nmmatrix.F90 +components/cam/src/dynamics/sld/nunv1.F90 +components/cam/src/dynamics/sld/pmgrid.F90 +components/cam/src/dynamics/sld/prognostics.F90 +components/cam/src/dynamics/sld/pspect.F90 +components/cam/src/dynamics/sld/quad.F90 +components/cam/src/dynamics/sld/realloc4.F90 +components/cam/src/dynamics/sld/realloc7.F90 +components/cam/src/dynamics/sld/restart_dynamics.F90 +components/cam/src/dynamics/sld/scan2.F90 +components/cam/src/dynamics/sld/scandyn.F90 +components/cam/src/dynamics/sld/scanslt.F90 +components/cam/src/dynamics/sld/settau.F90 +components/cam/src/dynamics/sld/sld_control_mod.F90 +components/cam/src/dynamics/sld/sltint.F90 +components/cam/src/dynamics/sld/spegrd.F90 +components/cam/src/dynamics/sld/spetru.F90 +components/cam/src/dynamics/sld/spmd_dyn.F90 +components/cam/src/dynamics/sld/stats.F90 +components/cam/src/dynamics/sld/stepon.F90 +components/cam/src/dynamics/sld/tfilt_massfix.F90 +components/cam/src/dynamics/sld/tricoef.F90 +components/cam/src/dynamics/sld/trisolve.F90 +components/cam/src/dynamics/sld/tstep.F90 +components/cam/src/dynamics/sld/tstep1.F90 +components/cam/src/dynamics/sld/vertnm.F90 +. remove SLD dycore + +components/cam/src/physics/cam/radconstants.F90 +. moved to physics/simple/ + +components/cam/test/system/config_files/f0.9c5.4dh +components/cam/test/system/config_files/f1.9c5.4wtclbdh +components/cam/test/system/config_files/f1.9c5.4wtclbh +. unused + +components/cam/test/system/nl_files/outfrq3s_bam +. the default for prescribed aerosols has been changed to bulk, so the + explicit setting in this file is not needed. + + +List all subroutines added and what they do: + +components/cam/src/physics/simple/radconstants.F90 +components/cam/src/physics/simple/radiation.F90 +. dummy modules so don't need to compile a radiation pkg when using simple + physics + +components/cam/src/physics/spcam/spcam_drivers.F90 +. moved the actual driver code here from physics/cam/. Put a stub + module in physics/cam/. + + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +. remove clm, cice, rtm functionality +. don't look for nthreads in config_cache.xml +. move defaults for analytic_ic_type to the defaults file +. add conditionals to avoid adding namelist groups for packages that aren't + used by the specified configuration. +. change the default prescribed aerosols to bulk +. add default for use_simple_phys (in phys_ctl_nl) + +components/cam/bld/config_files/definition.xml +. add 'cam6' to values for 'phys', remove 'cam5.4' +. add 'none' to values for microphys +. add 'none' to values for pbl +. add 'none' to values for rad +. remove lnd, rof, ice, cice_*, ntasks, nthreads + +components/cam/bld/config_files/horiz_grid.xml +. remove SLD entries + +components/cam/bld/configure +. add ability to turn clubb off (-noclubb_sgs). +. remove -comp_intf (no longer used) +. remove "-dyn sld" option +. add -macrophys to specify non-default macrophysics +. add '-phys cam6' and remove both cam5.4 and cam5.5 options +. remove cice options. Also remove -nthreads and -ntasks which were only + there for the cice configuration. +. remove -ice, -lnd, -rof. +. remove -defaults option. This option was not widely used, and was + fragile to begin with. It's not needed. +. move the defaults that were being set by the files in + config_files/defaults_*.xml and config_files/sys_defaults.xml into the + configure script. These small files caused more confusion than clarity. + - removal of these defaults files allows moving the setting of the + default chemisty and physics packages to after the config object is + initialized. + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. add defaults for analytic_ic_type +. fix use_topo_file attribute match for aquaplanet +. update attribute matching for cam6 +. add default of NONE for microp_scheme, eddy_scheme, deep_scheme, + shallow_scheme +. remove entries for CLM + +components/cam/bld/namelist_files/namelist_definition.xml +. add use_simple_physics + +components/cam/cime_config/buildcpp +. remove '-comp_inft mct' from configure args + +components/cam/cime_config/config_component.xml +. update CAM_CONFIG_OPTS to use cam6 instead of 'cam5.4 -clubb_sgs' + +components/cam/src/chemistry/aerosol/wetdep.F90 +. update cam_physpkg_is args from cam5.4 to cam6 + +components/cam/src/chemistry/utils/solar_data.F90 +. solar_data_readnl + - add early return for use_simple_phys + +components/cam/src/dynamics/fv/cd_core.F90 +. change automatic arrays used by am code to allocatable + +components/cam/src/dynamics/fv/ctem.F90 +. returned to its original use for TEM diagnostics. Remove the diagnostics + added for angular momentum. + +components/cam/src/dynamics/fv/diag_module.F90 +. AM diagnostics which had been added to ctem.F90 are now here. + +components/cam/src/dynamics/fv/dp_coupling.F90 +. d_p_coupling + - fix memory leak introduced with AM fixer mods + - restore the original call to ctem_diags inside do_circulation_diags + - call fv_diag_am_calc inside fv_am_diags conditional + +components/cam/src/dynamics/fv/dyn_comp.F90 +. cleanup AM diagnostics so all associated allocation and calculations are + inside appropriate conditionals. + +components/cam/src/dynamics/fv/dynamics_vars.F90 +. fix comment + +components/cam/src/dynamics/fv/sw_core.F90 +. at line 1272 set uc to D1E30 as it was in cam5_4_122 + +components/cam/src/dynamics/fv/te_map.F90 +. change dummy args uc, vc to allocatable. +. only call map1_ppm on uc, vc inside am_diag_lbl conditional + +components/cam/src/dynamics/tests/inic_analytic.F90 +. analytic_ic_readnl + - reworked logic so it is assumed that when the -analytic_ic flag is + specified to configure, then build-namelist will supply the + analytic_ic_nl group. If the namelist group is not found then just + return. Otherwise do the checking that the analytic_ic_type value has + been changed from its default of 'none' to a valid value. + +components/cam/src/physics/cam/beljaars_drag_cam.F90 +. beljaars_drag_readnl + - fix logic so it's not an error for the blj_nl namelist group to be + missing. + +components/cam/src/physics/cam/chem_surfvals.F90 +. chem_surfvals_init + - just return if using simple physics + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. update cam_physpkg_is args from cam5.4 to cam6 + +components/cam/src/physics/cam/dadadj_cam.F90 +. dadadj_readnl + - don't write log info when using simple physics + +components/cam/src/physics/cam/flux_avg.F90 +. removed old debug code + +components/cam/src/physics/cam/gw_drag.F90 +. gw_drag_readnl + - just return if using simple physics + +components/cam/src/physics/cam/hb_diff.F90 +. removed old debug code + +components/cam/src/physics/cam/micro_mg_cam.F90 +. add default for namelist var microp_uniform + +components/cam/src/physics/cam/microp_driver.F90 +. microp_driver_readnl +. microp_driver_implements_cnst + - add case selector for microp_scheme='NONE' + +components/cam/src/physics/cam/nucleate_ice_cam.F90 +. nucleate_ice_cam_calc + - add ".and. clim_modal_aero" to conditional at line 759 to protect from + using the uninitialized array num_accum + +components/cam/src/physics/cam/phys_control.F90 +. add use_simple_phys + +components/cam/src/physics/cam/pkg_cld_sediment.F90 +. cld_sediment_readnl + - don't write log info if using simple physics + +components/cam/src/physics/cam/rad_constituents.F90 +. rad_cnst_readnl + - just return if using simple physics + + +components/cam/src/physics/cam/rayleigh_friction.F90 +. rayleigh_friction_readnl + - just return if using simple physics + +components/cam/src/physics/cam/spcam_drivers.F90 +. this is a stub module. The drivers were moved to physics/spcam/. + +components/cam/src/physics/cam/tracers.F90 +. add initializer for test_tracer_num + +components/cam/src/physics/cam/trb_mtn_stress_cam.F90 +. trb_mtn_stress_readnl + - fix logic so it's not a error for the tms_nl group to be missing + +components/cam/src/physics/cam/zm_conv_intr.F90 +. zm_conv_init + - get rid of cam_physpkg_is conditional inside of history_budget + conditional + +components/cam/src/physics/carma/cam/carma_intr.F90 +. update cam_physpkg_is args from cam5.4 to cam6 + +components/cam/test/system/TBR.sh +components/cam/test/system/TER.sh +components/cam/test/system/TSM.sh +. remove cice args + +components/cam/test/system/TCB.sh +. remove -ntasks and -nthreads args to configure + +components/cam/test/system/TR8.sh +. remove path for dynamics/sld/ + +components/cam/test/system/config_files/f1.9c6aqcdh +components/cam/test/system/config_files/f1.9c6aqtsvbsdh +components/cam/test/system/config_files/f1.9c6aqwscdh +components/cam/test/system/config_files/f10c6aqdm +components/cam/test/system/config_files/f10c6aqt5mdm +components/cam/test/system/config_files/f10c6aqwmadm +components/cam/test/system/config_files/f4c6aqwmadm +components/cam/test/system/config_files/h16c6aqdm +. update cam5.5 to cam6 + +components/cam/test/system/input_tests_master +. remove SLD tests +. change outfrq3s_bam to outfrq3s +. update TEQ_ccsm aquaplanet tests to have the standalone runs use the + appropriate use case files. + +components/cam/test/system/nl_files/outfrq3s_am +. update namelist to get both the ctem diagnostics as well as the + additional AM diagnostics. + +components/cam/test/system/nl_files/rad_diag +. removed prescribed_aero_model='bulk'. That's the default. + +components/cam/test/system/tests_pretag_hobart_pgi +. remove SLD tests + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except +003 bl150 TBL.sh e64addh outfrq3s+dabi_p2004 9s ...............................................FAIL! rc= 7 at Sun May 21 13:33:00 MDT 2017 +006 bl151 TBL.sh e64hsdh outfrq3s+held_suarez_1994 9s .........................................FAIL! rc= 7 at Sun May 21 13:33:33 MDT 2017 +. diffs in co2vmr ch4vmr n2ovmr f11vmr f12vmr sol_tsi which are not used by + simple physics + +037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s .........................FAIL! rc= 7 at Sun May 21 17:05:53 MDT 2017 +039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase+aquaplanet_cam5 9s ........................FAIL! rc= 7 at Sun May 21 17:07:34 MDT 2017 +. These tests have been failing and need to be fixed. I suspect the + difference is in the SST. I see that the cesm version is now using docn + to supply the aquaplanet SSTs. Look into doing that for CAM standalone. + +043 bl012 TBL.sh f1.9c4portdh port_cam4 5d ....................................................FAIL! rc= 7 at Sun May 21 17:08:03 MDT 2017 +. PORT test has changed to use aquaplanet config. Checked old config by + hand to verify it was BFB. + +cheyenne/intel/aux_cam: + ERP_Ld3.f09_f09.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: FAIL) details: + FAIL ERP_Ld3.f09_f09.FWHIST.cheyenne_intel.cam-reduced_hist1d RUN time=35 + + ERS_Ln9.f10_f10.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERS_Ln9.f10_f10.FSPCAMS.cheyenne_intel.cam-outfrq9s RUN time=26 + + SMS_D_Ln9.f19_f19.FXHIST.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.f19_f19.FXHIST.cheyenne_intel.cam-outfrq9s MODEL_BUILD time=82 + +. These failures are pre-existing. + + SMS_Lm13.f09_f09.F2000_DEV.cheyenne_intel.cam-outfrq1m_clm5 (Overall: FAIL) details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.cheyenne_intel.cam-outfrq1m_clm5 RUN time=10871 + +. This is a time limit. The test on cheyenne is only getting enough + resource to get through about 3 months of simulation. I compared the h0 + files for the first 3 months by hand and they are BFB. + + +hobart/nag: All PASS except +031 bl335 TBL.sh f10idm idphys 9s .............................................................FAIL! rc= 7 at Sat May 20 13:33:43 MDT 2017 +. diffs in co2vmr ch4vmr n2ovmr f11vmr f12vmr sol_tsi which are not used by + simple physics + +053 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Sat May 20 14:17:12 MDT 2017 +. PORT test has changed to use aquaplanet config. Checked old config by + hand to verify it was BFB. + +hobart/pgi: All PASS except +029 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Sat May 20 14:27:26 MDT 2017 +. diffs in co2vmr ch4vmr n2ovmr f11vmr f12vmr which are not used in + simple physics. +032 bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s ......................................FAIL! rc= 7 at Sat May 20 14:34:36 MDT 2017 +. Checked baselines by hand due to change of nl file from outfrq3s_bam + to outfrq3s. They are BFB. + + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_126 + +Summarize any changes to answers: BFB + +. The baseline failures were all due either to changes in diagnostic output + or to changes in test definitions. + +. The aux_cam tests were done on cheyenne instead of yellowstone due to + overspent projects and runs sitting in standby. + The failures are pre-existing except the 13 month run which is + running into a time limit on cheyenne. But the 13 month run is BFB for + the first 3 months. + +=============================================================== +=============================================================== + +Tag name: cam5_4_127 +Originator(s): Kate T-C +Date: May 19, 2017 +One-line Summary: Remove WACCMX_EDYN from config_component and + define docn sstice files in CAM rather than CIME (since these + are CESM-specific). + +Purpose of changes: To support continued CIME/DOCN development and to ensure + consistancy through the models. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all existing files that have been modified, and describe the changes: + +M components/cam/cime_config/config_compsets.xml + - SSTICE_DATA_FILENAME and SSTICE_GRID_FILENAME updated with values + that were previously in docn, but are cesm specific so don't belong + there. + - WACCMX_EDYN no longer needed and removed + - CLM_NAMELIST_OPTS that are no longer needed removed + +M components/cam/cime_config/config_component.xml + - removed whitespace + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Cheyenne/intel/aux_cam: + Note: Per Mvertenstein, only Cheyenne cam-aux tests should be run. + **This means that cam5_4_128 tests should use cam5_4_126 baselines.** + SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s + - FAIL SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s MODEL_BUILD time=52 + ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s + - FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=20 + ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d + - FAIL ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d RUN time=38 + These are the same test failures as in cam5_4_126. + +=============================================================== +=============================================================== + +Tag name: cam5_4_126 +Originator(s): Cheryl Craig, Kate T-C +Date: May 15, 2017 +One-line Summary: CESM-aquaplanet is now supported out-of-the-box via prescribed-SST (QPCx) and slab-ocean (QSCx) compsets (where x is CAM version). + +Purpose of changes: + + Several user-required configuration and source code changes from the +CESM1-aquaplanet are no longer needed for CESM2-aquaplanet setup. Additionally, +the default CESM2-aquaplanet setup is more consistent with the standard Aqua +Planet Experiment (APE) protocol. The new CESM2-aquaplanet configuration has the +following updates: +* CESM2-aquaplanet compsets now automatically set correct land/ocean grid domains +and masking; zero orography; standard aquaplanet atmosphere initialization file; +and standard APE time-constant orbital parameters (zero obliquity and +eccentricity, orb_mode = fixed parameters) and greenhouse gas concentations for +both QPCx prescribed- (a.k.a. analytic-) SST and QSCx slab-ocean configurations. +* Stub sea-ice (SICE) is used by default for QPCx and QSCx aquaplanet compsets. +* For QPCx and QSCx compsets with either CAM5 or CAM6 physics, all aerosols except +sea salt are removed and constant cloud droplet and ice crystal number +concentrations are used. +* Prescribed-SST aquaplanet version (QPCx) defaults to "QOBS" SST profile, though +users can opt for one of nine other stock SST profiles or create their own +* The prescribed-SST pattern can also be supplied via a customized input data file +* The docn.streams.txt.som file (provides SOM forcing and boundary conditions) for +compset QSCx defaults to a 30m oceanic slab depth and a 0 q-flux globally. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +A components/cam/bld/namelist_files/use_cases/aquaplanet_cam6.xml + - use case for CAM6 aquaplanet +A components/cam/cime_config/usermods_dirs/aquap/user_nl_cpl + - set orbital parameters specifically for aquaplanet runs + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES + - update to newer cime and cime-config tag to support usermods_dirs + - update to new cism trunk tag required by newest cime tag + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - have topo file key off of the aquaplanet setting + - introduced zeroed out vegetation file + +M components/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml + - turn off volcanos + +M components/cam/bld/namelist_files/use_cases/aquaplanet_cam4.xml + - turn off volcanos and do not use topo file + +M components/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml + - various settings for CAM5 aquaplanet + +M components/cam/cime_config/config_component.xml + - change ways to designate aquaplanet runs in the long compset names + - add CAM_USER_MODS to specify the usermods_dirs needed by aquaplanet runs + +M components/cam/cime_config/config_compsets.xml + - rename aquaplanet compsets to use QPCx or QSCx designators + +M components/cam/cime_config/testdefs/testlist_cam.xml + - rename compsets from FC5AQUAP -> QPC5, added tests for QPC6 and QSC6 + +M components/cam/test/system/input_tests_master + - rename ccsm compsets from FC5AQUAP -> QPC5 (and similarly for FC4AQAUP) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + baseline comparisons fail (due to new depvel_lnd_file) in + 015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d + 017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s + 020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s + 023 bl380 TBL.sh f1.9c6aqcdh atrain 9s + + These tests need to be fixed to match updated compsets. + 037 eq991 TEQ_ccsm.sh f19_f19 QPC4 f1.9c4aqh fcase 9s + 039 eq993 TEQ_ccsm.sh ne16_ne16 QPC5 h16c5aqh fcase 9s + +yellowstone/intel/aux_cam: + SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s + - FAIL SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + - FAIL SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s MODEL_BUILD time=52 + ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s + - FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=20 + ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d + - FAIL ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d RUN time=38 + Run failures for SPCAM and WACCMX are pre-existing due to CLM version + +hobart/nag: + baseline comparisons fail (due to new depvel_lnd_file) in + 005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s + 017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s + 027 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s + 033 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s + 036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s + 039 bl368 TBL.sh f10c6aqdm outfrq3s 9s + 042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s + 048 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s + 051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s + +hobart/pgi: + baseline comparisons fail (due to new depvel_lnd_file) in + 011 bl222 TBL.sh f10spmaqdm outfrq3s 9s + 017 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s + 023 bl321 TBL.sh f10c5aqcdm atrain 9s + 026 bl334 TBL.sh f10c5aqudm outfrq3s 9s + 032 bl511 TBL.sh s8c5aqt5mdm ttrac 9s + 036 bl712 TBL.sh h5c5aqbamdm outfrq3s_bam+aquaplanet_cam5 9s + +=============================================================== +=============================================================== + +Tag name: cam5_4_125 +Originator(s): fvitt, joemci +Date: 12 May 2017 +One-line Summary: Provide capability to send nitrogen deposition fluxes to surface models and WACCMX compset updates + +Purpose of changes: + + Provide capability to send nitrogen deposition fluxes to surface models. + This can be turned on by setting ndep_list in drv_flds_in which is read by + the driver. + + Update WACCMX compsets. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + . add ndep_inparm namelist group to drv_flds_in + +M components/cam/bld/namelist_files/namelist_definition.xml + . new namelist variable "ndep_list" which will be in ndep_inparm namelist group to drv_flds_in + +M components/cam/src/cpl/cam_cpl_indices.F90 +M components/cam/src/control/camsrfexch.F90 + . add noy and nhx nitrogen deposition flux arrays to cam_out object + +M components/cam/src/cpl/atm_import_export.F90 + . export noy and nhx nitrogen deposition fluxes + +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 + . set the noy and nhx nitrogen deposition fluxes in cam_out object + . WD_NOY --> wet_deposition_NOy_as_N + . WD_NHX --> wet_deposition_NHx_as_N + . DF_NOY --> dry_deposition_NOy_as_N + . DF_NHX --> dry_deposition_NHx_as_N + +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + . set the noy and nhx nitrogen deposition fluxes in cam_out object + +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + . change comment + WD_NOY --> wet_deposition_NOy_as_N + WD_NHX --> wet_deposition_NHx_as_N + +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml + . WD_NOY --> wet_deposition_NOy_as_N + . WD_NHX --> wet_deposition_NHx_as_N + . DF_NOY --> dry_deposition_NOy_as_N + . DF_NHX --> dry_deposition_NHx_as_N + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - updates for waccmx compsets + +M components/cam/src/ionosphere/waccmx/edyn_init.F90 +M components/cam/src/ionosphere/waccmx/edynamo.F90 +M components/cam/src/physics/cam/cam_diagnostics.F90 +M components/cam/src/physics/cam/tidal_diag.F90 +M components/cam/src/physics/waccm/radheat.F90 +M components/cam/src/physics/waccmx/ion_electron_temp.F90 + - added diagnostics + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all pass + +yellowstone/intel/aux_cam: + + ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=16 + SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.f19_f19.FXHIST.yellowstone_intel.cam-outfrq9s RUN time=118 + SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAI≈ßL) details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + + Run failures for SPCAM and WACCMX are pre-existing due to CLM version + + Change in electron_file is the cause of namelist compare failures for WACCM, + otherwise waccm is bit-for-bit unchanged. + +hobart/nag: all pass + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_124 +Originator(s): fvitt +Date: 9 May 2017 +One-line Summary: Misc WACCM bug fixes and compset updates + +Purpose of changes: + +WACCM updates: + - bug fix for EUV photolysis rates -- computed photolysis and heating rates + should not be dependent on the order of EUV reactions in chemistry mechanism file + - explicitly account for this NH3 loss as an NH4 gain in modal gas/aerosol exchange + - chemistry preprocessor changes + . increase the length of the reaction tag names - this fixes a bug where some of + the reaction tag names were truncated effectively disabling the corresponding + user reactions + . fix bug in vectorized solver -- change in vector length should not change results + - updated chemistry mechanisms for WACCM and CAM-Chem + - updated WACCM and cam-chem compsets -- update emissions, IC files, history streams, etc. + +Bug fix for WACCM-SC: + - fix issue where prescribed H was being confused with NO + +Bug fix for WACCM-X: + - initialize waccmx ionosphere sooner to avoid restart problem when history includes + fields decomposed on geo-magnetic grid -- history need to know about the geo-magnetic + grid earlier in a restarted run + +Misc changes: + - added history flags + . history_chemspecies_srf + . history_cesm_forcing + . history_scwaccm_forcing + - units change in wet deposition flux (WD_*) diagnostics + - misc code clean up + - do not include tgcm_ubc_file and snoe_ubc_file namelist vars for WACCM-X + configurations -- this need for WACCM only + - regression tests updates + +Bugs fixed (include bugzilla ID): see above + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +D components/cam/src/chemistry/modal_aero/bam_nh4no3.F90 + - remove this dead code + +D components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml +D components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam6.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam6.xml + - replaced 'amip' with 'hist' in the file name + +D components/cam/test/system/config_files/f4c5.4wtclbdm +D components/cam/test/system/config_files/f4c4prgspcdm +D components/cam/test/system/config_files/f1.9c4bamm + - replaced by aquaplanet configuration files + +List all subroutines added and what they do: + +A components/cam/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml + - replaced 'amip' with 'hist' in the file name + +A components/cam/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +A components/cam/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +A components/cam/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml + - added for new cam-chem compsets + +A components/cam/test/system/config_files/f4c5.5aqwmtdm +A components/cam/test/system/config_files/f1.9c4aqbamm +A components/cam/test/system/config_files/f4c4aqprgspcdm + - these include aquaplanet config option + +List all existing files that have been modified, and describe the changes: + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - chemistry preprocessor changes + . increase the length of the reaction tag names + . fix bug in vectorized solver -- change in vector length should not change results + +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 + - updated chemistry mechanism + - increase the length of the reaction tag names + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 + - updated chemistry mechanism + - increase the length of the reaction tag names + +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_sc/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_terminator/chem_mods.F90 +M components/cam/src/chemistry/pp_terminator/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 + - increase the length of the reaction tag names, otherwise the chemistry has not changed + +M components/cam/src/chemistry/mozart/chemistry.F90 + - invoke add_default for history_cesm_forcing flag + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - invoke add_default for history_cesm_forcing flag + - code cleanup + +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 + - correction in NOy diagnostic to include 'PBZNIT' + - invoke add_default for history flags + . history_chemspecies_srf + . history_cesm_forcing + . history_scwaccm_forcing + +M components/cam/src/chemistry/mozart/mo_extfrc.F90 + - invoke add_default for history_cesm_forcing flag + - add vertically integrated external forcing diagnostic (kg/m2/sec) + +M components/cam/src/chemistry/mozart/mo_lightning.F90 + - invoke add_default for history_cesm_forcing flag + +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - units change in wet deposition flux (WD_*) diagnostics + +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + - code clean up + +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - add rates for 'TS1' chemistry + - code clean up + +M components/cam/src/chemistry/mozart/mo_photo.F90 +M components/cam/src/chemistry/mozart/mo_jeuv.F90 + - bug fix for EUV photolysis rates -- computed photolysis and heating rates + should not be dependent on the order of EUV reactions in chemsitry mechanism file + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - invoke add_default for history_cesm_forcing flag + - explicitly account for this NH3 loss as an NH4 gain. + Because the NH3->NH4 on aerosols is actually already + taken into account that way, we don't need to have the call to + bam_nh4no3_formation. + +M components/cam/src/chemistry/utils/mo_solar_parms.F90 + - fix problem when solar data includes leap day and the calendar is set to noleap + +M components/cam/src/dynamics/fv/ctem.F90 + - invoke add_default for history_waccm flag + +M components/cam/src/control/cam_comp.F90 + - initialize waccmx ionosphere sooner to aviod restart + problem when history includes fields decomposed on + geo-magnetic grid -- history need to know about the + geo-magnetic grid sooner in a restarted run + +M components/cam/src/physics/waccm/waccm_forcing.F90 + - code clean up + - sc-waccm bug fix -- prescribed H was being confused with NO + +M components/cam/src/physics/waccm/nlte_lw.F90 + - code clean up + +M components/cam/src/physics/waccm/radheat.F90 + - invoke add_default for history_scwaccm_forcing flag + +M components/cam/src/physics/cam/phys_control.F90 + - added history flags + . history_chemspecies_srf + . history_cesm_forcing + . history_scwaccm_forcing + +M components/cam/src/physics/cam/modal_aer_opt.F90 + - change defaults for history_amwg flag + +M components/cam/src/physics/cam/cam_diagnostics.F90 +M components/cam/src/physics/cam/gw_drag.F90 + - change defaults for history_waccm flag + +M components/cam/src/physics/cam/nucleate_ice_cam.F90 + - invoke add_default for history_cesm_forcing flag + +M components/cam/src/physics/cam/tidal_diag.F90 + - invoke add_default for history_waccm flag + +M components/cam/src/physics/cam/check_energy.F90 + - invoke add_default for history_waccm flag + + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - add default setting for history_chemspecies_srf flag + +M components/cam/bld/build-namelist + - camchem trop-strat VBS LBC and emissions the same as waccm TSMLT + - do not include tgcm_ubc_file and snoe_ubc_file namelist vars for WACCM-X + configurations -- this need for WACCM only + - add default setting for history_chemspecies_srf flag + +M components/cam/bld/namelist_files/namelist_definition.xml + - added history flags + . history_chemspecies_srf + . history_cesm_forcing + . history_scwaccm_forcing + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_pes.xml +M components/cam/cime_config/config_compsets.xml + - compset updates + +M components/cam/cime_config/testdefs/testlist_cam.xml +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam + - add geo-magnetic grid decomposed history fields + +M components/cam/test/system/tests_waccm_mpi +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_chem_mpi + - regression tests updates + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s ..................................................FAIL! rc= 7 at Tue May 9 12:49:24 MDT 2017 + - expected failure due to updates to trop_strat_mam4_vbs chemistry updates + +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_hist_cam6 9s ......................FAIL! rc= 7 at Tue May 9 13:26:58 MDT 2017 + - expected failure due to bug fix in sc-waccm (see above) + +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Tue May 9 12:10:29 MDT 2017 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Tue May 9 12:12:45 MDT 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Tue May 9 13:38:03 MDT 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Tue May 9 16:35:17 MDT 2017 +029 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Tue May 9 16:42:17 MDT 2017 +032 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Tue May 9 16:42:24 MDT 2017 + - climate is bit-for-bit unchanged -- baseline failures are due to units change in wet deposition flux (WD_*) diagnostics + +yellowstone/intel/aux_cam: CAM is B4B + + ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_123/ERP_Ld3.f09_f09.FWHIST.yellowstone_intel.cam-reduced_hist1d' does not exist + - new aux_cam test + + ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE + - NLCOMP failed due to added namelist variable "history_chemspecies_srf" + - BASELINE failed due to units change in wet deposition flux (WD_*) diagnostics + otherwise this is bit-for-bit unchanged + + ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE + - NLCOMP failed due to added namelist variable "history_chemspecies_srf" + - BASELINE failed due to units change in wet deposition flux (WD_*) diagnostics + otherwise this is bit-for-bit unchanged + + ERS_Ld3.f19_f19.FXREFC1.yellowstone_intel.cam-outfrq1d_newyear (Overall: FAIL) details: + FAIL ERS_Ld3.f19_f19.FXREFC1.yellowstone_intel.cam-outfrq1d_newyear NLCOMP + FAIL ERS_Ld3.f19_f19.FXREFC1.yellowstone_intel.cam-outfrq1d_newyear RUN time=42 + - fails due to issues with clm45 -- hopefully this will be resolved in future clm tag + + ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=16 + - pre-existing failure due to issues with clm + + SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE + - expected failure due to waccm compset updates + + SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF) details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + - NLCOMP failed due to added namelist variable "history_chemspecies_srf" + - BASELINE failed due to units change in wet deposition flux (WD_*) diagnostics + otherwise this is bit-for-bit unchanged + +hobart/nag: + +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Tue May 9 09:19:32 MDT 2017 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Tue May 9 09:37:41 MDT 2017 +027 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Tue May 9 09:53:15 MDT 2017 +033 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Tue May 9 09:57:30 MDT 2017 +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Tue May 9 10:03:00 MDT 2017 +039 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Tue May 9 10:05:57 MDT 2017 +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Tue May 9 10:09:02 MDT 2017 +045 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Tue May 9 10:17:10 MDT 2017 +048 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Tue May 9 10:27:15 MDT 2017 +051 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Tue May 9 10:37:53 MDT 2017 + - climate is bit-for-bit unchanged -- baseline failures are due to units change in wet deposition flux (WD_*) diagnostics + +hobart/pgi: + +014 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Tue May 9 10:13:41 MDT 2017 + - expected failure due to bug fix in sc-waccm (see above) + +017 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s .................................................FAIL! rc= 7 at Tue May 9 10:25:05 MDT 2017 +023 bl321 TBL.sh f10c5aqcdm atrain 9s .........................................................FAIL! rc= 7 at Tue May 9 10:34:54 MDT 2017 +026 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue May 9 10:43:24 MDT 2017 +032 bl511 TBL.sh s8c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Tue May 9 10:56:06 MDT 2017 + - climate is bit-for-bit unchanged -- baseline failures are due to units change in wet deposition flux (WD_*) diagnostics + +=============================================================== +=============================================================== + +Tag name: cam5_4_123 +Originator(s): thomas.toniazzo@uni.no, cacraig +Date: May 8, 2017 +One-line Summary: Angular momentum mods and additional dynamic wind increment diagnostics + +Purpose of changes: +Purpose of changes: + - Angular momentum mods: + .correction or fixer increments no longer applied in first (top) four levels + .dycore correction: improved 2nd-order in time + .AM fixer: level fixer set as default, and tapering for global fixer + - Additional diagnostics of the dynamics wind increments + + +Bugs fixed (include bugzilla ID): + - corrected check for disallowing SPCAM being threaded to include sam1mom + - added initialization of cap3vc when high_alt is false + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/src/dynamics/fv/angular_momentum.F90 + - removed unused routine + +List all subroutines added and what they do: +A + components/cam/test/system/nl_files/outfrq3s_am + - added test turning on am_correction + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/configure + - Test for SPCAM threading was testing m2005 twice. Modified one + of these checks to be sam1mom + +M components/cam/cime_config/testdefs/testlist_cam.xml + - Removed most of the yellowstone tests. Kept the ones needed for CAM's + regression testing until we move testing over completely to cheyenne + - changed ERP test to ERS for SPCAM since it is not doing threading and + failed on yellowstone for an unknown reason (ERP passed on cheyenne) + +M components/cam/src/dynamics/fv/benergy.F90 + - add use for par_vecsum + +M components/cam/src/dynamics/fv/d2a3dikj.F90 + - made a module + +M components/cam/src/dynamics/fv/par_vecsum.F90 + - put into a module and added an optional return summation variable + +M components/cam/src/dynamics/fv/tp_core.F90 +M components/cam/src/dynamics/fv/trac2d.F90 + - removed obsolete INNER_OMP cpp directive + +M components/cam/src/dynamics/fv/cd_core.F90 +M components/cam/src/dynamics/fv/ctem.F90 +M components/cam/src/dynamics/fv/dp_coupling.F90 +M components/cam/src/dynamics/fv/dyn_comp.F90 +M components/cam/src/dynamics/fv/sw_core.F90 +M components/cam/src/dynamics/fv/te_map.F90 + - modifications as described in Purpose section + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_hobart_nag + - added test for am_correction + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: all BFB except continue failing until update CLM external: + ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=16 + +hobart/nag: all BFB except: +042 bl369 TBL.sh f10c6aqdm outfrq3s_am 9s .....................................................FAIL! rc= 7 at Fri May 5 19:09:07 MDT 2017 + -- New test - no baseline for comparison + +hobart/pgi: all BFB + +=============================================================== +=============================================================== +Tag name: cam5_4_122 +Originator(s): jet +Date: May 5, 2017 +One-line Summary: Update to SCAM code - refactor forecast routine, bug fixes + +Purpose of changes: + - Refactor the forecast routine of SCAM, better organized and more flexible. Misc bug fixes. + - added test for use of uninitialized variables + - updated scam defaults + - added more options for vertical advection scheme + - fixed bug in cam_pio_utils error in reading scam initial files. + - updated default testing to use ARM97 IOP. + - fixed errors when running adiabatically + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + Cleaned up namelist, removed non working and added new namelist variables to give user + more control over relaxation, what type of vertical advection is used for the prognostics + and which observed IOP variables are used in the forecast. + Removed: + scm_diurnal_avg + scm_iop_srf_prop + scm_clubb_iop_name + Added + scm_iop_lhflxshflxTg -- use iop latent/sensible/ground temp fluxes + scm_iop_Tg, -- use just ground temp fluxes + scm_cambfb_mode, -- set when using a cam generated IOP for bfb testing + scm_relax_top_p, -- set upper relaxation pressure limit + scm_relax_bot_p, -- set lower relaxation pressure limit + scm_relax_tau_sec, -- set relaxation constant + scm_relax_tau_top_sec, -- relaxation time at upper boundary + scm_relax_tau_bot_sec, -- relaxation time at lower boundary + scm_relax_linear, -- use a linear interpolation of relaxation time + between the upper and lower boundary relaxation time + scm_zadv_uv, -- vertical advection type for uv (valid values iop,eul,off) + scm_zadv_T, -- vertical advection type for T (valid values iop,eul,off) + scm_zadv_q, -- vertical advection type for q (valid values iop,eul,slt,off) + scm_use_obs_T, -- use IOP values of T for forecast + scm_use_obs_uv, -- use IOP values of uv for forecast + scm_use_obs_qv, -- use IOP values of qv for forecast + scm_force_latlon -- force scm to use given values of + lat/lon not closest from datasets + + + namelist relaxation example: + relax the atmosphere to obs between 20mb and 900mb + using a linear interpolation of the relaxation time throughout the + atmosphere ranging from 3hrs at the top to 1 day at the bottom + ==================================== + scm_relaxation = .true. + scm_relax_linear = .true. + scm_relax_bot_p = 90000. + scm_relax_tau_bot_sec = 86400. + scm_relax_tau_top_sec = 10800. + scm_relax_top_p = 2000. + + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by:goldy + +List all subroutines eliminated: + D components/cam/src/physics/cam/iop_surf.F90 + D components/cam/src/dynamics/eul/forecast.F90 + +List all subroutines added and what they do: + A components/cam/src/physics/cam/iop_forcing.F90 replaced iop_surf.F90 + A components/cam/src/dynamics/eul/scmforecast.F90 modularized and + refactor of old forecast subroutine. + +List all existing files that have been modified, and describe the changes: + M components/cam/bld/namelist_files/namelist_defaults_cam.xml + M components/cam/bld/namelist_files/namelist_definition.xml + M components/cam/cime_config/config_compsets.xml + M components/cam/cime_config/config_pes.xml + M components/cam/doc/ChangeLog + M components/cam/src/chemistry/mozart/mo_drydep.F90 + M components/cam/src/control/history_defaults.F90 + M components/cam/src/control/history_scam.F90 + M components/cam/src/control/scamMod.F90 + M components/cam/src/dynamics/eul/dyn_comp.F90 + M components/cam/src/dynamics/eul/dynpkg.F90 + M components/cam/src/dynamics/eul/iop.F90 + M components/cam/src/dynamics/eul/restart_dynamics.F90 + M components/cam/src/dynamics/eul/scan2.F90 + M components/cam/src/dynamics/eul/scanslt.F90 + M components/cam/src/dynamics/eul/tfilt_massfix.F90 + M components/cam/src/physics/cam/cam_diagnostics.F90 + M components/cam/src/physics/cam/micro_mg_cam.F90 + M components/cam/src/physics/cam/physpkg.F90 + M components/cam/src/utils/cam_pio_utils.F90 + M components/cam/test/system/nl_files/scm_b4b_o1 + M components/cam/test/system/nl_files/scmarm + M components/cam/test/system/tests_pretag_hobart_nag + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: two known failures all others pass + + ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=28 + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== + +Tag name: cam5_4_121 +Originator(s): cacraig +Date: May 4, 2017 +One-line Summary: Update externals to match alpha06j except using CLM branch + +Purpose of changes: + - Brought all externals up to match external used in cesm2_0_alpha06j + - CLM external is branch tag which is being used in Cecile's science runs (and contains + mods which are not yet on the CLM trunk) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update externals to match alpha06j and use CLM branch which has + additional mods beyond the CLM trunk + +M components/cam/test/system/TCB_ccsm.sh +M components/cam/test/system/TER_ccsm.sh +M components/cam/test/system/TSM_ccsm.sh + - add double dashes for cesm flags + - use new xmlchange structure + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: all have namelist changes and fail baselines due to + changes in the external components + + ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s RUN time=25 + - this requires a version of CLM at r236 or beyond + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_120 +Originator(s): fvitt, joemci, liuh +Date: 24 Apr 2017 +One-line Summary: Initial incorporation of a more complete ionosphere in WACCM-X + +Purpose of changes: + + - Add electrodynamics for the purpose of transporting O-plus in the ionosphere and + providing more realistic ion drift velocities + - Add transport of ions (just O+ in this commit) instead of transport by FV dynamical core + - Add energetics (temperature tendency) through solver for electron and ion temperature for + more realistic thermosphere temperature + - Major WACCM-X code reorganization, revision, and clean up for better compatibility with + existing infrastructure and better maintainability + - Add and revise compsets and namelist variables for WACCM-X + - A number additions to handle the fact that a few constants in the lower atmosphere are no + longer constant in the upper atmosphere where diffusion is dominant + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM review team + +List all subroutines eliminated: + +D components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +D components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +D components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml + - removed these obsolete use cases + +D components/cam/src/physics/cam/ionosphere.F90 +D components/cam/src/physics/cam/majorsp_diffusion.F90 + - removed these stubs + +D components/cam/src/physics/waccmx/ionosphere.F90 + - renamed to ion_electron_temp + +D components/cam/src/chemistry/mozart/wei96.F90 +D components/cam/src/chemistry/mozart/efield.F90 +D components/cam/src/chemistry/mozart/mag_parms.F90 +D components/cam/src/chemistry/mozart/exbdrift.F90 + - moved to physcis/waccm + +List all subroutines added and what they do: + +A components/cam/src/ionosphere + +A components/cam/src/ionosphere/waccmx/dpie_coupling.F90 +A components/cam/src/ionosphere/waccmx/edyn_init.F90 +A components/cam/src/ionosphere/waccmx/filter.F90 +A components/cam/src/ionosphere/waccmx/edyn_maggrid.F90 +A components/cam/src/ionosphere/waccmx/ionosphere_interface.F90 +A components/cam/src/ionosphere/waccmx/edynamo.F90 +A components/cam/src/ionosphere/waccmx/getapex.F90 +A components/cam/src/ionosphere/waccmx/edyn_geogrid.F90 +A components/cam/src/ionosphere/waccmx/oplus.F90 +A components/cam/src/ionosphere/waccmx/edyn_params.F90 +A components/cam/src/ionosphere/waccmx/edyn_mudcom.F90 +A components/cam/src/ionosphere/waccmx/edyn_mpi.F90 +A components/cam/src/ionosphere/waccmx/edyn_mud.F90 +A components/cam/src/ionosphere/waccmx/edyn_mudmod.F90 +A components/cam/src/ionosphere/waccmx/edyn_solve.F90 +A components/cam/src/ionosphere/waccmx/edyn_esmf.F90 +A components/cam/src/ionosphere/waccmx/heelis.F90 +A components/cam/src/ionosphere/waccmx/savefield_waccm.F90 +A components/cam/src/ionosphere/waccmx/edyn_muh2cr.F90 +A components/cam/src/ionosphere/waccmx/wei05sc.F90 +A components/cam/src/ionosphere/waccmx + - waccmx ionosphere added -- electrodynamcis and o-plus ion transport + +A components/cam/src/ionosphere/ionosphere_interface.F90 + - stub interface + +A components/cam/src/physics/waccm/exbdrift.F90 +A components/cam/src/physics/waccm/efield.F90 +A components/cam/src/physics/waccm/wei05sc.F90 +A components/cam/src/physics/waccm/wei96.F90 +A components/cam/src/physics/waccm/mo_aurora.F90 +A components/cam/src/physics/waccm/mag_parms.F90 + - moved from chemistry/mozart + +A components/cam/src/physics/cam/waccmx_phys_intr.F90 + - provides a general interface to waccm physics modules + +A components/cam/src/physics/waccmx/ion_electron_temp.F90 + - previously named "ionosphere.F90" + +A components/cam/bld/config_files/defaults_waccmxie.xml + - default configuration settings for waccmx ionosphere edynamo + +A components/cam/test/system/config_files/f1.9c4aqwmxidh +A components/cam/test/system/config_files/f4c6aqwmadm +A components/cam/test/system/config_files/f4c4aqwmxdm +A components/cam/test/system/config_files/f4c4aqwmxidm +A components/cam/test/system/config_files/f4c4aqwmxiedm + - new test configuration used in waccmx testing + +A components/cam/test/system/nl_files/outfrq3s_newyear + +A components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +A components/cam/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +A components/cam/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +A components/cam/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml + +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_clm +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear + +List all existing files that have been modified, and describe the changes: + +M components/cam/test/system/input_tests_master +M components/cam/test/system/nl_files/outfrq3s_epp +M components/cam/test/system/nl_files/outfrq3s_ionos +M components/cam/test/system/tests_waccm_hybrid + - updates for waccmx + +M components/cam/test/system/TR8.sh + - add r8 check for code in src/ionosphere + +M components/cam/bld/build-namelist + - add SF6 to default flbc_list if in the mechanism + - set default waccmx ionosphere options + - set default fv_high_altitude for waccmx + +M components/cam/bld/configure + - added ionosphere configure option + +M components/cam/bld/Makefile.in + - add mpi_alltoallv to nag_mismatch_flag + +M components/cam/bld/config_files/definition.xml + - added ionosphere config option + +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - adjust waccmx default settings + +M components/cam/bld/namelist_files/namelist_definition.xml + - add namelist options: + . fv_high_altitude + . oplus_adiff_limiter + . oplus_shapiro_const + . oplus_enforce_floor + . ionos_xport_active + . ionos_edyn_active + . emirical_ion_velocities + . dadadj_niter + +M components/cam/src/physics/cam/constituents.F90 + - use gas constant from shr_const_mod rather physconst + +M components/cam/src/physics/cam/dadadj_cam.F90 +M components/cam/src/physics/cam/dadadj.F90 + - use variable Kappa + - add diagnostic + - add dadadj_niter namelist option + +M components/cam/src/physics/cam/physics_types.F90 + - physconst_update interface change + +M components/cam/src/physics/cam/vertical_diffusion.F90 +M components/cam/src/physics/cam/diffusion_solver.F90 + - modify ubc_flux to be 2-dimensional + +M components/cam/src/physics/cam/physpkg.F90 + - use waccm_phys_inter to interface with waccm physics + +M components/cam/src/physics/cam/iondrag.F90 + - added timestep_init interface to this stub + - misc clean up + +M components/cam/src/physics/waccm/qbo.F90 +M components/cam/src/physics/waccm/radheat.F90 +M components/cam/src/physics/waccm/nlte_fomichev.F90 +M components/cam/src/physics/waccm/nlte_lw.F90 + - misc clean up + +M components/cam/src/physics/waccm/iondrag.F90 + - add empirical_ion_velocities namelist option + + +M components/cam/src/physics/waccmx/majorsp_diffusion.F90 + - mods for 2-dimensional fluxes at upper boundary + - misc clean up + - add diagnostic MBARV + +M components/cam/src/chemistry/mozart/mo_aurora.F90 + - now a stub version + +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - pbuf names of Te and Ti changed + +M components/cam/src/chemistry/mozart/mo_apex.F90 + - provide ability to update mag parameters when mag year changes + +M components/cam/src/chemistry/mozart/euvac.F90 + - misc clean up + +M components/cam/src/chemistry/mozart/chemistry.F90 + - corrected 'O1D' species name lookup in chem_register + - misc clean up + +M components/cam/src/chemistry/mozart/upper_bc.F90 + - mods for 2-dimensional fluxes at upper boundary + - misc clean up + +M components/cam/src/chemistry/utils/apex.F90 + - misc clean up +M components/cam/src/chemistry/utils/mo_solar_parms.F90 + - changes to handle solar params which are more frequent than daily + +M components/cam/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_ma/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_ma/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_ma/chem_mech.in +M components/cam/src/chemistry/pp_waccm_ma/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_ma/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 + - include SF6 + +M components/cam/src/dynamics/fv/metdata.F90 +M components/cam/src/dynamics/fv/benergy.F90 +M components/cam/src/dynamics/fv/dp_coupling.F90 +M components/cam/src/dynamics/fv/dyn_comp.F90 +M components/cam/src/dynamics/fv/pkez.F90 +M components/cam/src/dynamics/fv/p_d_adjust.F90 +M components/cam/src/dynamics/fv/cd_core.F90 +M components/cam/src/dynamics/fv/dynamics_vars.F90 +M components/cam/src/dynamics/fv/diag_dynvar_ic.F90 +M components/cam/src/dynamics/fv/geopk.F90 +M components/cam/src/dynamics/fv/te_map.F90 +M components/cam/src/dynamics/fv/stepon.F90 + - changes for variable Kappa needed for the upper regions of waccmx + +M components/cam/src/control/cam_restart.F90 +M components/cam/src/control/cam_comp.F90 +M components/cam/src/control/runtime_opts.F90 + - interface with ionosphere + +M components/cam/src/utils/physconst.F90 + - add routine to calculate variable Kappa + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_pes.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - waccmx compsets: + . FXN2000 + . FXREFC1 + . FX2000 + . FSDX + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s ................................FAIL! rc= 7 at Fri Apr 21 21:29:44 MDT 2017 +029 bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s ...................................................FAIL! rc= 7 at Fri Apr 21 22:11:11 MDT 2017 + - expected failures due to waccmx updates + +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Fri Apr 21 22:27:29 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Fri Apr 21 22:27:29 MDT 2017 + - pre-existing failures + +yellowstone/intel/aux_cam: B4B +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d NLCOMP +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + namelist compare failure due to updated euvac_file, otherwise bit-for-bit unchanged + +hobart/nag: +042 bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s .............................................FAIL! rc= 7 at Fri Apr 21 15:24:14 MDT 2017 + - expected failure due to waccmx updates + +hobart/pgi: all pass + + +=============================================================== +=============================================================== + +Tag name: cam5_4_119 +Originator(s): cacraig +Date: April 19, 2017 +One-line Summary: Add preliminary support for cheyenne regression testing and misc bug fixes + +Purpose of changes: +- Started support for cheyenne regression testing. This is just a first step in the process, + and is far from being complete. It is being saved to use as a starting point for further + development. +- Removed illegal characters from namelist_definition.xml file +- Remove SPCAM branch test as it was unnecessary and took a long time +- Remove CAM version information from FSPCAM compsets + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/test/system/tests_pretag_cheyenne + - copy of yellowstone pretag tests for cheyenne runs + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_definition.xml + - removed illegal characters from xml file + +M components/cam/cime_config/config_compsets.xml + - removed CAM version information from SPCAM compsets (it was incorrectly setting -phys twice) + +M components/cam/cime_config/testdefs/testlist_cam.xml + - added aux_cam_test1 to test a single CESM compset + - duplicated all yellowstone runs to cheyenne runs + +M components/cam/test/system/CAM_runcmnd.sh + - add capability to run cheyenne jobs -- note the compute node names start with "r" + +M components/cam/test/system/test_driver.sh + - add the ability to run CAM regression testing on cheyenne nodes + - This is just a first step, and there are still many issues to resolve + +M components/cam/test/system/tests_pretag_hobart_pgi + - Removed br222 (branch test for SPCAMM) as it was unnecessary and took a lot of time + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass except: (see below) +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Tue Apr 18 21:47:08 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Tue Apr 18 21:47:09 MDT 2017 + +yellowstone/intel/aux_cam: all PASS except: +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE + - This is due to the change in no longer supplying -phys cam4 in addition to -phys sam1mom. The theory is that + the answer changes are due to cice no longer being triggered with cam4 for some of its namelist settings. SPCAMS + will be checked with these new settings and if it is important to maintain the cam4 settings for cice, that + namelist can be set with user_mods when a newer version of cime is brought into CAM. + + - Note that a special 9 timestep run of SPCAMM was run offline and its answers were identical, so it is not + impacted by the removal of -phys cam5 from the CAM configure + +hobart/nag: all BFB + +hobart/pgi: all BFB + +cheyenne tests summary: + - All CESM tests fail due to internal compiler error based on needing HAS_F2008_CONTIGUOUS to be set to FALSE. This is set + in a more recent cime tag (Will need to temporarily set this in the CAM Makefile as well for the CAM CESM tests) + - Default time for running CAM regression tests may be way too low (jobs are being terminated without explanation) at test + #12 for first pass, and #16 during rerun + - test er331, er353 and sm360 are exiting with a message: ERROR: spmd_readnl: ERROR: incorrect yz domain decomposition + + +=============================================================== +=============================================================== + +Tag name: cam5_4_118 +Originator(s): andrew, cacraig, Guang Zhang +Date: March 28, 2017 +One-line Summary: Add option for MG microphysics in ZM deep convection + +Purpose of changes: + - Add Song and Zhang 2012 version of MG 2-moment microphysics in ZM + convective scheme as an option + - Add dlfzm to the pbuf + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - Add new zmconv_microp namelist field which, if true, turns on the + ZM microphysics. By default, it is currently set to false + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A + components/cam/src/physics/cam/zm_microphysics.F90 + - added new routine for ZM convective microphysics, linked to MG + microphysics scheme + +A + components/cam/test/system/nl_files/outfrq3s_convmic + - added namelist file for testing convective microphysics + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - add zmconv_microp namelist - defaults to false + +M components/cam/src/physics/cam/clubb_intr.F90 +M components/cam/src/physics/cam/macrop_driver.F90 +M components/cam/src/physics/cam/ndrop.F90 +M components/cam/src/physics/cam/nucleate_ice.F90 +M components/cam/src/physics/cam/zm_conv.F90 +M components/cam/src/physics/cam/zm_conv_intr.F90 + - added appropriate hooks into ZM scheme for the new + ZM convective microphysics, linked to MG microphysics + +M components/cam/src/physics/cam/convect_deep.F90 + - dlf is now a member of pbuf + - added rice (reserved ice for energy integrals) + +M components/cam/src/physics/cam/physpkg.F90 + - dlf is now a member of pbuf + - added rice (reserved ice for energy integrals) + - add rice temporarily into snow_dp before calling check_energy_change + +M components/cam/src/physics/spcam/crmclouds_camaerosols.F90 + - added ztodt to convtran call + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_hobart_nag + - added test for convective microphysics + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Mon Mar 27 22:29:03 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Mon Mar 27 22:29:03 MDT 2017 + - expected failures due to pre-existing problems (see below) + +yellowstone/intel/aux_cam: all PASS except: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d NLCOMP +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: NLFAIL), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + - expected failure due to addition of zmconv_microp + +hobart/nag: all BFB except: +036 bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s ................................................FAIL! rc= 7 at Mon Mar 27 17:54:55 MDT 2017 + - new test so missing baseline + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_117 +Originator(s): mmills, rneely, fvitt +Date: 23 Mar 2017 +One-line Summary: Allow 3-mode specification of prescribed volcanic aerosols + +Purpose of changes: + + . Provide the ability to prescribe stratospheric sulfate aerosols in 3 modes input + to radiation transfer calculations. The old 1-mode specification is preserved for + backwards compatibility. + +Bugs fixed (include bugzilla ID): + + . Fix a bug in regression tests archive script so that all aux_cam test cases + are archived regardless of baseline compare status. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_definition.xml + - new namelist option "prescribed_strataero_3modes" + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/build-namelist + - provide the correct default radiation properties files for the 3 sulfate modes + - provide a working prescribed stratospheric sulfate aerosols input data set in 3 modes + +M components/cam/src/chemistry/utils/prescribed_strataero.F90 + - expanded to handle 3 modes of prescribed stratospheric aerosols + +M components/cam/src/physics/cam/phys_prop.F90 +M components/cam/src/physics/cam/aer_rad_props.F90 + - expanded for 3 radii of volcanic aerosols + +M components/cam/test/system/archive_baseline.sh + - added "-p" option to the bless_test_results invocation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Thu Mar 23 01:35:12 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Thu Mar 23 01:35:12 MDT 2017 + - expected failures due to pre-existing problems (see below) + +yellowstone/intel/aux_cam: all pass + +hobart/nag: all pass + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_116 +Originator(s): fvitt, mickelso +Date: 21 Mar 2017 +One-line Summary: Performance improvements to vectorized chemistry solver + +Purpose of changes: + + Improve performance of chemistry solver used in WACCM6 on yellowstone. This is + done by selecting a vector length of 64. This vector length is controlled by a + parameter which was added to the chemistry preprocessor input file. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/SVN_EXTERNAL_DIRECTORIES + - update chemisry preprocessor external + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 + - use vector length of 64 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Wed Mar 22 00:54:25 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Wed Mar 22 00:54:25 MDT 2017 + - expected failures due to pre-existing problems (see below) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d NLCOMP +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: NLFAIL), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + - namelist compare failures due to change in chemistry preprocessor input file chem_mech.in + +hobart/nag: all pass + +hobart/pgi: all pass + + +=============================================================== +=============================================================== + +Tag name: cam5_4_115 +Originator(s): cacraig, sacks@ucar.edu +Date: March 17, 2017 +One-line Summary: Update externals to match cesm2_0_alpha06f and some fixes to unit tests + +Purpose of changes: + - Update externals to match those used in cesm2_0_alpha06f + - Fix some of the broken unit tests (cime has an issue in unit testing + which breaks a couple of unit tests, but it does not indicate a + problem with CAM or the running of jobs in CESM) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/test/unit/README.txt + - Added a README for running unit tests -- Was copied from CLM and slightly modified + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cesm2_0_alpha06f externals + - update cime and CLM (to corresponding branch needed by this version of cime) + - added new cime_config (which was removed from cime and is now in its own github repository) + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml + - gust_fac does not have a defaut value, so CAM standalone needs to supply it + +M components/cam/bld/Makefile.in +M components/cam/bld/configure + - directory reorganization in cime + +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - add missing micro_do_sb_physics set to true + +M components/cam/cime_config/config_component.xml + - Added missing descriptions for %SPCAMCLBS and %SPCAMCLBM + +M components/cam/test/unit/CMakeLists.txt + - changed variable identifiers from CESM to CIME + - cime directory reorganization changes + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +040 sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s .....................................................FAIL! rc= 4 at Wed Mar 15 21:34:01 MDT 2017 +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 4 at Wed Mar 15 21:34:01 MDT 2017 + - This test fails due to the incomplete removal of atm_adiabatic and atm_ideal + which still remain in cime. Reran these tests with the head of cime (which + is not tagged yet) and these tests pass, so they should pass the next time + the CAM trunk updates its cime external + + +yellowstone/intel/aux_cam: all Baselines fail due to answer changes in CLM + all Namelist comparisons fail due to bad saving of namelists in previous tag + -- NOTES -- Namelists should be stored properly with this tag and PASS in the next tag + -- Baselines will be rechecked against Cecile's runs when the CLM branch that + she is using is moved to the CLM trunk. There was no way to check the answers + with this CLM configuration (but it was needed due to changes in cime) + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_114 +Originator(s): cacraig, mark@atmos.colostate.edu, minghuai.wang@nju.edu.cn +Date: March 10, 2017 +One-line Summary: Bug fixes to SPCAM + +Purpose of changes: + - Scale the local ECPP tendencies by necpp in crm_physics_tend + - add optional variables to return vertical values of aqso4_h2o2 and aqso4_o3_ + - Bugfix for cnst_species_class n modal_aero_data (only caused issues for SPCAM) + - Now use bulk prescribed aerosols for sam1mom + +Bugs fixed (include bugzilla ID): + - The consituents had a couple of bugs in modal_aero_data that were causing problems + for m2005 SPCAM runs. After running all the CAM regression tests, this bug only + seems to impact m2005 SPCAM. + +Describe any changes made to build system: + - FSPCAMS is now using bulk prescribed aerosols + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist +M components/cam/bld/configure + - SPCAM sam1mom now uses bulk prescribed aerosols + +M components/cam/cime_config/config_component.xml + - added FSPCAMCLBS and FSPCAMCLBM to allow SPCAM m2005 and sam1mom to run with CLUBB + +M components/cam/cime_config/config_compsets.xml + - update to using CLM50 + - add compsets FSPCAMCLBS and FSPCAMCLBM + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add prealpha and prebeta tests for SPCAM + +M components/cam/src/chemistry/aerosol/mo_setsox.F90 +M components/cam/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +M components/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 + - add optional variables to return the vertical values of aqso4_h2o2 and aqso4_o3 + +M components/cam/src/chemistry/modal_aero/modal_aero_data.F90 + - removed redundant setting of constituents and use the correct index for the + call which is used + +M components/cam/src/physics/spcam/crm_physics.F90 + - modifications to account for ecpp timestep not equaling the CAM timestep + +M components/cam/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 + - use the values of aqso4_h2o2 and aqso4_o3 at each vertical level + +M components/cam/src/physics/spcam/ecpp/module_data_ecpp1.F90 + - removed unused declarations + +M components/cam/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 + - limit the fields which are output to only the ones who have active constituents + +M components/cam/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 + - cleanup of diagnostics + +M components/cam/test/system/config_files/f10spsaqdm + - change chem to "none" for sam1mom + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +029 bl391 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmxi_2000_cam4 9s ..................................FAIL! rc= 7 at Mon Mar 13 10:30:24 MDT 2017 + - For some reason this baseline passed. Three more identical runs were made + and five tests were run with different number of tasks and all of them passed baseline. + It is assumed that something on caldera/yellowstone caused a momentary glitch in the + original run. If this happens again on this test, further investigation may be warranted. + +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Mon Mar 13 10:30:25 MDT 2017 + - continuing failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: all BFB except: + - namelists still have issues due to cime + +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE + - answer changing tag for SPCAM + +hobart/nag: all BFB except: +013 bl221 TBL.sh f10spsaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Mar 9 17:06:00 MST 2017 + - answer changing tag for SPCAM + +hobart/pgi: all BFB except: +012 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Mar 9 18:01:01 MST 2017 + - answer changing tag for SPCAM + +=============================================================== +=============================================================== + +Tag name: cam5_4_113 +Originator(s): cacraig, fvitt +Date: March 6, 2017 +One-line Summary: Initialize all variables before they are used + +Purpose of changes: + - Use the "-nan" compiler flag in NAG to find uninitialized variables + which are used before they are set + - CAM-SE has issues, but since it has a major rewrite coming soon to + the CAM trunk, temporarily removed the CAM-SE tests from the NAG test suite + - SCAM also has issues and will have an upcoming tag which will include fixes + for uninitialized values + - remove the remaining references to atm_adiabatic and atm_ideal_phys namelist options + +Bugs fixed (include bugzilla ID): + - gw_front.F90 had a bug in the midpoint_interp call where it was sending an array + subsection which contained unset memory. This is an answer-changing bug fix + for WACCM and WACCMX. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, fvitt, joemic, hanli + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/Makefile.in + - add NAN initialization for Intel and NAG debug modes (note NAG + testing is much more robust than Intel) + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml + - remove atm_adiabatic and atm_ideal_phys references + +M components/cam/src/chemistry/mozart/mo_aurora.F90 + - Initialize byloc + +M components/cam/src/chemistry/utils/apex.F90 + - a number of variables need to be intent(inout) to keep the + initializations that occurred before these routines are called + +M components/cam/src/physics/cam/clubb_intr.F90 + - the pbuf field FICE needs to be initialized on restarts as well + - limit comparisons to just the array subsection which has been set + +M components/cam/src/physics/cam/convect_shallow.F90 + - initialize the pbuf fields SH_FLXPRC and SH_FLXSNW + +M components/cam/src/physics/cam/gw_front.F90 + - Fixes a bug that was introduced in cam5_4_33. The function + midpoint_interp was including values outside the range that had + been set -- This change is what causes answer changes + for WACCM and WACCMX + +M components/cam/src/physics/cam/macrop_driver.F90 + - initialize FICE and CMELIQ on restarts as well + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - limit cldmax calculation to array subsection which has been set + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - initialize am_evp_st + +M components/cam/src/physics/cam/ndrop.F90 + - limit calculation of lcldo and lcldn to array subsections + which have been set + +M components/cam/src/physics/cam/physpkg.F90 + - limit adding of CLDICE with CLDLIQ to just those sections + which have been set + - only pass the array subsection of flx_heat which has been + set into check_energy_chng + +M components/cam/src/physics/cam/sslt_rebin.F90 + - remove unused routines from a use statement + +M components/cam/src/physics/camrt/radiation.F90 + - set fsnr and flnr to zero if they are not active + +M components/cam/src/physics/rrtmg/radiation.F90 + - initialize pbuf field QRL + +M components/cam/src/physics/spcam/crm_physics.F90 + - initialize pbuf field AST only on the first time step + +M components/cam/src/physics/waccmx/majorsp_diffusion.F90 + - tubc was only being set on the initialization step and + it needed to be set every time mspdiff is called -- Fix + provided by Francis Vitt + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_amip_cam6 9s ......................FAIL! rc= 7 at Fri Mar 3 18:59:29 MST 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_2000_cam4 9s ...................................FAIL! rc= 7 at Fri Mar 3 19:57:01 MST 2017 +029 bl391 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmxi_2000_cam4 9s ..................................FAIL! rc= 7 at Fri Mar 3 20:41:10 MST 2017 + - Answer changes as expected for WACCM/WACCMX + +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Fri Mar 3 21:00:39 MST 2017 + - continuing failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d BASELINE +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE + - In addition to namelist failures due to problems in cime, answer changes as expected for WACCM/WACCMX + +hobart/nag: +039 bl426 TBL.sh f10c4aqwmxdm outfrq3s_ionos 9s ...............................................FAIL! rc= 7 at Fri Mar 3 13:11:04 MST 2017 +045 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Mar 3 13:35:05 MST 2017 + - Answer changes as expected for WACCM/WACCMX + +046 sm711 TSM.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 8 at Fri Mar 3 13:37:09 MST 2017 +047 er711 TER.sh h5c5aqt5mdm ttrac 4+5s .......................................................FAIL! rc= 5 at Fri Mar 3 13:37:10 MST 2017 +048 br711 TBR.sh h5c5aqt5mdm ttrac 6+3s .......................................................FAIL! rc= 5 at Fri Mar 3 13:37:17 MST 2017 +049 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 4 at Fri Mar 3 13:37:17 MST 2017 +050 mc711 TMC.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 4 at Fri Mar 3 13:37:17 MST 2017 +051 eq701 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb0 9s ......................................FAIL! rc= 4 at Fri Mar 3 13:37:17 MST 2017 +052 eq702 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb1 9s ......................................FAIL! rc= 4 at Fri Mar 3 13:37:17 MST 2017 +053 eq703 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb3 9s ......................................FAIL! rc= 4 at Fri Mar 3 13:37:17 MST 2017 +054 sm741 TSM.sh h16c6aqdm ghgrmp_unstruct 9s .................................................FAIL! rc= 8 at Fri Mar 3 13:39:29 MST 2017 +055 er741 TER.sh h16c6aqdm ghgrmp_unstruct 4+5s ...............................................FAIL! rc= 5 at Fri Mar 3 13:39:29 MST 2017 +056 bl741 TBL.sh h16c6aqdm ghgrmp_unstruct 9s .................................................FAIL! rc= 4 at Fri Mar 3 13:39:29 MST 2017 + - There are known initialization issues with CAM-SE and since a major update is coming soon, these tests + are being removed until that tag is made + +059 sc003 TSM.sh scmc5aqds scmarm 7s ..........................................................FAIL! rc= 8 at Fri Mar 3 13:46:14 MST 2017 + - There were a good number of initialization issues with SCAM. These will be fixed when the upcoming + SCAM tag is made on the CAM trunk. Until then, this test is being removed. + +hobart/pgi: +015 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Fri Mar 3 13:35:24 MST 2017 + - Answer changes as expected for WACCM/WACCMX + +Summarize any changes to answers, i.e., +- what code configurations: all WACCM/WACCMX +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but same climate + +URL for AMWG diagnostics output used to validate the WACCM answer change: +https://acomstaff.acom.ucar.edu/mmills/diagnostics/WACCM6/FW2000.gwfront_7y/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_112 +Originator(s): juliob, cacraig +Date: Feb 27, 2017 +One-line Summary: Low level and gravity wave changes and several minor mods + +Purpose of changes: + + - Namelist control variables added to gw_rdg.F90 + - Allow code to reproduce Scinocca&McFarlane 2000 downslope wind and flow splitting + regimes, or modified regime definition using separate dividing streamlines + for downslope wind and flow splitting + - Optional smooth transitions to downslope wind regime implemented + - Code cleanup of unused variables in gw_rdg module + + - Rename all CESM tests which are not routinely run from "aux_" to "test_" + - Update default topo file for ne30np4 + - Implement bug fix in fv/spmd_dyn which was causing CAM to endrun when CAM tasks > npes_yz + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - Added the following namelist variables for gw_rdg + gw_rdg_do_divstream -- If .true. use separate dividing streamlines for downslope wind and + flow splitting regimes (“DS†configuration). If .false. use single + dividing streamline as in Scinocca&McFarlane 2000 (“SM†configuration). + gw_rdg_C_BetaMax_DS -- Enhancement factor for downslope wind stress in DS configuration + gw_rdg_C_GammaMax -- Enhancement factor for depth of downslope wind regime in DS configuration + gw_rdg_Frx0 -- Lower inverse Froude number limits on linear ramp terminating downslope wind + regime for high mountains in DS configuration + gw_rdg_Frx1 -- Upper inverse Froude number limits on linear ramp terminating downslope wind + regime for high mountains in DS configuration + gw_rdg_C_BetaMax_SM -- Enhancement factor for downslope wind stress in DS configuration + gw_rdg_Fr_c -- Critical inverse4 Froude number + gw_rdg_do_smooth_regimes -- If true, then use smooth regimes + gw_rdg_do_adjust_tauoro -- If true, then adujust tauoro + gw_rdg_do_backward_compat -- If true, then adjust for bit-for-bit answers with the ("N5") configuration + gw_rdg_orohmin -- minimum surface displacement height for orographic waves (m) + gw_rdg_orovmin -- Minimum wind speed for orographic waves + gw_rdg_orostratmin -- Minimum stratification allowing wave behavior + gw_rdg_orom2min -- Minimum stratification allowing wave behavior + +List any changes to the defaults for the boundary datasets: + Topo file for ne30np4 has been updated + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - Add gravity wave ridge namelist settings + - Update ne30np4 default topo file + +M components/cam/cime_config/testdefs/testlist_cam.xml + - Rename all CESM aux_XXX tests other than aux_cam and aux_cam_short to test_XXX + +M components/cam/src/dynamics/fv/spmd_dyn.F90 + - two sections of code should only be executed by master, otherwise the code + was calling endrun when CAM tasks > npex_yz + +M components/cam/src/physics/cam/gw_drag.F90 + - cleanup of unused variables + +M components/cam/src/physics/cam/gw_rdg.F90 + - Namelist control variables added to gw_rdg.F90 + - Allow code to reproduce Scinocca&McFarlane 2000 downslope wind and flow splitting + regimes, or modified regime definition using separate dividing streamlines + for downslope wind and flow splitting + - Optional smooth transitions to downslope wind regime implemented + - Code cleanup of unused variables in gw_rdg module + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Fri Feb 24 21:10:36 MST 2017 + - continuing failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: all PASS except still issues with namelst testing in cime + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_111 +Originator(s): fvitt +Date: 14 Feb 2017 +One-line Summary: Update emissions input data sets used by WACCM6 compsets + +Purpose of changes: + + Previous CAM trunk tags (cam5_4_107 through cam5_4_110) used emissions input + data sets which have been lost. Here WACCM6 build namelist use case files + point to updated emissions data sets. + + Reduce history data saved in the baselines of the aux_cam WACCM tests. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + components/cam/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d + components/cam/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam + - added for the purpose of reducing the amount of data saved in the baselines + +List all existing files that have been modified, and describe the changes: + components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml + components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml + components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml + - updated 1-degree emissions data sets + + components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml + - replace full path to IC with path relative to inputdata + + components/cam/cime_config/testdefs/testlist_cam.xml + - WACCM aux_cam test cases use reduced_hist1d modifier + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Mon Feb 13 23:40:46 MST 2017 + - pre-existing failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_110/ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-reduced_hist1d' does not exist +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d (Overall: DIFF), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_110/SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-reduced_hist1d' does not exist + + - waccm compsets are expected to give different results due to changes in emssions input data + - namelist comparisons seem to be broken + +hobart/nag: All Pass + +hobart/pgi: All Pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_110 +Originator(s): goldy, pel +Date: 2017-02-12 +One-line Summary: Add Kessler 'simple' physics option + +Purpose of changes: Add a new, 'simple' physcs option, Kessler + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/config_files/definition.xml +M components/cam/bld/configure + - Add Kessler as a physics option +A + components/cam/bld/namelist_files/use_cases/dctest_baro_kessler.xml +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml + - Compset and use case for Kessler physics with baroclinic wave initial conditions +M components/cam/cime_config/testdefs/testlist_cam.xml + - prealpha test for Kessler physics option +M components/cam/doc/ChangeLog + - Used the GNU ChangeBot to write this entry +M components/cam/src/control/cam_control_mod.F90 + - Added Kessler physics setting +M components/cam/src/dynamics/eul/dyn_comp.F90 + - Make use of pertlim namelist parameter repeatable (bug fix) +M components/cam/src/dynamics/fv/stepon.F90 + - Do not do dry air mass check and set if using analytic initial conditions +M components/cam/src/dynamics/se/dp_coupling.F90 +M components/cam/src/dynamics/se/dyn_comp.F90 + - Initialize state%PHIS in unused columns to avoid warnings +M components/cam/src/dynamics/sld/dyn_comp.F90 + - Make use of pertlim namelist parameter repeatable (bug fix) +M components/cam/src/physics/cam/cam_diagnostics.F90 + - Do not assume that any moist physics package has all cloud and precipitation pbuf and tracer fields +M components/cam/src/physics/cam/physics_types.F90 + - Dry mass pressure adjustments +M components/cam/src/physics/simple/held_suarez_cam.F90 + - Code cleanup +A + components/cam/src/physics/simple/kessler_cam.F90 +A + components/cam/src/physics/simple/kessler_mod.F90 + - New Kessler physics interface and module +M components/cam/src/physics/simple/physpkg.F90 + - Call Kessler physics when appropriate + - Move diagnostics write to after physics parameterizations (apparently, + people like to look at results after they have been calculated, who knew?) +M components/cam/src/cam/simple/restart_physics.F90 +A + components/cam/src/physics/simple/restart_physics.F90 + - Add minimal restart_physics for simple options allowing less clutter in CAM version + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +006 bl151 TBL.sh e64hsdh outfrq3s+held_suarez_1994 9s .........................................FAIL! rc= 7 at Sun Feb 12 01:52:12 MST 2017 +035 bl736 TBL.sh h16adtermdh terminator 9s ....................................................FAIL! rc= 7 at Sun Feb 12 05:08:58 MST 2017 + - Expected failures due to change in diagnostics + +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Sun Feb 12 05:12:01 MST 2017 + - failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: Namelist failures due to inadequate bless-test-results +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: NLFAIL), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + +hobart/nag: +031 bl335 TBL.sh f10idm idphys 9s .............................................................FAIL! rc= 7 at Sun Feb 12 12:53:07 MST 2017 + - Expected failure due to change in diagnostics + +hobart/pgi: +030 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Sun Feb 12 13:53:17 MST 2017 + - Expected failure due to change in diagnostics + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: NA +- what platforms/compilers: NA +- nature of change: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_109 +Originator(s): cacraig +Date: Feb 8, 2017 +One-line Summary: Fix topo file issues discovered during prealpha testing + +Purpose of changes: + - Fixed a couple of problems that were discovered with the assignment + of topo files for different compsets/resolutions + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Update the topo default files for 1 and 2 degree FV to Julio's + current files which contain the GBXAR field + +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - removed the hardwired topo file as the defaults now supply it + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Tue Feb 7 19:53:38 MST 2017 + - failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s NLCOMP +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + - Failures due to incorrect baseline management (bless_test_results?) + +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d (Overall: NLFAIL), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d NLCOMP + - Failure due to change in default topo file (bug fixed) + +hobart/nag: not run (changes were limited to CESM tests which only run on yellowstone) + +hobart/pgi: not run (changes were limited to CESM tests which only run on yellowstone) + +=============================================================== +=============================================================== + +Tag name: cam5_4_108 +Originator(s): goldy +Date: 2017-02-05 +One-line Summary: Remove CLM40 from CAM + +Purpose of changes: Remove CLM40 compsets from CAM to allow CLM group cleanup + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the +changes: +M SVN_EXTERNAL_DIRECTORIES + - Removed CLM40 external (no longer used by CAM) +M components/cam/cime_config/config_compsets.xml + - Grouped existing CLM45 compsets and converted existing CLM40 compsets to CLM45 +M components/cam/doc/ChangeLog + - Rewrote this file from scratch (that's a true alternative fact). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Sat Feb 4 14:17:42 MST 2017 +Roundoff level diffs in a few fields (including gw which is a constant), + probably due to different compiler settings. + +yellowstone/intel/aux_cam: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP +Failures due to incorrect baseline management (bless_test_results?) + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE +Expected failure due to change to CLM45 + +hobart/nag: ALL PASS + +hobart/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_107 +Originator(s): fvitt +Date: 2 Feb 2017 +One-line Summary: Corrections to ammonium aerosols, update boundary datasets, switch to vectorized chemistry solver in WACCM6 + +Purpose of changes: + + WACCM6 updates: + - include formation of bulk ammonium nitrate + - add wet removal of ammonium aerosols (as gas phase species) + - switch from scalar solver to vector solver + - update emissions and fixed lower boundary data + - set fixed geomagnetic year for perpetual year use cases + + Misc fixes: + - correctly set arrays to avoid undefined values + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/src/chemistry/modal_aero/bam_nh4no3.F90 + - for formation of bulk ammonium nitrate + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/master_aer_wetdep_list.xml +M components/cam/bld/namelist_files/master_gas_wetdep_list.xml + - move wet deposition of NH3 aerosols to gas phase species list + +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml + - update emissions and fixed lower boundary data + - set fixed geo-magnetic year for perpetual year waccm use cases + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - include formation of bulk NH4 aeroeols + +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - pass wetdep fluxes into chm_diags for history output + - correction to NOy summation + - include NH4 and NH4NO3 with wet deposition of gas phase species + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 + - switch from scalar solver to vector solver + +M components/cam/src/chemistry/utils/mo_solar_parms.F90 +M components/cam/src/dynamics/fv/dyn_comp.F90 +M components/cam/src/physics/carma/cam/carma_intr.F90 + - correctly set arrays to zero to avoid undefined values + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Thu Feb 2 14:14:39 MST 2017 + - expected failure due to wet removal of ammonium aerosols as gas phase species + +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s_f19c6aqwsc+waccm_sc_amip_cam6 9s ......................FAIL! rc= 7 at Thu Feb 2 15:26:47 MST 2017 + - expected failures due to change in LBC file + +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_2000_cam4 9s ...................................FAIL! rc= 7 at Thu Feb 2 15:52:18 MST 2017 +029 bl391 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmxi_2000_cam4 9s ..................................FAIL! rc= 7 at Thu Feb 2 15:54:09 MST 2017 + - expected failures due to change in geomagnetic year + +041 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Thu Feb 2 15:54:10 MST 2017 + - failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s BASELINE +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d (Overall: DIFF), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d BASELINE + - expected failures due to change in boundary datasets + +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: NLFAIL), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + - these failures in namelist comparisons are due to differences in PE layouts, + otherwise the results are bit-for-bit unchanged + +hobart/nag: all pass + +hobart/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: WACCM6, bulk aerosol model +- what platforms/compilers: all +- nature of change: larger than roundoff but same climate + +=============================================================== +=============================================================== + +Tag name: cam5_4_106 +Originator(s): cacraig +Date: Jan 26, 2017 +One-line Summary: Update the svn externals to match cesm2_0_alpha06a + +Purpose of changes: + - Update the CAM externals to match cesm2_0_alpha06 + - In a couple of outfld calls in the CLUBB interface, there were + variables which had arithemetic being performed on them within the call. + Now perform the arithmetic prior to the outfld call and pass that variable + to outfld + + -- CHANGES for CAM TESTING (only useful for developers) -- + - Now that cime has been updated to allow the override of threading, add + the SPCAMS compset test to aux_cam. Also added testing the SPCAMM compset + to the aux_spcam testing + - Use the override capability for any CAM compsets which use CISM1 to be forced + to use one node and one thread for that component + - With the update to cime, bless_test_results will now copy the namelists, so + remove the --hist-only flag from the baseline archiving + - Modifications to test_driver.sh to support rerunning CESM tests and + having the CESM bld and run directories go into the case setup directory + when running the CAM regression tests + - remove the h5c4aqwmdh test as it was never set up to use aquaplanet + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/test/system/config_files/h5c4aqwmdh + - this test removed as it did not have aquaplanet in + it (despite its name) and creating the initialization + file was problematic. Since this was a WACCM4 test using + SE dycore (which is not supported), Brian Eaton decided + to drop the test + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update the externals to match those in cesm2_0_alpha06a + +M components/cam/cime_config/config_compsets.xml + - remove obsolete single thread definitions (now in config_pes.xml) + +M components/cam/cime_config/config_pes.xml + - add single threading for SPCAM compsets + - all compsets which use CISM1 need single node and thread for + that component + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add compset for SPCAM m2005 testing with aux_spcam and add + FSPCAMS to aux_cam testing using the 10deg grid + +M components/cam/src/physics/cam/clubb_intr.F90 + - outfld calls with arithmetic in the calls were replaced + with temporary variables and the arithmetic is performed + before the call + +M components/cam/test/system/TCB_ccsm.sh + - add "--run-unsupported" to create_newcase to always test compsets, even + when they do not appear in the CESM testlist + +M components/cam/test/system/archive_baseline.sh + - remove "--hist-only" which was required due to bug in bless_test_results + which has now been fixed + +M components/cam/test/system/test_driver.sh + - "--rerun-cesm" now requires the test_id to be supplied as well + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_yellowstone + - removed test "760" (see the information about the deleted + config_file above for more information) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +044 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Wed Jan 25 18:56:06 MST 2017 + -- Failure due to issue with cime (first reported in cam5_4_105) + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s BASELINE +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d (Overall: DIFF), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d BASELINE +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + -- namelists fail due to error with previous bless_test_results -- this failure + should not occur in future tags + -- answer changes due to changes in external components + +ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_105/ERP_Ln9.f10_f10.FSPCAMS.yellowstone_intel.cam-outfrq9s' does not exist + -- new test, no baseline for comparison + +hobart/nag: all BFB + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_105 +Originator(s): eaton +Date: Wed Jan 25 09:50:25 MST 2017 +One-line Summary: refactor standalone regression testing + +Purpose of changes: + +. Recent and upcoming changes to the CLM and CICE components will require + significant changes to CAM's configure and build-namelist utilities in + order to continue using those components when running from CAM standalone + scripts. The support for this is not available. Instead we have chosen + to maintain the CAM standalone scripts only for the purpose of running + configurations that don't require the use of CLM or CICE, e.g., + adiabatic, ideal physics, and aquaplanet. Therefore the part of CAM + regression testing which relies on the standalone build has been + refactored to only use adiabatic, ideal physics, and aquaplanet + configurations. F-compset configurations which require an active CLM + and/or CICE component are now tested using the cime test harness. + +Bugs fixed (include bugzilla ID): + +. fixed SLD failure in MPI mode (some compilers are getting more strict + about not aliasing input and output arguments in mpiallgatherv call) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/test/system/config_files/e48c4dh +components/cam/test/system/config_files/e48c5h +components/cam/test/system/config_files/e48c5m +components/cam/test/system/config_files/e64am +components/cam/test/system/config_files/e64c4bfbiop +components/cam/test/system/config_files/e64c5bfbiop +components/cam/test/system/config_files/e64c5m +components/cam/test/system/config_files/e64c5paqm +components/cam/test/system/config_files/e8c5dm +components/cam/test/system/config_files/e8c5paqdm +components/cam/test/system/config_files/e8c5t5mdm +components/cam/test/system/config_files/f0.9c4m +components/cam/test/system/config_files/f0.9c5.5mam4vbsh +components/cam/test/system/config_files/f1.9c4carmsuldh +components/cam/test/system/config_files/f1.9c4carmwtsuldh +components/cam/test/system/config_files/f1.9c4cm +components/cam/test/system/config_files/f1.9c4dm +components/cam/test/system/config_files/f1.9c4fastdh +components/cam/test/system/config_files/f1.9c4ghgdm +components/cam/test/system/config_files/f1.9c4m +components/cam/test/system/config_files/f1.9c4mozdh +components/cam/test/system/config_files/f1.9c4mozm +components/cam/test/system/config_files/f1.9c4wcarmbc_m +components/cam/test/system/config_files/f1.9c4wmxdh +components/cam/test/system/config_files/f1.9c4wmxh +components/cam/test/system/config_files/f1.9c4wscdh +components/cam/test/system/config_files/f1.9c5.4dh +components/cam/test/system/config_files/f1.9c5.4dm +components/cam/test/system/config_files/f1.9c5.5h +components/cam/test/system/config_files/f1.9c5.5wmam4dh +components/cam/test/system/config_files/f1.9c5.5wmam4h +components/cam/test/system/config_files/f1.9c5.5wscmam4dh +components/cam/test/system/config_files/f1.9c5.5wscmam4dm +components/cam/test/system/config_files/f1.9c5.5wtmam4h +components/cam/test/system/config_files/f1.9c5carmc_ddm +components/cam/test/system/config_files/f1.9c5carmcirm +components/cam/test/system/config_files/f1.9c5carmmetm +components/cam/test/system/config_files/f1.9c5carmpmcm +components/cam/test/system/config_files/f1.9c5carmseam +components/cam/test/system/config_files/f1.9c5cdm +components/cam/test/system/config_files/f1.9c5clbdh +components/cam/test/system/config_files/f1.9c5clbdm +components/cam/test/system/config_files/f1.9c5cm +components/cam/test/system/config_files/f1.9c5dm +components/cam/test/system/config_files/f1.9c5fstmam3dh +components/cam/test/system/config_files/f1.9c5m +components/cam/test/system/config_files/f1.9c5mam4dh +components/cam/test/system/config_files/f1.9c5mam4vbsdh +components/cam/test/system/config_files/f1.9c5mam7dh +components/cam/test/system/config_files/f1.9c5mg1_5dm +components/cam/test/system/config_files/f1.9c5mg2dm +components/cam/test/system/config_files/f1.9c5nonedh +components/cam/test/system/config_files/f10c3dm +components/cam/test/system/config_files/f10c4carmwtsuldm +components/cam/test/system/config_files/f10c4cdm +components/cam/test/system/config_files/f10c4wmdm +components/cam/test/system/config_files/f10c4wmxdm +components/cam/test/system/config_files/f10c4wscdm +components/cam/test/system/config_files/f10c4wtsmltdm +components/cam/test/system/config_files/f10c5.5wmam4dm +components/cam/test/system/config_files/f10c5.5wscmam4dm +components/cam/test/system/config_files/f10c5cdm +components/cam/test/system/config_files/f10c5dm +components/cam/test/system/config_files/f10c5mam4vbsdm +components/cam/test/system/config_files/f10c5nonedm +components/cam/test/system/config_files/f10c5paqdm +components/cam/test/system/config_files/f10c5spcammm +components/cam/test/system/config_files/f10c5spcamsm +components/cam/test/system/config_files/f10c5t5mdm +components/cam/test/system/config_files/f10c5t5mdmsc +components/cam/test/system/config_files/f10c5udm +components/cam/test/system/config_files/f10c5wmdiondm +components/cam/test/system/config_files/f10c5wtmam4dm +components/cam/test/system/config_files/f2.5c5dm +components/cam/test/system/config_files/f4c4dh +components/cam/test/system/config_files/f4c4fastdm +components/cam/test/system/config_files/f4c4rrtmgdm +components/cam/test/system/config_files/f4c4wmdh +components/cam/test/system/config_files/f4c4wmh +components/cam/test/system/config_files/f4c4wscdm +components/cam/test/system/config_files/f4c5carmm_idm +components/cam/test/system/config_files/f4c5carmm_sdm +components/cam/test/system/config_files/f4c5carmp_sdm +components/cam/test/system/config_files/f4c5carmthodm +components/cam/test/system/config_files/f4c5carmtt1dm +components/cam/test/system/config_files/f4c5carmtt2dm +components/cam/test/system/config_files/f4c5dm +components/cam/test/system/config_files/f4c5fstmam3dm +components/cam/test/system/config_files/f4c5mam4dm +components/cam/test/system/config_files/f4c5mam7dm +components/cam/test/system/config_files/f4c5paqdh +components/cam/test/system/config_files/fsd0.9c5.5wtsmlth +components/cam/test/system/config_files/fsd1.9c4wcarmsuldm +components/cam/test/system/config_files/fsd1.9c5.4wmdionh +components/cam/test/system/config_files/fsd1.9c5.4wtclbh +components/cam/test/system/config_files/fsd1.9c5clbdh +components/cam/test/system/config_files/fsd1.9c5clbdm +components/cam/test/system/config_files/h30c4wscdm +components/cam/test/system/config_files/h30c5h +components/cam/test/system/config_files/h5c4wmdm +components/cam/test/system/config_files/s32c5dh +components/cam/test/system/config_files/s32c5paqdh +components/cam/test/system/config_files/s64c5dh +components/cam/test/system/config_files/s64c5h +components/cam/test/system/config_files/s64c5m +components/cam/test/system/config_files/s64c5paqdh +components/cam/test/system/config_files/s8c5dm +components/cam/test/system/config_files/s8c5paqdm +components/cam/test/system/config_files/s8c5t5mdm +components/cam/test/system/config_files/scm64c4bfbiop +components/cam/test/system/config_files/scm64c5bfbiop +components/cam/test/system/config_files/scmc5armiop +components/cam/test/system/nl_files/no_ttrac +components/cam/test/system/nl_files/off1.9x2.5 +components/cam/test/system/nl_files/outfrq3s_clubb +components/cam/test/system/nl_files/outfrq3s_macmic2_classnuc +components/cam/test/system/nl_files/outfrq3s_npryz +components/cam/test/system/tests_edison_intel +components/cam/test/system/tests_hopper_pgi +components/cam/test/system/tests_posttag_yellowstone +components/cam/test/system/tests_titan +components/cam/test/system/tests_titan_pgi +components/cam/test/system/tests_waccm_phys +. remove old tests + +List all subroutines added and what they do: + +components/cam/test/system/config_files/e64addh +components/cam/test/system/config_files/e64adh +components/cam/test/system/config_files/e64c4aqiopdm +components/cam/test/system/config_files/e64c5aqiopdm +components/cam/test/system/config_files/e64hsdh +components/cam/test/system/config_files/e8c3aqdm +components/cam/test/system/config_files/e8c4aqdm +components/cam/test/system/config_files/e8c5aqt5mdm +components/cam/test/system/config_files/f1.9c4aqh +components/cam/test/system/config_files/f1.9c4aqmozdh +components/cam/test/system/config_files/f1.9c4aqwmxdh +components/cam/test/system/config_files/f1.9c5aqm +components/cam/test/system/config_files/f1.9c6aqcdh +components/cam/test/system/config_files/f1.9c6aqtsvbsdh +components/cam/test/system/config_files/f1.9c6aqwscdh +components/cam/test/system/config_files/f10c4aqcdm +components/cam/test/system/config_files/f10c4aqwmxdm +components/cam/test/system/config_files/f10c4aqwscdm +components/cam/test/system/config_files/f10c5aqcdm +components/cam/test/system/config_files/f10c5aqcmtt1dm +components/cam/test/system/config_files/f10c5aqdm +components/cam/test/system/config_files/f10c5aqpbadm +components/cam/test/system/config_files/f10c5aqscdm +components/cam/test/system/config_files/f10c5aqt5mdm +components/cam/test/system/config_files/f10c5aqudm +components/cam/test/system/config_files/f10c6aqdm +components/cam/test/system/config_files/f10c6aqt5mdm +components/cam/test/system/config_files/f10c6aqwmadm +components/cam/test/system/config_files/f10spmaqdm +components/cam/test/system/config_files/f10spsaqdm +components/cam/test/system/config_files/f4c4aqdh +components/cam/test/system/config_files/h16adtermdh +components/cam/test/system/config_files/h16c5aqh +components/cam/test/system/config_files/h16c6aqdm +components/cam/test/system/config_files/h5c4aqwmdh +components/cam/test/system/config_files/h5c5aqbamdm +components/cam/test/system/config_files/h5c5aqdm +components/cam/test/system/config_files/h5c5aqt5mdm +components/cam/test/system/config_files/s8c5aqt5mdm +components/cam/test/system/config_files/scmc4aqds +components/cam/test/system/config_files/scmc5aqds +components/cam/test/system/nl_files/outfrq3s_diags +components/cam/test/system/nl_files/outfrq3s_f19c6aqwsc +components/cam/test/system/nl_files/ttrac_lb0 +. for new aquaplanet regression tests + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. added new IC files for aquaplanet tests + +components/cam/src/dynamics/sld/dyn_comp.F90 +. add access to clat, clon for analytic ICs + +components/cam/src/dynamics/sld/scanslt.F90 +. fix illegal aliasing in mpiallgatherv call + +components/cam/src/physics/camrt/radiation.F90 +. remove undefined calculation when FSNR not output + +components/cam/test/system/config_files/h16c5aqdm +. change '-ocn aquaplanet' to -aquaplanet + +components/cam/test/system/input_tests_master +components/cam/test/system/nl_files/ghgrmp_e8 +components/cam/test/system/nl_files/ghgrmp_unstruct +components/cam/test/system/nl_files/outfrq3s_carma +components/cam/test/system/nl_files/ttrac +components/cam/test/system/nl_files/ttrac_lb1 +components/cam/test/system/nl_files/ttrac_lb2 +components/cam/test/system/nl_files/ttrac_lb3 +components/cam/test/system/test_driver.sh +components/cam/test/system/tests_cam_phys +components/cam/test/system/tests_carma +components/cam/test/system/tests_chem_hybrid +components/cam/test/system/tests_chem_mpi +components/cam/test/system/tests_pretag_hobart_nag +components/cam/test/system/tests_pretag_hobart_pgi +components/cam/test/system/tests_pretag_yellowstone +components/cam/test/system/tests_waccm_hybrid +components/cam/test/system/tests_waccm_mpi +. updates for new regression tests + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +003 bl150 TBL.sh e64addh outfrq3s+dabi_p2004 9s ...............................................FAIL! rc= 7 at Tue Jan 24 11:32:59 MST 2017 +006 bl151 TBL.sh e64hsdh outfrq3s+held_suarez_1994 9s .........................................FAIL! rc= 7 at Tue Jan 24 11:33:43 MST 2017 +010 bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s .................................................FAIL! rc= 7 at Tue Jan 24 11:35:57 MST 2017 +013 bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s ................................FAIL! rc= 7 at Tue Jan 24 11:49:43 MST 2017 +015 bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d .............................................FAIL! rc= 7 at Tue Jan 24 11:52:10 MST 2017 +017 bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s+1850_trop_strat_vbs_cam6 9s .........................FAIL! rc= 7 at Tue Jan 24 12:19:38 MST 2017 +020 bl371 TBL.sh f1.9c6aqwscdh outfrq3s+waccm_sc_amip_cam6 9s .................................FAIL! rc= 4 at Tue Jan 24 12:31:44 MST 2017 +023 bl380 TBL.sh f1.9c6aqcdh atrain 9s ........................................................FAIL! rc= 7 at Tue Jan 24 12:43:28 MST 2017 +026 bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_2000_cam4 9s ...................................FAIL! rc= 7 at Tue Jan 24 13:26:22 MST 2017 +029 bl391 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmxi_2000_cam4 9s ..................................FAIL! rc= 7 at Tue Jan 24 14:08:17 MST 2017 +032 bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s .........................................FAIL! rc= 7 at Tue Jan 24 14:23:08 MST 2017 +035 bl736 TBL.sh h16adtermdh terminator 9s ....................................................FAIL! rc= 7 at Tue Jan 24 14:26:32 MST 2017 +038 bl760 TBL.sh h5c4aqwmdh outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jan 24 14:44:29 MST 2017 +044 eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s .............................FAIL! rc= 7 at Tue Jan 24 14:50:43 MST 2017 + +eq995 is failing due to bug in +cime/cime_config/cesm/machines/config_compilers.xml which defines NO_R16 +for intel. Intel does support quad precision. Jim will remove in future +cime tag. + +yellowstone/intel/aux_cam: All 5 tests PASS baselines. Namelist comparison +still fails. + +hobart/nag: All PASS except: +005 bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s .....................................................FAIL! rc= 7 at Tue Jan 24 09:45:54 MST 2017 +010 bl113 TBL.sh e8c4aqdm outfrq3s+aquaplanet_cam4 9s .........................................FAIL! rc= 7 at Tue Jan 24 09:48:14 MST 2017 +013 bl221 TBL.sh f10spsaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jan 24 09:57:41 MST 2017 +017 bl311 TBL.sh f10c5aqt5mdm ttrac 9s ........................................................FAIL! rc= 7 at Tue Jan 24 10:02:54 MST 2017 +024 bl318 TBL.sh f10c4aqcdm sat_hist 9s .......................................................FAIL! rc= 7 at Tue Jan 24 10:12:14 MST 2017 +027 bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s ...............................................FAIL! rc= 7 at Tue Jan 24 10:16:01 MST 2017 +033 bl338 TBL.sh f10c5aqdm rad_diag_mam 9s ....................................................FAIL! rc= 7 at Tue Jan 24 10:19:49 MST 2017 +036 bl368 TBL.sh f10c6aqdm outfrq3s 9s ........................................................FAIL! rc= 7 at Tue Jan 24 10:24:47 MST 2017 +039 bl426 TBL.sh f10c4aqwmxdm outfrq3s_ionos 9s ...............................................FAIL! rc= 7 at Tue Jan 24 10:31:39 MST 2017 +042 bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s .............................................FAIL! rc= 7 at Tue Jan 24 10:40:13 MST 2017 +045 bl471 TBL.sh f10c6aqwmadm outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Jan 24 10:49:19 MST 2017 +049 bl711 TBL.sh h5c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Tue Jan 24 10:56:40 MST 2017 +056 bl741 TBL.sh h16c6aqdm ghgrmp_unstruct 9s .................................................FAIL! rc= 7 at Tue Jan 24 11:32:12 MST 2017 + +hobart/pgi: All PASS except: +004 bl112 TBL.sh e8c3aqdm outfrq3s+aquaplanet_cam3 9s .........................................FAIL! rc= 7 at Tue Jan 24 09:46:00 MST 2017 +008 bl114 TBL.sh e8c4aqdm co2rmp 9s ...........................................................FAIL! rc= 7 at Tue Jan 24 09:51:37 MST 2017 +012 bl222 TBL.sh f10spmaqdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jan 24 10:49:31 MST 2017 +015 bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s ...............................................FAIL! rc= 7 at Tue Jan 24 10:56:46 MST 2017 +018 bl317 TBL.sh f10c5aqcdm outfrq3s_diags 9s .................................................FAIL! rc= 7 at Tue Jan 24 11:07:12 MST 2017 +021 bl320 TBL.sh f10c5aqpbadm rad_diag 9s .....................................................FAIL! rc= 7 at Tue Jan 24 11:13:49 MST 2017 +024 bl321 TBL.sh f10c5aqcdm atrain 9s .........................................................FAIL! rc= 7 at Tue Jan 24 11:16:07 MST 2017 +027 bl334 TBL.sh f10c5aqudm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jan 24 11:24:23 MST 2017 +030 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Tue Jan 24 11:29:02 MST 2017 +033 bl511 TBL.sh s8c5aqt5mdm ttrac 9s .........................................................FAIL! rc= 7 at Tue Jan 24 11:36:14 MST 2017 +037 bl712 TBL.sh h5c5aqbamdm outfrq3s_bam+aquaplanet_cam5 9s ..................................FAIL! rc= 7 at Tue Jan 24 11:43:02 MST 2017 + +All failing baseline comparisons due to new tests with no available +baseline. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_104 +Originator(s): fvitt, mmills, bardeenc +Date: 23 Jan 2017 +One-line Summary: Updates to chemical tropopause, add SF6 to WACCM6, and updates to compsets + +Purpose of changes: + + Updates to tropopause detection logic used in chemistry, clouds, and CLUBB and + to settings for stratospheric ice formation + + Modify the chemical tropopause definition poleward of 50 degrees from using a + fixed 300 hPa level (see note for 5_4_89) to use the lapse rate tropopause at + P > 125 hPa and the climatology if the lapse rate tropopause is found at + P < 125 hPa or is not found. This eliminates “false†tropopause detection in the + 75 hPa < P < 125 hPa range that are not physical and have a detrimental effect on + heterogeneous chemistry in the polar stratosphere, provides a diagnostic that can + respond to some climate change, and gives a smoother and more physical tropopause + detection across latitude and altitude ranges that improves some diagnostics. + + Change settings for namelist variables that control the use of the tropopause + detection logic (see notes for cam5_4_90 and cam5_4_91) used in heterogeneous + chemistry, stratospheric aerosols, stratospheric clouds, and CLUBB stratospheric + adjustments to all use this new definition. Previous settings were used to + retain bit-for-bit backward compatibility, but these settings represent better + physics. Namelist variables affected are: prescribed_strataero_use_chemtrop, + chem_use_chemtrop, and nucleate_ice_use_troplev. + + Change settings related to clouds and nucleation in the stratosphere to increase + nucleation and decrease dehydration. These include: nucleate_ice_strat, and + cldfrc2m_rhminis. + + Add SF6 to WACCM6 + + Updates to WACCM6 and CAM-Chem build-namelist use case files + + Add FW1850 compset + + Add WACCM to CIME aux_cam test list (FWAMIP and FW1850) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + - add SF6 to flbc_list + - set uwshcu_rpen only when pbl scheme is 'uw' + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - impose these defaults : + nucleate_ice_strat = 1.0 + nucleate_ice_use_troplev = .true. + chem_use_chemtrop = .true. + prescribed_strataero_use_chemtrop = .true. + cldfrc2m_rhminis = 1.0 + +M components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml + - remove the full path to ic files + +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml + - updates to build-namelist use cases + +M components/cam/cime_config/testdefs/testlist_cam.xml + - added ERP_Ld3 FWAMIP test to aux_cam tests + - other adjustments to aux_wcm tests + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 + - added SF6 to this mechanism + +M components/cam/src/physics/cam/clubb_intr.F90 + - correction to the KVH_CLUBB diagnostic + +M components/cam/src/physics/cam/tropopause.F90 + - more realistic chemical tropopuase over the poles (see above) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +008 bl222 TBL.sh f10c5spcammm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Jan 23 14:01:07 MST 2017 +019 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Mon Jan 23 14:01:26 MST 2017 +022 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Jan 23 14:01:42 MST 2017 +026 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Mon Jan 23 14:09:23 MST 2017 +028 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Mon Jan 23 14:12:10 MST 2017 +031 bl456 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam6 9s ......................FAIL! rc= 7 at Mon Jan 23 14:32:18 MST 2017 +034 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Mon Jan 23 14:42:36 MST 2017 +040 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Jan 23 14:56:40 MST 2017 +043 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Mon Jan 23 15:05:49 MST 2017 +045 bl492 TBL.sh f0.9c5.5mam4vbsh outfrq3s+1850_trop_strat_vbs_cam6 9s ........................FAIL! rc= 7 at Mon Jan 23 15:23:58 MST 2017 +048 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Mon Jan 23 15:52:14 MST 2017 +051 bl482 TBL.sh f1.9c5.5wscmam4dh outfrq3s+waccm_sc_amip_cam6 9s .............................FAIL! rc= 7 at Mon Jan 23 16:28:34 MST 2017 +069 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Mon Jan 23 16:54:37 MST 2017 + +yellowstone/intel/aux_cam: +ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_103/ERP_Ld3.f09_f09.FWAMIP.yellowstone_intel.cam-outfrq9s' does not exist +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d (Overall: DIFF), details: + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d BASELINE ERROR BFAIL baseline directory '/glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_103/SMS_Ld1.f09_f09.FW1850.yellowstone_intel.cam-outfrq1d' does not exist +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + +hobart/nag: +058 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Mon Jan 23 11:39:23 MST 2017 +061 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Mon Jan 23 11:52:32 MST 2017 +064 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Jan 23 12:10:36 MST 2017 +073 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Mon Jan 23 12:35:01 MST 2017 +076 bl471 TBL.sh f10c5.5wmam4dm outfrq3s_modalstrat 9s ........................................FAIL! rc= 7 at Mon Jan 23 12:48:02 MST 2017 + +hobart/pgi: All pass + + The baseline failures are expected due to changes in chemistry tropopause and nucleate_ice namelist settings + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all chemistry configurations including cam5 and cam6 +- what platforms/compilers: all +- nature of change : larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/tropopause_cam5_4_97_tags/tropopause02_cam5_4_99 +- platform/compilers: + yellowstone/intel +- configure commandline: + create_newcase -compset F2000_DEV -res f09_f09 -project CESM0005 -mach yellowstone -case /glade/p/work/mmills/case/f.e20.F2000_DEV.f09_f09.tropopause02_cam5_4_99.02 +- MSS location of output: + /home/mmills/csm/f.e20.F2000_DEV.f09_f09.tropopause02_cam5_4_99.02 + +MSS location of control simulations used to validate new climate: + /home/mmills/csm/f.e20.F2000_DEV.f09_f09.cam5_4_99.01 + +URL for AMWG diagnostics output used to validate new climate: + https://acomstaff.acom.ucar.edu/mmills/ccsm-diagnostics/CAM6_170117/tropopause02_cam5_4_99.02-cam5_4_99.01_y2-10/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_103 +Originator(s): goldy +Date: 2017-01-22 +One-line Summary: CAM history bug fixes and Cray directive removal + +Purpose of changes: Fix incorrect coordinate output when using column (patch) + output with unstructured grids. + Fix bug with point processing near prime meridian. + Also, take out old, unused Cray directives which were causing trouble. + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Brought this file over 100 lines closer to the magic 10^5 mark +M components/cam/src/control/cam_history.F90 + - Fixed problems with column output and improved log messages. + - Corrected point coordinate processing near prime meridian. +M components/cam/src/control/cam_history_support.F90 +M components/cam/src/utils/cam_grid_support.F90 +M components/cam/src/utils/cam_map_utils.F90 + - Fixed problem with column output for unstructured grids. +M components/cam/src/dynamics/eul/dyn.F90 +M components/cam/src/dynamics/eul/grcalc.F90 +M components/cam/src/dynamics/eul/hordif.F90 +M components/cam/src/dynamics/eul/linemsdyn.F90 +M components/cam/src/dynamics/eul/spegrd.F90 +M components/cam/src/dynamics/fv/dp_coupling.F90 +M components/cam/src/dynamics/fv/mapz_module.F90 +M components/cam/src/dynamics/fv/tp_core.F90 +M components/cam/src/dynamics/sld/dp_coupling.F90 +M components/cam/src/dynamics/sld/realloc4.F90 +M components/cam/src/dynamics/sld/realloc7.F90 +M components/cam/src/physics/cam/check_energy.F90 +M components/cam/src/physics/cam/cldwat.F90 +M components/cam/src/physics/cam/hk_conv.F90 +M components/cam/src/physics/cam/modal_aer_opt.F90 +M components/cam/src/physics/cam/phys_grid.F90 +M components/cam/src/physics/cam/qneg3.F90 +M components/cam/src/physics/cam/zm_conv.F90 +M components/cam/src/physics/camrt/radlw.F90 +M components/cam/src/physics/camrt/radsw.F90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 +M components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 +M components/cam/src/utils/fft99.F90 +M components/cam/src/utils/spmd_utils.F90 +M components/cam/src/physics/icarus-scops/icarus.f90 + - Took out old, unused Cray performance directives + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: Expected fail due to bad coordinate variables in baseline +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Sat Jan 21 18:19:29 MST 2017 + +yellowstone/intel/aux_cam: Expected fail due to bug in bless_test_results +FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + +hobart/nag: Expected fail due to bad coordinate variables in baseline +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Sat Jan 21 11:18:10 MST 2017 + +hobart/pgi: Expected fail due to bad coordinate variables in baseline +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Sat Jan 21 11:53:02 MST 2017 + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA (answer changes were in column output processing) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_102 +Originator(s): cacraig +Date: Jan 20, 2017 +One-line Summary: Update CLM external to match cesm2_0_beta05 + +Purpose of changes: + - Update the CLM external to match the version which is used + in cesm2_0_beta05. This version is needed for an upcoming CAM tag. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update CLM5 version + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + - Namelists will continue to fail until update cime external + - Update of CLM external changed answers for all these runs which use CLM5 + +hobart/nag: all BFB + +hobart/pgi: all BFB + + -- Answer changes for all jobs which use CLM4.5 or CLM5 due to answer changes in + the CLM tag + +Summarize any changes to answers, i.e., +- what code configurations: all which use CLM4.5 or CLM5 +- what platforms/compilers: all + +=============================================================== +=============================================================== + +Tag name: cam5_4_101 +Originator(s): hannay, cacraig +Date: Jan 17, 2017 +One-line Summary: Match Cecile's #125 configuration (with caveat) + +Purpose of changes: + - This tag matches Cecile's #125 configuration for the atmosphere. The + land is different between 125 and this tag. We verified run 125 was + identical to this run with a two month test case (see the detais below + in the testing section) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + Changed the namelist default settings for CAM6 (and 5.5 and 5.4): + clubb_do_liqsupersat = .false. + micro_mg_berg_eff_factor = 0.7 + clubb_gamma_coef = 0.32 + micro_mg_dcs = 540.D-6 + clubb_c14 = 2.2D0 + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Changed the default namelist settings as described above + - Removed a couple of settings which were set for MG2 without CLUBB + as these are now obsolete. + +M components/cam/bld/namelist_files/use_cases/1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/hist_cam6.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml + - add missing resolution qualifier to bnd_topo file + - remove clubb_do_liqsupersat and clubb_gamma_coef as they are now + set in the defaults + +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_cam + - changed the output precision from double to single to match the resolution + of Cecile's runs to ease comparisons + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - Process rate enhancement for relative variance is removed from the Siefert + and Behang 2001 (SB2001) autoconversion scheme. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except cam5.4, cam5.5 tests due to changes in this tag + +015 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Sat Jan 14 09:29:19 MST 2017 +019 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Sat Jan 14 09:34:47 MST 2017 +022 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Sat Jan 14 09:47:02 MST 2017 +031 bl456 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam6 9s ......................FAIL! rc= 7 at Sat Jan 14 10:27:52 MST 2017 +045 bl492 TBL.sh f0.9c5.5mam4vbsh outfrq3s+1850_trop_strat_vbs_cam6 9s ........................FAIL! rc= 7 at Sat Jan 14 11:18:05 MST 2017 +048 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Sat Jan 14 11:47:12 MST 2017 +051 bl482 TBL.sh f1.9c5.5wscmam4dh outfrq3s+waccm_sc_amip_cam6 9s .............................FAIL! rc= 7 at Sat Jan 14 12:22:32 MST 2017 + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + - namelist failures are due to the namelist files still not be put into the baselines + via bless_test_results + - Baseline failures are due to changes in this tag + +hobart/nag: all BFB except cam5.4, cam5.5 tests due to changes in this tag +055 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Fri Jan 13 18:32:31 MST 2017 +058 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Fri Jan 13 18:56:17 MST 2017 +061 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Fri Jan 13 19:10:11 MST 2017 +064 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Jan 13 19:27:11 MST 2017 +076 bl471 TBL.sh f10c5.5wmam4dm outfrq3s_modalstrat 9s ........................................FAIL! rc= 7 at Fri Jan 13 19:58:06 MST 2017 + +hobart/pgi: all BFB except cam5.4, cam5.5 tests due to changes in this tag +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Fri Jan 13 19:35:33 MST 2017 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all CAM5.4, CAM5.5, CAM6.0 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): New climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): cam5_4_101 +- platform/compilers: yellowstone/intel +- CESM commandline: .//create_newcase --case /glade/scratch/cacraig/aux_cam_20170113152136/SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5.C.aux_cam_20170113152136 --res f09_f09 --mach yellowstone --compiler intel --compset F2000_DEV --test --project P93300606 --user-mods-dir /glade/u/home/cacraig/cam5_4_101-TRUNK/cime/../components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5 --queue=regular --walltime 3:00 +- yellowstone location of output from 13 month run which compared with Cecile's 2 month run: + /glade/p/cesmdata/cseg/ccsm_baselines/cam5_4_101/SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 + +URL for AMWG diagnostics output used to validate new climate: + +Diags for F2000_DEV: +http://webext.cgd.ucar.edu/FCLIMO/f.e20.F2000_DEV.f09_f09.CLUBB_reorder_n05_cam5_4_96/atm/ + +Diags for 125 (for reference with the caveat above): +http://webext.cgd.ucar.edu/B1850/b.e20.B1850.f09_g16.pi_control.all.125/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_100 +Originator(s): cacraig, Minghaui Wang, Mark Branson, fvitt +Date: Jan 12, 2017 +One-line Summary: SPCAM: Bug fix for sam1mom and allow running of spcam_m2005 + +Purpose of changes: + - Super-parameterized CAM (SPCAM) now has the ability to run with the + double moment SAM microphysics (spcam_m2005) in addition to the already + released single moment SAM (spcam_sam1mom) + + - Using the flags: "-nan -v -O0" in the NAG compiler, tracked down all + uninitialized values and fixed them either by initializing + the values, putting assignments within if blocks or limiting array bounds + when passing into subroutines + + - Added FSPCAMM compset. Note that this compset along with FSPCAMS require + a fix in cime to override the threading setting of 2. These two compsets + do not work in this tag out-of-the-box. A fix for this is coming shortly. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - Now allow super-parameterized CAM double moment SAM microphysics to + be run (spcam_m2005) + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/src/physics/spcam/crm/crmx_init.F90 + - This routine was never called + +List all subroutines added and what they do: +A + components/cam/test/system/config_files/f10c5spcammm + - add spcam_m2005 configuration for CAM regression testing + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/configure + - Add a check to prevent turning on threading if using SPCAM as + the underlying CRM model is not threadsafe + - Remove the block on configuring spcam_m2005 + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml + - introduce a compset for spcam_m2005 + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - initialize reff_strat as the variable is intent(out) and + does not keep the initialization which occurred outside this routine + +M components/cam/src/physics/cam/spcam_drivers.F90 + - Bug fix from Mark Branson: Add in a call to sslt_rebin_adv to solve + problems with SSLTA and SSLTC + - Added initializations and if logic around assignments to eliminate + uninitialized variable issues + +M components/cam/src/physics/spcam/crm/crmx_crm_module.F90 +M components/cam/src/physics/spcam/crm/crmx_kurant.F90 +M components/cam/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 +M components/cam/src/physics/spcam/crm/crmx_params.F90 +M components/cam/src/physics/spcam/crmclouds_camaerosols.F90 + - initialized variables which were used before they were set + +M components/cam/src/physics/spcam/crm/crmx_diagnose.F90 + - removed a line which was not initialized before it was used, and + the computed value was not subsequently used (dead code) + +M components/cam/src/physics/spcam/crm_physics.F90 + - removed pbuf fields, prer_evap, relvar and accre_enhan which are + not needed by SPCAM + - initialize pbuf fields which are used by subsequent parameterizations + - limit arrays to only the sections which have been set + + +M components/cam/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 + - bug fix from Minghuai Wang (from his colleage Guangxin Lin) + +M components/cam/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 + - removed dead code which was having issues with uninitialized values + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_yellowstone + - add spcam_m2005 test to CAM regression testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +008 bl222 TBL.sh f10c5spcammm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Jan 9 22:02:39 MST 2017 + No baseline for comparison as this is a new test + +yellowstone/intel/aux_cam: all PASS except namelist failure due to missing archived namelists + +hobart/nag: all BFB except: +017 bl221 TBL.sh f10c5spcamsm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Jan 9 14:57:26 MST 2017 + - The sam1mom version of SPCAM has answer changes due to the introduction of the call to sslt_rebin_adv (bug fix) + +hobart/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_99 +Originator(s): mvertens, goldy +Date: 2017-01-01 +One-line Summary: Update CAM'S configure to be called from the new script, cime_config/buildcpp + +Purpose of changes: CAM'S configure is now called from a new file, + cime_config/buildcpp. buildcpp is primarily now called from + cime_config/buildlib - but can also be called from cime_config/buildnml + for cases where namelist generation needs to occur but a + config_cache.xml file is either not available or is outdated. + - Removed references to CCSM_CO2_PPMV in user_nl_clm testmods files + - Also, fixed FV restart bug which affects PIO2 runs (2395). + +Bugs fixed (include bugzilla ID): 2395 + +Describe any changes made to build system: configure infrastructure updated + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: mvertens, goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +A + components/cam/cime_config/buildcpp + - New CIME script to handle production of CPP variables from case configuration +M components/cam/cime_config/buildlib +M components/cam/cime_config/buildnml + - Added and modified code to be forwards compatible with upcoming CIME + namelist building changes +M components/cam/cime_config/config_component.xml + - Added entry for CAM_CPPDEFS needed by new configure utility script (buildcpp) +M components/cam/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/mam4_fire_emis/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist/user_nl_clm +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/user_nl_clm + - Removed references to deprecated variable, CCSM_CO2_PPMV +M components/cam/doc/ChangeLog_template + - Removed jaguar as a test machine +M components/cam/src/dynamics/fv/restart_dynamics.F90 + - Fixed location of pio_setframe calls which did not work with PIO2 (bugzilla + 2395) +M components/cam/src/dynamics/se/dyn_comp.F90 + - Slight code documentation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: ALL PASS + +yellowstone/intel/aux_cam: All PASS (note that namelist comparison still + broken) + +hobart/nag: ALL PASS + +hobart/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_98 +Originator(s): eaton +Date: Tue Dec 27 11:35:16 MST 2016 +One-line Summary: Remove dependence on CCSM_CO2_PPMV var in CESM scripts; + fix in hist_cam6 use case. + +Purpose of changes: + +. Remove the setting of CAM's co2vmr variable by cam/cime_config/buildnml. + This eliminates CAM's dependence on the CCSM_CO2_PPMV var in CESM scripts. + + CAM's co2vmr namelist variable is only used when flbc_file is not + specified, or scenario_ghg is not set to RAMPED. flbc_file is used by + all CAM-Chem and WACCM configurations, and scenario_ghg is set to RAMPED + in all historical runs that are not CAM-Chem or WACCM. So basically the + only use of co2vmr is for climatology runs of that standard cam physics + packages, or for scam runs with which are short duration and use fixed + co2. + + It turns out this dependency was redunant since the few cases where + co2vmr is used already had values that were consistent with the + CCSM_CO2_PPMV values set in use case files for in the namelist defaults + file. + +. bug fix in hist_cam6 use case file + +Bugs fixed (include bugzilla ID): + +. use case file hist_cam6.xml needed updated srf_emis_specifier files to + allow starting on 1850-01-01 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/namelist_files/use_cases/2000_cam6.xml +components/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +. add 367.0e-6 + +components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam6.xml +components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +. add CYCLICAL + +components/cam/bld/namelist_files/use_cases/scam_arm95.xml +. add 368.9e-6 + +components/cam/cime_config/buildnml +. remove setting co2vmr + +components/cam/bld/namelist_files/use_cases/hist_cam6.xml +. updated srf_emis_specifier files for DMS and SO2 to + allow starting on 1850-01-01 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +yellowstone/intel/aux_cam: All PASS (note that namelist comparison still + broken) + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_97 +Originator(s): fvitt, mmills, tilmes +Date: 8 Dec 2016 +One-line Summary: Update WACCM6 chemistry and remove obsolete compsets + +Purpose of changes: + + - use the latest TSMLT chemistry in WACCM6 + - add specified dynamics compset for WACCM6 FSDW + - remove unsupported obsolete compsets and associated build namelist + use case files and regression tests + - add default fields to h0 history when history_chemistry is TRUE + - correction in how emissions scaling factor is applied + +Bugs fixed (include bugzilla ID): + + correction in emissions scaling factor + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/src/chemistry/pp_trop_mozart_mam3 +D components/cam/src/chemistry/pp_trop_strat_soa +D components/cam/src/chemistry/pp_trop_strat_mam3 +D components/cam/src/chemistry/pp_trop_mozart_soa +D components/cam/src/chemistry/pp_trop_strat_mam7 + - remove obsolete chem packages + +D components/cam/test/system/tests_ccmi_mpi +D components/cam/test/system/tests_ccmi_hybrid + - these no longer apply + +D components/cam/test/system/config_files/f1.9c5tsmam7h +D components/cam/test/system/config_files/f4c5tsmam3dm +D components/cam/test/system/config_files/f4c5tsmam7dm +D components/cam/test/system/config_files/f4c5mzmam3dm +D components/cam/test/system/config_files/fsd1.9c4wtssoadh +D components/cam/test/system/config_files/f1.9c4tssoadh +D components/cam/test/system/config_files/f1.9c4wtssoadh +D components/cam/test/system/config_files/f4c4soadm +D components/cam/test/system/config_files/f1.9c4soadh +D components/cam/test/system/config_files/f1.9c5tsmam3dh +D components/cam/test/system/config_files/f4c4wtssoadh +D components/cam/test/system/config_files/f4c4wtssoadm +D components/cam/test/system/config_files/fsd1.9c4wtssoah +D components/cam/test/system/config_files/f1.9c5mzmam3dh + - remove these obsolete configure files + +D components/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp26.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_1850_cam4.xml +D components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +D components/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +D components/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +D components/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +D components/cam/bld/namelist_files/use_cases/cam5_trop_strat_chem.xml +D components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +D components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/2005-2100_cam4_strataero_rcp45.xml +D components/cam/bld/namelist_files/use_cases/2000_cam4_trop_moz_soa.xml +D components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +D components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +D components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +D components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +D components/cam/bld/namelist_files/use_cases/mozart_megan_emis.xml +D components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +D components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +D components/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +D components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp45.xml +D components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +D components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp85.xml +D components/cam/bld/namelist_files/use_cases/2000_cam5_trop_moz_mam3.xml +D components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +D components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +D components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +D components/cam/bld/namelist_files/use_cases/waccm_refb1.xml +D components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +D components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +D components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +D components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +D components/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +D components/cam/bld/namelist_files/use_cases/1850_cam4_trop_bam.xml +D components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +D components/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +D components/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +D components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +D components/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml +D components/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/sd_cam5_trop_strat_mam3.xml +D components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +D components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml + - remove obsolete use cases + +D components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam55.xml +D components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam55.xml + +D components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml +D components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +D components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml + +D components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam55.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam55.xml + +D components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam55.xml +D components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam55.xml +D components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam55.xml + - most of these *cam55.xml use cases were renamed as *cam6.xml + +List all subroutines added and what they do: + +A components/cam/test/system/config_files/fsd0.9c5.5wtsmlth + - new test configure for 1-degree SD WACCM + +A components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +A components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +A components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +A components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml + - new use cases for cam6 physics + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 + - use the latest TSMLT chemistry in WACCM + +M components/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - correction in the scaling factor + +M components/cam/src/chemistry/mozart/mo_extfrc.F90 + - correction in the scaling factor + - added default history to h0 when history_chemistry is TRUE + +M components/cam/src/chemistry/modal_aero/aero_model.F90 +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 +M components/cam/src/chemistry/mozart/chemistry.F90 + - added default history to h0 when history_chemistry is TRUE + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - remove unused history_aerosol variable + +M components/cam/test/system/tests_posttag_yellowstone +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/tests_waccm_mpi + - obsolete test were removed + +M components/cam/test/system/config_files/f4c5portdm +M components/cam/test/system/config_files/f4c5portdh + - use trop_mam3 chem -- trop_strat_mam3 no longer exists + +M components/cam/test/system/tests_titan +M components/cam/test/system/tests_pretag_yellowstone +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_chem_hybrid +M components/cam/test/system/tests_chem_mpi + - obsolete test were removed + - waccm6 tests were adjusted + +M components/cam/test/system/nl_files/outfrq3s_sd + - use megan emis factors file compatible with clm4 + +M components/cam/bld/config_files/definition.xml + - adjust list of allowed chem configure options + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - new megan factors file + - remove defaults for obsolete chemistry packages + - increase default fv_nsplit from 12 to 16 for 1-degree waccm + +M components/cam/bld/namelist_files/namelist_definition.xml + - adjust the list of possible chemistry packages + +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml + - correction in rate_sums specifier + +M components/cam/bld/build-namelist + - adjustment to the flbc_list for TSMLT chemistry + - removed references to obsolete chem packages + +M components/cam/bld/configure + - adjust the list of possible chemistry packages + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/config_component.xml + - clean out obsolete compsets + - add FSDW compset for waccm6 + +M components/cam/cime_config/testdefs/testlist_cam.xml + - test the supported waccm6 compsets + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +027 bl456 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam6 9s ......................FAIL! rc= 7 at Wed Dec 7 23:47:31 MST 2016 +044 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Thu Dec 8 00:59:34 MST 2016 + - expected failures due to changes in waccm_tsmlt_mam4 chemistry mechanism + +041 bl492 TBL.sh f0.9c5.5mam4vbsh outfrq3s+1850_trop_strat_vbs_cam6 9s ........................FAIL! rc= 7 at Thu Dec 8 00:32:58 MST 2016 + - new test for yellowstone + +047 bl482 TBL.sh f1.9c5.5wscmam4dh outfrq3s+waccm_sc_amip_cam6 9s .............................FAIL! rc= 7 at Thu Dec 8 01:34:46 MST 2016 + - expected failure due to changes in waccm_sc_amip_cam6 usecase + +yellowstone/intel/aux_cam: All PASS (note NLCOMP tests failed due to lack archived of namelist files from baseline runs) + +hobart/nag: + +082 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Wed Dec 7 18:42:33 MST 2016 + - expected failure due to the chemistry mechanism used in f4c5portdm changed from "trop_strat_mam3" to "trop_mam3" + -- trop_strat_mam3 chemistry package is removed in this commit + +hobart/pgi: + +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Wed Dec 7 18:30:19 MST 2016 + - expected failure due to the chemistry mechanism used in f4c5portdm changed from "trop_strat_mam3" to "trop_mam3" + -- trop_strat_mam3 chemistry package is removed in this commit + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: waccm_tsmlt_mam4 chemistry, waccm use cases +- nature of change: CAM is bit-for-bit unchanged while WACCM (waccm_tsmlt_mam4 chemistry) has changed + +=============================================================== +=============================================================== + +Tag name: cam5_4_96 +Originator(s): goldy +Date: 2016-12-04 +One-line Summary: Add analytic initial conditions options + +Purpose of changes: Enable setting initial conditions to analytic + functions for testing purposes (e.g., dycore validation). + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + - New namelist item, analytic_ic_type (see below) + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: eaton, cacraig, fvitt, goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: + - analytic_ic_readnl ! Read dyn_test_nl namelist + - analytic_ic_active ! .true. if analytic IC should be set + - analytic_ic_set_ic ! Set analytic initial conditions + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist + - Added new namelist item, analytic_ic_type, to determine which type of + analytic initial condition to use (or none). + - Make sure that use_topo_file is always expressed in namelist +M components/cam/bld/config_files/definition.xml + - Added new config switch, analytic_ic, to enable conditional compilation + of initial condition code. +M components/cam/bld/configure + - Added new config switch, analytic_ic, to enable conditional compilation + of initial condition code. +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Set default for analytic_ic_type (none) + - Set defaults for use_topo_file +M components/cam/bld/namelist_files/namelist_definition.xml + - Added new namelist item, analytic_ic_type, to determine which type of + analytic initial condition to use (or none). +M components/cam/bld/namelist_files/use_cases/dctest_baro_moist.xml + - Added an analytic_ic_type setting (baroclinic_wave) +M components/cam/cime_config/config_component.xml + - Added analytic_ic to the CAM%DCTBM compset. +M components/cam/doc/ChangeLog + - Made this file great again. +M components/cam/src/control/runtime_opts.F90 + - Read the analytic IC namelist (analytic_ic_readnl) +M components/cam/src/dynamics/eul/dyn_comp.F90 + - Add analytic initial condition reading to Eulerian dycore +M components/cam/src/dynamics/fv/dyn_comp.F90 + - Add analytic initial condition reading to finite volume dycore +M components/cam/src/dynamics/se/dyn_comp.F90 + - Add analytic initial condition reading to spectral element dycore +M components/cam/src/dynamics/sld/dyn_comp.F90 + - Add analytic initial condition reading to SLD dycore +A + components/cam/src/dynamics/tests/dyn_tests_utils.F90 + - Added parameters for vertical coordinate type +A + components/cam/src/dynamics/tests/inic_analytic.F90 + - Main interface for analytic initial conditions. +A + components/cam/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 + - Implementation of analytic initial conditions for baroclinic wave tests. +A + components/cam/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 + - Implementation of analytic initial conditions for Held-Suarez tests. +M components/cam/src/physics/cam/const_init.F90 + - Clarify when a variable is not found on initial dataset. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +yellowstone/intel/aux_cam: All PASS - note that the comparison of namelist + file is broken. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_95 +Originator(s): toniazzo, eaton +Date: Fri Dec 2 09:09:05 MST 2016 +One-line Summary: add option for angular momentum correction in FV dycore + +Purpose of changes: + +. Add angular momentum correction/fixer/diagnostic for the FV dycore from + Thomas Toniazzo . The new code is optional, off + by default, and controlled by the new namelist variables described below. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add namelist vars to control AM corrections: + logical :: fv_am_correction ! apply correction for angular momentum (AM) + ! conservation in SW eqns (default: .false.) + logical :: fv_am_fixer ! apply global fixer to conserve AM (default: .false.) + logical :: fv_am_fix_lbl ! apply AM fixer level by level (default: .false.) + logical :: fv_am_diag ! turn on an AM diagnostic calculation + ! written to log file (default: .false.) + +List any changes to the defaults for the boundary datasets: + +. The default FV, 2deg, 30 level ncdata file is changed + From: cami_0000-01-01_1.9x2.5_L30_c070703.nc + To: cami-mam3_0000-01-01_1.9x2.5_L30_c090306.nc + - this was done to simplify the attributes for the standard cam5 + configuration, which in turn allowed simplifying the attributes for the + cam5/aquaplanet ncdata file. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +components/cam/src/dynamics/fv/angular_momentum.F90 +. new subroutine for calculating the AM diagnostics which are output to the + log file. + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. Update attributes for the default FV 2deg L30 ncdata file. This was done + to fix a problem getting the correct default for the corresponding ncdata + file for aquaplanet. + +components/cam/bld/namelist_files/namelist_definition.xml +. Add namelist vars to control AM corrections: + logical :: fv_am_correction ! apply correction for angular momentum (AM) + ! conservation in SW eqns + logical :: fv_am_fixer ! apply global fixer to conserve AM + logical :: fv_am_fix_lbl ! apply AM fixer level by level + logical :: fv_am_diag ! turn on an AM diagnostic calculation written to log file + +components/cam/src/dynamics/fv/cd_core.F90 +. add control logicals for correction and fixer +. and output args for fixer +. remove obsolete !CSD$ directives +. pass am_correction to d2a2c_winds +. pass am_correction to d_sw, get ddpa and ddu back + +components/cam/src/dynamics/fv/d2a3dikj.F90 +. pass am_correction to d2a3dikj +. new code inside am_correction conditionals + +components/cam/src/dynamics/fv/dp_coupling.F90 +. access am_correction via dyn_state object, and pass to routines d2a3dikj + and uv3s_update + +components/cam/src/dynamics/fv/dyn_comp.F90 +. dyn_readnl + - add new namelist vars to namelist reader + - add check that fv_am_fixer must be true when fv_am_fix_lbl is true + - call phys_setopts to set fv_am_correction in the phys_control module +. dyn_run + - add AM conservation diagnostic + - add AM fixer + - pass am_correction to te_map + +components/cam/src/dynamics/fv/dyn_grid.F90 +. dyn_grid_init + - pass am_correction to grid_vars_init + +components/cam/src/dynamics/fv/dynamics_vars.F90 +. add AM control variables to the t_fvdycore_state derived type +. grid_vars_init + - add dummy arg for am_correction + - modified calc of cose, sinp, and fc inside conditionals +. remove unused routines + +components/cam/src/dynamics/fv/sw_core.F90 +. c_sw + - new calc of va +. d_sw + - add am_correction, ddp, duc to dummy args +. d2a2c_winds + - add am_correction to dummy args + - mods inside am_correction conditional + +components/cam/src/dynamics/fv/te_map.F90 +. add am_correction to dummy args +. mods inside am_correction conditional + +components/cam/src/dynamics/fv/uv3s_update.F90 +. add am_correction to uv3s_update dummy args +. mods inside am_correction conditional + +components/cam/src/physics/cam/diffusion_solver.F90 +. set module variable am_correction via init_vdiff method +. mod inside am_correction conditional + +components/cam/src/physics/cam/phys_control.F90 +. add fv_am_correction module data +. add phys_setopts method to allow setting fv_am_correction from the + dyn_readnl method + +components/cam/src/physics/cam/vertical_diffusion.F90 +. pass fv_am_correction to init_vdiff + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Dec 1 20:02:11 MST 2016 + +This failure is due to a change in the default IC files. + +yellowstone/intel/aux_cam: All PASS - note that the comparison of namelist + file is broken. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_94 +Originator(s): cacraig +Date: Nov 28, 2016 +One-line Summary: Update to cesm2_beta04 externals and bug fix cice5 tag + +Purpose of changes: + - Update CAM externals to match those used in cesm2_beta04 + - Using a more recent CICE tag which corrects an issue in F compsets when using the + tag in cesm2_beta04 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - All compsets are now using CISM2 + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cesm2_beta04 externals + - update to bug fix cice external to fix issue with F compsets + +M components/cam/cime_config/config_compsets.xml + - have compsets now use CISM2 + - add grid file for CISM2 as specified by Cecile + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add aux_short test for F1850_DONOTUSE + +M components/cam/test/system/archive_baseline.sh + - added CESM_TESTDIR environment variable to archive_baseline.sh for yellowstone + to enable the archiving of the CESM tests + NOTE -- The CESM_TESTDIR can be found by looking in the file in test/system + and by default is called something like aux_cam_test_20161123172411.log + +M components/cam/test/system/test_driver.sh + - removed generate capability from CESM tests - will generate the baselines in + the archive_baseline script + - removed the required test-id which was used for generating baselines + - added CESM_TESTDIR environment variable for yellowstone runs. User can specify + or by default it will create a dir called something like aux_cam_test_20161123172411 + in /glade/scratch/$USER on yellowstone + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Thu Nov 24 04:12:02 MST 2016 +008 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Thu Nov 24 04:15:05 MST 2016 +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Nov 24 04:26:42 MST 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Thu Nov 24 04:32:22 MST 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Nov 24 04:44:23 MST 2016 +022 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Thu Nov 24 05:00:11 MST 2016 +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Thu Nov 24 05:02:39 MST 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Thu Nov 24 05:27:13 MST 2016 +030 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Thu Nov 24 05:37:24 MST 2016 +033 bl397 TBL.sh f1.9c4cm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Thu Nov 24 05:40:18 MST 2016 +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Nov 24 05:51:30 MST 2016 +039 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Thu Nov 24 05:59:37 MST 2016 +041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Nov 24 06:08:55 MST 2016 +044 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Thu Nov 24 06:27:15 MST 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Thu Nov 24 06:52:20 MST 2016 +050 bl482 TBL.sh f1.9c5.5wscmam4dh outfrq3s+waccm_sc_amip_cam55 9s ............................FAIL! rc= 7 at Thu Nov 24 07:32:34 MST 2016 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Thu Nov 24 07:39:05 MST 2016 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Thu Nov 24 07:40:35 MST 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Thu Nov 24 08:00:14 MST 2016 + + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 BASELINE + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 TPUTCOMP Error: Computation time increase > 25% from baseline +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: DIFF), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 BASELINE +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: DIFF), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 BASELINE + + +hobart/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Nov 22 09:52:45 MST 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Nov 22 09:56:48 MST 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Nov 22 10:00:03 MST 2016 +017 bl221 TBL.sh f10c5spcamsm outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Nov 22 10:07:16 MST 2016 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Nov 22 10:12:26 MST 2016 +031 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Nov 22 10:21:54 MST 2016 +037 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Tue Nov 22 10:30:28 MST 2016 +040 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Nov 22 10:33:31 MST 2016 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Nov 22 10:37:42 MST 2016 +049 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Tue Nov 22 10:41:09 MST 2016 +055 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Nov 22 10:55:59 MST 2016 +058 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Tue Nov 22 11:18:54 MST 2016 +061 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Nov 22 11:31:21 MST 2016 +064 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Nov 22 11:46:55 MST 2016 +070 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Nov 22 11:59:49 MST 2016 +073 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Tue Nov 22 12:07:11 MST 2016 +076 bl471 TBL.sh f10c5.5wmam4dm outfrq3s_modalstrat 9s ........................................FAIL! rc= 7 at Tue Nov 22 12:16:28 MST 2016 +079 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Nov 22 12:35:55 MST 2016 + +hobart/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Nov 22 09:56:51 MST 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Nov 22 10:05:00 MST 2016 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Nov 22 10:14:05 MST 2016 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Nov 22 10:27:31 MST 2016 +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Nov 22 10:49:15 MST 2016 +036 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Tue Nov 22 10:55:24 MST 2016 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Nov 22 11:11:18 MST 2016 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Nov 22 11:18:33 MST 2016 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Nov 22 11:20:13 MST 2016 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Nov 22 11:22:55 MST 2016 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Nov 22 11:31:17 MST 2016 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Nov 22 11:51:04 MST 2016 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Nov 22 12:02:08 MST 2016 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Nov 22 12:12:11 MST 2016 + + +** All failing baselines are due to changes in the external components + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): https://svn-ccsm-models.cgd.ucar.edu/cam1/test_tags/cam5_4_94_n01 +- platform/compilers: yellowstone/intel +- configure commandline: Using the F2000_DEV compset +- build-namelist command (or complete namelist): + - To get the CLM namelist changes which mimic Cecile's runs, users need to add to their create_newcase the option: + --user-mods-dir ../../../components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5 + ** NOTE ** This directory name will be changing in a future tag +- MSS location of output: +Currently: /glade/p/cesm0005/archive/f.e20.F2000_DEV.f09_f09.cam5_4_94_n01 +Plan to put at: /CCSM/csm/f.e20.F2000_DEV.f09_f09.cam5_4_94_n01 (yellowstone is + currently down and have not been able to send these files to long-term archive) + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e20.F2000_DEV.f09_f09.cam5_4_94_n01/atm/f.e20.F2000_DEV.f09_f09.cam5_4_94_n01-f.e15.F2000_DEV.f09_f09.cam5_4_89.119/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_93 +Originator(s): jjb278, brianpm, olson, eaton +Date: Wed Nov 2 08:55:33 MDT 2016 +One-line Summary: Aquaplanet mods for cesm2. + +Purpose of changes: + +. Add option to fix the cloud droplet and crystal number concentrations in MG. + +. Remove the mg1_5 development code which is superseded by mg2_0. + +. Fix broken namelist variable aqua_planet_sst to set options for the + analytic SSTs. + +. Mods to configure and buildnamelist to support SOM aquaplanet. + +Bugs fixed (include bugzilla ID): + +. Fix the aqua_planet_sst variable which has been broken longer than anyone + can remember. + +Describe any changes made to build system: + +. configure + - remove option '-microphys mg1.5' + - add -aquaplanet switch to turn on the aqua-planet mode in CAM. By + default this switch also sets the -ocn option to aquaplanet, but + this can be overridden from the command line. + - add option '-ocn som' to support aquaplanet with SOM using CAM + standalone scripts + +Describe any changes made to the namelist: + +. Add variables to allow fixing the cloud droplet and crystal numbers in MG + - micro_mg_nccons - set .true. to hold cloud droplet number constant + - micro_mg_nicons - set .true. to hold cloud ice number constant + - micro_mg_ncnst - droplet num concentration when nccons=.true. (default: 100.e6 m-3) + - micro_mg_ninst - ice num concentration when nicons=.true. (default: 0.1e6 m-3) + +. modify output of docn namelist and stream files as appropriate for som. + +List any changes to the defaults for the boundary datasets: + +. Added the following initial condition files for aquaplanet runs: + + aqua_0006-01-01_0.9x1.25_L26_c161020.nc: FV, 1-deg, cam4 phys + aqua_0006-01-01_0.9x1.25_L30_c161020.nc: FV, 1-deg, cam5 phys + aqua_0006-01-01_0.9x1.25_L32_c161020.nc: FV, 1-deg, cam5.5 phys + + aqua_0006-01-01_1.9x2.5_L26_c161020.nc : FV, 2-deg, cam4 phys + aqua_0006-01-01_1.9x2.5_L30_c161020.nc : FV, 2-deg, cam5 phys + aqua_0006-01-01_1.9x2.5_L32_c161020.nc : FV, 2-deg, cam5.5 phys + + aqua_0006-01-01_ne30_np4_L26_c161027.nc: SE, 1-deg, cam4 phys + aqua_0006-01-01_ne30_np4_L30_c161027.nc: SE, 1-deg, cam5 phys + aqua_0006-01-01_ne30_np4_L32_c161027.nc: SE, 1-deg, cam5.5 phys + + aqua_0006-01-01_ne16_np4_L26_c161027.nc: SE, 2-deg, cam4 phys + aqua_0006-01-01_ne16_np4_L30_c161027.nc: SE, 2-deg, cam5 phys + aqua_0006-01-01_ne16_np4_L32_c161027.nc: SE, 2-deg, cam5.5 phys + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/physics/cam/micro_mg1_5.F90 +. remove old development code + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +. write aquaplanet namelist to file aquap_in +. modify output of docn namelist and stream files as appropriate for som. + +components/cam/bld/config_files/definition.xml +components/cam/bld/configure +. remove mg1.5 as valid option +. add -aquaplanet switch. +. allow 'som' as a valid value for -ocn option. SOM is implemented using + the DOCN component. + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. change attribute ocn="aquaplanet" to aquaplanet="1" in ncdata elements. +. add bndtvs and focndomain entries for som testing. + +components/cam/bld/namelist_files/namelist_definition.xml +. entries for micro_mg_nccons, micro_mg_nicons, + micro_mg_ncnst, micro_mg_ninst +. remove mg1.5 as valid option + +components/cam/cime_config/buildnml +. add code to copy the new aquap_in file to the run directory. + +components/cam/src/physics/cam/micro_mg1_0.F90 +. add 4 new variables that are namelist settable + - nccons - set .true. to hold cloud droplet number constant + - nicons - set .true. to hold cloud ice number constant + - ncnst - droplet num concentration when nccons=.true. (default: 100.e6 m-3) + - ninst - ice num concentration when nicons=.true. (default: 0.1e6 m-3) + +components/cam/src/physics/cam/micro_mg2_0.F90 +. Set nccons, nicons, ncnst, ninst via the initialization method from + namelist specified values. + +components/cam/src/physics/cam/micro_mg_cam.F90 +. add namelist variables (micro_mg_nccons, micro_mg_nicons, + micro_mg_ncnst, micro_mg_ninst) to allow constant number concentrations + and pass through the init method arg list. +. update mpi_bcast calls and add log output for namelist settings +. remove calls to mg1.5 routines + +components/cam/utils/cam_aqua/ocn_comp.F90 +. add namelist reader for aqua_planet_sst to set analytic SST option + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +060 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Tue Nov 1 21:17:44 MDT 2016 +063 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Nov 1 21:29:12 MDT 2016 +072 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Tue Nov 1 21:49:17 MDT 2016 + +yellowstone/intel/aux_cam: PASS + +hobart/nag: all PASS except +067 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Mon Oct 31 14:49:43 MDT 2016 + +hobart/pgi: all PASS except +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Mon Oct 31 14:55:16 MDT 2016 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. The aquaplanet tests that failed +baselines are using new IC files. + +=============================================================== +=============================================================== + +Tag name: cam5_4_92 +Originator(s): cacraig +Date: Oct 27, 2016 +One-line Summary: Update to current cime (to restore auto-resubmit functionality) + +Purpose of changes: + - Update to current cime version - this will enable auto-resubmit to work again + - This version of cime requires a namelist parameter "cime_model" and the contents of + the docn_ocn_in file is now in ocn_in. + - Added FC6AQUAP compset + - Update the testlist format to version 2 + - Remove "-file xx" from xmlchange commands in CAM regression testing scripts + - Added the ability for the CAM test_driver to rerun the CESM tests and only rerun + the parts which did not PASS + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + M . +M SVN_EXTERNAL_DIRECTORIES + - update to current cime tag + - this fixes the issues with auto-restart + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml + - cime_model is now a required namelist variable, hardwire it to cesm + - docn_ocn_in is no longer a separate file. Incorporate all its + values in ocn_in + +M components/cam/cime_config/config_compsets.xml + - add in aquaplanet compset at the request of Brian Medeiros and Jim Benedict + +M components/cam/cime_config/testdefs/testlist_cam.xml + - update to the version 2 of the testlist format + +M components/cam/test/system/TCB_ccsm.sh +M components/cam/test/system/TER_ccsm.sh + - remove "-file xx" from xmlchange as it no longer is an allowed field (xmlchange + internally determines which file it needs to modify) + +M components/cam/test/system/test_driver.sh + - add two new flags, "--rerun-cesm" and "--test-id" + * rerun-cesm will rerun the failed tests + * test-id is used to specify the actual testname + - if CAM_TAG is supplied, the CESM jobs will be collected in that directory in + the user's /glade/scratch directory + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: all BFB +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 NLCOMP +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: NLFAIL), details: + FAIL SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 NLCOMP + + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_91 +Originator(s): fvitt, mmills, tilmes, dkin +Date: 21 Oct 2016 +One-line Summary: WACCM chemistry and other msic updates -- "Phase 3" science changes + +Purpose of changes: + + - Use vectorized implicit solver for the waccm_tsmlt_mam4 chemistry + - Include chemistry preprocessor capable of generating vectorized solvers + - Update chemistry in waccm_tsmlt_mam4 mechanism -- includes: + . VBS SOA scheme + . JPL15 rates + - Add chemical forcings associated with energetic particle ionization + to WACCM6 build-namelist use cases + - Unify tropopause definition for chemistry and aerosol processes for consistency + - Use CFC 11* climate forcings in SC-WACCM + - SAD calculation change for chemistry + - Update JEUV heating efficiency for WACCM and WACCMX + - Add EPP settings to WACCM6 build-namelist use cases + - Fix a bug in mo_strato_rates + - Removed obsolete chemistry packages which were for WACCM with 3-mode aerosol scheme + +Bugs fixed (include bugzilla ID): + + - mo_strato_rates + . gamma terms need to be added rather than multipled -- dkin + - epp_ionization + . a correction in the error checking logic + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + The following namelist options are added to keep CAM bit-for-bit unchanged. + These may be removed in the future. + + prescribed_strataero_use_chemtrop (logical): + Indicates whether to use the unified chemistry tropopause method to set prescribed + stratospheric aerosols below the tropopause to zero. This has a maximum altitude + level corresponding to 300 hPa for latitudes poleward of 50 degrees. + Default: set by build-namelist + + chem_use_chemtrop (logical): + Indicates whether to use the unified chemistry tropopause method to set the + tropopause used in gas phase and aerosol chemical processes. This has a maximum + altitude level corresponding to 300 hPa for latitudes poleward of 50 degrees. + Default: set by build-namelist + + + The following modification to the existing namelist option is for very long rate + summation strings in the namelist. + + rxn_rate_sums (char*256(200)): + Give the user the ability to specify rate families (or groupings) diagnostics based + on reaction tag names. These group names can be added to history fincl variables. + To indicate the summation continues with next string use "&" character at the end + of the string. + Example: + rate_sums = + 'OX_P = NO_HO2 + CH3O2_NO + 2*jo2_b ... ', + 'OX_L = NO2_O_M + HO2_O3 + CLO_O ...', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 &', + '+ CH3CO3_CH3CO3 + CH3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 ...', + fincl1 = 'OX_P','OX_L', 'RO2_RO2_sum', ... + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +D components/cam/src/chemistry/mozart/mo_exp_sol.F90 + - now each mechanism has it's own version of exp_sol which may + or may not be vectorized + +D components/cam/src/chemistry/pp_waccm_ma_mam3 +D components/cam/src/chemistry/pp_waccm_sc_mam3 + - removed the waccm 3-mode mechanism -- 4-mode aerosol scheme is preferred + +D components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +D components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam5.xml +D components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +D components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml + - removed these obsolete use cases + +D components/cam/test/system/config_files/f1.9c5wmam3dh +D components/cam/test/system/config_files/f10c5wmam3dm +D components/cam/test/system/config_files/f1.9c5wscmam3dh +D components/cam/test/system/config_files/f1.9c5wscmam3dm +D components/cam/test/system/config_files/f1.9c5wmam3h +D components/cam/test/system/config_files/f1.9c5wmclbdh +D components/cam/test/system/config_files/f4c5wmclbdh +D components/cam/test/system/config_files/f10c5wscmam3dm + - removed these obsolete test configurations + +List all subroutines added and what they do: + +A components/cam/src/chemistry/mozart/chem_prod_loss_diags.F90 + - a utility module to be shared by scalar and vectorized solvers + to output chemistry production and loss diagnostics + +A components/cam/bld/namelist_files/use_cases/waccm_ma_amip_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_ma_1850_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_sc_amip_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam55.xml + - some new waccm mid-atmos and simplified-chem use cases + +A components/cam/src/chemistry/pp_super_fast_llnl/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mozart_mam3/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_none/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mam3/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mam4/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_strat_soa/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_bam/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mam7/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_ma/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_ghg/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_strat_mam3/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_sc/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mozart/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_mozart_soa/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_strat_mam7/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_terminator/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 + - each chem package has it's own version of explicit solver and may differ + depending on if the solvers are scalar or vector versions + +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc +A components/cam/src/chemistry/pp_waccm_sc_mam4/chem_mech.in +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 +A components/cam/src/chemistry/pp_waccm_sc_mam4 + - waccm_sc_mam4 replaces pre-existing waccm_sc_mam3 chem package + +A components/cam/test/system/config_files/f1.9c5.5wmam4h +A components/cam/test/system/config_files/f10c5.5wmam4dm +A components/cam/test/system/config_files/f1.9c5.5wmam4dh +A components/cam/test/system/config_files/f1.9c5.5wscmam4dh +A components/cam/test/system/config_files/f1.9c5.5wscmam4dm +A components/cam/test/system/config_files/f10c5.5wscmam4dm + - some test config files for testing 4-mode aerosol scheme in waccm + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - define defaults for use_chemtrop namelist options + - remove obsolete waccm*mam3 defaults and add defaulls for waccm*mam4 + +M components/cam/bld/namelist_files/namelist_definition.xml + - new namelist options added (see above) + +M components/cam/bld/configure + - adjustment to the list of available chemistry packages + - removal of refrence to waccmx_ma chemistry which does not exit + +M components/cam/bld/build-namelist + - set defaults for new *_chemtrop options (see above) + - removal of refrence to waccmx_ma chemistry which does not exit + - misc chemistry corrections + +M components/cam/bld/config_files/definition.xml + - adjustments to the list of chemsitry packages + +M components/cam/src/physics/cam/modal_aer_opt.F90 + - addded aerosol optics diagnostics + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - provide effective radius for use in chemistry + +M components/cam/src/chemistry/bulk_aero/aero_model.F90 + - interface change + +M components/cam/src/chemistry/mozart/epp_ionization.F90 + - bug fix in the error checking logic + +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/mo_jeuv.F90 + - update JEUV heating efficiency + +M components/cam/src/chemistry/mozart/rate_diags.F90 + - allow very long summation strings to be continued in the next + string in the summation list in the namelist + +M components/cam/src/chemistry/mozart/chemistry.F90 + - mods relevant to the unified chemistry tropopause level + +M components/cam/src/chemistry/mozart/exbdrift.F90 + - removed outfld calls for ion drift velocities which is done in iondrag + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - mods relevant to the unified chemistry tropopause level + - SAD diagnostics for troposphere and stratopshere + - effective radius diagnostics + +M components/cam/src/chemistry/mozart/cfc11star.F90 + - added ability to use prescribed CFC tracers to compute CFCSTAR + +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - allow wet removal of 'NDEP' and 'NHDEP' + +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - JPL15 updates + - effective radius changes + +M components/cam/src/chemistry/mozart/mo_strato_rates.F90 + - Doug's bug fix + + +M components/cam/src/chemistry/utils/prescribed_strataero.F90 + - convert radius units from centimeters to meters + - accept SAD units of cm2/cm3 in addition ot um2/cm3 + - option to use chemtrop method for tropopause level below which to zero out aerosols + +M components/cam/src/chemistry/utils/tracer_data.F90 + - improvement on error message + +M components/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_none/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_none/chem_mods.F90 +M components/cam/src/chemistry/pp_none/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_none/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_none/mo_phtadj.F90 +M components/cam/src/chemistry/pp_none/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_none/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_none/mo_indprd.F90 +M components/cam/src/chemistry/pp_none/m_spc_id.F90 +M components/cam/src/chemistry/pp_none/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_mam3/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_bam/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_bam/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mam7/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_mam7/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_ma/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_ma/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_ghg/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_ghg/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_sc/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_sc/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_sc/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_terminator/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_terminator/chem_mods.F90 +M components/cam/src/chemistry/pp_terminator/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_terminator/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_terminator/m_rxt_id.F90 +M components/cam/src/chemistry/pp_terminator/mo_phtadj.F90 +M components/cam/src/chemistry/pp_terminator/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_terminator/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_terminator/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_terminator/mo_indprd.F90 +M components/cam/src/chemistry/pp_terminator/m_spc_id.F90 +M components/cam/src/chemistry/pp_terminator/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_terminator/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +- all of the chemistry mechanism needed to be re-preprocessed due to changes in + the interface between chemdr and the chemical solvers + +M components/cam/test/system/config_files/f1.9c5.4wtclbh +M components/cam/test/system/config_files/f1.9c5.4wtclbdh +M components/cam/test/system/config_files/f1.9c5.5wtmam4h +M components/cam/test/system/config_files/fsd1.9c5.4wtclbh + - use a reduced pcol settings (max number of columns in each physics chunk) to + mitigate issues with memory footprint in the vectorized implicit solver used + in the waccm_tsmlt_mam4 chemistry package + +M components/cam/test/system/input_tests_master + +M components/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_ma_2000_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml + +M components/cam/bld/namelist_files/master_aer_drydep_list.xml +M components/cam/bld/namelist_files/master_aer_wetdep_list.xml +M components/cam/bld/namelist_files/master_gas_drydep_list.xml +M components/cam/bld/namelist_files/master_gas_wetdep_list.xml + - mods needed for the VBS scheme and updated TSMLT chemistry + +M components/cam/cime_config/config_pes.xml + - removed PER_NODE settting for yellowstone 2-degree FV that did not make sense + - added default PE layout for waccm + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml +M components/cam/cime_config/config_component.xml + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - use chem preprocessor capable of providing vectorized solvers + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +td.183021.status:022 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Fri Oct 21 02:24:34 MDT 2016 +td.183021.status:027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Fri Oct 21 02:51:37 MDT 2016 +td.183021.status:030 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Oct 21 03:01:04 MDT 2016 +td.183021.status:039 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Fri Oct 21 03:23:15 MDT 2016 +td.183021.status:041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Fri Oct 21 03:32:27 MDT 2016 +td.183021.status:044 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Oct 21 03:50:41 MDT 2016 +td.183021.status:047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Oct 21 04:15:26 MDT 2016 +td.183021.status:050 bl482 TBL.sh f1.9c5.5wscmam4dh outfrq3s+waccm_sc_amip_cam55 9s ............................FAIL! rc= 7 at Fri Oct 21 04:54:22 MDT 2016 + + These are expected baseline failures due to: + . change in tropopause definition + . chemistry is updated in waccm_tsmlt_mam4 mechanism + . change in how SAD in chemistry is calculated + . adjustment of the EUV heating factor in WACCM(X) + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL NLCOMP +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + FAIL NLCOMP +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: NLFAIL), details: + FAIL NLCOMP + + Baseline tests passed. The namelist compare tests failed due to new namelist options added. + +hobart/nag: + +073 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Thu Oct 20 20:05:16 MDT 2016 +076 bl471 TBL.sh f10c5.5wmam4dm outfrq3s_modalstrat 9s ........................................FAIL! rc= 7 at Thu Oct 20 20:13:12 MDT 2016 + + These are expected baseline failures due to: + . chemistry is updated in waccm_tsmlt_mam4 mechanism + . change in how SAD in chemistry is calculated + . adjustment of the EUV heating factor in WACCM(X) + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_90 +Originator(s): fvitt, bardeenc +Date: 14 Oct 2016 +One-line Summary: Added options to improve water vapor and ice clouds in the tropical UTLS and polar stratosphere + +Purpose of changes: + + - Provide namelist options to enable changes that have been shown to improve + stratospheric water vapor and surface area density in WACCM + - Improve water vapor and ice clouds in UTLS and polar stratosphere + - Provide a more consistent treatment of subgrid supersaturation for growth + and nucleation of ice clouds + - Provide some additional diagnostic output related to processes in the UTLS + and stratosphere + +Note: + This leaves the default CAM & WACCM behavior unchanged (bit-for-bit) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_definition.xml + - new namelist options added: + nucleate_ice_subgrid_strat + nucleate_ice_use_troplev + cldfrc2m_rhminis + cldfrc2m_rhmaxis + +M components/cam/bld/build-namelist + - set defaults for: + micro_mg_adjust_cpt + nucleate_ice_subgrid_strat + nucleate_ice_use_troplev + cldfrc2m_rhminis + cldfrc2m_rhmaxis + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - define defaults for: + micro_mg_adjust_cpt + nucleate_ice_subgrid_strat + nucleate_ice_use_troplev + cldfrc2m_rhminis + cldfrc2m_rhmaxis + +M components/cam/src/physics/cam/cldfrc2m.F90 +M components/cam/src/physics/cam/cldwat2m_macro.F90 +M components/cam/src/physics/cam/clubb_intr.F90 + Add namelist variables (cldfrc2m_rhminis, cldfrc2m_rhmaxis) to allow rhmini and + rhmaxi to be configured differently in the stratosphere and troposphere. By default, + they will be configured the same. + +M components/cam/src/physics/cam/clubb_intr.F90 + Add the vertical diffusivity from CLUBB (KVH_CLUBB) as an output field. Also fixed + compiler issue with output of RTPHLP_CLUBB (from Francis). + +M components/cam/src/physics/cam/hetfrz_classnuc_cam.F90 + Initialize some variables to 0._r8 as they were not being explicitly initialized before. + +M components/cam/src/physics/cam/micro_mg_cam.F90 + Add the ability to adjust the cold point temperature used by the microphysics based + upon interpolating the temperature profile between model levels. This is to account + for the model not being able to resolve the cold point which should determine entry + value for stratospheric water vapor. This feature is disabled by default. + +M components/cam/src/physics/cam/nucleate_ice.F90 +M components/cam/src/physics/cam/nucleate_ice_cam.F90 + Via namelist variables, allow the subgrid nucleation (nucleate_ice_subgrid) to be set + to the same value as used for subgrid growth (1/QSATFAC) rather than be set to a + fixed value. Also allow the subgrid value to be set differently in the troposphere and + the stratosphere (nucleate_ice_subgrid_strat). Add a namelist variable + (nucleate_ice_troplev) to control whether the chemical tropopause or hard coded + pressure levels are used to define where stratospheric ice is nucleated. Using the + chemical tropopause definition also adds the coarse and accumulation mode + number to the total sulfate concentration used for nucleation. Add more diagnostic + output (NISUBGRID, NITROP_PD). By default, fixed pressure levels are used, the + troposphere and stratosphere are configured the same, and the subgrid value for + nucleation is set to a fixed value of 1.2 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all pass + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + PASS CREATE_NEWCASE + PASS XML + FAIL NLCOMP + PASS SHAREDLIB_BUILD + PASS MODEL_BUILD + PASS RUN + PASS COMPARE_base_rest + PASS GENERATE + PASS COMPARE_baseline + PASS TPUTCOMP + PASS MEMLEAK +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s_clm5 (Overall: NLFAIL), details: + PASS CREATE_NEWCASE + PASS XML + FAIL NLCOMP + PASS SHAREDLIB_BUILD + PASS MODEL_BUILD + PASS RUN + PASS COMPARE_base_rest + PASS GENERATE + PASS COMPARE_baseline + PASS TPUTCOMP + PASS MEMLEAK +SMS_Lm13.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq1m_clm5 (Overall: NLFAIL), details: + PASS CREATE_NEWCASE + PASS XML + FAIL NLCOMP + PASS SHAREDLIB_BUILD + PASS MODEL_BUILD + PASS RUN + PASS GENERATE + PASS COMPARE_baseline + PASS MEMCOMP + PASS TPUTCOMP + PASS MEMLEAK + +hobart/nag: all pass + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_89 +Originator(s): cacraig, hannay, bogensch, mmills +Date: Oct 10, 2016 +One-line Summary: Phase1b of the CAM changes Cecile is currently using for CESM runs + +Purpose of changes: + + ** WARNING ** The cime external in this tag has an error when running the short_term archiver. + Manual resubmits are required. The cime external will be updated in a future + tag. + + - F2000_DEV replaces F2000_DONOTUSE compset as this compset is ready for general use. It should + be pointed out that this compset will be a "floating" compset and will follow the current + CAM development settings and will be updated as needed. + + - The "chemical tropopause" is defined using the method tropopause_findChemTrop. Between + 50N and 50S, this is the lapse rate tropopause backed up by the climatology. For high + latitudes (>50), a fixed pressure level (300 hPa) is used because the lapse rate tropopause + sometimes finds the tropopause at high altitudes. The chemical tropopause is used as the + boundary between tropospheric and stratospheric chemical reaction rates. When prognostic + stratospheric aerosols are used, the chemical tropopause sets the level for differences in + volatility between stratospheric and tropospheric modal aerosols. + + - A cold point tropopause definition is added as an option for defining the tropopause, using + the method TROP_ALG_CPP. History outputs for cold point tropopause are added: TROPF_P, + TROPF_T, TROPF_Z, TROPF_DZ, TROPF_PD, and TROPF_FD. + + - A function tropopause_interpolateP is added to find interpolated pressure at the specified + tropopause altitude. + + - Modification to allow the highest possible level for CLUBB's water vapor tendencies to be + applied is the tropopause top, to prevent a drying out of the upper troposphere and stratosphere, + as seen in WACCM simulations. Includes an option to apply this fixer to heat tendencies. In + addition, a fix is included to prevent small energy and water conservation violations + + - To get the CLM namelist changes which mimic Cecile's runs, users need to add to their create_newcase the option: + --user-mods-dir ../../../components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5 + ** NOTE ** This directory name will be changing in a future tag + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5 +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1m_clm5/user_nl_clm + - add settings for outputting monthly + - add spunup CLM initial condition file + +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5 +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clm5/user_nl_clm + - add spunup CLM initial condition file + + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml + - added ext_frc_specifier files to match what Cecile is currently using + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - F2000_DONOTUSE now becomes F2000_DEV as Cecile has confirmed that this + compset now matches what she is using for development + - add test for 13 month simulation for F2000_DEV + - use spunup CLM finidat file for CLM5 runs + +M components/cam/cime_config/config_pes.xml + - Turn off hyperthreading for all F compsets by default (seeing improved + perfomance with hyperthreading turned off) + - 1degree FV F compsets now use 720 tasks + +M components/cam/src/physics/cam/clubb_intr.F90 + - Modification to prevent a drying out of the upper troposphere and stratosphere + A fix is included to prevent small energy and water conservation violations + +M components/cam/src/physics/cam/tropopause.F90 + - changes to tropopause detailed extensively above. + +M components/cam/test/system/test_driver.sh + - add a warning if don't supply a CAM_TAG for generating the basline + - echo the ./create_test options to the log file also + - increase the wall clock time to 3 hours for all CESM jobs until update + to the new testdefs formatted files (when update to beta02 externals) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Fri Oct 7 19:10:07 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Oct 7 19:22:03 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Fri Oct 7 20:00:45 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Oct 7 21:18:53 MDT 2016 + + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL NLCOMP + FAIL COMPARE_baseline +ERP_Ln9.f09_f09.F2000_DEV.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL NLCOMP + FAIL COMPARE_baseline + +-- Namelist fails due to changes to match Cecile's configuration + Baseline comparison fails due to answer changes in CLUBB + +hobart/nag: All BFB except: +058 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Mon Oct 10 14:01:33 MDT 2016 +064 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Oct 10 14:02:18 MDT 2016 + + +hobart/pgi or jaguar/pgi: All BFB + + -- All tests above fail due to answer changes in CLUBB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all tests which use CLUBB +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): impact of phase1a and phase1b is new climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/cam5_4_75_phase1b_tags/cam5_4_75_phase1b_n05_cam5_4_88 + Cecile also added changes for CLM namelist settings which were not in this branch tag. These CLM changes + are in cam5_4_89. A 13 month run was compared against Cecile's run at 13 months and the files were identical + (except at the 7-8th digit as her run was storing single precision and the trunk run was storing double). +- platform/compilers: yellowstone intel +- configure commandline: Using the F2000_Dev compset +- build-namelist command (or complete namelist): the use case automatically supplied with F2000_Dev +- MSS location of output: not stored on HPSS + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e15.F2000_DEV.f09_f09.cam5_4_75_phase1b_n05_cam5_4_88_land_ic/atm/f.e15.F2000_DEV.f09_f09.cam5_4_75_phase1b_n05_cam5_4_88_land_ic-f.e15.F2000.f09_f09.pd.114_cam5_4_75/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_88 +Originator(s): cacraig, juliob, hannay, bardeenc +Date: Oct 5, 2016 +One-line Summary: Phase1a of the CAM changes Cecile is currently using for CESM runs + +Purpose of changes: + - Replacing analytical kinetic energy change with diagnosed kinetic energy + change across diffusion scheme for beljaars runs. + - Fixes a bug in MG2 in calculating the fall velocity for small ice particles and moves + the threshold for using this fall velocity from 8um to 18um. This allows the fall + velocities for the small particles to blend more smoothly with the fall velocity + used for larger particles. + - The wrong versions of the nucleate_ice files were included in cam5_4_63. This corrected + version affects how ice nucleation is calculated when cloud fraction is less than 1 and + how the use_incloud_nuc namelist variable is applied. + +Bugs fixed (include bugzilla ID): + - MG2 fall velocity for small particles corrected + - correct versions of nucleate_ice routines + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig, fvitt + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/beljaars_drag_cam.F90 + - allow do_beljaars to be used outside this module + +M components/cam/src/physics/cam/diffusion_solver.F90 + - Replacing analytical kinetic energy change with diagnosed kinetic energy + change across diffusion scheme + +M components/cam/src/physics/cam/micro_mg2_0.F90 + - Fixes a bug in calculating the fall velocity for small ice particles and moves + the threshold for using this fall velocity from 8um to 18um. This allows the fall + velocities for the small particles to blend more smoothly with the fall velocity + used for larger particles. + +M components/cam/src/physics/cam/nucleate_ice.F90 +M components/cam/src/physics/cam/nucleate_ice_cam.F90 + - The wrong versions of these files were included in cam5_4_63. This corrected + version affects how ice nucleation is calculated when cloud fraction is less than 1 and + how the use_incloud_nuc namelist variable is applied. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Oct 4 20:35:19 MDT 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Tue Oct 4 20:40:28 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Oct 4 20:52:21 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Tue Oct 4 21:30:08 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Tue Oct 4 22:46:41 MDT 2016 + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL COMPARE_baseline +ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL COMPARE_baseline + +hobart/nag: +055 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Wed Oct 5 10:34:38 MDT 2016 +058 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Wed Oct 5 10:35:06 MDT 2016 +061 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed Oct 5 10:35:20 MDT 2016 +064 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Oct 5 10:35:39 MDT 2016 + +hobart/pgi or jaguar/pgi: +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Wed Oct 5 10:43:25 MDT 2016 + +Summarize any changes to answers, i.e., +- what code configurations: all jobs which use mg2, do_beljaars=.true., certain conditions in nucleate_ice (see above) +- what platforms/compilers: all + +These changes have been tested offline by Cecile Hannay and the validation will be combined with +an upcoming CAM tag and reported in that tag. + +=============================================================== +=============================================================== + +Tag name: cam5_4_87 +Originator(s): aconley,fvitt,goldy +Date: 2016-09-30 +One-line Summary: Add terminator chemistry package + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/config_files/definition.xml + - Added terminator as a valid -chem option +M components/cam/bld/configure + - Added terminator as a valid -chem option. Set proper number of tracers +A + components/cam/bld/namelist_files/use_cases/dctest_baro_moist.xml + - Beginning of use case for dycore test use case (uses terminator chem package) +M components/cam/cime_config/config_component.xml + - Added a dycore test compset CAM options (DCTBM) +M components/cam/cime_config/config_compsets.xml + - Added dycore test compset (FDCBAROMOIST) +M components/cam/cime_config/testdefs/testlist_cam.xml + - Created aux_cam_short testlist (same as aux_cam for now). +M components/cam/doc/ChangeLog + - Improve disk drive manufacturer bottom line but using more storage +M components/cam/src/chemistry/mozart/chemistry.F90 + - Make fh2o a required argument +M components/cam/src/chemistry/pp_none/chemistry.F90 + - Make fh2o an optional argument +A + components/cam/src/chemistry/pp_terminator +A + components/cam/src/chemistry/pp_terminator/chem_mech.doc +A + components/cam/src/chemistry/pp_terminator/chem_mech.in +A + components/cam/src/chemistry/pp_terminator/chem_mods.F90 +A + components/cam/src/chemistry/pp_terminator/chemistry.F90 +A + components/cam/src/chemistry/pp_terminator/m_rxt_id.F90 +A + components/cam/src/chemistry/pp_terminator/m_spc_id.F90 +A + components/cam/src/chemistry/pp_terminator/mo_adjrxt.F90 +A + components/cam/src/chemistry/pp_terminator/mo_imp_sol.F90 +A + components/cam/src/chemistry/pp_terminator/mo_indprd.F90 +A + components/cam/src/chemistry/pp_terminator/mo_lin_matrix.F90 +A + components/cam/src/chemistry/pp_terminator/mo_lu_factor.F90 +A + components/cam/src/chemistry/pp_terminator/mo_lu_solve.F90 +A + components/cam/src/chemistry/pp_terminator/mo_nln_matrix.F90 +A + components/cam/src/chemistry/pp_terminator/mo_phtadj.F90 +A + components/cam/src/chemistry/pp_terminator/mo_prod_loss.F90 +A + components/cam/src/chemistry/pp_terminator/mo_rxt_rates_conv.F90 +A + components/cam/src/chemistry/pp_terminator/mo_setrxt.F90 +A + components/cam/src/chemistry/pp_terminator/mo_sim_dat.F90 + - Added new terminator chemistry package +M components/cam/src/dynamics/eul/dyn_comp.F90 + - Coordinates passed to cnst_init_default must be in radians +M components/cam/src/dynamics/fv/dyn_comp.F90 + - Coordinates passed to cnst_init_default must be in radians +M components/cam/src/dynamics/se/dyn_comp.F90 + - Coordinates passed to cnst_init_default must be in radians +M components/cam/src/dynamics/sld/dyn_comp.F90 + - Coordinates passed to cnst_init_default must be in radians +M components/cam/src/physics/cam/clubb_intr.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/cam/co2_cycle.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/cam/const_init.F90 + - Pass correct latitude array for each block in cnst_init_default +M components/cam/src/physics/cam/micro_mg_cam.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/cam/physpkg.F90 + - Show that fh2o is an optional argument (use key=value form) +M components/cam/src/physics/cam/rk_stratiform.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/cam/tracers_suite.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/cam/unicon_cam.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/carma/cam/carma_intr.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_tracers2/carma_model_mod.F90 + - Only initialize constituents where mask is .true. +M components/cam/src/physics/simple/physpkg.F90 + - Add chemistry to simple physics (chem_register, chem_init, chem_timestep_tend) +A + components/cam/test/system/config_files/f10adhterm + - New test config using adiabatic physics with terminator chemistry +M components/cam/test/system/input_tests_master + - Add new terminator chemistry test (339) +A + components/cam/test/system/nl_files/terminator + - Namelist file for terminator chemistry test +M components/cam/test/system/test_driver.sh + - Made processing of CAM regression tests and/or CESM auxiliary tests optional + - Allow alternate CESM test or test suite + - Cleaned up old comments and created usage statement with documentation +M components/cam/test/system/tests_pretag_hobart_nag + - Add new terminator chemistry test (339) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +yellowstone/intel/aux_cam: All pass + +hobart/nag: Baseline fail for new test (no baseline). +052 bl339 TBL.sh f10adhterm terminator 9s .....................................................FAIL! rc= 7 at Fri Sep 30 13:49:06 MDT 2016 + +hobart/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_86 +Originator(s): cacraig, hannay, mmills, fvitt +Date: September 29, 2016 +One-line Summary: Update solar files and use cases + +Purpose of changes: + - Update solar files used for CAM/WACCM 1850, HIST and 2000 cases + - Add use cases which capture F and FC5 compsets (cam4 and cam5) + at this current time. This allows the namelist defaults to follow the + cam6 configuration without impacting older versions. + - Added F1850_DONOTUSE compset - this compset is VERY PRELIMINARY and + really should not be used + - Started work on the FHIST_DONOTUSE compset, but it is broken and will + be worked on for future tags. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + + +A components/cam/bld/namelist_files/use_cases/1850_cam6.xml +A components/cam/bld/namelist_files/use_cases/hist_cam6.xml + - With input from Cecile, we are setting up preliminary use cases for FHIST and F1850 compsets + Note that hist_cam6.xml does not run to completion yet. + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/use_cases/2000_cam6.xml + - update solar_data_file (CAM and WACCM) and solar_parms_file (WACCM only) to files + provided by Mike Mills + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml + - update solar_data_file, solar_parms_file, epp_all_filepath and epp_all_varname + to settings provided by Mike Mills + +M components/cam/cime_config/config_component.xml + - add hooks for hist_cam6 use case + - update the 1850_CAM6 compsets to use 1850_cam6 use case + +M components/cam/cime_config/config_compsets.xml + - add F1850_DONOTUSE and FHIST_DONOTUSE compsets + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add aux_cam and prealpha testing for F1850_DONOTUSE + +M components/cam/doc/ChangeLog + - added additional information for the cam5_4_84 tag as the bug fix for clubb_do_liqsupersat had + a larger impact than was first thought + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 29 16:34:36 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Thu Sep 29 16:37:22 MDT 2016 + +yellowstone/intel/aux_cam: +ERP_Ln9.f09_f09.F1850_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL NLCOMP + FAIL COMPARE_baseline +ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s (Overall: DIFF), details: + FAIL NLCOMP + FAIL COMPARE_baseline + ** Namelist tests fail due to new solar forcing file + ** F2000 baseline test fails due to new solar forcing file + ** F1850 baseline test fails due to it being a new test + +hobart/nag: +017 bl221 TBL.sh f10c5spcamsm outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Sep 29 16:21:18 MDT 2016 +052 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Thu Sep 29 16:33:18 MDT 2016 + +hobart/pgi or jaguar/pgi: +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Thu Sep 29 16:31:46 MDT 2016 + +All of the above tests are expected to change due to the change in the SolarForcing file (which was provided by mmills) + +=============================================================== +=============================================================== + +Tag name: cam5_4_85 +Originator(s): fvitt, erik, cacraig +Date: 21 Sep 2016 +One-line Summary: Update build-namelist use cases with updated MEGAN emissions factors and update CLM + +Purpose of changes: + + Update build-namelist use cases used in CLM50 compsets with MEGAN active + to include emission factors for 79 PFTs + + Update CLM external to include MEGAN model for 79 PFTs used in clm45 and clm50 + for CIME testing + + Change the aux_cam CIME smoke test to a restart test (ERP) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + When using clm45 and clm50 the megan_factors_file needs to be set to + $INPUTDATA/atm/cam/chem/trop_mozart/emis/megan21_emis_factors_79pft_c20150518.nc + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/test/system/nl_files/outfrq3s_megan + - overrides megan_factors_file with an appropriate input file for clm4 used in cam regression tests + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - update CLM external to esmciport_n06_clm4_5_12_r194 which has updates to + MEGAN for clm45 and clm50 + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/sd_cam5_trop_strat_mam3.xml + - update megan_factors_file in these use cases to include 79 PFTs + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - update the default megan_factors_file to include 79 PFTs + +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands +M components/cam/cime_config/testdefs/testlist_cam.xml + - mods for aux_cam test -- workaround for the glc model issue when the test is less than 1 day + +M components/cam/test/system/input_tests_master + - use outfrq3s_megan in waccm5.5 test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s_megan+waccm_tsmlt_2000_cam55 9s .....................FAIL! rc= 7 at Wed Sep 21 09:00:31 MDT 2016 + - this is actually bit-for-bit -- change "outfrq3s" to "outfrq3s_megan" caused this baseline to fail + +yellowstone/intel/aux_cam: +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s CREATE_NEWCASE +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s XML +FAIL ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s SHAREDLIB_BUILD time=579 +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s MODEL_BUILD time=674 +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s RUN time=431 +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_base_rest +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s GENERATE +FAIL ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_baseline +PASS ERP_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s MEMLEAK insuffiencient data for memleak test + - this baseline is expected to fail -- clm50 has changed answers + +hobart/nag: all pass + +jaguar/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_84 +Originator(s): cacraig, bogensh, hannay, fvitt +Date: Sept 19, 2016 +One-line Summary: Add namelist parameter for CLUBB C14 and fix clubb_do_liqsupersat bug + +Purpose of changes: + - Add C14 tuning parameter for CLUBB to the namelist. Change its default value from + 1. to 1.83 + - Add missing mpi_bcast for clubb_do_liqsupersat + - After additional use, it was discovered that the clubb_do_liqsupersat fix has a significant impact + +Bugs fixed (include bugzilla ID): + - Fix bug which was causing CESM ERP tests using clubb to not be BFB + clubb_do_liqsupersat needed to be mpi_bcast to all MPI tasks + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - Add namelist clubb_c14 (constant for u'^2 and v'^2 terms) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml + - Add clubb_c14 tuning namelist parameter + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Change default value for clubb_c14 from 1. to 1.83 + +M components/cam/src/physics/cam/clubb_intr.F90 + - Add clubb_c14 tuning namelist parameter + - Fix bug where clubb_do_liqsupersat was not being broadcast to all mpi tasks + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Fri Sep 16 17:00:48 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Sep 16 17:12:46 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Fri Sep 16 17:52:47 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Sep 16 19:10:06 MDT 2016 + + +yellowstone/intel/aux_cam: +FAIL SMS_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s NLCOMP + - added new namelist parameter + +FAIL SMS_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_baseline + - expect the answers to change with the tuned parameter + +hobart/nag: all BFB except: +055 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Fri Sep 16 15:13:46 MDT 2016 +061 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Sep 16 15:40:51 MDT 2016 + +hobart/pgi or jaguar/pgi: all BFB (no CLUBB tests included in this testlist) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all runs which use CLUBB (including ones which use CAM5.5) +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +Case directories: +/glade/p/cesmdata/cseg/runs/cesm1_5/f.e15.F2000.f09_f09.pd.114_cam5_4_75 +and: +/glade/p/cesmdata/cseg/runs/cesm1_5/f.e15.F2000.f09_f09.pd.114_cam5_4_75_C14 + +Output data: +/glade/p/cesm0005/archive/f.e15.F2000.f09_f09.pd.114_cam5_4_75 +and +/glade/p/cesm0005/archive/f.e15.F2000.f09_f09.pd.114_cam5_4_75_C14 + +- MSS location of output + MSS location of control simulations used to validate new climate: + - Not stored on HPSS + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e15.F2000.f09_f09.pd.114_cam5_4_75/atm/f.e15.F2000.f09_f09.pd.114_cam5_4_75-f.e15.F2000.f09_f09.pd.114_cam5_4_75_C14/ + +URL for impact of the clubb_do_liqsupersat bug fix +http://webext.cgd.ucar.edu/FCLIMO/f.e15.F2000.f09_f09.pd.114_cam5_4_75_clubb_fix_tropopause_tend/atm/f.e15.F2000.f09_f09.pd.114_cam5_4_75_clubb_fix_tropopause_tend-f.e15.F2000.f09_f09.pd.114_cam5_4_75_clubb_fix_tropopause_tend_nompi/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_83 +Originator(s): eaton, mvr, hannay, cacraig +Date: Sept 15, 2016 +One-line Summary: radiation bugfix + +Purpose of changes: + - Mods were needed due to some refactoring in cloud_rad_props.F90. The fix provided by Mat + went into subroutine interpolate_ice_optics_lw and consequently needed to be applied to both + snow and ice cloud optics and not just to the snow optics as in the original mod. + - Changes were merged in from: https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/rrtmg_tags/rrtmg01_cam5_4_79 + These changes were identical to the ones that Cecile used in her testing + - added abs() to time_period_freq when the nhtfrq is negative (when specifying hours) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/control/cam_history.F90 + - added abs() to nhtfrq when it is negative + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - replace '.lt.' by '.le.' at line 2248 + +M components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 + - fix the case where the diffusivity angle was going negative under very + moist conditions + - the code has been changed so the interpolation for the lw ice optics has + been factored out and is now used for for the ice and snow cloud optics. + So the mod to limit the ice optical depths is now applied to both ice and + snow clouds. + +M components/cam/src/physics/rrtmg/cloud_rad_props.F90 + - Limit the snow/ice optical depths fix the case where there are large masses + of snow at high altitudes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Sep 13 17:52:12 MDT 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Tue Sep 13 17:57:15 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Sep 13 18:09:18 MDT 2016 +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Sep 13 18:27:05 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Tue Sep 13 18:47:22 MDT 2016 +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Sep 13 19:09:05 MDT 2016 +041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Sep 13 19:25:45 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Tue Sep 13 20:03:40 MDT 2016 +050 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Tue Sep 13 20:38:48 MDT 2016 +063 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Sep 13 21:03:18 MDT 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Sep 13 21:07:52 MDT 2016 + +yellowstone/intel/aux_cam: +FAIL SMS_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_baseline + +hobart/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Sep 13 15:27:37 MD +T 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Sep 13 15:31:46 MD +T 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Sep 13 15:35:19 MD +T 2016 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Sep 13 15:47:52 MD +T 2016 +034 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Sep 13 15:59:51 MD +T 2016 +040 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Sep 13 16:08:47 MD +T 2016 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Sep 13 16:13:04 MD +T 2016 +049 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Tue Sep 13 16:16:40 MD +T 2016 +052 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Sep 13 16:29:12 MD +T 2016 +055 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Tue Sep 13 16:51:48 MD +T 2016 +058 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Sep 13 17:03:56 MD +T 2016 +061 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Sep 13 17:19:11 MD +T 2016 +064 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Sep 13 17:26:15 MDT 2016 +067 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Sep 13 17:31:31 MDT 2016 +073 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Sep 13 17:46:16 MDT 2016 +076 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Sep 13 18:01:57 MDT 2016 +079 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Sep 13 18:07:20 MDT 2016 + +hobart/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Sep 13 15:31:34 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Sep 13 15:39:34 MDT 2016 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Sep 13 15:45:51 MDT 2016 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Sep 13 15:48:35 MDT 2016 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Sep 13 16:01:56 MDT 2016 +038 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Sep 13 16:35:51 MDT 2016 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Sep 13 16:44:56 MDT 2016 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Sep 13 16:51:58 MDT 2016 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Sep 13 16:53:39 MDT 2016 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Sep 13 16:56:58 MDT 2016 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Sep 13 17:05:15 MDT 2016 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Sep 13 17:25:06 MDT 2016 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Sep 13 17:36:01 MDT 2016 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Sep 13 17:46:07 MDT 2016 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Sep 13 17:58:34 MDT 2016 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Sep 13 18:05:53 MDT 2016 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all which use rrtmg radiation +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but not climate changing + +URL for AMWG diagnostics output: +http://webext.cgd.ucar.edu/FCLIMO/f.e15.F2000.f09_f09.pd.100_rrtmg_cam5_4_79/atm/f.e15.F2000.f09_f09.pd.100_rrtmg_cam5_4_79-f.e15.F2000.f09_f09.pd.100_cam5_4_79/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_82 +Originator(s): cacraig, aliceb, mvertens, fvitt, mmills +Date: September 13, 2016 +One-line Summary: Update to cime5.0.11 and other misc changes + +Purpose of changes: + - Update to cime5.0.11 to eliminate problem with --generate flag + on create_test + - Received from aliceb, bug fix for time_period_freq + - Received from mvertens, bug fix for config_compsets + - Changed CAM54 to CAM60 in WACCM FW5 compset (per fvitt and mmills) + +Bugs fixed (include bugzilla ID): + - bug fix for time_period_freq in cam_history.F90 + - bug fix in config_compsets when specifying grid=gland + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cime5.0.11 as cime5.0.8 had answer changes when using + the --generate flag in create_test + +M components/cam/cime_config/config_component.xml + - removed CAM54 + +M components/cam/cime_config/config_compsets.xml + - changed the CAM54 reference in FW5 to CAM60 + - grid=gland is now specified properly + +M components/cam/src/control/cam_history.F90 + - when calculating time_period_freq, convert nhtfrq to always be in seconds + (when it is negative it is the number of hours) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: (compared with cam5_4_80 as cam5_4_81 had differences due to a bug in cime) +FAIL SMS_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_baseline + - As discovered in cam5_4_81, the two files which had differences were the clm2.h0 and cpl.hi files. + In both cases, the only two fields which had differences (and they were roundoff level) + were VOLR and VOLRMCH (and the coupler versions of these fields). Bill Sacks said that + these two fields can exhibit roundoff level differences and CLM has learned to ignore them. + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_80 - cam5_4_81 was BFB with cam5_4_80 but had answer differences in the aux_cam test due to + a bug in cime. For convenience, used cam5_4_80 for all the baseline comparisons + +=============================================================== +=============================================================== + +Tag name: cam5_4_81 +Originator(s): mvertens, santos, jedwards, cacraig +Date: August 19, 2016 +One-line Summary: Update to CESM2 beta01 externals (cime5) + +Purpose of changes: + - Updates necessary to work with the new version of CIME. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + M . +M SVN_EXTERNAL_DIRECTORIES + - Update the externals to match CESM beta01 + +M components/cam/bld/configure + - The CIME/CESM scripts now look for a file called "CESM_cppdefs" + instead of "CCSM_cppdefs", so configure has to output to that file. + +M components/cam/cime_config/buildlib +M components/cam/cime_config/buildnml + - These CIME scripts are translated from Perl to Python. + - Queries to XML files now use CIME Python modules rather than xmlquery, + which substantially improves buildnml timing in CIME. + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml + - Compatibility fixes for new CIME scripts. + - Compset long names always use two version numbers for CAM (i.e. CAM40, + CAM50, and CAM55). + - WACCM+CLUBB compsets are now specified by using CAM55%WC*, so the + %WCCB modifier is removed. + +M components/cam/test/system/TSM_ccsm.sh + - The CIMEROOT environment variable must be specified when running the + CIME run script. + +M components/cam/test/system/test_driver.sh + - added CAM_TAG which is used in the aux_cam create_testcase to generate + the automatic baseline files for the CESM test(s) + - The Python module must be loaded on yellowstone so that Python 2.7 is + available for the CIME scripts. + +M components/cam/cime_config/testdefs/testmods_dirs/cam/chemproc/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/cosp/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq1d/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_sat_hist/shell_commands +M components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/shell_commands + - cleaned up shell commands + +M components/cam/cime_config/config_pes.xml + - change WACCM pe layouts to be for any version, not just cam4 or cam5 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +yellowstone/intel/aux_cam: +FAIL SMS_Ln9.f09_f09.F2000_DONOTUSE.yellowstone_intel.cam-outfrq9s COMPARE_baseline + - Upon further investigation, the two files which had differences were the clm2.h0 and cpl.hi files. + In both cases, the only two fields which had differences (and they were roundoff level) + were VOLR and VOLRMCH (and the coupler versions of these fields). Bill Sacks said that + these two fields can exhibit roundoff level differences and CLM has learned to ignore them. + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_80 +Originator(s): goldy +Date: 2016-08-17 +One-line Summary: Create separate package for simple physics options + +Purpose of changes: Create a new physics package for adiabatic and + Held-Suarez simulations in order to enable incorporation of other + idealized or simplified physics parameterizations. + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: + - New default datasets for Eulerian Held-Suarez simulations + HS1994.128x256.L30_c062216.nc + HS1994.128x256.L60_c061516.nc + HS1994.64x128.L30_c061616.nc + +Describe any substantial timing or memory changes: NA + +Code reviewed by: Eaton, Craig, Vitt + +List all subroutines eliminated: + - phys_run1_adiabatic_or_ideal -- replaced with simple/physpkg + - tphysidl -- replace with proper Held-Suarez parameterization + +List all subroutines added and what they do: +A + components/cam/bld/namelist_files/use_cases/held_suarez_1994.xml + - Use cases for Held-Suarez runs for Simpler Models project +A + components/cam/src/physics/simple + - New directory to hold various simplified physics options +A + components/cam/src/physics/simple/physpkg.F90 + - Separate physpkg interfaces for simplified physics options +A components/cam/src/physics/simple/held_suarez.F90 + - Portable layer Held-Suarez tendency calculation +A components/cam/src/physics/simple/held_suarez_cam.F90 + - CAM interface layer for Held-Suarez parameterization +M components/cam/src/control/cam_control_mod.F90 + - cam_ctrl_set_physics_type: Set physics type after namelist read + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/config_files/definition.xml + - Changed name of ideal physics package to held_suarez +M components/cam/bld/configure + - Changed name of ideal physics package to held_suarez. Added simple_phys + variable to help keep track of new simple physics options. + - Removed trailing spaces. +M components/cam/bld/namelist_files/namelist_definition.xml + - Fix some history documentation (the max number of history files is larger) +M components/cam/cime_config/config_component.xml + - Change IDEAL to HS94 for the -phys held_suarez configuration option +M components/cam/cime_config/config_compsets.xml + - Change the FIDEAL compset to FHS94 +M components/cam/cime_config/config_pes.xml + - Took out redundant EOS entry at request of jedwards. +M components/cam/doc/ChangeLog + - Had Watson fill out cam5_4_80 entry +M components/cam/src/control/cam_comp.F90 + - cam_init no longer takes adiabatic or ideal_phys inputs +M components/cam/src/control/cam_control_mod.F90 + - cam_ctrl_init no longer takes adiabatic or ideal_phys inputs + - new subroutine, cam_ctrl_set_physics_type (see above) +M components/cam/src/control/cam_history.F90 + - Remove SPMD and use real MPI calls +M components/cam/src/control/camsrfexch.F90 + - Make wet pbuf fields optional +M components/cam/src/cpl/atm_comp_mct.F90 + - No longer look for adiabatic or ideal_phys in infodata +M components/cam/src/dynamics/eul/tfilt_massfix.F90 + - Skip energy fixer for Held-Suarez simulations +M components/cam/src/physics/cam/cam_diagnostics.F90 + - Separated code into dry and moist sections. Moist sections are only + called for moist physics runs +M components/cam/src/physics/cam/microp_driver.F90 + - Include name of microp_scheme if unrecognized +M components/cam/src/physics/cam/phys_control.F90 + - Call cam_ctrl_set_physics_type to set physics type after namelist read + - Replace MPI shorthand with real MPI +M components/cam/src/physics/cam/physics_buffer.F90.in + - Improved endrun message for out of range error in pbuf_get_field +M components/cam/src/physics/cam/physpkg.F90 + - Removed simple physics options (adiabatic and Held-Suarez) + - Replace MPI shorthand with real MPI +M components/cam/test/system/config_files/e48idh +M components/cam/test/system/config_files/e8idm +M components/cam/test/system/config_files/f10idm +M components/cam/test/system/config_files/f4idm +M components/cam/test/system/config_files/s32idh +M components/cam/test/system/config_files/s48idh +M components/cam/test/system/config_files/s64idh + - Replaced '-phys ideal' with '-phys held_suarez' +M components/cam/test/system/nl_files/idphys + - Added a second history file with U,V,T,TTEND_TOT,DTCORE +M components/cam/test/system/test_driver.sh + - Add an option (-e) to email test summary to USER (or at least try) + - Create test summary and add to cam_test_summaries (and maybe also email) + - Added code to run CAM AUX tests but need CIME 5 to get working. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All Pass + +yellowstone/intel/aux_cam: All Pass + +hobart/nag: Timestep relaxation filter removed from Held-Suarez parameterization +047 bl335 TBL.sh f10idm idphys 9s .............................................................FAIL! rc= 7 at Wed Aug 17 17:21:46 MDT 2016 + +hobart/pgi: Timestep relaxation filter removed from Held-Suarez parameterization +019 bl115 TBL.sh e8idm idphys 9s ..............................................................FAIL! rc= 7 at Wed Aug 17 16:55:29 MDT 2016 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Held-Suarez tests are larget than roundoff due to removal of + model timestep-based relaxation (parameterization matches original + 1994 paper). Also, QRS diagnostic is purely the temperature + tendency from the heating rate (previous version also included + dycore energy fix). + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: Long runs were conducted per 1994 paper. Evaluation + is on Simpler Models page (https://www2.cesm.ucar.edu/models/simpler-models/dynamical-core-test/adiabatic). + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_79 +Originator(s): cacraig, hannay +Date: Aug 10, 2016 +One-line Summary: Add F2000_DONOTUSE compset + +Purpose of changes: +- In preparation for the release, the compset F2000_DONOTUSE has been created. + This compset will be modified as directed by Cecile to mimic her setups. + NOTE--THIS COMPSET IS NOT TO BE USED BY OTHER DEVELOPERS AT THIS TIME + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/bld/namelist_files/use_cases/2000_cam6.xml + - Preliminary use_case for F2000 CAM6 setup + ** THIS USE_CASE MAY BE MODIFIED UP UNTIL THE CESM2 RELEASE + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - added cism, ww3, and mosart libraries, so that F2000 runs may + be made with CAM checkout + +M components/cam/cime_config/config_component.xml + - add use_case for current 2000_cam55 + +M components/cam/cime_config/config_compsets.xml + - added F2000_DONOTUSE compset information + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add yellowstone, intel F2000_DONOTUSE regression test + +M components/cam/doc/ChangeLog_template + - added new yellowstone aux_cam test reporting + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +yellowstone/intel/aux_cam: new test - no baseline to compare against + To run the new aux_cam tests (inside cime/scripts): + ./create_test -xml_mach yellowstone -xml_compiler intel -xml_category aux_cam -testid cam5_4_79 -generate cam5_4_79 + The summary can be seen in the file TestStatus + + -- ran the F2000_DONOTUSE test by hand and compared F2000_DONOTUSE + results with cam5_4_70 + and it was BFB + +hobart/nag: + +hobart/pgi or jaguar/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_78 +Originator(s): goldy +Date: 2016-08-01 +One-line Summary: New Hobart environment + small fixes + +Purpose of changes: + - Modify test_driver for new Hobart environment (NAG 6.1) + - Small fix to makefile + - Adjust SPCAM regression test + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NAG 6.1 plus update mismatch flag + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, cacraig + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/Makefile.in + - Added mpi_alltoallw to the NAG mismatch flags (-wmismatch) +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Corrected the default value of eul_hdif_coef for T85 and T42 cases +M components/cam/doc/ChangeLog + - Dusted off the old template filling auto-bot +M components/cam/src/dynamics/fv/pfixer.F90 + - Corrected incorrect usage of mpi_allgatherv (overlapping send and dest) +M components/cam/test/system/config_files/f10c5spcamsm + - Modified spcam_nx to be 32 +M components/cam/test/system/test_driver.sh + - Updated NAG compiler to 6.1 + - Do not separately load an MPI library (only compiler module load). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: Roundoff-level changes due to compiler update +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Mon Aug 1 13:12:57 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Mon Aug 1 13:18:10 MDT 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Mon Aug 1 13:22:43 MDT 2016 +017 bl221 TBL.sh f10c5spcamsm outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Aug 1 13:30:09 MDT 2016 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Mon Aug 1 13:36:31 MDT 2016 +034 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Mon Aug 1 13:50:01 MDT 2016 +040 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Mon Aug 1 13:59:39 MDT 2016 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Mon Aug 1 14:04:11 MDT 2016 +049 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Mon Aug 1 14:08:44 MDT 2016 +052 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Mon Aug 1 14:21:07 MDT 2016 +055 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Mon Aug 1 14:43:05 MDT 2016 +058 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Mon Aug 1 14:54:56 MDT 2016 +061 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Aug 1 15:09:49 MDT 2016 +064 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Mon Aug 1 15:16:31 MDT 2016 +067 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Aug 1 15:21:34 MDT 2016 +070 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Mon Aug 1 15:28:29 MDT 2016 +073 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Mon Aug 1 15:36:22 MDT 2016 +076 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Mon Aug 1 15:52:15 MDT 2016 +079 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Mon Aug 1 15:57:46 MDT 2016 + +hobart/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff level diffs in some NAG baseline tests + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + - Hand examine cprnc output + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_77 +Originator(s): goldy +Date: 2016-07-09 +One-line Summary: Fix default constant initialization bug + +Purpose of changes: Fix default constant initialization bug in SE + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Adding yet another wall of shame +M components/cam/src/dynamics/se/dyn_comp.F90 + - Set redundant tracer points to zero before boundary exchange +A f10c5spcamsm + - Config file for testing SPCAM (should have been added to cam5_4_76) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_76 +Originator(s): cacraig, mark@atmos.colostate.edu, minghuai.wang@nju.edu.cn +Date: July 8, 2016 +One-line Summary: super-parameterized CAM (SPCAM) + +Purpose of changes: + - Super-parameterized CAM (SPCAM) implements a 2D cloud resolving model (the + System for Atmospheric Modeling SAM, version 6.8.2) in CAM. When it is turned on, + it replaces CAM's parameterization for moist convection and large-scale condensation + with this alternate model. + - At this time, only the sam1mom (One moment SAM microphysics) version of SPCAM is allowed. + The m2005 version (two moment microphysics) is awaiting scientific verification before will be enabled. + - The SPCAM package allows CLUBB to be used or not. It is important to note that there is + a SPCAM-specific version of CLUBB within the CRM package and it is not the same CLUBB being + used by CAM. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - introduced two new options to -phys: sam1mom and m2005 (though m2005 is not currently enabled) + - New configure options: + spcam_clubb_sgs: turns on the SPCAM version of CLUBB + spcam_nx: SPCAM's x-grid. defaults to 4 + spcam_ny: SPCAM's y-grid + spcam_dx: SPCAM's horizontal grid spacing + spcam_dt SPCAM's timestep + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton and CAM softwared engineering team + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/src/physics/cam/spcam_drivers.F90 + - driver interface routines between CAM and SPCAM + +A components/cam/src/physics/spcam/crm_physics.F90 + - wrapper routines around the CRM package + +A components/cam/src/physics/spcam/crmclouds_camaerosols.F90 + - subroutines to use cloud fields from the CRM model within CAM + +A components/cam/src/physics/spcam/crmdims.F90 + - module to setup crm dimensions + +A components/cam/src/physics/spcam +A components/cam/src/physics/spcam/crm +A components/cam/src/physics/spcam/crm/ADV_MPDATA +A components/cam/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 +A components/cam/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 +A components/cam/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 +A components/cam/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 +A components/cam/src/physics/spcam/crm/CLUBB +A components/cam/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_endian.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 +A components/cam/src/physics/spcam/crm/CLUBB/recl.inc +A components/cam/src/physics/spcam/crm/MICRO_M2005 +A components/cam/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 +A components/cam/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 +A components/cam/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 +A components/cam/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 +A components/cam/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 +A components/cam/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 +A components/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 +A components/cam/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 +A components/cam/src/physics/spcam/crm/crmx_abcoefs.F90 +A components/cam/src/physics/spcam/crm/crmx_adams.F90 +A components/cam/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 +A components/cam/src/physics/spcam/crm/crmx_advect2_mom_z.F90 +A components/cam/src/physics/spcam/crm/crmx_advect_all_scalars.F90 +A components/cam/src/physics/spcam/crm/crmx_advect_mom.F90 +A components/cam/src/physics/spcam/crm/crmx_atmosphere.F90 +A components/cam/src/physics/spcam/crm/crmx_bound_duvdt.F90 +A components/cam/src/physics/spcam/crm/crmx_bound_exchange.F90 +A components/cam/src/physics/spcam/crm/crmx_boundaries.F90 +A components/cam/src/physics/spcam/crm/crmx_buoyancy.F90 +A components/cam/src/physics/spcam/crm/crmx_compress3D.F90 +A components/cam/src/physics/spcam/crm/crmx_coriolis.F90 +A components/cam/src/physics/spcam/crm/crmx_crm_module.F90 +A components/cam/src/physics/spcam/crm/crmx_crmsurface.F90 +A components/cam/src/physics/spcam/crm/crmx_crmtracers.F90 +A components/cam/src/physics/spcam/crm/crmx_damping.F90 +A components/cam/src/physics/spcam/crm/crmx_diagnose.F90 +A components/cam/src/physics/spcam/crm/crmx_domain.F90 +A components/cam/src/physics/spcam/crm/crmx_ecppvars.F90 +A components/cam/src/physics/spcam/crm/crmx_forcing.F90 +A components/cam/src/physics/spcam/crm/crmx_grid.F90 +A components/cam/src/physics/spcam/crm/crmx_ice_fall.F90 +A components/cam/src/physics/spcam/crm/crmx_init.F90 +A components/cam/src/physics/spcam/crm/crmx_kurant.F90 +A components/cam/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 +A components/cam/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 +A components/cam/src/physics/spcam/crm/crmx_params.F90 +A components/cam/src/physics/spcam/crm/crmx_periodic.F90 +A components/cam/src/physics/spcam/crm/crmx_precip_fall.F90 +A components/cam/src/physics/spcam/crm/crmx_press_grad.F90 +A components/cam/src/physics/spcam/crm/crmx_press_rhs.F90 +A components/cam/src/physics/spcam/crm/crmx_pressure.F90 +A components/cam/src/physics/spcam/crm/crmx_random.F90 +A components/cam/src/physics/spcam/crm/crmx_sat.F90 +A components/cam/src/physics/spcam/crm/crmx_setparm.F90 +A components/cam/src/physics/spcam/crm/crmx_setperturb.F90 +A components/cam/src/physics/spcam/crm/crmx_stepout.F90 +A components/cam/src/physics/spcam/crm/crmx_task_init.F90 +A components/cam/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 +A components/cam/src/physics/spcam/crm/crmx_utils.F90 +A components/cam/src/physics/spcam/crm/crmx_uvw.F90 +A components/cam/src/physics/spcam/crm/crmx_vars.F90 +A components/cam/src/physics/spcam/crm/crmx_zero.F90 +A components/cam/src/physics/spcam/crm/fft.F +A components/cam/src/physics/spcam/crm/gammafff.c + - Routines for the CRM model - includes a CRM-specific version of CLUBB + +A components/cam/src/physics/spcam/ecpp +A components/cam/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 +A components/cam/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 +A components/cam/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 +A components/cam/src/physics/spcam/ecpp/module_data_ecpp1.F90 +A components/cam/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 +A components/cam/src/physics/spcam/ecpp/module_data_radm2.F90 +A components/cam/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 +A components/cam/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 +A components/cam/src/physics/spcam/ecpp/module_ecpp_util.F90 + - Explicit-Cloud-Parametrized-Pollutant (ECPP) approach which is + used to treat cloud processing of aerosols with statistics of + cloud properties resolved by the cloud resolving model. + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist + - sets up a few namelist settings based on spcam configure settings + +M components/cam/bld/config_files/definition.xml +M components/cam/bld/configure + - introduced two new options to -phys: sam1mom and m2005 (though m2005 is not currently enabled) + - New configure options: + spcam_clubb_sgs: turns on the SPCAM version of CLUBB + spcam_nx: SPCAM's x-grid. defaults to 4 + spcam_ny: SPCAM's y-grid + spcam_dx: SPCAM's horizontal grid spacing + spcam_dt SPCAM's timestep + - spcam specific settings are added internally to phys_pkg, microphys_pkg, + macrophys_pkg and pbl_pkg + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - specify namelist settings for SPCAM + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - added FSPCAMS compset to use SPCAM sam1mom + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - introduced accessor functions to retrieve aerosol data + - aqueous chemistry is done in ECPP and is not done in this module + +M components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M components/cam/src/physics/cam/constituents.F90 + - constituents species class is now handled like convtran2 + +M components/cam/src/chemistry/mozart/gas_wetdep_opts.F90 + - introduce an 'OFF' option for gas_wetdep_method + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - comment cleanup + +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - do_neu_wetdep is no longer public + +M components/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M components/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M components/cam/src/physics/cam/modal_aer_opt.F90 + - introduce a new routine modal_aero_calcdry and remove + this logic from modal_aero_wateruptake_dr + +M components/cam/src/physics/cam/cloud_diagnostics.F90 + - introduce logic for one and two moment clouds and + set them according to the type of microphysics package + being used + +M components/cam/src/physics/cam/cloud_fraction.F90 +M components/cam/src/physics/cam/conv_water.F90 +M components/cam/src/physics/cam/convect_deep.F90 +M components/cam/src/physics/cam/convect_shallow.F90 +M components/cam/src/physics/cam/diffusion_solver.F90 +M components/cam/src/physics/cam/microp_driver.F90 +M components/cam/src/physics/cam/phys_control.F90 +M components/cam/src/physics/cam/physpkg.F90 +M components/cam/src/physics/cam/pkg_cldoptics.F90 +M components/cam/src/physics/cam/vertical_diffusion.F90 + - add checks for the spcam schemes + +M components/cam/src/physics/cam/ndrop.F90 + - add additional logic if called from spcam + +M components/cam/src/physics/cam/radiation_data.F90 + - add logic to disable writing of radiation data + within the radiation routine. + +M components/cam/src/physics/cam/unicon_cam.F90 +M components/cam/src/physics/cam/zm_conv_intr.F90 + - additional pbuf fields used by other methods + needed to be added here as well. + +M components/cam/src/physics/rrtmg/radiation.F90 + - add a few extra variables to the radiation output type + +M components/cam/src/unit_drivers/offline_driver.F90 + - introduce a new offline driver register method + +M components/cam/src/unit_drivers/rad/unit_driver.F90 + - introduce a new unit driver register method + +M components/cam/src/unit_drivers/stub/unit_driver.F90 + - stub out unit_driver_reg + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_hobart_nag + - add regression test for sam1mom + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB except for the new added test which has no baseline +017 bl221 TBL.sh f10c5spcamsm outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Jul 7 17:55:11 MDT 2016 + +hobart/pgi or jaguar/pgi: all BFB + +Also ran the new aux_spcam compsets on hobart (nag and pgi) and yellowstone (intel) and they ran to completion + +=============================================================== +=============================================================== + +Tag name: cam5_4_75 +Originator(s): goldy +Date: 2016-06-18 +One-line Summary: Consolidate default initialization of constituents into + one routine + +Purpose of changes: Currently, each dycore replicates all the logic + necessary to initialize a constituent to a default value. In + addition to being a maintenance issue, this functionality + naturally belongs in the physics code. The new function, + cnst_init_default_col, also has a clearer interface. Latitude and + longitue are passed explicitly along with an optional mask which + defines valid indices in the constituent array. + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, eaton (design review) + +List all subroutines eliminated: + - convect_shallow_init_cnst -- unused code + - convect_shallow_implements_cnst -- unused code + +List all subroutines added and what they do: + - cnst_init_default -- Allows a dycore to initialize a constituent to its + default value + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Brilliant prose added in changelogic pentameter +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/pp_none/chemistry.F90 + - Updated chem_init_cnst to use the new interface +M components/cam/src/dynamics/eul/dyn_comp.F90 +M components/cam/src/dynamics/fv/dyn_comp.F90 +M components/cam/src/dynamics/se/dyn_comp.F90 +M components/cam/src/dynamics/sld/dyn_comp.F90 + - Replaced the old default initialization logic with a call to cnst_init_default_col +M components/cam/src/dynamics/se/dyn_grid.F90 + - Made pelat_deg and pelon_deg public to allow access to cnst_init_default_col +M components/cam/src/physics/cam/aoa_tracers.F90 + - Updated aoa_tracers_init_cnst to use the new interface +M components/cam/src/physics/cam/carma_intr.F90 + - Updated carma_init_cnst to use the new interface +M components/cam/src/physics/cam/clubb_intr.F90 + - Updated clubb_init_cnst to use the new interface +M components/cam/src/physics/cam/co2_cycle.F90 + - Updated co2_init_cnst to use the new interface +A + components/cam/src/physics/cam/const_init.F90 + - New module to hold the cnst_init_default_col subroutine +M components/cam/src/physics/cam/convect_shallow.F90 + - Removed unused routines, convect_shallow_init_cnst and convect_shallow_implements_cnst +M components/cam/src/physics/cam/micro_mg_cam.F90 + - Updated micro_mg_cam_init_cnst to use the new interface +M components/cam/src/physics/cam/microp_driver.F90 + - Updated microp_driver_init_cnst to use the new interface +M components/cam/src/physics/cam/rk_stratiform.F90 + - Updated rk_stratiform_init_cnst to use the new interface +M components/cam/src/physics/cam/tracers.F90 + - Updated tracers_init_cnst to use the new interface +M components/cam/src/physics/cam/tracers_suite.F90 + - Updated init_cnst_tr, init_cnst_lw, init_cnst_md, init_cnst_hi, and, init_cnst_un to use the new interface +M components/cam/src/physics/cam/unicon_cam.F90 + - Updated unicon_init_cnst to use the new interface +M components/cam/src/physics/carma/cam/carma_intr.F90 + - Updated carma_init_cnst to use the new interface +M components/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M components/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M components/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M components/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M components/cam/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M components/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M components/cam/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M components/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M components/cam/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +M components/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +M components/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +M components/cam/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +M components/cam/src/physics/carma/models/tholin/carma_model_mod.F90 + - Updated CARMA_InitializeParticle to use the new interface + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All Pass + +hobart/nag: All Pass + +hobart/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_74 +Originator(s): cacraig +Date: June 17, 2016 +One-line Summary: Update svn externals to match cesm1_5_alpha07c+ + +Purpose of changes: +- Update svn externals to cesm1_5_alpha07c +- Update cice external to cice5_2160614 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update svn externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Thu Jun 16 21:53:22 MDT 2016 +008 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Thu Jun 16 21:56:29 MDT 2016 +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 22:08:17 MDT 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Thu Jun 16 22:14:25 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Jun 16 22:26:48 MDT 2016 +022 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Thu Jun 16 22:42:56 MDT 2016 +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Thu Jun 16 22:45:45 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Thu Jun 16 23:06:55 MDT 2016 +030 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Thu Jun 16 23:16:19 MDT 2016 +033 bl397 TBL.sh f1.9c4cm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Thu Jun 16 23:19:40 MDT 2016 +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Jun 16 23:30:59 MDT 2016 +039 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Thu Jun 16 23:39:28 MDT 2016 +041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Jun 16 23:48:55 MDT 2016 +044 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Jun 17 00:08:25 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Jun 17 00:30:35 MDT 2016 +050 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Fri Jun 17 01:06:56 MDT 2016 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Fri Jun 17 01:14:41 MDT 2016 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Fri Jun 17 01:16:15 MDT 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Fri Jun 17 01:36:09 MDT 2016 + +hobart/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Jun 16 13:32:41 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Thu Jun 16 13:36:06 MDT 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 16 13:38:44 MDT 2016 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 16 13:42:59 MDT 2016 +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 13:51:09 MDT 2016 +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Thu Jun 16 13:58:42 MDT 2016 +037 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Thu Jun 16 14:01:06 MDT 2016 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Thu Jun 16 14:04:43 MDT 2016 +046 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Thu Jun 16 14:07:30 MDT 2016 +049 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Thu Jun 16 14:19:02 MDT 2016 +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Thu Jun 16 14:37:03 MDT 2016 +055 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Thu Jun 16 14:46:48 MDT 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Jun 16 14:59:16 MDT 2016 +064 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 15:09:23 MDT 2016 +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Thu Jun 16 15:15:08 MDT 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Thu Jun 16 15:21:47 MDT 2016 +073 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Thu Jun 16 15:35:23 MDT 2016 + +hobart/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Jun 16 13:35:32 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Thu Jun 16 13:41:54 MDT 2016 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 16 13:49:14 MDT 2016 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 16 14:00:07 MDT 2016 +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 14:16:35 MDT 2016 +036 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Thu Jun 16 14:21:01 MDT 2016 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Jun 16 14:33:20 MDT 2016 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Thu Jun 16 14:38:45 MDT 2016 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Thu Jun 16 14:39:58 MDT 2016 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Thu Jun 16 14:42:52 MDT 2016 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Jun 16 14:49:01 MDT 2016 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Thu Jun 16 15:06:29 MDT 2016 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 15:15:08 MDT 2016 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 16 15:23:01 MDT 2016 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Jun 16 15:33:40 MDT 2016 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Thu Jun 16 15:39:30 MDT 2016 + +Changes are due to answer changes in external libraries + +=============================================================== +=============================================================== + +Tag name: cam5_4_73 +Originator(s): fvitt, tilmes +Date: 16 Jun 2016 +One-line Summary: Modifications to VBS SOA model + +Purpose of changes: + + Provide capability for a simpler VBS SOA chemistry scheme (fewer species). + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/test/system/config_files/f0.9c5.5mam4vbsh + - configure options for VBS SOA chemsitry + +A components/cam/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam55.xml +A components/cam/bld/namelist_files/use_cases/1850_trop_strat_vbs_cam55.xml + - new use case files for VBS SOA chemistry + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + - VOC emis update + - removed add_default for "use_rdggamma_file" -- this namelist option does not exist + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + +M components/cam/bld/namelist_files/master_gas_drydep_list.xml +M components/cam/bld/namelist_files/master_gas_wetdep_list.xml + - changes to accomadate more SOA* names + +M components/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - GLYOXAL_aer user reaction rate added + +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 + - SOA chemistry updates + +M components/cam/src/chemistry/mozart/rate_diags.F90 + - use larger sized temperary strings to process rate sums that have a + large number of terms + +M components/cam/test/system/input_tests_master + - added a test for VBS SOA chemsitry + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All Pass + +hobart/nag: All Pass + +hobart/pgi: All Pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_72 +Originator(s): fvitt +Date: 15 Jun 2016 +One-line Summary: CAM Makefile change + +Purpose of changes: + + Decrease the intel compiler optimization level for the uwshcu module + to be consistent with CIME's intel build + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +. components/cam/bld/Makefile.in + - remove uwshcu.F90 from the intel compiler O3 optimization group + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed Jun 15 16:52:05 MDT 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed Jun 15 17:11:58 MDT 2016 + + - these baseline failures are expected due to change in intel compiler + optimization option for the uwshcu module used in cam5 physics + +hobart/nag: All Pass + +hobart/pgi: All Pass + + +=============================================================== +=============================================================== + +Tag name: cam5_4_71 +Originator(s): fvitt +Date: 14 Jun 2016 +One-line Summary: update cime external + +Purpose of changes: + + Update to cime4.5.15, which includes extensions to the deposition tables in + driver_cpl/shr/seq_drydep_mod.F90 needed for upcoming changes to chemistry + VBS SOA aerosol package + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: none + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + . SVN_EXTERNAL_DIRECTORIES + - update to cime4.5.15 + + . components/cam/bld/configure + - include stub ESP component in stand-alone cam build + + . components/cam/test/system/TCB_ccsm.sh + - set PE layout for ESP component + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Tue Jun 14 17:36:48 MDT 2016 +008 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Tue Jun 14 17:36:51 MDT 2016 +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 17:37:00 MDT 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Tue Jun 14 17:37:12 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jun 14 17:37:23 MDT 2016 +022 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Tue Jun 14 17:37:46 MDT 2016 +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Jun 14 17:37:50 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Tue Jun 14 17:40:32 MDT 2016 +030 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Jun 14 17:42:12 MDT 2016 +033 bl397 TBL.sh f1.9c4cm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Jun 14 17:42:21 MDT 2016 +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Jun 14 17:42:28 MDT 2016 +039 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Tue Jun 14 17:44:11 MDT 2016 +041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Jun 14 17:44:26 MDT 2016 +044 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Tue Jun 14 17:44:57 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Tue Jun 14 17:47:58 MDT 2016 +050 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Tue Jun 14 17:48:17 MDT 2016 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Jun 14 17:48:21 MDT 2016 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Tue Jun 14 17:48:25 MDT 2016 +060 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Tue Jun 14 17:48:28 MDT 2016 +063 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Jun 14 17:48:35 MDT 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Jun 14 17:51:22 MDT 2016 +072 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Tue Jun 14 17:54:19 MDT 2016 + + Baseline failures are expected due to a correction to shr_orb_cosz (in cime4.5.11) + +076 eq993 TEQ_ccsm.sh ne30_ne30 FC5 h30c5h fcase 9s ...........................................FAIL! rc= 7 at Tue Jun 14 17:56:41 MDT 2016 + + This failure is due to CIME's change in the intel compiler optimization level of uwshcu.F90 + +hobart/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Jun 14 11:47:18 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Jun 14 11:50:31 MDT 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Jun 14 11:52:39 MDT 2016 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Jun 14 11:57:19 MDT 2016 +025 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Jun 14 12:02:02 MDT 2016 +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 12:05:26 MDT 2016 +031 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Jun 14 12:07:52 MDT 2016 +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Tue Jun 14 12:13:10 MDT 2016 +037 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Jun 14 12:15:37 MDT 2016 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Jun 14 12:19:24 MDT 2016 +046 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Tue Jun 14 12:22:17 MDT 2016 +049 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Jun 14 12:33:57 MDT 2016 +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Tue Jun 14 12:52:16 MDT 2016 +055 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Jun 14 13:02:16 MDT 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jun 14 13:14:44 MDT 2016 +061 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Jun 14 13:20:24 MDT 2016 +064 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 13:24:44 MDT 2016 +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Tue Jun 14 13:30:29 MDT 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Jun 14 13:37:10 MDT 2016 +073 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Jun 14 13:51:04 MDT 2016 +076 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Jun 14 13:55:41 MDT 2016 + +hobart/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Jun 14 11:50:31 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Tue Jun 14 11:57:42 MDT 2016 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Jun 14 12:02:39 MDT 2016 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Jun 14 12:04:42 MDT 2016 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Jun 14 12:15:45 MDT 2016 +030 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Jun 14 12:26:31 MDT 2016 +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 12:32:43 MDT 2016 +036 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Tue Jun 14 12:37:30 MDT 2016 +038 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Jun 14 12:42:51 MDT 2016 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Jun 14 12:50:14 MDT 2016 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Jun 14 12:56:13 MDT 2016 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Jun 14 12:57:49 MDT 2016 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Jun 14 13:00:24 MDT 2016 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Jun 14 13:07:07 MDT 2016 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Tue Jun 14 13:25:06 MDT 2016 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 13:34:13 MDT 2016 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 14 13:42:19 MDT 2016 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Jun 14 13:53:11 MDT 2016 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Jun 14 13:59:05 MDT 2016 + + Baseline failures are expected due to a correction to shr_orb_cosz (in cime4.5.11) + +=============================================================== +=============================================================== + +Tag name: cam5_4_70 +Originator(s): eaton +Date: Tue Jun 14 07:44:27 MDT 2016 +One-line Summary: fix for FV in serial mode + +Purpose of changes: + +. The previous commit broke serial mode for FV due to some missing + initializers in the internal FV state object. + +Bugs fixed (include bugzilla ID): + +. Fix FV in serial mode (actually non-mpi mode; the fix applies to a pure + OMP configuration as well as serial). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/src/dynamics/fv/dynamics_vars.F90 +. initialize t_fvdycore_grid components (jfirst, jlast, ifirstxy, ilastxy, + jfirstxy, jlastxy, kfirst, klast, klastp) with values appropriate for + non-decomposed grids + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +yellowstone/intel/aux_cam: Ran test by hand: F2000_DONOTUSE test is BFB with run made with cam5_4_68 + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. CAM doesn't have any regression +tests for FV serial which is why this was missed in the previous commit. + +=============================================================== +=============================================================== + +Tag name: cam5_4_69 +Originator(s): eaton +Date: Fri Jun 10 07:40:19 MDT 2016 +One-line Summary: mods towards unifying initial and restart code paths + +Purpose of changes: + +. Use a single filehandle to point to either the initial file or the + primary restart file. Move the call to open the initial or restart file + to right after the namelist read. The previous individual calls to open + either the initial or restart file are removed from the conditional on + whether it's an initial run or not. + +. Initialize the grids immediately after the initial or restart file is + open. This requires a large refactoring in the dynamics interface code + for all 4 dycores. The initialization of the grid and the decomposition + are moved to the dyn_grid_init method. Move the call to dyn_grid_init + outside of the conditions on whether the run is initial or restart. + +. Move the call to initialize the physics grid decomposition to be + immediately after the call to dyn_grid_init (outside the conditional on + whether the run is initial or restart). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. move cam_branch_file to group cam_initfiles_nl +. move ct_overlap, trac_decomp from dyn_fv_inparm to spmd_fv_inparm + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/control/readinitial.F90 +. functionality moved to dyn_grid_init methods + +components/cam/src/control/startup_initialconds.F90 +. functionality moved to dyn_init methods + +components/cam/src/dynamics/eul/inidat.F90 +. move all routines to dyn_comp.F90 + +components/cam/src/dynamcis/eul/inital.F90 +. eliminate the cam_initial interface and call dyn_init directly from + cam_init. + +components/cam/src/dynamics/eul/initcom.F90 +. functionality moved to dyn_grid_init + +components/cam/src/dynamics/fv/fv_control_mod.F90 +. eliminate unused data and make use of the t_fvdycore_state object for + everything else + +components/cam/src/dynamics/fv/inidat.F90 +. move all routines to dyn_comp.F90 + +components/cam/src/dynamcis/fv/inital.F90 +. eliminate the cam_initial interface and call dyn_init directly from + cam_init. + +components/cam/src/dynamics/fv/initcom.F90 +. functionality moved to dyn_grid_init + +components/cam/src/dynamics/se/inidat.F90 +. read_inidat moved to dyn_comp + +components/cam/src/dynamcis/se/inital.F90 +. eliminate the cam_initial interface and call dyn_init directly from + cam_init. + +components/cam/src/dynamics/se/initcom.F90 +. this was a stub module that's no longer needed + +components/cam/src/dynamics/sld/inidat.F90 +. move all contents to dyn_comp module + +components/cam/src/dynamics/sld/inital.F90 +. code moved to dyn_grid_init, dyn_init, cam_init + +components/cam/src/dynamics/sld/initcom.F90 +. code moved to dyn_grid_init + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/configure +. remove setting the CPP macro STAGGERED. It is no longer used. + +components/cam/bld/namelist_files/namelist_definition.xml +. move cam_branch_file to group cam_initfiles_nl +. move ct_overlap, trac_decomp from dyn_fv_inparm to spmd_fv_inparm + +components/cam/src/control/cam_comp.F90 +. cam_init: + - move call to cam_initfiles_open from inside if(initial_run) conditional + to right after read_namelist. + - call dyn_grid_init after cam_initfiles_open + - add calls to phys_grid_init and chem_surfvals_init + +components/cam/src/control/cam_initfiles.F90 +. add cam_branch_file to cam_initfiles_nl namelist group. +. set name of restart pointer file here (moved from cam_restart.F90). Name + is public so cam_restart module can update contents as restart files are + written. +. set name of initial restart file for restart or branch runs (moved from + cam_restart). +. set caseid_prev here (moved from cam_restart). Since initial restart + files are opened here this module will do consistency check on caseid in + case of branch run. Also is responsible for providing this name to the + component interface as long as the separate surface restart file is + needed. +. add the get_restcase and get_restartdir methods. This module is now + responsible for the data that those accessor functions provide. +. remove call to read_initial from cam_initfiles_open. Functionality moved + to dycore specific dyn_grid_init + +components/cam/src/control/cam_restart.F90 +. remove cam_restart_nl namelist group and cam_restart_readnl routine. +. remove opening of restart file (moved to cam_initfiles). +. modify write_rest_pfile + - take the restart filename as an argument + - access the name of the pointer file from cam_initfiles + - remove adding the names of other restart files as comments. No other + component does this and it adds unnecessary complexity. +. move the get_restcase and get_restartdir methods to cam_initfiles +. cam_read_restart + - remove call to initcom + - remove call to ref_pres_init + - remove calls to phys_grid_init, chem_surfvals_init, spmdbuf + +components/cam/src/control/runtime_opts.F90 +. remove call to cam_restart_readnl + +components/cam/src/cpl/atm_comp_esmf.F90 +components/cam/src/cpl/atm_comp_mct.F90 +. update use association of get_restcase and get_restartdir to use the + methods in cam_initfiles + +components/cam/src/dynamics/eul/dyn_comp.F90 +. dyn_init + - move subroutine trunc() to module dyn_grid + - remove calls to trunc, spmdinit_dyn, hycoef_init (moved to dyn_grid_init) + - add calls to initialize_prognostics, scanslt_alloc, spmdbuf, and + initial_conds. The initial_conds call will be replaces by a + read_inidat call which must be inside a conditional to only be called + on an initial run. + +components/cam/src/dynamics/eul/dyn_grid.F90 +. change default module access to private +. add public statement for methods +. turn the initgrid method into dyn_grid_init + - add check on grid size previously done in read_initial + - add call to trunc() + - add call to spmdinit_dyn + - add call to hycoef_init + - add call to ref_pres_init + - remove dyn_grid_get_pref +. move subroutine trunc here from dyn_comp +. remove unused get_block_ldof_d + +components/cam/src/dynamics/eul/restart_dynamics.F90 +. read_restart_dynamics + - remove calls to initialize_prognostics, scanslt_alloc which are now + done in dyn_init + +components/cam/src/dynamics/fv/cd_core.F90 +. pass div24del2flag, del2coef through arg list rather than access from + fv_control_mod. + +components/cam/src/dynamics/fv/dyn_comp.F90 +. dyn_readnl + - remove namelist variables fv_ct_overlap and fv_trac_decomp +. dyn_register + - add this method and put the pbuf add calls there. Will need to add + this method to the dyn_comp modules of all dycores. +. dyn_init + - move hycoef_init call to dyn_grid_init + - move setting of namelist values in t_fvdycore_state object into + dyn_readnl + - move spmdinit_dyn call to dyn_grid_init + - clean up after moving all the grid initialization to dyn_grid_init. + - remove unused arg fh and replace the dyn_state arg by local pointer + and get state using get_dyn_state +. dyn_run + - access ct_overlap, trac_decomp from grid object rather than + fv_control_mod. + - access div24del2flag, del2coef from dyn_state and pass through cd_core + interface. + +components/cam/src/dynamics/fv/dyn_grid.F90 +. change default module access to private +. add public statement for methods +. turn the initgrid method into dyn_grid_init + - add check on grid size previously done in read_initial + - add call to hycoef_init + - add call to ref_pres_init + - remove dyn_grid_get_pref + - add call to spmdinit_dyn (remove SPMD conditional) +. remove unused get_block_ldof_d +. dyn_grid_init + - move the call to grid_vars_init here (was dynpkg_init called from + dynamics_init which has been removed) + - move call to define_cam_grids here (from dyn_comp::dyn_init) + - pass fft_flt through pftinit arg list +. fix use associations of pmgrid (most values now live only in grid + object). + +components/cam/src/dynamics/fv/dynamics_vars.F90 +. remove the dynamics_init subroutine. It's functionality is replaced by + setting the components of the grid object as soon as possible, and by + making direct calls to dynpkg_init and spmd_vars_init. +. dynpkg_init -- rename to grid_vars_init + - move the setting of ng_c, ng_d, ng_s into spmd_dyn::spmdinit_dyn. The + only info needed to set these vars is jord which is read in + dyn_readnl. +. spmd_vars_init + - remove the dummy args previously used to set components of the grid + object, but which have already been set elsewhere. Turn those args + into local variables set from the grid object components so don't need + to modify much internal code. +. remove unused components from t_fvdycore_state: run_times, num_calls, + dotime, dodyn +. add new components to t_fvdycore_state that were previously in the + fv_control_mod module: fft_flt, div24del2flag, del2coef +. add new components to t_fvdycore_grid that were previously in + fv_control_mod: ct_overlap, trac_decomp +. spmd_vars_init + - access ct_overlap, trac_decomp from grid object instead of fv_control_mod +. grid_vars_init + - pass fft_flt through arg list so can be passed to pftinit + +components/cam/src/dynamics/fv/gravity_waves_sources.F90 +. replace use of XY decomp info in pmgrid by grid object + +components/cam/src/dynamics/fv/metdata.F90 +. add only qualifier to pmgrid use statement + +components/cam/src/dynamics/fv/pft_module.F90 +. change fft_flt to be module data rather than access via fv_control_mod +. pftinit + - add fft_flt as input arg for initializing module data + +components/cam/src/dynamics/fv/restart_dynamics.F90 +. replace use of XY decomp info in pmgrid by grid object +. remove tmass0 +. read_restart_dynamics + - update interface to dyn_init call + +components/cam/src/dynamics/fv/spmd_dyn.F90 +. Narrow the scope of the SPMD ifdef so the readnl and init methods can + always be called. There is currently a bunch of code in dyn_init that + belongs in these spmd_dyn methods. +. spmd_readnl + - put the namelist data into the grid object. Anything in the grid + object should be removed from pmgrid: npr_y, npr_z, npes_yz, nprxy_x, + nprxy_y, npes_xy, twod_decomp + - add fv_ct_overlap, fv_trac_decomp. Store values in grid object. +. spmdinit_dyn + - remove calls to parsplit. these are duplicated in spmd_vars_init and + those calls are the ones setting the communicators in the grid object + - put decomp data directly into grid object and remove it from pmgrid: + beglat, endlat, beglev, endlev, endlevp, endlevp1 + beglonxy, endlonxy, beglatxy, endlatxy + - remove code to compute nmostlat and smostlat which appears to be + unused. + - move code here to set imxy, jmxy, jmyz, kmyz. Was in dyn_init. Will + pass these arrays through spmd_vars_init interface. + +components/cam/src/dynamics/fv/stepon.F90 +. fix use associations of pmgrid +. stepon_init + - remove check for STAGGERED + +components/cam/src/dynamics/se/dyn_comp.F90 +. dyn_register + - add this routine. Move the pbuf_add_field calls for FRONTGF and + FRONTGA here. +. dyn_init1 + - remove this routine. move the code in this routine to dyn_grid_init, + except for the init of the dyn_in and dyn_out objects. This needs to + be moved to the dyn_init2 routine because dyn_in/dyn_out are not args + to dyn_grid_init. Also move create_native_mapping_files to dyn_init2 + since otherwise a circular dependency occurs between native_mapping and + dyn_grid. +. public data timelevel, dom_mt, hvcoord moved to dyn_grid +. dyn_init2 + - change name to dyn_init + - call to read_inidat here and eliminate the call to initial_conds. Only + make this call for an initial run for now. Eventually should have the + same code reading either the initial or restart file. +. read_inidat + - moved here from inidat module + +components/cam/src/dynamics/se/dyn_grid.F90 +. dyn_grid_init + - add check for size of grid in initial file + +components/cam/src/dynamics/se/gravity_waves_sources.F90 +. access dom_mt, hvcoord from dyn_grid, not dyn_comp + +components/cam/src/dynamics/se/restart_dynamics.F90 +. read_restart_dynamics + - remove call to dyn_init1 + - access elem via dyn_grid since dyn_in isn't initialized until the call + to dyn_init (renamed from dyn_init2) + +components/cam/src/dynamics/se/stepon.F90 +. access timelevel from dyn_grid, not dyn_comp + +components/cam/src/dynamics/sld/dyn_comp.F90 +. move subroutine trunc() to module dyn_grid +. dyn_init + - add dyn_in and dyn_out as intent(out) dummy args + - remove calls to trunc, spmdinit_dyn, hycoef_init, and define_cam_grids + (moved to dyn_grid_init) + +components/cam/src/dynamics/sld/dyn_grid.F90 +. add private attribute +. add public statement for methods +. remove unused get_block_ldof_d +. remove dyn_grid_get_pref +. add dyn_grid_init + - add check on grid size previously done in read_initial + - add call to trunc() and the trunc subroutine (moved from dyn_init) + - add call to spmdinit_dyn (moved from dyn_init) + - add call to hycoef_init (moved from dyn_init) + - add call to ref_pres_init + - add call to define_cam_grids (moved from dyn_init) + +components/cam/src/dynamics/sld/restart_dynamics.F90 +. read_restart_dynamics + - update dyn_init actual args + - remove calls to initialize_prognostics and slt_alloc + +components/cam/src/dynamics/sld/scanslt.F90 +. remove initializer for nlonex. add it to the declaration statement in + the module data. + +components/cam/src/physics/cam/physpkg.F90 +. call dyn_register from phys_register + +components/cam/src/physics/cam/ref_pres.F90 +. refactor ref_pres_init to take the reference pressures as arguments + rather than via use of a dyn_grid method. That avoids creating a + circular dependency since we want to call ref_pres_init from dyn_grid. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_68 +Originator(s): fvitt +Date: 8 Jun 2016 +One-line Summary: Energetic particle inputs and WACCM updates + +Purpose of changes: + + - dynamically update geomagnetic coordinates on yearly basis + - read IGRF coefficient data from netCDF file + - energetic particle inputs on geomagnetic coordinates + - add D-region chemistry + - rename middle atmosphere "waccm_mozart" chemistry mechanisms as "waccm_ma" + - update aurora module to be consistent with TIEGCM + - chemistry changes associated the excited states of O+ in the waccm middle + atmosphere chemistry mechanism -- used by WACCMX and WACCM4 + - in iondrag set electron density as the sum of the densities O+, O2+, and NO+ + - ion drift velocities history fields 'UE', 'VE' renamed to 'UI', 'VI' + - add chemistry associated with O+ excited states to WACCM middle atmosphere + chemistry + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/src/chemistry/pp_waccmx_mozart + - removed -- waccmx uses pp_waccm_ma + +D components/cam/src/chemistry/pp_waccm_mozart_mam3 +D components/cam/src/chemistry/pp_waccm_mozart_mam4 +D components/cam/src/chemistry/pp_waccm_mozart +D components/cam/src/chemistry/pp_waccm_mozart_sulfur + - renamed "waccm_mozart" as "waccm_ma" + +D components/cam/src/chemistry/mozart/mo_solarproton.F90 +D components/cam/src/chemistry/mozart/spedata.F90 + - removed -- SPE functionality replaced by epp_ionization module + + +List all subroutines added and what they do: +A components/cam/bld/namelist_files/use_cases/sd_waccm5_mad_geos5.xml + - new use case for waccm d-region + +A components/cam/src/chemistry/pp_waccm_ma_sulfur + - renamed "waccm_mozart" as "waccm_ma" + - correction to "OCS + OH" reaction + +A components/cam/src/chemistry/pp_waccm_ma +A components/cam/src/chemistry/pp_waccm_ma_mam3 +A components/cam/src/chemistry/pp_waccm_ma_mam4 + - renamed "waccm_mozart" as "waccm_ma" + +A components/cam/src/chemistry/pp_waccm_mad_mam4 + - new mechanism for D-region ion chemistry + +A components/cam/src/chemistry/mozart/epp_ionization.F90 + - new module to read in EPP data sets (on geo-mag grid) + +A components/cam/test/system/nl_files/outfrq24h_epp +A components/cam/test/system/nl_files/outfrq3s_epp +A components/cam/test/system/config_files/fsd1.9c5.4wmdionh +A components/cam/test/system/config_files/f10c5wmdiond + - new tests for waccm d-region chemistry + +List all existing files that have been modified, and describe the changes: +M components/cam/src/chemistry/bulk_aero/aero_model.F90 + +M components/cam/src/chemistry/mozart/mo_setext.F90 + - changes for the new EPP inputs + - EPP forcings for D-region chemistry + +M components/cam/src/chemistry/mozart/charge_neutrality.F90 + - refactored and expanded for D-region ions + +M components/cam/src/chemistry/mozart/mo_photo.F90 + - D-region ionizations added + +M components/cam/src/chemistry/mozart/mo_aurora.F90 + - made consistent with TIEGCM + - removed dead SPE and HEE code + - code clean up + +M components/cam/src/chemistry/mozart/gcr_ionization.F90 + - split out HOx production code + +M components/cam/src/chemistry/utils/mo_msis_ubc.F90 + - fixed restart bug in MSIS when run start time is not mid-night UT + - added diagnostics + +M components/cam/src/chemistry/mozart/upper_bc.F90 + - fixed restart bug in MSIS when run start time is not mid-night UT + +M components/cam/src/chemistry/mozart/wei96.F90 +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 +M components/cam/src/chemistry/mozart/spehox.F90 +M components/cam/src/chemistry/mozart/efield.F90 + - code clean up + +M components/cam/src/chemistry/mozart/mo_apex.F90 + - variable geo-magnetic year implimented + +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - reactions rates added for D-region chemistry + - reactions rates added for quenching of excited states of O+ + +M components/cam/src/chemistry/mozart/mo_chemini.F90 + - removed references to spedata + +M components/cam/src/chemistry/mozart/chemistry.F90 + - removed references to spedata + - use new epp_ionization module + +M components/cam/src/chemistry/mozart/exbdrift.F90 + - pbuf name change for ion drift velocities + - ion drift velocities now 3-dimensional + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - enforce charge neutrality at the end of chemistry time step + +M components/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - fixed bug in diagnostics array dimensions + +M components/cam/src/chemistry/utils/tracer_data.F90 + - improvement in error messages + +M components/cam/src/chemistry/utils/mo_solar_parms.F90 + - removed unused code for hemispheric power + - added log messages + +M components/cam/src/chemistry/utils/apex.F90 + - read IGRF data from netcdf file + - added ability to re-initialize for change in geo-magnetic date + - code clean up + +M components/cam/src/physics/cam/physpkg.F90 + +M components/cam/src/physics/waccmx/ionosphere.F90 +M components/cam/src/physics/waccm/iondrag.F90 + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/tests_waccm_mpi +M components/cam/test/system/config_files/f1.9c4wmm +M components/cam/test/system/config_files/f10c4wmxdm +M components/cam/test/system/config_files/f1.9c5wmam3h +M components/cam/test/system/config_files/h5c4wmdm +M components/cam/test/system/config_files/f4c5wmclbdh +M components/cam/test/system/config_files/f1.9c4wmxdh +M components/cam/test/system/config_files/f1.9c4wmdh +M components/cam/test/system/config_files/fsd1.9c4wcarmsuldm +M components/cam/test/system/config_files/f1.9c5wmclbdh +M components/cam/test/system/config_files/fsd1.9c4wmh +M components/cam/test/system/config_files/f1.9c4carmsuldh +M components/cam/test/system/config_files/f1.9c4wcarmbc_m +M components/cam/test/system/config_files/fsd1.9c4wmdh +M components/cam/test/system/config_files/f4c4wmdh +M components/cam/test/system/config_files/f10c5wmam3dm +M components/cam/test/system/config_files/f4c4wmh +M components/cam/test/system/config_files/f1.9c5wmam3dh +M components/cam/test/system/config_files/f10c4wmdm +M components/cam/test/system/config_files/f1.9c4wmxh +M components/cam/test/system/config_files/f1.9c4wmh +M components/cam/test/system/TPF.sh + +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - added default IGRF input file + - changes for renaming "waccm_mozart" as "waccm_ma" + +M components/cam/bld/namelist_files/namelist_definition.xml + - removed SPE namelist options + - added EPP, IGRF, and fixed geo-mag year namelist options + +M components/cam/bld/build-namelist + - changes for renaming "waccm_mozart" as "waccm_ma" + - sanity checks for the EPP settings + +M components/cam/bld/configure +M components/cam/bld/config_files/definition.xml +M components/cam/bld/config_files/defaults_waccmx.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml +M components/cam/cime_config/config_component.xml + - changes for renaming "waccm_mozart" as "waccm_ma" + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Wed Jun 8 10:43:38 MDT 2016 +030 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Wed Jun 8 10:52:24 MDT 2016 +039 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Wed Jun 8 11:13:58 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Wed Jun 8 12:00:30 MDT 2016 + expected failures due to changes in geomag date and aurora updates + +yellowstone/intel/aux_cam: Ran test by hand: F2000_DONOTUSE test is BFB with run made with cam5_4_67 + +hobart/nag: +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Tue Jun 7 13:38:35 MDT 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Jun 7 13:45:21 MDT 2016 + expected failures due to changes in geomag date and aurora updates + +hobart/pgi: all pass + +=============================================================== +=============================================================== + +Tag name: cam5_4_67 +Originator(s): bdobbins, eaton +Date: Tue Jun 7 08:34:23 MDT 2016 +One-line Summary: fix for ridge scheme; optimization in heterogeneous + freezing code + +Purpose of changes: + +. Add the constituent tendencies and the energy change calculation to the + ridge scheme. Cecile verified that the impact on the simulation is + small. + +. Optimization from ASAP group (bdobbins) to hetfrz_classnuc.F90. Improves + CAM runtime w/ MAM4 chem by about 4%. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: about 4% speedup for +cam6. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/src/physics/cam/gw_drag.F90 +. gw_rdg_calc + - uncomment the code that adds in the constituent tendencies + - uncomment the code that calculates the energy change used by the energy + conservation checker. + +components/cam/src/physics/cam/hetfrz_classnuc.F90 +. move an expensive calculation that was being duplicated for every + gridcell at every timestep into an init method. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +yellowstone/intel/aux_cam: Ran test by hand: F2000_DONOTUSE test is ANSWER CHANGING with run made with cam5_4_66 + - this is expected due to the ridge changes as this test has use_gw_rdg_beta=.true. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except when ridge scheme is turned +on. It is currently off by default, but will be on for cam6 once we get +the required datasets. + +=============================================================== +=============================================================== + +Tag name: cam5_4_66 +Originator(s): andrew, vitt, cacraig +Date: May 27, 2016 +One-line Summary: Bug fixes for use_cases (including 1850_cam55), cosp simulator and MG_SADICE and MG_SADSNOW diagnostics + +Purpose of changes: + - Use case fixes for 1850 CAM5.5 and a number of WACCM use cases + - Correct estimation of diagnostic precipitation flux calculations to exactly + track precipitation in MG1 and MG2. Affects LS_FLXPRC and LS_FLXSNW used for + COSP simulator. Adds LS_FLXICE and LS_FLXLIQ for MG2 to be consistent with its methods. + - unpack sadice and sadsnow for MG_SADICE and MG_SADSNOW diagnostics + +Bugs fixed (include bugzilla ID): + - bugzilla 2315: perscribed_strataero_cycle_yr being set to incorrect year + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/physics/cam/micro_mg1_0.F90 +M components/cam/src/physics/cam/micro_mg2_0.F90 + - Changes to support LS_FLXPRC and LS_FLXSNW in COSP when using MG2 + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - Changes to support LS_FLXPRC and LS_FLXSNW in COSP when using MG2 + - unpack sadice and sadsnow for MG_SADICE and MG_SADSNOW diagnostics + -- has no effect on climate + +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml + - correction to SAD input file + +M components/cam/bld/namelist_files/use_cases/1850_cam55.xml + - correction to cycle year for prescribed stratospheric aerosols + +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml + - correction to pom surface emissions + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Thu May 26 16:23:50 MD +T 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Thu May 26 17:17:40 MD +T 2016 + -- These two tests differ due to changes in the use_cases + +yellowstone/intel/aux_cam: Ran test by hand: F2000_DONOTUSE test is BFB with run made with cam5_4_64 + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB except: +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu May 26 11:52:49 MDT 2016 +-- answer changes expected for COSP when using MG2 + +=============================================================== +=============================================================== + +Tag name: cam5_4_65 +Originator(s): eaton, cacraig +Date: May, 27, 2016 +One-line Summary: fix restart when ridge scheme enabled + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/control/cam_initfiles.F90 +M components/cam/src/physics/cam/gw_drag.F90 + - fix to allow ridge scheme to restart properly + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_64 +Originator(s): juliob, eaton +Date: Tue May 24 07:56:47 MDT 2016 +One-line Summary: add beljaars and ridge to gravity wave param. + +Purpose of changes: + +. Add Beljaars Sub-Grid Orographic (SGO) Form drag parameterization. + - Returns drag profile and integrated stress associated with subgrid + mountains with horizontal length scales nominally below 3km. Similar + to TMS but drag is distributed in the vertical (Beljaars et al., 2003, + QJRMS). + - This option is controlled by the namelist variable do_beljaars. When + turned on it replaces the existing turbulent mountain stress + parameterization, i.e., if do_beljaars is true then do_tms must be + false. + +. Add generation of gravity waves from ridges. + - This option is controlled by the namelist variable use_gw_rdg_beta. + - Code was also added for gamma ridges, but this option is not yet + validated. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add namelist variables for beljaars and for ridges. see details + below in namelist_definition.xml + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +components/cam/src/physics/cam/beljaars_drag.F90 +. portable implementation of Beljaars scheme. + +components/cam/src/physics/cam/beljaars_drag_cam.F90 +. CAM interfaces to Beljaars scheme. + +components/cam/src/physics/cam/gw_rdg.F90 +. portable implementation of gravity wave sources from ridge scheme. + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +. check that do_tms and do_beljaars not both set to true +. add defaults for use_gw_rdg_beta and use_gw_rdg_gamma +. modify default for gw_prndl when beta ridges are being used +. add defaults for new vars depending on use_gw_rdg_beta and + use_gw_rdg_gamma + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. set default for do_beljaars to false + +components/cam/bld/namelist_files/namelist_definition.xml +. add following vars for beta ridges to group gw_drag_nl: + - use_gw_rdg_beta + - n_rdg_beta + - effgw_rdg_beta + - effgw_rdg_beta_max + - rdg_beta_cd_llb + - trpd_leewv_rdg_beta +. add following vars for gamma ridges to group gw_drag_nl: + - use_gw_rdg_gamma + - n_rdg_gamma + - effgw_rdg_gamma + - effgw_rdg_gamma_max + - rdg_gamma_cd_llb + - trpd_leewv_rdg_gamma + - bnd_rdggm +. add do_beljaars to switch the beljaars scheme + +components/cam/src/physics/cam/diffusion_solver.F90 +. add intent(in) arg dragblg to compute_vdiff +. modify calcs of tauresx and tauresy + +components/cam/src/physics/cam/eddy_diff_cam.F90 +. add intent(in) arg dragblg to eddy_diff_tend +. add actual arg dradblj to compute_eddy_diff call +. add intent(in) arg dragblg to compute_eddy_diff +. add actual arg dragblj to compute_vdiff call + +components/cam/src/physics/cam/gw_common.F90 +. remove limit_tau_without_eff and apply_tndmax. the conditionals for + these variables have been combined to be controlled by a single variable + which is now an optional argument to gw_drag_prof (lapply_effgw) +. gw_drag_prof + - add optional arg kwvrdg + . if present use it in expression for tausat + - add optional arg satfac_in + . if not present then satfac=2.0 which was previously hardcoded + - add optional arg lapply_effgw_in + . if not present the lapply_effgw=.true. This applies efficiency to + completed stress profile. + . lapply_effgw replaces apply_tndmax. it also replaces + (.not. limit_tau_without_eff) + +components/cam/src/physics/cam/gw_drag.F90 +. Add option for ridge scheme +. Add module data for the ridge scheme. This data is read from the topo + file for the beta ridges, and from file specified by bnd_rdggm for the + gamma ridges. +. Add namelist variables for ridge schemes. Update the namelist reader + to eliminate the SPMD ifdef. +. pass optional arg lapply_effgw_in=gw_apply_tndmax. to gw_drag_prof when + inside conditionals: use_gw_convect_dp, use_gw_convect_sh, use_gw_front, + use_gw_front_igw, use_gw_oro + +components/cam/src/physics/cam/vertical_diffusion.F90 +. add calls to beljaars readnl, register, init, tend + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE (the new schemes are not yet +turned on by default for cam5.5) + +=============================================================== +=============================================================== + +Tag name: cam5_4_63 +Originator(s): bardeenc, fvitt +Date: 19 May 2016 +One-line Summary: Corrections to ice nucleation processes + +Purpose of changes: + + These changes are needed to improve the water vapor and relative + humidity biases in the TTL, particularly when using specified + dynamics (which corrects for an offsetting cold temperature bias + in free running CAM). This affects ice clouds in the TTL and controls + stratospheric water vapor. Ice particle size and ice nucleation were + adjusted to better represent thin cirrus in the UTLS, Type II (ice) + polar stratospheric clouds, and to improve the season dehydration in + the winter polar stratosphere. The PSCs and the dehydration are important + for polar ozone chemistry. The changes will also make sure that we are + the relative humidity with respect to liquid never exceeds 1, which was + happening after CLUBB. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - look for 'SNOWQM' constituent to add to cldice + +M components/cam/src/physics/cam/macrop_driver.F90 + - enforce maximum rhliq of 1 everywhere + +M components/cam/src/physics/cam/micro_mg2_0.F90 + - scale the water saturation values to reflect subgrid scale, where + ice clouds begin forming at a gridbox average relative humidity of + rhmini + +M components/cam/src/physics/cam/microp_aero.F90 + - Correct coarse dust fraction to include coarse sulfate mass. Also + support cloudborne aerosols for ice clouds. + +M components/cam/src/physics/cam/nucleate_ice.F90 +M components/cam/src/physics/cam/nucleate_ice_cam.F90 + - Added option for ice nucleation using the gridbox average relative + humidity, and added support for cloudbourne aerosols for ice clouds. + +M components/cam/src/physics/cam/clubb_intr.F90 + - use ice_micro_tend to enforce RHliq<=1 everywhere if clubb_do_liqsupersat is true + - use Goff and Gratch saturation equation + - read clubb_do_liqsupersat namelist option + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - added support for subgrid growth of ice clouds (qsatfac) and calculation + of SADICE and SADSNOW from micro_mg_tend2_0 interface + +M components/cam/src/physics/cam/phys_control.F90 + - removed micro_do_icesupersat + +M components/cam/src/physics/cam/physpkg.F90 + - removed micro_do_icesupersat code block + +M components/cam/src/physics/cam/cldfrc2m.F90 + - Introduce subgrid scale saturation factor (qsatfac) to allow ice growth beginning at + rhmini if cldfrc2m_do_subgrid_growth is true + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - allow for smaller ice particle sizes and adjust fall velocity for small ice + particles + +M components/cam/src/physics/cam/ndrop.F90 + - support for cloudbourne aerosol in ice clouds + - return aerosols to interstitual as cloud fracions decrease + - prevent cloudbourne aerosols from being released when no liquid clould is present + +M components/cam/bld/namelist_files/namelist_definition.xml + - added: + nucleate_ice_incloud + nucleate_ice_strat + cldfrc2m_do_subgrid_growth + clubb_do_liqsupersat + - removed: + micro_do_icesupersat + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/build-namelist + - added check to error out if use_preexisting_ice is selected if the aerosol model is MAM7 + - set defaults for cldfrc2m_do_subgrid_growth, nucleate_ice_incloud, nucleate_ice_strat and + clubb_do_liqsupersat + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Wed May 18 19:40:55 MDT 2016 +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Wed May 18 19:46:40 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed May 18 19:59:34 MDT 2016 +024 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed May 18 20:18:28 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Wed May 18 20:40:25 MDT 2016 +036 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Wed May 18 21:03:03 MDT 2016 +041 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Wed May 18 21:20:30 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Wed May 18 21:59:44 MDT 2016 +050 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Wed May 18 22:43:52 MDT 2016 +063 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Wed May 18 23:08:00 MDT 2016 +068 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed May 18 23:12:42 MDT 2016 + +hobart/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed May 18 16:57:17 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Wed May 18 17:01:15 MDT 2016 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed May 18 17:04:18 MDT 2016 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed May 18 17:09:16 MDT 2016 +031 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed May 18 17:20:45 MDT 2016 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Wed May 18 17:33:04 MDT 2016 +046 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Wed May 18 17:36:16 MDT 2016 +049 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Wed May 18 17:48:30 MDT 2016 +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Wed May 18 18:07:14 MDT 2016 +055 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed May 18 18:17:47 MDT 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed May 18 18:30:58 MDT 2016 +061 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed May 18 18:36:58 MDT 2016 +064 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed May 18 18:41:50 MDT 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Wed May 18 19:11:45 MDT 2016 +073 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Wed May 18 19:27:17 MDT 2016 + +hobart/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed May 18 17:00:12 MDT 2016 +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Wed May 18 17:06:46 MDT 2016 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Wed May 18 17:11:46 MDT 2016 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed May 18 17:14:02 MDT 2016 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed May 18 17:25:07 MDT 2016 +038 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed May 18 17:50:57 MDT 2016 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed May 18 17:58:11 MDT 2016 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Wed May 18 18:03:37 MDT 2016 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Wed May 18 18:04:54 MDT 2016 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Wed May 18 18:07:50 MDT 2016 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed May 18 18:14:26 MDT 2016 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_npryz 9s .................................................FAIL! rc= 7 at Wed May 18 18:32:40 MDT 2016 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed May 18 18:41:58 MDT 2016 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed May 18 18:50:17 MDT 2016 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed May 18 19:01:20 MDT 2016 + +All of the cam5+ baseline tests are expected to fail. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change : larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/clubbq_cam5_4_51_tags/clubbq07_cam5_4_57 + +- platform/compilers: yellowstone, intel +- configure commandline: +- build-namelist command (or complete namelist): + +For cam5: +create_newcase -mach yellowstone -res f19_f19 -case /glade/p/acd/fvitt/cesm/cases/F2000C5_nucleate_test02 -user_compset 2000_CAM5_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV -user_pes_setby cam + +For cam5.5: +create_newcase -case /glade/u/home/bardeenc/ccsm/case/f2000c55_test05f -compset FC55CLUBB -res f09_f09 -mach yellowstone + +- MSS location of output: + +For cam5: +/home/bardeenc/csm/f2000c5_test05f + +For cam5.5: +/home/bardeenc/csm/f2000c55_test05f + +MSS location of control simulations used to validate new climate: + +For cam5: +/home/fvitt/csm/F2000C5_nucleate_cntl01 + +For cam5.5: +/home/bardeenc/csm/f2000c55_control + +URL for AMWG diagnostics output used to validate new climate: + +For cam5: +http://webext.cgd.ucar.edu/FCLIMO/f2000c5_test05f/atm/ + +For cam5.5 +https://acomstaff.acom.ucar.edu/bardeenc/waccm55/f2000c55_test05f-obs/index.html +https://acomstaff.acom.ucar.edu/bardeenc/waccm55/f2000c55_test05f-f2000c55_control/index.html + +=============================================================== +=============================================================== + +Tag name: cam5_4_62 +Originator(s): bogensch, cacraig +Date: May 18, 2016 +One-line Summary: Introduced CLUBB liquid supersat, new CLUBB heat diffusivity + namelist param and updated CLUBB/MG namelist defaults + +Purpose of changes: + - Update CLUBB svn external to head of UWM trunk. + - Introduces liquid supersaturation closure after the 2nd PDF call to + avoid relative humidities greater than 100% before CLUBB's equations + are advanced. + - Introduces tunable parameter for the diffusivities of heat in CLUBB. + - Sets the CLUBB/MG namelist default parameters to what Cecile is using + in her current pre-CAM6 "62" testing + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - added clubb_c_K10h -- Thermo of Kh_zm + - namelist default settings for MG and CLUBB were changed to match Cecile's test "62" + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - added liquid supersaturation closure after the 2nd PDF call in CLUBB + - merged to the head of the CLUBB library trunk + - updated SILHS to use the same revision number as CLUBB for consistency + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/src/physics/cam/clubb_intr.F90 + - add clubb_c_K10h + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Answer changes are expected for CLUBB + +yellowstone/intel: all BFB except for the tests which use CLUBB +015 bl357 TBL.sh f1.9c5.5h outfrq3s+1850_cam55 9s .............................................FAIL! rc= 7 at Wed May 18 11:20:24 MDT 2016 +018 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed May 18 11:32:45 MDT 2016 +027 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Wed May 18 12:14:11 MDT 2016 +047 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Wed May 18 13:35:23 MDT 2016 + +hobart/nag: all BFB except for the tests which use CLUBB +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Tue May 17 17:24:44 MDT 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue May 17 17:46:48 MDT 2016 + +hobart/pgi or jaguar/pgi: all BFB (no CLUBB tests are run using PGI) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: All configurations which use CLUBB +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +This is part of the modifications which are leading up to CAM6 and has not +been tested independently, but rather as a group with the next several +upcoming tags. + +=============================================================== +=============================================================== + +Tag name: cam5_4_61 +Originator(s): hannay, cacraig +Date: May 12, 2016 +One-line Summary: Add namelist var zmconv_num_cin and cleanup clubb_intr + +Purpose of changes: + -- Added namelist var zmconv_num_cin to control the number of negative buoyancy regions + that are allowed before the convection top and CAPE calculations are completed + -- When CAM was run on cori, it core dumped with a floating point exception in clubb. + Removed the on-the-fly arithmetic for outfld calls which operated on all columns + in the array, even undefined ones. + -- Removed unused variables in clubb_intr.F90 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + -- Added zmconv_num_cin (see description above) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/bld/build-namelist +M components/cam/src/physics/cam/zm_conv_intr.F90 +M components/cam/src/physics/cam/zm_conv.F90 + -- Added zmconv_num_cin to namelist + +M components/cam/src/physics/cam/clubb_intr.F90 + -- outfld calls had on-the-fly arithmetic being done on the + entire array, regardless of how many columns were being used. + Scaled variables before passing to outfld + -- Removed unused variables + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: BFB + +hobart/nag: BFB + +hobart/pgi or jaguar/pgi: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_60 +Originator(s): bdobbins, dennis, cacraig +Date: May 9, 2016 +One-line Summary: Remove all references to fortran elementals for performance improvement + +Purpose of changes: +- All elementals within the CAM code were removed and according to performance + testing by John Dennis' group, this speeds up CAM by 1.2% +- scalar and vector versions of these routines are provided with a single + interface via fortran overloading + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + - According to tests by John Dennis' group this simple change enables a + 1.2% speedup to CAM. + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/clubb_intr.F90 +M components/cam/src/physics/cam/eddy_diff_cam.F90 +M components/cam/src/physics/cam/hb_diff.F90 +M components/cam/src/physics/cam/pbl_utils.F90 +M components/cam/src/physics/cam/vertical_diffusion.F90 + - loops were pushed down into lower level subroutines and elemental + subroutines/functions were eliminated. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_59 +Originator(s): ASAP, sacks, eaton +Date: Wed May 4 07:18:50 MDT 2016 +One-line Summary: RRTMG performance mods and cleanup; unit test fixes + +Purpose of changes: + +. Incorporate performance mods (to improve vectorization) from John Dennis' + ASAP group. + +. Up to now RRTMG has been included in CAM as an SVN external. Since we + will no longer receive updates to this code from AER the external is not + providing any benefit. The code has been moved to the CAM trunk and the + three subdirectories merged into one. This eliminates the confusion of + files with the same name in more than one directory (which is dealt with + in the CAM build by the Filepath ordering). At the same time all the + unused code to compute aerosol and cloud optical properties was removed. + In CAM the optical properties are computed externally to RRTMG and are + passed to it. + +. Fixes to unit tests from Bill Sacks + +. Fix to allow changes to namelist definition, defaults, and use case files + to be recognized when put in $CASEROOT/SourceMods/src.cam/ when running + with CESM scripts (it previously only worked with CAM standalone + scripts). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. The longwave and shortwave calculations have each been sped up by about + 25% on yellowstone/intel. Still need to look at overall speedup. + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +SVN external for RRTMG was eliminated: +https://svn-ccsm-models.cgd.ucar.edu/rrtmg/trunk_tags/rrtmg_160210/src + +components/cam/test/system/README +. not useful + +components/cam/test/system/gen_test_table.sh +. replaced by perl script in gen-test-table + +List all subroutines added and what they do: + +These files originated from the ASAP branch +https://svn-ccsm-models.cgd.ucar.edu/rrtmg/branch_tags/asap_rrtmg_lw_optimization_tags/asap_rrtmg_n08_format_fix/ + +components/cam/src/physics/rrtmg/aer_src/mcica_subcol_gen_lw.f90 +components/cam/src/physics/rrtmg/aer_src/mcica_subcol_gen_sw.f90 +components/cam/src/physics/rrtmg/aer_src/parrrsw.f90 +components/cam/src/physics/rrtmg/aer_src/parrrtm.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_con.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg01.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg02.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg03.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg04.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg05.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg06.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg07.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg08.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg09.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg10.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg11.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg12.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg13.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg14.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg15.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_kg16.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_ref.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_tbl.f90 +components/cam/src/physics/rrtmg/aer_src/rrlw_wvn.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_con.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg16.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg17.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg18.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg19.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg20.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg21.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg22.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg23.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg24.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg25.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg26.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg27.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg28.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_kg29.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_ref.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_tbl.f90 +components/cam/src/physics/rrtmg/aer_src/rrsw_wvn.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_setcoef.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_setcoef.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 +components/cam/src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 +. Removed unused code for computing cloud and aerosol optics + +components/cam/test/system/gen-test-style.css +. style sheet used by perl scripts that generate regression test web pages + + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES +. The external for RRTMG was eliminated + +components/cam/bld/configure +. Adjust Filepath for new directory containing RRTMG source + +components/cam/cime_config/buildnml +. add arg to configure command to pass the cam source mods directory + location. This allows changes to namelist definition, defaults, and use + case files to be recognized when put in $CASEROOT/SourceMods/src.cam/ + when running with CESM scripts (it previously only worked with CAM + standalone scripts). + +components/cam/src/physics/rrtmg/radlw.F90 +. rad_rrtmg_lw + - remove inflglw, iceflglw, liqflglw args used to specify options for + computing cloud optics + +components/cam/src/physics/rrtmg/radsw.F90 +. rad_rrtmg_sw + - remove inflgsw, iceflgsw, liqflgsw args used to specify options for + computing cloud optics + +components/cam/test/unit/CMakeLists.txt +components/cam/test/unit/linear_1d_operators/CMakeLists.txt +components/cam/test/unit/micro_mg_utils/CMakeLists.txt +. unit test fixes from Bill Sacks + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_58 +Originator(s): goldy +Date: 2016-05-03 +One-line Summary: Change writing of FV history coords for PIO2 + +Purpose of changes: Make FV history coord writing PIO2 compatible + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, katec + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - File was not long enough -- added more lines +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Modified filemap for horizontal coordinates to avoid issues with PIO2 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +hobart/nag: All pass + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam5_4_57 +Originator(s): bogensch, raut@uwm.edu, cacraig +Date: April 15, 2016 +One-line Summary: Updated CLUBB/SILHS external libraries and introduced a number of CLUBB namelist parameters + +Purpose of changes: +- Eric Raut at University of Wisconsin/Madison (UWM) made modifications to + the CLUBB library to allow the current version at UWM to have BFB answers + with the CAM version of the CLUBB library. This allowed CAM to eliminate + the need to maintain a separate branch of the CLUBB library and to use + an unmodified copy from the UWM CLUBB trunk directly. +- A number of CLUBB tunable parameters were introduced into the CLUBB + namelist by Pete Bogenschutz +- Reintroduced the check in build-namelist to prohibit running with more than + one thread if clubb_history is enabled. This feature does not run + properly when more than when thread is used. +- Removed the ability to turn on clubb_do_deep as it was an unsupported + feature + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +- Removed the clubb_do_deep option from clubb_opts + +Describe any changes made to the namelist: +- Introduced the following namelist parameters for CLUBB tunings + clubb_c11: Low Skewness in C11 Skw. Function + clubb_c11b: High Skewness in C11 Skw. Function + clubb_mult_coef: Coef. applied to log(avg dz/thresh) + clubb_gamma_coef: Low Skw.: gamma coef. Skw. Fnct. + clubb_c_K10: Coefficient of Kh_zm + clubb_beta: Plume widths for theta_l and rt + clubb_C2rt: C2 coef. for the rtp2_dp1 term + clubb_C2thl: C2 coef. for the thlp2_dp1 term + clubb_C2rtthl: C2 coef. for the rtpthlp_dp1 term + clubb_C8: Coef. #1 in C8 Skewness Equation + clubb_C7: Low Skewness in C7 Skw. Function + clubb_C7b: High Skewness in C7 Skw. Function + clubb_Skw_denom_coef: Factor to decrease sensitivity in the denominator of Skw calculation + clubb_lambda0_stability_coef: Intensity of stability correction applied to C1 and C6 + clubb_l_lscale_plume_centered: Uses PDF to compute perturbed values for l_avg_Lscale code + clubb_l_use_ice_latent: Include the effects of ice latent heating in turbulence terms + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - updated the CLUBB and SILHS externals to use an unmodified + copy of a recent version from UWM + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/src/physics/cam/clubb_intr.F90 + - added a number of CLUBB tuning parameters + - removed the obsolete clubb_do_deep + +M components/cam/bld/configure + - removed clubb_do_deep + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +** An additional test was run by Cecile with her current CESM setup and she indicated +that the answers were identical using this version. + +=============================================================== +=============================================================== + +Tag name: cam5_4_56 +Originator(s): raghuraj@ucar.edu, chris.kerr.llc@gmail.com, cacraig +Date: April 6, 2016 +One-line Summary: Optimized binterp in modal_aer_opt.F90 + +Purpose of changes: + - Optimization changes for binterp inside modal_aer_opt.F90 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + - According to Chris Kerr, binterp running using the yellowstone intel 16 compiler has a 30% speedup with this version. + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/modal_aer_opt.F90 + - optimizations to binterp + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB (bl357 was tested by hand as a baseline did not exist for it in cam5_4_54 -- it was BFB) + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_54 (cam5_4_55 did not have regression tests run for it) + +=============================================================== +=============================================================== + +Tag name: cam5_4_55 +Originator(s): fvitt +Date: 5 Apr 2016 +One-line Summary: Fix pre-industrial CAM5.5 build-namelist use case + +Purpose of changes: + + . Adjust the 1850_cam55 use case for proper inclusion of H20 forcings + due to oxidation of CH4 + . Add regression test for 1850_cam55 use case + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A + components/cam/test/system/config_files/f1.9c5.5h + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/use_cases/1850_cam55.xml + - made adjustments for inclusion of H20 forcings due to oxidation of CH4 + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_yellowstone + - added test for the 1850_cam55 use case + +The standard regression tests were not run since there are no code changes +and the only change is to the 1850_cam55.xml use case file -- only tested +the 1850_cam55 use case -- sm, er, br tests passed. + +=============================================================== +=============================================================== + +Tag name: cam5_4_54 +Originator(s): chris.kerr.llc@gmail.com, cacraig +Date: March 31, 2016 +One-line Summary: optimized MG2 + +Purpose of changes: + - Improve performance of microphysics routines. A 7-8% improvement + in microphysics is seen with this optimization. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/micro_mg1_0.F90 +M components/cam/src/physics/cam/micro_mg1_5.F90 +M components/cam/src/physics/cam/micro_mg2_0.F90 + - all arrays are automatic arrays based on the size that micro_mg_get_cols returns + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - all allocations are removed and arrays are now automatic arrays + - micro_mg_cam_tend simply calls micro_mg_get_cols and micro_mg_cam_tend_pack + - micro_mg_cam_tend_pack is basically the old micro_mg_cam_tend without + the calls to micro_mg_get_cols. + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - moved constant code outside of the loops over columns + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: BFB + +hobart/nag: BFB + +hobart/pgi or jaguar/pgi: BFB +=============================================================== +=============================================================== + +Tag name: cam5_4_53 +Originator(s): fvitt, mmills +Date: 26 Mar 2016 +One-line Summary: CAM5.5 stratospheric aerosols and methane oxidation + +Purpose of changes: + + . Changes to default namelist settings to turn on prescribed stratospheric + aerosols and prescribed forcing of H2O due to oxidation of methane in CAM5.5 + + . Update prescribed stratospheric aerosol input dataset is included for CAM5.5 + + . Turn on prognostic stratospheric aerosols in configurations + that have the appropriated chemistry + + . Update volcanic sulfur emissions input dataset for transient runs with prognostic + stratospheric aerosols + + . Misc clean up of default namelist settings for CAM5/CAM5.5 + + . Add CAM5.5 compsets: + FW2000 - WACCM with CAM5.5 physics and TSMLT chemistry + FWAMIP - WACCM5.5 transient with volcanic SO2 emissions + FSV2000 - CAMChem with CAM5.5 stratospheric chemistry and VBS SOAs + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: +D components/cam/test/system/config_files/f10c5wtmam3dm +D components/cam/test/system/config_files/fsd1.9c5wtmam3h + - these are replaced by waccm_tsmlt_mam4 versions + +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_solve.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_setrxt.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_adjrxt.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_rxt_rates_conv.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_imp_sol.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mods.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_prod_loss.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lin_matrix.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_rxt_id.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_phtadj.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_nln_matrix.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_factor.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_sim_dat.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_indprd.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_spc_id.F90 +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.doc +D components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.in + - removed waccm_tsmlt_mam3 chemistry package + +List all subroutines added and what they do: +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_amip_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam55.xml +A components/cam/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam55.xml + - use cases added for WACCM5.5 compsets + +A components/cam/test/system/config_files/f1.9c5.5wtmam4h +A components/cam/test/system/config_files/f10c5wtmam4dm + - config file for waccm_tsmlt_mam3 regression tests + +List all existing files that have been modified, and describe the changes: +M components/cam/src/chemistry/mozart/mo_sulf.F90 + - correction to checks for the need for prescribed tropospheric sulfates + +M components/cam/bld/configure +M components/cam/bld/config_files/definition.xml + - removed waccm_tsmlt_mam3 chem option + +M components/cam/bld/perl5lib/Build/ChemNamelist.pm + - added utility to check for presence of named species in the chemistry mechanism + +M components/cam/bld/build-namelist + - turn on stratopheric aerosol forcings for cam5.5/cam6 + -- activate prognostic stratopheric aerosols in appropriate + configurations, otherwise use prescribed stratospheric aerosols + - turn on methane oxidation in cam5.5/cam6 + - corrections to default emissions for tsmlt and mam4 chemistries + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - updates to namelist defaults for WACCM and CAMChem with cam5.5/cam6 + -- SAD updated for CAM5.5 and CAM6 + +M components/cam/bld/namelist_files/namelist_definition.xml + - "strat_aero_feedback" renamed "prescribed_strataero_feedback" + +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M components/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M components/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +M components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M components/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_strataero_rcp45.xml +M components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml + - "strat_aero_feedback" renamed "prescribed_strataero_feedback" + +M components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml + - update the volcanic so2 emissions + +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml +M components/cam/cime_config/config_component.xml + - new compsets added: + FW2000 -- WACCM + FWAMIP + FSV2000 -- CAMChem with VBS SOAs + +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/config_files/f1.9c5.4wtclbh +M components/cam/test/system/config_files/f4c5.4wtclbdm +M components/cam/test/system/config_files/f1.9c5.4wtclbdh +M components/cam/test/system/config_files/fsd1.9c5.4wtclbh +M components/cam/test/system/tests_pretag_yellowstone +M components/cam/test/system/input_tests_master + - changes to test waccm_tsmlt_mam4 with cam5.5 phys + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +td.165357.status:023 bl485 TBL.sh f1.9c5.5wtmam4h outfrq3s+waccm_tsmlt_2000_cam55 9s ...........................FAIL! rc= 7 at Fri Mar 25 12:28:59 MDT 2016 + - new test -- no baseline to compare against + +td.165357.status:037 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Fri Mar 25 13:08:55 MDT 2016 +td.165357.status:040 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Mar 25 13:27:28 MDT 2016 + - expected failures due to changes to default LBCs + +td.165357.status:043 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Mar 25 13:49:22 MDT 2016 + - expected failure due to changed chem package "waccm_tsmlt_mam3" to "waccm_tsmlt_mam4" + +hobart/nag: +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Fri Mar 25 09:59:00 MDT 2016 + - expected failure due to changes in default LBC file and SAD year + +076 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Fri Mar 25 10:31:13 MDT 2016 + - actually bit-for-bit -- change in the LBC file changes the green house gas values recorded in history + +hobart/pgi: +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Fri Mar 25 10:08:52 MDT 2016 + - actually bit-for-bit -- change in the LBC file changes the green house gas values recorded in history + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_52 +Originator(s): bogensch, cacraig +Date: March 21, 2016 +One-line Summary: Added alternative autoconversion scheme + +Purpose of changes: + - New switch to use alternative autoconversion scheme in MG2 (following Seifert and + Behang 2001). Currently this is not turned on + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- added logical micro_do_sb_physics which turns on/off the Seifert and Behang autoconversion. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_definition.xml + - added namelist parameter to turn on/off using the Seifert and Behang + autoconversion and accretion physics. It currently defaults to false. + +M components/cam/src/physics/cam/micro_mg2_0.F90 +M components/cam/src/physics/cam/micro_mg_cam.F90 +M components/cam/src/physics/cam/micro_mg_utils.F90 + - changes to add the Seifert and Behang autoconversion + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_51 +Originator(s): fvitt, tilmes, mahowald@cornell.edu +Date: 24 Feb 2016 +One-line Summary: Adjustments to bulk dust model + +Purpose of changes: + To update the following for the bulk aerosol model: + . dust physics properties files (optics files) + . dust emissions scaling factors + . soil erosion input file + . dust scavenging coefficients + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist + - changes for setting aer_scav_coef (scavenging coefficients) for bulk aerosols + via ChemNamelist->set_dep_lists + - set default dust_emis_fact when soil_erod_file is in the namelist rather than + using chemistry package name + +M components/cam/src/chemistry/bulk_aero/aero_model.F90 + - bulk model scavenging factor is now set via namelist + +M components/cam/src/chemistry/bulk_aero/dust_model.F90 + - changes in dust emissions scaling factors + - removal of the threshold where soil_erod is set to zero + +M components/cam/src/chemistry/aerosol/wetdep.F90 + - minor white space change + +M components/cam/bld/perl5lib/Build/ChemNamelist.pm + - changes for setting scavenging coefficients of bulk aerosols + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - changes in default optics files (phys props) for bulk dust + - new default soil erosion file for bulk dust + - dust_emis_fact set to 0.37 for cam4 + +M components/cam/bld/namelist_files/namelist_definition.xml + - added namelist variables for scavenging coefficients of bulk aerosols + + +M components/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M components/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml + - removed dust_emis_fact -- let build-namelist/namelist_defaults_cam set this + - removed soil_erod file + +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_cam5_trop_strat_mam3.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml + - removed dust_emis_fact -- let build-namelist/namelist_defaults_cam set this + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Tue Feb 23 16:40:21 MST 2016 +008 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Tue Feb 23 16:40:25 MST 2016 +021 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Tue Feb 23 16:40:49 MST 2016 +025 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Tue Feb 23 16:41:01 MST 2016 +028 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Tue Feb 23 16:41:11 MST 2016 +031 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Feb 23 16:42:59 MST 2016 +034 bl397 TBL.sh f1.9c4cm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Feb 23 16:43:09 MST 2016 +040 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Tue Feb 23 16:44:59 MST 2016 +045 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Tue Feb 23 16:45:33 MST 2016 +055 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Feb 23 17:50:10 MST 2016 +058 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Tue Feb 23 17:50:13 MST 2016 +061 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Tue Feb 23 17:51:15 MST 2016 + +hobart/nag: +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Feb 23 10:14:39 MST 2016 +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Tue Feb 23 10:22:05 MST 2016 +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Tue Feb 23 11:47:34 MST 2016 + +hobart/pgi: +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Feb 23 10:39:48 MST 2016 + +These cam4 baseline test failures are expected. Configurations that use bulk dust (prognostic or prescribed) +change answers due to changes in: + * dust phys props files (optics files) + * dust emissions scaling factors + * soil erosion input file + * dust scavenging coefficients + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_49 + +Summarize any changes to answers, i.e., +- what code configurations: cam4 physics +- what platforms/compilers: all +- nature of change : larger than roundoff + +Validation of these changes to cam4 dust was via the CCMI simulations. + +=============================================================== +=============================================================== + +Tag name: cam5_4_50 +Originator(s): cacraig +Date: February 22, 2016 +One-line Summary: Update CAM testlists for CAM and CESM testing + +Purpose of changes: + - prune both CAM and CESM testlists + - added CESM testing of CLUBB using CAM5.5 and CLM45 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, goldy, fvitt, joemci + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/config_compsets.xml + - added FC55CLUBB to run CLUBB using cam5.5 and CLM45 + +M components/cam/cime_config/testdefs/testlist_cam.xml + - pruned and modified the CESM testlist for prealpha and prebeta CAM tests + +M components/cam/test/system/tests_pretag_yellowstone + - removed a number of unnecessary CAM regression tests + +Since there were no code changes, and no new CAM regression tests were introduced, the CAM +regression testing was not run for this tag. + +All variations of yellowstone and hobart compilers and prealpha/prebeta were run through the CESM script +create_test utilizing nobuild and autosubmit off to verify the tests were set up properly. + +=============================================================== +=============================================================== + +Tag name: cam5_4_49 +Originator(s): cacraig +Date: February 16, 2016 +One-line Summary: Revert iulog assignment back to what it was in cam5_4_42 + +Purpose of changes: + - A request had been made to have QNEG3 lines not be directed to unit 6 (which is used by the CESM log). An mpi_bcast + was introduced in cam5_4_43 to broadcast the CAM iulog to all tasks, but that had issues with the gnu compiler during + FLUSH. After extensive investigation, it was determined that master should really be the only task which routinely + writes to iulog. This tag reverst the change made in cam5_4_43 and a future tage will create statistics for QNEG3 + that masterproc can write out. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/cpl/atm_comp_mct.F90 + - revert iulog logic back to all tasks other than masterproc will write to unit 6 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_48 +Originator(s): eaton +Date: Thu Feb 11 07:35:52 MST 2016 +One-line Summary: implement vectorized RNG utils in RRTMG + +Purpose of changes: + +. Vectorized RNG utilities were implemented in the RRTMG code (from ASAP). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. ASAP reports about 1% speedup in overall throughput with cam5 physics + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES: +. rrtmg_150428 -> rrtmg_160210 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_47 +Originator(s): fvitt +Date: 9 Feb 2016 +One-line Summary: WACCM updates and chemistry preprocessor bug fix + +Purpose of changes: + + - include O(3P) cooling in the thermosphere + - provide capability to input solar EUV irradiance data + - use electron and ion temperatures in usrrxt if available + - fix for chemistry preprocessor "He molecular weight" bug + - misc code clean up + +Bugs fixed (include bugzilla ID): + +The chemistry preprocessor was computing the molecular weight of helium ('He') +as the molecular weight of hydrogen ('H') plus an electron ('e'). The solution +here is to designate the name of electron element as an uppercase 'E' rather +than lowercase 'e' in the preprocessor. The names of all other elements begin +with an uppercase character. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/src/chemistry/utils/solar_euv_data.F90 + - reads solar EUV irradiance data + +A components/cam/test/system/nl_files/outfrq3s_euv + - use solar EUV irradance data + +A components/cam/test/system/config_files/f10c4wmdm + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/chemistry/utils/solar_data.F90 + - deallocate arrays in init routine + - remove unused decared variable + +M components/cam/src/chemistry/mozart/mo_jeuv.F90 + - master proc reads ascii input and then broadcasts + - use solar EUV irradiance data if available otherwise use EUVAC + - code clean up + +M components/cam/src/chemistry/mozart/mo_photo.F90 + - include option to use solar EUV irradiance data + - code clean up + +M components/cam/src/chemistry/mozart/mo_chemini.F90 +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/mozart/euvac.F90 + - code clean up -- removal of dead code + +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - pass electron- and ion-temperature to usrrxt if available + +M components/cam/src/control/runtime_opts.F90 + - invoke solar_euv_data_readnl + - remove unused "endrun" reference + +M components/cam/src/physics/waccm/nlte_fomichev.F90 +M components/cam/src/physics/waccm/nlte_lw.F90 + - include O(3P) cooling + +M components/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_mozart/chem_mech.in +M components/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.in +M components/cam/src/chemistry/pp_waccm_mozart_mam4/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_mozart_mam4/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in +M components/cam/src/chemistry/pp_waccmx_mozart/chem_mech.doc +M components/cam/src/chemistry/pp_waccmx_mozart/chem_mech.in + - chemistry prepocessor fix to correct "He" molecular weight + -- electron is now 'E' in elements table in chem preprocessor + -- map 'e' to 'E' in chem_mech.in, i.e., 'e -> E' + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - new "solar_euv_data_file" namelist var + - remove euvacdat_file -- data read in was not used + +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M components/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml + - removed comments that no longer apply + +M components/cam/test/system/nl_files/outfrq3s_neu + - removed nsplit specification -- should be set by namelist_defaults + +M components/cam/test/system/nl_files/outfrq3s_ionos + - use solar EUV irradance data + - change start date 20031028 + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_waccm_hybrid +M components/cam/test/system/tests_waccm_mpi + - added waccm tests that use solar EUV irradance data + +M components/cam/SVN_EXTERNAL_DIRECTORIES + M components/cam + - new chem preprocessor that fixes "He" molecular weight problem + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Mon Feb 8 15:14:30 MST 2016 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Mon Feb 8 15:36:26 MST 2016 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Mon Feb 8 16:08:57 MST 2016 +035 bl359 TBL.sh f4c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ................................FAIL! rc= 7 at Mon Feb 8 16:54:35 MST 2016 +052 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Mon Feb 8 17:49:25 MST 2016 +061 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Mon Feb 8 18:12:08 MST 2016 +069 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Mon Feb 8 19:00:57 MST 2016 +072 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Mon Feb 8 19:47:37 MST 2016 +082 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Mon Feb 8 20:14:41 MST 2016 + +hobart/nag: +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Feb 8 11:59:16 MST 2016 +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Mon Feb 8 13:36:48 MST 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Mon Feb 8 13:52:21 MST 2016 + +jaguar/pgi: +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Feb 8 12:27:11 MST 2016 + +The inclusion of O(3P) cooling has caused all WACCM configurations to change answers. +In addition to (3P) cooling the use of ion and electron temperatures to set reaction +rates has cause WACCMX with ionosphere to change answers. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_46 +Originator(s): bogensch, eaton +Date: Mon Feb 8 07:33:58 MST 2016 +One-line Summary: move reading of dycore namelists; clubb mod. + +Purpose of changes: + +. Move reading of dycore namelists to subroutine read_namelist (from + dyn_init) + +. CLUBB mod to provide horizontal cell size estimates + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. create eul/sld specific versions of all the generic dyn_spectral_* + variables, i.e., + dyn_spectral_dif2 -> eul_dif2_coef and sld_dif2_coef + dyn_spectral_dif4 -> sld_dif4_coef + dyn_spectral_divdampn -> eul_divdampn and sld_divdampn + dyn_spectral_eps -> eul_tfilt_eps and sld_tfilt_eps + dyn_spectral_kmxhdc -> eul_kmxhdc and sld_kmxhdc + +. move all eulerian specific vars to namelist group dyn_eul_inparm + +. move all sld specific vars to namelist group dyn_sld_inparm + +. create fv specific variable names: + nsplit -> fv_nsplit + nspltrac -> fv_nspltrac + nspltvrm -> fv_nspltvrm + iord -> fv_iord + jord -> fv_jord + kord -> fv_kord + dyn_conservative -> fv_conserve + filtcw -> fv_filtcw + ct_overlap -> fv_ct_overlap + trac_decomp -> fv_trac_decomp + fft_flt -> fv_fft_flt + div24del2flag -> fv_div24del2flag + del2coef -> fv_del2coef + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton, goldy + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/build-namelist +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. update variable names for Eul, FV, and SLD dycores + +components/cam/bld/namelist_files/namelist_definition.xml +. update variable names for Eul, FV, and SLD dycores +. replace generic dyn_spectral_inparm group by dycore specific versions + dyn_eul_inparm and dyn_sld_inparm. + +components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +components/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml +components/cam/bld/namelist_files/use_cases/dabi_p2004.xml +components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +. update variable names for Eul and FV dycores + +components/cam/src/control/cam_comp.F90 +. remove namelist file from arg lists of cam_initial and cam_read_restart + +components/cam/src/control/cam_restart.F90 +. remove namelist file from arg lists of cam_read_restart and + read_restart_dynamics + +components/cam/src/control/runtime_opts.F90 +. add call to dyn_readnl + +components/cam/src/cpl/atm_comp_esmf.F90 +components/cam/src/cpl/atm_comp_mct.F90 +. fix comment + +components/cam/src/dynamics/eul/dyn_comp.F90 +. add subroutine dyn_readnl (copied from dyn_eul_readnl) + - update the mpibcast calls to use mpi_bcast + - change spectral namelist variables to eul specific ones, and change the + namelist group from dyn_spectral_inparm to dyn_eul_inparm +. move spmd_readnl call to dyn_readnl +. remove dyn_readnl call from dyn_init. + +components/cam/src/dynamics/eul/eul_control_mod.F90 +. move dyn_eul_readnl to dyn_comp (rename dyn_readnl). + +components/cam/src/dynamics/eul/inital.F90 +. remove namelist file from arg lists of cam_initial and dyn_init + +components/cam/src/dynamics/eul/restart_dynamics.F90 +. remove namelist file from arg lists of read_restart_dynamics and dyn_init + +components/cam/src/dynamics/fv/cd_core.F90 +. code cleanup -- mainly adding consistent indentation to loop structure + +components/cam/src/dynamics/fv/ctem.F90 +. update namelist reader and call it from dyn_readnl rather than ctem_init + +components/cam/src/dynamics/fv/dyn_comp.F90 +. code cleanup -- mainly adding consistent indentation to loop structure +. add dyn_readnl (copied from fv_control_mod) + - update the mpibcast calls to use mpi_bcast + - change namelist variables to have consistent fv_ prefix: +. move spmd_readnl call to dyn_readnl +. move ctem_readnl call to dyn_readnl + +components/cam/src/dynamics/fv/fv_control_mod.F90 +. move dyn_readnl to dyn_comp. + +components/cam/src/dynamics/fv/inital.F90 +. remove namelist file from arg lists of cam_initial and dyn_init + +components/cam/src/dynamics/fv/restart_dynamics.F90 +. remove namelist file from arg lists of read_restart_dynamics and dyn_init + +components/cam/src/dynamics/se/dyn_comp.F90 +. remove call to dyn_readnl from dyn_init1. +. move call to native_mapping_readnl from dyn_init1 to dyn_readnl +. remove nlfilename arg from dyn_init1 + +components/cam/src/dynamics/se/inital.F90 +. remove namelist file from arg lists of cam_initial and dyn_init1 + +components/cam/src/dynamics/se/native_mapping.F90 +. update namelist reader to use mpi_bcast + +components/cam/src/dynamics/se/restart_dynamics.F90 +. remove namelist file from arg lists of read_restart_dynamics and dyn_init1 + +components/cam/src/dynamics/sld/dyn_comp.F90 +. add dyn_readnl (copied from dyn_sld_readnl) + - update the mpibcast calls to use mpi_bcast + - change dyn_spectral_* namelist variables to sld specific ones, and + change the namelist group from dyn_spectral_inparm to dyn_sld_inparm +. move spmd_readnl call to dyn_readnl + +components/cam/src/dynamics/sld/inital.F90 +. remove namelist file from arg lists of cam_initial and dyn_init + +components/cam/src/dynamics/sld/restart_dynamics.F90 +. remove namelist file from arg lists of read_restart_dynamics and dyn_init + +components/cam/src/dynamics/sld/sld_control_mod.F90 +. move dyn_sld_readnl to dyn_comp and rename to dyn_readnl + +components/cam/src/physics/cam/clubb_intr.F90 +. mod to provide horizontal cell size estimates + +components/cam/test/system/nl_files/ttrac +. dyn_spectral_divdampn changed to eul_divdampn + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_45 +Originator(s): fvitt +Date: 4 Feb 2016 +One-line Summary: Miscellaneous improvements to diagnostics + +Purpose of changes: + + - provide capability to output standard deviations over the sampling period + - output zonal-mean FV TEM diagnostics to a zonal-mean grid in the history file + - improve performance of the sathist output + - include vertically integrated rate diagnostic in NEU wet deposition + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, goldy + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/test/system/config_files/f4c5wmclbdh + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/control/cam_history_support.F90 + - added sbuf data buffer which stores the accumulation of history fields squared \ + for use in standard deviation output + - added sbuf_varid array for use in output of sbuf data to history restart files + +M components/cam/src/control/cam_history.F90 + - Standard deviation is calculated using the method of computing variance outlined in + http://www.johndcook.com/blog/standard_deviation/ + - Changes were made to support the additional data buffer (sbuf) which holds the + accumulating field squared, including persistence in the history restart files + when needed. + - Replaced module variable "i" with "idx". The module variable i was causing confusion + in subroutines that used i. Some subroutines declared a local variable i while others + did not. In subroutine h_normalize i was used without declaring it as a local variable + which led to a threading race condition. + +M components/cam/src/control/cam_history_buffers.F90 + - new accumulation method added to accumulate the history field squared + and store it in sbuf + +M components/cam/bld/namelist_files/namelist_definition.xml + - document the standard deviation option avgflag_pertape ('S') + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - check for MOZ wet dep method rather than .not.do_neu_wetdep + - clean up + +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - added WD_* diagnostics (vertically integrated rates -- kg/s) + +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 + - add/output WD history fields only if MOZ wet dep method is used + - clean up + +M components/cam/src/chemistry/mozart/chemistry.F90 + - removed unused chem_name from chemdr argument list + +M components/cam/src/dynamics/fv/ctem.F90 + - clean up of output of zonal mean fields including removal of the + output of the zonal mean fields on the horizontal grid + +M components/cam/src/control/sat_hist.F90 + - performance improved by grouping the output of columns of simularly decomposed + variables that share an iodesc object rather than creating a new iodesc object for + each variable + +M components/cam/test/system/nl_files/sat_hist + - added standard deviation output test + - '3d' fields renamed to '2d' -- zonal means + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_yellowstone + - reduce resolution waccm5+clubb yellowstone regression test + to speedup the test time + +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +M components/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M components/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45_bgc.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85_bgc.xml +M components/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_strataero_rcp45.xml +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/2000_cam4_trop_moz_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M components/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/1850_cam4.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +M components/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M components/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml +M components/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +M components/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml + - *2d ctem history fields replaced by *zm fields + - removed unused WDR_* history fields + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +035 bl359 TBL.sh f4c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ................................FAIL! rc= 7 at Thu Feb 4 05:28:10 MST 2016 +042 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Thu Feb 4 05:57:04 MST 2016 +049 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Thu Feb 4 06:12:58 MST 2016 + +test bl359 is a new test +tests bl373 and bl374 are bit-for-bit -- correction to WD_* wet dep diagnostics cause these tests to fail + +hobart/nag: +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Wed Feb 3 17:49:58 MST 2016 + +This is bit-for-bit -- the additional history stream for standard deviations causes this baseline test fail + +hobart/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_44 +Originator(s): goldy, cacraig, chris.kerr.llc@gmail.com +Date: 2016-01-30 +One-line Summary: FV npr_yz fix plus MG2 optimization + +Purpose of changes: + - Fix bug when FV dycore is not using all processors + - Minor MG2 peformance fix contributed by Chri Kerr + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, cacraig + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +M components/cam/doc/ChangeLog + - Now with more changes than ever before! + +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Fixed bug with use of npr_yz namelist when FV dycore ended up using fewer + tasks than CAM overall + +M components/cam/src/physics/cam/micro_mg_utils.F90 + - Moved non-repeating code out of loop to improve performance. + Noted by Chris Kerr. + +M components/cam/src/utils/cam_grid_support.F90 + - Fixed possible problems when some PEs are not part of a distributed grid + +M components/cam/test/system/input_tests_master + - added npr_yz test to sm354 + +A components/cam/test/system/nl_files/outfrq3s_npryz + - added npr_yz test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass (but see note about br397 below) + +hobart/nag: All pass + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: Note: Softlink was provided to allow modified sm354 to pass BFB test + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== + +Tag name: cam5_4_43 +Originator(s): eaton, erik, julio, cacraig +Date: Jan 28, 2016 +One-line Summary: Keep CAM output out of cesm.log, revise the COSP regression test, new ncdata file for ne30np4_L32 + +Purpose of changes: + - QNEG messages which were not on task 0, were being passed into cesm.log. Erik pointed out + where iulog was not being broadcast to the other tasks. + - The COSP setup for CAM regression testing was setting a number of cosp-specific flags. When + debug was turned on, one of these flags caused a floating point exception down deep in cosp. We + have removed the flags and just test cosp with its default settings. This change results in a branch + test run have issues. Per Brian Eaton's suggestion, the branch test has been removed and a + bugzilla has been filed (#2278) + - Julio created a new file for ne30np4_L32 (supports homme cam5.5 runs) + +Bugs fixed (include bugzilla ID): + 2262: CAM regression testing now tests cosp with the default settings + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - added file for homme cam5.5 initial data conditions + +M components/cam/src/cpl/atm_comp_mct.F90 + - added mpi broadcast for iulog + +M components/cam/test/system/input_tests_master + - modified cosp test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except +056 bl397 TBL.sh f1.9c4cm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Wed Jan 27 18:17:09 MS +T 2016 + -- This was expected to be different due to changing the settings for cosp + +055 br397 TBR.sh f1.9c4cm outfrq3s+1850-2005_cam4 6+3s ........................................FAIL! rc= 12 at Wed Jan 27 18:17:09 M +ST 2016 + -- This branch test fails due to removing the settings for cosp. Bugzilla 2278 has been filed + and this test is removed until it is solved + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +Summarize any changes to answers, i.e., +- what code configurations: Testing is now using different settings for cosp - no changes were made to cosp itself +=============================================================== +=============================================================== + +Tag name: cam5_4_42 +Originator(s): goldy, eaton +Date: 2016-01-25 +One-line Summary: + +Purpose of changes: Provide native namelist support for CAM-SE + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + - Summary: Create formal definitions for all supported HOMME variables. + Changed names for consistency (all start with "se_") + Group name changed from ctl_nl to dyn_se_inparm + Removed items which only had one valid value in CAM + Added support for refined mesh simulations + + - hypervis_order ==> se_hypervis_order (rename) + - hypervis_subcycle ==> se_hypervis_subcycle (rename) + - hypervis_subcycle_q ==> se_hypervis_subcycle_q (rename) + - nu ==> se_nu (rename) + - nu_div ==> se_nu_div (rename) + - nu_p ==> se_nu_p (rename) + - nu_q ==> se_nu_q (rename) + - nu_top ==> se_nu_top (rename) + - qsplit ==> se_qsplit (rename) + - rsplit ==> se_rsplit (rename) + - statefreq ==> se_statefreq (rename) + - tstep_type ==> se_tstep_type (rename) + - vert_remap_q_alg ==> se_vert_remap_q_alg (rename) + + - integration: Removed + - se_partmethod: Removed + - se_phys_tscale: Removed + - se_topology: Removed + + - se_fine_se: Added to support refined mesh simulations + - se_hypervis_power: Added to support refined mesh simulations + - se_hypervis_scaling: Added to support refined mesh simulations + - se_max_hypervis_courant: Added to support refined mesh simulations + - se_mesh_file: Added to support refined mesh simulations + - se_npes: Added to support different number of SE tasks + - se_refined_mesh: Added to support refined mesh simulations + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: eaton + +List all subroutines eliminated: + - dynamics/se/share/namelist_mod.F90: readnl -- No longer called from CAM-SE + - dynamics/se/spmd_utils: spmd_readnl -- No longer needed + +List all subroutines added and what they do: + - dynamics/se/dyn_comp.F90: dyn_readnl -- New namelist reader for CAM-SE + - dynamics/se/share/namelist_mod.F90: homme_set_defaults -- Called from dyn_readnl + - dynamics/se/share/namelist_mod.F90: homme_postprocess_namelist -- Called from dyn_readnl + +List all existing files that have been modified, and describe the changes: + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - Switch HOMME external to new tag with namelist and other fixes. + +M components/cam/bld/build-namelist + - Rewrite of logic to build namelist for SE dycore to use full CAM namelist support. + +M components/cam/bld/configure + - Fixed comment about WACCM physics + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - Modified namelist item names (added se_ -- see above) and added new items + to allow CAM to be fully in charge of reading the dynamics namelist + +M components/cam/doc/ChangeLog + - New and improved! + +M components/cam/src/control/cam_history.F90 + - Fixed an incorrect WARNING message + +M components/cam/src/dynamics/se/dyn_comp.F90 + - Added dyn_readnl (currently called from dyn_init1) and set HOMME variables. + - Do not call HOMME's readnl + +D components/cam/src/dynamics/se/physical_constants.F90 + - This was a temporary module put in by Brian waiting for a new HOMME tag + (see statement in cam5_4_40 section below). + +M components/cam/src/dynamics/se/restart_dynamics.F90 + - Took out unsed but now invalid use of the HOMME readnl subroutine + +M components/cam/src/dynamics/se/spmd_dyn.F90 + - Took out no-longer-needed spmd_readnl routine which was mostly reading + Eulerian dycore variables. The number of pes passed to HOMME is now + properly handled by build_namelist + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +hobart/nag: All pass + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_41 +Originator(s): fvitt foster +Date: 25 Jan 2016 +One-line Summary: Updates to WACCM geomagnetic coordinates module + +Purpose of changes: + + - allow WACCM physics to run on unstructured SE grid + - remove dynamics grid dependencies in mo_apex + - refactor of the legacy apex geomagnetic coordinates code (Ben Foster) + - encapsulate apex routines in a Fortran module + - general cleanup + - add unit test for aurora module + - add CIME test for WACCM on SE grid + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D components/cam/src/chemistry/mozart/apex_subs.F90 + - Ben Foster -- encapsulate apex subroutines in a module + +D components/cam/test/system/nl_files/outfrq3s_wse + - should not need special namelist settings to test waccm with SE dycore + +List all subroutines added and what they do: + +A components/cam/src/chemistry/utils/apex.F90 + - Ben Foster -- refactor legacy apex code + - encapsulate apex subroutines in a module + NOTE: produces near-identical results as the legacy code -- not B4B + +A components/cam/test/system/config_files/h5c4wmdm + - regression test for waccm with SE dycore + +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse/user_nl_clm +A components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wse + - CIME test for WACCM with SE dycore + +A components/cam/src/unit_drivers/aur/unit_driver.F90 +A components/cam/src/unit_drivers/aur + - unit test for aurora module + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/control/cam_control_mod.F90 + - moved magnetic year to mo_apex + +M components/cam/src/physics/cam/physpkg.F90 + - initialize APEX if needed + +M components/cam/src/physics/waccm/iondrag.F90 +M components/cam/src/chemistry/mozart/mo_aurora.F90 +M components/cam/src/chemistry/mozart/mo_apex.F90 +M components/cam/src/chemistry/mozart/efield.F90 +M components/cam/src/chemistry/mozart/exbdrift.F90 +M components/cam/src/chemistry/mozart/spedata.F90 + + +M components/cam/test/system/input_tests_master + - regression tests updates + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - set defaults: + - nu* (hyperviscosity) for ne5np4 resolution + - ncdata for WACCM on ne5np4 and ne30np4 resolutions + - rsplit for ne5np4 resolution + - se_nsplit for WACCM on ne5np4 resolution + +M components/cam/cime_config/config_pes.xml + - use a large number of cores with WACCM on SE ne30 grid + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add CIME test for WACCM on SE grid + +M components/cam/bld/configure +M components/cam/bld/config_files/definition.xml + - unit test for aurora module + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Fri Jan 22 14:45:31 MST 2016 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Fri Jan 22 15:37:45 MST 2016 +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Fri Jan 22 16:59:01 MST 2016 +052 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Jan 22 17:53:02 MST 2016 +062 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Fri Jan 22 18:16:39 MST 2016 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Jan 22 19:05:48 MST 2016 +083 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Fri Jan 22 20:16:13 MST 2016 + +hobart/nag: + +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Fri Jan 22 14:54:14 MST 2016 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Fri Jan 22 15:08:57 MST 2016 + +hobart/pgi: All pass + +These waccm/waccmx baseline failures are expected. The new apex module produce +near-identical results as the legacy code although larger than roundoff. These +difference are not expect to be climate changing. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: waccm/waccmx +- what platforms/compilers: all +- nature of change : larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +The new apex module produces near-identical results as the legacy code although +larger than roundoff. These difference are not expect to be climate changing. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/apex_cam5_4_39_tags/apex01_cam5_4_39 +- platform/compilers: + yellowstone/intel +- configure commandline: + create_newcase -compset F55WCN -res f19_f19 -mach yellowstone -case /glade/u/home/fvitt/cesm/cases/F55WCN_cam5_4_39_f19_cntl.001 + create_newcase -compset F55WCN -res f19_f19 -mach yellowstone -case /glade/u/home/fvitt/cesm/cases/F55WCN_cam5_4_39_f19_test.001 + +- build-namelist command (or complete namelist): default for F55WCN compset with these changes + user_nl_cam: + ncdata = '/glade/p/work/fvitt/f.e11.FWTREFC1.f19_f19.ccmi31.001.cam.i.1989-01-01-00000.nc' + + fincl1 = 'QSUM','ALONM','ALATM','QRS_TOT','QRL_TOT','QNO','QRLNLTE', + 'QRS_AUR','EPOTEN' + fincl2 = ' ' + fincl3 = ' ' + fincl4 = ' ' + fincl5 = ' ' + fincl6 = ' ' + env_run.xml: + + +- MSS location of output: + /home/fvitt/csm/F55WCN_cam5_4_39_f19_test.001 + +MSS location of control simulations used to validate new climate: + /home/fvitt/csm/F55WCN_cam5_4_39_f19_cntl.001 + +=============================================================== +=============================================================== + +Tag name: cam5_4_40 +Originator(s): eaton +Date: Fri Jan 22 09:19:04 MST 2016 +One-line Summary: Add fixes and compset for simplified model test; update cime external. + +Purpose of changes: + +. The simplified model test case has been renamed to DABI (dry adiabatic + baroclinic instability). This is reflected in the name of the use case + file which implements the test: dabi_p2004.xml. A compset, FDABIP04, has + also been defined for running this test from the CESM scripts. + +. The parameter that controls the top level for the del*N horizontal + diffusion in the Eulerian dycore can now be set using a namelist + variable (eul_hdif_kmnhdn). + +. Fix constants in dabi_p2004 use case file to match Table 1 in Polvani et + al. (2004) + +. Update to cime4.4.0 and add option to build pio2 (-pio2 switch to + configure). pio1 remains the default for cam standalone builds. + +Bugs fixed (include bugzilla ID): + +. The type of eul_hdif_coef in the namelist_definition.xml file was + integer. Change it to type real. + +. Add initializer in fv/metdata.F90 to fix debug mode failures in some FV + specified dynamics configurations. + +Describe any changes made to build system: + +. Add option to build pio2 library via setting -pio2 switch to configure. Note + that this library does not currently work with the cam standalone build + which uses a serial netcdf library. When -pio2 is set then pio2 is built + as a separate library using pio's cmake. This location can be installed + in a user specified location by setting the new configure option + -pio2_install_dir. + +Describe any changes made to the namelist: + +. add eul_hdif_kmnhdn + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/bld/namelist_files/use_cases/adiabatic_LC1.xml +. renamed to dabi_p2004.xml + +List all subroutines added and what they do: + +components/cam/bld/namelist_files/use_cases/dabi_p2004.xml +. use case adiabatic_LC1 renamed to dabi_p2004 (dry adiabatic baroclinic + instability, Polvani et al. 2004) + +src/dynamics/se/physical_constants.F90 +. copy of se/share/physical_constants.F90 with parameter attribute removed + from Cp so that it can be set from a namelist variable. + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES: +. cime4.2.3 -> cime4.4.0 + +components/cam/bld/build-namelist +. add default for eul_hdif_kmnhdn + +components/cam/bld/config_files/definition.xml +. add pio_build_dir and pio_install_dir + +components/cam/bld/configure +. update the Filepath file for pio1 source code +. add -pio2 as switch to enable building pio2 as a separate library. The + default is to use pio1 and to build it as part of the cam executable. +. add -pio2_install_dir option to allow user to specify an install location + for the pio2 library. This location is checked by configure for the + presence of an existing library, and if a library already exists then it + is used. +. Update to the use of nc-config utility for constructing the makefile + options needed to link netcdf libraries. +. Add code to run the PIO2 cmake configuration for building PIO2 as a + separate library. + +components/cam/bld/Makefile.in +. Add macros PIO_BUILD_DIR and PIO_INSTALL_DIR. If these are set then PIO2 + will be built and installed as a separate library. +. Add rules to build and install PIO2 as separate library. + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default value for eul_hdif_kmnhdn + +components/cam/bld/namelist_files/namelist_definition.xml +. change eul_hdif_coef type from integer to real +. clarify definition of dyn_spectral_dif2 +. add definition for eul_hdif_kmnhdn +. add definition for cpair +. add pio_rearranger for pio2 + +components/cam/cime_config/buildnml +. strip level info from grid name and set up -nlev arg for configure + +components/cam/cime_config/config_component.xml +components/cam/cime_config/config_compsets.xml +. add definition for FDABIP04 + +components/cam/src/dynamics/eul/eul_control_mod.F90 +. change kmnhdn from hardcoded parameter value to namelist variable + (eul_hdif_kmnhdn) +. add eul_hdif_kmnhdn to log output + +components/cam/src/dynamics/fv/metdata.F90 +. add initializer for met_q so that it may safely be used in an array + expression. + +components/cam/src/physics/cam/co2_cycle.F90 +. c_cp now set in the co2_register method rather than with an initializer + in the declaration statement. The initializer is no longer valid since + cpair is no longer a parameter. + +components/cam/src/physics/carma/cam/carma_constants_mod.F90 +components/cam/src/physics/carma/cam/carma_intr.F90 +. move init of CP to carma_init + +components/cam/src/utils/physconst.F90 +. add protected attribute to public variables +. change cpair from parameter to variable, and set via namelist + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_39 +Originator(s): eaton +Date: Tue Jan 19 08:13:10 MST 2016 +One-line Summary: Refactor radiation interfaces. + +Purpose of changes: + +. Refactor radiation interfaces in preparation for adding the new RRTMGP + parameterization. + - move the old cam_rt radiation code into its own directory + (src/physics/cam_rt) parallel to the rrtmg directory + - make radiation modules responsible for the data they need to read and + write from restart files (needed to do this to allow moving radae into + a directory which is not built unless cam_rt is active) + - make cam_rt radiation module responsible for calling + initialize_radbuffer (this was tangled up with restart functionality) + - redesign the RRTMG output type to only contain the diagnostics for a + single climate or diagnostic calculation (i.e., remove the N_DIAG + dimension). Remove components not needed for output, or which were + duplicated in the pbuf or cam_out objects. + +Bugs fixed (include bugzilla ID): + +. resolve bug 2254 by adding scale factors to the fields FUSC, FDSC in the + camrt code, and removing the scale factors applied to FUS, FDS in the + rrtmg code. These fields are only output for scm_crm_mode which is not + tested. + +. create_newcase was failing on FADIAB compset + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: didn't check + +Code reviewed by: review session on 6 Jan 2016 + +List all subroutines eliminated: + +components/cam/src/physics/cam/cloud_rad_props.F90 +. remove stub module + +components/cam/src/physics/cam/hirsbt.f90 +components/cam/src/physics/cam/hirsbtpar.f90 +. remove unused diagnostic + +components/cam/src/physics/cam/rad_solar_var.F90 +. move file to physics/camrt/rad_solar_var.F90 + +components/cam/src/physics/cam/radae.F90 +. move file to physics/camrt/radae.F90 + +components/cam/src/physics/cam/radiation.F90 +. move file to physics/cam_rt/radiation.F90 + +components/cam/src/physics/cam/radiation_utils.F90 +. remove file - move definition of rad_diagdata_type to radiation module + +components/cam/src/physics/rrtmg/radiation_utils.F90 +. remove file - move definition of rad_diagdata_type to radiation module + +components/cam/src/physics/cam/radlw.F90 +. move file to physics/camrt/radlw.F90 + +components/cam/src/physics/cam/radsw.F90 +. move file to physics/camrt/radsw.F90 + +List all subroutines added and what they do: + +components/cam/src/physics/camrt/rad_solar_var.F90 +. moved here from physics/cam/rad_solar_var.F90 + +components/cam/src/physics/camrt/radae.F90 +. moved here from physics/cam/radae.F90 +. call initializae_radbuffer from radae_init. Need to check that the + allocatable arrays haven't already been allocated (if restart or branch + run). + +components/cam/src/physics/camrt/radconstants.F90 +. moved here from physics/cam/radconstants.F90 + +components/cam/src/physics/camrt/radiation.F90 +. moved here from physics/cam/radiation.F90 +. remove use of mpishorthand from namelist reader +. move definition of rad_diagdata_type into this module, shorten name to rad_out_t +. radiation_init + - add call to rad_solar_var_init +. radiation_tend + - remove unused args icefrac and snowh + - make rd optional + - code cleanup +. add radiation_define_restart + - move code here from init_restart_physics +. add radiation_write_restart + - move code here from write_restart_physics +. add radiation_read_restart + - move code here from read_restart_physics + +components/cam/src/physics/camrt/radlw.F90 +. moved here from physics/cam/radlw.F90 + +components/cam/src/physics/camrt/radsw.F90 +. moved here from physics/cam/radsw.F90 +. multiply fusc and fdsc by 1.e-3 in the outfld call. This is consistent + with the treatment of fsntc (done in radiation_tend). + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/configure +. add components/cam/src/physics/camrt to filepaths unless using rrtmg. + +components/cam/cime_config/config_compsets.xml +. remove the docn and clm entries since these variables are not defined if + using stub components as the ideal, adiabatic, and aquaplanet compsets do. + Move entries to confi_component.xml + +components/cam/cime_config/config_component.xml +. move entries for docn and clm here from config_compsets.xml +. Supplement the new entries with definition elements. Find this info in + the docn and clm config_compsets.xml files and add it to the new entries. + +components/cam/src/control/cam_restart.F90 +. remove use of get_abs_restart_filepath which was writing nonsense into + the rpointer file. +. remove reading/writing of aeres_int. This was only being used to control + the writing of nonsense (previous bullet) into the rpointer file + +components/cam/src/control/startup_initialconds.F90 +. initial_conds -- remove initialize_radbuffer + +components/cam/src/physics/cam/micro_mg_cam.F90 +. moved addfld/outfld calls for CLDFSNOW here from rrtmg/radiation.F90. + Also changed the default averaging from 'I' to 'A'. + +components/cam/src/physics/cam/physpkg.F90 +. remove unused ref to radiation_do +. phys_init + - remove call to cloud_rad_props_init + - remove call to rad_solar_var_init +. tphysbc + - remove local radiation output object since this was changed to be an + optional arg in the radiation_tend interface + - get rid of unused icefrac and snowhland args from radiation_tend call + +components/cam/src/physics/cam/radconstants.F90 +. This is now a dummy module which contains module variables that are + referenced by modal_aero_data, modal_aer_opt, aer_rad_props, phys_prop, + radiation_data, rad_constituents, carma_constants_mod, carma_intr. When + radiation is active the version of this file from the appropriate + radiation subdirectory will be compiled instead. + +components/cam/src/physics/cam/restart_physics.F90 +. move code for radiation to new routines in the radiation interface + modules. +. make calls to new routines: radiation_define_restart, + radiation_write_restart, radiation_read_restart +. remove broken/unneeded routine get_abs_restart_filepath. This was used + when the camrt abs-ems restart data was written to a separate restart + file. It appears the separate file was eliminated when PIO was + implemented to write restarts. + +components/cam/src/physics/rrtmg/radiation.F90 +. remove use of mpishorthand from namelist reader +. radiation_init + - add call to cloud_rad_props_init + - add call to rad_solar_var_init +. move definition of rad_diagdata_type into this module, shorten name to rad_out_t +. radiation_tend + - remove unused args icefrac and snowh + - make rd optional + - remove the unused hirsbt code + - code cleanup +. add radiation_define_restart, radiation_write_restart, + radiation_read_restart +. remove N_DIAG dimension from components of rad_out_t +. add diag(icall) suffix to FSNR and FLNR +. move addfld/outfld for CLDFSNOW to micro_mg_cam.F90 +. add routine radiation_output_cld to output the cloud optics fields +. refactor radiation_output_sw and radiation_output_lw to allow them to be + called inside the loop over climate and diagnostic calcs. +. remove ice_tau, liq_tau, cld_tau, snow_tau, c_cld_tau, cldfprime, + aer_tau, cld_lw_abs, snow_lw_abs from rad_out_t. + These are local vars not used for diagnostic output. +. remove qrs, fsns, fsnt, fsds, qrl, flnt, flns, su, sd, lu, ld, from + rad_out_t. These are in pbuf. +. remove sols, soll, solsd, solld from rad_out_t. These are in cam_out. +. remove swcf, lwcf from rad_out_t. Only need to compute in output routines. + +components/cam/src/physics/rrtmg/radsw.F90 +. remove scaling of fus and fds by 1.e-3 in the outfld calls. + +components/cam/src/unit_drivers/drv_input_data.F90 +. fix log output for driving data file + +components/cam/src/unit_drivers/rad/unit_driver.F90 +. update radiation interfaces + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_38 +Originator(s): jedwards, cecile, cacraig +Date: Jan 14, 2016 +One-line Summary: Changes to support pio2; turnoff icesupersat as default for CLUBB and CAM5.5 + +Purpose of changes: + - Jim Edwards made minor changes to CAM to support pio2 + - It was decided that at this point, CAM did not want to bring in a new climate with + the turning on of ice supersaturation by default. It can still be turned on by users + as it is a namelist parameter. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - ice_supersat is set to .false. for CLUBB runs (reverses the setting implemented in cam5_4_37) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - set ice_supersat to .false. for CLUBB runs + +M components/cam/src/control/sat_hist.F90 +M components/cam/src/dynamics/fv/metdata.F90 + - changes implemented by Jim Edwards to support pio2 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Wed Jan 13 21:12:59 MST 2016 +038 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Jan 13 21:26:07 MST 2016 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Wed Jan 13 23:13:20 MST 2016 + + +hobart/nag: all BFB except: +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Wed Jan 13 17:20:36 MST 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Jan 13 17:44:15 MST 2016 + + +hobart/pgi or jaguar/pgi: all BFB + +All CLUBB tests are expected to be different due to turning off ice_supersat when running CLUBB. This reverses the +"new climate" that was introduced in cam5_4_37. According to Pete Bogenschutz the net effect of cam5_4_37 and +cam5_4_38 taken together will be "answer changing" and NOT "climate changing" + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_37 +Originator(s): bogensch, cacraig +Date: January 13, 2016 +One-line Summary: Ice supersat on by default for CAM5.5 and CLUBB; mods to energy conservation fixer + +Purpose of changes: + Turn on ice supersaturation parameterization when CAM5.5 physics is called + to remove access RH bias in the upper troposphere and stratosphere. In addition, + modify the energy conservation fixer in the CAM CLUBB interface to remove small + tendencies CLUBB may produce in layers above which it is active to the layers + where it is active, to avoid dehydration in the stratosphere. This also + includes a minor bug fix to the pre-existing energy fixer. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - ice supersaturation is now turned on be default anytime CLUBB is turned on + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - turn on ice supersaturation by default when using clubb + +M components/cam/src/physics/cam/clubb_intr.F90 + - modifications to energy conservation fixing + +M components/cam/src/physics/cam/macrop_driver.F90 + - minor bug fix for ice supersaturation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Tue Jan 12 16:05:56 MST 2016 +038 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jan 12 16:19:41 MST 2016 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Tue Jan 12 18:20:40 MST 2016 + +hobart/nag: all BFB except: +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Tue Jan 12 12:00:43 MST 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jan 12 12:25:48 MST 2016 + +All test which use CLUBB are climate changing + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: CAM5.5 and anything that turns on CLUBB +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/cam55_FC5_f09f09_version6_052/atm/cam55_FC5_f09f09_version6_052-cam55_FC5_f09f09_cam5_4_22_001/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_36 +Originator(s): eaton +Date: January 12, 2016 +One-line Summary: update to cesm1_5_beta03 externals + +Purpose of changes: + +. Update to cesm1_5_beta03 externals. +. Add new RNG code in cime/share/shr_RandNum/ to the CAM standalone build. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. New optimized code for random number generation is included in the CAM + standalone build. The CAM code doesn't yet reference the new RNG code. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update externals as follows: + cime4.0.1 -> cime4.2.3 + mosart_cime3_n02_clm4_5_3_r134 -> clm4_5_6_r156 + cice5_20150924 -> lone_cam_tags/lone01_c5435 + cime_refactor3_n01_rtm1_0_53 -> rtm1_0_54 + cime_refactor_n01_aquap_150301 -> aquap_151016 + + The cice tag in beta03 (cice5_20151113) needs a check for an empty + CASEROOT variable in order to work with the cam standalone build. That + is the sole change in the branch tag lone01_c5435. + +components/cam/bld/Makefile.in +. add option '-std=gnu99' to CFLAGS for gnu, intel, and nag (which uses + gcc) compilers. This was needed for C code that's been added to the cime + external. + +components/cam/bld/configure +. add following to Filepath file for new RNG code: + cime/share/shr_RandNum/include + cime/share/shr_RandNum/src + cime/share/shr_RandNum/src/dsfmt_f03 + cime/share/shr_RandNum/src/kissvec + cime/share/shr_RandNum/src/mt19937 + +components/cam/test/system/TCB_ccsm.sh +. remove -silent option to xmlchange commands +. replace case_setup by case.setup + +components/cam/test/system/TER_ccsm.sh +components/cam/test/system/TSM_ccsm.sh +. remove -silent option to xmlchange commands + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Mon Jan 11 13:00:31 MST 2016 +042 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Mon Jan 11 15:25:15 MST 2016 +046 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Mon Jan 11 15:34:24 MST 2016 +064 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Mon Jan 11 16:22:20 MST 2016 +067 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Mon Jan 11 16:41:17 MST 2016 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Mon Jan 11 17:02:09 MST 2016 + +These failures are expected due to a change in the deposition parameters +for some terpene species. + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for chem configs that include +terpene species with updated deposition. + +=============================================================== + +=============================================================== + +Tag name: cam5_4_35 +Originator(s): hannay, cacraig +Date: Jan 8, 2016 +One-line Summary: tunings to TOA based on coupled runs + +Purpose of changes: + - Cecile tuned TOA in coupled runs + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - parameter gamma_coef = 0.287 in CLUBB library + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - dust_emis_fact = 0.60D0 and micro_mg_dcs = 140.D-6 for the CAM5.5 setup + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB except: +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Thu Jan 7 20:57:00 MST 2016 +038 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Jan 7 21:10:37 MST 2016 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Thu Jan 7 23:03:36 MST 2016 + All CAM 5.5 runs are climate changing + +hobart/nag: All BFB except: +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Thu Jan 7 14:02:06 MST 2016 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Jan 7 14:24:47 MST 2016 + All CAM 5.5 runs are climate changing + +hobart/pgi or jaguar/pgi: All BFB (No CAM5.5 tests in this suite) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: cam5.5 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +---------------- +DOCUMENTATION FROM CECILE ON COUPLED SIMULATION TO VALIDATE THIS RUN +---------------- + +Case directory: +/glade/p/cesmdata/cseg/runs/cesm1_5/b.e15.B1850G.f09_g16.pi_control.28 + +Local history file: +/glade/p/cesm0005/archive/b.e15.B1850G.f09_g16.pi_control.28 + +Later in HPPS: +/CCSM/csm/b.e15.B1850G.f09_g16.pi_control.28 + +Diags: +http://webext.cgd.ucar.edu/B1850/b.e15.B1850G.f09_g16.pi_control.28/ + +----------------------------------- + +# Sandbox (Mariana will create experimental tag at some point) + +cd /glade/p/work/hannay/cesm_tags +svn co https://svn-ccsm-models.cgd.ucar.edu/cesm1/tags/cesm1_5_beta03 cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14 + +cd /glade/p/work/hannay/cesm_tags/cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14/components/clm +svn switch https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/respmods_tags/respmods_n05_clm4_5_7_r162/components/clm + +cd /glade/p/work/hannay/cesm_tags/cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14/components/pop +svn switch https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20151215 + +cd /glade/p/work/hannay/cesm_tags/cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14/components/mosart +svn switch https://svn-ccsm-models.cgd.ucar.edu/mosart/trunk_tags/mosart1_0_14/ + +cp /glade/scratch/erik/clm_upcime/cime/cime_config/cesm/archive.xml /glade/p/work/hannay/cesm_tags/cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14/cime/cime_config/cesm + + +# compset: +cd /glade/p/work/hannay/cesm_tags/cesm1_5_beta03_clm_r162_pop_20151215_mosart1_0_14/cime/scripts +./create_newcase -case /glade/p/cesmdata/cseg/runs/cesm1_5/b.e15.B1850G.f09_g16.pi_control.28 -user_compset 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_MOSART_CISM1%NOEVOLVE_SWAV_BGC%BDRD -res f09_g16 -mach yellowstone -user_pes_setby allactive -project CESM0005 + +# clm mods +/glade/p/cesmdata/cseg/runs/cesm1_5/b.e15.B1850G.f09_g16.pi_control.28/SourceMods/src.clm/LunaMod.F90 + +# cam mods (are in this tag) +/glade/p/cesmdata/cseg/runs/cesm1_5/b.e15.B1850G.f09_g16.pi_control.28/SourceMods/src.cam/parameters_tunable.F90 + + +# hybrid run +./xmlchange RUN_TYPE=hybrid,RUN_REFCASE=b.e15.B1850G.f09_g16.pi_control.25,RUN_REFDATE=0041-01-01,GET_REFCASE=TRUE + +# grid mapping file +./xmlchange ROF2OCN_RMAPNAME=cpl/gridmaps/r05/map_r05_to_gx1v6_e1000r300_151109.nc + +# run the following before running +./xmlchange OCN_CHL_TYPE=diagnostic + +# user_nl_clm +suplnitro = 'NONE' +use_flexiblecn=.true. +use_luna=.true. +use_fun=.true. +fsurdat = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/surfdata_0.9x1.25_16pftsmodwshrub_simyr1850_c151210.nc' +paramfile = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/paramdata/clm5_params.c151217.nc' +leaf_mr_vcm = 0.015d00 +use_dynroot = .false. +lower_boundary_condition = 2 +use_bedrock = .true. +rooting_profile_method=1 +soil_layerstruct = '20SL_8.5m' +limit_irrigation = .false. +use_init_interp = .true. +init_interp_fill_missing_with_natveg = .true. +hist_dov2xy = .true.,.false. +hist_fincl2 = 'TLAI','EFLX_LH_TOT','Vcmx25Z','TSA' +hist_mfilt = 1,1 +hist_nhtfrq = 0,0 + + +# user_nl_cpl +flux_diurnal = .true. + +# user_nl_cice +ice_ic = 'b.e15.B1850G.f09_g16.pi_control.25.cice.r.0041-01-01-00000.nc' + + +# user_nl_cam +bnd_topo = '/glade/p/cesmdata/cseg/inputdata/atm/cam/topo/fv_0.9x1.25-gmted2010_modis-cam_fv_smooth-intermediate_ncube3000-no_anisoSGH_c151029.nc' +fincl1='dst_a1','dst_c1','dst_a3','dst_c3','dst_a1_SRF','dst_a3_SRF','dst_a1DDF','dst_a1SFWET', + 'dst_c1DDF','dst_c1SFWET','dst_a3DDF','dst_a3SFWET','dst_c3DDF','dst_c3SFWET', +dust_emis_fact = 0.60D0 +micro_mg_dcs = 140.D-6 + +# user_nl_pop + alk_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dfe_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dic_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + din_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dip_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + doc_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + don_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dop_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dsi_riv_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/river_nutrients_GNEWS2000_gx1v6_no_ms_c150702.nc' + dust_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/dst79gnx_gx1v6_090416_no_ms_c150702.nc' + fesedflux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/fesedflux_gx1v6_etopo2v2_Nov2015_vents_no_ms_c151218.nc' + iron_flux_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/solFe_scenario4_current_gx1v6_no_ms_c150702.nc' + nhy_flux_monthly_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/ndep_ocn_1850_gx1v6_no_ms_c150702.nc' + nox_flux_monthly_input%filename = '/glade/p/cesm/bgcwg/forcing/BEC_gx1v6_forcing_no_ms/ndep_ocn_1850_gx1v6_no_ms_c150702.nc' + +=============================================================== +=============================================================== + +Tag name: cam5_4_34 +Originator(s): goldy, eaton, fvitt +Date: 2015-12-30 +One-line Summary: Add zonal_mean option for FV history output + +Purpose of changes: + - Zonal mean output can save considerable space and post-processing time, + however, the workaround which has been used for FV does not work in + many WACCM runs (when there are more levels than longitudes). This + change allows for native zonal-mean output with standard metadata. + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: eaton + +List all subroutines eliminated: NA + +List all subroutines added and what they do: + - cam_grid_is_zonal (cam_grid_support): Return .true. iff input grid is zonal + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_definition.xml + +M components/cam/doc/ChangeLog + - Now 0.09% heavier! + +M components/cam/src/control/cam_history.F90 + - Make sure new cell_methods field property restarts + - addfld constructs a cell_methods string if the input grid is zonal + - Do not allow (endrun) zonal fields for local time processing ('L') + - Do not allow (endrun) zonal fields on satellite history file + +M components/cam/src/control/cam_history_support.F90 + - Add a cell_methods property to the field structure + +M components/cam/src/dynamics/fv/ctem.F90 + - Modify output of zonally-averaged fields to use new zonal grid and + native output methods + +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Add new zonal grid, fv_centers_zonal, for history zonal mean output + +M components/cam/src/utils/cam_grid_support.F90 + - Add bounds attribute to horizontal coordinate structure, entered via a new + argument to horiz_coord_create + - Add zonal_grid attribute to grid structure. + +M components/cam/test/system/nl_files/sat_hist + - Change processing of zonal fields from 'L' to 'I' + - Remove zonal field from sat_hist file (no longer valid) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +hobart/nag: NA (but only because the missing field (UW3d from + sathist_fincl) does not trigger a baseline failure). + +hobart/pgi or jaguar/pgi: NA + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: + - The failed test outputs zonally-averaged fields (e.g., 'VTH3d') which + are now output as proper 2-D fields (they were copied plon times into + 3-D fields). The actual values are unchanged. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: NA + +URL for AMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== + +Tag name: cam5_4_33 +Originator(s): fvitt, mmills, jrichter, aksmith, joemci +Date: 18 Dec 2015 +One-line Summary: WACCM updates and bug fixes + +Purpose of changes: + + - update gravity wave drag for WACCM to be consistent with latest CCMI + -- turn off inertial gravity waves + -- set inverse Prandtl number to 0.5 + -- multiply tau by a factor of 2.0 in southern hemisphere + -- turn off land fraction scaling + -- switch order of limiter and when efficiencies are applied + - add namelist tuning parameter which effective reduces GW phase speeds + to aid in model generated QBO -- gw_qbo_hdepth_scaling + - correction to EUV heating for WACCM + - addition of CO2 cooling to space for WACCM + - correction to troposphere/stratosphere heterogeneous chemistry rates + -- minimum tropopause pressure of 300 hPa poleward of 50 degrees latitude + -- corrected double counting at the tropopause level, by calculating tropospheric + rates only below the tropopause, and not at the tropopause level + - add chemistry packages: + waccm_mozart_mam4 + waccm_tsmlt_mam4 + - add build-namelist use case: + volc_waccm_ma_cam5 + - add compset F55W5SC + - CIME tests updates + +Bugs fixed (include bugzilla ID): + + - correction to EUV heating for WACCM + - addition of CO2 cooling to space for WACCM + - correction to trop/strat heterogeneous chemistry rates + -- minimum tropopause pressure of 300 hPa poleward of 50 degrees latitude + -- corrected double counting at the tropopause level, by calculating tropospheric + rates only below the tropopause, and not at the tropopause level + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig, joemci + +List all subroutines eliminated: + +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d_sc +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d_sc/user_nl_clm +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d_sc/user_nl_cam +D components/cam/cime_config/testdefs/testmods_dirs/cam/outfrq3d_sc/shell_commands + - not needed and were removed -- there should be no need to set RUN_STARTDATE for waccm-sc + +List all subroutines added and what they do: + +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_lu_solve.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_setrxt.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_adjrxt.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_rxt_rates_conv.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_imp_sol.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/chem_mods.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_prod_loss.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_lin_matrix.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/m_rxt_id.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_phtadj.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_nln_matrix.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_lu_factor.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_sim_dat.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/mo_indprd.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/m_spc_id.F90 +A components/cam/src/chemistry/pp_waccm_mozart_mam4/chem_mech.doc +A components/cam/src/chemistry/pp_waccm_mozart_mam4/chem_mech.in +A components/cam/src/chemistry/pp_waccm_mozart_mam4 + - new chem package + +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +A components/cam/src/chemistry/pp_waccm_tsmlt_mam4 + - new chem package + +A components/cam/bld/namelist_files/use_cases/volc_waccm_ma_cam5.xml + - new use case + +A components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday/shell_commands +A components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday/user_nl_cam +A components/cam/cime_config/testdefs/testmods_dirs/cam/sd_leapday + - added leap day test + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist + - set default for new gw_* namelist vars + +M components/cam/bld/configure +M components/cam/bld/config_files/definition.xml + - new chem options -- waccm_mozart_mam4, waccm_tsmlt_mam4 + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - defaults for new gw_* namelist vars + - set fv nsplit default to 12 for 0.9x1.25 resolution + +M components/cam/bld/namelist_files/namelist_definition.xml + - new gw namelist options: + gw_limit_tau_without_eff : + Apply limiters to tau before applying the efficiency factor, rather than afterward. + Default: .false. + gw_apply_tndmax : + Apply limiter on maximum wind tendency from stress divergence in gravity wave drag scheme. + Default: .true. + gw_oro_south_fac : + Factor to multiply tau by, for orographic waves in the southern hemisphere. + Default: 1._r8 + gw_prndl : + Inverse Prandtl number used in gravity wave diffusion + Default: 0.5 + gw_qbo_hdepth_scaling : + Scaling factor for heating depth in gravity waves from convection. If less than 1.0 + this acts as an effective reduction of the gravity wave phase speeds needed to drive + the QBO. + Default: 1.0 + +M components/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml + - include gw and cld frac tuning settings + - update emissions and other changes from Mike Mills + - remove use of IGW + +M components/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml +M components/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml + - remove use of IGW + +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml + - add IC file for 1-degrees res + - use updated volcanic SO2 emissions + - remove use of IGW + +M components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml + - remove use of IGW + - fix bug in external forcing specifier + +M components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml + - added flbc_list + - remove use of IGW + +M components/cam/cime_config/config_component.xml + - use waccm_sc_2000_cam5 build-namelist use case for FW5SC compset + - use waccm_sc_mam3 chem configure option for waccm-sc-cam5 compsets + - new compset F55W5SC + +M components/cam/cime_config/config_compsets.xml + - new compset F55W5SC + - use GREGORIAN calendar for SDC1_* compsets + - use updated SST files that have data through 2014 for CCMI and SD compsets + - use a transient CLM use case + +M components/cam/cime_config/testdefs/testlist_cam.xml + - aux_wcm tests added + - use cam/outfrq3d testmods rather than outfrq3d_sc for waccm-sc tests + - leap day test added + +M components/cam/src/physics/waccm/nlte_lw.F90 +M components/cam/src/physics/waccm/nlte_fomichev.F90 + - added co2-to-spacing cooling term and associated diagnostics + +M components/cam/src/physics/cam/gw_diffusion.F90 +M components/cam/src/physics/cam/gw_common.F90 +M components/cam/src/physics/cam/gw_front.F90 +M components/cam/src/physics/cam/gw_convect.F90 +M components/cam/src/physics/cam/gw_drag.F90 + - namelist options to enable waccm GWs to be consistent with CCMI + - add namelist tuning parameter which effective reduces GW phase speeds + to aid in model generated QBO -- gw_qbo_hdepth_scaling + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - correction in comments regarding stratospheric wet surface area in stratosphere + +M components/cam/src/chemistry/mozart/mo_jeuv.F90 + - correction to EUV heating - wavelenths corrected + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - correction to trop/strat heterogeneous chemistry rates + -- minimum tropopause pressure of 300 hPa poleward of 50 degrees latitude + -- corrected double counting at the tropopause level, by calculating tropospheric + rates only below the tropopause, and not at the tropopause level + +M components/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.in +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_solve.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_setrxt.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_adjrxt.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/m_rxt_id.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_phtadj.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.doc + - updates -- consistent with waccm_mozart + - short-lived species declared as not-transported + +M components/cam/test/system/tests_waccm_mpi + - changed "br" test to "er" + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Thu Dec 17 20:15:00 MST 2015 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Thu Dec 17 20:36:05 MST 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Thu Dec 17 20:58:05 MST 2015 +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Thu Dec 17 22:08:44 MST 2015 +052 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Thu Dec 17 23:01:38 MST 2015 +062 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Thu Dec 17 23:23:47 MST 2015 +064 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Dec 17 23:32:51 MST 2015 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Fri Dec 18 00:09:18 MST 2015 +073 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Fri Dec 18 00:43:43 MST 2015 +083 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Fri Dec 18 01:09:47 MST 2015 + +hobart/nag: +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Dec 17 14:38:11 MST 2015 +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Thu Dec 17 16:54:17 MST 2015 +070 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Thu Dec 17 17:05:19 MST 2015 + +hobart/pgi or jaguar/pgi: +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Dec 17 15:18:19 MST 2015 + +These baseline failures are expected due to: + - update gravity wave drag for WACCM + - correction to troposphere/stratosphere heterogeneous chemistry rates + +=============================================================== +=============================================================== + +Tag name: cam5_4_32 +Originator(s): jedwards, cacraig +Date: Dec 17, 2015 +One-line Summary: Bug fix in restart_physics when using pio2 + +Purpose of changes: + - Jim Edwards discovered a bug and provided a fix in restart_physics. + This bug only occurs when using pio2 (which is not yet the CAM default) + and using the SE dycore. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/restart_physics.F90 + - bug fix when using pio2 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_31 +Originator(s): pel, hannay, rneale, mmills, fvitt, cacraig +Date: Dec 15, 2015 +One-line Summary: Update topo files for 1 and 2 degree FV runs + +Purpose of changes: +- all FV 1 and 2 degree runs will have answer changes + -- this includes both CAM and WACCM runs +- new topo files are based on GMTED2010 and MODIS + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: okayed by rneale + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - added new topo files for FV 1 and 2 degree runs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +As expected, all 1 and 2 degree FV runs are answer changing due to the new topo files. + +yellowstone/intel: + +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Mon Dec 14 20:11:42 MST 2015 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Mon Dec 14 20:25:46 MST 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Dec 14 20:58:38 MST 2015 +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Mon Dec 14 21:55:48 MST 2015 +038 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Dec 14 22:09:08 MST 2015 +042 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Mon Dec 14 22:24:52 MST 2015 +044 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Mon Dec 14 22:27:27 MST 2015 +046 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Mon Dec 14 22:33:42 MST 2015 +049 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Mon Dec 14 22:40:34 MST 2015 +052 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Mon Dec 14 22:49:25 MST 2015 +056 bl397 TBL.sh f1.9c4cm outfrq3s_cosp+1850-2005_cam4 9s .....................................FAIL! rc= 7 at Mon Dec 14 22:53:13 MST 2015 +059 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Dec 14 23:03:42 MST 2015 +062 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Mon Dec 14 23:11:58 MST 2015 +064 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Mon Dec 14 23:21:06 MST 2015 +067 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Mon Dec 14 23:38:18 MST 2015 +073 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Tue Dec 15 00:21:02 MST 2015 +077 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Dec 15 00:27:54 MST 2015 +080 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Tue Dec 15 00:29:28 MST 2015 +083 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Tue Dec 15 00:47:02 MST 2015 + +hobart/nag: All PASS +049 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Dec 14 16:59:16 MST 2015 +055 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Mon Dec 14 17:34:58 MST 2015 +058 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Dec 14 17:56:04 MST 2015 + +hobart/pgi or jaguar/pgi: +057 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Mon Dec 14 18:11:08 MST 2015 + +=============================================================== +=============================================================== + +Tag name: cam5_4_30 +Originator(s): cacraig, andrew, katec, eaton +Date: Mon Dec 7 09:00:08 MST 2015 +One-line Summary: Refactoring init sequence; remove rgrid; bug fixes + +Purpose of changes: + +. Continue refactoring initialization sequence + - More cleanup in runtime_opts: move call of sat_hist_readnl to + history_readnl. + - Move call to trunc from cam_init to the dyn_init calls in + the EUL and SLD dycores + - Remove call to init_masterlinkedlist from cam_init. This call was not + needed. + +. Finish removing code for unsupported rgrid functionality. This is + responsible for the bulk of the changes in this tag. + +. Fix threading problem in clubb when micro_do_icesupersat=.true. + +. Fix in MG code for analytic radar reflectivity diagnostic calc + +. Update SILHS external. + +Bugs fixed (include bugzilla ID): + +bugzilla 2247: fix test in analytic radar reflectivity calc + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/control/pspect.F90 +. moved to eul and sld dycore directories + +components/cam/src/control/rgrid.F90 +. removed -- unsupported functionality + +components/cam/src/dynamics/eul/trunc.F90 +components/cam/src/dynamics/sld/trunc.F90 +. subroutine moved into + +components/cam/src/dynamics/fv/comspe.F90 +components/cam/src/dynamics/fv/comsta.h +. remove unused files + +components/cam/src/dynamics/fv/trunc.F90 +components/cam/src/dynamics/se/trunc.F90 +. refactoring initialization allows removing these stubs + +List all subroutines added and what they do: + +components/cam/src/dynamics/eul/pspect.F90 +components/cam/src/dynamics/sld/pspect.F90 +. copied from control directory. These are only used by the global + spectral dycores. + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES +. update silhs from silhs_07_n02 to silhs_07_n04 + +components/cam/src/advection/slt/bandij.F90 +. remove rgrid + +components/cam/src/control/cam_comp.F90 +. remove calls to init_masterlinkedlist() and trunc() +. remove unused arg in call to init_pio_subsystem + +components/cam/src/control/cam_history.F90 +. remove init_masterlinkedlist(). Not needed since nullifying the pointers + masterlinkedlist and tape is now done in the declaration statements. +. remove public attribute from namelist variables that are passed as args to the + sat_hist_readnl routine. Now sat_hist_readnl is called from history_readnl. + +components/cam/src/control/cam_restart.F90 +. remove unused ref to pmgrid. remove unused var tmp_rgrid + +components/cam/src/control/runtime_opts.F90 +. move call of sat_hist_readnl to history_readnl. + +components/cam/src/dynamics/eul/comspe.F90 +components/cam/src/dynamics/sld/comspe.F90 +. Remove public attribute for specific variables since whole module is + public data. + +components/cam/src/dynamics/eul/dp_coupling.F90 +components/cam/src/dynamics/eul/dyn.F90 +components/cam/src/dynamics/eul/dyn_grid.F90 +components/cam/src/dynamics/eul/dynpkg.F90 +components/cam/src/dynamics/eul/grcalc.F90 +components/cam/src/dynamics/eul/herxin.F90 +components/cam/src/dynamics/eul/inidat.F90 +components/cam/src/dynamics/eul/initcom.F90 +components/cam/src/dynamics/eul/linemsdyn.F90 +components/cam/src/dynamics/eul/quad.F90 +components/cam/src/dynamics/eul/scan2.F90 +components/cam/src/dynamics/eul/scandyn.F90 +components/cam/src/dynamics/eul/scanslt.F90 +components/cam/src/dynamics/eul/spegrd.F90 +components/cam/src/dynamics/eul/spetru.F90 +components/cam/src/dynamics/eul/spmd_dyn.F90 +components/cam/src/dynamics/eul/stepon.F90 +components/cam/src/dynamics/sld/dp_coupling.F90 +components/cam/src/dynamics/sld/dyn.F90 +components/cam/src/dynamics/sld/dyn_grid.F90 +components/cam/src/dynamics/sld/grcalc.F90 +components/cam/src/dynamics/sld/initcom.F90 +components/cam/src/dynamics/sld/quad.F90 +components/cam/src/dynamics/sld/scan2.F90 +components/cam/src/dynamics/sld/scandyn.F90 +components/cam/src/dynamics/sld/scanslt.F90 +components/cam/src/dynamics/sld/spegrd.F90 +components/cam/src/dynamics/sld/spetru.F90 +components/cam/src/dynamics/sld/spmd_dyn.F90 +components/cam/src/dynamics/sld/stepon.F90 +components/cam/src/physics/cam/phys_gmean.F90 +components/cam/src/utils/cam_dom/sst_data.F90 +. remove rgrid +. replace refs to nlon by plon +. replace refs to nmmax by pmmax +. replace refs to beglatpair by 1 +. remove any conditional code in (.not. fullgrid) branches + +components/cam/src/dynamics/eul/dyn_comp.F90 +. remove unused dyndecomp_set +. add call to trunc() +. subroutine trunc as private routine in this module + +components/cam/src/dynamics/eul/pmgrid.F90 +components/cam/src/dynamics/fv/pmgrid.F90 +components/cam/src/dynamics/se/pmgrid.F90 +components/cam/src/dynamics/sld/pmgrid.F90 +. remove unused dyndecomp_set + +components/cam/src/dynamics/fv/dp_coupling.F90 +components/cam/src/dynamics/fv/dyn_grid.F90 +components/cam/src/dynamics/fv/initcom.F90 +. remove unused rgrid + +components/cam/src/dynamics/fv/dyn_comp.F90 +components/cam/src/dynamics/se/dyn_comp.F90 +. remove unused dyndecomp_set + +components/cam/src/dynamics/sld/dyn_comp.F90 +. remove unused dyndecomp_set +. add call to trunc() +. subroutine trunc as private routine in this module +. bug fix for addfld calls missing gridname='gauss_grid' arg + +components/cam/src/dynamics/sld/inidat.F90 +. bug fix -- read PS from fh_ini, not fh_topi +. remove rgrid +. replace refs to nlon by plon + +components/cam/src/physics/cam/clubb_intr.F90 +. Fix threading problem with micro_do_icesupersat=.true. Put init of lq2 + in init method. + +components/cam/src/physics/cam/micro_mg1_0.F90 +components/cam/src/physics/cam/micro_mg2_0.F90 +. fix test in analytic radar reflectivity calc + +components/cam/src/physics/cam/radiation.F90 +components/cam/src/physics/rrtmg/radiation.F90 +. remove unused ref to pspect + +components/cam/src/utils/cam_pio_utils.F90 +. remove unused dummy arg in routine init_pio_subsystem + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_29 +Originator(s): fvitt, jedwards, cacraig, aliceb, goldy +Date: November 24, 2015 +One-line Summary: cam_pio_get_var bug fix, mira compiler bug fix, chem_preproc bug fix, fix typo in config_component.xml + +Purpose of changes: + - cam_pio_get_var bug fix (supplied by Jim, approved by Steve) + - mira compiler bug fix (changed and tested by Cheryl and Alice, approved by Francis) + - chem_preproc bug fix (supplied by Francis) + - correct typo in PTS_MODE group identifier (supplied by Jim) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: see above + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - chem_preproc bug fix : was unable to compile with DEBUG flag enabled - a new + chem_proc external fixes this + +M components/cam/cime_config/config_component.xml + - correct typo in PTS_MODE group identifier + +M components/cam/src/chemistry/modal_aero/modal_aero_data.F90 + - mira compiler bug fix: mira did not like '??????' - change it to 'UNDEF ' + +M components/cam/src/utils/cam_pio_utils.F90 + - time dimension needed to be changed from a hardwired 3 to ndims in two places + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_28 +Originator(s): goldy +Date: 2015-11-15 +One-line Summary: Fix IO bug and PIO2 incompatiblity + +Purpose of changes: Fix IO bug and PIO2 incompatiblity + +Bugs fixed (include bugzilla ID): NA + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, jedwards + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Updated according to ancient rules of the CAMbal +M components/cam/src/utils/cam_pio_utils.F90 + - Fixed but in cam_pio_get_var for initial files with multiple timeslices +M components/cam/src/physics/cam/physics_buffer.F90.in + - Output buffers with a singleton mdim as 2-D variable for PIO2 compatibility + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +hobart/nag: All pass + +hobart/pgi or jaguar/pgi: All pass (hobart) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_27 +Originator(s): fvitt, tilmes +Date: 30 Oct 2015 +One-line Summary: Enable MAM to have multiple SOA species per mode + +Purpose of changes: + + - refactor how data objects in modal aerosol model are set to provide + flexibility needed for multiple SOA species (or bins) per mode + - support VBS (Volatility Basis-Set) aerosol chemistry schemes + - add trop_strat_mam4_vbs chemistry package and compset FSTRATVBSL45 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 + - initialization routines moved to modal_aero_data module + +List all subroutines added and what they do: + +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +A components/cam/src/chemistry/pp_trop_strat_mam4_vbs + - new VBS chemistry package + +A components/cam/test/system/config_files/f10c5mam4vbsdm +A components/cam/test/system/config_files/f1.9c5mam4vbsdh + - tests added for trop_strat_mam4_vbs + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/chemistry/modal_aero/aero_model.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M components/cam/src/chemistry/modal_aero/seasalt_model.F90 +M components/cam/src/chemistry/modal_aero/dust_model.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M components/cam/src/chemistry/utils/modal_aero_calcsize.F90 + - refactored modal aerosol data structures to provide flexibility for + multiple SOA species per mode + +M components/cam/src/chemistry/utils/aerodep_flx.F90 +M components/cam/src/chemistry/utils/modal_aero_deposition.F90 + - generalized/refactored to sum over all soa species + NOTE: these changes result in round-off level changes in deposition fluxes + of carbon aerosol exported to surface models which may feedback on climate + +M components/cam/bld/namelist_files/namelist_definition.xml + - trop_strat_mam4_vbs added to list of acceptable cam_chempkg names + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - defaults added for trop_strat_mam4_vbs chemistry + +M components/cam/bld/namelist_files/master_aer_drydep_list.xml +M components/cam/bld/namelist_files/master_aer_wetdep_list.xml +M components/cam/bld/namelist_files/master_gas_drydep_list.xml +M components/cam/bld/namelist_files/master_gas_wetdep_list.xml + - gas-phase and aerosol species added to deposition lists + +M components/cam/bld/build-namelist +M components/cam/bld/perl5lib/Build/ChemNamelist.pm + - use utility routine to construct modal aerosol objects for mode_defs + based on species in chemistry mechanism file + +M components/cam/bld/configure + - new chem option added: trop_strat_mam4_vbs + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - added FSTRATVBSL45 compset and prealpha test + +M components/cam/src/chemistry/mozart/mo_photo.F90 + - removed alias of dust_nbins to appease PGI compiler + +M components/cam/src/chemistry/mozart/mo_drydep.F90 +M components/cam/src/chemistry/mozart/mo_sethet.F90 +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +M components/cam/src/chemistry/mozart/mo_usrrxt.F90 + - mods to handle new SOA and "TS1" species + +M components/cam/test/system/input_tests_master + - tests added for trop_strat_mam4_vbs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Thu Oct 29 16:30:34 MDT 2015 +042 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Thu Oct 29 18:52:23 MDT 2015 +046 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Thu Oct 29 19:01:07 MDT 2015 +064 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Oct 29 19:47:50 MDT 2015 +067 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Thu Oct 29 20:04:55 MDT 2015 +070 bl470 TBL.sh fsd1.9c5.4wtclbh outfrq3s_sd+sd_waccm5_geos5 9s ..............................FAIL! rc= 7 at Thu Oct 29 20:25:31 MDT 2015 + - expected failures due to change in deposition of terpene species in tropospheric chemistry + +hobart/nag: All pass + +hobart/pgi: + +057 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Oct 29 15:49:26 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Oct 29 16:02:09 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Oct 29 16:14:28 MDT 2015 + - these failures are caused by round-off level differences in aerosol-gas exchange routine due to refactoring + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_26 +Originator(s): hannay, cacraig, jshollen +Date: October 29, 2015 +One-line Summary: Add 1850_CAM55 use case + +Purpose of changes: +- Add a use_case for 1850_CAM55. For now, this is an exact copy of 1850_CAM5 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/bld/namelist_files/use_cases/1850_cam55.xml + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/config_component.xml + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: none run as this was only adding a new use_case for CESM runs + +hobart/nag: none run as this was only adding a new use_case for CESM runs + +hobart/pgi or jaguar/pgi: none run as this was only adding a new use_case for CESM runs + +- Ran a test using a replica of this in alpha02f with Jay and verified by hand that + the proper use case was selected +=============================================================== +=============================================================== + +Tag name: cam5_4_25 +Originator(s): Chris Kerr, John Dennis, cacraig +Date: 0ct 28, 2015 +One-line Summary: Optimized MG2 + +Purpose of changes: + - optimizations which according to John Dennis' testing yields 27% speedup in MG2 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/micro_mg2_0.F90 +M components/cam/src/physics/cam/micro_mg_utils.F90 + - optimizations + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_24 +Originator(s): eaton +Date: Thu Oct 22 14:58:07 MDT 2015 +One-line Summary: Cleanup namelist reading; build system update. + +Purpose of changes: + +. cleanup namelist reading code in runtime_opts.F90. Move all remaining + variables out of the generic cam_inparm group and make the appropriate + modules responsible for reading their own namelist data + +. add '-phys cam5.5' option. It's equivalent to '-phys cam5.4 -clubb_sgs' + +. fix CAM standalone build of timing code so that dependencies are + automatically generated. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. add '-phys cam5.5' option + +. fix CAM standalone build of timing code so that dependencies are + automatically generated. + +Describe any changes made to the namelist: + +. move namelist variables out of cam_inparm an into module specific + namelist groups + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cam developers + +List all subroutines eliminated: + +components/cam/src/physics/cam/scyc.F90 +components/cam/src/physics/cam/tsinti.F90 +. no longer used + +List all subroutines added and what they do: + +components/cam/src/physics/cam/dadadj_cam.F90 +. cam interface layer added for dry adiabatic adjustment parameterization + + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/Makefile.in +. modify build of timing code so that only files in the source directories + that should not be built are specified rather than specifying files that + should be built. The dependency generation can now be done by mkDepends + rather than be hardcoded in the Makefile. + +components/cam/bld/configure +. add '-phys cam5.5' option +. add gptl and timing source directories to Filepath file. + +components/cam/bld/mkSrcfiles +. add option to allow excluding a list of files from the Srcfiles file. + +components/cam/bld/namelist_files/namelist_definition.xml +. move variables out of cam_inparm group and into the groups read by the + local namelist readers. + +components/cam/src/control/cam_comp.F90 +. Extract dtime from the eclock object passed by the driver. Then can use + it to initialize the time manager and don't need to put the read_namelist + call in front of the time manager init. +. move call to read_namelist after call to timemgr_init + +components/cam/src/control/cam_control_mod.F90 +. remove unused variables: rair, stebol, snwedp, latice, tmelt, latvap +. move other constants to modules that should be responsible for them + +components/cam/src/control/cam_history.F90 +. history_readnl + - access dtime from time manager rather than passing it as an arg. Can + do this because time manager is initialized before reading namelists. + +components/cam/src/control/cam_initfiles.F90 +. add pertlim to this module +. replace mpishorthand by std mpi code + +components/cam/src/control/cam_restart.F90 +. replace the default_opts, setopts, and printopts methods by + cam_restart_readnl. + +components/cam/src/control/camsrfexch.F90 +. access rair from physconst rather than cam_control_mod + +components/cam/src/control/filenames.F90 +. module data for absems_data moved to cam4 radiation module + +components/cam/src/control/rgrid.F90 +. hardcode fullgrid=.true. -- will be removing this entirely in the near + future. + +components/cam/src/control/runtime_opts.F90 +. remove dtime from cam_inparm namelist -- now gotten from coupler +. remove dtime as actual arg in history_readnl call +. remove absems_data, iradae, iradlw, iradsw, irad_always, spectralflux, + use_rad_dt_cosz from cam_inparm +. replace the radiation_defaultopts, radiation_setopts, radiation_printopts + with radiation_readnl. +. remove absems_data, iradae, iradlw, iradsw, irad_always, spectralflux, + use_rad_dt_cosz +. remove indirect +. remove print_step_cost -- this functionality has moved to the driver +. remove pertlim from cam_inparms namelist group +. remove nlvdry and add call to dadadj_readnl +. remove cam_branch_file and replace calls to restart default_opts, + setopts, and printopts methods by single call to cam_restart_readnl +. remove direct access to readtrace via constituents module and instead + call the new cnst_readnl +. remove rayk0, raykrange, raytau0 from cam_inparms and add call to + rayleigh_friction_readnl +. move pbuf_global_allocate to the pbuf_nl namelist + *** the pbuf_{defaultopts,setopts} are not present, which means this option + hasn't been getting tested. + - add pbuf_readnl call. leave it commented out for now. Need to fix + the pbuf_global_allocate=.false. option +. replace scam defaultopts/setopts routines by scam_readnl +. move print_energy_errors to the check_energy namelist +. replace check_energy_{defaultopts,setopts} by check_energy_readnl + +components/cam/src/control/scamMod.F90 +. replace scam defaultopts/setopts routines by scam_readnl + +components/cam/src/dynamics/eul/inidat.F90 +components/cam/src/dynamics/fv/inidat.F90 +components/cam/src/dynamics/se/inidat.F90 +components/cam/src/dynamics/sld/inidat.F90 +. access pertlim from cam_initfiles rather than cam_control_mod + +components/cam/src/physics/cam/check_energy.F90 +. replace check_energy_{defaultopts,setopts} by check_energy_readnl + +components/cam/src/physics/cam/cldwat.F90 +. remove unused ref to nlvdry + +components/cam/src/physics/cam/constituents.F90 +. add cnst_readnl to read constituents_nl namelist group + +components/cam/src/physics/cam/dadadj.F90 +. put this subroutine into a module +. change subroutine dadadj to dadadj_calc -- move error handling for the + routine to interface layer +. new subroutine dadadj_initial + +components/cam/src/physics/cam/phys_grid.F90 +. replace phys_grid defaultopts and setopts by readnl + +components/cam/src/physics/cam/physics_buffer.F90.in +. replace pbuf_{defaultopts,setopts} by pbuf_readnl + +components/cam/src/physics/cam/physpkg.F90 +. remove call to tsinti from routine phys_init +. replace call to dadadj by new call to cam interface routine dadadj_tend + +components/cam/src/physics/cam/radae.F90 +. pass absems_data through radae_init args. remove access via module + filenames. + +components/cam/src/physics/cam/radiation.F90 +. remove routine radiation_get -- not used +. add absems_data namelist variable to module data and pass it to + radae_init. +. remove spectralflux option which is not valid in camrt +. replace the radiation_defaultopts, radiation_setopts, radiation_printopts + with radiation_readnl. + +components/cam/src/physics/cam/rayleigh_friction.F90 +. add namelist reader + +components/cam/src/physics/cam/rk_stratiform.F90 +. remove unused addfld calls for EFFLIQ, EFFLIQ_IND, EFFICE + +components/cam/src/physics/rrtmg/radiation.F90 +. remove routine radiation_get -- not used +. remove iradae option which is not valid in rrtmg +. replace the radiation_defaultopts, radiation_setopts, radiation_printopts + with radiation_readnl. + +components/cam/src/utils/time_manager.F90 +. remove timemgr_set_step_size. Move setting dtime to the timemgr_init + method. + +components/cam/src/utils/units.F90 +. remove unused association of endrun + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +hobart/nag: All PASS + +hobart/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_22 (no testing done for cam5_4_23) + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_23 +Originator(s): cacraig +Date: October 14, 2015 +One-line Summary: Add CAM55 definition for CESM compsets + +Purpose of changes: Add CAM55 definition for CESM compsets + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: Improves timing + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/cime_config/config_component.xml + - add the CAM55 configuration definition for CESM compset use + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: Changes not testable in CAM regression testing - not run + +hobart/nag: Changes not testable in CAM regression testing - not run + +hobart/pgi or jaguar/pgi: Changes not testable in CAM regression testing - not run + +Jim Edwards ran a CESM test using these changes and deemed them correct + +=============================================================== +=============================================================== + +Tag name: cam5_4_22 +Originator(s): goldy +Date: 2015-10-08 +One-line Summary: Fix performance issue with regional output + +Purpose of changes: Fix performance issue with regional output + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: Improves timing + +Code reviewed by: goldy + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Can't remember what I did to this file +M components/cam/src/utils/cam_pio_utils.F90 + . Added optional argument for unlimited dim ID in cam_pio_var_info +M components/cam/src/control/cam_history_support.F90 + . Do not include unliminted dimension in PIO decomp calls + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_21 +Originator(s): cacraig, fvitt +Date: October 7, 2015 +One-line Summary: Update to CESM alpha02a externals, fix failing WACCM ionosphere CESM test, remove goldbach from testing + +Purpose of changes: + - Bring the CAM externals up to the current CESM tag (1_5_alpha02a) + - CESM test ERP_Ln9.f19_f19.FWXI.yellowstone_intel.cam-outfrq9s is now working properly + - All references to goldbach are removed from CAM testing due to its decommissioning. This included + removing the special nag53 compilation flag + - CESM now requires the submit script to be run which issues a bsub command. CAM regression testing + now changes the value of RUN_WITH_SUBMIT to allow the run script to be used directly (and not issue + a bsub). This circumvents calling short-term archiving which CAM regression testing does not use. + +Bugs fixed (include bugzilla ID): CESM ERP_Ln9.f19_f19.FWXI.yellowstone_intel.cam-outfrq9s is now working + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all subroutines eliminated: +D components/cam/test/system/tests_posttag_goldbach +D components/cam/test/system/tests_pretag_goldbach_nag +D components/cam/test/system/tests_pretag_goldbach_pgi + - remove goldbach testing + +List all subroutines added and what they do: +A components/cam/test/system/nl_files/outfrq3s_ionos + - namelist for waccm ionosphere test + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update externals to CESM1_5_alpha02a + +M components/cam/bld/Makefile.in +M components/cam/bld/config_files/definition.xml +M components/cam/bld/configure + - remove special nag53 compilation flag (was needed for goldbach) + +M components/cam/src/physics/waccmx/ionosphere.F90 + - Fixed reproducibility issue -- changing number of MPI tasks produced different results + +M components/cam/test/system/CAM_runcmnd.sh + - removed goldbach testing now that this computer is decommissioned + +M components/cam/test/system/TCB_ccsm.sh +M components/cam/test/system/TER_ccsm.sh +M components/cam/test/system/TSM_ccsm.sh + - add xmlchange for flag RUN_WITH_SUBMIT, to allow CAM regression testing to use the run + script instead of submit (which issues an independent bsub command) + +M components/cam/test/system/input_tests_master + - add additional waccm tests including one for ionosphere + +M components/cam/test/system/test_driver.sh + - removed goldbach testing + +M components/cam/test/system/tests_pretag_hobart_nag + - changed waccm test to one which includes ionosphere + +M components/cam/test/system/tests_pretag_yellowstone + - add waccm test for ionosphere + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except for new test: +062 bl429 TBL.sh f1.9c4wmxh outfrq3s+waccmxi_2000_cam4 9s .....................................FAIL! rc= 7 at Tue Oct 6 23:14:56 MDT 2015 + +hobart/nag: all BFB except for new test: +067 bl426 TBL.sh f10c4wmxdm outfrq3s_ionos 9s .................................................FAIL! rc= 7 at Tue Oct 6 18:17:23 MDT 2015 + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_20 +Originator(s): sacks, cacraig +Date: October 6, 2015 +One-line Summary: Passing CAM's topographic height to the coupler + +Purpose of changes: +- Pass the topographic height from CAM to the coupler so that it is available + for other components to use + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - temporarily for this tag, use a cime branch off of cime3.0.7 which includes + just the cime changes needed to support the additional topographic field + to the coupler + +M components/cam/src/control/camsrfexch.F90 +M components/cam/src/cpl/atm_import_export.F90 +M components/cam/src/cpl/cam_cpl_indices.F90 + - add the topographic height to the atmosphere/coupler exchange structures + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_19 +Originator(s): fvitt +Date: 1 Oct 2015 +One-line Summary: Bug fixes for SD CLUBB and WACCM with CLUBB + +Purpose of changes: + + - fix restart bug which occurs when CLUBB is used in specified dynamics mode + - fix bug in CLUBB when used with WACCM which set the constituent mixing ratios + to zero above the active CLUBB region + - correct emissoins of number density tracers in WACCM5 build-namelist use case + volc_waccm_tsmlt_nomegan_cam5 + - add compsets (and corresponding cime tests): + FSDW5 -- WACCM5 with TSMLT chemistry, cam5.4 physics, and specified dynamics + FWTC5L45CCMIR1 -- free running WACCM5 with TSMLT chemistry and cam5.4 physics + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/cpl/atm_comp_esmf.F90 +M components/cam/src/cpl/atm_comp_mct.F90 +M components/cam/src/cpl/atm_import_export.F90 + - add optional argument to atm_import which is used during the initialization + phase of a restarted run so that cam_in fields wsx, wsy, shf, and cflx are not + overwritten by fields read in from the rs restart file. These fields are + set by the data from the *cam.r.* restart file. When nudging to specified + dynamics the nudged surface fields presist in the *cam.r.* restart so that + CLUBB inputs are bit-for-bit the same on the first step of a restarted run + as a continuous run. + +M components/cam/src/physics/cam/clubb_intr.F90 + - enforce zero mixing ratio tendencies above the top_lev level so the clubb + does not effect tracer above its active region when used in WACCM + +M components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml + - correction to num_a1 and num_a2 emissions + +M components/cam/cime_config/config_component.xml +M components/cam/cime_config/config_compsets.xml +M components/cam/cime_config/testdefs/testlist_cam.xml + - add compsets (and corresponding cime tests): + FSDW5 -- WACCM5 with TSMLT chemistry, cam5.4 physics, and specified dynamics + FWTC5L45CCMIR1 -- free running WACCM5 with TSMLT chemistry and cam5.4 physics + +M components/cam/src/physics/cam/restart_physics.F90 + - cam_in fields wsx, wsy, shf added to *cam.r.* restart file + +M components/cam/test/system/input_tests_master +M components/cam/test/system/nl_files/off1.9x2.5 +M components/cam/test/system/tests_pretag_hobart_nag +M components/cam/test/system/tests_pretag_yellowstone + - add SD CAM/WACCM with CLUBB tests + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Thu Oct 1 09:33:27 MDT 2015 + - new test -- no baseline to compare to + +hobart/nag: + +052 bl356 TBL.sh fsd1.9c5clbdm off1.9x2.5 9s ..................................................FAIL! rc= 7 at Thu Oct 1 09:59:15 MDT 2015 + - new test -- no baseline to compare to + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_18 +Originator(s): mvertens, jedwards, cacraig +Date: Sept 29, 2015 +One-line Summary: Bring in CESM cime refactor + +Purpose of changes: +- Bring in the CESM cime refactor modifications +- For CAM regression testing, have gmake sync its compilation output +- use the externals from cesm1_5_alpha01d + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D components/cam/bld/cam.buildlib +D components/cam/bld/cam.buildnml +D components/cam/bld/user_nl_cam +D components/cam/cimetest +D components/cam/cimetest/testlist_cam.xml +D components/cam/cimetest/testmods_dirs +D components/cam/cimetest/testmods_dirs/cam +D components/cam/cimetest/testmods_dirs/cam/cam4_port +D components/cam/cimetest/testmods_dirs/cam/cam4_port/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/cam5_port +D components/cam/cimetest/testmods_dirs/cam/cam5_port/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/cam5_port_f45 +D components/cam/cimetest/testmods_dirs/cam/cam5_port_f45/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/cam5_port_ne30 +D components/cam/cimetest/testmods_dirs/cam/cam5_port_ne30/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/chemproc +D components/cam/cimetest/testmods_dirs/cam/chemproc/shell_commands +D components/cam/cimetest/testmods_dirs/cam/chemproc/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/cosp +D components/cam/cimetest/testmods_dirs/cam/cosp/shell_commands +D components/cam/cimetest/testmods_dirs/cam/fire_emis +D components/cam/cimetest/testmods_dirs/cam/fire_emis/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/fire_emis/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis +D components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/outfrq1d +D components/cam/cimetest/testmods_dirs/cam/outfrq1d/shell_commands +D components/cam/cimetest/testmods_dirs/cam/outfrq1d/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/outfrq1d/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/outfrq3d +D components/cam/cimetest/testmods_dirs/cam/outfrq3d/shell_commands +D components/cam/cimetest/testmods_dirs/cam/outfrq3d/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/outfrq3d/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/outfrq3d_sc +D components/cam/cimetest/testmods_dirs/cam/outfrq3d_sc/shell_commands +D components/cam/cimetest/testmods_dirs/cam/outfrq3d_sc/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/outfrq3d_sc/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/outfrq9s +D components/cam/cimetest/testmods_dirs/cam/outfrq9s/shell_commands +D components/cam/cimetest/testmods_dirs/cam/outfrq9s/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/outfrq9s/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/outfrq9s_sat_hist +D components/cam/cimetest/testmods_dirs/cam/outfrq9s_sat_hist/shell_commands +D components/cam/cimetest/testmods_dirs/cam/outfrq9s_sat_hist/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/outfrq9s_sat_hist/user_nl_clm +D components/cam/cimetest/testmods_dirs/cam/reduced_hist3s +D components/cam/cimetest/testmods_dirs/cam/reduced_hist3s/user_nl_cam +D components/cam/cimetest/testmods_dirs/cam/tssoa_fire_emis +D components/cam/cimetest/testmods_dirs/cam/tssoa_fire_emis/user_nl_cam + - files moved to components/cam/cime_config + +List all subroutines added and what they do: +A + components/cam/cime_config + - directory replaces cimetest + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - use the externals from cesm1_5_alpha01d + +M components/cam/bld/build-namelist + - scriptsroot for CICE build-namelist is now cimeroot + +M components/cam/test/system/TCB_ccsm.sh + - cesm_setup is now case_setup + +M components/cam/test/system/TSM_ccsm.sh + - allow for checking of final atm.log file to occur in either /run or /logs + +M components/cam/test/system/test_driver.sh + - update intel compiler on yellowstone to 15.0.3 (to match CESM compiler setting) + - force gmake to synchronize output so that NAG compiler warnings/errors are not scrambled + +M components/cam/cime_config/testdefs/testlist_cam.xml + - add gl10 to F1850C5L4BGC f19_f19 grid_name (per Jim Edwards) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_17 +Originator(s): cchen, cacraig +Date: September 25, 2015 +One-line Summary: Bug fix for hetfrz_classnuc and update CLUBB external + +Purpose of changes: +- With the original value of pdf_n_theta set to 101 the dust activation + fraction between -15 and 0 C could be overestimated. This problem was + eliminated by increasing pdf_n_theta to 301. To reduce the expense of + computing the dust activation fraction the integral is only evaluated + where dim_theta is non-zero. This was determined to be between + dim_theta index values of 53 through 113. These loop bounds are + hardcoded in the variables i1 and i2. + +- PGI compiler had issue with variable in CLUBB external declared threadprivate before defined - fixed + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - updated CLUBB library external + +M components/cam/src/physics/cam/hetfrz_classnuc.F90 + - modifications to fix hetfrz bug + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +** All files which use hetfrz_classnuc are expected to have different results. +** Default for cam5.4 is for hetfrz_classnuc to be used + +yellowstone/intel: +032 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 24 22:55:42 MDT 2015 +067 bl474 TBL.sh f1.9c5.4wtclbh outfrq3s+1850_waccm_tsmlt_cam5 9s .............................FAIL! rc= 7 at Fri Sep 25 01:42:46 MDT 2015 + +hobart/nag: +049 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 24 18:34:20 MDT 2015 +052 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Thu Sep 24 18:50:52 MDT 2015 + +hobart/pgi or jaguar/pgi: +057 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 24 19:14:32 MDT 2015 + +URL for AMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/cms/cchen/cam5_4_12_test-cam5_4_12_control + There are no significant differences between the two simulations + +=============================================================== +=============================================================== + +Tag name: cam5_4_16 +Originator(s): goldy +Date: 2015-09-16 +One-line Summary: Bug fixes related to new I/O infrastructure + +Purpose of changes: +- Fix issue with history coordinate writes which causes PIO2 to crash +- Fix wrong-grid error in specified dynamics history + +Bugs fixed (include bugzilla ID): +- Bugzilla 2201, Output of history fields + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy, jedwards + +List all subroutines eliminated: NA + +List all subroutines added and what they do: NA + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Added text around this line (30 above / 45 below) +M components/cam/src/dynamics/eul/dyn_grid.F90 + . Fix write statements and comments +M components/cam/src/dynamics/eul/initcom.F90 + . Initialize lat and lon values for restart +M components/cam/src/dynamics/fv/metdata.F90 + . Fix bugzilla 2201 +M components/cam/src/physics/cam/phys_grid.F90 + . Make sure coordinate dofs are one-to-one for physgrid + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: None + +hobart/nag: None + +hobart/pgi or jaguar/pgi: None + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_15 +Originator(s): fvitt +Date: 16 Sep 2015 +One-line Summary: WACCM5.5 updates + +Purpose of changes: + + - chemistry mechanism changes for waccm_tsmlt_mam3 including 'not-transported' + species + - correction to surface area densities of stratospheric aerosols + - bug fix in background ionization for waccm/waccmx + - changes to namelist use_case files for waccm5.5 compsets + - change FSDS phys buffer field scope from 'physpkg' to 'global' to solve + restart problem in chemistry + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D components/cam/test/system/config_files/f1.9c5wtmam3dh +D components/cam/test/system/config_files/f1.9c5wtmam3h + +D components/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt_cam5.xml +D components/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_geos5.xml +D components/cam/bld/namelist_files/use_cases/1850-2005_waccm_tsmlt_cam5.xml +D components/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml + +List all subroutines added and what they do: + +A components/cam/test/system/config_files/f4c5.4wtmam3dm +A components/cam/test/system/config_files/f1.9c5.4wtmam3h +A components/cam/test/system/config_files/f1.9c5.4wtmam3dh +A components/cam/test/system/config_files/fsd1.9c5wtmam3h + - regression tests + +A components/cam/bld/namelist_files/use_cases/rcp6.0_waccm_tsmlt_nomegan_cam5.xml +A components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_nomegan_cam5.xml +A components/cam/bld/namelist_files/use_cases/volc_waccm_tsmlt_megan_cam5.xml + - new use cases for waccm5.5 + +List all existing files that have been modified, and describe the changes: + +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/rrtmg/radiation.F90 + - change FSDS phys buffer field from 'physpkg' to 'global' to solve + restart problem in chemistry + +M components/cam/src/chemistry/modal_aero/aero_model.F90 + - calculate wet surface area densities of stratospheric aerosols + +M components/cam/src/chemistry/mozart/photo_bkgrnd.F90 + - corrections to waccm/waccmx back ground ionization + +M components/cam/src/physics/waccm/qbo.F90 + - restrict log messages to master process + +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_rxt_rates_conv.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mods.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_prod_loss.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lin_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_nln_matrix.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_factor.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_indprd.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_spc_id.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.doc +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.in +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_solve.F90 + - updates to chemistry mechanism including declaring some species as + "not-transported" + +M components/cam/cimetest/testlist_cam.xml + - added cime tests for waccm5.5 + +M components/cam/test/system/tests_waccm_mpi +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_waccm_hybrid + - changes to regression testing for waccm5.5 + +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M components/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +M components/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml + - changes to use cases for waccm5.5 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Tue Sep 15 09:52:22 MDT 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Tue Sep 15 09:55:56 MDT 2015 +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Tue Sep 15 09:57:34 MDT 2015 +052 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Sep 15 09:59:18 MDT 2015 +067 bl474 TBL.sh f1.9c5.4wtclbh outfrq3s+1850_waccm_tsmlt_cam5 9s .............................FAIL! rc= 7 at Tue Sep 15 09:59:19 MDT 2015 +080 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Tue Sep 15 10:00:20 MDT 2015 + - expected baseline failures due to : + -- corrections to back ground ionization + -- correction to surface area densities of stratospheric aerosols (WACCM5) + -- chemistry mechanism changes for waccm_tsmlt_mam3 including not-transported species (WACCM5) + +hobart/nag: + +064 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Sep 15 16:04:30 MDT 2015 +067 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Sep 15 16:30:17 MDT 2015 + - expected baseline failures due to : + -- corrections to back ground ionization + -- correction to surface area densities of stratospheric aerosols (WACCM5) + -- chemistry mechanism changes for waccm_tsmlt_mam3 including not-transported species (WACCM5) + +hobart/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_14 +Originator(s): bogensch, cacraig +Date: Sept 14, 2015 +One-line Summary: CLUBB total energy adjustment modification + +Purpose of changes: + + - Change of the vertical extent of the CLUBB total energy adjustment to limit + the altitudes to where CLUBB is creating a significant tendency. CLUBB and CAM + have different total energy definitions, and CLUBB is adjusted to match CAM. + Previously energy adjustment was over the whole depth of the model, this + limits it mostly to the troposphere. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/physics/cam/clubb_intr.F90 + - changes to CLUBB total energy adjustment + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +035 bl365 TBL.sh f1.9c5wmclbdh outfrq3s_clubb+waccm_2000_cam5 9s ..............................FAIL! rc= 7 at Fri Sep 11 22:07:37 MD +T 2015 +038 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Sep 11 22:20:44 MD +T 2015 + +hobart/nag: all BFB except: +055 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Sep 11 18:41:44 MDT 2015 + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all CLUBB +- what platforms/compilers: all +- nature of change : larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/camclubb_version4_tags/camclubb_version4_n03_cam5_4_03 + +URL for AMWG diagnostics output used to validate new climate: + http://webext.cgd.ucar.edu/FCLIMO/clubb_energy/cam55_FC5_f09f09_014/atm/cam55_FC5_f09f09_014-cam55_FC5_f09f09_001/ + +=============================================================== +=============================================================== + +Tag name: cam5_4_13 +Originator(s): jedwards, santos, gettelman, cacraig +Date: Sept 11, 2015 +One-line Summary: incorporate CESM branch fixes and misc minor updates + +Purpose of changes: +- incorporate mods to support pio2 +- fixes problem with ESMF interface +- Temporary workaround fix for failing CESM test with SE dycore on mira +- update MG2 header +- add missing clubb/waccm test to yellowstone +- Added perf_mod dependencies to allow NAG6 to compile on hobart for CAM standalone + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cime tag required for the pio changes + + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - Modification to allow CESM mira test to pass + - Detailed diagnostics calculation and log output skipped in prim_printstate due to use + of uninitialized variables. Output will be corrected and restored in a later release. + +M components/cam/bld/Makefile.in + - NAG6.0 was having issues with perf_mod not being compiled before it was required + Added four routines which were compiling when NAG aborted which have dependencies on perf_mod + +M components/cam/src/cpl/atm_comp_esmf.F90 + - changes for compatibility with pio2 + - fix for ESMF interface + +M components/cam/src/dynamics/fv/restart_dynamics.F90 +M components/cam/src/physics/cam/restart_physics.F90 +M components/cam/src/utils/cam_grid_support.F90 +M components/cam/src/utils/cam_pio_utils.F90 + - changes for compatibility with pio2 + +M components/cam/src/physics/cam/micro_mg2_0.F90 + - updated header to better document MG2 + +M components/cam/test/system/tests_pretag_yellowstone + - added missing CLUBB/WACCM test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except for newly added bl365 as it had no comparison file + +hobart/nag: all BFB + +hobart/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam5_4_12 +Originator(s): santos +Date: 2015/09/02 +One-line Summary: Changes to adapt new CAM physics for WACCM5.5 + +Purpose of changes: + + - Allow WACCM to run with CLUBB, which requires the vertical diffusion solver + to run in order to perform molecular diffusion, as well as adding a lid to + CLUBB that matches the one on most of the CAM5 and CAM5.4 cloud physics. + (Currently, this lid is at 1 hPa.) + + - Some minor progress has been made toward getting WACCM, CAM5.4 physics, and + UNICON to run together. This should not be considered functional yet. + + - The turbulent mountain stress parameterization (TMS) now has its own CAM + interface module and namelist. + + - Upper boundary conditions are now set in a somewhat more consistent way. + + - The eddy_diff module is now "mostly" portable (very minor CAM dependencies). + This is accomplished in part through introducing a new CAM interface module, + eddy_diff_cam. + + - The "comsrf" module, which was originally the COMmon block for the SuRFace, + has finally been removed. Its variables are either removed entirely (dead + code), or added to pbuf. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Variables do_tms, tms_orocnst, and tms_z0fac have been moved to the new TMS + namelist. Variables specific to the UW eddy diffusion have been moved to the + eddy_diff namelist. + + - The eddy_diff variables are only added to the namelist if the diag_TKE (UW) + scheme is actually enabled. + + - WACCM5 use_cases no longer add "QPERT" to any fincl, since it is only + available when the diag_TKE moist turbulence scheme is running. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D components/cam/src/physics/cam/comsrf.F90 + - This was a common block that had been turned into a module without + much improvement in the design. According to its comments: + + "Currently this is a hodge-podge of 2D arrays without a lot of thought + or design. We are under the process of removing this completely and + moving the relevent arrays to the modules that actually use the data." + + Now this is done. + +List all subroutines added and what they do: + +A components/cam/src/physics/cam/eddy_diff_cam.F90 + - Move compute_eddy_diff, and much of the data and initialization logic + it requires, to this new module, which is now the CAM interface to the + eddy_diff module. + - diag_TKE-specific setup, including reading the namelist, is now pushed + down into this module. + +A components/cam/src/physics/cam/trb_mtn_stress_cam.F90 + - Add CAM interface for the TMS code, which has its own namelist read + and history outputs. + - Outputs used by the vertical diffusion are placed into pbuf rather + than being passed in and out as arguments to the "tend" routine. + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/src/physics/cam/phys_control.F90 +M components/cam/src/utils/physconst.F90 + - Moved TMS and eddy_diff variables to their respective namelists. + - Only add eddy_diff variables if the PBL scheme is UW (i.e. the + eddy_scheme is diag_TKE). + +M components/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M components/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam5.xml + - Remove "QPERT" from WACCM5 fincl settings. + +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/pp_none/chemistry.F90 +M components/cam/src/control/camsrfexch.F90 +M components/cam/src/control/startup_initialconds.F90 +M components/cam/src/dynamics/eul/iop.F90 +M components/cam/src/physics/cam/cam_diagnostics.F90 +M components/cam/src/physics/cam/cldwat.F90 +M components/cam/src/physics/cam/convect_shallow.F90 +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/cam/rk_stratiform.F90 +M components/cam/src/physics/cam/unicon_cam.F90 +M components/cam/src/physics/rrtmg/radiation.F90 +M components/cam/src/unit_drivers/rad/unit_driver.F90 + - For variables previously kept in comsrf, which were passed directly + into many routines from physpkg, instead have each scheme retrieve any + needed variables from pbuf. + - Unused comsrf variables (and use statements and copies of those + variables) are simply removed. + - Where possible, reduce the argument list of top-level routines so that + the arguments are just a few CAM objects (state, pbuf, cam_in, + cam_out) rather than including lists of r8 arrays. + +M components/cam/src/chemistry/mozart/upper_bc.F90 +M components/cam/src/physics/cam/molec_diff.F90 +M components/cam/src/physics/cam/ref_pres.F90 +M components/cam/src/physics/waccmx/majorsp_diffusion.F90 + - Remove the variable "ntop_molec", since setting it to a value other + than 1 would not actually work, and would not be useful in any current + configuration anyway. + - Consistently use ubc_get_vals to set the top-of-model boundary + conditions. + - The molec_diff module no longer handles boundary conditions, except + for the data used specifically to calculate molecular diffusion. The + ubc calls are moved to vertical_diffusion. + - molec_diff is becoming "more" portable, but still largely depends on + physconst arrays for operations performed in WACCM-X. + +M components/cam/src/control/history_defaults.F90 + - SGH/SGH30 from the topography file are no longer available as + outputs. SGH30 was not even output properly, and there is not much + point in adding these to history files, since they are simply exact + copies of data in the topography file, and do not change from timestep + to timestep. + +M components/cam/src/dynamics/se/dyn_comp.F90 + - Remove clearing of topography variables for aquaplanet runs, since it + is redundant with a block in physpkg that already does this for all + dycores. + +M components/cam/src/physics/cam/clubb_intr.F90 + - Remove clubb_surface and the TMS calculations from CLUBB, in favor of + allowing the existing CAM code in vertical_diffusion to handle these. + - Use the new CLUBB API module (which is intended to eventually serve as + a stable interface?) instead of clubb_core and other CLUBB internal + routines, where possible. + - Put a lid on CLUBB, so that it only is used up to trop_cloud_top_lev. + The arrays with the smaller dimension (nlev) are the same arrays that + are "upside down" to match CLUBB's assumption that levels are numbered + from the ground upward. + - SGH30 is now a pbuf field, not an argument passed from physpkg. + - Fix some minor issues, e.g. by correcting the tests for NaN in + stats_end_timestep_clubb. + +M components/cam/src/physics/cam/convect_deep.F90 + - Only add a heating output for gravity waves if ZM is the deep + convection scheme, since otherwise this output must come from the + currently active unified convection scheme (either UNICON, or CLUBB + with clubb_do_deep enabled). + +M components/cam/src/physics/cam/diffusion_solver.F90 + - Separate the setting of upper boundary conditions and molecular + diffusion data from compute_vdiff. + - Avoid recreating the pressure coordinate object for each call of + compute_vdiff, having it passed in instead. + +M components/cam/src/physics/cam/eddy_diff.F90 +M components/cam/src/physics/cam/hb_diff.F90 +M components/cam/src/physics/cam/pbl_utils.F90 + - Convert eddy_diff into mostly-portable code. The use of wv_saturation + creates a dependency on CAM, but this could easily be fixed by using + the portable water vapor saturation module. The only reason that this + was not done was because it would change answers. (The CAM-specific + routine generates a lookup table for mixed-phase calculations, and so + gives different answers.) + - Move compute_eddy_diff, associated module data, and the non-portable + parts of init_eddy_diff to the new CAM interface module. + - austausch_atm was duplicated between the eddy_diff and hb_diff + modules, so it has been moved to the pbl_utils module, which depends + only on shr_kind_mod. + - eddy_diff returns warning and error strings instead of directly + writing to iulog or calling endrun. + +M components/cam/src/physics/cam/gw_drag.F90 + - Minor changes related to the above; SGH is now in pbuf, it is not a + history output, and ntop_molec has been removed. + +M components/cam/src/physics/cam/micro_mg1_5.F90 +M components/cam/src/physics/cam/micro_mg2_0.F90 +M components/cam/src/physics/cam/micro_mg_cam.F90 +M components/cam/src/physics/cam/micro_mg_utils.F90 + - All MG versions now output am_evp_st, the precipitation evaporation + fractional area, which is used by UNICON. + - QME is now output at all levels. It is zero above the tropospheric + cloud physics lid, trop_cloud_top_lev. + +M components/cam/src/physics/cam/physpkg.F90 + - Fields from the topography file are now added to pbuf instead of + residing in comsrf. + - physpkg no longer passes the fields that resided in comsrf to + individual schemes. Instead it only passes pbuf, so that those fields + can be queried by each scheme as needed. + - The vertical_diffusion module is now called even when CLUBB is + enabled. Processes that have been replaced by CLUBB should be skipped + within the vertical_diffusion module, while those which have not been + replaced should run as usual. clubb_surface is therefore redundant and + has been removed. + +M components/cam/src/physics/cam/restart_physics.F90 + - Because various comsrf fields have been moved to pbuf with global + scope, they no longer need to be explicitly written or read during + restart. + +M components/cam/src/physics/cam/vertical_diffusion.F90 + - Changes to conform to many of the above. + - vertical_diffusion now calls molecular diffusion and upper + boundary condition calculations that were being called out of + compute_vdiff. + - A significant amount of PBL-specific code is now controlled by + the "do_pbl_diags" flag, which is false in CLUBB runs. + +M components/cam/test/system/config_files/f1.9c5wmclbdh +M components/cam/test/system/input_tests_master + - Add WACCM-CLUBB test. + - Add non-threaded, 10-degree CAM5 DEBUG test (useful as a very + fast NAG DEBUG test, but not present in any test list). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Sep 2 11:45:42 MDT 2015 + +hobart/nag: + +055 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Sep 1 18:11:38 MDT 2015 + +hobart/pgi or jaguar/pgi: + +All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + CLUBB + +- what platforms/compilers: + + All + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Larger than roundoff, same climate. Pete Bogenshutz says that results are + similar, but dust levels may be mildly improved. CLUBB tuning is ongoing. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_11 +Originator(s): goldy +Date: 2015-08-28 +One-line Summary: Fix bugs found in cesm1_4_alpha07c testing + +Purpose of changes: +. Fix bug found in CESM ERP_D_Ln9.f19_f19.FSDWSF.yellowstone_pgi.cam-outfrq9s +. Restore 'gw' attribute for all fv history files + +Bugs fixed (include bugzilla ID): +. bug found in CESM ERP_D_Ln9.f19_f19.FSDWSF.yellowstone_pgi.cam-outfrq9s + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all subroutines eliminated: NA + +List all subroutines added and what they do: +- cam_grid_attribute_copy: Copy an attribute from one grid to another +- physgrid_copy_attributes_d: Inform the physics grids of which grid attributes to copy + +List all existing files that have been modified, and describe the changes: +M components/cam/doc/ChangeLog + - Added a bunch of stuff on top of existing document +M components/cam/src/dynamics/eul/dyn_grid.F90 +M components/cam/src/dynamics/fv/dyn_grid.F90 +M components/cam/src/dynamics/se/dyn_grid.F90 +M components/cam/src/dynamics/sld/dyn_grid.F90 + - Defined physgrid_copy_attributes_d for phys_grid_init +M components/cam/src/physics/cam/phys_grid.F90 + - Call physgrid_copy_attributes_d and copy indicated attributes +M components/cam/src/utils/cam_grid_support.F90 + - Defined cam_grid_attribute_copy +M components/cam/src/utils/cam_pio_utils.F90 + - Fixed bug in cam_pio_get_var_2d_r8 and cam_pio_get_var_3d_r8 + which was tripped by reading a variable with a time dimension + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All Pass + +hobart/nag: All Pass + +hobart/pgi or jaguar/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_10 +Originator(s): fvitt +Date: 21 Aug 2015 +One-line Summary: Enable CAM-Chem to use CLM wild fire emissions + +Purpose of changes: + +. Enable CAM-Chem to use wild fire emissions produced by CLM4.5 +. Let fc_type configure option accept 'cray' as a valid value + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Passing of wild fire emissions from CLM to CAM is engaged by drv_flds_in + namelist options: + + . fire_emis_specifier (array of strings) -- Each array element specifies + how CAM-Chem constituents are mapped to basic smoke compounds in + the fire emissions factors table (fire_emis_factors_file). Each + chemistry constituent name (left of '=' sign) is mapped to one or more + smoke compound (separated by + sign if more than one), which can be + proceeded by a multiplication factor (separated by '*'). + Example: + fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' + + . fire_emis_factors_file (string) -- Input file that contains the table + of basic compounds that make up the smoke from the CLM fires. This is + used in CLM module FireEmisFactorsMod. + + . fire_emis_elevated (logical) -- If true then CAM-Chem treats the fire + emission sources as 3-D vertically distributed forcings for the + corresponding chemical tracers. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig, santos, goldy, jedwards + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A components/cam/cimetest/testmods_dirs/cam/tssoa_fire_emis/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/tssoa_fire_emis +A components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis/user_nl_clm +A components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/mam4_fire_emis +A components/cam/cimetest/testmods_dirs/cam/fire_emis/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/fire_emis/user_nl_clm +A components/cam/cimetest/testmods_dirs/cam/fire_emis + - added aux_fire system tests + +A components/cam/src/chemistry/mozart/fire_emissions.F90 + - manages mapping of CLM generated wild fire emissions to chemical constituents + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/config_files/definition.xml + - will accept 'cray' for fc_type + +M components/cam/cimetest/testlist_cam.xml + - added aux_fire system tests + +M components/cam/bld/namelist_files/namelist_definition.xml + - added namelist options for CLM produced wild fire emissions + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - added default emissions files that do not include forest fire and + grass fire emissions + +M components/cam/bld/build-namelist + - set default emissions to files that do not include forest fire and + grass fire emissions when using CLM produced wild fire emissions + +M components/cam/src/cpl/atm_import_export.F90 + - set cam_in%fire* arrays to fluxes from coupler + +M components/cam/src/cpl/cam_cpl_indices.F90 + - set indices for fire emissions + +M components/cam/src/control/camsrfexch.F90 + - allocates the cam_in%fire* arrays for fire emissions + +M components/cam/src/physics/cam/rad_constituents.F90 + - added utility function for getting the number density name + corresponding to a species name + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - pass cam_in%fire* pointers to fire_emissions_vrt for vertically distributed + fire emission forcings + +M components/cam/src/chemistry/mozart/chemistry.F90 + - invoke fire_emissions_init and fire_emissions_srf + - pass the cam_in%fire* pointers to chemdr for vertically distributed fire + emission forcings + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +hobart/nag: All pass + +hobart/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_4_07 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_09 +Originator(s): cacraig +Date: August 17, 2015 +One-line Summary: Removed CESM prealpha test for FMOZ on mira + +Purpose of changes: + - Currently the chemistry preprocessor fails to build on mira. This test + is being removed as it is a low priority platform for chemistry and the + primary chemistry software developer does not have access to this machine. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/cimetest/testlist_cam.xml + - removed FMOZ test from mira - this configuration is still tested + on several other platforms and passes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: not tested + +hobart/nag: not tested + +hobart/pgi or jaguar/pgi: not tested + +The prealpha test suite is run by CESM and is not part of the CAM standalone testing + +=============================================================== +=============================================================== + +Tag name: cam5_4_08 +Originator(s): eaton +Date: Thu Aug 13 13:54:58 MDT 2015 +One-line Summary: fc_type bug fix + +Purpose of changes: + +. recent change to have fc_type accept ibm rather than xlf was incomplete. + Add a quick fix. + +Bugs fixed (include bugzilla ID): see above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/config_files/definition.xml +. for fc_type change valid value xlf to ibm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: not done + +hobart/nag: not done + +hobart/pgi or jaguar/pgi: not done + +Did quick interactive check that configure does not choke when given the +arg "-fc_type ibm" + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. No code change that is tested by +our current test platforms. + +=============================================================== +=============================================================== + +Tag name: cam5_4_07 +Originator(s): bogensch, cacraig, goldy, fvitt +Date: August 13, 2015 +One-line Summary: Update CLUBB tunings, NAG6.0 compiler fixes, bug fixes for serial builds, update CIME tests + +Purpose of changes: +- CLUBB tunings for cam5.5 are incorporated onto the CAM trunk +- NAG6.0 uncovers non-compliant code which needed to be fixed +- cam5_4_06 had bugs when built serially for FV and SE dynamics. These bugs have been fixed +- Updates for CIME tests + - fix PORT test on SE grid + - fix FTSC4L40CCMIR1SD test + - add chemistry preprocessor tests + - add aux_chem and aux_port test types + - add pleiades tests +- CAM configure now traps if attempting to use NAG with threading turned on + +Bugs fixed (include bugzilla ID): bugzilla 2198: FV dycore will not compile in serial mode + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- Added two new namelist parameters: + zmconv_momcu - Convective momentum transport parameter (upward) + zmconv_momcd - Convective mementum transport parameter (downward) +- defaults for a number of CLUBB namelist variables have been tuned + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/cimetest/testmods_dirs/cam/reduced_hist3s/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/reduced_hist3s + - added for hobart 10x15 FWTC4L40CCMIR1 test + +A components/cam/cimetest/testmods_dirs/cam/cam5_port_ne30/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/cam5_port_ne30 + - added for testing PORT on SE grid + +A components/cam/cimetest/testmods_dirs/cam/cam5_port_f45 +A components/cam/cimetest/testmods_dirs/cam/cam5_port_f45/user_nl_cam + - added for testing port on hobart/nag + +A components/cam/cimetest/testmods_dirs/cam/chemproc/user_nl_cam +A components/cam/cimetest/testmods_dirs/cam/chemproc/shell_commands +A components/cam/cimetest/testmods_dirs/cam/chemproc + - added for chemistry preprocessor tests + +List all existing files that have been modified, and describe the changes: + M . + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - updated CLUBB external - contains NAG6.0 corrections and tuning changes + +M components/cam/bld/configure + - trap for NAG compilations trying to run threaded as NAG does not support threading + +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_definition.xml + - added tuning parameters: zmconv_momcu and zmconv_momcd + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - various tunings for CLUBB + +M components/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml + - corrected the date on the met_data file + +MM components/cam/cimetest/testlist_cam.xml + - added chemistry preprocessor tests + - added "aux_chem" and "aux_port" tests + - added prebeta tests for pleiades + - reduced resolution of nag PORT test on hobart + - reduced resolution and history output of the FWTC4L40CCMIR1 test on hobart + - corrections for the ne30 port test + - removed the mime-type property -- allows svn diff to function normally on + local working copy without "--force" option + +M components/cam/src/dynamics/fv/dyn_grid.F90 +M components/cam/src/dynamics/se/dyn_grid.F90 +M components/cam/src/dynamics/se/spmd_dyn.F90 + - fixes for serial builds on CAM + +M components/cam/src/physics/cam/clubb_intr.F90 + - fix for NAG6.0 compilation error + - added outfld calls for tautmsx and tautmsy + +M components/cam/src/physics/cam/zm_conv.F90 +M components/cam/src/physics/cam/zm_conv_intr.F90 + - momcu and momcd are now namelist parameters + - removed variable "small" which was set but never used in momtran + +M components/cam/test/system/input_tests_master +M components/cam/test/system/tests_pretag_hobart_nag + - added NAG test for CLUBB without threading + +M components/cam/test/system/test_driver.sh + - LAPACK_LIBDIR needs to be specified on hobart + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Aug 12 21:00:49 MDT 2015 + - CLUBB tunings change answers for CLUBB + +hobart/nag: + +055 bl369 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Aug 13 09:33:01 MDT 2015 + - CLUBB tunings change answers for CLUBB + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_06 +Originator(s): goldy +Date: August 5, 2015 +One-line Summary: New grid and history infrastructure + +Purpose of changes: +- Modularize CAM grid information +- Move dycore specific information from CAM history to individual dycores +- Prepare for separate physics grid by cleaning interface between physics and dynamics +- Modularize grid start-up to allow for reconfiguration of CAM start-up and restart procedures + +Bugs fixed (include bugzilla ID): 1863, 1553 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: +- Consolidated history items into new cam_history_nl namelist +- Changed names of interpolated-output namelist variables (interp ==> + interpolate) and made them settable on a per-file basis +- Moved interpolated-output namelist variables from SE share namelist to + cam_history_nl + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig, santos, jedwards + +List all subroutines eliminated: +- That information is classified. Trust me, they were bad subroutines +- Almost everything in cam_pio_utils.F90 (it's a bloodbath in there) +- get_block_ldof_d (don't need specialized dof functions anymore) +- get_gcol_lat (from SE dycore) +- get_gcol_lon (from SE dycore) + +List all subroutines added and what they do: + dyn_grid.F90 +- define_cam_grids: in each dycore to define CAM grids + cam_pio_utils.F90 +- cam_pio_closefile: interface to pio_closefile (consistency and possible + future file close on endrun) +- cam_pio_fileexists: checks to see if a file exists (logical function) +- cam_pio_def_dim: convenience function for defining NetCDF dimensions +- cam_pio_def_var: convenience function for defining NetCDF variables +- cam_pio_handle_error: prints a custom error message if error status is passed +- cam_pio_get_var: Interface to pio_get_var which replaces 'GLOBAL' infld calls +- cam_pio_var_info: Retrieve variable properties (moved from ncdio_atm and + improved) +- cam_pio_find_var: Find a variable descriptor in an open NetCDF file +- cam_pio_check_var: Make sure var exists and retrieve properties +- cam_grid_register: Create a new CAM grid +- cam_grid_attribute_register: Add an attribute to a new CAM grid +- cam_grid_write_attr: Define the dimension and coordinate attributes for + the horizontal history coordinates for a grid as well at that + grid's attributes +- cam_grid_write_var: Write the values of the dimension and coordinate + attributes for the horizontal history coordinates for a grid as + well at that grid's attributes +- cam_grid_read_dist_array: Read a distributed array defined on a CAM grid +- cam_grid_write_dist_array: Write a distributed array defined on a CAM grid +- cam_grid_dimensions: Return the dimensions of the grid For lon/lat + grids, this is (nlon, nlat) For unstructured grids, this is + (ncols, 1) +- cam_grid_num_grids: Number of currently defined grids +- cam_grid_check: Return .true. iff grid ID exists +- cam_grid_id: Grid ID (decomp) or -1 if error +- cam_grid_get_local_size: Return the size of a local array for a grid +- cam_grid_get_file_dimids: Return the NetCDF IDs for a grid's dimensions +- cam_grid_get_decomp: Given some array information, find or compute a PIO + decomposition +- cam_grid_get_gcid: Return the global index for each grid element +- cam_grid_get_array_bounds: Return lower and upper bounds for local + arrays defined on a CAM grid +- cam_grid_get_coord_names: Return the names of a grid's horizontal coordinates +- cam_grid_get_dim_names: Return the name(s) of a grid's dimensions (may + be only one dimension for unstructured grids) +- cam_grid_has_blocksize: Return .true. iff a grid's arrays are contained + in differently sized blocks (e.g., physics grid ncol) +- cam_grid_get_block_count: Return the size of a block for a given grid ID +- cam_grid_get_latvals: Return a pointer to a grid's local latitude values +- cam_grid_get_lonvals: Return a pointer to a grid's local longitude values +- cam_grid_is_unstructured: Return .true. iff grid is unstructured +- cam_grid_is_block_indexed: Return .true. iff grid is block indexed + (e.g., physics grid) +- cam_grid_compute_patch: Calculate a grid and filemap for a region. Grid + patches are currently used for regional history output + +List all existing files that have been modified, and describe the changes: +M components/cam/SVN_EXTERNAL_DIRECTORIES + - Updated chem_proc to new tag which incorporates addfld + interface change + - Updated HOMME external to new tag which incorporates new + interpolated output interfaces +M components/cam/bld/build-namelist + - Moved interpolated output variables from SE/share namelist to new + cam_history_nl + - Renamed interpolated output variables to be more CAM like + - Added checks for incompatible history options +M components/cam/bld/namelist_files/namelist_definition.xml + - Organized new cam_history_nl namelist + - Changed interpolated output variable names as follows: + interpolate_analysis ==> interpolate_output + interp_nlat ==> interpolate_nlat + interp_nlon ==> interpolate_nlon + interp_type ==> interpolate_type + interp_gridtype ==> interpolate_gridtype +M components/cam/doc/ChangeLog + - Added a bunch of stuff on top of existing document +M components/cam/src/chemistry/aerosol/mo_setsox.F90 +M components/cam/src/chemistry/bulk_aero/aero_model.F90 +M components/cam/src/chemistry/bulk_aero/mo_aerosols.F90 +M components/cam/src/chemistry/bulk_aero/mo_setsoa.F90 +M components/cam/src/chemistry/bulk_aero/seasalt_model.F90 +M components/cam/src/chemistry/modal_aero/aero_model.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M components/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 +M components/cam/src/chemistry/mozart/cfc11star.F90 +M components/cam/src/chemistry/mozart/chemistry.F90 +M components/cam/src/chemistry/mozart/exbdrift.F90 +M components/cam/src/chemistry/mozart/gcr_ionization.F90 +M components/cam/src/chemistry/mozart/lin_strat_chem.F90 +M components/cam/src/chemistry/mozart/linoz_data.F90 +M components/cam/src/chemistry/mozart/mo_aero_settling.F90 +M components/cam/src/chemistry/mozart/mo_airglow.F90 +M components/cam/src/chemistry/mozart/mo_aurora.F90 +M components/cam/src/chemistry/mozart/mo_chm_diags.F90 +M components/cam/src/chemistry/mozart/mo_cph.F90 +M components/cam/src/chemistry/mozart/mo_drydep.F90 +M components/cam/src/chemistry/mozart/mo_exp_sol.F90 +M components/cam/src/chemistry/mozart/mo_extfrc.F90 +M components/cam/src/chemistry/mozart/mo_fstrat.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_ghg_chem.F90 +M components/cam/src/chemistry/mozart/mo_lightning.F90 +M components/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +M components/cam/src/chemistry/mozart/mo_photo.F90 +M components/cam/src/chemistry/mozart/mo_sad.F90 +M components/cam/src/chemistry/mozart/mo_setext.F90 +M components/cam/src/chemistry/mozart/mo_setinv.F90 +M components/cam/src/chemistry/mozart/mo_sulf.F90 +M components/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/noy_ubc.F90 +M components/cam/src/chemistry/mozart/rate_diags.F90 +M components/cam/src/chemistry/mozart/short_lived_species.F90 +M components/cam/src/chemistry/mozart/tracer_cnst.F90 +M components/cam/src/chemistry/mozart/tracer_srcs.F90 +M components/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 +M components/cam/src/chemistry/pp_waccm_sc_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccmx_mozart/mo_imp_sol.F90 +M components/cam/src/chemistry/pp_waccmx_mozart/mo_sim_dat.F90 +M components/cam/src/chemistry/utils/aerodep_flx.F90 +M components/cam/src/chemistry/utils/aircraft_emit.F90 +M components/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M components/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M components/cam/src/chemistry/utils/prescribed_aero.F90 +M components/cam/src/chemistry/utils/prescribed_ghg.F90 +M components/cam/src/chemistry/utils/prescribed_ozone.F90 +M components/cam/src/chemistry/utils/prescribed_strataero.F90 +M components/cam/src/chemistry/utils/prescribed_volcaero.F90 +M components/cam/src/chemistry/utils/tracer_data.F90 + - Modified addfld calls to match new interface +M components/cam/src/control/cam_control_mod.F90 + - Removed no longer needed use_64bit_nc logical variable +M components/cam/src/control/cam_history.F90 + - Reimplemented history to use new CAM grid infrastructure + - Removed dycore-specific history output and references + - Created new CAM history namelist reader +M components/cam/src/control/cam_history_buffers.F90 + - Modularized use of the dimind input to the accumulators + - Fixed some typos in teh local tod code +M components/cam/src/control/cam_history_support.F90 + - Modified structures and functions to implement support for + new grid infrastructure + - Modified column_info structure for new patch (regional) + output infrastructure + - Removed dycore-specific information + - Added interp_info_t for regional output + - Made use of new cam_pio_def_dim and cam_pio_def_var interfaces +M components/cam/src/control/cam_initfiles.F90 + - New cam_pio_openfile interface +M components/cam/src/control/cam_restart.F90 + - New interface to init_restart_physics and init_restart_dynamics + - Moved initcom call to before read_restart_dynamics so that + function can use new I/O infrastructure +M components/cam/src/control/history_defaults.F90 + - Modified addfld calls to match new interface + - Removed some unused addfld calls +M components/cam/src/control/history_scam.F90 + - Modified addfld calls to match new interface +M components/cam/src/control/ncdio_atm.F90 + - Modified infld interfaces to use new grid infrastructure + - GLOBAL grid input calls were moved to cam_pio_get_var + - check_var was moved to cam_pio_utils (and enhanced) + - check_dim functionality was replaced with cam_pio_def_dim +M components/cam/src/control/runtime_opts.F90 + - Moved history-related namelist reading to cam_history.F90 +M components/cam/src/control/sat_hist.F90 + - Minor changes due to variables moving between modules +M components/cam/src/cpl/atm_comp_mct.F90 + - Use new cam_pio_closefile interface +M components/cam/src/dynamics/eul/dyn_comp.F90 + - Add call to define_cam_grids which sets up dynamics grids + - Modified addfld calls to match new interface +M components/cam/src/dynamics/eul/dyn_grid.F90 + - Moved initgrid here from initcom.F90 + - Added lat_d_out and lon_d_out to get_horiz_grid_d (i.e., in degrees) + - Added subroutine, define_cam_grids, to define dynamics grids +M components/cam/src/dynamics/eul/inidat.F90 + - Changed GLOBAL infld calls to cam_pio_get_var + - Modified remaining infld calls for new interface +M components/cam/src/dynamics/eul/initcom.F90 + - Removed body of subroutine and moved to initgrid in dyn_grid.F90 +M components/cam/src/dynamics/eul/interp_mod.F90 + - Changed stub functions to use new interface (see SE) +M components/cam/src/dynamics/eul/restart_dynamics.F90 + - Replace hdimids input with call to cam_grid_write_attr +M components/cam/src/dynamics/fv/ctem.F90 + - Modified addfld calls to match new interface +M components/cam/src/dynamics/fv/dyn_comp.F90 + - Reordered start-up calls to enable define_cam_grids to work + - Add call to define_cam_grids which sets up dynamics grids + - Modified addfld calls to match new interface +M components/cam/src/dynamics/fv/dyn_grid.F90 + - Moved initgrid here from initcom.F90 (need to clean initcom?) + - Added lat_d_out and lon_d_out to get_horiz_grid_d (i.e., in degrees) + - Added subroutine, define_cam_grids, to define dynamics grids +M components/cam/src/dynamics/fv/inidat.F90 + - Modified infld calls for new interface +M components/cam/src/dynamics/fv/inital.F90 + - Moved call to dyn_init to make sure grids and coordinates are defined +M components/cam/src/dynamics/fv/interp_mod.F90 + - Changed stub functions to use new interface (see SE) +M components/cam/src/dynamics/fv/metdata.F90 + - Modified infld calls for new interface +M components/cam/src/dynamics/fv/restart_dynamics.F90 + - Replace hdimids input with call to cam_grid_write_attr +M components/cam/src/dynamics/se/dyn_comp.F90 + - Add call to define_cam_grids which sets up dynamics grids + - Minor cleanup including replacement of some MPI shorthand calls +M components/cam/src/dynamics/se/dyn_grid.F90 + - Moved initgrid here from initcom.F90 + - Added lat_d_out and lon_d_out to get_horiz_grid_d (i.e., in degrees) + - Added subroutine, define_cam_grids, to define dynamics grids + - Changed global coordinate functions to not store permanent globals +M components/cam/src/dynamics/se/gravity_waves_sources.F90 + - Added elem input to support future edge exchange interface +M components/cam/src/dynamics/se/inidat.F90 + - Read data into differently-shaped structures as part of new + grid support + - Modified infld calls for new interface +M components/cam/src/dynamics/se/interp_mod.F90 + - Modified interface to support defining interpolation on a per + file basis (e.g., different files can have different resolutions) + - Define CAM grid for interpolated output for each file +M components/cam/src/dynamics/se/nctopo_util_mod.F90 + - Modified output data structures to match new grid format +M components/cam/src/dynamics/se/restart_dynamics.F90 + - Replace hdimids input with call to cam_grid_write_attr +M components/cam/src/dynamics/se/stepon.F90 + - Modified addfld calls to match new interface +M components/cam/src/dynamics/sld/dyn_comp.F90 + - Add call to define_cam_grids which sets up dynamics grids + - Minor cleanup including replacement of some MPI shorthand calls +M components/cam/src/dynamics/sld/dyn_grid.F90 + - Moved initgrid here from initcom.F90 + - Added lat_d_out and lon_d_out to get_horiz_grid_d (i.e., in degrees) + - Added subroutine, define_cam_grids, to define dynamics grids +M components/cam/src/dynamics/sld/interp_mod.F90 + - Changed stub functions to use new interface (see SE) +M components/cam/src/dynamics/se/inidat.F90 + - Changed GLOBAL infld calls to cam_pio_get_var +M components/cam/src/dynamics/sld/restart_dynamics.F90 + - Replace hdimids input with call to cam_grid_write_attr +M components/cam/src/physics/cam/aer_rad_props.F90 +M components/cam/src/physics/cam/aoa_tracers.F90 +M components/cam/src/physics/cam/cam3_ozone_data.F90 +M components/cam/src/physics/cam/cam_diagnostics.F90 +M components/cam/src/physics/cam/check_energy.F90 +M components/cam/src/physics/cam/cldwat.F90 +M components/cam/src/physics/cam/cldwat2m_macro.F90 +M components/cam/src/physics/cam/cloud_cover_diags.F90 +M components/cam/src/physics/cam/cloud_diagnostics.F90 +M components/cam/src/physics/cam/cloud_fraction.F90 +M components/cam/src/physics/cam/clubb_intr.F90 +M components/cam/src/physics/cam/co2_cycle.F90 +M components/cam/src/physics/cam/constituent_burden.F90 +M components/cam/src/physics/cam/conv_water.F90 +M components/cam/src/physics/cam/convect_deep.F90 +M components/cam/src/physics/cam/convect_shallow.F90 +M components/cam/src/physics/cam/cospsimulator_intr.F90 +M components/cam/src/physics/cam/eddy_diff.F90 +M components/cam/src/physics/cam/gw_drag.F90 +M components/cam/src/physics/cam/hetfrz_classnuc_cam.F90 +M components/cam/src/physics/cam/hk_conv.F90 +M components/cam/src/physics/cam/macrop_driver.F90 +M components/cam/src/physics/cam/micro_mg_cam.F90 +M components/cam/src/physics/cam/microp_aero.F90 +M components/cam/src/physics/cam/modal_aer_opt.F90 +M components/cam/src/physics/cam/ndrop.F90 +M components/cam/src/physics/cam/ndrop_bam.F90 +M components/cam/src/physics/cam/nucleate_ice_cam.F90 +M components/cam/src/physics/cam/phys_debug.F90 + - Modified addfld calls to match new interface +M components/cam/src/physics/cam/phys_grid.F90 + - Define 'physgrid' physics CAM grid +M components/cam/src/physics/cam/physics_buffer.F90.in + - Changes to restart code to use new CAM grid interfaces + - Added interface (pbuf_dump_pbuf) useful for debugging +M components/cam/src/physics/cam/physpkg.F90 + - Modified infld calls for new interface +M components/cam/src/physics/cam/rad_constituents.F90 +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/cam/radiation_data.F90 + - Modified addfld calls to match new interface +M components/cam/src/physics/cam/restart_physics.F90 + - Changes to use new CAM grid interfaces + - Replaced hdimids input with grid info +M components/cam/src/physics/cam/rk_stratiform.F90 +M components/cam/src/physics/cam/sslt_rebin.F90 + - Modified addfld calls to match new interface +M components/cam/src/physics/cam/subcol.F90 + - File should be inout in subcol_init_restart +M components/cam/src/physics/cam/subcol_utils.F90.in + - Cleaned up (probably buggy) restart code using new grid + interfaces and cleaner convenience interfaces from cam_pio_utils +M components/cam/src/physics/cam/tidal_diag.F90 +M components/cam/src/physics/cam/tracers.F90 +M components/cam/src/physics/cam/tropopause.F90 +M components/cam/src/physics/cam/unicon_cam.F90 +M components/cam/src/physics/cam/uwshcu.F90 +M components/cam/src/physics/cam/vertical_diffusion.F90 +M components/cam/src/physics/cam/zm_conv.F90 +M components/cam/src/physics/cam/zm_conv_intr.F90 + - Modified addfld calls to match new interface +M components/cam/src/physics/carma/cam/carma_getH2O.F90 +M components/cam/src/physics/carma/cam/carma_getH2SO4.F90 +M components/cam/src/physics/carma/cam/carma_getT.F90 +M components/cam/src/physics/carma/cam/carma_intr.F90 + - Cleaned up input routines to use new cam_pio_get_var interface +M components/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M components/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M components/cam/src/physics/rrtmg/ebert_curry.F90 +M components/cam/src/physics/rrtmg/radiation.F90 +M components/cam/src/physics/rrtmg/slingo.F90 +M components/cam/src/physics/waccm/iondrag.F90 +M components/cam/src/physics/waccm/nlte_lw.F90 +M components/cam/src/physics/waccm/qbo.F90 +M components/cam/src/physics/waccm/radheat.F90 +M components/cam/src/physics/waccm/waccm_forcing.F90 +M components/cam/src/physics/waccmx/ionosphere.F90 +M components/cam/src/physics/waccmx/majorsp_diffusion.F90 +M components/cam/src/unit_drivers/drv_input_data.F90 +M components/cam/src/utils/cam_dom/ocn_comp.F90 +M components/cam/src/utils/cam_dom/sst_data.F90 + - Modified addfld calls to match new interface +A + components/cam/src/utils/cam_grid_support.F90 + - New module containing types and functionality for horizontal + coordinates and grids +A + components/cam/src/utils/cam_map_utils.F90 + - New module containing type (cam_filemap_t) and functionalty + for maps between field arrays and NetCDF file variables +M components/cam/src/utils/cam_pio_utils.F90 + - Substantially rewritten PIO interface utility layer + - Removed all dycore or physics grid specific decomposition code + - Use new CAM grid and cam_filemap_t interfaces to create and + use PIO decompositions + - Added convience interfaces which allow flexible inquiry and + definition of NetCDF dimensions and variables and also perform + error checking (with some functionality moved from ncdio_atm + functions check_var and check_dim) + - Added debug interface for comparing fields +M components/cam/src/utils/spmd_utils.F90 + - Added mpi_min forward reference (needed for filemap code) +M components/cam/test/system/archive_baseline.sh + - Fixed typo related to Goldbach ==> Hobart switch +M components/cam/test/system/input_tests_master + - Added new tests to protect regional and interpolated output +A + components/cam/test/system/nl_files/ghgrmp_e8 + - New regional output test + Existing ghgrmp namelist not valid with corrected region selection +A + components/cam/test/system/nl_files/ghgrmp_f4 + - New regional output test + Existing ghgrmp namelist not valid with corrected region selection +A + components/cam/test/system/nl_files/ghgrmp_unstruct + - New regional output and interpolated output test for the SE dycore +M components/cam/test/system/tests_pretag_goldbach_nag + - Added new tests for regional output and interpolated output + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp_e8+1850_cam4 9s ...............................................FAIL! rc= 7 at Sat Aug 8 22:31:46 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp_f4+1850_cam5 9s ................................................FAIL! rc= 7 at Sat Aug 8 23:23:57 MDT 2015 +- There are no existing baselines for these tests + +hobart/nag: +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Sat Aug 8 19:37:43 MDT 2015 +- There are no existing baselines for this test + +hobart/pgi or jaguar/pgi: +010 bl112 TBL.sh e8c5dm ghgrmp_e8 9s ..........................................................FAIL! rc= 7 at Sat Aug 8 19:52:14 MDT 2015 +- There are no existing baselines for this test + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_4_05 +Originator(s): cacraig +Date: 8/5/2015 +One-line Summary: Update CAM regression testing to hobart and update several externals + +Purpose of changes: + - CAM regression testing will now use hobart + - cosp, rtm and homme all had compiler issues when updated to NAG6.0 which were corrected + and were non-answer changing. These externals are used with this tag + - the cime external was pointing to a private user's branch and is now pointing to a + branch on the CESM cime repository + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - updated to externals which compile and run with NAG6.0 + +M components/cam/test/system/archive_baseline.sh +M components/cam/test/system/test_driver.sh +M components/cam/doc/ChangeLog_template + - changed over to using hobart for CAM regression testing + +M components/cam/test/system/tests_pretag_hobart_nag + - added new test which was added to the goldbach tests, but + had not been added to the identical hobart list + +M components/cam/bld/configure +M components/cam/bld/Makefile.in +M components/cam/bld/config_files/definition.xml + - changed over to using hobart for testing + - added temporary nag53 configure/namelist option to allow compilation + of nag53 (which is what has been used on goldbach) while moving ahead + with nag6.0 on hobart + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +* For the hobart baseline tests, updated cam5_4_04 with the minimal changes required to run on hobart in configure and Makefile.in +hobart/nag: all BFB except for cosp and homme tests which did not have the baselines pass due to the inability + of cam5_4_04 to compile with the old externals + +hobart/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_04 +Originator(s): cacraig +Date: July 31, 2015 +One-line Summary: Update to CESM1_4_beta06 externals + +Purpose of changes: Update to current CESM externals + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update CLM, CICE and RTM to most current tags (already had updated CIME in the last CAM tag) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..................................................FAIL! rc= 7 at Fri Jul 31 16:22:14 MDT 2015 +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Fri Jul 31 16:27:36 MDT 2015 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Fri Jul 31 16:27:42 MDT 2015 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Fri Jul 31 16:27:53 MDT 2015 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Fri Jul 31 16:27:57 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Fri Jul 31 16:28:00 MDT 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Fri Jul 31 16:28:25 MDT 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 16:28:33 MDT 2015 +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Jul 31 16:35:51 MDT 2015 +039 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Fri Jul 31 16:36:14 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Fri Jul 31 16:36:18 MDT 2015 +043 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Fri Jul 31 16:36:29 MDT 2015 +046 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Fri Jul 31 16:36:39 MDT 2015 +049 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Jul 31 16:38:21 MDT 2015 +053 bl397 TBL.sh f1.9c4cm outfrq3s_cosp+1850-2005_cam4 9s .....................................FAIL! rc= 7 at Fri Jul 31 16:38:30 MDT 2015 +056 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Jul 31 16:38:38 MDT 2015 +058 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Fri Jul 31 16:38:52 MDT 2015 +061 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Jul 31 16:39:23 MDT 2015 +064 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Fri Jul 31 16:41:30 MDT 2015 +067 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Fri Jul 31 16:41:54 MDT 2015 +071 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Fri Jul 31 16:41:59 MDT 2015 +074 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Fri Jul 31 16:42:03 MDT 2015 +077 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Fri Jul 31 16:43:02 MDT 2015 +088 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Fri Jul 31 16:43:25 MDT 2015 + +goldbach/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Fri Jul 31 10:24:51 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Fri Jul 31 10:32:46 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Fri Jul 31 10:39:23 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Jul 31 10:50:17 MDT 2015 +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 11:08:53 MDT 2015 +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Fri Jul 31 11:25:26 MDT 2015 +037 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Jul 31 11:33:05 MDT 2015 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Fri Jul 31 11:41:10 MDT 2015 +046 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Fri Jul 31 11:48:26 MDT 2015 +049 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 12:16:04 MDT 2015 +052 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Fri Jul 31 12:48:16 MDT 2015 +058 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 13:17:29 MDT 2015 +061 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 13:30:50 MDT 2015 +064 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Fri Jul 31 13:43:37 MDT 2015 +067 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Fri Jul 31 14:10:19 MDT 2015 + +goldbach/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Fri Jul 31 10:24:52 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Fri Jul 31 10:32:47 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Fri Jul 31 10:40:39 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Jul 31 10:54:05 MDT 2015 +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 11:15:12 MDT 2015 +036 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Fri Jul 31 11:21:02 MDT 2015 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Jul 31 11:35:35 MDT 2015 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Fri Jul 31 11:42:20 MDT 2015 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Fri Jul 31 11:43:57 MDT 2015 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Fri Jul 31 11:46:52 MDT 2015 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Jul 31 11:55:06 MDT 2015 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 12:31:01 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 12:44:41 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Jul 31 12:57:09 MDT 2015 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all runs which use cice have different answers due to changes in the cice tag +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): not analyzed as these are answers due to a compoonent other than CAM + +=============================================================== +=============================================================== + +Tag name: cam5_4_03 +Originator(s): fvitt, eaton +Date: Thu Jul 30 13:07:08 MDT 2015 +One-line Summary: Modify shr_flux_mod; change fc_type xlf to ibm; fix mam + diagnostic radiation calcs. + +Purpose of changes: + +. Fix problems from the update to cime1.1.15 in the cesm1_4_alpha06a + testing. + + - Modify shr_flux_mod.F90 to support setting the values of certain + constants as required for aquaplanet mode. Remove the cam_aqua copy of + that file. The mods to shr_flux_mod.F90 do *not* include the previous + mods to maintain BFB results for the cam3 aquaplanet. We decided to + deprecate the cam3 version of the flux algorithm which contained a bug. + + - Modify CAM's configure to accept COMPILER=ibm as the compiler "type" + for xlf compilers. This fixes the build of the chemistry proprocessor. + +. Fix memory allocation errors in code to recalculate the aerosol water + uptake when doing diagnostic radiation calculations with modal aerosols. + Also add test for diagnostic radiation calc w/ MAM. + +Bugs fixed (include bugzilla ID): + +bugz 2194: change 86400_r8 to 86400._r8 in 3 restart_dynamics files + +Describe any changes made to build system: + +. valid value for the -fc_type arg to configure was changed from 'xlf' to + 'ibm' for consistency with CESM scripts. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/src/utils/cam_aqua/shr_flux_mod.F90 +. made changes to csm_share version of shr_flux_mod so that it can be used + by CAM's aquaplanet mode. + +List all subroutines added and what they do: + +components/cam/test/system/nl_files/rad_diag_mam +. set up a diagnostic radiation calculation for MAM3 + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/cam.buildnml +. add the -fc_type arg back to configure + +components/cam/bld/config_files/definition.xml +. add parameter build_chem_proc to force the chem preprocessor to be built + +components/cam/bld/configure +. add -build_chem_proc flag +. change the fc_type: xlf -> ibm +. remove env var COMPILER as a source for the fc_type info. Use fc_type + arg instead. + +components/cam/bld/perl5lib/Build/ChemPreprocess.pm +. mods to recognize the build_chem_proc parameter +. add code to check that the fortran compiler is found + +components/cam/src/dynamics/sld/restart_dynamics.F90 +components/cam/src/dynamics/se/restart_dynamics.F90 +components/cam/src/dynamics/eul/restart_dynamics.F90 +. change 86400_r8 to 86400._r8 + +components/cam/src/chemistry/utils/modal_aero_calcsize.F90 +components/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +. remove allocation of arrays needed for diagnostic calculations +. add check that all arrays needed for diagnostic calcs have been + associated + +components/cam/src/physics/cam/modal_aer_opt.F90 +. modal_aero_sw, modal_aero_lw + - add allocation/deallocation of arrays needed by diagnostic calcs + +components/cam/src/utils/physconst.F90 +. call shr_flux_adjust_constants after the namelist read that gets the + desired values. + +components/cam/test/system/TCB.sh +components/cam/test/system/TCB_ccsm.sh +. force build of chem proc for all tests that use custom chem + +components/cam/test/system/input_tests_master +. add sm338 TSM.sh f10c5dm rad_diag_mam 9s +. add bl338 TBL.sh f10c5dm rad_diag_mam 9s + +components/cam/test/system/tests_pretag_goldbach_nag +. add sm338, bl338 + +components/cam/test/system/tests_pretag_yellowstone +. reorder test list + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Tue Jul 28 18:41:37 MDT 2015 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Tue Jul 28 18:48:29 MDT 2015 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Tue Jul 28 19:02:12 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Tue Jul 28 19:11:30 MDT 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Tue Jul 28 19:23:40 MDT 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jul 28 19:34:39 MDT 2015 +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jul 28 19:47:41 MDT 2015 +039 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Tue Jul 28 20:02:58 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Jul 28 20:05:35 MDT 2015 +043 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Tue Jul 28 20:11:49 MDT 2015 +046 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Tue Jul 28 20:18:34 MDT 2015 +049 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Jul 28 20:27:03 MDT 2015 +056 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Jul 28 20:41:16 MDT 2015 +058 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Jul 28 20:50:19 MDT 2015 +061 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Tue Jul 28 21:07:11 MDT 2015 +064 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Tue Jul 28 21:20:08 MDT 2015 +067 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Tue Jul 28 21:44:03 MDT 2015 +077 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Tue Jul 28 22:09:42 MDT 2015 +080 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Tue Jul 28 22:12:45 MDT 2015 +083 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Jul 28 22:24:03 MDT 2015 +088 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Jul 28 22:28:37 MDT 2015 + +All failures except bl731 are due to updating the cime external which +pulled in a change to not use the gamma and erf functions intrinsics with +the intel compiler. This is a change for performance reasons. + +bl731 fails because cam3/aquaplanet changes answers due to no longer +maintaining a bug in the shr_flux_mod calculations. + +goldbach/nag: All PASS except: +025 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Jul 28 15:21:37 MDT 2015 +046 bl338 TBL.sh f10c5dm rad_diag_mam 9s ......................................................FAIL! rc= 7 at Tue Jul 28 16:08:43 MDT 2015 + +goldbach/pgi: All PASS except: +030 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Jul 28 15:29:37 MDT 2015 + +bl313 fails due to cam3/aquaplanet answer change as noted above. +bl338 fails due to being a new test with no existing baseline. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except: + +1) cam3/aquaplanet changes answers due to no longer maintaining a bug in + the shr_flux_mod calculations. + +2) An intel compiler change to not use the gamma or erf intrinsic functions + (in shr_spfn_mod.F90). + +=============================================================== +=============================================================== + +Tag name: cam5_4_02 +Originator(s): cacraig +Date: July 17, 2015 +One-line Summary: Code cleanup/rearrangement and temporary fix to allow CESM to run on mira, but breaks chemistry preprocessor + +Purpose of changes: +- Code reviews of the SPCAM branch demonstrated several areas where + cleanup/rearrangement of CAM code was necessary to allow other + models to use sections of CAM cleanly. +- temporary fix to allow CESM to run on mira, but chemistry preprocessor will be broken +- radiation now has an optional argument to not output its results. All of the output + is put into a structure which is returned from radiation_tend and can be used outside + radiation. +- outfld calls in radiation are now in two routines called by radiation (one for + shortwave and the other for longwave). These routines are not called if the + optional do_output variable is set to .false. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/src/physics/cam/radiation_utils.F90 +A components/cam/src/physics/rrtmg/radiation_utils.F90 + - contains the structure for outputs from radiation + +List all existing files that have been modified, and describe the changes: +M components/cam/test/system/input_tests_master + - rearranged list so it is ordered consistently and corrected a couple of typos + +M components/cam/bld/configure + - make the check for setting pbl_pkg more precise + +M components/cam/bld/cam.buildnml + - temporary fix to allow CESM to run on mira. This will break chem preprocessor compilation + +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/rrtmg/radiation.F90 +M components/cam/src/unit_drivers/rad/unit_driver.F90 + - added structure which contains all radiation output data + - added optional flag to turn off calling the outfld calls inside radiation_tend + +M components/cam/src/physics/cam/cam_diagnostics.F90 +M components/cam/src/physics/cam/physpkg.F90 + - check status on a couple of optional pbuf fields before reading them + +M components/cam/src/physics/cam/macrop_driver.F90 + - fix bug where need to only process fields from top_lev:pver instead of the entire dimension as + valid data may not be set outside those bounds + +M components/cam/src/utils/cam_pio_utils.F90 + - temporary fix until the new cam history is implemented + +M components/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 +M components/cam/src/chemistry/modal_aero/aero_model.F90 +M components/cam/src/chemistry/bulk_aero/aero_model.F90 +M components/cam/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +M components/cam/src/chemistry/aerosol/mo_setsox.F90 + - move addfld/outfld calls to the interface layer + +M components/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + - allow modal_aero_kohler to be public (needed by SPCAM) + +M components/cam/src/chemistry/mozart/chemistry.F90 + - call sox_inti prior to aero_model_init so that the logical "has_sox" is available + when initializing the aerosols + +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +M components/cam/src/chemistry/mozart/mo_mass_xforms.F90 + - from a performance standpoint, dummy arrays are more efficient if they are declared with + their dimensions. Made all arrays be ncol long for consistency. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_4_01 +Originator(s): santos +Date: 2015/07/13 +One-line Summary: Miscellaneous minor changes. + +Purpose of changes: + + - Preliminary changes so that CAM can be built by CIME on hobart, and + using the new NAG 6.0 libraries. + + - Minor fixes to FV and physpkg. + + - Add some new diagnostic fields. + +Bugs fixed (include bugzilla ID): + + - #238: Remove "modcomm" namelist variables? (Actually resolved by + restoring their original functionality.) + + - Occasional floating-point exceptions in CAM5 (not noted on bugzilla?). + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Changed modcomm_gatscat, modcomm_geopk, and modcomm_transpose so that + they are added to the correct namelist group. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: (collection of small independent changes; mostly eaton) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/src/dynamics/fv/dyn_comp.F90 +M components/cam/src/dynamics/fv/pmgrid.F90 +M components/cam/src/dynamics/fv/spmd_dyn.F90 + - Correct handling of modcomm variables so that they actually + affect communication as intended for CAM-FV. + +M components/cam/cimetest/testlist_cam.xml + - Change goldbach to hobart in CIME tests. + +M components/cam/src/control/cam_history_buffers.F90 +M components/cam/src/dynamics/fv/dynamics_vars.F90 +M components/cam/src/dynamics/fv/restart_dynamics.F90 +M components/cam/src/physics/cam/cldwat.F90 + - Fix incorrect uses of kind numbers that cause problems for NAG + when the "-kind=byte" flag is omitted. + +M components/cam/src/physics/cam/cam_diagnostics.F90 + - Add new "T400", "U500", and "V500" diagnostics. + +M components/cam/src/physics/cam/physpkg.F90 + - Fix bug where flux arrays that were only set up to ncol were + having every element divided, which could cause crashes due to + floating-point exceptions in DEBUG mode, from computing with + uninitialized data. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +goldbach/nag: + +goldbach/pgi or jaguar/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: + + - cam5_3_92 was used, because it is identical to cam5_4_00. + +=============================================================== +=============================================================== + +Tag name: cam5_4_00 +Originator(s): cacraig +Date: July 8, 2015 +One-line Summary: Copy of cam5_3_92 to start the cam5_4 series + +Purpose of changes: +No changes, simply the start of the cam5_4 series + +=============================================================== +=============================================================== + +Tag name: cam5_3_92 +Originator(s): eaton +Date: Mon Jun 29 13:31:38 MDT 2015 +One-line Summary: Mods for passive tracer life cycle experiments + +Purpose of changes: + +Implement functionality for new simplified model "life cycle" experiments. + +. Modify the test tracer functionality: + - require that the number of test tracers be specified directly via the + -nadv_tt option to configure. Disable the old optional method of + setting -nadv larger than needed by the other phys/chem schemes and + assuming that remaining constituent slots will be filled with test + tracers. + - allow user to specify names of tracers to be read from the initial file. + +. Finish implementing the namelist reading for the Eulerian and SLD + dycores. Move default values that were set in the code to the namelist + defaults file. This fixes a hidden bug in the Eul dycore where a user + specified parameter could be overwritten by a hardcoded value. + +. Implement the option to apply Nth order horizontal diffusion in the + Eulerian dycore. The default remains 4th order diffusion. Add namelist + specification of the diffusion order, and rename the dif4 variable to + eul_hdif_coef to reflect that it's for the Nth order diffusion. + +. Allow user to specify that a topo dataset will not be used rather than + requiring that a dataset full of zeros be provided. + +. Mods to inidat routines to allow unicon to initialize its constituents. + +Bugs fixed (include bugzilla ID): + +. fix Eul dycore overwriting user specified values of dif2 and dif4 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. remove tracers_flag variable - replace by test_tracer_num variable which + is meant to be set by build-namelist to the value of the configure + parameter nadv_tt + +. add test_tracer_names for user specification of passive tracers to be read + from the initial file + +. change names of dif2,divdampn,eps,kmxhdc to dyn_spectral_* These + names are read by both EUL and SLD dycores + +. For Eulerian dycore add variables: + eul_hdif_order - sets order N of horizonal diffusion operator + (defaults to 4) + eul_hdif_coef - Nth order horizonal diffusion coefficient + +. add use_topo_file. The default behavior is always to provide a default + topo file. Setting use_topo_file=.false. allows the user to specify that + PHIS, SGH, SGH30, and LANDM_COSLAT are all zero without having to + supply a topo file. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cam developers + +List all subroutines eliminated: + +List all subroutines added and what they do: + +components/cam/bld/namelist_files/use_cases/adiabatic_LC1.xml +. add initial files for EUL T42, T85, T170 at 30, 60, and 120 levels +. set all topo fields to 0. via new use_topo_file=.false. +. add names of passive tracers for LC1 simulations + 'strat', 'tropo', 'th320', 'th340', 'wrt' +. Set up history output for 6-hrly instantaneous values of + 'U','V','T','PS','strat','tropo','th320','th340','wrt' + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/cam.buildnml +. parse the ATM_GRID value to extract the number of levels and add the + -nlev arg to the configure commandline if it has been specified. This + supports the CESM scripts. + +components/cam/bld/build-namelist +. if new use_topo_file variable is set false, then don't add default for + bnd_topo +. set new variable test_tracer_num to the value of configuration parameter + nadv_tt. Remove setting tracers_flag. +. add add_default calls for dyn_spectral_dif2, dyn_spectral_dif4, + dyn_spectral_divdampn, dyn_spectral_eps, dyn_spectral_kmxhdc +. add add_default calls for eul_hdif_order, eul_hdif_coef + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default values for dyn_spectral_dif2, dyn_spectral_dif4, + dyn_spectral_divdampn, dyn_spectral_eps, dyn_spectral_kmxhdc, + eul_hdif_order, eul_hdif_coef. The values + had previously be hardcoded in eul_control_mod.F90 and + sld_control_mod.F90. Note that the default for eul_hdif_order is 4, and + the coefficient values which previously assigned to dyn_spectral_dif4 are + now assigned to eul_hdif_coef for the Eulerian dycore only. + +components/cam/bld/namelist_files/namelist_definition.xml +. add new var test_tracer_names in group test_tracers_nl +. remove tracers_flag +. add test_tracer_num to group test_tracers_nl +. change names of dif2,divdampn,eps,kmxhdc to dyn_spectral_* These + names are read by both EUL and SLD dycores +. For Eulerian dycore add variables: + eul_hdif_order - sets order N of horizonal diffusion operator + (defaults to 4) + eul_hdif_coef - Nth order horizonal diffusion coefficient +. add use_topo_file to allow the user to specify that no topo file should + be added to the namelist specification. +. move ncdata and bnd_topo to group cam_initfiles_nl + +components/cam/src/chemistry/mozart/mo_drydep.F90 +. access ncdata using initial_file_get_id method of cam_initfiles rather + than from filenames module + +components/cam/src/control/cam_history.F90 +. access ncdata and bnd_topo from cam_initfiles rather than from filenames + module + +components/cam/src/control/cam_initfiles.F90 +. add public data for ncdata and bnd_topo (moved from filenames module) +. add routine cam_initfiles_readnl +. add namelist variable use_topo_file. Setting + use_topo_file=.false. implies no topo file will be read and PHIS, SGH, + SGH30, and LANDM_COSLAT will all be set to zero. + +components/cam/src/control/filenames.F90 +. move public data for ncdata and bnd_topo to cam_initfiles + +components/cam/src/control/runtime_opts.F90 +. remove ncdata and bnd_topo +. remove tracers_flag and add call to tracers_readnl +. add call to cam_initfiles_readnl + +components/cam/src/control/startup_initialconds.F90 +. remove pio filehandles as actual args in call to read_inidat + +components/cam/src/dynamics/eul/eul_control_mod.F90 +. rename kmnhd4 -> kmnhdn to reflect Nth order diffusion. Also make it + a parameter set in this module. +. change namelist variable names by prepending "dyn_spectral_" to dif2, + divdampn, eps, kmxhdc +. add new namelist variables eul_hdif_order and eul_hdif_coef. These + replace the old dif4 with variables to set both the order (N) of the + diffusion operator, and the coefficient for the Nth order diffusion. +. remove hardcoded values of namelist variables. In the old code there was + a bug where hardcoded values of dif2 and dif4 would overwrite user + specified values. +. move the log output inside a masterproc conditional + +components/cam/src/dynamics/eul/grcalc.F90 +. rename hdfst4 -> hdfstn to reflect implementation of general Nth order + diffusion + +components/cam/src/dynamics/eul/hdinti.F90 +. move setting of kmnhdn and kmxhd2 to eul_control_mod +. rename hdfst4 -> hdfstn and hdfsd4 -> hdfsdn to reflect implementation of + Nth order diffusion. +. compute coefs for Nth order diffusion. When N=4 there will be roundoff + level diffs with the coefficient values from the original 4th order calc. + +components/cam/src/dynamics/eul/hordif.F90 +. rename kmnhd4 -> kmnhdn, hdfst4 -> hdfstn, hdfsd4 -> hdfsdn + +components/cam/src/dynamics/eul/inidat.F90 +. use accessor methods to get ncid_ini and ncid_topo pointers. remove + dummy args change names to fh_ini and fh_topo. +. add check that fh_topo is not associated to the conditional that sets + phis=0.0 +. fix log output for constituent initialization so that it's not written for + every latitude slice +. add calls to allow unicon to initialize its constituents + +components/cam/src/dynamics/eul/spegrd.F90 +. rename kmnhd4 -> kmnhdn + +components/cam/src/dynamics/fv/inidat.F90 +components/cam/src/dynamics/se/inidat.F90 +components/cam/src/dynamics/sld/inidat.F90 +. use accessor methods to get ncid_ini and ncid_topo pointers. remove + dummy args. change names to fh_ini and fh_topo. +. add check that fh_topo is not associated to the conditional that sets + phis=0.0 +. add calls to allow unicon to initialize its constituents + +components/cam/src/dynamics/sld/sld_control_mod.F90 +. change namelist variable names by prepending "dyn_spectral_" +. remove hardcoded values of namelist variables. +. move the log output inside a masterproc conditional + +components/cam/src/physics/cam/physpkg.F90 +. remove calls to tracers_timestep_tend and tracers_timestep_init +. extend conditional that sets sgh=sgh30=landm=0 to also check whether + fh_topo is associated. + +components/cam/src/physics/cam/tracers.F90 +. add routine tracers_readnl to read namelist +. modify tracers_register and tracers_implements_cnst to allow the names to + come from either the test_tracer_names input or from the tracers_suite. +. remove unused functionality for non-passive tracers -- i.e., eliminate + routines tracers_timestep_init and tracers_timestep_tend + +components/cam/src/physics/cam/tracers_suite.F90 +. remove unused functionality for non-passive tracers + +components/cam/test/system/nl_files/ttrac +. replace divdampn by dyn_spectral_divdampn + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS except +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..................................................FAIL! rc= 7 at Fri Jun 26 14:08:18 MDT 2015 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .........................................FAIL! rc= 7 at Fri Jun 26 14:08:43 MDT 2015 + +goldbach/nag: all PASS except +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Jun 25 17:54:11 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Jun 25 18:03:17 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 25 18:08:48 MDT 2015 + +goldbach/pgi: all PASS except +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Fri Jun 26 12:43:47 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Fri Jun 26 12:50:33 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Fri Jun 26 12:58:03 MDT 2015 +019 bl115 TBL.sh e8idm idphys 9s ..............................................................FAIL! rc= 7 at Fri Jun 26 13:02:10 MDT 2015 + +All failed baselines are due to a roundoff difference in the Eulerian 4th +order horizontal diffusion tendency which is computed using an algorithm +that has been generalized to work for Nth order diffusion rather than be +fixed at 4th order diffusion. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except roundoff diffs in Eulerian dycore. + +=============================================================== +============================================================== + +Tag name: cam5_3_91 +Originator(s): cacraig +Date: 06/11/15 +One-line Summary: Bug fix for is_convtran1 with MG1; added hobart regression testing; +limit calculations on check_energy_chng call in tphysbc to (:ncol); added more robust +subcolumn restart test + +Purpose of changes: +- A bug in micro_mg_cam when calling cnst_add incorrectly with is_convtran1=.false. was discovered a number + of months ago. As it was answer changing for MG1, applying the correction was delayed until this tag. +- Added capabilities for using hobart (the next generation CGD cluster) to the CAM regression testing platforms +- A bug was discovered with a call to check_energy_chng with arithmetic calculations which were being done + over the entire array instead of the ncol subsection. In certain instances, this caused a floating point + error to occur during calculations outside the valid range. +- Discovered an error with filter and weights not being read in correctly during restart. Added a more robust +test (subcol_tstcp_restart) to test this capability. Regression test 337 has been added, but will not be added +to a pretag test list until the cam_history tag is created which corrects the bug. + +Bugs fixed (include bugzilla ID): no bugzilla reports for any of the bugs listed above + +Describe any changes made to build system: added hobart capability to regression testing + +Describe any changes made to the namelist: added subcolumn namelist flag subcol_test_restart which turns + on a more robust restart test for weights + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A components/cam/test/system/tests_pretag_hobart_nag +A components/cam/test/system/tests_pretag_hobart_pgi + - hobart pretag tests are identical to the current goldbach pretag tests + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/build-namelist +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml + - add subcolumn namelist variable subcol_tstcp_restart which tests restart on weights more robustly + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - removed bug in cnst_add call which used is_convtran1=.false. instead of .true. for MG1 runs + As it was answer changing, fixing this bug was delayed until this tag + +M components/cam/src/physics/cam/physpkg.F90 + - bug discovered when calling check_energy_chng where an entire array is divided by cld_macmic_num_steps + In this instance a Nan was at the end of the array past the ncol which cause a floating point error + +M components/cam/src/physics/cam/subcol_tstcp.F90 + - introduced subcol_tstcp_restart which is designed to setup weights in such a way that if they + are incorrectly unpacked during restart, an exact restart test will fail + +M components/cam/test/system/input_tests_master + - added test 337 to turn on subcol_tstcp_restart. It will be used in cam_history branch testing and + will be added to a pretag test when the updated cam_history is brought onto the trunk + +M components/cam/test/system/CAM_runcmnd.sh +M components/cam/test/system/test_driver.sh + - added hobart capabilities to CAM regression testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +NOTE -- All of these tests were BFB with a set of regression tests that were run without the answer changing micro_mg_cam change. The +results below only failed when the micro_mg_cam bug fix was put into the code base. + +yellowstone/intel: +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Thu Jun 11 14:04:45 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Thu Jun 11 14:27:54 MDT 2015 +034 er366 TER.sh f1.9c5clbdh outfrq3s_clubb 4+5s ..............................................FAIL! rc= 6 at Thu Jun 11 15:29:27 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Thu Jun 11 15:50:20 MDT 2015 +054 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Jun 11 16:19:12 MDT 2015 +056 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Jun 11 16:28:14 MDT 2015 +062 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Thu Jun 11 16:56:47 MDT 2015 +065 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Thu Jun 11 17:20:48 MDT 2015 +081 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Thu Jun 11 18:00:32 MDT 2015 +086 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Thu Jun 11 18:05:05 MDT 2015 + +goldbach/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Jun 11 11:15:52 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Jun 11 11:24:11 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 11 11:31:32 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 11 11:43:00 MDT 2015 +031 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Thu Jun 11 12:08:27 MDT 2015 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Thu Jun 11 12:40:19 MDT 2015 +053 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Jun 11 14:07:41 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 11 14:19:21 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Thu Jun 11 14:47:44 MDT 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Thu Jun 11 15:18:01 MDT 2015 + +goldbach/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Jun 11 11:15:16 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Jun 11 11:23:00 MDT 2015 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Thu Jun 11 11:28:10 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 11 11:29:50 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Jun 11 11:29:50 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 11 11:42:50 MDT 2015 +038 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Thu Jun 11 12:17:03 MDT 2015 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Jun 11 12:26:16 MDT 2015 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Thu Jun 11 12:34:10 MDT 2015 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Thu Jun 11 12:35:55 MDT 2015 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Thu Jun 11 12:38:26 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 11 13:40:11 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 11 13:53:05 MDT 2015 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Jun 11 14:20:21 MDT 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all MG1 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? +A 5 year run using the F_2000_CAM5 compset and MG1 was run for both a baseline as well as a +run with the is_convtran1=.true. fixed. The results were evaluated by Andrew Gettelman and +his determination was that the change was larger than roundoff, but is within the noise. + +=============================================================== +=============================================================== + +Tag name: cam5_3_90 +Originator(s): cacraig, eaton +Date: Fri Jun 5 11:01:33 MDT 2015 +One-line Summary: Add "-phys cam5.4" to configure + +Purpose of changes: + +Add "-phys cam5.4" option to configure for easy setup of the cam5.4 physics +package. This has the following effect: + +. build configuration: + - trop_mam4 chemistry + - mg2 microphysics + - 32 vertical levels + - nucleate_ice.F90 contained a conditional clause that was previously turned + on by defining the CPP macro USE_XLIU_MOD. This version of the + conditional has been validated and is now the default code. Note that + this is an answer changing mod for the cam5 physics package as well as + being the cam5.4 configuration. + +. runtime configuration: + - use_preexisting_ice = .true. + use_hetfrz_classnuc = .true. + cldfrc_rhminl_adj_lan = 0.00D0 + modal_accum_coarse_exch = .true. + micro_mg_dcs = 250.D-6 + nucleate_ice_subgrid =1.2D0 + - note that modal_accum_coarse_exch=.true. triggers the tuning parameter + seasalt_emis_scale = 0.9D0 + - There are currently only initial files for FV 1 and 2 deg: + cami-mam3_0000-01-01_1.9x2.5_L32_c150407.nc + cami-mam3_0000-01-01_0.9x1.25_L32_c141031.nc + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. add cam5.4 as valid physics package + +Describe any changes made to the namelist: + +. provide correct defaults for cam5.4 physics package + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. don't have performance estimates for cam5.4 at this time. + +Code reviewed by: cacraig, eaton + +List all subroutines eliminated: + +components/cam/test/system/nl_files/outfrq3s_cam5.4 +. remove this file and use outfrq3s in the cam5.4 tests. The namelist + customizations in this file for cam5.4 are no longer needed. + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/configure +. change default physics package to cam5.4 + - remove cam3_5_1 as an alias for cam4 +. set default cam5.4 chem package to trop_mam4 +. change logic so defaults_waccm.xml is used with cam4 physics, else + use defaults_waccm5.xml +. set default cam5.4 microphys_pkg to mg2 +. remove old warning about cosp/cam5 not tested +. set nlev values for non-waccm configurations +. remove old code setting ice_pkg='cice' for cam3 (cice is the default) + +components/cam/bld/config_files/definition.xml +. remove phys value cam3_5_1 +. add cam5.4 as valid value for phys parameter +. remove default value for nlev - set it in configure + +components/cam/bld/build-namelist +. add add_default calls for use_hetfrz_classnuc and use_preexisting_ice +. add add_default call for modal_accum_coarse_exch (only for modal aerosols) +. mods to support defaults that haven't changed between cam5 and cam5.4 + +components/cam/bld/namelist_files/namelist_defaults_cam.xml +. add defaults for use_hetfrz_classnuc and use_preexisting_ice +. add defaults for modal_accum_coarse_exch +. add new cam5.4 default for cldfrc_rhminl_adj_land +. mods to support defaults that haven't changed between cam5 and cam5.4 +. mg2 value of nucleate_ice_subgrid changed from 1.0 to 1.2 +. mg2 value of micro_mg_dcs changed from 150.D-6 to 250.D-6 + +components/cam/src/chemistry/aerosol/wetdep.F90 +components/cam/src/physics/cam/zm_conv_intr.F90 +components/cam/src/physics/cam/cospsimulator_intr.F90 +components/cam/src/physics/carma/cam/carma_intr.F90 +. add cam_physpkg_is('cam5.4') to conditionals using cam_physpkg_is('cam5') + +components/cam/src/physics/cam/nucleate_ice.F90 +. use the form of the condition statement that results from defining the + CPP USE_XLIU_MOD. Make this the only option and remove the macro. + +components/cam/test/system/config_files/f0.9c5.4dh +components/cam/test/system/config_files/f1.9c5.4dh +components/cam/test/system/config_files/f1.9c5.4dm +. "-phys cam5 -microphys mg2 -chem trop_mam4 -nlev 32" replaced by + "-phys cam5.4" +. remove "-cppdefs -DUSE_XLIU_MOD" + +components/cam/test/system/input_tests_master +. change outfrq3s_cam5.4 to outfrq3s in all cam5.4 tests + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: + +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Thu Jun 4 16:02:55 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Thu Jun 4 16:25:34 MDT 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 16:48:33 MDT 2015 +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Jun 4 17:01:25 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Thu Jun 4 17:19:26 MDT 2015 +054 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Jun 4 17:48:38 MDT 2015 +056 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Jun 4 17:57:39 MDT 2015 +062 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Thu Jun 4 18:26:06 MDT 2015 +065 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Thu Jun 4 18:50:06 MDT 2015 +081 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Thu Jun 4 19:30:09 MDT 2015 +086 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Thu Jun 4 19:34:41 MDT 2015 + +goldbach/nag: All PASS except: + +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 4 12:31:29 MDT 2015 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Thu Jun 4 13:41:39 MDT 2015 +047 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 14:29:23 MDT 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Thu Jun 4 15:10:54 MDT 2015 +053 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Jun 4 15:36:14 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 15:51:26 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Thu Jun 4 16:21:59 MDT 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Thu Jun 4 16:56:11 MDT 2015 + +goldbach/pgi: All PASS except: + +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Jun 4 12:24:24 MDT 2015 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Jun 4 13:11:57 MDT 2015 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Thu Jun 4 13:19:18 MDT 2015 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Thu Jun 4 13:21:10 MDT 2015 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Thu Jun 4 13:24:34 MDT 2015 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Jun 4 13:33:16 MDT 2015 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 14:10:00 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 14:25:23 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jun 4 14:38:53 MDT 2015 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Jun 4 15:04:53 MDT 2015 + +All failures above are expected as explained below. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +BFB except cam5 and cam5.4 physics configurations: + +. All cam5 configurations fail baselines due to making the USE_XLIU_MOD + form of a conditional in nucleate_ice.F90 the default. These are larger + than roundoff answer changes, but same climate. That validation is here: + http://webext.cgd.ucar.edu/FCLIMO/f.e13.F2000C5.f09_f09.cam5.3.51.ice_nucleation.005/atm/f.e13.F2000C5.f09_f09.cam5.3.51.ice_nucleation.005-f.e13.F2000C5.f09_f09.cam5.3.51.ice_nucleation.002/ + +. All cam5.4 configurations fail baselines due to changes in tuning + parameters. This is part of the cam5.4 development process. + +=============================================================== +=============================================================== + +Tag name: cam5_3_89 +Originator(s): eaton +Date: Fri May 29 09:31:42 MDT 2015 +One-line Summary: update cime and cice externals + +Purpose of changes: + +. Update to cime1.0.8. This tag contains an updated MCT external which + provides the mpi-serial library. This change required several + compensating changes in the CAM standalone build, and also an update of + the cice external to deal with compilation issues (NAG) stemming from the + new mpi-serial version of mpif.h. + +Bugs fixed (include bugzilla ID): + +. Fix problem in the dependency generation caused by an include path being + added directly to Makefile.in rather than via the Filepath file. + +Describe any changes made to build system: + +. Changes to support MCT's new mpi-serial build. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update to cime1.0.8 +. update cice to cice/branch_tags/cice5_tags/cice5_20150402_20150528 + - The new cice tag was needed to get fixes that removed global save + statements from cice/src/mpi/ice_boundary.F90 and + cice/src/mpi/ice_global_reductions.F90. These save statements + conficted with a new save statement in the mpi-serial version of + mpif.h. This is a problem for the NAG compiler only. + +components/cam/bld/configure +. in mct configure section + - add copies for the mpif.h and mpi.h files +. add $cam_root/cime/share/csm_share/include to the Filepath file + - this is a bug fix required for proper dependency generation of the + shr_assert.h file (it contains a 'use shr_assert_mod' statement and + that dependency is needed to force correct build sequencing) + +components/cam/bld/Makefile.in +. in rule to build mct libs + - add SRCDIR=$(ROOTDIR)/cime/externals/mct to submake commandline. This + is compensating for a bug in the MCT configure. The base directory of + the MCT source code has already been provided to MCT's configure, and + it should not have to be passed again via the make command. +. don't manually append $cam_root/cime/share/csm_share/include to + cpp_path. It's coming from the Filepath file now. + +components/cam/src/utils/spmd_utils.F90 +. remove the declaration of mpi_status_ignore. The new mpi-serial version + of mpif.h contains this declaration. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. + +=============================================================== +=============================================================== + +Tag name: cam5_3_88 +Originator(s): cacraig, andrew, sean, fvitt, jenkay +Date: May 22, 2015 +One-line Summary: Miscellaneous chemistry, cosp and general CAM bug fixes + and modifications + +Purpose of changes: + - added output fields to the microphysics for supercooled liquid water + - new variables QTGW, CLDLIQTGW, and CLDICETGW, as well as the existing variable CT_H2O, + are added to the budget history file. This is necessary to balance the budget for + water when active chemistry and the parameterized gravity waves are enabled. + - fix bug in CESM build of chemistry preprocessor + - fix bug in chemistry preprocessor when the list of non-transported species + is long + - fix bug in interp_mod for SE dycore + - removed the need to pass dry deposition velocity fields of tagged CO + species through the model coupler -- this helps alleviate a problem which + occasionally occurs when the list of dry deposition of velocity fields + and MEGAN emission fields to transfer from CLM to CAM has gotten to + long for the model coupler to handle + - bug fix to ice_nucleate to check qi for non-zero value to prevent divide by zero + - bug fixes for cosp + - CLD_CAL_LIQ, CLD_CAL_ICE, CLD_CAL_UN,CLD_CAL_TMP, CLD_CAL_TMPLIQ, + CLD_CAL_TMPICE, CLD_CAL_TNPUN) for COSP1.4 should all be dimensioned the same + as the original CALIPSO variable CLD_CAL. CLD_CAL uses nht_cosp as a vertical + size and cosp_ht as the mdim variable. These new output fields are all being + saved on the COSP grid - not the CAM grid. + - moved the outfld calls inside of the if(llidar_sim) conditional. + - removed the adddefault calls for CLD_CAL_TMP, CLD_CAL_TMPLIQ,CLD_CAL_TMPICE, + CLD_CAL_TNPUN as they are temporary variables and unclear how they would + be used for model evaluation. + - removed the comment "fails check_accum if 'A'" where it doesn't belong. This + comment is meant to be only for COSP outputs with sub-column dimensions (e.g., TAU_ISCCP). + You cannot save COSP outputs with sub-columns as 'A' fields - they have to be 'I'. This + comment "fails check_accum if 'A'" is not applicable for CLD_CAL_LIQ, CLD_CAL_ICE, + CLD_CAL_UN,CLD_CAL_TMP, CLD_CAL_TMPLIQ,CLD_CAL_TMPICE, CLD_CAL_TNPUN. + - PGI15.1 had a compiler bug which requires associate subsections to have ranges on them + - updated goldbach PGI testing to use PGI15.1 + +Bugs fixed (include bugzilla ID): +- bug fixes for cosp +- bug fix for nucleate_ice which had a divide by zero when qi was zero (answer, but not climate changing for cam5.4 setup) +- components/cam/src/dynamics/se/interp_mod.F90 +- bug fix in CESM build of chemistry preprocessor +- bug fix in chemistry preprocessor when the list of non-transported species is long +- bug fix in interp_mod for SE dycore + + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/test/system/test_driver.sh + - update to use PGI15.1 on goldbach + +M components/cam/src/physics/cam/microp_aero.F90 +M components/cam/src/physics/cam/hetfrz_classnuc_cam.F90 + - PGI15.1 has a compiler bug which requires associate commands to have ranges on the subsections + +M components/cam/src/physics/cam/micro_mg_cam.F90 + - added output fields to the microphysics for supercooled liquid water + +M components/cam/src/physics/cam/gw_drag.F90 + - added new variables QTGW, CLDLIQTGW, and CLDICETGW, as well as the existing variable CT_H2O, + to the budget history file. This is necessary to balance the budget for + water when active chemistry and the parameterized gravity waves are enabled. + +M components/cam/src/physics/cam/nucleate_ice.F90 + - bug fix to ice_nucleate to check qi for non-zero value to prevent divide by zero + +M components/cam/src/physics/cam/cospsimulator_intr.F90 + - bug fixes for cosp (see details above) + +M components/cam/src/chemistry/mozart/chemistry.F90 + - added CT_H2O, to the budget history file. + +M components/cam/src/dynamics/se/interp_mod.F90 + - bug fix from Francis + +M SVN_EXTERNAL_DIRECTORIES + - using cime external from github (still the same version as previously) + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - use updated chemistry preprocessor tag which fixes a bug in not-transported species + - update cosp to a version which works with WACCM + +M components/cam/bld/cam.buildnml + - invoke fc_type configure option so that chemistry preprocessor will be + built with correct compiler + +M components/cam/bld/perl5lib/Build/ChemPreprocess.pm + - replaced setting of 'COMPILER' environment variable with 'USER_FC' + -- 'COMPILER' is set in CESM scripts and don't want to reset it here + +M components/cam/test/system/tests_pretag_yellowstone + - moved CAM test 376 to be after CESM test ne996 -- this is so that + the chemistry preprocessor will be built with CESM scripts rather + than by stand-alone CAM configure + +M components/cam/src/chemistry/mozart/mo_drydep.F90 + - cleaned up tagged CO code and fixed bug in setting deposition fluxes + of the tagged CO species + +M components/cam/bld/namelist_files/master_gas_drydep_list.xml + - removed tagged CO species so that these deposition velocity fields will + not be passed through the coupler which are duplicates of CO deposition + velocity fields -- only deposition velocity field of CO is needed + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +032 bl353 TBL.sh f1.9c5.4dh outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Fri May 22 14:47:08 MDT 2015 + +goldbach/nag: all BFB except: +047 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Fri May 22 13:52:16 MDT 2015 + +goldbach/pgi or jaguar/pgi: all BFB except: +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Fri May 22 13:56:16 MDT 2015 + +Summarize any changes to answers, i.e., +- what code configurations: cam5.4 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but same climate + +=============================================================== +=============================================================== + +Tag name: cam5_3_87 +Originator(s): eaton +Date: Fri May 1 07:43:51 MDT 2015 +One-line Summary: cleanup in atm_comp, cam_comp, time_manager + +Purpose of changes: + +. Move initialization code that has been duplicated in atm_comp_mct and + atm_comp_esmf down to the cam_comp layer. + +. Add initializer for module data in cam_control_mod and add protected + attribute. This is the location of control info from the + driver/coupler. + +. Remove restart functionality from the time_manager module. The + driver/coupler is responsible for providing this information to + components. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cam developers + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +components/cam/SVN_EXTERNAL_DIRECTORIES +. update COSP -- fixes a missing build dependency + +components/cam/bld/Makefile.in +. fix for configure's esmf link test + +components/cam/bld/configure +. fix for linking with external ESMF lib (need to build driver code with + USE_ESMF_LIB defined. +. fix for configure's esmf link test + +components/cam/src/chemistry/bulk_aero/mo_setsoa.F90 +components/cam/src/chemistry/mozart/spedata.F90 +components/cam/src/chemistry/utils/tracer_data.F90 +. replace obsolete nsrest variable (or remove unused variable) + +components/cam/src/control/cam_comp.F90 +. remove cam specific timing code +. move cam specific initialization that had been done in atm_comp layer + into cam_init. +. data from the coupler is passed to cam_init via intent(in) args. +. Pass the Eclock object and access it's data inside cam_init rather than + passing the timestamp data as individual arguments. +. change name of module variable "dtime" to "dtime_phys" since this is not + the same dtime that cam reads from its namelist and uses to set its + internal clock timestep. dtime_phys is set by the dycore (intent(out) + arg of stepon_run1) and is used by the physics package as the timestep + for computed tendencies which are returned to the dycore. + +components/cam/src/control/cam_control_mod.F90 +. add protected attribute to public module variables +. add init routine for public module variables -- these are set by + information coming from the coupler +. add log output for the variables in this module (moved here from + read_namelist) + +components/cam/src/control/cam_history.F90 +. replace obsolete nsrest variable (or remove unused variable) +. access caseid and ctitle from cam_control_mod + +components/cam/src/control/cam_restart.F90 +. replace obsolete nsrest variable (or remove unused variable) +. remove call for time_manager restart +. remove obsolete reduced grid code + +components/cam/src/control/filenames.F90 +. caseid and brnch_retain_casename moved to cam_control_mod. These are + given to cam by the coupler. + +components/cam/src/control/runtime_opts.F90 +. dtime made local; version in time_manager mod made private +. single_column, scmlat, scmlon removed as module data since these are + given by the coupler and passed as intent(in) args to read_namelist +. remove check on caseid; this comes from the coupler and is handled in + cam_control_mod +. add call to timemgr_set_step_size to set dtime in time_manager +. move log output that belongs in cam_control_mod +. remove obsolete COUP_SOM code +. remove mpibcast of variables handled by cam_control_mod -- these weren't + doing anything anyway since the variable came from the coupler and were + already known in all tasks. + +components/cam/src/control/scamMod.F90 +. added a dycore_is check for EUL since scam_setopts is always called by + read_namelist rather than only being called when scam is on + +components/cam/src/cpl/atm_comp_esmf.F90 +components/cam/src/cpl/atm_comp_mct.F90 +. replace the direct initialization of public module data by subroutine + calls that initialize protected module data. This is for the data that + comes from the coupler. +. pass the Eclock object to cam_init and move time_manager init there +. move broken check on co2_readflux_ocn into co2_cycle +. remove time_manager restart +. remove call to scam_use_iop_srf -- move to phys_timestep_init since this + is code to read info from the iop dataset + +components/cam/src/dynamics/eul/initcom.F90 +. replace obsolete nsrest variable (or remove unused variable) + +components/cam/src/dynamics/eul/scanslt.F90 +. scanslt_initial -- change etamid to intent(out) -- this is not the same + etamid as in the hycoef module because SCAM may overwrite it with pmid + +components/cam/src/dynamics/eul/stepon.F90 +. make etamid a private module variable since SCAM may overwrite it's usual + values +. remove gw and etamid from stepon_init arg list +. remove etamid from stepon_run3 arg list + +components/cam/src/dynamics/fv/metdata.F90 +. replace obsolete nsrest variable (or remove unused variable) + +components/cam/src/dynamics/fv/stepon.F90 +. replace obsolete nsrest variable (or remove unused variable) +. remove gw and etamid from stepon_init arg list +. remove etamid from stepon_run3 arg list + +components/cam/src/dynamics/se/dyn_comp.F90 +. replace direct use of time_manager module var dtime by get_step_size + function + +components/cam/src/dynamics/se/stepon.F90 +. replace direct use of time_manager module var dtime by get_step_size + function +. remove gw and etamid from stepon_init arg list +. remove etamid from stepon_run3 arg list + +components/cam/src/dynamics/sld/scanslt.F90 +. slt_initial - remove gw from arg list + +components/cam/src/dynamics/sld/stepon.F90 +. replace internal calc of etamid by use of hycoef var +. remove gw and etamid from stepon_init arg list +. remove etamid from stepon_run3 arg list + +components/cam/src/physics/cam/co2_cycle.F90 +. check on co2_readflux_ocn moved here from atm_comp + +components/cam/src/physics/cam/physpkg.F90 +. replace obsolete nsrest variable (or remove unused variable) +. add cam_in as actual arg in call to phys_timestep_init +. add cam_in as dummy arg in phys_timestep_init so can call + scam_use_iop_srf which is using data to set surface field values + +components/cam/src/physics/carma/cam/carma_intr.F90 +. replace obsolete nsrest variable (or remove unused variable) + +components/cam/src/unit_drivers/drv_input_data.F90 +. replace direct use of time_manager module var dtime by get_step_size + function + +components/cam/src/utils/cam_dom/ocn_comp.F90 +components/cam/src/utils/cam_dom/ocn_comp_mct.F90 +. replace obsolete nsrest variable (or remove unused variable) + +components/cam/src/utils/cam_dom/ocn_filenames.F90 +. access caseid from cam_control_mod rather than filenames module + +components/cam/src/utils/time_manager.F90 +. add timemgr_set_step_size to set private dtime module variable with value + read from namelist +. timemgr_init - add current time value obtained from coupler, and extend + functionality to deal with either initial or restart cases. +. remove restart functionality -- that is driver/coupler responsibility + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam5_3_86 +Originator(s): cacraig +Date: 4/30/2015 +One-line Summary: Switch to cice5 external library + +Purpose of changes: +- Use the new cice5 external library + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES +M components/cam/bld/configure + - added cice5 library and directories + +M components/cam/bld/build-namelist + - ice_ic file is required for branches and CAM needs to supply its name in the rpointer.ice file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..................................................FAIL! rc= 7 at Wed Apr 29 17:07:35 MDT 2015 +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Wed Apr 29 17:30:40 MDT 2015 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Wed Apr 29 17:37:24 MDT 2015 +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Wed Apr 29 17:51:03 MDT 2015 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Wed Apr 29 17:54:00 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Wed Apr 29 18:00:07 MDT 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Wed Apr 29 18:12:25 MDT 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 29 18:23:13 MDT 2015 +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Apr 29 18:36:12 MDT 2015 +039 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Wed Apr 29 18:51:49 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed Apr 29 18:54:23 MDT 2015 +043 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Wed Apr 29 19:00:37 MDT 2015 +046 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Wed Apr 29 19:07:20 MDT 2015 +049 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Wed Apr 29 19:16:04 MDT 2015 +053 bl397 TBL.sh f1.9c4cm outfrq3s_cosp+1850-2005_cam4 9s .....................................FAIL! rc= 7 at Wed Apr 29 19:19:50 MDT 2015 +056 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Apr 29 19:29:59 MDT 2015 +058 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Wed Apr 29 19:39:00 MDT 2015 +061 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Wed Apr 29 19:55:51 MDT 2015 +064 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Wed Apr 29 20:07:28 MDT 2015 +067 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Wed Apr 29 20:31:17 MDT 2015 +071 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Wed Apr 29 20:37:57 MDT 2015 +074 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Wed Apr 29 20:39:27 MDT 2015 +077 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Wed Apr 29 20:56:49 MDT 2015 +088 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed Apr 29 21:15:16 MDT 2015 + +goldbach/nag: all BFB except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Apr 29 14:48:19 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Apr 29 14:56:34 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Apr 29 15:02:32 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Apr 29 15:12:18 MDT 2015 +028 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 15:29:00 MDT 2015 +034 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Wed Apr 29 15:47:09 MDT 2015 +037 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Wed Apr 29 15:53:49 MDT 2015 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Wed Apr 29 16:01:55 MDT 2015 +047 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 29 16:36:46 MDT 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed Apr 29 17:06:13 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 17:37:18 MDT 2015 +059 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 17:50:20 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Wed Apr 29 18:03:05 MDT 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Wed Apr 29 18:27:51 MDT 2015 + +goldbach/pgi or jaguar/pgi: all BFB except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Apr 29 14:48:27 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Apr 29 14:54:49 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Apr 29 15:01:15 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Apr 29 15:13:08 MDT 2015 +033 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 15:33:02 MDT 2015 +036 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Wed Apr 29 15:38:39 MDT 2015 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed Apr 29 15:52:15 MDT 2015 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Wed Apr 29 15:58:52 MDT 2015 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Wed Apr 29 16:00:36 MDT 2015 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Wed Apr 29 16:02:45 MDT 2015 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed Apr 29 16:10:46 MDT 2015 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 29 16:45:31 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 16:58:40 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Apr 29 17:10:10 MDT 2015 + +All of the above changes are due to the change in cice and are establishing a new baseline for CAM. + + +=============================================================== +=============================================================== + +Tag name: cam5_3_85 +Originator(s): cbardeen +Date: 2015/04/29 +One-line Summary: Limit values in RRTMG vulnerable to bad table extrapolation. + +Purpose of changes: + + - Some variables in RRTMG can have unrealistic values due to being extrapolated + far past the ranges provided in lookup tables. This produces problems such as + negative optical depths, so the RRTMG external is updated with limiters to + avoid extreme values. + + - Fix a race condition in the COSP makefile. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: trivial, checked by santos + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M components/cam/SVN_EXTERNAL_DIRECTORIES + - Update the RRTMG and COSP externals. RRTMG has the aforementioned + limiters added, while COSP has a dependency from scale_LUTs_io to + radar_simulator_types added to the Makefile. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Wed Apr 29 05:21:11 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Wed Apr 29 05:43:53 MDT 2015 +032 bl353 TBL.sh f1.9c5.4dh outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 29 06:06:24 MDT 2015 +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Apr 29 06:19:06 MDT 2015 +041 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed Apr 29 06:36:40 MDT 2015 +056 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Apr 29 07:10:29 MDT 2015 +058 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Wed Apr 29 07:19:28 MDT 2015 +064 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Wed Apr 29 07:47:21 MDT 2015 +067 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Wed Apr 29 08:10:53 MDT 2015 +083 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Wed Apr 29 08:50:11 MDT 2015 +088 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed Apr 29 08:54:41 MDT 2015 + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Apr 28 11:36:40 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Apr 28 11:44:32 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Apr 28 11:50:27 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Apr 28 12:00:33 MDT 2015 +031 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Apr 28 12:21:04 MDT 2015 +037 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Apr 28 12:41:30 MDT 2015 +040 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Apr 28 12:48:50 MDT 2015 +047 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Tue Apr 28 13:28:04 MDT 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Apr 28 13:59:50 MDT 2015 +053 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Apr 28 14:22:41 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Apr 28 14:34:53 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Apr 28 15:00:08 MDT 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Apr 28 15:31:00 MDT 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Apr 28 15:40:02 MDT 2015 + +goldbach/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Apr 28 11:56:09 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Apr 28 12:04:26 MDT 2015 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Apr 28 12:10:41 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Apr 28 12:12:51 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Apr 28 12:26:57 MDT 2015 +038 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Apr 28 13:02:42 MDT 2015 +041 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Apr 28 13:12:23 MDT 2015 +045 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Apr 28 13:20:30 MDT 2015 +048 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Apr 28 13:22:25 MDT 2015 +051 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Apr 28 13:25:43 MDT 2015 +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Apr 28 13:35:23 MDT 2015 +057 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Tue Apr 28 14:15:13 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Apr 28 14:31:18 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Apr 28 14:44:46 MDT 2015 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Apr 28 15:15:08 MDT 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Apr 28 15:23:23 MDT 2015 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + All RRTMG cases (mostly CAM5 and development configurations). +- what platforms/compilers: + All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + larger than roundoff, same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +Climate not changed, but note diags of FC5 and FW5 cases run on yellowstone: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.f19_f19.rrtmglim.002/atm/f.e13.FC5.f19_f19.rrtmglim.002-f.e13.FC5.f19_f19.rrtmgctl.002 +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FW5.f19_f19.rrtmglim.002/atm/f.e13.FW5.f19_f19.rrtmglim.002-f.e13.FW5.f19_f19.rrtmgctl.002 + +=============================================================== +=============================================================== + +Tag name: cam5_3_84 +Originator(s): sungsup, jenkay, eaton +Date: Mon Apr 27 13:20:21 MDT 2015 +One-line Summary: add UNICON kernel to trunk; COSP diagnostic fix + +Purpose of changes: + +. The UNICON kernel code being put on the trunk is the one used to produce + the simulations evaluated by the panel prior to the Feb 2015 AMWG + meeting. But note that those simulations were done from source code + based on cam5_3_25 with a modified version of MG1 code which is not on + CAM's trunk. Thus the simulations evaluated by the panel are not + reproducible in this tag. This is of course also a due to all the answer + changes that are being added for the candidate 5.4 physics package. + + The UNICON code is enabled by setting the "-unicon" flag to configure. + +. Bug fixes in the addfld calls for the following COSP diagnostic fields: + CLD_CAL_LIQ, CLD_CAL_ICE, CLD_CAL_UN, + CLD_CAL_TMP, CLD_CAL_TMPLIQ, CLD_CAL_TMPICE, CLD_CAL_TMPUN + +Bugs fixed (include bugzilla ID): + +. cosp diagnostics + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +components/cam/test/system/nl_files/fv2d_4tsk +components/cam/test/system/nl_files/fv2d_8tsk +. namelists for obsolete tests + +List all subroutines added and what they do: + +components/cam/src/physics/cam/unicon.F90 +components/cam/src/physics/cam/unicon_utils.F90 +. UNICON kernel + +components/cam/test/system/config_files/f10c5udm +. new file for cam5/unicon config + +List all existing files that have been modified, and describe the changes: + +components/cam/src/physics/cam/cospsimulator_intr.F90 +. fix addfld calls for CLD_CAL_LIQ, CLD_CAL_ICE, CLD_CAL_UN, + CLD_CAL_TMP, CLD_CAL_TMPLIQ, CLD_CAL_TMPICE, CLD_CAL_TMPUN + +components/cam/src/physics/cam/unicon_cam.F90 +. interface updates for addition of unicon_utils module + +components/cam/test/system/input_tests_master +components/cam/test/system/tests_posttag_goldbach +components/cam/test/system/tests_pretag_goldbach_pgi +. add new unicon test and remove some obsolete tests + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS except + +054 bl334 TBL.sh f10c5udm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Apr 24 15:25:14 MDT 2015 + +bl334 is a new test with no previous baseline for comparison. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_83 +Originator(s): bogensch, cacraig +Date: 04/24/15 +One-line Summary: Updated to more recent CLUBB external library + +Purpose of changes: +- Using next version of the CLUBB external library +- introduced several new tuning parameters for CLUBB: clubb_timestep, clubb_rnevap_effic, clubb_stabcorrect + The default values of these and other clubb tuning parameters may be changed in a future tag +- introduced microphysics logical allow_sed_supersat: allow supersaturated conditions after sedimentation loop +- Update some default namelist parameters for CLUBB in preparation for CAM5.4-CLUBB simulations. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- added: clubb_stabcorrect (CLUBB logical - do explict diffusion with a stability correction) + clubb_timestep (CLUBB real - timestep) + clubb_rnevap_effic (CLUBB real - rain evaporation efficiency factor) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM software development team + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M components/cam +M components/cam/SVN_EXTERNAL_DIRECTORIES + - update to newer CLUBB external library + - brought in SILHS external library (needed for CLUBB to compilation even though it is not used) + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/bld/build-namelist + - added clubb_timestep, clubb_rnevap_effic, clubb_stabcorrect + +M components/cam/src/physics/cam/micro_mg2_0.F90 +M components/cam/src/physics/cam/micro_mg_cam.F90 + - introduced allow_sed_supersat which is set to false for clubb runs + +M components/cam/src/physics/cam/clubb_intr.F90 + - numerous changes to support changes in the CLUBB interface + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +035 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Apr 24 04:35:59 MDT 2015 + -- CLUBB runs are expected to change answers. Runs have been validated extensively by Peter Bogenschutz + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + + +=============================================================== +=============================================================== + +Tag name: cam5_3_82 +Originator(s): cacraig, eaton +Date: 04/21/2015 +One-line Summary: Revised how the new solar insolation calculation (shr_orb_avg_cosz) is called from CESM + +Purpose of changes: +- After discussions with Rich Neale and Keith Lindsey, the way shr_orb_cosz is called has been revised + -- shr_orb_cosz now has an optional argument (dt_avg) which if set and is non-zero will be used as + the average time step in the new cosz calculation (there is no longer a module level variable in shr) + -- the namelist use_rad_dt_cosz sets the dt_avg parameter ONLY for the radiation calls to shr_orb_cosz (via + the CAM wrapper routine zenith) + -- Other CESM components (including chemistry) are currently defaulting to the original shr_orb_cosz calculation + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D components/cam/src/physics/cam/zenith.F90 + - This bare subroutine has been made into a module and moved into utils/orbit.F90 + +List all subroutines added and what they do: +A + components/cam/src/utils/orbit.F90 + - This contains the zenith.F90 subroutine and has been made into a module + - Added the optional argument dt_avg which is passed along ot the shr_orb_cosz routine + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - updated to cime0_3_31 which contains the revised shr_orb_cosz call + - shr_orb_cosz now has an optional parameter (dt_avg) which if it is set and is + non-zero will trigger calling the new shr_orb_avg_cosz calculation + +M components/cam/bld/configure + - pio now has an additional directory layer "cime/externals/pio/pio" + +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/rrtmg/radiation.F90 + - dt_avg is now a radiation module level variable and is set via radiation_init if use_rad_dt_cosz is true, + otherwise dt_avg defaults to zero + +M components/cam/src/physics/waccmx/ionosphere.F90 +M components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M components/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + - added use statements for zenith which now resides in the module orbit + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +NOTE -- The results from using the namelist use_rad_dt_cosz will be different than the results in cam5_3_80. + +=============================================================== +=============================================================== + +Tag name: cam5_3_81 +Originator(s): mvertens, cacraig +Date: 04/17/2015 +One-line Summary: minor changes to support pop2 being renamed to pop + +Purpose of changes: +- pop2 is being renamed to pop. CAM had a few places where this needed to be changed + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/configure +M components/cam/bld/config_files/definition.xml +M components/cam/bld/cam.buildnml + - pop2 is now pop + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_80 +Originator(s): zhoulinjiong2010@gmail.com, minghua.zhang@stonybrook.edu, cacraig +Date: 4/14/2015 +One-line Summary: Modifications to bring in new optional solar insolation calculation (shr_orb_cosz) + +Purpose of changes: +- From Minghua Zhang's email: + A new routine (shr_orb_avg_cosz) has been introduced "that eliminates the spurious zonal oscillation of + daily insolation caused by discrete time sampling. The algorithm uses the mean of cosz in a time step. + The module shr_orb_mod.F90 calls this subroutine" +- Added a shr_orb_init routine which is used to set the dt to use in the above calculation. This dt is the + size of the radiation time step. If shr_orb_init is not called, the original shr_orb_cosz calculation is used. +- It is important to note that ALL CESM components will use this modified cosz calculation with the specified + dt value if it is turned on. +- This new shr functionality is controlled via the new CAM namelist logical: use_rad_dt_cosz + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- use_rad_dt_cosz: By default it is false and the original shr_orb_cosz calculation is used. If this parameter + is set to true, then the shr_orb_avg_cosz calculation described above is used for all components in CESM which + call shr_orb_cosz. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, results evaluated by Cecile Hannay and Rich Neale + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - updated to cime0_3_21 which contains the modified shr_orb_cosz + +M components/cam/test/system/input_tests_master + - corrected er736 entry + +M components/cam/bld/namelist_files/namelist_definition.xml + - introduced use_rad_dt_cosz logical to control the type of calculation used + when calling shr_orb_cosz + +M components/cam/src/control/runtime_opts.F90 + - added use_rad_dt_cosz to namelist and pass it into radiation defaultotps/setopts + +M components/cam/src/physics/cam/radiation.F90 +M components/cam/src/physics/rrtmg/radiation.F90 + - if use_rad_dt_cosz is true, then the average radiation timestep is calculated and passed + into shr_orb_mod via the call to shr_orb_init + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: when use_rad_dt_cosz is set to true +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): https://svn-ccsm-models.cgd.ucar.edu/cime/branch_tags/sol_insolation_tags/sol_insolation_n04_cime0_3_13 (ran 1 month of cam5_3_80 and it was BFB with this version) +- platform/compilers: all +- configure commandline: all +- build-namelist command (or complete namelist): use_rad_dt_cosz=.true. + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e13.F2000C5.f09_f09_cam5.4_cam5_3_77.001_n03-2/atm/f.e13.F2000C5.f09_f09_cam5.4_cam5_3_77.001_n03-2-f.e13.F2000C5.f09_f09_cam5.4_cam5_3_77.001/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_79 +Originator(s): richard.easter, po-lun.ma, balwinder.singh, eaton +Date: Fri Apr 10 11:38:10 MDT 2015 +One-line Summary: Add modal aerosol convective scavenging option. + +Purpose of changes: +. Unified treatment for convective transport and scavenging of modal + aerosols: + + The wet removal and transport of modal aerosols by convective clouds in + CAM5 are treated in two different places (though there are linkages + between them). This new parameterization treats the two processes in a + more coherent manner in which aerosol activation within the convective + updraft is treated based on Abdul-Razzak and Ghan (2000) + parameterization. It also treats the secondary activation for aerosols + entrained from the environment. This new parameterization reduces the + aerosol transport to the upper troposphere, and provide improved aerosol + vertical distribution (in better agreement with observations). + + The new parameterization is off by default, and is enabled by setting the + namelist variable convproc_do_aer=.true. + +. The constituents module was extended to allow specifying that the ZM + convective transports should be turned off. This is to support the new + convective scavenging code which does the transport and scavenging + together. + +. Fields that characterize the transports in the ZM deep and UW shallow + convection parameterizations have been added to the physics buffer for + use in either the ZM convtran routine or the new parameterization for + unified convection/scavenging. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add convproc_do_aer to phys_ctl_nl group. Turns on new convective + scavenging option. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cam code review on 1 April 2015. + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90 +. module for the new modal aerosol convective scavenging parameterization + +List all existing files that have been modified, and describe the changes: + +components/cam/bld/Makefile.in +. add missing dependency for perf_mod.o to fix occasional build failures + +components/cam/bld/namelist_files/namelist_definition.xml +. Add convproc_do_aer to phys_ctl_nl group. Turns on new convective + scavenging option. + +components/cam/src/chemistry/aerosol/wetdep.F90 +. Add option to remove the resuspension term from bcscavt and bsscavt and + return it in rcscavt and rsscavt respectively. + +components/cam/src/chemistry/modal_aero/aero_model.F90 +. add diagnostics for convective scavenging +. aero_model_wetdep + . add option in loop over phases (interstitial and cloud borne) to do the + cloud borne first when convective scavenging is active + . add call to new convective scavenging run method + +components/cam/src/chemistry/modal_aero/modal_aero_data.F90 +. move definition of species_class values so they can be used to initialize + the array. + +components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +. add logic to turn off the deep convective transports of the aerosols when + the new convective scavenging is active. +. add call to new convective scavenging init method +. cleanup old code in modal_aero_initialize_q that assumed lat/lon grid + +components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. modify chem diagnostics (call to het_diags) when convective scavenging + active + +components/cam/src/physics/cam/clubb_intr.F90 +. access cmfmc2 from pbuf instead of dummy arg + +components/cam/src/physics/cam/constituents.F90 +. add option to turn off deep convective transport (ZM) of tracers after + wetdep. + +components/cam/src/physics/cam/convect_deep.F90 +. remove unused ref to begchunk, endchunk + +components/cam/src/physics/cam/convect_shallow.F90 +. add CMFMC_SH (cmfmc2) and SH_E_ED_RATIO to pbuf +. remove cmfmc2 from arg list of convect_shallow_tend + +components/cam/src/physics/cam/macrop_driver.F90 +. remove cmfmc2 from arg lists and access from pbuf (CMFMC_SH) instead + +components/cam/src/physics/cam/ndrop.F90 +. make activate_modal public, and add optional arg smax_prescribed +. add missing intents in arg declarations for both activate_modal and maxsat + +components/cam/src/physics/cam/phys_control.F90 +. add convproc_do_aer to namelist and accessor method + +components/cam/src/physics/cam/physpkg.F90 +. remove cmfmc2 from arg lists + +components/cam/src/physics/cam/rk_stratiform.F90 +. remove cmfmc2 from arg lists and access from pbuf (CMFMC_SH) instead + +components/cam/src/physics/cam/uwshcu.F90 +. add sh_e_ed_ratio to output args + +components/cam/src/physics/cam/zm_conv.F90 +. remove lengath from args, and add initializer to ideep to allow lengath + to be computed on the fly. + +components/cam/src/physics/cam/zm_conv_intr.F90 +. move the module data for the convective fluxes into the pbuf +. in zm_conv_tend_2 make use of new cnst_is_convtran2 logical array to + decide which species to transport. + +components/cam/test/system/input_tests_master +. fix specification of tests er736, bl736 + +components/cam/test/system/tests_pretag_goldbach_nag +. remove br354, {sm,er,bl}312 + +components/cam/test/system/tests_pretag_goldbach_pgi +. remove br354, {sm,er,bl}312, {sm,er,bl}367 + +components/cam/test/system/tests_pretag_yellowstone +. remove br353 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS + +goldbach/nag: all PASS + +goldbach/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam5_3_78 +Originator(s): cacraig +Date: 04/09/2015 +One-line Summary: Update externals and introduce revised cam5.4 regression tests + +Purpose of changes: +- Update to cesm1_4_beta02 cime external +- Update to latest cice branch for cime work (cice5 has issues with CAM and will be brought in later) +- Put in 2degree cam5.4 regression tests + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/test/system/config_files/f1.9c5.4dh +A components/cam/test/system/config_files/f1.9c5.4dm + - Introduced current configure options for CAM5.4 for regression testing purposes + - Use 2 degree setup since 1 degree took very long to run on yellowstone + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to cesm1_4_beta02 cime tag + - use latest cice4 branch for cime work + - Bring in only the CLM directories which are used by CAM (more efficient checkout) + +M components/cam/test/system/tests_pretag_goldbach_pgi +M components/cam/test/system/tests_pretag_goldbach_nag + - Add 2 degree CAM5.4 tests + +M components/cam/test/system/input_tests_master + - Change test #353 to use 2 degree files + - Add #354 to be an MPI only test + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - Add two degree initial condition file for 32 levels + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +033 bl353 TBL.sh f1.9c5.4dh outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 8 16:56:51 MDT 2015 + - New test - no baseline for comparision + +goldbach/nag: all BFB except: +051 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Wed Apr 8 12:16:56 MDT 2015 + - New test - no baseline for comparision: + +goldbach/pgi or jaguar/pgi: all BFB except: +058 bl354 TBL.sh f1.9c5.4dm outfrq3s_cam5.4 9s ................................................FAIL! rc= 7 at Thu Apr 9 11:27:16 MDT 2015 + - New test - no baseline for comparision + +=============================================================== +=============================================================== + +Tag name: cam5_3_77 +Originator(s): cacraig, eaton, hannay +Date: 04/07/2015 +One-line Summary: Introduced namelist seasalt_emis_scale and changed value when modal_accum_coarse_exch is true + +Purpose of changes: +- Allow emis_scale in seasalt to be set via the namelist +- Use the tuning parameter that Cecile determined was best when modal_accum_coarse_exch is set to true +- Introduced new cam regression test to test cam5.4 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- Introduced seasalt_emis_scale. It defaults to 1.62 for mam7, 0.9 when modal_accum_coarse_exch is true and otherwise is 1.35. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A components/cam/test/system/config_files/f0.9c5.4dh +A components/cam/test/system/nl_files/outfrq3s_cam5.4 + - setup for new regression tests + +List all existing files that have been modified, and describe the changes: +M components/cam/test/system/TSM.sh + - removed debug flag which was inadvertently checked in + +M components/cam/test/system/tests_pretag_yellowstone +M components/cam/test/system/input_tests_master + - added cam5.4 regression test + +M components/cam/bld/namelist_files/namelist_defaults_cam.xml +M components/cam/bld/namelist_files/namelist_definition.xml +M components/cam/bld/build-namelist +M components/cam/src/chemistry/modal_aero/aero_model.F90 +M components/cam/src/chemistry/modal_aero/seasalt_model.F90 + - added seasalt_emis_scale as a namelist tuning parameter + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +065 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Mon Apr 6 15:09:31 MDT 2015 + - seasalt_emis_scale tuning parameter is changed when modal_accum_coarse_exch is set to true + +goldbach/nag: all BFB except: +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Mon Apr 6 16:48:12 MDT 2015 + - seasalt_emis_scale tuning parameter is changed when modal_accum_coarse_exch is set to true + +goldbach/pgi or jaguar/pgi: all BFB + +Summarize any changes to answers, i.e., +- what code configurations: answer changing when modal_accum_coarse_exch is set to true +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: -phys cam5 -microphys mg2 -chem trop_mam4 -nlev 32 -cppdefs -DUSE_XLIU_MOD +- build-namelist command (or complete namelist): + use_preexisting_ice = .true. + use_hetfrz_classnuc = .true. + cldfrc_rhminl_adj_land = 0.00D0 + modal_accum_coarse_exch = .true. +- MSS location of output: + + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e13.F2000C5.f09_f09_beta16.cam5.4_mills01_cam5_3_70.011/atm/f.e13.F2000C5.f09_f09_beta16.cam5.4_mills01_cam5_3_70.011-obs/ +NOTE -- Cecile plans to rerun these diagnostics with this tag and the ChangeLog will be updated to reflect these results. Also will include the details on her previous runs once she supplies it. + +=============================================================== +=============================================================== + +Tag name: cam5_3_76 +Originator(s): mills, hannay, cacraig +Date: 04/03/2015 +One-line Summary: limit the mode exchange between coarse accumulation in the stratosphere + +Purpose of changes: +- limit the mode exchange between coarse accumulation in the stratosphere +- bug fix from Mike Mills + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/src/chemistry/modal_aero/modal_aero_rename.F90 + - bug fix and limiting the mode exchange + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +061 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Fri Apr 3 16:36:50 MDT 2015 + - Uses modal_accum_coarse_exch=.true. and answers were expected to change when this flag is set + +goldbach/nag: all BFB except: +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Fri Apr 3 13:55:28 MDT 2015 + - Uses modal_accum_coarse_exch=.true. and answers were expected to change when this flag is set + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: when modal_accum_coarse_exch=.true. +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): unknown - part of the climate changing mods made in cam5_3_75, 76 and 77 and tested in aggregate by hannay + +tag for the documentation of these runs will occur in upcoming tag (currently slated to be cam5_3_77) + +=============================================================== +=============================================================== + +Tag name: cam5_3_75 +Originator(s): s.albani@cornell.edu, hannay, cacraig +Date: 4/2/2015 +One-line Summary: Updated soil erodobility file + +Purpose of changes: +- new dust erodibility file - improves the dust in the Middle East + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - new default file for soil_erod_file + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M components/cam/bld/namelist_files/namelist_defaults_cam.xml + - new dust erodibility file from Samuel Albani (s.albani@cornell.edu) + +M components/cam/doc/ReleaseNotes + - updated with COSP and dust notes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Thu Apr 2 16:47:48 MDT 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Thu Apr 2 17:21:18 MDT 2015 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Thu Apr 2 17:48:17 MDT 2015 +036 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Thu Apr 2 18:04:47 MDT 2015 +038 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Thu Apr 2 18:07:47 MDT 2015 +040 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Thu Apr 2 18:14:13 MDT 2015 +053 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Apr 2 18:46:39 MDT 2015 +055 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Thu Apr 2 18:56:03 MDT 2015 +058 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Thu Apr 2 19:13:52 MDT 2015 +061 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Thu Apr 2 19:26:46 MDT 2015 +064 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Thu Apr 2 19:51:17 MDT 2015 +085 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Thu Apr 2 20:39:00 MDT 2015 + +goldbach/nag: +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Apr 2 13:59:02 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Apr 2 14:07:01 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Apr 2 14:19:24 MDT 2015 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Thu Apr 2 14:55:58 MDT 2015 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Thu Apr 2 15:46:29 MDT 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Thu Apr 2 16:33:27 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Apr 2 17:15:28 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Thu Apr 2 17:48:31 MDT 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Thu Apr 2 18:29:32 MDT 2015 + +goldbach/pgi or jaguar/pgi: +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Apr 2 14:04:09 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Apr 2 14:13:51 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Apr 2 14:33:24 MDT 2015 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Thu Apr 2 15:10:31 MDT 2015 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Apr 2 15:54:44 MDT 2015 +054 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Thu Apr 2 16:11:08 MDT 2015 +057 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Thu Apr 2 16:51:33 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Apr 2 17:12:15 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Apr 2 17:29:58 MDT 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all configurations which use prognostic dust +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate +tag for the documentation of these runs (currently slated to be cam5_3_77) + +=============================================================== +=============================================================== + +Tag name: cam5_3_74 +Originator(s): mvertens, cacraig +Date: March 24, 2015 +One-line Summary: ** REORGANIZATION OF models/atm/cam TO components/cam ** and introducing new CESM testing framework + +Purpose of changes: +- All files which were in models/atm/cam/ have been moved to components/cam/ +- All externals other than main model components are now in cime/ +- Introduced new CESM testing framework +- Removed janus, titan and hopper tests from cime testing and renamed FC51850 to F1850C5 to match the compset name per Jay's request + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + *** ALL FILES MOVED FROM /models/atm/cam to /components/cam *** + + M . +M SVN_EXTERNAL_DIRECTORIES + - new external list matches CESM1_4_beta01 + +M + components/cam/test/system/TPF.sh +M + components/cam/test/system/test_driver.sh +M + components/cam/test/system/TBL_ccsm.sh +M + components/cam/test/system/TFM.sh +M + components/cam/test/system/TSM.sh +M + components/cam/test/system/gen-test-coverage +M + components/cam/test/system/TR8.sh +M + components/cam/test/system/TCB_ccsm.sh +M + components/cam/test/system/TBL.sh +M + components/cam/test/system/gen-test-table +M + components/cam/test/system/gen_test_table.sh +M + components/cam/bld/configure +M + components/cam/bld/Makefile.in +M + components/cam/bld/run-ibm.csh +M + components/cam/bld/run-yellowstone.csh +M + components/cam/bld/get_nxny.pl +M + components/cam/bld/run-lynx.csh +M + components/cam/bld/perl5lib/Build/ChemPreprocess.pm +M + components/cam/bld/run-pc.csh +M + components/cam/bld/run-scam.csh +M + components/cam/bld/run-darwin.csh +M + components/cam/bld/build-namelist +M + components/cam/bld/run-cray.csh + - changes required due to moving models/atm/cam/ to components/cam/ + +M + components/cam/cimetest/testlist_cam.xml + - removed janus, hopper and titan tests per Jay's request + - Corrected typo FC51850 to F1850C5 (the correct compset name) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB + +goldbach/nag: All BFB + +goldbach/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_73 +Originator(s): jenkay, Po-lun, G. Cesana and H. Chepfer (LMD, Helene.Chepfer@lmd.polytechnique.fr), cacraig +Date: 03/23/15 +One-line Summary: Update cosp from 1.3 to 1.4 + +Purpose of changes: + +CESM-relevant changes from COSP1.3 to COSP1.4 taken from the CFMIP website (http://cfmip.metoffice.com/) are: +1) In radar simulator: new attenuation integration scheme and other optimsations, possibility of using a look up table, partial support of two-moment microphysics, selection of microphysics via cosp_defs.h. +2) Optimised version of cosp_change_vertical_grid in cosp_stats +3) New CALIPSO cloud phase diagnostics: large list of new cloud diagnostics developed by Gregory Cesana (Cesana and Chepfer, doi:10.1002/jgrd.50376) +4) New timing variables that allow to get a quick estimate of the performance of each simulator. + +In addition - the COSP1.4 in CESM implementation has: +1) radiatively active snow in all simulators (described in Kay et al. 2012 doi: http://dx.doi.org/10.1175/JCLI-D-11-00469.1) with lidar snow treatment error fix (described in English et al. 2014 doi: http://dx.doi.org/10.1175/JCLI-D-13-00608.1) +2) bug fix identified by Po-Lun for convective ice input into COSP + +Bugs fixed (include bugzilla ID): + +- bug fix identified by Po-Lun for convective ice input into COSP +There are differences in the MODIS simulator outputs related to Po-Lun's bug fix. +From Robert Pincus's e-mail on 11/16/14: " The sense of the bug is to essentially +double the mixing ratio of convective water cloud but to call half of it ice. The +MODIS simulator diagnoses phase based on the relative amounts of extinction near +cloud top by cloud liquid and cloud ice. When the ratio of extinction is greater +than 70% for either ice or water we say we know the phase; if it's less we say it's +undetermined but assume water. The bug puts a bunch of convective "ice" low in the +troposphere and pairs it with equal amounts of convective liquid and possible +large-scale liquid, so it'll always be diagnosed as liquid (or undetermined and then +assumed liquid). So it makes sense that the LWP goes down, although it also implies +that there's a *lot* of convective LWP (145-130, or about 15 g/m2). The reduction in +particle size makes sense, too: with the bug, the optical properties are determined +by a mix of liquid and "ice", where the ice single scattering albedo (the quantity +relevant for the re retrieval) is consistent with large ice particles." + + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M . + M models/atm/cam +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated the cosp externals + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TSM.sh + - added printing of commands to better document what is being run + +M models/atm/cam/test/system/tests_pretag_yellowstone + - added cosp testing (was in posttag which is no longer run) + +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + - modifications to support cosp1.4 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: +050 bl397 TBL.sh f1.9c4cm outfrq3s_cosp+1850-2005_cam4 9s .....................................FAIL! rc= 7 at Fri Mar 20 23:20:02 MDT 2015 + +goldbach/nag: all BFB except: +037 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Fri Mar 20 18:10:19 MDT 2015 + +goldbach/pgi or jaguar/pgi: all BFB except: +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Mar 20 18:21:38 MDT 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: cosp +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): just in cosp diagnostics + +Location of cosp1.3/cosp1.4 diagnostic plots: +http://www.cgd.ucar.edu/staff/jenkay/cosp/diag/cosp_n03_cam5_3_70_intel_test-cam5_3_70_intel_control/sets.htm + +=============================================================== +=============================================================== + +Tag name: cam5_3_72 +Originator(s): fvitt, dkin +Date: 13 Mar 2015 +One-line Summary: CCMI chemistry updates and PORT bug fix + +Purpose of changes: + +- Add namelist options for BULK aerosol solubility factors. + +- Replace "cldfrc_rhminp" namelist option with "rk_strat_polstrat_rhmin". + This gives the user an opportunity to use a different rhmin threshold for + dehydration in the polar stratosphere (poleward of 50 degrees on pressure + levels above 300 mbar). Previously this was applied to cloud fraction + which lead to unrealistic cloud fractions in the polar stratosphere. + +- Change the vertical boundary separating the stratospheric aerosols and + tropospheric BULK aerosols in the polar region (poleward of 50 degrees) + from the tropopause to 300 mbars applied to the surface area densities used + in chemistry. + +- Update stratospheric aerosol chemistry rate constants (dkin) + +- Chemistry mechanism updates to packages: + trop_strat_soa + waccm_mozart + waccm_tsmlt_mam3 + waccm_tsmlt + waccm_tsmlt_sulfur + +- Fix a bug in PORT -- initialize physics buffer fields used + in "fixed dynamical heating" calculation + +- Correct units of NEU wet deposition diagnostics + +Bugs fixed (include bugzilla ID): + - initialize physics buffer fields used in "fixed dynamical heating" calculation of PORT + - correction in units of DTWR_* diagnostics NEU wet deposition module + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Namelist options were added for BULK aerosol solubility factor lists 'aer_sol_facti' + and 'aer_sol_factb' for respectively in-cloud and below-cloud solubility factors. + For convenience the following options were added for different aerosol types which + are mapped appropriately to the 'aer_sol_facti' and 'aer_sol_factb' lists: + . SO4_sol_facti : in-cloud solubility factor for SO4 + . SO4_sol_factb : below-cloud solubility factor for SO4 + . NH4_sol_facti : in-cloud solubility factor for NH4 + . NH4_sol_factb : below-cloud solubility factor for NH4 + . NH4NO3_sol_facti : in-cloud solubility factor for NH4NO3 + . NH4NO3_sol_factb : below-cloud solubility factor for NH4NO3 + . CB2_sol_facti : in-cloud solubility factor for black carbon + . CB2_sol_factb : below-cloud solubility factor for black carbon + . OC2_sol_facti : in-cloud solubility factor for organic carbon + . OC2_sol_factb : below-cloud solubility factor for organic carbon + . dust_sol_facti : in-cloud solubility factor for dust + . dust_sol_factb : below-cloud solubility factor for dust + . sslt_sol_facti : in-cloud solubility factor for sea salt + . sslt_sol_factb : below-cloud solubility factor for sea salt + + Replaced "cldfrc_rhminp" option with "rk_strat_polstrat_rhmin". + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton and others in the CAM code review team + +List all subroutines eliminated: +D models/atm/cam/test/system/tests_titan_cb +D models/atm/cam/test/system/tests_pretag_titan_pgi_cb + - these obsolete test lists were removed + +D models/atm/cam/src/physics/cam/stratiform.F90 + - this has been renamed rk_stratiform + +List all subroutines added and what they do: +A models/atm/cam/src/physics/cam/rk_stratiform.F90 + - was previously stratiform.F90 + - moved cldwat namelist to stratiform + - added rk_strat_polstrat_rhmin namelist option + +A models/atm/cam/test/system/config_files/f1.9c4portdh +A models/atm/cam/test/system/config_files/f1.9c4portdm +A models/atm/cam/test/system/nl_files/port_cam4 + - added for testing PORT + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_pretag_yellowstone + - changed PORT test + +M models/atm/cam/test/system/input_tests_master + - "cb" tests removed -- these are no longer needed + - PORT tests added + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - cldwat_* namelist options renamed to rk_strat_* + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - cldwat_* namelist options renamed to rk_strat_* + - added rk_strat_polstrat_rhmin option + - removed cldfrc_rhminp and cldfrc_rhminp_botmb options + - added bulk aerosol solubility factor lists 'aer_sol_facti' and 'aer_sol_factb' + for respectively in-cloud and below-cloud solubility factors. + For use convience the following options were added for different aerosol types: + . SO4_sol_facti : in-cloud solubility factor for SO4 + . SO4_sol_factb : below-cloud solubility factor for SO4 + . NH4_sol_facti : in-cloud solubility factor for NH4 + . NH4_sol_factb : below-cloud solubility factor for NH4 + . NH4NO3_sol_facti : in-cloud solubility factor for NH4NO3 + . NH4NO3_sol_factb : below-cloud solubility factor for NH4NO3 + . CB2_sol_facti : in-cloud solubility factor for black carbon + . CB2_sol_factb : below-cloud solubility factor for black carbon + . OC2_sol_facti : in-cloud solubility factor for organic carbon + . OC2_sol_factb : below-cloud solubility factor for organic carbon + . dust_sol_facti : in-cloud solubility factor for dust + . dust_sol_factb : below-cloud solubility factor for dust + . sslt_sol_facti : in-cloud solubility factor for sea salt + . sslt_sol_factb : below-cloud solubility factor for sea salt + +M models/atm/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml + - updates from CCMI simulations + - cldwat_* renamed to rk_strat_* + +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml +M models/atm/cam/bld/namelist_files/use_cases/cam3.xml + - cldwat_* renamed to rk_strat_* + +M models/atm/cam/bld/build-namelist + - set defaults for aer_sol_facti and aer_sol_factb lists which are returned + from ChemNameList::set_dep_list routine + - add default 'prescribed_strataero_file' rather than 'sulf_file' for trop_strat_soa chem + - cldwat_* namelist options renamed to rk_strat_* + - correction in prescribed_aero_model setting when aerosols are not prognosed + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + +M models/atm/cam/src/control/runtime_opts.F90 + +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/cam/radiation.F90 + - pass pbuf2d to rad_data_init + +M models/atm/cam/src/physics/cam/radiation_data.F90 + - PORT fix + -- initialize pbuf fields used in "fixed dynamical heating" calculations + +M models/atm/cam/src/physics/cam/physpkg.F90 + - references to stratiform changed to rk_stratiform + - radiation_init interface change + +M models/atm/cam/src/physics/cam/cloud_fraction.F90 + - reverted back to cam5_3_40 (pre-CCMI version) + +M models/atm/cam/src/physics/cam/cldwat.F90 + - namelist moved upto rk_stratiform + - added option (rk_strat_polstrat_rhmin) to use different rhmin + poleward of 50 degrees on pressure levels above 300 mbar for + dehydration in the polar stratosphere in special cases. + Previously this was applied to cloud fraction which lead to + unrealistic cloud fractions in the polar regions. + +M models/atm/cam/src/chemistry/utils/prescribed_strataero.F90 + - zero out stratospheric aerosols on pressure levels below the + 300 mbar level poleward of 50 degrees, elsewhere pressure levels + above the tropopause + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - zero out tropospheric sulfate on pressure levels above 300 mbar level + and poleward of 50 degrees, elesewhere on levels above the tropopause + - added SULF_TROP diagnostic + - changes for ratecon_sfstrat subroutine interface change + - added diagnostics for stratospheric aerosol reaction rates + +M models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 + - aer_sol_facti and aer_sol_factb namelist options added + - zero out tropospheric surface area densities on pressure levels above 300 mbar level + and poleward of 50 degrees, elesewhere on levels above the tropopause + +M models/atm/cam/src/chemistry/modal_aero/aero_model.F90 + - interface change in aero_model_surfarea subroutine to be consistent + with bulk aerosol model + +M models/atm/cam/src/chemistry/mozart/mo_strato_rates.F90 + - science changes provided by D Kinnison + - output diagnostics through ratecon_sfstrat subroutine interface + +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - correction in units of DTWR_* diagnostics + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - interface change to pass column latitudes to aero_model_surfarea + +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + - references to stratiform changed to rk_stratiform + +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.in +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.in +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in + - chemistry mechanism updates + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +036 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Fri Mar 13 13:43:10 MDT 2015 +040 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Fri Mar 13 13:52:03 MDT 2015 + - expected failures due to the vertical boundary between stratospheric aerosols + and tropospheric aerosols in the polar region moved from the tropopause to 300 mbars + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Fri Mar 13 12:32:35 MDT 2015 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Fri Mar 13 13:14:25 MDT 2015 +046 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Mar 13 14:07:49 MDT 2015 +054 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Mar 13 14:44:00 MDT 2015 +057 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Fri Mar 13 14:56:00 MDT 2015 +070 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Fri Mar 13 15:45:59 MDT 2015 + - expected failures due to the CCMI updates: + . changes in the chemistry mechanisms + . updates in the stratospheric aerosol chemistry rate constants + . the vertical boundary between stratospheric aerosols and tropospheric aerosols + in the polar region moved from the tropopause to 300 mbars + . the dehydration threshold rhmin in the polar stratosphere in no longer applied to + cloud fraction and is applied poleward of 50 degrees (previously 60 degrees) + +092 bl012 TBL.sh f1.9c4portdh port_cam4 5d ....................................................FAIL! rc= 7 at Fri Mar 13 16:28:55 MDT 2015 + - expected failure -- new PORT test + +goldbach/nag: +059 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Mar 13 13:09:44 MDT 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Fri Mar 13 13:25:18 MDT 2015 + - expected failures due to waccm chemistry mechanism update + +goldbach/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_71 +Originator(s): fvitt, mmills +Date: 12 Mar 2015 +One-line Summary: Provide CAM5 with the capability to include source + of water vapor in the stratosphere from methane oxidation + +Purpose of changes: +- Add option for external forcing of H2O from CH4 oxidation when running + low-top CAM5 without chemistry. CH4 oxidation is an important source of + H2O in the stratosphere. By default this additional source of water + vapor is off. This is turned on by adding H2O and corresponding external + forcing file to the "ext_frc_specifier" namelist option. +(NOTE: The chemistry now prognoses H2O and applies a tendency to water vapor, + which gives an additional and insignificant source of water vapor from + the oxidation of H2O2 (H2O2 + OH -> H2O + HO2) that is always applied + to CAM5.) +- Add default physics properties files for stratospheric modal aerosols +- Add external forcing of SO2 by OCS oxidation when running CAM5 without + chemistry when stratospheric modal aerosols are active (off by default) +- Add OCS to chem packages: + trop_mozart_soa + trop_mozart_mam3 + trop_strat_soa + trop_strat_mam3 + trop_strat_mam7 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - default phys props files added for stratospheric modal aerosols + - default SO2 forcing file corresponding to OCS oxidation source + - default photolysis rsf_file the same for all chem packages + +M models/atm/cam/bld/build-namelist + - when modal_strat_sulfate is true include OCS oxidation forcing file for SO2 + +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.in + - change H2O from fixed to prognostic in the stratosphere which provides the + capability to include H2O from oxidation of methane (via external forcing) + +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in + - added OCS and associated reactions + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Wed Mar 11 14:17:49 MDT 2015 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Mar 11 14:43:11 MDT 2015 +038 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed Mar 11 15:01:16 MDT 2015 +049 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Mar 11 15:33:13 MDT 2015 +051 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Wed Mar 11 15:42:13 MDT 2015 +076 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Wed Mar 11 17:14:56 MDT 2015 +081 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed Mar 11 17:18:27 MDT 2015 + - expected failures in MAM without chemistry configurations due to making H2O prognostic + in the chemistry which gives an additional small source of H2O from H2O2+OH reaction. + There is also a change in photolysis rsf_file input file. + +054 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Wed Mar 11 15:59:17 MDT 2015 + - expected failure due to chemistry mechanism change -- additions of OCS and associated reactions + +057 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Wed Mar 11 16:11:16 MDT 2015 + - expected failure due to change in physics property input file for stratospheric modal aerosols + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Mar 11 16:31:09 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Mar 11 16:31:13 MDT 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Mar 11 16:31:18 MDT 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Mar 11 16:31:19 MDT 2015 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Wed Mar 11 16:31:25 MDT 2015 +034 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed Mar 11 16:31:26 MDT 2015 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Wed Mar 11 16:31:27 MDT 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed Mar 11 16:31:34 MDT 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 11 16:31:36 MDT 2015 + - expected failures in MAM without chemistry configurations due to making H2O prognostic + in the chemistry which gives an additional small source of H2O from H2O2+OH reaction. + There is also a change in photolysis rsf_file input file. + +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Wed Mar 11 16:46:22 MDT 2015 + - expected failure due to change in physics property input file for stratospheric modal aerosols + +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Wed Mar 11 16:46:39 MDT 2015 + - expected failure due to change in photolysis rsf_file input file + +goldbach/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Mar 11 11:30:54 MDT 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Mar 11 11:48:58 MDT 2015 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Wed Mar 11 12:02:04 MDT 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Mar 11 12:04:06 MDT 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Mar 11 12:33:27 MDT 2015 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Wed Mar 11 13:21:02 MDT 2015 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed Mar 11 14:18:17 MDT 2015 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed Mar 11 14:39:05 MDT 2015 +054 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Wed Mar 11 15:01:14 MDT 2015 +057 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Wed Mar 11 15:41:00 MDT 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 11 16:04:02 MDT 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 11 16:27:11 MDT 2015 + - expected failures in MAM without chemistry configurations due to making H2O prognostic + in the chemistry which gives an additional small source of H2O from H2O2+OH reaction. + There is also a change in photolysis rsf_file input file. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: cam5 +- what platforms/compilers: all +- nature of change: larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag: https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mills_cam5_3_67_tags/mills01_cam5_3_70 +- platform/compilers: yellowstone/intel +- configure commandline: + create_newcase -mach yellowstone -compset FC5 -res f19_f19 -case /glade/p/acd/fvitt/cesm/cases/f.e13.c5370.FC5.f19_f19.test.01 +- build-namelist command: default namelist +- MSS location of output: + [HSI]/home/fvitt/csm/f.e13.c5370.FC5.f19_f19.test.01 + +MSS location of control simulations used to validate new climate: + [HSI]/home/fvitt/csm/f.e13.c5370.FC5.f19_f19.cntl.01 + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e13.c5370.FC5.f19_f19.test.01/atm/f.e13.c5370.FC5.f19_f19.test.01-f.e13.c5370.FC5.f19_f19.cntl.01/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_70 +Originator(s): santos (cacraig ran testing) +Date: March 5, 2015 +One-line Summary: performance improvements and unit testing for micro_mg_utils; splitting sedimentation loop; minor cleanup + +Purpose of changes: +Aside from some minor diagnostic/cleanup changes, the main differences are: + 1) Speeding up micro_mg_utils, especially by reducing gamma and pow calls. + 2) The sedimentation loop is split up, so that constituents other than rain go through fewer iterations. + - combined #1 and #2 give about a 14% speedup in MG2 (maybe 2% in CAM, depending on configuration) + 3) Basic unit tests added for micro_mg_utils. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: +A models/atm/cam/test/unit/micro_mg_utils +A models/atm/cam/test/unit/micro_mg_utils/test_mg_size_utils.pf +A models/atm/cam/test/unit/micro_mg_utils/test_mg_processes.pf +A models/atm/cam/test/unit/micro_mg_utils/CMakeLists.txt + - added unit tests for micro_mg_utils + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/unit/micro_mg_data/test_MGPacker.pf + - uses packer%pack_interface now + +M models/atm/cam/test/unit/CMakeLists.txt +M models/atm/cam/src/physics/cam/CMakeLists.txt + - added unit testing for micro_mg_utils + +M models/atm/cam/src/physics/cam/micro_mg2_0.F90 + - various cleanup + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - ADRAIN and ADSNOW are now output by default to allow them to be added to AMWG diagnostics + - added QRSEDTEN and QSSEDTEN (rain and snow ratio tendencies from sedimentation) for all MG except MG1.0 + +M models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - speedup changes + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Wed Mar 4 20:06:45 MST 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Wed Mar 4 20:29:35 MST 2015 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Wed Mar 4 20:54:37 MST 2015 +038 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Wed Mar 4 21:12:50 MST 2015 +049 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Wed Mar 4 21:44:24 MST 2015 +051 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Wed Mar 4 21:53:23 MST 2015 +057 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Wed Mar 4 22:21:32 MST 2015 +060 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Wed Mar 4 22:45:17 MST 2015 +076 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Wed Mar 4 23:25:12 MST 2015 +081 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Wed Mar 4 23:28:42 MST 2015 + +goldbach/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Mar 4 17:12:00 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Mar 4 17:18:52 MST 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Mar 4 17:24:38 MST 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Mar 4 17:33:46 MST 2015 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Wed Mar 4 17:58:13 MST 2015 +034 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed Mar 4 18:11:27 MST 2015 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Wed Mar 4 18:36:09 MST 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed Mar 4 19:07:49 MST 2015 +053 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed Mar 4 19:26:03 MST 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 4 19:34:56 MST 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Wed Mar 4 19:59:54 MST 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Wed Mar 4 20:22:24 MST 2015 + +goldbach/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Wed Mar 4 17:12:05 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Wed Mar 4 17:18:30 MST 2015 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Wed Mar 4 17:23:24 MST 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Wed Mar 4 17:24:56 MST 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Wed Mar 4 17:36:24 MST 2015 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Wed Mar 4 18:01:30 MST 2015 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Wed Mar 4 18:23:47 MST 2015 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed Mar 4 18:31:13 MST 2015 +048 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Wed Mar 4 18:37:19 MST 2015 +051 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Wed Mar 4 18:38:54 MST 2015 +054 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Wed Mar 4 18:40:57 MST 2015 +057 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Wed Mar 4 19:10:54 MST 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 4 19:24:03 MST 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Mar 4 19:35:47 MST 2015 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed Mar 4 20:01:51 MST 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + - all cam5 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - Number 1(listed in Purpose of Changes) is roundoff-level + - Number 2 has a small effect on precipitation, but does not seem to significantly impact climate. + +=============================================================== +=============================================================== + +Tag name: cam5_3_69 +Originator(s): bsander, santos, cacraig +Date: March 4, 2015 +One-line Summary: Bug fix for exponentials in rrtmg_sw_reftra + +Purpose of changes: +- The use of low precision lookup tables for exponential terms in + the clear sky reflectivity calculation was determined to be the + cause of rare occurances of extreme hot surface + temperatures (exceeding 100 C). The fix is to replace the + lookup table by double precision exponentials. We attempted to + reduce the cost of the exponential calculation by using a + single precision version of the function. This attempt failed + due to argument values outside the domain of the single + precision exp function. The initial 5 day timings indicated + maybe a 1% slowdown, but timings from the 5 year runs indicated + that any difference in time was in the run-time noise. + + +Bugs fixed (include bugzilla ID): +- Bug when using the exponential lookup table was removed + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton (through verbal discussions) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M models/atm/cam +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - using the updated rrtmg external library which contains the bug fix + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Tue Mar 3 19:17:02 MST 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Tue Mar 3 19:39:27 MST 2015 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Mar 3 20:04:44 MST 2015 +038 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Mar 3 20:22:25 MST 2015 +049 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Mar 3 20:53:08 MST 2015 +051 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Mar 3 21:02:01 MST 2015 +057 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Tue Mar 3 21:30:11 MST 2015 +060 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Tue Mar 3 21:53:51 MST 2015 +076 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Mar 3 22:33:06 MST 2015 +081 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Mar 3 22:36:34 MST 2015 +092 bl010 TBL.sh f4c5portdh outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Mar 3 23:02:20 MST 2015 + + +goldbach/nag: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Mar 3 16:36:03 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Mar 3 16:46:03 MST 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Mar 3 16:52:41 MST 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Mar 3 17:02:31 MST 2015 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Mar 3 17:27:43 MST 2015 +034 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Mar 3 17:40:41 MST 2015 +040 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Mar 3 17:59:40 MST 2015 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Mar 3 18:06:59 MST 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Mar 3 18:39:50 MST 2015 +053 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Mar 3 19:01:42 MST 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Mar 3 19:12:19 MST 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Tue Mar 3 19:36:02 MST 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Mar 3 20:00:51 MST 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Mar 3 20:09:15 MST 2015 + + +goldbach/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Mar 3 16:36:53 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Mar 3 16:46:56 MST 2015 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Mar 3 16:52:58 MST 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Mar 3 16:54:58 MST 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Mar 3 17:11:08 MST 2015 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Mar 3 17:39:11 MST 2015 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Mar 3 18:02:51 MST 2015 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Mar 3 18:10:30 MST 2015 +048 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Mar 3 18:16:54 MST 2015 +051 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Mar 3 18:18:34 MST 2015 +054 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Mar 3 18:21:08 MST 2015 +057 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Mar 3 18:52:29 MST 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Mar 3 19:06:36 MST 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Mar 3 19:18:40 MST 2015 +066 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Mar 3 19:42:51 MST 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Mar 3 19:49:41 MST 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: rrtmg radiation (cam5) +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Changes all implementations which use the rrtmg implementation of radiation (cam5). According to Rich Neale who inspected the 5 year comparison runs, the "simulations look pretty near identical" + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + * https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/reftra_lookup_fix_tags/reftra_lookup_fix_n03_cam5_3_66 +- platform/compilers: yellowstone / intel +- configure commandline: create_newcase -case /glade/scratch/cacraig/cam_dev/cases/cam5_3_66_reftra_5years -mach yellowstone -res f09_f09 -compset FC5 -project P93300606 +- build-namelist command (or complete namelist): default namelist aside from setting stop option to 1 year and resubmitting 4 times +- MSS location of output: + /home/cacraig/csm/cam5_3_66_reftra_5years + +MSS location of control simulations used to validate new climate: + /home/cacraig/csm/cam5_3_66_test_5years + +URL for AMWG diagnostics output used to validate new climate: + http://webext.cgd.ucar.edu/FCLIMO/cam5_3_66_reftra_5years-cam5_3_66_test_5years/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_68 +Originator(s): Natalie Mahowald, Steve Ghan, Xiaohong Liu, Po-Lun Ma, Cecile Hannay +Date: Mar 2, 2015 +One-line Summary: new soil erodibility map; new optical properties for MAM3 and MAM4; changes ice nucleation for MAM4; tuning for cam5/mg2 (cldfrc_rhminl) + +Purpose of changes: +- Soil erodibility map, tuned following Albani et al., 2014 to best match observations. +- New optical properties with less absorbing optics for MAM3 and MAM4 (use aeronet dust optics and dust in the aitken mode 2). +- Changes to make the ice nucleation compatible with MAM4 +- Tuning for cam5/mg2 (cldfrc_rhminl) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/src/physics/cam/hetfrz_classnuc_cam.F90 +M models/atm/cam/src/chemistry/modal_aero/dust_model.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Mon Mar 2 10:38:06 MST 2015 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Mon Mar 2 10:38:13 MST 2015 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Mon Mar 2 10:38:17 MST 2015 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Mon Mar 2 10:38:28 MST 2015 +036 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Mon Mar 2 10:38:41 MST 2015 +038 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Mon Mar 2 10:41:14 MST 2015 +040 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Mon Mar 2 10:41:25 MST 2015 +049 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Mar 2 10:41:33 MST 2015 +051 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Mon Mar 2 10:41:48 MST 2015 +054 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Mon Mar 2 10:42:16 MST 2015 +057 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Mon Mar 2 10:44:26 MST 2015 +060 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Mon Mar 2 10:44:51 MST 2015 +076 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Mon Mar 2 10:44:58 MST 2015 +081 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Mon Mar 2 10:45:21 MST 2015 +092 bl010 TBL.sh f4c5portdh outfrq24h_port 2d .................................................FAIL! rc= 7 at Mon Mar 2 10:45:22 MST 2015 + + +goldbach/nag: +001 fm001 TFM.sh ..............................................................................FAIL! rc= 2 at Fri Feb 27 14:28:21 MST 2015 +- This was expected to fail as this tag was checked out on yellowstone and the subversion version is not compatible with goldbach +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Fri Feb 27 14:34:00 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Fri Feb 27 14:37:36 MST 2015 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Fri Feb 27 14:41:19 MST 2015 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Feb 27 14:48:18 MST 2015 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Fri Feb 27 15:12:17 MST 2015 +043 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Fri Feb 27 15:44:18 MST 2015 +050 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Fri Feb 27 16:19:07 MST 2015 +056 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 27 16:52:26 MST 2015 +062 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Fri Feb 27 17:11:25 MST 2015 +065 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Fri Feb 27 18:12:05 MST 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Fri Feb 27 18:20:30 MST 2015 + +goldbach/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Fri Feb 27 14:38:24 MST 2015 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Fri Feb 27 14:45:17 MST 2015 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Fri Feb 27 14:52:43 MST 2015 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Feb 27 15:04:51 MST 2015 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Fri Feb 27 15:34:52 MST 2015 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Feb 27 16:05:07 MST 2015 +054 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Fri Feb 27 16:16:23 MST 2015 +057 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Feb 27 16:51:38 MST 2015 +060 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 27 17:06:42 MST 2015 +063 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Feb 27 17:20:14 MST 2015 +068 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Fri Feb 27 18:21:20 MST 2015 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - new climate + +AMWG diagnostics for the new climate: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.F2000C5.f09_f09_cam5.3.68.001/atm/f.e13.F2000C5.f09_f09_cam5.3.68.001-obs/ + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.F2000C5.f09_f09_cam5.3.68.001/atm/f.e13.F2000C5.f09_f09_cam5.3.68.001-f.e13.F2000C5.f09_f09.cam5.3.release.001/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_67 +Originator(s): olson, cacraig +Date: Feb 25, 2015 +One-line Summary: Reformulate total energy as applied in physics_update and the energy fixers for CAM-FV and CAM-SE dycores. + +Purpose of changes: +- To "correct" the total energy definition in scattered regions of the model + +Bugs fixed (include bugzilla ID): +- 2148: lengthened character variable "tcase" to handle longer filenames + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton, Santos + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/advection/slt/engy_te.F90 + - modify total energy calculation +M models/atm/cam/src/control/cam_restart.F90 + - fixed bug #2148 lengthened character variable "tcase" +M models/atm/cam/src/dynamics/eul/dp_coupling.F90 + - check for neg tracers +M models/atm/cam/src/dynamics/eul/linemsdyn.F90 +M models/atm/cam/src/dynamics/eul/spegrd.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 + - check for neg tracers +M models/atm/cam/src/dynamics/se/dp_coupling.F90 + - check for neg tracers +M models/atm/cam/src/dynamics/sld/dp_coupling.F90 + - check for neg tracers +M models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M models/atm/cam/src/dynamics/sld/spegrd.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - modify some diagnostics +M models/atm/cam/src/physics/cam/check_energy.F90 + - modify total energy for energy conservation check +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 + - fix diagnostics bug +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - clerical corrections +M models/atm/cam/src/physics/cam/physics_types.F90 + - update temperature based on new energy definition +M models/atm/cam/src/physics/cam/physpkg.F90 + - remove Boville heating kluge for FV + - fix DTCORE diagnostic + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all TBL tests *FAILED* due to answer changes by energy fix + +goldbach/nag: all TBL tests *FAILED* due to answer changes by energy fix + +goldbach/pgi or jaguar/pgi: all TBL tests *FAILED* due to answer changes by energy fix + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: +http://www.cesm.ucar.edu/working_groups/Atmosphere/development/cam6/eb/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_66 +Originator(s): cacraig, eaton, bogensch +Date: Feb 13, 2015 +One-line Summary: Various updates/fixes and update externals to alpha17d + +Purpose of changes: +- update to alpha17d externals +- time_period_freq attribute is now added to history files +- add history_budget changes to CLUBB (per Pete's email) +- fixed bug when running SCAM with history_budget=true and ndens=1(default) +- timing mods now that GPTL is its own directory (eaton) +- allow CLUBB to be run threaded when using clubb_history + +Bugs fixed (include bugzilla ID): +- 1727: CLUBB_history is now threadsafe so remove check prohibiting this in configure +- fixed bug when running SCAM with history_budget=true and the default setting of ndens=1 + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- clubb_history and threading is now permitted + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: +A models/atm/cam/test/system/nl_files/outfrq1s_hist +A models/atm/cam/test/system/nl_files/outfrq1s_carma +A models/atm/cam/test/system/nl_files/outfrq1s_clubb + - namelists turning on histories and forcing conversion to trop any fields not set, but are written out (cacraig) + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES + - update to beta17 externals + +M models/atm/cam/test/system/tests_pretag_goldbach_pgi +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/tests_pretag_goldbach_nag +M models/atm/cam/test/system/nl_files/scmarm +M models/atm/cam/test/system/input_tests_master + - added "hi" tests to turn on the history flags and force conversion to trap any values not set but are output (cacraig) + +M models/atm/cam/test/system/TSM_ccsm.sh + - "SUCCESSFUL TERMINATION" is no longer echoed to standard out, so now grep for the success string in atm.log (cacraig) + +M models/atm/cam/bld/configure +M models/atm/cam/bld/Makefile.in + - mods to how timing is built since GPTL is its own directory (eaton) + +M models/atm/cam/bld/build-namelist + - timing mods since GPTL is its own directory (eaton) + - clubb_history is now threadsafe. Removed check preventing threading with clubb_history=true (cacraig) + +M models/atm/cam/src/control/cam_history.F90 + - added time_per_freq attribute (cacraig) + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - added history_budget to CLUBB (bogensch) + +M models/atm/cam/src/physics/cam/phys_control.F90 + - fixed typo (bogensch) + +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 + - fixed history_budget when running single column mode (cacraig) + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_65 +Originator(s): bogensch, cacraig +Date: February 4, 2015 +One-line Summary: Updated release of CLUBB + +Purpose of changes: + +- Provide updates to CAM-CLUBB to perform scientifically similar to the candidate CAM-CLUBB simulations +(NOTE: no tuning has yet been performed to account for recent CAM5 answer changes committed to the +trunk). Includes scientific support for CAM-CLUBB to run with prognostic precipitation (MG2), which is +now the default microphysics for CAM-CLUBB simulations. The option has been added to provide the +capability for CLUBB's turbulent moments to be advected by dynamics. In addition, updates have been +made to allow CAM-CLUBB to run as a deep convection scheme, as an option. Outside of CLUBB, other +options have been made available. The first being the option to allow the Zhang McFarlane (ZM) deep +convection scheme to run with the organization parameterization based on Mapes and Neale (2010). The +second being the option for an ice-supersaturation adjustment closure. + +- fixed missing character in waccmx use case (fix from Francis Vitt) + +- additional error messages in physics_buffer to help give more information if buffer_field is not allocated + +- mo_neu_wetdep was causing a floating point exception when RCA = 0 - added a check to prevent this + + +Bugs fixed (include bugzilla ID): +- bugzilla 2127 (format error in waccmxi_2000_cam4.xml) + +Describe any changes made to build system: +- Added clubb_opts: clubb_do_adv (Advect CLUBB moments), clubb_do_deep(CLUBB does the deep convection) +- Added zmconv_org: Include parameterization for sub-grid scale convective organization for the + ZM deep convective scheme based on Mapes and Neale (2011) + +Describe any changes made to the namelist: +Added: + - cldfrc2m_rhmaxi(rhi at which ice cloud fraction = 1) + - micro_mg_dcs (microphysics autoconversion size threshold) + - micro_mg_precip_frac_method (micorphysics type of precipitation fraction - max_overlap or in_cloud) + - micro_mg_berg_eff_factor (microphysics efficiency factor for berg) + - micro_do_icesupersat (apply ice supersaturation adjustment code) + - zmconv_ke_lnd (Tunable evaporation efficiency for land in ZM deep convection scheme) + - zmconv_org (organization parameterization in ZM) + - deep_scheme (CLUBB_SGS is now a valid option for this flag) + - clubb_cloudtop_cooling (CLUBB - turns on/off cloud top radiative cooling parameterization in CLUBB) + - clubb_rainevap_turb (CLUBB - turns on/off including effects of precip evaporation on turbulent moments + - clubb_expldiff (CLUBB - turns on/off explicit diffusion on temperature and moisture when CLUBB is on + - clubb_do_adv (CLUBB - on/off switch for advecting CLUBB moments) + - clubb_do_deep (CLUBB - on/off switch for having CLUBB calculate the deep convection) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM software engineers at code reviews + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + M . + M models/atm/cam +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated to new CLUBB external library and added SILHS library + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + - changes to support new options: clubb_opts(clubb_do_deep and clubb_do_adv) and zmconv_org + - set default microphys_pkg to MG2 when CLUBB is turned on + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist + - changes to support new namelist variables: + clubb_rainevap_turb, clubb_cloudtop_cooling, clubb_expldiff, + micro_mg_dcs, micro_mg_precip_frac_method, micro_mg_berg_eff_factor, micro_do_icesupersat, + cldfrc2m_rhmaxi, zmconv_org + - new settings for CLUBB of nucleate_ice_subgrid, sol_facti_cloud_borne, deep_scheme, zmconv_c0_lnd, + zmconv_ke_lnd, cld_macmic_num_steps, micro_mg_num_steps + +M models/atm/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml + - Added missing character (at Francis Vitt request) + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated CLUBB and added SILHS external libraries + +M models/atm/cam/src/control/runtime_opts.F90 + - clubb now has a namelist read + - zmconv namelist read is now in zm_conv_intr + +M models/atm/cam/src/physics/cam/micro_mg2_0.F90 + - prer_evap is added as a new field to micro_mg_tend + - uses namelist fields micro_mg_dcs, micro_mg_precip_frac_method and micro_mg_berg_eff_factor + - bug with negative temperature causing a core dump was solved by moving a section of code below conservation checks + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - WP2 is now more correctly named WP2_nadv + - use micro_do_icesupersat flag + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - uses namelist fields micro_mg_dcs, micro_mg_precip_frac_method and micro_mg_berg_eff_factor + - prer_evap is added as a new field + +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 + - whitespace changes only + +M models/atm/cam/src/physics/cam/cldfrc2m.F90 + - added cldfrc2m_rhmaxi to namelist + - ice water number is now passed into the aist calculations + - added code for new iceopt=6 + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - all of the changes to support the details listed in the purpose section above + +M models/atm/cam/src/physics/cam/convect_shallow.F90 + - added new variable landfracdum + +M models/atm/cam/src/physics/cam/pbl_utils.F90 + - new compute_radf routine which was originally a section of code in eddy_diff + +M models/atm/cam/src/physics/cam/zm_conv.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - added logic for organization parameterization detailed above in the purpose section + - moved the namelist out from zm_conv into the interface (zm_conv_intr) module + - passed namelist variables into the zm init routine (zm_convi) + +M models/atm/cam/src/physics/cam/eddy_diff.F90 + - uses new compute_radf routine + +M models/atm/cam/src/physics/cam/phys_control.F90 + - added micro_do_icesupersat control variable + - added support for macrop_scheme being CLUBB + +M models/atm/cam/src/physics/cam/physpkg.F90 + - added code based on using micro_d_icesupersat + - pass in additional parameters to clubb_tend_cam to support using macmic logic + +M models/atm/cam/src/physics/cam/macrop_driver.F90 + - changes to support micro_do_icesupersat + +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 + - rhmaxi and ni1 are now passed to lower level routines + +M models/atm/cam/src/physics/cam/convect_deep.F90 + - support for CLUBB_SGS being a valid deep_scheme + +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - additional error messages to help give more information if buffer_field is not allocated + +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - added check for RCA > zero as this was causing a floating point exception + +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + - call clubb_init_cnst for clubb constituents + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated Machines branch to update Intel compiler to 15.0.1 (15.0.0 was giving CLUBB/MG2 issues) + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB except: +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Feb 3 21:31:15 MST 2015 + This CLUBB baseline was expected to fail as updates to CLUBB are answer changing + +goldbach/nag: All BFB except: +049 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Feb 3 19:16:12 MST 2015 + Change to MG2 to fix negative temperature bug is expected to changes answers for MG2 + +goldbach/pgi or jaguar/pgi: All BFB except: +056 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Feb 3 20:01:28 MST 2015 + Change to MG2 to fix negative temperature bug is expected to changes answers for MG2 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + Changes for CLUBB - improved physics produces different climate just for CLUBB + Changes for MG2 - larger than roundoff but same climate - confirmed by Andrew Gettelman + +If bitwise differences were observed, how did you show they were no worse: +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + + CLUBB answers not strictly controlled yet, but was evaluated extensivly by Pete Bogenschutz + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_64 +Originator(s): sungsup, eaton +Date: Tue Jan 27 09:21:25 MST 2015 +One-line Summary: Update UNICON interfaces; add park macrophysics option. + +Purpose of changes: + +. Update the UNICON interface to put convective detrainment fields in the + pbuf. + +. Add option to Park macrophysics to compute variations in the rhminl, + rhminh, rhmini parameters using information about convective detrainment + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. add cldfrc2m_rhmini used by routines computing cloud fractions for ice + clouds +. add logical variable (offline_driver) to indicate model is configured to + use offline driver. This is set automatically by build-namelist based on + the model configuration. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cam developers + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/cldfrc2m.F90 +. Move the cloud fraction subroutines out of cldwat2m.F90 and into this new + module. The parameter rhmini is maintained here, and is set by the + namelist variable cldfrc2m_rhmini. +. These routines have all been modified to accept optional arguments + allowing rhminl, rhminh, rhmini to vary spatially + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. set default for cldfrc2m_rhmini +. set new variable, offline_driver, to true when CAM has been configured to + use an offline driver + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default for cldfrc2m_rhmini + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add cldfrc2m_rhmini +. add logical variable (offline_driver) to indicate model is configured to + use offline driver + +models/atm/cam/src/control/runtime_opts.F90 +. add calls for cldfrc2m and unicon namelist readers + +models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +. add new options to compute variation in rhminl, rhminh, rhmini using + information on convective detrainment +. move the routines that compute cloud fraction to new module, cldfrc2m. + +models/atm/cam/src/physics/cam/clubb_intr.F90 +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +models/atm/cam/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +models/atm/cam/src/physics/carma/models/cirrus/carma_cloudfraction.F90 +. change use association of cldwat2m_macro to cldfrc2m + +models/atm/cam/src/physics/cam/conv_water.F90 +. add diagnostic fields + +models/atm/cam/src/physics/cam/macrop_driver.F90 +. call Park macrophysics init routine (ini_macro) from macrop_driver_init +. add logic to access an pass new pbuf fields to cldwat2m_macro routines + when unicon is enabled + +models/atm/cam/src/physics/cam/microp_driver.F90 +. remove call to ini_macro (it was moved to macrop_driver_init) + +models/atm/cam/src/physics/cam/phys_control.F90 +. add offline_driver to phys_ctl_nl + +models/atm/cam/src/physics/cam/physpkg.F90 +. add call to cldfrc2m_init + +models/atm/cam/src/physics/cam/qneg4.F90 +. fix format statement + +models/atm/cam/src/physics/cam/unicon_cam.F90 +. add convective detrainment quantities to pbuf + +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. add fields to the pbuf for use in new Park macrophysics options (only + enabled when UNICON is on) + +models/atm/cam/src/unit_drivers/drv_input_data.F90 +. remove use of subroutine getfil. This subroutine looks for files in the + working directory before using the file specified by the namelist with an + absolute pathname. This may be not be what you want. +. add better error messages when reading input file. + +models/atm/cam/test/system/test_driver.sh +. Set ACCOUNT environment variable for yellowstone testing. +. update intel/15.0.0 to intel/15.0.1 on yellowstone + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_63 +Originator(s): cacraig, santos, eaton, jedwards +Date: January 14, 2015 +One-line Summary: longer casenames, MG2 change to avoid FPE, turn off use_contiguous for gfortran, added missing & which caused issues on mira + +Purpose of changes: +- Need to allow longer casenames for CESM runs +- micro_mg_cam needed to set entire arrays to avoid a floating point exception in later code +- when using gfortran 4.8.3, got a segmentation fault in decomp_left_div when USE_CONTIGUOUS is turned on +- added missing & on a continuation line which caused issues on mira + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/Makefile.in + - turn off USE_CONTIGUOUS for gfortran + +M models/atm/cam/src/control/filenames.F90 + - use the longer casename lengths + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - set entire arrays so don't get a segmentation fault in later code + +M models/atm/cam/src/physics/cam/chem_surfvals.F90 + - added missing & which caused issues on mira + + M . +M SVN_EXTERNAL_DIRECTORIES + - update to csm_share version which supports the longer casename setting + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except which differ due to the updated csm_share external: +072 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Tue Jan 13 10:16:33 MST 2015 +075 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Jan 13 10:16:40 MST 2015 +080 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Jan 13 10:17:03 MST 2015 +084 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Tue Jan 13 10:17:15 MST 2015 +Created baseline files with the same csm_share external as used in cam5_3_63 and these 4 tests are BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff due to changes with DNO_SHR_VMATH + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_62 +Originator(s): joemci +Date: 10 Jan 2015 +One-line Summary: Fix for cam5_3_61 + +Purpose of changes: + + Fix error in cam5_3_61 commit in short_lived_species.F90 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, CAM code reviewers + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 + - Remove extraneous endif + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Jan 9 19:20:48 MST 2015 + - expected failure -- added a third airglow heating term in mo_aiglow.F90 and + changed from constant to variable mean mass in charge_neutrality.F90 which + both change answers for WACCM-X with neutral option + +goldbach/nag: + +003 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Sat Jan 10 12:59:58 MST 2015 + - expected failure -- added a third airglow heating term in mo_aiglow.F90 and + changed from constant to variable mean mass in charge_neutrality.F90 which + both change answers for WACCM-X with neutral option + +goldbach/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_61 +Originator(s): joemci, liuh +Date: 5 Jan 2015 +One-line Summary: Update WACCM-X with extended ionosphere + +Purpose of changes: + + Add capability to switch on vertical ion transport ambipolar diffusion and + electron and ion temperature calculations in WACCM-X. This will give a more + realistic simulation of the ionosphere in the model and is the next step in + adding full thermosphere/ionosphere physics and dynamics to CESM. + + Also, added is the infrastructure for the more realistic setting of ions + and electrons to short-lived non-transported species in the thermosphere/ + ionosphere but no species are set to short-lived.. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, CAM code reviewers + +List all subroutines eliminated: + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/waccmxi_2000_cam4.xml + - new WACCM-X extended ionosphere use case + +models/atm/cam/src/chemistry/pp_waccmx_mozart/chem_mech.doc +models/atm/cam/src/chemistry/pp_waccmx_mozart/chem_mech.in +models/atm/cam/src/chemistry/pp_waccmx_mozart/chem_mods.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/m_rxt_id.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/m_spc_id.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_adjrxt.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_imp_sol.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_indprd.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_lin_matrix.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_lu_factor.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_lu_solve.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_nln_matrix.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_phtadj.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_prod_loss.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_rxt_rates_conv.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_setrxt.F90 +models/atm/cam/src/chemistry/pp_waccmx_mozart/mo_sim_dat.F90 + - new WACCM-X MOZART chem package currently identical to WACCM MOZART + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/physics/cam/physpkg.F90 + - changed name of interface routine to extended ionosphere and added + charge neutrality check to update electron number density after + extended ionosphere calculation of O+ + +M models/atm/cam/src/physics/cam/ionosphere.F90 + - changed name of interface routine to extended ionosphere + +M models/atm/cam/src/physics/waccmx/ionosphere.F90 + - updated algorithms for electron and ion temperature and ion + transport ambipolar diffusion + +M models/atm/cam/src/chemistry/mozart/mo_airglow.F90 +M models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + - added 630 nm O1D airglow heating rate to total rate and clarified + output field names + +M models/atm/cam/src/chemistry/mozart/charge_neutrality.F90 + - now ensures charge neutrality for short-lived species in pbuf + - changed mean mass from constant to variable for WACCM-X + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - modified conditionals for chemistry package to include new WACCM-X + MOZART package + +M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 + - changed from three to two dimensional the temporary pointer which + is used for setting short-lived species in pbuf + +M models/atm/cam/src/chemistry/mozart/exbdrift.F90 + - uncommented code to calculate vertical ExB drift and add to pbuf + +M models/atm/cam/bld/build-namelist + - set namelist defaults for new waccmx_mozart chemistry package + +M models/atm/cam/bld/config_files/definition.xml + - updated the chemistry option definition for new waccmx_mozart chemistry + package + +M models/atm/cam/bld/configure + - updated the chem option description for new waccmx_mozart chemistry + package + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - set default emission inputs for new waccmx_mozart chemistry package + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - added waccmx_mozart to valid values for cam_chempkg + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Jan 6 22:27:50 MST 2015 + - expected failure -- added a third airglow heating term in mo_aiglow.F90 and + changed from constant to variable mean mass in charge_neutrality.F90 which + both change answers for WACCM-X with neutral option + +goldbach/nag: + +003 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jan 8 13:41:50 MST 2015 + - expected failure -- added a third airglow heating term in mo_aiglow.F90 and + changed from constant to variable mean mass in charge_neutrality.F90 which + both change answers for WACCM-X with neutral option + +goldbach/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_60 +Originator(s): fvitt, mmills +Date: 5 Jan 2015 +One-line Summary: Bring in prognostic stratospheric modal aerosols and SC-WACCM5 + +Purpose of changes: + + Provide the capability to prognose modal aerosols in the stratosphere. This + gives CAM5 and WACCM5 the ability to simulate aerosols in the stratosphere + which originate from volcanic eruptions. To this end, accumulation to coarse + mode exchange is allowed and the widths and edges of the modes are modified + + Provide new capabilities for specifying emissions (surface and elevated): + - ability to specify emissions from multiple input files for any given species + - optional global attribute 'input_method' (set to: 'SERIAL', 'CYCLICAL', + or 'INTERP_MISSING_MONTHS') in the emissions input file which overrides the + corresponding *type namelist option on a file-by-file basis + - optional multiplier proceeding the emissions filepath, e.g.: + 'NAME -> 0.5*/path.../filename.nc' + + Provide chemistry package for SC-WACCM5 which has prognostic modal aerosols + (this mechanism lacks OCS which is important for the non-volcanic stratospheric sulfate) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, CAM code reviewers + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/pp_waccm_ghg +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_solve.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_setrxt.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_adjrxt.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_rxt_rates_conv.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mods.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_prod_loss.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lin_matrix.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/m_rxt_id.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_phtadj.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_nln_matrix.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_factor.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/mo_indprd.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/m_spc_id.F90 +D models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.doc +D models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.in + - renamed 'waccm_ghg' to 'waccm_sc' + +D models/atm/cam/test/system/config_files/f1.9c4wghgdm +D models/atm/cam/test/system/config_files/f4c4wghgdm +D models/atm/cam/test/system/config_files/f10c4wghgdm +D models/atm/cam/test/system/config_files/h30c4wgdm + - changed 'wghg' to 'wsc' + +D models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.dat + - preprocessor by-product -- not needed in CAM + +List all subroutines added and what they do: + +A models/atm/cam/test/system/config_files/f1.9c4wscdm +A models/atm/cam/test/system/config_files/f4c4wscdm +A models/atm/cam/test/system/config_files/f10c4wscdm +A models/atm/cam/test/system/config_files/h30c4wscdm + - changed 'wghg' to 'wsc' + +A models/atm/cam/test/system/config_files/f1.9c4carmwtsuldh +A models/atm/cam/test/system/config_files/f10c5wtmam3dm +A models/atm/cam/test/system/config_files/f10c5wscmam3dm +A models/atm/cam/test/system/config_files/f1.9c5wmam3h +A models/atm/cam/test/system/config_files/f1.9c5wscmam3dh +A models/atm/cam/test/system/config_files/f1.9c5wscmam3dm +A models/atm/cam/test/system/config_files/f1.9c5wtmam3dh +A models/atm/cam/test/system/config_files/f1.9c4wscdh +A models/atm/cam/test/system/config_files/f10c4wmxdm +A models/atm/cam/test/system/config_files/f10c4carmwtsuldm +A models/atm/cam/test/system/config_files/f10c5wmam3dm +A models/atm/cam/test/system/config_files/f1.9c5wtmam3h + - new test configurations + +A models/atm/cam/test/system/tests_waccm_mpi +A models/atm/cam/test/system/tests_waccm_hybrid + - tests many flavors/configurations of waccm + +A models/atm/cam/test/system/nl_files/outfrq3s_modalstrat + - for prognostic stratospheric modal aerosols + +A models/atm/cam/test/system/nl_files/outfrq3s_carma2000 + - for carma-waccm-suflur tests + +A models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/1850-2005_waccm_tsmlt_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/1850_waccm_tsmlt_cam5.xml + - new waccm5 use cases + +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_waccm5_geos5.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam5.xml + - new SC-waccm5 use cases + +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_mam3 + - new chem package + +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_sc_mam3 + - new chem package (this mechanism lacks OCS which is important for the + non-volcanic stratospheric sulfate) + +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_tsmlt_sulfur + - new chem package + +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_sc/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_sc/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_sc + - renamed 'waccm_ghg' to 'waccm_sc' + +List all existing files that have been modified, and describe the changes: + + +M models/atm/cam/src/control/cam_history.F90 + - add F10.7, Kp and Ap data to cam history if they are input into the model + regardless of which chem package is used + +M models/atm/cam/src/physics/cam/carma_flags_mod.F90 + - added 'carm_rad_feedback' and 'carm_do_partialinit' + - changed 'carma_to_hetchem' to 'carma_hetchem_feedback' + +M models/atm/cam/src/physics/cam/tropopause.F90 + - added check for troplev > 0 + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - a workaround for pgi compiler bug on goldbach + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 + - added diagnostics for stratospheric aerosols + +M models/atm/cam/src/physics/cam/phys_control.F90 + - prog_modal_aero set by checking for '_mam' in chem package name + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - removed the chem package name check for tidal diagnostics + +M models/atm/cam/src/physics/cam/nucleate_ice.F90 + - initialize variables 'deles' and 'esi' to zero + +M models/atm/cam/src/physics/waccmx/ionosphere.F90 + - 'get_solar_parms' changed to 'solar_parms_get' + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 + - carma updates for rad feedback and partial init +M models/atm/cam/src/chemistry/utils/prescribed_strataero.F90 + - correction to comment + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - increased size of buffer used to read in units attribute + +M models/atm/cam/src/chemistry/utils/solar_data.F90 + - masterproc read namelist + - added check to prevent users from setting solar_data_ymd when + solar_data_type is 'SERIAL' + +M models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 + - added readnl subroutine + - added "solar_parm_on" indicator + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + - mods for stratospheric sulfate + +M models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 + - mods for stratospheric sulfate and accumulation to coarse mode exchanges + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 + - removed MODAL_AERO ifdef + +M models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 + - interface change in gasaerexch routine + - added stub strat_surfarea subroutine + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - call aero_modal_strat_surfarea + +M models/atm/cam/src/chemistry/mozart/photo_bkgrnd.F90 + - 'get_solar_parms' changed to 'solar_parms_get' + +M models/atm/cam/src/chemistry/mozart/spedata.F90 + - correction in log message + +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 + - use pressure of top of model to determine of upper boundary conditions are applied + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - removed is_waccm checks + +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 + - new capability added to allow individual species to have forcings from + multiple files + - global attribute 'input_method' in the input file which overrides the + ext_frc_type namelist setting on a file-by-file basis + +M models/atm/cam/src/chemistry/mozart/euvac.F90 + - added euvac_on indicator + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - remove chem_is check used to set constituent mixtype -- now all + chemical constituents are registered with mixtype='dry'. + If do_molec_diff is true cnst_type is set to wet in chem_init. + - water vapor has fixed upper boundary if top of model pressure is + comparable to waccm's top + - removed chem_is checks and WACCM ifdefs -- waccm parameterizations + know if they are active + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - removed waccm checks -- use top of model pressure + +M models/atm/cam/src/chemistry/mozart/mag_parms.F90 +M models/atm/cam/src/chemistry/mozart/efield.F90 + - 'get_solar_parms' changed to 'solar_parms_get' + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - 'carma_do_hetchem' changed to carm_hetchem_feedback' + +M models/atm/cam/src/chemistry/mozart/mo_jeuv.F90 + - added check for active jeuv reactions + + +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - new capability added to allow individual species to have emissions from + multiple files + - global attribute 'input_method' in the input file which overrides the + ext_frc_type namelist setting on a file-by-file basis + + +M models/atm/cam/src/dynamics/fv/trac2d.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 + - replaced WACCM cppdefs with top of model pressure checks + + +M models/atm/cam/bld/configure + - updated the chem option description: + . waccm_ghg renamed to waccm_sc + . new chem pckgs -- waccm_sc_mam3, waccm_tsmlt_mam3, waccm_tsmlt_sulfur + - removed the numerous chem_pkg conditionals which set chem_nadv (hard wired) -- + now let ChemPreprocess perl module determine the number of advected + chemical tracers + - removed the WACCM cpp defines + +M models/atm/cam/bld/config_files/definition.xml + - updated the chem option definition: + . waccm_ghg renamed to waccm_sc + . new chem pckgs -- waccm_sc_mam3, waccm_tsmlt_mam3, waccm_tsmlt_sulfur + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - new default IC files for + . 10x15 waccm5 + . 10x15 waccmx + . waccm/carma/sulfur + - new mode definition files for prognostic stratospheric aerosols + - set default inputs for waccm_sc_mam3 + - update default long-wavelength photolysis cross section input file + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - changes to carma options: + . added carma_do_partialinit + . added carma_rad_feedback + . carma_do_hetchem renamed to carma_hetchem_feedback + - changed valid values for cam_chempkg + - modal aersol options + . modal_accum_coarse_exch -- allows accumulation to coarse mode exchange to take place + -- needed for prognostic stratospheric aerosols + . modal_strat_sulfate -- turns on prognostic stratospheric sulfate + - several places where 'waccm_ghg' changed to 'waccm_sc' + +M models/atm/cam/bld/build-namelist + - 'waccm_ghg' to 'waccm_sc' changes + - set appropriate mode definition files if 'modal_accum_coarse_exch' is set to TRUE + - set rad_climate appropriately when 'carma_rad_feedback' is set to TRUE + - determine if prescribed stratospheric aerosols are needed -- + when there are no prognostic stratospheric aerosols + - set namelist defaults for waccm_sc_mam3 and waccm_tsmlt_mam3 + - don't override cam_chempkg setting for waccm + - in check_input_files look for multiplier coefficient proceeding emissions filepath + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - separated out the code which determines the number of advected chemical tracers + +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.in + - chemistry updates + +M models/atm/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml + - removed namelist settings that were set to default values or should not be set here + such as phys_loadbalance and dtime + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml + - removed namelist settings that were set to default values or should not be set here + - update LBC file + - IC file for 4x5 + +M models/atm/cam/test/system/tests_chem_hybrid +M models/atm/cam/test/system/tests_chem_mpi + - new chemistry tests added + +M models/atm/cam/test/system/tests_pretag_yellowstone + - added waccm5_tsmlt and waccm5_sc tests + +M models/atm/cam/test/system/tests_pretag_goldbach_nag + - added 10-degree waccmx and waccm5 tests + +M models/atm/cam/test/system/nl_files/outfrq1m + - set frequency of all history streams to 1-month + +M models/atm/cam/test/system/input_tests_master + - changed 'wghg' to 'wsc' + - new tests added + - corrected specification of sd-waccm test 501 + - for CCSM tests 993 use 'ne30_ne30' resolution rather than 'ne30_g16' + -- this is consistent with the resolution specified in eq993 + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated carma model + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +016 bl326 TBL.sh f1.9c4wscdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ...................FAIL! rc= 7 at Wed Dec 31 17:43:05 MST 2014 + - expected failure -- fixed upper bound of water vapor for waccm_ghg chem package + +042 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Wed Dec 31 18:43:44 MST 2014 + - expected failure -- changed constituent mixing type from 'wet' to 'dry' for super_fast_llnl chem package + +056 bl474 TBL.sh f1.9c5wtmam3h outfrq3s+1850_waccm_tsmlt_cam5 9s ..............................FAIL! rc= 7 at Wed Dec 31 19:36:57 MST 2014 + - expected failure -- waccm_tsmlt_mam3 is a new chem package -- no baseline to compare against + +059 bl482 TBL.sh f1.9c5wscmam3dh outfrq3s_2005+waccm_sc_1955-2005_cam5 9s .....................FAIL! rc= 7 at Wed Dec 31 19:59:39 MST 2014 + - expected failure -- waccm_sc_mam3 is a new chem package -- no baseline to compare against + +goldbach/nag: + +031 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Dec 31 16:11:05 MST 2014 + - expected failure -- fixed upper bound of water vapor for waccm_ghg chem package + +058 bl424 TBL.sh f10c4wmxdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Dec 31 18:16:11 MST 2014 + - expected failure -- new waccmx test -- no baseline to compare against + +061 bl471 TBL.sh f10c5wmam3dm outfrq3s_modalstrat 9s ..........................................FAIL! rc= 7 at Wed Dec 31 18:32:04 MST 2014 + - expected failure -- chemistry mechanism changes + +goldbach/pgi: + +036 bl314 TBL.sh f10c4wscdm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Dec 31 16:12:31 MST 2014 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_59 +Originator(s): santos (contributions from others, see below) +Date: 2014/12/24 +One-line Summary: New gravity wave and vertical diffusion code, unit tests. + +Purpose of changes: + +- Fix bug regarding molecular diffusion of heat in WACCM. + +- Add inertial gravity waves triggered by frontogenesis. + - Adapted from the WACCM code used for CCMI, designed by X.H. Xue, with + modifications from liuh and aksmith. + +- Add new finite volume diffusion solver code to simplify processes that + perform vertical diffusion in the column physics. The method is largely + identical to old code, but the interface is intended to provide more + flexibility and reduce the likelihood of errors when making changes in + the middle-layer science code, e.g. when changing boundary conditions. + +- Add first unit tests for CAM, for new diffusion code. + +- Allow different gravity wave sources to produce different spectra. + +- Add gravity waves sourced from shallow convection (disabled by default). + - Adapted from code from Tzu-Ling Lai (aka Leslie). + +- Add new "consistent" topography files for FV 1 and 2 degree. + +- Turn on diffusion for orographic gravity waves. + +- Gravity wave efficiencies are now applied to the generated stress profile + (tau), and not just the wind tendencies. + +- Fix a number of bugs and tuning issues in gravity waves. + + - Fix bug where orographic waves were erroneously adding in tendencies + with contributions from other gravity wave types (fixing this yields a + somewhat hotter mesosphere in WACCM). + - Remove problematic limit on effective diffusivity due to gravity waves. + - Increase minimum value of Brunt-Vaisalla frequency to address numerical + inaccuracies. + - Fix issue where heating from breaking waves used the wrong wave speed + ("c" instead of "u-c"). + - Replace "alpha0" (Newtonian cooling profile) with a version considered + to be better-founded, and use this for both CAM and WACCM. + - Scale sgh up using landfrac before calculating source sizes, then scale + the efficiency down. + - Several minor bugs. + +- Resolve minor discrepancies between CAM and WACCM gravity wave treatment, + especially limiters that are redundant. + +- Add USE_CONTIGUOUS flag to the CAM Makefile, allowing use of the + "contiguous" attribute to assist optimization on compilers that support + it. + +Bugs fixed (include bugzilla ID): + +- #1799: gw_drag: Wrong expression for converting kinetic energy to + thermal in wave dissipation. +- #1800: gw_drag: Orographic waves produce spurious cooling upon + dissipation. +- #1801: gw_drag: gw_diffusion functions are called with kbotbg instead of + kbot +- #1812: gw_drag: Beres scheme uses cshift on a table when it only needs a + normal shift. +- #1878: Molecular diffusion upper boundary condition has an extra term in + WACCM. +- #1980: WACCM: output of "ap" to history file actually overwrites "kp" + instead +- #2016: SC-WACCM: uninitialized flags cause a crash on XLF with DEBUG. +- #2069: Molecular diffusion of heat disabled in WACCM. +- #2103: gw_drag: Wrong value of tau used in momentum fixer. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +- Add shallow convection gravity wave source configuration. + - Pre-existing variables now have the suffix "_dp", except for + gw_drag_file, which may provide a file usable for a combined + shallow and deep convection scheme in the future. + - New variables now have the suffix "_sh". + +List any changes to the defaults for the boundary datasets: + +- CAM-FV 1 and 2 degree configurations now use topography files generated + with the same consistent method used to create the CAM-FV topography + files. + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, CAM code reviewers + +List all subroutines eliminated: + +List all subroutines added and what they do: + +M models/atm/cam/test/unit/CMakeLists.txt +M models/atm/cam/src/physics/cam/CMakeLists.txt +A models/atm/cam/src/utils/CMakeLists.txt +A models/atm/cam/test/unit/coords_1d +A models/atm/cam/test/unit/coords_1d/CMakeLists.txt +A models/atm/cam/test/unit/coords_1d/test_coords_1d.pf +A models/atm/cam/test/unit/linear_1d_operators +A models/atm/cam/test/unit/linear_1d_operators/CMakeLists.txt +A models/atm/cam/test/unit/linear_1d_operators/test_diagonal.pf +A models/atm/cam/test/unit/linear_1d_operators/test_derivatives.pf +A models/atm/cam/test/unit/linear_1d_operators/test_arithmetic.pf +A models/atm/cam/test/unit/vdiff_lu_solver +A models/atm/cam/test/unit/vdiff_lu_solver/CMakeLists.txt +A models/atm/cam/test/unit/vdiff_lu_solver/test_fd_solver.pf +A models/atm/cam/test/unit/vdiff_lu_solver/test_fv_solver.pf + - Add tests (directory names correspond to the names of the modules + they test). + +A models/atm/cam/src/physics/cam/coords_1d.F90 + - New vertical coordinate type (introduced to cache derived values + of the pressure coordinates for performance reasons). + +A models/atm/cam/src/physics/cam/linear_1d_operators.F90 + - New operator type for linear operations on 1D grids that can be + represented by tridiagonal matrices (plus boundary conditions). + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Add unit_testing external. + +M models/atm/cam/bld/Makefile.in + - Add USE_CONTIGUOUS CPP macro. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add second gravity wave spectrum for inertial waves. + - Add shallow convection variables to namelist. + - Add inertial gravity wave variables to namelist. + - gw_polar_taper now controls the polar taper for non-inertial + waves from frontogenesis (taper is on by default for FV only). + - The "60 level model" Beres efficiency now applies to all + non-WACCM cases. + - Change to new topography files for f19 and f09 resolutions. + +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml + - Rename "EKGWSPEC" to "EKGW", since it now includes contributions + from orographic waves (which do not cover a spectrum). + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +M models/atm/cam/src/dynamics/se/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 + - Frontogenesis now has to be calculated if either inertial or + non-inertial gravity waves are triggered by it. + +M models/atm/cam/src/physics/cam/boundarydata.F90 + - Initialize some flags that were causing crashes on platforms + where module data is not initialized to 0 (or in this case, + to ".false."). + +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 + - Changes to provide separate data/flags for deep and shallow + convective gravity waves. + - Add use_gw_front_igw flag. + +M models/atm/cam/src/physics/cam/diffusion_solver.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/molec_diff.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Fix bug where molecular diffusion of heat was disabled in WACCM + (#2069). + - Incorporate new diffusion code. The new code handles some details + such as pressure level thicknesses, which therefore do not need + to be accounted for in higher-level code (e.g. we no longer pass + tmpi2). + - Fully calculate WACCM-X diffusion coefficient terms down to the + lowest internal interface in the molecular diffusion region, not + the second-lowest, as was done before. + +M models/atm/cam/src/physics/cam/gw_common.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 + - Allow different gravity wave source parameterizations to emit + waves in different spectra, defined by a new type called + GWSpectrum. + - Add new inertial gravity waves triggered by frontogenesis. + - Add new shallow convection source, which has its own efficiency + and input file. + - The "tndmax" limiter (for numerical stability) is now used on the + total tendency for each grid point, rather than the contribution + from each phase speed, as was done before. + - Add file and line numbers to error messages. + - Use PIO to read in input files, not a direct call to netCDF. + - Read in Beres lookup table dimensions, since we can no longer + make assumptions about some of their values or sizes. + - Remove "orographic_only" and "do_spectral_waves" flags, and stop + using "do_molec_diff" except in the CAM interface layer, since + these represent ultimately unnecessary differences between WACCM + and CAM gravity waves. + - Refactor momentum/energy conservation code into four very + short routines, and report energy excess from the orographic + and shallow convection waves as a heating rate to + check_energy_chng. + - Fix bug where orographic waves added extra wind tendencies. + - Use a higher minimum value for B-V frequency. + - Fix bug where a wrong speed was used to calculate kinetic energy + differences. + - Use per-column gravity wave efficiencies, so that CAM can tweak + these values. This allows local scaling factors, such as the + polar taper, to be implemented by simply adjusting the + efficiency. + - Gravity wave efficiencies are now applied to tau as well as to + the wind tendencies. This makes the limiters on tau less + restrictive, and also fixes an issue where the momentum fixer + failed to correctly account for the efficiency. + - Remove CAM-specific code affecting the diffusivity that damps + stresses, since this is now thought to be an poor method of + accounting for self-damping. + - Remove several limiters on various quantities, as most of these + are either numerically unnecessary or redundant with other + checks. + - Improve handling of landfrac by using it to scale sgh as well as + as the efficiency. + - Enable diffusion from orographic gravity waves. + - Output "EKGWSPEC" is now renamed to "EKGW" and includes + orographic diffusion. + - Output temperature tendency for each gravity wave source. + - Remove redundant code which was left in during a previous + refactoring purely in order to preserve answers. + - Fix bug where all diffusion was limited to occur above the bottom + level for waves from frontogenesis, instead of a source-specific + bottom level. + - Index arrays defined on level interfaces from 1, not 0. + +M models/atm/cam/src/physics/cam/gw_convect.F90 + - Modifications to make the code more generic, so that it can be + used for sourcing waves from shallow convection. + - Add BeresSourceSpec type, which holds data read in from the input + file, and other differences between deep and shallow convective + sources. + - Remove assumption that heating depth dimension of the input file + contains only integers. + - Fix bug where storm speed was accounted for with a circular shift + (cshift) instead of a regular shift (eoshift). + - Removed unnecessary casts of storm cell speed to an integer and + back to double precision, which lost precision during table + lookup. + - Change handling of pole points to reduce the chance of + mishandling due to inexact floating point arithmetic. + +M models/atm/cam/src/physics/cam/gw_diffusion.F90 + - Modifications to use new diffusion code. + - Remove limiter on egwdffi, which turned out to be too low and + ultimately unnecessary. + +M models/atm/cam/src/physics/cam/gw_front.F90 + - Instead of using the trapezoidal method to integrate a gaussian, + use erfc. + - Use the type "CMSourceSpec" to hold information that was used as + module data, to improve flexibility enough to handle inertial and + non-inertial waves with the same routine. + +M models/atm/cam/src/physics/cam/gw_oro.F90 + - Changes for compatibility with gw_common, especially using the + new spectra. + +M models/atm/cam/src/physics/cam/gw_utils.F90 + - Convert "elemental" subroutines to vector subroutines. + +M models/atm/cam/src/physics/cam/vdiff_lu_solver.F90 + - Now uses linear_1d_operators to construct operators before + decomposing them. + - The definition and application of boundary conditions is more + generic. + +M models/atm/cam/src/utils/cam_pio_utils.F90 + - Remove dead code and make error messages more specific. + +M models/atm/cam/test/system/input_tests_master +A models/atm/cam/test/system/nl_files/outfrq3s_gw_igw +A models/atm/cam/test/system/nl_files/outfrq3s_gw_sh + - Add test for inertial gravity waves. + - Add test for gravity waves from shallow convection. + +M models/atm/cam/test/system/test_driver.sh + - Add ability to override CAM_TASKS and CAM_RESTART_TASKS using the + environment (this is necessary to run tests with very low + resolution or high overall cost, when the machine defaults will + not work). + +Finally, the following files were moved/changed as part of a general move +of utility code to src/utils rather than src/control or src/physics/cam. +The changed (rather than added/deleted) files were mostly changed to add +use statements for subroutines that were placed inside modules as well as +being moved to utils. + +D models/atm/cam/src/control/mpishorthand.F +D models/atm/cam/src/control/physconst.F90 +D models/atm/cam/src/control/intp_util.F90 +D models/atm/cam/src/control/bnddyi.F90 +D models/atm/cam/src/control/interpolate_data.F90 +D models/atm/cam/src/control/wrap_nf.F90 +D models/atm/cam/src/control/datetime.F90 +D models/atm/cam/src/control/srchutil.F90 +D models/atm/cam/src/control/units.F90 +D models/atm/cam/src/control/gauaw_mod.F90 +D models/atm/cam/src/control/ioFileMod.F90 +D models/atm/cam/src/control/vrtmap.F90 +D models/atm/cam/src/control/infnan.F90 +D models/atm/cam/src/control/wrap_mpi.F90 +D models/atm/cam/src/control/error_messages.F90 +M models/atm/cam/src/control/cam_history.F90 +A models/atm/cam/src/utils/mpishorthand.F +A models/atm/cam/src/utils/physconst.F90 +A models/atm/cam/src/utils/intp_util.F90 +A models/atm/cam/src/utils/bnddyi.F90 +A models/atm/cam/src/utils/coords_1d.F90 +A models/atm/cam/src/utils/interpolate_data.F90 +A models/atm/cam/src/utils/wrap_nf.F90 +A models/atm/cam/src/utils/datetime.F90 +A models/atm/cam/src/utils/linear_1d_operators.F90 +A models/atm/cam/src/utils/srchutil.F90 +M models/atm/cam/src/utils/cam_dom/sst_data.F90 +A models/atm/cam/src/utils/units.F90 +A models/atm/cam/src/utils/gauaw_mod.F90 +A models/atm/cam/src/utils/ioFileMod.F90 +A models/atm/cam/src/utils/infnan.F90 +A models/atm/cam/src/utils/vrtmap.F90 +A models/atm/cam/src/utils/wrap_mpi.F90 +A models/atm/cam/src/utils/error_messages.F90 +D models/atm/cam/src/physics/cam/linear_1d_operators.F90 +D models/atm/cam/src/physics/cam/coords_1d.F90 +M models/atm/cam/src/physics/cam/co2_data_flux.F90 +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/eul/scanslt.F90 +M models/atm/cam/src/dynamics/se/native_mapping.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..................................................FAIL! rc= 7 at Tue Dec 23 17:38:45 MST 2014 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .........................................FAIL! rc= 7 at Tue Dec 23 17:39:09 MST 2014 +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Tue Dec 23 17:59:52 MST 2014 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Tue Dec 23 18:06:47 MST 2014 +016 bl326 TBL.sh f1.9c4wghgdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ..................FAIL! rc= 7 at Tue Dec 23 18:20:14 MST 2014 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Tue Dec 23 18:23:21 MST 2014 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Tue Dec 23 18:29:43 MST 2014 +026 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ..........................................FAIL! rc= 7 at Tue Dec 23 18:29:59 MST 2014 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Tue Dec 23 18:41:51 MST 2014 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Dec 23 18:52:12 MST 2014 +035 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Tue Dec 23 19:05:31 MST 2014 +037 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Dec 23 19:08:01 MST 2014 +039 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Tue Dec 23 19:14:03 MST 2014 +042 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Tue Dec 23 19:20:53 MST 2014 +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Tue Dec 23 19:30:06 MST 2014 +048 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Dec 23 19:40:06 MST 2014 +050 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Dec 23 19:48:54 MST 2014 +053 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Tue Dec 23 20:05:34 MST 2014 +057 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Tue Dec 23 20:11:54 MST 2014 +060 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Tue Dec 23 20:13:32 MST 2014 +063 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Tue Dec 23 20:30:50 MST 2014 +066 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Tue Dec 23 20:33:41 MST 2014 +069 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Dec 23 20:44:32 MST 2014 +074 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Tue Dec 23 20:48:01 MST 2014 +078 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Tue Dec 23 21:02:54 MST 2014 + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Dec 23 19:40:47 MST 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Dec 23 19:40:49 MST 2014 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Dec 23 19:40:52 MST 2014 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Dec 23 19:40:54 MST 2014 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Dec 23 19:41:04 MST 2014 +028 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Dec 23 19:41:05 MST 2014 +031 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Dec 23 19:41:07 MST 2014 +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Dec 23 19:41:08 MST 2014 +036 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Tue Dec 23 19:41:10 MST 2014 +039 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Dec 23 19:41:13 MST 2014 +042 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Dec 23 19:41:14 MST 2014 +049 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Tue Dec 23 20:11:59 MST 2014 +052 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Dec 23 20:12:12 MST 2014 +055 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Dec 23 20:12:17 MST 2014 +058 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Dec 23 20:12:51 MST 2014 + +goldbach/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Dec 23 20:17:40 MST 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Dec 23 20:17:42 MST 2014 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Dec 23 20:17:43 MST 2014 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Dec 23 20:17:46 MST 2014 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Dec 23 20:17:48 MST 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Dec 23 20:17:58 MST 2014 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Tue Dec 23 20:17:59 MST 2014 +036 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Dec 23 20:18:01 MST 2014 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Tue Dec 23 20:18:02 MST 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Dec 23 20:18:03 MST 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Dec 23 20:18:05 MST 2014 +047 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Dec 23 20:18:06 MST 2014 +050 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Dec 23 20:18:08 MST 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Dec 23 20:18:09 MST 2014 +056 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Dec 23 20:44:22 MST 2014 +059 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Dec 23 20:44:27 MST 2014 +062 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Dec 23 20:44:32 MST 2014 +065 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Tue Dec 23 20:44:45 MST 2014 + + +ALL CAM configurations except ideal and adiabatic physics (and PORT) are +expected to change answers due to diffusion, gravity wave, and topography +file changes. + + +CAM tag used for the baseline comparison tests if different than previous +tag:Summarize any changes to answers, i.e., +- what code configurations: CAM 3/4/5 +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): New climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/gw_fixes_tags/gw_fixes_n14_cam5_3_55 +- platform/compilers: yellowstone/intel +- configure commandline: (CESM script defaults for FC5) +- build-namelist command (or complete namelist): Sole change was bnd_topo +bnd_topo = '/glade/p/cesmdata/cseg/inputdata/atm/cam/topo/consistent-topo-fv1.9x2.5_c130424.nc' +- MSS location of output: +/CCSM/csm/f.e13.FC5.f19_f19.GwFxTCam.002 + +(Evaluation run is #1894 in the experiment database.) + +MSS location of control simulations used to validate new climate: +/CCSM/csm/f.e13.FC5.f19_f19.GwCtlCam.001 + +(Control is #1895 in the experiment database.) + +URL for AMWG diagnostics output used to validate new climate: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.f19_f19.GwFxTCam.002/atm/f.e13.FC5.f19_f19.GwFxTCam.002-f.e13.FC5.f19_f19.GwCtlCam.001/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_58 +Originator(s): jedwards, santos, cacraig +Date: Dec 23, 2014 +One-line Summary: pio changes needed for pio2, change to MG2 to allow PGI to compile/run properly + +Purpose of changes: + +- Changes required in preparation for pio2 + +- fix to MG2 to allow PGI to compile and run properly + +- update PGI compiler on goldbach to 14.10 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh + - update to PGI 14.10 on goldbach + +M models/atm/cam/bld/mkDepends +M models/atm/cam/src/control/ncdio_atm.F90 +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam/subcol_utils.F90.in +M models/atm/cam/src/utils/cam_pio_utils.F90 +M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/se/dyn_grid.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/se/restart_dynamics.F90 +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M SVN_EXTERNAL_DIRECTORIES + - changes made by Jim to prepare for pio2 + +M models/atm/cam/src/physics/cam/micro_mg_data.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - changes to allow PGI to compile/run properly + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + +- what platforms/compilers: + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_57 +Originator(s): santos, cchen +Date: 2014/12/15 +One-line Summary: Change FV vertical remapping from energy to temperature + +Purpose of changes: + +- In the FV dycore, vertical remapping of total energy can cause + significant numerical errors in WACCM due to the high model top. By + remapping temperature instead, this error is reduced. + +- Fix a bug in MG2, and work around an Intel compiler bug that also affects + MG2. + +Bugs fixed (include bugzilla ID): + +- #2098: Double division error in sub-saturation check in MG2 +- #2104: MG2 produces garbage output in some diagnostics using Intel 15 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +- Short changes to numerical science code only, not formally reviewed. + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/dynamics/fv/te_map.F90 + - Replace total energy remapping with temperature remapping over + log(p). + - Remove some dead/unneeded code. + +M models/atm/cam/src/physics/cam/micro_mg2_0.F90 + - Initialize many variables at the top of the tend subroutine (they + should be overwritten in any case, but this initialization is + still necessary to workaround an apparent Intel bug). + - Remove extra factor of deltat that should not be applied to + mnuccd and vap_dep. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Fri Dec 12 17:52:24 MST 2014 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Fri Dec 12 17:59:04 MST 2014 +016 bl326 TBL.sh f1.9c4wghgdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ..................FAIL! rc= 7 at Fri Dec 12 18:12:19 MST 2014 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...................................................FAIL! rc= 7 at Fri Dec 12 18:15:26 MST 2014 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Fri Dec 12 18:21:48 MST 2014 +026 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ..........................................FAIL! rc= 7 at Fri Dec 12 18:22:03 MST 2014 +029 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Fri Dec 12 18:33:53 MST 2014 +032 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Dec 12 18:44:23 MST 2014 +035 bl373 TBL.sh f1.9c4mozdh outfrq3s+2000_cam4_trop_chem 9s ..................................FAIL! rc= 7 at Fri Dec 12 18:57:40 MST 2014 +037 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Fri Dec 12 19:00:24 MST 2014 +039 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Fri Dec 12 19:06:31 MST 2014 +042 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Fri Dec 12 19:13:30 MST 2014 +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Fri Dec 12 19:22:26 MST 2014 +048 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Dec 12 19:32:30 MST 2014 +050 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Fri Dec 12 19:41:19 MST 2014 +053 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Fri Dec 12 19:57:51 MST 2014 +057 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ..........................................FAIL! rc= 7 at Fri Dec 12 20:05:21 MST 2014 +060 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Fri Dec 12 20:06:59 MST 2014 +063 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Fri Dec 12 20:24:27 MST 2014 + +goldbach/nag: + +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Dec 12 15:58:47 MST 2014 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Fri Dec 12 16:30:20 MST 2014 +028 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Fri Dec 12 16:32:35 MST 2014 +031 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Dec 12 16:40:36 MST 2014 +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Fri Dec 12 16:42:49 MST 2014 +036 bl318 TBL.sh f10c4cdm sat_hist 9s .........................................................FAIL! rc= 7 at Fri Dec 12 16:58:17 MST 2014 +039 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Dec 12 17:06:53 MST 2014 +042 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Fri Dec 12 17:15:16 MST 2014 +046 bl335 TBL.sh f10idm idphys 9s .............................................................FAIL! rc= 7 at Fri Dec 12 17:20:56 MST 2014 +049 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Fri Dec 12 17:52:50 MST 2014 +055 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Dec 12 18:25:18 MST 2014 +058 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Fri Dec 12 18:56:34 MST 2014 + +goldbach/pgi or jaguar/pgi: + +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Fri Dec 12 16:03:18 MST 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Fri Dec 12 16:37:26 MST 2014 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ........................................FAIL! rc= 7 at Fri Dec 12 16:43:20 MST 2014 +036 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Dec 12 16:52:39 MST 2014 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .....................................................FAIL! rc= 7 at Fri Dec 12 16:59:55 MST 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Fri Dec 12 17:07:07 MST 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Fri Dec 12 17:17:39 MST 2014 +047 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Fri Dec 12 17:25:40 MST 2014 +050 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Fri Dec 12 17:28:20 MST 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Fri Dec 12 17:32:18 MST 2014 +056 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Fri Dec 12 18:03:10 MST 2014 +059 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Dec 12 18:19:48 MST 2014 +062 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Fri Dec 12 18:35:28 MST 2014 + +All failures due to expected answer changes in the FV dycore and MG2. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + All FV and MG2. + +- what platforms/compilers: + + All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Larger than roundoff but same climate. The MG2 bug fix may have a small + effect on climate, but no significant change in climate is observed in + standard CAM5 or WACCM4. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_56 +Originator(s): cacraig +Date: 12/09/15 +One-line Summary: Update to CESM1_3_beta14 externals + +Purpose of changes: + +- Update to CESM1_3_beta14 externals +- Remove -DNO_SHR_VMATH compiler flag to match CESM settings (non-CAM bug which required this flag was fixed) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: None (minor changes) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/Makefile.in + - removed -DNO_SHR_VMATH to match the CESM settings + +M SVN_EXTERNAL_DIRECTORIES + - updated to match CESM1_3_beta14 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB except: +066 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Mon Dec 8 16:20:51 MST 2014 +069 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Mon Dec 8 16:31:52 MST 2014 +074 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Mon Dec 8 16:35:24 MST 2014 +078 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Mon Dec 8 16:50:21 MST 2014 +These tests fail due to the change with removing the -DNO_SHR_VMATH compilation flag. They passed when this flag was used. + +goldbach/nag: All BFB + +goldbach/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_55 +Originator(s): santos, cacraig +Date: 12/02/15 +One-line Summary: Fix compiler issue on mira XLF + +Purpose of changes: + +- issues with default initialization using mira XLF compiler - one line workaround. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: None (minor changes) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/micro_mg_data.F90 + - one line fix for mira XLF compiler initialization issue + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB + +goldbach/nag: All BFB + +goldbach/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_54 +Originator(s): santos +Date: 2014/11/20 +One-line Summary: Fix memory leak with the PGI compiler. + +Purpose of changes: + +- Fix memory leak for MG on PGI. + +- Allow detection of the LAPACK library to find .so and .dylib files. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: None (minor changes) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure + - Check for liblapack.so and liblapack.dylib as well as + liblapack.a. + +M models/atm/cam/src/physics/cam/micro_mg_data.F90 + - Do explicit deallocation on PGI. + - Suppress intent warning. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS. + +goldbach/nag: All PASS. + +goldbach/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_53 +Originator(s): cacraig, santos +Date: 2014/11/18 +One-line Summary: Update externals to at least cesm1_3_beta13 + +Purpose of changes: + - Update externals to cesm1_3_beta13 (with a couple beyond, as needed for + previous tags and Intel compiler bug workarounds). + + - Work around compiler bugs. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: Intel compiler flag changes. + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: none (trival changes). + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh + - Updated yellowstone intel to 15.0.0 to match CESM compiler. + +M models/atm/cam/bld/configure + - CLM rearranged their directory structure. + +M models/atm/cam/bld/build-namelist + - CICE has changed their CAM flag from cam5 to cam4. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Avoid unpacking am_evp_st in MG1.5 or MG2, since it is only set + by MG1.0. + +M models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - Add workaround for XLF compiler bug. + +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/stepon.F90 + - Removed array subsections in subroutine argument lists, since + Intel's bounds checker complains when these arrays are + allocated with size 0. + +M SVN_EXTERNAL_DIRECTORIES + - Updated to cesm1_3_beta13 externals, except Machines and CMake + are more recent because CAM needs them. + - CICE is more recent to fix Intel 14 bug. + +M models/atm/cam/bld/Makefile.in + - Modify Intel settings to match CESM flags for yellowstone + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s ...........FAIL! rc= 7 at Mon Nov 17 17:10:13 MST 2014 +037 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Mon Nov 17 18:17:55 MST 2014 +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ......................................FAIL! rc= 7 at Mon Nov 17 18:39:07 MST 2014 +060 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...............................................FAIL! rc= 7 at Mon Nov 17 19:22:39 MST 2014 +063 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ............................FAIL! rc= 7 at Mon Nov 17 19:39:54 MST 2014 +066 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Mon Nov 17 19:42:41 MST 2014 +069 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Mon Nov 17 19:53:31 MST 2014 +074 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Mon Nov 17 19:57:02 MST 2014 +078 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Mon Nov 17 20:11:51 MST 2014 + +All changes are due to Intel update to version 15 and changes in compiler +flags. (If these changes are backed out, including the Machines update, all +tests pass.) + +goldbach/nag: All BFB + +goldbach/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: None for most compilers. + +- what platforms/compilers: Intel only. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_52 +Originator(s): santos +Date: 2014/10/17 +One-line Summary: Remove NO_SHR_VMATH from Makefile + +Purpose of changes: + +- Allow use of compiler-specific vector math functions in shr_vmath_mod for + CAM standalone, so that it remains bit-for-bit with CESM script runs. + +- Use default physics load balancing settings for CAM-SE, since doing so + now performs better than using phys_loadbalance = 0 (h/t jedwards). + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +- No longer using -DNO_SHR_VMATH. + +Describe any changes made to the namelist: + +- CAM-SE, like CAM-FV, defaults to phys_loadbalance = 2. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: none (trival changes). + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/Makefile.in + - Remove -DNO_SHR_VMATH. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/build-namelist + - Remove setting of phys_loadbalance to 0 for CAM-SE. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Correct mistake in documentation of the phys_loadbalance default. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +066 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ............................................FAIL! rc= 7 at Thu Oct 16 22:33:08 MDT 2014 +069 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Thu Oct 16 22:44:03 MDT 2014 +074 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .......................................................FAIL! rc= 7 at Thu Oct 16 22:47:35 MDT 2014 +078 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ........................................FAIL! rc= 7 at Thu Oct 16 23:02:41 MDT 2014 + +All CAM-SE runs with non-trival physics (i.e. not adiabatic or ideal) have +answer changes due to the NO_SHR_VMATH change. Note that the outfrq3s_lb0 +baseline failed, but test eq740 (TEQ of different phys_loadbalance +settings) passed. This shows that the answer changes are due to use of +shr_vmath_mod in CAM-SE's dp_coupling layer, and not due to the +phys_loadbalance change. + +goldbach/nag: All PASS. + +goldbach/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + - CAM-SE, except adiabatic/ideal, when using CAM Makefile. + +- what platforms/compilers: + + - Only those with special shr_vmath_mod implementations defined (in + practice, the Intel compiler is the only one left still in common use). + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + - Roundoff. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +- Monitor outputs from first (instantaneous) timestep; no fields in any of + the history outputs had a relative difference much greater than machine + epsilon. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_51 +Originator(s): santos andrew morrison bogensch caldwell +Date: 2014/10/16 +One-line Summary: Add new MG2 microphysics scheme. + +Purpose of changes: + +- Add MG2, a new version of the MG microphysics with prognostic + precipitation. + +- Add new macro/micro and microphysics-only substepping features. + +- Add first unit tests to CAM. + +Bugs fixed (include bugzilla ID): + +- Bug 1603: microphysics: BAM aerosols has hardcoded assumption that MG2 is + substepped twice +- Bug 2046: Fv dycore spmd_dyn.F90 and intel 14.x compiler +- Bug 2054: bug in cosp ice diagnostic + +Describe any changes made to build system: + +- Add a csm_share include directory. +- PGI builds now use the "-traceback" flag in DEBUG mode. + +Describe any changes made to the namelist: + +- Add cld_macmic_num_steps, which controls joint substepping of + macrophysics and microphysics within a physics timestep. + +- Add micro_mg_num_steps, which controls microphysics-only substepping + within a macro/micro substep. + +- Add nucleate_ice_subgrid, a new tuning parameter for ice nucleation. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, cacraig, CAM reviewers + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/CMakeLists.txt + - CMakeLists used to add files to be built for unit tests. + +A models/atm/cam/src/physics/cam/micro_mg2_0.F90 + - Portable science module for new MG2 code. + +A models/atm/cam/src/physics/cam/micro_mg_data.F90 + - Utility types for dealing with output data. + +A models/atm/cam/test/unit/CMakeLists.txt +A models/atm/cam/test/unit/micro_mg_data/ +A models/atm/cam/test/unit/micro_mg_data/CMakeLists.txt +A models/atm/cam/test/unit/micro_mg_data/test_MGFieldPostProc.pf +A models/atm/cam/test/unit/micro_mg_data/test_MGPacker.pf +A models/atm/cam/test/unit/micro_mg_data/test_MGPostProc.pf +A models/atm/cam/test/unit/mock/ +A models/atm/cam/test/unit/mock/CMakeLists.txt +A models/atm/cam/test/unit/mock/shr_sys_mod.nompi_abortthrows.F90 + - Unit tests for micro_mg_data module. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update csm_share and Machines externals for utility code used by + the MG interface. + - Add unit_testing external. + +M models/atm/cam/bld/Makefile.in + - Add new csm_share include directory. + - Add "-traceback" option for PGI debug runs. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add MG2 microphysics as an option. + - Add new namelist options. + - Set tuning parameters for MG2. + +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + - Workaround for an Intel 14 and 15 regression (h/t jedwards). + +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 + - Add rain and snow to lists of advected water constituents. + - Add physics_ptend_scale to scale an entire physics tendency by + some scalar factor. + +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + - Fix bug where COSP used liquid instead of ice for an ice + diagnostic (via Po-lun Ma, hannay, cacraig). + +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - Change MG optional input handling. + - Give MG1.0 a "get_cols" routine. + - Significant MG1.5 changes from tracking parts of MG2 development. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Add MG2 and new inputs/outputs for prognostic precipitation and + new diagnostics. + - Add microphysics-only substepping at this layer. + - Match MG1.0 interface changes. + - Use micro_mg_data types to handle packing and output averages. + +M models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - Change value of hard-coded eii parameter. + - Minor changes (e.g. comments). + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Remove (incorrect) assumption in BAM that npccn should be tweaked + to account for MG substepping. This was not even correct for MG1, + and hard-codes a value that can now vary using the new + microphysics substepping. + +M models/atm/cam/src/physics/cam/nucleate_ice.F90 +M models/atm/cam/src/physics/cam/nucleate_ice_cam.F90 + - "subgrid" is now a namelist option. + +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 + - Add macro/micro sub-stepping. + +D models/atm/cam/test/system/config_files/f1.9c5mg1_5m +A models/atm/cam/test/system/config_files/f1.9c5mg1_5dm +A models/atm/cam/test/system/config_files/f1.9c5mg2dm +M models/atm/cam/test/system/input_tests_master +A models/atm/cam/test/system/nl_files/outfrq3s_macmic2_classnuc +M models/atm/cam/test/system/tests_pretag_goldbach_nag +M models/atm/cam/test/system/tests_pretag_goldbach_pgi + - MG1.5 test is now a DEBUG test. + - Add MG2 test. + - Add macro/micro substepping test with use_hetfrz_classnuc + enabled. + - Add microphysics tests to NAG and PGI pretag lists on goldbach. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +082 eq993 TEQ_ccsm.sh ne30_ne30 FC5 h30c5h fcase 9s ...........................................FAIL! rc= 7 at Wed Oct 15 23:26:35 MDT 2014 + +- Test fails due to csm_share update that uses NO_SHR_VMATH, which CAM + defines, but CESM does not for the Intel compiler. Reconciling the two is + deferred to a near-future tag. + +goldbach/nag: + +049 bl368 TBL.sh f1.9c5mg2dm outfrq3s_macmic2_classnuc 9s .....................................FAIL! rc= 7 at Wed Oct 15 18:48:13 MDT 2014 +052 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed Oct 15 19:09:32 MDT 2014 + +- bl368 is a new test with no existing baseline. +- bl734 is affected by the fix for bug 1603, which affects all cases with + BAM and MG microphysics. + +goldbach/pgi or jaguar/pgi: + +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Wed Oct 15 18:12:45 MDT 2014 +047 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Wed Oct 15 18:21:36 MDT 2014 +050 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Wed Oct 15 18:24:13 MDT 2014 +056 bl367 TBL.sh f1.9c5mg2dm outfrq3s 9s ......................................................FAIL! rc= 7 at Wed Oct 15 19:01:53 MDT 2014 +065 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Wed Oct 15 20:01:59 MDT 2014 + +- bl317 changes answers for COSP diagnostics only, due to bug 2054 being + fixed. +- bl367 is a new test with no existing baseline. +- bl319, bl320, and bl734 are (prescribed) bulk modal aerosol cases with + MG, so are affected by the fix for bug 1603. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + - Fix for bug 1603 affects all BAM+MG cases. + - Fix for bug 2054 affects all COSP cases. +- what platforms/compilers: All. +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + - BAM+MG is larger than roundoff. This configuration is not + scientifically supported at this time. + - COSP changes diagnostics only, larger than roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_50 +Originator(s): eaton +Date: Mon Sep 22 14:22:41 MDT 2014 +One-line Summary: updates to heterogeneous freezing code + +Purpose of changes: + +. Updates to heterogeneous freezing code. + - Finish support for MAM7. + - Change two parameter values to match published values. + - Change name of modules and associated method names from hoose_hetfrz to + hetfrz_classnuc. + +. Add support for low resolution SE grid: ne5np4 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. use_hoose_hetfrz -> use_hetfrz_classnuc +. hist_hoose_hetfrz -> hist_hetfrz_classnuc + +List any changes to the defaults for the boundary datasets: +. added some defaults for low res SE grids + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/hoose_hetfrz.F90 +models/atm/cam/src/physics/cam/hoose_hetfrz_cam.F90 +. Rename hoose_hetfrz to hetfrz_classnuc + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/hetfrz_classnuc.F90 +models/atm/cam/src/physics/cam/hetfrz_classnuc_cam.F90 +. Rename hoose_hetfrz to hetfrz_classnuc +. Finish support of MAM7. +. Minor changes for the values of two variables: "theta_imm_bc" and + "dga_imm_bc" to be consistent with published paper. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/config_files/horiz_grid.xml +. add parameter values for low res SE grids + +models/atm/cam/bld/configure +. remove the CAM ldflags from the mct_ldflags passed to MCT's configure. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add defaults for low res SE grid: ne5np4 + +models/atm/cam/bld/namelist_files/namelist_definition.xml +models/atm/cam/src/physics/cam/micro_mg1_0.F90 +models/atm/cam/src/physics/cam/micro_mg1_5.F90 +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +models/atm/cam/src/physics/cam/microp_aero.F90 +models/atm/cam/src/physics/cam/nucleate_ice_cam.F90 +models/atm/cam/src/physics/cam/phys_control.F90 +. hoose_hetfrz -> hetfrz_classnuc + +models/atm/cam/src/physics/cam/nucleate_ice.F90 +. hoose_hetfrz -> hetfrz_classnuc +. improve comments +. Put change to conditional statement inside CPP USE_XLIU_MOD. This mod + needs a climate evaluation before being added to cam5 physics. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none. + +=============================================================== +=============================================================== + +Tag name: cam5_3_49 +Originator(s): eaton +Date: Mon Sep 15 10:46:16 MDT 2014 +One-line Summary: add pre-existing ice and Hoose heterogeneous freezing options + +Purpose of changes: + +. Add pre-existing ice option to nucleate_ice code. + +. Add option for Hoose heterogeneous freezing parameterization. + +. Improve the microp_aero driver by removing code that belonged in a CAM + specific interface for the nucleate_ice parameterization and adding the + missing CAM interface layer. + +. Add two new functions to the rad_constituents interfaces to make it + easier to access the mode and specie indices for specific modes and + specie types. + +Bugs fixed (include bugzilla ID): + +bugzilla 2036: memory leak in cam_pio_utils + + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +Add new variables: + +use_preexisting_ice - turn on the pre-existing ice option +hist_preexisting_ice - add diagnostic output for the pre-existing ice + option to the history file +use_hoose_hetfrz - turn on the Hoose hetergeneous freezing option +hist_hoose_hetfrz - add diagnostic output for Hoose heterogeneous freezing + to the history file + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: CAM SEs on Wed Sep 10. + +List all subroutines eliminated: + +List all subroutines added and what they do: +models/atm/cam/src/physics/cam/hoose_hetfrz.F90 +. module for the Hoose heterogeneous freezing parameterization + +models/atm/cam/src/physics/cam/hoose_hetfrz_cam.F90 +. CAM interface layer for the hoose_hetfrz module + +models/atm/cam/src/physics/cam/nucleate_ice_cam.F90 +. CAM interface layer for the nucleate_ice module + +List all existing files that have been modified, and describe the changes: +models/atm/cam/bld/Makefile.in +. add options to gfortran debug flags to trap FPEs + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add logical variable use_hoose_hetfrz to enable Hoose heterogeneous + freezing (default: false) +. add logical variable hist_hoose_hetfrz to add default history output for + Hoose heterogeneous freezing (default: false) +. add use_preexisting_ice to enable treatment of pre-existing ice in the + ice_nucleation module (default: false) +. add hist_preexisting_ice to add default history output for the treatment + of pre-existing ice in the ice_nucleation module (default: false) + +models/atm/cam/src/physics/cam/micro_mg1_0.F90 +models/atm/cam/src/physics/cam/micro_mg1_5.F90 +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +. add code to optionally make use of three new inputs provided by the Hoose + heterogeneous freezing code + +models/atm/cam/src/physics/cam/microp_aero.F90 +. move code belonging to the CAM interface for nucleate_ice into the new + module, nucleate_ice_cam, created for that purpose. +. add method calls for the new Hoose heterogeneous freezing module. + +models/atm/cam/src/physics/cam/ndrop.F90 +. add new output for activation fraction for aerosol number + +models/atm/cam/src/physics/cam/nucleate_ice.F90 +. add option to treat pre-existing ice + +models/atm/cam/src/physics/cam/phys_control.F90 +. add use_hoose_hetfrz option + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. add function rad_cnst_get_mode_idx to find the mode index for a specific + mode type. +. add function rad_cnst_get_spec_idx to find the specie index for a specific + specie type. + +models/atm/cam/src/utils/cam_pio_utils.F90 +. function get_phys_ldof + - change local variable localhmask from pointer to allocatable, and add + explicit deallocate at end of function body. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit. There are currently no +tests that turn on the new options. May be good to add this with the MG2 +code option. + +=============================================================== +=============================================================== + +Tag name: cam5_3_48 +Originator(s): cacraig +Date: 09/11/2014 +One-line Summary: Update CAM regression tests, default compilation is now caldera, update homme and minor bug fix to gw_drag output + +Purpose of changes: + - Update CAM regression tests based on review by CAM SE group + - Since the gpgpu queue (exclusive node) can sometimes hold in the queue a long time, the default + is now caldera. A test of compilation times showed a difference of a few seconds in a series of + compilations which took 1.5 hours to compile. Introduced CALDERA_BATCHQ environment variable if + user wants to override. + - homme updated with bugs fixed to allow to work in CAM + - minor bug fix to gw_drag output + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D models/atm/cam/test/system/tests_pretag_bluefire +D models/atm/cam/test/system/tests_posttag_bluefire +D models/atm/cam/test/system/tests_pretag_jaguarpf_pgi_cb +D models/atm/cam/test/system/tests_pretag_jaguarpf_pgi +D models/atm/cam/test/system/tests_posttag_jaguar +D models/atm/cam/test/system/tests_posttag_jaguar_cb +D models/atm/cam/test/system/posttag_cron_bangkok.sh +D models/atm/cam/test/system/posttag_cron_bluevista.sh + - deleted tests for old machines + +D models/atm/cam/test/system/config_files/hn16c5aqdm + - renamed test to h16c5naqdm + +D models/atm/cam/test/system/tests_pretag_titan_pgi +D models/atm/cam/test/system/tests_posttag_titan_cb +D models/atm/cam/test/system/tests_posttag_titan +D models/atm/cam/test/system/tests_pretag_hopper_pgi +D models/atm/cam/test/system/tests_pretag_edison_intel + - removed pretag and posttag from names for remote machine tests + + +List all subroutines added and what they do: +A + models/atm/cam/test/system/config_files/h16c5naqdm + - renamed test from hn16c5aqdm + +A models/atm/cam/test/system/config_files/h16adh +A models/atm/cam/test/system/config_files/f10idm + - configurations for new tests + +A models/atm/cam/test/system/gen-test-coverage +A models/atm/cam/test/system/gen-test-table + - perl scripts to create web page CAM test information + +A models/atm/cam/test/system/nl_files/outfrq3s_lb0 +A models/atm/cam/test/system/nl_files/outfrq3s_lb2 +A models/atm/cam/test/system/nl_files/outfrq9s + - namelists for new tests + +A + models/atm/cam/test/system/tests_titan_pgi +A + models/atm/cam/test/system/tests_hopper_pgi +A + models/atm/cam/test/system/tests_edison_intel +A + models/atm/cam/test/system/tests_titan +A + models/atm/cam/test/system/tests_titan_cb + - removed pretag and posttag from names for remote machine tests + + +List all existing files that have been modified, and describe the changes: + M models/atm/cam +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated to new homme trunk tag + +M models/atm/cam/test/system/test_driver.sh + - introduced CALDERA_BATCHQ and changed default compilation queue for yellowstone jobs to caldera from gpgpu + +M models/atm/cam/test/system/tests_pretag_goldbach_nag +M models/atm/cam/test/system/tests_pretag_yellowstone + - introduced new tests and removed old ones + +M models/atm/cam/test/system/TEQ_ccsm.sh + - now compares cam.i files also + +M models/atm/cam/test/system/TSM_ccsm.sh + - selects outfrq file based on run length and output frequency type + +M models/atm/cam/test/system/nl_files/fcase + - changed to 9 time steps and request initial files + +M models/atm/cam/test/system/input_tests_master + - introduced new tests + +M models/atm/cam/bld/cam.buildnml.csh + - Introduced a check for NTHRDS_ATM > 1 and sets smp + +M models/atm/cam/bld/configure + - add CPP def -DHORIZ_OPENMP if se and smp is on + +M models/atm/cam/src/physics/cam/gw_drag.F90 + - changed format statement from i2 to i0 as integer could be > 99 and intel exits if not large enough + +M models/atm/cam/src/dynamics/se/dyn_comp.F90 + - ifdef was changed from ELEMENT_OPENMP to COLUMN_OPENMP or HORIZ_OPENMP + +M models/atm/cam/src/dynamics/se/interp_mod.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 +M models/atm/cam/src/dynamics/se/nctopo_util_mod.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 + - interface change for initEdgeBuffer + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +009 bl203 TBL.sh fsd1.9c4wtsmlth outfrq3s_sd+sd_1975-2010_ccmi_refc1_waccm_tsmlt 9s .....FAIL! rc= 7 at Tue Sep 9 19:09:31 MDT 2014 +012 bl322 TBL.sh f1.9c5nonedh outfrq3s_lb0 9s ...........................................FAIL! rc= 7 at Tue Sep 9 19:21:05 MDT 2014 +045 bl390 TBL.sh f1.9c4wmxh outfrq3s+waccmx_2000_cam4 9s ................................FAIL! rc= 7 at Tue Sep 9 20:49:20 MDT 2014 + - new tests + +063 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_2005-2100_cam4_rcp45 2d ......................FAIL! rc= 7 at Tue Sep 9 21:52:24 MDT 2014 + - Changed use case + +074 bl740 TBL.sh h30c5h outfrq3s_lb0 9s .................................................FAIL! rc= 7 at Tue Sep 9 22:09:51 MDT 2014 + - Changed the loadbalance and caused automatic cprnc to fail. Hand compared select files and they are BFB + +goldbach/nag: +003 bl335 TBL.sh f10idm idphys 9s .......................................................FAIL! rc= 7 at Thu Sep 11 10:33:45 MDT 2014 + - New test + +046 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s .............................FAIL! rc= 7 at Wed Sep 10 19:28:51 MDT 2014 + - Renamed test caused automatic cprnc to fail. Hand compared select files and they are BFB + +goldbach/pgi or jaguar/pgi: +062 bl734 TBL.sh h16c5naqdm outfrq3s_bam+aquaplanet_cam5 9s .............................FAIL! rc= 7 at Tue Sep 9 17:42:42 MDT 2014 + - Renamed test caused automatic cprnc to fail. Hand compared select files and they are BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_47 +Originator(s): santos +Date: 2014/09/05 +One-line Summary: Minor bug fix for MG microphysics. + +Purpose of changes: + +- Fix a change in cam5_3_26 that inadvertently made ice limiters for + outputs to the radiation inconsistent with the value of dcs internally + used by MG1. ("dcs" is the ice->snow autoconversion threshold.) + +- Tweak test_driver.sh so that it does not load two incompatible netcdf + modules on yellowstone. + +Bugs fixed (include bugzilla ID): + +- Bug 2038: MG uses wrong limiter on cloud ice particle size + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: None (straightforward bug fix) + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - Set cloud ice particle properties using version-specific value of + dcs. + +M models/atm/cam/test/system/test_driver.sh + - Remove load of the netcdf module, so that netcdf-mpi is correctly + loaded for yellowstone. (The "error" from the second load is not + fatal, and the netCDF version does not affect answers, so this + fix is only for I/O performance, and to match the environment + used for running with the CESM scripts.) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +011 bl137 TBL.sh e48c5h outfrq24h 2d ..........................................................FAIL! rc= 7 at Thu Sep 4 23:09:53 MDT 2014 +014 bl322 TBL.sh f1.9c5nonedh outfrq3s 9s .....................................................FAIL! rc= 7 at Thu Sep 4 23:16:15 MDT 2014 +019 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Thu Sep 4 23:27:54 MDT 2014 +027 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Thu Sep 4 23:37:37 MDT 2014 +042 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ..........................................................FAIL! rc= 7 at Thu Sep 4 23:56:27 MDT 2014 +046 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Fri Sep 5 00:09:03 MDT 2014 +049 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .........................................................FAIL! rc= 7 at Fri Sep 5 00:17:25 MDT 2014 +056 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Fri Sep 5 00:40:57 MDT 2014 +065 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Fri Sep 5 01:09:52 MDT 2014 +067 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Fri Sep 5 01:18:46 MDT 2014 +086 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Fri Sep 5 02:16:46 MDT 2014 +088 bl740 TBL.sh h30c5h outfrq3s 9s ...........................................................FAIL! rc= 7 at Fri Sep 5 02:19:29 MDT 2014 + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Sep 4 14:27:28 MDT 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Sep 4 14:37:22 MDT 2014 +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Sep 4 14:46:33 MDT 2014 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Sep 4 15:01:37 MDT 2014 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Thu Sep 4 15:33:04 MDT 2014 +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Thu Sep 4 15:47:34 MDT 2014 +042 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Thu Sep 4 16:21:51 MDT 2014 +046 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Sep 4 16:46:22 MDT 2014 +049 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 4 16:59:57 MDT 2014 +052 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Thu Sep 4 17:27:17 MDT 2014 + +goldbach/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Thu Sep 4 20:17:10 MDT 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Thu Sep 4 20:17:12 MDT 2014 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Thu Sep 4 20:17:12 MDT 2014 +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Thu Sep 4 20:17:15 MDT 2014 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Thu Sep 4 20:17:16 MDT 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Thu Sep 4 20:17:26 MDT 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Thu Sep 4 20:17:27 MDT 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Thu Sep 4 20:17:29 MDT 2014 +047 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Thu Sep 4 20:17:30 MDT 2014 +050 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Thu Sep 4 20:17:31 MDT 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Thu Sep 4 20:17:32 MDT 2014 +056 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 4 20:17:37 MDT 2014 +059 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Sep 4 20:17:41 MDT 2014 +062 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...................................FAIL! rc= 7 at Thu Sep 4 20:44:35 MDT 2014 + + +- All failures are CAM5 baseline changes due to MG changing answers. + + +Summarize any changes to answers, i.e., +- what code configurations: All with MG microphysics (CAM5) +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Larger than roundoff, same climate. + +=============================================================== +=============================================================== + +Tag name: cam5_3_46 +Originator(s): fvitt, Steve Ghan +Date: 28 Aug 2014 +One-line Summary: Include dust in the Aitken aerosol mode of MAM4 + +Purpose of changes: + - add dust to the Aitken aerosol mode in MAM4 + - corrections to build-namelist use cases + - change the PE threading in the regression tests for yellowstone to + improve performance + - misc bug fixes + +Bugs fixed (include bugzilla ID): + - fixed bug #2020 - online interpolation of vector fields from SE dynamics + grid broken (Jim Edwards) + - fixed bug #2003 - microp_uniform needs to not be hardwired to false (Cheryl Craig) + - a bug fix for cases where short lived (not transported) chemistry species + are not found in the IC file + - corrections in build namelist use cases: + . 1850-PD_cam5 (used in compset F1850PDC5) + . 1950-2100_ccmi_refc2_rcp85_waccm_ma + . 1950-2100_ccmi_refc2_waccm_tsmlt + . 1950-2100_ccmi_refc2_trop_strat_soa + . 2000_cam4_trop_strat_soa (used in compset FSSOA) + . 2000_cam5_trop_strat_mam3 (used in compsets BSTRATMAM3, FSTRATMAM3) + . 2000_cam5_trop_strat_mam7 (used in compsets BSTRATMAM7, FSTRATMAM7) + . 2000_cam4_trop_chem (used in compsets BMOZ, FMOZ) + . waccmx_2000_cam4 (used in compset FWX) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, santos, cacraig + +List all subroutines eliminated: + +D models/atm/cam/test/system/nl_files/user_nl_cam + - now use outfrq24h for CESM runs with run lengths in days + +List all subroutines added and what they do: + +A models/atm/cam/test/system/nl_files/outfrq1s + - namelist settings for high-frequency history output for 1-step tests + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TCB_ccsm.sh + - move setting the run-time options in user_nl_cam to TSM_ccsm.sh + +M models/atm/cam/test/system/test_driver.sh + - set CAM_THREADS=2 and CAM_RESTART_THREADS=1 and min_cpus_per_task=1 (not over subscribing the yellowstone nodes) + -- leaving CAM_THREADS=32 CAM_RESTART_THREADS=64 avoids performance issues that + arise when OMP_NUM_THREADS=1 or in pure MPI runs + +M models/atm/cam/test/system/TSM_ccsm.sh + - set user_nl_cam differently for run times lengths in steps -- high-frequency history output + . nl_files/outfrq24h is copied to user_nl_cam for run times lengths in days + . nl_files/outfrq1s is copied to user_nl_cam for run times lengths in steps + - remove all the cam.h* history files from the run directory (not just the *cam.h0* files) + - copy cam.i.* and cam.r.* files (in addition to cam.h* files) into the test dir + +M models/atm/cam/test/system/input_tests_master + - adjustments to use case files used in cam-chem regression tests + - run length of CESM chemistry preprocessor test changed from 2 days to 1 step + +M models/atm/cam/test/system/TNE_ccsm.sh + - compare not only cam.h0 files but also all cam.h*, cam.i.* and cam.r.* files + +M models/atm/cam/bld/configure + - trop_mam4 number of advect species increased from 23 to 24 + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - update to default mam4_mode2_file + +M models/atm/cam/bld/namelist_files/master_aer_drydep_list.xml + - include new dst_a2 (Aitken mode of dust) tracer in dry dep list + +M models/atm/cam/bld/namelist_files/master_aer_wetdep_list.xml + - include new dst_a2 (Aitken mode of dust) tracer in wet dep list + + +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml + - replaced 'SRFRAD' with 'FLDS' + - removed the 'D' from the OddOx* rxtn groups specifications + +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +M models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml + - corrections in OC and BC emissions + +M models/atm/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml + - fixed dates in 1850-2100 DMS emis file + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml + - correction in specifying prescribed stratospheric aerosols + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml + - correction in specifying prescribed stratospheric aerosols + - correction on pom_a3 vertical emissions file name + +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml + - correction in 1.9x2.5 IC file + +M models/atm/cam/bld/build-namelist + - include Aitken mode of dust in MAM4 mode specifier + +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.in + - include Aitken mode of dust in MAM4 chemistry mechanism + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +M models/atm/cam/src/chemistry/modal_aero/dust_model.F90 + - include Aitken mode of dust in MAM4 aerosol model + +M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 + - a bug fix for cases where short lived (not transported) chemistry species + are not found in the IC file + +M models/atm/cam/src/dynamics/se/interp_mod.F90 + - fixed bug #2020 - Jim Edwards + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - fixed bug #2003 - Cheryl Craig + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +065 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 7 at Mon Aug 25 20:51:24 MDT 2014 + +goldbach/nag: + +059 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Aug 27 13:26:39 MDT 2014 + +goldbach/pgi: + +049 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 7 at Wed Aug 27 13:19:14 MDT 2014 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_45 +Originator(s): cacraig +Date: 07/21/14 +One-line Summary: autogeneration of .F90 files from .F90.in, goldbach now uses modules, misc cleanup + +Purpose of changes: + - Files with .in.F90 extension are now automatically generated into .F90 by the CAM makefile. This mimics the + functionality which is done with CESM for these files. + - goldbach compilations in test_driver.sh are now using modules + - wei96 had a deprecated PAUSE command which has been commented out + - two non-existent directories were being referenced in configure. These have been removed + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - In the past, .F90.in files needed to be run by hand through genf90 to create the .F90 files. This has now been + incoporated in the CAM Makefile.in/mkSrcFiles/mkDepends in much that same way that CESM has incorporated it. + - test_driver.sh now uses modules on goldbach to select the appropriate libraries + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam/subcol_utils.F90 +D models/atm/cam/src/physics/cam/physics_buffer.F90 +D models/atm/cam/src/utils/buffer.F90 + - These three modules are now autogenerated from the .F90.in versions during the make process + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh + - goldbach now uses modules to identify library versions + +M models/atm/cam/bld/configure + - removed two obsolete directories which no longer exist + +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/mkSrcfiles +M models/atm/cam/bld/mkDepends + - generation of .F90 from .F90.in files now occurs automatically during the compilation process + +M models/atm/cam/src/chemistry/mozart/wei96.F90 + - commented out error check which had obsolete PAUSE statement + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS + +goldbach/nag: all PASS + +goldbach/pgi or jaguar/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_44 +Originator(s): cacraig +Date: 07/16/14 +One-line Summary: Update externals to cesm1_3_beta11 + +Purpose of changes: + - Update externals to cesm1_3_beta11 + - Conflicting namespace for abortutils in CAM and CLM which both use endrun (with different implementations) + Renamed CAM's abortutils module to cam_abortutils + - Updated to new chem_proc external which includes changes to cam_abortutils + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - coupler namelist variable "ocean_tight_coupling" replaced with "cpl_seq_option" + 'CESM1_MOD_TIGHT' is the setting which mimics turning on the old ocean_tight_coupling + - CLM namelist variable "fpftdyn" renamed to flanduse_timeseries - no other mods + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D models/atm/cam/src/utils/abortutils.F90 + - Removed due to namespace collision with CLM version + +List all subroutines added and what they do: +A models/atm/cam/src/utils/cam_abortutils.F90 + - old abortutils.F90 module is now named cam_abortutils.F90 - no other change + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES + - updated externals to match cesm1_3_beta11 + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated to CAM's externals which had changes to point to cam_abortutils + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist + - Contain changes for coupler and CLM nameslist changes + +M models/atm/cam/doc/ReleaseNotes + - Contains information for cam5_3_43 release + +M models/atm/cam/tools/interpic_new/interpolate_data.F90 +M models/atm/cam/tools/interpaerosols/Makefile +M models/atm/cam/bld/Makefile.in +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/ncdio_atm.F90 +M models/atm/cam/src/control/bnddyi.F90 +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/control/interpolate_data.F90 +M models/atm/cam/src/control/wrap_nf.F90 +M models/atm/cam/src/control/filenames.F90 +M models/atm/cam/src/control/wrap_mpi.F90 +M models/atm/cam/src/control/error_messages.F90 +M models/atm/cam/src/control/readinitial.F90 +M models/atm/cam/src/control/physconst.F90 +M models/atm/cam/src/control/cam_history_buffers.F90 +M models/atm/cam/src/control/intp_util.F90 +M models/atm/cam/src/control/camsrfexch.F90 +M models/atm/cam/src/control/units.F90 +M models/atm/cam/src/control/gauaw_mod.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/ioFileMod.F90 +M models/atm/cam/src/control/vrtmap.F90 +M models/atm/cam/src/control/cam_history_support.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam/subcol.F90 +M models/atm/cam/src/physics/cam/carma_flags_mod.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/ndrop_bam.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/boundarydata.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/phys_prop.F90 +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 +M models/atm/cam/src/physics/cam/chem_surfvals.F90 +M models/atm/cam/src/physics/cam/constituents.F90 +M models/atm/cam/src/physics/cam/radconstants.F90 +M models/atm/cam/src/physics/cam/subcol_utils.F90.in +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/rad_constituents.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +M models/atm/cam/src/physics/cam/dadadj.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/phys_grid.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 +M models/atm/cam/src/physics/cam/unicon_cam.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/majorsp_diffusion.F90 +M models/atm/cam/src/physics/cam/cam3_aero_data.F90 +M models/atm/cam/src/physics/cam/comsrf.F90 +M models/atm/cam/src/physics/cam/tphysidl.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/tracers_suite.F90 +M models/atm/cam/src/physics/cam/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/hk_conv.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/ghg_data.F90 +M models/atm/cam/src/physics/cam/radiation_data.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/subcol_utils.F90 +M models/atm/cam/src/physics/cam/radlw.F90 +M models/atm/cam/src/physics/cam/co2_data_flux.F90 +M models/atm/cam/src/physics/cam/radae.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/phys_debug_util.F90 +M models/atm/cam/src/physics/cam/cam3_ozone_data.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/co2_cycle.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/rad_solar_var.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in +M models/atm/cam/src/physics/cam/aoa_tracers.F90 +M models/atm/cam/src/physics/cam/subcol_tstcp.F90 +M models/atm/cam/src/physics/cam/ref_pres.F90 +M models/atm/cam/src/physics/cam/conv_water.F90 +M models/atm/cam/src/physics/cam/ionosphere.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/waccmx/ionosphere.F90 +M models/atm/cam/src/physics/carma/cam/carma_getH2SO4.F90 +M models/atm/cam/src/physics/carma/cam/carma_getT.F90 +M models/atm/cam/src/physics/carma/cam/carma_getH2O.F90 +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/tholin/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/tholin/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_cloudfraction.F90 +M models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/waccm/nlte_fomichev.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccm/nlte_lw.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +M models/atm/cam/src/physics/rrtmg/slingo.F90 +M models/atm/cam/src/physics/rrtmg/radconstants.F90 +M models/atm/cam/src/physics/rrtmg/oldcloud.F90 +M models/atm/cam/src/physics/rrtmg/radlw.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/rad_solar_var.F90 +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +M models/atm/cam/src/physics/rrtmg/radsw.F90 +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/utils/sgexx.F90 +M models/atm/cam/src/utils/buffer.F90 +M models/atm/cam/src/utils/buffer.F90.in +M models/atm/cam/src/utils/spmd_utils.F90 +M models/atm/cam/src/utils/cam_pio_utils.F90 +M models/atm/cam/src/utils/cam_dom/sst_data.F90 +M models/atm/cam/src/utils/cam_dom/ocn_time_manager.F90 +M models/atm/cam/src/utils/cam_dom/ocn_comp.F90 +M models/atm/cam/src/utils/cam_aqua/ocn_comp.F90 +M models/atm/cam/src/utils/hycoef.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/dust_model.F90 +M models/atm/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 +M models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 +M models/atm/cam/src/chemistry/bulk_aero/mo_setsoa.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_model.F90 +M models/atm/cam/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +M models/atm/cam/src/chemistry/aerosol/dust_common.F90 +M models/atm/cam/src/chemistry/aerosol/dust_sediment_mod.F90 +M models/atm/cam/src/chemistry/aerosol/soil_erod_mod.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/utils/aerodep_flx.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/mo_msis_ubc.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_deposition.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +M models/atm/cam/src/chemistry/utils/horizontal_interpolate.F90 +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 +M models/atm/cam/src/chemistry/utils/prescribed_strataero.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/utils/solar_data.F90 +M models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +M models/atm/cam/src/chemistry/utils/time_utils.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/mozart/mo_seto2.F90 +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +M models/atm/cam/src/chemistry/mozart/wei96.F90 +M models/atm/cam/src/chemistry/mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/mozart/mo_cph.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +M models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +M models/atm/cam/src/chemistry/mozart/gas_wetdep_opts.F90 +M models/atm/cam/src/chemistry/mozart/mo_heatnirco2.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +M models/atm/cam/src/chemistry/mozart/apex_subs.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/mo_jeuv.F90 +M models/atm/cam/src/chemistry/mozart/spehox.F90 +M models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +M models/atm/cam/src/chemistry/mozart/chlorine_loading_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_ghg_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_mean_mass.F90 +M models/atm/cam/src/chemistry/mozart/mo_airglow.F90 +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/mo_photoin.F90 +M models/atm/cam/src/chemistry/mozart/spedata.F90 +M models/atm/cam/src/chemistry/mozart/noy_ubc.F90 +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 +M models/atm/cam/src/chemistry/mozart/rate_diags.F90 +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/mo_setz.F90 +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 +M models/atm/cam/src/chemistry/mozart/mo_snoe.F90 +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 +M models/atm/cam/src/chemistry/mozart/euvac.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +M models/atm/cam/src/chemistry/mozart/cfc11star.F90 +M models/atm/cam/src/chemistry/mozart/efield.F90 +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +M models/atm/cam/src/chemistry/mozart/mo_tuv_inti.F90 +M models/atm/cam/src/chemistry/mozart/mo_xsections.F90 +M models/atm/cam/src/chemistry/mozart/mo_inter.F90 +M models/atm/cam/src/chemistry/mozart/gcr_ionization.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 +M models/atm/cam/src/dynamics/sld/sld_control_mod.F90 +M models/atm/cam/src/dynamics/sld/trunc.F90 +M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M models/atm/cam/src/dynamics/sld/sltint.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/sld/interp_mod.F90 +M models/atm/cam/src/dynamics/sld/initcom.F90 +M models/atm/cam/src/dynamics/sld/dp_coupling.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/sld/nmmatrix.F90 +M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +M models/atm/cam/src/dynamics/eul/cubydr.F90 +M models/atm/cam/src/dynamics/eul/trunc.F90 +M models/atm/cam/src/dynamics/eul/herxin.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M models/atm/cam/src/dynamics/eul/sphdep.F90 +M models/atm/cam/src/dynamics/eul/lagyin.F90 +M models/atm/cam/src/dynamics/eul/eul_control_mod.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/interp_mod.F90 +M models/atm/cam/src/dynamics/eul/initcom.F90 +M models/atm/cam/src/dynamics/eul/dp_coupling.F90 +M models/atm/cam/src/dynamics/eul/settau.F90 +M models/atm/cam/src/dynamics/eul/scanslt.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 +M models/atm/cam/src/dynamics/eul/limdx.F90 +M models/atm/cam/src/dynamics/se/dyn_grid.F90 +M models/atm/cam/src/dynamics/se/interp_mod.F90 +M models/atm/cam/src/dynamics/se/native_mapping.F90 +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/se/spmd_dyn.F90 +M models/atm/cam/src/dynamics/se/nctopo_util_mod.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 +M models/atm/cam/src/dynamics/se/restart_dynamics.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/mapz_module.F90 +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +M models/atm/cam/src/dynamics/fv/ctem.F90 +M models/atm/cam/src/dynamics/fv/te_map.F90 +M models/atm/cam/src/dynamics/fv/fv_control_mod.F90 +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 +M models/atm/cam/src/dynamics/fv/pfixer.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/interp_mod.F90 +M models/atm/cam/src/dynamics/fv/initcom.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 +M models/atm/cam/src/advection/slt/qmassa.F90 +M models/atm/cam/src/unit_drivers/drv_input_data.F90 +M models/atm/cam/src/unit_drivers/rad/unit_driver.F90 +M models/atm/cam/src/unit_drivers/offline_driver.F90 +M models/atm/cam/src/cpl/atm_comp_mct.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS + +goldbach/nag: all PASS + +goldbach/pgi or jaguar/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_43 +Originator(s): fvitt +Date: 11 July 2014 +One-line Summary: Include MAM4 aerosol model + +Purpose of changes: + + Place 4-mode version of the modal aerosol model (MAM4) on the development trunk. + +Bugs fixed (include bugzilla ID): 1994 + - ocphiwet deposition missing contributions from soa_a2 and soa_c2 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, santos + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/pp_trop_mam4 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mam4/chem_mech.in + - chemistry preprocessor generated source code for MAM4 chemistry package + +A models/atm/cam/test/system/config_files/f4mode1.9c5dh +A models/atm/cam/test/system/config_files/f4mode4c5dm + - regressions tests added for MAM4 + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml + - fixed issues for the FSDSSOA compset (problems introduced in tag cam5_3_41) + +M models/atm/cam/src/chemistry/utils/modal_aero_deposition.F90 + - included contributions from MAM4 aerosols and added soa_a2 to the ocphiwet fluxes + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/master_aer_drydep_list.xml +M models/atm/cam/bld/namelist_files/master_aer_wetdep_list.xml +M models/atm/cam/bld/build-namelist + +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +M models/atm/cam/src/chemistry/modal_aero/seasalt_model.F90 +M models/atm/cam/src/chemistry/modal_aero/dust_model.F90 +M models/atm/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 + - mods for MAM4 + +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/tests_pretag_goldbach_nag +M models/atm/cam/test/system/tests_pretag_goldbach_pgi +M models/atm/cam/test/system/input_tests_master + - regressions tests added for MAM4 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +065 bl421 TBL.sh f1.9c5mam4dh outfrq3s 9s .....................................................FAIL! rc= 5 at Thu Jul 10 13:25:06 MDT 2014 + +goldbach/nag: + +049 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 5 at Thu Jul 10 12:17:47 MDT 2014 + +goldbach/pgi: + +056 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Thu Jul 10 11:42:00 MDT 2014 +059 bl422 TBL.sh f4c5mam4dm outfrq3s 9s .......................................................FAIL! rc= 5 at Thu Jul 10 11:55:20 MDT 2014 + +** Answer changes for MAM7 configurations are due to change in n_so4_monolayers_pcage parameter in modal_aero_gasaerech +and change in default primary organic mater aerosol optics input file (ocpho_rrtmg) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_42 +Originator(s): jedwards, cacraig +Date: 07/01/2014 +One-line Summary: Fix homme compilation issues and add homme NAG test + +Purpose of changes: + - Fix homme compilation issues + - add homme NAG test + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_goldbach_nag + - add homme NAG regression test + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Use homme branch that Jim provided which fixes compilation issues + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: Just ran homme tests, 731, 735, 740 and 751 all PASS and are BFB + +goldbach/nag: Ran newly introduced 734 test and it PASSes. Could not run baseline due to compilation bug in cam5_3_41 homme. + +goldbach/pgi or jaguar/pgi: Only ran 734 tests and all PASS and BFB. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_41 +Originator(s): fvitt, dkin, tilmes, lamar +Date: 25 June 2014 +One-line Summary: CCMI chemistry and bug fixes + +Purpose of changes: + + Bring in changes used in the Chemistry-Climate Model Initiative (CCMI) + simulations. These changes are summarized as follows: + + - new chemistry package: + waccm_tsmlt + - CCMI diagnostic tracers added to: + trop_mozart_soa + trop_strat_soa + - chemistry mechanism updates to: + waccm_mozart + + - updates to mo_sad (from Doug Kinnison) + + - rate updates in usrrxt + + - enthalpies for exothermic reaction chemicals are now specified + in mechanism file (for WACCM) + + - new specified stratospheric aerosols (volcanic) + + - give user ability to specify a different rhmin poleward of 60 deg + and above a specified pressure level (300 mbar default) + + - CAM-Chem now has ability to include NOx and HOx sources from solar protons + + - ability to include NOx and HOx sources from galactic cosmic ray ionization + + - background ionization from star light added to WACCM + + - corrections to age-of-air tracers (from Valery) + + - specified dynamics namelist option met_max_rlx replaced by met_rlx_time (hours) + + - history changes: + . increased number of fields in fincls from 750 to 1000 + . can have upto 10 simultaneous history files (or streams) + + - corrections to aerosol surface area used in usrrxt + + - neu_wetdep changes + . set TICE to 263 + . disable wet deposition poleward of 60 degrees and pressures < 200 mbar + + - chemistry preprocessor updates: + -- enthalpies for chemical potential heating now specified in mechanism files + -- added ability to put comments at the end of reactions in mechanism file following '#' or '!' + -- bug fixes for species names longer than 8 characters (up to 16 characters) + -- mo_imp_sol changes + . compute o3 loss rates for middle atm chem + . changes to appease NAG compiler (lines cannot be longer than 128 chars) + . added 'H_PEROX_CHMP' diagnostic + . changes needed for changes in reaction tag names convention + . added o3s_loss optional argument -- o3s loss below tropopause is implimented in chemdr + + Fix bugs: + - remove duplicate line "g1=g1sqrt*g1" in ndrop + - correction to Henry's Law parameters used for SO2 deposition + + Regression testing capability added for CGD leehill machine (cacraig) + + Regression tests configuration files renamed to follow naming convention: + (dycore)(sd?)(res)(phys)(chem)(debug?)(mpi/openmp/hybrid) + +Bugs fixed (include bugzilla ID): + + Bug 1983: + - remove duplicate line "g1=g1sqrt*g1" in maxsat subroutine + models/atm/cam/src/physics/cam/ndrop.F90 + + Bug 2000: + - correction to Henry's Law parameters used for SO2 deposition + models/drv/shr/seq_drydep_mod.F90 + models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, santos + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 + - removed -- prescribed_strataero provides SADs + +D models/atm/cam/test/system/config_files/fst7mode1.9c5h +D models/atm/cam/test/system/config_files/fsoa1.9c4dh +D models/atm/cam/test/system/config_files/wx1.9c4dh +D models/atm/cam/test/system/config_files/fmz4c5dm +D models/atm/cam/test/system/config_files/fm1.9c5dh +D models/atm/cam/test/system/config_files/fs1.9c4dh +D models/atm/cam/test/system/config_files/fsf1.9c5dh +D models/atm/cam/test/system/config_files/wm1.9c4h +D models/atm/cam/test/system/config_files/wg1.9c4dm +D models/atm/cam/test/system/config_files/wm1.9c5dh +D models/atm/cam/test/system/config_files/wm1.9c4m +D models/atm/cam/test/system/config_files/fst1.9c4dh +D models/atm/cam/test/system/config_files/fm1.9c4m +D models/atm/cam/test/system/config_files/fma1.9c4m +D models/atm/cam/test/system/config_files/fprgspc4c4dm +D models/atm/cam/test/system/config_files/wm4c4h +D models/atm/cam/test/system/config_files/wg4c4dm +D models/atm/cam/test/system/config_files/fsf4c4dm +D models/atm/cam/test/system/config_files/fmo1.9c4dh +D models/atm/cam/test/system/config_files/f7mode1.9c5dh +D models/atm/cam/test/system/config_files/wg10c4dm +D models/atm/cam/test/system/config_files/fst4c5dm +D models/atm/cam/test/system/config_files/fm1.9c4dh +D models/atm/cam/test/system/config_files/fsf1.9c4dh +D models/atm/cam/test/system/config_files/fn10c5dm +D models/atm/cam/test/system/config_files/f7mode4c5dm +D models/atm/cam/test/system/config_files/fsm4c5dm +D models/atm/cam/test/system/config_files/fsoa4c4dm +D models/atm/cam/test/system/config_files/fst7mode4c5dm +D models/atm/cam/test/system/config_files/wx1.9c4h +D models/atm/cam/test/system/config_files/fst1.9c5dh +D models/atm/cam/test/system/config_files/fmgpa1.9c4dm +D models/atm/cam/test/system/config_files/fn1.9c5dh + - renamed following convention : + (dycore)(sd?)(res)(phys)(chem)(debug?)(mpi/openmp/hybrid) + new file names are below + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/mozart/gcr_ionization.F90 + - new GCR sources of NOx and HOx + +A models/atm/cam/src/chemistry/mozart/noy_ubc.F90 + - new module for CAM-Chem NOy upper boundary intended for NOy from solar proton + ionization sources above model top + +A models/atm/cam/src/chemistry/mozart/photo_bkgrnd.F90 + - new module for WACCM to prameterize background ionization by star light + +A models/atm/cam/src/chemistry/utils/prescribed_strataero.F90 + - new module for prescribed stratospheric aerosols (volcanic) + +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_tsmlt/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_tsmlt + - new chem pkg + +A models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_moz_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/2004-2100_ccmi_refc2_rcp45_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_tsmlt.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_ma.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_tsmlt.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_2007-2011_htap_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/2000_ccmi_refc1_waccm_tsmlt.xml +A models/atm/cam/bld/namelist_files/use_cases/1979-2010_sd_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_rcp85_waccm_ma.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tsmlt_geos5.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_waccm_ma.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccm_tsmlt.xml +A models/atm/cam/bld/namelist_files/use_cases/2007-2011_htap_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_strataero_rcp45.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_1975-2010_ccmi_refc1_waccm_ma.xml +A models/atm/cam/bld/namelist_files/use_cases/1950-2100_ccmi_refc2_trop_strat_soa.xml + - new use cases for CCMI simulations + +A models/atm/cam/test/system/tests_pretag_leehill + - added for CGD leehill machine (cacraig) + +A models/atm/cam/test/system/nl_files/outfrq3s_neu +A models/atm/cam/test/system/nl_files/outfrq3s_sd + - regression tests namelist files added + +A models/atm/cam/test/system/tests_ccmi_hybrid +A models/atm/cam/test/system/tests_ccmi_mpi + - new tests for the CCMI configurations + +A models/atm/cam/test/system/config_files/f10c4wtsmltdm +A models/atm/cam/test/system/config_files/f1.9c4wtsmltdh +A models/atm/cam/test/system/config_files/fsd1.9c4wtsmltdh +A models/atm/cam/test/system/config_files/f1.9c4wtsmlth +A models/atm/cam/test/system/config_files/f4c4wtsmltdh +A models/atm/cam/test/system/config_files/fsd1.9c4wtsmlth +A models/atm/cam/test/system/config_files/f1.9c4wtssoadh +A models/atm/cam/test/system/config_files/fsd1.9c4wtssoadh +A models/atm/cam/test/system/config_files/f4c4wtssoadh +A models/atm/cam/test/system/config_files/f4c4wtssoadm +A models/atm/cam/test/system/config_files/fsd1.9c4wtssoah +A models/atm/cam/test/system/config_files/f1.9c4tssoadh +A models/atm/cam/test/system/config_files/f4c4wmdh +A models/atm/cam/test/system/config_files/fsd1.9c4wmdh +A models/atm/cam/test/system/config_files/fsd1.9c4wmh + - new + +A models/atm/cam/test/system/config_files/f1.9c4wghgdm +A models/atm/cam/test/system/config_files/f1.9c4mozdh +A models/atm/cam/test/system/config_files/f10c5nonedm +A models/atm/cam/test/system/config_files/f4c4wghgdm +A models/atm/cam/test/system/config_files/f1.9c5mam7dh +A models/atm/cam/test/system/config_files/f10c4wghgdm +A models/atm/cam/test/system/config_files/f1.9c4wmh +A models/atm/cam/test/system/config_files/f1.9c4wmdh +A models/atm/cam/test/system/config_files/f1.9c4wmm +A models/atm/cam/test/system/config_files/f4c5mam7dm +A models/atm/cam/test/system/config_files/f1.9c5tsmam3dh +A models/atm/cam/test/system/config_files/f1.9c5fstmam3dh +A models/atm/cam/test/system/config_files/f4c4soadm +A models/atm/cam/test/system/config_files/f1.9c4bamm +A models/atm/cam/test/system/config_files/f1.9c5mzmam3dh +A models/atm/cam/test/system/config_files/f4c5tsmam3dm +A models/atm/cam/test/system/config_files/f4c5tsmam7dm +A models/atm/cam/test/system/config_files/fsd1.9c4mozdh +A models/atm/cam/test/system/config_files/f1.9c5tsmam7h +A models/atm/cam/test/system/config_files/f4c5mzmam3dm +A models/atm/cam/test/system/config_files/f1.9c4ghgdm +A models/atm/cam/test/system/config_files/f1.9c5wmam3dh +A models/atm/cam/test/system/config_files/f1.9c4soadh +A models/atm/cam/test/system/config_files/f1.9c4fastdh +A models/atm/cam/test/system/config_files/f4c4prgspcdm +A models/atm/cam/test/system/config_files/f1.9c4mozm +A models/atm/cam/test/system/config_files/f1.9c4wmxh +A models/atm/cam/test/system/config_files/f1.9c4wmxdh +A models/atm/cam/test/system/config_files/f4c4wmh +A models/atm/cam/test/system/config_files/f4c4fastdm +A models/atm/cam/test/system/config_files/f1.9c5nonedh +A models/atm/cam/test/system/config_files/f4c5fstmam3dm + - renamed + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - update models/drv external to drvseq5_0_13 -- has correction to Henry's Law parameters for SO2 + in shr/seq_drydep_mod.F90 + +M models/atm/cam/bld/cam.buildnml.csh + - added warning messages (cacraig) + +M models/atm/cam/bld/configure + - added waccm_tsmlt + - changes in chem_nadv for + trop_mozart_soa + trop_strat_soa + waccm_mozart + - remove useless DUST and PROGSSLT cpp defs + +M models/atm/cam/bld/config_files/definition.xml + - added waccm_tsmlt + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - simplified/reduced many defaults + - updates in defaults for photolysis, stratospheric aerosols + - defaults for new waccm_tsmlt chem + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - met_max_rlx --> met_rlx_time (hours) + Relaxation time (hours) applied to specified meteorology. + - positive values less then time step size gives 100% nudging + - negative values gives 0.0% nudging (infinite relaxation time) + - expanded history streams from 6 to 10 + - increased number of fields in fincls from 750 to 1000 + - added namelist options: + rxt_rate_sums -- to specify rate families (or groupings) diagnostics based + on reaction tag names + cldfrc_rhminp -- min rh for high stable clouds poleward of 60 degrees + cldfrc_rhminp_botmb -- max pressure (mbar) where cldfrc_rhminp is applied + noy_ubc_* options for NOy upper boundary conditions for CAM-Chem to include SPE + NOx source obove the model top + gcr_ionization_* options for GCR ionizations for NOx and HOx producation + sulf_* options (serial, cyclic, or fixed) for tropospheric sulfate aerosols + prescribed_strataero_* options for prescribed stratospheric aerosols + - removed + sad_* options + +M models/atm/cam/bld/build-namelist + - die if cldfrc_rhminp is set and microphys is not 'rk' + - waccm_tsmlt changes + - set default wetdep method + - rad_climate includes CFC11STAR for trop_strat waccm_mozart waccm_tsmlt + - if strat_aero_feedback use VOLC_MMR rather than H2SO4M in rad_climate + - "sad_file" replaced by "prescribed_strataero_file" + - set cam_chempkg to "waccm_mozart" for waccm_tsmlt as well as waccm_mozart_sulfur + +M models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 + - surface area corrections +M models/atm/cam/src/chemistry/bulk_aero/mo_setsoa.F90 + - rate tags changes + - corrections in soa_yield() + +M models/atm/cam/src/chemistry/modal_aero/aero_model.F90 + - removed reference to ref_pres module -- not used + +M models/atm/cam/src/chemistry/mozart/cfc11star.F90 + - expanded for the additional waccm_tsmlt CFC species + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - include GRCs + - no longer fix CO and CO2 at upper boundary (now have zero flux) + - invoke register_cfc11star for CAM-Chem as well as WACCM + - include SPEs for CAM-Chem (and NOy upper boundary) + - sad namelist vars removed (mo_sad now reads its own namelist) + - change find tropopuase method for non-super_fast mechanisms + +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 + - added module-level initialized flag + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - cam-chem can init spe module, which initializes mo_apex if needed + - strato_sad_inti removed (now prescribed_strataero reads SADs) + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - diagnostics added for waccm_tsmlt + - added DOCHM_LMS and DOCHM_TRP for CCMI simulations + +M models/atm/cam/src/chemistry/mozart/mo_cph.F90 + - refactored to be more flexable -- enthalpy data are now specified in + chemistry preprocessor input files (cph=nnnn) + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - some code cleanup + - added O3S + - unstructured grid fix + +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 + - alt_data columns are now reversed in tracer_data + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - added code for CCMI diagnostic tracers + - NOy uppper boundary + - SAD from phys buffer + +M models/atm/cam/src/chemistry/mozart/mo_ghg_chem.F90 + - correction in diagnostic GHG_CH4_R + +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - set TICE to 263. + - set dtwr to zero poleward of 60 degrees and press < 200 mbar + - added SO2t and NH_50W + - added HF COF2 and COFCL + - removed gamma function -- use csm_share version + - correction to Henry's Law parameters used for SO2 deposition (in seq_drydep_mod) + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - added background ionization for waccm + +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 + - science changes from Doug Kinnison + +M models/atm/cam/src/chemistry/mozart/mo_setext.F90 + - added GCR sources of NOx and HOx + - make SPE sources available to CAM-Chem as well as WACCM + - AOA_NH forcings for CCMI simulations + +M models/atm/cam/src/chemistry/mozart/mo_solarproton.F90 + - added a check for presence of SPEs in simulation + +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 + - options added for cyclical and serial inputs + +M models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 + - now only specify H2 at upper boundary (removed CO and CO2) + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - rate updates for + cl2o2 + m --> 2*clo + m + ho2 + ho2 --> h2o2 + - added aerosol losses above tropopause + +M models/atm/cam/src/chemistry/mozart/rate_diags.F90 + - added functionality to provide rate groupings (sumations) + +M models/atm/cam/src/chemistry/mozart/spedata.F90 + - make spe_run public/protected + - initialize apex module if needed + +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 + - added F and HF fixed upper boundaries + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - added geop_alt option + - reverse vertical coordinate for alt_data in interpolated + - pgi 13.9 bug workaround (santos) + +M models/atm/cam/src/control/cam_history_support.F90 + - ptapes changed from 8 to 12 (to have 10 history streams) + - pflds increased from 750 to 1000 (fincls can have 1000 fields) + +M models/atm/cam/src/control/runtime_opts.F90 + - invoke _readnl for modules: + prescribed_strataero + rate_diags + - expanded history namelist arrays from 6 to 10 + - default for collect_column_output changed from .false. to .true. to avoid memory leak + +M models/atm/cam/src/dynamics/fv/metdata.F90 + - met_max_rlx replaced by met_rlx_time + +M models/atm/cam/src/dynamics/se/interp_mod.F90 + - mods to deal with the length of interpolate_analysis is NOT equal to mtapes + (which is now increased to 12) + +M models/atm/cam/src/physics/cam/aoa_tracers.F90 + - corrections to age-of-air tracers (Valery Yudin) + +M models/atm/cam/src/physics/cam/cloud_fraction.F90 + - give user ability to specify a different rhmin poleward of 60 deg + and above a specified pressure level (300 mbar default) + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - use molecular weight of H2O rather than dry air for the water constituents + +M models/atm/cam/src/physics/cam/stratiform.F90 + - use molecular weight of H2O rather than dry air for the water constituents + +M models/atm/cam/src/physics/cam/ndrop.F90 + - remove duplicate line "g1=g1sqrt*g1" in maxsat subroutine ( Bug 1983 ) + +M models/atm/cam/src/physics/cam/physpkg.F90 + - invoke prescribed_strataero methods + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - chem preprocessor updates + -- enthalpies for chemical potential heating now specified in mechaism files + -- added ability to put comments at the end of reactions in mechanism file following '#' or '!' + -- bug fixes for species names longer than 8 characters (up to 16 characters) + -- mo_imp_sol changes + . compute o3 loss rates for middle atm chem + . changes to appease NAG compiler (lines cannot be longer than 128 chars) + . added 'H_PEROX_CHMP' diagnostic + . changes needed for changes in reaction tag names convention + . added o3s_loss optional argument -- o3s loss below tropopause is implimented in chemdr + + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.in +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_none/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_none/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_none/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_none/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_none/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_none/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_none/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_none/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_none/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_none/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_none/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_bam/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/m_spc_id.F90 + - mechanism updates + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/cam5_trop_strat_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml + - use case changes for SAD inputs and misc cleanup + +M models/atm/cam/test/system/CAM_runcmnd.sh + - added CGD leehill machine (cacraig) + +M models/atm/cam/test/system/test_driver.sh + - increased status standard output line to 95 characters + - added CGD leehill machine (cacraig) + +M models/atm/cam/test/system/input_tests_master + - added new regression tests + - many existing regression test config files renamed + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +011 bl137 TBL.sh e48c5h outfrq24h 2d ..........................................................FAIL! rc= 7 at Tue Jun 24 16:59:13 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +014 bl322 TBL.sh f1.9c5nonedh outfrq3s 9s .....................................................FAIL! rc= 7 at Tue Jun 24 17:05:22 MDT 2014 + - no baseline to compare against -- regression test name changed +017 bl326 TBL.sh f1.9c4wghgdm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s ..................FAIL! rc= 7 at Tue Jun 24 17:15:52 MDT 2014 + - no baseline to compare against -- regression test name changed +019 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Jun 24 17:17:23 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +027 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...................................................FAIL! rc= 7 at Tue Jun 24 17:28:44 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +039 bl336 TBL.sh f4c4wmdh outfrq3s+waccm_1850_cam4 9s .........................................FAIL! rc= 7 at Tue Jun 24 17:44:16 MDT 2014 + - no baseline to compare against -- regression test name changed +042 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ..........................................................FAIL! rc= 7 at Tue Jun 24 17:51:54 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +046 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ................................................FAIL! rc= 7 at Tue Jun 24 18:06:50 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +049 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .........................................................FAIL! rc= 7 at Tue Jun 24 18:15:14 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +054 bl373 TBL.sh f1.9c4mozdh outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Jun 24 18:35:31 MDT 2014 + - no baseline to compare against -- regression test name changed +056 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...............................................FAIL! rc= 7 at Tue Jun 24 18:38:10 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +058 bl376 TBL.sh f1.9c4mozdh+testmech outfrq3s 9s .............................................FAIL! rc= 7 at Tue Jun 24 18:44:19 MDT 2014 + - no baseline to compare against -- regression test name changed +061 bl374 TBL.sh f1.9c4fastdh outfrq3s+1850-2005_cam4_super_fast_llnl 9s ......................FAIL! rc= 7 at Tue Jun 24 18:52:00 MDT 2014 + - no baseline to compare against -- regression test name changed +063 bl430 TBL.sh f1.9c5mzmam3dh outfrq3s_NEUwetdep 9s .........................................FAIL! rc= 7 at Tue Jun 24 19:00:57 MDT 2014 + - no baseline to compare against -- regression test name changed +066 bl440 TBL.sh f1.9c4soadh outfrq3s+soa_chem_megan_emis 9s ..................................FAIL! rc= 7 at Tue Jun 24 19:17:54 MDT 2014 + - no baseline to compare against -- regression test name changed +076 bl379 TBL.sh f1.9c4wmh outfrq24h+waccm_1850-2005_cam4 2d ..................................FAIL! rc= 7 at Tue Jun 24 19:43:52 MDT 2014 + - no baseline to compare against -- regression test name changed +082 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ........................................FAIL! rc= 7 at Tue Jun 24 19:58:22 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +084 bl740 TBL.sh h30c5h outfrq3s 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 20:01:07 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +094 bl010 TBL.sh f4c5portdh outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Jun 24 22:15:49 MDT 2014 + - change cfc11 to cfc11star in rad_climate specification (trop_start_mam3 chem configuration) + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 15:05:51 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Jun 24 15:15:26 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +014 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Jun 24 15:25:00 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Jun 24 15:38:11 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 16:09:16 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +031 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Jun 24 16:21:53 MDT 2014 + - no baseline to compare against -- regression test name changed +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Jun 24 16:23:58 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +042 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..............................................FAIL! rc= 7 at Tue Jun 24 17:00:45 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +046 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..............................................FAIL! rc= 7 at Tue Jun 24 17:32:53 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix + +goldbach/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 15:05:54 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +010 bl112 TBL.sh e8c5dm ghgrmp 9s .............................................................FAIL! rc= 7 at Tue Jun 24 15:14:33 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ..........................................FAIL! rc= 7 at Tue Jun 24 15:20:49 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +016 bl114 TBL.sh e8c5dm co2rmp 9s .............................................................FAIL! rc= 7 at Tue Jun 24 15:23:45 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ..........................................................FAIL! rc= 7 at Tue Jun 24 15:39:07 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 16:07:09 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +036 bl314 TBL.sh f10c4wghgdm outfrq3s 9s ......................................................FAIL! rc= 7 at Tue Jun 24 16:22:18 MDT 2014 + - no baseline to compare against -- regression test name changed +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .........................................FAIL! rc= 7 at Tue Jun 24 16:39:10 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .........................................................FAIL! rc= 7 at Tue Jun 24 16:50:17 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +047 bl319 TBL.sh f10c5nonedm outfrq3s_bam 9s ..................................................FAIL! rc= 7 at Tue Jun 24 16:59:35 MDT 2014 + - no baseline to compare against -- regression test name changed +050 bl320 TBL.sh f10c5nonedm rad_diag 9s ......................................................FAIL! rc= 7 at Tue Jun 24 17:02:00 MDT 2014 + - no baseline to compare against -- regression test name changed +053 bl321 TBL.sh f10c5cdm atrain 9s ...........................................................FAIL! rc= 7 at Tue Jun 24 17:05:20 MDT 2014 + - expected failure -- trop_mam3 chem changes, ndrop bug fix +056 bl420 TBL.sh f4c5mam7dm outfrq3s 9s .......................................................FAIL! rc= 7 at Tue Jun 24 17:21:54 MDT 2014 + - no baseline to compare against -- regression test name changed +061 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .................................................FAIL! rc= 7 at Tue Jun 24 17:55:39 MDT 2014 + - change cfc11 to cfc11star in rad_climate specification (trop_start_mam3 chem configuration) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: cam5, waccm, cam-chem +- what platforms/compilers: All +- nature of change: larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/ccmi_cam5_3_40_tags/ccmi07_cam5_3_40 +- platform/compilers: + yellowstone / intel +- configure commandline: + create_newcase -mach yellowstone -compset FC5 -res f19_f19 -case /glade/p/acd/fvitt/cesm/cases/f.e13.FC5.f19_f19.test.011 +- build-namelist command (or complete namelist): + defaults for the FC5 f19_f19 configuration +- MSS location of output: + /home/fvitt/csm/f.e13.FC5.f19_f19.test.011 + +MSS location of control simulations used to validate new climate: + /home/fvitt/csm/f.e13.FC5.f19_f19.cntl.001 + +URL for AMWG diagnostics output used to validate new climate: +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.f19_f19.test.011/atm/f.e13.FC5.f19_f19.test.011-f.e13.FC5.f19_f19.cntl.001/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_40 +Originator(s): eaton +Date: Thu May 22 11:26:49 MDT 2014 +One-line Summary: Add hooks for UNICON; add ne120 aquaplanet IC files. + +Purpose of changes: + +. Add hooks for running the UNICON code along with some associated clean + up. The UNICON parameterization is not yet on the trunk, just the CAM + interface code. + +. Add IC files for ne120 aquaplanet runs (one for cam4, one for cam5). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. extensions to turn unicon on/off + +Describe any changes made to the namelist: + +. Add some variables that are used as tuning knobs by UNICON to the namelist: + - add sol_factb_interstitial and sol_factic_interstitial for tuning wet + scavening of modal aerosol + - add conv_water_frac_limit + - add eddy_moist_entrain_a2l + +List any changes to the defaults for the boundary datasets: + +. add IC files: +atm/cam/inic/homme/cami_0003-01-01_ne120np4_L26_ape_c140519.nc +atm/cam/inic/homme/cami_0003-01-01_ne120np4_L30_ape_c140519.nc + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/unicon_cam.F90 +. CAM interface code for UNICON +. use USE_UNICON macro to create stub interfaces for when unicon not enabled + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add sol_factb_interstitial and sol_factic_interstitial for tuning wet + scavening of modal aerosol +. add conv_water_frac_limit +. add eddy_moist_entrain_a2l + +models/atm/cam/bld/config_files/definition.xml +. add parameter for unicon on/off switch + +models/atm/cam/bld/configure +. add unicon on/off switch. + - When unicon enabled check that Park macrophysics, UW PBL, and MG + microphysics are on. + - Add 5 advected tracers for unicon. +. add USE_UNICON to cpp macros when unicon is enabled + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add UNICON specific settings for + - conv_water_frac_limit + - eddy_moist_entrain_a2l + - sol_factb_interstitial and sol_factic_interstitial + - deep_scheme and shallow_scheme + - cldfrc_rhminl + - cldwat_icritc + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add UNICON as valid value for deep_scheme, shallow_scheme +. add definition for + - eddy_moist_entrain_a2l + - conv_water_frac_limit + - sol_factb_interstitial and sol_factic_interstitial +. conv_water_in_rad moved from phys_ctl_nl to conv_water_nl + +models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +. sol_factb_interstitial and sol_factic_interstitial added to namelist + +models/atm/cam/src/control/cam_comp.F90 +models/atm/cam/src/control/cam_restart.F90 +models/atm/cam/src/cpl/atm_import_export.F90 +models/atm/cam/src/physics/cam/restart_physics.F90 +. fix to restart + - add cam_in cflx values to restart + - don't zero out cam_in%cflx before adding values from the coupler + +models/atm/cam/src/control/runtime_opts.F90 +. add call to conv_water_readnl + +models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +. remove conv_water_in_rad from conv_water_4rad actual args + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. change do loop limit from pver-1 to pver (not answer changing) + +models/atm/cam/src/physics/cam/conv_water.F90 +. add namelist +. conv_water_4rad + - remove conv_water_mode dummy arg and get info from module data + - add some pointers into the state obj to cleanup code + +models/atm/cam/src/physics/cam/convect_deep.F90 +. add treatment of deep_scheme='UNICON'. This acts the same as + deep_scheme='off' since the actual call to the unicon code is made from + the convect_shallow driver. + +models/atm/cam/src/physics/cam/convect_shallow.F90 +. add treatment of shallow_scheme='UNICON' +. convect_shallow_register + - add call to unicon_cam_register +. convect_shallow_init + - add call to unicon_cam_init +. add convect_shallow_implements_cnst/convect_shallow_init_cnst methods +. convect_shallow_tend + - add sgh30, cam_in dummy args + - add call to unicon_cam_tend + +models/atm/cam/src/physics/cam/eddy_diff.F90 +. set a2l from init_eddy_diff +. add UW_wsed to master field list +. compute_eddy_diff + - add intent(out) args tkes, went + - change ipbl, kpblh to integer types since the pbuf supports it +. caleddy + - add intent(out) args went, wsed_CL + +models/atm/cam/src/physics/cam/macrop_driver.F90 +. macrop_driver_init + - add dummy arg pbuf2d and add initializers for pbuf fields declared in + this module. +. macrop_driver_tend + - remove unused conv_water_in_rad + +models/atm/cam/src/physics/cam/micro_mg1_0.F90 +. add stratiform evap area diagnostic output + +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +. mods to add stratiform evap diagnostics to pbuf + +models/atm/cam/src/physics/cam/phys_control.F90 +. remove conv_water_in_rad +. remove checks for valid values that are done by build-namelist + +models/atm/cam/src/physics/cam/phys_debug.F90 +. add phys_debug_state_init and phys_debug_state_out methods to help with + output of state variables from various points in the code. + +models/atm/cam/src/physics/cam/physpkg.F90 +. some cleanup of how phys_getopts is called. Mainly collected the duplicated calls + and just do it once from the registration routine. +. phys_init + - add pbuf2d arg to call convect_shallow_init + - add pbuf2d arg to call macrop_driver_init +. tphysac + - add call to unicon_cam_org_diags +. tphysbc + - add sgh30, cam_in args to convect_shallow_tend + +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. add eddy_moist_entrain_a2l to namelist +. add fields to pbuf for use by UNICON + +models/atm/cam/src/physics/cam/wv_saturation.F90 +. add findsp to public methods + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_39 +Originator(s): santos +Date: 2014/05/19 +One-line Summary: SC-WACCM development, reduce bare add_default calls. + +Purpose of changes: + +- Merge changes from the CESM 1.2.2 release, mostly SC-WACCM changes and + WACCM bug fixes. + +- Control all add_default calls with namelist flags. + +- Remove last traces of CSIM, and the COUP_DOM CPP macro. + +Bugs fixed (include bugzilla ID): + + - #1837: WACCM: QBO forcing gives wrong output with do_circulation_diags = .false. + - #1841: WACCM5: zisocl failures for some compsets + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +- solar_htng_spctrl_scl is now properly set for SC-WACCM. + +- do_circulation_diags no longer defaults to .true. for SC-WACCM or + WACCM-SE. + +- Add new xs_short_file and xs_long_file (includes Lyman-alpha and + quantum yields for jh2so4, h/t Chuck Bardeen). + +- Add new history flags: + - history_waccmx + - history_chemistry + - history_carma + - history_clubb + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1850_cam4.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_1955-2005_cam4.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp26.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp45.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2005-2100_cam4_rcp85.xml + - New SC-WACCM use_cases for 1850, 1955-2005, and RCP 2.6, 4.5, + and 8.5. + +A models/atm/cam/src/dynamics/fv/zonal_mean.F90 + - Short utility to do zonal averages, extracted from the uzm + calculation in ctem.F90. + +A models/atm/cam/test/system/config_files/wg1.9c4dm +A models/atm/cam/test/system/nl_files/outfrq3s_2005 + - Files used for new SC-WACCM RCP 4.5 test. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update scripts and Machines externals to get new compsets. + +M models/atm/cam/bld/build-namelist + - Fix SC-WACCM and WACCM-SE defaults. + - Add new history flags. + - Remove mention of CSIM. + +M models/atm/cam/bld/configure + - Age of air tracers are no longer on by default for SC-WACCM. + - Remove COUP_DOM macro and CSIM paths. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Add solar_data_file for waccm_ghg. + - xs_* file changes for H2SO4. + - TMS settings now trigger based on waccm_phys, not specific + chemistry packages. + - Defaults for new history outputs (currently all .true., to match + previous behavior when the corresponding configure options were + set to .true.). + - Remove CSIM variables. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Add new history variables. + - Correct descriptions to match new/current behavior. + - Remove mentions of CSIM. + +D models/atm/cam/bld/namelist_files/use_cases/waccm_cam4_nuclear_winter.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M models/atm/cam/test/system/input_tests_master + - Rename use_case, which is now a generic black carbon use_case + instead of a nuclear winter use_case. + - New test for SC-WACCM RCP 4.5 case. + +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml + - Remove variables produced by modules that are no longer enabled + by default for SC-WACCM. + +M models/atm/cam/src/chemistry/bulk_aero/seasalt_model.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_exp_sol.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 +M models/atm/cam/src/chemistry/pp_none/chemistry.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/rad_constituents.F90 +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 + - Remove unnecessary uses of add_default. + - Remove commented out add_default calls. + +M models/atm/cam/src/chemistry/mozart/exbdrift.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccm/nlte_lw.F90 +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 + - Call add_default for WACCM variables only if history_waccm is + set. + +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 + - Call add_default for chemistry variables only if + history_chemistry is set. + +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - Fix erroneous usage of pbuf_set_field that affected WACCM-X. + - History fields that were added in mo_apex, but set in mo_aurora, + are now controlled exclusively by mo_aurora. + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - Add ability to specify PS in zonally averaged files. + +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 + - Only add DTH to output if history_amwg is set. + +M models/atm/cam/src/dynamics/fv/ctem.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 + - Calculation of zonal mean zonal wind for QBO nudging is done in + zonal_mean, not in ctem, so that the QBO no longer breaks down + when circulation diagnostics are turned off. + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - Move add_default for ideal_phys inside history_amwg conditional. + - Use history_waccm, not chem_is, to test for whether WACCM + add_default calls should be done. + - Remove CSIM-specific outputs. + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - Call add_default only if history_clubb is set. + - PBLH is a necessary part of the AMWG set, so it is added by + history_amwg instead of history_clubb. + +M models/atm/cam/src/physics/cam/eddy_diff.F90 + - Turn off an error condition for high-top runs, in order to + prevent WACCM5 from needlessly aborting the run. + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - Add defaults for diagnostic calls only if history_aero_optics is + set. + +M models/atm/cam/src/physics/cam/ndrop_bam.F90 + - Call add_default for CCN3 only if history_amwg is set, since it + is one of the AMWG diagnostic variables. + +M models/atm/cam/src/physics/cam/phys_control.F90 + - Add history fields to phys_control. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Add missing deallocation of state%cid. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - Call add_default for CARMA variables only if history_carma is + set. + +M models/atm/cam/src/physics/waccmx/ionosphere.F90 +M models/atm/cam/src/physics/waccmx/majorsp_diffusion.F90 + - Call add_default for WACCM-X variables only if history_waccmx is + set. + +M src/utils/cam_dom/ocn_comp.F90 + - Remove TSOCN output, as it is inconveniently located and seems to + have been only for CSIM. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +017 bl326 TBL.sh wg1.9c4dm outfrq3s_2005+waccm_sc_2005-2100_cam4_rcp45 9s .FAIL! rc= 7 at Mon May 19 14:31:15 MDT 2014 + +goldbach/nag: + +031 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri May 16 15:33:17 MDT 2014 + +goldbach/pgi or jaguar/pgi: + +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri May 16 15:59:48 MDT 2014 + +The goldbach SC-WACCM baselines failed because of a bug fix in solar_data +settings, and due to changes in the output. bl326 is a new test, so it has +no baseline to compare to. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: SC-WACCM with default namelist. +- what platforms/compilers: All. +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Larger than roundoff; fixed a bug in SC-WACCM solar_data_file handling. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_38 +Originator(s): fvitt, aconley +Date: 16 May 2014 +One-line Summary: Include PORT and fix use case bugs + +Purpose of changes: + + Place the Parallel Offline Radiation Tool (PORT) on the development trunk. + PORT is used to compute both radiative forcing and instantaneous radiative + forcing. PORT computes radiative heating rates and fluxes on model-generated + datasets (as well as user-modified datasets) without any responses or feedback + of non-radiative processes. + + If the rad_data_fdh namelist variable is set to .true., radiative fluxes + and heating rates are computed under the assumption of fixed dynamical + heating (fdh). Under fdh, changes in temperature tendencies (due to + changes in composition or optical properties) above the tropopause + are applied. Only temperatures are allowed to adjust. + + Fix bugs in build-namelist use cases: + . 2000_cam4_trop_strat_soa + . sd_cam4_trop_strat_soa + . cam4_bam_radpsv_geos5 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + Added the following CAM configure option to activate unit driver + + -offline_drv + where is: + stub -- does nothing, used for testing + rad -- invokes only radiation_tend subroutine (PORT) + +Describe any changes made to the namelist: + + Added namelist options: + . offline_driver_infile -- filepath of a single input file for offline driver (or PORT) + . offline_driver_fileslist -- filepath of an ascii file containing a list of input files for PORT + . rad_data_fdh -- switch to turn on "fixed dynamical heating" in PORT + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/unit_drivers/drv_input_data.F90 +A models/atm/cam/src/unit_drivers/rad/unit_driver.F90 +A models/atm/cam/src/unit_drivers/rad/README +A models/atm/cam/src/unit_drivers/rad +A models/atm/cam/src/unit_drivers/offline_driver.F90 +A models/atm/cam/src/unit_drivers/stub/unit_driver.F90 +A models/atm/cam/src/unit_drivers/stub +A models/atm/cam/src/unit_drivers + - unit driver code + +A models/atm/cam/test/system/nl_files/outfrq24h_port +A models/atm/cam/test/system/config_files/f4c5portdh +A models/atm/cam/test/system/config_files/f4c5portdm + - regression tests added for PORT + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure + - offline_drv configure option added + - set surface models to stub versions for PORT configurations + +M models/atm/cam/bld/config_files/definition.xml + - offline_drv configure option added + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - added namelist options + . rad_data_fdh -- switch to turn on "Fixed Dynamical Heating" in PORT configuration + . offline_driver_infile -- filepath of a single input file for offline driver (or PORT) + . offline_driver_fileslist -- filepath of an ascii file containing a list of input files for PORT + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml + - replaced 'SSLT*PP' fields in fincl1 list with 'SSLT*WET' + +M models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml + - flbc_list needed + +M models/atm/cam/bld/build-namelist + - set defaults of iradsw and iradlw to 1 for PORT configurations + +M models/atm/cam/src/control/runtime_opts.F90 + - invoke offline_driver_readnl routine + +M models/atm/cam/src/control/ncdio_atm.F90 + - add missing timelevel optional argument to call to in_real_3dncolphys routine for unstructed grids + +M models/atm/cam/src/control/cam_comp.F90 + - some code cleanup + - skip dynamics and "before coupler" part of physics (tphysbc) if PORT is active + - invoke offline_driver_run instead of "after coupler" part of physics (tphysac) if PORT is active + +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/cam/radiation.F90 + - removed unused reference to concld + - added call to rad_data_register() + - added 'FSNR' and 'FLNR' diagnostics + - removed unused landm argument in radiation_tend subroutine + +M models/atm/cam/src/physics/cam/radiation_data.F90 + - combined with PORT's rad_data_input module + - add pbuf fields needed for the "fixed dynamical heating" functionality of PORT + - changes for cam5 physics (modal aerosols) + - added "fixed dynamical heating" functionality + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - add missing errcode argument to pbuf_get_index call + +M models/atm/cam/src/physics/cam/physpkg.F90 + - remove unused "landm" from argument list to radiation_tend + +M models/atm/cam/src/physics/cam/radheat.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 + - added method to turn off chemical heating in the upper atmosphere so the PORT can be used + in a waccm configuration + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - added abort option to incr_filename function. If abort is .false. then return + 'NOT_FOUND' if not able to increment the filename rather than calling endrun + +M models/atm/cam/test/system/test_driver.sh + - added ability to use gpgpu queue on yellowstone + +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/tests_pretag_goldbach_pgi +M models/atm/cam/test/system/input_tests_master + - regression tests added for PORT + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +091 bl010 TBL.sh f4c5portdh outfrq24h_port 2d .............................FAIL! rc= 7 at Fri May 16 03:52:04 MDT 2014 + -no baseline to compare against + +goldbach/nag: All pass + +goldbach/pgi: +061 bl011 TBL.sh f4c5portdm outfrq24h_port 2d .............................FAIL! rc= 7 at Thu May 15 19:10:14 MDT 2014 + -no baseline to compare against + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_37 +Originator(s): dennis, srinathv, eaton +Date: Wed May 7 07:57:45 MDT 2014 +One-line Summary: cleanup and vectorize wetdepa_v2; BGQ mods for standalone build + +Purpose of changes: + +. Mods to vectorize the wetdepa_v2 subroutine used by the modal aerosol + code were contributed by John Dennis and Srinath Vadlamani. Eaton + subsequently cleaned the unused code out of the subroutine. The answers + are different at the roundoff level. + +. Mods for the BGQ platform were added to configure and Makefile.in for the + CAM standalone build. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. Add BGQ option to CAM standalone build + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. The wetdepa_v2 code is 70% faster on yellowstone. The overall speedup of + CAM is about 1.5% + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. add -DHAVE_MPI when building with MPI -- used by timing lib code +. add section for BGQ + +models/atm/cam/bld/config_files/sys_defaults.xml +. add entry for bgq to turn on both mpi and threading by default + +models/atm/cam/bld/configure +. add bgq as possible value for target_os +. add default compilers for bgq + +models/atm/cam/src/chemistry/aerosol/wetdep.F90 +. wetdepa_v2 - vectorization mods + - combine the four occurances of the 3-way conditional into a single + occurance. + - replace scalar temporaries by arrays as necessary for vectorization +. wetdepa_v2 - cleanup mods + - remove unused weight factor (hardcoded to 0.0) + - remove unused dummy args: t + - remove set but unused vars: adjfac + - remove unused dummy arg rate1ord_cw2pr_st + - remove unused local vars: aqfrac, cwatc, cwats, cwatp, gafrac, hconst, + mpla, mplb, part, patm, precbl, precmin + - remove set but not used vars: tracab, sol_factii, sol_factiic, sol_factbi + - remove unused dummy arg sol_factbi_in, sol_factii_in, sol_factiic_in + - add local vars to remove some duplicated calculations: + clds for stratiform cloud fraction + trac_qqcw - common to tracer_incu and tracer_mean + - remove cldmabc - not needed since cldvcu always supplies its values + - remove cldmabs - not needed since cldvst always supplies its values + - remove dummy arg cldv - not used + - replace overloaded vars scrs1, scrs2 with variables specific to + convective and stratiform contributions to incloud and below cloud + scavenging... conv_scav_ic, conv_scav_bc, st_scav_ic, st_scav_bc + +models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +. aero_model_wetdep + - remove actual args for t from calls to wetdepa_v2 + - remove wetdepa_v2 actual args: rate1ord_cw2pr_st + - remove optional args sol_factbi, sol_factii, sol_factiic + - remove optional args qqcw and f_act_conv in the call for the cloud + borne aerosols. + - remove actual arg dep_inputs%cldv in wetdepa_v2 calls + +models/atm/cam/src/physics/carma/cam/carma_intr.F90 +. carma_wetdep_tend + - remove actual args for t from call to wetdepa_v2 + - remove actual arg cldv in wetdepa_v2 call + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue May 6 04:09:39 MDT 2014 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue May 6 04:17:24 MDT 2014 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue May 6 04:28:38 MDT 2014 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue May 6 04:42:04 MDT 2014 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Tue May 6 04:56:50 MDT 2014 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue May 6 05:05:09 MDT 2014 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue May 6 05:27:41 MDT 2014 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Tue May 6 05:50:29 MDT 2014 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Tue May 6 06:43:50 MDT 2014 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Tue May 6 06:46:33 MDT 2014 + +goldbach/nag: All PASS except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon May 5 15:15:15 MDT 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon May 5 15:21:40 MDT 2014 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon May 5 15:28:13 MDT 2014 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon May 5 15:37:57 MDT 2014 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon May 5 16:04:29 MDT 2014 +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon May 5 16:17:46 MDT 2014 +042 bl325 TBL.sh f10c5t5mdmsc outfrq3s_subcol 9s ..........................FAIL! rc= 7 at Mon May 5 16:45:46 MDT 2014 +046 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..........................FAIL! rc= 7 at Mon May 5 17:13:20 MDT 2014 + +goldbach/pgi: All PASS except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon May 5 15:23:50 MDT 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon May 5 15:31:42 MDT 2014 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon May 5 15:37:29 MDT 2014 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon May 5 15:41:09 MDT 2014 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon May 5 15:55:31 MDT 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon May 5 16:22:58 MDT 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon May 5 16:50:08 MDT 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Mon May 5 16:59:10 MDT 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Mon May 5 17:14:27 MDT 2014 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Mon May 5 17:28:41 MDT 2014 + +The baseline failures are all due to roundoff level differences introduced +into subroutine wetdepa_v2 which is used by the modal aerosol code. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Roundoff differences in configurations +that use the prognostic modal aerosol code. + +=============================================================== +=============================================================== + +Tag name: cam5_3_36 +Originator(s): cacraig, goldy +Date: May 5, 2014 +One-line Summary: Bug fixes to subcolumns + +Purpose of changes: Bug fixes and cleanup for subcolumns + +Bugs fixed (include bugzilla ID):1952 (incorrect allocation of state_sc) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/subcol_utils.F90 +M models/atm/cam/src/physics/cam/subcol_utils.F90.in + - Changed all state intents to in from inout + - Allocation of state_sc was incorrect and decided it should be an endrun instead + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - Bug in setting of dimsizes(:) and then overwriting dimsizes(1) when threading + in pbuf1d_field_by_index. Corrected to set only dimsizes(2:). + - Cleanup of logic when using optional start/count in get_pbuf1d_field_by_index + - Corrected spelling of persistence + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB + +goldbach/nag: All BFB + +goldbach/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_35 +Originator(s): fvitt, tilmes +Date: 02 May 2014 +One-line Summary: Improve performance of satellite history output + and bug fix in modal aerosol surface area routine + +Purpose of changes: + + - It has been observed that CAM's run-time performance is degraded + when satellite history output is turned on, especially when running + on higher resolution grids. The sat_hist_write method was spending + the bulk of its time doing a "find nearest neighbor" operation to + determine the nearest column(s) to output. Each PE was searching the + entire global grid (both dynamics grid and physics grid). Modifications + here parallelizes the find nearest neighbor operation and performance + is greatly improved. + + - Fix a bug in modal aerosol surface area routine used for heterogeneous + chemistry reactions. + + - Build-namelist use case changes to be consistent with 1.2.2 release. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_cam5_trop_strat_mam3.xml +Changes to be consistent with 1.2.2 release + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +The use of dgnumwet in MODAL version of surfarea needs to be converted from "m" to "cm" + +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/se/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +Improve performance of sat_hist + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Thu May 1 19:07:34 MDT 2014 + - expected failure due to the bug fix in surfarea + +goldbach/nag: all pass + +goldbach/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_34 +Originator(s): cacraig, eaton, gettelman +Date: April 25, 2014 +One-line Summary: Fix broken COSP, namelist defaults, ideal physics, PGI on hopper, micro_mg_cam + +Purpose of changes: + +- COSP had include files with .f instead of .inc. Use the new COSP external to allow CESM to compile it + +- CAM standalone whn running SE ne16np4 was broken - updated namelist defaults to fix problem + +- ideal physics with threading was broken. Eliminated ptend as a thread private variable and made + it an array with a chunk index + +- Fixed PGI compilation on hopper + +- Andrew provided a bug fix for micro_mg_cam for vprao, vprco, and racau + +Bugs fixed (include bugzilla ID): 1894 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure + - fix PGI compilation on hopper + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - fix namelist defaults for CAM SE ne16np4 in CAM standalone + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - use updated COSP build which allows CESM to compile it directly with their new mods + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Changes from Andrew for vprco, vprao and racau + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Fix for running ideal physics using threading + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_33 +Originator(s): fvitt +Date: 22 Apr 2014 +One-line Summary: Chemistry bug fixes and use case changes + +Purpose of changes: + Correction to aerosol surface area used in heterogeneous chemical + reactions, O1D+O2 reaction rate update, and updates to build-namelist + use cases + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45_bgc.xml +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85_bgc.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_cam4_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_cam5_trop_strat_mam3.xml + - new build-namelist use cases + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml + - updates to build-namelist use cases + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.in +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in + - corrected rate constants for O1D + O2 reaction + - added SO4 to external forcing list + +M models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +M models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - correction to aerosol surface area used in heterogeneous chemical + reactions when using prognostic modal aerosols + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Apr 22 10:44:29 MDT 2014 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Tue Apr 22 10:53:13 MDT 2014 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Tue Apr 22 11:10:20 MDT 2014 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Tue Apr 22 11:27:14 MDT 2014 + - these failures are expected due to changes in O1D+O2 reaction rate and + changes to aerosol surface area used in heterogeneous chemical reactions + +goldbach/nag: All Pass + +goldbach/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_32 +Originator(s): olson, cacraig +Date: 4/18/14 +One-line Summary: Bug fixes for bugzilla 1958 + +Purpose of changes: Fix computation of the diagnostic term "DTCORE" - total dynamics T-tendency + +Bugs fixed (include bugzilla ID): 1958 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, olson + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 + - bug fix for DTCORE + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Thu Apr 17 20:45:09 MDT 2014 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Thu Apr 17 22:40:06 MDT 2014 + Failed due to differences with DTCORE. Jerry Olson approved the new numbers + +goldbach/nag: all BFB + +goldbach/pgi or jaguar/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_31 +Originator(s): santos, Marcus Wagner, cacraig +Date: 04/14/2014 +One-line Summary: Bug fixes for bugzilla 1954 and 1919 + +Purpose of changes: +- Fix write outside array bounds in pilgrim code (1919) +- Fix lon-lat history file from multi-instance CAM-SE (1954) + +Bugs fixed (include bugzilla ID): 1919 and 1954 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/utils/pilgrim/parutilitiesmodule.F90 + - bug fix from Marcus Wagner for bugzilla 1919 (write outside array bounds in pilgrim code) + +M models/atm/cam/src/dynamics/se/interp_mod.F90 + - bug fix from Sean Santos for bugzilla 1954 (lon-lat history file from multi-instance CAM-SE: bug and fix) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_30 +Originator(s): cacraig, eaton +Date: 04/04/2014 +One-line Summary: Changed compiler settings to match CESM to fix failing TEQ test + +Purpose of changes: +- Fix failing TEQ test by changing compiler settings + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh + - Updated modules for yellowstone to match CESM modules + +M models/atm/cam/bld/Makefile.in + - Updated compiler flags for yellowstone to match CESM modules + - handful of routines have -O3 optimization + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Thu Apr 3 19:59:46 MDT 2014 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Thu Apr 3 21:19:13 MDT 2014 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Thu Apr 3 22:39:16 MDT 2014 +- Answers changed due to modified compiler settings + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_29 +Originator(s): cacraig +Date: 03/31/2014 +One-line Summary: Update to cesm1_3beta08 externals + +Purpose of changes: +- Updated to cesm1_3beta08 externals +- Needed to update to CLM branch to eliminate some introduced bugs + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh + - need to "module load perlmods" for yellowstone + +M SVN_EXTERNAL_DIRECTORIES + - updated to beta08 externals + - Needed to upgrade to CLM branch tag to correct several bugs discovered during CAM testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS except: +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri Mar 28 14:04:13 MDT 2014 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Mar 28 14:56:53 MDT 2014 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Fri Mar 28 15:06:36 MDT 2014 +058 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Mar 28 15:14:36 MDT 2014 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Fri Mar 28 15:24:34 MDT 2014 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Fri Mar 28 15:42:57 MDT 2014 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Fri Mar 28 16:06:52 MDT 2014 + - Jobs with cam_chempkg='trop_mozart', 'waccm_mozart', 'super_fast_llnl', 'trop_mozart_mam3', 'trop_mozart_soa' all + have answer changes due to CLM mods + +088 eq993 TEQ_ccsm.sh ne30_ne30 FC5 h30c5h fcase 2d .......................FAIL! rc= 7 at Fri Mar 28 18:11:41 MDT 2014 + - Machines compiler updates on yellowstone cause answer changes. Will change in next tag as may be answer changing to + other tests as well. + +goldbach/nag: All PASS except +001 fm001 TFM.sh ..........................................................FAIL! rc= 2 at Thu Mar 27 13:56:02 MDT 2014 +Failed because checked out on yellowstone which is using an older svn repository. Will check out next version on +goldbach for this test. + + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_28 +Originator(s): cacraig, goldy (with input from many others) +Date: 03/06/2014 +One-line Summary: Routines to support sub-columns introduced and sub-columninzation of microphysics + +Purpose of changes: + +- Last checkin of initial subcolumn development work +- Introduces the subcolumn interface and utility routines +- microphysics is now subcolumnized +- when subcolumns are not specified, no changes + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton, plus numerous group reviews + +List all subroutines eliminated: none +D models/atm/cam/src/utils/grid_flag_utils.F90 + - Got rid of confusing bit_field_kind and its supporting routines as no longer needed + - Moved col_type parameters to physics_buffer.F90 + - Removed obsolete module + +List all subroutines added and what they do: none +A models/atm/cam/test/system/config_files/f10c5t5mdmsc +A models/atm/cam/test/system/nl_files/outfrq3s_subcol + - Added regression testing for subcolumns + +A + models/atm/cam/src/physics/cam/subcol.F90 + - interface layer for subcolumns + - Has the ability to redirect subcolumn-scheme specific routines + - public routines: + subcol_register ! Read scheme from namelist and initialize any scheme-global variables + subcol_init ! Initialize any variables or fields specific to the active scheme + subcol_gen ! Generate subcol fields from GBA fields + subcol_field_avg ! Average subcol fields back into GBA fields + subcol_ptend_avg ! Average sub-column ptend to grid ptend + subcol_readnl ! Namelist reader for subcolumns + subcol_init_restart ! Initialize restart with subcolumn specific fields + subcol_read_restart ! Read subcolumn specific fields from restart + subcol_write_restart ! Write subcolumn specific fields for restart + +A + models/atm/cam/src/physics/cam/subcol_utils.F90.in +A + models/atm/cam/src/physics/cam/subcol_utils.F90 + - Utilities layer for subcolumns + - public routines: + subcol_utils_init ! Initialize module data (e.g., nsubcol2d) + subcol_get_nsubcol ! Copy chunk from nsubcol2d + subcol_set_nsubcol ! Copy chunk to nsubcol2d + subcol_get_indcol ! Copy chunk from indcol2d + subcol_get_filter ! return the filter values + subcol_set_filter ! set the filter values + subcol_get_weight ! return the weight values + subcol_set_weight ! set the weight values + subcol_field_copy ! copy a physics buffer field into one with subcolumn dimensions + subcol_ptend_copy ! copy a physics_ptend object into one with subcolumn dimensions + subcol_set_subcols ! set nsubcols and copy state & tend objects into one with subcolumn dimensions + subcol_field_avg_shr ! Average subcol fields back into GBA fields + subcol_ptend_avg_shr ! average subcolumn ptend to grid ptend + subcol_field_get_firstsubcol ! Retrieve the first subcolumn and assign to grid + subcol_ptend_get_firstsubcol ! retrieve the first subcolumn from the ptend fields and assign to grid ptend + subcol_unpack ! Unpack a subcolumn field + subcol_pack ! Pack a subcolumn field + subcol_utils_init_restart ! Initialize restart with subcolumn specific fields + subcol_utils_read_restart ! Read subcolumn specific fields from restart + subcol_utils_write_restart ! Write subcolumn specific fields for restart + is_filter_set ! True if filters for averaging have been set + is_weight_set ! True if weights for averaging have been set + is_subcol_on ! true is any subcol_scheme other than "off" is set + subcol_get_scheme ! Return the active subcolumn scheme name + subcol_utils_readnl ! Set the active scheme based on namelist + +A + models/atm/cam/src/physics/cam/subcol_tstcp.F90 + - Testing module for subcolumns + - Has more robust setting of random indices + - Introduced on fly test of subcolumn indices + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam +M models/atm/cam/test/system/tests_pretag_goldbach_nag +M models/atm/cam/test/system/input_tests_master + - Added regression test for subcolumns + +M models/atm/cam/bld/configure + - Added SILHS to configure for SILHS developer's ease + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Moved microp_uniform initialized to false + - Introduced a number of subcolumn namelist variables + - Initialized subcol_scheme to "off" + +M models/atm/cam/bld/build-namelist + - Introduced subcolumn namelist variables + +M models/atm/cam/src/control/runtime_opts.F90 + - Added subcol_readnl + +M models/atm/cam/src/control/cam_history_support.F90 + - Added is_subcol field to field_info strtucture + - Only defines the pio variables if they are associated + +M models/atm/cam/src/control/cam_history.F90 + - Utilizes the new is_subcol field and handles subcolumns properly + - Introduced an interface for subcol_field_avg_handler to eliminate a circular dependency + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Allow microphysics to have grid or subcolumns + - moved microp_uniform the this namelist + - Lower portion of micro_mg_cam reverts back to the grid + +M models/atm/cam/src/physics/cam/check_energy.F90 + - registers that TEOUT and DTCORE need to have subcolumn fields as well if subcolumns turned on + +M models/atm/cam/src/physics/cam/restart_physics.F90 + - if subcolumns are on, then call appropriate routines + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Removed fields from physics_state: nsubcol and indcol. This information is now stored in subcol_utils module + - cpariv and rairv now have local copies of cpair and rair. + If subcolumns, then allocates to subcolumn size and assigns the scalar value + If grid columns, then allocates to pcols and checks that all of array version matches scalar value + If grid columns, and cpairv and/or rairv is not all equal to scalar value, exit with an error + +M models/atm/cam/src/physics/cam/physpkg.F90 + - uses the new subcolumn routines for init and register + - tphysbc now has logic to handle optional subcolumns for microp_driver + +M models/atm/cam/src/physics/cam/microp_driver.F90 + - minor cleanup + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - Now contains col_type parameters + - buffer_hdr has additional fields: + is_copy(ngrid_types): contains info on whether subcolumn field is a copy or not + added: used to flag if pbuf_add_field was called on this field + dimsizes and vardesc have dimension for ngrid_types + - bfg_sc is gone and bfg now dimensioned over ngrid_types + - number of possible dimensions one less due to subcolumns needing a dimension + - new routines which are public: + pbuf_col_type_index: retrieves col_type index based on whether subcolumns turned on or not + pbuf_register_subcol: used to make sure a subcolumn field is created - does not care if it + already was created or not. + - new internal routines: + pbuf_field_has_gridcols: returns true only if it is an allocated grid field + pbuf_field_has_subcols: returns true only if it is an allocated subcol field (and not a copy) + pbuf_field_has_col_type: returns true only if col_type field is allocated + find_pbuf_header: finds a pbuf header pointer based on name and tacks on extra header if name not found + pbuf_register_field_int: register a field in the pbuf (used by pbuf_add_field and was + guts of pbuf_add_field in previous versions). Has additional functionality + to register both grid and subcolumn fields. + get_pbuf2d_field_restart: used by write_restart_field. If subcolumn data, unpacks it before returning field. + Grid data is just returned + write_restart_field: replacement of pbuf_write_field with support for subcolumns + read_restart_field: replacement for pio_read_restart_field with support for subcolumns + + - removed obsolete routines: pbuf_set_test_field and pbuf_check_test_field + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All Pass except newly introduced BL325 + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_27 +Originator(s): cchen, hannay, eaton +Date: Tue Mar 4 10:52:02 MST 2014 +One-line Summary: Namelist control for AMWG variability + diagnostics; remove rad_diag_1 from CAM5/RCP use cases; add new + history_amwg defaults. + +Purpose of changes: + +. Add a namelist variable, history_vdiag, which adds the specific fields at + daily, 6-hourly, and 3-hourly output frequency required by the AMWG + variability diagnostics. Setting history_vdiag=.true. in the namelist is + the only action required on the user's part, unless there is a conflict + with the setting of nhtfrq. The history_vdiag option writes fields to + auxilliary history files h1, h2, and h3, and it assumes that the output + frequency for these files is set to daily, 6-hourly, and 3-hourly + respectively. If the value of nhtfrq is set by the user, the first 4 + elements must be 0,-24,-6,-3. Otherwise build-namelist will flag an + error. In the case of an error be sure to check whether the use case is + the source of the inconsistent values of nhtfrq. + +. All CAM5/RCP use case files have been modified to remove the diagnostic + radiation calculation. This is an expensive diagnostic and it was + decided that it should not be enabled by default. + +. Add variables TAUGWX, TAUGWY, TAUTMSX, TAUTMSY to the history_amwg field + list. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add history_vdiag + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add default for history_vdiag +. check that nhtfrq hasn't been set inconsistently, and set it's default if + not set yet. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add history_vdiag to phys_ctl_nl group + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default for history_vdiag (.false.) + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add module variable history_vdiag +. diag_init + - init history_vdiag via phys_getopts call + - add add_default calls for U200, V200, U850, OMEGA500, PRECT inside of + history_vdiag conditionals. The addfld calls for all these variables + sets them as time averaged. The add_default calls are hardcoded with + the specific auxillary hist file numbers. + +models/atm/cam/src/physics/cam/gw_drag.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. add variables TAUGWX, TAUGWY, TAUTMSX, TAUTMSY to the history_amwg field list. + +models/atm/cam/src/physics/cam/phys_control.F90 +. add module variable history_vdiag +. add history_vdiag to namelist group phys_ctl_nl +. add history_vdiag to phys_getopts accessor method + +models/atm/cam/src/physics/cam/radiation.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +. radiation_init + - add add_default calls for FLUT inside history_vdiag conditional. + addfld call adds FLUT as time average field. + +models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp26.xml +models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp60.xml +models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp45.xml +models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp85.xml +. remove the following setting for rad_diag_1: + + 'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12' + + +. remove the fincl1 fields that are produced by rad_diag_1: + 'FSNT_d1','FSNTC_d1','FSNS_d1','FSNSC_d1' + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS + +goldbach/nag: All PASS + +goldbach/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_3_26 +Originator(s): santos cacraig eaton +Date: 2014/02/21 +One-line Summary: Subcolumn prep for MG, update frankfurt to goldbach + +Purpose of changes: + +- Size distribution calculations for the radiation and diagnostic output + are now done in micro_mg_cam, instead of directly using the outputs from + micro_mg_tend. This will allow them to be done after all subcolumn and + substepping averages, which presents a more consistent state for RRTMG. + +- Add new test to check that svn:mergeinfo exists in the root directory of + CAM, and nowhere else. + +- Transition from frankfurt to goldbach as a test system. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/test/system/TFM.sh +A models/atm/cam/test/system/find_mergeinfo.sh + - Add find_mergeinfo.sh utility for detecting mergeinfo. + - Add test to ensure that the svn:mergeinfo property only exists on + certain directories. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/configure + - Work around issue with PGI and the MPI compiler wrapper on + goldbach. + - When running MCT's configure script, pass along the value of CC + and user-specified LDFLAGS as well as FC. + +M models/atm/cam/doc/ChangeLog_template + - Change frankfurt to goldbach. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - Have micro_mg_cam initialize micro_mg_utils for MG 1 (in future + versions, the portable layer of MG will do this). + - Define mincld in micro_mg_utils. In future versions, this will + allow micro_mg_cam and the portable layer to share this value. + For now, only micro_mg_cam uses it. + - Do size distribution parameter calculations for the radiation + in micro_mg_cam, rather than using the MG outputs. Reorder some + output statements for consistency with this. + +M models/atm/cam/test/system/CAM_decomp.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TCB_ccsm.sh +M models/atm/cam/test/system/archive_baseline.sh +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/test_driver.sh +D models/atm/cam/test/system/tests_posttag_frankfurt +A models/atm/cam/test/system/tests_posttag_goldbach +D models/atm/cam/test/system/tests_pretag_frankfurt_nag +A models/atm/cam/test/system/tests_pretag_goldbach_nag +D models/atm/cam/test/system/tests_pretag_frankfurt_pgi +A models/atm/cam/test/system/tests_pretag_goldbach_pgi + - Fix issue where ptile=32 does not work consistently on + yellowstone, due to a recent LSF upgrade. + - Update from frankfurt to goldbach. + - Add TFM (mergeinfo test) to NAG pretag tests on goldbach. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Feb 19 20:09:42 MST 2014 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Feb 19 20:15:58 MST 2014 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Feb 19 20:17:22 MST 2014 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Feb 19 20:28:53 MST 2014 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Feb 19 20:42:39 MST 2014 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Wed Feb 19 20:57:31 MST 2014 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Feb 19 21:05:43 MST 2014 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Wed Feb 19 21:29:26 MST 2014 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Wed Feb 19 21:53:57 MST 2014 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Wed Feb 19 22:11:53 MST 2014 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Wed Feb 19 22:48:40 MST 2014 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Wed Feb 19 22:51:25 MST 2014 + +goldbach/nag: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Feb 20 13:26:47 MST 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Feb 20 13:32:29 MST 2014 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Feb 20 13:38:46 MST 2014 +018 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Feb 20 13:47:49 MST 2014 +026 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Feb 20 14:10:49 MST 2014 +033 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Feb 20 14:20:19 MST 2014 +042 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..........................FAIL! rc= 7 at Thu Feb 20 14:57:21 MST 2014 + +goldbach/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Feb 20 13:28:30 MST 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Feb 20 13:36:01 MST 2014 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Thu Feb 20 13:41:24 MST 2014 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Feb 20 13:44:47 MST 2014 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Feb 20 13:58:49 MST 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Feb 20 14:25:48 MST 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Feb 20 14:49:53 MST 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Feb 20 14:58:45 MST 2014 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Thu Feb 20 15:05:23 MST 2014 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Thu Feb 20 15:07:44 MST 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Thu Feb 20 15:11:19 MST 2014 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Thu Feb 20 15:24:21 MST 2014 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Thu Feb 20 15:43:58 MST 2014 + +All CAM 5 baselines were expected to fail due to microphysics changes. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + +All MG (therefore all CAM5). + +- what platforms/compilers: + +All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +Larger than roundoff, same climate. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_25 +Originator(s): santos +Date: 2014/01/27 +One-line Summary: Add settings for new 60 layer AMIP compset. + +Purpose of changes: + +- Add namelist settings for new AMIP compset, with high vertical resolution + and spectral gravity waves. + +- Clean up work and fix of a minor DEBUG mode bug in CARMA. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +- Add gravity wave settings for new compset, including the new tau_0_ubc + option. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Use https instead of http to get PIO external (fixes Subversion + 1.7 error). + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/physics/cam/gw_common.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 + - Add option to enforce an upper boundary condition of tau = 0 in + the gravity waves, and turn it on for CAM runs with spectral + gravity waves. + - Add gravity wave settings for high vertical resolution, + non-WACCM runs. + +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/tholin/carma_model_mod.F90 + - Remove unnecessary calls to phys_grid routines. + - Fix bug where uninitialized data was used in a multiplication, + causing a floating point exception (this bug did not affect + results). + +M models/atm/cam/doc/ChangeLog + - Fixed the date on the previous commit (Happy New Year!). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS. + +frankfurt/nag: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_24 +Originator(s): santos +Date: 2014/01/23 +One-line Summary: Improve stability of the ZM scheme. + +Purpose of changes: + +- In the ZM deep convection scheme, use Brent's method to invert the + entropy equation, as it converges faster. + +- In the ZM scheme, for the mixing ratio of water vapor at saturation, use + a ratio over total mass rather than over dry mass, to avoid numerical + overflow that can occur at high temperature. + +- Limit RRTMG so that it only operates below 1 Pa, rather than using the + lid of 0.01 Pa that was in place before. (Only impacts WACCM5 and other + high-top RRTMG runs.) + +- Prevent rare divide by zero error for very cold grid points in + modal_aero_wateruptake. + +Bugs fixed (include bugzilla ID): + +#1891 - The "top" of RRTMG is too high in high-top models + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + - Work around divide-by-zero error by checking for water vapor + saturation pressures that are 0. (If this happens, the saturation + pressure is wrong anyway because the temperature is unrealistic, + but we give the model the chance to recover, or to throw a better + error elsewhere.) + +M models/atm/cam/src/physics/cam/wv_sat_methods.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 + - Use improved entropy inverter in zm_conv. + - Remove qmmr, and have zm_conv use qsat_water instead. + +M models/atm/cam/src/physics/rrtmg/rrtmg_state.F90 + - Lower the lid on RRTMG to 1 Pa. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Wed Jan 22 16:30:24 MST 2014 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Wed Jan 22 16:31:33 MST 2014 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Jan 22 16:34:29 MST 2014 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Jan 22 16:46:44 MST 2014 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Jan 22 16:48:19 MST 2014 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Wed Jan 22 16:56:05 MST 2014 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Jan 22 17:10:37 MST 2014 +026 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Wed Jan 22 17:11:14 MST 2014 +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Wed Jan 22 17:18:15 MST 2014 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Jan 22 17:26:23 MST 2014 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Wed Jan 22 17:45:20 MST 2014 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Jan 22 18:02:32 MST 2014 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Jan 22 18:33:04 MST 2014 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Wed Jan 22 18:37:35 MST 2014 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Wed Jan 22 18:44:54 MST 2014 +058 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Wed Jan 22 18:55:12 MST 2014 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Wed Jan 22 19:05:38 MST 2014 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Wed Jan 22 19:26:59 MST 2014 +067 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Wed Jan 22 19:39:13 MST 2014 +070 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Wed Jan 22 19:41:58 MST 2014 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Wed Jan 22 19:58:22 MST 2014 +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Wed Jan 22 20:02:49 MST 2014 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Wed Jan 22 20:19:54 MST 2014 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Wed Jan 22 20:23:06 MST 2014 +084 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Wed Jan 22 20:40:08 MST 2014 + +frankfurt/nag: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jan 22 14:43:08 MST 2014 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jan 22 14:49:33 MST 2014 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jan 22 14:58:37 MST 2014 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jan 22 15:26:40 MST 2014 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Jan 22 15:53:26 MST 2014 +027 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Wed Jan 22 15:54:48 MST 2014 +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 22 16:07:12 MST 2014 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Jan 22 16:09:36 MST 2014 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Wed Jan 22 16:26:25 MST 2014 +038 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Jan 22 16:35:26 MST 2014 +041 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..........................FAIL! rc= 7 at Wed Jan 22 17:10:20 MST 2014 + +frankfurt/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jan 22 14:42:53 MST 2014 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jan 22 14:51:44 MST 2014 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Jan 22 14:57:17 MST 2014 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jan 22 15:04:41 MST 2014 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jan 22 15:20:23 MST 2014 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Jan 22 15:56:52 MST 2014 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Wed Jan 22 16:01:35 MST 2014 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 22 16:23:41 MST 2014 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Wed Jan 22 16:29:37 MST 2014 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Jan 22 16:37:16 MST 2014 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 22 16:54:05 MST 2014 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Wed Jan 22 17:00:47 MST 2014 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Wed Jan 22 17:04:38 MST 2014 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Wed Jan 22 17:13:05 MST 2014 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Jan 22 17:43:31 MST 2014 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Wed Jan 22 18:08:46 MST 2014 + +ZM modifications expected to change answers (but not climate) for all +runs except adiabatic and ideal physics. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: All CAM3/4/5. +- what platforms/compilers: All. +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Larger than roundoff, same climate. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_23 +Originator(s): Po-Lun Ma, eaton +Date: Thu Jan 9 13:37:51 MST 2014 +One-line Summary: changes to defaults for soil_erod and dust_emis_fact + +Purpose of changes: + +A problem with too low dust burdens in high res (1/2 and 1/4 deg) cam5 runs +was traced to the soil_erod datasets being used at those resolutions. The +proposed solution involves using the 2 deg (1.9x2.5) dataset at all +resolutions higher than 2 deg. Since we have already tuned the 1 deg FV +runs using the 0.9x1.25 dataset, an exception will be made for that case to +maintain backwards compatibility. There are also several low resolution +specific versions of soil_erod that will be maintained for backwards +compatibility (and because there is no known problem with them). + +It is unnecessary to produce specific high resolution version of soil_erod by +interpolating the 1.9x2.5 dataset since CAM is already set up to do this on +the fly internally (this was done to support the SE dycore and not require +resolution specific datasets for all the SE grids). Therefore the fix is +to simply modify the build-namelist defaults so that the 1.9x2.5 dataset is +used for all dycores at all resolutions except the 1 deg FV case, and for +the existing low res specific datasets. + +There is also a change to the dust_emis_fact tuning parameter. Po-Lun Ma +has done simulations showing that the dust burdens for the 1/2 and 1/4 deg +FV case is improved by using the value 0.45 (the value from the tuning with +the 1 deg soil_erod dataset is set to 0.35). This change has been included +as well. + +The SE setting for dust_emis_fact has not been changed from the value of +0.55 which was from tuning ne30np4 using the 1 deg soil_erod dataset. +Since the tuning of CAM-SE is ongoing we decided to change all the SE +resolutions to use the 1.9x2.5 soil erod dataset recognizing that +dust_emis_fact will need retuning for SE. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. defaults changed for soil_erod and dust_emis_fact as described above. + +List any changes to the defaults for the boundary datasets: +. defaults changed for soil_erod as described above. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. updates to soil_erod defaults +. updates to dust_emis_fact + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all PASS except: +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Thu Jan 9 01:31:35 MST 2014 + +All SE w/ prognostic aerosols runs change answers. + +frankfurt/nag: all PASS except: +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Jan 8 18:46:44 MST 2014 + +frankfurt/pgi: all PASS except: +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Jan 8 19:38:10 MST 2014 + +bl312 fails becase the default dataset when no resolution dependent version +of soil_erod is now the 1.9x2.5 version. This resolution was previously +using 0.9x1.25. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +Answers will change for all SE w/ prognostic aerosol runs. + +Answers will change for FV w/ prognostic aerosols for resolutions finer +than 1 deg, or for low resolutions that don't already have resolution +specific version of soil_erod. + +=============================================================== +=============================================================== + +Tag name: cam5_3_22 +Originator(s): cbardeen, santos +Date: 2014/01/02 +One-line Summary: New CARMA updates and compiler porting + +Purpose of changes: + + - Add six new CARMA models: + - cirrus_dust + - meteor_impact + - mixed_sulfate + - pmc_sulfate + - tholin + - test_tracers2 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + - New CPP macro, N_RAD_CNST, sets the maximum allowed number of + radiatively active constituents. + + - Work around new NAG fpp bug by turning off macro expansion in comments. + +Describe any changes made to the namelist: + + - Add defaults for the new CARMA models. + + - New carma_emis_* variables for the meteor impact model. + + - New carma_neutral_h2so4 flag. + + - The types in namelist_definitions.xml can now contain arrays with + variable dimensions. + + - The variable n_rad_cnst was introduced, and controls the size of the + rad_climate and rad_diag_* arrays. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/carma/cam/carma_getH2O.F90 +A models/atm/cam/src/physics/carma/cam/carma_getH2SO4.F90 + - Create constituent profiles from averages over columns. + +A models/atm/cam/src/physics/carma/models/cirrus_dust +A models/atm/cam/src/physics/carma/models/cirrus_dust/carma_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus_dust/hetnucl.F90 +A models/atm/cam/src/physics/carma/models/cirrus_dust/growevapl.F90 +A models/atm/cam/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 + - Add CARMA cirrus_dust model. + +A models/atm/cam/src/physics/carma/models/meteor_impact +A models/atm/cam/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 + - Add CARMA meteor_impact model. + +A models/atm/cam/src/physics/carma/models/mixed_sulfate +A models/atm/cam/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 + - Add CARMA mixed_sulfate model. + +A models/atm/cam/src/physics/carma/models/pmc_sulfate +A models/atm/cam/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 + - Add CARMA pmc_sulfate model. + +A models/atm/cam/src/physics/carma/models/test_tracers2 +A models/atm/cam/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 + - Add CARMA test_tracers2 model. + +A models/atm/cam/src/physics/carma/models/tholin +A models/atm/cam/src/physics/carma/models/tholin/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/tholin/carma_model_flags_mod.F90 + - Add CARMA tholin model. + +A models/atm/cam/test/system/config_files/f1.9c5carmc_ddm +A models/atm/cam/test/system/config_files/f4c5carmm_idm +A models/atm/cam/test/system/config_files/f4c5carmm_sdm +A models/atm/cam/test/system/config_files/f4c5carmp_sdm +A models/atm/cam/test/system/config_files/f4c5carmthodm +A models/atm/cam/test/system/config_files/f4c5carmtt1dm +A models/atm/cam/test/system/config_files/f4c5carmtt2dm + - Config files for tests of new models. + +A models/atm/cam/test/system/config_files/f4c4rrtmgdm + - Test case for CAM4+RRTMG. + +A models/atm/cam/test/system/nl_files/outfrq3s_carma +A models/atm/cam/test/system/nl_files/outfrq3s_carma_fractal + - Add namelist for a outfrq3s test for CARMA, and CARMA with + fractal soot enabled. + +List all existing files that have been modified, and describe the changes: + + + NOTE: There are changes for porting to the NAG compiler, as well as + cosmetic changes (such as whitespace), throughout the CARMA + modules. The most common such change is to wrap lines that would + otherwise be longer than the Fortran standard's limit (132 + characters.) These changes will not be listed individually. + + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - New CARMA external. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add settings for new CARMA models and features. + - Allow the user to increase the maximum allowed number of + radiatively active (or diagnosed) constituents, using the new + option "-max_n_rad_cnst". + +M models/atm/cam/bld/perl5lib/Build/Namelist.pm +M models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm + - Allow namelist_definitions.xml to specify a variable as an array + dimension (for n_rad_cnst). + +M models/atm/cam/bld/Makefile.in + - For NAG, don't expand macros in comments (workaround for fpp + regression). + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Don't add rel_fn to the physics buffer, since it's only used for + output from MG itself. + +M models/atm/cam/src/physics/cam/phys_prop.F90 + - Remove limit on maximum number of unique input files, by using + an allocatable to store the list. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Allow grid cells to have negative altitude. (Fixes issue with + state_debug_checks and negative topology.) + +M models/atm/cam/src/physics/cam/rad_constituents.F90 + - Maximum number of radiative constituents now comes from the + parameter n_rad_cnst, set from the macro N_RAD_CNST. + +M models/atm/cam/src/physics/cam/radiation_data.F90 + - Don't output rel_fn; it can be output by MG, and is not actually + an input the radiation uses in the first place. + +M models/atm/cam/src/physics/carma/cam/carma_getT.F90 + - Spelling correction. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - Create and use new H2O/H2SO4 profiles. + - Correct indexing errors. + - Changes for new fractal code. + - Fix fairly severe error where "nf90_get_var" was being used + instead of "nf90_put_var", leading to outputs of files + containing uninitialized data. + +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 + - Fix bug where state was being inappropriately modified by calls + to MG routines. + +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 + - Address case where Weibull_k is 0 differently. + - Removed prescribed Weibull coefficients entirely from this file, + since this feature has not been completed, and the incomplete + pieces broke the NAG build. + +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 + - Only NAG port and cosmetic changes. + +M models/atm/cam/src/physics/rrtmg/rad_solar_var.F90 + - Removed unnecessary use of ssi_ref. + +M models/atm/cam/src/physics/rrtmg/radiation.F90 + - Don't retrieve REL, REL_FN, and REI from pbuf, because they are + never used. + +M models/atm/cam/test/system/TER.sh + - For restart tests, copy RRTMG optical property files that have + been written out by CARMA. + +D models/atm/cam/test/system/config_files/fsd1.9c4wcarmsulm +A models/atm/cam/test/system/config_files/fsd1.9c4wcarmsuldm + - Change SD-WACCM CARMA sulfate test to a debug mode test. + +M models/atm/cam/test/system/input_tests_master + - Add tests for CAM4+RRTMG and new CARMA models. + - Dust and SD-WACCM tests are now 9 timestep debug tests. + +M models/atm/cam/test/system/nl_files/outfrq3s_carma + - Remove year specification (it messed up the SD test, which + doesn't have data for 1995). + +M models/atm/cam/test/system/test_driver.sh + - Explicitly use netCDF 4.3 on Frankfurt/NAG, since the symlink + still points to a version where getting text attributes will + corrupt data on the stack. + +M models/atm/cam/test/system/tests_carma + - Add new CARMA model tests to this list. + +M models/atm/cam/test/system/tests_pretag_frankfurt_nag + - Add test for CAM4+RRTMG. + - Add test for CARMA test_tracers. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +All PASS. + +frankfurt/nag: + +038 bl324 TBL.sh f4c4rrtmgdm outfrq3s 9s ..................................FAIL! rc= 7 at Thu Jan 2 11:15:23 MST 2014 +041 bl805 TBL.sh f4c5carmtt1dm outfrq3s_carma 9s ..........................FAIL! rc= 7 at Thu Jan 2 11:15:24 MST 2014 + +Failures for new tests where there is no baseline. + +frankfurt/pgi or jaguar/pgi: + +All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + +All configurations with CARMA. + +- what platforms/compilers: + +All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +Mixed, several likely to have new climate. No changes to compsets that are +scientifically supported within CESM; this is only new CARMA development. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_21 +Originator(s): cacraig +Date: 12/20/13 +One-line Summary: Update yellowstone intel compiler to 13.1.2 to allow implementation of eq tests for CESM + +Purpose of changes: + - Have CAM standalone tests on yellowstone use Intel 13.1.2 to allow CESM eq tests to be BFB (compiler version + CESM is currently using) + - Modified CESM regression tests on yellowstone to be eq tests for CAM4 FV and CAM5 SE + - Added missing finidat file for ne30np4 case (answers were not BFB with CESM without it) + - Updated to alpha06d externals (except CLM which has a bug) to eliminate core dump in pio + - Performed mergeinfo cleanup (svn propdel svn:mergeinfo -R; svn revert .) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCB_ccsm.sh + - Added echo of all CESM commands for documentation purposes + +M models/atm/cam/test/system/TSM.sh + - Added echo of command sent to TCB.sh for documentation purposes + +M models/atm/cam/test/system/test_driver.sh + - Force yellowstone intel compilations to be 13.1.2 to match CESM compiler and allow eq tests to be BFB + +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/input_tests_master + - Modified CESM tests on yellowstone to be eq tests for CAM4 FV and CAM5 SE + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Added missing finidat file for ne30np4 case (answers were not BFB with CESM without it) + +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + - Change trunits to character*256 to get rid of bounds error in sm374 and sm430 with Intel 13.1.2 + +M SVN_EXTERNAL_DIRECTORIES + - Updated to alpha06d externals to eliminate core dump in pio + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +********* SPECIAL NOTES ON TESTING ************** +** Due to time constraints due to the upcoming holidays, +** yellowstone tests were run without changes to inidat. +** The change to inidat allowed sm374 and sm430 to run to +** completion and these two group of tests were rerun. +** Other yellowstone tests were not run with this inidat +** change on yellowstone. +************************************************* +yellowstone/intel: All BFB except, +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Mon Dec 16 18:23:43 MST 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Dec 16 19:41:43 MST 2013 +070 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Mon Dec 16 20:25:32 MST 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Mon Dec 16 20:42:02 MST 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Mon Dec 16 21:06:26 MST 2013 + - Answer changes due to change in compiler + +frankfurt/nag: All BFB and run with new inidat + +frankfurt/pgi or jaguar/pgi: All BFB and run with new inidat + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_20 +Originator(s): hannay, pel, mataylo, eaton +Date: +One-line Summary: update SE dycore tuning parameters and mct_libdir option + +Purpose of changes: + +. Update SE dycore tuning parameters + - Change time stepping method to RK5 (Kinnmark & Gray Runga-Kutta 5 + stage; 3rd order accurate in time) + - Set the namelists variables as recommended for RK5 in: + http://www.cgd.ucar.edu/cms/pel/software/cam-se-dt-table.pdf + - Add "tstep_type" namelist option for SE dycore + - Turn on the FV energy fixer (This will be updated later on with + Williamson an Olson enery fixer) + - Remove the variable "energy_fixer" from the cam namelist. + + To update a namelist created by an earlier CAM tag for an SE run on + grid ne30np4 one should make the following changes: + - The default settings for CESM1.2.0 were: + tstep_type =1 + hypervis_subcycle = 2 + qsplit =4 + rsplit = 5 + se_ftype =1 + se_nsplit = 1 + + - The new recommended settings are: + tstep_type =5 + hypervis_subcycle = 3 + qsplit = 1 + rsplit = 3 + se_ftype =0 + se_nsplit = 2 + + These changes have been approved by the AMWG co-chairs: + Rich Neale: 11/11/2013 + Minghua Zhang: 11/12/2013 + Mark Taylor: 11/12/2013 + +. Allow the CAM standalone mode to build the MCT libs outside the CAM build + directory so that they can be reused for multiple CAM builds. The + location of the MCT build is specified using the -mct_libdir argument. + If the libraries are present in the location specified by -mct_libdir + then the MCT configure and build do not need to be redone. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. add tstep_type, remove energy_fixer, and change many default SE tuning + parameters + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. remove default for energy_fixer +. add default for tstep_type + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update defaults for dtime, nu, nu_p, nu_div, hypervis_subcycle, qsplit, + rsplit, se_nsplit, se_ftype +. remove energy_fixer default +. add default for tstep_type + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add namelist variable tstep_type for SE timestepping method +. remove entry for energy_fixer + +models/atm/cam/src/physics/cam/physpkg.F90 +. tphysbc and phys_run1_adiabatic_or_ideal + - Add SE to the conditional for running the check_energy_fix global + energy fixer (also used by FV). + +models/atm/cam/test/system/TCB.sh +models/atm/cam/bld/configure +. Added changes to allow mct to be built once and used for all tests + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Thu Dec 5 20:45:41 MST 2013 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Thu Dec 5 21:02:21 MST 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Thu Dec 5 21:05:37 MST 2013 +084 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Thu Dec 5 21:22:22 MST 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Thu Dec 5 21:40:24 MST 2013 + + +frankfurt/nag: All BFB + +frankfurt/pgi or jaguar/pgi: all BFB except +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Thu Dec 5 19:24:50 MST 2013 + +SE tests were answer changing and approved by the AMWG co-chairs + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: All SE configurations have answer +changes. The climate is similar for ne30np4. + +URL for AMWG diagnostics output used to validate new climate: +> http://webext.cgd.ucar.edu/FCLIMO/f.e12.F2000C5.ne30_ne30.dyn.001/atm/f.e12.F2000C5.ne30_ne30.dyn.001-f.e12.F2000C5.ne30_ne30.cnt.001/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_19 +Originator(s): Cheryl Craig, Jen Kay, Jay Shollenberger, Jim Edwards, Brian Eaton +Date: 11/21/13 +One-line Summary: Misc updates + +Purpose of changes: + - update a use case + - updated SVN_EXTERNAL_DIRECTORIES to match alpha06c (gets the fix for Machines) + +Bugs fixed (include bugzilla ID): + - 1859: bug inside physics_buffer: linked list should be advanced from 2,index instead of 1,index + - 1864: bug in lidar simulator fixed + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml + - Changed SSLT01PP, SSLT02PP, SSLT03PP and SSLT04PP to + SSLT01WET, SSLT02WET, SSLT03WET and SSLT04WET + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - bug fix from jenkay for lidar simulator in cosp + +M models/atm/cam/src/control/cam_history.F90 + - bug fix from edwards to _Filltype type written to history restart file + did not match the data type when history files were set to real in netCDF6. + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - bug fix from eaton. In physics_buffer, pbuf_get_field_name the loop over the + linked list was one too many. Now loops from 2,index. + +M models/atm/cam/test/system/tests_pretag_frankfurt_pgi + - Removed tests sm991 and eq991 per Brian Eaton + His feeling is that CESM testing should be done by the CESM team and this test is redundant + The CESM team is seeing this error as well. + +M SVN_EXTERNAL_DIRECTORIES + - Needed new machines external to fix CESM regression tests. This tag + appears to depend on other tags (CESM test would not build). Updated + all externals to ones used in alpha06c + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +frankfurt/nag: all BFB + +frankfurt/pgi or jaguar/pgi: all BFB except: +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Nov 21 15:46:21 MST 2013 + The cosp test was expected to be different + +060 sm991 TSM_ccsm.sh f19_f19 F 2d ........................................FAIL! rc= 4 at Thu Nov 21 17:00:26 MST 2013 +061 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 4 at Thu Nov 21 17:00:26 MST 2013 + NOTE -- These tests are permanently removed per Brian Eaton + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_18 +Originator(s): cacraig +Date: 11/20/13 +One-line Summary: Update externals to CESM1_3_beta05 + +Purpose of changes: Update externals to CESM1_3_beta05 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update externals to CESM1_3_beta05 except for csm_share. + beta05 used share3_130918 for csm_share, but CAM requires + share3_131101 which made gamma elemental and is required in micro_mg_cam. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB except +085 sm992 TSM_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 6 at Mon Nov 18 20:43:08 MST 2013 +086 er992 TER_ccsm.sh f19_g16 ETEST 1+1d ..................................FAIL! rc= 6 at Mon Nov 18 20:43:08 MST 2013 +087 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 4 at Mon Nov 18 20:43:08 MST 2013 +088 sm997 TSM_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 6 at Mon Nov 18 21:13:31 MST 2013 +089 er997 TER_ccsm.sh ne16_g37 FC5 1+1d ...................................FAIL! rc= 6 at Mon Nov 18 21:13:31 MST 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 4 at Mon Nov 18 21:13:31 MST 2013 +091 ne996 TNE_ccsm.sh f45_f45 FMOZ FMOZ+testmech 2d .......................FAIL! + +These CESM tests failed due to a bug in scripts/ccsm_utils/Machines/mkbatch.yellowstone. Jim provided a fix which I tested +and the tests all passed and were BFB. This fix will be in his next machines tag and will be incorporated in cam5_3_19. + +frankfurt/nag: All BFB + +frankfurt/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + +- what platforms/compilers: + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_17 +Originator(s): santos +Date: 13/11/04 +One-line Summary: Compiler fixes, prep work for new MG substepping. + +Purpose of changes: + + - Bring in changes from the MG microphysics development branch, to make it + easier to merge the full set of changes with the new subcolumn framework + later. + + This includes micro_mg_utils, which provides routines that implement + part of the core functionality of MG version 2 (coming soon). + + - Fix issues identified by NAG. + + - Fix issue due to missing CMELIQ output in the CLUBB interface. + + - Address other bugs that show up in rare cases. + +Bugs fixed (include bugzilla ID): + + - #1813: CMELIQ no longer able to be output + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/micro_mg_utils.F90 + - Module providing utility code and individual process subroutines. + Part of MG 2.0 will be based on this module. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update csm_share to a version where gamma is an elemental + function. + +M models/atm/cam/bld/cam.buildnml.csh + - Turn on state_debug_checks if DEBUG is TRUE. + +M models/atm/cam/src/chemistry/mozart/apex_subs.F90 + - Send array sections to TRILIN rather than individual elements + (i.e. pointers), to satisfy NAG checks that error due to the + dummy array exceeding the bounds of the actual argument array. + +M models/atm/cam/src/chemistry/mozart/spedata.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 + - Nullify pointers and take steps to reduce the chance of an + uninitialized pointer reference. + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + - Change modal_aero_kohler to use assumed shape arrays to avoid a + pointless copy. + +M models/atm/cam/src/control/interpolate_data.F90 + - Use new integer flag in lininterp_full1d instead of a literal 1. + - Remove inappropriate check that causes failure in RRTMG for + serial cases that are not SCAM runs. + +M models/atm/cam/src/control/wrap_nf.F90 + - Remove arbitrary addition of "1" to a dimension; this has no + clear purpose and was causing issues for CARMA with strict + compiler checks. + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - Add missing addfld/outfld calls for CMELIQ. + +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 + - Remove unnecessary output "cldo". + - Rearrange statements. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Reduce the number of differences with respect to the MG 2.0 + development branch, including statement reordering, cleanup, + whitespace, and output changes. + +M models/atm/cam/src/physics/cam/tropopause.F90 + - Switch to assumed-shape arrays for twmo interface, avoiding an + unnecessary copy, and also change the name "gamma" to "gam" to + avoid any name clash with the F2008 intrinsic. + +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 + - Remove routines that were duplicated from an earlier version of + the MG microphysics, and instead use versions from the new + micro_mg_utils module. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS. + +frankfurt/nag: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + Changes answers for CARMA cirrus model only. + +- what platforms/compilers: + + All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Roundoff. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + Offline testing of the size distribution routines that caused the answer + change. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_16 +Originator(s): fvitt +Date: 21 Oct 2013 +One-line Summary: Refactor the chemistry-aerosol model interface and update drv tag. + +Purpose of changes: + + - The chemistry-aerosol model interface was refactored to provide a more + extendable framework. This will ease incorporation of other aerosol + models (e.g., a sectional aerosol model) + + This refactoring of the chemistry-aerosol model interface does away with the numerous + ifdefs that have been historically used to embed aerosol models within CAM-Chem. + Each aerosol model must provide the following modules in chemistry/name_aero (where + name is a named aerosol model, e.g., modal): + aero_model.F90 ------- aerosol model specific module with methods: + . aero_model_drydep ----- aerosol dry deposition and sediment + . aero_model_wetdep ----- aerosol wet removal + . aero_model_emissions -- aerosol emissions + . aero_model_surfarea --- aerosol surface area for chemistry + . aero_model_gasaerexch - create, grow, change, and shrink aerosols + dust_model.F90 ------- dust module with methods + . dust_names - dust species names + . dust_nbin -- number of dust bins + . dust_emis -- emissions method + seasalt_model.F90 ---- sea salt module with methods + . seasalt_names - sea salt species names + . seasalt_nbin -- number of sea salt bins + . seasalt_emis -- sea salt emissions method + sox_cldaero_mod.F90 -- aerosol model specific code for cloud aerosol/SOx aqueous chemistry + + - Update drv tag to drvseq5_0_03 which fixes SCAM test + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/namelist_files/master_mam_dep_list.xml +D models/atm/cam/bld/namelist_files/master_drydep_list.xml + - re-organized master deposition list files + +D models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +D models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +D models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 + - removed + +D models/atm/cam/src/chemistry/bulk_aero/drydep_mod.F90 +D models/atm/cam/src/chemistry/bulk_aero/wetdep.F90 +D models/atm/cam/src/chemistry/bulk_aero/dust_sediment_mod.F90 + - moved to chemistry/aerosol directory + +D models/atm/cam/src/chemistry/mozart/mo_setsox.F90 + - moved to chemistry/aerosol directory + +D models/atm/cam/src/chemistry/mozart/mo_aerosols.F90 +D models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 + - moved to chemistry/bulk_aero + +D models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + - removed + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/master_aer_drydep_list.xml +A models/atm/cam/bld/namelist_files/master_gas_drydep_list.xml + - re-organized master deposition list files + +A models/atm/cam/src/chemistry/modal_aero/aero_model.F90 +A models/atm/cam/src/chemistry/modal_aero/seasalt_model.F90 +A models/atm/cam/src/chemistry/modal_aero/dust_model.F90 + - modal aerosol specific code + +A models/atm/cam/src/chemistry/modal_aero/sox_cldaero_mod.F90 + - modal aerosol specific code for aqueous chemistry + +A models/atm/cam/src/chemistry/bulk_aero/mo_aerosols.F90 + - moved from chemistry/mozart + +A models/atm/cam/src/chemistry/bulk_aero/aerosol_depvel.F90 +A models/atm/cam/src/chemistry/bulk_aero/aero_model.F90 +A models/atm/cam/src/chemistry/bulk_aero/mo_setsoa.F90 +A models/atm/cam/src/chemistry/bulk_aero/seasalt_model.F90 +A models/atm/cam/src/chemistry/bulk_aero/dust_model.F90 +A models/atm/cam/src/chemistry/bulk_aero/sox_cldaero_mod.F90 + - module for the bulk aerosol model + +A models/atm/cam/src/chemistry/aerosol/mo_setsox.F90 +A models/atm/cam/src/chemistry/aerosol/dust_sediment_mod.F90 + - moved from chemistry/mozart + +A models/atm/cam/src/chemistry/aerosol/drydep_mod.F90 +A models/atm/cam/src/chemistry/aerosol/dust_common.F90 +A models/atm/cam/src/chemistry/aerosol/cldaero_mod.F90 +A models/atm/cam/src/chemistry/aerosol/wetdep.F90 +A models/atm/cam/src/chemistry/aerosol + - utility modules common to all aerosol models + +A models/atm/cam/src/chemistry/aerosol/soil_erod_mod.F90 + - extracted code from deprecated dust_intr.F90 module + +A models/atm/cam/src/chemistry/aerosol/sslt_sections.F90 + - extracted code from deprecated progseasalts module + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TR8.sh + - check for r8 kind in source directory src/cpl rather than the multiple + src/cpl_* directories that existed prior to cam3_5_15 + +M models/atm/cam/bld/configure + - change in Filepath directory structure for the aerosol models + +M models/atm/cam/bld/namelist_files/master_aer_wetdep_list.xml + - re-organized master deposition list files + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - sol_farcti_cloud_borne, aerosol_drydep_list, and aer_wetdep_list + are now part of the aerosol_nl namelist group + - dust_emis_fact moved to dust_nl namelist group + - "soil_erod" --> "soil_erod_file" and is included in dust_nl namelist group + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - "soil_erod" --> "soil_erod_file" + +M models/atm/cam/bld/build-namelist + - refactored how deposition lists are set + - "soil_erod" --> "soil_erod_file" + - set sol_facti_cloud_borne only if chemistry has modal aerosols + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - refactored how deposition lists are set + +M models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml + - removed ORO from fincl list + - "soil_erod" --> "soil_erod_file" + +M models/atm/cam/bld/namelist_files/use_cases/soa_chem_megan_emis.xml + - *PP history fields replaced by *WET fields + +M models/atm/cam/src/control/camsrfexch.F90 + - extend cam_in_t for dust and MEGAN fluxes from land model + +M models/atm/cam/src/cpl/atm_comp_mct.F90 +M models/atm/cam/src/cpl/atm_comp_esmf.F90 +M models/atm/cam/src/cpl/atm_import_export.F90 + - set dust and MEGAN fluxes in the cam_in data structure + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - replaced MODAL_AERO ifdef with prog_modal_aero conditional + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - removed MODAL_AERO ifdef that served no purpose + +M models/atm/cam/src/physics/cam/physpkg.F90 + - add FRACIS to phys buffer + - register and initialize calsize and wateruptake for modal aerosol model + - removed calls to aerosol_reg and aerosol_init -- these are invoked by chemistry + - removed MODAL_AERO ifdefs + - invoke calcsize and wateruptake for prescribed modal aerosols + +M models/atm/cam/src/physics/cam/qneg3.F90 + - removed MODAL_AERO ifdefs and qneg3_modalx1 subroutine which was + essentially a duplication of the qneg3 subroutine + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - moved output of 'ustar' and 'obklen' history fields to this module + +M models/atm/cam/src/chemistry/pp_none/chemistry.F90 + - chem_register invokes aero_model_register for prescribed aerosols + - chem_init invokes aero_model_init for prescribed aerosols + - added stub chem_emissions subroutine to be consistent with mozart/chemistry.F90 + +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 + - added comment + +M models/atm/cam/src/chemistry/utils/mo_constants.F90 + - added densities of dust and sea salt + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + - added register method which adds DGNUMWET, WETDENS_AP, and QAERWAT fields + to physics buffer + +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 + - added register method which adds DGNUM field to physics buffer + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 + - removed latndx and lonndx arguments + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 + - moved addfld calls for aqueous chemistry to sox_cldaero_mod + - moved call to modal_aero_bcscavcoef_init to modal_aero/aero_model.F90 + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - removed the numerous MODAL_AERO ifdefs + - the bulk of the modal aerosol formation code moved to + aero_model_gasaerexch subroutine which include aqueous chem in setsox + - invocation of set_srf_emissions moved to chem_emissions subroutine + +M models/atm/cam/src/chemistry/mozart/mo_setaer.F90 + - reference sslt_names + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - removed calls to aerosols_inti, soa_inti, and sox_int subroutines + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - removed MODAL_AERO ifdefs + -- moved cloud-borne wet dep addfld calls to modal_aero/aero_model.F90 + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - chem_reset_fluxes --> chem_emissions + - aerosol namelist vars moved to aero_model + - general cleanup + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - reference seasalt_names + +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 + - determine if modal aerosols in initialization + +M models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + - min size of 1 for col_dens and col_delta arguments + +M models/atm/cam/src/chemistry/mozart/mo_mass_xforms.F90 + - moved qqcw2vmr and vmr2qqcw to modal_aero/aero_model.F90 + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - removed surarea code -- is now in aero_model.F90 + - removed MODAL_AERO ifdefs + +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + - removed calls to aerosol_implements_cnst (deprecated) + +M SVN_EXTERNAL_DIRECTORIES + - update drv tag to drvseq5_0_03 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All pass + +frankfurt/nag: All pass + +frankfurt/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_15 +Originator(s): cacraig, mvertens +Date: 10/17/13 +One-line Summary: Merge in comptype03_cam5_3_10 and update to cesm1_3_beta04 externals + +Purpose of changes: +- Merge in Mariana's changes in comptype03_cam5_3_10 + svn merge $CAMREPO/trunk_tags/cam5_3_10 $CAMREPO/branch_tags/comptype_tags/comptype03_cam5_3_10 + (plus additional changes below) +- Additional changes required: + cp /glade/u/home/mvertens/src/cesm1_3_beta04+comptype/models/atm/cam/src/utils/cam_dom/ocn_comp_mct.F90 + svn del cpl_mct, cpl_mct_ocn_comp_mct.F90, cpl_esmf + svn add ocn_comp_mct.F90 + cp /glade/u/home/mvertens/src/cescm1_3_beat04_comptype/models/atm/cam/bld/configure + Needed to modify models/atm/cam/src/cpl/atm_import_export.F90 to incorporate the changes from cam5_3_14 +- Using cesm1_3_beta04 externals except for share which is using share3_130918 to get single column test to pass +- Added ability to CAM regression tests to use caldera for both compilation and running if job is started while logged on caldera + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +D models/atm/cam/src/cpl_share +D models/atm/cam/src/cpl_share/cam_cpl_indices.F90 +D models/atm/cam/src/utils/cam_dom/cpl_mct +D models/atm/cam/src/utils/cam_dom/cpl_mct/ocn_comp_mct.F90 +D models/atm/cam/src/utils/cam_dom/cpl_esmf +D models/atm/cam/src/utils/cam_aqua/cpl_mct +D models/atm/cam/src/utils/cam_aqua/cpl_mct/ocn_comp_mct.F90 +D models/atm/cam/src/utils/cam_aqua/cpl_esmf +D models/atm/cam/src/cpl_mct +D models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +D models/atm/cam/src/cpl_esmf +D models/atm/cam/src/cpl_esmf/atm_comp_mct.F90 +D models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 + - Changes from the comptype branch merge + +List all subroutines added and what they do: +A models/atm/cam/src/utils/cam_dom/ocn_comp_mct.F90 +A + models/atm/cam/src/utils/cam_aqua/cpl +A + models/atm/cam/src/utils/cam_aqua/cpl/ocn_comp_mct.F90 +A + models/atm/cam/src/cpl +A + models/atm/cam/src/cpl/atm_comp_mct.F90 +A + models/atm/cam/src/cpl/atm_comp_esmf.F90 +A + models/atm/cam/src/cpl/atm_import_export.F90 +A + models/atm/cam/src/cpl/cam_cpl_indices.F90 + - Changes from the comptype branch merge + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh + - Added the ability to use caldera instead of yellowstone if job initiated on caldera + +M models/atm/cam/bld/configure + - Changes from the comptype branch merge + +M SVN_EXTERNAL_DIRECTORIES + - Using cesm1_3_beta04 externals except for share which is using share3_130918 to get single column test to pass + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: + +092 sc001 TSC.sh e64c5bfbiop scm_prep scm64c5bfbiop scm_b4b_o1 7s .........FAIL! rc= 6 at Tue Oct 15 00:23:51 MDT 2013 + - Not all of John Truesdale's changes made it into the driver tag. Mariana will be updating and will be in future tag. + +frankfurt/nag:all BFB: + +frankfurt/pgi: all BFB: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_14 +Originator(s): fvitt +Date: 30 Sep 2013 +One-line Summary: Minor corrections to aerosol code and bug fixes + +Purpose of changes: + +This branch isolates the answer changing corrections uncovered +during the refactoring of chemistry/aerosol interface. + +Answer changing features: + + - Corrections to dust emissions to use unmodified dust fluxes + from the coupler each time step -- in time-steps where fluxes + from surface models were not updated modification of cam_in%cflx + were not representations of dust flux from surface models but the + modification of dust fluxes from the previous time-step. For example, + when the model advances from time step 0 to time step 1 it does not + couple with surface models and thus does not restore cflx with dust + fluxes from coupler. + + - Removed kludge in ChemNamelist.pm that excluded H2SO4 from the + gas_wetdep_list namelist variable + + - Register number density tracers with qmin of 1e-5 -- this allows + removal of special code in uwshcu for MAM + + - Scale organic aerosol emissions off line for MAM + + - Replace obsolete sulfchem routine with some chemistry for trop_bam + + - Let chemistry output all aerosols in MMR units (kg/kg) + and gas species in VMR units (mole/mole) regardless of + aerosol model + + - Corrections in setsox routine for chemistry mechanisms with MAM3 + aerosols that include NH3 + + - Removed kludge in the hetrxtrate routine of mo_usrrxt which was + introduced to keep the bulk aerosol model bit-for-bit + +Bugs fixed (include bugzilla ID): Bug 1824 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/bulk_aero/sulchem.F90 + - this code is obsolete and thus was removed + +List all subroutines added and what they do: + +A models/atm/cam/test/system/config_files/fmz4c5dm +A models/atm/cam/test/system/config_files/fsf1.9c5dh +A models/atm/cam/test/system/config_files/fprgspc4c4dm +A models/atm/cam/test/system/config_files/fsf4c4dm +A models/atm/cam/test/system/config_files/fst4c5dm +A models/atm/cam/test/system/config_files/fsf1.9c4dh +A models/atm/cam/test/system/config_files/f1.9c4carmsuldh +A models/atm/cam/test/system/nl_files/outfrq3s_NEUwetdep + - updates to chemistry regression tests + +List all existing files that have been modified, and describe the changes: + + +M models/atm/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp60.xml +M models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +M models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- new emissions files for MAM pom and soag + -- the emissions MAM primary organic matter and SOA are now + multiplied offline by a factor of 1.4 + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - removed the obsolete "use_cam_sulfchem" namelist option + +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_trop_bam.xml + - trop_bam now needs spectral irradiance solar data for photolysis + + +M models/atm/cam/bld/build-namelist + - references to 'use_cam_sulfchem' namelist variable were moved + - bulk aerosol model need default photolysis inputs + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - removed the kludge that excluded H2SO4 from the gas_wetdep_list namelist variable + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - for BAM include the chemistry for the aerosol precursors + +M models/atm/cam/src/physics/cam/uwshcu.F90 + - removed the special code which set trmin to 1e-5 for number density tracers + -- this is accounted for by setting qmin to 1e-5 when the tracers + are registered to the consistuents module + +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.in + - changes to trop_bam mechanism to include chemistry for aerosol precursors + which is needed to replace the calcuations of the obsolete sulfchem routine + + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 + - added wet dep diagnostics + +M models/atm/cam/src/chemistry/bulk_aero/dust_sediment_mod.F90 + - corrections to if block expressions + +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 + - corrections to dust emissions to use unmodified dust fluxes + from surface models each time step -- in time-steps where fluxes + from surface models were not updated modification of cam_in%cflx + were not representations of dust flux from surface models but the + modifaction of dust fluxes from the previous time-step. + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - add emissions fluxes returned from set_srf_emissions to cflx + - removed references to do_cam_sulfchem + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - let chemistry output all aerosols in MMR units (kg/kg) + and gas species in VMR units (mole/mole) regardless of + aerosol model + +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 + - removed special code which scaled organic aerosol emissions + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - register number density tracers with qmin set to 1.e-5 + - removed use_cam_sulfchem from chemistry namelist + +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + - removed obsolete sulfchem option + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - removed a kludge in the hetrxtrate routine which was introduced to + keep the bulk aerosol model bit-for-bit + +M models/atm/cam/src/chemistry/mozart/mo_setsox.F90 + - correction for chemistry mechanisms with MAM3 aerosols that inlucde NH3 + +M models/atm/cam/src/control/camsrfexch.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 + - extend cam_in_t data structure for dust fluxes from surface models + - dust fluxes from the surface models are simply copied to cam_in%dstflx + without any modifications. This prevents an error which happens + when the model goes from time step 0 to time step 1, which does not + couple with surface models and thus does not restore cflx with dust + fluxes from coupler. + +M models/atm/cam/test/system/tests_chem_hybrid +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_chem_mpi + - updates to chemistry regression tests + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + -- Bugzilla – Bug 1824 -- don't use cyc_ndx_beg before it is defined + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Fri Sep 27 21:51:05 MDT 2013 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Sep 27 22:04:01 MDT 2013 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Sep 27 22:27:31 MDT 2013 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Fri Sep 27 22:42:35 MDT 2013 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Fri Sep 27 23:00:23 MDT 2013 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Sep 27 23:17:06 MDT 2013 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Sep 27 23:47:27 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Sep 27 23:51:43 MDT 2013 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Fri Sep 27 23:58:49 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_NEUwetdep 9s ..........................FAIL! rc= 7 at Sat Sep 28 00:17:53 MDT 2013 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Sat Sep 28 00:38:28 MDT 2013 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Sat Sep 28 01:37:52 MDT 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Sat Sep 28 01:40:56 MDT 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Sat Sep 28 02:22:09 MDT 2013 + - expected failures + +092 sc001 TSC.sh e64c5bfbiop scm_prep scm64c5bfbiop scm_b4b_o1 7s .........FAIL! rc= 6 at Sat Sep 28 02:32:04 MDT 2013 + - this failed in previous tag + +frankfurt/nag: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Sep 27 16:46:11 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Sep 27 16:56:14 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Sep 27 17:04:30 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Sep 27 17:15:09 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Sep 27 17:41:33 MDT 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Sep 27 17:54:59 MDT 2013 + - expected failures + +frankfurt/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Sep 27 16:46:48 MDT 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Sep 27 16:56:32 MDT 2013 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Sep 27 17:02:49 MDT 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Sep 27 17:10:19 MDT 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Sep 27 17:27:21 MDT 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Sep 27 18:02:22 MDT 2013 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Sep 27 18:27:56 MDT 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Sep 27 18:39:34 MDT 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Fri Sep 27 18:55:59 MDT 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Fri Sep 27 19:15:26 MDT 2013 + - expected failures + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/aerofixes_cam5_3_12_tags/aerofixes01_cam5_3_12 + +- platform/compilers: + yellowstone / intel + +- configure commandline: + create_newcase -case /glade/p/acd/fvitt/cesm/cases/FC5.cam5312.ne30.test.001 -compset FC5 -res ne30_ne30 -mach yellowstone + +- build-namelist command (or complete namelist): + defaults for the FC5 ne30_ne30 configuration + +- MSS location of output: + -fvitt/csm/FC5.cam5312.ne30.test.001 + +MSS location of control simulations used to validate new climate: + /CCSM/csm/f.e13.FC5.ne30_ne30.test2ans.002 + +URL for AMWG diagnostics output used to validate new climate: + http://webext.cgd.ucar.edu/FCLIMO/FC5.cam5312.ne30.test.001/atm/FC5.cam5312.ne30.test.001-f.e13.FC5.ne30_ne30.test2ans.002/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_13 +Originator(s): cacraig +Date: 9/27/13 +One-line Summary: SVN_EXTERNAL_DIRECTORIES updated to cesm1_3_beta03 + +Purpose of changes: +- Updated to all cesm1_3_beta03 directories +- Updated share to share3_130918 (cesm1_3_alpha04a) to fix the frankfurt single column tests + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB except: + +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Mon Sep 23 19:10:56 MDT 2013 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Sep 23 19:14:57 MDT 2013 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Sep 23 19:26:09 MDT 2013 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Mon Sep 23 19:35:35 MDT 2013 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Mon Sep 23 19:50:23 MDT 2013 +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Mon Sep 23 19:57:50 MDT 2013 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Sep 23 20:05:37 MDT 2013 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Mon Sep 23 20:23:33 MDT 2013 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Sep 23 20:40:25 MDT 2013 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Sep 23 21:10:38 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Sep 23 21:14:51 MDT 2013 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Mon Sep 23 21:22:02 MDT 2013 +058 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon Sep 23 21:31:13 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Mon Sep 23 21:41:21 MDT 2013 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s_mozEOOH+soa_chem_megan_emis 9s ......FAIL! rc= 7 at Mon Sep 23 22:02:19 MDT 2013 +067 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Mon Sep 23 22:13:31 MDT 2013 +070 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Mon Sep 23 22:16:13 MDT 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Mon Sep 23 22:33:18 MDT 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Mon Sep 23 23:04:53 MDT 2013 +087 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 7 at Mon Sep 23 23:31:36 MDT 2013 + - Changes expected due to Tony's coupler changes + +092 sc001 TSC.sh e64c5bfbiop scm_prep scm64c5bfbiop scm_b4b_o1 7s .........FAIL! rc= 6 at Mon Sep 23 23:54:57 MDT 2013 + - John Truesdale investigated and has proposed a temporary fix which will most likely be in the next tag. This + test runs to completion but fails in the comparison test with a regular CAM run. + +frankfurt/nag:all BFB except: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Sep 23 17:08:08 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Sep 23 17:15:03 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Sep 23 17:21:44 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Sep 23 17:31:52 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Sep 23 17:59:27 MDT 2013 +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Sep 23 18:09:20 MDT 2013 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Mon Sep 23 18:22:32 MDT 2013 + - Changes expected due to Tony's coupler changes + +frankfurt/pgi: all BFB except: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Sep 23 17:12:03 MDT 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Sep 23 17:21:52 MDT 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Sep 23 17:35:36 MDT 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Sep 23 17:55:59 MDT 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Sep 23 18:32:05 MDT 2013 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Sep 23 18:45:53 MDT 2013 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Mon Sep 23 18:52:03 MDT 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Sep 23 19:09:22 MDT 2013 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Mon Sep 23 19:16:29 MDT 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Mon Sep 23 19:19:22 MDT 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Mon Sep 23 19:26:45 MDT 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Mon Sep 23 19:46:08 MDT 2013 + - Changes expected due to Tony's coupler changes + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_12 +Originator(s): santos +Date: 2013/09/22 +One-line Summary: Fix radiation bug, change SE dycore to run with Pa. + +Purpose of changes: + + - Fix a bug in cloud_rad_props, which was rounding down in a table lookup +rather than interpolating between table values, due to declaring an integer +rather than a real as the interpolation weight. + + - Change the dycore to use units of Pa instead of hPa, to remove the need +for a conversion and prevent future bugs. + + - Fix minor precision issues, where complex numbers were constructed in +single precision when double was intended. + + - Add clarification to error message in modal_aer_opt. + +Bugs fixed (include bugzilla ID): + +#1794 - Interpolation in cloud_rad_props is less precise than originally + intended. +#1797 - CMPLX has wrong precision in several places + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Update HOMME external to use Pa instead of hPa. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Clarify that do_circulation_diags must be set to .true. for QBO + forcing to work in WACCM. + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/physics/cam/phys_prop.F90 + - Add explicit kind to calls of the intrinsic "cmplx", to ensure + that it returns a complex number with double-precision + components. + +M models/atm/cam/src/control/interpolate_data.F90 + - Add parameters corresponding to the extrap_method values, so + that callers can use named constants rather than bare ints. + +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +M models/atm/cam/src/dynamics/se/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 +M models/atm/cam/src/dynamics/se/inidat.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 + - Remove conversions to hPa (factors of 100._r8). + +M models/atm/cam/src/dynamics/se/spmd_dyn.F90 + - Remove unnecessary use statement. + +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - Very slightly reduce the max value of lambda_c so that it will + always fall within the limits of the table in RRTMG. + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - Clarify error message for unreasonable optical depth, and abort + when optical depth is negative. + - Make calls to cmplx return double precision values. + +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 + - Use lininterp to do interpolation of lookup tables, instead of + using (buggy) custom code. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Sep 17 21:30:18 MDT 2013 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Sep 17 21:41:45 MDT 2013 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Sep 17 21:43:22 MDT 2013 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Sep 17 22:06:07 MDT 2013 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Sep 17 22:20:49 MDT 2013 +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Tue Sep 17 22:38:58 MDT 2013 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue Sep 17 22:56:00 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Sep 17 23:30:24 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Tue Sep 17 23:57:06 MDT 2013 +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Wed Sep 18 00:56:25 MDT 2013 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Wed Sep 18 01:18:00 MDT 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Wed Sep 18 01:21:15 MDT 2013 +084 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Wed Sep 18 01:42:23 MDT 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Wed Sep 18 02:01:53 MDT 2013 + +frankfurt/nag: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Sep 17 15:03:31 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Sep 17 15:10:17 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Sep 17 15:17:04 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Sep 17 15:27:32 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Sep 17 15:52:56 MDT 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Tue Sep 17 16:05:17 MDT 2013 + +frankfurt/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Sep 17 15:07:17 MDT 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Sep 17 15:16:57 MDT 2013 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Sep 17 15:23:06 MDT 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Sep 17 15:30:41 MDT 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Sep 17 15:47:50 MDT 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Sep 17 16:22:59 MDT 2013 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Tue Sep 17 16:48:32 MDT 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Sep 17 16:59:13 MDT 2013 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Tue Sep 17 17:06:27 MDT 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Tue Sep 17 17:09:30 MDT 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Tue Sep 17 17:16:29 MDT 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Tue Sep 17 17:36:04 MDT 2013 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Tue Sep 17 18:14:35 MDT 2013 + + CAM-5 changes answers due to bug fixes, CAM-SE due to units change. This +accounts for all failed baselines. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + All CAM-SE cases, and all CAM5 (specifically due to RRTMG, MG, and MAM + changes). + +- what platforms/compilers: + + All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + The pressure unit change and the cmplx changes are at or below single + precision roundoff. RRTMG is larger than roundoff and climate changing. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + +https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/ + santos_answer_changes_tags/santos_answer_changes_n01_cam5_3_08 + +- platform/compilers: + + yellowstone/intel + +- configure commandline: + + Default FC5 ne30_ne30 run. + +- build-namelist command (or complete namelist): + + Default FC5 ne30_ne30 run. + +- MSS location of output: + + /CCSM/csm/f.e13.FC5.ne30_ne30.test2ans.002 + +MSS location of control simulations used to validate new climate: + + /CCSM/csm/f.e13.FC5.ne30_ne30.ctl_ans.001 + +URL for AMWG diagnostics output used to validate new climate: + +Comparison of an earlier version with the RRTMG bug fix to control: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.ne30_ne30.test2ans.001/atm/ + f.e13.FC5.ne30_ne30.test2ans.001-f.e13.FC5.ne30_ne30.ctl_ans.001/ + +Comparison of this tag to the earlier version mentioned above: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.ne30_ne30.test2ans.002/atm/ + f.e13.FC5.ne30_ne30.test2ans.002-f.e13.FC5.ne30_ne30.test2ans.001/ + +Comparison of this tag to observations: + +http://webext.cgd.ucar.edu/FCLIMO/f.e13.FC5.ne30_ne30.test2ans.002/atm/ + f.e13.FC5.ne30_ne30.test2ans.002-obs/ + +=============================================================== +=============================================================== + +Tag name: cam5_3_11 +Originator(s): cacraig +Date: 9/17/13 +One-line Summary: Corrected SVN_EXTERNAL_DIRECTORIES to match cam5_3_09 version + +Purpose of changes: +- Corrected the SVN_EXTERNAL_DIRECTORIES file which inadvertently was checked in with an older version + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +frankfurt/nag:all BFB + +frankfurt/pgi: all BFB + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_10 +Originator(s): tcraig, cacraig +Date: 9/06/13 +One-line Summary: Tony's coupler changes + +Purpose of changes: +- CAM trunk tag for merge of https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/cplupa_tags/cplupa_n01_cam5_3_09 + From Tony's notes: + - modify intents on init/run/finalize coupling interfaces + - add ifdef USE_ESMF_METADATA arouind esmf attribute calls + - modify mkatmsrffile.F90 to account fo changes in shr_mct_sMatPInitnc interface +- Removed all mergeinfo files except the root + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, andrew + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/tools/mkatmsrffile/mkatmsrffile.F90 +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/doc/ChangeLog +M models/atm/cam/src/utils/cam_dom/cpl_mct/ocn_comp_mct.F90 +M models/atm/cam/src/utils/cam_aqua/cpl_mct/ocn_comp_mct.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +M SVN_EXTERNAL_DIRECTORIES + - merge to Tony's cplupa branch + +property 'svn:mergeinfo' deleted from 'models/atm/cam'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/test/system/tests_pretag_frankfurt_pgi'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/test/system/TCB_ccsm.sh'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/test/system/tests_posttag_frankfurt'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/configure'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/Makefile.in'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/config_files/definition.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/namelist_definition.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/use_cases/soa_chem_megan_emis.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_moz_mam3.xml'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/bld/build-namelist'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/control/camsrfexch.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/cpl_share/cam_cpl_indices.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/cpl_mct/atm_comp_mct.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/comsrf.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/micro_mg_cam.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/wv_sat_methods.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/micro_mg1_0.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/microp_driver.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/wv_saturation.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/cam/uwshcu.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/physics/rrtmg/radsw.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/dynamics/se/dp_coupling.F90'. +property 'svn:mergeinfo' deleted from 'models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90'. + - files which had mergeinfo removed + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +frankfurt/nag:all BFB + +frankfurt/pgi: all BFB except +060 sm991 TSM_ccsm.sh f19_f19 F 2d ........................................FAIL! rc= 6 at Thu Sep 5 18:11:33 MDT 2013 +061 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 4 at Thu Sep 5 18:11:33 MDT 2013 + +Jay agreed that it made sense to check in cam5_3_10 with this failure and discover the solution during CESM testing + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_09 +Originator(s): cacraig +Date: 8/30/13 +One-line Summary: minor microphysics rearrangement and cleanup + +Purpose of changes: +- Moved calculation of in-cloud water values for radiation into cloud_diagnostics +- Moved calls for micro_mg_tend back to inline instead of being contained at end of module +- Simplified the calling list for conv_water_4rad +- Moved a handful pbuf_add_field, outfld and addfld calls to modules where data is being set +- Renamed pbuf_times to dyn_time_lvls and itim to itim_old. These values should only be + used for leap-frogging times. +- cmeliq is now a member of pbuf and not passed on calling lists +- Removed effi, effc, effc_fn, effliq, effice and effliq_fn variables as they were exact copies + of rei, rel and rel_fn and were redundant inside micro_mg_cam.F90 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, andrew + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/control/cam_history.F90 + - added trim to string for calendar + +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 + - Contains the conv_rad_4rad call and associated calculations for radiation using mg physics + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Moved in-cloud water calculations which are specific for radiation to cloud_diagnostics + - Moved calls for micro_mg_tend back to inline instead of being contained at end of module + - Moved a number of pbuf_add_field and addfld calls to modules where data is being set + - Removed effi, effc, effc_fn, effliq, effice and effliq_fn variables as they were exact copies + of rei, rel and rel_fn and were redundant + +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 + - cmeliq is now added to pbuf + +M models/atm/cam/src/physics/cam/conv_water.F90 + - simplified calling list for conv_water_4rad + - addfld calls moved from micro_mg_cam + +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 + - pbuf_add_field, addfld and outfld call(s) moved from micro_mg_cam + + +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/flux_avg.F90 +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/radiation_data.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +M models/atm/cam/src/physics/rrtmg/oldcloud.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/slingo.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - Rename of pbuf_times to dyn_time_lvls and itim to itim_old + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all BFB + +frankfurt/nag:all BFB (mc111 failed on first try due to mangled log file due to multiprocessing) Passed on second try + +frankfurt/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Inside micro_mg_cam: calculation of tgliqwp now uses iclwpst instead of iclwp. This changes answers for + the diagnostic variables APRL, PE and PEFRAC. No regression tests show any changes. + + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_08 +Originator(s): santos +Date: 2013/08/29 +One-line Summary: Fix NAG, CESM scripts with Frankfurt/PGI, serial CAM-SE + +Purpose of changes: + + - Fix the NAG port, since the RRTMG changes were temporarily reverted to + fix a bug on big-endian systems (e.g. Mira). + + - Pull in an updated Machines tag so that the CESM scripts can run with + PGI on Frankfurt. + + - Have CAM tests use PGI 13.7 on Frankfurt, and change compiler flags, to + match the new Machines tag. + + - Fix HOMME when SPMD is not defined, so that it will work with + mpi-serial. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + - The "-Mvect=nosse" option is no longer used for PGI, because SSE + vectorization has been safe for a while now, and because Machines has + made the same change. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - New Machines tag with Frankfurt/PGI update. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - New COSP and RRTMG tags, compatible with NAG, and with a + big-endian system fix. + +M models/atm/cam/bld/Makefile.in + - Remove -Mvect=nosse option from PGI builds. + +M models/atm/cam/src/control/runtime_opts.F90 + - Fix spelling error in abort message. + +M models/atm/cam/src/dynamics/se/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/native_mapping.F90 +M models/atm/cam/src/dynamics/se/pmgrid.F90 + - Fix the SE dycore when SPMD is not defined (mpi-serial). + - Add "implicit none" to pmgrid, since "iam" and "masterproc" + were getting implicit types. + +M models/atm/cam/test/system/TCB_ccsm.sh + - Put the CESM build in a directory called "bld", following + convention. + +M models/atm/cam/test/system/test_driver.sh + - Change the version of PGI used on Frankfurt to 13.7. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS. + +frankfurt/nag: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +For NAG only, change + +Summarize any changes to answers, i.e., +- what code configurations: + + CAM standalone builds only. + +- what platforms/compilers: + + PGI, only with optimization on. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Roundoff. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + The difference is due to a compiler optimization change, which should be + no worse than roundoff. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_07 +Originator(s): fischer, fvitt +Date: Mon Aug 5 15:10:54 MDT 2013 +One-line Summary: flbc_list namelist logic update, rrtmg reverted for mira + +Purpose of changes: +. SVN external updates + - Reverted rrtmg tag to previous tag due to a big endian bug caused by + a fix to get the NAG compiler to work. This was causing large errors in + the energy balance. + - Updated homme external to fix threading issues on bluegene systems + - Updated component tags to match cesm1_3_beta01 +. Update to how flbc_list is set in namelist +. Added new scenario_ghg called CHEM_LBC_FILE to indicate when values are being + set from flbc_file. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. Update homme, and reverted rrtmg tag + +M SVN_EXTERNAL_DIRECTORIES +. Updated externals to match cesm1_3_beta01 + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +. Removed flbc_list since this is the default being set in build-namelist + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/src/physics/cam/chem_surfvals.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 +. Updates to the way flbc_list is being handled + Added new scenario_ghg called CHEM_LBC_FILE + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all passed + +frankfurt/nag: +001 sm111 TSM.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 8 at Fri Aug 2 11:56:12 MDT 2013 +002 er111 TER.sh e8c5t5mdm ttrac 4+5s .....................................FAIL! rc= 5 at Fri Aug 2 11:56:12 MDT 2013 +003 br111 TBR.sh e8c5t5mdm ttrac 6+3s .....................................FAIL! rc= 5 at Fri Aug 2 11:58:17 MDT 2013 +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 4 at Fri Aug 2 11:58:17 MDT 2013 +005 mc111 TMC.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 4 at Fri Aug 2 11:58:17 MDT 2013 +006 dd111 TDD.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 4 at Fri Aug 2 11:58:17 MDT 2013 +007 sm112 TSM.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 8 at Fri Aug 2 12:03:02 MDT 2013 +008 er112 TER.sh e8c5dm ghgrmp 4+5s .......................................FAIL! rc= 5 at Fri Aug 2 12:03:02 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 4 at Fri Aug 2 12:03:02 MDT 2013 +010 sm114 TSM.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 8 at Fri Aug 2 12:05:18 MDT 2013 +011 er114 TER.sh e8c5dm co2rmp 4+5s .......................................FAIL! rc= 5 at Fri Aug 2 12:05:18 MDT 2013 +012 br114 TBR.sh e8c5dm co2rmp 6+3s .......................................FAIL! rc= 5 at Fri Aug 2 12:07:30 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 4 at Fri Aug 2 12:07:30 MDT 2013 +014 sm311 TSM.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 8 at Fri Aug 2 12:12:34 MDT 2013 +015 er311 TER.sh f10c5t5mdm ttrac 4+5s ....................................FAIL! rc= 5 at Fri Aug 2 12:12:34 MDT 2013 +016 br311 TBR.sh f10c5t5mdm ttrac 6+3s ....................................FAIL! rc= 5 at Fri Aug 2 12:15:18 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 4 at Fri Aug 2 12:15:19 MDT 2013 +018 mc311 TMC.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 4 at Fri Aug 2 12:15:19 MDT 2013 +019 eq301 TEQ.sh f10c5t5mdm ttrac f10c5t5mdm ttrac_lb1 4s .................FAIL! rc= 4 at Fri Aug 2 12:17:47 MDT 2013 +020 eq302 TEQ.sh f10c5t5mdm ttrac f10c5t5mdm ttrac_lb2 4s .................FAIL! rc= 4 at Fri Aug 2 12:17:47 MDT 2013 +021 eq303 TEQ.sh f10c5t5mdm ttrac f10c5t5mdm ttrac_lb3 4s .................FAIL! rc= 4 at Fri Aug 2 12:17:48 MDT 2013 +022 eq304 TEQ.sh f10c5t5mdm ttrac f10c5dm no_ttrac 4s .....................FAIL! rc= 4 at Fri Aug 2 12:17:48 MDT 2013 +023 sm312 TSM.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 8 at Fri Aug 2 12:23:00 MDT 2013 +024 er312 TER.sh f2.5c5dm ghgrmp 4+5s .....................................FAIL! rc= 5 at Fri Aug 2 12:23:01 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 4 at Fri Aug 2 12:23:01 MDT 2013 +031 sm316 TSM.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 8 at Fri Aug 2 12:35:53 MDT 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 4 at Fri Aug 2 12:35:53 MDT 2013 +036 sc003 TSM.sh scmc5armiop scmarm 7s ....................................FAIL! rc= 8 at Fri Aug 2 12:50:32 MDT 2013 +. cam5 tests are expected to fail because the rrtmg external was reverted to an earlier version that has an overflow + error that NAG catches. + +frankfurt/pgi: +060 sm991 TSM_ccsm.sh f19_f19 F 2d ........................................FAIL! rc= 6 at Fri Aug 2 16:32:14 MDT 2013 +061 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 4 at Fri Aug 2 16:32:14 MDT 2013 +. expected, CESM scripts are not working with current setup on frankfurt + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_06 +Originator(s): santos, fischer +Date: 2013/07/21 +One-line Summary: Gravity wave refactoring, remove WACCM_PHYS CPP macro. + +Purpose of changes: + + - Remove WACCM_PHYS CPP macro (and the equivalent "do_waccm_phys" + function) in favor of more specific physics options. + + - Merge CAM and WACCM gravity wave modules and split the result into + smaller, mostly portable modules. + + - Make WACCM modules read their own namelists. + + - Move uzm and frontgf/frontga from physics_state to the physics buffer, + since they are not treated the same as other physics_state variables and + introduce unnecessary complication into physics_types. + + - Remove Lahey support, since new code in this tag uses Fortran 2003 + features. + +Bugs fixed (include bugzilla ID): + + - Due to a unit mismatch between CAM and HOMME, WACCM-SE was using a + frontogenesis function that was ~14x too large. + + - Fix some namelist values in 1850_cam5_pm.xml that had yellowstone paths + hard-coded (h/t Chris Fischer). + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - New history_waccm flag, for turning on common outputs for WACCM runs. + Implementation of this flag is incomplete and should be considered a + work in progress. + + - Three new namelist variables, use_gw_oro, use_gw_front, and + use_gw_convect, are provided to turn on the three types of gravity wave + sources currently used in CAM and WACCM. + + - Several previously hard-coded parameters were added to gw_drag_nl. + + - New namelist variables "do_molec_press" and "molec_diff_bot_press" + determine whether molecular diffusion is on, and the bottom level where + it will take place, respectively. + + - Existing namelist variables have been moved from cam_inparm to qbo_nl, + radheat_nl, and iondrag_nl. + + - New namelist settings for WACCM-SE with vertically Lagrangian advection. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/test/system/tests_pretag_frankfurt_lahey + - Lahey support dropped. (Current NAG test list is identical.) + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/qbo.F90 + - Stub version of QBO module. + +A models/atm/cam/src/physics/cam/vdiff_lu_solver.F90 + - Contains vd_lu_decomp and vd_lu_solve, so this code can be + shared rather than duplicated between diffusion_solver and + gw_drag. These are also modified so that the output of + vd_lu_decomp is contained in an object of type "lu_decomp", + which can then be fed back to vd_lu_solver directly. + +A models/atm/cam/test/system/config_files/h30c4wgdm +A models/atm/cam/test/system/config_files/wg4c4dm +A models/atm/cam/test/system/nl_files/outfrq3s_wse + - Files to test SC-WACCM-SE, and SC-WACCM's use_case. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Add history_waccm namelist option. + - Add new molecular diffusion pressures to namelist. + - Add new gw_drag namelist variables. + - Move namelist variables out of cam_inparm. + - Modify SC-WACCM-SE settings (experimental settings for + vertically Lagrangian advection). + +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5_pm.xml + - Remove hard-coded glade paths. + +M models/atm/cam/doc/ChangeLog_template +M models/atm/cam/test/system/archive_baseline.sh +M models/atm/cam/test/system/gen_test_table.sh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/configure +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm +M models/atm/cam/src/physics/cam/phys_grid.F90 + - Remove Lahey support. + - Remove some workarounds for and mentions of Lahey. + +M models/atm/cam/src/control/runtime_opts.F90 + - Have qbo, radheat, and iondrag read their own namelists. + - Call waccm_forcing_readnl from within radheat_readnl. + +M models/atm/cam/src/control/sat_hist.F90 + - Use global save statement instead of saving an individual + variable. + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +M models/atm/cam/src/dynamics/se/dyn_comp.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 + - Set WACCM variables in the physics buffer rather than + physics_state. + - Replace "do_waccm_phys" with flags specific to the qbo and + gw_drag modules. + - Sometimes frontgf was handled before frontga, and sometimes vice + versa. This made it too easy to mix them up, so move frontgf + before frontga in all these cases. + - Fix bug where WACCM-SE was using a too-large frontogenesis + function. + +M models/atm/cam/src/physics/cam/convect_deep.F90 + - Remove do_waccm_phys in favor of querying for presence of pbuf + field. + - Change name of "ZMDT" to "TTEND_DP" in the physics buffer. + +M models/atm/cam/src/physics/cam/diffusion_solver.F90 + - Pull LU solver routines out into the portable module named + vdiff_lu_solver. This is the only dependency of + diffusion_solver, so it is effectively portable in that sense. + Portability is still limited by the fact that it must be passed + routines with very specific interfaces for molecular diffusion. + - Update interfaces for compute_molec_diff and the vd_lu_* + routines. + +M models/atm/cam/src/physics/cam/iondrag.F90 + - Harmonize stub module with WACCM version and make calls to its + routines non-fatal (so we don't need WACCM_PHYS to determine + whether or not to call it). + +M models/atm/cam/src/physics/cam/molec_diff.F90 +M models/atm/cam/src/physics/cam/ref_pres.F90 + - Have ref_pres find molecular diffusion levels, rather than + molec_diff. + - Change the way ref_pres calculates levels, to guarantee that a + "top" level is not too high and a "bottom" level is not too low. + - Return information about the interpretation of kvt from + compute_molec_diff, so that diffusion_solver no longer has to + use "waccmx_is". + - Use the new lu_decomp type for compatibility with + vdiff_lu_solver. + +M models/atm/cam/src/physics/cam/phys_control.F90 + - Add WACCM history flag. + - Add use_gw_* flags to specify which gravity wave sources are on. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Remove uzm, frontgf, and frontga from physics_state objects. + - Allow ZM to use a different name from convect_deep. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Since exbdrift is only used directly by iondrag, move the call + to exbdrift_register into iondrag as well. + - Change gw_drag interfaces. + - Remove "#ifdef WACCM_PHYS" statements. + - Pass pbuf to qbo_relax, since UZM is now in pbuf. + - Call WACCM physics routines in the same order throughout. + +M models/atm/cam/src/physics/cam/radheat.F90 + - Add stub namelist read to replace defaultopts and setopts. + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Don't advertise gravity wave drag as "coming soon" in the + comments. + - Use a utility function in ref_pres to set ntop_eddy. + - Use history_waccm to switch on add_default calls. + - Account for changes in molec_diff and diffusion_solver + interfaces. + +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - Change ptend%name from "convect_deep" to "zm_conv_tend". + +M models/atm/cam/src/physics/waccm/iondrag.F90 + - Have iondrag handle its own namelist. + - Move in register logic from physpkg. + +M models/atm/cam/src/physics/waccm/qbo.F90 + - Have qbo handle its own namelist. + - Get uzm from physics buffer. + +M models/atm/cam/src/physics/waccm/radheat.F90 + - Have radheat handle its own namelist. + - radheat calls waccm_forcing_readnl. + +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 + - Change null filename (no effect, done just to be consistent with + QBO). + +M models/atm/cam/src/physics/waccmx/majorsp_diffusion.F90 + - Get molecular diffusion levels from ref_pres, not molec_diff. + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - Fix spelling error. + +M models/atm/cam/test/system/input_tests_master + - Add tests for WACCM-SE and tests that exercise the + waccm_sc_2000_cam4 use_case. + +M models/atm/cam/test/system/CAM_compare.sh + - Fix bug where fields with small differences would not be printed + to the log after a comparison failure. + +M models/atm/cam/test/system/TCB_ccsm.sh + - Allow compiler names to be specified as part of machine names + (e.g. "frankfurt_nag"). + - Turn repetitive blocks into loops. + +M models/atm/cam/test/system/input_tests_master + - Add SC-WACCM tests, including with the SE dycore. + +M models/atm/cam/test/system/test_driver.sh + - Change walltime limit on Frankfurt so that setting + CAM_BATCHQ="short" will work. + - Remove Lahey section. + +Changes to the gravity waves: + +M models/atm/cam/src/physics/cam/gw_drag.F90 +D models/atm/cam/src/physics/waccm/gw_drag.F90 +A models/atm/cam/src/physics/cam/gw_common.F90 +A models/atm/cam/src/physics/cam/gw_convect.F90 +A models/atm/cam/src/physics/cam/gw_diffusion.F90 +A models/atm/cam/src/physics/cam/gw_front.F90 +A models/atm/cam/src/physics/cam/gw_oro.F90 +A models/atm/cam/src/physics/cam/gw_utils.F90 + +Highlights of the refactoring: + + - Merge WACCM and CAM modules. + + - Use history_waccm to switch on add_default calls. + + - Eliminate dead code, including an old spectral wave source from CAM's + version of gw_drag and a buggy implementation of low level stress + divergence. + + - Set previously hard-coded parameters via namelist. + + - Change names of gw_inti and gw_intr to gw_init and gw_tend. + + - Move the gravity wave source routines into separate modules + (gw_convect, gw_front, and gw_oro), which are turned on or off via + the phys_control namelist. + + - Homogenize and simplify code for the three gravity wave sources, + to simplify the process of adding new sources in the future. + + - Separate addfld/outfld calls from other code, and move gravity + wave drag profile routines into a portable layer (gw_common). + + - Separate diffusion routines into a separate module from + gw_common, called gw_diffusion, using the new vdiff_lu_solver + module to share code with diffusion_solver. + + - Create a module for common vector operations (gw_utils). + + - Fix UTGWORO, VTGWORO, and TTGWORO to more accurately reflect the + wind and temperature tendencies from orographic gravity waves. + + - Use cpairv rather than cpair (for consistency in WACCM-X). + + - Reorder loops to access memory in order and contiguously, and + only calculate the LU decomposition once for diffusion due to + gravity wave breaking, as diffusion_solver already does. These + two optimizations reduce the total cost of spectral gravity + waves by >40% (Yellowstone/ifort). Most of this gain is due to + loop reordering, but it's unclear how much of the benefit was + due to vectorization vs. more efficient cache use. In loops where the + level bounds varied by column for the Beres scheme, this was handled + mostly by masking assignments (where statements). + + - Change most arrays from size pcols to size ncol. This cleans up + the code slightly because array operations no longer need an + explicit bound (e.g. "src_level(:ncol)"), but there was no + significant effect on computation time. + + - Purely orographic waves have taken a performance hit (roughly double + the cost), but still only represent about 0.1% of the total cost of + CAM5. This cost seems to be primarily the result of changes to + gw_drag_prof, which needs more per-column level indices for the Beres + scheme. + + - Miscellaneous cleanup, e.g. limiting lines to <=80 characters, and + re-ordering arguments in interfaces. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Sun Jul 21 14:24:03 MDT 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Sun Jul 21 16:35:21 MDT 2013 + +Changes to diagnostic output only, as UTGWORO and VTGWORO have been fixed +to match the actual wind tendencies from orographic gravity waves. + +frankfurt/nag: + +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Sun Jul 21 12:55:40 MDT 2013 + +frankfurt/pgi or jaguar/pgi: + +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Sun Jul 21 13:44:29 MDT 2013 +060 sm991 TSM_ccsm.sh f19_f19 F 2d ........................................FAIL! rc= 6 at Sun Jul 21 15:34:49 MDT 2013 +061 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 4 at Sun Jul 21 15:34:49 MDT 2013 + +The bl314 tests failed because the old files used for WACCM at 10x15 have a +different vertical grid, and so some pressure limiters are now rounded to +a different level due to changes in ref_pres. This has no impact on current +WACCM cases. + +The CESM tests on Frankfurt failed because of machine issues that have +temporarily broken the CESM port. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: WACCM +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + - For WACCM-FV, larger than roundoff changes for diagnostic output only + (UTGWORO and VTGWORO). The climate and all other diagnostics should be + bit-for-bit. + + - For WACCM-SE, a climate-changing bug fix for the frontogenesis + function. + + - Some old WACCM files, such as the default for 10x15 resolution, use + different pressure levels than more current files. The tropospheric + cloud physics top level was changed for these cases due to the change + in ref_pres. This showed up in SC-WACCM testing but does not affect + current, supported WACCM cases, as demonstrated by a test of SC-WACCM + on FV at a resolution of 4x5 degrees. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_05 +Originator(s): fischer, cacraig, santos +Date: Tue Jul 2nd, 2013 +One-line Summary: COSP build fix for CESM, CLUBB threading fix, + namelist updates + +Purpose of changes: +. The COSP build was broken when using cesm scripts with the latest + cesm tags. This is now fixed. + +. CLUBB was giving different answers when the number of threads are + changed. This is mostly fixed, except for when clubb_history is true. + When clubb_history is true and the number of threads is > 1, then + build-namelist exits with an error message. + +. Namelist updates for flbc_file and bndtvs. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. configure was refactored so cesm scripts build COSP in a separate library + the same way cam stand alone does. cosp_libdir is a new option for configure, + this is the directory the COSP library will be built. + +Describe any changes made to the namelist: +. Updates for bndtvs and flbc_file + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/nl_files/outfrq3s_clubb +. Removed clubb_history from clubb test. + +M models/atm/cam/test/system/input_tests_master +. Turned on threading for clubb test. + +M models/atm/cam/bld/cam.buildnml.csh +. Pass cosp_libdir when configure is invoked. + +M models/atm/cam/bld/configure +. Check for CLUBB threading was removed. +. cosp_libdir is a new variable that can be passed into configure +. Refactored so cesm scripts build COSP in a separate library the + same way cam stand alone does. + +M models/atm/cam/bld/Makefile.in +. Add -liomp5 for clubb threading. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Updated fpftcon and bndtvs files to match cesm. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. Fix documentation for COSP. + +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +. Updated bndtvs files + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/cam5_trop_strat_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_cam4_nuclear_winter.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +. Updated flbc_file (from santos) + +M models/atm/cam/bld/build-namelist +. Add an exit if threading and clubb_history is true. This combination isn't thread + safe. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. Update clubb external for threading fix + +M models/atm/cam/src/physics/cam/clubb_intr.F90 +. CLUBB threading and cmeliq fix. + +M models/atm/cam/src/physics/cam/physpkg.F90 +. Add cmeliq to call the clubb_tend_cam. + +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +. Fixes for CLUBB threading. + +M SVN_EXTERNAL_DIRECTORIES +. Updated machines tag to fix cosp cesm build. + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +043 bl366 TBL.sh f1.9c5clbdh outfrq3s_clubb 9s ............................FAIL! rc= 7 at Tue Jul 2 14:07:28 MDT 2013 +. New test + +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Jul 2 14:07:33 MDT 2013 +067 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Tue Jul 2 14:07:38 MDT 2013 +. New bndtvs files change answers + +frankfurt/lf95: all passed + +frankfurt/nag: all passed + +frankfurt/pgi: all passed + +=============================================================== +=============================================================== + +Tag name: cam5_3_04 +Originator(s): santos, cbardeen, jedwards, pel, goldy +Date: 2013/06/11 +One-line Summary: Answer-changing fixes and cleanup, NAG port fixes + +Purpose of changes: + + Fix a bug that caused cases with interactive chemistry involving the CLY + and BRY families to crash within a few years. + + Fix a race condition when using WACCM-SE with threading. + + Collect answer-changing code cleanup in one tag: + + - Remove references to "nonintrinsic" functions, which were + provided only to preserve answers during the NAG port. Unit + tests have verified that nonintrinsic and intrinsic versions + of these functions match to within roundoff error in most cases + (the exceptions involve large arguments to the gamma function, + which are not needed by CAM, or gfortran, which has a less + accurate library). + + - Remove a switch in pkg_cldoptics that caused a pointless + difference between WACCM and CAM cases (the do_waccm_phys switch + and the WACCM_PHYS macro will likely be removed entirely soon). + + - Change hard-coded physical constants in chemistry to use + physconst (directly, or through mo_constants). + + - Remove dead code and change r4 to r8 in modal_aero_coag. + + Fix regressions with the NAG port and get it working out of the box. + + More bug fixes from various sources: + - Fix broken Darwin build (from Chuck Bardeen). + - Fix multi-instance CAM-SE (from Jim Edwards). + - Fix for topo_tool (from Peter Lauritzen). + - Correct physics_buffer abort messages (from Steve Goldhaber). + + Update externals to make the above possible: + + - csm_share: Fix for shr_spfn_gamma on Intel. + - CLM: NAG port tag. + - MCT: Fixes for NAG port, Darwin build, and Intel bounds-checking. + These fixes have not been put into a released version of MCT + yet, so for now CAM is using an MCT branch as its external. + + Some externals updated to try to avoid CLM compatibility issues: + + - RTM + - scripts + - Machines + +Bugs fixed (include bugzilla ID): + + - 1729: WACCM (and possibly strat chem) crashes within a few years + - 1744: WACCM-SE sometimes fails due to race condition with threading + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton, most chemistry changes reviewed by fvitt + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update csm_share, CLM, and MCT. + +M models/atm/cam/bld/Makefile.in + - Fix the COSP build on Darwin. + - Remove some OpenMP/NAG flags, as OpenMP is not ready yet. + +M models/atm/cam/bld/configure + - Fix the setting of rpath on Darwin; Darwin's ld will accept + "-rpath /foo" but not "-rpath=foo". + +M models/atm/cam/bld/build-namelist + - Fix setting of srf_emis_cycle_yr for super_fast_llnl_mam3, + waccm_mozart_mam3, and trop_mam7. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 + - Remove dead code. + - Change r4 declarations to r8. + - Get physical constants from physconst. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/mozart/mo_airglow.F90 +M models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + - Get physical constants from from physconst and mo_constants. + (E.g. R_gas, Avogadro's number, Boltzmann's constant...) + - Remove definitions of constants that are never used. + - Fix line over 132 characters in mz_aerosols_intr.F90. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/ndrop_bam.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 + - Replace "nonintrinsic" versions of special functions with + the regular versions (which allow shr_spfn_mod to decide if a + Fortran 2008 intrinsic is available). + +M models/atm/cam/src/chemistry/utils/mo_constants.F90 + - Add more constants with different units needed by the chemistry. + - Explicitly call out cgs units by naming them with a "_cgs" + suffix. + +M models/atm/cam/src/control/cam_history_support.F90 + - Resolve ambiguity between check_hist_coord_all and + check_hist_coord_char by making the "vlen" argument mandatory + for check_hist_coord_all. + +M models/atm/cam/src/control/physconst.F90 + - Add molecular weight for NH4. + +M models/atm/cam/doc/ChangeLog_template + - Add NAG to compilers used to run tests. + +M models/atm/cam/src/dynamics/se/dyn_comp.F90 + - Fix multi-instance CAM-SE by only calling write_grid_mapping + from one index. + +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 + - Fix race condition that caused a crash on Intel with DEBUG + on. + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - Correct endrun messages that mentioned pbuf_get_field but were + actually in pbuf_set_field. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Fix bug where clybry_fam_adj would crash when given negative + constituent concentrations, by calling qneg3 beforehand. + +M models/atm/cam/src/physics/cam/pkg_cldoptics.F90 + - Remove unnecessary truncation of a table when do_waccm_phys() + is .false. + +M models/atm/cam/test/system/TCB_ccsm.sh +M models/atm/cam/test/system/test_driver.sh + - Use a CCSM_MPILIB as well as CCSM_MACH. This is a necessary step + for NAG to run CESM tests on frankfurt right now, since only + mpich is built there right now, but the CESM scripts choose + openmpi as the default MPI library. + - Define CCSM_MACH separately for all compilers on frankfurt + except Lahey. + - Correct the spelling of "edison" in edison's CCSM_MACH. + +M models/atm/cam/test/system/archive_baseline.sh + - Mention NAG in the help message. + +M models/atm/cam/tools/topo_tool/cube_to_target/cube_to_target.F90 +M models/atm/cam/tools/topo_tool/cube_to_target/remap.F90 + - Several fixes for topo_tool from Peter Lauritzen. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Mon Jun 10 17:51:45 MDT 2013 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Mon Jun 10 17:52:35 MDT 2013 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Jun 10 17:55:01 MDT 2013 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Jun 10 18:03:19 MDT 2013 +016 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Jun 10 18:04:42 MDT 2013 +020 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Mon Jun 10 18:09:12 MDT 2013 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Mon Jun 10 18:18:41 MDT 2013 +026 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Mon Jun 10 18:19:12 MDT 2013 +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Mon Jun 10 18:25:18 MDT 2013 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Jun 10 18:31:04 MDT 2013 +043 bl366 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ............................FAIL! rc= 7 at Mon Jun 10 18:46:32 MDT 2013 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Jun 10 18:59:17 MDT 2013 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Jun 10 19:24:26 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Jun 10 19:28:29 MDT 2013 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Mon Jun 10 19:35:24 MDT 2013 +058 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon Jun 10 19:42:59 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Mon Jun 10 19:52:41 MDT 2013 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s_mozEOOH+soa_chem_megan_emis 9s ......FAIL! rc= 7 at Mon Jun 10 20:11:34 MDT 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Mon Jun 10 20:40:06 MDT 2013 +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Mon Jun 10 21:06:26 MDT 2013 +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Mon Jun 10 21:09:21 MDT 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Mon Jun 10 21:47:38 MDT 2013 + +Expected failures due to various answer changes mentioned below. + +The following tests unexpectedly passed: + +067 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................PASS at Mon Jun 10 20:20:04 MDT 2013 +070 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................PASS at Mon Jun 10 20:22:31 MDT 2013 +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................PASS at Mon Jun 10 20:46:26 MDT 2013 +084 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................PASS at Mon Jun 10 21:30:11 MDT 2013 +087 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................PASS at Mon Jun 10 21:35:01 MDT 2013 + +These were expected to have answer changes due to the change in +pkg_cldoptics.F90. However, this change would only affect CAM3 and CAM4 +non-WACCM cases, and only if temperatures fell below 180K. The most likely +explanation for the fact that these baseline tests passed, is that +temperatures never fell below 180K during the test. + +frankfurt/lf95: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Jun 10 16:37:50 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Jun 10 17:17:27 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Jun 10 17:28:38 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Jun 10 18:17:02 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Jun 10 21:10:10 MDT 2013 +027 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Mon Jun 10 21:27:46 MDT 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon Jun 10 22:42:03 MDT 2013 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Mon Jun 10 23:15:21 MDT 2013 + +Expected failures due to various answer changes mentioned below. + +frankfurt/nag: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................SKIPPED* at Mon Jun 10 16:02:35 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................SKIPPED* at Mon Jun 10 16:10:17 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................SKIPPED* at Mon Jun 10 16:18:33 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................SKIPPED* at Mon Jun 10 16:30:08 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................SKIPPED* at Mon Jun 10 16:57:04 MDT 2013 +027 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................SKIPPED* at Mon Jun 10 16:59:36 MDT 2013 +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................SKIPPED* at Mon Jun 10 17:08:04 MDT 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................SKIPPED* at Mon Jun 10 17:10:54 MDT 2013 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................SKIPPED* at Mon Jun 10 17:24:24 MDT 2013 + +Baseline tests skipped because NAG is new (and baselines would be expected +to fail anyway). + +frankfurt/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Jun 10 16:26:49 MDT 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Jun 10 16:36:55 MDT 2013 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Jun 10 16:43:39 MDT 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Jun 10 16:51:32 MDT 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Jun 10 17:09:33 MDT 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Jun 10 17:45:32 MDT 2013 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Mon Jun 10 17:50:21 MDT 2013 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Mon Jun 10 18:05:47 MDT 2013 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon Jun 10 18:12:40 MDT 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Jun 10 18:24:04 MDT 2013 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Mon Jun 10 18:31:46 MDT 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Mon Jun 10 18:34:44 MDT 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Mon Jun 10 18:42:30 MDT 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Mon Jun 10 19:02:11 MDT 2013 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Mon Jun 10 19:43:20 MDT 2013 + +Expected failures due to various answer changes mentioned below. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + All cases with CAM3/4 physics that are not WACCM cases, all cases with + CAM5 physics, and all cases with active chemistry. The CARMA cirrus, + dust, and sea_salt models are also affected. + + Therefore, the only bit-for-bit cases will be those without typical CAM + physics (e.g. using ideal physics) and WACCM4 specified chemistry cases. + +- what platforms/compilers: + + All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Larger than roundoff but same climate, except that changes to use + statements for shr_spfn_mod may be roundoff-level for most compilers. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + For shr_spfn_mod changes, this was demonstrated during previous unit + tests of csm_share code. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_03 +Originator(s): Craig, Goldhaber +Date: +One-line Summary: Implementation of pbuf and history support for sub-columns + +Purpose of changes: +- Modifications to pbuf to support sub-columns +- Modifications to history to support sub-columns +- Bug fix to cosp history + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: +M models/atm/cam/src/control/cam_history_support.F90 +. register_history_mdim: Removed and replaced with add_hist_coord interface + +M models/atm/cam/src/physics/cam/cosp_share.F90 +. Removed file (merged into cospsimulator_intr.F90 as separate file no + longer needed for cam_history.F90 use). + +List all subroutines added and what they do: +M models/atm/cam/src/control/cam_history.F90 +. get_field_properties: Retrieve properties from CAM history field + This function needed to provide information to non-history code + needing to manipulate history data (e.g., subcol_outfld). + +M models/atm/cam/src/control/cam_history_support.F90 +. check_hist_coord interface consisting of routines to verify + consistency between data passed in an add_hist_coord or + add_vert_coord call and any data already residing in + hist_coords. This interface includes subroutines for each datatype + found in the hist_coord_t derived type. +. add_hist_coord interface consisting of the following two routines +. add_hist_coord_int: New routine for registering mdim and storing all + information relevant to an mdim when the dimension values are integral +. add_hist_coord_r8: New routine for registering mdim and storing all + information relevant to an mdim when the dimension values are real +. add_vert_coord: Routine for adding the vertical mdims (lev and ilev). +. write_hist_coord_att: Write the NetCDF attributes for a single hist coord +. write_hist_coord_atts: Write the NetCDF attributes for all hist coords +. write_hist_coord_var: Write the NetCDF data for a single hist coord +. write_hist_coord_vars: Write the netCDF data for all hist coords + + +M models/atm/cam/src/utils/grid_flag_utils.F90 +. Utilities to support grid flags + col_type - number from 0-31 - used to identify which type of field (currently: 0=grid, 1=sub-col) + grid_type - integer(bit_field_kind) which contains the appropriate fields turned on/off (internally each bit of + a grid_type flag indicates on/off status for each type of field) + + * clear_grid_types - clears all the flags from provided grid_types_flag + * is_col_type_set - returns true if requested col_type flag is set in provided grid_types_flag + * set_col_type - returns a grid_types integer with the requested col_type flag set + * add_col_type - adds the requested col_type to the provided grid_types_flag + * clear_col_type - clears the requested col_type fromthe provided grid_types_flag + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/control/cam_history.F90 +. Changes described in the subroutine sections +. Removed unused 'use' subroutines and unused variables +. Removed explicit output of vertical or 'mdim' coordinates. This + output is now handled in the add_hist_coord and add_vert_coord interfaces. +. Moved all register_hist_coord calls to 'owner' routines +. Moved all information about specific hist coords to 'owner' routines +. Added calls to support functions to write hist coord attributes and values + +M models/atm/cam/src/control/cam_history_support.F90 +. Changes described in the subroutine sections + +M models/atm/cam/src/control/ncdio_atm.F90 +. Added optional ncolnam input to infld_real_2dncol and to + infld_real_3dncol. This input allows infld to read a variable + defined on a different grid by specifying a name other than 'ncol'. + +M models/atm/cam/src/control/sat_hist.F90 +. Name change of hist_mdims to hist_coords. Also %value --> %dimsize + +M models/atm/cam/src/dynamics/eul/dp_coupling.F90 +. Now passing array subsection in geopotential_t call + +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 +. Moved hycoef_init call to before addfld calls (needed because + hycoef_init now defined 'lev' and 'ilev' dimensions). + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +. Now passing array subsection in geopotential_t call + +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. Whitespace cleanup + +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +. Now passing array subsection in geopotential_t call + +M models/atm/cam/src/dynamics/se/dyn_comp.F90 +. Removed redundant subroutine 'use' statement. + +M models/atm/cam/src/dynamics/se/dp_coupling.F90 +. Now passing array subsection in geopotential_t call + +M models/atm/cam/src/dynamics/sld/dyn_comp.F90 +. Moved hycoef_init call to before addfld calls (needed because + hycoef_init now defined 'lev' and 'ilev' dimensions). + +M models/atm/cam/src/physics/cam/check_energy.F90 +. Arrays in arguments are now assumed shape. Local arrays are now dimensioned state%ncol instead of pcols + +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +. Merged cosp_share.F90 into file. Made as many transferred variables + as possible private. +. Replaced register_hist_mdim calls with more self-contained add_hist_coord +. Replaced 'cosp_nhtml' mdim with 'lev' (change verified by Jen Kay). +. Made dimension units CF compilant (changes verified with Brian and + Jen Kay). + +M models/atm/cam/src/physics/cam/geopotential.F90 +. Arrays in arguments are now assumed shape. Local arrays are now dimensioned ncol instead of pcols + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in +. Added bfg_sc to buffer field +. pbuf_add_field - added optional grid_types_flag parameter which if present adds field(s) specified +. pbuf_get_field - added optional col_types parameter which if present specifies which col_type to + retrieve, otherwise grid field is returned +. pbuf_set_field - added optional grid_types_flag paramater which if present sets the field(s) specified, + otherwise set the grid field + +M models/atm/cam/src/physics/cam/radiation.F90 +. use change due to cosp_share module elimination + +M models/atm/cam/src/physics/rrtmg/radiation.F90 +. use change due to cosp_share module elimination + +M models/atm/cam/src/utils/buffer.F90 +M models/atm/cam/src/utils/buffer.F90.in +. Added buffer_field_is_alloc - checks the allocation status of buffer field passed in + +M models/atm/cam/src/utils/cam_pio_utils.F90 +. Name change of hist_mdims to hist_coords. Also %value --> %dimsize + +M models/atm/cam/src/utils/hycoef.F90 +. hyai, hyam, hybi, and hybm are now targets as they are stored as + pointers in the hist_coord_t type. +. level values for 'lev' and 'ilev' are stored as new module variables, + alev and ailev (also targets). +. hycoef_init now calls add_vert_coord for 'lev' and 'ilev'. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All Passed + +frankfurt/lf95: All Passed + +frankfurt/pgi: +044 bl317 TBL.sh f10c5cdm outfrq3s 9s: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +PGI with COSP test. mdim coordinate values and attributes were incorrect + in history file. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_3_02 +Originator(s): fischer, eaton +Date: Thu May 9 2013 +One-line Summary: Merge updates from cesm1_2_0 release branches + +Purpose of changes: + +. Merge updates from the release branch to match cesm1_2_0_n05_cam5_3_01. + Excluding the offline radiation driver. + +. Improve how CAM standalone build handles NetCDF. Improved error handling + for configure's use of the nf-config and nc-config scripts to determine + the link arguments. Also made mods to allow the user to *not* specify + NetCDF include file or library locations. This is useful for working + with compiler wrapper scripts that already have this information from the + system module settings (e.g., when using the mpif90 wrapper script on + yellowstone). + +. Swapped test 735 on frankfurt with 991 on yellowstone. Did this because + The TEQ_ccsm 991 test was failing due to different intel compiler versions + being used for cam stand alone, and cesm scripts. 735 was swapped because + it's run lenght was about the same as 991. In order to do this, the pes + layout for frankfurt had to be overridden in TCB_ccsm.sh, and CCSM_MACH + had to be set for frankfurt. + +. Other testing changes were turning on debugging for the WACCM-X post-tag + test on yellowstone, and add support for testing on edison. + +. Updates for testing and run script example for yellowstone to set OMP_STACKSIZE and remove + INC_NETCDF and LIB_NETCDF. + +. Fix units for aerosol, basically it is all variables with the name that contain "num". Units + were "kg/m2/s", should be " 1/m2/s" + +. #NO_MPI2 logic was removed, and MPI2 code was removed. The MPI2 all_gather calls were failing due + to a bug in MPI2. + +. SVN externals updated to match cesm1_2_beta08 + +Bugs fixed (include bugzilla ID): + +. OMP bug fixed for WACCM-X. + +. Memory leak fix for WACCM-SE. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +. New initial condition file for ne30np4 + +. New tunings for rsplit and se_split to allow 7.5 minute vertical remapping for ne120np4. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Fischer, Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_pretag_frankfurt_pgi +M models/atm/cam/test/system/tests_pretag_yellowstone +. Moved the 735 tests to yellowstone. Moved 991 from yellowstone to frankfurt + +M models/atm/cam/test/system/TCB_ccsm.sh +. Add the ability to run ccsm tests on frankfurt + +A models/atm/cam/test/system/config_files/wx1.9c4dh +. Created a WACCM-X debug test to be run posttag on yellowstone + +M models/atm/cam/test/system/test_driver.sh +. Add test support for edison. +. Set CCSM_MACH for frankfurt to allow ccsm tests to be run on frankfrut. +. Removed INC_NETCDF and LIB_NETCDF from yellowstone testing + +M models/atm/cam/test/system/input_tests_master +. Turned on debugging for the WACCM-X 399 tests. + +M models/atm/cam/test/system/CAM_runcmnd.sh +A models/atm/cam/test/system/tests_pretag_edison_intel +. Added support for edison testing + +M models/atm/cam/bld/configure +. Update how configure deals with the NetCDF library. + - Remove the default locations of /usr/local/include and /usr/local/lib. + The compiler wrapper scripts that are used on yellowstone supply this + information, so there's no reason for configure to supply a default + that's almost never correct. + - Remove the check that the netCDF header files and libraries exist. We + may not know where they are. + - Don't fail if .mod files not found + - If the netcdf lib path is specified, then attempt to get netcdf link + args from the nf-config or nc-config scripts. But if that fails then + set defaults based on the specified library path. + - Add a -rpath setting to the link args unless the nf-config or nc-config + scripts have already set info to be passed to linker (assuming the user + has provided netcdf lib path) + - Fix bug in test code (the create mode needed to be defined). +. removed some unused code + +M models/atm/cam/bld/Makefile.in +. Remove all setting of rpath for netcdf shared libs. This responsibility + has been moved to configure. +. Remove the -d option for mkDepends -- this was causing problems for the + configure tests +. Put code to append the MOD_NETCDF seach path inside conditional logic since it + may not be set. +. Need to set -DNO_C_SIZEOF to please latest PIO tag. + +M models/atm/cam/bld/config_files/definition.xml +. add nc_ldflags to save args used to link NetCDF libraries. + + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. New initial condition file for ne30np4 CAM5 +. Set all values of rsplit to 5, and set se_nsplit to 2 for ne120np4. This + allows 7.5 minute vertical remapping. + + +M models/atm/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml +. Renamed emis files from ar5 to RCP45 + +M models/atm/cam/bld/run-yellowstone.csh +. Removed LIB_NETCDF and INC_NETCDF +. Set OMP_STACKSIZE to 256M + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +. Fix units for aerosols. + +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 +. Fix memory leak for WACCM-SE + +M models/atm/cam/src/dynamics/se/dyn_grid.F90 +M models/atm/cam/src/utils/spmd_utils.F90 +. Removed #NO_MPI2 +. Removed MPI2 code because of a bug in the MPI2 libraries + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +. OMP bug fix, mmrSum_O_O2_H needed to be private. Changes answer for WACCM-X + +M SVN_EXTERNAL_DIRECTORIES +. Externals updated to match cesm1_2_beta08. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Tue May 7 18:43:36 MDT 2013 +051 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue May 7 19:42:06 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue May 7 19:46:08 MDT 2013 +055 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Tue May 7 19:52:59 MDT 2013 +058 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue May 7 20:00:27 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Tue May 7 20:10:01 MDT 2013 +063 bl440 TBL.sh fsoa1.9c4dh outfrq3s_mozEOOH+soa_chem_megan_emis 9s ......FAIL! rc= 7 at Tue May 7 20:28:58 MDT 2013 +067 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Tue May 7 20:37:23 MDT 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Tue May 7 20:57:22 MDT 2013 +. Answer changes from new clm tag + +079 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Tue May 7 21:23:56 MDT 2013 +. New test for yellowstone + +081 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Tue May 7 21:27:01 MDT 2013 +. Expected to fail because of new initial condition file + +frankfurt/lf95: All passed + +frankfurt/pgi: All passed + + +=============================================================== +=============================================================== + +Tag name: cam5_3_01 +Originator(s): santos cbardeen hannay +Date: Apr 25, 2013 +One-line Summary: Fixes for CAM-CHEM, WACCM, and CARMA issues (posttag tests). + +Purpose of changes: + + - Update driver and csm_share to fix some SCAM cases. (Also brings in a + driver fix for NAG builds.) + + - Get CARMA working with debug flags turned on (Lahey, PGI, Intel). + + - Restore WACCM-X hydrogen limiters for calls of physics_update where + hydrogen (atomic and molecular) is not being modified directly via + ptend. + + - Fix issues with WACCM and CAM-CHEM debug cases. + + - Fix from Chuck Bardeen for meteor_smoke and pmc CARMA models with + specified dynamics cases. + + - Fix from Cecile Hannay for the units of NUMLIQ and NUMICE. + +Bugs fixed (include bugzilla ID): + + - SCAM cases that were over ocean, but not aquaplanet cases, were setting + lnd_present = .false., but not sno_present = .false. + - CARMA debug cases did not run. + - WACCM and some CAM-CHEM debug cases failed state_debug_check. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/namelist_files/use_cases/arm95_scam.xml + - Replaced by scam_arm95.xml, which was added in the previous tag. + +List all subroutines added and what they do: + +A models/atm/cam/test/system/config_files/f1.9c5carmdusdm + - CARMA dust model with debug flags enabled. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Pull in update to driver and csm_share with SCAM fix. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Pull in CARMA with fixes for DEBUG mode. + (See the CARMA log for details about these changes.) + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Output different units for mass mixing ratios and number + concentrations (CLDLIQ/CLDICE vs. NUMLIQ/NUMICE). + - Change units of "#" to the CF-compliant "1". + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - Split long lines to stay under 132 character limit. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Remove conditionals that caused an accidental answer change for + WACCM-X in cam5_2_21. In isolation, this change restores answers + that are bit-for-bit with cam5_2_20. However, WACCM-X will not + be bit-for-bit between this tag and any previous tag, because + of other changes affecting WACCM chemistry. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Move clybry_fam_adj call before QNEG3, so that QNEG3 enforces + the qmin limit on the result, and the subsequent call to + physics_state_check can pass. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - Use carma_do_thermo to prevent access of unallocated array in + the "CRTT" outfld call. + - The calls to "set_dry_to_wet" and "set_wet_to_dry" did not + respect qmin. For now, cause CARMA to operate on a temporary + copy of the state. CARMA does not deliberately modify the state; + it only produces a roundoff error due to these two conversions. + - Change ptend names to differentiate between CARMA tendencies + originating in different routines. + +M models/atm/cam/src/physics/carma/models/cirrus/carma_cloudfraction.F90 + - Remove unnecessary use of physics_ptend_init. + +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 + - Force internal calculations to use 365 day years, to deal with + mismatches between year lengths in CARMA and specified dynamics + files. + +M models/atm/cam/test/system/input_tests_master + - Change CARMA dust test to a debug test. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +036 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Wed Apr 24 19:04:38 MDT 2013 +073 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Wed Apr 24 21:18:15 MDT 2013 + +Expected small change due to moving clybry_fam_adj. + +084 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Wed Apr 24 21:53:28 MDT 2013 + +Expected failure due to mismatch between CESM compiler version and +yellowstone default. + +frankfurt/lf95: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +(There is a WACCM case on frankfurt, but it is specified chemistry, and + thus the baseline is not expected to fail.) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +WACCM and CAM-CHEM - Small (but above roundoff) change due to reordering + of clybry_fam_adj and qneg3. +CARMA - Change due to machine roundoff in divide/multiply that is no longer + executed on the shared physics_state object. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_3_00 +Originator(s): fischer, bsingh, eaton, hannay, jet, taylor +Date: Apr 23, 2013 +One-line Summary: Improve rad_diag calcs; add modal aerosol optics diagnostics + scam updates, SE bug fix + +Purpose of changes: +. Remove restriction that radiation diagnostic calculations reuse the water + uptake and wet radius values calculated for the climate affecting modes. + These quantities are now recomputed for the diagnostic modes. + +. Add new diagnostics for modal aerosol optics. + +. Make species burdens consistent with mode burdens, i.e., only include + contributions from daylight columns. + +. Add new IOP datasets, use cases, and run script for scam. Along with a + date bug fix for scam. + +. Minor bug fix and external update for SE from Taylor + +. Update svn externals to cesm1_2_beta06, except for pio tag. PIO has + an mpi-serial bug. + +. inic files moved back to homme from se. + +Bugs fixed (include bugzilla ID): + +. Fix bug in configure script for SE + + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. Added a new namelist variable, history_aero_optics, to add modal aerosol + optics diagnostics to the default history fields. The existing + history_aerosol variable turns on diagnostics related to the aerosol + production and removal tendencies. + + A models/atm/cam/bld/namelist_files/use_cases/scam_arm95.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_arm97.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_gateIII.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_twp06.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_togaII.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_sparticus.xml + A models/atm/cam/bld/namelist_files/use_cases/scam_mpace.xml + . New use cases for scam + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam/test/system/TBR.sh + M models/atm/cam/test/system/TER.sh + M models/atm/cam/test/system/TSM.sh + M models/atm/cam/bld/build-namelist + M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + M models/atm/cam/bld/namelist_files/namelist_definition.xml + M models/atm/cam/src/physics/cam/phys_control.F90 + . add namelist variable history_aero_optics + + M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + . add namelist variable history_aero_optics + . Move inic files back to homme from se. + + M models/atm/cam/bld/config_files/horiz_grid.xml + . add ncol values for se dycore -- this is only used by standalone builds + to provide info needed for the cice decomp + + M models/atm/cam/bld/configure + . change set_horiz_grid to use ncol from the horiz_grid.xml file rather + than nlon and nlat when dycore is SE. A little less confusing. + + M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 + . remove restriction that dry radius is being calculated for the modes + affecting the climate. The calculation for the diagnostic modes is + returned via an optional argument rather than put in the physics buffer. + + M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + . remove restriction that water uptake and wet radius are being calculated + for the modes affecting the climate. The calculations for the diagnostic + modes are returned via optional arguments rather than put in the physics + buffer. + + M models/atm/cam/src/physics/cam/aer_rad_props.F90 + . use history_aero_optics rather than history_aerosol to add default + diagnostics to the history output + + M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + . remove restriction that diagnostic calculations will reuse the water + uptake and wet radius values computed for the climate affecting modes. + . add diagnostic output + + M models/atm/cam/src/physics/rrtmg/radconstants.F90 + . add public parameters to identify nir and uv sw bands + + M models/atm/cam/src/physics/cam/radconstants.F90 + . add public parameters to identify nir and uv sw bands. This is only for + interface consistency; this version of radconstants shouldn't be used + when modal aerosols are in use. + + + M models/atm/cam/test/system/tests_pretag_yellowstone + M models/atm/cam/test/system/input_tests_master + A models/atm/cam/test/system/config_files/h30c5h + . New non aquaplanet SE test + + M models/atm/cam/bld/run-scam.csh + M models/atm/cam/src/dynamics/eul/iop.F90 + . Updates for scam from jet + + M models/atm/cam/bld/run-yellowstone.csh + . Remove dos carriage returns + + M models/atm/cam/src/dynamics/se/dyn_comp.F90 + . Bug fix from Mark Taylor + + M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + . Update SE tag to 1_3_36 for bug fix for Taylor + + M SVN_EXTERNAL_DIRECTORIES + . Update externals to match cesm1_2_beta06, except for pio, which has an + mpi-serial bug + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Apr 23 11:10:56 MDT 2013 +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Apr 23 11:11:00 MDT 2013 +024 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Apr 23 11:11:03 MDT 2013 +039 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Apr 23 11:11:05 MDT 2013 +043 bl366 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ............................FAIL! rc= 7 at Tue Apr 23 11:11:13 MDT 2013 +046 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue Apr 23 11:11:16 MDT 2013 +053 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Apr 23 11:11:20 MDT 2013 +060 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Tue Apr 23 11:11:28 MDT 2013 +090 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Tue Apr 23 11:11:51 MDT 2013 +. Baseline failures are due to a change in how the diagnostic output of + species burdens (BURDENBC BURDENDUST BURDENPOM BURDENSEASALT BURDENSO4 + BURDENSOA) have been redefined to be consistent with the mode burden + diagnostics which only contain contributions from daylight columns. + + +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Tue Apr 23 11:11:33 MDT 2013 +078 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 23 11:11:33 MDT 2013 +081 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Tue Apr 23 11:11:44 MDT 2013 +. Bug fix for SE cause minor answer changes + +078 bl740 TBL.sh h30c5h outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 23 11:11:33 MDT 2013 +. New test, no baselines + +084 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Tue Apr 23 11:11:47 MDT 2013 +. expected, cam tests use Intel 12, cesm test use Intel 13, which have answer differences + + +frankfurt/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Apr 22 15:12:39 MDT 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Apr 22 15:12:41 MDT 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Apr 22 15:12:42 MDT 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Apr 22 15:12:46 MDT 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Apr 22 15:13:11 MDT 2013 +. Baseline failures are due to a change in how the diagnostic output of + species burdens (BURDENBC BURDENDUST BURDENPOM BURDENSEASALT BURDENSO4 + BURDENSOA) have been redefined to be consistent with the mode burden + diagnostics which only contain contributions from daylight columns. + + +frankfurt/pgi or jaguar/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Apr 23 11:17:48 MDT 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Apr 23 11:17:49 MDT 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Apr 23 11:17:52 MDT 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Apr 23 11:17:57 MDT 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Apr 23 11:18:22 MDT 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Apr 23 11:18:27 MDT 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Tue Apr 23 11:18:30 MDT 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Tue Apr 23 11:18:41 MDT 2013 +. Baseline failures are due to a change in how the diagnostic output of + species burdens (BURDENBC BURDENDUST BURDENPOM BURDENSEASALT BURDENSO4 + BURDENSOA) have been redefined to be consistent with the mode burden + diagnostics which only contain contributions from daylight columns. + + + + +=============================================================== +=============================================================== + +Tag name: cam5_2_21 +Originator(s): santos +Date: Apr 17, 2013 +One-line Summary: Add debug checks to physics_update, some chores + +Purpose of changes: + + - Add a routine to validate physics_state objects, and provide a + namelist option to run this routine every time physics_update is + called. + - Change ptend%name for some routines to be more informative when + used in these messages. + + - Fix bug in CARMA netCDF file reads. + + - "endrun" is now a wrapper for "shr_sys_abort" from csm_share. This + means that ENDRUN will no longer be printed to log files; ERROR + will be printed instead. + + - For CESM cases, do not re-run configure after a build is complete. + + - Update mkDepends to match Machines version. + + - Standardize checking of error strings with handle_errmsg. + + - Move cprnc to $CESMROOT/tools, matching CESM's layout. + - This also pulls in a copy of genf90; it's convenient to have + an updated copy of genf90.pl in the same place in both CESM + and CAM tags (e.g. to auto-regenerate source code in unit + tests). + - The location of cprnc does not seem to be specified anywhere + in the CAM scripts, so this should be a "harmless" change + except in any user scripts that build and use cprnc from the + CAM source. + + - Remove some "#ifdef WACCM_PHYS" in cases where it can be replaced + with a cheap runtime conditional. + + - Change outputs for CAM-CHEM cases. + +Bugs fixed (include bugzilla ID): + + - Fixed issue with CARMA and a wrap_nf change introduced in + cam5_2_19. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Add "state_debug_checks" to phys_control namelist. + - .true. turns on these checks. + - Default is .true. for cases passing "-debug" to configure, + .false. otherwise. + + - Add new use_case (1850-PD_cam5.xml). This is similar to + 1850-2005_cam5.xml but has data from both observations and + projections, to allow cases to be run longer. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/1850-PD_cam5.xml + - New use_case for new compset (similar to F_AMIP_CAM5 but + with added data from observations and projections). + +In models/atm/cam/src/control/error_messages.F90: + handle_errmsg: Checks a string to make sure that it is empty. + If it is not empty, it is assumed to be an + error message and used to call endrun. + +In models/atm/cam/src/physics/cam/physics_types.F90: + physics_state_check: Checks for invalid data in a physics_state + object. Currently limited to checking for NaN + and finiteness, in most cases. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Add tools/cprnc. + - Update csm_share external to get shr_assert_mod. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Remove CAM copy of tools/cprnc. + +M models/atm/cam/bld/Makefile.in + - Use the "-d" option of mkDepends to ensure MCT is always + built first. + - Add netCDF to RPATH for Intel builds. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/physics/cam/phys_control.F90 + - Add state_debug_checks option (on by default for -debug + builds). + +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_moz_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml +M models/atm/cam/bld/namelist_files/use_cases/soa_chem_megan_emis.xml + - Change fincl1 output variables. + +M models/atm/cam/bld/cam.buildnml.csh + - Skip configure if build is complete (but error if + config_cache.xml is missing). + +M models/atm/cam/bld/mkDepends + - Updated with copy from Machines. + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccmx/majorsp_diffusion.F90 + - Changed handling of ptend%name so that routines no longer + need to alias themselves (e.g. MG's ptend%name was cldwat). + - Changed/removed settings of ptend%name which were redundant + or would tend to hide the true source of a change. + - Error strings coming from portable code now use + handle_errmsg. + - Replace compile-time "#ifdef WACCM_PHYS" with run-time + "if (do_waccm_phys)". + +M models/atm/cam/src/control/error_messages.F90 + - Add "handle_errmsg". + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/se/dp_coupling.F90 + - State variables initialized by dycore are now actually + *allocated* by the dycore, if supported. + - Remove temperature check that is now redundant with a check + in physpkg. + +M models/atm/cam/src/dynamics/se/gravity_waves_sources.F90 +M models/atm/cam/src/dynamics/se/pmgrid.F90 +M models/atm/cam/src/dynamics/se/stepon.F90 + - Add save statement needed by XLF on Intrepid. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Add new state_debug_checks option and routine that + implements it. + - Added separate routine to allocate variables needed by + WACCM and initialized by dycore (uzm, frontgf, and + frontga). + - If allocated, uzm, frontgf, and frontga are now copied + in physics_state_copy. + - Generalized pergro logic slightly so that microphysics and + macrophysics routines no longer have to set ptend%name + to cldwat. + - Simplify some constituent limiters in physics_update. + - physics_update now flushes iulog. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Call physics_state_check at beginning of tphysac and + tphysbc. + - Since uzm is part of the state, don't pass it as a separate + argument to qbo_relax. + - Remove/shrink some "#ifdef WACCM_PHYS" blocks. + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Uses temporary arrays instead of ptend components to hold + local state. + - Uses handle_errmsg to check errstring. + - Replace "#ifdef WACCM_PHYS" with "if (do_waccm_phys)". + +M models/atm/cam/src/physics/cam/wv_saturation.F90 + - Use shr_assert_in_domain and handle_errmsg for some checks. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 + - Change CARMA netCDF reads to use netcdf module and new + wrap_nf interface. + - This is a bit hackish; wrap_nf should really just be + removed. + +M models/atm/cam/src/physics/waccm/gw_drag.F90 + - Check that state fields have been allocated by dycore in + gw_intr. + - Minor cleanup in preparation of some strings used as field + names in outfld (done while debugging a memory issue that + was actually caused by code elsewhere). + +M models/atm/cam/src/physics/waccm/qbo.F90 + - Use state%uzm directly instead of requiring it as a + separate argument to qbo_relax, and check that it is + allocated first. + +M models/atm/cam/src/utils/abortutils.F90 + - endrun is now just a wrapper for shr_sys_abort. + +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - Comment change. + +M models/atm/cam/test/system/CAM_runcmnd.sh +M models/atm/cam/test/system/archive_baseline.sh +M models/atm/cam/test/system/test_driver.sh + - Remove bluefire. + - test_driver.sh will set the wallclock limit to 2:00 if + using the "small" (debug) queue on yellowstone. + - Intel uses -rpath (like other compilers) rather than adding + $LIB_NETCDF to $LD_LIBRARY_PATH. + +M models/atm/cam/test/system/config_files/fst7mode1.9c5h +M models/atm/cam/test/system/config_files/fsoa1.9c4dh +M models/atm/cam/test/system/config_files/fsoa4c4dm +M models/atm/cam/test/system/config_files/fst7mode4c5dm + - Add option -age_of_air_trcs (now required by use_cases). + +M models/atm/cam/tools/README + - Remove description of cprnc. + +Additionally, a number of files with the "svn:executable" property +were not actually executables. This property was removed from files +that were not scripts. + +Having svn:mergeinfo on subdirectories can cause merge problems, so +this property was removed from all subdirectories. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All PASS. + +Note: Intel compiler version was set to 13 to get the following CESM +comparison test to pass: + +082 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d + +frankfurt/lf95: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +This tag is bit-for-bit except: +cam5_2_19 introduced a roundoff-level change in "igamma" for compilers +that provide a gamma intrinsic function. This only affects the CARMA +dust and seasalt models, and was exposed in this tag (since CARMA +cases did not work in cam5_2_19 and cam5_2_20). + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_20 +Originator(s): fischer +Date: Fri Apr 12 09:42:31 MDT 2013 +One-line Summary: rename homme to se, cice decomp fix + +Purpose of changes: +. HOMME is now referred to SE. The code is changed to reflect this. + If -dyn homme is used, you'll get a warning message and the dynamics + will be automatically switched to se. +. Fixes for calls to generate_cice_decomp.pl and cice configure + to handel changes with a new cice tag +. Update scripts tag to fix T42_T42 grid +. Couple minor fixes to test scripts + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TCB.sh +. Remove cice decomp calls from test scripts, let bld/configure handel the cice decomp. + +M models/atm/cam/test/system/test_driver.sh +. Changed path logic for submit scripts + +M models/atm/cam/test/system/TSC.sh +. Bug fix to return error code from second call to TSM.sh + +M models/atm/cam/test/system/TR8.sh +M models/atm/cam/test/system/config_files/h30c4aqdm +M models/atm/cam/test/system/config_files/hn16c5aqdm +M models/atm/cam/test/system/config_files/h16c3aqdh +M models/atm/cam/test/system/config_files/h16c5aqdm +M models/atm/cam/tools/interpic_new/README +M models/atm/cam/bld/config_files/horiz_grid.xml +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +M models/atm/cam/src/utils/cam_pio_utils.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 +. rename homme to se + +M models/atm/cam/bld/configure +. Rename homme to se. If homme dynamics is selected, print warning message and set to se. +. Fix cice decomp for cam stand alone scripts. + +D models/atm/cam/bld/config_files/defaults_homme.xml +A models/atm/cam/bld/config_files/defaults_se.xml +. Rename file with homme to se + +D models/atm/cam/src/dynamics/homme/pmgrid.F90 +D models/atm/cam/src/dynamics/homme/dycore.F90 +D models/atm/cam/src/dynamics/homme/trunc.F90 +D models/atm/cam/src/dynamics/homme/gravity_waves_sources.F90 +D models/atm/cam/src/dynamics/homme/nctopo_util_mod.F90 +D models/atm/cam/src/dynamics/homme/dyn_grid.F90 +D models/atm/cam/src/dynamics/homme/interp_mod.F90 +D models/atm/cam/src/dynamics/homme/README +D models/atm/cam/src/dynamics/homme/native_mapping.F90 +D models/atm/cam/src/dynamics/homme/initcom.F90 +D models/atm/cam/src/dynamics/homme/dp_coupling.F90 +D models/atm/cam/src/dynamics/homme/stepon.F90 +D models/atm/cam/src/dynamics/homme/inidat.F90 +D models/atm/cam/src/dynamics/homme/dyn_comp.F90 +D models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +D models/atm/cam/src/dynamics/homme/spmd_dyn.F90 +D models/atm/cam/src/dynamics/homme/inital.F90 +A models/atm/cam/src/dynamics/se/dycore.F90 +A models/atm/cam/src/dynamics/se/nctopo_util_mod.F90 +A models/atm/cam/src/dynamics/se/README +A models/atm/cam/src/dynamics/se/interp_mod.F90 +A models/atm/cam/src/dynamics/se/native_mapping.F90 +A models/atm/cam/src/dynamics/se/dp_coupling.F90 +A models/atm/cam/src/dynamics/se/dyn_comp.F90 +A models/atm/cam/src/dynamics/se/stepon.F90 +A models/atm/cam/src/dynamics/se/restart_dynamics.F90 +A models/atm/cam/src/dynamics/se/spmd_dyn.F90 +A models/atm/cam/src/dynamics/se/inital.F90 +. Move homme directory to se, and rename homme to se + +M SVN_EXTERNAL_DIRECTORIES +. Update scripts to fix T42_T42 grid + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all passed + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + + +=============================================================== +=============================================================== + +Tag name: cam5_2_19 +Originator(s): santos +Date: Apr 9, 2013 +One-line Summary: NAG port + +Purpose of changes: + +This allows CAM to compile with the NAG Fortran compiler. The +build will not quite work out of the box; as of this tag, CLM +and CICE tags still must be updated, and MCT requires a patch +to remove "intent" attributes from the MPI interfaces in +m_mpif90.F90. + +Not all configurations are ported; the following are still +untested or works in progress: + - OpenMP threading + - WACCM-X + - CARMA + - CLUBB + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + - Add NAG support. + - Get netCDF linking flags from nc-config/nf-config. + - This should also allow the use of a shared library. + - Add more debug flags to CAM Makefile for DEBUG cases: + - Add "-g" to C code (most compilers). + - Configure MCT with debugging enabled. + - Update most externals to NAG-compatible versions. + - All externals are between their cesm1_2_beta05 + and cesm1_2_beta06 versions. + - This required the addition of a wave component (swav). + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/src/utils/error_function.F90 +D models/atm/cam/src/utils/gamma_function.F90 + - Functionality moved to shr_spfn_mod (csm_share module). + +find_group_name (models/atm/cam/src/utils/namelist_utils.F90) + - Moved to shr_nl_mod (csm_share module). + +List all subroutines added and what they do: + +A models/atm/cam/test/system/tests_pretag_frankfurt_nag + - NAG pretag test list. Duplicate of Lahey pretag tests. + +A models/atm/cam/bld/get_nxny.pl + - Script to get nx and ny values from "config_grid.xml" in + the CESM scripts. These values are needed because they + must be passed to CICE configure scripts. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update externals to very recent versions (between cesm1_2_beta05 + and cesm1_2_beta06). + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Update externals to NAG-compatible versions. + +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure + - Add nagfor to compilers. + - Use netCDF config script to get linking flags. + - Add -g to CFLAGS for DEBUG builds. + - Add --enable-debugging option to MCT for DEBUG builds. + - For NAG, set MCT CFLAGS (override defaults), since otherwise + there will be binary incompatibilities and/or spurious test + failures in MCT's configure. + - Update configure for standalone build with new wav component + and CICE configure changes. + +===================== +There are a number of short changes that had to be made to large numbers of +files. The following is a list of these changes, followed by the list of +all files that had only these changes made. These changes may have also +affected other files. + +Changes regarding syntax and Fortran standard compliance: + - Where a module has both a save statement, and variables declared with the + save attribute individually, remove the individual save and leave only + the module-scope save. + - Additionally, add save statement to some modules where it was missing. + - Additionally, move include statements of mpif.h above any save + statements in a module, since mpif.h may include variables with + the "save" attribute specified individually. + - Where a procedure gets two arguments, and one is a dimension of the other, + the arguments may be in either order in the interface, but the dimension + must be declared first. + - Break up source code lines longer than the standard length of 132 + characters (72 for fixed-form source). + - Change non-standard format specifiers to standard equivalents. + - Always pass reals to procedures requiring a real argument; do not assume + integers will be converted to real automatically. + - Pass whole arrays or appropriate slices, rather than passing the first + element of an array under the assumption that a pointer to the correct + array location will be passed. + - Correct some "intent" attributes. + +Changes to pointer use: + - Default-initialize pointers to null() where NAG had detected at runtime + that they were being used uninitialized. + - Add "target" attribute to objects for which persistent pointers are + needed. + - In cases where pointer dummy arguments must remain associated with some + memory upon entry to a procedure, declare the dummy arguments with + "intent(in)" or "intent(inout)", not "intent(out)", regardless of how + that memory is used. + - Generally, this does not require changes to pointer dummy arguments, + since Fortran 95 (and therefore the Lahey compiler) does not allow + any intent to be specified on pointer dummy arguments. However, some + derived types have pointer components, and dummy arguments of these + types must have the correct intent. + +Changes to use of libraries and intrinsics: + - Get F2008 intrinsics that are not present on all compilers (e.g. gamma, + erfc) from shr_spfn_mod, rather than assuming that all compilers do or + do not have them. + - When setting IEEE NaN or Infinity, use the new version of shr_infnan_mod, + which requires the operator "assignment(=)" to be used. + - "bigint" was also replaced with huge(1). + - In some cases, "inf" had to be changed to "posinf" to deal with a + bug in PGI on Frankfurt. + - Where the netCDF F77 bindings are used, change to the netCDF F90 + bindings, and also replace any uses of wrap_nf in those modules. + - Change non-standard complex number intrinsics to generic standard + intrinsics (e.g. imag to aimag, dcmplx to cmplx). + - Use CAM's "endrun", not "abort" or "exit" (non-standard extensions). + +Other changes: + - Where required by the above changes, change dimensions of arrays. + (Usually, from explicit or assumed size to assumed shape.) + - Add some changes that would have allowed problems described above to + be detected on other compilers (initialize pointer components to null, + add explicit intent on procedures). + - Remove unnecessary code that would otherwise require one of the above + changes to be made. + +*A quick note on external libraries in Fortran: +It is technically not standard-conforming to use generic functions without +explicit interfaces, as in the netCDF and MPI F77 bindings. For netCDF, it +is easy to switch to the Fortran 90 bindings. For MPI, there are some +potential issues with using the MPI module, so instead the "-wmismatch" +argument is used to turn off some of nagfor's compile-time checks. + +Files: +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/chemistry/mozart/cfc11star.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_ghg_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/mo_mass_xforms.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/utils/msise00.F90 +M models/atm/cam/src/chemistry/utils/solar_data.F90 + +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/camsrfexch.F90 +M models/atm/cam/src/control/history_defaults.F90 +M models/atm/cam/src/control/physconst.F90 +M models/atm/cam/src/control/rgrid.F90 +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/control/scamMod.F90 +M models/atm/cam/src/control/wrap_nf.F90 + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 + +M models/atm/cam/src/dynamics/eul/comspe.F90 +M models/atm/cam/src/dynamics/eul/courlim.F90 +M models/atm/cam/src/dynamics/eul/dyndrv.F90 +M models/atm/cam/src/dynamics/eul/eul_control_mod.F90 +M models/atm/cam/src/dynamics/eul/forecast.F90 +M models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +M models/atm/cam/src/dynamics/eul/prognostics.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M models/atm/cam/src/dynamics/eul/scanslt.F90 +M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 +M models/atm/cam/src/dynamics/eul/stepon.F90 + +M models/atm/cam/src/dynamics/fv/ctem.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 +M models/atm/cam/src/dynamics/fv/par_xsum.F90 +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 + +M models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/interp_mod.F90 +M models/atm/cam/src/dynamics/homme/native_mapping.F90 + +M models/atm/cam/src/dynamics/sld/comspe.F90 +M models/atm/cam/src/dynamics/sld/courlim.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/sld/prognostics.F90 +M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M models/atm/cam/src/dynamics/sld/scan2.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 +M models/atm/cam/src/dynamics/sld/stepon.F90 + +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/boundarydata.F90 +M models/atm/cam/src/physics/cam/cam3_aero_data.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/chem_surfvals.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +M models/atm/cam/src/physics/cam/comsrf.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/diffusion_solver.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/molec_diff.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/ndrop_bam.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/radae.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/radiation_data.F90 +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 + +M models/atm/cam/src/physics/rrtmg/radsw.F90 +M models/atm/cam/src/physics/rrtmg/rrtmg_state.F90 + +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 +M models/atm/cam/src/physics/waccmx/ionosphere.F90 + +M models/atm/cam/src/utils/abortutils.F90 +M models/atm/cam/src/utils/cam_dom/ocn_spmd.F90 +M models/atm/cam/src/utils/cam_dom/ocn_time_manager.F90 +M models/atm/cam/src/utils/cam_dom/sst_data.F90 + +M models/atm/cam/src/utils/pilgrim/decompmodule.F90 +M models/atm/cam/src/utils/pilgrim/mod_comm.F90 + +M models/atm/cam/src/utils/spmd_utils.F90 +M models/atm/cam/src/utils/time_manager.F90 + +===================== + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - Change leading dimension of dummy argument rh to "ncol", to + match the dimensions of the actual argument. + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - Ensure that extfrc and reaction_rates always have non-zero + size. (When extcnt or rxntot are 0, the arrays will have + a trailing dimension of 1, but will not actually be used.) + - Size zero arrays are not a problem with NAG, but these + arrays have default values assigned, and this cannot be + done for arrays with no elements to assign. + +M models/atm/cam/src/chemistry/mozart/mo_setsox.F90 + - Fix a case where a variable that was only set for 7-mode MAM + was being referenced in all MAM cases. + - It appears that only 7-mode MAM would actually enter the + block where this reference occurred, so this caused no + apparent problems and passed runtime checks on other + compilers. + +M models/atm/cam/src/chemistry/mozart/wei96.F90 + - Remove unnecessary common block that impaired readability + during debugging. + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - Implemented workaround for a (still poorly understood) bug + with the netCDF builds on Frankfurt, where netCDF stores + a pointer to output dimension IDs and then overwrites them. + - Change "write(*,*)" to "write(iulog,*)". + - Nullify pointer in specify_fields if it will not be + allocated. + +M models/atm/cam/src/control/infnan.F90 + - Internal variables replaced with references to shr_infnan_mod. + - bigint removed; integers that were set to bigint are + now set to huge(1). + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in +M models/atm/cam/src/utils/buffer.F90 +M models/atm/cam/src/utils/buffer.F90.in + - Cast physics buffer pointers back to their original type (and + thus correct size) before deallocating. + +M models/atm/cam/src/physics/cam/rad_constituents.F90 + - Correct string with subroutine name. + +M models/atm/cam/src/physics/cam/restart_physics.F90 + - Randomly shuffle use statements to avoid bug with PGI on + Frankfurt. + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Remove assumption that constituents 2 and 3 are cldliq and + cldice. + +M models/atm/cam/src/utils/cam_dom/ocn_comp.F90 + - Close I/O unit before attempting to reuse it to open a new + file. + +M models/atm/cam/src/utils/cam_pio_utils.F90 + - Fix integer overflow in find_iodesc. +M models/atm/cam/src/utils/namelist_utils.F90 + - Now only a wrapper for shr_nl_mod. + +M models/atm/cam/test/system/CAM_runcmnd.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh +M models/atm/cam/test/system/test_driver.sh + - Add NAG to regression test compilers on Frankfurt. + - For some cases, NAG requires ocn_modelio.nml to be written. + - Set "ulimit -c unlimited" for Frankfurt, since this is generally + desirable if a regression test fails, and does not seem to be + inherited from the user's environment. + +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TCB_ccsm.sh + - Changes necessary to perform standalone build with new CICE, + wav component, and scripts. + +Some files with purely whitespace or comment changes: +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/tools/interpic_new/interpolate_data.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +082 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Tue Apr 9 05:22:41 MDT 2013 +085 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 7 at Tue Apr 9 05:27:33 MDT 2013 + +The updated version of Machines has a new version of the Intel compilers on +yellowstone. It was therefore expected that some TBL_ccsm tests might fail. + +Additionally, TEQ_ccsm tests will fail until either version 13 of the Intel +compiler becomes the default on yellowstone, or test_driver.sh is updated +to specify version 13. + +The TEQ_ccsm test did in fact pass with the compiler version bumped: +082 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................PASS at Tue Apr 9 11:09:14 MDT 2013 + +frankfurt/lf95: All PASS. + +frankfurt/pgi or jaguar/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + +All CAM configurations are bit-for-bit, excepting CESM cases with changes +due to updated Machines. + + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_18 +Originator(s): santos, mmills, bardeenc, hannay +Date: Apr 8, 2013 +One-line Summary: Update externals and namelist for CARMA and HOMME + +Purpose of changes: + + - Update CARMA external with several bug fixes. These are described in the + CARMA ChangeLog at: + models/atm/cam/src/physics/carma/base/ChangeLog + - Add use cases for new WACCM/CARMA sulfur and nuclear winter compsets. + - Source code updates for CARMA sulfate model to interact with chemistry. + + - Update HOMME with NAG-compatible version and bug fix for vector + Laplacian operation. + - Updates to HOMME namelist (see below). The most important change is that + the vertically Lagrangian advection method is now the default. + - Update namelist_definition.xml to describe HOMME namelist settings in + more detail (some descriptions and assistance from Mark Taylor). + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + - For HOMME cases, we use the flag "-DHAVE_F2003_PTR_BND_REMAP", as F2003 + pointer bounds remapping appears to be supported on all current + compilers (except Lahey, which we no longer test with HOMME). If this + causes problems, this flag will have to be set on a per-compiler basis + in CAM's Makefile.in and Machines. + +Describe any changes made to the namelist: + + - New CARMA sulfate model flag "carma_do_hetchem" toggles the use of CARMA + sulfate surface area density in heterogeneous chemistry rate + calculations. + + - SO2 forcing is no longer automatically added for waccm_mozart_sulfur. + + - Many HOMME changes: + - Switch from Eulerian to Lagrangian vertical advection method. + - Turn on energy fixer. + - Correct nu_p value for ne30np4. + - Correct both nu_p and nu_div for ne16np4 (necessary for stability). + - Set default nu_q to -1.D0, which automatically sets nu_q = nu within + HOMME. + - ne120np4 with vertically Lagrangian code has experimental settings + from John Truesdale. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_cam4_nuclear_winter.xml + - Use cases for SD-WACCM sulfur and nuclear winter compsets. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update csm_share external to get new shr_spfn_mod module. This is + necessary for the NAG port update, including the HOMME external + pulled in in this tag. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Update CARMA & HOMME externals. + +M models/atm/cam/bld/Makefile.in + - Define CPRLAHEY and CPRGNU for the respective compilers; used by + the new csm_share. + +M models/atm/cam/bld/build-namelist + - Add carma_do_hetchem to CARMA sulfate model. + - Remove logic that always adds an SO2 forcing file for + waccm_mozart_sulfur. + +M models/atm/cam/bld/configure + - Add "-DHAVE_F2003_PTR_BND_REMAP" to HOMME flags. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Changes to HOMME namelist. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add carma_do_hetchem. + - Update HOMME namelist documentation. + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/physics/cam/carma_flags_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 + - If carma_do_hetchem is .true., use CARMA sulfate surface area + density in mozart chemistry. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - Minor tweaks (e.g. radiation_scheme is now discovered through + phys_getopts rather than guessing based on the number of bands). + +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 + - Remove comment that should have only been in the cirrus model. + +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 + - Fix comment typo. + +D models/atm/cam/test/system/config_files/f1.9c4carmsulm +A models/atm/cam/test/system/config_files/fsd1.9c4wcarmsulm +D models/atm/cam/test/system/config_files/f1.9c5carmbc_m +A models/atm/cam/test/system/config_files/f1.9c4wcarmbc_m +M models/atm/cam/test/system/input_tests_master +D models/atm/cam/test/system/nl_files/carma24h +A models/atm/cam/test/system/nl_files/outfrq24h_carma + - CARMA test changes: + - Remove old sulfate and bc_strat tests and replace them with + WACCM tests that more closely match the new CESM compsets + (including the new use cases). + - Rename carma24h to outfrq24h_carma (similar to outfrq3s_*). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +076 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Sun Apr 7 22:31:44 MDT 2013 +079 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Sun Apr 7 22:52:24 MDT 2013 +088 bl997 TBL_ccsm.sh ne16_g37 FC5 2d .....................................FAIL! rc= 7 at Sun Apr 7 23:13:39 MDT 2013 + +frankfurt/lf95: All tests PASS + +frankfurt/pgi or jaguar/pgi: + +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Sun Apr 7 21:28:48 MDT 2013 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Sun Apr 7 22:43:14 MDT 2013 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + - All HOMME cases and CARMA cirrus and sulfate cases. + +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - Above roundoff, but same climate. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_2_17 +Originator(s): fischer, bsingh, eaton, +Date: April 5, 2013 +One-line Summary: Prescribed MAM update + +Purpose of changes: +. Merge in latest changes for prescribed MAM. +. Add default namelist support for prescribed MAM. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +A models/atm/cam/bld/namelist_files/use_cases/1850_cam5_pm.xml +. new use_case for 1850 prescribed MAM + +A models/atm/cam/test/system/config_files/fn1.9c5dh +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/input_tests_master +. new prescribed MAM test + +M models/atm/cam/test/system/test_driver.sh +. Fixed frankfurt intel tests + +M models/atm/cam/bld/Makefile.in +. Removed -DNO_MPI2 rule for dyn_grid.F90 + +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/utils/spmd_utils.F90 +. Add #define DNO_MPI2 1 + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Add checks for prescribed bulk/modal aerosol variables + +M models/atm/cam/bld/build-namelist +. Updated prescribed mam variable list +. Fixed logic to allow prescribed bulk and modal aerosol namelist + varibles to be set to defaults + +M models/atm/cam/bld/perl5lib/Build/Namelist.pm +. Modify Namelist.pm to recognize comment lines in namelist input files. + The previous code only recognized end of line comments. + +M models/atm/cam/src/physics/cam/convect_shallow.F90 +. Changes to option name for physics_ptend_init + +M models/atm/cam/src/physics/cam/gw_drag.F90 +. Changes to option name for physics_ptend_init + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +. Change scalar file%in_pbuf to an array. + +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +. Merge in changes from cam1/branch_tags/aerosol_tags/aerosol002_cam5_2_10 +. Allocate file%in_pbuf and initialize + +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 +M models/atm/cam/src/chemistry/utils/aerodep_flx.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +. Allocate file%in_pbuf and initialize + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +014 bl322 TBL.sh fn1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Apr 4 21:56:30 MDT 2013 +. New test for prescribed MAM + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + + +=============================================================== +=============================================================== + +Tag name: cam5_2_16 +Originator(s): Cheryl Craig, Pete Bogenschutz and Sean Santos +Date: April 1, 2013 +One-line Summary: CLUBB tunings for scientifically validated release + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- Introduced sol_facti_cloud_borne to allow tuning, default value is 1.0 +- Changed tuning of dust_emis_fact_dyn for CLUBB +- Changed tuning of sol_facti_cloud_borne for CLUBB + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Utilizing modified CLUBB library + +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - Introduced sol_facti_cloud_borne tuning parameter + +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - CLUBB tunings + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Temporary CLUBB tuning + +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - CLUBB tunings and revised routine from Sean + +M models/atm/cam/src/physics/cam/convect_deep.F90 + - Moved initializations of prec and snow to after they are acquired + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: All BFB except CLUBB, which is expected to fail due to new tunings +040 bl366 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ............................FAIL! rc= 7 at Sat Mar 30 01:45:03 MDT 2013 + +frankfurt/lf95: All BFB + +frankfurt/pgi or jaguar/pgi: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_15 +Originator(s): fvitt, tilmes +Date: 29 Mar 2013 +One-line Summary: CAM-Chem and WACCM updates + +Purpose of changes: + + - call endrun when lower boundary conditions are specified + in more than one manner via bndtvghg, flbc_file, or *vmr namelist + variables to prevent multiple specification of lower boundary conditions + - remove deprecated waccm_mozart_v1 chemistry package + - replace chemistry package trop_strat_bam_v1 with trop_strat_soa + - update chemistry in packages: + trop_mozart_mam3 + trop_mozart_mam7 + trop_mozart_soa + - set default nspltvrm to 2 for waccm_phys ( waccm and waccmx ) + - corrections to surface area calculations of modal aerosols + - correction to units of the SOA*_PROD diagnostics + - restrict message logging to masterproc in many of the chemistry modules + - update to MEGAN factors input file + - update to solar protons input file + - update to SAD input file + - update to sulfate file + - new build-namelist use cases: + 2000_cam5_trop_moz_mam3 + 2000_cam4_trop_strat_soa + 2000_cam5_trop_strat_mam3 + 2000_cam5_trop_strat_mam7 + +Bugs fixed (include bugzilla ID): + Bug #: 1639 + Summary: reduce stdout from cam + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/pp_waccm_mozart_v1 + - deprecated chemistry package removed + +D models/atm/cam/src/chemistry/pp_trop_strat_bam_v1 + - mechanism placed by pp_trop_strat_soa + +D models/atm/cam/src/chemistry/utils/mo_regrider.F90 + - removed this deprecated module that only works on regular lat/lon grids + +List all subroutines added and what they do: + +A models/atm/cam/test/system/nl_files/outfrq3s_mozEOOH + - added for mechanisms that have EOOH chemical tracer + +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_strat_soa/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_strat_soa + - chemical mechanism added to replace trop_strat_bam_v1 + +A models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_moz_mam3.xml +A models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_strat_soa.xml +A models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam3.xml +A models/atm/cam/bld/namelist_files/use_cases/2000_cam5_trop_strat_mam7.xml + - new build-namelist use case files + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/config_files/wm1.9c4h + - changed "waccm_mozart_v1" to "waccm_mozart" + +M models/atm/cam/test/system/config_files/fst1.9c4dh + - changed "trop_strat_bam_v1" to "trop_strat_soa" + +M models/atm/cam/test/system/config_files/fsoa4c4dm + - correction to -nosmp config option + +M models/atm/cam/test/system/tests_chem_hybrid + - moved SOA tests to be first + +M models/atm/cam/test/system/test_driver.sh + - set yellowstone queue to $CAM_BATCHQ + +M models/atm/cam/test/system/input_tests_master + - adjustments for outfrq3s_mozEOOH namelist options + +M models/atm/cam/bld/configure + - removed chemistry package waccm_mozart_v1 + - replaced chemistry package trop_strat_bam_v1 with trop_strat_soa + - adjusted number of advected tracers in chemistry packages + trop_strat_mam3 + trop_strat_mam7 + trop_mozart_mam3 + +M models/atm/cam/bld/config_files/definition.xml + - removed chemistry package waccm_mozart_v1 + - replaced chemistry package trop_strat_bam_v1 with trop_strat_soa + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - waccm_mozart_v1 defaults removed + - update to megan_factors_file + - update to default SAD file -- default for WACCMX also + - update to sulfate file + - update to photolysis cross sections + - set defaults of nspltvrm, nspltac and nsplit when waccm_phys is used + +M models/atm/cam/bld/namelist_files/master_gas_wetdep_list.xml +M models/atm/cam/bld/namelist_files/master_drydep_list.xml + - updates to species lists + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - increase in megan_specifier string (to 1024 characters) + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml + - update to solar proton input file + - removed bndtvghg -- this is redundant specification of lower boundary with flbc_file + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml + - removed bndtvghg -- this is redundant specification of lower boundary with flbc_file + - update SPE file + +M models/atm/cam/bld/namelist_files/use_cases/mozart_megan_emis.xml +M models/atm/cam/bld/namelist_files/use_cases/soa_chem_megan_emis.xml + - update to megan_factors_file + - corrected emissions from files + - set megan_mapped_emisfctrs to .false. + - included a fincl1 list + - include IC files + +M models/atm/cam/bld/build-namelist + - removed waccm_mozart_v1 setting + - replaced "trop_strat_bam_v1" with "trop_strat_soa" + - set default nsplit and nspltrac for waccm_phys + - set default srf_emis_cycle_yr to 2000 for waccm_mozart_mam3 chemistry + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - removed kludge to set wet deposition list for waccm_mozart_v1 + +M models/atm/cam/src/physics/cam/chem_surfvals.F90 + - call endrun if both bndtvghg and flbc_file are specified + + +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 + - call endrun if lower boundary is specified in more than one manner + +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - map EOOH to CH2O + +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 +M models/atm/cam/src/chemistry/mozart/wei96.F90 +M models/atm/cam/src/chemistry/mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 +M models/atm/cam/src/chemistry/mozart/efield.F90 + - restrict message logging to masterproc + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - interface changes to mo_sulf and mo_drydep + - zero out topospheric sulfate above tropopause and + stratospheric sulfate below the tropopause + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - interface changes to mo_sulf + +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 + - removed use mo_regrider statement -- mo_regrider not used in these modules + +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 + - replaced the use of mo_regrider with tracer_data utility module + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - replaced the use of mo_regrider with lininterp_data module + which will regrid data on unstructure grids + - depostition velocity of EOOH mapped to CH2O + +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 + - misc code clean up + +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 + - correction to units of the SOA*_PROD diagnostics + - correction for changing soa* tag names + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - corrections to surface area calculations of modal aerosols + +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 + - preprocessor re-ran on these mechanisms to give updated data + +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in + - mechanism updates + +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.in + - mechanism updates + +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.in + - mechanism updates + +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 + - correction for renaming the soa1 tag name + +M SVN_EXTERNAL_DIRECTORIES + - chem proprocessor updates + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Wed Mar 27 19:14:26 MDT 2013 + - expected failure due to default setting of nspltvrm + +070 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Wed Mar 27 21:22:55 MDT 2013 + - expected failure due to default setting of nspltvrm + - changed chemistry mechanism from waccm_mozart_v1 to waccm_mozart + +048 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Mar 27 20:11:43 MDT 2013 +052 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Wed Mar 27 20:22:14 MDT 2013 +055 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Wed Mar 27 20:29:51 MDT 2013 + - changes in input files + +057 bl430 TBL.sh fm1.9c5dh outfrq3s_mozEOOH 9s ............................FAIL! rc= 7 at Wed Mar 27 20:38:59 MDT 2013 + - changes in chemistry mechanism and input files + +060 bl440 TBL.sh fsoa1.9c4dh outfrq3s_mozEOOH+soa_chem_megan_emis 9s ......FAIL! rc= 7 at Wed Mar 27 20:55:25 MDT 2013 + +frankfurt/lf95: +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Mar 27 19:27:30 MDT 2013 + - expected failure due to default setting of nspltvrm + +frankfurt/pgi: +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Mar 27 15:31:43 MDT 2013 + - expected failure due to default setting of nspltvrm + +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Mar 27 16:38:04 MDT 2013 + - expected failure due to changes in photolysis inputs + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_2_14 +Originator(s): fischer, hannay +Date: Fri Mar 15 11:09:40 MDT 2013 +One-line Summary: Add namelist variables to control history file output, generate + pre cam5_2_13 baselines, waccm sc ic file + +Purpose of changes: + +. Namelist variables history_amwg, history_aerosol, history_eddy, and history_budget + are setup to control the history file outputs. These are boolean flags that are + used to control the add_default calls. history_amwg is the only one that defaults to + true. +. A -b argument was added to test_driver.sh, incase there is a need to generate baselines + for pre cam5_2_13 tags. Usage would be test_driver.sh -f -b +. New better logic in test_driver.sh to handle command line arguments +. New ne30 initial condition file for waccm_sc_2000_cam4. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +. Changed ne30np4 ic from cami_ne30np4_L66_SC_WACCM_c121127.nc to + f.e11.FWSC.ne30_ne30.wm_SE.003.cam.i.0006-01-01-00000.nc +. Add history_amwg, history_aerosol, history_budget, and history_eddy to control + variables being saved to history files. The default is history_amwg is true, + the rest are false. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/archive_baseline.sh +. Change group write permission + +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh +. Turn on extra history output for cam3/4/5 + +M models/atm/cam/test/system/TBL_ccsm.sh +M models/atm/cam/test/system/TBL.sh +. Add logic to be able to create pre cam5_2_13 baselines + +M models/atm/cam/test/system/test_driver.sh +. Improve logic for handling command line arguments +. Add -b argument to be able to generate baselines for pre cam5_2_13 tags. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Remove history_microphysics variable +. Set defaults for history_amwg(true), history_aerosol(false), + history_eddy(false), and history_budget(false) + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. Add history_amwg and history_eddy, removed history_microphyics + +M models/atm/cam/bld/build-namelist +. Add history_amwg, history_aerosol, history_budget, and history_eddy to namelists + Remove history_microphysics + +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/cloud_cover_diags.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. Move add_default into conditionals based on history_amwg, history_aerosol, + history_budget, and history_eddy. Remove history_microphysics. + +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +. Change ic file for ne30np4 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: all passed + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + + +=============================================================== +=============================================================== + +Tag name: cam5_2_13 +Originator(s): fischer, eaton, cacraig, cecila, jedwards, Mark Taylor +Date: 3-11-2013 +One-line Summary: test script improvements, homme update, external updates, bug fixes, + change solar namelist defaults + +Purpose of changes: + +. The default for the solar data namelist variables was being set + differently for the configurations "-phys cam5 -chem trop_mam3" and + "-phys cam5 -chem none". This was changed to make the value for + prescribed aerosols be the same as for prognostic aerosols. Also added + a check to build-namelist to disallow setting both solar_const and + solar_data_file. It only makes sense to set one of these variables. + +. Made changes to test scripts to improve testing on yellowstone. + - -j option was added to be able to specify number of of jobs for gmake. + The default setting of -j was unlimited, which was producing slower builds + than specifying -j 4, -j 8, or -j 16. + - Fix issues with builds on yellowstone being repeated done when it + fails to build the first time. + - Fix issues with builds being tried on yellowstone compute nodes. + - Add CAM_RBOPTIONS to give more flexibility on how builds are done. + Valued values are "build_only", "run_only" and "run_and_build" + CAM_RBOPTIONS is passed to the other test scripts through the argument + list. The effect of this change is this tag cannot make a baseline for + previous tags. + - Option for pgi testing was added, but not working yet. + +. SVN externals were updated to match cesm1_2_beta02. + - Issues with PIO forced the use of a later PIO tag. + - Also, the Machines tag wasn't updated do to failed tests with intel/13.0.1 + +. CAM-SE (homme) external was update to homme1_3_17 + +Bugs fixed (include bugzilla ID): +. Fixed long name for SNOWHICE. Bugzilla #945 +. Fix memory leak by adding missing deallocate. Bugzilla #1629 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer, fvitt + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + M models/atm/cam/test/system/tests_pretag_yellowstone + M models/atm/cam/test/system/tests_posttag_yellowstone +. Move sm415 and bl415(fst1.9c5dh) from pretag to posttag test. +. Replaced sm993(ne30_g16), er993, and bl993 with sm997(ne16_g37),er997, and bl997 + + M models/atm/cam/test/system/input_tests_master +. Add an ne16_g37 cesm test sm997, er997, and bl997 + + D models/atm/cam/test/system/TBL_cb.sh + D models/atm/cam/test/system/TNE_cb_ccsm.sh + D models/atm/cam/test/system/TBL_cb_ccsm.sh + D models/atm/cam/test/system/TSC_cb.sh + . These test scripts are no longer needed. + + M models/atm/cam/test/system/test_driver.sh +. Changed pes layouts for yellowstone and frankfurt +. Removed bluefire logic +. Add -j command line option to set the number of jobs for gmake +. Changed logic for yellowstone builds, added new enviroment variable + CAM_RBOPTIONS, valide values are 'build_only', 'run_only', and 'run and build' +. Started adding pgi support for yellowstone, currently not working. + + M models/atm/cam/test/system/TCB.sh + M models/atm/cam/test/system/TDD.sh + M models/atm/cam/test/system/TCB_ccsm.sh + M models/atm/cam/test/system/TBL.sh + M models/atm/cam/test/system/TBR.sh + M models/atm/cam/test/system/TPF.sh + M models/atm/cam/test/system/TER.sh + M models/atm/cam/test/system/TEQ_ccsm.sh + M models/atm/cam/test/system/TER_ccsm.sh + M models/atm/cam/test/system/TSM_ccsm.sh + M models/atm/cam/test/system/TMC.sh + M models/atm/cam/test/system/TBL_ccsm.sh + M models/atm/cam/test/system/TSC.sh + M models/atm/cam/test/system/TEQ.sh + M models/atm/cam/test/system/TNE_ccsm.sh + M models/atm/cam/test/system/TSM.sh +. Pass CAM_RBOPTIONS to test scripts through argument list +. Add logic to handle CAM_RBTIONS + + M models/atm/cam/bld/configure +. remove a debug print +. Updated build filepaths for changes in the clm directory structure to + handle multiple versions of clm (clm4.0, clm4.5) + + M models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +. remove extraneous setting of solar_const + + M models/atm/cam/bld/build-namelist +. add check to disallow setting both solar_const and solar_data_file +. change how solar namelist defaults are set so that for cam5 physics the + defaults don't depend on which chemistry package is used. The defaults + for cam4 physics continue to depend on whether chemistry is used or not. + + M models/atm/cam/bld/perl5lib/Build/Namelist.pm +. add delete_variable method + + M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. Fixed long name for SNOWHICE. Bugzilla #945 + + M models/atm/cam/src/utils/cam_pio_utils.F90 +. Fix memory leak by adding missing deallocate. Bugzilla #1629 + + M models/atm/cam/src/chemistry/mozart/short_lived_species.F90 +. Bug fix to pbuf_set_field + + M models/atm/cam/src/dynamics/homme/dyn_comp.F90 +. Bug fix for dynamics timestep when using lagrangian code. + + M models/atm/cam/src/dynamics/fv/te_map.F90 +. Abort if vertical levels cross. This prevents some unstable runs in + various FV CAM and WACCM simulations. + + M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + . Update homme(SE) external + + M SVN_EXTERNAL_DIRECTORIES + . Update svn external to match cesm1_2_beta02. Issues with pio forced the + use of a later version of pio. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +. All passed + +frankfurt/lf95: +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Thu Mar 7 17:07:33 MST 2013 +. Changed ntasks from 8 to 16, causes answer changes in COSP due to known bugs in COSP code + +frankfurt/pgi: +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Mar 7 12:39:38 MST 2013 +. Changed ntasks from 8 to 16, causes answer changes in COSP due to known bugs in COSP code +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Thu Mar 7 12:46:18 MST 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Thu Mar 7 12:49:13 MST 2013 +. The change to solar input defaults change answers for configurations with + the args "-phys cam5 -chem none". + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam5_2_12 +Originator(s): fvitt +Date: 01 Mar 2012 +One-line Summary: Corrections to super_fast_llnl_mam3 chemistry package + and misc updates and fixes + +Purpose of changes: + + - correct super_fast_llnl_mam3 chemistry package + - fix in modal_aero_data to avoid index out of range error + - change history output of SOA* aerosols from VMR to MMR + - add build-namelist use case for MOZSOA compset + so that 'NEU' wet deposition scheme is used + - update solar input files for SD-WACCM + - update default MEGAN emissions factors input file + - make chemistry preprocessor more robust + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/soa_chem_megan_emis.xml + - new use case file for MOZSOA compsets -- this uses 'NEU' wet dep method + +A models/atm/cam/test/system/config_files/fsoa4c4dm + - new SOA chem regestion test + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_chem_hybrid +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_chem_mpi + - adjustments to chem tests + +M models/atm/cam/bld/configure + - minor cleanup associated with customizing chemistry (preprocessor) + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - corrections to prescribed ozone input for SC-WACCM + - added default IC file for waccm5 at 4x5 resolution + - update to default MEGAN emissions factors + +M models/atm/cam/bld/build-namelist + - correction in super_fast_llnl_mam3 linoz and chlorine loading inputs + +M ... /use_cases/.. sd_waccm_geos5 ??? + - updates to solar_data_file and solar_parms_file + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - changes to make preprocessor more robust + . check if need to re-run preprocessor -- checks changes to input + . attempt to store executable in a public place so that every user + does not need to compile every time the preprocessor is needed + . errors in preprocessor input more apparent + +M models/atm/cam/src/chemistry/mozart/mo_mass_xforms.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 + - avoid index out of range error when index is greater the number of + registered constituents which can occur when we have chemical tracers + that are not registered (e.g., H2O in WACCM) + +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.doc +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.in + - change in tag name of O3 + hv photo reaction to be compatable with + tag name check in llnl_O1D_to_2OH_adj + +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in + - LLNL corrections to super_fast_llnl_mam3 chem mechanism + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_setz.F90 +M models/atm/cam/src/chemistry/mozart/mo_pchem.F90 +M models/atm/cam/src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_xsections.F90 + - changes for super_fast_llnl_mam3 -- checks for j2oh rxt tag + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - output SOA aerosol species in units of kg/kg + +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 + - added diagnostics + +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - map SOG species to H2O2 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +062 bl440 TBL.sh fsoa1.9c4dh outfrq3s+soa_chem_megan_emis 9s ..............FAIL! rc= 7 at Thu Feb 28 14:41:12 MST 2013 + - failed due to change in build-namelist use case + +frankfurt/lf95: + +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Feb 28 14:58:28 MST 2013 + - failed due to change in prescribed ozone input file + +frankfurt/pgi: + +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Feb 28 10:52:11 MST 2013 + - failed due to change in prescribed ozone input file + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_11 +Originator(s): santos +Date: Feb 25, 2013 +One-line Summary: Separate MAM top level, code simplifications + +Purpose of changes: + - Separate MAM top level from tropospheric cloud physics + top level, so that modal aerosols can sediment above the + clouds in WACCM5. + - Make "tend" an optional argument to physics_update. + - Make interpic_new always produce netCDF with 64-bit offset. + - Cleanup regarding gw_drag. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Add "clim_modal_aero_top_press", the new top level for + modal aerosol microphysics. By default this is high enough + that modal aerosol calculations are done throughout the + WACCM levels, but below most WACCM-X levels. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist + - Add clim_modal_aero_top_lev option with default 1.e-4 Pa. + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - Change top level from trop_cloud_top_lev to + clim_modal_aero_top_lev. + +M models/atm/cam/src/physics/cam/physics_types.F90 + - Move the physics_tend argument to the end of + physics_update's argument list, and make it + optional. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - Remove dummy physics_tend argument that is no + longer necessary to call physics_update. + +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/tphysidl.F90 + - Since both versions of gw_drag have a register + routine now, move gw_drag_register out of + #ifdef WACCM_PHYS. + - Move "tend" argument to the end of every + physics_update call. + +M models/atm/cam/src/physics/cam/gw_drag.F90 + - Add empty subroutine gw_drag_register, so that + the interface for this module matches the other + gw_drag. + +M models/atm/cam/src/physics/cam/ref_pres.F90 + - Add clim_modal_aero_top_lev, analogous to + trop_cloud_top_lev, and force the MAM top to + be above the cloud top. + +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 + - Changes with no effect (e.g. white space). + +M models/atm/cam/tools/interpic_new/fmain.F90 + - Remove -64 option, as 64-bit offset is now + always on. + + WARNING: This will break scripts that specify + "-64" if they are used on interpic built from + this tag (or later). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + + WACCM5 posttag baseline will fail. WACCM5 is bit-for-bit if + clim_modal_aero_top_press is set to 100 Pa in the new code, + but the new default is 1.e-4 Pa. Part of ongoing development + of WACCM5. + + +yellowstone/intel: + +All PASS. + +frankfurt/lf95: + +All PASS. + +frankfurt/pgi or jaguar/pgi: + +All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + - WACCM5 +- what platforms/compilers: + - All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - Affects climate, but can be made bit-for-bit through namelist. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_10 +Originator(s): santos +Date: Feb 8, 2013 +One-line Summary: saturation vapor pressure fixes, WACCM5 fixes + +Purpose of changes: + - Fix problems with saturation vapor pressure schemes + discovered during development of cam5_2_02. + - Fix outstanding problems with WACCM5 that cause it to + crash, by enforcing trop_cloud_top_lev in more modules + that require this limit. + - Make treatment of WACCM4 and WACCM5 more consistent. Both + now set the same top_lev limiter, but some modules perform + additional checks for CAM5 features to decide if they want + to use it. + - Add "rsplit" namelist option for HOMME (courtesy Cecile + Hannay). + +Bugs fixed (include bugzilla ID): + "Meta"bugs: + 1588: Incorrect calculation of saturation specific humidity at + low pressures throughout CAM + Bugs: + 1583: zm_conv generates NaN and negative values in saturation mmr + calculation at low pressure + 1584: radae bypasses checks for low pressure when calculating + saturation specific humidity + 1585: modal_aero_wateruptake bypasses checks for low pressure in + saturation specific humidity + 1589: Findsp does not conserve enthalpy for very low temperatures + + Enhancements: + 1587: Unify dqsdt calculations in CAM + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Add rsplit option for HOMME. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add rsplit namelist option for HOMME. + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + - Set all fields added for clim_modal_aero to 0, to try to + reduce the chance of uninitialized data use. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Add top_lev to more loops and array slices. + - Remove unnecessary/unused logic. + - The following miscellaneous changes: + - modal_aero_wateruptake: Change qsat_water call to use + new version. + - aer_rad_props: Since trop_cloud_top_lev is now set in WACCM4, + use it only "if (prog_modal_aero)". + - cldwat2m_macro: Rename "qsat" to "qs" to avoid confusion with + wv_saturation intrinsic (and "esat" to "es" to match). + - cloud_fraction: cldfrc_fice moved from cldwat, and top_lev + only used if macrop_scheme /= "rk". + - Microphysics/macrophysics modules: Change indexes to ensure + that output variables do not contain uninitialized data above + top_lev. + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 + - Comment changes only. + +M models/atm/cam/src/physics/cam/cldwat.F90 + - Replace k1mb with top_lev. + - Update calculation of dqsdt to use new code (and remove check for + low pressure that is now done in wv_sat_methods). + - Because cldwat_fice is shared code between CAM4 and CAM5, it + has been moved to cloud_fraction. The resulting code is only + used by RK microphysics and thus no longer checks microp_scheme. + +M models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/radae.F90 +M models/atm/cam/src/physics/cam/radlw.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 + - Update code that did SVP calculations without proper limits for + low pressure, and/or used a method other than the CAM default. + - ntopcld moved, and is now max(trop_cloud_top_lev,2). + - SVP conversion from Pa to hPa has been moved back into zm_conv, + since the requirement is specific to this module and not used + by any other CAM module. + +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 + - Moved "inimc" call from physpkg to stratiform, since cldwat + is not used at all unless RK microphysics is on. + - Slight simplifications to stratiform constituent logic. + +M models/atm/cam/src/physics/cam/wv_sat_methods.F90 + - Do proper pressure limiting in qsat/qmmr functions. + - Changed wv_sat_svp_trans to work correctly for ttrice == 0._r8. + - Bolton water scheme now outputs in Pa, like the other schemes. + +M models/atm/cam/src/physics/cam/wv_saturation.F90 + - Remove "legacy" functions and special function for ZM. + - Remove multiple copies of tmin; SVP calculations are now + always performed down to 127.16K. + - Fix findsp enthalpy checking at low temperatures, and generally + improve consistency/integration with wv_saturation. Enthalpy is + now always checked to ensure conservation. + - Note: Findsp used to ENDRUN with a non-convergence error for + very low temperatures. This (sometimes beneficial) checking + behavior was unintentional, and only triggered in certain edge + cases. Now findsp will abort the run only if a problem occurs + while it is running, and not due to bad input. If necessary, + temperatures should be checked elsewhere. + - Cleanup changes: + - trinv removed. + - estblf reorganized, and uses kind=r8 in aint. + - Pull out enthalpy formula for findsp into a function + (tq_enthalpy). + - Enthalpy at saturation can now be calculated as an optional + argument to the qsat routines. + - Temperature derivative optional outputs from qsat_* routines + are calculated in a separate (shared) function. + +M models/atm/cam/src/physics/waccm/gw_drag.F90 + - Prevent divide by 0 if wind happens to be exactly 0 at certain + points. + - Prevent segfault from certain bad winds by avoiding use of "abs" + to limit integer indices. This is just to avoid a "red herring" + crash in gw_drag, when the real problem is elsewhere. + +D models/atm/cam/test/system/config_files/wm1.9c5h +A models/atm/cam/test/system/config_files/wm1.9c5dh +M models/atm/cam/test/system/input_tests_master + - WACCM5 test is now a debug test, to catch some common errors + that occurred during development. + - Change "outfrq3s" to "outfrq3s_clubb" in CLUBB baseline test. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Fri Feb 8 15:44:21 MST 2013 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Fri Feb 8 15:44:22 MST 2013 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Fri Feb 8 15:44:27 MST 2013 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Feb 8 15:44:28 MST 2013 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Fri Feb 8 15:44:33 MST 2013 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Feb 8 15:44:39 MST 2013 +023 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Fri Feb 8 15:44:40 MST 2013 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri Feb 8 15:45:08 MST 2013 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Fri Feb 8 15:45:12 MST 2013 +040 bl366 TBL.sh f1.9c5clbdm outfrq3s_clubb 9s ............................FAIL! rc= 7 at Fri Feb 8 15:45:12 MST 2013 +043 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Feb 8 15:45:25 MST 2013 +048 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Feb 8 15:45:47 MST 2013 +050 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Feb 8 15:45:56 MST 2013 +052 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Fri Feb 8 15:46:19 MST 2013 +055 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Feb 8 15:46:31 MST 2013 +057 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Fri Feb 8 15:47:08 MST 2013 +059 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Feb 8 15:47:35 MST 2013 +062 bl440 TBL.sh fsoa1.9c4dh outfrq3s+mozart_megan_emis 9s ................FAIL! rc= 7 at Fri Feb 8 15:48:00 MST 2013 +066 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Fri Feb 8 15:48:07 MST 2013 +069 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Fri Feb 8 15:48:12 MST 2013 +072 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Fri Feb 8 15:49:16 MST 2013 +075 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Fri Feb 8 15:49:21 MST 2013 +078 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Fri Feb 8 15:49:37 MST 2013 +084 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 7 at Fri Feb 8 15:49:41 MST 2013 +087 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Fri Feb 8 15:50:11 MST 2013 + +frankfurt/lf95: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Feb 8 14:44:16 MST 2013 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Feb 8 14:44:19 MST 2013 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Feb 8 14:44:22 MST 2013 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Feb 8 14:44:31 MST 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Feb 8 14:45:18 MST 2013 +027 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Fri Feb 8 14:45:19 MST 2013 +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Feb 8 14:45:27 MST 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Feb 8 14:45:28 MST 2013 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Fri Feb 8 14:45:32 MST 2013 + +frankfurt/pgi or jaguar/pgi: + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Feb 8 14:46:31 MST 2013 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Feb 8 14:46:35 MST 2013 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Feb 8 14:46:35 MST 2013 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Feb 8 14:46:38 MST 2013 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Feb 8 14:46:44 MST 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Feb 8 14:47:30 MST 2013 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Fri Feb 8 14:47:31 MST 2013 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Feb 8 14:47:41 MST 2013 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Fri Feb 8 14:47:43 MST 2013 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Feb 8 14:47:43 MST 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Feb 8 14:47:51 MST 2013 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Fri Feb 8 14:47:56 MST 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Fri Feb 8 14:48:00 MST 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Fri Feb 8 14:48:05 MST 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Fri Feb 8 14:48:31 MST 2013 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Fri Feb 8 14:49:20 MST 2013 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Fri Feb 8 14:50:25 MST 2013 + + +**All CAM physics cases fail baseline tests due to wv_saturation bug fixes.** + + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + - All CAM physics cases (everything but ideal and adiabatic). + +- what platforms/compilers: + - All. + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + - Above roundoff but same climate as previous version and CESM1.1.1 + This was demonstrated with: + + - A CAM5 present day case (FC5, 1 degree), with code based on + cam5_2_03, run for 5 years. + - A fully-coupled 1850 WACCM case (B1850WCN, 2 degree), with code + based on cam5_2_06, run for 25 years. + - This run is in the experiment DB with ID #1635. + - The case name is: b.e11.B1850WCN.f19_g16.test_lim.001 + - A fully-coupled 1850 CAM5 case (B1850C5CN, 2 degree) is also + in the run database, but has not had its climate compared with + CESM 1.1.1. + - ID #1634 + - Case name is b.e11.B1850C5CN.f19_g16.test_lim.001 + + - Finite-volume cases are bit-for-bit between cam5_2_06 and + cam5_2_09, except that there is a roundoff-level difference due + to changes to shr_reprosum_mod in csm_share. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_09 +Originator(s): Cheryl Craig +Date: 1/28/13 +One-line Summary: Dynamic state,tend,ptend + +Purpose of changes: + - Introduce dynamic state,tend, ptend structures and supporting routines for use with sub-columns + - eliminated MODAL_AERO ifdef and replaced with rad_constituent interface inside ndrop.F90 (Eaton modification) + - Removed CLUBB_core from repository and the directory models/atm/cam/src/physics/clubb is now an external library + - Added Yellowstone pretag test for CLUBB + - Add module load mkl for CLUBB library + - renamed sub_column to microp_uniform to better reflect its purpose inside microp routines + +Bugs fixed (include bugzilla ID): + - Corrected flag for the intel compiler to ignore temp array creation + +Describe any changes made to build system: + - Introduced new configure parameter "psubcols". Default is 1 = no subcolumns. + +Describe any changes made to the namelist: + - Introduced use_subcol_microp - Switch which will be used to control sub-columns within microphysics + Namelist flag is accessed in phys_control, but it is not used inside CAM yet + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/src/physics/CLUBB_core +D models/atm/cam/src/physics/CLUBB_core/constants_clubb.F90 +D models/atm/cam/src/physics/CLUBB_core/variables_prognostic_module.F90 +D models/atm/cam/src/physics/CLUBB_core/interpolation.F90 +D models/atm/cam/src/physics/CLUBB_core/clip_explicit.F90 +D models/atm/cam/src/physics/CLUBB_core/saturation.F90 +D models/atm/cam/src/physics/CLUBB_core/mono_flux_limiter.F90 +D models/atm/cam/src/physics/CLUBB_core/mixing_length.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_zm.F90 +D models/atm/cam/src/physics/CLUBB_core/file_functions.F90 +D models/atm/cam/src/physics/CLUBB_core/mean_adv.F90 +D models/atm/cam/src/physics/CLUBB_core/grid_class.F90 +D models/atm/cam/src/physics/CLUBB_core/pdf_closure_module.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_zt.F90 +D models/atm/cam/src/physics/CLUBB_core/parameter_indices.F90 +D models/atm/cam/src/physics/CLUBB_core/hyper_diffusion_4th_ord.F90 +D models/atm/cam/src/physics/CLUBB_core/csr_matrix_class_3array.F90 +D models/atm/cam/src/physics/CLUBB_core/input_reader.F90 +D models/atm/cam/src/physics/CLUBB_core/parameters_model.F90 +D models/atm/cam/src/physics/CLUBB_core/error_code.F90 +D models/atm/cam/src/physics/CLUBB_core/lapack_wrap.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_rad_zm.F90 +D models/atm/cam/src/physics/CLUBB_core/parameters_radiation.F90 +D models/atm/cam/src/physics/CLUBB_core/mt95.f90 +D models/atm/cam/src/physics/CLUBB_core/endian.F90 +D models/atm/cam/src/physics/CLUBB_core/recl.inc +D models/atm/cam/src/physics/CLUBB_core/parameters_microphys.F90 +D models/atm/cam/src/physics/CLUBB_core/gmres_cache.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_rad_zt.F90 +D models/atm/cam/src/physics/CLUBB_core/sigma_sqd_w_module.F90 +D models/atm/cam/src/physics/CLUBB_core/hydrostatic_module.F90 +D models/atm/cam/src/physics/CLUBB_core/array_index.F90 +D models/atm/cam/src/physics/CLUBB_core/anl_erf.F90 +D models/atm/cam/src/physics/CLUBB_core/T_in_K_module.F90 +D models/atm/cam/src/physics/CLUBB_core/calendar.F90 +D models/atm/cam/src/physics/CLUBB_core/model_flags.F90 +D models/atm/cam/src/physics/CLUBB_core/advance_windm_edsclrm_module.F90 +D models/atm/cam/src/physics/CLUBB_core/pos_definite_module.F90 +D models/atm/cam/src/physics/CLUBB_core/pdf_parameter_module.F90 +D models/atm/cam/src/physics/CLUBB_core/fill_holes.F90 +D models/atm/cam/src/physics/CLUBB_core/sponge_layer_damping.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_variables.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_subs.F90 +D models/atm/cam/src/physics/CLUBB_core/variables_radiation_module.F90 +D models/atm/cam/src/physics/CLUBB_core/numerical_check.F90 +D models/atm/cam/src/physics/CLUBB_core/stat_file_module.F90 +D models/atm/cam/src/physics/CLUBB_core/input_names.F90 +D models/atm/cam/src/physics/CLUBB_core/output_netcdf.F90 +D models/atm/cam/src/physics/CLUBB_core/diffusion.F90 +D models/atm/cam/src/physics/CLUBB_core/advance_wp2_wp3_module.F90 +D models/atm/cam/src/physics/CLUBB_core/advance_xm_wpxp_module.F90 +D models/atm/cam/src/physics/CLUBB_core/extrapolation.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_sfc.F90 +D models/atm/cam/src/physics/CLUBB_core/surface_varnce_module.F90 +D models/atm/cam/src/physics/CLUBB_core/clip_semi_implicit.F90 +D models/atm/cam/src/physics/CLUBB_core/clubb_core.F90 +D models/atm/cam/src/physics/CLUBB_core/stats_type.F90 +D models/atm/cam/src/physics/CLUBB_core/clubb_precision.F90 +D models/atm/cam/src/physics/CLUBB_core/advance_helper_module.F90 +D models/atm/cam/src/physics/CLUBB_core/gmres_wrap.F90 +D models/atm/cam/src/physics/CLUBB_core/Skw_module.F90 +D models/atm/cam/src/physics/CLUBB_core/parameters_tunable.F90 +D models/atm/cam/src/physics/CLUBB_core/advance_xp2_xpyp_module.F90 +D models/atm/cam/src/physics/CLUBB_core/output_grads.F90 +D models/atm/cam/src/physics/CLUBB_core/variables_diagnostic_module.F90 + - Removed CLUBB_core from repository and the directory + models/atm/cam/src/physics/clubb is now an external library + +List all subroutines added and what they do: +A + models/atm/cam/test/system/config_files/f1.9c5clbdm +A + models/atm/cam/test/system/nl_files/outfrq3s_clubb + - Added Yellowstone pretag test for CLUBB + +A models/atm/cam/bld/run-yellowstone.csh + - Example build and run script for yellowstone + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh + - Add module load mkl for CLUBB library + +M models/atm/cam/test/system/tests_pretag_yellowstone +M models/atm/cam/test/system/input_tests_master + - Added Yellowstone pretag test for CLUBB + +MM models/atm/cam/bld/configure +MM models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/physics/cam/ppgrid.F90 + - Added psubcols. Changed CLUBB_core directory to clubb. + +MM models/atm/cam/bld/Makefile.in + - Corrected flag for the intel compiler to ignore temp array creation + +MM models/atm/cam/bld/config_files/definition.xml +MM models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +MM models/atm/cam/bld/build-namelist +M models/atm/cam/src/physics/cam/phys_control.F90 + - Added use_subcol_microp switch to control sub-columns in microphysics + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - CLUBB code is now in an external library + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - last microphysics fields which were in calling lists were added to pbuf + +MM models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - "sub_column" renamed "microp_uniform" to better describe variable + - modifications using new dynamically dimensioned state/tend/ptend + +M models/atm/cam/src/physics/cam/physics_types.F90 + - modifications for dynamically dimensioned state/tend/ptend + - added new routines physics_state_alloc, physics_tend_alloc, physics_ptend_alloc, + physics_state_dealloc, physics_tend_dealloc, and physics_ptend_dealloc + - state now has: + ngrdcol -- Grid -- number of active columns (on the grid) + nsubcol(pcols)-- Sub-columns -- number of active sub-columns in each grid column + psetcols -- -- max number of columns set - if subcols = pcols*psubcols, else = pcols + ncol -- -- sum of nsubcol for all ngrdcols - number of active columns + indcol(pcols*psubcols) -- indices for mapping from subcols to grid cols + - ptend and tend now has: + psetcols -- -- max number of columns set - if subcols = pcols*psubcols, else = pcols + - new routine physics_ptend_copy_subcol - copies ptend on grid to ptend on subcols + +M models/atm/cam/src/physics/cam/ndrop.F90 + - eliminated MODAL_AERO ifdef and replaced with rad_constituent interface (Eaton modification) + +M models/atm/cam/src/physics/cam/clubb_intr.F90 + - modifications using new dynamically dimensioned state/tend/ptend + - eliminated MODAL_AERO ifdef and now uses rad_constituent interface + - corrected bug found with Intel compiler in rho calculation + +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 + - microp_aero_run and summing with microp ptend now called in tphysbc instead of inside microp_driver_tend + - modifications using new dynamically dimensioned state/tend/ptend + +MM models/atm/cam/src/physics/cam/micro_mg1_0.F90 +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - renamed sub_column to microp_uniform to better reflect its purpose + +M models/atm/cam/src/physics/cam/tphysidl.F90 +M models/atm/cam/src/physics/cam/rayleigh_friction.F90 +M models/atm/cam/src/physics/cam/tracers.F90 +M models/atm/cam/src/physics/cam/radheat.F90 +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/carma_intr.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/iondrag.F90 +M models/atm/cam/src/physics/cam/aoa_tracers.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/chemistry/pp_none/chemistry.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/dynamics/sld/dp_coupling.F90 +M models/atm/cam/src/dynamics/sld/stepon.F90 +M models/atm/cam/src/dynamics/eul/dp_coupling.F90 +M models/atm/cam/src/dynamics/eul/stepon.F90 +M models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M models/atm/cam/src/dynamics/homme/stepon.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 + - modifications using new dynamically dimensioned state/tend/ptend + +M models/atm/cam/doc/ChangeLog + + M models/atm/cam/test/system/tests_pretag_frankfurt_pgi + M models/atm/cam/test/system/tests_posttag_frankfurt + M models/atm/cam/test/system/tests_pretag_frankfurt_lahey + M models/atm/cam/bld/namelist_files + M models/atm/cam/src/control/camsrfexch.F90 + M models/atm/cam/src/cpl_share/cam_cpl_indices.F90 + M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 + M models/atm/cam/src/physics/cam/comsrf.F90 + M models/atm/cam/src/physics/cam/wv_sat_methods.F90 + M models/atm/cam/src/physics/cam/uwshcu.F90 + M models/atm/cam/src/dynamics + M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +040 bl366 TBL.sh f1.9c5clbdm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Jan 30 16:31:23 MST 2013 + - This is a new regression test for CLUBB. CLUBB was tested offline by both Cheryl Craig and Pete Bogenschutz. + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + + +Summarize any changes to answers, i.e.,: none + +=============================================================== +=============================================================== + +Tag name: cam5_2_08 +Originator(s): fischer +Date: Jan 25th, 2013 +One-line Summary: Remove SRFRAD, new diagnostics, chem preprocessor build, + update externals, fix dust_emis_fact + +Purpose of changes: + -Remove unneeded SRFRAD from the monthly averaged output + AMWG diagnostics uses SRFRAD to compute flwds, but FLDS can + used instead. + -New diagnostics added for aerosol burdens and weed speeds. + -Update to the chemistry preprocessor to recognize the intel + compiler on yellowstone. + -SVN externals updated to match cesm1_2_beta01 externals. + -dust_emis_fact was being set to .35 for CAM-SE5, should be set to .55 + + +Bugs fixed (include bugzilla ID): + -Bugzilla #1618, remove misleading SRFRAD variable + +Describe any changes made to build system: + -New information about the fc_type is being passed to the chemistry + preprocessor build scripts. This is to correct a problem with the + chem preprocessor not recognizing the intel compiler on yellowstone. + +Describe any changes made to the namelist: + -dust_emis_fact was being set to .35 instead of .55 when dyn="homme", tms="1", and + phys="cam5". The problem was there was a better match for the .35 value + than the .55 value. This was fixed by added tests for tms and phys to the + .55 value, making it the better match. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/archive_baseline.sh +. Set read permissions for archived files + +M models/atm/cam/test/system/tests_pretag_yellowstone +. Returned sm376, bl376, and ne996 test for the chemistry preprocessor + +M models/atm/cam/bld/Makefile.in +. Add flag for the intel compiler to ignore temp array creation + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Fixed bug where dust_emis_fact was being set to .35 instead of .55 for + CAM-SE 5 + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +. Removed SRFRAD from namelist + +M models/atm/cam/src/control/camsrfexch.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +. Removed srfrad. Moved calculation for netsw from camsrfexch to + the radiation_trend subroutines. + +M models/atm/cam/bld/configure +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm +. Add new argument fc_type to be passed to ChemPreprocess.pm. This is needed to + build on yellowstone using intel. + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +. Add new diagnostics variables for aerosol burdens and wind speeds. + +M SVN_EXTERNAL_DIRECTORIES +. Update externals to match cesm1_2_beta01 + clm tag updated to branch_tags/nmlfix_tags/nmlfix01_clm4_0_58 + pio tag updated to trunk_tags/pio1_5_7 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +049 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Fri Jan 25 09:54:03 MST 2013 +. expected since +testmech was broken on the previous tag + +084 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Fri Jan 25 10:32:33 MST 2013 +. answer changes expected for CAM_SE5 + + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + + +Summarize any changes to answers, i.e.,: all bfb, except CAM-SE using cam5 + physics. + +=============================================================== +=============================================================== + +Tag name: cam5_2_07 +Originator(s): santos +Date: Jan 23, 2012 +One-line Summary: HOMME update, move repro_sum_mod, WACCM-SE + +Purpose of changes: + + - Update CESM externals. + - Note: "setup" has been renamed to "cesm_setup", and + "env_pesetup.xml" has been renamed back to "env_mach_pes.xml" + - csm_share updated for to get working (and recently + improved!) shr_reprosum_mod. + - During debugging, updated the driver, Machines, and scripts. + While this was unnecessary, these were verified BFB, so + were updated anyway. + - RTM had to be updated for the driver update. build_namelist + had to be updated due to RTM namelist changes. Note that + standalone CAM has RTM off by default, so no answer changes. + + - Update HOMME external (and make changes to interface layer + to accomodate this). + - Add changes that were waiting on this update: + - repro_sum_mod is deleted, and modules now use + shr_reprosum_mod from csm_share + - New routine and first namelist options for WACCM-SE + (WACCM+HOMME, still under development). + - Fix WACCM5 restart test that fails since cam5_2_05 (diagnostic + variables were not being initialized above top_lev, so random + unused garbage above that level was in the output files). + - Fix HOMME settings for ne120np4. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Replace do_rtm = .false. with rtm_mode = "NULL", for RTM update. + + - Standalone CAM still allows modification of reprosum module + options, but these are now written to a driver namelist. + + - New HOMME settings for ne120np4. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/src/utils/repro_sum_x86.c +D models/atm/cam/src/utils/repro_sum_mod.F90 + - Eliminated in favor of shr_reprosum_mod in csm_share. + +List all subroutines added and what they do: + +A models/atm/cam/src/dynamics/homme/gravity_waves_sources.F90 + - New module with HOMME-compatible frontogenesis calculation + (for WACCM). + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Update driver, RTM, csm_share, scripts, Machines, and HOMME. + +M models/atm/cam/bld/build-namelist + - Update for RTM with CAM standalone. + +M models/atm/cam/bld/configure + - Allow WACCM+HOMME configurations. + - Define NC=4 for new HOMME. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml + - WACCM-SE defaults for ne30np4. + - Specify which defaults in the use_cases are for fv only. + - Add ne30np4 data set for FWSC compset. + - Fix default parameters for ne120np4 resolution. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Move RTM and reprosum options (see above). + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 + - Remove use of shr_kind_r4 (cleanup). + +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/dynamics/fv/d2a3dikj.F90 +M models/atm/cam/src/dynamics/fv/fv_prints.F90 +M models/atm/cam/src/dynamics/fv/mean_module.F90 +M models/atm/cam/src/dynamics/fv/p_d_adjust.F90 +M models/atm/cam/src/dynamics/fv/par_xsum.F90 +M models/atm/cam/src/physics/cam/phys_gmean.F90 +M models/atm/cam/src/physics/cam/polar_avg.F90 + - Change use of repro_sum_mod to shr_reprosum_mod. + +M models/atm/cam/src/control/cam_comp.F90 + - Nullify pointers in module scope. + +M models/atm/cam/src/control/cam_restart.F90 + - Change dyn_in/dyn_out declarations to "intent(inout)" + (to preserve allocation of pointer components). + +M models/atm/cam/src/control/runtime_opts.F90 + - Remove processing of repro_sum_mod options. + +M models/atm/cam/src/dynamics/fv/ctem.F90 + - Put explicit limits on arrays in par_xsum call (leftover + cleanup from debugging, will be necessary for NAG). + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 + - Remove WACCM_PHYS "ifdef" statements in favor of equivalent + runtime switch in phys_control. + - When dynamic state changes arrive, this will also be used + to change allocation of frontgf/frontga. + +D models/atm/cam/src/physics/waccm/gravity_waves_sources.F90 +A models/atm/cam/src/dynamics/fv/gravity_waves_sources.F90 + - Moved FV-specific gravity_waves_sources from WACCM, since + this module is dycore-specific. + +M models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M models/atm/cam/src/dynamics/homme/stepon.F90 + - Add call to gravity_waves_sources for WACCM. + - HOMME update changes (see below). + - Check for negative temperatures in d_p_coupling and abort + with a debug message if any are found. + +M models/atm/cam/src/dynamics/homme/dyn_comp.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + - Change interface to HOMME for the updated version. + - Remove timelevel dimension from elem%state%Q. + - Add calls to Timelevel_Qdp to get Qdp-specific timelevel + index. + - Rename references to "cslam" to "fvm". + - Remove logic for deprecated or removed options. + - "leapfrog" scheme not supported. + - tracer_advection_formulation is now always + TRACERADV_TOTAL_DIVERGENCE. + - dyn_import_t and dyn_export_t are now created with pointer + components nullified. This means that they usually must be + "intent(inout)" arguments to maintain those pointers' + association. (Using "intent(out)" was already incorrect + Fortran, but still worked with most compilers.) + +M models/atm/cam/src/physics/cam/geopotential.F90 + - Changed arrays to assumed shape in order to prevent + creation of temporary copies (flagged by ifort). + +M models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - Change mistaken use of qin to qi (bug fix for + sub_column=.true., which is not yet turned on). + - Correct spelling of "heterogeneous". + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Initialize diagnostic output above top_lev (prevents + garbage from being output above top_lev in WACCM5). + +M models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Pure cleanup changes. + +M models/atm/cam/src/physics/waccm/qbo.F90 + - Removed unused FV-specific dependencies. QBO forcing does + not currently work with HOMME, but removing these dependencies + is necessary for the module to be compiled in a HOMME case. + +M models/atm/cam/test/system/archive_baseline.sh + - New script for archiving CAM regression test baselines on + current testing machines. + +M models/atm/cam/test/system/TCB_ccsm.sh + - Update for CESM scripts. + +M models/atm/cam/test/system/test_driver.sh + - Remove "impi" module on yellowstone, as MPICH is supposedly + faster. + +M models/atm/cam/tools/interpic_new/Makefile + - Add ifort and make it default compiler (so that interpic_new + can be used on yellowstone out-of-the-box). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + - All baselines using the HOMME dycore are expected to fail due to + the updated external. + - All baselines for cases that used repro_sum_mod are expected to + fail due to updates to the csm_share version. + - In practice, this means HOMME cases (which would fail baseline + tests anyway), and most FV cases. + +yellowstone/intel: + +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Jan 11 03:02:02 MST 2013 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Fri Jan 11 03:05:43 MST 2013 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Jan 11 03:20:21 MST 2013 +026 bl334 TBL.sh f4adh fv2d_8tsk 9s .......................................FAIL! rc= 7 at Fri Jan 11 03:21:51 MST 2013 +030 bl335 TBL.sh f4idm idphys 9s ..........................................FAIL! rc= 7 at Fri Jan 11 03:23:22 MST 2013 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri Jan 11 03:26:27 MST 2013 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Fri Jan 11 03:34:40 MST 2013 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Jan 11 04:04:58 MST 2013 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Jan 11 05:03:22 MST 2013 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Jan 11 05:07:13 MST 2013 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Jan 11 05:18:56 MST 2013 +052 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Fri Jan 11 05:55:46 MST 2013 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Jan 11 06:24:36 MST 2013 +057 bl440 TBL.sh fsoa1.9c4dh outfrq3s+mozart_megan_emis 9s ................FAIL! rc= 7 at Fri Jan 11 07:01:50 MST 2013 +061 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Fri Jan 11 07:10:08 MST 2013 +064 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Fri Jan 11 07:12:28 MST 2013 +067 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Fri Jan 11 07:50:50 MST 2013 +070 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Fri Jan 11 08:00:33 MST 2013 +073 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Fri Jan 11 08:18:07 MST 2013 +079 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 7 at Fri Jan 11 08:27:19 MST 2013 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Fri Jan 11 08:59:27 MST 2013 + + +bluefire: Most tests run with identical results to yellowstone, but machine + is being retired + +frankfurt/lf95: + +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Jan 10 19:06:24 MST 2013 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Jan 10 21:55:34 MST 2013 +027 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Thu Jan 10 22:07:33 MST 2013 +030 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 10 22:37:52 MST 2013 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Jan 10 23:01:07 MST 2013 +035 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Thu Jan 10 23:23:40 MST 2013 + +frankfurt/pgi: + +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Jan 10 18:03:55 MST 2013 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Jan 10 18:32:55 MST 2013 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Thu Jan 10 18:37:10 MST 2013 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 10 18:44:21 MST 2013 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Thu Jan 10 18:49:26 MST 2013 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Jan 10 18:54:43 MST 2013 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 10 19:02:42 MST 2013 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Thu Jan 10 19:08:34 MST 2013 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Thu Jan 10 19:11:07 MST 2013 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Thu Jan 10 19:14:42 MST 2013 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Thu Jan 10 19:30:33 MST 2013 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Thu Jan 10 20:02:34 MST 2013 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Thu Jan 10 21:02:17 MST 2013 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: HOMME and FV dycores +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff (due to shr_reprosum_mod and HOMME) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + - Testing of shr_reprosum_mod and HOMME output outside of CAM. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_06 +Originator(s): fischer +Date: Dec 10 2012 +One-line Summary: bug fix for yellowstone + +Purpose of changes: +. Use cam erfc function in modal_aero_rename.F90 instead + of intrinsic erfc function. This is to get around an error + on yellowstone. +. Change the queue name for the yellowstone test build + script from caldera go gpgpu. This will give you a + dedicated node on caldera, instead of sharing a node. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +. Changed caldera queue to gpgpu to get a dedicate node on caldera to do + the pre builds. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +. Use cam erfc function instead of intrinsic erfc. Will cause answer + changes for cam5. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Sat Dec 8 00:08:12 MST 2012 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Sat Dec 8 00:12:07 MST 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Sat Dec 8 00:36:50 MST 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Sat Dec 8 00:59:45 MST 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Sat Dec 8 01:43:28 MST 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Sat Dec 8 03:51:51 MST 2012 +052 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Sat Dec 8 05:48:46 MST 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Sat Dec 8 07:04:02 MST 2012 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Sat Dec 8 11:29:06 MST 2012 +. cam5 baselines expected to fail + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Dec 10 08:29:36 MST 2012 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Dec 10 08:29:39 MST 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Mon Dec 10 08:29:51 MST 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Dec 10 08:30:00 MST 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Dec 10 08:30:26 MST 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Dec 10 08:30:45 MST 2012 +054 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Mon Dec 10 09:54:35 MST 2012 +056 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Dec 10 10:29:45 MST 2012 +084 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Mon Dec 10 11:32:58 MST 2012 +. cam5 baselines expected to fail + +frankfurt/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 5 at Mon Dec 10 08:32:42 MST 2012 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Mon Dec 10 08:32:57 MST 2012 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Mon Dec 10 08:32:57 MST 2012 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 5 at Mon Dec 10 08:33:11 MST 2012 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 5 at Mon Dec 10 08:33:25 MST 2012 +032 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 5 at Mon Dec 10 08:33:39 MST 2012 +. cam5 baselines expected to fail + +frankfurt/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 5 at Fri Dec 7 14:51:27 MST 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Fri Dec 7 14:57:45 MST 2012 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 5 at Fri Dec 7 15:01:36 MST 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Fri Dec 7 15:05:51 MST 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 5 at Fri Dec 7 15:21:43 MST 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 5 at Fri Dec 7 15:50:54 MST 2012 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 5 at Fri Dec 7 16:21:03 MST 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 5 at Fri Dec 7 16:28:08 MST 2012 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 5 at Fri Dec 7 16:33:12 MST 2012 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 5 at Fri Dec 7 16:35:52 MST 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 5 at Fri Dec 7 16:40:07 MST 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 5 at Fri Dec 7 16:55:40 MST 2012 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 5 at Fri Dec 7 17:26:16 MST 2012 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 5 at Fri Dec 7 18:26:50 MST 2012 +. cam5 baselines expected to fail + + +=============================================================== +=============================================================== + +Tag name: cam5_2_05 +Originator(s): andrew, morrison, santos +Date: Dec 6, 2012 +One-line Summary: New "MG1.5" microphysics scheme + +Purpose of changes: + - Added new microphysics scheme 'mg1.5', the next development + version of the Morrison & Gettelman stratiform cloud microphysics. + +Bugs fixed (include bugzilla ID): + - Bug 1600: CARMA cirrus model fails in build_namelist in cam5_2_02 + - This bug was introduced in cam5_2_02, when the name of wvsat_scheme + was changed to wv_sat_scheme. The name was not changed in the + add_default call in build_namelist, so the cirrus model would not + build. + +Describe any changes made to build system: + - Added mg1.5 option to -microphys configure option. + +Describe any changes made to the namelist: + - Added micro_mg_version and micro_mg_sub_version (MG version numbers). + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/micro_mg1_5.F90 + - Alternative microphysics related to micro_mg.F90 + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist + - Add micro_mg_version and micro_mg_sub_version to + represent the version number of MG. + - Fix bug with CARMA cirrus model and wv_sat_scheme. + +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure + - Added "mg1.5" as valid option for -microphys. + - "mg" is preserved as an alias for the old microphysics (which + is now "mg1"). + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add version number for MG. + - Added 1.9x2.5 MG1.5 defaults for cldfrc_rhminl and uwshcu_rpen. + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - Initialize pointers in derived types to null (bug fix for + gfortran, courtesy jedwards). + +M models/atm/cam/src/control/history_defaults.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +M models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +M models/atm/cam/src/physics/rrtmg/oldcloud.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/slingo.F90 + - Remove unused (or unnecessary) microp_scheme variable. + +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +M models/atm/cam/src/physics/cam/conv_water.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +M models/atm/cam/src/physics/cam/radiation_data.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Files that did not need to be changed, but retain "cleanup" + or stylistic changes due to changes to microp_scheme in a + previous stage. + +D models/atm/cam/src/physics/cam/micro_mg.F90 +A models/atm/cam/src/physics/cam/micro_mg1_0.F90 + - File moved to emphasize place within series. + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 + - Added MG1.5 call, uniform use of top_lev. + +M models/atm/cam/src/physics/cam/stratiform.F90 + - stratiform_implements_cnst now always returns .false. + if microp_scheme is not RK. + +M models/atm/cam/src/physics/cam/wv_sat_methods.F90 + - "save" attribute is now global. + - Added qsat methods (non-optional logic from wv_saturation). + +M models/atm/cam/src/physics/cam/wv_saturation.F90 + - Moved qsat_water/ice logic to wv_sat_methods. + +A models/atm/cam/test/system/config_files/f1.0c5mg1_5m +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_posttag_frankfurt + - Add test for mg1.5. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Thu Dec 6 11:46:02 MST 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Thu Dec 6 12:14:45 MST 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Thu Dec 6 12:37:43 MST 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Thu Dec 6 13:22:20 MST 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Thu Dec 6 15:04:19 MST 2012 +052 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Thu Dec 6 17:01:20 MST 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Dec 6 18:17:04 MST 2012 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Thu Dec 6 22:51:13 MST 2012 + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Thu Dec 6 16:46:46 MST 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Thu Dec 6 16:46:54 MST 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Thu Dec 6 16:47:01 MST 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Thu Dec 6 16:47:15 MST 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Thu Dec 6 16:47:27 MST 2012 +054 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Thu Dec 6 16:48:09 MST 2012 +056 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Dec 6 16:48:39 MST 2012 +084 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Thu Dec 6 19:44:23 MST 2012 + +frankfurt/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Dec 5 14:13:13 MST 2012 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Dec 5 15:07:40 MST 2012 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Dec 5 15:15:56 MST 2012 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Dec 5 16:24:19 MST 2012 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Dec 5 20:24:51 MST 2012 + +frankfurt/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Dec 5 13:28:35 MST 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Dec 5 13:38:17 MST 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Dec 5 13:50:04 MST 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Dec 5 14:08:13 MST 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Dec 5 14:44:06 MST 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Dec 5 15:25:27 MST 2012 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Wed Dec 5 15:33:30 MST 2012 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Wed Dec 5 15:37:02 MST 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Wed Dec 5 15:42:24 MST 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Dec 5 16:06:10 MST 2012 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Wed Dec 5 16:50:56 MST 2012 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Wed Dec 5 18:16:15 MST 2012 + + - On all systems, CAM5 baselines were expected to fail due to a change in + diagnostic output. Outside of this output, the model is bit-for-bit. + + - The changes are in these variables: AREI AREL AWNC AWNI FREQI FREQL + + - The only difference is that these variables are now scaled by the + cloud fraction (liquid or ice, as appropriate). + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name:cam5_2_04 +Originator(s): fischer +Date: Tue Dec 5 14:54:12 MST 2012 +One-line Summary: merge in changes from the release tag, yellowstone testing +support + +Purpose of changes: +. Merge in changes from release branch tag + - update for mozart_megan_emis.xml + - cam-se topo tools from Peter L. + - Support for SCAM running from cesm script fixed + - Changed QNEG3 lchnk format from i5 to i7 + - EMIS addfld bug fix +. Fix fincl6lonlat namelist bug +. Support to run cam's test suite on yellowstone. + - test_driver.sh first submits a build script to + caldera to build all the needed exacutables. + - The a run script is submitted to yellowstone. + - There will be 2 td.*.status files, the first + is for the builds, the second is for the runs. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: +A models/atm/cam/test/system/TNE_cb_ccsm.sh +A models/atm/cam/test/system/TBL_cb.sh +A models/atm/cam/test/system/TSC_cb.sh +A models/atm/cam/test/system/TBL_cb_ccsm.sh + - script needed to do all pre builds, only used on yellowstone at this time. + +A models/atm/cam/test/system/tests_pretag_yellowstone +A models/atm/cam/test/system/tests_posttag_yellowstone + - New test lists for yellowstone, the same as bluefire test lists, + except for +testmech tests were removed + +A models/atm/cam/tools/topo_tool + - topography generation tools + +A models/atm/cam/bld/namelist_files/use_cases/arm95_scam.xml + - use case need to run SCAM with cesm scripts + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TCB_ccsm.sh + - Change pes layout for yellowstone + +M models/atm/cam/test/system/test_driver.sh + - Added ability to read in an existing test list and build + everthing that's needed. Only used on yellowstone. + +M models/atm/cam/test/system/CAM_runcmnd.sh + - updated to run on yellowstone + +M models/atm/cam/src/control/runtime_opts.F90 + - Add fincl6lonlat + +M models/atm/cam/bld/Makefile.in + - set rules to build dyn_grid.F90 due to mpich2 v1208 bug + - added rpath to LIB_NETCDF to build test_nc + +M models/atm/cam/bld/namelist_files/use_cases/mozart_megan_emis.xml + - updated + +M models/atm/cam/doc/ChangeLog_template + - Add yellowstone/intel to testing results + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 + - Fixes to run SCAM with cesm scripts + +M models/atm/cam/src/physics/cam/qneg3.F90 + - Changed QNEG3 lchnk format from i5 to i7 + +M models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 + - Removed old comments + +M SVN_EXTERNAL_DIRECTORIES + - Updated externals to match cesm1_1_beta18. Machines and scripts tags were + updated to newer version to get yellowstone support. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +yellowstone/intel: + All TBL tests failed because previous tag didn't fully support yellowstone. + +bluefire: +059 bl440 TBL.sh fsoa1.9c4dh outfrq3s+mozart_megan_emis 9s ................FAIL! rc= 7 at Sat Dec 1 20:34:10 MST 2012 + update to megan emis use case + +frankfurt/lf95: + all passed + +frankfurt/pgi: + all passed + +Summarize any changes to answers, i.e., + +=============================================================== +=============================================================== + +Tag name: cam5_2_03 +Originator(s): fvitt +Date: 26 Nov 2012 +One-line Summary: Chemistry change and fix for WACCM5 + +Purpose of changes: + + - correction to trop_strat_mam3 chemistry (removed NH4NO3) + - correction in RRTMG radiation code for WACCM5 + - a workaround for OpenMP problem in SC-WACCM when compiled with + intel compiler (yellowstone) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure + - reduced number of advected tracers for trop_strat_mam3 chemistry package + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - changed default IC file for trop_strat_mam7 chemistry + +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml + - added IC file for WACCM5 at 4x5 resolution + +M models/atm/cam/src/physics/rrtmg/radsw.F90 + - corrections WACCM5 + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - a workaround for OpenMP problem in SC-WACCM when compiled with intel compiler + - corrections to reading of zonal-averaged input data which applies only to + varied arrangment of data dimensions in input file + +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in + - removed NH4NO3 from chemical mechanism + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +054 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Thu Nov 15 16:27:37 MST 2012 +expected failure due to correction to trop_strat_mam3 chemistry package + +frankfurt/lf95: all pass + +frankfurt/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_02 +Originator(s): santos +Date: Nov 9, 2012 +One-line Summary: Refactoring of wv_saturation module + +Purpose of changes: + - Refactoring of wv_saturation: + - Consolidate routines in wv_saturation. + - Pull in related logic from other modules to wv_saturation. + - Create wv_sat_methods to hold SVP estimation methods separately + from interface logic. + - Update interfaces throughout CAM to match. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - Changed wvsat_scheme in phys_control to wv_sat_scheme in + wv_saturation. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/src/physics/cam/esinti.F90 + - Removed in favor of wv_sat_init in wv_saturation. +D models/atm/cam/src/physics/cam/gffgch.F90 + - Moved to gffgch_legacy in wv_saturation, in anticipation of + it being phased out. + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/wv_sat_methods.F90 + - Contains the basic formulae used to calculate SVP, and + simple lookup routines for finding them. + - Contains the basic formulae to convert SVP to saturation + specific humidity and saturation mass mixing ratio. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Moved wvsat_scheme to wv_sat_scheme in wv_sat_nl. + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/hk_conv.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/ndrop_bam.F90 +M models/atm/cam/src/physics/cam/nucleate_ice.F90 +M models/atm/cam/src/physics/cam/radae.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 + - Changed calls to qsat/qsat_water/qsat_ice and/or legacy svp + functions to match new interface. + +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/micro_mg.F90 + - Change svp calls to match new interface. + - Now get gamma and svp functions through use statement + rather than having them passed in. + - micro_mg.F90 uses portable layer rather than wv_saturation. + +M models/atm/cam/src/chemistry/mozart/mo_aerosols.F90 + - Removed unnecessary dependence on wv_saturation. + +M models/atm/cam/src/control/physconst.F90 + - Added the triple point of water as h2otrip (used from + csm_share, equivalent to triple point already used in + polysvp). + - Removed unused variables. + +M models/atm/cam/src/control/runtime_opts.F90 + - Add wv_saturation's namelist. + +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 + - Change dependencies on wv_saturation to dependencies on + physconst. + - Move findsp to wv_saturation. + - Change interface of qsat/svp calls. + - uwshcu gets qsat through use statement rather than as + an argument. + +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/utils/cam_aqua/shr_flux_mod.F90 + - Trivial cleanup unrelated to wv_saturation (e.g. removal of + unused dependencies, comment typos). + +M models/atm/cam/src/physics/cam/phys_control.F90 + - Remove wvsat_scheme. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Call init/final for wv_saturation module. + - Move some "use" statements around to deal with a PGI bug + for large modules. + +M models/atm/cam/src/physics/cam/wv_saturation.F90 + - Completely refactored. A list of public routines: + - Control routines, replacing esinti and other CAM logic: + - wv_sat_readnl + - wv_sat_init + - wv_sat_final + - SVP calculations, replacing polysvp: + - svp_water + - svp_ice + - SVP table lookup, largely unchanged: + - estblf + - SVP to saturation specific humidity conversion: + - svp_to_qsat + - SVP to saturation mass mixing ratio conversion: + - svp_to_qmmr + - Saturation specific humidity functions, replacing all + subroutines of the form [a,v]qsat[d[2]][_single] + - qsat + - qsat_water + - qsat_ice + - Wet bulb temperature solver, replacing findsp[_water]: + - findsp_vc + - "Legacy" routines, included only to preserve answers: + - gffgch_legacy, gffgch_legacy_water + - qsat_water_legacy + - qmmr_zm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +frankfurt/lf95: All PASS + +frankfurt/pgi or jaguar/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_2_01 +Originator(s): eaton +Date: Mon Oct 29 10:42:35 MDT 2012 +One-line Summary: build changes for yellowstone; remove LCLOUD from default hist output + +Purpose of changes: + +. Made mods to configure and Makefile.in to account for new compiler + wrappers used on yellowstone. +. Made some changes to the MCT build part of CAM's configure to allow + trapping the error return from the MCT configure script. +. Modified the Makefile rules used by configure's -test option so they work + with the recent changes to build MCT as a separate lib. +. Remove LCLOUD from the default history output. It is only used by the + stratus cloud activation, and is not the same as the fraction of liquid + stratus which is available as LIQCLDF (but is not output by default). +. Move the addfld/outfld calls for AST, LIQCLDF, ICECLDF from micro_mg_cam + to macrop_driver since these fields are computed by the macrophysics. + +Bugs fixed (include bugzilla ID): + +. fix addfld call for EMIS in cam5 radiation (rrtmg). + +Describe any changes made to build system: + +. mods for yellowstone and MCT build as noted above + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/configure +. set default CC to mpicc when mpif90 is the fortran compiler +. fix the check for the return status of the MCT configure command + +models/atm/cam/bld/Makefile.in +. fix the rules for building test_fc and test_nc by removing the + specification of $(LDFLAGS). Now that we build MCT as a separate lib, + these rules were failing because LDFLAGS contains -lmct which doesn't + exist yet. Similar fixes for test_mpi and test_esmf. Had to add + $(FFLAGS) to the link commands to pick up the OpenMP flags that + are in the $(LDFLAGS) macro which was removed. + +models/atm/cam/src/physics/cam/microp_aero.F90 +. add addfld/outfld call for LCLOUD (moved from ndrop). Modify long_name + to 'Liquid cloud fraction used in stratus activation' + +models/atm/cam/src/physics/cam/ndrop.F90 +. move addfld call for LCLOUD to microp_aero.F90 and remove the add_default + and outfld calls. + +models/atm/cam/src/physics/cam/macrop_driver.F90 +. add addfld/outfld calls for AST, LIQCLDF, ICECLDF + +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +. remove addfld/outfld calls for AST, LIQCLDF, ICECLDF (move to + macrop_driver) + +models/atm/cam/src/physics/cam/rrtmg/radiation.F90 +. fix addfld call for EMIS. change number of levels from 1 to plev, and + changed default averaging from 'I' to 'A' + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +frankfurt/lf95: All PASS + +frankfurt/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_2_00 +Originator(s): fischer eaton +Date: Tue Oct 9 13:36:42 MDT 2012 +One-line Summary: namelist updates, bug fixes + +Purpose of changes: + +. In cam_diagnostics.F90, the default diagnostic that dqcond is used to + compute is only written to the history file for 1 constituent (specific + humidity). The memory for the other pcnst-1 constituents is allocated and + set but not used. In the case where the diagnostic is written for all + pcnst constituents the data structure was modified to avoid index addresses + that don't fit into 32 bit integers. + +. cam's configure script needed to be fixed to pass $mpi_inc and $mpi_lib to the + MCT configure script, when mpi_inc and mpi_lib are passed in from the configure + argument list. + +. update svn externals to match cesm1_1_alpha18g. + +. Namelist updates for waccmx, sd-waccm and homme. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. cam configure was updated to pass mpi_lib and mpi_inc, being + set by arguments to cam's configure, to MCT configure + +Describe any changes made to the namelist: +. set dust_emis_fact to .55 for homme +. set so2_emis_file for sd_waccm use_cases +. clm_rtm_inparm group moved to clm_inparm +. sim_year for waccmx_1996_cam4 changed to 2000 + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +. intel support on frankfurt + +M models/atm/cam/test/system/CAM_runcmnd.sh +. use mvapich mpirun for franfurt intel + +M models/atm/cam/bld/configure +. fix MCT configure to allow mpi_lib and mpi_inc to be set with argument to cam configure + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. set dust_emis_fact to .55 for homme + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. moved clm_rtm_inparm group to clm_inparm + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +. set so2_emis_file + +M models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml +. Changed sim_year from 1996 to 2000 + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. Data allocation fixed to avoid indexing addresses that don't fit into + 32-bit integers. +. Avoid allocating memory that's not used. + +M models/atm/cam/src/physics/cam/clubb_intr.F90 +. Changes to appease the intel compiler. + +M SVN_EXTERNAL_DIRECTORIES +. Changed externals to match cesm1_1_alpha18g + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + +=============================================================== +=============================================================== + +Tag name: cam5_1_44 +Originator(s): fischer, hannay, eaton +Date: Mon Oct 1 10:29:58 MDT 2012 +One-line Summary: SE/cam5 tuning mods; mods for SE in standalone mode; some code cleanup. + +Purpose of changes: + +. Add tuning mods for SE/cam5 configurations. Also add "tuned" topo + dataset for ne30np4. + +. Mods to CAM standalone build to support running SE in F compset + configurations (i.e., active land, thermodynamic cice, and data ocean). + Up to now the standalone build has only worked for SE running in + adiabatic, ideal physics, or aquaplanet configurations. + +. Some cleanup in the dynamics initialization layer. In particular remove + a bunch of dead code from the SE dynamics interfaces. + +. The attempt to access the initial file from the dyn_init routine created + a circular dependency. Accessing the initial file in the dyn_comp module + requires it to use startup_initialconds. But startup_initialconds + depends on dyn_comp because of the initial_conds method. Resolve this by + separating the code that opens the initial and topo files (and is not + dycore dependent) from the initial_conds routine which reads the initial + file and is dycore dependent. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. support for SE standalone scripts + +Describe any changes made to the namelist: + +. add some tuning parameters for SE + +List any changes to the defaults for the boundary datasets: + +. new default for ne16np4 and ne30np4 topo datasets +. new default for ne16np4 soil_erod dataset +. new defaults for SE grids for fsurdat, fatmlndfrc, bndtvs, focndomain + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/control/binary_io.F90 +. remove unused file + +models/atm/cam/src/dynamics/homme/commap.F90 +. eliminate this file. move module data to dyn_grid + +List all subroutines added and what they do: + +models/atm/cam/src/control/cam_initfiles.F90 +. new file that contains just the routines from startup_initialconds that + were responsible for open/close of initial and topo files, and provide + accessor functions for the filehandles. + - rename setup_initial -> cam_initfiles_open + - rename close_initial_file -> cam_initfiles_close + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add bndtvs_domain to docn stream txt file +. remove unused code for csim4 +. add defaults for nu_p, nu_div, hypervis_subcycle, hypervis_subcycle_q + +models/atm/cam/bld/configure +. mod to run mct configure in quiet mode unless cam configure is in verbose + mode + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add defaults for SE/cam5 + 5.0 + 1.0e15 + 0.0 + 1.0e15 + 25.e14 + 2 + 1 + -1 + 1 +. add ne16np4 topo dataset +. update ne30np4 topo dataset +. add ne16np4 soil_erod dataset +. add se datasets (ne16,30,60,120,240) for fsurdat for 1850 and 2000 +. add se datasets (ne16,30,60,120,240) for fatmlndfrc +. add se datasets (use 1x1 HadOIBl) for bndtvs for 1850, 2000, and + 1850-2000 +. add se dataset for bndtvs_domain +. add se datasets for focndomain + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add bndtvs_domain +. add nu_p, nu_div, hypervis_subcycle, hypervis_subcycle_q + +models/atm/cam/src/control/startup_initialconds.F90 +. leave behind just the subroutine initial_conds. This code should + eventually move to the dycore interfaces. + +models/atm/cam/src/dynamics/homme/dyn_comp.F90 +. move dynamics initialization code out of cam_initial and into dyn_init1 + +models/atm/cam/src/dynamics/homme/dyn_grid.F90 +. add coordinate/weights arrays from commap +. remove refs to commap + +models/atm/cam/src/dynamics/homme/interp_mod.F90 +. move reference to w from commap to dyn_grid + +models/atm/cam/src/dynamics/homme/inital.F90 +. move dynamics initialization stuff out of cam_initial and into dyn_init1 + +models/atm/cam/src/dynamics/homme/initcom.F90 +. Tried to remove this file but initcom is called from cam_read_restart. + That should be moved to a dycore specific spot since initcom is dycore + specific. For now just moved the contents to dyn_init1 and left a stub. + +models/atm/cam/src/dynamics/homme/spmd_dyn.F90 +. remove unused routines spmd_dyn_defaultopts, spmd_dyn_setopts, + spmdinit_dyn, compute_gsfactors +. remove unused module data + +models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +. remove unused reference to binary_io module + +models/atm/cam/src/dynamics/eul/inital.F90 +models/atm/cam/src/dynamics/fv/inital.F90 +models/atm/cam/src/dynamics/homme/inital.F90 +models/atm/cam/src/dynamics/sld/inital.F90 +. remove call to setup_initial (which has been renamed cam_initfiles_open) + -- move it to cam_comp::cam_init. Opening files is not dycore specific + and shouldn't be buried in dycore specific code. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +072 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Sun Sep 30 18:09:05 MDT 2012 +075 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Sun Sep 30 18:27:18 MDT 2012 +084 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Mon Oct 1 08:58:46 MDT 2012 + +frankfurt/lf95: All PASS + +frankfurt/pgi: All PASS except: +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Sat Sep 29 20:57:00 MDT 2012 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Sat Sep 29 22:11:40 MDT 2012 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for SE configurations due to +new datasets and tuning parameters. + +=============================================================== +=============================================================== + +Tag name: cam5_1_43 +Originator(s): santos, joemci, bardeenc +Date: Sept 27, 2012 +One-line Summary: WACCM-X use_case, CARMA dust, RTM in standalone builds + +Purpose of changes: + - Add use_case for WACCM-X solar minimum conditions. + - Add CARMA dust model. + - Allow CAM standalone builds to build RTM and new CLM. + - Add rof externals. + - Update CARMA external (bug fix). + - Update other externals (to alpha18e or higher). + - Clean up CARMA models. + - Clean up residual issues after CLUBB commit. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + - Add build of ROF in standalone CAM. + +Describe any changes made to the namelist: + - Add options for CARMA dust model. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/waccmx_1996_cam4.xml + - use_case containing solar minimum (1996) conditions for WACCM-X. + +A models/atm/cam/src/physics/carma/models/dust/ +A models/atm/cam/src/physics/carma/models/dust/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/dust/carma_model_mod.F90 +M models/atm/cam/test/system/config_files/f1.9c5carmdusm + - New CARMA dust model. + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - Update externals, add rof. + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Update CARMA external with bug fixes. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - Add rof for CAM standalone builds. + - Add CARMA dust model options. + +M models/atm/cam/src/control/camsrfexch.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_share/cam_cpl_indices.F90 +M models/atm/cam/src/physics/cam/comsrf.F90 + - Add volumetric soil water (soilw) to coupling from CLM, for CARMA dust. + +M models/atm/cam/src/physics/cam/clubb_intr.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Bug fixes and cleanup from previous tag (CLUBB commit). + +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 + - Use gamma from gamma_function, move igamma to gamma_function. + +M models/atm/cam/src/utils/gamma_function.F90 + - Update gamma function and make it pure. + - Cleanup older code (e.g. remove goto statements). + - Add "igamma", the upper incomplete gamma function. + +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_carma +M models/atm/cam/test/system/tests_posttag_bluefire + - Add tests for CARMA dust, new WACCM-X use_case. + - Currently testing solar min in posttag, rather than solar max. + - Change E compset to ETEST, for new docn/scripts compatibility. + +M models/atm/cam/test/system/TCB_ccsm.sh + - Add rof to build. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + - All cases with chemistry impacted by dust fluxes have answer changes. + +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Sat Sep 29 13:14:57 MDT 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Sat Sep 29 13:15:10 MDT 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Sat Sep 29 13:15:19 MDT 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Sat Sep 29 13:15:43 MDT 2012 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Sat Sep 29 13:16:26 MDT 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Sat Sep 29 13:16:44 MDT 2012 +049 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Sat Sep 29 13:17:25 MDT 2012 +054 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Sat Sep 29 13:18:42 MDT 2012 +056 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Sat Sep 29 13:19:37 MDT 2012 +059 bl440 TBL.sh fsoa1.9c4dh outfrq3s+mozart_megan_emis 9s ................FAIL! rc= 7 at Sat Sep 29 13:20:22 MDT 2012 +081 bl992 TBL_ccsm.sh f19_g16 ETEST 2d ....................................FAIL! rc= 5 at Sat Sep 29 13:20:29 MDT 2012 +084 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Sat Sep 29 15:09:30 MDT 2012 + +frankfurt/lf95: + - All cases with chemistry impacted by dust fluxes have answer changes. + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Sat Sep 29 13:49:45 MDT 2012 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Sat Sep 29 13:49:51 MDT 2012 +013 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Sat Sep 29 13:49:58 MDT 2012 +017 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Sat Sep 29 13:50:05 MDT 2012 +025 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Sat Sep 29 13:51:43 MDT 2012 + +frankfurt/pgi or jaguar/pgi: + - All cases with chemistry impacted by dust fluxes have answer changes. + +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Sep 28 10:44:50 MDT 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Sep 28 11:17:22 MDT 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Sep 28 11:51:00 MDT 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Sep 28 12:45:56 MDT 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Sep 28 13:57:40 MDT 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Sep 28 16:05:53 MDT 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Fri Sep 28 16:42:32 MDT 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Fri Sep 28 17:29:37 MDT 2012 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + - Most active chemistry and CARMA cases. +- what platforms/compilers: + - All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - Larger than roundoff, same climate. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_42 +Originator(s): cacraig, bogenschutz, eaton, santos, edwards +Date: 09/26/12 +One-line Summary: CLUBB and two minor changes for trunk + +Purpose of changes: + +- Introduction of CLUBB onto CAM trunk. CLUBB (Cloud Layers Unified by Bi-normals) is a + higher-order turbulence closure centered around an assumed double Guassian PDF. It is + a unified parameterization in that it returns tendencies due to PBL, shallow convection, + and cloud macrophysical processes. This unified moist turbulence parameterization + uses multivariate PDFs to predict moments to generate shallow and stratiform clouds + that are then passed to the microphysics. + + Reference: Bogenschutz, P. A., Gettelman, A., Morrison, H., Larson, V. E., Schanen, D. P., + Meyer, N. R., and Craig, C.: Unified parameterization of the planetary boundary layer and + shallow convection with a higher-order turbulence closure in the community atmosphere + model: single column experiments, Geosci. Model Dev. Discuss., 5, 1743-1780, doi:10.5194/gmdd-5-1743-2012 + +- Removed CONCLDQL from pbuf as it was only written and never read + +- bug fix to sat_hist (edwards) + +- addition of carma_inparm namelist (santos) + +Bugs fixed (include bugzilla ID): +1547: CAM dies trying to writ out N-dimensional fields to the "satellite" history file + - fixed in sat_hist.F90 + +Describe any changes made to build system: +- Introduced clubb_sgs flag as a configure option to turn on CLUBB + +Describe any changes made to the namelist: +- Introduced in phys_ctl_nl + macrop_scheme - character, valid values are "rk, park, clubb_sgs, none" + do_clubb_sgs - logical, if true, turns on CLUBB_SGS +- Added option CLUBB_SGS to shallow_scheme and eddy_scheme +- Introduced in cam_inparm + scm_clubb_iop_name - character, IOP name for CLUBB running in single column mode +- Introduced clubb namelist "clubb_his_nl" with variables: + clubb_history - logical, if true, output CLUBB history statistics + clubb_rad_history - logical, if true, output CLUBBs radiative history statistics +- Introduced clubb namelist "clubb_stats_nl" with variables: + clubb_vars_zt - character, same as fincl1, but for CLUBB statistics on zt grid + clubb_vars_zm - character, same as fincl1, but for CLUBB statistics on zm grid + clubb_vars_rad_zt - character, same as fincl1, but for CLUBB statistics on radiation zt grid + clubb_vars_rad_zm - character, same as fincl1, but for CLUBB statistics on radiation zm grid + clubb_vars_src - character, same as fincl1, but for CLUBB statistics on surface + clubb_iop_name - character, name of the IOP case for adjustments within CLUBB +- Moved from vert_diff_nl to phys_ctl_nl + do_tms +- Moved from vert_diff_nl to physconst_nl + tms_orocnst, tms_z0fac +- Introduced carma namelist "carma_inparm" with variables: + carma_fields - character, list of fluxes needed by the CARMA model from CLM to CAM + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: none +A + models/atm/cam/src/physics/cam/clubb_intr.F90 + - Interface module between CLUBB and CAM + +A + models/atm/cam/src/physics/CLUBB_core +A + models/atm/cam/src/physics/CLUBB_core/constants_clubb.F90 +A + models/atm/cam/src/physics/CLUBB_core/variables_prognostic_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/interpolation.F90 +A + models/atm/cam/src/physics/CLUBB_core/clip_explicit.F90 +A + models/atm/cam/src/physics/CLUBB_core/saturation.F90 +A + models/atm/cam/src/physics/CLUBB_core/mono_flux_limiter.F90 +A + models/atm/cam/src/physics/CLUBB_core/mixing_length.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_zm.F90 +A + models/atm/cam/src/physics/CLUBB_core/file_functions.F90 +A + models/atm/cam/src/physics/CLUBB_core/mean_adv.F90 +A + models/atm/cam/src/physics/CLUBB_core/grid_class.F90 +A + models/atm/cam/src/physics/CLUBB_core/pdf_closure_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_zt.F90 +A + models/atm/cam/src/physics/CLUBB_core/parameter_indices.F90 +A + models/atm/cam/src/physics/CLUBB_core/hyper_diffusion_4th_ord.F90 +A + models/atm/cam/src/physics/CLUBB_core/csr_matrix_class_3array.F90 +A + models/atm/cam/src/physics/CLUBB_core/input_reader.F90 +A + models/atm/cam/src/physics/CLUBB_core/parameters_model.F90 +A + models/atm/cam/src/physics/CLUBB_core/error_code.F90 +A + models/atm/cam/src/physics/CLUBB_core/lapack_wrap.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_rad_zm.F90 +A + models/atm/cam/src/physics/CLUBB_core/parameters_radiation.F90 +A + models/atm/cam/src/physics/CLUBB_core/mt95.f90 +A + models/atm/cam/src/physics/CLUBB_core/endian.F90 +A + models/atm/cam/src/physics/CLUBB_core/recl.inc +A + models/atm/cam/src/physics/CLUBB_core/parameters_microphys.F90 +A + models/atm/cam/src/physics/CLUBB_core/gmres_cache.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_rad_zt.F90 +A + models/atm/cam/src/physics/CLUBB_core/sigma_sqd_w_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/hydrostatic_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/array_index.F90 +A + models/atm/cam/src/physics/CLUBB_core/anl_erf.F90 +A + models/atm/cam/src/physics/CLUBB_core/T_in_K_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/calendar.F90 +A + models/atm/cam/src/physics/CLUBB_core/model_flags.F90 +A + models/atm/cam/src/physics/CLUBB_core/advance_windm_edsclrm_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/pos_definite_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/pdf_parameter_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/fill_holes.F90 +A + models/atm/cam/src/physics/CLUBB_core/sponge_layer_damping.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_variables.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_subs.F90 +A + models/atm/cam/src/physics/CLUBB_core/variables_radiation_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/numerical_check.F90 +A + models/atm/cam/src/physics/CLUBB_core/stat_file_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/input_names.F90 +A + models/atm/cam/src/physics/CLUBB_core/output_netcdf.F90 +A + models/atm/cam/src/physics/CLUBB_core/diffusion.F90 +A + models/atm/cam/src/physics/CLUBB_core/advance_wp2_wp3_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/advance_xm_wpxp_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/extrapolation.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_sfc.F90 +A + models/atm/cam/src/physics/CLUBB_core/surface_varnce_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/clip_semi_implicit.F90 +A + models/atm/cam/src/physics/CLUBB_core/clubb_core.F90 +A + models/atm/cam/src/physics/CLUBB_core/stats_type.F90 +A + models/atm/cam/src/physics/CLUBB_core/clubb_precision.F90 +A + models/atm/cam/src/physics/CLUBB_core/advance_helper_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/gmres_wrap.F90 +A + models/atm/cam/src/physics/CLUBB_core/Skw_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/parameters_tunable.F90 +A + models/atm/cam/src/physics/CLUBB_core/advance_xp2_xpyp_module.F90 +A + models/atm/cam/src/physics/CLUBB_core/output_grads.F90 +A + models/atm/cam/src/physics/CLUBB_core/variables_diagnostic_module.F90 + - CLUBB code + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +MM models/atm/cam/bld/build-namelist + - namelist changes described above + +M models/atm/cam/doc/ChangeLog + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/scamMod.F90 + - introduction of scm_clubb_iop_name + +M models/atm/cam/src/control/physconst.F90 + - physconst_nl now has tms_orocnst and tms_z0fac + +M models/atm/cam/src/control/sat_hist.F90 + - bug fix described above + +M models/atm/cam/src/dynamics/eul/iop.F90 + - shflx and sh are now mutually exclusive + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - Modifications to allow for QCWAT, TCWAT, ICWAT + and qpert possibly not being in pbuf + +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 + - aist_vector is now public + +M models/atm/cam/src/physics/cam/convect_deep.F90 + - modified deep_scheme_does_scav_trans logic to make + it more flexible + - jctop and jcbot are now initialized to non-zero values + +M models/atm/cam/src/physics/cam/convect_shallow.F90 + - moved qpert as it just exists in Hack scheme + - cnt2 and cnb2 are now initialized to non-zero values + - added CLUBB_SGS to possible cases for shallow_scheme + +M models/atm/cam/src/physics/cam/hb_diff.F90 + - pblintd is now public + +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M + models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M + models/atm/cam/src/physics/cam/microp_driver.F90 + - bug fix- energy conservation was giving off false alarms - non + answer changing. Removed rliq from microp to macro to be + considered for energy conservation + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Introduced logic for CLUBB_SGS + +M models/atm/cam/src/physics/cam/phys_control.F90 + - Added to phys_ctl_nl: macrop_scheme, do_clubb_sgs and do_tms + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Addition of CLUBB_SGS logic + - Modifications to allow for QCWAT, TCWAT, ICWAT + and qpert possibly not being in pbuf + - bug fix for energy conservation (see macrop_driver above for more details) + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Moved do_tms to phys_ctl_nl + - Moved tms_orocnst and tms_z0fac to physconst_nl + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +frankfurt/lf95: All PASS + +frankfurt/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: All BFB + +=============================================================== +=============================================================== + +Tag name: cam5_1_41 +Originator(s): cacraig, eaton +Date: Mon Sep 24 13:57:57 MDT 2012 +One-line Summary: cleanup in stratiform, macrop, microp modules; new namelist + +Purpose of changes: + +. Remove lots of unused code left over from the original cam5 development. + This was a consequence of the cam5 macro/micro physics being developed in + the stratiform module, and then later moved to separate macrop and + micro_mg modules. The result was code that's only needed for the cam5 + physics was left in the stratiform module, and code that's only needed for + cam4 physics was left in the macrop and micro_mg modules. + +. Move several pbuf_add calls to the modules that are responsible for + setting the pbuf field. + +. Add namelist group microp_aero_nl to the microp_aero module. Currently + just contains the variable microp_aero_bulk_scale which is a tuning + parameter for using bulk aerosols with the cam5 physics package. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add namelist group microp_aero_nl to the microp_aero module. Currently + just contains the variable microp_aero_bulk_scale which is a tuning + parameter for using bulk aerosols with the cam5 physics package. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/mcshallow.F90 +. not used + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. occasionally the serial builds were failing due to trying to compile the + pio_kinds.F90 before the mct build was finished. This fails because in + the serial build the mpi-serial lib is part of mct, and that build puts + the mpif.h file in the appropriate include directory. For now have added + a rule to make pio_kind.o depend on libmct.a. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add microp_aero_bulk_scale + +models/atm/cam/src/control/runtime_opts.F90 +. add call for microp_aero_readnl + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. add cldfrc_register for SH_FRAC, DP_FRAC + +models/atm/cam/src/physics/cam/conv_water.F90 +. remove refs to pbuf fields ALST, AIST, QLST, QIST -- not used +. remove ref to CONCLDQL -- not used + +models/atm/cam/src/physics/cam/eddy_diff.F90 +. fix logfile info that was written from all procs -- only write from + masterproc +. replace 'stop' statements by calls to endrun + +models/atm/cam/src/physics/cam/macrop_driver.F90 +. Remove RHDFDA and RHU00 from pbuf and local vars. Only used in cam4 + physics. +. Remove the second call to cldfrc which was only used for the rhdfda + calculation. +. remove addfld/outfld for CNVCLD -- no longer used +. remove calls to add SH_FRAC, DP_FRAC to pbuf. Now done in + cldfrc_register. +. remove pbuf_add calls for TINI, QINI, CLDLIQINI, CLDICEINI. Now done in + phys_register. +. remove access of QME -- not used +. remove pbuf_add for CC_* variables -- moved to micro_mg_cam. Replace + with pbuf_get_index calls for those variables. + +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +. remove REL2, REI2, DEICONV, MUCONV, LAMBDACONV from pbuf. Not used. +. add initializer for CLDO. +. add pbuf_add for CC_* variables; also add initializers. + +models/atm/cam/src/physics/cam/microp_aero.F90 +. add microp_aero_readnl, and microp_aero_bulk_scale for tuning the + activation by bulk aerosol. + +models/atm/cam/src/physics/cam/physpkg.F90 +. call cldfrc_register from phys_register +. add pbuf_add calls for TINI, QINI, CLDLIQINI, CLDICEINI (used for physics + package diagnostics). +. move initializer for CLDO to microp_mg_cam + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove micro_treatment parameter which isn't relevent for cam4 +. Remove RHDFDA and RHU00 from pbuf and use local variables only. + rhu00 is computed in cldfrc, then used to compute rhdfda, and is + intent(in) to pcond. + rhdfda is computed then used as intent(in) arg to pcond. There is no + use of saved values. +. remove many unused local variables +. remove AIST,ALST from pbuf. Replace local use by ast. +. remove LIQCLDF, ICECLDF from hist. They are identical to AST. +. remove CLDO, CONCLD_QL, ICCWAT, REL_FN, DEICONV, MUCONV, LAMBDACONV + from pbuf. Not used. +. remove pbuf_add calls for SH_FRAC, DP_FRAC. Now done in + cldfrc_register. +. remove pbuf_add calls for TINI, QINI, CLDLIQINI, CLDICEINI. Now done in + phys_register. +. replace local var fice by pbuf FICE. get rid of fice_ql pointer + +models/atm/cam/src/physics/carma/cam/carma_intr.F90 +. remove pbuf_times dimension from CG*, CI*, CL*, CT + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +frankfurt/lf95: All PASS + +frankfurt/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: All BFB + +=============================================================== +=============================================================== + +Tag name: cam5_1_40 +Originator(s): fischer +Date: Fri Sep 20 2012 +One-line Summary: update SVN exteranals, build MCT library separately + +Purpose of changes: +. There are a couple of changes with the cesm build scripts with the new + scripts tag. + . The command line command "configure -case" has been replace with "setup" + . env_configure.xml has been renamed env_pesetup.xml + +. Update SVN externals to match cesm1_1_beta17, except for clm4_0_47 + and pio1_5_4. These are later tags that are a bug fix for cam and + a fix for lahey + +. With the new tag for MCT, the MCT configure script must be run. So + configure and Makefile.in were updated to handle these changes. A new + varaible mct_libdir was added to be able to set the location of the mct + library. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. MCT is now built as a stand alone library. In order to build mct, changes + where made to configure and Makefile.in. + .FC, FC_TYPE, and cc are now determined in configure instead of Makefile.in. + .cam's configure script creates a directory structure in $mct_libdir and copies the MCT + makefiles over. + .MCT's configure script is called in order to set up MCT's Makefile.conf. + .CAM's Makefile.in has new rules to build the MCT library. + .$mct_libdir default is $cam_bld/mct, can be set on the command line -mct_libdir, or + enviroment variable MCT_LIBDIR. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by:eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + + +M models/atm/cam/test/system/TCB_ccsm.sh +. updated test script to reflect changes with the cesm build system + +M models/atm/cam/test/system/tests_pretag_frankfurt_lahey +. removed 113 and 115 tests + +M models/atm/cam/bld/configure +. Added code to create directory structure needed to build MCT. +. Moved logic for determining fc and fc_type from Makefile.in to configure. + This was done so the new call to the MCT configure script can be passed + the compiler type. + +M models/atm/cam/bld/Makefile.in +. removed logic for determining fc and fc_type. +. Added make rules for MCT library build. + +M models/atm/cam/bld/config_files/definition.xml +. add mct_libdir, and add xlf to fc_type defaults + +M SVN_EXTERNAL_DIRECTORIES +. Update SVN externals to match cesm1_1_beta17, except for clm4_0_47 + and pio1_5_4. The clm tag is a bug fix to allow cam builds using + cesm scripts. The pio tag is a fix to allow lahey to work. + +List all existing files that have been modified, and describe the changes: + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +frankfurt/lf95: all passed + +frankfurt/pgi: all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.,: all bfb + +=============================================================== +=============================================================== + +Tag name: cam5_1_39 +Originator(s): fvitt +Date: 18 Sep 2012 +One-line Summary: MAM7 corrections + +Purpose of changes: + + Correction to dust density weighting factors in microp_aero when + 7-mode modal aerosol model is used. + + Correction to the aerosol optics inputs for MAM7. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/test/system/tests_posttag_edinburgh +D models/atm/cam/test/system/tests_pretag_edinburgh_lahey +D models/atm/cam/test/system/tests_pretag_edinburgh_pgi + - edinburgh is replaced by frankfurt + +List all subroutines added and what they do: + +A models/atm/cam/test/system/tests_pretag_frankfurt_pgi +A models/atm/cam/test/system/tests_posttag_frankfurt +A models/atm/cam/test/system/tests_pretag_frankfurt_lahey + - edinburgh is replaced by frankfurt + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh + - edinburgh is replaced by frankfurt + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - correction to the aerosol optics inputs for MAM7 + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - corrections weighting factors of dust densities for MAM7 + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 + - sea salt emission scaling factor adjusted for MAM7 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +frankfurt/lf95: All PASS + +frankfurt/pgi or jaguar/pgi: +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Mon Sep 17 15:04:53 MDT 2012 + - this is expected due to changes for MAM7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_38 +Originator(s): mmills, santos +Date: September 10, 2012 +One-line Summary: Merge in WACCM5 development + +Purpose of changes: + - Add first WACCM5 chemistry package: waccm_mozart_mam3. + - Add namelist settings and use_cases for WACCM5 + - Add features for WACCM5 compatibility. + - Troposphere cloud physics "top" added to more modules. + - Fix CARMA coordinate bug. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - New configuration file, namelist defaults, and use_cases for WACCM5. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.dat +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_mam3/mo_sim_dat.F90 + + - Add new waccm_mozart_mam3 chemistry package. + +A models/atm/cam/test/system/config_files/wm1.9c5h + + - Configuration file for WACCM5 tests. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist +A models/atm/cam/bld/config_files/defaults_waccm5.xml +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam5.xml + + - Default settings for WACCM5 added. + - waccm_mozart_mam3 added to configure, namelist defaults added. + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 + - Added trop_cloud_top_lev as upper boundary of certain + processes/loops. + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 + - Added waccm_mozart_mam3 chemistry package to options/conditionals. + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - Initialize entire lcldn/lcldo arrays to 0._r8, rather than + only initializing below top_lev. + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - Fixed bug in CARMA interface where dlat was being set + instead of dy. + +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_posttag_bluefire + - Added short WACCM5 tests to bluefire posttag. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS. + +edinburgh/lf95: All PASS + +edinburgh/pgi or jaguar/pgi: All PASS + +The following non-pretag tests, however, are expected to fail. + - WACCM5 posttag baseline test (bl380) will fail, because this is a new + feature and chemistry package. However, sm380 and er380 succeed. + - CARMA baseline tests expected to fail due to bug fix. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + + - CARMA only, due to bug fix. + +- what platforms/compilers: All + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + - Larger than roundoff CARMA, bit-for-bit all other cases, anticipate + same climate. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_37 +Originator(s): eaton +Date: Wed Sep 5 08:26:01 MDT 2012 +One-line Summary: Remove hardcoded zvir from cam4 physics. + +Purpose of changes: + +. Call the init routine for the pbl_utils from phys_init, not from + init_eddy_diff and init_hb_diff. This wasn't done previously because a + local value of zvir (0.61) was being used in the hb_diff module. Using a + single call to the init routine which uses the shared value of constants + will change answers (but not climate) for cam3/cam4 physics. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/physics/eddy_diff.F90 +. remove call to init_pbl + +models/atm/cam/src/physics/hb_diff.F90 +. remove call to init_pbl +. remove zvir_loc, zvir, rair. they were only used in init_pbl call which has + been moved. Adjust init_hb_diff args accordingly. + +models/atm/cam/src/physics/pbl_utils.F90 +. change name init_pbl to pbl_utils_init + +models/atm/cam/src/physics/physpkg.F90 +. add call to pbl_utils_init from phys_init + +models/atm/cam/src/physics/vertical_diffusion.F90 +. modify actual args in init_hb_diff call + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Fri Aug 31 14:43:43 MDT 2012 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Fri Aug 31 14:47:20 MDT 2012 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Fri Aug 31 15:36:07 MDT 2012 +023 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Fri Aug 31 15:58:00 MDT 2012 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri Aug 31 16:35:18 MDT 2012 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Sep 4 09:25:23 MDT 2012 +049 bl376 TBL.sh fm1.9c4dh+testmech outfrq3s 9s ...........................FAIL! rc= 7 at Tue Sep 4 10:31:57 MDT 2012 +052 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue Sep 4 11:26:28 MDT 2012 +059 bl440 TBL.sh fsoa1.9c4dh outfrq3s+mozart_megan_emis 9s ................FAIL! rc= 7 at Tue Sep 4 13:07:47 MDT 2012 +063 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Tue Sep 4 13:51:42 MDT 2012 +066 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Tue Sep 4 14:04:16 MDT 2012 +069 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Tue Sep 4 16:14:28 MDT 2012 +072 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Tue Sep 4 16:23:53 MDT 2012 +075 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Tue Sep 4 16:47:10 MDT 2012 +081 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Tue Sep 4 17:39:42 MDT 2012 + +edinburgh/lf95: All PASS except: +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Mon Sep 3 23:57:16 MDT 2012 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Sep 4 01:18:44 MDT 2012 +040 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Tue Sep 4 03:18:48 MDT 2012 + +edinburgh/pgi: All PASS except: +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Fri Aug 31 15:43:49 MDT 2012 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Aug 31 15:55:16 MDT 2012 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Fri Aug 31 16:03:06 MDT 2012 + +All configurations using cam3 or cam4 physics fail the baseline comparisons. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except configs using cam3/cam4 physics + +=============================================================== +=============================================================== + +Tag name: cam5_1_36 +Originator(s): fvitt +Date: 31 Aug 2012 +One-line Summary: Changes for MAM7, added chemistry package, and misc bug fixes + +Purpose of changes: + + - changes for MAM7 (7 mode modal aerosol model): + . use different scaling factor for sea salt emissions + . adjusted the external forcings for trop_mam7 chemistry package + . adjusted the NH4 aerosol optics files + - new chemistry package trop_strat_mam7 (MOZART chemistry with MAM7 aerosols) + - add build-namelist use case for MEGAN emissions that will be used + with MOZSOA compsets + - bug fix in CO+OH reaction rate for super_fast_llnl chemistry + - bug fix in "WMO" method of tropopause calculation + - fix path of chemistry preprocessor generated source files in Filepath + so that CESM build with compile the correct source files + - added regression tests for the chem preprocessor + +Bugs fixed (include bugzilla ID): + + - correction to CO+OH reaction rate for super_fast_llnl chemistry + - invoke O1D_to_2OH_adj subroutine when chemistry is super_fast_llnl_mam3 + - correction to "WMO" method of tropopause calculation + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_usrrxt.F90 + - removed duplicate code + the code relevant to waccm_mozart_sulfur moved to chemistry/mozart/mo_usrrxt.F90 + +List all subroutines added and what they do: + +A models/atm/cam/test/system/TNE_ccsm.sh +A models/atm/cam/test/system/config_files/testmech + - for chemistry preprocessor regression tests + +A models/atm/cam/test/system/config_files/fst7mode1.9c5h +A models/atm/cam/test/system/config_files/f7mode1.9c5dh +A models/atm/cam/test/system/config_files/fst7mode4c5dm + - for trop_mam7 and trop_strat_mam7 chemistry tests + +A models/atm/cam/test/system/tests_chem_hybrid +A models/atm/cam/test/system/tests_chem_mpi + - for many chemistry configurations + +A models/atm/cam/bld/namelist_files/use_cases/mozart_megan_emis.xml + - use case for MEGAN emission for MOZART chemistry + +A models/atm/cam/src/chemistry/pp_trop_strat_mam7 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_strat_mam7/chem_mech.in + - new chemistry package added + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/TCB_ccsm.sh +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/TSM.sh + - changes for testing chemistry preprocessor + - added tests for trop_mam7 and trop_strat_mam7 chemistry + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + - fixed the path of pre-processor generated source code in Filepath + - new chem option + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - defaults for trop_strat_mam7 chemistry + - change in NH4 optics files for MAM7 + - added emission files for MAM7 + +M models/atm/cam/bld/namelist_files/use_cases/cam5_trop_strat_chem.xml + - adjusted the lght_no_prd_factor namelist parameter + +M models/atm/cam/bld/build-namelist + - MAM7 (trop_mam7 and trop_strat_mam7) default namelist + - added the ability to use "$INPUTDATA_ROOT" variable in specifying complex + namelist settings in use cases + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - update to chemistry preprocessor to handle mechanism with up to 1000 species + +M models/atm/cam/src/physics/cam/tropopause.F90 + - correction to "WMO" method of tropopause calculation + +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - additional prognostic modal aerosol model (trop_strat_mam7) + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 + - use different scaling factor for sea salt emissions + +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.in + - changes in external forcings + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - fix for super_fast_llnl_mam3 + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - corrected CO+OH rate calculation for super_fast_llnl + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +052 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Aug 31 00:16:50 MDT 2012 + - correction to reaction rate + +054 bl415 TBL.sh fst1.9c5dh outfrq3s+cam5_trop_strat_chem 9s ..............FAIL! rc= 7 at Fri Aug 31 00:18:08 MDT 2012 + - change in lght_no_prd_factor namelist parameter + +edinburgh/lf95: All Pass + +edinburgh/pgi: + +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Thu Aug 30 16:13:18 MDT 2012 + changes in trop_mam7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_35 +Originator(s): eaton +Date: Wed Aug 29 08:28:47 MDT 2012 +One-line Summary: fix vertical_diffusion pbuf fields + +Purpose of changes: + +. Several of the fields put in the physics buffer by the vertical diffusion + module were using the special pbuf_times dimension incorrectly. This + only results in a bug for the Eulerian dycore (and hence SCAM) since + that's the only dycore for which pbuf_times is greater than 1. + The dimension was removed for the following fields: + + - tke is in the buffer to be communicated to microp_aero. There is no + need for multiple time levels when the purpose is just to share a the + most recently computed values of a diagnostic. In fact subtle mistakes + will result when the data consuming module executes before the data + producing module in the tphysbc then tphysac sequence, and both modules + are using the pbuf_old_tim_idx to access the buffer. In the particular + case of tke the bug was that it was being accessed in microp_aero as if + it did not even have a pbuf_times dimension. + - kvh is used by other parameterizations, and as an initial guess in + compute_eddy_diff on subsequent timesteps. In the Eulerian case it + probably doesn't make sense to use values that are 2 timesteps old as + initial guesses rather than 1 timestep old values. Furthermore this + field was being accessed in microp_aero and ndrop as if it did not have + a pbuf_times dimension. + - kvm, tauresx, and tauresy are in the pbuf to be used as an initial + guesses on the next timestep. + - turbtype and smaw are not currently needed in the pbuf. + - kvt is only used by the waccm/gw_drag code. Only the information just + computed in vertical_diffusion needs to be passed (not multiple time + levels). + +. Change default vertical remap subcycles for 1-deg FV to nspltvrm=2. This + is to make the 1-deg simulation more stable. + +. Fix T_TTEND output diagnostic. + +Bugs fixed (include bugzilla ID): + +. Several physics buffer fields declared with the pbuf_times dimension were + being incorrectly accessed. This is only a bug for cam5 physics using + Eulerian dycore. Note in particular that this affects SCAM. + +. The T_TTEND diagnostic had the wrong sign, and due to incorrect use of + the physics buffer was completely invalid for runs using Eulerian dycore. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Change default value of nspltvrm to 2 for 1-deg FV. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. The change of nspltvrm to 2 for 1-deg FV does add an overhead which will + be noticable (5% ?) but hasn't been thoroughly evaluated. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. set nspltvrm=2 for 1-deg FV + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. Fix access to tke, kvh, kvm (now 2D instead of 3D) +. Fix T_TTEND output diagnostic: + - T_TTEND was added to the pbuf with a pbuf_times index, but was accessing + the field ignoring that index. For the Eulerian core this implies that + on some steps the previous timestep value was accessed, and on the + following steps the value from 2 previous timesteps was accessed. When + computing tendencies for Eulerian the ztodt variable contains twice the + physics timestep, so need to always access the pbuf values from 2 + timesteps previous using the pbuf_old_tim_idx function. + - In the diag_conv_tend_ini routine only initialize the T_TTEND pbuf on the + first step of an initial run, and initialize all pbuf_times levels. + - Fix the sign of the T_TTEND tendency calculation. + +models/atm/cam/src/physics/cam/convect_shallow.F90 +. remove time index from tke access from pbuf + +models/atm/cam/src/physics/cam/diffusion_solver.F90 +. make sure kvt is present when do_molec_diff=.true. +. remove initializer for kvt. It is intent(out) from compute_molec_diff. + +models/atm/cam/src/physics/cam/gw_drag.F90 +. remove unused dummy arg kvh + +models/atm/cam/src/physics/cam/molec_diff.F90 +. change kvt dummy arg to intent(out) from inout + +models/atm/cam/src/physics/cam/physpkg.F90 +. fix initialization of tke, kvh, kvm to use just 1 time level +. tphysac - remove access of kvt from the pbuf, and remove kvt actual arg + from call to gw_intr + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove tke which is referenced but not used. It is also initialized + which overwrites the initialization in physpkg. But shouldn't impact + answers because it isn't used by the hack shallow convection. +. remove kvh which is referenced but not used. It is also initialized + which overwrites the initialization in physpkg. Shouldn't impact cam4 + answers unless running with IC file that contained KVH. +. remove turbtype and smaw which are referenced but not used + +models/atm/cam/src/physics/cam/tracers_suite.F90 +. comment out debug output + +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. remove pbuf_times dimension from tke. it is set in compute_eddy_diff or + compute_hb_diff and used in moist physics to estimate subgrid vertical + velocity. **N.B.** was being incorrectly accessed without the pbuf_times + dimension in microp_aero. +. remove pbuf_times dimension from kvh. kvh in the pbuf is used by other + physics parameterizations, and as an initial guess in compute_eddy_diff + on the next timestep. **N.B.** was being incorrectly accessed without + the pbuf_times dimension in microp_aero and in ndrop. +. remove pbuf_times dimension from kvm. kvm in the pbuf is only used as an + initial guess in compute_eddy_diff on the next timestep. Thus the kvm + field in the pbuf does not contain the contributions from molecular + diffusion that are added in the call to compute_vdiff. +. remove pbuf_times dimension from turbtype and smaw. these fields in the + pbuf are currently not used, but may be in the future. Also can remove + the pbuf_set_field to zero for the HB case since the fields are init to + zero and not modified. +. tauresx and tauresy are only in the pbuf to be used as initial guesses in + subsequent timesteps. No need for multiple time levels. + +. kvt only needs one time level and physpkg scope. +. kvt is set before it is used anywhere -- doesn't need an initialization + in vertical_diffusion_init +. change local array for kvt to pointer into pbuf +. remove obsolete comment about calc_kvt +. associate kvt pointer with pbuf and remove the copy of the local kvt into + the pbuf. + +models/atm/cam/src/physics/waccm/gw_drag.F90 +. remove dummy arg kvt and access from pbuf instead. add init for + kvt_idx. modify indexing to account for pbuf field using 1 based + indices. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Aug 27 18:54:35 MDT 2012 + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Aug 27 19:24:15 MDT 2012 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Aug 27 21:02:18 MDT 2012 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Aug 27 22:30:15 MDT 2012 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Aug 27 22:40:37 MDT 2012 + +edinburgh/pgi: All PASS except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Aug 27 17:10:52 MDT 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Aug 27 17:31:47 MDT 2012 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Aug 27 17:46:04 MDT 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Aug 27 17:58:51 MDT 2012 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except: +. configurations using Eulerian dycore w/ cam5 physics change answers due + to bug fixes +. FV, 1-deg runs change answers (same climate) due to changing the default + number of subcycles for the vertical remapping (nspltvrm=2). + +=============================================================== +=============================================================== +Tag name: cam5_1_34 +Originator(s): fischer, eaton, sungsup, fvitt +Date: Fri Aug 24 2012 +One-line Summary: obklen, deep convection, ndrop, and WACCM concentration bug fixes + +Purpose of changes: + +. Mods from Sungsu Park to fix the unreasonable concentration of some + species in WACCM. The fix prevents large fluxes of species with very + small concentrations. + +. Fix to wet radius calculation in the modal_aero_wateruptake module. + +. Provide a computed value for the Obukhov length in the cam5 physics + package. It was inadvertently left set to zero. This impacts dry + deposition calculations. + +. Mods from Guang Zhang in zm_conv to fix some inconsistency in the + initialization of hu, and to define su at cloud base using hu. + +. Mods to ndrop from Cathy Chuang, Philip Cameron-smith, and Steve Ghan. + Mods to mo_setsox from Xiaohong Liu to generalize the method for + calculating pH value of cloud water. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. obklen variable fix for cam5 + +M models/atm/cam/src/physics/cam/zm_conv.F90 +. deep convection bug fix + +M models/atm/cam/src/physics/cam/uwshcu.F90 +. bug fix for unreasonable concentration of tracers with WACCM + +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 +. move calculation of dgncur_awet outside of modal_aero_wateruptake_sub and + into modal_aero_wateruptake_dr. This moves it to a point after the + calculation of wetrad has been completed with the + deliquesence/crystallization hysteresis treatment. + +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsox.F90 +. ndrop bug fix + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Thu Aug 23 09:29:18 MDT 2012 +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Thu Aug 23 09:29:20 MDT 2012 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Thu Aug 23 09:29:28 MDT 2012 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Thu Aug 23 09:29:30 MDT 2012 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Thu Aug 23 09:29:41 MDT 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Thu Aug 23 09:29:52 MDT 2012 +023 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Thu Aug 23 09:29:54 MDT 2012 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Thu Aug 23 09:30:42 MDT 2012 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Thu Aug 23 09:30:49 MDT 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Thu Aug 23 09:31:17 MDT 2012 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Aug 23 09:32:04 MDT 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Thu Aug 23 09:32:24 MDT 2012 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Thu Aug 23 09:32:51 MDT 2012 +052 bl415 TBL.sh fst1.9c5dh outfrq3s 9s ...................................FAIL! rc= 7 at Thu Aug 23 09:34:05 MDT 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Aug 23 09:35:06 MDT 2012 +057 bl440 TBL.sh fsoa1.9c4dh outfrq3s 9s ..................................FAIL! rc= 7 at Thu Aug 23 09:35:58 MDT 2012 +061 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Thu Aug 23 09:36:11 MDT 2012 +064 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Thu Aug 23 09:36:21 MDT 2012 +067 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Thu Aug 23 09:38:37 MDT 2012 +070 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Thu Aug 23 09:38:46 MDT 2012 +073 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Thu Aug 23 09:39:20 MDT 2012 +079 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Thu Aug 23 10:36:02 MDT 2012 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Thu Aug 23 12:23:05 MDT 2012 +expected, all bug fixes change answers + + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Aug 22 23:23:39 MDT 2012 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Aug 22 23:23:43 MDT 2012 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Aug 22 23:23:44 MDT 2012 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Aug 22 23:23:50 MDT 2012 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Aug 23 00:12:41 MDT 2012 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Aug 23 02:58:48 MDT 2012 +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Thu Aug 23 03:39:43 MDT 2012 +034 er314 TER.sh wg10c4dm outfrq3s 4+5s ...................................FAIL! rc= 8 at Thu Aug 23 04:32:47 MDT 2012 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Aug 23 05:19:42 MDT 2012 +037 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Aug 23 06:49:22 MDT 2012 +040 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Thu Aug 23 07:47:52 MDT 2012 +expected, all bug fixes change answers + +edinburgh/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Aug 22 15:10:31 MDT 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Aug 22 15:19:55 MDT 2012 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Aug 22 15:24:37 MDT 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Aug 22 15:29:44 MDT 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Aug 22 15:47:52 MDT 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Aug 22 17:03:07 MDT 2012 +033 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Wed Aug 22 17:11:49 MDT 2012 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Aug 22 17:29:57 MDT 2012 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Wed Aug 22 17:43:44 MDT 2012 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Aug 22 17:56:15 MDT 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Aug 22 18:17:23 MDT 2012 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Wed Aug 22 18:33:39 MDT 2012 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Wed Aug 22 18:38:34 MDT 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Wed Aug 22 18:46:36 MDT 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Aug 22 19:32:42 MDT 2012 +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Wed Aug 22 20:48:29 MDT 2012 +expected, all bug fixes change answers + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): + cam5_1_32 + obklen, deep convection, water update + cesm1_1_beta15 + ndrop bug fix +- platform/compilers: + bluefire, xlf +- configure commandline: + Used cesm build scripts + create_newcase -compset F1850C5 -res f19_f19 -mach bluefire -case /glade/home/fischer/runs/F1850C5_5_1_32_xxxx +- MSS location of output: + /home/fischer/csm/F1850C5_5_1_32_mawu + bug fix for water uptake in the modal aerosol + /home/fischer/csm/F1850C5_5_1_32_obklen + Fix for obklen variable + /home/fischer/csm/F1850C5_5_1_32_zm + Deep convection bug fix + /home/tilmes/csm/f2000_cam5_beta15_modal + ndrop bug fix + +MSS location of control simulations used to validate new climate: + /home/fischer/csm/F1850C5_5_1_32_bl + obklen, deep convection, water update + /home/tilmes/csm/f2000_cam5_beta15 + ndrop bug + +URL for AMWG diagnostics output used to validate new climate: + http://www.cgd.ucar.edu/cms/hannay/internal/cam_dev/cam5.2_dev.html + +=============================================================== +=============================================================== + +Tag name: cam5_1_33 +Originator(s): fischer +Date: Wed Aug 22, 2012 +One-line Summary: external updates and bug fixes + +Purpose of changes: +. SVN external updates to beta16 tags + scripts4_120509a -> scripts4_120801a + . Changes to CESM build scripts. + . configure only supports -case and -clean. + cleannamelist, cleanmach and cleanall have been removed. + . RUNDIR moved from env_build.xml to env_run.xml + Default RUNDIR is now set in Machines/config_machines.xml, instead of + being based on $EXEROOT. + drvseq4_1_09 -> drvseq4_1_24 + branch_tags/rasm_tags/rasm08_clm4_0_43 -> branch_tags/rasm_tags/rasm11_clm4_0_43 + Only update clm tags to cesm1_1_beta15 do to a bug in clm searching for + datm files + cice4_0_20120502 -> cice4_0_20120803 + newer cice tag than cesm1_1_beta16 to fix decomp types were missing from + the definition file + docn8_120502 -> docn8_120626 + share3_120509 -> share3_120731 + timing_120419 -> timing_120731 + MCT2_7_0-120413 -> MCT2_8_0_120503 + Didn't update MCT tag to github since it broke cam's build scripts + PIO + pio wasn't updated because newer version needs FORTRAN 2003, so all lahey + tests failed. + stubs1_3_02 -> stubs1_3_04 + Machines_120515 -> Machines_120802 + +. Merge in branch tag branch_tags/bldnml_tags/bldnml04_cam5_1_31 + .CESM build namelist fixes + +. Cloud diagnostics bug fix in cloud_diagnostics.F90. + +. Additional optional microphysics output diagnostics. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +. updated externals to match cesm1_1_beta16, except for CLM, MCT,and PIO + PIO has Fortran 2003 code which isn't supported in lahey, there will + be a patch for this. MCT needs to be built using the MCT configure + script, which isn't supported with the cam stand alone build. + CLM's configure needs a definition file from datm. + + +M models/atm/cam/test/system/TCB.sh +. Update for cice decomp updates +. Make seperate explicit calls to generate_cice_decomp to get decomp_type, + maxblocks, bsize_x, and bsize_y. + +M models/atm/cam/test/system/TCB_ccsm.sh +. Renamed env_mach_pes.xml to env_configure.xml +. Add xmlchange for RUNDIR + +M models/atm/cam/bld/configure +. new decomp types for cice + +M models/atm/cam/bld/cam.buildnml.csh +M models/atm/cam/bld/cam.cpl7.template +. CESM build namelist fixes + +M models/atm/cam/bld/build-namelist +. Change debug print messages + +M models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +. cloud_diagnostics bug fix, gravit*1000 should be just gravit in call to conv_water_4rad + +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 +. Additional optional microphysics output diagnostics. + +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +. Fixed typo + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + 079 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Tue Aug 21 18:07:07 MDT 2012 + Change in cice decomp type changes answers for some cases + +edinburgh/lf95: all passed + +edinburgh/pgi: all passed + +=============================================================== +=============================================================== + +Tag name: cam5_1_32 +Originator(s): santos, eaton +Date: July 23, 2012 +One-line Summary: remove dependencies in phys_control, vert diffusion cleanup + +Purpose of changes: + - To break the dependency of phys_control on ref_pres (and thus on the + dynamics and physconst). + - Move namelist options from phys_control to vertical_diffusion. + - Remove #ifdef MODAL_AERO from vertical_diffusion. + - Make trb_mtn_stress module fully portable. + - General cleanup (remove goto statements, unnecessary code). + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - ref_pres_nl handles options for the reference pressure module. + - trop_cloud_top_press is defined in namelist_definitions and + always added by build_namelist. + - Value for cam5 is 100 Pa. Currently only WACCM configurations + go above this level. + - Value for cam4 is currently 0 Pa. (CAM 4 uses k1mb as the + microphysics top instead.) + + - The following namelist variables were moved from phys_control to + vertical_diffusion: + - do_iss + - do_tms + - tms_orocnst + - tms_z0fac + - vdiff_compute_obklen + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/phys_control.F90 :: phys_ctl_init +models/atm/cam/src/physics/cam/phys_control.F90 :: trop_cloud_top_init + - These set various top/bottom levels for vertical_diffusion and the + cloud physics, respectively. + - Their functionality has been split between routines in other + modules, in order to remove dependence on ref_pres. + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/diffusion_solver.F90 :: new_fieldlist_vdiff + - Returns a new vdiff_selector ("fieldlist") object, given a + constituent number. + - Split fieldlist creation subroutine off of init_vdiff so that + module does not have to be re-initialized by eddy_diff. + +models/atm/cam/src/physics/cam/rad_constituents.F90 :: rad_cnst_get_mam_mmr_idx +models/atm/cam/src/physics/cam/rad_constituents.F90 :: rad_cnst_get_mode_num_idx + - Get constituent indices of mam species mass mixing ratio, and mode + number mixing ratio, respectively. + - Used in cleanup of vertical diffusion. + +models/atm/cam/src/physics/cam/ref_pres.F90 :: ref_pres_readnl + - Namelist parser for ref_pres. + - Added to move trop_cloud_top_press option from phys_control. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Added trop_cloud_top_press to namelist. + +models/atm/cam/bld/namelist_files/namelist_definition.xml + - Added trop_cloud_top_press, moved options from phys_control to + vertical_diffusion. + +models/atm/cam/src/control/runtime_opts.F90 + - Added ref_pres namelist. + +models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +models/atm/cam/src/physics/cam/cloud_fraction.F90 +models/atm/cam/src/physics/cam/micro_mg_cam.F90 +models/atm/cam/src/physics/cam/microp_aero.F90 +models/atm/cam/src/physics/cam/ndrop_bam.F90 + - Updated location of trop_cloud_top_lev from phys_control to ref_pres. + +models/atm/cam/src/physics/cam/diffusion_solver.F90 + - do_iss is set by input argument rather than gotten from phys_control. + - Fieldlists are created by new_fieldlist_vdiff rather than init_vdiff. + - vdiff_selector uses an allocatable list rather than a pointer, and + the .not. and "any" operators operate without slicing. (Adding "(:)" + actually does produce a semantic difference, though one that's + irrelevant here!) + +models/atm/cam/src/physics/cam/eddy_diff.F90 + - Get fieldlists from new_fieldlist_vdiff rather than init_vdiff. + +models/atm/cam/src/physics/cam/molec_diff.F90 + - Use errstring argument to init_molec_diff to remove iulog and endrun + dependencies. + - init_molec_diff now calculates top/bottom of molecular diffusion + +models/atm/cam/src/physics/cam/phys_control.F90 + - To remove ref_pres dependence, the following were removed + from this module, and correspondingly from phys_getopts: + - trop_cloud_top_init + - trop_cloud_top_lev + - trop_cloud_top_press + - phys_ctl_init + - do_molec_diff + - ntop_eddy/nbot_eddy + - ntop_molec/nbot_molec + - Because they relate specifically to vertical_diffusion, the following + were also removed: + - do_iss + - do_tms + - tms_orocnst + - tms_z0fac + - vdiff_compute_obklen + +models/atm/cam/src/physics/cam/physpkg.F90 + - phys_ctl_init and trop_cloud_top_init calls removed. + +models/atm/cam/src/physics/cam/rad_constituents.F90 + - Added rad_cnst_get_mam_mmr_idx and rad_cnst_get_mode_num_idx. + +models/atm/cam/src/physics/cam/ref_pres.F90 + - Added ref_pres_readnl. + - Add trop_cloud_top_lev calculation. + +models/atm/cam/src/physics/cam/trb_mtn_stress.F90 + - Used errstring to remove dependency on iulog, took dependence on + shr_const_mod back out. + +models/atm/cam/src/physics/cam/tropopause.F90 + - Replaced goto statements with cycle/exit. + - Comment typo fixes. + +models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - Added variables to namelist from phys_control. + - vertical_diffusion now decides if molecular diffusion will be done. + - ntop_molec/nbot_molec are returned from init_molec_diff, not phys_getopts. + - vertical_diffusion now determines ntop_eddy/nbot_eddy values. + - Uses new_fieldlist_vdiff. + - Handles new errstring outputs from init_molec_diff and init_tms. + - New rad_constituent procedures and prog_modal_aero used to remove + #ifdef MODAL_AERO statements. + +models/atm/cam/src/physics/rrtmg/rad_solar_var.F90 + - Used DIM argument to maxloc to change size 1 vector to scalar. + +models/atm/cam/src/physics/waccm/gw_drag.F90 + - nbot_molec used from molec_diff rather than queried from phys_getopts + +models/atm/cam/src/physics/waccmx/majorsp_diffusion.F90 + - Unused Boltzmann constant removed. + - ntop_molec/nbot_molec used from molec_diff rather than phys_control. + - Do loop guaranteed to have exactly one iteration removed (replaced + with simple assignment). + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + + - All PASS. + +edinburgh/lf95: + + - All PASS. + +edinburgh/pgi or jaguar/pgi: + + - All PASS. + +Summarize any changes to answers: None. All bit-for-bit. + +=============================================================== + +=============================================================== + +Tag name: cam5_1_31 +Originator(s):fischer, eaton, jedwards +Date: 5-25-2012 +One-line Summary: homme updates, 1/2 cam4 tunings, and bug fixes + +Purpose of changes: + +. Updated testing scripts to handle CESM jaguarpf to titan name change. +. Added new COSP tests that skip MISR and RADAR simulators because they + cause answer changes when the columns change. This happens when different + pes layouts, or phys_loadbalance changes. +. Added ability to set tunings differently depending on the ocean model +. Merge with cam1/branch_tags/camse_cam5_1_27_tags/01_camse_cam5_1_27/ + Updates for homme, memory reduction + Changes to vert_remap_q_alg in namelist_defaults_cam.xml + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. Added ability to set tunings differently depending on the ocean model + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: +. For ne60 with 256 mpi tasks on bluefire memory usage when from + 858Mb high water per task to 778Mb + 648Mb low water per task to 573Mb + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +. added titan + +M models/atm/cam/test/system/tests_posttag_bluefire +M models/atm/cam/test/system/input_tests_master +A models/atm/cam/test/system/nl_files/outfrq3s_cosp +. New COSP tests that skips MISR and the RADAR simulators + This is to get around failing tests because of answer changes when + columns are changed. + +M models/atm/cam/bld/configure +. remove 'none' as an option for -ocn. +. remove default setting of $ocn_pkg='none' when -ccsm_seq option set + +M models/atm/cam/bld/config_files/definition.xml +. replace 'none' by 'pop2' as valid value for ocn. + +M models/atm/cam/bld/cam.buildnml.csh +. use $COMP_OCN to set value of -ocn argument to configure (replace + hardcoded value 'none') + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add tunings for 1/2 deg cam4 for cldfrc_rhminh, cldfrc_rhminl, + cldfrc_sh1, cldwat_icritw +. Merge with cam1/branch_tags/camse_cam5_1_27_tags/01_camse_cam5_1_27/ + Changes made to vert_remap_q_alg + +M models/atm/cam/bld/build-namelist +. Added test for $cam_build when setting bndtvs and focndomain + +M models/atm/cam/src/control/cam_history.F90 +. Changed the len of logname from 8 to 16 to fix PGI problem on lynx. + +M models/atm/cam/src/physics/cam/microp_aero.F90 +. Initialize for ptend was needed. + +M models/atm/cam/src/dynamics/homme/interp_mod.F90 +. Updated seq_io_mod to use shr_pio_mod + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. updated homme external to homme1_3_6 + +M SVN_EXTERNAL_DIRECTORIES +. updated externals tags to cesm1_1_beta14 tags + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +070 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Thu May 24 11:46:43 MDT 2012 +073 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Thu May 24 11:47:16 MDT 2012 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Thu May 24 16:24:01 MDT 2012 +. homme is expected to changes answer + + + +edinburgh/lf95: all passed + +edinburgh/pgi: +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Tue May 22 20:14:51 MDT 2012 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Tue May 22 22:07:24 MDT 2012 +. homme is expected to changes answer + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_30 +Originator(s): fvitt bardeenc +Date: 18 May 2012 +One-line Summary: Chemisry and CARMA bug fixes + +Purpose of changes: + +Chemistry bug fixes + - corrected SO2 + OH --> H2SO4 reaction in trop_strat_mam3 chemistry package + - include wet removal of H2SO4 for aerosol chemistry packages other than trop_mam3 + - remove use of deprecated commap module from chemistry source code + - include of solar/geomagnetic activity data in history files for WACCM + +CARMA bug fixes +- carma_do_clearsky was not being passed to CARMA_Initialize (is false by default) +- the default for carma_do_clearsky was not correct for the cirrus model (should have been false) + +CARMA models +- (cirrus) changed namelist defaults to match latest runs on Pleiades +- (pmc) added dust/ice coagulation +- (test_tracers) new model for tracer trajectory studies + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/cam5_trop_strat_chem.xml + -new build-namelist use case for *STRATMAM compsets + +A models/atm/cam/src/physics/carma/models/test_tracers/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/test_tracers +- (test_tracers) new model for tracer trajectory studies + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure + - added new carma option (test_tracers) + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - moved "diag_cnst_conv_tend" to "cam_diags_opts" namelist group + - added definition for "met_srf_nudge_flux" namelist option + - CARMA namilist options added: + . carma_launch_doy + . carma_emission_rate + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - remove H2SO4 from wet dep list only for chem package trop_mam3 + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - resolve $CASEBUILD path so that the chemistry preprocessor execute + properly within CESM scripts + +M models/atm/cam/test/system/test_driver.sh + +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 + - pass do_clearsky option into CARMA model + +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 + - invoke CAMRA_AddCoagulation + +M models/atm/cam/src/physics/carma/models/cirrus/carma_cloudfraction.F90 + - change "camsrfexch_types" to "camsrfexch" so this will compile + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml + - update to solar irradiance data input + - update to list of GEOS5 meteorology input files + +M models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml + - update to list of GEOS5 meteorology input files + +M models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml + - update to list of GEOS5 meteorology input files + - gas_wetdep_method set to "NEU" + +M models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml + - set do_tms to .false. + - gas_wetdep_method set to "NEU" + +M models/atm/cam/bld/build-namelist + - changes for CARMA + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/control/runtime_opts.F90 + - moved reading of cam_diagnostics namelist options from runtime_opts to cam_diagnostics + +M models/atm/cam/src/control/cam_history_support.F90 +M models/atm/cam/src/control/cam_history.F90 + - restored inclusion of solar/geomagnetic activity data in history files for waccm + +M models/atm/cam/src/physics/cam/tropopause.F90 + - added TROP_DZ diagnostic history output + +M models/atm/cam/src/physics/cam/phys_control.F90 + - increased length of cam_chempkg_out optional argument + +M models/atm/cam/src/physics/cam/eddy_diff.F90 + - corrected pressure units in description of eddy_max_bot_pressure var + +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sad.F90 +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 + - removed latndx and lonndx from arg list of sad_strat_calc routine, which are not used + +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 + - removed use of commap module, which is deprecated + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - removed latndx and lonndx from args passed into routines which don't make use of these variables + +M models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 +M models/atm/cam/src/chemistry/mozart/mo_setext.F90 +M models/atm/cam/src/chemistry/mozart/mo_photoin.F90 + - removed latndx and lonndx from arg list, which are not used + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - removed latndx and lonndx from arg list, which are not used + - set do_jshort to false for fast TUV method + - removed use of deprecated commap module and use phys_grid interface to determine grid point locations + +M models/atm/cam/src/chemistry/mozart/mo_seto2.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - output known aerosol species in units of MMR and gas-phase species as VMR + . the exception to this is trop_mam3 which outputs all species in units of MMR + +M models/atm/cam/src/chemistry/mozart/mo_synoz.F90 + - removed use of deprecated commap module and use dyn_grid interface to determine latitudes + and latitude weights grid boxes + +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in + - corrected SO2 + OH --> H2SO4 reaction + +M models/atm/cam/src/dynamics/sld/grmult.F90 + - corrected code to compute virtual temperature (otherwise this would not compile) + +M models/atm/cam/src/dynamics/sld/sld_control_mod.F90 + - correction to endrun message in dyn_sld_readnl subroutine + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +052 bl415 TBL.sh fst1.9c5dh outfrq3s 9s ...................................FAIL! rc= 7 at Thu May 17 13:16:55 MDT 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu May 17 13:17:55 MDT 2012 + These failures are expected due to H2SO4 added to list of tracers which are wet removed + +edinburgh/lf95: All Pass + +edinburgh/pgi: +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed May 16 18:35:24 MDT 2012 + This failure is expected due to H2SO4 added to list of tracers which are wet removed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_29 +Originator(s): Cheryl Craig and Brian Eaton +Date: 5/10/2012 +One-line Summary: Introduced driver layer for modal_aero_wateruptake and cleanup and bug fix + +Purpose of changes: + Introduced driver layer for modal_aero_wateruptake to allow incorporation of sub-columns + prec_zmc and snow_zmc renamed prec_dp and snow_dp - both stored in pbuf + prec_cmf and snow_cmf renamed prec_sh and snow_sh and - both stored in pbuf + prec_str, snow_str, prec_sed, snow_sed, prec_pcw and snow_pcw now stored in pbuf + +Bugs fixed (include bugzilla ID): + bug fix for klambda check in rrtmg/cloud_rad_props.F90, if == 1 then would klambda-1 would be out-of-bound index + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/control/camsrfexch_types.F90 + renamed camsrfexch.F90 + +D models/atm/cam/src/control/srfxfer.F90 + moved into camsrfexch.F90 module and renamed cam_export + +List all subroutines added and what they do: +A + models/atm/cam/src/control/camsrfexch.F90 + renamed from camsrfexch_type.F90 and now contains old srfxfer routine which is renamed cam_export + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/chemistry/utils/modal_aero_wateruptake.F90 + new driver layer (modal_aero_wateruptake_dr) introduced to aid subcolumns + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +MM models/atm/cam/src/physics/cam/microp_driver.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 + prec_zmc and snow_zmc renamed prec_dp and snow_dp - both stored in pbuf + prec_cmf and snow_cmf renamed prec_sh and snow_sh and - both stored in pbuf + prec_str, snow_str, prec_sed, snow_sed, prec_pcw and snow_pcw now stored in pbuf + +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 + bug fix for klambda check, if == 1 then klambda-1 would be out-of-bound index + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + calls modal_aero_wateruptake_dr now + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/pp_none/chemistry.F90 +M models/atm/cam/src/chemistry/utils/aerodep_flx.F90 +M models/atm/cam/src/chemistry/utils/modal_aero_deposition.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/dynamics/eul/inital.F90 +M models/atm/cam/src/dynamics/eul/stepon.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 +M models/atm/cam/src/dynamics/fv/fv_prints.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 +M models/atm/cam/src/dynamics/homme/stepon.F90 +M models/atm/cam/src/physics/cam/carma_intr.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/flux_avg.F90 +M models/atm/cam/src/physics/cam/iop_surf.F90 +M models/atm/cam/src/physics/cam/phys_debug.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/radiation_data.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/carma/cam/carma_cloudfraction.F90 +M models/atm/cam/src/physics/carma/cam/carma_intr.F90 +M models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +M models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/rrtmg_state.F90 +M models/atm/cam/src/dynamics/sld/stepon.F90 + rename of camsrfexch_types to camsrfexch + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all BFB + +edinburgh/lf95: all BFB + +edinburgh/pgi: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam5_1_28 +Originator(s): bardeenc santos +Date: May 8, 2012 +One-line Summary: CARMA added, sathist multiple columns, cleanup + +Purpose of changes: + + - Add CARMA (Community Aerosol and Radiation Model for Atmospheres), + along with several CARMA models: + - bc_strat + - cirrus + - meteor_smoke + - pmc + - sea_salt + - sulfate + As well as basic test/tutorial models for CARMA: + - test_detrain + - test_growth + - test_passive + - test_radiative + - test_swelling + + - Add new chemistry package: waccm_mozart_sulfur, usable with + the CARMA sulfate model. + + - New features used by CARMA, but potentially relevant outside of + CARMA, include: + - The ability to turn off some processes in MG microphysics and + Park macrophysics. + - A flag specifying the stage at which a constituent will undergo + convective transport. + - New spectral flux outputs for radiation. + - The ability to calculate the Obukhov length outside the HB/HBR + eddy scheme. + + - Allow sat_hist to use more than one column near a given point, as + well as giving columns from more than one timestep, to allow + interpolation in time and space. + + - Update/add to WACCM namelist defaults for certain configurations. + + - Tweaked forcing from meteorological data. + + - Improve Darwin parallel support. + + - Minor cleanup to RRTMG. + + - Some options from cldwat have been moved into cloud_fraction. + +Bugs fixed (include bugzilla ID): + + - Bug #1475 has been partially addressed by this tag, which removed + the faulty option (liu_in == .true. is the only valid behavior for + MG microphysics). The faulty functionality will be restored with + the addition of further ice nucleation options in a future tag. + +Describe any changes made to build system: + + - Improved support for compilation using Darwin. + + - Added configure and namelist options specific to CARMA and + waccm_mozart_sulfur, including also. + + - Namelist variables for new satellite history, RRTMG spectral + (per-band) fluxes, changing wv_saturation scheme. + + - Moved/combined some variables from cldwat to cloud_fraction + (cldfrc). + +Describe any changes made to the namelist: + + - New defaults for certain WACCM resolutions: + + atm/cam/inic/fv/cami_0000-01-01_1.9x2.5_L64_c070703.nc + atm/cam/inic/fv/cami_0000-01-01_4x5_L64_c090108.nc + atm/cam/inic/fv/cami_0000-01-01_10x15_L64_c081013.nc + atm/waccm/ic/cami_2000-07-01_1.9x2.5_L125_c040928.nc + + - WACCM emissions files updated: + + atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc + atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc + atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc + atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_SO2_1850-2000_1.9x2.5.c090522.nc + + In the waccm_2000_cam4 use case: + atm/waccm/lb/LBC_1765-2005_1.9x2.5_CMIP5_za_c111110.nc + + - Defaults for recently added eddy diffusion variables are now set + in namelist_defaults_cam.xml rather than hard-coded in the module: + + 0.D0 + 1.D0 + 1.D0 + 40.e3 + 40.e3 + 100.e3 + .false. + + - Several changes specific to CARMA and waccm_mozart_sulfur. + + - H2SO4 added to drydep and wetdep lists. + + - New logical flags for turning off processes in macro/microphysics: + - macro_park_do_cldice + - macro_park_do_cldliq + - macro_park_do_detrain + - micro_mg_do_cldice + - micro_mg_do_cldliq + + - Namelist options for cldfrc replacing functionality in cldwat: + - cldfrc_rhminl_adj_land + - cldfrc_premib + - cldfrc_iceopt + - cldfrc_icecrit + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/ +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_sulfur/mo_usrrxt.F90 + - New waccm_mozart chemistry branch. + +A models/atm/cam/src/physics/cam/carma_flags_mod.F90 + - Module that provides CARMA-specific flags. + +A models/atm/cam/src/physics/cam/carma_intr.F90 +A models/atm/cam/src/physics/cam/carma_model_flags_mod.F90 + - Stubs for CARMA-specific code, used when the corresponding + CARMA modules are not compiled. + +A models/atm/cam/src/physics/carma +A models/atm/cam/src/physics/carma/cam/ +A models/atm/cam/src/physics/carma/cam/carma_cloudfraction.F90 +A models/atm/cam/src/physics/carma/cam/carma_constants_mod.F90 +A models/atm/cam/src/physics/carma/cam/carma_getT.F90 +A models/atm/cam/src/physics/carma/cam/carma_intr.F90 +A models/atm/cam/src/physics/carma/cam/carma_precision_mod.F90 +A models/atm/cam/src/physics/carma/models/ +A models/atm/cam/src/physics/carma/models/bc_strat/ +A models/atm/cam/src/physics/carma/models/bc_strat/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus/ +A models/atm/cam/src/physics/carma/models/cirrus/carma_cloudfraction.F90 +A models/atm/cam/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/cirrus/growevapl.F90 +A models/atm/cam/src/physics/carma/models/meteor_smoke/ +A models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/pmc/ +A models/atm/cam/src/physics/carma/models/pmc/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/pmc/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/sea_salt/ +A models/atm/cam/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 +A models/atm/cam/src/physics/carma/models/sea_salt/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/sulfate/ +A models/atm/cam/src/physics/carma/models/sulfate/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_detrain/ +A models/atm/cam/src/physics/carma/models/test_detrain/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_growth/ +A models/atm/cam/src/physics/carma/models/test_growth/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_passive/ +A models/atm/cam/src/physics/carma/models/test_passive/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_radiative/ +A models/atm/cam/src/physics/carma/models/test_radiative/carma_model_mod.F90 +A models/atm/cam/src/physics/carma/models/test_swelling/ +A models/atm/cam/src/physics/carma/models/test_swelling/carma_model_mod.F90 + - Added CARMA-CAM interface and several CARMA models. + +X models/atm/cam/src/physics/carma/base + - External for CARMA's base code. + +A models/atm/cam/test/system/config_files/f1.9c4carmsulm +A models/atm/cam/test/system/config_files/f1.9c5carmbc_m +A models/atm/cam/test/system/config_files/f1.9c5carmcirm +A models/atm/cam/test/system/config_files/f1.9c5carmmetm +A models/atm/cam/test/system/config_files/f1.9c5carmpmcm +A models/atm/cam/test/system/config_files/f1.9c5carmseam +A models/atm/cam/test/system/nl_files/carma24h +A models/atm/cam/test/system/tests_carma + -Added CARMA-specific tests for various models + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - Added CARMA base external, updated RRTMG external. + +M models/atm/cam/bld/Makefile.in +M models/atm/cam/src/utils/abortutils.F90 +M models/atm/cam/tools/interpic/Makefile + - Improved Darwin support. + +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure + - Added CARMA, waccm_mozart_sulfur. + +M models/atm/cam/bld/namelist_files/master_drydep_list.xml +M models/atm/cam/bld/namelist_files/master_gas_wetdep_list.xml + - Added H2SO4 to main gas phase lists. + - Removed MAM-specific drydep entry to prevent + double-counting. + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml + - Added CARMA, waccm_mozart_sulfur, and sathist options. + - New files for various WACCM resolutions. + - Updated WACCM emis_file defaults (but usually overridden by + use case defaults anyway). + - Eddy diffusion defaults now set in namelist_defaults_cam. + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - Tweaks to gas_wetdep_list moved from build-namelist to + set_dep_lists. + - Avoid changing answers for trop_mam due to + waccm_mozart_sulfur's addition of H2SO4 to gas wetdep. + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + - Notify hub2atm if CARMA is doing drydep. + +M models/atm/cam/src/chemistry/bulk_aero/wetdep.F90 + - is_strat_cloudborne handled properly as optional argument + rather than using #ifdef MODAL_AERO statements. + +M models/atm/cam/src/chemistry/utils/modal_aero_calcsize.F90 + - Unnecessary use statement removed. + +M models/atm/cam/src/control/physconst.F90 + - Some constants from shr_const_mod are now used instead of + recalculated with identical formulae. + +M models/atm/cam/src/control/runtime_opts.F90 + - Add CARMA readnl, microp/macrop driver readnl, and the new + RRTMG spectralflux option. + +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 + - Now can use n closest columns to a given point, rather than + only the nearest column. + - sat_hist.F90 can output multiple timesteps as well. + - Distance is now the great circle distance rather than + lon^2+lat^2 (this will change the closest column found in + some cases, particularly unstructured grids, points near 0 + degrees longitude, and points near the poles). + +M models/atm/cam/src/dynamics/eul/grmult.F90 +M models/atm/cam/src/dynamics/sld/grmult.F90 + - Replaced call to virtem with equivalent one-liner. + +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 + - Add CARMA constituents. + +M models/atm/cam/src/dynamics/fv/metdata.F90 + - Meteorological data nudges, rather than forces, some CAM + fields by default. + - New namelist variable met_srf_nudge_flux can be set to + .false. to recover the old behavior. + +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 + - Account for CARMA's processes without trying to redo them. + - Some subroutines made publically available for CARMA. + - Some parameters now housed in cloud_fraction and read in + from the namelist rather than set between cldwat2m_macro + and cloud_fraction. + +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/micro_mg.F90 +M models/atm/cam/src/physics/cam/micro_mg_cam.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 + - Account for physical processes executed by CARMA. + - New namelist flags to control this behavior, and new readnl + methods to get those flags. + - The liu_in option has been removed, since setting it to + false has produced garbage for some time now. See bug + #1475 in bugzilla. + - microp_driver now uses switch statement rather than if (this + anticipates MG2 and/or other potential new schemes it will + have to handle). + +M models/atm/cam/src/physics/cam/constituents.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - Added flag for constituents to undergo convective transport + in first or second stage. + +M models/atm/cam/src/physics/cam/eddy_diff.F90 + - Instead of trbintd, ustar now calculated from new calc_ustar + subroutine in pbl_utils. + - Surface density now output with ustar. + +M models/atm/cam/src/physics/cam/hb_diff.F90 + - Made clear that the module declares and uses its own value + for zvir. + - Added HB_ri field for Richardson number. + - Use routines from pbl_utils to calculate virtual + temperature, ustar, kinematic surface fluxes, and Obukhov + length. + - Virtual temperature is now only calculated once and reused, + rather than recalculated several times. + - Removed now-unnecessary arguments from several routines. + - Instead of all constituent fluxes being input, only uses + water vapor. + +M models/atm/cam/src/physics/cam/ndrop_bam.F90 + - Aerosols with no defined dispersion exempted from CCN loops. + +M models/atm/cam/src/physics/cam/phys_control.F90 + - Added wvsat_scheme option, since the scheme can now be + changed. + - Added flag vdiff_compute_obklen to force computation of + Obukhov length outside the vertical diffusion. + +M models/atm/cam/src/physics/cam/phys_grid.F90 + - Added phys_grid_find_cols, identical to phys_grid_find_col + except that it finds multiple nearest columns and uses the + great circle distance to find them. + +M models/atm/cam/src/physics/cam/phys_prop.F90 + - Added 'trim' to string included in endrun message. + +M models/atm/cam/src/physics/cam/physpkg.F90 + - Set convective transport stage for water vapor. + - Added calls to CARMA. + +M models/atm/cam/src/physics/cam/radconstants.F90 +M models/atm/cam/src/physics/cam/radsw.F90 + - CAMRT's radsw no longer thinks it's clever to sneak an index + into the hundredth's place of a float. Sure, it seemed like + the thing to do when it was young and headstrong, but times + have changed, and radsw.F90 has grown up. It has adopted the + more conventional approach of accepting a separate integer + array from radconstants. + - Accordingly, wavmin and wavmax are only available through + an improved accessor function. + +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radlw.F90 +M models/atm/cam/src/physics/rrtmg/radsw.F90 + - Added new spectralflux option. Only used in RRTMG. + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - No longer sets defaults that are always provided via + namelist. + - Accomodates changes in eddy diffusion subroutine arguments. + - If vdiff_compute_obklen == .true., now calculates obklen + itself regardless of the eddy scheme. + +M models/atm/cam/src/physics/cam/wv_saturation.F90 + - 'MurphyKoop' scheme added for new wvsat_scheme option. + +M models/atm/cam/src/physics/cam/zm_conv.F90 + - Removed pcnst dependency (workaround for bug on PGI). + +M models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +M models/atm/cam/src/physics/rrtmg/oldcloud.F90 +M models/atm/cam/src/physics/rrtmg/slingo.F90 + - wavmin and wavmax are now set by accessor function. + +M models/atm/cam/src/physics/rrtmg/rad_solar_var.F90 +M models/atm/cam/src/physics/rrtmg/radconstants.F90 + - Tweak to include far-IR in solar variability is now done in + rad_solar_var rather than radconstants. (Lowest bin extends + down to 100 microns, regardless of actual value.) + - Accessor functions (get_sw/lw_spectral_boundaries) have + minor improvements. + +M models/atm/cam/test/system/input_tests_master + - Added CARMA tests. + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm +M models/atm/cam/src/physics/cam/phys_debug_util.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/utils/cam_pio_utils.F90 + - Cosmetic changes (comments, typos, whitespace). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +edinburgh/lf95: all passed except + +bl318 TBL.sh f10c4cdm sat_hist 9s + + This is an expected answer change, because satellite history + interpolation now uses the correct great circle distance to find + distances to columns. + +edinburgh/pgi or jaguar/pgi: all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: Any with satellite history output. +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + - Diagnostic output in satellite history file changes for some + columns; this has no effect on other output, which is all + bit for bit. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_27 +Originator(s): jedwards, mtaylor, mlevy +Date: 4-20-2012 +One-line Summary: CAM-SE dycore updates, externals update + +Purpose of changes: CAM_SE development, compatability with changes in PIO, driver and csm_share externals + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + added vert_remap_q_alg to allow a toggle between three possible algorythms for vertical remapping in camse + renamed pio_inparm to pio_default_inparm for cam standalone for compatibility with cesm build changes + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Edwards, Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + models/atm/cam/bld/cam.buildnml.csh + models/atm/cam/bld/cam.buildexe.csh + Part of new cesm build mechanism + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/nl_files/aqua + added FU and FV to history file so that dyn grid variables are tested in history restart + models/atm/cam/test/system/TCB_ccsm.sh + removed obsolete option -skip_rundb + models/atm/cam/test/system/TSM_ccsm.sh + Added -f flag to rm to avoid error message when file not found + models/atm/cam/bld/configure + Changed when variables are resolved in cesm build + models/atm/cam/bld/Makefile.in + Corrected rpath flag + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + Changed default cam-se limiter option + models/atm/cam/bld/namelist_files/namelist_definition.xml + Added cam-se vert_remap_q_alg flag controls vertical remapping in dycore, updated pio namelist variable names + models/atm/cam/bld/build-namelist + Change pio namelist name + models/atm/cam/bld/cam.cpl7.template + Code moved to cam.build*.csh + models/atm/cam/SVN_EXTERNAL_DIRECTORIES + update dynamics/homme/share to latest cam-se dycore code + + models/atm/cam/src/dynamics/sld/dyn_grid.F90 + models/atm/cam/src/dynamics/eul/dyn_grid.F90 + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + models/atm/cam/src/dynamics/fv/dyn_grid.F90 + models/atm/cam/src/utils/cam_pio_utils.F90 + Changed from seq_io_mod to shr_pio_mod, changed ldof arrays to kind=pio_offset + + models/atm/cam/src/control/cam_history.F90 + Fixed a problem with camse dyn grid variables in history restart file + + models/atm/cam/src/physics/cam/tidal_diag.F90 + Changed source of constants from shr_const_mod to physconst + models/atm/cam/src/physics/cam/phys_grid.F90 + Changed default load balance option from 0 to 2 + models/atm/cam/src/dynamics/homme/interp_mod.F90 + models/atm/cam/src/dynamics/homme/native_mapping.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + models/atm/cam/src/dynamics/homme/inital.F90 + Updated interface to cam-se share code + + models/atm/cam/src/dynamics/homme/inidat.F90 + Fixed pertlim to apply perturbations to initial temperature field + + SVN_EXTERNAL_DIRECTORIES + Updated externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 070 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL + 073 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL + 082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL +edinburgh/lf95: All pass except + 040 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! + +edinburgh/pgi: All pass except + 044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! + 059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! + 062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Changes to CAM-SE for which we do not yet have a standard climate. + Changes to COSP tests due to the change in default phys_loadbalance from 0 to 2, + this is a bug to be investigated. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_26 +Originator(s): fischer +Date: Mon Apr 9 15:59:20 MDT 2012 +One-line Summary: svn external updates, Makefile updates, testing updates + +Purpose of changes: + +. svn externals updated to cesm1_1_beta11 component tags. csm_share tag had a bug + that was caught by the lahey compiler, so the latest csm_share tag was + needed, along with a newer esmf_wrf_timemgr and clm tags. + +. Makefile.in was updated to set CPPDEF flags to specify different compilers + in the latests csm_share tag. + +. CESM tests for 2deg FAMIPC5 and T42 FC5 were added to bluefire posttag test. + PES layouts for cesm are being overridden by the cam tests scripts. + lrg_regular queue is being used for bluefire testing. + +. fatmgrid was removed from the namelists, now using combined grid/land + fraction data fatmlndfrc + +. atm_id was made public in cam_instance.F90 to speed up lookups in shr_pio_mod + +. New initial condition files for ne16 and ne60 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +. Makefile.in was updated to set CPPDEF flags for the different compilers + in the latests csm_share tag. + For PGI compiler set -DCPRPGI + For INTEL compiler set -DCPRINTEL + For Pathscale compiler set -DCPRPATHSCALE + For Cray compiler set -DCPRCRAY + +Describe any changes made to the namelist: +. new fatmlndfrc files, fatmgrid removed + share/domains/domain.clm/domain.lnd.T85_USGS.111004.nc + share/domains/domain.clm/domain.lnd.T42_USGS.111004.nc + share/domains/domain.lnd.T31_gx3v7.090928.nc + share/domains/domain.lnd.T21_USGS.111004.nc + share/domains/domain.clm/domain.lnd.T5_USGS.111004.nc + + share/domains/domain.lnd.fv0.23x0.31_gx1v6.100517.nc + share/domains/domain.lnd.fv0.47x0.63_gx1v6.090407.nc + share/domains/domain.lnd.fv0.9x1.25_gx1v6.090309.nc + share/domains/domain.lnd.fv1.9x2.5_gx1v6.090206.nc + share/domains/domain.lnd.fv2.5x3.33_gx3v7.110223.nc + share/domains/domain.lnd.fv4x5_USGS.110713.nc + share/domains/domain.lnd.fv10x15_USGS.110713.nc + +. New ncdata files for CAM5 ne16 and ne60 + atm/cam/inic/homme/cami-mam3_0000-01-ne16np4_L30_c090306.nc + atm/cam/inic/homme/cami-mam3_0000-01-ne60np4_L30_c090306.nc + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_posttag_bluefire +M models/atm/cam/test/system/input_tests_master + - add FAMIPC5 and T42 CAM5 tests + +M models/atm/cam/test/system/TCB_ccsm.sh + - override cesm scripts pes layouts for cesm tests + +M models/atm/cam/test/system/test_driver.sh + - change bluefire queue to lrg_regular until we can replace the + ne30 test with an ne16 tests + - updated hopper library paths for NETCDF + +M models/atm/cam/test/system/CAM_runcmnd.sh + - set number of pes pre node to 24 for hopper + +M models/atm/cam/bld/Makefile.in + - added CPPDEF compiler flags -DCPRPGI -DCPRINTEL -DCPRPATHSCALE and + -DCPRCRAY, which are needed to build csm_share + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - added ne16 and ne60 CAM5 ncdata files + - removed fatmgrid, switched to new combined grid/land fraction data files + fatmlndfrc + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist + - removed fatmgrid + +M models/atm/cam/bld/cam.cpl7.template + - fixed problem were cam template was being over written + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated rrtmg externals + +M models/atm/cam/src/control/cam_instance.F90 + - made atm_id public. This was done to make lookups in shr_pio_mod faster. + + +M SVN_EXTERNAL_DIRECTORIES + - updated to cesm1_1_beta11 component tags + - needed to update to latest clm, esmf_wrf_timemgr, and csm_share tags + because of bugs that caused lahey to fail + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Fri Apr 6 09:21:02 MDT 2012 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Fri Apr 6 09:21:10 MDT 2012 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Fri Apr 6 09:21:20 MDT 2012 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Apr 6 09:21:31 MDT 2012 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri Apr 6 09:22:17 MDT 2012 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Apr 6 09:22:43 MDT 2012 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Apr 6 09:23:31 MDT 2012 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Apr 6 09:23:50 MDT 2012 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Apr 6 09:24:16 MDT 2012 +052 bl415 TBL.sh fst1.9c5dh outfrq3s 9s ...................................FAIL! rc= 7 at Fri Apr 6 09:58:04 MDT 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Fri Apr 6 09:59:04 MDT 2012 +057 bl440 TBL.sh fsoa1.9c4dh outfrq3s 9s ..................................FAIL! rc= 7 at Fri Apr 6 10:00:27 MDT 2012 +061 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Fri Apr 6 10:00:42 MDT 2012 +064 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Fri Apr 6 10:15:11 MDT 2012 +067 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Fri Apr 6 11:06:22 MDT 2012 +079 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Fri Apr 6 12:05:46 MDT 2012 +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 7 at Fri Apr 6 13:34:04 MDT 2012 +new clm tag is not bfb and causes baseline failures + + +edinburgh/lf95: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Mon Apr 9 09:47:37 MDT 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Mon Apr 9 09:47:41 MDT 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Mon Apr 9 09:47:46 MDT 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Mon Apr 9 09:47:51 MDT 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Mon Apr 9 09:48:30 MDT 2012 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Apr 9 09:58:14 MDT 2012 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Mon Apr 9 10:13:25 MDT 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Apr 9 10:48:52 MDT 2012 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Mon Apr 9 11:05:56 MDT 2012 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Mon Apr 9 11:11:25 MDT 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Mon Apr 9 11:18:50 MDT 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Mon Apr 9 12:04:00 MDT 2012 +new clm tag is not bfb and causes baseline failures + + +edinburgh/pgi: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Apr 6 11:15:26 MDT 2012 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Apr 6 11:24:26 MDT 2012 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Apr 6 11:35:05 MDT 2012 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Apr 6 11:54:22 MDT 2012 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Apr 6 12:50:52 MDT 2012 +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Apr 6 13:08:14 MDT 2012 +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Fri Apr 6 13:16:02 MDT 2012 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Apr 6 13:34:37 MDT 2012 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 7 at Fri Apr 6 13:44:03 MDT 2012 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Fri Apr 6 13:47:54 MDT 2012 +053 bl321 TBL.sh f10c5cdm atrain 9s .......................................FAIL! rc= 7 at Fri Apr 6 13:53:37 MDT 2012 +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Fri Apr 6 14:25:54 MDT 2012 +new clm tag is not bfb and causes baseline failures + + + +Summarize any changes to answers, i.e.: new clm tag is not bfb and causes baseline failures + +=============================================================== +=============================================================== + +Tag name: cam5_1_25 +Originator(s): fvitt, emmons, mvertens +Date: 23 Mar 2012 +One-line Summary: Corrections to tropospheric chemistry mechanisms and emissions inputs. + +Purpose of changes: + + - Corrections to reactions in tropospheric chemistry packages + to include M in reactions: + MPAN + OH + HCN + OH + - Include HCOOH emissions in default namelist for tropospheric + chemistry packages + - Simplified specifications of default emission files for MAM-chemistry packages + - Change in CAM configure to compile with MPICH2 + - Fix multiple instance in cesm scripts (cam.cpl7.template) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Chris Fischer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/cam.cpl7.template + - Fix multiple instance in cesm scripts + +M models/atm/cam/bld/configure + - check for MPICH2 -- do not set cppdefs NO_MPI2 and MO_MPIMOD for MPICH2 + +M models/atm/cam/bld/build-namelist + - include emissions files for HCOOH for tropospheric chem pkgs + - corrected default emissions for trop_mozart_soa chem pkg + - pass in ref to hash into get_default_value for emissions files + -- use "ver" attribute for emis files to simplify namelist_defaults_cam.xml + - change default emis files for super_fast_llnl_mam3 and trop_mam7 + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - update megan_factors_file + - change location of default trop chem emissions + - specify emissions for mam chemistry with "ver" attribute + to combine many of the deplicate emissions + +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml + - use mapped MEGAN emission factors for isoprene + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.in + - change in chemistry mechanism results in new preprocessor generated + source files, many of which are just change in format + - molecular masses are more presice with updated preprocessor + - added M to reactions: + MPAN + OH + HCN + OH + +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in + - added M to reactions: + MPAN + OH + HCN + OH + +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.in + - change in chemistry mechanism results in new preprocessor generated + source files, many of which are just change in format + - molecular masses are more presice with updated preprocessor + - added M to reactions: + MPAN + OH + HCN + OH (and added .5*CO2 + M products) + +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.in + - added M to reactions: + MPAN + OH + HCN + OH + +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in + - added M to reactions: + MPAN + OH + HCN + OH (and added .5*CO2 + M products) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Thu Mar 22 04:17:54 MDT 2012 + - Change in MEGAN emissions of isoprene using mapped factors + +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Mar 22 04:17:31 MDT 2012 +052 bl415 TBL.sh fst1.9c5dh outfrq3s 9s ...................................FAIL! rc= 7 at Thu Mar 22 04:19:06 MDT 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Mar 22 04:20:07 MDT 2012 +057 bl440 TBL.sh fsoa1.9c4dh outfrq3s 9s ..................................FAIL! rc= 7 at Thu Mar 22 04:20:58 MDT 2012 + - All these failures are due to change in chemitry mechanism and emissions + +076 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Thu Mar 22 06:22:27 MDT 2012 + - As in previous tag, problems with clm namelist variable being changed from fatmgrid to fatmlndfrc + +edinburgh/lf95: All pass + +edinburgh/pgi: + +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 7 at Wed Mar 21 23:47:35 MDT 2012 + - Change in emissions inputs caused this baseline failure for trop_mam7 chemistry + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_24 +Originator(s): fischer, edwards, eaton, neale, mvertens +Date: Mar 16, 2012 +One-line Summary: CAM template update, namelist updates for homme, minor bug fixes + +Purpose of changes: + +. Bring in cam.cpl7.template updates from a branch tag + +. Update namelist option for homme. + Updated soil_erod for the default and homme + cldfrc_permit is now being set for homme + Added ne30 and ne120 ncdata files + +. Add a CAM5 ne30_g16 CESM homme dycore test. + +. Fix memory leak in stratiform.F90. When use_shfrc is false, + then shfrc is allocated, but never deallocated. Allocate was + replaced with a pointer to a local variable. + +. Fixes to testing scripts for hopper and titan/jaguar + Wrong number of processors per node. + +. Fix regular expression for parsing string values in Namelist.pm + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +M models/atm/cam/bld/configure +. Change how SPMD is set + +M models/atm/cam/bld/perl5lib/Build/Namelist.pm +. Fix regular expression for parsing string values in Namelist.pm + +A models/atm/cam/bld/user_nl_cam +. Empty user_nl_cam file that is used by new cam.cpl7.template + +M models/atm/cam/bld/cam.cpl7.template +. Updated cam.cpl7.template + +Describe any changes made to the namelist: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Update to newer soil_erod + Default file was updated, this produces answer changes + Add filenames for ne30, ne60, ne120, and ne240, this produces answer changes for homme +. cldfrc_permit being set for homme instead of default being used +. New ncdata added for ne30, ne120. Still need and ne60 ic. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/input_tests_master +. Add a CESM ne30 CAM5 test + +M models/atm/cam/test/system/TCB_ccsm.sh +. Fix to work with latest cam.cpl7.template + +M models/atm/cam/test/system/CAM_runcmnd.sh +. Set number of processors per node to 16 for hopper and titan/jaguarpf + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. Changed spelling of precipitatable to precipitable + +M models/atm/cam/src/physics/cam/stratiform.F90 +. Memory leak fix. + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +. Change 4 to 2 in a formatted write + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +076 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Thu Mar 15 22:40:00 MDT 2012 +. Problems with clm namelist variable being changed from fatmgrid to fatmlndfrc + +082 bl993 TBL_ccsm.sh ne30_g16 FC5 2d .....................................FAIL! rc= 5 at Thu Mar 15 23:57:26 MDT 2012 +. Expected, this is a new test + + +edinburgh/lf95: +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Mar 15 23:08:11 MDT 2012 +. Expected, updated soil_erod file + + +edinburgh/pgi: +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Mar 15 17:48:37 MDT 2012 +. Expected, updated soil_erod file +059 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Thu Mar 15 20:11:09 MDT 2012 +062 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 7 at Thu Mar 15 21:50:02 MDT 2012 +. Expected updated soil_erod file and cldfrc_permit being set for homme + + +Summarize any changes to answers, i.e., + +=============================================================== +=============================================================== + +Tag name: cam5_1_23 +Originator(s): Francis Vitt +Date: 12 Mar 2012 +One-line Summary: Support for new CLM MEGAN VOC emissions + +Purpose of changes: + + * New functionality for CLM MEGAN VOC emissions + - flexibility in specifying VOC emissions from MEGAN in CLM + * New functionality for offline dyn driver + - ability added to turn off surface feedbacks to climate + met_srf_feedback (default is false) + * New functionality added for generating chem rate diagnostics + * Revived broken trop_mam7 and super_fast_llnl_mam3 chem packages + * Added new chem packages : + - trop_mozart_mam3 + - trop_mozart_soa + - trop_strat_mam3 + * Added ability to support chemistry species names up to 16 characters + * Maximum length for history increased to 24 characters + * Fixed bug in physics_buffer + * Fixed path issues in chem perl build modules for CESM scripts + * Chemistry preprocessor changes : + - supports chem species names up to 16 chars + - remove references to het specifications -- all species can have wet removal + - carbon mass of species output + - calculates molecular masses using double precision to get consistent masses wrt invoking + the preprocessor on different platforms and compilers + - new functionality for generating chem rate diagnostics + * Switched on TMS for SC and SD WACCM + * Misc cleanup in chemistry routines + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Namelist group megan_emis_nl has been added to file drv_flds_in + + Namelist variables: + megan_specifier, megan_mapped_emisfctrs, megan_factors_file + + megan_specifier is a series of strings where each string contains one + CAM chemistry constituent name (left of = sign) and one or more MEGAN + compounds (seperated by + sign if more than one). The specification of + the MEGAN compounds to the right of the = signs tells the MEGAN VOC + model within CLM how to construct the VOC fluxes using the factors in + megan_factors_file and land surface state. + + megan_factors_file read by CLM contains valid MEGAN compound names, + MEGAN class groupings and scalar emission factors + + megan_mapped_emisfctrs switch is used to tell the MEGAN model to use + mapped emission factors read in from the CLM surface data input file + rather than the scalar factors from megan_factors_file + + Example: + &megan_emis_nl + megan_specifier = 'ISOP = isoprene', + 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + 'CH3OH = methanol', + 'C2H5OH = ethanol', + 'CH2O = formaldehyde', + 'CH3CHO = acetaldehyde', + ... + megan_factors_file = '$datapath/megan_emis_factors.nc' + / + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/modal_aero/mo_sethet.F90 + - this separate version is no longer needed and is removed + +D models/atm/cam/src/chemistry/pp_waccm_mozart/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_trop_mozart/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_super_fast_llnl/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_trop_mam3/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_trop_mam7/m_het_id.F90 +D models/atm/cam/src/chemistry/pp_trop_ghg/m_het_id.F90 + - these are no longer used and are removed + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/mozart/rate_diags.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_none/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_rxt_rates_conv.F90 + - these are added to give the user the ability to output reaction rates to history + +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_mozart_mam3 + - new chemistry package added + +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mozart_soa/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_mozart_soa + - new chemistry package added + +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_rxt_rates_conv.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_strat_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_strat_mam3 + - new chemistry package added + +A models/atm/cam/test/system/config_files/fsoa1.9c4dh +A models/atm/cam/test/system/config_files/fm1.9c5dh +A models/atm/cam/test/system/config_files/fst1.9c4dh +A models/atm/cam/test/system/config_files/f7mode4c5dm +A models/atm/cam/test/system/config_files/fsm4c5dm +A models/atm/cam/test/system/config_files/fst1.9c5dh + - new tests added + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/tests_pretag_edinburgh_pgi +M models/atm/cam/test/system/input_tests_master + - new tests added + +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/configure + - new chem pkgs listed above + - clm_vocsrc congifure option removed (now run-time specification) + - removed DUST and PROGSSLT cppdefs which are no longer used + - corrected setting of chem_proc_src and chem_proc_src paths for CESM scripts + - added NO__MPIMOD and NO_SIZEOF cppdefs for use of new PIO on edinburgh + +M models/atm/cam/bld/Makefile.in + - use NO_MPIMOD and NO_MPI2 when _MPISERIAL is used + - fixed LDFLAGS for lahey so that we can build on systems that do have the ../lf6481/lib64 path + the "-Wl,-rpath ..." flags do not seem to be needed + +M models/atm/cam/bld/build-namelist + - removed the flds_voc namelist var (now handled in drv_flds_in namelist file) + - removed reference to the clm_vocsrc config setting (no longer applies) + the MEGAN VOC specifications should be done via build-namelist use cases + or user_nl_cam + - the set_dep_list perl routine needs chem_proc_src path to get correct species lists when + the chem preprocessor is invoked. + - added code for 7-mode modal aerosols + - mods for trop_mozart_mam3, trop_mozart_soa, trop_strat_mam3 + - corrections to trop_mam7 settings + - include megan_emis_nl (for MEGAN VOC emissions from CLM) in comp_gruops + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - added defaults for new chemistry pkgs + - 7-mode mam phys props and optics files -- some of these defaults are not correct + - defaults added for trop_mam7 emissions files + - set drydep_method to xactive_atm for super_fast_llnl_mam3 and mozart_mam3 chem pckgs + - set dust_emis_fact to 0.35 for all cam5 configurations regardless of chemistry + - default megan factors file + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - moved met namelist opts for offline dyn driver from cam_inparm to metdata_nl + - added new options for offline dyn driver + - made fexcl, fincl and fwrtpr namelist type specifications consistent with array declarations in runtime_opts + - added namelist vars for specification of CLM MEGAN VOC emissions + - removed "flds_voc" namelist var + - for cplflds_custom namlist var seq_cplflds_inparm -> seq_cplflds_userspec + to support latest driver + +M models/atm/cam/bld/namelist_files/master_gas_wetdep_list.xml +M models/atm/cam/bld/namelist_files/master_aer_wetdep_list.xml +M models/atm/cam/bld/namelist_files/master_drydep_list.xml + - added species for new trop_mozart_soa chem + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml + - switched on TMS + - new wasolar forcing file which does not include 29 Feb 2100 + +M models/atm/cam/bld/namelist_files/use_cases/waccmx_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml + - new wasolar forcing file which does not include 29 Feb 2100 + +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml + - added megan specifer namelist + +M models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - fixed a bug set_dep_lists which occurs when the chem preprocessor is used + - fixed chem_src_dir and chem_proc_src paths problem for CESM scripts + - removed setting DUST and PROGSSLT cppdefs + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updates to chemistry preprocessor + - supports chem species names upto 16 chars + - remove references to het specifications -- all species can have wet removal + - carbon mass of species output + - calc molecular masses using double precision to get consistent masses wrt invoking + the preprocessor on different platforms and compilers + - new functionality for generating chem rate diagnostics + +M models/atm/cam/src/control/runtime_opts.F90 + - use history fieldname_len declared in cam_history_support for consistency + - moved met namelist opts for offline dyn driver from cam_inparm to metdata_nl in metdata.F90 +M models/atm/cam/src/control/cam_history_support.F90 + - increased fieldname_len to support longer constituent names + +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 + - moved invocation of offline dyn driver get_met subroutines to physpkg level + +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +M models/atm/cam/src/cpl_share/cam_cpl_indices.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 + - changes for new MEGAN VOC surface fluxes + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - changes to be able to run 7 mode version of MAM + - prog_modal_aero needs to be true for super_fast_llnl_mam3 and mozart_mam3 + + +M models/atm/cam/src/physics/cam/phys_control.F90 + - need to suppor longer chempkg names + - prog_modal_aero logical added + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 + - include hist fields for trop_mam7 + +M models/atm/cam/src/physics/cam/ndrop.F90 + - get prog_modal_aero logical from phys_getopts + +M models/atm/cam/src/physics/cam/physics_buffer.F90 +M models/atm/cam/src/physics/cam/physics_buffer.F90.in + - changes to support more diminsions physics buffer arrays + +M models/atm/cam/src/physics/cam/constituent_burden.F90 + - increase burdennam length for longer constituent names + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/physics/waccmx/majorsp_diffusion.F90 + - waccmx corrections from 1.0.4 release version + +M models/atm/cam/src/chemistry/utils/modal_aero_deposition.F90 + - changes needed to run trop_mam7 + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 + - format change for readability + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + - set prog_modal_aero logical from phys_getopts + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - changes needed to have modal aerosol with mozart chemistry + - removal of the obsolete hetcnt reference + +M models/atm/cam/src/chemistry/mozart/mo_tracname.F90 + - increased species name length (up to 16 chars) + +M models/atm/cam/src/chemistry/mozart/mo_exp_sol.F90 + - removal of the obsolete hetcnt reference + +M models/atm/cam/src/chemistry/mozart/mo_cph.F90 + - reaction tag names changed for the waccm chemical potential heating reactions + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - pass pbuf pointer into sao_inti + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - removed assumption made about the indexing of modal aerosols + - removal of the obsolete hetcnt reference + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - prog_modal_aero needs to be true for super_fast_llnl_mam3 and mozart_mam3 + - increase chem_name + - chem_reset_fluxes subroutine added to initialize chem srf emissions each time set + including MEGAN emissions from CLM + - soa_register added + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - dry dep added for new SOA species + - allocate and initialize fraction_landuse array for modal aerosol dry dep + +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 + - changes needed for new chem pkgs (SOA) + - merged in modal version here + - removal of the obsolete hetcnt reference + + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - change tag names of waccm ion reactions + - incorporate modal aerosols + +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 + - changes needed for new SOA chem pkg + + +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - removed the assumption of which species has emissions set elsewhere + -- now simply added what is specified in file to the surf fluxes + - does not set surf fluxes to zero + - cleaned up the MODAL ifdefs + +M models/atm/cam/src/physics/cam/radheat.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 + - changes for offline dyn driver new feature + +M SVN_EXTERNAL_DIRECTORIES + - update driver to drvseq4_1_04 for MEGAN + - update clm to megan05_clm4_0_40 for MEGAN + - update pio to pio1_4_2 to support more dimensions in physics buffer + - scripts updated to scripts4_120307 to support new pio + - machines updated to Machines_120307 to support new pio + +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in + - change in cph tag names + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.in + - change in cph tag names + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_none/chemistry.F90 +A models/atm/cam/src/chemistry/pp_none/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_none/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_none/chem_mech.in +M models/atm/cam/src/chemistry/pp_none/mo_lin_matrix.F90 + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +D models/atm/cam/src/chemistry/pp_trop_bam/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +D models/atm/cam/src/chemistry/pp_trop_ghg/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.doc + - cleanup + - added capability to write reaction rates to history + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon Mar 12 02:13:11 MDT 2012 + srf emis for ISOP has changed (new MEGAN emis) thus this is expected to fail + +052 bl415 TBL.sh fst1.9c5dh outfrq3s 9s ...................................FAIL! rc= 5 at Mon Mar 12 02:13:12 MDT 2012 +054 bl430 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 5 at Mon Mar 12 02:13:12 MDT 2012 +057 bl440 TBL.sh fsoa1.9c4dh outfrq3s 9s ..................................FAIL! rc= 5 at Mon Mar 12 02:13:13 MDT 2012 + these baseline tests for new chem pckgs are expected to fail + +076 eq991 TEQ_ccsm.sh f19_f19 F f1.9c4m fcase 2d ..........................FAIL! rc= 7 at Mon Mar 12 03:13:02 MDT 2012 +079 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Mon Mar 12 03:40:51 MDT 2012 + these failures are do to update to CLM which caused namelist inconsistencies + +edinburgh/lf95: + +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Mar 12 06:26:41 MDT 2012 + expected to fail due to TMS switch on + +edinburgh/pgi: + +036 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Sun Mar 11 20:43:34 MDT 2012 + expected to fail due to TMS switch on + +056 bl420 TBL.sh f7mode4c5dm outfrq3s 9s ..................................FAIL! rc= 5 at Sun Mar 11 22:31:14 MDT 2012 + new test expected to fail + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_22 +Originator(s): fischer +Date: 2-28-2012 +One-line Summary: Fixes for cam template + +Purpose of changes: + +. cam.cpl7.template has two bug fixes in it, this only affects + running with the cesm scripts + - Incorrect number of tasks was being sent to build-namelist + when mutliple instances of cam is running. + - drv_flds_in needed to be copied to the cesm run directory. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/cam.cpl7.template +. diveded ntasks my the number of atm instances +. copy drv_flds_in from Buildconf/camconf to the run directory + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +edinburgh/lf95: + +edinburgh/pgi or jaguar/pgi: + +Summarize any changes to answers: all bfb + +=============================================================== +=============================================================== + +Tag name: cam5_1_21 +Originator(s): fischer, eaton, mvertens +Date: Feb 23 07:50:11 MST 2012 +One-line Summary: namelist changes, CAM5 RCP and homme fixes, COSP restart + +Purpose of changes: +. Namelist changes to support user_nl_comp and preview_namelist scripts + changes in cesm. +. Bug fix for old formatted fields in rad_diag for CAM5 RCP use_cases +. Fixes to get CAM5 homme with chemistry working out of box +. Fix added so COSP branch runs will work when using restart files from + a non COSP run. + +Bugs fixed (include bugzilla ID): + + +Describe any changes made to build system: +M cam/bld/configure +. Removed -DSPMD for cesm + +M cam/bld/build-namelist +. Fixes so aerosol deposition datasets aren't added to the namelist + when running in aqua planet. +. Removed $pathname = strip_rootdir... so cesm user_nl_comp and + preview_namelist work correctly + +M cam/bld/cam.cpl7.template +. Changes so cesm user_nl_comp and preview_namelist work correctly. +. -DSMPD is set here + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm +. $CODEROOT dir needed to be resolved for cesm runs + +Describe any changes made to the namelist: +M cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp60.xml +M cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp26.xml +M cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp45.xml +M cam/bld/namelist_files/use_cases/2006-2100_cam5_rcp85.xml +. Fields in rad_diag needed to be updated to the new format + + +M cam/bld/namelist_files/namelist_defaults_cam.xml +. drydep_srf_file fix for homme/cam5 +M cam/bld/namelist_files/namelist_definition.xml +. Path for drydep_srf_file was not resolving because input_pathname wasn't being set. + + + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +A cam/test/system/config_files/s64c5dh +A cam/test/system/config_files/s64adh +A cam/test/system/config_files/s64idh +A cam/test/system/config_files/s64c5paqdh +. config files needed for s64 tests + +A cam/test/system/config_files/h16c5aqdm +M cam/test/system/tests_pretag_edinburgh_pgi +M cam/test/system/input_tests_master +. Add new homme test with chemistry + +M models/atm/cam/test/system/nl_files/user_nl_cam +M models/atm/cam/test/system/TCB_ccsm.sh +. Changes so cesm user_nl_comp and preview_namelist work in testing. + +M models/atm/cam/src/physics/cam/restart_physics.F90 +. Added test for cossp_cnt_init, if missing then cosp_cnt_init is set to 0. + This allows a COSP branch run from run that didn't have COSP turned on. + +M SVN_EXTERNAL_DIRECTORIES +. update tags for cesm user_nl_comp and preview_namelist. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +edinburgh/lf95: all passed + +edinburgh/pgi or jaguar/pgi: +059 bl735 TBL.sh h16c5aqdm outfrq3s+aquaplanet_cam5 9s ....................FAIL! rc= 5 at Wed Feb 22 15:08:45 MST 2012 + expected, new test + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bfb + +=============================================================== +=============================================================== + +Tag name: cam5_1_20 +Originator(s): fischer, eaton, craig, mvertens, edwards +Date: Feb 7, 2012 +One-line Summary: coupler fields and esmf interface updates, remove csim4 + +Purpose of changes: + +. Update ESMF interfaces for ESMF ver 5.2.0, and update coupler filed names. + Merged with branch_tags/e52r_tags/e52r02_newcplflds03_cam5_1_16 + +. Remove csim4 + +. merge pbuf changes from branch_tags/spcam_cam5_1_17_tags/spcam01_cam5_1_17 + +. Update svn externals + +. Add r8 tests for dynamics/homme, skip dynamics/homme/share + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +M models/atm/cam/bld/config_files/definition.xml +. remove csim4 + +M models/atm/cam/bld/configure +. Refactor configure to have just one method for writing the Filepath file +. csim4 removed + +Describe any changes made to the namelist: +M models/atm/cam/bld/build-namelist +. add seq_cplflds_inparm group to the driver namelist file +. set flds_voc = .false. + flds_co2a = .true. + flds_co2b = .false. + flds_co2c = .false. + flds_co2_dmsa = .false. + cplflds_inparm = "" +. set do_rtm to false in the clm namelist file + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. add flds_voc, flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, + cplflds_inparm to the driver namelist file (drv_in) +. add do_rtm so river run off can be turned off in the clm namelist file + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/src/utils/cam_csim4 +. Removed csim4 + +D models/atm/cam/src/physics/cam/advnce.F90 +. merge in pbuf changes from branch_tags/spcam_cam5_1_17_tags/spcam01_cam5_1_17 + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/input_tests_master +. Add s64 tests +. e48c5m test removed + +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/phys_debug.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +. merge in pbuf changes from branch_tags/spcam_cam5_1_17_tags/spcam01_cam5_1_17 + +M models/atm/cam/test/system/config_files/f10c3dm +. replace csim4 with cice + +M models/atm/cam/test/system/tests_posttag_bluefire +. remove s32 tests, add s64 tests + +M models/atm/cam/test/system/TR8.sh +. Add R8 test from dynamics/homme, skip dynamics/homme/share + +M models/atm/cam/test/system/tests_pretag_edinburgh_lahey +M models/atm/cam/test/system/tests_pretag_edinburgh_pgi +. Move r8 test from lahey test list to pgi test list +. Add f10c3dm test for pgi + +M models/atm/cam/src/dynamics/homme/nctopo_util_mod.F90 +. fixed end module statement for the R8 test + +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/native_mapping.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/homme/stepon.F90 +. insterted missing _r8s. + +M models/atm/cam/bld/cam.cpl7.template +. USE_MPISERIAL test changed to MPILIB == 'mpi-serial' +. extra echo removed + +M models/atm/cam/src/cpl_share/cam_cpl_indices.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +. couple field name changes + +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/utils/cam_dom/ocn_time_manager.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_mct.F90 +. ESMF interface update to 5.2.0 + + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +. couple field name changes +. ESMF interface update to 5.2.0 + +M models/atm/cam/src/utils/cam_dom/cpl_mct/ocn_comp_mct.F90 +M models/atm/cam/src/utils/cam_aqua/cpl_mct/ocn_comp_mct.F90 +. New fields are being passed to ocn_final_mct from the coupler. + +M models/atm/cam/src/physics/cam/convect_shallow.F90 +. Bug fix for 6 outfld calls that declared the 1st dimension of the + output array to be size pcols, but then passed an array section of + dimensioned ncol. + + +M SVN_EXTERNAL_DIRECTORIES +. Update externals + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +063 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 7 at Thu Feb 2 16:12:20 MST 2012 +066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Thu Feb 2 16:12:53 MST 2012 + expected dynamics/homme missing r8s inserted + + +edinburgh/lf95: all passed + + +edinburgh/pgi: +039 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Tue Jan 31 17:40:58 MST 2012 + csim4 replaced with cice + +056 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 7 at Tue Jan 31 19:11:09 MST 2012 + expected dynamics/homme missing r8s inserted + + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + HOMME will have answer changes due to missing r8s being insterted in + /dynamics/homme, and not the share directory + CSIM4 replace with CICE in tests caused answer changes. + + +=============================================================== +=============================================================== + +Tag name: cam5_1_19 +Originator(s): Jim Edwards, Jen Kay +Date: 01-20-2012 +One-line Summary: Intel compiler port, Make restarts double, COSP bug fix + +Purpose of changes: Intel compiler port, Make restarts double, COSP bug fix + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/test_driver.sh + Adjusted modules used on lynx + models/atm/cam/test/system/tests_pretag_edinburgh_pgi + models/atm/cam/test/system/input_tests_master + Added a test 321 for cosp atrain + models/atm/cam/src/control/cam_history.F90 + Make sure that restart files are always douple precision + models/atm/cam/src/physics/cam/cldwat2m_macro.F90 + models/atm/cam/src/physics/cam/uwshcu.F90 + models/atm/cam/src/physics/cam/vertical_diffusion.F90 + models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + An assumption was made about the location of cldliq and cldice fields + in the constituents array. This assumption was incorrect and was removed. + models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + 1) addition of allocate statement circa line 526. + 2) match atrain file longitude range to model + models/atm/cam/src/dynamics/eul/inidat.F90 + models/atm/cam/src/dynamics/eul/prognostics.F90 + models/atm/cam/src/dynamics/eul/stepon.F90 + Change subroutine calls so that intel compiler doesn't complain when endlat 0) + - redo ndrop interfaces to pass cam types as per physics interface + - replace local calc of pi with physconst version, and replace hardcoded + value of sqrt(2*pi) by computed value. +. implement rad_constituent interfaces +. add logic so that tendencies are only computed for prognostic MAM +. remove the MODAL_AERO ifdef except around the code that does the tendency + calculations. +. rework local arrays that were declared with a pcnst dimension, but only + needed storage for the modal number densities and species mmr. Use a + local indexing scheme for those constituents. + +models/atm/cam/src/physics/cam/phys_prop.F90 +. add fields for the modal optics and properties to the physprop_type + structure. +. modify logic to read physprop files for modes as well as for bulk + aerosols. +. move the reading of bulk aerosol properties into separate routine and + only call when appropriate. +. add new method for reading modal physprop files + +models/atm/cam/src/physics/cam/physpkg.F90 +. remove unused pbuf and phys_state args from rad_cnst_init call +. replace phys_state arg by pbuf in prognostic_aerosol_initialize call +. remove some unnecessary array bounds and just pass entire phys_state array + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. extensions to support modal aerosols + - a new namelist variable, mode_defs, was added to supply metadata + defining the modes. + - add parsing for new mode_defs variable + - extend parsing of rad_climate and rad_diag_* variables to include + modes. + - create new internal data structures for the mode definitions and for + mode lists which are analogous to the gas and bulk aerosol lists. + - move the initialization of data structures that contain information + specified in the namelist up into rad_cnst_readnl so that this info is + available elsewhere via the rad_cnst_get_info method as early in the + initialization process as possible. + - generic method rad_cnst_get_info has been extended to return info about + the mode definitions + - rad_cnst_get_aer_mmr and rad_cnst_get_aer_props have been extended to + return mixing ratios and props for the mode species + - rad_cnst_get_mode_num and rad_cnst_get_mode_props have been added to + provide the number mixing ratio and properties that are specific to + modes. + - removed some optional args from the get_info method for data that + should remain private in the module. +. rad_cnst_init and init_lists -- remove unused args pbuf & phys_state + +models/atm/cam/src/physics/cam/radiation_data.F90 +. use rad_constituent interfaces to access mixing ratio data -- old code + was accessing metadata which is meant to be private in the + rad_constituents module by extending rad_cnst_get_info, then using this + metadata to directly access the mixing ratios in the state and pbuf + structures. The rad_cnst_get_gas and rad_cnst_get_aer_mmr interfaces are + supposed to be used for this. + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove unused cam5 macro/micro physics code + +models/atm/cam/src/physics/cam/tphysac.F90 +. fix aerosol_emis_intr interface to make ifdef MODAL_AERO unnecessary + +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. move the initialization of the physics buffer fields tke and kvh into the + vertical diffusion init method. + +models/atm/cam/src/physics/rrtmg/oldcloud.F90 +. cleanup -- remove some unused code + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. move the add_default calls for radiation diagnostics inside the loop over + diagnostic calculations so that when diagnostic calculations are + requested the output from those calculations is added to the history file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Fri Oct 28 16:05:11 MDT 2011 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Oct 28 16:09:44 MDT 2011 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Oct 28 16:28:12 MDT 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Fri Oct 28 16:59:22 MDT 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Oct 28 17:16:34 MDT 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Oct 28 18:00:24 MDT 2011 + +All failures are expected baseline comparison failures. + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Oct 28 15:36:52 MDT 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Oct 28 15:51:40 MDT 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Oct 28 16:03:04 MDT 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Oct 28 16:07:47 MDT 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Oct 28 16:37:10 MDT 2011 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Oct 28 19:09:29 MDT 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Oct 28 19:51:59 MDT 2011 + +All failures are expected baseline comparison failures. + +There is a bug in PGI compiler versions earlier than 11.0 which prevent it +from compiling the new rad_constituents.F90 file. There is no obvious +workaround for this bug, so until edinburgh gets an updated pgi the testing +will be done on one of the cray platforms. + +hopper/pgi-11.7: All PASS except: +005 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Oct 28 14:33:20 PDT 2011 +010 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Oct 28 14:35:05 PDT 2011 +012 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Oct 28 14:35:06 PDT 2011 +016 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Oct 28 14:35:14 PDT 2011 +023 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Oct 28 14:35:19 PDT 2011 +031 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Oct 28 14:35:39 PDT 2011 +041 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Oct 28 14:35:41 PDT 2011 +044 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Oct 28 14:35:47 PDT 2011 +047 bl319 TBL.sh fn10c5dm outfrq3s_bam 9s .................................FAIL! rc= 5 at Fri Oct 28 14:35:47 PDT 2011 +050 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Fri Oct 28 14:35:50 PDT 2011 +053 bl734 TBL.sh hn16c5aqdm outfrq3s_bam+aquaplanet_cam5 9s ...............FAIL! rc= 5 at Fri Oct 28 14:35:50 PDT 2011 + +These baseline failures are all expected due to the different answers from +cam5 w/ trop_mam3. Two tests, bl319 and bl734 failed due the test +definitions changing and the new test wasn't defined for the baseline. But +when the new test is added to the baseline cam5_1_11, then the failures in +those tests, as in bl320, is due to a roundoff diff in the diagnostic field +CCN3. The simulations are actually identical. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: The answers are bit for bit except for +configurations with cam5 physics and trop_mam3 chemistry. In that case a +single precision size roundoff change was introduced, and has been +validated by the climate runs below. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: + +Runs done on bluefire using cesm scripts. + control: + $SVNREPO/cam1/branch_tags/r8_cam5_1_03_tags/r8b_cam5_1_03/ + create_newcase -compset F1850C5 -res f19_f19 -mach bluefire -case /blhome/fischer/runs/cam5_1_03_1850_r8 + experiment: + $SVNREPO/cam1/branch_tags/radcnst_cam5_1_11_tags/radcnst06_cam5_1_11/ + create_newcase -compset F1850C5 -res f19_f19 -mach bluefire -case /glade/home/fischer/runs/cam5_1_11_radcnst06 + +MSS location of control simulations used to validate new climate: + control: /FISCHER/csm/cam5_1_03_1850_r8 + experiment: /home/fischer/csm/cam5_1_11_radcnst06 + +URL for AMWG diagnostics output used to validate new climate: + http://www.cgd.ucar.edu/cms/fischer/cam5/cam5_1_11_radcnst06-cam5_1_03_1850_r8 + +=============================================================== +=============================================================== +Tag name: cam5_1_11 +Originator(s): fischer +Date: Oct 11 2011 +One-line Summary: add missing explicit r8 kind, fix TKE and CUSH init + +Purpose of changes: +. Add testing for missing explicit r8 kind +. Add missing explicit r8 kind to F90 code +. Didn't add missing explicit r8 kind or tests for external code +. Fix initialization bug (#1378) for TKE and CUSH. + +Bugs fixed (include bugzilla ID): #1378 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fischer + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam/miesubs.F +. not being used + +List all subroutines added and what they do: +A models/atm/cam/test/system/TR8.sh +. test for missing explicit r8 kind + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/tests_pretag_edinburgh_pgi +M models/atm/cam/test/system/input_tests_master +. add test for missing explicit r8 kind + +M models/atm/cam/src/physics/cam/convect_shallow.F90 +. remove initialization of TKE and CUSH (bug #1378) +. add missing explicit r8 kind + + +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/control/interpolate_data.F90 +M models/atm/cam/src/control/scamMod.F90 +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/utils/cam_csim4/ice_time_manager.F90 +M models/atm/cam/src/utils/cam_dom/ocn_time_manager.F90 +M models/atm/cam/src/utils/pilgrim/mod_comm.F90 +M models/atm/cam/src/utils/pilgrim/unit_testers/ghosttest.F90 +M models/atm/cam/src/utils/pilgrim/unit_testers/redistributetest.F90 +M models/atm/cam/src/utils/pilgrim/unit_testers/decomptest.F90 +M models/atm/cam/src/utils/pilgrim/unit_testers/parutilitiestest.F90 +M models/atm/cam/src/utils/pilgrim/unit_testers/parpatterntest.F90 +M models/atm/cam/src/utils/repro_sum_mod.F90 +M models/atm/cam/src/physics/cam/cam3_aero_data.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/rayleigh_friction.F90 +M models/atm/cam/src/physics/cam/flux_avg.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/phys_prop.F90 +M models/atm/cam/src/physics/cam/hirsbt.f90 +D models/atm/cam/src/physics/cam/miesubs.F +M models/atm/cam/src/physics/cam/sslt_rebin.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/radlw.F90 +M models/atm/cam/src/physics/cam/hb_diff.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/phys_debug_util.F90 +M models/atm/cam/src/physics/cam/rad_constituents.F90 +M models/atm/cam/src/physics/cam/mcshallow.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +M models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +M models/atm/cam/src/physics/cam/rad_solar_var.F90 +M models/atm/cam/src/physics/cam/phys_grid.F90 +M models/atm/cam/src/physics/cam/phys_debug.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/cam/uw_conv.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_photo.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sad.F90 +M models/atm/cam/src/chemistry/utils/mo_constants.F90 +M models/atm/cam/src/chemistry/utils/mo_util.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/solar_data.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/modal_aero/mo_sethet.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_calcsize.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_ghg_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_airmas.F90 +M models/atm/cam/src/chemistry/mozart/mo_trislv.F90 +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_schu.F90 +M models/atm/cam/src/chemistry/mozart/mo_lymana.F90 +M models/atm/cam/src/chemistry/mozart/mo_calcoe.F90 +M models/atm/cam/src/chemistry/mozart/mo_aerosols.F90 +M models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +M models/atm/cam/src/chemistry/mozart/gas_wetdep_opts.F90 +M models/atm/cam/src/chemistry/mozart/mo_ps2str.F90 +M models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 +M models/atm/cam/src/chemistry/mozart/mo_sphers.F90 +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 +M models/atm/cam/src/chemistry/mozart/mo_setozo.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +M models/atm/cam/src/chemistry/mozart/cfc11star.F90 +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +M models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/mo_setcld.F90 +M models/atm/cam/src/chemistry/mozart/mo_xsections.F90 +M models/atm/cam/src/chemistry/mozart/mo_inter.F90 +M models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsox.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/sld/sld_control_mod.F90 +M models/atm/cam/src/dynamics/eul/eul_control_mod.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/forecast.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +M models/atm/cam/src/dynamics/eul/stepon.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dryairm.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/ctem.F90 +. add missing explicit r8 kind + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Mon Oct 10 09:50:55 MDT 2011 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Oct 10 09:51:03 MDT 2011 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Mon Oct 10 09:51:05 MDT 2011 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Mon Oct 10 09:51:14 MDT 2011 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Mon Oct 10 09:51:26 MDT 2011 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Mon Oct 10 09:52:15 MDT 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Oct 10 09:52:22 MDT 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Oct 10 09:52:47 MDT 2011 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Mon Oct 10 09:53:35 MDT 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Oct 10 09:53:54 MDT 2011 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon Oct 10 09:54:19 MDT 2011 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Mon Oct 10 09:54:32 MDT 2011 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Mon Oct 10 09:54:42 MDT 2011 +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Mon Oct 10 10:08:24 MDT 2011 +072 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Mon Oct 10 11:27:41 MDT 2011 + + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Oct 7 10:05:05 MDT 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Fri Oct 7 10:23:38 MDT 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Fri Oct 7 10:41:40 MDT 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Fri Oct 7 10:47:03 MDT 2011 +018 bl115 TBL.sh e8idm idphys 9s ..........................................FAIL! rc= 7 at Fri Oct 7 10:55:59 MDT 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Oct 7 11:30:05 MDT 2011 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Oct 7 14:53:54 MDT 2011 +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Fri Oct 7 15:05:18 MDT 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Oct 7 15:38:46 MDT 2011 +038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Fri Oct 7 15:52:18 MDT 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Oct 7 16:16:54 MDT 2011 +043 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Fri Oct 7 16:40:26 MDT 2011 + + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Oct 7 09:50:03 MDT 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Fri Oct 7 09:57:42 MDT 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 5 at Fri Oct 7 10:01:33 MDT 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Fri Oct 7 10:04:17 MDT 2011 +018 bl115 TBL.sh e8idm idphys 9s ..........................................FAIL! rc= 7 at Fri Oct 7 10:08:53 MDT 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Oct 7 10:19:37 MDT 2011 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Fri Oct 7 10:49:54 MDT 2011 +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Fri Oct 7 10:55:05 MDT 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Oct 7 11:03:37 MDT 2011 +038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Fri Oct 7 11:09:38 MDT 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Fri Oct 7 11:15:43 MDT 2011 +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Oct 7 11:26:42 MDT 2011 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Oct 7 11:34:07 MDT 2011 +049 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Fri Oct 7 11:37:14 MDT 2011 +052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Fri Oct 7 12:06:39 MDT 2011 + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.: Adding in the missing explicit r8 kind caused greater than + roundoff error. But climate is still preserved. + +Runs done on bluefire using cesm scripts. + +control: $SVNREPO/cam1/trunk_tags/cam5_1_03/ +create_newcase -compset F1850C5 -res f19_f19 -mach bluefire -case /blhome/fischer/runs/cam5_1_03_1850_OOB +create_newcase -mach bluefire -res f19_g16 -compset FMOZ -case /blhome/fischer/runs/mozt5_1_03_2000_OOB +create_newcase -mach bluefire -res f19_g16 -compset F1850W -case /blhome/fischer/runs/waccm5_1_03_1850_OOB +create_newcase -res f19_f19 -compset F_SD_WACCM -mach bluefire -case /blhome/fischer/runs/wcm_offline_OOB + +experiment: $SVNREPO/cam1/branch_tags/r8_cam5_1_03_tags/r8b_cam5_1_03/ +create_newcase -compset F1850C5 -res f19_f19 -mach bluefire -case /blhome/fischer/runs/cam5_1_03_1850_r8 +create_newcase -mach bluefire -res f19_g16 -compset FMOZ -case /blhome/fischer/runs/mozt5_1_03_2000_r8 +create_newcase -mach bluefire -res f19_g16 -compset F1850W -case /blhome/fischer/runs/waccm5_1_03_1850_r8 +create_newcase -res f19_f19 -compset F_SD_WACCM -mach bluefire -case /blhome/fischer/runs/wcm_offline_r8 + + +MSS location of control simulations used to validate new climate: + +Control runs: +/FISCHER/csm/cam5_1_03_1850_OOB +/FISCHER/csm/mozt5_1_03_2000_OOB +/FISCHER/csm/waccm5_1_03_1850_OOB +/FISCHER/csm/wcm_offline_OOB + +Experiment runs: +/FISCHER/csm/cam5_1_03_1850_r8 +/FISCHER/csm/mozt5_1_03_2000_r8 +/FISCHER/csm/waccm5_1_03_1850_r8 +/FISCHER/csm/wcm_offline_r8 + +URL for AMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/cms/fischer/cam5/cam5_1_03_1850_r8-cam5_1_03_1850_OOB/ +http://www.cgd.ucar.edu/cms/fischer/r8/mozart/mozt5_1_03_2000_r8-mozt5_1_03_2000_OOB/ +http://www.cgd.ucar.edu/cms/fischer/r8/waccm/waccm5_1_03_1850_r8-waccm5_1_03_1850_OOB/ +http://www.cgd.ucar.edu/cms/fischer/r8/waccm/wcm_offline_r8-wcm_offline_OOB/ + +=============================================================== +=============================================================== +Tag name: cam5_1_10 +Originator(s): fischer, jedwards, Mark Taylor +Date: Thu Oct 6 2011 +One-line Summary: Update externals, memory use reduction, fix column data output + +Purpose of changes: +. Updated SVN externals to match cesm1_1_beta03 +. Memory reduction in src/chemistry/mozart/mo_drydep.F90 provided my + Mark Taylor +. Fix bug where column data was the same across history files +. Improve column data test + +Bugs fixed (include bugzilla ID): +. #1417 CAM history column output: h0 column data same as h1 column + data even when specified to be different + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: +. 250MB reduction for CAM5 1/8 degree with changes to + src/chemistry/mozart/mo_drydep.F90 + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/nl_files/ghgrmp +. improve column data testing + +M models/atm/cam/src/control/cam_history_support.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/utils/cam_pio_utils.F90 +. bug #1417 fix + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +. Memory usage reduction for CAM5 + +M SVN_EXTERNAL_DIRECTORIES +. Updated to cesm1_1_beta03 svn externals + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed, except for TBL with ghgrmp + +edinburgh/lf95: all passed, except for TBL with ghgrmp + +edinburgh/pgi: all passed, except for TBL with ghgrmp + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Test with ghgrmp where changed for better column data + testing. This causes TBLs for these tests to fail. + +=============================================================== +=============================================================== + +Tag name: cam5_1_09 +Originator(s): Edwards +Date: 09-27-2011 +One-line Summary: Add radiation_scheme string + +Purpose of changes: Memory usage reduction for cam5 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: Added variable + radiation_scheme with allowed values 'rrtmg' and 'camrt' + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + Memory reduction when using rrtmg since these 4D camrt variables were allocated but not required. + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + bld/namelist_files/namelist_defaults_cam.xml + bld/namelist_files/namelist_definition.xml + bld/build-namelist + physics/cam/phys_control.F90 + physics/cam/radae.F90 + Add support for radiation_scheme variable, allocate 4D structures only + for camrt radiation + + physics/rrtmg/radiation.F90 + Remove unnessasary use of radae + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass + +edinburgh/lf95: All pass + +edinburgh/pgi or jaguar/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_08 +Originator(s): Francis Vitt +Date: 21 Sep 2011 +One-line Summary: Misc bug fixes + +Purpose of changes: + + Bug fixes include : + + - correction to O3 chemical loss rate diagnostic + - fixed a restart problem that occurs when empty_htapes=.true. in waccm configurations + - corrections to time-averaging history output + - correction to sathist output of dynamics decomposed variables on the HOMME grid + - replaced "physconst, only: amass => mwdry" with "physconst, only: mwdry" in several + chemistry modules to appease the PGI 9.3 compiler + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml + - the first meteorology data file contains one month of data so that + one can run more than one day with data which is downloaded from the + subversion inputdata repository + +M models/atm/cam/test/system/nl_files/sat_hist + - include more output fields for more thorough tests of sat_hist and + local-time averaging outputs + +M models/atm/cam/src/control/cam_history_buffers.F90 + - corrections to local-time averaging accumulation + +M models/atm/cam/src/control/sat_hist.F90 + - correction to column output of dynamics decomposed variables on the HOMME grid + - moved dyn_find_col subroutine code to the dyn_grid module + +M models/atm/cam/src/control/cam_history.F90 + - fixed a restart problem that occurs when empty_htapes=.true. in waccm configurations + - corrected the buffer allocations for time-averaging output + - corrected the h_normalize subroutine for time-averaging output buffer + +M models/atm/cam/src/physics/cam/hb_diff.F90 + - correction to the TKE diagnostic so that it will be the same for different + MPI configurations + +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 + - added untility methods to find column nearest a specified coordinate and + determine coordinates of a specified element (or lat slice), which + are used in sat_hist and local-time averaging history features. + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 + - replace WACCM_GHG and WACCM_MOZART cppdefs with WACCM_PHYS + +M models/atm/cam/src/chemistry/pp_none/chem_mods.F90 + - change nabscol from 0 to 2 so that arrays are not declared to have zero size + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - declare do_diag variable that is needed when DEBUG is true + +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 + - replaced "physconst, only: amass => mwdry" with "physconst, only: mwdry" + to appease the PGI 9.3 compiler + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - update to the chemistry preprocessor to correct O3 loss rate diagnostic and + include missing r8 kind specifiers + +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_none/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 + - correction to O3 loss rate diagnostic + - include missing "r8" kind specifier + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass + +edinburgh/lf95: +043 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Tue Sep 20 15:24:14 MDT 2011 + This failure is expected do the corrections in local-time averaging history output. + +edinburgh/pgi: +052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 5 at Tue Sep 20 11:20:45 MDT 2011 + The base-line code (cam5_1_07) did not successfully compile with PGI 9.3 + It was noted in tag cam5_1_06 that this did compile after several attempts. + Several attempts were made here without success. The mwdry changes to the + chemistry modes, as noted above, should remedy this problem. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_07 +Originator(s): jedwards +Date: 9-19-2011 +One-line Summary: correct cam.cpl7.template for backward compatibility + +Purpose of changes: Correct problems with cam restart file names in + branch runs. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Feddema + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/bld/cam.cpl7.template + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + This file does not affect any cam standalone tests, it is only used in + the cesm build. Pretag testing was done in the CESM test suite + using cesm1_1_alpha02g + +=============================================================== +=============================================================== + +Tag name: cam5_1_06 +Originator(s): Levy, Mirin, Taylor, Garcia, Edwards, Feddema +Date: 9-1-2011 +One-line Summary: CAM-SE dycore update + +Purpose of changes: Merge latest SE dycore development into CAM + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + Made NETCDF 4.1.3_seq default on bluefire + Made PGI 9.3 pgf95 default on edinburgh + +Describe any changes made to the namelist: + updated default settings for a number of dycore specific fields. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Jedwards, Mtaylor + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/tools/interpic_new/README - refined instructions for interpolating to CAM-SE initial file. + + models/atm/cam/bld/configure - added code to link libnetcdff.a if it is found in the nc_lib directory + models/atm/cam/bld/cam.cpl7.template - added code to allow branch runs with restart files from older cam + versions which use cam2 in the filename instead of cam + + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + models/atm/cam/bld/namelist_files/namelist_definition.xml + models/atm/cam/bld/build-namelist + + Added some cam-se specific namelist variables. Changes some default values. + + models/atm/cam/test/system/test_driver.sh + + Changed default netcdf for bluefire and PGI for edinburgh + + models/atm/cam/test/system/TSC.sh + + ncdump no longer accepts more than one file on the command line, changed this test + to look at one file at a time. + + models/atm/cam/SVN_EXTERNAl_DIRECTORIES + + Update cam-se external pointer + models/atm/cam/doc/ChangeLog + + models/atm/cam/src/physics/cam/cam_diagnostics.F90 + + Added 3 new diagnostic fields: + Z1000 + PREC_pcw (precip due to prognostic cloud water) + PREC_zmc (Precip duc to ZM convective scheme) + + models/atm/cam/src/dynamics/homme/pmgrid.F90 + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + models/atm/cam/src/dynamics/homme/interp_mod.F90 + models/atm/cam/src/dynamics/homme/native_mapping.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + + Bug fixes and updates for compatability with the new cam-se externals + Also creates a new HommeMapping.nc file which provides connectivity information + for the history grid. + + models/atm/cam/src/dynamics/homme/share + + Latest cam-se dycore code from the HOMME standalone trunk. Includes the + ability to run on non-uniform (telescoping) grids. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except: + 063 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL + 066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL +edinburgh/lf95: All pass + +edinburgh/pgi or jaguar/pgi: All pass except: + 052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL + + (Note that test 050 sm734 TSM.sh hn16c5aqdm had problems building on edinburgh, these problems + seem to be compiler or system related - the build completed and tests passed after repeated attempts, + this test was also run on lynx with no issues) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + All differences are in the CAM-SE dycore, we do not yet have a baseline climate established for this dycore. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_1_05 +Originator(s): mvertens, fischer, eaton +Date: Wed Aug 31 2011 +One-line Summary: Add multi instance support, replace cam2 with cam in + history file names, update externals + +Purpose of changes: +. Add multi instance support for cesm. +. Replace cam2 with cam in history file names. Fix tests to handle + the file name changes. +. Modifications to mkDepends to relax the restrictions on + source file name matching module name and only one module per source + file. +. Update to current externals + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. configure needed to be changed to set the number of instances + for each component. This is needed for cam stand alone, the + CESM scripts were setting these values. +. configure was also updated to work with the newest pio and mct tags +. mkDepends was modified to relax the restrictions on source file + name matching module + +Describe any changes made to the namelist: +. vect_map was added to the nameslists and set to cart3d for homme. + The new driver tag was setting this to a default of npfix, which + was causing failures. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A models/atm/cam/src/control/cam_instance.F90 +. Initializes instance variables inst_name, inst_index, inst_suffix + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TEQ_ccsm.sh +M models/atm/cam/test/system/TER_ccsm.sh +M models/atm/cam/test/system/TSM_ccsm.sh +M models/atm/cam/test/system/nl_files/scm_b4b_o1 + Fixed tests to replace cam2 with cam in history files. + +M models/atm/cam/bld/configure +. Set NUM_COMP_INST_ATM, NUM_COMP_INST_LND, NUM_COMP_INST_OCN, NUM_COMP_INST_ICE + and NUM_COMP_INST_GLC to 1 for CAM stand alone runs. This is needed for the + new driver tag. +. Updated to work with latest pio and mct tags + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist +. Add vect_map and set to cart3d for homme. New driver tag was setting the default + for vect_map to npfix + +M models/atm/cam/bld/mkDepends +. Modifications to relax the restrictions on source file name matching module name + and only one module per source file. Also added a new "-d objfile" option which + allows an additional object file to be added to every dependence. + +M models/atm/cam/bld/cam.cpl7.template +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/sat_hist.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/utils/cam_pio_utils.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +. Changes made for multi-instance support. Replace cam2 with cam + in history filenames + + +M SVN_EXTERNAL_DIRECTORIES +. Updated externals. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +073 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Fri Aug 19 11:30:01 MDT 2011 +. E compset was updated in the CESM1 scripts +. all other passed, expect for baselines because output files were renamed, but still bfb + +edinburgh/lf95: all passed, expect for baselines becuase output files were renamed, but still bfb + +edinburgh/pgi: all passed , expect for baselines because output files were renamed, but still bfb + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.: All baseline tests will fail +because history file names where change from having cam2 to cam. However, +this tag is still bfb with the previous. + +=============================================================== +=============================================================== +Tag name: cam5_1_04 +Originator(s): fischer, eaton jedwards +Date: 8 Aug 2011 +One-line Summary: Fix cloud diagnostics, and remove unused allocate + +Purpose of changes: + +. Bugfix for the diagnostic output fields CLDLIQSTR and CLDICESTR. The + previous version was based on state values that did not contain the + tendencies from the macrophysics package. + +. Allocate statement in mo_drydep.F90 not used and was removed. It could + have caused problems with UNSTRUCTURED grids since the nlon_veg and nlat_veg + variables are not defined in that case. + + +Bugs fixed (include bugzilla ID): #1386 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/physics/cam/macrop_driver.F90 +. Bugfix for the diagnostic output fields CLDLIQSTR and CLDICESTR. The + previous version was based on state values that did not contain the + tendencies from the macrophysics package. + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +. The allocate statement at line 1861 is not used and was removed. It + could have caused problems with UNSTRUCTURED grids since the nlon_veg and + nlat_veg variables are not defined in that case. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +edinburgh/lf95: all passed + +edinburgh/pgi: all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.: all bfb + +=============================================================== +=============================================================== + +Tag name: cam5_1_03 +Originator(s): Francis Vitt +Date: 1 Aug 2011 +One-line Summary: Extension of the prescribed aerosol reading capabilities. + +Purpose of changes: + The prescribed aerosol data modules were extended to be able to read in modal + aerosol concentrations and aerosol deposition fluxes. This was done to facilitate + development of prescribed Modal Aerosol Model configurations. + +Bugs fixed (include bugzilla ID): + Missing namelist declaration of drydep_srf_file for chem_inparm in chemistry.F90 (1377) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + New namelist variable added: "prescribed_aero_model" + Switch used to indicate which type of aerosols are prescribed -- bulk or modal. + This is used to set the default prescribed_aero_specifier and aerodep_flx_specifier + namelist variables. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/modal_aero/modal_aero_deposition.F90 +- this was moved to models/atm/cam/src/chemistry/utils + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/utils/modal_aero_deposition.F90 + - moved here so that it can be used when modal aerosols are not prognosed + - modified init method so the the indices can be specified when modal aerosols are not prognosed + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist + - modified to set default aerodep_flx_specifier and prescribed_aero_specifier + according to the new "prescribed_aero_model" namelist variable which can be + "bulk" or "modal" + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - new "prescribed_aero_model" namelist variable added + - rewrite of the "prescribed_aero_specifier" namelist description + - corrections to the "type" entries of prescribed_aero_specifier and aerodep_flx_specifier + namelsit variables + +M models/atm/cam/src/physics/cam/advnce.F90 + - pass pbuf to prescribed data modules + +M models/atm/cam/src/physics/waccm/waccm_forcing.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 + - remove reference to fields%chnk_offset + +M models/atm/cam/src/chemistry/utils/aerodep_flx.F90 + - Expanded to accommodate prescribed modal aerosol deposition fluxes. + +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 + - This has be generalized to read any prescribed field from datasets + and store them in the physics buffer. The units convertion feature + has been removed + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - now can handle 2D fields that are stored in files that have lev dimension + - no longer store pointer to pbuf locations but store pbuf indices for pbuf fields + +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 + - pbuf is now passed into the adv method and operates on the pbuf field + using the stored pbuf indices rather the stored pbuf pointers + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 + - check for prescribed aero dep fluxes before invoking the modal_aero_deposition_init + routine + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - restored namelist declaration of drydep_srf_file for chem_inparm + - check for prescribed aero dep fluxes before setting the cam_out fluxes to the + prognosed deposition fluxes + +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 + - check for prescribed aero dep fluxes before setting the cam_out fluxes to the + prognosed deposition fluxes + +M models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 + - removed redundant "save" + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All Pass + +edinburgh/lf95: All Pass + +edinburgh/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_1_02 +Originator(s): mirin, fischer, eaton +Date: Fri Jun 17 2011 +One-line Summary: Implement reference pressure module. + +Purpose of changes: +. The physics/chemistry parameterizations only need vertical level + locations expressed as pressures. In many places the hybrid coefficients + were being used to directly compute reference pressures (assuming a + surface reference pressure of 1e5 Pa). Since future dycores may use + different types of vertical coordinates we needed to remove any direct + access to the hybrid coefficients. A new reference pressure module + (ref_pres) has been implemented and all direct references to the hybrid + coefficients in the physics/chemistry code have been refactored to use + this module. Currently the physics is operating on the grid defined by + the dynamics, so each dycore must supply a subroutine (in dyn_grid) which + provides the reference pressures. The ref_pres module calls this + subroutine during initialization to set the reference pressures. + +. Do some refactoring of the initialization sequence to move where the + hybrid coefficients are read from dycore independent places to dycore + dependent places. + +. Update documentation in namelist_definition.xml (descriptions of + variables and categories). + +. Update test lists for bluefire + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. Update documentation in namelist_definition.xml (descriptions of + variables and categories). + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/control/hycoef.F90 +. file moved to src/utils/ + +models/atm/cam/src/physics/cam/cldconst.F90 +models/atm/cam/src/physics/cam/cldinti.F90 +. code consolidated and moved to cloud_fraction.F90 + + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/ref_pres.F90 +. new module to provide access to the reference pressures + +models/atm/cam/src/utils/hycoef.F90 +. file moved here from src/control/ + +models/atm/cam/test/system/config_files/f1.9c4cm +models/atm/cam/test/system/config_files/f1.9c5cm +. created new 2deg COSP test with debug turned off + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. change actual arg to set_ub_col from ps to pint(:,1). This is because + the top interface pressure was being calculated using ps and hybrid coefs. + +models/atm/cam/src/control/cam_restart.F90 +. remove reading of the hybrid coefs from this dycore independent spot. + Moved to the dycore dependent read_restart_dynamics methods. +. add call to initialize the reference pressures before the physics restart + is read. + +models/atm/cam/src/control/readinitial.F90 +. remove the call that reads the hybrid coefs from the initial file (and + all associated error checks). This is moved to dycore specific dyn_init + methods. +. remove a bunch of unused local variable declarations + +models/atm/cam/src/control/startup_initialconds.F90 +. remove unused 'include netcdf.inc' + +models/atm/cam/src/dynamics/eul/dyn_comp.F90 +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +models/atm/cam/src/dynamics/homme/dyn_comp.F90 +models/atm/cam/src/dynamics/sld/dyn_comp.F90 +. add file handle dummy arg to dyn_init method +. call hycoef_init to read and initialize hybrid coefs + +models/atm/cam/src/dynamics/eul/dyn_grid.F90 +models/atm/cam/src/dynamics/fv/dyn_grid.F90 +models/atm/cam/src/dynamics/homme/dyn_grid.F90 +models/atm/cam/src/dynamics/sld/dyn_grid.F90 +. add dyn_grid_get_pref method. This is to allow the dycore to supply the + reference pressures to the physics. + +models/atm/cam/src/dynamics/eul/inital.F90 +models/atm/cam/src/dynamics/fv/inital.F90 +models/atm/cam/src/dynamics/homme/inital.F90 +models/atm/cam/src/dynamics/sld/inital.F90 +. add file handle to dyn_init calling args +. call ref_pres_init before call to read initial_conds + +models/atm/cam/src/dynamics/eul/initcom.F90 +models/atm/cam/src/dynamics/fv/initcom.F90 +models/atm/cam/src/dynamics/sld/initcom.F90 +. remove call to hycoef_init. moved to dyn_init + +models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +. call init_restart_hycoef from init_restart_dynamics -- vdimids is now + local and can be removed from init_restart_dynamics args +. call write_restart_hycoef from write_restart_dynamics +. in read_restart_dynamcis add file handle to dyn_init calling args + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. put code from cldinti into cldfrc_init + +models/atm/cam/src/physics/cam/eddy_diff.F90 +. init_eddy_diff -- remove unused pref_mid dummy arg +. replace 'stop' by endrun call + +models/atm/cam/src/physics/cam/physics_types.F90 +. remove redundant calculation of psdry and pintdry + +models/atm/cam/src/physics/cam/physpkg.F90 +. change actual args from hyp* to pref_* +. remove call to cldinti -- code moved to cldfrc_init + +models/atm/cam/src/physics/cam/uw_conv.F90 +. replace a 'stop' by call endrun + + +models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +models/atm/cam/src/chemistry/mozart/mo_photo.F90 +models/atm/cam/src/chemistry/mozart/mo_sad.F90 +models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +models/atm/cam/src/chemistry/utils/mo_msis_ubc.F90 +models/atm/cam/src/chemistry/utils/tracer_data.F90 +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_photo.F90 +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sad.F90 +models/atm/cam/src/physics/cam/boundarydata.F90 +models/atm/cam/src/physics/cam/cldwat.F90 +models/atm/cam/src/physics/cam/radae.F90 +models/atm/cam/src/physics/cam/tphysidl.F90 +models/atm/cam/src/physics/cam/tracers_suite.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +models/atm/cam/src/physics/rrtmg/radlw.F90 +models/atm/cam/src/physics/waccm/gravity_waves_sources.F90 +models/atm/cam/src/physics/waccm/qbo.F90 +. replace use of hycoef module by use of ref_pres + +models/atm/cam/src/physics/cam/convect_deep.F90 +models/atm/cam/src/physics/cam/convect_shallow.F90 +models/atm/cam/src/physics/cam/gw_drag.F90 +models/atm/cam/src/physics/cam/hb_diff.F90 +models/atm/cam/src/physics/cam/radheat.F90 +models/atm/cam/src/physics/cam/zm_conv_intr.F90 +models/atm/cam/src/physics/waccm/gw_drag.F90 +models/atm/cam/src/physics/waccm/iondrag.F90 +models/atm/cam/src/physics/waccm/nlte_lw.F90 +models/atm/cam/src/physics/waccm/radheat.F90 +. change dummy args from hyp* to pref_* + +models/atm/cam/test/system/input_tests_master +models/atm/cam/test/system/tests_posttag_bluefire +. Turned off debugging for COSP CAM5 2deg test + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all passed + +edinburgh/lf95: all passed + +edinburgh/pgi: all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.: 2deg COSP baseline tests will fail +because debugging was turned off in the test. Everything is bfb + +=============================================================== +=============================================================== + +Tag name: cam5_1_01 +Originator(s): eaton, fvitt, fischer +Date: Mon May 30 18:24:32 MDT 2011 +One-line Summary: enable 1/4 deg FV cam5, chemistry bug fixes + +Purpose of changes: + +. Enable 1/4 deg FV cam5 to run out of the box. This required a code mod + to the interpolation of the landuse map in the dry deposition code used + by the modal aerosols, and providing an appropriate initial file. +. corrected O1D + CCL4 -> 4*CL reaction in the waccm_mozart_v1 mechanism +. removed reference to solar_parms_file from cam4_trop_strat_chem use_case + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. add default IC file for 1/4 deg FV cam5. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +. subroutine interp_map -- clamp the values of fraction_landuse between 0 + and 1. This replaces a check for out of range values which then + triggered a call to endrun. + +models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in +. added comment + +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_prod_loss.F90 +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lin_matrix.F90 +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.doc +models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.in +. corrected O1D + CCL4 -> 4*CL reaction in the waccm_mozart_v1 mechanism +. added comment to chem_mech.in + +models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml +. removed reference to solar_parms_file (waccm input file) + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_1_00 +Originator(s): fvitt, fischer, jedwards +Date: +One-line Summary: chemistry corrections, new homme ncdata file + +Purpose of changes: + - chemistry preprocessor update -- adjust the write format to *.doc output + files to allow negative values in the "troe" reactions + - correction to pp_trop_mozart document file resulting from the above preprocessor change + - numerous corrections to the chem reactions in trop_strat_bam_v1 package + - corrected the reaction: O1D + CCL4 -> 4*CL + - correction to pp_waccm_mozart_v1 document file resulting from the above preprocessor change + - new homme dycor ne240np4 1850 ncdata file + - add output needed for radition driver + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +-atm/cam/inic/homme/cami_0002-01-01_ne240np4_L26_c100522.nc ++atm/cam/inic/homme/cami_1850-01-01_ne240np4_L26_c110314.nc + + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - new homme dycor ne240np4 1850 ncdata file + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - chemistry preprocessor update -- adjust the write format to *.doc output + files to allow negative values in the "troe" reactions + +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc + - correction to this document file resulting from the above preprocessor change + +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.in + - numerous corrections to the chem reactions in trop_strat_bam_v1 package + +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in + - corrected the reaction: O1D + CCL4 -> 4*CL + +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.doc + - correction to this document file resulting from the above preprocessor change + +M models/atm/cam/src/physics/cam/radiation_data.F90 + - add output needed for radition driver + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +all passed + +edinburgh/lf95: +all passed + +edinburgh/pgi: +all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: all bfb + +=============================================================== +=============================================================== + +Tag name: cam5_0_57 +Originator(s): fischer, eaton, hannay, fvitt, andrew +Date: Tue May 17 13:57:22 MDT 2011 +One-line Summary: CAM5.1 tuning, CAM5 default output updates, bug fixes + +Purpose of changes: +. CAM5.1 2 degree tuning, new values for uwshcu_rpen and rhminl +. CAM5 default outputs added +. NEU Chemistry bug fixes +. Micro physics bug fixes from Andrew Gettelman +. Modify build-namelist to produce default FV decomposition settings + (npr_yz). This functionality was previously embedded in the CESM scripts + and was not available to user's of CAM standalone scripts. +. Change dataroot for lynx testing + + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. build-namelist has a new argument, -ntasks, which is used to set a + default value for the FV decomposition. The user can always override + this default by explicitly setting npr_yz. + +Describe any changes made to the namelist: +. uwshcu_rpen was added to the namelist for CAM5. + Default value is 10.0 + At 2deg the value is 5.0, this changes answers +. rhminl was set the .8875 for 2deg CAM5, this changes answers + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +. uwshcu_readnl was added to models/atm/cam/src/physics/cam/uwshcu.F90 + uwshcu_readnl reads the namelist variable uwshcu_rpen + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add fv_decomp_set method used to set default FV decomp when new -ntasks + arg is set and the user hasn't already explicitly set it (npr_yz). +. add namelist variable uwshcu_rpen + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add namelist variable uwshcu_rpen for CAM5 and set default to 10.0 + uwshcu_rpen is set to 5.0 when resoltion is 2 degree +. set cldfrc_rhminl to .8875 for 2 degree CAM5 + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add uwshcu_repn definition + uwshcu_rpen - For penetrative entrainment efficiency + +models/atm/cam/src/control/runtime_opts.F90 +. add call to uwshcu_readnl to read in uwshcu_rpen + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. set cldfrc_rhminl to .8875 for 2 degree CAM5 +. set uwshcu_rpen to 5.0 for 2 degree CAM5 and set default to 10 + +models/atm/cam/src/physics/cam/uwshcu.F90 +. add routine uwshcu_readnl to set uwshcu_rpen +. add error checking to see if uwshcu_rpen is set + +models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. bug fix prevent overwriting of tendencies set by mo_neu_wetdep + +models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 +. turn off debug print statements + +models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +models/atm/cam/src/physics/cam/macrop_driver.F90 +. micro physics bug fixes from Andrew Gettelman + +models/atm/cam/src/physics/cam/microp_driver.F90 +. comment fix from Andrew Gettelman + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. T700, T850, ATMEINT added to default output + +models/atm/cam/src/physics/rrtmg/radiation.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +. TOT_CLD_VISTAU and TOT_ICLD_VISTAU added to default output + +models/atm/cam/src/physics/cam/microp_aero.F90 +. CCN3 added to default output + +odels/atm/cam/test/system/test_driver.sh +. set dataroot to /glade/proj3/cseg/inputdata for lynx + +SVN_EXTERNAL_DIRECTORIES +. update clm tag to clm4_0_31 +. update scripts tag to scripts4_110513 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue May 17 13:23:40 MDT 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue May 17 14:16:19 MDT 2011 +. New CAM5 tunings for uwshcu_rpen and cldfrc_rhminl cause the baseline tests to fail + +edinburgh/lf95: +all passed + +edinburgh/pgi : +all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: CAM5 at 2 degree will have answer changes due to +new tuning values for cldfrc_rhminl and uwshcu_rpen + +=============================================================== +=============================================================== + +Tag name: cam5_0_56 +Originator(s): fischer, eaton +Date: Thu May 12 12:24:30 MDT 2011 +One-line Summary: update component svn externals + +Purpose of changes: +. update component svn externals + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +-lnd/clm2/pftdata/pft-physiology.c101006.nc ++lnd/clm2/pftdata/pft-physiology.c110425.nc +. Update + ++lnd/clm2/initdata/clmi.BCN_0051-01-01_48x96_gx3v7_simyr2000_c110509.nc ++lnd/clm2/initdata/clmi.BCN.1850-01-01_48x96_gx3v7_simyr1850_c110421.nc ++lnd/clm2/surfdata/surfdata_512x1024_simyr1850_c100315.nc ++lnd/clm2/surfdata/surfdata.pftdyn_48x96_hist_simyr1850-2005_c110114.nc ++lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp6.0_simyr1850-2100_c100812.nc ++lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_rcp6.0_simyr1850-2100_c100813.nc ++lnd/clm2/surfdata/surfdata.pftdyn_10x15_rcp6.0_simyr1850-2100_c100901.nc +. Added + +-lnd/clm2/surfdata/surfdata_48x96_simyr2000_c090928.nc ++lnd/clm2/surfdata/surfdata_48x96_simyr2000_c100505.nc +-lnd/clm2/surfdata/surfdata_48x96_simyr1850_c090928.nc ++lnd/clm2/surfdata/surfdata_48x96_simyr1850_c110114.nc +-lnd/clm2/surfdata/surfdata_0.47x0.63_simyr1850_c100305.nc ++lnd/clm2/surfdata/surfdata_0.47x0.63_simyr1850_c100826.nc +-lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c100205.nc ++lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c100319.nc +. Changed + +-lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c100205.nc +-lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp4.5_simyr1850-2100_c100406.nc +-lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp2.6_simyr1850-2100_c100323.nc +. Removed + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Updated fsurdat, fptfcon, and finidat to match clm4_0_29 +. Added rcp6.0 fpftdyn +. Removed extra > at line 249 +. Removed RCP 2000-2100 fpftdyn + +SVN_EXTERNAL_DIRECTORIES +. Updated all externals to match cesm1_0_beta20 + + +SVN_EXTERNAL_DIRECTORIES + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Wed May 11 16:36:52 MDT 2011 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed May 11 16:59:47 MDT 2011 +. bl132 and bl137 failed because spun-up data is being used now + +072 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Sat May 7 12:17:46 MDT 2011 +. bl992 failed because of updated drv tag + +edinburgh/lf95: +all passed + +edinburgh/pgi: +all passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.: bfb except for: ccsm tests, and T31. + +=============================================================== +=============================================================== + +Tag name: cam5_0_55 +Originator(s): jenkay, eaton, fischer +Date: 5 May 2011 + +One-line Summary: Fixes for COSP, reduce CAM5 default output. + +Purpose of changes: +. Mods in modis simulator to workaround an xlf compiler problem. +. Modify both CAM standalone and CESM builds to allow modis simulator to + use the abortutils module instead of calling stop. +. Move some 'add_default' calls for CAM5 diagnostic fields inside conditionals. +. Update to 110505 COSP external + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +. Add abortutils dependency so cosp code can make use of subroutine endrun. + $(COSP_LIBDIR)/libcosp.a: abortutils.o + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. update to the 110505 COSP external + +models/atm/cam/bld/Makefile.in +models/atm/cam/bld/configure +. mods to allow cosp to use associate CAM's abortutils module + +models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_calcsize.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +models/atm/cam/src/physics/cam/aer_rad_props.F90 +models/atm/cam/src/physics/cam/ndrop.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. remove some 'add_default' calls for CAM5 diagnostic fields. Many + add_default calls for modal aerosols were moved inside conditionals that + are turned on using the history_aerosol namelist variable. + +models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +. fix long_name in some addfld calls +. fix bug in output fields clhmodis, clmmodis, cllmodis +. changes in cloud fraction weighting code + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +015 br381 TBR.sh f1.9c4cdm outfrq3s+1850-2005_cam4 6+3s ...................FAIL! rc= 12 at Thu May 5 00:05:32 MDT 2011 +016 bl381 TBL.sh f1.9c4cdm outfrq3s+1850-2005_cam4 9s .....................FAIL! rc= 5 at Thu May 5 00:11:40 MDT 2011 +019 br382 TBR.sh f1.9c5cdm outfrq3s+1850-2005_cam5 6+3s ...................FAIL! rc= 12 at Thu May 5 01:37:03 MDT 2011 +020 bl382 TBL.sh f1.9c5cdm outfrq3s+1850-2005_cam5 9s .....................FAIL! rc= 5 at Thu May 5 01:45:22 MDT 2011 + Branch tests failed due to changing task geometry, when keeping the task geometry consistent the branch tests passed + Baselines for COSP are expected to fail + +edinburgh/lf95: +all passed + +edinburgh/pgi: +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu May 5 13:45:00 MDT 2011 + Baselines for COSP are expected to fail + +CAM tag used for the baseline comparison tests if different than previous +tag:cam5_0_54 + +Summarize any changes to answers: BFB except for COSP diagnostic output + + +=============================================================== +=============================================================== + +Tag name: cam5_0_54 +Originator(s): Francis Vitt +Date: 27 Apr 2011 +One-line Summary: New chemistry features and minor corrections to trop_mozart reactions. + +Purpose of changes: + + - provide an additional optional wet deposition method for gas phase chemical species + - include short wavelength photolysis in tropospheric chemistry + - new treatment of WACCM stratospheric aerosols + - new chemistry package added : trop_strat_bam_v1 + - adjustments to the trop_mozart chemistry mechanism + - provide dynamic creation of default deposition species lists + namelist settings using master lists + - correction to the wet deposition lists of species for + super_fast_llnl, and waccm_mozart + - correction to the configure options for the offline driver regression test + + Science changes effect (baseline test will fail) these chemistry packages: + trop_mozart + - inclusion of the short wavelength photolysis + - adjustments to the chemistry mechanism (reaction rates) + + super_fast_llnl + - correction to the wet deposition list (include CH3OOH) + + waccm_mozart (development version of waccm) + - correction to the wet deposition list (N2O5 removed from list) + - new treatment of stratospheric aerosols + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + namelist variables added + - gas_wetdep_list + list of gas phase species that under go wet depostion + - gas_wetdep_method + 'MOZ' to select the mozart scheme (default) + 'NEU' to select the + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/cam4_trop_strat_chem.xml + - new use case for F_TROP_STRAT_CHEM compset + +A models/atm/cam/bld/namelist_files/master_aer_wetdep_list.xml +A models/atm/cam/bld/namelist_files/master_gas_wetdep_list.xml +A models/atm/cam/bld/namelist_files/master_mam_dep_list.xml +A models/atm/cam/bld/namelist_files/master_drydep_list.xml +A models/atm/cam/bld/perl5lib/Build/ChemNamelist.pm + - sets default depostion species lists namelist variables for the desired + chemistry mechanism using the above master lists + +A models/atm/cam/src/chemistry/mozart/gas_wetdep_opts.F90 + - reads wet depostion options for gas phase species + +A models/atm/cam/src/chemistry/mozart/mo_neu_wetdep.F90 + - new wet depostion method provided by J Neu + +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_strat_bam_v1/chem_mech.in + - new chem pkg added (133 species, interactive stratosphere and troposphere chem) + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/config_files/fmo1.9c4dh + - correction to the configure options for the offline driver test + +M models/atm/cam/bld/configure + - new chemistry package added 'trop_strat_bam_v1' + - set $chem_src_dir to $cam_root/.... which is an absolute path so that + build-namelist deposition lists generation will function within CESM scripts + +M models/atm/cam/bld/config_files/definition.xml + - new chemistry package added 'trop_strat_bam_v1' (-chem option) + +M models/atm/cam/bld/build-namelist + - changes for the new trop_strat_bam_v1 chemisty package + - invokes the ChemNamelist module to generate depostion lists + - removed the if( $waccm_chem ) clause around the strat_aero_feedback/rad_climate setting + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - default emissions files added for trop_strat_bam_v1 + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - namelist variables added + - gas_wetdep_list + list of gas phase species that under go wet depostion + - gas_wetdep_method + 'MOZ' to select the mozart scheme (default) + 'NEU' to select the + +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml + - history fields names change related to SAD code changes + HNO3_CD1 replaced by HNO3_STS and HNO3_CD3 replaced by HNO3_NAT + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - added get_species_list routine and is made public so it can be used by ChemNamelist.pm + - set the chem_src_dir for customized mechanism + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated chemistry preprocessor + +M models/atm/cam/src/control/sat_hist.F90 + - added a check to avoid an error which occurs when the last observation + time is exactly the same as the model time + +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_photo.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sad.F90 + - inteface changes to be constitent with changes in mo_gas_phase_chemdr + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.in + - changes to chemistry reactions + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.doc +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - the master lists give a different list of wet dep species so + this is not a bit-for-bit change, otherwise it is bit-for-bit + +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_phtadj.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mech.doc +M models/atm/cam/src/chemistry/pp_trop_ghg/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.doc +M models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.in + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + - this is a bit-for-bit change + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - HNO3_CD1 renamed to HNO3_STS + - HNO3_CD2 renamed to HNO3_NAT + - removed HNO3_CD2, SAD_SNAT, RAD_SNAT + - added call to neu_wetdep (new wet deposition scheme) + +M models/atm/cam/src/chemistry/mozart/mo_strato_rates.F90 + - chenges to names of variables + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - call to neu_wetdep_init added + +M models/atm/cam/src/chemistry/mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - changes to use jshort for low top model if the needed fields are available + (short wavelength photolsys for CAM-Chem) + +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 + - extensive changes provided by Doug Kinnison + this is a new treatment of the the WACCM stratospheric aerosols + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - call gas_wetdep_readnl added to read wet dep namelist options + - call to neu_wetdep_tend added + +M models/atm/cam/src/chemistry/mozart/mo_chem_utls.F90 +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +(N2O5 removed from list) - changed need to specify which species have wet dep with namelist + setting + - chemistry solver includes wash-out loss rates term for all species + which are set to non-zero for only the gas_wetdep_list namelist + +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + - now uses the gas_wetdep_list to check that none of the gas phase + species are included in the aerosol wet dep list + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Tue Apr 26 20:18:43 MDT 2011 + the development version of waccm_mozart (not waccm_mozart_v1) is expected + to fail due to + - correction to the wet deposition list (N2O5 removed from list) + - new treatment of stratospheric aerosols + +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Apr 26 21:24:59 MDT 2011 + trop_mozart is expected to fail due to + - inclusion of the short wavelength photolysis + - adjustments to the chemistry mechanism (reaction rates) + +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue Apr 26 22:07:42 MDT 2011 + super_fast_llnl is expected to fail due to correction to the wet deposition list (include CH3OOH) + +edinburgh/lf95: All Pass + +edinburgh/pgi : All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_53 +Originator(s): eaton +Date: Mon Apr 25 14:11:19 MDT 2011 +One-line Summary: fix cosp external + +Purpose of changes: + +. The new cosp external didn't get 'propset' before the last commit. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: none + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: not done + +edinburgh/lf95: not done + +edinburgh/pgi or jaguar/pgi: not done + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_52 +Originator(s): fischer, eaton, fvitt, jenkay, tcraig +Date: 19 April 2011 +One-line Summary: Update COSP, Fix for offline driver, performance fix for modal aerosol, ESMF updates + +Purpose of changes: +. Fix performance problem introduced in cam5_0_27 in the modal aerosol + optics calculation. +. COSP updates, Includes the mods from LLNL to incorporate the effects of snow and other + bug fixes. +. Fix offline driver, add sd_waccm_ghg use case, fix SDBAM. +. ESMF updates from Tony Craig + +Bugs fixed (include bugzilla ID): +. Fix for offline driver +. Fix the use case(cam4_bam_radpsv_geos5) used in SDBAM compset + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. Added cosp_histfile_aux to the COSP namelist. + When set to true, additional output is generated. +. Use case cam4_bam_radpsv_geos5.xml changes + set strat aerosol data cycle year, file, and type + set ext_frc_type, srf_emis_type, and tracer_cnst_type to SERIAL + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + CAM5 1deg is ~ 6.5% faster than the previous tag. + previous tag .902 hrs for a 1deg 10 day run + cam5_0_52 .842 hrs for a 1deg 10 day run + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A bld/namelist_files/use_cases/sd_waccm_geos5.xml +A bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +. New WACCM use cases from fvitt + +A test/system/config_files/f1.9c4cdm +A test/system/config_files/f1.9c5cdm +. created 2deg COSP tests + +List all existing files that have been modified, and describe the changes: +M test/system/input_tests_master +M test/system/tests_posttag_bluefire +. added 2deg COSP tests to bluefire post-tag tests + +M test/system/nl_files/off1.9x2.5 +. changed start_ymd, met_data_file +. set bnd_topo, and ncdata + +M src/utils/time_manager.F90 +M src/cpl_esmf/atm_comp_mct.F90 +M src/cpl_esmf/atm_comp_esmf.F90 +. ESMF updates from Tony Craig + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. added cosp_histfile_aux and cosp_histfile_aux_num to the namelist + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. BAM and MAM aerosol emissions file changes + +M models/atm/cam/bld/build-namelist +. added tracer_cnst_filelist + +M models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml +. set strat aerosol data cycle year, file, and type +. set ext_frc_type, srf_emis_type, and tracer_cnst_type to SERIAL + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. Updated COSP external + +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +. COSP updates + +M models/atm/cam/src/dynamics/fv/pfixer.F90 +. set sum1 private for omp + +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/uv3s_update.F90 +. added if defined for OFFLINE_DYN, WACCM_GHG, and WACCM_MOZART + +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. made do loops omp parallel + +M models/atm/cam/src/dynamics/fv/metdata.F90 +. removed if debug +. added tests for TS in met dataset + + +models/atm/cam/src/physics/cam/modal_aer_opt.F90 +. lookup the indicies of the modal aerosol species in the aerosol list at + initialization and save them (this is the main performance fix) +. assign pointers to modal aerosol specie mixing ratios outside the + calculation loops (not sure whether this is having a significant + performance impact) + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. make rad_cnst_get_aer_idx public + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +all passed + +edinburgh/lf95: +043 bl318 TBL.sh f10c4cdm sat_hist 9s .....................................FAIL! rc= 7 at Tue Apr 19 18:19:26 MDT 2011 + Changes is COSP caused bl318 to fail + + +edinburgh/pgi or jaguar/pgi: +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Apr 19 12:05:14 MDT 2011 + Changes is COSP caused bl317 to fail + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_0_51 + + +Summarize any changes to answers: BFB except for COSP diagnostic output + +=============================================================== +=============================================================== + +Tag name: cam5_0_51 +Originator(s): Francis Vitt +Date: 4 April 2011 +One-line Summary: + + Added various chemistry features, bug fixes and code clean up. + +Purpose of changes: + + - provide more intuitive data-timing namelist variables + - update trop_mozart with latest MOZART4 mechanism + - restore lighting NOx production in super_fast_llnl + - give flexibility to the units of the emissions datasets + - use more up-to-date dataset for waccm_ghg forcing + - include CO2 reactions for WACCM to improve concentrations in upper regions + - updates to dry deposition module + - bug fixes listed below + +Bugs fixed (include bugzilla ID): + + - corrected vertically integrated wet deposition rates diagnostics + - corrected MASS and AREA output fields + - corrected chemical prod/loss rates diagnostics + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - data-timing namelist changes: + * srf_emis_ymd --> srf_emis_cycle_yr + srf_emis_fixed_ymd + * srf_emis_tod --> srf_emis_fixed_tod + + * ext_frc_ymd --> ext_frc_cycle_yr + ext_frc_fixed_ymd + * ext_frc_tod --> ext_frc_fixed_tod + + * flbc_date --> flbc_cycle_yr + flbc_fixed_ymd + flbc_fixed_tod + * flbc_yr_offset removed + + * prescribed_aero_ymd --> prescribed_aero_cycle_yr + prescribed_aero_fixed_ymd + * prescribed_aero_tod --> prescribed_aero_fixed_tod + + * aerodep_flx_ymd --> aerodep_flx_cycle_yr + aerodep_flx_fixed_ymd + * aerodep_flx_tod --> aerodep_flx_fixed_tod + + * prescribed_ghg_ymd --> prescribed_ghg_cycle_yr + prescribed_ghg_fixed_ymd + * prescribed_ghg_tod --> prescribed_ghg_fixed_tod + + * prescribed_ozone_ymd --> prescribed_ozone_cycle_yr + prescribed_ozone_fixed_ymd + * prescribed_ozone_tod --> prescribed_ozone_fixed_tod + + * prescribed_volcaero_ymd --> prescribed_volcaero_cycle_yr + prescribed_volcaero_fixed_ymd + * prescribed_volcaero_tod --> prescribed_volcaero_fixed_tod + + * sad_date --> sad_cycle_yr + sad_fixed_ymd + sad_fixed_tod + + * tgcm_ubc_ymd --> tgcm_ubc_cycle_yr + tgcm_ubc_fixed_ymd + * tgcm_ubc_tod --> tgcm_ubc_fixed_tod + + * chlorine_loading_ymd --> chlorine_loading_cycle_yr + chlorine_loading_fixed_ymd + * chlorine_loading_tod --> chlorine_loading_fixed_tod + + * linoz_data_ymd --> linoz_data_cycle_yr + linoz_data_fixed_ymd + * linoz_data_tod --> linoz_data_fixed_tod + + * tracer_cnst_ymd --> tracer_cnst_cycle_yr + tracer_cnst_fixed_ymd + * tracer_cnst_tod --> tracer_cnst_fixed_tod + + * tracer_srcs_ymd --> tracer_srcs_cycle_yr + tracer_srcs_fixed_ymd + * tracer_srcs_tod --> tracer_srcs_fixed_tod + + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/config_files/defaults_waccm_ghg.xml +D models/atm/cam/bld/config_files/defaults_trop_mozart.xml +D models/atm/cam/bld/config_files/defaults_trop_mam3.xml +D models/atm/cam/bld/config_files/defaults_trop_bam.xml +D models/atm/cam/bld/config_files/defaults_trop_mam7.xml +D models/atm/cam/bld/config_files/defaults_waccm_mozart.xml +D models/atm/cam/bld/config_files/defaults_super_fast_llnl_mam3.xml +D models/atm/cam/bld/config_files/defaults_trop_ghg.xml +D models/atm/cam/bld/config_files/defaults_super_fast_llnl.xml + - these were not needed and removed + +D models/atm/cam/src/physics/cam/chemistry.F90 + - moved to models/atm/cam/src/chemistry/pp_none + +D models/atm/cam/src/chemistry/mozart/tgcm_forcing.F90 +D models/atm/cam/src/chemistry/mozart/iondrag.F90 + - iondrag.F90 moved to physics/waccm/ + - tgcm_forcing.F90 replaced by physics/waccm/waccm_forcing.F90 + +List all subroutines added and what they do: + +A models/atm/cam/bld/config_files/defaults_waccm.xml + - configure defaults in this file are used for all veriation of waccm + +A models/atm/cam/bld/namelist_files/use_cases/cam4_bam_radpsv_geos5.xml +A models/atm/cam/bld/namelist_files/use_cases/sd_waccm_tslt_geos5.xml +A models/atm/cam/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp26.xml +A models/atm/cam/bld/namelist_files/use_cases/cam4_chem_radpsv_geos5.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp85.xml + - added build-namelist use cases + +A models/atm/cam/src/physics/waccm/waccm_forcing.F90 + - for new waccm_ghg forcing data + +A models/atm/cam/src/physics/waccm/iondrag.F90 + - moved from models/atm/cam/src/chemistry/mozart + +A models/atm/cam/src/chemistry/modal_aero/mo_sethet.F90 + - old mo_sethet.F90 moved here so that trop_mam3 is bit-for-bit unchanged + +A models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_bam/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mozart/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_mam7/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mech.in +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in +A models/atm/cam/src/chemistry/pp_trop_ghg/chem_mech.doc +A models/atm/cam/src/chemistry/pp_trop_ghg/chem_mech.in +A models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.doc +A models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mech.in +A models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.doc +A models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mech.in + - added chem package documents + + +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_photo.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lin_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sad.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_jeuv.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_strato_rates.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart_v1/m_spc_id.F90 + - this was added for backwards compatibility (b4b same as previous waccm_mozart) + +A models/atm/cam/src/chemistry/pp_none +A models/atm/cam/src/chemistry/pp_none/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_none/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_none/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_none/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_none/chemistry.F90 +A models/atm/cam/src/chemistry/pp_none/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_none/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_none/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_none/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_none/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_none/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_none/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_none/mo_lin_matrix.F90 + - this chem pkg was added to inable removal of cppdefs + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/config_files/wm1.9c4h + - use waccm_mozart_v1 chemistry package for this test + +M models/atm/cam/bld/configure + - copy chemistry mechanism docs to $cam_bld + - added waccm_mozart_v1 chemistry package (same as the CMIP version of waccm_mozart) + - reference only defaults_waccm.xml config defaults files + - references to TROPCHEM and SUPERFASTLLNL cppdefs removed + + +M models/atm/cam/bld/config_files/definition.xml + - waccm_mozart_v1 chem option added + - added chem_proc_src chemistry preprocessor generated source code directory path + - new default emissions files for trop_mozart + - defaults added for waccm_mozart_v1 + - set cam_chempkg to 'waccm_mozart' for the waccm_mozart_v1 mechanism + +M models/atm/cam/bld/build-namelist + - chem_rad_passive --> atm_dep_flux=.false. + - airpl_emis_file replaced with ext frc files + - offline_dyn --> do_tms=.false. + - cftgcm --> waccm_forcing_file + - CB2 and OC2 default emis files added in addition to HCN,CH3CN,C2H2,CH3COOH for trop_mozart + - changes in dep lists for new trop_mozart mechanism + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - replaced *_ymd namelist variables with *_cycle_yr + - replaced cftgcm defaults with waccm_forcing defaults for waccm_ghg + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - met_data_path namelist added + - waccm_forcing_* namelist options added for waccm ghg data + -- itgcmcyc removed + -- cftgcm removed + - data-timing namelist changes (see above). + +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_trop_bam.xml +M models/atm/cam/bld/namelist_files/use_cases/2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_2xco2.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml + - mods for the data-timing namelist changes + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - copy over preprocessor input and *.doc files to $cam_bld directory + - set $chem_proc_src dir when preprocessor is invoked + - clean up + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - use updated preprocessor which has corrections to the chem prod/loss rate diagnostics + +M models/atm/cam/src/control/runtime_opts.F90 + - removed itgcmcyc and cftgcm + and added call to waccm_forcing_readnl + - broadcast nlte_use_mo + - met_data_path namelist variable added + +M models/atm/cam/src/physics/cam/tropopause.F90 + - TROPCHEM cppdefs removed + - history field names changed: + 'chem_trop' --> 'hstobie_trop' + 'chem_trop_linoz' --> 'hstobie_linoz' + 'chem_trop_tropop' --> 'hstobie_tropop' + +M models/atm/cam/src/physics/cam/advnce.F90 +M models/atm/cam/src/physics/cam/radheat.F90 + - radheat_timestep_init interface changed for new waccm_ghg + +M models/atm/cam/src/physics/waccm/nlte_lw.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 + - changes for waccm_ghg + +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + - WACCM_MOZART and TROPCHEM cppdefs removed + +M models/atm/cam/src/physics/cam/phys_control.F90 + - cam_chempkg_out added to getopts + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - tidal diagnostics added +M models/atm/cam/src/physics/cam/tidal_diag.F90 + - get_tidal_coeffs subroutine added + +M models/atm/cam/src/physics/cam/chem_surfvals.F90 + - data-timing namelist changes + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_het_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_spc_id.F90 + - changed trop_mozart chem mechanism + +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +M models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 + - fixed bug in chem prod/loss diagnostics + +M models/atm/cam/src/chemistry/utils/aerodep_flx.F90 +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/mo_flbc.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/aircraft_emit.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/utils/m_types.F90 +M models/atm/cam/src/chemistry/mozart/chlorine_loading_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 + - data-timing namelist changes + +M models/atm/cam/src/chemistry/bulk_aero/dust_sediment_mod.F90 + - replaced "stop" statement with call to endrun + +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_indprd.F90 + - waccm mech changes (added CO2 reactions near upper boundary) + +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 + - added ext frcing of NO for lightning production + + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - set sulfate passed to usrrxt from vmr(so4_ndx) if SO4 is active + - corrected units on rxt (tag_names) history feilds + - call set_fstrat_h2o only if h2o is not chem active + +M models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +M models/atm/cam/src/chemistry/mozart/mo_setext.F90 + - moved the NO lightning code outside the if (has_airpl_src) block + +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 + - added has_no_lightning_prod var so that cppdefs can be removed from physpkg.F90 + +M models/atm/cam/src/chemistry/mozart/spedata.F90 + - removed the "spe_restart" option + - no longer save the spe data file pathname in restart file + +M models/atm/cam/src/chemistry/mozart/mo_strato_rates.F90 + - if mixing ratios are small (< 1e-16) then rates are set to zero + +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + - NJEUV increased to 26 (neuv) for the new waccm upper boundary jeuv CO2 photolysis + - corrected AREA, MASS, and WD_* (vert integrated wet dep rate) diagnostics + +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 + - added *_dens and *_vmr history fields + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - data-timing namelist changes + - "chem_rad_passive" switch added -> sets ptend%lq(1) = .false. so that the + chemistry does not change water vapor + - removed the spedata restart calls + - removed cppdefs that set chem_name + - chem_is now invokes phys_control->cam_chempkg_is function + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - added code for HCN, CH3CN, HCOOH + - if offline-dyn use meteorology TS to determine icefrac which is + applied only when drydep_method = 'xactive_lnd' + - HCN and CH3CN zero over land (only ocnice_dvel applied) + - code corrected for Carbon aerosols + - CO tags added + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - max zenith for waccm 94.0 --> 97.01 degress + +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 + - Louisa's wet dep changes + - check for unset het rates added + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - CO tags added + - added check for usr_N2O5_aer if mech has het1 to avoid double counting + in tropospheric aerosol rates + +M models/atm/cam/src/chemistry/mozart/mo_jeuv.F90 + - CO2 photolysis added (near upper boundary) + +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - data-timing namelist changes + - flexable units of input data + +M models/atm/cam/src/dynamics/fv/ctem.F90 + - "defined on ilev" added to description of 2D outputs + +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 + - offline dyn changes + - can read bottom portion of met data + - added code to determine icefrac from surface temperature + +M SVN_EXTERNAL_DIRECTORIES + - use driver tag drvseq3_1_51 and CLM tag clm4_0_26 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 + This is expected to fail due to the changes in waccm_mozart chemistry mechanism + +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 + This is expected to fail due to the changes in trop_mozart chemistry mechanism, + dry deposition and wet deposition + +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 + This is expected to failure due to the inclusion of lightning produced NOx + +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 + This failure is cause by changes in dry deposition. If the drydep_method were set to + 'xactive_atm' then this baseline test would pass since this uses waccm_mozart_v1 which + has exactly the same mechanism as the previous waccm_mozart + +edinburgh/lf95: +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 + This is expected to fail due to changes in waccm_ghg forcing data + +edinburgh/pgi: +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 + This is expected to fail due to changes in waccm_ghg forcing data + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_50 +Originator(s): Jim Edwards +Date: March 30, 2011 +One-line Summary: Bug fixes for cosp and inithist + +Purpose of changes: bug fixes, code cleanup + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + models/atm/cam/src/control/cam_history_support.F90 : field_copy + provides an overload on the = operator to properly copy the + field_info derived type + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/TER.sh + + added code to prevent inithist file from initial runs with + inithist='endofrun' from being compared + + models/atm/cam/test/system/nl_files/ghgrmp + models/atm/cam/test/system/nl_files/outfrq3s + + added inithist='endofrun' to namelist to capture writting inithist + after a restart + + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + + updated some of the homme init files + + models/atm/cam/src/control/cam_history_buffers.F90 + models/atm/cam/src/control/cam_history_support.F90 + models/atm/cam/src/control/cam_history.F90 + + Added support for individual fields to define and use their own fill values, replaced some cosp + bounds variables improperly removed in cam5_0_47, fixed a bug that caused inithist files to fail + when trying to write after a restart. Removed global declarations of plat,plon,plev and plevp. + Changed the variable time_bnds written to inithist files to properly reflect time of files, this + will cause some baseline tests to fail. + + models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + + Added support for cosp fillvalues to be used in cam_history instead of overwritting one fillvalue + with another. + + + models/atm/cam/src/physics/cam/tropopause.F90 + models/atm/cam/src/physics/cam/radiation.F90 + models/atm/cam/src/physics/cam/aer_rad_props.F90 + models/atm/cam/src/physics/cam/radiation_data.F90 + models/atm/cam/src/physics/cam/modal_aer_opt.F90 + models/atm/cam/src/physics/cam/microp_driver.F90 + models/atm/cam/src/physics/cam/cldwat2m_micro.F90 + models/atm/cam/src/physics/rrtmg/oldcloud.F90 + models/atm/cam/src/physics/rrtmg/radiation.F90 + models/atm/cam/src/dynamics/fv/inidat.F90 + + Moved references to fillvalue from cam_history.F90 to cam_history_support.F90 + + + models/atm/cam/src/dynamics/homme/native_mapping.F90 + + Modified output mapping file to better conform to scrip/esmf standards + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except: + 004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Thu Mar 31 07:44:32 MDT 2011 + 006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 7 at Thu Mar 31 07:44:34 MDT 2011 + 013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Thu Mar 31 07:44:36 MDT 2011 + 017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Thu Mar 31 07:44:44 MDT 2011 + 021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Thu Mar 31 07:44:52 MDT 2011 + 023 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 7 at Thu Mar 31 07:44:53 MDT 2011 + 033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Thu Mar 31 07:45:19 MDT 2011 + 045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Thu Mar 31 07:45:39 MDT 2011 + 050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Thu Mar 31 07:45:54 MDT 2011 + 054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Thu Mar 31 07:46:01 MDT 2011 + 066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 7 at Thu Mar 31 08:04:48 MDT 2011 + + +edinburgh/lf95: All pass except: + 004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Mar 31 08:17:23 MDT 2011 + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Mar 31 08:17:25 MDT 2011 + 011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Thu Mar 31 08:17:25 MDT 2011 + 015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Mar 31 08:17:28 MDT 2011 + 022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Mar 31 08:17:30 MDT 2011 + 030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Mar 31 09:08:13 MDT 2011 + 032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Thu Mar 31 09:08:14 MDT 2011 + 035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Mar 31 09:08:17 MDT 2011 + 038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Thu Mar 31 09:08:18 MDT 2011 + 040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Mar 31 09:08:19 MDT 2011 + + + + +edinburgh/pgi : ALL pass except: + 004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Mar 31 08:37:53 MDT 2011 + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Mar 31 08:37:54 MDT 2011 + 011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Thu Mar 31 08:37:55 MDT 2011 + 015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Mar 31 08:37:57 MDT 2011 + 022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Mar 31 08:37:59 MDT 2011 + 030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Thu Mar 31 08:55:29 MDT 2011 + 032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 7 at Thu Mar 31 08:55:30 MDT 2011 + 035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Mar 31 08:55:33 MDT 2011 + 038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 7 at Thu Mar 31 08:55:34 MDT 2011 + 040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Thu Mar 31 08:55:35 MDT 2011 + 043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Mar 31 08:55:41 MDT 2011 + 046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Mar 31 08:55:44 MDT 2011 + 052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Thu Mar 31 08:56:04 MDT 2011 + + +All results are bfb, tests failed due to changes in the inithist file - for ghgrmp and outfrq3s an additional file is + present which was not in the baseline. The others failed because the variable time_bnds was corrected to + properly reflect the (instantaneous) bounds of the inithist file and because the nlon and wnummax variables + were removed. + + + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_49 +Originator(s): Edwards, Taylor, Mirin +Date: 03/21/2011 +One-line Summary: homme dycore updates, New column output method + +Purpose of changes: Developement of homme dycore and related + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + Additional homme hgrid support + +Describe any changes made to the namelist: + updated some defaults for high resolution + Exposed additional homme namelist variables to CAM's build-namelist: + homme_ftype: selects type of forcing (adjustment, tendencies or + hybrid + phys_tscale: HOMME's forcing allows for the the physics dt + (phys_tscale) to be different than the + physics update frequency (dtime) + default is phys_tscale=dtime + nu_q hyper-viscosity for tracers (default=nu) + qsplit controlls tracer/dynamics time step splitting + + + +List any changes to the defaults for the boundary datasets: + updated default topography data sets to use new + hyperviscosity-smoothed versions. + added a 128x256 eul initial dataset with 101 startdate + + +Describe any substantial timing or memory changes: + +Code reviewed by: Edwards, Eaton + +List all subroutines eliminated: + models/atm/cam/src/dynamics/homme/io_dist.F90 + models/atm/cam/src/dynamics/fv/io_dist.F90 + Obsolete functions to move distributed arrays to single processor IO. + + +List all subroutines added and what they do: + two new modules added - they are data processing utilities which + rely on both CAM and HOMME infrastructure so included here but + not used for normal simulations. + + models/atm/cam/src/dynamics/homme/native_mapping.F90 + Allows the creation of scrip format mapping files based on the + homme dycore basis functions. These are smoother than bilinear + interpolation but may not be sign preserving. + + models/atm/cam/src/dynamics/homme/nctopo_util_mod.F90 + Applys hyper-viscosity smoothing to PHIS, SGH, SGH30 fields, + writes smoothed fields to history files as PHIS_SM, SGH_SM and SGH30_SM + + + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/nl_files/ghgrmp + Added a third history file output with new column data format but + same data as second history file + + models/atm/cam/bld/config_files/horiz_grid.xml + models/atm/cam/bld/build-namelist + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + models/atm/cam/bld/namelist_files/namelist_definition.xml + Added support for ne16np8 and ne30np8 hgrids + Updated default topo files for ne30np4, ne60np4, ne120np4 and ne240np4 hgrids + + Added support for new column output method, method is triggered with namelist + variable collect_column_output = .true. this is an array of size 6, one for + each history file. + + + models/atm/cam/src/control/cam_history.F90 + models/atm/cam/src/control/cam_history_support.F90 + Added an interface to interp_mod so that information about the interpolation + method is written to the history files. + Added an option to collect column output into a single field and + output using the ncol format which is defined for unstructured grids. + This is a much faster method when you are outputing several columns + + models/atm/cam/src/utils/spmd_utils.F90 + Refactored in an effort to move toward removeing mpishorthand.F and + making this the sole location in cam where mpif.h is included. + + + models/atm/cam/src/dynamics/homme/pmgrid.F90 + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + models/atm/cam/src/dynamics/homme/inital.F90 + Added support for physics to use more mpi tasks than dynamics, + removed SPMD cpp ifdefs , remove use of mpishorthand module + + models/atm/cam/src/dynamics/homme/interp_mod.F90 + Added code to add attributes to the history file indicating + the options used in interpolation, fixed a bug in vector + field interpolation. + + models/atm/cam/src/dynamics/fv/dyn_grid.F90 + models/atm/cam/src/dynamics/sld/dyn_grid.F90 + models/atm/cam/src/dynamics/eul/dyn_grid.F90 + Added stubs for get_block_ldof_d - plan to move code + + models/atm/cam/src/dynamics/fv/interp_mod.F90 + models/atm/cam/src/dynamics/sld/interp_mod.F90 + models/atm/cam/src/dynamics/eul/interp_mod.F90 + update stub api to support unstructured grids + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Tue Mar 22 11:21:47 MDT 2011 + 021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Mar 22 12:01:36 MDT 2011 + 063 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ....................... FAIL + 066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL + + +edinburgh/lf95: All pass except: + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Mar 22 11:32:18 MDT 2011 + 030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Mar 22 15:59:09 MDT 2011 + +edinburgh/pgi : All pass except: + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Mar 22 11:18:46 MDT 2011 + 030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Mar 22 12:00:41 MDT 2011 + 052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL + + ghgrmp baseline tests fail due to the addition of a history file with collected column output + all existing history files were comfirmed to be bfb with baseline + + HOMME default output was changed from interpolated to native grid + + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_48 +Originator(s): mvr,bundy,jedwards,dennis,hannay,eaton +Date: Wed Mar 16 2011 +One-line Summary: added functionality for fv 2.5x3.33 resolution; small fixes +and cleanup to test scripts; added support for 0.25deg cam-homme; tweak of +cam5 tuning parameters; bug fixes to flushing of output buffers; updated +externals definitions for component tags + +======= +Purpose of changes: +-machine jaguar was decommissioned 3/7/11 so support was stripped from test scripts +-adjusted tuning parameters dust_emis_fact and cldfrc_rhminl for cam5_1...tuning + was done at 1deg but applies to all resolutions for now - tuning specific to + other resolutions may follow +-externals updated from cesm1_0_beta13 to cesm1_0_beta16 + + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- added default files for new 2.5x3.33 resolution +- added default files for 0.25deg cam-homme + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f2.5c5dm +- new configuration options test file for 2.5x3.33 + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TDD.sh +M models/atm/cam/test/system/TCB_ccsm.sh +M models/atm/cam/test/system/TBL.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TPF.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TEQ_ccsm.sh +M models/atm/cam/test/system/TER_ccsm.sh +M models/atm/cam/test/system/TSM_ccsm.sh +M models/atm/cam/test/system/TMC.sh +M models/atm/cam/test/system/TBL_ccsm.sh +M models/atm/cam/test/system/TSC.sh +M models/atm/cam/test/system/TEQ.sh +M models/atm/cam/test/system/TSM.sh +- fix behavior of test scripts in how they clean up after themselves + +M models/atm/cam/test/system/CAM_decomp.sh +- added code for new 2.5x3.33 resolution to fv dynamics decomposition utility + +M models/atm/cam/test/system/test_driver.sh +- removed test support for decommissioned machine, jaguar +- made all module loading/unloading in test scripts to refer to generic + compilers, netcdf, etc and removed the 'module purge' from lynx + +M models/atm/cam/test/system/nl_files/ghgrmp +- enhanced namelist options test file with additional vars on aux history + tapes (jedwards) + +M models/atm/cam/test/system/input_tests_master +- modified test definition to now run at new 2.5x3.33 resolution + +M models/atm/cam/test/system/CAM_runcmnd.sh +- removed test support for decommissioned machine, jaguar + +M models/atm/cam/bld/config_files/horiz_grid.xml +- added support for new 2.5x3.33 resolution + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- added default files for new 2.5x3.33 resolution +- added default files for 0.25deg cam-homme +- adjusted tuning parameters dust_emis_fact and cldfrc_rhminl for cam5 + +M models/atm/cam/src/control/ncdio_atm.F90 +M models/atm/cam/src/utils/abortutils.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +- now flushing correct output buffer rather than unit 6 + +M models/atm/cam/src/control/cam_history.F90 +- bug fix to string length problem (jedwards) + +M models/atm/cam/src/utils/time_manager.F90 +- added method from release branch for timemgr_set_date_time + +M models/atm/cam/src/utils/cam_aqua/shr_flux_mod.F90 +- change to interface to coincide with changes to share and drv code + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +- added call to flush buffers after initialization stage + +M SVN_EXTERNAL_DIRECTORIES + M . +- new external component tags for drv, clm, cice, docn, share, timing, + scripts, slnd, sice, socn, sglc - consistent with update from cesm1_0_beta13 + to cesm1_0_beta16 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Mar 15 16:35:21 MDT 2011 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Mar 15 16:36:56 MDT 2011 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Mar 15 16:49:59 MDT 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Mar 15 17:14:53 MDT 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue Mar 15 17:28:40 MDT 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Mar 15 17:56:35 MDT 2011 +072 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Tue Mar 15 19:20:21 MDT 2011 +- cam5 baselines were expected to fail due to changes in tuning parameters +- bl992 was expected to fail due to changes to component tags between cesm1_0_beta13 and cesm1_0_beta16, namely: + "landfrac is no longer sent at run phase" (beta15) and "driver mapping mods" (beta16) + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Mar 15 14:47:47 MDT 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Mar 15 15:00:24 MDT 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Mar 15 15:07:27 MDT 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Mar 15 15:13:55 MDT 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Mar 15 15:41:20 MDT 2011 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Tue Mar 15 18:13:40 MDT 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Tue Mar 15 18:47:52 MDT 2011 +- cam5 baselines were expected to fail due to changes in tuning parameters +- bl312 was expected to fail due to it changing to 2.5x3.33 resolution which did not exist in baseline code + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Mar 16 10:30:16 MDT 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Mar 16 10:35:59 MDT 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Mar 16 10:39:20 MDT 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Mar 16 10:42:43 MDT 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Mar 16 10:52:47 MDT 2011 +030 bl312 TBL.sh f2.5c5dm ghgrmp 9s .......................................FAIL! rc= 7 at Wed Mar 16 11:17:07 MDT 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Mar 16 11:28:02 MDT 2011 +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Mar 16 11:28:08 MDT 2011 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Mar 16 11:28:09 MDT 2011 +049 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 7 at Wed Mar 16 11:28:11 MDT 2011 +052 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Wed Mar 16 11:29:31 MDT 2011 +- cam5 baselines were expected to fail due to changes in tuning parameters +- bl312 was expected to fail due to it changing to 2.5x3.33 resolution which did not exist in baseline code + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b except for cam5, where all configurations had answers change due to + the tweaking of tuning parameters...these produce a new climate and the diagnostics can be found here: + http://wwwint.cgd.ucar.edu/project/diagnostics/cesm-1.0/amwg/hannay/b40_1850_1d_b08c5cn_138j/b40_1850_1d_b08c5cn_138j-obs_yr200-209/ + + +====================================================================== +=============================================================== + +>>>>>>> .merge-right.r27350 +Tag name: cam5_0_47 +Originator(s): jedwards, eaton +Date: Mar, 08 2011 +One-line Summary: Refactoring cam history + +Purpose of changes: + +. Refactoring in cam history to allow for extra dimensions beyond the + current spatial/temporal ones. Previously the fields in a history file + time sample only had (lon,lat,lev,time) or (ncol,lev,time) dimensions. + The "addfld" calls allowed lev to be set to 1, plev or plevp. To work + around this constraint in the past optional flags were added to the + addfld subroutine that allowed more values of lev, but this workaround + did not provide extra dimensions. In cases where multiple non-horizontal + dimensions were needed, e.g., level and optical depth, or level and + subcolumn, the technique employed was to combine multiple dimensions into + a single mixed dimension. We have eliminated the need to do that. + Optional arguments have been added to the addfld subroutine which allow + defining multiple dimensions rather than just a single "lev" dimension. + +. The support for 4-byte history buffers has been removed. This feature + added substantial complexity to cam_history, but no demonstrated benefit. + It also was not part of the regression testing, so we don't know whether + it was working correctly. + +. The old isccp cloudsimulator code was removed. The latest ISCCP + simulator is available as part of the COSP package. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Edwards, Eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/cloudsimulator.F90 +models/atm/cam/src/physics/cam/cloudsimulator_38.F90 +models/atm/cam/src/physics/cam/icarus_scops.F90 +models/atm/cam/src/physics/cam/icarus_scops_38.F90 +. The old ISCCP simulator code has been removed. + + +List all subroutines added and what they do: + +models/atm/cam/src/control/cam_history_buffers.F90 +models/atm/cam/src/control/cam_history_support.F90 +- These files seperate out some of the distinct functionality that was + in cam_history. + + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/CAM_compare.sh + Added -d option so that cprnc can compare sat_hist files + + models/atm/cam/test/system/test_driver.sh + Point to new cprnc location on bluefire and edinburgh, this change should + be reverted when the new cprnc code is moved to the standard location + + models/atm/cam/test/system/nl_files/outfrq1m + Change ndens from 1 to 2 so that 4 byte history files are included in the test + suite. + + models/atm/cam/test/system/input_tests_master + Modify test 318 to incude sat history file and local time buf tests + + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + models/atm/cam/bld/namelist_files/namelist_definition.xml + models/atm/cam/bld/build-namelist + Remove isccp code, add drydep_srf_file for homme, remove flags for 4-byte history buffers + + models/atm/cam/bld/cam.cpl7.template + Remove phys_loadbalance setting - this is handled by cams configure script and varies with dycore + + models/atm/cam/SVN_EXTERNAL_DIRECTORIES + Update cprnc tag + + models/atm/cam/src/utils/time_manager.F90 + models/atm/cam/src/control/mpishorthand.F + Remove global save statement + + models/atm/cam/src/control/runtime_opts.F90 + Remove isccp code, remove 4-byte history buffer code + + models/atm/cam/src/control/cam_comp.F90 + models/atm/cam/src/control/camsrfexch_types.F90 + Added code to deallocate derived data types used in srf exchanges + + models/atm/cam/src/physics/cam/radiation.F90 + models/atm/cam/src/physics/rrtmg/radiation.F90 + models/atm/cam/src/control/filenames.F90 + Remove isccp code + + models/atm/cam/src/control/cam_restart.F90 + Removed unused reference to shr_sys_getenv, cam_history mtapes is now ptapes + + models/atm/cam/src/control/ioFileMod.F90 + Added an optional argument to getfil, lexist, that will be set to true if the + file is found and false otherwise. + + models/atm/cam/src/control/cam_history.F90 + Moved buffer code to cam_history_buffers.F90, moved some shared header code to + cam_history_support.F90, removed 4-byte buffer code. Added support for more than + 1 non-decomposed dimension in fields. Refactored cosp and + sat_hist code, removed isccp specific and other dead code. + + models/atm/cam/src/utils/cam_pio_utils.F90 + Moved code that had been moved here from cam_history to cam_history_support.F90 + Added support for more than 1 non-decomposed dimension in fields. + + models/atm/cam/src/utils/cam_dom/ocn_comp.F90 + Removed reference to unused shr functions + + models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + Seperated dimensions that were required to be combined by restrictions in cam_history + Added only clause to use statements. + + models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + Improved error checking for reading drydep_srf_file used by unstructured grids + + models/atm/cam/src/dynamics/homme/interp_mod.F90 + Bug fix in interpolation of vector fields + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass + +edinburgh/lf95: all pass except: + 043 bl318 TBL.sh f10c4cdm sat_hist 9s Test was modified to include sat_hist, I back ported the modified test and + ran manually with bfb results. + Tests 317 and 318 require the updated cprnc (cprnc_110307c) + +edinburgh/pgi or jaguar/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_46 +Originator(s): jet, P. Worley, eaton +Date: +One-line Summary: Fix spmd_comm namelist parameters for all dycores. + +Purpose of changes: SPMD controlling namelist parameters were broken for all dycores but FV + by my cam5_0_25 tag. Additionally the inline documentation for the parameters in + spmd_dyn were also screwed up. Both of these are now fixed. This tag also continues + the namelist refactor that defines and sets the default namelist values as module + data instead of using the setopts routines. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Added a new spmd_utils namelist to atm_in called spmd_utils_nl. + This contains the spmd controlling namelist parameters + swap_comm_protocol + swap_comm_maxreq + fc_gather_flow_cntl + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by:mvr + +List all subroutines eliminated: + fc_gather_setopts + swap_comm_setopts + +List all subroutines added and what they do: + + spmd_utils_readnl - allows for namelist input for + the swap_comm/gather_flow spmd + parameters + +List all existing files that have been modified, and describe the changes: + M models/atm/cam/doc/ChangeLog + + M models/atm/cam/bld/namelist_files/namelist_definition.xml + Added spmd_utils_nl as the group for the swap_comm/gather_flow parameters + + M models/atm/cam/src/control/runtime_opts.F90 + Added call for reading new namelist + + M models/atm/cam/src/utils/spmd_utils.F90 + Added new subroutine to read spmd_utils_nl namelist + + M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 + Got rid of spmd setopts calls + + M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 + Got rid of spmd setopts calls + + M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + Got rid of spmd setopts calls + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All Pass + +edinburgh/lf95: All Pass + +edinburgh/pgi or jaguar/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e.,BFB +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam5_0_45 +Originator(s): mvr,jenkay +Date: Fri Feb 18 2011 +One-line Summary: fixing a problem with the weighted averages for several COSP + output variables + +Purpose of changes: +- problem affects COSP answers and fix was needed before CFMIP integrations could begin. + output variables affected: MEANCLDALB_ISCCP, MEANPTOP_ISCCP, and MEANTAU_ISCCP + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: +043 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Feb 18 13:06:55 MST 2011 +- baselines for configurations using cosp were expected to fail - differences in the secondary history tapes only + +edinburgh/pgi: +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Fri Feb 18 13:07:06 MST 2011 +- baselines for configurations using cosp were expected to fail - differences in the secondary history tapes only + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b, except for cosp variables MEANCLDALB_ISCCP, MEANPTOP_ISCCP, and MEANTAU_ISCCP + + +====================================================================== +=============================================================== + +Tag name: cam5_0_44 +Originator(s): Francis Vitt +Date: 18 Feb 2011 +One-line Summary: Added new history capabilities + +Purpose of changes: + + The following capabilities were added to CAM history to help with + comparisons to observations: + - local time averaging + - sampling along a specified track + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + To activate local time averaging use 'L' history averaging flag and set lcltod_start, and + lcltod_stop namelist variable to specify the local start and stop times (in seconds) of the + averaging region. For example: + + hist_avgflag_pertape = 'L' + lcltod_start = 0 + lcltod_stop = 3600 + + To activate sampling along a specified track use the following namelists: + + sathist_track_infile - netcdf file that specifies the track(s) the sample along + sathist_fincl - list of history fields to be sampled + sathist_mfilt - number of columns output to each individual file + sathist_hfilename_spec - specifies the output file template "%c.cam2.sat.%y-%m-%d-%s.nc" + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/control/sat_hist.F90 + this manages the output of columns along a specified track + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 + changes for sampling and local time averaging + +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 + made get_gcol_block_d interface the same as the dynamics/homme version + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: ALL PASS + +edinburgh/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_0_43 +Originator(s): mvr,jenkay,eaton +Date: Wed Feb 16 2011 +One-line Summary: cosp bug fixes/code improvement; cleanup of cam microphysics; + fix for sld configurations + +Purpose of changes: +- cosp mods include: + 1) reff_cosp mods per Yuying's e-mail, described in cospsimulator_intr.F90 + 2) I checked that all fields to run COSP off-line are available, and changed + documentation at the top of cospsimulator_intr.F90. + 3) Jim Boyle found a problem when using cosp_nradsteps = 3: + "The data were saved as instantaneous - the values were saved as missing. + If there is a bug I could imagine the missing values cycling through all the + longitudes for a month and producing seemingly complete fields." + This was indeed a problem - radiation is called a number of times in a + single timestep (loop over chunks in physpkg.F90). Therefore, my cosp_cnt + counter, which was meant to advance only as timestep advanced, was advancing + within a timestep. I redid the logic in radiation.F90. cosp_cnt now has an + lchnk dimension... each chunk has its own counter. + + Note: for 3), the monthly outputs from a long COSP run looked ok - I think + they are just sub-sampling the columns in a different way. So 3) is really + an answer issue more for instantaneous forecast values, and a consistency + issue for monthly averages. + 4) An aside code mod not related to COSP: I added ATMEINT addfld/outfld calls + in cam_diagnostics.F90, a useful diagnostic for meridional heat transport + calculations. + +- microphysics changes involve: + 1. Removing unnecessary passed variables and use statements for the CAM5 cloud + microphysics (cldwat2m_micro.F90) [Hugh: Oct 31st Mods] + 2. Adding functionality for a logical flag called 'sub_column' to be passed to + the CAM5 microphysics that changes how it works, but with the flag set (false) + to reproduce the standard code (cldwat2m_micro.F90) + +- anything using sld dycore was broken with mods in cam5_0_41, where a + namespace issue was addressed for coupling with cism + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/utils/sgexx.F90 +M models/atm/cam/src/dynamics/sld/nmmatrix.F90 +- fix for sld - was broken with mods to address namespace problems in cam5_0_41 + +M models/atm/cam/src/physics/cam/initindx.F90 +M models/atm/cam/src/physics/cam/microp_aero.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/macrop_driver.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/rrtmg/radlw.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +- mods for cosp work (see above) + +M models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +MM models/atm/cam/src/physics/cam/microp_driver.F90 +- mods included those for cosp work and microphysics cleanup (see above) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: +043 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Feb 15 13:38:13 MST 2011 +- baselines for configurations turning on cosp were expected to fail - differences in the secondary history tapes only + +edinburgh/pgi: +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Feb 15 13:21:21 MST 2011 +- baselines for configurations turning on cosp were expected to fail - differences in the secondary history tapes only + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b, except for cosp variables + + +====================================================================== +=============================================================== + +Tag name: cam5_0_42 +Originator(s): Edwards, Eaton +Date: Mon Feb 7 09:57:52 MST 2011 +One-line Summary: Refactoring in rad_constituents and modal aerosol code. + +Purpose of changes: + +. This is another step on the path to providing prescribed modal aerosol + functionality. + +. The rad_constituent interfaces have been generalized to treat the climate + and diagnostic calculations more uniformly. The use of an optional + argument to identify a diagnostic calc is replaced by a non-optional + argument which is set to zero to indicate the climate calculation, and to + 1,...,N_DIAG for the diagnostic calculation. This allows us to + consolidate the separate code for climate and diagnostic calcs in the + radiation driver (rrtmg only). + +. Removed qqcw array from pbuf structure and replaced with individual cloud + bourne constituant species. Code clean up including replacing goto flow + structures and redefining static variables as parameters. + +. Add test for diagnostic rad calcs with BAM and rrtmg + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. Removal of qqcw array reduces the number of 3D arrays in pbuf by 10. + +Code reviewed by: Eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/test/system/nl_files/rad_diag + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/chemistry/modal_aero/modal_aero_calcsize.F90 +. update qqcw access +. cleanup code structure, remove "go to"s + +models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +. move parameter settings here from the initialize module +. add methods to access qqcw fields + +models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +. add register method for adding fields to constituent arrays and pbuf. +. fix output unit + +models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +models/atm/cam/src/chemistry/modal_aero/modal_aero_wateruptake.F90 +. cleanup + +models/atm/cam/src/chemistry/mozart/chemistry.F90 +. call new modal_aero_register method + +models/atm/cam/src/chemistry/mozart/mo_mass_xforms.F90 +. add methods qqcw2vmr and vmr2qqcw to handle new qqcw implementation + +models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +. cleanup unused rad_constituents use association + +models/atm/cam/src/physics/cam/microp_aero.F90 +models/atm/cam/src/physics/cam/microp_driver.F90 +. update rad_cnst interfaces +. update qqcw access + +models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/mozart/mo_setsox.F90 +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +models/atm/cam/src/physics/cam/ndrop.F90 +. update qqcw access +. cleanup + +models/atm/cam/src/physics/cam/stratiform.F90 +models/atm/cam/src/physics/cam/tphysbc.F90 +. remove unused ifdef MODAL_AERO conditionals + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +models/atm/cam/src/physics/cam/modal_aer_opt.F90 +models/atm/cam/src/physics/cam/rad_constituents.F90 +models/atm/cam/src/physics/cam/radiation.F90 +models/atm/cam/src/physics/cam/radiation_data.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +models/atm/cam/src/physics/waccm/nlte_lw.F90 +. update rad_cnst interfaces + +models/atm/cam/test/system/input_tests_master +models/atm/cam/test/system/tests_pretag_edinburgh_pgi +. add test {sm,er,bl}320 fn10c5dm rad_diag 9s + This tests rad diagnostic calcs for bulk aerosols in rrtmg + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass + +edinburgh/lf95: all pass + +edinburgh/pgi: all pass except +049 bl320 TBL.sh fn10c5dm rad_diag 9s .....................................FAIL! rc= 5 at Sat Feb 5 17:51:45 MST 2011 + +This failure is expected since it's a new test and there is no comparable +test in cam5_0_41 for the baseline comparison. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== +Tag name: cam5_0_41 +Originator(s): mvr,jedwards,eaton +Date: Mon Jan 31 2011 +One-line Summary: enabled use of intel and pathscale compilers; updated clm tag +allowed cleanup of misc.h and preproc.h; filepath changes for clm; new default +climatological datasets for prescribed aerosol, ozone; cleanup of namelist +definitions; mods to allow coupling with cism + +Purpose of changes: +- new aerosol and ozone datasets were for 2000 climatology +- coupling with land ice model (cism) was hampered by namespace conflicts + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- new default climatological datasets for prescribed aerosol, ozone + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +- enabled testing with pathscale and intel compilers on lynx + +M models/atm/cam/bld/configure +- new clm tag allowed cleanup of misc.h and preproc.h; filepath changes for clm + +M models/atm/cam/bld/Makefile.in +- changes needed to enable pathscale and intel compilers + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- new default climatological datasets (2000 climatology) for prescribed aerosol + and prescribed ozone + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- cleanup of old clm entries + +M models/atm/cam/bld/namelist_files/use_cases/2005_cam4.xml +- changed the prescribed aero, deposition, and ozone datasets for present day + use_case to the versions used by rcp4.5 + +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +- minor fixes needed to appease intel or pathscale compiler + +M models/atm/cam/src/utils/sgexx.F90 +- converted to a module to prevent namespace conflicts when coupled with cism + +M models/atm/cam/src/dynamics/eul/settau.F90 +- modified to now use new module sgexx + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated land tag to clm4_0_22 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Jan 31 09:50:55 MST 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Jan 31 09:51:06 MST 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Jan 31 09:51:29 MST 2011 +072 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 4 at Mon Jan 31 10:40:13 MST 2011 +- any baseline where prescribed aerosols or prescribed ozone was used was expected to fail + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Jan 27 12:13:18 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Jan 27 12:22:16 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Jan 27 12:34:43 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Jan 27 12:57:50 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Thu Jan 27 13:20:08 MST 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 27 13:41:30 MST 2011 +043 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 27 13:57:43 MST 2011 +- any baseline where prescribed aerosols or prescribed ozone was used was expected to fail + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Thu Jan 27 12:09:01 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Thu Jan 27 12:14:38 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Thu Jan 27 12:21:44 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Thu Jan 27 12:32:49 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Thu Jan 27 12:41:59 MST 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 27 12:49:30 MST 2011 +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 27 13:02:30 MST 2011 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Jan 27 13:06:58 MST 2011 +049 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Thu Jan 27 13:33:53 MST 2011 +- any baseline where prescribed aerosols or prescribed ozone was used was expected to fail + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b, except for configurations using default datasets for prescribed aerosols, ozone + + +====================================================================== +=============================================================== +Tag name: cam5_0_40 +Originator(s): mvr,hannay +Date: Thu Jan 27 2011 +One-line Summary: bug fixes and retuning of cam5 physics + +Purpose of changes: +1. A fix to immersion freezing (small changes) +2. Fixing the diagnostic output FICE to trap for roundoff errors (diagnostic only) +3. Bug fix for subgrid cloud water treatment in contact nucleation (small changes) +4. Bug fix for size of snow particles used in radiation (they get smaller by a factor of 3 and more reflective: some impact). +5. Fix to guarantee the in-stratus LWC to be within the specified range even when the cloud fraction is very small (< 1.e-5 ) +6 Fix to prevent model crash by dividing by near zero cloud fraction in the droplet activation routine + +We also include retuning parameters as in: b40_1850_1d_b08c5cn_138j + + release(2deg) Bugfix+CN (1deg) +Dcs 325 400 +rhminl 0.89 0.90 +c0_lnd 0.0020 0.0059 +c0_ocn 0.0150 0.0450 +dp1 0.04 0.10 +dp2 675. 500. +div24del2flag 2 4 + +Notice that the 2 degree version has not been retuned and we use the +1 degree parameter for all resolution. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- default settings for rhminl, c0_lnd, c0_ocn, dp1, dp2, div24del2flag + retuned for cam5 physics + +M models/atm/cam/src/physics/cam/ndrop.F90 +- Fix to prevent model crash by dividing by near zero cloud fraction in + the droplet activation routine + +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +- bug fixes, see above + +M models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +- rhosn, Dcs retuned; bug fixes, see above + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Jan 26 11:49:08 MST 2011 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Jan 26 11:49:10 MST 2011 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Jan 26 11:49:24 MST 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Jan 26 11:50:28 MST 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Jan 26 11:51:12 MST 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Wed Jan 26 11:51:49 MST 2011 +- cam5 baseline tests failed as expected + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jan 26 15:36:19 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jan 26 15:42:36 MST 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Jan 26 15:48:01 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jan 26 15:49:49 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jan 26 16:06:20 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Wed Jan 26 16:36:45 MST 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Jan 26 17:27:13 MST 2011 +- cam5 baseline tests failed as expected + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jan 26 15:34:11 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jan 26 15:38:35 MST 2011 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Jan 26 15:41:42 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jan 26 15:42:39 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jan 26 15:49:55 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Wed Jan 26 15:54:17 MST 2011 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Jan 26 16:06:28 MST 2011 +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 26 16:17:26 MST 2011 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 26 16:24:58 MST 2011 +049 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Wed Jan 26 17:01:15 MST 2011 +- cam5 baseline tests failed as expected + +lynx/pgi: +004 bl157 TBL.sh e64c5m ghgrmp 9s .........................................FAIL! rc= 7 at Tue Jan 25 12:58:50 MST 2011 +006 bl158 TBL.sh e64c5paqm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Jan 25 12:58:52 MST 2011 +012 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Jan 25 12:59:05 MST 2011 +021 bl372 TBL.sh f1.9c5m fvvp_lb2 9s ......................................FAIL! rc= 7 at Tue Jan 25 13:00:44 MST 2011 +026 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Jan 25 13:01:16 MST 2011 +- cam5 baseline tests failed as expected + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate for cam5 physics + +The validation run is: + http://wwwint.cgd.ucar.edu/project/diagnostics/cesm-1.0/amwg/hannay/cam5_0_39_1d_u265/cam5_0_39_1d_u265-obs/ + + +====================================================================== +=============================================================== +Tag name: cam5_0_39 +Originator(s): mvr,mvertens +Date: Fri Jan 21 2011 +One-line Summary: mods to compute coupler indices locally + +Purpose of changes: +The coupler is being changed to not depend on hard-wired indices. Each component +will now compute its own indices. The calculation of the indices will reside in +a new module called cam_cpl_indices.F90 - that is in a new directory cpl_share +that is shared between cpl_esmf and cpl_mct. Use of seq_flds_indices is being +removed. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none +A models/atm/cam/src/cpl_share +A models/atm/cam/src/cpl_share/cam_cpl_indices.F90 +- new directory and file for computing coupler indices locally + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/configure +- addition of new directory cpl_share to filepath + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +- replaced use of seq_flds_indices with cam_cpl_indices + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: not tested + +edinburgh/pgi: not tested + +lynx/pgi: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +====================================================================== +=============================================================== +Tag name: cam5_0_38 +Originator(s): mvr +Date: Fri Jan 07 2011 +One-line Summary: updated for esmf metadata capability + +Purpose of changes: +The "register" interface in esmf is changing. This change only +impacts the esmf interfaces, nothing else. This should all be bfb +and really only impacts the esmf interface version of the components. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/cpl_esmf/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: not tested + +edinburgh/pgi: not tested + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +====================================================================== +=============================================================== + +Tag name: cam5_0_37 +Originator(s): Jim Edwards, Mark Taylor +Date: 01-03-2011 +One-line Summary: Merge homme dycore development, inline history interpolation + +Purpose of changes: Improve support for unstructured grids + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: Added analysis namelist for homme dycore + with the following variables: + interpolate_analysis : logical array which indicates whether each history file should be interpolated to a lat/lon grid + interp_nlat, interp_nlon : integer variables indicating the size of the lat lon grid to interpolate to + interp_gridtype: integer indicating the type of output grid to use. + ! gridtype = 1 equally spaced, including poles (FV scalars output grid) + ! gridtype = 2 Gauss grid (CAM Eulerian) + ! gridtype = 3 equally spaced, no poles (FV staggered velocity) + interp_type : The type of interpolation to perform, currently supported values are + ! interp_type = 0 Native grid high order interpolation + ! interp_type = 1 Bilinear interpolation + + + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + Inline Grid interpolation appears to require some 6-10x more time per history file than writting on the native grid, + this feature is added as a convenience for the scientist. If high frequency output is required, or it is required that + the interpolation meet extraordinary quality standards, then it is recommended to + output on the native grid and interpolate using the post processing tool provided in homme. + +Code reviewed by: Eaton, Taylor, Edwards + +List all subroutines eliminated: + +List all subroutines added and what they do: interp_mod.F90 provides an interface between cam_history.F90 + and the interpolation functions which may be unique to each dycore. + +List all existing files that have been modified, and describe the changes: + models/atm/cam/SVN_EXTERNAL_DIRECTORIES + models/atm/cam/src/dynamics/homme/external + + The homme/external directory was formerly a copy of the homme source tree, + we are now pointing directly at the homme source code repository. + + models/atm/cam/bld/Makefile.in + + Replaced -btextpsize:64k with -btextpsize:32K for AIX builds, this is a workaround for a bug in AIX which prevents + debuggers from properly reporting source code lines. + + models/atm/cam/bld/build-namelist + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + models/atm/cam/bld/namelist_files/namelist_definition.xml + + Added support for the new interpolation fields outlined above + + models/atm/cam/src/dynamics/sld/interp_mod.F90 + models/atm/cam/src/dynamics/eul/interp_mod.F90 + models/atm/cam/src/dynamics/fv/interp_mod.F90 + + Dummy code added to support the interpolation api. This code could also be + used to interpolate from one lat/lon grid to another. + + models/atm/cam/src/control/cam_history.F90 + models/atm/cam/src/utils/cam_pio_utils.F90 + + Added code to support history file interpolation, including support for interpolating vector pairs + which may require simultanious treatment. + + + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + models/atm/cam/src/dynamics/homme/interp_mod.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + + Added code for inline interpolation of history files to a lat-lon grid, merged in latest homme dycore + development. + + models/atm/cam/src/control/print_memusage.F90 + Bug fix for intrepid (BGQ) + + + models/atm/cam/chemistry/bulk_aero/dust_intr.F90 + + Replaced netcdf calls with pio calls and added interpolation. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + 011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL + 021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL + 036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL + 040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL + 045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL + 047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL + 063 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL + 066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL + +edinburgh/lf95: + 004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL + 015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL + 022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL + 030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL + +edinburgh/pgi or jaguar/pgi: + 004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL + 009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL + 015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL + 022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL + 030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL + 043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL + + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + Failing baseline cases are due to the change in dust_intr.F90, testing shows that this was a round-off + change for the fv cases. The EUL cases however were not on the same grid as the dataset, though they + were at the same resolution, which causes the dataset to now be interpolated and thus greater + than roundoff error. + + HOMME dycore baselines are failing because the default history file is now interpolated to a latlon + grid. These were tested to be bfb with interpolate_analysis set to .false. + + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_0_36 +Originator(s): mvr +Date: Tue Jan 05 2011 +One-line Summary: updated external definitions of component tags to those +of cesm1_0_beta13 + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- new default datasets for plant function types and river routing + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- new default datasets for plant function types and river routing + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- removed entry for obsolete namelist var, hist_crtinic + +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml +- bug fix to remove hard-coded file path to solar input datafile + +M SVN_EXTERNAL_DIRECTORIES + M . +- new component tags for clm, cice (non-bfb), csm_share, and scripts + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Tue Jan 4 13:34:59 MST 2011 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Jan 4 13:35:07 MST 2011 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Tue Jan 4 13:36:36 MST 2011 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Jan 4 13:36:44 MST 2011 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Tue Jan 4 13:37:14 MST 2011 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Jan 4 13:37:21 MST 2011 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue Jan 4 13:37:42 MST 2011 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Tue Jan 4 13:38:08 MST 2011 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Tue Jan 4 13:38:23 MST 2011 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue Jan 4 13:38:39 MST 2011 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Tue Jan 4 13:38:47 MST 2011 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Tue Jan 4 13:38:53 MST 2011 +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Tue Jan 4 13:40:34 MST 2011 +072 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Tue Jan 4 13:40:40 MST 2011 +- baseline failures were expected for any configuration using cice, where changes were not bfb + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Jan 4 13:31:35 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Jan 4 13:31:39 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Jan 4 13:32:41 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Jan 4 13:32:52 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Tue Jan 4 13:32:58 MST 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Jan 4 13:33:03 MST 2011 +043 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 7 at Tue Jan 4 13:34:52 MST 2011 +- baseline failures were expected for any configuration using cice, where changes were not bfb + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jan 5 09:09:58 MST 2011 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jan 5 09:10:00 MST 2011 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jan 5 09:10:03 MST 2011 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jan 5 09:10:06 MST 2011 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Wed Jan 5 09:10:09 MST 2011 +035 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 5 09:10:12 MST 2011 +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 5 09:10:19 MST 2011 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jan 5 09:10:20 MST 2011 +- baseline failures were expected for any configuration using cice, where changes were not bfb + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: +Answer changes were due soley to the new cice tag. These changes were described as greater than round-off, but +same climate - please see the cice documentation for more information. + + +====================================================================== +=============================================================== + +Tag name: cam5_0_35 +Originator(s): Jerry Olson +Date: Dec 29, 2010 +One-line Summary: fixed "cam3" and "cam3/aquaplanet" to be more + consistent with CAM3.1 release. Adjusted cam4 + and cam5 aquaplanet namelist parameters. + +Purpose of changes: fix cam3 and aquaplanet runs. Added cldfrc tuning + parameters to namelist. 1 minor bugfix + + List of changes to have the current "cam3" replicate CAM3.1: + 1) models/atm/cam/src/physics/cam/stratiform.F90: Remove extra cldfrc call after pcond call + 2) models/atm/cam/src/physics/cam/zm_conv_intr.F90: Shut off convective momentum transport + 3) models/atm/cam/src/physics/cam/zm_conv.F90: Call buoyan instead of buoyan_dilute + 4) models/atm/cam/bld/namelist_files/use_cases/cam3.xml: cldfrc_freeze_dry set to .false. + 5) models/atm/cam/bld/namelist_files/use_cases/cam3.xml: + a) tuning parameters are set back to their CAM3.1 levels + b) orb_iyear, solar_const, GHG values all set back to CAM3.1 values + + Additional changes to have the current "cam3" aquaplanet replicate CAM3.1 aquaplanet: + + 1) models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml and + models/atm/cam/src/control/physconst.F90: + modify freezing point of water from 273.15 --> 273.16 + 2) copy models/csm_share/shr/shr_flux_mod.F90 to + models/atm/cam/src/utils/cam_aqua/shr_flux_mod.F90 and modify: + a) originally uses T rather than virtual T to compute stability functions. + Changed back to virtual T for aqua_planet. + b) "umin" set back to 1. from 0.5 + + 3) models/atm/cam/src/physics/cam/radlw.F90: initialization of, "cldp", using + "ntoplw" instead of "ntopcld" + + 4) models/atm/cam/src/chemistry/utils/prescribed_ozone.F90: for unit conversion of APE ozone, + change universal constants: + + from: + - real(R8), parameter :: SHR_CONST_MWDAIR = 28.96623324623746_R8 + - real(r8), parameter :: molmass = 47.9981995_r8 + to: + - real(r8), parameter :: amass = 28.9644_r8 + - real(r8), parameter :: molmass = 48._r8 + + 5) models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml: + a) solar_const, GHG values set back to CAM3.1 aquaplanet levels: + b) orbit set to circular/equinox settings. + c) dtime set to 5 minutes physics timestep (dtime = 150 for Eulerian dycore) + + NOTE --> All tuning parameters for cam3 aquaplanet are set to standard CAM3.1 T85 + settings no matter the dycore or resolution. DTIME set to 5 minutes + physics timestep. User must change in namelist if other settings are + desired. + + +Bugs fixed (include bugzilla ID): State variables now output time-averaged + by default when "budget_history" is true. + +Describe any changes made to build system: csm_share/shr and csm_share/dshr + moved to bottom of Filepath - has + no effect on answers + +Describe any changes made to the namelist: + When running full model, "cam3" physics, must use "-use_case cam3" in build-namelist call + (numerous tuning parameter changes to be consistent with CAM3.1 release) + When running aquaplanet, "cam3" physics, must use "-use_case aquaplanet_cam3" in build-namelist call + (replaces aquaplanet_cam3_cam4.xml) + When running aquaplanet, "cam4" physics, must use "-use_case aquaplanet_cam4" in build-namelist call + (replaces aquaplanet_cam3_cam4.xml) + When running aquaplanet, "cam5" physics, must use "-use_case aquaplanet_cam5" in build-namelist call + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: self, eaton + +List all subroutines eliminated: + + models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3_cam4.xml + +List all subroutines added and what they do: + + models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3.xml + namelist defaults for cam3 aquaplanet + + models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam4.xml + namelist defaults for cam4 aquaplanet + + models/atm/cam/bld/namelist_files/use_cases/cam3.xml + namelist defaults for cam3 full model runs + + models/atm/cam/src/utils/cam_aqua/shr_flux_mod.F90 + copy of "models/csm_share/shr/shr_flux_mod.F90" for use + when running aqua_planet. Modified to replicate cam3 aquaplanet + results. + + models/atm/cam/test/system/config_files/f10c3aqdm + regression test added to test cam3 aquaplanet + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/bld/build-namelist + - added cldfrc tuning parameters + + models/atm/cam/bld/configure + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - moved some namelist defaults to "cam3.xml", added cldfrc tuning params + + models/atm/cam/bld/namelist_files/namelist_definition.xml + - cldfrc tuning params + + models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml + - set some new aqua_planet defaults + + models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 + - changed physical constants for cam3 aquaplanet + + models/atm/cam/src/control/physconst.F90 + - set tmelt to be initialized at runtime + + models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - made state variables time averaged rather than instantaneous + on output when "history_budget" is .true. + + models/atm/cam/src/physics/cam/cldwat2m_macro.F90 + models/atm/cam/src/physics/cam/cldwat2m_micro.F90 + - set tmax_fsnow, tmin_fsnow to be initialized at runtime + + models/atm/cam/src/physics/cam/cldwat.F90 + - set tmax_fsnow, tmin_fsnow, tmax_fice, tmin_fice to be initialized at runtime + + models/atm/cam/src/physics/cam/cloud_fraction.F90 + - made cldfrc tuning params namelist parameters + + models/atm/cam/src/physics/cam/microp_driver.F90 + - made state variables time averaged rather than instantaneous + on output when "history_budget" is .true. + + models/atm/cam/src/physics/cam/physpkg.F90 + - call inimc from here rather than from stratiform + + models/atm/cam/src/physics/cam/radlw.F90 + - code change to fix cam3 physics + + models/atm/cam/src/physics/cam/stratiform.F90 + - made state variables time averaged rather than instantaneous + on output when "history_budget" is .true. + - Remove extra cldfrc call after pcond call (cam3 physics change) + + models/atm/cam/src/physics/cam/zm_conv.F90 + - Call buoyan instead of buoyan_dilute (cam3 physics change) + + models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - Shut off convective momentum transport (cam3 physics change) + + models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_init.f90 + - set physics constants from "physconst" rather than "shr_const_mod" + + models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_init.f90 + - set physics constants from "physconst" rather than "shr_const_mod" + + models/atm/cam/test/system/input_tests_master + - use aquaplanet .xml files for all aquaplanet regression tests + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + All pass except the following baseline tests which change due to changes in aquaplanet +006 bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s .....................FAIL! rc= 5 at Tue Dec 28 14:14:56 MST 2010 +013 bl330 TBL.sh f4c5paqdh aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Tue Dec 28 14:42:34 MST 2010 +023 bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s ......................FAIL! rc= 5 at Tue Dec 28 15:06:39 MST 2010 +063 bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s ........................FAIL! rc= 5 at Tue Dec 28 18:19:21 MST 2010 +066 bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s ....................FAIL! rc= 5 at Tue Dec 28 18:31:44 MST 2010 + +edinburgh/lf95: + All pass except the following baseline tests which change due to changes in aquaplanet and/or cam3 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Dec 29 11:36:29 MST 2010... +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 5 at Wed Dec 29 12:48:00 MST 2010... +038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 5 at Wed Dec 29 13:22:18 MST 2010... +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Dec 29 13:33:49 MST 2010... + +edinburgh/pgi or jaguar/pgi: + All pass except the following baseline tests which change due to changes in aquaplanet and/or cam3 +011 bl113 TBL.sh e8c5paqdm aqpgro+aquaplanet_cam5 3s ......................FAIL! rc= 7 at Wed Dec 29 11:36:01 MST 2010... +032 bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s ....................FAIL! rc= 5 at Wed Dec 29 11:52:15 MST 2010... +038 bl315 TBL.sh f10c3dm outfrq3s+cam3 9s .................................FAIL! rc= 5 at Wed Dec 29 12:09:40 MST 2010... +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Wed Dec 29 12:16:19 MST 2010... +049 bl734 TBL.sh hn16c5aqdm outfrq3s+aquaplanet_cam5 9s ...................FAIL! rc= 7 at Wed Dec 29 13:09:07 MST 2010... + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except > RO changes in aquaplanet and any cam3 runs + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_34 +Originator(s): Jim Edwards +Date: Dec 21, 2010 +One-line Summary: fix mpi issues + +Purpose of changes: bug fixes + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + mo_lightning.F90 : needed to add optional commm parameter to repro_sum calls + metdata.F90 : needed to move pio_closefile call out of mastertask only clause. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass + +edinburgh/lf95: all pass + +edinburgh/pgi or jaguar/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): None + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_0_33 +Originator(s): mvr, jenkay +Date: Thu Dec 16 2010 +One-line Summary: extended cosp code to work with cam5 physics; update +to latest cosp vendor tag + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f10c5cdm +- new configuration options test file for testing cosp with cam5 physics + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_edinburgh_pgi +- added test for cosp/cam5 to default suite of tests on edinburgh/pgi +- removed test for cosp/cam4 from default suite (still remains in edinburgh/lahey) + +M models/atm/cam/test/system/input_tests_master +- added definition of news tests for cosp/cam5 + +M models/atm/cam/bld/configure +- no longer dies for cosp/cam5 configuration + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- entry for cosp_nradsteps; correction to cosp_histfile_num's type + +M models/atm/cam/src/physics/cam/initindx.F90 +- added call to new method, conv_water_register + +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/cosp_share.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/microp_driver.F90 +M models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +M models/atm/cam/src/physics/cam/conv_water.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +- local mods needed to work with new cosp vendor code to enable cosp + to work with cam5 physics + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + M models/atm/cam +- update to latest cosp vendor tag + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +edinburgh/lf95: +043 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 7 at Thu Dec 16 11:10:47 MST 2010 +- expected failure for cosp using cam4 due to changes in external cosp code + +edinburgh/pgi: +043 bl317 TBL.sh f10c5cdm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Dec 15 13:57:42 MST 2010 +- new test for cosp using cam5 failed because baseline code did not recognize test configuration + +CAM tag used for the baseline comparison tests if different than previous +tag: +**note: additional tests were performed for cosp using both cam4 and cam5 where results + were compared to the cosp branch tag, cosp08_cam5_0_18...results were b4b + +Summarize any changes to answers: BFB + + +====================================================================== +=============================================================== + +Tag name: cam5_0_32 +Originator(s): Edwards, Vitt +Date: 12-10-10 +One-line Summary: Generalize chemistry data input for unstructured grids + +Purpose of changes: Extend unstructured grid functionality to chemistry/ cam5 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + Changed default drydep_method to xactive_lnd except when modal chemistry is activated + Added variable drydep_srf_file to chem_inparm namelist, this allows drydep surface values + to be interpolated to the cam grid offline by the new tool mkatmsrffile + +List any changes to the defaults for the boundary datasets: + + +Describe any substantial timing or memory changes: + +Code reviewed by: Edwards, Vitt, Kinnison, Lamarque, Marsh, Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + Added atm/cam/tools/mkatmsrffile to create fraction_landuse and soilw fields off line + +List all existing files that have been modified, and describe the changes: + models/atm/cam/tools/interpic_new/README + extended instructions for creating homme dycore input data files + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + added defualts for drydep_method and drydep_srf_file + models/atm/cam/bld/namelist_files/namelist_definition.xml + added drydep_srf_file + models/atm/cam/src/chemistry/utils/mo_flbc.F90 + models/atm/cam/src/chemistry/mozart/mo_lightning.F90 + models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + models/atm/cam/src/chemistry/mozart/mo_airplane.F90 + models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 + models/atm/cam/src/chemistry/mozart/mo_photo.F90 + models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 + changed IO and interpolation methods + + models/atm/cam/src/chemistry/utils/tracer_data.F90 + removed unused use statement + models/atm/cam/src/chemistry/mozart/mo_setext.F90 + moved airplane specific code to mo_airplane.F90 + + models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + updated interfaces to chemistry code with new IO and + interpolation methods + + models/atm/cam/src/chemistry/mozart/chemistry.F90 + added support for new namelist variable drydep_srf_file + removed hard coded string lengths and replaced with shr_kind_cl + + models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + added support for reading fraction_landuse and soilw as generated offline + + models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + fraction_landuse changed from lat/lon grid to model grid + models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + changed interface to set_ub_col + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + +bluefire: + All pass except the following baseline tests which change due to changes in interpolation + 033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s + 045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s + 050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s + 060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d + +edinburgh/lf95: All pass + +edinburgh/pgi or jaguar/pgi: All pass + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: + cam4 with chemistry + what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Larger than roundoff changes in interpolation of input fields most pronounced near the + poles due to changes in interpolation method. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam5_0_31 +Originator(s): mvr, eaton, sungsu, gettleman +Date: Mon Dec 06 2010 +One-line Summary: corrected the default settings for compiler type on linux +systems; fix to unwanted side-effect of using do_circulation_diags; mod to +enable running cam5 physics without chemistry; default settings added for +divergence damping and velocity diffusion as well as the number of vertical +re-mapping timesteps per physics timestep; bug fix in shallow convection +scheme; added a few new tests, changed the names of a few others + +Purpose of changes: +The previous tag broke cam testing on the crays, where the test scripts were +relying on default settings for compiler type...changes to Makefile.in were +applied to address this problem + +We discovered that the CAM use case files that set do_circulation_diags=.true. +were having the undesirable side effect of writing the 3D field TH into the +daily avg h1 file. + +Modifications were added to get cam5 with -chem none option to produce a +climate 'similar' to standard cam5. This also enabled running the homme +dycore with cam5 physics - tests were added to exercise these. (gettleman) + +Default setting added for divergence damping and velocity diffusion at 1deg +for cam5 (was 2, now 4) + +Default settings added for the number of vertical re-mapping timesteps per +physics timestep: 2 for 0.5deg and 0.25deg and 1 otherwise + +The shallow convection scheme needed a fix to prevent division by zero in +computing cumulus top height (sungsu). + +edinburgh testing will now test separate suites for lahey and pgi compilers + +Scam test using cam5 will now have chemistry enabled. + +Default homme testing now done at higher resolution (h30np4) on bluefire + + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- add_default for nspltvrm (number of vertical re-mapping timesteps per + physics timestep) +- corrected default settings for compiler type on linux systems + +List any changes to the defaults for the boundary datasets: +- new inic file for homme using cam5 physics + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none +D models/atm/cam/test/system/config_files/f10c5pdm +D models/atm/cam/test/system/config_files/e48c4pdm +D models/atm/cam/test/system/config_files/e8c5pdm +D models/atm/cam/test/system/config_files/h16x4c3dh +D models/atm/cam/test/system/config_files/e64c5pm +D models/atm/cam/test/system/config_files/s8c5pdm +D models/atm/cam/test/system/config_files/s32c5pdh +D models/atm/cam/test/system/config_files/f4c5pdh +D models/atm/cam/test/system/config_files/f4c4pdh +- these configuration options files (used by test scripts) were renamed + +D models/atm/cam/test/system/config_files/h16c4aqdm +D models/atm/cam/test/system/tests_pretag_edinburgh +- removed these obsolete test files + +List all subroutines added and what they do: +A + models/atm/cam/test/system/config_files/e64c5paqm +A + models/atm/cam/test/system/config_files/s32c5paqdh +A + models/atm/cam/test/system/config_files/f4c4paqdh +A + models/atm/cam/test/system/config_files/f10c5paqdm +A + models/atm/cam/test/system/config_files/f4c5paqdh +A + models/atm/cam/test/system/config_files/e8c5paqdm +A + models/atm/cam/test/system/config_files/s8c5paqdm +A + models/atm/cam/test/system/config_files/h16c3aqdh +A + models/atm/cam/test/system/config_files/e48c4paqdm +- these are newly named configuration options files (used by test scripts) + +A models/atm/cam/test/system/config_files/h30c4aqdm +A models/atm/cam/test/system/config_files/hn16c5aqdm +A models/atm/cam/test/system/config_files/fn10c5dm +- these are new configuration options files needed for new tests + +A models/atm/cam/test/system/tests_pretag_edinburgh_lahey +A models/atm/cam/test/system/tests_pretag_edinburgh_pgi +- will now have separate default test suites depending on the edinburgh compiler used +- new tests added to pgi suite + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +- default homme testing now done at higher resolution on bluefire + +M models/atm/cam/test/system/config_files/scm64c4bfbiop +M models/atm/cam/test/system/config_files/e64c4bfbiop +- removed redundant setting of '-chem none' from cam4 scam test +- speeding up global 3d portion of test to run with mpi-only rather than serial + +M models/atm/cam/test/system/config_files/scmc5armiop +M models/atm/cam/test/system/config_files/scm64c5bfbiop +M models/atm/cam/test/system/config_files/e64c5bfbiop +- removed setting of '-chem none' to test default chemistry as part of cam5 scam test +- speeding up global 3d portion of test to run with mpi-only rather than serial + +M models/atm/cam/test/system/test_driver.sh +- will now have separate default test suites depending on the edinburgh compiler used + +M models/atm/cam/test/system/input_tests_master +- changes to test definitions due to filename changes with configuration options +- several new tests added, cleanup + +M models/atm/cam/bld/Makefile.in +- on linux systems, made the default fc_type pgi and set the default C compiler to + cc when the fortran compiler is ftn +- added the same optimization to the CFLAGS for pgi that is set in the + CESM macros (for consistency) + +M models/atm/cam/bld/config_files/definition.xml +- The parameters cflags, fflags, and ldflags have all had the list="1" attribute added, + to allow adding flag values that contain commas. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- new inic file for homme using cam5 physics +- new default settings for the number of vertical re-mapping timesteps per physics timestep +- new default setting for divergence damping and velocity diffusion for 1deg cam5 + +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +- Add the fields from the removed add_default calls (VTH2d, WTH2d, UV2d, + UW2d, TH, and MSKtem) explicitly to the fincl2 specification in *all* + WACCM use cases + +M models/atm/cam/bld/build-namelist +- add_default added for nspltvrm + +M models/atm/cam/src/physics/cam/microp_aero.F90 +- modifications to get cam5 with -chem none to produce a climate 'similar' to + standard cam5 (gettleman) + +M models/atm/cam/src/physics/cam/uwshcu.F90 +- fix to prevent division by zero in computing cumulus top height in shallow convection + scheme (sungsu) + +M models/atm/cam/src/dynamics/fv/ctem.F90 +- remove the add_default calls for VTH2d, WTH2d, UV2d, UW2d, TH, and MSKtem + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +006 bl133 TBL.sh e48c4paqdm aqpgro 3s .....................................FAIL! rc= 7 at Mon Dec 6 09:46:12 MST 2010 +013 bl330 TBL.sh f4c5paqdh aqpgro 3s ......................................FAIL! rc= 7 at Mon Dec 6 09:46:13 MST 2010 +023 bl333 TBL.sh f4c4paqdh aqpgro 3s ......................................FAIL! rc= 7 at Mon Dec 6 09:46:51 MST 2010 +063 bl731 TBL.sh h16c3aqdh aqua 9s ........................................FAIL! rc= 7 at Mon Dec 6 11:19:38 MST 2010 +066 bl751 TBL.sh h30c4aqdm outfrq3s 9s ....................................FAIL! rc= 7 at Mon Dec 6 11:31:15 MST 2010 +- bl751 is a new test, the other failures were due to name changes of the configuration options files + +edinburgh/lf95: +011 bl113 TBL.sh e8c5paqdm aqpgro 3s ......................................FAIL! rc= 7 at Mon Dec 6 09:42:07 MST 2010 +032 bl313 TBL.sh f10c5paqdm aqpgro 3s .....................................FAIL! rc= 7 at Mon Dec 6 10:37:41 MST 2010 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon Dec 6 10:59:10 MST 2010 +- failures were due to name changes of the configuration options files + +edinburgh/pgi: +011 bl113 TBL.sh e8c5paqdm aqpgro 3s ......................................FAIL! rc= 7 at Mon Dec 6 09:30:14 MST 2010 +032 bl313 TBL.sh f10c5paqdm aqpgro 3s .....................................FAIL! rc= 7 at Mon Dec 6 09:56:54 MST 2010 +040 bl316 TBL.sh f10c5paqdm aqpgro+aquaplanet_cam5 3s .....................FAIL! rc= 7 at Mon Dec 6 10:05:49 MST 2010 +046 bl319 TBL.sh fn10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Dec 6 10:14:43 MST 2010 +049 bl734 TBL.sh hn16c5aqdm outfrq3s 9s ...................................FAIL! rc= 7 at Mon Dec 6 10:35:24 MST 2010 +- bl734 and bl319 are new tests, the other failures were due to name changes of the configuration options files + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +====================================================================== +====================================================================== +Tag name: cam5_0_30 +Originator(s): Diane Feddema +Date: Dec 1 2010 +One-line Summary: Add new command line option to CAM's configure, fc_type. Also code cleanup. + +Purpose of changes: CAM's configure and Makefile now allow the user to specify which compiler they want when +they specify the wrapper script ftn as their compiler. fc_type is the underlying compiler that +will be invoked, valid options are pgi, intel, pathscale, lahey. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: CAM's configure has a new commandline option, fc_type. + +Describe any changes made to the namelist:None + +List any changes to the defaults for the boundary datasets:None + +Describe any substantial timing or memory changes: None + +Code reviewed by:Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/config_files/definition.xml + - added fc_type + +M models/atm/cam/bld/configure + - added fc_type command line option + +M models/atm/cam/bld/Makefile.in + - added support for fc_type command line option + +M models/atm/cam/src/physics/cam/convect_shallow.F90 + - removed duplicate declarations + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: None + +edinburgh/lf95: None + +edinburgh/pgi or jaguar/pgi: None + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + All tests are BFB + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam5_0_29 +Originator(s): Andrew Gettelman and Cheryl Craig +Date: Nov 23 2010 +One-line Summary: Separate microp/macrop physics + +Purpose of changes: Separate microphysics and macrophysics drivers in CAM5 code + +Bugs fixed (include bugzilla ID): Fix a bug in call to conv_water_4rad that would + lead to erroneous results with conv_water_in_rad=2 option if invoked. + +Describe any changes made to build system:None + +Describe any changes made to the namelist:None + +List any changes to the defaults for the boundary datasets:None + +Describe any substantial timing or memory changes: None + +Code reviewed by:Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + + +A models/atm/cam/src/physics/cam/macrop_driver.F90 + - File which contains the macrop physics processing which + had resided in stratiform +A models/atm/cam/src/physics/cam/microp_driver.F90 + - File which contains the microp physics processing which + had resided in stratiform +A models/atm/cam/src/physics/cam/conv_water.F90 + - File which contains the convective water processing which + had resided in stratiform + + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/physics/cam/microp_aero.F90 + - changed to support separation of microphysics and macrophysics and + concentrate aerosol information there + + +M models/atm/cam/src/physics/cam/param_cldoptics.F90 + - Changed file to support separation of the macro and micro physics code + - Fixed the bug found when conv_water_in_rad = 2 in the call to conv_water_4rad + +M models/atm/cam/src/physics/cam/initindx.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + - Changed files to support separation of the macro and micro physics code + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: None + +edinburgh/lf95: None + +edinburgh/pgi or jaguar/pgi: None + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + All tests are BFB + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_28 +Originator(s): mvr,jenkay,jedwards,hannay +Date: Mon Nov 22 2010 +One-line Summary: pio namelist changes; mods to handle variable orbital settings; +time_manager mods for calendar type; diagnostics added; added support to test +scripts for additional machines; updated externals + +Purpose of changes: +- pio now controlled by settings in pio_inparm of the drv namelist +- now resetting orbital parameters at run phase +- time_manager to use share constants for calendar type, new method for cf standards +- new diagnostics for inversion parameters and visible cloud optical depth (jenkay), + additional history_aerosol diagnostics (hannay) +- support was added to test scripts for jaguarpf and lynx_pgi +- external definitions updated for drv,clm,docn,cice,share,mct,scripts,pio to + match those intended for cesm1_0_beta11 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- fix to settings for initial conditions files for cam5 at half and one degree fv +- updated to use the gx1v6 version of both the 1/4 deg focndomain and fatmlndfrc files + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/bld/run-lynx.csh +- template run script for ncar cray, lynx + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +- reinstated tests er731 and bl731 to default suite on bluefire + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- added support to test scripts for jaguarpf, lynx_pgi + +M models/atm/cam/test/system/nl_files/fvvp_lb2 +M models/atm/cam/test/system/nl_files/fvvp_lb0 +- modified test definition to utilize more of the requested resources + +M models/atm/cam/bld/Makefile.in +- added -DNO_MPI2 to all serial builds + +M models/atm/cam/bld/build-namelist +- namelist variable changed from orb_iyear_ad to orb_iyear + +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml +M models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3_cam4.xml +- now specifying orb_mode=fixed_parameters in use_cases where any orbital info is specified + +M models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +- replaced PIO_NOCLOBBER with PIO_NOWRITE to enable running on lynx, which uses NETCDF 4 + +MM models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +- additional diagnostics output if history_aerosol + +M models/atm/cam/bld/configure +- removed references to USE_ESMF_LIB + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- fix to settings for initial conditions files for cam5 at half and one degree fv +- namelist variable changed from orb_iyear_ad to orb_iyear +- updated to use the gx1v6 version of both the 1/4 deg focndomain and fatmlndfrc files + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- mods to reflect changes in the pio namelist +- namelist variable changed from orb_iyear_ad to orb_iyear +- new entry for orb_mode + +M models/atm/cam/src/utils/cam_pio_utils.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +- mods needed in connection with pio changes + +M models/atm/cam/src/control/runtime_opts.F90 +- removed unneeded broadcasts of orbital parameters + +M models/atm/cam/src/control/cam_control_mod.F90 +- cleanup of parameter iyear_ad + +M models/atm/cam/src/control/cam_history.F90 +- replaced use of get_calendar with get_calendar_cf to retrieve cf standard calendar name +- mods needed in connection with pio changes + +M models/atm/cam/src/utils/time_manager.F90 +- now using share values for noleap and gregorian calendar names +- removed method get_calendar +- new method, timemgr_is_caltype, returns true if incoming calendar type string + matches actual calendar type in use +- new method, timemgr_get_calendar_cf, returns cf standard for calendar type +- removed references to USE_ESMF_LIB + +M models/atm/cam/src/utils/cam_csim4/ice_time_manager.F90 +M models/atm/cam/src/utils/cam_dom/ocn_time_manager.F90 +- now using share values for noleap and gregorian calendar names +- removed method get_calendar +- new method, timemgr_is_caltype, returns true if incoming calendar type string + matches actual calendar type in use + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +- now resetting orbital parameters with each run phase, rather than just at init + +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +- new visible cloud optical depth diagnostics for cam4 (from jenkay) + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +- new inversion diagnostics (from jenkay) + +M models/atm/cam/src/physics/rrtmg/radiation.F90 +- new visible cloud optical depth diagnostics for cam5 (from jenkay) + +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +- removed references to get_calendar method in time_manager.F90 + +M models/atm/cam/src/chemistry/mozart/spedata.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 +- replaced use of get_calendar with timemgr_is_caltype and shr constants + +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +- added code to load orbital parameters + +M models/atm/cam/src/control/cam_comp.F90 +- cleanup of comments referring to orbital parameters + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated external definitions of component tags to those meant for cesm1_0_beta11 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +063 bl731 TBL.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 7 at Mon Nov 22 00:57:53 MST 2010 +- failure due to test being reinstated and therefore not recognized by baseline scripts + +**Note that sm731 had been failing up until this tag. It is unclear what exactly + was responsible for it now passing. Through isolating each of the modifications + going in with this tag, it appears to have something to do with the changes made + in time_manager.F90, where one method was removed and two were added. + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_27 +Originator(s): eaton +Date: Thu Nov 18 14:55:18 MST 2010 +One-line Summary: Remove dependence of modal optics calc on prognostic MAM. + +Purpose of changes: + +. The first step in providing a prescribed modal aerosol capability is to + make the current prognostic MAM interact with the radiative heating + calculation via the rad_constituents module. This commit is just part of + the first step; the dependence of the modal_aer_opt module on the + prognostic MAM code has been removed. A side effect of this refactoring + in modal_aer_opt was an extensive code clean up including removal of the + inactive mie code (which can be reintroduced later if desired). + + The major structural change in modal_aer_opt is to reorder the loops so + that the loop over modes is the outermost loop. This is in preparation + for doing diagnostic forcing calculations in which some modes are + excluded from having a radiative effect. The ability to do these + diagnostic calculations is not yet in place. + + The rad_constituents interface is used to access the physical properties + and mass mixing ratios of the individual species in each mode. The + rad_constituents interface requires the names of the species (as stored + in the state or physics buffer) to access properties. The names of the + species in each mode (which is hardcoded in the prognostic MAM code) were + added to the modal optics data file to make them accessible for either + prognostic or prescribed modal optics calculations. + + The existing rad_constituent interfaces used list indexes to access the + individual aerosols. The interface was intended to be used in a context + where the aerosols were all considered to be bulk aerosols whose optical + properties would be externally mixed. But in the modal context where the + species are internally mixed we would like to be able to access + individual species by name. So generic methods have been added to the + rad_constituents interfaces that allow requesting the physical properties + and the mass mixing ratios either by index or by name. + + The namelist setting for rad_climate was updated to include all the + 3-mode species. This is required to use the rad_constituents interface + to retrieve properties and mmr for all the species contributing to the + modes. + + The species refractive indices were being read from the physprops files, + but the species densities were hardcoded and the densities in the + physprops files did not match the hardcoded values. So the physprops + files were updated to contain the hardcoded values and the prognostic MAM + code was changed to set the densities from the files. + + The phys_prop module had been hacked to get the refractive index of water + from the physprops files of the first aerosol, and the refractive index + of water data was duplicated in all the aerosol species files. Remove + this hack and put water refractive index in it's own file. Read the data + in the modal_aer_opt module since that's where it's used. Give + modal_aer_opt its own namelist for reading the name of both the water + refindex file and the modal optics file. + + Refactor phys_prop and rad_constituents interfaces to pass complex form + of refractive index. + + Refactor phys_prop to read refractive index data if it's present. Don't + depend on MODAL_AERO cpp token which is only defined for prognostic MAM. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. rad_climate updated for trop_mam3 to include all species that contribute + to the modes. + +List any changes to the defaults for the boundary datasets: + +. The modal optics file has been updated to include the metadata that + describes the modes, i.e., the number of species in each mode, the names + of the species in each mode, and the types of the species in each mode. + The original file, modal_optics_3mode.nc, was updated and renamed + modal_optics_3mode_c100507.nc. + +. The following files have the "density" variables updated to match the + hardcoded values in the trop_mam3 code. + + bcpho_rrtmg_c090310.nc --> bcpho_rrtmg_c100508.nc + ocpho_rrtmg_c100528.nc --> ocpho_rrtmg_c101112.nc + ocphi_rrtmg_c080918.nc --> ocphi_rrtmg_c100508.nc + ssam_rrtmg_c080918.nc --> ssam_rrtmg_c100508.nc + +. A new file was constructed that contains the refractive index data for + water. The file was created by extracting the data from + ocpho_rrtmg_c080918.nc. It's named water_refindex_rrtmg_c080910.nc + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add all 3-mode species to the rad_climate specifier + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update the modal_optics file +. update the physprop files +. change modal_optics to modal_optics_file and change the attribute from + chem to aero which is set in build-namelist depending on whether 3mode or + 7mode aerosols are used. But it's no longer dependent on particular + chemistry scenarios in anticipation of a prescribed modal aerosol + capability. +. add water_refindex_file + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add water_refindex_file +. change modal_optics to modal_optics_file and move out of rad_cnst_nl and + into modal_aer_opt_nl. + +models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +. use rad_constituents interface to set specdens_amode +. update the rad_cnst_get_aer_props interfaces to get complex refractive + index and copy to local storage + +models/atm/cam/src/control/filenames.F90 +. remove modal_optics + +models/atm/cam/src/control/runtime_opts.F90 +. remove modal_optics +. add call to modal_aer_opt_readnl + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. rename aer_rad_props_get_clim_{sw,lw} to aer_rad_props_{sw,lw} +. remove loop over sw bands around call to modal_aero_sw +. move the call to modal_size_parameters inside modal_aero_sw. + +models/atm/cam/src/physics/cam/modal_aer_opt.F90 +. remove unused AEROCOM declarations +. remove calc_optics option - currently hardcoded to not operate +. remove miefit, fitcurv, fitcurvlin, chebft, write_modal_optics +. remove BACKSCAT which was only used for mie calcs +. remove "use mpishorthand" -- not referenced +. remove module variables nrefr, nrefi -- they're not used as variables, so + just use the parameters prefr, prefi +. move the loop over sw bands inside modal_aero_sw +. move the call to modal_size_parameters inside modal_aero_sw. +. modal_aero_sw + - change args to match aer_rad_props_sw (except diagnostic capability not + implemented yet) + - pull some initializations outside the loop over sw bands + - switch the order of the outer level and mode do loops putting the mode + loop on the outside. This causes roundoff diffs in AODABS, AODVIS, + SSAVIS. These are diagnostic fields that are summed over both level + and mode, so interchanging that sum introduces a roundoff difference. + - move the initializations of the diagnostic output outside the sw loop. + Need to put the burden calc inside a savaervis conditional. + - move the mode loop outside the sw band loop. The diagnostic output + moves outside all the loops since the arrays used for output are only + set for the visible band. + - replace direct use of state%q by call to rad_cnst_get_aermmr in the + aerosol species loop + - refactor dust aod diagnostic to look for xname_spectype='dust' + - remove the else clause in the computation of the dustaodmode + calculation. This is a bug. The calc is accumulating contributions to + dustaodmode inside a loop over levels. Setting the whole result to + zero upon encountering a layer with wetvol<=1.e-40 is zeroing the + entire accumulation over levels to that point rather than just zeroing + the contribution from that level. + - use rad_cnst_get_aer_props to get species densities +. modal_aero_lw:: + - change args to match aer_rad_props_lw (except diagnostic capability not + implemented yet) + - repeat the same refactoring that was done in modal_aero_sw to reorder + loops and obtain the species mmr, density, and refractive index from + the rad_constituent interfaces. +. read_modal_optics + - modes arg removed. Will instead set module variable ntot_amode with + the number of modes. + - remove all args that are just being used to set module data, and + instead set it directly. + - read new variables that contain the number of species in each mode, and + the species names and types from optics file. + - move sigma_logr_aer from local to module data so that it can be used + instead of modal_aero_data::sigmag_amode +. add subroutine modal_aer_opt_readnl to read modal_optics_file and + water_refindex_file. +. add new subroutine read_water_refindex and use it to set the module data + for complex water refractive index +. remove the call to rad_cnst_get_clim_aer_prop to access water refractive + index data +. remove unused wavelength band arguments from modal_aer_opt_init +. access species refractive index via rad_cnst_get_aer_props +. add alnsg_amode as module data that is set using the sigma_logr_aer field + read from the modal optics file, rather than being set from the hardcoded + values of sigmag_amode in modal_aero_data +. allocate/deallocate arrays with sizes that depend on the number of modes. +. remove ifdef MODAL_AERO -- the code is now independent of prognostic MAM + +models/atm/cam/src/physics/cam/phys_prop.F90 +. remove reading of water refractive index. +. refindex_aer_init - get rid of the ifdef MODAL_AERO by adding checks that + the refindex variables are present in the file before trying to read + them. Only allocate space if the variable is present. +. supply the complex version of the refractive index data directly rather + than as real and imaginary parts. + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. implement generic rad_cnst_get_aer_mmr +. implement generic rad_cnst_get_props +. remove optional args that provide water refindex via the + rad_cnst_get_aer_props interfaces. +. update the rad_cnst_get_aer_props interfaces to pass complex refractive + index + +models/atm/cam/src/physics/cam/radiation.F90 +. rename aer_rad_props_get_clim_{sw,lw} to aer_rad_props_{sw,lw} + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. rename aer_rad_props_get_clim_{sw,lw} to aer_rad_props_{sw,lw} +. remove wavelength band args from call to modal_aer_opt_init + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Fri Nov 12 13:02:18 MST 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Fri Nov 12 13:29:39 MST 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Fri Nov 12 14:12:22 MST 2010 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Fri Nov 12 14:32:34 MST 2010 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Fri Nov 12 15:22:29 MST 2010 +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Fri Nov 12 18:31:10 MST 2010 + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Nov 12 13:01:04 MST 2010 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Nov 12 13:45:01 MST 2010 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Nov 12 14:30:07 MST 2010 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Nov 12 15:43:19 MST 2010 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Fri Nov 12 16:28:54 MST 2010 + +edinburgh/pgi: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Fri Nov 12 11:41:25 MST 2010 +009 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Fri Nov 12 11:51:29 MST 2010 +015 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Fri Nov 12 12:02:37 MST 2010 +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Fri Nov 12 12:19:57 MST 2010 +030 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Fri Nov 12 12:33:58 MST 2010 + +The baseline failures are all due to roundoff diffs introduced into the +diagnostic fields AODABS, AODVIS, and SSAVIS. + +sm731 is a pre-existing failure. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except roundoff changes in some + diagnostic fields for trop_mam3. + +=============================================================== +=============================================================== + +Tag name: cam5_0_26 +Originator(s): jet +Date: Wed Nov 03 2010 +One-line Summary:Fix bug with new dynamics namelists,update external tags for high res support and Flow control + +Purpose of changes: There was a group name error for the spectral namelists that prevented user modifications of the dynamics variables via the namelist. Support for high resolution + +Bugs fixed (include bugzilla ID):Fixed namelist bug created during last commit. + +Describe any changes made to build system:Updated SVN_EXTERNALS to reflect new tags for high res support in the externals. Also brought remaining externals up to beta 10. + +Describe any changes made to the namelist:Updated namelist defaults for high res support. + +List any changes to the defaults for the boundary datasets:Added default datasets for high res. + +Describe any substantial timing or memory changes: + +Code reviewed by:jet + +List all subroutines eliminated: + +List all subroutines added and what they do: + + Added a diagnostic test that checks that a variable in the + spectral namelist can be successfully changed. + + A models/atm/cam/test/system/TDD.sh + +List all existing files that have been modified, and describe the changes: + + + new diagnostic test that checks that a variable in the spectral + namelist can be successfully changed. + + M models/atm/cam/test/system/input_tests_master + M models/atm/cam/test/system/tests_pretag_edinburgh + M models/atm/cam/test/system/nl_files/ttrac + + *********************** + + additional support for high res models - default tuning parameters added + M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + + *********************** + + Fixed bug with new dynamics namelist reads + + M models/atm/cam/src/dynamics/sld/sld_control_mod.F90 + M models/atm/cam/src/dynamics/eul/eul_control_mod.F90 + + *********************** + + Updated externals to a minimum of ccsm beta10 or the + latest tags with updates for add high res support + + M SVN_EXTERNAL_DIRECTORIES + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ....FAIL! +011 bl137 TBL.sh e48c5h outfrq24h 2d ............FAIL! +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s .....FAIL! +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s .....FAIL! +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s ..........FAIL! +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ............FAIL! +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s ...........FAIL! + + Failure for test 4 was expected. I added a new test of + the dynamics namelist to a pre-existing test. Because + of the namelist bug a new dynamics variable was not + updated correctly in the previous tag. In the new tag + the changed namelist variable is used and produces different + answers + + The rest of the failures were expected due to an update to the + external libraries. The only field that failed the bfb tests + was U10 which was added to the trunk by updating the externals + to ccsm_beta10. + +edinburgh/lf95: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .............FAIL! +009 bl112 TBL.sh e8c5dm ghgrmp 9s ...............FAIL! +015 bl114 TBL.sh e8c5dm co2rmp 9s ...............FAIL! +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ............FAIL! +030 bl312 TBL.sh f10c5dm ghgrmp 9s ..............FAIL! +035 bl314 TBL.sh wg10c4dm outfrq3s 9s ...........FAIL! +038 bl315 TBL.sh f10c3dm outfrq3s 9s ............FAIL! +043 bl318 TBL.sh f10c4cdm outfrq3s 9s ...........FAIL! + +All expected as explained above. + + +edinburgh/pgi or jaguar/pgi: + +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .............FAIL! +009 bl112 TBL.sh e8c5dm ghgrmp 9s ...............FAIL! +015 bl114 TBL.sh e8c5dm co2rmp 9s ...............FAIL! +022 bl311 TBL.sh f10c5t5mdm ttrac 9s ............FAIL! +030 bl312 TBL.sh f10c5dm ghgrmp 9s ..............FAIL! +035 bl314 TBL.sh wg10c4dm outfrq3s 9s ...........FAIL! +038 bl315 TBL.sh f10c3dm outfrq3s 9s ............FAIL! +043 bl318 TBL.sh f10c4cdm outfrq3s 9s ...........FAIL! + +All expected as explained above. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + BFB with the exception of diagnostic field U10 + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_25 +Originator(s): jet +Date: Fri Oct 29 2010 +One-line Summary:clean up dynamics, add eulerian subcycling, support for t341 + +Purpose of changes:Commit of code modifications from Kate Evans, + Mark Taylor and Pat Worley. These modifications add support + running the T341 eulerian model. Mark Taylor's mods to allow + eulerian subcycling were also added to correct an instability in + the cloud/convection parameterization at higher resolutions. + As part of merging Mark Taylor's mods in correctly some clean + up of the dynamics routines was required. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system:Kate Evan's added support for + T341 resolutions + +Describe any changes made to the namelist:Moved dynamic specific variables + out of the cam_inparm namelist into a dynamics namelist. Also + split the spmd and dynamics variables into separate namelists. + +List any changes to the defaults for the boundary datasets: Added boundary datasets for t341 support. + +Describe any substantial timing or memory changes: + +Code reviewed by:jet,eaton + +List all subroutines eliminated: + + D models/atm/cam/src/control/decompinit.F90 + D models/atm/cam/src/control/fv_control_mod.F90 + D models/atm/cam/src/physics/cam/spmd_phys.F90 + + +List all subroutines added and what they do: + + models/atm/cam/src/dynamics/fv/fv_control_mod.F90 + + runtime opts was cleaned up, moving the dynamics namelist + initializations into their own init routines under dynamics. + After this was done fv_control_mod was moved into the fv dynamics + directory. + + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam/bld/config_files/horiz_grid.xml + M models/atm/cam/bld/build-namelist + M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + M models/atm/cam/bld/namelist_files/namelist_definition.xml + M models/atm/cam/doc/ChangeLog + M models/atm/cam/src/control/readinitial.F90 + M models/atm/cam/src/control/runtime_opts.F90 + M models/atm/cam/src/control/cam_control_mod.F90 + M models/atm/cam/src/control/startup_initialconds.F90 + M models/atm/cam/src/control/cam_restart.F90 + M models/atm/cam/src/utils/spmd_utils.F90 + M models/atm/cam/src/physics/cam/phys_grid.F90 + M models/atm/cam/src/dynamics/sld/spegrd.F90 + M models/atm/cam/src/dynamics/sld/dyn_comp.F90 + M models/atm/cam/src/dynamics/sld/hordif.F90 + M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 + M models/atm/cam/src/dynamics/sld/hdinti.F90 + M models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 + M models/atm/cam/src/dynamics/eul/inital.F90 + M models/atm/cam/src/dynamics/eul/iop.F90 + M models/atm/cam/src/dynamics/eul/dyn.F90 + M models/atm/cam/src/dynamics/eul/grcalc.F90 + M models/atm/cam/src/dynamics/eul/dynpkg.F90 + M models/atm/cam/src/dynamics/eul/stepon.F90 + M models/atm/cam/src/dynamics/eul/courlim.F90 + M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 + M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + M models/atm/cam/src/dynamics/fv/dyn_comp.F90 + M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + M models/atm/cam/src/dynamics/fv/inital.F90 + M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +edinburgh/lf95: + +edinburgh/pgi or jaguar/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_24 +Originator(s): dfeddema +Date: Mon Oct 25 2010 +One-line Summary: CAM cleanup for code which stores and retrieves pbuf indices. These changes 1) save pbuf index as local module data when pbuf_add is called 2) move pbuf_get_fld_idx calls from run routines to init routines. + +Purpose of changes: readability, consistency and performance + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +[...]/models/atm/cam/src/physics/rrtmg/slingo.F90 +[...]/models/atm/cam/src/physics/rrtmg/radiation.F90 +[...]/models/atm/cam/src/physics/rrtmg/oldcloud.F90 +[...]/models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +[...]/models/atm/cam/src/physics/cam/zm_conv_intr.F90 +[...]/models/atm/cam/src/physics/cam/vertical_diffusion.F90 +[...]/models/atm/cam/src/physics/cam/stratiform.F90 +[...]/models/atm/cam/src/physics/cam/sslt_rebin.F90 +[...]/models/atm/cam/src/physics/cam/radiation.F90 +[...]/models/atm/cam/src/physics/cam/physpkg.F90 +[...]/models/atm/cam/src/physics/cam/param_cldoptics.F90 +[...]/models/atm/cam/src/physics/cam/convect_shallow.F90 +[...]/models/atm/cam/src/physics/cam/convect_deep.F90 +[...]/models/atm/cam/src/physics/cam/cloud_fraction.F90 +[...]/models/atm/cam/src/physics/cam/check_energy.F90 +[...]/models/atm/cam/src/physics/cam/cam_diagnostics.F90 +[...]/models/atm/cam/src/physics/cam/mo_gas_phase_chemdr.F90 +[...]/models/atm/cam/src/chemistry/mozart/iondrag.F90 +[...]/models/atm/cam/src/chemistry/mozart/chemistry.F90 +[...]/models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Sun Oct 24 14:54:04 MDT 2010 +- sm731 failure is pre-existing + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_23 +Originator(s): mvr,mvertens +Date: Thu Oct 21 2010 +One-line Summary: mods for processing u10 (10m wind speed) which is now +being received from drv code; externals updated for new drv, cice and pio tags + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/control/camsrfexch_types.F90 +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +- mods for processing u10 now being received from the driver + +M models/atm/cam/src/utils/cam_csim4/cpl_mct/ice_comp_mct.F90 +- removed references to variable sicthk + +M SVN_EXTERNAL_DIRECTORIES + M . +- externals updated for new drv, cice and pio tags + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Wed Oct 20 22:26:59 MDT 2010 +- sm731 failure is pre-existing + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_22 +Originator(s): mvr,hannay +Date: Wed Oct 13 2010 +One-line Summary: corrected the default settings for condensate- +to-rain autoconversion coefficients for cam5 configurations + +Purpose of changes: +cam5 runs (other than those at 1.9x2.5) were using values meant +for cam4 configurations + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- new default values for condensate-to-rain autoconversion coefficients + at cam5 configurations + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Oct 12 20:51:50 MDT 2010 +013 bl330 TBL.sh f4c5pdh aqpgro 3s ........................................FAIL! rc= 7 at Tue Oct 12 20:59:06 MDT 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Oct 12 21:18:23 MDT 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Oct 12 21:56:41 MDT 2010 +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Wed Oct 13 00:34:44 MDT 2010 +- sm731 failure is pre-existing +- baseline failures were expected at cam5 configurations (other than 1.9x2.5) with changes to tuning parameters + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Oct 12 17:01:21 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Oct 12 17:44:55 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 7 at Tue Oct 12 18:19:12 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Oct 12 18:25:07 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Oct 12 19:33:09 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Tue Oct 12 20:16:18 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 7 at Tue Oct 12 20:41:53 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 7 at Tue Oct 12 21:47:57 MDT 2010 +- baseline failures were expected at cam5 configurations (other than 1.9x2.5) with changes to tuning parameters + +edinburgh/pgi: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Tue Oct 12 16:28:44 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Tue Oct 12 16:37:59 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 7 at Tue Oct 12 16:45:03 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Tue Oct 12 16:47:05 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Tue Oct 12 17:03:29 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Tue Oct 12 17:15:03 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 7 at Tue Oct 12 17:22:05 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 7 at Tue Oct 12 17:35:58 MDT 2010 +- baseline failures were expected at cam5 configurations (other than 1.9x2.5) with changes to tuning parameters + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, except for cam5 configurations other than 1.9x2.5 + +=============================================================== +=============================================================== + +Tag name: cam5_0_21 +Originator(s): mvr +Date: Tue Oct 12 2010 +One-line Summary: new tuning mods added as defaults for T31; mods to +test scripts to reflect changes in the cice decomposition formulation + +Purpose of changes: +T31 tuning mods... +cldfrc_rhminh = 0.50 +cldwat_icritc = 1.e-6 +cldwat_r3lcrit = 1.e-6 (and moved into a namelist variable) +do_tms = true +tms_orocnst = 1.0 +tms_z0fac = 0.1 (and moved into a namelist variable) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- new tuning mods added as defaults for T31 + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCB.sh +- mods to utilize fixes made to cice decomp script + +M models/atm/cam/test/system/CAM_decomp.sh +- bug fix to test script for properly altering task count for hybrid tests + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh +- test scripts now utilize new nl option for cice distribution type, roundrobin + +M models/atm/cam/test/system/test_driver.sh +- bluefire testing returned to use all 64procs of node with fixes to cice decomp + +M models/atm/cam/bld/build-namelist +- cleaned up handling of tms variables, added code for new namelist parameters + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- added default values for T31 (see description above) + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- added entries for new namelist variables + +M models/atm/cam/src/physics/cam/trb_mtn_stress.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +- changes to reflect new handling of tms namelist variables + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated to new cice tag with fixes to its decomposition formulation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Tue Oct 12 08:48:07 MDT 2010 +006 bl133 TBL.sh e48c4pdm aqpgro 3s .......................................FAIL! rc= 7 at Tue Oct 12 08:48:08 MDT 2010 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Oct 12 08:48:15 MDT 2010 +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Tue Oct 12 08:50:49 MDT 2010 +- sm731 failure is pre-existing +- baseline failures were expected at T31 with changes to tuning parameters + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, except at T31 + +=============================================================== +=============================================================== + +Tag name: cam5_0_20 +Originator(s): jet +Date: Mon Oct 4, 2010 +One-line Summary: Updated SVN_EXTERNALS to include workaround for intel compile bug when compiling shr_scam_mod. + +Purpose of changes: Updated SVN_EXTERNALS to include workaround for intel compile bug when compiling shr_scam_mod. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by:jet,tcraig + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/chemistry/mozart/tgcm_forcing.F90 +M SVN_EXTERNAL_DIRECTORIES + + tgcm_forcing had what looked to be debug io that was + incompatible with single column mode. For now that write + statement was commented out. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Thu Sep 30 11:50:18 MDT 2010 + + Expected failure from previous tags. + + +edinburgh/lf95: BFB scam runs completed on tramhill with lf95 + +edinburgh/pgi or jaguar/pgi: BFB scam runs completed on tramhill with pfg90 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? bfb + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_19 +Originator(s): mvr,eaton +Date: Thr Sep 30 2010 +One-line Summary: update component externals to those of cesm1_0_beta08; +corrected ghg dataset for cam5 use_case; added default ic file for 0.5deg cam5 + + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- new default initial conditions file for 0.5deg cam5 + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- added listing for default initial conditions file at 0.5deg cam5 + +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +- corrected the ghg dataset being used + +M SVN_EXTERNAL_DIRECTORIES + M . +- new external definitions for drv, clm, cice, csm_share and scripts + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Thu Sep 30 11:50:18 MDT 2010 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Thu Sep 30 14:15:47 MDT 2010 +- sm731 failure is pre-existing +- bl375 baseline comparison was expected to fail due to the change made to the ghg dataset used + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_18 +Originator(s): pworley, jedwards, eaton +Date: Sat Sep 25 11:20:58 MDT 2010 +One-line Summary: Mods for COSP; phys_grid column pair fix + +Purpose of changes: + +. Changes were made to configure and to the COSP source tree to enable the + build of COSP from the CESM scripts as part of the atm library (the + standalone CAM build builds COSP as a separate library). + +. The COSP interface module was incurring an unnecessary memory overhead + when the COSP simulator was not being used. This has been remedied + (fixes from Jim Edwards). + +. Modify configure to remove restrictions against building for spmd or smp + modes with Darwin OS. + +Bugs fixed (include bugzilla ID): + +. Fix to column pairing algorithm in phys_grid. From Pat Worley: + > The error does not break the + > code, it just erroneously disables the wrap map of the columns as + > well as the column pairing. This essentially disables all load + > balancing when the namelist parameter phys_twin_algorithm == 0 or + > when using HOMME and not setting phys_twin_algorithm = 1. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. Replace static allocation of atrain arrays in the COSP interface by + dynamic allocation to remove the overhead when COSP isn't being used. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. update cosp to cosp_v1_3_100924 + +models/atm/cam/bld/configure +. only write cosp Makefile if doing a cam standalone build +. modify the write_filepath_ccsm method to include the cosp filepaths if + running with cosp enabled +. remove checks that disallow darwin builds with SPMD or SMP + +models/atm/cam/src/physics/cam/cospsimulator_intr.F90: +. mpibcast of cosp_histfile_num, atrainday, atrainhr, atrainmin, atrainsec + had wrong type +. change large atrain orbit data arrays from static to allocatable + +models/atm/cam/src/physics/cam/phys_grid.F90 +. fix for twin algorithm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Fri Sep 24 23:36:01 MDT 2010 + +sm731 failure is pre-existing + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_17 +Originator(s): mvr,jek,eaton, pworley, bardeenc +Date: 16 Sep 2010 +One-line Summary: update/fixes made to COSP code; add a test to test_driver +for exercising COSP; Supply a missing initialization in the reproducible sum code + +Purpose of changes: +1) additional logic so that cosp outputs that require both radar and +lidar simulator are saved only when both simulators are run +2) double counting of the convective cloud water in cosp inputs. this +required defining some new variables for the stratiform cloud water +within cospsimulator_intr.F90. +3) Pressures and heights not defined correctly in cosp inputs. +Yuying: "Based on TYPE COSP_GRIDBOX (line 282-286) in cosp_types.F90, +zlev & p are height and pressure at model levels, +and zlev_half & ph are values at bottom (interface) of model layer. +The definition in cospsimulator_intr.F90 (line 1581-1584) shows that +gbx%p & gbx%zlev are interface values while +gbx%ph & gbx%zlev_half are at model levels." +4) convection *_flxprc are for rain+snow while stratiform *_flxprc was +for rain only. I am changing ls_flxprc so that it includes +both rain and snow in cldwat.F90, ~ line 946, rkflx = precab instead of +rkflx = precab - snowab. It is confusing to have things labeled +*_flxprc when some include rain and others include rain+snow. I also +made name mods in stratiform.F90. I modified cospsimulator.F90 +accordingly -- see lines 1447 - 1469. +5) Jim wanted a namelist variable so that you can specify which CAM +history tape COSP outputs are written to +I used Jerry's mods for history_budget_histfile_num as a template. +I added cosp_histfile_num as a namelist variable by making mods to both +namelist_definition.xml and to cospsimulator_intr.F90. +6) circa line 4288, dimension name wrong -- +"dimen4a(3)=cosp_prstau_modis_dim" should be +"dimen4m(3)=cosp_prstau_modis_dim" +7) for cfad_sr532_cal. nbze_cosp = nsr_cosp = 15. this leads to if +statement problems because cam_history.F90 only checks flags and +dimensions sizes. i set the flag_**dbze** = .false when flag_cosphtsrlev += .true circa line 1281 +8) similar problem for fisccp1_cosp and isccp simulator flags. fix circa +line 1293 + + +Bugs fixed (include bugzilla ID): + +. fix for missing initializer in repro_sum_mod module (from Chuck Bardeen + and Pat Worley) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f10c4cdm +- new configuration options test file for testing of cosp + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_edinburgh +- added new cosp test to default set of required pretag tests on edinburgh + +M models/atm/cam/test/system/TER.sh +- modified the exact restart test to not change number of tasks/threads upon + restart for any test running cosp + +M models/atm/cam/test/system/input_tests_master +- added definition of new cosp tests to master list + +M models/atm/cam/test/system/CAM_runcmnd.sh +- change to test scripts to set run command on edinburgh while accounting for + potential tests of both mpi-only or hybrid + +M models/atm/cam/src/utils/repro_sum_mod.F90 +- Supply a missing initialization in the reproducible sum code. The code + was not producing wrong answers, but could possibly produce a runtime + failure due to a bad argument (fix from Bardeen, Worley). + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +- cosp changes (see description above) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Thu Sep 16 00:23:05 MDT 2010 +- existing failure + +edinburgh/lf95: +042 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 5 at Wed Sep 15 19:38:59 MDT 2010 +- new test failed because it is not defined in baseline code + +edinburgh/pgi: +042 bl318 TBL.sh f10c4cdm outfrq3s 9s .....................................FAIL! rc= 5 at Wed Sep 15 16:13:34 MDT 2010 +- new test failed because it is not defined in baseline code + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_16 +Originator(s): Francis Vitt +Date: 15 Sep 2010 +One-line Summary: Added capability to overwrite the cam surface GHG +values with data from waccm lower boundary file. + +Purpose of changes: + +This makes the co2vmr value used in the WACCM nlte_fomichev module +consistent with the value in the WACCM lower boundary file. This +capability has been extended to non WACCM configurations so that +a WACCM LBC file can be used set the CAM GHG surface values. + +Also included is a change in the age-of-air tracers to use values +from the initial conditions file as initial values. To override +this default behavior set aoa_read_from_ic_file namelist variable +to false. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/mozart/mo_flbc.F90 +D models/atm/cam/src/chemistry/mozart/m_types.F90 + - files moved to the models/atm/cam/src/chemistry/utils directory so + that they are available in non-chemistry configurations + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/utils/mo_flbc.F90 +A models/atm/cam/src/chemistry/utils/m_types.F90 + - files moved from the models/atm/cam/src/chemistry/mozart/ directory + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist + - if a LBC file is defined then do not set default settings for + bndtvghg, co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - aoa_read_from_ic_file defaults to TRUE + - more explanation is added to ext_frc_specifier namelist description + - flbc_* namelist variables have been moved to "chem_srfvals_nl" namelist + +M models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml + - removed the co2vmr setting since this is now set by the LBC file + +M models/atm/cam/src/physics/cam/phys_gmean.F90 + - added a subroutine to compute global mean of a single field + +M models/atm/cam/src/physics/cam/chem_surfvals.F90 + - changes to read flbc_* namelist variables + - changes to overwrite the GHG surface values with global means from + the mo_flbc module + +M models/atm/cam/src/physics/cam/aoa_tracers.F90 + - changes the default ICs to be set from the CAM initial conditions file + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - set initial value of list_cycled to .false. + - if data path is empty do not append "/filename" to it + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - changes needed to make mo_flbc available to non-chemistry configurations + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Wed Sep 15 10:13:08 MDT 2010 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Sep 15 10:13:48 MDT 2010 +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Wed Sep 15 10:45:34 MDT 2010 +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Wed Sep 15 10:46:35 MDT 2010 + +The WACCM baseline tests bl336 and bl379 failures are due to the change in the co2vmr +surface value used in the nlte_fomichev module and the change in initial conditions +of the age-of-air tracers + +The trop_mozart baseline test bl379 failure is due to the change in GHG values used in +the radiation which are now based on the chemistry lower conditions file + +Test sm731 failure is pre-existing + +edinburgh/lf95: + +034 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Sep 13 17:51:19 MDT 2010 + +This failure is due to the change in initial conditions of the age-of-air tracers + +edinburgh/pgi: + +034 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 7 at Mon Sep 13 15:09:27 MDT 2010 + +This failure is due to the change in initial conditions of the age-of-air tracers + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_15 +Originator(s): mirin, eaton +Date: Wed Sep 8 11:46:04 MDT 2010 +One-line Summary: Fix for FV div4 filter; refactor pertlim code; rcp6.0 update + +Purpose of changes: + +. Fixes to indices for ghost regions in FV div4 filter (from Art Mirin). + +. Refactor the application of a perturbation to the initial T field so that + it is distributed. Previously the 3D T field was read to the master + task and then scattered after the perturbation was applied. + +. Modify the rcp6.0 use case to use the datm version of the prescribed + aerosol deposition fluxes. + +Bugs fixed (include bugzilla ID): + +. The results of the FV dycore with the div4 filtering on (only on by + default for 1/2 deg and higher resolution) where found to depend on the + decomposition. The fixes to ghost region indexing has resolved this. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. change aerosol deposition dataset in use case 2005-2100_cam4_rcp60 + +Describe any substantial timing or memory changes: + +. The change to how an initial temperature perturbation is applied + substantially reduces memory requirements (eliminating the need for a + global 3D field) so that perturbation growth tests may be done at higher + resolutions. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +. modify aerodep_flx_file to use the datm dataset. + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. remove debug write to all procs + +models/atm/cam/src/dynamics/fv/inidat.F90 +. remove reading 3D T field to masterproc and scattering when pertlim is + specified. +. add code that uses the global column number to seed the random number + generator. This makes setting the perturbation independent of + decomposition. + +models/atm/cam/src/dynamics/fv/dynamics_vars.F90 +models/atm/cam/src/dynamics/fv/sw_core.F90 +. Fixes for indices in ghost regions of FV div4 filter. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Tue Sep 7 21:14:08 MDT 2010 + +sm731 failure is pre-existing. + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except FV run that use the div4 + filter produces larger than roundoff diffs. This filter is the default + for 1/2 deg and higher resolutions. + +=============================================================== +=============================================================== + +Tag name: cam5_0_14 +Originator(s): mvr +Date: Wed Sep 01 +One-line Summary: use_cases added for waccm, rcp6.0; test added to default test +suite; removed reference to shr_date_mod; updated externals to cesm1_0_beta07 + +Purpose of changes: +- a test was added to the test suite to ensure a run of stand-alone-cam vs + an "F" case via the ccsm scripts was b4b + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/test/system/nl_files/fcase +A models/atm/cam/test/system/nl_files/user_nl_cam +-new test files required for new "stand-alone-cam vs fcase" test + +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp60.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_2005-2100_cam4_rcp45.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1955-2005_cam4.xml +-new use_cases added + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/tests_posttag_jaguar_cb +M models/atm/cam/test/system/tests_posttag_jaguar +M models/atm/cam/test/system/input_tests_master +-added new "stand-alone-cam vs fcase" test to master and default test lists + +M models/atm/cam/test/system/TCB_ccsm.sh +-configure-time mods needed for new "stand-alone-cam vs fcase" test + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TEQ_ccsm.sh +M models/atm/cam/test/system/TEQ.sh +-correction to output messages of test scripts + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/TER_ccsm.sh +M models/atm/cam/test/system/TSM_ccsm.sh +-mods to enable testing of ccsm scripts via cam test suite on jaguar + +M models/atm/cam/src/physics/cam/tidal_diag.F90 +-removed the usage of the module shr_date_mod + +M SVN_EXTERNAL_DIRECTORIES + M . +-updated external definitions for drv, csm_share and scripts to represent those +of beta07 as closely as possible + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +007 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Tue Aug 31 17:14:51 MDT 2010 +016 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Tue Aug 31 17:15:06 MDT 2010 +-bl992 failure is due to change in the setting for co2_ppmv +-sm731 failure is pre-existing + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + + +=============================================================== +=============================================================== + +Tag name: cam5_0_13 +Originator(s): eaton +Date: Fri Aug 20 12:37:04 MDT 2010 +One-line Summary: fix HOMME for repro_sum change; mods to high-res FV config; logfile output; COSP updates + +Purpose of changes: + +. Fix HOMME dycore to supply the new "commid" argument in the repro_sum + calls. + +. Changes to FV filtering default for high resolution grids (1/2 deg and + finer). + +. Modify logfile output to include lists of all history fields in the + master and the active lists, including long_name. + +. Remove the echo of the GHG and Solar forcing data to the IC file (it's + still in the history files). It's never read from the IC file, so it's + confusing to have it there. + +. Modify waccm_2000_cam4 use case with updated IC files. + +. Makefile updates for the BGP and the Linux/Intel builds. + +. Updates to COSP simulator code: + - fix mpi bug + - output cosp coordinate values in variables rather than as attributes + - output cosp coordinate bounds in CF compliant variables rather than as + attributes + - mods to save COSP CFMIP outputs with different frequencies on separate + history files. + +. Modify pretag tests for HOMME on bluefire + +Bugs fixed (include bugzilla ID): + +. fix mpi bug in cospsimulator (missing mpibcast call for namelist vars) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/test/system/config_files/h16c4aqdm +. new config: homme, ne16np4, cam4, aquaplanet, debug, pure mpi + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. update cosp externals to cosp_v1_3_100813 + +models/atm/cam/bld/Makefile.in +. add an include path for the BGP build +. add special rules to the ifort section for compiling 2 rrtmg modules + and shr_scam_mod.F90 without optimization + +models/atm/cam/bld/build-namelist +. remove the manual setting of the ape attribute (comes automatically from + the cache file now that setting -ocn aquaplanet is a build time setting) +. add default for filtcw (since it now depends on resolution) + +models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +. update initial files + +models/atm/cam/bld/configure +. remove unused -notest option + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. make div24del2flag=42 the default for 1/2 deg and finer FV grids +. make filtcw=1 the default for 1/4 deg and finer FV grids +. replace the attribute ape="1" by ocn="aquaplanet" which comes + automatically from the config_cache.xml file + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. fix documentation of fft_flt +. prepend "cosp_" to all cosp namelist variables + +models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +. update IC files + +models/atm/cam/src/control/cam_history.F90 +. modify output for master and active field lists +. mods to remove GHG/Solar forcing data from IC file. +. mods to cosp vertical coordinates for CF conformance + +models/atm/cam/src/control/camsrfexch_types.F90 +. fix comment on snowhice to indicate that it is actual snow height, not + the liquid water equivalent. + +models/atm/cam/src/control/runtime_opts.F90 +. add comment about physconst_readnl + +models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 +models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 +. supply the optional arg "commid" in the repro_sum calls (it's really only + optional if the correct communicator is MPI_COMM_WORLD). + +models/atm/cam/src/physics/cam/cosp_share.F90 +. add new 2D bounds variables for CF conforming output + +models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +. add missing mpibcast calls for namelist variables +. prepend "cosp_" to all cosp namelist variables +. modify output for CFMIP experiments + +models/atm/cam/test/system/config_files/h16c4aqdm +. homme, ne16np4, cam4, aquaplanet, debug, pure mpi + +models/atm/cam/test/input_tests_master +. add sm733, er733, bl733 to test h16c4aqdm, outfrq3s + +models/atm/cam/test/system/nl_files/aqpgro +models/atm/cam/test/system/nl_files/aqua +. remove the aqua_planet and aqua_planet_sst settings -- they are redundant + since aquaplanet is now a build time setting. + +models/atm/cam/test/tests_pretag_bluefire +. add sm733, er733, bl733 +. remove er731, bl731 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +061 sm731 TSM.sh h16x4c3dh aqua 9s ........................................FAIL! rc= 8 at Thu Aug 19 20:44:26 MDT 2010 +064 bl733 TBL.sh h16c4aqdm outfrq3s 9s ....................................FAIL! rc= 5 at Thu Aug 19 20:44:27 MDT 2010 + +The failed test sm731 of HOMME in hybrid mode appears to be a system +problem. It is only when the executable is built with threads enabled that +the failure occurs. The error message points to the following location: + +Illegal instruction (privileged operation) in cam_history.__cam_history_NMOD__&&_cam_history.__cam_history_NMOD_h_define at line 3350 in file "/ptmp/eaton/src/cam5_0_12_trb/models/atm/cam/src/control/cam_history.F90" ($t1) + 3350 if(restart) then + +I'm guessing that the illegal instruction message is a result of the +variable "restart" being corrupted. This configuration runs successfully +under PGI on edinburgh. On bluefire the configuration runs successfully if +the debug flags are removed. It also runs successfully with debug in +serial and pure mpi modes. The code fails in a pure OMP mode in with an +identical error message as above. Running a debug/OMP executable in +totalview with memoryscape enabled is successful, apparently due to +totalview's control of memory management. When run in totalview without +memory tracing enabled the reported error is the same as above. The +reported error is not in a threaded code region. I added a pure mpi +version of the test so that HOMME would continue to be tested, and left +just the smoke test version of the debug/hybrid configuration that's +failing to keep this problem on the radar. + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + + +=============================================================== +=============================================================== + +Tag name: cam5_0_12 +Originator(s): jenkay, eaton +Date: Tue Aug 10 14:02:00 MDT 2010 +One-line Summary: Add COSP simulator. + +Purpose of changes: + +. add ability to produce diagnostic output from the COSP simulator as an + option. The option is enabled by adding the argument "-cosp" to the + configure commandline. + +. The Makefile.in template was refactored to facilitate passing the Fortran + compiler flags to a sub-Make. The COSP simulator is built as a separate + library because it needs to be compiled using autopromotion flags. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. add -cosp argument to configure to enable cosp simulator + +Describe any changes made to the namelist: + +. New variables for COSP simulator: + +docosp: +If true, the COSP cloud simulator is run. +COSP will not run unless this is set to .true. in the namelist! +Turn on the desired simulators using lXXX_sim namelist vars +If no specific simulators are specified, all of the simulators +are run on all columns and all output is saved. (useful for testing). +This option available with CAM4 physics only. +This default logical is set in cospsimulator_intr.F90. +Default: FALSE + +lradar_sim: +If true, COSP radar simulator will be run and all output +will be saved. +Default: FALSE + +llidar_sim: +If true, COSP lidar simulator will be run and all output +will be saved +Default: FALSE + +lisccp_sim: +If true, COSP ISCCP simulator will be run and all output +will be saved. ISCCP simulator is run on only daylight +columns. +Default: FALSE + +lmisr_sim: +If true, MISR simulator will be run and all output +will be saved. MISR simulator is run on only daylight +columns. +Default: FALSE + +lmodis_sim: +If true, MODIS simulator will be run and all output +will be saved. +Default: FALSE + +cfmip_3hr: +If true, the COSP cloud simulator is run for CFMIP 3-hourly +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + +cfmip_da: +If true, the COSP cloud simulator is run for CFMIP daily +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + +cfmip_off: +If true, the COSP cloud simulator is run for CFMIP off-line +monthly experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + +cfmip_mon: +If true, the COSP cloud simulator is run for CFMIP monthly +experiments. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + +ncolumns: +Number of subcolumns in SCOPS +This default logical is set in cospsimulator_intr.F90 +Default: 50 + +sample_atrain: +Turns on sampling along a-train orbit for radar and lidar simulators. +This default logical is set in cospsimulator_intr.F90 +Default: TRUE + +atrainorbitdata: +Path for the Atrain orbit data file provided by CFMIP. +There is no default for this, but sample_atrain = .true. will not work +if this namelist variable is undefined. +currently /project/cms/jenkay/SCAM/repository/cloudsat_orbit_08921_14250.nc +Default: no default set now, need to specify in namelist + +lfrac_out: +Turns on sub-column output from COSP. +If both the isccp/misr simulators and the lidar/radar simulators +are run, lfrac_out is from the isccp/misr simulators columns. +This default logical is set in cospsimulator_intr.F90 +Default: FALSE + + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. the simulator is not on by default +. performance and memory implications of the simulator in operation have + not been evaluated + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/cosp_share.F90 +models/atm/cam/src/physics/cam/cospsimulator_intr.F90 +. CAM specific interfaces to simulator code + +models/atm/cam/src/physics/cosp/* +models/atm/cam/src/physics/icarus-scops/* +. simulator code is linked in as an svn external + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. link cosp source via externals + +models/atm/cam/bld/Makefile.in +. add rules to build cosp library +. refactor how FFLAGS are set to facilitate passing the fortran compiler + flags to the sub-Make used to build cosp + +models/atm/cam/bld/build-namelist +. set docosp=.true. when CAM is built with the cosp simulator + +models/atm/cam/bld/config_files/definition.xml +models/atm/cam/bld/configure +. add -cosp argument to enable cosp simulator + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add namelist variables to control cosp simulator + +models/atm/cam/src/control/cam_history.F90 +. add output for cosp simulator -- the main issue is all the new level + dimensions and coordinate variables +. remove the call to check_accum from subroutine hbuf_accum_inst. This + subroutine checks that either all values in a column are fill values, or + none are. This breaks when the vertical dimension is actually a + collection of subcolumns (stacked on top of one another) some of which + contain fill values and others which don't. An assumption of the + accumulator for time averaging is that a column (the vertical dimension) + is all fill value or no fill value. These hybrid vertical dimensions + break that assumption. As a consequence they should only be output as + instantaneous fields. +. Don't call the h_normalize subroutine for instantaneous fields. For + fields with fill values it enforces the constraint that either all values + in the vertical dimension are the fill value, or none are. This is not + true for cosp output. It should be up to the diagnostic code to enforce + this constraint where it is appropriate, not the generic h_normalize + code. + +models/atm/cam/src/control/runtime_opts.F90 +. call cospsimulator_intr_readnl method + +models/atm/cam/src/physics/cam/cldwat.F90 +. add diagnostic fields needed by cosp simulator as intent(out) args + +models/atm/cam/src/physics/cam/radiation.F90 +. add calls to init and run the simulator + +models/atm/cam/src/physics/cam/convect_shallow.F90 +models/atm/cam/src/physics/cam/stratiform.F90 +models/atm/cam/src/physics/cam/zm_conv_intr.F90 +. add fields to physics buffer for driving cosp simulator + +models/atm/cam/src/utils/cam_pio_utils.F90 +. add flags for new level coordinates for cosp output + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_11 +Originator(s): Patrick Worley / Art Mirin +Date: Sun Aug 8 2010 +One-line Summary: FV memory optimization; repro_sum update; spmd_utils and mod_comm communication protocol updates. + +Purpose of changes: + +. significant decrease in memory requirements in FV mod_comm + layer (Mirin) + +. modification to implementation of handshaking communication + logic in spmd_utils and mod_comm to improve robustness. + Problems have not been observed with previous implementation, + and these changes are simply to avoid potential future problems. + +. modification to repro_sum logic, improving accuracy in extreme + cases, enabling bit-for-bit agreement whether using 4-byte or + 8-byte integers in implementation, and changing CPP token used + to determine which length integers to use + +. modification to repro_sum implementation to remove + dependencies in mpishorthand, spmd_utils, cam_iulog, + and abortutils, as first step to moving repro_sum_mod to + models/csm_share or models/utils (for use by other components) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +. Changed CPP token that forces use of 4-byte integers in repro_sum + algorithm from "BGP" to "noI8". + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +. significant decrease in FV memory requirements, no longer + allocating memory for undecomposed 3D field (only undecomposed + 2D field) when modcomm_gatscat /= 0 + +Code reviewed by: Worley + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +. removal of dependence on spmd_utils and cam_iulog required new + formal parameters for specifying log unit number and "masterproc" in + repro_sum_setopts routine +control/runtime_opts.F90 +utils/repro_sum_mod.F90 + +. removal of dependence on cam_iulog required new formal parameter + for specifying log unit number in repro_sum_tol_exceeded routine +utils/repro_sum_mod.F90 +dynamics/fv/d2a3dikj.F90 +dynamics/fv/fv_prints.F90 +dynamics/fv/mean_module.F90 +dynamics/fv/p_d_adjust.F90 +dynamics/fv/par_xsum.F90 +physics/cam/phys_gmean.F90 + +. removal of dependence on spmd_utils required addition of exisiting + optional commid parameter in calls to repro_sum +physics/cam/polar_avg.F90 + +. reimplementation of communication handshaking logic so that each + handshaking message is received into a different memory location + (rather than all going to/from the same location); also + add nonblocking handshaking message logic to mp_swaptrirr. +utils/pilgrim/mod_comm.F90 +utils/spmd_utils.F90 + +. new CCP token to indicate use of 4-byte integers instead of + 8-byte integers (original workaround for compiler bug on BG/P - + no longer necessary?): "noI8" replacing "BGP"; modified algorithm + termination logic so that get full accuracy and 4-byte integer + and 8-byte integers options now +utils/repro_sum_mod.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: none + +edinburgh/lf95: none + +edinburgh/pgi: none + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_0_10 + +Summarize any changes to answers: NONE + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_10 +Originator(s): Diane Feddema +Date: 4, Aug, 2010 +One-line Summary:Fixed CAM memory leak with work-around for xlf90 compiler bad code generation bug(IBM PMR 21571.003.000) + +Purpose of changes: Fixed memory leak in CAM by adding a work-around to CAM for a bad code generation bug in IBM's xlf90 comipler. + +Bugs fixed (include bugzilla ID): +. Fix memory leak in CAM caused by IBM xlf90 compiler error which does not free memory for an automatic array (which is the return value for an called function) before the calling function exits. The calling function is pbuf_get_fld_idx. When the calling function is exited memory for the automatic array is not freed - and is never freed. Diane submitted a failing testcase to IBM and they filed IBM internal bug report PMR 21571.003.000. + +. Fixed misplaced t_startf call in aircraft_emit.F90 which results in mismatched timer calls when aircraft_emit.F90 results in mismatched timer calls when aircraft emission code isn't active. (Also removed embedded space from teh event tag). +describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: memory leak fixed + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +./models/atm/cam/src/physics/cam/phys_buffer.F90 + +Modified routine pbuf_get_fld_idx so that it is case sensitive. This modication removes a check (call to to_upper from inside an if-block that contains a return statement within the if-block) that caused a memory leak, due to a bug in the IBM xlf90 compiler (see IBM bug report PMR 21571.003.000). + +./models/atm/cam/src/physics/cam/stratiform.F90 + +Made pbuf_get_fld_idx calls case sensitive by using arguments with the same case for field name that was used to create the pbuf entry. +ifld = pbuf_get_fld_idx('KVH') was changed to ifld = pbuf_get_fld_idx('kvh') +ifld = pbuf_get_fld_idx('TKE') was changed to ifld = pbuf_get_fld_idx('tke') +ifld = pbuf_get_fld_idx('TURBTYPE') was changed to ifld = pbuf_get_fld_idx('turbtype') +ifld = pbuf_get_fld_idx('SMAW') was changed to ifld = pbuf_get_fld_idx('smaw') + +./models/atm/cam/src/physics/cam/tphysac.F90 + +Made pbuf_get_fld_idx call case sensitive by using argument with the same case for field name that was used to create the pbuf entry. +ifld = pbuf_get_fld_idx('KVH') was chaned to ifld = pbuf_get_fld_idx('kvh') + + +If there were any failures reported from running test_driver.sh on any test + +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: none + +edinburgh/lf95: none + +edinburgh/pgi : none + +CAM tag used for the baseline comparison tests if different than previous +tag: cam5_0_09 + +Summarize any changes to answers, i.e., NONE +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_09 +Originator(s): Cheryl Craig and Jack Chen +Date: 27 July, 2010 +One-line Summary: Added the ability to read in FAA aircraft files + Added latitude weighted interpolation and conserve column capabilities + +Purpose of changes: To allow FAA aircraft data to be used in CESM + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: Created aircraft_emit_nl: contains aircraft_spcecifier and aircraft_type + aircraft_specifier contains a list of "aircraft species -> filename of file list for that species" + aircraft_type contains "CYCLICAL_LIST" which says the file list should be cycled + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Brian Eaton, Francis Vitt + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/utils/horizontal_interpolate.F90: NEW MODULE + ! This module computes and uses weighting functions to map a variable of (im1,jm1) resolution to (im2,jm2) resolution + ! weight_x(im2,im1) is the weighting function for zonal interpolation + ! weight_y(jm2,jm1) is the weighting function for meridional interpolation + models/atm/cam/src/chemistry/utils/tracer_data.F90 + - advance_file: Advances to the next file + - vert_interp_mixrat: performs vertical interpolation of mixing ratios + models/atm/cam/src/chemsitry/utils/aircraft_emit.F90: NEW MODULE + - aircraft_emit_register: adds the aircraft emission data to the physics buffer + - aircraft_emit_init: Initialize the aircraft emission data handling + - aircraft_emit_adv: Advance to the next aircraft data + - aircraft_emit_readnl: Reads the aircraft emission namelist + - function get-aircraft_ndx: returns the index of the aircraft data being requested + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - added aircraft_specifier and aircraft_type +M models/atm/cam/src/physics/cam/initindx.F90 + - added call to new routine aircraft_emit_register +M models/atm/cam/src/physics/cam/physpkg.F90 + - added call to new routine aircraft_emit_init +M models/atm/cam/src/physics/cam/advnce.F90 + - added call to new aircraft_emit_adv +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - added the following new basic functionalities + - stepTime: time can "step" (no interpolation is done in time) + - CYCLICAL_LIST: added capability of cycling of filelists + - weight_by_lat: if true, then performs interpolations weighted by lat + - conserve_column: if tue, then interpolations preserve the total column + - introduced new routine advance_file: Copy of section in check_files which is + now called in two places. +M models/atm/cam/src/control/runtime_opts.F90 + - added call to aircraft_emit_readnl + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: none + +calgary/lf95: + +calgary/pgi or jaguar/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: camdev_cam3_6_23_tags/camdev55_cam3_6_72 + +Summarize any changes to answers, i.e., NONE +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NONE + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_08 +Originator(s): Diane Feddema +Date: 26 Jul 2010 +One-line Summary: Renamed two derived types: surface_state became cam_out_t, srfflx_state became cam_in_t. + +Purpose of changes: To clarify the intended use of these derived types. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +models/atm/cam/src/control/camsrfexch_types.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/control/srfxfer.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/control/cam_restart.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/control/cam_comp.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/advnce.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/physics/cam/iop_surf.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/phys_debug.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/radiation.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/restart_physics.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/chemistry.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/flux_avg.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/physpkg.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/tphysbc.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/cam/tphysac.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/physics/rrtmg/radiation.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/chemistry/utils/aerodep_flx.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/chemistry/modal_aero/modal_aero_deposition.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/chemistry/mozart/chemistry.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/chemistry/mozart/spedata.F90 +comment line changed ("srfflx_state" was changed to "cam_in" in comment) + +models/atm/cam/src/dynamics/eul/stepon.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/dynamics/homme/stepon.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/dynamics/fv/metdata.F90 +derived type name "srfflx_state" was changed to "cam_in_t" + +models/atm/cam/src/dynamics/fv/stepon.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/dynamics/fv/fv_prints.F90 +derived type name "surface_state" was changed to "cam_out_t" + +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +derived type name "surface_state" was changed to "cam_out_t" +derived type name "srfflx_state" was changed to "cam_in_t" + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass + +edinburgh/lf95: all pass + +edinburgh/pgi or jaguar/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_07 +Originator(s): Francis Vitt +Date: 21 Jul 2010 +One-line Summary: Bug fixes to FV dycore offline driver and the chemistry customization option in CAM configure. + +Purpose of changes: + + Fix a bug in the FV dycore offline driver that was introduced when the + metdata module used by the FV dycore offline driver was modified to use + parallel IO utilities. + + Fix a bug in the CAM configure utility to allow the user to customize + the trop_bam, trop_ghg, and waccm_ghg chemistry packages via the "-usr_mech_infile" + configure option. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/config_files/fmo1.9c4dh + Use the new -offline_dyn configure option + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + Added "-offline_dyn" option + +M models/atm/cam/bld/config_files/defaults_trop_bam.xml +M models/atm/cam/bld/config_files/defaults_trop_ghg.xml +M models/atm/cam/bld/config_files/defaults_waccm_ghg.xml + Removed the "prog_species" specification to allow the user to customize + the chemical mechanism. The prog_species specification is not needed + here since these chemistry packages are pre-defined, i.e., the preprocessor + generated source code for the chem packages are already included in the + standard source code distribution. + +M models/atm/cam/bld/build-namelist + Adjustments needed for trop_bam, trop_ghg, and waccm_ghg since prog_species + is not set for these chem packages. + Included the ver=>'fixed_ox' specification to tracer_cnst* default namelist + settings. + +M models/atm/cam/src/dynamics/fv/metdata.F90 + Corrected problems with the reading of prescribed meteorology fields that + were introduced when this module was modified to use parallel IO utilities + in cam4_1_12. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass + +edinburgh/lf95: all pass + +edinburgh/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam5_0_06 +Originator(s): andrew, eaton +Date: Mon Jul 19 19:10:10 MDT 2010 +One-line Summary: separate aerosol activation code from microphysics code + +Purpose of changes: + +. Separate the aerosol activation code from the microphysics code. + +. Change waccm_ghg test to use cam4 physics. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/test/system/config_files/wg10c5dm +. this file was moved to wg10c4dm + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/microp_aero.F90 +. aerosol activation code previously in cldwat2m_micro.F90 + +models/atm/cam/test/system/config_files/wg10c4dm +. was wg10c4dm -- change cam5 to cam4 + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +. Move aerosol activation code to new microp_aero module. + +models/atm/cam/src/physics/cam/stratiform.F90 +. add calls to microp_aero subroutines + +models/atm/cam/test/system/input_tests_master +. wg10c5dm changed to wg10c4dm + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Jul 14 19:14:39 MDT 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Jul 14 19:40:24 MDT 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Jul 14 20:20:16 MDT 2010 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Jul 14 20:40:42 MDT 2010 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Wed Jul 14 21:31:32 MDT 2010 + +These baseline failures are due to roundoff changes associated with the +code refactoring. + +edinburgh/lf95: +034 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 5 at Mon Jul 19 18:45:06 MDT 2010 + +edinburgh/pgi: +034 bl314 TBL.sh wg10c4dm outfrq3s 9s .....................................FAIL! rc= 5 at Mon Jul 19 18:26:03 MDT 2010 + +bl314 fails because it is a new test -- no baseline available for comparison. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: cam4 is BFB. cam5 has roundoff changes + due to the code refactoring. Andrew Gettelman verified the roundoff + changes. + +=============================================================== +=============================================================== + +Tag name: cam5_0_05 +Originator(s): olson +Date: Fri Jun 30 2010 +One-line Summary: added capability to specify which history file to place heat/moisture budget terms + +Purpose of changes: +Added the namelist variable "history_budget_histfile_num" to specify which +history file to place the heat/moisture budget terms (and instantaneous state fields). +Previously the only option was the primary history file. When "history_budget" is .false., +"history_budget_histfile_num" is ignored. Default is "1" (primary). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: added "history_budget_histfile_num" + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/physics/cam/phys_control.F90 +- added "history_budget_histfile_num" to namelist and control infrastructure + +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 + +- replaced the primary history file designation ("1") with "history_budget_histfile_num" + in the call to "add_default" + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +- replaced the primary history file designation ("1") with "history_budget_histfile_num" + in the call to "add_default". Also, made the state fields instantaneous for that + history file when "history_budget" is .true. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_04 +Originator(s): mvr, jedwards +Date: Fri Jun 25 2010 +One-line Summary: various fixes made to test scripts; pnetcdf bug fix and +io cleanup from release branch + +Purpose of changes: +The test scripts place an explicit call to generate_cice_decomp.pl (the cice +decomposition script) so that cice can be built in a manner that allows reuse +of the resulting binary during restart tests, where the number of mpi tasks +(and possible smp threads) are changed. Until now, this script was not being +called with the proper inputs, but still managed to provide an executable +that could be reused for restart tests. + +However, we discovered that this was the cause of a failed test in the jaguar +posttag testing, where the pgi compiler had a problem with zero-length arrays +being created as a by-product. To fix that problem, changes were made to properly +call the decomp script and make the necessary changes to the rest of the test +scripts to deal with some of its constraints. For example, testing on bluefire +was moved to 48 processors (under-utilizing one bluefire node) because many of its +tests are done at fv 4x5, which does not have a cartesian solution with 64 procs. + +This is viewed as a short-term solution. Long-term we intend to remove the call +to generate_cice_decomp.pl from the test scripts and have cam's configure figure +out the parameters to send to the cice build. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/fma1.9c5m +D models/atm/cam/test/system/config_files/fmgpa1.9c5dm +D models/atm/cam/test/system/config_files/fmo1.9c5dh +- config options test files using cam5 were replaced with those using cam4 + +D models/atm/cam/test/system/nl_files/off2x2.5 +- removed obsolete test file + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/fmgpa1.9c4dm +A models/atm/cam/test/system/config_files/fma1.9c4m +A models/atm/cam/test/system/config_files/fmo1.9c4dh +- config options test files using cam5 were replaced with those using cam4 + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCB.sh +- modification of the call to generate_cice_decomp.pl + +M models/atm/cam/test/system/test_driver.sh +- bluefire testing now done on 48 processors instead of 64; no longer + using 'module purge' prior to jaguar testing + +M models/atm/cam/test/system/nl_files/off1.9x2.5 +- namelist options test file now will use inputfile with 26 levels (needed for cam4 testing) + +M models/atm/cam/test/system/nl_files/fvvp_lb2 +- namelist options file modified to fit into fewer processors on bluefire + +M models/atm/cam/test/system/input_tests_master +- changes to test definitions to reflect some tests moving from cam5 to cam4 + +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-cray.csh +- run template scripts now execute build-namelist from rundir rather than blddir + +M models/atm/cam/src/utils/cam_pio_utils.F90 +- bug fix for pnetcdf (from jedwards) + +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/utils/cam_csim4/ice_filenames.F90 +M models/atm/cam/src/utils/cam_csim4/cpl_mct/ice_comp_mct.F90 +M models/atm/cam/src/utils/cam_csim4/ice_data.F90 +M models/atm/cam/src/utils/cam_csim4/ice_time_manager.F90 +M models/atm/cam/src/utils/cam_csim4/ice_srf.F90 +M models/atm/cam/src/utils/cam_csim4/ice_comp.F90 +M models/atm/cam/src/physics/cam/rayleigh_friction.F90 +M models/atm/cam/src/physics/cam/phys_gmean.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +M models/atm/cam/src/physics/cam/uwshcu.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_wateruptake.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +M models/atm/cam/src/chemistry/mozart/wei96.F90 +M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +- io cleanup pulled in from release branch + +M models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +- bug fix for homme restart on 48 processors (from jedwards) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_03 +Originator(s): eaton +Date: Mon Jun 21 09:08:32 MDT 2010 +One-line Summary: code workaround for bluefire threading problem; update externals + +Purpose of changes: + +. A system problem on bluefire has been causing threaded CAM runs to either + crash badly (bringing down the node) when running cam5, or just seg fault + when running with cam4. A code modification has been made in the + tropopause module which allows cam4 to run without seg faulting, but does + not fix the problem running cam5. A firmware fix for bluefire will be + applied shortly, and at that time we may back out this workaround. + +. Update to cesm1_0_beta05 externals. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. add default jan 01 IC for 1 deg cam5 + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. drvseq3_1_30 -> drvseq3_1_32 + clm4_0_08 -> clm4_0_09 + cice4_0_20100607 -> cice4_0_20100611 + share3_100607 -> share3_100616 + scripts4_100608 -> scripts4_100617 + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add cami-mam3_0000-01-01_0.9x1.25_L30_c100618.nc + +models/atm/cam/src/physics/cam/tropopause.F90 +. Make the variables kap, faktor, and ka1 module variables, and remove the + local declarations in routine twmo. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_02 +Originator(s): aconley, fvitt +Date: 16 June 2010 +One-line Summary: RRTMG source code clean up. + +Purpose of changes: + + Rename the "conley" liquid cloud optics method to "gammadist" + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + RRTMG liqcloudoptics method "conley" changed to "gammadist" + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +U models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +U models/atm/cam/bld/namelist_files/namelist_definition.xml +U models/atm/cam/src/physics/rrtmg/radiation.F90 + - Changed "conley" liquid cloud optics method to "gammadist" + +U models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +U models/atm/cam/src/physics/rrtmg/slingo.F90 + - Fixed bug for wavelengths greater the 2.38 micrometers. + These methods are not used in the default configurations so this + bug fix had no effect on the base-line regression tests. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS + +edinburgh/lf95: all PASS + +edinburgh/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_01 +Originator(s): eaton +Date: Tue Jun 15 08:21:45 MDT 2010 +One-line Summary: back out change to restart file + +Purpose of changes: + +. The change to the restart file made in cam4_9_11 which moved the variable + rst_calendar to a global attribute has been backed out. The change is + not backwards compatible with older restart files which prevents the + model from doing branch runs from older ccsm4 runs. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/utils/time_manager.F90 +. revert rst_calendar from a global attribute back to being a variable + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: not done + +edinburgh/lf95: not done + +edinburgh/pgi or jaguar/pgi: not done + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam5_0_00 +Originator(s): fvitt, eaton +Date: Sun Jun 13 09:30:22 MDT 2010 +One-line Summary: branch point for CAM5 release; hist output mods + +Purpose of changes: + +. The CAM5 release branch will be made off of this tag. + +. Modify addfld/add_default calls so that fields relevent to cam5 physics + don't show up by default when using cam4 physics. + +. Updates to chemistry namelist documentation. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. update documentation + +models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +. don't execute init method unless needed + +models/atm/cam/src/physics/cam/ndrop.F90 +. add the addfld/add_default calls for + WTKE,LCLOUD,NDROPMIX,NDROPSRC,NDROPSNK,NDROPCOL + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove addfld/add_default calls for + WTKE,LCLOUD,NDROPMIX,NDROPSRC,NLSED,NDROPSNK,NDROPCOL + - there was no outfld call for NLSED, the other diags belong in ndrop. + +models/atm/cam/src/physics/waccm/qbo.F90 +. remove extraneous log messages + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam4_9_12 +Originator(s): eaton et al. +Date: Sat Jun 12 12:25:34 MDT 2010 +One-line Summary: update externals; build-namelist mod for cam5; change + adiabatic mode dry mass; fix cam5 budget output; cleanup for release + +Purpose of changes: + +. update externals to be consistent with cesm1_0_beta03 + +. modify build-namelist to call the cice build-namelist with cam5=.true. for + cam5 runs. This enables the cice build-namelist to provide the following + cam5 specific settings: r_snw=1.75, dt_mlt_in=1.0, rsnw_melt_in=1000. + Note that these changes were already in place for runs using the ccsm + scripts. + +. updates to namelist defaults for HOMME (from Mark Taylor) + +. new run script template for scam (from John Truesdale) + +. updates to aquaplanet use case (from John Truesdale) + +. change how the dry atmosphere mass is fixed in adiabatic mode (from + Christianne Jablonowski) + +. cleanup comments in stratiform (from Andrew Gettelman) + +. add missing CAM5 budget diagnostics (from Jerry Olson) + +. remove unsupported KE deep convection scheme + +. remove unsupported water tracer code + +Bugs fixed (include bugzilla ID): none + +. fix bug in creation of cam.buildexe.csh (wouldn't allow switching between + mct and esmf interfaces after the script was created) This is only + relevent to running with ccsm scripts. (from Tony Craig) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. modify the atm_dep_flux namelist variable so that setting it to false + explicitly sets the deposition fluxes sent to the coupler to zero. + Previously setting it to false was supposed to signal to CLM and CICE to + read the deposition fluxes from an external file. But that functionality + has been removed from CICE, and both CLM and CICE now expect CAM to + always provide these fluxes. Explicitly setting them to zero provides a + way to turn of the climate feedbacks from prognostically determined + fluxes. + +List any changes to the defaults for the boundary datasets: + +. update the 20th century use cases to use the 1850-2008 AMIP SST datasets + rather than 1850 climatology. (This affects CAM standalone runs only, + not runs done using ccsm scripts.) + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/convect_ke.F90 +models/atm/cam/src/physics/cam/convect_ke_intr.F90 +. remove KE deep convection + +models/atm/cam/src/control/wtrc_flxoce.F90 +models/atm/cam/src/physics/cam/water_isotopes.F90 +models/atm/cam/src/physics/cam/water_tracers.F90 +. remove water tracer code + +List all subroutines added and what they do: + +models/atm/cam/bld/run-scam.csh +. new run script template for scam + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. clm4_0_07 -> clm4_0_08 + cice4_0_20100602 -> cice4_0_20100607 + scripts4_100603a -> scripts4_100608 + +models/atm/cam/bld/build-namelist +. add "cam5=.true." to the cice namelist arg when cam5 physics used. +. remove setting of faerdep in clm namelist + +models/atm/cam/bld/cam.cpl7.template +. fix bug in creation of cam.buildexe.csh (wouldn't allow switching between + mct and esmf interfaces after the script was created) + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update defaults for HOMME (parameters and ne240np4 IC file for jan 01) +. remove faerdep defaults since no longer asking CLM to read deposition file + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. remove KE as valid option for deep_scheme +. remove wisotope, tracer_water + +models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3_cam4.xml +. update tuning parameters + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +. update the 20th century use cases to use the 1850-2008 AMIP SST datasets + rather than 1850 climatology. + +models/atm/cam/src/control/runtime_opts.F90 +. remove trace_water, wisotope variables +. remove water_isotopes, water_tracers + +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +. hardcode the setting of atm_aero=.true. rather than listening to the + atm_dep_flux variable since the ability of the cice code to read the + deposition fluxes from an external file has been removed. + + +models/atm/cam/src/dynamics/eul/inidat.F90 +models/atm/cam/src/dynamics/sld/inidat.F90 +. initialize tmass0 from the initial pressure field for adiabatic runs + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. in subroutine diag_surf set the deposition fluxes to zero if + atm_dep_flux=.false. + +models/atm/cam/src/physics/cam/cldwat.F90 +. remove deep_scheme='KE' + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. remove unused deep_scheme variable + +models/atm/cam/src/physics/cam/convect_deep.F90 +. remove deep_scheme='KE' + +models/atm/cam/src/physics/cam/initindx.F90 +models/atm/cam/src/physics/cam/physpkg.F90 +. remove water_tracers + +models/atm/cam/src/physics/cam/stratiform.F90 +. cleanup comments +. remove deep_scheme from inimc calling args. +. add diagnostics: + 'DPDLFLIQ ','DPDLFICE ','SHDLFLIQ ','SHDLFICE ','DPDLFT ','SHDLFT ' +. remove water_tracers + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +009 bl134 TBL.sh e48adh adia 9s ...........................................FAIL! rc= 7 at Fri Jun 11 18:10:39 MDT 2010 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Jun 9 15:36:44 MDT 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Jun 9 16:03:07 MDT 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Jun 9 16:39:49 MDT 2010 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Jun 9 16:59:21 MDT 2010 +045 bl373 TBL.sh fm1.9c4dh outfrq3s 9s ....................................FAIL! rc= 7 at Wed Jun 9 17:28:04 MDT 2010 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Wed Jun 9 17:46:41 MDT 2010 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Wed Jun 9 18:06:49 MDT 2010 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Wed Jun 9 18:22:54 MDT 2010 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Wed Jun 9 18:34:21 MDT 2010 +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Wed Jun 9 19:14:19 MDT 2010 +068 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Wed Jun 9 19:55:26 MDT 2010 + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jun 9 15:13:25 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jun 9 15:34:55 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jun 9 15:48:02 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jun 9 16:26:15 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Wed Jun 9 17:02:19 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 4 at Wed Jun 9 17:10:32 MDT 2010 + +edinburgh/pgi: All PASS except: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Wed Jun 9 14:47:02 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Wed Jun 9 14:52:42 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Wed Jun 9 14:58:31 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Wed Jun 9 15:08:45 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Wed Jun 9 15:16:42 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Wed Jun 9 15:27:47 MDT 2010 + +The baseline failures are due to the following: +. The bugfix to snow hydrology in CLM changes answers in all configurations + that use CLM. +. The update to build-namelist changes answers for all configurations using + CAM5 physics and CICE due to changed parameter values. +. The update to how the dry mass is initialized in adiabatic mode causes + answer changes in all adiabatic tests. +. The update to use the AMIP SST datasets for all transient tests changes + answers in runs using the 1850-2005 use cases. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: cam is BFB, but answers change due to new + externals and boundary datasets. + +=============================================================== +=============================================================== + +Tag name: cam4_9_11 +Originator(s): Jim Edwards, Art Mirin, Mark Taylor +Date: 6/9/2010 +One-line Summary: Update Homme Dynamics + +Purpose of changes: Development/ bug fixes + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Jim + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/doc/ChangeLog_template + removed calgary added edinburgh + + models/atm/cam/test/system/input_tests_master + Renamed models/atm/cam/test/system/config_files/h16x4c3dm + to + models/atm/cam/test/system/config_files/h16x4c3dh + following the convention because OpenMP was added to the test. + + models/atm/cam/test/system/test_driver.sh + updated pnetcdf version for bluefire. + + models/atm/cam/bld/config_files/horiz_grid.xml + added a very low resolution homme grid + models/atm/cam/bld/namelist_files/namelist_definition.xml + added qsplit to homme ctl_nl + models/atm/cam/src/utils/time_manager.F90 + made the calendar string an attribute rather than a variable + models/atm/cam/src/dynamics/sld/inidat.F90 + models/atm/cam/src/dynamics/eul/inidat.F90 + Fixed a bug in reading the PHIS variable when the from_hires attribute + is not defined. + models/atm/cam/src/dynamics/homme/external/filter_mod.F90 + models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 + models/atm/cam/src/dynamics/homme/external/mass_matrix_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 + models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 + models/atm/cam/src/dynamics/homme/external/control_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + models/atm/cam/src/dynamics/homme/external/element_mod.F90 + models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 + models/atm/cam/src/dynamics/homme/external/edge_mod.F90 + models/atm/cam/src/dynamics/homme/external/dof_mod.F90 + models/atm/cam/src/dynamics/homme/external/solver_mod.F90 + models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + Fixed OpenMP implementation. Ported recent development from homme standalone + repository. + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except + 063 bl731 TBL.sh h16x4c3dh aqua 9s expected due to dycore + development and change of test from MPI to hybrid. +edinburgh/lf95: all pass + +edinburgh/pgi : all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_9_10 +Originator(s): fvitt, eaton +Date: Tue Jun 8 08:15:34 MDT 2010 +One-line Summary: add BGC and WACCM use cases; update externals + +Purpose of changes: + +. add use cases 1850-2005_cam4_bgc and waccm_2000_cam4 +. update csm_share and driver externals +. modify run script templates to explicitly run fv, 1.9x2.5 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_bgc.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_2000_cam4.xml +. new use case files + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. drvseq3_1_29 -> drvseq3_1_30 +. share3_100515 -> share3_100607 + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. fix category of co2_cycle_rad_passive namelist var + +models/atm/cam/bld/run-cray.csh +models/atm/cam/bld/run-ibm.csh +models/atm/cam/bld/run-pc.csh +. configure for fv, 1.9x2.5 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers; BFB + +=============================================================== +=============================================================== + +Tag name: cam4_9_09 +Originator(s): hannay, gettelman, morrison, mvr +Date: +One-line Summary: finalize CAM5 + +Purpose of changes: +* bugfix in microphysics and major (non-answer changing) cleanup of code, +* physics changes (scale sea-salt, change in solubility factor, emissions numbers for black carbon and organic carbon, rhminl) +* Change testing of mozart : fm1.9c5 => fm1.9c4 + +Bugs fixed (include bugzilla ID): +Bug Fix in microphysics: calculation of pgam changed to c1 * (ncic/1e.-6 * rho) + c2 [bug was dividing by rho] + +Describe any changes made to build system: + +Describe any changes made to the namelist: +* Changes to output by default the MG microphysics variables for AMWG package + +List any changes to the defaults for the boundary datasets: +* Changes in emissions numbers for black carbon and organic carbon +* Changes in hygroscopicity "B" of POA from 0 to 0.1 + +Describe any substantial timing or memory changes: +* efficiency improvements due to major non-answer changing cleanup of microphysics code + +Code reviewed by: hannay, eaton + +List all subroutines eliminated: + +* models/atm/cam/test/system/config_files/fm1.9c5dh +* models/atm/cam/test/system/config_files/fm1.9c5m + Delete testing: fm1.9c5 (testing mozart in cam5) + +List all subroutines added and what they do: +* models/atm/cam/test/system/config_files/fm1.9c4dh +* models/atm/cam/test/system/config_files/fm1.9c4m + Add testing: fm1.9c4 (testing mozart in cam4) + +List all existing files that have been modified, and describe the changes: +* models/atm/cam/test/system/input_tests_master + Change testing of mozart: fm1.9c5 => fm1.9c4 + +* models/atm/cam/src/physics/cam/cldwat2m_micro.F90 + Major non-answer changing cleanup of code, includes efficiency improvements + Bug Fix: calculation of pgam changed to c1 * (ncic/1e.-6 * rho) + c2 [bug was dividing by rho] + Sub-grid qc removed from fallspeed calculation (unc, umc) + For t > tmelt, use esl (saturation vapor pressure over liquid)(2-4 are answer changing) + +* models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 + scale sea-salts: increase by 35% + +* models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + change in the solubility factor: sol_factic = 0.5->0.4 + +* models/atm/cam/src/physics/cam/phys_control.F90 + output by default the MG microphysics variables for AMWG package + +* models/atm/cam/bld/build-namelist + Changes to output by default the MG microphysics variables for AMWG package + +* models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + Change in rhminl: 0.905->0.89 + Changes in emissions numbers for black carbon and organic carbon + Changes in hygroscopicity "B" of POA from 0 to 0.1 (atm/cam/physprops/ocpho_rrtmg_c100528.nc) + +* models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml + Changes in emissions numbers for black carbon and organic carbon + +* models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml + Changes in emissions numbers for black carbon and organic carbon + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Mon Jun 7 11:10:45 MDT 2010 +013 bl330 TBL.sh f4c5pdh aqpgro 3s ........................................FAIL! rc= 7 at Mon Jun 7 11:10:48 MDT 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Mon Jun 7 11:10:59 MDT 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Mon Jun 7 11:11:09 MDT 2010 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Mon Jun 7 11:11:34 MDT 2010 +047 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 7 at Mon Jun 7 11:23:02 MDT 2010 + +calgary/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Sat Jun 5 16:09:08 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Sat Jun 5 16:22:41 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 7 at Sat Jun 5 16:26:37 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Sat Jun 5 16:32:33 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Sat Jun 5 16:59:28 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Sat Jun 5 17:27:04 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 7 at Sat Jun 5 17:32:17 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Sat Jun 5 17:32:19 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 7 at Sat Jun 5 17:35:00 MDT 2010 +- any baseline tests where cam5 was used were expected to fail becasue changes in the cam5 physics + +calgary/pgi or jaguar/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 7 at Sat Jun 5 15:57:09 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 7 at Sat Jun 5 16:03:12 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 7 at Sat Jun 5 16:07:29 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 7 at Sat Jun 5 16:09:19 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 7 at Sat Jun 5 16:19:37 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 7 at Sat Jun 5 16:28:00 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 7 at Sat Jun 5 16:32:30 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 7 at Sat Jun 5 16:38:44 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 7 at Sat Jun 5 16:43:06 MDT 2010 +- any baseline tests where cam5 was used were expected to fail becasue changes in the cam5 physics + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam4_9_08 +Originator(s): mvr, hannay +Date: Fri Jun 4 2010 +One-line Summary: updated to recent versions of external component code; Turn on + volcanic aerosols in CAM5 for the 1850-2005 use case. + +Purpose of changes: + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: changes needed to implement volcanic + aerosols in cam5 + +List any changes to the defaults for the boundary datasets: new setting for volcanics + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: +A models/atm/cam/test/system/nl_files/volc +- new namelist options test file for testing volcanics + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh +- added dumping of missing namelists to test log output + +M models/atm/cam/test/system/input_tests_master +- change in test definition for test of cam5 volcanics + +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-cray.csh +- fix to run template scripts needed to utilize new ocn.stream.txt info + +M models/atm/cam/bld/configure +- removed ntr_pond and ntr_iage settings from cice configure call + +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +- changes required to implement volcanic aerosols in cam5 + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated external definitions for drv,clm,cice,pio,scripts + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri Jun 4 12:26:23 MDT 2010 +- failure expected due to bug fix in drydep code of new clm tag + +002 bl375 TBL.sh f1.9c5m volc+1850-2005_cam5 2d ...........................FAIL! rc= 5 at Fri Jun 4 14:57:52 MDT 2010 +- failure due to new test definition not recognized by baseline code, but would have failed anyway due to change + in volcanics in cam5 physics + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam4_9_07 +Originator(s): eaton +Date: Wed Jun 2 16:33:56 MDT 2010 +One-line Summary: mods for BGC runs; mods to super_fast_llnl use cases; + misc cleanup + +Purpose of changes: + +. Add logic to build-namelist for the desired co2_cycle behavior: + If co2_cycle is true then: + - don't read the co2 fossil fuel fluxes when sim_year=1850 + - read the co2 fossil fuel fluxes when sim_year=1850-2000 unless the user + explicitly sets co2_readflux_fuel=.false. + - make the prognostic CO2 radiatively active unless the user explicitly + sets co2_cycle_rad_passive=.true. + +. mods for output when co2_cycle is active +. mods in super_fast_llnl use cases +. make the setting of npr_yz in the cam.buildnml.csh script more robust +. remove the compiler patch args from the AIX section. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. namelist variables for the co2_cycle module were put into their own + namelist group co2_cycle_nl + +. namelist variables for the chem_surfvals module were put into their own + namelist group chem_surfvals_nl + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add logic for desired co2_cycle behavior: when co2_cycle is true then + - don't read the co2 fossil fuel fluxes when sim_year=1850 + - read the co2 fossil fuel fluxes when sim_year=1850-2000 unless the user + explicitly sets co2_readflux_fuel=.false. + - make the prognostic CO2 radiatively active unless the user explicitly + sets co2_cycle_rad_passive=.true. + +models/atm/cam/bld/cam.cpl7.template +. make the setting of npr_yz in the cam.buildnml.csh script more robust + +models/atm/cam/bld/Makefile.in +. Remove the compiler patch args from the AIX section. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. change group of co2_cycle namelist variables to co2_cycle_nl +. put the chem_surfvals namelist variables into the chem_surfvals_nl group. +. remove unused variable prognostic_sulfur +. add co2_cycle_rad_passive +. updates to documentation + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +. adjust h0 fields + +models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +. turn on clm drydep + +models/atm/cam/src/physics/cam/aoa_tracers.F90 +. put log output inside if(masterproc) condition + +models/atm/cam/src/control/cam_history.F90 +. replace chem_surfvals_get('CO2VMR') by chem_surfvals_co2_rad(vmr_in=.true.) + +models/atm/cam/src/control/runtime_opts.F90 +. remove co2_{default,set}opts routines +. add call to co2_cycle_readnl +. replace chem_surfvals_{default,set}opts calls by chem_surfvals_readnl + +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +. remove outfld calls for SFCO2* + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add outfld calls for SFCO2*, CO2*_BOT + +models/atm/cam/src/physics/cam/chem_surfvals.F90 +. modify chem_surfvals_co2_rad with an optional argument to allow it to + return co2 as vmr (default is to return it as mmr). +. add chem_surfvals_readnl for reading namelist + +models/atm/cam/src/physics/cam/co2_cycle.F90 +. add addfld calls for CO2*_BOT +. add add_default calls for TMCO2* + +models/atm/cam/src/physics/cam/co2_cycle.F90 +. add co2_cycle_readnl routine to read namelist +. remove old co2_{default,set}opts routines + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +Note: answers will change when using the 1850_cam4_super_fast_llnl use case. + +=============================================================== +=============================================================== + +Tag name: cam4_9_06 +Originator(s): mvr +Date: 27 May 2010 +One-line Summary: cleanup of test scripts + +Purpose of changes: +the filename of the configure options file used by each test did not +always contain a string indicating which physics package was being +exercised - filenames in these instances were changed + +removed the cppdef -DNO_VEXP from the test scripts as it is no longer +being used by the model + +removed test of waccm using cam5 physics until the configuration has been +validated + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/f4h +D models/atm/cam/test/system/config_files/fmo1.9dh +D models/atm/cam/test/system/config_files/fm1.9m +D models/atm/cam/test/system/config_files/e64m +D models/atm/cam/test/system/config_files/s8dm +D models/atm/cam/test/system/config_files/e48m +D models/atm/cam/test/system/config_files/e64o +D models/atm/cam/test/system/config_files/scm64bfbiop +D models/atm/cam/test/system/config_files/e64bfbiop +D models/atm/cam/test/system/config_files/f4dm +D models/atm/cam/test/system/config_files/s48dh +D models/atm/cam/test/system/config_files/s32pdh +D models/atm/cam/test/system/config_files/wm4dh +D models/atm/cam/test/system/config_files/s32dh +D models/atm/cam/test/system/config_files/f10pdm +D models/atm/cam/test/system/config_files/wm1.9m +D models/atm/cam/test/system/config_files/scmarmiop +D models/atm/cam/test/system/config_files/e8dm +D models/atm/cam/test/system/config_files/f10t5mdm +D models/atm/cam/test/system/config_files/wg10dm +D models/atm/cam/test/system/config_files/scm64bfbiop_4 +D models/atm/cam/test/system/config_files/fma1.9h +D models/atm/cam/test/system/config_files/e64bfbiop_4 +D models/atm/cam/test/system/config_files/fm1.9dh +D models/atm/cam/test/system/config_files/fma1.9m +D models/atm/cam/test/system/config_files/e8pdm +D models/atm/cam/test/system/config_files/e8t5mdm +D models/atm/cam/test/system/config_files/s64h +D models/atm/cam/test/system/config_files/f1.9h +D models/atm/cam/test/system/config_files/s64m +D models/atm/cam/test/system/config_files/f1.9m +D models/atm/cam/test/system/config_files/e64pm +D models/atm/cam/test/system/config_files/h16x4dm +D models/atm/cam/test/system/config_files/s64o +D models/atm/cam/test/system/config_files/s8pdm +D models/atm/cam/test/system/config_files/f1.9o +D models/atm/cam/test/system/config_files/fmgpa1.9dh +D models/atm/cam/test/system/config_files/s8t5mdm +D models/atm/cam/test/system/config_files/fmgpa1.9dm +D models/atm/cam/test/system/config_files/f10dm +D models/atm/cam/test/system/config_files/s48pdh + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f10c5pdm +A models/atm/cam/test/system/config_files/scmc5armiop +A models/atm/cam/test/system/config_files/f10c5t5mdm +A models/atm/cam/test/system/config_files/e8c5dm +A models/atm/cam/test/system/config_files/wg10c5dm +A models/atm/cam/test/system/config_files/fm1.9c5dh +A models/atm/cam/test/system/config_files/e8c5pdm +A + models/atm/cam/test/system/config_files/scm64c4bfbiop +A + models/atm/cam/test/system/config_files/e64c4bfbiop +A models/atm/cam/test/system/config_files/wm1.9c4h +A models/atm/cam/test/system/config_files/e8c5t5mdm +A models/atm/cam/test/system/config_files/s64c5h +A models/atm/cam/test/system/config_files/s64c5m +A + models/atm/cam/test/system/config_files/h16x4c3dm +A models/atm/cam/test/system/config_files/e64c5pm +A models/atm/cam/test/system/config_files/s8c5pdm +A models/atm/cam/test/system/config_files/s8c5t5mdm +A models/atm/cam/test/system/config_files/fmgpa1.9c5dm +A models/atm/cam/test/system/config_files/s32c5pdh +A models/atm/cam/test/system/config_files/f10c5dm +A models/atm/cam/test/system/config_files/s32c5dh +A models/atm/cam/test/system/config_files/fm1.9c5m +A models/atm/cam/test/system/config_files/fma1.9c5m +A models/atm/cam/test/system/config_files/s8c5dm +A models/atm/cam/test/system/config_files/e64c5m +A models/atm/cam/test/system/config_files/e48c5m +A models/atm/cam/test/system/config_files/scm64c5bfbiop +A models/atm/cam/test/system/config_files/e64c5bfbiop +A models/atm/cam/test/system/config_files/fmo1.9c5dh + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/config_files/e48c4pdm +M models/atm/cam/test/system/config_files/wm1.9c4m +M models/atm/cam/test/system/config_files/f4c5dm +M models/atm/cam/test/system/config_files/wm4c4h +M models/atm/cam/test/system/config_files/f4c4pdh +M models/atm/cam/test/system/tests_posttag_jaguar_cb +M models/atm/cam/test/system/tests_posttag_jaguar +M models/atm/cam/test/system/input_tests_master + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +045 bl373 TBL.sh fm1.9c5dh outfrq3s 9s ....................................FAIL! rc= 5 at Thu May 27 11:16:50 MDT 2010 +060 bl379 TBL.sh wm1.9c4h outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 5 at Thu May 27 12:49:01 MDT 2010 +063 bl731 TBL.sh h16x4c3dm aqua 9s ........................................FAIL! rc= 5 at Thu May 27 12:53:53 MDT 2010 +- failures were due to the change in name of the respective configuration options file, where it was not recognized + by the baseline scripts + +edinburgh/lf95: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 5 at Wed May 26 11:18:09 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Wed May 26 11:30:34 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 5 at Wed May 26 11:33:53 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Wed May 26 11:38:42 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 5 at Wed May 26 12:04:26 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 5 at Wed May 26 12:29:01 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 5 at Wed May 26 12:32:56 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 5 at Wed May 26 12:54:55 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 5 at Wed May 26 13:02:29 MDT 2010 +- failures were due to the change in name of the respective configuration options file, where it was not recognized + by the baseline scripts + +edinburgh/pgi: +004 bl111 TBL.sh e8c5t5mdm ttrac 9s .......................................FAIL! rc= 5 at Wed May 26 11:07:28 MDT 2010 +008 bl112 TBL.sh e8c5dm ghgrmp 9s .........................................FAIL! rc= 5 at Wed May 26 11:10:34 MDT 2010 +010 bl113 TBL.sh e8c5pdm aqpgro 3s ........................................FAIL! rc= 5 at Wed May 26 11:12:41 MDT 2010 +014 bl114 TBL.sh e8c5dm co2rmp 9s .........................................FAIL! rc= 5 at Wed May 26 11:14:03 MDT 2010 +021 bl311 TBL.sh f10c5t5mdm ttrac 9s ......................................FAIL! rc= 5 at Wed May 26 11:21:38 MDT 2010 +029 bl312 TBL.sh f10c5dm ghgrmp 9s ........................................FAIL! rc= 5 at Wed May 26 11:26:50 MDT 2010 +031 bl313 TBL.sh f10c5pdm aqpgro 3s .......................................FAIL! rc= 5 at Wed May 26 11:29:08 MDT 2010 +034 bl314 TBL.sh wg10c5dm outfrq3s 9s .....................................FAIL! rc= 5 at Wed May 26 11:32:59 MDT 2010 +039 bl316 TBL.sh f10c5pdm aqpgro+aquaplanet_cam5 3s .......................FAIL! rc= 5 at Wed May 26 11:37:13 MDT 2010 +- failures were due to the change in name of the respective configuration options file, where it was not recognized + by the baseline scripts + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b + +=============================================================== + +Tag name: cam4_9_05 +Originator(s): sungsu, aconley, hannay, eaton +Date: Wed May 26 09:24:56 MDT 2010 +One-line Summary: "final" cam5 version + +Purpose of changes: + +. Mods to CAM5 physics package: + - change to the initialization for the radius in prescribed_volcaero.F90 + - correction to the lookup table in aer_rad_props.F90 + - fixes in the wet scavenging of aerosols + - solubility factor = 0.4 instead of 0.6 + - increase SOAG by 1.5 + - reduction in black & organic carbon number by a factor of 3 + + This is expected to be the final version of the CAM5 physics for the + CESM-1.0 release except for bug fixes and code cleanup. + +Bugs fixed (include bugzilla ID): + +. bug fix in modal_aero_lw (makes refractive index vary with wavelength) + +. bugfix in aerosol activation + +. bugfix in wet deposition + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +- new emission datasets for soag and black carbon numbers (num_a1) + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml +models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml +models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +models/atm/cam/src/chemistry/bulk_aero/sulchem.F90 +models/atm/cam/src/chemistry/bulk_aero/wetdep.F90 +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +models/atm/cam/src/physics/cam/aer_rad_props.F90 +models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +models/atm/cam/src/physics/cam/cloud_fraction.F90 +models/atm/cam/src/physics/cam/convect_deep.F90 +models/atm/cam/src/physics/cam/convect_shallow.F90 +models/atm/cam/src/physics/cam/eddy_diff.F90 +models/atm/cam/src/physics/cam/modal_aer_opt.F90 +models/atm/cam/src/physics/cam/ndrop.F90 +models/atm/cam/src/physics/cam/stratiform.F90 +models/atm/cam/src/physics/cam/tphysbc.F90 +models/atm/cam/src/physics/cam/uwshcu.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +models/atm/cam/src/physics/cam/zm_conv_intr.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue May 25 15:23:22 MDT 2010 +013 bl330 TBL.sh f4c5pdh aqpgro 3s ........................................FAIL! rc= 7 at Tue May 25 15:30:27 MDT 2010 +021 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue May 25 15:49:40 MDT 2010 +036 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue May 25 16:27:50 MDT 2010 +040 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue May 25 16:47:45 MDT 2010 +045 bl373 TBL.sh fm1.9dh outfrq3s 9s ......................................FAIL! rc= 7 at Tue May 25 17:23:04 MDT 2010 +047 bl375 TBL.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 7 at Tue May 25 17:40:45 MDT 2010 + +edinburgh/lf95: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue May 25 15:08:15 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue May 25 15:31:59 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..........................................FAIL! rc= 7 at Tue May 25 15:38:27 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue May 25 15:44:34 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue May 25 16:24:29 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue May 25 17:02:39 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 7 at Tue May 25 17:10:39 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue May 25 17:47:25 MDT 2010 +039 bl316 TBL.sh f10pdm aqpgro+aquaplanet_cam5 3s .........................FAIL! rc= 7 at Tue May 25 17:55:54 MDT 2010 + +edinburgh/pgi: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue May 25 14:44:21 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue May 25 14:49:54 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..........................................FAIL! rc= 7 at Tue May 25 14:54:09 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue May 25 14:55:46 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue May 25 15:05:59 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue May 25 15:13:48 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 7 at Tue May 25 15:18:22 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue May 25 15:25:17 MDT 2010 +039 bl316 TBL.sh f10pdm aqpgro+aquaplanet_cam5 3s .........................FAIL! rc= 7 at Tue May 25 15:29:38 MDT 2010 + +All failures are baseline tests that are expected to fail due to changed +answers with cam5 physics. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: cam4 is BFB. cam5 has new climate. + +=============================================================== +=============================================================== + +Tag name: cam4_9_04 +Originator(s): jet,eaton,mvertens +Date: 5-20-2010 +One-line Summary: Added aquaplanet as component model and make docn default for cam + +Purpose of changes: aquaplanet is now a supported configuration. It is no longer + a namelist option but is now an -ocn aquaplanet option to the configure script. + The configure -ocn aquaplanet and build-namelist calls will produce a cam + executable that uses the default analytic sst pattern #1. I also included two + new use cases that allow building namelists which have specific settings for the + ape experiments (resetting of model constants, special boundary datasets, etc.) + There is a use case for cam3/cam4 called aquaplanet_cam3_cam4 and one for cam5 + physics called aquaplanet_cam5. The cam3/cam4 use-case turns off aerosol forcing + and the cam5 use-case uses most of the cam5 default configuration which includes + prognostic aerosols. + + DOCN is now the default ocn component for CAM. DOM is still an option to configure. + The DOCN model uses a slightly different interpolation algorithm and is roundoff + compared to DOM. + + Cleaned up the use of shr_const in the model. Replace most of the shr_const parameters + with their physconst analogs. This allows a consistent use and derivation of physical + constants for when running aquaplanet experiments. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + DOCN is the new default ocn component + DOM must now be specified via -ocn dom setting of configure + aquaplanet is now an configure option -ocn aquaplanet + +Describe any changes made to the namelist: + ===================================================================== + Brought some additional resolution tuning parameters into the namelist + ===================================================================== + + Cldwat + cldwat_icritc !threshold for autoconversion of cold ice + cldwat_icritw !threshold for autoconversion of warm ice + cldwat_conke !tunable constant for evaporation of precip + + hkconv + hkconv_cmftau !characteristic adjustment time scale + hkconv_c0 !rain water autoconversion coefficient + + zmconv + zmconv_ke !Tunable evaporation efficiency + ===================================================================== + Added docn parameters to namelist + ===================================================================== + restfilm !Full pathname of docn restart file. + ocn_in !ocn type + decomp !1d + + ===================================================================== + Added namelist option to pick analytic sst pattern for aquaplanet + ===================================================================== + aqua_planet_sst !Set the sst to a particular analytic solution. + + ===================================================================== + Added 6 physical constants to namelist to support APE experiments + ===================================================================== + + sday ! sec in siderial day ~ sec + rearth ! radius of earth (m) + gravit ! gravitational acceleration (m/s**2) + mwdry ! molecular weight dry air + mwh2o ! molecular weight h2o + cpwv ! specific heat of water vapor (J/K/kg) + + These values default to their shr_const values if not reset in the namelist + +List any changes to the defaults for the boundary datasets: + + added new solar and ozone datasets for aquaplanet experiments. + +Describe any substantial timing or memory changes: + +Code reviewed by: jet eaton + +List all subroutines eliminated: + + Moved physconst to control +D models/atm/cam/src/physics/cam/physconst.F90 + + Replace shr_const values with physconst equivalents +D models/atm/cam/src/dynamics/fv/dynconst.F90 +D models/atm/cam/src/dynamics/sld/dynconst.F90 +D models/atm/cam/src/dynamics/eul/dynconst.F90 + +List all subroutines added and what they do: + New Use Cases for Aquaplanet +A models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/aquaplanet_cam3_cam4.xml + + Moved physconst from physics to control +A + models/atm/cam/src/control/physconst.F90 + + Added new utils directory for aquaplanet support +A models/atm/cam/src/utils/cam_aqua +A models/atm/cam/src/utils/cam_aqua/ocn_types.F90 +A models/atm/cam/src/utils/cam_aqua/cpl_mct +A models/atm/cam/src/utils/cam_aqua/cpl_mct/ocn_comp_mct.F90 +A models/atm/cam/src/utils/cam_aqua/cpl_esmf +A models/atm/cam/src/utils/cam_aqua/ocn_comp.F90 + +List all existing files that have been modified, and describe the changes: + + Aquaplanet support +M models/atm/cam/test/system/config_files/e48c4pdm +M models/atm/cam/test/system/config_files/f10c3dm +M models/atm/cam/test/system/config_files/s32pdh +M models/atm/cam/test/system/config_files/f10pdm +M models/atm/cam/test/system/config_files/f4c5pdh +M models/atm/cam/test/system/config_files/e8pdm +M models/atm/cam/test/system/config_files/e48adh +M models/atm/cam/test/system/config_files/s8pdm +M models/atm/cam/test/system/config_files/h16x4dm +M models/atm/cam/test/system/config_files/e64pm +M models/atm/cam/test/system/config_files/f4c4pdh + + New diagnostic tests for aquaplanet use case +M models/atm/cam/test/system/tests_posttag_edinburgh +M models/atm/cam/test/system/tests_pretag_edinburgh + + Added support for docn branch +M models/atm/cam/test/system/TBR.sh + + Aquaplanet/docn support +M models/atm/cam/test/system/nl_files/aqua +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + + Added new namelist parameters that control tuning parameters and docn component +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/hk_conv.F90 +M models/atm/cam/src/control/runtime_opts.F90 + + Code cleanup +M models/atm/cam/src/control/ncdio_atm.F90 +M models/atm/cam/src/utils/cam_csim4/cpl_mct/ice_comp_mct.F90 +M models/atm/cam/src/utils/cam_csim4/print_coverage.F90 +M models/atm/cam/src/utils/cam_dom/sst_data.F90 +M models/atm/cam/src/utils/cam_dom/cpl_mct/ocn_comp_mct.F90 +M models/atm/cam/src/utils/cam_dom/ocn_comp.F90 +M models/atm/cam/src/control/cam_history.F90 + + updated to latest docn7/csm_share/drv components to allow support for docn and aquaplanet +M SVN_EXTERNAL_DIRECTORIES + + shr_const parameters replaced with physconst equivalents +M models/atm/cam/src/physics/cam/tropopause.F90 +M models/atm/cam/src/physics/cam/boundarydata.F90 +M models/atm/cam/src/physics/cam/phys_gmean.F90 +M models/atm/cam/src/physics/cam/ghg_data.F90 +M models/atm/cam/src/physics/cam/chem_surfvals.F90 +M models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +M models/atm/cam/src/physics/cam/co2_cycle.F90 +M models/atm/cam/src/physics/cam/tidal_diag.F90 +M models/atm/cam/src/physics/waccm/nlte_fomichev.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/physics/waccm/gravity_waves_sources.F90 +M models/atm/cam/src/chemistry/utils/mo_constants.F90 +M models/atm/cam/src/chemistry/utils/solar_data.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/mo_msis_ubc.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/mozart/chlorine_loading_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_aero_settling.F90 +M models/atm/cam/src/chemistry/mozart/mo_airglow.F90 +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +M models/atm/cam/src/chemistry/mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +M models/atm/cam/src/chemistry/mozart/set_cp.F90 +M models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/mozart/mo_snoe.F90 +M models/atm/cam/src/chemistry/mozart/mo_sphers.F90 +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +M models/atm/cam/src/chemistry/mozart/iondrag.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +M models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +M models/atm/cam/src/chemistry/mozart/efield.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/mo_jeuv.F90 +M models/atm/cam/src/chemistry/mozart/exbdrift.F90 +M models/atm/cam/src/chemistry/mozart/mo_solarproton.F90 +M models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +M models/atm/cam/src/chemistry/mozart/mo_params.F90 +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M models/atm/cam/src/dynamics/sld/initcom.F90 +M models/atm/cam/src/dynamics/sld/settau.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/sld/spetru.F90 +M models/atm/cam/src/dynamics/sld/dyn.F90 +M models/atm/cam/src/dynamics/sld/quad.F90 +M models/atm/cam/src/dynamics/sld/grcalc.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/initcom.F90 +M models/atm/cam/src/dynamics/eul/scanslt.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/spetru.F90 +M models/atm/cam/src/dynamics/eul/iop.F90 +M models/atm/cam/src/dynamics/eul/dyn.F90 +M models/atm/cam/src/dynamics/eul/quad.F90 +M models/atm/cam/src/dynamics/eul/grcalc.F90 +M models/atm/cam/src/dynamics/homme/external/physical_constants.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/initcom.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/inital.F90 +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + Since docn gives roundoff differences to dom all the baseline tests + were expected to fail + + When the code was tested with dom all tests past as expected. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 +060 bl389 TBL.sh wm1.9c4m outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 +068 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 + +edinburgh/lf95: +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 + + +edinburgh/pgi: +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 +039 bl316 TBL.sh f10pdm aqpgro+aquaplanet_cam5 3s .........................SKIPPED* + + bl316 is a new test for the aquaplanet5 use case and didn't exist in the base line. + + +CAM tag used for the baseline comparison tests if different than previous +tag:cam4_9_03 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + roundoff changes. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + tested docn sstfield against original dom sst. Some values were different in the last bit. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam4_9_03 +Originator(s): mvr, eaton, jet +Date: 14 May 2010 +One-line Summary: made prescribed aerosol mode the default; mod to cam.cpl7.template to read users CCSM namelist +from CASEROOT/user_nl_cam; scam bugfix; back out workaround for esmf bug; new jan1 ncdata for 0.23x0.31 + +Purpose of changes: +- the user namelist was previously read from $CASEROOT/SourceMods/src.cam/user_nl +- reverting back to the cam4_1_14 version of time_manager.F90 to undo workaround for esmf bug +- cam's handling of prescribed aerosols and their depositions will allow surface models to remove this functionality + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- added settings for aerosol deposition + +List any changes to the defaults for the boundary datasets: +- new jan1 ncdata file for 0.23x0.31 + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +M models/atm/cam/bld/namelist_files/use_cases/2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_2xco2.xml +M models/atm/cam/src/physics/cam/phys_control.F90 +- mods need to make prescribed aerosols the default + +M models/atm/cam/bld/cam.cpl7.template +- new reading user namelist from $CASEROOT/user_nl_cam + +M models/atm/cam/src/utils/time_manager.F90 +- back out workaround for esmf bug + +M models/atm/cam/src/utils/cam_dom/sst_data.F90 +- scam bug fix + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Fri May 14 07:05:21 MDT 2010 +017 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Fri May 14 07:05:29 MDT 2010 +033 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Fri May 14 07:05:55 MDT 2010 +050 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Fri May 14 07:06:10 MDT 2010 +054 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Fri May 14 07:06:17 MDT 2010 +057 bl388 TBL.sh f1.9c4m outfrq24h+1850_cam4 2d ...........................FAIL! rc= 7 at Fri May 14 07:06:23 MDT 2010 +060 bl389 TBL.sh wm1.9c4m outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 7 at Fri May 14 07:07:48 MDT 2010 +068 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Fri May 14 07:07:54 MDT 2010 +- any baseline test where prescribed aerosols were used were expected to fail + +edinburgh/lf95: +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Thu May 13 17:31:21 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Thu May 13 17:33:41 MDT 2010 +- any baseline test where prescribed aerosols were used were expected to fail + +edinburgh/pgi: +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Thu May 13 16:15:27 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Thu May 13 16:15:27 MDT 2010 +- any baseline test where prescribed aerosols were used were expected to fail + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: runs using prescribed aerosols are different by larger than roundoff but presumably + same climate - we are relying on dbaily and dlawrence signing off on validation runs with this change + +=============================================================== +Tag name: cam4_9_02 +Originator(s): mvr, eaton, mirin +Date: 05 May 2010 +One-line Summary: enhanced testing of cam4 configurations; updated externals of +surface components to match those of ccsm4_0_beta52; cleaned up test scripts to +reflect decommissioning of calgary; addition of fields to master field list; +fix of potential bug in fv dycore + +Purpose of changes: +-the cgd linux cluster, calgary was decommissioned on 5/5/10...this was a primary + test platform for cam - testing will now take place on its replacement, edinburgh + +-master field list needed some additional fields being requested for the "moar" + production runs + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +- fsurdat settings updated for T85 and 0.23x0.31 +- fpftdyn and faerdep settings added for rcp=4.5,2.6 + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/fmo2dh +- removed obsolete test file + +D models/atm/cam/test/system/config_files/scm64bfbiop_35 +D models/atm/cam/test/system/config_files/e64bfbiop_35 +- test files renamed (cam3_5 -> cam4) + +D models/atm/cam/test/system/tests_posttag_calgary +D models/atm/cam/test/system/tests_pretag_calgary +- test files renamed to reflect decommissioning of calgary + + +List all subroutines added and what they do: +A + models/atm/cam/test/system/tests_posttag_edinburgh +A + models/atm/cam/test/system/tests_pretag_edinburgh +- files containing test lists renamed to reflect decommissioning of calgary + +A models/atm/cam/test/system/config_files/wm1.9c4m +A models/atm/cam/test/system/config_files/f0.9c4m +A models/atm/cam/test/system/config_files/fm1.9dh +A models/atm/cam/test/system/nl_files/outfrq1m +- new test files for enhanced testing of cam4 configurations, trop_mozart chemistry + +A models/atm/cam/test/system/config_files/scm64bfbiop_4 +A models/atm/cam/test/system/config_files/e64bfbiop_4 +- test files renamed (cam3_5 -> cam4) + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/tests_posttag_jaguar_cb +M models/atm/cam/test/system/tests_posttag_jaguar +M models/atm/cam/test/system/tests_posttag_bluefire +- additional tests for cam4 physics, trop_mozart chemistry + +M models/atm/cam/test/system/TCB.sh +- fixed the error trapping for calls to generate_cice_decomp.pl + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- stripped out settings in test scripts for calgary + +M models/atm/cam/bld/configure +- default number of vertical levels is now set to 26 only for non-waccm chemistry runs + using cam3 or cam4 physics + +M models/atm/cam/bld/run-cray.csh +- run template script for xt machines will now use default version of compilers + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- update to default inputdata files to coincide with updated clm tag + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +- added temporary clim_pi SST datasets to this use_case + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add T200, T500, Z100, Z200 to master fieldlist +. add interpolation and outfld calls for new fields +. add hist_fld_active conditionals to avoid diagnostic calculations and/or + interpolations for fields that don't appear in any history file. +. remove duplicate routine polysvp + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +. add some omp directives + +M models/atm/cam/src/dynamics/fv/cd_core.F90 +. fix dimension in work array (This is fixing a potential bug, not a + currently occurring bug.) + +M models/atm/cam/src/dynamics/fv/sw_core.F90 +. put declaration for u2, v2 inside ifdef FILTER_MASS_FLUXES conditional + (this option isn't being enabled in cam. This fix is just saving memory + by not declaring unused arrays) + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated externals to match settings for ccsm4_0_beta52 (drv, clm, cice, docn, csm_share, scripts) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +009 bl134 TBL.sh e48adh adia 9s ...........................................FAIL! rc= 7 at Tue May 4 17:57:40 MDT 2010 +024 bl334 TBL.sh f4adh fv2d_8tsk 9s .......................................FAIL! rc= 7 at Tue May 4 18:37:16 MDT 2010 +028 bl335 TBL.sh f4idm idphys 9s ..........................................FAIL! rc= 7 at Tue May 4 18:39:03 MDT 2010 +043 bl373 TBL.sh fm1.9dh outfrq3s 9s ......................................FAIL! rc= 5 at Tue May 4 19:41:52 MDT 2010 +058 bl389 TBL.sh wm1.9c4m outfrq24h+waccm_1850_cam4 2d ....................FAIL! rc= 5 at Tue May 4 21:12:43 MDT 2010 +002 bl330 TBL.sh f4c5pdh aqpgro 3s ........................................FAIL! rc= 5 at Wed May 5 11:13:44 MDT 2010 +- adiabatic and ideal physics baseline tests failed because they're now running at 30-levels which require + a different initial file +- bl373, bl389 and bl330 failed because they introduce a new test configuration that was not recognized by the baseline code + +edinburgh/lf95: +017 bl115 TBL.sh e8idm idphys 9s ..........................................FAIL! rc= 7 at Tue May 4 17:32:52 MDT 2010 +- ideal physics baseline test failed because it's now running at 30-levels which requires a different initial file + +edinburgh/pgi: +017 bl115 TBL.sh e8idm idphys 9s ..........................................FAIL! rc= 7 at Tue May 4 16:58:15 MDT 2010 +- ideal physics baseline test failed because it's now running at 30-levels which requires a different initial file + + +CAM tag used for the baseline comparison tests if different than previous +tag: bl351, bl352, bl385, bl386, bl388, bl389 were run against cam4_9_00 to ensure nothing changed + answers for these configurations with previous tag + +Summarize any changes to answers: b4b except for adiabatic and ideal physics configurations which now run at 30 levels + +=============================================================== +=============================================================== + +Tag name: cam4_9_01 +Originator(s): Francis Vitt +Date: 3 May 2010 +One-line Summary: Updates to the 1850-2005_cam4_super_fast_llnl build-namelist use case + and radiation output bug fixes. + +Purpose of changes: + + Changes to the 1850-2005_cam4_super_fast_llnl use case are needed for the + track1 with super_fast_llnl chemistry 20th century transient simulation. + + Fix bugs: + - the SWCF radiation diagnostic needs to be in the dosw if block + - output of undefined fields when MG microphysics is not used + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +U models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml + - mods for the 20th century transient simulation with super_fast_llnl chemistry + . use 1-degree emission data sets + . changed to be consistent with the 1850-2005_cam4 use case + . fincl1 output fields list was adjusted + +U models/atm/cam/src/physics/cam/radiation.F90 + - move the outfld call for SWCF diagnostic to the dosw if block + +U models/atm/cam/src/physics/cam/radiation_data.F90 + - modified to not output physics buffer fields which are not defined when + 'MG' is not used + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon May 3 13:02:43 MDT 2010 + - this is expected to fail due to changes in the 1850-2005_cam4_super_fast_llnl use case + +edinburgh/lf95: all PASS + +edinburgh/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_9_00 +Originator(s): mvr, sungsu, hannay, eaton, others +Date: 29 Apr 2010 +One-line Summary: updated the physics with code from the cam5 development branch; +some changes to the dynamics, including the enabling of fourth-order divergence damping + +Purpose of changes: + +Devlopment of the cam5 physics has been occuring on a code branch for some +time. The merge of that code base with that of the cam trunk is now complete, +including backwards compatibility with cam4 and cam3 physics. For more details +on the changes, see the ChangeLog file for the branch camdev_cam3_6_23. + +There were some changes to the dynamics included with this merge including: +- Switch to enable fourth-order divergence damping except at the model top layers where regular + second-order (Laplacian) damping is applied (damps both divergence and vorticity). +- FV no longer writes/reads "DELP" to/from IC file. +- Added another nested loop to the FV dynamical core. allow multiple vertical + remappings within a physics time-step. added new namelist variable: NSPLTVRM (for + split vertical remapping) as an addtion to the NSPLIT and NSPLTRAC dynamics + splitting namelist variables. Default is 1. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +- changes in support of new cam5 physics (addition of flag to specify pbl scheme, etc) + +Describe any changes made to the namelist: +- changes in support of new cam5 physics (settings for turbulent mountain stress, + convective water in radiation, condensate-to-rain autoconversion coefficients, etc) + +List any changes to the defaults for the boundary datasets: +- files now specified for running with 30 vertical levels + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: none +D models/atm/cam/src/physics/cam/cldwat2m.F90 +- file split into two, one for microphysics and one for macrophysics + +List all subroutines added and what they do: +A + models/atm/cam/bld/namelist_files/use_cases/1850_cam5_super_fast_llnl.xml +- new use_case using cam5 physics + +A + models/atm/cam/src/physics/cam/cldwat2m_macro.F90 +A + models/atm/cam/src/physics/cam/cldwat2m_micro.F90 +- new physics files created from cldwat2m.F90 + +A + models/atm/cam/src/physics/cam/uwshcu.F90 +- new physics for university of wash shallow convection scheme + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam +- externals property updated to reflect changes in SVN_EXTERNAL_DIRECTORIES from cam4_1_08 + +M + models/atm/cam/test/system/nl_files/off1.9x2.5 +- update of test file to use input file with 30 vertical levels + +M models/atm/cam/test/system/nl_files/scm_b4b_o1 +M models/atm/cam/test/system/nl_files/scm_prep +- update of scam tests to ensure 3d model and scam runs use identical inputs + +M models/atm/cam/test/system/CAM_runcmnd.sh +- just a change in white space + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/fv_control_mod.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/physics/cam/molec_diff.F90 +M models/atm/cam/src/physics/cam/param_cldoptics.F90 +M models/atm/cam/src/physics/cam/trb_mtn_stress.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/phys_prop.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/check_energy.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/constituents.F90 +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/diffusion_solver.F90 +M models/atm/cam/src/physics/cam/ndrop.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/rad_constituents.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +M models/atm/cam/src/physics/cam/gw_drag.F90 +M models/atm/cam/src/physics/cam/phys_buffer.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/physics/cam/zm_conv.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/cloud_diagnostics.F90 +M models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +- changes in support of new cam5 physics + +M models/atm/cam/src/dynamics/sld/spegrd.F90 +M models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/sld/dyn_comp.F90 +M models/atm/cam/src/dynamics/sld/grmult.F90 +M models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/eul/lagyin.F90 +M models/atm/cam/src/dynamics/eul/sphdep.F90 +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 +M models/atm/cam/src/dynamics/eul/cubydr.F90 +M models/atm/cam/src/dynamics/fv/initcom.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/inital.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 +M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 +M models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 +M models/atm/cam/src/dynamics/fv/uv3s_update.F90 +M models/atm/cam/src/dynamics/fv/te_map.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +- changes made in support of dynamics changes (see above) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Tue Apr 27 21:40:53 MDT 2010 +019 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Tue Apr 27 22:00:13 MDT 2010 +034 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Tue Apr 27 22:37:02 MDT 2010 +038 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Tue Apr 27 22:56:00 MDT 2010 +042 bl375 TBL.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 7 at Tue Apr 27 23:20:40 MDT 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue Apr 27 23:40:52 MDT 2010 +049 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Tue Apr 27 23:57:19 MDT 2010 +057 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Wed Apr 28 00:34:35 MDT 2010 +- any baseline test using cam5 physics was expected to fail (bl137, bl332, bl337, bl371, bl375) +- bl374, bl387, and bl992 failed due to the fact that delta pressure (delp) is no longer being read from the + initial conditions file + +**additional tests using cam4 physics +2deg 1850 and 1850-2005 +1deg 1850 and 1850-2005 +2deg waccm 1850 and 1850-2005 +- 2-month tests vs baseline were b4b, when accounting for the fact that delta pressure (delp) is no longer being + read from the initial conditions file + +edinburgh/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue Apr 27 21:45:29 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue Apr 27 21:56:21 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..........................................FAIL! rc= 7 at Tue Apr 27 22:04:06 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue Apr 27 22:10:06 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue Apr 27 22:36:18 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue Apr 27 23:00:53 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 7 at Tue Apr 27 23:09:37 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 27 23:34:04 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Tue Apr 27 23:39:46 MDT 2010 +- any baseline test using cam5 physics was expected to fail (bl111, bl112, bl113, bl114, bl311, bl312, bl313, bl314) +- bl315 failed due to 1) round-off differences introduced in calculation of + condensate-to-rain autoconversion coefficient (c0) and 2) the fact that delta pressure (delp) + is no longer being read from the initial conditions file + +edinburgh/pgi: +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue Apr 27 17:08:20 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue Apr 27 17:13:58 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..........................................FAIL! rc= 7 at Tue Apr 27 17:18:45 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue Apr 27 17:20:24 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue Apr 27 17:30:19 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue Apr 27 17:38:10 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 7 at Tue Apr 27 17:42:53 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 27 17:49:13 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Tue Apr 27 17:53:02 MDT 2010 +- any baseline test using cam5 physics was expected to fail (bl111, bl112, bl113, bl114, bl311, bl312, bl313, bl314) +- bl315 failed due to 1) round-off differences introduced in calculation of + condensate-to-rain autoconversion coefficient (c0) and 2) the fact that delta pressure (delp) + is no longer being read from the initial conditions file + +jaguar: +004 bl157 TBL.sh e64m ghgrmp 9s ...........................................FAIL! rc= 7 at Wed Apr 28 11:15:15 EDT 2010 +006 bl158 TBL.sh e64pm aqpgro 3s ..........................................FAIL! rc= 7 at Wed Apr 28 11:15:17 EDT 2010 +009 bl159 TBL.sh e64am adia 9s ............................................FAIL! rc= 7 at Wed Apr 28 11:15:21 EDT 2010 +012 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Apr 28 11:15:29 EDT 2010 +015 bl372 TBL.sh f1.9m fvvp_lb2 9s ........................................FAIL! rc= 7 at Wed Apr 28 11:15:56 EDT 2010 +018 sm375 TSM.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 8 at Tue Apr 27 22:47:39 EDT 2010 +019 er375 TER.sh f1.9c5m outfrq24h+1850-2005_cam5 1+1d ....................FAIL! rc= 5 at Tue Apr 27 22:47:39 EDT 2010 +020 bl375 TBL.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 4 at Wed Apr 28 11:16:57 EDT 2010 +023 bl378 TBL.sh fm1.9m outfrq3s 9s .......................................FAIL! rc= 7 at Wed Apr 28 11:17:33 EDT 2010 +024 sm379 TSM.sh wm1.9m outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 8 at Tue Apr 27 22:54:29 EDT 2010 +025 er379 TER.sh wm1.9m outfrq3s+waccm_1850_cam4 4+5s .....................FAIL! rc= 5 at Tue Apr 27 22:54:29 EDT 2010 +026 bl379 TBL.sh wm1.9m outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 4 at Wed Apr 28 11:17:49 EDT 2010 +030 bl383 TBL.sh fma1.9m outfrq3s+1850_cam4_trop_bam 9s ...................FAIL! rc= 7 at Wed Apr 28 11:18:13 EDT 2010 +031 sm384 TSM.sh fmgpa1.9dm outfrq3s+1850_cam4 9s .........................FAIL! rc= 8 at Tue Apr 27 23:00:19 EDT 2010 +032 er384 TER.sh fmgpa1.9dm outfrq3s+1850_cam4 4+5s .......................FAIL! rc= 5 at Tue Apr 27 23:00:20 EDT 2010 +033 br384 TBR.sh fmgpa1.9dm outfrq3s+1850_cam4 6+3s .......................FAIL! rc= 5 at Tue Apr 27 23:00:31 EDT 2010 +034 bl384 TBL.sh fmgpa1.9dm outfrq3s+1850_cam4 9s .........................FAIL! rc= 4 at Wed Apr 28 11:18:28 EDT 2010 +037 bl386 TBL.sh f1.9c4m outfrq24h+1850_cam4 2m ...........................FAIL! rc= 7 at Wed Apr 28 11:22:08 EDT 2010 +- '375' '379' and '384' test failures are pre-existing +- any baseline test using cam5 physics was expected to fail (bl157, bl158, bl137, bl372, bl378, bl383) +- bl159 failed due to change in default cam initial conditions file being used +- bl386 failed due to either 1) round-off differences introduced in calculation of + condensate-to-rain autoconversion coefficient (c0) or 2) the fact that delta pressure (delp) + is no longer being read from the initial conditions file, or both (this was not investigated) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: +cam5: answers change due to new climate +cam4: the change to no longer read delp from the initial file may produce answers beyond round-off; the change + to the setting of the condensate-to-rain autoconversion coefficient (c0) from a scalar to a computation + introduces a round-off level difference on some compilers (for example, edinburgh w/pgi and w/lahey) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? +- cam5 answere are b4b with end of the development branch - see the ChangeLog file for branch camdev_cam3_6_23 for + validation details + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- see the ChangeLog file for branch camdev_cam3_6_23 for validation details + + +=============================================================== +=============================================================== + +Tag name: cam4_1_15 +Originator(s): Francis Vitt +Date: 26 Apr 2010 +One-line Summary: WACCM and CAM-Chem changes + +Purpose of changes: + + - correction to WACCM Fomichev code for time-dependent surface co2 + - bug fixes for dry deposition calculations over ocean and ice when CLM dry deposition is used + - give user the ability to turn on/off aerosol deposition fluxes to surface components + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/utils/ocnice_aero.F90 + caused errors in dry dep over ocean and ice + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/2000_cam4_super_fast_llnl.xml + new use case added + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure + impose cam5 physics restriction on all MAM chemistry packages + +M models/atm/cam/bld/build-namelist + - remove the ISOP emis from super_fast_llnl namelist when CLM MEGAN is used + - include trop_mam7 in with the 'atm_dep_flux' default namelist setting + - get default prescribed_aero settings unless prescribed_aero_file is specified + - set co2vmr for waccm unless scenario_ghg is 'RAMPED' + - set srf_emis_type='CYCLICAL' and srf_emis_ymd=19970101 unless srf_emis_type is specified + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - corrected spelling of 'category' + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml + - cldfrc_rhminl set to 0.90 + - specify scenario_ghg='RAMPED' and bndtvghg input file + - use IC file from 1850 control simulation + - use new solar_parms file which spans period from 1845-2008 + - added TROPP_FD diagnostic to h0 history + +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml + - use correct solar data input file + - cldfrc_rhminl set to 0.9225 + - added 1-degree volc vert emis files + - history fields added to fincl1 + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml + - cldfrc_rhminl set to 0.90 + - strat_aero_feedback=.true. added for volcanoes + +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml + - cleanup -- rearrange + +M models/atm/cam/src/control/camsrfexch_types.F90 + - initializing aero dep fluxes to shr_const_spval seems to have no effect -- this is removed + +M models/atm/cam/src/utils/time_manager.F90 + - work around for ESMF lib problem when time is negative + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 + - set driver atm_aero flag to atm_dep_flux cam namelist + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - corrections to dry dep over non-land regions + +M models/atm/cam/src/physics/waccm/nlte_lw.F90 +M models/atm/cam/src/physics/waccm/nlte_fomichev.F90 + - set matrice amat and bmat every timestep since co2vmr at the surface can be time-dependent + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Mon Apr 26 14:57:40 MDT 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Mon Apr 26 16:10:41 MDT 2010 + - these are expected failures due to changes in the waccm_1850_cam4 and 1850-2005_cam4_super_fast_llnl use cases + +edinburgh/lf95: all PASS + +edinburgh/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam4_1_14 +Originator(s): mvr +Date: Wed Apr 21 2010 +One-line Summary: updated externals of surface components to +those of ccsm4_0_beta48 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- update CLM datasets to be consistent with the clm3_7_10 tag + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- update CLM datasets to be consistent with the clm3_7_10 tag +M SVN_EXTERNAL_DIRECTORIES + M . +- updated external definitions + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 7 at Wed Apr 21 10:01:48 MDT 2010 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 7 at Wed Apr 21 10:11:11 MDT 2010 +015 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s ...............................FAIL! rc= 7 at Wed Apr 21 10:15:58 MDT 2010 +019 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 7 at Wed Apr 21 10:24:06 MDT 2010 +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s .......................FAIL! rc= 7 at Wed Apr 21 10:38:12 MDT 2010 +034 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ......................................FAIL! rc= 7 at Wed Apr 21 10:45:25 MDT 2010 +038 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .....................................FAIL! rc= 7 at Wed Apr 21 10:57:47 MDT 2010 +042 bl375 TBL.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 7 at Wed Apr 21 11:13:11 MDT 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Wed Apr 21 11:13:21 MDT 2010 +049 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 7 at Wed Apr 21 11:13:31 MDT 2010 +057 bl992 TBL_ccsm.sh f19_g16 E 2d ........................................FAIL! rc= 7 at Wed Apr 21 11:13:38 MDT 2010 +- baselines (other than aquaplanet, ideal physics, adiabatic) were expected to fail due to change in clm and cice + +edinburgh/lf95: all PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue Apr 20 16:45:42 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue Apr 20 16:45:43 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue Apr 20 16:45:46 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue Apr 20 16:45:47 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue Apr 20 16:45:48 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 20 17:11:02 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Tue Apr 20 17:16:49 MDT 2010 +- baselines (other than aquaplanet, ideal physics, adiabatic) were expected to fail due to change in clm and cice + +edinburgh/pgi: all PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .........................................FAIL! rc= 7 at Tue Apr 20 13:02:10 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...........................................FAIL! rc= 7 at Tue Apr 20 13:08:08 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...........................................FAIL! rc= 7 at Tue Apr 20 13:15:38 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 7 at Tue Apr 20 13:29:08 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 7 at Tue Apr 20 13:37:28 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 7 at Tue Apr 20 13:49:42 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 7 at Tue Apr 20 13:53:19 MDT 2010 +- baselines (other than aquaplanet, ideal physics, adiabatic) were expected to fail due to change in clm and cice + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: larger than roundoff but same climate - see clm ChangeLog for details + + +=============================================================== +Tag name: cam4_1_13 +Originator(s): mvr +Date: Tue Apr 20 2010 +One-line Summary: corrected solar input file for use_cases with super_fast chem; +fix for pio bug introduced with previous tag; enhancement/cleanup of test scripts; +updated run template scripts and added one for cray xt's + +test scripts/files were modified to: +- enhance testing of eul dycore at T31 +- explicitly test cam5 physics rather than relying on default +- explicitly test cam4 physics (replacing cam3_5_1) +- add mpi-only tests to bluefire + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none +- new solar input files for super_fast chemistry + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/e32c4pdm +D models/atm/cam/test/system/config_files/f4idh +D models/atm/cam/test/system/config_files/e64h +D models/atm/cam/test/system/config_files/e32adh +D models/atm/cam/test/system/config_files/e32idh +D models/atm/cam/test/system/config_files/f4dh +D models/atm/cam/test/system/config_files/f1.9c4dh +D models/atm/cam/test/system/config_files/f1.9c351h +D models/atm/cam/test/system/config_files/f1.9c351m +D models/atm/cam/test/system/config_files/e32c4dh +D models/atm/cam/test/system/tests_posttag_lightning +- removed test files that were no longer being used + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/e48c4pdm +A models/atm/cam/test/system/config_files/e48c4dh +A models/atm/cam/test/system/config_files/f4idm +A models/atm/cam/test/system/config_files/e48m +A models/atm/cam/test/system/config_files/f4c5dm +A models/atm/cam/test/system/config_files/s48dh +A models/atm/cam/test/system/config_files/f4dm +A models/atm/cam/test/system/config_files/s48adh +A models/atm/cam/test/system/config_files/s48idh +A models/atm/cam/test/system/config_files/f1.9c4h +A models/atm/cam/test/system/config_files/f1.9c4m +A models/atm/cam/test/system/config_files/f1.9c4dm +A models/atm/cam/test/system/config_files/e48c5h +A models/atm/cam/test/system/config_files/e48adh +A models/atm/cam/test/system/config_files/f1.9c5m +A models/atm/cam/test/system/config_files/e48idh +A models/atm/cam/test/system/config_files/s48pdh +- new files to be used by test scripts + +A models/atm/cam/test/system/CAM_decomp.sh +- new test utility to build fv 2d decomp string if required for test (needed to + enable broader testing of mpi-only configurations) + +A models/atm/cam/bld/run-cray.csh +- new run template script for cray platforms + +A models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam5.xml +A models/atm/cam/bld/namelist_files/use_cases/1850_cam5.xml +- new use_cases brought over from cam5 branch to enable testing + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/tests_posttag_jaguar_cb +M models/atm/cam/test/system/tests_posttag_jaguar +M models/atm/cam/test/system/tests_posttag_calgary +M models/atm/cam/test/system/tests_pretag_calgary +- modified to reflect changes in test names + +M models/atm/cam/test/system/TCB.sh +- hardwired cice_maxblocks=4 to enable testing a wide variety of configurations + while limiting the number of model builds + +M models/atm/cam/test/system/config_files/wm4c4h +M models/atm/cam/test/system/config_files/wm4dh +M models/atm/cam/test/system/config_files/wm1.9m +M models/atm/cam/test/system/config_files/wg10dm +- explicitly set dycore to fv - was relying on the default + +M models/atm/cam/test/system/TSM.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +- now calls CAM_decomp.sh to build fv 2d decomp string for namelist if needed + +M models/atm/cam/test/system/TPF.sh +- change to how test results are written to log file + +M models/atm/cam/test/system/test_driver.sh +- edinburgh now tests on 8tsks; jaguar now tests on 64 processors and default version of + pgi compilers; modified format of test results + +M models/atm/cam/test/system/input_tests_master +- modified with new test definitions + +M models/atm/cam/test/system/CAM_runcmnd.sh +- improved how hybrid runs are set up for testing; improved the changing of tasks/threads + on restart tests + +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-ibm.csh +- updated run template scripts to work with recent changes to model + +MM models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +- fix for use_cases using super_fast chemistry to use correct solar input file + +M models/atm/cam/src/utils/cam_dom/sst_data.F90 +- fix for pio bug introduced with previous tag + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +004 bl132 TBL.sh e48c4dh ghgrmp+1850_cam4 9s ..............................FAIL! rc= 5 at Tue Apr 20 09:01:21 MDT 2010 +006 bl133 TBL.sh e48c4pdm aqpgro 3s .......................................FAIL! rc= 5 at Tue Apr 20 09:01:21 MDT 2010 +009 bl134 TBL.sh e48adh adia 9s ...........................................FAIL! rc= 5 at Tue Apr 20 09:01:22 MDT 2010 +011 bl137 TBL.sh e48c5h outfrq24h 2d ......................................FAIL! rc= 5 at Tue Apr 20 09:01:23 MDT 2010 +019 bl332 TBL.sh f4c5dm ghgrmp+1850_cam5 9s ...............................FAIL! rc= 5 at Tue Apr 20 09:01:24 MDT 2010 +028 bl335 TBL.sh f4idm idphys 9s ..........................................FAIL! rc= 5 at Tue Apr 20 09:01:25 MDT 2010 +042 bl375 TBL.sh f1.9c5m outfrq24h+1850-2005_cam5 2d ......................FAIL! rc= 5 at Tue Apr 20 09:55:11 MDT 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s .....FAIL! rc= 7 at Tue Apr 20 10:14:54 MDT 2010 +049 bl387 TBL.sh f1.9c4dm outfrq3s+1850-2005_cam4 9s ......................FAIL! rc= 5 at Tue Apr 20 10:27:22 MDT 2010 +- bl374 failed due to new solar input file for super_fast chemistry +- all other baselines failures were due to them being new tests where the configuration was not recognizable in + the baseline test scripts + +edinburgh/lf95: all PASS except +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 5 at Mon Apr 19 17:58:14 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 5 at Mon Apr 19 18:16:56 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 5 at Mon Apr 19 18:24:09 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 5 at Mon Apr 19 18:43:13 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 5 at Mon Apr 19 18:48:00 MDT 2010 +- baselines at 10x15 failed due to baseline test scripts not having new functionality to build fv 2d decomp namelist setting + +edinburgh/pgi: all PASS except +021 bl311 TBL.sh f10t5mdm ttrac 9s ........................................FAIL! rc= 5 at Mon Apr 19 17:28:51 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..........................................FAIL! rc= 5 at Mon Apr 19 17:36:04 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .........................................FAIL! rc= 5 at Mon Apr 19 17:41:24 MDT 2010 +034 bl314 TBL.sh wg10dm outfrq3s 9s .......................................FAIL! rc= 5 at Mon Apr 19 17:47:14 MDT 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ......................................FAIL! rc= 5 at Mon Apr 19 17:50:43 MDT 2010 +- baselines at 10x15 failed due to baseline test scripts not having new functionality to build fv 2d decomp namelist setting + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, except for super_fast chemistry + + +=============================================================== + +Tag name: cam4_1_12 +Originator(s): Jim Edwards +Date: 04-14-2010 +One-line Summary: chem port to pio, homme restart fix + +Purpose of changes: Removing depreciated wrap_nf code and + replacing it with pio. + +Bugs fixed (include bugzilla ID): homme restart was not bfb when + task count changed after restart + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/src/utils/cam_dom/ocn_spmd.F90 + models/atm/cam/src/utils/cam_dom/sst_data.F90 + models/atm/cam/src/utils/cam_dom/ocn_comp.F90 + models/atm/cam/src/chemistry/utils/solar_data.F90 + models/atm/cam/src/chemistry/mozart/chlorine_loading_data.F90 + models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + models/atm/cam/src/chemistry/mozart/mo_photoin.F90 + models/atm/cam/src/chemistry/mozart/spedata.F90 + models/atm/cam/src/chemistry/mozart/mo_seto2.F90 + models/atm/cam/src/chemistry/mozart/mo_jshort.F90 + models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 + models/atm/cam/src/chemistry/mozart/mo_snoe.F90 + models/atm/cam/src/chemistry/mozart/euvac.F90 + models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + models/atm/cam/src/chemistry/mozart/iondrag.F90 + models/atm/cam/src/chemistry/mozart/mo_photo.F90 + models/atm/cam/src/chemistry/mozart/mo_tuv_inti.F90 + models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + models/atm/cam/src/dynamics/fv/metdata.F90 + + replaced serial netcdf io functions with pio equivalents. + + + models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + + replaced an internal homme global average function with the + task count independent cam version in repro_sum_mod + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except + 052 bl731 TBL.sh h16x4dm aqua 9s + due to roundoff level change in global sum calculation + +edinburgh/lf95: all pass + +calgary/pgi or jaguar/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_1_11 +Originator(s): fvitt, aconley +Date: 12 Apr 2010 +One-line Summary: Correction to the solar spectral scaling in CAMRT used by WACCM. + +Purpose of changes: + + Corrected solar band spectral scaling in CAMRT used in WACCM + and super_fast_llnl simulations. Added history fields for + off-line radiation calculations. Band-level scaling is now + computed relative to a reference spectrum of 4 solar cycles + rather than a reference from the CAMRT code. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Namelist variable "solar_htng_spctrl_scl" added. This is a switch that can be used to + turn on/off the solar band spectral heating. This is set to TRUE by default for waccm_mozart + or when radiation package is RRTMG, otherwise it is set to FALSE + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/rrtmg/rad_solar_var.F90 + Manages the solar spectral scaling specific to RRTMG radiation package. + This is the same as the previous version, just moved to the rrtmg directory. + Band level scaling in RRTMG continues to be relative to the base Kurucz + spectrum assumed by RRTMG. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist + - solar_cnst explicitly set to -9999. when solar_data_file is specified + - namelist var solar_htng_spctrl_scl to TRUE for waccm_mozart or when rad package is rrtmg + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - change in default solar_data_file for waccm_mozart + - solar_photons_files default setting removed + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - solar_htng_spctrl_scl namelist variable added + - rad_data_avgflag namelist variable added + - rad_data_output and rad_data_histfile_num namelist variables moved from rad_cnst_nl to rad_data_nl + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml + - change in solar_data_file input for these waccm use cases + +M models/atm/cam/src/control/runtime_opts.F90 + - rad_data_readnl call added + +M models/atm/cam/src/physics/cam/radiation.F90 + - init_rad_data moved from physpkg + - output_rad_data call moved from tphysbc + - FSDTOA diagnostic field added to history + +M models/atm/cam/src/physics/cam/tphysbc.F90 + - output_rad_data call moved to radiation.F90 + +M models/atm/cam/src/physics/cam/radsw.F90 + - calculate the column value of the fsdtoa diagnostic field + - correction to the solar band scaling + +M models/atm/cam/src/physics/cam/radconstants.F90 + - wavemin_true data added + - correction to the get_sw_spectral_boundaries subroutine + +M models/atm/cam/src/physics/cam/radiation_data.F90 + - output of the rad constituents moved from rad_constituents + - solar zeneth weighted surface fields added + - code cleanup + +M models/atm/cam/src/physics/cam/physpkg.F90 + - init_rad_data moved to radiation.F90 + +M models/atm/cam/src/physics/cam/rad_constituents.F90 + - output of the rad constituents moved to radiation_data.F90 + - rad_data_output and rad-data_histfile_num namelist vars moved to radiation_data + - rad_cnst_get_clim_info subroutine was extended to provide more information + +M models/atm/cam/src/physics/cam/rad_solar_var.F90 + - reference spectrum used in the solar band scaling is now based on a + reference spectrum provided in the solar input dataset rather than a spectrum + provided by CAMRT + - set band scaling factors to 1.0 for TSI solar heating + +M models/atm/cam/src/physics/rrtmg/radiation.F90 + - init_rad_data moved from physpkg + - output_rad_data call moved from tphysbc + +M models/atm/cam/src/chemistry/utils/mo_util.F90 + - constant "0." changed to "0._r8" + +M models/atm/cam/src/chemistry/utils/solar_data.F90 + - solar_htng_spctrl_scl namelist variable added. This is a switch that can be used to + turn on/off the solar band spectral heating. + - endrun called if both solar_const and solar_data_file are both specified + - read both tsi and ssi if the input dataset contains both + - read in a reference spectrum (ref_ssi) and reference TSI (ref_tsi) + - correction to the units of the solar photon fluxes used by photolysis + +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 + - comments added to clearly specify units of the input solar fluxes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s ...............FAIL! rc= 7 + This is an expected failure due to changes in the band-level solar spectral scaling in + CAMRT for waccm_mozart. + +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s FAIL! rc= 7 + This is an expected failure due to change to use of TSI in CAMRT heating rather than + band-level solar spectral scaling for super_fast_llnl chemistry configuration. + +edinburgh/lf95: + +td.1285.status:034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + This is an expected failure due to change to use of TSI in CAMRT heating rather than + band-level solar spectral scaling for waccm_ghg chemistry configuration. + +edinburgh/pgi: +td.1282.status:034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + This is an expected failure due to change to use of TSI in CAMRT heating rather than + band-level solar spectral scaling for waccm_ghg chemistry configuration. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_1_10 +Originator(s): eaton +Date: Fri Apr 9 09:47:41 MDT 2010 +One-line Summary: update for carbon cycle runs + +Purpose of changes: + +. Updates to configure and build-namelist to facilitate "out of the box" + capability for carbon cycle runs. When the configure option -co2_cycle + is set, build-namelist will by default set the flags to turn on the + co2_cycle code in CAM (adds 4 tracers) and will set the flag to read the + fossil fuel emissions dataset. Note that the code that reads the + emission dataset doesn't do any spatial interpolation. We currently only + have the required dataset at fv 0.9x1.25 resolution. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. add default fossil fuel emissions dataset: + inputdata/atm/cam/ggas/co2flux_fossil_1751-2006-monthly_0.9x1.25_c20100204.nc + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/configure +. remove the check that only allows the -co2_cycle option to be specified + with -ccsm_seq. This option can be run in standalone mode to test the + emission and flux datasets. + +models/atm/cam/bld/build-namelist +. add section to set defaults for co2_flag, co2_readflux_fuel, and + co2flux_fuel_file when co2_cycle is true. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default for co2flux_fuel_file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS. + +edinburgh/lf95: All PASS. + +edinburgh/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam4_1_09 +Originator(s): eaton +Date: Wed Apr 7 16:51:52 MDT 2010 +One-line Summary: add rcp26 and rcp45 use cases; change default fields on + initial file; misc cleanup + +Purpose of changes: + +. Add use cases for rcp2.6 and rcp4.5 runs. + +. Change default value of inithist_all to .false.. This affects the + writing of extra fields to the initial file that are used in CAPT + experiments. + +. Change some defaults in the FV communications per recommendation of Pat + Worley. + +. Misc cleanup. + +Bugs fixed (include bugzilla ID): + +. Fix build-namelist deal correctly with the case when both -ignore_ic_year + and -ignore_ic_date are specified. You now get the -ignore_ic_date + behavior from this setting. This fix was needed for ncdata. It was + implemented correctly for finidat (used by cam standalone). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Change default value of inithist_all to .false.. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp26.xml +models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp45.xml +. update the GHG, aerosol, and ozone datasets + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/cam.cpl7.template +. change \$BLDROOT/Makefile to \$CASETOOLS/Makefile. (requested by Tony) + +models/atm/cam/bld/configure +. add check_fc test +. don't try to run esmf test in spmd mode + +models/atm/cam/bld/Makefile.in +. remove old platforms: nec-sx6, cray-x1, earth_simulator + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. change documentation for inithist_all default to .false. +. change "catagory" to "category". +. remove bndtvsf6 + +models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm +. change "catagory" to "category". + +models/atm/cam/src/control/filenames.F90 +. remove bndtvsf6 + +models/atm/cam/src/control/ncdio_atm.F90 +. change "warning" to "info" in logfile message. + +models/atm/cam/src/control/runtime_opts.F90 +. change documentation for inithist_all default to .false. +. remove bndtvsf6 + +models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. only add DELP to IC file when inithist_all is true. + +models/atm/cam/src/dynamics/fv/inidat.F90 +. don't issue warning if DELP isn't found on IC file + +models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +. change default of modc_onetwo from 1 to 2. +. change default of modc_tracers from 0 to 3. + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. change default for inithist_all to .false. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS. + +edinburgh/lf95: All PASS. + +edinburgh/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam4_1_08 +Originator(s): Francis Vitt +Date: 19 March 2010 +One-line Summary: WACCM features added and bug fixes + +Purpose of changes: + +Added new features and bug fixes: + - 'INTERP_MISSING_MONTHS' capability added to WACCM upper boundary + - new WACCM QBO capability added + - fix a bug in the turbulent mountain stress (TMS) module + - fix for QBO problem introduced in cam4_1_05 (uzm was not set) + - fix a bug in CLY family diagnostic + - switch added to age of air tracers to read from IC file + - clean up of waccm use cases + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/namelist_files/use_cases/waccm_1953_ramped_qbo.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1995_climo.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smin.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smax.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smin.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smax.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1950_ramped.xml + cleaned out deprecated waccm use cases + +D models/atm/cam/src/chemistry/mozart/mo_drydep_tables.F90 + this was duplicated in the drv/shr code and is no longer needed + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +U models/atm/cam/SVN_EXTERNAL_DIRECTORIES + update in the chemistry pre-processor + +U models/atm/cam/bld/build-namelist + change default waccm_ghg namelist settings + +U models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + tgcm upper boundary file name change + +U models/atm/cam/bld/namelist_files/namelist_definition.xml + age of air tracer namelist option added + +U models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +U models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +U models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +U models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml + waccm use cases corrections + +U models/atm/cam/src/physics/waccm/qbo.F90 +U models/atm/cam/src/control/wrap_nf.F90 + functionality added to QBO code to operate over long time spans + +U models/atm/cam/src/physics/cam/molec_diff.F90 + +U models/atm/cam/src/physics/cam/trb_mtn_stress.F90 + TMS bug fix + +U models/atm/cam/src/chemistry/mozart/chemistry.F90 +U models/atm/cam/src/physics/cam/vertical_diffusion.F90 +U models/atm/cam/src/physics/waccm/nlte_lw.F90 +U models/atm/cam/src/physics/cam/advnce.F90 +U models/atm/cam/src/physics/cam/upper_bc.F90 +U models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 + ability to interpolate over long time spans added to upper boundary + +U models/atm/cam/src/physics/cam/aoa_tracers.F90 + namelist option added + + +U models/atm/cam/src/chemistry/utils/tracer_data.F90 +U models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 + bug fix in CLY diagnostic + +U models/atm/cam/src/dynamics/fv/ctem.F90 +U models/atm/cam/src/dynamics/fv/dp_coupling.F90 + changes needed for QBO bug fix introduced in cam4_1_05 + +U models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + - bug fixes and code clean up + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 at Fri Mar 19 12:11:59 MDT 2010 +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s ...............FAIL! rc= 7 at Fri Mar 19 12:35:46 MDT 2010 +034 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ..............................FAIL! rc= 7 at Fri Mar 19 12:48:13 MDT 2010 +038 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .............................FAIL! rc= 7 at Fri Mar 19 13:06:04 MDT 2010 +042 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Fri Mar 19 13:28:04 MDT 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s FAIL! rc= 7 at Fri Mar 19 13:48:08 MDT 2010 +These are expected failures. The waccm baseline fails due to change in upper boundary code and dry deposition. +The other chemistry configurations fail due to change in dry deposition. + +edinburgh/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Fri Mar 19 11:26:34 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Fri Mar 19 11:32:21 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 at Fri Mar 19 11:38:23 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Fri Mar 19 11:40:10 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Fri Mar 19 11:50:58 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Fri Mar 19 11:59:49 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 at Fri Mar 19 12:04:56 MDT 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Fri Mar 19 12:18:26 MDT 2010 +These are expected failures. The chemistry configurations fail the baseline tests due to change in dry deposition. + +edinburgh/pgi: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Fri Mar 19 11:26:34 MDT 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Fri Mar 19 11:32:21 MDT 2010 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 at Fri Mar 19 11:38:23 MDT 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Fri Mar 19 11:40:10 MDT 2010 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Fri Mar 19 11:50:58 MDT 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Fri Mar 19 11:59:49 MDT 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 at Fri Mar 19 12:04:56 MDT 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Fri Mar 19 12:18:26 MDT 2010 +These are expected failures. The chemistry configurations fail the baseline tests due to change in dry deposition. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_1_07 +Originator(s): eaton +Date: Sat Mar 13 11:33:42 MST 2010 +One-line Summary: add dust tuning param to namelist; misc configure/build-namelist mods + +Purpose of changes: + +. Make the dust emission tuning parameter namelist accessable. + +. Modify the dust emission tuning parameter for trop_bam only. + +. Remove any remaining references to track1 from the CAM regression + tests. + +. The CLM deposition velocity calc is a runtime setting. Remove the switch + from configure and require it to be set via build-namelist. + +. Add error trapping in build-namelist to protect against the user setting + tms_orocnst without setting do_tms. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +. Add dust_emis_fact to new namelist group aerosol_nl. This is the dust + emissions tuning factor. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/input_tests_master +. replace track1 by cam4 (use case names have previously been updated) + +M models/atm/cam/bld/configure +. remove -lnd_drydep switch +. change -lnd_vocsrc to -clm_vocsrc, and only process when land model is + CLM. +. made verbose mode output more consistent. + +M models/atm/cam/bld/config_files/definition.xml +. remove lnd_drydep +. change lnd_vocsrc to clm_vocsrc + +M models/atm/cam/bld/build-namelist +. add dust_emis_fact to namelist when dust is prognostic -- default value + depends on the value of do_tms +. change lnd_vocsrc to clm_vocsrc +. remove dependence of drydep_method on the lnd_drydep configure parameter + which was removed. The default for drydep_method is set in + namelist_defaults_cam.xml. To use deposition velocities from CLM the + user specifies drydep_method='xactive_lnd' in the namelist. +. add check that do_tms has been set if tms_oroconst has been set. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default values for dust_emis_fact -- allow them to depend on attribute tms +. add default for drydep_method + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. add dust_emis_fact to namelist group aerosol_nl +. move soil_erod to namelist group aerosol_nl + +M models/atm/cam/src/control/filenames.F90 +. remove soil_erod from module data + +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. add log output for do_tms and tms_orocnst + +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +. fixed log output to only be written from masterproc + +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +. declare namelist variables as module data +. set namelist variables by passing them through the arg list of + dust_initialize. +. add soil_erod to module data +. set namelist variables by passing them through the arg list of + dust_initialize. +. in dust_emis_intr set the variable "fact" from the namelist setting + dust_emis_fact. Remove conditional logic for setting fact since this + will now be done by build-namelist. + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +. declare namelist variables as module data +. add aerosol_readnl to read namelist group aerosol_nl +. add soil_erod to module data and to namelist group aerosol_nl +. add soil_erod to calling args for dust_initialize + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +. call aerosol_readnl from the chem_readnl method +. remove soil_erod from chem_inparm namelist group + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except trop_bam + +=============================================================== +=============================================================== + +Tag name: cam4_1_06 +Originator(s): eaton +Date: Tue Mar 9 08:08:52 MST 2010 +One-line Summary: finish "track1" to "cam4" conversion; update externals + +Purpose of changes: + +. Finish cleanup of use cases that contain "track1" in name. All + references to "track1" have been replaced by "cam4". + +. comment out the 'dpcoup dqreq' and 'dpcoup cant adjust' log messages. + They're making the output log file unusable. + +. remove old utilities for SOM and reduced grid + +. update externals + +. update the ccsm build template to recognize the USE_MPISERIAL environment + variable set by the ccsm scripts + +Bugs fixed (include bugzilla ID): + +. change attribute "cell_method" to "cell_methods" to be compliant with CF + conventions. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/bld/namelist_files/use_cases/1850_track1_2xco2.xml +models/atm/cam/bld/namelist_files/use_cases/1850_track1_super_fast_llnl.xml +. moved to "cam4" versions + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +. deleted (cam4 versions already exist) + +models/atm/cam/tools/definemld/* +models/atm/cam/tools/defineqflux/* +. old SOM utilities + +models/atm/cam/tools/mkrgrid/* +models/atm/cam/tools/mkrgridnew/* +models/atm/cam/tools/mkrgridsst/* +. old reduced grid utilities + +models/ice/csim4/* +. move to models/atm/cam/src/utils/cam_csim4/* + +models/ocn/dom/* +. move to models/atm/cam/src/utils/cam_dom/* + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/waccm_1974-2005_cam4.xml +. new waccm use case + +models/atm/cam/bld/namelist_files/use_cases/1850_cam4_2xco2.xml +models/atm/cam/bld/namelist_files/use_cases/1850_cam4_super_fast_llnl.xml +. moved from "track1" versions + +models/atm/cam/src/utils/cam_csim4/* +. moved from models/ice/csim4/* + +models/atm/cam/src/utils/cam_dom/* +. moved from models/ocn/dom/* + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. drvseq3_1_18 --> drvseq3_1_19 + MCT2_7_0_100106 --> MCT2_7_0_100228 + pio1_0_12 --> pio1_0_15 + scripts4_100225 --> scripts4_100306 + +models/atm/cam/bld/cam.cpl7.template +. add logic to recognize USE_MPISERIAL env var and set -nospmd arg to + configure when it's value is 'TRUE'. + +models/atm/cam/bld/configure +. change the filepaths for dom and csim4 +. remove unused arg esmf_libvers + +models/atm/cam/src/control/cam_history.F90 +. change attribute "cell_method" to "cell_methods" to be compliant with CF + conventions. + +models/atm/cam/src/control/runtime_opts.F90 +. Put log output for divdampn inside conditional logic so it's only written + to the logfile for the spectral dycores. + +models/atm/cam/src/dynamics/fv/dp_coupling.F90 +. comment out the 'dpcoup dqreq' and 'dpcoup cant adjust' log messages. + They're making the output log file unusable. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam4_1_05 +Originator(s): Francis Vitt +Date: 8 Mar 2010 +One-line Summary: Added features and misc code cleanup + +Purpose of changes: + +Features added: + - ability to use CLM generated MEGAN VOC emissions + - ability to use CLM generated dry deposition velocities + - ability to read in prescribed aerosol deposition fluxes + to be passed to surface models via the coupler + - ability to use the WACCM age-of-air diagnostic tracers + in any configuration + - ability to use the WACCM TEM circulation diagnostics in + non-WACCM configurations that use the finite-volume dycore + - ability to output data fields need for offline radiation + calculations + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/physics/waccm/tracers.F90 +D models/atm/cam/src/physics/waccm/ctem.F90 + these were moved so that they can be made available outside of waccm + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/cam/aoa_tracers.F90 + waccm age-of-air tracers moved make available outside of waccm + +A models/atm/cam/src/physics/cam/radiation_data.F90 + module added to output field for offline radiation calculations + +A models/atm/cam/src/chemistry/utils/ocnice_aero.F90 + utility module added to compute surface aerodynamic quatities for + dry deposition + +A models/atm/cam/src/chemistry/utils/aerodep_flx.F90 + used to read in precribed aerosol deposition fluxes + +A models/atm/cam/src/dynamics/fv/ctem.F90 + waccm TEM diagnostics moved make available outside of waccm + +List all existing files that have been modified, and describe the changes: + +U models/atm/cam/bld/config_files/definition.xml +U models/atm/cam/bld/configure + configure options added: + -[no]age_of_air_trcs + -lnd_vocsrc + -lnd_drydep + +U models/atm/cam/bld/build-namelist + changed needed for WACCM TEM diagnostics, age-of-air, MEGAN VOCs and dry depostion + +U models/atm/cam/bld/namelist_files/namelist_definition.xml + namelist variables added: + do_circulation_diags + rad_data_output + rad_data_histfile_num + aoa_tracers_flag + aerdep_flx_* + +U models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +U models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +U models/atm/cam/bld/namelist_files/use_cases/1850_cam4.xml + added TEM diagnostics + +U models/atm/cam/src/control/runtime_opts.F90 + cleanup - the presrcibed_* utility data modules now read there own namelist + +U models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +U models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +U models/atm/cam/src/control/camsrfexch_types.F90 + mods to receive the CLM generated VOC emissions and dry dep velocities + +U models/atm/cam/src/control/cam_restart.F90 +U models/atm/cam/src/control/cam_comp.F90 +U models/atm/cam/src/dynamics/fv/dp_coupling.F90 +U models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +U models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +U models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +U models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +U models/atm/cam/src/dynamics/fv/dyn_comp.F90 +U models/atm/cam/src/dynamics/fv/inital.F90 + mods for TEM diagnostics initialization + +U models/atm/cam/src/physics/cam/tropopause.F90 +U models/atm/cam/src/physics/cam/radiation.F90 +U models/atm/cam/src/physics/cam/radsw.F90 +U models/atm/cam/src/physics/cam/radconstants.F90 +U models/atm/cam/src/physics/cam/radlw.F90 + cleanup + fixed threading bug in calculation of SOLIN diagnostic + +U models/atm/cam/src/physics/cam/rad_constituents.F90 +U models/atm/cam/src/physics/cam/tphysbc.F90 + mods to output radiation data for offline calculations + +U models/atm/cam/src/physics/cam/physpkg.F90 + changes in initialization + +U models/atm/cam/src/physics/cam/advnce.F90 + advances aoa_tracers and aerodep_flx modules added + +U models/atm/cam/src/physics/cam/tphysac.F90 + aoa_tracers tendancies invoked + +U models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +U models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +U models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +U models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 + these read their own namelists to set options + +U models/atm/cam/src/chemistry/utils/tracer_data.F90 + path90 compilier bug fix + +U models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +U models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +U models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +U models/atm/cam/src/chemistry/mozart/chemistry.F90 + changes to make use of the CLM generated dry deposition velocities + +U models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + code cleanup + +U models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + changes to make use of the CLM generated MEGAN VOC emissions + +U models/atm/cam/src/dynamics/sld/inidat.F90 +U models/atm/cam/src/dynamics/eul/inidat.F90 +U models/atm/cam/src/dynamics/homme/inidat.F90 +U models/atm/cam/src/dynamics/fv/inidat.F90 +U models/atm/cam/src/physics/cam/initindx.F90 + changes for age-of-air tracers + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +edinburgh/lf95: All PASS + +edinburgh/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam4_1_04 +Originator(s): eaton +Date: Mon Mar 1 14:23:48 MST 2010 +One-line Summary: update externals; update rcp8.5 use case + +Purpose of changes: + +. update externals to match ccsm4_0_beta45 + +. update the solar and ghg files in the rcp8.5 use case + +. Move the pilgrim directory location so that CCSM tags don't need to + explicitly declare pilgrim to be an external. It will now automatically + come with the declared CAM tag. Since pilgrim is maintained as part of + CAM, this change enforces the consistency between pilgrim and CAM tags + that is already implicitly assumed by the development process. + +. misc cleanup + +Bugs fixed (include bugzilla ID): + +. There was a bug in share code that caused incorrect interpolation of + annual cycle datasets when the model start date was 101. This code was + only being used by CICE in prescribed mode for the interpolation of ice + fraction. CAM inherited the fix by updating the share external. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. CLM datasets updated with the new external. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/utils/pilgrim/* +. pilgrim directory moved to models/atm/cam/src/utils + +List all subroutines added and what they do: + +models/atm/cam/src/utils/pilgrim/* +. pilgrim directory moved from models/utils/ + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. drvseq3_1_16 --> drvseq3_1_18 + clm3_6_63 --> clm3_7_05 + cice4_0_20100105 --> cice4_0_20100222 + docn8_100103 --> docn8_100124 + share3_091217 --> share3_100228 + timing_090929 --> timing_091021 + scripts4_100112b --> scripts4_100225 + +models/atm/cam/bld/cam.cpl7.template +. remove the atm_in and atm_in.tmp file once they're no longer needed + (after the cam.buildnml.csh script is complete). + +models/atm/cam/bld/configure +. update filepath for pilgrim: + models/utils/pilgrim --> models/atm/cam/src/utils/pilgrim + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update CLM datasets to be consistent with the clm3_7_05 tag + +models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +. update solar and ghg files + +models/atm/cam/src/control/cam_comp.F90 +. remove superfluous declaration and setting of dtime in cam_final. + +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +. fix the comment in atm_run_mct about looping over the radiation interval. + Should say looping over atm coupling interval. + +models/atm/cam/src/physics/cam/radsw.F90 +. remove unused JPE_VMATH ifdefs + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e32c4dh ghgrmp+1850_cam4 9s ......................FAIL! rc= 7 at Fri Feb 26 19:16:35 MST 2010 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 at Fri Feb 26 19:36:47 MST 2010 +015 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s .......................FAIL! rc= 7 at Fri Feb 26 19:43:58 MST 2010 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 at Fri Feb 26 19:59:01 MST 2010 +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s ...............FAIL! rc= 7 at Fri Feb 26 20:24:58 MST 2010 +034 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ..............................FAIL! rc= 7 at Fri Feb 26 20:36:28 MST 2010 +038 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .............................FAIL! rc= 7 at Mon Mar 1 10:36:21 MST 2010 +042 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Mon Mar 1 10:52:18 MST 2010 +057 bl992 TBL_ccsm.sh f19_g16 E 2d ................................FAIL! rc= 5 at Fri Feb 26 22:28:50 MST 2010 + +bl132, bl151, bl331, bl332, bl336, bl337 fail due to updating the fsurdat files +at resolutions other than fv 1 and 2 deg. + +bl151, bl337, bl371, bl375 fail due to fixing the bug in share code that +was giving incorrect results for runs with start dates of 101. + +bl992 fails due to a pre-existing failure of the build in the previous +tag. + +edinburgh/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Fri Feb 26 18:56:30 MST 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Fri Feb 26 18:59:52 MST 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Fri Feb 26 19:03:41 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Mon Mar 1 11:31:37 MST 2010 + +edinburgh/pgi: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Fri Feb 26 19:07:59 MST 2010 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Fri Feb 26 19:21:32 MST 2010 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Fri Feb 26 19:39:55 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Mon Mar 1 09:52:21 MST 2010 + +bl111, bl112, bl114 fail due to updating the fsurdat files +at resolutions other than fv 1 and 2 deg. + +bl317 fails due to fixing the bug in share code that was giving incorrect +results for runs with start dates of 101. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except configs using new CLM datasets +(updated CLM tag) and runs starting on 101 (bug fix in share code). + +=============================================================== +=============================================================== + +Tag name: cam4_1_03 +Originator(s): Jim Edwards, Mark Taylor, Pat Worley +Date: 2/23/2010 +One-line Summary: Homme dycore update, pio netcdf4 support + +Purpose of changes: Homme dycore development, unstructured grid support + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + cam_trunk/SVN_EXTERNAL_DIRECTORIES + Updated pio external + cam_trunk/models/atm/cam/SVN_EXTERNAL_DIRECTORIES + Updated cprnc to the same as used by ccsm + cam_trunk/models/atm/cam/bld/build-namelist + cam_trunk/models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + Namelist cleanup for the homme dycore + cam_trunk/models/atm/cam/src/chemistry/mozart/mo_airplane.F90 + cam_trunk/models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + Replaced wrap_nf with pio. + cam_trunk/models/atm/cam/src/chemistry/utils/tracer_data.F90 + cam_trunk/models/atm/cam/src/physics/cam/modal_aer_opt.F90 + Replaced pio_noclobber with pio_nowrite, this change was required for + some netcdf4 versions + cam_trunk/models/atm/cam/src/control/cam_history.F90 + Removed dead code + cam_trunk/models/atm/cam/src/dynamics/homme/dp_coupling.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/inital.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/control_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + cam_trunk/models/atm/cam/src/dynamics/homme/stepon.F90 + Ongoing development changes for the homme dycore + Enable subcycling & foward-in-time dynamics by default + Update to time-split forcing for forward-in-time dynamics + Removed unnecessary data from restart files + + cam_trunk/models/atm/cam/src/physics/cam/phys_gmean.F90 + cam_trunk/models/atm/cam/src/physics/cam/phys_grid.F90 + Memory reductions in loadbalance options for unstructured grids + + cam_trunk/models/atm/cam/src/physics/cam/radconstants.F90 + move psf from module global to subroutine local + + cam_trunk/models/atm/cam/src/utils/cam_pio_utils.F90 + Added support for two new pio file types + netcdf4c (hdf5 compressed) and netcdf4p (hdf5 parallel) + these are somewhat mutually exclusive types: a file opened + to write compressed data must be serial. + PIO will detect and open files to read with the correct + option for that file type regardless of option requested. + + cam_trunk/models/atm/cam/test/system/test_driver.sh + Update bluefire pnetcdf path + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except ... + 052 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! + 053 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! + 054 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! + 055 sm992 TSM_ccsm.sh f19_g16 E 2d ................................FAIL! + 056 er992 TER_ccsm.sh f19_g16 E 1+1d ..............................FAIL! + 057 bl992 TBL_ccsm.sh f19_g16 E 2d ................................FAIL! + + bl731 fails due to update of homme dycore. + + - 991 and 992 tests failed to build due to update of drv external + without corresponding required updates to other external + components - carried forward from 4_1_02 + +edinburgh/lf95: all pass + +calgary/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: testing on bluefire required a mod to cam4_1_02 to allow that pio tag to build + with pnetcdf-1.1.1svn. The pnetcdf version check in pio had to be commented out. + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam4_1_02 +Originator(s): mvr +Date: Fri Feb 19 2010 +One-line Summary: enhancement of test suite on bluefire; added use_cases for +rcp runs; qarch setting returned to Makefile and xlf compiler patch added; +mods for the atm_aero infodata flag; build-namelist bug fix for dynamic PFT dataset + +notes: +1 rcp use_cases will need update to solar data file when it is ready +2 test suite on bluefire enhanced to include more configurations including better + coverage of cam4 (track1) runs - more enhancements to follow +3 atm_aero flag indicates whether CAM will provide carbon and dust deposition fluxes + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none +- improved error messages; addition of cam_chempkg; bug fix for dynamic PFT dataset + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/f1.9c351dh +D models/atm/cam/test/system/config_files/f1.9dm +D models/atm/cam/test/system/config_files/e32dh +D models/atm/cam/test/system/config_files/f4c351pdh +D models/atm/cam/test/system/config_files/fm1.9dh +D models/atm/cam/test/system/config_files/wm4h +D models/atm/cam/test/system/config_files/e32pdh +- removed obsolete configuration options files no longer needed in test suite + +D models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml +D models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1_super_fast_llnl.xml +D models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +- changed name of use_cases from 'track1' to cam4 + +D models/atm/cam/tools/newcprnc +D models/atm/cam/tools/cprnc +- removed all versions of netcdf comparison tool - will be added as external in subsequent tag + +List all subroutines added and what they do: none +A models/atm/cam/test/system/config_files/e32c4pdm +A models/atm/cam/test/system/config_files/f1.9c5dm +A models/atm/cam/test/system/config_files/fs1.9c4dh +A models/atm/cam/test/system/config_files/f4c5dh +A models/atm/cam/test/system/config_files/wm4c4h +A models/atm/cam/test/system/config_files/f1.9c4dh +A models/atm/cam/test/system/config_files/f4c4dh +A models/atm/cam/test/system/config_files/e32c4dh +A models/atm/cam/test/system/config_files/f4c4pdh +- new configuration options files needed for enhancements to test suite + +A + models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_cam4.xml +A + models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4_super_fast_llnl.xml +A + models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cam4.xml +- changed name of use_cases from 'track1' to cam4 + +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85.xml +A models/atm/cam/bld/namelist_files/use_cases/2005-2100_cam4_rcp85v2.xml +- new use_cases required for rcp runs - will require mod for new solar data file + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +- changes made to set of required pretag tests on bluefire + +M models/atm/cam/test/system/TBL.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TEQ_ccsm.sh +M models/atm/cam/test/system/TER_ccsm.sh +M models/atm/cam/test/system/TBL_ccsm.sh +M models/atm/cam/test/system/TEQ.sh +- b4b checks now include any initial files generated + +M models/atm/cam/test/system/nl_files/aqpgro +- namelist options test file now included inithist='ENDOFRUN' + +M models/atm/cam/test/system/input_tests_master +- master list of test definitions changes to reflect enhancements made to test suite + +M models/atm/cam/bld/Makefile.in +- qarch setting replaced for bluefire compilations (was removed in cam4_1_00) and compiler + patch was added to FFLAGS and CFLAGS + +M models/atm/cam/bld/build-namelist +- improved error messages; addition of cam_chempkg; bug fix for dynamic PFT dataset + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +- info added for cam_chempkg + +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +- fix to xml syntax for several recently added fields; added pre-industrial sst datasets + +M models/atm/cam/bld/namelist_files/use_cases/2005_cam4.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_cam4.xml +- fix to xml syntax for several recently added fields + +M models/atm/cam/src/control/cam_history.F90 +- mods to ensure initial files get the default output variables when empty_htapes=.true. + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +- use atm_aero flag to provide carbon and dust deposition fluxes when desired + +M models/atm/cam/src/physics/cam/phys_control.F90 +- addition of cam_chempkg to phys_ctl_nl namelist + +M SVN_EXTERNAL_DIRECTORIES + M . +- update of drv tag needed for use of the atm_aero info flag + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +004 bl132 TBL.sh e32c4dh ghgrmp+1850_cam4 9s ......................FAIL! rc= 7 at Fri Feb 19 10:14:28 MST 2010 +006 bl133 TBL.sh e32c4pdm aqpgro 3s ...............................FAIL! rc= 7 at Fri Feb 19 10:14:28 MST 2010 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 at Fri Feb 19 10:14:37 MST 2010 +015 bl331 TBL.sh f4c4dh co2rmp+1850_cam4 9s .......................FAIL! rc= 7 at Fri Feb 19 10:14:39 MST 2010 +021 bl333 TBL.sh f4c4pdh aqpgro 3s ................................FAIL! rc= 7 at Fri Feb 19 10:14:44 MST 2010 +031 bl336 TBL.sh wm4c4h outfrq3s+waccm_1850_cam4 9s ...............FAIL! rc= 7 at Fri Feb 19 10:14:49 MST 2010 +034 bl337 TBL.sh f4c5dh fv2d_8tsk 9s ..............................FAIL! rc= 7 at Fri Feb 19 10:14:50 MST 2010 +038 bl371 TBL.sh f1.9c5dm fvvp_lb2 9s .............................FAIL! rc= 7 at Fri Feb 19 10:14:50 MST 2010 +042 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Fri Feb 19 10:15:02 MST 2010 +045 bl374 TBL.sh fs1.9c4dh outfrq3s+1850-2005_cam4_super_fast_llnl 9s FAIL! rc= 7 at Fri Feb 19 10:15:03 MST 2010 +049 bl387 TBL.sh f1.9c4dh outfrq3s+1850-2005_cam4 9s ..............FAIL! rc= 7 at Fri Feb 19 10:15:04 MST 2010 +053 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 at Fri Feb 19 10:15:31 MST 2010 +054 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 at Fri Feb 19 10:15:31 MST 2010 +055 sm992 TSM_ccsm.sh f19_g16 E 2d ................................FAIL! rc= 4 at Fri Feb 19 10:15:47 MST 2010 +056 er992 TER_ccsm.sh f19_g16 E 1+1d ..............................FAIL! rc= 6 at Fri Feb 19 10:15:47 MST 2010 +057 bl992 TBL_ccsm.sh f19_g16 E 2d ................................FAIL! rc= 4 at Fri Feb 19 10:15:47 MST 2010 +- bl132, bl133, bl331, bl333, bl336, bl337, bl371, bl374, bl387 failed due to change in test definition +- bl151, bl336, bl375 failed due to replacement of qarch setting in Makefile and inclusion of compiler patch +- 991 and 992 tests failed to build due to update of drv external without corresponding required updates to + other external components + +edinburgh/lf95: all PASS except +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 at Thu Feb 18 15:41:54 MST 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 at Thu Feb 18 16:47:54 MST 2010 +- these failed because initial files are now generated and included in b4b checks + +edinburgh/pgi: all PASS except +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 at Thu Feb 18 15:21:07 MST 2010 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 at Thu Feb 18 15:38:12 MST 2010 +- these failed because initial files are now generated and included in b4b checks + +CAM tag used for the baseline comparison tests if different than previous +tag: additional testing done with cam and drv changes placed into ccsm4_0_beta43 - CME.f19_f19.F.bluefire PASSED + +Summarize any changes to answers: BFB, but pergro test was performed on bluefire for configuration where things +were not b4b due to replacement of qarch setting and addition of compiler patch (fv 1.9x2.5 hybrid - passed) + + + +=============================================================== +Tag name: cam4_1_01 +Originator(s): mvr +Date: Wed Feb 10 2010 +One-line Summary: adjustment to dust mods of previous tag; general cleanup of test scripts + +Purpose of changes: dust mods of previous tag were applied for all configurations, but + were not intended when using cam5 physics (indicated when MODAL_AERO is defined) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/h5x8dm +D models/atm/cam/test/system/config_files/h5x8adm +D models/atm/cam/test/system/config_files/h5x8idm +- removed configuration options test files for unused homme grid +D models/atm/cam/test/system/posttag_cron_lightning.sh +D models/atm/cam/bld/run-lightning.csh +- removed test and template scripts for obsolete machine lightning + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/config_files/scm64bfbiop_35 +M models/atm/cam/test/system/config_files/e64bfbiop_35 +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- cleanup of test scripts, including removal of code for obsolete machines lightning and dublin +M models/atm/cam/test/system/input_tests_master +- corrected test definitions where usecase 1870_prog_aero was replaced with 1850_cam4_trop_bam +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +- adj to dust changes of previous tag, where mods will not have an affect when MODAL_AERO + is defined + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 at Wed Feb 10 09:04:46 MST 2010 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 at Wed Feb 10 09:04:54 MST 2010 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 at Wed Feb 10 09:05:02 MST 2010 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 at Wed Feb 10 09:05:06 MST 2010 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 at Wed Feb 10 09:05:11 MST 2010 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 at Wed Feb 10 09:05:27 MST 2010 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Wed Feb 10 09:05:38 MST 2010 +- all were expected, as they are cam5 configurations where dust mod of cam4_1_00 was undone + +edinburgh/lf95: all PASS except +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Feb 9 19:05:35 MST 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Feb 9 19:42:09 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Feb 9 20:56:52 MST 2010 +- all were expected, as they are cam5 configurations where dust mod of cam4_1_00 was undone + +edinburgh/pgi: all PASS except +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Feb 9 18:20:27 MST 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Feb 9 18:29:45 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Feb 9 18:49:06 MST 2010 +- all were expected, as they are cam5 configurations where dust mod of cam4_1_00 was undone + +CAM tag used for the baseline comparison tests if different than previous +tag: additional testing was done vs cam3_6_79 to verify the baseline tests listed above were b4b + +Summarize any changes to answers: BFB + +=============================================================== + +Tag name: cam4_1_00 +Originator(s): eaton +Date: Wed Feb 3 10:35:05 MST 2010 +One-line Summary: update names to reflect CAM4 release; update trop_bam dust; SST datasets. + +Purpose of changes: + +. The decision was made to publicly release what we have been calling + track1 or cam3_5_1 during the development process as CAM-4.0. This + update is mainly to make name changes that are consistent with that + decision. + + The default physics on the trunk is still in an intermediate development + state between cam4 and the new track5 physics. For that reason the trunk + tag name has been advanced beyond cam4_0_00. We expect to merge the + track5 development branch to the trunk in the near future. + + In the public release of CAM-4.0 the cam4 physics will obviously be the + default. But to get cam4 physics from a trunk tag you must give the + argument "-phys cam4" to configure. For backwards compatibility with + existing scripts configure will continue to recognize the value cam3_5_1 + as an alias for cam4. + +. Update SST datasets for 1850 climatology and add 1850-2008 AMIP. + +. Changes for dust in trop_bam + - Update soil_erod files for 1, 1/2, and 1/4 degree FV + - New use case: 1850_cam4_trop_bam + - tuning mod in dust_emis_intr + +. Add workaround to Makefile for problems with track5 physics on bluefire. + This workaround causes a roundoff level change in other configurations. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. updated soil_erod files for 1, 1/2, and 1/4 degree FV + +. updated the "clim_pi" SST datasets which are used when sim_year=1850. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/bld/namelist_files/use_cases/1990_prog_aero.xml +. deleted + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam351.xml +models/atm/cam/bld/namelist_files/use_cases/1850_cam351.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +models/atm/cam/bld/namelist_files/use_cases/2005_cam351.xml +. old names + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam4.xml +models/atm/cam/bld/namelist_files/use_cases/1850_cam4.xml +models/atm/cam/bld/namelist_files/use_cases/2005_cam4.xml +. new names + +models/atm/cam/bld/namelist_files/use_cases/1850_cam4_trop_bam.xml +. renamed from 1870_prog_aero.xml +. update 1850 GHG values +. update prescribed ozone and oxidants datasets + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +models/atm/cam/bld/config_files/definition.xml +models/atm/cam/bld/configure +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. change valid values of phys to be cam3, cam4, cam5, ideal, adiabatic. + cam5 is default on the trunk. For backwards compatibility accept + cam3_5_1 as an alias for cam4. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add SST datasets for 1850 climatology and 1850-2008 AMIP. +. update soil_erod files for 1, 1/2, and 1/4 degree FV + +models/atm/cam/bld/Makefile.in +. remove the -qarch=auto flag for AIX builds. This is a temporary + workaround to address current problems with the track5 code on bluefire. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. documentation update + +models/atm/cam/bld/build-namelist +models/atm/cam/bld/namelist_files/namelist_definition.xml +models/atm/cam/src/physics/cam/phys_control.F90 +. add namelist variable to be set by build-namelist that communicates the + name of the physics package. +. add logical query function, physpkg_is(name), to allow control logic to + be based on the name of the physics package. + +models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +. modify a conditional on soil_erod_tmp at line 858 (tuning mod) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 at Tue Feb 2 19:23:17 MST 2010 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 at Mon Feb 1 13:08:47 MST 2010 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 at Tue Feb 2 19:46:49 MST 2010 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 at Tue Feb 2 19:54:22 MST 2010 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 at Mon Feb 1 13:40:03 MST 2010 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 at Tue Feb 2 20:11:27 MST 2010 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 at Tue Feb 2 20:24:18 MST 2010 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Mon Feb 1 14:13:58 MST 2010 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 at Tue Feb 2 20:58:25 MST 2010 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 4 at Tue Feb 2 21:02:27 MST 2010 + +bl151, bl336, and bl375 fail due to the removal of the -qarch=auto flag. +That change only introduced roundoff diffs (validated w/ a pergro test) +into configs running without debug flags. + +bl132, bl151, bl331, bl332, bl337, bl371, bl375, bl374 are failing due to +the tuning mod in dust_intr.F90. This is larger than roundoff. + +bl387 fails due to updating the "clim_pi" SST dataset. + +edinburgh/lf95: +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Feb 2 20:08:59 MST 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Feb 2 20:35:01 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Feb 2 21:25:21 MST 2010 + +edinburgh/pgi: +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Feb 2 19:21:44 MST 2010 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Feb 2 19:27:41 MST 2010 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Feb 2 19:39:15 MST 2010 + +bl311, bl312, and bl317 fail with both lf95 and pgi due to the tuning mod +in dust_intr.F90. This is larger than roundoff. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except: +. non-debug runs on bluefire all have roundoff diffs due to qarch flag +. trop_mozart and trop_mam3 are both affected by the tuning mod in + dust_intr.F90 +. any run using new SST datasets (*clim_pi* versions) + +=============================================================== +=============================================================== + +Tag name: cam3_6_79 +Originator(s): mvr, hannay +Date: Fri Jan 22 2010 +One-line Summary: New SSTs data for 1850 runs; Make the SST dataset "sim_year" dependant. + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- new sst datasets for 1850 configurations + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/build-namelist +- Make the SST dataset "sim_year" dependant. +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- New SSTs data for 1850 runs; Make the SST dataset "sim_year" dependant. +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_track1_super_fast_llnl.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_track1_2xco2.xml +- documentation for use cases changed to reflect sst forcings are based on sim_year +M models/atm/cam/test/system/test_driver.sh +- increased wall time for running test suite on jaguar +M models/atm/cam/test/system/tests_posttag_jaguar +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/input_tests_master +- new test id's for equivalence tests to avoid confusion; added test cb372 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 at Thu Jan 21 20:05:20 MST 2010 +- bl387 was expected to fail since it's using a new sst dataset + +edinburgh/lf95: all PASS + +edinburgh/pgi: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except configs that use 1850 sst datasets + +=============================================================== + +Tag name: cam3_6_78 +Originator(s): pworley, fvitt, eaton +Date: Mon Jan 18 15:23:36 MST 2010 +One-line Summary: Merge mods/fixes from the release branch; update externals + +Purpose of changes: + +. Add workaround for problem with BGP in the repro_sum_mod module. (from + pworley) + +. Cleanup of some old and unused files. + +. fixes to waccm and super fast chem use cases (from fvitt) + +. update externals + pio1_0_6 --> pio1_0_7 + scripts4_100108b --> scripts4_100112b + + +Bugs fixed (include bugzilla ID): + +. the problem with the SCAM runs (link failure) in the last tag is fixed by + updating to pio1_0_7 + +. workaround apparent compiler bug that was affecting the SOLIN diagnostic + field in some configurations. (from fvitt) + +. subroutine calc_col_mean should use pdeldry rather than pdel to + convert the GHG mixing ratios to masses. Only affects CAM-RT radiation + scheme. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +Copyright +README +. Old CAM3 files + +models/atm/cam/bld/script_tests/namelist.pl +models/atm/cam/bld/perl5lib/t/* +. delete unused test code + +models/atm/cam/bld/camdom.cpl7.template +. delete since camdom no longer supported from ccsm scripts + +models/atm/cam/bld/README +. delete old README + +models/atm/cam/src/physics/cam3_6/* +. delete unsupported physics option + +models/atm/cam/test/unit/* +. delete unused test code + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update pio and scripts externals + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1_super_fast_llnl.xml +models/atm/cam/bld/namelist_files/use_cases/1850_track1_super_fast_llnl.xml +. mods from fvitt + +models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +. new 4x5 IC file + +models/atm/cam/src/physics/cam/radsw.F90 +. replace an intrinsic sum by an explicit do loop. This is a workaround + for a problem where the diagnostic field SOLIN would contain bad values + in some configurations (cam3_5_1 plus trop_mozart). (from fvitt) + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +models/atm/cam/src/physics/cam/radiation.F90 +. fix lines longer than 132 chars + +models/atm/cam/src/utils/repro_sum_mod.F90 +. Add a workaround, inside a BGP ifdef, to use i4 with the scalable + reproducible algorithm. All other platforms use i8. + +models/atm/cam/src/physics/cam/radiation.F90 +. Change subroutine calc_col_mean to use pdeldry rather than pdel to + convert the GHG mixing ratios to masses. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. Change subroutine calc_col_mean to use pdeldry rather than pdel to + convert the GHG mixing ratios to masses. This subroutine is only used + for a diagnostic calculation in the RRTMG version. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 at Mon Jan 18 12:36:15 MST 2010 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 at Mon Jan 18 12:47:31 MST 2010 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 at Mon Jan 18 13:52:43 MST 2010 +051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 at Mon Jan 18 13:57:35 MST 2010 +056 bl992 TBL_ccsm.sh f19_g16 E 2d ................................FAIL! rc= 7 at Mon Jan 18 14:19:13 MST 2010 + +edinburgh/lf95: +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 at Mon Jan 18 13:48:38 MST 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 at Mon Jan 18 13:53:14 MST 2010 + +edinburgh/pgi: +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 at Mon Jan 18 12:21:25 MST 2010 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 at Mon Jan 18 12:23:34 MST 2010 + +bl314 and bl336 fail due to the workaround in radsw for the SOLIN +calculation. It's only the diagnostic field SOLIN that contains roundoff +level diffs. + +All baselines above fail because they +use the CAM-RT radiation code which +uses the calc_col_mean routine to compute a value of both O2 and CO2. +Changing the weights used in the calculation results in a roundoff level +change if the constituent has a constant mmr to begin with, and a larger +than roundoff change in any constituent that is not already constant in the +column. That causes larger than roundoff diffs in WACCM runs that have +prognostic CO2 and O2. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except configs that use CAM-RT. That +config changes by rounoff if O2 and CO2 are constant, and by more than +roundoff if O2 or CO2 have 3D variation. + +=============================================================== +=============================================================== + +Tag name: cam3_6_77 +Originator(s): mataylo, jedwards, eaton +Date: Mon Jan 11 18:33:04 MST 2010 +One-line Summary: fix namespace conflict w/ new pio lib; update externals + +Purpose of changes: + +. Fix CAM trunk to work with new pio tag by changing the name of the + pio_utils module to cam_pio_utils. + **Note** The SCAM mode is not linking correctly with the new PIO lib. + This will be fixed shortly, but this tag was made anyway due to timelines + of the release branch for CCSM4.0. + +. update PIO and CLM externals + +Bugs fixed (include bugzilla ID): + +. bug fix for the totalsize calculation in pbuf_init_restart (from mataylo) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/utils/pio_utils.F90 +. this name conflicts with one in the new PIO lib + +models/atm/cam/bld/perl5lib/XML/man3/XML::Lite.3 +models/atm/cam/bld/perl5lib/XML/man3/XML::Lite::Element.3 +. "::" in filenames causes problems when trying to check out code from the + svn repo on a Windows system. + +List all subroutines added and what they do: + +models/atm/cam/src/utils/cam_pio_utils.F90 +. renamed from pio_utils.F90 +. also change module name from pio_utils to cam_pio_utils + +models/atm/cam/bld/perl5lib/XML/man3/XML_Lite.3 +models/atm/cam/bld/perl5lib/XML/man3/XML_Lite_Element.3 +. renamed from XML::Lite.3 and XML::Lite::Element.3 + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. clm3_6_58 --> clm3_6_63 + pio60_prod --> pio1_0_6 + +models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +models/atm/cam/src/chemistry/utils/tracer_data.F90 +models/atm/cam/src/control/cam_comp.F90 +models/atm/cam/src/control/cam_history.F90 +models/atm/cam/src/control/cam_restart.F90 +models/atm/cam/src/control/ncdio_atm.F90 +models/atm/cam/src/control/startup_initialconds.F90 +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +models/atm/cam/src/dynamics/homme/inidat.F90 +models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +models/atm/cam/src/physics/cam/modal_aer_opt.F90 +models/atm/cam/src/physics/cam/phys_prop.F90 +models/atm/cam/src/physics/cam/radae.F90 +models/atm/cam/src/physics/cam/restart_physics.F90 +models/atm/cam/src/physics/cam/tropopause.F90 +. change pio_utils to cam_pio_utils + +models/atm/cam/src/physics/cam/phys_buffer.F90 +. change pio_utils to cam_pio_utils +. bug fix for the totalsize calculation in pbuf_init_restart (from mataylo) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +057 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 4 at Mon Jan 11 15:14:53 MST 2010 + +edinburgh/lf95: All PASS except +042 sc003 TSM.sh scmarmiop scmarm 7s ..............................FAIL! rc= 4 at Mon Jan 11 15:00:07 MST 2010 + +edinburgh/pgi: All PASS except +042 sc003 TSM.sh scmarmiop scmarm 7s ..............................FAIL! rc= 4 at Mon Jan 11 13:20:45 MST 2010 + +These failures are all build time link failures. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_76 +Originator(s): fvitt, mataylo, eaton +Date: Sat Jan 9 13:25:13 MST 2010 +One-line Summary: use case mods; update externals + +Purpose of changes: + +. add use cases to supply additional sub-monthly output for AR5 runs + +. modify waccm use cases to use a different 4x5 initial file, and add + workaround for problem in waccm_1850_track1 (from fvitt) + +. update externals to be consistent with ccsm4_0_beta39 + +. some cleanup work in namelist code + +Bugs fixed (include bugzilla ID): + +. fix for HOMME subcycling bug (from mataylo) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. waccm use cases using a new 4x5 initial file +. new initial (jan 01) and topo files for HOMME ne30np4 grid + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/1850_cam351.xml +. This is the 1850_track1 use case with daily fields requested for AR5 runs + added ('TREFHTMN','TREFHTMX','TREFHT','PRECC','PRECL','PSL'). + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_cam351.xml +. This is the 1850-2005_track1 use case with daily fields requested for AR5 runs + +models/atm/cam/bld/namelist_files/use_cases/2005_cam351.xml +. Use case for fixed 2005 forcings. + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES + drvseq3_1_10 --> drvseq3_1_11 + cice4_0_20091202 --> cice4_0_20100105 + docn8_091208 --> docn8_100103 + scripts4_091208 --> scripts4_100108b + MCT2_6_0_090926 --> MCT2_7_0_100106 + +models/atm/cam/bld/build-namelist +. refactor code that makes sure consistent land/ocn fractions are used by + surface components. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. remove bndtvs and focndomain settings for homme grids +. add ncdata (jan 01) and bnd_topo files for ne30np4 HOMME grid + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. remove old SOM variables + +models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +. update 4x5 ncdata to waccm3548_4x_t43.cam2.i.1870-01-01-00000.nc + +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +. set ext_frc_ymd=18500102 to work around a problem that occurs when + setting it to 18500101. + +models/atm/cam/src/dynamics/homme/dyn_comp.F90 +. fix for subcycling bug (from Mark Taylor) + +models/atm/cam/test/system/input_tests_master +. change SOM tests from f19_g15 to f19_g16 + +models/atm/cam/test/system/config_files/h16x4dm +models/atm/cam/test/system/config_files/h5x8adm +. remove machine specific settings for -pnc_inc and -pnc_lib + +models/atm/cam/test/system/test_driver.sh +. Add {INC,LIB}_PNETCDF variables for bluefire to point to the required + version of PNetCDF. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +056 bl992 TBL_ccsm.sh f19_g16 E 2d ................................FAIL! rc= 7 at Thu Jan 7 12:21:24 MST 2010 + +This baseline failure is expected due to changing the test definition from +g15 to g16. + +edinburgh/lf95: All PASS. + +edinburgh/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_75 +Originator(s): tcraig, cacraig, mvertens, eaton +Date: Tue Jan 5 09:45:39 MST 2010 +One-line Summary: Support for DOCN; mods for running with CCSM scripts; misc fixes and cleanup. + +Purpose of changes: + +. Changes to allow running the DOCN data model in place of CAM-DOM. + CAM-DOM is currently still the default when running in a standalone CAM + mode (DOCN doesn't yet support the aqua-planet SSTs). But only DOCN is + supported for running F compsets with the CCSM scripts. + +. Mod to allow putting namelist variables in the file + $CASEROOT/SourceMods/src.cam/user_nl when running with CCSM scripts. + This is an easier way to modify namelist settings than via the + CAM_NAMELIST_OPTS attribute in the compset definition. + +. Add ESMF interfaces and support for running with an external ESMF library + via the CCSM scripts. + +. Changes to support running single column mode from the CCSM scripts. + +. Code cleanup -- added implicit none, private, and save statements to + modules that were missing them. + +. Fix bugs that were causing problems on BG/P. + +Bugs fixed (include bugzilla ID): + +. bug 1073 -- change the first argument of mpi_get_processor_name from char + array to string. + +. bug 1074 -- Add error return arg to mpi_abort. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_bam.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1990_control.xml +. delete old use cases + +List all subroutines added and what they do: + +models/atm/cam/src/cpl_esmf/atm_comp_esmf.F90 +models/atm/cam/src/cpl_esmf/atm_comp_mct.F90 +. esmf interface layer + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. Modify so that build-namelist doesn't try to find defaults for bndtvs when + ocn has been set to none. This was causing a problem trying to run HOMME + from the CCSM scripts. +. Add code to write the files that docn needs. + +models/atm/cam/bld/cam.cpl7.template +. Add support for "PTS_MODE" == single_column +. change use of ATM_NY -- now it's resolved at build time rather than + configure time. +. mod to allow the user to put a file with namelist settings in the source + mods directory in a file named user_nl, i.e., + $CASEROOT/SourceMods/src.cam/user_nl. This file should have the + format of a file that is supplied to build-namelist via the -infile + argument. + +models/atm/cam/bld/configure +. Remove the -esmf_libvers option. The cpp macro ESMF_v2 has been replaced + by USE_ESMF_LIB for consistency with CCSM. We assume that whenever an + external ESMF lib is used, that its version is 3.1 or later. If an + external ESMF lib is not used, the default WRF implementation of the ESMF + time manager utilities has interfaces from ESMF version 2. + Modify configure to recognize the USE_ESMF_LIB environment variable which + is set by the CCSM scripts. This must be used to determine whether or + not and external lib is being used since ESMF_LIBDIR is always set by the + CCSM scripts whether it will be used or not. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Remove the years from the ic_ymd attributes for the finidat files. This + way they will be used with the default 101 start date without the user + having to specify -ignore_ic_year to build-namelist. This is the way + CAM's ncdata files work as well. + +models/atm/cam/src/dynamics/fv/inidat.F90 +models/atm/cam/src/physics/cam/buffer.F90 +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +models/atm/cam/src/physics/cam/cmparray_mod.F90 +models/atm/cam/src/physics/cam/convect_ke_intr.F90 +models/atm/cam/src/physics/cam/geopotential.F90 +models/atm/cam/src/physics/cam/hirsbtpar.f90 +models/atm/cam/src/physics/cam/iop_surf.F90 +models/atm/cam/src/physics/cam/param_cldoptics.F90 +models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +models/atm/cam/src/physics/cam/ppgrid.F90 +models/atm/cam/src/physics/cam/restart_physics.F90 +models/atm/cam/src/physics/cam/wv_saturation.F90 +models/atm/cam/src/physics/rrtmg/cloud_diagnostics.F90 +. code cleanup -- mostly adding missing implicit none, private, and save + statements to modules +. eliminate unused parameter pvermx + +models/atm/cam/src/utils/abortutils.F90 +. Add error return arg to mpi_abort. This fixes bug 1074. + +models/atm/cam/src/utils/spmd_utils.F90 +. Change the first argument of mpi_get_processor_name from char array to + string. This fixes bug 1073. + +models/atm/cam/src/utils/time_manager.F90 +. initialize_clock: arg ref_date - change intent from in to inout +. set_date_from_time_float: Distinquish between the esmf-v2 (the wrf_esmf + code uses these interfaces) and the esmf-v3 or later interfaces by the + cpp macro USE_ESMF_LIB. The ESMF_v2 macro is deprecated. + +models/atm/cam/test/system/input_tests_master +. The 1870_bam use case was only being used in the *384 tests on jaguar. + Replace that use case by 1850_track1. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS. + +dublin/lf95: All PASS. + +dublin/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_74 +Originator(s): Francis Vitt +Date: 23 Dec 2009 +One-line Summary: Update chemistry code with track5 branch code + +Purpose of changes: + + - Update trunk with latest chemistry code which is in the track5 branch. + - Eliminate the discrepancies in chem code between trunk and track5 branch. + - Fix the super_fast_llnl build-namelist use cases. + + The changes merged in from track5 branch: + - added capability to specify 'INTERP_MISSING_MONTHS' to the surface and elevated emissions codes + - modifications needed for running super_fast_llnl chemistry with prognostic modal aerosols + - radiation packages camrt and rrtmg both have the ability to use spectral solar variance + - chemistry photolysis reactions and radiation heating use the same input dataset + so in chemistry configurations rad heating will have spectral solar variance + - woods and neckel schemes of using F10.7 data to model the solar spectrum is removed + - additional chemistry code changes: + . use tropopause level determined by physics/cam/tropopause.F90 + . unified "users" reaction labeling scheme for waccm and cam-chem + . aircraft sources optional + . minimum mixing ratio of all chemical tracers greater than zero + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +D models/atm/cam/src/physics/cam/solvar_interface.F90 +D models/atm/cam/src/chemistry/mozart/solar_photons.F90 +D models/atm/cam/src/chemistry/mozart/mo_tropopause.F90 +D models/atm/cam/src/chemistry/mozart/solvar_interface.F90 +D models/atm/cam/src/chemistry/mozart/woods.F90 +D models/atm/cam/src/chemistry/mozart/llnl_set_chem_trop.F90 +D models/atm/cam/src/chemistry/mozart/solvar_woods.F90 +D models/atm/cam/src/chemistry/mozart/solvar_data.F90 +D models/atm/cam/src/chemistry/mozart/neckel.F90 + +List all subroutines added and what they do: + +A models/atm/cam/bld/config_files/defaults_super_fast_llnl_mam3.xml + - configure defaults file for new super_fast_llnl_mam3 chem option + +A models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1_super_fast_llnl.xml + - track1 with chemistry use case + +A models/atm/cam/src/physics/cam/rad_solar_var.F90 + - needed for the spectral solar variance + +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 + - preprocessor generated files for new super_fast_llnl_mam3 chemistry with package + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + - chem option "super_fast_llnl_mam3" added + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - update MAM inputs + - optics file for super_fast_llnl_mam3 configuration + - default solar input file + - prescribed constituents updates + - tropopause, woods, neckel inputs removed + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - tropopause, woods, neckel namelist vars removed + - added capability to specify 'INTERP_MISSING_MONTHS' to the + surface and elevated emissions + +M models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +M models/atm/cam/bld/namelist_files/use_cases/1990_prog_aero.xml +M models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +M models/atm/cam/bld/namelist_files/use_cases/1850_track1_super_fast_llnl.xml +M models/atm/cam/bld/build-namelist + - changes to build-namelist and use cases to be consistent with namelist changes + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - update to super_fast_llnl input file + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - update chem preprocessor and rrtmg + +M models/atm/cam/src/control/wrap_nf.F90 + - added routine to get number of vars in a netcdf file + +M models/atm/cam/src/physics/cam/tropopause.F90 + - added hybrid-stobie method + +M models/atm/cam/src/chemistry/utils/solar_data.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/radconstants.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radconstants.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radsw.F90 + - radiation packages camrt and rrtmg both have the ability to use spectral solar variance + - shortened the routine names in radconstants.F90 to be less than 32 characters (F90 standard limit) + +M models/atm/cam/src/chemistry/pp_trop_mam7/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 + - unified usrrxt tagging scheme + - ext frc from file added for time-dependent aircraft emissions + +M models/atm/cam/src/physics/cam/modal_aer_opt.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +M models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/drydep_mod.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_sediment_mod.F90 +M models/atm/cam/src/chemistry/bulk_aero/wetdep.F90 +M models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +M models/atm/cam/src/chemistry/bulk_aero/sulchem.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 + - MAM track5 branch mods + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - check for spectral solar data input + +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/mo_jshort.F90 + - removed woods and neckel etf + +M models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +M models/atm/cam/src/chemistry/mozart/mo_setext.F90 + - check for aircraft input file + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - tropopause level passed in + - call to one usrrxt interface + +M models/atm/cam/src/chemistry/mozart/upper_bc.F90 + - waccm check + + +M models/atm/cam/src/chemistry/mozart/mo_cph.F90 + - change in usrrxt label scheme + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - tropopause, woods, neckel namelist vars removed + - emis namelist var changes + +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +M models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +M models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +M models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +M models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 +M models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 +M models/atm/cam/src/control/cam_history.F90 + - misc cleanup + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - unified tagging scheme + +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 + - added capability to specify 'INTERP_MISSING_MONTHS' to the + surface and elevated emissions codes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 + - these are expected to due to changes in chemistry configurations + - the configurations that test cam3 and cam3_5_1 physics pass + +calgary/lf95: + +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + - these are expected to due to changes in chemistry configurations + - the configurations that test cam3 and cam3_5_1 physics pass + +calgary/pgi or jaguar/pgi: + +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + - these are expected to due to changes in chemistry configurations + - the configurations that test cam3 and cam3_5_1 physics pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_73 +Originator(s): eaton +Date: Mon Dec 21 14:01:12 MST 2009 +One-line Summary: update prescribed GHG data; update externals; misc fixes + +Purpose of changes: + +. update external references to be consistent with ccsm4_0_beta37 + +. Add new timer events for performance evaluation. + +. Modify physics buffer error checking in pbuf_add to be consistent with + code in pbuf_get_fld_idx. The physics buffer names are assumed to be + case insensitive. + +. Modify code in the parcel_dilute subroutine of zm_conv.F90 to avoid bug + in cases where the model top is below 40 mb. + +Bugs fixed (include bugzilla ID): + +. The values of atm_nx and atm_ny were not being set correctly in the + driver infobuffer for the HOMME dycore. + +. The interpic_new Makefile had a bug in the logic for setting netcdf + default locations. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. add new IC file for T31 valid at Jan 01. + +. update the prescribed GHG data for AR5 20th century runs. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update externals as follows: + drvseq3_0_40 --> drvseq3_1_08 + clm3_6_54 --> clm3_6_58 + cice4_0_20091104 --> cice4_0_20091202 + docn7_090720 --> docn8_091208 + share3_091026 --> share3_091208 + MCT2_6_0_090317 --> MCT2_6_0_090926 + scripts4_091102 --> scripts4_091208 + +models/atm/cam/bld/config_files/definition.xml +. allow -ocn to be set to 'docn'. + +models/atm/cam/bld/configure +. modify the Filepaths file for the new driver directory structure. +. modify the Filepaths file for the new docn directory. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. Add T31 IC file for Jan 01. +. update bndtvghg to use atm/cam/ggas/ghg_hist_1765-2005_c091218.nc +. update the 1.9x2.5 fsurdat and fpftdyn files. Last time I tried this I + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +. update bndtvghg to use atm/cam/ggas/ghg_hist_1765-2005_c091218.nc + +models/atm/cam/src/dynamics/atm_comp_mct.F90 +. set atm_nx and atm_ny values in infobuffer by using the dyn_grid method + get_horiz_grid_dim_d. Remove reference to pmgrid which should not appear + outside of the dynamics. + +models/atm/cam/src/dynamics/homme/stepon.F90 +. bugfix from Mark Taylor + +models/atm/cam/src/physics/cam/ghg_data.F90 +. fixed comment + +models/atm/cam/src/physics/cam/phys_buffer.F90 +. modify the pbuf_add error checking for a name that's already been defined + by making the name matching case insensitive. The code that returns the + buffer index for a specified name is doing case insensitive matching, so + pbuf_add needs to be consistent with that. + +models/atm/cam/src/physics/cam/tphysac.F90 +. add timer events for rayleigh friction and aerosol drydep + +models/atm/cam/src/physics/cam/radiation.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +. modify timer events for consistency between rrtmg and camrt code, and to + separate out the cost of the aerosol optics calc. + +models/atm/cam/src/physics/cam/zm_conv.F90 +. modify code in parcel_dilute to avoid bug in cases where the model top is + below 40 mb. + +models/atm/cam/tools/interpic_new/Makefile +. fix bug in logic for setting defaults of netcdf lib and inc dirs. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 at Sat Dec 19 12:37:39 MST 2009 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 at Tue Dec 15 16:20:16 MST 2009 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 at Tue Dec 15 16:30:08 MST 2009 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 at Tue Dec 15 16:36:56 MST 2009 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 at Tue Dec 15 16:49:22 MST 2009 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 at Tue Dec 15 16:53:16 MST 2009 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 at Tue Dec 15 17:05:34 MST 2009 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 at Tue Dec 15 17:20:21 MST 2009 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 at Tue Dec 15 17:39:57 MST 2009 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 at Tue Dec 15 17:53:23 MST 2009 +051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 at Tue Dec 15 17:58:06 MST 2009 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 at Tue Dec 15 18:36:55 MST 2009 + +dublin/lf95: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Tue Dec 15 12:56:24 MST 2009 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Tue Dec 15 13:07:32 MST 2009 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Dec 15 14:04:10 MST 2009 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Dec 15 14:47:06 MST 2009 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 at Tue Dec 15 15:36:47 MST 2009 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 at Tue Dec 15 15:43:40 MST 2009 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Dec 15 16:00:22 MST 2009 + +dublin/pgi: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 at Tue Dec 15 11:47:18 MST 2009 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 at Tue Dec 15 11:50:23 MST 2009 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 at Tue Dec 15 12:00:44 MST 2009 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 at Tue Dec 15 12:06:04 MST 2009 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 at Tue Dec 15 12:13:03 MST 2009 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 at Tue Dec 15 12:15:06 MST 2009 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 at Tue Dec 15 12:16:32 MST 2009 + +Most of the baseline failures appear to be due to a roundoff level change +introduced into either CLM or CICE. For resolutions except FV 1.9x2.5 the +diffs don't show up at nstep=0, but are first present at nstep=3. For the 2 +degree FV runs the diffs show up at nstep=0 but just in a few fields, and +the diffs again appear to be roundoff level changes. I suspect this is due +to updating the 2 degree CLM fsurdat file. + +In addition to the differences just mentioned: + +bl731 fails due to a homme bug fix. + +bl112, bl132, bl312, bl332, bl387 fail due to updating the prescribed GHG +dataset. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Answers change due to updating externals +and updating the prescribed GHG dataset. HOMME answers change due to a +bug fix. + +=============================================================== +=============================================================== + +Tag name: cam3_6_72 +Originator(s): Francis Vitt +Date: 11 Dec 2009 +One-line Summary: WACCM changes needed for climate runs. + +Purpose of changes: + + - compute "CFC11STAR" for radiation in WACCM configuration + - adjust inputs to the waccm_1850-2005_track1 use case + - misc cleanup + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/mozart/cfc11star.F90 + - calculates "CFC11STAR" and addes it the the physics buffer for radiation + +A models/atm/cam/bld/namelist_files/use_cases/waccm_1850-2005_track1.xml + - use case added for 1850-2005 transient waccm climate run + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - default solar_photons_file added + - defaults added for time dependent NO2 and BC aircraft emissions + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - "ippc_aircraft_emis" variable added which sets the ext_frc namelist + variables appropriately for the time dependent aircraft emissions + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml + - adjustments to the waccm 1850 track1 use case + +M models/atm/cam/bld/build-namelist + - specify "CFC11STAR" radiatively active by default for WACCM + - added "ipcc_aircraft_emis" namelist variable + - set xactive_drydep = .true. for waccm + - as default use the Lean solar data rather than Woods and Neckel data for waccm + +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 + - NO2 external forcing added to mechanism for aircraft emissions + +M models/atm/cam/src/chemistry/mozart/woods.F90 + - initialize only if input file is specified + +M models/atm/cam/src/chemistry/mozart/neckel.F90 + - initialize only if input file is specified + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - invocations of the cfc11star module + +M models/atm/cam/src/chemistry/mozart/llnl_set_chem_trop.F90 + - removed 'chem_trop_linoz' field from default history + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL + expected failure due to waccm changes in input data and cfc11star + +calgary/lf95: all pass + +calgary/pgi or jaguar/pgi: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_71 +Originator(s): Jim Edwards +Date: 12/09/2009 +One-line Summary: update homme dycore + +Purpose of changes: Update HOMME dycore + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + Remove homme requirement for lapack library + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/bld/configure + Removed requirement for lapack + models/atm/cam/src/control/ncdio_atm.F90 + Moved call to pio_setframe + models/atm/cam/src/dynamics/homme/ + A host of new features and options added. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL + expected failure due to dycore update + +dublin/lf95: All pass + +calgary/pgi or jaguar/pgi: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_70 +Originator(s): eaton +Date: Tue Dec 8 17:05:37 MST 2009 +One-line Summary: fix memory leaks + +Purpose of changes: + +. fix memory leaks and EUL OMP bug (see below) + +. misc configure/Makefile changes: + - enable building HOMME from CCSM scripts + - add flexibility to deal with new dycores in set_horiz_grid method + - remove Switch module from configure due to strange behavior on bluefire + +Bugs fixed (include bugzilla ID): + +. memory leaks (pointed out by Chuck Bardeen) due to missing deallocation + of allocated local variables in: + models/atm/cam/src/chemistry/utils/tracer_data.F90 + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + models/atm/cam/src/physics/cam/polar_avg.F90 + +. fix OMP directive in eulerian dycore (missing private variable + declaration) (from Pat Worley) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add some HOMME initial files + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/doc/ChangeSum +models/atm/cam/doc/Copyright +models/atm/cam/doc/DatasetLog +models/atm/cam/doc/README +. old files relevent to earlier ccm/cam versions + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. remove --pca from lf95 debug flags. Documentation says it overrides the + effect of --chk a +. remove -DCAM from the CPPDEF macro. It is only used by HOMME, so is + added to the USER_CPPDEFS by configure. + +models/atm/cam/bld/configure +. Remove check for smp=off when building for scam. Should run with threads + enabled even if they aren't kept busy. +. fix set_horiz_grid so that the fv grid recognition is specific to 'fv', + to allow extension to other dycores that start with fv, like fvcubed. +. add "-DCAM" to the cppdefs for the homme dycore. It is the only + component using this macro. Having configure set the macro means that it + will be available when running from the CCSM scripts as well as from CAM + standalone scripts. +. remove use of Switch module. We ran into some bizzare problems on + bluefire. The if/elsif conditional is just as easy to read. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update homme initial files to provide settings for non-aqua-planet runs. + +models/atm/cam/src/chemistry/utils/tracer_data.F90 +. remove unused allocatable arrays filename and filelist in subroutine + specify_fields. + +models/atm/cam/src/dynamics/eul/sphdep.F90: +. add S_NVAL to omp private variables at line 413 + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. add missing deallocate for phisxy3 in dyn_run + +models/atm/cam/src/physics/cam/polar_avg.F90 +. deallocate lats, n_pole, s_pole in subroutines polar_average{2,3}d + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +dublin/lf95: All PASS + +dublin/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_69 +Originator(s): Francis Vitt +Date: 24 Nov 2009 +One-line Summary: Updates to super_fast_llnl/LINOZ chemistry + +Purpose of changes: + +Correct the LINOZ code and allow interactive "super_fast_llnl" chemistry +to be included in a "track1" coupled CCSM simulation.. + +The changes are summarized as: + + * ISOP added to the super_fast_llnl chemistry mechanism + * CH4 is now prescribed + * The prescribed CH4 is radiatively active + * LINOZ chlorine loading is now read in from file + * Use case added for 1850 track 1 with super_fast_llnl chem + * FIXED solar data restart bug fix + * Corrections LINOZ code + * Added another tropopause method which is used in super_fast_llnl chemistry + * Added new super_fast_llnl mechanism file to preprocessor + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/1850_track1_super_fast_llnl.xml + - build namelist use case added for track1 with super_fast_llnl chemistry simulation + +A models/atm/cam/src/chemistry/mozart/chlorine_loading_data.F90 + - reads in time-dependent chlorine data for LINOZ + +List all existing files that have been modified, and describe the changes: + + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - default input files added for the prescribed CH4 and chlorine loading used + in the super_fast_llnl chemistry + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - namelist variables added for the chlorine loading input data + +M models/atm/cam/bld/build-namelist + - prognostic SO4 and prescribed CH4 is now radiatively active by default + for super_fast_llnl chemistry configuration + - surface emissions for ISOP added to the default super_fast_llnl + chemistry namelist + - vertical emmisions of SO2 and SO4 added to the default + super_fast_llnl chemistry namelist + - prescribed CH4 namelist variable settings added to the default + super_fast_llnl chemistry namelist + +M models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + - use the new super_fast_llnl chemistry preprocessor input file + +M models/atm/cam/src/chemistry/utils/solar_data.F90 + - FIXED solar data restart bug fix + +M models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 + - minor code cleanup + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 + - fixed bug in datapath specification + - out log info in masterproc only + +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 + - preproccessor generated file for the new super_fast_llnl chemistry mechanism + +M models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 + - corrections to the LINOZ code + +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 + - fix bug in data_type specifier (INTERP_MISSING_MONTHS) + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - namelist variables added for chlorine loading inputs + - subroutine calls added to invoke chlorine loading module + - default method for tropopause set to "Stobie-LINOZ hybrid" + +M models/atm/cam/src/chemistry/mozart/llnl_set_chem_trop.F90 + - "Stobie-LINOZ hybrid" method added to find tropopause + - diagnostic outputs added + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES + - updated chemistry preprocessor input files + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All Pass + +calgary/lf95: All Pass + +calgary/pgi or jaguar/pgi: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_68 +Originator(s): eaton +Date: Thu Nov 19 14:56:35 MST 2009 +One-line Summary: tuning for 1.9x2.5 track1 runs + +Purpose of changes: + +. The default value of rhminl was changed to 0.91, and a multiplier for the + ice fall velocity in pkg_cld_sediment.F90 was set to 0.5. Because this + multiplier depends both on resolution and the physics/chemistry packages + it was made settable via the namelist. + + These mods only change answers for FV 1.9x2.5 (a.k.a. 2 deg) track1 runs. + The changes were made so that the tunings for that configuration match + the ones used in WACCM runs. + +. The WACCM use case waccm_1850_track1 was updated to be consistent with + the prescribed aerosol changes made in the 1850_track1 use case in the + previous tag. This will change WACCM answers for runs using that use + case for all horizontal resolutions except 0.9x1.25. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add namelist group cldsed_nl which includes the variable + cldsed_ice_stokes_fac used to set the factor applied to the ice fall + velocity computed from Stokes terminal velocity. + +List any changes to the defaults for the boundary datasets: + +. defaults for prescribed aerosols changed in waccm_1850_track1 use case. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add an add_default call for cldsed_ice_stokes_fac + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. change cldfrc_rhminl for 1.9x2.5 track1 to match the waccm_mozart value + of 0.91 +. add defaults for cldsed_ice_stokes_fac. Default remains 1.0 for + backwards compatibility with older cam physics packages. Change default + to 0.5 for any waccm_phys run, and also for 2 degree track1 runs. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add cldsed_ice_stokes_fac + +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +. make the prescribed aerosols consistent with 1850_track1.xml + +models/atm/cam/src/control/runtime_opts.F90 +. add call to cld_sediment_readnl + +models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +. add cld_sediment_readnl to read namelist +. add namelist variable cldsed_ice_stokes_fac to set the factor to be + applied to the ice fall velocity via the Stokes calculation. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 at Thu Nov 19 15:05:24 MST 2009 + +This is a 2 deg track1 baseline which is expected to fail. + +**Note** +050 er731 TER.sh h16x4dm aqua 4+5s ................................PASS at Thu Nov 19 15:09:59 MST 2009 + +We've been seeing some erratic behavior with this test. I had both failures +and passes of it during testing for the previous tag. More examination of +this test is needed. + +calgary/lf95: All PASS + +calgary/pgi or jaguar/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except 2 deg track1 and WACCM runs +using the waccm_1850_track1 use case. + +=============================================================== +=============================================================== + +Tag name: cam3_6_67 +Originator(s): jedwards, eaton +Date: Wed Nov 18 11:44:51 MST 2009 +One-line Summary: update prescribed aerosol and ozone datasets. + +Purpose of changes: + +. bug fixes and updated datasets -- see below. + +Bugs fixed (include bugzilla ID): + +. The attributes _FillValue and missing_value were being written to the + history file as 8-byte reals even when the corresponding data value were + written as 4-byte reals. These attributes must match the data type for + successful post-processing. This bug was introduced at cam3_6_39 with + the changes to pio. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. The prescribed aerosol and ozone datasets have been updated. The new + data will be the default in the 1850_track1 and 1850_track1_2xco2 use + cases for all resolutions except FV 0.9x1.25. This is for backwards + compatibility with the existing control run. The new data will be the + default for the 1850-2005_track1 use case. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +. update prescribed aerosol and ozone datasets + +models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +models/atm/cam/bld/namelist_files/use_cases/1850_track1_2xco2.xml +. update prescribed aerosol and ozone datasets for all resolutions except + FV 0.9x1.25 (for backwards compatibility with control run). + +models/atm/cam/src/control/cam_history.F90 +. Fix the real kind of data written to the attributes _FillValue and + missing_value. +. Remove old logic for "fullgrid". The reduced grid option is not functional. + +models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 +models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +. mods from Jim Edwards + +models/atm/cam/test/system/TCB.sh +. mod to allow stub ice model + +models/atm/cam/test/system/config_files/h16x4dm +models/atm/cam/test/system/config_files/h5x8adm +models/atm/cam/test/system/config_files/h5x8dm +models/atm/cam/test/system/config_files/h5x8idm +. use stub ice and lnd in all these standalone mode configs which + only supports adiabatic, ideal, or aqua-planet physics. + +models/atm/cam/test/system/CAM_runcmnd.sh +models/atm/cam/test/system/test_driver.sh +. add edinburgh + +models/atm/cam/test/system/tests_posttag_jaguar_cb +. add cb372 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 at Tue Nov 17 15:09:41 MST 2009 +006 er731 TER.sh h16x4dm aqua 4+5s ................................FAIL! rc= 10 at Tue Nov 17 15:10:36 MST 2009 + +bl387 fails because the new prescribed aerosol and ozone datasets changes +answers. + +er731 failure is unexplained. cam3_6_66 is also exhibiting this failure +even though the test passed at the time of that commit on Nov 5. + +dublin/lf95: All PASS + +dublin/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except configurations using the +updated prescribed aerosol and ozone datasets. + +=============================================================== +=============================================================== + +Tag name: cam3_6_66 +Originator(s): mvertens, eaton +Date: Thu Nov 5 10:11:53 MST 2009 +One-line Summary: add SNOWHICE to diagnostic output; update externals + +Purpose of changes: + +. Add SNOWHICE to the default monthly avg history output. + +. Update externals to be mostly consistent with ccsm4_0_beta33 + drvseq3_0_29 --> drvseq3_0_40 + clm3_6_51 --> clm3_6_54 + cice4_0_20090831 --> cice4_0_20091104 + share3_090825 --> share3_091026 + timing_081221 --> timing_090929 + scripts4_090901a --> scripts4_091102 + stubs1_1_01 --> stubs1_2_02 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none for CAM + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. remove forganic (no longer used by CLM) + +models/atm/cam/bld/configure +. updates for directory paths used by stub components + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update defaults for CLM files + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. two driver pio variable name changes + +models/atm/cam/src/control/camsrfexch_types.F90 +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add SNOWHICE to default monthly avg output + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 at Thu Nov 5 11:54:53 MST 2009 + +This failure is due to updating the CICE external. CICE is run in +prognostic mode in the E compsets (SOM mode). + +dublin/lf95: All PASS + +dublin/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_65 +Originator(s): eaton +Date: Mon Nov 2 14:16:30 MST 2009 +One-line Summary: Add output for CCR diagnostics, and to verify forcings + for 20th century track1 runs. + +Purpose of changes: + +. Add diagnostic fields needed by the CCR package and for verifying that + the intended forcings have been used in the track1 20th century + simulations. + - The scalar GHG and solar const values were added to history output. + co2vmr was already there. The values n2ovmr, ch4vmr, f11vmr, f12vmr, + sol_tsi have been added to all history files. + - PRECT was added by default to monthly avg output. + - The aerosol optical depths (visible) of all species affecting the + climate have been added by default to the monthly avg output. + - The ability to output the column burdens of all aerosol and gas species + that affect the climate was added. The burdens of SO4 and O3 have been + added to the default monthly avg file (via fincl1) for the + 1850-2005_track1 use case. + +. Modify regression tests to improve coverage of the production 1850_track1 + and 1850-2005_track1 use cases. + +. Mod to configure needed for building for BGL and BGP from CCSM scripts. + +. Mods to PGI settings in Makefile.in for consistency with CCSM scripts. + +. Misc cleanup + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/test/system/config_files/f1.9c351h +models/atm/cam/test/system/config_files/f1.9c351m +. new files for track1 physics (c351 ==> cam3_5_1) + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. PGI settings: + - change optimization from -fast to -O2 (keep -Mvect=nosse -Kieee) + - apply the threading options to FFLAGS_NOOPT macro + - remove special compilation rule for seq_timemgr_mod.o for consistency + with CCSM build. + +models/atm/cam/bld/build-namelist +. fix logic for when defaults are added for co2vmr. That value is needed + for the RAMP_CO2_ONLY option and for waccm_mozart which were previously not + adding defaults for co2vmr (hence the hardcoded value in chem_surfvals + was being used). +. remove redundant specification of default values for tracer_cnst_type and + tracer_cnst_ymd which are present in the namelist_defaults_cam.xml file. + +models/atm/cam/bld/configure +. Only add the Fortran name mangling macro to the cppdefs list for a cam + standalone build. When build from the CCSM scripts they take care of + setting this macro. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add nu_q definition and defaults (for homme) + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +. add cb_ozone_c and cb_sulf_c to fincl1 list + +models/atm/cam/src/chemistry/utils/solar_data.F90 +. initialize sol_tsi to -1.0. Default value set by build-namelist. + +models/atm/cam/src/control/cam_history.F90 +. add n2ovmr, ch4vmr, f11vmr, f12vmr, sol_tsi + +models/atm/cam/src/control/hycoef.F90 +. add initializers for module data ps0, psr, and change them to parameters. + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. add an add_default call for the individual aerosol optical depth + (visible) fields. + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add PRECT to default monthly avg history file + +models/atm/cam/src/physics/cam/chem_surfvals.F90 +. change initialization values of co2vmr, n2ovmr, ch4vmr, f11vmr, f12vmr to + -1.0. The default values are set by build-namelist. + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. add diagnostics for column burden of both gases and aerosols + +models/atm/cam/src/physics/cam/radiation.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +. replace rad_cnst_clim_aer_out by generic rad_cnst_out + +models/atm/cam/src/utils/pio_utils.F90 +. remove base=0 optional arg that's hardcoded in the init_pio_subsystem + call. + +models/atm/cam/src/control/runtime_opts.F90 +models/atm/cam/src/utils/time_manager.F90 +. remove timemgr_preset from time_manager.F90 and remove the call to + timemgr_preset from subroutine preset in module runtime_opts. dtime is + the only thing being set and setting this value has been moved to + build-namelist. + +models/atm/cam/test/system/CAM_runcmnd.sh +. add -d ${CAM_THREADS} to aprun command for hybrid mode. + +models/atm/cam/test/system/input_tests_master +. define new tests: + - sm372 TSM.sh f1.9m fvvp_lb2 9s + - er372 TER.sh f1.9m fvvp_lb2 4+5s + - bl372 TBL.sh f1.9m fvvp_lb2 9s + - eq374 TEQ.sh f1.9m fvvp_lb2 f1.9m fv1d_lb2 9s + - eq375 TEQ.sh f1.9m fvvp_lb2 f1.9m fvvp_lb0 9s +. change definition: + - sm379 TSM.sh wm1.9m outfrq3s 9s + changed to sm379 TSM.sh wm1.9m outfrq3s+waccm_1850_track1 9s + - er379 TER.sh wm1.9m outfrq3s 4+5s + changed to er379 TER.sh wm1.9m outfrq3s+waccm_1850_track1 4+5s + - bl379 TBL.sh wm1.9m outfrq3s 9s + changed to bl379 TBL.sh wm1.9m outfrq3s+waccm_1850_track1 9s + - cb386 TCB.sh f1.9m + changed to cb386 TCB.sh f1.9c351m + - sm385 TSM.sh f1.9h outfrq24h+1870_control 2m + changed to sm385 TSM.sh f1.9c351h outfrq24h+1850_track1 2m + - sm386 TSM.sh f1.9m outfrq24h+1870_control 2m + changed to sm386 TSM.sh f1.9c351m outfrq24h+1850_track1 2m + - er385 TER.sh f1.9h outfrq24h+1870_control 1+1m + changed to er385 TER.sh f1.9c351h outfrq24h+1850_track1 1+1m + - er386 TER.sh f1.9m outfrq24h+1870_control 1+1m + changed to er386 TER.sh f1.9c351m outfrq24h+1850_track1 1+1m + - bl385 TBL.sh f1.9h outfrq24h+1870_control 2m + changed to bl385 TBL.sh f1.9c351h outfrq24h+1850_track1 2m + - bl386 TBL.sh f1.9m outfrq24h+1870_control 2m + changed to bl386 TBL.sh f1.9c351m outfrq24h+1850_track1 2m + - pf385 TPF.sh f1.9h outfrq24h+1870_control 2m + changed to pf385 TPF.sh f1.9c351h outfrq24h+1850_track1 2m + - pf386 TPF.sh f1.9m outfrq24h+1870_control 2m + changed to pf386 TPF.sh f1.9c351m outfrq24h+1850_track1 2m + +models/atm/cam/test/system/tests_posttag_jaguar +. replace sm371 er371 bl371 eq372 eq373 + by sm372 er372 bl372 eq374 eq375 + +models/atm/cam/test/system/tests_posttag_jaguar_cb +. remove cb371 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 at Mon Nov 2 12:49:10 MST 2009 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 at Mon Nov 2 13:00:02 MST 2009 + +dublin/lf95: All PASS except: +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Sun Nov 1 12:18:36 MST 2009 + +dublin/pgi: All PASS except: +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 at Sat Oct 31 16:46:56 MDT 2009 + +The above baseline failures are all due to removing the hardcoded GHG +values from the chem_surfvals module and requiring that these values be set +via the namelist. The failed tests were all making use of the hardcoded +value of co2vmr, and that value changed when the default came from the +namelist. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for configurations that +were using the hardcoded GHG values in chem_surfvals. + +=============================================================== +=============================================================== + +Tag name: cam3_6_64 +Originator(s): Francis Vitt +Date: 27 Oct 2009 +One-line Summary: Miscellaneous chemistry cleanup and bug fixes + +Purpose of changes: + +The main purpose is to make waccm physics features available to +tropospheric chemistry configurations. The changes are summarized as: + + - added ability to configure waccm physics with any chemistry configuration + - fix needed to customize chemistry mechanism without dust and sea salt + - fix needed to get troposphere level with customized chemistry mech without + prognostic ozone present + - cleaned up physics/cam/chemistry.F90 -- removed deprecated chemistry code + - cleaned up aerosol_drydep_intr interface -- removed MODAL_AERO cpp def + - fix in waccm ctem module for cases where more processors are + operating on physics than on dynamics + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/chem_preprocess.pl + Moved to the bld/perl5lib/Build/ChemPreprocess.pm. + +List all subroutines added and what they do: + +A models/atm/cam/bld/perl5lib/Build/ChemPreprocess.pm + Chemistry preprocessor perl code file was moved to the bld/perl5lib/Build + subdirectory and implemented as a perl module. A check for prognostic + sea salt and dust was added which was needed for customized chemistry + mechanisms. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml +M models/atm/cam/bld/config_files/defaults_waccm_ghg.xml +M models/atm/cam/bld/config_files/defaults_waccm_mozart.xml + Option "-waccm_phys" was added to get the users the ability to + configure with waccm physics for any of the chemistry packages. + +M models/atm/cam/bld/build-namelist + Set the appropriate gravity wave namelist when configured with -waccm_phys option + +M models/atm/cam/src/control/runtime_opts.F90 + Misc cleanup. + Replaced cpp flags WACCM_GHG, WACCM_MOZART with WACCM_PHYS. + +M models/atm/cam/src/control/camsrfexch_types.F90 + Nullify ram1 and fv pointers before they are allocated. + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 + Removed DUST and PROGSSLT cpp flags . + +M models/atm/cam/src/physics/cam/initindx.F90 +M models/atm/cam/src/physics/cam/trb_mtn_stress.F90 +M models/atm/cam/src/physics/cam/cldwat2m.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/esinti.F90 +M models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +M models/atm/cam/src/physics/cam/advnce.F90 +M models/atm/cam/src/physics/cam/cldwat.F90 +M models/atm/cam/src/physics/cam3_6/cldwat2m.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 + Replaced cpp flags WACCM_GHG, WACCM_MOZART with WACCM_PHYS. + This makes waccm physics available to tropospheric chemistry + configurations. + +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/physics/cam/tphysac.F90 + Made clybry_fam module available to TROCHEM configuration. + +M models/atm/cam/src/physics/cam/cloud_fraction.F90 + Cleanup -- removed to not-used waccm check. + +M models/atm/cam/src/physics/cam/chemistry.F90 + Cleanup -- removed to not-used chemistry code . + +M models/atm/cam/src/physics/waccm/ctem.F90 + Fix bug when more PEs are used in physics than in dynamics. + +M models/atm/cam/src/physics/waccm/radheat.F90 + Add a check for waccm heating. + Misc clean up. + +M models/atm/cam/src/physics/waccm/gw_drag.F90 + Jack Chen's changes: + 1) change the source level of Beres scheme to the top of heating instead of 100 mb. + 2) momentum/energy tendency below gravity wave source level to ensure the + total momentum/energy of the entire column is conserved. + +M models/atm/cam/src/physics/waccm/qbo.F90 +M models/atm/cam/src/chemistry/mozart/mo_setz.F90 + Misc clean up. + +M models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 + Removed the MODAL_AERO cpp flag from the aerosol_drydep_intr subroutine + interface. + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/llnl_set_chem_trop.F90 + Fixed bug where the tropopause level was not set when mechanism does + not have prognostic ozone. + +M models/atm/cam/src/chemistry/mozart/mo_tropopause.F90 + Removed the check for the need for tropopause level. + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + Made stratosphere aerosol feedback available to troposphere chemistry + configurations. + +M models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 + Made has_hrates variable public. + +M models/atm/cam/src/chemistry/mozart/mo_tuv_inti.F90 + Added "_r8" kind specifier to zero constant. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 + - Failed due to changes in waccm/gw_drag.F90. + +calgary/lf95: + +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + - Failed due to changes in waccm/gw_drag.F90 and physics for waccm_ghg. + +calgary/pgi or jaguar/pgi: + +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + - Failed due to changes in waccm/gw_drag.F90 and physics for waccm_ghg. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_63 +Originator(s): Jim Edwards +Date: 10-19-2009 +One-line Summary: update of tropopause interpolation for cs grids + +Purpose of changes: code development and cleanup + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + control/landfrac_file.F90 + no longer used + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + control/runtime_opts.F90 + some namelist strings were declared too short for possible options + + control/ncdio_atm.F90 + control/interpolate_data.F90 + control/startup_initialconds.F90 + utils/pio_utils.F90 + dynamics/eul/inidat.F90 + dynamics/homme/inidat.F90 + dynamics/fv/inidat.F90 + + code cleanup, added support for files with more than one timelevel + + physics/cam/tropopause.F90 + physics/cam/phys_prop.F90 + physics/cam/modal_aer_opt.F90 + physics/cam/radae.F90 + update IO method to PIO, update tropopause interpolation to one compatible + with unstructured grids. This change causes some non bfb differences in + tropopause level diagnostic fields. + + chemistry/utils/mo_solar_parms.F90 + chemistry/utils/tracer_data.F90 + Update IO method to PIO + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 037 bl371 TBL.sh f1.9dm fvvp_lb2 9s + 041 bl375 TBL.sh f1.9h outfrq24h 2d + 048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s + +dublin/lf95: All pass except + 004 bl111 TBL.sh e8t5mdm ttrac 9s + 008 bl112 TBL.sh e8dm ghgrmp 9s + 014 bl114 TBL.sh e8dm co2rmp 9s + +calgary/pgi or jaguar/pgi: All pass except + 004 bl111 TBL.sh e8t5mdm ttrac 9s + 008 bl112 TBL.sh e8dm ghgrmp 9s + 014 bl114 TBL.sh e8dm co2rmp 9s + + All failures due to differences in diagnostic tropopause height fields due to change in + the interpolation algorythm for climatological tropopause file. + These fields are diagnostic only and do not feed back to model prognostics. + Differences may be greater than roundoff but generally in the 6th digit or less. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_62 +Originator(s): Jim Edwards / Pat Worley / Mark Taylor +Date: 8-13-2009 +One-line Summary: Homme Dynamics update/ handshake logic update / pio interface update + +Purpose of changes: Code development and improvement + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + +Changed mpi handshake logic to avoid potential deadlock. +M 18837 models/utils/pilgrim/mod_comm.F90 +M 18837 models/atm/cam/src/utils/spmd_utils.F90 + +Added a timestamp to the status message printed +M 18837 models/atm/cam/test/system/test_driver.sh + + +Moved initialization of surface fields sgh, sgh30,and landm from dynamics to physics +M 18837 models/atm/cam/src/physics/cam/comsrf.F90 +M 18837 models/atm/cam/src/physics/cam/physpkg.F90 +M 18837 models/atm/cam/src/dynamics/sld/inidat.F90 +M 18837 models/atm/cam/src/dynamics/eul/inidat.F90 +M 18837 models/atm/cam/src/dynamics/homme/inidat.F90 +M 18837 models/atm/cam/src/dynamics/fv/inidat.F90 + +New pio interface no longer requires arrays to be flattened before passing +M 18837 models/atm/cam/src/physics/cam/phys_buffer.F90 +M 18837 models/atm/cam/src/control/ncdio_atm.F90 +M 18837 models/atm/cam/src/control/cam_history.F90 +M 18837 models/atm/cam/src/physics/cam/restart_physics.F90 + +Message to stdout limited to masterproc +M 18837 models/atm/cam/src/chemistry/mozart/mo_jlong.F90 + +Homme dynamics updated with support for tracer/dynamics subcycling +M 18837 models/atm/cam/src/dynamics/homme/external/filter_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/derivative_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/coordinate_systems_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/control_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/element_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/edge_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 +M 18837 models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M 18837 models/atm/cam/src/dynamics/homme/stepon.F90 +M 18837 models/atm/cam/src/dynamics/homme/dyn_comp.F90 +M 18837 models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + +Updated PIO +M 18837 SVN_EXTERNAL_DIRECTORIES + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except + 051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL + expected due to ongoing development of dycore. + +dublin/lf95: all pass + +calgary/pgi or jaguar/pgi: calgary - all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_61 +Originator(s): pworley +Date: Wed Sep 30 2009 +One-line Summary: spectral Eulerian dycore performance optimizations; +T341 support; new repro_sum option + +Purpose of changes: Improve performance of spectral Eulerian dycore when +have exhausted MPI parallelism; introduce new, cheaper, reproducible sum +option; add support for T341 resolution + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +* added OUTER_OMP cpp token to revert to original implementation of + OpenMP in spectral Eulerian dycore + +Describe any changes made to the namelist: + +* added phys_twin_algorithm to cam_inparm to specify whether to use + twin algorithm in creating physics chunks (potentially overriding default) + +* added repro_sum_use_ddpdd in cam_inparm to select alternative + reproducible sum algorithm + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +* Can improve performance of spectral Eulerian dycore significantly (~2x) + on systems with OpenMP parallelism when using large MPI process counts + +* Can degrade performance of spectral Eulerian dycore slightly on systems + with OpenMP parallelism when using small MPI process counts. Adding + OUTER_OMP to cpp tokens when compiling will restore original performance + +Code reviewed by: self + +List all subroutines eliminated: + +* usetlbuf in cam/src/control/usetlbuf.c + call to the routine was eliminated in cam3_4_04. Eliminating file now. + +List all subroutines added and what they do: + +* fc_gathervc in cam/src/utils/spmd_utils.F90 + flow control gather for character strings + +* repro_sum_ddpdd and DDPDD in cam/src/utils/repro_sum_mod.F90 + He and Ding's implementation of the double-double reproducible sum + algorithm + +* x86_fix_start and x86_fix_end in cam/src/utils/repro_sum_x86.c + routines to set and restore round-to-double flag in the control word + of a x86 fpu (required for double-double algorithm) + +List all existing files that have been modified, and describe the changes: + +1) The primary performance optimization has been moving OpenMP off of the loops +that are also decomposed with MPI and onto inner loops. Some of these loops +have also been restructured to improve the effectiveness of the OpenMP +parallelism. Legacy Cray vectorization and streaming directives were also +removed during this process. + + src/advection/slt/bandij.F90 + src/advection/slt/difcor.F90 + src/advection/slt/kdpfnd.F90 + src/advection/slt/omcalc.F90 + src/advection/slt/pdelb0.F90 + src/advection/slt/plevs0.F90 + src/advection/slt/qmassa.F90 + src/advection/slt/xqmass.F90 + + src/dynamics/eul/cubydr.F90 + src/dynamics/eul/cubzdr.F90 + src/dynamics/eul/dyndrv.F90 + src/dynamics/eul/dp_coupling.F90 + src/dynamics/eul/grmult.F90 + src/dynamics/eul/herxin.F90 + src/dynamics/eul/heryin.F90 + src/dynamics/eul/herzin.F90 + src/dynamics/eul/lagyin.F90 + src/dynamics/eul/limdy.F90 + src/dynamics/eul/limdz.F90 + src/dynamics/eul/linemsdyn.F90 + src/dynamics/eul/quad.F90 + src/dynamics/eul/realloc4.F90 + src/dynamics/eul/realloc7.F90 + src/dynamics/eul/scan2.F90 + src/dynamics/eul/scandyn.F90 + src/dynamics/eul/scanslt.F90 + src/dynamics/eul/spegrd.F90 + src/dynamics/eul/sphdep.F90 + src/dynamics/eul/stats.F90 + src/dynamics/eul/tfilt_massfix.F90 + src/dynamics/eul/trjmps.F90 + src/dynamics/eul/tstep.F90 + + src/physics/cam/virtem.F90 + +2) Added support for T341 resolution + + bld/config_files/horiz_grid.xml + src/dynamics/eul/dycore.F90 + src/physics/cam/cldwat.F90 + src/physics/cam/cloud_fraction.F90 + src/physics/cam/hk_conv.F90 + src/physics/cam/zm_conv.F90 + +3) Added a flow control version of gather used to determine names of nodes +during intialization + + src/utils/spmd_utils.F90 + +4) Added DDPDD alternative reproducible sum algorithm. + + src/utils/repro_sum_mod.F90 + src/utils/repro_sum_x86.c + src/control/mpishorthand.F + +5) Added namelist support for choice of algorithm to use in creating physics +chunks. The default is for lon/lat grids to look for north/south; day/night +"twins" when assigning columns to chunks, and not to do this for unstructured +grids. Setting phys_twin_algorithm=.true. will force the twin algorithm to be +used. Setting phys_twin_algorithm=.false. will disable the twin algorithm. +Also added namelist support for the DDPDD alternative reproducible +sum algorithm. Setting repro_sum_use_ddpdd=.true. will enable this option. + + bld/namelist_files/namelist_definition.xml + src/control/runtime_opts.F90 + +6) MPI communication optimization + src/dynamics/eul/bndexch.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: PASSED + +calgary/lf95: PASSED + +calgary/pgi: PASSED + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +NONE (bit for bit) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_60 +Originator(s): rneale,mvr +Date: Mon Sep 28 2009 +One-line Summary: additional output fields for ipcc analysis; fix to scam test; +code work-arounds to enable testing with intel compilers; adjustment to waccm +tuning parameter + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/nl_files/scm_prep_35 +- removing obsolete namelist options test file + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/config_files/scm64bfbiop_35 +M models/atm/cam/test/system/config_files/e64bfbiop_35 +M models/atm/cam/test/system/input_tests_master +- corrected config settings for testing scam with cam3_5_1 physics + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- change to tuning parameter (rhminl) default for waccm at 1.9x2.5 + +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/radlw.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +- added output of fields required for ipcc analysis + +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M models/atm/cam/src/advection/slt/phcs.F90 +- code work-arounds to enable testing with intel compilers + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire:none + +calgary/lf95:none + +calgary/pgi:none + +CAM tag used for the baseline comparison tests if different than previous + +Summarize any changes to answers: bfb + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_59 +Originator(s): jet, jedwards +Date: Tue Sep 15 15:24:42 MDT 2009 +One-line Summary:Bug fixes for scam and CAM column output + +Purpose of changes:fixes a problem with restarts when using column output + and bug fixes for scam aerosol deposition +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system:na + +Describe any changes made to the namelist:na + +List any changes to the defaults for the boundary datasets:na + +Describe any substantial timing or memory changes:na + +Code reviewed by:jet + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/control/cam_history.F90 + fix for column output +M models/atm/cam/src/utils/spmd_utils.F90 + fix for column output +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 + fix for scam dry deposition +M models/atm/cam/src/dynamics/eul/inidat.F90 + fix for scam dry deposition +M models/atm/cam/src/dynamics/eul/iop.F90 + fix for scam dry deposition + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire:none + +calgary/lf95: + +calgary/pgi or jaguar/pgi:none + +CAM tag used for the baseline comparison tests if different than previous +tag:cam3_6_58 + +Summarize any changes to answers, i.e., + + Default model is bfb + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_58 +Originator(s): eaton, jedwards +Date: Thu Sep 3 11:44:33 MDT 2009 +One-line Summary: Update externals; add cloud fraction tuning parameters to namelist. + +Purpose of changes: + +. Update externals to be consistent with ccsm4_0_beta22: + cice4_0_20090805 --> cice4_0_20090831 + clm3_6_47 --> clm3_6_51 + drvseq3_0_24 --> drvseq3_0_29 + share3_090706b --> share3_090825 + scripts4_090722b --> scripts4_090901a + +. Move the cloud fraction tuning parameters rhminl, rhminh to the + namelist. The code that previously set these parameters in cldfrc_init + has been replaced by entries in the namelist_defaults_cam.xml file. The + logic for supported tunings has been simplified by making use of the + high level physics package attribute. So now the default settings are + available for the track1 and track5 physics packages (corresponding to + the -phys values cam3_5_1 and cam), and some chemistry packages. And of + course the tunings remain resolution dependent. + + Most importantly, when experimenting with tunings for any particular + model configuration, the user only needs to add values to the namelist + input rather than having to wade through the quagmire of default settings + in cldfrc_init in order to modify the source code. + +. Modify build-namelist to allow the definition, defaults, and use case + files to be located in the user source directories (specified via the + -usr_src argument to configure). + +. Some workarounds for the intel compiler. + +Bugs fixed (include bugzilla ID): + +. Fix problems with column output, including the longstanding restriction + that column output doesn't work for fields with names that contain the + underscore character. + +. Remove the setting of NF90_NOCLOBBER in calls to nf90_open (this was a + one line change in cam_history.F90). NF90_NOCLOBBER is not a valid + argument to nf90_open, but most netcdf libraries were silently ignoring + this. We encountered an error when trying to link with netcdf4 libs that + were built with hdf5 enabled. + + +. Fix bug in build-namelist that resulted in the default setting for forganic + having the inputdata root directory prepended twice. This only occurred + when the inputdata root directory was specified as a relative path. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add outnc_large_files to clm_inparm group + +. remove atm_cdf64, ice_cdf64, lnd_cdf64, ocn_cdf64 -- not used + +. add cldfrc_rhminl, cldfrc_rhminh for setting cloud fraction tuning + parameters rhminl and rhminh. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. cice4_0_20090805 --> cice4_0_20090831 +. clm3_6_47 --> clm3_6_51 +. drvseq3_0_24 --> drvseq3_0_29 +. share3_090706b --> share3_090825 +. scripts4_090722b --> scripts4_090901a + +models/atm/cam/bld/Makefile.in +. Intel compiler options: move -132 out of FFLAGS and into FIXEDFLAGS. + This allows the compiler to process lines longer than 132 chars in free + format source code. +. Add -static-intel to the intel LDFLAGS to get around problem with CGD + cluster dublin. Should be temporary. + +models/atm/cam/bld/build-namelist +. Fix the default setting for forganic (the inputdata root directory was + being prepended twice). +. add cldfrc_rhminl and cldfrc_rhminh by default. +. Modify to allow the definition, defaults, and use case files to be + located in the user source directories (specified via the -usr_src + argument to configure). + +models/atm/cam/bld/configure +. fixed a comment + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add defaults for cldfrc_rhminl, cldfrc_rhminh + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add outnc_large_files to clm_inparm group +. fix documentation for use_64bit_nc +. remove atm_cdf64, ice_cdf64, lnd_cdf64, ocn_cdf64 -- not used +. add cldfrc_rhminl, cldfrc_rhminh + +models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +. Replace parameter index reference by a variable index (workaround for + intel compiler). + +models/atm/cam/src/control/cam_history.F90 +. Fix problems with column output, including the longstanding restriction + that column output doesn't work for fields with names that contain the + underscore character. +. Remove pio_noclobber flag from the call to cam_pio_openfile. + +models/atm/cam/src/control/gauaw_mod.F90 +. replace a sqrt generic function call by ()**0.5_r16. Don't know why this + wasn't working since ifort supports quad precision. + +models/atm/cam/src/dynamics/fv/inidat.F90 +models/atm/cam/src/dynamics/fv/metdata.F90 +. Move pio use association out of subroutines and up to module level + (workaround for intel compiler). + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. set tuning parameters rhminl, rhminh via namelist + - remove inline code in cldfrc_init for setting rhminl, rhminh + +models/atm/cam/src/physics/cam/phys_buffer.F90 +. remove old code for binary restart files +. add ability to break large fields into smaller pieces for writing to + restart. If the global field is larger than 4-GB, then try to split it + up using the last pbuf dimension. This avoids a size limit imposed by + the netcdf 64-bit offset format. + +models/atm/cam/src/physics/cam/convect_shallow.F90 +models/atm/cam/src/physics/cam/phys_debug.F90 +models/atm/cam/src/physics/cam/physics_types.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. replace hardcoded constituent indices for cldliq & cldice + +models/atm/cam/test/system/test_driver.sh +. changes for intel compiler and for dublin cluster + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 + +calgary/lf95: All PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +dublin/pgi: All PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +The failed baseline tests are due to updating the CLM and CICE components. +The baseline tests in aqua-planet, ideal, and adiabatic modes all pass. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate due to changes in CLM and +CICE components. + +=============================================================== +=============================================================== + +Tag name: cam3_6_57 +Originator(s): Dani Bundy Coleman +Date: 08/13/09 +One-line Summary: Add optional ESMFv3 interfaces in order to use the Gregorian calendar + +Purpose of changes: +To use the Gregorian calendar, CAM must link with the actual ESMF library +instead of the default WRF fortran implementation of it. +The configure option to do this remains unchanged: + -esmf_libdir directory +There is a new configure option: + -esmf_libvers [ 2 (default) | 3 ] +that is only necessary if configure is unable to determine the library +version through an automatic test. The default remains esmf_libvers=2 for +compatibility with the WRF implementation of the ESMF library. + +This code includes the changes necessary for CAM to run with a Gregorian +calendar (existing namelist variable: calendar = 'GREGORIAN' ) but this +option will fail until the externals (drv,lnd,csm_share) have been updated. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: + Added configure option -esmf_libvers [ 2 (default) | 3 ] + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary data set: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Eaton + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_time_manager.F90 + +M models/ice/csim4/ice_time_manager.F90 +Change ESMF variables from intent(in) to intent(inout) in order to use +ESMF version 3. When using a Gregorian calendar, have time managers +fake day 366 by repeating day 365. This allows the models to run on +leap-years without having to modify the solar zenith angle calculations. + +M models/atm/cam/src/utils/time_manager.F90 +In addition to above, trap for Feb 29 of a non-leap year, which +might be invoked legitimately by a routine reading a dataset for a fixed +year (see below). + +M models/atm/cam/bld/configure +Require test of ESMF library when invoked with the existing option +-esmf_libdir in order to test which ESMF version is being used. Required +some re-ordering of flow. Add option -esmf_libvers [ 2 (default) | 3 ] in +case the test fails. + +M models/atm/cam/bld/Makefile.in +If using the ESMF library, override default linker with ESMF recommendation + +M models/atm/cam/bld/config_files/definition.xml +Add esmf_libvers option + +M models/atm/cam/src/chemistry/mozart/mo_flbc.F90 +Trap for Feb 29 of a non-leap year, which might be invoked legitimately by +a routine reading a dataset for a fixed year (see below). + +Explanation of the Feb 29 trap: +When using a fixed year from a dataset, these routines create an integer +date by combining the fixed year with the current model day-of-year. +This fails on Feb 29 of a leap year: + e.g. fixed year = 1990 + model date = 20000229 + combined date = 19900229 +Since this is an unrealistic date, we trap for it here, using Feb 28 +instead of Feb 29. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: None + +calgary/lf95: None + +calgary/pgi or jaguar/pgi: None + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., + Default model is bfb + +=============================================================== + +Tag name: cam3_6_56 +Originator(s): Art Mirin +Date: 08/10/2009 +One-line Summary: Alternative OpenMP in FV dynamics + +Purpose of changes: In FV dynamics, OpenMP is applied in the vertical direction. For example, for +cases with one level per subdomain, OpenMP becomes meaningless. An option has been added to instead +apply OpenMP to horizontal loops throughout sw_core and tp_core. Because this involves whether or +not to include directives, the option is necessarily a compile-time option. In order to apply this +option, one must define the CPP flag INNER_OMP. One should not do this in general, since +for cases where there are enough levels per subdomain to apply OpenMP, there is less OpenMP +overhead applying it vertically. If the user does not define INNER_OMP, the precompiled code +will be identical to the previous tag. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Worley + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +In dynamics/fv, files cd_core.F90 and trac2d.F90 optionally have OpenMP directives removed; +files sw_core.F90 and tp_core.F90 optionally have OpenMP directives added. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +calgary/lf95: + +calgary/pgi or jaguar/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_55 +Originator(s): mvr,eaton,hannay +Date: Thu Aug 6 2009 +One-line Summary: Completed update of externals to be consistent with ccsm; +modified machine support in test scripts; new aerosol/ozone datasets; track1 tuning + +Purpose of changes: + +- Updated externals as follows: + clm3_6_46 -> clm3_6_47 + cice4_0_20090721 -> cice4_0_20090805 + + clm needed update to fix bug in hybrid dynamic pft code; cice needed update to fix + bug where lahey detected use of variable with undefined value + +- new aerosol and ozone datasets arrived for the 1850-2005 transient runs and for + the 2000 climatology - gives new climate + +- linux cluster bangkok was retired and a new cluster came online (dublin)... + the test scripts were modified to reflect this + +- tuning parameter rhminl was tweaked for track1: + for 0.9x1.25: .91_r8 to .920_r8 + for 1.9x2.5: .92_r8 to .924_r8 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new aerosol and ozone datasets + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/tests_pretag_bangkok +- file containing set of required tests removed for retired machine + +List all subroutines added and what they do: +A + models/atm/cam/test/system/tests_pretag_calgary +- new file for set of required tests on machine calgary + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- test scripts modifed for machine changes (bangkok out, dublin in) + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +- mods to reflect new aerosol and ozone datasets + +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +- new setting for tuning parameter rhminl + +M SVN_EXTERNAL_DIRECTORIES + M . +- updated externals as summarized above. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 +- baselines (except adiabatic and ideal physics) failed due to new aerosol + and ozone datasets; bl387 would've failed anyway due to bug fix + +dublin/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 5 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 5 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 5 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 5 +017 bl115 TBL.sh e8idm idphys 9s ..................................FAIL! rc= 5 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 5 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 5 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 5 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 5 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 5 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 5 +- all baselines failed because baseline was not set up to run on dublin; + +calgary/pgi: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +- all baselines (except ideal physics) failed due to new aerosol and ozone + datasets + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: New climate due to new aerosol and ozone datasets + +=============================================================== +=============================================================== + +Tag name: cam3_6_54 +Originator(s): eaton +Date: Mon Aug 3 11:23:46 MDT 2009 +One-line Summary: Update externals to be consistent with ccsm4_0_beta20. + +Purpose of changes: + +. Updated externals as follows: + clm3_6_19 -> clm3_6_46 + cice4_0_20090226 -> cice4_0_20090721 + scripts4_090428 -> scripts4_090722b + docn7_090107 -> docn7_090720 + + **NOTE** clm3_6_46 has a known bug in the hybrid dynamic pft code. + Consequently this tag should not be used in hybrid mode for transient + simulations (climatology runs are OK). The fix will be added to the + next CAM commit. + +. Mods so that SCAM works with the updated CLM and with trop_mam3. + +. Added WACCM use case for 1850 track1 simulations. + +. Added use case for 1850 track1 w/ 2X CO2 simulations. + +. Updated regression tests to use the CCSM version of cprnc. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/1850_track1_2xco2.xml +. same as use case 1850_track1 except double the CO2 value + +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_track1.xml +. use case for waccm 1850 track1 runs + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. updated externals as summarized above. + +models/atm/cam/bld/build-namelist +. add code to use sim_year in generating the clm namelist +. update code for clm namelist to be consistent with clm3_6_46 +. add -DCO2A to the cppdefs. The clm namelist is now being set with the + variable co2_type='diagnostic' so it always listens to the atm to recieve + the surface CO2 concentration. -DCO2A is needed when building the + coupler to make sure these fields are always allocated. +. added capability to not include the aerosol deposition dataset in the CLM + namelist when CAM will provide the deposition fluxes to the coupler. + Note: due to CLM bug the aerosol deposition dataset currently needs to be + added to the CLM namelist whether it's used or not. + +models/atm/cam/bld/configure +. define -DCO2A for building the cpl7 code. This is currently the only BGC + option implemented. +. change -DMAXPATCH_PFT=4 to -DMAXPATCH_PFT=numpft+1 for CLM build. +. add new CLM directory for mct or esmf component interface. +. add new CICE directories for mct or esmf component interface. +. hack to modify output of CICE configure in SCAM mode since the CICE + configure doesn't support SCAM mode. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update clm defaults for consistency with clm3_6_43 + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add sim_year +. remove old clm variables: csm_doflxave, irad +. add new clm variables: rtm_nsteps, urban_hac, urban_traffic + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_bam.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml +. add setting for sim_year + +models/atm/cam/src/control/cam_restart.F90 +. move 'use pio' for intel compiler workaround + +models/atm/cam/bld/build-namelist +models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +models/atm/cam/src/chemistry/utils/tracer_data.F90 +models/atm/cam/src/control/history_defaults.F90 +models/atm/cam/src/control/scamMod.F90 +models/atm/cam/src/dynamics/eul/diag_dynvar_ic.F90 +models/atm/cam/src/dynamics/eul/inidat.F90 +models/atm/cam/src/dynamics/eul/iop.F90 +models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +models/atm/cam/src/physics/cam/initindx.F90 +models/atm/cam/test/system/nl_files/scm_prep +models/atm/cam/test/system/nl_files/scm_prep_35 +. mods for SCAM + +models/atm/cam/test/system/CAM_compare.sh +. update to parse output from cprnc version: + https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_081022 + +models/atm/cam/test/system/CAM_runcmnd.sh +. modify run commands for bluefire to use the environment variable + TARGET_CPU_LIST and add absolute paths to "launch" and "hybrid_launch" + +models/atm/cam/test/system/test_driver.sh +. update the location of the cprnc executable + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +046 er387 TER.sh f1.9c351dh outfrq3s+1850-2005_track1 4+5s ........FAIL! rc= 10 +047 br387 TBR.sh f1.9c351dh outfrq3s+1850-2005_track1 6+3s ........FAIL! rc= 12 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 5 + +The baseline failures are all expected due to the new climate of the CLM +tag. + +er387, br387, bl387 are all failing due to the bug in clm3_6_46. + +calgary/lf95: not done +There are currently problems with the mpich installation under lf95 on +calgary (since the OS upgrade). + +calgary/pgi: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +These baseline failures are expected due to the new climate of CLM. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: New climate due to updated CLM external. + +=============================================================== +=============================================================== + +Tag name: cam3_6_53 +Originator(s): Jim Edwards, Mark Taylor, Pat Worley, Jerry Olson +Date: 7-23-09 +One-line Summary: Update of homme dynamics, + correction of column output, + improvement of load balance initialization + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Updated build paths for calgary + +Describe any changes made to the namelist: Updated defaults for homme dycore, + reimplimented use_64bit_nc namelist flag + (this flag was disabled in cam3_6_39) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: originators + +List all subroutines eliminated: +- subroutine xzy_to_xyz (xyzbuf, xzybuf, dimind) +- subroutine loc_xzy_to_xyz (xyzbuf, xzybuf, dimind) +- subroutine loc_xyz_to_xzy (xzybuf, xyzbuf, dimind) + dead code in cam_history.F90 + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + updated build paths for calgary. + + models/atm/cam/test/system/CAM_compare.sh + models/atm/cam/test/system/test_driver.sh + models/atm/cam/test/system/CAM_runcmnd.sh + + modified build defaults for homme dycore + + models/atm/cam/bld/config_files/horiz_grid.xml + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + + Column output is unsupported for unstructured grids, added error checking on + fincllonlat + + models/atm/cam/src/control/runtime_opts.F90 + + Changed default value of use_64bit_nc to true + + models/atm/cam/src/control/cam_control_mod.F90 + + Added error checking for the case of a filename which exceeds the variable length + + models/atm/cam/src/control/ioFileMod.F90 + + added BGP to supported platforms + models/atm/cam/src/control/print_memusage.F90 + + + Corrected location of column data output, new locations were verified by + comparing netcdf column output to global output file using chkcol.ncl + + models/atm/cam/src/control/cam_history.F90 + models/atm/cam/src/utils/pio_utils.F90 + + Added code so that if the proc_name count exceeds 256 only the first 256 are printed to the log + + models/atm/cam/src/utils/spmd_utils.F90 + + improved initialization of load balancing scheme, especially for high task counts and + unstructed dycores. + models/atm/cam/src/physics/cam/phys_grid.F90 + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + + + development update of homme dycore. + models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 + models/atm/cam/src/dynamics/homme/external/reduction_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + models/atm/cam/src/dynamics/homme/external/cube_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + models/atm/cam/src/dynamics/homme/external/element_mod.F90 + models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 + models/atm/cam/src/dynamics/homme/external/edge_mod.F90 + models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + 051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 + Fails due to update of homme dycore + + + 052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 + 053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 + 054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + 055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 + 056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + Preexisting failures + +calgary/lf95: + all pass + +calgary/pgi or jaguar/pgi: + all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_6_51 (no relevent changes in cam3_6_52) + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_52 +Originator(s): eaton +Date: Thu Jul 23 11:19:58 MDT 2009 +One-line Summary: fix filepath for builds from ccsm scripts + +Purpose of changes: fix filepath for builds from ccsm scripts + +Bugs fixed (include bugzilla ID): + +. CAM's configure was not producing the correct filepath when run from the + CCSM scripts (with -ccsm_seq flag). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/configure +. fix filepath for ccsm mode + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: not done + +calgary/lf95: not done + +calgary/pgi or jaguar/pgi: not done + +No regression testing was done for this tag. The change only affects the +ccsm tests and they are currently failing for other reasons. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_51 +Originator(s): jedwards, eaton +Date: Tue Jul 21 14:04:05 MDT 2009 +One-line Summary: fixes for history buffer restart files + +Purpose of changes: + +. Finish fixing the bug in the history buffer restart files. The first + part of this fix was made in cam3_6_49. + +. Update externals: + drvseq3_0_14 -> drvseq3_0_24 + pio50_prod -> pio51_prod + share3_090112 -> share3_090706b + +Bugs fixed (include bugzilla ID): see above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. reduce memory requirement for unstructured grids by writing the global + lat, lon, and area fields one at a time. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update driver, csm_share, and pio + +models/atm/cam/src/control/cam_history.F90 +. fix for history buffer restart files +. reduce memory requirement for unstructured grids by writing the global + lat, lon, and area fields one at a time. + +models/atm/cam/src/utils/pio_utils.F90 +. removed some commented code + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +050 er731 TER.sh h16x4dm aqua 4+5s ................................FAIL! rc= 10 +051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +The ccsm test failures are pre-existing. + +Jim Edwards will address the homme test failures in his upcoming commit. + +calgary/lf95: All PASS + +calgary/pgi: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_50 +Originator(s): Francis Vitt +Date: 14 July 2009 +One-line Summary: + + Cleanup the old CAM3 prognostic aerosol code files and use + the chemistry preprocessor only when customizing the chemistry. + +Purpose of changes: + + The old CAM3 prognostic aerosol routines have been replicated + in the MOZART chemistry framework. The deprecated configure and + run-time options and source code have been removed to improve + maintainability. + + The configure script only invokes the chemistry preprocessor only + when the chemistry is customized which is done by providing the code files + generated by the preprocessor for the pre-defined chemistry packages. + The purpose of this is to avoid portability and long path name issues + associated with the chemistry preprocessor and shorten the configure time. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + Removed deprecated prog_aero configure option + +Describe any changes made to the namelist: + Removed the namelist variables: + aero_carbon + aero_dust + aero_progsslt + aero_sea_salt + bndtvdms + bndtvoxid + bndtvsox + caer_emis + rampyear_prognostic_sulfur + scenario_prognostic_sulfur + + Moved namelist variable soil_erod form cam_inparm to chem_inparm + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/physics/cam/progseasalts_intr.F90 +D models/atm/cam/src/physics/cam/drydep_mod.F90 +D models/atm/cam/src/physics/cam/dust_sediment_mod.F90 +D models/atm/cam/src/physics/cam/wetdep.F90 +D models/atm/cam/src/physics/cam/dust_intr.F90 +D models/atm/cam/src/physics/cam/aerosol_intr.F90 +D models/atm/cam/src/physics/cam/sulchem.F90 +These have moved to models/atm/cam/src/chemistry/bulk_aero + +D models/atm/cam/src/physics/cam/acbnd.F90 +D models/atm/cam/src/physics/cam/dmsbnd.F90 +D models/atm/cam/src/physics/cam/caer.F90 +D models/atm/cam/src/physics/cam/sulfur_intr.F90 +D models/atm/cam/src/physics/cam/sulemis.F90 +D models/atm/cam/src/physics/cam/sulbnd.F90 +D models/atm/cam/src/physics/cam/seasalt_intr.F90 +D models/atm/cam/src/physics/cam/soxbnd.F90 +D models/atm/cam/src/physics/cam/caerbnd.F90 +D models/atm/cam/src/physics/cam/carbon_intr.F90 +These deprecated module files have been removed. + +D models/atm/cam/src/chemistry/trop_mam3 +D models/atm/cam/src/chemistry/trop_bam +These directories have been replaced by pp_trop_mam3 and pp_trop_bam. + +List all subroutines added and what they do: + +A models/atm/cam/src/chemistry/bulk_aero +A models/atm/cam/src/chemistry/bulk_aero/progseasalts_intr.F90 +A models/atm/cam/src/chemistry/bulk_aero/drydep_mod.F90 +A models/atm/cam/src/chemistry/bulk_aero/dust_sediment_mod.F90 +A models/atm/cam/src/chemistry/bulk_aero/wetdep.F90 +A models/atm/cam/src/chemistry/bulk_aero/dust_intr.F90 +A models/atm/cam/src/chemistry/bulk_aero/aerosol_intr.F90 +A models/atm/cam/src/chemistry/bulk_aero/sulchem.F90 +These are the CAM3 aerosol module files that are used within the MOZART +chemistry framework. + +A models/atm/cam/src/chemistry/pp_trop_mozart +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 +These are the preprocessor generated code files for the trop_mozart +chemistry package. + +A models/atm/cam/src/chemistry/pp_trop_bam +A models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 +These are the preprocessor generated code files for the trop_bam +chemistry package. + +A models/atm/cam/src/chemistry/pp_trop_mam3 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 +These are the preprocessor generated code files for the trop_mam3 +chemistry package. + +A models/atm/cam/src/chemistry/pp_trop_mam7 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 +These are the preprocessor generated code files for the trop_mam7 +chemistry package. + +A models/atm/cam/src/chemistry/pp_trop_ghg +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 +These are the preprocessor generated code files for the trop_ghg +chemistry package. + +A models/atm/cam/src/chemistry/pp_super_fast_llnl +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 +These are the preprocessor generated code files for the super_fast_llnl +chemistry package. + +A models/atm/cam/src/chemistry/pp_waccm_mozart +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_mozart/mo_lin_matrix.F90 +These are the preprocessor generated code files for the waccm_mozart +chemistry package. + +A models/atm/cam/src/chemistry/pp_waccm_ghg +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_solve.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_setrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/m_rxt_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_phtadj.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_nln_matrix.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_adjrxt.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/m_het_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lu_factor.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_indprd.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_sim_dat.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/m_spc_id.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_imp_sol.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/chem_mods.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_prod_loss.F90 +A models/atm/cam/src/chemistry/pp_waccm_ghg/mo_lin_matrix.F90 +These are the preprocessor generated code files for the waccm_ghg +chemistry package. + +List all existing files that have been modified, and describe the changes: + +U models/atm/cam/bld/configure +Removed prog_aer option +Invoke chem preprocessor only when chem package is customized + + +U models/atm/cam/bld/config_files/definition.xml +Removed prog_aer configure option + +U models/atm/cam/bld/config_files/defaults_trop_mozart.xml +Made 1.9x2.5 the default resolution for trop_mozart chemistry + +U models/atm/cam/bld/namelist_files/namelist_definition.xml +Removed the CAM3 prognostic aerosol namelist variables listed above. +Moved soil_erod namelist varible to chem_inparm namelist + +U models/atm/cam/bld/build-namelist +Removed the old prognostic aerosol code + +U models/atm/cam/bld/perl5lib/t/config_definition.xml +Removed prog_aero configure option + +U models/atm/cam/SVN_EXTERNAL_DIRECTORIES +Modified chemistry preprocessor to handle longer path names + +U models/atm/cam/src/control/runtime_opts.F90 +Removed the namelist variables listed above +Moved soil_erod namelist varible to chem_inparm namelist + +U models/atm/cam/src/control/filenames.F90 +Remove the deprecated prognostic aerosol input file names + +U models/atm/cam/src/physics/cam/tropopause.F90 +Changed tropLev from real(r8) to integer since this is used to index arrays. + +U models/atm/cam/src/physics/cam/advnce.F90 +Removed the deprecated aerosol_time_interp subroutine call + +U models/atm/cam/src/physics/cam/tphysac.F90 +Removed the deprecated aerosol_srcsnk_intr subroutine call + +U models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +Changed tropLev from real(r8) to integer (see tropopause.F90). + +U models/atm/cam/src/chemistry/modal_aero/modal_aero_deposition.F90 +Fixed for trop_mam7 configuration. + +U models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +Removed code that checks the deprecated prognostic aerosol namelist settings + +U models/atm/cam/src/chemistry/mozart/chemistry.F90 +Moved soil_erod namelist varible from cam_inparm to chem_inparm namelist + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: pre-existing failures +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +calgary/lf95: All Pass + +calgary/pgi or jaguar/pgi: + +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +This fails due to the difference in molecular masses in the preprocessor generated +code produced by different compilers. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam3_6_49 +Originator(s): jedwards, eaton +Date: Wed Jul 8 12:15:07 MDT 2009 +One-line Summary: fixes for history buffer restart files + +Purpose of changes: + +. Some bugs have been discovered in the netcdf history buffer restart + files. Restart failures can occur when multiple time samples are being + written to a history file, and the restart occurs at a point when the + history buffers must be written to a restart file. + + This commit fixes part of the problem, i.e., the errors encountered when + trying to write some history buffer restart files. But there is an + outstanding problem which will be fixed in a subsequent commit, i.e., + some history buffer restart files will contain corrupted data which + impacts the next time sample written in the sequence. Things are OK for + subsequent time samples until another restart occurs. The workaround is + to use mfilt=1 for all history files that use averaging periods which + will require writing a history buffer restart file. + +. Update to pio50_prod + +. Some logfile cleanup. + +Bugs fixed (include bugzilla ID): see above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update pio external to pio50_prod + +models/atm/cam/bld/build-namelist +. bugfix: don't fail when the use case file is missing a default value that + has already been supplied by the user via the -namelist or -infile args. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. Add 'B' as a valid value of avgflag_pertape + +models/atm/cam/src/chemistry/mozart/spedata.F90 +. add some initializers for filename variables + +models/atm/cam/src/control/cam_history.F90 +. fixes for history buffer restart files + +models/atm/cam/src/control/runtime_opts.F90 +. logfile output cleanup + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except pre-existing failures: + +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +calgary/lf95: All PASS. + +calgary/pgi: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_48 +Originator(s): mvr +Date: 6/25/2009 +One-line Summary: bug fix for proper selection of cam initial files with ccsm; remove + -Mrecursive from pgi debug build; prep code for intel compilers + +Purpose of changes: +intel compilers limit line length to 132 chars; also, code work-arounds were required in +some instances of use association and array subscripting + +the use of -Mrecursive was tripping up a cam regression test (with pgi); after discussion +it was deemed unneccessary for debug builds + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- replaced a bad T42 cam initial dataset as the default for jan 1 startdates, 26levs + +List any changes to the defaults for the boundary datasets: +- replaced a bad T42 cam initial dataset as the default for jan 1 startdates, 26levs + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/test_driver.sh +- fix for invocation of 'showproj' to enable grabbing default charge account on jaguar + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +- bug fix to setting of tasks/threads when testing restarts and branches + +M models/atm/cam/bld/Makefile.in +- removed '-Mrecursive' from pgi debug compilation flags +- made 'icc' the default c compiler for ifort builds + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- replaced a bad T42 cam initial dataset as the default for jan 1 startdates, 26levs + +M models/atm/cam/bld/cam.cpl7.template +- bug fix for ccsm to grab correct cam initial file based on start date + +M models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +M models/atm/cam/src/chemistry/mozart/spedata.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +- workaround for use association of pio module + +M models/atm/cam/src/physics/cam/sulchem.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +- trim line lengths to <132 chars + +M models/atm/cam/src/chemistry/mozart/mo_photoin.F90 +M models/atm/cam/src/chemistry/mozart/mo_setaer.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +- workaround for array subscripting + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 + 053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 + 054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + 055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 + 056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +failures are pre-existing + +calgary/lf95: All pass + +calgary/pgi: All pass except +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 5 +failed due to problem in baseline code that has been fixed with removal of -Mrecursive flag + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_47 +Originator(s): Jim Edwards +Date: 6/15/2009 +One-line Summary: Fix model column output problem on restart + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: New PIO external should improve io performance. + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + cam_history.F90 - improved support for outputing single columns or block subsets + of model fields. Outputing columns was causing model failure on + restart. + test/system/nl_files/ghgrmp - added code to test column output so that this test + becomes a regular part of precommit and postcommit cam testing + SVN_EXTERNAL_DIRECTORIED - updated pio external + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 + 019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 + + + 052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 + 053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 + 054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + 055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 + 056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +calgary/lf95: All pass except + 008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 + 029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 + + +calgary/pgi or jaguar/pgi: + 008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 + 029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 + 032 sm314 TSM.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 8 + 033 er314 TER.sh wg10dm outfrq3s 4+5s .............................FAIL! rc= 5 + 034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 + + +The ghgrmp baseline tests fail due to the addition of a new history file for column output + all results in the existing files are BFB. Bluefire 052-056 and calgary 032-034 are + legacy failures. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_46 +Originator(s): Francis Vitt +Date: 12 June 2009 +One-line Summary: WACCM updates + +Purpose of changes: + Bring the trunk up to date with waccm branch. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/waccm_1850_cntrl.xml + - for ccsm 1850 "track 1" simulation + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - Corrected RSF photolysis file + +M models/atm/cam/src/chemistry/mozart/linoz_data.F90 +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - INTERP_MISSING_MONTHS option added + +M models/atm/cam/src/chemistry/mozart/mo_sad.F90 + - corrected strat aero rad forcing + +M models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/phys_control.F90 +M models/atm/cam/src/physics/cam/solvar_interface.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/tidal_diag.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +M models/atm/cam/src/chemistry/mozart/solar_photons.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/mozart/solvar_interface.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/solvar_data.F90 +M models/atm/cam/src/dynamics/fv/pfixer.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 + - merged in mods from waccm16_cam3_5_48 + - enabled stratospheric aerosols radiation feedback + +M models/atm/cam/src/chemistry/mozart/spedata.F90 + - write spedata log messages only from masterproc + +M models/atm/cam/src/control/cam_history.F90 + - change to appease Lahey compiler + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 + expected to fail due to waccm updates + +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +calgary/lf95: + +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + This is expected to fail due to parameter changes in waccm gravity wave routine. + +calgary/pgi or jaguar/pgi: + +032 sm314 TSM.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 8 +033 er314 TER.sh wg10dm outfrq3s 4+5s .............................FAIL! rc= 5 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_45 +Originator(s): eaton +Date: Thu Jun 11 12:35:34 MDT 2009 +One-line Summary: bugfix for branch runs via ccsm scripts + +Purpose of changes: + +. The camdom component isn't using netcdf for its restart files. Need to + back out the change in cam.cpl7.template that assumed it was. + +Bugs fixed (include bugzilla ID): see above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/cam.cpl7.template +. remove ".nc" from value of nrevsn_dom_nml + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: not done + +calgary/lf95: not done + +calgary/pgi or jaguar/pgi: not done + +No regression testing was done for this tag because the change in +cam.cpl7.template is only tested via the ccsm scripts, and our tests of the +ccsm scripts are currently failing for other reasons. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_44 +Originator(s): eaton +Date: Wed Jun 10 11:29:39 MDT 2009 +One-line Summary: Add directories to enable optional esmf component interfaces. + +Purpose of changes: + +. For each component the directories cpl_mct and cpl_esmf are added. The + current mct based component interfaces (in the modules xxx_comp_mct.F90) + are moved to the cpl_mct directory. The esmf component interfaces will + be added to the cpl_esmf directories. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. Add -comp_intf argument to configure. Once the esmf interfaces are in + place, they will be used by adding "-comp_intf esmf" to the configure + commandline. + +. Add BGP and BGL support to Makefile for chemistry preprocessor + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/control/atm_comp_mct.F90 +models/ice/csim4/ice_comp_mct.F90 +models/ocn/dom/ocn_comp_mct.F90 +. These files were moved to the new cpl_mct directories. + +models/ocn/som/mixed_layer.F90 +models/ocn/som/ocn_filenames.F90 +models/ocn/som/ocn_spmd.F90 +models/ocn/som/ocn_types.F90 +models/ocn/som/ocn_time_manager.F90 +models/ocn/som/somint.F90 +models/ocn/som/ocn_constants.F90 +models/ocn/som/ocn_comp.F90 +models/ocn/som/ocean_data.F90 +models/ocn/som/somini.F90 +models/ocn/som/ocn_comp_mct.F90 +. remove unused som code + +List all subroutines added and what they do: + +models/atm/cam/src/cpl_mct/atm_comp_mct.F90 +models/ice/csim4/cpl_mct/ice_comp_mct.F90 +models/ocn/dom/cpl_mct/ocn_comp_mct.F90 +. These files were moved into the new cpl_mct directories, and the SEQ_MCT + ifdefs were removed. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. chem_proc -> trunk_tags/chem_proc3_6_01 + +models/atm/cam/bld/configure +. add new option comp_intf to select which component interfaces to use. + Can be set to either mct or esmf. Default: mct. +. modify filepaths for cam, dom, and csim4 to use the cpl_* directories. + Wait to update the filepaths for other components until updating the + externals to versions that have the cpl_* directories implemented. Once + this is done the -DSEQ_MCT can be removed from Makefile.in. + +models/atm/cam/bld/config_files/definition.xml +. add comp_intf parameter w/ valid values mct or esmf. Default is mct. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +These are pre-existing failures. + +calgary/lf95: All PASS + +calgary/pgi: All PASS except: +032 sm314 TSM.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 8 +033 er314 TER.sh wg10dm outfrq3s 4+5s .............................FAIL! rc= 5 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 + +These are pre-existing failures. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_43 +Originator(s): eaton, mirin +Date: Thu Jun 4 12:50:57 MDT 2009 +One-line Summary: Misc bug fixes. + +Purpose of changes: + +. Workaround for PGI compiler bug. + +. Fix bug in hfilename_spec. User specification of history filenames was + being ignored. + +. Change to BG/L section of Makefile.in (Mirin). + +Bugs fixed (include bugzilla ID): + +. hfilename_spec wasn't being recognized. There was a missing broadcast of + the namelist variable. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. change compilers for BG/L to mpxlf90 and mpxlc + +models/atm/cam/src/control/cam_history.F90 +. remove LLNL_PELOTON + +models/atm/cam/src/control/runtime_opts.F90 +. add an mpi broadcast for hfilename_spec + +models/atm/cam/src/dynamics/fv/metdata.F90 +. remove unneeded use shr_kind_mod declarations. This is a workaround for + a pgi compiler bug, but resulting code is cleaner. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +These are pre-existing failures. + +calgary/lf95: All PASS + +calgary/pgi: All PASS except +032 sm314 TSM.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 8 +033 er314 TER.sh wg10dm outfrq3s 4+5s .............................FAIL! rc= 5 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 + +sm314 is a pre-existing failure. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. + +=============================================================== +=============================================================== + +Tag name: cam3_6_42 +Originator(s): eaton, sawyer, mvertens, mvr +Date: Tue Jun 2 09:27:01 MDT 2009 +One-line Summary: Fixes for ccsm branch runs, intel compiler, low order FV interpolation. + +Purpose of changes: + +. Fix bug in cam.cpl7.template to restore branch run functionality to ccsm + scripts (mvertens) + +. Fixes for intel compiler. + +. Bug fixes from Will Sawyer for low order interpolation options in the FV + dycore. + +. Update default 1 degree SST climatology dataset (mvr). + +Bugs fixed (include bugzilla ID): 970 + +. 970 - fix cam.cpl7.template to restore branch runs + +. Fixes for intel compiler include reformatting lines longer than 132 + characters and replacing the LLNL_PELOTON fix with a more generic one. + +. Fix problems in FV dycore with setting iord/jord equal to 1 or 2. + Problems were due to indexing bugs. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. Update the default 1 degree SST dataset to + sst_HadOIBl_bc_0.9x1.25_clim_c040926a.nc. This is the same as the + c040926 version except that the calendar attribute has been added to the + time coordinate variable. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton, mirin (FV indexing) + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/cam.cpl7.template +. add ".nc" suffixes to nrevsn* values + +models/atm/cam/src/dynamics/fv/cd_core.F90 +models/atm/cam/src/dynamics/fv/sw_core.F90 +models/atm/cam/src/dynamics/fv/tp_core.F90 +. fixes for low order interpolation schemes. + +models/atm/cam/bld/Makefile.in +models/atm/cam/src/chemistry/utils/tracer_data.F90 +models/atm/cam/src/control/hycoef.F90 +models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +models/atm/cam/src/physics/cam/aer_rad_props.F90 +models/atm/cam/src/physics/cam/phys_buffer.F90 +models/atm/cam/src/physics/cam/rad_constituents.F90 +models/atm/cam/src/physics/cam/restart_physics.F90 +models/atm/cam/src/utils/time_manager.F90 +. fixes for intel compiler +. remove need to #define LLNL_PELOTON + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +Pre-existing failures due to inconsistency between ccsm scripts and clm tag. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_41 +Originator(s): Jim Edwards, Pat Worley +Date: 05-28-2009 +One-line Summary: Additional communications algorythms, cice bug fix + +Purpose of changes: Cray XT machines were having mpi buffer issues at large proc counts + this pio update resolves those issues. + Updated PIO to trunk_tags/pio47_prod + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + Moved call to close initial file from cam_init to cam_finalize in + cam_comp.F90 - the ice component + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: no failures other than ccsm tests carried over from cam3_6_38 + +bangkok/lf95: no failures + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_40 +Originator(s): Jim Edwards +Date: May 12, 2009 +One-line Summary: bug fixes for cam3_6_39 + +Purpose of changes: Remedy bugs and performance in cam3_6_39 + +Bugs fixed (include bugzilla ID): Fixed a postcommit PGI compiler issue in + PIO. Fixed problems with history column output. + Fixed a post commit failure in sld dycore. + + NOTE: There are still outstanding issues related to running on + CRAY XT systems that we continue to work on. + + +Describe any changes made to build system: + PIO updated to pio43_prod +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self, eaton + +List all subroutines eliminated: + Removed dead code from cam_history.F90 : read_hbuf, write_hbuf, readin_hbuf + mpigatherv_hbuf, wrap_put_vara_hbuf, + gather_chunk_to_field_hbuf, scatter_field_to_chunk_hbuf +List all subroutines added and what they do: + Added code for storing iodesc in pio_utils.F90: find_iodesc, clean_iodesc_list + +List all existing files that have been modified, and describe the changes: + src/control/ncdio_atm.F90 + src/control/startup_initialconds.F90 + src/control/cam_restart.F90 + src/control/cam_history.F90 + src/utils/pio_utils.F90 + src/physics/cam/restart_physics.F90 + src/physics/cam/phys_buffer.F90 + src/dynamics/sld/restart_dynamics.F90 + src/dynamics/homme/inidat.F90 + + The iodesc variable was changed to a pointer so that it could be reused, this + improved performance and reduced memory relative to cam3_6_39 and brought it + back inline with cam3_6_38. Capability to output column subsets of history + variables was restored. Some dead code was removed. + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass against cam3_6_39 except ccsm tests. + post commit test pf385 was run against cam3_6_38 and also passed. + additional testing with ndens=2 was also conducted +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + + +bangkok/lf95: All pass against cam3_6_39 + PGI tests were also conducted against cam3_6_38, all pass except + expected failures. +032 sm314 TSM.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 8 +033 er314 TER.sh wg10dm outfrq3s 4+5s .............................FAIL! rc= 5 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 + +POST test sm371 Fails on jaguar with DEBUG=true - this is a feature of the PGI compiler + which is giving an error when mct passes an array of length 0. This is legal fortran + and should not be trapped. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_39 +Originator(s): Jim Edwards, Mark Taylor +Date: 01-09-2009 +One-line Summary: Add pio support for initial file + +Purpose of changes: parallelize IO + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Removed PIO from CAM build in + CCSM: PIO is now built as a library + +Describe any changes made to the namelist: Added pio_input logical to + control use of PIO in reading initial file + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + Added PIO specific versions of inidat for all dycores + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TBR.sh + Updated to match new netcdf restart name string +M models/atm/cam/test/system/nl_files/off1.9x2.5 +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/off2x2.5 + Removed obsolete pio_restart variable + +M models/atm/cam/bld/build-namelist + Clean up homme dycore options, add pio_inparm namelist for driver + +M models/ice/csim4/ice_comp.F90 + T3 field is used to initialize TBOT when TBOT not present in initial file, however this field was being allocated and read even when + TBOT was present. Refactored to read T3 in parallel and + only when required +M models/atm/cam/src/control/runtime_opts.F90 + Broadcast pertlim variable to support parallel IO + +M models/atm/cam/src/control/cam_history.F90 + Added cell area variable for homme dycore + +M models/atm/cam/src/control/readinitial.F90 +M models/atm/cam/src/control/ncdio_atm.F90 +M models/atm/cam/src/control/startup_initialconds.F90 +M models/atm/cam/src/utils/pio_utils.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 + Added PIO versions of initial file read routines. + +M models/atm/cam/src/physics/cam/cam3_aero_data.F90 +M models/atm/cam/src/physics/cam/seasalt_intr.F90 +M models/atm/cam/src/physics/cam/tracers.F90 +M models/atm/cam/src/physics/cam/progseasalts_intr.F90 +M models/atm/cam/src/physics/cam/dust_intr.F90 +M models/atm/cam/src/physics/cam/tracers_suite.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/carbon_intr.F90 +M models/atm/cam/src/physics/cam/co2_cycle.F90 +M models/atm/cam/src/physics/cam/chemistry.F90 +M models/atm/cam/src/physics/cam/aerosol_intr.F90 +M models/atm/cam/src/physics/cam/sulfur_intr.F90 +M models/atm/cam/src/physics/waccm/tracers.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + Refactored initialization of Constituents to allow for parallel + initialization. + +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 + Added subroutines get_gcol_lat and get_gcol_lon to map a global + column id to a lat/lon pair + +M models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +M models/atm/cam/src/dynamics/homme/inital.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 + Simplified an indexing equation + +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 + Added default initialization of dyn_in members to inf for debugging + uninitialized variables +M models/atm/cam/src/dynamics/fv/metdata.F90 + Cleaned up stdout +M SVN_EXTERNAL_DIRECTORIES + Updated PIO external and mct serial driver + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except + 051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 + expected failure due to homme dynamics updates + + 052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 + 053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 + 054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + 055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 + 056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + carried forward from cam3_6_38 - This commit passed these tests as run against + cam3_6_37 prior to the cam3_6_38 merge. + + + +bangkok/lf95: All pass except + 037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 + fails due to round off differences in polar averaging of TCWAT field + as initialized from T in physpkg.F90 - see cam3_6_35 for details. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_38 +Originator(s): eaton +Date: Tue May 5 11:34:35 MDT 2009 +One-line Summary: Fix for running F compsets from ccsm4_0_beta16 and later. + +Purpose of changes: + +. modify build-namelist so that it generates a landmask file for the CAMDOM + component namelist that is consistent with the one generated for the CICE + namelist. + Note that the fix is for running the F compsets from the ccsm4_0_beta16 + and later tags. Using the ccsm scripts to run F compsets from this cam + tag is broken due to an inconsistency between the scripts and the CLM + tag. We will be updating the CLM external to fix this problem shortly. + +. Update to the latest scripts and pio tags. Updating to the latest + scripts tag has temporarily broken the ability to run F compsets via the + ccsm scripts in this CAM tag. + + +Bugs fixed (include bugzilla ID): + +. Fix for running F compsets from ccsm4_0_beta16 and later. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. models/utils/pio -> pio38_prod/pio +. scripts -> scripts4_090428 + +cam/bld/build-namelist +. modify build-namelist to look at the cice namelist defaults to determine + whether the gx1v6 mask is being used. If a gx1v6 mask is used, the + default for the focndomain variable will be determined using the attribue + mask="gx1v6". +. don't write dom_inparm namelist group when it isn't needed, i.e., for + ideal, adiabatic, and aqua-planet modes. + +cam/bld/namelist_files/namelist_defaults_cam.xml +. remove defaults for old 1x1.25 and 2x2.5 resolutions which are no longer + supported. +. add focndomain defaults for gx1v6 mask. + +cam/src/chemistry/utils/tracer_data.F90 +cam/src/physics/cam/polar_avg.F90 +. Change name of polar_avg_mod to polar_avg to match the filename (required + by dependency generator). + +cam/test/system/TCB_ccsm.sh +. change the xmlchange command to modify env_build.xml rather than + env_mach_generic.xml. The EXEROOT variable was moved to env_build.xml. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all PASS except + +052 sm991 TSM_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +053 er991 TER_ccsm.sh f19_f19 F 1+1d ..............................FAIL! rc= 6 +054 sm992 TSM_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 +055 er992 TER_ccsm.sh f19_g15 E 1+1d ..............................FAIL! rc= 6 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +These tests fail due to an inconsistency between the scripts and CLM tags. + +bangkok/lf95: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_37 +Originator(s): pworley +Date: Mon Apr 27 2009 +One-line Summary: more accurate reproducible sum; additional OpenMP +parallelism. + +Purpose of changes: + +1) Modify repro_sum fixed-point algorithm to improve accuracy. + In certain situations, numerical cancellation can degrade accuracy + of original repro_sum algorithm as compared to floating-point-based + algorithms. New algorithm is nearly exact, employing variable + precision as needed. This results in roundoff level differences. + +2) Introduce OpenMP parallelism in physics and chemistry routines + that are not called within the major loop over chunks. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +- Cost of new repro_sum algorithm is higher than that of the old + algorithm. Experiments indicate that the additional cost is + not significant. + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + + physics/cam/polar_avg.F90 - + moved polar averaging routines out of repro_sum_mod.F90 and + into their own module + +List all existing files that have been modified, and describe the changes: + + chemistry/utils/prescribed_aero.F90 - + slight restructuring to expose OpenMP parallelism; + addition of OpenMP directives + + chemistry/utils/tracer_data.F90 - + 'use' polar_avg_mod instead of repro_sum_mod; + addition of OpenMP directives + + dynamics/fv/spmd_dyn.F90 - + changed default communication protocol for I/O-related scatter + routines in FV, to address runtime failure on Cray XT system + + physics/cam/ghg_data.F90 - + addition of OpenMP directive + + physics/cam/phys_grid.F90 - + bug fix to unadvertised load balancing option + + utils/repro_sum_mod.F90 - + generalization of fixed-point reproducible sum algorithm to + enable (almost) exact arithmetic + + test/system/input_tests_master - + bug fix (at request of Brian Eaton) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except + +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 +024 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 7 +027 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +048 bl387 TBL.sh f1.9c351dh outfrq3s+1850-2005_track1 9s ..........FAIL! rc= 4 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 + +bangkok/lf95: All PASS except + +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 4 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 4 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 4 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 4 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 4 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 4 + + All baselines using FV fail due to roundoff introduced in changes to + reproducible sum algorithm. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + Roundoff diffs in all configurations using FV. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + pergro test on bluefire + +=============================================================== + +Tag name: cam3_6_36 +Originator(s): fvitt, eaton +Date: Tue Apr 21 14:56:51 MDT 2009 +One-line Summary: new solar data code; update prescribed forcing data. + +Purpose of changes: + +. A new module (solar_data) has been added with capabilities to read + datasets containing either total solar irradiance (TSI) or spectrally + resolved solar irradiance (SSI). Currently only the TSI code, needed for + the track1 transient runs, is active. + +. Updates to prescribed forcing data: + - New TSI and SSI datasets from Caspar Ammann. + - New 1850 and 2000 climatologies for both BAM and ozone from + Jean-Francois Lamarque. + - New GHG data (CO2, CH4, N2O, F11*, F12) from Doug Kinnison. + - New volcanic emissions (eruptive) data from Caspar Ammann. + +. A new use case (1850-2005_track1) has been implemented for the 1850-2005 + transient runs for track1 physics. + +. configure has been modified to invoke the CICE configure with the args + "-ntr_aero 0 -ntr_pond 1 -ntr_iage 0". The -ntr_aero setting was already + being used; the -ntr_pond and -ntr_iage settings are new. This is for + consistency with how the CCSM F cases are configured. The values for + -ntr_pond and -ntr_iage are the defaults, so this doesn't change + answers. + +Bugs fixed (include bugzilla ID): + +. The chemistry/utils/prescribed_* modules all contained a bug which did + not allow the data_type variable to be set to INTERP_MISSING_MONTHS (the + module variable was declared char*8). + +. The interpic_new utility was assuming that all global attributes are text + strings. This was causing failures on input files produced by the NCO + operators which contain a global attribute of type integer. + +. build-namelist wasn't recognizing a value of "0" in the use case file + because a conditional statement was testing whether the value was true + rather than whether the value was defined. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. new namelist variables for the solar_data module: + character(len=256) :: solar_data_file = '' + character(len=8) :: solar_data_type = 'SERIAL' ! "FIXED" or "SERIAL" + integer :: solar_data_ymd = 0 ! YYYYMMDD for "FIXED" type + integer :: solar_data_tod = 0 ! seconds of day for "FIXED" type + real(r8) :: solar_const ! constant TSI (W/m2) + +. The following namelist variables have been removed: + bndtvscon, rampyear_scon, scenario_scon, scon + +List any changes to the defaults for the boundary datasets: + +. updates to 2000 climatology for ozone, prescribed BAM +. update fixed GHG values to be consistent with year 2000 from the new GHG + dataset. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/ramp_scon.F90 +. old solar irradiance module + +List all subroutines added and what they do: + +models/atm/cam/bld/namelist_files/use_cases/1850-2005_track1.xml +. use case for track1 1850-2005 transient runs + +models/atm/cam/src/chemistry/utils/solar_data.F90 +. new module to manage solar irradiance specification + +models/atm/cam/test/system/config_files/f1.9c351dh +. config params for fv, 1.9x2.5, cam3_5_1, debug, hybrid. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. unless the solar_data_file is specified by the user or by a use case, set + the default solar constant. +. fix bug in processing use case values (need to check whether value is + defined rather than whether it's true) + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. remove bndtvscon, rampyear_scon, scenario_scon, scon +. add solar_data_file, solar_data_type, solar_data_ymd, solar_data_tod, + solar_const +. change type of prescribed_*_type variables from char*8 to char*32. Add + the appropriate valid values to each. + +models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +models/atm/cam/bld/namelist_files/use_cases/1870_bam.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +. convert scon -> solar_const (change units too) + +models/atm/cam/bld/namelist_files/use_cases/1990_control.xml +models/atm/cam/bld/namelist_files/use_cases/1990_prog_aero.xml +. remove scon spec so default present day value is used (valid for 1990 or 2000). + +models/atm/cam/src/chemistry/mozart/solvar_woods.F90 +. use sol_tsi from solar_data instead of scon from cam_control_mod. + +models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +. change declaration of datatype variable from char*8 to char*32. Needs to + be long enough for the value INTERP_MISSING_MONTHS. + +models/atm/cam/src/control/cam_control_mod.F90 +. remove doramp_scon and scon + +models/atm/cam/src/control/runtime_opts.F90 +. add call to solar_data_readnl +. remove use ramp_scon +. remove scenario_scon, rampyear_scon, scon + +models/atm/cam/src/physics/cam/advnce.F90 +. add call to solar_data_advance +. remove ramp_scon + +models/atm/cam/src/physics/cam/physconst.F90 +. add speed of light and Planck's constant. + +models/atm/cam/src/physics/cam/physpkg.F90 +. add call to solar_data_init + +models/atm/cam/src/physics/cam/radiation.F90 +. use sol_tsi from solar_data instead of scon from cam_control_mod. + use local scon to convert units to mW/m2. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. use sol_tsi from solar_data instead of scon from cam_control_mod. + conversion to mks units no longer necessary. + +models/atm/cam/test/system/input_tests_master +. add new tests: + - sm387 TSM.sh f1.9c351dh outfrq3s+1850-2005_track1 9s + - er387 TER.sh f1.9c351dh outfrq3s+1850-2005_track1 4+5s + - br387 TBR.sh f1.9c351dh outfrq3s+1850-2005_track1 6+3s + - bl387 TBR.sh f1.9c351dh outfrq3s+1850-2005_track1 9s + +models/atm/cam/test/system/tests_pretag_bluefire +. replace {sm,er,br,bl}382 by {sm,er,br,bl}387 + +models/atm/cam/tools/interpic_new/fmain.F90 +. remove assumption that copied attributes are text strings + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +051 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 + +bangkok/lf95: All PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Answers change due to update of + prescribed forcing datasets. There was also a roundoff level change in + waccm_mozart due to changing the units of the solar constant input. + +=============================================================== +=============================================================== + +Tag name: cam3_6_35 +Originator(s): fvitt, aconley, bardeenc, jedwards, eaton +Date: Mon Apr 13 13:36:28 MDT 2009 +One-line Summary: volcano emissions and optics; 1850_track1 updates; + build-namelist mods (improve AMIP setup) + +Purpose of changes: + +. Add new code for reading volcano emission datasets. This includes a new + feature to mask emissions below the tropopause. Currently the volcanic + emissions are radiatively active by default only when used with camrt and + with BAM (prescribed or prognostic). This functionality is needed for the + track1 transient runs. + +. Add module to diagnose the location of the tropopause. Multiple + algorithms are provided, some of which may not be able to identify a + tropopause in all situations. To handle these cases, an analytic + defintion and a climatology are provided that can be used to fill in + when the original algorithm fails. The troppause temperature and + pressure are determined and can be output to the history file. (From + Charles Bardeen.) + +. Tuning mod: set rhminl=0.92 for FV 1.9x2.5 w/ cam3 or cam3_5* physics. + +. Update the 1850_track1 use case with new 1850 prescribed BAM aerosols + from Jean-Francois Lamarque. + +. Update build-namelist to allow setting all namelist variables recognized + by the perf_mod module. Also change default for timing output files to + use a single file. + +. Update build-namelist to enforce consistency between the SST and ocean + domain files used by CAM-DOM and the prescribed CICE mode. Also add + variables to the CAM namelist that are needed to specify the first and + last years of a multi-year SST dataset (for AMIP runs). + +. Update the FV inidat code to replace global sums by distributed sums in + the polar averaging. This results in roundoff level differences. (From + Jim Edwards.) + +. Add support for radius dependent optics calculation for volcanic + aerosols. This code will only be turned on for RRTMG. + +Bugs fixed (include bugzilla ID): + +. The volcano emissions code used in cam3 was broken when changes were made + to remove assumptions about rectangular lat/lon grids from the physics + code. The new code added with this commit replaces the old code which + has been removed. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new volcano emission variables + +character(len=16) :: prescribed_volcaero_name ! name of variable containing volcano mmr (default: MMRVOLC) +character(len=256) :: prescribed_volcaero_file ! name of file containing emission data +character(len=256) :: prescribed_volcaero_filelist ! name of file containing list of emission dataset file names +character(len=256) :: prescribed_volcaero_datapath ! absolute pathname of file containing emission data +character(len=8) :: prescribed_volcaero_type ! type of time interpolation (default: SERIAL) +logical :: prescribed_volcaero_rmfile ! true => remove dataset after using (default: false) +integer :: prescribed_volcaero_ymd ! start ymd for interpolation if different from model time +integer :: prescribed_volcaero_tod ! time of day (sec) relative to prescribed_volcaero_ymd + +. Remove variables used by old volcano emission modules: bndtvvolc and + strat_volcanic. + +. Add support for all namelist variables recognized by the perf_mod module. + +. Add the variables stream_year_first and stream_year_last which are used + to specify, respectively, the first and last years of data in a + multi-year SST dataset. This is needed for AMIP runs. + +. The new tropopause diagnostic code uses a tropopause climatology file. + The default (which is also used by the trop_mozart code) can be + overridden via the namelist variable tropopause_climo_file. + +List any changes to the defaults for the boundary datasets: + +. new dataset for 1850 climatology of prescribed bulk aerosols. + +. replace sst_HadOIBl_bc_32x64_clim_c030228.nc by + sst_HadOIBl_bc_32x64_clim_c050526.nc because the latter file has a time + coordinate that's recognized by cice. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/cam/volcanicmass.F90 +models/atm/cam/src/physics/cam/volcemission.F +. old volcanic emission code + +List all subroutines added and what they do: + +models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +. module to read prescribed volcano emissions dataset + +models/atm/cam/src/physics/cam/tropopause.F90 +. new tropopause diagnostic code. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. add -gopt to pgi FFLAGS for non-debug build + +models/atm/cam/bld/build-namelist +. modify to make the prescribed volanic aerosols radiatively active if + present. +. change the default so a single file is produced for timing output +. modify how default is added for the fsurdat file +. invoke the cice build-namelist with variables set to insure that the + settings of SST dataset and ocn domain file are consistent with the + CAM-DOM settings. +. Add ability to set the variables stream_year_first and stream_year_last + directly in the CAM namelist as a convenience for setting up AMIP runs. + These settings are passed to the cice build-namelist which is the + component that requires setting them. +. add default for tropopause climatology file. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default for tropopause climatology file. +. change T21 SST dataset. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. Add new namelist variables for prescribed_volcaero module. +. Remove old volcano emissions variables +. Add all namelist variables recognized by the perf_mod module. +. add stream_year_first and stream_year_last. These set the first and last + years respectively in a multi-year SST dataset read by cice in prescribed + mode. They must be set for AMIP style runs. +. add definition for tropopause climatology file. + +models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +. new dataset for 1850 climatology of prescribed bulk aerosols. + +models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +. remove a save attribute that caused compiler warnings (because there's + already a global save statement) + +models/atm/cam/src/chemistry/utils/tracer_data.F90 +. fix indexing bug in read_za_trc + +models/atm/cam/src/dynamics/fv/inidat.F90 +. Replace global sums done on masterproc by distributed sums. Needed for + polar averaging. + +models/atm/cam/src/control/runtime_opts.F90 +models/atm/cam/src/physics/cam/advnce.F90 +models/atm/cam/src/physics/cam/initindx.F90 +models/atm/cam/src/physics/cam/physpkg.F90 +models/atm/cam/src/physics/cam/restart_physics.F90 +. add hooks for new prescribed_volcaero module + +models/atm/cam/src/control/filenames.F90 +models/atm/cam/src/control/runtime_opts.F90 +models/atm/cam/src/physics/cam/advnce.F90 +models/atm/cam/src/physics/cam/aerosol_intr.F90 +models/atm/cam/src/physics/cam/initindx.F90 +models/atm/cam/src/physics/cam/physpkg.F90 +models/atm/cam/src/physics/cam/sulfur_intr.F90 +. remove references to old volcanicmass and volcemission modules + +models/atm/cam/src/chemistry/utils/prescribed_volcaero.F90 +. replace simple tropopause expression by a utility that provides multiple + methods for diagnosing the tropopause. + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. add code to compute optics for radius-dependent quantities + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. set rhminl=0.92 for FV 1.9x2.5 with cam3 or cam3_5* physics + +models/atm/cam/src/physics/cam/phys_prop.F90 +. add code to read radius-dependent mass-specific quantities: r_sw_ext, + r_sw_scat, r_sw_ascat, r_lw_abs, mu + +models/atm/cam/src/physics/cam/physpkg.F90 +. add calls to tropopause_init + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. add access to new properties: r_lw_abs, r_sw_ext, r_sw_scat, r_sw_ascat, + mu + +models/atm/cam/src/physics/cam/tphysbc.F90 +. add output of tropopause diagnostic calc + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 +024 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 7 +027 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +048 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 7 +056 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 + +bangkok/lf95: All PASS except +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + + +. bl132 fails due to new SST dataset. + +. All baselines using FV fail due to roundoff introduced in computing polar + averages at initialization. + +. bl315 and bl333 have larger than roundoff differences due to the rhminl + tuning mod for track1, 1.9x2.5 runs. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Roundoff diffs in all configurations + using FV. Larger than roundoff diffs in FV @ 1.9x2.5 using cam3_5_1 + or earlier physics. + +=============================================================== +=============================================================== + +Tag name: cam3_6_34 +Originator(s): Jim Edwards,mvr +Date: Fri Mar 27 2009 +One-line Summary: Extend cam3.5 physics to unstructured grids; bug fix to +test scripts for testing of ccsm and cleanup + +Purpose of changes: +. Extend cam3.5 physics to unstructured grids. This involves the code used + to interpolate the prescribed aerosols and ozone datasets. It does not + involve lots of code used by the prognostic chemistry schemes to + interpolate surface emission datasets. + + The new interpolation code parallelizes the calculation rather than + interpolating on masterproc and scattering the results. + +Bugs fixed (include bugzilla ID): +. The changes made to the interpolation code to support unstructured grids + fixed code bugs related to the treatment of interpolation points at or + near the poles. This introduces larger than roundoff changes in the + interpolated fields. + +Describe any changes made to build system: +- moved memory pagesize flags for AIX from testdriver to Makefile + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian, mvr, Francis + +List all subroutines eliminated: +D models/atm/cam/test/system/TCS.ccsm.sh +D models/atm/cam/test/system/TCB.ccsm.sh +D models/atm/cam/test/system/config_files/f4pdh +- remove test scripts, config file that are no longer used + + +List all subroutines added and what they do: +A models/atm/cam/bld/namelist_files/use_cases/1850_track1.xml +- new use_case for 1850 runs and track1 + +A models/atm/cam/test/system/config_files/f4c351pdh +- new configure options test file for testing cam3_5_1 physics + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/tests_posttag_bluefire +- modified bluefire pretag test list to enable it to finish within 6hr limit + +M models/atm/cam/test/system/TCB_ccsm.sh +- minor cleanup to allow reuse of existing test directories + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/run-ibm.csh +- moved memory pagesize flags for AIX from testdriver to Makefile + +M models/atm/cam/test/system/input_tests_master +- modified definition of pergro test to use cam3_5_1 physics + +M models/atm/cam/test/system/TBL_ccsm.sh +- bug fix to ccsm baseline test - was not using baseline code! + +M models/atm/cam/src/control/interpolate_data.F90 +- added support for direct interpolation from a regular grid to a phys + grid decomposition. + +M models/atm/cam/src/utils/repro_sum_mod.F90 +- added support for pole averaging fv on the phys grid + +M models/atm/cam/src/chemistry/utils/tracer_data.F90 +- replaced mo_regrid calls with calls to interpolate_data, this parallelizes + the interpolation and extends it to unstructured grids. + +M models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +- replaced references to commap with calls to dyn_grid + +M models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +- extended functionality of get_horiz_grid_d to return either regular + grid or unstructured grid output depending on the size of the array(s) + to be returned + +M models/atm/cam/src/dynamics/homme/dycore.F90 +- added 'UNSTRUCTURED' as a valid string in dycore_is + +M . +M SVN_EXTERNAL_DIRECTORIES +- updated to new mct, scripts external tags + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All pass except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4c351pdh aqpgro 3s ..............................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 7 +061 bl991 TBL_ccsm.sh f19_f19 F....................................FAIL! rc= 7 +064 bl992 TBL_ccsm.sh f19_g15 E....................................FAIL! rc= 7 + +bangkok/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +all baselines were expected to fail except those using: +-ideal physics +-adiabatic +-cam3_5 physics +-homme +-trop mozart chemistry + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: +- what code configurations: see above +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Larger than roundoff but same climate. + + The new interpolation scheme improves handling of grid points close to the + poles, this change results in a larger than roundoff difference. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? 20yr validatin run vs cam3_6_33 + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): cs_cam3_6_33 +- platform/compilers: bluefire +- configure commandline: +configure -ntasks 16 -nthreads 4 -phys cam3_5_1 -dyn fv -res 1.9x2.5 + +- build-namelist command (or complete namelist): +build-namelist -s -case cs_cam3_6_33_F -runtype continue -namelist "&camexp stop_option='nmonths', stop_n=30 /" + +- MSS location of output: +mss:/MVR/csm/cs_cam3_6_33_F + +MSS location of control simulations used to validate new climate: +mss:/MVR/csm/cam3_6_33_F + +URL for AMWG diagnostics output used to validate new climate: +mss:/MVR/csm/cs_cam3_6_33_F/cs_cam3_6_33_F-cam3_6_33_F.tar + + +=============================================================== + +Tag name: cam3_6_33 +Originator(s): eaton +Date: Fri Mar 13 17:00:02 MDT 2009 +One-line Summary: add cam3_5_1 option & tuning; change solar constant; change cice default + +Purpose of changes: + +. Add a new configure option, "-phys cam3_5_1". This is to configure the + "track1" simulations out of the box. cam3_5_1 is the same build as + cam3_5, but the namelist settings are modified to set the critical Froude + number to 1.0 and to set the FV polar filter to use FFT always (these are + the same values that are used by default in the latest development code). + +. Tuning parameter for track1: set rhminl=0.90 for 2 degree runs using RK + microphysics. + +. Change to solar constant. Notes from Caspar Ammann: + On Wed, Mar 11, 2009 at 04:44:54PM -0600, Caspar Ammann wrote: + > + > the numbers for mean total solar irradiance (TSI, or scon) for the + > 1850-PreIndustrial as well as PresentDay controls are now computed based + > on the latest information from Judith Lean and her irradiance model. They + > are consistent with SORCE: + > + > PreIndustrial: 1360.89 W/m2 (~1850 AD) + > PresentDay: 1361.27 W/m2 (~1990 but also 2000 AD) + > + > FYI: + > the 1850 mean was computed over 3 roughly stable solar cycles 1834-1866 AD + > the 1990/2000 values were computed over 3 roughly stable solar cycles + > 1975-2007 AD + > + > The cycles were assumed to be 11-year cycles. + > + > The spectral range included is: integral of irradiance at wavelengths + > >200nm + +. Turn off the aerosol tracers in CICE: + The CAM "standalone" configuration uses the "prescribed" mode of CICE. + The recent addition of aerosol tracers into CICE is causing problems in + the prescribed mode, so we have decided as a short term fix to turn off + the aerosol tracers in CICE. It is an open science question whether the + aerosol tracers should be turned on in the CICE prescribed mode since + this mode allows only vertical transport of the tracers. + +. Update scripts external to scripts4_090312 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. Changes to configure: add valid option "-phys cam3_5_1". + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. added default for 1/4 degree soil_erod dataset + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. Update scripts external to scripts4_090312 + +models/atm/cam/bld/cam.cpl7.template +. Add $CAM_NAMELIST_OPTS to the build-namelist command. + +models/atm/cam/bld/config_files/definition.xml +. add cam3_5_1 as valid value for phys. + +models/atm/cam/bld/configure +. add cam3_5_1 as valid value for phys. The build is identical to cam3_5. +. call the cice configure command with the argument "-ntr_aero 0" to turn + off the aerosol tracer code. +. add check of exit status from the cice configure. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. change present day value of scon to 1.36127e6 + +models/atm/cam/bld/namelist_files/use_cases/1870_bam.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +. change 1870 value of scon to 1.36089e6 + +models/atm/cam/src/control/atm_comp_mct.F90 +models/atm/cam/src/control/cam_comp.F90 +. remove of old gensom code + +models/atm/cam/src/physics/cam/cloud_fraction +. set rhminl=.90 for 2 degree w/ RK microphysics + +models/atm/cam/src/physics/cam/zm_conv.F90 +. Change the dpdry arg from optional to required. dpdry is always + available and changing this allows us to remove a compiler workaround for + the bluegene machines. + +models/atm/cam/src/physics/cam/zm_conv_intr.F90 +. remove BGP ifdef. always pass dpdry to convtran. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl370 TBL.sh fmo1.9dh off1.9x2.5 9s ...........................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 7 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +061 bl991 TBL_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 4 +064 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 4 + +bangkok/lf95: All PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +The baseline failures are expected as summarized below. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate in all configs except + adiabatic and ideal physics due to changing the solar constant. In + addition the tuning parameter change for track1 affects 2 degree FV runs + using the RK microphysics (cam3, cam3_5, and cam3_5_1 physics options). + I suspect that turning off the aerosol tracers in CICE will also change + answers although that change wasn't tested in isolation. + +=============================================================== +=============================================================== + +Tag name: cam3_6_32 +Originator(s): eaton +Date: Mon Mar 2 12:55:20 MST 2009 +One-line Summary: mods to ramp_co2; update externals + +Purpose of changes: + +. The option to ramp CO2 at a specified annual rate currently required the + user to specify the start date via the namelist variable + ramp_co2_start_ymd. This has been modified so that if this variable is + not specified, the default behavior is to start the ramping at the + beginning of the run. + +. Update to the following externals: + drvseq3_0_09 + clm3_6_19 + cice4_0_20090226 + scripts4_090226 + + ** Note ** Updating the CLM and CICE externals results in a new climate + for any configuration that provides deposition of carbon/dust to the + surface (currently trop_mam3, trop_bam, trop_mozart). The new CLM and + CICE versions will use deposition fluxes from the atm whenever they are + provided. + +Bugs fixed (include bugzilla ID): + +. bug fix from Sungsu in the MG microphyics: + Add the term mnucct+msacwi to the calculation of tlat. + These terms do not appear in the cam3_6 version of MG microphysics, so + this fix will not affect the "track2b" simulations. It does change + answers in the version of MG microphysics currently on CAM's trunk which + came from the end of the modal branch (modal12_cam3_6_26). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update to include drvseq3_0_09, clm3_6_19, cice4_0_20090226, scripts4_090226 + +models/atm/cam/bld/build-namelist +. restore untruncated names of the following variables to the fincl2 list + used for the camiop test: afixcldliq, afixcldice,dqfxcldliq,dqfxnumliq, + dqfxnumice,afixnumice,afixnumliq,dqfxcldice (bug fix for SCAM). + +models/atm/cam/src/dynamics/eul/iop.F90 +. change declaration of lowername from char*8 to char*16 (bug fix for SCAM). + +models/atm/cam/src/physics/cam/chem_surfvals.F90 +. modify how ramp_co2_start_ymd works. Rather than failing if the user + doesn't set it, let the default be to start the co2 ramping at the + beginning of the run. + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. bug fix from sungsu, line 2879, add the terms mnucct(k)+msacwi(k) to tlat calc. + ((bergs(k)+psacws(k)+mnuccc(k)+mnucct(k)+msacwi(k))*cldm(i,k)+(mnuccr(k)+ & + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl370 TBL.sh fmo1.9dh off1.9x2.5 9s ...........................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 7 +061 bl991 TBL_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 7 +064 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 +065 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 6 + +bangkok/lf95: All PASS except +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +The baseline failures are all expected (see below) +The SCAM failure is pre-existing. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: New climate for configurations that + include the default MG microphysics (bug fix) or prognostic aerosols (due + to the new CICE and CLM externals responding to deposition fluxes. + BFB for ideal and adiabatic physics, and for cam3. + +=============================================================== +=============================================================== + +Tag name: cam3_6_31 +Originator(s): eaton +Date: Fri Feb 27 13:45:55 MST 2009 +One-line Summary: option to use "cam3_6" physics; add deposition fluxes for + : prognostic BAM + +** N.B. ** The current "out of the box" configuration matches that of the + end of the modal branch, modal12_cam3_6_26, plus the bug fix mentioned + below. This is not a tuned configuration, and is not one of the configs + being evaluated as the possible cam4. The candidate cam4 configurations + require setting various arguments to the configure command. There is + also a large amount of candidate code still on a branch which will be + merged to the trunk in the near future. + +Purpose of changes: + +. Add capability to run with "cam3_6" physics, defined as cam3_5 + a + version of MG microphysics prior to adding the new treatment for ice + + prognostic BAM. cam3_6 retains the camrt radiation package, the HB + vertical diffusion code, the Hack Shallow convection, and the ZM deep + convection w/ Neale/Richter modifications. This option is configured by + setting the argument "-phys cam3_6" to configure. To run with prescribed + instead of prognostic BAM add the argument "-chem none" to configure. + +. Send the carbon and dust deposition fluxes to the coupler when prognostic + BAM is active. + +Bugs fixed (include bugzilla ID): in stratiform.F90 + +. Fix bug in stratiform.F90 (remove conditional surrounding the statement + that sets the tendency of cloud ice number due to detrainment of Nc). + +Describe any changes made to build system: + +. Changes to configure: add valid option "-phys cam3_6". + +Describe any changes made to the namelist: + +. Move cloud_fraction namelist variables into their own namelist group. + Change names: freeze_dry -> cldfrc_freeze_dry + rhminl_31 -> cldfrc_rhminl_31 + Add cldfrc_ice to turn on/off the calculation of ice cloud fraction. + +. Add variable atm_dep_flux to turn on sending deposition fluxes to the + coupler. This is set by build-namelist when the chemistry option is one + that provides the desired fluxes. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam3_6/cldwat2m.F90 +. This is the version of cldwat2m being used for cam3_6. It came + originally from modal03_cam3_6_24 and has been modified for the "track2" + runs. This is temporary. The physics that has been backed out of + cldwat2m needs to be implemented with conditional logic in + physics/cam/cldwat2m.F90. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add defaults for cldfrc_freeze_dry and cldfrc_ice +. add default for atm_dep_flux + +models/atm/cam/bld/config_files/defaults_waccm_ghg.xml +models/atm/cam/bld/config_files/defaults_waccm_mozart.xml +. remove setting phys=waccm + +models/atm/cam/bld/config_files/definition.xml +. add cam3_6 as valid value for phys +. remove waccm as a valid value for phys. This removes an unnecessary + dependence between the phys and chem parameters. +. remove setting the default value for phys. configure needs to determine + the physics package before the configure object is initialized. + +models/atm/cam/bld/configure +. add cam3_6 option to -phys +. Move the determination of the physics package ahead of determining the + chemistry package in configure. The physics packages have different + default chemistry packages, so the physics package needs to be set first. + Also remove waccm as a valid physics package value. This created an + unnecessary dependence between the chemistry and physics package settings + that was causing problems as more options are added. configure can do + whatever needs to be done for waccm by checking the value of the + chemistry package. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. remove the phys="waccm" attributes. In the gw_drag_file element the attribute + was not needed. In the solar_parms_file element it was replaced by + duplicating the element and inserting chem="waccm_ghg" in one and + chem="waccm_mozart" in the other. +. add defaults for cldfrc_freeze_dry and cldfrc_ice. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. move cloud_fraction namelist variables into namelist group cldfrc_nl +. rename freeze_dry -> cldfrc_freeze_dry + rhminl_31 -> cldfrc_rhminl_31 +. add cldfrc_ice to switch whether the ice cloud fraction calculation is done +. add atm_dep_flux to indicate when CAM will send deposition fluxes to the + coupler. + +models/atm/cam/src/chemistry/mozart/chemistry.F90 +. chem_timestep_tend - change intent of cam_out arg from in to inout. +. copy drydep for CB1 to cam_out%bcphodry + copy drydep for CB2 to cam_out%bcphidry + copy drydep for OC1 to cam_out%ocphodry + copy drydep for OC2 to cam_out%ocphidry + +models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. add intent(out) arg drydepflx to gas_phase_chemdr, and set it. + +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +. copy wetdep for OC2 to cam_out%ocphiwet + copy wetdep for CB2 to cam_out%bcphiwet + +models/atm/cam/src/control/camsrfexch_types.F90 +. use phys_control module to query whether atm will send deposition fluxes + to the coupler. + +models/atm/cam/src/control/runtime_opts.F90 +. remove cloud fraction namelist vars from cam_inparm +. add call to cldfrc_readnl + +models/atm/cam/src/physics/cam/aerosol_intr.F90 +. add cam_out to calling args for dust_wet_intr and dust_drydep_intr + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. add AEROD_V to default history output + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. add method to read namelist cldfrc_nl +. use new namelist variable cldfrc_ice to control whether ice cloud + fraction is computed, not the microphysics type + +models/atm/cam/src/physics/cam/dust_intr.F90 +. copy wetdep for 4 dust bins to cam_out%dstwet[1-4] +. copy drydep for 4 dust bins to cam_out%dstdry[1-4] + +models/atm/cam/src/physics/cam/phys_control.F90 +. add namelist variable atm_dep_flux. access via the phys_getopts method. + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove conditional around setting the tendency of cloud ice number due to + detrainment of Nc. +. misc cleanup + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl370 TBL.sh fmo1.9dh off1.9x2.5 9s ...........................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 7 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +061 bl991 TBL_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 7 +064 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 7 +065 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 6 + +bangkok/lf95: all PASS except: + +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 + +All baselines fail except adiabatic and ideal physics due to changes in the +cam3 configuration and due to the bug fix in MG microphysics which is the +default. The SCAM test failure is pre-existing (fix coming soon). + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: different climate due to bug fix in MG +microphysics and change in cam3 configuration (returned the freeze_dry +setting to it's cam3 value). + +=============================================================== +=============================================================== + +Tag name: cam3_6_30 +Originator(s): mvr +Date: Fri Feb 20 2009 +One-line Summary: added testing of ccsm from with cam's test driver; updated +run template scripts; new externals for timing and docn7; other small fixes + +Purpose of changes: +will now test F (stand-alone cam default, prescribed ocn/ice) and E (cam mode +with fully active ice and som ocean) configurations during required pretag testing +via the ccsm scripts... + +the run template scripts provided in the ~bld directory had not been updated since +cice became the default sea ice model, requiring changes to the configure calls... + +latest timing tag eliminated the need for an extra env var in cppdefs in order to +limit the log output of the timing code...however, a change to the performance test +script was required to account for unrelated format changes in the output... + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: +- removed '-DHAVE_GETTIMEOFDAY' from cppdefs - no longer needed with new timing code + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/TSB.ccsm.sh +D models/atm/cam/test/system/TCT.ccsm.sh +- outdated scripts for testing ccsm from cam's test driver + + +List all subroutines added and what they do: +A models/atm/cam/test/system/TCB_ccsm.sh +- new test script to test the configure and build of a ccsm executable +A models/atm/cam/test/system/TEQ_ccsm.sh +- new test script to test the equivalence of a ccsm run vs a cam run +A models/atm/cam/test/system/TER_ccsm.sh +- new test script to test that a ccsm run restarts b4b +A models/atm/cam/test/system/TSM_ccsm.sh +- new test script to test that a ccsm runs to completion (smoke test) +A models/atm/cam/test/system/TBL_ccsm.sh +- new test script to test that a ccsm run is b4b with a run using baseline code + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bluefire +M models/atm/cam/test/system/tests_posttag_bluefire +- new ccsm tests will now be part of default/required pretag testing on bluefire + +M models/atm/cam/test/system/TPF.sh +- performance test script modified to reflect format changes in timing output + +M models/atm/cam/test/system/input_tests_master +- test definitions modified with new ccsm tests; +- bug fix to 1870 test to use proper 'use' case + +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-lightning.csh +- run template scripts brought up to date to account for recent changes to configure + +M models/atm/cam/bld/Makefile.in +- removed '-DHAVE_GETTIMEOFDAY' from cppdefs - no longer needed with new timing code + +M SVN_EXTERNAL_DIRECTORIES + M . +- new docn7 tag for som runs to work; new timing tag to eliminate need for + '-DHAVE_GETTIMEOFDAY' in cppdefs to cut down log output + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +061 bl991 TBL_ccsm.sh f19_f19 F 2d ................................FAIL! rc= 5 +064 bl992 TBL_ccsm.sh f19_g15 E 2d ................................FAIL! rc= 5 +065 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 6 + +sc001 is a pre-existing failure; bl991 and bl992 failed because these tests did +not exist in the baseline code + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_29 +Originator(s): eaton +Date: Thu Feb 19 11:44:19 MST 2009 +One-line Summary: fixes for cam3_5 version; no chem preproc for trop_bam; + : update emissions + +Purpose of changes: + +. Apply fixes to restore the cam3_5 version (use "-phys cam3_5" option to + configure). This is a combination of adding some control logic in the + source code, and appropriately setting the default values of some + namelist variables which is accomplished via mods to build-namelist. The + changes are: + - cloud_fraction fixed so the new algorithms for ice cloud fraction are + only invoked for the MG microphysics package. + - set the default value of fcrit2 in gw_drag to 0.5 for CAM3 and CAM3_5 + physics. The default in the current code is 1.0. + - set fft_flt=0 for CAM3 and CAM3_5 versions. This only applies to the FV + dycore. The current default is fft_flt=1 (which required building with + ALT_PFT defined in the CAM3 and CAM3_5 versions of the code). + + Note 1: There are still some differences from the CAM3_5 version of the physics + present in the current code: + - The radiation code now uses a mass based relative humidity (rh) calc + rather than a mole based one. This is for consistency with other calcs + of rh in the moist physics. + - The radiation code assumes that the constituents are dry mixing ratios + rather than moist when computing optical depths. + - the sea salt optics for camrt are now computed using two bins (coarse + and accumulation modes) instead of one. These optics calculations now + depend on the available optics files. We'd need some code modification + along with a new optics file to enable a 1-bin version of sea salt + optics used by cam3_5. + + Note 2: The above changes also apply to the cam3 physics. But cam3 + physics is still not working due to the Neale/Richter convection mods not + being optional. This is still on the to do list. + +. Remove the need to run the chemistry preprocessor for prognostic BAM + (trop_bam). + +. Update srf emission and external forcing files for both BAM and MAM to use + the AEROCOM files for year 2000 (trop_mam3 was already using these files) + +. Update CICE to cice4_0_20090211 + +. Update the 1870_prog_aero use case to use the aerocom emissions. + Update the 1870_control use case to remove the trop_mam3 attribute from + the emission datasets. These datasets are used by either BAM or MAM + prognostic aerosols. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. have build-namelist set the default values of the variables in the + phys_control module, i.e., deep_scheme, eddy_scheme, shallow_scheme, + srf_flux_avg, and microp_scheme, so that CAM version specific defaults + will be set. build-namelist also made responsible for setting fcrit2 and + fft_flt. + +List any changes to the defaults for the boundary datasets: + +. use aerocom 2000 files for BAM and MAM + +atm/cam/chem/trop_mozart_aero/emis/aerocom_DMS_2000.c080417.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_CB1_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_OC1_2000.nosoa.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SOAG_2000.c080926.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_surface_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_surface_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_vertical_2000.c080807.nc +atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_vertical_2000.c080807.nc + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +Files from chemistry preprocessor added to src/chemistry/trop_bam/ +A chem_mods.F90 +A m_het_id.F90 +A mo_adjrxt.F90 +A mo_imp_sol.F90 +A mo_indprd.F90 +A mo_lin_matrix.F90 +A mo_lu_factor.F90 +A mo_lu_solve.F90 +A mo_nln_matrix.F90 +A mo_phtadj.F90 +A mo_prod_loss.F90 +A mo_setrxt.F90 +A mo_sim_dat.F90 +A m_rxt_id.F90 +A m_spc_id.F90 + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update CICE to cice4_0_20090211 + +models/atm/cam/bld/build-namelist +. add defaults for deep_scheme, eddy_scheme, shallow_scheme, srf_flux_avg +. add default for fcrit2 (non-WACCM runs only) +. add default for fft_flt +. fix bug in sub add_default. Needed to check for a defined return value + from get_default_value rather than a true or false return value. The + valid return value "0" was causing the check to fail. + +models/atm/cam/bld/configure +. add section analogous to the one for trop_mam3 in the section that + invokes the chem preprocessor. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add default values for deep_scheme, eddy_scheme, shallow_scheme, + srf_flux_avg +. add default values for fcrit2 (depends of cam version) +. add default values for fft_flt (depends on cam version) +. use aerocom 2000 files for BAM and MAM + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. move the phys_control namelist variables into group phys_ctl_nl + +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +. Update the 1870_prog_aero use case to use the aerocom emissions. + Update the 1870_control use case to remove the trop_mam3 attribute from + the emission datasets. These datasets are used by either BAM or MAM + prognostic aerosols. Currently these use cases are identical. + +models/atm/cam/src/control/runtime_opts.F90 +. replace phys_{default,set}opts methods by phys_ctl_readnl. phys_control + module now reads it's own namelist. +. remove unused indforce variable + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. add logic to only do new cloud ice fraction calculation for MG + microphysics and to return the cloud fraction for cam3_5 physics + overwise. + +models/atm/cam/src/physics/cam/gw_drag.F90 +. remove setting default value of fcrit2 + +models/atm/cam/src/physics/cam/phys_control.F90 +. replace the phys_{default,set}opts methods with phys_ctl_readnl so this + module reads it's own namelist. +. Since the default physics packages depend on what physics version we want + to run, allow build-namelist to set the defaults rather than hardcoding + them. Remove the hardcoding of initial values in the module variables. + +models/atm/cam/src/physics/cam/radiation.F90 +. Remove radforce, indforce, and associated diagnostics. This isn't + supported by the new aerosol-radiation interfaces. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. Remove radforce and indforce module variables. This isn't + supported by the new aerosol-radiation interfaces. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +059 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 6 + +bl381 fails due to changing the emission datasets in the 1870_prog_aero use case +bl731 fails because it uses cam3 physics which changed (bug fixes) +sc001 is a pre-existing failure + +bangkok/lf95: All PASS except: + +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 + +bl315 fails due to changes in cam3 physics (bug fixes) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for configs using cam3 or + cam3_5 physics, and for prognostic BAM due to updating the emission + datasets (both present day (year 2000) and pre-industrial (year 1750) + emissions). + +=============================================================== +=============================================================== + +Tag name: cam3_6_28 +Originator(s): eaton, mflanner +Date: Tue Feb 10 09:23:00 MST 2009 +One-line Summary: send trop_mam3 aerosol deposition fluxes to the coupler + +Purpose of changes: + +. Add the aerosol deposition fluxes to CAM's export state. These fields + are copied to the coupler. Currently this is only being done for the + trop_mam3 aerosols. Eventually CAM will always be responsible for + providing these fluxes, even in prescribed aerosol modes. + +. Update CICE tag to cice4_0_20090209 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none known + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/chemistry/modal_aero/modal_aero_deposition.F90 +. This module contains the subroutines that are responsible for + partitioning the deposition fluxes of the modal aerosol components into + the fluxes passed through the coupler. + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. Update CICE tag to cice4_0_20090209 + +models/atm/cam/bld/build-namelist +. use cice config cache filepath from config_cache file when issuing CICE + build-namelist command. + +models/atm/cam/bld/config_files/definition.xml +. add cice_config_cache_file + +models/atm/cam/bld/configure +. write the filepath for the CICE config_cache file to CAM's config_cache + file so that CAM's configure knows where it is when it invokes the CICE + build-namelist. + +models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +. add cam_out to arg list of mz_aero_{wet,dry}_intr +. add dry/wet fluxes for each modal constituent to local var +. call new methods, set_srf_drydep and set_srf_wetdep, to partition + contributions from modal constituents into fields passed to coupler. + +models/atm/cam/src/control/atm_comp_mct.F90 +. copy fluxes from cam export state into coupler buffer + +models/atm/cam/src/control/camsrfexch_types.F90 +. add aerosol deposition fluxes to cam export type +. initialize values to 0. for trop_mam3, to shr_const_spval otherwise. + +models/atm/cam/src/physics/cam/aerosol_intr.F90 +. add cam_out to actual args of mz_aero_wet_intr and mz_aero_dry_intr +. add cam_out to dummy args of aerosol_wet_intr and aerosol_drydep_intr + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add new method, diag_export, to make outfld calls for the deposition + fluxes that are being passed to the coupler + +models/atm/cam/src/physics/cam/physpkg.F90 +. modify calling args to diag_surf (cleanup) + +models/atm/cam/src/physics/cam/restart_physics.F90 +. add 8 drydep components of cam_out to both the pio and serial code + sections. + +models/atm/cam/src/physics/cam/tphysac.F90 +. add cam_out to actual args of aerosol_drydep_intr + +models/atm/cam/src/physics/cam/tphysbc.F90 +. add cam_out to actual args of aerosol_wet_intr +. call diag_export at end of subroutine. This is the state that is copied + to the coupler. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +059 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 6 + +This failure is pre-existing. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. + +=============================================================== +Tag name: cam3_6_27 +Originator(s): eaton,andrew,mvr +Date: 02 Feb 2009 +One-line Summary: Make trop_mam3 the default chemistry; integrate MAM with the MG microphysics. + +Purpose of changes: + +. Make trop_mam3 the default chemistry. + - Don't require running the chemistry preprocessor for predefined chemistry + schemes; currently only trop_mam3 has been reimplemented this way. + - Add tuning to modal aerosols from Xiaohong. + - Add boundary layer nucleation from Xiaohong. + +. MG microphysics changes + - add MG microphysics bug fix for diagnostic field used by wet dep codes + - ice microphysics mods; MAM tuning + - hook immersion freezing to modal dust + +. Update RRTMG external + - update rrtmg to latest tag, rrtmg_081203, which includes change to sw + surface fluxes needed to balance the surface energy budget. + +. changes for regression testing + - modified the offline driver test to run at 1.9x2.5 + - change mo_apex.F90 to calculate latitude midpoints inline rather than + relying on a quantity (clat_staggered) that's not available from all the + dycores. This is to get the regression tests working for the spectral + dycores. + - Removed the gensom and som config files from the regression tests. + +. new external tags for almost all components to emulate current ccsm beta tags + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +. default chemistry set to trop_mam3 + +. Don't require running the chemistry preprocessor for predefined chemistry + schemes; currently only trop_mam3 has been reimplemented this way. + +. Refactor configure's -chem option. This needed to be done to provide a way + to turn off the default trop_mam3 chemistry. At the same time, the + overloaded use of "-chem none" to imply that the CAM3 prescribed aerosols + and ozone were being used was removed. Now "-chem none" is used to turn + off all prognostic chemistry without implying which prescribed aerosols or + ozone are used. To do that new valid values, cam3 and cam3_5, have been + added to the -phys argument. "-phys cam3" now implies "-chem none" and + that the CAM3 prescribed aerosols and ozone will be used. This is not yet + a completely implemented backwards compatibility switch for CAM3 physics + because the Richter/Neale convection mods are still hardwired. But the + intention is to have the "-phys cam3" option eventually provide the + complete CAM3 physics package. "-phys cam3_5" also implies "-chem none", + but instead of the CAM3 aerosols and ozone, the newer prescribed BAM + aerosols and the ozone dataset from J.F. Lamarque will be used. + + In addition to the new configure functionality, quite a bit of new error + checking has been added to try and prevent building the model with + inconsistent physics packages. + +. The -gensom and "-ocn som" options were removed from configure. The new + SOM functionality is currently only available via the CCSM scripts. + +Describe any changes made to the namelist: +. option added to allow cam's build-namelist to call build-namelist for cice + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: +. trop_mam3 is much more expensive than prescribed BAM + +. the build will be faster when the chemistry preprocessor isn't needed + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/f10sdm +D models/atm/cam/test/system/config_files/f4gdh +D models/atm/cam/test/system/config_files/f4sdh +D models/atm/cam/test/system/config_files/e8sdm +D models/atm/cam/test/system/config_files/e32sdh +D models/atm/cam/test/system/config_files/s8sdm +D models/atm/cam/test/system/config_files/e64sm +D models/atm/cam/test/system/config_files/s32sdh +. obsolete test files containing configure options + +D models/atm/cam/test/system/tests_posttag_bluevista +. removed file for obsolete machine + +List all subroutines added and what they do: +A + models/atm/cam/test/system/config_files/fmo1.9dh +- new test file containing configuration options for offline driver test + +A + models/atm/cam/test/system/config_files/s8dm +. replacement test file containing configuration options + +A + models/atm/cam/test/system/nl_files/off1.9x2.5 +. new test file containing namelist options for offline driver test + +A + models/atm/cam/bld/namelist_files/use_cases/1870_bam.xml +. new use case for prescribed BAM aerosols + +A + models/atm/cam/src/chemistry/trop_mam3 +A + models/atm/cam/src/chemistry/trop_mam3/mo_lu_solve.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_setrxt.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_adjrxt.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_imp_sol.F90 +A + models/atm/cam/src/chemistry/trop_mam3/chem_mods.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_prod_loss.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_lin_matrix.F90 +A + models/atm/cam/src/chemistry/trop_mam3/m_rxt_id.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_phtadj.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_nln_matrix.F90 +A + models/atm/cam/src/chemistry/trop_mam3/m_het_id.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_lu_factor.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_indprd.F90 +A + models/atm/cam/src/chemistry/trop_mam3/mo_sim_dat.F90 +A + models/atm/cam/src/chemistry/trop_mam3/m_spc_id.F90 +. preprocessor output for trop_mam3 + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCB.sh +. added -cice_decomptype to configure call + +M models/atm/cam/test/system/tests_pretag_bluefire +. modified list of default tests for pretag testing of machine bluefire + +M models/atm/cam/test/system/config_files/f10c3dm +. use "-phys cam3" in place of "-chem none -microphys rk -rad camrt" + +M models/atm/cam/test/system/config_files/h16x4dm +. modified the test file used for configuration options for homme test + +M models/atm/cam/test/system/config_files/scm64bfbiop +M models/atm/cam/test/system/config_files/e64bfbiop +M models/atm/cam/test/system/config_files/scmarmiop +- added -chem "none" to configuration options of scam tests as temporary fix + +M models/atm/cam/test/system/tests_pretag_bangkok +. modified list of pretag tests to fit in time constraints + +M models/atm/cam/test/system/TBR.sh +. set the cice_ic var with the restart filename only (not absolute path) +. modified call to build-namelist for cice changes; cleanup + +M models/atm/cam/test/system/test_driver.sh +. added env var to allow specification of batch queue + +M models/atm/cam/test/system/TER.sh +. modified call to build-namelist for cice changes + +M models/atm/cam/test/system/nl_files/scm_prep +. changed the names in the fincl2 list to match the untruncated names + +M models/atm/cam/test/system/input_tests_master +. change the *382 tests to use the new use case 1870_bam.xml. This + preserves the test of prescribed bam aerosols. +. change e32sdh to e32dh +. change e64sm to e64m +. change e8sdm to e8dm +. change f10sdm to f10dm +. change f4gdh to f4dh +. change f4sdh to f4dh +. change s8sdm to s8dm + +M models/atm/cam/test/system/TSM.sh +. modified call to build-namelist for cice changes + +M models/atm/cam/bld/configure +. make trop_mam3 the default value for chem. +. add conditional logic to not call chem_preprocess when the chem package + is trop_mam3. This requires correctly setting $chem_nadv, $chem_cppdefs, + and the 'chem_src_dir' entry in the configure object. +. fix bug in setting chem_pkg when phys is ideal or adiabatic +. modify how the default chemistry package is set. +. add error checking for inconsistent settings of physics and chemistry + packages. +. add error checking for inconsistent settings of radiation and + microphysics packages. The defaults for both these packages has moved + from the definition file to configure since they depend on the setting of + the physics package. +. remove -gensom and "-ocn som" options. SOM is only supported via the + CCSM scripts. +. mods needed for cice build changes; additions for ocn,lnd,glc stub code + +M models/atm/cam/bld/Makefile.in +. -DHAVE_GETTIMEOFDAY added to cppdefs (required to control output of new + timing code) + +M models/atm/cam/bld/config_files/definition.xml +. change valid value for phys: cam1 -> cam, and add cam3 and cam3_5. +. mods in connection with stub code additions + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update filenames of aerocom emissions for 2000 +. add dst_0.47x0.63_c081217.nc for 1/2 degree soil_erod default +. update the CLM entries to be as consistent with the CLM version as + possible. +. Add the entries for fsnowoptics, fsnowaging, faerdep. + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +. add definitions for fsnowoptics, fsnowaging, faerdep. + +M models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +. update for trop_mam3 chemistry + +M models/atm/cam/bld/build-namelist +. add defaults for fsnowoptics, fsnowaging, faerdep. +. add co2_ppmv. Take this from the value set for CAM and convert vmr to +ppmv. +. change the way CAM3 physics is specified. Currently uses $chem eq 'none' + change to $phys eq 'cam3'. The cam3_5 option should use the prescribed + BAM aerosols and JF's prescribed ozone. +. Don't try to create CLM or CICE namelists if the physics mode doesn't use + an active land or ice component. Currently that's true for the ideal, + adiabatic, and aqua_planet modes. +. option added to allow cam's build-namelist to call build-namelist for cice + +M models/atm/cam/bld/camdom.cpl7.template +M models/atm/cam/bld/cam.cpl7.template +. update .template files for ccsm4_0_beta07 (and later) tags + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. from rrtmg_081029 to rrtmg_081203 + +M models/atm/cam/src/control/scamMod.F90 +. change declarations for alphanam(pcnst) and dqfxnam(pcnst) from char*8 to + char*16 so the names aren't truncated. + +M models/atm/cam/src/control/atm_comp_mct.F90 +. compute nextsw_cday at init time for startup runs only + +M models/atm/cam/src/physics/cam/cldwat2m.F90 +. remove temp vars nevapr1, evapsnow1, prain1, prodsnow1, cmeout1. They + were being zeroed incorrectly inside the iteration where they were + supposed to be accumulating quantities over sub-steps. +. replace DOS with UNIX endlines +. immersion freezing hooks in modal dust + +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +. ice microphysics mods from Andrew Gettleman +. immersion freezing hooks in modal dust + +M models/atm/cam/src/physics/cam/aerosol_intr.F90 +. immersion freezing hooks in modal dust + +M models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +M models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 +. fix declaration of dotend -- was pcnstxx, changed to pcnst. +. mods for boundary layer nucleation from xiaohong + +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +. mods for boundary layer nucleation from xiaohong + +M models/atm/cam/src/chemistry/mozart/mo_apex.F90 +. replace reference to clat_staggered by inline calculation of latitude +midpoints. + +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +. In subroutine interp_map change veg_ext from 10 to 20. + +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +. Add tuning to modal aerosols from Xiaohong. + +M SVN_EXTERNAL_DIRECTORIES +. new tags for almost all components to emulate current ccsm beta tags + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e32dh ghgrmp 9s ..................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4dh co2rmp 9s ...................................FAIL! rc= 7 +019 bl332 TBL.sh f4dh ghgrmp 9s ...................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl370 TBL.sh fmo1.9dh off1.9x2.5 9s ...........................FAIL! rc= 5 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_bam 9s ..................FAIL! rc= 5 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 +059 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 4 +- all baselines failed except for adiabatic and ideal physics (this was expected) +- scam test has been broken, a fix is in the works + +bangkok/lf95: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8dm ghgrmp 9s ...................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +021 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +029 bl312 TBL.sh f10dm ghgrmp 9s ..................................FAIL! rc= 7 +031 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +034 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +037 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +040 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +- all baselines failed except for adiabatic and ideal physics (this was expected) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate +. There are answer changes due to all of the following + - Updates in both the MAM and MG microphysics, as well as integrating those + packages to work together. + - New RRTMG tag with modified SW surface fluxes. + - Answer changes from updated CLM and CICE tags. + +=============================================================== + +Tag name: cam3_6_26 +Originator(s): Francis Vitt +Date: 24 Dec 2008 +One-line Summary: Addition of the LLNL super fast chemistry + +Purpose of changes: + + Provide a less expensive option for interactive chemistry + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + Added configure option: + -chem super_fast_llnl + +Describe any changes made to the namelist: + + Replaced "photopath" namelist variable with "exo_coldens_file", + "tuv_xsect_file", and "o2_xsect_file". + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/bld/config_files/defaults_super_fast_llnl.xml + - configure defaults for the super_fast_llnl chem + +A models/atm/cam/src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 +A models/atm/cam/src/chemistry/mozart/llnl_set_chem_trop.F90 + - for super_fast_llnl chem + +A models/atm/cam/src/chemistry/mozart/lin_strat_chem.F90 +A models/atm/cam/src/chemistry/mozart/linoz_data.F90 + - for linoz ozone speicification in the stratosphere + +List all existing files that have been modified, and describe the changes: + + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_files/definition.xml + - configure -chem super_fast_llnl option added + +M models/atm/cam/bld/chem_preprocess.pl + - changed location of the chemistry preprocessor to models/atm/cam/chem_proc + - super_fast_llnl option added + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - new chem IC files added + - defaults for super_fast_llnl chemistry + +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - replaced "photopath" namelist variable with + "exo_coldens_file", "tuv_xsect_file", and "o2_xsect_file". + - linoz options added + - tropopause level options added + +M models/atm/cam/bld/build-namelist + - changes for super_fast_llnl chem + - replaced "photopath" namelist variable with "exo_coldens_file", + "tuv_xsect_file", and "o2_xsect_file". + +M models/atm/cam/src/physics/cam/eddy_diff.F90 + - change to appease lf95 compiler + +MM models/atm/cam/src/chemistry/utils/tracer_data.F90 + - mods to read zonal-averaged LINOZ data + +M models/atm/cam/src/chemistry/mozart/mo_aero_settling.F90 + - fixed potential array out-of-boounds error + +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - changes for super_fast_llnl and linoz + +M models/atm/cam/src/chemistry/mozart/mo_seto2.F90 + - changed photopath to o2_xsect_file + +M models/atm/cam/src/chemistry/mozart/mo_tropopause.F90 + - cleanup + +M models/atm/cam/src/chemistry/mozart/mo_exp_sol.F90 + - added ability to specify top pressure level to apply solver + +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - chemistry options change + +M models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +M models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 + - SYNOZ bug fix + +M models/atm/cam/src/chemistry/mozart/mo_setinv.F90 + - change for super_fast_llnl + +M models/atm/cam/src/chemistry/mozart/chemistry.F90 + - chemistry options change + - changes for super_fast_llnl and linoz + +M models/atm/cam/src/chemistry/mozart/mo_tuv_inti.F90 +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 + - replaced "photopath" namelist variable with "exo_coldens_file", + "tuv_xsect_file", and "o2_xsect_file". + +M models/atm/cam/src/chemistry/mozart/efield.F90 + - waccm change provided by HAO + +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 + - changes for super_fast_llnl and linoz + +M models/atm/cam/SVN_EXTERNAL_DIRECTORIES +M SVN_EXTERNAL_DIRECTORIES + - changed location of the chemistry preprocessor to models/atm/cam/chem_proc + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 + A science change in efield.F90 caused this failure + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_25 +Originator(s): pworley +Date: Wed Dec 18 10:25:45 MST 2008 +One-line Summary: generalize and optimize load balancing options + +Purpose of changes: + +1) Generalize the definition of load balancing options +0, 1, 3, and 4 to be able to use more processes in the physics than in +the dynamics. + +Previously there was support for using additional +processes in the physics only when specifying the most aggressive +load balancing (phys_loadbalance==2). The other options have been +generalized to assign work to all physics processes. +For example, phys_loadbalance==0 will now distribute work +to otherwise idle processes, but will (still) not trade work with +other processes active during the dynamics. When the number of +physics and dynamics processes are the same, the behavior of +the load balancing options is unchanged. + +2) Introduce new default communication option for physics +load balancing (phys_alltoall = -1) that uses information about +nature of the communication to choose between a point-to-point +algorithm and an MPI collective. + +When using more physics processes than dynamics processes, and +when using load balancing options other than phys_loadbalance=2, +most processes send and receive data to/from only a small number of +the other processes. In these situations, a point-to-point implementation +of the data arrangment is often faster than calling MPI_Alltoallv. +This observation is now "implemented" in the code. It can be overridden +by setting phys_alltoall to 0 (to use collective) or 1 (to use +point-to-point algorithm). + +3) Performance optimizations in FV (mod_comm and geopk_d) +and dynamics/physics MPI communications (spmd_util). + +Eliminated sending/receiving zero length messages in one +of the communication options in both the FV transposes and +in the physics/dynamics transposes. Also added support for +the mpi_isend/mpi_send option (modc_send_cdcore) to the +geopk_d algoritm. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +- Changed the range of phys_alltoall to include -1, and made -1 the default. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +- Performance improved at scale, especially when using more physics +processes than dynamics processes + +Code reviewed by: Mirin + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/physics/cam: + phys_grid.F90 - generalized load balancing options; + changed phys_alltoall default + + models/atm/cam/src/utils: + spmd_utils.F90 - eliminated zero-length messages when not using + handshaking protocol + + models/utils/pilgrim: + mod_comm.F90 - eliminated zero-length messages when not using + handshaking protocol + + models/atm/cam/src/dynamics/fv: + cd_core.F90 - changed parameters in call to geopk_d + geopk.F90 - added modc_send_cdcore option to geopk_d + dynamics_vars.F90 - updated comments + spmd_dyn.F90 - updated comments + dp_coupling.F90 - zeroed out uninitialized array elements being + communicated during load balancing + + models/atm/cam/src/dynamics/eul: + spmd_dyn.F90 - initialized work array used in load balancing + + models/atm/cam/src/dynamics/sld: + spmd_dyn.F90 - initialized work array used in load balancing + + models/atm/cam/bld/namelist_files: + namelist_definition.xml - updated descriptions + + models/atm/cam/src/control: + runtime_opts.F90 - updated comments + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +bangkok/lf95: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): NO CHANGES (bfb) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_6_24 +Originator(s): eaton +Date: Fri Dec 12 15:02:11 MST 2008 +One-line Summary: remove PIO as part of CAM component when building for CCSM + +Purpose of changes: + +. Remove PIO as part of CAM component when building for CCSM. This backs + out a hack added in cam3_6_19 for the CCSM build. + + *** This change doesn't affect the CAM standalone build and has not been + run through all the usual pretag regression testing. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. As noted above when building for CCSM. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/configure +. Don't build PIO as part of CAM component for CCSM build. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: not done. + +bangkok/lf95: not done. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_23 +Originator(s): eaton, pworley, mvertens +Date: Tue Dec 9 12:35:36 MST 2008 +One-line Summary: update interpic_new, scripts tag; misc + +Purpose of changes: + +. Substantial update to interpic_new code. See tools/interpic_new/README + for details. This includes mods from Mark Taylor to deal with large files. + +. Mod to phys_grid.F90 that was left out of the cam3_6_21 commit (from + Pat Worley). + +. Mods to run on BGP. + +. Cleanup: put config_* files into config_files/* + +. update scripts external to scripts4_081207. + +. updated cam.cpl7.template file (from Mariana Vertens). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/bld/config_defaults_eul.xml +models/atm/cam/bld/config_defaults_fv.xml +models/atm/cam/bld/config_defaults_homme.xml +models/atm/cam/bld/config_defaults_sld.xml +models/atm/cam/bld/config_defaults_trop_bam.xml +models/atm/cam/bld/config_defaults_trop_ghg.xml +models/atm/cam/bld/config_defaults_trop_mam3.xml +models/atm/cam/bld/config_defaults_trop_mam7.xml +models/atm/cam/bld/config_defaults_trop_mozart.xml +models/atm/cam/bld/config_defaults_waccm_ghg.xml +models/atm/cam/bld/config_defaults_waccm_mozart.xml +models/atm/cam/bld/config_definition.xml +models/atm/cam/bld/config_definition.xsl +models/atm/cam/bld/config_horiz_grid.xml +models/atm/cam/bld/config_sys_defaults.xml +. moved to subdirectory config_files/ and renamed + +models/atm/cam/tools/interpic_new/interp_driver.F90 +models/atm/cam/tools/interpic_new/varspecs_mod.F90 + +List all subroutines added and what they do: + +models/atm/cam/bld/config_files/defaults_eul.xml +models/atm/cam/bld/config_files/defaults_fv.xml +models/atm/cam/bld/config_files/defaults_homme.xml +models/atm/cam/bld/config_files/defaults_sld.xml +models/atm/cam/bld/config_files/defaults_trop_bam.xml +models/atm/cam/bld/config_files/defaults_trop_ghg.xml +models/atm/cam/bld/config_files/defaults_trop_mam3.xml +models/atm/cam/bld/config_files/defaults_trop_mam7.xml +models/atm/cam/bld/config_files/defaults_trop_mozart.xml +models/atm/cam/bld/config_files/defaults_waccm_ghg.xml +models/atm/cam/bld/config_files/defaults_waccm_mozart.xml +models/atm/cam/bld/config_files/definition.xml +models/atm/cam/bld/config_files/definition.xsl +models/atm/cam/bld/config_files/horiz_grid.xml +models/atm/cam/bld/config_files/sys_defaults.xml +. moved from the bld/ subdirectory and renamed (remove config_ prefix) + +models/atm/cam/tools/interpic_new/interp.F90 +models/atm/cam/tools/interpic_new/interpolate_data.F90 +models/atm/cam/tools/interpic_new/shr_kind_mod.F90 +. interpic_new refactoring + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. change scripts external to scripts4_081207. + +models/atm/cam/bld/build-namelist +. replace instances of $defaults->get_value by get_default_value. This is + so that the use case setting affects the default values. + +models/atm/cam/bld/cam.cpl7.template +. cam's dtime is set based on $ATM_NCPL +. mods to incorporate $CAM_CONFIG_OPTS arg to configure. This replaces the + more specific $CAM_CHEM. +. remove broken CO2 cycle code. Will reimplement as required. +. $CAM_USE_CASE replaced by $CAM_NML_USE_CASE. + +models/atm/cam/bld/Makefile.in +. mods to the BGP section + +models/atm/cam/bld/configure +. change names of config_*.xml files to config_files/*.xml + +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +. Remove tracer_cnst_file from use case xml file since the default chem is + not using prognostic aerosols. Also remove the scon setting since that + now comes from the general defaults. + +models/atm/cam/test/system/test_driver.sh +. increase queue time on bluefire to 4:28 (from 3:28) + +models/atm/cam/src/control/cam_history.F90 +. remove endrun condition if LOGNAME isn't found in environment + +models/atm/cam/src/control/ioFileMod.F90 +. remove unused "use shr_sys_mod" and "use shr_file_mod + +models/atm/cam/src/control/print_memusage.F90 +. add BGP to the ifdef that avoids calling get_memusage + +models/atm/cam/src/physics/cam/phys_grid.F90 +. replace some mpigather* calls by fc_gather* + +models/atm/cam/tools/interpic_new/Makefile +models/atm/cam/tools/interpic_new/README +models/atm/cam/tools/interpic_new/compare_var.F90 +models/atm/cam/tools/interpic_new/control.F90 +models/atm/cam/tools/interpic_new/cpvar.F90 +models/atm/cam/tools/interpic_new/dimensions.F90 +models/atm/cam/tools/interpic_new/driver.F90 +models/atm/cam/tools/interpic_new/fill_positions.F90 +models/atm/cam/tools/interpic_new/fmain.F90 +models/atm/cam/tools/interpic_new/handle_special_cases.F90 +models/atm/cam/tools/interpic_new/is_special_case.F90 +models/atm/cam/tools/interpic_new/wrap_nf.F90 +. update interpic_new + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_22 +Originator(s): Xiaohong Liu, Francis Vitt +Date: 5 Dec 2008 +One-line Summary: Incorporate the Modal Aerosol Model (MAM) + +Purpose of changes: + + Provide more aerosol model options. In addition the the bulk + aerosol model, 3-mode and 7-mode modal models have been + incorporated with radiation feed-backs on the climate. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + Changes to the configure utility: + -chem options added: + trop_mam3 (3-mode model) + trop_mam7 (7-mode model) + -chem option change: + trop_aero --> trop_bam (bulk aerosol model) + +Describe any changes made to the namelist: + + New namelist variables: + modal_optics (char*256) + dataset for modal aerosol optics + + aer_drydep_list (char*16(1000)) + list of modal aerosol species that undergo dry deposition + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/bld/config_defaults_trop_aero.xml + +List all subroutines added and what they do: + +A models/atm/cam/bld/config_defaults_trop_mam7.xml +A models/atm/cam/bld/config_defaults_trop_mam3.xml +A models/atm/cam/bld/config_defaults_trop_bam.xml + - added configure options "-chem trop_mam7" and "-chem trop_mam3" + - replaced the "-chem trop_aero" with "-chem trop_bam" + +A models/atm/cam/src/physics/cam/miesubs.F +A models/atm/cam/src/physics/cam/modal_aer_opt.F90 +A models/atm/cam/src/physics/cam/ndrop.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_rename.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_coag.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_data.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_wateruptake.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_calcsize.F90 +A models/atm/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 + - files added for MAM + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/config_files/fma1.9h +M models/atm/cam/test/system/config_files/fma1.9m + - change "-chem trop_aero" to "-chem trop_bam" + +M models/atm/cam/bld/configure +M models/atm/cam/bld/chem_preprocess.pl +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_definition.xml + - implemented configure and build-namelist changes for MAM + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/wrap_nf.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/filenames.F90 +M models/atm/cam/src/physics/cam/progseasalts_intr.F90 +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/dust_intr.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 +M models/atm/cam/src/physics/cam/cldwat2m.F90 +M models/atm/cam/src/physics/cam/aer_rad_props.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/cam/phys_prop.F90 +M models/atm/cam/src/physics/cam/stratiform.F90 +M models/atm/cam/src/physics/cam/radlw.F90 +M models/atm/cam/src/physics/cam/rad_constituents.F90 +M models/atm/cam/src/physics/cam/wetdep.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/carbon_intr.F90 +M models/atm/cam/src/physics/cam/sulchem.F90 +M models/atm/cam/src/physics/cam/wv_saturation.F90 +M models/atm/cam/src/physics/cam/aerosol_intr.F90 +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/physics/cam/qneg3.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +M models/atm/cam/src/physics/rrtmg/radlw.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radsw.F90 +M models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +M models/atm/cam/src/chemistry/mozart/chemistry.F90 +M models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +M models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +M models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +M models/atm/cam/src/chemistry/mozart/mo_setsox.F90 + - source code files changed to implement MAM + +M models/atm/cam/src/chemistry/mozart/mo_photo.F90 +M models/atm/cam/src/chemistry/mozart/mo_photoin.F90 + - changes needed to use fast-tuv photolyis in MAM + +M models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/mozart/mo_chemini.F90 + - reduced the memory overhead for the table-lookup photolysis method + +M SVN_EXTERNAL_DIRECTORIES + - new chem_proc tag (chemistry preprocessor) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 + + These baseline failures are expected. These are caused by changes in + the photolysis routines and input datasets. + +bangkok/lf95: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_21 +Originator(s): Art Mirin, Pat Worley +Date: +One-line Summary: Improvements to communication, other misc. improvements + +Purpose of changes: Improve communication performance at scale. + +Changes are bit-for-bit. + +MPI performance in CAM for runs with large numbers of processes has proven +to be erratic in certain circumstances, sometimes even leading to failures +due to exhaustion of system buffer space. Aspects of this behavior have been +observed on three different platforms (Atlas at LLNL, Cray XT, and IBM BG/P), +and is likely to occur with some process count on all systems. + +Through empirical experiments, we identified a number of communication protocols +that were implemented in the swapm routine in the spmd_utils module that eliminate +these problems. However, no one protocol was best in all situations, so a number +of protocols were imported into the mod_comm irregular communication routines +(which are used for intra-FV-dynamics transposes, gathers and scatters, +and geopotential communications) and the choice of what to use can be +specified at runtime. Reasonable defaults were determined, however. + +As part of this exercise, we also cleaned up the swapm routine, +removing the options that are never exercised, so the logic in mod_comm and +swapm are now very similar. + +(Fun fact: swapm communication protocols were originally developed for PSTSWM +and were used in CCM/MP2D.) + +The ALTGATHER logic, used to avoid problems on the Cray XT when too many "unexpected" +messages arrive at the root of the gather, is now supported within mod_comm as one +of the options, and is enabled by default. Similarly, new routines with robust +behavior but without any performance degradation were made the defaults for I/O-related +gathers for the spectral dycores. + +The new communication options, implemented in the mod_comm mp_sendirr +and mp_recvirr irregular communication routines, include: + +(1) option to handshake; that is, the source will not post its send until the +corresponding receive has already been posted; this mitigates against unnecessary +contention and buffering; in this case, ready send is used instead of send. + +(2) option to use blocking rather than nonblocking send. + +(3) option to limit the number of outstanding message requests; this mitigates against +exhausting buffer space and performance degradation when the number of sources and +destinations for a process during a collective operation becomes large. + +(4) option to call MPI_Alltoallv. (Note, this is typically not the best choice within +the FV dycore on Atlas or on the Cray XT, but it usually is best on the IBM BG/P.) + +(5) option to perform certain intra-FV-dynamics transposes in pairs. + +(6) option to perform intra-FV-dynamics tracer transposes N at a time; irregular transpose +structures were replaced with 4-D arrays; also, the partial real*4 tracer support was +removed. + +We also changed ordering of target tasks to dimensional-exchange ordering, as used in swapm, +rather than 1 to N; this mitigates against contention. + +Changes were also made to the logic for error checking with the fast reproducible sum +calculation; testing and warning message are now run-time options, off by default; in +particular, the collective sums are computed once only unless the user requests error +checking. + +Bugs fixed (include bugzilla ID): Temporary 1-line conditionally compilable patches +were added to six pio-related files, as workaround for ifort compiler bug. + +Describe any changes made to build system: + +Describe any changes made to the namelist: The following were added: + + modc_sw_dynrun - mod_comm irregular underlying communication method for dyn_run/misc + modc_hs_dynrun - mod_comm irregular communication handshaking for dyn_run/misc (T/F) + modc_send_dynrun - mod_comm irregular communication send protocol for dyn_run/misc (T/F) + modc_mxreq_dynrun - mod_comm irregular communication nonblocking request throttle for dyn_run/misc + + modc_sw_cdcore - mod_comm irregular underlying communication method for cd_core/geopk + modc_hs_cdcore - mod_comm irregular communication handshaking for cd_core/geopk (T/F) + modc_send_cdcore - mod_comm irregular communication send protocol for cd_core/geopk (T/F) + modc_mxreq_cdcore - mod_comm irregular communication nonblocking request throttle for cd_core/geopk + + modc_sw_gather - mod_comm irregular underlying communication method for gather + modc_hs_gather - mod_comm irregular communication handshaking for gather (T/F) + modc_send_gather - mod_comm irregular communication send protocol for gather (T/F) + modc_mxreq_gather - mod_comm irregular communication nonblocking request throttle for gather + + modc_sw_scatter - mod_comm irregular underlying communication method for scatter + modc_hs_scatter - mod_comm irregular communication handshaking for scatter (T/F) + modc_send_scatter - mod_comm irregular communication send protocol for scatter (T/F) + modc_mxreq_scatter - mod_comm irregular communication nonblocking request throttle for scatter + + modc_sw_tracer - mod_comm irregular underlying communication method for multiple tracers + modc_hs_tracer - mod_comm irregular communication handshaking for multiple tracers (T/F) + modc_send_tracer - mod_comm irregular communication send protocol for multiple tracers (T/F) + modc_mxreq_tracer - mod_comm irregular communication nonblocking request throttle for multiple tracers + modc_onetwo - one or two simultaneous mod_comm irregular communications (excl. tracers) + modc_tracers - max number of tracers for simultaneous mod_comm irregular communications; + if 0, then use mp_sendirr/mp_recvirr to do one at a time + + fc_gather_flow_cntl - tuning option for flow-controlled gathers used by spectral dycores. + Default should be sufficient, but if performance is suffering can try a + different level of message request throttling. + +List any changes to the defaults for the boundary datasets: NONE + +Describe any substantial timing or memory changes: Certain configurations on +certain platforms run a lot faster at scale. + +Code reviewed by: Eaton + +List all subroutines eliminated: + + utils/pilgrim/mod_comm.F90: + mp_swapmirr, mp_sendirr_fc, mp_sendirr_fc_r4, mp_sendirr_fc_i4 + +List all subroutines added and what they do: + + utils/pilgrim/mod_comm.F90: + mp_sendtrirr, + mp_recvtrirr - versions of mp_sendirr/mp_recvirr for use with tracer advection + + mp_swapirr, + mp_swapirr_i4, + mp_swaptrirr - implements new flow-controlled and MPI_collective options, called + within mp_sendirr, mp_sendirr_i4, and mp_sendtrirr, respectively + + atm/cam/src/utils/spmd_utils.F90: + fc_gatherv, + fc_gathervr4, + fc_gathervint - flow-controlled gather algorithms, based on ALTGATHER code + formerly in control/wrap_mpi.F90 in the routines mpigatherv, + mpigathervr4, and mpigathervint, respectively. + + fc_gather_setopts - set fc_gather_flow_cntl, the maximum number of preposted + receive requests allowed in the flow-controlled gather algorithm. + fc_gather_defaultopts - return default value for fc_gather_flow_cntl (64) + + atm/cam/src/utils/repro_sum_mod.F90: + repro_sum_tol_exceeded - reports whether difference between fast reproducible + collective sum and fast nonreproducible collective sum + exceeds the specified tolerance. + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/bld/namelist_files: + namelist_definition.xml - registered new tuning parameters + + models/atm/cam/src/chemistry/utils: + tracer_data.F90 - included pio patch for ifort on atlas + + models/atm/cam/src/control: + binary_io.F90 - referenced renamed gather routines now included in spmd_utils.F90 + cam_history.F90 - referenced renamed gather routines now included in spmd_utils.F90 + hycoef.F90 - included pio patch for ifort on atlas + interpolate_data.F90 - fixed syntax + runtime_opts.F90 - included new tuning parameters + wrap_mpi.F90 - eliminated gather and altalltoallv routines (now relocated in + spmd_utils.F90). wrap_mpi.F90 is now just a wrapper for MPI calls. + + models/atm/cam/src/dynamics/eul: + realloc4.F90 - added reference to altalltoallv in spmd_utils module + realloc7.F90 - added reference to altalltoallv in spmd_utils module + scan2.F90 - added reference to altalltoallv in spmd_utils module + spmd_dyn.F90 - included FV-relevant performance options (for spmd_dyn.F90 consistency) + + models/atm/cam/src/dynamics/fv: + advect_tend.F90 - adopted new tracer array structure + benergy.F90 - adopted new tracer array structure + cd_core.F90 - generalized interface to mod_comm, provided option to call multiple + simultaneous transposes + d2a3dikj.F90 - incorporated summation modifications + diag_dynvar_ic.F90 - adopted new tracer array structure + diag_module.F90 - generalized interface to mod_comm + dp_coupling.F90 - adopted new tracer array structure, generalized interface to mod_comm, + fixed syntax + dryairm.F90 - adopted new tracer array structure + dyn_comp.F90 - adopted new tracer array structure, generalized interface to mod_comm, + provided option to call multiple simultaneous transposes + dynamics_vars.F90 - added performance parameters to FV datatype, adopted new tracer array + structure + fv_prints.F90 - incorporated summation modifications + geopk.F90 - generalized interface to mod_comm + inidat.F90 - adopted new tracer array structure, generalized interface to mod_comm + io_dist.F90 - generalized interface to mod_comm + mapz_module.F90 - adopted new tracer array structure + mean_module.F90 - incorporated summation modifications + p_d_adjust.F90 - adopted new tracer array structure, incorporated summation modifications + par_xsum.F90 - incorporated summation modifications + pfixer.F90 - generalized interface to mod_comm + restart_dynamics.F90 - adopted new tracer array structure, eliminated real*4 tracer option, + included pio patch for ifort on atlas + spmd_dyn.F90 - included new tuning parameters + stepon.F90 - adopted new tracer array structure + te_map.F90 - adopted new tracer array structure + trac2d.F90 - adopted new tracer array structure + + models/atm/cam/src/dynamics/homme: + spmd_dyn.F90 - included FV-relevant performance options (for spmd_dyn.F90 consistency) + + models/atm/cam/src/dynamics/sld: + realloc4.F90 - added reference to altalltoallv in spmd_utils module + realloc7.F90 - added reference to altalltoallv in spmd_utils module + scan2.F90 - added reference to altalltoallv in spmd_utils module + spmd_dyn.F90 - included FV-relevant performance options (for spmd_dyn.F90 consistency) + + models/atm/cam/src/physics/cam: + phys_buffer.F90 - included pio patch for ifort on atlas + phys_gmean.F90 - incorporated summation modifications + phys_grid.F90 - generalized interface to mod_comm + restart_physics.F90 - included pio patch for ifort on atlas + + models/atm/cam/src/utils: + repro_sum_mod.F90 - incorporated summation modifications + spmd_utils.F90 - incorporated gather and altalltoallv routines from wrap_mpi.F90; + introduced new flow-controlled gather routines; + modified swap software + time_manager.F90 - included pio patch for ifort on atlas + + models/utils/pilgrim: + debugutilitiesmodule.F90 - trivial change + decompmodule.F90 - trivial change + mod_comm.F90 - incorporated major communication options + parutilitiesmodule.F90 - generalized interface to mod_comm + pilgrim.F90 - trivial change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: ALL PASS + +bangkok/lf95: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_20 +Originator(s): eaton +Date: Wed Nov 26 14:18:10 MST 2008 +One-line Summary: Make RRTMG default; update default radiative forcings; + misc fixes + +Purpose of changes: + +. Make RRTMG the default radiation package. + +. Update the namelist defaults so that the "out of the box" configuration + uses the same forcings as the CCSM B_PRESENT_DAY cases. This includes + the solar constant, prescribed ozone, aerosols, and GHGs. + +. misc fixes and compiler workarounds + - Fix new logic in getfil to make PGI happy. + - Fix PIO namelist variable definition (iotype_name) + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. default values of forcings changed as described above + +List any changes to the defaults for the boundary datasets: + +. default values of forcings changed as described above + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/config_definition.xml +. set default value for "rad" to "rrtmg" + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. update defaults from 1990 to 2000 + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. fix pio namelist variable iotype_name + +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +. remove the solar constant. now build-namelist will use the value in + namelist_defaults_cam.xml. + +models/atm/cam/src/chemistry/mozart/tgcm_forcing.F90 +. change dimension of dimids from 3 to 4 in tgcm_init + +models/atm/cam/src/control/ioFileMod.F90 +. fix getfil logic (test on optional arg iflag) to make PGI happy + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. add :ncol bounds to array expression to make lf95/debug happy + +models/atm/cam/test/system/config_files/f10c3dm +. add -rad camrt to get at cam3.5 configuration + +models/atm/cam/test/system/nl_files/ghgrmp +. remove "doisccp=.true." + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 + +bangkok/lf95: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8t5mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +055 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +These baseline comparisons are expected to fail due to making RRTMG the +default radiation package, and due to new default radiative forcings + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: New climate due to changing the default + radiation and the default forcings. + +=============================================================== +=============================================================== + +Tag name: cam3_6_19 +Originator(s): eaton +Date: Mon Nov 17 18:51:53 MST 2008 +One-line Summary: CCSM/PIO build; BGP mods; getfil; extend build-namelist use_case + +Purpose of changes: + +. Modify CAM's configure so that when building the CAM component via the + CCSM build scripts, PIO is built as part of CAM. This is a temporary + hack! + +. Add standalone CAM build support for BGP. + +. Modify getfil so that the default is to abort when a requested file isn't + found. This makes it easier to detect this common error. + +. Extend the functionality of build-namelist so that use case + specifications can contain variables that are not namelist variables just + like the namelist_defaults_cam.xml file does. This is needed to support + building complex namelist values like those used by the chemistry code to + specify the emission datasets for multiple constituents. + +Bugs fixed (include bugzilla ID): + +. fix initialization problem in FV offline mode that was causing sm355 to + fail. + +Describe any changes made to build system: + +. modified as described above for CCSM builds. + +. support for BGP + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. Check the element names in the use case defaults file and if the name + isn't in the definition file then don't add the name to the namelist. +. The namelist defaults object corresponding to the use case needs to be + saved, and searched for default values before the base defaults file is + searched. Encapsulate this in a new routine, get_default_values. + +models/atm/cam/bld/configure +. add utils/pio to Filepath produced for ccsm build. +. add -D_NETCDF macro to the $cfg_cppdefs for a ccsm build. +. add -D_USEBOX to $cfg_cppdefs + +models/atm/cam/bld/Makefile.in +. remove -D_USEBOX + +models/atm/cam/bld/cam.cpl7.template +. remove old unicos code + +models/atm/cam/bld/config_sys_defaults.xml +. add bgp support (default is pure MPI) + +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +. remove tracer_cnst_file specifier which is inconsistent with the default + prescribed BAM aerosols. This was causing the failure of sm386. + +models/atm/cam/src/control/iofilemod.F90 +. change default behavior of getfil so that it aborts when requested file + can't be found. + +models/atm/cam/src/dynamics/fv/inidat.F90 +. initialize dyn_in%u3s and dyn_in%v3s to zero for FV offline mode + +models/atm/cam/src/physics/waccm/gw_drag.F90 +. use getfil before trying to open a file + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 5 + +This baseline is failing because the smoke test sm355 fails for cam3_6_18. + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_18 +Originator(s): aconley, eaton +Date: Mon Nov 3 18:57:32 MST 2008 +One-line Summary: RRTMG fixes and new cloud diagnostics + +Purpose of changes: + +. Update RRTMG external to + - Fixes bug in restart (some wrong intents) + - Fixes problem with minimal solar zenith angle for WACCM. + +. RRTMG diagnostics + - Cleanup of addfld calls + - Output aerosol masses as seen by radiation + +. Cloud diagnostics moved into a new module, cloud_diagnostics. This + module is currently only implemented for RRTMG. + +. Add capability to compute optical properties for volcanic aerosols. + +. Extend the rad_constituents interface to allow setting gas species mixing + ratios to zero. This is done by using the specifier 'Z' in the + appropriate namelist variable in place of 'P' or 'D'. + +. Bugfix in new ISCCP simulator. + +. Modify how radiation package is specified to configure. The -rrtmg + switch has been replaced by the argument -rad which takes either rrtmg or + camrt as values. The current default is camrt. + +. Update test_driver.sh to use pgi-7.2-5 on bangkok and calgary. + +Bugs fixed (include bugzilla ID): + +. fix an index problem in the new ISCCP simulator + +. change char*80 to 256 in filename declaration in mo_flbc.F90 + +Describe any changes made to build system: + +. remove -rrtmg switch from configure. replaced by -rad argument which + takes either rrtmg or camrt as values. The current default is camrt. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/rrtmg/param_cldoptics.F90 +. not used -- much of this moved to cloud_diagnostics + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/cloud_diagnostics.F90 +. stub function for so that cam can separate cloud physical diagnostics + from radiation diagnostics + +models/atm/cam/src/physics/rrtmg/cloud_diagnostics.F90 +. write cloud physical diagnostics (non-radiative diagnostics) to history + file. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. update RRTMG external to rrtmg_081029 + +models/atm/cam/bld/build-namelist +. fixes related to changing configuration parameter from rrtmg to rad +. add check for doisccp. use it to set doisccp_38 if rrtmg is rad pkg + +models/atm/cam/bld/config_definition.xml +. remove rrtmg and add generic rad + +models/atm/cam/bld/configure +. remove the -rrtmg flag and add a more full featured -rad arg + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. change rrtmg attribute of physprop files + +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +. add tracer_cnst_file setting so the use case doesn't break when the + defaults in namelist_defaults_cam.xml change. + +models/atm/cam/bld/perl5lib/Build/Namelist.pm +. fix code that limits the length of strings written to namelist output + files + +models/atm/cam/src/chemistry/mozart/mo_flbc.F90 +. change declaration of filename from char*80 to char*256 + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. add radiation hooks for volcanic aerosol. +. fix indexing for output of SW aerosol OD's. +. update names in code to match names in aerosol files (lw_ext renamed to lw_abs) + +models/atm/cam/src/physics/cam/icarus_scops_38.F90 +. fix indexing bug + +models/atm/cam/src/physics/cam/phys_prop.F90 +. add functionality for volcanics +. update names in code to match names in aerosol files (lw_ext renamed to lw_abs) + +models/atm/cam/src/physics/cam/physpkg.F90 +. add call for cloud_diagnostics_init +. remove call for param_cldoptics_init + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. specify masses that are not included in diagnostic radiation calls as + having zero mass path. +. add new props for volcanics to rad_cnst_get_clim_aer_props() + +models/atm/cam/src/physics/cam/radae.F90 +. make code robust for zero ozone concentrations (from Philip Cameron-Smith + and Dan Bergmann) + +models/atm/cam/src/physics/cam/radiation.F90 +. move param_cldoptics initialization into camrt radiation.F90, since it is + now a radiation utility + +models/atm/cam/src/physics/cam/tphysbc.F90 +. add call to cloud_diagnostics + +models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +. clean up diagnostic history tape calls +. remove unused pointers to CLD in physics buffer. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. remove obsolete "addfld" calls +. fix intent of fsds. Was intent(out), but should be intent(inout) since + it is only set on radiation timesteps. +. add calls to output aerosol masses as seen by radiation +. remove old isccp simulator -- can replace if we decide we really want to + run this with rrtmg. + +models/atm/cam/src/physics/rrtmg/radsw.F90 +. change solvar_interface names for waccm + +models/atm/cam/test/system/config_files/h16x4dm +models/atm/cam/test/system/config_files/h5x8adm +models/atm/cam/test/system/config_files/h5x8dm +models/atm/cam/test/system/config_files/h5x8idm +. add -hgrid values + +models/atm/cam/test/system/CAM_runcmnd.sh +. remove hpmcount from bluefire (left in by mistake on previous commit) + +models/atm/cam/test/system/test_driver.sh +. update to pgi-7.2-5 on bangkok and calgary +. return default queue on bluefire to regular + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +045 sm355 TSM.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 8 +046 er355 TER.sh fmo2dh off2x2.5 4+5s .............................FAIL! rc= 5 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 4 + +The smoke test for these tests fails in cam3_6_17. + +bangkok/lf95: All PASS except: + +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +There is a roundoff difference in these results. Not sure why. Validated +with a pergro test (need to set -microphys rk). + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, except roundoff for non-debug + production configurations under lf95. + +=============================================================== +=============================================================== + +Tag name: cam3_6_17 +Originator(s): Jim Edwards +Date: +One-line Summary: Refactor restart files from binary to netcdf using PIO + +Purpose of changes: Improved memory profile allow parallel IO for restart + in NetCDF format + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Added external PIO library + +Describe any changes made to the namelist: Added pio_ctl namelist + default allowed values + io_stride 1 1 - n + iotype_name 'netcdf' 'netcdf', 'pnetcdf' + pio_restart .false. + num_iotasks n 1 - n + where n is the total number of compute tasks + io_stride and num_iotasks control the number of tasks participating in IO, If only io_stride is set + num_iotasks will be adjusted automatically. + pio_restart can be used to turn off the pio facility and use the old binary restart. + If you find that you need to set this please let me know so that I can address the problem, we plan to make PIO + the only option in an upcoming release. + iotype_name allows a choice of netcdf or pnetcdf libraries - currently netcdf appears to perform better but + that may change depending on platform, decomposition and problem size. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/TSB.ccsm.sh + models/atm/cam/test/system/TCT.ccsm.sh + models/atm/cam/test/system/TBL.sh + models/atm/cam/test/system/TBR.sh + models/atm/cam/test/system/test_driver.sh + models/atm/cam/test/system/CAM_runcmnd.sh + models/atm/cam/test/system/TEQ.sh + removed bluevista, added firefly. updated files_to_compare so that only history files are listed. + models/atm/cam/test/system/nl_files/ghgrmp + models/atm/cam/test/system/nl_files/off2x2.5 + added pio_restart=.true. so that pio is tested with all dycores as part of precommit tests. + + models/atm/cam/test/system/nl_files/aqua + clean up of test namelist + models/atm/cam/test/system/input_tests_master + added a homme ideal phys test + + models/atm/cam/bld/configure + models/atm/cam/bld/namelist_files/namelist_definition.xml + models/atm/cam/bld/Makefile.in + added pio support + + models/atm/cam/src/control/rgrid.F90 + modified initialization so that default values are used instead of invalid values. + + models/atm/cam/src/physics/cam/physpkg.F90 + models/atm/cam/src/physics/cam/physics_types.F90 + added initialization of phys_state and tend data structures for improved error checking + + models/atm/cam/src/physics/cam/convect_shallow.F90 + changed cush declaration from a 3D variable (pverp) to a 2D. + + models/atm/cam/src/physics/cam/tphysac.F90 + added homme to dycores which need moist physics + + models/atm/cam/src/dynamics/eul/dyn_grid.F90 + new values in get_dyn_grid_parm for compatability + + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + models/atm/cam/src/dynamics/homme/external/edge_mod.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + models/atm/cam/src/dynamics/homme/inital.F90 + refactored model flow to better match other dycores. + + models/atm/cam/src/control/cam_restart.F90 + models/atm/cam/src/control/hycoef.F90 + models/atm/cam/src/control/cam_comp.F90 + models/atm/cam/src/utils/pio_utils.F90 + models/atm/cam/src/utils/time_manager.F90 + models/atm/cam/src/physics/cam/restart_physics.F90 + models/atm/cam/src/physics/cam/chemistry.F90 + models/atm/cam/src/physics/cam/buffer.F90 + models/atm/cam/src/physics/cam/phys_buffer.F90 + models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 + models/atm/cam/src/chemistry/utils/prescribed_aero.F90 + models/atm/cam/src/chemistry/utils/tracer_data.F90 + models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 + models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 + models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 + models/atm/cam/src/chemistry/mozart/chemistry.F90 + models/atm/cam/src/dynamics/sld/restart_dynamics.F90 + models/atm/cam/src/dynamics/eul/restart_dynamics.F90 + models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + models/atm/cam/src/dynamics/fv/metdata.F90 + added support for PIO restart method + + + SVN_EXTERNAL_DIRECTORIES + updated PIO tag + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests were done twice, once with each restart format. + +bluefire: All pass except + 058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL + Fails due to continuing dycore development. + +bangkok/lf95: All tests pass. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam3_6_16 +Originator(s): Francis Vitt +Date: +One-line Summary: Combine CAM-Chem and WACCM chemistry codes. + +Purpose of changes: Ease of chemistry code mantainance and + provide more flexability in the aerosol and gas phase chemistry + configurations. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + + Changes to configure: + + - new configure options : + -prog_species [SO4[,DST[,SSLT[,OC[,BC[,GHG[,CARBON16]]]]]]] + Configure will generate a preprocessor input file + for any combination of these predefined prognostics + aerosol and ghg packages. + -edit_chem_mech + This allows the user to edit the mechanism file before + it is processed. Default editor is vi. The user can + specify another editor via the CAMCHEM_EDITOR environment + variable. + -usr_mech_infile $mechanism_file + This allows the user to specify a preprocessor input file. + + - configure invokes the chemstry preprocessor to generate chemistry + solver code + + - predefined chemistry options: + -chem trop_mozart | trop_ghg | trop_aero | waccm_mozart | waccm_ghg + + - when configured with the option -chem trop_mozart | waccm_mozart + the preprocessor will use a predefined "standard" preprocessor input file + + - when configured with the option -chem trop_ghg | trop_aero | waccm_ghg + or with the -prog_species SO4 | DST | SSLT | OC | BC | GHG | CARBON16 + a preprocessor input file is created + + New features: + + - The ability to specify short-lived chemical tracers which will + not be transported. These species are specified via a "ShortLived" + species designation in the preprocessor input file. + + - The ability to skip solving the chemical equations some time + steps. The chemical equation are solved each time step by + default. This can be changed via the chem_freq namelist variable. + + - The prescribed mozart ozone and aerosols for the radiation can now be used + with any chemistry configuration (and without any chemistry). + +Describe any changes made to the namelist: + + Chemistry options are now read from "chem_inparm" namelist in atm_in. + + Pass "chem_rad_passive = .true." to build-namelist to set the rad_climate variable + so that the chemical tracers are radiatively passive. + + emis_date --> srf_emis_date + emis_type --> srf_emis_type + + WACCM + now uses srf_emis_specifier as with CAM-chem + + lbc_file --> flbc_file + lbc_fixed_date --> flbc_date + lbc_senario --> flbc_type + + sad_fixed_date --> sad_date + sad_scenario --> sad_type + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/trop_mozart +D models/atm/cam/src/chemistry/trop_mozart_aero +D models/atm/cam/src/chemistry/waccm_mozart +D models/atm/cam/src/chemistry/trop_mozart_prescribed_aero +D models/atm/cam/src/chemistry/trop_mozart_ghg_paero + The source code in these directories are combined. The preprocessor + generated code is now generated by configure via the the chemistry + preprocessor. + +D models/atm/cam/bld/config_defaults_trop_mozart_aero.xml +D models/atm/cam/bld/config_defaults_trop_mozart_prescribed_aero.xml +D models/atm/cam/bld/config_defaults_trop_mozart_ghg_paero.xml + The -chem options trop_mozart_aero, trop_mozart_prescribed_aero, and + trop_mozart_ghg_paero were removed. + +D models/atm/cam/src/physics/waccm/iondrag.F90 +D models/atm/cam/src/physics/waccm/chemistry.F90 +D models/atm/cam/src/physics/waccm/mo_solar_parms.F90 +D models/atm/cam/src/physics/waccm/mo_msis_ubc.F90 +D models/atm/cam/src/physics/waccm/upper_bc.F90 +D models/atm/cam/src/physics/waccm/msise00.F90 +D models/atm/cam/src/physics/waccm/tgcm_forcing.F90 + These were moved to the shared chemistry directory. + +List all subroutines added and what they do: + +A models/atm/cam/bld/config_defaults_trop_aero.xml +A models/atm/cam/bld/config_defaults_trop_ghg.xml + Files added for the new -chem options "trop_aero" and "trop_ghg". + +A models/atm/cam/bld/chem_preprocess.pl + Perl file added to invoke the chemistry preprocessor. + +A models/atm/cam/bld/namelist_files/use_cases/waccm_refb1.xml +A models/atm/cam/bld/namelist_files/use_cases/1990_prog_aero.xml + WACCM use cases added for the build-namelist util. + +A models/atm/cam/src/physics/waccm/gravity_waves_sources.F90 + new WACCM gravity wave drag code. + +A models/atm/cam/src/chemistry/utils/mo_constants.F90 +A models/atm/cam/src/chemistry/utils/prescribed_ghg.F90 +A models/atm/cam/src/chemistry/utils/mo_util.F90 +A models/atm/cam/src/chemistry/utils/prescribed_aero.F90 +A models/atm/cam/src/chemistry/utils/tracer_data.F90 +A models/atm/cam/src/chemistry/utils/prescribed_ozone.F90 +A models/atm/cam/src/chemistry/utils/mo_solar_parms.F90 +A models/atm/cam/src/chemistry/utils/mo_regrider.F90 +A models/atm/cam/src/chemistry/utils/time_utils.F90 +A models/atm/cam/src/chemistry/utils/mo_msis_ubc.F90 +A models/atm/cam/src/chemistry/utils/msise00.F90 +A models/atm/cam/src/chemistry/utils +A models/atm/cam/src/chemistry/mozart/mo_aero_settling.F90 +A models/atm/cam/src/chemistry/mozart/mo_ghg_chem.F90 +A models/atm/cam/src/chemistry/mozart/mo_wavelen.F90 +A models/atm/cam/src/chemistry/mozart/mo_mean_mass.F90 +A models/atm/cam/src/chemistry/mozart/mo_airglow.F90 +A models/atm/cam/src/chemistry/mozart/mo_jlong.F90 +A models/atm/cam/src/chemistry/mozart/mo_setext.F90 +A models/atm/cam/src/chemistry/mozart/mo_airmas.F90 +A models/atm/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +A models/atm/cam/src/chemistry/mozart/charge_neutrality.F90 +A models/atm/cam/src/chemistry/mozart/mo_photoin.F90 +A models/atm/cam/src/chemistry/mozart/mo_setaer.F90 +A models/atm/cam/src/chemistry/mozart/mo_lightning.F90 +A models/atm/cam/src/chemistry/mozart/mo_tgcm_ubc.F90 +A models/atm/cam/src/chemistry/mozart/mo_trislv.F90 +A models/atm/cam/src/chemistry/mozart/spedata.F90 +A models/atm/cam/src/chemistry/mozart/mo_setair.F90 +A models/atm/cam/src/chemistry/mozart/mo_tracname.F90 +A models/atm/cam/src/chemistry/mozart/mo_waveall.F90 +A models/atm/cam/src/chemistry/mozart/mo_seto2.F90 +A models/atm/cam/src/chemistry/mozart/clybry_fam.F90 +A models/atm/cam/src/chemistry/mozart/solar_photons.F90 +A models/atm/cam/src/chemistry/mozart/mo_tropopause.F90 +A models/atm/cam/src/chemistry/mozart/mo_schu.F90 +A models/atm/cam/src/chemistry/mozart/mo_rtlink.F90 +A models/atm/cam/src/chemistry/mozart/upper_bc.F90 +A models/atm/cam/src/chemistry/mozart/mo_flbc.F90 +A models/atm/cam/src/chemistry/mozart/wei96.F90 +A models/atm/cam/src/chemistry/mozart/mo_jshort.F90 +A models/atm/cam/src/chemistry/mozart/mo_exp_sol.F90 +A models/atm/cam/src/chemistry/mozart/mo_sulf.F90 +A models/atm/cam/src/chemistry/mozart/mo_cph.F90 +A models/atm/cam/src/chemistry/mozart/mo_strato_rates.F90 +A models/atm/cam/src/chemistry/mozart/mo_chemini.F90 +A models/atm/cam/src/chemistry/mozart/tracer_cnst.F90 +A models/atm/cam/src/chemistry/mozart/mo_chm_diags.F90 +A models/atm/cam/src/chemistry/mozart/tracer_srcs.F90 +A models/atm/cam/src/chemistry/mozart/mo_lymana.F90 +A models/atm/cam/src/chemistry/mozart/set_cp.F90 +A models/atm/cam/src/chemistry/mozart/mo_setz.F90 +A models/atm/cam/src/chemistry/mozart/mo_calcoe.F90 +A models/atm/cam/src/chemistry/mozart/mo_aerosols.F90 +A models/atm/cam/src/chemistry/mozart/mo_zadj.F90 +A models/atm/cam/src/chemistry/mozart/mo_aurora.F90 +A models/atm/cam/src/chemistry/mozart/mo_airplane.F90 +A models/atm/cam/src/chemistry/mozart/mo_extfrc.F90 +A models/atm/cam/src/chemistry/mozart/solvar_interface.F90 +A models/atm/cam/src/chemistry/mozart/mo_pchem.F90 +A models/atm/cam/src/chemistry/mozart/mo_ps2str.F90 +A models/atm/cam/src/chemistry/mozart/mo_apex.F90 +A models/atm/cam/src/chemistry/mozart/mo_heatnirco2.F90 +A models/atm/cam/src/chemistry/mozart/woods.F90 +A models/atm/cam/src/chemistry/mozart/mo_fstrat.F90 +A models/atm/cam/src/chemistry/mozart/mo_sphers.F90 +A models/atm/cam/src/chemistry/mozart/mo_snoe.F90 +A models/atm/cam/src/chemistry/mozart/mo_sad.F90 +A models/atm/cam/src/chemistry/mozart/mo_setinv.F90 +A models/atm/cam/src/chemistry/mozart/euvac.F90 +A models/atm/cam/src/chemistry/mozart/chemistry.F90 +A models/atm/cam/src/chemistry/mozart/mo_setozo.F90 +A models/atm/cam/src/chemistry/mozart/m_types.F90 +A models/atm/cam/src/chemistry/mozart/solvar_woods.F90 +A models/atm/cam/src/chemistry/mozart/mo_drydep.F90 +A models/atm/cam/src/chemistry/mozart/iondrag.F90 +A models/atm/cam/src/chemistry/mozart/mo_photo.F90 +A models/atm/cam/src/chemistry/mozart/mo_sethet.F90 +A models/atm/cam/src/chemistry/mozart/efield.F90 +A models/atm/cam/src/chemistry/mozart/mo_setsoa.F90 +A models/atm/cam/src/chemistry/mozart/apex_subs.F90 +A models/atm/cam/src/chemistry/mozart/mz_aerosols_intr.F90 +A models/atm/cam/src/chemistry/mozart/mo_waccm_hrates.F90 +A models/atm/cam/src/chemistry/mozart/mo_mass_xforms.F90 +A models/atm/cam/src/chemistry/mozart/mo_tuv_inti.F90 +A models/atm/cam/src/chemistry/mozart/short_lived_species.F90 +A models/atm/cam/src/chemistry/mozart/mo_strato_sad.F90 +A models/atm/cam/src/chemistry/mozart/mo_waveo3.F90 +A models/atm/cam/src/chemistry/mozart/solvar_data.F90 +A models/atm/cam/src/chemistry/mozart/neckel.F90 +A models/atm/cam/src/chemistry/mozart/tgcm_forcing.F90 +A models/atm/cam/src/chemistry/mozart/mo_usrrxt.F90 +A models/atm/cam/src/chemistry/mozart/mo_jeuv.F90 +A models/atm/cam/src/chemistry/mozart/mag_parms.F90 +A models/atm/cam/src/chemistry/mozart/spehox.F90 +A models/atm/cam/src/chemistry/mozart/exbdrift.F90 +A models/atm/cam/src/chemistry/mozart/mo_setcld.F90 +A models/atm/cam/src/chemistry/mozart/mo_xsections.F90 +A models/atm/cam/src/chemistry/mozart/mo_inter.F90 +A models/atm/cam/src/chemistry/mozart/m_sad_data.F90 +A models/atm/cam/src/chemistry/mozart/mo_drydep_tables.F90 +A models/atm/cam/src/chemistry/mozart/mo_wavelab.F90 +A models/atm/cam/src/chemistry/mozart/mo_solarproton.F90 +A models/atm/cam/src/chemistry/mozart/mo_negtrc.F90 +A models/atm/cam/src/chemistry/mozart/mo_synoz.F90 +A models/atm/cam/src/chemistry/mozart/mo_params.F90 +A models/atm/cam/src/chemistry/mozart/mo_chem_utls.F90 +A models/atm/cam/src/chemistry/mozart/mo_srf_emissions.F90 +A models/atm/cam/src/chemistry/mozart/sv_decomp.F90 +A models/atm/cam/src/chemistry/mozart/mo_setsox.F90 +A models/atm/cam/src/chemistry/mozart/mo_jpl.F90 +A models/atm/cam/src/chemistry/mozart + trop_mozart and waccm_mozart source code directories combined + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_defaults_waccm_ghg.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_definition.xml + Implement new chem configure options and invoke chem preprocessor. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml + Chem namelist cleanup. + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1950_ramped.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smax.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1953_ramped_qbo.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1995_climo.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smin.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smax.xml +M models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smin.xml +M models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +M models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml + Modified for namelist variables cleanup. + + +M models/atm/cam/src/control/runtime_opts.F90 + Chem namelist cleanup. + +M models/atm/cam/src/physics/cam/initindx.F90 + Prescribed aerosols and ozone independent of chemistry. + WACCM gravity wave drag. + +M models/atm/cam/src/physics/cam/trb_mtn_stress.F90 + WACCM change + +M models/atm/cam/src/physics/cam/radiation.F90 + Make restarts bit-for-bit regardless of number of steps in initial run. + +M models/atm/cam/src/physics/cam/tphysac.F90 +M models/atm/cam/src/physics/cam/tphysbc.F90 + Cleanup. Change for short-lived waccm tracers. + +M models/atm/cam/src/physics/cam/phys_prop.F90 + Change in error message string. + +M models/atm/cam/src/physics/cam/advnce.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 + Changes for prescribed rad tracers independent of chem. + +MM models/atm/cam/src/physics/cam/chem_surfvals.F90 + Remove lbc* (old waccm) namelist variables. + + +M models/atm/cam/src/physics/cam/physpkg.F90 + Change for short-lived chem tracers. + Init prescribed rad tracer modules. + +M models/atm/cam/src/physics/cam/pkg_cld_sediment.F90 + WACCM adjustment + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/convect_deep.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 + Changes for new waccm gravity wave drag. + +M models/atm/cam/src/physics/cam/chemistry.F90 + Change in namelist variable interface --> read "chem_parm" namelist. + +M models/atm/cam/src/physics/waccm/radheat.F90 + Change for waccm lower upper boundary (without ions) + +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 + Changes for offline waccm (minor cleanup). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: + +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 + Sharing chemistry code changes answers for these configurations + WACCM default aerosols for radiation are now the mozart prescribed aerosols + +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 + Water vapor production from methane oxidation is now included + +057 er731 TER.sh h16x4dm aqua 4+5s ................................FAIL! rc= 10 + This also failed in cam3_6_15 + +bangkok/lf95: + +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 + This is expected to fail due to change in waccm_ghg implementation -- + now uses the mozart chemical equation solver. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: trop_mozart and waccm_mozart codes are combined +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_15 +Originator(s): eaton, aconley +Date: Sun Oct 12 16:31:36 MDT 2008 +One-line Summary: RRTMG uses 3D CO2 and O2 fields. Update externals for + consistency with CCSM tags. + +Purpose of changes: + +. Modify RRTMG to accept 3D fields of CO2 and O2. + +. Remove output of the vertically integrated cloud diagnostics from RRTMG + since those diagnostics aren't available. + +. Fix logic so new ISCCP simulator is available for use with RRTMG. + +. update driver code to drv/seq_mct/trunk_tags/drvseq2_0_33 + +. update cice code to cice/branch_tags/cice4_0_20080930b_brnchT_20081008 + +. update csm_share code to csm_share/trunk_tags/share3_081009 + - this includes larger than roundoff changes to the surface fluxes + resulting from a bug fix introduce at share3_080811 + +. update the scripts code to scripts/trunk_tags/scripts4_081009 + +. Move the external definition for the RRTMG code into a new file, + models/atm/cam/SVN_EXTERNAL_DIRECTORIES. This was done to avoid the need + for separate external definition for RRTMG in the CCSM tags. The tag + used for the CAM src will now automatically include the RRTMG external. + +Bugs fixed (include bugzilla ID): described above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +. 1/2 and 1/4 degree versions of fatmlndfrc changed to use gx1v5 + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/SVN_EXTERNAL_DIRECTORIES +. add external for RRTMG + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update driver, cice, csm_share, and scripts externals. +. remove external for RRTMG + +models/atm/cam/bld/configure +. make commandline arg values of dynamics/physics/chemistry options case insensitive +. add check that RRTMG radiation only be turned on with MG microphysics. +. update CPP defines needed for new CICE tag + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add gx1v5 versions of fatmlndfrc files for 1/2 and 1/4 degree FV grids + +models/atm/cam/bld/perl5lib/Build/Config.pm +models/atm/cam/bld/perl5lib/Build/Namelist.pm +models/atm/cam/bld/perl5lib/Build/NamelistDefaults.pm +models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm +. mods to make the interfaces case insensitive with respect to the namelist + variable names. +. add some checking that the types of supplied namelist variable values + match the types declared in the definition file. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +models/atm/cam/src/physics/rrtmg/radlw.F90 +models/atm/cam/src/physics/rrtmg/radsw.F90 +. mods to pass 3D fields of O2 and CO2 into RRTMG + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 +057 er731 TER.sh h16x4dm aqua 4+5s ................................FAIL! rc= 10 +058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL! rc= 7 + +bangkok/lf95: All PASS except: + +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8t5mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +055 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +. All baseline tests except for adiabatic and ideal physics fail as + expected due to bugfix in csm_share code +. Test er731 is an unexpected failure which will be resolved in a future + tag. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: There are larger than roundoff changes + due to a bugfix in the surface fluxes that was incorporated via updating + the csm_share external. + +=============================================================== +=============================================================== + +Tag name: cam3_6_14 +Originator(s): mvertens +Date: Sun Sep 28 20:15:13 MDT 2008 +One-line Summary: changes to cam.cpl7.template and camdom.cpl7.template for new scripts build + +Purpose of changes: Bug fixes to cam.cpl7.template and camdom.cpl7.template to get it + to work correctly with new build + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none (does not apply to cam build yet) + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M bld/camdom.cpl7.template +M bld/cam.cpl7.template + bug fixes to the way gmake is invoked for the new build + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: no testing since cam build/makefile was not touched + +bangkok/lf95: no testing since cam build/makefile was not touched + +Summarize any changes to answers: bfb in the cam build + +=============================================================== + +Tag name: cam3_6_13 +Originator(s): aconley, eaton +Date: Thu Sep 25 18:42:12 MDT 2008 +One-line Summary: new cloud optics for RRTMG + +Purpose of changes: + +. Add new cloud optics for RRTMG. + + - Note 1: This code has been added to the trunk to provide early + access for developers. However, the port of the code from the Andrew's + branch to the trunk has not yet been scientifically validated. + + - Note 2: The RRTMG code is not yet the default. It is enabled by + specifying -rrtmg on the configure commandline. When this is done, the + default for the cloud optics is set to be the mitchell ice cloud optics + and the conley liquid cloud optics. There is currently a capability to + switch the cloud optics back to CAM3 versions by setting the namelist + variables liqcldoptics='slingo' and icecldoptics='ebertcurry'. + + - Note 3: There is still alot of work to be done to clean up the new + cloud optics code. But exactly what needs to be done will depend on + whether both the new and old cloud optics schemes need to be available + for use with RRTMG. The old optics will remain available for use in a + CAM3 backwards compatibility mode in any case. + +. Add new version (3.8) of the ISCCP cloud simulator. This version only + works with RRTMG. The old cloud simulator is maintained to work with + CAMRT. + +Bugs fixed (include bugzilla ID): + +. Some bug fixes in cam.cpl7.template needed for CCSM builds + - fix the logic for the CAM_CHEM variable so that setting CAM_CHEM='none' + results in setting the arg "-chem none" for configure. + - remove the override that forced CAM to always be built with threading on. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add the following variables for cloud optics: + + - liqcldoptics type="char*32" valid_values="slingo,conley" + filepath and name for ice optics data for rrtmg + + - icecldoptics type="char*32" valid_values="ebertcurry,mitchell" + filepath and name for ice optics data for rrtmg + + - iceopticsfile type="char*256" + filepath and name for ice optics data for rrtmg + + - liqopticsfile type="char*256" + filepath and name for liquid cloud (gamma distributed) optics data for + rrtmg + +. Add new variable, doisccp_38, to turn on the new version of the isccp + cloud simulator. This is a logical variable and is false by default. + +List any changes to the defaults for the boundary datasets: + +. New physprop files from Steve Ghan. New variables have been added to the + new set of files (*_c080918.nc), and all the existing variables have the + same values as in the previous set of files (*_c080819.nc). + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/cloud_rad_props.F90 +. this is currently stub code + +models/atm/cam/src/physics/cam/cloudsimulator_38.F90 +models/atm/cam/src/physics/cam/icarus_scops_38.F90 +. new version (3.8) of the ISCCP cloud simulator + +models/atm/cam/src/physics/rrtmg/cloud_rad_props.F90 +models/atm/cam/src/physics/rrtmg/ebert_curry.F90 +models/atm/cam/src/physics/rrtmg/oldcloud.F90 +models/atm/cam/src/physics/rrtmg/param_cldoptics.F90 +models/atm/cam/src/physics/rrtmg/slingo.F90 +. code and interfaces to allow switching between new and old cloud optics + for RRTMG only. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add defaults for new cloud optics variables when running with rrtmg. +. modify the filepaths produced for the -inputdata option to retain leading + shell variables (e.g., $DIN_LOC_ROOT). + +models/atm/cam/bld/cam.cpl7.template +. fix the logic for the CAM_CHEM variable so that setting CAM_CHEM='none' + results in setting the arg "-chem none" for configure. +. remove the override that forced CAM to always be built with threading on. +. mods for using unified Makefile and Macros files for CCSM build. + +models/atm/cam/bld/configure +. create stub versions of the misc.h and preproc.h files which are still + reference by CLM code, but not used. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. new physprop files +. add defaults for new cloud optics variables. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. new namelist variables oldcldoptics, liqcldoptics, icecldoptics, + iceopticsfile, liqopticsfile, doisccp_38 +. update the documentation for the input_pathname attribute, and remove the + attribute from the variables used to specify the restart files used for + branch runs. + +models/atm/cam/src/control/runtime_opts.F90 +. add doisccp_38 + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. change idxvis to idx_sw_diag + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. add new diagnostic fields + +models/atm/cam/src/physics/cam/phys_prop.F90 +. change idxVIS to idx_sw_diag + +models/atm/cam/src/physics/cam/physpkg.F90 +. add call to cloud_rad_props_init +. remove init for cloudsimulator + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. add public data for ice/liq optics files? + +models/atm/cam/src/physics/cam/radconstants.F90 +. wavelength band indices for diagnostic fields + +models/atm/cam/src/physics/cam/radiation.F90 +. add initialization of cloud simulator to radiation_init + +models/atm/cam/src/physics/cam/stratiform.F90 +. add microphysics fields to pbuf +. Change limiters on in-cloud ice and liquid mixing ratios. These fields + are only set by MG microphysics. They are used in the new cloud optics + routines, which means the new cloud optics won't work with RK + microphysics. + +models/atm/cam/src/physics/rrtmg/radconstants.F90 +. add wavelength band indexes for diagnostic fields + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. mods for diagnostic calcs +. mods for cloud simulator. +. call cloudsimulator_init from radiation_init +. add diagnostic calc specific versions of output fields +. mods for cloud optics +. remove cicewp, cliqwp, rei, and rel from the args passed to + rad_rrtmg_{sw,lw}. +. add cloud optics fields as input args to the RT calls +. remove old cloud cover diagnostics that aren't consistent with mcica. + +models/atm/cam/src/physics/rrtmg/radlw.F90 +. change dummy arg from cldtau to tauc_lw which has a + wavelength dependence (nbndlw). Previously tauc_lw was a local var. +. remove input dummy args E_cicewp, E_cliqwp, E_rei, E_rel. CAM is no + longer providing these fields as input + +models/atm/cam/src/physics/rrtmg/radsw.F90 +. get idx_sw_diag from radconstants +. add args for cld optics to rad_rrtmg_sw +. remove input dummy args E_cicewp, E_cliqwp, E_rei, E_rel. CAM is no + longer providing these fields as input +. code for different versions of cloud optics -- maintain it all for now +. Remove public subroutine radsw_cldoptics (original implementation of old + cloud optics for rrtmg) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Note that there are currently no +regression tests for RRTMG. The answers with RRTMG have changed due to new +cloud optics. + +=============================================================== +=============================================================== + +Tag name: cam3_6_12 +Originator(s): Jim Edwards +Date: 9-23-08 +One-line Summary: Update of Homme dycore, code cleanup to prepare for IO changes + +Purpose of changes: Remove access to module pmgrid variables plat and plon and + require access through the dyn_grid module. + +Bugs fixed (include bugzilla ID): Fixed a bug in boundary data, this bug + manafest in the homme dycore only. + +Describe any changes made to build system: Removed macros DYN_STATE_INTERFACE + and LSMLON, LSMLAT (except for the scam build) from configure. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + models/atm/cam/src/dynamics/homme/external/flops_mod.F90 + models/atm/cam/src/dynamics/homme/external/forcing_mod.F90 + models/atm/cam/src/dynamics/homme/external/surfaces_mod.F90 + models/atm/cam/src/dynamics/homme/external/baroclinic_inst_mod.F90 + models/atm/cam/src/dynamics/homme/external/checksum_mod.F90 + models/atm/cam/src/dynamics/homme/external/timer_mod.F90 + + Homme code not used in cam interface. + + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + models/atm/cam/test/system/config_files/h16x4dm + removed reference to lapack lib - this is handled in configure + models/atm/cam/bld/configure + removed obsolete macros DYN_STATE_INTERFACE and LSMLON, LSMLAT + (except for scam case) + models/atm/cam/bld/Makefile.in + added LAPACK libs to Linux build (needed for homme) + added NO_MPI2 macro to Linux build (needed for PIO) + models/atm/cam/src/control/startup_initialconds.F90 + models/atm/cam/src/control/cam_restart.F90 + models/atm/cam/src/control/cam_comp.F90 + Removed DYN_STATE_INTERFACE clauses + models/atm/cam/src/physics/cam/boundarydata.F90 + Fixed a bug in interpolation code used for homme dycore only + models/atm/cam/src/physics/cam/progseasalts_intr.F90 + models/atm/cam/src/physics/cam/acbnd.F90 + models/atm/cam/src/physics/cam/carbon_intr.F90 + models/atm/cam/src/physics/cam/spmd_phys.F90 + models/atm/cam/src/physics/cam/sulfur_intr.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_flbc.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_aerosols.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_extfrc.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_regrider.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_fstrat.F90 + models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_photo.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_seasalt.F90 + models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_synoz.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 + Removed reference to pmgrid module variables plon and plat and + replaced with calls to get_dyn_grid_parm + models/atm/cam/src/dynamics/sld/pmgrid.F90 + models/atm/cam/src/dynamics/sld/inidat.F90 + models/atm/cam/src/dynamics/sld/dyn_comp.F90 + models/atm/cam/src/dynamics/sld/inital.F90 + models/atm/cam/src/dynamics/sld/stepon.F90 + models/atm/cam/src/dynamics/sld/restart_dynamics.F90 + models/atm/cam/src/dynamics/eul/inidat.F90 + models/atm/cam/src/dynamics/eul/dyn_comp.F90 + models/atm/cam/src/dynamics/eul/inital.F90 + models/atm/cam/src/dynamics/eul/stepon.F90 + models/atm/cam/src/dynamics/eul/restart_dynamics.F90 + Added empty dyn state structure so that dyn interface + matchs homme and fv and DYN_STATE_INTERFACE macro could + be removed + models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 + models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 + models/atm/cam/src/dynamics/homme/external/reduction_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 + models/atm/cam/src/dynamics/homme/external/control_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 + models/atm/cam/src/dynamics/homme/external/element_mod.F90 + models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + models/atm/cam/src/dynamics/homme/external/time_mod.F90 + models/atm/cam/src/dynamics/homme/external/hybvcoord_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 + models/atm/cam/src/dynamics/homme/external/edge_mod.F90 + models/atm/cam/src/dynamics/homme/external/dof_mod.F90 + models/atm/cam/src/dynamics/homme/external/physical_constants.F90 + models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 + models/atm/cam/src/dynamics/homme/external/bndry_mod.F90 + Ported to lf95 compiler and merged development from homme. + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + Ported to lf95 compiler + SVN_EXTERNAL_DIRECTORIES + Updated mct, drv, and scripts tags. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except + 058 bl731 TBL.sh h16x4dm aqua 9s ..................................FAIL + expected failure due to homme dycore updates. + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_6_11 +Originator(s): eaton, fvitt +Date: Thu Sep 18 14:27:10 MDT 2008 +One-line Summary: wet deposition bug fix + +Purpose of changes: + +. This bug fix removes the double counting of snow in both the total + precipitation and total evaporation fields that were being passed to the + gas phase chemistry and used in wet deposition. + +Bugs fixed (include bugzilla ID): + +. described above + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +. use physics buffer fields NEVAPR instead of TOTEVAPR, and PRAIN instead + of TOTPRECP as actual args passed through the gas_phase_chemdr interface. + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. fix the comments for prain and nevapr to indicate that they are totals of + rain + snow. + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove the fields TOTEVAPR (nevapr+evapsnow) and TOTPRECP + (prain+prodsnow) from the physics buffer. These fields were double + counting the contribution from snow since it is already included in the + prain and nevapr fields returned by subroutines pcond and mmicro_pcond. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 + +These baselines fail because answers for both full chemistry and prognostic +aerosol codes have changed as a result of the wet deposition change. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for runs with full chemistry +(-chem trop_mozart) or prognostic aerosols (-chem trop_mozart_aero). + +=============================================================== +=============================================================== + +Tag name: cam3_6_10 +Originator(s): eaton +Date: Fri Sep 12 12:34:59 MDT 2008 +One-line Summary: build-namelist fix and update driver + +Purpose of changes: + +. build-namelist was modified to properly produce the list of input + datasets when the root directory has been specified as an environment + variable reference, e.g., "-csmdata \$DIN_LOC_ROOT". This is a + requirement for how the CCSM scripts invoke build-namelist. + +. Update to new driver code. The new driver contains a workaround for the + performance problem being encountered on bluefire when running more than + 1 thread per task. Driver updated to drvseq2_0_27. + +. pathf90 section of Makefile modified to turn off optimization for the 2 + RRTMG modules that take excess amounts of time to compile (or won't + compile at all). + +Bugs fixed (include bugzilla ID): + +. build-namelist (described above) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none known + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update driver external to drvseq2_0_27 + +models/atm/cam/bld/config_definition.xml +. change valid value of lnd from clm2 to clm + +models/atm/cam/bld/build-namelist +. modify so that the namelist files for the driver, CLM, and CICE are only + written out for CAM standalone scripts. +. modify so that the list of inputdata file produced has the root directory + properly stripped, even when it's in the form of an environment variable + as is the case when the CCSM scripts invoke build-namelist. + +models/atm/cam/bld/Makefile.in +. modify to remove optimization from build of rrtmg_sw_k_g.f90 and + rrtmg_lw_k_g.f90 when using pathf90. + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add new namelist variables to seq_infodata_inparm group. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 + +bangkok/lf95: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8t5mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +The baseline test failures are due to roundoff level differences in the +driver code. Many of the baseline tests pass either because the +configuration doesn't involve surface interactions (e.g., adiabatic, ideal +physics, aqua-planet), or due to some unknown coincidence all the FV +1.9x2.5 tests are passing. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_6_07 + +Summarize any changes to answers: BFB or roundoff. The roundoff +differences were verified by looking at the differences in the cprnc output +for all fields at each timestep for a short run. The normal perturbation +growth test isn't applicable because it uses aquaplanet mode which is BFB. + +=============================================================== +=============================================================== + +Tag name: cam3_6_09 +Originator(s): Jim Edwards, Mark Taylor (HOMME dycore), Pat Worley (phys_grid.F90) +Date: 09-04-2008 +One-line Summary: Update of HOMME dynamic core + +Purpose of changes: Update of HOMME dynamic core + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: modified to allow HOMME dycore restart using PIO + +Describe any changes made to the namelist: added pio_ctl namelist + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + + - models/atm/cam/test/system/config_files/h16x4dm + - models/atm/cam/test/system/nl_files/aqua + These were added in support of new homme aquaplanet test 731 + +A + - models/atm/cam/src/utils/pio_utils.F90 + Added to support HOMME dycore restart, also added a new external + utils/pio which is currently only compiled for the HOMME dycore. + +List all existing files that have been modified, and describe the changes: + models/ocn/dom/ocn_comp_mct.F90 + models/ice/csim4/ice_comp_mct.F90 + models/atm/cam/src/control/atm_comp_mct.F90 + models/atm/cam/src/physics/cam/phys_gmean.F90 + I made the phys_grid variable nlcols private and provided a method to copy it. + + models/atm/cam/test/system/tests_pretag_bluefire + Removed the 711 tests and added the 731 tests + + models/atm/cam/test/system/config_files/h5x8adm + Added path to pnetcdf on bluefire + + models/atm/cam/test/system/TER.sh + Revised pattern for cprnc tests so that netcdf restart files are not included. + Improved error message for cice namelist + + models/atm/cam/test/system/input_tests_master + Added tests for HOMME dycore aquaplanet configuration + + models/atm/cam/test/system/TSM.sh + Improved error message for cice namelist + + models/atm/cam/bld/config_defaults_homme.xml + Added support for ne=16 np=4 (~2 degree) HOMME dycore resolution + + models/atm/cam/bld/configure + models/atm/cam/bld/Makefile.in + models/atm/cam/bld/config_horiz_grid.xml + models/atm/cam/bld/config_definition.xml + Added support for building PIO and pnetcdf + + models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + models/atm/cam/bld/namelist_files/namelist_definition.xml + models/atm/cam/bld/build-namelist + Added support for pio_ctl namelist, changed some HOMME dycore defaults + + models/atm/cam/src/control/cam_restart.F90 + models/atm/cam/src/control/cam_comp.F90 + Added support for PIO based restart in HOMME dycore + + + models/atm/cam/src/utils/spmd_utils.F90 + Added method to export mpicom from this module + + models/atm/cam/src/physics/cam/boundarydata.F90 + Bug fix, this bug was exposed by the HOMME dycore only. + + models/atm/cam/src/physics/cam/physics_types.F90 + Changed a test to add homme to the list of dycores who do not need this subroutine + + models/atm/cam/src/physics/cam/phys_grid.F90 + Made nlcols private and provided a method to retreve it's value. + Changed init method to make it more efficient for 1d horizontal grids. + + models/atm/cam/src/dynamics/homme/pmgrid.F90 + models/atm/cam/src/dynamics/homme/dycore.F90 + models/atm/cam/src/dynamics/homme/external/filter_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 + models/atm/cam/src/dynamics/homme/external/cg_mod.F90 + models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 + models/atm/cam/src/dynamics/homme/external/derivative_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_si_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 + models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 + models/atm/cam/src/dynamics/homme/external/quadrature_mod.F90 + models/atm/cam/src/dynamics/homme/external/cube_mod.F90 + models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 + models/atm/cam/src/dynamics/homme/external/control_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 + models/atm/cam/src/dynamics/homme/external/linear_algebra_mod.F90 + models/atm/cam/src/dynamics/homme/external/element_mod.F90 + models/atm/cam/src/dynamics/homme/external/viscosity_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_si_ref_mod.F90 + models/atm/cam/src/dynamics/homme/external/time_mod.F90 + models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 + models/atm/cam/src/dynamics/homme/external/kinds.F90 + models/atm/cam/src/dynamics/homme/external/physical_constants.F90 + models/atm/cam/src/dynamics/homme/external/solver_mod.F90 + models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 + models/atm/cam/src/dynamics/homme/dyn_grid.F90 + models/atm/cam/src/dynamics/homme/initcom.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + models/atm/cam/src/dynamics/homme/dyn_comp.F90 + models/atm/cam/src/dynamics/homme/inidat.F90 + models/atm/cam/src/dynamics/homme/stepon.F90 + models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + models/atm/cam/src/dynamics/homme/commap.F90 + models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + models/atm/cam/src/dynamics/homme/inital.F90 + Updated from development on homme_cam3_5_29 branch. + + + SVN_EXTERNAL_DIRECTORIES + Added PIO external. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all pass except er731, new test with no baseline to compare to. + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bfb + +=============================================================== + +Tag name: cam3_6_08 +Originator(s): eaton, jenkay, mvr +Date: Thur Sep 4 2008 +One-line Summary: build-namelist fix; new radiation and microphysics + diagnostic fields + +Purpose of changes: +. fix build-namelist to recognize the input datasets that occur in the + rad_climate and rad_diag_N variables. This is only relevent + for the -test option which checks that all required input datasets exist + on a local disk, and for the -inputdata option which writes a list of the + required input datasets to a file. + +. Add precip fluxes calculations and output fields (MGFLXPRC, + MGFLXSNW) to cldwat2m.F90 (from Jen Kay). + +. Add additional radiation fields (FLDS, FSUTOA) to radiation.F90 and + radsw.F90 (from Jen Kay). + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- fix to build-namelist to recognize input datasets associated + with -test option + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +- increased wall clock for bluefire testing + +M models/atm/cam/bld/build-namelist +- fix to recognize input datasets associated with -test option + +M models/atm/cam/src/physics/cam/cldwat2m.F90 +- add precip fluxes calculations and output fields (MGFLXPRC, MGFLXSNW) + +M models/atm/cam/src/physics/cam/radiation.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/physics/rrtmg/radiation.F90 +M models/atm/cam/src/physics/rrtmg/radsw.F90 +- Add additional radiation fields (FLDS, FSUTOA) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +bangkok/lf95: All PASS + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b + +=============================================================== + +Tag name: cam3_6_07 +Originator(s): eaton, aconley, mvr +Date: Fri Aug 29 18:24:14 MDT 2008 +One-line Summary: new physprop (optics + microphysics) files; fixes for + RRTMG aerosol optics; build/run fixes for CICE + +Purpose of changes: + +. Update code to read new physprop datasets which contain updated aerosol + optics and microphysical properties for both the CAMRT and RRTMG codes. + These are the latest data from Steve Ghan that have been converted to CAM + naming conventions by Andrew Conley. These physprop datasets are the + ones currently being used by the radiation team in the evaluation of the + RRTMG code. + +. Update the relative humidity calculation done in the CAMRT code to be + consistent with the rh calcs in the moist physics code and with the + value of rh written to the history output (i.e., rh=q/qsat). + +. Fix bug in reading aerosol lw optical properties. This bug was the cause + of RRTMG solutions not being invariant when task and/or thread counts were + changed. This did not affect CAMRT simulations. + +. Remove storage of optical depths from RRTMG code. + - Update rrtmg external definition to trunk_tags/rrtmg_080826 + +. The cam3_6_05 commit included new driver code that allows different + components to use different thread counts. This is controlled using + variables from the driver namelist group ccsm_pes. Update build-namelist + to write this namelist group to drv_in. By default the *_nthreads + variables are set to 1. This means that runs using cam3_6_05 and + cam3_6_06 will run with 1 thread in each task regardless of the setting + of OMP_NUM_THREADS. build-namelist will now set the value of *_nthreads + to the value of OMP_NUM_THREADS. Also, the user may explicitly set the + values of *_nthreads to achieve a heterogeneous threading configuration. + +. Fixes to regression tests on jaguar addressing CICE and quad-core issues. + +Bugs fixed (include bugzilla ID): + +. Fix bug in reading aerosol lw optical properties. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. iradae is no longer used by RRTMG + +List any changes to the defaults for the boundary datasets: + +. new physprops datasets. + +. change the focndomain defaults for 1/2 and 1/4 degree fv to use the gx1v5 + ocn grid rather than USGS. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/physics/rrtmg/aer_rad_props.F90 +. no longer needed since the physics/cam version of this file is identical + to it after the relative humidity expression is updated + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update rrtmg external to trunk_tags/rrtmg_080826 + +models/atm/cam/bld/build-namelist +. set defaults and write the ccsm_pes namelist group to drv_in + +models/atm/cam/bld/Makefile.in +. remove optimization from the PGI build of the RRTMG files + rrtmg_lw_k_g.f90 and rrtmg_sw_k_g.f90. + + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. new physprops datasets + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add driver namelist group ccsm_pes to control the task/thread layout. + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. + +models/atm/cam/src/physics/cam/phys_prop.F90 +. Update code to read new physprop datasets. Mainly this is new variable + names in the netcdf files. +. bugfix for reading lw_ext data. flw_ext was dimensioned with nswbands + instead of nlwbands. + +models/atm/cam/src/physics/rrtmg/radiation.F90 +models/atm/cam/src/physics/rrtmg/radlw.F90 +models/atm/cam/src/physics/rrtmg/radsw.F90 +. remove dotau option for controlling calculation frequency of optical + depths. This was previously set by using the iradae namelist variable + which has now been removed from RRTMG. + +models/atm/cam/test/system/TCB.sh +. modify code to look for 'csim4' in config_files to flag that cice is not + the ice model + +models/atm/cam/test/system/TBR.sh +models/atm/cam/test/system/TER.sh +. set OMP_NUM_THREADS to CAM_RESTART_THREADS before calling build-namelist +. put conditional around invocation of the cice build-namelist so that it's + not invoked when csim4 is being used. + +models/atm/cam/test/system/TSM.sh +. set OMP_NUM_THREADS to CAM_THREADS before calling build-namelist + +models/atm/cam/test/system/CAM_runcmnd.sh +. generalized the call to aprun to assign the number of tasks per node + based on the requested tasks and threads, assuming the use of quad-core + nodes + +models/atm/cam/test/system/test_driver.sh +. modified task/thread request for hybrid testing on jaguar to work + with changes to test scripts for using the new cice model; fix to default + workspace used for test output +. version of showproj - the utility to grab a charge account for a user - + is now consistent with what ccsm is using... + +models/atm/cam/test/system/config_files/f10c3dm +models/atm/cam/test/system/config_files/h5x8adm +models/atm/cam/test/system/config_files/h5x8dm +models/atm/cam/test/system/config_files/h5x8idm +. set -ice csim4. The f10c3dm config is designed to test the cam3.5 + configuration. The homme tests aren't currently using a sea ice model, + but when they do the csim4 model will probably be the easiest to work + with initially. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +. The regression testing was carried out in two stages. First, all changes + except using the new optics/microphysics data for camrt and switching the + expression for rh used by camrt were tested and shown to be bit-for-bit. + Then those changes were made and the testing redone. The second set of + regression tests which include failed baseline tests is what is reported + below. + +bluefire: All PASS except + +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 + +bangkok/lf95: All PASS except + +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 4 +049 bl511 TBL.sh s8t5mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +055 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +All baseline tests except the adiabatic and ideal physics tests fail due to +the changes in the camrt optics and the microphysics data. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate -- validation runs are being +done by the radiation team. + +=============================================================== +=============================================================== + +Tag name: cam3_6_06 +Originator(s): mvertens +Date: Wed Aug 27 10:45:00 MDT 2008 +One-line Summary: removal of cpl6 refs and script mods for trigrid support + +Purpose of changes: removal of all cpl6 references and cam.cpl7.template +changes needed for upcoming trigrid support + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none expected + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/bld/cam.cpl6.template +D models/atm/cam/src/control/ccsm_msg.F90 +D models/atm/cam/src/control/con_cam.F90 + - removal of cpl6 references + +D models/atm/cam/bld/camsom.cpl7.template +D models/atm/cam/bld/camcsim.cpl7.template + - compsets for camsom and camcsim will no longer be there in cpl7 scripts + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/configure +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_definition.xml + - removed cpl6 references + +M models/atm/cam/bld/cam.cpl7.template + - put in support needed for trigrid upcoming changes + +M models/atm/cam/src/control/mpishorthand.F +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/utils/abortutils.F90 +X models/atm/cam/src/physics/rrtmg/ext +M models/atm/cam/src/dynamics/sld/dynpkg.F90 +M models/atm/cam/src/dynamics/fv/trac2d.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 + - removed references to COUPCSM_ + +M models/atm/cam/src/control/runtime_opts.F90 + - removed references to COUPCSM_ + +M SVN_EXTERNAL_DIRECTORIES + - updated scripts to https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_080820b + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: all tests passed + +bangkok/lf95: all tests passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: answers are bfb + +=============================================================== +=============================================================== + +Tag name: cam3_6_05 +Originator(s): John T., Mariana V. +Date: 082208 +One-line Summary:Put new CICE code on the trunk as default ice model + +Purpose of changes:new cice code default, scam update + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system:none + +Describe any changes made to the namelist:none + +List any changes to the defaults for the boundary datasets:added new + cami_0000-01-01_64x128_T42_L26_c080822.nc + +Describe any substantial timing or memory changes: Mariana reports a + 2%-3% hit to timing not sure of memory changes. + +Code reviewed by:Mariana + +List all subroutines eliminated: + +List all subroutines added and what they do: +These are all new configure scripts and namelists for testing scam +A models/atm/cam/test/system/config_files/scmarmiop +A models/atm/cam/test/system/config_files/scm64bfbiop_35 +A models/atm/cam/test/system/config_files/e64bfbiop_35 +A models/atm/cam/test/system/nl_files/scm_prep_35 +A models/atm/cam/test/system/nl_files/scmarm + +List all existing files that have been modified, and describe the changes: + +---- + | models/atm/cam/test/system/config_files/f10sdm + | models/atm/cam/test/system/config_files/e64sm + | models/atm/cam/test/system/config_files/f4sdh + | models/atm/cam/test/system/config_files/e8sdm + | models/atm/cam/test/system/config_files/e32sdh + | models/atm/cam/test/system/config_files/s8sdm + | models/atm/cam/test/system/config_files/s32sdh + +---> Got rid of old som tests + + models/atm/cam/test/system/config_files/h5x8dm + models/atm/cam/test/system/config_files/h5x8adm + models/atm/cam/test/system/config_files/h5x8idm + + +---- + | models/atm/cam/test/system/config_files/scm64bfbiop_35 + | models/atm/cam/test/system/config_files/e64bfbiop_35 + | models/atm/cam/test/system/nl_files/scm_prep_35 + +---> new scam tests + + +---- + | models/atm/cam/test/system/tests_pretag_bangkok + | models/atm/cam/test/system/tests_posttag_bluefire + | models/atm/cam/test/system/tests_posttag_bluevista + | models/atm/cam/test/system/TCB.sh + | models/atm/cam/test/system/TBR.sh + | models/atm/cam/test/system/TER.sh + | models/atm/cam/test/system/TSM.sh + | models/atm/cam/bld/configure + | models/atm/cam/bld/build-namelist + | models/atm/cam/bld/config_definition.xml + +---> configuration/testing changes for new cice + + models/atm/cam/bld/Makefile.in + changed -qautoinit flag for ibm from 7FF7FFFF7FF7FFFF + to 7FF7FFFF. Fixed compilation warnings for + uninitialized data + + models/atm/cam/src/control/history_defaults.F90 + Added new outfields for scam with MG microphysics + + models/atm/cam/src/control/scamMod.F90 + Added new variables for scam with MG microphysics + + models/atm/cam/src/chemistry/trop_mozart/mo_regrider.F90 + fix scam for running with MG microphysics + + models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + fix scam for running with new chem + + models/atm/cam/src/dynamics/eul/iop.F90 + fix scam for running with MG microphysics + + models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + fix scam for running with MG microphysics + + SVN_EXTERNAL_DIRECTORIES + updated to latest drv and cice code + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire:None + +bangkok/lf95:None + +CAM tag used for the baseline comparison tests if different than previous +tag:No baseline since new cice changes answers + +Summarize any changes to answers, i.e., +- what code configurations: + New CICE code +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + new climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +Atmospheric Diagnostics at + +- source tag + cice4_0_20080822 +- platform/compilers: + bluefire + bangkok +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + /DBAILEY/csm/f40.033 + +URL for AMWG diagnostics output used to validate new climate: + http://www.cgd.ucar.edu/cms/mvr/f40.033/f40.033-f40.017/ + + +=============================================================== +=============================================================== + +Tag name: cam3_6_04 +Originator(s): eaton +Date: Wed Aug 20 11:00:34 MDT 2008 +One-line Summary: Makefile mods for AIX; mods for RRTMG + +Purpose of changes: + +. Change the default optimization for AIX from -O3 to -O2. This is to + address an irreproducibility problem on bluefire resulting from compiling + CLM at -O3. + + *** NOTE *** The change from -O3 to -O2 has triggered a new xlf11 + compiler problem. CAM encounters a seg fault when built *without* + threading enabled, i.e., either serial or pure mpi builds. The + workaround is to build for hybrid parallelization, which is the + default way to build for the IBM power platforms. + +. Other Makefile changes for AIX debug mode: + - change setting of -qinitauto to a double precision signalling NAN + - turn off the optimization that is implied by -qsmp by setting + -qsmp=omp:noopt for threaded configs. + +. Various fixes for RRTMG code: + - bugfix in aerosol optical properties passed to rrtmg + - change index of the visible band from 9 to 10 + +. Note that we are not yet ready to start doing tests of RRTMG w/ aerosols + due to issues with the latest physprop datasets. Will resolve this in an + upcoming commit. + +. Change the cam*.cpl7.template files to force CCSM builds of CAM to enable + threading. + +Bugs fixed (include bugzilla ID): + +. aerosol optics for rrtmg + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/rrtmg/aer_rad_props.F90 +. version of aer_rad_props for rrtmg. currently the only difference is + that the physics/cam/aer_rad_props.F90 still contains the incorrect + expression for relative humidity that was used in cam3. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/cam.cpl7.template +models/atm/cam/bld/camcsim.cpl7.template +models/atm/cam/bld/camdom.cpl7.template +models/atm/cam/bld/camsom.cpl7.template +. always set THREAD = TRUE. This is to deal with a problem that has + appeared on both bluevista and bluefire when trying to run in serial or + pure mpi modes after we reduced the optimization from -O3 to -O2. + +models/atm/cam/bld/Makefile.in +. Change default optimization for AIX to -O2 (was -O3) +. change value of -qinitauto (AIX) to a double precision signalling NAN. +. modify AIX section to avoid having -O2 turned on implicitly by -qsmp in + debug mode + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. bugfix for diagnostic calculation of visible optical depth + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. add some log output for the aerosol physical properties +. modify smcritfactor calculation to allow for hygro_aer=0 + +models/atm/cam/src/physics/rrtmg/radconstants.F90 +. change idxVIS to 10 (from 9) + +models/atm/cam/src/physics/rrtmg/radiation.F90 +. remove unused calculation of relative humidity + +models/atm/cam/src/physics/rrtmg/radsw.F90 +. bugfix for aerosol properties that are passed to rrtmg_sw. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: + +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 + +The baseline tests fail due the change in compiler optimization. This is +true for tests run in both debug and non-debug modes due to implicit +optimization that is turned on by -qsmp + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_6_01 + +Summarize any changes to answers: roundoff introduced due to change from + -O3 to -O2. + +=============================================================== +=============================================================== + +Tag name: cam3_6_03 +Originator(s): eaton +Date: Tue Aug 12 18:51:26 MDT 2008 +One-line Summary: allow setting fcrit2 via namelist; add aerosol optical +depth diagnostics to history output + +Purpose of changes: + +. Provide a new namelist variable fcrit2 to allow setting the value in + gw_drag. The default is still fcrit2=1.0 which is the change made in + cam3_5_50. + +. Add diagnostic output of the column integrated optical depth in the + visible band for individual aerosol constituents that affect the climate + simulation. The names in the history file are of the form ODV_xxx where + xxx is the constituent name as set by the parameterization that + determines its mass distribution. xxx is also the name that is used in + the rad_climate namelist variable. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add namelist variable fcrit2 to namelist group gw_drag_nl + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add variable fcrit2 to namelist group gw_drag_nl + +models/atm/cam/src/control/runtime_opts.F90 +. add call to new gw_drag_readnl routine + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. add diagnostic output of optical depth in the visible band for individual + aerosol constituents in the climate list. The diagnostics lists are not + yet available. + +models/atm/cam/src/physics/cam/gw_drag.F90 +. add gw_drag_readnl routine to read namelist group gw_drag_nl which + contains the variable fcrit2. Remove hardcoded setting of fcrit2 from + the gw_inti routine. + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. add optional arg aernames to the rad_cnst_get_clim_info subroutine to + give access to the aerosol names in either a climate or diagnostic list. + +models/atm/cam/src/physics/waccm/gw_drag.F90 +. changes to waccm version of gw_drag are necessary so that the modules + have the same interfaces and can be swapped at build time + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_6_01 + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_02 +Originator(s): eaton +Date: Thu Aug 7 08:29:12 MDT 2008 +One-line Summary: Enable building standalone CAM with CICE + +Purpose of changes: + +. In the near future the "prescribed" version of CICE will replace + CSIM4 as the default sea ice model for the standalone CAM configuration. + This commit is a step along that path; CICE has not yet been made the + default. It is currently enabled by giving the argument "-ice cice" to + configure. + +. Unlike CSIM4, CICE uses its own grid decomposition which is independent + of CAM's. This decomposition is specified by parameters that are set at + build time, hence they are specified to configure. There are two ways to + do this: + - Specify the number of tasks and/or threads for hybrid, pure mpi, or + pure omp parallelism using the new configure options -ntasks, and + -nthreads. This will allow a default decomposition to be determined. + - Specify the CICE decomposition explicitly via the new configure options + -cice_bsizex, -cice_bsizey, and -cice_maxblocks. + +. Update the CICE external to cice4_0_20080718 + +. Modify the Makefile to allow faster compilation of the RRTMG modules + rrtmg_lw_k_g.f90 and rrtmg_sw_k_g.f90. Longer term solution is to read the + data that's stored in these modules from a file. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. changes to configure to support building w/ CICE + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update CICE to cice4_0_20080718 +. add external for stub sice + +models/atm/cam/bld/configure +. add arguments -cice_bsizex, -cice_bsizey, -cice_maxblocks. + These are used to explicitly set the CICE decomposition. Note that they + must be consistent with the number of tasks and threads used to run the + executable. +. add arguments -ntasks and -nthreads. If these are both specified then a + script provided by CICE will be used to generate a default CICE + decomposition. + Setting -ntasks > 0 implies -spmd, and setting -nthreads > 0 implies + -smp. Serial mode is still set using "-nospmd -nosmp". +. add cice_decomptype to the config definition. build-namelist needs access to + it to call the CICE build-namelist + +models/atm/cam/bld/config_definition.xml +. add cice_decomptype, ntasks, and nthreads + +models/atm/cam/bld/build-namelist +. use the CICE build-namelist +. add -cice_nl argument as a way to pass values to the CICE build-namelist + +models/atm/cam/bld/Makefile.in +. add special rules to AIX section to remove optimization from the + compilation of rrtmg_lw_k_g.f90 and rrtmg_sw_k_g.f90 + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. change names in outfld calls for number concentrations of aerosols to + avoid a name clash with the mixing ratios output by chemistry. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_6_01 +Originator(s): mvr +Date: Wed Aug 6 2008 +One-line Summary: fix to runtime bug with pgi compilers; began replacing +unit 6 flush statements with those using a variable unit number; fix to +ensure code dependencies are regenerated with each make + +Purpose of changes: +any configuration other than adiabatic or ideal physics would die at runtime +with a segfault in the radiation code, when using the pgi compilers on jaguar +(version 7.1-6)...this was introduced in cam3_5_54 + +occasionally, messages from cam were not making it to log files when the coupled +model would die at runtime...this was due to flush statements improperly using unit 6 + +bug 787 describes a problem where code could change between makes where dependencies +may be altered, but make does not regenerate the Depends file + +Bugs fixed (include bugzilla ID): 793 (partial), 787 (partial) + +Describe any changes made to build system: +mod to Makefile.in to ensure Depends file is regenerated with each make + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/run-ibm.csh +- small bug fix to setenv statement with syntax error + +M models/atm/cam/src/control/cam_comp.F90 +- flush calls now using iulog rather than unit 6 + +M models/atm/cam/src/physics/cam/rad_constituents.F90 +- fix to runtime bug (segfault) caught with pgi compilers + +M models/atm/cam/bld/Makefile.in +- fix to ensure Depends file is recreated with each make + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS: + +bangkok/lf95: All PASS: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b + +=============================================================== +=============================================================== + +Tag name: cam3_6 +Originator(s): eaton, andrew +Date: Fri Aug 1 11:27:59 MDT 2008 +One-line Summary: make MG microphysics the default + +Purpose of changes: + +. MG microphysics is now the default. This is controlled by the new + "-microphys" argument to configure. The valid values are "rk" (Rasch and + Kristjansson), and "mg" (Morrison and Gettelman two moment scheme). "mg" + is the default. + + ** Note 1 ** This default needs to implemented in configure rather than + build-namelist because it affects the total number of + advected constituents which is a build time setting. + + ** Note 2 ** Since configure now knows what microphysics scheme is being + used, build-namelist is able to automatically set the + correct value of the namelist variable microp_scheme. The + user no longer needs to set that variable. + +. Add bugfix to MG microphysics code (from Andrew Gettelman). + +. A new argument, -nadv_tt, has been added to configure to specify the + number of advected test tracers. Previously this was done by using the + -nadv argument which specifies the total number of advected tracers. + That way of doing things resulted in having to redefine all the + regression tests that include test tracers because the MG microphysics + adds 2 advected constituents. Deconvolving the specification of test + tracers and total advected constituents makes the test specifications + more robust, and provides an easier to use interface. + +. The regression tests have been updated to use the new -nadv_tt argument + to configure for specifying the number of advected test tracers. Also, + the special test for MG microphysics has been replaced by a test for the + cam3.5 physics. + +Bugs fixed (include bugzilla ID): + +. Add bugfix to MG microphysics code (from Andrew Gettelman). + +Describe any changes made to build system: + +. configure has 2 new arguments: -microphys and -nadv_tt + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. MG microphysics is more expensive than RK. Don't have benchmarks yet. + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/test/system/config_files/e8c8mdm +. renamed e8t5mdm + +models/atm/cam/test/system/config_files/f10c8mdm +. renamed f10t5mdm + +models/atm/cam/test/system/config_files/s8c8mdm +. renamed s8t5mdm + +models/atm/cam/test/system/config_files/f10c5dm +. renamed f10c3dm + +models/atm/cam/test/system/nl_files/microp_mg +. special test for MG microphysics no longer needed + +List all subroutines added and what they do: + +models/atm/cam/test/system/config_files/e8t5mdm +models/atm/cam/test/system/config_files/f10t5mdm +models/atm/cam/test/system/config_files/s8t5mdm +. these files are for tests using test tracers. The -nadv settings have + all been replaced by settings for -nadv_tt + +models/atm/cam/test/system/config_files/f10c3dm +. this file is used to test the cam3.5 physics, which is turned on by the + setting "-chem none -microphys rk" + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add default for microp_scheme based on value from configure +. set tracers_flag=.true. if test tracers requested via configure + +models/atm/cam/bld/config_defaults_trop_mozart.xml +models/atm/cam/bld/config_defaults_trop_mozart_aero.xml +models/atm/cam/bld/config_defaults_trop_mozart_ghg_paero.xml +models/atm/cam/bld/config_defaults_trop_mozart_prescribed_aero.xml +models/atm/cam/bld/config_defaults_waccm_ghg.xml +models/atm/cam/bld/config_defaults_waccm_mozart.xml +. remove default setting for nadv -- responsibility for setting this + belongs in configure. + +models/atm/cam/bld/config_definition.xml +. add parameter "microphys" with valid values "rk" or "mg", and set the + default value to "mg" +. remove default value for nadv -- move all responsibility for setting + this into configure +. add parameter "nadv_tt" to specify number of advected test tracers + +models/atm/cam/bld/configure +. modify how nadv values are set depending on the specific chemistry and + microphysics packages +. add commandline args for the new microphys and nadv_tt parameters + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add values for microp_scheme + +models/atm/cam/doc/ChangeLog_template +. blueice changed to bluefire + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. one line bugfix from Andrew Gettelman + +models/atm/cam/src/physics/cam/phys_control.F90 +. Remove the default setting for microp_scheme_default. It is now the + responsibility of configure to set this default. + +models/atm/cam/src/physics/cam/stratiform.F90 +. Add check that valid value of microp_scheme has been specified. + +models/atm/cam/test/system/config_files/e64bfbiop +models/atm/cam/test/system/config_files/scm64bfbiop +. add "-microphys rk" for scam tests which are currently failing when the + MG microphysics is enabled. + +models/atm/cam/test/system/input_tests_master +. update test definitions to account for changed config file names +. replace special MG microphysics test with a test for the cam3.5 physics. + currently this sets "-chem none -microphysics rk" + +models/atm/cam/test/system/nl_files/ttrac +models/atm/cam/test/system/nl_files/ttrac_lb1 +models/atm/cam/test/system/nl_files/ttrac_lb2 +models/atm/cam/test/system/nl_files/ttrac_lb3 +. remove tracers_flag -- now set by build-namelist + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 7 + +bangkok/lf95: All PASS except: +004 bl111 TBL.sh e8t5mdm ttrac 9s .................................FAIL! rc= 5 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10t5mdm ttrac 9s ................................FAIL! rc= 5 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c3dm outfrq3s 9s ..............................FAIL! rc= 5 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8t5mdm ttrac 9s .................................FAIL! rc= 5 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +055 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +All baseline tests fail except for the adiabatic and ideal physics tests. +Some of the failures above are due to changing the names of config files. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: new climate in default model due to + changing default microphysics to MG. The answers for MG also change from + the baseline due to the bug fix. + +=============================================================== +=============================================================== + +Tag name: cam3_5_55 +Originator(s): eaton, santos, rneale +Date: Wed Jul 30 11:22:12 MDT 2008 +One-line Summary: fix compilation problems; new default files for full +chem; mods to generate input dataset lists + +Purpose of changes: + +. Fixes for compilation problems (with PGI) encountered during post-tag + testing of previous tag. + +. Add new default files so that build-namelist produces working namelists + for 1 and 2 degree full trop chemistry runs. + +. Mods to allow CCSM scripts to automatically retrieve missing input + datasets from svn archive (from Sean Santos). + +. Add log output to zm_conv to help diagnose ientropy errors (from Rich + Neale). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. new input datasets for 1 and 2 degree full trop chemistry configs. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +models/atm/cam/bld/cam.cpl7.template +. Mods to allow CCSM scripts to automatically retrieve missing input + datasets from svn archive. + +models/atm/cam/bld/namelist_files/namelist_defaults.xml +. add files needed for 1 and 2 deg full trop chem runs + +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +. Change dummy arg "order" in both read_2d_trc and read_3d_trc from assumed + shape to the correct explicit shape. + +models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +. replace new "use share_const_mod" with constants from existing "use mo_constants" + +models/atm/cam/src/physics/cam/zm_conv.F90 +. add diagnostic output for ientropy errors + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except + +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 + +This baseline test fails because the test code is using a new initial file +that contains spun up chemistry. + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_54 +Originator(s): eaton, aconley, fvitt +Date: Thu Jul 24 10:48:30 MDT 2008 +One-line Summary: Add new radiative constituent interfaces. Add RRTMG as +an option. CAM3.5 configuration is now the default. + +Purpose of changes: + +. The new radiative constituent interface has been added. This provides + for an explicit specification of which constituents are radiatively + active for both climate and diagnostic calculations. The namelist + variables rad_climate, rad_diag_1, rad_diag_2, ... rad_diag_10 are used + to specify the constituents used for the climate and up to ten diagnostic + calculations. Each of the namelist variables specifies which + constituents are used for the gas species, aerosol species, and a file + that contains the optical and physical properties for each aerosol species. + + build-namelist constructs default values for rad_climate for each of the + chemistry options. There are no diagnostic calculations specified by + default. In this initial commit the diagnostic calculations for the CAM3 + radiation code are not implemented. There is a partial implementation of + the diagnostics for the RRTMG radiation. + + The functionality for controlling which aerosols were radiatively active + was previously located in the aerosol_intr module. The namelist + variables previously used for this purpose have been removed. + +. The RRTMG radiation code is present as a build time option. It is + enabled by specifying the flag -rrtmg to configure. Implementing aerosol + and cloud optics for RRTMG is not yet complete. + + The RRTMG code is accessed by CAM via an external definition of the + source tree directory models/atm/cam/src/physics/rrtmg/ext/ + +. MG microphysics now gets microphysical data for aerosols from the same + files that provide the optics data. This data was previously hardcoded + in the prescribed_aerosols module. That module has been removed. + +. The 1990_control use case has been made the default configuration on the + trunk. This is the configuration used for CCSM3.5 1990 control + runs. The differences from the previous default configuration are: + - The CAM-Chem prescribed aerosols replace the CAM3 aerosol climatology. + - The GHG values (co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr) and scon are + from the 1990_control use case. + - The CAM-Chem prescribed ozone replaces the CAM3 ozone (from pcmdi). + - The CAM-Chem options are enabled by making the configure option + "-chem trop_mozart_prescribed_aero" the default chemistry mode. + +. A new chemistry mode "-chem none" has been added to configure. + Specifying this option turns on the CAM3 prescribed aerosols and ozone + and makes them radiatively active. The functionality to support the CAM3 + prescribed aerosols and ozone is implemented by the new cam3_aero_data + and cam3_ozone_data modules. + +. Modifications to CAM-Chem code: + - The prescribed aerosol and ozone modules were modified to put the + interpolated values (in mass mixing ratio units) into the physics + buffer. + - The namelist variable input has been redistributed so that it's not + handled entirely by the chemistry module. + - The names of the prescribed aerosols were changed. + - Default value of xactive_drydep changed from .false. to .true. + - More flexible tracer_data module. Allow dimensions of the input data + to occur in any order rather than restrict to (lon,lat,lev,tim). + +. SVN_EXTERNAL_DIRECTORIES: + - update to esmf_wrf_timemgr_080717 + - add external rrtmg_080606 + +Bugs fixed (include bugzilla ID): + +. The CAM-Chem code that rebins the 4-bin sea salt into 2 bins for the + CAM-RT optics was missing an initializer. + +. The problem with the trop_mozart_ghg_paero mode running in debug mode + under xlf11 has been fixed. The problem was with date calculation code + in tracer_data which has been updated to use time_manager methods (and + required a mod to the esmf_wrf_timemgr code. + +Describe any changes made to build system: + +. add -rrtmg flag to configure to build CAM with RRTMG radiation + +. modifications to make "trop_mozart_prescribed_aero" the default value of + the -chem argument to configure + +Describe any changes made to the namelist: + +. namelist variables removed + - rampyear_prescribed_sulfur + - scenario_prescribed_sulfur + - tauback + - aeroptics + - aero_feedback_carbon + - aero_feedback_dust + - aero_feedback_progsslt + - aero_feedback_sea_salt + - bndtvcarbonscale + - carscl, dustscl, ssltscl, sulscl, volcscl + - bgscl_rf, carscl_rf, dustscl_rf, ssltscl_rf, sulscl_rf, volcscl_rf + - prescribed_sulfur + - radforce + - scenario_carbon_scale + - use_cam_ghg_data, use_cam_ozone_data + - use_data_co2, use_data_o3 + +. namelist variables added + - cam3_ozone_data_on: enables the CAM3 prescribed ozone + - cam3_aero_data_on: enables the CAM3 prescribed aerosols + - rad_climate + - rad_diag_1, rad_diag_2, ..., rad_diag_10 + - prescribed_aero_datapath + - prescribed_aero_file + - prescribed_aero_filelist + - prescribed_aero_rmfile + - prescribed_aero_specifier + - prescribed_aero_tod + - prescribed_aero_type + - prescribed_aero_ymd + - prescribed_ghg_datapath + - prescribed_ghg_file + - prescribed_ghg_filelist + - prescribed_ghg_rmfile + - prescribed_ghg_specifier + - prescribed_ghg_tod + - prescribed_ghg_type + - prescribed_ghg_ymd + +. namelist variables modified + - bndtvaer: moved from group cam_inparm to cam3_aero_data_nl + - bndtvo: moved from group cam_inparm to cam3_ozone_data_nl + - ozncyc: moved from group cam_inparm to cam3_ozone_data_nl + +List any changes to the defaults for the boundary datasets: + +. the namelist_defaults.xml file has been modified to remove all the + resolution dependent start_ymd values. This was origianlly implemented + to ensure that a default initial file would be found without the user + needing to know the corresponding date. This feature was mainly for the + regression testing. But we now have the capability to specify + -ignore_ic_date or -ignore_ic_year to build-namelist which is a more + explicit and flexible way for the user to indicate that the exact date of + the initial file isn't important. The TBL.sh script uses the + -ignore_ic_date arg in its build-namelist call. + + The result of this change is that some of our regression tests which + previously got a resolution dependent start_ymd that was different from + 901 will now get the resolution independent default which has been + changed to 101 for consistency with the CCSM scripts. + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/src/chemistry/trop_mozart/rad_cnst_data_interface.F90 +. not needed. prescribed aerosols now put in physics buffer and + rad_constituents is responsible for knowing what to use for climate and + diagnostic calcs. + +models/atm/cam/src/physics/cam/aer_optics.F90 +models/atm/cam/src/physics/cam/aerosol_index.F90 +models/atm/cam/src/physics/cam/aerosol_radiation_interface.F90 +. aerosol optical calcs moved to new aer_rad_props module + +models/atm/cam/src/physics/cam/carbonscales.F90 +. functionality replaced by providing time series data for carbon aerosol + distributions. + +models/atm/cam/src/physics/cam/ozone_data.F90 +. This module has been renamed cam3_ozone_data. + +models/atm/cam/src/physics/cam/prescribed_aerosols.F90 +. This module has been renamed cam3_aero_data. All the functionality + related to determining the aerosol mass for both the climate and + diagnostic calculations now belongs in the rad_constituents module. + +List all subroutines added and what they do: + +models/atm/cam/src/chemistry/trop_mozart/prescribed_aero.F90 +models/atm/cam/src/chemistry/trop_mozart/prescribed_ghg.F90 +. New CAM-Chem code for prescribed aerosols and ozone. The prescribed + constituents are maintained in the physics buffer. + +models/atm/cam/src/physics/cam/aer_rad_props.F90 +. New module for computing aerosol radiative properties for both climate + and diagnostic calculations. + +models/atm/cam/src/physics/cam/cam3_aero_data.F90 +. Responsible for putting the CAM3 aerosol mixing ratios into the physics + buffer. + +models/atm/cam/src/physics/cam/cam3_ozone_data.F90 +. Responsible for putting the CAM3 ozone mixing ratios into the physics + buffer. + +models/atm/cam/src/physics/cam/hirsbt.f90 +models/atm/cam/src/physics/cam/hirsbtpar.f90 +. Diagnostic calculations of TOA brightness temperatures for 7 TOVS/HIRS + channels and 4 TOVS/MSU channels. + +models/atm/cam/src/physics/cam/phys_prop.F90 +. responsible for maintaining the physical property data (includes optics) + for the aerosols. + +models/atm/cam/src/physics/cam/radconstants.F90 +. constants for CAM-RT + +models/atm/cam/src/physics/cam/sslt_rebin.F90 +. rebins 4 sea salt bins into 2 bins. + +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/README +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/parrrtm.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_cld.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_con.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg01.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg02.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg03.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg04.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg05.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg06.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg07.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg08.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg09.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg10.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg11.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg12.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg13.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg14.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg15.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_kg16.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_ref.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_tbl.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_vsn.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrlw_wvn.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_cldprop.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_init.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_k_g.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_rad.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_rtrn.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_rtrnmr.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_setcoef.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_lw/rrtmg_lw_taumol.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/mcica_random_numbers.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/mcica_subcol_gen_lw.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/mcica_subcol_gen_sw.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_lw_cldprmc.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_lw_rad.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_lw_rtrnmc.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_sw_cldprmc.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_sw_rad.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_mcica/rrtmg_sw_spcvmc.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/README +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/parrrsw.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_aer.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_cld.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_con.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg16.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg17.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg18.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg19.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg20.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg21.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg22.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg23.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg24.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg25.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg26.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg27.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg28.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_kg29.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_ref.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_tbl.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_vsn.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrsw_wvn.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_cldprop.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_init.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_k_g.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_rad.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_reftra.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_setcoef.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_spcvrt.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_taumol.f90 +models/atm/cam/src/physics/rrtmg/ext/rrtmg_sw/rrtmg_sw_vrtqdr.f90 +. new RRTMG code. This code is pulled in via an external definition. + +models/atm/cam/src/physics/rrtmg/radconstants.F90 +models/atm/cam/src/physics/rrtmg/radiation.F90 +models/atm/cam/src/physics/rrtmg/radlw.F90 +models/atm/cam/src/physics/rrtmg/radsw.F90 +. CAM specific interface code to the RRTMG radiation parameterization. + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update to esmf_wrf_timemgr_080717 +. add rrtmg_080606 + +models/atm/cam/bld/Makefile.in +. add suffix recognition and rules for compiling .f90 files + +models/atm/cam/bld/build-namelist +. add defaults for the scon and GHG values +. only put absems_data into namelist when CAM-RT is active +. turn on the cam3 prescribed ozone and aerosols for configurations that + don't yet work with the CAM-Chem versions (i.e., waccm) +. add appropriate defaults for the prescribed aerosols and ozone depending + on whether cam3 or CAM-Chem versions being used (or both). +. construct new rad_climate specifier depending on the chem option +. remove old specifiers of aerosol feedback +. update namelist variables used by CAM-Chem options + +models/atm/cam/bld/config_defaults_trop_mozart.xml +models/atm/cam/bld/config_defaults_trop_mozart_aero.xml +models/atm/cam/bld/config_defaults_trop_mozart_ghg_paero.xml +models/atm/cam/bld/config_defaults_trop_mozart_prescribed_aero.xml +. remove specification of cppdefs="-DTROPCHEM" + +models/atm/cam/bld/config_definition.xml +. add parameter rrtmg +. modify chem parameter to accept 'none' as a valid value, and to make + trop_mozart_prescribed_aero the default value. + +models/atm/cam/bld/configure +. add -rrtmg option +. modify so that when the user specifies -nadv the value is not modified by + configure +. mod to supply the -DTROPCHEM cpp def when any trop_mozart* chemistry + option is specified. Then that specification may be removed from all the + config_defaults_trop_mozart*.xml files + +models/atm/cam/bld/mkSrcfiles +. update to recognize .f90 suffix for files that need to be built. This + was needed for building the rrtmg code. + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +. add Jan 1 IC file for T5 +. add new defaults for aerosol optics +. add defaults for new prescribed ozone (same as 1990_control use case) +. add defaults for new prescribed aerosol (same as 1990_control use case) +. add defaults for GHGs and scon (same as 1990_control use case) + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. changes to namelist as described above + +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +. add GHG and scon settings consistent with 1870_control values used in + CCSM3.5 simulations +. update for namelist changes in the CAM-Chem code + +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1990_control.xml +. update for namelist changes in the CAM-Chem code + +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +. remove a bunch of namelist vars that have been moved to other modules + +models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 +. remove namelist variables from arg list that are now managed by module + specific *_{default,set}opts methods. Call new *_init methods. + +models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 +. Change default value of xactive_drydep from .false. to .true. + +models/atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_jshort.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 +. access parameter rearth from physconst rather than dycore specific + dynconst module + +models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +. remove set_aerosol_from_mz_prescribed routine + +models/atm/cam/src/chemistry/trop_mozart/prescribed_ozone.F90 +. add *_{default,set}opts methods +. put ozone in physics buffer in mass mixing ratio units + +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +. allocate memory if field not already in pbuf +. allow dimensions of input data to occur in any order +. use date calculation routines from time_manager + +models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 +models/atm/cam/src/chemistry/trop_mozart/tracer_srcs.F90 +. add *_{default,set}opts methods + +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_sim_dat.F90 +models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_sim_dat.F90 +. change names of prescribed aerosols so that they can co-exist with the + prognostic aerosols. + +models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 +. move namelist variables for prescribed_ozone, tracer_cnst, tracer_srcs + modules into the *_{default,set}opts methods of those modules + +models/atm/cam/src/chemistry/waccm_mozart/mo_sad.F90 +. comment out sad_set_aer_mass routine which needs to be updated to use the + physics buffer + +models/atm/cam/src/control/cam_comp.F90 +. add pbuf as actual arg in phys_init call + +models/atm/cam/src/control/filenames.F90 +. remove public module data bndtvaer, bndtvcarbonscale, aeroptics + +models/atm/cam/src/control/runtime_opts.F90 +. move bndtvaer, ozncyc to cam3_aero_data +. move bndtvo to cam3_ozone_data +. remove aeroptics, bndtvcarbonscale + scenario_carbon_scale, scenario_prescribed_sulfur, rampyear_prescribed_sulfur, + prescribed_sulfur, tauback, radforce + aero_feedback_carbon, aero_feedback_sea_salt, aero_feedback_progsslt, + aero_feedback_dust + sulscl, carscl, ssltscl, dustscl, volcscl, + sulscl_rf, carscl_rf, ssltscl_rf, dustscl_rf, volcscl_rf + use_data_o3, use_data_co2, use_cam_ozone_data, use_cam_ghg_data +. added prescribed_ghg_specifier, prescribed_ghg_file, prescribed_ghg_filelist, + prescribed_ghg_datapath, prescribed_ghg_type, prescribed_ghg_rmfile, + prescribed_ghg_ymd, prescribed_ghg_tod, + prescribed_aero_specifier, prescribed_aero_file, + prescribed_aero_filelist, prescribed_aero_datapath, prescribed_aero_type, + prescribed_aero_rmfile, prescribed_aero_ymd, prescribed_aero_tod +. added *_{default,set}opts methods for tracer_cnst, tracer_srcs, + prescribed_ozone, prescribed_ghg, prescribed_aero modules +. removed *_{default,set}opts methods for ozone_data, rad_constituents, + aerosol_radiation_interface modules +. add methods to read module specific namelists for cam3_aero_data, + cam3_ozone_data, rad_constituents modules + +models/atm/cam/src/physics/cam/advnce.F90 +. update interfaces for cam3 prescribed aerosols and ozone + +models/atm/cam/src/physics/cam/aerosol_intr.F90 +. remove variables that control whether aerosols are radiatively active +. remove set_aerosol_from_prognostics + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. add addfld/add_default calls for existing outfld calls +. update rad_constituents interfaces +. comment output of aerosol number concentrations + +models/atm/cam/src/physics/cam/phys_gmean.F90 +models/atm/cam/src/dynamics/fv/mean_module.F90 +models/atm/cam/src/dynamics/fv/d2a3dikj.F90 +models/atm/cam/src/dynamics/fv/par_xsum.F90 +models/atm/cam/src/dynamics/fv/p_d_adjust.F90 +. comment out log messages about "fixed and floating point sums differ" + +models/atm/cam/src/physics/cam/initindx.F90 +. new register routines for cam3 aerosols and ozone +. new register routines for CAM-Chem prescribed ozone, aerosols, ghgs +. add log output after all pbuf fields registered + +models/atm/cam/src/physics/cam/phys_buffer.F90 +. new print method for log file info +. new query method pbuf_get_fld_name + +models/atm/cam/src/physics/cam/physpkg.F90 +. add pbuf to phys_init dummy args +. update init calls for cam3 aerosols and ozone +. new init calls for rad_constituents and aer_rad_props +. new init for the sea salt rebinning module + +models/atm/cam/src/physics/cam/param_cldoptics.F90 +models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +. add cloud optical depth calc + +models/atm/cam/src/physics/cam/rad_constituents.F90 +. implement new interface design that treats both gases and aerosols + +models/atm/cam/src/physics/cam/radae.F90 +. use radconstants + +models/atm/cam/src/physics/cam/radiation.F90 +. use radconstants +. remove calc of sat sp hum +. update rad_constituents interfaces +. new aer_rad_props interfaces +. temporarily remove diagnostic call and indirect call to radcswmx + +models/atm/cam/src/physics/cam/radlw.F90 +. use radconstants +. add aerosol optical depth arg to radclwmx +. add subroutine aer_trans_from_od + +models/atm/cam/src/physics/cam/radsw.F90 +. use radconstants +. remove rh arg from radcswmx +. add aerosol optical properties as args to radcswmx + +models/atm/cam/src/physics/cam/stratiform.F90 +. move addfld calls for MG microphysics quantities to cldwat2m.F90 +. update the rad_constituent interfaces. they are only used by MG. + +models/atm/cam/src/physics/cam/tphysbc.F90 +. Add a call to sslt_rebin_adv to rebin the seasalt from 4 into 2 bins. + This is only need for the CAM-RT radiation code for which there are only + optical characterizations of 2 sea salt bins. + +models/atm/cam/src/physics/cam/volcanicmass.F90 +. register the volcanic aerosol in pbuf and use pbuf to store the + interpolated data +** this functionality is currently broken ** + +models/atm/cam/src/physics/waccm/nlte_lw.F90 +. update to new rad_constituent interfaces + +models/atm/cam/src/utils/repro_sum_mod.F90 +. bug fix for non-spmd mode + +models/atm/cam/src/utils/time_manager.F90 +. add methods set_time_float_from_date and set_date_from_time_float + +models/atm/cam/test/system/config_files/e64bfbiop +models/atm/cam/test/system/config_files/scm64bfbiop +. change configurations used to SCAM test to use "-chem none" + +models/utils/esmf_wrf_timemgr/ESMF_TimeIntervalMod.F90 +. enabled the d_ optional argument to ESMF_TimeIntervalSet + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: All PASS except +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +009 bl134 TBL.sh e32adh adia 9s ...................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +024 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 7 +027 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 5 + +bangkok/lf95: All PASS except +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +017 bl115 TBL.sh e8idm idphys 9s ..................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +055 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +These baseline tests are expected to fail due to changed answers. The +ideal physics and adiabatic configurations in tests bl115, bl334, and bl335 +are actually BFB, but the test is failing due to the changes to the default +start_ymd values. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_52 + +Summarize any changes to answers: + +Model configurations that are BFB with the baseline: +==================================================== + +. adiabatic and ideal physics + +. full physics configurations in which the only radiatively active species + are the gases. If prescribed ozone is active, it must be the CAM3 + ozone. The CAM3 ozone is enabled by setting cam3_ozone_data_on=.true. in + the namelist. The aerosols are turned off in the baseline code by + setting sulscl=dustscl=carscl=ssltscl=0.0 in the namelist. + + This was verified for the -chem options: trop_mozart_prescribed_aero, + trop_mozart_ghg_paero, trop_mozart_aero, trop_mozart, waccm_ghg, and + waccm_mozart. + +Model configurations that have only roundoff differences with the baseline: +=========================================================================== + +. full physics configurations in which the only radiatively active species + are the gases *and* the active ozone is the CAM-Chem prescribed ozone. + This version of ozone is the now the default on the trunk. The aerosols + are turned off in the baseline code by setting + sulscl=dustscl=carscl=ssltscl=0.0 in the namelist. + + This was verified via a pergro test for the -chem option + trop_mozart_prescribed_aero. + +. full physics configurations with CAM-Chem version of aerosols (prescribed + or prognostic). + + In order to validate the roundoff diffs it is necessary to fix the bug in + the baseline code that rebins the 4-bin sea salt into 2 bins. + + Configurations that were verified by pergro test are the -chem options: + trop_mozart_prescribed_aero and trop_mozart_ghg_paero. + +Model configurations with larger than roundoff differences from the baseline: +============================================================================= + +. full physics configurations using the CAM3 prescribed aerosols. The + issue here is that these aerosol mixing ratios were incorrectly treated + as moist mmr in CAM3 code. This has been fixed. The result is larger + than roundoff differences (but presumably the same climate) have been + introduced into these configurations. That includes the waccm_ghg and + waccm_mozart modes which aren't yet configured to use the new CAM-Chem + prescribed aerosols. + +Validation with MG microphysics enabled: +======================================== + +. The validation of the default configuration + MG microphysics is + complicated by very large error growth when MG is enabled. Our standard + pergro test is not valid in this configuration. So to attempt to validate + MG I looked just at a 6 step run using the pergro/aqua_planet + configuration, and looked at the output from cprnc for all fields written + to the default history file. The roundoff size differences are introduced + at nstep=0, and it can be seen that all fields with differences show 12-16 + digits of agreement on average. This isn't a stong test, but it did point + out problems that resulted in larger than roundoff size differences at + nstep=0. In particular, to get this test to pass it was necessary to make + a bugfix to the baseline code. In stratiform_tend the conversion of aerosol + mass to mmr made before calling the MG microphysics was using moist instead + of dry air mass. + +=============================================================== +=============================================================== + +Tag name: cam3_5_53 +Originator(s): mvr, jedwards, dbailey, pworley +Date: 17 July 2008 +One-line Summary: bug fix for omp-only mode; code workaround for pathscale +compiler problem; backed out timing library introduced in cam3_5_51; new +cice tag with prescribed ice similar to csim + +Purpose of changes: +cam3_5_51 introduced a few things needing attention...omp-only mode needed +a bug fix and posttag testing with pathscale was disabled due to new code +that triggered a compiler problem...also, running with the ccsm scripts +showed a problem with the timing library introduced + +a new cice tag became available where the prescribed ice looks similar to +csim...this is the next step on the path to replacing csim with cice + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/bld/run-ibm.csh +- revised the list of ibm env vars (from jedwards) + +M models/atm/cam/bld/cam.cpl7.template +- cleanup, removed sourcing of ccsm env files; use_case now set from ccsm env var + +M models/atm/cam/bld/camsom.cpl7.template +M models/atm/cam/bld/camcsim.cpl7.template +M models/atm/cam/bld/camdom.cpl7.template +- cleanup, removed sourcing of ccsm env files + +M models/atm/cam/src/utils/repro_sum_mod.F90 +- code workaround for pathscale compiler problem which surfaced with cam3_5_51 + +M models/atm/cam/src/dynamics/fv/mean_module.F90 +- bug fix for running in omp-only mode + + M . +M SVN_EXTERNAL_DIRECTORIES +- new clm, cice, timing, and scripts tag + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +052 sm382 TSM.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 8 +053 er382 TER.sh fmgpa1.9dh outfrq3s+1870_control 4+5s ............FAIL! rc= 5 +054 br382 TBR.sh fmgpa1.9dh outfrq3s+1870_control 6+3s ............FAIL! rc= 5 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 4 + +- "382" tests are existing failures which first occurred with introduction of XLF + 11.1 compilers on the IBM's, which is the default on bluevista and bluefire + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): bfb + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_52 +Originator(s): pworley +Date: 11 July 2008 +One-line Summary: use scalable reproducible sum logic in FV distributed sums + +Purpose of changes: improve performance and memory scalability + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: Substantial performance +improvement for runs with large numbers of tracers; modest improvements in +current FV production configurations. + +Code reviewed by: Eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam/src/dynamics/fv/d2a3dikj.F90 + M models/atm/cam/src/dynamics/fv/fv_prints.F90 + M models/atm/cam/src/dynamics/fv/mean_module.F90 + M models/atm/cam/src/dynamics/fv/p_d_adjust.F90 + M models/atm/cam/src/dynamics/fv/par_xsum.F90 + + - Replaced existing logic based on "master computes" with the scalable, + reproducible algorithm implemented in repro_sum_module. If the relative + difference between the sum produced by the reproducible fixed-point + algorithm and by the nonreproducible floating-point algorithm is greater + than repro_sum_rel_diff_max (default 1.0e-13) and if repro_sum_recompute + is set equal to true (default .false.), then the sum is recomputed with + the original (nonscalable) algorithm. Since this is done on a field-by-field + basis, the memory requirements are less than in the original implementation, + but the cost is potentially much greater. + + M models/atm/cam/src/dynamics/fv/FVperf_module.F90 + + - defined the grid argument in FVstartclock, FVstopclock, and + FVbarrierclock to be intent(in) instead of intent(inout) when + GEOS_MODE is NOT defined. This removes an incompatibility introduced by + using FVstart/stopclock in par_xsum.F90. + + M models/atm/cam/src/dynamics/fv/te_map.F90 + + - in previous versions, par_xsum was not called when SPMD was not defined + or when nprxy_x = 1. To preserve reproducibility when using the repro_sum + routine, te_map was modified to call par_xsum in all instances. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: + +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +024 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 7 +027 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 + +Use of repro_sum algorithm in FV distributed sums introduces a roundoff level +difference in the numerics. All FV comparisons with the baseline code fail. + +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +052 sm382 TSM.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 8 +053 er382 TER.sh fmgpa1.9dh outfrq3s+1870_control 4+5s ............FAIL! rc= 5 +054 br382 TBR.sh fmgpa1.9dh outfrq3s+1870_control 6+3s ............FAIL! rc= 5 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 4 + +- "382" tests are existing failures which first occurred with introduction of XLF + 11.1 compilers on the IBM's, which is the default on bluevista and bluefire + +bangkok/lf95: + +023 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 + +Due to roundoff level difference in numerics, FV comparisons with the baseline +code fail. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: FV dycore +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? standard pergro test + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_51 +Originator(s): pworley +Date: 10 July 2008 +One-line Summary: BGP support; new timing library; new +reproducible sum routine; new performance optimization options +in cd_core; ALTGATHER support; clean-up and bug fixes + +Purpose of changes: + +Bugs fixed (include bugzilla ID): omega diagnostic calculation +is now correct when geopktrans==1 (and 2) + +Describe any changes made to build system: added support for BGP in +Makefile and in configure. Adding ALTGATHER to CPPFLAGS may +eliminate the gather failure on the Cray XT without requiring setting +MPI environment variables. + +Describe any changes made to the namelist: eliminated +phys_float_repro_gmean, phys_fixed_repro_gmean, and +phys_nonrepro_gmean; replaced phys_rdiff_warning_gmean with +repro_sum_rel_diff_max; added repro_sum_recompute, +geopkblocks, and cd_core_swapm; added option 2 to geopktrans. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: performance improved +for certain problems and platforms by setting geopktrans=2 and +geopkblocks appropriately, and/or by setting cd_core_swapm to .true. + +Code reviewed by: Eaton + +List all subroutines eliminated: + in models/atm/cam/src/physics/cam/phys_gmean.F90 + 1) phys_gmean_defaultopts + 2) phys_gmean_setopts + 3) gmean_nonrepro + +List all subroutines added and what they do: + in new file models/atm/cam/src/utils/repro_sum_defaultopts.F90 + 1) repro_sum_defaultopts + - get default runtime options (replacement for phys_gmean_defaultopts) + 2) repro_sum_setopts + - set runtime options (replacement for phys_gmean_setopts) + 3) repro_sum + - calculate both fixed-point scalable, reproducible distributed sums + and floating-point scalable, nonreproducible sums, returning + fixed-point results and relative difference between two algorithms. + + in models/utils/pilgrim/mod_comm.F90 + 1) mp_sendirr_fc + - version of mp_sendirr with additional flow control + 2) mp_sendirr_fc_r4 + - version of mp_sendirr_r4 with additional flow control + 3) mp_sendirr_fc_i4 + - version of mp_sendirr_i4 with additional flow control + 4) mp_swapmirr + - replacement for mp_sendirr/mp_recvirr that gives up + support for one-sided and MPI datatype options and communication/ + computation overlap, but adds swap_comm protocol + options, improved communication ordering, and the ability to + transpose multiple fields simultaneously. + + in models/atm/cam/control/wrap_mpi.F90 + 1) mpigathervr4 + - version of mpigatherv for r4 data + 2) mpigathervint + - version of mpigatherv for int data + + in models/atm/cam/dynamics/fv/geopk.F90 + 1) geopk_d + - implementation of same calculation as geopk without requiring + transpose. Calculation is reproducible, and numerics are identical + to geopk. Performance is somewhat similar to geopk16. + +List all existing files that have been modified, and describe the changes: + +Timing library + Updated to include a more recent version of Jim Rosinski's + GPTL library, supporting global statistics, and improved control of + output + + M SVN_EXTERNAL_DIRECTORIES + - updated to timing/trunk_tags/timing080629 + + M models/atm/cam/bld/Makefile.in + - added OpenMP-enabling flags to CFLAGS when SMP is defined + for all platforms where missing. Note that have tested only + on Bluefire, Bangkok, Cray XT4 (Jaguar), and IBM BG/P + +ALTGATHER + Defining ALTGATHER replaces mpi_gather in mpigatherv with a point-to-point + implementation with additional flow control. It also calls new routines + mp_sendirr_fc, mp_sendirr_fc_r4, and mp_sendirr_fc_i4 with additional + flow control for gathers in FV I/O routines. This avoids many of the gather + failures on the Cray XT. These may become unecessary when PIO becomes + operational, but this approach is more robust than using MPI environment + variables to avoid the gather error. + + M models/utils/pilgrim/mod_comm.F90 + - added mp_sendirr_fc, mp_sendirr_fc_r4, mp_sendirr_fc_i4 + + M models/atm/cam/src/control/binary_io.F90 + M models/atm/cam/src/physics/cam/phys_grid.F90 + M models/atm/cam/src/control/cam_history.F90 + - call mpigathervr4 and mpigathervint instead of mpigatherv when + gathering r4 and int data, respectively + + M models/atm/cam/src/dynamics/fv/io_dist.F90 + - if ALTGATHER defined, call mp_sendirr_fc, + mp_sendirr_fc_r4 and mp_sendirr_fc_i4 instead of + mp_sendirr, mp_sendirr_fc and mp_sendirr_fc, respectively + + M models/atm/cam/src/control/wrap_mpi.F90 + - added new routines mpigathervr4 and mpigathervint; if ALTGATHER + defined, use point-to-point implementations of the gather + with flow control in mpigatherv, mpigathervr4, and migathervint + instead of MPI_GATHERV + +BG/P support: + M models/atm/cam/bld/Makefile.in + - added BGP section that works on ORNL BGP system; have not yet tried + on ANL BGP system + M models/atm/cam/bld/configure + - added bgp as -target_os option + M models/atm/cam/src/utils/abortutils.F90 + - added BGP to existing BGL ifdef + M models/atm/cam/src/physics/cam/zm_conv_intr.F90 + - BGP compiler bug workaround (having to do with an + optional parameter). Enabled only if BGP defined. + +Reproducible distributed sum + Extracted fixed-precision algorithm from phys_gmean and put into + a new module. New algorithm can be used with any distributed sum, not + just a global mean. Both fixed-precision and floating-point algorithms + are now always computed, and the relative difference is + returned in an optional parameter. The error tolerance + repro_sum_rel_diff_max is used in the calling routine (phys_gmean here) + to decide whether to just write out a warning message or to also + recompute using the original "master computes" nonscalable algorithm. + The recalculation occurs in phys_gmean if the namelist parameter + repro_sum_recompute is set to .true. + + M models/atm/cam/src/control/runtime_opts.F90 + - eliminated phys_float_repro_gmean, phys_fixed_repro_gmean, + phys_nonrepro_gmean, and phys_rdiff_warning_gmean ; added + repro_sum_rel_diff_max and repro_sum_recompute + + M models/atm/cam/src/physics/cam/phys_gmean.F90 + - replaced in-place algorithm with call to repro_sum + - deleted public routines phys_gmean_defaultopts, phys_gmean_setopts, + and private routine gmean_nonrepro + + M models/atm/cam/src/physics/cam/phys_grid.F90 + - made nlcols public for use in phys_gmean + +Alternative GEOPK routine + The calculation of geopotential to the kappa (geopk) is one of the + more expensive operators in the FV dycore when using a 2D domain + decomposition as it requires transposing from a YZ to an + XY decompostion and back again for each call. An existing + non-transpose-based alternative algorithm (geopk16) is not + reproducible unless quad precision is used, which is not + available on a number of platforms, such as the Cray XT. + A new optional algorithm, geopk_d, has been introduced that does + not require a transpose and is reproducible without requiring + quad precision. Performance using geopk_d is sometimes better + (and sometimes worse) than the other options. geopk_d + is enabled by setting the namelist parameter geopktrans + to 2. (Setting it to 0, the default, enbles geopk; setting it to 1 + enables geopk16.) A tuning parameter geopkblocks is used with geopk_d + to define the amount of overlap to try to exploit in this + distributed algorithm. The default is 1 (no overlap), while the + optimal choice appears to be approximately 3 when using large + latitude decompositions. However, the optimum is dependent on problem + size, processor count, and platform. In the process of introducing + this option, it was discovered that the non-transpose-based options + were no longer working due to the reworking of the omega calculation. + This has been fixed. + + M models/atm/cam/src/dynamics/fv/geopk.F90 + - added geopk_d + + M models/atm/cam/src/dynamics/fv/cd_core.F90 + - added call to geopk_d and bug fix + + M models/atm/cam/src/dynamics/fv/dyn_comp.F90 + - distributed algorithm bug fix + + M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + - added support for geopk_d + + M models/atm/cam/src/control/runtime_opts.F90 + - added geopkblocks namelist parameter + + M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 + M models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 + - added geopkblocks to spmd_dyn_defaultopts and + spmd_dyn_setopts + +Alternative transpose algorithm + A major source of communication overhead in FV when using + the 2D decomposition is the transposes between the YZ and XY + decompositions. The current Pilgrim/mod_comm implementation + supports both one-sided and two-sided MPI communication, and + both explicit buffer packing and MPI datatypes. Every effort + is made to overlap communication with computation by separating + the commands mp_sendirr and mp_recvirr. As an evaluation tool, + an alternative mechanism called mp_swapmirr has been introduced + that uses the swapm routine. mp_swapmirr gives up + the one-sided and MPI data type options and does not try to + overlap the communication. but it does enable + trying many different two-sided communication protocols, uses + a more efficient communication ordering, and has the ability + to transpose multiple fields simultaneously. This capability is + introduced initially into cd_core only, and is enabled by + setting the namelist parameter cd_core_swapm to .true. + Initial experiments indicate that mp_swapmirr is sometimes + more efficient. If this holds upon further investigation, + the relevant functionality will either be introduced + into the standard mod_comm routines or the new routine + will be used outside of cd_core as well. + + M models/atm/cam/src/dynamics/fv/cd_core.F90 + - added call to mp_swapmirr + + M models/utils/pilgrim/mod_comm.F90 + - added mp_swapmirr + + M models/atm/cam/src/control/runtime_opts.F90 + - added cd_core_swapm namelist parameter + + M models/atm/cam/src/dynamics/fv/dyn_comp.F90 + M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + - added support for mp_swapmirr (cd_core_swapm) + + M models/atm/cam/src/utils/spmd_utils.F90 + - added communicator argument to swapm (so that could + be used in FV); added optional parameters to override + communication protocol defaults + - changed default protocol to mpi_isend/mpi_irevc + (from mpi_sendrecv) as a general performance optimization + + M models/atm/cam/src/control/wrap_mpi.F90 + - added communicator argument to swapm + + M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 + M models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 + - added cd_core_swapm to spmd_dyn_defaultopts and + spmd_dyn_setopts + +MISCELLANEOUS + + M models/atm/cam/src/utils/spmd_utils.F90 + - changed default swapm MPI protocol to mpi_isend/mpi_irevc + (from mpi_sendrecv) as a general performance optimization + + M models/atm/cam/src/physics/cam/phys_grid.F90 + - changed message tags to differentiate from dycore message tags + + M models/atm/cam/src/control/cam_comp.F90 + - disabled output of spmdstats files unless SPMDSTATS defined + + M models/atm/cam/src/dynamics/fv/stepon.F90 + M models/atm/cam/src/dynamics/fv/io_dist.F90 + M models/atm/cam/src/dynamics/fv/inidat.F90 + M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + M models/atm/cam/src/dynamics/fv/te_map.F90 + M models/atm/cam/src/dynamics/fv/dryairm.F90 + - deleted unnecessary use statements or unused elements + in use statements + - (for some) changed CCP_PRT_PREFIX definition + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +052 sm382 TSM.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 8 +053 er382 TER.sh fmgpa1.9dh outfrq3s+1870_control 4+5s ............FAIL! rc= 5 +054 br382 TBR.sh fmgpa1.9dh outfrq3s+1870_control 6+3s ............FAIL! rc= 5 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 4 + +- "382" tests are existing failures which first occurred with introduction of XLF + 11.1 compilers on the IBM's, which is the default on bluevista and bluefire + +bangkok/lf95: all pass + +jaguar: all pass (using posttag tests) + +** ran tests both with and without cd_core_swapm = .true and + geoptrans = 2, with identical results. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_50 +Originator(s): mvr,jwolfe,pel,jrichter,jedwards +Date: 24 June 2008 +One-line Summary: change to critical froude number; fix to fv polar +filter; fix for memory bug in ccsm bgc runs; processor binding included +with mpirun calls for bluefire in test and template scripts + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +-Implement fft_flt flag to switch between the FFT filter always and a + combination FFT/algebraic filter. Make default FFT always. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/tests_posttag_blueice +D models/atm/cam/test/system/tests_pretag_blueice +-removed default test lists for decommissioned machine + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TCT.ccsm.sh +-test script modified to use ccsm scripts from cam sandbox rather than + external ccsm tag + +M models/atm/cam/test/system/test_driver.sh +-top level test script modified to remove code for decommissioned machine, + blueice and updated aix environment variables for bluevista,bluefire + +M models/atm/cam/test/system/tests_posttag_bluefire +M models/atm/cam/test/system/tests_posttag_bluevista +-modified sets of default pretag/posttag tests + +M models/atm/cam/test/system/input_tests_master +-added test of cam using cice as ice model (via ccsm scripts) + +M models/atm/cam/test/system/CAM_runcmnd.sh +-processor binding in mpirun.lsf calls; blueice cleanup + +M models/atm/cam/bld/run-ibm.csh +-processor binding in mpirun.lsf call; modified list of aix env vars + +M models/atm/cam/bld/namelist_files/namelist_definition.xml +-add definition for fft_flt. read from cam_inparm for now + +M models/atm/cam/src/control/runtime_opts.F90 +-read fft_flt from cam_inparm namelist + +M models/atm/cam/src/control/atm_comp_mct.F90 +-fix to bug which caused memory leak in bgc runs of ccsm + +M models/atm/cam/src/control/fv_control_mod.F90 +-Add fft_flt flag (namelist) to switch between FFT filter always and a + combination FFT/algebraic filter + +M models/atm/cam/src/physics/cam/gw_drag.F90 +-change fcrit2 from 0.5 to 1.0 + +M models/atm/cam/src/dynamics/fv/pft_module.F90 +-Implement fft_flt flag to switch between the FFT filter always and a + combination FFT/algebraic filter. Make default FFT always. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +019 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +021 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +024 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 7 +027 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +037 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +041 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +044 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +051 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +052 sm382 TSM.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 8 +053 er382 TER.sh fmgpa1.9dh outfrq3s+1870_control 4+5s ............FAIL! rc= 5 +054 br382 TBR.sh fmgpa1.9dh outfrq3s+1870_control 6+3s ............FAIL! rc= 5 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 4 +057 bl711 TBL.sh h5x8adm adia 9s ..................................FAIL! rc= 5 + +- baseline tests failed due to change to gravity wave constant and mods to the + fv polar filter + +- "382" tests are existing failures which first occurred with introduction of XLF + 11.1 compilers on the IBM's, which is the default on bluevista and bluefire + +bangkok/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +019 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +023 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +031 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +033 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +036 bl314 TBL.sh wg10dm outfrq3s 9s ...............................FAIL! rc= 7 +039 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +042 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +045 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +049 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +053 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +057 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +- baseline tests failed due to change to gravity wave constant and mods to the + fv polar filter + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +evaluations were assumed to have been done by the associated scientists +providing the source mods: Jaga Richter for the gravity wave change +and Peter Lauritzen for the fv polar filter change + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_49 +Originator(s): mvr,mvertens +Date: 12 June 2008 +One-line Summary: added support for new machine bluefire; enabled +create_newcase (of the ccsm scripts) to be called from within cam; +added code work-around for older pgi compilers + +Purpose of changes: +bluefire (the new IBM clustered system at NCAR based on the Power6 chip) +came online june 9th and blueice will be taken offline around june 16 + +we wanted the ability to do model runs from cam using the ccsm +scripts in order to benefit from the features these scripts offer, like: +swapping in other component models (like replacing csim for cice), +use of the ccsm run database to document model runs, etc. + +fix that went into cam3_5_48 corrected problems for pgi and pathscale +compilers as well as ifort, but not older versions (6.1-6) of pgi used +on cgd machines bangkok and calgary; a code work-around was added to +enable posttag testing on those machines while we wait for a compiler +upgrade + + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: +A models/atm/cam/test/system/tests_pretag_bluefire +A models/atm/cam/test/system/tests_posttag_bluefire +- default sets of tests for new machine bluefire + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/CAM_runcmnd.sh +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/test/system/test_driver.sh +- added support for new machine bluefire +M models/atm/cam/bld/cam.cpl7.template +- minor bug fixes +M models/atm/cam/src/physics/cam/tidal_diag.F90 +- code work-around for older versions of pgi compiler + M . +M SVN_EXTERNAL_DIRECTORIES +- new clm, scripts, cice tags; now grabbing clm bld directory with checkouts + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluefire: +052 sm382 TSM.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 8 +053 er382 TER.sh fmgpa1.9dh outfrq3s+1870_control 4+5s ............FAIL! rc= 5 +054 br382 TBR.sh fmgpa1.9dh outfrq3s+1870_control 6+3s ............FAIL! rc= 5 +055 bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 4 +- existing failures which first occurred with introduction of XLF 11.1 compilers + on the IBM's, which is the default on bluevista and bluefire + +bangkok/lf95: all pass + +calgary/pgi: just baselines failed (due to compiler bug in baseline tag) + +**additionally ran the ccsm test ERS_D.f19_f19.F.blueice (passed) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_48 +Originator(s): Francis Vitt +Date: 3 June 2008 +One-line Summary: changes for ifort compiler + +Purpose of changes: to compile with ifort compiler + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/physics/cam/tidal_diag.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/waccm_mozart/apex_subs.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): +cam3_5_47 +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_47 +Originator(s): Francis Vitt +Date: 29 May 2008 +One-line Summary: WACCM bug fixes and enhancements. + +Purpose of changes: + + Enhance science in WACCM chemistry and fix a few bugs. The enhancements + and bug fixes include: + - Updated chemistry to JPL-2006. + - Added ClOy and BrOy family tracers (CLY and BRY) to improve + conservation of Cl and Br during advection. + - Made photolysis more flexible by using label tags in the + preprocessor input file. + - Don't allow wet removal above 300 mb in polar region. + - Added tidal diagnostics. + - Updates in aurora code. + - Added the ability to input surface fields that are lat, and time + dependent only in addition to fields that are lon, lat, and time + dependent. + - Added F107, F107a, Kp, Ap to history tapes. + - Added offline waccm driver capability. + - Added capability to use the Judith Lean solar irradiance data. + - Added the radiative feed back option for stratospheric sulfur aerosols + +Bugs fixed (include bugzilla ID): + + Fixed bug in O2 data used in radsw for waccm + + Fixed inithist bug (bugzilla ID 715) + + Fixed a bug in mo_jlong which was producing jagged photolysis + rate profiles. There was in error in the calculation of the + ozone ratios used in the interpolations of the radiative source + functions. + + Fixed negative del_p bug in mo_jlong + +Describe any changes made to build system: + + Increased the number of advected tracers by two for waccm_mozart chemistry + + Added build-namelist use_cases for waccm: + - waccm_1950_smax + - waccm_1950_smin + - waccm_1995_smax + - waccm_1995_smin + - waccm_1950_ramped + - waccm_1953_ramped_qbo + +Describe any changes made to the namelist: + + Added new namelist options for offline driver + - met_rlx_top + - met_rlx_bot + - met_max_rlx + - met_fix_mass + - met_shflx_name + - met_qflx_name + - met_shflx_factor + - met_qflx_factor + - solar_photons_file + - strat_aero_feedback + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton, Francis Vitt + +List all subroutines eliminated: + +D models/atm/cam/src/chemistry/waccm_mozart/mo_read_chm_sim.F90 + +List all subroutines added and what they do: + +A models/atm/cam/bld/namelist_files/use_cases/waccm_1950_ramped.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smax.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1953_ramped_qbo.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smin.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1995_smax.xml +A models/atm/cam/bld/namelist_files/use_cases/waccm_1950_smin.xml + * new waccm use cases + +A models/atm/cam/src/chemistry/waccm_mozart/clybry_fam.F90 + * module added to manage setting the family tracer before advection + and to adjust the individual component species after advection + +A models/atm/cam/src/physics/cam/tidal_diag.F90 + * added tidal diagnostics for waccm + +A models/atm/cam/src/physics/cam/solvar_interface.F90 +A models/atm/cam/src/chemistry/waccm_mozart/solar_photons.F90 +A models/atm/cam/src/chemistry/waccm_mozart/solvar_woods.F90 +A models/atm/cam/src/chemistry/waccm_mozart/solvar_data.F90 + * Files added for the use of the Lean solar irradiance data + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + * changed default namelist files + - xs_short_file + - xs_long_file + - rsf_file + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/bld/namelist_files/namelist_definition.xml + * added new namelist options + - met_rlx_top + - met_rlx_bot + - met_max_rlx + - met_fix_mass + - met_shflx_name + - met_qflx_name + - met_shflx_factor + - met_qflx_factor + - solar_photons_file + - strat_aero_feedback + +M models/atm/cam/bld/namelist_files/use_cases/waccm_1995_climo.xml + * added default start_ymd setting + +M models/atm/cam/bld/config_defaults_waccm_mozart.xml + * increased nadv to 65 for waccm (BRY and CLY added) + +M models/atm/cam/src/control/cam_history.F90 + * fixed init hist bug + * added time-dimensional only fields 'f107', 'f107a', 'ap', 'kp' to the + history files in the same manor as 'co2vmr' + +M models/atm/cam/src/physics/cam/tphysbc.F90 + * invocation added to adjust the individual BRY and CLY family + tracers after advection + +M models/atm/cam/src/physics/cam/tphysac.F90 + * invocation added to set CLY and BRY family tracers before advection + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + * added tidal diagnostics for waccm + +M models/atm/cam/src/chemistry/waccm_mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_photo.F90 + * changes for tagged photolysis rates scheme + * changed max solar zenith angle to 97.01 degrees + * In subroutines jlong_hrates and jlong_photo corrected the + calculation of the O3 ratios used in the interpolations of + the radiative source functions + * Files changed for the use of the Lean irradiance data + +M models/atm/cam/src/chemistry/waccm_mozart/mo_chemini.F90 +M models/atm/cam/src/physics/cam/aerosol_radiation_interface.F90 +M models/atm/cam/src/physics/cam/radsw.F90 +M models/atm/cam/src/chemistry/waccm_mozart/woods.F90 +M models/atm/cam/src/chemistry/waccm_mozart/solvar_interface.F90 + * Files changed for the use of the Lean irradiance data + +M models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 + * set O2 mmr data to 0.23143 + * Added the ability to input surface fields that are lat, and time + dependent only in addition to fields that are lon, lat, and time + dependent. This is backwards compatible so the the "old" surface + data file can still be used. + +M models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + * history addfld calls added + * call to advance Lean irradiance data added + +M models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 + * history outfld calls added + * wetdep interface change + +M models/atm/cam/src/chemistry/waccm_mozart/mo_wetdep.F90 + * changed min pressure where wet removal is applied to + 300 mbar poleward of 60 degrees. + +M models/atm/cam/src/chemistry/waccm_mozart/efield.F90 + * write to iulog + +M models/atm/cam/src/chemistry/waccm_mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mag_parms.F90 + * Changes in aurora code supplied by Liying Qian + +M models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_strato_rates.F90 + * change for new JPL 2006 chemistry mechanism + +M models/atm/cam/src/chemistry/waccm_mozart/chem_mods.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_lu_solve.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_phtadj.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_nln_matrix.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_lu_factor.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_sim_dat.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_indprd.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_adjrxt.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_lin_matrix.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_setrxt.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_prod_loss.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_usrrxt.F90 +M models/atm/cam/src/chemistry/waccm_mozart/m_het_id.F90 +M models/atm/cam/src/chemistry/waccm_mozart/m_spc_id.F90 +M models/atm/cam/src/chemistry/waccm_mozart/m_rxt_id.F90 + * new code generated by the chemistry preprocessor + +M models/atm/cam/src/chemistry/waccm_mozart/mo_sad.F90 + * JF's change on lightning factor implementation + +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 +M models/atm/cam/src/dynamics/fv/uv3s_update.F90 +M models/atm/cam/src/dynamics/fv/metdata.F90 + * changes for offline waccm driver + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +047 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +These are expected to fail due to changes in waccm chemistry and the offline driver. + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_46 +Originator(s): mvr,pworley,robj,eaton,mvertens +Date: Tue May 27 MDT 2008 +One-line Summary: test scripts updated for new jaguar hardware and compilers; +updated to new clm,mct and scripts externals to address bugs; other bug fixes + +Purpose of changes: +jaguar returned to production with new quad-core processors - the test +scripts needed mods to work with the new hardware and pgi compilers (7.1-6) + +a new mct tag was released that addressed several cam bugs - one with fv +decomp and phys_loadbalance=0 on jaguar and the other with excessive writes +from processors other than the master + +a new clm tag addressed a bug in logic for do-albedo calculation + +numerous ccsm tests were failing due to bugs in the scripts used by the coupled +system, including a mismatch in the grids specified for the eul dycore + +new default aquaplanet initial files added to help in running pergro tests + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +- mods to reflect dir name change from ~models/lnd/clm2 to ~models/lnd/clm + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +- added default initial files for running in aquaplanet mode + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton + +List all subroutines eliminated: +D models/atm/cam/bld/run-sgi.csh +- run template script for obsolete machine 'tempest' removed + +List all subroutines added and what they do: +none + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_comp.F90 +M models/ocn/som/ocn_comp.F90 +M models/ice/csim4/ice_comp.F90 +M models/atm/cam/src/control/ncdio_atm.F90 +- mods needed for fix to bug in fv decomp with phys_loadbalance=0 on jaguar + +M models/atm/cam/test/system/test_driver.sh +- top level test script enabled for jaguar quad-core and 7.1-6 pgi compilers + +M models/atm/cam/bld/configure +- mods to reflect dir name change from ~models/lnd/clm2 to ~models/lnd/clm + +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-lightning.csh +- run template scripts now default to validating archives to mss with file + comparison + +M models/atm/cam/bld/camsom.cpl7.template +M models/atm/cam/bld/camcsim.cpl7.template +M models/atm/cam/bld/cam.cpl7.template +M models/atm/cam/bld/camdom.cpl7.template +- fixes for bugs when running as part of ccsm - including grid name mismatch + for eul dycore, initial file usage for start dates other than 1/1 and 9/1, and + other cleanup + +M models/atm/cam/bld/build-namelist +- only check that user has specified start_ymd when ncdata has been + specified when building namelists for standalone cam scripts. + +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +- added default initial files for running in aquaplanet mode + + M . +M SVN_EXTERNAL_DIRECTORIES +- new external code for clm,mct, and scripts + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: +all pass + +bangkok/lf95: +004 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +012 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 +- sld baseline tests fail due to a doalb bug fix introduced in clm3_6_03 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): bit-for-bit + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_45 +Originator(s): mvr,dennis,jedwards +Date: Thurs May 8 MDT 2008 +One-line Summary: code work-arounds for bluevista compiler problems; +new default initial conditions file for fv 0.47x0.63 and jan 1 start date + +Purpose of changes: +we're still waiting for ibm to provide a fix for problems with the new +xlf compiler (version 11.1)...in the meantime, jedwards has provided +code work-arounds for two cam files to enable running with two of +the configurations known to trigger problems... + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +added default initial conditions file at fv 0.47x0.63 w/ start date of jan 1 + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_comp.F90 +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +above files modified with code work-arounds for bluevista compiler problems +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +added default initial conditions file at fv 0.47x0.63 w/ start date of jan 1 +M models/atm/cam/bld/cam.cpl7.template +mod to make use of new default initial conditions file for fv 0.47x0.63, jan 1 +M models/atm/cam/test/system/test_driver.sh +minor fixes to top-level test script + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: ALL PASS + +bangkok/lf95: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_44 +Originator(s): eaton +Date: Wed May 7 14:44:38 MDT 2008 +One-line Summary: build-namelist mods + +Purpose of changes: + +. fix bug in waccm_1995_climo use case + +. update the Build::NamelistDefinition module with methods for creating + documentation from the definition xml file + +. extend build-namelist to write the /modelio/ namelists used by components + to redirect their log output to a named file. + +Bugs fixed (include bugzilla ID): +. fixed bug in waccm_1995_climo use case + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. add namelist variables used by components to redirect their log output to + named files. The new variables are + + atm_logfile - Name of file that the atmosphere component log messages will + be written to. Default: none + atm_logfile_diro - Absolute pathname of directory that the file specified + by atm_logfile will be written to. Default: "./" + cpl_logfile - Name of file that the driver component log messages will + be written to. Default: none + cpl_logfile_diro - Absolute pathname of directory that the file specified + by cpl_logfile will be written to. Default: "./" + lnd_logfile - Name of file that the land component log messages will + be written to. Default: none + lnd_logfile_diro - Absolute pathname of directory that the file specified + by lnd_logfile will be written to. Default: "./" + + Having each component write to it's own named log file is the default + when running with the ccsm4_alpha scripts. These new variables allow the + same flexibility when running with the standalone CAM scripts. The + default for the standalone CAM scripts remains that all components write + their log messages to stdout. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. extend to write /modelio/ namelists to component specific files + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. add new namelist variables for named logfiles + +models/atm/cam/bld/namelist_files/use_cases/waccm_1995_climo.xml +. fix broken root element (terminating tag missing leading slash) + +models/atm/cam/bld/perl5lib/Build/Namelist.pm +. convert embedded newlines to spaces before _parse_next method is called + by _split_namelist_value + +models/atm/cam/bld/perl5lib/Build/NamelistDefaults.pm +. add check that the defaults xml file has a root element + +models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm +. add methods for creating documentation from the definition xml file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_43 +Originator(s): mvertens,tcraig,mvr +Date: 080424 +One-line Summary: update to externals list of ccsm4_0_alpha28; + removed all code related to permutation of grid points; + minor modifications to test scripts + +Purpose of changes: permutation of grid points now handled within +mct code, so update to latest mct tag allowed removal of this code + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: mvertens,tcraig + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/wg10dh +- configuration options file replaced with one for mpi-only + +D models/atm/cam/test/system/tests_pretag_bluevista +- pretag testing will now be required on blueice + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/wg10dm +- new configuration options file for running test in mpi-only mode + +A models/atm/cam/test/system/tests_posttag_bluevista +- bluevista testing will now be done posttag + +A models/atm/cam/test/system/tests_pretag_blueice +- blueice will now be the required pretag platform for testing + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_comp_mct.F90 +M models/ocn/som/ocn_comp_mct.F90 +M models/ice/csim4/ice_comp_mct.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +- removed code related to permutation of grid points + +M models/atm/cam/test/system/test_driver.sh +- testing on jaguar will now use charge account specific to user; other + minor fixes + +M models/atm/cam/test/system/TER.sh +- minor fix to restart test script when using fv 2d decomposition + +M models/atm/cam/test/system/input_tests_master +- mod needed to have test run in mpi-only mode on bangkok/calgary/lightning + +M models/atm/cam/doc/ChangeLog_template +- mod to reflect pretag testing now required on blueice rather than bluevista + + M . +M SVN_EXTERNAL_DIRECTORIES +- updated to externals of ccsm4_0_alpha28 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: +ALL PASS + +bangkok/lf95: +ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change: b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_42 +Originator(s): eaton, mvertens +Date: Thu, 17 Apr 2008 14:42:08 +One-line Summary: misc mods for build, trop_mozart_prescribed_aero, cam-som + +Purpose of changes: + +. build-namelist mods: + - when user specifies ncdata require that start_ymd also be specified + - don't write dom namelist when ocn=none. similarly for csim when + ice=none. + +. configure mods: + - don't put utils/timing in filepath for build using ccsm scripts (they + build the timing lib separately) + +. Modify behavior of "-chem trop_mozart_prescribed_aero". This option has + been changed to allow one to use the prescribed mozart ozone via the + "prescribed_ozone_file" namelist option. If "prescribed_ozone_file" is + not set then the default cam ozone data is used for the radiation + calculation, just as before. + +. Modify DOM so that it writes TSOCN to CAM's initial file. This is needed + for CAM-SOM. + +. Add ENDOFRUN option to the inithist namelist variable. This allows an + initial file to be written only at the end of the run. + :N.B. this option won't be fully functional until mods are made to + CLM and to the driver code. + +Bugs fixed (include bugzilla ID): +. bugID 739 - don't write dom and csim namelists unless needed + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. add ENDOFRUN as possible value for inithist + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add check to require that the user specify start_ymd whenever ncdata has + been specified. +. don't write dom_inparm group to atm_in file if configuration ocn=none +. don't write csim_inparm group to atm_in file if configuration ice=none + +models/atm/cam/bld/configure +. remove timing lib from filepath for ccsm build + +models/atm/cam/bld/namelist_files/namelist_definition.xml +. make definition file consistent with new seq_timemgr_inparm and + seq_infodata_inparm namelist groups. +. changes to quite a few "catagory" attributes for documentation purposes +. add ENDOFRUN as valid value of inithist + +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/chem_mods.F90 +models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_sim_dat.F90 +. allow use of CAM-Chem prescribed ozone in trop_mozart_prescribed_aero + configuration. + +models/atm/cam/src/control/cam_history.F90 +models/atm/cam/src/control/runtime_opts.F90 +. add ENDOFRUN option to inithist + +models/ocn/dom/ocn_comp.F90 +. write TSOCN to cam initial file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: All PASS except +015 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 + +calgary/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +014 bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 7 +023 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 + +The failed tests are all baseline comparisons that fail due to the +appearance of a new field (TSOCN) in the initial file. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam3_5_41 +Originator(s): mvr,tcraig +Date: 080401 + +One-line Summary: +mods to test scripts in preparation of the decommission of machine +tempest; enhanced post-tag testing on jaguar; fix to cleanup problems in +cpl history file + +Purpose of changes: +machine tempest is being decommissioned on 4/5. the default tests +performed there as a requirement for committing to the cam developement +trunk had to be farmed out to other platforms. going forward, pretag +testing will be required on just two platforms, bangkok/lahey and +bluevista. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself,eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/fmgpa1.9h +D models/atm/cam/test/system/config_files/fmgpa1.9m +- removed obsolete configure options files + +D models/atm/cam/test/system/tests_pretag_tempest +- machine tempest being decommissioned + +D models/atm/cam/test/system/tests_posttag_bluevista +- post-tag tests on bluevista folded into post-tag blueice suite + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/e8dm +A models/atm/cam/test/system/config_files/e8idm +A + models/atm/cam/test/system/config_files/fmgpa1.9dh +A + models/atm/cam/test/system/config_files/fmgpa1.9dm +- new configure options files required for test scripts + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/tests_pretag_bangkok +M models/atm/cam/test/system/tests_pretag_bluevista +M models/atm/cam/test/system/tests_posttag_blueice +M models/atm/cam/test/system/tests_posttag_calgary +M models/atm/cam/test/system/tests_posttag_lightning +- new default test lists reflecting tests inherited from tempest + +M models/atm/cam/test/system/tests_posttag_jaguar_cb +M models/atm/cam/test/system/tests_posttag_jaguar +- enhanced list of tests for jaguar including performance testing, testing + of omp threading, pgi debug mode, and fv 2d decomposition + +M models/atm/cam/test/system/test_driver.sh +- removed references to machine tempest; minor fixes to jaguar directives + +M models/atm/cam/test/system/input_tests_master +- mods to master test list reflecting tweaks to tests farmed out of tempest + +M models/atm/cam/test/system/CAM_runcmnd.sh +- removed references to machine tempest; mod to jaguar run command enabling + ability to test in hybrid mode (spmd and smp) + +M models/atm/cam/doc/ChangeLog_template +- removed references to machine tempest + +M models/atm/cam/src/control/atm_comp_mct.F90 +- minor fix from tonyc where uninitialized data was causing problems + in the cpl history file + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +bl382 TBL.sh fmgpa1.9dh outfrq3s+1870_control 9s ..............FAIL! rc= 5 + +bangkok/lf95: +bl114 TBL.sh e8dm co2rmp 9s ...................................FAIL! rc= 5 +bl115 TBL.sh e8idm idphys 9s ..................................FAIL! rc= 5 + +- these baseline tests failed because their configurations were not + recognized by the scripts in the baseline code base + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_40 +Originator(s): Dani Coleman (bundy@ucar.edu) +Date: 28 Mar 2008 +One-line Summary: Fix pdeldry bug and remove cnst_need_pdeldry option + +Purpose of changes: +The bug caused the EUL dycore to fail when run with phys_loadbalance=2 and +cnst_need_pdeldry. Now the model always saves pdeldry, regardless of the constituents. + +Bugs fixed (include bugzilla ID): 388 (spmdbuf_siz needs to be increased in spectral Eulerian dycore) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +Removed cnst_need_pdeldry logic in all modified subroutines (now model +runs as if cnst_need_pdeldry = .true. ) + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 +M models/atm/cam/src/physics/cam/phys_gmean.F90 +M models/atm/cam/src/physics/cam/constituents.F90 +M models/atm/cam/src/physics/cam/physics_types.F90 +M models/atm/cam/src/physics/cam/physpkg.F90 +M models/atm/cam/src/physics/cam/zm_conv_intr.F90 +M models/atm/cam/src/dynamics/eul/scanslt.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/prognostics.F90 +M models/atm/cam/src/dynamics/eul/scandyn.F90 +M models/atm/cam/src/dynamics/eul/scan2.F90 +M models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + +Also changed buffer increment from 4 to 5. +M models/atm/cam/src/dynamics/eul/dp_coupling.F90 line 146 +M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 line 1065 + +Also calculate pdeldry in call to set_state_pdry. It either has to be +calculated here (like in the FV & SLD dycores) or passed back from the +dynamics (like in the EUL dycore) +M models/atm/cam/src/dynamics/homme/dp_coupling.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all pass + +tempest: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): n/a + +If bitwise differences were observed, how did you show they were no worse +than roundoff? n/a + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + n/a +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: n/a +URL for AMWG diagnostics output used to validate new climate: n/a + + +============================================================== + +Tag name: cam3_5_39 +Originator(s): mirin +Date: 3/21/08 +One-line Summary: Advect tracers simultaneously and allow finer decomp. with FV + +Purpose of changes: Several issues are addressed: + +A. Ability to advect multiple tracers simultaneously with FV + +Tracers may be divided into "trac_decomp" groups, with trac2d invoked +concurrently for the various groups. The additional groups are solved +using auxiliary computational processes. In particular, the kth group of +tracers is advected on the kth set of npes_yz processs. The relevant +namelist variable is trac_decomp, whose default is 1. The implementation +of this option is very similar to that of overlapping trac2d and +cd_core subcycles; however, these options are presently mutually exclusive. + +B. Ability to use larger FV domain decomposition + +The condition that a subdomain contain 3 vertical lines has been relaxed. +Subdomains need contain at least one vertical line. + +C. Bug fix and minor modification to mod_comm + +A bug was discovered that affects scenarios with more than 1024 processes +ONLY WHEN at least one of the modcomm_?? namelist variables equals 1. +This was remedied by changing some static arrays to allocatable. + +Also, the quantity "alloc_slack_factor" was changed to 8, to accommodate +certain fine-domain-decomposition scenarios. + +D. Allow new 64-bit netCDF format + +This is necessary for some high-resolution scenarios. The relevant +namelist variable is use_64bit_nc, which defaults as .false. + +E. Incorporate minor modification and bug fix from MVR + +Bug fix involves use with PGI. + +Bugs fixed (include bugzilla ID): + +Mod_comm bug (see item C above) and Makefile.in bug (see item E above). + +Describe any changes made to build system: + +Describe any changes made to the namelist: Namelist variables trac_decomp and use_64bit_nc +added. See items A and D above. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Sawyer + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/dynamics/fv: + +cd_core.F90 - post sends for simultaneous tracer advection; merge logic + with that of overlapping cd_core and trac2d subcycles; calling + arguments affected. + +dyn_comp.F90 - insert main logic for simultaneous tracer advection; merge + logic with that of overlapping cd_core and trac2d subcycles; these + two options are mutually exclusive. + +dynamics_vars.F90 - initialize necessary quantities for simultaneous + tracer advection. + +spmd_dyn.F90 - add communicator logic for simultaneous tracer advection; + relax requirement of 3 verticals per subdomain; fix a couple of minor + allocation bugs with auxiliary processes. + +trac2d.F90 - allow advection of a subset of tracers. + +models/atm/cam/control: + +cam_control_mod.F90 - add use_64bit_nc namelist variable for new 64-bit + netCDF format. + +cam_history.F90 - optionally invoke new 64-bit netCDF format when creating + netCDF history file. + +fv_control_mod.F90 - add trac_decomp namelist variable for concurrent + tracer advection. + +runtime_opts.F90 - add namelist variables use_64bit_nc and trac_decomp. + +models/utils/pilgrim: + +mod_comm.F90 - change InHandle and OutHandle from static to allocatable + arrays; change alloc_slack_factor to 5; add comments. + +models/atm/cam/bld: + +Makefile.in - incorporate Mat's corrections for PGI. + +cam.cpl7.template - allow one vertical per subdomain for FV + +camsom.cpl7.template - incorporate Mat's corrections for ccsm4. + +models/atm/cam/bld/namelist_files: + +namelist_definition.xml - add use_64bit_namelist, trac_decomp, and + ct_overlap (previously omitted). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: + +tempest: + +bangkok/lf95: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? Answers are BFB. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_38 +Originator(s): mvr, mvertens +Date: 080314 +One-line Summary: brought cam up to date with ccsm4_0_alpha25 driver + +Purpose of changes: To bring the ccsm4_0_alpha25 cam branch and other + ccsm4_0_alpha25 externals (primarily the drvseq2_0_10 driver) onto + the cam trunk. The cam "stand-alone" configuration (for both + cam/dom and cam/som) will always be run with the new driver + "ocean_tight_coupling" namelist option set to .true. The ocean + tight coupling option treats ocean model like lnd/ice in + coupling. When this is true, the updated state from the ocean is + merged with the updated state from the land and ice to create the + input atmospheric state. The updated state from the ocean is also + used in the atm/ocn flux calculation. When this is not true + (i.e. loose coupling) the previous state of the ocean is used + along with the updated state from the land and ice to be merged + into the input atmosphere. In addition, the previous state of the + ocean is used in the atm/ocn flux calculation too. Loose coupling + is the way pop2 is always coupled into the system and corresponds + to the way a concurrent ocean would be run. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: modified configure to + add new flexibility to bring in cice (which is + not the default yet) and added COUP_DOM as a CPP variable. + +Describe any changes made to the namelist: driver namelist modifications + +List any changes to the defaults for the boundary datasets: the following + sst datasets are now the defaults (since they have the correct + time and calendar attributes to run with the cice in prescribed mode) + + atm/cam/sst/sst_HadOIBl_bc_128x256_clim_c050526.nc + atm/cam/sst/sst_HadOIBl_bc_64x128_clim_c050526.nc + atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc + atm/cam/sst/sst_HadOIBl_bc_8x16_clim_c050526.nc + atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc + atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c061031.nc + atm/cam/sst/sst_HadOIBl_bc_10x15_clim_c050526.nc + +Describe any substantial timing or memory changes: + +Code reviewed by: mvertens + +List all subroutines eliminated: +D models/atm/cam/bld/run-pc-cice-docn7.csh +D models/atm/cam/bld/run-ibm-cice-docn7.csh + +List all subroutines added and what they do: +A + models/atm/cam/bld/cam.cpl7.template +A + models/atm/cam/bld/camdom.cpl7.template +A + models/atm/cam/bld/camsom.cpl7.template +A + models/atm/cam/bld/camcsim.cpl7.template + - the above were modified to enable cam stand-alone configurations + to run out of the ccsm4_0_alpha25 (and later) scripts + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_comp.F90 +M models/ocn/dom/ocn_comp_mct.F90 +M models/ocn/som/ocn_comp.F90 +M models/ocn/som/ocn_comp_mct.F90 + - interface changes needed to run with drvseq2_0_10 + +M models/ice/csim4/ice_comp.F90 +M models/ice/csim4/ice_comp_mct.F90 + - interface changes needed to run with drvseq2_0_10 + +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TPF.sh +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh + - changes needed to run with drvseq2_0_10 utilizing the + ocean_tight_coupling driver namelist option (see above) + +M models/atm/cam/bld/configure +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +M models/atm/cam/bld/namelist_files/namelist_definition.xml +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_definition.xml + - added new flags for ocn and ice configurations + - put in flexibility to run with cice in ccsm4_0_alpha25 + - modified driver namelist definition to be consistent with drvseq2_0_10 + - changed defaults sst datasets (see above) + - set ocean_tight_coupling to .true. (see above) + +M models/atm/cam/src/control/runtime_opts.F90 + - removed shr_orb_mod from use + - now broadcast obliqr,mvelpp,lambm0 instead of obliq,mvelp, iyear_ad + +M models/atm/cam/src/control/ccsm_msg.F90 + - removed psl as an allocatable array - now obtaining psl as in atm_comp_mct.F90 + via cam_out%psl + +M models/atm/cam/src/control/camsrfexch_types.F90 + - added psl to surface_state data type + +M models/atm/cam/src/control/cam_control_mod.F90 + - orbital variables modified to be consistent with drvseq2_0_10 + +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 + - modifications made necessary for interacting with drvseq2_0_10 + +M models/atm/cam/src/utils/time_manager.F90 + +M models/atm/cam/src/physics/cam/tphysbc.F90 + - surface_state2d (or in ccsm_msg, cam_out%psl) is now filled in via the + call to diag_phys_writeout + +M models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - removed references to COUP_CSM - added psl as an optional argument to + diag_phys_writeout instead of utilizing the COUP_CSM directive + +M models/atm/cam/src/physics/cam/co2_cycle.F90 + - removed COUP_CSM if-def + + M . +M SVN_EXTERNAL_DIRECTORIES +models/drv/seq_mct https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq2_0_10 +models/lnd/clm2/src https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/ccsm4a_tags/ccsm4a03_clm3_5_18/src +models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20080227 +models/ocn/docn7 https://svn-ccsm-models.cgd.ucar.edu/docn7/branch_tags/drva_docn7_070824_tags/drva11_docn7_071129 +models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/loga_share3_070903_tags/loga25_share3_071107 +models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_060616 +models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_070525 +models/utils/mct https://svn-ccsm-models.cgd.ucar.edu/mct/branch_tags/seqa_MCT2_3_0_070524_tags/seqa07_MCT2_4_2_071026 +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/seqmct_scripts_070823_tags/seqmct44_scripts_080108 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +026 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +030 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +034 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +037 bl374 TBL.sh fm1.9dh outfrq3s 9s ..............................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +044 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +048 bl382 TBL.sh fmgpa1.9h outfrq3s+1870_control 9s ...............FAIL! rc= 7 +052 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +059 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +tempest: +004 bl131 TBL.sh e32dh co2rmp 9s ..................................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +035 bl531 TBL.sh s32dh co2rmp 9s ..................................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +bangkok/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +035 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +039 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +043 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +047 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): ccsm4_0_alpha25 +- platform/compilers: blueice +- configure commandline: +som: +create_newcase -mach blueice -compset F_CAMSOM_CSIM -res f19_f19 -case /ptmp/mvr/f40.021 +dom: +create_newcase -mach blueice -compset F_CAMDOM_CSIM -res f19_f19 -case /ptmp/mvr/f40.017 + +- build-namelist command (or complete namelist): +see the entries for f40.017 and f40.021 in run database, http://ccsm-rundb.cgd.ucar.edu + + +- MSS location of output: + som: mss:/MVR/csm/f40.021 + dom: mss:/MVR/csm/f40.017 + +- MSS location of control simulations used to validate new climate: + som: mss:/MVR/csm/seqnoflxave06_cam3_5_24_som4 + dom: mss:/MVR/csm/seqnoflxave06_cam3_5_24 + +- URL for AMWG diagnostics output used to validate new climate: + som: mss:/MVR/csm/f40.021/f40.021-seqnoflxave06_cam3_5_24_som4.tar + http://www.cgd.ucar.edu/cms/mvr/f40.021 + dom: mss:/MVR/csm/f40.017/f40.017-seqnoflxave06_cam3_5_24.tar + http://www.cgd.ucar.edu/cms/mvr/f40.017 + + +=============================================================== +=============================================================== + +Tag name: cam3_5_37 +Originator(s): andrew, eaton +Date: Thu Mar 13 12:27:27 MDT 2008 +One-line Summary: Mods and bug fixes in MG microphysics and CLDTOP/CLDBOT indexes. + +Purpose of changes: + +. Mods and bug fixes for MG microphysics -- see details in changes to + prescribed_aerosols and cldwat2m modules below. + +. Fix bug in UW shallow convection scheme that was setting cloud top and + cloud bottom indexes incorrectly in cloud free columns. The chemistry + is the only parameterization affected by this bug. + +. Change the default averaging flag for radiative forcing and aerosol + indirect diagnostic output fields from 'I' to 'A' + +Bugs fixed (include bugzilla ID): + +. bug in cldtop/cldbot indexes (bugz ID 716) +. bug fixes for MG microphysics + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not checked + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/physics/cam/prescribed_aerosols.F90 +. modify dry_radaer for OCPHO,OCPHI,BCPHO,BCPHI,VOLC to 0.05e-6 (same as sulfate). + [this changes answers slightly, and makes the microphysical distributions + better in the model] + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. several bug fixes for diagnostic CCN output only [does not change answers] +. fix prodprec (prain) variable [changes answers only with prognostic aerosols] +. additional mod: put prodsnow and evapsnow into prain, evaprain + [changes answers only with prognostic aerosols: this fixes the + wet-deposition] + +models/atm/cam/src/physics/cam/mcshallow.F90 +. In compute_mcshallow change the initializers for cnt_out to 1 and for + cnb_out to pver. Only do it in the last of the 4 places where the + cnt_out/cnb_out values are set. This appears to be the section of code + that re-initializes values for columns with no convection. + +models/atm/cam/src/physics/cam/radiation.F90 +. change default averaging of radiative forcing diagnostics from 'I' to 'A' +. change default averaging of aerosol indirect forcing diagnostics from 'I' to 'A' + +models/atm/cam/src/physics/waccm/gw_drag.F90 +models/atm/cam/src/physics/waccm/mo_msis_ubc.F90 +. get pi from CAM's physconst module rather than from shr_const_mod. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: All PASS + +tempest: All PASS + +calgary/lf95: All PASS except + +029 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 + +bl315 is expected to fail due to changes to MG microphysics. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_34 + +Summarize any changes to answers: BFB except when MG microphysics is on + due to bug fixes in that code. + + Andrew has verified this code is reasonable both with our microphysical + diagnostics and with the standard diagnostics. + + Diagnostics at: + http://www.cgd.ucar.edu/cms/andrew/diag/nmicro2.65_cam3_5_36-obs/ + + Diagnostics for a pair of 2 year runs with the + fixed version (nmicro2.68) and the current version on the trunk + (cam3_5_36_MG) are at: + + http://www.cgd.ucar.edu/cms/andrew/diag/cam3_5_36_MG-nmicro2.68_cam3_5_36 + + Note that both of these are with the Morrison-Gettelman microphysics. + + +=============================================================== +=============================================================== + +Tag name: cam3_5_36 +Originator(s): eaton +Date: Mon Mar 3 10:11:54 MST 2008 +One-line Summary: bug fixes for build-namelist + +Purpose of changes: + +. Bug fixes for build-namelist -- see below. + +. Reimplement the -test option to build-namelist. This checks whether the + input datasets exist on the local disk. It's also an easy way to + generate a list of the input datasets required for the run. + +. Allow the phys_debug_util module to read its own namelist. The + implementation is meant to serve as an example for other modules for + which it's appropriate to read namelist input. The general design that + we've been moving towards is for modules to read their own namelist + rather than have all namelist variables live in one big namelist. The + new build-namelist utility makes it easy to define a new namelist group + and have that namelist group be written to the atm_in file simply by + adding an appropriate definition of the variables in the + namelist_definition.xml file. + +Bugs fixed (include bugzilla ID): + +. build-namelist wasn't validating namelist array variables that were specified + in the input as array elements. + +. build-namelist was not recognizing values in the -namelist argument when + the string contained embedded newlines. This happens when using the C + shell and splitting the -namelist arg into multiple lines. + +. build-namelist wasn't checking the date attributes in the default values + for finidat. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. phys_debug_lat and phys_debug_lon have moved to the new namelist group + phys_debug_nl. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. modify so that when a new namelist group is defined for the CAM + component that group will automatically be written to CAM's namelist + file. +. fix setting the default value of finidat to recognize the date + attribute. +models/atm/cam/bld/namelist_files/namelist_definition.xml +. move phys_debug_lat and phys_debug_lon into namelist group phys_debug_nl +models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm +. modify the _validate_pair method so that an index specifier is stripped + off of the variable name before checking whether it's in the definition + file. +models/atm/cam/bld/perl5lib/Build/Namelist.pm +. allow strings used to initialize Namelist objects to contain embedded + newlines. + +models/atm/cam/src/physics/cam/phys_debug_util.F90 +. add subroutine phys_debug_readnl to read the namelist. +models/atm/cam/src/control/runtime_opts.F90 +. remove phys_debug_lat, phys_debug_lon from cam_inparm +. add call to phys_debug_readnl + +models/atm/cam/src/physics/cam/convect_shallow.F90 +. add CLDTOP and CLDBOT to master field list for debugging. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: All PASS. + +tempest: All PASS. + +calgary/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_34 + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_35 +Originator(s): sungsu, pjr, pworley, mvr, eaton +Date: Fri Feb 15 17:15:40 MST 2008 +One-line Summary: Mods to PBL code; add physics debug utility; fix archiving script + +Purpose of changes: + +. Modifications to UW PBL scheme. (sungsu) + +. Add HBR option to eddy_scheme. (pjr) + +. Add flux_avg module which contains code to smooth the surface fluxes + to reduce instabilities in the surface layer. (pjr) + +. Add physics debugging utility code that allows easy location of the + closest column in the physics grid to a specified location. (pjr, pworley) + +. Some debugging code to help analyze how PBL schemes are behaving near the + surface has been left on the trunk until the CAM4 PBL scheme has been + verified. The debugging code will be removed once the verification has + taken place. (pjr, eaton) + +. Update external for scripts directory. *** N.B. *** This fixes a bug in + the archiving scripts introduced at cam3_5_31. (mvr) + +Bugs fixed (include bugzilla ID): Fix archiving script bug. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: added variables + +. logical rhminl_31 - to allow use of special value of rhminl in 31 layer model + (default: .false.) +. logical freeze_dry - to allow use of Vavrus "freeze dry" mod (default: .true.) +. integer srf_flux_avg - on=1/off=0 switch for code to adjust surface fluxes to + stabilize near surface layers (default: 0 if + eddy_scheme='HB', 1 otherwise ) +. real(r8) phys_debug_lat - requested latitude for debugging physics (degrees) +. real(r8) phys_debug_lon - requested longitude for debugging physics (degrees) + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not tested + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/flux_avg.F90 +. surface flux adjustments +models/atm/cam/src/physics/cam/phys_debug_util.F90 +. physics debugging utility +models/atm/cam/src/physics/cam/phys_debug.F90 +. user code for specific debugging output + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/namelist_files/namelist_definition.xml +models/atm/cam/src/control/runtime_opts.F90 +. add new namelist variables freeze_dry, rhminl_31, do_flux_averaging, + phys_debug_lat, phys_debug_lon +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. don't make outfld call for PSDRY if atm is dry +models/atm/cam/src/physics/cam/check_energy.F90 +. add message to log about status of printing conservation errors +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. add namelist variables + - rhminl_31 to allow use of special value of rhminl in 31 layer model + (default is .false.) + - freeze_dry to allow use of Vavrus "freeze dry" mod (default is .true.) +. change rhminh from .9 to .85 for UW shallow scheme without MG + microphysics, but leave it at .9 when UW is run w/ MG. +models/atm/cam/src/physics/cam/eddy_diff.F90 +. change default averaging of diagnostic output from instantaneous to + averaged +. mods from sungsu +models/atm/cam/src/physics/cam/hb_diff.F90 +. mods for HBR option +. add temporary debug code +models/atm/cam/src/physics/cam/initindx.F90 +. add register routine for flux averaging +models/atm/cam/src/physics/cam/mcshallow.F90 +. change default averaging of diagnostic output from instantaneous to + averaged +. set rdrag=1.0 (was 2.0) +. modify evprain expression +. change some hardcoded constants in qvten expression +models/atm/cam/src/physics/cam/phys_control.F90 +. add check for eddy_scheme='HBR' +. add namelist variable srf_flux_avg to control whether the flux averaging + code is turned on. +models/atm/cam/src/physics/cam/phys_grid.F90 +. add subroutine phys_grid_find_col +models/atm/cam/src/physics/cam/physconst.F90 +. add pi +models/atm/cam/src/physics/cam/physics_types.F90 +. add temporary debug code +models/atm/cam/src/physics/cam/physpkg.F90 +. add init call for physics_debug +. move tracer_init call to before exit for adiabatic/ideal physics +models/atm/cam/src/physics/cam/qneg4.F90 +. modify warning message +models/atm/cam/src/physics/cam/rayleigh_friction.F90 +. fix initialization of ptend +models/atm/cam/src/physics/cam/tphysac.F90 +. add optional call for surface flux averaging +models/atm/cam/src/physics/cam/tphysbc.F90 +. add temporary debug code +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. mods to UW code by Sungsu +. add HBR option to eddy_scheme +. add eddy_scheme as actual arg to init_hb_diff +. change default averaging from I to A for UW PBL diagnostic fields +. add temporary debug code +models/atm/cam/src/physics/cam/zm_conv_intr.F90 +. move assignment of nstep to top of zm_conv_tend + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: (used blueice due to XLF11 problem on bluevista): All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. + +=============================================================== +=============================================================== + +Tag name: cam3_5_34 +Originator(s): mvertens +Date: Tue Feb 5 23:19:00 MST 2008 +One-line Summary: minor bug fixes for cpl6 mode compatibilty + +Purpose of changes: fix a compiler problem on jaguar and put fix back + in (that was taken out of cam3_5_33) for coupling every time step + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M src/control/runtime_opts.F90 + - finished cleaning up uses of eshr_timemgr_mod and shr_inputinfo_mod + that are no longer needed +M src/control/ccsm_msg.F90 + - a fix was needed in ccsm_msg.F90 to match a corresponding correction + in the flux coupler to correctly specify the albedo shift and enable + communication every cam timestep - this fix was inadvertently taken + out of cam3_5_33 - and has been put back in +M src/control/cam_control_mod.F90 + - removed reference to flxave which was causing a compiler problem on + jaguar + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +all pass + +tempest: +all pass + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_32 + +Summarize any changes to answers: none, answers are bfb + +=============================================================== +=============================================================== + +Tag name: cam3_5_33 +Originator(s): mvertens +Date: Tue Feb 5 08:39:49 MST 2008 +One-line Summary: migrated all cpl7 framework references to xxx_comp_mct.F90 + +Purpose of changes: enable cam-cpl6 to run without reference to any cpl7 + data structures and move move all cpl7 framework references to xxx_comp_mct.F90 + (e.g. remove all references from cam_comp.F90, etc). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: new namelist, camcpl6_inparm, was introduced + that is independent of any cpl7 utilities. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + All framework specific data structures were moved into xxx_comp_mct.F90 + routies. + +M models/ocn/dom/ocn_comp.F90 +M models/ocn/dom/ocn_comp_mct.F90 +M models/ocn/som/ocn_comp.F90 +M models/ocn/som/ocn_comp_mct.F90 + - moved calls to routimemgr_init into ocn_comp_mct from ocn_comp.F90 + +M models/atm/cam/src/control/runtime_opts.F90 + - removed all references to shr_input_info or eshr_timemgr module routines + and variables. Obtaining data from sync clock, setting nsrest and getting + data from ccsminit object have been moved to atm_comp_mct.F90. + - removed routine runtime_options, now call read_namelist directly in + both cpl6 and cpl7 cam interfaces (call preset directly from read_namelist) + - removed flxave from cam_inparm and placed it in camcpl6_inparm + - removed broadcast for single column variables + +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/con_cam.F90 + - eliminated shr_input_info and eshr_timemgr references + - explicit use now made of camcpl6_inparm namelist input + +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 + +M models/atm/cam/bld/cam.cpl6.template + - modifications to get branch and hybrid tests working +M models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml + - removed reference to flxave +M models/atm/cam/bld/namelist_files/namelist_definition.xml + - removed reference to flxave +M models/atm/cam/bld/build-namelist + - removed reference to flxave + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +all pass + +tempest: +all pass + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none, answers are bfb + +=============================================================== +=============================================================== + +Tag name: cam3_5_32 +Originator(s): mvr,mvertens +Date: 080131 +One-line Summary: mods to enable cam to work with cpl7 + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +namelist 'timemgr_inparm' changed name to 'camcpl6_inparm' + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: mvertens,eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/cam.cpl6.template +M models/atm/cam/bld/build-namelist +M models/atm/cam/src/control/runtime_opts.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: not tested + +tempest: not tested + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_31 +Originator(s): mvr +Date: 080130 +One-line Summary: enable test_driver for jaguar (cray xt); now pulling in +entire ccsm scripts directory as external; mod to allow communication with +flux coupler every cam timestep + +Purpose of changes: +there was a need to perform regular cam testing on jaguar as reliance +on this machine for production use increases + +a bug fix was added to the archiving scripts, so the external for +its scripts tag needed updating...we eventually will need the ccsm +scripts available as the two systems merge, so we decided to pull +in the entire ccsm scripts directory as the external + +a fix was needed in ccsm_msg.F90 to match a corresponding correction +in the flux coupler to correctly specify the albedo shift and enable +communication every cam timestep + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +pgi compiler flags now include -Kieee; non-debug pgi compiler settings +now use '-fast -mvect=nosse' instead of -O1 + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: mvr,eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/fm2dh +- config options file with fv 2x2.5 replaced with one at fv 1.9x2.5 + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/wm1.9m +A models/atm/cam/test/system/config_files/e64sm +A models/atm/cam/test/system/config_files/fm1.9dh +A models/atm/cam/test/system/config_files/fm1.9m +A models/atm/cam/test/system/config_files/fma1.9m +A models/atm/cam/test/system/config_files/e64pm +A models/atm/cam/test/system/config_files/fmgpa1.9m +A models/atm/cam/test/system/config_files/e64am +- new config options files required for testing on jaguar + +A models/atm/cam/test/system/tests_posttag_jaguar +- new file containing the default set of tests for jaguar +A models/atm/cam/test/system/tests_posttag_jaguar_cb +- set of tests for jaguar containing just the configure/build's + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/test_driver.sh +- added functionality for testing on jaguar (cray xt) + +M models/atm/cam/test/system/tests_pretag_bluevista +M models/atm/cam/test/system/tests_posttag_blueice +- modified default test lists for testing on ibm's to reflect testing + fv 1.9x2.5 rather that fv 2x2.5 + +M models/atm/cam/test/system/input_tests_master +- master list of tests now include those added for jaguar + +M models/atm/cam/test/system/CAM_runcmnd.sh +- code added to properly build the run command on jaguar + +M models/atm/cam/bld/Makefile.in +- new default compiler settings for pgi + +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-pc-cice-docn7.csh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-sgi.csh +M models/atm/cam/bld/run-lightning.csh +- run template scripts modified to reflect new location of archive scripts + +M models/atm/cam/src/control/ccsm_msg.F90 +- fix to specify albedo shift correctly and enable communication with coupler + every cam timestep + + M . +M SVN_EXTERNAL_DIRECTORIES +- now pulling in entire ccsm scripts directory as external + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +all pass + +tempest: +all pass + +bangkok/lf95: +all pass + +calgary/pgf: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +035 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +039 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +043 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +045 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +047 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +all baselines fail due to changes to pgf compiler flags + +NOTE: tests of this cam tag within ccsm4 show that future mods will be required +including a minor fix to the new build-namelist and fixes to cam.cpl6.template + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all +- what platforms/compilers: pgf compilers only +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? pergro tests passed on calgary/pgf and jaguarcnl/pgf + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_30 +Originator(s): eaton +Date: Thu Jan 24 09:32:04 MST 2008 +One-line Summary: new version of build-namelist + +Purpose of changes: + +. A new version of build-namelist has been implemented with new features + which will make namelist generation more robust, as well as being easier + to extend and maintain. + + From the user perspective the biggest differences with the old version + are: + + - All valid namelist variables are known to build-namelist. So an + incorrectly specified variable from the user (supplied either by the + -infile or -namelist options) will cause build-namelist to fail with an + error message telling which namelist variable is invalid. This is a + big improvement over a runtime failure caused by an invalid variable + which typically gives no hint as to which variable caused the problem. + + - In addition to knowing all valid variable names and their types, + build-namelist also knows which namelist group each variable belongs + to. This means that the user only needs to specify variable names to + build-namelist and not the group names. The -infile and -namelist + options still require valid namelist syntax as input. But the group + name(s) is ignored. So all variables can be put in a single group with + an arbitrary name, for example, "&in ... /". + + From the developer perspective the main differences are: + + - New namelist variables added to existing namelist groups require adding + an entry to the definition file (namelist_definition.xml). If the new + variable has default values these are provided by modifying the + build-namelist script and possibly the defaults file + (namelist_defaults_cam.xml). + + - Implementing a new namelist group no longer requires writing a new perl + module. The variables are added following the same procedure used to + add a variable to an existing namelist group. + + The commandline interface to build-namelist has not been changed except + to remove the -cam_cfg option. This was used to specify the directory + containing the CAM configuration files. It's not needed because we + assume the files are located in directories relative to the one that + contains the build-namelist script being executed (which is known by + looking at $0). + + The -test option has not yet been implemented. + + The -v (verbose) option no longer accepts a value. It's an on switch. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: nrevsn + +nrevsn has been given component specific names. It's functionality is +unchanged. The new names for each component are: + +&cam_inparm nrevsn --> cam_branch_file +&csim_inparm nrevsn --> csim_branch_file +&dom_inparm nrevsn --> dom_branch_file +&som_inparm nrevsn --> dom_branch_file + + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: +models/atm/cam/bld/CAM_config.pm +models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultCCSM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultCSIM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultCTL_NL_Namelist.xml +models/atm/cam/bld/DefaultDOM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultFILTER_NL_Namelist.xml +models/atm/cam/bld/DefaultSOM_INPARM_Namelist.xml +models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml +models/atm/cam/bld/NamelistsDescriptions.xml +models/atm/cam/bld/SeqCCSM_namelist.pm +models/atm/cam/bld/cam_inparm.pm +models/atm/cam/bld/camexp.pm +models/atm/cam/bld/ccsm_inparm.pm +models/atm/cam/bld/clm_inparm.pm +models/atm/cam/bld/clmexp.pm +models/atm/cam/bld/compnl.pm +models/atm/cam/bld/csim_inparm.pm +models/atm/cam/bld/ctl_nl.pm +models/atm/cam/bld/dom_inparm.pm +models/atm/cam/bld/filter_nl.pm +models/atm/cam/bld/namelist.pm +models/atm/cam/bld/nl_descrips.pm +models/atm/cam/bld/prof_inparm.pm +models/atm/cam/bld/som_inparm.pm +models/atm/cam/bld/timemgr_inparm.pm +models/atm/cam/bld/use_cases/1870-2000_control.nl +models/atm/cam/bld/use_cases/1870_control.nl +models/atm/cam/bld/use_cases/1870_prog_aero.nl +models/atm/cam/bld/use_cases/1990_control.nl +models/atm/cam/bld/use_cases/waccm_1995_climo.nl + +List all subroutines added and what they do: +models/atm/cam/bld/namelist_files/namelist_defaults_cam.xml +models/atm/cam/bld/namelist_files/namelist_definition.xml +models/atm/cam/bld/namelist_files/use_cases/1870-2000_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_control.xml +models/atm/cam/bld/namelist_files/use_cases/1870_prog_aero.xml +models/atm/cam/bld/namelist_files/use_cases/1990_control.xml +models/atm/cam/bld/namelist_files/use_cases/waccm_1995_climo.xml +models/atm/cam/bld/perl5lib/Build/Namelist.pm +models/atm/cam/bld/perl5lib/Build/NamelistDefaults.pm +models/atm/cam/bld/perl5lib/Build/NamelistDefinition.pm +. files to implement new build-namelist + +List all existing files that have been modified, and describe the changes: +models/atm/cam/bld/build-namelist +models/atm/cam/bld/cam.cpl6.template +models/atm/cam/src/control/cam_restart.F90 +models/atm/cam/src/control/runtime_opts.F90 +. replace namelist variable nrevsn by cam_branch_file +models/atm/cam/test/system/TBR.sh +. change nrevsn to the component appropriate name. +models/atm/cam/test/system/TSM.sh +. remove -cam_cfg option from build-namelist command. +models/ice/csim4/ice_comp.F90 +. replace namelist variable nrevsn by csim_branch_file +models/ocn/dom/ocn_comp.F90 +. replace namelist variable nrevsn by dom_branch_file +models/ocn/som/ocn_comp.F90 +. replace namelist variable nrevsn by som_branch_file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_5_29 +Originator(s): andrew, edwards, worley, eaton +Date: Wed Jan 9 11:21:24 MST 2008 +One-line Summary: bug fixes for MG microphysics, aerosol optics, & misc + +| 24 Jan 2008, eaton, update ChangeLog for cam3_5_29 +| +| Andrew Conley let me know that the indexing bug in aer_optics.F90 +| shouldn't affect the default physics because in the original prescribed +| aerosols the longwave effect of seasalt and dust was zero. I verified +| this. The ChangeLog documention has been updated accordingly. + +Purpose of changes: + +. Bug fixes and diagnostics changes for MG microphysics. Also changed some + diagnostics from RK microphysics. Only affects simulations with MG + microphysics turned on. + +. Fix indexing bug in aer_optics.F90 which affects simulations where the + new seasalt and dust aerosols are radiatively active. + +. Add fix or workaround (not sure which) for a problem with the pgi + compiler on jaguarcnl. Compiler is failing on a declaration of a zero + size array which uses a scalar initializer. + +. Change entropy function (in zm_conv.F90) to return a real(r8) result. It + was returning a single precision result. This results in a larger than + roundoff difference in the simulations with default physics. + + Also replace the stop with an endrun call in the convergence checking + loop of subroutine ientropy (in zm_conv.F90). + + +Bugs fixed (include bugzilla ID): + +. bugz #683 - fix for single column output (was broken when making memory + use improvements in cam3_5_26). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/chemistry/trop_mozart/mo_extfrc.F90 +. initialize arrays has_extfrc and spc_fnames, which can potentially be of + size zero, in the extfrc_inti method rather than with initializers +models/atm/cam/src/control/cam_history.F90 +. fix for single column output +models/atm/cam/src/physics/cam/aer_optics.F90 +. fix indexing bug affecting new seasalt and dust optics +models/atm/cam/src/physics/cam/cldwat2m.F90 +. Snow bug fixed (morrison email 27 Nov 2007) Line 1523 changed. Top level + autoconversion bug fixed (line 1515-1516) Rain diagnostic output changed + to gridbox average (the first 2 change answers for MG microphysics only, + the third is diagnostic) +models/atm/cam/src/physics/cam/stratiform.F90 +. cloud fraction diagnostic calculations AFTER second cloud fraction call + to make in-cloud values consistent with outputed cloud fraction. changed + for MG and RK microphysics. This affects diagnostic in-cloud values in + RK and MG microphysics (icimr, icwmr in RK) Also: cleaned up in-cloud + diagnostics which were using ptend_loc after it was set to zero. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +017 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +026 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 4 +030 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +034 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +044 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 7 +048 bl382 TBL.sh fmgpa1.9h outfrq3s+1870_control 9s ...............FAIL! rc= 7 +052 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +054 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +059 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +tempest: All PASS except: +004 bl131 TBL.sh e32dh co2rmp 9s ..................................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +035 bl531 TBL.sh s32dh co2rmp 9s ..................................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +bangkok/lf95: All PASS except: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +035 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +039 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +043 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +045 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +047 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +** All baseline comparisons fail except for configurations using adiabatic or + ideal physics. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +. There are larger than roundoff changes in the default physics + configurations due to changing the entropy function from single to double + precision. + +. There are larger than roundoff changes to runs in which the new dust and + seasalt aerosols are radiatively active. + +. There are additional larger than roundoff changes in the MG microphysics + due to bug fixes. + +=============================================================== +=============================================================== + +Tag name: cam3_5_28 +Originator(s): eaton +Date: Fri Jan 4 16:34:15 MST 2008 +One-line Summary: refactor the adiabatic and ideal physics options + +Purpose of changes: + +. The ideal physics mode was broken when using the FV dycore. The + process of fixing that configuration inspired a refactoring of the + implementation of both adiabatic and ideal physics modes for all + dycores. The main features of the refactoring are: + - The dry atmosphere is implemented by setting the specific humidity to + zero rather than by setting physical constants for water vapor to + those for dry air. The Q field is no longer required on the initial + file for these modes. + - The condensed water species are no longer allocated and transported + around as inert species. + - The FV dycore is not called in a special mode but is called the same + way as when full physics forcings are applied. + - The adiabatic and ideal physics forcings are returned as tendencies and + applied to the state in the identical way that full physics forcings + are applied. + - The energy conservation for the FV dycore which is done in the physics + part of the code is now done in adiabatic and ideal modes identically + to how it's done in full physics mode. + - Eliminate write/read of fields from restart files that aren't used in + ideal/adiabatic modes. + +Bugs fixed (include bugzilla ID): +#677 - don't turn on co2 cycle code for CCSM_BGC==CO2A + +Describe any changes made to build system: + +. add "ideal" and "adiabatic" as valid values of configure's -phys option. + The reason for making adiabatic and ideal physics build time options is + that the condensed water species need not be allocated and transported + for these dry atmosphere configurations. For either of these physics + options only one advected specie is allocated (by default). + +Describe any changes made to the namelist: + +. No namelist variables changed. But since the adiabatic and ideal physics + modes are specified to configure, build-namelist knows about these modes + and can automatically add the appropriate namelist variable, i.e., either + setting atm_ideal_phys=.true. or atm_adiabatic=.true.. So the use does + not need to worry about setting a namelist variable for adiabatic or + ideal physics modes. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: didn't check + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/test/system/config_files/e32adh +models/atm/cam/test/system/config_files/e32idh +models/atm/cam/test/system/config_files/f4adh +models/atm/cam/test/system/config_files/f4idh +models/atm/cam/test/system/config_files/h5x8adm +models/atm/cam/test/system/config_files/h5x8idm +models/atm/cam/test/system/config_files/s32adh +models/atm/cam/test/system/config_files/s32idh +. new config files which use the -phys arg to configure to build CAM + for an adiabatic or ideal physics run. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +. remove unneeded PHYSICS attribute from ncdata entries so that the initial + files can be used for ideal/adiabatic physics modes + +models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml +. remove unneeded PHYSICS attributes. + +models/atm/cam/bld/cam.cpl6.template +. don't set -co2_cycle flag to configure, and don't set namelist variable + co2_flag=.true. when CCSM_BGC==CO2A + +models/atm/cam/bld/ccsm_inparm.pm +. use config_cache.xml to set atm_adiabatic/atm_ideal_phys namelist vars. + +models/atm/cam/bld/config_definition.xml +. add ideal and adiabatic as valid_values for phys. + +models/atm/cam/bld/configure +. add ideal and adiabatic as valid options for the -phys arg. These + options decrement the number of advected species by 2 (cldliq and + cldice). + +models/atm/cam/src/control/cam_comp.F90 +. remove actual arg etamid from call to phys_run1 + +models/atm/cam/src/control/cam_control_mod.F90 +. add moist_physics + +models/atm/cam/src/control/cam_history.F90 +. comment out the 'outfld' event timer + +models/atm/cam/src/control/hycoef.F90 +. add etamid + +models/atm/cam/src/control/runtime_opts.F90 +. set moist_physics + +models/atm/cam/src/control/startup_initialconds.F90 +. allow setting bnd_topo=' ' to override default set in build-namelist + +models/atm/cam/src/dynamics/eul/inidat.F90 +. initialize q=0 in adiabatic or ideal physics modes + +models/atm/cam/src/dynamics/fv/dp_coupling.F90 +. remove full_phys dummy arg from d_p_coupling and p_d_coupling +. remove full_phys conditionals -- keep only the full_phys=.true. branches +. remove full_phys actual arg from call to p_d_adjust +. remove dummy arg adiabatic from d_p_coupling +. change timer event tag from 'DP_CPLN: ctem' to DP_CPLN_ctem + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. make convt a module parameter set to .true., so the FV core is always + called in its "full physics" mode. +. remove convt as a dummy arg from dyn_run +. remove addfld calls for constituent tendencies that don't have + corresponding outfld calls. + +models/atm/cam/src/dynamics/fv/inidat.F90 +. initialize q=0 in adiabatic or ideal physics modes + +models/atm/cam/src/dynamics/fv/p_d_adjust.F90 +. remove full_phys dummy arg +. remove full_phys conditionals -- assume full_phys=.true. + +models/atm/cam/src/dynamics/fv/stepon.F90 +. remove full_phys logical. +. don't set zvir=0 for adiabatic/ideal physics. Set q=0 instead. +. use new moist_physics variable to control call to dryairm + (moist_physics = .not. adiabatic .and. .not. ideal_physics) +. remove full_phys as actual arg in calls to dyn_run, d_p_coupling, + p_d_coupling +. moist_phys is only used in call to fv_out to control whether or not + precip stats are output. +. remove adiabatic as actual arg in call to p_d_coupling + +models/atm/cam/src/dynamics/sld/inidat.F90 +. initialize q=0 in adiabatic or ideal physics modes + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. add outfld call for QRS to diag_init for ideal_phys run +. exit diag_init after basic state variables are added to history in case + of adiabatic or ideal physics run +. don't output RELHUM for dry atm + +models/atm/cam/src/physics/cam/check_energy.F90 +. modify so that cloud liq/ice don't need to be present. + +models/atm/cam/src/physics/cam/constituents.F90 +. add init of names for constituent diagnostics to cnst_chk_dim + +models/atm/cam/src/physics/cam/initindx.F90 +. if ideal/adiabatic phys then don't call the physics register routines +. move the init of constituent diagnostic names to cnst_chk_dim +. replace cph2o by cpwv +. move setting sflxnam, apcnst, hadvnam, vadvnam, fixcnam, tendnam, + ptendnam, dmetendname, tottnam to cnst_chk_dim subroutine in constituents + module. + +models/atm/cam/src/physics/cam/physconst.F90 +. set rh2o, cpvir, cpwv, zvir as parameters. +. remove rwat (duplicate of rh2o), and cph2o (duplicate of cpwv). + +models/atm/cam/src/physics/cam/physics_types.F90 +. add conditionals so special tests for cloud liq/ice aren't done when atm + is dry. +. remove unused "use" statements in physics_tend_init + +models/atm/cam/src/physics/cam/physpkg.F90 +. phys_init + - remove setting special values of physical constants for adiabatic/ideal + physics modes + - return early when ideal_phys or adiabatic + - move call to diag_init to happen before early exit for + ideal_phys/adiabatic modes + - move call to check_energy_init to happen before early exit for + ideal_phys/adiabatic modes +. phys_run1 + - remove dummy arg etamid + - remove actual args etamid and cam_in from call to + phys_run1_adiabatic_or_ideal + - move call to check_energy_gmean up so that it gets done whether using + ideal or full physics. +. phys_run1_adiabatic_or_ideal: + - remove call to geopotential_t since all versions of d_p_coupling make + this call. + - use physics_tend_init to initialize phys_tend + - update calling args to tphysidl + - remove dummy args cam_in, etamid + +models/atm/cam/src/physics/cam/qneg3.F90 +. use same criteria for printing error messages as is used by WACCM + +models/atm/cam/src/physics/cam/restart_physics.F90 +. don't write fields to restart files that aren't used when running + adiabatic/ideal physics. + +models/atm/cam/src/physics/cam/tphysidl.F90 +. Remove args for taux and tauy. These are inputs to the atm and are + initialized elsewhere. Don't know why tphysidl would be trying to set + these to zero. +. Remove etamid arg -- use hycoef module +. Have ideal physics algorithms set values in ptend, i.e., set dry static + energy tendency in ptend rather than temperature tendency in tend. +. use update_physics routine to update the output variable tend -- just like + it's done for the full physics routines. + +models/atm/cam/src/physics/cam/water_tracers.F90 +. replace cph2o by cpwv + +models/atm/cam/src/physics/cam/zm_conv.F90 +. replace rwat by rh2o + +models/atm/cam/test/system/input_tests_master +. move the specification for adiabatic and ideal physics tests out of the + namelist template and into the configure arguments + +models/atm/cam/test/system/nl_files/adia +. remove setting of atm_adiabatic -- done by build namelist based on + configuration. + +models/atm/cam/test/system/nl_files/idphys +. remove setting of atm_ideal_phys -- done by build namelist based on + configuration. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +009 bl134 TBL.sh e32adh adia 9s ...................................FAIL! rc= 5 +020 bl334 TBL.sh f4adh adia 9s ....................................FAIL! rc= 5 +057 bl534 TBL.sh s32adh adia 9s ...................................FAIL! rc= 5 + +bl134 and bl534: Diffs in fields depending on Q since it's now set to zero, but + identical otherwise. +bl334: Larger than roundoff diffs due to bug fixes. + +tempest: All PASS except: + +012 bl135 TBL.sh e32idh idphys 9s .................................FAIL! rc= 5 +029 bl335 TBL.sh f4idh idphys 9s ..................................FAIL! rc= 5 +043 bl535 TBL.sh s32idh idphys 9s .................................FAIL! rc= 5 + +bl135 and bl535: Q fields are different since now Q=0. Roundoff diffs in the + diagnostic field QRS. +bl335: Larger than roundoff diffs due to bug fixes. + +bangkok/lf95: All PASS except: + +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +047 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +These baselines fail due to a roundoff size diff in first appears in the +field DTH. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except roundoff in spectral dycores +with lf95, and larger that roundoff in FV ideal and adiabatic due to bug +fixes in those configurations. + +=============================================================== +=============================================================== + +Tag name: cam3_5_27 +Originator(s): mvr, mvertens +Date: 071212 +One-line Summary: +CAM will now couple to the surface components every CAM time step in a way +that mirrors the coupling mechanism in cpl6; orbital parameter orb_iyear_ad +will now default to 1990 rather than 1950. + +Purpose of changes: +This new coupling mechanism also solves the current problem whereby history +files were not obtained in the last month of production runs. Now when cam +and the surface components couple every cam time step, cam and clm do not +communicate with the driver at nstep=0. Backwards compatibility was maintained +to still permit the coupling of cam with the surface components on the cam +radiation time step. The cam tests now use coupling every time step as the +default approach. +Orbital parameter now matches that used in CCSM. + +Bugs fixed (include bugzilla ID): 592 + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- default coupling frequency is value of dtime from atmnl + +List any changes to the defaults for the boundary datasets: +- new default finidat, fatmlndfrc, focndomain files for fv1.9x2.5 at gx1v5 + +Describe any substantial timing or memory changes: + +Code reviewed by: mvertens, eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/nl_files/outfrq2h +- obsolete namelist file with move to coupling every cam timestep + +List all subroutines added and what they do: +A models/atm/cam/test/system/nl_files/outfrq3s +- new namelist file needed for testing when coupling every cam timestep + +List all existing files that have been modified, and describe the changes: +M models/ocn/som/mixed_layer.F90 +M models/ocn/som/ocn_comp.F90 +M models/ocn/som/somini.F90 +M models/ocn/som/ocn_comp_mct.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/con_cam.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 +- mods required for new default coupling frequency + +M models/atm/cam/test/system/test_driver.sh +- will now test ccsm with latest tag from ccsm3_9_beta series + +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/nl_files/fvvp_lb2 +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/fv1d_lb2 +M models/atm/cam/test/system/nl_files/idphys +M models/atm/cam/test/system/nl_files/co2rmp +M models/atm/cam/test/system/nl_files/fv1d_4tsk +M models/atm/cam/test/system/nl_files/fv2d_4tsk +M models/atm/cam/test/system/nl_files/scm_prep +M models/atm/cam/test/system/nl_files/fv1d_8tsk +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/fv2d_8tsk +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/microp_mg +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb3 +M models/atm/cam/test/system/nl_files/fvvp_lb0 +- namelist and run length settings tweaked for test scripts to reflect new + coupling frequencies + +M models/atm/cam/bld/cam.cpl6.template +M models/atm/cam/bld/timemgr_inparm.pm +M models/atm/cam/bld/SeqCCSM_namelist.pm +- scripts modified to include only the required namelist vars for coupled runs + +M models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultDOM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultCSIM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultSOM_INPARM_Namelist.xml +- new default files at gx1v5 for fv1.9x2.5; orb_iyear_ad now 1990 + + M . +M SVN_EXTERNAL_DIRECTORIES +- updated to drv/seq_mct/trunk_tags/drvseq1_0_62 and + clm2/branch_tags/seqccsm_clm3_5_08_tags/seqccsm10_clm3_5_11 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +004 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +009 bl134 TBL.sh e32dh adia 9s ....................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +017 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +020 bl334 TBL.sh f4dh adia 9s .....................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 5 +026 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +030 bl371 TBL.sh f1.9dm fvvp_lb2 9s ...............................FAIL! rc= 7 +034 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 5 +040 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +044 bl381 TBL.sh fma1.9h outfrq3s+1870_prog_aero 9s ...............FAIL! rc= 5 +048 bl382 TBL.sh fmgpa1.9h outfrq3s+1870_control 9s ...............FAIL! rc= 5 +052 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +054 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +057 bl534 TBL.sh s32dh adia 9s ....................................FAIL! rc= 7 +059 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 +061 bl711 TBL.sh h5x8dm adia 9s ...................................FAIL! rc= 7 + +tempest: +004 bl131 TBL.sh e32dh co2rmp 9s ..................................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +012 bl135 TBL.sh e32dh idphys 9s ..................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 5 +021 bl331 TBL.sh f4gdh co2rmp 9s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +029 bl335 TBL.sh f4dh idphys 9s ...................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +035 bl531 TBL.sh s32dh co2rmp 9s ..................................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +043 bl535 TBL.sh s32dh idphys 9s ..................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +calgary/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 9s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +035 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 4 +039 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 7 +043 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 7 +045 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 7 +047 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +-all baseline tests failed due to a combination of non-b4b changes introduced + and the altering of the test scripts that were not available in the baseline code + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_26 + +Summarize any changes to answers, i.e., +- what code configurations: ALL +- what platforms/compilers: ALL +- nature of change: larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): seqnoflxave06_cam3_5_24 +- platform/compilers: blueice/mpxlf90_r +- configure commandline: + som run: + $cfgdir/configure -dyn fv -res 1.9x2.5 -ocn som + + dom run: + $cfgdir/configure -dyn fv -res 1.9x2.5 -gensom + +- build-namelist command (or complete namelist): + som run: + $cfgdir/build-namelist -s -case $case -runtype $runtype \ + -namelist "&camexp stop_option='nmonths', stop_n=$stop_n \ + bndtvs='/fis/cgd/cseg/people/mvr/cam_mydata/som/seqnoflxave06_cam3_5_24_0011-0020_qflux.nc' \ + focndomain='/fs/cgd/csm/inputdata/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v4_070807.nc' / &clmexp \ + fatmlndfrc='/fs/cgd/csm/inputdata/lnd/clm2/griddata/fracdata_1.9x2.5_gx1v4_060808.nc' \ + finidat='/fs/cgd/csm/inputdata/lnd/clm2/inidata_3.1/cam/clmi_0000-09-01_1.9x2.5_gx1v4_c070309.nc' /" + + dom run: + $cfgdir/build-namelist -s -case $case -runtype $runtype \ + -namelist "&camexp stop_option='nmonths', stop_n=$stop_n start_ymd=101 / &clmexp \ + finidat='/fs/cgd/csm/inputdata/lnd/clm2/inidata_3.1/ccsm/clmi_0000-01-01_1.9x2.5_gx1v5_c070523.nc' /" + +- MSS location of output: + som: mss:/MVR/csm/seqnoflxave06_cam3_5_24_som4 + dom: mss:/MVR/csm/seqnoflxave06_cam3_5_24 + +- MSS location of control simulations used to validate new climate: + som: mss:/MVR/csm/cam3_5_24_som4 + dom: mss:/MVR/csm/cam3_5_24 + +- URL for AMWG diagnostics output used to validate new climate: + som: mss:/MVR/csm/seqnoflxave06_cam3_5_24_som4/seqnoflxave06_cam3_5_24_som4-cam3_5_24_control_som.tar + dom: mss:/MVR/csm/seqnoflxave06_cam3_5_24/seqnoflxave06_cam3_5_24-cam3_5_24_control.tar + + +=============================================================== +=============================================================== + +Tag name: cam3_5_26 +Originator(s): Jim Edwards +Date: 12/04/2007 +One-line Summary: Remove memory consuming arrays from cam_history + +Purpose of changes: Memory usage reduction + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + The pflds array of cam_history.F90 was replaced by a linked list. This + allows the masterlist to be allocated as needed instead of statically allocated + to the largest anticipated size. The hash table lookup feature of outfld is retained + by creating an array of pointers into the linked list. The sum result is a slight reduction of + performance of the outfld subroutine with up to 2x reduction in memory high water as measured on + bluevista. + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + add_entry_to_master - add an entry to the masterlist + init_masterlinkedlist - initialize the linkedlist + get_entry_by_name - lookup a masterlist entry by name + + +List all existing files that have been modified, and describe the changes: + cam_history.F90 - modified to remove pflds from masterlist and from tape structures + these are now allocated structures. pflds is now only used to support + reading fincl and fexcl from the namelist and has been reduced from 10000 + to 500. Changes required moving location of the variable varid in the restart + file, so there is a change in restart file format from previous versions. + cam_comp.F90 - call the init_masterlinkedlist function on startup + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS except: +051 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: all PASS except: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: all PASS except: +038 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +br532, br531, and br511 are pre-existing failures + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_25 +Originator(s): eaton +Date: Mon Dec 3 18:50:09 MST 2007 +One-line Summary: misc bugfixes + +Purpose of changes: + +. Merge bugfixes from the ccsm35 branch (between tags ccsm35_03_cam3_5_07 + and ccsm35_12_cam3_5_07) onto the trunk. + + These fixes change answers for the following CAM configurations. + - All WACCM configurations + - CAM-CHEM configurations "-chem trop_mozart" and "-chem + trop_mozart_aero" with the prognostic dust radiatively passive and the + old prescribed dust radiatively active. + +. Makefile.in change in AIX section to support new timing library. + +. Update the 1870-2000_control use case to use the version of prescribed + aerosol datasets that contains 10-year climatologies. + +. Update to the CAM-CHEM time interpolation codes to deal with input + datasets that contain gaps in a time series of monthly averages. + +. Change the check on the sum of cell areas when running with cpl6 from an + absolute to a relative error check. + +. Loosen check in interpolate_data module for what percent of interpolated + grid points fall outside the range of the data points. This check was + causing a 31 level model version to fail when interpolating the + noaamisc.r8.nc file for simple GHG chemistry. + +. Bugfix in co2_data_flux module (missing mpibcast). + + +Bugs fixed (include bugzilla ID): + +. Bugzilla id 667 - Fix iyear_ad bug in WACCM. + +. WACCM bugfix for H2O saturation table. + +. CAM-CHEM bug in old prescribed dust optics as described above. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. new default aerosol dataset for 1870-2000_control use case + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/Makefile.in +. changes in AIX section for new timing lib code + +models/atm/cam/bld/SeqCCSM_namelist.pm +. add tracer_cnst_filelist to use case hack. + +models/atm/cam/bld/use_cases/1870-2000_control.nl +. use aerosol dataset that contains 10 year climatologies + +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +. changes to namelist variables for 'INTERP_MISSING_MONTHS' option + +models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +. add mz_prescribed_dust function for dust aerosol optics bugfix + +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +. implement 'INTERP_MISSING_MONTHS' interpolation option + +models/atm/cam/src/chemistry/waccm_mozart/efield.F90 +models/atm/cam/src/chemistry/waccm_mozart/exbdrift.F90 +models/atm/cam/src/chemistry/waccm_mozart/mo_apex.F90 +. replace iyear_ad by magfield_fix_year + +models/atm/cam/src/chemistry/waccm_mozart/mo_jlong.F90 +. bugfix - need ptarget declared real + +models/atm/cam/src/chemistry/waccm_mozart/mo_sad.F90 +. replace with version from tag + waccm_qbo_cam3_5_04_tags/waccm_qbo04_cam3_5_18 (per Stacy). + +models/atm/cam/src/control/cam_control_mod.F90 +. add magfield_fix_year to set year of magnetic field in WACCM + +models/atm/cam/src/control/ccsm_msg.F90 +. Change check that cell areas sum to 4*pi from absolute to relative error. + +models/atm/cam/src/control/interpolate_data.F90 +. change check for %domain in extrapolation region -- was causing failure + of 31 level model when interpolating the noaamisc.r8.nc file for simple + GHG chemistry. + +models/atm/cam/src/control/runtime_opts.F90 +. add 'INTERP_MISSING_MONTHS' interpolation option for prescribed ozone, + tracer_cnst, and tracer_srcs +. replace 'diag TKE' by 'diag_TKE' + +models/atm/cam/src/physics/cam/aer_optics.F90 +. bugfix - old prescribed dust needs old dust optics + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. WACCM tuning mod +. replace 'diag TKE' by 'diag_TKE' + +models/atm/cam/src/physics/cam/co2_data_flux.F90 +. BGC bugfix - add missing mpibcast + +models/atm/cam/src/physics/cam/physpkg.F90 +. WACCM bugfix - call qbo_init +. move call aer_optics_initialize to after chem init (needed for the new + function mz_prescribed_dust) + +models/atm/cam/src/physics/cam/radae.F90 +. WACCM bugfix for H2O saturation table + +models/atm/cam/src/physics/cam/convect_shallow.F90 +models/atm/cam/src/physics/cam/phys_control.F90 +models/atm/cam/src/physics/cam/vertical_diffusion.F90 +. replace 'diag TKE' by 'diag_TKE' + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: +023 bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 4s ...............................FAIL! rc= 7 +044 bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +051 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +bl336 fails due to waccm bugfixes. +bl354, bl355, bl381 fail due to the dust optics bugfix +br532 is a pre-existing failure + +tempest: All PASS except: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +br531 is a pre-existing failure + +bangkok/lf95: All PASS except +038 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +br511 is a pre-existing failure + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except larger than roundoff changes in +- All WACCM configurations +- CAM-CHEM configurations "-chem trop_mozart" and "-chem + trop_mozart_aero" with the prognostic dust radiatively passive and the + old prescribed dust radiatively active. + +=============================================================== +=============================================================== + +Tag name: cam3_5_24 +Originator(s): tcraig, dennis, eaton +Date: Tue Nov 27 18:32:47 MST 2007 +One-line Summary: MPI fixes + +Purpose of changes: + +. Update the driver external to camxa01_drvseq1_0_57. This tag is + seqmct1_0_57 with mods from John Dennis to fix the + mpicom problems and fix a memory leak. + +. Add the file cam.cpl6.template to CAM's bld directory for CCSM build + system modifications being implemented in the ccsm3_9_betaXX series. + +Bugs fixed (include bugzilla ID): see above. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/cam.cpl6.template +. used by new build system being implemented in ccsm3_9_betaXX series. + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. set external for models/drv/seq_mct to + $REPO/drv/seq_mct/branch_tags/camxa_drvseq1_0_57_tags/camxa01_drvseq1_0_57 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS except: +051 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: all PASS except: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: all PASS except: +038 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +br532, br531, and br511 are pre-existing failures + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_23 +Originator(s): Art Mirin +Date: November 17, 2007 +One-line Summary: Overlap of dynamics and tracer FV subcycles + +Purpose of changes: +This version supports overlap of trac2d and cd_core subcycles. This refers to the +subcycles described by the "do 2000 n=1,n2" loop in dyn_run and has nothing to do +with the "do it=1,nsplit" lower-level subcycling. Each trac2d call (n), other +than the last, is overlapped with the subsequent cd_core 'series' (n+1). + +This capability becomes relevant as we go to higher and higher resolution and +operate with more and more tracers. Best results are obtained when the dynamics +and tracer times are comparable (for example, operating with more than the default +number of tracers) and when there is a high degrees of subcycling (for example, at +0.47x0.63 with nspltrac=8). + +The controlling namelist variable is ct_overlap. The overlapping trac2d calls are +carried out on the second set of npes_yz processes (npes_yz <= iam < 2*npes_yz). +The tracer arrays are sent to the auxiliary processes prior to the do-2000 loop. +During each subcycle (other than the last), the dp0 array is sent prior to the +cd_core series; arrays cx, cy, mfx, mfy are sent directly from cd_core during +the last call in the series (it=nsplit). At the completion of the last auxiliary +trac2d subcycle (n=n2-1), the updated tracer values are returned to the primary +processes; the last tracer subcycle (n=n2) is carried out on the primary processes. +Communication calls are nonblocking, with attempt to overlap computation to the +extent possible. The CCSM mpi layer (wrap_mpi) is used. Tags with values greater +than npes_xy are chosen to avoid possible interference between the messages sent +from cd_core and the geopk-related transpose messages called from cd_core +thereafter. The auxiliary processes must use values of jfirst, jlast, kfirst, +klast corresponding to their primary process antecedents, whereas by design +those values are (1,0,1,0), resp. (set in spmdinit_dyn). We therefore add +auxiliary subdomain limits to the grid datatype: jfirstct, jlastct, kfirstct, +klastct. For the primary processes, these are identical to the actual subdomain +limits; for the secondary processes, these correspond to the subdomain limits of +the antecedent primary process. These values are communicated to the auxiliary +processes during initialization (spmd_vars_init). During the auxiliary +calculations (and allocations) we temporarily set jfirst equal to jfirstct, etc., +and when done, restore to the original values. Other information needed by the +auxiliary processes is obtained through the grid datatype. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +New variable ct_overlap (default 0). If nonzero, overlap cd_core and trac2d +subcycles as desdribed above; if nonzero, do not overlap. When overlapping, +the number of processes must be at least as large as twice the size of the +latitude-vertical decomposition. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Sawyer, Worley, Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +utils/pilgrim: + mod_comm.F90 - compute process index relative to local communicator +src/control: + fv_control_mod.F90 - add ct_overlap flag + runtime_opts.F90 - add ct_overlap namelist variable +src/dynamics/fv: + cd_core.F90 - post communication for arrays needed by trac2d on auxiliary processes + dyn_comp.F90 - principal routine modified to accomplish cd_core/trac2d overlap + dynamics_vars.F90 - communicate subdomain limits to auxiliary trac2d processes + spmd_dyn.F90 - define additional 2yz communicator + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +051 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: +038 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_22 +Originator(s): mvr, mirin, eaton +Date: 071116 +One-line Summary: added tests for running with fv decomposition; various +other bug fixes + +Purpose of changes: +needed to beef up testing of the various fv decomposition settings as features +are being added; updating to newer drv tag fixes PGI testing (done post-tag) +which started failing with cam3_5_19; files need to have the same name as the +module they contain - an offender was introduced in cam3_5_20; build-namelist +has not been placing certain variables that are required in multiple namelists + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +build-namelist will now properly place bndtvs and focndomain into both the ocn +and ice namelists + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: mvr,mirin,eaton + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam/ghg_defaults.F90 +- file renamed to match the module name it contains + +List all subroutines added and what they do: +A + models/atm/cam/src/physics/cam/ghg_data.F90 +- new filename to match the module name it contains + +A models/atm/cam/test/system/config_files/f1.9dm +- new configuration options file for testing fv decomposition in mpi only + +A models/atm/cam/test/system/nl_files/fvvp_lb2 +A models/atm/cam/test/system/nl_files/fv1d_lb2 +A models/atm/cam/test/system/nl_files/fv1d_4tsk +A models/atm/cam/test/system/nl_files/fv1d_8tsk +A models/atm/cam/test/system/nl_files/fvvp_lb0 +- new namelist options files for testing fv decomposition in various modes + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES +- updated to drvseq1_0_57 which contain bug fixes to map_ocnaocn_mct.F90 - this + was tripping up PGI testing; updated to latest tag for archiving scripts + +M models/atm/cam/test/system/tests_pretag_bangkok +M models/atm/cam/test/system/tests_pretag_bluevista +M models/atm/cam/test/system/tests_posttag_blueice +M models/atm/cam/test/system/tests_posttag_calgary +M models/atm/cam/test/system/tests_posttag_lightning +- added new tests of fv decomposition to default pre/post tag test lists + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- mods in support of new fv tests; increased wall clock for lightning testing + +M models/atm/cam/test/system/input_tests_master +- new fv tests; bug fix with specification of resolution for ccsm tests + +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-pc-cice-docn7.csh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-sgi.csh +M models/atm/cam/bld/run-lightning.csh +- modified the default long-term archive root path + +M models/atm/cam/bld/SeqCCSM_namelist.pm +- bug fix for namelist variables needing inclusion on multiple namelists (bndtvs, focndomain) + +M models/atm/cam/src/physics/cam/volcanicmass.F90 +- small bug fix in volcanic_initialize + +M models/atm/cam/src/dynamics/fv/sw_core.F90 +- fix to bug introduced in cam3_5_21 where the new coding excluded a needed + pole-related computation + +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +- bug fix in call to mpi_comm_split where the value of 'color' was set + to a negative number + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: +030 bl371 TBL.sh f1.9dm fvvp_lb2 4s ...............................FAIL! rc= 5 +051 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +- bl371 is a new test, so a failure was expected with the baseline code +- br532 is pre-existing failure + +tempest: All PASS except: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +- br531 is pre-existing failure + +bangkok/lf95: All PASS except: +038 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 +- br511 is pre-existing failure + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_21 +Originator(s): Art Mirin +Date: November 6, 2007 +One-line Summary: Addition of Rayleigh friction and Putman filtering (FV) + +Purpose of changes: + +CAM has been augmented with the capability to apply Rayleigh +friction or additional filtering (FV). The purpose is to counteract +the effects of a polar jet that appears in the upper portions +of the model, particularly at higher resolution. The jet, the +extent of which is believed to be non-physical and progressively +worse as the resolution increases, can force the model to run at +a prohibitively low time step. + +Additionally, an update to the Pilgrim parutilitiesmodule.F90, +courtesy of John Dennis, is included. The purpose of the +update is to reduce memory requirements. This is needed +particularly for running on BG/L at moderate to high resolution. + +Also included in this update is pointing model/drv/seq_mct to +drvseq1_0_56. + +Rayleigh friction: Frictional term is applied with an adjustable +vertical profile based on hyperbolic tangent; lost kinetic energy +is converted to potential energy. Namelist variables are as follows: + rayk0 - vertical index of peak (default 2). + raykrange - determines width of profile; if 0., default width + is chosen; see rayleigh_friction.F90. + raytau0 - approximate decay time (days) at top of model; + default of 0. means no Rayleigh friction. + +Filtering: Capability to optionally filter intermediate c-grid winds, +courtesy of Bill Putman. Majority of code changes due to necessity +of computing c-grid winds before call to c_sw. Namelist variable is: + filtcw - yes (1), no (0). Default is 0. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +New namelist variables are (for Rayleigh friction) rayk0, raykrange and +raytau0; and (for Putman filtering) filtcw. See above for descriptions. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +src/physics/cam: rayleigh_friction.F90: new Rayleigh friction routine. + +List all existing files that have been modified, and describe the changes: + +utils/pilgrim/parutilitiesmodule.F90: added capability (courtesy +of John Dennis) to reduce memory of decompositions; see precompile +flag _SMEMORY, which is presently set at the beginning of +parutilitiesmodule.F90. + +src/control: + +fv_control_mod.F90: added filtcw flag (1 for Putman filtering, +0 for none; default is 0). + +runtime_opts.F90: Read in 4 new namelist variables. + +src/physics/cam: + +physpkg.F90: call rayleigh_friction_init. +tphysac.F90: call rayleigh_friction_tend and subsequent physics_update. + +src/dynamics/fv: + +cd_core.F90: call new routine for c-grid winds (d2a2c_winds). +Communicate prior to c_sw call. Eliminate ALT_PFT option. + +dyn_comp.F90: Pass through filtcw namelist variable. + +dynamics_vars.F90: Pass through filtcw namelist variable. + +inital.F90: Pass through filtcw namelist variable. + +pft_module.F90: Eliminate ALT_PFT option. +restart_dynamics.F90: Pass through filtcw namelist variable. + +sw_core.F90: Add subroutine d2a2c_winds. Eliminate coding that it replaced. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: (per Mat Rothstein) +045 br532 TBR.sh s32sdh ghgrmp 4+2s..............FAIL! rc=11 + +tempest: +034 br531 TBR.sh s32dh co2rmp 4+2s ..............FAIL! rc=11 + +bangkok/lf95: +037 br511 TBR.sh s8c8mdm ttrac 4+2s .............FAIL! rc=11 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_20 +Originator(s): Andrew Conley +Date: 11/01/07 +One-line Summary: + Move (CAM) data descriptions of gas constituents to pbuf + +Purpose of changes: + Preparation for implementation of Radiative Constituents interface. + Note that CAM/CHEM (MOZART) data gasses have not yet been moved. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + Memory for prescribed gas fields is now allocated in the + physics buffer rather than module variables. (Not + substantial?) + +Code reviewed by: myself, Brian Eaton + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam/rad_cnst_data_interface.F90 + Module no longer necessary for override from mozart/chem data +specification. + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/initindx.F90 + data models of gas distributions registrations with pbuf are called +M models/atm/cam/src/physics/cam/ghg_defaults.F90 + O2 added as a data model gas + CO2 is now added as a data gas through this interface + Access to pbuf is passed to this module + ghg's register with pbuf + ghg's update values with timestep (advnce) + local memory deleted for data gasses + remove "ghg_defaults_get_cnst()" +M models/atm/cam/src/physics/cam/radheat.F90 + add pbuf to radheat_tend argument list so that waccm override has access. +M models/atm/cam/src/physics/cam/radiation.F90 + O2 is now accessed from rad_constituents + remove call to unused/inoperative aerosol_indirect method + generalized co2_col_mean code to work for O2 and CO2 + pass o2 to radcswmx +M models/atm/cam/src/physics/cam/radsw.F90 + pass o2 rather than specifying it as a data statement +M models/atm/cam/src/physics/cam/chem_surfvals.F90 + add o2mmr data specification in this module +M models/atm/cam/src/physics/cam/ozone_data.F90 + use pbuf to store data description rather than local memory + add "ozone_data_register" + rm unused ozone_data_final + add "ozone_data_get_cnst" +M models/atm/cam/src/physics/cam/physpkg.F90 + rm call to "ghg_defaults_init" + add pbuf to call advnce(phys_state, pbuf) +M models/atm/cam/src/physics/cam/rad_constituents.F90 + modified logic to use pbuf representations of data gases, + unless a number of complex overrides are present. Read + the logic for your particular case if interested. +M models/atm/cam/src/physics/cam/prescribed_aerosols.F90 + rm unused/inoperable aerosol_indirect subroutine +M models/atm/cam/src/physics/cam/advnce.F90 + add access to pbuf +M models/atm/cam/src/physics/waccm/nlte_lw.F90 + add access to pbuf so code can access data O3 +M models/atm/cam/src/physics/waccm/radheat.F90 + add access to pbuf +M models/atm/cam/src/chemistry/trop_mozart/rad_cnst_data_interface.F90 + remove calls to CAM versions of data gasses. +M models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 + add data prescription of oxygen + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +004 bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +017 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +026 bl337 TBL.sh f4dh fv2d_8tsk 4s ................................FAIL! rc= 7 +028 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +031 bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +034 bl355 TBL.sh fmo2dh off2x2.5 4s ...............................FAIL! rc= 7 +038 bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +042 bl382 TBL.sh fmgpa1.9h outfrq2h+1870_control 4s ...............FAIL! rc= 7 +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +046 bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +053 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +tempest: +004 bl131 TBL.sh e32dh co2rmp 4s ..................................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +009 bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq2h 4s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4gdh co2rmp 4s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +035 bl531 TBL.sh s32dh co2rmp 4s ..................................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + + +calgary/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 4s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 4s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 2s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 4s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 4s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 2s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 4s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 4s ...............................FAIL! rc= 7 +034 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 +038 bl511 TBL.sh s8c8mdm ttrac 4s .................................FAIL! rc= 7 +042 bl512 TBL.sh s8sdm ghgrmp 4s ..................................FAIL! rc= 7 +046 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +The following failures were preexisting: +bluevista + 045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +tempest + 034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +calgary/lf95 + 037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +Almost all baseline tests fail since this commits a roundoff level change. +This code produces roundoff level changes since we use a mass-weighted +average value of a constant value instead of the constant value for CO2 +and O2. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: waccm/mozart prognostic O2 is now used by +radiation +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff, verified by cprncdf and visual inspection. + larger than "roundoff" for waccm/mozart + +If bitwise differences were observed, how did you show they were no worse +than roundoff? cprncdf on Temperature field + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +Summarize any changes to answers: roundoff + +=============================================================== +=============================================================== + +Tag name: cam3_5_19 +Originator(s): mvertens +Date: Wed Oct 31 13:59:52 MDT 2007 +One-line Summary: updated externals to ccsm4_0_alpha07 + +Purpose of changes: Bring cam trunk up to date with sequential ccsm + code base + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: see below + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: + A bld/run-ibm-cice-docn7.csh + - temporary script to run with cice-docn7 outside of cpl7 scripts + (recommendation is to always use cpl7 scripts) + +List all existing files that have been modified, and describe the changes: + + M models/ocn/dom/ocn_comp_mct.F90 + M models/ocn/som/ocn_comp_mct.F90 + M models/ice/csim4/ice_comp_mct.F90 + M models/atm/cam/src/control/atm_comp_mct.F90 + - made routines compatible with drvseq1_0_55 + + M models/atm/cam/src/control/con_cam.F90 + - removed call to shr_inputInfo_initRestArchive + M models/atm/cam/src/control/print_memusage.F90 + - added BGL flag + + M models/atm/cam/bld/configure + - stand-alone: added drv/seq_mct/driver to Filepath + - cpl7: added drv/seq_mct/driver to Filepath and ccsm_seq flag to specify that cam + is being built from cpl7 scripts + M models/atm/cam/bld/config_definition.xml + - added ccsm_seq switch + + M SVN_EXTERNAL_DIRECTORIES + - using following new externals (https://svn-ccsm-models.cgd.ucar.edu is implied in path below) + models/drv/seq_mct drv/seq_mct/trunk_tags/drvseq1_0_55 + models/lnd/clm2/src clm2/branch_tags/seqccsm_clm3_5_08_tags/seqccsm08_clm3_5_11/src + models/ice/cice/src cice/trunk_tags/cice4_0_20071022 + models/ocn/docn7 docn7/branch_tags/drva_docn7_070824_tags/drva05_docn7_070824 + models/csm_share csm_share/branch_tags/loga_share3_070903_tags/loga15_share3_071012 + models/utils/esmf_wrf_timemgr esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_060616 + models/utils/timing timing/trunk_tags/timing_070525 + models/utils/mct mct/branch_tags/seqa_MCT2_3_0_070524_tags/seqa06_MCT2_4_2_071026 + models/atm/cam/archiving scripts/trunk_tags/scripts_070907b/ccsm_utils/Tools/archiving + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all tests passed except for +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 9 + +tempest: all tests passed except for +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +bangkok/lf95: all tests passed except for +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 9 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none, answers are bfb + +=============================================================== +=============================================================== + +Tag name: cam3_5_18 +Originator(s): Jim Edwards +Date: 10/24/07 +One-line Summary: update of homme dycore + +Purpose of changes: merge recent development of homme dycore into trunk + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + added support for homme ne21np4 resolution + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + get_dyn_grid_parm added to dyn_grid.F90 for all dycores + given a string name of an integer parameter, return the value + of that parameter, return -1 if that parameter is not valid in a + given dycore. + +List all existing files that have been modified, and describe the changes: + Bulk update of HOMME dycore from development in the standalone homme + repository and in branch homme_cam3_5_01 +M 6985 models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/filter_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/forcing_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/reduction_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/schedule_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/derivative_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/prim_si_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/domain_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/surfaces_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/control_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/physics_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/element_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/time_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/hybvcoord_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/baroclinic_inst_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/dof_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/solver_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/external/bndry_mod.F90 +M 6985 models/atm/cam/src/dynamics/homme/dycore.F90 +M 6990 models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M 6985 models/atm/cam/src/dynamics/homme/initcom.F90 +M 6985 models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M 6985 models/atm/cam/src/dynamics/homme/stepon.F90 +M 6985 models/atm/cam/src/dynamics/homme/dyn_comp.F90 + + Added get_dyn_grid_parm which replaces use pmgrid functionality + and allows the removal of several #ifdef macros in cam_history +M 6985 models/atm/cam/src/dynamics/sld/dyn_grid.F90 +M 6985 models/atm/cam/src/dynamics/eul/dyn_grid.F90 +M 6985 models/atm/cam/src/dynamics/fv/dyn_grid.F90 +M 6985 models/atm/cam/src/control/cam_history.F90 + + Support for homme grid resolution ne21np4 +M 6985 models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +M 6985 models/atm/cam/bld/config_horiz_grid.xml + + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All pass except preexisting and homme + 055 bl711 TBL.sh h5x8dm adia 4s ...................................FAIL! rc= 7 + since have not yet established a climate for the homme dycore no perturbation growth was run. + +tempest: All pass except preexisting. + +bangkok/lf95: All pass except preexisting. + +The following failures were preexisting: +bluevista + 045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +tempest + 034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +bangkok/lf95 + 037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_17 +Originator(s): Pat Worley, Brian Eaton, James B. White III +Date: 10/18/07 +One-line Summary: introduction of scalable gmean algorithms; +replacement of gavglook by gmean_mass (which calls gmean) + +Purpose of changes: improve performance and memory scalability of +field mean calculations in the physics + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: cam_inparm (in atm_in) +has optional parameters phys_float_repro_gmean, phys_fixed_repro_gmean, +phys_nonrepro_gmean, phys_rdiff_warning_gmean (see descriptions below) + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: for large processor counts, +significant improvement in performance + +Code reviewed by: Worley and Eaton + +List all subroutines eliminated: + + gavglook (in physpkg.F90) + - replaced by gmean_mass + +List all subroutines added and what they do: + + phys_gmean_defaultopts (in phys_gmean.F90) + - get default phys_gmean runtime options + + phys_gmean_setopts (in phys_gmean.F90) + - set phys_gmean runtime options + + gmean_mass (in phys_gmean.F90) + - compute global mean mass of constituent fields on physics decomposition + - replacement for gavglook; calls gmean + + gmean_float_repro (in phy_gmean.F90 - private to module) + - gmean algorithm used in cam3_5_16 (preserved until future clean-up check-in) + - implementation calls gather_chunk_to_field and computes 2D mean on masterproc + - selected by setting phys_float_repro_gmean = .true. in cam_inparm namelist + - if selected, this value is used instead of that produced by other gmean + algorithms + + gmean_fixed_repro (in phy_gmean.F90 - private to module) + - fixed-point-based, scalable, reproducible gmean algorithm + - implementation calls mpi_allreduce twice + - on by default, but can be turned on/off by setting + phys_fixed_repro_gmean = .true./.false. in cam_inparm namelist + + gmean_nonrepro (in phy_gmean.F90 - private to module) + - floating-point-based, scalable, nonreproducible gmean algorithm + - implementation calls mpi_allreduce once + - on by default, but can be turned on/off by setting + phys_nonrepro_gmean = .true./.false. in cam_inparm namelist + - when used with gmean_fixed_repro, result from gmean_nonrepro used only + to check that gmean_fixed_repro result is accurate; error criterion + set using phys_rdiff_warning_gmean mac_inparm namelist. Default value is + phys_rdiff_warning_gmean = 1.e-13_r8 + +List all existing files that have been modified, and describe the changes: + + atm/cam/src/control/cam_comp.F90 + atm/cam/src/physics/cam/physpkg.F90 + - gmean_mass replacement for gavglook + + atm/cam/src/control/cam_history.F90 + - fix of SYPD performance calculation when doing restarts + + atm/cam/src/control/ccsm_msg.F90 + atm/cam/src/dynamics/eul/dyn_grid.F90 + atm/cam/src/dynamics/fv/dyn_grid.F90 + atm/cam/src/dynamics/homme/dyn_grid.F90 + atm/cam/src/dynamics/sld/dyn_grid.F90 + atm/cam/src/physics/cam/phys_grid.F90 + - change in get_horiz_grid_d call to return both areas and integration + weights (optional parameters); used to eliminate necessity of dycore-specific + implementations in new gmean algorithms + + atm/cam/src/control/mpishorthand.F + atm/cam/src/utils/spmd_utils.F90 + - support for fixed-precision gmean algorithm + + atm/cam/src/control/runtime_opts.F90 + - gmean runtime options + + atm/cam/src/physics/cam/phys_gmean.F90 + - new and old gmean algorithms and routines to control which to use + - gmean_mass replacement for gavglook + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: ALL PASS except + +015 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +017 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +026 bl337 TBL.sh f4dh fv2d_8tsk 4s ................................FAIL! rc= 7 +028 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +031 bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +038 bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +042 bl382 TBL.sh fmgpa1.9h outfrq2h+1870_control 4s ...............FAIL! rc= 7 +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: ALL PASS except + +017 bl314 TBL.sh wg10dh outfrq2h 4s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4gdh co2rmp 4s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: ALL PASS except + +016 bl311 TBL.sh f10c8mdm ttrac 4s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 4s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 2s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 4s .............................FAIL! rc= 7 +032 bl317 TBL.sh f10dm fv2d_4tsk 4s ...............................FAIL! rc= 7 +034 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +The following failures were preexisting: +bluevista + 045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +tempest + 034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +bangkok/lf95 + 037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +Changing the gmean calculation is not bit-for-bit when using the +FV dycore (but is for the spectral dycores). Thus all FV comparisons +to the baseline failed. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: FV dycore using new gmean algorithms. Using old + algorithm (phys_float_repro_gmean), the results are bit-for-bit +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? perturbation growth test on bluevista + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_5_16 +Originator(s): mvr, mvertens, mirin +Date: 071009 +One-line Summary: bug fix for gensom utility (temporary); cleanup of +getfil routine; line length bug fix for code entered in prev tag; new +resolutions for ocnfrac input files + +Purpose of changes: the gensom utility broke with cam3_5_01 where +the string variables passed between components were being truncated +when the max length was exceeded - a temporary fix, extending the +length of the strings was put into the drv code...the getfil routine +still had logic trying to locate files remotely if not present on +local disc - this should have been cleaned up with cam3_5_11...lines +of fortran code cannot exceed 132 chars on tempest compilers - new +code from cam3_5_15 needed to be split into two lines + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +new ocnfrac datasets at 1,1/2,1/4 deg fv + +Describe any substantial timing or memory changes: + +Code reviewed by: mvr,mvertens + +List all subroutines eliminated: +none + +List all subroutines added and what they do: +none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/bld/DefaultDOM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultCSIM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultSOM_INPARM_Namelist.xml +- new resolutions added to default settings for ocnfrac files +M models/atm/cam/src/control/ioFileMod.F90 +- further cleanup of getfil to only search local disc for file +M models/atm/cam/src/physics/cam/stratiform.F90 +- shortened length of line that trips up compiler on tempest (sgi/irix) +M SVN_EXTERNAL_DIRECTORIES + M . +- updated drv branch tag to pull in temporary fix for lengths of strings + passed between components + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: All PASS except: + +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except: + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: All PASS except: + +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +The failures are pre-existing. + +CAM tag used for the baseline comparison tests if different than previous +tag: needed to use cam3_5_14 on tempest to get around compiler problem +with line length + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_15 +Originator(s): andrew, eaton +Date: Thu Oct 4 18:44:20 MDT 2007 +One-line Summary: fix MG microphysics diagnostics; update CLM datasets; new + use cases + +Purpose of changes: + +. MG microphysics: Add fixes for diagnostics and add new radar reflectivity + diagnostics. + +. Update the CLM datasets for 1 degree and higher resolutions. + +. Add new build-namelist -use_case options: + 1870-2000_control -- CAM configuration for running 1870-2000 CCSM controls + waccm_1995_climo -- WACCM 1995 climatology + +. Modify co2vmr value in 1990_control use case to be consistent with the + value in the CCSM scripts. + +. Modify WACCM code not to use iyear_ad because it is not available when + running in the CCSM environment. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. Updated the CLM datasets for 1 degree and higher resolutions + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/use_cases/1870-2000_control.nl +models/atm/cam/bld/use_cases/waccm_1995_climo.nl +. new use case files + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. look for valid use case names in the use_cases directory. Now this file + doesn't need to be updated when new use cases are added. + +models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +. update a WACCM lbc_file entry + +models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +. update CLM files for 1 degree and higher resolutions + +models/atm/cam/bld/SeqCCSM_namelist.pm +. add code to add the data root directory to the relative pathnames + that are specified in the use case namelist files. + +models/atm/cam/bld/cam_inparm.pm +models/atm/cam/bld/dom_inparm.pm +. mods so that relative paths can be specified in use case files + +models/atm/cam/bld/namelist.pm +. modify code in sub parse that's responsible for finding the line of the + input file that contains the namelist group name. + +models/atm/cam/bld/use_cases/1990_control.nl +. update co2vmr to match specification in CCSM + +models/atm/cam/src/chemistry/waccm_mozart/exbdrift.F90 +. use the model year instead of iyear_ad in call to subsol. iyear_ad is + currently not available to CAM when running in CCSM. + +models/atm/cam/src/control/srfxfer.F90 +. always set cam_out%co2diag; not just when co2_transport==.true. + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. mods for radar reflectivity calculation + +models/atm/cam/src/physics/cam/prescribed_aerosols.F90 +. fix units of aerosol number concentration fields in history files + +models/atm/cam/src/physics/cam/stratiform.F90 +. add radar reflectivity fields +. use state instead of state1 in call to collect_sw_aer_masses + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +023 bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except: + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: All PASS except: + +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +bl336 is failing due to using the model year rather than iyear_ad in the +WACCM code for the ExB calculation. + +br511, br531, br532 are pre-existing failures. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_10 + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_14 +Originator(s): mvr +Date: 070925 +One-line Summary: all writes of model log output to unit 6 were replaced +with writes to a variable logical unit - allows for a move to a unique +unit number with assigned log file in the future + +Purpose of changes: sorting through the log output of a coupled +run was complicated by various components all dumping to stdout; +assigning unique unit numbers with associated log files for each +component will clear some of the confusion + +Bugs fixed (include bugzilla ID): 447 (partially) + +Describe any changes made to build system: +- added option to configure to indicate that CAM is being built from within +sequential CCSM scripts + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, mvertens, eaton + +List all subroutines eliminated: +D models/atm/cam/src/control/linebuf_stdout.c +- removed obsolete code + +List all subroutines added and what they do: +A models/atm/cam/src/control/cam_logfile.F90 +- added new module for managing the logical unit of cam's output log + +List all existing files that have been modified, and describe the changes: + +- too many to list!! +- every file with writes to stdout was modified to use a variable unit number + instead...what follows are mods made in addition to these + +M models/atm/cam/bld/configure +M models/atm/cam/bld/config_definition.xml +- added option to indicate that CAM is being built from within sequential + CCSM scripts + +M models/atm/cam/src/control/con_cam.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 +- moved call to spmdinit up one level to ease the redirection of share + output to cam's log output + +M models/atm/cam/src/physics/cam/convect_ke_intr.F90 +M models/atm/cam/src/physics/cam/icarus_scops.F90 +- replaced usage of hardcoded unit numbers with calls to share code for + unique unit numbers + +M input_tests_master +- modified resolutions used for testing of ccsm through cam + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except: + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +calgary/lf95: All PASS except: + +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +The failures are pre-existing. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_13 +Originator(s): eaton +Date: Thu Sep 20 17:45:00 MDT 2007 +One-line Summary: Reduce memory use + +Purpose of changes: + +. Reduce memory use. + +. Update the csm_share tag to trunk_tags/share3_070918 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. Memory use in the FV core was reduced by eliminating the allocation of 4 + unnecessary 3D arrays in inidat. + +. Memory use was reduced when absorptivity/emissivity restart files are + read/written by breaking the read and write of the abs/ems arrays into + smaller pieces so no more than a single 3D global array of temporary + storage is required. Previously PLEVP 3D arrays were being + simultaneously allocated. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. change csm_share to trunk_tags/share3_070918 + +models/atm/cam/src/dynamics/fv/inidat.F90 +. remove 4 unneeded 3D arrays + +models/atm/cam/src/physics/cam/restart_physics.F90 +. Break the read and write of the abs/ems arrays into smaller pieces so no + more than a single 3D global array of temporary storage is required. + Previously PLEVP 3D arrays were being simultaneously allocated. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except: + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: All PASS except: + +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +The failures are pre-existing. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_10 + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_5_12 +Originator(s): jet, mariana +Date: Tue Sep 18 15:00:16 MDT 2007 + +One-line Summary: SCM fixes, brought clm external up to latest commit, + added focndomain changes. + +Purpose of changes: Fixed outstanding problem with SCM not being able + to read land initial data, also refactored the way scm mode + determines whether land/ocn/ice is present by using new focndomain + boundary dataset. Required analogous changes to drv,share,clm + externals. + +Bugs fixed (include bugzilla ID): 480, 612 + +Describe any changes made to build system: new focndomain file is now + provided by configure + +Describe any changes made to the namelist: ocn_in has focndomain boundary + data file + +List any changes to the defaults for the boundary datasets: new focndomain + file is now required to have ocean fraction data. + +Describe any substantial timing or memory changes:none + +Code reviewed by:jet + +List all subroutines eliminated: + +D models/atm/cam/src/control/setlatlonidx.F90 + + moved this file's functionality into a share module that all + components can use. + +List all subroutines added and what they do: + + +List all existing files that have been modified, and describe the changes: + M models/ocn/dom/sst_data.F90 - uses new shr_scam_mod_file + M models/ocn/dom/ocn_comp.F90 - fixes for focndomain + M models/ocn/dom/ocn_comp_mct.F90 - fixes for focndomain + M models/ocn/som/ocn_comp.F90 - fixes for focndomain + M models/ocn/som/ocn_comp_mct.F90 - fixes for focndomain + M models/ice/csim4/ice_data.F90 - uses new shr_scam_mod_file + M models/ice/csim4/ice_comp.F90 - fixes for focndomain + M models/ice/csim4/ice_comp_mct.F90 - fixes for focndomain + M models/atm/cam/bld/som_inparm.pm - fixes for focndomain + M models/atm/cam/bld/configure - fixes for focndomain + M models/atm/cam/bld/run-pc-cice-docn7.csh - fixes for focndomain + M models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml - fixes for focndomain + M models/atm/cam/bld/cam_inparm.pm - fixes for focndomain + M models/atm/cam/bld/DefaultDOM_INPARM_Namelist.xml - fixes for focndomain + M models/atm/cam/bld/dom_inparm.pm - fixes for focndomain + M models/atm/cam/bld/DefaultCSIM_INPARM_Namelist.xml - fixes for focndomain + M models/atm/cam/bld/DefaultSOM_INPARM_Namelist.xml - fixes for focndomain + M models/atm/cam/bld/csim_inparm.pm - fixes for focndomain + M models/atm/cam/src/control/runtime_opts.F90 - fixes for focndomain + M models/atm/cam/src/control/ncdio_atm.F90 - scam bug fix + M models/atm/cam/src/control/scamMod.F90 - uses new shr_scam_mod_file + M models/atm/cam/src/control/startup_initialconds.F90 - merge marianas mods for focndomain + M models/atm/cam/src/control/filenames.F90 - merge marianas mods for focndomain + M models/atm/cam/src/control/cam_history.F90 - uses new shr_scam_mod_file + M models/atm/cam/src/physics/cam/prescribed_aerosols.F90 - uses new shr_scam_mod_file + M models/atm/cam/src/physics/cam/gw_drag.F90 - scam bug fix + M models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 - uses new shr_scam_mod_file + M models/atm/cam/src/dynamics/eul/iop.F90 - scam refactor changes + M SVN_EXTERNAL_DIRECTORIES - point to new external directories + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All ccsm tests fail due to new external shr code requirements for clm, atm, and, drv + +bluevista: +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_5_08 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? bfb + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_11 +Originator(s): mvr +Date: 7 Sep 2007 +One-line Summary: replacing inline archiving of model output with +scripts for archiving after completion of model run + +Purpose of changes: it's been a long-time desire to make the archiving +of model output a post-processing activity, similar to running with ccsm; +ideally, we'd like both systems to use the same scripts; this should +allow for adding support for more machines and storage systems, inside +and eventually outside ncar... + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: removed share code from +filepath for coupled runs + +Describe any changes made to the namelist: archiving options removed + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/nl_files/off2x2.5p +- removed namelist options file no longer used by test scripts + +List all subroutines added and what they do: +none + +List all existing files that have been modified, and describe the changes: +M SVN_EXTERNAL_DIRECTORIES +M . +- added external for archiving scripts which will reside in the ccsm scripts; + updated to new share tag which has cleanup of restart pointer files for drv + +M models/ocn/dom/ocn_comp.F90 +M models/ocn/dom/ocn_comp_mct.F90 +M models/ocn/som/ocn_comp.F90 +M models/ocn/som/ocn_comp_mct.F90 +M models/ice/csim4/ice_comp.F90 +M models/ice/csim4/ice_comp_mct.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/filenames.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/ioFileMod.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 +M models/atm/cam/bld/NamelistsDescriptions.xml +- removed code related to inline archiving of model output; now forcing restart + pointer files to reside in run directory + +M models/atm/cam/test/system/test_driver.sh +- made 'regular' the default queue for bluevista testing; increased wall clock + limit for lightning testing; removed redundant setting of LD_LIBRARY_PATH on bangkok + +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/outfrq24h +M models/atm/cam/test/system/nl_files/idphys +M models/atm/cam/test/system/nl_files/co2rmp +M models/atm/cam/test/system/nl_files/fv2d_4tsk +M models/atm/cam/test/system/nl_files/scm_b4b_o1 +M models/atm/cam/test/system/nl_files/scm_prep +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/fv2d_8tsk +M models/atm/cam/test/system/nl_files/outfrq2h +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/microp_mg +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb3 +- removed specifications of restart pointer files in test scripts and any archive settings + +M models/atm/cam/test/system/input_tests_master +- post-tag testing of ccsm will now exercise 1870_control compset + +M models/atm/cam/bld/configure +- removed share code from filepath in support of having csm_share build as library in + coupled mode + +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-pc-cice-docn7.csh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-sgi.csh +M models/atm/cam/bld/run-lightning.csh +- enabled template run scripts with calls to new archive scripts + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +- branch tests br511, br531, br532 failed in the previous tag + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_10 +Originator(s): Art Mirin, Pat Worley +Date: 9/5/07 +One-line Summary: Enable different numbers of processes for different portions of the calculation + +Purpose of changes: Improve scalability and make minor changes to physics +tuning for 0.5-deg and 0.25-deg FV. + +CAM is now able to utilize different numbers of processes for different +portions of the calculation. More specifically: + +(1) CAM/FV can run with a smaller latitude-vertical decomposition than +longitude-latitude decomposition. + +(2) CAM can run with more physics processes than dynamics processes, or with +inactive processes. Inactive physics processes are enabled by assigning zero chunks. +The current restrictions are as follows: If phys_loadbalance equals 0 or 3, then the +physics process count will equal the dynamics process count, and additional processes will be +idle throughout. If phys_loadbalance equals 2, all processes will be assigned to +the physics and a prescribed subset to the dynamics. The current capability holds for FV, +EUL and SLD dynamical cores. + +Also, a few physics tuning parameters relevant to running the FV dycore at +0.5-deg or finer have been modified. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: added nspltrac, dyn_npes, dyn_npes_stride +nspltrac: number of tracer timesteps per physics timestep for FV; if 0, +resolution-dependent defaults are enacted +dyn_npes: number of dynamics processes for EUL/SLD +dyn_npes_stride: stride for dynamics processes for EUL/SLD + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: ability to use more physics +than dynamics processes improves throughput of physics; ability to use more +lon-lat processes than lat-vert processes for FV improves throughput of parts of FV dynamics + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +src/physics/cam: + +check_energy.F90 - inactive physics processes +cldwat.F90 - tuning; icritc for 0.5- and 0.25-deg FV +cloud_fraction.F90 - tuning; premit for 0.5- and 0.25-deg FV +gw_drag.F90 -writing effgw_oro and kwv to stdout +hk_conv.F90 - tuning; c0 for 0.5- and 0.25-deg FV, and writing cmftau and c0 to stdout +phys_grid.F90 -chunk creation and allocation changes to support inactive processes in + the dynamics; use correct communicator and dimensions with mod_comm options in + transpose routines. +physpkg.F90 - automatic => allocatable arrays in gavglook (Note: if/when gavglook is + optimized a la phys_gmean, this will be unnecessary) + +src/control: + +cam_comp.F90 - fix timers bug +fv_control_mod.F90 - declare nspltrac for tracer subcycling +runtime_opts.F90 - add namelist variables for active dynamics processes (EUL/SLD) and + tracer subcycling (FV) + +src/utils: + +spmd_utils.F90 - trivial clean-up of appearance and comments + +src/dynamics/fv: + +FVperfmod.F90 - add communicators to barrier calls +benergy.F90 - add communicator to calls +cd_core.F90 - flexible dynamics decompositions and add communicators to calls +d2a3d_ijk.F90 - add communicator to calls +d2a3d_ikj.F90 - add communicator to calls +diag_module.F90 - flexible dynamics decompositions and add communicator to calls +dp_coupling.F90 - flexible dynamics and physics decompositions +dyn_comp.F90 - flexible dynamics decompositions and add communicator to calls +dynamics_vars.F90 - flexible dynamics decompositions, add communicator to calls, and + tracer subcycling +epvd.F90 - add communicator to calls +fv_prints.F90 - flexible dynamics and physics decompositions +geopk.F90 - flexible dynamics decompositions and add communicator to calls; fix + placement of precompile flag +inidat.F90 - flexible dynamics decompositions and add communicator to calls +inital.F90 - tracer subcycling +io_dist.F90 - add communicator to calls +mapz_module.F90 - add diagnostics +mean_module.F90 - flexible dynamics decompositions +metdata.F90 - add communicator to calls +pfixer.F90 - add communicator to calls +pmgrid.F90 - remove superfluous decompositions +restart_dynamics.F90 - flexible dynamics decompositions and tracer subcycling +spmd_dyn.F90 - flexible dynamics decompositions, adding new EUL/SLD namelist + arguments in spmd_dyn_defaultopts and spmd_dyn_setopts (as no-ops) +stepon.F90 - add communicator to calls and tracer subcycling +te_map.F90 - add communicator to calls +trac2d.F90 - add communicator to calls +uv3s_update.F90 - add communicator to calls + +src/dynamics/eul: + +bndexch.F90 - support for inactive processes in dynamics (communication restricted to + active processes) +comspe.F90 - support for inactive processes in dynamics (wave number decomposition + only over active processes) +realloc4.F90 - support for inactive processes in dynamics (communication restricted to + active processes for grid-point/spectral transposes) +realloc7.F90 - support for inactive processes in dynamics (array initialization) +scan2.F90 - support for inactive processes in dynamics (array initialization) +scanslt.F90 - support for inactive processes in dynamics (communication restricted to + active processes for halo updates) +spmd_dyn.F90 - support for inactive processes in dynamics (defining decomposition, + assigning zero work to idle processes, and adding new namelist options to control active + process placement) + +src/dynamics/sld: + +comspe.F90 - support for inactive processes in dynamics (wave number decomposition + only over active processes) +realloc4.F90 - support for inactive processes in dynamics (communication restricted to + active processes for grid-point/spectral transposes) +realloc7.F90 - support for inactive processes in dynamics (array initialization) +scan2.F90 - support for inactive processes in dynamics (array initialization) +scanslt.F90 - support for inactive processes in dynamics (defining decomposition, + communication restricted to active processes for halo updates) +spmd_dyn.F90 - support for inactive processes in dynamics (defining decomposition, + assigning zero work to idle processes, and adding new namelist options to control active + process placement) + +src/dynamics/homme: + +spmd_dyn.F90 - adding new EUL/SLD namelist arguments in spmd_dyn_defaultopts + and spmd_dyn_setopts (as no-ops) + +models/utils/pilgrim: + +mod_comm.F90 - numerous changes to support different sized decompositions and + multiple communicators +parutilitesmodule.F90 - numerous changes to support different sized decompositions and + multiple communicators +puninterfaces.F90 - add communicator to calls + +models/ocn/dom: + +ocn_spmd.F90 - corrected comments + +models/ice/csim4: + +ice_spmd.F90 - corrected comments + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: br532 (known failure) + +tempest: br531 (known failure) + +bangkok/lf95: br511 (known failure) + +CAM tag used for the baseline comparison tests if different than previous +tag: 3_5_08; actually, this tag 3_5_10 and 3_5_09 are identical except +for the ChangeLog file + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +Answers are BFB except for 0.5-deg and 0.25-deg FV due to different +tuning parameters. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam3_5_09 +See tag cam3_5_10; only difference between 3_5_10 and 3_5_09 is ChangeLog file. +=============================================================== + +Tag name: cam3_5_08 +Originator(s): andrew, eaton +Date: Wed Aug 15 15:44:58 MDT 2007 +One-line Summary: add Morrison-Gettleman microphysics code; 2-bin sea salt optics + +Purpose of changes: + +. The Morrison-Gettleman microphysics code has been added as an option to + replace the default Rasch-Kristjansson microphysics. To enable this + option: + -- configure must add 2 additional constituents. If no other optional + constituents are enabled then the number of constituents needs to be + increased from its default value of 3 to 5 via setting the configure + arg "-nadv 5". + -- set the namelist variable microp_scheme='MG' + +. An option to produce radiation fields used to diagnose the indirect + effect has been added. It is off by default. To enable it set the + namelist variable indforce=.true. + +. The aerosol optics for sea salt has been changed to use 2 sea salt size + bins. The previous sea salt optics assumed only 1 bin. This results in + larger than roundoff changes to the climate simulation. + +. Add restart and baseline tests to the regression suite for running with + the MG microphysics enabled. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: added microp_scheme and indforce + +List any changes to the defaults for the boundary datasets: + +. add default CLM fsurdat files for 0.23x0.31 and 0.47x0.63 resolutions + +Describe any substantial timing or memory changes: none (new microphysics + not on by default) + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/physics/cam/cldwat2m.F90 +. new MG microphysics parameterization + +models/atm/cam/test/system/config_files/f10c5dm +models/atm/cam/test/system/nl_files/microp_mg +. new tests for MG microphysics + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +models/atm/cam/src/physics/cam/phys_control.F90 +models/atm/cam/src/physics/cam/physics_types.F90 +models/atm/cam/src/physics/cam/pkg_cldoptics.F90 +models/atm/cam/src/physics/cam/radsw.F90 +models/atm/cam/src/physics/cam/stratiform.F90 +. mods for MG microphysics + +models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +models/atm/cam/src/physics/cam/aer_optics.F90 +models/atm/cam/src/physics/cam/aerosol_index.F90 +models/atm/cam/src/physics/cam/aerosol_intr.F90 +models/atm/cam/src/physics/cam/aerosol_radiation_interface.F90 +models/atm/cam/src/physics/cam/prescribed_aerosols.F90 +models/atm/cam/src/physics/cam/seasalt_intr.F90 +. mods for 2-bin sea salt optics + +models/atm/cam/src/control/runtime_opts.F90 +. add namelist variables microp_scheme and indforce + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. clarify long_names of precip fields + +models/atm/cam/src/physics/cam/radiation.F90 +. add radiation calc for indirect effect diagnostics + +models/atm/cam/src/physics/cam/sulchem.F90 +. limiter to keep pH positive + +models/atm/cam/src/physics/cam/wetdep.F90 +. bound variable fracev + +models/atm/cam/src/physics/cam/zm_conv.F90 +. remove unused variable conke + +models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +. add fsurdat defaults for 0.23x0.31 and 0.47x0.63 resolutions + +models/atm/cam/bld/Makefile.in +. modify linux section to allow not specifying the mpi location when + SPMD=TRUE + +models/atm/cam/test/system/input_tests_master +models/atm/cam/test/system/tests_posttag_calgary +models/atm/cam/test/system/tests_posttag_lightning +models/atm/cam/test/system/tests_pretag_bangkok +. add new tests for MG microphysics + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS except + +004 bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +006 bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +011 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +015 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +017 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +023 bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +026 bl337 TBL.sh f4dh fv2d_8tsk 4s ................................FAIL! rc= 7 +028 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +031 bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +034 bl355 TBL.sh fmo2dh off2x2.5 4s ...............................FAIL! rc= 7 +038 bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +042 bl382 TBL.sh fmgpa1.9h outfrq2h+1870_control 4s ...............FAIL! rc= 7 +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +046 bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +053 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +tempest: all PASS except + +004 bl131 TBL.sh e32dh co2rmp 4s ..................................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +009 bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq2h 4s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4gdh co2rmp 4s ..................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +035 bl531 TBL.sh s32dh co2rmp 4s ..................................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +bangkok/lf95: all PASS except + +004 bl111 TBL.sh e8c8mdm ttrac 4s .................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 4s ..................................FAIL! rc= 7 +010 bl113 TBL.sh e8pdm aqpgro 2s ..................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +016 bl311 TBL.sh f10c8mdm ttrac 4s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 4s .................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 2s .................................FAIL! rc= 7 +029 bl315 TBL.sh f10c5dm microp_mg 4s .............................FAIL! rc= 5 +032 bl317 TBL.sh f10dm fv2d_4tsk 4s ...............................FAIL! rc= 7 +034 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 5 +037 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 +038 bl511 TBL.sh s8c8mdm ttrac 4s .................................FAIL! rc= 7 +042 bl512 TBL.sh s8sdm ghgrmp 4s ..................................FAIL! rc= 7 +046 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + + +These are the expected results. The baseline tests fail due to the change +in the sea salt optical treatment. The SLD branch test failures are a +pre-existing problem. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: +- what code configurations: default +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but same climate + +10 year runs were done (by Andrew Gettleman) with cam3_5_04 and +nmicro2_3_cam3_5_04 in their default configurations. The only difference +between these runs is the treatment of sea salt optical properties (use 2 +size bins instead of 1). The output from the AMWG diagnostics package is +here: +http://www.cgd.ucar.edu/cms/andrew/diag/nmicro2_3_cam3_5_04_2-cam3_5_04 + +=============================================================== +=============================================================== + +Tag name: cam3_5_07 +Originator(s): eaton, mirin, fvitt +Date: Tue Aug 14 13:38:57 MDT 2007 +One-line Summary: increase max number of history fields; modify + tracer_suite; add namelist utility; fix cyclic mode + +Purpose of changes: + +. Increase size of master field list. This was needed to allow running a + CCSM configuration that turns on full trop_mozart chemistry. + + Also made a couple of changes to eliminate adding names to the master + field list that have no corresponding outfld calls. + +. Fix a bug in trop_mozart data reading code. This affects performance but + the answers are identical. + +. Modifications to the tracers_suite module to allow easily creating many + test tracers. The original 5 tracers (which have no emission, source, or + sink terms) are copied as many time as necessary to produce the requested + number of test tracers. + + This option is used by setting the configure -nadv option to the total + number of advected tracers, and by setting the namelist variable + tracers_flag=.true. The total number of test tracers will be the number + set by the -nadv option, minus the number present by default (the water + substance tracers) and the number registered by any other packages. + +. Utility code has been added which will position an input file at the + first record of a specified namelist group. This simplifies reading a + specific namelist from an input file that contains multiple namelists. + +Bugs fixed (include bugzilla ID): #563 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. The size of the history master field list was increased. +. The size of the primary hash table for the master field list was + increased. + + Note that the primary reason these data array sizes need to be increased + is that there are 10 or so diagnostic fields that occur for each + constituent, and they are registered in the master list whether the + diagnostic is being computed or not. Better control logic needs to be + added to the diagnostic code so that these fields are not registered in + the master list unless the diagnostic is going to be computed and written + to a history file. + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/src/utils/namelist_utils.F90 +. add utility code to search for a specified namelist group name in an + input file and leave the file positioned at the record containing that + group name + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/control/cam_history.F90 +. increase pflds to 10000 +. increase tbl_hash_pri_sz_lg2 to 16. + +models/atm/cam/src/control/runtime_opts.F90 +. use subroutine find_group_name from new namelist_utils module to find the + cam_inparm namelist group in the input file. + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. comment out addfld calls for per constituent diagnostics of + hadvnam, vadvnam, tendnam, fixcnam. There are no matching outfld calls + for these fields. (The spectral cores do have outfld calls for these + fields.) + +models/atm/cam/src/physics/cam/cam_diagnostics.F90 +. if diag_cnst_conv_tend='none' or 'q_only' don't add the per constituent + names for DCxxxx to the master field list + +models/atm/cam/src/physics/cam/constituents.F90 +. add cnst_num_avail function to return the number of available slots in + the constituent array. + +models/atm/cam/src/physics/cam/tracers_suite.F90 +. modify to enable up to 999 copies of each of the 5 basic tracer types. + That's a total of up to 5000 tracers. + +models/atm/cam/src/physics/cam/tracers.F90 +. modify tracers_register to query the constituent module for the number of + available slots in the constituent array, and to register test tracers in + all available slots. This assumes that the test tracers are registering + last. + +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +. bug fix for cyclic mode. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except + +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: All PASS except + +034 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +These are expected failures. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none. + +=============================================================== +=============================================================== + +Tag name: cam3_5_06 +Originator(s): mvertens +Date: Mon Aug 6 10:07:59 MDT 2007 +One-line Summary: cam and surface components may now couple every cam time step + +Purpose of changes: There is now the capability to have cam and the surface components +couple every cam time step. This capability can be invoked by simply setting the +namelist variable, atm_cpl_dt in drv_in equal to the cam timestep (by default it is +set to 3600 seconds). The default behavior of the system is to still couple on the +cam shortwave radiation timestep. All tests have maintained this behavior. + +Bugs fixed (include bugzilla ID): 493 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None expected + +Code reviewed by: myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - updated models/lnd/clm code to pftintdat08_clm3_5_05 (modified lnd_comp_mct.F90 to permit + either hourly coupling or coupling on the cam time step) + - update drv/seq_mct code to drvseq1_0_42 (seq_flux_mct.F90 only does + albedo calculation for ocn or ice if nextsw_cday is not -1 +M models/atm/cam/src/control/atm_comp_mct.F90 + - put in capability to couple either on the short wave radiative time step or + every cam time step +M atm/cam/src/control/ccsm_msg.F90 + - one line fix for bugzilla #493 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: +034 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit with cam3_5_05. +In addition, bfb restults with cam3_4_15 can be shown with coupling +every cam timestep, if the cam3_4_15 ice_comp.F90 code is modified +such that the zenith angle is updated on the timestep before cam needs +the albedos (as is done in clm). + +=============================================================== +=============================================================== + +Tag name: cam3_5_05 +Originator(s): eaton +Date: Tue Jul 24 09:17:11 MDT 2007 +One-line Summary: add use case for 1990 control. bug fixes. + +Purpose of changes: + +. add use case for 1990 control runs to build namelist + +Bugs fixed (include bugzilla ID): + +. fix bug in configure's -test option + +. fix bug in setting nlend + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/use_cases/1990_control.nl +. ghg values, ozone, and aerosol datasets for 1990. + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add 1990_control as use case + +models/atm/cam/bld/configure +. fix bug in configure's -test option + +models/atm/cam/src/control/atm_comp_mct.F90 +. fix bug in setting nlend + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS except + +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: all PASS except + +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: all PASS except + +034 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +These branch test failures are pre-existing. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam3_5_04 +Originator(s): mvr,rneale,jrichter +Date: 18 Jul 2007 +One-line Summary: Addition of convective momentum transport fixes +plus tuning parameter updates + +Purpose of changes: a bug was discovered in the cmt code and +energy balancing was required for the spinup of biogeochemistry +3.5 coupled runs + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: rneale,jrichter + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M cloud_fraction.F90 +- tuning of cloud parameters +M zm_conv_intr.F90 +M zm_conv.F90 +- cmt bug fixes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +blueice: +bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +bl336 TBL.sh wm4h outfrq2h 4s .................................FAIL! rc= 7 +bl337 TBL.sh f4dh fv2d_8tsk 4s ................................FAIL! rc= 7 +bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +bl355 TBL.sh fmo2dh off2x2.5 4s ...............................FAIL! rc= 7 +bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +bl382 TBL.sh fmgpa1.9h outfrq2h+1870_control 4s ...............FAIL! rc= 7 +br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 +bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +bl533 TBL.sh s32pdh aqpgro 2s .................................FAIL! rc= 7 +bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +tempest: +bl131 TBL.sh e32dh co2rmp 4s ..................................FAIL! rc= 7 +bl132 TBL.sh e32sdh ghgrmp 4s .................................FAIL! rc= 7 +bl133 TBL.sh e32pdh aqpgro 2s .................................FAIL! rc= 7 +bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +bl314 TBL.sh wg10dh outfrq2h 4s ...............................FAIL! rc= 7 +bl331 TBL.sh f4gdh co2rmp 4s ..................................FAIL! rc= 7 +bl332 TBL.sh f4sdh ghgrmp 4s ..................................FAIL! rc= 7 +bl333 TBL.sh f4pdh aqpgro 2s ..................................FAIL! rc= 7 +bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 +bl531 TBL.sh s32dh co2rmp 4s ..................................FAIL! rc= 7 +bl532 TBL.sh s32sdh ghgrmp 4s .................................FAIL! rc= 7 +bl533 TBL.sh s32pdh aqpgro 2s .................................FAIL! rc= 7 +bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +bangkok/lf95: +bl111 TBL.sh e8c8mdm ttrac 4s .................................FAIL! rc= 7 +bl112 TBL.sh e8sdm ghgrmp 4s ..................................FAIL! rc= 7 +bl113 TBL.sh e8pdm aqpgro 2s ..................................FAIL! rc= 7 +bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 7 +bl311 TBL.sh f10c8mdm ttrac 4s ................................FAIL! rc= 7 +bl312 TBL.sh f10sdm ghgrmp 4s .................................FAIL! rc= 7 +bl313 TBL.sh f10pdm aqpgro 2s .................................FAIL! rc= 7 +bl317 TBL.sh f10dm fv2d_4tsk 4s ...............................FAIL! rc= 7 +bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 +bl511 TBL.sh s8c8mdm ttrac 4s .................................FAIL! rc= 7 +bl512 TBL.sh s8sdm ghgrmp 4s ..................................FAIL! rc= 7 +bl513 TBL.sh s8pdm aqpgro 2s ..................................FAIL! rc= 7 +bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 7 + +-all baseline tests (other than ideal physics or adiabatic tests) were + expected to fail...the branch test with sld has been failing for reasons + unrelated to this commit + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change : new climate! + +If bitwise differences were observed, how did you show they were no worse +than roundoff? +- cmt mods were validated in a 10yr stand-alone cam run using cam3_3_3 +- tuning mods are being validated in a 18mo F run, using ccsm3_5_beta06 + plus the mods for this commit +- climate to be verified in an upcoming 50yr ccsm coupled run + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_5_03 +Originator(s): eaton, fvitt, jwolfe +Date: Thu Jul 5 18:58:40 MDT 2007 +One-line Summary: Vertical interp of prescribed constituents modified; PGI + compiler workarounds; tuning mod; new dust optics. + +Purpose of changes: + +. Use hybrid coefficients and surface pressure if available to + construct a pressure field to vertically interpolate the prescribed + constituents. Otherwise use the variable "lev" to vertically + interpolate the prescribed constituents. (fvitt) + +. Mod to cam_diagnostics so that diagnostics needed by the AMWG package are + always on the default history file. + +. Mod to check_energy so that when printing of detailed column by column + conservation errors is on (it's off by default), it's on for all + processes and not just the masterproc. + +. Tuning mod: reduce rhminh from .80 to .79 + +. Add default 30 level initial files for FV, 1.9x2.5, for running w/ UW + PBL scheme. + +. Change CLM to branch_tags/pftintdat06_clm3_5_05/. This provides a fix + for effective porosity having zero values, which apparently was not + affecting the simulation, but was preventing us from running some tests + in debug mode. + +. PGI compiler (6.2-5) was failing to recognize aliases made in use statements. + Workaround by using CAM's physconst module in place of share_const_mod. (jwolfe) + + Also modify code to avoid creating zero length substrings which are + causing problems for the pgi compiler. + +. Update the aerosol optics file. The new file is backwards compatible + with the previous one when using the old prescribed aerosol distributions + (which is still the default). It contains new optics for the prognostic + dust (and the new prescribed dust) due to differences in how the size + distribution is binned. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. SVN_EXTERNAL_DIRECTORIES + - change CLM to branch_tags/pftintdat04_clm3_5_04 + +. models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 + - remove '_trcnst' suffix from fields output by this module + +. models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + - mods to use PS in vertical interpolation if present + +. models/atm/cam/src/control/wrap_nf.F90 + - add optional arg to wrap_inq_varid to allow return of control to caller + rather than just aborting if a variable isn't in the netcdf file + - add wrap_get_scalar_realx + +. models/atm/cam/src/physics/cam/aer_optics.F90 + - replace the netcdf variable names *_dust by *_dust_pres + - replace the netcdf variable names *_dust_mod by *_dust_prog + - The get variable id call for abs_cff_mss_aer needs the same logic + as the shortwave optics. + Use abs_cff_mss_aer_prog for the prognostic and new prescribed dust, and + abs_cff_mss_aer for the old prescribed dust. + +. models/atm/cam/src/physics/cam/cam_diagnostics.F90 + - Mod to cam_diagnostics so that diagnostics needed by the AMWG package are + always on the default history file. + +. models/atm/cam/src/physics/cam/check_energy.F90 + - remove "if (masterproc)" from prints in check_energy_chng + +. models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +. models/atm/cam/src/chemistry/trop_mozart/prescribed_ozone.F90 +. models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 + - use physconst module instead of shr_const_mod. This is a workaround for + a PGI compiler problem encountered on jaguar. + +. models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + - Mod to avoid creating zero length substring. Using the zero length + substring in a fortran intrinsic function resulted in an allocation + error using pgi6.2-5. + +. models/atm/cam/src/physics/cam1/cloud_fraction.F90 + - change rhminh from .80 to .79 + +. models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + - add initial files for FV, 1.9x2.5, 30 levels, Jan 1 and Sep 1 start dates. + - update aeroptics file to use AerosolOptics_c060817nat.nc + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +028 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +031 bl354 TBL.sh fm2dh outfrq2h 4s ................................FAIL! rc= 7 +034 bl355 TBL.sh fmo2dh off2x2.5 4s ...............................FAIL! rc= 7 +038 bl381 TBL.sh fma1.9h outfrq2h+1870_prog_aero 4s ...............FAIL! rc= 7 +042 bl382 TBL.sh fmgpa1.9h outfrq2h+1870_control 4s ...............FAIL! rc= 7 +045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + +tempest: All PASS except: + +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + +bangkok/lf95: All PASS except: + +031 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 +034 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + +. The branch tests br511, br531, br532 also failed in the previous tag. + +. The baseline tests bl381 and bl382 fail due to + - the vertical interpolation change for prescribed constituents + - new CAM tuning for FV 1.9x2.5 and 2x2.5 + - new dust optics + +. The baseline tests bl375, bl376, bl377 failed due to + - new CAM tuning for FV 1.9x2.5 and 2x2.5 + +. The baseline tests bl354 and bl355 failed due to + - new CAM tuning for FV 1.9x2.5 and 2x2.5 + - new dust optics + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for FV 1.9x2.5 and 2x2.5 due + to CAM tuning, and all trop_mozart_* runs due to new dust optics. + +=============================================================== +=============================================================== + +Tag name: cam3_5_02 +Originator(s): bundy +Date: Fri Jun 29 08:30:08 MDT 2007 +One-line Summary: Modifications to UW PBL scheme (non-default option) + +Purpose of changes: Update the version of the UW PBL scheme in CAM to +the latest from the UW development group. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/src/physics/cam/mcshallow.F90 +M models/atm/cam/src/physics/cam/convect_shallow.F90 +M models/atm/cam/src/physics/cam/cloud_fraction.F90 +M models/atm/cam/src/physics/cam/eddy_diff.F90 +M models/atm/cam/src/physics/cam/vertical_diffusion.F90 +All changes affect only the CAM UW scheme (shallow convection and eddy +diffusivity). + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + + +bluevista: 045 br532 TBR.sh s32sdh ghgrmp 4+2s + ...............................FAIL! rc= 11 + +tempest: 034 br531 TBR.sh s32dh co2rmp 4+2s +................................FAIL! rc= 11 + +bangkok/lf95: 034 br511 TBR.sh s8c8mdm ttrac 4+2s +...............................FAIL! rc= 11 + +These tests are expected to fail although the branch capability that +is being tested is apparently okay. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + None to default CAM + New climate for UW PBL configuration + +=============================================================== + +Tag name: cam3_5_01 +Originator(s): mvertens +Date: Thu Jun 28 09:50:19 MDT 2007 +One-line Summary: CAM now couples to surface components only on shortwave timestep + +Purpose of changes: + +* The following changes force CAM to couple to the surface components on + its shortwave radiation timestep only (currently this is hourly). This + is the same coupling constraint that is currently used in ccsm + mode. CAM now averages its output precipitation fluxes over the hour + period and receives hourly averaged fluxes from the surface + components. All states exchanged between CAM and the surface + componenents are instantaneous. CAM also sends to all the surface + components the calendar to use for the next zenith angle contribution + to the albedo computation. + +* The CAM-csim and CAM-dom/som components now have an hourly timestep + and only calculate the albedos hourly. Previously, the CAM-csim and + CAM-dom/som components updated the zenith angle every CAM timestep, + which was incorrect, since CAM was updating its zenith angle only + hourly (i.e. on the shortwave radiation computation). + +* As a result of these changes, the CCSM CICE and DOCN7 componenents can + now couple to CAM via the sequential driver (either on the CAM grid or + on the displaced pole grid). CICE and DOCN7 will now be checked out + with the CAM code and a new script in the bld directory, + run-pc-cice-docn7.csh, accompanies this tag. This script permits CAM + to couple to CICE/DOCN7 at T31 (thermodynamic ice mode only) or at + T31_gx3v5. Furthermore, the DOCN7 can be run either in prescribed SST + mode or som mode. This script is a starting point for bringing the + CCSM ice and ocn surface components into stand-alone CAM. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +* Changed the specification of coupling fields so that only one file is + needed now, seq_flds_mod.F90. Optional coupling fields are now + specified via the use of CPP directives in this file (i.e. GENSOM, + DUST, PROGSSLT). This removes the needed for a different file and + therefore a different filepath for every new coupling scenario. Changed + configure to reflect this modification. + +* Changed configure to permit the addition of CICE and DOCN7 as alternative + ice and ocean components. The following new options can be provided to configure + -ocn Build CAM with data SSTs or slab ocean model [dom | som | docn7] + -ice Build CAM with sea ice model [csim4 | cice] + +* If cice is selected for the -ice option then the following additional settings can be added + -cice_nbx Number of cice blocks in x on 1 processor (default 4) + -cice_nby Number of cice blocks in y on 1 processor (default 4) + -cice_nlon Number of ocean/ice longitudes (only used for cice/docn7) + -cice_nlat Number of ocean/ice latitudes (only used for cice/docn7) + -cice_ntasks Number of MPI tasks used to set cice block decomposition (default not set) + +Describe any changes made to the namelist: + +* The atm_cpl_dt is now set to 3600 by default in DefaultTIMEMGR_INPARM_Namelist.xml + +* In additin, in SeqCCSM_namelist.pm, the coupling frequency of all + components is now set to atm coupling frequency. In the future the ocn + component (i.e. POP2) will be allowed to couple at a different + frequency. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None expected (not tested yet) + +Code reviewed by: myself, Brian Eaton, Erik Kluzek + +List all subroutines eliminated: + (all removed files are in the testing system and described below) + +List all subroutines added and what they do: + (all added files are in the testing system and described below) + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - updated to the following externals + models/drv/seq_mct https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq1_0_37 + models/lnd/clm2/src https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm3_5_04/src + models/ice/cice/src https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20070605/src + models/ocn/docn7 https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn7_070605 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_070626 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_060616 + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_070525 + models/utils/mct https://svn-ccsm-models.cgd.ucar.edu/mct/trunk_tags/MCT2_3_0_070524 + - note that lnd_comp_mct.F90 now performs time averages over the coupling interval for its output fluxes) + - note that the cice and docn7 timesteps are hourly) + - note that seq_flds_mod.F90 i drvseq1_0_37 has a different specification for optional fields, see above) + - note that driver sync clock is advanced at the beginning of the time step now + +M models/ocn/dom/ocn_filenames.F90 + - removed previous interface and put in new interface for + specifying restart filename from input year, month, day, secs +M models/ocn/dom/ocn_time_manager.F90 + - time step is no longer advanced on restart +M models/ocn/dom/ocn_comp.F90 + - sync clock dtime is now the atm coupling interval (1 hour) and not + the atm time step + - no longer read FLAND as option (not needed) + - restart filename determined from sync clock time and no longer from rsfilename_spec_ocn +M models/ocn/dom/ocn_comp_mct.F90 + - since driver sync clock is advanced at the beginning of the time step now, check of internal + clock with sync clock is now made at the end of ocn_run_mct + +M models/ocn/som/ocn_filenames.F90 + - removed previous interface and put in new interface for + specifying restart filename from input year, month, day, secs +M models/ocn/som/ocn_time_manager.F90 + - time step is no longer advanced on restart +M models/ocn/som/ocn_comp.F90 + - sync clock dtime is now the atm coupling interval (1 hour) and not + the atm time step + - no longer read FLAND as option (not needed) + - restart filename determined from sync clock time and no longer from rsfilename_spec_ocn +M models/ocn/som/ocn_comp_mct.F90 + - since driver sync clock is advanced at the beginning of the time step now, check of internal + clock with sync clock is now made at the end of ocn_run_mct + +M models/ice/csim4/ice_filenames.F90 + - removed previous interface and put in new interface for + specifying restart filename from input year, month, day, secs +M models/ice/csim4/ice_types.F90 + - added fswabs to ice_out derived type +M models/ice/csim4/ice_srf.F90 + - added fsns update for dom mode (currently only done for som mode) +M models/ice/csim4/ice_comp.F90 + - sync clock dtime is now the atm coupling interval (1 hour) and not + the atm time step + - restart filename determined from sync clock time and no longer from rsfilename_spec_ice +M models/ice/csim4/albice.F90 + - removed zenith angle calculation from code (now done independently in driver as is the case + in cpl6 + - note again that ice zenith angle and albedo now updated only on the atm/surface model coupling interval, + (i.e. cam sw radiation) and not every cam time step +M models/ice/csim4/ice_comp_mct.F90 + - the merge to ocean now multiplies melth by aice (to be able to couple in cice) - so now divide melth by + aice in the ice_import_mct routine since the merge to ocn will now multiply it back in + - since driver sync clock is advanced at the beginning of the time step now, check of internal + clock with sync clock is now made at the end of ice_run_mct + +M models/atm/cam/src/control/atm_comp_mct.F90 + - removed all references to infobuf (shr_intputInfo will now be used for this information) + - CAM now returns control to the driverafter it completes its shortwave radiation computation (i.e. hourly). + However, since the sw computation is done one timestep into the hour (except for SLD), the CAM time + will generally be shifted relative to the sync clock time step by one CAM timestep. As a result, + if iradsw is not 1, then an offset of -dtime is used to check consistency with sync clock at the + end of atm_run_mct routine. + - CAM now averages precipation between coupling intervals and sends averaged precipitation back to the + surface components (as is done in cpl6). + - CAM sends calendar day of next radation computation back to the surface components, and albedos will be + computed for the surface components utilizing this calendar day. + - restart filenames are now set by the sync clock date and not by the CAM internal date (see below) +M models/atm/cam/src/control/filenames.F90 +M models/atm/cam/src/control/cam_restart.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam/restart_physics.F90 + - for above five routines, now pass in + [yr_spec, mon_spec, day_spec, sec_spec] + as optional arguments to set the name of the restart file + (this will enable restart file name to trigger off of the sync clock time + rather than the internal cam time, which for non-sld mode will be shifted by + a time step ahead of the sync clock time) +M models/atm/cam/src/utils/time_manager.F90 + - removed dtime_in as argument (note that for cam_comp.F90, dtime_cam is no longer + passed as an argument to eshr_timemgr_clockGet, but is now set to get_step_size() + after the call to timemgr_init + +M models/atm/cam/bld/configure +A + models/atm/cam/bld/run-pc-cice-docn7.csh +M models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml +M models/atm/cam/bld/timemgr_inparm.pm +M models/atm/cam/bld/SeqCCSM_namelist.pm +M models/atm/cam/bld/config_definition.xml + - see above description of bld changes + +M models/atm/cam/test/system/TSB.ccsm.sh +D models/atm/cam/test/system/config_files/fmo2m +D models/atm/cam/test/system/config_files/f2c11m +D models/atm/cam/test/system/config_files/e128m +A + models/atm/cam/test/system/config_files/f4gdh +D models/atm/cam/test/system/config_files/f4c11gdh +D models/atm/cam/test/system/config_files/e128c11m +A + models/atm/cam/test/system/config_files/fma1.9h +D models/atm/cam/test/system/config_files/fm1.9m +D models/atm/cam/test/system/config_files/f1.9pm +D models/atm/cam/test/system/config_files/e32c11dh +D models/atm/cam/test/system/config_files/s32c11dh +A + models/atm/cam/test/system/config_files/fmgpa1.9h +D models/atm/cam/test/system/config_files/e128pm +M models/atm/cam/test/system/TCT.ccsm.sh +D models/atm/cam/test/system/tests_posttag_phoenix +M models/atm/cam/test/system/TBR.sh +D models/atm/cam/test/system/tests_posttag_bluesky +D models/atm/cam/test/system/tests_pretag_bluesky +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/test_driver.sh +D models/atm/cam/test/system/posttag_cron_bluesky.sh +M models/atm/cam/test/system/tests_pretag_bluevista +M models/atm/cam/test/system/nl_files/ghgrmp +D models/atm/cam/test/system/nl_files/outfrq3s +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/idphys +A + models/atm/cam/test/system/nl_files/co2rmp +M models/atm/cam/test/system/nl_files/fv2d_4tsk +M models/atm/cam/test/system/nl_files/scm_prep +D models/atm/cam/test/system/nl_files/pghgsul +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/fv2d_8tsk +A + models/atm/cam/test/system/nl_files/outfrq2h +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb3 +M models/atm/cam/test/system/tests_posttag_blueice +M models/atm/cam/test/system/input_tests_master +D models/atm/cam/test/system/tests_posttag_robin +M models/atm/cam/test/system/CAM_runcmnd.sh +M models/atm/cam/test/system/TSM.sh + - the above testing changes needed to account for the fact that atm->surface + component coupling only occurs on the cam shortwave radiation time + step and that the GENSOM and DUST fields transferred no longer involve a + change to the filepath but rather require the specification of a CPP variable + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: + 045 br532 TBR.sh s32sdh ghgrmp 4+2s ...............................FAIL! rc= 11 + (note that the branch actually was bfb, but a history restart file was written on + the initial part of this run, giving rise to a fail status for this test) + +tempest: + 034 br531 TBR.sh s32dh co2rmp 4+2s ................................FAIL! rc= 11 + (note that the branch actually was bfb, but a history restart file was written on + the initial part of this run, giving rise to a fail status for this test) + +calgary/lf95: + 034 br511 TBR.sh s8c8mdm ttrac 4+2s ...............................FAIL! rc= 11 + (note that the branch actually was bfb, but a history restart file was written on + the initial part of this run, giving rise to a fail status for this test) + +Summarize any changes to answers: +- what code configurations: + NOTE ***all SLD configurations will be bfb with cam3_4_15*** + NOTE ***all non-SLD runs are larger than roundoff but same climate (see below) *** +- what platforms/compilers: All +- nature of change: larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: +- source tag (all code used must be in the repository): + hourly coupling: https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/seqflxave_cam3_4_01_tags/seqflxave10_cam3_4_11 + control: https : https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/conv_cam3_4_03_tags/conv09_cam3_4_03 +- platform/compilers: + ibm-sp( blueice ) +- configure commandline: + configure -spmd -smp -dyn fv -res 1.9x2.5 -ocn dom (for hourly_cpl-f1.9m_conv09 below) + configure -spmd -smp -dyn fv -res 1.9x2.5 -ocn som (for hourly_cpl_som-cam_som below) +- build-namelist command (or complete namelist): + for dom: + $cfgdir/build-namelist -s -case $case -runtype $runtype -config $blddir/config_cache.xml \ + -namelist "&camexp mss_irt=0 stop_option='nmonths', stop_n=$stop_n doisccp=.true. fincl1='CLDST' \ + ncdata='/fis/cgd/cms/rneale/cam_mydata/atm/cam3_2_59_bvc.cam2.i.0023-01-01-00000.nc' start_ymd=101 \ + restart_pfile='$rundir/rpointer.drv' rest_pfile='$rundir/rpointer.cam' / \ + &dom_inparm rest_pfile='$rundir/rpointer.dom' / \ + &som_inparm rest_pfile='$rundir/rpointer.som' / \ + &csim_inparm rest_pfile='$rundir/rpointer.csim' / \ + &clmexp rpntpath='$rundir/rpointer.clm' \ + finidat='/fs/cgd/csm/inputdata/lnd/clm2/inidata_3.1/ccsm/clmi_0000-01-01_1.9x2.5_gx1v4_c070311.nc' /" \ + || echo "build-namelist failed" && exit 1 + for som: + $cfgdir/build-namelist -s -case $case -runtype $runtype -config $blddir/config_cache.xml \ + -namelist "&camexp mss_irt=0 stop_option='nmonths', stop_n=$stop_n doisccp=.true. fincl1='CLDST' \ + ncdata='/fis/cgd/cms/rneale/cam_mydata/atm/cam3_2_59_bvc.cam2.i.0023-01-01-00000.nc' start_ymd=101 \ + bndtvs='/fis/cgd/cseg/people/mvr/cam_mydata/som/cam3_4_11_with_correct_pft_0000-0020_qflux.nc' \ + restart_pfile='$rundir/rpointer.drv' rest_pfile='$rundir/rpointer.cam' / \ + &dom_inparm rest_pfile='$rundir/rpointer.dom' / \ + &som_inparm rest_pfile='$rundir/rpointer.som' / \ + &csim_inparm rest_pfile='$rundir/rpointer.csim' / \ + &clmexp rpntpath='$rundir/rpointer.clm' \ + finidat='/fs/cgd/csm/inputdata/lnd/clm2/inidata_3.1/ccsm/clmi_0000-01-01_1.9x2.5_gx1v4_c070311.nc' /" \ + || echo "build-namelist failed" && exit 1 +MSS location of output: + /MVR/csm/seqflxave10_cam3_4_11/hour_cpl + /MVR/csm/seqflxave10_cam3_4_11/hour_cpl_som +MSS location of control simulations used to validate new climate: + *** to be filled in by mvr *** +URL for AMWG diagnostics output used to validate new climate: + http://www.cgd.ucar.edu/cms/rneale/runs/cam/hourly_cpl-f1.9m_conv09 + http://www.cgd.ucar.edu/cms/rneale/runs/cam/hourly_cpl_som-cam_som + + +=============================================================== + +Tag name: cam3_4_15 +Originator(s): eaton, fvitt +Date: Fri Jun 15 15:30:19 MDT 2007 +One-line Summary: mod to trop_mozart boundary dataset reader + +Purpose of changes: + +. Modify the dataset reader in the trop_mozart tracer_data module so that the + dataset does not need a time coordinate variable. This reader is being used + for oxidant datasets that use an integer date variable instead of a time + coordinate. + +. update the use case "1870_prog_aero" to specify that the oxidant dataset + should be treated as cyclic for year 1870. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + - mod to relax requirement that datasets have a time coordinate variable + +. models/atm/cam/bld/use_cases/1870_prog_aero.nl + - specify the oxidant dataset as cyclic. The earlier version of + tracer_data.F90 didn't support a cyclic dataset option. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_4_14 +Originator(s): eaton, fvitt +Date: Fri Jun 8 10:42:45 MDT 2007 +One-line Summary: add initial file; trop_mozart prescribed aerosol bug fix + +Purpose of changes: + +. Add an FV 1.9x2.5 initial file valid for Jan 01 which is the initial date + normally used for CCSM runs. + +. Changed the 1870 use cases for build-namelist to start simulations in + year 0 rather than 1870, which is the convention for climatological runs. + +Bugs fixed (include bugzilla ID): + +. Apply bug fix from Francis to the trop_mozart prescribed aerosol code + (fix the molecular weights of the aerosol species). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + - add Jan 1 initial file for FV 1.9x2.5 + +. models/atm/cam/bld/use_cases/1870_control.nl +. models/atm/cam/bld/use_cases/1870_prog_aero.nl + - Removed the setting start_ymd=18700901 from these files which are used to + implement the build-namelist use cases. So by default the simulations + will start in year 0 which is the convention for climatological runs. + +. models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_imp_sol.F90 + - new preprocessor output -- doesn't affect prescribed aerosols + +. models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_sim_dat.F90 +. models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_sim_dat.F90 + - fix molecular weights of aerosol species + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam3_4_13 +Originator(s): eaton, fvitt +Date: Tue Jun 5 09:26:59 MDT 2007 +One-line Summary: updates to trop_mozart; add build-namelist use cases; misc bug fixes + +Purpose of changes: + +. Updates to trop_mozart code to assume constituents use dry mass mixing + ratios (fvitt). + +. Fix the sea salt mass passed to the aerosol optics code by summing masses + from the 4 sea salt bins into the 1 bin currently used by the optics + (fvitt). + +. Add new chemistry option which includes a simple GHG chemistry (CH4, N2O, + CFC11, CFC12) in addition to the prescribed aerosols. This is intended + to replace the simple GHG chemistry that was enabled in CAM by setting + the namelist variable trace_gas=.true.. This option is set by invoking + configure with the arg "-chem trop_mozart_ghg_paero". This option + additionally allows reading the prescribed ozone from a 3D dataset which + is spatially interpolated to the model grid. (fvitt) + +. Add ability to cycle the prescribed aerosol datasets. This is needed for + the 1870 and present day control runs. (fvitt) + +. Add "-use_case" option to build-namelist to provide a single switch for + setting up runs that require setting many namelist parameters. Two use + cases have been implemented: + 1870_prog_aero -- sets up run that was used to produce the 1870 aerosol + climatology + 1870_control -- sets up the 1870 control run which uses a simple GHG + chemistry, the 1870 prescribed aerosol climatology, an + 1870 prescribed ozone climatology, and sets the solar + constant to 1366.5 W/m^2 + +. Update to mct/trunk_tags/MCT2_3_0_070524. This fixes a memory leak. + +. Update to timing/trunk_tags/timing_070525. This fixes a problem with the + timers that caused a seg fault on lightning (w/ pathscale) when a t_stopf + call was made without a matching t_startf. + +Bugs fixed (include bugzilla ID): + +. defineqflux was broken on 64-bit platforms due to stdlib.h not being + included (it's needed to provide the correct declaration of malloc). + +. Fix compilation failure on IBM when compiling for pure OMP. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. New namelist vars for trop_mozart chemistry + character(len=16) :: prescribed_ozone_name ! prescribed ozone field name in netCDF + character(len=256) :: prescribed_ozone_file ! prescribed ozone file + character(len=256) :: prescribed_ozone_filelist ! list of prescribed data files (series of files) + character(len=256) :: prescribed_ozone_datapath ! absolute path of prescribed data files + character(len=8) :: prescribed_ozone_type ! 'CYCLICAL' | 'SERIAL' (default) + logical :: prescribed_ozone_rmfile ! remove data file from local disk (default .false.) + integer :: prescribed_ozone_ymd ! yyyymmdd - start date of the prescribed data (default is current model date) + integer :: prescribed_ozone_tod ! start time of day (seconds) of the prescribed data (default is current model time) + character(len=256) :: tracer_cnst_datapath ! absolute path of prescribed data files + character(len=8) :: tracer_cnst_type ! 'CYCLICAL' | 'SERIAL' (default) + character(len=256) :: tracer_srcs_datapath ! absolute path of prescribed data files + character(len=8) :: tracer_srcs_type ! 'CYCLICAL' | 'SERIAL' (default) + +List any changes to the defaults for the boundary datasets: + +. Defaults have been changed for emission datasets used by trop_mozart_aero + to match the datasets used to produce the prescribed aerosol distributions + to be used in future CCSM simulations. + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/config_defaults_trop_mozart_ghg_paero.xml +models/atm/cam/src/chemistry/trop_mozart/mo_ghg_chem.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_lu_solve.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_setrxt.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/m_rxt_id.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_phtadj.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_nln_matrix.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_adjrxt.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/m_het_id.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_lu_factor.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_indprd.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_sim_dat.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/m_spc_id.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_imp_sol.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/chem_mods.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_prod_loss.F90 +models/atm/cam/src/chemistry/trop_mozart_ghg_paero/mo_lin_matrix.F90 +. implement new trop_mozart_ghg_paero chemistry option + +models/atm/cam/src/chemistry/trop_mozart/prescribed_ozone.F90 +. allows trop_mozart options to read the 3D prescribed ozone datasets and + spatially interpolate them to the model grid. + +models/atm/cam/bld/use_cases/1870_prog_aero.nl +. implements the use case 1870_prog_aero + +models/atm/cam/bld/use_cases/1870_control.nl +. implements the use case 1870_control + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/build-namelist +. add "-use_case" commandline arg to be used to specify a use case +. add use case for 1870_prog_aero +. add use case for 1870_control +. add "-ignore_ic_year" commandline arg. This is analogous to the + -ignore_ic_date option except that the month/day part of the date are + still matched. This allows a run starting at 18700901 to use a + climatological initial file with a date 901. + +models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +. update names of some trop_mozart_aero files +. add prescribed aerosol dataset for 1870 climatology + +models/atm/cam/bld/cam_inparm.pm +. changed defaults so that prognostice aerosols are radiatively passive +. update trop_mozart_aero +. update trop_mozart_prescribed_aero +. add trop_mozart_ghg_paero + +models/atm/cam/bld/config_definition.xml +models/atm/cam/bld/configure +. add new -chem option trop_mozart_ghg_paero + +models/atm/cam/bld/SeqCCSM_namelist.pm +. add code to build method to parse the namelist file that's providing the + use case defaults + +models/atm/cam/bld/compnl.pm +. modify attribute matching in defaults files to allow only a month/day + match of the ic_ymd attribute + +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +. specify dry mmr when adding constituents + +models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +. fix mass calculations to assume dry mixing ratios +. sum the masses of the 4 sea salt constituents to provide the single sea + salt bin requested by current radiative optics package. + +models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 +. fix mass to volume mixing ratio conversions to assume dry mixing ratios + +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +. add fix to init of file%filenames +. Replace hardcoded Fortran unit numbers by calls to the shr_file_getUnit + and shr_file_freeUnit routines in the shr_file_mod module. +. add '/' separator between path and fname parts of filepath. + +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_fstrat.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_mean_mass.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 +models/atm/cam/src/chemistry/trop_mozart/rad_cnst_data_interface.F90 +models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 +models/atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +models/atm/cam/src/chemistry/trop_mozart/tracer_srcs.F90 +. mods for trop_mozart_ghg_paero package + +models/atm/cam/src/control/runtime_opts.F90 +. remove initialization of scon from preset. Move to cam_control_mod.F90. +. add namelist variables for reading prescribed ozone +. add namelist variables to specify whether the prescribed data is serial + or cyclical + +models/atm/cam/src/control/cam_control_mod.F90 +. add initializer for scon (1367 W/m^2) + +models/atm/cam/src/control/ccsm_msg.F90 +. Move the t_startf/t_stopf calls to fix a bug that resulted from the calls + to t_adj_detailf(+2) during initialization (this prevented a t_startf + call from being made in initialization whose matching t_stopf call during + the run phase then became unmatched). + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +. Move !$omp directive inside the SPMD ifdef at line 1392. Otherwise a + syntax error (on ibm) was encountered when compiling for no SPMD. + +models/atm/cam/tools/defineqflux/timediddle_mavg.c +. Include the stdlib.h header file -- needed for correct malloc declaration. + +models/drv/seq_mct/seq_flux_mct.F90 +. Move calls to mct_gGrid_exportRAttr so they are only called once rather + than every step. This avoids a memory leak discovered in the mct code. + It's also a better to just make these calls once even without a memory + leak. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +037 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 + +These baseline tests should fail due to changing the treatment of constituents +by trop_mozart from wet to dry mixing ratio. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for trop_mozart_* chemistry + +=============================================================== +=============================================================== + +Tag name: cam3_4_12 +Originator(s): Francis Vitt, eaton +Date: Wed May 2 16:02:20 MDT 2007 +One-line Summary: + Addition of prescribed aerosols chemistry package with changes + to dust and trop_mozart external forcings. + +Purpose of changes: + The new chemistry package and code changes are needed to be able to + read the prescribed aerosol distributions that will be generated by + runs with the prognostic aerosol package which was added at cam3_4_11. + Note that both new aerosol packages are undergoing testing and + should not be used for scientific purposes. CAM by default is still + using the CAM-3.0 prescribed aerosol climatology. + + Update CLM to clm3_4_1. + + Update the CLM namelist defaults file. + +Bugs fixed (include bugzilla ID): + - vertical emissions altitude (external forcing) is now set to + height relative to surface + - trop_mozart interactive dry deposition broadcast days of + climatological soil water data to all MPI tasks + +Describe any changes made to build system: + chemistry option added to configure script + -chem trop_mozart_prescribed_aero + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + Update the CLM namelist defaults to use the correct PFT file, + the latest fsurdat file for FV 1.9x2.5, and a fully spun up IC file + for FV 1.9x2.5. + +Describe any substantial timing or memory changes: not yet tested... + +Code reviewed by: Brian Eaton, Francis Vitt + +List all subroutines eliminated: + +List all subroutines added and what they do: +--- models/atm/cam/bld/config_defaults_trop_mozart_prescribed_aero.xml + needed to configure new trop_mozart_prescribed_aero chemistry package + +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_lu_solve.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_setrxt.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/m_rxt_id.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_phtadj.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_nln_matrix.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_adjrxt.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/m_het_id.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_lu_factor.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_indprd.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_sim_dat.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/m_spc_id.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_imp_sol.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/chem_mods.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_prod_loss.F90 +--- models/atm/cam/src/chemistry/trop_mozart_prescribed_aero/mo_lin_matrix.F90 + code files for the new trop_mozart_prescribed_aero chemistry package + +List all existing files that have been modified, and describe the changes: +--- models/atm/cam/bld/configure +--- models/atm/cam/bld/config_definition.xml + added -chem trop_mozart_prescribed_aero configure option + +--- models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +--- models/atm/cam/bld/cam_inparm.pm + default namelist settings for the trop_mozart_prescribed_aero chemistry + +--- models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml + new PFT file, updated fsurdat file for FV 1.9x2.5, new spun-up IC + file for FV 1.9x2.5 + +--- models/atm/cam/src/control/runtime_opts.F90 + replaced pcnst with MAXTRCS to allow then number of prescribed tracers + to excede the number of prognostic tracers + +--- models/atm/cam/src/physics/cam/dust_intr.F90 + Natalie's tuned dust module + +--- models/atm/cam/src/physics/cam/aerosol_radiation_interface.F90 + allow radiative feedbacks from prescribed aerosols + +--- models/atm/cam/src/chemistry/trop_mozart/mo_setext.F90 +--- models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 + invoke external forcing routine (vert emis) with relative height + +--- models/atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 + don't do anything if trop_mozart does not solve for any species (gascnt < 1) + +--- models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 + don't do anything if trop_mozart does not have any "user" reactions + +--- models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 + changed some log messages + +--- models/atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 + changed some log messages + +--- models/atm/cam/src/chemistry/trop_mozart/mo_extfrc.F90 + added diagnostic output to history + +--- models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + chem_is_active = .false. if imozart < 1 + +--- models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + don't try to open data files if number of dry dep tracers is zero + MPI broadcast days of the climatology soil data + +--- models/atm/cam/src/chemistry/trop_mozart_aero/mo_setrxt.F90 + change rates of CB1->CB2 and OC1->OC2 transitions + +--- models/atm/cam/src/chemistry/trop_mozart_aero/mo_imp_sol.F90 + xnox species added to preprossor -- no real change for trop_mozart_aero + +--- models/atm/cam/src/chemistry/trop_mozart_aero/chem_mods.F90 + preprocessor changes for label rxt rates output -- no real change for trop_mozart_aero + +--- SVN_EXTERNAL_DIRECTORIES + new CLM external + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +037 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 + Changes to the dust caused changes to the chemical species via the + interactive photolysis rates which in turn changed radiation + feedbacks via the sulfur aerosol cycle. + +tempest: All Pass + +bangkok/lf95: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_4_11 with the CLM namelist defaults modified to use the same new + files as this tag so that the baseline tests would pass. + +Summarize any changes to answers: BFB except for trop_mozart + +=============================================================== +=============================================================== + +Tag name: cam3_4_11 +Originator(s): eaton, fvitt +Date: Fri Apr 20 16:40:53 MDT 2007 +One-line Summary: mods to deep convection, cloud fraction and aerosols; + update CLM and timing lib externals + +Purpose of changes: + +. Add dilute plume and convective momentum transport mods from Neale and + Richter to ZM deep convection parameterization. + +. Add a call to the cloud fraction routine after pcond (cloud microphysics) + and move the outfld calls for the cloud fraction fields to be after this + new call to cldfrc (Sungsu Park). + +. Add the Vavrus "freeze dry" mod. + +. Update to latest timing library tag (timing_070328). This fixes the + regression tests that were failing on tempest. + +. Update to the latest CLM trunk tag (clm3_expa_98). + +. The initial version of a new aerosol package is included, but should not + be used for scientific purposes. It will be updated shortly with mods + required to produce an acceptable aerosol simulation. + +. Add debug flags for pathscale to fix a problem with the regression tests + on lightning (fix from Jim Edwards). + +. Update the sample run scripts (from Mat Rothstein) + +Bugs fixed (include bugzilla ID): + + ID 409 - aqua-planet tests in cam3_4_04 fail on tempest + ID 434 - fix fsnsoi gensom problem + +Describe any changes made to build system: + +. the new aerosol package is enabled by specifying "-chem trop_mozart_aero" + to configure + +Describe any changes made to the namelist: + +. some emissions datasets names have been added to build-namelist, but the + datasets have not yet been moved to the standard locations. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +models/atm/cam/bld/config_defaults_trop_mozart_aero.xml +. configuration file for new chemistry package + +models/atm/cam/src/chemistry/trop_mozart_aero/chem_mods.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/m_het_id.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/m_rxt_id.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/m_spc_id.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_adjrxt.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_imp_sol.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_indprd.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_lin_matrix.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_lu_factor.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_lu_solve.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_nln_matrix.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_phtadj.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_prod_loss.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_setrxt.F90 +models/atm/cam/src/chemistry/trop_mozart_aero/mo_sim_dat.F90 +. source code for new chemistry package + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNALS_DIRECTORIES +. update CLM and timing lib externals + +models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +. new files for trop_mozart_aero package + +models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +. update fsurdat file for FV 1.9x2.5 only + +models/atm/cam/bld/cam_inparm.pm +. add support for trop_mozart_aero namelist vars + +models/atm/cam/bld/config_definition.xml +models/atm/cam/bld/configure +. add "trop_mozart_aero" option to -chem arg of configure + +models/atm/cam/bld/Makefile.in +. add -trapuv -Wuninitialized to debug flags for pathf90 + +models/atm/cam/bld/run-ibm.csh +models/atm/cam/bld/run-pc.csh +models/atm/cam/bld/run-sgi.csh +models/atm/cam/bld/run-lightning.csh +models/atm/cam/bld/run-darwin.csh +. updates to the sample run scripts + +models/atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_extfrc.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setext.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_usrrxt.F90 +models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 +models/atm/cam/src/physics/cam/sulchem.F90 +. mods for new chem package + +models/atm/cam/src/physics/cam/cloud_fraction.F90 +. add Vavrus "freeze dry" mod + +models/atm/cam/src/physics/cam/physconst.F90 +. add some constants for water (values from shr_const_mod) + +models/atm/cam/src/physics/cam/radiation.F90 +. remove concld from dummy args of radiation_tend -- use physics buffer + +models/atm/cam/src/physics/cam/stratiform.F90 +. remove concld from dummy args of stratiform_tend -- use physics buffer +. add call to cldfrc after pcond +. move outfld calls for cloud fraction fields to after cldfrc after pcond + +models/atm/cam/src/physics/cam/tphysbc.F90 +. remove local var concld as actual arg to stratiform_tend and + radiation_tend calls + +models/atm/cam/src/physics/cam/zm_conv.F90 +. add mods for convective momentum transport and dilute plumes + +models/atm/cam/src/physics/cam/zm_conv_intr.F90 +. add calls for convective momentum transport to zm_conv_tend +. add diagnostic output + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +014 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +018 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 +034 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +056 bl711 TBL.sh h5x8dm adia 9s ...................................FAIL! rc= 7 + +. The Eulerian and FV baselines fail (bl151, bl375) due to a roundoff diff in + a single diagnostic field (SWCF) introduced at cam3_4_07 + +. The HOMME baseline fails (bl711) due to answer changes introduced at cam3_4_10. + +. The FV baseline that tests the gensom mode (bl331) fails due to the gensom + bugfix. + +tempest: All PASS except: + +021 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 + +. bl331 fails for the same reason as on bluevista. + +. Note that updating to the new timing lib fixed the problems with the + aqua-planet tests. + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: conv09_cam3_4_03 -- *** NOTE *** this tag was used for baseline + comparisons to validate that the new physics was merged from the + branch to the trunk correctly. All baseline tests that exercise the + standard physics will fail when this code is compared to cam3_4_10. + +Summarize any changes to answers, i.e., +- what code configurations: All that use standard cam physics +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? N.A. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): conv09_cam3_4_03 +- platform/compilers: CrayXT (jaguar) / pgi-6.2.5 (-fast optimization) +- configure commandline: + + configure -fc ftn -dyn fv -res 1.9x2.5 -fopt "-fast" -spmd -nosmp -cppdefs "-DCATAMOUNT" + +- build-namelist command (or complete namelist): + + build-namelist -s -case f1.9m_conv09 -config $blddir/config_cache.xml \ + -namelist "&camexp start_type='startup' stop_option='nmonths' stop_n=1 + mss_irt=0 restart_option='monthly' restart_n=1 + phys_loadbalance=2 npr_yz=32,8,8,32 + rest_pfile='./rpointer.cam' / + &clmexp rpntpath='./rpointer.clm' + finidat='/tmp/work/eaton/inputdata/clmi_0000-09-01_1.9x2.5_gx1v4_c070311.nc' /" + +- MSS location of output: + + Only climo files used to produce AMWG diagnostics were saved. + mss:/EATON/CASE/conv09_cam3_4_03/f1.9m_conv09/climo_0001-0006.tar + +MSS location of control simulations used to validate new climate: + + This run was compared against the simulation done with conv07_cam3_4_03 + mss:/EATON/CASE/conv07_cam3_4_03/f1.9h_conv07/climo_0001-0006.tar + +URL for AMWG diagnostics output used to validate new climate: + + http://www.cgd.ucar.edu/cms/rneale/runs/cam/cam3_4_03_conv09-cam3_4_03_conv07/ + + +=============================================================== +=============================================================== + +Tag name: cam3_4_10 +Originator(s): Jim Edwards +Date: 4-16-07 +One-line Summary: Fix problems commited in cam3_4_09 + +Purpose of changes: cam3_4_09 had problems which made it unusable + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +models/atm/cam/src/dynamics/fv/inidat.F90 +models/atm/cam/src/physics/cam/co2_cycle.F90 +models/atm/cam/src/control/ncdio_atm.F90 + +Fixed formatting and module use errors that managed to get past the +precommit testing for cam3_4_09 + +models/atm/cam/test/system/CAM_runcmnd.sh +models/atm/cam/test/system/test_driver.sh +fixes to test system on bangkok + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All passed except: + bl711 TBL.sh h5x8dm adia 9s + HOMME Dycore test expected failure due to restructuring + +tempest: all pass except +008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 +025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 +039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_4_08 + +Summarize any changes to answers, i.e., + - what code configurations: - what platforms/compilers: - nature + of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_4_09 +Originator(s): Jim Edwards +Date: 04-13-07 +One-line Summary: Merge of HOMME dycore development branch + +Purpose of changes: Update with latest HOMME development + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, Eaton + +List all subroutines eliminated: +D models/atm/cam/src/dynamics/homme/external/math_constants.F90 +D models/atm/cam/src/dynamics/homme/external/stats.h +D models/atm/cam/src/dynamics/homme/external/preq_init_mod.F90 +D models/atm/cam/src/dynamics/homme/external/utils_mod.F90 +D models/atm/cam/src/dynamics/homme/external/locate.F90 +D models/atm/cam/src/dynamics/homme/external/torus_mod.F90 +D models/atm/cam/src/dynamics/homme/external/stats.F90 +D models/atm/cam/src/dynamics/homme/external/field_mod.F90 +D models/atm/cam/src/dynamics/homme/external/types_mod.F90 +D models/atm/cam/src/dynamics/homme/external/generic_list.F90 +D models/atm/cam/src/dynamics/homme/external/ref_state_mod.F90 +D models/atm/cam/src/dynamics/homme/external/vertex_mod.F90 +D models/atm/cam/src/dynamics/homme/external/rotation_init.F90 +D models/atm/cam/src/dynamics/homme/external/vertical_mod.F90 +D models/atm/cam/src/dynamics/fv/xpavg.F90 + +List all subroutines added and what they do: +A models/atm/cam/src/dynamics/homme/external/prim_driver_mod.F90 + driver module for the HOMME dycore +A models/atm/cam/src/utils/xpavg_mod.F90 + moved from dynamics/fv/xpavg.F90 to facilitate use in ncdio.F90 + +List all existing files that have been modified, and describe the changes: +U models/atm/cam/test/system/config_files/h5x8dm +U models/atm/cam/bld/DefaultCTL_NL_Namelist.xml + Added -lapack_libdir argument and modified namelist for h5xdm testcase + +U models/atm/cam/src/control/ncdio_atm.F90 +U models/atm/cam/src/control/startup_initialconds.F90 +U models/atm/cam/src/control/cam_comp.F90 +U models/atm/cam/src/physics/cam/aer_optics.F90 +U models/atm/cam/src/physics/cam/physpkg.F90 +U models/atm/cam/src/physics/cam/prescribed_aerosols.F90 +U models/atm/cam/src/physics/cam/phys_buffer.F90 +U models/atm/cam/src/physics/cam/phys_grid.F90 +U models/atm/cam/src/dynamics/sld/inidat.F90 +U models/atm/cam/src/dynamics/sld/inital.F90 +U models/atm/cam/src/dynamics/eul/inidat.F90 +U models/atm/cam/src/dynamics/eul/inital.F90 +U models/atm/cam/src/dynamics/fv/inidat.F90 +U models/atm/cam/src/dynamics/fv/p_d_adjust.F90 +U models/atm/cam/src/dynamics/fv/inital.F90 + moved initialization of fields used only in physics from + dynamics/*/inidat.F90 to physpkg.F90 and moved around + initialization to handle this change this allowed us to remove + code duplicated for each dycore and avoid a special case for HOMME + initialization. However a special case was inserted in ncdio.F90 + for the fv core initialization to handle the pole average scheme + xpavg.F90, this was done to maintain bfb results with that core. + +U models/atm/cam/src/physics/cam/co2_cycle.F90 + fixed a bug in constituent initialization + +U models/atm/cam/src/dynamics/homme/external/flops_mod.F90 +U models/atm/cam/src/dynamics/homme/external/filter_mod.F90 +U models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 +U models/atm/cam/src/dynamics/homme/external/mass_matrix_mod.F90 +U models/atm/cam/src/dynamics/homme/external/forcing_mod.F90 +U models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 +U models/atm/cam/src/dynamics/homme/external/cg_mod.F90 +U models/atm/cam/src/dynamics/homme/external/reduction_mod.F90 +U models/atm/cam/src/dynamics/homme/external/schedule_mod.F90 +U models/atm/cam/src/dynamics/homme/external/spacecurve_mod.F90 +U models/atm/cam/src/dynamics/homme/external/derivative_mod.F90 +U models/atm/cam/src/dynamics/homme/external/prim_si_mod.F90 +U models/atm/cam/src/dynamics/homme/external/gridgraph_mod.F90 +U models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +U models/atm/cam/src/dynamics/homme/external/metagraph_mod.F90 +U models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 +U models/atm/cam/src/dynamics/homme/external/surfaces_mod.F90 +U models/atm/cam/src/dynamics/homme/external/quadrature_mod.F90 +U models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 +U models/atm/cam/src/dynamics/homme/external/coordinate_systems_mod.F90 +U models/atm/cam/src/dynamics/homme/external/cube_mod.F90 +U models/atm/cam/src/dynamics/homme/external/control_mod.F90 +U models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 +U models/atm/cam/src/dynamics/homme/external/linear_algebra_mod.F90 +U models/atm/cam/src/dynamics/homme/external/element_mod.F90 +U models/atm/cam/src/dynamics/homme/external/prim_si_ref_mod.F90 +U models/atm/cam/src/dynamics/homme/external/time_mod.F90 +U models/atm/cam/src/dynamics/homme/external/hybvcoord_mod.F90 +U models/atm/cam/src/dynamics/homme/external/baroclinic_inst_mod.F90 +U models/atm/cam/src/dynamics/homme/external/checksum_mod.F90 +U models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 +U models/atm/cam/src/dynamics/homme/external/edge_mod.F90 +U models/atm/cam/src/dynamics/homme/external/ll_mod.F90 +U models/atm/cam/src/dynamics/homme/external/thread_mod.F90 +U models/atm/cam/src/dynamics/homme/external/dof_mod.F90 +U models/atm/cam/src/dynamics/homme/external/physical_constants.F90 +U models/atm/cam/src/dynamics/homme/external/solver_mod.F90 +U models/atm/cam/src/dynamics/homme/external/timer.h +U models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 +U models/atm/cam/src/dynamics/homme/external/bndry_mod.F90 +U models/atm/cam/src/dynamics/homme/external/timer_mod.F90 +U models/atm/cam/src/dynamics/homme/external/metis_mod.F90 +U models/atm/cam/src/dynamics/homme/external/hybrid_mod.F90 +U models/atm/cam/src/dynamics/homme/dyn_grid.F90 +U models/atm/cam/src/dynamics/homme/initcom.F90 +U models/atm/cam/src/dynamics/homme/dp_coupling.F90 +U models/atm/cam/src/dynamics/homme/stepon.F90 +U models/atm/cam/src/dynamics/homme/inidat.F90 +U models/atm/cam/src/dynamics/homme/dyn_comp.F90 +U models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +U models/atm/cam/src/dynamics/homme/inital.F90 + + A cleanup and restructuring of the HOMME dycore interface. + Variables that do not need to be exposed to the model interface + are now hidden. A number of subroutines that are not used by + cam have been removed. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All passed except: + bl711 TBL.sh h5x8dm adia 9s + HOMME Dycore test expected failure due to restructuring + +tempest: All passed except problems carried over from previous commit: +008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 +025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 +039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 + +bangkok/lf95: All passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_4_08 +Originator(s): mvr, eaton +Date: 29 Mar 2007 + +One-line Summary: +svn external definitions simplified; changes to ccsm testing from within cam; +directory name change: physics/cam1 -> physics/cam; ccsm filepath will now +be identical to stand-alone cam; several unrelated bug fixes + +Purpose of changes: +attempting to clean up some long standing issues with regards to multiple +external definitions for a single component and directory structure +differences between ccsm and stand-alone cam...this will help with testing +ccsm from within cam + +Bugs fixed (include bugzilla ID): 420 & 425 + +Describe any changes made to build system: +ccsm filepath now identical to stand-alone cam...the external definitions for +ccsm tags using this cam tag (and thereafter) will need to reflect these mods + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvr, eaton + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam1 +- directory and contents moved to ~physics/cam + +List all subroutines added and what they do: +A models/atm/cam/src/physics/cam +- directory and contents moved from ~physics/cam1 + +List all existing files that have been modified, and describe the changes: + M . +M SVN_EXTERNAL_DIRECTORIES +- condensed number of external definitions; now pulling in all csm_share code +M models/ocn/dom/ocn_comp_mct.F90 +- bug fix for restart_option="none" (bug# 425) +M models/atm/cam/test/system/TSB.ccsm.sh +- mod to run ccsm tests in regular queue by default rather than premium +M models/atm/cam/test/system/TCT.ccsm.sh +- mods to run ccsm tests either with just the cam code from users sandbox or + with all available sandbox code if env var is set +M models/atm/cam/test/system/test_driver.sh +- will now grab latest ccsm tag in 3_5 beta sequence for testing; increase + job time for posttag testing on lightning +M models/atm/cam/test/system/tests_posttag_bluevista +M models/atm/cam/test/system/tests_pretag_bluevista +M models/atm/cam/test/system/tests_posttag_blueice +- change default test lists to move all ccsm testing to posttag +M models/atm/cam/bld/configure +- mods to support directory name change of physics/cam1 -> physics/cam; + ccsm filepath will now be the same as for stand-alone cam +M models/atm/cam/src/control/cam_history.F90 +- bug fix for restarts of fixed length intervals (bug# 420) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS + +tempest: +008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 +025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 +039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 +- carried over from previous commit + +bangkok/lf95: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_4_07 +Originator(s): John Truesdale +Date: +One-line Summary: SCM mode cleanup and additional namelist + functionality + +Purpose of changes: replace scm specific netcdf routines with + standard model calls and add surface forcing functionality + to scm cam mode. Also added hooks for relaxation to + obs and column radiation only modes to scm. + +Bugs fixed (include bugzilla ID): na + +Describe any changes made to build system: na + +Describe any changes made to the namelist: Added some new + namelist variables for control of single column mode + of scam. New namelist variables are + scm_iop_srf_prop = .TRUE. if using iop surface properties + scm_relaxation = .TRUE. if relaxing solution back to obs + scm_diurnal_avg = .TRUE. currently just a place holder for + diurnal averaging + scm_crm_mode = .TRUE. run scm in column radiation mode + +List any changes to the defaults for the boundary datasets: na + +Describe any substantial timing or memory changes: na + +Code reviewed by: truesdale + +List all subroutines eliminated: + + getnetcdfdata.F90 - extracted the setlatlonidx functionality from this + routine and got rid of the rest. Created new + subroutine for setlatlonidx. + +List all subroutines added and what they do: + + setlatlonidx.F90 - determines closest boundary dataset lat lon to + that specified in the namelist for single column mode. + +List all existing files that have been modified, and describe the changes: + + The following changes removed scam specific netcdf code and + replaced it with standard cam netcdf calls. + + models/atm/cam/src/control/ncdio_atm.F90 + models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 + models/atm/cam/src/physics/cam1/iop.F90 + models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + models/lnd/clm2/src/biogeochem/STATICEcosysDynMod.F90 + models/lnd/clm2/src/main/iniTimeConst.F90 + models/lnd/clm2/src/main/ncdio.F90 + models/lnd/clm2/src/main/surfrdMod.F90 + models/ice/csim4/ice_data.F90 + models/ocn/dom/sst_data.F90 + + + The following changes added new scm functionality to CAM. + + models/atm/cam/src/control/atm_comp_mct.F90 + models/atm/cam/src/control/history_scam.F90 + models/atm/cam/src/control/runtime_opts.F90 + models/atm/cam/src/control/scamMod.F90 + models/atm/cam/src/dynamics/eul/dynpkg.F90 + models/atm/cam/src/dynamics/eul/forecast.F90 + models/atm/cam/src/physics/cam1/physics_types.F90 + models/atm/cam/src/physics/cam1/physpkg.F90 + models/atm/cam/src/physics/cam1/radiation.F90 + models/atm/cam/src/physics/cam1/radlw.F90 + models/atm/cam/src/physics/cam1/radsw.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: + 035 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 + 059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + + Notes: test 059 is a known failure for the last few commits. + test 035 failed on the history tape compare for one value of one + the SWCF field. I reran the test per Eaton's suggestion + compiling with debug on and it passed. Conclusion is + that the models are bit for bit in the prognostics but + because of a compiler optimization are getting a least + significant bit flip in one diagnostic field. + +tempest: + 008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 + 009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 + 025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 + 026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 + 039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 + 040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 + + These aquaplanet tests are known failures for the previous few commits. + +bangkok/lf95: + All tests pass + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_4_06 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): bit-for-bit on all platforms. One roundoff diagnostic on bluevista + which subsequently passed when run with debug turned on. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? Turn on debug and they went away. Also the difference in + absolute values was in the least significant bit of one number in + the domain. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_4_06 +Originator(s): eaton +Date: Wed Mar 14 12:12:51 MDT 2007 +One-line Summary: refactor configure script + +Purpose of changes: + +. Refactor the configure script by moving the generic functionality of + managing a configuration file into a new module (Build::Config), and + leave the CAM specific parts in the configure script. A detailed design + with instructions for how to modify and extend configure is being + prepared as part of a new CAM Developer's Guide. + + configure's commandline interface contains the following changes: + + . -nlat, -nlon, -trk, -trm, -trn have been removed as well as removing the + "custom" option to -res. A new resolution is added by putting the + appropriate entry in the config_horiz_grid.xml file. + + . The -res argument is being replaced by the option -hgrid to specify the + horizontal grid. The -res argument will be supported for backwards + compatibility. + + . -nnadv has been removed since the feature of "non-advected + constituents" was removed at cam3_3_47. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: + +. new configure script. +. build-namelist updated to use new Build::Config module to read the + config_cache.xml file (which has a new structure). + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + +models/atm/cam/bld/config_cam_eul_defaults.xml +models/atm/cam/bld/config_cam_fv_defaults.xml +models/atm/cam/bld/config_cam_homme_defaults.xml +models/atm/cam/bld/config_cam_sld_defaults.xml +models/atm/cam/bld/config_trop_chem_mozart_defaults.xml +models/atm/cam/bld/config_waccm_ghg_defaults.xml +models/atm/cam/bld/config_waccm_mozart_defaults.xml +models/atm/cam/bld/resolution_parameters.xml +models/atm/cam/bld/system_defaults.xml + +List all subroutines added and what they do: + +models/atm/cam/bld/config_defaults_eul.xml +models/atm/cam/bld/config_defaults_fv.xml +models/atm/cam/bld/config_defaults_homme.xml +models/atm/cam/bld/config_defaults_sld.xml +models/atm/cam/bld/config_defaults_trop_mozart.xml +models/atm/cam/bld/config_defaults_waccm_ghg.xml +models/atm/cam/bld/config_defaults_waccm_mozart.xml +. The new defaults files contain just the values that need to be set + +models/atm/cam/bld/config_definition.xml +. The configuration definition lives in this file. This file contains + information about the config parameters such as valid values, and whether + the parameter can take a list of values. The config_cache.xml file + output by configure has the same structure and will contain the same + parameters as this file (though not in the same order). + +models/atm/cam/bld/config_definition.xsl +. An XSLT stylesheet for the config_definition.xml file. + +models/atm/cam/bld/config_horiz_grid.xml +. The horizonal grid specifiers are defined here. + +models/atm/cam/bld/config_sys_defaults.xml +. This is the old system_defaults.xml file renamed for consistency with the + other config_* files. + +models/atm/cam/bld/perl5lib/Build/Config.pm +. New Build::Config module. + +models/atm/cam/bld/perl5lib/t/01.t +models/atm/cam/bld/perl5lib/t/config_cache.xml +models/atm/cam/bld/perl5lib/t/config_definition.xml +models/atm/cam/bld/perl5lib/t/config_setup_eul.xml +models/atm/cam/bld/perl5lib/t/debug.t +. test code for the Build::Config module + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/perl5lib/XML/Changes +models/atm/cam/bld/perl5lib/XML/Lite.pm +models/atm/cam/bld/perl5lib/XML/Lite/Element.pm +models/atm/cam/bld/perl5lib/XML/README +models/atm/cam/bld/perl5lib/XML/man3/XML::Lite.3 +models/atm/cam/bld/perl5lib/XML/man3/XML::Lite::Element.3 +. The XML::Lite module has just been moved under perl5lib + +models/atm/cam/bld/CAM_config.pm +models/atm/cam/bld/build-namelist +. Update build-namelist to use the Build::Config module to read the + config_cache.xml file produced by configue. + +models/atm/cam/bld/configure +. complete refactoring to make use of new Build::Config module + +models/atm/cam/bld/mkDepends +. add fix for emacs fontlock + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +The CCSM test is failing due to a share code inconsistency. + +tempest: All PASS except: + +008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 +025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 +039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 + +The smoke tests started failing in cam3_4_04. Still looking into this. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_4_03. + +Summarize any changes to answers: none -- BFB. + +=============================================================== +=============================================================== + +Tag name: cam3_4_05 +Originator(s): mvertens +Date: Tue Mar 13 11:04:53 MDT 2007 +One-line Summary: upgraded to drvseq1_0_12 + +Purpose of changes:Updated component codes and driver to have flexibility +to recognize active versus data/dead atm/land components. This is needed to +optimize performance for4 certain component combinations such as datm/land coupling. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + - updated drv/seqmct to drvseq1_0_12 + - updated csm_share/[shr/eshf/flds] to share3_070305 + - updated clm2 to prof_clm3_expa_92_tags/prof02_clm3_expa_92 + +M models/ocn/dom/ocn_time_manager.F90 +M models/ocn/dom/ocn_comp_mct.F90 + updated to drvseq1_0_12 + +M models/ocn/som/ocn_time_manager.F90 +M models/ocn/som/ocn_comp_mct.F90 + updated to drvseq1_0_12 + +M models/ice/csim4/ice_time_manager.F90 +M models/ice/csim4/ice_comp_mct.F90 + updated to drvseq1_0_12 + +M models/atm/cam/src/control/atm_comp_mct.F90 + updated to drvseq1_0_12 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +tempest: All PASS except +008 sm133 TSM.sh e32pdh aqpgro 3s .................................FAIL! rc= 8 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 4 +025 sm333 TSM.sh f4pdh aqpgro 3s ..................................FAIL! rc= 8 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 4 +039 sm533 TSM.sh s32pdh aqpgro 3s .................................FAIL! rc= 8 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 4 + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam3_4_04 +Originator(s): pworley +Date: Fri Mar 9 09:00:00 EST 2007 +One-line Summary: new profiling interface; one processor EUL/SLD MPI fix + +Purpose of changes: + +. Add new profiling interface, isolating all calls to underlying timing + library in perf_mod.F90 + +. Replace compile time profiling options with runtime options via + a new namelist prof_inparm (in drv_in) + +. Add support for one process MPI runs in the EUL and SLD dycores + +Bugs fixed (include bugzilla ID): + +. disabled a few shr_sys_flush(6) calls that caused the code + to crash on UNICOSMP systems (Cray X1/X1E) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +. Added prof_inparm namelist: + profile_disable, profile_barrier, profile_single_file, + profile_depth_limit, profile_detail_limit, profile_timer + to drv_in + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: pworley + +List all subroutines eliminated: + +. ccsm_seq_timer_init (in con_cam.F90 and in seq_ccsm_drv.F90) + +List all subroutines added and what they do: + +in perf_mod.F90: + t_initf: replacement for ccsm_seq_timer_init, including support + for new namelist prof_inparm + t_profile_onf: logical function indicating whether profiling is active + at this point in the code + t_barrier_onf: logical function indicating whether timing barriers are + enabled + t_single_filef: logical function indicating whether one file or one + file per process should be generated for timing and spmdstats data + t_adj_detailf: increment or decrement timing detail level + t_barrierf: if enabled, t_startf(XXX), shr_sys_barrier, t_stopf(XXX) + t_finalizef: timing library clean-up + +in FVperf_module.F90: + FVbarrierclock: if enabled, t_startf(XXX), mp_barrier, t_stopf(XXX) + +List all existing files that have been modified, and describe the changes: + +in CAM: +atm/cam/bld/NamelistsDescriptions.xml +atm/cam/bld/SeqCCSM_namelist.pm +atm/cam/bld/camexp.pm +atm/cam/bld: prof_inparm.pm +. added support to generate new namelist (prof_inparm) within drv_in + (contributed by Brian Eaton) + +atm/cam/src/dynamics/eul/spmd_dyn.F90 +atm/cam/src/dynamics/sld/spmd_dyn.F90 +. added support for 1 processor MPI (SPMD) runs + +atm/cam/src/chemistry/trop_mozart/chemistry.F90 +atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +atm/cam/src/chemistry/trop_mozart/tracer_data.F90 +atm/cam/src/chemistry/waccm_mozart/chemistry.F90 +atm/cam/src/chemistry/waccm_mozart/iondrag.F90 +atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 +atm/cam/src/chemistry/waccm_mozart/spedata.F90 +atm/cam/src/control/cam_history.F90 +atm/cam/src/control/ccsm_msg.F90 +atm/cam/src/control/wrap_mpi.F90 (when WRAP_MPI_TIMING defined) +atm/cam/src/dynamics/eul/dyndrv.F90 +atm/cam/src/dynamics/eul/dynpkg.F90 +atm/cam/src/dynamics/eul/scandyn.F90 +atm/cam/src/dynamics/eul/stepon.F90 +atm/cam/src/dynamics/fv/metdata.F90 +atm/cam/src/dynamics/homme/dp_coupling.F90 +atm/cam/src/dynamics/homme/dyn_comp.F90 +atm/cam/src/dynamics/homme/stepon.F90 +atm/cam/src/dynamics/sld/dyndrv.F90 +atm/cam/src/dynamics/sld/dynpkg.F90 +atm/cam/src/dynamics/sld/scandyn.F90 +atm/cam/src/dynamics/sld/stepon.F90 +atm/cam/src/physics/cam1/advnce.F90 +atm/cam/src/physics/cam1/cloudsimulator.F90 +atm/cam/src/physics/cam1/convect_ke_intr.F90 +atm/cam/src/physics/cam1/molec_diff.F90 +atm/cam/src/physics/cam1/phys_gmean.F90 +atm/cam/src/physics/cam1/prescribed_aerosols.F90 +atm/cam/src/physics/cam1/radiation.F90 +atm/cam/src/physics/cam1/stratiform.F90 +atm/cam/src/physics/cam1/sulchem.F90 +atm/cam/src/physics/cam1/tphysac.F90 +atm/cam/src/physics/cam1/tphysbc.F90 +atm/cam/src/physics/cam1/vertical_diffusion.F90 +atm/cam/src/physics/cam1/zm_conv_intr.F90 +atm/cam/src/physics/waccm/radheat.F90 +ice/csim4/ice_comp.F90 +ice/csim4/ice_comp_mct.F90 +ice/csim4/ice_dh.F +ice/csim4/ice_srf.F90 +ocn/dom/ocn_comp.F90 +ocn/dom/ocn_comp_mct.F90 +ocn/som/mixed_layer.F90 +ocn/som/ocn_comp.F90 +ocn/som/ocn_comp_mct.F90 +utils/pilgrim/mod_comm.F90 (when TIMING defined) +utils/pilgrim/unit_testers/ghosttest.F90 (when MODCM_TIMING defined) +utils/pilgrim/unit_testers/parpatterntest.F90 (when MODCM_TIMING defined) +utils/pilgrim/unit_testers/redistributetest.F90 (when MODCM_TIMING defined) +. added 'use perf_mod' + +atm/cam/src/control/atm_comp_mct.F90 +. added 'use perf_mod' and one new timer event + +atm/cam/src/dynamics/eul/courlim.F90 +atm/cam/src/dynamics/eul/linemsdyn.F90 +atm/cam/src/dynamics/eul/scan2.F90 +atm/cam/src/dynamics/eul/scanslt.F90 +atm/cam/src/dynamics/eul/spegrd.F90 +atm/cam/src/dynamics/sld/courlim.F90 +atm/cam/src/dynamics/sld/scan2.F90 +atm/cam/src/dynamics/sld/scanslt.F90 +atm/cam/src/dynamics/sld/spegrd.F90 +atm/cam/src/physics/cam1/phys_grid.F90 +atm/cam/src/dynamics/eul/dp_coupling.F90 +atm/cam/src/dynamics/fv/dp_coupling.F90 +atm/cam/src/dynamics/fv/dyn_comp.F90 +atm/cam/src/dynamics/fv/stepon.F90 +atm/cam/src/dynamics/sld/dp_coupling.F90 +. added 'use perf_mod', added mpicom definition for no-SPMD case + where necessary, and replaced TIMING_BARRIERS logic with t_barrierf + +atm/cam/src/control/cam_comp.F90 +. added 'use perf_mod', added mpicom definition for no-SPMD case, + replaced TIMING_BARRIERS logic with t_barrierf, eliminated (via ifdef) + shr_sys_flush(6) for UNICOSMP, and replaced MULTIPLE_PERF_FILES + logic with t_single_filef logic for spmdstats + +atm/cam/src/control/con_cam.F90 +. added 'use perf_mod', removed call to usetlbuf (on CATAMOUNT), + replaced definition and call to ccsm_seq_timer_init with call to + t_initf, moved timer initialization, added t_adj_detailf(+2/-2) + to 'hide' initialization in default timing, added additional + timers (many sets, to match seq_ccsm_drv), modified t_prf call, + and added new t_finalizef call + +atm/cam/src/dynamics/fv/FVperf_module.F90 +. added 'use perf_mod' (when not in GEOS_MODE) and added + FVbarrierclock (as interface to t_barrierf, eventually; + implemented exlicitly until mpicom is exposed in Pilgrim + and modcomm calls) + +atm/cam/src/dynamics/fv/cd_core.F90 +atm/cam/src/dynamics/fv/trac2d.F90 +. replaced TIMING_BARRIERS logic with FVbarrierclock + +atm/cam/src/physics/cam1/physpkg.F90 +. added 'use perf_mod', added mpicom definition for no-SPMD case, + replaced TIMING_BARRIERS logic with t_barrierf, added t_adj_detailf(+1/-1) + to hide instrumentation inside chunking loops + +in CLM2 +lnd/clm2/src/main/atmdrvMod.F90 +lnd/clm2/src/main/clm_comp.F90 +lnd/clm2/src/main/clm_csmMod.F90 +lnd/clm2/src/main/program_csm.F90 +lnd/clm2/src/main/program_off.F90 +. added 'use perf_mod' + +lnd/clm2/src/main/lnd_comp_mct.F90 +lnd/clm2/src/riverroute/RtmMod.F90 +lnd/clm2/src/main/driver.F90 +. added 'use perf_mod', added mpicom definition for no-SPMD case where + necessary, and replaced TIMING_BARRIERS logic with t_barrierf + +lnd/clm2/src/main/decompMod.F90 +. eliminated (via ifdef) shr_sys_flush(6) for UNICOSMP + +in DRV +drv/seq_mct/seq_ccsm_drv.F90 +. added 'use perf_mod', removed call to usetlbuf (on CATAMOUNT), + replaced definition and call to ccsm_seq_timer_init with call to + t_initf, moved timer initialization, added t_adj_detailf(+2/-2) + to 'hide' initialization in default timing, replaced TIMING_BARRIERS + logic with t_barrierf, remove MULTIPLE_PERF_FILES logic and use + modified t_prf call, added new t_finalizef call, deleted stop 0. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except + +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +This test was also failing in the previous tag. + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +=============================================================== +=============================================================== + +Tag name: cam3_4_03 +Originator(s): mvertens, andrew, eaton +Date: Fri Mar 2 08:15:42 MST 2007 +One-line Summary: restart bug fix; mod in radforce for lf95/debug + +Purpose of changes: + +. Fix restart bug (see below). + +. Add mod to radforce code to make lf95/debug work. This is just changing + a full array copy (1:pcols) to a copy of only the subsection (1:ncol). + +Bugs fixed (include bugzilla ID): + +. [ID 405] The code currently crashes when writing the restart pointer + files for the dom, som, and csim components unless the user has + explicitly set these names via the namelist. This has be fixed by + providing appropriate default values. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/ice/csim4/ice_comp.F90 +models/ocn/dom/ocn_comp.F90 +models/ocn/som/ocn_comp.F90 +. add default for rest_pfile + +models/atm/cam/test/system/nl_files/aqpgro +models/atm/cam/test/system/nl_files/fv2d_4tsk +models/atm/cam/test/system/nl_files/fv2d_8tsk +models/atm/cam/test/system/nl_files/ghgrmp +models/atm/cam/test/system/nl_files/no_ttrac +models/atm/cam/test/system/nl_files/off2x2.5 +models/atm/cam/test/system/nl_files/off2x2.5p +models/atm/cam/test/system/nl_files/outfrq24h +models/atm/cam/test/system/nl_files/outfrq3s +models/atm/cam/test/system/nl_files/pghgsul +models/atm/cam/test/system/nl_files/scm_b4b_o1 +models/atm/cam/test/system/nl_files/scm_prep +models/atm/cam/test/system/nl_files/ttrac +models/atm/cam/test/system/nl_files/ttrac_lb1 +models/atm/cam/test/system/nl_files/ttrac_lb2 +models/atm/cam/test/system/nl_files/ttrac_lb3 +. remove setting of rest_pfile (the default is what we want to use) + +models/atm/cam/src/physics/cam1/radiation.F90 +. replace whole array assignments of pmxrgnrf and nmxrgnrf with versions + that copy the array section 1:ncol. This is to make lf95/debug happy. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except + +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +This test was also failing in the previous tag. + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam3_4_02 +Originator(s): cchen, sawyer, eaton +Date: Wed Feb 28 08:37:57 MST 2007 +One-line Summary: fix FV omega calc, misc bug fixes + +Purpose of changes: + +. A new implementation of the omega calculation fix originally applied in + cam3_3_3 was provided by Jack Chen, and made to work with OMP by Will + Sawyer. + +. A new subroutine, pbuf_setval, was added to the physics buffer module to + allow fields to be initialized to values other than the default (NaN). + +Bugs fixed (include bugzilla ID): + +. [ID387] Fix bug in FV mode reading an initial file that contains the + field DELP. + +. Fix for subroutine fstrat_inti in mo_fstrat.F90 (trop_mozart chem). + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cchen, sawyer, eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/src/dynamics/fv/dyn_comp.F90 +models/atm/cam/src/dynamics/fv/diag_module.F90 +models/atm/cam/src/dynamics/fv/cd_core.F90 +models/atm/cam/src/dynamics/fv/te_map.F90 +. FV omega fix + +models/atm/cam/src/physics/cam1/phys_buffer.F90 +. add pbuf_setval method for initializing physics buffer fields to values + other than the default (NaN). + +models/atm/cam/src/chemistry/trop_mozart/mo_fstrat.F90 (fstrat_inti) +. remove inappropriate uses of beglat, endlat. This fix didn't affect + results in the configurations tested by the regression tests. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: PASS except + +001 sb998 TSB.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 5 +019 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +027 bl334 TBL.sh f4dh adia 9s .....................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +035 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +038 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 7 +041 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +The CCSM test fails for same reason as in previous tag. + +The failed baseline tests are expected failures due to the change in the +diagnostic FV omega calculation. The only fields with diffs are OMEGA, +OMEGAT, UW3d and WTH3d. + +tempest: PASS except + +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +029 bl335 TBL.sh f4dh idphys 9s ...................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 + +The failed baseline tests are expected failures due to the change in the +diagnostic FV omega calculation. The only fields with diffs are OMEGA, +OMEGAT, UW3d and WTH3d. + +bangkok/lf95: PASS except + +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 7 +029 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 7 +031 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 + +These are expected failures due to the change in the diagnostic FV omega +calculation. The only fields with diffs are OMEGA and OMEGAT. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: Answers are BFB except for the diagnostic + FV omega calculation. + +=============================================================== +=============================================================== + +Tag name: cam3_4_01 +Originator(s): mvr, mvertens +Date: 27 Feb 2007 +One-line Summary: cam dom/som now called after cam run phase + +Purpose of changes: +Summary: Moved the ocean component to now be run after atmospheric component to + permit incorporation of an active ocean component that is only called + once per day. Made the driver code and specification of surface fields + exchanged between components part of SVN_EXTERNAL_DIRECTORIES. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- Introduced separate hard-wired namelist files for cam (atm_in), + cam-dom/som (ocn_in), cam-csim (ice_in) and the sequential driver (drv_in). + +- The new cam-csim namelist is as follows: + namelist /csim_inparm/ prognostic_icesnow, reset_csim_iceprops, & + ice_conschk_frq, icecyc, rest_pfile, nrevsn + +- The new cam-dom namelist is as follows: + namelist /dom_inparm/ sstcyc, nrevsn, rest_pfile + +- The new cam-som namelist is as follows: + namelist /som_inparm/ sstcyc, som_conschk_frq, rest_pfile, nrevsn + +- The new driver namelist file contains the namelists + ccsm_inparm and timemgr_inparm (which were previous in single namelist file "namelist") + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: mvertens, mvr + +List all subroutines eliminated: +D models/drv +- directory removed and made external +D models/atm/cam/bld/atmlndnl.pm + +List all subroutines added and what they do: +A + models/ocn/dom/ocn_filenames.F90 +A + models/ocn/dom/ocn_time_manager.F90 +A + models/ocn/som/ocn_filenames.F90 +A + models/ocn/som/ocn_time_manager.F90 +A + models/ice/csim4/ice_filenames.F90 +A + models/ice/csim4/ice_time_manager.F90 +- Made cam-dom, cam-som and cam-csim no longer dependent on the cam time + manager. Now each of these components has a separate time manager module + that is initialized from the sync clock the same way as the cam time manager + is initialized from the sync clock. Also made cam-dom, cam-som and cam-csim + have a cam-independent specification for their restart file names. These + routines (ocn_filenames.F90 and ice_filenames.F90 now utilize the component + specific time manager routines rather than the cam time manager). + +A + models/ocn/som/ocn_constants.F90 +- Added new module to specify tfrez and cpw independent of the cam-csim code. + This removed an implicit dependency between the cam-som and cam-csim code. + +A + models/atm/cam/bld/som_inparm.pm +A + models/atm/cam/bld/DefaultDOM_INPARM_Namelist.xml +A + models/atm/cam/bld/dom_inparm.pm +A + models/atm/cam/bld/DefaultCSIM_INPARM_Namelist.xml +A + models/atm/cam/bld/compnl.pm +A + models/atm/cam/bld/DefaultSOM_INPARM_Namelist.xml +A + models/atm/cam/bld/csim_inparm.pm +- new files needed for the breakout of the namelists + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_spmd.F90 +- removed #SPMD if def +M models/ocn/dom/sst_data.F90 +- removed boudning of sst temp by freezing point of water: + ! Bound the sst temp by the freezing point of sea water. + ! sst(i,lchnk) = max(sst(i,lchnk),tsice) + the logic is now consistent with that utilized in docn7 dom mode +- also minor cleanup of logic to get code to work with moving the ocn call to after the + atmosphere call +M models/ocn/dom/ocn_types.F90 +- removed lwup from ocn_types +M models/ocn/dom/ocn_comp.F90 +- incorporated cam-dom specific namelist, time manager and restart file naming utility +M models/ocn/dom/ocn_comp_mct.F90 +- introduced new cdata input data structure that his info buf flag capability +- modified domain generation such that it removed maxfrac as an attribute of dom_o + and added aream as a new attribute (area from SCRIP mapping file) + +M models/ocn/som/mixed_layer.F90 +- removed #ifdef SPMD, removed extra call to time mixed_layer2 +- removed "use ice_constants" for tref by adding new ocn_constants module +M models/ocn/som/ocn_spmd.F90 +- removed #ifdef SPMD +M models/ocn/som/ocn_types.F90 +- removed tsocn(:) (no longer needed) +M models/ocn/som/somint.F90 +- removed "use cam_control_mod, only: sstcyc", now obtained from cam-som namelist +- replaced "use time_manager" (cam time manager) with "use ocn_time_manager" +M models/ocn/som/ocn_comp.F90 +- incorporated cam-dom specific namelist, time manager and restart file naming utility +M models/ocn/som/ocean_data.F90 +- introduced module variable sstcyc which is now set from som specific namelist +M models/ocn/som/somini.F90 +- removed "use cam_control_mod, only: sstcyc", now obtained from cam-som namelist +- replaced "use time_manager" (cam time manager) with "use ocn_time_manager" +- removed ifdef SPMD +M models/ocn/som/ocn_comp_mct.F90 +- introduced new cdata input data structure that his info buf flag capability +- modified domain generation such that it removed maxfrac as an attribute of dom_o + and added aream as a new attribute (area from SCRIP mapping file) + +M models/ice/csim4/ice_spmd.F90 +- removed #ifdef SPMD +M models/ice/csim4/ice_data.F90 +- removed #ifdef SPMD +- removed "use ocn_comp, only : sst_file_get_id" +- removed reference to aqua_planet +- replaced "use time_manager" (cam time manager) with "use ocn_time_manager" +M models/ice/csim4/ice_dh.F +- added module variables prognostic_icesnow, reset_csim_iceprops that will now be used by + cam-csim namelist +M models/ice/csim4/ice_srf.F90 +- removed use statements for cam_history and cam_control_mod +M models/ice/csim4/ice_comp.F90 +- incorporated cam-dom specific namelist, time manager and restart file naming utility +- removed module variables asdirice, aldirice, asdifice, aldifice +- moved addfld calls to cam_diagnostics +M models/ice/csim4/ice_diagnostics.F +- removed use of cam time manager and introduced use of ice time manager +M models/ice/csim4/ice_comp_mct.F90 +- introduced new cdata input data structure that his info buf flag capability +- modified domain generation such that it removed maxfrac as an attribute of dom_o + and added aream as a new attribute (area from SCRIP mapping file) + +M models/atm/cam/test/system/TBL.sh +- mod to diagnostic output message + +M models/atm/cam/test/system/TMC.sh +- bug fix to parsing of tracer output for mass conservation test + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TSM.sh +M models/atm/cam/test/system/TER.sh +- namelist broken out into individual files for each component; branch test needed + pointers to restart files specified in build-namelist call + +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/outfrq3s +M models/atm/cam/test/system/nl_files/off2x2.5p +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/outfrq24h +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/idphys +M models/atm/cam/test/system/nl_files/fv2d_4tsk +M models/atm/cam/test/system/nl_files/scm_prep +M models/atm/cam/test/system/nl_files/scm_b4b_o1 +M models/atm/cam/test/system/nl_files/pghgsul +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/fv2d_8tsk +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb3 +- all namelist options files modified with new pointers to component restart files + +M models/atm/cam/bld/config_cam_eul_defaults.xml +M models/atm/cam/bld/configure +M models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +M models/atm/cam/bld/config_trop_chem_mozart_defaults.xml +M models/atm/cam/bld/camexp.pm +M models/atm/cam/bld/filter_nl.pm +M models/atm/cam/bld/config_waccm_ghg_defaults.xml +M models/atm/cam/bld/clm_inparm.pm +M models/atm/cam/bld/config_waccm_mozart_defaults.xml +M models/atm/cam/bld/config_cam_fv_defaults.xml +M models/atm/cam/bld/DefaultCTL_NL_Namelist.xml +M models/atm/cam/bld/cam_inparm.pm +M models/atm/cam/bld/NamelistsDescriptions.xml +M models/atm/cam/bld/timemgr_inparm.pm +M models/atm/cam/bld/ctl_nl.pm +M models/atm/cam/bld/config_cam_homme_defaults.xml +M models/atm/cam/bld/CAM_config.pm +M models/atm/cam/bld/clmexp.pm +M models/atm/cam/bld/SeqCCSM_namelist.pm +M models/atm/cam/bld/ccsm_inparm.pm +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/config_cam_sld_defaults.xml +M models/atm/cam/bld/DefaultFILTER_NL_Namelist.xml +- mods required to account for breakout of the namelists + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/cam_control_mod.F90 +- removed cam namelists for the following variables + sstcyc, icecyc, prognostic_icesnow, reset_csim_iceprops, ice_conschk_frq, som_conschk_frq +M models/atm/cam/src/control/ccsm_msg.F90 +- moved addfld for history variables calls to cam_diagnostics.F90 (see below) +M models/atm/cam/src/control/con_cam.F90 +- hardwired atm.stdin as namelist for nlfilename argument to cam_init +M models/atm/cam/src/control/atm_comp_mct.F90 +- introduced the possibility to do flux averaging of precipitation (as is done in cpl6) + this will be required when cam communicates with the sequential driver only on time steps when + the short wave computation is done +- introduced new cdata input data structure that his info buf flag capability +- moved verification of surface fractions from mrg_x2a_mct.F90 to this module (do not want + to do this verification for dead components) +- modified domain generation such that it removed maxfrac as an attribute of dom_o + and added aream as a new attribute (area from SCRIP mapping file) +M models/atm/cam/src/control/cam_comp.F90 +- hard-wired atm_in and argument to NLFileName in call to cam_initial +- moved call to intht to the initialization phase of cam +- moved calls to addfld of FSNSOI, FLNSOI, LHFLXOI and SHFLXOI from atm_comp_mct.F90 to this module +M models/atm/cam/src/utils/spmd_utils.F90 +- added public attribute to mpicom module variable when SPMD is not defineda +M models/atm/cam/src/physics/cam1/radiation.F90 +- added new routine, radiation_newsw_cday, which returns the calendar day of the + next sw radiation calculation +- added optional input variable, "timestep", to function radiation_do() +M models/atm/cam/src/physics/cam1/cam_diagnostics.F90 +- moved the addfld calls from som/ocn_comp.F90 to this module +- moded the addfld calls from dom/ocn_comp.F90 to tihs module +- moved the addfld calls from ccsm_msg.F90 to this module +- moded the addfld calls from ice/csim/ice_comp.F90 to this module +M SVN_EXTERNAL_DIRECTORIES +- externals now include drv code and updated to clm3_expa_92 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +all baseline tests fail due to change in answers; ccsm test fails because +latest ccsm tag does not yet have necessary mods...when a ccsm sandbox +was created with ccsm3_1_beta44, clm updated to clm3_expa_91, csm_share +updated to share3_070220, MCT updated to MCT2_3_0_070206, and scripts +updated with small change to cam.template for new namelists, the ccsm +test passes + +tempest: +all baseline tests fail due to change in answers + +bangkok/lf95: +all baseline tests fail due to change in answers + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: ALL +- what platforms/compilers: ALL +- nature of change: larger than roundoff but same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): drvord13_cam3_3_43 +- platform/compilers: bluevista/mpxlf90_r +- configure commandline: + som run: + $cfgdir/configure -spmd -smp -dyn fv -res 1.9x2.5 -ocn som + + dom run: + $cfgdir/configure -spmd -smp -dyn fv -res 1.9x2.5 + +- build-namelist command (or complete namelist): + som run: + &ccsm_inparm + case_name = 'camrun_som' + start_type = "continue" + / + &timemgr_inparm + atm_cpl_dt = 1800 + orb_iyear_ad = 1950 + restart_option = 'monthly' + start_ymd = 101 + stop_n = 24 + stop_option = 'nmonths' + / + &cam_inparm + absems_data = '/fs/cgd/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' + aeroptics = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' + bnd_topo = '/fs/cgd/csm/inputdata/atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc' + bndtvaer = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolMass_V_1.9x2.5_clim_c040811.nc' + bndtvo = '/fs/cgd/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' + bndtvs = '/fis/cgd/cms/rneale/cam_mydata/som/cam3_2_59_bvc_0005-0020_qflux.nc' + doisccp = .true. + dtime = 1800 + fincl1 = 'CLDST' + isccpdata = '/fs/cgd/csm/inputdata/atm/cam/rad/isccp.tautab_invtau.nc' + ncdata = '/fis/cgd/cms/rneale/cam_mydata/som/cam3_2_59_som0.cam2.i.0050-01-01-00000.nc' + / + &clm_inparm + dtime = 1800 + finidat = '/fis/cgd/cms/rneale/cam_mydata/som/cam3_2_59_som0.clm2.r.0050-01-01-00000.nc' + fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' + fsurdat = '/fs/cgd/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_1.9x2.5_c050603.nc' + / + + dom run: + &ccsm_inparm + case_name = 'camrun_dom' + start_type = "continue" + / + &timemgr_inparm + atm_cpl_dt = 1800 + orb_iyear_ad = 1950 + restart_option = 'monthly' + start_ymd = 101 + stop_n = 24 + stop_option = 'nmonths' + / + &cam_inparm + absems_data = '/fs/cgd/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' + aeroptics = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' + bnd_topo = '/fs/cgd/csm/inputdata/atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc' + bndtvaer = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolMass_V_1.9x2.5_clim_c040811.nc' + bndtvo = '/fs/cgd/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' + bndtvs = '/fs/cgd/csm/inputdata/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c040810.nc' + doisccp = .true. + dtime = 1800 + fincl1 = 'CLDST' + isccpdata = '/fs/cgd/csm/inputdata/atm/cam/rad/isccp.tautab_invtau.nc' + ncdata = '/fis/cgd/cms/rneale/cam_mydata/atm/cam3_2_59_bvc.cam2.i.0023-01-01-00000.nc' + / + &clm_inparm + dtime = 1800 + finidat = '/fis/cgd/cms/rneale/cam_mydata/lnd/cam3_2_59_bvc.clm2.i.0023-01-01-00000.nc' + fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' + fsurdat = '/fs/cgd/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_1.9x2.5_c050603.nc' + / + +- MSS location of output: +/MVR/csm/camrun_som +/MVR/csm/camrun_dom + +MSS location of control simulations used to validate new climate: +/RNEALE/csm/cam3_2_59_som0/atm/hist +/RNEALE/csm/cam3_2_59_bvc/atm/hist + +URL for AMWG diagnostics output used to validate new climate: +MSS:/MVR/csm/camrun_som/camrun_som-cam3_2_59_som0.tar +MSS:/MVR/csm/camrun_dom/camrun_dom-cam3_2_59_bvc.tar + +=============================================================== +=============================================================== + +Tag name: cam3_4_00 +Originator(s): erik +Date: Thu Feb 22 16:04:59 MST 2007 +One-line Summary: Update CLM and csm_share + +Purpose of changes: Update CAM to use latest CLM with new hydrology changes in it + +Bugs fixed (include bugzilla ID): 307 + +Describe any changes made to build system: Add SEQ_MCT CPP token for seqCCSM driver + Need to use different CAM_CCSMROOT for CCSM tests see below + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New datasets for CLM + +Describe any substantial timing or memory changes: None + +Code reviewed by: eaton + +List all SVN Externals updated: + +Update csm_share to share3_070220 -- Has new share freezing constants +Update CLM to clm3_expa_91 --------- New hydrology +Update MCT to MCT2_3_0_070206 ------ New features added to mpi-serial needed for CLM + +List all subroutines eliminated: + +D models/atm/cam/test/system/scamtest.sh -- no longer used by test_driver.sh + +List all subroutines added and what they do: + +None, other than updates to new externals. + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/system/TSC.sh -- leave SCAM files if CAM_RETAIN_FILES is true +M models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml -- Add new CLM hydrology datasets +M models/atm/cam/bld/Makefile.in -- Add SEQ_MCT define to build +M models/drv/seq_mct/flux_ao.F90 -- rm a shr_const_ value now defined in shr_const_mod.F90 + +Add CPP Token SEQ_MCT to SEQ_MCT drivers for each model component. + +M models/ocn/dom/ocn_comp_mct.F90 +M models/ocn/som/ocn_comp_mct.F90 +M models/ice/csim4/ice_comp_mct.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except TBL tests -- because answers change + +005 bl131 TBL.sh e32c11dh pghgsul 9s ..............................FAIL! rc= 7 +008 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +010 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +013 bl134 TBL.sh e32dh adia 9s ....................................FAIL! rc= 7 +015 bl151 TBL.sh e64h outfrq24h 2d ................................FAIL! rc= 7 +019 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +024 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +027 bl334 TBL.sh f4dh adia 9s .....................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 +033 bl337 TBL.sh f4dh fv2d_8tsk 9s ................................FAIL! rc= 7 +035 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +038 bl354 TBL.sh fm2dh outfrq3s 9s ................................FAIL! rc= 7 +041 bl355 TBL.sh fmo2dh off2x2.5 9s ...............................FAIL! rc= 7 +045 bl531 TBL.sh s32c11dh pghgsul 9s ..............................FAIL! rc= 7 +048 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +050 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +053 bl534 TBL.sh s32dh adia 9s ....................................FAIL! rc= 7 +055 bl551 TBL.sh s64h outfrq24h 2d ................................FAIL! rc= 7 + +setenv CAM_CCSMROOT /fis/cgd/home/erik/ccsm3_1_beta44+clm91+shr+mct + +(this is a CCSM sandbox with ccsm3_1_beta44, clm updated to clm3_expa_91, + csm_share updated to share3_070220 and MCT updated to MCT2_3_0_070206) + +tempest: All PASS except TBL tests -- because answers change + +004 bl131 TBL.sh e32c11dh pghgsul 9s ..............................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9s .................................FAIL! rc= 7 +009 bl133 TBL.sh e32pdh aqpgro 3s .................................FAIL! rc= 7 +012 bl135 TBL.sh e32dh idphys 9s ..................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h 2d ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 7 +021 bl331 TBL.sh f4c11gdh pghgsul 9s ..............................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9s ..................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 3s ..................................FAIL! rc= 7 +029 bl335 TBL.sh f4dh idphys 9s ...................................FAIL! rc= 7 +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 +035 bl531 TBL.sh s32c11dh pghgsul 9s ..............................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9s .................................FAIL! rc= 7 +040 bl533 TBL.sh s32pdh aqpgro 3s .................................FAIL! rc= 7 +043 bl535 TBL.sh s32dh idphys 9s ..................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h 2d ................................FAIL! rc= 7 + +bangkok/lf95: All PASS except TBL tests -- because answers change + +004 bl111 TBL.sh e8c8mdm ttrac 9s .................................FAIL! rc= 5 +008 bl112 TBL.sh e8sdm ghgrmp 9s ..................................FAIL! rc= 5 +010 bl113 TBL.sh e8pdm aqpgro 3s ..................................FAIL! rc= 5 +012 bl153 TBL.sh e64m outfrq24h 2d ................................FAIL! rc= 5 +016 bl311 TBL.sh f10c8mdm ttrac 9s ................................FAIL! rc= 5 +024 bl312 TBL.sh f10sdm ghgrmp 9s .................................FAIL! rc= 5 +026 bl313 TBL.sh f10pdm aqpgro 3s .................................FAIL! rc= 5 +029 bl317 TBL.sh f10dm fv2d_4tsk 9s ...............................FAIL! rc= 5 +031 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 5 +035 bl511 TBL.sh s8c8mdm ttrac 9s .................................FAIL! rc= 5 +039 bl512 TBL.sh s8sdm ghgrmp 9s ..................................FAIL! rc= 5 +041 bl513 TBL.sh s8pdm aqpgro 3s ..................................FAIL! rc= 5 +043 bl553 TBL.sh s64m outfrq24h 2d ................................FAIL! rc= 4 + +Summarize any changes to answers, i.e., +- what code configurations: All +- what platforms/compilers: All +- nature of change (new CLM climate, and ice freezing point change) + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +In run database... + + http://ccsm-rundb.cgd.ucar.edu/case_display.php?case=b31.020ws + +MSS location of control simulations used to validate new climate: /CCSM/csm/b31.020ws + +Note --this case does NOT include the TKFRZ constant change. + +URL for AMWG diagnostics output used to validate new climate: + + http://www.cgd.ucar.edu/tss/clm/diagnostics/ccsm2_prod/b31.020ws_atma-b31.002_atma/sets.htm + +=============================================================== +=============================================================== + +Tag name: cam3_3_51 +Originator(s): mvr +Date: 9 Feb 2007 +One-line Summary: Test driver enabled for blueice; bug fix for the use + of env var CAM_ACCOUNT to specify charge account + +Purpose of changes: the new ibm machine blueice cam online feb 1; the + recent implementation of the environment variable CAM_ACCOUNT + failed to use the account specified when spawning the CCSM tests + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: +none + +List all subroutines added and what they do: +A README_EXTERNALS +- documentation for how to work with cam's external directories +A models/atm/cam/test/system/tests_posttag_blueice +- default list of tests to run posttag on blueice + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/TCT.ccsm.sh +- CCSM test scripts enabled for use on blueice; now uses CAM_ACCOUNT setting + for spawning CCSM tests with user-specified charge account +M models/atm/cam/test/system/tests_posttag_bluesky +M models/atm/cam/test/system/tests_pretag_bluesky +- default set of tests on bluesky now include tests for homme and scam +M models/atm/cam/test/system/test_driver.sh +- top level test script enabled for use on blueice; now exports CAM_ACCOUNT +M models/atm/cam/test/system/CAM_runcmnd.sh +- script enabled to construct run command appropriate for blueice + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS + +tempest: all PASS + +bangkok/lf95: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_50 +Originator(s): eaton, mvr, jedwards +Date: Sun Feb 4 15:01:47 MST 2007 +One-line Summary: fixes for file archiving & eshr time manager; test suite enhancements + +Purpose of changes: + +. Fix problems observed in recent NCAR production runs involving failed + transfers to MSS and failed restarts on automatic resubmissions. Part of + the problem appears to be due to the LSF batch system killing msrcp + processes when the CAM processes are finished. The LoadLeveler batch + system did not do this. The fix implemented was designed to restore the + same behavior we had under LoadLeveler by issuing the msrcp commands that + occur on the final timestep syncronously, i.e., don't let CAM finish + until the requested file transfers are successful. + + Note that having CAM be responsible for file archiving is undesirable for + several reasons, chief among them being that the implementation is not + portable. We intend to implement a file archiving script for CAM similar + to the file harvester used by CCSM. But the current ability of CAM to + archive files at NCAR will be maintained until a better solution is in + place. + +. Fix logic for determining the last timestep in share code for ESMF + time manager. This eliminates the need to use the optional arg nextstep + to get the correct behavior. + +. Enhancements to test suite (from mvr) include: + + - Allow user to specify a project number on SCD machines via the + CAM_ACCOUNT environment variable. + + - Print summary of the cprnc output to the log file, including a list of + fields that contain differences. + +Bugs fixed (include bugzilla ID): + +. Fix problem in boundarydata.F90 (from jedwards) that was causing seg + fault trying to interpolate unstructured grid cyclic dataset between + December and January. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES +. update csm_share externals to point to csm_share/branch_tags/scmshr_tags/scmshr02 + +models/csm_share/eshr/eshr_timemgr_mod.F90 +. fix logic in eshr_timeMgr_clockisOnLastStep +. change eshr_timemgr_clockAlarmIsOnRes to call + eshr_timeMgr_clockisOnLastStep without optional nextStep=.true. arg +. add method eshr_timemgr_curTimeLEstopTime which returns true when the + current time is <= the stop time. + +models/atm/cam/src/control/atm_comp_mct.F90 +. remove nextstep=.true. arg from call to eshr_timeMgr_clockIsOnLastStep + that sets nlend. + +models/atm/cam/src/control/con_cam.F90 +. remove unused reference to eshr_timemgr_clockIsOnLastStep + +models/drv/seq_mct_drv/seq_ccsm_drv.F90 +. use new method eshr_timeMgr_curTimeLEstopTime in timestep loop +. remove nextstep=.true. from call to eshr_timeMgr_clockisOnLastStep which + sets the logical for removing files +. modify the last msrcp call, which is for the driver restart file, to be + synchronous. + +models/atm/cam/src/control/ioFileMod.F90 +. modify putfil so that at the end of run when the files are not to be + removed after archiving, the archiving commands are issued + synchronously. This is to avoid having the batch queue kill the + processes that are trying to archive files. + +models/atm/cam/src/physics/cam1/boundarydata.F90 +. fix allocate statement that was causing seg fault trying to interpolate + unstructured grid cyclic dataset between december and january. + +models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml +. add default start_ymd for HOMME ne5np8 resolution initial file. + +models/atm/cam/bld/DefaultCTL_NL_Namelist.xml +. change statefreq to 60 from 1 (per J Edwards). + +models/atm/cam/test/system/TBL.sh +. Remove grepping for non-zero comparisons in cprnc output -- this belongs + in the CAM_compare.sh script + +models/atm/cam/test/system/CAM_compare.sh +. Enhance to print summary of cprnc output to the log file, including a + list of fields that contain differences. + +models/atm/cam/test/system/test_driver.sh +. Allow user to specify project number on IBMs via CAM_ACCOUNT environment + variable. +. Modify LD_LIBRARY_PATH to include pgi libs even when using lf95 for + testing on CGD clusters. This is because cprnc was built with pgi. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except: + + 057 bl711 TBL.sh h5x8dm adia 9s ...................................FAIL! rc= 7 + + This failure is expected since I fixed the start_ymd to be consistent with + the initial file, and changed the value of statefreq. + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam3_3_49 +Originator(s): Will Sawyer, Lawrence Takacs, Bill Putman +Date: Thu Feb 1 11:41:00 MST 2007 +One-line Summary: Merge of GEOS5 and CAM fv-dycores + +Purpose of changes: + + o Added mass fluxes to the output of the FV dycore (Putman) + + o Added cubic vertical interpolation (Takacs) to used optionally + (flag te_method=1) in the remapping. + + o More FV constants were cleaned up in a consistent way (Bug #214) + in particular, pi=4*atan(1.0) was replaced by F90 parameter with + sufficient significant digits (cause non-zero differences!) + + o Refactoring to remove many CPP #if defined(GEOS_MODE) distinctions + +Bugs fixed (include bugzilla ID): #214 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: no difference + +Code reviewed by: Sawyer, Takacs, Suarez, Putman + +List all subroutines eliminated: none + +List all subroutines added and what they do: c2a3d (cubic interpolation + from a C to an A grid) in module dynamics_vars.F90. + +List all existing files that have been modified, and describe the changes: + + In models/atm/cam/src/dynamics/fv + +fill_module.F90: revised definition of PI (R16), no longer 4*atan(1) + +dyn_comp.F90: Horizontal mass fluxes (Putman), remapping method + switch (te_method). + +mapz_module.F90: Cubic interpolation (Takacs), removed references to + state and grid, in particular clocks. + +inital.F90: dyn_init call now has TE_METHOD as an argument + +cd_core.F90: bug fix: zero out the first latitude of UC (which + should never be used, but *is* written to the restart. + +dynamics_vars.F90: c2a3d (Putman), removed all references to ESMF + (GEOS_MODE), PI passed in as argument + +te_map.F90: Horizontal mass fluxes (Putman), optional use + of cubic interpolation (activated by te_method flag) + Isolated magic numbers as F90 parameters. + Partial remapping (Takacs et al.), considerable + code restructuring (zero difference changes) + +restart_dynamics.F90: dyn_init call now has TE_METHOD as an argument + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: Fails baseline tests (bl331,332, 333, 334, 336, 337, 354, + 355, 375) due to PI roundoff. Passes perturbation growth test. + Fails cs998 (CCSM run -- known problem) +tempest: passes all tests +bangkok/lf95: passes all tests + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_48 (previous tag) + +Summarize any changes to answers, i.e., +- what code configurations: WACCM, FV +- what platforms/compilers: Bluevista +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? perturbation growth test + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_48 +Originator(s): Stacy Walters, Francis Vitt +Date: 25 Jan 2007 +One-line Summary: + Scientific updates for WACCM + +Purpose of changes: + - Improved WACCM gravity wave drag + - Enhanced diagnostic outputs + - Added QBO forcing in WACCM physics + - Added NOx and HOx production from solar proton events (SPE) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + logical :: qbo_use_forcing ! .true. => qbo forcing used; default = .false. + + character(len=256) :: qbo_forcing_file ! qbo forcing data file; default = 'NO_QBO_FILE' + ! if qbo_use_forcing == .true. this must be set + + logical :: qbo_cyclic ! .true. => qbo forcing file is to be used with + ! a 28 month periodicity otherwise model time is + ! used to access qbo_forcing_file dataset + + real(r8) :: t_pert_ubc ! temperature pertubation to apply to the msis + ! temperature at the upper boundary in Kelvin + ! degrees; default value = 0._r8 + + real(r8) :: no_xfac_ubc ! nitrogen oxide concentration multiplicative + ! factor to be applied to the SNOE no values + ! at the upper boundary; default = 1._r8 + + + ! waccm solor proton event (SPE) data variables + logical :: spe_remove_file ! true => the offline spe file will be removed + + logical :: spe_restart ! true => restart from a previous run with SPEs + + character(len=256) :: spe_data_file ! name of file that contains the spe data + + character(len=256) :: spe_filenames_list ! file that lists a series of spe files + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton, Stacy Walters, Francis Vitt + +List all subroutines eliminated: + +List all subroutines added and what they do: + +A models/atm/cam/src/physics/waccm/qbo.F90 +- new routine to allow for a forced qbo +A models/atm/cam/src/chemistry/waccm/spedata.F90 +- new routine to allow for solar proton events +A models/atm/cam/src/chemistry/waccm/spehox.F90 +- new routine to allow for hox production from solar proton events +A models/atm/cam/src/chemistry/waccm/mo_solarproton.F90 +- new routine to allow for solar proton events + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/src/control/runtime_opts.F90 +- added the above listed changes to the namelist +M models/atm/cam/src/physics/cam1/check_energy.F90 +- changed default value of print_energy_errors from .false. to .true. + (Francis you might want to check with Brian about this) +M models/atm/cam/src/physics/cam1/physics_types.F90 +- added real variable uzm, the zonally averaged u wind, for the qbo option +M models/atm/cam/src/physics/cam1/advnce.F90 +- added use association and call to qbo_timestep_init for qbo initialization + on a time step basis +M models/atm/cam/src/physics/cam1/tphysac.F90 +- added use association and call to qbo_relax for qbo +- added preprocessing tokens to differentiate call to ion_drag depending on + whether the simulation is waccm_mozart or waccm_ghg +M models/atm/cam/src/physics/cam1/nlte_fomichev.F90 +- changed constant 1 to 1._r8 +M models/atm/cam/src/physics/cam1/nlte_lw.F90 +- changed longname for QRLNLTE in addfld call +- add addfld call for QNO; nitrogen oxide cooling rate +M models/atm/cam/src/physics/cam1/ctem.F90 +- extensive changes to allow the "transformed eulerian mean" variables to + be computed and output properly with either a one or two dimensional + physical grid decomposition +M models/atm/cam/src/physics/waccm/gw_drag.F90 +- added resolution cases for waccm gravity wave drag +M models/atm/cam/src/physics/waccm/tgcm_forcing.F90 +- added preprocessing token to limit the diagnotic output +M models/atm/cam/src/chemistry/waccm_mozart/svdcmp.F90 +- modification to svd routines to make them fortran90 compliant +M models/atm/cam/src/chemistry/waccm_mozart/mo_setext.F90 +- added code to handle insitu production from solar proton events +M models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 +- corrected error in the cloud ice buffer index +M models/atm/cam/src/chemistry/waccm_mozart/mo_tgcm_ubc.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/upper_bc.F90 +- added code to implement t_pert_ubc and no_xfac_ubc the temperature and + nitrogen oxide perturbations at the upper boundary. The resultant temperature + and nitrogen oxide concentration are checked for non-negativity +M models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/mo_cph.F90 +- removed use of molecular nitrogen concentration in chemical heating rates +M models/atm/cam/src/chemistry/waccm_mozart/mo_chemini.F90 +- added solar proton event initialization +M models/atm/cam/src/chemistry/waccm_mozart/mo_indprd.F90 +- added solar proton event insitu forcing +M models/atm/cam/src/chemistry/waccm_mozart/mo_aurora.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/mo_imp_sol.F90 +- cosmetic changes and removed removed reference to mpi process identifier "iam" +M models/atm/cam/src/chemistry/waccm_mozart/mo_snoe.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/euvac.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 +- added call to advance_spedata to update the solar proton event forcing to present + time step +- added call to addfld for spe related production for ground and excited state + atomic nitrogen and oh +M models/atm/cam/src/chemistry/waccm_mozart/iondrag.F90 +- extensive update to waccm_mozart chemistry case wherein ion and electron + concentrations are directly utilized +M models/atm/cam/src/chemistry/waccm_mozart/mo_setrxt.F90 +- removed all vector function sections +M models/atm/cam/src/chemistry/waccm_mozart/efield.F90 +- added use association for the svd routines +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/chem_mods.F90 +- new module consistent with solar proton event insitu forcing +M models/atm/cam/src/chemistry/waccm_mozart/mo_prod_loss.F90 +- added code to handle solar proton insitu forcing +M models/atm/cam/src/chemistry/waccm_mozart/neckel.F90 +- restricted diagnostic output to the masterproc and with preprocessing tokens +M models/atm/cam/src/chemistry/waccm_mozart/mo_srf_emissions.F90 +- altered flux initialization from gas_pcnst to gas_pcnst-1 +M models/atm/cam/src/dynamics/fv/pmgrid.F90 +- added decomptype strip2dx for modified ctem.F90 routines +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +- added dynamics block decomposition x and y index ranges to subroutine + definition of d_p_coupling +- modified code to handle both one and two dimensional grid decomposition +- modified code to properly interface with the modified ctem.F90 routines +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +- created decomptype strip2dx for modified ctem.F90 routines +M models/atm/cam/src/dynamics/fv/dynamics.F90 +- created decomptype strip2dx for modified ctem.F90 routines +M models/atm/cam/src/dynamics/fv/stepon.F90 +- added dynamics block decomposition x and y index ranges to calling sequence of + d_p_coupling +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +- added code to output variables needed for restarting with solar proton event + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +030 bl336 TBL.sh wm4h outfrq3s 9s .................................FAIL! rc= 7 + - expected to fail due to WACCM changes +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + - this failed in cam3_3_47 and is not expected to pass in this version + +tempest: +017 bl314 TBL.sh wg10dh outfrq3s 9s ...............................FAIL! rc= 7 + - expected to fail due to WACCM changes + +bangkok/lf95: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_47 +Originator(s): eaton +Date: Tue Jan 23 08:54:59 MST 2007 +One-line Summary: Remove non-advected constituents option; misc bug fixes & enhancements. + +Purpose of changes: + +. Remove the "non-advected" constituents option. This option allowed + constituent transport by the physics parameterizations, but disabled + large-scale advective transports. It was used by the original prognostic + cloud water scheme, but is no longer needed. + +. Add configurations for 1/4 and 1/2 degree FV grids. Add + dycore/resolution specific parameters in cldwat and cloud_fraction + modules. + +. Fix interpolation code diagnostic that caused cam to quit if all columns + in a process fell into an "extrapolation region" of the input dataset. + The test only makes sense when interpolating on the global grid; not on + sub-domains. + +. Fix bug in driver that was preventing the CAM banner from being printed. + +. Modify build-namelist defaults for FV, 1.9x2.5. The default landfrac is + now consistent with the coupled model resolution 1.9x2.5_gx1v4. + +. Modify build-namelist to fail with informative message if user specifies + ncdata but not start_ymd. This is because build-namelist has default + values for start_ymd which correspond to the default datasets used for + ncdata. If the user overrides the default ncdata, then the default + start_ymd should also be overridden since the default may be inconsistent + with the dataset specified for ncdata. + +. add fix to XML::Lite parser code to recognize attributes when there is + optional white space between the equals sign and the value. Also allow + the attribute values to be enclosed in single quotes as well as double + quotes. + +. modify build for a homme run + +. Add some initializers for index values in FV (from Art Mirin). + +. replace deprecated float() intrinsic with real(). + +. fix for spaces in the name of the spmdstats file (from Pat Worley). + +. update mct external to trunk tag MCT2_3_0_070112 + +Bugs fixed (include bugzilla ID): + +. Bugzilla bug 89: + Change to cd_core.F90 required to enable the ifort compiler to compile the + omp directive surrounding "do 4500" loop. + +. Bugzilla bug 65: + Remove a informative print statement from inside an CSD region (caused + problem on Cray-X1E). + +. add fix for intermittent problem Tony found running in coupled mode on + bassi (NERSC IBM p5). Add initializer for srfflx_state2d%qref. + +. fix ctl_nl.pm (a homme namelist) so that it doesn't ignore the resolution + found in the config_cache.xml file. Remove the hardcoded value of "ne" + from Default_CTL_NL_Namelist.xml. + +. NOTE -- initial commit and tag contained problem with svn external + definitions. Deleted that tag, fixed definitions, recommitted and + retagged. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add checks to build-namelist to fail if ncdata is specified without + specifying start_ymd. + +List any changes to the defaults for the boundary datasets: + +. New CLM datasets for FV, 1.9x2.5. These datasets are consistent with the + landfraction used for CCSM runs (1.9x2.5_gx1v4). + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. update mct external to trunk tag MCT2_3_0_070112 + SVN_EXTERNAL_DIRECTORIES + +. Mods to add 1/4 and 1/2 degree FV grids + models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml + models/atm/cam/bld/resolution_parameters.xml + models/atm/cam/src/physics/cam1/cldwat.F90 + models/atm/cam/src/physics/cam1/cloud_fraction.F90 + models/atm/cam/src/physics/cam1/hk_conv.F90 + models/atm/cam/src/physics/cam1/zm_conv.F90 + models/atm/cam/src/dynamics/fv/dycore.F90 + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + +. modify warning about extrapolating too much of grid + models/atm/cam/src/control/interpolate_data.F90 + +. bug fix for CAM banner in output log + models/drv/seq_mct/seq_ccsm_drv.F90 + +. Modify build-namelist defaults for FV, 1.9x2.5. + models/atm/cam/bld/cam_inparm.pm + models/atm/cam/bld/clm_inparm.pm + models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml + +. add check to force user to also specify start_ymd if ncdata has been + specified. + models/atm/cam/bld/SeqCCSM_namelist.pm + +. add fix to XML::Lite parser code to recognize attributes when there is + optional white space between the equals sign and the value. Also allow + the attribute values to be enclosed in single quotes as well as double + quotes. + models/atm/cam/bld/XML/Lite/Element.pm + +. add missing initializer for srfflx_state2d%qref. + models/atm/cam/src/control/camsrfexch_types.F90 + +. mods for homme build + models/atm/cam/bld/config_cam_homme_defaults.xml + models/atm/cam/bld/ctl_nl.pm + models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + models/atm/cam/bld/DefaultCTL_NL_Namelist.xml + models/atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml + +. add some initializers for index values in FV (from Art Mirin). + models/atm/cam/src/dynamics/fv/d2a3dijk.F90 + models/atm/cam/src/dynamics/fv/d2a3dikj.F90 + models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + +. Replace deprecated float() intrinsic with real(): + models/atm/cam/src/physics/cam1/mcshallow.F90 + models/atm/cam/src/physics/cam1/convect_ke.F + models/atm/cam/src/physics/cam1/uw_conv.F + +. Bugzilla bug 89: + models/atm/cam/src/dynamics/fv/cd_core.F90 + +. Bugzilla bug 65 + models/atm/cam/src/dynamics/fv/fill_module.F90 + +. Put shr_sys_flush calls inside "#ifndef UNICOSMP" as a workaround for a bug + on the Cray-X1E. +. fix spmdstats filename so that it doesn't contain spaces + models/atm/cam/src/control/cam_comp.F90 + +. Mods to remove the "non-advected" species option. Remove all occurances + of pnats and ppcnst, and change the cnst_add interface to remove the + 'type' argument. + models/ocn/som/mixed_layer.F90 + models/utils/pilgrim/mod_comm.F90 + models/atm/cam/test/unit/control/file_test.pl + models/atm/cam/test/unit/ocnsice/dom/params.h + models/atm/cam/tools/scam/configure + models/atm/cam/tools/scam/scm_init/forecast.F90 + models/atm/cam/tools/scam/obj/Makefile + models/atm/cam/bld/CAM_config.pm + models/atm/cam/src/control/ccsm_msg.F90 + models/atm/cam/src/control/wtrc_flxoce.F90 + models/atm/cam/src/control/srfxfer.F90 + models/atm/cam/src/control/history_scam.F90 + models/atm/cam/src/control/cam_history.F90 + models/atm/cam/src/control/history_defaults.F90 + models/atm/cam/src/control/camsrfexch_types.F90 + models/atm/cam/src/control/ncdio_atm.F90 + models/atm/cam/src/control/iop.F90 + models/atm/cam/src/physics/cam1/tphysidl.F90 + models/atm/cam/src/physics/cam1/tphysbc.F90 + models/atm/cam/src/physics/cam1/drydep_mod.F90 + models/atm/cam/src/physics/cam1/restart_physics.F90 + models/atm/cam/src/physics/cam1/hk_conv.F90 + models/atm/cam/src/physics/cam1/constituents.F90 + models/atm/cam/src/physics/cam1/water_tracers.F90 + models/atm/cam/src/physics/cam1/hb_diff.F90 + models/atm/cam/src/physics/cam1/convect_shallow.F90 + models/atm/cam/src/physics/cam1/convect_deep.F90 + models/atm/cam/src/physics/cam1/buffer.F90 + models/atm/cam/src/physics/cam1/zm_conv.F90 + models/atm/cam/src/physics/cam1/qneg4.F90 + models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + models/atm/cam/src/physics/cam1/initindx.F90 + models/atm/cam/src/physics/cam1/seasalt_intr.F90 + models/atm/cam/src/physics/cam1/tracers.F90 + models/atm/cam/src/physics/cam1/progseasalts_intr.F90 + models/atm/cam/src/physics/cam1/dust_intr.F90 + models/atm/cam/src/physics/cam1/stratiform.F90 + models/atm/cam/src/physics/cam1/carbon_intr.F90 + models/atm/cam/src/physics/cam1/co2_cycle.F90 + models/atm/cam/src/physics/cam1/chemistry.F90 + models/atm/cam/src/physics/cam1/aerosol_intr.F90 + models/atm/cam/src/physics/cam1/sulfur_intr.F90 + models/atm/cam/src/physics/cam1/tracers.F90 + models/atm/cam/src/physics/cam1/radiation.F90 + models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + models/atm/cam/src/physics/cam1/cam_diagnostics.F90 + models/atm/cam/src/physics/cam1/upper_bc.F90 + models/atm/cam/src/physics/cam1/physics_types.F90 + models/atm/cam/src/physics/cam1/physpkg.F90 + models/atm/cam/src/physics/cam1/constituent_burden.F90 + models/atm/cam/src/physics/cam1/tphysac.F90 + models/atm/cam/src/physics/waccm/tracers.F90 + models/atm/cam/src/physics/waccm/chemistry.F90 + models/atm/cam/src/physics/waccm/gw_drag.F90 + models/atm/cam/src/physics/waccm/upper_bc.F90 + models/atm/cam/src/physics/waccm/mo_msis_ubc.F90 + models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + models/atm/cam/src/chemistry/waccm_mozart/upper_bc.F90 + models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 + models/atm/cam/src/chemistry/waccm_mozart/mo_tgcm_ubc.F90 + models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 + models/atm/cam/src/chemistry/waccm_mozart/mo_snoe.F90 + models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_hrates.F90 + models/atm/cam/src/dynamics/sld/linemsdyn.F90 + models/atm/cam/src/dynamics/sld/spegrd.F90 + models/atm/cam/src/dynamics/sld/prognostics.F90 + models/atm/cam/src/dynamics/sld/scanslt.F90 + models/atm/cam/src/dynamics/sld/scan2.F90 + models/atm/cam/src/dynamics/sld/restart_dynamics.F90 + models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 + models/atm/cam/src/dynamics/sld/dp_coupling.F90 + models/atm/cam/src/dynamics/sld/inidat.F90 + models/atm/cam/src/dynamics/sld/dyn_comp.F90 + models/atm/cam/src/dynamics/sld/spmd_dyn.F90 + models/atm/cam/src/dynamics/sld/diag_dynvar_ic.F90 + models/atm/cam/src/dynamics/eul/linemsdyn.F90 + models/atm/cam/src/dynamics/eul/spegrd.F90 + models/atm/cam/src/dynamics/eul/scanslt.F90 + models/atm/cam/src/dynamics/eul/prognostics.F90 + models/atm/cam/src/dynamics/eul/scandyn.F90 + models/atm/cam/src/dynamics/eul/restart_dynamics.F90 + models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + models/atm/cam/src/dynamics/eul/diag_dynvar_ic.F90 + models/atm/cam/src/dynamics/eul/dp_coupling.F90 + models/atm/cam/src/dynamics/eul/dyn_comp.F90 + models/atm/cam/src/dynamics/eul/inidat.F90 + models/atm/cam/src/dynamics/eul/spmd_dyn.F90 + models/atm/cam/src/dynamics/fv/stepon.F90 + models/atm/cam/src/dynamics/fv/dp_coupling.F90 + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + models/atm/cam/src/dynamics/fv/inital.F90 + models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + models/atm/cam/src/advection/slt/qmassa.F90 + models/atm/cam/src/dynamics/homme/dp_coupling.F90 + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: all PASS except: +035 bl375 TBL.sh f1.9h outfrq24h 2d ...............................FAIL! rc= 7 +059 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +tempest: all PASS except +031 bl376 TBL.sh f1.9o outfrq24h 2d ...............................FAIL! rc= 7 + +bangkok/lf95: all PASS except: +031 bl377 TBL.sh f1.9m outfrq24h 2d ...............................FAIL! rc= 7 + +The failure of the FV, 1.9x2.5 baseline comparisons are expected due to a +change in the default landfrac file for that case. + +The failure of the CCSM restart test is still under investigation. The +latest CCSM tag in collections (ccsm3_1_beta42) is also failing with +cam3_3_46 which means the failure is not associated with the mods in this +commit. + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_3_46 +Originator(s): mvr,jet,eaton,aconley +Date: 10 Jan 2007 +One-line Summary: test_driver mods, consolidation of external +definitions in top directory, various bug fixes + +Purpose of changes: +-having external definitions in multiple places led to some confusion +-previously had no pretag tests at fv 1.9x2.5, an important production res +-wanted some posttag testing to occur on calgary as alternative linux cluster +-testing of fv 2d decomposition needed bolstering and multiple platforms +-needed test of an extended run (several months) to catch certain run-time bugs +-added lightning test environment setting to override that of users +-branch test again branches from an earlier restart file than the last created + (broken since cam3_3_15) + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself,eaton + +List all subroutines eliminated: +D models/utils/SVN_EXTERNAL_DIRECTORIES +D models/SVN_EXTERNAL_DIRECTORIES +- files no longer needed with consolidation of external defs to top dir +D models/atm/cam/test/system/config_files/f2h +D models/atm/cam/test/system/config_files/f2m +D models/atm/cam/test/system/config_files/f2o +- fv tests at "production" settings moved from fv2x2.5 to fv1.9x2.5 +D models/atm/cam/test/system/tests_posttag_bangkok +- posttag testing of linux cluster moved from bangkok to calgary +D models/atm/cam/test/system/TRX.sh +- restart test while toggling fv 2d decomp settings merged with TER.sh + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f4h +- new configuration options file for performance/extended-run test +A models/atm/cam/test/system/config_files/f1.9o +- new configuration options file for "production" setting on tempest +A models/atm/cam/test/system/nl_files/fv2d_4tsk +A models/atm/cam/test/system/nl_files/fv2d_8tsk +- new namelist options files for testing of fv 2d decomposition +A models/atm/cam/test/system/tests_posttag_calgary +- posttag testing of linux cluster moved from bangkok to calgary +A SVN_EXTERNAL_DIRECTORIES +- new, consolidated list of all cam external definitions + +List all existing files that have been modified, and describe the changes: + M . +- set externals property on top level dir + M models + M models/utils +- deleted externals properties where they previously existed +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TSM.sh +- modified to handle new syntax for run length +M models/atm/cam/test/system/TER.sh +- modified to handle new syntax for run length; restart now toggles resources + appropriately if running fv 2d decompostion +M models/atm/cam/test/system/tests_pretag_tempest +- now running "production" test at fv 1.9x2.5 +M models/atm/cam/test/system/tests_pretag_bangkok +M models/atm/cam/test/system/tests_posttag_lightning +- added test for fv 2d decomp and now running "production" test at fv 1.9x2.5 +M models/atm/cam/test/system/tests_posttag_bluesky +M models/atm/cam/test/system/tests_pretag_bluesky +M models/atm/cam/test/system/tests_pretag_bluevista +- changed test for fv 2d decomp and now running "production" test at fv 1.9x2.5 +M models/atm/cam/test/system/tests_posttag_bluevista +- added extended run (two months) and moved the performance test from 10d to 2m +M models/atm/cam/test/system/test_driver.sh +- modified settings for calgary; bug fix for lightning environment +M models/atm/cam/test/system/nl_files/pghgsul +- added namelist settings for freq of restart writes +M models/atm/cam/test/system/input_tests_master +- modified syntax for run length of tests - needed to specify something other + than timesteps or days; addition and deletion of tests mentioned +M models/atm/cam/test/system/CAM_runcmnd.sh +- modified setting for calgary +M models/atm/cam/src/control/getnetcdfdata.F90 +- SCM bug fix for setlatlonidx routine when determining closest model column to + given lat/lon pair +M models/atm/cam/src/physics/cam1/aerosol_radiation_interface.F90 +- fix to memory bug when calling radforce with omp enabled +M models/atm/cam/src/physics/cam1/phys_gmean.F90 +- fix to memory leak introduced in cam3_3_35; whitespace cleanup +M models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +- fixed bug in reading PS data from Match. Bug introduced in cam3_3_43 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +- all baseline tests failed due to the changes in the testing scripts and in + some cases the fixing of bugs - when a baseline was set up with the same + script changes and bug fixes, all baseline tests passed + +tempest: +- all baseline tests failed due to the changes in the testing scripts and in + some cases the fixing of bugs - when a baseline was set up with the same + script changes and bug fixes, all baseline tests passed + +bangkok/lf95: +- all baseline tests failed due to the changes in the testing scripts and in + some cases the fixing of bugs - when a baseline was set up with the same + script changes and bug fixes, all baseline tests passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_45 +Originator(s): Dani Bundy Coleman, Jerry Olson +Date: 8 Jan 2007 +One-line Summary: Alternative convection & PBL schemes, forecast mode + +Purpose of changes: Allow users to run the UW PBL scheme or the Emanuel + deep convection scheme. Add rough code to run in forecast mode. + + The UW PBL scheme requires: + configuration option: nlev = 30 + namelist options: shallow_scheme = 'UW' + eddy_scheme = 'diag TKE' + The Emanuel deep convection requires: + namelist options: deep_scheme = 'KE' + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +character(len=16) :: shallow_scheme ! 'Hack' (default),'UW','off' +! 'Hack' = Hack shallow convection (default) +! 'UW' = original McCaa UW pbl scheme, modified by Sungsu Park +! 'off' = no shallow convection +! +character(len=16) :: deep_scheme ! 'ZM' (default), 'KE', 'off' +! 'ZM' = Zhang-McFarlane (default) +! 'KE' = Kerry Emanuel's scheme +! 'off' no deep convection +! +character(len=16) :: eddy_scheme ! 'HB' (default), 'diag TKE' +! 'HB' = Holtslag and Boville (default) +! 'diag TKE' = diagnostic tke version of Grenier and Bretherton + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: + +A models/atm/cam/src/utils/error_function.F90 + provides an erfc function for the UW PBL scheme +A models/atm/cam/src/physics/cam1/phys_control.F90 + Control interface to CAM physics packages +A models/atm/cam/src/physics/cam1/mcshallow.F90 + UW PBL shallow convection package +A models/atm/cam/src/physics/cam1/convect_ke_intr.F90 + Interface to Kerry Emanuel's deep convection scheme +A models/atm/cam/src/physics/cam1/convect_ke.F + Kerry Emanuel's deep convection scheme +A models/atm/cam/src/physics/cam1/zm_conv_intr.F90 + Interface to Zhang-McFarlane deep convection scheme + (used to be convect_deep.F90) +A models/atm/cam/src/physics/cam1/eddy_diff.F90 + UW PBL eddy diffusivity package +A models/atm/cam/src/physics/cam1/uw_conv.F90 + UW PBL shallow convection package + +List all existing files that have been modified, and describe the changes: + +Forecast mode changes: +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam1/check_energy.F90 +M models/atm/cam/src/physics/cam1/cam_diagnostics.F90 +M models/atm/cam/src/dynamics/sld/spegrd.F90 +M models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M models/atm/cam/src/dynamics/sld/scanslt.F90 +M models/atm/cam/src/dynamics/sld/dyn_comp.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/sld/grmult.F90 +M models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/eul/linemsdyn.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 +M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/fv/initcom.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/commap.F90 +M models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 +M models/atm/cam/src/dynamics/fv/uv3s_update.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 + +Convection option changes: +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/physics/cam1/initindx.F90 +M models/atm/cam/src/physics/cam1/param_cldoptics.F90 +M models/atm/cam/src/physics/cam1/physpkg.F90 +M models/atm/cam/src/physics/cam1/cloud_fraction.F90 +M models/atm/cam/src/physics/cam1/gw_drag.F90 +M models/atm/cam/src/physics/cam1/phys_buffer.F90 +M models/atm/cam/src/physics/cam1/zm_conv.F90 +M models/atm/cam/src/physics/cam1/cldwat.F90 +M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 +M models/atm/cam/src/physics/cam1/convect_shallow.F90 + This is now the interface to all shallow convection schemes +M models/atm/cam/src/physics/cam1/convect_deep.F90 + This is now the interface to all deep convection schemes + +Convection and Forecast-mode changes: +M models/atm/cam/src/physics/cam1/tphysbc.F90 +M models/atm/cam/src/physics/cam1/stratiform.F90 +M models/atm/cam/src/physics/cam1/constituents.F90 +M models/atm/cam/src/physics/cam1/tphysac.F90 + +Miscellaneous changes: +M models/atm/cam/test/system/TBL.sh + Add more information to output +M models/atm/cam/test/system/test_driver.sh + Change bluevista gmake option from "-j" to "-j8" +M models/atm/cam/src/physics/cam1/acbnd.F90 + Check that oxidant file has correct vertical dimensions +M models/atm/cam/src/physics/cam1/radiation.F90 +M models/atm/cam/src/physics/cam1/radsw.F90 +M models/atm/cam/src/physics/cam1/radlw.F90 + Calculate clearsky solor & longwave heating rates + New output fields: QRSC, QRSC_RF, QRLC +M models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + stdout + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +Some code was moved from timestepping routines to initialization +routines. In cldwat.F90, this causes a roundoff change +on bluevista that causes the following baseline tests to fail: +005 bl131 TBL.sh e32c11dh pghgsul 9 +008 bl132 TBL.sh e32sdh ghgrmp 9 +015 bl151 TBL.sh e64h outfrq24h -2 +019 bl331 TBL.sh f4c11gdh pghgsul 9 +022 bl332 TBL.sh f4sdh ghgrmp 9 +030 bl336 TBL.sh wm4h outfrq3s 9 +034 bl351 TBL.sh f2h outfrq24h -2 +037 bl354 TBL.sh fm2dh outfrq3s 9 +040 bl355 TBL.sh fmo2dh off2x2.5 9 +054 bl551 TBL.sh s64h outfrq24h -2 + +tempest: +The roundoff difference as seen on bluevista seems to +show up in a waccm test that fails: +017 bl314 TBL.sh wg10dh outfrq3s 9 + +The baseline model field DTCOND included the effects of the energy +fixer (which is actually a fix to the nonconservation of the +dynamics). We moved the call to diag_conv_tend_ini from its position +above the energy fixer to below it, which makes the field different +and allows the heat budget to work out. This causes the following tests to +fail (only DTCOND is different): +021 bl331 TBL.sh f4c11gdh pghgsul 9 +024 bl332 TBL.sh f4sdh ghgrmp 9 +031 bl352 TBL.sh f2o outfrq24h -2 + + +bangkok/lf95: +Failed because of fixed DTCOND (only DTCOND is different) +016 bl311 TBL.sh f10c8mdm ttrac 9 +024 bl312 TBL.sh f10sdm ghgrmp 9 +028 bl353 TBL.sh f2m outfrq24h -2 + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_44 + +Summarize any changes to answers, i.e., +- what code configurations: + Any configuration on bluevista, although the sulfur cycle is particularly sensitive. + WACCM on tempest was also sensitive to the roundoff change + +- what platforms/compilers: + bluevista, tempest + +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + roundoff +If bitwise differences were observed, how did you show they were no worse +than roundoff? + pergro test, tracking roundoff change to culprit code + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_44 +Originator(s): Jim Edwards +Date: 12-13-2006 +One-line Summary: Update of homme dynamics, update of tests and timing utils + +Purpose of changes: Merge homme dynamics development branch. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + Added a default homme core build + M 2606 models/atm/cam/bld/config_cam_homme_defaults.xml + M 2606 models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + M 2606 models/atm/cam/bld/DefaultCTL_NL_Namelist.xml + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + updated for new timings tag: + models/utils/SVN_EXTERNAL_DIRECTORIES + + added a homme test and updated the CCSM test: + A 0 models/atm/cam/test/system/config_files/h5x8dm + M 2606 models/atm/cam/test/system/TCT.ccsm.sh + M 2606 models/atm/cam/test/system/tests_pretag_bluevista + M 2606 models/atm/cam/test/system/input_tests_master + + ccsm tests will now pull in share code from tester's sandbox by default... + added environment variable (CAM_USE_SHR) to control behavior + + Added support for homme grid in energy calculation + M 2606 models/atm/cam/src/physics/cam1/phys_gmean.F90 + Replaced some data statements with parameter declarations + M 2606 models/atm/cam/src/physics/cam1/radae.F90 + + Removed some debugging code + M 2606 models/atm/cam/src/physics/cam1/physpkg.F90 + M 2606 models/atm/cam/src/physics/cam1/qneg3.F90 + + Removed some timers that were causing a problem on bluevista - + this is a hack, it looks like there is a memory problem associated + with fmo2dh - I will continue to investigate. + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: 056 bl711 TBL.sh h5x8dm adia 9 FAIL (no existing baseline) + + 058 cs998 TCS.ccsm.sh ERS f19_g13 K + 040 bl355 TBL.sh fmo2dh off2x2.5 9 + FAILED against cam3_3_43 PASS against cam3_3_42 this is due to + problems introduced in 3_3_42 + +tempest: none + +bangkok/lf95: none + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_43 +Originator(s): John Truesdale +Date: 4 Dec 2006 +One-line Summary: Added single column mode to CAM + +Purpose of changes: + + This commit adds a single column mode (SCM) to CAM. The scam + GUI is being refactored and has been removed from the + trunk. The CAM single column mode is controlled via the + standard cam namelist. Additional namelist parameters allow + cam to be forced using a standard IOP dataset. Future commits + will add back much of the original scam and column radiation + capablity as well as an updated GUI. + + To run cam in single column mode you need to invoke the standard + cam configure script with the -scam option and compile the model + as usual. Although single column mode only runs with the eularian + dynamics most other options for configuring cam (resolution, external + libraries, etc) will work. Next invoking the build-namelist + script will provide a namelist template for running with the + default ARM IOP. The build-namelist procedure requires the user + to supply namelist values for the latitude and longitude of the + IOP column using the namelist variables scmlat and scmlon. + In practice though the user must also specify the starting date + and timesteps to run as well as an appropriate initial condition. + The following parameters to the build-namelist script may be used for + running with the various IOP datasets. The initial data being read + in and used as a background for each of the IOPs is the standard + SEP 1 initial condition. It is suggested that the user generate an + initial condition closer to the starting date of the IOP. + Once the namelist is generated the user may run cam and analyze the + standard history tape produced for the IOP column with any netcdf + visualization tool. + + The relavent namelist parameters for use with the single column mode + of cam are: + + single_column = .true. + scmlat = xxx ! scm latitude to use for the model run + scmlon = xxx ! scm longitude to use for the model run + iopfile = 'xxx' ! iop boundary condition file + + +build-namelist script params for the ARM IOP + +build-namelist -namelist \ +"&camexp \ +mss_irt=0 \ +scmlat=36.6 \ +scmlon=262.5 \ +start_ymd=19950718 \ +start_tod=19800 \ +stop_n=1259 \ +stop_option='nsteps' \ +iopfile='/fs/cgd/csm/inputdata/atm/cam/scam/iop/arm0795v1.2.nc' \ +ncdata ='/fs/cgd/csm/inputdata/atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc' \ +mfilt=1400 \ +nhtfrq=1/" + +build-namelist script params for the Gate IOP + +build-namelist -namelist \ +"&camexp \ +mss_irt=0 \ +scmlat=9. \ +scmlon=336. \ +start_ymd=19740830 \ +start_tod=0 \ +stop_n=1440 \ +stop_option='nsteps' \ +iopfile='/fs/cgd/csm/inputdata/atm/cam/scam/iop/gate0874v1.2.nc' \ +ncdata ='/fs/cgd/csm/inputdata/atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc' \ +mfilt=1500 \ +nhtfrq=1/" + +build-namelist script params for GCSS IOP + +build-namelist -namelist \ +"&camexp \ +mss_irt=0 \ +scmlat=-2. \ +scmlon=155. \ +start_ymd=19921220 \ +start_tod=0 \ +stop_n=505 \ +stop_option='nsteps' \ +iopfile='/fs/cgd/csm/inputdata/atm/cam/scam/iop/gcss1292v1.2.nc' \ +ncdata ='/fs/cgd/csm/inputdata/atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc' \ +mfilt=1500 \ +nhtfrq=1/" + + + In addition to the standard IOP datasets the single column version + of CAM may be forced with an intial condition file and a "pseudo + IOP" history file generated from a previous global CAM run. This + mode is useful for getting a feel for how new physics modules + behave given forcing from an actual CAM run. To generate an + initial condition and IOP style forcing data from a standard cam + run configure the model using the new -camiop option of the + configure script. The build-namelist script has been modified to + generate a namelist which will create an initial condition for a + scm model run as well as an auxillary history tape containing the + IOP fields needed to drive a single column version of CAM. Both + the initial conditions file and the IOP forcing history tape are 3 + dimensional. When running with these datasets in SCM mode the + user can choose which column will be used via the namelist + parameters scmlat and scmlon. + + The relavent namelist parameters for generating an CAMIOP are + + fincl2 = 'Ps','u','v','t','q','omega','phis','Prec','lhflx','shflx',\ + 'Tsair','Tg','divq3d','divT3d','dcldice','dcldliq','beta',\ + 'fixmas','afixq','afixcldl','afixcldi','dqfxq','dqfxcldl',\ + 'dqfxcldi','CLAT','T','Q' + inithist = 'CAMIOP' + mfilt = 1,10 + nhtfrq = 0,1 + + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Added -scam and -camiop options + to configure script. The -scam option will configure cam for + single column mode. The -camiop option will configure cam to produce + an iop initial condition file and a boundary forcing history tape + to be used in single column mode. + +Describe any changes made to the namelist: Added namelist parameters for + single column mode. Since all surface models need single column + control information the following namelist variables were added + to ccsm_inparm + + ! enable single_column mode + logical :: single_column ! default false set to true to + ! enable single column mode + + ! single column longitude + real(r8) :: scmlon ! longitude setting used by cam in + ! scm mode + ! single column latitude + real(r8) :: scmlat ! latitude setting used by cam in + ! scm mode + + The following namelist variable was added to the cam_inparm namelist + + ! iop boundary file + integer, parameter :: max_chars = 128 + character(len=max_chars) iopfile !IOP Boundary condition file + + + Added the CAMIOP option to the inithist namelist variable. This + option will produce an initial condition for use with a cam + generated iop forcing history tape. + + ! inithist Generate initial dataset as auxillary history file + ! can be set to '6-HOURLY', 'DAILY', 'MONTHLY', + ! 'YEARLY', 'CAMIOP', or 'NONE'. + ! default: 'YEARLY' + + +List any changes to the defaults for the boundary datasets: + Added a namelist option to specify an IOP file for SCM mode. + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + + configuration/namelist/script files for testing of scm cam mode: + + models/atm/cam/test/system/config_files/scm64bfbiop + models/atm/cam/test/system/config_files/e64bfbiop + models/atm/cam/test/system/nl_files/scm_prep + models/atm/cam/test/system/nl_files/scm_b4b_o1 + models/atm/cam/test/system/TSC.sh + + Files adding scm capability to cam: + models/atm/cam/src/control/scamMod.F90 + models/atm/cam/src/control/getnetcdfdata.F90 + models/atm/cam/src/dynamics/eul/forecast.F90 + models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 + models/lnd/clm2/src/main/getnetcdfdata.F90 + +List all existing files that have been modified, and describe the changes: +The majority of the modifications had to do with removing the +#define SCAM sections of code. There is still some duplication of +functionality that will be cleaned up in future commits (reading of +netcdf data). The pieces of independent single column mode code +are delineated now by a run time 'if (single_column)' test. The single_column +logical is defined in the ccsm_inparm namelist and is available to all component +models. Files in the test and bld subdirectories were modified to allow +bit for bit testing of scam against a control run of the 3d model as well +as adding functionality to the build-namelist and configure scripts to make +running in single column mode easier. + + models/ocn/dom/sst_data.F90 + models/ice/csim4/ice_data.F90 + models/atm/cam/test/system/tests_pretag_bangkok + models/atm/cam/test/system/TPF.sh + + TPF.sh: the script for testing performance problems was modified to + reflect the move to a single timing file introduced in cam3_3_42 + + models/atm/cam/test/system/tests_pretag_bluevista + models/atm/cam/test/system/nl_files/scm_prep + models/atm/cam/test/system/nl_files/scm_b4b_o1 + models/atm/cam/test/system/input_tests_master + models/atm/cam/test/system/TSC.sh + models/atm/cam/test/system/TCT.sh + + TCT.sh: all ccsm tests through cam's test suite will now use the + csm_share and clm code from the cam sandboxes rather than that + from the latest ccsm tag (up to now it used just the cam code) + + models/atm/cam/test/system/tests_posttag_lightning + models/atm/cam/bld/configure + models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + models/atm/cam/bld/cam_inparm.pm + models/atm/cam/bld/NamelistsDescriptions.xml + models/atm/cam/bld/resolution_parameters.xml + models/atm/cam/bld/CAM_config.pm + models/atm/cam/bld/ccsm_inparm.pm + models/atm/cam/src/control/readinitial.F90 + models/atm/cam/src/control/history_defaults.F90 + models/atm/cam/src/control/runtime_opts.F90 + models/atm/cam/src/control/ncdio_atm.F90 + models/atm/cam/src/control/rgrid.F90 + models/atm/cam/src/control/interpolate_data.F90 + models/atm/cam/src/control/con_cam.F90 + models/atm/cam/src/control/atm_comp_mct.F90 + models/atm/cam/src/control/startup_initialconds.F90 + models/atm/cam/src/control/history_scam.F90 + models/atm/cam/src/control/cam_comp.F90 + models/atm/cam/src/control/cam_history.F90 + models/atm/cam/src/physics/cam1/initindx.F90 + models/atm/cam/src/physics/cam1/radiation.F90 + models/atm/cam/src/physics/cam1/radsw.F90 + models/atm/cam/src/physics/cam1/cam_diagnostics.F90 + models/atm/cam/src/physics/cam1/physics_types.F90 + models/atm/cam/src/physics/cam1/radlw.F90 + models/atm/cam/src/physics/cam1/physpkg.F90 + models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + models/atm/cam/src/physics/cam1/aerosol_index.F90 + models/atm/cam/src/physics/cam1/gw_drag.F90 + models/atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 + models/atm/cam/src/dynamics/sld/dyn_comp.F90 + models/atm/cam/src/dynamics/eul/sphdep.F90 + models/atm/cam/src/dynamics/eul/initcom.F90 + models/atm/cam/src/dynamics/eul/scanslt.F90 + models/atm/cam/src/dynamics/eul/inidat.F90 + models/atm/cam/src/dynamics/eul/getinterpnetcdfdata.F90 + models/atm/cam/src/dynamics/eul/inital.F90 + models/atm/cam/src/dynamics/eul/dycore.F90 + models/atm/cam/src/dynamics/eul/iop.F90 + models/atm/cam/src/dynamics/eul/dynpkg.F90 + models/atm/cam/src/dynamics/eul/diag_dynvar_ic.F90 + models/atm/cam/src/dynamics/eul/scan2.F90 + models/atm/cam/src/dynamics/eul/stepon.F90 + models/atm/cam/src/dynamics/eul/restart_dynamics.F90 + models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + models/SVN_EXTERNAL_DIRECTORIES + models/drv/seq_mct_drv/seq_ccsm_drv.F90 + models/drv/seq_mct/mrg_x2a_mct.F90 + models/csm_share/shr/shr_inputinfo_mod.F90 + models/lnd/clm2/src/main/inicFileMod.F90 + models/lnd/clm2/src/main/driver.F90 + models/lnd/clm2/src/main/ncdio.F90 + models/lnd/clm2/src/main/initializeMod.F90 + models/lnd/clm2/src/main/iniTimeConst.F90 + models/lnd/clm2/src/main/restFileMod.F90 + models/lnd/clm2/src/main/controlMod.F90 + models/lnd/clm2/src/main/lnd_comp_mct.F90 + models/lnd/clm2/src/main/surfrdMod.F90 + models/lnd/clm2/src/biogeochem/STATICEcosysDynMod.F90 + models/lnd/clm2/src//main/clm_varctl.F90 + + The following files were deleted. As stated above + the GUI version of SCAM is being refactored. An + impoved GUI will be added in the future. + + scam + scam/configure + scam/crm + scam/GNUmakefile + scam/.scam_defaults + scam/README + scam/tools + scam/tools/sdev + scam/tools/sdev/sdev + scam/tools/sdev/sdev.C + scam/tools/sdev/Makefile + scam/tools/sdev/README + scam/tools/ncmult + scam/tools/ncmult/ncmult.C + scam/tools/ncmult/Makefile + scam/tools/ncmult/README + scam/tools/nctrans + scam/tools/nctrans/nctrans + scam/tools/nctrans/nctrans.C + scam/tools/nctrans/Makefile + scam/tools/nctrans/README + scam/tools/diurnal_ave + scam/tools/diurnal_ave/diurnal_ave + scam/tools/diurnal_ave/diurnal_ave.C + scam/tools/diurnal_ave/Makefile + scam/tools/diurnal_ave/README + scam/tools/intercomparison-post-processing + scam/tools/intercomparison-post-processing/ncfile.C + scam/tools/intercomparison-post-processing/field.C + scam/tools/intercomparison-post-processing/post + scam/tools/intercomparison-post-processing/ncfile.H + scam/tools/intercomparison-post-processing/post.C + scam/tools/intercomparison-post-processing/field.H + scam/tools/intercomparison-post-processing/intercompare.scm + scam/tools/intercomparison-post-processing/Makefile + scam/tools/intercomparison-post-processing/process + scam/tools/ncadd + scam/tools/ncadd/ncadd + scam/tools/ncadd/ncadd.C + scam/tools/ncadd/Makefile + scam/tools/ncadd/README + scam/tools/pdf + scam/tools/pdf/ferret.jnl + scam/tools/pdf/pdf + scam/tools/pdf/pdf.C + scam/tools/pdf/Makefile + scam/tools/pdf/README + scam/tools/ccm2iop + scam/tools/ccm2iop/ncfile.C + scam/tools/ccm2iop/ncfile.cpp + scam/tools/ccm2iop/ioerr.h + scam/tools/ccm2iop/ncfile.h + scam/tools/ccm2iop/Makefile + scam/tools/ccm2iop/ccm2iop.C + scam/tools/ccm2iop/test.nc + scam/getlatlon.pl + scam/testscript + scam/html + scam/html/userguide.html + scam/html/tdiff-cam2.gif + scam/html/gif + scam/html/gif/tdiff-cam2.gif + scam/html/gif/plot.gif + scam/html/gif/tdiff3.2.gif + scam/html/gif/tdiff3.6.gif + scam/html/gif/post.gif + scam/html/gif/formula1.gif + scam/html/gif/formula2.gif + scam/html/gif/iop.gif + scam/html/gif/formula3.gif + scam/html/gif/formula4.gif + scam/html/gif/qdiff.gif + scam/html/gif/formula5.gif + scam/html/gif/formula6.gif + scam/html/gif/tdiff.gif + scam/html/gif/mainwnd.gif + scam/html/gif/qls.gif + scam/html/gif/global.gif + scam/html/gif/sls.gif + scam/html/gif/mainwin.gif + scam/html/gif/uls.gif + scam/html/gif/vls.gif + scam/html/gif/w.gif + scam/html/gif/option.gif + scam/html/gif/g2.gif + scam/html/gif/uphys.gif + scam/html/gif/selectdata.gif + scam/html/gif/vphys.gif + scam/html/tdiff3.6.gif + scam/html/index.html + scam/scm_init + scam/scm_init/init_model.F90 + scam/scm_init/misc.h + scam/scm_init/scam_srfdata.F90 + scam/scm_init/drand48_.c + scam/scm_init/get_levels.F90 + scam/scm_init/scam_srfdata_MCT.F90 + scam/scm_init/runtype.h + scam/scm_init/scam_rpc.x + scam/scm_init/calcdate.F90 + scam/scm_init/comfrc.h + scam/scm_init/fortran.h + scam/scm_init/ipc.h + scam/scm_init/setlatlon.F90 + scam/scm_init/forecast.F90 + scam/scm_init/scam_run.F90 + scam/scm_init/myhandler.F + scam/scm_init/realtype.h + scam/scm_init/inital.F90 + scam/scm_init/readpressdata.F90 + scam/scm_init/c_outfld.c + scam/scm_init/scamMod.F90 + scam/scm_init/c_outfld.h + scam/scm_init/interplevs.F90 + scam/scm_init/getnetcdfdata.F90 + scam/scm_init/preproc.h + scam/scm_init/setiopupdate.F90 + scam/scm_init/scam.c + scam/scm_init/scam_fifo.c + scam/scm_init/getinterpncdata.F90 + scam/scm_init/readiopdata.F90 + scam/scm_init/readsaveinit.F90 + scam/scm_init/max.h + scam/scm_init/scam_fifo.h + scam/INSTALL + scam/mymods + scam/mymods/README + scam/userdata + scam/userdata/crmtest18.in + scam/userdata/crmtest26.out + scam/userdata/crmdarwintest26.out + scam/userdata/crmtest200.in + scam/userdata/README + scam/userdata/crmtest26.in + scam/data + scam/data/README + scam/obj + scam/obj/makdep.linux + scam/obj/makdep + scam/obj/Makefile + scam/ui + scam/ui/timeconvert.cpp + scam/ui/PostPlottingDlg.h + scam/ui/OptionsDlg.ui.h + scam/ui/LoadData.ui + scam/ui/utils.h + scam/ui/history.h + scam/ui/IOPSelectDateDlg.ui + scam/ui/PlistDlgImpl.h + scam/ui/rpcmodel.h + scam/ui/defaults.h + scam/ui/map.cpp + scam/ui/PlistDlg.ui + scam/ui/datasetselector.cw + scam/ui/plot.cpp + scam/ui/manager.h + scam/ui/map.xbm + scam/ui/msgdlg.h + scam/ui/field.cpp + scam/ui/globalmap.cw + scam/ui/crm.h + scam/ui/fieldlistbox.cpp + scam/ui/dataset.h + scam/ui/Platform.Notes + scam/ui/ncarg.cpp + scam/ui/observer.h + scam/ui/IOPSelectDateDlg.ui.h + scam/ui/PostPlottingDlg.cpp + scam/ui/IOPSelectDateDlgImpl.cpp + scam/ui/ncfile.cpp + scam/ui/PlotDlg.ui + scam/ui/LoadDataImpl.h + scam/ui/history.cpp + scam/ui/ascii_dataset.h + scam/ui/globalmap.h + scam/ui/fifomodel.cpp + scam/ui/rpcmodel.cpp + scam/ui/plot.cw + scam/ui/GNUmakefile + scam/ui/defaults.cpp + scam/ui/ncarg + scam/ui/ncarg/c.h + scam/ui/SelectGlobalDataDlg.ui + scam/ui/msgdlg.cpp + scam/ui/sicfile.cpp + scam/ui/list.h + scam/ui/crm.cpp + scam/ui/dbgmodel.h + scam/ui/plot.h + scam/ui/PostPlottingDlgImpl.h + scam/ui/dataset.cpp + scam/ui/MainWnd.ui + scam/ui/world.xbm + scam/ui/LoadDataImpl.cpp + scam/ui/PlotDlgImpl.h + scam/ui/fieldlistbox.h + scam/ui/ncarg.h + scam/ui/model.cpp + scam/ui/configure + scam/ui/IOPSelectDateDlgImpl.h + scam/ui/map.cw + scam/ui/OptionsDlgImpl.cpp + scam/ui/ChangeAxisScaleDlg.ui + scam/ui/ncfile.h + scam/ui/SelectGlobalDataDlgImpl.h + scam/ui/fifomodel.h + scam/ui/ncarg_stubs.cpp + scam/ui/fieldplotwidget.cw + scam/ui/dbgmodel.cpp + scam/ui/PostPlottingDlgImpl.cpp + scam/ui/fortran.h + scam/ui/numlined.h + scam/ui/sicfile.h + scam/ui/images + scam/ui/images/editcopy + scam/ui/images/editcut + scam/ui/images/fileopen + scam/ui/images/editpaste + scam/ui/images/textbold + scam/ui/images/undo + scam/ui/images/searchfind + scam/ui/images/filenew + scam/ui/images/redo + scam/ui/images/print + scam/ui/images/filesave + scam/ui/main.cpp + scam/ui/MainWndImpl.h + scam/ui/ioerr.h + scam/ui/PlotDlgImpl.cpp + scam/ui/ld.man + scam/ui/ChangeAxisScaleDlgImpl.h + scam/ui/utils.cpp + scam/ui/SelectGlobalDataDlgImpl.cpp + scam/ui/configure.works + scam/ui/PlistDlgImpl.cpp + scam/ui/timeconvert.h + scam/ui/model.h + scam/ui/OptionsDlgImpl.h + scam/ui/manager.cpp + scam/ui/OptionsDlg.ui + scam/ui/fieldlistbox.cw + scam/ui/MainWndImpl.cpp + scam/ui/c.h + scam/ui/field.h + scam/ui/sst + scam/ui/max.h + scam/ui/ChangeAxisScaleDlgImpl.cpp + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: + +The following test failed as part of the cam3_3_42 commit and also fail as part +of this commit. + +038 sm355 TSM.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 8 +039 er355 TER.sh fmo2dh off2x2.5 4+5 ..............................FAIL! rc= 5 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 4 + + All ccsm tests through cam's test suite will now use the + csm_share and clm code from the cam sandboxes rather than that + from the latest ccsm tag (up to now it used just the cam code) + + +tempest: + +bangkok/lf95: + +CAM tag used for the baseline comparison tests if different than previous +tag:cam3_3_42 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + NONE + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + + NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + + NA + +MSS location of control simulations used to validate new climate: + + NA + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_3_42 +Originator(s): Patrick Worley +Date: 24 Nov 2006 +One-line Summary: refactored timer instrumentation and support for single timing output file + +Purpose of changes: + + To update timing instrumentation to reflect recent model changes, + and to improve 'coverage' by adding timers for all top level events. + + To improve usability on large numbers of processes by decreasing number + of process count-dependent files and lines of output: + - added option to generate single timing and spmdstats files + (containing all of the information that had been spread between + multiple files before) + - added option to restrict reporting of many runtime options and + memory usage statistics to process 0 + These new options are enabled by default + +Bugs fixed (include bugzilla ID): + 'debugging' shr_sys_flush call in seq_domain_mct.F90 erroneously left in + during earlier check-in caused error on Cray X1E + +Describe any changes made to build system: + Added new CPP flags: + - MULTIPLE_PERF_FILES: if defined, timing and output files will be + created for each process (the previous default) + - WRAP_MPI_TIMING: if defined, timing events are defined for each MPI + call in wrap_mpi.F90 (the previous default) + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Patrick Worley + +List all subroutines eliminated: + +List all subroutines added and what they do: + t_pr_onef in utils/timing/f_wrappers.c: + variant of t_prf that write all timing data in one file + t_enablef in utils/timing/f_wrappers.c, + GPTL_enable in utils/timing/gptl.c: + runtime timing routine enabler + t_disablef in utils/timing/f_wrappers.c, + GPTL_disable in utils/timing/gptl.c: + runtime timing routine disabler + +List all existing files that have been modified, and describe the changes: + + SVN_EXTERNAL_DIRECTORIES + using clm3_expa_79 + + utils/SVN_EXTERNAL_DIRECTORIES + using timing_061124 + + atm/cam/src/control/atm_comp_mct.F90 + atm/cam/src/control/cam_comp.F90 + atm/cam/src/control/wrap_mpi.F90 + atm/cam/src/dynamics/eul/dp_coupling.F90 + atm/cam/src/dynamics/eul/dyndrv.F90 + atm/cam/src/dynamics/eul/dynpkg.F90 + atm/cam/src/dynamics/eul/scan2.F90 + atm/cam/src/dynamics/eul/scandyn.F90 + atm/cam/src/dynamics/eul/scanslt.F90 + atm/cam/src/dynamics/eul/stepon.F90 + atm/cam/src/dynamics/fv/cd_core.F90 + atm/cam/src/dynamics/fv/dp_coupling.F90 + atm/cam/src/dynamics/fv/dyn_comp.F90 + atm/cam/src/dynamics/fv/mapz_module.F90 + atm/cam/src/dynamics/fv/stepon.F90 + atm/cam/src/dynamics/fv/trac2d.F90 + atm/cam/src/dynamics/sld/dp_coupling.F90 + atm/cam/src/dynamics/sld/dyndrv.F90 + atm/cam/src/dynamics/sld/dynpkg.F90 + atm/cam/src/dynamics/sld/scan2.F90 + atm/cam/src/dynamics/sld/scandyn.F90 + atm/cam/src/dynamics/sld/scanslt.F90 + atm/cam/src/dynamics/sld/stepon.F90 + atm/cam/src/physics/cam1/convect_deep.F90 + atm/cam/src/physics/cam1/convect_shallow.F90 + atm/cam/src/physics/cam1/diffusion_solver.F90 + atm/cam/src/physics/cam1/physpkg.F90 + atm/cam/src/physics/cam1/radiation.F90 + atm/cam/src/physics/cam1/tphysac.F90 + atm/cam/src/physics/cam1/tphysbc.F90 + atm/cam/src/physics/cam1/vertical_diffusion.F90 + atm/cam/src/physics/cam1/zm_conv.F90 + drv/seq_mct_drv/seq_ccsm_drv.F90 + ice/csim4/ice_comp.F9 + ice/csim4/ice_comp_mct.F90 + ice/csim4/ice_srf.F90 + lnd/clm2/src/main/clm_comp.F90 + lnd/clm2/src/main/driver.F90 + lnd/clm2/src/main/lnd_comp_mct.F90 + ocn/dom/ocn_comp.F90 + ocn/dom/ocn_comp_mct.F90 + ocn/som/ocn_comp.F90 + ocn/som/ocn_comp_mct.F90 + modified performance timer logic + + atm/cam/src/control/cam_comp.F90 + single spmdstats output file option + + atm/cam/src/control/cam_history.F90 + process 0-only reporting (eliminating unnecessary output) + + atm/cam/src/control/print_memusage.F90 + process 0-only reporting memory usage. Old default restored + by defining DEBUG. + + atm/cam/src/dynamics/eul/spmd_dyn.F90 + atm/cam/src/dynamics/sld/spmd_dyn.F90 + process 0-only reporting of SPMD buffer allocation. + + atm/cam/src/physics/cam1/chem_surfvals.F90 + atm/cam/src/physics/cam1/prescribed_aerosols.F90 + process 0-only reporting of runtime options + + drv/seq_mct/seq_domain_mct.F90 + deleted 'call shr_sys_flush(25+iam)' + + drv/seq_mct_drv/seq_ccsm_drv.F90 + disabled CATAMOUNT-specific call to usetlbuf; I/O buffering is now + the system default, and usetlbuf is unecessary + added option to create a single timing output file + + lnd/clm2/src/main/restFileMod.F90 + (ask T. Craig or M. Vertenstein) + + utils/timing/f_wrappers.c + added t_pr_onef, t_enablef, t_disablef + + utils/timing/gptl.c + utils/timing/gptl.h + added GPTL_enable, GPTL_disable + modified GPTLpr to create either one timer output file, + or one file per process + process 0-only reporting timing options. Old default restored + by defining DEBUG. + + utils/timing/gptl_papi.c + modified error message (mod. from J. Edwards) + + utils/timing/private.h + increased timing event name length + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASSED + +tempest: All PASSED + +bangkok/lf95: All PASSED + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_3_41 +Originator(s): Francis Vitt +Date: 15 Nov 2006 +One-line Summary: Added functionality and flexibility to the trop_mozart chemistry. + +Purpose of changes: + + To implement flexibility in the chemical mechanism used in trop_mozart + chemistry package. This flexibility is provided + via: + - flexible namelist variables + - helper functions which use data provided by the chemical preprocessor + + Use cam implemented prognostic sea salt and dust with the trop_mozart + chemistry package. + + Use cam implemented rain out of trop_mozart aerosols. + + Provide the ability to use cam sulfur chemistry routines with trop_mozart + chemistry package. + + Provide the ability to use prescribed chemical constituents and sources + in trop_mozart chemistry package. + + Fix bug in the offline driver on bluevista. + +Bugs fixed (include bugzilla ID): + #239 fv offline driver fails in cam on bluevista + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Added several namelist variables for trop_mozart chemistry package + for the flexable chemical mechanism implementation. These are: + + ! trop_mozart surface emissions: + character(len=256) :: srf_emis_specifier(pcnst) ! string array where each + ! string contains the constituent name and filepath separated by "->", e.g. + ! srf_emis_specifier = 'CO -> /path/CO_emis_file.nc','NO -> /path/NO_emis_file.nc',... + character(len=8) :: emis_type ! 'CYCLICAL' | 'SERIAL' | 'FIXED' + integer :: emis_date ! yyyymmdd for SERIAL(yyyy) or FIXED + integer :: emis_yr_offset ! yrs added to current model year for CYCLICAL + + ! trop_mozart chem sources(sinks): + character(len=256) :: ext_frc_specifier(pcnst) ! string array where each + ! string contains the constituent name and filepath separated by "->", e.g. + ! ext_frc_specifier = 'CO -> /path/CO_extfrc_file.nc','NO -> /path/NO_extfrc_file.nc',... + character(len=8) :: ext_frc_type ! 'CYCLICAL' | 'SERIAL' | 'FIXED' + integer :: ext_frc_date ! yyyymmdd for SERIAL(yyyy) or FIXED + integer :: ext_frc_yr_offset ! yrs added to current model year for CYCLICAL + + ! trop_mozart fixed lower boundary: + character(len=16) :: flbc_list(pcnst) ! list of constituents + character(len=256) :: flbc_file ! lower boundary data file + character(len=8) :: flbc_type ! 'CYCLICAL' | 'SERIAL' | 'FIXED' + integer :: flbc_date ! yyyymmdd for SERIAL(yyyy) or FIXED + integer :: flbc_yr_offset ! yrs added to current yr for CYCLICAL + + ! trop_mozart constituents that have dry deposition + character(len=16) :: drydep_list(pcnst) + + ! trop_mozart constituents that are constrained in the stratosphere + character(len=16) :: fstrat_list(pcnst) ! list of constituents + character(len=256) :: fstrat_file ! data file for fixed stratosphere constituents + character(len=256) :: trop_pause_file + + ! trop_mozart aerosol constituents that have wet deposition + character(len=16) :: aer_wetdep_list(pcnst) + + ! trop_mozart use CAM sulfur chemistry driver rather than mo_setsox + logical :: use_cam_sulfchem + ! trop_mozart use CAM prescribed ozone for radiation rather than trop_moz prescribed data + logical :: use_cam_ozone_data + ! trop_mozart use CAM prescribed green house gases for radiation rather than trop_moz prescribed data + logical :: use_cam_ghg_data + + ! trop_mozart prescribed constituents + character(len=256) :: tracer_cnst_file ! prescribed data file + character(len=256) :: tracer_cnst_filelist ! list of prescribed data files (series of files) + character(len=256) :: tracer_cnst_specifier(pcnst) ! string array where each + ! string contains the prescribed constituent name and field name in the data file separated by ":", e.g. + ! ext_frc_specifier = 'CO : CO_VMR','OH : OH_VMR',... + logical :: tracer_cnst_rmfile ! remove data file from local disk (default .false.) + integer :: tracer_cnst_ymd ! yyyymmdd - start date of the prescribed data (default is current model date) + integer :: tracer_cnst_tod ! start time of day (seconds) of the prescribed data (default is current model time) + + ! trop_mozart prescribed constituent sourrces/sinks + character(len=256) :: tracer_srcs_file ! prescribed data file + character(len=256) :: tracer_srcs_filelist ! list of prescribed data files (series of files) + character(len=256) :: tracer_srcs_specifier(pcnst) ! string array where each + ! string contains the constituent source name and field name in the data file separated by ":", e.g. + ! ext_frc_specifier = 'CO : CO_SRC','OH : OH_SRC',... + logical :: tracer_srcs_rmfile ! remove data file from local disk (default .false.) + integer :: tracer_srcs_ymd ! yyyymmdd - start date of the prescribed data (default is current model date) + integer :: tracer_srcs_tod ! start time of day (seconds) of the prescribed data (default is current model time) + + Replaced the namelist variables for the individual species emissions + files with the srf_emis_specifier variable. + + Replaced trop_mozart ub and lb variables for individual species with + corresponding specifier variables as described above. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + + atm/cam/src/chemistry/trop_mozart/mo_ch4_lbc.F90 + atm/cam/src/chemistry/trop_mozart/mo_lb_vals.F90 + atm/cam/src/chemistry/trop_mozart/mo_ub_vals.F90 + atm/cam/src/chemistry/trop_mozart/mo_wetdep.F90 + +List all subroutines added and what they do: + + atm/cam/src/chemistry/trop_mozart/mo_chem_utls.F90 + provides helper functons to allow easier changes in chemical mechanisms + + atm/cam/src/chemistry/trop_mozart/mo_extfrc.F90 + provides the ability to include external (or prescribed) sources (or sinks) + + atm/cam/src/chemistry/trop_mozart/mo_flbc.F90 + applies fixed lower boundary conditions to constituents + + atm/cam/src/chemistry/trop_mozart/mo_fstrat.F90 + applies constraints to constituents in the stratosphere + + atm/cam/src/chemistry/trop_mozart/mo_sethet.F90 + replaces mo_wetdep module -- set heterogeneous reaction rates + + atm/cam/src/chemistry/trop_mozart/mo_synoz.F90 + implements synthetic ozone scheme in the stratosphere + + atm/cam/src/chemistry/trop_mozart/mz_aerosols_intr.F90 + handles the wet depostion of trop_mozart aerososl as well as the + operation of cam implemented sulfur chemistry routines on trop_mozart + constituents + + atm/cam/src/chemistry/trop_mozart/tracer_cnst.F90 + atm/cam/src/chemistry/trop_mozart/tracer_data.F90 + atm/cam/src/chemistry/trop_mozart/tracer_srcs.F90 + These provide the ability to use prescribed constituents as well as + sources for the trop_mozart chemical mechanism. + + atm/cam/src/chemistry/trop_mozart/rad_cnst_data_interface.F90 + Overrides the cam routines that set radiative constituents to prescribed + data to use trop_mozart prescribed data. + + atm/cam/src/physics/cam1/rad_cnst_data_interface.F90 + provides the chemistry packages the opportunity to override procedures + that set the radiative constituents from prescribed data + + atm/cam/src/dynamics/fv/advect_tend.F90 + Handles the computation and history output of advection tendency. + +List all existing files that have been modified, and describe the changes: + + atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + Change defualt upper boundary data files and dust input files. + + atm/cam/bld/cam_inparm.pm + Made changes to accommodate the namelist changes for the trop_mozart + chemistry package. + Set default aero_feedback=.false. since a special aerosol optics + file is required for dust. + + atm/cam/bld/config_trop_chem_mozart_defaults.xml + set prog_aero="dust,seasalt" and nadv=98 for default trop_mozart chemistry + + atm/cam/bld/configure + - allow prog_aero seasalt without dust for trop_mozart chemistry + - set cppdef DUST for seasalt or dust when trop_mozart is used + - disallow prog_aero sulfur and caer (carbon aerosols) when + trop_mozart is used + + atm/cam/src/chemistry/trop_mozart/chem_mods.F90 + atm/cam/src/chemistry/trop_mozart/chemistry.F90 + atm/cam/src/chemistry/trop_mozart/m_het_id.F90 + atm/cam/src/chemistry/trop_mozart/m_spc_id.F90 + atm/cam/src/chemistry/trop_mozart/mo_aerosols.F90 + atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 + atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 + atm/cam/src/chemistry/trop_mozart/mo_constants.F90 + atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + atm/cam/src/chemistry/trop_mozart/mo_exp_sol.F90 + atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 + atm/cam/src/chemistry/trop_mozart/mo_imp_sol.F90 + atm/cam/src/chemistry/trop_mozart/mo_indprd.F90 + atm/cam/src/chemistry/trop_mozart/mo_jlong.F90 + atm/cam/src/chemistry/trop_mozart/mo_jshort.F90 + atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 + atm/cam/src/chemistry/trop_mozart/mo_lin_matrix.F90 + atm/cam/src/chemistry/trop_mozart/mo_lu_factor.F90 + atm/cam/src/chemistry/trop_mozart/mo_lu_solve.F90 + atm/cam/src/chemistry/trop_mozart/mo_mass_xforms.F90 + atm/cam/src/chemistry/trop_mozart/mo_nln_matrix.F90 + atm/cam/src/chemistry/trop_mozart/mo_photo.F90 + atm/cam/src/chemistry/trop_mozart/mo_photoin.F90 + atm/cam/src/chemistry/trop_mozart/mo_prod_loss.F90 + atm/cam/src/chemistry/trop_mozart/mo_rtlink.F90 + atm/cam/src/chemistry/trop_mozart/mo_seasalt.F90 + atm/cam/src/chemistry/trop_mozart/mo_setaer.F90 + atm/cam/src/chemistry/trop_mozart/mo_setext.F90 + atm/cam/src/chemistry/trop_mozart/mo_setinv.F90 + atm/cam/src/chemistry/trop_mozart/mo_setrxt.F90 + atm/cam/src/chemistry/trop_mozart/mo_setsoa.F90 + atm/cam/src/chemistry/trop_mozart/mo_setsox.F90 + atm/cam/src/chemistry/trop_mozart/mo_sim_dat.F90 + atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 + atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 + atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 + atm/cam/src/chemistry/trop_mozart/mo_usrrxt.F90 + Changes in the trop_mozart chemistry are mostly for: + - the addition to SYNOZ/O3RAD ozone formulation and NH4/H2SO4 chemistry + - flexible namelist variables + - addition of helper functions to allow flexibility in terms of + chemical mechanisms facilitated by the chemical preprocessor + + atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + interface changes that correspond to the interface changes of + trop_mozart/chemistry.F90 + + atm/cam/src/control/atm_comp_mct.F90 + Added a check to insure that dust constituents are in the + simulation before setting the dust surface fluxes. + + atm/cam/src/control/runtime_opts.F90 + Added several namelist variables for trop_mozart chemistry package + for the flexible chemical mechanism implementation (see above). + Added a check to not allow trace_gas = .true. when trop_mozart + chemistry package is used. + + atm/cam/src/dynamics/fv/dyn_comp.F90 + Changed the actual argument "dyn_state%grid" to "grid" to + subroutines metdata_dyn_init, get_met_fields and adjust_press. + + atm/cam/src/dynamics/fv/metdata.F90 + Removed the unnecessary ghosting of US and VS in the get_us_vs + subroutine. + + atm/cam/src/dynamics/fv/stepon.F90 + Added calls to compute and output advection tendencies. + + atm/cam/src/physics/cam1/aerosol_intr.F90 + Moved the call to hub2atm_sepopts to aerosol_register_cnst + from the dust_intr module -- this is to allow one to have + sea salt constituents without dust constituents. + Disabled the register call for dust and sea salts when + trop_mozart chemistry package is used. + Added the invocation of wet deposition of trop_mozart aerosols. + + atm/cam/src/physics/cam1/aerosol_radiation_interface.F90 + added optical depth history outputs of carbon and dust + + atm/cam/src/physics/cam1/chemistry.F90 + interface changes that correspond to the interface changes of + trop_mozart/chemistry.F90 + + atm/cam/src/physics/cam1/convect_deep.F90 + add prognostics outputs of convective mass fluxes + + atm/cam/src/physics/cam1/drydep_mod.F90 + don't allow surface friction velocity returned from calcram + to be equal to zero -- zero fv causes a float point exception + in the dry deposition calculation of dust and sea salt + + atm/cam/src/physics/cam1/dust_intr.F90 + changes dust names + a lot of code cleanup + added the public interfaces: + dust_set_idx, dust_names, and dust_has_wet_dep + + atm/cam/src/physics/cam1/progseasalts_intr.F90 + changes sea salt names + a lot of code cleanup + added the public interfaces: + progseasalts_set_idx, progseasalt_names, and progseasalt_has_wet_dep + + atm/cam/src/physics/cam1/rad_constituents.F90 + added string variables to be used for radiative constituent names + + atm/cam/src/physics/cam1/radiation.F90 + replaced hard wired radiative constituent names with string + variables defined on the rad_constituents module + + atm/cam/src/physics/cam1/restart_physics.F90 + added a call to write and read chemistry data to restart file + + atm/cam/src/physics/cam1/sulchem.F90 + created a sulfur chemistry driver seperate from the wet deposition + -- this gives the trop_mozart chemistry the opportunity to use + the "cam" sulfur chemistry routines without the wet deposition. + + atm/cam/src/physics/cam1/sulfur_intr.F90 + moved some of the addfld calls to sulchem.F90 -- where the + fields are output to history + + atm/cam/src/physics/waccm/chemistry.F90 + interface changes that correspond to the interface changes of + trop_mozart/chemistry.F90 + + drv/seq_flds/dust/seq_flds_mod.F90 + corrected fortran syntax errors and made changes for ibm compile + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: + +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 5 +These failures are expected due to changes in trop_mozart chemistry package. + +tempest: All Pass + +bangkok/lf95: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_40 +Originator(s): eaton +Date: Tue Nov 7 10:19:16 MST 2006 +One-line Summary: Misc updates + +Purpose of changes: + +. Replace all occurances of 273.16 either by SHR_CONST_TKFRZ or by tmelt + which is the CAM specific constant that's set to SHR_CONST_TKFRZ in the + physconst module. + +. Remove the cfort.h file -- put the Fortran name mangling CPP macro into + CAM and SCAM's configure. + +. Remove cfort.h from the timing library. This required creating a new + trunk_tag for the timing library (timing_061028) and updating CAM's + external property to use it. + +. Update MCT to trunk_tag MCT2_2_3_061018. + +. Update CLM to trunk_tag clm3_expa_76. + +. Remove excessive info/debug print statements (there is more to do). + +. Fix bug (introduced at cam3_3_34) to enable running w/ HOMME dycore. + + +Bugs fixed (include bugzilla ID): + +. bugID 224 -- fix for SHR_CONST_TKFRZ + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +. possible performance improvements on certain platforms due to update of + MCT and CLM externals + +Code reviewed by: eaton + +List all subroutines eliminated: + + atm/cam/src/utils/cfort.h + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. SHR_CONST_TKFRZ mods in: + models/atm/cam/src/physics/cam1/stratiform.F90 + models/atm/cam/src/physics/cam1/wetdep.F90 + models/atm/cam/src/physics/cam1/sulchem.F90 + models/atm/cam/src/physics/cam1/water_isotopes.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + +. mods to remove cfort.h in: + models/atm/cam/bld/configure + models/atm/cam/bld/Makefile.in + models/atm/cam/tools/scam/configure + models/atm/cam/src/control/get_memusage.c + models/atm/cam/src/control/linebuf_stdout.c + models/atm/cam/src/control/uselbuf.c + models/utils/timing/f_wrappers.c # create trunk_tag timing_061028 + +. update external for timing library, MCT, and CLM + models/SVN_EXTERNAL_DIRECTORIES + models/utils/SVN_EXTERNAL_DIRECTORIES + +. remove excessive info print statements + models/atm/cam/src/physics/cam1/phys_grid.F90 + models/atm/cam/src/control/cam_history.F90 + +. Replace deprecated float intrinsic by real + models/atm/cam/src/control/interpolate_data.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: All PASS except expected failures of offline trop_mozart tests: + +038 sm355 TSM.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 8 +039 er355 TER.sh fmo2dh off2x2.5 4+5 ..............................FAIL! rc= 5 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 4 + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam3_3_39 +Originator(s): mvertens +Date: Fri Nov 3 16:40:37 MST 2006 +One-line Summary: Top level driver now invokes cam as one run phase + +Purpose of changes: To have CAM called as one run phase from the top level driver. +This is necessary if the surface components are to couple to cam at frequencies +other than the cam time step (a feature that will be required for a sequential CCSM). + +Bugs fixed (include bugzilla ID): #255 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: eaton + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + M atm/cam/tools/scam/scm_init/init_model.F90 + M atm/cam/tools/scam/scm_init/scam_run.F90 + M atm/cam/src/control/atm_comp_mct.F90 + M drv/seq_mct_drv/seq_ccsm_drv.F90 + - Seq_ccsm_drv.F90 and scam_run.F90 will now call only one run phase of cam. + The basic idea is that the first time the cam run phase is called outside + of the time loop, it will only call tphysbc. Within the run loop the cam + mct levelrun phase will call tphysac, update the cam time and then call tphysbc. + + M drv/seq_mct/seq_domain_mct.F90 + - removed extra writes + + M drv/seq_mct/seq_flux_mct.F90 + - fixed bug #255 + + M drv/seq_flds/dust/seq_flds_mod.F90 + M drv/seq_flds/default/seq_flds_mod.F90 + M drv/seq_flds/gensom/seq_flds_mod.F90 + M drv/seq_flds_indices/seq_flds_indices.F90 + - Added Foxx_salt to drv->ocn fields + Note needed now, but will be needed when pop is used for active ocn + + M drv/seq_mct/mrg_x2o_mct.F90 + - Fixed bugs for fields needed in merging when active ocean will be + utilized + + M ice/csim4/ice_data.F90 + M ice/csim4/ice_dh.F + M ice/csim4/ice_srf.F90 + M ice/csim4/ice_comp.F90 + M atm/cam/src/control/runtime_opts.F90 + M atm/cam/src/control/cam_control_mod.F90 + - moved input namelist variables prognostic_icesnow and reset_csim_iceprops + from ice_dh to cam_control_mod.F90. This will make it possible to replace + cam-csim with cice4. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +019 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 +- this test failed due to a sign change implemented for the latent/sensible + oi gensom fluxes (this was a bug introduced in cam3_3_37 that did not get picked + up in the testing. +038 sm355 TSM.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 8 +039 er355 TER.sh fmo2dh off2x2.5 4+5 ..............................FAIL! rc= 5 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 4 +- these tests began failing with the upgrade of the compilers on bluevista + around 060918...a retest of a previous tag (cam3_3_28) where these tests + had passed, showed these tests now fail as well...it fails run-time as it + tries to read in the met data...see bug #239 + +tempest: All tests passed except for +021 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 +- this tested failed due to the same gensom bug fix as appeared in bluevista + test 19 + +bangkok/lf95: All tests passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None, answers are bfb except for gensom oi diagnostics + +=============================================================== +=============================================================== + +Tag name: cam3_3_38 +Originator(s): mvr +Date: 20061027 +One-line Summary: mods to resolve naming conflict when cam is used in +a ccsm single-executable; bluevista replaces bluesky as required pretag +test platform; mods to conform to changes in ccsm's test scripts + +Purpose of changes: one more naming conflict in ccsm single-executable +that was overlooked; bluesky is scheduled for decommission by the end +of the year, so bluevista will now be the platform required for testing +cam prior to commits; ccsm changed its default behavior for cleanup +of files after successful tests - a change was made to specifically +turn off this cleanup and let cam's test scripts handle the cleanup + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: +D models/atm/cam/src/control/restart.F90 +- just a rename required to clear up name conflict in ccsm single-executable + +List all subroutines added and what they do: +A + models/atm/cam/src/control/cam_restart.F90 +- newly named file and mods to clear up name conflict in ccsm single-executable +A models/atm/cam/test/system/tests_pretag_bluevista +- new file with test ids to run by default for pretag testing on bluevista + +List all existing files that have been modified, and describe the changes: +M models/ocn/dom/ocn_comp.F90 +M models/ocn/som/ocn_comp.F90 +M models/ice/csim4/ice_comp.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/drv/seq_mct/mrg_x2a_mct.F90 +- files modified to reflect name change: restart -> cam_restart + +M ChangeLog_template +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/TCT.ccsm.sh +M models/atm/cam/test/system/tests_posttag_bluesky +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/tests_posttag_bluevista +- mods to test scripts to have bluevista replace bluesky as the required + platform for pretag testing, utilize mods in ccsm scripts for the bluevista16 + machine definition, and turned off ccsm's cleanup functionality + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluevista: +038 sm355 TSM.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 8 +039 er355 TER.sh fmo2dh off2x2.5 4+5 ..............................FAIL! rc= 5 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 4 +- these tests began failing with the upgrade of the compilers on bluevista + around 060918...a retest of a previous tag (cam3_3_28) where these tests + had passed, showed these tests now fail as well...it fails run-time as it + tries to read in the met data...see bug #239 + +tempest: +all pass + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_37 +Originator(s): mvertens +Date: Tue Oct 24 22:58:04 MDT 2006 +One-line Summary: use cpl6 ocn/atm flux calculation and surface flux sign convention + +Purpose of changes: To bring the current sequential system in line with the + concurrent system atm/ocn flux calculation, ocn and ice and merge functionalities, + and ccsm surface flux sign convention. In addition, to remove the need for the ice + and ocean components to know pass any landfrac information to the top level driver. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none (to the best of my knowledge) + +Code reviewed by: mvertens, rjacob, tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + M ocn/dom/ocn_comp.F90 + - Removed all references to lwup + M ocn/dom/ocn_comp_mct.F90 + - Removed latr and lonr from dom_o - conversion is now done in seq_flux_mct.F90 + - Removed o2x_o(index_o2x_Faoo_lwup,ig) - (now done in atm/ocn flux calc) + - Removed setting of maxfrac to 1.-landfrac in dom_o + + M ocn/som/ocn_types.F90 + - Removed lwup from ocn_out type + M ocn/som/ocn_comp.F90 + - Removed computation of lwup (now done in atm/ocn flux calc) + - Removed lwup from restart file + M ocn/som/ocn_comp_mct.F90 + - Removed latr and lonr from dom_o - conversion is now done in seq_flux_mct.F90 + - Removed o2x_o(index_o2x_Faoo_lwup,ig) - (now done in atm/ocn flux calc) + - Removed setting of maxfrac to 1.-landfrac in dom_o + - Set sign convention to fluxes are positive downwards + - Moved multiplication of fswabs, shflx, lhflx, lwdn and lwup by (1.-aice) + to mrg_x2o_mct.F90 (this is consistent now with ocn merging in cpl6) + + M ice/csim4/ice_types.F90 + - Made cflx component of ice_out one-dimensional + - Made qbot component of ice_in one-dimensional + - Removed reference to pcnst + M ice/csim4/ice_srf.F90 + - Fluxes are now positive downwards for lwup, shflx, lhflx, taux, tauy, qflx + - Removed setting of non-water constituent fluxes to zero + - Arguemnts qbot and qflx no longer depend on pcnst+pnats + M ice/csim4/ice_diagnostics.F + - Made qbot component of ice_in one-dimensional + M ice/csim4/ice_comp.F90 + - Sign convention for lwup is now that fluxes are positive downwards + - Removed references to aqua-planet + M ice/csim4/ice_comp_mct.F90 + - Removed i2x_i%rAttr(index_i2x_Si_aice,ig) and set i2x_i%rAttr(index_i2x_Si_ifrac,ig) + to now correspond to fraction of ice with respect to ocean part of gridcell + + M atm/cam/test/system/test_driver.sh + - Updates to lightning and bluevista tests + - Replaced x2a_a%rAttr(index_x2a_Faoo_lwup,n) with x2a_a%rAttr(index_x2a_Faox_lwup,n) + + M atm/cam/src/control/atm_comp_mct.F90 + - Sign convention is that all fluxes from driver are positive downwards + + M drv/seq_flds/dust/seq_flds_mod.F90 + M drv/seq_flds/default/seq_flds_mod.F90 + M drv/seq_flds/gensom/seq_flds_mod.F90 + M drv/seq_flds_indices/seq_flds_indices.F90 + - Added fields and indices to get closer to cpl_fields_mod. This involved adding: + 'So_u' ! velocity, zonal DEF + 'So_v' ! velocity, meridional DEF + 'So_s' ! salinity DEF + 'So_dhdx' ! surface slope, zonal DEF + 'So_dhdy' ! surface slope, meridional DEF + 'Si_ifrac' ! state: ice fraction wrt ocean DEF + 'Sa_pslv' ! state: sea level pressure DEF + 'Foxx_lwup' ! heat flux: long-wave up DEF + 'Foxx_prec' ! water flux: rain+snow DEF + 'Foxx_snow' ! water flux: snow DEF + 'Foxx_rain' ! water flux: rain DEF + 'Foxx_evap' ! water flux: evap DEF + 'Foxx_meltw' ! water flux: melt DEF + 'Forr_roff' ! water flux: runoff DEF + 'Faoo_lwup' ! shortwave: net absorbed DEF + 'Faox_lwup' ! upward longwave heat flux DEF + and removed Si_aice and changed the previous functionality of Si_ifrac + Some of the above fields are not currently used - but are place holders for + when the ccsm components will be put in. + + M atm/cam/tools/scam/scm_init/init_model.F90 + - Added domain information to mapping initialization + + M drv/seq_mct_drv/seq_ccsm_drv.F90 + - Added domain information to mapping initialization + + M drv/seq_mct/mrg_x2a_mct.F90 + - Replaced index_o2x_Faoo_lwup with index_xao_Faox_lwup + + M drv/seq_mct/mrg_x2o_mct.F90 + - Merging functionality for input to ocn component is now same as cpl6 + + M drv/seq_mct/seq_domain_mct.F90 + - maxfrac_o = 1.- maxfrac_l is set for points where maxfrac_l > 0 and + maxfrac_l < 1. The same is true for maxfrac_i. As a result, the ocean + and ice components need not know the land fraction in the gridcell. + Furthermore, the ice fraction need only be scaled as that relative to + the total gridcell for merging functionality from drv->atm. The ice fraction + is only needed relative to the ocean part of the gridcell for merging + functionality from drv->ocn. + + M drv/seq_mct/seq_flux_mct.F90 + - xao_o%rAttr(index_xao_Faox_lwup,n) is now used (instead of lwup + being calculated by the ocean components) + - flux_albo is not identical to cpl6 code + + M drv/seq_mct/flux_ao.F90 + - This code is now the same as the flux_atmOcn routine in the cpl6 flux_mod.F90. + Both this routine and flux_atmOcn will be migrated to a csm_share/shr/shr_flux_mod.F90 + code base in upcoming tags. + + M drv/seq_mct/seq_mct_mod.F90 + - Added use aliases for mct_aVectimport Rattr and mct_aVect_exportRattr + + M drv/seq_mct/map_atmice_mct.F90 + - Obtain maxfrac_ice on atmosphere decomp, needed for merging to atmosphere grid + when all components are on same grid and when partial land cover in ice gridcell. + - Added domain information to initialization phase + + M drv/seq_mct/map_atmlnd_mct.F90 + M drv/seq_mct/map_iceocn_mct.F90 + M drv/seq_mct/map_atmocn_mct.F90 + - Added domain information to initialization phases + + SVN_EXTERNALS has been updated to clm3_expa_75 + M lnd/clm2/src/main/clm_time_manager.F90 + - Removed write statement to fort.30 + M lnd/clm2/src/main/lnd_comp_mct.F90 + - Changed sign convention of fluxes sent to driver to be consistent + with those used by concurrent ccsm + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all tests passed except for + + 005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 + 019 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 + 030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 + 034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 + 037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 + 044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 5 + + the above were bfb except for the TREFHT output (which is not totally different) + + 008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + + the above represent round-off level diffs for som tests + +tempest: all tests passed except for + + 004 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 014 bl152 TBL.sh e64o outfrq24h -2 ................................FAIL! rc= 7 + 017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 + 021 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 + 031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 + 035 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 045 bl552 TBL.sh s64o outfrq24h -2 ................................FAIL! rc= 7 + + the above were bfb except for the TREFHT output (which is not totally different) + + 007 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 038 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 + + the above represent round-off level diffs for som tests + +bangkok/lf95: all tests passed except for + + 004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 7 + 016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 + 024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 + 032 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 7 + + the above were bfb except for the TREFHT output (which is not totally different) + + 012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 + 028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 + 040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + + the above represent round-off level diffs due to higher optimization levels + than the 9 timestep tests + + 008 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 7 + 036 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 7 + + the above represent round-off level diffs for som tests + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- nature of change (larger than roundoff but same climate) + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +- source tag (all code used must be in the repository): + cam3_3_37 +- platform/compilers: + ibm (bluesky) +- configure commandline: + configure -ocn dom -dyn fv -spmd -smp -test -res 4x5 -gensom +- build-namelist command (or complete namelist): + &ccsm_inparm + case_name = 'cam3_3_34_nonbfb_fv4x5dom' + start_type = "startup" + / + &timemgr_inparm + atm_cpl_dt = 1800 + orb_iyear_ad = 1950 + restart_option= 'monthly' + start_ymd = 10101 + stop_n = 4000 + stop_option = 'ndays' + / + &cam_inparm + absems_data = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' + aeroptics = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' + bnd_topo = '/fis/cgd/cseg/csm/inputdata/atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc' + bndtvaer = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolMass_V_4x5_clim_c031022.nc' + bndtvo = '/fis/cgd/cseg/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' + bndtvs = '/fis/cgd/cseg/csm/inputdata/atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c030228.nc' + dtime = 1800 + ncdata = '/fis/cgd/cseg/csm/inputdata/atm/cam/inic/fv/cami_0001-01-01_4x5_L26_c060608.nc' + / + &clm_inparm + dtime = 1800 + fpftcon = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' + fsurdat = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_4x5_c050523.nc' + / + +MSS location of output: + /MVERTENS/csm/cam3_3_34_nonbfb_fv4x5dom + +MSS location of control simulations used to validate new climate: + /MVERTENS/csm/cam3_3_34_nonbfb_fv4x5dom_0 + +URL for AMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/cms/rneale/runs/cam/cam3_3_34_nonbfb_fv4x5dom-cam3_3_34_nonbfb_fv4x5dom_0/ +=============================================================== +=============================================================== + +Tag name: cam3_3_36 +Originator(s): mvertens +Date: Tue Oct 24 21:58:40 MDT 2006 +One-line Summary: non-bfb changes corresponding to cam3_3_37 + +Purpose of changes: to create the minimal code base that generates the + greater than round-off changes in cam3_3_37. Since cam3_3_37 will + contain number round-off level changes for som, it is useful to isolate + the few pieces of code that produced the greater than round-off differences.a + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens + M models/ocn/dom/ocn_comp.F90 + - Computation of lwup is occuring before temperature is updated. This is + now consistent with obtaining lwup from atm/ocn flux computation. This + will ensure that all fluxes in atm/ocn flux computation (including lwup) + are based on the same surface temperature. + M models/ocn/som/ocn_comp.F90 + - No longer multiplying onf by 1.-aice. Now doing this to each component of + onf in ocn_comp_mct.F90 + M models/ocn/som/ocn_comp_mct.F90 + - Now multiplying Foxx_melth, Foxx_swnet, Foxx_sen, Foxx_lat and Foxx_lwdn, + and lwup by 1.-aice. + M models/atm/cam/src/control/atm_comp_mct.F90 + - At first time step determine the longwave up flux from the surface + temperature. This is identical to what is being done in ccsm_msg.F90 + M models/drv/seq_mct/seq_flux_mct.F90 + - Put in computation to no longer require lat/lon to be passed in radians + from the ocean domain. Ocean domain will now pass lat/lon in degrees and + will convert to radians. + - Set ocean albedos to 1. when coszen < 0. + M models/drv/seq_mct/flux_ao.F90 + - Set umin to 0.5_r8 + This is the only answer changing modification between this code and the + atm/ocn flux calcuation code in cpl6. The goal is for both the concurrent + and sequential ccsm to use the same atm/ocn flux calculation code base. + Note that the diagnostic TREF will be totally different when the cpl6 + atm/ocn flux calculation is utilized + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all passed except for following baseline comparisons + 005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 010 bl133 TBL.sh e32pdh aqpgro 3 ..................................FAIL! rc= 7 + 015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 + 019 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 + 022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 + 030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 + 034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 + 037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 + 040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + 044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 049 bl533 TBL.sh s32pdh aqpgro 3 ..................................FAIL! rc= 7 + 054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 + +tempest: all passed except for following baseline comparisons + 004 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 5 + 007 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 5 + 009 bl133 TBL.sh e32pdh aqpgro 3 ..................................FAIL! rc= 5 + 012 bl135 TBL.sh e32dh idphys 9 ...................................FAIL! rc= 5 + 014 bl152 TBL.sh e64o outfrq24h -2 ................................FAIL! rc= 5 + 017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 5 + 021 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 5 + 024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 5 + 026 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 5 + 029 bl335 TBL.sh f4dh idphys 9 ....................................FAIL! rc= 5 + 031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 5 + 035 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 5 + 038 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 5 + 040 bl533 TBL.sh s32pdh aqpgro 3 ..................................FAIL! rc= 5 + 043 bl535 TBL.sh s32dh idphys 9 ...................................FAIL! rc= 5 + 045 bl552 TBL.sh s64o outfrq24h -2 ................................FAIL! rc= 5 + +bangkok/lf95: all passed except for following baseline comparisons + 004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 7 + 008 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 7 + 010 bl113 TBL.sh e8pdm aqpgro 3 ...................................FAIL! rc= 7 + 012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 + 016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 + 024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 + 026 bl313 TBL.sh f10pdm aqpgro 3 ..................................FAIL! rc= 7 + 028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 + 032 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 7 + 036 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 7 + 038 bl513 TBL.sh s8pdm aqpgro 3 ...................................FAIL! rc= 7 + 040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- nature of change (larger than roundoff but same climate) + see complete documentation of runs to evaluate changes in cam3_3_37 tag info + +=============================================================== +=============================================================== + +Tag name: cam3_3_35 +Originator(s): Jim Edwards +Date: 10-11-2006 +One-line Summary: homme dycore development, replacement of cam common blocks + +Purpose of changes: development, code clean-up + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: refined build support for target_os=bgl + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: +D 2094 models/atm/cam/src/control/comtfc.h +D 2094 models/atm/cam/src/control/comfft.h +D 2094 models/atm/cam/src/control/comctl.h +D 2094 models/atm/cam/src/control/comqfl.h +D 2094 models/atm/cam/src/control/perturb.h +D 2094 models/atm/cam/src/physics/cam1/comsol.h +D 2094 models/atm/cam/src/physics/cam1/comtsc.h +D 2094 models/atm/cam/src/physics/cam1/comadj.h + +List all subroutines added and what they do: +These are data modules which replace the common blocks eliminated above, +because the fv_control_mod contains namelist variables it needs to be compiled +regardless of dycore - thus it's location in the control directory. + +A + - models/atm/cam/src/control/cam_control_mod.F90 +A + - models/atm/cam/src/control/fv_control_mod.F90 +A + - models/atm/cam/src/dynamics/sld/sld_control_mod.F90 +A + - models/atm/cam/src/dynamics/eul/eul_control_mod.F90 + + +List all existing files that have been modified, and describe the changes: +Changes related to the continuing development of the homme dycore: +M 2094 models/atm/cam/src/dynamics/homme/external/forcing_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/element_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/dof_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/bndry_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/baroclinic_inst_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/external/edge_mod.F90 +M 2094 models/atm/cam/src/dynamics/homme/README +M 2094 models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M 2094 models/atm/cam/src/dynamics/homme/stepon.F90 +M 2094 models/atm/cam/src/dynamics/homme/inidat.F90 +M 2094 models/atm/cam/src/dynamics/homme/dyn_comp.F90 +M 2094 models/atm/cam/src/dynamics/homme/restart_dynamics.F90 +M 2094 models/atm/cam/src/dynamics/homme/inital.F90 +C 2094 models/ocn/dom/sst_data.F90 +M 2094 models/atm/cam/tools/interpic_new/README +M 2094 models/atm/cam/bld/configure +M 2094 models/atm/cam/bld/Makefile.in +M 2094 models/atm/cam/src/control/cam_history.F90 +M 2094 models/atm/cam/src/utils/abortutils.F90 +M 2094 models/atm/cam/src/physics/cam1/tphysidl.F90 + +Changes related to the elemination of common blocks (note: there is some overlap in these lists): +C 2094 models/ocn/dom/sst_data.F90 +M 2094 models/ocn/dom/ocn_comp.F90 +M 2094 models/ocn/som/somint.F90 +M 2094 models/ocn/som/ocn_comp.F90 +M 2094 models/ocn/som/somini.F90 +M 2094 models/ice/csim4/ice_data.F90 +C 2094 models/ice/csim4/ice_comp.F90 +M 2094 models/atm/cam/tools/scam/scm_init/init_model.F90 +M 2094 models/atm/cam/tools/scam/scm_init/forecast.F90 +M 2094 models/atm/cam/tools/scam/scm_init/inital.F90 +M 2094 models/atm/cam/tools/scam/scm_init/readiopdata.F90 +M 2094 models/atm/cam/src/control/readinitial.F90 +M 2094 models/atm/cam/src/control/history_defaults.F90 +M 2094 models/atm/cam/src/control/runtime_opts.F90 +M 2094 models/atm/cam/src/control/ncdio_atm.F90 +M 2094 models/atm/cam/src/control/srfxfer.F90 +M 2094 models/atm/cam/src/control/restart.F90 +M 2094 models/atm/cam/src/control/startup_initialconds.F90 +M 2094 models/atm/cam/src/control/history_scam.F90 +C 2094 models/atm/cam/src/control/cam_comp.F90 +M 2094 models/atm/cam/src/control/cam_history.F90 +M 2094 models/atm/cam/src/physics/cam1/initindx.F90 +M 2094 models/atm/cam/src/physics/cam1/zenith.F90 +M 2094 models/atm/cam/src/physics/cam1/radiation.F90 +M 2094 models/atm/cam/src/physics/cam1/tphysbc.F90 +M 2094 models/atm/cam/src/physics/cam1/check_energy.F90 +M 2094 models/atm/cam/src/physics/cam1/restart_physics.F90 +M 2094 models/atm/cam/src/physics/cam1/cam_diagnostics.F90 +M 2094 models/atm/cam/src/physics/cam1/phys_gmean.F90 +M 2094 models/atm/cam/src/physics/cam1/stratiform.F90 +M 2094 models/atm/cam/src/physics/cam1/physics_types.F90 +M 2094 models/atm/cam/src/physics/cam1/radlw.F90 +M 2094 models/atm/cam/src/physics/cam1/tsinti.F90 +M 2094 models/atm/cam/src/physics/cam1/co2_data_flux.F90 +M 2094 models/atm/cam/src/physics/cam1/physpkg.F90 +M 2094 models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +M 2094 models/atm/cam/src/physics/cam1/dadadj.F90 +M 2094 models/atm/cam/src/physics/cam1/chemistry.F90 +M 2094 models/atm/cam/src/physics/cam1/phys_buffer.F90 +M 2094 models/atm/cam/src/physics/cam1/ramp_scon.F90 +M 2094 models/atm/cam/src/physics/cam1/phys_grid.F90 +M 2094 models/atm/cam/src/physics/cam1/advnce.F90 +M 2094 models/atm/cam/src/physics/cam1/tphysac.F90 +M 2094 models/atm/cam/src/physics/cam1/zm_conv.F90 +M 2094 models/atm/cam/src/physics/cam1/cldwat.F90 +M 2094 models/atm/cam/src/physics/waccm/nlte_fomichev.F90 +M 2094 models/atm/cam/src/physics/waccm/chemistry.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/solvar_interface.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/mo_apex.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/efield.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_hrates.F90 +M 2094 models/atm/cam/src/chemistry/waccm_mozart/exbdrift.F90 +M 2094 models/atm/cam/src/dynamics/sld/spegrd.F90 +M 2094 models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M 2094 models/atm/cam/src/dynamics/sld/initcom.F90 +M 2094 models/atm/cam/src/dynamics/sld/scanslt.F90 +M 2094 models/atm/cam/src/dynamics/sld/inidat.F90 +M 2094 models/atm/cam/src/dynamics/sld/dyn_comp.F90 +M 2094 models/atm/cam/src/dynamics/sld/hordif.F90 +M 2094 models/atm/cam/src/dynamics/sld/spetru.F90 +M 2094 models/atm/cam/src/dynamics/sld/scan2.F90 +M 2094 models/atm/cam/src/dynamics/sld/restart_dynamics.F90 +M 2094 models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 +M 2094 models/atm/cam/src/dynamics/eul/spegrd.F90 +M 2094 models/atm/cam/src/dynamics/eul/initcom.F90 +M 2094 models/atm/cam/src/dynamics/eul/linemsdyn.F90 +M 2094 models/atm/cam/src/dynamics/eul/scanslt.F90 +M 2094 models/atm/cam/src/dynamics/eul/inidat.F90 +M 2094 models/atm/cam/src/dynamics/eul/dyn_comp.F90 +M 2094 models/atm/cam/src/dynamics/eul/hordif.F90 +M 2094 models/atm/cam/src/dynamics/eul/spetru.F90 +M 2094 models/atm/cam/src/dynamics/eul/scan2.F90 +M 2094 models/atm/cam/src/dynamics/eul/restart_dynamics.F90 +M 2094 models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +M 2094 models/atm/cam/src/dynamics/fv/pmgrid.F90 +M 2094 models/atm/cam/src/dynamics/fv/initcom.F90 +M 2094 models/atm/cam/src/dynamics/fv/dryairm.F90 +M 2094 models/atm/cam/src/dynamics/fv/inidat.F90 +M 2094 models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M 2094 models/atm/cam/src/dynamics/fv/inital.F90 +M 2094 models/atm/cam/src/dynamics/fv/stepon.F90 +M 2094 models/atm/cam/src/dynamics/fv/restart_dynamics.F90 +M 2094 models/atm/cam/src/dynamics/fv/metdata.F90 +M 2094 models/atm/cam/src/advection/slt/difcor.F90 +C 2094 models/drv/seq_mct/mrg_x2l_mct.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: none + +tempest: none + +bangkok/lf95: none + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., + - what code configurations: - what platforms/compilers: - nature + of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_34 +Originator(s): Will Sawyer +Date: Wed Oct 11 03:05:07 MDT 2006 +One-line Summary: Reduce init time (#213), clean up FV constants (#214), allocate status (#166) + +Purpose of changes: + + o PILGRIM initialization time has been reduced (Bug #213). This has + been achieved by removing the communications for XZY index and replacing + them by XYZ communication patterns. These are assembled by generating + an XY decomposition comm. pattern, then extending it to 3D in the + (undistributed) Z direction. This reduces initialization time, drastically + in the case of high resolution. Note that this change required extensive + restructuring of cam_history. + + o The status of allocation of large 3-D arrays in FV is checked (Bug #166) + + o FV constants were cleaned up in a consistent way (Bug #214), e.g., + + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D1_5 = 1.5_r8 + +Bugs fixed (include bugzilla ID): #166, #213, #214 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: FV initialization time is + now much faster, especially so for high resolutions. + +Code reviewed by: myself + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/control/cam_history.F90: Extensive changes to use + XYZ indexing to gather and scatter arrays. Now only one type of + PILGRIM gather/scatter operation (fv_gather_??, fv_scatter_??) + is used. Addition of routines to copy the *local* portion of the + array from XYZ -> XZY (loc_xyz_to_xzy) and XZY -> XYZ (loc_xzy_to_xyz) + decompositions. Performing this local give a minor performance + improvement. Overall this reduces the length and complexity of the + module. Treats the writing of the staggered U-winds field (which + has 1 less latitude than other fields) in a cleaner way. Now + writes all fields to restart consistently in XYZ indexing. + + models/atm/cam/src/dynamics/fv/benergy.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/cd_core.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/d2a3dijk.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/d2a3dikj.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/dp_coupling.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/dyn_grid.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/dynconst.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/epvd.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/fill_module.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/fv_prints.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/geopk.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/inital.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/initcom.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/mapz_module.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/mean_module.F90: new treatment of constants, e.g., + models/atm/cam/src/dynamics/fv/metdata.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/p_d_adjust.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/par_vecsum.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/pfixer.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/pft_module.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/stepon.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/sw_core.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/te_map.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/trac2d.F90: new treatment of constants + models/atm/cam/src/dynamics/fv/tp_core.F90: new treatment of constants, cleaning + models/atm/cam/src/dynamics/fv/xpavg.F90: new treatment of constants + + models/atm/cam/src/dynamics/fv/dyn_comp.F90: new treatment of constants, test return + status of allocations + + models/atm/cam/src/dynamics/fv/inidat.F90: new treatment of constants, test return + status of allocations, use new naming scheme for scatter/gather comm. patterns + + models/atm/cam/src/dynamics/fv/restart_dynamics.F90: new treatment of constants; + use new naming scheme for scatter/gather comm. patterns + + models/atm/cam/src/dynamics/fv/io_dist.F90: extensive cleaning. Removed old + methods for writing and reading; scheme is now consistent with + fv_read/write_r4/r8/i4 and fv_scatter/gather_r4/r8/i4 routines. + + models/atm/cam/src/dynamics/fv/dynamics_vars.F90: removed (unused) ESMF code + revised naming scheme for gather/scatter comm. patterns now consistent, + added PI argument to dynamics_init, dynpkg_init; XYZ patterns generated + by XY pattern with extension in Z; new treatment of constants + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: Failed on tests 030 (bl336), 034 (bl351), 055 (cs998), probably + because of new treatment of constants, specifically removal of + 4.0*atan(1.0) as definition of PI. Perturbation growth tests by + Brian Eaton indicate that these are roundoff differences. Check-in + OK'ed by Mathew Rothstein. + +tempest: passes all tests + +bangkok/lf95: passes all tests + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_33 (previous tag) + +Summarize any changes to answers, i.e., +- what code configurations: WACCM, FV +- what platforms/compilers: Bluesky +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? perturbation growth test (by Eaton) + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== + +Tag name: cam3_3_33 +Originator(s): eaton +Date: Fri Oct 6 16:22:01 MDT 2006 +One-line Summary: Enable linking to external ESMF library + +Purpose of changes: + +. Changes to configure and Makefile.in to allow linking to ESMF library + This can be done by: + 1. setting the new -esmf_libdir option, + or + 2. by setting the environment variable ESMF_LIBDIR. + + Either of these methods will cause configure to check that the + files libesmf.a or libesmf.so and esmf.mk are present in the specified + directory. The esmf.mk file is produced when the ESMF library is built + and contains Makefile macros that CAM's Makefile will reference when + compiling and linking to the external library. + +. Remove interactive mode from configure. + +. Cleanup of Makefile.in. Remove untested SUN and OSF1 sections. + +Bugs fixed (include bugzilla ID): + +. Fix bug in fv/inidat.F90 applying perturbation to initial temperature + field. + +. Fixed SCAM build on bangkok. + +Describe any changes made to build system: + +. Add ability to link to an external ESMF library. The default remains to use + the WRF_ESMF time manager code. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +models/atm/cam/bld/configure +. Add capability to specify that an external ESMF library should be used. +. Add test for linking to the ESMF library to test suite invoked by + configure's -test option. +. Add ability to try running a successfully built test. This helps to + identify problems related shared libraries not being found. +. Remove interactive mode. +. Simplify verbose mode; now set by "-v" option without a numeric argument. + +models/atm/cam/bld/Makefile.in +. Include the esmf.mk file if ESMF_LIBDIR is defined. +. use ESMF_F90COMPILEPATHS from esmf.mk to set search path for esmf module file . +. Use ESMF_F90LINKPATHS and ESMF_F90ESMFLINKLIBS from esmf.mk to set search + path and library name for linking to external esmf lib. +. Remove 32-bit addressing option for AIX. If this is needed somewhere it + should be re-implemented in configure rather than by requiring editing of the + Makefile. +. Remove unused SUN and OSF1 sections. +. Substantial cleanup. Tried to eliminate duplicated code from the + architecture specific sections of the Makefile. Tried to organize the + architecture specific sections to more or less follow the same order of + setting macros. + +models/atm/cam/src/dynamics/fv/inidat.F90 +. fix bug in how perturbation was applied to initial temperature field. + +models/atm/cam/test/system/test_driver.sh +. increase to bluevista time limit from 2:28 to 4:28 to account for + slowdown in compilation times +. update pathscale compiler version to 2.4 from 2.2.1 (on lightning) + +models/atm/cam/tools/scam/ui/configure +. add -lpgc to the LINK_LIBS macro in the Linux section. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_32 +Originator(s): mvertens +Date: Mon Oct 2 21:03:25 MDT 2006 +One-line Summary: Have SCAM driver determine the fractional + land cover in any gridcell. + +Purpose of changes: remove SCAM if-defs in lnd_comp_mct.F90 + and put the logic in SCAM driver. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik, eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + M ocn/dom/ocn_comp_mct.F90 + - removed SCAM if-def + M ocn/som/ocn_comp_mct.F90 + - removed SCAM if-def + M atm/cam/tools/scam/scm_init/init_model.F90 + M atm/cam/tools/scam/scm_init/scamMod.F90 + - changes enable SCAM to read in landfrac for the gridcell and determine + if the land model should be called + M SVN_EXTERNAL_DIRECTORIES + - updated to clm_exp_73 + M drv/seq_mct_drv/seq_ccsm_drv.F90 + - formatting change + M lnd/clm2/src/main/lnd_comp_mct.F90 + - removed SCAM if-defs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: ALL TESTS PASSED +tempest: ALL TESTS PASSED +bangkok/lf95: ALL TESTS PASSED + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE +=============================================================== +=============================================================== + +Tag name: cam3_3_31 +Originator(s): mvertens +Date: Tue Sep 26 19:48:56 MDT 2006 +One-line Summary: made surface components mpi utilities and clm time manager independent of cam + +Purpose of changes: cam surface components no longer "use" cam communicator group settings + and clm no longer uses cam time manager when in COUP_CAM mode + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + M atm/cam/bld/clm_inparm.pm + M atm/cam/bld/SeqCCSM_namelist.pm + - added dtime to clm namelist input + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton, tcraig, robj + +List all subroutines eliminated: none + +List all subroutines added and what they do: + + A ocn/dom/ocn_spmd.F90 + - determine communicator group and masterproc, iam, npes for ocn + A ocn/som/ocn_spmd.F90 + - determine communicator group and masterproc, iam, npes for ocn + A ice/csim4/ice_spmd.F90 + - determine communicator group and masterproc, iam, npes for ice + A drv/seq_mct/seq_communicator.F90 + - determine communicator group and masterproc, iam, npes for drv routines + +List all existing files that have been modified, and describe the changes: + + M ocn/dom/sst_data.F90 + - replace "use mpishorthand" with "use ocn_utils" + - made explicit calls to mpi_bcast rather than the interfaces in mpishorthand + M ocn/dom/ocn_comp.F90 + - replace "use spmd_utils" with "use ocn_utils" + - ocn_mpicom now passed in as argument and used to initialize ocn communicator + group, masterproc, iam and npes + M ocn/dom/ocn_comp_mct.F90 + - ocn_mpicom now passed in as argument + - replaced call to module routine seq_init_SetgsMap with call to mct routine + mct_gsMap_init in order to initialize gsmap + + M ocn/som/mixed_layer.F90 + - replace "use mpishorthand" with "use ocn_utils" + - made explicit calls to mpi_bcast rather than the interfaces in mpishorthand + M ocn/som/ocn_comp.F90 + - replace "use spmd_utils" with "use ocn_utils" + - ocn_mpicom now passed in as argument and used to initialize ocn communicator + group, masterproc, iam and npes + - fixed bug in conservation check equation (this is turned off in all tests) + ocn_in(c)%netfocn replaced with ocn_in(c)%melth + M ocn/som/somini.F90 + - replace "use mpishorthand" with "use ocn_utils" + - made explicit calls to mpi_bcast rather than the interfaces in mpishorthand + M ocn/som/ocn_comp_mct.F90 + - ocn_mpicom now passed in as argument + - replaced call to module routine seq_init_SetgsMap with call to mct routine + mct_gsMap_init in order to initialize gsmap + + M ice/csim4/ice_data.F90 + - replace "use spmd_utils" with "use ice_utils" + - made explicit calls to mpi_bcast rather than the interfaces in mpishorthand + M ice/csim4/print_coverage.F90 + - replace "use spmd_utils" with "use ice_utils" + M ice/csim4/ice_comp.F90 + - replace "use spmd_utils" with "use ice_utils" + - made explicit calls to mpi_bcast rather than the interfaces in mpishorthand + M ice/csim4/ice_comp_mct.F90 + - added ICEID and mpicom_ice to input arguments + - replaced call to module routine seq_init_SetgsMap with call to mct routine + mct_gsMap_init in order to initialize gsmap + + M atm/cam/tools/scam/scm_init/init_model.F90 + - put in changes analogous to those in seq_ccsm_drv.F90 + M atm/cam/tools/scam/scm_init/scam_run.F90 + - separated calls to ocn_run_mct and atm/ocn flux calculation into two separate blocks + M atm/cam/tools/scam/scm_init/scamMod.F90 + - added dtime_out as argument to scam_clm_default_opts (see clm notes below + + M atm/cam/src/control/con_cam.F90 + - removed call to cam_init2 (call to cam_init1 now is call to cam_init) + - removed call to spmdinit + - mpicom now passed as argument to cam_init + M atm/cam/src/control/atm_comp_mct.F90 + M atm/cam/src/control/cam_comp.F90 + - removed cam_init2 and replaced cam_init1 with cam_init + - call to intht is now done on first call of cam_comp + M atm/cam/src/utils/spmd_utils.F90 + - no longer calls mpi_init when COUP_CSM ins not defined + - removed code-block for if-defined IRIX (no longer needed) + - mpicom_atm passed as now as argument + M atm/cam/src/utils/time_manager.F90 + - removed module variables perpetual_ymd and perpetual_run (no longer needed) + + M SVN_EXTERNAL_DIRECTORIES + - now using clm3_expa_73 + - clm3_expa_73 no longer uses the cam time manager and as a result dtime needs to be + specified explicitly in the clm namelist + - clm3_expa_73 also no longer obtains irad from the call to the cam routine radiation_get + as a result bugzilla #228 has been added + + M drv/seq_mct_drv/seq_ccsm_drv.F90 + - removed call to atm_init2 + - mpi now initialized in seq_ccsm_drv.F90 rather than in the cam routine spmdinit + - currently it is assumed that cam and all the surface components will utilize the global + communicator group + - mpicom_glob now passed as an argument to cam and the surface components + - replaced calls to mrg_x2*_alloc_mct with mrg_x2*_init_mct, and removed the original calls + to mrg_x2* + + M drv/seq_mct/seq_init_mct.F90 + - now calls mpi_init (rather than in cam routine spmdinit) + - removed routine seq_init_setgsmap (see above) + M drv/seq_mct/seq_domain_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + - removed explicit setting of mpicom=1 when SPMD is not defined + M drv/seq_mct/seq_flux_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + - removed explicit setting of mpicom=1 when SPMD is not defined + M drv/seq_mct/mrg_x2a_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + - replaced hard-wired copies for each field with mct call to mct_aVect_copy. + M drv/seq_mct/mrg_x2i_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + all common attribute vector components from one attribute vector to another. + - replaced hard-wired copies for each field with mct call to mct_aVect_copy (only + rain and snow are now hard-wired in the copy command). mct_aVect_copy will copy + - removed explicit setting of mpicom=1 when SPMD is not defined + M drv/seq_mct/mrg_x2l_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + - removed explicit setting of mpicom=1 when SPMD is not defined + - replaced hard-wired copies for each field with mct call to mct_aVect_copy. + M drv/seq_mct/mrg_x2o_mct.F90 + - replaced "use mpishorthand" with "use seq_comunicator" + - removed explicit setting of mpicom=1 when SPMD is not defined + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: ALL PASS +tempest: ALL PASS +bangkok/lf95: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_3_30 +Originator(s): Jim Edwards + Pat Worley (phys_grid) +Date: 09-21-2006 +One-line Summary: homme dycore development + +Purpose of changes: homme dycore development + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: added build for bluegene + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Edwards, Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: added dynamics/homme/external + +List all existing files that have been modified, and describe the changes: + + Improved documentation for creating initial and boundary files + for the homme dycore +M models/atm/cam/tools/interpic_new/README + + Added support for bluegene system at NCAR (frost) + and improved support for homme dycore. +M models/atm/cam/bld/configure +M models/atm/cam/bld/Makefile.in +M models/atm/cam/bld/namelist.pm +A + models/atm/cam/bld/filter_nl.pm +M models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +M models/atm/cam/bld/system_defaults.xml +A + models/atm/cam/bld/DefaultCTL_NL_Namelist.xml +M models/atm/cam/bld/cam_inparm.pm +M models/atm/cam/bld/resolution_parameters.xml +A + models/atm/cam/bld/ctl_nl.pm +M models/atm/cam/bld/config_cam_homme_defaults.xml +M models/atm/cam/bld/SeqCCSM_namelist.pm +A + models/atm/cam/bld/DefaultFILTER_NL_Namelist.xml + + Improved the interface that allows reading multiple namelists from multiple source code files. + Fixed a problem with the dyn_grid -> phys_grid mapping apparent in the homme dycore. + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/con_cam.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/control/cam_history.F90 +M models/atm/cam/src/physics/cam1/boundarydata.F90 +M models/atm/cam/src/physics/cam1/physpkg.F90 +M models/atm/cam/src/physics/cam1/phys_grid.F90 +M models/atm/cam/src/physics/cam1/cldwat.F90 +M models/atm/cam/src/dynamics/fv/inital.F90 + +Continued development of the homme dycore: the external directory represents a + mirror of the files in repository + https://svn-homme-model.cgd.ucar.edu/trunk/src/share + +A + models/atm/cam/src/dynamics/homme/external +A + models/atm/cam/src/dynamics/homme/external/flops_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/filter_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/math_constants.F90 +A + models/atm/cam/src/dynamics/homme/external/forcing_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/stats.h +A + models/atm/cam/src/dynamics/homme/external/preq_init_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/interface.h +A + models/atm/cam/src/dynamics/homme/external/schedule_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/reduction_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/parallel_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/spacecurve_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/utils_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/derivative_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_state_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/dimensions_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/locate.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_restart_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/torus_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/quadrature_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/coordinate_systems_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/global_norms_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/control_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/element_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/time_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_si_ref_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/stats.F90 +A + models/atm/cam/src/dynamics/homme/external/hybvcoord_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/checksum_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_advection_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/directions.F90 +A + models/atm/cam/src/dynamics/homme/external/thread_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/dof_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/physical_constants.F90 +A + models/atm/cam/src/dynamics/homme/external/kinds.F90 +A + models/atm/cam/src/dynamics/homme/external/solver_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/restart_io_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/namelist_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/perfmodel_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/bndry_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/metis_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/params_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/field_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/diffusion_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/mass_matrix_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_advance_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/cg_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/prim_si_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/types_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/domain_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/gridgraph_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/metagraph_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/generic_list.F90 +A + models/atm/cam/src/dynamics/homme/external/ref_state_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/vertex_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/cube_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/physics_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/rotation_init.F90 +A + models/atm/cam/src/dynamics/homme/external/interpolate_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/linear_algebra_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/baroclinic_inst_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/edge_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/ll_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/vertical_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/timer.h +A + models/atm/cam/src/dynamics/homme/external/timer_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/state_mod.F90 +A + models/atm/cam/src/dynamics/homme/external/hybrid_mod.F90 +A + models/atm/cam/src/dynamics/homme/io_dist.F90 +M models/atm/cam/src/dynamics/homme/dyn_grid.F90 +M models/atm/cam/src/dynamics/homme/dp_coupling.F90 +M models/atm/cam/src/dynamics/homme/dyn_comp.F90 +M models/atm/cam/src/dynamics/homme/inidat.F90 +M models/atm/cam/src/dynamics/homme/stepon.F90 +M models/atm/cam/src/dynamics/homme/spmd_dyn.F90 +M models/atm/cam/src/dynamics/homme/inital.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: passed + +tempest: passed + +bangkok/lf95: passed + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_28 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_3_29 +Originator(s): jwolfe, eaton +Date: Wed Sep 20 17:08:08 MDT 2006 +One-line Summary: fix for single executable CCSM + +Purpose of changes: fix for single executable CCSM + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +In con_cam.F90 change this: + +#ifdef SINGLE_EXEC + call MPH_get_argument("THREADS", nthreads, "atm") + call OMP_SET_NUM_THREADS(nthreads) +#endif + +to this: + +#ifdef SINGLE_EXEC + call MPH_get_argument("THREADS", nThreads, "atm") +#ifdef _OPENMP + call OMP_SET_NUM_THREADS(nThreads) +#endif +#endif + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: not done + +tempest: not done + +bangkok/lf95: not done + +Tests not done because this change is inside an ifdef that isn't turned on +for any of CAM's current regression tests. + +=============================================================== +=============================================================== + +Tag name: cam3_3_28 +Originator(s): mvr, jwolfe +Date: 060914 +One-line Summary: implemented last remaining items needed for cam to +be included in a ccsm single-executable; bug fix to enable scam to compile + +Purpose of changes: ccsm single-executable required a few more mods, +including one name conflict that was overlooked; a compile-time bug was +introduced to the scam build in cam3_3_27 + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton, mvertens + +List all subroutines eliminated: +D models/atm/cam/src/physics/cam1/diagnostics.F90 +- just a rename required to clear up name conflict in ccsm single-executable + +List all subroutines added and what they do: +A + models/atm/cam/src/physics/cam1/cam_diagnostics.F90 +- newly named file and mods to clear up name conflict in ccsm single-executable + +List all existing files that have been modified, and describe the changes: +M models/ice/csim4/ice_comp.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/con_cam.F90 +M models/atm/cam/src/physics/cam1/tphysbc.F90 +M models/atm/cam/src/physics/cam1/physpkg.F90 +- files modified to reflect name change: diagnostics -> cam_diagnostics + +M models/atm/cam/tools/scam/scm_init/init_model.F90 +- bug fix to enable scam to compile + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +ALL PASS + +tempest: +ALL PASS + +bangkok/lf95: +ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_27 +Originator(s): mvertens +Date: Mon Sep 11 21:44:10 MDT 2006 +One-line Summary: moved atm/ocn flux calculation to top level + +Purpose of changes: + +Moved the atmosphere/ocean flux calculation out of the ocn (dom/som) +models and up to the top level driver. This is a necessary stop in constructing +a sequential ccsm system. It will also enable the use of the cpl6 atm/ocn flux +calculation to be utilized in both the sequential and concurrent system. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Probably none (this should be checked) + +Code reviewed by: eaton, erik (briefly) + +List all subroutines eliminated: + + D ocn/dom/albocean.F90 + - calculation now done in seq_flux_mct.F90 (see below) + D ocn/dom/print_coverage.F90 + - not used by any code in dom/ + D ocn/dom/parpbl.h + - only used in flxoce.F90 - which is no longer utilized + D ocn/dom/albedo.h + - not used by any code in dom/ + D ocn/dom/wtrc_flxoce.F90 + - moved to atm/cam/src/control + D ocn/dom/flxoce.F90 + - replaced by flux_ao routine (see below) + D ocn/dom/srfoce.F90 + - see below + + D ocn/som/albocean.F90 + - calculation now done in seq_flux_mct.F90 (see below) + D ocn/som/mixed_layer_globalcalcs.F90 + D ocn/som/ocn_srf.F90 + - ocn_srf.F90 and mixed_layer_globalcalcs.F90 merged into mixed_layer.F90 + D ocn/som/parpbl.h + - only used in flxoce.F90 - which is no longer utilized + D ocn/som/flxoce.F90 + - replaced by flux_ao routine (see below) + +List all subroutines added and what they do: + + A ocn/som/mixed_layer.F90 + - merge of mixed_layer_globalcalcs.F90 and ocn_srf.F90 + + A atm/cam/src/control/wtrc_flxoce.F90 + - moved computation of water tracer exchange from ocean into atmospheric code base + to reduce number of fields that need to be exchanged between ocean and atmosphere + + A drv/seq_mct/seq_flux_mct.F90 + A drv/seq_mct/flux_ao.F90 + - performs calculation previously done in dom/flxocn.F90 and som/flxocn.F90 + - also calculates ocean albedo and net shortwace absorbed by surface + +List all existing files that have been modified, and describe the changes: + + M ocn/dom/sst_data.F90 + M ocn/dom/ocn_types.F90 + M ocn/dom/ocn_comp.F90 + M ocn/dom/ocn_comp_mct.F90 + - see below + + M ocn/som/ocn_types.F90 + M ocn/som/ocn_comp.F90 + M ocn/som/ocn_comp_mct.F90 + - see below + + M atm/cam/tools/scam/scm_init/init_model.F90 + M atm/cam/tools/scam/scm_init/scam_srfdata_MCT.F90 + M atm/cam/tools/scam/scm_init/scam_run.F90 + - put in changes to incorporate xao_o and xao_a along with calls to ocean/atmosphere + flux calculation from top level driver + + M atm/cam/src/control/ccsm_msg.F90 + M atm/cam/src/control/camsrfexch_types.F90 + - added "rho, netsw, ustar, re, ssq" as cam_out components in camsrfexch_types.F90 + M atm/cam/src/control/srfxfer.F90 + - removed rho and netsw as module variables in ccsm_msg.F90 + M atm/cam/src/control/atm_comp_mct.F90 + - introduced call to wtrc_flxoce if trace_water is true + - replace call to atm_init1_mct with atm_init_mct + - added ustar, re and ssq to x1a_a input + + M drv/seq_flds/dust/seq_flds_mod.F90 + M drv/seq_flds/default/seq_flds_mod.F90 + M drv/seq_flds/gensom/seq_flds_mod.F90 + - see below + + M drv/seq_mct_drv/seq_ccsm_drv.F90 + M drv/seq_mct/mrg_x2a_mct.F90 + - replaced o2x_a components that are now calculated in seq_flux_mct with xao_a components + M drv/seq_mct/mrg_x2i_mct.F90 + - removed index_o2x_So_tsocn from o2x_i and x2i_i + M drv/seq_mct/mrg_x2o_mct.F90 + - removed unnecessary a2x_o (this is now utilized in atm/ocn flux calculatin in seq_flux_mct) + M drv/seq_flds_indices/seq_flds_indices.F90 + - put in changes necessary for new atm/ocn flux computation at top level (see below) + + Summary: New attribute vectors xao_o and xao_a were introduced at the top level + to account for the calculation of the atm/ocn flux calculation. + + The routines dom/srfoce.F90, dom/flxoce.F90 and som/flxoce.F90 were replaced with + drv/seq_mct/flux_ao.F90 and drv/seq_mct/seq_flux_mct.F90. + The current form of flx_ao.F90 is such that it can be replaced with + the equivalent coupler code once sign conventions are addressed. (Note, + to increase clarity som/ocn_srf.F90 and som/mixed_layer_globalcalcs.F90 were + merged to create som/mixed_layer.F90). + + The ocean albedo calculation was also moved out of the ocean code and + put into seq_flux_mct.F90. As a result, ocn/som/albocean.F90 and + ocn/dom/albedo.h are no longer needed). The new routine to calculate ocean albedos, + seq_flux_albo_mct, is now contained in seq_flux_mct.F90. + + Ocean input information was significantly altered as a result of bringing the atm/ocn + flux calculation out of the ocean code base. The CAM DOM code now does not need any + input information. The CAM SOM code also requires significantly less input information + (only netsw from the atmosphere). + + It is important to note that lwup is still being computed in the ocean code. The + impact on SOM needs to be evaluated when moving this calculation to the + atm/ocean flux routine (as is done in the cpl6 code). + + The routine, wtrc_flxoce.F90 (isotope calculation) was moved out of the ocean model + and into atm/cam/src/control. The extra fields necessary to do this + computation (ustar, re, ssq) were added to the x2a attribute vector. + Note that this feature is currently not tested. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: ALL PASSED +tempest: ALL PASSED +bangkok/lf95: ALL PASSED except for + 012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 + 028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 + 040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + - the above difference appear to be roundoff errors that set in very early + - note that all other tests (including on all other platforms) produced bfb + baseline comparisons + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE +=============================================================== +=============================================================== + +Tag name: cam3_3_26 +Originator(s): mvertens +Date: Sun Sep 10 20:22:42 MDT 2006 +One-line Summary: Changes necessary for moving atm/ocn flux calc to top level + +Purpose of changes: + +Incorporated changes necessary to move the atm/ocn flux calculation out of the dom/som +ocean code and into the top level application driver. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: eaton + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M ocn/dom/ocn_comp.F90 + - Moved update of ocean temperature to after calculation of ocean surface/fluxes + This was done to be consistent with SOM update and to be able to move the atm/ocean + surface flux calculation to the top level driver without introducint cpp ifdefs. + This change also required writing the surface temperature to the ocean restart file. + This modification will result in greater than round-off level differences with cam3_3_25. + - removed the call to sstan and made the conversion from degees K to C explicit + + M ice/csim4/ice_types.F90 + M ice/csim4/ice_comp.F90 + M ice/csim4/ice_diagnostics.F + - Removed "precsc, precsl, precc, precl" as ice_in types and replaced them with "snow" + since only snow is needed as input to csim. This change should only result in round-off + level differences with cam3_3_25. + M ice/csim4/ice_comp_mct.F90 + - In addition to only using "snow" as input from the application driver, also removed + x2i_i%rAttr(index_x2i_So_tsocn,g) as input and instead used + x2i_i%rAttr(index_x2i_So_t,g)-SHR_CONST_TKFRZ. This change should only result in + round-off level differences with cam3_3_25. + + M drv/seq_flds/dust/seq_flds_mod.F90 + M drv/seq_flds/default/seq_flds_mod.F90 + M drv/seq_flds/gensom/seq_flds_mod.F90 + M drv/seq_mct/mrg_x2i_mct.F90 + M drv/seq_flds_indices/seq_flds_indices.F90 + - replaced 'Faxa_rainc', Faxa_rainl','Faxa_snowc','Faxa_snowl' as input to ice + with 'Faxa_rain' and :Faxa_snow' + + M drv/seq_mct/mrg_x2a_mct.F90 + - Removed calculation of ts for non-fractional grid box + This makes the merge consistent with that done in cpl6. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All tests passed (no baseline compare was done) +tempest: All tests passed (no baseline compare was done) +bangkok/lf95: All tests passed (no baseline compare was done) + +Summarize any changes to answers, i.e., +- what code configurations: see above +- what platforms/compilers: effects all platforms +- nature of change: larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +- source tag (all code used must be in the repository): cam3_3_26 +- platform/compilers: bluesky + +- configure commandline: +configure -ocn dom -dyn fv -spmd -smp -test -res 4x5 + +- build-namelist command (or complete namelist): +&ccsm_inparm + case_name = 'cam3_3_24_fluxao_fv4x5dom' + start_type = "continue" +/ +&timemgr_inparm + atm_cpl_dt = 1800 + orb_iyear_ad = 1950 + restart_option = 'monthly' + start_ymd = 10101 + stop_n = 720 + stop_option = 'ndays' +/ +&cam_inparm + dtime = 1800 + absems_data = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' + aeroptics = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' + bnd_topo = '/fis/cgd/cseg/csm/inputdata/atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc' + bndtvaer = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolMass_V_4x5_clim_c031022.nc' + bndtvo = '/fis/cgd/cseg/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' + bndtvs = '/fis/cgd/cseg/csm/inputdata/atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c030228.nc' + ncdata = '/fis/cgd/cseg/csm/inputdata/atm/cam/inic/fv/cami_0001-01-01_4x5_L26_c060608.nc' +/ +&clm_inparm + fpftcon = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' + fsurdat = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_4x5_c050523.nc' +/ + +- MSS location of output: +/MVERTENS/csm/cam3_3_24_fluxao_fv4x5dom/hist (cam3_3_24+ current mods) + +MSS location of control simulations used to validate new climate: +/MVERTENS/csm/cam3_3_24_fluxao_fv4x5dom_0/hist (cam3_3_24) + +URL for AMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/cms/rneale/runs/cam/cam3_3_24_fluxao_fv4x5dom-cam3_3_24_fluxao_fv4x5dom_0/ + +=============================================================== +=============================================================== + +Tag name: cam3_3_25 +Originator(s): eaton +Date: Tue Sep 5 08:53:01 MDT 2006 +One-line Summary: add spun-up CLM initial files + +Purpose of changes: + +. add spun-up CLM initial files for FV 1.9x2.5. There are files for both + 0000-01-01 and 0000-09-01 + +. Fixed syntax of some attributes in the default XML files. XML requires + that attribute values are quoted, and there were unquoted values in the + files. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +. add spun-up CLM initial files for FV 1.9x2.5. There are files for both + 0000-01-01 and 0000-09-01 + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +. models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +. models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_3_24 +Originator(s): mvr, jwolfe +Date: 060830 +One-line Summary: mods to eliminate naming conflicts in the ccsm +single executable; increased max fields for history tapes; +minor test driver enhancements + +Purpose of changes: the move to a single executable for running +cam as part of ccsm introduced some naming conflicts that needed +to be resolved; running cam in ccsm and turning on the chemistry +and co2 blew out the maximum allowed fields on a history tape + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton + +List all subroutines eliminated: +D models/atm/cam/src/control/history.F90 +- renamed due to conflict in the ccsm single executable + +List all subroutines added and what they do: +A + models/atm/cam/src/control/cam_history.F90 +- newly named to work with the ccsm single executable +- also modified the maximum number of fields allowed on history tapes + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +- modified to use resource settings returned from ccsm scripts +- ccsm tests now use default queue on phoenix + +M models/atm/cam/test/system/test_driver.sh +- machine calgary now supported by test driver; +- increased wall clock limit for default testing on bluevista + +M models/atm/cam/test/system/CAM_runcmnd.sh +- added code in support of machine calgary + +M models/ocn/dom/ocn_comp.F90 +M models/ocn/som/ocn_srf.F90 +M models/ocn/som/ocn_comp.F90 +M models/ice/csim4/ice_srf.F90 +M models/ice/csim4/ice_comp.F90 +M models/atm/cam/tools/scam/scm_init/init_model.F90 +M models/atm/cam/tools/scam/scm_init/forecast.F90 +M models/atm/cam/src/control/history_defaults.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/srfxfer.F90 +M models/atm/cam/src/control/restart.F90 +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/atm/cam/src/control/filenames.F90 +M models/atm/cam/src/control/history_scam.F90 +M models/atm/cam/src/control/cam_comp.F90 +M models/atm/cam/src/utils/time_manager.F90 +M models/atm/cam/src/physics/cam1/seasalt_intr.F90 +M models/atm/cam/src/physics/cam1/tphysidl.F90 +M models/atm/cam/src/physics/cam1/progseasalts_intr.F90 +M models/atm/cam/src/physics/cam1/tracers.F90 +M models/atm/cam/src/physics/cam1/param_cldoptics.F90 +M models/atm/cam/src/physics/cam1/diagnostics.F90 +M models/atm/cam/src/physics/cam1/radiation.F90 +M models/atm/cam/src/physics/cam1/dust_intr.F90 +M models/atm/cam/src/physics/cam1/tphysbc.F90 +M models/atm/cam/src/physics/cam1/aerosol_radiation_interface.F90 +M models/atm/cam/src/physics/cam1/radsw.F90 +M models/atm/cam/src/physics/cam1/check_energy.F90 +M models/atm/cam/src/physics/cam1/stratiform.F90 +M models/atm/cam/src/physics/cam1/water_tracers.F90 +M models/atm/cam/src/physics/cam1/radlw.F90 +M models/atm/cam/src/physics/cam1/ozone_data.F90 +M models/atm/cam/src/physics/cam1/physpkg.F90 +M models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +M models/atm/cam/src/physics/cam1/convect_shallow.F90 +M models/atm/cam/src/physics/cam1/convect_deep.F90 +M models/atm/cam/src/physics/cam1/carbon_intr.F90 +M models/atm/cam/src/physics/cam1/sulchem.F90 +M models/atm/cam/src/physics/cam1/co2_cycle.F90 +M models/atm/cam/src/physics/cam1/chemistry.F90 +M models/atm/cam/src/physics/cam1/gw_drag.F90 +M models/atm/cam/src/physics/cam1/sulemis.F90 +M models/atm/cam/src/physics/cam1/aerosol_intr.F90 +M models/atm/cam/src/physics/cam1/cloudsimulator.F90 +M models/atm/cam/src/physics/cam1/zm_conv.F90 +M models/atm/cam/src/physics/cam1/sulfur_intr.F90 +M models/atm/cam/src/physics/cam1/constituent_burden.F90 +M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 +M models/atm/cam/src/physics/waccm/iondrag.F90 +M models/atm/cam/src/physics/waccm/tracers.F90 +M models/atm/cam/src/physics/waccm/nlte_lw.F90 +M models/atm/cam/src/physics/waccm/chemistry.F90 +M models/atm/cam/src/physics/waccm/ctem.F90 +M models/atm/cam/src/physics/waccm/radheat.F90 +M models/atm/cam/src/physics/waccm/gw_drag.F90 +M models/atm/cam/src/physics/waccm/tgcm_forcing.F90 +M models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 +M models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 +M models/atm/cam/src/chemistry/trop_mozart/mo_aerosols.F90 +M models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +M models/atm/cam/src/chemistry/trop_mozart/mo_seasalt.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_aero_settling.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_airglow.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_jlong.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_setext.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_photo.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_jshort.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_cph.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_chm_diags.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_aurora.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_apex.F90 +M models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 +M models/atm/cam/src/chemistry/waccm_mozart/iondrag.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_hrates.F90 +M models/atm/cam/src/chemistry/waccm_mozart/mo_jeuv.F90 +M models/atm/cam/src/chemistry/waccm_mozart/exbdrift.F90 +M models/atm/cam/src/dynamics/sld/spegrd.F90 +M models/atm/cam/src/dynamics/sld/linemsdyn.F90 +M models/atm/cam/src/dynamics/sld/dyn_comp.F90 +M models/atm/cam/src/dynamics/sld/diag_dynvar_ic.F90 +M models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/eul/spegrd.F90 +M models/atm/cam/src/dynamics/eul/linemsdyn.F90 +M models/atm/cam/src/dynamics/eul/dyn_comp.F90 +M models/atm/cam/src/dynamics/eul/diag_dynvar_ic.F90 +M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 +M models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 +M models/atm/cam/src/dynamics/fv/uv3s_update.F90 +- mods to eliminate naming conflicts when used in the ccsm single executable: + (mods included 'use' statements, documentation, and whitespace formatting) + subroutine write_restart -> cam_write_restart + subroutine read_restart -> cam_read_restart + module history -> cam_history + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +ALL PASS +tempest: +ALL PASS +bangkok/lf95: +ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_23 +Originator(s): eaton +Date: Sun Aug 27 14:17:37 MDT 2006 +One-line Summary: fix some intent attributes in various high level interfaces + +Purpose of changes: + +. Some of the intents for derived types that contain pointer components are + wrong in the FV interface routines. In this situation the intent refers to + the association status of the pointer, not to the target of the pointer. + Fix these intents in fv/stepon.F90 and fv/dyn_comp.F90. + +. cam_run1 has args cam_in and cam_out declared intent(inout). Most of the + components of these user defined types are arrays of length pcols, but + we're adding components that are pointers, and probably all the + components should be pointers. Since for pointer components the + intent(inout) doesn't make sense, and for non-pointer components it's the + default, this intent has been removed. Also switched the order of these + args to match the convention of listing input args first. + +. replace the variables surface_state2d and srfflx_state2d by cam_out and + cam_in respectively in physpkg. There are alot of other places where + this still needs to happen. + +. utils/timing/f_wrappers.c was missing the header file string.h. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + models/utils/timing/f_wrappers.c + . add missing include of string.h + + models/atm/cam/src/dynamics/fv/stepon.F90 + . remove the intent(out) attributes of dummy args dyn_in and dyn_out in + both stepon_init and stepon_run1. That intent + implies that the pointer components should be associated in this + routine. But the pointers were previously associated in + dyn_create_interface and the targets are what is being set here. + + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + . remove the intent(inout) attributes of dummy args dyn_in and dyn_out in + dyn_run + + models/atm/cam/src/control/cam_comp.F90 + . remove the intent(inout) attribute of args cam_in and cam_out in + cam_run1 interface. Also switched the order of these + args to match the convention of listing input args first. + . order actual args (.., cam_in, cam_out) in call to phys_run1 + + models/atm/cam/src/control/con_cam.F90 + . switch order of actual args in call to cam_run1 + + models/atm/cam/src/control/atm_comp_mct.F90 + . switch order of actual args in call to cam_run1 + + models/atm/cam/src/physics/cam1/physpkg.F90 + . replace surface_state2d by cam_out and replace srfflx_state2d by cam_in + . order dummy args (.., cam_in, cam_out) in definition of phys_run1 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_3_22 +Originator(s): erik +Date: Fri Aug 18 10:18:32 MDT 2006 +One-line Summary: fix restart_option=end, get_perp_date bugs + +Purpose of changes: + +Bugs fixed (include bugzilla ID): 107, 185 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M cam/test/unit/control/run_time_test + Add tests for perpetual case and other restart_options +M atm/cam/test/unit/control/test_time.F90 + Add tests for perpetual case and other restart_options +M atm/cam/src/utils/time_manager.F90 + Add ability to use offset optional argument for get_perp_date + +Externals updated: + + csm_share to share3_060814 + clm2 to clm3_expa_69 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam3_3_21 +Originator(s): eaton, klindsay, mirin +Date: 2006-08-17 +One-line Summary: Update icesst tools; add column burden diags; FV fixes/cleanup. + +Purpose of changes: + +. Update the icesst tool to recognize the new datasets being provided by + Dennis Shea. These have a CF-conforming time coordinate and the date + information in YYYYMMDD format is moved to a new date variable. + Also needed to change some fixed sizes in bcgen/solver.f90 to allow for + the new datasets starting from 1870 rather than 1949. + +. Add hist_fld_active query function to history.F90. Returns whether or + not a field is active on any history file. This enables the ability to + not perform expensive diagnostic calculations if they aren't being asked + for in the history output. (Contributed by Keith Lindsay.) + +. Add column burden diagnostics for all constituents except water vapor. + These are not put on the history tapes by default. The names of the + output variables are of the form 'TM'//cnst_name. Not enabled for SCAM. + (Contributed by Keith Lindsay.) + +. Add modcomm_gatscat to namelist (bugfix); fix defaults for some modcomm + options; cleanup of comments. (Contributed by Art Mirin.) + +Bugs fixed (include bugzilla ID): + +. Add modcomm_gatscat to namelist + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. Add modcomm_gatscat to namelist + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + + models/atm/cam/tools/icesst/README.bfb + +List all subroutines added and what they do: + +. column burden diagnostics for all constituents except water vapor + models/atm/cam/src/physics/cam1/constituent_burden.F90 + +List all existing files that have been modified, and describe the changes: + +. enable icesst tools to read new input datasets + models/atm/cam/tools/icesst/README + models/atm/cam/tools/icesst/bcgen/solver.f90 + models/atm/cam/tools/icesst/regrid/regrid.f90 + models/atm/cam/tools/icesst/regrid/wrap_nf.f90 + +. add column burden diagnostics + models/atm/cam/src/physics/cam1/diagnostics.F90 + +. add new query function to history + models/atm/cam/src/control/history.F90 + +. FV and modcomm bugfixes and cleanup + models/atm/cam/src/control/runtime_opts.F90 + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + models/utils/pilgrim/mod_comm.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NONE + +=============================================================== +=============================================================== + +Tag name: cam3_3_20 +Originator(s): erik +Date: Wed Aug 16 09:34:33 MDT 2006 +On-line Summary: Fix bugs from cam3_3_15 for working on phoenix + +Purpose of changes: Changes needed for CCSM to work on phoenix. + +Bugs fixed (include bugzilla ID): 204 and 205 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, jwolfe + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/test/unit/control/run_time_test + Remove old style namelists for comparision, add netcdf directories + explicitly for bangkok. +M models/atm/cam/src/control/con_cam.F90 + Move start of timers to earlier in program. +M models/SVN_EXTERNAL_DIRECTORIES + Update to share3_060814. Fixes problem in shr_file_mod for phoenix. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all tests pass + +tempest: all tests pass + +bangkok/lf95: all tests pass + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam3_3_19 +Originator(s): Jim Edwards (homme, history, phys_grid), + Rory Kelly (homme), + Pat Worley (phys_grid) +Date: 8-14-2006 +One-line Summary: Moved dynamic core specific functions from history + to specific cores. + +Purpose of changes: Continuing work on general dynamics/physics API + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Originators, Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + The dynamics fields that were previously added to the history output from + the history_defaults file have been moved to dyn_init so that each dycore + is responsible for declaring the fields for which outfld calls will be made + using the dynamics decomposition. + + Moving addfld calls into dyn_init created a circular dependency, i.e., + + dyn_comp -> history -> io_dist -> dyn_comp + + io_dist uses dyn_state (in dyn_comp) to access the decomposition info + needed for gathers. We broke the chain by putting dyn_state in a separate + module, i.e., + + dyn_comp -> history -> io_dist -> dyn_internal_state + + Another side effect of moving addfld calls into dyn_init was to require + moving the setting of the dyngrid_set variable (and give it the more + appropriate name dyndecomp_set) to a place in front of these calls. It was + previously being set in initcom which is after the dyn_init call. It + should be set as soon as the parameters that determine the dynamics + decomposition are known. It can probably still be set earlier than it is + currently. + + The gather/scatter methods in phys_grid have been modified to work when the + global field is on either a lat/lon grid or an unstructured grid. + (Contributed by Pat Worley.) + + The wrapper routines in wrap_nf have been moved into a module. This + provides interface checking for these routines. + + More work has been done to the dycore interface for HOMME in the + dynamics/homme directory. This work is still in progress. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all tests pass + +tempest: all tests pass + +bangkok/lf95: all tests pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_18 +Originator(s): bundy (Dani Bundy Coleman) +Date: Aug 11 2006 +One-line Summary: Fix and improve prognostic aerosol packages + +Purpose of changes: Some of the existing prognostic aerosol packages +did not function out-of-the-box. Furthermore, the dust package was +outdated, the sea salt was actually diagnostic and the carbon +offered only one simple scenerio. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: +Added configure option for prognostic aerosol packages + -prog_aero sulfur,caer4,caer16,dust,seasalt +Invoke with comma-separated list of any combination of the above. +This adds the correct number of advected constituents to the build and +defines cpp tokens required for dust, seasalt and the new 16-constituent +carbon aerosol package. + +Describe any changes made to the namelist: +The configure option for prognostic aerosols is used by build-namelist to + set namelist variables related to the aerosol packages. +Added namelist variables to control implementation & feedback of dust & sea salt. + aero_progsslt + Set to .TRUE. to turn on prognostic seal salt aerosols + should be set by build-namelist, as needs cppdefs too + aero_feedback_progsslt + Set to .TRUE. to enable feedback of prognostic sea salt + aerosols. NOT YET IMPLEMENTED + aero_dust + Set to .TRUE. to turn on dust prognostic aerosols + should be set by build-namelist, as needs cppdefs too + aero_feedback_dust + Set to .TRUE. to enable feedback of dust + prognostic aerosols. + +To avoid confusion with the existing co_emis_file namelist variable, + renamed emissions file for prognostic carbon aerosol: +OLD co_emis +NEW caer_emis + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none +When run without aerosols, there are no changes. + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: +models/atm/cam/src/physics/cam1/dust.F90 + module information moved to (existing) dust_intr.F90 + +List all subroutines added and what they do: +models/atm/cam/src/physics/cam1/progseasalts_intr.F90 + new module includes methods for registering, initializing, setting + indices, and calculating sinks of prognostic sea salt aerosol + progseasalts_register_cnst + progseasalts_init_cnst + set_progseasalts_idx + progseasalts_initialize + progseasalts_time_interp + ProgseasaltsDryDep +models/atm/cam/src/control/camsrfexch_types.F90 + hub2atm_setopts + called by dust.F90:dust_register_cnst to allocate ram1 & fv in srfflx_state +models/atm/cam/src/physics/cam1/aerosol_intr.F90 + aerosol_getopts ! get runtime options + +Also added +models/drv/seq_flds/dust +models/drv/seq_flds/dust/seq_flds_mod.F90 + add tokens for new exchange components in x2a and l2x strings + +List all existing files that have been modified, and describe the changes: + +M models/atm/cam/bld/CAM_config.pm + add AEROSOLS attribute + +M models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + changed co_emis to caer_emis + add caer_emis_16 + +M models/atm/cam/bld/cam_inparm.pm + Add AEROSOLS attribute to namelist object + Use settings from config_cache to set aero_carbon and caer_emis + All carbon surface emissions in caer_emis + Use config_cache to set prognostic_sulfur and prescribed_sulfur + Use config_cache to set soil_erod + +M models/atm/cam/bld/config_cam_eul_defaults.xml +M models/atm/cam/bld/config_cam_fv_defaults.xml +M models/atm/cam/bld/config_cam_homme_defaults.xml +M models/atm/cam/bld/config_cam_sld_defaults.xml +M models/atm/cam/bld/config_trop_chem_mozart_defaults.xml +M models/atm/cam/bld/config_waccm_ghg_defaults.xml +M models/atm/cam/bld/config_waccm_mozart_defaults.xml + add prog_aero to defaults xml files + +M models/atm/cam/bld/configure + add "-prog_aero " option + add consistency check for specified packages + increment nadv with the number of constituents in specified packages + +M models/atm/cam/src/control/atm_comp_mct.F90 + transfer fv, ram1 & dust fluxes if dust or progseasalt is running + +M models/atm/cam/src/control/camsrfexch_types.F90 + add ram1,fv to srfflx_state type definition + add subroutine hub2atm_setopts( aero_dust_in ) + called by dust.F90:dust_register_cnst + to allocate ram1 & fv pointers + +M models/atm/cam/src/control/runtime_opts.F90 + change namelist var co_emis to caer_emis + changed comments about sea salt to diagnostic + added namelist variables for prognostic sea salt & dust + +M models/atm/cam/src/physics/cam1/aer_optics.F90 + if prognostic dust is running, use different optics + +M models/atm/cam/src/physics/cam1/aerosol_intr.F90 + new subroutine aerosol_getopts to get run-time settings + add dust & progseasalt implementation & control flags + take out old ifdef DUSTs + initialize dry deposition module if any aerosol is running + generalize interfaces to carbon_intr + +M models/atm/cam/src/physics/cam1/caer.F90 + add new carbon aerosol scenario with 16 constituents + invoke with configure -prog_aero caer16 + +M models/atm/cam/src/physics/cam1/caerbnd.F90 + add new caer16 carbon emission scenario + +M models/atm/cam/src/physics/cam1/carbon_intr.F90 + generalize interface for both caer4 & caer16 packages + +D models/atm/cam/src/physics/cam1/dust.F90 + moved information into dust_intr.F90 + +M models/atm/cam/src/physics/cam1/dust_intr.F90 + move calcarm, d3ddflux subroutines to drydep_mod.F90 + moved dust.F90 information into dust_intr.F90 + +M models/atm/cam/src/physics/cam1/hk_conv.F90 + modify checks for small constituent values + causes roundoff diffs to any constituent with mixing ration < 1.e-300 + +M models/atm/cam/src/physics/cam1/physpkg.F90 + remove ram1, fv from comsrf + +A models/atm/cam/src/physics/cam1/progseasalts_intr.F90 + new module to handle prognostic sea salt aersols + +M models/atm/cam/src/physics/cam1/seasalt_intr.F90 + added method to return ixsslt + +M models/atm/cam/src/physics/cam1/sulchem.F90 + add wet deposition diagnostics to dummy args of chemwdepdr + +M models/atm/cam/src/physics/cam1/sulfur_intr.F90 + add SO4 wet deposition diagnostics to history (not default) + remove call to inidrydep (now down in aerosol_intr if any aerosol is running) + move outfld calls to sulfur_wet_intr from chemwdepdr + +M models/atm/cam/src/physics/cam1/tphysac.F90 + remove fv and ram1 dummy args (in srfflx_state2d?) + pass srfflx_state2d to aerosol_drydep_intr instead of its components + +M models/atm/cam/src/physics/cam1/wetdep.F90 + add optional args to wetdepa + +A models/drv/seq_flds/dust +A models/drv/seq_flds/dust/seq_flds_mod.F90 + added directory for configure-time dust options + add tokens for new exchange components in x2a and l2x strings + +M models/drv/seq_flds_indices/seq_flds_indices.F90 + add indices for fv, ram1, flxdst[1-4] in x2a, l2x sections (no ifdefs here) + +M models/drv/seq_mct/mrg_x2a_mct.F90 + copy from surface attribute vectors to atm attvec + +NOTE these land mods were checked into the clm trunk with clm3_expa_64 +M src/biogeochem/DUSTMod.F90 + OLD dmt_vma = 2.524e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + NEW dmt_vma = 3.500e-6_r8 ! [m] Mass median diameter analytic +M src/main/clm_atmlnd.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) +M src/main/lnd_comp_mct.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! + Round-off changes to chemistry constituents Np and N2p are caused + by a modification to the Hack shallow convection scheme + models/atm/cam/src/physics/cam1/hk_conv.F90 + +tempest: all PASS + +bangkok/lf95: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: waccm_mozart +- what platforms/compilers: bluesky tested, probably all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? cprnc output shows 2 diffs in an array of 218592 elements; +code change only operates on numbers less than 1.e-300 + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +=============================================================== + +Tag name: cam3_3_17 +Originator(s): mvr +Date: +One-line Summary: update to clm3_expa_66; work-around for bluevista +compiler bug; update to new pgi compiler and libs + +Purpose of changes: wanted to use new pgi compilers which meant an +update to clm tag with work-around for code the compilers didn't like; +new operating system on bluevista forced some mods in the build +system and test scripts + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +- removed noopt flag from compile and link commands in debug,smp mode + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: +- added spun-up CAM and CLM initial files for the FV 0.9x1.25 resolution. + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/TCT.ccsm.sh +- modified for ccsm test to work in new bluevista os + +M models/atm/cam/test/system/TBL.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TRX.sh +M models/atm/cam/test/system/TEQ.sh +- test scripts modified to do ALL output file comparisons, even if one fails + +M models/atm/cam/test/system/test_driver.sh +- modified for new bluevista os; updated bangkok libraries and 6.1-3 pgi compiler + +M models/atm/cam/tools/scam/ui/configure +- updated to link with pgi 6.1-3 libraries + +M models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml +- added spun-up CAM and CLM initial files for the FV 0.9x1.25 resolution. + +M models/atm/cam/bld/Makefile.in +- removed noopt flag from compile and link commands in debug,smp mode (work- + around for bluevista compiler bug) + +M models/atm/cam/bld/run-ibm.csh +- updated to work on bluevista as well as bluesky + +M models/atm/cam/bld/run-pc.csh +- updated bangkok libraries and 6.1-3 pgi compiler + +M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 +- bug fix for out-of-bounds array reference caught by pgi compiler + +M models/SVN_EXTERNAL_DIRECTORIES +- updated to new clm tag (clm3_expa_66) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 +008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 +010 bl133 TBL.sh e32pdh aqpgro 3 ..................................FAIL! rc= 7 +013 bl134 TBL.sh e32dh adia 9 .....................................FAIL! rc= 7 +019 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +027 bl334 TBL.sh f4dh adia 9 ......................................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 +044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 +047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 +049 bl533 TBL.sh s32pdh aqpgro 3 ..................................FAIL! rc= 7 +052 bl534 TBL.sh s32dh adia 9 .....................................FAIL! rc= 7 +055 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + +-all baseline tests in debug mode running omp fail due to removal of noopt flag +-ccsm test fails, but passes when using ccsm sandbox with upcoming mods + +tempest: +all PASS + +bangkok/lf95: +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 5 + +-these were deemed acceptable roundoff errors + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: non-debug +- what platforms/compilers: bangkok/lf95 +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? analysis of nstep0 differences + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam3_3_16 +Originator(s): Will Sawyer, Art Mirin +Date: Wed Jul 19 02:15:17 MDT 2006 +One-line Summary: + +Purpose of changes: Upgrade to newest pilgrim version; + streamlining of FV to remove unneeded allocations; + resynching FV dycore with that from GEOS5; + corrections in namelists for high resolution runs; + update of FV namelist options (removal of set_eta); + update of benergy to run with XY decomposition + +Bugs fixed (include bugzilla ID): (following have no bugzilla ID) + D-resolution runs on Phoenix (reported by Worley) + Conservative-mode bug (reported by Suarez in GEOS5) + Compilation bug tp_core.F90 (reported by Trayanov in GEOS5) + Tracer transpose bug on certain architectures (e.g. Linux) + with mod_method=1 (reported by Mirin, et al.) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + Removed use_eta (comctl) + Added dyn_conservative (comctl) + Changes to the names of Topo, SST and initial files for + 0.9x1.25 and 0.5x0.625 resolutions. + +List any changes to the defaults for the boundary datasets: + RESOLUTION="0.9x1.25">atm/cam/topo/USGS-gtopo30_0.9x1.25_remap_c051027.nc + RESOLUTION="0.5x0.625" >atm/cam/sst/sst_HadOIBl_bc_0.5x0.625_1949_2001_c040402.nc + +Describe any substantial timing or memory changes: + FV memory usage has decreased -- intermediate buffering of + tracers is being avoided. + +Code reviewed by: ourselves + +List all subroutines eliminated: + set_decomp, y_decomp (mod_comm) -- no longer used + create_vars, restore_vars, record_state, record_vars, + destroy_state, destroy_vars (dyn_comp) -- no longer used + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + +M models/utils/pilgrim/parutilitiesmodule.F90 + -- Changes to initialization routine to support revised mod_comm + -- Changed default communication method to mod_method=0 + -- MPI types only initialized for mod_method=1 + -- Updated documentation + +M models/utils/pilgrim/mod_comm.F90 + -- Extensive refactoring and updates to documentation + -- Dynamic allocation of buffers (minimalistic, local allocation) + -- Removal of mod_method=3 (MPI1) + +M models/atm/cam/bld/DefaultCLM_INPARM_Namelist.xml +M models/atm/cam/bld/DefaultCAM_INPARM_Namelist.xml + -- Changed default files for 0.9x1.25 and 0.5x0.625 resolutions. + +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/control/comctl.h + -- Added dyn_conservative, modcomm_gatscat + -- removed use_eta, tracertrans + +M models/atm/cam/src/physics/cam1/phys_grid.F90 + -- Changes to modmax_alltoall method (now method 13) + +M models/atm/cam/src/dynamics/sld/spmd_dyn.F90 +M models/atm/cam/src/dynamics/eul/spmd_dyn.F90 + -- Added dyn_conservative, modcomm_gatscat + -- removed use_eta, tracertrans + +M models/atm/cam/src/dynamics/fv/pmgrid.F90 + -- Added mod_gatscat method, default = 0 + +M models/atm/cam/src/dynamics/fv/benergy.F90 + -- Extensively rewritten to support XY decomposition (instead of YZ) + +M models/atm/cam/src/dynamics/fv/tp_core.F90 + -- Compilation bug fixed (reported by Trayanov in GEOS5) + +M models/atm/cam/src/dynamics/fv/par_xsum.F90 + -- Sequential execution bug fix, refactoring + +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/dryairm.F90 + -- Introduced T_TRACERS type for constituents + +M models/atm/cam/src/dynamics/fv/inidat.F90 + -- Introduced T_TRACERS type for constituents + -- T3 array has become i,j,k (was i,k,j) + +M models/atm/cam/src/dynamics/fv/dyn_comp.F90 + -- Introduced T_TRACERS type for constituents + -- Introduced dyn_conservative mode + -- Removed unneeded allocations, removed unneeded subroutines + -- Moved location of call to benergy into XY decomposition section + +M models/atm/cam/src/dynamics/fv/p_d_adjust.F90 + -- Introduced T_TRACERS type for constituents + +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + -- Added dyn_conservative, modcomm_gatscat + -- removed use_eta, tracertrans + -- changed location and argument list of parinit() + +M models/atm/cam/src/dynamics/fv/inital.F90 + -- Revised call to dyn_init + +M models/atm/cam/src/dynamics/fv/cd_core.F90 + -- cosmetic changes to FVstart/stopclock + +M models/atm/cam/src/dynamics/fv/sw_core.F90 + -- loop index bug fixed (reported by Putman) + +M models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 + -- T3 array has become i,j,k (was i,k,j) + -- Introduced T_TRACERS type for constituents + +M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + -- Bug fix for conservation mode (now: grid%klastp = km_in+1) + -- Added ACOSU + +M models/atm/cam/src/dynamics/fv/geopk.F90 + -- Changes for mod_geopk mode to reduce MPI_TYPE usage + +M models/atm/cam/src/dynamics/fv/stepon.F90 + -- Removed set_eta code (namelist variable: use_eta) + -- Introduced T_TRACERS type for constituents + +M models/atm/cam/src/dynamics/fv/fv_prints.F90 + -- Introduced T_TRACERS type for constituents + +M models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + -- Introduced T_TRACERS type for constituents + -- Revised call to dyn_init + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All tests pass except the CCSM comparison test + + 055 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + + Justification: was failing in cam3_3_14 and 15. See explanations there. + +tempest: all tests passed + +bangkok/lf95: all tests passed + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + ==> No changes to answers + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: no change + +URL for AMWG diagnostics output used to validate new climate: no change + +=============================================================== +=============================================================== + +Tag name: cam3_3_15 +Originator(s): Erik Kluzek +Date: Thu Jul 13 21:17:44 MDT 2006 +One-line Summary: + +Purpose of changes: Put in top level initialization and clock objects at driver level + for moving forward with sequential CCSM. + + This separates out the driver from the internals of the CAM time-manager. Making + the top level driver separable from CAM itself, and moves it toward a Sequential + CCSM where the sub-components can be swapped for other CCSM components (such + as the CCSM data models or active ice and active ocean models). + +Bugs fixed (include bugzilla ID): 153 + + Fix bug in test_driver.sh where if BL_ROOT was NOT set -- it would erase the + entire contents of your /ptmp/$USER directory after it was finished. + +Describe any changes made to build system: Add csm_share/eshr directory to Filepath + +Describe any changes made to the namelist: Split into 4 namelists. + + ccsm_inparm ----- Sequential CCSM driver level initialization information + (passed to all subcomponent models: atm, lnd, ice, ocn) + timemgr_inparm -- Sequential CCSM driver level clock information + (passed to all subcomponent models: atm, lnd, ice, ocn) + cam_inparm ------ CAM specific namelist + clm_inparm ------ CLM specific namelist + +The ccsm_inparm namelist is managed by the shr_inputInfo_mod.F90 module and objects. +The timemgr_inparm namelist is managed by the eshr_timemgr_mod.F90 module and objects. +These are both sequential CCSM top level driver objects that are passed into +sub-components (atmosphere, land, sea-ice, and ocean) to manage information that is +shared between sub-components. + +CHANGE SO THAT THE NAMELIST IS NO LONGER READ FROM STDIN -- THE NAMELIST NAME IS +ASSUMED AND THE FILE OPENED EXPLICITLY. When namelists read the file is opened, and +namelists are read until the correct one is found, then the file is closed. If the +needed namelist does not exist -- OR THERE IS AN ERROR IN IT -- the program will abort +with an error. + +The interface to build-namelist still uses the input namelists of: camexp and clmexp +and will divide the relevant namelist items to the appropriate namelists. + +Option added to build-namelist: -ignore_ic_date + +by default build-namelist will match the start date/time (start_ymd,start_tod) for +initial condition datasets. If a suitable dataset with the correct starting date +(as well as resolution and other matching criteria) isn't found -- an initial condition +dataset will NOT be provided. + +If you use the -ignore_ic_date option is used datasets will be matched without +examining the starting date/time of the dataset. + +Namelist items removed: + + restart_nsteps --> use restart_option and restart_n + restart_nhours --> use restart_option and restart_n + restart_ndays ---> use restart_option and restart_n + restart_monthly -> use restart_option and restart_n + restart_yearly --> use restart_option and restart_n + no_restart ------> use restart_option and restart_n + nelapse ---------> use stop_option and stop_n + nestep ----------> Functionality removed + nsrest ----------> Use start_type + +Namelist items moved to different namelist: + + Old namelist item New namelist used in + ================= ==================== + archive_dir ccsm_inparm (now refers to the top level archive directory) + aqua_planet ccsm_inparm + brnch_retain_casename ccsm_inparm + mss_irt ccsm_inparm + mss_wpass ccsm_inparm + calendar timemgr_inparm + stop_ymd timemgr_inparm + stop_tod timemgr_inparm + start_ymd timemgr_inparm + start_tod timemgr_inparm + ref_ymd timemgr_inparm + ref_tod timemgr_inparm + perpetual_run timemgr_inparm + perpetual_ymd timemgr_inparm + +Namelist items that changed names: + + Old namelist item New namelist item name New namelist used in + ================= ====================== ==================== + eccen orb_eccen timemgr_inparm + obliq orb_obliq timemgr_inparm + mvelp orb_mvelp timemgr_inparm + iyear_AD orb_iyear_AD timemgr_inparm + ctitle case_desc ccsm_inparm + caseid case_name ccsm_inparm + adiabatic atm_adiabatic ccsm_inparm + ideal_phys atm_ideal_phys ccsm_inparm + +Namelist items added: + + Namelist item Description New namelist used in + ========================= ====================================== ==================== + start_type ---------------> How simulation will startup ccsm_inparm + Valid options: + + startup = Use initial files + continue = Use restart files to continue simulation + branch = Use restart files to branch simulation + + restart_pfile ------------> Driver level restart pointer file name ccsm_inparm + restart_file -------------> Driver level restart file name ccsm_inparm + restart_file_override ----> Override list of items from restart file ccsm_inparm ** + restart_file_TGRoverride -> Override list of items from restart file ccsm_inparm ** + restart_option -----------> Driver level restart frequency type timemgr_inparm + Valid options: + + nsteps ---- Write restarts every restart_n time-steps + ndays ----- Write restarts every restart_n days + nmonths --- Write restarts every restart_n months + nyears ---- Write restarts every restart_n years + monthly --- Write restarts at beginning of each month + yearly ---- Write restarts at beginning of the year + end ------- Write restarts only at end of simulation + none ------ Don't write any restarts + + restart_n ----------------> Driver level restart frequency value timemgr_inparm + stop_option --------------> Driver level restart frequency type timemgr_inparm + Valid options: + + nsteps ---- Stop after stop_n time-steps + ndays ----- Stop after stop_n days + nmonths --- Stop after stop_n months + nyears ---- Stop after stop_n years + date ------ Stop at stop_ymd/stop_tod date/time + + stop_n -------------------> Driver level restart frequency value timemgr_inparm + stop_final_ymd -----------> The final date to run to (YYYYMMDD format) timemgr_inparm + atm_cpl_dt ---------------> Atmosphere coupling frequency (sec) timemgr_inparm + +Example creation of the old and new namelist using build-namelist: + +With cam3_3_14: + + build-namelist -runtype initial -namelist "&camexp nelapse=-1, restart_monthly=.true., iyear_AD=1990/ " + +with cam3_3_15: + + build-namelist -runtype startup -namelist "&camexp stop_option='ndays', stop_n=1, restart_option='monthly' , orb_iyear_AD=1990 /" + +So build-namelist figures out that all of the above options belong in the timemgr_inparm namelist +and deal with it appropriately. And results in the following namelist: + +&ccsm_inparm + case_name = 'camrun' + start_type = "startup" +/ +&timemgr_inparm + atm_cpl_dt = 1200 + orb_iyear_ad = 1950 + restart_option = 'monthly' + start_ymd = 901 + stop_n = 1 + stop_option = 'ndays' +/ +&cam_inparm + absems_data = '/fs/cgd/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' + aeroptics = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' + bnd_topo = '/fs/cgd/csm/inputdata/atm/cam/topo/USGS-gtopo30_64x128_c050520.nc' + bndtvaer = '/fs/cgd/csm/inputdata/atm/cam/rad/AerosolMass_V_64x128_clim_c031022.nc' + bndtvo = '/fs/cgd/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' + bndtvs = '/fs/cgd/csm/inputdata/atm/cam/sst/sst_HadOIBl_bc_64x128_clim_c020411.nc' + dtime = 1200 + ncdata = '/fs/cgd/csm/inputdata/atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc' +/ +&clm_inparm + fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' + fsurdat = '/fs/cgd/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_64x128_c050523.nc' +/ + +How to override information on the restart file from the namelist: ** + + By default for a continue or branch type of simulation -- driver information is + read from the restart file and namelist information is ignored. In order to explicitly + use driver level restart information you have to do the following: + + 1.) Set given namelist item(s) you want to override. + 2.) Set restart_file_override (or restart_file_TGRoverride for timemgr_inparm namelist) + to include the colon delimited list of items you want to override on the namelist. + 3.) To override the case_name -- set the brnch_retain_casename namelist item to true. + + List of ccsm_inparm items that can be overridden: mss_irt, mss_wpass, and case_desc + (and case_name is brnch_retain_casename is set to true) + List of timemgr_inparm items that can be overridden: restart_option, restart_n + + Examples + + build-namelist -runtype continue -namelist \ + "&camexp mss_irt=45, mss_wpass='example', restart_file_override='mss_irt:mss_wpass' /" + + The above example will override the values of mss_irt, mss_wpass from the restart file + with those given on the namelist. Note if restart_file_override were missing, the + values on the restart file would be used an the values on the namelist ignored. + + build-namelist -runtype continue -namelist \ + "&camexp restart_option='nyears', restart_n=2, restart_file_TGRoverride='restart_option:restart_n' /" + + The above example will override the values of restart_option, and restart_n from + the restart file with those given on the namelist. Note if restart_file_override + were missing, the values on the restart file would be used an the values on the + namelist ignored. + +List any changes to the defaults for the boundary datasets: make sure IC file names are + consistent with dates in file. + Also add ic_ymd and ic_tod to describe the date (YYYYMMDD format) and time-of-day (sec) + that the given initial condition file represents. + +Describe any substantial timing or memory changes: none + +Code reviewed by: Brian Eaton, Mariana Vertenstein, Mat Rothstein + +Externals updated: + share3_060710 ------------ Add shr_inputinfo_mod/eshr_timemgr_mod codes. + clm3_expa_65 ------------- Use new share objects. + esmf_wrf_timemgr_060616 -- Same behavior as ESMF, changes needed for new share. + MCT2_2_1_060706 ---------- Changes get_zeits.c to work on new bangkok compiler. + +List all subroutines eliminated: + + In models/atm/cam/src/control/restart.F90 <-- determine if restart from SyncClock + restart_init + restart_is_write_step + update_next_write_time + In models/atm/cam/src/utils/time_manager.F90 <-- remove unused functions. + get_clock + get_curr_ESMF_Time + calc_nestep <---- not needed as SynClock determines stop-time. + +List all subroutines added and what they do: + + runtime_opts_setNLFile (runtime_opts.F90) -- Set the namelist filename. + ccsmini_sendgridgetorb (ccsm_msg.F90) ------ Send grid and get orbit info + at initialization. + get_calendar (time_manager.F90) ------------ Get calendar type using. + timemgr_check_restart (time_manager.F90) --- Check the restart info for consistency. + +List all files eliminated: + + atm/cam/bld/DefaultCLMEXPNamelist.xml (change name) + atm/cam/bld/clm2exp.pm (change name) + atm/cam/bld/CAM_namelist.p (change name) + atm/cam/bld/DefaultCAMEXPNamelist.xml (change name) + +List all files added and what they do: + + atm/cam/test/unit/control/filterhead.pl -- filters unit test log data to compare results + with a different version. + + atm/cam/bld/nl_descrips.pm --------------------- Describes the driver level namelists. + atm/cam/bld/clm_inparm.pm ---------------------- Manages the clm_inparm namelist. + atm/cam/bld/DefaultCAM_INPARM_Namelist.xml ----- Default values for the cam_inparm namelist. + atm/cam/bld/DefaultCLM_INPARM_Namelist.xml ----- Defaults for the clm_inparm + namelist (renamed from old CAMEXP file) + atm/cam/bld/DefaultTIMEMGR_INPARM_Namelist.xml - Default values for the timemgr_inparm namelist. + atm/cam/bld/DefaultCCSM_INPARM_Namelist.xml ---- Default values for the ccsm_inparm namelist. + atm/cam/bld/NamelistsDescriptions.xml ---------- List of items on driver level namelists. + atm/cam/bld/timemgr_inparm.pm ------------------ Manages the timemgr_inparm namelist. + atm/cam/bld/cam_inparm.pm ---------------------- Manages the cam_inparm namelist. + atm/cam/bld/SeqCCSM_namelist.pm ---------------- Manages all namelists needed. + atm/cam/bld/ccsm_inparm.pm --------------------- Manages the ccsm_inparm namelist + +List all existing files that have been modified, and describe the changes: + + Pass CCSMInit and SyncClock objects down to sub-models. + + ocn/dom/ocn_comp_mct.F90 + ocn/som/ocn_comp_mct.F90 + ice/csim4/ice_comp_mct.F90 + + Update unit tests for time_manager module. + + atm/cam/test/unit/control/configure + atm/cam/test/unit/control/run_time_test + atm/cam/test/unit/control/test_time.F90 + + Change test_driver system to work with new build-namelist options and new + namelist behavior and changes to namelist item names. + + atm/cam/test/system/test_driver.sh + atm/cam/test/system/TSB.ccsm.sh + atm/cam/test/system/TBR.sh + atm/cam/test/system/TER.sh + atm/cam/test/system/TRX.sh + atm/cam/test/system/TSM.sh + atm/cam/test/system/nl_files/idphys + atm/cam/test/system/nl_files/ghgrmp + atm/cam/test/system/nl_files/outfrq3s + atm/cam/test/system/nl_files/aqpgro + atm/cam/test/system/nl_files/no_ttrac + atm/cam/test/system/nl_files/off2x2.5 + atm/cam/test/system/nl_files/pghgsul + atm/cam/test/system/nl_files/ttrac_lb1 + atm/cam/test/system/nl_files/ttrac_lb2 + atm/cam/test/system/nl_files/ttrac + atm/cam/test/system/nl_files/ttrac_lb3 + atm/cam/test/system/nl_files/adia + atm/cam/test/system/nl_files/outfrq24h + + Pass CCSMInit and SyncClock objects down as appropriate into scam. Upgrade + make to work with new PGI compiler on bangkok. + + atm/cam/tools/scam/configure + atm/cam/tools/scam/testscript + atm/cam/tools/scam/userdata/crmtest26.out <--- Needed for compiler upgrade on bangkok. + atm/cam/tools/scam/ui/configure + atm/cam/tools/scam/scm_init/init_model.F90 + atm/cam/tools/scam/scm_init/scam_srfdata_MCT.F90 + atm/cam/tools/scam/scm_init/scam_run.F90 + atm/cam/tools/scam/scm_init/inital.F90 + atm/cam/tools/scam/scm_init/scamMod.F90 + atm/cam/tools/scam/scm_init/setiopupdate.F90 + + Work with new PGI compiler on bangkok. Add eshr to Filepath. + Changes to get Darwin (Mac OS-X) to work. Remove HIDE_SHR_MSG as + unneeded now. + + atm/cam/bld/configure + atm/cam/bld/Makefile.in + + Change to work in the context of the 4 new namelists. Add -ignore_ic_date option + in. Have CAM_config.pm keep track of new items added to the XML configuration file. + + atm/cam/bld/build-namelist + atm/cam/bld/clmexp.pm + atm/cam/bld/namelist.pm + atm/cam/bld/camexp.pm + atm/cam/bld/atmlndnl.pm + atm/cam/bld/CAM_config.pm + + Change run scripts to work with new build-namelist and do NOT redirect stdin. + + atm/cam/bld/run-ibm.csh + atm/cam/bld/run-pc.csh + atm/cam/bld/run-sgi.csh + atm/cam/bld/run-lightning.csh + atm/cam/bld/run-darwin.csh + + Pass CCSMInit and SyncClock objects down as needed. Use them to + initialize CAM internal data. + + atm/cam/src/control/readinitial.F90 + atm/cam/src/control/runtime_opts.F90 + atm/cam/src/control/restart.F90 + atm/cam/src/control/history.F90 + atm/cam/src/control/atm_comp_mct.F90 + atm/cam/src/control/startup_initialconds.F90 + atm/cam/src/control/units.F90 + atm/cam/src/control/filenames.F90 + atm/cam/src/control/ioFileMod.F90 + atm/cam/src/control/cam_comp.F90 + atm/cam/src/utils/time_manager.F90 + atm/cam/src/dynamics/fv/metdata.F90 + + Create CCSMInit and SyncClock driver level data at top level concurrent CAM + driver pass down as needed. Set orbital information in SyncClock from data sent + from coupler. + + atm/cam/src/control/con_cam.F90 + atm/cam/src/control/ccsm_msg.F90 + + Remove dependence on CAM specific data and modules and use CCSMInit + and SyncClock driver level objects. + + drv/seq_mct_drv/seq_ccsm_drv.F90 + drv/seq_mct/mrg_x2a_mct.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All tests pass except the CCSM comparison test + + 055 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 + + CCSM failed because the new CCSM scripts for this tag don't work with the old CAM + Thus the comparison to the old CCSM tag and cam3_3_14 had to be done by hand. + The comparison is exact if esmf_wrf_timemgr is updated in cam3_3_14 to + esmf_wrf_timemgr_051212. If not the difference is bit-for-bit until the 25th time-step + when the difference is off by roundoff. This was documented in the cam3_3_4 commit + where we had a roundoff difference due to the new esmf_wrf_timemgr. + + For running CCSM test use: + + env CAM_CCSMROOT=/fs/cgd/csm/models/atm/newchg_ccsm3_1_beta34 + +tempest: none + +bangkok/lf95: none + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_14 + +Summarize any changes to answers: none (bit-for-bit) + CCSM (changes to roundoff) + + CCSM answers change because esmf_wrf_timemgr updated from an + older version 050309 to the version used here 060616. + +=============================================================== +=============================================================== + +Tag name: cam3_3_14 +Originator(s): mvr +Date: 060612 +One-line Summary: +Update the ccsm tests within cam's test suite to reflect new changes to +ccsm's scripts; minor bug fixes to test scripts; cray x1 mods in newcprnc + +Purpose of changes: new naming conventions were introduced to ccsm's +test scripts; newcprnc required mods for cray x1 + +Bugs fixed (include bugzilla ID): applied fix for bug #43 to cam's newcprnc +code just as it was applied to clm's + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: +D models/atm/cam/tools/newcprnc/cprnc.f90 +- file renamed due to pre-processor directives added for cray x1 + +List all subroutines added and what they do: +A + models/atm/cam/tools/newcprnc/cprnc.F90 +- new file with directives for cray x1 + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +- mods to reflect name changes introduced in ccsm scripts; added cleanup after + successful ccsm test; minor bug fixes +M models/atm/cam/test/system/TCT.ccsm.sh +- mods to reflect name changes introduced in ccsm scripts; now dumps output +of create_test to output log +M models/atm/cam/test/system/test_driver.sh +- test suite now uses prod queue rather than debug on phoenix +M models/atm/cam/test/system/gen_test_table.sh +- utility updated to include all platforms supported by cam's test driver +M models/atm/cam/test/system/input_tests_master +- mods to reflect name changes introduced in ccsm scripts +M models/atm/cam/test/system/TCB.ccsm.sh +- mods to reflect name changes introduced in ccsm scripts +M models/atm/cam/tools/newcprnc/nfwrappers.f90 +- bug fix for intent of variables in wrap_open (see bug #43) +M models/atm/cam/tools/newcprnc/Makefile +- added mods for cray x1 +M posttag_cron_bangkok.sh +M posttag_cron_bluesky.sh +M posttag_cron_lightning.sh +M posttag_cron_bluevista.sh +- cron scripts modified to make use of "collections" area for cam tags + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +055 cs998 TCS.ccsm.sh ERS f19_g13 K ...............................FAIL! rc= 2 +- ccsm test fails when comparing to baseline due to changes in naming + conventions...tests were verified by hand + +tempest: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_3_13 +Originator(s): Jim Edwards +Date: 060606 +One-line Summary: addition of HOMME dynamic core, removal of plat/plon from physics + +Purpose of changes: development of a new dynamic core prototype, generalization of + model to non-rectangular horizontal grids + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Added support for homme dynamics in configure. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: a dynamics/homme subdirectory was added + with stubs to interface the (external) homme model +A models/atm/cam/src/dynamics/homme + A models/atm/cam/src/dynamics/homme/initcom.F90 + A models/atm/cam/src/dynamics/homme/pmgrid.F90 + A models/atm/cam/src/dynamics/homme/dp_coupling.F90 + A models/atm/cam/src/dynamics/homme/dycore.F90 + A models/atm/cam/src/dynamics/homme/dyn_comp.F90 + A models/atm/cam/src/dynamics/homme/inidat.F90 + A models/atm/cam/src/dynamics/homme/stepon.F90 + A models/atm/cam/src/dynamics/homme/restart_dynamics.F90 + A models/atm/cam/src/dynamics/homme/commap.F90 + A models/atm/cam/src/dynamics/homme/spmd_dyn.F90 + A models/atm/cam/src/dynamics/homme/dyn_grid.F90 + A models/atm/cam/src/dynamics/homme/README + A models/atm/cam/src/dynamics/homme/inital.F90 + A models/atm/cam/bld/config_cam_homme_defaults.xml +List all existing files that have been modified, and describe the changes: + Changed FV CPP macro STAGGERED to the more appropriate and general DYN_STATE_INTERFACE + + U models/atm/cam/src/control/runtime_opts.F90 + U models/atm/cam/src/control/ccsm_msg.F90 + U models/atm/cam/src/control/startup_initialconds.F90 + U models/atm/cam/src/control/cam_comp.F90 + U models/atm/cam/src/utils/time_manager.F90 + + Removed references to plat and plon. + + U models/atm/cam/src/physics/cam1/comsrf.F90 + U models/atm/cam/src/physics/cam1/dmsbnd.F90 + U models/atm/cam/src/physics/cam1/acbnd.F90 + U models/atm/cam/src/physics/cam1/dust_intr.F90 + U models/atm/cam/src/physics/cam1/tracers_suite.F90 + U models/atm/cam/src/physics/cam1/boundarydata.F90 + U models/atm/cam/src/physics/cam1/drydep_mod.F90 + U models/atm/cam/src/physics/cam1/restart_physics.F90 + U models/atm/cam/src/physics/cam1/stratiform.F90 + U models/atm/cam/src/physics/cam1/water_tracers.F90 + U models/atm/cam/src/physics/cam1/co2_data_flux.F90 + U models/atm/cam/src/physics/cam1/volcanicmass.F90 + U models/atm/cam/src/physics/cam1/physpkg.F90 + U models/atm/cam/src/physics/cam1/wetdep.F90 + U models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + U models/atm/cam/src/physics/cam1/carbon_intr.F90 + U models/atm/cam/src/physics/cam1/sulchem.F90 + U models/atm/cam/src/physics/cam1/co2_cycle.F90 + U models/atm/cam/src/physics/cam1/sulbnd.F90 + U models/atm/cam/src/physics/cam1/soxbnd.F90 + U models/atm/cam/src/physics/cam1/caerbnd.F90 + U models/atm/cam/src/physics/cam1/aerosol_intr.F90 + U models/atm/cam/src/physics/cam1/advnce.F90 + U models/atm/cam/src/physics/cam1/sulfur_intr.F90 + + Added support for HOMME dycore + + U models/atm/cam/bld/configure + U models/atm/cam/bld/resolution_parameters.xml + + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: none + tested with CAM_CCSMROOT=/fs/cgd/csm/collections/ccsm3_1_beta29 + +tempest: none + +bangkok/lf95: none + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam3_3_12 +Originator(s): mvr, jedwards +Date: 060602 +One-line Summary: test suite now supports phoenix (cray x1); + added testing of coupled model to bluevista; bug fix + for fv coupled runs + +Purpose of changes: wanted test coverage of cray x1; testing + of coupled model had been restricted to just bluesky; + new features in ccsm's scripts available for use + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +- added DMS_emmissions, oxid, and SOx_emissions files for fv 2x2.5 +- updated to newer SOx_emissions file for T85 + +Describe any substantial timing or memory changes: + +Code reviewed by: myself + +List all subroutines eliminated: +none + + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/fmo2m +A models/atm/cam/test/system/config_files/f2c11m +A models/atm/cam/test/system/config_files/e128m +A models/atm/cam/test/system/config_files/e128c11m +A models/atm/cam/test/system/config_files/fm1.9m +A models/atm/cam/test/system/config_files/f1.9pm +A models/atm/cam/test/system/config_files/f1.9m +A models/atm/cam/test/system/config_files/e128pm +- new configuration options for testing on phoenix + +A models/atm/cam/test/system/nl_files/off2x2.5p +- new namelist options for testing on phoenix + +A models/atm/cam/test/system/TCT.ccsm.sh +- new test script needed for testing of coupled model + +A models/atm/cam/test/system/tests_posttag_phoenix +A models/atm/cam/test/system/tests_posttag_robin +- new sets of default posttag tests for robin and phoenix + + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/TCB.ccsm.sh +- scripts for testing of coupled model now supports bluevista, phoenix; + build of coupled model can now be done separately prior to run; + updated to take advantage of new features in ccsm scripts + +M models/atm/cam/test/system/tests_posttag_bluesky +M models/atm/cam/test/system/tests_pretag_bluesky +- defaults test sets modified to have fv ccsm test be pretag, eul posttag + +M models/atm/cam/test/system/tests_posttag_bluevista +- default posttag tests on bluevista now include ccsm tests + +M models/atm/cam/test/system/test_driver.sh +- support added for robin/phoenix; MPI_TYPE_MAX now set for all platforms + +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/CAM_runcmnd.sh +- new tests added to master list for phoenix + +M models/atm/cam/bld/camexp.pm +- mod to allow for casenames of length 80 characters + +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml +- added default input files for fv 2x2.5; updated to a newer T85 file + +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/history.F90 +- bug fixes to remove call to getfil for files not yet in existence - + would fail on phoenix when it tried to find it on mass store + +M models/atm/cam/src/chemistry/trop_mozart/mo_imp_sol.F90 +- bug fix for line length exceeding max number of characters + +M models/atm/cam/src/dynamics/fv/dyn_grid.F90 +- bug fix for problem introduced in cam3_3_11 for fv coupled runs + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +001 sb998 TSB.ccsm.sh ER.01a 1.9x2.5_gx1v3 K ......................FAIL! rc= 6 +055 cs998 TCS.ccsm.sh ER.01a 1.9x2.5_gx1v3 K ......................FAIL! rc= 2 +- failed due to mods in test scripts; test passes when run manually + +tempest: +all pass + +bangkok/lf95: +all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: fv ccsm test used cam3_3_10 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? b4b + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: cam3_3_11 +Originator(s): pworley, Jim Edwards +Date: 5/25/2006 +One-line Summary: phys_grid changes for single index method to support non-rectangular grids + +Purpose of changes: to support non-rectangular grids + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, Brian Eaton, Mariana, Pat Worley + +List all subroutines eliminated: + cam_domain, + get_cid_all_p, + get_chunk_coord_owner_p, + get_chunk_owner_p + get_cid_p + get_block_coord_d + get_block_coord_cnt_d + get_block_col_cnt_d + get_lon_d + get_lat_d + + + + +List all subroutines added and what they do: + get_gcol_all_p, get the global column id for all columns in the chunk + get_area_all_p, get the area of all columns in the chunk + get_block_gcol_d get column indices for given block + get_gcol_block_d get global block indices and local columns index for given global column index + get_horiz_grid_d: provides the total number of global columns visible to the physics + the lat, lon location and the surface area of each column + + (functions) + get_area_p : get area of column + get_gcol_p : get gcol id of column + get_gcol_owner_p : get task of column gcol in physics + get_block_gcol_cnt_d : get number of columns in given block + get_gcol_block_cnt_d : get number of blocks containing data + from a given global column index + get_horiz_grid_cnt_d : get number of columns in dynamics grid (visible to physics) + + +List all existing files that have been modified, and describe the changes: + + The cam_domain module was removed and these files modified to + get the mct grid initialization data directly from the physics + chunk on the task. This is both a simplification and a generalization + of the method introduced in cam3_3_9 + + M models/ocn/dom/ocn_comp_mct.F90 + M models/ocn/som/ocn_comp_mct.F90 + M models/ice/csim4/ice_comp_mct.F90 + M models/atm/cam/src/control/ccsm_msg.F90 + M models/atm/cam/src/control/atm_comp_mct.F90 + M models/atm/cam/src/control/cam_comp.F90 + M models/drv/seq_mct/seq_domain_mct.F90 + + Chunks (decomposed grid in the physics) were changed from + 2-D arrays in the horizontal to 1D. + This allows the generalization of cam physics to + non-rectangular grids. + + M models/atm/cam/src/physics/cam1/physics_types.F90 + M models/atm/cam/src/physics/cam1/phys_grid.F90 + M models/atm/cam/src/dynamics/sld/dyn_grid.F90 + M models/atm/cam/src/dynamics/eul/dyn_grid.F90 + M models/atm/cam/src/dynamics/fv/dyn_grid.F90 + + Support for the historical reduced grid method has been removed + if a reduced grid is reintroduced in the future it should use the + more general method introduced here. + M models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_ub_vals.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 + M models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_lb_vals.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_photo.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_ch4_lbc.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 + M models/atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 + M models/atm/cam/src/chemistry/waccm_mozart/mo_tgcm_ubc.F90 + M models/atm/cam/src/chemistry/waccm_mozart/mo_sulf.F90 + M models/atm/cam/src/chemistry/waccm_mozart/mo_airplane.F90 + M models/atm/cam/src/chemistry/waccm_mozart/mo_drydep.F90 + M models/atm/cam/src/chemistry/waccm_mozart/mo_srf_emissions.F90 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All tests pass + +tempest: All tests pass + +bangkok/lf95: All tests pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_10 +Originator(s): mvr +Date: 060524 +One-line Summary: added gensom option to configure; added test of gensom + vars to test suite; updated externals to new timing files; cleanup + +Purpose of changes: SOM input fields should not be generated and written + to history tapes by default; unused integer return codes of some + timing routines were causing problems on phoenix; write statements + and empty directories were left behind from previous commits + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: -gensom option added to configure + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not including the SOM + input fields by default may show slight improvement + +Code reviewed by: myself, eaton + +List all subroutines eliminated: +D models/atm/cam/test/system/config_files/f4c11dh +- config options file replaced with one that includes -gensom option for testing +D models/atm/cam/src/ocnsice +D models/atm/cam/src/ocnsice/dom +D models/atm/cam/src/ocnsice/som +- removed empty directories left behind from previous commit + +List all subroutines added and what they do: +A models/atm/cam/test/system/config_files/f4c11gdh +- replacement config options file with -gensom option for testing + +List all existing files that have been modified, and describe the changes: +M models/utils/SVN_EXTERNAL_DIRECTORIES +- updating to new timing tag with mods for replacing int return codes with void +M models/atm/cam/test/system/input_tests_master +- adding test of the new configure option (gensom) to an existing test +M models/atm/cam/bld/configure +- modified to handle new option for generating SOM input fields +M models/atm/cam/bld/config_cam_eul_defaults.xml +M models/atm/cam/bld/config_trop_chem_mozart_defaults.xml +M models/atm/cam/bld/config_waccm_ghg_defaults.xml +M models/atm/cam/bld/config_waccm_mozart_defaults.xml +M models/atm/cam/bld/config_cam_fv_defaults.xml +M models/atm/cam/bld/config_cam_sld_defaults.xml +- added default values for gensom +M models/atm/cam/src/control/atm_comp_mct.F90 +M models/drv/seq_mct/mrg_x2a_mct.F90 +M models/drv/seq_mct/seq_domain_mct.F90 +- removed write statements left behind from previous commits + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +019 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 5 +- failed because this is a new test and did not exist in previous tag + +tempest: +021 bl331 TBL.sh f4c11gdh pghgsul 9 ...............................FAIL! rc= 5 +- failed because this is a new test and did not exist in previous tag + +bangkok/lf95: +none + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_9 +Originator(s): Mariana Vertenstein +Date: Wed May 17 13:05:13 MDT 2006 +One-line Summary: created new generate som mode for mct coupling + +Purpose of changes: Remove output of ice/ocn specific fields from + mrg_x2a_mct.F90 and move then to atm_comp_mct.F90. All routines + in mct_drv/ should be devoid of cam specific information. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: default seq_flds_mod.F90 + to be used is currently in drv/seq_flds/gensom. This corresponds + to extra fields being sent to the atm which would only be used + for SOM input fields generation. Changes need to be made to + the testing scripts and configure to support a gensom option. + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: The extra + fields being sent to atm_comp_mct.F90 might have a very small + performance penalty. However, a fix for this is expected in the + very near future. + +Code reviewed by: Myself (discussed these changes with Brian Eaton) + +List all subroutines eliminated: + +List all subroutines added and what they do: + + A drv/seq_flds/gensom/seq_flds_mod.F90 + sends fields to atm that are needed for SOM input data generation + +List all existing files that have been modified, and describe the changes: + + M atm/cam/src/control/history_defaults.F90 + M atm/cam/src/physics/cam1/diagnostics.F90 + M ocn/som/ocn_comp.F90 + moved history file initialization from diagnostics.F90 and history_defaults.F90 for: + TSOCN&IC, QFLUX, QFLUX_FT, QFLUX_TH, QFLUX_A2, FOCN, OIE, OIERATE, ONF, MLDANN + M ice/csim4/ice_comp.F90 + moved history file initialization from diagnostics.F90 and history_defaults.F90 for: + MELTB ,MELTT ,MELTL ,GROWB ,FRAZIL ,FLOOD ,FRZMLT ,NRGERROR,DELTAICE + NRGICE ,IIERATE ,F_ICE ,F_OCN ,FRZMLTMX,IMBAL ,EICEIN ,EICEOUT , TSICERAD&IC + M atm/cam/src/control/ccsm_msg.F90 + moved history file initialization from diagnostics.F90 and history_defaults.F90 for: + CPLRAINC,CPLRAINL,CPLSNOWC,CPLSNOWL,CPLPRCER + + M atm/cam/tools/scam/scm_init/scam_run.F90 + M drv/seq_mct_drv/seq_ccsm_drv.F90 + removed call to mrg_x2a_run1_mct + renamed call to mrg_x2a_run2_mct as call to mrg_x2a_run_mct + M drv/seq_mct/mrg_x2a_mct.F90 + removed subroutine mrg_x2a_run1_mct + renamed subroutine mrg_x2a_run2_mct as call to mrg_x2a_run_mct + + M atm/cam/bld/configure + set default path for seq_flds to $srcdir/drv/seq_flds/gensom + + M atm/cam/src/control/atm_comp_mct.F90 + added private subroutines atm_gensom1_mct and atm_gensom2_mct + that provide fuctionality previously done in + mrg_x2a_run1_mct and mrg_x2a_run2_mct - they are only invoked + if indices in seq_flds_indices for SOM generation fields are + non-zero (this will only be the case if + $srcdir/drv/seq_flds/gensom/seq_flds_mod.F90 is used. + + M drv/seq_flds_indices/seq_flds_indices.F90 added indices necessary for SOM data generation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all pass + +tempest: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_8 +Originator(s): Mariana Vertenstein +Date: Sat May 13 17:48:49 MDT 2006 +One-line Summary: to implement MCT domains in each component + +Purpose of changes: To implement MCT domains and implement + a top level domain checker for cam and the surface components + using these domains (this replaces use statements within clm) + Note that cam3_3_7 was identical to this tag - but was tagged + with the wrong land externals - this tag fixes this problem. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + all changes are in the initialization phase - however, + the impact of timing due to initialization has not been tested + +Code reviewed by: Tony Craig and Rob Jacob + +List all subroutines eliminated: None + +List all subroutines added and what they do: + + A models/atm/cam/src/control/cam_domain.F90 + A new routine that can be used by both ccsm_msg.F90 and the + atm_comp_mct.F90 routine to calculate the cam grid and areas + (this code was previously contained in ccsm_msg.F90). + +List all existing files that have been modified, and describe the changes: + + M models/atm/cam/src/control/atm_comp_mct.F90 + M models/ocn/dom/ocn_comp_mct.F90 + M models/ocn/som/ocn_comp_mct.F90 + M models/ice/csim4/ice_comp_mct.F90 + M models/lnd/clm2/src/main/lnd_comp_mct.F90 + M models/atm/cam/tools/scam/scm_init/init_model.F90 + M models/atm/cam/tools/scam/scm_init/scam_srfdata_MCT.F90 + M models/drv/seq_mct_drv/seq_ccsm_drv.F90 + M models/drv/seq_mct/seq_mct_mod.F90 + D models/drv/seq_mct/seq_mct_init.F90 => A models/drv/seq_mct/seq_init_mct.F90 + In the above routines: + * domains were implemented using the MCT general grid data structures + * the current general grid components that I am defining are + lon,lat,area,mask and maxfrac (maxfrac is the maximum fraction + that the model can have on any gridcell - for the landthis + corresponds to the landfrac, for the ocn and ice this should + correspond to 1.-landfrac when everyone is on the same grid) + * domain checking is only done on the master processor at + initialization (via an MCT gather on the general grid) + * essentially, domains enable grid and fraction checking to be done + at the top level by the master processor and eliminates the use + statements contained in the land model. The consistency check for + fractional land is somewhat different than in the current flux + coupler. Basically, when all the models are on the same grid, you + want the "maximum fraction" from each component to be consistent. + What this boils down to is that the max_frac from the ocn/ice must + equal (1.-landfrac)to within some eps (I have specified 1.e-13). + In the ccsm cpl6 system, the ocn determines the landfrac,and on the + ocean grid maxfrac is either 1 or 0. This is clearly different + than in the current system. + + M models/atm/cam/src/physics/cam1/comsrf.F90 + M models/atm/cam/src/physics/cam1/restart_physics.F90 + M models/atm/cam/src/dynamics/sld/inidat.F90 + M models/atm/cam/src/dynamics/eul/inidat.F90 + M models/atm/cam/src/dynamics/fv/inidat.F90 + -removed landfrac_glob.F90 from above routines + + M models/atm/cam/src/control/ccsm_msg.F90 + - made changes to use cam_domain.F90 for determining grid information + + M models/ocn/dom/ocn_comp.F90 + M models/ocn/som/ocn_comp.F90 + M models/ice/csim4/ice_comp.F90 + M atm/cam/src/physics/cam1/diagnostics.F90 + - moved calls for the following initial file fields: + SNOWHICE&IC, ICEFRAC&IC, SICTHK&IC, TSICERAD&IC + to models/ice/csim4/ice_comp.F90 + - moved calls for the following initial file fields: + TSOCN&IC + to models/ocn/som/ocn_comp.F90 and models/ocn/dom/ocn_comp.F90 + - removed references to initial file file fields TS&IC since this + intiial field it was not being used by any routine + + M atm/cam/src/physics/cam1/restart_physics.F90 + - removed references to landfrac_glob and all COUP_CSM if-defs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all pass + +tempest: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_7 +Originator(s): Mariana Vertenstein +Date: Sat May 13 17:48:49 MDT 2006 +One-line Summary: to implement MCT domains in each component + +Note that tag had a problem with the land externals - another tag +was made using the correct land externals + +=============================================================== +=============================================================== + +Tag name: cam3_3_6 +Originator(s): eaton, tcraig +Date: Mon May 8 11:26:41 MDT 2006 +One-line Summary: Fix CAM log problem in CCSM runs + +Purpose of changes: + + . Fix problem with CAM log file not being written during CCSM run. The + fix was provide by tcraig in bugzilla bug 102. + + . Set MPI_TYPE_MAX environment variable for testing on tempest + (sgi-o3800). This problem started in cam3_3_3 with FV code updates. + It is only a problem on machines that have a default value which is too + small. Currently setting MPI_TYPE_MAX=100000 is sufficient. The + problem has also been observed on phoenix (cray-x1e). + +Bugs fixed (include bugzilla ID): 102 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself, tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/control/con_cam.F90 + . rearrange initialization as follows: + call cpl_interface_init(cpl_fields_atmname, mpicom) ! call mpi_init + call spmdinit() ! set masterproc + call shr_msg_chdir('atm') ! all PE's chdir + call shr_msg_chStdin('atm') ! all PE's redirect unit 5 + if (masterproc) call shr_msg_chStdout('atm') ! redir unit 6 + call ESMF_Initialize() ! init ESMF time manager + call ccsm_seq_timer_init() ! init timing library + + models/atm/cam/test/system/test_driver.sh + . add "export MPI_TYPE_MAX=100000" for testing on tempest + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: Only ran CCSM test -- PASS. + +tempest: All PASS. + +bangkok/lf95: no tests done -- none of the code mods are exercised on bangkok + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_5 +Originator(s): sawyer, eaton +Date: Sun May 7 14:58:53 MDT 2006 +One-line Summary: Fix omega calc for FV offline mode + +Purpose of changes: Fix omega calc for FV offline mode + +Bugs fixed (include bugzilla ID): + + The fix for the FV omega calc added in cam3_3_3 was inadvertently left + out of the offline version of FV. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself, sawyer + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + . call compute_vdot_gradp for both prognostic and offline FV + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS except: + + 040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + + This baseline test is expected to fail. Only the OMEGA field is different. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_4 +Originator(s): Erik Kluzek +Date: May/01/2006 +One-line Summary: Update clm, csm_share, and esmf_wrf_timemgr, use shr_file_mod for archiving + +Purpose of changes: First step in moving toward using ESMF clock interface at top level + use shr_file_mod syntax for archive_dir. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Tony Craig, Mariana Vertenstein, Brian Kauffman (csm_share and clm) + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/drv/seq_mct_drv/seq_ccsm_drv.F90 + +M test/unit/control/configure +M test/unit/control/run_time_test +M tools/scam/scm_init/init_model.F90 +M src/control/ccsm_msg.F90 +M src/control/con_cam.F90 +M src/control/history.F90 +M src/control/filenames.F90 +M src/control/ioFileMod.F90 +M src/physics/waccm/chemistry.F90 + +Also use new version of CLM (shrgetput08_cammct05_clm3_expa_58), csm_share (share3_060428) and +esmf_wrf_timemgr (esmf_wrf_timemgr_060501) + +Changes needed to use new versions of above libraries. Make sure a getfil is done before +a open-file. All programs need to do a ESMF_Initialize. ioFileMod uses shr_file_mod.F90 rather +than it's own functionality. filenames sets up archive_dir for shr_file_mod.F90 syntax (with +mss: prescript). Time unit tests use Lahey instead of PGI compiler on Linux. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: None + +tempest: None + +bangkok/lf95: +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + +esmf_wrf_timemgr real-r8 julian day calculations are off by roundoff on Linux platforms. +It's off by roundoff on other platforms after 4-years. According to the unit tests it +remains within roundoff even for a very long simulation time. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_3 + +Summarize any changes to answers, i.e., +- what code configurations: outfrq24 +- what platforms/compilers: Linux lf95/pgi + +If bitwise differences were observed, how did you show they were no worse +than roundoff? cprnc shows RMS difference in the 1e-17-1.e-20 range + Also unit-tests for time-manager shows that answers for julian day remain + bounded within roundoff even for a very long simulation time. + +=============================================================== +=============================================================== + +Tag name: cam3_3_3 +Originator(s): sawyer, eaton +Date: Tue Apr 25 16:17:05 MDT 2006 +One-line Summary: FV dycore improvements, fix omega diagnostic + +Purpose of changes: + o The XY decomposition is now the only one which is + visible to the outside user (YZ is hidden). This + simplifies the CAM-specific part of FV (code inside + the dynamics/fv directory but outside of the portable + FV core) enormously. + + o A dynamical core interface has + been written which is ESMF-like (init, run, final) + using an import and export container, and implementing + a dynamics state. + + o Correct calculation of OMEGA, and related diagnostics. + + o Resynchronized versions of FV dycores and PILGRIM + between GEOS5 and CAM (except GEOS5 vertical remapping). + + o Numerous other software engineering improvements + (all bit-for-bit). + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + The timings for the FV dycore are roughly the same on bluevista. There + is about a 10% slowdown on phoenix. + +Code reviewed by: sawyer, eaton + +List all subroutines eliminated: + + models/atm/cam/src/dynamics/fv/FVCAM_GridCompMod.F90 + . renamed dyn_comp.F90 + models/atm/cam/src/dynamics/fv/gmean.F90 + . move this subroutine into the new module mean_module.F90 + models/atm/cam/src/dynamics/fv/prognostics.F90 + . prognostic state info now in dyn_import and dyn_export + +List all subroutines added and what they do: + + models/atm/cam/src/dynamics/fv/diag_module.F90 + . contains the new routine compute_vdot_gradp which supplies a fix for + the OMEGA calculation + models/atm/cam/src/dynamics/fv/dyn_comp.F90 + . was FVCAM_GridCompMod.F90 + models/atm/cam/src/dynamics/fv/mean_module.F90 + . new module contains the old gmean.F90 and new XY version of gmean + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/control/history.F90 + . add ability to work with FV fields using XY decomp -- it appears that the + ability to use YZ decomp has been maintained. + . generalize the beg/end index names + . allow history restart write/read to work with XY decomp + + models/atm/cam/src/control/cam_comp.F90 + models/atm/cam/src/control/restart.F90 + models/atm/cam/src/control/startup_initialconds.F90 + . add STAGGERED ifdef to support passing dynamics import/export types through top + level interfaces + + models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 + . use XY decomp only + + models/atm/cam/src/dynamics/fv/dp_coupling.F90 + . use XY decomp only + . use dyn import/export types + + models/atm/cam/src/dynamics/fv/dryairm.F90 + . modify for XY decomp + + models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + . move ESMF code inside GEOS_MODE ifdefs + . remove some tracertrans related code + + models/atm/cam/src/dynamics/fv/epvd.F90 + . update for XY decomp + + models/atm/cam/src/dynamics/fv/fv_prints.F90 + . converted to XY decomp + . ifdef out unused code to find max/min constituent values + + models/atm/cam/src/dynamics/fv/inidat.F90 + . use dyn_import/export_t containers + . remove dependency on prognostics + . input fields now scattered to XY decomp + + models/atm/cam/src/dynamics/fv/inital.F90 + . use dyn_import/export_t containers + . remove dependency on prognostics + + models/atm/cam/src/dynamics/fv/io_dist.F90 + . add methods needed for read/write of XY decomp from/to restart files + + models/atm/cam/src/dynamics/fv/mapz_module.F90 + . add option for cubic interpolation + + models/atm/cam/src/dynamics/fv/metdata.F90 + . remove unneeded ghosting of met_us, met_vs (it's done in cd_core). + + models/atm/cam/src/dynamics/fv/p_d_adjust.F90 + . modify to use XY decomp only + + models/atm/cam/src/dynamics/fv/par_xsum.F90 + . remove CPP conditional surrounding par_xsum_r4 + + models/atm/cam/src/dynamics/fv/pfixer.F90 + . remove SPMD ifdefs that surrounded !$omp directives. + + models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + . remove prognostics module + . add dyn_out as intent(in) arg to write_restart_dynamics + . modify read/write methods to work with XY decomp + . add dyn_in/out as intent(out) args to read_restart_dynamcis + + models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + . remove tracertrans-related variables + + models/atm/cam/src/dynamics/fv/stepon.F90 + . remove prognostics by adding dyn_state to dyn_comp + . use dyn_import_t and dyn_export_t from dyn_comp + . get rid of lots of local xy arrays that are now part of the import/export + states + . add dyn_in, dyn_out dummy args to stepon_init + . the components of dyn_in are being initialized rather than local variables + . add dyn_in, dyn_out as dummy args to stepon_run1 + . replace actual args to diag_dynvar_ic with components of dyn_out + (previously used prognostics module data). + . replace actual args to dyn_run with dyn_state, dyn_in, dyn_out. + Previously passed prognostics module vars and local xy vars. + . use dyn_out as actual arg to d_p_coupling instead of all the local xy + arrays. + . add dyn_in, dyn_out as intent(out) args to stepon_run2 + . use dyn_in as actual arg to p_d_coupling instead of mix of prognostics + and local xy arrays + . add dyn_in, dyn_out as intent(out) args to stepon_run3 + . pass components of dyn_out as actual args to fv_out + + models/atm/cam/src/dynamics/fv/sw_core.F90 + . change an index range in one calc + + models/atm/cam/src/dynamics/fv/te_map.F90 + . added some SPMD ifdefs + + models/atm/cam/src/dynamics/fv/trac2d.F90 + . add local variable frac to private declaration in !$omp and !CSD$ directives + + models/atm/cam/src/dynamics/fv/uv3s_update.F90 + . update to use XY decomp. Note that u3s and v3s are no longer passed with + ghost regions because the ghost region is taken care of in local variables. + + models/atm/cam/src/dynamics/eul/dyn_grid.F90 + models/atm/cam/src/dynamics/fv/dyn_grid.F90 + models/atm/cam/src/dynamics/sld/dyn_grid.F90 + . move ptimelevels from prognostics to here. + + models/atm/cam/src/physics/cam1/phys_buffer.F90 + models/atm/cam/src/physics/cam1/restart_physics.F90 + . get ptimelevels from dyn_grid instead of prognostics + + models/utils/pilgrim/mod_comm.F90 + models/utils/pilgrim/parutilitiesmodule.F90 + models/utils/pilgrim/puminterfaces.F90 + models/utils/pilgrim/redistributemodule.F90 + . merge with GEOS5 version of pilgrim + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS except: + + 019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 + 022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 027 bl334 TBL.sh f4dh adia 9 ......................................FAIL! rc= 7 + 030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 + 034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 + 037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 + +tempest: All PASS except: + + 017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 + 021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 + 024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 029 bl335 TBL.sh f4dh idphys 9 ....................................FAIL! rc= 7 + 031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 + +bangkok/lf95: All PASS except: + + 016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 + 024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 + 028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 + + All the baseline tests that fail on bluesky, tempest, and bangkok do so + due to changes in the diagnostic OMEGA and OMEGAT fields. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_3_1 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_2 +Originator(s): Jim Edwards +Date: 4/24/2006 +One-line Summary: Eliminate common block comlun + +Purpose of changes: code clean up + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: self + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +In control directory: +file comlun.h removed +readinitial.F90 - converted to netcdf f90 interface, modified for ncol format + initial file +runtime_opts.F90, history.F90 - removed reference to ncid_ini and ncid_topo +startup_initial_cond.F90 - made ncid_ini and ncid_topo module variables + added function interfaces initial_file_get_id and topo_file_get_id + to allow read only access to these. +ioFileMod.F90 - made info messages print from masterproc only +error_messages.F90 - added an option integer variable in handle_ncerr to + print the error line number +physics/waccm/tgcm_forcing.F90: removed unused reference to comlun.h +physics/waccm/chemistry.F90: removed unused reference to ncid_trc and comlun.h +physics/cam1/co2_data_flux.F90: removed unused reference to comlun.h +physics/cam1/boundarydata.F90: changed calls to handle_ncerr to add line number +dynamics/*/inidat.F90: changed read_inidat to pass in ncid_ini, ncid_topo + {eul,sld}/spegrd.F90 + {eul,sld}/linemsdyn.F90 + sld/tfilt_massfix.F90 - removed unused refs to comlun.h +tools/scam/scm_init/inital.F90 +tools/scam/scm_init/init_model.F90 - removed refs to comlun.h +ice/csim4/ice_comp.F90 +ice/csim4/ice_data.F90 +ocn/som/somini.F90 +ocn/som/ocn_comp.F90 +ocn/som/somint.F90 +ocn/dom/ocn_comp.F90 +ocn/dom/sst_data.F90 - replaced refs to comlun.h with calls to functions or + local variables as appropriate. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All pass + +tempest: All pass + +bangkok/lf95: All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_1 +Originator(s): Mariana Vertnestein +Date: 4/18/2006 +One-line Summary: bug fixes necessary for CCSM phoenix + +Purpose of changes: Implemented several minor bugs fixes necessary + to run CAM in CCSM on phoenix (Cray X1) + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself, Jon Wolfe, Brian Eaton + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + M src/control/con_cam.F90 + Modifications put in so that only the lead/master MPI process + redirects its stdout to the appropriate component model log file when + running fully coupled, instead of having every process "open" the same + log file. This change solves the problem of logs getting trashed on + phoenix (which has been recently experienced). The only down side is + that warning and error messages generated by other processes + (non-master processes) get stuck in the job's stdout file, so users + may want to archive job output files as well as component model logs. + In addition, when debugging problems with the model system, certain + error messages which may have previously appeared in component model + logs may now appear in the job output. + + M src/dynamics/fv/trac2d.F90 + M src/dynamics/fv/cd_core.F90 + Removed streaming directives for COUP_CSM mode where a routine is called + from within a streaming region. This problem does not exist in stand-alone + CAM mode, but causes the system to hang or crash in coupled mode. This is + bug will be reported to Cray, but a fix has currently been implemented so + that production runs can occur on phoenix. + the following changes was made for cpp directives: + #if defined(USE_OPM => #if (!definedUSE_OMP) && (!defined COUP_CSM) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: no pre-tag testing was done + +tempest: no pre-tag testing was done + +bangkok/lf95: no pre-tag testing was done + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_3_0 +Originator(s): Mariana Vertenstein +Date: 4/18/2006 +One-line Summary: Directory restructuring for sequential ccsm + +Purpose of changes: + Create new directory structure and mct file renaming for + the next step in the creation of a sequential ccsm starting + from stand-alone cam and for the next step in the ESMF stage + 1 evaluation effort. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: + bld/configure was changed to take into account the new directory + structure and to remove the obsolete mode for the sea ice package "ccmice" + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Myself, Brian Eaton + +List all subroutines eliminated: +List all subroutines added and what they do: +The following lists the directory restucturing and file renaming that was done + + D atm/cam/src/ocnsice/dom/sst_data.F90 => A models/ocn/dom/sst_data.F90 + D atm/cam/src/ocnsice/dom/ocn_types.F90 => A models/ocn/dom/ocn_types.F90 + D atm/cam/src/ocnsice/dom/albocean.F90 => A models/ocn/dom/albocean.F90 + D atm/cam/src/ocnsice/dom/print_coverage.F90 => A models/ocn/dom/print_coverage.F90 + D atm/cam/src/ocnsice/dom/parpbl.h => A models/ocn/dom/parpbl.h + D atm/cam/src/ocnsice/dom/ocn_comp.F90 => A models/ocn/dom/ocn_comp.F90 + D atm/cam/src/ocnsice/dom/albedo.h => A models/ocn/dom/albedo.h + D atm/cam/src/ocnsice/dom/wtrc_flxoce.F90 => A models/ocn/dom/wtrc_flxoce.F90 + D atm/cam/src/ocnsice/dom/MCT_ocn_comp.F90 => A models/ocn/dom/flxoce.F90 + D atm/cam/src/ocnsice/dom/flxoce.F90 => A models/ocn/dom/ocn_comp_mct.F90 + D atm/cam/src/ocnsice/dom/srfoce.F90 => A models/ocn/dom/srfoce.F90 + + D atm/cam/src/ocnsice/som/ocn_types.F90 => A models/ocn/som/ocn_types.F90 + D atm/cam/src/ocnsice/som/albocean.F90 => A models/ocn/som/albocean.F90 + D atm/cam/src/ocnsice/som/mixed_layer_globalcalcs.F90 => A models/ocn/som/mixed_layer_globalcalcs.F90 + D atm/cam/src/ocnsice/som/ocn_srf.F90 => A models/ocn/som/ocn_srf.F90 + D atm/cam/src/ocnsice/som/parpbl.h => A models/ocn/som/parpbl.h + D atm/cam/src/ocnsice/som/somint.F90 => A models/ocn/som/somint.F90 + D atm/cam/src/ocnsice/som/ocn_comp.F90 => A models/ocn/som/ocn_comp.F90 + D atm/cam/src/ocnsice/som/ocean_data.F90 => A models/ocn/som/ocean_data.F90 + D atm/cam/src/ocnsice/som/somini.F90 => A models/ocn/som/somini.F90 + D atm/cam/src/ocnsice/som/MCT_ocn_comp.F90 => A models/ocn/som/flxoce.F90 + D atm/cam/src/ocnsice/som/flxoce.F90 => A models/ocn/som/ocn_comp_mct.F90 + + D ice/csim4/MCT_ice_comp.F90 => A models/ice/csim4/ice_comp_mct.F90 + + A models/drv/seq_mct/seq_mct_mod.F90 + D atm/cam/src/control/MCT_atmocn_cpl.F90 => A models/drv/seq_mct/map_atmocn_mct.F90 + D atm/cam/src/control/MCT_atmlnd_cpl.F90 => A models/drv/seq_mct/map_atmlnd_mct.F90 + D atm/cam/src/control/MCT_iceocn_cpl.F90 => A models/drv/seq_mct/map_iceocn_mct.F90 + D atm/cam/src/control/MCT_atmice_cpl.F90 => A models/drv/seq_mct/map_atmice_mct.F90 + D atm/cam/src/control/MCT_lndhub_comp.F90 => A models/drv/seq_mct/mrg_x2l_mct.F90 + D atm/cam/src/control/MCT_atmhub_comp.F90 => A models/drv/seq_mct/mrg_x2a_mct.F90 + D atm/cam/src/control/MCT_icehub_comp.F90 => A models/drv/seq_mct/mrg_x2i_mct.F90 + D atm/cam/src/control/MCT_ocnhub_comp.F90 => A models/drv/seq_mct/mrg_x2o_mct.F90 + D atm/cam/src/control/MCT_seq.F90 => A models/drv/seq_mct/seq_mct_init.F90 + D atm/cam/src/control/cam.F90 => A models/drv/seq_mct_drv/seq_ccsm_drv.F90 + D atm/cam/src/control/seq_fields_indices.F90 => A models/drv/seq_flds_indices/seq_flds_indices.F90 + D atm/cam/src/control/seq_fields_mod.F90 => A models/drv/seq_flds/default/seq_flds_mod.F90 + + D atm/cam/src/control/MCT_atm_comp.F90 => A models/atm/cam/src/control/atm_comp_mct.F90 + +List all existing files that have been modified, and describe the changes: + + M atm/cam/tools/scam/configure + M atm/cam/tools/scam/scm_init/init_model.F90 + M atm/cam/tools/scam/scm_init/scam_srfdata_MCT.F90 + M atm/cam/tools/scam/scm_init/scam_run.F90 + M atm/cam/bld/configure + Modified these files to work with above directory restructuring and file renaming + + M models/SVN_EXTERNAL_DIRECTORIES + Modified to use clm branch tag cammct05_clm3_expa_58 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. => All failed tests must be justified. + +bluesky: None + +tempest: None + +bangkok/lf95: None + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_60 (this is the previous tag) + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_60 +Originator(s): Mariana Vertenstein +Date: 4/11/2006 +One-line Summary: Introduction of MCT CAM-surface coupling + +Purpose of changes: + Incoporate MCT cam-surface component coupling for all + CAM surface components. Introduce the appropriate thin-layer + design for MCT coupling that can also be extended to ESMF. + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + ***These have to still be determined*** + +Code reviewed by: + Erik Kluzek + +List all subroutines eliminated: + D atm/cam/src/physics/cam1/camhub_comp.F90 + +List all subroutines added and what they do: + + A atm/cam/src/control/MCT_atmhub_comp.F90 + A atm/cam/src/control/MCT_lndhub_comp.F90 + A atm/cam/src/control/MCT_ocnhub_comp.F90 + A atm/cam/src/control/MCT_icehub_comp.F90 + -introduced these routines to merge necessary + input for atm, lnd, ocn and ice states + (e.g. MCT_atm_hub_comp.F90 merges lnd,ocn and ice + states and fluxes to create the necessary input + atm attribute vector) + These hub component routines act only on MCT attribute vectors + + A atm/cam/src/control/MCT_atmlnd_cpl.F90 + A atm/cam/src/control/MCT_iceocn_cpl.F90 + A atm/cam/src/control/MCT_atmocn_cpl.F90 + A atm/cam/src/control/MCT_atmice_cpl.F90 + A atm/cam/tools/scam/scm_init/scam_srfdata_MCT.F90 + -introduced new MCT couplers + (e.g. MCT_atmlnd_cpl.F90 maps between atm and lnd domains) + These couplers act only on MCT attribute vectors + + A atm/cam/src/ocnsice/dom/ocn_types.F90 + -introduced new dom specific data structures (ocn_in, ocn_out) + so that MCT could map directory to the dom input/output states + A atm/cam/src/ocnsice/som/ocn_types.F90 + -introduced new som specific data structures (ocn_in, ocn_out) + so that MCT could map directory to the dom input/output states + A ice/csim4/ice_types.F90 + -introduced new csim specific data structures (ice_in, ice_out) + so that MCT could map directory to the dom input/output states + + A ice/csim4/MCT_ice_comp.F90 + -introduced MCT_ocn_comp.F90 that map MCT attribute vectors + to ice_in and ice_out to MCT attribute vectors + A atm/cam/src/ocnsice/dom/MCT_ocn_comp.F90 + -introduced MCT_ocn_comp.F90 that map MCT attribute vectors + to ocn_in and ocn_out to MCT attribute vectors + A atm/cam/src/ocnsice/som/MCT_ocn_comp.F90 + -introduced MCT_ocn_comp.F90 that map MCT attribute vectors + to ocn_in and ocn_out to MCT attribute vectors + + A atm/cam/src/control/seq_fields_indices.F90 + -contains integer indices for all possible character strings that + represent cam and cam surface model couling + A atm/cam/src/control/con_cam.F90 + -replaced part of cam.F90 that dealt with running cam in COUP_CSM mode + +List all existing files that have been modified, and describe the changes: + + M ice/csim4/ice_data.F90 + -removed srfflx_state2d from input argument and replaced it with frac + (frac a frac_t defined type now specific to ice/csim4) + M ice/csim4/ice_dh.F + -renamed surface_state2d -> ice_in (where ice_in is now of type ice_in_t not surface_state) + A ice/csim4/print_coverage.F90 -> D atm/cam/src/ocnsice/som/print_coverage.F90 + M ice/csim4/ice_srf.F90 + -renamed surface_state2d -> ice_in (where ice_in is now of type ice_in_t not surface_state) + M ice/csim4/ice_diagnostics.F + -renamed surface_state2d -> ice_in (where ice_in is now of type ice_in_t not surface_state) + D ice/csim4/camice.F90-> A ice/csim4/ice_comp.F90 + -renamed camice.F90 -> ice_comp.F90 and introduced ice_in and ice_out + states to replace srfflx_parm2d_ocn, srfflx_state2d. + -added functionality to read landfrac from cam initial file and store it + as a module variable, rather than use it from camsrf. + + M atm/cam/tools/scam/configure + M atm/cam/tools/scam/testscript + M atm/cam/tools/scam/scm_init/init_model.F90 + M atm/cam/tools/scam/scm_init/scam_srfdata.F90 + M atm/cam/tools/scam/scm_init/scam_run.F90 + M atm/cam/tools/scam/scm_init/inital.F90 + M atm/cam/tools/scam/scm_init/scamMod.F90 + M atm/cam/tools/scam/ui/configure + -incorporated changes into above scam routines so that + they could work with new MCT coupling to surface models + + M atm/cam/tools/cprnc/Makefile + + M atm/cam/src/control/MCT_atm_comp.F90 + -introduced MCT_ocn_comp.F90 that map MCT attribute vectors + to cam_in and cam_out to MCT attribute vectors + M atm/cam/src/control/ccsm_msg.F90 + -extended restart functionality to use logic previously in restart_physics + M atm/cam/src/control/cam.F90 + -this is now a top level MCT coupling driver for stand-alone CAM + M atm/cam/src/control/seq_fields_mod.F90 + -generalized routine to account for cam-ice and cam-ocn coupling + M atm/cam/src/control/restart.F90 + -made changes to removed srfflx_parm and srfflx_state from camsrfexch_typees + M atm/cam/src/control/startup_initialconds.F90 + -removed call to close ncid_topo + -removed srfflx_state2d argument to read_inidat and initial_conds + M atm/cam/src/control/cam_comp.F90 + -removed srfflx_parm from camsrfexch_types use + -removed cam_in from call to cam_initial and read_restart + -added call to hub2atm_alloc + + M atm/cam/src/physics/cam1/comsrf.F90 + -removed snowhland, tsocn and renamed landfrac_field->landfrac_glob + M atm/cam/src/physics/cam1/diagnostics.F90 + -removed outfld calls for TBOT,SNOWHLND,TSOCN + -removed comsrf uses for tsocn + -removed snowhland as input argument + M atm/cam/src/physics/cam1/tphysbc.F90 + -removed snowh ans input argument + M atm/cam/src/physics/cam1/restart_physics.F90 + -removed calls to output srfflx_state2d fields - moved these to + ccsm_msg.F90 and MCT_atmhub_comp.F90. + M atm/cam/src/physics/cam1/physpkg.F90 + D atm/cam/src/physics/cam1/camsrfexch_types.F90 -> A atm/cam/src/control/camsrfexch_types.F90 + -removed module routines bounding, verify_fractions, srfflx_parm_reset, + srfcomp2hub_alloc + -renamed atm2srf_alloc->atm2hub->alloc + -removed srfflx_parm derived type and added snowhland as part of srfflx_state + definition + D atm/cam/src/physics/cam1/srfxfer.F90 -> A atm/cam/src/control/srfxfer.F90 + -cosmetic changes only + M atm/cam/src/physics/cam1/tphysac.F90 + -removed snowh as input argument + M atm/cam/src/ocnsice/dom/sst_data.F90 + - removed landfrac from argument list + M atm/cam/src/ocnsice/dom/albocean.F90 + - removed landfrac from argument list + D atm/cam/src/ocnsice/dom/camoce.F90 -> A atm/cam/src/ocnsice/dom/ocn_comp.F90 + -renamed camoce.F90 -> ocn_comp.F90 and introduced ocn_in and ocn_out + states to replace srfflx_parm2d_ocn, srfflx_state2d. + -added functionality to read landfrac from cam initial file and store it + as a module variable, rather than use it from camsrf. + -introuced ocn_IC_OUTPUT routine to output TSOCN to initial file. + + M atm/cam/src/ocnsice/som/albocean.F90 + - removed landfrac from argument list + D atm/cam/src/ocnsice/som/print_coverage.F90 + -removed routine, no longer needed + M atm/cam/src/ocnsice/som/mixed_layer_globalcalcs.F90 + -added landfrac_glob to argument list, replace landfrac_field->landfrac_glob + M atm/cam/src/ocnsice/som/ocn_srf.F90 + -removed Tffresh, rhow, cp_ocn from ice_constants use statement and used + SHR_CONST_ROWSW, SHR_CONST_CPSW and SHR_CONST_TKFREZ from shr_const_mod instead + D atm/cam/src/ocnsice/som/somoce.F90 -> A atm/cam/src/ocnsice/som/ocn_comp.F90 + -renamed somoce.F90 -> ocn_comp.F90 and introduced ocn_in and ocn_out + states to replace srfflx_parm2d_ocn, srfflx_state2d. + -added functionality to read landfrac from cam initial file and store it + as a module variable, rather than use it from camsrf. + -introuced ocn_IC_OUTPUT routine to output TSOCN to initial file. + -added landfrac_glob as argument to gmean and check_conservation calls + -repalce Focn->ocn_out%frzmlt + -removed use of camice (Focn, frzmlt, aice, sicthk, snowhice now obtained + via ocn_in and ocn_out) + -removed ice_constants use for rhow, cp_ocn and used + SHR_CONST_ROWSW, SHR_CONST_CPSW from shr_const_mod instead + + M atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 + M atm/cam/src/chemistry/trop_mozart/chemistry.F90 + -removed snowhland from camsrf use and added to argument list (part of cam_in) + + M atm/cam/src/dynamics/sld/stepon.F90 + M atm/cam/src/dynamics/eul/stepon.F90 + -removed srfflx_state and srfflx_parm use statements + + M atm/cam/src/dynamics/sld/inidat.F90 + M atm/cam/src/dynamics/eul/inidat.F90 + M atm/cam/src/dynamics/fv/inidat.F90 + -changed varialbe names (surface_state->cam_out) + -introduced landfrac_glob and removed use of landfrac from comsrf + -removed srfflx_state use from camsrfexch_types + + M atm/cam/src/dynamics/sld/inital.F90 + M atm/cam/src/dynamics/eul/inital.F90 + M atm/cam/src/dynamics/fv/inital.F90 + -changed varialbe names (surface_state->cam_out) + -removed srfflx_state2d as input argument + -removed call to hub2atm_alloc and renamed atm2srf_alloc->atm2hub_alloc + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + 005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 + 019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 + 022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + 030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 + 034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 + 037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 + 040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + 044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 + 047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 + 054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 + All these tests only contain differences in the following fields + LHFLXOI, SHFLXOI, FSNSOI + with RMS values on the order of 1.e-15 + In addition, TBL.f2h.outfrq24h contained a difference in QFLX on the order of 1.-e23 + So even though the TBL tests fail, this tag does not change answers. + +tempest: + 014 bl152 TBL.sh e64o outfrq24h -2 ................................FAIL! rc= 7 + diffs set in at NSTEP=47 + 021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 + only QRS is different in cprnc.out with an RMS on the order of 3.e-24 + 024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 + only SNOWHICE is different in cprnc.out with an RMS on the order of 1.e-23 + 031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 + only VD01 is different in cprnc.out with an RMS on the order of 4.e-25 + +bangkok/lf95: + 012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 + diffs set in at NSTEP=29 + 016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 + differences are only in SHOWHICE with RMS value of 5.e-21 + 028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 + diffs set in at nstep=9 + 040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + diffs set in at nstep=3 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_59 +Originator(s): mvr, eaton, edwards +Date: 4/6/06 +One-line Summary: collection of bug fixes + +Purpose of changes: +bug fixes for ccsm testing, cray directive on phoenix, compiler workaround +on bluevista, coupled runs on tempest; added cron scripts to repository + +Bugs fixed (include bugzilla ID): +bug#68 is resolved + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton, edwards + +List all subroutines eliminated: +D models/atm/cam/test/system/td_nightly_aix.sh +D models/atm/cam/test/system/td_nightly_linux.sh +- post-tag cron jobs were renamed + +List all subroutines added and what they do: +A + models/atm/cam/test/system/posttag_cron_bangkok.sh +A + models/atm/cam/test/system/posttag_cron_bluesky.sh +A models/atm/cam/test/system/posttag_cron_lightning.sh +A models/atm/cam/test/system/posttag_cron_bluevista.sh +- post-tag cron job scripts for machine-specific testing of cam + +List all existing files that have been modified, and describe the changes: +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/TCB.ccsm.sh +- mods to make cam's ccsm test scripts compatible with changes in ccsm scripts + +M models/atm/cam/test/system/test_driver.sh +M models/atm/cam/test/system/CAM_runcmnd.sh +- test scripts now use unix utility 'hostname' to determine local machine + +M models/atm/cam/src/physics/cam1/dmsbnd.F90 +- removed debug print statement left behind - trips up coupled runs on tempest + +M models/atm/cam/src/physics/cam1/physpkg.F90 +- added workaround for code introduced in cam3_2_58 which trips xlf bug on bluevista + +M models/atm/cam/src/dynamics/fv/fv_prints.F90 +- fix of bug in cpp definition CPP_PRT_PREFIX on phoenix + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: all PASS + +tempest: all PASS + +bangkok/lf95: all PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_58 +Originator(s): Jim Edwards +Date: 4/4/2006 +One-line Summary: changes for ncol dataset support + +Purpose of changes: Allows data input on non-rectangular grids using an alternative input file format + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: none, no new boundary datasets + are provided at this time + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, Eaton + +List all subroutines eliminated: renamed file zonalbndydata.F90 to boundarydata.F90 + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + renamed file zonalbndydata.F90 to boundarydata.F90 + dmsbnd.F90 prescribed_aerosols.F90 : added support for ncol based input dataset + chemistry.F90 ozone_data.F90: changed module names from zonalndydata to boundarydata + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: one fails + 055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 + + That's due to a change in the CCSM scripts in ccsm3_1_beta24. The test + passes when run in ccsm3_1_beta23. Mat is modifying the CAM test to work + with the new CCSM scripts. + +tempest: all pass + +bangkok/lf95: all pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_57 +Originator(s): pworley +Date: Sun Apr 2 12:22:18 MDT 2006 +One-line Summary: Performance optimizations, primarily for Cray-X1E + +Purpose of changes: + + To restore X1E performance lost in recent check-ins; to fix X1E and XT3 + bugs. + +Bugs fixed (include bugzilla ID): + + PGI compile problem; aqua planet error on X1E. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Performance on X1E doubled compared to 3_2_56 when running T85 on 128 + processors. + +Code reviewed by: myself, eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + a) Vectorized routines chunk_to_buff and buff_to_chunk used by MCT in + land/atmosphere communication and in coupler/atmosphere communication: + + M atm/cam/src/physics/cam1/phys_grid + - buff_to_chunk, chunk_to_buff: interface clean up and vector-friendly + reimplementation + + M atm/cam/src/control/ccsm_msg.F90 + M atm/cam/src/control/MCT_atm_comp + - changed parameters in calls to buff_to_chunk and chunk_to_buff + + b) Fixed bug on X1E caused by diagnostic message output inside streamed + code segment + + M atm/cam/src/dynamics/fv/fill_module.F90 + - surrounded (non fatal) error test with ifdef DEBUG cpp logic + + c) Introduced workaround for PGI compiler bug + + M lnd/clm2/src/biogeophys/Hydrology2Mod.F90 + - removed unnecessary "use" of spmdMod + + d) Optimized performance of MCT Rearranger routine + + M utils/mct/mct/m_Rearranger + - added new optional parameter ALLTOALL and modified code in rearrange_ + to implement an MPI_Alltoallv option for interprocessor communication. + - reordered the send/receive pattern for the non-ALLTOALL implementation + to decrease link and processor contention. + - Reduced number of allocate/deallocate requests. + + M utils/mct/mpi-serial/collective.c + M utils/mct/mpi-serial/mpi.h + - add mpi_alltoallv interfaces (from Ray Loy) + + M lnd/clm2/src/main/MCT_atmlnd_cpl + - added optional parameters VECTOR and ALLTOALL to calls to MCT_Rearrange, + setting VECTOR to .true. if CPP_VECTOR is defined, and setting + ALLTOALL to .true. if SYSUNICOS is defined. Otherwise they are + set to .false. . + + Note that ALLTOALL=.true. may be a better choice for all systems, + but I have only verified this on the X1E. + + e) Improved vector performance in CLM/MCT interface. + + M lnd/clm2/src/main/MCT_lnd_comp + - made minor change to index logic to improve vectorization on the X1E + + f) Improved performance (both vector and nonvector) in routines that + map to/from CLM grid + + M areaMod + - added support for mapping multiple fields in one call to + gridmap_mapparray + - reimplemented gridmap_mapparray to improve vector performance, + incuding changing calling interface + + M clm_atmlnd + - modified logic in clm_mapa2l and clm_mall2a to call gridmap_array once + for all fields + - made other minor modifications to improve vectorization + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS except: + 055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 + + That's due to a change in the CCSM scripts in ccsm3_1_beta24. The test + passes when run in ccsm3_1_beta23. Mat is modifying the CAM test to work + with the new CCSM scripts. + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_56 +Originator(s): mvr +Date: 3/27/06 +One-line Summary: +test_driver.sh made to run interactive; test scripts modified for use +on lightning, bluevista; new tests added; some bugs fixes + +Purpose of changes: +wanted to test on lightning, bluevista + +Bugs fixed (include bugzilla ID): +ccsm tests work again + +Describe any changes made to build system: +LAPACK library replaced with ESSL library as default for WACCM_MOZART +configurations on AIX + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself, eaton + +List all subroutines eliminated: +D atm/cam/test/system/input_tests_aix +D atm/cam/test/system/input_tests_linux +D atm/cam/test/system/input_tests_irix +D atm/cam/test/system/input_tests_aix_nightly +D atm/cam/test/system/input_tests_linux_nightly +- these files were renamed + + +List all subroutines added and what they do: +A + atm/cam/test/system/tests_pretag_bluesky +A + atm/cam/test/system/tests_pretag_bangkok +A + atm/cam/test/system/tests_pretag_tempest +A + atm/cam/test/system/tests_posttag_bluesky +A + atm/cam/test/system/tests_posttag_bangkok +- newly renamed files + +A atm/cam/test/system/tests_posttag_bluevista +A atm/cam/test/system/tests_posttag_lightning +- new files containing tests for respective platforms + +A atm/cam/test/system/config_files/f1.9h +- new config options file for testing fv 1.9x2.5 resolution +A atm/cam/test/system/TPF.sh +- new test script for performance testing + + +List all existing files that have been modified, and describe the changes: +M atm/cam/test/system/test_driver.sh +- made to run interactive (ie will create/spawn command file to machine's + batch queue); added support for lightning, bluevista; added env var to + specify ccsm tag to be used for testing +M atm/cam/test/system/CAM_runcmnd.sh +- added logic for setting run command on lightning, bluevista +M atm/cam/test/system/TCB.sh +- uses new env var for setting options to configure +M atm/cam/test/system/TSB.ccsm.sh +- bug with ccsm test now fixed - files/dirs now compatible with ccsm scripts +M atm/cam/test/system/TCB.ccsm.sh +- now specifies resources for ccsm test; general cleanup +M atm/cam/test/system/TBL.sh +- minor cleanup +M atm/cam/test/system/td_nightly_aix.sh +- posttag cron script modified with new call to test_driver.sh; + now spawns testing on lightning, bluevista +M atm/cam/test/system/td_nightly_linux.sh +- posttag cron script modified with new call to test_driver.sh +M atm/cam/test/system/input_tests_master +- added performance test, ccsm test w/bgc, ccsm test w/trop_mozart chemistry +M atm/cam/test/system/tag_email.sh +- posttag cron script now used 'mail' to notify developers of new tag +M atm/cam/bld/configure +- now uses ESSL rather than LAPACK library for waccm_mozart on aix + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 +- compatibility bug w/ccsm scripts fixed, this test should pass going forward + +tempest: +- none + +bangkok/lf95: +004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 5 +008 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 5 +010 bl113 TBL.sh e8pdm aqpgro 3 ...................................FAIL! rc= 5 +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 5 +016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 5 +024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 5 +026 bl313 TBL.sh f10pdm aqpgro 3 ..................................FAIL! rc= 5 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 5 +032 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 5 +036 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 5 +038 bl513 TBL.sh s8pdm aqpgro 3 ...................................FAIL! rc= 5 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 5 +- baseline tests failed due to change in env vars used in testing; these tests + should pass going forward + +CAM tag used for the baseline comparison tests if different than previous +tag: ccsm testing used cam3_2_51 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_55 +Originator(s): Francis Vitt +Date: Fri Mar 24 16:51:04 MST 2006 +One-line Summary: Fixed bug in mo_drydep.F90 + +Purpose of changes: To compile and run on lighting + +Bugs fixed (include bugzilla ID): 60 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + +Code reviewed by: Jeff Lee ( Yen-Huei Lee) + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +U models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + changed parameter n_drydep_species from 52 to 53 + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + Dry deposition species have changed. Bit for bit comparison to + previous version is expected to fail. +055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 + CCSM scripts have changed causing this test to fail + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_54 +Originator(s): Jim Edwards +Date: 03/21/06 12:36PM +One-line Summary: addresses bug reported in http://bugs.cgd.ucar.edu/show_bug.cgi?id=56 + +Purpose of changes: + +Bugs fixed (include bugzilla ID): 56 ccsm cannot read co2 data file + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + co2_data_flux.F90 changed variable for date and sec to explicitly allocated + arrays. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +This file is used only with ccsm, no stand-alone tests are available. We have confirmed the +change using ccsm3_1_beta23. + +=============================================================== +=============================================================== + +Tag name: cam3_2_53 +Originator(s): Francis Vitt +Date: Thu Mar 16 09:00:35 MST 2006 + +One-line Summary: + Changes to trop_mozart chemistry for CCSM coupled mode. + +Purpose of changes: + To run CAM with trop_mozart in CCSM and pass acceptance tests + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + New initial coniditions files are used from trop_mozart chemistry. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/bld/DefaultCAMEXPNamelist.xml + changed IC data files for trop_mozart + + models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + Changed loop indexing where constituent fields are output + to history file to be compatable with BGC package + + models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + Added H2 to the dry deposition species list + + models/atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 + Initialize surface fluxes to zero before setting to data + + models/atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 + Increaesed the length of filename to 265 characters + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + These bit-for-bit comparisons to the previous version of trop_mozart + chemistry are expected fail since H2 was added to dry deposition + and different initial conditions are used + +055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 + CCSM scripts have changed causing this test to fail + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name:cam3_2_52 +Originator(s): Jim Edwards +Date: Thu Mar 9 17:11:49 MST 2006 +One-line Summary: netcdf f90 interface, interpaerosols update + +Purpose of changes: non lat/lon grid integration + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: copies of bilin and kinds were eleminated from + the interpaerosols directory; subroutine lininterp was overloaded to + avoid several names for the same basic functionality + +List all subroutines added and what they do: lininterp2d1d - interpolate from a 2d lat/lon field to a 1d ncols field - this subroutine is private in interpolate_data.F90 and accesible through the lininterp interface. + +List all existing files that have been modified, and describe the changes: +A host of files were changed in the physics/cam1 directory to move from netcdf f77 interface to the f90 interface. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + +tempest: + +bangkok/lf95: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== + +Tag name: cam3_2_51 +Originator(s): eaton +Date: Fri Feb 17 18:27:20 MST 2006 +One-line Summary: configure and Makefile mods + +Purpose of changes: + + . Modify Makefile to enable threading with lf95 and pathf90. + *** N.B. *** lf95 (v6.2) still has severe per thread stacksize limits. + I was only able to get threading to work with the --threadheap option + which puts the thread memory on the heap. That option however doesn't + work with debug flags -g, --chk, or --chkglobal. Set up the Makefile + to allow threading only in non-debug mode. + + . Modify configure so that the checks for include files and libraries are + not done when the -ccsm flag is set since the CAM Makefile is not used + in that case. + + . Modify configure to require that the configure script and all + associated configuration files live in a specified subdirectory of the + source tree for the source being built. This is for robustness. Using + configure with source or configuration files from outside a source tree + that represents a fixed source version is fraught with peril. + + . Add -linker option to the configure script to enable specifying a + linker which is different from the Fortran compiler. This is + particulary useful on Linux platforms where specifying mpif90 as the + linker automatically provides the correct linkage for the MPI + libraries. Note that this depends on the user's PATH being set so that + the correct mpif90 is used, i.e., the one that's consistent with the + Fortran compiler being used. + + . Modify configure to run its tests in a subdirectory of the CAM build + directory. This avoids having the Makefile build the dependency list + for the full CAM just to run the tests, and consequently they run much + faster. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: described above + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: + + bld/Makefile -- renamed Makefile.in + +List all subroutines added and what they do: + + bld/Makefile.in -- was Makefile + +List all existing files that have been modified, and describe the changes: + + bld/configure + . Remove -cam_cfg option and CAM_CFGDIR environment variable: require all + configuration files to be in the same directory as the configure script. + . remove -cam_root option and CAM_ROOT environment variable: require + configure to be located in the CAM src tree. + . Modifications for CCSM build: delete setting of locations for all + external include/mod/lib directories. These are only needed for the CAM + Makefile which is not produced when doing a CCSM build. + . Remove -esmf_* options. This was used with the ESMF prototype library + which is no longer supported. Will re-implement ESMF options when we + start linking the new ESMF library. + . add -linker option + . use it to set the USER_LINKER macro in the Makefile + . Run tests in a subdirectory of the CAM build directory. + + bld/Makefile.in + . add "--openmp --threadheap 4096" to FFLAGS and LDFLAGS when SMP is + defined for lf95 compiler + . add -mp to FFLAGS and LDFLAGS when SMP is defined for pathf90 compiler + . Remove default settings of macros that are set by configure. + . Remove ESMF macros except for ESMF_MOD and ESMF_LIB. Currently these are + not set by configure, but they will be when we start linking to the ESMF + library. + . add LINKER macro to be used to link cam executable. + . set LINKER to $(USER_LINKER) if it's defined, otherwise use platform + default which is $(FC) on most platforms, but is "$(CC) -f90lib" on the + SX6 and ES. + + bld/mkDepends + . add fix from Tom Henderson to include Fortran syntax includes in the + dependencies (previously only recognized cpp syntax). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + NONE + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_50 +Originator(s): eaton +Date: Sat Feb 4 08:28:03 MST 2006 +One-line Summary: Fix FV memory leak & non-adv tracers. SCAM bugfixes. Fix Cray build problem. + +Purpose of changes: + + 1. Fix for FV memory leak found by Siddhartha Ghosh + + 2. Mods FV dycore from Jean-Francois Lamarque to advect only the advected + constituents + + 3. Mod from Rob Jacob to fix the MCT problem on the Cray (replace + "system" call with "ishell") + + 4. Bug fixes for scam from John Truesdale + . Corrects a C++ usage error when using the newest gcc compiler + . Allows the model to use scam generated initial conditions. + . Allows the model to use user generated data for input. + +Bugs fixed (include bugzilla ID): + + Described in Purpose of changes section. The memory leak in FV is + bugzilla ID 26. + +Describe any changes made to build system: + + Define the SYSUNICOS cpp macro when running on Cray. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + 1. FV memory leak + dynamics/fv/FVCAM_GridCompMod.F90 + . move allocation of q_internal to top of run method, and deallocation to + bottom of method -- like all the rest of the allocation/deallocation + pairs. + + 2. Mods FV dycore + dynamics/fv/FVCAM_GridCompMod.F90 + . call create_vars with ntotq as actual arg rather than nq + dynamics/fv/inital.F90 + . use pcnst as actual arg corresponding to dummy arg nq in Initialize arg + list + dynamics/fv/restart_dynamics.F90 + . use pcnst as actual arg corresponding to dummy arg nq in Initialize arg + list + + 3. Mod to fix the MCT problem on the Cray + bld/Makefile + . add -DSYSUNICOS to FPPFLAGS for UNICOS/mp build + + 4. Bug fixes for scam + scm_init/runtype.h + scm_init/readsaveinit.F90 + ui/LoadData.ui + ui/plot.h + ui/dataset.cpp + ui/LoadDataImpl.cpp + ui/ncfile.h + + Changes to external code: + + The following fix was made in $SVNREPOS/mct/trunk/mpeu + m_FileResolv.F90 + . use ishell rather than system command when SYSUNICOS is #define'd + + A new tag for MCT was created: $SVNREPOS/mct/mct/trunk_tags/MCT2_2_0_060203 + and CAM's external property for MCT was changed to that tag. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_49 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_49 +Originator(s): Tony Craig +Date: Thu Feb 2 11:10:17 MST 2006 +One-line Summary: + + Update CLM source code to clm3_expa_56 + +Purpose of changes: + + Bring in a latest version of clm3 which includes changes in + infrastructure to support finemesh integrations. This version + of clm is 100% backward compatable with namelist and datasets + and is bfb with recent version of clm3. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new optional namelist + added to clm, fatmgrid. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: tcraig, mvr + +List all subroutines eliminated: No changes in CAM + +List all subroutines added and what they do: No changes in CAM + +List all existing files that have been modified, and describe the changes: + No changes in CAM + +models/lnd/clm2/src/main: + initGridIndexMod.F90,lnd2atmMod.F90,CNiniTimeVar.F90, + abortutils.F90,clm_comp.F90,driver.F90,clm_camMod.F90,atmdrvMod.F90, + subgridRestMod.F90,accFldsMod.F90,clmtypeInitMod.F90,initializeMod.F90, + pftdynMod.F90,iniTimeConst.F90,histFileMod.F90,program_csm.F90, + clm_atmlnd.F90,clm_varsur.F90,clm_csmMod.F90,restFileMod.F90, + surfFileMod.F90,controlMod.F90,initSurfAlbMod.F90,initSubgridMod.F90, + clm_varctl.F90,ndepFileMod.F90,initGridCellsMod.F90,MCT_lnd_comp.F90, + program_off.F90,domainMod.F90,decompMod.F90,areaMod.F90,clmtype.F90, + histFldsMod.F90 + +models/lnd/clm2/src/riverroute: + RtmMod.F90 + +models/lnd/clm2/src/biogeochem: + CASAMod.F90,DUSTMod.F90,CNPhenologyMod.F90,STATICEcosysDynMod.F90, + DGVMMod.F90,CNrestMod.F90,VOCEmissionMod.F90,CNNDynamicsMod.F90, + CNVegStructUpdateMod.F90 + +models/lnd/clm2/src/biogeophys: + BalanceCheckMod.F90,SurfaceRadiationMod.F90,SoilTemperatureMod.F90, + Biogeophysics1Mod.F90,Biogeophysics2Mod.F90,FrictionVelocityMod.F90, + Hydrology1Mod.F90,Hydrology2Mod.F90,BiogeophysicsLakeMod.F90, + HydrologyLakeMod.F90,BareGroundFluxesMod.F90,CanopyFluxesMod.F90 + SurfaceAlbedoMod.F90 + +Code changes: *** Only in clm code *** + Merge atm2lnd_state_type, atm2lnd_flux_type. Same for lnd2atm state/flux. + Related changes in clm3 and elsewhere in code. + Add domainMod.F90 and domain_type. Migrate grid data into domain type. + Instantiate adomain(atm/coarse), ldomain(lnd/finemesh), rdomain(rtm), + ddomain(atmdrv external data) in model. + Add lats, latn, lonw, lone 2d arrays and associated code changes. + Cleanup areaMod.F90; merging subroutines, removing redundant code, eliminate + *_point routines. + Remove numlon + Add decomp_type for gcelldc and gcellsn. Remove redundant data in other + arrays related to addressing physical space and logical space. + Clean up interface in set_landunit subroutines. Remove redundant code. + Clean up procs and clumps datatypes, removing redundant data. + Migrate clm3 topology data to pointers from copies + Add gridmap_type for interpolation and associated code and routines to + support the type. + Add clm_atmlnd.F90 file for upscale/downscale code. Add clm_mapa2l + and clm_mapl2a to carry out mapping associated with upscale/downscale. + Add gridmap_setmapsFM for generation of weights for downscale/upscale + routines. + forc_ndep should not be in atm2lnd_type. + Reuse new code as much as possible throughout. + Rename latixy and longxy to latc and lonc. + Remove fullgrid attribute. + Add pftm to domain datatype and history file + Modify coupling to handle coarse <-> finemesh for standlaone, cam, and + ccsm. + Add normalized area to history files + Add lat_a, lon_a, latdeg_a, londeg_a to clm3 datatype for atm lats/lons. + required in SurfaceAlbedo computation where the the zenith angle has + to be based on the atm (coarse) grid, not the fine clm grid. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_48 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Answers are bit-for-bit. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== + +Tag name: cam3_2_48 +Originator(s): Francis Vitt +Date: +One-line Summary: + + Update to the tropospheric chemistry code and fixes to the offline driver. + +Purpose of changes: + + The updates to the tropospheric chemistry code where done to include + into CAM the latest MOZART chemistry and to provide the option to + to use interactive dry deposition and interactive photolysis rates + rather than the prescribed table look up methods. + + Changes to the offline dynamics driver were done to fix a total energy + conservation issue that was evident with simulations longer than two + months. A fix to a bug which occurred in high resolution runs is also + included. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +added: + + character(len=256) :: depvel_file + character(len=256) :: depvel_lnd_file + character(len=256) :: clim_soilw_file + character(len=256) :: season_wes_file + character(len=256) :: trop_pause_file + character(len=256) :: lght_landmask_file + real(r8) :: lght_no_prd_factor + logical :: xactive_prates + logical :: xactive_drydep + character(len=256) :: photopath + character(len=8) :: emis_type + integer :: emis_date + integer :: emis_yr_offset + character(len=256) :: met_filenames_list + +removed: + chem_config + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: Brian Eaton + +List all subroutines eliminated: + + models/atm/cam/src/chemistry/trop_mozart/mo_waccm_photo.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_read_chm_sim.F90 + models/atm/cam/src/chemistry/trop_mozart/phtadj.F90 + models/atm/cam/src/chemistry/trop_mozart/rxtmod.F90 + +List all subroutines added and what they do: + + models/atm/cam/src/chemistry/trop_mozart/mo_wavelen.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_cnum.F90 + models/atm/cam/src/chemistry/trop_mozart/mak_grp_vmr.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_phtadj.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_airmas.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_photoin.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setaer.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_trislv.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setair.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_waveall.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_seto2.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_tropopause.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_schu.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_rtlink.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_addpnt.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_constants.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_sim_dat.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_lymana.F90 + models/atm/cam/src/chemistry/trop_mozart/time_utils.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setz.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_calcoe.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_zadj.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_pchem.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_ps2str.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_sphers.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setozo.F90 + models/atm/cam/src/chemistry/trop_mozart/m_types.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_photo.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_tuv_inti.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_strato_sad.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_waveo3.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_rxt_mod.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setcld.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_xsections.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_drydep_tables.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_inter.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_wavelab.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_params.F90 + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/bld/config_trop_chem_mozart_defaults.xml + the number of advected constituents has changed to 99 for the tropospheric chemistry + models/atm/cam/bld/camexp.pm + models/atm/cam/bld/DefaultCAMEXPNamelist.xml + made changes to be consistent with the changes to the namelist variables + models/atm/cam/src/control/readinitial.F90 + moved from stepon the adjustment to the top interface pressure when zero + models/atm/cam/src/control/runtime_opts.F90 + see namelist changes above + models/atm/cam/src/control/wrap_nf.F90 + added subroutines wrap_inq_varndims and wrap_get_vara_text + models/atm/cam/src/control/history.F90 + made module variable fieldname_len public and increase its value to 16 + models/atm/cam/src/utils/string_utils.F90 + made GLC function public + models/atm/cam/src/physics/cam1/comsrf.F90 + added fsds field + models/atm/cam/src/physics/cam1/diagnostics.F90 + increased the length of string variable dcconnam + models/atm/cam/src/physics/cam1/tphysbc.F90 + changed the intent on fsds argument variable to inout + models/atm/cam/src/physics/cam1/check_energy.F90 + don't adjust the total global energy in offline mode + models/atm/cam/src/physics/cam1/restart_physics.F90 + models/atm/cam/src/physics/cam1/constituents.F90 + increased the length of string variable names + models/atm/cam/src/physics/cam1/physpkg.F90 + removed module variable fsds + models/atm/cam/src/physics/cam1/chemistry.F90 + made the chemistry interface consistent with trop_mozart + models/atm/cam/src/physics/cam1/tphysac.F90 + the arguments to subroutine chem_timestep_tend has changed + models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + increased the length of vdiffnam string variable + models/atm/cam/src/physics/waccm/chemistry.F90 + made the chemistry interface consistent with trop_mozart + models/atm/cam/src/chemistry/trop_mozart/mo_lu_solve.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_mean_mass.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_jlong.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_nln_matrix.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_lu_factor.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_ub_vals.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_indprd.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_aerosols.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_adjrxt.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_imp_sol.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_lin_matrix.F90 + models/atm/cam/src/chemistry/trop_mozart/m_rxt_id.F90 + models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_wetdep.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_setrxt.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_seasalt.F90 + models/atm/cam/src/chemistry/trop_mozart/chem_mods.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_prod_loss.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_usrrxt.F90 + models/atm/cam/src/chemistry/trop_mozart/m_het_id.F90 + models/atm/cam/src/chemistry/trop_mozart/m_spc_id.F90 + models/atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 + update the tropospheric chemistry code to be consistent with MOZART 4 + models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + made the chemistry interface consistent with trop_mozart + models/atm/cam/src/dynamics/fv/pfixer.F90 + changed variable names and cleaned up code + models/atm/cam/src/dynamics/fv/spmd_dyn.F90 + fixed a bug in compute_gsfactors which occurs when 2D decomposition is used + models/atm/cam/src/dynamics/fv/stepon.F90 + removed the adjustment to the top interface pressure if zero + models/atm/cam/src/dynamics/fv/metdata.F90 + Made changes to get the observed surface pressure at sub-timestep + interval times. This is needed for the high resolution bug fix. + models/atm/cam/src/dynamics/fv/FVCAM_GridCompMod.F90 + Made changes needed to fix the bug in the offline driver used in + high resolution simulations. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 + +Changes to the trop_mozart chemistry have caused the base line comparison +to fail as expected. + +tempest: All PASS + +bangkok/lf95: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_47 +Originator(s): eaton, mvr +Date: Thu Jan 19 12:01:57 MST 2006 +One-line Summary: + + Workaround for xlf90 (v9.1.0.3) bug (on bluevista) & test script updates. + +Purpose of changes: + + The workaround for the compiler bug allows running on bluevista. Note + that there is still an unresolved bug on the platform affecting the + trop_mozart chemistry mode. + + The TBR.sh test script has been modified to work around a GPFS + problem (sometimes files that have just been copied don't appear in the + output from an "ls" command executed in the directory that the files were + just copied to) which causes the branch test to fail intermittently on bluesky. + + Misc changes in the overnight test scripts. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: eaton, mvr + +List all subroutines eliminated: + + models/atm/cam/test/system/update_collections.sh + +List all subroutines added and what they do: + + models/atm/cam/test/system/tag_email.sh + +List all existing files that have been modified, and describe the changes: + + models/atm/cam/src/physics/cam1/physpkg.F90 + . in phys_init pass phys_state(begchunk:endchunk) to chem_init and + ozone_data_init + + models/atm/cam/test/system/TBR.sh + models/atm/cam/test/system/td_nightly_aix.sh + models/atm/cam/test/system/td_nightly_linux.sh + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_46 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Answers are bit-for-bit. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_46 +Originator(s): eaton +Date: Mon Jan 9 16:58:42 MST 2006 +One-line Summary: refactor restart logic and fix restart bug + +Purpose of changes: + + Provide control of when restart files are written that is decoupled from + the behavior of CAM's history file writes. + + Also did some cleanup work: + . get rid of anncyc, nlhst, itsst + . move nlres and lbrnch into restart module -- get it out of comctl.h + . call set_restart_filepath from restart_setopts -- remove from runtime_opts + . move the restart filepaths into the restart module -- get them out of filepaths.F90 + +Bugs fixed (include bugzilla ID): + + At cam3_2_24 the restart writes for fields needed by CAM's ocean and sea + ice modules were moved into the run methods for those modules. This broke + the writing of restart files in all situations except at the end of the + model run when the restart triggers off the nlend flag. + + The problem is that the calls to write the restart files for the ocean and + ice models are made before atm_run4 which makes the calls to write CAM's + history file. Since the old logic to determine when it's time to write a + restart file depended on the state in CAM's history module, and that state + was being updated after the calls to write the ocean and ice restart files, + the ocn and ice restarts were out of sync with CAM's restarts except when + nlend=.true. The fix was to implement a separate logic for writing restart + files that doesn't depend on the state of CAM's history module. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + + The namelist variables nrefrq and itsst have been eliminated. + + New namelist variables added: + logical :: no_restart ! true => turn off all restart writes (default: false) + integer :: restart_nsteps ! restart interval in steps + integer :: restart_nhours ! restart interval in hours + integer :: restart_ndays ! restart interval in days + logical :: restart_monthly ! true => write restart at begining of each month (default: true) + logical :: restart_yearly ! true => write restart at begining of each year + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens reviewed CLM code changes + +List all subroutines eliminated: + + control/rstwr.F90 + . remove this file -- subroutine added to restart module + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + control/cam.F90 + . change rstwr from external to local variable. add init before timestep + loop. + . add rstwr as actual arg to ocn_run, ice_run, atm_run4 + . add rstwr actual arg to clm_camRun (lnd_run) + + control/cam_comp.F90 + . add rstwr dummy arg to cam_run4 and remove the external declaration + . change write_restart call logic to only use rstwr + . set rstwr using restart_is_write_step method + + control/ccsm_msg.F90 + . add rstwr intent(out) arg to ccsm_run and remove the external declaration + . move the logic to set rstwr from the old rstwr function into ccsm_run + . change write_restart_ccsm call logic to only use rstwr + + control/comctl.h + . remove nrefrq + . remove anncyc -- no longer used + . remove nlhst -- it is equivalent to lbrnch + . remove itsst -- obsolete and broken + . move nlres and lbrnch to restart.F90 + + control/filenames.F90 + . remove comctl.h + . remove nrefrq dependence on initializing rest_pfile + . move nrevsn and rest_pfile to restart module + + control/history.F90 + . add rstwr dummy arg to wrapup and remove the external declaration + + control/restart.F90 + . extend functionality of this module to include the control of setting the + restart write time. + . add restart_is_write_step method. This started as the rstwr + function in rstwr.F90. + . add restart_init to initialize the restart write time + . add restart_{default,set}opts methods for namelist + . restart_setopts provides checking of the namelist settings and echos a + summary to the log file. + . add next_write_{ymd,tod} to restart file + . replace use of nlhst with lbrnch + . add nlres and lbrnch control variables (moved here from comctl.h) + . add nsrest as intent(in) arg of the restart_setopts method - it's needed + to set the values of nlres and lbrnch + . remove comctl.h -- no longer needed + + control/runtime_opts.F90 + . remove nrefrq + . add restart write interval namelist variables + . add restart_{default,set}opts calls + . add mpibcast calls + . replace use of nlhst with lbrnch + . add nlres and lbrnch control variables (moved here from comctl.h) + . add nsrest as intent(in) arg of the restart_setopts method - it's needed + to set the values of nlres and lbrnch + . remove comctl.h -- no longer needed + + control/startup_initialconds.F90 + . add restart_init call to setup_initial method + + control/time_manager.F90 + . cleanup some comments + . remove target attribute from tm_cal + . remove public attribute from tm_clock + . add new methods: + timemgr_time_ge ! check if time2 is later than or equal to time1 + timemgr_time_inc ! increment time instant by a given time interval + + dynamics/eul/initcom.F90 + . use nsrest instead of nlres in conditional + + ice/csim4/camice.F90 + . remove comctl.h from camice_write_restart -- not used + . add rstwr dummy arg to camice_run and remove the external declaration + . change camice_write_restart call logic to only use rstwr + . remove unused ref to nrevsn + + ocnsice/dom/camoce.F90 + . add rstwr dummy arg to camoce_run and remove the external declaration + . change camoce_write_restart call logic to only use rstwr + . remove anncyc -- no longer used + . remove itsst -- obsolete and broken + . remove unused ref to nrevsn + + ocnsice/som/somoce.F90 + . add rstwr dummy arg to somoce_run and remove the external declaration + . change somoce_write_restart call logic to only use rstwr + . remove unused ref to nrevsn + + test/system/nl_files/pghgsul + test/system/nl_files/ttrac + . add restart_nsteps setting to match history write frequency (these are + the only namelists used in the TBR tests) + + tools/scam/scm_init/scam_run.F90 + . add rstwr actual arg to ocn_run and ice_run calls. Hardwire value to + .false. (scam doesn't ask cam to write a restart file) + + Mods were made to the following CLM routines. These mods are accessed + via the external code svn:/clm2/branch_tags/clm3_expa_53_brnchT_cam01 + + clm/src/main/clm_camMod.F90 + . add rstwr intent(in) arg to clm_camRun and use it as actual arg in call to + clm_run2 + . remove setting of cam_nhtfrq, cam_mfilt to nhtfrq, mfilt. + + clm/src/main/clm_comp.F90 + . add rstwr intent(in) arg to clm_run2 and use it as actual arg in call to + driver2. + + clm/src/main/clm_varctl.F90 + . remove cam_nhtfrq and cam_mfilt -- no longer used + + clm/src/main/controlMod.F90 + . remove overwritting of hist_nhtfrq, hist_mfilt with cam_nhtfrq, cam_mfilt + + clm/src/main/driver.F90 + . add rstwr optional intent(in) arg to driver2 and use it in conditional for call to + restFile_write. + . check for presence of rstwr arg and use it to set local logical variable, + or use the do_restwrite method if it's not present. This allows driver2 + to continue to be used by the program_csm and program_off drivers. + + *** NOTE *** The following files have been moved from cam/src/control/ + to cam/src/utils/. (The reason is that by moving utility functions into + a separate directory it's easier to build unit testers using CAM's build + procedure which requires that all source files in each specified + directory be built.) + abortutils.F90 + cfort.h + spmd_utils.F90 + string_utils.F90 + time_manager.F90 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: All PASS. + +tempest: All PASS. + +bangkok/lf95: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam3_2_45 + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + + Answers are bit-for-bit. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_45 +Originator(s): eaton +Date: Sun Dec 18 14:55:02 MST 2005 +One-line Summary: Bug fixes for memory leak and misc. + +Purpose of changes: bug fixes + +Bugs fixed (include bugzilla ID): + +1. Fix memory leak introduced in cam3_0_20. Briefly the problem is that the + overloaded .not. operator defined in diffusion_solver.F90 returns an object + of type vdiff_selector for which memory is allocated, but this operator is + used as an actual argument in the call to compute_vdiff in + vertical_diffusion.F90, and so the memory is never assigned to a variable + which can be deallocated. + +2. The T field in initial files for FV when 2D decomp is used are bad. + This was caused by a problem with an array index in + fv/diag_dynvar_ic.F90 + +3. The history restart files were being removed at the end of the run. The + normal CAM behavior is to not remove any files written at the end of the + run. + +4. The filepath for tgcm data was being truncated at 80 characters. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + Memory leak fixed. The severity of this problem depends on what the + compiler did with an object returned by a function that was being used as + an actual argument. The problem was most severe with the lf95 compiler. + +Code reviewed by: myself + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +Bug 1. + +physics/cam1/vertical_diffusion.F90 +. replace fieldlist by fieldlist_moist +. add fieldlist_dry to module data and replace .not.fieldlist w/ fieldlist_dry +. add fieldlist_dry as actual arg to init_vdiff +. use fieldlist_dry in 2nd call to compute_vdiff +physics/cam1/diffusion_solver.F90 +. add fieldlist_dry as dummy arg to init_vdiff and initialize it + +Bug 2. + +dynamics/fv/diag_dynvar_ic.F90 +. The outfld call for T&IC needs the array referenced as t3(1,kfirst,j), + not t3(1,1,j). + +Bug 3. + +control/history.F90 +. Change the argument in the putfil call that determines whether the file + is removed after it is archived from .true. to .not.nlend. +. Add nlend as a dummy arg to write_restart_history +control/restart.F90 +. add nlend to the actual args of write_restart_history + +Bug 4. + +physics/waccm/tgcm_forcing.F90 +. Change "character*80 locfn" to "character*256 locfn" at line 158 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +All PASS except: +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 10 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 10 +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +tempest: +All PASS except: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +bangkok/lf95: +All PASS except: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 + +These tests are all expected to fail due to a bug in the current logic for +writing restart files. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? Answers are BFB. + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_44 +Originator(s): Mariana Vertenstein, Rob Jacob +Date: 2005-12-16 +One-line Summary: Incorprated MCT for cam-clm coupling + +Purpose of changes: Replaced current cam-clm lp-coupling scheme with + new MCT coupling and interfaces. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: MCT is now built as part of the + CAM executable (since it is all F90 code) - configure was changed so + that the MCT filepath could be incorporated into the CAM build + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none (from a preliminary + analysis of timing numbers). A more detailed timing analysis is planned. + +Code reviewed by: Mariana Vertenstein, Rob Jacob + +List all subroutines eliminated: none + +List all subroutines added and what they do: + + control/seq_fields_mod.F90 + provides list of fields to be coupled using same mechanism as in + concurrent ccsm mode + + control/MCT_seq.F90 + control/MCT_atm_comp.F90 + provide new MCT coupling interfaces + +List all existing files that have been modified, and describe the changes: + + physics/cam1/camhub_comp.F90 + cleaned up interfaces + + physics/cam1/prescribed_aerosols.F90 + bug fix (provided by Andrew Conley) - does not change answers + in current tests + + atm/cam/tools/scam/configure + atm/cam/tools/scam/scm_init/init_model.F90 + atm/cam/tools/scam/scm_init/scam_run.F90 + changes to SCAM in order to run with MCT cam-clm coupling + and also use new camhub_comp changes + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: + + 004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + 018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 + 043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 10 + +tempest: + + 003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + 020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 + 034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +bangkok/lf95: + + 003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 + 015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 + 031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 + +CAM tag used for the baseline comparison tests if different than previous +tag: previous tag + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): results were bit-for-bit + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam3_2_43 +Originator(s): Mariana Vertenstein, Mat Rothstein +Date: 2005-12-15 +One-line Summary: Updated clm code to clm3_expa_52 + +Purpose of changes: +Update clm code base to clm3_expa_52 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mariana Vertenstein, Keith Oleson + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + src/biogeochem/CASAMod.F90 + src/biogeochem/DGVMEstablishmentMod.F90 + src/biogeophys/CanopyFluxesMod.F90 + src/main/clm_varcon.F90 + src/main/time_manager.F90 + + - Put in changes to use esmf_wrf_timemgr code base + - Changes to clm_varcon.F90 and CanopyFluxesMod.F90 are + Changes made to the clm hydrology in tag clm3_expa_46 that were + increased the conductance of heat and moisture between the soil and the + canopy air space. This leads to the following changes in land climatology: global + increase in soil evaporation and a decrease in transpiration + and in the soil surface temperature. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 +008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 +015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 10 +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 +044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 +047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 +054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 + +tempest: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +004 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h -2 ................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +035 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h -2 ................................FAIL! rc= 7 + +bangkok/lf95: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 7 +008 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 7 +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +032 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 7 +036 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 7 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: The above changes to clm lead to a new climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: + +- source tag (all code used must be in the repository): + cam3_2_40 (with clm source code corresponding to clm3_expa_48) + +- platform/compilers: + bluesky + +- configure commandline: + configure -ocn dom -dyn fv -spmd -smp -test -res 4x5 + +- build-namelist command (or complete namelist): +&camexp +absems_data = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/abs_ems_factors_fastvx.c030508.nc' +aeroptics = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolOptics_c050419.nc' +bnd_topo = '/fis/cgd/cseg/csm/inputdata/atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc' +bndtvaer = '/fis/cgd/cseg/csm/inputdata/atm/cam/rad/AerosolMass_V_4x5_clim_c031022.nc' +bndtvo = '/fis/cgd/cseg/csm/inputdata/atm/cam/ozone/pcmdio3.r8.64x1_L60_clim_c970515.nc' +bndtvs = '/fis/cgd/cseg/csm/inputdata/atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c030228.nc' +caseid = 'cam3_2_40_fv4x5dom' +dtime = 1800 +iyear_ad = 1950 +ncdata = '/fis/cgd/cseg/csm/inputdata/atm/cam/inic/fv/cami_0000-09-01_4x5_L26_c031217.nc' +nelapse = -1 +nsrest = 0 +/ +&clmexp +fpftcon = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/pftdata/pft-physiology-cn16.c040719' +fsurdat = '/fis/cgd/cseg/csm/inputdata/lnd/clm2/srfdata/cam/clms_3.1_4x5_c050523.nc' +/ + +- MSS location of output: + /OLESON/csm/cam3_2_40_fv4x5dom + +MSS location of control simulations used to validate new climate + /OLESON/csm/cam3_2_29_fv4x5dom + +URL for AMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/tss/clm/diagnostics/cam_clm2/cam3_2_40_fv4x5dom-cam3229_fv4x5dom/sets.htm + +=============================================================== +=============================================================== + +Tag name: cam3_2_42 +Originator(s): mvr +Date: 051213 +One-line Summary: csm_share, esmf_wrf_timemgr, timing now from +external sources; updated to share3_051205; new ChangeLog format + +Purpose of changes: taking advantage of some subversion features + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvr, eaton + +List all subroutines eliminated: all csm_share, esmf_wrf_timemgr, and +timing files; +D models/utils/timing +D models/utils/timing/private.h +D models/utils/timing/gptl_papi.c +D models/utils/timing/rtcrate.F90 +D models/utils/timing/gptlutil.c +D models/utils/timing/threadutil.c +D models/utils/timing/gptl.c +D models/utils/timing/f_wrappers.c +D models/utils/timing/gptl.h +D models/utils/timing/README +D models/utils/timing/gptl.inc +D models/utils/esmf_wrf_timemgr +D models/utils/esmf_wrf_timemgr/ESMF_AlarmClockMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_CalendarMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_BaseMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_TimeMgr.inc +D models/utils/esmf_wrf_timemgr/ESMF_Mod.F90 +D models/utils/esmf_wrf_timemgr/c_esmc_subroutines.F90 +D models/utils/esmf_wrf_timemgr/ESMF_BaseTimeMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_ClockMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_AlarmMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_TimeMod.F90 +D models/utils/esmf_wrf_timemgr/ESMF_Macros.inc +D models/utils/esmf_wrf_timemgr/ESMF_Stubs.F90 +D models/utils/esmf_wrf_timemgr/ESMF_TimeIntervalMod.F90 +D models/utils/esmf_wrf_timemgr/wrf_error_fatal.F90 +D models/utils/esmf_wrf_timemgr/ESMF_FractionMod.F90 +D models/utils/esmf_wrf_timemgr/Makefile +D models/csm_share +D models/csm_share/ChangeLog +D models/csm_share/unit_testers +D models/csm_share/unit_testers/test_shr_sys.F90 +D models/csm_share/unit_testers/test_shr_orb.F90 +D models/csm_share/unit_testers/Makefile +D models/csm_share/ChangeSum +D models/csm_share/shr +D models/csm_share/shr/shr_date_mod.F90 +D models/csm_share/shr/shr_map_mod.F90 +D models/csm_share/shr/shr_sys_mod.F90 +D models/csm_share/shr/shr_file_mod.F90 +D models/csm_share/shr/shr_vmath_mod.F90 +D models/csm_share/shr/shr_timer_mod.F90 +D models/csm_share/shr/shr_orb_mod.F90 +D models/csm_share/shr/shr_kind_mod.F90 +D models/csm_share/shr/shr_tInterp_mod.F90 +D models/csm_share/shr/shr_mpi_mod.F90 +D models/csm_share/shr/shr_const_mod.F90 +D models/csm_share/shr/shr_msg_mod.F90 +D models/csm_share/shr/shr_stream_mod.F90 +D models/csm_share/shr/shr_ncread_mod.F90 +D models/csm_share/shr/shr_alarm_mod.F90 +D models/csm_share/shr/shr_cal_mod.F90 +D models/csm_share/shr/shr_vmath_fwrap.c +D models/csm_share/shr/shr_string_mod.F90 +D models/csm_share/README +D models/csm_share/cpl +D models/csm_share/cpl/cpl_kind_mod.F90 +D models/csm_share/cpl/cpl_const_mod.F90 +D models/csm_share/cpl/cpl_infobuf_mod.F90 +D models/csm_share/cpl/cpl_fields_mod.F90.CO2A +D models/csm_share/cpl/cpl_fields_mod.F90.CO2B +D models/csm_share/cpl/cpl_comm_mod.F90 +D models/csm_share/cpl/cpl_fields_mod.F90.CO2_DMSA +D models/csm_share/cpl/cpl_iobin_mod.F90 +D models/csm_share/cpl/cpl_interface_mod.F90 +D models/csm_share/cpl/cpl_fields_mod.F90 +D models/csm_share/cpl/cpl_domain_mod.F90 +D models/csm_share/cpl/cpl_bundle_mod.F90 +D models/csm_share/cpl/cpl_contract_mod.F90 +D models/csm_share/cpl/cpl_map_mod.F90 +D models/csm_share/cpl/cpl_control_mod.F90 +D models/csm_share/cpl/cpl_mct_mod.F90 +D models/csm_share/cpl/cpl_iocdf_mod.F90 +D models/csm_share/README.scm +- all these replaced with subversion external directories + +D models/atm/cam/doc/BaseModelSum +D models/atm/cam/doc/BaseModelLog +- some documentation cleanup + +List all subroutines added and what they do: +A models/utils/SVN_EXTERNAL_DIRECTORIES +A models/SVN_EXTERNAL_DIRECTORIES +- contain definitions for the external directories + +A + models/atm/cam/doc/Copyright +- copy of the copyright information that'll be picked up by ccsm external pull + +A models/atm/cam/doc/ChangeLog_template +- template for new ChangeLog format + +List all existing files that have been modified, and describe the changes: + M models + M models/utils +- directories modified with properties for the external definitions + +M models/atm/cam/doc/ChangeLog +- added documentation for this tag + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +bluesky: +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 10 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +tempest: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +bangkok/lf95: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 + + +CAM tag used for the baseline comparison tests if different than previous +tag: prev + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): b4b + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +cam3_2_41 +Originator: jet ( John Truesdale) +Date: Fri Dec 9 11:56:01 MST 2005 +Model: CAM +Version: CAM3.2.41 +One-line Summary: Fixed SCAM bugs, added SCAM tests to testscript, made SCAM datasets consistent with CAM +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no + +Substantial timing or memory changes: no +Requires change in run script: no + +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) + +bangkok: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 + +tempest: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +bluesky: +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 10 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 10 + + +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) + +Changes to CLM land-model: One - fixed bug with scam specific code. + +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +This is basically a bug fix for SCAM as well as adding some +small changes to get rid of autopromotion dependency in SCAM. +Changes are bit for bit for CAM/CCSM. I did update the datasets +used by SCM to by consistent with the latest datasets for CAM +so the CRM test output also needed to be updated to reflect this. + +A list of files changed follows: + +history_defaults.F90 - added cpp def BFB_CAM_SCAM_IOP around cam/scam + bfb specific code +runtime_opts.F90 - scam initializes with the name of the topo and initial + conditions datasets +startup_initialconds.F90 - made changes to include this file in scam + intial calls +inidat.F90 - changed scam specific code to use topo info off of topo dataset +.scam_defaults - updated to use topo file and newer boundary dataset files +scam/configure - Brian's changes to get rid of autopromotion +scam/testscript - added tests to check consistency of .scam_defaults + datasets with CAM namelist. + added tests for scam to run in default mode. +getnetcdfdata.F90 - Brian's changes to get rid of autopromotion +init_model.F90 - add topo dataset to scam +inital.F90 - call cam routine setup_initial from scam specific code. +ipc.h - added topo dataset to scam +runtype.h - added topo dataset to scam +scamMod.F90 - let scam initialize topo and initial conditions dataset names +scam_fifo.c - pass topo dataset to scam initialization +scam_run.F90 - fix bug with scam - don't run lsm if no land present +setlatlon.F90 - fix bug with scam - don't error out in iop run if iop + dataset has different column latitude and longitude than + initial data. +IOPSelectDateDlgImpl.cpp - cleanup +OptionsDlg.ui - add topo dataset to scam dataset tab in gui +OptionsDlgImpl.cpp - add topo dataset to scam dataset tab in gui +crm.cpp - add topo dataset to scam +dataset.cpp - add topo dataset to scam +fifomodel.cpp - add topo dataset to scam +manager.cpp - add topo dataset to scam +rpcmodel.cpp - add topo dataset to scam +crmtest26.out - crm radiation values changed slightly when we changed + the default datasets to match the current cam defaults +clm_camMod.F90 - fix bug with scam - don't run lsm if no land present also + get rid of spurious SCAM returns in this file + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_40 +Originator: jedwards ( James Edwards) +Date: Fri Dec 2 17:24:53 MST 2005 +Model: CAM +Version: CAM3.2.40 +One-line Summary: minor cleanup and extended testing of cam3_2_39 commit +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: testing was repeated against 3_2_38 +bangkok: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 3 ..................................FAIL! rc= 7 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 + +tempest: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 + +bluesky: +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 10 +054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 + +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton +Restart files change: no +Changes answers: Yes (same-to-roundoff against 3_2_38) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +All reference to macros __FILE__ and __LINE__ have been removed. +File ozone_data.F90 was cleaned up to remove variables which are no longer used. +A further pergrow test was conducted with chemistry enabled since some of the changes in the previous commit involved chemistry but the pergrow test did not. This is why the test were rerun against 3_2_38 instead of 3_2_39. + +Besides we wanted to close the CVS repository with a nice even number. :-) + +=============================================================== +=============================================================== + +cam3_2_39 +Originator: jedwards ( James Edwards) +Date: Fri Dec 2 10:48:22 MST 2005 +Model: CAM +Version: CAM3.2.39 +One-line Summary: Consolidated zonal data input methods used by cam 1 chemistry and ozone files. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: +bluesky: +015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 10 +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 10 +054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 +tempest: +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +026 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +bangkok: +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 +024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 +026 bl313 TBL.sh f10pdm aqpgro 3 ..................................FAIL! rc= 7 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 +041 sc999 scamtest.sh .............................................FAIL! rc= 4 + +6+3 tests are expected to fail due to problems in the testing procedure introduced in cam3_2_37. +TBL tests failed due to order of operation changes. A perturbation growth test was conducted and passed to show these are errors are order round-off. +The scamtest does not work for me in the test script, the scamtest was sucessfully run by hand. + +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes (same-to-roundoff - details noted above.) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +Added file physics/cam1/zonalbndrydata.F90 +moved netcdf interface in chemistry.F90 and ozone_data.F90 to this new file. +In the past the chemistry file read a full years data at the initial time and held it in memory while the ozone file read two months data and updated during the run when it needed new data. The new file supports both methods but requires that you choose one or the other at compile time. The second method is now the default. + +Several minor changes were made in other files, mostly removing unused references to plat and plon. The interface was changed for one chemistry routine which required changes in all flavors of the chemistry files and dynamics inidat files. Below is a complete list of changed files: + + models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + models/atm/cam/src/control/interpolate_data.F90 + models/atm/cam/src/control/runtime_opts.F90 + models/atm/cam/src/dynamics/eul/inidat.F90 + models/atm/cam/src/dynamics/fv/inidat.F90 + models/atm/cam/src/dynamics/sld/inidat.F90 + models/atm/cam/src/physics/cam1/advnce.F90 + models/atm/cam/src/physics/cam1/aerosol_intr.F90 + models/atm/cam/src/physics/cam1/chemistry.F90 + models/atm/cam/src/physics/cam1/drydep_mod.F90 + models/atm/cam/src/physics/cam1/ozone_data.F90 + models/atm/cam/src/physics/cam1/physpkg.F90 + models/atm/cam/src/physics/cam1/ramp_scon.F90 + models/atm/cam/src/physics/cam1/seasalt_intr.F90 + models/atm/cam/src/physics/cam1/stratiform.F90 + models/atm/cam/src/physics/cam1/tphysidl.F90 + models/atm/cam/src/physics/cam1/tracers.F90 + models/atm/cam/src/physics/cam1/volcanicmass.F90 + models/atm/cam/src/physics/waccm/chemistry.F90 + + +=============================================================== +=============================================================== + +cam3_2_38 +Originator: mirin ( Arthur Andrew Mirin) +Date: Tue Nov 29 16:50:01 MST 2005 +Model: CAM +Version: CAM3.2.38 +One-line Summary: (1) Restore FV options; (2) Cray-X1E communications, threading, streaming +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +No changes to file/directory structure +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: TBR.sh (Get clearance for failed tests, enter lines from td.*.status files that fail) +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 (bluesky) +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 10 (bluesky) +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 (bluesky) +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 (tempest) +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 (tempest) +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 (tempest) +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 (bangkok) +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 (bangkok) +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 (bangkok) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer, Worley +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: Cray-X1E OpenMP/CSD compatibility +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: +(1) Restored nonworking FV options (geopktrans, tracertrans, modcomm-transpose, +modcomm_geopk) +(2) Added Shmem capability to Cray-X1E (USE_SHMEM if-def - affects mod_comm.F90) +(3) Allowed coexistence of OpenMP and CSD's on Cray-X1E provided they do not operate +on same loop index +(4) Removed nested OpenMP capability +Files changed: +models/atm/cam/bld: CAM_config.pm, config_trop_chem_mozart_defaults.xml, Makefile, +config_waccm_ghg_defaults.xml, config_cam_eul_defaults.xml, config_waccm_mozart_defaults.xml, +config_cam_fv_defaults.xml, configure, config_cam_sld_defaults.xml +models/atm/cam/src/control: runtime_opts.F90 +models/atm/cam/src/dynamics/eul: dyndrv.F90, realloc4.F90, scan2.F90, scanslt.F90 +models/atm/cam/src/dynamics/fv: FVCAM_GridCompMod.F90, geopk.F90, sw_core.F90, +cd_core.F90, pmgrid.F90, tp_core.F90, dynamics_vars.F90, spmd_dyn.F90, trac2d.F90 +models/atm/cam/src/dynamics/sld: realloc4.F90, scan2.F90 +models/atm/cam/src/physics/cam1: phys_grid.F90, radlw.F90 +models/lnd/clm2/src/main: areaMod.F90, driver.F90, histFileMod.F90, atmdrvMod.F90, +filterMod.F90, initializeMod.F90 +models/lnd/clm2/src/riverroute: RtmMod.F90 +lnd/clm2/tools/mksurfdata: mkdynpftMod.F90, mklaiMod.F90, pmkpftMod.F90, mksoitex.F90, +mkglacier.F90, mklanwat.F90, mksoicol.F90, mkurban.F90 +models/utils/pilgrim: mod_comm.F90 +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_37 +Originator: mvr ( Mathew Rothstein) +Date: Fri Nov 18 16:43:50 MST 2005 +Model: CAM +Version: CAM3.2.37 +One-line Summary: Bug fix for cam in ccsm; removed cam-specific code from csm_share; mod to branch test and other test suite cleanup +cam-bugs Requests resolved: none +Requires change in build system: yes +returned spmd mode to builds for ccsm (mistakenly removed with cam3_2_35) +Substantial timing or memory changes: yes, using spmd again in coupled mode +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: + +bluesky +004 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 6 +008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 6 +010 bl133 TBL.sh e32pdh aqpgro 3 ..................................FAIL! rc= 6 +013 bl134 TBL.sh e32dh adia 9 .....................................FAIL! rc= 6 +015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 6 +018 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 6 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 6 +024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 6 +027 bl334 TBL.sh f4dh adia 9 ......................................FAIL! rc= 6 +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 6 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 6 +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 6 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 6 +043 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 6 +047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 6 +049 bl533 TBL.sh s32pdh aqpgro 3 ..................................FAIL! rc= 6 +052 bl534 TBL.sh s32dh adia 9 .....................................FAIL! rc= 6 +054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 6 +055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K ..........................FAIL! rc= 2 + +tempest +003 br131 TBR.sh e32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +004 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 6 +007 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 6 +009 bl133 TBL.sh e32pdh aqpgro 3 ..................................FAIL! rc= 6 +012 bl135 TBL.sh e32dh idphys 9 ...................................FAIL! rc= 6 +014 bl152 TBL.sh e64o outfrq24h -2 ................................FAIL! rc= 6 +017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 6 +020 br331 TBR.sh f4c11dh pghgsul 6+3 ..............................FAIL! rc= 9 +021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 6 +024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 6 +026 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 6 +029 bl335 TBL.sh f4dh idphys 9 ....................................FAIL! rc= 6 +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 6 +034 br531 TBR.sh s32c11dh pghgsul 6+3 .............................FAIL! rc= 9 +035 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 6 +038 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 6 +040 bl533 TBL.sh s32pdh aqpgro 3 ..................................FAIL! rc= 6 +043 bl535 TBL.sh s32dh idphys 9 ...................................FAIL! rc= 6 +045 bl552 TBL.sh s64o outfrq24h -2 ................................FAIL! rc= 6 + +bangkok +003 br111 TBR.sh e8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 6 +008 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 6 +010 bl113 TBL.sh e8pdm aqpgro 3 ...................................FAIL! rc= 6 +012 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 6 +015 br311 TBR.sh f10c8mdm ttrac 6+3 ...............................FAIL! rc= 9 +016 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 6 +024 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 6 +026 bl313 TBL.sh f10pdm aqpgro 3 ..................................FAIL! rc= 6 +028 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 6 +031 br511 TBR.sh s8c8mdm ttrac 6+3 ................................FAIL! rc= 9 +032 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 6 +036 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 6 +038 bl513 TBL.sh s8pdm aqpgro 3 ...................................FAIL! rc= 6 +040 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 6 + +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +M models/atm/cam/bld/configure +- bug fix for running cam in coupled mode with spmd + +M models/atm/cam/src/advection/slt/phcs.F90 +M models/atm/cam/src/chemistry/waccm_mozart/apex_subs.F90 +M models/atm/cam/src/control/gauaw_mod.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/fill_module.F90 +M models/atm/cam/src/dynamics/fv/geopk.F90 +M models/atm/cam/src/dynamics/fv/pft_module.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 +M models/csm_share/shr/shr_kind_mod.F90 +- moved cam-specific code out of csm_share + +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/input_tests_master +- modified branch test to branch from an earlier restart file + +M models/atm/cam/test/system/TCB.ccsm.sh +M models/atm/cam/test/system/TSB.ccsm.sh +M models/atm/cam/test/system/test_driver.sh +- cleaned up use of environment vars CAMROOT and CAM_ROOT + +M models/atm/cam/test/system/td_nightly_aix.sh +M models/atm/cam/test/system/td_nightly_linux.sh +- just updating repository with mods to nightly scripts + +M models/atm/cam/test/system/TCB.ccsm.sh +- ccsm test will now use tags from ccsm3_1_beta* sequence + +M models/atm/cam/test/system/TBL.sh +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/idphys +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/outfrq24h +M models/atm/cam/test/system/nl_files/outfrq3s +M models/atm/cam/test/system/nl_files/pghgsul +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac_lb3 +- test suite now outputting history/restart files for each time sample + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_36 +Originator: jedwards ( James Edwards) +Date: Fri Nov 11 09:58:15 MST 2005 +Model: CAM +Version: CAM3.2.36 +One-line Summary: rework of new interpolation method, bug fix in phys_gmean, clean up in waccm_mozart +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Reworked recently introduced interpolation changes to contain the method within a physics chunk and eliminate dependence on the phys_grid module. + +Fixed a bug in phys_gmean in which the number of fields passed in was hardcoded, and the incoming number of fields argument was ignored. + +Removed unused 'use ' statements in waccm_mozart. +=============================================================== +=============================================================== + +cam3_2_35 +Originator: erik ( Erik Kluzek) +Date: Tue Nov 8 12:41:27 MST 2005 +Model: CAM +Version: CAM3.2.35 +One-line Summary: Remove prototype ESMF and use WRF implimentation of ESMF_2_1_0 API for time-manager, allow build to use external ESMF +cam-bugs Requests resolved: none +Requires change in build system: yes + (Configure changed so that Filepath also points to models/utils/esmf_wrf_timemgr) +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Remove: models/utils/esmf: + Remove all prototype ESMF files. + +Add: models/utils/esmf_wrf_timemgr: + Put in WRF implementation of ESMF_2_1_0 time-manager API. + +Changes to build: + Change build so default is to build with WRF ESMF time-manager. Can also use + externally compiled ESMF_2_1_0. + + Linking with external ESMF: non-default, have to build ESMF externally + and send appropriate command-line options to configure to use this option. + + Get rid of ESMF_ROOT as unneeded now. Now have three + tokens for dealing with ESMF: ESMF_BLD, ESMF_LIB, and ESMF_MOD. + Setting any of those threes means to link with external ESMF. + If ESMF_BLD is set, the Makefile will figure out the path + based on uname and debug option to the default version of ESMF. + If ESMF_LIB and ESMF_MOD are set the full paths will be used + for these two. The external version of ESMF that you link to is + assumed to be a current download of ESMF, which has it's own build + system. The current ESMF does not have a build for several important + platforms: Cray, Pathscale, ES, NEC etc, therefore only the esmf_wrf_timemgr + version can be used there. Also there were bugs with linking that will + need to be worked out on our standard platforms, before this will work + reliably + + Change configure so SPMD information isn't duplicated in configure output + files. + +Changes to time_manager: + + Update time_manager.F90 so uses the ESMF_2_1_0 API instead of the prototype + ESMF API. Create unit-tests in models/atm/cam/tests/unit/control to do + extensive testing of the time-manager interface. Runs different time-intervals and different ways of setting the stop-date, with one simulation period from + year 0 to year 9999. Answers were compared to the previous time-manager and + found to be bit-for-bit on IBM, SGI and Linux-PGI compilers. + + Calendar can not be set to GREGORIAN right now, only NOLEAP is allowed. + esmf_wrf_timemgr could be extended to allow both calendars, or we can start + using ESMF externally to handle both calendars. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_34 +Originator: jedwards ( James Edwards) +Date: Thu Nov 3 17:00:55 MST 2005 +Model: CAM +Version: CAM3.2.34 +One-line Summary: interpolation method changed in waccm chemistry +cam-bugs Requests resolved: none + +Requires change in build system: no + +Substantial timing or memory changes: Yes reduced memory profile of waccm/chemistry +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +plat and plon dependence were removed from waccm/chemistry.F90 +following the same method as cam1/chemistry.F90 +The method in cam1 was modified to read only on the masterproc, this does +not change the memory profile. + +=============================================================== +=============================================================== + +cam3_2_32 +Originator: mvr ( Mathew Rothstein) +Date: Fri Oct 28 16:58:34 MDT 2005 +Model: CAM +Version: CAM3.2.32 +One-line Summary: Update csm_share to share3_051025; update remaining clm files to clm3_expa_45 that were missed with previous tag +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.sh script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM : yes +Tested to work with SCAM : yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes, updated doc files to clm3_expa_45 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +M models/csm_share/ChangeLog +M models/csm_share/ChangeSum +M models/csm_share/cpl/cpl_contract_mod.F90 +M models/csm_share/cpl/cpl_domain_mod.F90 +M models/csm_share/cpl/cpl_fields_mod.F90 +M models/csm_share/cpl/cpl_fields_mod.F90.CO2A +M models/csm_share/cpl/cpl_fields_mod.F90.CO2B +M models/csm_share/cpl/cpl_fields_mod.F90.CO2_DMSA +M models/csm_share/cpl/cpl_interface_mod.F90 +M models/csm_share/shr/shr_const_mod.F90 +M models/csm_share/shr/shr_map_mod.F90 +M models/csm_share/shr/shr_ncread_mod.F90 +M models/csm_share/shr/shr_stream_mod.F90 +M models/csm_share/shr/shr_timer_mod.F90 +M models/csm_share/unit_testers/test_shr_orb.F90 +M models/csm_share/unit_testers/test_shr_sys.F90 +- these are the files that changed between share3_050909 and share3_051025 + +M models/lnd/clm2/doc/ChangeLog +M models/lnd/clm2/doc/ChangeSum +- these are the files missed in updating between clm3_expa_29 and clm3_expa_45 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_31 +Originator: mvertens ( Mariana Vertenstein) +Date: Wed Oct 26 15:24:06 MDT 2005 +Model: CAM +Version: CAM3.2.31 +One-line Summary: updated clm to clm3_expa_45 (removed condition that clm and cam grid had to be bfb) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes (describe) +Requires change in run script: no +Ran test_driver.shl script: No (does all of the following tests) +Machines tested: IBM (ran 2 climate simulations on IBM - see below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes +Changes answers: Yes (same-climate) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +No cam physics code was modified. Only clm interface code was modified. +Modified models/lnd/clm2/src/main/clm_camMod.F90 (only several lines of clm code +were commented out) so that cam and clm grid do not have to be bfb. The +tolerance is that the grid latitudes/longitudes grids match to 1.e-12. +The fractional land however, must be identical. The clm code base has +now been updated to clm3_expa_45. + +Two 10 year integration for the entire set of physics changes using climatological SSTs +were performed. See: +/MVERTENS/csm/cam3_2_29_fv4x5dom (cam3_2_29 with changes to clm_camMod.F90) + vs +MVERTENs/csm/cam3_2_29_cam3_2_29_fv4x5dom_0 (cam3_2_29 with no changes) + +Diagnostic output is at: +http://www.cgd.ucar.edu/~mvertens/AMWG_diag/cam3229_fv4x5dom-cam3229_fv4x5dom_0/ +=============================================================== + +=============================================================== + +cam3_2_30 +Originator: mvr ( Mathew Rothstein) +Date: Thu Oct 20 09:49:40 MDT 2005 +Model: CAM +Version: CAM3.2.30 +One-line Summary: mods / new scripts added to cam's test suite for automated testing of new tags +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM : yes +Tested to work with SCAM : yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +A models/atm/cam/test/system/input_tests_aix_nightly +- test ids to run as part of nightly testing of new cam tags on bluesky (aix) +A models/atm/cam/test/system/input_tests_linux_nightly +- test ids to run as part of nightly testing of new cam tags on bangkok (linux) +A models/atm/cam/test/system/td_nightly_aix.sh +- cron script for overnight testing of new cam tag on bluesky (aix) +A models/atm/cam/test/system/td_nightly_linux.sh +- cron script for overnight testing of new cam tag on bangkok (linux) +A models/atm/cam/test/system/update_collections.sh +- cron script for overnight loading of latest cam tag on machine sanitas +M models/atm/cam/test/system/TCB.ccsm.sh +- added command to modify directory path to finite volume code in ccsm scripts +M models/atm/cam/test/system/input_tests_master +- added ccsm tests for running coupled model with finite volume dycore + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_29 +Originator: eaton ( Brian Eaton) +Date: Tue Oct 18 10:52:05 MDT 2005 +Model: CAM +Version: CAM3.2.29 +One-line Summary: add LANDFRAC file, move inti.F90 into phys_init +cam-bugs Requests resolved: bugzilla #19 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Added the ability to specify the file that contains the LANDFRAC field. +The namelist variable bnd_landfrac is used to specify the path of this +file. If not specified the default is to use the file that the topography +fields are read from. + +Moved the physics initialization routines into phys_init. Removed +subroutine inti. Also add initialization of grid information to the +physics_state objects that are allocated in phys_init. This information is +needed to be passed to the physics init routines that do spatial +interpolation of boundary data. + +Misc: +. Fix for problem with WACCM_MOZART on SGI: was failing to write abs/ems + restart file. Resolves bugzilla #19. +. Bugfix in lf95 section of Makefile (reference to apex_subs.F changed to + apex_subs.F90). + +=============================================================== +=============================================================== + +cam3_2_28 +Originator: mvertens ( Mariana Vertenstein) +Date: Mon Oct 17 09:35:36 MDT 2005 +Model: CAM +Version: CAM3.2.28 +One-line Summary: updated clm code clm3_expa_44 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes (all clm restarts, other than history restarts, are now NetCDF) +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes + Updated clm code to clm3_expa_44 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + Updated clm code to clm3_expa_44. Interfaces between cam and clm + (in clm_camMod.F90) have been modified to be consistent with + making clm a gridded component. The clm driver routine has now + also been split into two phases as part of this process. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_27 +Originator: jedwards ( James Edwards) +Date: Fri Oct 14 10:20:58 MDT 2005 +Model: CAM +Version: CAM3.2.27 +One-line Summary: consolidated linear interpolation schemes +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Merged lininterp.F90 bilin.F90 vertinterp.F90 and timinterp.F90 into a single module. added use statements for this module where appropriate + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_26 +Originator: pworley ( Patrick H Worley) +Date: Wed Oct 12 21:20:24 MDT 2005 +Model: CAM +Version: CAM3.2.26 +One-line Summary: Cray X1(E) optimizations for FV +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes - much faster on the X1E when using FV +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: failed all baseline comparisons tests for FV on bluesky. +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +024 bl333 TBL.sh f4pdh aqpgro 3 ...................................FAIL! rc= 7 +027 bl334 TBL.sh f4dh adia 9 ......................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 +All other tests passed, and all tests passed on other two systems. pergro test +for FV on bluesky passed, indicating that change was within roundoff. +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Art Mirin, Will Sawyer +Restart files change: no +Changes answers: No for EUL and SLD, No for FV on SGI and Linux-Lahey, Yes for FV on IBM (same-to-roundoff) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +Synchronizing FV with NASA version introduced code that does run +efficiently on the Cray vector system (and probably not on the Earth Simulator +either). These changes bring performance back to what it was before, as well +as vectorizing buffer copies in the communication layer. + +dynamics/fv/cd_core.F90, dynamics/fv/sw_core.F90 + eliminated unnecessary array segment specifications in subroutine calls where it + was causing array copying +dynamics/fv/mapz_module.F90 + restructured recently added code to improve vectorization +dynamics/fv/trac2d.F90 + replaced pointer-based implementation of double buffering algorithm with an + equivalent index-based implementation, working around a problem on the Cray X1E +utils/pilgrim/mod_comm.F90, utils/pilgrim/parutilitiesmodule.F90 + restructured buffer copy loops for improved vectorization; general clean-up and optimization + +Some of the timer logic was also broken in a recent check-in: +control/cam.F90, control/cam_comp.F90 + fixed timer logic +utils/timing/gptl.c + fixed problems in mpi_wtime support in timing routines + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_25 +Originator: jeff ( Yen-Huei Lee) +Date: Fri Oct 7 09:16:46 MDT 2005 +Model: CAM +Version: CAM3.2.25 +One-line Summary: user specified constant co2 when running in ccsm +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton, Mathew Rothstein +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +modified the following files: + +models/atm/cam/src/control/runtime_opts.F90 +models/atm/cam/src/physics/cam1/radiation.F90 +models/atm/cam/src/physics/cam1/chem_surfvals.F90 +models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 +- add one namelist variable to allow user to specify a constant co2 (vmr) + for radiation calculation when running in CCSM, indepedent of other settings + of co2. + +models/atm/cam/src/control/ccsm_msg.F90 +- mod to support 1x1.25 resolution when running in CCSM. + +models/atm/cam/test/systems/TSB.ccsm.sh +- mod to run ccsm test effectively. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_24 +Originator: erik ( Erik Kluzek) +Date: Mon Oct 3 13:21:24 MDT 2005 +Model: CAM +Version: CAM3.2.24 +One-line Summary: Move time-loop to top driver, make multiple run methods in cam_comp and + stepon modules to reduce code duplication +cam-bugs Requests resolved: none +Requires change in build system: no (Remove auto-promotion on Darwin) +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, mvertens, mvr (testscript changes) +Restart files change: yes +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes! (clm_camMod only, move allocation method inside, create final method) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +High level structure changes: + +Make multiple run methods in cam_comp and stepon to reduce duplication and move +the time-loop up to the top level driver seq_ccsm -- still called cam.F90. +Remove nlend from comctl and make local data, passing down to relevant subroutines +and functions that need it. Make Gaussian weights and etamid module data +in cam_comp. Move all initialization calls for ocean or ice into one initialization +call (calls to read_restart_xxx moves to inside relevant initialize subroutine). And +move write_restart_xxx calls for ice and ocn inside of ice and ocean run method. Create +final methods for all component models (ice, ocn, land, atm). Use ncol in derived types +rather than using get_ncols_p method. Move tssub from surface_state derived type to private +data inside of camice. Move allocation of input/output derived types from driver to inside +of relevant component (ice, ocean, or land). Remove the temporary place-holder +restart_camsrf.F90 surface restart file. Remove ice_frac in camice and start using areafrac +and move merge of fractions to camhub_comp. This takes care of CCSM/ESMF Stage 1-2.6, 1.4 +and 1.7, and some work on 1.9.1. This creates drivers and component modules that have the +bulk of the Pre-ESMF work complete. + +See the "CCSM/ESMF Stage-1 Release Schedule" at... + + http://swiki.ucar.edu/start/66 + +SCAM Changes: + +Get SCAM and testscript to run on Darwin. Make Eulerian data dimensioned plat/2 to (plat+1)/2, +so will compile correctly with SCAM. Add "skip" and "noclean" as command-line arguments to +SCAM testscript to skip the CAM build/run and/or don't clean before the build of CAM or SCAM. +These are both useful for using testscript interactively for debugging running SCAM. Add +ability to testscript to run CAM at different resolutions and operate over any point +given (it gets the latitude and longitude needed for SCAM from the IOP file produced). + +CAM Makefile change: + +Get rid of auto-promotion on Darwin compile (Mac-OS-X with Absoft IBM XLF/XLC compilers). + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_23 +Originator: pworley ( Patrick H Worley) +Date: Thu Sep 29 15:42:12 MDT 2005 +Model: CAM +Version: CAM3.2.23 +One-line Summary: Explicitly typed variables and constants and deleted autopromotion of reals in Makefile. +cam-bugs Requests resolved: none +Requires change in build system: Yes - removed autopromotion flags from FFLAGS +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton, Art Mirin, Forrest Hoffman, Michael Ham +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes - Explicitly typed variables and constants +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Nearly every file in CAM standalone was modified, some extensively, but most +changes were "syntactic". Note that this includes most Fortran source in csm_share, ice, +lnd, and utils as well as in atm. Only the tool subdirectories were "spared". + +The steps were as follows: + +a) in atm/cam/src, the routines + +chemistry/waccm_mozart/apex_subs.F +chemistry/waccm_mozart/svdcmp.F +chemistry/waccm_mozart/wei96.F +physics/waccm/msise00.F +utils/fft99.F +utils/sgexx.F + + were all changed from fixed format that used implicit typing + to free free format with "implicit none" + and explicitly typing of all variables. (The suffixes + were all changed from .F to .F90 as well.) + +b) Tom Henderson's tool "addrealkind" was used to + change "real" declarations to "real(r8) and to add + "_r8" to all floating point constants that weren't already typed. + "use shr_kind_mod" was added where needed. + (For csm_share/shr. SHR_KIND_R8 was used instead of r8. + In csm_share/cpl, R8 was used. In ice/csim4, dbl_kind was used.) + + (For Tom's tool to work correctly, the name of the module was appended + to "end module" in a number of files, and "end" was replaced + by "end subroutine xxx" or "end function yyy" in a number of + files as well.) + + complex declarations were also changed to complex(r8) + +c) float(iii) and real(iii) were replaced by real(iii,r8). + cmplx(xxx,yyy) was replaced by cmplx(xxx,yyy,r8). + dble(iii) was replaced by real(iii,r16) if r16 was really necessary, + otherwise it was replaced by real(iii,r8). + Constants of the form xxx.yyyDeee were replaced by xxx.yyyEeee_r16 + if r16 was necessary, otherwise were replaced by xxx.yyy.Eeee_r8. + +d) specific intrinsics were changed to generic intrinsics, + e.g. alog10 was changed to log10, etc. + +e) removed local definitions of r8 and r16 when they were identical to + those in shr_kind_mod, but left the local definitions as is if they + were different. + +f) compiler flags that defined real variables to be double precision (or real*8) + and/or promoted floating point constants and intrinsics to double precision + were removed from the CAM makefile. (Something similar will need to + be done in CCSM.) + +Finally, a new command was added to phys_grid to indicated whether phys_grid +had been called or not. This logical function was used in camhub_comp.F90 +in place of the existing error-prone tests for this condition. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_22 +Originator: erik ( Erik Kluzek) +Date: Tue Sep 20 14:19:53 MDT 2005 +Model: CAM +Version: CAM3.2.22 +One-line Summary: Create cam_comp atmosphere component and make stepon a module, add Darwin (Mac-OS-X) as a platform +cam-bugs Requests resolved: none +Requires change in build system: no + (Did add changes to configure/build system so that can compile on Mac-OS-X with + Absoft XLC/XLF compilers. +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, mvertens +Restart files change: yes +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Interface with cam_comp changes +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Move the cam3_2_21_brnchT_chghilev_8 tag onto cam_dev. + +Add changes to esmf, cam, scam, and cprnc to build/run on Darwin (Mac-OS-X) platform +with the ABSOFT IBM XLF/XLC compilers. On Darwin scam will compile, but not link +at this point. More work needs to be done for it to completely build and run. + +Create a cam_comp component module to encapsulate the atmosphere part +of CAM. Make stepon into a module with initial, run and final methods. +Have scam interface with cam_comp rather than underlying subroutines. +Have scam interface with runtime_options in a more straightforward manner, +that won't require duplication of default settings for SCAM inside scam +initialization. Rename scam_inital to inital module a module for scam replacing +the Eulerian inital. + +The next step is to make cam_comp have multiple run phases, and stepon have +multiple run phases (this is outlined in each stepon). Then bring the time-loop +out of stepon and up to the driver level. The driver is still called cam.F90, but +will soon be refered to as sequential CCSM to distinquish it from cam_comp the +atmosphere only component, of the stand-alone CAM modeling system. + +This is documented as Stage-1.2-6 on the CCSM/ESMF webpages.... + +http://swiki.ucar.edu/start/83 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_21 +Originator: mvr ( Mathew Rothstein) +Date: Mon Sep 12 14:34:15 MDT 2005 +Model: CAM +Version: CAM3.2.21 +One-line Summary: re-work of ccsm test within cam test suite; updated to latest version of share code; mods to help waccm work in ccsm mode +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM: yes +Tested to work with SCAM: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +A models/atm/cam/test/system/gen_test_table.sh +- utility to generate html file with table of tests currently included in cam test suite + +A models/csm_share/cpl/cpl_fields_mod.F90.CO2A +A models/csm_share/cpl/cpl_fields_mod.F90.CO2B +A models/csm_share/cpl/cpl_fields_mod.F90.CO2_DMSA +A models/csm_share/shr/shr_map_mod.F90 +A models/csm_share/shr/shr_ncread_mod.F90 +A models/csm_share/shr/shr_stream_mod.F90 +A models/csm_share/shr/shr_string_mod.F90 +A models/csm_share/shr/shr_tInterp_mod.F90 +- added as part of update of share code from share3_0_2 to share3_050909 + +M models/atm/cam/bld/configure +- changed filepath for ccsm builds to correct location of waccm src +M models/atm/cam/src/physics/waccm/msise00.F +- changed the name of variable MSS to avoid ccsm pre-processor confusion +M models/atm/cam/test/system/TCB.ccsm.sh +- redirection of ccsm build test output to appropriate log file and some cleanup +M models/atm/cam/test/system/TCS.ccsm.sh +- re-working of ccsm test within cam test suite +M models/atm/cam/test/system/TMC.sh +- added some error checking to mass conservation test script +M models/atm/cam/test/system/TSB.ccsm.sh +- re-working of ccsm test within cam test suite +M models/atm/cam/test/system/test_driver.sh +- remove references to certain job log file if running interactively + +M models/csm_share/ChangeLog +M models/csm_share/ChangeSum +M models/csm_share/cpl/cpl_bundle_mod.F90 +M models/csm_share/cpl/cpl_comm_mod.F90 +M models/csm_share/cpl/cpl_contract_mod.F90 +M models/csm_share/cpl/cpl_control_mod.F90 +M models/csm_share/cpl/cpl_domain_mod.F90 +M models/csm_share/cpl/cpl_fields_mod.F90 +M models/csm_share/cpl/cpl_infobuf_mod.F90 +M models/csm_share/cpl/cpl_interface_mod.F90 +M models/csm_share/cpl/cpl_iobin_mod.F90 +M models/csm_share/cpl/cpl_iocdf_mod.F90 +M models/csm_share/cpl/cpl_map_mod.F90 +M models/csm_share/cpl/cpl_mct_mod.F90 +M models/csm_share/shr/shr_cal_mod.F90 +M models/csm_share/shr/shr_msg_mod.F90 +- modified as part of update of share code from share3_0_2 to share3_050909 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_20 +Originator: jedwards ( James Edwards) +Date: Wed Sep 7 14:22:57 MDT 2005 +Model: CAM +Version: CAM3.2.20 +One-line Summary: removed the comhyb.h commonblock, made hycoef a module. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: 055 cs999 TCS.ccsm.sh ER.01a T31_gx3v5 K +cam3_2_19 fails ccsm build, that failure is carried forward. + +Tested to work coupled with CCSM (create_ccsmcam): no - see above +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +changes made: removed the file comhyb.h and created a module hycoef. subroutine hycoef is renamed hycoef_init and the common block variables from comhyb +are now module variables. Replaced #include with +use hycoef, only : +this change affected a number of files across the structure. + +=============================================================== +=============================================================== + +cam3_2_19 +Originator: pworley (Pat Worley), eaton ( Brian Eaton) +Date: Tue Sep 6 16:01:22 MDT 2005 +Model: CAM +Version: CAM3.2.19 +One-line Summary: cray performance, XT3 support, timing lib mods +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes - restore Cray performance to levels before commit of cam3_2_1; + also, timing lib changes improve SGI Altix performance significantly. +Requires change in run script: no +Ran test_driver.sh script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: The CCSM test is failing because the CCSM scripts don't use CAM's Makefile. Will fix + the test by updating the appropriate CCSM template file. +Tested to work coupled with CCSM (create_ccsmcam): fails +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Worley, Eaton, Conley +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +> Makefile +> - set default C compiler to mpcc_r for AIX (was "cc") +> - added support for Cray XT3 in Linux section. +> (For XT3, set +> USER_FC := ftn +> USER_CC := cc +> and add -DCATAMOUNT to USER_CPPDEFS ). +> +> control/cam.F90 +> - added four timer calls (mpi_wtime), to get basic +> performance data (total, stepon, SYPD based on stepon time) +> even when -DDISABLE_TIMERS is specified. +> - moved first t_start calls to after spmdinit is called, +> to allow mpi_wtime to be used in the timing library +> - moved trunc call to after first t_start call, so as to +> include in measured initialization phase +> - #ifdef CATAMOUNT +> ! Improve performance of writing to standard out and error on XT3 +> ! (using Catamount kernel) by increasing buffer size. +> call usetlbuf() +> #endif +> +> control/get_memusage.c +> - Linux branch of get_memusage breaks the code on the XT3. +> Disabled the routine when CATAMOUNT defined. +> +> #ifdef CATAMOUNT +> return -1; +> #else ... +> +> dynamics/fv/cd_core.F90 +> - added CSD call (Cray Streaming Directive, for use on Cray X1(E) ) +> that was mistakenly not included in earlier check-in. +> +> physics/cam1/aerosol_radiation_interface.F90 +> - promoted local 1D arrays to 2D; added CSD; moved diagnostic output +> to separate loop; in order to recover vectorization and streaming +> lost in cam3_2_1 check-in +> +> physics/cam1/radsw.F90 +> - deleted hanging CSD region delimiter +> +> utils/timing/gptl.c +> - added support for using mpi_wtime instead of gettimeofday when +> SPMD specified. (This improves performance on SGI Altix significantly, +> and allows timers to be used on Cray XT3.) +> - added call to rtcrate on Cray X1(E) systems, removing hardcoded +> ticks_per_sec value (that is different on X1 and X1E). +> - increased number of digits in timing data output +> +> utils/timing/private.h +> - defined fields needed when using mpi_wtime to measure time +> +> 2 files added: +> +> control/uselbuf.c +> +> - set system buffering for output to stdout and stderr. +> Needed on Cray XT3 to workaround performance problem. +> +> utils/timing/rtcrate.F90 +> +> - C-callable Fortran function that calls irtc_rate intrinsic +> and returns the value (when #ifdef UNICOSMP). + + + +=============================================================== +=============================================================== + +cam3_2_18 +Originator: jedwards (Jim Edwards) eaton (Brian Eaton) +Date: Mon Sep 5 09:42:57 MDT 2005 +Model: CAM +Version: CAM3.2.18 +One-line Summary: spmd_utils module mods +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: jedwards, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Consolidate code into spmd_utils.F90 that sets up the generic spmd +environment. In particular, move pmgrid variables masterproc and iam, +spmd_dyn variables npes, nsmps, proc_smp_map, and the subroutines from the +files spmdinit.F90 and swap_comm.F90 into the spmd_utils module. The +subroutine spmdinit has been modified to initialize these public variables +whether SPMD is defined or not. Hence the "ifdef SPMD" conditional has +been removed from the call to spmdinit in the main cam program. + +Because these variables are so widely used this change touches about 150 +files. Most the changes are only one or two lines of modified "use" +association statements. + +=============================================================== +=============================================================== + +cam3_2_17 +Originator: erik ( Erik Kluzek) +Date: Tue Aug 30 16:32:07 MDT 2005 +Model: CAM +Version: CAM3.2.17 +One-line Summary: Resolve special physics modes beneath driver, move surface restart to seperate call +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: ideal-phys bit-for-bit test + 029 bl335 TBL.sh f4dh idphys 9 ....................................FAIL! rc= 7 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) (Except FV ideal_phys test, because was previously broken) +Changes to CLM land-model: Add noland mode for adibatic,ideal_phys, aqua +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Resolve the non-physics modes of CAM (adiabatic, ideal_phys, and aquaplanet) +below the driver level, so that components know the appropriate action, but +the driver isn't aware of it. Continue to use the common block for the data +that signals this behavior, but move the behavior completely inside of ice, +ocean or land surface models. + +Also move the read of surface initial data and restart information outside +of cam_intial and read_restart to methods just before surface model +initialization. This means breaking up the restart so that intht is called +later, the read_history is called later, and the close of nrg is done at this +later step as well. Move the nrg unit numbers to wholy contained within the +relevent restart modules. + +This actually allows CCSM mode to make use of ideal_phys, or adiabatic, +unlike previously where it wasn't a possiblity. + +Documentation fully spelled out at: + +Pre-ESMF Stage-1.2.3 checkin from + + http://swiki.ucar.edu/start/82 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_16 +Originator: jedwards ( James Edwards) +Date: Mon Aug 29 20:40:09 MDT 2005 +Model: CAM +Version: CAM3.2.16 +One-line Summary: added 'only' clause to some and removed other module statements +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.sh script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml + +Changes Made: + minor changes were made to a number of files which use modules from + the dynamics directories. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_15 +Originator: erik ( Erik Kluzek) +Date: Mon Aug 22 11:36:09 MDT 2005 +Model: CAM +Version: CAM3.2.15 +One-line Summary: Split comsrf into three parts move calls to surface models up to cam.F90 and stepon.F90 level +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.sh script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) + License problems with scamtest +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Pass in new structures to it +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Put cam3_2_14_brnchT_chghilev_2 on the main trunk (with some SCAM changes made so +that CRM should operate properly). Didn't test for anything beyond testscript. + +Changes defined in pre-ESMF Stage-1-2 + + http://swiki.ucar.edu/start/73 + +Make physpkg into a module with and initial and 2 run phase methods. +Move the initialization calls of the surface models to cam.F90. +Move the run calls of the surface models to stepon.F90. + +Divide comsrf into 3 parts: + +comsrf.F90 ------- miscellaneous 2D arrays that should be moved into relevant packages (physics, + ice, or ocean) +camhub_comp.F90 --- Responsible for merging surface models (land, ice, ocean) into a merged + surface state +camsrfexch_types -- definition of derived data types for exchange of surface information + between surface models + +Move landfrac, ocnfrac and icefrac into merged surface derived type. + +Move instantiation of surface exchange types to top driver level. Pass down data types +to relevant subroutines. + +Make physpkg into a module with and initial and 2 run phase methods. +Move the initialization calls of the surface models to cam.F90. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_14 +Originator: boville (Byron Boville), eaton (Brian Eaton) +Date: Fri Aug 12 16:12:13 MDT 2005 +Model: CAM +Version: CAM3.2.14 +One-line Summary: history module mods +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: boville, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Some cleanup of the history module - mainly moving addfld and add_default +calls to the modules that are responsible for defining a quantity and +making outfld calls for it. This gets rid of most of bldfld and h_default. +What remains of those subroutines has been merged into bldfld, and bldfld +has been moved into history_defaults.F90 which we expect to eventually go +away. Also, the SCAM specific routines have been put into +history_scam.F90. What's left in the history module is intended to be the +generic history module interface. + +The functionality of the history module has been extended so that the +defined history files don't have to be sequential, e.g., a user can now +remove fincl2 from a namelist that contains specifications for fincl2 and +fincl3 without having to rename fincl3 to fincl2. Previously the renaming +would have been necessary because having the 2nd history file empty when +the 3rd file was not empty was not allowed. However, this new +functionality was not motivated by increased user convenience which is +pretty negligible. The real reason for this change was to allow more +flexibility in where the calls are made to add fields to the initial file +which is just a special history file which is always the last one in the +list. By allowing the list to contain empty files, the index of initial +file can now be terminal list index which is known at compile time, rather +than being the index that follows the last user or code defined history +file which isn't known until after processing all the add_default calls +which can occur at any point during the physics initialization. + +precc_thresh and precl_thresh have been removed from the namelist. + + +=============================================================== +=============================================================== + +cam3_2_13 +Originator: mvr ( Mathew Rothstein) +Date: Thu Aug 11 12:29:05 MDT 2005 +Model: CAM +Version: CAM3.2.13 +One-line Summary: Added tests to default CAM test suite; various bug fixes and cleanup +cam-bugs Requests resolved: none +Requires change in build system: yes +Makefile changed for pathf90; added -ftpp option to handle directive +embedded in multi-line data statement +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM: yes +Tested to work with SCAM: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +R models/atm/cam/test/system/create_ccsmcam +- most stuff was merged into TCB.ccsm.sh + +A models/atm/cam/bld/run-lightning.csh +- new self-contained example run script specifically for lightning platform +A models/atm/cam/test/system/TMC.sh +- new script for the testing of mass conservation parameters +A models/atm/cam/test/system/TSB.ccsm.sh +- new generic script that will submit a specified ccsm test and include a + baseline test if appropriate + +M models/atm/cam/bld/Makefile +- added pathf90 compiler option -ftpp, needed to pre-process a directive + embedded in a multi-line data statement +M models/atm/cam/src/control/history.F90 +- bug fix for the setting of time_bnds for branch runs +- bug fix for the writes of flag_xyfill and flag_isccplev to the restart file +M models/atm/cam/src/control/time_manager.F90 +- added method get_prev_time (analogous to get_curr_time) +M models/atm/cam/src/physics/cam1/qneg3.F90 +- made mods recommened by dave parks for NEC efficiency +M models/atm/cam/test/system/TBL.sh +- will now skip entirely if not testing vs baseline +- bug fix for mkdir validation +M models/atm/cam/test/system/TBR.sh +- reordering of algorithm for efficiency +- bug fix for mkdir validation +M models/atm/cam/test/system/TCB.ccsm.sh +- complete overhaul; is now just a wrapper script for ccsm's create_test with + some sed commands +M models/atm/cam/test/system/TCB.sh +- bug fix for mkdir validation +M models/atm/cam/test/system/TCS.ccsm.sh +- major overhaul to work with new script TSB.ccsm.sh +M models/atm/cam/test/system/TEQ.sh +- bug fix for mkdir validation +M models/atm/cam/test/system/TER.sh +- reordering of algorithm for efficiency +- bug fix for mkdir validation +M models/atm/cam/test/system/TRX.sh +- reordering of algorithm for efficiency +- bug fix for mkdir validation +M models/atm/cam/test/system/TSM.sh +- bug fix for mkdir validation +M models/atm/cam/test/system/input_tests_aix +- replaced TCB.ccsm.sh with TSB.ccsm.sh in default list +M models/atm/cam/test/system/input_tests_linux +- added the tests for mass conservation to defaul list +M models/atm/cam/test/system/input_tests_master +- added mass conservatin tests, ccsm submit test, most smoke tests now 9 steps +M models/atm/cam/test/system/scamtest.sh +- bug fix for mkdir validation +M models/atm/cam/test/system/test_driver.sh +- now using newcprnc - required to recognize isccp variables +M models/atm/cam/test/system/nl_files/ghgrmp +- added namelist variable to turn on isccp simulator for testing + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_12 +Originator: erik ( Erik Kluzek) +Date: Wed Aug 10 12:53:31 MDT 2005 +Model: CAM +Version: CAM3.2.12 +One-line Summary: Get rid of #ifdefs refering to CAMSURF from cam3.2.3 commit +cam-bugs Requests resolved: none +Requires change in build system: no (but you can get rid of references to CAMSURF in misc.h) +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: Most bit-for-bit tests fail as this is an answer changing commit +On bangkok: +004 bl111 TBL.sh e8c8mdm ttrac 9 ..................................FAIL! rc= 7 +007 bl112 TBL.sh e8sdm ghgrmp 9 ...................................FAIL! rc= 7 +011 bl153 TBL.sh e64m outfrq24h -2 ................................FAIL! rc= 7 +015 bl311 TBL.sh f10c8mdm ttrac 9 .................................FAIL! rc= 7 +022 bl312 TBL.sh f10sdm ghgrmp 9 ..................................FAIL! rc= 7 +026 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +030 bl511 TBL.sh s8c8mdm ttrac 9 ..................................FAIL! rc= 7 +033 bl512 TBL.sh s8sdm ghgrmp 9 ...................................FAIL! rc= 7 +037 bl553 TBL.sh s64m outfrq24h -2 ................................FAIL! rc= 7 +On bluesky: +005 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 +008 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 +015 bl151 TBL.sh e64h outfrq24h -2 ................................FAIL! rc= 7 +019 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +022 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +030 bl336 TBL.sh wm4h outfrq3s 9..................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +037 bl354 TBL.sh fm2dh outfrq3s 9 .................................FAIL! rc= 7 +040 bl355 TBL.sh fmo2dh off2x2.5 9 ................................FAIL! rc= 7 +044 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 +047 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 +054 bl551 TBL.sh s64h outfrq24h -2 ................................FAIL! rc= 7 +On tempest: +004 bl131 TBL.sh e32c11dh pghgsul 9 ...............................FAIL! rc= 7 +007 bl132 TBL.sh e32sdh ghgrmp 9 ..................................FAIL! rc= 7 +014 bl152 TBL.sh e64o outfrq24h -2................................FAIL! rc= 7 +017 bl314 TBL.sh wg10dh outfrq3s 9 ................................FAIL! rc= 7 +021 bl331 TBL.sh f4c11dh pghgsul 9 ................................FAIL! rc= 7 +024 bl332 TBL.sh f4sdh ghgrmp 9 ...................................FAIL! rc= 7 +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +035 bl531 TBL.sh s32c11dh pghgsul 9 ...............................FAIL! rc= 7 +038 bl532 TBL.sh s32sdh ghgrmp 9 ..................................FAIL! rc= 7 +045 bl552 TBL.sh s64o outfrq24h -2 ................................FAIL! rc= 7 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, eaton +Restart files change: no +Changes answers: Yes (same-physics) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + Get rid of all the #ifdef's refering to CAMSURF that went in with + the cam3.2.3 tag. + Basically, this tag gets the same answers as cam3.2.11 if you set + + #define CAMSURF CLIMATE_CAMSURF + + in misc.h and in configure script. + + The exception to this is that in this tag newiceproperties is + still called at initialization + in camice in camice_init. The reason for this is because there is + some initializion + that's important to do in newiceproperties. + + The code changes answers compared to cam3.2.11, and the changes + were validated with + simulations with FV and DOM at 4x5 resolution. Answers also change + for SOM, but this + wasn't verified. + + /ERIK/csm/cam324_fv4x5dom_camsurf_1 --- Experiment based + off cam3.2.4 (10 years) + vs. + /ERIK/csm/cam321_fv4x5dom_1 -- control of cam3.2.1 (10 + years) + + Plots are available from + + http://www.cgd.ucar.edu/~erik/AMWG_diag/cam324_fv4x5dom_camsurf_1-cam321_fv4x5dom_1/ + + The difference in the code is primarily to unify the merging of + surface fields at + timestep==0 with that done while time-stepping. And to unify how + the ocean-ice + diagnostic fluxes are calculated at time-step==0 with when + time-stepping. Also in + order to remove a dependency on the order that ocean and ice are + called, I also use + 1-landfrac rather than ocnfrac as a mask for certain + calculations. This changes + answers for SOM at each time-step. + + The tests that fail have to do with bit-for-bit comparisions with + cam3.2.11. Some + of the bit-for-bit tests pass, if they run ideal-phys, adiabatic, + or aqua-planet. + Also error-growth tests are identical as error-growth is run in + aqua-planet mode. + +See: +http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_11 +Originator: sawyer (Will Sawyer), eaton (Brian Eaton) +Date: Fri Aug 5 11:47:16 MDT 2005 +Model: CAM +Version: CAM3.2.11 +One-line Summary: Cleanup and performance mods for FV +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes (performance improvements for FV on Cray and NEC SX) +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: +on bluesky: +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 7 +034 bl351 TBL.sh f2h outfrq24h -2 .................................FAIL! rc= 7 +on bangkok: +026 bl353 TBL.sh f2m outfrq24h -2 .................................FAIL! rc= 7 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: sawyer, eaton +Restart files change: no +Changes answers: no, except roundoff introduce into FV +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Replace the original dynamics_vars.F90 by the new version. + +Add performance mods for both Cray X1 and NEC SX (from Art Mirin and Pat Worley). + +Clean up implementation of options for using platform optimized FFT +libraries (from Art Mirin and Pat Worley). + +Remove SAVEd variables in cd_core. This will come close to making the code +reentrant. + +Explain failed tests: + +These tests all failed due to a roundoff level changed introduced in the FV dycore. Since no +tests that had debug enabled failed, we assume this is an optimization issue. The roundoff level +changes were verified by perturbation growth tests on both bluesky and bangkok, but only for +the configuration of tests bl351 and bl353. Test bl336 is a waccm_mozart configuration and +the pergro test does not currently work there. + +=============================================================== +=============================================================== + +cam3_2_10 +Originator: sawyer (Will Sawyer), eaton ( Brian Eaton) +Date: Tue Aug 2 18:02:15 MDT 2005 +Model: CAM +Version: CAM3.2.10 +One-line Summary: Bug fix for FV in OMP-only mode +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: sawyer, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +dynamics/fv/p_d_adjust.F90 +. add "pole" to private variables in first OMP directive + +=============================================================== +=============================================================== + +cam3_2_9 +Originator: dcn (David Noone), eaton ( Brian Eaton) +Date: Tue Jul 26 17:57:28 MDT 2005 +Model: CAM +Version: CAM3.2.9 +One-line Summary: mods for water isotopes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) +on tempest: +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: dcn, eaton +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +This is an incremental commit of mods to incorporate water isotopes into +CAM. Added mods to manage the water isotope constituents. Added mods to +allow the cloud sedimentation and ocean evaporation processes to act on +these constituents. + +The regression test that fails is due to a bug in the FV dycore introduced +in cam3_2_8. It has only been observed in pure OMP mode on the SGI. + + +=============================================================== +=============================================================== + +cam3_2_8 +Originator: sawyer, eaton ( Brian Eaton) +Date: Thu Jul 21 13:37:42 MDT 2005 +Model: CAM +Version: CAM3.2.8 +One-line Summary: update FV dycore, part 1 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no (only tested IBM) +Requires change in run script: no +Ran test_driver.sh script: yes +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: +On tempest: +031 bl352 TBL.sh f2o outfrq24h -2 .................................FAIL! rc= 7 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: spectral dycores are bit-for-bit, fv has roundoff change +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Update the FV dycore to contain new code from the GEOS5 version. The new +code includes derived types to encapsulate grid and state information. +Currently we've only used the grid type. The dynamics state remains module +data in the prognostics module. The new grid type replaces most of the +previous uses of the pmgrid and spmd_dyn modules although there is still +cleanup work to be done. There was also a change in the polar filtering +code which introduces a roundoff level change in the FV simulations. The +change was implemented as a bug fix to the problem that answers were +depending on the X decomposition when the 2D decomp option was used. + + +=============================================================== +=============================================================== + +cam3_2_7 +Originator: mvr ( Mathew Rothstein) +Date: Tue Jul 19 11:31:59 MDT 2005 +Model: CAM +Version: CAM3.2.7 +One-line Summary: Fix for CCSM testing within CAM test suite; other test suite enhancements, cleanup +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +R models/atm/cam/bld/CAM.pm +R models/atm/cam/bld/CAM_lab.pm +R models/atm/cam/bld/CAM_run.pm +R models/atm/cam/bld/Design.tex +R models/atm/cam/bld/Requirements.tex +R models/atm/cam/bld/bldtex.csh +R models/atm/cam/bld/condense-path.pl +R models/atm/cam/bld/fvtest.sh +R models/atm/cam/bld/graphgrowth.csh +R models/atm/cam/bld/lab_default.pm +R models/atm/cam/bld/run-model.pl +- cleaned up obsolete files from bld directory + +R models/atm/cam/test/system/TER.ccsm.sh +- script made more generic and renamed - see the new file TCS.ccsm.sh + +A models/atm/cam/test/system/TCS.ccsm.sh +- generic script to check the status of a coupled cam run + +M models/atm/cam/test/system/TBL.sh +- status file renamed for consistency, algorithm re-ordered for efficiency +M models/atm/cam/test/system/TBR.sh +- status file renamed for consistency, algorithm re-ordered for efficiency +M models/atm/cam/test/system/TCB.ccsm.sh +- will now configure build and submit ccsm run for specified test/config +M models/atm/cam/test/system/TCB.sh +- status file renamed for consistency +M models/atm/cam/test/system/TEQ.sh +- status file renamed for consistency +M models/atm/cam/test/system/TER.sh +- status file renamed for consistency, algorithm re-ordered for efficiency +M models/atm/cam/test/system/TRX.sh +- status file renamed for consistency, algorithm re-ordered for efficiency +M models/atm/cam/test/system/TSM.sh +- status file renamed for consistency +M models/atm/cam/test/system/create_ccsmcam +- modified to use CAM sandbox for coupled test rather than CAM of CCSM tag +M models/atm/cam/test/system/input_tests_aix +- new testid for ccsm check status test +M models/atm/cam/test/system/input_tests_master +- new argument lists for ccsm tests (test, resolution, component set) +M models/atm/cam/test/system/scamtest.sh +- status file renamed for consistency +M models/atm/cam/test/system/test_driver.sh +- now allows batch jobs to run from their own directory if env var CAMROOT set +M models/atm/cam/test/system/CAM_runcmnd.sh +- corrected documentation in the comments +M models/atm/cam/tools/scam/testscript +- removed unnecessary output file + +M models/atm/cam/test/system/nl_files/adia +M models/atm/cam/test/system/nl_files/aqpgro +M models/atm/cam/test/system/nl_files/ghgrmp +M models/atm/cam/test/system/nl_files/idphys +M models/atm/cam/test/system/nl_files/no_ttrac +M models/atm/cam/test/system/nl_files/off2x2.5 +M models/atm/cam/test/system/nl_files/outfrq24h +M models/atm/cam/test/system/nl_files/outfrq3s +M models/atm/cam/test/system/nl_files/ttrac +M models/atm/cam/test/system/nl_files/ttrac_lb1 +M models/atm/cam/test/system/nl_files/ttrac_lb2 +M models/atm/cam/test/system/nl_files/ttrac_lb3 +- namelists now specify secondary history tape names, freqs, and use 64-bit + +M models/atm/cam/bld/run-ibm.csh +M models/atm/cam/bld/run-pc.csh +M models/atm/cam/bld/run-sgi.csh +- updated the self-contained example run scripts + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_6 +Originator: fvitt ( Francis Vitt) +Date: Wed Jul 13 09:34:52 MDT 2005 +Model: CAM +Version: CAM3.2.6 +One-line Summary: Fixed bug in earth-sun distance factor used in waccm +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +bluesky, tempest, bangkok +Test id's that fail: +on bluesky -- bug fix in waccm resulted in failure of base line comparison +030 bl336 TBL.sh wm4h outfrq3s 9 ..................................FAIL! rc= 6 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Stacy Walters +Restart files change: no +Changes answers: no (bit-for-bit) or Yes +bit-for-bit except for waccm +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +models/atm/cam/src/chemistry/waccm_mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/waccm_mozart/mo_waccm_hrates.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_5 +Originator: mvr ( Mathew Rothstein) +Date: Mon Jul 11 15:56:16 MDT 2005 +Model: CAM +Version: CAM3.2.5 +One-line Summary: Removal of params.h and misc.h (clm code excluded) +cam-bugs Requests resolved: none +Requires change in build system: yes +#defines of misc.h and params.h now passed to Makefile via cppdefs +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: +cb999, er999 (ccsm test on bluesky) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +M models/atm/cam/bld/configure +- moved #define's of params.h and misc.h into cppdefs +- removed creation of params.h (misc.h still temporarily remains for clm code) +M models/atm/cam/bld/Makefile +- no longer looks for SPMD specification in misc.h + +**also modified all fortran and c files to remove #include of misc.h and +params.h (excluding clm code) + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_4 +Originator: jeff ( Yen-Huei Lee) +Date: Sun Jul 3 13:48:55 MDT 2005 +Model: CAM +Version: CAM3.2.4 +One-line Summary: fix tro_mozart to allow extra tracers, bug fix to run in ccsm, output co2 fluxes to history tape, add index for fdms +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: none (Get clearance for failed tests, enter lines from td.*.status files that fail) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +M models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 + allow trop_mozart to run with extra tracers, i.e. CO2. + +M models/atm/cam/src/physics/cam1/physpkg.F90 + bug fix to allow ccsm to run + +M models/atm/cam/src/physics/cam1/co2_cycle.F90 +M models/atm/cam/src/control/ccsm_msg.F90 + output co2 fluxes to history tape + +M models/atm/cam/src/physics/cam1/comsrf.F90 + add index for fdms + +M models/atm/cam/src/dynamics/fv/fv_prints.F90 + bug fix + +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml + use new data sad_file for waccm_mozart + +=============================================================== +=============================================================== + +cam3_2_3 +Originator: erik ( Erik Kluzek) +Date: Thu Jun 30 00:18:39 MDT 2005 +Model: CAM +Version: CAM3.2.3 +One-line Summary: Move cam3_2_2_brnchT_srfsimp6 to cam_dev -- makes surface (ocean, land, sea-ice) more modular +Requires change in build system: yes +(Requires CAMSURF defines in misc.h) +Substantial timing or memory changes: no +Requires change in run script: no +Ran test_driver.shl script: yes (does all of the following tests) +Machines tested: IBM, SGI, Linux-Lahey +Test id's that fail: Bluesky: 1, 5,8,15,22,30,34,37,40,44,47,54,55 + 5-54 fail because diagnostic fields change + 001 cb999 TCB.ccsm.sh .............................................FAIL! rc= 4 + 055 er999 TER.ccsm.sh .............................................FAIL! rc= 2 +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, mvertens +Restart files change: yes +Changes answers: no (bit-for-bit) (some ocean/ice diagnostic fields + change to roundoff at time=0) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Add following to misc.h: + +#define B4B_CAMSURF -2 +#define RND_CAMSURF -1 +#define CLIMATE_CAMSURF 0 +#define CAMSURF B4B_CAMSURF + +This allows answers to be the same as current model, while allowing +ifdefs that can provide changes to roundoff or climate-changing. + +Move tsnam and plevmx to ice_constants + +Shorten initext and remove tangled dependencies of surface models. +Create initialization methods for sea-ice and oceanm that are called by +initext. Move surface methods in physpkg to run methods in ocean, and ice. + +Make camice and somocn, and camocn into modules with various methods. +Move ice_read from inidat to camice. Move write_restart, read_restart +of ice to camice methods. + +Make comsrf more modular. Move data specific to ocean, ice, or land +out of comsrf. Create merge method, and make some methods private. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_2 +Originator: mvr ( Mathew Rothstein) jeff, mvertens, eaton +Date: Wed Jun 15 16:37:19 MDT 2005 +Model: CAM +Version: CAM3.2.2 +One-line Summary: configure/build-namelist mods for calls from ccsm and a plethora of bug fixes +cam-bugs Requests resolved: none +Requires change in build system: yes - now enabled for ccsm +Substantial timing or memory changes: no +Requires change in run script: yes - now enabled for ccsm +Tested to work coupled with CCSM (create_ccsmcam): not create_ccsmcam, but other +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey,pgi +Ran test_driver.shl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself,eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes - logical restart writes changed to ints +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: +R models/atm/cam/tools/icesst/bcgen/namelist.T42 +R models/atm/cam/tools/icesst/bcgen/namelist.T42.oldtt +R models/atm/cam/tools/icesst/bcgen/namelist.T5 +- cleanup of files resulting from regeneration of sst datasets + +A models/atm/cam/tools/icesst/bcgen/namelist +- new file required of modified method to generate sst datasets +A models/atm/cam/test/system/config_files/wm4h +- new configuration options file for waccm test without debug + +M models/atm/cam/bld/CAM_namelist.pm +M models/atm/cam/bld/build-namelist +M models/atm/cam/bld/namelist.pm +- mods required for CAM's build-namelist script to be called from within CCSM + +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml +M models/atm/cam/bld/DefaultCLMEXPNamelist.xml +- new defaults for 1.9x2.5 topo datasets + +M models/atm/cam/bld/configure +- mods required for CAM's configure script to be called from within CCSM + +M models/atm/cam/src/chemistry/waccm_mozart/mo_setrxt.F90 +- bug fix to achieve b4b restart of waccm_mozart + +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/history.F90 +M models/atm/cam/src/control/restart.F90 +M models/atm/cam/src/control/time_manager.F90 +M models/lnd/clm2/src/main/histFileMod.F90 +- all logical restart writes are now integers (workaround to pathscale bug) + +M models/atm/cam/src/physics/cam1/co2_cycle.F90 +M models/atm/cam/src/physics/cam1/radiation.F90 +- change co2 tracer from moist to dry + +M models/atm/cam/src/control/ccsm_msg.F90 +- change unit of co2 flux from kgC/m2/s to kgCO2/m2/s + +M models/atm/cam/src/physics/cam1/srfxfer.F90 +- bug fix for computation of netsw in coupled mode + +M models/atm/cam/test/system/input_tests_master +- modified to now test waccm_mozart in non-debug mode + +M models/atm/cam/test/system/scamtest.sh +- bug fix for output of test results + +M models/atm/cam/tools/definesurf/fmain.f90 +- land fractions < .001 set to zero; metadata now complies with CF conventions + +M models/atm/cam/tools/icesst/README +- describe -g option for reading grid info from file + +M models/atm/cam/tools/icesst/bcgen/bcgen.f90 +- pass the history attribute to setup_outfile + +M models/atm/cam/tools/icesst/bcgen/driver.f90 +- input & output filepaths now specified on command-line +- generate the history attribute + +M models/atm/cam/tools/icesst/bcgen/setup_outfile.f90 +- add history attribute to both output files + +M models/atm/cam/tools/icesst/regrid/regrid.f90 +- Modify so that output grid coordinates can be read from the new grid files + +M models/atm/cam/tools/icesst/regrid/wrap_nf.f90 +- add wrap_nf_put_var_int + +M models/atm/cam/tools/scam/ui/crm.cpp +- updated aerosol optics file to be used for column radiation model test +M models/atm/cam/tools/scam/userdata/crmtest26.out +- updated validation file for column radiation model test + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_2_1 +Originator: aconley ( Andrew J. Conley) +Date: Fri Jun 3 17:29:46 MDT 2005 +Model: CAM +Version: CAM3.2.1 +One-line Summary: Improve interface between radiation (LW and SW) and aerosols +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: Yes (problems for vector architecture) +Requires change in run script: Yes + Added new data to AerosolsOptics file. So CAM namelist has changed +Tested to work coupled with CCSM (create_ccsmcam): No: ccsm namelist is now out of date +Tested to work with SCAM (tools/scam/testscript): No: crm part of test fails now because of change to Aerosol Optics +Machines tested: IBM, SGI, Lahey +Ran test_driver.shl script: No: ran test_driver.sh +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: not for waccm +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: Yes (no change to climate, but larger than roundoff changes) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + + + New files: aerosol_radiation_interface.F90 + aerosol_index.F90 + Deleted: volcrad.F90 + Changed: DefaultCAMExpNamelist + runtime_opts.F90 + advnce.F90 + aer_optics.F90 + aerosol_intr.F90 + inti.F90 + prescribed_aerosols.F90 + radae.F90 + radiation.F90 + radsw.F90 + volcanicmass.F90 + + +=============================================================== +=============================================================== + +cam3_2_0 +Originator: mvertens ( Mariana Vertenstein) +Date: Mon May 30 15:53:48 MDT 2005 +Model: CAM +Version: CAM3.2.0 +One-line Summary: incorporated clm3_expa_29 into stand-alone cam +cam-bugs Requests resolved: none +Requires change in build system: yes (new clm cpp variable added) +Substantial timing or memory changes: no (unless CN code is activated) +Requires change in run script: all clm surface datasets have changed +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, +Restart files change: no +Changes answers: new-climate +Changes to CLM land-model: Yes (see below) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +The following code changes accompany the incorporation +of new CLM code - clm_expa_29 - into the stand-alone CAM +development code base. As part of these changes, new CLM +raw datasets were used to create the clm model surface +datasets. All CLM surface datasets were regenerated using +the new raw datasets. In addition, clm3_expa_29 also contains the +the incorporation of the carbon-nitrogen cycle into the CLM code base +(both Peter Thornton's CN model and the CASA carbon cycle model). +A detailed summary of climate changing modifications appears below. +Finally, clm3_expa_29, contains the flexibility, for the first time, +to run dynamic land use runs using prescribed land use datasets. + +Note that generating clm surface datasets is now accomplished +via an offline tool in mksrfdata/tools/mksrfdat. This is not +part of the standard cam clm/tools directory yet +due to the current structure of the cam cvs module. +This will be incorporated into cam in a subsequent cam checkin. + +Validation simulations were carried out for 1979-2000 with annually varying SSTs. + +The tags used for hyd_clm3_1 were cam3_1_7 and clm3_expa_29 +(camroot = /fis/cgd/cseg/people/mvertens/src/cam/cam3_1_7_clm3_expa_29) + +The changes between hyd_clm3_1 and hyd_con were: +o New SST dataset (amipbc_sst_T42_1949_2004.nc as opposed to sst_HadOIBl_bc_64x128_1949_2001_c020411.nc) +o Albedo calculation in CLM moved to end of second biophysics loop +o Peter Thornton's 2-leaf canopy model +o Peter Lawrence's MODIS-based surface dataset (distribution of plant + functional types, LAI, and soil color) +o David Lawrence's and Peter Thornton's hydrology modifications (includes + new formulations for interception, infiltration (surface runoff), soil + moisture effects on stomatal conductance, soil to canopy air space transfer + coefficients, soil hydraulic conductivity, and baseflow. + +=============================================================== +=============================================================== + +cam3_1_9 +Originator: boville, eaton +Date: Fri May 27 09:55:54 MDT 2005 +Model: CAM +Version: CAM3.1.9 +One-line Summary: WACCM bugfix +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: boville +Restart files change: no +Changes answers: no (bit-for-bit) except WACCM_MOZART changes answers +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +chemistry/waccm_mozart/chemistry.F90 +. Fix initialization of qmin. + +=============================================================== +=============================================================== + +cam3_1_8 +Originator: boville, eaton ( Brian Eaton) +Date: Tue May 17 18:33:16 MDT 2005 +Model: CAM +Version: CAM3.1.8 +One-line Summary: Merge latest WACCM development code +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: boville, eaton +Restart files change: no +Changes answers: CAM is bit-for-bit, WACCM has a new climate. +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Merge latest WACCM development code. + +There is a new feature in the FV tracer code (trac2d.F90) which allows the +timestep splitting to differ in different vertical layers. This feature is +currently only enabled for the WACCM_MOZART configuration since it can +introduce answer changes into the standard CAM FV configurations. + +Add LAPACK_LIBDIR macro to Makefile to allow specifying the location of the +LAPACK and BLAS libraries. Optional use is made of these libraries in +WACCM specific code (on AIX only). + +Add the use of the massv library to the AIX section of the Makefile. The +use of this library introduces roundoff level differences into the +simulation when changing the parallel configuration. This library is only +used in WACCM_MOZART specific code. + +In the IRIX64 section of the Makefile the -cpp option was replaced with +-macro_expand. A WACCM_MOZART ifdef which was including code in a +multi-line data statement was failing to compile otherwise. + +=============================================================== +=============================================================== + +cam3_1_7 +Originator: mvr ( Mathew Rothstein) +Date: Wed May 4 12:14:23 MDT 2005 +Model: CAM +Version: CAM3.1.7 +One-line Summary: Updating the new cam test framework with new tests and other enhancements +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +A models/atm/cam/test/system/TEQ.sh +- new generic script to test the equivalence of two cam smoke runs +A models/atm/cam/test/system/TRX.sh +- new script to test the restart of cam using fv 2d decomposition +A models/atm/cam/test/system/scamtest.sh +- new script to test scam and crm +A models/atm/cam/test/system/config_files/f10dm +A models/atm/cam/test/system/config_files/fm2dh +A models/atm/cam/test/system/config_files/fmo2dh +A models/atm/cam/test/system/config_files/wg10dh +A models/atm/cam/test/system/config_files/wm4dh +- new configuration options files for added tests +A models/atm/cam/test/system/nl_files/no_ttrac +A models/atm/cam/test/system/nl_files/off2x2.5 +A models/atm/cam/test/system/nl_files/ttrac_lb1 +A models/atm/cam/test/system/nl_files/ttrac_lb2 +A models/atm/cam/test/system/nl_files/ttrac_lb3 +- new namelist options files for added tests + +M models/atm/cam/test/system/CAM_compare.sh +M models/atm/cam/test/system/TBL.sh +M models/atm/cam/test/system/TBR.sh +M models/atm/cam/test/system/TCB.ccsm.sh +M models/atm/cam/test/system/TCB.sh +M models/atm/cam/test/system/TER.ccsm.sh +M models/atm/cam/test/system/TER.sh +M models/atm/cam/test/system/TSM.sh +M models/atm/cam/test/system/input_tests_aix +M models/atm/cam/test/system/input_tests_irix +M models/atm/cam/test/system/input_tests_linux +M models/atm/cam/test/system/input_tests_master +M models/atm/cam/test/system/test_driver.sh + +mods and enhancements to the new cam test framework scripts including: +- added waccm tests +- added test for load balancing +- added test for the fv offline driver +- added test for fv 2d decomposition +- moved scam/crm test into default tests +- will now stop on first failure for interactive runs by default and + added environment variable CAM_SOFF to override default behavior +- cleaned up handling of shell string variables +- now backs up directories of failed tests when reattempting + +M README +- updated with the wording used for release + + + (Put your detailed description of the changes you made here...) + (You will get your edited copy e-mailed to you. It will also be) + (sent to cam-dev@cgd.ucar.edu.) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_1_6 +Originator: jeff ( Yen-Huei Lee) +Date: Sat Apr 30 12:25:17 MDT 2005 +Model: CAM +Version: CAM3.1.6 +One-line Summary: allow model year to be different from ghg data year +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/chemistry/waccm_mozart/chem_surfvals.F90 +M models/atm/cam/src/physics/cam1/chem_surfvals.F90 +M models/atm/cam/src/physics/cam1/advnce.F90 +M models/atm/cam/src/physics/cam1/srfxfer.F90 +M models/atm/cam/src/physics/cam1/radiation.F90 +M models/atm/cam/src/physics/cam1/co2_cycle.F90 +D models/atm/cam/src/physics/cam1/co2_data_scalar.F90 + +Function add: + +use the following namelists to set model start year and ghg data start year, + + ghg_yearStart_model = 1 + ghg_yearStart_data = 1950 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_1_5 +Originator: eaton ( Brian Eaton) +Date: Mon Apr 25 18:17:11 MDT 2005 +Model: CAM +Version: CAM3.1.5 +One-line Summary: fix CCSM test, update definesurf tool +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): no +Machines tested: IBM +Ran test_driver.shl script: Only ran CCSM test +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None (one-line description) + +Changes made: + +Fix the CCSM test. + +Also add some modifications to the definesurf tool from Byron. These mods +relax the previous restriction that the same filter be applied to both SGH +and PHIS. + +=============================================================== +=============================================================== + +cam3_1_4 +Originator: jeff ( Yen-Huei Lee) +Date: Sat Apr 23 11:20:36 MDT 2005 +Model: CAM +Version: CAM3.1.4 +One-line Summary: add co2 tracer transport and using 2D co2 for radiation +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): no +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test_driver.shl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton +Restart files change: no +Changes answers: Yes (same-to-roundoff) +(Note: test_driver.sh only does checks this -- if you run it with "env BL_ROOT=") +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +The constant co2 value used for radiation computation was replaced by +2D co2 distribution (column-mean). This is responsible for the roundoff. + +Function added: + +co2 tracer can be transported with co2 fluxes from land (through coupler), +from ocean (through data file) and from fossil fuel (through data file). + +co2 scalar data can be read from data file and can be used as data-cycling +type operation. + +M models/atm/cam/src/control/cam.F90 +M models/atm/cam/src/control/initext.F90 +M models/atm/cam/src/control/ccsm_msg.F90 +M models/atm/cam/src/control/restart.F90 +M models/atm/cam/src/control/runtime_opts.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/physics/cam1/advnce.F90 +M models/atm/cam/src/physics/cam1/initindx.F90 +M models/atm/cam/src/physics/cam1/restart_physics.F90 +M models/atm/cam/src/physics/cam1/comsrf.F90 +M models/atm/cam/src/physics/cam1/inti.F90 +M models/atm/cam/src/physics/cam1/srfxfer.F90 +M models/atm/cam/src/physics/cam1/rad_constituents.F90 +M models/atm/cam/src/physics/cam1/radiation.F90 +M models/atm/cam/src/physics/cam1/radsw.F90 +M models/atm/cam/src/physics/cam1/radlw.F90 +M models/atm/cam/src/physics/cam1/radae.F90 +A models/atm/cam/src/physics/cam1/co2_cycle.F90 +A models/atm/cam/src/physics/cam1/co2_data_flux.F90 +A models/atm/cam/src/physics/cam1/co2_data_scalar.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_1_3 +Originator: eaton ( Brian Eaton) +Date: Thu Mar 31 08:51:32 MST 2005 +Model: CAM +Version: CAM3.1.3 +One-line Summary: move control of rad calcs into rad module. pathscale & g95 builds +cam-bugs Requests resolved: bugzilla IDs 4, 10, 13 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): no, currently broken +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Consolidate control of radiation calculations in the radiation module. +This includes resposibility for maintaining the namelist variables iradsw, +iradlw, iradae, and irad_always, and providing a function for the values +dosw, dolw, doabsems, and aeres. These variables have all been removed +from comctl.h. + +Add bugfix for turbulent mountain stress code. + +Add files to DefaultCAMEXPNamelist.xml needed for WACCM runs at 1.9x2.5 +resolution. + +Add Makefile sections and ESMF build to support pathscale and g95 compilers +on linux systems. + +Replace the PGF90 CPP macro with NO_R16. The PGF90 macro was being used to +indicate that the compiler doesn't support quad precision. But that's also +the case for the pathscale and g95 compilers. The use of a generic CPP +token allows new compilers to be supported by modifying the the Makefile to +specify the compiler properties without requiring source code modification. + +The g95 compiler doesn't recognize the cray pointer syntax in fv/geopk.F90. +The use of cray pointers there can't be trivially replaced by F90 pointers. +Since the cray pointers only appear in the geopk16 routine which is not +used by default, a CPP token NO_CRAY_POINTERS is defined for g95 and used +to stub out geopk16. endrun is called if the user sets the namelist +variable (geopktrans) to use geopk16 when NO_CRAY_POINTERS is defined. + +Add bugfix to cmfmca pointed out by David Noone. This only affects the +simulation of tracers using dry mixing ratio (none by default). The set of +test tracers enabled by setting the namelist variable +tracers_flag=.true. use a dry mixing ratio and are affected by this fix. + + +=============================================================== +=============================================================== + +cam3_1_2 +Originator: mvr ( Mathew Rothstein) +Date: Fri Mar 25 16:41:11 MST 2005 +Model: CAM +Version: CAM3.1.2 +One-line Summary: New testing framework for CAM - replaces test-model; and a few minor bug fixes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey, Linux-PGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +...and much, much more! +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + + +R models/atm/cam/test/system/babyblue.test-model.pl.log +R models/atm/cam/test/system/CAM_test.pm +R models/atm/cam/test/system/cam_timing.pm +R models/atm/cam/test/system/check-timing.pl +R models/atm/cam/test/system/dao_batch.csh +R models/atm/cam/test/system/default_tests.test-model.xml +R models/atm/cam/test/system/llnl_blue.csh +R models/atm/cam/test/system/llnl_compass.csh +R models/atm/cam/test/system/llnl_frost.csh +R models/atm/cam/test/system/namelist-config.test-model.dbg.log +R models/atm/cam/test/system/ncar_batch.csh +R models/atm/cam/test/system/nersc_batch.csh +R models/atm/cam/test/system/ornl_batch.csh +R models/atm/cam/test/system/specs-testslist.test-model.xml +R models/atm/cam/test/system/test-examples.pl +R models/atm/cam/test/system/test-model.pl +R models/atm/cam/test/system/test-production.pl +- cleanup of old test-model files + +A models/atm/cam/test/system/CAM_compare.sh +- utility script for comparison of results +A models/atm/cam/test/system/CAM_runcmnd.sh +- utility script for constructing platform dependent run command +A models/atm/cam/test/system/input_tests_aix +- required aix tests for cam commit +A models/atm/cam/test/system/input_tests_irix +- required irix tests for cam commit +A models/atm/cam/test/system/input_tests_linux +- required linux tests for cam commit +A models/atm/cam/test/system/input_tests_master +- master list of tests +A models/atm/cam/test/system/TBL.sh +- generic script for baseline tests +A models/atm/cam/test/system/TBR.sh +- generic script for branch tests +A models/atm/cam/test/system/TCB.ccsm.sh +- script for configure and build test of cam in coupled model +A models/atm/cam/test/system/TCB.sh +- generic script for configure and build tests +A models/atm/cam/test/system/TER.ccsm.sh +- script for exact restart test of cam in coupled model +A models/atm/cam/test/system/TER.sh +- generic script for exact restart tests +A models/atm/cam/test/system/test_driver.sh +- driver script for all tests +A models/atm/cam/test/system/TSM.sh +- generic script for smoke tests +A models/atm/cam/test/system/nl_files/adia +A models/atm/cam/test/system/nl_files/aqpgro +A models/atm/cam/test/system/nl_files/ghgrmp +A models/atm/cam/test/system/nl_files/idphys +A models/atm/cam/test/system/nl_files/outfrq24h +A models/atm/cam/test/system/nl_files/outfrq3s +A models/atm/cam/test/system/nl_files/pghgsul +A models/atm/cam/test/system/nl_files/ttrac +- files containing non-default namelist options being tested +A models/atm/cam/test/system/config_files/e32c11dh +A models/atm/cam/test/system/config_files/e32dh +A models/atm/cam/test/system/config_files/e32pdh +A models/atm/cam/test/system/config_files/e32sdh +A models/atm/cam/test/system/config_files/e64h +A models/atm/cam/test/system/config_files/e64m +A models/atm/cam/test/system/config_files/e64o +A models/atm/cam/test/system/config_files/e8c8mdm +A models/atm/cam/test/system/config_files/e8pdm +A models/atm/cam/test/system/config_files/e8sdm +A models/atm/cam/test/system/config_files/f10c8mdm +A models/atm/cam/test/system/config_files/f10pdm +A models/atm/cam/test/system/config_files/f10sdm +A models/atm/cam/test/system/config_files/f2h +A models/atm/cam/test/system/config_files/f2m +A models/atm/cam/test/system/config_files/f2o +A models/atm/cam/test/system/config_files/f4c11dh +A models/atm/cam/test/system/config_files/f4dh +A models/atm/cam/test/system/config_files/f4pdh +A models/atm/cam/test/system/config_files/f4sdh +A models/atm/cam/test/system/config_files/s32c11dh +A models/atm/cam/test/system/config_files/s32dh +A models/atm/cam/test/system/config_files/s32pdh +A models/atm/cam/test/system/config_files/s32sdh +A models/atm/cam/test/system/config_files/s64h +A models/atm/cam/test/system/config_files/s64m +A models/atm/cam/test/system/config_files/s64o +A models/atm/cam/test/system/config_files/s8c8mdm +A models/atm/cam/test/system/config_files/s8pdm +A models/atm/cam/test/system/config_files/s8sdm +- files containing configuration options being tested + +M models/atm/cam/src/physics/cam1/sulfur_intr.F90 +- fixed declaration and setting of array totcond +M models/atm/cam/src/physics/cam1/dmsbnd.F90 +- initialized arrays dmsin and dms to 0._r8 +M models/atm/cam/src/dynamics/eul/inidat.F90 +- added explicit setting of phis_hires +M models/atm/cam/src/dynamics/fv/inidat.F90 +- modified the array assignments where it depended upon ncol +M models/atm/cam/src/dynamics/sld/inidat.F90 +- added explicit setting of phis_hires +M models/atm/cam/src/control/initext.F90 +- modified the array assignments where it depended upon ncol +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml +- modified the default settings for fv 4x5 sulpher datasets + + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_1_1 +Originator: fvitt ( Francis Vitt) +Date: Mon Mar 21 12:39:28 MST 2005 +Model: CAM +Version: CAM3.1.1 +One-line Summary: Added a tropospheric chemistry package. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +Files added: + +models/atm/cam/bld/config_trop_chem_mozart_defaults.xml +models/atm/cam/src/chemistry/trop_mozart/chem_mods.F90 +models/atm/cam/src/chemistry/trop_mozart/chemistry.F90 +models/atm/cam/src/chemistry/trop_mozart/m_het_id.F90 +models/atm/cam/src/chemistry/trop_mozart/m_rxt_id.F90 +models/atm/cam/src/chemistry/trop_mozart/m_spc_id.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_adjrxt.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_aerosols.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_airplane.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_ch4_lbc.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_chemini.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_drydep.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_exp_sol.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_gas_phase_chemdr.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_imp_sol.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_indprd.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_jlong.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_jpl.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_jshort.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lb_vals.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lightning.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lin_matrix.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lu_factor.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_lu_solve.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_mass_xforms.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_mean_mass.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_negtrc.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_nln_matrix.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_prod_loss.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_read_chm_sim.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_regrider.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_seasalt.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setext.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setinv.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setrxt.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setsoa.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_setsox.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_srf_emissions.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_sulf.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_tracname.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_ub_vals.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_usrrxt.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_waccm_photo.F90 +models/atm/cam/src/chemistry/trop_mozart/mo_wetdep.F90 +models/atm/cam/src/chemistry/trop_mozart/phtadj.F90 +models/atm/cam/src/chemistry/trop_mozart/rxtmod.F90 + +Files modified: + +models/atm/cam/bld/DefaultCAMEXPNamelist.xml + - added files needed for trop_mozart chemistry package +models/atm/cam/bld/camexp.pm + - added trop_mozart input files to the namelist +models/atm/cam/bld/configure + - added trop_mozart chemistry package option +models/atm/cam/src/chemistry/waccm_mozart/chemistry.F90 + - changed interface to be consistent with trop_mozart chemistry +models/atm/cam/src/control/history.F90 + - increased tbl_hash_oflow_percent +models/atm/cam/src/control/runtime_opts.F90 + - added input files to namelist for trop_mozart chemistry +models/atm/cam/src/physics/cam1/aerosol_intr.F90 + - added aerosol feedback capability for trop_mozart chemistry +models/atm/cam/src/physics/cam1/chemistry.F90 + - changed interface to be consistent with trop_mozart chemistry +models/atm/cam/src/physics/cam1/physpkg.F90 + - enabled lightning production of NO for trop_mozart chemistry +models/atm/cam/src/physics/cam1/stratiform.F90 + - added total precip/evap fields to physics buffer needed by trop_mozart +models/atm/cam/src/physics/waccm/chemistry.F90 + - changed interface to be consistent with trop_mozart chemistry +models/atm/cam/tools/scam/testscript + - removed "-test" option from configure invocation + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_1 +Originator: eaton ( Brian Eaton) +Date: Tue Mar 15 20:14:48 MST 2005 +Model: CAM +Version: CAM3.1 +One-line Summary: cam3_1 same as cam3_0_34 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): no +Tested to work with SCAM (tools/scam/testscript): no +Machines tested: none +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? no + +Changes made: none. + +Add tag cam3_1. This is the branch point for the CAM3.1 release + +=============================================================== +=============================================================== + +cam3_0_34 +Originator: pworley ( Patrick H Worley) +Date: Tue Mar 15 18:01:47 MST 2005 +Model: CAM +Version: CAM3.0.34 +One-line Summary: Cray X1 optimizations +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes on X1: recovers performance lost due to changes since cam3.0 +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): no - broken in earlier check-in +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes - added support for SSP execution mode +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +added models/utils/esmf/cray_x1_ssp/ + Identical to cray_x1 except that compiler options in the file base_variables were modified + so that esmf routines could be used in SSP mode. + +models/atm/cam/bld/Makefile + - in UNICOSMP section: added support for SSP mode and higher optimization levels for 4 routines, + recovering performance lost in earlier check-in that lowered optimization + +models/atm/cam/src/control/history.F90, wrap_nf.F90 + - deleted CRAY ifdefs + +models/atm/cam/src/physics/cam1/convect_deep.F90 + - modified calls to convtran, replacing ":" array indices with "1", to improve performance + +models/atm/cam/src/physics/cam1/qneg3.F90 + - modified to improve vectorization and streaming + +models/atm/cam/src/physics/cam1/radiation.F90 + - modified calls to radcswmx and radclwmx, + replacing ":" array indices with "1", to improve performance + - added Cray compiler directives + +models/atm/cam/src/physics/cam1/zm_conv.F90 + - added Cray compiler directives + +models/lnd/clm2/src/main/controlMod.F90 + - added ifdef to define default clump_pproc value for SSP mode + +models/lnd/clm2/src/main/driver.F90 + - added ifdef to disable OpenMP directive around "loop2" for SSP mode (a bug work around) + +models/utils/timing/gptl.c + - added ifdef to not disable timers unnecessarily in SSP mode + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_33 +Originator: rosinski ( Jim Rosinski) +Date: Thu Mar 10 14:05:47 MST 2005 +Model: CAM +Version: CAM3.0.33 +One-line Summary: Enable new timing lib. +cam-bugs Requests resolved: none +Requires change in build system: Maybe for CCSM. +Substantial timing or memory changes: Yes: on IBM timer overhead decreases + by as much as 10x. On SGI by 2x. On + Cray X1 by 3x. No speedup on Linux. +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes but it failed. Told + to go ahead with commit. +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: timer init calls and fortran include file changed. +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +o Replace timer code in utils/timing with new more effecient version. Better + performance results from replacing a linked list search for timer names + with a simple hash table. The new library now prints per-timer overhead + estimates. It can also interface with the PAPI low level performance + counter library. A brief description of how to do so is included in + utils/timing/README. + +o The old interface names (t_xxx) were retained. But these should be changed + to the new names (gptlxxx) as soon as possible. + +o Modify CAM Makefile for optimal performance on Cray X1. + +=============================================================== +=============================================================== + +cam3_0_32 +Originator: eaton ( Brian Eaton) +Date: Tue Mar 8 10:08:10 MST 2005 +Model: CAM +Version: CAM3.0.32 +One-line Summary: topo fields in separate file +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes + namelist includes bnd_topo -- build-namelist provides defaults +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Topography fields (mods from Byron Boville) +=========================================== + +These mods are to read the topo fields (PHIS, SGH, SGH30, LANDFRAC, +LANDM_COSLAT) from their own file. They are no longer written to the +output initial files. Backwards compatibility is maintained by looking for +the topo fields on the initial file if a topo file is not specified using +the new namelist variable bnd_topo. There are also mods to write the names +of the initial, topo, and sst files into global attributes of the history +files. + +An initial set of topo files have been created by extracting the topo +fields from the initial files currently specified in +DefaultCAMEXPNamelist.xml. The topo files are in the data directory +$CSMDATA/atm/cam/topo/. These files will eventually be replaced by a set +of standard files that contain detailed metadata describing how the fields +were produced. + +There are also modifications and cleanup in the definehires and definesurf +utilities. Added alot of information to the README files for both utils. + +Misc +==== + +. Re-insert a fix in phys_grid.F90 (transpose_chunk_to_block) + changing the chunk_buffer arg to intent(in). + +. In history.F90 increase pflds to 2000 and tbl_hash_oflow_percent to 10. + + + +=============================================================== +=============================================================== + +cam3_0_31 +Originator: bundy ( Dani Bundy Coleman) +Date: Wed Mar 2 13:56:13 MST 2005 +Model: CAM +Version: CAM3.0.31 +One-line Summary: Add mass conservation for dry tracers in Eularian dycore; restore same in SLD +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes (bluesky) +Tested to work with SCAM (tools/scam/testscript): yes (bangkok) +Machines tested: IBM (bluesky), SGI (tempest), Linux-Lahey (bangkok) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton +Restart files change: no (pdeld added only when run with dry-type constituents) +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +A models/atm/cam/src/dynamics/eul/massfix.F90 +Currently a module that just holds hw1, hw2, hw3, alpha. Could facilitate +a separation between mass fix and the timefilter. + +M slt/qmassa.F90 +Now a module, old subroutine qmassa is now qmassarun. Added an +optional argument pdeld to be used to calculate hw1lat for dry +mixing-ratio constituents. + +M control/history.F90 +moved addfld and add_defualt for PDELDRY from here to physics/cam1/diagnostics.F90 + +M eul/dp_coupling.F90 +Added transfer of pdeld from p->d,d->p. Calculation of pdeld moved to +tfilt_massfix.F90 instead of call to set_state_pdry. + +M eul/inital.F90 +added initialization of dynamics variable pdeld + +M eul/prognostics.F +added dynamics variable pdeld, only allocated when dry constituents +are present + +M eul/restart_dynamics.F90 +added pdeld to restart files + +M eul/scan2.F90 +moved public hw1, hw2, hw3, alpha to new module massfix.F90 +pass pdeld to tfilt_massfixrun() + +M eul/scandyn.F90 +pass pdeld to qmassarun + +M eul/scanslt.F90 +pass pdeld to qmassarun + +M eul/stepon.F90 +pass pdeld to d_p_coupling + +M eul/tfilt_massfix.F90 +Calculate time filtered value of pdeldry; use this to time-filter dry +constituents conservatively. + +M sld/scanslt.F90 +change qmassa call to new name: qmassarun + +M sld/tfilt_massfix.F90 +save water vapor for use in next timestep; this was inadvertently +removed in cam3_0_28 and is necessary for dry mass conservation + +M physics/constituents.F90 +new public logical cnst_need_pdeldry. Default is flase, set to true if +any constituents are dry. + +M physics/convect_deep.F90 +only use pdeldry when needed + +M physics/diagnostics.F90 +addfld and outfld calls for PSDRY and PDELDRY only when needed + +M physics/icarus_scops.F90 +added r8 to reals + +M physics/physics_types.F90 +added state%pdeldry and related to methods only when needed +added optional argument pdeld_calc (default=true) to subroutine +set_state_pdry, setting false still calculates related fields but +doesn't change state%pdeldry itself. + +M physics/physpkg.F90 +diagnostic subroutine gavglook only calculates dry quantities when +needed + +M physics/tracers_suite.F90 +added missing r8 +Now a module, old subroutine qmassa is now qmassarun. Added an +optional argument pdeld to be used to calculate hw1lat for dry +mixing-ratio constituents. + +M control/history.F90 +moved addfld and add_defualt for PDELDRY from here to physics/cam1/diagnostics.F90 + +M eul/dp_coupling.F90 +Added transfer of pdeld from p->d,d->p. Calculation of pdeld moved to +tfilt_massfix.F90 instead of call to set_state_pdry. + +M eul/inital.F90 +added initialization of dynamics variable pdeld + +M eul/prognostics.F +added dynamics variable pdeld, only allocated when dry constituents +are present + +M eul/restart_dynamics.F90 +added pdeld to restart files + +M eul/scan2.F90 +moved public hw1, hw2, hw3, alpha to new module massfix.F90 +pass pdeld to tfilt_massfixrun() + +M eul/scandyn.F90 +pass pdeld to qmassarun + +M eul/scanslt.F90 +pass pdeld to qmassarun + +M eul/stepon.F90 +pass pdeld to d_p_coupling + +M eul/tfilt_massfix.F90 +Calculate time filtered value of pdeldry; use this to time-filter dry +constituents conservatively. + +M sld/scanslt.F90 +change qmassa call to new name: qmassarun + +M sld/tfilt_massfix.F90 +save water vapor for use in next timestep; this was inadvertently +removed in cam3_0_28 and is necessary for dry mass conservation + +M physics/constituents.F90 +new public logical cnst_need_pdeldry. Default is flase, set to true if +any constituents are dry. + +M physics/convect_deep.F90 +only use pdeldry when needed + +M physics/diagnostics.F90 +addfld and outfld calls for PSDRY and PDELDRY only when needed + +M physics/icarus_scops.F90 +added r8 to reals + +M physics/physics_types.F90 +added state%pdeldry and related to methods only when needed +added optional argument pdeld_calc (default=true) to subroutine +set_state_pdry, setting false still calculates related fields but +doesn't change state%pdeldry itself. + +M physics/physpkg.F90 +diagnostic subroutine gavglook only calculates dry quantities when +needed + +M physics/tracers_suite.F90 +added missing r8 + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_30 +Originator: mvr ( Mathew Rothstein) +Date: Wed Feb 9 16:34:12 MST 2005 +Model: CAM +Version: CAM3.0.30 +One-line Summary: Cleanup of copyright info; minor bug fixes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +R LICENSE +- update to the copyright info and renaming of the file for + consistency with ccsm +A Copyright +- new file to replace LICENSE file that was removed +M models/atm/cam/src/control/cam.F90 +- slight mod to the info on where to find copyright notice +M models/atm/cam/src/control/history.F90 +- bug fix for the variable "vid" whose intent needed to be out rather than in +M models/atm/cam/src/physics/cam1/icarus_scops.F90 +- removed copyright info already contained in Copyright file +M models/atm/cam/test/system/create_ccsmcam +- replaced blackforest with bluesky as default machine +M models/atm/cam/test/system/ncar_batch.csh +- default load-leveller queue now for bluesky rather than blackforest +M models/atm/cam/tools/scam/testscript +- bug fix for how the TESTSCRIPTDIR was determined +M models/atm/cam/tools/scam/ui/Platform.Notes +- removed copyright info already contained in Copyright file +M models/atm/cam/tools/scam/ui/c.h +- removed copyright info already contained in Copyright file +M models/atm/cam/tools/scam/ui/ncarg/c.h +- removed copyright info already contained in Copyright file + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_29 +Originator: rosinski ( Jim Rosinski) +Date: Sun Feb 6 12:50:13 MST 2005 +Model: CAM +Version: CAM3.0.29 +One-line Summary: Reduced grid mods for CAM and interpaerosols boundary dataset generation code. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Modify eul/initcom.F90 to abort in SCAM mode if reduced grid enabled. +o Enable "mkrgrid" utility to work under lf95, ifort, and Cray X1. +o Enable "interpaerosols" utility for reduced grid, and Cray X1. +o Add new utility "mkrgridnew", which can replace "mkrgrid" when IC files + are xyz. The new utility is simpler, and unlike mkrgrid works on ISCCP + history files and on Cray X1. +o Check for reduced grid in optional boundary dataset reading routines + for which reduced grid capability is not yet enabled (e.g. dust module) + and abort in reduced grid mode. +o When CAM reads SST and aerosol data, ensure that boundary dataset grids + match cam grid. +o Delete threading directives from ccsm_msg.F90 per mvertens. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_28 +Originator: olson ( Jerry Olson) +Date: Thu Jan 27 11:11:47 MST 2005 +Model: CAM +Version: CAM3.0.28 +One-line Summary: Add new diagnostics to history file. Other misc mods. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: + +- Changes are round-off for EUL (except for aqua-planet which has a new climate + because of a change in the dry airmass constant) + Changes are BFB for SLD (except for aqua-planet which has a new climate) + Changes are BFB for FV (except for aqua-planet which has a new climate) + +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + + - Add fields to the master field list which complete the heat, moisture, cloud + liquid water, cloud liquid ice, and precip budgets + + (no new *default* fields are added to the History file) + + - Add an attribute ("sampling_seq") to those fields on a NetCDF History File + which are *not* based on an every-time-step sampling frequency. The + attribute would have a descriptive value indicating its sampling sequence. + Currently only one value is added: "rad_lwsw" (for fields that are only + sampled at LW/SW radiation time steps). No code is currently being added to + fill these fields with "missing" values. + + - Replace the "RAD_FIRST_HOUR" namelist variable with "IRAD_ALWAYS". + "RAD_FIRST_HOUR" was a logical that was too inflexible. "IRAD_ALWAYS" is an + integer that specifies length of time in timesteps (positive) or hours + (negative) that the SW/LW radiation will be run continuously from the start + of an initial run. + + - For aqua-planet runs, dry mass is hard-wired to 101325.-245. ( = 101080.) Pa + + - Bug fixes: + + - Fix a potential bug in the history module that would end up clobbering + the creation of the IC file if *all* the fields added to an auxiliary + history file through "add_default" calls are then excluded via FEXCL in + the namelist. + + - Fix bug that corrupts high resolution runs: promote "n" to I8 when + doing n**4 and n**3 math in hdinti, hordif1, and phcs. + + - Correct the logic in the aerosol data interpolator as reported by + Jim Boyle on the CGD forum + + - make "jstrt_p" private in SCAN2 and REALLOC7 loops + + - bugfix for adiabatic restarts + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_27 +Originator: mvr ( Mathew Rothstein) and mirin +Date: Thu Jan 20 16:16:39 MST 2005 +Model: CAM +Version: CAM3.0.27 +One-line Summary: Vectorization mods for finite volume; clarification of pgf90 optimization level +cam-bugs Requests resolved: none +Requires change in build system: yes +set pgf90 optimization explicitly to -O1; vectorization mods (see below) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey, Linux-pgi, cray x1 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mirin, eaton +Restart files change: no +Changes answers: b4b except for fv on cray x1, ibm, and linux-pgi, which are +round-off (pergro test passed on ibm) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M models/atm/cam/bld/Makefile +M models/atm/cam/src/control/cam.F90 +M models/atm/cam/src/control/spmdinit.F90 +M models/atm/cam/src/dynamics/fv/cd_core.F90 +M models/atm/cam/src/dynamics/fv/dp_coupling.F90 +M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 +M models/atm/cam/src/dynamics/fv/dynpkg.F90 +M models/atm/cam/src/dynamics/fv/fill_module.F90 +M models/atm/cam/src/dynamics/fv/fv_prints.F90 +M models/atm/cam/src/dynamics/fv/mapz_module.F90 +M models/atm/cam/src/dynamics/fv/pft_module.F90 +M models/atm/cam/src/dynamics/fv/spmd_dyn.F90 +M models/atm/cam/src/dynamics/fv/stepon.F90 +M models/atm/cam/src/dynamics/fv/sw_core.F90 +M models/atm/cam/src/dynamics/fv/te_map.F90 +M models/atm/cam/src/dynamics/fv/tp_core.F90 +M models/atm/cam/src/physics/cam1/check_energy.F90 +M models/atm/cam/src/physics/cam1/constituents.F90 +M models/csm_share/shr/shr_msg_mod.F90 +M models/utils/pilgrim/mod_comm.F90 + +please reference corresponding documentation in cam checkin list for details + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_26 +Originator: mvr ( Mathew Rothstein) and eaton +Date: Tue Jan 18 13:58:51 MST 2005 +Model: CAM +Version: CAM3.0.26 +One-line Summary: Collection of bug fixes and enhancements for Cray X1 +cam-bugs Requests resolved: none +Requires change in build system: yes +pgi fortran optimization set to O by default; Cray X1 mods; dependency cleanup +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes +removal of equivalences; bug fix for offline mode +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M cam1/models/atm/cam/bld/Makefile +- changed default optimization of pgi fortran compiler to O from O2 +- added Cray X1 mods and cleaned up some dependencies +M cam1/models/atm/cam/src/control/ccsm_msg.F90 +- added mods for Cray X1 +M cam1/models/atm/cam/src/control/history.F90 +- removed equivalences; removed addfld for unused var; added gregorian + calendar type to output; removed some unneeded date checking +M cam1/models/atm/cam/src/control/runtime_opts.F90 +- added code required with removal of equivalence in history.F90; + added phys_buffer mods +M cam1/models/atm/cam/src/dynamics/fv/dp_coupling.F90 +- removed beglev from declaration of var ps +M cam1/models/atm/cam/src/dynamics/fv/fv_prints.F90 +- fixed bug in write statements +M cam1/models/atm/cam/src/dynamics/fv/stepon.F90 +- add call to shr_sys_flush +M cam1/models/atm/cam/src/physics/cam1/phys_buffer.F90 +- added mods to physics buffer +M cam1/models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +- fixed bug in date comparison +M cam1/models/atm/cam/tools/scam/configure +- fixed bug with input file location for scam (created with cam3_0_25) +M cam1/models/lnd/clm2/src/main/areaMod.F90 +- bug fix for offline mode +M cam1/models/lnd/clm2/src/main/histFileMod.F90 +- removal of equivalences + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_25 +Originator: jet ( John Truesdale) +Date: Mon Jan 10 16:43:43 MST 2005 +Model: CAM +Version: CAM3.0.25 +One-line Summary: Updated SCAM INSTALL text and added data directory to fix bug with scam configure script. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): no +Tested to work with SCAM (tools/scam/testscript): no +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: n/a +Tested multiple constituents: n/a +Tested that different domain decompositions match bit-for-bit: n/a +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? no this is a nontesting tag, only edited text files (INSTALL and REAME) no code +modified. + +Changes made: + +Added words to the INSTALL file for SCAM to let the user know to set the +CSMDATA environment variable. Also added a directory under scam (/data). +The scam configure script assumes this directory exists and links all +scam data files here. The previous release didn't have this directory. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_24 +Originator: pworley ( Patrick H Worley) +Date: Thu Jan 6 11:20:57 MST 2005 +Model: CAM +Version: CAM3.0.24 +One-line Summary: reduced grid support for spectral dycores and miscellaneous bug fixes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no for full grid, yes (improved) for reduced grid +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: fixed reduced grid support in one routine +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Fixed support for reduced grid (Jim Rosinski): + - control/readinitial.F90 + - physics/cam1/prescribed_aerosols.F90 + - dynamics/eul/initcom.F90 + - lnd/clm2/src/main/surfFileMod.F90 + +Additional reduced grid support modifications (for the X1 +only?). Zeroing out unused locations in the FFT buffers is required +on the X1. + - dynamics/eul/linemsdyn.F90 + - dynamics/eul/spegrd.F90 + - dynamics/sld/spegrd.F90 + - dynamics/sld/scanslt.F90 + +Added new runtime option, dyn_equi_by_col, to improve performance of +spectral dycores when using reduced grid. When set to .true., it +attempts to allocate the same number of columns to each process in the +dynamics rather than the same number of latitude lines. For a full +grid, these goals are identical. The option is on by default. However, +it is not necessarily the best choice when using a reduced grid on a +vector system. Setting it to .false. executes the old code, +equidistributing the number of latitude lines whether using a full or +a reduced grid. + 1) Moved decompinit out of cam, into readinitial.F90 and restart.F90, + so that reduced grid option could be identifed before computing + dynamics decomposition + - control/cam.F90 + - control/readinitial.F90 + - control/restart.F90 + 2) Added dyn_equi_by_col runtime option + - control/runtime_opts.F90 + - dynamics/eul/spmd_dyn.F90 + - dynamics/sld/spmd_dyn.F90 + - dynamics/fv/spmd_dyn.F90 + 3) Added dyn_equi_by_col domain decomposition + - dynamics/eul/spmd_dyn.F90 + - dynamics/sld/spmd_dyn.F90 + +The SLD dycore does not have all of the modifications made to EUL in +Jan.-March, 2004 to, for example, decrease memory requirements in the +spectral domain. The following files were modified as a step toward +implementing these changes. The motivation is that including these +changes allows the SLD version of spmd_dyn.F90 to be almost identical +to that used in EUL. + - dynamics/sld/comspe.F90 + - dynamics/sld/scanslt.F90 + +The current Co-Array Fortran logic in CAM requires that the two +communication buffers allocated in the spectral dycores be the same +size. This is currently true when the number of processors divides the +latitudes, but not otherwise. Since this may be important for other +one-sided messaging systems as well, the following files have been +modified to require that all processes allocate the same size +communcation buffers. Note that this has no performance impact in +normal CAM usage (and probably never has an impact). + - control/mpishorthand.F + - control/spmdinit.F90 + - control/wrap_mpi.F90 + - dynamics/eul/spmd_dyn.F90 + - dynamics/sld/spmd_dyn.F90 + +Reinsert compiler directive fixing Cray X1 bug that was lost in +a previous check-in + - control/history.F90 + +The routine sort_chunks is called in create_chunks and +orders the columns assigned to a chunk. +It was added to phys_grid.F90 back when we were looking for +alternatives to the buffer copies introduced into radcswmx.F90 for +vectorization. A bug in this code was recently identified. Rather than +fix it, we have decided that sort_chunks does nothing useful even when +working correctly. Thus the routine sort_chunks has been removed. + + - physics/cam1/phys_grid.F90 + +Miscellaneous bug fixes: + + 1) A typo in the existing "equidistribute by latitudes" + decomposition logic was fixed. Fortunately, this bug + was never seen in practice. + + - dynamics/eul/spmd_dyn.F90 + - dynamics/sld/spmd_dyn.F90 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_23 +Originator: fvitt ( Francis Vitt) +Date: Tue Dec 21 10:13:50 MST 2004 +Model: CAM +Version: CAM3.0.23 +One-line Summary: Add ability to use offline data to drive finite volume dynamics core. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: yse +Requires OFFLINE_DYN C preprocessor flag to be set. +Substantial timing or memory changes: no +Requires change in run script: yes +Namelist varibles are added. See below. +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton +Restart files change: yes +Offline data file names added to restart file. +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +Added files: + models/atm/cam/src/dynamics/fv/metdata.F90 + models/atm/cam/src/dynamics/fv/pfixer.F90 + +Modified files: + models/atm/cam/src/dynamics/fv/cd_core.F90 + models/atm/cam/src/dynamics/fv/dp_coupling.F90 + models/atm/cam/src/dynamics/fv/dryairm.F90 + models/atm/cam/src/dynamics/fv/dynpkg.F90 + models/atm/cam/src/dynamics/fv/inidat.F90 + models/atm/cam/src/dynamics/fv/restart_dynamics.F90 + models/atm/cam/src/dynamics/fv/stepon.F90 + models/atm/cam/src/dynamics/fv/sw_core.F90 + models/atm/cam/src/dynamics/fv/uv3s_update.F90 + models/atm/cam/src/physics/cam1/inti.F90 + models/atm/cam/src/physics/cam1/physpkg.F90 + models/atm/cam/src/control/runtime_opts.F90 + models/atm/cam/src/control/string_utils.F90 + +Modifications are effective only if CAM is configured to use +offline meteorology data. To configure to use offline data +set OFFLINE_DYN C preprocessor flag. + +Namelist variables added: + + met_data_file The filepath of the netCDF file + containing the meteorology data + + met_cell_wall_winds Set to true if the meteorology winds are + defined on model cell walls. + Default is false. + + met_remove_file Set to true to have the offline data file be + removed from the local file system. + Default is false. + +The offline meteorology data can be read from a sequence of files +provided the files are named stringNNN.nc, where NNN is an integer +of any number of digits. If the data is contained in a series of +files, the files need to be named sequentially, e.g., metdata001.nc, +metdata002.nc, metdata003.nc, etc. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_22 +Originator: jeff ( Yen-Huei Lee) +Date: Fri Dec 10 10:20:33 MST 2004 +Model: CAM +Version: CAM3.0.22 +One-line Summary: add WACCM physics and chemistry +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Brian Eaton +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +Add two new direstories for WACCM: + models/atm/cam/src/physics/waccm/ + models/atm/cam/src/chemistry/waccm_mozart/ + +Change the following files: + A models/atm/cam/bld/config_cam_eul_defaults.xml + A models/atm/cam/bld/config_cam_fv_defaults.xml + A models/atm/cam/bld/config_cam_sld_defaults.xml + A models/atm/cam/bld/config_waccm_ghg_defaults.xml + A models/atm/cam/bld/config_waccm_mozart_defaults.xml + D models/atm/cam/bld/config_cache_defaults.xml + M models/atm/cam/bld/CAM_config.pmonfig.pm + M models/atm/cam/bld/DefaultCAMEXPNamelist.xml + M models/atm/cam/bld/DefaultCLMEXPNamelist.xml + M models/atm/cam/bld/camexp.pm + M models/atm/cam/bld/clm2exp.pm + M models/atm/cam/bld/configure + M models/atm/cam/bld/resolution_parameters.xml + M models/atm/cam/src/dynamics/eul/dp_coupling.F90 + M models/atm/cam/src/dynamics/eul/inital.F90 + M models/atm/cam/src/dynamics/eul/stepon.F90 + M models/atm/cam/src/dynamics/sld/dp_coupling.F90 + M models/atm/cam/src/dynamics/sld/inital.F90 + M models/atm/cam/src/dynamics/fv/dp_coupling.F90 + M models/atm/cam/src/dynamics/fv/dycore.F90 + M models/atm/cam/src/dynamics/fv/dynamics_vars.F90 + M models/atm/cam/src/dynamics/fv/inital.F90 + D models/atm/cam/src/physics/cam1/ghg_surfvals.F90 + A models/atm/cam/src/physica/cam1/chem_surfvals.F90 + M models/atm/cam/src/physics/cam1/advnce.F90 + M models/atm/cam/src/physics/cam1/aerosol_intr.F90 + M models/atm/cam/src/physics/cam1/check_energy.F90 + M models/atm/cam/src/physics/cam1/chemistry.F90 + M models/atm/cam/src/physics/cam1/cloud_fraction.F90 + M models/atm/cam/src/physics/cam1/constituents.F90 + M models/atm/cam/src/physics/cam1/convect_deep.F90 + M models/atm/cam/src/physics/cam1/convect_shallow.F90 + M models/atm/cam/src/physics/cam1/diagnostics.F90 + M models/atm/cam/src/physics/cam1/diffusion_solver.F90 + M models/atm/cam/src/physics/cam1/ghg_defaults.F90 + M models/atm/cam/src/physics/cam1/gw_drag.F90 + M models/atm/cam/src/physics/cam1/initindx.F90 + M models/atm/cam/src/physics/cam1/inti.F90 + M models/atm/cam/src/physics/cam1/molec_diff.F90 + M models/atm/cam/src/physics/cam1/physics_types.F90 + M models/atm/cam/src/physics/cam1/physpkg.F90 + M models/atm/cam/src/physics/cam1/qneg3.F90 + M models/atm/cam/src/physics/cam1/rad_constituents.F90 + M models/atm/cam/src/physics/cam1/radae.F90 + M models/atm/cam/src/physics/cam1/radheat.F90 + M models/atm/cam/src/physics/cam1/radiation.F90 + M models/atm/cam/src/physics/cam1/radlw.F90 + M models/atm/cam/src/physics/cam1/radsw.F90 + M models/atm/cam/src/physics/cam1/stratiform.F90 + M models/atm/cam/src/physics/cam1/sulfur_intr.F90 + M models/atm/cam/src/physics/cam1/tphysac.F90 + M models/atm/cam/src/physics/cam1/tphysbc.F90 + M models/atm/cam/src/physics/cam1/tracers.F90 + M models/atm/cam/src/physics/cam1/upper_bc.F90 + M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + M models/atm/cam/src/control/history.F90 + M models/atm/cam/src/control/restart.F90 + M models/atm/cam/src/control/runtime_opts.F90 + M models/atm/cam/src/control/time_manager.F90 + M models/atm/cam/tools/scam/scm_init/scam_inital.F90 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_21 +Originator: pworley ( Patrick H Worley) +Date: Mon Nov 1 07:40:57 MST 2004 +Model: CAM +Version: CAM3.0.21 +One-line Summary: Communication optimizations (MPI1, MPI2, Co-Array Fortran) for spectral dycores and dp_coupling; physics chunking bug fix. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes, improves performance on Earth Simulator when using MPI-2 one-sided option; may improve performance on Cray X1 +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): no +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +1) Fixed bug in assign_chunks identified by Steve Ghan and Tim Shippert. This + bug did not affect execution in the standard modes of operation. + +2) Fixed UNICOS/MP Makefile option for cam3_0_20 changes. + +3) Communication optimizations: + + - eliminated overlap implementations of realloc and dp_coupling + communications. All that was being overlapped was buffer copies, + which did not appear to be useful on the current target platforms. + + - added "alternative" implementations of alltoall and allgather + (used in realloc routines and dp_coupling), using + 1) one of a large number of MPI-2 point-to-point commands, + controlled by swap_comm_order, swap_comm_protocol, and + swap_comm_maxreq. The first two parameters have the same + meaning as before. swap_comm_maxreq controls the maximum number + of outstanding send/receive requests allowed in the + implementation of alltoall/allgather. This can be used to tune + performance or work around bugs on systems that do + not tolerate large numbers of outstanding requests well. + 2) MPI-2 put commands + 3) Co-Array Fortran remote writes + + #2 is important for performance on the Earth Simulator. The others + represent defensive programming, for situations in which the MPI + collectives are not implemented efficiently. #2 also seems to be + fastest on the Cray X1, but I haven't not done a careful study yet. + + - To support the MPI-2 implementation, replaced original + communication buffer logic + * call spmdbuf in spmdinit_dyn to allocate communication buffers; + call spmdbuf_resize in d_p_coupling or in p-d_coupling to + reallocate communication buffers is they are not large enough + with + * call spmdbuf in inital or in restart, after phys_grid_init, to + allocate communication buffers of the appropriate size the + first time, then use MPI_WINCREATE to enable remote + read/write from/to these buffers. + + - For the SLD dycore, added minor modifications originally + introduced into the EUL dycore to improve vectorization. This + makes realloc5, realloc5, and realloc7 almost identical between + the EUL and SLD dycores again, and should improve vectorization + for the SLD dycore. + + The new runtime options for dyn_alltoall, dyn_allgather, and + phys_alltoall are: + + 0: use collectives + 1: use MPI-2 point-to-point, as specified by swap_comm_order, + swap_comm_protocol, swap_comm_maxreq. (swap_comm_maxreq default + is -1, meaning no limit; >0 sets the upper bound) + 2: if compiled with -DMPI2, then use MPI-2 put implementation, else + use an MPI_SENDRECV implementation + 3: if compiled with -DCAF, then use Co-Array remote write + implementation, else use an MPI_SENDRECV implementation + + Files modified are as follows: + +control/restart.F90 + added call to spmdbuf +control/runtime_opts.F90 + added swap_comm_maxreq parameter +control/swap_comm.F90 + added swapm, swap_comm_maxreq; + removed swap1, swap2, swap3, swap1m, swap3m, do_swap1, do_swap3, + delayed_swap_recv +control/wrap_mpi.F90 + added mpialltoallint, altalltoallv, mpiwincreate +eul/dp_coupling.F90, sld/dp_coupling.F90 + added MPI2 window parameter to transpose call; + replaced spmdbuf_resize call with an spmdbuf_size test +eul/inital.F90, sld/inital.F90 + added smpdbuf call +eul/realloc4.F90, sld/realloc4.F90 + added altalltoall, removed swap routine calls +eul/realloc7.F90, sld/realloc7.F90, eul/scan2.F90, sld/scan2.F90 + added altalltoall, removed swap routine calls +eul/spmd_dyn.F90, sld/spmd_dyn.F90 + removed spmdbuf_resize and modified spmdbuf; + moved local_dp_map, block_buf_nrecs, and chunk_buf_nrecs from phys_grid; + added support for MPI2 and CAF. +fv/dp_coupling.F90 + side effect of moving local_dp_map, block_buf_nrecs, and + chunk_buf_nrecs from phys_grid to spmd_dyn +fv/spmd_dyn.F90 + moved local_dp_map, block_buf_nrecs, and chunk_buf_nrecs from phys_grid +sld/comspe.F90, scanslt.F90, spegrd.F90, trunc.F90 + vectorization modifications ported from EUL +physics/cam1/phys_grid.F90 + added altalltoall, removed swap routine calls + fixed assign_chunk bug. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_20 +Originator: jmccaa ( James McCaa) +Date: Mon Oct 18 11:58:59 MDT 2004 +Model: CAM +Version: CAM3.0.20 +One-line Summary: Refactored vertical diffusion module. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and Brian Eaton +Restart files change: no +Changes answers: Yes (same-to-roundoff) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Refactored the vertical diffusion module: + - new interface names + - new molecular diffusion module + - new turbulent mountain stress module + - new eddy diffusion module + - new diffusion solver module + - removed turbulence module + +Cleaned up unused variables from interfaces to convect_deep, +convect_shallow, cloud_fraction, stratiform modules. + +Added a T42 30-level ic file to the CAM defaults file. + +Added a function form of vqsatd to the wv_saturation module. + +Assorted small fixed to scam, plus modified the scam +configure and test scripts to allow running from a working +directory outside the distribution. + +Files added/deleted/modified: +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml +M models/atm/cam/doc/ChangeLog +M models/atm/cam/src/physics/cam1/advnce.F90 +M models/atm/cam/src/physics/cam1/cloud_fraction.F90 +M models/atm/cam/src/physics/cam1/convect_deep.F90 +M models/atm/cam/src/physics/cam1/convect_shallow.F90 +A models/atm/cam/src/physics/cam1/diffusion_solver.F90 +A models/atm/cam/src/physics/cam1/hb_diff.F90 +M models/atm/cam/src/physics/cam1/initindx.F90 +M models/atm/cam/src/physics/cam1/inti.F90 +A models/atm/cam/src/physics/cam1/molec_diff.F90 +M models/atm/cam/src/physics/cam1/physconst.F90 +M models/atm/cam/src/physics/cam1/stratiform.F90 +M models/atm/cam/src/physics/cam1/tphysac.F90 +M models/atm/cam/src/physics/cam1/tphysbc.F90 +M models/atm/cam/src/physics/cam1/tphysidl.F90 +A models/atm/cam/src/physics/cam1/trb_mtn_stress.F90 +R models/atm/cam/src/physics/cam1/turbulence.F90 +M models/atm/cam/src/physics/cam1/upper_bc.F90 +M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 +M models/atm/cam/src/physics/cam1/wv_saturation.F90 +M models/atm/cam/tools/scam/GNUmakefile +M models/atm/cam/tools/scam/configure +M models/atm/cam/tools/scam/testscript +M models/atm/cam/tools/scam/obj/Makefile +M models/atm/cam/tools/scam/scm_init/c_outfld.c +M models/atm/cam/tools/scam/scm_init/init_model.F90 +M models/atm/cam/tools/scam/scm_init/scam.c +M models/atm/cam/tools/scam/ui/GNUmakefile +M models/atm/cam/tools/scam/ui/configure +M models/atm/cam/tools/scam/ui/ncfile.h + +=============================================================== +=============================================================== + +cam3_0_19 +Originator: erik ( Erik Kluzek) +Date: Thu Sep 23 11:49:07 MDT 2004 +Model: CAM +Version: CAM3.0.19 +One-line Summary: Isolate extended grid information to just spectral dycores and just inside of SLT advection inside SLD and Eul dycores. +cam-bugs Requests resolved: 147 +(See http://wreq.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: see below +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, olson, mvr +Restart files change: yes (Eul and SLD) +Changes answers: bit-for-bit with Eul and FV dycores + same to roundoff for SLD dycore (on IBM and Linux/Lahey, + answers identical if you run with -debug compiler options) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Move cam3_0_18_brnchT_nohalo9 to cam_dev. + + Isolate extended grid information to SLT advection to only + within Spectral dy-cores. + +Use plon(regular grid) instead of plond(extended grid) except for +SLT variables, inside of relevent dynamics. + +Eulerian: + + scanslt becomes a module with alloc, initial, run and final phases. + + Remove comslt and move data to inside of scanslt or scan2. + + scanslt has a advection_state data-type to keep track of all extended + grid information. All data on the extended grid are kept inside of this + state. Dynamics data iscopied into and then out of this state for advection. + + New dimension for FFT -- plondfft. + + spetru has new temporary variables inside of it so it can be dimensioned + the right size for FFT (plondfft). + + linemsdyn becomes a module and scan2 becomes a module + + Make grdini, grdxy, sltb1, and sltini module subroutines of scanslt. + +SLD: + scanslt becomes a module with: alloc, initial, run_setup, run, and + final phases. Extended grid parameters moved from pmgrid and rgrid to + inside of this module. Much of the data becomes private inside of + scanslt module. Create advection_state data type to keep track of all + extended grid data, copy data into this structure and then out of + for the rest of the dynamics + + comslt removed and data moved to inside of scanslt. grmult becomes a module. + Use inf instead of nan for initialization. + + Spmd_dyn data only used for bndexch moved as private data inside of scanslt. + + Make bndexch, grdini, grdxy, sltlinint, slttraj, sltwgts, and trajdp + module subroutines of scanslt. + +test-model.pl + + Fix problem where couldn't change resolution on comand line + with -skip option (cam-bug 147). + + Add -cppdefs option + + Restart tests done at default compiler option rather than explicitly + set to production compiler settings. This allows the use of the "-debug" + option to override the default setting for testing where this is + useful. + +SCAM: + Improve readability of testscript, send output to log files + and have the script clean up after itself better. Use plon instead + of plond. + +Performance changes: (Following tests were done with earlier versions + on no-halo branch based off of cam3_0_9 for eul and + cam3_0_15 for sld test) + Eul@T42 on IBM same + Eul@T85 on IBM with 11 constituents 3% slower + Sld@T42 on IBM 2% faster + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_18 +Originator: mvr ( Mathew Rothstein), eaton, mirin +Date: Fri Sep 17 11:01:58 MDT 2004 +Model: CAM +Version: CAM3.0.18 +One-line Summary: A collection of bug fixes and portability enhancements +cam-bugs Requests resolved: none +Requires change in build system: yes +Makefile changed for pgi compile defaults +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes +mss system calls now go through csm_share code +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M models/atm/cam/bld/Makefile +- mods to pgi compiler defaults: -O2 optimization (non-debug), -Mrecursive + only in debug mode +- mod to ifort name for intel builds +M models/atm/cam/src/control/abortutils.F90 +- fix for ibm jobs hanging in xl__trbk routine +M models/atm/cam/src/control/ccsm_msg.F90 +- fix for ccsm with FV 2D composition +M models/atm/cam/src/control/ioFileMod.F90 +- now calls csm_share code for mss system calls +M models/atm/cam/src/control/runtime_opts.F90 +- fix to properly communicate the input vars kmxhdc, dif2, dif4 +R models/atm/cam/src/control/system_cmd.c +- no longer needed - now using csm_share code +M models/atm/cam/src/physics/cam1/cldwat.F90 +- fix for non-default vertical resolution extending top of model above 1mb +M models/atm/cam/src/physics/cam1/phys_grid.F90 +- corrected routine argument from intent out to intent in +M models/atm/cam/test/system/CAM_test.pm +- bug fix for "-skip" options in test-model +M models/ice/csim4/ice_data.F90 +- fixed out of bounds array reference +M models/lnd/clm2/src/main/fileutils.F90 +- now call csm_share code for mss system calls +R models/lnd/clm2/src/main/system_cmd.c +- no longer needed - now using csm_share code + +M models/utils/esmf/README +M models/utils/esmf/build/common +A models/utils/esmf/build/Darwin_absoft/ESMF_conf.h +A models/utils/esmf/build/Darwin_absoft/base +A models/utils/esmf/build/Darwin_absoft/base.site +A models/utils/esmf/build/Darwin_absoft/base_variables +A models/utils/esmf/build/Darwin_absoft/fix.h +A models/utils/esmf/build/Darwin_xlf/ESMF_conf.h +A models/utils/esmf/build/Darwin_xlf/base +A models/utils/esmf/build/Darwin_xlf/base.site +A models/utils/esmf/build/Darwin_xlf/base_variables +M models/utils/esmf/src/Infrastructure/Error/ESMC_Error.c +M models/utils/esmf/src/Infrastructure/TimeMgmt/ESMC_Alarm.c +M models/utils/esmf/src/Infrastructure/TimeMgmt/ESMC_Calendar.c +M models/utils/esmf/src/Infrastructure/TimeMgmt/ESMC_Date.c +M models/utils/esmf/src/Infrastructure/TimeMgmt/ESMC_TOD.c +M models/utils/esmf/src/Infrastructure/TimeMgmt/ESMC_Time.c +- upgrade to esmf_0_0_8 + +M models/utils/timing/t_pclstr.c +M models/utils/timing/t_stop.c + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_17 +Originator: jeff ( Yen-Huei Lee) +Date: Mon Sep 13 14:41:57 MDT 2004 +Model: CAM +Version: CAM3.0.17 +One-line Summary: bug fix +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + + Add one file + + A models/atm/cam/src/physics/cam1/upper_bc.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_16 +Originator: jeff ( Yen-Huei Lee) +Date: Mon Sep 13 13:22:44 MDT 2004 +Model: CAM +Version: CAM3.0.16 +One-line Summary: modified vertical diffusion +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Tested to work with SCAM (tools/scam/testscript): yes +Machines tested: IBM, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + + Modified the following files: + M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + M models/atm/cam/src/physics/cam1/tphysac.F90 + M models/atm/cam/src/physics/cam1/rad_constituents.F90 + M models/atm/cam/src/physics/cam1/ghg_defaults.F90 + M models/atm/cam/src/physics/cam1/constitueadvnce.F90 + M models/atm/cam/src/physics/cam1/advnce.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_15 +Originator: eaton ( Brian Eaton) +Date: Thu Sep 2 08:14:58 MDT 2004 +Model: CAM +Version: CAM3.0.15 +One-line Summary: new radiation/constituents interface +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, boville, conley +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Create an new radiation/constituent interface. This functionality (for gas +phase constituents) previously resided in the chemistry module. It has +been reimplemented in it's own module (rad_constituents.F90) to facilitate +swapping in new chemistry code without having to duplicate the control +logic in another chemistry module. Also, the new module can be extended to +coordinate control of the aerosol constituents. + +Modified the constituents module: +1) Add an optional argument to cnst_add to allow specifying that the + default outfld calls for that constituent should not be made. This + allows, for example, the chemistry module to output volume mixing + ratios rather than the default mass mixing ratios. +2) Add an optional argument to cnst_get_ind to allow it to return an error + status rather than just aborting if the requested name is not found in + the constituent array. + +Add a bugfix to cldwat.F90. Some variables needed initializers. Only +caused a problem if the top of the model was above 1mb. + +Create a new module (ghg_defaults.F90) for the default ghg distributions +computed by trcmix. + +Added lat and lon (radians) to the physics_state data type. + +Add a method to the ozone_data module to return a pointer to the +interpolated data. + +Returned the chemistry module to its previous functionality of just +providing prognostic ghg distributions using a simple production/loss +chemistry. + + +=============================================================== +=============================================================== + +cam3_0_14 +Originator: jmccaa ( James Mccaa) +Date: Wed Aug 25 19:58:09 MDT 2004 +Model: CAM +Version: CAM3.0.14 +One-line Summary: Introduction of definehires utility and use of 30 second topographic variance (SGH30) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +This checkin introduces a new utility, definehires, that can be used to process +USGS 30 second topographic data and produce a 10-minute dataset suitable for +use with definesurf. +It is located in the directory: +cam1/models/atm/cam/tools/definehires/README + +The following files were modified to accomodate a new input dataset + field (SGH30) that represents the variance of the 30-second + height data on the 10-minute grid. This supplements the field + SGH, which represents the variance of the 10-minute mean heights + on the model grid. Both definesurf and CAM can still use the + old datasets with no change in answers from the current code. + In the case of CAM, if SGH30 is not present, the model will use + SGH in its place (as it currently does), but SGH30 will be used + if found. +>> cam1/models/atm/cam/src/dynamics/eul/inidat.F90 +>> cam1/models/atm/cam/src/dynamics/sld/inidat.F90 +>> cam1/models/atm/cam/src/dynamics/fv/inidat.F90 +>> cam1/models/atm/cam/src/physics/cam1/comsrf.F90 +>> cam1/models/atm/cam/src/physics/cam1/diagnostics.F90 +>> cam1/models/atm/cam/src/physics/cam1/physpkg.F90 +>> cam1/models/atm/cam/src/physics/cam1/restart_physics.F90 +>> cam1/models/atm/cam/src/physics/cam1/tphysac.F90 +>> cam1/models/atm/cam/src/control/history.F90 +>> cam1/models/atm/cam/tools/definesurf/Makefile +>> cam1/models/atm/cam/tools/definesurf/fmain.f90 +>> cam1/models/atm/cam/tools/definesurf/sghphis.f90 + + +=============================================================== +=============================================================== + +cam3_0_13 +Originator: eaton ( Brian Eaton) +Date: Tue Aug 24 15:28:21 MDT 2004 +Model: CAM +Version: CAM3.0.13 +One-line Summary: add single interface for radiation to access trace gases +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes, same-to-roundoff +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +The non-water gas phase constituents that are required by the radiation +codes are O3, CO2, CH4, N2O, CFC11, CFC12. All these constituents, except +CO2, are now accessed only via the chemistry module. A single method, +chem_get_cnst, returns constituent values regardless of whether they are +prognostic variables from the constituent array, or are diagnosed or +interpolated from a dataset. So all the logic for determining where a +constituent comes from now lives in the top level chemistry interface and +not in the top level radiation interface. + +CO2 is a special case because it is assumed by the radiation algorithms to +be a single global value. For now it is still accessed directly from the +ghg_surfvals module. We expect this to change in the future. + +These changes are roundoff due to the decision that chem_get_cnst should +return values as mass mixing ratio. Previously O3 values were accessed +from the interpolation routine as volume mixing ratio and converted to +mass mixing ratio as needed. The change in where this conversion happens +introduced a roundoff level difference. + + +=============================================================== +=============================================================== + +cam3_0_12 +Originator: jmccaa ( James McCaa) +Date: Thu Aug 19 09:06:13 MDT 2004 +Model: CAM +Version: CAM3.0.12 +One-line Summary: Addition of a column radiation model and various fixes to SCAM. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +This checkin adds a column radiation model to the SCAM, and also +contains a variety of general fixes/enhancements to SCAM, mostly +centered around allowing it to work with nonstandard numbers of model +levels. Details follow... + + +Addition of the column radiation model: +--------------------------------------- + +The CRM can operate on old-style text CRM input files, or on a model +state initialized via any of scam's existing methods. + +The CRM has both non-gui and gui modes. The gui version is accessed +via a new page under scam's "Options" tab. The non-gui version is +accessed via a shell script named crm. + +I modified testscript to test the crm. +The following output from the test script indicates a pass (both lines +must be present): + +scam passed its bfb test. +CRM passed. + + +General scam modifications: +--------------------------- + +Scam now honors the use_srfprop flag. + +To facilitate running at nonstandard numbers of levels: + scam now guesses the appropriate level-dependent pressure file to use. + ncdio_atm.F90 has been modified to interpolate/extrapolate data to + the scam levels if necessary. + +Handling of defaults files and quickstart files is slightly more robust. + +Scam now plots interface level fields correctly. + +Buffer sizes have been increased to allow scam to use up to 300 levels. + +The gui's configure script has been modified to remove an unnecessary +dependency on libg2c when not using ncar graphics + +I fixed an unitialized value problem in readiopdata.F90. + +I modified init_model.F90 to handle C-to-fortran string passing +according to the unix standard. + +I modified the scam testscript to retry (up to 10 times) on +compilation failures to try to overcome our persisent license server +problems. + +I added a sanity check on precab(i) to cldwat.F90. + +Updated init_model.F90 to reference ozone_data.F90 instead of comozp.F90. + +Lastly, I removed 7 Mb of apparently unneeded ncar graphics files from +the repository. + +=============================================================== +=============================================================== + +cam3_0_11 +Originator: eaton ( Brian Eaton) +Date: Fri Aug 13 12:06:12 MDT 2004 +Model: CAM +Version: CAM3.0.11 +One-line Summary: add fv 1.9x2.5 resolution; sst dataset generation tools +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Add 1.9x2.5 (96 lats, 144 lons) resolution for finite volume. Configure +using: + configure -dyn fv -res 1.9x2.5 + +Add sst dataset generation tools from Jim Rosinski. + + +=============================================================== +=============================================================== + +cam3_0_10 +Originator: eaton ( Brian Eaton) +Date: Mon Aug 9 12:11:12 MDT 2004 +Model: CAM +Version: CAM3.0.10 +One-line Summary: add new modules for radiation and ozone data +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +. Created modules for ozone datasets (ozone_data.F90), longwave radiation + (radlw.F90), and shortwave radiation (radsw.F90). + + The old radini which initialized the old common block crdcon contained a + couple of constants which differed from the share constants. In order to + have a bit-for-bit commit the old values have been maintained. + +. Add pointer variables inside radiation_tend to provide flexible method of + passing either prescribed or prognostic constituents to the radiation + calcs. + +. Removed the common block ptrrgrid.h which was not being used. + +. Added some FV 10x15 datasets to the Default*Namelist.xml files. + +. Added back 13 files that were lost during the cam3_0_9 commit. + +=============================================================== +=============================================================== + +cam3_0_9 +Originator: rosinski ( Jim Rosinski) +Date: Sun Jul 25 14:14:34 MDT 2004 +Model: CAM +Version: CAM3.0.9 +One-line Summary: Enable CAM to build and run using Intel compiler suite +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): no +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, CLM changes by Vertenstein +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +CVS says: + +M atm/cam/bld/Makefile +M lnd/clm2/src/biogeophys/Hydrology2Mod.F90 +M lnd/clm2/src/main/decompMod.F90 +M lnd/clm2/src/main/histFileMod.F90 +A utils/esmf/build/linux_altix/ESMF_conf.h +A utils/esmf/build/linux_altix/base +A utils/esmf/build/linux_altix/base.site +A utils/esmf/build/linux_altix/base_variables +A utils/esmf/build/linux_altix/fix.h +A utils/esmf/build/linux_intel/ESMF_conf.h +A utils/esmf/build/linux_intel/base +A utils/esmf/build/linux_intel/base.site +A utils/esmf/build/linux_intel/base_variables +A utils/esmf/build/linux_intel/fix.h +M utils/timing/t_pr.c + +Minor mods (listed above) to CAM Makefile, timing print routine, CLM +routines, and ESMF to enable CAM to build and run on Linux machines using +Intel compiler suite. 2-day error growth test using ifort and icc passed at +T42 in EUL configuration. + +ESMF upgraded to ESMF_0_0_6 per Erik Kluzek. No code changes, but support +added for linux_intel and linux_altix. Note that linux_intel assumes that +Fortran and C compilers are both Intel (ifort and icc respectively). Though +CAM can be configured (and will run) with gcc, there is little point in doing +this as of this commit since ESMF will still require icc. + +Minor mods to CLM routines to allow compilation with ifort. + +Addition of an "fclose" to timing print routine t_pr.c to force a buffer +flush. Without it icc was truncating its printed output of model timers. + + +IMPORTANT: the only configurations of Intel compiler suite and underlying +glibc library that proved successful were: + +ifort >= 8.0.046 +icc >= 8.0.055 +glibc >= 2.3.x + +Tests in which not all these conditions were met resulted in various +failures, including general compiler errors, internal compiler errors, and +segmentation faults. + +Notes: + +o In general the Intel compilers create code that runs fast. Compile times +for optimized code (-O2) can be fairly long. + +o The debugger (idb) is line-based. Hopefully it can be used in conjunction +with ddd to give a window-based option. + +o Hybrid OpenMP/MPI configuration with Intel compilers was tested and does +work. Little timing difference compared with pure-MPI was observed. +Depending on model conifiguration, manipulation of environment variable +KMP_STACKSIZE may be required to avoid seg faults when threading is enabled. + +o Tests enabling floating point traps (-fpe0) did not work in SPMD mode, so +this option was not included in Makefile mods. Hopefully the code changes +required to enable this option will be minor. + + +=============================================================== +=============================================================== + +cam3_0_8 +Originator: jeff ( Yen-Huei Lee) +Date: Wed Jul 21 11:53:53 MDT 2004 +Model: CAM +Version: CAM3.0.8 +One-line Summary: ntoplw changes to radiation arrays +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe)no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate)no +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + + M models/atm/cam/src/physics/cam1/crdcon.h + M models/atm/cam/src/physics/cam1/radae.F90 + M models/atm/cam/src/physics/cam1/radclwmx.F90 + M models/atm/cam/src/physics/cam1/radini.F90 + M models/atm/cam/src/physics/cam1/restart_physics.F90 + M models/atm/cam/src/physics/cam1/trcplk.F90 + M models/atm/cam/src/physics/cam1/trcpth.F90 + +See: http://www.cgd.ucar.edu/cgi-binradae.F90/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_7 +Originator: mvr ( Mathew Rothstein), eaton, bundy +Date: Tue Jul 20 10:03:47 MDT 2004 +Model: CAM +Version: CAM3.0.7 +One-line Summary: Added new physics interface (deep & shallow convection, stratiform, radiation) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: to be determined +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton, bundy +Restart files change: no +Changes answers: Yes (same-to-roundoff) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +R models/atm/cam/src/physics/cam1/cldcond.F90 +R models/atm/cam/src/physics/cam1/cldnrh.F90 +R models/atm/cam/src/physics/cam1/convtran.F90 +R models/atm/cam/src/physics/cam1/moistconvection.F90 +R models/atm/cam/src/physics/cam1/radctl.F90 +A models/atm/cam/src/physics/cam1/convect_deep.F90 +A models/atm/cam/src/physics/cam1/convect_shallow.F90 +A models/atm/cam/src/physics/cam1/hk_conv.F90 +A models/atm/cam/src/physics/cam1/radiation.F90 +A models/atm/cam/src/physics/cam1/stratiform.F90 +M models/atm/cam/src/control/history.F90 +M models/atm/cam/src/dynamics/eul/inidat.F90 +M models/atm/cam/src/dynamics/fv/inidat.F90 +M models/atm/cam/src/dynamics/sld/inidat.F90 +M models/atm/cam/src/physics/cam1/aerosol_intr.F90 +M models/atm/cam/src/physics/cam1/buffer.F90 +M models/atm/cam/src/physics/cam1/carbon_intr.F90 +M models/atm/cam/src/physics/cam1/diagnostics.F90 +M models/atm/cam/src/physics/cam1/dust_intr.F90 +M models/atm/cam/src/physics/cam1/initindx.F90 +M models/atm/cam/src/physics/cam1/inti.F90 +M models/atm/cam/src/physics/cam1/param_cldoptics.F90 +M models/atm/cam/src/physics/cam1/phys_adiabatic.F90 +M models/atm/cam/src/physics/cam1/phys_idealized.F90 +M models/atm/cam/src/physics/cam1/physics_types.F90 +M models/atm/cam/src/physics/cam1/physpkg.F90 +M models/atm/cam/src/physics/cam1/restart_physics.F90 +M models/atm/cam/src/physics/cam1/srfxfer.F90 +M models/atm/cam/src/physics/cam1/sulfur_intr.F90 +M models/atm/cam/src/physics/cam1/tphysbc.F90 +M models/atm/cam/src/physics/cam1/zm_conv.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_6 +Originator: mvr ( Mathew Rothstein) +Date: Fri Jul 16 16:54:46 MDT 2004 +Model: CAM +Version: CAM3.0.6 +One-line Summary: Added SOM tools; Modified CLM log output to version 3.0; Bug fix for system command strings +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes...updated log output to version 3.0 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +---added files needed to create SOM tools +A models/atm/cam/tools/definemld/Makefile +A models/atm/cam/tools/definemld/README +A models/atm/cam/tools/definemld/binf2c.f90 +A models/atm/cam/tools/definemld/definemld1x1.c +A models/atm/cam/tools/definemld/definemld1x1.h +A models/atm/cam/tools/definemld/definemldbdy.f90 +A models/atm/cam/tools/definemld/err_exit.c +A models/atm/cam/tools/definemld/neighborfill.f90 +A models/atm/cam/tools/definemld/precision.f90 +A models/atm/cam/tools/definemld/sm121.f90 +A models/atm/cam/tools/definemld/wrap_nc.c +A models/atm/cam/tools/definemld/wrap_nf.f90 +A models/atm/cam/tools/defineqflux/Makefile +A models/atm/cam/tools/defineqflux/README +A models/atm/cam/tools/defineqflux/backsolve.c +A models/atm/cam/tools/defineqflux/check_consistent.c +A models/atm/cam/tools/defineqflux/defineqflux.c +A models/atm/cam/tools/defineqflux/defineqflux.h +A models/atm/cam/tools/defineqflux/definesomic.h +A models/atm/cam/tools/defineqflux/err_exit.c +A models/atm/cam/tools/defineqflux/gepp.c +A models/atm/cam/tools/defineqflux/mksith.c +A models/atm/cam/tools/defineqflux/printeq.c +A models/atm/cam/tools/defineqflux/timediddle_mavg.c +A models/atm/cam/tools/defineqflux/wrap_nc.c + +M models/lnd/clm2/src/main/initializeMod.F90 + - updated log output to version 3.0 +M models/atm/cam/src/control/system_cmd.c + - bug fix for handling of system command strings + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_5 +Originator: jet ( John Truesdale) +Date: Thu Jun 24 13:17:43 MDT 2004 +Model: CAM +Version: CAM3.0.5 +One-line Summary: Updated SCAM files to match cam3.0 distribution +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: mostly documentation) +(Detailed description below) +Tested to work coupled with CCSM (create_ccsmcam): no +Machines tested: none +Ran test-model.pl script: no +Tested on fv dynamics: na +Tested on eul dynamics:na +Tested on sld dynamics:na +Tested that restarts are bit-for-bit: na +Tested multiple constituents: na +Tested that different domain decompositions match bit-for-bit: na +Tested in adiabatic mode: na +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM +CRB? yes + +Changes made: + +Added data directory and README file +deleted duplicate INSTALL and scam.html file in html directory +updated userguide.html +corrected but in testscript + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_4 +Originator: mvr ( Mathew Rothstein), truesdale, vertenstein +Date: Mon Jun 21 10:19:32 MDT 2004 +Model: CAM +Version: CAM3.0.4 +One-line Summary: Cleanup of default settings of CAM/CLM input datasets; SCAM updated; Fixed two CLM bugs +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, truesdale, vertenstein +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes +fixed bug in code to exclude fields from history tape; fixed bug in code that +generates land surface datasets for fv +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +R models/atm/cam/tools/scam/scm_init/scam_rpc.h +A models/atm/cam/tools/scam/testscript + - new validation test script +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml + - modified entry for fv2x2.5 input dataset, removed references to linked + files, modified some comments +M models/atm/cam/bld/DefaultCLMEXPNamelist.xml + - new entry for fv2x2.5 input dataset, modified some comments +M models/atm/cam/tools/scam/.scam_defaults +M models/atm/cam/tools/scam/configure +M models/atm/cam/tools/scam/ui/configure +M models/atm/cam/tools/scam/ui/manager.cpp +M models/lnd/clm2/src/main/histFileMod.F90 + - fixed bug in code that allows user to exclude fields from primary + history tape +M models/lnd/clm2/src/mksrfdata/mksrfdatMod.F90 + - fixed bug in generation of land surface datasets for fv + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_3 +Originator: olson ( Jerry Olson) +Date: Thu Jun 17 14:33:44 MDT 2004 +Model: CAM +Version: CAM3.0.3 +One-line Summary: new initial conditions input/output +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton +Restart files change: no +Changes answers: no (bit-for-bit) except: + a) answers change in aqua-planet mode for all dycores + (new climate) + b) round-off for SLD on IBMs +Changes to CLM land-model: yes. trivial mods to comments +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + + +-------------- + + Description of changes: + + - The history.F90 module is modified to include the Initial Conditions file as + part of the general history file build process. Details: + + - the IC file is formatted exactly like a history file. + - just as in other history files, the IC file is filled via calls to + "outfld". + - no time averaging; fields are always instantaneous + - only one time sample written to file + - accumulation/output is in double precision + - "ptapes" increased from 6 to 7 + - IC file is indexed "mtapes" in the history module (always at end of + active history file list) + - name of file includes ".i." rather than ".hX." + + - two namelist parameters control the building of the IC file: + + - INITHIST: controls frequency of IC file writes (for both land and + atmosphere): '6-HOURLY, 'DAILY', 'MONTHLY', 'YEARLY' or + 'NONE' + - INITHIST_ALL: .false.: dump ONLY required fields to IC file + .true. : dump required AND optional fields to IC + file (DEFAULT) + - setting "EMPTY_HTAPES = .true." does NOT prevent the IC file from being + created. + - only setting INITHIST = 'NONE' prevents the IC file from being created. + - no space allocated on history buffer if INITHIST = 'NONE' + - the old IC file build routine, "write_inithist" is removed + + - Note: - In an Eulerian run, the new code does not produce identical IC + files as the old code. The values for QCWAT, TCWAT, LCWAT, and + CLD will be different. + + - In adiabatic mode, the FV dycore *still* does not create an IC + file with the proper temperature on it. In adiabatic mode, FV + does not update temperature. Therefore, the IC file will + contain the wrong temperature. + + - History (and IC) fieldnames can be up to 16 characters long + + - inidat.F90 re-written for all dycores. All fields are now read and processed + one at a time, reducing memory costs. All reads are done via a call to a + single netCDF interface (modified version of module written for the Land + Model by Mariana Vertenstein). + + - inidat.F90 is backward compatible with OLD IC files. + + - EUL and SLD spetru.F90 modules modified to be identical to eachother + + - another new namelist variable: + + RAD_FIRST_HOUR: Flag to force model to compute full radiation every + timestep in the first model hour (for use in + "forecast/analysis" runs) + Default: .false. + + - restart files will change (because of extra characters for each field) + + - Removed code associated with HADVTEST and VADVTEST cpp tokens ("blob" test) + + - Bugfixes in aqua-planet mode: + + - the field "landm" is now set to 0. Changes answers; new climate for + aqua-planet. + - fixed bug in analytical SST specification (in a branch of code not run + by default model) + - Bugfix to test-model.pm provided by Erik. + + +-------------- + + Files modified: + + M models/atm/cam/bld/CAM_run.pm + - Bugfix provided by Erik + M models/atm/cam/src/control/comctl.h + - added namelist variable, "rad_first_hour" + M models/atm/cam/src/control/filenames.F90 + - deleted old IC file logic + M models/atm/cam/src/control/history.F90 + - extensive changes to add IC file as + part of the history file set (ptapes = 7) + - history file field names can be up to + 16 characters long + M models/atm/cam/src/control/readinitial.F90 + - added logic to trap possible model and IC file inconsistencies in the + grid/spectral resolutions + M models/atm/cam/src/control/runtime_opts.F90 + - added new namelist variables + M models/atm/cam/src/dynamics/eul/dyndrv.F90 + - removed blob test code + M models/atm/cam/src/dynamics/eul/grmult.F90 + - removed blob test code + M models/atm/cam/src/dynamics/eul/inidat.F90 + - cleanup + M models/atm/cam/src/dynamics/eul/linemsdyn.F90 + - removed blob test code + M models/atm/cam/src/dynamics/eul/spetru.F90 + - modified so that "eul" and "sld" spetru routines are identical + M models/atm/cam/src/dynamics/eul/stepon.F90 + - removed logic associated with old IC file code + - added call to dump state field values to IC file buffer + M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + - removed blob test code + - fix to qneg3 diagnostic print + M models/atm/cam/src/dynamics/fv/inidat.F90 + - cleanup + M models/atm/cam/src/dynamics/fv/inital.F90 + - modified a "use" statement + M models/atm/cam/src/dynamics/fv/stepon.F90 + - removed logic associated with old IC file code + - added call to dump state fields to IC file buffer + M models/atm/cam/src/dynamics/sld/dyndrv.F90 + - removed blob test code + M models/atm/cam/src/dynamics/sld/grmult.F90 + - removed blob test code + M models/atm/cam/src/dynamics/sld/inidat.F90 + - cleanup + M models/atm/cam/src/dynamics/sld/restart_dynamics.F90 + - removed unused fields from restart file + M models/atm/cam/src/dynamics/sld/scan2.F90 + - removed logic associated with old IC file code + M models/atm/cam/src/dynamics/sld/scanslt.F90 + - removed blob test code + M models/atm/cam/src/dynamics/sld/sltwgts.F90 + - removed blob test code + M models/atm/cam/src/dynamics/sld/spetru.F90 + - modified so that "eul" and "sld" spetru routines are identical + M models/atm/cam/src/dynamics/sld/stepon.F90 + - added call to dump state fields to IC file buffer + M models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 + - removed blob test code + - fixed diagnostics bug in qneg3 + M models/atm/cam/src/ocnsice/dom/sst_data.F90 + - fixed bug in analytical SST specification (used in "aqua-planet" mode) + M models/atm/cam/src/physics/cam1/advnce.F90 + - Do full radiation every timestep of first model hour if "rad_first_hour" + is .true. + M models/atm/cam/src/physics/cam1/diagnostics.F90 + - add routine to dump physics fields to IC file buffer + M models/atm/cam/src/physics/cam1/phys_adiabatic.F90 + - cleanup + M models/atm/cam/src/physics/cam1/physics_types.F90 + - fix to qneg3 diagnostic print + M models/atm/cam/src/physics/cam1/phys_idealized.F90 + - cleanup + M models/atm/cam/src/physics/cam1/physpkg.F90 + - call routine to dump physics fields to IC file buffer + M models/atm/cam/src/physics/cam1/qneg3.F90 + - fix to qneg3 diagnostic print + M models/atm/cam/src/physics/cam1/restart_physics.F90 + - fix to quell compiler complaint + M models/atm/cam/src/physics/cam1/tphysbc.F90 + - fix to qneg3 diagnostic print + M models/lnd/clm2/src/main/clm_varctl.F90 + M models/lnd/clm2/src/main/inicFileMod.F90 + +-------------- + + Files added: + + A models/atm/cam/src/control/ncdio_atm.F90 + - Wrapper for reading a 2-D or 3-D field from a netCDF IC file + A models/atm/cam/src/dynamics/eul/diag_dynvar_ic.F90 + - "outfld" dynamics state variables to history buffer (for IC file) + A models/atm/cam/src/dynamics/fv/diag_dynvar_ic.F90 + - "outfld" dynamics state variables to history buffer (for IC file) + A models/atm/cam/src/dynamics/sld/diag_dynvar_ic.F90 + - "outfld" dynamics state variables to history buffer (for IC file) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_2 +Originator: erik ( Erik Kluzek) +Date: Wed Jun 9 10:29:42 MDT 2004 +Model: CAM +Version: CAM3.0.2 +One-line Summary: Major test-model.pl update, bug fix for DGVM in clm code +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton, Matt Rothstein, and Tom Henderson +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: DGVMMod.F90, and driver.F90 from Mariana for DGVM bug-fix +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Synopsis: + +Overall this is a major refactoring of test-model.pl. This is the version +of test-model.pl that was on the subroutinization branch for the last year. +This improves the default behavior of test-model.pl and makes it easier +and more flexible to use. It also provides for the ability to test the +test-model.pl test harness. + +Files changed and a description of the changes: + +M models/atm/cam/bld/CAM.pm +M models/atm/cam/bld/CAM_config.pm +M models/atm/cam/bld/CAM_namelist.pm +M models/atm/cam/bld/CAM_run.pm +R models/atm/cam/bld/check-namelist.pl +R models/atm/cam/bld/lsmexp.pm +M models/atm/cam/bld/run-model.pl + +Add abilities needed by new test-model.pl. Don't delete *.f90 files. +Delete lsmexp.pm file. Make run options more clear. Add printlev and test +option to namelist. Build_namelist always does a new on a namelist +object. Get rid of check-namelist.pl as not used. + +M models/atm/cam/test/system/CAM_test.pm +M models/atm/cam/test/system/README +A models/atm/cam/test/system/babyblue.test-model.pl.log ! testonly mode results +M models/atm/cam/test/system/dao_batch.csh +A models/atm/cam/test/system/default_tests.test-model.xml ! XML default tests +A models/atm/cam/test/system/namelist-config.test-model.dbg.log ! file of + configuration/namelists from testonly mode +M models/atm/cam/test/system/ncar_batch.csh +A models/atm/cam/test/system/specs-testslist.test-model.xml ! XML file of + specifications of fields expected in testslist XML files +M models/atm/cam/test/system/test-model.pl + +New version of test-model.pl as described below. + +M models/atm/cam/tools/newcprnc/Makefile + +Allow use of env variables needed by test-model.pl. Still not used in +test-model.pl as newcprnc doesn't do a proper mass weighting of the +differences. + +M models/lnd/clm2/src/biogeochem/DGVMMod.F90 +M models/lnd/clm2/src/main/driver.F90 + +Bug-fixes from Mariana for DGVM. + +Details of changes to test-model.pl + +test-model.pl -- new version with XML files to control tests that + are run. This is the version of test-model.pl that was + used on the subroutinization branch. Modified batch scripts + to correspond to new command line options. + +Default is changed so that if you are comparing and a test is +NOT bit-for-bit to the comparision code -- test-model.pl will +stop. + +New command line options to test-model.pl + +-cleanonly = only clean files out +-help_defaults = Create file with configuration/namelist information + for all tests -allow_nonb4bcompare = Allow comparisions not bit-for-bit to continue. +-[no]spmd = Turn on [off] SPMD mode +-[no]smp = Turn on [off] SMP mode +-nocompareifskipped = If you are skipping tests a comparision will NOT + be run if a given test is skipped. -namelist "namelist" = Reads in namelist and adds these options to the + namelists that are used. +-testonly = Only test test-model.pl running configure and + build-namelist for all tests to demonstrate what + test-model.pl would have produced. +-testslist filename = Use the given XML file of tests rather + than the default file. + +Information on all command-line options is given with + +test-model.pl -help + +newcprnc -- Add ability to use the env variables needed for test-model.pl + VPATH, EXEDIR. To use this in test-model.pl change the path + in test-model.pl and change CAM_test.pm to NOT use the "-m" option + as the behavior of this flag was reversed in newcprnc from cprnc. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0_1 +Originator: erik ( Erik Kluzek) +Date: Tue May 25 16:40:56 MDT 2004 +Model: CAM +Version: CAM3.0.1 +One-line Summary: Get rid of ncdata_vers stuff, and fix SOM comparision bug in test-model.pl +cam-bugs Requests resolved: 118 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes +(ncdata_vers is no longer needed) +Tested to work coupled with CCSM (create_ccsmcam): yes +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Get rid of ncdata_vers stuff in the build-namelist scripts. + +Fix bug in SOM comparisions, so test-model.pl will flag a difference +if SOM code changes. Previously this aspect was broken and the comparisions +files were mislabled. Now the files are properly labeled, SOM control +tests are made in a seperate directory, and namelist and configuration +variables are consistent such that the comparision is valid. This problem +was documented as cam-bug #118. + +No code was changed only build and configuration and test scripts. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam3_0 +Originator: eaton ( Brian Eaton) +Date: Mon May 24 15:33:43 MDT 2004 +Model: CAM +Version: CAM3.0 +One-line Summary: remove old CAM2 documentation +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: none +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no + +Changes made: + +Remove old CAM2 documentation. + +=============================================================== +=============================================================== + +cam2_0_2_dev86 +Originator: mvertens ( Mariana Vertenstein) +Date: Thu May 20 10:56:00 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev86 +One-line Summary: updated clm code clm3_deva_14 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes (TER.01a.T31_gx3v5.K.blackforest) +Machines tested: IBM, SGI, Linux(lf95) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +1) Updated clm code to clm3_deva_14 +2) Updated clm documentation to clm3_deva_14 +3) One line modification to + atm/src/control/ioFileMod.F90 + clm2/src/main/fileutils.F90 + to fix file removal problem associated with mss writes + +=============================================================== +=============================================================== + +cam2_0_2_dev85 +Originator: jet ( John Truesdale) +Date: Tue May 18 14:53:15 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev85 +One-line Summary: Added SCAM to cam_dev +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Added cpp delimeted code to allow clm to work + in single column mode. + +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +My check-in includes 3 sets of modifications to CAM code. +1) modifications to allow it to work in single column mode +2) additional source code and configuration files to create GUI + for the Single-Column CAM (SCAM). +3) modification to CAM to allow it to produce a history file that + can be used by SCAM to run in a pseudo-iop mode using model + data. + +Most of the modifications to CAM source have been delimited by cpp +tokens (#defined SCAM and #defined BFB_CAM_SCAM_IOP) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev84 +Originator: mvr ( Mathew Rothstein) +Date: Fri May 14 09:43:26 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev84 +One-line Summary: Replaced numerical recipes routines for random# generation and findvalue; modified Makefile to eliminate double comma problem; other small bug fixes +cam-bugs Requests resolved: none +Requires change in build system: yes +- replaced the use of function subst in Makefile with patsubst to eliminate + double comma problem +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, pjr +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +R models/atm/cam/src/utils/findvalue.F90 + - removing old find routine based on numerical recipe algorithm +A models/atm/cam/src/utils/marsaglia.F90 + - new random number generator for cloud simulator +M models/atm/cam/src/physics/cam1/cloudsimulator.F90 + - modified to seed new random number generator +M models/atm/cam/src/physics/cam1/icarus_scops.F90 + - now uses new random number generator rather than algorithm from + numerical recipes +M models/atm/cam/src/physics/cam1/radclwmx.F90 + - added r8 declaration to array aer_trn_ttl +M models/atm/cam/src/physics/cam1/radcswmx.F90 + - now uses fortran intrinsic for finding an array minimum rather + than a routine from numerical recipes +M models/atm/cam/bld/Makefile + - replaced the use of function subst with patsubst to eliminate ,, +M models/atm/cam/test/system/CAM_test.pm + - modified error message in test-model + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev83 +Originator: mvr ( Mathew Rothstein) +Date: Thu May 13 09:56:08 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev83 +One-line Summary: Replaced sort routine; modified handling of namelist vars for computing run stop date; modifed input dataset path strings +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: same-to-roundoff +Changes to CLM land-model: yes +- modified strings of default input datasets to include full path from csmdata +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +R models/atm/cam/src/utils/sortarray.F90 + - removing old sort routine based on numerical recipe algorithm +A models/atm/cam/src/utils/quicksort.F90 + - replacing sort routine with new quick-sort algorithm +M models/atm/cam/src/physics/cam1/radclwmx.F90 + - modified to call new sort routine +M models/atm/cam/src/physics/cam1/radcswmx.F90 + - modified to call new sort routine +M models/atm/cam/src/control/time_manager.F90 + - modified handling of namelist parameters for computing stop date +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml + - modified input dataset strings to include full path from csmdata +M models/atm/cam/bld/DefaultCLMEXPNamelist.xml + - modified input dataset strings to include full path from csmdata +M models/atm/cam/bld/camexp.pm + - modified to use new input dataset strings +M models/atm/cam/bld/clm2exp.pm + - modified to use new input dataset strings + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev82 +Originator: jmccaa ( James Mccaa) +Date: Mon May 10 15:40:39 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev82 +One-line Summary: Tuning modifications for the finite volume dycore. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, intel +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes, for FV -- bit-for-bit for EUL and SLD +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +Modified tuning for FV 2x2.5, and introduced tuning settings for FV 4x5 +and FV 1x1.25. +A new i.c. file for FV 4x5 was introduced. +These files were modified: +M cam1/models/atm/cam/bld/DefaultCAMEXPNamelist.xml +M cam1/models/atm/cam/src/dynamics/fv/dycore.F90 +M cam1/models/atm/cam/src/physics/cam1/cldwat.F90 +M cam1/models/atm/cam/src/physics/cam1/cloud_fraction.F90 +M cam1/models/atm/cam/src/physics/cam1/moistconvection.F90 +M cam1/models/atm/cam/src/physics/cam1/zm_conv.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev81 +Originator: mvertens ( Mariana Vertenstein) +Date: Tue May 4 10:40:20 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev81 +One-line Summary: updated clm code to clm3_deva_10 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes (TER.01a.T31_gx3v5.K.blackforest) +Machines tested: IBM, SGI, Linux(lf95) +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Forrest Hoffman +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes (see below) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +1) Updated clm code to clm3_deva_10 + This primarily includes the addition of CrayX1 directives to the code + as well as changes to DGVM to make it effectively work on the Cray X1 + Also changed the name of the clm file changed in cam2_0_2_dev80 back + to its original name for the sake of cvs history continuity +2) Modified history.F90 to use (ieor,iand) rather than (xor,and) + +=============================================================== +=============================================================== + +cam2_0_2_dev80 +Originator: eaton ( Brian Eaton) and Pat Worley +Date: Wed Apr 28 17:44:37 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev80 +One-line Summary: merge vector branch +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux/lf95, Linux/pgi +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Pat Worley +Restart files change: no +Changes answers: Yes (same-to-roundoff) +Changes to CLM land-model: rename STATICEcosysDynMod.F90 --> STATICEcosystemDynMOD.F90 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +1. Merge of vector and scalar code branches: + +The mods for the NEC that didn't change answers (bit-for-bit) were +committed previously. This set of mods introduces a roundoff level +change into the simulation. The main modifications are: + +. A new version of radcswmx. This code runs a little slower on the IBM + (about 4% of total run time). It introduces roundoff level changes + which affects all dycores. + +. Large sections of code have been changed which reorder the spectral + calculations in the EUL dycore. We observed no performance degradation + on the IBM from this change. + +. Most of the Cray optimizations have been included as well. They are mainly + compiler directives. + +2. Rename a CLM file which didn't match the module name it contained (this + breaks the dependency generator) + +3. Some cleanup in ncar_batch.csh + +=============================================================== +=============================================================== + +cam2_0_2_dev79 +Originator: eaton ( Brian Eaton) +Date: Fri Apr 23 07:56:47 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev79 +One-line Summary: T31 tuning; T31 and T85 datasets; diagnostics +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, Linux/lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +. Tuning mods for T31 +. New datasets for T31 and T85 +. Diagnostics: + - AIX specific traceback call added to abortutils + - Check for NaNs in timeinterp + +=============================================================== +=============================================================== + +cam2_0_2_dev78 +Originator: eaton ( Brian Eaton) and Mat Rothstein +Date: Tue Apr 20 10:52:58 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev78 +One-line Summary: misc configure/Makefile/test-model changes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes, on Blackforest +Machines tested: IBM, Linux/lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvr +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +. Fix hack in test-model that set F_OPTIMIZATION_OVERRIDE for certain PGI + tests. The hack was broken by the inclusion of a commandline option to + configure for setting the F_OPTIMIZATION_OVERRIDE macro in the Makefile. +. Add print in test-model output to tells which log contains NOT BFB + message. +. Various configure/Makefile changes: + - Temporarily remove -Mbounds from PGI debug options. CLM2 is not working + with this option. + - Add -cppdefs option to configure for defining CPP tokens. These cpp + definitions are appended to the Makefile defaults. Remove the -precomp + option which was adding #define lines to misc.h. + - Add capability to configure to determine the name of the MPI library + being used. This is currently most useful for Linux which may use + either mpi or mpich as the library name. + - Clean up Linux section of Makefile. Fixed a bug which broke the build + if the user specified the option '-fc pgf90' to configure. Remove + options for compilers that don't have corresponding builds of the ESMF + library. +. Add missing addfld call for H2O2DRY in sulfur_intr.F90 + +=============================================================== +=============================================================== + +cam2_0_2_dev77 +Originator: mvr ( Mathew Rothstein) and Brian Eaton +Date: Tue Apr 6 10:38:51 MDT 2004 +Model: CAM +Version: CAM2.0_2.dev77 +One-line Summary: Update cloud simulator; T31 mods; Enable cloud overlap scenarios; Bug fix in masterlist lookups; Re-commit of infnan mods +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes +replaced infnan mods of dev65, mistakenly removed +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +R models/atm/cam/src/physics/cam1/cloudsimulatorparms.F90 + - put data in icarus_scops.h, put doisccp into cloudsimulator.F90 +A models/atm/cam/src/physics/cam1/icarus_scops.F90 + - new module containing subroutine isccp_cloud_types (converted to free + format) and subroutine ran0_vec + - change output types to r8 + - replace "STOP" with endrun calls + - add diagnostic for meanttop + - add icarus_scops_init routine to read in tautab and invtau arrays +M models/atm/cam/bld/DefaultCAMEXPNamelist.xml + - added default value for dataset isccpdata, needed for isccp simulator +M models/atm/cam/bld/camexp.pm + - modified to handle namelist parameters related to the isccp simulator +M models/atm/cam/src/control/cam.F90 + - remove call to initialization routine +M models/atm/cam/src/control/history.F90 + - use icarus_scops instead of use cloudsimulatorparms + - remove addfld and add_default calls for diagnostic fields (move to + cloudsimulator_init) + - remove unnecessary addfld for aermmr + - added endrun calls for hash table lookups of fields not on masterlist +M models/atm/cam/src/control/runtime_opts.F90 + - use cloudsimulator instead of cloudsimulatorparms +M models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 + - removed outfield calls and related code for fields not on masterlist +M models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 + - removed outfield calls and related code for fields not on masterlist +M models/atm/cam/src/physics/cam1/check_energy.F90 + - removed unneeded code to fix bug identified by SX6 machine +M models/atm/cam/src/physics/cam1/cldwat.F90 + - added special setting of physical constants for T31 runs +M models/atm/cam/src/physics/cam1/cloud_fraction.F90 + - added special setting of physical constants for T31 runs +M models/atm/cam/src/physics/cam1/cloudsimulator.F90 + - rename isccptab --> cloudsimulator_init + - rename ccm_isccp --> cloudsimulator_run + - add state to cloudsimulator_run args + - add addfld and add_default calls for diagnostic fields + - change arguments to isccp_cloud_types from single columns to chunks + - use the totalcldarea diagnostic from isccp_cloud_types rather than the + cltot diagnostic from cam to decide whether it's cloudy or not. This + avoids assigning fillvalues inside the isccp_cloud_types code +M models/atm/cam/src/physics/cam1/constituents.F90 + - commented out code for fields no longer in use +M models/atm/cam/src/physics/cam1/initindx.F90 + - commented out code for fields no longer in use +M models/atm/cam/src/physics/cam1/inti.F90 + - call cloudsimulator_init +M models/atm/cam/src/physics/cam1/moistconvection.F90 + - added special setting of physical constants for T31 runs +M models/atm/cam/src/physics/cam1/param_cldoptics.F90 + - add_default call for icldiwp + - modify long name attribute for icldlwp +M models/atm/cam/src/physics/cam1/radclwmx.F90 + - uncommented line and modified associated array declaration in LW + cloud-overlap code (critical for certain cloud overlap assumptions) +M models/atm/cam/src/physics/cam1/tphysbc.F90 + - use cloudsimulator instead of cloudsimulatorparms + - update cloudsimulator_run args + - removed outfield calls and related code for fields not on masterlist +M models/atm/cam/src/physics/cam1/zm_conv.F90 + - added special setting of physical constants for T31 runs +M models/lnd/clm2/src/main/nanMod.F90 + - replaced mods for quiet/signalling NaN's of dev65 that were + mistakenly overwritten with dev75 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev76 +Originator: rosinski ( Jim Rosinski) +Date: Tue Mar 30 15:11:23 MST 2004 +Model: CAM +Version: CAM2.0_2.dev76 +One-line Summary: bit-for-bit NEC vector branch changes. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit). PC is only roundoff +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Merged cam2.0.2.dev67.brnchT.nec15 (vector branch) changes that do not affect + answers onto cam_dev. Opted for Pat Worley's dev68 communication mods over NEC + communication mods where conflicts occurred. A few NEC_SX ifdefs still + exist in the committed code. Most involve reversing "do k" and "do i" + loops in dynamics routines for vectorization. An inner loop over k results + in a non-unit-stride situation on scalar machines and should be avoided. + That is why these code portions were left ifdef'd + +o Note 1: The code appears to be good to roundoff on IBM machines when NEC_SX is + #define'd. To test this on an IBM, "! defined AIX" needs to be added in 2 + obvious places in cfort.h and abortutils.F90 + +o Note 2: An odd behavior was discovered whereby inconsistent chunck indices are + printed from ice_srf.F90 at times when the ice temperature profile is reset to + linear. This behavior appears to only manifest when threads * tasks exceeds + the number of physical CPUs available. It was decided to commit without + resolving this discrepancy because the behavior occurs in the base model and + in earlier libraries, i.e. independent of the NEC vector mods. + +=============================================================== +=============================================================== +cam2_0_2_dev75 +Originator: mvertens ( Mariana Vertenstein) +Date: Fri Mar 26 15:07:40 MST 2004 +Model: CAM +Version: CAM2.0_2.dev75 +One-line Summary: updated clm to clm3_deva_08 +cam-bugs Requests resolved: none +Requires change in build system: no (can removed atmlnd_share from Filepath howeer) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, (Brian Eaton revied cam time_manager.F90) +Restart files change: yes +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes - updated to clm3_deva_08 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +1) added perpetual model to cam-clm + - updated clm/src to clm3_deva_09 which had perpetual mode changes. + - modified models/atm/cam/src/control/time_manager.F90 to add offset argument to + subroutine get_perp_date(..) +2) changes to models/atm/cam/bld/: + - removed setting of reset_csim_iceprops in DefaultCAMEXPNamelist.xml + - removed atmlnd_share from configure +3) chages to atmlnd_share/: + atmlnd_share no longer needed + atmlnd_share/cfort.h updated and moved to models/atm/cam/src/control and models/lnd/clm2/src/main + atmlnd_share/datetime.F90 moved to models/atm/cam/src/control + atmlnd_share/infnan.F90 moved to models/atm/cam/src/control + atmlnd_share/linebuf_stdout.c moved to models/atm/cam/src/control + atmlnd_share/mpishorthand.F moved to models/atm/cam/src/control + atmlnd_share/string_utils.F90 moved to models/atm/cam/src/control + atmlnd_share/wrap_nf.F90 moved to models/atm/cam/src/control +4) other changes: + removed all files in following directories - they are now obsolete:following obsolete files: + models/bld/ + scripts/gui/ + scripts/gui_run/ + scripts/system_test/ + scripts/test.a1/ + scripts/test.a2/ + scripts/tests/cpl_check/ + scripts/tests/gprof/ + scripts/tests/sub_sgi/ + scripts/tests/test_scripts/ + scripts/tests/timing/ +=============================================================== +=============================================================== + +cam2_0_2_dev74 +Originator: mvr ( Mathew Rothstein) +Date: Thu Mar 18 11:51:59 MST 2004 +Model: CAM +Version: CAM2.0_2.dev74 +One-line Summary: Add fields to master list for radiation diagnostics; fixes to build-namelist for "naked decimal" and handling of raw land surface datasets +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes +clm2exp.pm: now properly handles user-specified raw land surface datasets +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M cam1/models/atm/cam/bld/clm2exp.pm + - now properly handles user-specified raw land surface datasets +M cam1/models/atm/cam/bld/namelist.pm + - added ability to read "naked" decimal entries +M cam1/models/atm/cam/bld/script_tests/namelist.pl + - added namelist tests for "naked" decimal entries and more +M cam1/models/atm/cam/src/control/history.F90 + - add addfld calls for ASDIR, ASDIF, ALDIR, ALDIF + - remove old addfld call for REL + - add addfld call for SST +M cam1/models/atm/cam/src/physics/cam1/comsrf.F90 + - init trefmxav, trefmnav + - init lchnk and ncol in srfflx_state_2d +M cam1/models/atm/cam/src/physics/cam1/diagnostics.F90 + - change diag_surf to use srfflx_state and surface_state types + - add outfld calls for ASDIR, ASDIF, ALDIR, ALDIF + - add outfld call for SST +M cam1/models/atm/cam/src/physics/cam1/param_cldoptics.F90 + - add addfld and outfld calls for EMIS, CICEWP, REI, REL +M cam1/models/atm/cam/src/physics/cam1/physpkg.F90 + - pass srfflx_state and surface_state types to diag_surf instead of the + individual fields +M cam1/models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 + - remove old outfld call for REL + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev73 +Originator: mirin ( Arthur Andrew Mirin) +Date: Mon Mar 15 09:16:02 MST 2004 +Model: CAM +Version: CAM2.0_2.dev73 +One-line Summary: Mod_comm and related updates. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: new test on blackforest +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +(A) mod_comm has been significantly streamlined to make it easier to +understand the coding; module mod_irreg has been combined into mod_comm; +option to dynamically allocate target window has been added. +More work still needs to be done. Most of the changes in the FV routines +are due to the new linkage. + +(B) the utils/pilgrim subdirectory can now be included for all 3 dycores; +this requires setting the if-def MODCM_DP_TRANSPOSE. Consequently, +the mod_comm option for the dynamics/physics transposes in phys_grid +is now operational with all 3 dycores; + +(C) namelist variable modcomm_method has been fissioned into 2 new +namelist variables - modcomm_transpose and modcomm_geopk; these are +applicable to the FV dycore. + +(D) the namelist variable phys_alltoall is now overloaded when applicable +to mod_comm; its new value is 11 + (mod_comm method), where (mod_comm method) +can have values from 0 to 3; see code documentation in phys_grid. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev72 +Originator: bundy ( Danielle R. B. Coleman) +Date: Fri Mar 12 12:13:22 MST 2004 +Model: CAM +Version: CAM2.0_2.dev72 +One-line Summary: fix FV mass conservation problem +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux (Lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Phil Rasch +Restart files change: no +Changes answers: changes answers in FV only +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +models/atm/cam/src/dynamics/fv/fill_module.F90 + +fix mass conservation for small mixing ratios by scaling tiny fill value +to magnitude of mixing ratio. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev71 +Originator: bundy ( Danielle R. B. Coleman) +Date: Wed Mar 10 16:13:03 MST 2004 +Model: CAM +Version: CAM2.0_2.dev71 +One-line Summary: Add dry mixing ratio formulation, suite of test tracers +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux (Lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Phil Rasch +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + a. A list of any subroutines eliminated; +models/atm/cam/src/physics/cam1/test_tracers.F90 +models/atm/cam/src/physics/cam1/rnozunit.F90 + + b. A list of any subroutines added and what they do; and +models/atm/cam/src/physics/cam1/tracers.F90 +replaces eliminated file test_tracers.F90 +an interface for a generic suite of tracers specified in tracers_suite.F90 + +models/atm/cam/src/physics/cam1/tracers_suite.F90 +replaces eliminated rnozunit.F90 +contains all the specifications for a suite +of tracers, and is interfaced to the model via tracers.F90. + + c. For existing files that have been modified, an itemized list + of the changes and where they can be found + +models/atm/cam/src/physics/cam1/advnce.F90 + add call to tracers_timestep_init +models/atm/cam/src/physics/cam1/check_energy.F90 + add check_tracers mass capability +models/atm/cam/src/physics/cam1/constituents.F90 + add mixtype (wet or dry) field to constituent description + add functions to get type by index or name +models/atm/cam/src/physics/cam1/convtran.F90 +/models/atm/cam/src/physics/cam1/diagnostics.F90 + outfld call for PDELDRY +models/atm/cam/src/physics/cam1/initindx.F90 +models/atm/cam/src/physics/cam1/inti.F90 + change namelist variables that control tracers +models/atm/cam/src/physics/cam1/moistconvection.F90 +models/atm/cam/src/physics/cam1/physics_types.F90 + add capability for wet or dry mixtype tracers +models/atm/cam/src/physics/cam1/physpkg.F90 + calculates pdeldry for dry mixtypes + added gavglook subroutine for checking mass conservation +models/atm/cam/src/physics/cam1/tphysac.F90 + change tracer namelist variables, subroutine calls + check mass of tracers + for LR dyn, convert dry to wet at end +models/atm/cam/src/physics/cam1/tphysbc.F90 + calculate and write out dry surface pressure PSDRY + check mass of tracers +models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + calculate tend wrt dry pressure for dry mixtype tracers + by calling vdiff for again only if there are dry tracersm +models/atm/cam/src/physics/cam1/turbulence.F90:trbintr() + add optional argument to skip outfld calls + ( used on 2nd call to subroutine from 2nd call to vdiff) +models/atm/cam/src/control/filenames.F90 + add boundary file for test tracers: bndtvsf6 +models/atm/cam/src/control/runtime_opts.F90 + change namelist variables for tracers: + [new] bndtvsf6 + [mod] tracers_flag [replaces trace_test{1-3}] +models/atm/cam/src/control/history.F90 + addfld PSDRY +models/atm/cam/src/advection/slt/qmassa.F90 +models/atm/cam/src/advection/slt/xqmass.F90 + add capability for dry mixtype tracers +models/atm/cam/src/dynamics/eul/dp_coupling.F90 +models/atm/cam/src/dynamics/sld/dp_coupling.F90 + only change wet mixtype tracers to dry/wet mr for dyn/phys +models/atm/cam/src/dynamics/fv/dp_coupling.F90 + convert dry mixtype tracers to wet/dry for dyn/phys +models/atm/cam/src/dynamics/fv/stepon.F90 + before 1st call to dynamics, convert dry tracers to wet +models/atm/cam/src/dynamics/eul/inidat.F90 +models/atm/cam/src/dynamics/sld/inidat.F90 +models/atm/cam/src/dynamics/fv/inidat.F90 + name changes test_tracers -> tracers +models/atm/cam/src/dynamics/eul/scanslt.F90 +models/atm/cam/src/dynamics/sld/scanslt.F90 + pass vars (n3,q3) to slt interface +models/atm/cam/src/dynamics/eul/tfilt_massfix.F90 +models/atm/cam/src/dynamics/sld/tfilt_massfix.F90 + modify qneg threshold (corm) for dry mixtypes to conserve mass +/models/atm/cam/src/dynamics/eul/comslt.F90 + add trcavg variable + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev70 +Originator: pworley ( Patrick H Worley) +Date: Tue Mar 9 08:30:43 MST 2004 +Model: CAM +Version: CAM2.0_2.dev70 +One-line Summary: replaced use of mpi_comm_world with mpicom in initialization of swap_comm module +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux/Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +modified control/swap_comm.F90: + replaced mpi_comm_world with mpicom when duplicating communicators (for use in + swap_comm module routines). Without this, CAM does not work with CCSM. + +added test/system/create_ccsmcam: + script provided by Mariana Vertenstein to test CAM with CCSM + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev69 +Originator: mvr ( Mathew Rothstein) +Date: Thu Mar 4 17:35:12 MST 2004 +Model: CAM +Version: CAM2.0_2.dev69 +One-line Summary: Fix for DMS bug; Fix for co2 ramping with rate<0; Added co2vmr to history output +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M models/atm/cam/src/physics/cam1/acbnd.F90 + - move allocate outside of masterproc conditional in acbndint() +M models/atm/cam/src/physics/cam1/dmsbnd.F90 + - fix bug reading new time sample in dmsbndint() + - move allocate outside of masterproc conditional in dmsbndint() +M models/atm/cam/src/physics/cam1/soxbnd.F90 + - move allocate outside of masterproc conditional in soxbndint() +M models/atm/cam/src/physics/cam1/ghg_surfvals.F90 + - fixed the handling of co2 ramping when the rate is less than zero +M models/atm/cam/src/control/history.F90 + - added co2vmr (co2 volume mixing ratio) to the history output files + + +=============================================================== +=============================================================== + +cam2_0_2_dev68 +Originator: pworley ( Patrick H Worley) +Date: Wed Mar 3 12:55:10 MST 2004 +Model: CAM +Version: CAM2.0_2.dev68 +One-line Summary: communication optimizations and removal of PVP ifdefs +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: not with default settings +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux cluster +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself (earlier version reviewed by Tom Henderson) +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + +1) Removed PVP ifdefs (to make merge with vector branches cleaner). Files affected: + control/cam.F90, rgrid.F90 + + dynamics/eul/comspe.F90, dyn.F90, dyndrv.F90, grcalc.F90, hordif.F90, + inital.F90, initcom.F90, quad.F90, settau.F90, spetru.F90, + trunc.F90, tstep.F90 + + dynamics/fv/initcom.F90 + + dynamics/sld/dyn.F90, dyndrv.F90, dynpkg.F90, grcalc.F90, hordif.F90, + initcom.F90, quad.F90, spetru.F90, trunc.F90, tstep.F90, + tstep1.F90, vertnm.F90 + +2) Reimplemented communication algorithms in spectral dycore realloc routines + and in the physics load balancing, using either MPI collectives or + point-to-point implementations that use the swap_comm module. swap_comm + was imported from PSTSWM and PCCM, and supports 28 different options. The default + is to use collectives. When not using collectives, the default is to use the + original point-to-point algorithm (using mpi_sendrecv). Runtime options + dyn_alltoall, dyn_allgather, phys_alltoall, swap_comm_order, and swap_comm_protocol + were added to runtime_options to specify these. For example, + dyn_alltoall == 0 means to use MPI_Alltoallv in realloc4a and realloc4b. + dyn_alltoall == 1 means to use one of the point-to-point algorithms. + + Physics load balancing was also changed to use the same communication buffer + as that used by the realloc routines. Finally, the physics load balancing + options were tweaked, primarily to remove a high complexity initialization algorithm + that was dominating runtime for short runs at high resolution. Files affected: + + control/runtime_opts.F90, spmd_utils.F90, spmdinit.F90, swap_comm.F90, mpi_wrap.F90 + + dynamics/eul/dp_coupling.F90, realloc4.F90, realloc7.F90, scan2.F90, spmd_dyn.F90 + + dynamics/fv/spmd_dyn.F90 + + dynamics/sld/dp_coupling.F90, realloc4.F90, realloc7.F90, scan2.F90, spmd_dyn.F90 + + physics/cam1/phys_grid.F90 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev67 +Originator: mvr ( Mathew Rothstein) +Date: Fri Feb 27 08:53:27 MST 2004 +Model: CAM +Version: CAM2.0_2.dev67 +One-line Summary: Implemented co2 ramping; Enabled lf95/debug checking with sulfates on; fix for 200MB radiation diagnostics +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI(pending), Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M models/atm/cam/src/control/runtime_opts.F90 + - added new option to namelist var scenario_ghg: RAMP_CO2_ONLY + - added new namelist variables: ramp_co2_annual_rate, ramp_co2_cap, + ramp_co2_start_ymd +M models/atm/cam/src/control/time_manager.F90 + - added new routine to calculate #of days between dates: timemgr_datediff +M models/atm/cam/src/physics/cam1/acbnd.F90 + - mods to enable lf95/debug checking with sulfates on +M models/atm/cam/src/physics/cam1/dmsbnd.F90 + - mods to enable lf95/debug checking with sulfates on +M models/atm/cam/src/physics/cam1/soxbnd.F90 + - mods to enable lf95/debug checking with sulfates on +M models/atm/cam/src/physics/cam1/ghg_surfvals.F90 + - formally implemented ability to ramp co2 +M models/atm/cam/src/physics/cam1/radcswmx.F90 + - added fix for 200MB radiation diagnostics + - uses new function to retrieve co2 mass mixing ratio +M models/atm/cam/src/physics/cam1/trcpth.F90 + - uses new function to retrieve co2 mass mixing ratio + + +=============================================================== +=============================================================== + +cam2_0_2_dev66 +Originator: eaton ( Brian Eaton) +Date: Mon Feb 23 16:40:39 MST 2004 +Model: CAM +Version: CAM2.0_2.dev66 +One-line Summary: misc performance improvements +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes (performance improvement validated by G. Carr) +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Carr, Edwards +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +>> models/atm/cam/src/dynamics/eul/herxin.F90 +>> . "rolled" a loop for better cache performance (Edwards) +>> +>> models/atm/cam/src/dynamics/eul/limdy.F90 +>> models/atm/cam/src/dynamics/eul/limdz.F90 +>> . inlined scm0 by hand into limdy and limdz (Carr) +>> +>> models/atm/cam/src/dynamics/eul/sltini.F90 +>> . remove SPMD ifdefs and thread a loop that was previously unthreaded +>> when SPMD was defined. (Eaton) + +=============================================================== +=============================================================== + +cam2_0_2_dev65 +Originator: hender ( Tom Henderson) +Date: Thu Feb 12 16:18:09 MST 2004 +Model: CAM +Version: CAM2.0_2.dev65 +One-line Summary: IPCC performance upgrade in prognostic sulfate interpolation +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Intel-Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Jim McCaa, Brian Eaton, Jim Rosinski, Mathew Rothstein +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Restored signalling Nan except for pgf90 +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +>> Performance fix to scale computations in linintp. Speedup = ~12% for +>> stand-alone CAM at T85 with IPCC scenario configurations for prognostic +>> sulfates and greenhouse gasses: +>> models/atm/cam/bld/run-ibm.csh +>> models/atm/cam/src/physics/cam1/acbnd.F90 +>> models/atm/cam/src/physics/cam1/dmsbnd.F90 +>> models/atm/cam/src/physics/cam1/soxbnd.F90 +>> models/atm/cam/src/physics/cam1/sulchem.F90 +>> models/atm/cam/src/physics/cam1/sulemis.F90 +>> models/atm/cam/src/physics/cam1/sulfur_intr.F90 +>> models/atm/cam/src/control/error_messages.F90 +>> Jim Rosinski's new timers: +>> models/atm/cam/src/physics/cam1/comsrf.F90 +>> models/atm/cam/src/physics/cam1/convtran.F90 +>> models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +>> models/atm/cam/src/physics/cam1/tphysbc.F90 +>> models/atm/cam/src/control/intp_util.F90 +>> Brian Eaton's change to remove broadcasts from chemistry.F90 that were +>> happening every time step: +>> models/atm/cam/bld/DefaultCAMEXPNamelist.xml +>> models/atm/cam/bld/DefaultCLMEXPNamelist.xml +>> models/atm/cam/src/physics/cam1/chemistry.F90 +>> Mathew Rothstein's change to use quiet NaN for pgf90 and signalling NaN for +>> all other compilers. +>> models/lnd/clm2/src/main/nanMod.F90 +>> models/atmlnd_share/infnan.F90 +>> Jim McCaa's addition of 200mb fields. +>> models/atm/cam/src/physics/cam1/radclwmx.F90 +>> models/atm/cam/src/physics/cam1/radcswmx.F90 +>> models/atm/cam/src/physics/cam1/radctl.F90 +>> models/atm/cam/src/control/history.F90 +>> By default, this change produces no new output fields; however, it allows +>> one to fincl the following: +>> FSN200: Clearsky shortwave flux at 200 mb +>> FSN200C: Shortwave flux at 200 mb +>> FLN200: Clearsky longwave flux at 200 mb +>> FLN200C: Longwave flux at 200 mb + +=============================================================== +=============================================================== + +cam2_0_2_dev64 +Originator: mvr ( Mathew Rothstein) +Date: Mon Feb 2 11:13:05 MST 2004 +Model: CAM +Version: CAM2.0_2.dev64 +One-line Summary: patch to enable runs using portland group compiler; removal of mprun2d.pm +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: yes + - modified definition of parameter nan to enable runs using portland group compiler +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +M cam1/models/lnd/clm2/src/main/nanMod.F90 + - modified definition of parameter nan to enable run using portland + group comiler +R cam1/models/atm/cam/bld/mprun2d.pm + + +=============================================================== +=============================================================== + +cam2_0_2_dev63 +Originator: rosinski ( Jim Rosinski) +Date: Tue Jan 27 10:15:42 MST 2004 +Model: CAM +Version: CAM2.0_2.dev63 +One-line Summary: Eliminate dead code, more flexible endrun, more "intent" attributes, + better lf95 strict error checking compliancy +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Mariana checked this. +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Vertenstein +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o endrun is now in a module and takes an optional character string argument. + If present, this string is printed before the model aborts. +o Eliminated dead code, including the old "dataicemodel". Mods were made to + ncar_batch.csh to eliminate the dataicemodel tests. This was done by passing + -skip all:1-17 to test-model. +o Also eliminated dead logic related to sulfur variables. +o Better strict error checking compliancy under lf95. But "lf95 -x" cannot be + used because lf95 warns that all underlying libraries must also be compiled + with this option in order for it to work properly. +o Added "intent" clause to arguments where the proper value was clear. The code + was already in pretty good shape w.r.t. all arguments having their intent + declared. There are still a few places where intent needs to be added though. +=============================================================== +=============================================================== + +cam2_0_2_dev62 +Originator: hender ( Tom Henderson) +Date: Fri Jan 23 10:49:42 MST 2004 +Model: CAM +Version: CAM2.0_2.dev62 +One-line Summary: IPCC scenario changes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes, new namelist variables, new data files +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC-Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Conley, Bundy, Rosinski +Restart files change: no +Changes answers: no (bit-for-bit) for runs that do not use prognostic sulfates, +Yes otherwise +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + + 1. Complete documentation of the changes, including: + a. A list of any subroutines eliminated; +>> cam1/models/atm/cam/src/physics/cam1/Population.F90 +>> cam1/models/atm/cam/src/physics/cam1/aerosols.F90 +>> cam1/models/atm/cam/src/physics/cam1/ramp_ghg_bau.h +>> cam1/models/atm/cam/src/physics/cam1/ramp_ghg_stab.h +>> cam1/models/atm/cam/src/physics/cam1/ramp_scon.h + + b. A list of any subroutines added and what they do; and +>> cam1/models/atm/cam/src/physics/cam1/carbonscales.F90 +>> Formerly Population.F90 +>> cam1/models/atm/cam/src/physics/cam1/prescribed_aerosols.F90 +>> Formerly aerosols.F90 +>> cam1/models/atm/cam/src/utils/timeinterp.F90 +>> Combined repeated code bits into a new subroutine. + + c. For existing files that have been modified, an itemized list + of the changes and where they can be found + (NOTE: A cvs command that generates all of the above information can be + provided in place of individual answers. For example, "cvs -nq + update ..." or "cvs rdiff ...".) +>> cam1/models/atm/cam/bld/DefaultCAMEXPNamelist.xml +>> cam1/models/atm/cam/bld/camexp.pm +>> cam1/models/atm/cam/bld/run-model.pl +>> cam1/models/atm/cam/src/physics/cam1/advnce.F90 +>> cam1/models/atm/cam/src/physics/cam1/aerosol_intr.F90 +>> cam1/models/atm/cam/src/physics/cam1/chemistry.F90 +>> cam1/models/atm/cam/src/physics/cam1/dmsbnd.F90 +>> cam1/models/atm/cam/src/physics/cam1/ghg_surfvals.F90 +>> cam1/models/atm/cam/src/physics/cam1/inti.F90 +>> cam1/models/atm/cam/src/physics/cam1/radae.F90 +>> cam1/models/atm/cam/src/physics/cam1/radcswmx.F90 +>> cam1/models/atm/cam/src/physics/cam1/radctl.F90 +>> cam1/models/atm/cam/src/physics/cam1/ramp.h +>> cam1/models/atm/cam/src/physics/cam1/ramp_scon.F90 +>> cam1/models/atm/cam/src/physics/cam1/ramp_so4_mod.F90 +>> cam1/models/atm/cam/src/physics/cam1/soxbnd.F90 +>> cam1/models/atm/cam/src/physics/cam1/sulfur_intr.F90 +>> cam1/models/atm/cam/src/physics/cam1/volcanicmass.F90 +>> cam1/models/atm/cam/src/physics/cam1/volcrad.F90 +>> cam1/models/atm/cam/src/control/filenames.F90 +>> cam1/models/atm/cam/src/control/oznint.F90 +>> cam1/models/atm/cam/src/control/runtime_opts.F90 +>> cam1/models/atm/cam/src/control/so4bnd.F90 +>> cam1/models/atm/cam/src/ocnsice/dom/sst_data.F90 +>> cam1/models/atm/cam/src/ocnsice/som/somint.F90 +>> cam1/models/lnd/clm2/src/main/lp_coupling.F90 +>> +>> See below for details of changes. + + 2. Complete documentation of these changes in the code by comments. +>> DONE + + 3. On what machines did you successfully run test-model.pl? + a. blackforest +>> YES + b. chinook +>> YES + c. anchorage-lf95 +>> YES + + 4. For all of the runs in #3 above, which version of cam did you + compare to (which tag)? +>> cam2_0_2_dev61, using hand-tests since test-model does not support +>> "-compare" when namelist has changed. + + 5. If bitwise differences were observed, how did you prove they were no + worse than roundoff? +>> bit-for-bit + + 6. Does the CAM Users Guide need to be updated due to these changes? + (Possible reasons include changes to the namelist, history output, + configure script, build or run process, etc.) +>> Yes + If so, has the CAM Users Guide been updated in the CVS repository? +>> No + + +>> +>> Source: http://www.cgd.ucar.edu/cseg/plans/ipcc_plan2.txt 01/23/04 +>> +>> IPCC Features in CAM +>> +>> Requirements +>> . thoroughly tested +>> . releaseable, reproducible, community usable +>> . usable for 1990, 1870, historicals, future, paleo +>> (without changing source code, only namelist?) +>> . no hacks, no magic dates in code +>> . datasets available to support T85 resolution (T42?, T31?) +>> . implementation must be general, namelist and dataset must be +>> robust for the specified use cases below. that means making +>> sure that 1870-2000 datasets can be used robustly in the model +>> on Jan 1, 1870 and Jan 1, 2000, and that future datasets can +>> be used in the model robustly on Jan 1, 1990. +>> +>> ------------------------------- +>> +>> Present 1870 control run mods relative to 1990 controls +>> Add CAM namelists f11vmr, f12vmr, co2vmr, ch4vmr, n2ovmr +>> Add CAM namelist carscl=0.3 +>> Add CAM namelist sulscl=0.0 +>> +>> ------------------------------- +>> +>> Dust, Sea Salt +>> . seasonal cycle of monthly averages, data(x,y,z,12) +>> . dataset is resolution dependent, requires T42 and T85 datasets +>> . same datasets will be used for all runs +>> . can be scaled, scaling will always be 1 +>> . this has always been on +>> . file name AerosolMass* +>> . file also includes carbon which is also always on +>> Tasks +>> + Review dataset, verify supports all resolutions; T85, T42, T31, 2x2.5 +>> (Andrew, Bill, Jim R) +>> - Verify correct datasets in CAM scripts (Andrew, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana) +>> Namelist +>> bndtvaer +>> +>> Carbon +>> . carbon dataset is in same file as Dust, Sea Salt, same format (x,y,z,12) +>> . in file AerosolMass +>> . always on, carscl can scale, default 1.0 +>> . carscl=0.3 for 1870 run, continuous with pop dataset +>> . historical will be based on population dataset (t) +>> . time interpolation is flexible, can have varying dt in dataset +>> . dataset "easy to generate" +>> . endruns if date outside dataset +>> . dataset will cover 1870 to 2000 +>> . 2000 to 2300 constant carscl at 2000 (1.0) +>> . 1870 and future will use carscl, historical will use dataset +>> . "ramp year" namelist implementation is defered +>> Tasks +>> + Rename carbon_by_pop to scenario_carbon_scale, char string input +>> (Andrew) +>> + Rename bndtvpop to bndtvcarbonscale (Andrew) +>> + Generate a 1870-2000 dataset (Andrew) +>> + Verify carbon will call endrun if date is outside dataset boundaries +>> (Andrew) +>> - Verify correct datasets and namelist in CAM scripts (Andrew, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana) +>> Namelist +>> bndtvaer +>> carscl +>> scenario_carbon_scale (RAMPED, FIXED), ramped will turn on use of +>> dataset, fixed +>> means use carscl. +>> bndtvcarbonscale +>> +>> Solar +>> . normally a constant, namelist (scon) can override default +>> . can turn on ramping via scenario_scon +>> . ramping data is implemented as data statement and include file +>> . 1870-2000 dataset +>> . all runs with using ramping feature, 1870 will use rampyear_scon +>> set to 1870, future runs will use rampyear_scon set to "2005" +>> Tasks +>> - Create solar dataset, end solar cycle in middle of 11 year cycle +>> around 2005, verify dataset, (Lawrence, Caspar) +>> + Remove include file and data statement, add read of netcdf dataset (Tom) +>> - Move datasets to inputdata and verify naming convention (Lawrence, Tom) +>> + Verify solar calls endrun if using ramped feature and date is outside +>> dataset range (Tom) +>> + Implement in source code ability to use new namelist convention +>> (bndtvscon) (Tom) +>> - Verify correct datasets and namelist in CAM scripts (Lawrence, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana, Lawrence) +>> - Verify functionality of scenario and rampYear via code review +>> or validation runs (Tom, Lawrence) +>> Namelist +>> scon (won't be used) +>> scenario_scon (RAMPED) +>> bndtvscon +>> rampYear_scon +>> +>> GHGs +>> . 5 tracers, f11, f12, co2, ch4, n2o +>> . normally a constant, namelist can override the constants +>> . can turn on ramping +>> . ramping data is implemented as data statement and include file, +>> . turns on some ghg chemistry, IPCC will use that feature, automatically +>> turned on when ramped feature is used +>> . future scenarios will be time varying +>> . Use scenario_ghg = RAMPED always +>> . set rampYear_ghg to 1870 for 1870 control +>> . there will be multiple datasets, 1870-2000 for historical, several +>> 1990 to future datasets. +>> . requires pcnst=pcnst+4 +>> Tasks +>> + Talk to Byron or Jeff about ghg chemistry (Bill) +>> + Generate 1870-2000 netcdf ghg dataset (Lawrence) +>> - Generate 1990-future netcdf ghg datasets (Lawrence, Gary) +>> + Remove include file and data statement, add a dataset (Tom) +>> + Verify ghg code calls endrun if year outside dataset for ramped +>> usage (Tom) +>> + Implement in source code ability to use new namelist convention +>> (bndtvghg) (Tom) +>> - Move datasets to inputdata and verify naming convention (Lawrence, Tom) +>> - Verify correct datasets and namelist in CAM scripts (Lawrence, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana, Lawrence) +>> Namelist +>> f11vmr (won't be used) +>> f12vmr (won't be used) +>> co2vmr (won't be used) +>> ch4vmr (won't be used) +>> n2ovmr (won't be used) +>> scenario_ghg (RAMPED) +>> rampYear_ghg +>> bndtvghg +>> trace_gas +>> read_trace +>> +>> Volcanics +>> . one field, mvolc(x,y,z,t), 1 sample per month +>> . flexible time interpolation, won't handle years outside dataset bounds +>> . turned off by default +>> . should be on for historicals only, datafile for 1870-2000 +>> . will do spatial interpolation +>> Tasks +>> + Generate 1870-2000 dataset and review for historical runs, make +>> sure volcanics go to 0.0 at edges of dataset, make sure model +>> calls endrun if strat_volc=true and date is outside bounds of +>> dataset (Andrew, Caspar) +>> + Move datasets to inputdata and verify naming convention (Andrew) +>> - Verify correct datasets and namelist in CAM scripts (Andrew, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana) +>> Namelist +>> strat_volc = .true. +>> bndtvvolc = 'dataset' +>> +>> Sulfate +>> . three different tracers in three datasets, dms, oxidants, sox +>> . dms is f(x,y,t), seasonal cycle with 12 time samples +>> . oxidants is f(x,y,z,t) seasonal cycle with 12 time samples +>> . dms and oxidants are seasonally repeating, not a function of "year" +>> . sox(x,y,2,t) is 4 samples/year, varying over different years +>> . sox time interpolation works fine, no extrapolation currently +>> . dataset must be generated on CAM grid +>> . REQUIRES pcnst = pcnst+4 (not 3) +>> . historical and future will use ramped feature with time varying data +>> . 1870 run will use ramped feature with rampyear_prognostic_sulfur set to +>> 1870 +>> . some sort of huge(int) intrinsic value needs to be default for rampyear +>> Tasks +>> + Design new namelist, prescribed_sulfur and prognostic_sulfur +>> and usage/features (Bill, Andrew, Phil) +>> + Remove dead namelist, aero_sulfur, aero_feedback_sulfur, implement new +>> namelist and features (see below) (Andrew and Dani) +>> + Remove (3) old dataset namelist (dms_emis, oxid, sox_emis) and add +>> (3) new dataset namelists (see below) (Dani) +>> + Verify endrun is called if date outside sox datasets (Dani) +>> + Generate 1870-2000 sox dataset for T85 (Dani, Gary) +>> + Generate future datasets for sulfur (Dani, Lawrence, Gary) +>> + Move all datasets to inputdata and verify naming convention +>> (Andrew, Dani) +>> - Verify correct datasets and namelist in CAM scripts (Andrew, Dani, Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana) +>> Namelist +>> bndtvdms +>> bndtvoxid +>> bndtvsox +>> scenario_prescribed_sulfur (FIXED (DEFAULT), RAMPED) +>> rampyear_prescribed_sulfur +>> prescribed_sulfur (off, passive, direct (DEFAULT)) +>> scenario_prognostic_sulfur (FIXED (DEFAULT), RAMPED) +>> rampyear_prognostic_sulfur +>> prognostic_sulfur (off (DEFAULT), passive, direct) +>> +>> Ozone +>> . ozone function of (x,y,z,t) with seasonal cycle +>> . use T42 dataset with monthly data, 1870-2000, (850Mb) +>> . ozone dataset not CAM grid dependent, does space interpolation +>> . for 1870, use 1870 only dataset with cycling set to true +>> . for historical, use 1870-2000 with cycling set to false +>> . for future, use 2000 dataset with cycling set to true +>> . tropopause consistency issue +>> . defer namelist changes +>> Tasks +>> - Generate 1870-2000 monthly dataset on T42, spoof to 1870 (Lawrence) +>> - Generate 1870 and 2000 cycling datasets (Lawrence) +>> - Create, review, and validate datasets, dataset continuity between +>> 1870 cycling dataset, 1870-2000 dataset, 2000 cycling dataset (Lawrence) +>> - Move datasets to inputdata and verify naming convention (Lawrence, Tom) +>> - Verify correct datasets and namelist in CAM scripts (Tom) +>> + Implement changes to CCSM scripts as needed (Tony, Mariana) +>> Namelist +>> bndtvo +>> ozncyc +>> +>> ------------------------------- +>> +>> Tony will monitor overall task progress +>> Tom will collect code mods and CAM script mods and coordinate checkin +>> Tony will coordinate changes in CCSM scripts +>> +>> ------------------------------- +>> +>> Use Cases: +>> +>> 1990 control - runs out of the box without above turned on, +>> this is not the same as historical run at 1990 or 1990 control +>> done similar to 1870. use pcnst = 3 +>> +>> (no source code mods required to switch between 1870, 1990, +>> historical, future cases below, pcnst = 11 for all cases) +>> +>> 1870 control, pcnst = 11 in build, standard namelist plus, +>> X means not needed or current default inside model (included +>> for clarity) +>> +>> bndtvaer = AerosolMass_V_128x256_clim_c031022.nc +>> X scenario_carbon_scale = 'FIXED' +>> carscl = 0.3 +>> X bndtvcarbonscale = carbonscaling_1870-1999_c040114.nc +>> scenario_scon = 'RAMPED' +>> rampYear_scon = 1870 +>> bndtvscon = *.nc (1870-2005 dataset TBD) +>> scenario_ghg = 'RAMPED' +>> rampYear_ghg = 1870 +>> bndtvghg = ghg_1870_2100_c040122.nc +>> trace_gas = .true. +>> read_trace = .false. +>> X strat_volcanic = .false. +>> X bndtvvolc = VolcanicMass_1870-1999_64x1_L18_c040115.nc +>> bndtvdms = DMS_emissions_128x256_clim_c040122.nc +>> bndtvoxid = oxid_128x256_L26_clim_c040112.nc +>> bndtvsox = SOx_emissions_128x256_L2_c040109.nc +>> scenario_prescribed_sulfur = 'FIXED' +>> prescribed_sulfur = 'passive' +>> scenario_prognostic_sulfur = 'RAMPED' +>> rampYear_prognostic_sulfur = 1870 +>> prognostic_sulfur = 'direct' +>> X ozncyc = .true. +>> bndtvo = *.nc (1870 dataset) +>> +>> historical (1870-2000), hybrid startup at year 1870, run to 2000 +>> pcnst = 11 in build, set namelist as follows, X means not needed or +>> current default, * indicate changes from 1870 control +>> +>> bndtvaer = AerosolMass_V_128x256_clim_c031022.nc +>> * scenario_carbon_scale = 'RAMPED' +>> *X carscl (remove) +>> bndtvcarbonscale = carbonscaling_1870-1999_c040114.nc +>> scenario_scon = 'RAMPED' +>> *X rampYear_scon (remove) +>> bndtvscon = *.nc (1870-2005 dataset TBD) +>> scenario_ghg = 'RAMPED' +>> *X rampYear_ghg (remove) +>> bndtvghg = ghg_1870_2100_c040122.nc +>> trace_gas = .true. +>> * strat_volcanic = .true. +>> bndtvvolc = VolcanicMass_1870-1999_64x1_L18_c040115.nc +>> bndtvdms = DMS_emissions_128x256_clim_c040122.nc +>> bndtvoxid = oxid_128x256_L26_clim_c040112.nc +>> bndtvsox = SOx_emissions_128x256_L2_c040109.nc +>> scenario_prescribed_sulfur = 'FIXED' +>> prescribed_sulfur = 'passive' +>> scenario_prognostic_sulfur = 'RAMPED' +>> * rampYear_prognostic_sulfur = (remove) +>> prognostic_sulfur = 'direct' +>> * ozncyc = .false. +>> * bndtvo = *.nc (1870-2000 dataset TBD) +>> +>> future (1990-), hybrid startup at year 1990 from historical 1990, +>> pcnst = 11 in build, set namelist as follows, X means not needed or +>> current default, * indicate change from historical run +>> +>> bndtvaer = AerosolMass_V_128x256_clim_c031022.nc +>> *X scenario_carbon_scale = 'FIXED' +>> *X carscl = 1.0 +>> X bndtvcarbonscale = carbonscaling_1870-1999_c040114.nc +>> scenario_scon = 'RAMPED' +>> * rampYear_scon = 2005 +>> bndtvscon = *.nc (1870-2006 dataset TBD) +>> scenario_ghg = 'RAMPED' +>> X rampYear_ghg (remove) +>> * bndtvghg = *.nc (future dataset TBD) +>> trace_gas = .true. +>> *X strat_volcanic = .false. +>> X bndtvvolc = VolcanicMass_1870-1999_64x1_L18_c040115.nc +>> bndtvdms = DMS_emissions_128x256_clim_c040122.nc +>> bndtvoxid = oxid_128x256_L26_clim_c040112.nc +>> bndtvsox = SOX_T85_future +>> scenario_prescribed_sulfur = 'FIXED' +>> prescribed_sulfur = 'passive' +>> scenario_prognostic_sulfur = 'RAMPED' +>> prognostic_sulfur = 'direct' +>> *X ozncyc = .true. +>> * bndtvo = *.nc (2000 dataset TBD) +>> +>> --------------------------------- +>> +>> Available (and validated) Datasets: +>> +>> bndtvaer: (rad dir) +>> AerosolMass_V_128x256_clim_c031022.nc T85 +>> AerosolMass_V_64x128_clim_c031022.nc T42 +>> AerosolMass_V_48x96_clim_c031022.nc T31 +>> AerosolMass_V_2x2.5_clim_c031022.nc 2x2.5 +>> +>> bndtvdms: (scyc dir) +>> DMS_emissions_64x128_c030722.nc T42 +>> DMS_emissions_128x256_clim_c040122.nc T85 +>> +>> bndtvoxid: (scyc dir) +>> oxid_3d_64x128_L26_c030722.nc T42 +>> oxid_128x256_L26_clim_c040112.nc T85 +>> +>> bndtvsox: (scyc dir) +>> SOx_emissions_64x128_L2_c031219.nc T42 (1870+historical) +>> - T42 (A1) +>> - T42 (A2) +>> - T42 (B1) +>> - T42 (B2) +>> SOx_emissions_128x256_L2_c040109.nc T85 (1870+historical) +>> SOx_emissions_A1_128x256_L26_1990-2100_c030121.nc T85 (A1) +>> SOx_emissions_A2_128x256_L26_1990-2100_c030121.nc T85 (A2) +>> SOx_emissions_B1_128x256_L26_1990-2100_c030121.nc T85 (B1) +>> SOx_emissions_B2_128x256_L26_1990-2100_c030121.nc T85 (B2) +>> +>> bndtvo: (ozone dir) +>> pcmdio3.r8.64x1_L60_clim_c970515.nc (present day cycling +>> dataset) +>> - (1870 cycling) +>> - (1870-2000) +>> - (2000 cycling) +>> +>> bndtvvolc: (rad dir) +>> VolcanicMass_1870-1999_64x1_L18_c040115.nc (1870-2000 dataset) +>> +>> bndtvcarbonscale: (rad dir) +>> carbonscaling_1870-1999_c040114.nc (1870-2000 dataset) +>> +>> bndtvscon: (rad dir) +>> scon_1870_2100_c040122.nc (CAM default, do not +>> use) +>> - (1870-2006 dataset) +>> +>> bndtvghg: (ggas dir) +>> ghg_1870_2100_c040122.nc (CAM default, +>> 1870+historical) +>> - (A1) +>> - (A2) +>> - (B1) +>> - (B2) + +=============================================================== +=============================================================== + +cam2_0_2_dev61 +Originator: mirin ( Arthur Andrew Mirin) +Date: Wed Jan 14 11:51:56 MST 2004 +Model: CAM +Version: CAM2.0_2.dev61 +One-line Summary: Finite Volume and Transpose Improvements (2 of 2) +This is the second of two successive archive updates. The only changed +routine is dynamics/fv/geopk.F90. Due to reordering of computations, +there are roundoff differences. + +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer +Restart files change: no +Changes answers: Yes (same to roundoff for FV), EUL and SLD are bit-for-bit. +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +Reordering of computations in FV geopk.F90 causes roundoff changes. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev60 +Originator: mirin ( Arthur Andrew Mirin) +Date: Wed Jan 14 11:39:22 MST 2004 +Model: CAM +Version: CAM2.0_2.dev60 +One-line Summary: Finite Volume and transpose improvements (1 of 2) +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes +Mprun2d namelist no longer exists; relevant variables in CAMEXP namelist. +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer, Eaton +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +This is the first of two successive archive updates. These changes are +bit-fot-bit. + +Summary of changes: + +Removal of mprun2d namelist. This involved creating routines +spmd_dyn_defaultopts and spmd_dyn_setopts with optional arguments. I +mimicked the procedure in phys_grid.F90. In runtime_opts.F90 I put +"dycore_is" test around the calls, and I created dummy versions in +dynamics/eul and dynamics/sld. The initial dummy versions were just +subroutine and end statements, with no arguments. However, the code would +not compile; there were complaints about inaccessible routines and +needing explicit interfaces with optional arguments. I ended up putting +'public' declarations in the EUL and SLD versions and using the same +argument list as with the FV version. (I think the key problem was the +argument list more than the public declaration.) I know it is our +intention to have different versions (with different arguments) of these +routines for the different dycores, but that clearly didn't work; the +present solution is out of expediency. I suspect that the fact that the +arguments are optional is central to the problem. I used optional +arguments only because that is what was done in phys_grid.F90. Also, one +of the namelist variables (modcomm_method) will eventually apply outside +of FV once we use mod_comm transposes outside of FV, so it will +eventually have to be moved or replicated. + +Single coding path for 1-D and 2-D decompositions for FV dycore. TWOD_YZ +ifdef eliminated. The "xy" variables are always invoked (e.g., ptxy). The +twod_decomp variable now refers to whether or not transposes (versus +copies) are called to go between yz and xy decompositions; naturally +copies are relevant only for 1-D decomposition; for debugging purposes, +one can force transposes even with 1-D decomposition (see new namelist +variable force_2d). Also, there is a new FV runtime diagnostic (not +input) variable (called spmd_on) that indicates SPMD versus non-SPMD. + +Method for FV transposes now runtime rather than compile time (although +the choice between ordinary MPI and MPI-2 is still compile-time). For +ordinary MPI, the choice is between invoking temporary contiguous buffers +versus using MPI derived types. The relevant namelist variable is +modcomm_method (0 for contiguous buffers, 1 for derived types (default)). +MPI-2 presently has 4 options (0,1(default),2,3) (options 0,1,2 use +contiguous buffer at target; 0 is for contiguous source buffers; 1 is for +direct MPI_put's of contiguous segments, with threading over the +segments; 2 is for MPI derived types at the source with threading over +target; option 3 is for MPI derived types at source and target, with +threading over target; option 3 involves re-definition of windows and is +probably not optimal). For MPI-2, one specifies "USE_MPI2" precompile +flag when configuring. + +New configure option "-precomp ", where string is a non-empty +list of precompile flags to be placed in misc.h. For example, one can +specify "-precomp USE_MPI2" for MPI-2 mod_comm transposes. + +Option to use nested OpenMP constructs for FV dycore on IBM. This must be +specified at compile time using new configure option "-nested_omp"; this +has effect on misc.h and the Makefile. In sw_core.F90 and tp_core.F90 +(which are already threaded with respect to z), latitude loops are +threaded. The number of inner threads is the new namelist variable +"ompnest", which must divide evenly into the total number of threads; the +number of outer threads will be the total number of threads divided by +"ompnest". IBM's implementation is non-standard. + +Option to use mod_comm for dynamics/physics transposes when using +load-balanced chunking. In phys_grid.F90, the "alltoall" flag is replaced +by new namelist variable "phys_transpose" (1 for original alltoall +(default), 2 for Pat Worley's send_and_receive, 3 for mod_comm). Because +mod_comm is presently compiled and linked only for FV, the mod_comm +option is presently valid only for FV; it must be activated at compile +time with the MODCM_DP_TRANSPOSE if-def (use precomp option in +configure). + +Miscellaneous transpose improvements and code cleaning. + +Deletion of configure_fv.pl and script.m4. + +I also created the necessary surface data and aerosol files to support +the FV 0.5x0.625 resolution. The CAM and CLM default namelists were +updated accordingly. This required updating +tools/interpaerosols/REGRID.pl as well. + +***************************************************************** +With the removal of the TWOD_YZ if-def and mprun2d namelist, the +interactive configuration procedure no longer queries for the 2-D +decompositions, and test-model contains no references to 2-D +decompositions. The validity of 2-D decompositions is checked in +spmd_dyn.F90. To impart 2-D decompositions in test-model, one needs to +set the camexp namelist accordingly. A decision needs to be made on which +decompositions are to be used, and the necessary changes must be made in +the namelist specification. +***************************************************************** + +Changed files: + +utils/pilgrim: mod_comm.F90, mod_irreg.F90, parutilitiesmodule.F90 + +bld: CAM_config.pm, CAM_namelist.pm, CAM_run.pm, configure, Makefile, +DefaultCAMEXPNamelist.xml, DefaultCLMEXPNamelist.xml, +config_cache_defaults.xml, mprun2d.pm (deleted), configure_fv.pl +(deleted), script.m4 (deleted) + +test/system: CAM_test.pm, test-model.pl + +tools/interpaerosols: REGRID.pl + +src/physics/cam1: phys_grid.F90 + +src/control: cam.F90, history.F90, runtime_opts.F90 + +src/dynamics/fv: cd_core.F90, d2a3dijk.F90, d2a3dikj.F90, +dp_coupling.F90, dyn_grid.F90, dynamics_vars.F90, dynpkg.F90, geopk.F90, +pmgrid.F90, spmd_dyn.F90, stepon.F90, sw_core.F90, te_map.F90, +tp_core.F90, trac2d.F90, uv3s_update.F90 + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== +cam2_0_2_dev59 +Originator: mvertens ( Mariana Vertenstein) +Date: Thu Jan 8 13:52:37 MST 2004 +Model: CAM +Version: CAM2.0_2.dev59 +One-line Summary: updated clm code to clm3_deva_01 (vector version of clm) + Requires change in build system: no (see below) + ecosysdyn/ is no longer needed in clm Filepath (will not + trigger error if it is there) +Substantial timing or memory changes: Yes (describe) + 3-5% performance improvement should be obtained +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Forrest Hoffman, Dave Parks, Keith Oleson +Restart files change: yes (for clm) + Backwards compatilibity with older restart files have been incorporated +Changes answers: Yes (same-climate) +Changes to CLM land-model: Yes (see below) +Have you filled out the pre-check-in documentation as required by the CAM CRB? no, I plan to. +Changes made: +1) Updated the clm code to clm3_dev_01 (the vector version of clm). + Both offline and cam-clm stand-alone runs showed that the new code + resulted in the same climate. For the cam-clm validation diagnostic + results see: + http://www.cgd.ucar.edu/tss/clm/diagnostics/cam_clm2/cam202d39clm2d47a-cam202d39clm2d36a/sets.htm +2) Modified models/atm/cam/bld/configure to removed ecosysdyn/ from + the clm filepath. +=============================================================== +=============================================================== + +cam2_0_2_dev58 +Originator: aconley ( Andrew J. Conley) +Date: Wed Jan 7 13:53:42 MST 2004 +Model: CAM +Version: CAM2.0_2.dev58 +One-line Summary: added volcanic aerosols and population based carbonaceous aerosol scaling +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes (same-to-roundoff, same-physics) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? no, I plan to. +Changes made: +New documentation: +UG-20.html +UG-20a.html +UG-27.html +UG-45.html +table_of_contents.html + +addition of filenames for volcanic mass, new optics, and population data +as well as namelist variables for strat_volcanic and carbon_by_pop +filenames.F90 +DefaultCAMEXPNamelist.xml +camexp.pm +runtime_opts.F90 + +advnce.F90 initialization for volcanics and population + +aer_optics.F90 added volcanic optics +aerosols.F90 added massfields for volcanics +volcanicmass.F90 (new file) read, interpolate volcanic masses +radctl.F90 added diagnostics for volcanic masses and effects of volcanics + +radcswmx.F90 added volcanic mass shortwave effects + + +Added effects of volcanics +radclwmx.F90 +radae.F90 +trcab.F90 +trcabn.F90 +trcems.F90 +volcrad.F90 (new file) + +Population.F90 (new file) read population history and provide carbonaceous aerosol scaling factor based on population + +New data files +bndtvvolc: historical masses from volcanic eruptions +bndtvpop: estimates of global total population + +appended new volcanic shortwave optics to aeroptics + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev57 +Originator: mvr ( Mathew Rothstein) +Date: Fri Jan 2 12:03:34 MST 2004 +Model: CAM +Version: CAM2.0_2.dev57 +One-line Summary: Upgrade CSM share; Upgrade ESMF; Add namelist option brnch_retain_casename; Update ccsm_msg to remove chunks and knuhcs; caseid now length 80; Remove goto from aerosols.F90. +cam-bugs Requests resolved: none +Requires change in build system: yes +-references to directory csm_share now point to csm_share/shr +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux (Lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, tcraig, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +- Updated ESMF to ESMF0_0_4 +- Updated CSM_SHARE to share3_0_2 +- added function get_chunk_owner_p in src/physics/cam1/phys_grid.F90: returns + the owner of a chunk given the lat, lon +- modified bld/configure: references to directory csm_share now point to + csm_share/shr +- modified bld/configure_fv.pl: references to directory csm_share now point + to csm_share/shr +- modified src/control/ccsm_msg.F90: utilize new function get_chunk_owner_p + rather than vars chunks, knuhcs +- modified src/control/filenames.F90: modified length of caseid to 80 from 33; + now using shr_kind_cs and shr_kind_cl for strings of length 80 and 256; + defined new namelist var brnch_retain_casename +- modified src/control/restart.F90: modified var tcase to same length as + caseid (shr_kind_cs); implemented new namelist var brnch_retain_casename to + allow branch runs without a change in casename +- modified src/control/runtime_opts.F90: added var brnch_retain_casename to + namelist camexp +- modified src/physics/cam1/phys_grid.F90: added new function + get_chunk_owner_p +- modified src/physics/cam1/aerosols.F90: replaced "goto" statement with code + friendlier to compiler optimization +- updated users guide to reflect new namelist option + +=============================================================== +=============================================================== + +cam2_0_2_dev56 +Originator: rosinski ( Jim Rosinski) +Date: Mon Dec 29 15:35:44 MST 2003 +Model: CAM +Version: CAM2.0_2.dev56 +One-line Summary: Enable restarting coupled model from dev51 restart file. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes (done by mvertens) +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes (in coupled mode they now look like dev51 restart files) +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Modified coupled-mode CAM restart file to be identical to dev51. +o NOTE: Standalone and SOM restart files are NOT the same. + +=============================================================== +=============================================================== + +cam2_0_2_dev55 +Originator: jmccaa ( James McCaa) +Date: Mon Dec 22 14:11:07 MST 2003 +Model: CAM +Version: CAM2.0_2.dev55 +One-line Summary: Tuning mods for finite volume 2x2.5. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes - new-climate for FV +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +Model parameters have been adjusted for runs using the finite volume +dycore. Changes occurred in the following routines: +cldwat.F90 +cloud_fraction.F90 +gw_drag.F90 +vertical_diffusion.F90 +moistconvection.F90 +zm_conv.F90 + +The turbulence mountain stress parameterization is now turned off. Also, +the parameters governing gravity wave drag are now the same for FV as for +the spectral dycores. + +=============================================================== +=============================================================== + +cam2_0_2_dev54 +Originator: pworley ( Patrick H Worley) +Date: Thu Dec 18 09:27:25 MST 2003 +Model: CAM +Version: CAM2.0_2.dev54 +One-line Summary: Improved existing and added SMP-aware physics load balancing schemes +cam-bugs Requests resolved: none +Requires change in build system: maybe +To exploit alternative EUL and SLD latitude decomposition, need to add -DMIRROR_DECOMP to Makefile +Substantial timing or memory changes: Yes - benchmarks by Rory Kelley indicate that new opt=0 load balancing improves performance +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC cluster +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Tom Henderson +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +1) Added Henderson, et al's modification to call spmdinit_dyn after runtime_options, + so that future modifications can use namelist input to decide how to decompose + dynamics data structures. + added: control/decompinit.F90 + modified: control/cam.F90, control/spmdinit.F90 +2) Added Henderson, et al's modification to move duplicate code (ceil_2, pair) + to a new spmd_util module. + added: control/spmd_utils.F90 + modified: dynamics/eul - realloc4.F90, realloc7.F90, scan2.F90, spmd_dyn.F90 + dynamics/sld - realloc4.F90, realloc7.F90, scan2.F90, spmd_dyn.F90 + physics/cam1 - phys_grid.F90 +3) Determined number of SMPs and process/SMP map. For EUL and SLD, equidistributed extra + latitudes (when mod(NLAT/npes) /= 0) over the SMPs. (This is useful when using option 1 + load balancing. See below.) + modified: control/spmdinit.F90, dynamics/eul/spmd_dyn.F90, dynamics/sld/spmd_dyn.F90, + dynamics/fv/spmd_dyn.F90 +4) For EUL and SLD, added an option to assign latitudes to processes so that southern + hemisphere latitudes and their "mirrors" in the northern hemisphere are assigned + to consecutive processes. This is useful when using load balancing options 1 and 3 (see below). + Currently, this is a compile time option. It will be changed to a runtime option + in the near future. To enable now, the CPP token MIRROR_DECOMP must be added to the + FPPFLAGS in the Makefile. + modified: dynamics/eul - spmd_dyn.F90, bndexch.F90; dynamics/sld - spmd_dyn.F90, bndexch.F90 +5) Redesigned load balancing options and implementation. The new options are + -1: each latitude line is a single chunk, same as 1D dynamics decompositions. + (UNCHANGED) + 0: split local longitude/latitude blocks into chunks, + while attempting to create load-balanced chunks. + (IMPROVED) + 1: split SMP-local longitude/latitude blocks into chunks, + while attempting to create load-balanced chunks. + (NEW) + 2: load balance chunks with respect to diurnal and + seaonsal cycles and wth respect to latitude, + and assign chunks to processor + in a way that attempts to minimize communication costs + (UNCHANGED) + 3: load balance chunks with respect to diurnal and + seasonal cycles (but not latitude), and assign chunks to + processor in a way that attempts to minimize communication + costs + (NEW) + + The implementation was significantly modified. The heuristic for + load balancing is now identical for options 0-3. The only difference + between the options is which processes are allowed to communicate + when load balancing.` + + Performance comparisons on the IBM indicate that the new option 0 is an improvement + over the old option 0. The other options (especially option 3) are now + competitive with option 0, but are not noticeably better. These results are for T85L26 + on 128 processors of Bluesky, and different results may hold on other systems or + for other problem sizes. + + modified: physics/cam1/phys_grid.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev53 +Originator: hender ( Tom Henderson) +Date: Mon Dec 15 11:55:00 MST 2003 +Model: CAM +Version: CAM2.0_2.dev53 +One-line Summary: Improve and extend prototype of new run-time options module. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, anchorage-lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton. Design reviewed by Eaton and Rosinski +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: +Files removed: +models/atm/cam/src/control/comhd.h +models/atm/cam/src/control/parse_namelist.F90 +models/atm/cam/src/control/preset.F90 + +Files added: +models/atm/cam/src/control/comhd.F90 +models/atm/cam/src/control/runtime_opts.F90 + +Files Modified: +models/atm/cam/src/dynamics/eul/courlim.F90 +models/atm/cam/src/dynamics/eul/grcalc.F90 +models/atm/cam/src/dynamics/eul/hdinti.F90 +models/atm/cam/src/dynamics/eul/hordif.F90 +models/atm/cam/src/dynamics/eul/spegrd.F90 +models/atm/cam/src/dynamics/sld/courlim.F90 +models/atm/cam/src/dynamics/sld/grcalc.F90 +models/atm/cam/src/dynamics/sld/hdinti.F90 +models/atm/cam/src/dynamics/sld/hordif.F90 +models/atm/cam/src/dynamics/sld/spegrd.F90 +models/atm/cam/src/physics/cam1/aerosol_intr.F90 +models/atm/cam/src/physics/cam1/phys_grid.F90 +models/atm/cam/src/control/cam.F90 +models/atm/cam/src/control/history.F90 + + + +=============================================================== +=============================================================== + +cam2_0_2_dev52 +Originator: rosinski ( Jim Rosinski) and John Truesdale +Date: Fri Dec 12 15:56:44 MST 2003 +Model: CAM +Version: CAM2.0_2.dev52 +One-line Summary: Improve handling of surface fractions, especially in coupled mode (SOM and CCSM) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Rosinski, Truesdale +Restart files change: yes +Changes answers: no (bit-for-bit) except SOM which is roundoff. There is a #define in somoce.F90 + that if defined will make SOM bfb. If the "puny" criterion of ice_srf.F90 is + ever met (aice <= puny = 1.e-12) then there is a possibility that prescribed-ice + mode could be good only to roundoff, but we were unable to generate such a case. +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Install a more permanent fix to erroneous surface fraction calculations +than the quick fix of dev50. The original bug which dev50 addressed was that +surface fractions were being changed in an incorrect way by calls to +update_srf_fractions in coupled mode (both SOM and CCSM). At various points +during a timestep, variable ICEFRAC contained either ice fraction of the grid +box or ice fraction of the non-land portion of the grid box. Routine +update_srf_fractions implicity assumed it was being called to convert a +non-land fraction into a grid box fraction. In coupled mode, +update_srf_fractions was being called by ccsmrcv every timestep after +receiving surface fraction information from the coupler. Since ICEFRAC held +ice fraction of the grid box at this point, an erroneous calculation thus +resulted. The dev50 quick fix was to install ifdefs around the ICEFRAC +recomputation in update_srf_fractions. In the more permanent fix, array AICE +always represents ice fraction of the non-land portion of the grid box, and +ICEFRAC always represents the ice fraction of the entire grid box. + +The updating of surface fractions and verifying their validity is now +segregated into two subroutines, comsrf.F90 routines update_ocnice and +verify_fractions, respectively. ccsm_msg.F90 routines ccsmrcv and +ccsm_msg_getalb now call verify_fractions, instead of a routine which will +actually change the surface fractions. If update_ocnice is ever called in +coupled mode it will result in an endrun() call. Instead, ccsmrcv and +ccsm_msg_getalb now contain explicit code to compute new fractions +(correctly) rather than make calls to update_ocnice. This resetting should +be unnecessary, but was retained to obtain bit-for-bit reproducibility with +earlier libraries and to avoid concerns about restartability. We believe the +calls to update_srf_fractions were originally installed to address bizarre +restartability issues in the coupled model. Ultimately the recomputation of +fractional information (especially landfrac every timestep) should be removed +from these routines. These spots are currently delimited with "bit-for-bit" +comments. + +For further details see details on the CAM checkin list. +=============================================================== +=============================================================== + +cam2_0_2_dev51 +Originator: mvr ( Mathew Rothstein) +Date: Mon Dec 8 11:29:27 MST 2003 +Model: CAM +Version: CAM2.0_2.dev51 +One-line Summary: add -Q to Makefile for IBM, added XLSMPOPTS back into run-ibm.csh +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, hender +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + +>> Makefile: +>> Add "-Q" for ~1% speedup. +>> +>> run-ibm.csh: +>> Add XLSMPOPTS do avoid thread-stack limits that cause seg-fault when +>> prognostic sulfates, carbon, sea salt, and dust are all turned on. +>> +>> ## suggestion from Jim Edwards to reintroduce XLSMPOPTS on 11/13/03 +>> setenv XLSMPOPTS "stack=256000000" + +=============================================================== +=============================================================== + +cam2_0_2_dev50 +Originator: jmccaa ( James Mccaa) +Date: Wed Dec 3 15:35:26 MST 2003 +Model: CAM +Version: CAM2.0_2.dev50 +One-line Summary: Small change to prevent CAM from incorrectly modifying sea ice fractions in SOM/CCSM mode. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +A small change was made to comsrf.F90 to prevent CAM from incorrectly +modifying sea ice fractions in SOM/CCSM mode. This corrects an error +introduced in dev47, and therefore the tags dev47, dev48, and dev49 +should not be used for SOM or CCSM runs. + +=============================================================== +=============================================================== + +cam2_0_2_dev49 +Originator: hender ( Tom Henderson) +Date: Tue Nov 18 12:26:08 MST 2003 +Model: CAM +Version: CAM2.0_2.dev49 +One-line Summary: New T85 surface data set with pre-computed fields, fixed SST data sets at T85 and T170, T85 tuning. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +- Modified DefaultCLMEXPNamelist.xml to point to new T85 surface data set from + Jim McCaa. This data set contains pre-computed surface fields and cuts more + than 10 minutes off of T85 initialization. + +- Modified DefaultCAMEXPNamelist.xml to point to new climatological sst files + for T85 and T170 from Jim McCaa. + Details from Jim McCaa: + On Fri, 31 Oct 2003, Jim McCaa wrote: +> These two files are intended to replace broken climatological sst files for +> T85 and T170, respectively, in /fs/cgd/csm/inputdata/atm/cam2/sst. +> +> /fs/cgd/data0/jmccaa/sst_HadOIBl_bc_128x256_clim_c031031.nc +> /fs/cgd/data0/jmccaa/sst_HadOIBl_bc_256x512_clim_c031031.nc +> +> +> The defaults xml file should be updated to point to these new files, +> replacing> any entries pointing to either of +> /fs/cgd/csm/inputdata/atm/cam2/sst/sst_HadOIBl_bc_128x256_clim_c020812.nc +> /fs/cgd/csm/inputdata/atm/cam2/sst/sst_HadOIBl_bc_256x512_clim_c020812.nc +> +> This will primarily affect anyone trying to run Jim R.'s defineqflux +> program, +> i.e. anyone trying to set up a T85 or T170 SOM run. +> +> I produces these new files using the old ones and the command: +> ncks -d time,0,11 + +- T85 tuning in cloud_fraction.F90 from Jim McCaa: +49c49 +< rhminl = .92 +--- +> rhminl = .91 + + +=============================================================== +=============================================================== + +cam2_0_2_dev48 +Originator: rosinski ( Jim Rosinski) +Date: Tue Nov 11 09:12:51 MST 2003 +Model: CAM +Version: CAM2_0_2_dev48 +One-line Summary: Save memory in aerosol code by holding in-core only 2 time levels of data. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes. per MPI task memory saved @ T42 = 190 MB/ntask +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit), except only roundoff under PC/pgf90 +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Revised aerosol reading to be like SST and ozone, keeping in-core only 2 + time levels of data to save memory. Initialization should speed up lots, + since 2 time levels of aerosol data are read in instead of 12. + + It is now feasible from a memory use standpoint to run T85 using 2 MPI + tasks on a machine with 2 GB of memory. + + BYPASS ifdef was removed since the speedup renders it unnecessary. + + Minor mods were made to sst and ozone interpolation routines for clarity + and consistency. + + There are still some differences between the new code and ozone/SST + handling. There is no "aercyc = .false." namelist option. Date info is + gotten from an internal Fortran "data" statement rather than read from a + boundary dataset. Existing routine "aerosol_initialize" takes the role of + what otherwise would be called "aerini" (instead of being named like + "sstini" and "oznini"), and is called from "inti" instead of "initext". + There is a new routine "aerint" in aerosols.F90 a la "sstint" and "oznint" + which is called from "advnce". Like these routines it reads in a new time + slice of data when needed. But the actual time interpolation is done in + "get_aerosol". The reasons for these differences have mainly to do with + maintaining minimal intrusiveness, and the fact that there are plans + to modify the way time and vertical interpolation of aerosols is done. + + +=============================================================== +=============================================================== + +cam2_0_2_dev47 +Originator: jet ( John Truesdale) +Date: Wed Nov 5 15:41:05 MST 2003 +Model: CAM +Version: CAM2.0_2.dev47 +One-line Summary: cam usage of boundary dataset ice fraction made consistant with HADISST data. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no + +Substantial timing or memory changes: no +Requires change in run script: no + +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: yes. Ice extent is now reduced around land. + +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +After computing the ice area of the original datasets and comparing it to +the ice area produced by our t42 model, it became apparent that CAM was +over estimating the ice area. The ice fraction on the boundary dataset was +intrepreted as being the fraction of ice covering an entire gridbox. A more +accurate way of determining the ice coverage is to regard the boundary +dataset ice fraction as the fraction of ice covering the *non-land* portion +of the grid box. So + +gridbox ice fraction = boundary dataset ice fraction * (1-land fraction) + +The ice area produced by cam with this change is now very close to the +original datasets and to the ice area produced by CSM. The overall effect +is a reduction of ice coverage in those grid boxes with some land fraction. + +This change is a one line mod to comsrf.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev46 +Originator: pworley ( Patrick H Worley) +Date: Tue Nov 4 15:26:37 MST 2003 +Model: CAM +Version: CAM2.0_2.dev46 +One-line Summary: Decreased memory requirements in dynamics/eul/inidat and added new load balancing scheme to phys_grid (same as dev39). +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes - decreased number of full 3D fields needed in inidat from 9+(pcnst+pnats) to 4 +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Linux cluster +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes (same as dev39) +Changes made: + + The cam2_0_2_dev39 commit failed (on Sep. 29, 2003). This commit reintroduces those changes. + The following is identical to the dev39 documentation ... + + 1) restructured dynamics/eul/inidat.F90 to minimize the memory requirements. + In the original version, masterproc allocates (9+pcnst+pnats) 3D fields + and 16 2D fields. It then reads in or generates the initial data, + scatters the data, and finally deallocates the arrays. In the revised + version, subsets of arrays are allocated, initialized, scattered, and + deallocated together, decreasing the maximum memory requirements to 4 3D fields. + Note that I implemented the logic that Brian Eaton used in FV inidat (for WACCM) + to treat each species in q3 separately. + + 2) added a new load balancing algorithm in physics/cam1/phys_grid.F90. + The original global balancing algorithm (opt = 1) eliminates + imbalances due to the diurnal and seasonal cycles. However, it still + assigns all polar latitdues to the same processors, the mid-latitudes + to the same processors, and the equatorial latitudes to the same processors. + The new algorithm (opt = 2) mixes up the latitudes as well, achieving + almost perfect load balance. It comes at a cost of increased communication cost + compared to opt = 1, and may or may not be a performance enhancer for + a given system, problem size, and processor count. + + 3) added an option to physics/cam1/phys_grid.F90 to implement the transpose_block_to_chunk + and transpose_chunk_to_block routines using point-to-point MPI commands rather + than mpi_alltoallv. This has been important on some systems in the past, + and is included here as an aid to experimentation. This option is currently + disabled in the code. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev45 +Originator: hender ( Tom Henderson) +Date: Fri Oct 31 11:24:43 MST 2003 +Model: CAM +Version: CAM2.0_2.dev45 +One-line Summary: Performance optimization for IBM. +cam-bugs Requests resolved: none +Requires change in build system: yes +Fortran compiler optimization for IBM "xlf90" has changed from +"-O2 -qmaxmem=-1 -Q" to "-O3 -qstrict". The "-lmass" library is now +linked in unless DEBUG is on. +Substantial timing or memory changes: yes, it runs ~5% faster. +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Linux-lf95 +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Jim McCaa +Restart files change: no +Changes answers: Yes, same-physics +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Changed optimization in Makefile for IBM. +Changed "sanity checks" in pcond() (cldwat.F90) to make IBM compiler +happy (bfb). +Changed "rliq1 sanity check" in pcond() (cldwat.F90) to use Jim McCaa's +fix (bfb). + +=============================================================== +=============================================================== + +cam2_0_2_dev44 +Originator: jmccaa ( James McCaa) +Date: Fri Oct 31 09:48:06 MST 2003 +Model: CAM +Version: CAM2.0_2.dev44 +One-line Summary: T85 tuning, removal of many default history file fields, modification of dif4 initialization. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit at all resolutions except T85) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +This tag supplies three changes to the model: + +1) The tuning of the T85 Eulerian model has been modified through the + addition of the relative humidity cloud threshold ramp in + cloud_fraction.F90. Tuning parameters were also modified in + zm_conv.F90, moistconvection.F90, and cldwat.F90. + +2) The number of fields on the default monthly history files has been + reduced substantially. All fields continue to be available via the + fincl namelist facility. Also, default daily history files have + been eliminated. + +3) The initialization of the diffusion parameters dif4 and dif2 have + been moved out of build-namelist and into the model. The default + dif4 value for T85 has been modified. + +The files that were modified are: +>> M models/atm/cam/bld/DefaultCAMEXPNamelist.xml +>> M models/atm/cam/src/control/history.F90 +>> M models/atm/cam/src/control/preset.F90 +>> M models/atm/cam/src/dynamics/eul/dycore.F90 +>> M models/atm/cam/src/dynamics/sld/dycore.F90 +>> M models/atm/cam/src/physics/cam1/cldcond.F90 +>> M models/atm/cam/src/physics/cam1/cldwat.F90 +>> M models/atm/cam/src/physics/cam1/cloud_fraction.F90 +>> M models/atm/cam/src/physics/cam1/gw_drag.F90 +>> M models/atm/cam/src/physics/cam1/moistconvection.F90 +>> M models/atm/cam/src/physics/cam1/vertical_diffusion.F90 +>> M models/atm/cam/src/physics/cam1/zm_conv.F90 + +=============================================================== +=============================================================== + +cam2_0_2_dev43 +Originator: rosinski ( Jim Rosinski) +Date: Wed Oct 29 14:02:46 MST 2003 +Model: CAM +Version: CAM2.0_2.dev43 +One-line Summary: cos(lat) now applied to LANDM field offline. Since all IC files now require this + field (LANDM_COSLAT), new IC fields were generated. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes. Same-to-roundoff T42. Changes answers other resolutions (due to LANDM). +Changes to CLM land-model: None (except sfc datasets must be generated). +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Migrated multiplication of LANDM field by cos(lat) offline. One reason to do this was that +model-written IC files were invalid, due to erroneous multiple applications of the above-mentioned +cosine function. Also, for horizontal resolutions other than T42 there was an undesirable +resolution-dependent behavior of the LANDM specification algorithm. In the new approach, +linear interpolation to the target resolution is done from a "master" LANDM dataset, which was +built at T42 (per pjr). The resulting LANDM_COSLAT field now looks similar regardless of resolution. + +The "master" LANDM_COSLAT dataset lives in /fs/cgd/csm/inputdata/atm/cam2/hrtopo/landm_coslat.nc +It is read in by offline tool "definesurf", which has been modified to read it. + +Since new IC files are now required for all resolutions, it was decided to introduce consistency +to these files by using the newest 10-minute hi-res topography dataset when creating them. The +newest topography file is /fs/cgd/csm/inputdata/atm/cam2/hrtopo/topo10min.merged_c030506.nc +As a consequence of using this new file, existing resolution-specific surface datasets and IC +files for CLM also are invalid. Thus for many resolutions (though not T42), CLM must be spun +up for any runs done with cam2.0.2.dev43 and beyond. These changes are reflected in the xml +files which are used to build CAM and CLM namelists. + +=============================================================== +=============================================================== + +cam2_0_2_dev42 +Originator: rosinski ( Jim Rosinski) +Date: Tue Oct 28 16:02:07 MST 2003 +Model: CAM +Version: CAM2.0_2.dev42 +One-line Summary: Eliminate global TS print from physpkg and other minor speedups. + Add T85 and 2x2.5 aerosol datasets to xml file. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Minor speedup (see below). +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +o Eliminated global TS calculation and printout from physpkg. This code was left over +from long ago and the output is now more easily obtainable by other means. Minor speedup. + +o Moved calculation of tsice_rad to threaded region. Minor speedup on IBM, potentially +more significant when OMP_NUM_THREADS is a larger number (e.g. SGI). Unfortunately this +calculation is needed to create v2 IC files so it cannot be eliminated entirely. But it is +only needed when an IC file is generated, not every timestep. So further speedup is +possible. + +o Made srfflx_state_reset callable by chunk to enable fusing threaded loops. + +o Added reference to T85 and 2x2.5 aerosol datasets to CAM namelist xml file. + +=============================================================== +=============================================================== + +cam2_0_2_dev41 +Originator: jmccaa ( James Mccaa) +Date: Thu Oct 23 15:54:52 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev41 +One-line Summary: Climate tuning mods for T42 and T85. + +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes, new-climate +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Modifications have been made to allow the code to run using different +physics tuning parameters for different dycores and resolutions. +The values of these parameters have been adjusted following numerous +sensitivity experiments. + +The file cldfrc.F90 has been converted to a module named cloud_fraction.F90, and +an initialization routine has been added. +The files closure.F90, guang.h, and q1q2.F90 have merged into zm_conv.F90. +Minor code modifications have been made to allow greater optimization levels on +the IBM. + +Changed files: +>> M models/atm/cam/src/advection/slt/hordif1.F90 +>> M models/atm/cam/src/control/cam.F90 +>> M models/atm/cam/src/control/history.F90 +>> M models/atm/cam/src/control/preset.F90 +>> M models/atm/cam/src/control/spmdinit.F90 +>> M models/atm/cam/src/dynamics/eul/dycore.F90 +>> M models/atm/cam/src/dynamics/fv/dycore.F90 +>> M models/atm/cam/src/dynamics/sld/dycore.F90 +>> M models/atm/cam/src/physics/cam1/cldnrh.F90 +>> M models/atm/cam/src/physics/cam1/cldwat.F90 +>> M models/atm/cam/src/physics/cam1/geopotential.F90 +>> M models/atm/cam/src/physics/cam1/inti.F90 +>> M models/atm/cam/src/physics/cam1/moistconvection.F90 +>> M models/atm/cam/src/physics/cam1/pkg_cld_sediment.F90 +>> M models/atm/cam/src/physics/cam1/radae.F90 +>> M models/atm/cam/src/physics/cam1/sulchem.F90 +>> M models/atm/cam/src/physics/cam1/tphysbc.F90 +>> M models/atm/cam/src/physics/cam1/zm_conv.F90 +>> M models/csm_share/shr_vmath_mod.F90 + +Removed files: +>> R models/atm/cam/src/physics/cam1/cldfrc.F90 +>> R models/atm/cam/src/physics/cam1/closure.F90 +>> R models/atm/cam/src/physics/cam1/guang.h +>> R models/atm/cam/src/physics/cam1/q1q2.F90 + +Added files: +>> A models/atm/cam/src/physics/cam1/cloud_fraction.F90 + +=============================================================== +=============================================================== + +cam2_0_2_dev40 +Originator: rosinski ( Jim Rosinski) +Date: Wed Oct 22 16:54:16 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev40 +One-line Summary: Move horizontal aerosol interpolation offline. Modify print_memusage for readability and portability. +cam-bugs Requests resolved: none +Requires change in build system: yes: resolution-specific aerosol dataset required +Substantial timing or memory changes: yes: faster, uses less memory +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Andrew Conley +Restart files change: no +Changes answers: Yes (same-to-roundoff) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + +Changes made: + +o Moved horizontal aerosol interpolation to CAM grid offline. The main reason for +this was to speed up initialization and reduce memory usage when running CAM. At T42 +using 2 MPI tasks, the memory hi-water mark for MPI task 0 is reduced by about 50%. +Memory reduction for MPI task 1 is around 20%. + +Since the boundary aerosol dataset is now resolution-specific, the amount of speedup vs. +dev39 will be resolution-dependent, with lower resolutions seeing the biggest benefit. +There will also be some speedup during the time-integration phase due to reordering loops +and array structure for cache efficiency in aerosol routine vert_interpolate. Since +the aerosol initialization code still reads a full 12 months of data, the startup time +overhead and memory overheads are not insignificant. We may want to further restructure +the code to read in aerosols the same way as SST and Ozone, keeping just 2 bounding +months of data in-core at any given time. In the meantime, if time spent reading +the aerosol boundary data still proves to be an annoyance, things can be sped up dramatically +if the aerosol dataset is made local rather than read from an NFS-mounted file system. +Alternatively, #define BYPASS is still available from earlier libs. + +The new boundary dataset generation code lives in cam/tools/interpaerosols. A +README in that directory explains the procedure to generate an aerosol boundary +dataset at the target model resolution. Resolution-specific aerosol datasets have +already been created for resolutions needed by test-model, and some other common +resolutions. + +Mods were also made to the main CAM Makefile. LAPACK/BLAS routines are only used by the +aerosol initialization procedure, so library references to these routines now only +exist in the offline code. + + +o Rewrote utility routine print_memusage for readability of output and portability. It now +works on Linux as well as SGI and IBM. The point of the routine is to print +memory use information at whatever point in the code the user wishes. On most machines +the numbers printed refer to hi-water mark, but on Linux they refer to current use (i.e. +on Linux the numbers do not necessarily increase monotonically with time). Also on +most machines, the printed numbers refer to KB of memory used. But this is not necessarily +true on all machines (e.g. Linux). Refer to "man getrusage" on most machines, and "man proc" +on Linux machines for details. The output from print_memusage now goes to Fortran unit 0, +which in most cases translates to stderr. So memory use information can be segregated from +stdout by for example: (cam < namelist >! out) >&! err. This code is far from perfect, e.g. +printed output can still be jumbled between MPI tasks. + + +Misc. notes: + +o To get bit for bit vs. dev39, created a 64-bit aerosol dataset, pasted lon and lat +coordinate variables from a dev39 run into the input/output file required by interpaerosols. +Under pgf90 this is bfb. Unfortunately this procedure did not yield bfb results on IBM or SGI. + +o Input aerosol dataset variable names and output history variable names are as before, but +with an "_V" appended to their name. This reflects the fact that these variables have +undergone a vertical sum. The different names will also cause the model to crash if an +incorrect boundary dataset is used. + +=============================================================== +=============================================================== + +cam2_0_2_dev39 +Originator: pworley ( Patrick H Worley) +Date: Mon Sep 29 13:44:01 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev39 +One-line Summary: Decreased memory requirements in dynamics/eul/inidat and added new load balancing scheme to phys_grid. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes - decreased number of full 3D fields needed in inidat from 9+(pcnst+pnats) to 4 +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux cluster +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + + 1) restructured dynamics/eul/inidat.F90 to minimize the memory requirements. + In the original version, masterproc allocates (9+pcnst+pnats) 3D fields + and 16 2D fields. It then reads in or generates the initial data, + scatters the data, and finally deallocates the arrays. In the revised + version, subsets of arrays are allocated, initialized, scattered, and + deallocated together, decreasing the maximum memory requirements to 4 3D fields. + Note that I implemented the logic that Brian Easton used in FV inidat (for WACCM) + to treat each species in q3 separately. + + 2) added a new load balancing algorithm in physics/cam1/phys_grid.F90. + The original global balancing algorithm (opt = 1) eliminates + imbalances due to the diurnal and seasonal cycles. However, it still + assigns all polar latitdues to the same processors, the mid-latitudes + to the same processors, and the equatorial latitudes to the same processors. + The new algorithm (opt = 2) mixes up the latitudes as well, achieving + almost perfect load balance. It comes at a cost of increased communication cost + compared to opt = 1, and may or may not be a performance enhancer for + a given system, problem size, and processor count. + + 3) added an option to physics/cam1/phys_grid.F90 to implement the transpose_block_to_chunk + and transpose_chunk_to_block routines using point-to-point MPI commands rather + than mpi_alltoallv. This has been important on some systems in the past, + and is included here as an aid to experimentation. This option is currently + disabled in the code. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev38 +Originator: hender ( Tom Henderson) +Date: Mon Sep 22 11:46:03 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev38 +One-line Summary: Bug fix for prognostic aerosols, SE improvements. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux-lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Phil Rasch, Brian Eaton, Erik Kluzek +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Fixed bugs and added namelist variables to control prognostic aerosols. +(Bug fix for prognostic aerosols was provided by Phil Rasch.) +Improved design of parse_namelist(), prototype implementation is included +subject to review. So far design and implementation have been reviewed +only by Brian Eaton and Erik Kluzek. +Brought physics performance tuning parameters out to CAMEXP namelist. + +New namelist variables are: + +PHYSICS CONTROLS + +AERO_SULFUR +Type: Logical +Default: .FALSE. +Description: If true, turn on sulfur prognostic aerosols. + +AERO_FEEDBACK_SULFUR +Type: Logical +Default: .FALSE. +Description: If true, turn on feedback of sulfur prognostic aerosols. May +only be true if AERO_SULFUR is also true. + +AERO_CARBON +Type: Logical +Default: .FALSE. +Description: If true, turn on carbon prognostic aerosols. + +AERO_FEEDBACK_CARBON +Type: Logical +Default: .FALSE. +Description: If true, turn on feedback of carbon prognostic aerosols. May +only be true if AERO_CARBON is also true. + +AERO_SEA_SALT +Type: Logical +Default: .FALSE. +Description: If true, turn on sea salt prognostic aerosols. + +AERO_FEEDBACK_SEA_SALT +Type: Logical +Default: .FALSE. +Description: If true, turn on feedback of sea salt prognostic aerosols. May +only be true if AERO_SEA_SALT is also true. + + +PERFORMANCE TUNING + +PHYS_LOADBALANCE +Type: Integer +Default: 0 +Description: Select different options for organization of physics chunks. +Each uses a different scheme for static load balancing. + +PHYS_CHNK_PER_THD +Type: Integer +Default: 1 +Description: Select target number of chunks per thread. Must be positive + + +CHANGED FILES: + cam1/models/atm/cam/doc/UsersGuide/UG-20.html + cam1/models/atm/cam/src/dynamics/eul/inidat.F90 + cam1/models/atm/cam/src/dynamics/sld/inidat.F90 + cam1/models/atm/cam/src/dynamics/fv/inidat.F90 + cam1/models/atm/cam/src/physics/cam1/aerosol_intr.F90 + cam1/models/atm/cam/src/physics/cam1/carbon_intr.F90 + cam1/models/atm/cam/src/physics/cam1/dust_intr.F90 + cam1/models/atm/cam/src/physics/cam1/phys_grid.F90 + cam1/models/atm/cam/src/physics/cam1/radctl.F90 + cam1/models/atm/cam/src/physics/cam1/seasalt_intr.F90 + cam1/models/atm/cam/src/physics/cam1/sulchem.F90 + cam1/models/atm/cam/src/physics/cam1/sulfur_intr.F90 + cam1/models/atm/cam/src/physics/cam1/wetdep.F90 + cam1/models/atm/cam/src/control/cam.F90 + cam1/models/atm/cam/src/control/comhd.h + cam1/models/atm/cam/src/control/parse_namelist.F90 + + + +=============================================================== +=============================================================== + +cam2_0_2_dev37 +Originator: mirin ( Arthur Andrew Mirin) +Date: Wed Sep 17 16:30:30 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev37 +One-line Summary: Transpose and other FV improvements +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: no (unless test_model did that) +Code reviewed by: myself, Will Sawyer +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +This update accomplishes improvements to the finite-volume transposes and to +the FV dycore itself, as undertaken by Art Mirin and Will Sawyer. Specifically: + +(A) The irregular communication routines of the mod_comm library +have been placed in their own module (mod_irreg), to enable use of a unified +version of mod_comm in CAM2 and FVGCM (NASA Goddard). This facilitates making use +of ongoing improvements at Goddard (such as support for SHMEM). + +(B) The transpose calls directly reference mod_irreg routines as opposed to +going through the Pilgrim layer. This is true for use of mpi derived types as +well as contiguous buffers. Pilgrim's main function is to set up communication +patterns; mod_irreg then accomplishes the transposes. + +By default, the transposes gather/scatter data from/to contiguous buffers. We +have found mpi derived types to be very slightly superior on the IBM. +One can implement use of mpi derived types at compile time by activating the line +"FPPFLAGS += -WF,-DUSE_MPI_TYPES" in the AIX section of the Makefile. +Support for one-sided (MPI2) communications when using MPI derived types has not +yet been implemented. + +(C) There have been other miscellaneous improvements to Pilgrim / mod_comm. + +(D) The Held-Suarez, Rayleigh friction and high-pressure mode have been removed +from the FV dycore. + +(E) The FV version of inidat.F90 has been rewritten to minimize use of global 3D +arrays. + +(F) Additional sectional timing diagnostics have been added, as well as an additional +optional timing barrier in the physics. + +(G) There have been other miscellaneous improvements. + +The following routine was added: + cam1/models/utils/pilgrim/mod_irreg.F90 + +The following routines were deleted: + cam1/models/atm/cam/src/dynamics/fv: hswf.F90, highp2.F90, dry_adj.F90, rayl_fric.F90 + +The following routines were modified: + cam1/models/utils/pilgrim: Makefile, mod_comm.F90, parutilitiesmodule.F90 + cam1/models/atm/cam/bld/Makefile + cam1/models/atm/cam/src/physics/cam1/physpkg.F90 + cam1/models/atm/cam/src/dynamics/fv: cd_core.F90, d2a3dikj.F90, dp_coupling.F90, + dynamics_vars.F90, dynpkg.F90, geopk.F90, inidat.F90, inital.F90, mapz_module.F90, + p_d_adjust.F90, pft_module.F90, pmgrid.F90, restart_dynamics.F90, spmd_dyn.F90, + stepon.F90, te_map.F90, uv3s_update.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev36 +Originator: jmccaa ( James McCaa) +Date: Fri Sep 12 14:32:06 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev36 +One-line Summary: Merge of physics tuning branch onto cam_dev branch. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux cluster +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers:Yes -- new climate +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +The following changes apply to all dycores: +* The fall velocity of large (400 micron) ice crystals has been reduced + from 3.5 m/s to 1 m/s. +* There is a lapse-rate reduction of the SST used for stratus diagnosis + when the sea surface elevation is not 0. +* The temperature ramp used to compute the effective radius of warm + clouds over land now goes from -20 C to 0 C. +* The land fraction ramp over the ocean goes from cos(lat) near the + coast to 0 at 1000 km from the coast. +* The effective radius and CCN of warm clouds over land now depend + on snow depth (linear ramp from 0 to 0.1 m liquid water equivalent). +* The evaporative efficiency for rain falling from cumulus has been + lowered from 3.0e-6 to 2.0e-6. +* Formulae for cloud fraction associated with moist convection have + been changed. +* Adjustments have been made to the aerosol optics. + +The following modifications only apply to the finite volume dycore: +(They are in addition to the changes described above.) +* A new energy fixer has been added. +* The parameterization of gravity wave drag has been modified. +* A new parameterization of orographic form drag has been added. +* The Hack scheme now detrains cloud liquid. +* Evaporation efficiency for stratiform rain has been halved. +* Evaporation efficiency for convective rain has been halved. +* Formulae for cloud fraction associated with moist convection have + been changed. + +The following modififications have been made to keep the standalone +CAM consistent with recent coupled runs: +* The snow fraction on land as a function of snow depth has been + changed. +* Both visible and near-ir albedos of snow on sea ice have been + lowered by 0.02. +* Albedos of bare sea ice have been lowered by 0.10 for visible and + 0.06 for near-ir. + +There is one infrastructure change: +* ncar_batch.csh now overrides any previously set values of the environment + variables INC_NETCDF and LIB_NETCDF to point to 64 bit versions + +=============================================================== +=============================================================== +cam2_0_2_dev35 +Originator: mvertens ( Mariana Vertenstein) +Date: Wed Sep 10 10:37:47 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev35 +One-line Summary: fix clm bug that caused problems at very high mpi task number +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Forrest Hoffman +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + Fixed bug in clm code (lnd_grid.F90) that caused problems to occur at very + high mpi task number +=============================================================== +=============================================================== + +cam2_0_2_dev34 +Originator: hender ( Tom Henderson) +Date: Tue Sep 2 12:41:50 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev34 +One-line Summary: AIX 64-bit addressing and a bunch of other stuff +cam-bugs Requests resolved: 98, (127), 128 +Requires change in build system: AIX build now uses 64-bit addressing +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux-lf95 +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, contributors +Restart files change: no +Changes answers: Yes (same-to-roundoff for AIX, bfb for all others) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + Bunch-o-fixes II: + - Jim Edwards' performance fix for estblf + - wv_saturation.F90 + - change Makefile (etc.) to use 64-bit on AIX + - Modified Makefile, run-ibm.csh, CAM_lab.pm + - From Jim McCaa + The code already exists in history.F90, but is CPPed out. So, what I'm + requesting is to remove the two CPP lines, thereby enabling the code. + They are: + line 2501: #if ( defined CNTL_FORSOM ) + line 2506: #endif + This won't affect answers, but will add fields to the monthly history + tape. + - From John Truesdale: + In diagnostics.F90 the outfld call for TSICERAD needs to be removed (per + Jerry O.) In tphysbc.F90 the DQCOND outfld call needs to be removed + (duplicate of outfld call using dcconnam). + - Jim Rosinski kindly offered to add a summary message to cprnc indicating + how many fields were compared and how many passed bfb. + - only one file changed: + /fs/cgd/data0/rosinski/newcprnc/cam1/models/atm/cam/tools/cprnc/cpr.F + - Fixed bug in fv 2D decomposition (From Art Mirin) + - Changed dp_coupling.F90 for fv + - Fixed CAM bug #98 (originally reported by Woo Sun Yang) + - Francis Vitt (ACD) provided the bug fix for writing staggered 'US' grid + from history.F90. + - Attempted to remove undocumented Lahey compiler option from Makefile as + suggested by Jim Rosinski + "For some reason the default CAM Makefile includes an undocumented compiler + flag (-CcdRR8) when using lf95 on the PC. The documented flag --dbl used + to suffice for auto-promotion of real to real*8, and has been removed. + Does anyone know why this was changed? If not, I propose changing back to + the documented flag if identical answers can be obtained. Undocumented + flags are a bad idea all around, I think. + JR" + - Can't make this change because "--dbl" promotes real*4's too (which + will break MPI communications and history output). + - Corrected misleading comments about this in Makefile. + - Implemented Brian Eaton's fix for incorrect override of qmin from namelist + - Modified all three flavors of initcom.F90 + - Removed ccm366 physics from Default*Namelist.xml. + - Added new data file for Jerry Olson to DefaultCAMEXPNamelist.xml. + eul/ncdata_vers=2: cami_0000-09-01_64x128_L26_c030624.nc + sld/ncdata_vers=2: cami_0000-09-01_64x128_L26_c030624.nc + eul/ncdata_vers=1: cami_0000-09-01_64x128_L26_030506.nc + sld/ncdata_vers=1: cami_0000-09-01_64x128_L26_030506.nc + - Fix CAM bug #128 (fv build problems on Compaq and SGI) with bug fixes + from Tony Craig and Wei Yu. + - Modified cd_core.F90, and ccsm_msg.F90 (physpkg.F90 already fixed) + + dev34 is bfb vs. dev33 on non-AIX machines, but + roundoff on AIX machines. AIX perturbation growth of cam2_0_2_dev33 is + nearly identical to error growth of difference between cam2_0_2_dev33 and + cam2_0_2_dev34 for all three dycores. roundoff is entirely due to change + in AIX compiler options to use 64-bit addressing in Makefile and in cprnc + Makefile. This was tested by comparing dev33+(new Makefiles) vs. dev33 + (roundoff differences observed) and comparing dev34-(new Makefiles) vs. + dev33 (bfb exact). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== +cam2_0_2_dev33 +Originator: mvertens ( Mariana Vertenstein) +Date: Mon Aug 25 12:06:15 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev33 +One-line Summary: updated clm code from clm2_deva_30 to clm2_deva_36 +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes (new-physics (clm only) +Changes to CLM land-model: Yes +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +Only clm changes have been made in this tag. + +cam2_0_2_dev32 contains clm2_deva_30 (with some changes on the cam branch for dust +that are only invoked when the cpp variable DUST is defined). + +cam_0_2_dev33 contains clm2_deva_36 (which has incorporated the above dust mods). + +The following summarizes the changes between clm2_deva_30 and clm2_deva_36. +The changes that lead to greater than roundoff differences are denoted by (*). + + 1) Put in dust mods in cam2_0_2_dev32. +*2*) Put in bug fix to BareGroundFluxesMod.F90 so that z0hg and z0qg at the column + level would not be set by pft level quantities. This changes answers to more + than roundoff. + 3) Put in bug fix in Biogeophysics2Mod.F90 so that would not divide by + zero when calculating the ratio of soil evaporation for a pft relative + to the total of all evaporating PFTs. This would occur if the weight + became 0. in the dgvm calculation. This results in bfb answers in non-dgvm mode. + 4) Put in bug fix to BareGroundFluxesMod.F90 so that z0hg and z0qg at the column + level would not be set by pft level quantities. This changes answers to more + than roundoff. + 5) Put in bug fix in Biogeophysics2Mod.F90 so that would not divide by + zero when calculating the ratio of soil evaporation for a pft relative + to the total of all evaporating PFTs. This would occur if the weight + became 0. in the dgvm calculation. This results in bfb answers in non-dgvm mode. + 6) Put in a change to DGVMMod.F90 to fix a bug in history file output + in compete mode (the default now). +*7*) Reversion to old fraction snow cover algorithm (clm2_deva_32) + 8) Made clmtype variables relating to soil hydraulic and thermal properties + column physical state properties rather than land physical state properties + 9) Fixed DGVM restart problem in compete mode: + Modified restFileMod.F90 and DGVMMod.F90 so that average over all + column pfts for h2ocan (needed by begwb computation in routine + driver.F90) is done in restfileMod.F90 only for non-DGVM mode and in + resetWeightstDGVM (in module DGVMMod.F90) for DGVM mode (since this + needs to be done after the weights are reset in the DGVM case). + 10) Modified tssbef dimension in clmtype.F90 to be consistent. +=============================================================== + +=============================================================== + +cam2_0_2_dev32 +Originator: pworley ( Patrick H Worley) +Date: Tue Aug 19 20:38:06 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev32 +One-line Summary: Chunking data structures and optimizing interprocessor communication in ozone routines +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes (performance improves for large process counts) +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +The original version of oznini reads in two timelevels of ozone data +and saves them in masterproc. masterproc then interpolates the data to the +current timelevel and broadcasts the entire field to each process. +Each shortwave or longwave timestep, advnce calls oznint. +In oznint, masterproc again interpolates the ozone data +to the current timelevel and broadcasts the entire field to each process. +(Every month or so, oznint also reads a new timelevel of +ozone data into masterproc.) + +In the new version, oznini reads in the two timelevels, then distributes +both timelevels to all of the processes, so that they can do the interpolation +on their own. Moreover, the ozone data has been chunked, and each process +holds only the data that it needs for the columns that it is responsible for. +The performance impact is a significant decrease in the number of times +masterproc sends ozone data to the other processes, and a decrease in the +amount of data sent in each remaining communication. Routines modified were +comozp.F90, oznini.F90, oznint.F90, and radozn.F90, all in control/ . + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev31 +Originator: rosinski ( Jim Rosinski) +Date: Thu Aug 14 21:54:00 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev31 +One-line Summary: Bugfix from Natalie M. for sulfur fields. Consistent treatment of r4 vs. r8 in function calls +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +o Sulfur bugfix from Natalie M. addresses negative concentrations. +o Consistent treatment of constants as r8. + +=============================================================== +=============================================================== + +cam2_0_2_dev30 +Originator: pworley ( Patrick H Worley) +Date: Wed Aug 13 15:23:59 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev30 +One-line Summary: Replaced global spectral arrays and indices with local arrays in EUL dycore, to decrease memory requirements. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes:Yes (spectral memory requirements now decrease as number of MPI processes increase) +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux cluster +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: No (bit-for-bit) for SGI and Linux cluster, Yes (same-to-roundoff) for IBM +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +The primary goal of this update is to decrease the memory requirements +in the spectral Eulerian dycore by allocating space only for the +spectral coefficients that each processor is responsible for. While +we earlier decomposed the work, we have still been allocating the +full spectral arrays on each processor. This modification is important +for higher horizontal resolutions (T85, T170) as it decreases the memory +required for each process and may improve performance by improving memory +locality. To this end, the following files in dynamics/eul were modified: + +comspe, spmd_dyn, trunc, initcom, inital, dynpkg, grcalc, hordif, +quad, and tstep + +The routine spetru was also divided into 4 routines (in a new spetru module): +spetru_u., spetru_t, spetru_ps, and spetru_phis, spectrally truncating +the fields u and v, t, ps, and phis, respectively. The old spetru used +the global spectral arrays vz, d, t, and phis, which have been eliminated. +The new routines use at most a few single level global spectral arrays to +truncate the fields, again decreasing the required memory. + +Finally a few random changes were included in this update: + +Makefile - + Added -lcxml to the LDFLAGS for OSF, to link in DGETRF and DGETRS + on the Pittsburgh AlphaServer SC (needed by aerosols.F90) + +caerbnd.F90, dmsbnd.F90: + Moved declaration for ncol so that it appears before its use in + array declarations. (HP/Compaq compiler complained.) + +physpkg.F90: + Removed redundant USE of time_manager variables. (HP/Compaq compiler + complained.) + +carbon_intr.F90, seasalt_intr.F90 + Removed redundant USE of shr_const_mod variables. (HP/Compaq compiler + complained.) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev29 +Originator: aconley ( Andrew J. Conley) +Date: Thu Aug 7 10:25:49 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev29 +One-line Summary: linearly interp asym and ssa parameters, Do not extrap optics beyond rh = 1.0 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, chinooke, anchorage +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers:Yes new-physics ( < 10^-3 relative change in aerosol heating) + +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + Aerosol optics are no longer extrapolated beyond rh = 1.0. + Asymmetry and single scattering albedo are now linearly interpolated + in rh rather than exponentially interpolated. +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev28 +Originator: rosinski ( Jim Rosinski) +Date: Wed Aug 6 11:49:49 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev28 +One-line Summary: Back out nf90 interface from sulfur codes. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: + +o Backed out the Fortran 90 interface from sulfur codes per CRB. +o IMPORTANT NOTE: There is a reproducibility problem on the IBM when the sulfur routines are + enabled. This problems exists both in the previous library (2.0.2.dev27) and this commit. + Only the sulfur fields are affected, and the impact appears to be minor. The problem is + likely related to threading, since 1-day test runs on IBM machines with OMP_NUM_THREADS=1 + give reproducible answers. Threaded tests on chinook (SGI) were successful. Note that + test-model does not enable the sulfur routines, so results were bit-for-bit. + +=============================================================== +=============================================================== + +cam2_0_2_dev27 +Originator: hender ( Tom Henderson) +Date: Wed Jul 30 15:10:50 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev27 +One-line Summary: First cut at getting dust to work with physics chunking. +cam-bugs Requests resolved: none +Requires change in build system: no + +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, anchorage-lf95 +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Hacks for dust, see "#if (defined DUST)" +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: +Updated Natalie Mahowald's dust package (including her land model changes) to +work with PCOLS=16. It does not crash on anchorage but does crash on +blakcforest when cpp token DUST is defined (by default, dust, sulfates, +sea salt, and carbon packages are turned off via cpp tokens). MORE WORK NEEDS +TO BE DONE. + +This tag is identical to cam2_0_2_dev25_brnchT_paero7. + +Note that pgf90-pgcc and pgf90-gcc are known to fail because the Makefile has +not been updated to deal with the new F90 netcdf interfaces used in the new +code. The next tag should replace the F90 interfaces with the standard CAM +wrap_ncf() calls, if possible. + +=============================================================== +=============================================================== + +cam2_0_2_dev26 +Originator: hender ( Tom Henderson) +Date: Mon Jul 28 18:18:26 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev26 +One-line Summary: Added Phil Rasch's prognostic SOx aerosols. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux-lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + (If not abort this tag and follow the procedures in) + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: +Added prognostic aerosols. All four packages (sulfates, carbon, sea salt, and +dust) are independently #ifdef'd out in aerosol_intr.F90. Sulfates have +been tested with the other three off. Results are bfb with cam2_0_2_dev25 +when all four are off. Feedback to radiation is disabled in radctl.F90 (see +commented-out calls to set_aerosol_from_prognostics). + +Time constraints forced the choice of cpp and comments instead of namelist +variables... + +NEW FILES: +cam1/models/atm/cam/src/physics/cam1/acbnd.F90 +cam1/models/atm/cam/src/physics/cam1/acsf.F +cam1/models/atm/cam/src/physics/cam1/aerosol_intr.F90 +cam1/models/atm/cam/src/physics/cam1/caerbnd.F90 +cam1/models/atm/cam/src/physics/cam1/caer.F90 +cam1/models/atm/cam/src/physics/cam1/carbon_intr.F90 +cam1/models/atm/cam/src/physics/cam1/dmsbnd.F90 +cam1/models/atm/cam/src/physics/cam1/drydep_mod.F90 +cam1/models/atm/cam/src/physics/cam1/dust.F90 +cam1/models/atm/cam/src/physics/cam1/dust_intr.F90 +cam1/models/atm/cam/src/physics/cam1/dust_sediment_mod.F90 +cam1/models/atm/cam/src/physics/cam1/scyc.F90 +cam1/models/atm/cam/src/physics/cam1/seasalt_intr.F90 +cam1/models/atm/cam/src/physics/cam1/soxbnd.F90 +cam1/models/atm/cam/src/physics/cam1/sulbnd.F90 +cam1/models/atm/cam/src/physics/cam1/sulchem.F90 +cam1/models/atm/cam/src/physics/cam1/sulemis.F90 +cam1/models/atm/cam/src/physics/cam1/sulfur_intr.F90 +cam1/models/atm/cam/src/physics/cam1/surface.F +cam1/models/atm/cam/src/physics/cam1/volcemission.F +cam1/models/atm/cam/src/physics/cam1/wetdep.F90 + +CHANGED FILES: +cam1/models/atm/cam/doc/UsersGuide/UG-20.html +cam1/models/atm/cam/bld/DefaultCAMEXPNamelist.xml +cam1/models/atm/cam/bld/camexp.pm +cam1/models/atm/cam/bld/run-ibm.csh +cam1/models/atm/cam/bld/run-pc.csh +cam1/models/atm/cam/src/dynamics/eul/inidat.F90 +cam1/models/atm/cam/src/physics/cam1/advnce.F90 +cam1/models/atm/cam/src/physics/cam1/aerosols.F90 +cam1/models/atm/cam/src/physics/cam1/cldcond.F90 +cam1/models/atm/cam/src/physics/cam1/comsrf.F90 +cam1/models/atm/cam/src/physics/cam1/initindx.F90 +cam1/models/atm/cam/src/physics/cam1/inti.F90 +cam1/models/atm/cam/src/physics/cam1/physpkg.F90 +cam1/models/atm/cam/src/physics/cam1/radctl.F90 +cam1/models/atm/cam/src/physics/cam1/tphysac.F90 +cam1/models/atm/cam/src/physics/cam1/tphysbc.F90 +cam1/models/atm/cam/src/control/filenames.F90 +cam1/models/atm/cam/src/control/intp_util.F90 +cam1/models/atm/cam/src/control/parse_namelist.F90 +cam1/models/atm/cam/test/system/ncar_batch.csh + + +=============================================================== +=============================================================== + +cam2_0_2_dev25 +Originator: jmccaa ( James Mccaa) +Date: Thu Jul 17 15:38:48 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev25 +One-line Summary: Introduction of orographic form drag and modification of gravity wave drag routines. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, linux-lf95, linux-pgf90 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes, new-physics +Changes to CLM land-model: None (one-line description) +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Modified three files: +models/atm/cam/src/physics/cam1/gw_drag.F90 +models/atm/cam/src/physics/cam1/tphysac.F90 +models/atm/cam/src/physics/cam1/vertical_diffusion.F90 + +Introduced orographic form drag in vertical_diffusion module. +Modified gravity wave drag in gw_drag module. +These changes necessitated changes to the interfaces in tphysac. + +Form drag and the new gravity wave drag algorithm are implemented only +when using the finite volume dycore. However, for the spectral dycores +the gravity wave algorithm was changed to disallow the formation of +gravity waves over pure ocean points with non-zero orographic standard +deviation. + +==================================================== +==================================================== + +cam2_0_2_dev24 +Originator: eaton ( Brian Eaton) +Date: Fri Jul 11 12:48:54 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev24 +One-line Summary: dycore independent energy fixer, only active for FV +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, pc-lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: roundoff changes in spectral dycores, fv has new physics +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Reinsert changes made at cam2_0_2_dev21 (dycore independent energy fixer active +for fv only). + +Fix bad error growth (add PERGRO condition in cldfrc.F90) + +Fix namelist problem for 64x128 sld (new dataset in DefaultCAMEXPNamelist.xml). + + +=============================================================== +=============================================================== + +cam2_0_2_dev23 +Originator: hender ( Tom Henderson) +Date: Sat Jun 21 09:41:17 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev23 +One-line Summary: Fixes for coupled runs, removal of CCM366 and LSM, other minor fixes. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Intel-Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Tony Craig, Art Mirin, and a cast of thousands +Restart files change: no +Changes answers: no (bfb with dev22) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + - Bug fix #122. (outfld calls from Jerry Olson's commit) + Modified routine diag_surf() in diagnostics.F90 so fields TSICE + and TSICE_RAD are excluded from the history files during a coupled + run. + - bugfix for ccsm_msg from Tony for fractional land + /fs/cgd/data0/tcraig/ccsm2_runs/f22.006/src.atm/ccsm_msg.F90 + - Strip out CCM366 code now that test-model tests are no longer run... + Removed all files in models/atm/cam/src/physics/ccm366/ (CCM366 + physics) and models/lnd/lsm/src/ (LSM). + - Deal with huge volume of print statements + Commented out print of "TIMEFILTER" messages per CAM CRB meeting on + 6/20/03. Modified tfilt_massfix.F90 + - Restore fv_prints.F90 as per Art Mirin's email + Got new fv_prints.F90 from sunray3:/home/mirin/outgoing/. + - Added Art Mirin's "one-line-change" to resolution_parameters.xml + Added new line for resolution=".5x.625" + + +=============================================================== +=============================================================== + +cam2_0_2_dev22 +Originator: hender ( Tom Henderson) +Date: Fri Jun 20 15:50:11 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev22 +One-line Summary: Rolled back dev21 changes (per CAM CRB). +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: none. I verified that the entire cam1 module is identical to +dev20. Testing will be done for dev23 +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: dev22 is identical to dev20 +=============================================================== +=============================================================== + +cam2_0_2_dev21 +Originator: eaton ( Brian Eaton) +Date: Wed Jun 18 13:15:50 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev21 +One-line Summary: dycore independent energy fixer, only active for FV +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC/lf95 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, boville +Restart files change: no +Changes answers: Yes. spectral dycores change to round-off. FV dycore has a physics change. +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes +Changes made: + +Add dycore independent energy fixer. Currently it is only applying an energy fix when run +with the FV dycore. For the spectral dycores it is diagnostic. + +A round-off level change was introduced into the spectral dycores due to 2 changes: +1. The definition of dry static energy was changed to include the surface geopotential. +2. The conversion between dry and wet constituent mixing ratios was moved into the coupling layer, + and an extraneous conversion that previously happened at the end of tphysbc and at the beginning + of tphysac has been removed. + +See http://www.cgd.ucar.edu/~cam/cam_checkins/ for details. + +=============================================================== +=============================================================== + +cam2_0_2_dev20 +Originator: erik ( Erik Kluzek) +Date: Mon Jun 16 12:54:27 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev20 +One-line Summary: Get rid of ccm366/lsm test in test-model.pl, clean more files in $MODEL_BLDDIR, send *.cprout files in test-model to $MODEL_EXEDIR +cam-bugs Requests resolved: 112, 118(partial) +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux(lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, hender +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB?no + +Got rid of the ccm366/lsm test in test-model.pl. + +Clean more files in the $MODEL_BLDDIR when using test-model.pl or run-model.pl +(fixes bug #112) + +Send all *.cprout files to $MODEL_EXEDIR instead of $SCRIPT_DIR this prevents +overwrites of files by different machines. This is a partial fix to bug #118. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. + http://www.cgd.ucar.edu/~cam/cam_checkins/ + for most recent and proposed checkins + +=============================================================== +=============================================================== + +cam2_0_2_dev19 +Originator: hender ( Tom Henderson) +Date: Fri Jun 13 10:28:19 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev19 +One-line Summary: Merged "science" branch into "dev" branch. +cam-bugs Requests resolved: none +Requires change in build system: Yes (see science branch documentation) +Substantial timing or memory changes: Yes (see science branch documentation) +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: many +Restart files change: yes +Changes answers: Yes (new-climate) +Changes to CLM land-model: Yes +Have you filled out the pre-check-in documentation as required by the CAM CRB? yes + http://www.cgd.ucar.edu/~cam/cam_checkins/checkin_process.shtml +Changes made: +See http://www.cgd.ucar.edu/~cam/cam_checkins/ for details of all changes +made on the science branch. + +=============================================================== +=============================================================== + +cam2_0_2_dev18 +Originator: rosinski ( Jim Rosinski) +Date: Tue Apr 8 17:09:30 MDT 2003 +Model: CAM +Version: CAM2.0_2.dev18 +One-line Summary: Speedup mods. Particularly for large number of threads (e.g. typical SGI) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes. Speedup mods. See below for details. +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Have you filled out the pre-check-in documentation as required by the CAM CRB? no but I will +Changes made: + +o Speedup mods. Should see order 10% speedup on SGI, 3% on IBM. Even better than that for + more than 32 threads on SGI. Specifics were: + - fuse threaded loops to minimize threading overhead + - Don't dereference pointers in expensive history calculations. + - Thread some calculations called from physpkg that were previously single-threaded. This + likely is the reason for such a big speedup on SGI. + +o Changed ifdef DEBUG to HDEBUG inside history.F90. Reason was model barfed somewhere in + physics when DEBUG ifdef was set. + +o Fix max/min combined with flag_xyfill=.true. pathological history case (prv commit). + +=============================================================== +=============================================================== + +cam2_0_2_dev17 +Originator: rosinski ( Jim Rosinski) +Date: Sat Apr 5 11:48:41 MST 2003 +Model: CAM +Version: CAM2.0_2.dev17 +One-line Summary: Added ISCCP cloud simulator +cam-bugs Requests resolved: none +Requires change in build system: yes (new namelist variables) +Substantial timing or memory changes: history speedup. +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +o Added ISCCP cloud simulator. Cost overhead is around 5%. You need to set + namelist variable doisccp = .true. to enable the simulator. Then + isccpdata = '/fs/cgd/csm/inputdata/atm/cam2/rad/isccp.tautab_invtau.nc' + to tell the simulator where the required boundary dataset is. + + Had to set default doisccp = .false. because test-model will barf when cprnc + gets confused at the different values of the "levels" coordinate variable. + This needs to be fixed. + + Output from the simulator is 6 fields. The key field is FISCCP1, dimensioned + lon x 49 x lat x time. The 49 is really 7 pressure levels by 7 optical + depths. Pressure and optical depth of each "level" can be determined from + dimension variable "isccp_prstau". Pressure is the number to the left of + the decimal point in mb. Optical depth is the number to the right of the + decimal point times 1000. + + The simulator is only called during daytime (coszrs > 0). As a consequence, + routine outfld in history.F90 was modified to ignore input array locations + set to fillvalue. To enable this feature, a new argument to addfld named + flag_xyfill was added. Set it to .true. to enable outfld ignoring fillvalue + input. Currently this is only done for appropriate ISCCP fields. If this + feature is enabled, for multilevel fields the setting of fillvalue MUST be + invariant in the z-direction. The reason is that the accumulator (nacs) is + currently only dimensioned x-y. The history handler checks for this + consistency and barfs if it is not met. Changing the accumulator to be + x-y-z capable would not be too hard, but might have severe performance + ramifications. + +=============================================================== + +cam2_0_2_dev16 +Originator: tcraig ( Anthony Craig) +Date: Thu Apr 3 15:51:34 MST 2003 +Model: CAM +Version: CAM2.0_2.dev16 +One-line Summary: Updates for CCSM coupling with cpl6, CCSM coupling with FV, rain/snow in coupling +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + + ccsm_msg.F90 + - Significant rewrite for cpl6, has no impact on stand-alone CAM + (Rob Jacob). + - Fixed bug in outfld call for CPLRAIN*, CPLSNOW*, CPLPRCER + (Mariana Vertenstein). + - Removed artificial repartitioning of snow and rain in fields + sent to coupler to be ready for CLM2.2. + - Fixed bug in read/write of precca, precla, precsca, precsla + (Mariana Vertenstein, Bryon Boville) + - Modified coupling for LR dycore, removed special mods for LR + dycore in sendgrid setting mask to zero at most pole latitudes. + This was required for CCSM coupled runs with the LR dycore. + + spmdinit.F90 + - Removed the MPI_INIT call for COUP_CSM mode, cpl6 now handles this. + - Removed use of shr_msg_comm_atm (cpl5). Added a call to + cpl_interface_init (cpl6) to return the MPI communicator group. + + cam.F90 + - Modified some code on COUP_CSM definitions, remove calls to + shr_msg_init, shr_msg_groups, and shr_msg_finalize (cpl5). + Added call to cpl_interface_finalize (cpl6). + + phys_grid.F90 + - Added two new routines, buff_to_chunk and chunk_to_buff (Rob Jacob). + These are used in ccsm_msg to rearrange data from a lon-lat buffer + into chunk structure. + + +=============================================================== +=============================================================== + +cam2_0_2_dev15 +Originator: jet ( John Truesdale) +Date: Wed Apr 2 08:27:51 MST 2003 +Model: CAM +Version: CAM2.0_2.dev15 +One-line Summary: Added capability to output history tape fields on a column by column basis +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Changes made: + +I've added code and a set of namelist variables that allow fields for +a particular history tape to be written on a column by column basis. +The new namelist variables are named fincl1lonlat ... fincl6lonlat and +are used in conjunction with the fincl1 ... fincl6 namelist variables. + +Here is an example of how to use the new variables to define individual +columns or a lat/lon range of columns for output. + +1. Define a history tape with a set of fields that you would like to see + output at specific columns + + ex. fincl3 = 'LHFLX','SHFLX','PS','T','U' + +2. Define the columns for that history tape using fincl[1..6]lonlat + Like the fincl[1..6] specifiers all of the column identifiers are strings. + Specify the longitude in degrees followed by a single character + (e)ast/(w)est modifier. Follow this with an underscore ('_') and then + specify the latitude in degrees followed by a single character + (n)orth/(s)outh modifier. + + ex. fincl3lonlat = '30.5e_45.5n' + + will output the model column closest to 30.5 degrees east longitude + and 45.5 degrees north latitude for all fields defined by history tape + 3. + + You can specify a range of longitudes (or latitudes) by separating + the min and max values with a colon (':') like so + + ex. fincl3lonlat = '30e:40e_45n' + + will output the closest model columns from 30 to 40 degrees east + and at 45 degrees north for all fields defined on history tape 3. + + The latitudes/longitudes must be positive (real or integer). + + longitude values range from [0w to 180w] and [0e to 180e] + latitude values range from [90s to 0s] and [0n to 90n] + +3) Variables will be put on the history tape with the longitude and latitude + coded as part of the name. + + Ex. Using these namelist variables + + fincl3 = 'LHFLX','SHFLX','PS','T','U' + fincl3lonlat = '30.5e_45.5n','30e:40e_45n' + + will produce the following fields on history tape 3. + + LHFLX_30.5e_45.5n + LHFLX_30e_to_40e_45n + PS_30.5e_45.5n + PS_30e_to_40e_45n + SHFLX_30.5e_45.5n + SHFLX_30e_to_40e_45n + T_30.5e_45.5n + T_30e_to_40e_45n + U_30.5e_45.5n + U_30e_to_40e_45n + + The netcdf attributes for each field will be set to include the + actual latitude and longitude. This allows tools like ferret + to correctly plot the correct part of the world grid. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev14 +Originator: eaton ( Brian Eaton) +Date: Thu Mar 27 15:07:31 MST 2003 +Model: CAM +Version: CAM2.0_2.dev14 +One-line Summary: fix fv restart under lf95/debug and fix bug in pseudo-ozone test tracer +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, pc-linux-lf95 +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +>> physics/cam1/restart_physics.F90 - in subroutine read_restart_physics add +>> calls to get_ncols_p inside the chunk loops and only assign the correct +>> number of columns worth of restart data into srfflx_state2d and +>> surface_state2d member arrays. +>> +>> physics/cam1/test_tracers.F90 - fix bug in subroutine test_tracers_timestep_tend. +>> All levels of the pseudo-O3 were being zeroed rather than just the bottom level. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev13 +Originator: hender ( Tom Henderson) +Date: Tue Mar 25 10:17:12 MST 2003 +Model: CAM +Version: CAM2.0_2.dev13 +One-line Summary: Fixes and upgrades to test scripts, change for omega in history output. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux-lf95 +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Erik Kluzek, Jim McCaa +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + + 1) Fixes to test-model.pl so -compare works (Kluzek). + 2) Shorten run length for SOM tests in test-model.pl (Kluzek). + 3) Script improvements to allow Wei to easily test lf95, pgf90-pgcc, and + pgf90-gcc in his automated runs (Henderson). + 4) Makefile changes to make pgf90 bfb restarts with different number of + processes work with the fv dycore (Henderson). + 5) Makefile changes to add Fortran optimization override environment + variable F_OPTIMIZATION_OVERRIDE (Henderson). + 6) test-model.pl upgrade to use F_OPTIMIZATION_OVERRIDE when pgf90 is + used for fv04-fv06 and fv10-fv13 tests (Henderson). + 7) test-model.pl upgrade to allow multiple test-model.pl incarnations to + be launched simultaneously from ncar_batch.csh (i.e. via queuing + systems) (Henderson, Kluzek). + 8) Modified ncar_batch.csh to pass the "-unique_id" option to + test-model.pl (Henderson). + 9) Changed $COMPARE_DIR/cam1 to $COMPARE_DIR in ncar_batch.csh to help + folks who use non-standard directory naming (Henderson). + 10) Upgraded CAM XML parser to latest version (Kluzek). + 11) Modified history file output to replace Omega@600mb with Omega@500mb + (McCaa and Henderson). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev12 +Originator: erik ( Erik Kluzek) +Date: Thu Mar 20 15:48:06 MST 2003 +Model: CAM +Version: CAM2.0_2.dev12 +One-line Summary: Fix bug in test-model with -compare and update XML::Lite from 0.11 to 0.14 +cam-bugs Requests resolved: 104 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Sun, Linux-PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, hender, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Update XML::Lite from 0.11 to 0.14. Creator of XML::Lite, gave us +a newer version as he said the old version had "a significant bug" +in it. + +Fix bug in -compare option for test-model.pl (bug #104). Previously +worked ok if you specified the dynamics, or for eul dynamics. It would +fail when it changed dynamics. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev11 +Originator: mirin ( Arthur Andrew Mirin) +Date: Thu Mar 13 17:21:11 MST 2003 +Model: CAM +Version: CAM2.0_2.dev11 +One-line Summary: Changes to transposes for 2D FV decomposition. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no; however one can now make with 64-bit addressing on IBM. +Substantial timing or memory changes: no +Requires change in run script: no; however, there are some new input options. +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes; however, bug in script, so could not verify. +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Will Sawyer +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None +Changes made: + + The main changes are in the area of transposes for the 2D FV decomposition. + + a. Transposes now include ghost points, which obviates extra ghost point + communication following the transposes. This improves performance, + but with limited impact because so few of the transposes involve ghost + points. + + b. Transposes now use the NASA/Goddard mod_comm package, which lies underneath + Pilgrim. This enables use of one-sided MPI-2 communications as well as + standard MPI. NASA/Goddard personnel report substantial gains on + the SGI when MPI-2 is used in place of standard MPI. + + c. Arrays containing extra points in any of the dimensions still cannot + be handled and must be copied into (out of) arrays without extra + points. Instead, the associated copies are, to the extent possible, + overlapped with other messages. This improves performance. + + d. The number of tracers to be transposed simultaneously is now specifiable. + Formerly, all tracers had to be transposed together. This facilitates + overlapping copying with communication (see above point). If there are + N tracers altogether, to be transposed in groups of M, one solves + N = Q * M + R, and does Q groups of M and 1 group of R. Preliminary + tests indicate that M=1 is good for coarse domain decompositions, + but that as the decomposition becomes finer, the latency of multiple + transpose calls outweighs the computation/communicaiton overlap + benefit. The default is M=6. + + e. A new method for initializing the transposes has been implemented. + Unlike the old methodology, this new method works for ghost points. + The method scales fine spatially but very poorly with the number of + tracers to be simultaneously transposed. Until this is fixed, + one would best limit M (see above point) to 6 (the default). + + f. We have been experimenting with MPI derived types, versus the current + method of copying data in and out of contiguous buffers. At present + we are getting mixed results. This option has been implemented for + MPI-1 only (not MPI-2). Further testing is underway. + + The files affected are: + Directory ...../src/dynamics/fv, files cd_core.F90, dp_coupling.F90, + dynamics_vars.F90, dynpkg.F90, geopk.F90, inidat.F90, + p_d_adjust.F90, pmgrid.F90, spmd_dyn.F90, stepon.F90, trac2d.F90. These are virtually all transpose-related changes. + + Directory ...../src/control, files cam.F90, spmdinit.F90. + The change to cam.F90 is to make sure TWOD_YZ is not set when SPMD + is unset. The change to spmdinit.F90 has to do with MPI + initialization on SGI machines when using MPI-2. + + Directory ...../utils/pilgrim, files Makefile, Makefile.conf.AIX, + Makefile.conf.IRIX64, decompmodule.F90, ghostmodule.F90, memstuff.c, + mod_comm.F90, parutilitiesmodule.F90, puminterfaces.F90, + redistributemodule.F90. + + Directory ...../utils/pilgrim/unit_testers, files Makefile, + decomptest.F90, ghosttest.F90, parpatterntest.F90, + parutilitiestest.F90, redistributetest.F90, unstructured.F90. + + Directory ...../bld, files Makefile, configure_fv.pl, script.m4. + The change to Makefile is to provide option for 64-bit addressing + on IBM. To do so, switch actual and commented lines to set + ADDRESS := Q64. The other two files are NASA/Goddard-specific. + + Directory ...../test/system, file llnl_frost.csh. + + A full diff of changes is on goldhill in ~mirin/diffs/diff_archive_cam2_0_2_dev10. + + Here is some information on new, as well as existing knobs: + + Two parameters have been added to the mprun2d namelist (used for 2D FV + decomposition) - geopktrans and tracertrans. Geopktrans refers to the + geopotential computation/communication method in geopk.F90. A value + of 0 (default), which results in the setting of geopk16byte false, + means that transposes are computed before and after the calls to + geopk (from cd_core) in order to do the vertical indefinite integrals + in geopk. A value of 1 causes geopk16byte to be set to true, + meaning that instead of computing transposes, partial sums in each + vertical subdomain are calculated and then communicated in z as + needed; 16-byte arithmetic may be used to guarantee bit-for-bit agreement + across domain decomposition; the default (for purposes of speed) is + 8-byte arithmethic. One can change to 16-byte arithmetic by editing + geopk.F90 to change DSIZE from 8 to 16 (switch actual and commented + statements). For performance purposes, the code should be used + as is with geopktrans equal to 1. The other parameter, tracertrans, + refers to the number of tracers simultaneously transposed (denoted by + M above); the default is 6 and in general need not be changed. + + One can implement MPI derived types in the transposes by activating + USE_MPI_TYPES in models/utils/pilgrim/parutilitiesmodule.F90. + This is unsupported - do so at your own risk. This bypasses mod_comm + and works for only MPI-1. One can make use of MPI-2 in mod_comm by + activating MPI2 at the beginniing of mod_comm.F90. Use of this is + definitely at your own risk. + + To run waccm configuration tests, please see instructions on goldhill + in ~mirin/waccm. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev10 +Originator: hender ( Erik Kluzek, tagged by Tom Henderson) +Date: Wed Mar 12 13:46:38 MST 2003 +Model: CAM +Version: CAM2.0_2.dev10 +One-line Summary: Added SOM test to test-model.pl. Various bug fixes. Update to ESMF_0_0_2p8 +cam-bugs Requests resolved: 101, 100, 99 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: yes, if running with new SOM +-som option in configure now works. Default will behave as before. +Substantial timing or memory changes: no +Requires change in run script: yes, if running with new SOM +Must use initial and SST datasets that are compatible with SOM. See +/ftp/pub/erik/cam2_0_2.scidac-atm.datasets.tar.gz +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Intel-Linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Jim Rosinski, Erik Kluzek, Brian Eaton, Tom Henderson +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes to ESMF library: Update to ESMF_0_0_2p8, a pruned version of ESMF_0_0_2p5 +Changes made: + +Added SOM test to test-model.pl and fixed bugs: + +Add a SOM test for all dycores and for the control library. +Add new datasets needed for running with SOM. Reset namelist +each test in test-model.pl to make test-model.pl more robust. +Add a no-fail option to cam_timing so that when using -nofail +if a simulation aborts test-model.pl won't stop. Fix reporting +problem of different history files with -nofail. Improve the +diagnostic output of test-model.pl especially for the -nofail +case. Also be more careful at cleaning up data, such that data files +are deleted only after needed comparisions are done. + +New datasets are available under "datasets" on the cam developers +web page. + +Put, support message about ESMF in Makefile. + +U atm/cam/bld/DefaultCAMEXPNamelist.xml +U atm/cam/bld/Makefile +U atm/cam/doc/UsersGuide/test-model.html +U atm/cam/test/system/CAM_test.pm +U atm/cam/test/system/cam_timing.pm +U atm/cam/test/system/test-model.pl + +Bug fixes to make Lahey compiler happy: +U atm/cam/src/ocnsice/som/ocn_srf.F90 +U atm/cam/src/dynamics/fv/inidat.F90 +U atm/cam/bld/configure + +Changed these ESMF files to allow for removal of lots and lots of other +ESMF files: + +Update to ESMF_0_0_2p8, so can prune out unused files and directories. +Also turn off dependency of OMP, PCL, and MPI libraries. This simplifies, +shortens, and makes the ESMF make more robust. It also removes half of the +amount of disk storage for ESMF than was used before, several of the unused +code directories were removed and only the minimal set needed for using +the ESMF time manager. + +U utils/esmf/README +U utils/esmf/build/IRIX/ESMF_conf.h +U utils/esmf/build/IRIX64/ESMF_conf.h +U utils/esmf/build/alpha/ESMF_conf.h +U utils/esmf/build/linux_gnupgf90/ESMF_conf.h +U utils/esmf/build/linux_lf95/ESMF_conf.h +U utils/esmf/build/linux_pgi/ESMF_conf.h +U utils/esmf/build/rs6000_64/ESMF_conf.h +U utils/esmf/build/rs6000_64/base_variables +U utils/esmf/build/rs6000_sp/ESMF_conf.h +Ripped out lots and lots of ESMF files: +... + +Upgraded to simplify automated testing on anchorage with pgf90-pgcc and +pgf90-gcc: +U atm/cam/test/system/ncar_batch.csh + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev9 +Originator: rosinski ( Jim Rosinski) +Date: Wed Feb 26 17:59:48 MST 2003 +Model: CAM +Version: CAM2.0_2.dev9 +One-line Summary: Added SOM capability. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) except Linux-pgf90 is only roundoff +Changes to CLM land-model: None +Changes made: + +o Added Slab Ocean Model (SOM) capability. To enable, change som/ to dom/ +in Filepath, and add #define COUP_SOM in misc.h. + +For prescribed-ice control runs that will create fluxes for SOM, to get +good results CNTL_FORSOM must also be #defined. + +Climates have only been examined in EUL mode. SLD and FV do compile, but they +have not yet been tested. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev8 +Originator: jet ( John Truesdale) +Date: Wed Feb 19 16:51:27 MST 2003 +Model: CAM +Version: CAM2.0_2.dev8 +One-line Summary: fix bug in srface diagnostic variables - fsnslnd fsnsocn etc +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no + +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Changes made: +These mods were to fix a bug with the newly added surface diagnostics. +They were not giving bit for bit when restarting fv and sld runs. To +fix this I had to add some variables to the restart dataset +as well as put a n-1 timelevel of landfrac,ocnfrac,and icefrac into the +physics buffer. These n-1 timelevel values are used from the physics +buffer on restart. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev7 +Originator: hender ( Tom Henderson) +Date: Mon Feb 10 09:49:09 MST 2003 +Model: CAM +Version: CAM2.0_2.dev7 +One-line Summary: Grab bag -- Makefile, script, and source code fixes for SGI, Linux (PGI and Lahey), IBM +cam-bugs Requests resolved: 92, 88 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Lots of accumulated minor fixes for SGI, Linux, IBM. All bfb. Biggest change +is support for Linux-Lahey in source code and ncar_batch.csh. Brian Eaton, +Pat Worley, John Truesdale, Jim Rosinski, and Erik Kluzek contributed various +bits. +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Makefile, run-ibm.csh, ncar_batch.csh, ice_srf.F90, comsrfdiag.F90, +fv_prints.F90, test-model.pl (and files it uses) +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux-Lahey +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Brian Eaton (SGI bits in Makefile), Jim Rosinski +(Linux-Lahey bits in Makefile), John Truesdale (John made the fixes for +ice_srf.F90, comsrfdiag.F90, and fv_prints.F90), Erik Kluzek (Erik made the +fixes for test-model.pl) +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: +Note: This is item #018 on CAM Check-in List "Fix performance bug in Makefile + for SGI (formerly CAM task list #02.12.19.5)". It's scope has expanded + a bit. +A- Modified Makefile for SGI so LDFLAGS has options and libraries in the + correct order ( -mp -lmp -lmpi ) as described by Pat Worley. +B- Added Brian Eaton's fix for run-ibm.csh: + "On the IBM there are 3 environment variables that allow you to specify the + node/task configuration. The 2 that are set in the run-ibm.csh file imply + that the total number of mpi tasks (procs) is 2. It's likely that your job + has procs=1 due to the 3rd environment variable, MP_PROCS, being set + somewhere else, like your .cshrc or .profile file (perhaps by the SCD + supplied default version of these files). The fix I'd suggest is to add + the command "unsetenv MP_PROCS" to run-ibm.csh file in the POE Environment + settings section." -- Brian Eaton +C- Added Brian Eaton's fix for run-ibm.csh to ncar_batch.csh too. +D- Added support for the Lahey compiler on anchorage to ncar_batch.csh. PGI + becomes an option, Lahey the default. +E- Added John Truesdale's fixes for ice_srf.F90, comsrfdiag.F90, and + fv_prints.F90. This allows versions cam2_0_2_dev1 and later to work + with the Lahey compiler. Prior to these fixes, lf95 was complaining about + unintialized variables (etc.). +F- Erik Kluzek fixed test-model.pl to work around a problem on bluesky. +G- Changed pgf90 optimization from -fast to -O1 in Makefile to fix bfb problem + with test-model.pl test #fv06 (compare initial run to restart run with + different number of processors for fv dycore). All other tests were + passing bfb with -fast. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev6 +Originator: pworley ( Patrick H Worley) +Date: Wed Feb 5 15:19:36 MST 2003 +Model: CAM +Version: CAM2.0_2.dev6 +One-line Summary: New 1D decomposition for Fourier and Spectral domains in SLD dycore, for improved performance +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes, faster for large processor counts +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: No (bit-for-bit) on SGI and Compaq; Yes (same-to-roundoff) on IBM +Changes to CLM land-model: changed division by parameter to division by local copy in lnd_grid, to eliminate compiler complaint +Changes made: + +Implemented a consistent wavenumber decomposition for Fourier +and Spectral domains in SLD dycore, decreasing MPI communication and +storage requirements. Wavenumber decomposition also modified, +to improve load balance and decrease amount of communication. +This modification is similar to that in cam2_0_1_dev3, except for +SLD instead of EUL. + +Routines modified in dynamics/sld: comspe, courlim, dyn, dyndrv, +dynpkg, grcalc, hordif, quad, realloc4, realloc7, scan2, scandyn, +scanslt, spegrd, spmd_dyn, trunc, tstep, tstep1, vertnm. +Routines deleted in dynamics/sld: realloc3, realloc6 . + +Also, changed division by parameter to division by a local +copy of the parameter in two places in lnd_grid, to eliminate +a compilation failure with some versions of the IBM compiler. +(Fix provided by Art Mirin.) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev5 +Originator: eaton ( Brian Eaton) +Date: Tue Jan 21 12:33:04 MST 2003 +Model: CAM +Version: CAM2.0_2.dev5 +One-line Summary: makefile/configure changes +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, pc-linux +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Add ability to specify additional flags to the C compiler and to the loader +(this ability already exists for the Fortran compiler). This provides +flexibility in porting to new platforms. + +Change Makefile so that the Filepath, Srcfiles, and Depends files are +explicitly in the current directory. This fixes a bug which occurs when +make finds a Srcfiles file in the VPATH, and that Srcfiles is newer than +the Filepath (which results in Srcfiles not being created in the current +directory and the command to build the Depends file fails). + +Add an option to configure to allow the configuration cache file to be +created in a different directory than the CAM build directory. The default +behavior of configure is unchanged. + +Fix a broken configuration. The combination of omp on linux using pgf90 +and gcc resulted in the timing library being built without threading +enabled. Removed the setting of the THREADED_PTHREADS and THREADED_OMP cpp +macros from utils/timing/gpt.h and set these in the Makefile. This also +allows them to be set only when SMP is true. They were previously set to +use threads whether the rest of the model was threaded or not. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev4 +Originator: hender ( Tom Henderson) +Date: Fri Jan 17 11:23:15 MST 2003 +Model: CAM +Version: CAM2.0_2.dev4 +One-line Summary: ncar_batch.csh: added support for test-model.pl with -compare option +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + +The new ncar_batch.csh can be used to do bitwise comparison with a previous +source version. The test-model.pl script is run internally with the -compare +option. + +For NQS or PBS, the new usage is: +>> env SCRIPT_DIR=`pwd` COMPARE_DIR=$MYBASEDIR qsub ncar_batch.csh + +For LoadLeveler, the new usage is: +env SCRIPT_DIR=`pwd` COMPARE_DIR=$MYBASEDIR llsubmit ncar_batch.csh + +In both cases, directory $MYBASEDIR should contain the source code for the +previous version. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev3 +Originator: jet ( John Truesdale) +Date: Mon Jan 13 08:53:33 MST 2003 +Model: CAM +Version: CAM2.0_2.dev3 +One-line Summary: Added diagnostics for surface budget calculation, moved sst/ocn interpolation to correct minor flux bug +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Apache +Ran test-model.pl script: yes: Only on IBM +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: Yes (new-physics) +Changes to CLM land-model: None (one-line description) +Changes made: + +Added diagnostics to allow for surface energy budget calculations. The +following diagnostics were added: + +FSNSLND,FSNSOCN,FSNSICE,FLNSLND,FLNSOCN,FLNSICE,SHFLXLND,SHFLXOCN,SHFLXICE, +LHFLXLND,LHFLXOCN,LHFLXICE. + +Also added the following diagnostics to provide ocean/ice forcing for som +model + +FSNSOI,FLNSOI,SHFLXOI,LHFLXOI + +Moved the interpolation of ocean and ice right before the surface routines +that use them. SSTINT and ICEINT were previously at the top of the time +loop before tphysbc in the routine advnce. I removed them from advnce and +placed them after tphysbc right before camocn and camice. This corrected +a minor bug in the models use of fluxes calculated by camocn and camice. +Previously new fluxes were computed by camocn and camice with a set of +land, ocean, and ice fractions. The time loop ended, advnce was called, +new surface fractions computed and then tphysbc used the fluxes calculated +the previously time around only using the new fractions instead of the +surface fractions used to compute the fluxes. tphysbc now uses the time +level of fractions appropriate for the fluxes that are being read in. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev2 +Originator: rosinski ( Jim Rosinski) +Date: Thu Jan 9 17:16:38 MST 2003 +Model: CAM +Version: CAM2.0_2.dev2 +One-line Summary: Add evap bugfix to ice_srf.F90 per C. Bitz +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) or Yes (same-to-roundoff, same-physics, new-physics, new-climate) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Changes made: + +o One-line chage adds sublimation over sea ice to evaporative flux in ice model. + Changes answers beyond roundoff. Analysis of effects of this change available at: + www.cgd.ucar.edu/cms/rosinski/analysis/20shrconstevap-cam20shrconst/sets.htm + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_2_dev1 +Originator: hender ( Tom Henderson) +Date: Mon Jan 6 15:25:38 MST 2003 +Model: CAM +Version: CAM2.0_2.dev1 +One-line Summary: Minor improvements to batch execution of test-model and User's Guide updates +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and Erik +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Description: + CAM_lab.pm Update linux defaults + CAM_test.pm Fixed bug so "FAIL" is printed when a test fails (instad of + "ran"). Only affected the -nofail option. + ncar_batch.csh Updated to chinook "ded_16" queue and added PBS stuff for + anchorage. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev17 +Originator: erik ( Erik Kluzek) +Date: Fri Dec 20 15:42:18 MST 2002 +Model: CAM +Version: CAM2.0_1.dev17 +One-line Summary: Small script change for testing, Makefile change to run on Compaq +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, Sun, Linux-Lahey, Linux-PGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + +Point to new test-production.pl baseline. + +Change Makefile to run on Compaq. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev16 +Originator: mvertens ( Mariana Vertenstein) +Date: Thu Dec 19 14:31:58 MST 2002 +Model: CAM +Version: CAM2.0_1.dev16 +One-line Summary: updated cam documentation for cam2_0_2 release +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: None +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: +Updated cam documentation for cam2_0_2 release. +Clm documentation has already been updated. +Did not modify any code. +=============================================================== +=============================================================== + +cam2_0_1_dev15 +Originator: mvertens ( Mariana Vertenstein) +Date: Wed Dec 18 21:19:12 MST 2002 +Model: CAM +Version: CAM2.0_1.dev15 +One-line Summary: updated clm to clm2_deva_08 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: (see below) + tested that clm2_deva_08 worked with CCSM +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes +Changes made: +1) Updated clm user's guide to clm2.1 +2) Fixed restart problem for clm2.1 auxiliary history files +=============================================================== +=============================================================== + +cam2_0_1_dev14 +Originator: erik ( Erik Kluzek) +Date: Tue Dec 17 16:14:46 MST 2002 +Model: CAM +Version: CAM2.0_1.dev14 +One-line Summary: Fix script problems use new datasets, update to ccsm2_0_beta61 +cam-bugs Requests resolved: 76, 79, 84, 85 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes (IBM) +Machines tested: IBM, SGI, Sun, Linux (PGI,Lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) -- Except Z050 field changes! +Changes to CLM land-model: None + +New datasets: + + Add capability for 1x1.25 for FV. Use new datasets for FV 2x2.5. + Download the new cam2.0.2 set of SCIDAC datasets for use with + this version of the model. + +Fix test-model.pl bug in comparision: + + Fix comparision problem in test-model.pl. Also fix so that + doesn't use as much disk-space. And change so that does + a error-growth test with the control code. + +Fix build-namelist bug: + + Fix bug in writing out long lists. + +Fix bug in Z050: + + Z050 was 5 mbar surface rather than 50 mbar surface. + +Fix PGI bug for open-MP processing: + + Delete a specific OpenMP loop in dynamics/fv/inidat.F90 that + caused answers to change with number of processors. + +Update to ccsm2_0_beta61: + + Update models/bld and scripts to ccsm2_0_beta61. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev13 +Originator: mvertens ( Mariana Vertenstein) +Date: Mon Dec 9 09:49:17 MST 2002 +Model: CAM +Version: CAM2.0_1.dev13 +One-line Summary: clm code updated to development tag clm2_deva_07 (clm2.1 code) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +New (converted) clm initial datasets must be used +see DefaultCLMEXPNamelist.xml +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, Sun, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: Yes (for clm only) +Changes answers: Yes (same-to-roundoff, same-climate) +Changes to CLM land-model: YES (updated to clm2.1 data structures) +Changes made: + +1) clm2.1 has replaced clm2.0 in the current code. + updated models/lnd/clm to clm development tag clm2_deva_07 + The differences are roundoff. + Two climate simulations were done to verify this commit. + case: /OLESON/csm/eul_201dev10 - cam2_0_1_dev10 (clm2.0) + case: /OLESON/csm/eul_201dev10_06 - cam2_0_1_dev10 (clm2.1 - tag clm2_deva_06) + The two cases were been compared with the standard climatological SST simulation + using CAM2.0.dev24 (case eul20dev24_a) and show the same climate + Performance on blackforest is effectively the same. + +2) initial clm datasets used with clm2.0 are no longer compatible with clm2.1 + surface datasets used with clm2.0 will work with clm2.1 + restart files used with clm2.0 are not compatible with clm2.1 + a conversion tool has been created (see directory models/lnd/clm2/tools/convert_inic) + running gmake in this directory will generate the conversion tool executable, convert_inic + datasets needed by configure have already been converted and have been placed in the + directory /fs/cgd/csm/inputdata/lnd/clm2/inidata_2.1/cam + +3) the xml file DefaultCLMEXPNamelist.xml in models/atm/cam/bld has been modified + to point to the converted clm2.1 initial datasets + +4) the following tests were done using test-model.pl: + tests platform status + ------------------------------------------------------------------ + eul:1-6:64x128L26 ibm (blackforest) success + eul:1-6:64x128L26 sgi (chinookfe) success + eul:1-6:64x128L26 linux (apache) lf95, pgf90 success + eul:1-6:64x128L26 sun (flagstaf) success + eul:1-6:64x128L26 compaq (ornl-colt) cannot test due to know problem starting with + cam2_0_1_dev10 on compaq + eul:1-6:48x96L26 ibm (blackforest) success + eul:1-6:48x96L26 sgi (chinookfe) success + eul:1-6:48x96L26 linux (apache) pgf90 success + eul:1-6:48x96L26 sun (flagstaf) success + eul:1-6:48x96L26 compaq (ornl-colt) cannot test due to know problem starting with + cam2_0_1_dev10 on compaq + fv:1-6:2x2.5L26 ibm (blackforest) success + fv:1-6:2x2.5L26 sgi (chinookfe) success + fv:1-6:2x2.5L26 linux (apache) lf95 success (know problem with pgf90 on restart due to openmp) + fv:4-6:2x2.5L26 sun (flagstaf) success + fv:1-6:2x2.5L26 compaq (ornl-colt) cannot test due to know problem starting with + cam2_0_1_dev10 on compaq + sld:1-6 ibm (blackforest) success + sld:1-6 sgi (chinookfe) success + sld:1-6 linux (apache) lf95 success + sld:1-6 sun (flagstaf) success + sld:1-6 compaq (ornl-colt) cannot test due to know problem starting with + cam2_0_1_dev10 on compaq + sld:1-6:64x128L26 ibm (blackforest) success + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev12 +Originator: eaton ( Brian Eaton) +Date: Tue Nov 26 17:48:40 MST 2002 +Model: CAM +Version: CAM2.0_1.dev12 +One-line Summary: new physics buffer and misc makefile changes +cam-bugs Requests resolved: none +Requires change in build system: yes +ccm366 physics now requires pnats=0 (done by configure) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, pc-linux-lf95 +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: yes, one fewer timelevel saved for cld, tcwat, qcwat, +and lcwat fields. +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Implement new physics buffer (phys_buffer.F90) to manage fields that +persist across timesteps or that are communicated between different physics +packages within a time step. Eventually the buffer.F90 module will be +replaced. For now only the fields used by the stratiform cloud condensate +scheme are being managed by the physics buffer. + +The new module in cldcond.F90 is the start of an implementation of the new +physics interface for the cloud condensate parameterization. It currently +just deals with the fields that use the physics buffer. These fields save +a dycore dependent number of timelevels in the buffer, and that number has +been reduced by one from the buffer.F90 implementation (i.e., eul saves 2 +old timelevels while fv and sld just save one). + +Removed the need to declare pnats=1 for a cloud water constituent which +wasn't used when running with ccm366 physics. The configure script now +sets pnats=0 in that case. + +Modify Makefile, configure, and config_cache_defaults.xml to support using +netCDF f90 interface. The environment variable MOD_NETCDF should be set to +the directory that contains the netCDF module files. This capability is not yet +required as CAM isn't currently using the netCDF Fortran 90 interface. + +Added -qmaxmem=-1 to the AIX fflags for optimization. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev11 +Originator: eaton ( Brian Eaton) +Date: Thu Nov 21 19:12:10 MST 2002 +Model: CAM +Version: CAM2.0_1.dev11 +One-line Summary: constituent initialization mods +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, pc-linux-lf95 +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no, except for a specific non-production configuration described below +Changes to CLM land-model: None +Changes made: + +Implemented mods to allow specifying for each constituent whether the +initial values are to be read from the initial file or set by an +initialization routine. The namelist variable readtrace now serves to set +the default value for all constituents except water vapor (its default +value is .true.). The default may be overridden by an optional argument in +the calls that register the constituents. The optional argument may be set +by namelist variables that are managed by the constituent's package, or may +be hardwired in the call. The ghg chemistry package uses the default value +determined by readtrace. The test_tracers package hardwires the initial +values to be set by an initialization routine. Thus it is no longer +necessary to set readtrace=.false. to run the test_tracer package in CAM. +The namelist variables nusr_adv and nusr_nad have been disabled. + +In the FV dycore only, the initialization of constituents has been modified +to initialize one constituent at a time. This is to reduce the memory +requirements since we couldn't fit the waccm configuration (2x2.5, 66 +levels, 50 constituents) on the ibm-winterhawk2 nodes. + +The mods do not change answers in the production model. However the +following configuration has non-bfb changes: When the ghg chemistry is run +using initial values that are set by its initialization routine (rather +than being read from the initial file), the answers change due to changed +initial values. The ghg initial values are set with uniform distributions +rather than having a decay in the stratosphere as was previously done. +Byron believes this distribution will spin up to an equilibrium state more +quickly than the previous initial distribution. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev10 +Originator: eaton ( Brian Eaton) +Date: Thu Nov 14 19:03:59 MST 2002 +Model: CAM +Version: CAM2.0_1.dev10 +One-line Summary: fix some uninitialized variables so lf95 debug mode works +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, pc-linux-lf95 +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself. Pat Worley provided the mods. +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + +These mods fix a couple of references to uninitialized variables that caused a +runtime error in executables built w/ lf95 and strict error checking. +The test-model.pl debug test (test 1) now works on all dycores with lf95. +Also fixed a couple of incorrect intent attributes. + +Mods: +dynamics/{eul,sld}/linemsdyn.F90 - init vcour to 0. +vmax2d, vmax2dt, and vcour declared intent(inout) in +1) sld/realloc7.F90 +2) sld/dyndrv.F90 (in both PVP and nonPVP branches) +3) sld/courlim.F90 +cam1/radctl.F90 - fix outfld call for qrl + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev9 +Originator: eaton ( Brian Eaton) +Date: Thu Nov 14 09:31:24 MST 2002 +Model: CAM +Version: CAM2.0_1.dev9 +One-line Summary: change AIX optimization from O3 to O2 +cam-bugs Requests resolved: 75 +Requires change in build system: no +Substantial timing or memory changes: didn't do performance tests +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + +Makefile changes for AIX only: +O3 --> O2, and remove -qstrict which is only needed with -O3 +Use -qsmp=omp:noopt in debug mode. + +Surprisingly (at least to me) the answers are bfb when changing from "-O3 -qstrict" to "-O2". + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev8 +Originator: forrest ( Forrest Hoffman) +Date: Wed Nov 13 12:37:22 MST 2002 +Model: CAM +Version: CAM2.0_1.dev8 +One-line Summary: Fix for new code introduced in cam2_0_1_dev7 that caused run-time failures on SGI and Linux +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM (cheetah), SGI (thanks to Mariana Vertenstein) +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Mariana Vertenstein +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Fixes to lp_coupling +Changes made: + +Replaced intent(out) with intent(inout) for srfflx to avoid passing +undefined elements back to the atmosphere physics since only land point +values are filled. This problem was exhibited under SGI IRIX and +Linux. + +Added working scalars to the private clause of the OpenMP do parallel +statements to assure appropriate scope. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev7 +Originator: forrest ( Forrest Hoffman) +Date: Fri Nov 8 15:46:07 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: introduced clump land model decomposition and implemented new alltoall comm between atm and lnd +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes, about 7x speedup in cam<->clm communications (only) +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Mariana Vertenstein, Pat Worley +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: New land model decomposition on clumps and alltoall comunication for CAM+CLM configuration +Changes made: + +1. Added new subroutine get_chunk_coord_owner_p() to phys_grid for + both cam1 and ccm366 versions. + +2. Added lnd_grid module containing the following: + + public surface_grid_init ! initializes land surface decomposition + public get_nclumps ! returns the number of clumps defined + public get_clump_cell_id_coord ! returns clump/cell ids based on lon/lat + public get_clump_owner_id ! returns clump owner based on clump id + public get_clump_ncells_proc ! returns number of cells for process + public get_clump_ncells_id ! returns number of cells in clump + public get_clump_tpatch_proc ! returns number of patches for process + public get_clump_tpatch_id ! returns number of patches in clump + public get_clump_coord_id ! returns lon/lat coordinates based on id + public get_clump_patchinfo ! returns patch id and number of patches + public get_clump_patchwt ! returns patch weight based on patch num + + surfage_grid_init() performs the land model domain decomposition into + clumps of grid cells containing patches. Clumps are private derived + data types which may be accessed through a suite of functions and + subroutines also contained in lnd_grid (see above). + +3. Added lp_coupling module containing the following: + + public lp_coupling_init ! initialize clump<-->chunk mapping + public lp_coupling_finalize ! destroy clump<-->chunk mapping + public alltoall_clump_to_chunk_init ! communicate fluxes from lnd to atm + public alltoall_clump_to_chunk ! communicate fluxes from lnd to atm + public alltoall_chunk_to_clump ! communicate fluxes from atm to lnd + + lp_coupling_init() initializes the mapping between atmosphere + physics chunks and land model clumps. It also allocates buffers + for use by subroutines within the module which perform the alltoallv + communication/transposition of surface state and fluxes between the + atmosphere and the land. This coupling is used when CAM and CLM are + run together as a single executable (when COUP_CAM is defined). + +4. Removed lnd_atmMod module which previously did processor mapping + for coupling. + +5. Modified atm_lndMod module to use routines from lp_coupling for coupling. + Added TIMING_BARRIERS barriers for communications timing tests. + +6. Modified clm_map subroutine to call surface_grid_init() (lnd_grid) for + domain decomposition and lp_coupling_init() (lp_coupling) to initialize + the atm<->lnd coupling. + +7. Added npes=1 definition even for the case when SPMD is undefined so + that new domain decomposition works correctly when running SMP-only. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev6 +Originator: pworley ( Patrick H Worley) +Date: Wed Nov 6 22:34:11 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: Fixed minor bugs introduced in cam2_0_1_dev3 that were found with Lahey and SGI compilers +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + + All changes in dynamics/eul only: + + 1) Modified courlim and dyndrv to change intent of vmax2d, + vmax2dt, and vcour from in to inout. + 2) Modified grcalc to set dalpn(2) to zero on processors + that do not calculate it. This eliminates a failure in + the SGI test-model DEBUG tests from using an uninitialized + variable. (dalpn(2) is used to calculate zurcor, which is + used only on the processor which also calculates dalpn(2). ) + 3) Moved an array initialization using array syntax + out of an OpenMP loop, as a + work around for a pgf90 compiler error. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev5 +Originator: bshen ( Bo-Wen Shen) +Date: Wed Nov 6 09:22:18 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: Changed DAO scripts +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: Yes (in DAO scripts) +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) + +Changes to CLM land-model: None (one-line description) +Changes made: + + + Modified DAO scripts (configure_fv.pl and script.m4) to run +the model on DAO SGI machines. + + 1. Defined SMP in Make.macros when OpenMP is used + to run a hybrid mode on SGI. + 2. Changed the way to call system_cmd, which is + written in C and does not accept a function name + (trim in this case) as an argument on DAO SGI. + 3. Modified mswrite/msread which will generated at run time + 4. Calculated total # of CPUs and passed the # to PBS + directives + + +=============================================================== +=============================================================== + +cam2_0_1_dev4 +Originator: eaton ( Brian Eaton) +Date: Wed Oct 30 07:46:47 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: implement ghg surface values module +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, pc-linux +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +This set of mods is in preparation for further mods to implement the new +physics interface design for initializing constituents. The current loop +to initialize constituents that are not read from the initial file (in +{eul,fv,sld}/inidat.F90) contains a call to ramp_ghg(). This function sets +surface values for the ghg constituents which are used by the radiation +codes as well as by the ghg chemistry code. The mods being committed +gather the code which is responsible for setting surface values of the ghg +constituents, and time interpolating them (ramping) from an annual dataset +if requested, into the single module in the file ghg_surfvals.F90. + +The new module ghg_surfvals does the following: +. maintains the values co2vmr, co2mmr, n2ovmr, ch4vmr, f11vmr, and f12vmr + as public data +. maintains the namelist variables scenario_ghg and rampyear_ghg. The + meaning of these variables has not changed. +. provides ramping functionality (time interpolation) when scenario_ghg is + set to 'RAMPED'. The data used by the ramp is determined by an include + statement in the module. Either file ramp_ghg_bau.h or ramp_ghg_stab.h + may be included. These .h files contain data formated as module data. + When using ramped data the default is to interpolate to the current + time. This may be modified by setting the rampyear_ghg variable to a + valid year which is then used to produce values that will cycle within + that fixed year. + +Files added: +physics/{cam1,ccm366}/ghg_surfvals.F90 + +Files removed: +physics/{cam1,ccm366}/ramp_ghg.F90 +physics/ccm366/comvmr.F90 + +Files changed: +control/preset.F90 +control/parse_namelist.F90 +control/comctl.h +control/restart.F90 +physics/cam1/constituents.F90 +physics/cam1/{chemistry.F90,radae.F90,radini.F90,trcmix.F90} +physics/cam1/ramp.h +physics/cam1/{ramp_ghg_bau.h,ramp_ghg_stab.h} +physics/cam1/crdcon.h +physics/cam1/radini.F90 +physics/cam1/{radcswmx.F90,trcpth.F90} +physics/cam1/advnce.F90 +physics/ccm366/ramp_ghg.F90 +physics/ccm366/{ramp_ghg_bau.F90,ramp_ghg_stab.F90} +physics/ccm366/constituents.F90 +physics/ccm366/{radabs.F90,radems.F90,radinp.F90} +physics/ccm366/radini.F90 +physics/ccm366/crdcon.h +physics/ccm366/{radcsw.F90,trcpth.F90} +physics/ccm366/trcmix.F90 +physics/ccm366/chemistry.F90 +physics/ccm366/physconst.F90 +physics/ccm366/inidat.F90 +physics/ccm366/advnce.F90 +dynamics/{eul,fv,sld}/inital.F90 +dynamics/{eul,fv,sld}/inidat.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev3 +Originator: pworley ( Patrick H Worley) +Date: Sun Oct 27 18:17:22 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: New 1D decomposition for Fourier and Spectral domains in EUL dycore, for improved performance +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: Yes, faster for large processor counts +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: John Drake, Michael Ham +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + Implemented a consistent wavenumber decomposition for Fourier + and Spectral domains in EUL dycore, decreasing MPI communication and + storage requirements. Wavenumber decomposition also modified, + to improve load balance and decrease amount of communication. + Routines modified: comspe, dp_coupling, dyn, dyndrv, + dynpkg, grcalc, hordif, linemsdyn, quad, realloc4, realloc7, scan2, + scandyn, scanslt, spegrd, spmd_dyn, trunc, and tstep. Also, + realloc3 and realloc6 no longer needed and deleted. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev2 +Originator: pworley ( Patrick H Worley) +Date: Sun Oct 27 09:10:31 MST 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: In-lined two temporaries in grcalc, so that new EUL dom. decomp. will be bit_for_bit on the IBM in next check-in +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and Jim Rosinski +Restart files change: no +Changes answers: no on Compaq, yes on IBM (same-to-roundoff, same-physics) +Changes to CLM land-model: None +Changes made: + + Eliminated tmpr and tmpi in grcalcs and grcalca in dynamics/eul/grcalc.F90: + + tmpr = alps(ir)*alp(mr+n,irow) + tmpi = alps(ii)*alp(mr+n,irow) + + in-lining the expressions in the two places where each + of them is used.This causes roundoff level changes to the solution + on the IBM, but not on the HP/Compaq. With this change, the restructuring + of the domain decomposition used in the spectral Eulerian (next check-in) + will be bit-for-bit. This check-in is used to isolate and document + the source of the roundoff change. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_1_dev1 +Originator: sawyer ( William Barton Sawyer) +Date: Sun Oct 20 00:53:30 MDT 2002 +Model: CAM +Version: CAM2.0.1 +One-line Summary: Bug fix for tracer advection (from S.-J. Lin) +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit +Changes to CLM land-model: None +Changes made: + + Retagged cam2_0_dev26 to confirm with new tagging scheme. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev26 +Originator: sawyer ( William Barton Sawyer) +Date: Fri Oct 18 07:48:14 MDT 2002 +Model: CAM +Version: CAM2.0.dev26 +One-line Summary: Bug fix from FVGCM for multiple advected constituents (S.-J. Lin) +cam-bugs Requests resolved: unlisted +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Lin +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + src/dynamics/fv/trac2d.F90: bug fix, dp2 copy to dp1 + moved from above label 5000 to between labels 5000 and 6000 + + bld/script.m4: changes to avoid runtime errors in DAO runs + which resulted from bug fix 64 (shell cmd now returns error code). + + Note: test-model.pl is successful but does not test the + multiple advected constituent case. This change will be + further tested by DAO runs. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev25 +Originator: erik ( Erik Kluzek) +Date: Wed Oct 2 08:33:38 MDT 2002 +Model: CAM +Version: CAM2.0.dev25 +One-line Summary: Fix run-pc.csh script. +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: Linux-PGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + +Fix run-pc.csh so will run without a core-dump on apache. To do this +I changed it from pur-SPMD to pure-OpenMP mode. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev24 +Originator: erik ( Erik Kluzek) +Date: Tue Sep 24 22:42:42 MDT 2002 +Model: CAM +Version: CAM2.0.dev24 +One-line Summary: Fix minor problems (tau units, SGI system call, FV array) +cam-bugs Requests resolved: 64,65,66 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! (SGI, IBM) +Machines tested: IBM, SGI, lf95, PGIF90, Solaris +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself,mvertens,boville (units) +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Use "C" wrapper for SGI system call +Changes made: + +Units change: (cam-bugs 66) + + Surface stress was identified as N, consistently use N/m^2. + +FV fix: (cam-bugs 65) + + Make cut array allocatable and dimension acording to npes. + +SGI System routine: (cam-bugs 64) + + Use a "C" wrapper to system call on SGI so that the return +code can be queried. + +INT long-name: + + Change long-name on PRECCINT and PRECLINT to note that to +get intensity (average precipitation of precipitating events), you +divide by PRECCFRQ or PRECLFRQ respectively. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev23 +Originator: eaton ( Brian Eaton) +Date: Fri Sep 20 15:41:12 MDT 2002 +Model: CAM +Version: CAM2.0.dev23 +One-line Summary: updates to User Guide +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: none +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + +Made changes to the sections on configuring and building CAM. Added new +material on the run scripts. Edited details of config files and make +procedure in appendix B. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev22 +Originator: rosinski ( Jim Rosinski) +Date: Fri Sep 20 14:50:14 MDT 2002 +Model: CAM +Version: CAM2.0.dev22 +One-line Summary: fix potential memory overwrite bug in radae.F90 +cam-bugs Requests resolved: 63 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +o Fixed potential memory overwrite bug in radae.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev21 +Originator: erik ( Erik Kluzek) +Date: Mon Sep 16 23:41:41 MDT 2002 +Model: CAM +Version: CAM2.0.dev21 +One-line Summary: Add new output fields: PRECCINT, PRECCFRQ, PRECLINT, PRECLFRQ, and Z050 +cam-bugs Requests resolved: 46, 61 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! (IBM) +Machines tested: IBM, SGI, Linux-PGI, Linux-Lahey, Solaris +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +New output fields and namelist items: + + PRECCINT, PRECCFRQ, PRECLINT, and PRECLFRQ. Precipitation that +exceeds a given threshold (PRECC_THRESH = 0.1mm/hr and PRECL_THRESH=0.05mm/hr +by default, both can be set on the namelist). + +Fix minor problem with FV with Lahey: + +Update ccsm scripts to ccsm2_0_beta54: + +Fix so Solaris would work: + + Reduce optimization level. + +Minor changes to test-production.pl: + + Remove files after completion, new reference simulation. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev20 +Originator: rosinski ( Jim Rosinski) +Date: Mon Sep 16 14:38:10 MDT 2002 +Model: CAM +Version: CAM2.0.dev20 +One-line Summary: Implement shared constants in ice code. NOTE: no control run for this tag yet exists. +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, PC +Ran test-model.pl script: not yet. +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode:no +Code reviewed by: myself +Restart files change: no +Changes answers: Yes (new-climate) +Changes to CLM land-model: None (one-line description) +Changes made: + +o Use shared constants in CSIM4 ice code. +o Have not yet run test-model, but will today. Wanted to get commit in + because folks are waiting for it. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev19 +Originator: eaton ( Brian Eaton) +Date: Sat Sep 14 10:24:24 MDT 2002 +Model: CAM +Version: CAM2.0.dev19 +One-line Summary: implement the Makefile SMP option for linux-pgf90 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: pc-linux-pgf90 +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + + Added SMP option to the pc-linux-pgf90 section of the Makefile. Set + the default value of SMP to true since that replicates previous Makefile + behavior (the -mp flags were hardwired into the pgf90 settings). But + note that the default in the configure script sets SMP false for pc-linux. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev18 +Originator: olson ( Jerry Olson) +Date: Fri Sep 6 17:29:17 MDT 2002 +Model: CAM +Version: CAM2.0.dev18 +One-line Summary: bugfix in sld/scan2.F90 +cam-bugs Requests resolved: none +Requires change in build system: no +(one-line description of changes: fixed treatment of non-advected tracers in sld/scan2.F90 +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: no +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + + sld/scan2.F90 was copying cloud water from one time level to + another. Loop was generalized to copy *all* non-advected + tracers. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev17 +Originator: sawyer ( William Barton Sawyer) +Date: Thu Sep 5 06:48:57 MDT 2002 +Model: CAM +Version: CAM2.0.dev17 +One-line Summary: Allowed 3 latitudes per process; improvements from fvgcm-1_3_71 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, S.-J. Lin +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + In src/dynamics/fv: + + spmd_dyn.F90 Test for >= 4 latitudes now + >= 3 latitudes per process; tested + 72x46x26 with 12 processes and + 144x91x26 with 24 processes. Works. + cd_core.F90 Integrated optimizations and restructuring + from fvgcm-1_3_71. Zero diff changes. + Note that some experimental changes + from FVGCM (HIGH_P, value of tau) + have not yet been integrated. + sw_core.F90 Now includes upol5, vpol5 + upol5.F90 Removed + vpol5.F90 Removed + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev16 +Originator: erik ( Erik Kluzek) +Date: Wed Aug 28 11:22:02 MDT 2002 +Model: CAM +Version: CAM2.0.dev16 +One-line Summary: Fix deadlock with scenario_so4, fix various bugs, + T85, T170 in scripts, update to clm2_3_dev32, ccsm2_0_beta53 +cam-bugs Requests resolved: 37, 49, 51, 52 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! (IBM) +Machines tested: IBM, SGI, Compaq, Solaris, PGF90 +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: update to clm2_3_dev32 +Changes made: + +Build changes: + + Fix bug in "configure -test", so that tests will be done +in cam_bld directory, and then return to pwd. Add ability to do +T85, and T170 resolutions. Change prun in CAM_lab.pm for running +in hybrid mode. + +History restart fix: + + History restart files weren't going to mass store -- now +they do. + +Decomposition set in phys_grid_init rather than in call to it: + + Previously there were four locations to determine the +chunking decomposition type. + + Also remove the "is_lsm" and "is_phys366" methods. Always +assume that lsm will ONLY be run with phys366 and CLM will ONLY be +run with the new physics. + +Update CLM to CLM2_3_dev32 + + This fixes a problem with getting clmi files at T170. + +Fix deadlock problem with scenario_so4: + + A parameter was only set on masterproc that needed to be +set on all nodes. + +Update to ccsm2_0_beta53 and scripts_a020822 + + both scripts and models/bld directories. scripts_a020822 fixes +a minor problem in ccsm2_0_beta53 scripts. + +Test scripts: + + Add test-example.pl script to run the examples from the +users guide. Does limited checking to ensure things work as expected. +This is setup to run on blackforest. + + Add ability to set the remote lab in the "-errgro" option +in test-model.pl. This allows for port validation for remote +machines. Also delete more files that test-model.pl produces when +running in the default "clean" configuration. This prevents having +lots of wasted disk space for test-model.pl tests. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev15 +Originator: sawyer ( William Barton Sawyer) +Date: Wed Aug 7 07:58:09 MDT 2002 +Model: CAM +Version: CAM2.0.dev15 +One-line Summary: Completed merge of fvgcm-1_3_56 te_map, cleaned up remaining t3/tvm arrays +cam-bugs Requests resolved: none +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + src/dynamics/fv: + + te_map.F90: completed merge of fvgcm-1_3_56 te_map.F90 + code is same except for 2D decomposition + additions + dynpkg.F90: removed tvm, tvmxy arguments (information is + in pt, ptxy) + dp_coupling.F90:Use pt/ptxy instead of t3/t3xy + stepon.F90: remove t3xy entirely, t3 from d_p_coupling + arguments + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev14 +Originator: sawyer ( William Barton Sawyer) +Date: Tue Aug 6 09:01:22 MDT 2002 +Model: CAM +Version: CAM2.0.dev14 +One-line Summary: Patched FV communicator bug in coupled mode; T3 reset to phys_state%t in p_d_coupling; config. improvments +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + models/utils/pilgrim: + + parutilitiesmodule.F90, mod_comm.F90: extended initialization + routines to accept an optional communicator from which + the FV global communicator is determined. + + models/atm/cam/bld + + configure_fv.pl, fvtest.sh, script.m4: for DAO + code execution, renamed run script fvcam.j, + number of threads, processes renamed to DAO + convention AGCM_N_PROCESSES, AGCM_N_THREADS_PER_PROCESS + + models/atm/cam/src/dynamics/fv + + dp_coupling.F90 : t3 reset to phys_state%t in p_d_coupling + (suggestion from Brian). + + stepon.F90 : modified arg list to p_d_coupling, removed + explicit transpose of T3XY->T3 for 2D decomp. + + spmd_dyn.F90 : pass mpicom to ParInit. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev13 +Originator: jet ( John Truesdale) +Date: Thu Aug 1 16:03:16 MDT 2002 +Model: CAM +Version: CAM2.0.dev13 +One-line Summary: Fix initialization problem with fractional land, doesn't affect climate, only for CAM not CCSM +cam-bugs Requests resolved: 43 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: no (does all of the following tests) +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: Yes ( new-physics) +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Changes made: +initext now uses the ts value from the land initialization routine instead +of the value returned from the update surface fluxes routine. I added an +array to save off these values and apply them after iceint is called. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev12 +Originator: erik ( Erik Kluzek) +Date: Wed Jul 31 14:20:10 MDT 2002 +Model: CAM +Version: CAM2.0.dev12 +One-line Summary: Add 2D-decomp for FV to bld, Fix Solaris climate, add production test, add timing parser, fix various bugs +cam-bugs Requests resolved: 17, 20, 27, 30, 31, 33, 35, 36, 37, 39 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: yes + (makes use of the _OPENMP CPP token when SMP on, compiler options + must set this) +Substantial timing or memory changes: no +Requires change in run script: Yes + (dif4 now required on namelist if Eulerian and not T42) +Tested to work coupled with CCSM: Yes! (IBM) +Machines tested: IBM, SGI, Solaris, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +FV 2D parallel decomposition option added to bld scripts: + + Requires a new namelist (mprun2d). + Also added a "-fv2d" option to test-model.pl to run fv tests + with 2D decompostion. Also fix the constraint in src/dynamics/fv + so that the npr_yz array from the namelist is checked properly. + +Solaris: + Change Makefile so that model gives climate similar to IBM. + +Makefile: + Add CPPDEF for CPP definitions used by all platforms. Also + include a new token "CAM" declared when compling code with CAM. + Remove "-d" on AIX, and turn on "-g, -qfullpath" in + production mode so that when the model core-dumps you can + query the core files to find where it died. + +dif4: + Now require dif4 to be set on namelist for Eulerian dynamics not + at T42 resolution. + +restart-pointer files: + Get rid of getfil for restart-pointer file and add an optional + argument to opnfil, so that "old" can be given for type so that + the model will die if a restart pointer file doesn't exist. + +Fix some problems with using scenario_so4: + Fix write statements before "call endrun" so that they will be + written even if not on masterproc. Also broadcast sulfdata to all + nodes. There still seems to be other problems with this configuration. + +namelist: + Fix namelist parsing so that repeat declarations can be used + (i.e. mfilt = 4*1). Also update the change method so that it parses + as a regular namelist which allows arrays to be entered and more + complex namelist entries. +test/system: + Add ccm366 test and SMP=FALSE test to test-model.pl (unless on + AIX, ensure that SMP test gives same answers as SPMD). Add "-fv2d" + option to test-model.pl to check FV 2D decompostion. Add some simple + performance checking to test-model.pl. Add test-production.pl + a script to run the production model from Sep to Feb/1 weekly + to ensure the model is running as expected. + +check-timing.pl: + Add a script to do straight forward parsing of timing.* files to + look at performance. Simplist operation is as follows: + + check-timing.pl directory1 directory2 + + Options also exist to load the log-files in, and casenames, as + well as a list of timers to parse in the file. To get help invoke + it with "-help" or without any arguments. + +ESMF: Update to ESMF_0_0_2p5 (fixes problem with compiling on Sanitas) + This small update changes the name of "conf.h" to ESMF_conf.h + so that it won't find the wrong file in the search path. It also + removes the hard-wired use of /usr/local/include. Also previous + model versions didn't have all files updated to ESMF_0_0_2p4, and + this update fixes that problem. + +FV now passes LF95 strict checking tests with test-model.pl: + + Arrays in restart_physics:write_restart were going over pcols + rather than cols for FV. By having the arrays only go to ncols + this worked with LF95 and FV. + +phys_grid.F90: + Change a difficult to understand OMP loop used to get the + number of threads to a more straight-forward OMP subroutine call. +CCSM: + Update to ccsm2_0_beta50. Add table for dif4 to atm.setup.csh. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev11 +Originator: sawyer ( William Barton Sawyer) +Date: Tue Jul 30 09:22:20 MDT 2002 +Model: CAM +Version: CAM2.0.dev11 +One-line Summary: te_map.F90 aligned with latest FVGCM version; optimizations: overlapping communication/computation +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, W. Putman +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + src/dynamics/fv/te_map.F90 + + o Removed CPP token OLDWAY + o Aligned with latest FVGCM version + o Restructured communication (particularly for 2D + decomposition) to overlap communication with computation + as much as possible. Slight performance gains conceivable. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev10 +Originator: sawyer ( William Barton Sawyer) +Date: Mon Jul 15 10:20:32 MDT 2002 +Model: CAM +Version: CAM2.0.dev10 +One-line Summary: Merged latest work from DAO FVGCM version fvgcm-1_3_44 +cam-bugs Requests resolved: none +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Lin, Putman, Shen +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + atm/cam/src/dynamics/fv + + sw_core.F90, tp_core.F90, upol5.F90, vpol5.F90 -- + changes by Putman allow runs with only 3 + latitudes per PE + + trac2d.F90 -- cache optimizations by Lin for tracer advection + + utils/pilgrim + + mod_comm.F90 -- latest version from FVGCM + Makefile.conf.IRIX64 -- support recent change #include + unit_testers/Makefile rather than #include "file.h" + + atm/cam/test/system + + dao_batch.csh -- batch script to run test-model.pl on DAO + machines (currently tropic and dycore) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev9 +Originator: sawyer ( William Barton Sawyer) +Date: Thu Jul 4 14:12:43 MDT 2002 +Model: CAM +Version: CAM2.0.dev9 +One-line Summary: Bug fixes for 2D domain decomposition, LF95 strict error checking +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + + in src/dynamics/fv: + + inidat.F90 : chunking patch suggested by Pat Worley + + restart_dynamics.F90: bufres now allocated on all PEs + (for LF95 strict error checking) + + sw_core.F90, tp_core.F90 : revision by S.-J. Lin + crx in tpcc now ghosted +/- ng_c latitudes + + benergy.F90, cd_core.F90, trac2d.F90, uv3s_update.F90: + fix for 2D domain decomposition on IBM -- + pole PEs now do not accidently send data + to lower or upper levels. Code still does + not work on all IBM 2D configurations but + it is getting closer. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev8 +Originator: sawyer ( William Barton Sawyer) +Date: Mon Jun 24 02:12:01 MDT 2002 +Model: CAM +Version: CAM2.0.dev8 +One-line Summary: FV patches for Lahey strict error checking +Requires change in build system: no +ubstantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + src/dynamics/fv: + + mapz_module.F90:Q2 now INOUT in map1_ppm, mapn_ppm, + because Q1 (IN) and Q2 (was OUT) + were being passed same array + + sw_core.F90: crx now declared (im,jfirst-ng_d:jlast+ng_d) + passed to tpcc crx(1,jfirst-ng_d). + No error when ng_d == 0 (SMP-only) + + tp_core.F90: In tpcc, dummy argument crx now declared + crx(im,jfirst-ng:jlast+ng). No error when + ng (== ng_d) == 0. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev7 +Originator: erik ( Erik Kluzek) +Date: Thu Jun 20 23:48:55 MDT 2002 +Model: CAM +Version: CAM2.0.dev7 +One-line Summary: #include "" to <>, Fix Solaris make, Fix SLD for Lahey, change coupled restarts, fix sort, update csm_share/bld/scripts, fix clm restart +cam-bugs Requests resolved: 19, 18, 25, 26 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes! (IBM, restarts tested as well) +Machines tested: IBM, SGI (some testing on Solaris, and Linux/Lahey) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, olson (sld) +Restart files change: yes (but only if COUP_CSM set) +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Fix restart pointer files for long casenames +Changes made: + +SLD changes for Lahey strict error checking: + + Small changes to q arrays sent to a few routines so that + dimension of arrays would pass strict error checking in Lahey + compiler. + +Restarts: + + Change restarts when running coupled (COUP_CSM on), so that + data not used for coupled runs not output/read. This also allows + model to use the restart files from the b20.007 simulation. + +Sort routines: + + Change sort routines in responce to bug found by Phil Rasch. + +csm_share: + + Update csm_share to share2.1.3. + +Misc: + + #include "" to #include <> + Initialize ctitle and let it be up to 256 characters. + Put "if (masterproc)" around write(6 statements for ramping. + test-model.pl, get rid of global data used for setting up tests. + Replace it with methods. This is a better more robust solution. + Add -qfullpath when debug on for IBM. + Update models/bld, and scripts directories to ccsm2_0_beta47. + Get coupled scripts to work with CAM directory structure, and + change so that restart can work. + +CLM: + Don't limit length on string read in from restart pointer file, + as this causes problem when casenames are long. + +Solaris: + + Change Makefile so that model will work, get rid of special + F77 compilation and use new autopromotion flag in the new compiler. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev6 +Originator: mvertens ( Mariana Vertenstein) +Date: Thu Jun 20 15:31:15 MDT 2002 +Model: CAM +Version: CAM2.0.dev6 +One-line Summary: put chunking into coupled model +Requires change in build system: no +cam-bugs Requests resolved: 24 +(See http://www.cgd.ucar.edu/cgi-bin/wreq/req?list-5) +Substantial timing or memory changes: Yes + (significant performance improvement when chunking is turned on) +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI +Ran test-model.pl script: no (does all of the following tests) + Changes only affected coupled model model +Code reviewed by: myself, erik +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + + Put chunking into coupled model + + Verified bfb with ccsm2_0 and that PCOLS=16 and PCOLS=128 was bfb the same + on the SGI and IBM in coupled mode + + Verified that coupled model restarts and branches correctly + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev5 +Originator: eaton ( Brian Eaton) +Date: Wed Jun 19 19:49:37 MDT 2002 +Model: CAM +Version: CAM2.0.dev5 +One-line Summary: build procedure mods, memory allocation mods +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Erik +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + + Remove ccm366/cldwat.F90 - not used + + Add capability to bld/build-namelist to build LSM namelists + + bld/configure + Add -[no]smp option + Add -pcols option + + Makefile: + Add SMP macro to allow enabling/disabling openMP without having + to edit Makefile. Currently only implemented for AIX and SGI. + Get rid of the -macro_expand option to SGI f90 because + it's not needed when you use -cpp. + + physics/cam1/phys_grid.F90 - move globalfield allocation from stack to heap + in write_field_from_chunk and read_chunk_from_field + + dynamics/{eul,fv,sld}/stepon.F90 - move stack memory allocation of + 3-D physics and dynamics data structures to heap + + models/ice/csim4/ice_tstm.F - change first character of comment lines + starting with c to ! + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev4 +Originator: erik ( Erik Kluzek) +Date: Sat Jun 15 08:04:21 MDT 2002 +Model: CAM +Version: CAM2.0.dev4 +One-line Summary: Remove precision module, and use csm_share/shr_kind_mod + instead with renames to r8,r4,i8 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, eaton +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes, same change to precision as above. +Changes made: + +Precision change: + + Remove precision module and use csm_share shr_kind_mod module + to get precision types. Use the rename feature to get the names + that were used in the precision module. + +Tools change: + + Make same change to the tools: cprnc, definesurf, interpic, mkrgrid, + and cprlndnc. In this case keep a local copy of shr_kind_mod for + their use. Made sure each tool changed would build after the change. + +Bug-Fix: + + Added definition of CPP_INTEGER4 to pilgrim.h as was needed to + get fv to build. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev3 +Originator: sawyer ( William Barton Sawyer) +Date: Thu Jun 13 07:39:36 MDT 2002 +Model: CAM +Version: CAM2.0.dev3 +One-line Summary: Solved SUN compilation problem; further merging of FVGCM into CAM; bug fix for SMP-only +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, SUN +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Putman, Mirin +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + models/atm/cam/bld: + configure_fv.pl, script.m4, revised for cam2_0 data sets (Mirin) + + models/atm/cam/src/dynamics/fv: + + pft_module.F90 : merged from FVGCM (minor additions) + sw_core.F90 : merged from FVGCM + cd_core.F90 : bug fix in call of c_sw + modified to use pft_module and sw_core + + models/atmlnd_share: + + precision.F90 : added i4 needed by DAO (mod_comm) + + models/utils/pilgrim: + + mod_comm.F90 : fixed SUN compilation problem, upgrade (Putman) additions for STAND_ALONE mode (Sawyer) + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev2 +Originator: sawyer ( William Barton Sawyer) +Date: Tue Jun 4 09:40:49 MDT 2002 +Model: CAM +Version: CAM2.0.dev2 +One-line Summary: Merge of FVGCM (DAO) software engineering improvements into CAM2 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM (test-model.pl) SGI (DAO A26, B26 cases) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Bill Putman, others +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + + This merges cam1_8_dev6_brnch_fvgcm_merge with cam2_0_dev1. + + models/utils/pilgrim: + + Newest version of mod_comm (but does not yet solve + real -> real(r8) promotion problem on SUN). + Upgrade of other modules for use in CAM-DAS + restructuring and upgrades of unit testers. + + models/atm/cam/src/dynamics/fv: + + Software engineering improvements from FVGCM (DAO) + + benergy.F90 cd_core.F90 d2a3dijk.F90 d2a3dikj.F90 + dp_coupling.F90 dynpkg.F90 highp2.F90 hswf.F90 + p_d_adjust.F90 te_map.F90 trac2d.F90 uv3s_update.F90 + use new mod_comm interface. + + mod_mpi.F90 removed. + + mapz_module.F90 consolidates vertical interpolation routines: + kmppm.F90 map1_ppm.F90 map3_ppm.F90 ppm2m.F90 steepz.F90 + + inidat.F90 initcom.F90 pmgrid.F90 spmd_dyn.F90 trunc.F90 + minor structural changes + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam2_0_dev1 +Originator: erik ( Erik Kluzek) +Date: Mon Jun 3 14:10:23 MDT 2002 +Model: CAM +Version: CAM2.0.dev1 +One-line Summary: Fix test-model.pl problems, fix problems running Lahey + for Eul dy-core, add T31 namelist options +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM (some testing on Linux with Lahey--lf95) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +T31: + + Add namelist options and datasets needed to run T31. + +test-model.pl + + Fix a couple problems with test-model.pl. Will now properly +run through the list of all dynamics. Start refactoring to a more +general way to run through the tests with object methods rather than +global data. Put quotes around run env variables, allow setting of +interactive option in CAM_namelist, make sure CAM objects have everything +properly set withe either setenv or setcfg. + +Lahey fix: + + A few changes to dynamics/eul so that qfcst arrays can be properly +dimensioned. Inside spegrd and tfilt_massfix copy qfcst from i1 to nlon+i1-1, +so that strange things with memory don't have to be done. This allows +tests 1 and 2 with test-model.pl to work for Eulerian dynamics. Test 13 fails. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev11 +Originator: erik ( Erik Kluzek) +Date: Fri May 17 10:37:16 MDT 2002 +Model: CAM +Version: CAM1.8.dev11 +One-line Summary: License update, icefrac bug-fix, build fixes, dataset name changes, fix test-model.pl so that validation could be done +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes + (dataset names change) +Tested to work coupled with CCSM: yes! (IBM) +Machines tested: IBM, SGI, Linux-PC-PGI + (some testing on Compaq, Linux-Lahey, and Solaris) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +License update: + Update to CAM license as reviewed by Bill Collins and Catherine + Shea (NCAR lawyer). + +icefrac bug-fix: + Fix problem introduced in cam1_8_dev10 on initialization of + icefrac. + +Build fixes: + Various fixes to build scripts to work on machines at ORNL. + +Name changes: + + Dataset names change to be consistent with the following format: + + _YYYY-MM-DD__L__.nc + + resolution for spectral dycores is refered to as nlatxnlon, with + the spectral truncation following. So for example, Eulerian T42 is + refered to as: 64x128_T42, SLD T63 is 64x128_T63. Datasets that + don't have a specific spectral truncation associated with them + leave off the spectral truncation part (so initial datasets run + through definesurf or most land datasets). + + Example: + + cami_0000-09-01_64x128_L26_c020514.nc + +test-model.pl + + Fix test-model.pl so that release version of the model could be + validated. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev10 +Originator: erik ( Erik Kluzek) +Date: Mon May 13 12:01:17 MDT 2002 +Model: CAM +Version: CAM1.8.dev10 +One-line Summary: Replace Numerical-Recipe code, Lahey fixes for multiple constituents, Update to ccsm2_0_beta45, update to clm2_3_dev30, some Solaris and Compaq fixes +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes +Machines tested: IBM, SGI, Linux-PGI, Linux-PGI/GCC + Some testing with Solaris and Compaq, but not everything works. +Ran test-model.pl script: yes (does all of the following tests) + (test-model.pl currently broken test-model ran with previous version) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Update to clm2_3_dev30 +Changes made: + +Known problem: + This model core-dumps in the standard configuration due +to a problem with the initialization of icefrac. + +Lahey fixes: + + Do some fixes for strict error checking with Lahey compiler when +using multiple constituents. + +Numerical Recipes sorting routines replaced: + + Numerical Recipes routines CAN NOT be publically released, so +they were replaced by Tony Craig's implementation of the same alogrithm. + +cprnc: + + Fix cprnc so it would work on Solaris. Solution was a Kludge to +get it to work. More work should be done to find the underlying problem. + +CCSM2_0_beta45 update: + + Update models/bld and scripts to ccsm2_0_beta45. + +CLM2_3_dev30 update: + + Update CLM to clm2_3_dev30. + +test-model.pl + + With the new build stuff in place test-model.pl is currently +broken. It will be fixed as soon as possible (which may be after the +model release). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev9 +Originator: eaton ( Brian Eaton) +Date: Mon May 13 11:22:15 MDT 2002 +Model: CAM +Version: CAM1.8.dev9 +One-line Summary: merge newbld branch +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: none +Ran test-model.pl script: no - it's officially broken +Tested on fv dynamics: no +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: no +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself, Erik +Restart files change: no +Changes answers: no +Changes to CLM land-model: None (one-line description) +Changes made: + +Added new build scripts and user docs. + +atm/cam/bld/configure produces the Filepath, misc.h, params.h, preproc.h files, +and a Makefile. + +atm/cam/bld/build-namelist produces a namelist file + +test-model.pl is currently broken because Erik's mods to have it use CAM_namelist.pm +have not been completed. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev8 +Originator: erik ( Erik Kluzek) +Date: Wed May 8 17:41:26 MDT 2002 +Model: CAM +Version: CAM1.8.dev8 +One-line Summary: Fix CCSM restart problem +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes! IBM +Machines tested: IBM +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes (eul coupled only) +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + +Fix problem where restarts when running coupled were not bit-for-bit. +All changes are isolated to ccsm_msg.F90. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev7 +Originator: jet ( John Truesdale) +Date: Wed May 8 16:22:05 MDT 2002 +Model: CAM +Version: CAM1.8.dev7 +One-line Summary: definesurf to extend ross ice shelf by default, clean up csim error messages +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no or Yes (describe) +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: yes +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Restart files change: no +Changes answers: no +(Note: test-model.pl only does checks this -- if you run it with the "-compare" option) +Changes to CLM land-model: None (one-line description) +Changes made: +Fix to definesrf to make it extend ross ice shelf by default. Non-land +below S79 is set to land so that land will treat the area as glacier. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev6 +Originator: sawyer ( William Barton Sawyer) +Date: Wed May 8 07:59:26 MDT 2002 +Model: CAM +Version: CAM1.8.dev6 +One-line Summary: FV patches to help pass lf95 strict error checking, Erik's fix of tphysbc.F90 to pass FV test 1 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI, Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, erik +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + + bld: configure_fv.pl and script.m4 upgraded for cam1_8 + + src/physics/cam1: tphysbc.F90 fix by Erik to pass FV test 1 + + src/dynamics/fv: + + avgc.F90 : retired + cd_core.F90 : inlined avgc.F90 + dp_coupling.F90 : intent(inout) u3s (it's updated during ghost) + dynamics_vars.F90: temporary arrays allocated for SPMD only + dynpkg.F90: 2D decomposition arrays now allocated consistently + pmgrid.F90: initialize 2D decomp variables for non-2D case + stepon.F90: 2D decomposition arrays now allocated consistently + + utils/pilgrim: + + mod_comm.F90: intent(inout) q in BufferUnPack*D + +Note: it will pass lf95 strict error checking in SPMD mode on Linux + only if following routines are compiled with DEBUG FALSE: + fv_prints.F90, restart_dynamics.F90 and restart_physics.F90. + Strict error checking yields errors in those routines which + may be related to the chunking mechanism. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev5 +Originator: erik ( Erik Kluzek) +Date: Tue May 7 13:03:41 MDT 2002 +Model: CAM +Version: CAM1.8.dev5 +One-line Summary: Fix problem with restarts when running coupled. +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: yes! IBM (full "K" test suite) +Machines tested: IBM +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: No -- not when running coupled! +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + +Change ONLY ccsm_msg.F90 so that restarts would work. Ran the +full CCSM test GUI on the BIM (blackforest). + +This version has a bug in it where restarts are not exact when +running coupled. This problem is fixed in cam1_8_dev8. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev4 +Originator: rosinski ( Jim Rosinski) +Date: Thu May 2 15:12:01 MDT 2002 +Model: CAM +Version: CAM1.8.dev4 +One-line Summary: xlf90 bugfix for h_override. make clean deletes esmf. flint complaints. modified timing calls. Added lf95 to definesurf makefile. +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None (one-line description) +Changes made: + +o Bug in xlf90 caused h_override to behave improperly. +o "make clean" now deletes esmf/ directory as well as .o, etc. files +o Fixed some flint complaints. +o Added lf95 entry to definesurf makefile. +o Modified some of the calls to the timing library. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev3 +Originator: erik ( Erik Kluzek) +Date: Wed May 1 22:25:25 MDT 2002 +Model: CAM +Version: CAM1.8.dev3 +One-line Summary: Output field changes, cam1 to cam2, FLAND to LANDFRAC, + fix vertinterp, longname for constituents +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: yes + (Restart pointer files are now cam2 instead of cam1, restart files have cam2 in name) +Tested to work coupled with CCSM: Yes! (SGI and IBM) +Machines tested: IBM, SGI, Linux-PGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens (and input from wcollins, pjr, and boville) +Restart files change: no +Changes answers: no (bit-for-bit) (although DTCOND different) +Changes made: + +Output field changes: + + DTCOND -- Changed to be defined by dry static energy instead of + temperature to be more consistent with current alogrithms. + This change is from Fabrizio Sassi. + New fields: + WSPEED -- Wind speed (default maximum) + FSDSC --- Clearsky downwelling solar flux at surface + PRECTMX - Maximum precipitation rate + (Add above to monthly files) + Put TREFMNAV and TREFMXAV on output monthly files for non-coupled case. + + These changes are in ccsm-bugs as request 19. + +Change instances of cam1 to cam2: + + Change occurances of cam1 to cam2 in output file names and code comments. + +FLAND on initial files is now LANDFRAC: + + Have initial files that are produced use the name LANDFRAC instead +of FLAND to be consistent with history files. This also put attributes on +the field which didn't happen with the FLAND name. For backwards compatability +allow the names on the initial files to be either LANDFRAC or FLAND. + +vertinterp: + Apply a fix to vertinterp as found by Art Mirin. This fixes a problem + if the interpolation pressure happens to exactly equal the pressure + at a data-point. Recorded in ccsm-bugs as request 29. + +Constituents module now has longname data element: + + Add longname to constiuents module and set it as an optional argument + in add_cnst. When add_cnst called if appropriate set longname to + something useful. + +Coupled: + Change scripts to look at inputdata/atm/cam2 input directory. + Fix log-file output problem by adding a if( masterproc) on + the "stopping at end of day" print. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev2 +Originator: erik ( Erik Kluzek) +Date: Sat Apr 27 09:39:39 MDT 2002 +Model: CAM +Version: CAM1.8.dev2 +One-line Summary: Update to cam1_8_dev1_brnchT_esmfup4 -- + Update to ESMF_0_0_2p4, clm2_3_dev29, ccsm2_0_beta41, simple fixes, + nix scatter/gather aliasing for CCSM +Requires change in build system: Yes (ESMF build changes) +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! (SGI and IBM) +Machines tested: Some testing on all platforms: + IBM, SGI, Compaq, Solaris, Linux-PGI, Linux-Lahey, Linux-PGI/GCC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Update to clm2_3_dev29 +Changes to ESMF: Update to ESMF_0_0_2p4 +Changes made: + +ESMF update: Update to newer version of ESMF with name changes from + mf_ to esmf_. The newer ESMF simplifies the build by not needing + dependence on OMP or MPI, so nothing is referenced outside the + ESMF distribution. + +CLM2 update: Update to clm2_3_dev29 which works with ESMF version above. + +CCSM Update: Update models/bld and scripts directories to ccsm2_0_beta41 + version of the scripts. Also put PCOLS define in CCSM scripts rather + than hardcoded in ppgrid.F90. Ran csm.csh test on babyblue and utefe. + Bit-for-bit with non-SPMD version and bit-for-bit with previous + model. + +CCSM Scatter/Gather aliasing: Get rid of the aliasing (using the same array + for input and output) in the mpigather and mpiscatter calls in + ccsm_msg.F90. In the process create a new allocatable array allocated + on masterproc and an old array allocatable so that only dimensioned + from beglat:endlat. This reduces the total amount of memory needed + for the mpi scatters and gathers. + +Solaris: Fix a couple subscript problems caught on solaris in history.F90. + Then as a particularly difficult problem was caught, turn subscript + checking off for solaris when DEBUG=TRUE. + +phys_grid.F90: Get updates from Pat Worley and Art Mirin to generalize + phys_grid.F90 in cam1 for odd numbers for FV dynamics. Tried same + routine in ccm366 physics, but results in problems. + +ORNL -Colt: Add settings needed to CAM_lab.pm to run on colt.ccs.ornl.gov. + +Testing: Ran at least some test-model.pl tests on all platforms: + + Linux-PGI (Apache, longs), Linux-Lahey (Apache, compile test on longs) + Linux-PGI/GCC (Apache, longs), SGI (utefe), IBM (babyblue, eagle@ornl), + Solaris (sanitas, test 1 works), Compaq (colt@ornl tests 2-5 with SPDM off) + + There are problems with some of the standard tests in test-model.pl + on particular platforms. These problems will need to be cleanup in + before model release. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_8_dev1 +Originator: erik ( Erik Kluzek) +Date: Mon Apr 22 13:11:18 MDT 2002 +Model: CAM +Version: CAM1.8.dev1 +One-line Summary: Move cam1_7_dev34_brnchT_fractional_8 branch to the development branch +Requires change in build system: Yes! + Filepath requires new directories +Substantial timing or memory changes: Yes (running with new ice-model is slower) +Requires change in run script: Yes + New set of SST and Initial condition files are required. +Tested to work coupled with CCSM: Yes! (IBM and SGI) + (bit-for-bit with ccsm2_0_beta38) +Machines tested: IBM, SGI, Compaq, Sun, Linux-Lahey, Linux-PGI + (Sun compiles but doesn't run, Compaq core-dumps on error-growth + test, Linux-PGI core-dumps on error-growth test with fv dynamics) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, John Truesdale, Mariana Vertenstein, Jim Rosinski +Restart files change: yes! +Changes answers: new-physics +Changes to CLM land-model: Interface changes +Control cases: + /EATON/csm/fv2x-fland05 -- Finite-Volume with PCMDI SST's. + /JET/csm/sldnewicefrac01 -- SLD dynamics with PCMDI SST's. + /ROSINSKI/csm/newsstclim03 - Eulerian dynamics with Hurrell + Hadley Center OI / Reynolds blended SST data climatology. + /ROSINSKI/csm/newsstamip02 - Eulerian dynamics with Hurrell + blended monthly SST data. +Changes made: + +Physics: + + Fractional land and ocean: Old binary ORO flag is gone replaced + by the fractions: landfrac, icefrac, and ocnfrac. Also the old + flag on SST datasets is done away with and ice-cov is used for + sea-ice concentrations. comsrf.F90 was reworked as part of this change. + Also the offline tool "definesurf" was changed to work with the + new datasets. "interpic" continues to work with IC files as well. + + New ice-model: A modified version of the CCSM Sea-Ice model + Community Sea-Ice Model (csim4) is included with the model + now in the "models/ice/csim4" directory. The old ice-model is + included in the new directory "models/atm/cam/src/ocnsice/dataicemodel". + +CCM3.6.6 Physics: + + The CCM3.6.6 physics is still supported although now it can ONLY + be run with Eulerian dynamics/LSM and the old data ice/sst model. + The old version of the data ice model codes are in the "physics/ccm366" + directory. + +Namelist changes: + + prognostic_icesnow -- If TRUE determine snow-depth over ice prognostically + otherwise use a climatology. + reset_csim_iceprops -- Reset the CSIM ice-model initial properties + (used on a new initial run if the model blows up). + +Script / Makefile changes: + + Filepath, datasets and new variable "ICEMODEL" added to deal with + the two ice-models (CSIM4 or CCMDATA). Lahey error-checking added + to Makefile. Initial datasets now require the land-fraction on + them in the variable "FLAND". When using the new ice model + SST datasets are required to have the variables "SST_cpl" (for SST), and "ice_cov" for sea-ice concentration. + + "NEWBUILD=TRUE" option now the only way to use the standard makefile. + The old "makdep" dependency generator logic ripped out of the Makefile + and deleted from the "tools/makdep" directory. + + Users guide updated to reflect changes. DatasetLog updated with + new datasets. + +New datasets: + To obtain the new tar-ball of datasets: + + ftp ftp.cgd.ucar.edu + cd pub/erik + bin + get cam1_8.scidac-atm.datasets.tar.gz + +Error-growth: + + Error-growth is much faster than previous versions of the model. + Error-growth is still high using the dataicemodel and active-land. + Using prognostic_icesnow=.false. improves error-growth, and using + standard T42L26 datasets provides reasonable error-growth. Also + running error-growth with aqua_planet on provides reasonable error-growth. + +Coupled model: + + landfrac, and ocnfrac are now binary values of 0.0 or 1.0 in + accordance to how ORO was previously assigned in the model. This + should eventually be changed to use the values the coupler send + explicitly. + +test-model.pl: + + Change restart tests to restart after 5 time steps. + Change error-growth full-physics test to use prognostic_icesnow=.false. + and aqua_planet=.true. and use date from dataset rather than Dec/31. + Delete the SOM test and add a new test to make sure using the + dataicemodel works. + Fix problem with recognizing old files. + +interpsst gone: + + The old tools/interpsst code removed as it will not work with the + new SST files. Also new tools for creating SST datasets are in + development. The new tools use the Hurrell SST datasets and also + modify data so that when a linear time-interpolation is applied + to the mid-monthly datapoints the observed monthly average is + reconstructed. It's unclear when the new tools will become part + of the distribution. + +Changes to make most of the model Lahey compliant: + + Small changes to large amounts of the code so that strict error-checking + with the Lahey compiler can be performed on most of the model. The + files: binary_io.F90, wrap_nf.F90, wrap_mpi.F90 have not been converted. + As part of this change the routines bouyan, and cldprp where moved + to inside the zm_conv.F90 file. + +Bug-fixes: + + Fix in phys_grid.F90 for SGI. + Fix in filenames.F90 for IBM. + +Known problems: + + IBM -- history.F90 still doesn't always compile when DEBUG=TRUE. + Compaq -- Model core-dumps with "floating invalid" when running + error-growth test on Compaq (Colt @ ORNL) + The model compiles but has trouble running on the Sun. Subscript overflow + problem when running compiler checking (Sanitas @ NCAR). + Linux-PGI -- fv: When running FV dynamics and Error-growth the model + aborts with an error + "DEALLOCATE: memory at 43d18c10 not allocated" + (Apache @ NCAR) + + SOM -- New model does not work with the slab-ocean model. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev34 +Originator: rosinski ( Jim Rosinski) +Date: Fri Mar 29 16:44:22 MST 2002 +Model: CAM +Version: CAM1.7.dev34 +One-line Summary: Bugfix to tphysbc.F90 to keep uninitialized data (in ptend) from being used. +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, PC +Ran test-model.pl script: yes (does all of the following tests) + NOTE: fv tests on IBM failed for both this commit and the comparison + previous library due to compiler bugs. But all ran OK on PC. +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) presuming the short tests are sufficient to ensure no garbage + from stack being used +Changes to CLM land-model: None +Changes made: + +o Contents of local variable ptend in tphysbc were being used uninitialized. No ill symptoms were + noticed in the dev branch, but the fractional branch was randomly seg faulting or encountering + a floating point error when restarting on 16 nodes on blackforest. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev33 +Originator: pworley ( Patrick H Worley) +Date: Tue Mar 12 14:30:32 MST 2002 +Model: CAM +Version: CAM1.7.dev33 +One-line Summary: load-balanced physics option; PCOLS cpp token for setting pcols; SOM chunking bug fix +Requires change in build system: yes +PCOLS cpp token required to set pcols in ppgrid.F90. params.h.in.csh modified to do this automatically. +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM and Compaq at ORNL +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and Marcia Branstetter +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +1) Changed phys_grid_init call. Instead of specifying number of + columns per chunk, now specify number of chunks per thread. + This then sets the number of columns per chunk appropriately, + guaranteeing that the same number of chunks can be assigned + to each processor. Files affected: + + control/restart.F90 + control/wrap_mpi.F90 + dynamics/eul/inital.F90 + dynamics/sld/inital.F90 + dynamics/fv/inital.F90 + physics/cam1/phys_grid.F90 + physics/ccm366/phys_grid.F90 + +2) Augmented physics domain decomposition options: + opt == -1: same as before (latitude-slice chunk, for compatibility + with ccm366 physics, lsm1, and CSM) + opt == 0: For a given MPI process, all chunks have the same number + of columns, and each thread associated with a process has + the same number of chunks. Columns are assigned to chunks + to improve load balance between chunks (compared to + the default ordering), but without requiring + interprocessor communication in dp_coupling. + opt == 1: All chunks have the same number of columns and each + thread has the same number of chunks, across all MPI + processes. Columns are assigned to chunks to balance + day/night, summer/winter "static" load imbalances. + Chunks are assigned to processes to minimize interprocessor + communication in dp_coupling, but it will occur + anyway unless the dynamics decomposition is compatbile. + Files affected: + + + dynamics/eul/dp_coupling.F90 + dynamics/eul/dyn_grid.F90 + dynamics/eul/inital.F90 + + dynamics/fv/dp_coupling.F90 + dynamics/fv/dyn_grid.F90 + dynamics/fv/inital.F90 + + dynamics/sld/dp_coupling.F90 + dynamics/sld/dyn_grid.F90 + dynamics/sld/inital.F90 + + physics/cam1/phys_grid.F90 + physics/ccm366/phys_grid.F90 + + control/wrap_mpi.F90 + control/restart.F90 + +3) Added PCOLS cpp token, used to set pcols parameter in ppgrid.F90 . + When running coupled, pcols (still) set to PLOND. params.h.in.csh + modified to set PCOLS default, taking care of LSM1 and CCM366 physics + special cases. (Code courtesy of Erik Kluzek.) + + Files affected: + + ../bld/README + ../bld/params.h.in.csh + physics/cam1/ppgrid.F90 + physics/ccm366/ppgrid.F90 + +4) Fixed chunking bug in SOM. Files affected: + + ocnsice/som/somoce.F90 + ocnsice/som/srfsomi.F90 + ocnsice/som/srfsomo.F90 + ocnsice/som/srftsbi.F90 + +5) Miscellaneous clean-up (removing pchnk and pchnkd parameters, + renaming a phys_grid routine). Files affected: + + physics/cam1/physgrid.F90 + physics/cam1/ppgrid.F90 + physics/cam1/cldwat.F90 + physics/ccm366/physgrid.F90 + physics/ccm366/ppgrid.F90 + control/history.F90 + + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev32 +Originator: erik ( Erik Kluzek) +Date: Thu Mar 7 23:00:41 MST 2002 +Model: CAM +Version: CAM1.7.dev32 +One-line Summary: Bug-fix to cam1_7_dev30 snowfall rates, also fix interpret_filename_spec +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! +Machines tested: IBM, SGI (some testing on Linux, SunOS as well) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, tcraig +Restart files change: no +Changes answers: Yes (fixes bug from cam1_7_dev30 where everything appears as snow) +Changes to CLM land-model: fix problem where numpatch was "use"'d twice +Changes made: + +tphysbc.F90: + + Fix bad merge from cam1_7_dev30 that caused all precipitation to fall +as snow. + +filenames.F90: + + Check if prev is present before using. Without this the SGI and Compaq +would seg-fault when running the model. + +test-model.pl: + + Fix problem in test 6. Tests skipped don't build-namelist. + +run-model.pl: + + Don't resubmit till year 1 after first simulation. + +clm: + + Fix double "use" of numpatch. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev31 +Originator: mirin ( Arthur Andrew Mirin) +Date: Thu Mar 7 10:11:37 MST 2002 +Model: CAM +Version: CAM1.7.dev31 +One-line Summary: Completed full history capability for 2D FV decomposition +Known bug: All precipitation appears as snowfall! +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Added 32-bit accumulation buffers and initial history file capability for 2D FV decomposition. This involved a number of changes to history.F90, minor changes to stepon.F90, enhancements to restart_dynamics.F90, and enhancements (made by Will Sawyer) to the Pilgrim library (puminterfaces.F90, pilgrim.h, parutilitiesmodule.F90, redistributemodule.F90). Also made a minor unrelated improvement to trac2d.F90 (elimination of 2D temporary array). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev30 +Originator: erik ( Erik Kluzek) +Date: Wed Mar 6 08:58:37 MST 2002 +Model: CAM +Version: CAM1.7.dev30 +One-line Summary: Fix labels on monthly files, physics changes from mzh6, + fix CCSM logs, update to ccsm2_0_beta38 +Known bug: All precipitation appears as snowfall! +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! +Machines tested: IBM, Linux (PGI) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens +Restart files change: no +Changes answers: Yes! (same-physics -- less snowfall, reduced Cn over sea-ice) + Case names for changes: /CCSM/csm/b20.001 +Changes made: + +Bug introduced: + + This version introduces a bug where all precipitation appears as snow. +This was due to incorrectly resolving a conflict in the merge from mzh5 to +mzh6. + +Fix labels on monthly files: + +Monthly files were labeled with the current time-stamp. Now they are labeled +with the previous month. Also don't output a monthly file, if nstep == 0, +as it will just be an instantaneous time-sample rather than an average. + +Get code updates from ccm3_12_47_brnchT_mzh6: + +Snowfall is reduced by requring average temperature to be -2C. Reduce cloud +condensation nuclei over sea-ice from 40 to 5. These code changes were tested +coupled, but not stand-alone yet. Both a new coupled and uncoupled simulation +will be run shortly. + +Fix log-files when running coupled: + +Only redirect masterproc output to atm.log file. Redirecting all output was +causing conflicts in the log file and causing most of the information +to be lost. Also add more checks on masterproc for output when running coupled. + +Update CCSM scripts to ccsm2_0_beta38: + +Update the "models/bld" and "scripts" directories to point to the "beta38" +version of CCSM2.0. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev29 +Originator: erik ( Erik Kluzek) +Date: Fri Mar 1 20:53:28 MST 2002 +Model: CAM +Version: CAM1.7.dev29 +One-line Summary: Fix initial filenames and increase caseid from 16 to 32 characters +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM (eul,sld,fv), SGI (eul only) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Increase caseid from 16 to 32 +Changes made: + +Increase caseid from 16 to 32 characters. + +Fix filenames of initial files (the .nc extension was dropped off). + +Change test-model.pl. SOM test now run on all platforms (AIX was left +off before). $CASE is a little longer and more descriptive. Filewildcard +more explicit (solves a simple problem I ran into, where the old file +was found). + +Ran run-model.pl with a 32-character caseid (both with CLM and LSM) +producing initial files to make sure worked with long caseid, and +initial files had proper name. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev28 +Originator: erik ( Erik Kluzek) +Date: Fri Feb 15 17:56:56 MST 2002 +Model: CAM +Version: CAM1.7.dev28 +One-line Summary: Add new flexible filenames with CCSM names as defaults, update to CLM2.3.17 +Requires change in build system: yes + (SHELL_MSS is no longer required) +Substantial timing or memory changes: no +Requires change in run script: no + (namelist options changed: rirt, nrmvn, nsmvn removed, irt => mss_irt, + nswrps => mss_wpass, add hfilename_spec, archive_dir option) +Tested to work coupled with CCSM: yes! +Machines tested: IBM, SGI (some testing on Linux PGI, Sun) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, mvertens, eaton +Restart files change: yes! +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Update to CLM2.3.17, get to work with changes +Changes made: + +Flexible filenames: + + New namelist option, hfilename_spec to specify filenames, newly +adopted CCSM standard filenames are the default. Filename specifiers set +the filenames, with the following interpretations: + + %c = casid + %t = tape number + %y = current year + %m = month + %d = day + %s = seconds into current day + %% = % character + +By default non-monthly files have a hfilename_spec of: "%c.cam1.h%t.%y-%m-%d-%s.nc" +Hence, for example, with a caseid="test", tape number 2, writing it's first data +for 12/1 UT 0:0 for year 1, will have the filename: +"test.cam1.h1.0001-12-01-00000.nc". + +Namelist: + + nsmvn, nrmvn, and rirt removed from namelist. + old irt renamed to mss_irt + old nswrps renamed to mss_wpass + + Added hfilename_spec filename specifyer to history filenames. + Added archive_dir to give MSS archive directory + + (now defaults to /USERNAME/caseid/csm/atm). + +Filenames module: + + New module to deal with filenames, and MSS options and interpret +filename specifiers (as above). Unit-test for this module was created. + +Restarts: + + history and abs-ems restart full filepaths added to master restart file. +Restart pointer file changed to include information on all files needed to +successfully do a restart. Restart files are disposed to MSS when closed +rather than in wrapup. + +History: + + History filenames are created and opened when data is first written to +them. Added methods: get_mtapes, get_hist_restart_filepath, get_hfilepath +to get private data in history module. Increase length of filenames to 256. + +CCSM scripts: + + models/bld updated to ccsm2_0_beta35, scripts updated to +scripts_a011228_brnchT_a020201. system_test script updated to changes in these +scripts. atm.setup.csh updated for new namelist changes. + +test-model.pl: + + New SOM dataset names added. Changed test-model.pl to use NEWBUILD +mechanism which should speedup build, changed so that error-growth tests +run without trace-gas, but with readtrace to exercise more code options. Set +nhtfrq(1) for restart tests so that all history files produce restart files. +Change Makefile so that explicit path to mkSrcfiles and mkDepends scripts +is given (using Rootdir). + +CLM: + + CLM updated to CLM2.3.17 (uses new CCSM filename convention). Update +to filenames module and namelist change. + +Move files unused by CLM from atmlnd_share to control: + (Testing of files in atmlnd_share is insufficient to work with + CLM2. So we are working on seperating the two.) + ioFileMod.F90, gauaw_mod.F90, wrap_mpi.F90 + ioFileMod.F90 changes so that comments, and mvn is not needed, and + SHELL_MSS option becomes standard. + +MSS: + + Remove MSS comments when mswrite done, and remove SHELL_MSS CPP token, +since always used. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev27 +Originator: eaton ( Brian Eaton) +Date: Fri Feb 8 18:19:23 MST 2002 +Model: CAM +Version: CAM1.7.dev27 +One-line Summary: bugfix for CAM makefile +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC-Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Erik +Restart files change: no +Changes answers: no +Changes to CLM land-model: None +Changes made: + +The CAM build was failing when the new ESMF macro MF_BUILD was set to a +relative path. Added fix to CAM makefile to convert the relative pathname +to an absolute one. + +Misc: modified bld/condense-path.pl to look for CAM.pm in $MODEL_CFGDIR. +This allows bld/configure.csh to be used in a directory other than bld. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev26 +Originator: eaton ( Brian Eaton) +Date: Wed Feb 6 14:52:17 MST 2002 +Model: CAM +Version: CAM1.7.dev26 +One-line Summary: update esmf to MF_LLU_0_0_12p1 and add fixes for lf95 +Requires change in build system: yes +CAM Makefile modified to set MF_BUILD macro used by esmf makefile. +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC-Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +David Neckels' summary of changes in MF_LLU_0_0_12p1: +> Version: MF_LLU_0.0.12 +> One-line summary: Added relocatable build support. +> Changes made: +> +> -Added variable MF_BUILD, which allows the code to be built in a +> directory other than the default. To use, invoke: +> gmake BOPT=g MF_BUILD=/tmp/esmf_build +> This will build the library under "/tmp/esmf_build". The object files, +> the library and the mod files will all be created under the new +> directory. +> +> -Added an install target to makefile. The variables MF_LIB_INSTALL +> and MF_MOD_INSTALL determine where the libraries and mod files are +> copyed during the install: (e.g) +> gmake BOPT=g MF_BUILD=/tmp/esmf_build MF_LIB_INSTALL=/usr/lib \ +> MF_MOD_INSTALL=/usr/mod install +> (Notice that once the MF_BUILD is used, it must be passed to the +> subsequent make commands). + +The CAM Makefile was changed to set the MF_BUILD directory to $(MODEL_EXEDIR)/esmf. + +The latest lf95 compiler (lf9561) required the following changes to the source code: + +physics/cam1/{radae.F90,chemistry.F90} - removed save attribute in variable +declarations that were in the same scope as a save statement. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev25 +Originator: eaton ( Brian Eaton) +Date: Tue Feb 5 12:04:52 MST 2002 +Model: CAM +Version: CAM1.7.dev25 +One-line Summary: remove prognostic sulfur cycle stubs +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, PC-Linux +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes made: + +Only the interface to the prognostic sulfur cycle is being removed. The +following independent features have not been removed: 1) a specified +sulfate aerosol distribution may be read from a dataset, 2) a ramp function +may be applied to the specified sulfate distribution, and 3) the indirect +radiative effects of sulfate aerosols may be estimated. + +Modify files: +control/history.F90 +control/initext.F90 +control/parse_namelist.F90 +control/restart.F90 +dynamics/eul/inidat.F90 +dynamics/fv/inidat.F90 +dynamics/sld/inidat.F90 +physics/cam1/advnce.F90 +physics/cam1/initindx.F90 +physics/cam1/inti.F90 +physics/cam1/moistconvection.F90 - left icwmr in arg list of cmfmca. +physics/cam1/radctl.F90 +physics/cam1/tphysac.F90 +physics/cam1/tphysbc.F90 +physics/cam1/tracers.F90 +physics/cam1/zm_conv.F90 +physics/ccm366/advnce.F90 +physics/ccm366/initindx.F90 +physics/ccm366/tracers.F90 + +Remove files: +control/acbnd.F90 +control/clddiag.F90 +control/dmsbnd.F90 +control/drydep.F90 +control/massbgt.F90 +control/scyc.F90 - move the indirect flag into comctl.h. Use this flag + directly rather than via the doindirect query method. +control/soxbnd.F90 +control/sulbnd.F90 +control/sulchem.F90 +control/sulemis.F90 +control/wetdep.F90 + +Misc: + Change variable count to count1 in history.F90(wshist) to fix a problem + with the pgf90 compiler. count is the name of an F90 intrinsic function + and apparently using it as a local variable was causing a problem. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev24 +Originator: olson ( Jerry Olson) +Date: Thu Jan 31 17:06:44 MST 2002 +Model: CAM +Version: CAM1.7.dev24 +One-line Summary: modifications and bufixes to eulerian, sld, and physics + routines +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (IBM only) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Restart files change: no +Changes answers: EUL: no (bit-for-bit; unless "DIVDAMPN" is used in namelist) + SLD: Yes (same-physics) +Changes to CLM land-model: None +Changes made: + + bugfixes: + - divergence damper in Eulerian code + src/dynamics/eul/hordif.F90 + - SLD energy fixer + src/physics/cam1/comsrf.F90 + src/physics/cam1/physpkg.F90 + src/physics/cam1/radctl.F90 + src/physics/cam1/tphysbc.F90 + + other mods + - SLD vector-field advection routine + src/dynamics/sld/nunv1.F90 + - src/advection/sld/engy_tdif.F90 + - removed an option from idealized physics + src/physics/cam1/phys_idealized.F90 + src/physics/cam1/tphysidl.F90 + - modified "test_trace3" tracer + src/physics/cam1/tphysac.F90 + +=============================================================== +=============================================================== + +cam1_7_dev23 +Originator: sawyer ( William Barton Sawyer) +Date: Wed Jan 16 13:46:35 MST 2002 +Model: CAM +Version: CAM1.7.dev23 +One-line Summary: Upgraded fvCAM to newest mod_comm primitives +Requires change in build system: no +Substantial timing or memory changes: possibly faster +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Putman (mod_comm primitives) +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: (For changes that change answers) +Changes to CLM land-model: None (one-line description) +Changes made: + + models/utils/pilgrim: + + removed bufferpack/unpack 2d,3d,4d primitives (in mod_comm) + mod_comm.F90: added generic mp_send/recv primitives + + models/atm/cam/src/dynamics/fv + + cd_core.F90 d2a3dijk.F90 d2a3dikj.F90 dynpkg.F90 + highp2.F90 hswf.F90 p_d_adjust.F90 te_map.F90 uv3s_update.F90 + + replaced parbegin/endtransfer primitives with mp_send/recv + primitives from mod_comm. The only tricky part about this + was determining the proper source and destination PE numbers: + in the 2D decomposition this depends on the ordering of + the mapping of the decomposition to the PEs (row-major or + column-major). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev22 +Originator: mirin ( Arthur Andrew Mirin) +Date: Tue Jan 15 14:49:36 MST 2002 +Model: CAM +Version: CAM1.7.dev22 +One-line Summary: Support history files for 2D FV decomposition +Requires change in build system: no +(one-line description of changes: Makefile, include files, directories, etc.) +(Detailed description below) +Substantial timing or memory changes: no +Requires change in run script: no +(one-line description of changes: data files, run-scripts, namelist etc.) +(Detailed description below) +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation:not-applicable +Changes answers: no (bit-for-bit) +(Note: test-model.pl only does checks this -- if you run it with the "-c" option) +Name of tests cases on NCAR Mass-Store: (For changes that change answers) +Changes to CLM land-model: None (one-line description) +Changes made: + +Changed history.F90, uv3s_update.F90 and restart_dynamics.F90. +Also changed CAM_lab.pm and script.m4. + +Main changes were to history.F90, in order to support 2D FV decomposition. +The field_info structure was generalized to include a vertical extent. Support +for dynamics variables having global vertical extent 1, plev and plevp was added; +however, only tested variables had global extent plev. New coding supports 64-bit +accumulation buffers. 32-bit accumulation buffers are still not supported for +2D FV but are supported for 1D FV decomposition. + +Previous coding had bug involving non-preservation of subscript array +range for associated pointers. That bug affected the hbuf_accum routines and +hbuf_compute_avg. Bug has been fixed; inside those routines relevant arrays +have beginning subscript equal to 1. + +uv3s_update.F90 needed minor fix to properly call the history routine. + +restart_dynamics.F90 had a minor bug involving 2D FV decomposition. + +script.m4 (DAO) was given 1-line change involving ccm to cam transition. + +CAM_lab.pm had 1-character change involving working directory on LLNL frost. + + + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev21 +Originator: sawyer ( William Barton Sawyer) +Date: Mon Jan 7 07:38:50 MST 2002 +Model: CAM +Version: CAM1.7.dev21 +One-line Summary: Merge of current DAO fvGCM FV dycore into CAM baseline: ghosting of variables, mod_comm for communication +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Linux +Ran test-model.pl script: no (test-model.pl -l dao not currently working) +Tested on fv dynamics: yes +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: no +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): no +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: n/a +Changes to CLM land-model: None (one-line description) +Changes made: + + Phase 2 of fvGCM-CAM fv dycore merge: ghosted prognostic + variables U3S, V3S, Q3. Uses mod_comm for communication + (as well as pilgrim). More consistent use of "only" statement + in "use" lines. Upgrade of pilgrim (synchronized with DAO + Chemistry Transport Model development) and mod_comm (should + compile on Compaq now). + + models/utils/pilgrim: + + pilgrim.h, parutilitiesmodule.F90, ghostmodule.F90: + synchronized with DAO CTM development. + mod_comm.F90 : should now compile on Compaq (sorry, + not tested -- no access to a Compaq) + + models/atm/cam/src/control: + + history.F90: rather ugly code to support write of + ghosted U3S array. Well be improved in later version. + + models/atm/cam/src/dynamics/fv + + prognostics : ghosted variables U3S, V3S, Q3 + + cd_core.F90, trac2d.F90 : ghosting of U, V, Q3, replaced many + pilgrim calls with mod_comm. + + benergy.F90, dryairm.F90, inidat.F90, restart_dynamics.F90 + map1_ppm.F90, d2a3dijk.F90, d2a3dikj.F90, dynpkg.F90, + te_map.F90, fv_prints.F90, p_d_adjust.F90, dp_coupling.F90, + hswf.F90, uv3s_update.F90 : accommodated ghosted variables. + + mod_mpi.F90 : retired (now uses mod_comm) + + dynamics_vars.F90 : new temporary unghosted variables as + interim solution for 2D decomposition redistributions. + + stepon.F90 : ghosted variable u3sxy + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev20 +Originator: rosinski ( Jim Rosinski) +Date: Wed Jan 2 16:48:01 MST 2002 +Model: CAM +Version: CAM1.7.dev20 +One-line Summary: Mods to SOM: MLD renamed MLDANN on SST dataset., and contains + yearly values. SPMD SOM indexing fix. No resetting SICTHK, + SNOWH, TSSUB in SOMINI +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, PC +Ran test-model.pl script: no +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: no (bit-for-bit) at least for non-SOM configurations +Changes to CLM land-model: None +Changes made: + +NOTE: All changes are to slab ocean model (SOM) code. + +o Changed name of mixed layer depths to MLDANN on SST boundary file +o Fixed indexing bug in SPMD mode (SOMINI, SOMINT) +o Removed code from SOMINI which reset SICTHK, SNOWH, TSSUB, ORO. + +=============================================================== + +cam1_7_dev19 +Originator: sawyer ( William Barton Sawyer) +Date: Thu Dec 27 07:47:01 MST 2001 +Model: CAM +Version: CAM1.7.dev19 +One-line Summary: FV core upgrade: Q3 indexing changed to (i,j,k,iq); no changes in order on history/restart files +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Art Mirin +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: (For changes that change answers) +Changes to CLM land-model: None (one-line description) +Changes made: + + Changed indexing of prognostic var. Q3 from (i,k,iq,j) to + (i,j,k,iq) in FV dynamical core. This change affected + numerous files in FV, + + cd_core.F90 fv_prints.F90 pmgrid.F90 stepon.F90 + dp_coupling.F90 inidat.F90 prognostics.F90 sw_core.F90 + dryairm.F90 mod_mpi.F90 restart_dynamics.F90 te_map.F90 + dynpkg.F90 p_d_adjust.F90 spmd_dyn.F90 trac2d.F90 + + and one common file: src/control/history.F90. + + The section in history is protected by an "if ( dycore_is('LR) ) then" + line (and is also embedded in an #ifdef STAGGERED CPP statement -- + does any other dycore use STAGGERED?) + + The order of Q3 on the initial/restart files has *not* changed. + For the time-being there is logic to read and write Q3 in the + original order. This might change (in restart_dynamics.F90) later on. + + + models/util/pilgrim/mod_comm.F90 has also been upgraded with + new routines; which are not yet used by the FV core. A code + review/revision of these changes by Putman/Shen is pending. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev18 +Originator: eaton ( Brian Eaton) +Date: Tue Dec 18 12:40:35 MST 2001 +Model: CAM +Version: CAM1.7.dev18 +One-line Summary: changes for share constants +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, sun, pc/linux/pgf +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: Erik, myself, and Mariana +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: Yes, new constants sometimes agree to only 2 digits with old ones. This tag requires scientific validation. +Name of tests cases on NCAR Mass-Store: Erik will do production runs. +Changes to CLM land-model: Updated to clm2_3_dev10. +Changes made: + + Update CLM to clm2_3_dev10. + + The following changes were implemented by Erik and reviewed by me. + + Use values of constants from models/csm_share/shr_const_mod.F90 for + consistency with other CCSM component models. The changes are mainly in + the physics/cam1/physconst.F90 module. + + Also changed some hard-wired constants in individual parameterizations: + + ocnsice/dom/srftsb.F90 + cmair = cpair (was 1.00e3) + cmice = shr_const_cpice (was 2.07e3) + rhair = shr_const_rhodair (was 1.25) + rhice = shr_const_rhoice (was 9.20e2) + + ocnsice/som/oceanconst.F90 + tof = shr_const_tkfrz -1.9_r8 (was 271.26) + rhoocn = shr_const_rhosw (was 1.026e3) same + cpocn = shr_const_cpsw (now 3.996e3, was 3.930e3) + tsm = shr_const_tkfrz (was 273.16) + + physics/cam1/cldwat.F90 + rhonot = rhodair/1000. (was 1.275e-3) + t0 = tmelt (was 273.16) + replace hard-wired 273.16 with t0 + + physics/cam1/esinti.F90 + pass tmelt as an arg + + physics/cam1/gffgch.F90 + replace hard-wired 273.16 with tmelt + + physics/cam1/radae.F90 + amd = mwdry (now 28.966, was 28.9644) + + Made some interface changes to provide initialization routines for + setting constants in parameterizations. + + Moved routines for water vapor pressure calcs into new wv_saturation + module. + + Moved routines for shallow convection into moistconvection module. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev17 +Originator: sawyer ( William Barton Sawyer) +Date: Tue Dec 18 07:25:41 MST 2001 +Model: CAM +Version: CAM1.7.dev17 +One-line Summary: Bug fix of mod_comm library for AIX and Linux +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, Linux +Ran test-model.pl script: no +Tested on fv dynamics: yes +Tested on eul dynamics: no +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: no +Tested that different domain decompositions match bit-for-bit: no +Tested in adiabatic mode: no +Code reviewed by: myself, Shen +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: N/A +Changes to CLM land-model: None +Changes made: + + models/utils/pilgrim: memstuff.c, mp_assign_to_cpu.c mod_comm.F90 + + Minor bug fixes to get mod_comm to compile and run on AIX and Linux + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev16 +Originator: sawyer ( William Barton Sawyer) +Date: Mon Dec 17 03:19:29 MST 2001 +Model: CAM +Version: CAM1.7.dev16 +One-line Summary: FV dycore improvements: mod_comm comm. library; more support for 2D decomposition +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: SGI +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Putman, Lin +Updated the DatasetLog (for new input data-files): no +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: N/A +Changes to CLM land-model: None +Changes made: + + model/utils/pilgrim: + + mod_comm.F90: optimized comm. library (Lin, Putman, Shen) + memstuff.c: related utilities for MLP parallelism + mp_assign_to_cpu.c: CPU pinning utility (MLP and MPI modes) + + model/atm/cam/bld + + CAM_lab.pm: improvements for -l dao + configure_fv.pl, script.m4: Additional support for 2D decomp. + + model/atm/cam/src/dynamics/fv + + benergy.F90, cd_core.F90, dynpkg.F90, geopk.F90, + hswf.F90. prognostics.F90, restart_dynamics.F90, + spmd_dyn.F90, stepon.F90, te_map.F90: + + Phase 1 of transition to mod_comm library, + mod_mpi replaced by mod_comm in cd_core.F90. + Variable PT ghosted throughout various routines. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev15 +Originator: rosinski ( Jim Rosinski) +Date: Thu Dec 6 11:47:59 MST 2001 +Model: CAM +Version: CAM1.7.dev15 +One-line Summary: Add per-tape averaging flag. Delete inlining for SGI +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, PC +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): no or Yes or not-applicable +Updated the documentation: no +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: (For changes that change answers) +Changes to CLM land-model: None +Changes made: + +o Added namelist option avgflag_pertape. Usage ex: if set avgflag_pertape(2) = 'I', + all fields on history file 2 will by default be instantaneous. Can still + be overridden (for example) with fincl2 = 'T:A' + +o Deleted inlining for SGI (a mod to bld/Makefile). Inlining slowed compilation + down by 60% and resulted in zero or negative speedup. Could also delete for + other machines, but Makefile mods, compilation time and execution time effects + of including inlining were not nearly as obnoxious as on SGI so left alone for now. + +o Added addfld call for NSTEP. Writing this field to history file is often useful + for diagnosing mods to history.F90. By default this field is not written. + +o Moved dycore print from parse_namelist.F90 to cam.F90 + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev14 +Originator: mvertens ( Mariana Vertenstein) +Date: Tue Dec 4 09:08:53 MST 2001 +Model: CAM +Version: CAM1.7.dev14 +One-line Summary: put in esmf calendar manager into clm2 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, erik +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: Yes (for clm2 only) +Changes answers: On utefe(sgi) and prospect (compaq) the result were +bfb when running test-model.pl with the -c option. On the ibm, +the changes were roundoff compared with cam1_7_dev13 when running with +the esmf libO version and bfb when running with the esmf libg version +(differences only appeared after 98 times steps and were due to +roundoff differences in the computation of the calendar day) +Changes to CLM land-model: Yes + +1) Put in the esmf time manager into clm2 + Brought cam code up to date with clm2_3_dev6. + Only clm2 code was changed. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== + +=============================================================== + +cam1_7_dev13 +Originator: eaton ( Brian Eaton) +Date: Sun Dec 2 15:54:13 MST 2001 +Model: CAM +Version: CAM1.7.dev13 +One-line Summary: make history files conform to CF metadata conventions +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, sun, linux-pgf +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: +Changes to CLM land-model: None +Changes made: + + Changes are all in history.F90 except for some units changes in addfld + calls in gw_drag.F90. The modifications are: + .Fix units attributes. + .Fix convention attribute. + .Fix description of hybrid vertical coordinates. + .Write all coordinate variables as type double. + .Fix description of time averaged values. + .Add time interval boundaries. + .Remove _FillValue attribute for variables on a full grid. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev12 +Originator: eaton ( Brian Eaton) +Date: Thu Nov 29 19:08:09 MST 2001 +Model: CAM +Version: CAM1.7.dev12 +One-line Summary: update ESMF lib to MF_LLU_0_0_11p3 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, sun, linux/pgf +Ran test-model.pl script: yes +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: David Neckels +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: +Changes to CLM land-model: None +Changes made: + + Update the ESMF library from version MF_LLU_0_0_11p2 to MF_LLU_0_0_11p3. + Date increment incorrectly normalized itself when on the first month of the + year. The time management increment function did not completely construct + itself. These bugs were uncovered during unit testing of the ESMF library + by David Neckels. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev11 +Originator: mirin ( Arthur Andrew Mirin) +Date: Wed Nov 28 23:02:45 MST 2001 +Model: CAM +Version: CAM1.7.dev11 +One-line Summary: Changes for multi-2D decomposition for FV dycore +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Sawyer +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: Yes (minor roundoff differences in FV dycore routine te_map.F90) +(Note: test-model.pl only does checks this -- if you run it with the "-c" option) +Name of tests cases on NCAR Mass-Store: (For changes that change answers) +Changes to CLM land-model: None (one-line description) +Changes made: +Changed 13 files in dynamics/fv; most changes were fairly minor. +Changed control/spmdinit.F90. +Changes 3 files in physics/cam1, to allow more general chunking. These changes were actually made by Pat Worley. +Changed 2 files in Pilgrim (minor). +Added batch capability for test-model.pl for LLNL IBM Frost. +Minor change to CAM_lab.pm for LLNL Frost. +Minor changes to DAO scripts configure_fv.pl, script.m4. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev10 +Originator: mvertens ( Mariana Vertenstein) +Date: Mon Nov 26 08:32:45 MST 2001 +Model: CAM +Version: CAM1.7.dev10 +One-line Summary: changed mpi distribution of subgrid patches in clm2 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq +Ran test-model.pl script: yes (does all of the following tests) +On Compaq only tested eul dynamics +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Ran test-model.pl with -compare optio +Changes to CLM land-model only: +Brought cam code up to date with clm2_3_dev4 +1) changed the distribution of subgrid patches among processors + so that patches for a given land point must all be on the same processor +2) changed all mpi gather/scatter calls to mpi gatherv/scatterv calls + and introduced subroutines to determine the asymmetric vector lengths +3) Put in CF1.0 conventions into clm history file +4) removed rtm_doavg from namelist - rtm averaging is now done + if rtm_nsteps is set to greater than 1 (this does not appply + to cam model unless cam is run with RTM - by default this is + not the case) + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev9 +Originator: erik ( Erik Kluzek) +Date: Wed Nov 21 16:02:10 MST 2001 +Model: CAM +Version: CAM1.7.dev9 +One-line Summary: Get coupled model to work, update to scripts_a011121 + and bld_b011121 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: Yes! (IBM only) +Machines tested: IBM +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Terminate string in clm_csmMod.F90 so would compile. +Changes made: + +Make changes needed to get CAM to work with coupled with CCSM. Update models/bld +to bld_b011121, and scripts/test.a1 to scripts_a011121. Run csm.csh on babyblue +to make sure would work. Also ran on utefe, but lnd.setup.csh failed due to +a "getdata" problem, the compile of CAM was successful however. Update "csm.csh" +coupled version to ccsm2_0_beta26. + +Change ccsm_msg.F90 to use time_manager to get nstep (from Lawrence Buja). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev8 +Originator: eaton ( Brian Eaton) +Date: Wed Nov 21 08:47:35 MST 2001 +Model: CAM +Version: CAM1.7.dev8 +One-line Summary: add perpetual calendar option to time manager +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, pc-linux, sun +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): no +Updated the documentation: Yes +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: +Changes to CLM land-model: None +Changes made: + +Add namelist variables to enable perpetual calendar: + +logical perpetual_run - Set to .true. to specify that a perpetual run is + being done (default is .false.). If perpetual_ymd + is not set then read the perpetual date from the + initial file. + +integer perpetual_ymd - Perpetual date specified as (year*1000 + month*100 + + day). This overrides value from initial file. + +If aqua_planet=.true. then the values of perpetual_run and perpetual_ymd +are ignored. aqua_planet mode uses a perpetual date of 321. + +Modify files: + +control/time_manager.F90 - add perpetual_run, perpetual_ymd to public data. +add is_perpetual method to indicate that perpetual calendar is in use. +Modify internal logic so that perpetual calendar doesn't depend on +aqua_planet mode. Add an optional argument to specify an offset in the +get_curr_date method (needed by the CLM). + +control/parse_namelist.F90 - add perpetual_run, perpetual_ymd. + +Modify code in the following files to use the perpetual date when +interpolating boundary datasets if perpetual calendar is in use. +control/initext.F90 +control/oznini.F90 +control/oznint.F90 +control/so4bnd.F90 +dom/sst_data.F90 +physics/advnce.F90 +physics/chemistry.F90 +physics/tphysac.F90 + +Misc: +control/initext.F90 - There was code in a #ifdef COUP_CSM section that was +nested inside a #if (!defined COUP_CSM) section. Remove this code which +wasn't being executed anyway. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev7 +Originator: eaton ( Brian Eaton) +Date: Fri Nov 16 17:35:37 MST 2001 +Model: CAM +Version: CAM1.7.dev7 +One-line Summary: update ESMF library +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, pc, sun +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and David Neckels +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: +Changes to CLM land-model: None +Changes made: + + Update the ESMF library from version MF_LLU_0_0_11 to MF_LLU_0_0_11p2. + This includes bugfixes for the mfm_datedecrement and mfm_timemgrlaststep + functions. + + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev6 +Originator: erik ( Erik Kluzek) +Date: Fri Nov 16 09:37:28 MST 2001 +Model: CAM +Version: CAM1.7.dev6 +One-line Summary: Update ESMF to MF_LLU_0_0_11, change test-model.pl interface, fix problem with run-model.pl +Requires change in build system: Yes +(Changed Makefile on sun to be compatable with new ESMF) +(Changed Makefile for Linux-PGF90 so sgexx.F doesn't get compiled with -fast) +Substantial timing or memory changes: no +Requires change in run script: Yes (run-model.pl scripts need to use + setup_directories( "support" ) +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, Sun, Linux-PGI (NERSC-IBM, ORNL-IBM) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Mariana Vertenstein +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes to ESMF: Update to MF_LLU_0_0_11 +Changes made: + +ESMF Update: + + Get newer version of ESMF library. This fixes a problem with calculating +the ending date (which fixes a problem that the CLM had in writing out restart +files at the end of the run). It also fixes problems in building on several +platforms. The previous version did not build on the DAO SGI (tropic) for +example. + +Makefile changes: + + SUN: Use -dalign for DEBUG, and otherwise -fast to be compatable + with the new version of ESMF. + + Linux-PGF90: Set to compile sgexx.F withotu -fast, so that SLD + simulations won't hang. + +run-model.pl change: + Change so that CAM_run.pm sets up a directory to build makdep in + like test-model.pl does. This allows run-model.pl to use the same + source directory, but submit to different machines simultaneously. + The change requires the setup_directories( "support" ) method to + be called from run-model.pl type scripts. + +test-model.pl changes: + + Change interface from mixed short names like "-l" and "-nofail" to +consistent longer names: "-lab", "-compare", "-help" etcetera. + + -l ==> -lab + -c ==> -compare + -h ==> -help + -t ==> Eliminated you now get the list of test from -help + -r ==> -resume + -dirty ==> -noclean + -e ==> -errgro + -s ==> -skip + +For backwards compatability, -l, -c, -r, -e, and -s are still allowed, although +the longer names are prefered. + +ornl: Change default CASE_DIR to a GPFS directory so that builds will work. +llnl: Change default SPMG_CMND depending on whether machine has prun or dmpirun. + Will now automatically detect which exists and use the one that works. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev5 +Originator: eaton ( Brian Eaton) +Date: Tue Nov 13 10:19:40 MST 2001 +Model: CAM +Version: CAM1.7.dev5 +One-line Summary: makefile changes for ESMF library build +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq, PC/linux-pgf +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself and Erik +Updated the DatasetLog (for new input data-files): no +Updated the documentation: no +Changes answers: no (bit-for-bit) +Name of tests cases on NCAR Mass-Store: +Changes to CLM land-model: None +Changes made: + +Modified the CAM Makefile to prevent unnecessary rebuilding of the ESMF +library. + +The ESMF Makefile has been improved (by David Neckels) to include support for +more Fortran compilers under Linux, and to allow simultaneous builds of the +library from different platforms with access to the same source on a shared +filesystem. There is also a README file for the ESMF build in +top_dir/models/utils/esmf/README. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev4 +Originator: erik ( Erik Kluzek) +Date: Fri Nov 9 11:44:51 MST 2001 +Model: CAM +Version: CAM1.7.dev4 +One-line Summary: Fix problem with run-model.pl, add condense-path utility, + update ESMF to MF_LLU_0_0_10p1 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI, Compaq (partial tests on Linux and Sun) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Known problems: SOM test fails on AIX, LSM/phys366 test fails on Linux + SLD test 3 (in test-model.pl) hangs on Linux-PGf90 +Code reviewed by: myself, Brian Eaton +Changes answers: no (bit-for-bit) +Changes to CLM land-model: None +Changes to ESMF: Update to MF_LLU_0_0_10p1 +Changes made: + +Fix path problems with run-model.pl + + Add a condense-path.pl utility to shorten pathnames with "/.." in them. +This is important since the longer directory names of CAM and the multiple +levels cause line length problems when building. + +test-model.pl: Turn SOM test on for all platforms but AIX + + Let the SOM test happen for all platforms except the IBM where it fails. +Once this is fixed we should re-enable it. + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +cam1_7_dev3 +Originator: mvertens ( Mariana Vertenstein) +Date: Wed Nov 7 13:00:31 MST 2001 +Model: CAM +Version: CAM1.7.dev3 +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: no +Tested to work coupled with CCSM: no +Machines tested: IBM +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: no +Tested on eul dynamics: yes +Tested on sld dynamics: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: no (bit-for-bit) +Simulations: + /ERIK/csm/eul17dev3_a ---- 5 year simulation with + PCMDI climatological SST's +Changes made: + +1) put in restart consistency checks between cam and clm2 + i.e ensure that both models restart with same time step + +=============================================================== +=============================================================== + +cam1_7_dev2 +Originator: mvertens ( Mariana Vertenstein) +Date: Wed Nov 7 10:16:12 MST 2001 +Model: CAM +Version: CAM1.7.dev2 +One-line Summary: Put in three clm2 bug fixes that change answers +Requires change in build system: no +Substantial timing or memory changes: no +Requires change in run script: Yes + CLM2 namelist must have the following changes: + 1) fpftcon = $LM_DATDIR/pftdata/pft-physiology-vegdyn-cleanup-ratio + 2) remove mksrf_firr from namelist +Tested to work coupled with CCSM: no +Machines tested: IBM, SGI +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Erik Kluzek +Updated the DatasetLog (for new input data-files): not-applicable +Updated the documentation: not-applicable +Changes answers: Yes (new-physics - bug fixes) +Changes to CLM land-model: YES +Changes made (CLM2 code): +Put in changes from clm2_2_12, clm2_2_13, clm_2_14 + +clm2_2_12: +1) Update to clm2 changes from CCM3.12.62, from Brian Eaton + "Use public data and methods from time_manager mod for initialization." + +clm2_2_13: +1) cleaned up pft physiology file and related code + removed anything related to biogeochemistry when DGVM is off (not defined) +2) used ratio of roughness length and displacement height to canopy top height + instead of actual values for roughness lenght and displacement height +3) fixed openmp bug in RtmMod.F90 +4) fixed branch bug in AccumulMod.F90 +5) fixed DGVM bug in Fire.F90 + +clm2_2_14: +The clm2 code in this tag is clm2_2_14 with Erik's cam1_7_1 mods +where ccm->cam in various files min the clm2/main directory +1) (Biogeophysics_Lake.F90) - Fixed bug in lake model where latent heat of + fusion was being used (incorrect) instead of latent heat of sublimation + (correct). + Also Fixed two "problems" noticed in the b202.20.0 simulations: +2) (CombineSnowLayers.F90) - Global water and ice contents in the + top soil layer were increasing with time. Eliminated ponding in + wetlands by assigning snow melt to runoff. +3) (SurfaceRunoff.F90) - Eliminated formation and growth of basal ice layer + beneath snow cover by assigning snow melt reaching impermeable ground + surface to surface runoff. + The above three fixes were tested by examining output from several single + point and 21-year standalone simulations. No trends in surface soil + water and ice were noted. Lake bug fix has small effects on surface + fluxes from grid cells with lakes that have snow cover. +4) Put in volr in initial dataset +5) Put in restart id tag on restart file for consistency - + if restart file is modified, the parameter rest_id in restFileMod.F90 + must be updated. +6) Set maximum number of auxillary history files to 2 to be + consistent with parameter settings. + +=============================================================== +=============================================================== + +cam1_7_dev1 +Originator: erik ( Erik Kluzek) +Date: Wed Nov 7 09:11:22 MST 2001 +Model: CAM +Version: CAM1.7.dev1 +One-line Summary: Move from CCM to CAM, mask error-growth problems by not + letting CLM see snowfall, Change build +Requires change in build system: Yes! + (Change COUP_CCM to COUP_CAM for CLM, Makefile uses Rootdir file for + ESMF build, ESMF build is done from within Makefile, directory + structure different) +Substantial timing or memory changes: no +Requires change in run script: Yes! + (namelist is now camexp instead of ccmexp, input data files directory + changed, Env variable for datasets is now $CSMDATA) +Tested to work coupled with CCSM: no (need to update CCSM build for ESMF) +Machines tested: IBM, SGI, Compaq, Sun, Linux-PGF90 + (SOM test fails on IBM, LSM/PHYS366 test fails on Linux) +Ran test-model.pl script: yes (does all of the following tests) +Tested on fv dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Code reviewed by: myself, Mariana Vertenstein, Brian Eaton (som changes) +Updated the DatasetLog (for new input data-files): no (but need to) + Did create 26 level T21 datasets for testing, and got test-datasets + at T42L18 for SOM + (new datasets at ftp.cgd.ucar; cd pub/erik; + get cam1_7.scidac-atm.datasets.tar.gz) +Updated the documentation: Yes (first pass at changes from CCM to CAM) +Changes answers: no (bit-for-bit) +Changes to CLM land-model: Yes (COUP_CCM to COUP_CAM, nix references to ccm) +Changes made: + +Change references from CCM to CAM. + +datafiles: ccmr and ccmi files are now camr and cami +filenames: ccm3, conv_ccm, ccmoce, are now cam, conv_cam, camoce +lnd filenames: ccm_lndMod, lnd_ccmMod, are now atm_lndMod, and lnd_atmMod +CPP Tokens: COUP_CCM is now COUP_CAM +Directory structure: New directory structure compatable with the "cam1" + cvs module rather than the "ccm" cvs module. +Other references in code and comments to CCM were changed to CAM. + +New build: + + Build changed to create a Rootdir file with the top level directory +of "cam1". This is used by the Makefile to figure out the location of the ESMF +directory. The Makefile then builds the ESMF library directly from the +Makefile. This new build system comes from David Neckels via Brian Eaton. +It is a much easier more robust way of building the model. The env variable +DYNAMICS for Lin-Rood should now be set to "fv" in agreement with the new directory name. For the SUN take out the "-fast" option to be compatible with the +ESMF library build (put this back in when ESMF build is updated). + +Run scripts: + +Run scripts use "CSMDATA" instead of MODEL_DATDIR. AM_DATDIR, and LM_DATDIR +env variables removed. New directory structure for cam with subdirectories +for: inic, ggas, rad, hrtopo, ozone, scyc, and sst for initial conditions, +greenhouse gas, radiation, high-resolution topography, ozone, sulfur-cycle +and sea surface temperatures respectively. The environment variable OCEAN +was added to refer to the ocean model to use "dom" or "som". The env variable +PHYSICS now either should be "cam" or "ccm366" to refer to the type of physics +used. + +Error-growth problem: + + Mask the current error-growth problem to some extent by only letting +CLM see rain and not snowfall. Error-growth for FV still seems to be large. + +Remove Sulfur-cycle codes: + + Remove the sulfur-cycle codes (they are still accessible on the +cam_brnch_scyc branch and with the cam1_scyc module). In their place the +dummy stubs from dscyc were put into the control directory. Eventually, we +will rip these out of the main development and only leave them on the +sulfur-cycle branch. + +Changes to test-model.pl: + + Change vertical resolution of the sld and eul tests to 26, in agreement +with the vertical resolution used for production simulations (the difference +in vertical resolution can have an impact on how changes to physics are +perceived). Remove "-clean" option and make cleaning old directories out the +default, add the option "-dirty" to not clean files before the build. + +Users Guide: + + Users Guide now part of the distribution, first pass on moving from +CCM3.12 to CAM was completed. Namelist documentation is up to date, directory +structure is outlined. Further updates should update documentation at the +same time that code is changed. + +SOM: + + SOM now part of the distribution, SOM was updated to use the new +timing routines. "test-model.pl" has a test for SOM that is currently commented +out since it doesn't run on the IBM (does complete on other platforms however). + +See: http://www.cgd.ucar.edu/cgi-bin/cms/ncar_only/view_change_file.cgi?ChangeLog + for latest version of this file on the web. +=============================================================== +=============================================================== + +ccm3_12 +Originator: erik ( Erik Kluzek) +Date: Wed Jun 13 11:35:28 MDT 2001 +Model: CCM +Version: CCM3.12 +One-line Summary: New H2O LW abs/ems, geo-potential, precip evap, cloud-water changes, no oro-drag over ocean +Requires change in build system: no (but, Makefile updated for in-lining, see below) +Substantial timing or memory changes: no +Requires change in run script: Yes (New abs_ems_dataset, see below) +Tested to work coupled with CSM: Yes (IBM and SGI) +Machines tested: IBM, SGI, Compaq, Sun, Linux (see below) +Ran test-model.pl script: yes (does all of the following tests) +Tested on lr dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: yes +Updated the DatasetLog (for new input data-files): Yes +Updated the documentation: no (but need to) +Changes answers: Yes (new-physics) +Name of tests cases on NCAR Mass-Store: + /JET/csm/zm31139evap06 ---- Climatological SST's T42L26, Eulerian dynamics + /JET/csm/amipevap06 ------- AMIP2 SST's T42L26, Eulerian dynamics + /JET/csm/amipevap06_3h ---- Daily output same as above. + /CCSM/csm/b202.02 --------- Coupled simulations, T42L26, Eulerian dynamics +Changes made: + +IMPORTANT: Problems on SUN, and Linux, problems on batch submission to: + blue, eagle, gseaborg (see below). Need new datasets (see below). +---------------------------------------------------------------------------- +Physical changes: + Precipitation evaporation: J.J. Hack. + Cloud water changes for mid-atm.: P.J. Rasch + LW water-vapor abs/ems changes: W. Collins + no orographic drag over ocean: B.B. Boville + fix to geo-potential: B.B. Boville + +Land-model: + Tested with both LSM1 and CLM2 land-models (see below). CLM2 + was updated to CLM2.1.20. +Interface changes: + Makefile changed so that in-lining is done. + radems/radabs became a module. + LINUX CPP token changed to Linux (so you can use uname -s) + Block data removed (except for phys366). + Check that ORO is valid from IC file. +Testing: + Code was tested both on many NCAR platforms and several off-site + platforms as well. test-model.pl was primarily used to validate + that the model started/restarted for all dynamics as well as + both the "physics" and "phys366" physics directories and "lsm1" + and "clm2" land models. It also verified that restarts give exact + answers to the history files (both average and instant values), + and that changing the decomposition gives the same answers and + that SPMD and non-SPMD gives the same answers. It also checks + that the code can run with bounds checking on (on Sun and Linux), + and with the compiler initializing variables to indefinite. + + CCSM tests run ccm/test/csm.csh to ensure that the model works + with the CCSM coupler. This version of the model works with + ccsm2_0_beta11. + +Machine lsm1-physics CCSM clm2-physics clm2-phys366 lsm1-phys366 +babyblue(aix) X X X X X +blackforest(aix) X X +gseaborg(aix) X +eagle(aix) X +blue(aix) X +longs(PC) X X X +prospect(osf) X X X X +compass(osf) X +utefe(sgi) X X X X +tropic(sgi) X X X +sanitas(sun) X X X + +Error growth: + The error-growth is faster than the previous model, especially + SLD but, it was deemed acceptable. HOWEVER, + THE ERROR-GROWTH ON THE SUN IN COMPARISON TO THE IBM IS + UNACCEPTABLE. Until this is fixed the Sun should not be + used for simulations. + +Script changes: + test-model.pl was made more robust. Tests + to compare SPMD non-SPMD were added and to check both avg + and instant history files for restart tests, and new + input options added: + + set the env variables: + + LANDMODEL --- to define whether to use LSM1 or CLM2 + PHYSICS ----- to define whether to use "phys366" or "physics". + + skip option (-s) now allows an end-point and allows resolution + to be specified. So + + -s eul:3-5:T42L26 + + Will run tests 3-5 with Eulerian dynamics at T42 and 26 levels. + + Error-growth option. To do a port validation you can validate + against a given trusted machine. To do this use something like: + + -e "blackforest.ucar.edu(aix)" + + This assumes you already ran test-model.pl on blackforest (and + left everything in the standard locations). Then the "errg*.cprout" + files will contain a comparison to the above machine. + +New datasets: + Bundle of datasets needed to run the model and use "test-model.pl". + + ftp.cgd.ucar.edu; cd pub/erik; bin; + get ccm3.12.acpi-atm.datasets.tar.gz + + abs_ems_factors_fastvx.052001.nc --- Required for use with + the new LW code. + clm datasets ---- In order to run with clm2. + fv.4x5L18 -------- 4x5 degree resolution dataset with 18 levels + for LR dynamics from Sharon Nebuda. +Known-Bugs: + Linux: S.-J. had trouble with 10x15 on Linux with LR and the + Portland group compiler. I had trouble with Linux at + 2x2.5 with LR. + Sun: Error-growth was bad. Ran out of memory at some resolutions, + especially when doing SPMD, or when using CLM2. + Batch: Had trouble with batch submission on the IBM-SP machines: + blue, gseaborg, and eagle. Interactive, didn't have the + same trouble, so I'm unclear why this is the case. + test-model.pl: When using "-s all:" option you can't give an + end-point or it will only run for the first dynamics. +Changes since CCM3.11: + Many enhancements, bug-fixes, and progress on 2D-decompostion to LR + dynamics. Update to F90 and initial Protex pass for LR. + Replace Rayleigh friction with 1st order upwind transport. + Revised mapping algorithm near the surface for winds. + + slaveio namelist item removed. Namelist variable "IDEALDYN" + changed to "IDEAL_PHYS" + + Support for Lahey and Fujitsu compilers on Linux. Work on chunking. + Columns given by phys_grid methods. timing library added. + Ability for bounds-checking added. FORTFFT cpp parameter deleted + use USEFFTLIB if library available. SPMD now doesn't require that + the number of MPI tasks evenly divide into the number of latitudes. + + History modularized. Progress on physics/dynamics split. Restart + dyanmics and physics split out better. Sulfur-cycle codes fixed. + SLD energy fixer added. + + phys366 and clm2 directories added. Generic interface to both + land-models. + + Options added to scripts: PHYSICS, LANDMODEL, tests to run. + NO_SWITCH option for LLNL Compaq. "-clean", "-nofail" and "-t" + options added. Fix interpic for multiple times if available in file. + +=============================================================== +=============================================================== + +ccm3_11 +Originator: erik ( Erik Kluzek) +Date: Thu Dec 21 16:22:20 MST 2000 +Model: CCM +Version: CCM3.11 +One-line Summary: New LW absorption,new vertical diffusion,SLD energy fixer, + scripts,Lin/Rood fixes,split dynamics +Requires change in build system: yes, new build system, use 26 level model +Tested on lr dynamics: yes +Tested on eul dynamics: yes +Tested on sld dynamics: yes +Tested to work coupled with CSM: no +Tested that restarts are bit-for-bit: yes +Tested multiple constituents: yes +Tested that different domain decompositions match bit-for-bit: yes +Tested in adiabatic mode: no (currently broken) +Substantial timing or memory changes: no +Machines tested: IBM, SGI, Sun, PC +Requires change in run script: yes + (New namelist parameter: absems_data) + (New namelist parameter for Lin-Rood: nsplit) + (New namelist parameter: empty_htapes) + (New namelist parameter: aqua-planet) + (New build/run environment provided) + (Need to use new 26 level datasets) +Updated the DatasetLog (for new input data-files): Yes +Updated the documentation: no (will need to though) +Changes answers: Yes (improved physics) +Name of tests cases on NCAR Mass-Store: See CCM3.10.60 below +Changes made: + +Physics changes from CCM3.10: + + New LW absorption of water vapor as per Dr. William Collins. + New vertical diffusion on dry static energy as per Dr. Byron Boville. + + Energy fixer for SLD from Dr. David Williamson and Jerry Olson. + Many bug-fixes to Lin/Rood dynamics. + Many routines migrated to modules. + +New build run environment provided: + + A completly new set of scripts provided to configure, build, and + run the model. Also a test script provided for testing before + committing code changes. + + A script provided to help with the process of interpolating and + creating new initial condition datasets. + +Code changes: + + Work to split dynamics and physics better. + Initial work on 2D decomposition. + Open MP works on PC. + More platforms supported with LR. + Add version, revision_id to history files. + Fix floating point trapping on Compaq. + Various bug-fixes. + +=============================================================== +=============================================================== + +ccm3_10 +Originator: erik ( Erik Kluzek) +Date: Tue Jun 20 08:35:26 MDT 2000 +Model: CCM +Version: CCM3.10 +One-line Summary: Update code to F90 and coding standard, + optimize radcsw, fix bugs, new LR core, + Finish reduced grid tools +Requires change in build system: no +Tested on lr dynamics: Yes +Tested on eul dynamics: Yes +Tested on sld dynamics: Yes +Tested to work coupled with CSM: Yes +Requires change in run script: Yes (requires I/C files with LANDM) +Updated the DatasetLog (for new input data-files): Yes +Updated the documentation: Yes +Changes answers: Yes (different climate) +Name of tests cases on NCAR Mass-Store: /JET/csm/ccm3911 (full grid Eulerian) + /ROSINSKI/csm/ccm3911_r1up (reduced grid Eul) +Changes made: + + Double tagged as CCM3.9.28. + + Update code to F90 free-form and coding standard. + New optimized version of radcsw. Fix bug with CSM with flxave on. Fix bug + with first time-step on Eulerian. Get offline tools to work with reduced + grid and L/R dynamics. Change so LANDM is calculated in offline tool rather + than inside model. Update L/R to new version, add "precision" changes. Fix + Linux Makefile for F90 files. Fix bug with SLD and hortal smoothing and hordif. + Fix problems with SLD on Sun, IBM and Compaq. Fix PHIS filter bug. + +=============================================================== +=============================================================== + +ccm3_9 +Originator: erik ( Erik Kluzek) +Date: Thu Apr 27 15:04:53 MDT 2000 +Model: CCM +Version: CCM3.9 +One-line Summary: New cloud overlap, reduced grid option, addition of Lin-Rood dynamics. +Requires change in build system: Yes +Requires change in run script: Yes +(New options for reduced grid, or Lin-Rood) +Updated the DatasetLog (for new input data-files): not-applicable +Updated the CCM development schedule: no +Updated the documentation: Yes +Changes answers: Yes (new-climate) +Name of tests cases on NCAR Mass-Store: /JET/csm/bill30e +Changes made: + + Added new cloud overlap assumptions from Bill Collins (random overlap when gap + between clouds in column, maximum overlap when clouds exist in both adjoining + layers). + + Added the reduced grid option from Dave Williamson. + + Added Lin-Rood dynamics as a new dynamics configuration. + + Output cleanup. Code cleanup. Two default output streams monthly and daily + files. + + Support IBM and Compaq. Will compile/run on Cray, but radiation changes + (which are highly scalar) make it run very slow. Cray will no longer be + supported. + + Atmosphere determines partitioning of rain/snow. + + SPMD mode now works. Support hybrid SPMD/OMP memory running on IBM, Compaq. + +=============================================================== +=============================================================== + +ccm3_8 +Originator: rosinski ( ROSINSKI JIM 1397 ML CGD) +Date: Fri Aug 20 11:24:07 MDT 1999 +Model: CCM +Version: CCM3.8 +One-line Summary: Merged netcdfhtape branch to trunk +Requires change in build system: Yes. makdep now required. New Makefile +Requires change in run script: Yes. Namelist changes. +Run through comtest.spectral.csh and comtest.sld.csh: Yes +Run through csm.test.nqs: no +Updated the DatasetLog: no +Changes answers: no (bit-for-bit) +Changes made: + + o Model now writes netcdf history tapes. + o Requires f90 compiler since modules and allocatable arrays are + used. Code now should be fully f90-compliant. No more Cray + pointers or user-defined Fortran interfaces to malloc. + o Cloud water is a non-advected tracer as opposed to advecting it + and throwing away the results of the advection (mvertens). + o Model at least runs on IBM. Have not done error growth analysis. + o Moved time filter and mass fixer to scan2. This became possible + with the time-split physics. + o Precision now specified in code rather than relying on vendor flag + (e.g. -r8). This change has not yet been put in the library code + (e.g. ecmfft), so -r8 flag (or equivalent) is still needed for + these files. + o Build procedure now REQUIRES use of the makdep routine provided + in tools/makdep. The reason is that no standard UNIX tool I + know of can provide the full dependency analysis needed. + o Eliminated out-of-core option. History, radiation, and main + model buffers are now modules. Integer pointers to buffer + locations are gone, as are /comgrd/ and points.F + o Namelist changes: + +old namelist new namelist +------------ ------------ + + &CCMEXP &CCMEXP + nlfilt ! write extra time sample------> + ! to 1st volume + stfnum ! starting file number---------> + incorrad ! abs/ems in core--------------> + incorbuf ! model buffer in core---------> + incorhst ! history buffer in core-------> + ndens = [1,2, or 4] ! packing density---> ndens = [1 or 2] ! double or float + primary = 'T', 'Q',...------------------> fincl1 = 'T', 'Q',... + auxf = '1', 'T', 'Q',...,------------> fincl2 = 'T', 'Q',... + '2', 'V', 'U',...-------------> fincl3 = 'V', 'U',... + exclude = 'PS','PHIS',...---------------> fexcl1 = 'PS','PHIS',... + --------------------------> fexcl2 = 'CMFMCA','SOLIN',... + --------------------------> xzy = [T or F] ! non-coords order + / / + + +=============================================================== +=============================================================== + +ccm3_7 +Originator: erik ( Erik Kluzek) +Date: Fri May 28 13:38:40 MDT 1999 +Model: CCM +Version: CCM3.7 +One-line Summary: Prognostic cloud-water and sulfur cycle +Requires change in build system: Yes +(new directory scyc) +Requires change in run script: Yes +(need to use readtrace=.F. and cldw_adv=.T.) +Run through comtest.spectral.csh and comtest.sld.csh: Yes +Run through csm.test.nqs: Yes +Updated the DatasetLog (for new input data-files): Yes +Changes answers: yes +Name of tests cases on NCAR Mass-Store: /JET/csm/prgcld01 +Changes made: + + Prognostic cloud-water and sulfur cycle put on the CCM development trunk. +Changes are huge, in essense this puts ccm3_6_20_brnchT_scycRad1_13 on the +trunk. Standard mode to run is now with 30 levels and with the NOAA Ozone +dataset. So use: SEP1.T42L30_diffPHIS.0599.nc and noaao3.1990.21999.nc. +Using these datasets readtrace must be set to FALSE and normal operation +is with cldw_adv TRUE. To build you must put the "src/scyc" directory in +your path (optionally you can checkout the dscyc module which has dummy +stub routines for the sulfur codes). The default operation is without any +of the sulfur cycle stuff turned on. + + Caveat's: MODEL DOES NOT WORK WITH SPMD MODE! + CSM was tested to ensure it works, but there were + changes that haven't had a long simulation done to verify they + are working correctly. + + SLD mode was tested to ensure it works, but long simulations + were not performed. + + Model tested on SGI, Cray, and Sun. But, the most extensive testing + was on the SGI (ute). + + SOM not tested. Only dom mode was tested. + + A change was put into the LSM for arbitrary initialization. The + change is bit-for-bit when not using arbitrary initialization. + But, new spin-up datasets have not been created nor long-simulations + with the change (the change makes points southward of 60S land ice and + initializes them with a snow depth of 1m). + + Current version does not work with the 44 mid-atmosphere model. + + (a fix is on the way soon). + + Sulfur code has it's own version of the solar zenith angle. This + routine is incompatible with the version in csm_share. This means + the model should not be used for Paleo simulations, with sulfur cycle + turned on. + (a fix is on the way soon). + +=============================================================== diff --git a/doc/ChangeLog_template b/doc/ChangeLog_template new file mode 100644 index 0000000000..0d69003a8e --- /dev/null +++ b/doc/ChangeLog_template @@ -0,0 +1,65 @@ +=============================================================== + +Tag name: +Originator(s): +Date: +One-line Summary: + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel: + +cheyenne/intel/aux_cam: + +hobart/nag: + +hobart/pgi: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== diff --git a/doc/ReleaseNotes b/doc/ReleaseNotes new file mode 100644 index 0000000000..c8ababd26a --- /dev/null +++ b/doc/ReleaseNotes @@ -0,0 +1,300 @@ +------------------------------------------------- +New features in CAM-5.4 +------------------------------------------------- + +## CAM-SE +* Update SE dycore tuning parameters (XXEaton) + - Change time stepping method to RK5 (Kinnmark & Gray Runga-Kutta 5 + stage; 3rd order accurate in time) + - Set the namelists variables as recommended for RK5 in: + http://www.cgd.ucar.edu/cms/pel/software/cam-se-dt-table.pdf + - Add "tstep_type" namelist option for SE dycore + - Turn on the FV energy fixer. + - Remove the variable "energy_fixer" from the cam namelist. + - Reformulated total energy as applied in physics_update and the energy fixers for CAM-FV and CAM-SE dycores. + +## CAM-FV +* Vertical remapping is now applied to temperature instead of energy. This + primarily affects WACCM by reducing numerical artifacts near the model top. + - Reformulated total energy as applied in physics_update and the energy fixers for CAM-FV and CAM-SE dycores. + +## CARMA +* Add six new CARMA models: + - cirrus_dust + - meteor_impact + - mixed_sulfate + - pmc_sulfate + - tholin + - test_tracers2 + +* Further development of CARMA-CAM integration, including: + - New sulfate model features. + - "Fractal" code for soot. + - Port to the NAG compiler. + +## CLUBB +* Update the version of CLUBB used +* Add features to the interface (all options, controlled by namelist switches) + - rain evaportation-turbulence feedback + - advection of CLUBB's moments + - cloud top radiational cooling parameterization + - explicit diffusion on CLUBBs prognostic temperature and total water + - provide support for CLUBB/microphysics sub-stepping + +## CHEMISTRY + +* Added ability to use wild fire emissions produced by CLM4.5 + +* Added option for external forcing of H2O from CH4 oxidation when running + low-top CAM5 without chemistry. CH4 oxidation is an important source of + H2O in the stratosphere. + +* Reaction constants updated to JPL10 + +* Added functionality to provide rate groupings (summations) diagnostics + +* Corrections to aerosol surface area + +* NEU wet deposition changes + . set TICE to 263 + . disable wet deposition poleward of 60 degrees and pressures < 200 mbar + . correction Henry's Law parameters used for SO2 deposition (in seq_drydep_mod) + . correction in units of NEU wet deposition diagnostics + +* Chemistry preprocessor updates: + . enthalpies for chemical potential heating now specified in mechanism files + . added ability to put comments at the end of reactions in mechanism file following '#' or '!' + . bug fixes for species names longer than 8 characters (up to 16 characters) + + +## COSP + . Update from COSP1.3 (version used for CMIP5) to COSP1.4 (version endorsed for CMIP6) + - includes code optimizations, new CALIPSO cloud phase diagnostics, new timing variables + - retains radiatively active snow in all simulators (merged from CESM version of COSP1.3) + - fixes bug affecting convective ice input into COSP + +## AEROSOLS + +* Added 4-mode modal aerosol model (MAM4) + +* Enhancements to emission specifications (surface and elevated): + . ability to specify emissions from multiple input files for any given species + . optional global attribute 'input_method' (set to: 'SERIAL', 'CYCLICAL', + or 'INTERP_MISSING_MONTHS') in the emissions input file which overrides the + corresponding *type namelist option on a file-by-file basis + . optional multiplier proceeding the emissions filepath, e.g.: + 'NAME -> 0.5*/path.../filename.nc' + +* Prognostic Modal Aerosols: Provide the capability to prognose modal aerosols in the stratosphere. This + gives CAM5 and WACCM5 the ability to simulate aerosols in the stratosphere + which originate from volcanic eruptions. To this end, accumulation to coarse + mode exchange is allowed and the widths and edges of the modes are modified + +* Added options to use different then default values for solubility factors for + BULK aerosols + +## DUST + +* Defaults changed for soil_erod and dust_emis_fact. + . All grids except the 0.9x1.25 FV and a few low resolution grid now use + the soid_erod dataset generated for the 1.9x2.5 FV grid. + . The value of dust_emis_fact has been changed for FV 1/2 and 1/4 degree + grids to 0.45 based on tuning done at PNNL. The value for FV 1 degree + was not changed since that will require retuning the production configuration. + +* Tuned following Albani et al., 2014 to best match observations + +* New soil erodibility file from Albani which specifically improves the dust in the Middle East + +## Radiation + +* New optical properties with less absorbing optics for MAM3 and MAM4 (use aeronet dust optics and dust in the aitken mode 2) + +* Added option to calculate solar insolation using the mean of cosz in a radiation time step. When this option is turned on, + it eliminates the spurious zonal oscillation of daily insolation caused by discrete time sampling. + +## Microphysics + +* New microphysics scheme: MG version 2 adds prognostic precipitation and has + a cleaner implementation compared to the original MG scheme. + +* It is now possible to control both the number of microphysics substeps per + physics time step, and joint macrophysics/microphysics substepping, via the + namelist. + +* Add pre-existing ice option to nucleate_ice code. + +* Add option for Hoose heterogeneous freezing parameterization. + +* Add option to specify/parameterize precipitation fraction + +* Add option to use a different dehydration threshold (rhmin) for in the polar stratosphere. + +* New switch to use alternative autoconversion scheme in MG2 (following Seifert and Behang 2001): when active this + uses a different autoconversion and accretion scheme for liquid in MG2 + +* Add Song and Zhang 2012 version of MG 2-moment microphysics in ZM convective scheme as an option + +## Macrophysics + +* Add option for a ice supersaturation closure (supported in both CAM5 and CAM-CLUBB) + +## Deep convection + +* Minor improvements to the ZM scheme improve robustness for some inputs + (e.g. unusually high temperatures). + +* Add option for convective organization in ZM (based on Mapes and Neale 2010) + +## Sub-columns +* Modifications to pbuf and history to support sub-columns + +* Introduced sub-column interface and utlities routines + +* Microphysics now has the ability to be run on grid(usual) or subcolumns + +## Gravity waves + +* New AMIP configuration with a high vertical resolution uses spectral + gravity waves in the low top model. + +* A long-wavelength inertial gravity wave spectrum has been added, and + frontogenesis can now trigger waves in this spectrum. + +* Gravity waves can be triggered from shallow, as well as deep, convection. + +* The entire gravity wave scheme has been audited to correct conservation + issues, internal inconsistencies, and problems with hard-coded parameters. + This should result in more accurate and less noisy output. + +* WACCM's gravity wave functionality can now be enabled in non-WACCM runs, + and can be enabled/disabled at run time via the namelist. + +* Most gravity wave parameters that were previously hard-coded are now + set by the namelist instead. + +* Added "tau_0_ubc" option, to enforce an upper boundary condition of tau = 0 + in the gravity wave parameterization. + +## WACCM + +* WACCM5 with prognostic modal aerosols in the stratosphere + +* Reaction constants updated to JPL10 + +* Background ionization from star light added to WACCM + +* New specification of stratospheric aerosols (volcanic) + +* New treatment of stratospheric aerosol chemistry + +* Corrections to age-of-air tracers + +* Bug fixes and usability improvements for SC-WACCM and WACCM5 that were + also added between CESM 1.2.1 and CESM 1.2.2. + +* Include SC-WACCM5 which has prognostic modal aerosols + +* WACCM-X now has an option to turn on the extended ionosphere including + calculation of electron and ion temperatur and ion transport ambipolar + diffusion + +## SCAM + +## SPCAM +* Super-parameterized CAM (SPCAM) implements a 2D cloud resolving model (the + System for Atmospheric Modeling SAM, version 6.8.2) in CAM. When it is turned on, + it replaces CAM's parameterization for moist convection and large-scale condensation + with this alternate model. + +* The SPCAM package allows CLUBB to be used or not. It is important to note that there is + a SPCAM-specific version of CLUBB within the CRM package and it is not the same CLUBB being + used by CAM + +## AQUAPLANET +* CESM-aquaplanet is now supported out-of-the-box via prescribed-SST (QPCx) and + slab-ocean (QSCx) compsets (where x is CAM version). + + +------------------------------------------------- +CODE CLEANUP AND REFACTORING +------------------------------------------------- + +* CARMA and the MG microphysics interface now use micro_mg_utils to get + size distribution parameters for cloud droplets, ice, and precipitation. + Previously this was done with duplicated code. + +* The chemistry-aerosol model interface was refactored to provide a more + extendable framework. This will ease incorporation of other aerosol + models (e.g., a sectional aerosol model) + +* The SE dycore now uses Pa instead of hPa, which is consistent with CAM's + physics. + +* The CAM and WACCM gravity wave modules have been merged together, and the + result was extensively refactored. The CAM interface (gw_drag.F90) has been + separated from a new set of modules that constitute a portable layer, and + the routines for the wave sources, wave propagation, and effective diffusion + have been separated from each other as well. + +* Removed the WACCM_PHYS preprocessor macro, and brought WACCM physics modules + up to date with current CAM conventions: + + - qbo, radheat, and iondrag have their own namelists. If WACCM is off, we + compile in stubs rather than using the WACCM_PHYS macro. + - Molecular diffusion is turned on/off at run time based on the namelist and + the extent of the vertical grid. + - Each type of gravity wave source is turned on/off via the namelist. + - WACCM-specific fields set by the dycore are now communicated via the physics + buffer rather than the physics_state object, and are only set if needed. + +* Remove restriction that radiation diagnostic calculations reuse the water + uptake and wet radius values calculated for the climate affecting modes. + These quantities are now recomputed for the diagnostic modes. + +* satellite history output was refactored to improve run-time performance + -- find nearest neighbor operation was parallelized + +* The vertical diffusion code was refactored to use new tridiagonal matrix + types, which represent operators in the diffusion equation. + +------------------------------------------------- +CAM INFRASTRUCTURE CHANGES +------------------------------------------------- + +* Improve the microp_aero driver by removing code that belonged in a CAM + specific interface for the nucleate_ice parameterization and adding the + missing CAM interface layer (nucleate_ice_cam). + +* Add two new functions to the rad_constituents interfaces to make it + easier to access the mode and specie indices for specific modes and + specie types. + +* Type descriptions in namelist_definitions.xml can now include variables + as dimensions. For instance, both "integer(n)" and "integer(2)" can be + used for a 1-D integer array. + +* The rad_climate and rad_diag_* arrays can now be set to a larger size + using the new "-max_n_rad_cnst" configure option. + +* Turning on CESM's DEBUG mode now also turns on state_debug_checks. + +* The Lahey compiler is no longer supported because it doesn't support Fortran + 2003 features. + +* Added a new namelist variable, history_aero_optics, to add modal aerosol + optics diagnostics to the default history fields. The existing + history_aerosol variable turns on diagnostics related to the aerosol + production and removal tendencies. + +* Preliminary implementation of further flags to control default history + outputs, including: + - history_waccm + - history_waccmx + - history_chemistry + - history_carma + - history_clubb + +* CAM history changes: + . increased number of fields in fincls from 750 to 1000 + . can have up to 10 simultaneous history files (or streams) diff --git a/manage_externals/.dir_locals.el b/manage_externals/.dir_locals.el new file mode 100644 index 0000000000..a370490e92 --- /dev/null +++ b/manage_externals/.dir_locals.el @@ -0,0 +1,12 @@ +; -*- mode: Lisp -*- + +((python-mode + . ( + ;; fill the paragraph to 80 columns when using M-q + (fill-column . 80) + + ;; Use 4 spaces to indent in Python + (python-indent-offset . 4) + (indent-tabs-mode . nil) + ))) + diff --git a/manage_externals/.github/ISSUE_TEMPLATE.md b/manage_externals/.github/ISSUE_TEMPLATE.md new file mode 100644 index 0000000000..8ecb2ae64b --- /dev/null +++ b/manage_externals/.github/ISSUE_TEMPLATE.md @@ -0,0 +1,6 @@ +### Summary of Issue: +### Expected behavior and actual behavior: +### Steps to reproduce the problem (should include model description file(s) or link to publi c repository): +### What is the changeset ID of the code, and the machine you are using: +### have you modified the code? If so, it must be committed and available for testing: +### Screen output or log file showing the error message and context: diff --git a/manage_externals/.github/PULL_REQUEST_TEMPLATE.md b/manage_externals/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000000..b68b1fb5e2 --- /dev/null +++ b/manage_externals/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,17 @@ +[ 50 character, one line summary ] + +[ Description of the changes in this commit. It should be enough + information for someone not following this development to understand. + Lines should be wrapped at about 72 characters. ] + +User interface changes?: [ No/Yes ] +[ If yes, describe what changed, and steps taken to ensure backward compatibilty ] + +Fixes: [Github issue #s] And brief description of each issue. + +Testing: + test removed: + unit tests: + system tests: + manual testing: + diff --git a/manage_externals/.gitignore b/manage_externals/.gitignore new file mode 100644 index 0000000000..411de5d96e --- /dev/null +++ b/manage_externals/.gitignore @@ -0,0 +1,14 @@ +# directories that are checked out by the tool +cime/ +cime_config/ +components/ + +# generated local files +*.log + +# editor files +*~ +*.bak + +# generated python files +*.pyc diff --git a/manage_externals/.travis.yml b/manage_externals/.travis.yml new file mode 100644 index 0000000000..b32f81bd28 --- /dev/null +++ b/manage_externals/.travis.yml @@ -0,0 +1,32 @@ +# NOTE(bja, 2017-11) travis-ci dosen't support python language builds +# on mac os. As a work around, we use built-in python on linux, and +# declare osx a 'generic' language, and create our own python env. + +language: python +os: linux +python: + - "2.7" + - "3.4" + - "3.5" + - "3.6" +matrix: + include: + - os: osx + language: generic + before_install: + # NOTE(bja, 2017-11) update is slow, 2.7.12 installed by default, good enough! + # - brew update + # - brew outdated python2 || brew upgrade python2 + - pip install virtualenv + - virtualenv env -p python2 + - source env/bin/activate +install: + - pip install -r test/requirements.txt +before_script: + - git --version +script: + - cd test; make test + - cd test; make lint +after_success: + - cd test; make coverage + - cd test; coveralls diff --git a/manage_externals/LICENSE.txt b/manage_externals/LICENSE.txt new file mode 100644 index 0000000000..665ee03fbc --- /dev/null +++ b/manage_externals/LICENSE.txt @@ -0,0 +1,34 @@ +Copyright (c) 2017-2018, University Corporation for Atmospheric Research (UCAR) +All rights reserved. + +Developed by: + University Corporation for Atmospheric Research - National Center for Atmospheric Research + https://www2.cesm.ucar.edu/working-groups/sewg + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"), +to deal with the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom +the Software is furnished to do so, subject to the following conditions: + + - Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimers. + - Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimers in the documentation + and/or other materials provided with the distribution. + - Neither the names of [Name of Development Group, UCAR], + nor the names of its contributors may be used to endorse or promote + products derived from this Software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/manage_externals/README.md b/manage_externals/README.md new file mode 100644 index 0000000000..15e45ffb71 --- /dev/null +++ b/manage_externals/README.md @@ -0,0 +1,211 @@ +-- AUTOMATICALLY GENERATED FILE. DO NOT EDIT -- + +[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master) +``` +usage: checkout_externals [-h] [-e [EXTERNALS]] [-o] [-S] [-v] [--backtrace] + [-d] [--no-logging] + +checkout_externals manages checking out groups of externals from revision +control based on a externals description file. By default only the +required externals are checkout out. + +Operations performed by manage_externals utilities are explicit and +data driven. checkout_externals will always make the working copy *exactly* +match what is in the externals file when modifying the working copy of +a repository. + +If checkout_externals isn't doing what you expected, double check the contents +of the externals description file. + +Running checkout_externals without the '--status' option will always attempt to +synchronize the working copy to exactly match the externals description. + +optional arguments: + -h, --help show this help message and exit + -e [EXTERNALS], --externals [EXTERNALS] + The externals description filename. Default: + Externals.cfg. + -o, --optional By default only the required externals are checked + out. This flag will also checkout the optional + externals. + -S, --status Output status of the repositories managed by + checkout_externals. By default only summary + information is provided. Use verbose output to see + details. + -v, --verbose Output additional information to the screen and log + file. This flag can be used up to two times, + increasing the verbosity level each time. + --backtrace DEVELOPER: show exception backtraces as extra + debugging output + -d, --debug DEVELOPER: output additional debugging information to + the screen and log file. + --no-logging DEVELOPER: disable logging. + +``` +NOTE: checkout_externals *MUST* be run from the root of the source tree it +is managing. For example, if you cloned a repository with: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +Then the root of the source tree is /path/to/some-project-dev. If you +obtained a sub-project via a checkout of another project: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +and you need to checkout the sub-project externals, then the root of the +source tree is /path/to/some-project-dev. Do *NOT* run checkout_externals +from within /path/to/some-project-dev/sub-project + +The root of the source tree will be referred to as `${SRC_ROOT}` below. + +# Supported workflows + + * Checkout all required components from the default externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals + + * To update all required components to the current values in the + externals description file, re-run checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals + + If there are *any* modifications to *any* working copy according + to the git or svn 'status' command, checkout_externals + will not update any external repositories. Modifications + include: modified files, added files, removed files, or missing + files. + + To avoid this safety check, edit the externals description file + and comment out the modified external block. + + * Checkout all required components from a user specified externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --excernals my-externals.cfg + + * Status summary of the repositories managed by checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --status + + ./cime + s ./components/cism + ./components/mosart + e-o ./components/rtm + M ./src/fates + e-o ./tools/PTCLM + + where: + * column one indicates the status of the repository in relation + to the externals description file. + * column two indicates whether the working copy has modified files. + * column three shows how the repository is managed, optional or required + + Column one will be one of these values: + * s : out-of-sync : repository is checked out at a different commit + compared with the externals description + * e : empty : directory does not exist - checkout_externals has not been run + * ? : unknown : directory exists but .git or .svn directories are missing + + Column two will be one of these values: + * M : Modified : modified, added, deleted or missing files + * : blank / space : clean + * - : dash : no meaningful state, for empty repositories + + Column three will be one of these values: + * o : optional : optionally repository + * : blank / space : required repository + + * Detailed git or svn status of the repositories managed by checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --status --verbose + +# Externals description file + + The externals description contains a list of the external + repositories that are used and their version control locations. The + file format is the standard ini/cfg configuration file format. Each + external is defined by a section containing the component name in + square brackets: + + * name (string) : component name, e.g. [cime], [cism], etc. + + Each section has the following keyword-value pairs: + + * required (boolean) : whether the component is a required checkout, + 'true' or 'false'. + + * local_path (string) : component path *relative* to where + checkout_externals is called. + + * protoctol (string) : version control protocol that is used to + manage the component. Valid values are 'git', 'svn', + 'externals_only'. + + Switching an external between different protocols is not + supported, e.g. from svn to git. To switch protocols, you need to + manually move the old working copy to a new location. + + Note: 'externals_only' will only process the external's own + external description file without trying to manage a repository + for the component. This is used for retreiving externals for + standalone components like cam and clm. If the source root of the + externals_only component is the same as the main source root, then + the local path must be set to '.', the unix current working + directory, e. g. 'local_path = .' + + * repo_url (string) : URL for the repository location, examples: + * https://svn-ccsm-models.cgd.ucar.edu/glc + * git@github.com:esmci/cime.git + * /path/to/local/repository + * . + + NOTE: To operate on only the local clone and and ignore remote + repositories, set the url to '.' (the unix current path), + i.e. 'repo_url = .' . This can be used to checkout a local branch + instead of the upstream branch. + + If a repo url is determined to be a local path (not a network url) + then user expansion, e.g. ~/, and environment variable expansion, + e.g. $HOME or $REPO_ROOT, will be performed. + + Relative paths are difficult to get correct, especially for mixed + use repos. It is advised that local paths expand to absolute paths. + If relative paths are used, they should be relative to one level + above local_path. If local path is 'src/foo', the the relative url + should be relative to 'src'. + + * tag (string) : tag to checkout + + * hash (string) : the git hash to checkout. Only applies to git + repositories. + + * branch (string) : branch to checkout from the specified + repository. Specifying a branch on a remote repository means that + checkout_externals will checkout the version of the branch in the remote, + not the the version in the local repository (if it exists). + + Note: one and only one of tag, branch hash must be supplied. + + * externals (string) : used to make manage_externals aware of + sub-externals required by an external. This is a relative path to + the external's root directory. For example, the main externals + description has an external checkout out at 'src/useful_library'. + useful_library requires additional externals to be complete. + Those additional externals are managed from the source root by the + externals description file pointed 'useful_library/sub-xternals.cfg', + Then the main 'externals' field in the top level repo should point to + 'sub-externals.cfg'. + + * Lines begining with '#' or ';' are comments and will be ignored. + +# Obtaining this tool, reporting issues, etc. + + The master repository for manage_externals is + https://github.com/ESMCI/manage_externals. Any issues with this tool + should be reported there. diff --git a/manage_externals/README_FIRST b/manage_externals/README_FIRST new file mode 100644 index 0000000000..c8a47d7806 --- /dev/null +++ b/manage_externals/README_FIRST @@ -0,0 +1,54 @@ +CESM is comprised of a number of different components that are +developed and managed independently. Each component may have +additional 'external' dependancies and optional parts that are also +developed and managed independently. + +The checkout_externals.py tool manages retreiving and updating the +components and their externals so you have a complete set of source +files for the model. + +checkout_externals.py relies on a model description file that +describes what components are needed, where to find them and where to +put them in the source tree. The default file is called "CESM.xml" +regardless of whether you are checking out CESM or a standalone +component. + +checkout_externals requires access to git and svn repositories that +require authentication. checkout_externals may pass through +authentication requests, but it will not cache them for you. For the +best and most robust user experience, you should have svn and git +working without password authentication. See: + + https://help.github.com/articles/connecting-to-github-with-ssh/ + + ?svn ref? + +NOTE: checkout_externals.py *MUST* be run from the root of the source +tree it is managing. For example, if you cloned CLM with: + + $ git clone git@github.com/ncar/clm clm-dev + +Then the root of the source tree is /path/to/cesm-dev. If you obtained +CLM via an svn checkout of CESM and you need to checkout the CLM +externals, then the root of the source tree for CLM is: + + /path/to/cesm-dev/components/clm + +The root of the source tree will be referred to as ${SRC_ROOT} below. + +To get started quickly, checkout all required components from the +default model description file: + + $ cd ${SRC_ROOT} + $ ./checkout_cesm/checkout_externals.py + +For additional information about using checkout model, please see: + + ${SRC_ROOT}/checkout_cesm/README + +or run: + + $ cd ${SRC_ROOT} + $ ./checkout_cesm/checkout_externals.py --help + + diff --git a/manage_externals/checkout_externals b/manage_externals/checkout_externals new file mode 100755 index 0000000000..a0698baef0 --- /dev/null +++ b/manage_externals/checkout_externals @@ -0,0 +1,36 @@ +#!/usr/bin/env python + +"""Main driver wrapper around the manic/checkout utility. + +Tool to assemble external respositories represented in an externals +description file. + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import sys +import traceback + +import manic + +if sys.hexversion < 0x02070000: + print(70 * '*') + print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) + print('It appears that you are running python {0}'.format( + '.'.join(str(x) for x in sys.version_info[0:3]))) + print(70 * '*') + sys.exit(1) + + +if __name__ == '__main__': + ARGS = manic.checkout.commandline_arguments() + try: + RET_STATUS, _ = manic.checkout.main(ARGS) + sys.exit(RET_STATUS) + except Exception as error: # pylint: disable=broad-except + manic.printlog(str(error)) + if ARGS.backtrace: + traceback.print_exc() + sys.exit(1) diff --git a/manage_externals/manic/__init__.py b/manage_externals/manic/__init__.py new file mode 100644 index 0000000000..11badedd3b --- /dev/null +++ b/manage_externals/manic/__init__.py @@ -0,0 +1,9 @@ +"""Public API for the manage_externals library +""" + +from manic import checkout +from manic.utils import printlog + +__all__ = [ + 'checkout', 'printlog', +] diff --git a/manage_externals/manic/checkout.py b/manage_externals/manic/checkout.py new file mode 100755 index 0000000000..afd3a27886 --- /dev/null +++ b/manage_externals/manic/checkout.py @@ -0,0 +1,409 @@ +#!/usr/bin/env python + +""" +Tool to assemble repositories represented in a model-description file. + +If loaded as a module (e.g., in a component's buildcpp), it can be used +to check the validity of existing subdirectories and load missing sources. +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import argparse +import logging +import os +import os.path +import sys + +from manic.externals_description import create_externals_description +from manic.externals_description import read_externals_description_file +from manic.externals_status import check_safe_to_update_repos +from manic.sourcetree import SourceTree +from manic.utils import printlog, fatal_error +from manic.global_constants import VERSION_SEPERATOR, LOG_FILE_NAME + +if sys.hexversion < 0x02070000: + print(70 * '*') + print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) + print('It appears that you are running python {0}'.format( + VERSION_SEPERATOR.join(str(x) for x in sys.version_info[0:3]))) + print(70 * '*') + sys.exit(1) + + +# --------------------------------------------------------------------- +# +# User input +# +# --------------------------------------------------------------------- +def commandline_arguments(args=None): + """Process the command line arguments + + Params: args - optional args. Should only be used during systems + testing. + + Returns: processed command line arguments + """ + description = ''' + +%(prog)s manages checking out groups of externals from revision +control based on an externals description file. By default only the +required externals are checkout out. + +Running %(prog)s without the '--status' option will always attempt to +synchronize the working copy to exactly match the externals description. +''' + + epilog = ''' +``` +NOTE: %(prog)s *MUST* be run from the root of the source tree it +is managing. For example, if you cloned a repository with: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +Then the root of the source tree is /path/to/some-project-dev. If you +obtained a sub-project via a checkout of another project: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +and you need to checkout the sub-project externals, then the root of the +source tree remains /path/to/some-project-dev. Do *NOT* run %(prog)s +from within /path/to/some-project-dev/sub-project + +The root of the source tree will be referred to as `${SRC_ROOT}` below. + + +# Supported workflows + + * Checkout all required components from the default externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s + + * To update all required components to the current values in the + externals description file, re-run %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s + + If there are *any* modifications to *any* working copy according + to the git or svn 'status' command, %(prog)s + will not update any external repositories. Modifications + include: modified files, added files, removed files, or missing + files. + + To avoid this safety check, edit the externals description file + and comment out the modified external block. + + * Checkout all required components from a user specified externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --externals my-externals.cfg + + * Status summary of the repositories managed by %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --status + + ./cime + s ./components/cism + ./components/mosart + e-o ./components/rtm + M ./src/fates + e-o ./tools/PTCLM + + + where: + * column one indicates the status of the repository in relation + to the externals description file. + * column two indicates whether the working copy has modified files. + * column three shows how the repository is managed, optional or required + + Column one will be one of these values: + * s : out-of-sync : repository is checked out at a different commit + compared with the externals description + * e : empty : directory does not exist - %(prog)s has not been run + * ? : unknown : directory exists but .git or .svn directories are missing + + Column two will be one of these values: + * M : Modified : modified, added, deleted or missing files + * : blank / space : clean + * - : dash : no meaningful state, for empty repositories + + Column three will be one of these values: + * o : optional : optionally repository + * : blank / space : required repository + + * Detailed git or svn status of the repositories managed by %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --status --verbose + +# Externals description file + + The externals description contains a list of the external + repositories that are used and their version control locations. The + file format is the standard ini/cfg configuration file format. Each + external is defined by a section containing the component name in + square brackets: + + * name (string) : component name, e.g. [cime], [cism], etc. + + Each section has the following keyword-value pairs: + + * required (boolean) : whether the component is a required checkout, + 'true' or 'false'. + + * local_path (string) : component path *relative* to where + %(prog)s is called. + + * protoctol (string) : version control protocol that is used to + manage the component. Valid values are 'git', 'svn', + 'externals_only'. + + Switching an external between different protocols is not + supported, e.g. from svn to git. To switch protocols, you need to + manually move the old working copy to a new location. + + Note: 'externals_only' will only process the external's own + external description file without trying to manage a repository + for the component. This is used for retrieving externals for + standalone components like cam and ctsm which also serve as + sub-components within a larger project. If the source root of the + externals_only component is the same as the main source root, then + the local path must be set to '.', the unix current working + directory, e. g. 'local_path = .' + + * repo_url (string) : URL for the repository location, examples: + * https://svn-ccsm-models.cgd.ucar.edu/glc + * git@github.com:esmci/cime.git + * /path/to/local/repository + * . + + NOTE: To operate on only the local clone and and ignore remote + repositories, set the url to '.' (the unix current path), + i.e. 'repo_url = .' . This can be used to checkout a local branch + instead of the upstream branch. + + If a repo url is determined to be a local path (not a network url) + then user expansion, e.g. ~/, and environment variable expansion, + e.g. $HOME or $REPO_ROOT, will be performed. + + Relative paths are difficult to get correct, especially for mixed + use repos. It is advised that local paths expand to absolute paths. + If relative paths are used, they should be relative to one level + above local_path. If local path is 'src/foo', the the relative url + should be relative to 'src'. + + * tag (string) : tag to checkout + + * hash (string) : the git hash to checkout. Only applies to git + repositories. + + * branch (string) : branch to checkout from the specified + repository. Specifying a branch on a remote repository means that + %(prog)s will checkout the version of the branch in the remote, + not the the version in the local repository (if it exists). + + Note: one and only one of tag, branch hash must be supplied. + + * externals (string) : used to make manage_externals aware of + sub-externals required by an external. This is a relative path to + the external's root directory. For example, if LIBX is often used + as a sub-external, it might have an externals file (for its + externals) called Externals_LIBX.cfg. To use libx as a standalone + checkout, it would have another file, Externals.cfg with the + following entry: + + [ libx ] + local_path = . + protocol = externals_only + externals = Externals_LIBX.cfg + required = True + + Now, %(prog)s will process Externals.cfg and also process + Externals_LIBX.cfg as if it was a sub-external. + + * Lines beginning with '#' or ';' are comments and will be ignored. + +# Obtaining this tool, reporting issues, etc. + + The master repository for manage_externals is + https://github.com/ESMCI/manage_externals. Any issues with this tool + should be reported there. + +# Troubleshooting + +Operations performed by manage_externals utilities are explicit and +data driven. %(prog)s will always attempt to make the working copy +*exactly* match what is in the externals file when modifying the +working copy of a repository. + +If %(prog)s is not doing what you expected, double check the contents +of the externals description file or examine the output of +./manage_externals/%(prog)s --status + +''' + + parser = argparse.ArgumentParser( + description=description, epilog=epilog, + formatter_class=argparse.RawDescriptionHelpFormatter) + + # + # user options + # + parser.add_argument("components", nargs="*", + help="Specific component(s) to checkout. By default, " + "all required externals are checked out.") + + parser.add_argument('-e', '--externals', nargs='?', + default='Externals.cfg', + help='The externals description filename. ' + 'Default: %(default)s.') + + parser.add_argument('-o', '--optional', action='store_true', default=False, + help='By default only the required externals ' + 'are checked out. This flag will also checkout the ' + 'optional externals.') + + parser.add_argument('-S', '--status', action='store_true', default=False, + help='Output the status of the repositories managed by ' + '%(prog)s. By default only summary information ' + 'is provided. Use the verbose option to see details.') + + parser.add_argument('-v', '--verbose', action='count', default=0, + help='Output additional information to ' + 'the screen and log file. This flag can be ' + 'used up to two times, increasing the ' + 'verbosity level each time.') + + parser.add_argument('--svn-ignore-ancestry', action='store_true', default=False, + help='By default, subversion will abort if a component is ' + 'already checked out and there is no common ancestry with ' + 'the new URL. This flag passes the "--ignore-ancestry" flag ' + 'to the svn switch call. (This is not recommended unless ' + 'you are sure about what you are doing.)') + + # + # developer options + # + parser.add_argument('--backtrace', action='store_true', + help='DEVELOPER: show exception backtraces as extra ' + 'debugging output') + + parser.add_argument('-d', '--debug', action='store_true', default=False, + help='DEVELOPER: output additional debugging ' + 'information to the screen and log file.') + + logging_group = parser.add_mutually_exclusive_group() + + logging_group.add_argument('--logging', dest='do_logging', + action='store_true', + help='DEVELOPER: enable logging.') + logging_group.add_argument('--no-logging', dest='do_logging', + action='store_false', default=False, + help='DEVELOPER: disable logging ' + '(this is the default)') + + if args: + options = parser.parse_args(args) + else: + options = parser.parse_args() + return options + + +# --------------------------------------------------------------------- +# +# main +# +# --------------------------------------------------------------------- +def main(args): + """ + Function to call when module is called from the command line. + Parse externals file and load required repositories or all repositories if + the --all option is passed. + + Returns a tuple (overall_status, tree_status). overall_status is 0 + on success, non-zero on failure. tree_status gives the full status + *before* executing the checkout command - i.e., the status that it + used to determine if it's safe to proceed with the checkout. + """ + if args.do_logging: + logging.basicConfig(filename=LOG_FILE_NAME, + format='%(levelname)s : %(asctime)s : %(message)s', + datefmt='%Y-%m-%d %H:%M:%S', + level=logging.DEBUG) + + program_name = os.path.basename(sys.argv[0]) + logging.info('Beginning of %s', program_name) + + load_all = False + if args.optional: + load_all = True + + root_dir = os.path.abspath(os.getcwd()) + external_data = read_externals_description_file(root_dir, args.externals) + external = create_externals_description( + external_data, components=args.components) + + for comp in args.components: + if comp not in external.keys(): + fatal_error( + "No component {} found in {}".format( + comp, args.externals)) + + source_tree = SourceTree(root_dir, external, svn_ignore_ancestry=args.svn_ignore_ancestry) + printlog('Checking status of externals: ', end='') + tree_status = source_tree.status() + printlog('') + + if args.status: + # user requested status-only + for comp in sorted(tree_status.keys()): + tree_status[comp].log_status_message(args.verbose) + else: + # checkout / update the external repositories. + safe_to_update = check_safe_to_update_repos(tree_status) + if not safe_to_update: + # print status + for comp in sorted(tree_status.keys()): + tree_status[comp].log_status_message(args.verbose) + # exit gracefully + msg = """The external repositories labeled with 'M' above are not in a clean state. + +The following are two options for how to proceed: + +(1) Go into each external that is not in a clean state and issue either + an 'svn status' or a 'git status' command. Either revert or commit + your changes so that all externals are in a clean state. (Note, + though, that it is okay to have untracked files in your working + directory.) Then rerun {program_name}. + +(2) Alternatively, you do not have to rely on {program_name}. Instead, you + can manually update out-of-sync externals (labeled with 's' above) + as described in the configuration file {config_file}. + + +The external repositories labeled with '?' above are not under version +control using the expected protocol. If you are sure you want to switch +protocols, and you don't have any work you need to save from this +directory, then run "rm -rf [directory]" before re-running the +checkout_externals tool. +""".format(program_name=program_name, config_file=args.externals) + + printlog('-' * 70) + printlog(msg) + printlog('-' * 70) + else: + if not args.components: + source_tree.checkout(args.verbose, load_all) + for comp in args.components: + source_tree.checkout(args.verbose, load_all, load_comp=comp) + printlog('') + + logging.info('%s completed without exceptions.', program_name) + # NOTE(bja, 2017-11) tree status is used by the systems tests + return 0, tree_status diff --git a/manage_externals/manic/externals_description.py b/manage_externals/manic/externals_description.py new file mode 100644 index 0000000000..3cebf525b5 --- /dev/null +++ b/manage_externals/manic/externals_description.py @@ -0,0 +1,790 @@ +#!/usr/bin/env python + +"""Model description + +Model description is the representation of the various externals +included in the model. It processes in input data structure, and +converts it into a standard interface that is used by the rest of the +system. + +To maintain backward compatibility, externals description files should +follow semantic versioning rules, http://semver.org/ + + + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import logging +import os +import os.path +import re + +# ConfigParser in python2 was renamed to configparser in python3. +# In python2, ConfigParser returns byte strings, str, instead of unicode. +# We need unicode to be compatible with xml and json parser and python3. +try: + # python2 + from ConfigParser import SafeConfigParser as config_parser + from ConfigParser import MissingSectionHeaderError + from ConfigParser import NoSectionError, NoOptionError + + USE_PYTHON2 = True + + def config_string_cleaner(text): + """convert strings into unicode + """ + return text.decode('utf-8') +except ImportError: + # python3 + from configparser import ConfigParser as config_parser + from configparser import MissingSectionHeaderError + from configparser import NoSectionError, NoOptionError + + USE_PYTHON2 = False + + def config_string_cleaner(text): + """Python3 already uses unicode strings, so just return the string + without modification. + + """ + return text + +from .utils import printlog, fatal_error, str_to_bool, expand_local_url +from .utils import execute_subprocess +from .global_constants import EMPTY_STR, PPRINTER, VERSION_SEPERATOR + +# +# Globals +# +DESCRIPTION_SECTION = 'externals_description' +VERSION_ITEM = 'schema_version' + + +def read_externals_description_file(root_dir, file_name): + """Read a file containing an externals description and + create its internal representation. + + """ + root_dir = os.path.abspath(root_dir) + msg = 'In directory : {0}'.format(root_dir) + logging.info(msg) + printlog('Processing externals description file : {0}'.format(file_name)) + + file_path = os.path.join(root_dir, file_name) + if not os.path.exists(file_name): + if file_name.lower() == "none": + msg = ('INTERNAL ERROR: Attempt to read externals file ' + 'from {0} when not configured'.format(file_path)) + else: + msg = ('ERROR: Model description file, "{0}", does not ' + 'exist at path:\n {1}\nDid you run from the root of ' + 'the source tree?'.format(file_name, file_path)) + + fatal_error(msg) + + externals_description = None + if file_name == ExternalsDescription.GIT_SUBMODULES_FILENAME: + externals_description = read_gitmodules_file(root_dir, file_name) + else: + try: + config = config_parser() + config.read(file_path) + externals_description = config + except MissingSectionHeaderError: + # not a cfg file + pass + + if externals_description is None: + msg = 'Unknown file format!' + fatal_error(msg) + + return externals_description + +class LstripReader(object): + "LstripReader formats .gitmodules files to be acceptable for configparser" + def __init__(self, filename): + with open(filename, 'r') as infile: + lines = infile.readlines() + self._lines = list() + self._num_lines = len(lines) + self._index = 0 + for line in lines: + self._lines.append(line.lstrip()) + + def readlines(self): + """Return all the lines from this object's file""" + return self._lines + + def readline(self, size=-1): + """Format and return the next line or raise StopIteration""" + try: + line = self.next() + except StopIteration: + line = '' + + if (size > 0) and (len(line) < size): + return line[0:size] + + return line + + def __iter__(self): + """Begin an iteration""" + self._index = 0 + return self + + def next(self): + """Return the next line or raise StopIteration""" + if self._index >= self._num_lines: + raise StopIteration + + self._index = self._index + 1 + return self._lines[self._index - 1] + + def __next__(self): + return self.next() + +def git_submodule_status(repo_dir): + """Run the git submodule status command to obtain submodule hashes. + """ + # This function is here instead of GitRepository to avoid a dependency loop + cwd = os.getcwd() + os.chdir(repo_dir) + cmd = ['git', 'submodule', 'status'] + git_output = execute_subprocess(cmd, output_to_caller=True) + submodules = {} + submods = git_output.split('\n') + for submod in submods: + if submod: + status = submod[0] + items = submod[1:].split(' ') + if len(items) > 2: + tag = items[2] + else: + tag = None + + submodules[items[1]] = {'hash':items[0], 'status':status, 'tag':tag} + + os.chdir(cwd) + return submodules + +def parse_submodules_desc_section(section_items, file_path): + """Find the path and url for this submodule description""" + path = None + url = None + for item in section_items: + name = item[0].strip().lower() + if name == 'path': + path = item[1].strip() + elif name == 'url': + url = item[1].strip() + else: + msg = 'WARNING: Ignoring unknown {} property, in {}' + msg = msg.format(item[0], file_path) # fool pylint + logging.warning(msg) + + return path, url + +def read_gitmodules_file(root_dir, file_name): + # pylint: disable=deprecated-method + # Disabling this check because the method is only used for python2 + """Read a .gitmodules file and convert it to be compatible with an + externals description. + """ + root_dir = os.path.abspath(root_dir) + msg = 'In directory : {0}'.format(root_dir) + logging.info(msg) + printlog('Processing submodules description file : {0}'.format(file_name)) + + file_path = os.path.join(root_dir, file_name) + if not os.path.exists(file_name): + msg = ('ERROR: submodules description file, "{0}", does not ' + 'exist at path:\n {1}'.format(file_name, file_path)) + fatal_error(msg) + + submodules_description = None + externals_description = None + try: + config = config_parser() + if USE_PYTHON2: + config.readfp(LstripReader(file_path), filename=file_name) + else: + config.read_file(LstripReader(file_path), source=file_name) + + submodules_description = config + except MissingSectionHeaderError: + # not a cfg file + pass + + if submodules_description is None: + msg = 'Unknown file format!' + fatal_error(msg) + else: + # Convert the submodules description to an externals description + externals_description = config_parser() + # We need to grab all the commit hashes for this repo + submods = git_submodule_status(root_dir) + for section in submodules_description.sections(): + if section[0:9] == 'submodule': + sec_name = section[9:].strip(' "') + externals_description.add_section(sec_name) + section_items = submodules_description.items(section) + path, url = parse_submodules_desc_section(section_items, + file_path) + + if path is None: + msg = 'Submodule {} missing path'.format(sec_name) + fatal_error(msg) + + if url is None: + msg = 'Submodule {} missing url'.format(sec_name) + fatal_error(msg) + + externals_description.set(sec_name, + ExternalsDescription.PATH, path) + externals_description.set(sec_name, + ExternalsDescription.PROTOCOL, 'git') + externals_description.set(sec_name, + ExternalsDescription.REPO_URL, url) + externals_description.set(sec_name, + ExternalsDescription.REQUIRED, 'True') + git_hash = submods[sec_name]['hash'] + externals_description.set(sec_name, + ExternalsDescription.HASH, git_hash) + + # Required items + externals_description.add_section(DESCRIPTION_SECTION) + externals_description.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') + + return externals_description + +def create_externals_description( + model_data, model_format='cfg', components=None, parent_repo=None): + """Create the a externals description object from the provided data + """ + externals_description = None + if model_format == 'dict': + externals_description = ExternalsDescriptionDict( + model_data, components=components) + elif model_format == 'cfg': + major, _, _ = get_cfg_schema_version(model_data) + if major == 1: + externals_description = ExternalsDescriptionConfigV1( + model_data, components=components, parent_repo=parent_repo) + else: + msg = ('Externals description file has unsupported schema ' + 'version "{0}".'.format(major)) + fatal_error(msg) + else: + msg = 'Unknown model data format "{0}"'.format(model_format) + fatal_error(msg) + return externals_description + + +def get_cfg_schema_version(model_cfg): + """Extract the major, minor, patch version of the config file schema + + Params: + model_cfg - config parser object containing the externas description data + + Returns: + major = integer major version + minor = integer minor version + patch = integer patch version + """ + semver_str = '' + try: + semver_str = model_cfg.get(DESCRIPTION_SECTION, VERSION_ITEM) + except (NoSectionError, NoOptionError): + msg = ('externals description file must have the required ' + 'section: "{0}" and item "{1}"'.format(DESCRIPTION_SECTION, + VERSION_ITEM)) + fatal_error(msg) + + # NOTE(bja, 2017-11) Assume we don't care about the + # build/pre-release metadata for now! + version_list = re.split(r'[-+]', semver_str) + version_str = version_list[0] + version = version_str.split(VERSION_SEPERATOR) + try: + major = int(version[0].strip()) + minor = int(version[1].strip()) + patch = int(version[2].strip()) + except ValueError: + msg = ('Config file schema version must have integer digits for ' + 'major, minor and patch versions. ' + 'Received "{0}"'.format(version_str)) + fatal_error(msg) + return major, minor, patch + + +class ExternalsDescription(dict): + """Base externals description class that is independent of the user input + format. Different input formats can all be converted to this + representation to provide a consistent represtentation for the + rest of the objects in the system. + + NOTE(bja, 2018-03): do NOT define _schema_major etc at the class + level in the base class. The nested/recursive nature of externals + means different schema versions may be present in a single run! + + All inheriting classes must overwrite: + self._schema_major and self._input_major + self._schema_minor and self._input_minor + self._schema_patch and self._input_patch + + where _schema_x is the supported schema, _input_x is the user + input value. + + """ + # keywords defining the interface into the externals description data + EXTERNALS = 'externals' + BRANCH = 'branch' + SUBMODULE = 'from_submodule' + HASH = 'hash' + NAME = 'name' + PATH = 'local_path' + PROTOCOL = 'protocol' + REPO = 'repo' + REPO_URL = 'repo_url' + REQUIRED = 'required' + TAG = 'tag' + + PROTOCOL_EXTERNALS_ONLY = 'externals_only' + PROTOCOL_GIT = 'git' + PROTOCOL_SVN = 'svn' + GIT_SUBMODULES_FILENAME = '.gitmodules' + KNOWN_PRROTOCOLS = [PROTOCOL_GIT, PROTOCOL_SVN, PROTOCOL_EXTERNALS_ONLY] + + # v1 xml keywords + _V1_TREE_PATH = 'TREE_PATH' + _V1_ROOT = 'ROOT' + _V1_TAG = 'TAG' + _V1_BRANCH = 'BRANCH' + _V1_REQ_SOURCE = 'REQ_SOURCE' + + _source_schema = {REQUIRED: True, + PATH: 'string', + EXTERNALS: 'string', + SUBMODULE : True, + REPO: {PROTOCOL: 'string', + REPO_URL: 'string', + TAG: 'string', + BRANCH: 'string', + HASH: 'string', + } + } + + def __init__(self, parent_repo=None): + """Convert the xml into a standardized dict that can be used to + construct the source objects + + """ + dict.__init__(self) + + self._schema_major = None + self._schema_minor = None + self._schema_patch = None + self._input_major = None + self._input_minor = None + self._input_patch = None + self._parent_repo = parent_repo + + def _verify_schema_version(self): + """Use semantic versioning rules to verify we can process this schema. + + """ + known = '{0}.{1}.{2}'.format(self._schema_major, + self._schema_minor, + self._schema_patch) + received = '{0}.{1}.{2}'.format(self._input_major, + self._input_minor, + self._input_patch) + + if self._input_major != self._schema_major: + # should never get here, the factory should handle this correctly! + msg = ('DEV_ERROR: version "{0}" parser received ' + 'version "{1}" input.'.format(known, received)) + fatal_error(msg) + + if self._input_minor > self._schema_minor: + msg = ('Incompatible schema version:\n' + ' User supplied schema version "{0}" is too new."\n' + ' Can only process version "{1}" files and ' + 'older.'.format(received, known)) + fatal_error(msg) + + if self._input_patch > self._schema_patch: + # NOTE(bja, 2018-03) ignoring for now... Not clear what + # conditions the test is needed. + pass + + def _check_user_input(self): + """Run a series of checks to attempt to validate the user input and + detect errors as soon as possible. + + NOTE(bja, 2018-03) These checks are called *after* the file is + read. That means the schema check can not occur here. + + Note: the order is important. check_optional will create + optional with null data. run check_data first to ensure + required data was provided correctly by the user. + + """ + self._check_data() + self._check_optional() + self._validate() + + def _check_data(self): + # pylint: disable=too-many-branches,too-many-statements + """Check user supplied data is valid where possible. + """ + for ext_name in self.keys(): + if (self[ext_name][self.REPO][self.PROTOCOL] + not in self.KNOWN_PRROTOCOLS): + msg = 'Unknown repository protocol "{0}" in "{1}".'.format( + self[ext_name][self.REPO][self.PROTOCOL], ext_name) + fatal_error(msg) + + if (self[ext_name][self.REPO][self.PROTOCOL] == + self.PROTOCOL_SVN): + if self.HASH in self[ext_name][self.REPO]: + msg = ('In repo description for "{0}". svn repositories ' + 'may not include the "hash" keyword.'.format( + ext_name)) + fatal_error(msg) + + if ((self[ext_name][self.REPO][self.PROTOCOL] != self.PROTOCOL_GIT) + and (self.SUBMODULE in self[ext_name])): + msg = ('self.SUBMODULE is only supported with {0} protocol, ' + '"{1}" is defined as an {2} repository') + fatal_error(msg.format(self.PROTOCOL_GIT, ext_name, + self[ext_name][self.REPO][self.PROTOCOL])) + + if (self[ext_name][self.REPO][self.PROTOCOL] != + self.PROTOCOL_EXTERNALS_ONLY): + ref_count = 0 + found_refs = '' + if self.TAG in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.TAG, self[ext_name][self.REPO][self.TAG], + found_refs) + if self.BRANCH in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.BRANCH, self[ext_name][self.REPO][self.BRANCH], + found_refs) + if self.HASH in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.HASH, self[ext_name][self.REPO][self.HASH], + found_refs) + if (self.SUBMODULE in self[ext_name] and + self[ext_name][self.SUBMODULE]): + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.SUBMODULE, + self[ext_name][self.SUBMODULE], found_refs) + + if ref_count > 1: + msg = 'Model description is over specified! ' + if self.SUBMODULE in self[ext_name]: + msg += ('from_submodule is not compatible with ' + '"tag", "branch", or "hash" ') + else: + msg += (' Only one of "tag", "branch", or "hash" ' + 'may be specified ') + + msg += 'for repo description of "{0}".'.format(ext_name) + msg = '{0}\nFound: {1}'.format(msg, found_refs) + fatal_error(msg) + elif ref_count < 1: + msg = ('Model description is under specified! One of ' + '"tag", "branch", or "hash" must be specified for ' + 'repo description of "{0}"'.format(ext_name)) + fatal_error(msg) + + if (self.REPO_URL not in self[ext_name][self.REPO] and + (self.SUBMODULE not in self[ext_name] or + not self[ext_name][self.SUBMODULE])): + msg = ('Model description is under specified! Must have ' + '"repo_url" in repo ' + 'description for "{0}"'.format(ext_name)) + fatal_error(msg) + + if (self.SUBMODULE in self[ext_name] and + self[ext_name][self.SUBMODULE]): + if self.REPO_URL in self[ext_name][self.REPO]: + msg = ('Model description is over specified! ' + 'from_submodule keyword is not compatible ' + 'with {0} keyword for'.format(self.REPO_URL)) + msg = '{0} repo description of "{1}"'.format(msg, + ext_name) + fatal_error(msg) + + if self.PATH in self[ext_name]: + msg = ('Model description is over specified! ' + 'from_submodule keyword is not compatible with ' + '{0} keyword for'.format(self.PATH)) + msg = '{0} repo description of "{1}"'.format(msg, + ext_name) + fatal_error(msg) + + if self.REPO_URL in self[ext_name][self.REPO]: + url = expand_local_url( + self[ext_name][self.REPO][self.REPO_URL], ext_name) + self[ext_name][self.REPO][self.REPO_URL] = url + + def _check_optional(self): + # pylint: disable=too-many-branches + """Some fields like externals, repo:tag repo:branch are + (conditionally) optional. We don't want the user to be + required to enter them in every externals description file, but + still want to validate the input. Check conditions and add + default values if appropriate. + + """ + submod_desc = None # Only load submodules info once + for field in self: + # truely optional + if self.EXTERNALS not in self[field]: + self[field][self.EXTERNALS] = EMPTY_STR + + # git and svn repos must tags and branches for validation purposes. + if self.TAG not in self[field][self.REPO]: + self[field][self.REPO][self.TAG] = EMPTY_STR + if self.BRANCH not in self[field][self.REPO]: + self[field][self.REPO][self.BRANCH] = EMPTY_STR + if self.HASH not in self[field][self.REPO]: + self[field][self.REPO][self.HASH] = EMPTY_STR + if self.REPO_URL not in self[field][self.REPO]: + self[field][self.REPO][self.REPO_URL] = EMPTY_STR + + # from_submodule has a complex relationship with other fields + if self.SUBMODULE in self[field]: + # User wants to use submodule information, is it available? + if self._parent_repo is None: + # No parent == no submodule information + PPRINTER.pprint(self[field]) + msg = 'No parent submodule for "{0}"'.format(field) + fatal_error(msg) + elif self._parent_repo.protocol() != self.PROTOCOL_GIT: + PPRINTER.pprint(self[field]) + msg = 'Parent protocol, "{0}", does not support submodules' + fatal_error(msg.format(self._parent_repo.protocol())) + else: + args = self._repo_config_from_submodule(field, submod_desc) + repo_url, repo_path, ref_hash, submod_desc = args + + if repo_url is None: + msg = ('Cannot checkout "{0}" as a submodule, ' + 'repo not found in {1} file') + fatal_error(msg.format(field, + self.GIT_SUBMODULES_FILENAME)) + # Fill in submodule fields + self[field][self.REPO][self.REPO_URL] = repo_url + self[field][self.REPO][self.HASH] = ref_hash + self[field][self.PATH] = repo_path + + if self[field][self.SUBMODULE]: + # We should get everything from the parent submodule + # configuration. + pass + # No else (from _submodule = False is the default) + else: + # Add the default value (not using submodule information) + self[field][self.SUBMODULE] = False + + def _repo_config_from_submodule(self, field, submod_desc): + """Find the external config information for a repository from + its submodule configuration information. + """ + if submod_desc is None: + repo_path = os.getcwd() # Is this always correct? + submod_file = self._parent_repo.submodules_file(repo_path=repo_path) + if submod_file is None: + msg = ('Cannot checkout "{0}" from submodule information\n' + ' Parent repo, "{1}" does not have submodules') + fatal_error(msg.format(field, self._parent_repo.name())) + + submod_file = read_gitmodules_file(repo_path, submod_file) + submod_desc = create_externals_description(submod_file) + + # Can we find our external? + repo_url = None + repo_path = None + ref_hash = None + for ext_field in submod_desc: + if field == ext_field: + ext = submod_desc[ext_field] + repo_url = ext[self.REPO][self.REPO_URL] + repo_path = ext[self.PATH] + ref_hash = ext[self.REPO][self.HASH] + break + + return repo_url, repo_path, ref_hash, submod_desc + + def _validate(self): + """Validate that the parsed externals description contains all necessary + fields. + + """ + def print_compare_difference(data_a, data_b, loc_a, loc_b): + """Look through the data structures and print the differences. + + """ + for item in data_a: + if item in data_b: + if not isinstance(data_b[item], type(data_a[item])): + printlog(" {item}: {loc} = {val} ({val_type})".format( + item=item, loc=loc_a, val=data_a[item], + val_type=type(data_a[item]))) + printlog(" {item} {loc} = {val} ({val_type})".format( + item=' ' * len(item), loc=loc_b, val=data_b[item], + val_type=type(data_b[item]))) + else: + printlog(" {item}: {loc} = {val} ({val_type})".format( + item=item, loc=loc_a, val=data_a[item], + val_type=type(data_a[item]))) + printlog(" {item} {loc} missing".format( + item=' ' * len(item), loc=loc_b)) + + def validate_data_struct(schema, data): + """Compare a data structure against a schema and validate all required + fields are present. + + """ + is_valid = False + in_ref = True + valid = True + if isinstance(schema, dict) and isinstance(data, dict): + # Both are dicts, recursively verify that all fields + # in schema are present in the data. + for key in schema: + in_ref = in_ref and (key in data) + if in_ref: + valid = valid and ( + validate_data_struct(schema[key], data[key])) + + is_valid = in_ref and valid + else: + # non-recursive structure. verify data and schema have + # the same type. + is_valid = isinstance(data, type(schema)) + + if not is_valid: + printlog(" Unmatched schema and input:") + if isinstance(schema, dict): + print_compare_difference(schema, data, 'schema', 'input') + print_compare_difference(data, schema, 'input', 'schema') + else: + printlog(" schema = {0} ({1})".format( + schema, type(schema))) + printlog(" input = {0} ({1})".format(data, type(data))) + + return is_valid + + for field in self: + valid = validate_data_struct(self._source_schema, self[field]) + if not valid: + PPRINTER.pprint(self._source_schema) + PPRINTER.pprint(self[field]) + msg = 'ERROR: source for "{0}" did not validate'.format(field) + fatal_error(msg) + + +class ExternalsDescriptionDict(ExternalsDescription): + """Create a externals description object from a dictionary using the API + representations. Primarily used to simplify creating model + description files for unit testing. + + """ + + def __init__(self, model_data, components=None): + """Parse a native dictionary into a externals description. + """ + ExternalsDescription.__init__(self) + self._schema_major = 1 + self._schema_minor = 0 + self._schema_patch = 0 + self._input_major = 1 + self._input_minor = 0 + self._input_patch = 0 + self._verify_schema_version() + if components: + for key in model_data.items(): + if key not in components: + del model_data[key] + + self.update(model_data) + self._check_user_input() + + +class ExternalsDescriptionConfigV1(ExternalsDescription): + """Create a externals description object from a config_parser object, + schema version 1. + + """ + + def __init__(self, model_data, components=None, parent_repo=None): + """Convert the config data into a standardized dict that can be used to + construct the source objects + + """ + ExternalsDescription.__init__(self, parent_repo=parent_repo) + self._schema_major = 1 + self._schema_minor = 1 + self._schema_patch = 0 + self._input_major, self._input_minor, self._input_patch = \ + get_cfg_schema_version(model_data) + self._verify_schema_version() + self._remove_metadata(model_data) + self._parse_cfg(model_data, components=components) + self._check_user_input() + + @staticmethod + def _remove_metadata(model_data): + """Remove the metadata section from the model configuration file so + that it is simpler to look through the file and construct the + externals description. + + """ + model_data.remove_section(DESCRIPTION_SECTION) + + def _parse_cfg(self, cfg_data, components=None): + """Parse a config_parser object into a externals description. + """ + def list_to_dict(input_list, convert_to_lower_case=True): + """Convert a list of key-value pairs into a dictionary. + """ + output_dict = {} + for item in input_list: + key = config_string_cleaner(item[0].strip()) + value = config_string_cleaner(item[1].strip()) + if convert_to_lower_case: + key = key.lower() + output_dict[key] = value + return output_dict + + for section in cfg_data.sections(): + name = config_string_cleaner(section.lower().strip()) + if components and name not in components: + continue + self[name] = {} + self[name].update(list_to_dict(cfg_data.items(section))) + self[name][self.REPO] = {} + loop_keys = self[name].copy().keys() + for item in loop_keys: + if item in self._source_schema: + if isinstance(self._source_schema[item], bool): + self[name][item] = str_to_bool(self[name][item]) + elif item in self._source_schema[self.REPO]: + self[name][self.REPO][item] = self[name][item] + del self[name][item] + else: + msg = ('Invalid input: "{sect}" contains unknown ' + 'item "{item}".'.format(sect=name, item=item)) + fatal_error(msg) diff --git a/manage_externals/manic/externals_status.py b/manage_externals/manic/externals_status.py new file mode 100644 index 0000000000..d3d238f289 --- /dev/null +++ b/manage_externals/manic/externals_status.py @@ -0,0 +1,164 @@ +"""ExternalStatus + +Class to store status and state information about repositories and +create a string representation. + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +from .global_constants import EMPTY_STR +from .utils import printlog, indent_string +from .global_constants import VERBOSITY_VERBOSE, VERBOSITY_DUMP + + +class ExternalStatus(object): + """Class to represent the status of a given source repository or tree. + + Individual repositories determine their own status in the + Repository objects. This object is just resposible for storing the + information and passing it up to a higher level for reporting or + global decisions. + + There are two states of concern: + + * If the repository is in-sync with the externals description file. + + * If the repostiory working copy is clean and there are no pending + transactions (e.g. add, remove, rename, untracked files). + + """ + DEFAULT = '-' + UNKNOWN = '?' + EMPTY = 'e' + MODEL_MODIFIED = 's' # a.k.a. out-of-sync + DIRTY = 'M' + + STATUS_OK = ' ' + STATUS_ERROR = '!' + + # source types + OPTIONAL = 'o' + STANDALONE = 's' + MANAGED = ' ' + + def __init__(self): + self.sync_state = self.DEFAULT + self.clean_state = self.DEFAULT + self.source_type = self.DEFAULT + self.path = EMPTY_STR + self.current_version = EMPTY_STR + self.expected_version = EMPTY_STR + self.status_output = EMPTY_STR + + def log_status_message(self, verbosity): + """Write status message to the screen and log file + """ + self._default_status_message() + if verbosity >= VERBOSITY_VERBOSE: + self._verbose_status_message() + if verbosity >= VERBOSITY_DUMP: + self._dump_status_message() + + def _default_status_message(self): + """Return the default terse status message string + """ + msg = '{sync}{clean}{src_type} {path}'.format( + sync=self.sync_state, clean=self.clean_state, + src_type=self.source_type, path=self.path) + printlog(msg) + + def _verbose_status_message(self): + """Return the verbose status message string + """ + clean_str = self.DEFAULT + if self.clean_state == self.STATUS_OK: + clean_str = 'clean sandbox' + elif self.clean_state == self.DIRTY: + clean_str = 'modified sandbox' + + sync_str = 'on {0}'.format(self.current_version) + if self.sync_state != self.STATUS_OK: + sync_str = '{current} --> {expected}'.format( + current=self.current_version, expected=self.expected_version) + msg = ' {clean}, {sync}'.format(clean=clean_str, sync=sync_str) + printlog(msg) + + def _dump_status_message(self): + """Return the dump status message string + """ + msg = indent_string(self.status_output, 12) + printlog(msg) + + def safe_to_update(self): + """Report if it is safe to update a repository. Safe is defined as: + + * If a repository is empty, it is safe to update. + + * If a repository exists and has a clean working copy state + with no pending transactions. + + """ + safe_to_update = False + repo_exists = self.exists() + if not repo_exists: + safe_to_update = True + else: + # If the repo exists, it must be in ok or modified + # sync_state. Any other sync_state at this point + # represents a logic error that should have been handled + # before now! + sync_safe = ((self.sync_state == ExternalStatus.STATUS_OK) or + (self.sync_state == ExternalStatus.MODEL_MODIFIED)) + if sync_safe: + # The clean_state must be STATUS_OK to update. Otherwise we + # are dirty or there was a missed error previously. + if self.clean_state == ExternalStatus.STATUS_OK: + safe_to_update = True + return safe_to_update + + def exists(self): + """Determine if the repo exists. This is indicated by: + + * sync_state is not EMPTY + + * if the sync_state is empty, then the valid states for + clean_state are default, empty or unknown. Anything else + and there was probably an internal logic error. + + NOTE(bja, 2017-10) For the moment we are considering a + sync_state of default or unknown to require user intervention, + but we may want to relax this convention. This is probably a + result of a network error or internal logic error but more + testing is needed. + + """ + is_empty = (self.sync_state == ExternalStatus.EMPTY) + clean_valid = ((self.clean_state == ExternalStatus.DEFAULT) or + (self.clean_state == ExternalStatus.EMPTY) or + (self.clean_state == ExternalStatus.UNKNOWN)) + + if is_empty and clean_valid: + exists = False + else: + exists = True + return exists + + +def check_safe_to_update_repos(tree_status): + """Check if *ALL* repositories are in a safe state to update. We don't + want to do a partial update of the repositories then die, leaving + the model in an inconsistent state. + + Note: if there is an update to do, the repositories will by + definiation be out of synce with the externals description, so we + can't use that as criteria for updating. + + """ + safe_to_update = True + for comp in tree_status: + stat = tree_status[comp] + safe_to_update &= stat.safe_to_update() + + return safe_to_update diff --git a/manage_externals/manic/global_constants.py b/manage_externals/manic/global_constants.py new file mode 100644 index 0000000000..0e91cffc90 --- /dev/null +++ b/manage_externals/manic/global_constants.py @@ -0,0 +1,18 @@ +"""Globals shared across modules +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import pprint + +EMPTY_STR = '' +LOCAL_PATH_INDICATOR = '.' +VERSION_SEPERATOR = '.' +LOG_FILE_NAME = 'manage_externals.log' +PPRINTER = pprint.PrettyPrinter(indent=4) + +VERBOSITY_DEFAULT = 0 +VERBOSITY_VERBOSE = 1 +VERBOSITY_DUMP = 2 diff --git a/manage_externals/manic/repository.py b/manage_externals/manic/repository.py new file mode 100644 index 0000000000..4488c6be9e --- /dev/null +++ b/manage_externals/manic/repository.py @@ -0,0 +1,97 @@ +"""Base class representation of a repository +""" + +from .externals_description import ExternalsDescription +from .utils import fatal_error +from .global_constants import EMPTY_STR + + +class Repository(object): + """ + Class to represent and operate on a repository description. + """ + + def __init__(self, component_name, repo): + """ + Parse repo externals description + """ + self._name = component_name + self._protocol = repo[ExternalsDescription.PROTOCOL] + self._tag = repo[ExternalsDescription.TAG] + self._branch = repo[ExternalsDescription.BRANCH] + self._hash = repo[ExternalsDescription.HASH] + self._url = repo[ExternalsDescription.REPO_URL] + + if self._url is EMPTY_STR: + fatal_error('repo must have a URL') + + if ((self._tag is EMPTY_STR) and (self._branch is EMPTY_STR) and + (self._hash is EMPTY_STR)): + fatal_error('{0} repo must have a branch, tag or hash element') + + ref_count = 0 + if self._tag is not EMPTY_STR: + ref_count += 1 + if self._branch is not EMPTY_STR: + ref_count += 1 + if self._hash is not EMPTY_STR: + ref_count += 1 + if ref_count != 1: + fatal_error('repo {0} must have exactly one of ' + 'tag, branch or hash.'.format(self._name)) + + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correce + branch or tag. + NB: is include as an argument for compatibility with + git functionality (repository_git.py) + """ + msg = ('DEV_ERROR: checkout method must be implemented in all ' + 'repository classes! {0}'.format(self.__class__.__name__)) + fatal_error(msg) + + def status(self, stat, repo_dir_path): # pylint: disable=unused-argument + """Report the status of the repo + + """ + msg = ('DEV_ERROR: status method must be implemented in all ' + 'repository classes! {0}'.format(self.__class__.__name__)) + fatal_error(msg) + + def submodules_file(self, repo_path=None): + # pylint: disable=no-self-use,unused-argument + """Stub for use by non-git VC systems""" + return None + + def url(self): + """Public access of repo url. + """ + return self._url + + def tag(self): + """Public access of repo tag + """ + return self._tag + + def branch(self): + """Public access of repo branch. + """ + return self._branch + + def hash(self): + """Public access of repo hash. + """ + return self._hash + + def name(self): + """Public access of repo name. + """ + return self._name + + def protocol(self): + """Public access of repo protocol. + """ + return self._protocol diff --git a/manage_externals/manic/repository_factory.py b/manage_externals/manic/repository_factory.py new file mode 100644 index 0000000000..80a92a9d8a --- /dev/null +++ b/manage_externals/manic/repository_factory.py @@ -0,0 +1,29 @@ +"""Factory for creating and initializing the appropriate repository class +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +from .repository_git import GitRepository +from .repository_svn import SvnRepository +from .externals_description import ExternalsDescription +from .utils import fatal_error + + +def create_repository(component_name, repo_info, svn_ignore_ancestry=False): + """Determine what type of repository we have, i.e. git or svn, and + create the appropriate object. + + """ + protocol = repo_info[ExternalsDescription.PROTOCOL].lower() + if protocol == 'git': + repo = GitRepository(component_name, repo_info) + elif protocol == 'svn': + repo = SvnRepository(component_name, repo_info, ignore_ancestry=svn_ignore_ancestry) + elif protocol == 'externals_only': + repo = None + else: + msg = 'Unknown repo protocol "{0}"'.format(protocol) + fatal_error(msg) + return repo diff --git a/manage_externals/manic/repository_git.py b/manage_externals/manic/repository_git.py new file mode 100644 index 0000000000..c0e64eb551 --- /dev/null +++ b/manage_externals/manic/repository_git.py @@ -0,0 +1,790 @@ +"""Class for interacting with git repositories +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import copy +import os + +from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR +from .global_constants import VERBOSITY_VERBOSE +from .repository import Repository +from .externals_status import ExternalStatus +from .externals_description import ExternalsDescription, git_submodule_status +from .utils import expand_local_url, split_remote_url, is_remote_url +from .utils import fatal_error, printlog +from .utils import execute_subprocess + + +class GitRepository(Repository): + """Class to represent and operate on a repository description. + + For testing purpose, all system calls to git should: + + * be isolated in separate functions with no application logic + * of the form: + - cmd = ['git', ...] + - value = execute_subprocess(cmd, output_to_caller={T|F}, + status_to_caller={T|F}) + - return value + * be static methods (not rely on self) + * name as _git_subcommand_args(user_args) + + This convention allows easy unit testing of the repository logic + by mocking the specific calls to return predefined results. + + """ + + def __init__(self, component_name, repo): + """ + Parse repo (a XML element). + """ + Repository.__init__(self, component_name, repo) + self._gitmodules = None + self._submods = None + + # ---------------------------------------------------------------- + # + # Public API, defined by Repository + # + # ---------------------------------------------------------------- + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correct + branch or tag. + """ + repo_dir_path = os.path.join(base_dir_path, repo_dir_name) + repo_dir_exists = os.path.exists(repo_dir_path) + if (repo_dir_exists and not os.listdir( + repo_dir_path)) or not repo_dir_exists: + self._clone_repo(base_dir_path, repo_dir_name, verbosity) + self._checkout_ref(repo_dir_path, verbosity, recursive) + gmpath = os.path.join(repo_dir_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + if os.path.exists(gmpath): + self._gitmodules = gmpath + self._submods = git_submodule_status(repo_dir_path) + else: + self._gitmodules = None + self._submods = None + + def status(self, stat, repo_dir_path): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correct + branch or tag. + """ + self._check_sync(stat, repo_dir_path) + if os.path.exists(repo_dir_path): + self._status_summary(stat, repo_dir_path) + + def submodules_file(self, repo_path=None): + if repo_path is not None: + gmpath = os.path.join(repo_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + if os.path.exists(gmpath): + self._gitmodules = gmpath + self._submods = git_submodule_status(repo_path) + + return self._gitmodules + + # ---------------------------------------------------------------- + # + # Internal work functions + # + # ---------------------------------------------------------------- + def _clone_repo(self, base_dir_path, repo_dir_name, verbosity): + """Prepare to execute the clone by managing directory location + """ + cwd = os.getcwd() + os.chdir(base_dir_path) + self._git_clone(self._url, repo_dir_name, verbosity) + os.chdir(cwd) + + def _current_ref(self): + """Determine the *name* associated with HEAD. + + If we're on a branch, then returns the branch name; otherwise, + if we're on a tag, then returns the tag name; otherwise, returns + the current hash. Returns an empty string if no reference can be + determined (e.g., if we're not actually in a git repository). + """ + ref_found = False + + # If we're on a branch, then use that as the current ref + branch_found, branch_name = self._git_current_branch() + if branch_found: + current_ref = branch_name + ref_found = True + + if not ref_found: + # Otherwise, if we're exactly at a tag, use that as the + # current ref + tag_found, tag_name = self._git_current_tag() + if tag_found: + current_ref = tag_name + ref_found = True + + if not ref_found: + # Otherwise, use current hash as the current ref + hash_found, hash_name = self._git_current_hash() + if hash_found: + current_ref = hash_name + ref_found = True + + if not ref_found: + # If we still can't find a ref, return empty string. This + # can happen if we're not actually in a git repo + current_ref = '' + + return current_ref + + def _check_sync(self, stat, repo_dir_path): + """Determine whether a git repository is in-sync with the model + description. + + Because repos can have multiple remotes, the only criteria is + whether the branch or tag is the same. + + """ + if not os.path.exists(repo_dir_path): + # NOTE(bja, 2017-10) condition should have been determined + # by _Source() object and should never be here! + stat.sync_state = ExternalStatus.STATUS_ERROR + else: + git_dir = os.path.join(repo_dir_path, '.git') + if not os.path.exists(git_dir): + # NOTE(bja, 2017-10) directory exists, but no git repo + # info.... Can't test with subprocess git command + # because git will move up directory tree until it + # finds the parent repo git dir! + stat.sync_state = ExternalStatus.UNKNOWN + else: + self._check_sync_logic(stat, repo_dir_path) + + def _check_sync_logic(self, stat, repo_dir_path): + """Compare the underlying hashes of the currently checkout ref and the + expected ref. + + Output: sets the sync_state as well as the current and + expected ref in the input status object. + + """ + def compare_refs(current_ref, expected_ref): + """Compare the current and expected ref. + + """ + if current_ref == expected_ref: + status = ExternalStatus.STATUS_OK + else: + status = ExternalStatus.MODEL_MODIFIED + return status + + cwd = os.getcwd() + os.chdir(repo_dir_path) + + # get the full hash of the current commit + _, current_ref = self._git_current_hash() + + if self._branch: + if self._url == LOCAL_PATH_INDICATOR: + expected_ref = self._branch + else: + remote_name = self._determine_remote_name() + if not remote_name: + # git doesn't know about this remote. by definition + # this is a modified state. + expected_ref = "unknown_remote/{0}".format(self._branch) + else: + expected_ref = "{0}/{1}".format(remote_name, self._branch) + elif self._hash: + expected_ref = self._hash + elif self._tag: + expected_ref = self._tag + else: + msg = 'In repo "{0}": none of branch, hash or tag are set'.format( + self._name) + fatal_error(msg) + + # record the *names* of the current and expected branches + stat.current_version = self._current_ref() + stat.expected_version = copy.deepcopy(expected_ref) + + if current_ref == EMPTY_STR: + stat.sync_state = ExternalStatus.UNKNOWN + else: + # get the underlying hash of the expected ref + revparse_status, expected_ref_hash = self._git_revparse_commit( + expected_ref) + if revparse_status: + # We failed to get the hash associated with + # expected_ref. Maybe we should assign this to some special + # status, but for now we're just calling this out-of-sync to + # remain consistent with how this worked before. + stat.sync_state = ExternalStatus.MODEL_MODIFIED + else: + # compare the underlying hashes + stat.sync_state = compare_refs(current_ref, expected_ref_hash) + + os.chdir(cwd) + + def _determine_remote_name(self): + """Return the remote name. + + Note that this is for the *future* repo url and branch, not + the current working copy! + + """ + git_output = self._git_remote_verbose() + git_output = git_output.splitlines() + remote_name = '' + for line in git_output: + data = line.strip() + if not data: + continue + data = data.split() + name = data[0].strip() + url = data[1].strip() + if self._url == url: + remote_name = name + break + return remote_name + + def _create_remote_name(self): + """The url specified in the externals description file was not known + to git. We need to add it, which means adding a unique and + safe name.... + + The assigned name needs to be safe for git to use, e.g. can't + look like a path 'foo/bar' and work with both remote and local paths. + + Remote paths include but are not limited to: git, ssh, https, + github, gitlab, bitbucket, custom server, etc. + + Local paths can be relative or absolute. They may contain + shell variables, e.g. ${REPO_ROOT}/repo_name, or username + expansion, i.e. ~/ or ~someuser/. + + Relative paths must be at least one layer of redirection, i.e. + container/../ext_repo, but may be many layers deep, e.g. + container/../../../../../ext_repo + + NOTE(bja, 2017-11) + + The base name below may not be unique, for example if the + user has local paths like: + + /path/to/my/repos/nice_repo + /path/to/other/repos/nice_repo + + But the current implementation should cover most common + use cases for remotes and still provide usable names. + + """ + url = copy.deepcopy(self._url) + if is_remote_url(url): + url = split_remote_url(url) + else: + url = expand_local_url(url, self._name) + url = url.split('/') + repo_name = url[-1] + base_name = url[-2] + # repo name should nominally already be something that git can + # deal with. We need to remove other possibly troublesome + # punctuation, e.g. /, $, from the base name. + unsafe_characters = '!@#$%^&*()[]{}\\/,;~' + for unsafe in unsafe_characters: + base_name = base_name.replace(unsafe, '') + remote_name = "{0}_{1}".format(base_name, repo_name) + return remote_name + + def _checkout_ref(self, repo_dir, verbosity, submodules): + """Checkout the user supplied reference + if is True, recursively initialize and update + the repo's submodules + """ + # import pdb; pdb.set_trace() + cwd = os.getcwd() + os.chdir(repo_dir) + if self._url.strip() == LOCAL_PATH_INDICATOR: + self._checkout_local_ref(verbosity, submodules) + else: + self._checkout_external_ref(verbosity, submodules) + + os.chdir(cwd) + + def _checkout_local_ref(self, verbosity, submodules): + """Checkout the reference considering the local repo only. Do not + fetch any additional remotes or specify the remote when + checkout out the ref. + if is True, recursively initialize and update + the repo's submodules + """ + if self._tag: + ref = self._tag + elif self._branch: + ref = self._branch + else: + ref = self._hash + + self._check_for_valid_ref(ref) + self._git_checkout_ref(ref, verbosity, submodules) + + def _checkout_external_ref(self, verbosity, submodules): + """Checkout the reference from a remote repository + if is True, recursively initialize and update + the repo's submodules + """ + if self._tag: + ref = self._tag + elif self._branch: + ref = self._branch + else: + ref = self._hash + + remote_name = self._determine_remote_name() + if not remote_name: + remote_name = self._create_remote_name() + self._git_remote_add(remote_name, self._url) + self._git_fetch(remote_name) + + # NOTE(bja, 2018-03) we need to send separate ref and remote + # name to check_for_vaild_ref, but the combined name to + # checkout_ref! + self._check_for_valid_ref(ref, remote_name) + + if self._branch: + ref = '{0}/{1}'.format(remote_name, ref) + self._git_checkout_ref(ref, verbosity, submodules) + + def _check_for_valid_ref(self, ref, remote_name=None): + """Try some basic sanity checks on the user supplied reference so we + can provide a more useful error message than calledprocess + error... + + """ + is_tag = self._ref_is_tag(ref) + is_branch = self._ref_is_branch(ref, remote_name) + is_hash = self._ref_is_hash(ref) + + is_valid = is_tag or is_branch or is_hash + if not is_valid: + msg = ('In repo "{0}": reference "{1}" does not appear to be a ' + 'valid tag, branch or hash! Please verify the reference ' + 'name (e.g. spelling), is available from: {2} '.format( + self._name, ref, self._url)) + fatal_error(msg) + + if is_tag: + is_unique_tag, msg = self._is_unique_tag(ref, remote_name) + if not is_unique_tag: + msg = ('In repo "{0}": tag "{1}" {2}'.format( + self._name, self._tag, msg)) + fatal_error(msg) + + return is_valid + + def _is_unique_tag(self, ref, remote_name): + """Verify that a reference is a valid tag and is unique (not a branch) + + Tags may be tag names, or SHA id's. It is also possible that a + branch and tag have the some name. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_tag = self._ref_is_tag(ref) + is_branch = self._ref_is_branch(ref, remote_name) + is_hash = self._ref_is_hash(ref) + + msg = '' + is_unique_tag = False + if is_tag and not is_branch: + # unique tag + msg = 'is ok' + is_unique_tag = True + elif is_tag and is_branch: + msg = ('is both a branch and a tag. git may checkout the branch ' + 'instead of the tag depending on your version of git.') + is_unique_tag = False + elif not is_tag and is_branch: + msg = ('is a branch, and not a tag. If you intended to checkout ' + 'a branch, please change the externals description to be ' + 'a branch. If you intended to checkout a tag, it does not ' + 'exist. Please check the name.') + is_unique_tag = False + else: # not is_tag and not is_branch: + if is_hash: + # probably a sha1 or HEAD, etc, we call it a tag + msg = 'is ok' + is_unique_tag = True + else: + # undetermined state. + msg = ('does not appear to be a valid tag, branch or hash! ' + 'Please check the name and repository.') + is_unique_tag = False + + return is_unique_tag, msg + + def _ref_is_tag(self, ref): + """Verify that a reference is a valid tag according to git. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + """ + is_tag = False + value = self._git_showref_tag(ref) + if value == 0: + is_tag = True + return is_tag + + def _ref_is_branch(self, ref, remote_name=None): + """Verify if a ref is any kind of branch (local, tracked remote, + untracked remote). + + """ + local_branch = False + remote_branch = False + if remote_name: + remote_branch = self._ref_is_remote_branch(ref, remote_name) + local_branch = self._ref_is_local_branch(ref) + + is_branch = False + if local_branch or remote_branch: + is_branch = True + return is_branch + + def _ref_is_local_branch(self, ref): + """Verify that a reference is a valid branch according to git. + + show-ref branch returns local branches that have been + previously checked out. It will not necessarily pick up + untracked remote branches. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_branch = False + value = self._git_showref_branch(ref) + if value == 0: + is_branch = True + return is_branch + + def _ref_is_remote_branch(self, ref, remote_name): + """Verify that a reference is a valid branch according to git. + + show-ref branch returns local branches that have been + previously checked out. It will not necessarily pick up + untracked remote branches. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_branch = False + value = self._git_lsremote_branch(ref, remote_name) + if value == 0: + is_branch = True + return is_branch + + def _ref_is_commit(self, ref): + """Verify that a reference is a valid commit according to git. + + This could be a tag, branch, sha1 id, HEAD and potentially others... + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + """ + is_commit = False + value, _ = self._git_revparse_commit(ref) + if value == 0: + is_commit = True + return is_commit + + def _ref_is_hash(self, ref): + """Verify that a reference is a valid hash according to git. + + Git doesn't seem to provide an exact way to determine if user + supplied reference is an actual hash. So we verify that the + ref is a valid commit and return the underlying commit + hash. Then check that the commit hash begins with the user + supplied string. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_hash = False + status, git_output = self._git_revparse_commit(ref) + if status == 0: + if git_output.strip().startswith(ref): + is_hash = True + return is_hash + + def _status_summary(self, stat, repo_dir_path): + """Determine the clean/dirty status of a git repository + + """ + cwd = os.getcwd() + os.chdir(repo_dir_path) + git_output = self._git_status_porcelain_v1z() + is_dirty = self._status_v1z_is_dirty(git_output) + if is_dirty: + stat.clean_state = ExternalStatus.DIRTY + else: + stat.clean_state = ExternalStatus.STATUS_OK + + # Now save the verbose status output incase the user wants to + # see it. + stat.status_output = self._git_status_verbose() + os.chdir(cwd) + + @staticmethod + def _status_v1z_is_dirty(git_output): + """Parse the git status output from --porcelain=v1 -z and determine if + the repo status is clean or dirty. Dirty means: + + * modified files + * missing files + * added files + * removed + * renamed + * unmerged + + Whether untracked files are considered depends on how the status + command was run (i.e., whether it was run with the '-u' option). + + NOTE: Based on the above definition, the porcelain status + should be an empty string to be considered 'clean'. Of course + this assumes we only get an empty string from an status + command on a clean checkout, and not some error + condition... Could alse use 'git diff --quiet'. + + """ + is_dirty = False + if git_output: + is_dirty = True + return is_dirty + + # ---------------------------------------------------------------- + # + # system call to git for information gathering + # + # ---------------------------------------------------------------- + @staticmethod + def _git_current_hash(): + """Return the full hash of the currently checked-out version. + + Returns a tuple, (hash_found, hash), where hash_found is a + logical specifying whether a hash was found for HEAD (False + could mean we're not in a git repository at all). (If hash_found + is False, then hash is ''.) + """ + status, git_output = GitRepository._git_revparse_commit("HEAD") + hash_found = not status + if not hash_found: + git_output = '' + return hash_found, git_output + + @staticmethod + def _git_current_branch(): + """Determines the name of the current branch. + + Returns a tuple, (branch_found, branch_name), where branch_found + is a logical specifying whether a branch name was found for + HEAD. (If branch_found is False, then branch_name is ''.) + """ + cmd = ['git', 'symbolic-ref', '--short', '-q', 'HEAD'] + status, git_output = execute_subprocess(cmd, + output_to_caller=True, + status_to_caller=True) + branch_found = not status + if branch_found: + git_output = git_output.strip() + else: + git_output = '' + return branch_found, git_output + + @staticmethod + def _git_current_tag(): + """Determines the name tag corresponding to HEAD (if any). + + Returns a tuple, (tag_found, tag_name), where tag_found is a + logical specifying whether we found a tag name corresponding to + HEAD. (If tag_found is False, then tag_name is ''.) + """ + # git describe --exact-match --tags HEAD + cmd = ['git', 'describe', '--exact-match', '--tags', 'HEAD'] + status, git_output = execute_subprocess(cmd, + output_to_caller=True, + status_to_caller=True) + tag_found = not status + if tag_found: + git_output = git_output.strip() + else: + git_output = '' + return tag_found, git_output + + @staticmethod + def _git_showref_tag(ref): + """Run git show-ref check if the user supplied ref is a tag. + + could also use git rev-parse --quiet --verify tagname^{tag} + """ + cmd = ['git', 'show-ref', '--quiet', '--verify', + 'refs/tags/{0}'.format(ref), ] + status = execute_subprocess(cmd, status_to_caller=True) + return status + + @staticmethod + def _git_showref_branch(ref): + """Run git show-ref check if the user supplied ref is a local or + tracked remote branch. + + """ + cmd = ['git', 'show-ref', '--quiet', '--verify', + 'refs/heads/{0}'.format(ref), ] + status = execute_subprocess(cmd, status_to_caller=True) + return status + + @staticmethod + def _git_lsremote_branch(ref, remote_name): + """Run git ls-remote to check if the user supplied ref is a remote + branch that is not being tracked + + """ + cmd = ['git', 'ls-remote', '--exit-code', '--heads', + remote_name, ref, ] + status = execute_subprocess(cmd, status_to_caller=True) + return status + + @staticmethod + def _git_revparse_commit(ref): + """Run git rev-parse to detect if a reference is a SHA, HEAD or other + valid commit. + + """ + cmd = ['git', 'rev-parse', '--quiet', '--verify', + '{0}^{1}'.format(ref, '{commit}'), ] + status, git_output = execute_subprocess(cmd, status_to_caller=True, + output_to_caller=True) + git_output = git_output.strip() + return status, git_output + + @staticmethod + def _git_status_porcelain_v1z(): + """Run git status to obtain repository information. + + This is run with '--untracked=no' to ignore untracked files. + + The machine-portable format that is guaranteed not to change + between git versions or *user configuration*. + + """ + cmd = ['git', 'status', '--untracked-files=no', '--porcelain', '-z'] + git_output = execute_subprocess(cmd, output_to_caller=True) + return git_output + + @staticmethod + def _git_status_verbose(): + """Run the git status command to obtain repository information. + """ + cmd = ['git', 'status'] + git_output = execute_subprocess(cmd, output_to_caller=True) + return git_output + + @staticmethod + def _git_remote_verbose(): + """Run the git remote command to obtain repository information. + """ + cmd = ['git', 'remote', '--verbose'] + git_output = execute_subprocess(cmd, output_to_caller=True) + return git_output + + @staticmethod + def has_submodules(repo_dir_path=None): + """Return True iff the repository at (or the current + directory if is None) has a '.gitmodules' file + """ + if repo_dir_path is None: + fname = ExternalsDescription.GIT_SUBMODULES_FILENAME + else: + fname = os.path.join(repo_dir_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + + return os.path.exists(fname) + + # ---------------------------------------------------------------- + # + # system call to git for sideffects modifying the working tree + # + # ---------------------------------------------------------------- + @staticmethod + def _git_clone(url, repo_dir_name, verbosity): + """Run git clone for the side effect of creating a repository. + """ + cmd = ['git', 'clone', '--quiet'] + subcmd = None + + cmd.extend([url, repo_dir_name]) + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + if subcmd is not None: + os.chdir(repo_dir_name) + execute_subprocess(subcmd) + + @staticmethod + def _git_remote_add(name, url): + """Run the git remote command for the side effect of adding a remote + """ + cmd = ['git', 'remote', 'add', name, url] + execute_subprocess(cmd) + + @staticmethod + def _git_fetch(remote_name): + """Run the git fetch command for the side effect of updating the repo + """ + cmd = ['git', 'fetch', '--quiet', '--tags', remote_name] + execute_subprocess(cmd) + + @staticmethod + def _git_checkout_ref(ref, verbosity, submodules): + """Run the git checkout command for the side effect of updating the repo + + Param: ref is a reference to a local or remote object in the + form 'origin/my_feature', or 'tag1'. + + """ + cmd = ['git', 'checkout', '--quiet', ref] + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + if submodules: + GitRepository._git_update_submodules(verbosity) + + @staticmethod + def _git_update_submodules(verbosity): + """Run git submodule update for the side effect of updating this + repo's submodules. + """ + # First, verify that we have a .gitmodules file + if os.path.exists(ExternalsDescription.GIT_SUBMODULES_FILENAME): + cmd = ['git', 'submodule', 'update', '--init', '--recursive'] + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + + execute_subprocess(cmd) diff --git a/manage_externals/manic/repository_svn.py b/manage_externals/manic/repository_svn.py new file mode 100644 index 0000000000..2f0d4d848c --- /dev/null +++ b/manage_externals/manic/repository_svn.py @@ -0,0 +1,284 @@ +"""Class for interacting with svn repositories +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import re +import xml.etree.ElementTree as ET + +from .global_constants import EMPTY_STR, VERBOSITY_VERBOSE +from .repository import Repository +from .externals_status import ExternalStatus +from .utils import fatal_error, indent_string, printlog +from .utils import execute_subprocess + + +class SvnRepository(Repository): + """ + Class to represent and operate on a repository description. + + For testing purpose, all system calls to svn should: + + * be isolated in separate functions with no application logic + * of the form: + - cmd = ['svn', ...] + - value = execute_subprocess(cmd, output_to_caller={T|F}, + status_to_caller={T|F}) + - return value + * be static methods (not rely on self) + * name as _svn_subcommand_args(user_args) + + This convention allows easy unit testing of the repository logic + by mocking the specific calls to return predefined results. + + """ + RE_URLLINE = re.compile(r'^URL:') + + def __init__(self, component_name, repo, ignore_ancestry=False): + """ + Parse repo (a XML element). + """ + Repository.__init__(self, component_name, repo) + self._ignore_ancestry = ignore_ancestry + if self._branch: + self._url = os.path.join(self._url, self._branch) + elif self._tag: + self._url = os.path.join(self._url, self._tag) + else: + msg = "DEV_ERROR in svn repository. Shouldn't be here!" + fatal_error(msg) + + # ---------------------------------------------------------------- + # + # Public API, defined by Repository + # + # ---------------------------------------------------------------- + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument + """Checkout or update the working copy + + If the repo destination directory exists, switch the sandbox to + match the externals description. + + If the repo destination directory does not exist, checkout the + correct branch or tag. + NB: is include as an argument for compatibility with + git functionality (repository_git.py) + + """ + repo_dir_path = os.path.join(base_dir_path, repo_dir_name) + if os.path.exists(repo_dir_path): + cwd = os.getcwd() + os.chdir(repo_dir_path) + self._svn_switch(self._url, self._ignore_ancestry, verbosity) + # svn switch can lead to a conflict state, but it gives a + # return code of 0. So now we need to make sure that we're + # in a clean (non-conflict) state. + self._abort_if_dirty(repo_dir_path, + "Expected clean state following switch") + os.chdir(cwd) + else: + self._svn_checkout(self._url, repo_dir_path, verbosity) + + def status(self, stat, repo_dir_path): + """ + Check and report the status of the repository + """ + self._check_sync(stat, repo_dir_path) + if os.path.exists(repo_dir_path): + self._status_summary(stat, repo_dir_path) + + # ---------------------------------------------------------------- + # + # Internal work functions + # + # ---------------------------------------------------------------- + def _check_sync(self, stat, repo_dir_path): + """Check to see if repository directory exists and is at the expected + url. Return: status object + + """ + if not os.path.exists(repo_dir_path): + # NOTE(bja, 2017-10) this state should have been handled by + # the source object and we never get here! + stat.sync_state = ExternalStatus.STATUS_ERROR + else: + svn_output = self._svn_info(repo_dir_path) + if not svn_output: + # directory exists, but info returned nothing. .svn + # directory removed or incomplete checkout? + stat.sync_state = ExternalStatus.UNKNOWN + else: + stat.sync_state, stat.current_version = \ + self._check_url(svn_output, self._url) + stat.expected_version = '/'.join(self._url.split('/')[3:]) + + def _abort_if_dirty(self, repo_dir_path, message): + """Check if the repo is in a dirty state; if so, abort with a + helpful message. + + """ + + stat = ExternalStatus() + self._status_summary(stat, repo_dir_path) + if stat.clean_state != ExternalStatus.STATUS_OK: + status = self._svn_status_verbose(repo_dir_path) + status = indent_string(status, 4) + errmsg = """In directory + {cwd} + +svn status now shows: +{status} + +ERROR: {message} + +One possible cause of this problem is that there may have been untracked +files in your working directory that had the same name as tracked files +in the new revision. + +To recover: Clean up the above directory (resolving conflicts, etc.), +then rerun checkout_externals. +""".format(cwd=repo_dir_path, message=message, status=status) + + fatal_error(errmsg) + + @staticmethod + def _check_url(svn_output, expected_url): + """Determine the svn url from svn info output and return whether it + matches the expected value. + + """ + url = None + for line in svn_output.splitlines(): + if SvnRepository.RE_URLLINE.match(line): + url = line.split(': ')[1].strip() + break + if not url: + status = ExternalStatus.UNKNOWN + elif url == expected_url: + status = ExternalStatus.STATUS_OK + else: + status = ExternalStatus.MODEL_MODIFIED + + if url: + current_version = '/'.join(url.split('/')[3:]) + else: + current_version = EMPTY_STR + + return status, current_version + + def _status_summary(self, stat, repo_dir_path): + """Report whether the svn repository is in-sync with the model + description and whether the sandbox is clean or dirty. + + """ + svn_output = self._svn_status_xml(repo_dir_path) + is_dirty = self.xml_status_is_dirty(svn_output) + if is_dirty: + stat.clean_state = ExternalStatus.DIRTY + else: + stat.clean_state = ExternalStatus.STATUS_OK + + # Now save the verbose status output incase the user wants to + # see it. + stat.status_output = self._svn_status_verbose(repo_dir_path) + + @staticmethod + def xml_status_is_dirty(svn_output): + """Parse svn status xml output and determine if the working copy is + clean or dirty. Dirty is defined as: + + * modified files + * added files + * deleted files + * missing files + + Unversioned files do not affect the clean/dirty status. + + 'external' is also an acceptable state + + """ + # pylint: disable=invalid-name + SVN_EXTERNAL = 'external' + SVN_UNVERSIONED = 'unversioned' + # pylint: enable=invalid-name + + is_dirty = False + try: + xml_status = ET.fromstring(svn_output) + except BaseException: + fatal_error( + "SVN returned invalid XML message {}".format(svn_output)) + xml_target = xml_status.find('./target') + entries = xml_target.findall('./entry') + for entry in entries: + status = entry.find('./wc-status') + item = status.get('item') + if item == SVN_EXTERNAL: + continue + if item == SVN_UNVERSIONED: + continue + else: + is_dirty = True + break + return is_dirty + + # ---------------------------------------------------------------- + # + # system call to svn for information gathering + # + # ---------------------------------------------------------------- + @staticmethod + def _svn_info(repo_dir_path): + """Return results of svn info command + """ + cmd = ['svn', 'info', repo_dir_path] + output = execute_subprocess(cmd, output_to_caller=True) + return output + + @staticmethod + def _svn_status_verbose(repo_dir_path): + """capture the full svn status output + """ + cmd = ['svn', 'status', repo_dir_path] + svn_output = execute_subprocess(cmd, output_to_caller=True) + return svn_output + + @staticmethod + def _svn_status_xml(repo_dir_path): + """ + Get status of the subversion sandbox in repo_dir + """ + cmd = ['svn', 'status', '--xml', repo_dir_path] + svn_output = execute_subprocess(cmd, output_to_caller=True) + return svn_output + + # ---------------------------------------------------------------- + # + # system call to svn for sideffects modifying the working tree + # + # ---------------------------------------------------------------- + @staticmethod + def _svn_checkout(url, repo_dir_path, verbosity): + """ + Checkout a subversion repository (repo_url) to checkout_dir. + """ + cmd = ['svn', 'checkout', '--quiet', url, repo_dir_path] + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + + @staticmethod + def _svn_switch(url, ignore_ancestry, verbosity): + """ + Switch branches for in an svn sandbox + """ + cmd = ['svn', 'switch', '--quiet'] + if ignore_ancestry: + cmd.append('--ignore-ancestry') + cmd.append(url) + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) diff --git a/manage_externals/manic/sourcetree.py b/manage_externals/manic/sourcetree.py new file mode 100644 index 0000000000..83676b776b --- /dev/null +++ b/manage_externals/manic/sourcetree.py @@ -0,0 +1,350 @@ +""" + +FIXME(bja, 2017-11) External and SourceTree have a circular dependancy! +""" + +import errno +import logging +import os + +from .externals_description import ExternalsDescription +from .externals_description import read_externals_description_file +from .externals_description import create_externals_description +from .repository_factory import create_repository +from .repository_git import GitRepository +from .externals_status import ExternalStatus +from .utils import fatal_error, printlog +from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR +from .global_constants import VERBOSITY_VERBOSE + +class _External(object): + """ + _External represents an external object inside a SourceTree + """ + + # pylint: disable=R0902 + + def __init__(self, root_dir, name, ext_description, svn_ignore_ancestry): + """Parse an external description file into a dictionary of externals. + + Input: + + root_dir : string - the root directory path where + 'local_path' is relative to. + + name : string - name of the ext_description object. may or may not + correspond to something in the path. + + ext_description : dict - source ExternalsDescription object + + svn_ignore_ancestry : bool - use --ignore-externals with svn switch + + """ + self._name = name + self._repo = None + self._externals = EMPTY_STR + self._externals_sourcetree = None + self._stat = ExternalStatus() + # Parse the sub-elements + + # _path : local path relative to the containing source tree + self._local_path = ext_description[ExternalsDescription.PATH] + # _repo_dir : full repository directory + repo_dir = os.path.join(root_dir, self._local_path) + self._repo_dir_path = os.path.abspath(repo_dir) + # _base_dir : base directory *containing* the repository + self._base_dir_path = os.path.dirname(self._repo_dir_path) + # repo_dir_name : base_dir_path + repo_dir_name = rep_dir_path + self._repo_dir_name = os.path.basename(self._repo_dir_path) + assert(os.path.join(self._base_dir_path, self._repo_dir_name) + == self._repo_dir_path) + + self._required = ext_description[ExternalsDescription.REQUIRED] + self._externals = ext_description[ExternalsDescription.EXTERNALS] + # Treat a .gitmodules file as a backup externals config + if not self._externals: + if GitRepository.has_submodules(self._repo_dir_path): + self._externals = ExternalsDescription.GIT_SUBMODULES_FILENAME + + repo = create_repository( + name, ext_description[ExternalsDescription.REPO], + svn_ignore_ancestry=svn_ignore_ancestry) + if repo: + self._repo = repo + + if self._externals and (self._externals.lower() != 'none'): + self._create_externals_sourcetree() + + def get_name(self): + """ + Return the external object's name + """ + return self._name + + def get_local_path(self): + """ + Return the external object's path + """ + return self._local_path + + def status(self): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the external. + If the repo destination directory does not exist, checkout the correce + branch or tag. + If load_all is True, also load all of the the externals sub-externals. + """ + + self._stat.path = self.get_local_path() + if not self._required: + self._stat.source_type = ExternalStatus.OPTIONAL + elif self._local_path == LOCAL_PATH_INDICATOR: + # LOCAL_PATH_INDICATOR, '.' paths, are standalone + # component directories that are not managed by + # checkout_externals. + self._stat.source_type = ExternalStatus.STANDALONE + else: + # managed by checkout_externals + self._stat.source_type = ExternalStatus.MANAGED + + ext_stats = {} + + if not os.path.exists(self._repo_dir_path): + self._stat.sync_state = ExternalStatus.EMPTY + msg = ('status check: repository directory for "{0}" does not ' + 'exist.'.format(self._name)) + logging.info(msg) + self._stat.current_version = 'not checked out' + # NOTE(bja, 2018-01) directory doesn't exist, so we cannot + # use repo to determine the expected version. We just take + # a best-guess based on the assumption that only tag or + # branch should be set, but not both. + if not self._repo: + self._stat.expected_version = 'unknown' + else: + self._stat.expected_version = self._repo.tag() + self._repo.branch() + else: + if self._repo: + self._repo.status(self._stat, self._repo_dir_path) + + if self._externals and self._externals_sourcetree: + # we expect externals and they exist + cwd = os.getcwd() + # SourceTree expects to be called from the correct + # root directory. + os.chdir(self._repo_dir_path) + ext_stats = self._externals_sourcetree.status(self._local_path) + os.chdir(cwd) + + all_stats = {} + # don't add the root component because we don't manage it + # and can't provide useful info about it. + if self._local_path != LOCAL_PATH_INDICATOR: + # store the stats under tha local_path, not comp name so + # it will be sorted correctly + all_stats[self._stat.path] = self._stat + + if ext_stats: + all_stats.update(ext_stats) + + return all_stats + + def checkout(self, verbosity, load_all): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the external. + If the repo destination directory does not exist, checkout the correct + branch or tag. + If load_all is True, also load all of the the externals sub-externals. + """ + if load_all: + pass + # Make sure we are in correct location + + if not os.path.exists(self._repo_dir_path): + # repository directory doesn't exist. Need to check it + # out, and for that we need the base_dir_path to exist + try: + os.makedirs(self._base_dir_path) + except OSError as error: + if error.errno != errno.EEXIST: + msg = 'Could not create directory "{0}"'.format( + self._base_dir_path) + fatal_error(msg) + + if self._stat.source_type != ExternalStatus.STANDALONE: + if verbosity >= VERBOSITY_VERBOSE: + # NOTE(bja, 2018-01) probably do not want to pass + # verbosity in this case, because if (verbosity == + # VERBOSITY_DUMP), then the previous status output would + # also be dumped, adding noise to the output. + self._stat.log_status_message(VERBOSITY_VERBOSE) + + if self._repo: + if self._stat.sync_state == ExternalStatus.STATUS_OK: + # If we're already in sync, avoid showing verbose output + # from the checkout command, unless the verbosity level + # is 2 or more. + checkout_verbosity = verbosity - 1 + else: + checkout_verbosity = verbosity + + self._repo.checkout(self._base_dir_path, self._repo_dir_name, + checkout_verbosity, self.clone_recursive()) + + def checkout_externals(self, verbosity, load_all): + """Checkout the sub-externals for this object + """ + if self.load_externals(): + if self._externals_sourcetree: + # NOTE(bja, 2018-02): the subtree externals objects + # were created during initial status check. Updating + # the external may have changed which sub-externals + # are needed. We need to delete those objects and + # re-read the potentially modified externals + # description file. + self._externals_sourcetree = None + self._create_externals_sourcetree() + self._externals_sourcetree.checkout(verbosity, load_all) + + def load_externals(self): + 'Return True iff an externals file should be loaded' + load_ex = False + if os.path.exists(self._repo_dir_path): + if self._externals: + if self._externals.lower() != 'none': + load_ex = os.path.exists(os.path.join(self._repo_dir_path, + self._externals)) + + return load_ex + + def clone_recursive(self): + 'Return True iff any .gitmodules files should be processed' + # Try recursive unless there is an externals entry + recursive = not self._externals + + return recursive + + def _create_externals_sourcetree(self): + """ + """ + if not os.path.exists(self._repo_dir_path): + # NOTE(bja, 2017-10) repository has not been checked out + # yet, can't process the externals file. Assume we are + # checking status before code is checkoud out and this + # will be handled correctly later. + return + + cwd = os.getcwd() + os.chdir(self._repo_dir_path) + if self._externals.lower() == 'none': + msg = ('Internal: Attempt to create source tree for ' + 'externals = none in {}'.format(self._repo_dir_path)) + fatal_error(msg) + + if not os.path.exists(self._externals): + if GitRepository.has_submodules(): + self._externals = ExternalsDescription.GIT_SUBMODULES_FILENAME + + if not os.path.exists(self._externals): + # NOTE(bja, 2017-10) this check is redundent with the one + # in read_externals_description_file! + msg = ('External externals description file "{0}" ' + 'does not exist! In directory: {1}'.format( + self._externals, self._repo_dir_path)) + fatal_error(msg) + + externals_root = self._repo_dir_path + model_data = read_externals_description_file(externals_root, + self._externals) + externals = create_externals_description(model_data, + parent_repo=self._repo) + self._externals_sourcetree = SourceTree(externals_root, externals) + os.chdir(cwd) + +class SourceTree(object): + """ + SourceTree represents a group of managed externals + """ + + def __init__(self, root_dir, model, svn_ignore_ancestry=False): + """ + Build a SourceTree object from a model description + """ + self._root_dir = os.path.abspath(root_dir) + self._all_components = {} + self._required_compnames = [] + for comp in model: + src = _External(self._root_dir, comp, model[comp], svn_ignore_ancestry) + self._all_components[comp] = src + if model[comp][ExternalsDescription.REQUIRED]: + self._required_compnames.append(comp) + + def status(self, relative_path_base=LOCAL_PATH_INDICATOR): + """Report the status components + + FIXME(bja, 2017-10) what do we do about situations where the + user checked out the optional components, but didn't add + optional for running status? What do we do where the user + didn't add optional to the checkout but did add it to the + status. -- For now, we run status on all components, and try + to do the right thing based on the results.... + + """ + load_comps = self._all_components.keys() + + summary = {} + for comp in load_comps: + printlog('{0}, '.format(comp), end='') + stat = self._all_components[comp].status() + for name in stat.keys(): + # check if we need to append the relative_path_base to + # the path so it will be sorted in the correct order. + if not stat[name].path.startswith(relative_path_base): + stat[name].path = os.path.join(relative_path_base, + stat[name].path) + # store under key = updated path, and delete the + # old key. + comp_stat = stat[name] + del stat[name] + stat[comp_stat.path] = comp_stat + summary.update(stat) + + return summary + + def checkout(self, verbosity, load_all, load_comp=None): + """ + Checkout or update indicated components into the the configured + subdirs. + + If load_all is True, recursively checkout all externals. + If load_all is False, load_comp is an optional set of components to load. + If load_all is True and load_comp is None, only load the required externals. + """ + if verbosity >= VERBOSITY_VERBOSE: + printlog('Checking out externals: ') + else: + printlog('Checking out externals: ', end='') + + if load_all: + load_comps = self._all_components.keys() + elif load_comp is not None: + load_comps = [load_comp] + else: + load_comps = self._required_compnames + + # checkout the primary externals + for comp in load_comps: + if verbosity < VERBOSITY_VERBOSE: + printlog('{0}, '.format(comp), end='') + else: + # verbose output handled by the _External object, just + # output a newline + printlog(EMPTY_STR) + self._all_components[comp].checkout(verbosity, load_all) + printlog('') + + # now give each external an opportunitity to checkout it's externals. + for comp in load_comps: + self._all_components[comp].checkout_externals(verbosity, load_all) diff --git a/manage_externals/manic/utils.py b/manage_externals/manic/utils.py new file mode 100644 index 0000000000..f57f43930c --- /dev/null +++ b/manage_externals/manic/utils.py @@ -0,0 +1,330 @@ +#!/usr/bin/env python +""" +Common public utilities for manic package + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import logging +import os +import subprocess +import sys +from threading import Timer + +from .global_constants import LOCAL_PATH_INDICATOR + +# --------------------------------------------------------------------- +# +# screen and logging output and functions to massage text for output +# +# --------------------------------------------------------------------- + + +def log_process_output(output): + """Log each line of process output at debug level so it can be + filtered if necessary. By default, output is a single string, and + logging.debug(output) will only put log info heading on the first + line. This makes it hard to filter with grep. + + """ + output = output.split('\n') + for line in output: + logging.debug(line) + + +def printlog(msg, **kwargs): + """Wrapper script around print to ensure that everything printed to + the screen also gets logged. + + """ + logging.info(msg) + if kwargs: + print(msg, **kwargs) + else: + print(msg) + sys.stdout.flush() + + +def last_n_lines(the_string, n_lines, truncation_message=None): + """Returns the last n lines of the given string + + Args: + the_string: str + n_lines: int + truncation_message: str, optional + + Returns a string containing the last n lines of the_string + + If truncation_message is provided, the returned string begins with + the given message if and only if the string is greater than n lines + to begin with. + """ + + lines = the_string.splitlines(True) + if len(lines) <= n_lines: + return_val = the_string + else: + lines_subset = lines[-n_lines:] + str_truncated = ''.join(lines_subset) + if truncation_message: + str_truncated = truncation_message + '\n' + str_truncated + return_val = str_truncated + + return return_val + + +def indent_string(the_string, indent_level): + """Indents the given string by a given number of spaces + + Args: + the_string: str + indent_level: int + + Returns a new string that is the same as the_string, except that + each line is indented by 'indent_level' spaces. + + In python3, this can be done with textwrap.indent. + """ + + lines = the_string.splitlines(True) + padding = ' ' * indent_level + lines_indented = [padding + line for line in lines] + return ''.join(lines_indented) + +# --------------------------------------------------------------------- +# +# error handling +# +# --------------------------------------------------------------------- + + +def fatal_error(message): + """ + Error output function + """ + logging.error(message) + raise RuntimeError("{0}ERROR: {1}".format(os.linesep, message)) + + +# --------------------------------------------------------------------- +# +# Data conversion / manipulation +# +# --------------------------------------------------------------------- +def str_to_bool(bool_str): + """Convert a sting representation of as boolean into a true boolean. + + Conversion should be case insensitive. + """ + value = None + str_lower = bool_str.lower() + if str_lower in ('true', 't'): + value = True + elif str_lower in ('false', 'f'): + value = False + if value is None: + msg = ('ERROR: invalid boolean string value "{0}". ' + 'Must be "true" or "false"'.format(bool_str)) + fatal_error(msg) + return value + + +REMOTE_PREFIXES = ['http://', 'https://', 'ssh://', 'git@'] + + +def is_remote_url(url): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + """ + remote_url = False + for prefix in REMOTE_PREFIXES: + if url.startswith(prefix): + remote_url = True + return remote_url + + +def split_remote_url(url): + """check if the user provided a local file path or a + remote. If remote, try to strip off protocol info. + + """ + remote_url = is_remote_url(url) + if not remote_url: + return url + + for prefix in REMOTE_PREFIXES: + url = url.replace(prefix, '') + + if '@' in url: + url = url.split('@')[1] + + if ':' in url: + url = url.split(':')[1] + + return url + + +def expand_local_url(url, field): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + Note: local paths of LOCAL_PATH_INDICATOR have special meaning and + represent local copy only, don't work with the remotes. + + """ + remote_url = is_remote_url(url) + if not remote_url: + if url.strip() == LOCAL_PATH_INDICATOR: + pass + else: + url = os.path.expandvars(url) + url = os.path.expanduser(url) + if not os.path.isabs(url): + msg = ('WARNING: Externals description for "{0}" contains a ' + 'url that is not remote and does not expand to an ' + 'absolute path. Version control operations may ' + 'fail.\n\nurl={1}'.format(field, url)) + printlog(msg) + else: + url = os.path.normpath(url) + return url + + +# --------------------------------------------------------------------- +# +# subprocess +# +# --------------------------------------------------------------------- + +# Give the user a helpful message if we detect that a command seems to +# be hanging. +_HANGING_SEC = 300 + + +def _hanging_msg(working_directory, command): + print(""" + +Command '{command}' +from directory {working_directory} +has taken {hanging_sec} seconds. It may be hanging. + +The command will continue to run, but you may want to abort +manage_externals with ^C and investigate. A possible cause of hangs is +when svn or git require authentication to access a private +repository. On some systems, svn and git requests for authentication +information will not be displayed to the user. In this case, the program +will appear to hang. Ensure you can run svn and git manually and access +all repositories without entering your authentication information. + +""".format(command=command, + working_directory=working_directory, + hanging_sec=_HANGING_SEC)) + + +def execute_subprocess(commands, status_to_caller=False, + output_to_caller=False): + """Wrapper around subprocess.check_output to handle common + exceptions. + + check_output runs a command with arguments and waits + for it to complete. + + check_output raises an exception on a nonzero return code. if + status_to_caller is true, execute_subprocess returns the subprocess + return code, otherwise execute_subprocess treats non-zero return + status as an error and raises an exception. + + """ + cwd = os.getcwd() + msg = 'In directory: {0}\nexecute_subprocess running command:'.format(cwd) + logging.info(msg) + commands_str = ' '.join(commands) + logging.info(commands_str) + return_to_caller = status_to_caller or output_to_caller + status = -1 + output = '' + hanging_timer = Timer(_HANGING_SEC, _hanging_msg, + kwargs={"working_directory": cwd, + "command": commands_str}) + hanging_timer.start() + try: + output = subprocess.check_output(commands, stderr=subprocess.STDOUT, + universal_newlines=True) + log_process_output(output) + status = 0 + except OSError as error: + msg = failed_command_msg( + 'Command execution failed. Does the executable exist?', + commands) + logging.error(error) + fatal_error(msg) + except ValueError as error: + msg = failed_command_msg( + 'DEV_ERROR: Invalid arguments trying to run subprocess', + commands) + logging.error(error) + fatal_error(msg) + except subprocess.CalledProcessError as error: + # Only report the error if we are NOT returning to the + # caller. If we are returning to the caller, then it may be a + # simple status check. If returning, it is the callers + # responsibility determine if an error occurred and handle it + # appropriately. + if not return_to_caller: + msg_context = ('Process did not run successfully; ' + 'returned status {0}'.format(error.returncode)) + msg = failed_command_msg(msg_context, commands, + output=error.output) + logging.error(error) + logging.error(msg) + log_process_output(error.output) + fatal_error(msg) + status = error.returncode + finally: + hanging_timer.cancel() + + if status_to_caller and output_to_caller: + ret_value = (status, output) + elif status_to_caller: + ret_value = status + elif output_to_caller: + ret_value = output + else: + ret_value = None + + return ret_value + + +def failed_command_msg(msg_context, command, output=None): + """Template for consistent error messages from subprocess calls. + + If 'output' is given, it should provide the output from the failed + command + """ + + if output: + output_truncated = last_n_lines(output, 20, + truncation_message='[... Output truncated for brevity ...]') + errmsg = ('Failed with output:\n' + + indent_string(output_truncated, 4) + + '\nERROR: ') + else: + errmsg = '' + + command_str = ' '.join(command) + errmsg += """In directory + {cwd} +{context}: + {command} +""".format(cwd=os.getcwd(), context=msg_context, command=command_str) + + if output: + errmsg += 'See above for output from failed command.\n' + + return errmsg diff --git a/manage_externals/test/.coveragerc b/manage_externals/test/.coveragerc new file mode 100644 index 0000000000..8b681888b8 --- /dev/null +++ b/manage_externals/test/.coveragerc @@ -0,0 +1,7 @@ +[run] +branch = True +omit = test_unit_*.py + test_sys_*.py + /usr/* + .local/* + */site-packages/* \ No newline at end of file diff --git a/manage_externals/test/.gitignore b/manage_externals/test/.gitignore new file mode 100644 index 0000000000..dd5795998f --- /dev/null +++ b/manage_externals/test/.gitignore @@ -0,0 +1,7 @@ +# virtual environments +env_python* + +# python code coverage tool output +.coverage +htmlcov + diff --git a/manage_externals/test/.pylint.rc b/manage_externals/test/.pylint.rc new file mode 100644 index 0000000000..64abd03e42 --- /dev/null +++ b/manage_externals/test/.pylint.rc @@ -0,0 +1,426 @@ +[MASTER] + +# A comma-separated list of package or module names from where C extensions may +# be loaded. Extensions are loading into the active Python interpreter and may +# run arbitrary code +extension-pkg-whitelist= + +# Add files or directories to the blacklist. They should be base names, not +# paths. +ignore=.git,.svn,env2 + +# Add files or directories matching the regex patterns to the blacklist. The +# regex matches against base names, not paths. +ignore-patterns= + +# Python code to execute, usually for sys.path manipulation such as +# pygtk.require(). +#init-hook= + +# Use multiple processes to speed up Pylint. +jobs=1 + +# List of plugins (as comma separated values of python modules names) to load, +# usually to register additional checkers. +load-plugins= + +# Pickle collected data for later comparisons. +persistent=yes + +# Specify a configuration file. +#rcfile= + +# Allow loading of arbitrary C extensions. Extensions are imported into the +# active Python interpreter and may run arbitrary code. +unsafe-load-any-extension=no + + +[MESSAGES CONTROL] + +# Only show warnings with the listed confidence levels. Leave empty to show +# all. Valid levels: HIGH, INFERENCE, INFERENCE_FAILURE, UNDEFINED +confidence= + +# Disable the message, report, category or checker with the given id(s). You +# can either give multiple identifiers separated by comma (,) or put this +# option multiple times (only on the command line, not in the configuration +# file where it should appear only once).You can also use "--disable=all" to +# disable everything first and then reenable specific checks. For example, if +# you want to run only the similarities checker, you can use "--disable=all +# --enable=similarities". If you want to run only the classes checker, but have +# no Warning level messages displayed, use"--disable=all --enable=classes +# --disable=W" +disable=bad-continuation,useless-object-inheritance + + +# Enable the message, report, category or checker with the given id(s). You can +# either give multiple identifier separated by comma (,) or put this option +# multiple time (only on the command line, not in the configuration file where +# it should appear only once). See also the "--disable" option for examples. +enable= + + +[REPORTS] + +# Python expression which should return a note less than 10 (10 is the highest +# note). You have access to the variables errors warning, statement which +# respectively contain the number of errors / warnings messages and the total +# number of statements analyzed. This is used by the global evaluation report +# (RP0004). +evaluation=10.0 - ((float(5 * error + warning + refactor + convention) / statement) * 10) + +# Template used to display messages. This is a python new-style format string +# used to format the message information. See doc for all details +msg-template={msg_id}:{line:3d},{column:2d}: {msg} ({symbol}) + +# Set the output format. Available formats are text, parseable, colorized, json +# and msvs (visual studio).You can also give a reporter class, eg +# mypackage.mymodule.MyReporterClass. +output-format=text + +# Tells whether to display a full report or only the messages +#reports=yes + +# Activate the evaluation score. +score=yes + + +[REFACTORING] + +# Maximum number of nested blocks for function / method body +max-nested-blocks=5 + + +[BASIC] + +# Naming hint for argument names +argument-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Regular expression matching correct argument names +argument-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Naming hint for attribute names +attr-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Regular expression matching correct attribute names +attr-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Bad variable names which should always be refused, separated by a comma +bad-names=foo,bar,baz,toto,tutu,tata + +# Naming hint for class attribute names +class-attribute-name-hint=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ + +# Regular expression matching correct class attribute names +class-attribute-rgx=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ + +# Naming hint for class names +class-name-hint=[A-Z_][a-zA-Z0-9]+$ + +# Regular expression matching correct class names +class-rgx=[A-Z_][a-zA-Z0-9]+$ + +# Naming hint for constant names +const-name-hint=(([A-Z_][A-Z0-9_]*)|(__.*__))$ + +# Regular expression matching correct constant names +const-rgx=(([A-Z_][A-Z0-9_]*)|(__.*__))$ + +# Minimum line length for functions/classes that require docstrings, shorter +# ones are exempt. +docstring-min-length=-1 + +# Naming hint for function names +function-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Regular expression matching correct function names +function-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Good variable names which should always be accepted, separated by a comma +good-names=i,j,k,ex,Run,_ + +# Include a hint for the correct naming format with invalid-name +include-naming-hint=no + +# Naming hint for inline iteration names +inlinevar-name-hint=[A-Za-z_][A-Za-z0-9_]*$ + +# Regular expression matching correct inline iteration names +inlinevar-rgx=[A-Za-z_][A-Za-z0-9_]*$ + +# Naming hint for method names +method-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Regular expression matching correct method names +method-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Naming hint for module names +module-name-hint=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ + +# Regular expression matching correct module names +module-rgx=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ + +# Colon-delimited sets of names that determine each other's naming style when +# the name regexes allow several styles. +name-group= + +# Regular expression which should only match function or class names that do +# not require a docstring. +no-docstring-rgx=^_ + +# List of decorators that produce properties, such as abc.abstractproperty. Add +# to this list to register other decorators that produce valid properties. +property-classes=abc.abstractproperty + +# Naming hint for variable names +variable-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + +# Regular expression matching correct variable names +variable-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ + + +[FORMAT] + +# Expected format of line ending, e.g. empty (any line ending), LF or CRLF. +expected-line-ending-format= + +# Regexp for a line that is allowed to be longer than the limit. +ignore-long-lines=^\s*(# )??$ + +# Number of spaces of indent required inside a hanging or continued line. +indent-after-paren=4 + +# String used as indentation unit. This is usually " " (4 spaces) or "\t" (1 +# tab). +indent-string=' ' + +# Maximum number of characters on a single line. +max-line-length=100 + +# Maximum number of lines in a module +max-module-lines=1000 + +# List of optional constructs for which whitespace checking is disabled. `dict- +# separator` is used to allow tabulation in dicts, etc.: {1 : 1,\n222: 2}. +# `trailing-comma` allows a space between comma and closing bracket: (a, ). +# `empty-line` allows space-only lines. +no-space-check=trailing-comma,dict-separator + +# Allow the body of a class to be on the same line as the declaration if body +# contains single statement. +single-line-class-stmt=no + +# Allow the body of an if to be on the same line as the test if there is no +# else. +single-line-if-stmt=no + + +[LOGGING] + +# Logging modules to check that the string format arguments are in logging +# function parameter format +logging-modules=logging + + +[MISCELLANEOUS] + +# List of note tags to take in consideration, separated by a comma. +notes=FIXME,XXX,TODO + + +[SIMILARITIES] + +# Ignore comments when computing similarities. +ignore-comments=yes + +# Ignore docstrings when computing similarities. +ignore-docstrings=yes + +# Ignore imports when computing similarities. +ignore-imports=no + +# Minimum lines number of a similarity. +min-similarity-lines=4 + + +[SPELLING] + +# Spelling dictionary name. Available dictionaries: none. To make it working +# install python-enchant package. +spelling-dict= + +# List of comma separated words that should not be checked. +spelling-ignore-words= + +# A path to a file that contains private dictionary; one word per line. +spelling-private-dict-file= + +# Tells whether to store unknown words to indicated private dictionary in +# --spelling-private-dict-file option instead of raising a message. +spelling-store-unknown-words=no + + +[TYPECHECK] + +# List of decorators that produce context managers, such as +# contextlib.contextmanager. Add to this list to register other decorators that +# produce valid context managers. +contextmanager-decorators=contextlib.contextmanager + +# List of members which are set dynamically and missed by pylint inference +# system, and so shouldn't trigger E1101 when accessed. Python regular +# expressions are accepted. +generated-members= + +# Tells whether missing members accessed in mixin class should be ignored. A +# mixin class is detected if its name ends with "mixin" (case insensitive). +ignore-mixin-members=yes + +# This flag controls whether pylint should warn about no-member and similar +# checks whenever an opaque object is returned when inferring. The inference +# can return multiple potential results while evaluating a Python object, but +# some branches might not be evaluated, which results in partial inference. In +# that case, it might be useful to still emit no-member and other checks for +# the rest of the inferred objects. +ignore-on-opaque-inference=yes + +# List of class names for which member attributes should not be checked (useful +# for classes with dynamically set attributes). This supports the use of +# qualified names. +ignored-classes=optparse.Values,thread._local,_thread._local + +# List of module names for which member attributes should not be checked +# (useful for modules/projects where namespaces are manipulated during runtime +# and thus existing member attributes cannot be deduced by static analysis. It +# supports qualified module names, as well as Unix pattern matching. +ignored-modules= + +# Show a hint with possible names when a member name was not found. The aspect +# of finding the hint is based on edit distance. +missing-member-hint=yes + +# The minimum edit distance a name should have in order to be considered a +# similar match for a missing member name. +missing-member-hint-distance=1 + +# The total number of similar names that should be taken in consideration when +# showing a hint for a missing member. +missing-member-max-choices=1 + + +[VARIABLES] + +# List of additional names supposed to be defined in builtins. Remember that +# you should avoid to define new builtins when possible. +additional-builtins= + +# Tells whether unused global variables should be treated as a violation. +allow-global-unused-variables=yes + +# List of strings which can identify a callback function by name. A callback +# name must start or end with one of those strings. +callbacks=cb_,_cb + +# A regular expression matching the name of dummy variables (i.e. expectedly +# not used). +dummy-variables-rgx=_+$|(_[a-zA-Z0-9_]*[a-zA-Z0-9]+?$)|dummy|^ignored_|^unused_ + +# Argument names that match this expression will be ignored. Default to name +# with leading underscore +ignored-argument-names=_.*|^ignored_|^unused_ + +# Tells whether we should check for unused import in __init__ files. +init-import=no + +# List of qualified module names which can have objects that can redefine +# builtins. +redefining-builtins-modules=six.moves,future.builtins + + +[CLASSES] + +# List of method names used to declare (i.e. assign) instance attributes. +defining-attr-methods=__init__,__new__,setUp + +# List of member names, which should be excluded from the protected access +# warning. +exclude-protected=_asdict,_fields,_replace,_source,_make + +# List of valid names for the first argument in a class method. +valid-classmethod-first-arg=cls + +# List of valid names for the first argument in a metaclass class method. +valid-metaclass-classmethod-first-arg=mcs + + +[DESIGN] + +# Maximum number of arguments for function / method +max-args=5 + +# Maximum number of attributes for a class (see R0902). +max-attributes=7 + +# Maximum number of boolean expressions in a if statement +max-bool-expr=5 + +# Maximum number of branch for function / method body +max-branches=12 + +# Maximum number of locals for function / method body +max-locals=15 + +# Maximum number of parents for a class (see R0901). +max-parents=7 + +# Maximum number of public methods for a class (see R0904). +max-public-methods=20 + +# Maximum number of return / yield for function / method body +max-returns=6 + +# Maximum number of statements in function / method body +max-statements=50 + +# Minimum number of public methods for a class (see R0903). +min-public-methods=2 + + +[IMPORTS] + +# Allow wildcard imports from modules that define __all__. +allow-wildcard-with-all=no + +# Analyse import fallback blocks. This can be used to support both Python 2 and +# 3 compatible code, which means that the block might have code that exists +# only in one or another interpreter, leading to false positives when analysed. +analyse-fallback-blocks=no + +# Deprecated modules which should not be used, separated by a comma +deprecated-modules=regsub,TERMIOS,Bastion,rexec + +# Create a graph of external dependencies in the given file (report RP0402 must +# not be disabled) +ext-import-graph= + +# Create a graph of every (i.e. internal and external) dependencies in the +# given file (report RP0402 must not be disabled) +import-graph= + +# Create a graph of internal dependencies in the given file (report RP0402 must +# not be disabled) +int-import-graph= + +# Force import order to recognize a module as part of the standard +# compatibility libraries. +known-standard-library= + +# Force import order to recognize a module as part of a third party library. +known-third-party=enchant + + +[EXCEPTIONS] + +# Exceptions that will emit a warning when being caught. Defaults to +# "Exception" +overgeneral-exceptions=Exception diff --git a/manage_externals/test/Makefile b/manage_externals/test/Makefile new file mode 100644 index 0000000000..293e360757 --- /dev/null +++ b/manage_externals/test/Makefile @@ -0,0 +1,124 @@ +python = not-set +verbose = not-set +debug = not-set + +ifneq ($(python), not-set) +PYTHON=$(python) +else +PYTHON=python +endif + +# we need the python path to point one level up to access the package +# and executables +PYPATH=PYTHONPATH=..: + +# common args for running tests +TEST_ARGS=-m unittest discover + +ifeq ($(debug), not-set) + ifeq ($(verbose), not-set) + # summary only output + TEST_ARGS+=--buffer + else + # show individual test summary + TEST_ARGS+=--buffer --verbose + endif +else + # show detailed test output + TEST_ARGS+=--verbose +endif + + +# auto reformat the code +AUTOPEP8=autopep8 +AUTOPEP8_ARGS=--aggressive --in-place + +# run lint +PYLINT=pylint +PYLINT_ARGS=-j 2 --rcfile=.pylint.rc + +# code coverage +COVERAGE=coverage +COVERAGE_ARGS=--rcfile=.coveragerc + +# source files +SRC = \ + ../checkout_externals \ + ../manic/*.py + +CHECKOUT_EXE = ../checkout_externals + +TEST_DIR = . + +README = ../README.md + +# +# testing +# +.PHONY : utest +utest : FORCE + $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_unit_*.py' + +.PHONY : stest +stest : FORCE + $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_sys_*.py' + +.PHONY : test +test : utest stest + +# +# documentation +# +.PHONY : readme +readme : $(CHECKOUT_EXE) + printf "%s\n\n" "-- AUTOMATICALLY GENERATED FILE. DO NOT EDIT --" > $(README) + printf "%s" '[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)' >> $(README) + printf "%s" '[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master)' >> $(README) + printf "\n%s\n" '```' >> $(README) + $(CHECKOUT_EXE) --help >> $(README) + +# +# coding standards +# +.PHONY : style +style : FORCE + $(AUTOPEP8) $(AUTOPEP8_ARGS) --recursive $(SRC) $(TEST_DIR)/test_*.py + +.PHONY : lint +lint : FORCE + $(PYLINT) $(PYLINT_ARGS) $(SRC) $(TEST_DIR)/test_*.py + +.PHONY : stylint +stylint : style lint + +.PHONY : coverage +# Need to use a single coverage run with a single pattern rather than +# using two separate commands with separate patterns for test_unit_*.py +# and test_sys_*.py: The latter clobbers some results from the first +# run, even if we use the --append flag to 'coverage run'. +coverage : FORCE + $(PYPATH) $(COVERAGE) erase + $(PYPATH) $(COVERAGE) run $(COVERAGE_ARGS) $(TEST_ARGS) --pattern 'test_*.py' + $(PYPATH) $(COVERAGE) html + +# +# virtual environment creation +# +.PHONY : env +env : FORCE + $(PYPATH) virtualenv --python $(PYTHON) $@_$(PYTHON) + . $@_$(PYTHON)/bin/activate; pip install -r requirements.txt + +# +# utilites +# +.PHONY : clean +clean : FORCE + -rm -rf *~ *.pyc tmp fake htmlcov + +.PHONY : clobber +clobber : clean + -rm -rf env_* + +FORCE : + diff --git a/manage_externals/test/README.md b/manage_externals/test/README.md new file mode 100644 index 0000000000..938a900eec --- /dev/null +++ b/manage_externals/test/README.md @@ -0,0 +1,77 @@ +# Testing for checkout_externals + +NOTE: Python2 is the supported runtime environment. Python3 compatibility is +in progress, complicated by the different proposed input methods +(yaml, xml, cfg/ini, json) and their different handling of strings +(unicode vs byte) in python2. Full python3 compatibility will be +possible once the number of possible input formats has been narrowed. + +## Setup development environment + +Development environments should be setup for python2 and python3: + +```SH + cd checkout_externals/test + make python=python2 env + make python=python3 env +``` + +## Unit tests + +Tests should be run for both python2 and python3. It is recommended +that you have seperate terminal windows open python2 and python3 +testing to avoid errors activating and deactivating environments. + +```SH + cd checkout_externals/test + . env_python2/bin/activate + make utest + deactivate +``` + +```SH + cd checkout_externals/test + . env_python2/bin/activate + make utest + deactivate +``` + +## System tests + +Not yet implemented. + +## Static analysis + +checkout_externals is difficult to test thoroughly because it relies +on git and svn, and svn requires a live network connection and +repository. Static analysis will help catch bugs in code paths that +are not being executed, but it requires conforming to community +standards and best practices. autopep8 and pylint should be run +regularly for automatic code formatting and linting. + +```SH + cd checkout_externals/test + . env_python2/bin/activate + make lint + deactivate +``` + +The canonical formatting for the code is whatever autopep8 +generates. All issues identified by pylint should be addressed. + + +## Code coverage + +All changes to the code should include maintaining existing tests and +writing new tests for new or changed functionality. To ensure test +coverage, run the code coverage tool: + +```SH + cd checkout_externals/test + . env_python2/bin/activate + make coverage + open -a Firefox.app htmlcov/index.html + deactivate +``` + + diff --git a/manage_externals/test/doc/.gitignore b/manage_externals/test/doc/.gitignore new file mode 100644 index 0000000000..d4e11e5ea0 --- /dev/null +++ b/manage_externals/test/doc/.gitignore @@ -0,0 +1,2 @@ +_build + diff --git a/manage_externals/test/doc/Makefile b/manage_externals/test/doc/Makefile new file mode 100644 index 0000000000..18f4d5bf99 --- /dev/null +++ b/manage_externals/test/doc/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line. +SPHINXOPTS = +SPHINXBUILD = sphinx-build +SPHINXPROJ = ManageExternals +SOURCEDIR = . +BUILDDIR = _build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file diff --git a/manage_externals/test/doc/conf.py b/manage_externals/test/doc/conf.py new file mode 100644 index 0000000000..469c0b0dc5 --- /dev/null +++ b/manage_externals/test/doc/conf.py @@ -0,0 +1,172 @@ +# -*- coding: utf-8 -*- +# +# Manage Externals documentation build configuration file, created by +# sphinx-quickstart on Wed Nov 29 10:53:25 2017. +# +# This file is execfile()d with the current directory set to its +# containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +# import os +# import sys +# sys.path.insert(0, os.path.abspath('.')) + + +# -- General configuration ------------------------------------------------ + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = ['sphinx.ext.autodoc', + 'sphinx.ext.todo', + 'sphinx.ext.coverage', + 'sphinx.ext.viewcode', + 'sphinx.ext.githubpages'] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = u'Manage Externals' +copyright = u'2017, CSEG at NCAR' +author = u'CSEG at NCAR' + +# The version info for the project you're documenting, acts as replacement for +# |version| and |release|, also used in various other places throughout the +# built documents. +# +# The short X.Y version. +version = u'1.0.0' +# The full version, including alpha/beta/rc tags. +release = u'1.0.0' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This patterns also effect to html_static_path and html_extra_path +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + +# If true, `todo` and `todoList` produce output, else they produce nothing. +todo_include_todos = True + + +# -- Options for HTML output ---------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'alabaster' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +# html_theme_options = {} + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# This is required for the alabaster theme +# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars +html_sidebars = { + '**': [ + 'relations.html', # needs 'show_related': True theme option to display + 'searchbox.html', + ] +} + + +# -- Options for HTMLHelp output ------------------------------------------ + +# Output file base name for HTML help builder. +htmlhelp_basename = 'ManageExternalsdoc' + + +# -- Options for LaTeX output --------------------------------------------- + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'ManageExternals.tex', u'Manage Externals Documentation', + u'CSEG at NCAR', 'manual'), +] + + +# -- Options for manual page output --------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'manageexternals', u'Manage Externals Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'ManageExternals', u'Manage Externals Documentation', + author, 'ManageExternals', 'One line description of project.', + 'Miscellaneous'), +] + + + diff --git a/manage_externals/test/doc/develop.rst b/manage_externals/test/doc/develop.rst new file mode 100644 index 0000000000..b817b7b093 --- /dev/null +++ b/manage_externals/test/doc/develop.rst @@ -0,0 +1,202 @@ +Developer Guidelines +==================== + +The manage externals utilities are a light weight replacement for svn +externals that will work with git repositories pulling in a mixture of +git and svn dependencies. + +Given an externals description and a working copy: + +* *checkout_externals* attempts to make the working copy agree with the + externals description + +* *generate_externals* attempts to make the externals description agree + with the working copy. + +For these operations utilities should: + +* operate consistently across git and svn + +* operate simply with minimal user complexity + +* robustly across a wide range of repository states + +* provide explicit error messages when a problem occurs + +* leave the working copy in a valid state + +The utilities in manage externals are **NOT** generic wrappers around +revision control operations or a replacement for common tasks. Users +are expected to: + +* create branches prior to starting development + +* add remotes and push changes + +* create tags + +* delete branches + +These types of tasks are often highly workflow dependent, e.g. branch +naming conventions may vary between repositories, have the potential +to destroy user data, introduce significant code complexit and 'edge +cases' that are extremely difficult to detect and test, and often +require subtle decision making, especially if a problem occurs. + +Users who want to automate these types are encouraged to create their +own tools. The externals description files are explicitly versioned +and the internal APIs are intended to be stable for these purposes. + +Core Design Principles +----------------------- + +1. Users can, and are actively encouraged to, modify the externals + directories using revision control outside of manage_externals + tools. You can't make any assumptions about the state of the + working copy. Examples: adding a remote, creating a branch, + switching to a branch, deleting the directory entirely. + +2. Give that the user can do anything, the manage externals library + can not preserve state between calls. The only information it can + rely on is what it expectes based on the content of the externals + description file, and what the actual state of the directory tree + is. + +3. Do *not* do anything that will possibly destroy user data! + + a. Do not remove files from the file system. We are operating on + user supplied input. If you don't call 'rm', you can't + accidentally remove the user's data. Thinking of calling + ``shutil.rmtree(user_input)``? What if the user accidentally + specified user_input such that it resolves to their home + directory.... Yeah. Don't go there. + + b. Rely on git and svn to do their job as much as possible. Don't + duplicate functionality. Examples: + + i. We require the working copies to be 'clean' as reported by + ``git status`` and ``svn status``. What if there are misc + editor files floating around that prevent an update? Use the + git and svn ignore functionality so they are not + reported. Don't try to remove them from manage_externals or + determine if they are 'safe' to ignore. + + ii. Do not use '--force'. Ever. This is a sign you are doing + something dangerous, it may not be what the user + wants. Remember, they are encouraged to modify their repo. + +4. There are often multiple ways to obtain a particular piece of + information from git. Scraping screen output is brittle and + generally not considered a stable API across different versions of + git. Given a choice between: + + a. a lower level git 'plumbing' command that processes a + specific request and returns a sucess/failure status. + + b. high level git command that produces a bunch of output + that must be processed. + + We always prefer the former. It almost always involves + writing and maintaining less code and is more likely to be + stable. + +5. Backward compatibility is critical. We have *nested* + repositories. They are trivially easy to change versions. They may + have very different versions of the top level manage_externals. The + ability to read and work with old model description files is + critical to avoid problems for users. We also have automated tools + (testdb) that must generate and read external description + files. Backward compatibility will make staging changes vastly + simpler. + +Model Users +----------- + +Consider the needs of the following model userswhen developing manage_externals: + +* Users who will checkout the code once, and never change versions. + +* Users who will checkout the code once, then work for several years, + never updating. before trying to update or request integration. + +* Users develope code but do not use revision control beyond the + initial checkout. If they have modified or untracked files in the + repo, they may be irreplacable. Don't destroy user data. + +* Intermediate users who are working with multiple repos or branches + on a regular basis. They may only use manage_externals weekly or + monthly. Keep the user interface and documentation simple and + explicit. The more command line options they have to remember or + look up, the more frustrated they git. + +* Software engineers who use the tools multiple times a day. It should + get out of their way. + +User Interface +-------------- + +Basic operation for the most standard use cases should be kept as +simple as possible. Many users will only rarely run the manage +utilities. Even advanced users don't like reading a lot of help +documentation or struggling to remember commands and piece together +what they need to run. Having many command line options, even if not +needed, is exteremly frustrating and overwhelming for most users. A few +simple, explicitly named commands are better than a single command +with many options. + +How will users get help if something goes wrong? This is a custom, +one-off solution. Searching the internet for manage_externals, will +only return the user doc for this project at best. There isn't likely +to be a stackoverflow question or blog post where someone else already +answered a user's question. And very few people outside this community +will be able to provide help if something goes wrong. The sooner we +kick users out of these utilities and into standard version control +tools, the better off they are going to be if they run into a problem. + +Repositories +------------ + +There are three basic types of repositories that must be considered: + +* container repositories - repositories that are always top level + repositories, and have a group of externals that must be managed. + +* simple repositories - repositories that are externals to another + repository, and do not have any of their own externals that will be + managed. + +* mixed use repositories - repositories that can act as a top level + container repository or as an external to a top level + container. They may also have their own sub-externals that are + required. They may have different externals needs depening on + whether they are top level or not. + +Repositories must be able to checkout and switch to both branches and +tags. + +Development +=========== + +The functionality to manage externals is broken into a library of core +functionality and applications built with the library. + +The core library is called 'manic', pseduo-homophone of (man)age +(ex)ternals that is: short, pronounceable and spell-checkable. It is +also no more or less meaningful to an unfamiliar user than a random +jumble of letters forming an acronym. + +The core architecture of manic is: + +* externals description - an abstract description on an external, + including of how to obtain it, where to obtain it, where it goes in + the working tree. + +* externals - the software object representing an external. + +* source trees - collection of externals + +* repository wrappers - object oriented wrappers around repository + operations. So the higher level management of the soure tree and + external does not have to be concerned with how a particular + external is obtained and managed. + diff --git a/manage_externals/test/doc/index.rst b/manage_externals/test/doc/index.rst new file mode 100644 index 0000000000..9ab287ad8c --- /dev/null +++ b/manage_externals/test/doc/index.rst @@ -0,0 +1,22 @@ +.. Manage Externals documentation master file, created by + sphinx-quickstart on Wed Nov 29 10:53:25 2017. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +Welcome to Manage Externals's documentation! +============================================ + +.. toctree:: + :maxdepth: 2 + :caption: Contents: + + + develop.rst + testing.rst + +Indices and tables +================== + +* :ref:`genindex` +* :ref:`modindex` +* :ref:`search` diff --git a/manage_externals/test/doc/testing.rst b/manage_externals/test/doc/testing.rst new file mode 100644 index 0000000000..623f0e431c --- /dev/null +++ b/manage_externals/test/doc/testing.rst @@ -0,0 +1,123 @@ +Testing +======= + +The manage_externals package has an automated test suite. All pull +requests are expected to pass 100% of the automated tests, as well as +be pep8 and lint 'clean' and maintain approximately constant (at a +minimum) level of code coverage. + +Quick Start +----------- + +Do nothing approach +~~~~~~~~~~~~~~~~~~~ + +When you create a pull request on GitHub, Travis-CI continuous +integration testing will run the test suite in both python2 and +python3. Test results, lint results, and code coverage results are +available online. + +Do something approach +~~~~~~~~~~~~~~~~~~~~~ + +In the test directory, run: + +.. code-block:: shell + + make env + make lint + make test + make coverage + + +Automated Testing +----------------- + +The manage_externals manic library and executables are developed to be +python2 and python3 compatible using only the standard library. The +test suites meet the same requirements. But additional tools are +required to provide lint and code coverage metrics and generate +documentation. The requirements are maintained in the requirements.txt +file, and can be automatically installed into an isolated environment +via Makefile. + +Bootstrap requirements: + +* python2 - version 2.7.x or later + +* python3 - version 3.6 tested other versions may work + +* pip and virtualenv for python2 and python3 + +Note: all make rules can be of the form ``make python=pythonX rule`` +or ``make rule`` depending if you want to use the default system +python or specify a specific version. + +The Makefile in the test directory has the following rules: + +* ``make python=pythonX env`` - create a python virtual environment + for python2 or python3 and install all required packages. These + packages are required to run lint or coverage. + +* ``make style`` - runs autopep8 + +* ``make lint`` - runs autopep8 and pylint + +* ``make test`` - run the full test suite + +* ``make utest`` - run jus the unit tests + +* ``make stest`` - run jus the system integration tests + +* ``make coverage`` - run the full test suite through the code + coverage tool and generate an html report. + +* ``make readme`` - automatically generate the README files. + +* ``make clean`` - remove editor and pyc files + +* ``make clobber`` - remove all generated test files, including + virtual environments, coverage reports, and temporary test + repository directories. + +Unit Tests +---------- + +Unit tests are probably not 'true unit tests' for the pedantic, but +are pragmatic unit tests. They cover small practicle code blocks: +functions, class methods, and groups of functions and class methods. + +System Integration Tests +------------------------ + +NOTE(bja, 2017-11) The systems integration tests currently do not include svn repositories. + +The manage_externals package is extremely tedious and error prone to test manually. + +Combinations that must be tested to ensure basic functionality are: + +* container repository pulling in simple externals + +* container repository pulling in mixed externals with sub-externals. + +* mixed repository acting as a container, pulling in simple externals and sub-externals + +Automatic system tests are handled the same way manual testing is done: + +* clone a test repository + +* create an externals description file for the test + +* run the executable with the desired args + +* check the results + +* potentially modify the repo (checkout a different branch) + +* rerun and test + +* etc + +The automated system stores small test repositories in the main repo +by adding them as bare repositories. These repos are cloned via a +subprocess call to git and manipulated during the tests. diff --git a/manage_externals/test/repos/container.git/HEAD b/manage_externals/test/repos/container.git/HEAD new file mode 100644 index 0000000000..cb089cd89a --- /dev/null +++ b/manage_externals/test/repos/container.git/HEAD @@ -0,0 +1 @@ +ref: refs/heads/master diff --git a/manage_externals/test/repos/container.git/config b/manage_externals/test/repos/container.git/config new file mode 100644 index 0000000000..e6da231579 --- /dev/null +++ b/manage_externals/test/repos/container.git/config @@ -0,0 +1,6 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = true + ignorecase = true + precomposeunicode = true diff --git a/manage_externals/test/repos/container.git/description b/manage_externals/test/repos/container.git/description new file mode 100644 index 0000000000..498b267a8c --- /dev/null +++ b/manage_externals/test/repos/container.git/description @@ -0,0 +1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/container.git/info/exclude b/manage_externals/test/repos/container.git/info/exclude new file mode 100644 index 0000000000..a5196d1be8 --- /dev/null +++ b/manage_externals/test/repos/container.git/info/exclude @@ -0,0 +1,6 @@ +# git ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ diff --git a/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 new file mode 100644 index 0000000000000000000000000000000000000000..f65234e17f32800b1be0aa9908cc706458b14605 GIT binary patch literal 133 zcmV;00DAv;0acB$4#OY}L_6~pma=t7)Fr=DfpLNr2P1F?mVSF_r3_t8x_fuJAR6GY zuD1yyS3=Xu)WDKA@Ra});Xx7fWf1zv2~1TS@=422pQw4`eHcB9X3EwU=O)-GQ}s5s nqUZ%S7HaN3i|$`ck;m7Sz6S{Y_}`UoN%K{iOGozsJ+C?sZtFeC literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de b/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de new file mode 100644 index 0000000000000000000000000000000000000000..9759965b1ba440f1899216c1c82c0780fb65f46e GIT binary patch literal 136 zcmV;30C)d*0hNtQ3c@fDKwak)a{8g?ULFizQ5yOj!O$#BY{3QX>9e{j4e8<)

AV=y!@Ff%bx&`ZxO$xP47FG^)_lzn~QNUpn5)Pnq=ii~6DWK2pp8O#dS+Wke_L literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 b/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 new file mode 100644 index 0000000000000000000000000000000000000000..460fd7781917e095c826e8bc77ad53d943f199aa GIT binary patch literal 81 zcmV-X0IvUd0R_Ry4S+BV1VG+Yu@&$_q5vvMU;#^(9XS?9_smrFie(;Fw=7}|1e56wgzpa&}fBkqfO*k&i_)dY`l?1hv=p}Fj<2Ge{uRcq{saZ z%j{g@HZ3wNvQv&lo|o_6gr*rieLQOSK`~u|R`NhFUI)68@B`BlpbA~$UTB9Ga*~zx a%Jelj*-|I)LF@ttC5adD0subgY(|R<&Qf{+ literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 b/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 new file mode 100644 index 0000000000000000000000000000000000000000..032f4b1ca6bf0d25f1f9f419b1e7ab2aae1ef6c8 GIT binary patch literal 171 zcmV;c095~Y0Zomu4uUWgMV;SQFt~~^I5;?f2d%r6C&MNz$f6Pi}^^zp3SC&knSt>TGbz78}9=ZOL8&?Fv(cG!`VtgKgN ZY{1E$27wP^7dQxMoWuzLd;nlTMfbC)Q$zp& literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 b/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 new file mode 100644 index 0000000000000000000000000000000000000000..13d15a96a5071e98f0ba0cfbbdb2992c03990151 GIT binary patch literal 136 zcmV;30C)d*0hNtG4#FT106p`H{eaDGEd>%|)SJ(su+=pM4B|mwZ+(Kd$t05rB_(M< zmNu<2!_Lge2B#67kHO(Q1a!#· +MP…tæÇM¯0v&ù>î°KciåÇüÇ8V; \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f b/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f new file mode 100644 index 0000000000000000000000000000000000000000..7bacde68db5f1201015d4532aba9551660b05399 GIT binary patch literal 167 zcmV;Y09gNc0hNxy4Z<)C0C{H$F90%4+_Vxxz$T7kLnR0(O(n*sumP`oo$loMcuWmC z-)~w~gsCf*eiQX=*_sZfntbAHl&dTZ&5gE zmqjc(UfS(h;i3i3C0B(5e{oub>rV4>ggxy?ABf1q79*mQ-&@oFEO*Ws<|S?Qy{d)p VGuU)ju(jTFZd1AL+y`g^OR&}EOOOBn literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 b/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 new file mode 100644 index 0000000000000000000000000000000000000000..8c6b04837ae4456cc5dc53ea7572610e6635d0d8 GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lzn`tC9-|*xG$A9N literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c b/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c new file mode 100644 index 0000000000000000000000000000000000000000..1a35b74d479fdfb4bf24bcf199663fbb52036eee GIT binary patch literal 130 zcmV-|0Db>>0V^p=O;s>7GGs6`FfcPQQP4}zEXhpI%P&f0aFl&|Gw+GS!K3kZ)1Ezh zejs~i1S3>cQEFmJZmM2MMG3=S(WPsHSWJ^Nk8w52YBee>u{sG;Ra}~+n_5wlT9lWV kQ>>Sqmd-GFVdTA?;?e&$HE}Vp-My(>AuMbJ03PHp2Cniq;{X5v literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 new file mode 100644 index 0000000000000000000000000000000000000000..f65234e17f32800b1be0aa9908cc706458b14605 GIT binary patch literal 133 zcmV;00DAv;0acB$4#OY}L_6~pma=t7)Fr=DfpLNr2P1F?mVSF_r3_t8x_fuJAR6GY zuD1yyS3=Xu)WDKA@Ra});Xx7fWf1zv2~1TS@=422pQw4`eHcB9X3EwU=O)-GQ}s5s nqUZ%S7HaN3i|$`ck;m7Sz6S{Y_}`UoN%K{iOGozsJ+C?sZtFeC literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 b/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 new file mode 100644 index 0000000000000000000000000000000000000000..6b2146cae4080fe2369401ecf5009fd9612c363c GIT binary patch literal 129 zcmV-{0Dk{?0V^p=O;s>7GGs6`FfcPQQP4}zEXhpI%P&f0aFl&|Gw+GS!K3kZ)1Ezh zejs~i1S3>cQEFmJZmM2MMG3=S(WPsHSWJ^Nk8w52YBee>u{sG;Ra}~+n_5wlT9lWV jQ>>Sqmd+qz)?FYbw&JLT!Zra%FYj6GAw1sz`R^`7StK`- literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a b/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a new file mode 100644 index 0000000000..852a051139 --- /dev/null +++ b/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a @@ -0,0 +1 @@ +x•ANÄ09çsãÄÊŽ;‘~2±ÛÊJÄ^MÆ,Ï'ì8õ¥«ÔÚ¾_•ÆyyR3ØlmvˆÆ•PB°Œ˜FCñ¼Î>»y¸± *Ùbla’«-n^]D§¥,Ùx»fvÖû2p×­ }¢ÒGÍzå¿xï‰å‚ÜßÈNvq~Z¢¡Òc›âÔ èÇyäç+QåT¤íÔt;]ŠC:ÝA¹Õg¥¿AÚ( XA÷G‰®µ*=i\†_øÀ^' \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 b/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 new file mode 100644 index 0000000000000000000000000000000000000000..682d799898667fc1b506c6daece665c1af824fc1 GIT binary patch literal 169 zcmV;a09OBa0X2=i4uUWgg`MwHFu01a>EM8d!9g*|M#xPmH`1igdRvT%@!c&N$Mf@@ z(`wU3>1MmAof<6C(>I`v6dJAYeYA@l%k@73%f=gNbntJ=1Cup4@hq3GQ+7Tcu*$C$ z?z1w-GQSj97De^`@|sp*JpN(#NilT+t9T-4S&VZ28ie!20Ci{*k3u`_$Vpb#D>F9W XWKV;@2eAt}0BM}W2>^TmrSn6;Se#N% literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 b/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 new file mode 100644 index 0000000000..33c9f6cdf1 --- /dev/null +++ b/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 @@ -0,0 +1 @@ +x•ŽKNÄ0Yç½cÅÈŸLlK7é´Ÿ5#{ä´ŽO˜°z›ªÒ“¶mW%Ó“v€8¹³äÈÁ&¶eFö²òìÙ±$/¦äéÆUÉžÝz°RœÎJ¶¡”%ZY“ |YS“ìÄC/­Ó'*}ÔÜA¯ü7ïC¸ŸÇÛ‘²ÉÏ‹1‘^L0f’Ç7Åÿ¬©cì übå/ª¼Jo5½-Å®;íî Üê³Ò…¿AÚH:XA÷D×Z:ïÚ‡èè8M¿¸^æ \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd b/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd new file mode 100644 index 0000000000000000000000000000000000000000..73e7cbfbc8e106cee027f798dcb163ec6c5d21e6 GIT binary patch literal 130 zcmV-|0Db>>0V^p=O;s>7GGs6`FfcPQQP4}zEXhpI%P&f0aFl&|Gw+GS!K3kZ)1Ezh zejs~i1S3>cQEFmJZmM2MMG3=S(WPsHSWJ^Nk8w52YBee>u{sG;Ra}~+n_5wlT9lWV kQ>>Sqmd?O9-L+qLU;NqZBmPS=oA+@UXed_#01>J$$h2KJZU6uP literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 b/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 new file mode 100644 index 0000000000000000000000000000000000000000..189ed85bb3c8b8642ae353d29a759f67040b5786 GIT binary patch literal 130 zcmV-|0Db>>0V^p=O;s>7GGs6`FfcPQQP4}zEXhpI%P&f0aFl&|Gw+GS!K3kZ)1Ezh zejs~i1S3>cQEFmJZmM2MMG3=S(WPsHSWJ^Nk8w52YBee>u{sG;Ra}~+n_5wlT9lWV kQ>>Sqmd?Q7Ty=.p¢ˆA +!ìÜ  w4ݵ¡¸Qªé€Øú=©Ã¤á¨ÏZ9ü0„þûkÌ éžG)* \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master new file mode 100644 index 0000000000..1e0eef1ea3 --- /dev/null +++ b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master @@ -0,0 +1 @@ +6fc379457ecb4e576a13c7610ae1fa73f845ee6a diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature new file mode 100644 index 0000000000..607e80d1bc --- /dev/null +++ b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature @@ -0,0 +1 @@ +9580ecc12f16334ce44e42287d5d46f927bb7b75 diff --git a/manage_externals/test/repos/simple-ext-fork.git/HEAD b/manage_externals/test/repos/simple-ext-fork.git/HEAD new file mode 100644 index 0000000000..cb089cd89a --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/HEAD @@ -0,0 +1 @@ +ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext-fork.git/config b/manage_externals/test/repos/simple-ext-fork.git/config new file mode 100644 index 0000000000..04eba17870 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/config @@ -0,0 +1,8 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = true + ignorecase = true + precomposeunicode = true +[remote "origin"] + url = /Users/andreb/projects/ncar/git-conversion/checkout-model-dev/cesm-demo-externals/manage_externals/test/repos/simple-ext.git diff --git a/manage_externals/test/repos/simple-ext-fork.git/description b/manage_externals/test/repos/simple-ext-fork.git/description new file mode 100644 index 0000000000..498b267a8c --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/description @@ -0,0 +1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext-fork.git/info/exclude b/manage_externals/test/repos/simple-ext-fork.git/info/exclude new file mode 100644 index 0000000000..a5196d1be8 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/info/exclude @@ -0,0 +1,6 @@ +# git ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f new file mode 100644 index 0000000000000000000000000000000000000000..ae28c037e5e8773bab7a7f9b6b050a01c3c8402a GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lznAV=y!@Ff%bx&`ZxO$xP47FG^)_lzn&Ekz!U-;cU~)E`&5u^pl|A>?=DrCt|Zp*KGhtORPb%uc6q&p;{~x`YAHy z#2GbEv6YQH#`fOIuH1gSE*yL=Ojyh~{nIdqe*nnpf*T V&^Fln@|2-4tBgli^9u#mM`!{nPaFUM literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c b/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c new file mode 100644 index 0000000000..564e7bba63 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c @@ -0,0 +1,2 @@ +x%ŒK +Â0@]çse&ßDÔ›L’!´˜¶„l¼½).¼Åãu.@Æ_ö¸Jê0ÇàìlM–Ä~v:ÄèmLÌÆi™åY*/ŸÛè@ŽpòÞ W ˆJ¥&Üå¿ø)´*Í \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f b/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f new file mode 100644 index 0000000000000000000000000000000000000000..0d738af68b021dcd9918c8f2047aa4fff55bf6e4 GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lznO)_H(Z zem6QZm^^8RnmiI`ubHzgrPye+FKRN0H9F;O5%17>8Q`NMJ?ehWT|!t)2i0Np3Z=u$N9svC-|`;J-!jY5fUp SfzGuJhQeX2oy8Y4sYkDN{z{Sn literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf b/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf new file mode 100644 index 0000000000000000000000000000000000000000..0999f0d4b9b4297e5677a96f3c9677bf408ee8d9 GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lzniemt(y-3DP$mtIvOOf literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 b/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 new file mode 100644 index 0000000000000000000000000000000000000000..9da8434f65ef3bfdb57cb8117e312a56663a31a2 GIT binary patch literal 159 zcmV;Q0AT-k0hNwh3c@fD0R7G>_5#Z8=Ft>H)JyoiX*NFFNQn2h9>Kq1U|^;?&-V_@ zcGH_GU?Q(kip?&NPmV1)rl3VdZ7GGKLl-2Pw=`WkjA`(0bci¹`ý}0…M”؇BÚÁs0/µâ¿}öï:: \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b new file mode 100644 index 0000000000..9a31c7ef2e --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b @@ -0,0 +1,2 @@ +x•ŽKnÃ0 ³Ö)x”,ÊI½EÑŸ´–A¹Ü#t7o€ŒìÛ¶vp.žzS…ÁšÆƒ&oÑ„©d¦8¹xLd@™Ì‹›ÖCð6f¯% +œpt$‰m&ŽJd…¦¡øhøÝ—½Á—VxÔÒ®ùÉpŸ7^/²o7°d­K1ÂGDsØ#¯ë¿æ{o?Z 7®²€,\g½˜AV=y!@Ff%bx&`ZxO$xP47FG^)_lznAV=y!@Ff%bx&`ZxO$xP47FG^)_lznvGy0&Z${j?E8>6rD10GHRYE2d literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/5f/1d4786d12e52d7ab28d2f2f1118c1059a9f1ae b/manage_externals/test/repos/simple-ext-fork.git/objects/5f/1d4786d12e52d7ab28d2f2f1118c1059a9f1ae new file mode 100644 index 0000000000000000000000000000000000000000..25488b7bfe52fd0d530e20393b752815d9aaf16f GIT binary patch literal 93 zcmV-j0HXhR0S(JB4ue1p1i;kyiv0l8%LNPZurX=iP=VtPL2T>`g? zkh3=;83|{%kTn0{lH8#Nev_`XVPmImRbRpwOIgehnBL{IWwXg literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/67/136e5ab4d5c1c65d10c8048763b96b0e53c1d6 b/manage_externals/test/repos/simple-ext-fork.git/objects/67/136e5ab4d5c1c65d10c8048763b96b0e53c1d6 new file mode 100644 index 0000000000000000000000000000000000000000..d3dfe31113715fe07ea6833f0c2a25e868ac20b2 GIT binary patch literal 165 zcmV;W09yZe0hNwR4#F@DL|Nw)z5pm6r*$QSfIWwB8k=t$6s6+&lq0Ykjo#?ZSf=UT zz+~D012)4Gj)~xM%ugTv-b1AFi TQ|c4S3@Y4~D&BknM3zUWvn5b3 literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/7b/0bd630ac13865735a1dff3437a137d8ab50663 b/manage_externals/test/repos/simple-ext-fork.git/objects/7b/0bd630ac13865735a1dff3437a137d8ab50663 new file mode 100644 index 0000000000000000000000000000000000000000..0a2ec0494bc1600144cb54b61a6d7b43c7f3e806 GIT binary patch literal 119 zcmV--0Eqv10X50d4FVw$MNz-0;#IJTYiz*^YyjkKAhHY@MpwI+#E{&tb3>7U^YwDN zr`$2}=y`92Fm{8oNzW$w#gQ$c3ivT<^#zfQHTwFÁ©¹£rPkÖSèkJ´^ë \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 b/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 new file mode 100644 index 0000000000..d8ba654548 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 @@ -0,0 +1,3 @@ +xUÌ[ +Â0…aŸ³ŠÙ@%Is+ˆ¨;™¤c/˜DÂq÷VðÅ×Ã>Æ ”w‡WJ Ú˜>8ò!¤!&'ƒS=)í±×CòF+ÑI2‚ßO‚Ts^Xðn`Ä2ÖBcw'ä­Ñw¨Á +\ËØNqÝ›F—)ãò8îç3(«¬Œ2:é¥ÿü0x-<×!6,i ª9 \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 b/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 new file mode 100644 index 0000000000000000000000000000000000000000..9b40a0afa00b93a318cd503d3b29db1162978b03 GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lznD—}ÂD>£Nƒv“{ŠZ¼M˜I…¥?jƒ‹Ìpžs8ÄgøÓ½„qÚ¥ZŽ€qo j†­f­ÕJ×{]þÕµÓ¥®¥Om/¨3Ü$ô¥‰Q_@ÞH© \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/packed-refs b/manage_externals/test/repos/simple-ext-fork.git/packed-refs new file mode 100644 index 0000000000..b8f9e86308 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/packed-refs @@ -0,0 +1,5 @@ +# pack-refs with: peeled fully-peeled sorted +36418b4e5665956a90725c9a1b5a8e551c5f3d48 refs/heads/feature2 +9b75494003deca69527bb64bcaa352e801611dd2 refs/heads/master +11a76e3d9a67313dec7ce1230852ab5c86352c5c refs/tags/tag1 +^9b75494003deca69527bb64bcaa352e801611dd2 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 b/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 new file mode 100644 index 0000000000..d223b0362d --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 @@ -0,0 +1 @@ +f268d4e56d067da9bd1d85e55bdc40a8bd2b0bca diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature new file mode 100644 index 0000000000..8a18bf08e9 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature @@ -0,0 +1 @@ +a42fe9144f5707bc1e9515ce1b44681f7aba6f95 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 new file mode 100644 index 0000000000..2764b552d5 --- /dev/null +++ b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 @@ -0,0 +1 @@ +8d2b3b35126224c975d23f109aa1e3cbac452989 diff --git a/manage_externals/test/repos/simple-ext.git/HEAD b/manage_externals/test/repos/simple-ext.git/HEAD new file mode 100644 index 0000000000..cb089cd89a --- /dev/null +++ b/manage_externals/test/repos/simple-ext.git/HEAD @@ -0,0 +1 @@ +ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext.git/config b/manage_externals/test/repos/simple-ext.git/config new file mode 100644 index 0000000000..e6da231579 --- /dev/null +++ b/manage_externals/test/repos/simple-ext.git/config @@ -0,0 +1,6 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = true + ignorecase = true + precomposeunicode = true diff --git a/manage_externals/test/repos/simple-ext.git/description b/manage_externals/test/repos/simple-ext.git/description new file mode 100644 index 0000000000..498b267a8c --- /dev/null +++ b/manage_externals/test/repos/simple-ext.git/description @@ -0,0 +1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext.git/info/exclude b/manage_externals/test/repos/simple-ext.git/info/exclude new file mode 100644 index 0000000000..a5196d1be8 --- /dev/null +++ b/manage_externals/test/repos/simple-ext.git/info/exclude @@ -0,0 +1,6 @@ +# git ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ diff --git a/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f new file mode 100644 index 0000000000000000000000000000000000000000..ae28c037e5e8773bab7a7f9b6b050a01c3c8402a GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lznbW_*ltIGSP}@rN;eRaRvTe4jec)&9#mV ztc{ztsDi^RDN|POQ7IsM3R)Zn^fb6Ap%fNDG*4c1YCyeUO2}@P$+4Hjj2b9dvLb3- zmJ-WQ2E*@mn-@6i1g9x43VXTpcO0*k$48gudH@`(^)|-1gKbZJZ&teIHT_#Om*271 ST(#ZC=?eOIX=gtC)=0=UK}@j# literal 0 HcmV?d00001 diff --git a/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 b/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 new file mode 100644 index 0000000000000000000000000000000000000000..32d6896e3cb813edde3e4f0d0ca2d21963c2f1b0 GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lznåY*/ŸÛè@ŽpòÞ W ˆJ¥&Üå¿ø)´*Í \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 b/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 new file mode 100644 index 0000000000000000000000000000000000000000..0f0db6797fe19372f1d2122ebe8aa5361df07c61 GIT binary patch literal 90 zcmV-g0HyzU0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lzn_5#Z8=Ft>H)JyoiX*NFFNQn2h9>Kq1U|^;?&-V_@ zcGH_GU?Q(kip?&NPmV1)rl3VdZ7GGKLl-2Pw=`WkjA`(0bciÁ©¹£rPkÖSèkJ´^ë \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 b/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 new file mode 100644 index 0000000000..1d27accb58 --- /dev/null +++ b/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 @@ -0,0 +1 @@ +x ÈÁ € @ßT±øàeV` ›p ¹;£v¯É¼&מ±Äi+bø%˜œ£Ns(G7ñ®/nñ‚ÖÁÇ©-UlGj»ÐæV&¿”Yÿ+!|£òŠ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff b/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff new file mode 100644 index 0000000000000000000000000000000000000000..4018ea5914ee89b76d88fc282b6c98d80e4aaccd GIT binary patch literal 89 zcmV-f0H*(V0V^p=O;s>AV=y!@Ff%bx&`ZxO$xP47FG^)_lzn=1.7.0 +autopep8>=1.3.0 +coverage>=4.4.0 +coveralls>=1.2.0 +sphinx>=1.6.0 diff --git a/manage_externals/test/test_sys_checkout.py b/manage_externals/test/test_sys_checkout.py new file mode 100644 index 0000000000..63adcacdde --- /dev/null +++ b/manage_externals/test/test_sys_checkout.py @@ -0,0 +1,1827 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the manic and +checkout_externals module is already in the python path. This is +usually handled by the makefile. If you call it directly, you may need +to adjust your path. + +NOTE(bja, 2017-11) If a test fails, we want to keep the repo for that +test. But the tests will keep running, so we need a unique name. Also, +tearDown is always called after each test. I haven't figured out how +to determine if an assertion failed and whether it is safe to clean up +the test repos. + +So the solution is: + +* assign a unique id to each test repo. + +* never cleanup during the run. + +* Erase any existing repos at the begining of the module in +setUpModule. + +""" + +# NOTE(bja, 2017-11) pylint complains that the module is too big, but +# I'm still working on how to break up the tests and still have the +# temporary directory be preserved.... +# pylint: disable=too-many-lines + + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import logging +import os +import os.path +import shutil +import unittest + +from manic.externals_description import ExternalsDescription +from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM +from manic.externals_description import git_submodule_status +from manic.externals_status import ExternalStatus +from manic.repository_git import GitRepository +from manic.utils import printlog, execute_subprocess +from manic.global_constants import LOCAL_PATH_INDICATOR, VERBOSITY_DEFAULT +from manic.global_constants import LOG_FILE_NAME +from manic import checkout + +# ConfigParser was renamed in python2 to configparser. In python2, +# ConfigParser returns byte strings, str, instead of unicode. We need +# unicode to be compatible with xml and json parser and python3. +try: + # python2 + from ConfigParser import SafeConfigParser as config_parser +except ImportError: + # python3 + from configparser import ConfigParser as config_parser + +# --------------------------------------------------------------------- +# +# Global constants +# +# --------------------------------------------------------------------- + +# environment variable names +MANIC_TEST_BARE_REPO_ROOT = 'MANIC_TEST_BARE_REPO_ROOT' +MANIC_TEST_TMP_REPO_ROOT = 'MANIC_TEST_TMP_REPO_ROOT' + +# directory names +TMP_REPO_DIR_NAME = 'tmp' +BARE_REPO_ROOT_NAME = 'repos' +CONTAINER_REPO_NAME = 'container.git' +MIXED_REPO_NAME = 'mixed-cont-ext.git' +SIMPLE_REPO_NAME = 'simple-ext.git' +SIMPLE_FORK_NAME = 'simple-ext-fork.git' +SIMPLE_LOCAL_ONLY_NAME = '.' +ERROR_REPO_NAME = 'error' +EXTERNALS_NAME = 'externals' +SUB_EXTERNALS_PATH = 'src' +CFG_NAME = 'externals.cfg' +CFG_SUB_NAME = 'sub-externals.cfg' +README_NAME = 'readme.txt' +REMOTE_BRANCH_FEATURE2 = 'feature2' + +SVN_TEST_REPO = 'https://github.com/escomp/cesm' + + +def setUpModule(): # pylint: disable=C0103 + """Setup for all tests in this module. It is called once per module! + """ + logging.basicConfig(filename=LOG_FILE_NAME, + format='%(levelname)s : %(asctime)s : %(message)s', + datefmt='%Y-%m-%d %H:%M:%S', + level=logging.DEBUG) + repo_root = os.path.join(os.getcwd(), TMP_REPO_DIR_NAME) + repo_root = os.path.abspath(repo_root) + # delete if it exists from previous runs + try: + shutil.rmtree(repo_root) + except BaseException: + pass + # create clean dir for this run + os.mkdir(repo_root) + # set into the environment so var will be expanded in externals + # filess when executables are run + os.environ[MANIC_TEST_TMP_REPO_ROOT] = repo_root + + +class GenerateExternalsDescriptionCfgV1(object): + """Class to provide building blocks to create + ExternalsDescriptionCfgV1 files. + + Includes predefined files used in tests. + + """ + + def __init__(self): + self._schema_version = '1.1.0' + self._config = None + + def container_full(self, dest_dir): + """Create the full container config file with simple and mixed use + externals + + """ + self.create_config() + self.create_section(SIMPLE_REPO_NAME, 'simp_tag', + tag='tag1') + + self.create_section(SIMPLE_REPO_NAME, 'simp_branch', + branch=REMOTE_BRANCH_FEATURE2) + + self.create_section(SIMPLE_REPO_NAME, 'simp_opt', + tag='tag1', required=False) + + self.create_section(MIXED_REPO_NAME, 'mixed_req', + branch='master', externals=CFG_SUB_NAME) + + self.write_config(dest_dir) + + def container_simple_required(self, dest_dir): + """Create a container externals file with only simple externals. + + """ + self.create_config() + self.create_section(SIMPLE_REPO_NAME, 'simp_tag', + tag='tag1') + + self.create_section(SIMPLE_REPO_NAME, 'simp_branch', + branch=REMOTE_BRANCH_FEATURE2) + + self.create_section(SIMPLE_REPO_NAME, 'simp_hash', + ref_hash='60b1cc1a38d63') + + self.write_config(dest_dir) + + def container_simple_optional(self, dest_dir): + """Create a container externals file with optional simple externals + + """ + self.create_config() + self.create_section(SIMPLE_REPO_NAME, 'simp_req', + tag='tag1') + + self.create_section(SIMPLE_REPO_NAME, 'simp_opt', + tag='tag1', required=False) + + self.write_config(dest_dir) + + def container_simple_svn(self, dest_dir): + """Create a container externals file with only simple externals. + + """ + self.create_config() + self.create_section(SIMPLE_REPO_NAME, 'simp_tag', tag='tag1') + + self.create_svn_external('svn_branch', branch='trunk') + self.create_svn_external('svn_tag', tag='tags/cesm2.0.beta07') + + self.write_config(dest_dir) + + def mixed_simple_base(self, dest_dir): + """Create a mixed-use base externals file with only simple externals. + + """ + self.create_config() + self.create_section_ext_only('mixed_base') + self.create_section(SIMPLE_REPO_NAME, 'simp_tag', + tag='tag1') + + self.create_section(SIMPLE_REPO_NAME, 'simp_branch', + branch=REMOTE_BRANCH_FEATURE2) + + self.create_section(SIMPLE_REPO_NAME, 'simp_hash', + ref_hash='60b1cc1a38d63') + + self.write_config(dest_dir) + + def mixed_simple_sub(self, dest_dir): + """Create a mixed-use sub externals file with only simple externals. + + """ + self.create_config() + self.create_section(SIMPLE_REPO_NAME, 'simp_tag', + tag='tag1', path=SUB_EXTERNALS_PATH) + + self.create_section(SIMPLE_REPO_NAME, 'simp_branch', + branch=REMOTE_BRANCH_FEATURE2, + path=SUB_EXTERNALS_PATH) + + self.write_config(dest_dir, filename=CFG_SUB_NAME) + + def write_config(self, dest_dir, filename=CFG_NAME): + """Write the configuration file to disk + + """ + dest_path = os.path.join(dest_dir, filename) + with open(dest_path, 'w') as configfile: + self._config.write(configfile) + + def create_config(self): + """Create an config object and add the required metadata section + + """ + self._config = config_parser() + self.create_metadata() + + def create_metadata(self): + """Create the metadata section of the config file + """ + self._config.add_section(DESCRIPTION_SECTION) + + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, + self._schema_version) + + def create_section(self, repo_type, name, tag='', branch='', + ref_hash='', required=True, path=EXTERNALS_NAME, + externals='', repo_path=None, from_submodule=False): + # pylint: disable=too-many-branches + """Create a config section with autofilling some items and handling + optional items. + + """ + # pylint: disable=R0913 + self._config.add_section(name) + if not from_submodule: + self._config.set(name, ExternalsDescription.PATH, + os.path.join(path, name)) + + self._config.set(name, ExternalsDescription.PROTOCOL, + ExternalsDescription.PROTOCOL_GIT) + + # from_submodules is incompatible with some other options, turn them off + if (from_submodule and + ((repo_path is not None) or tag or ref_hash or branch)): + printlog('create_section: "from_submodule" is incompatible with ' + '"repo_url", "tag", "hash", and "branch" options;\n' + 'Ignoring those options for {}'.format(name)) + repo_url = None + tag = '' + ref_hash = '' + branch = '' + + if repo_path is not None: + repo_url = repo_path + else: + repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) + + if not from_submodule: + self._config.set(name, ExternalsDescription.REPO_URL, repo_url) + + self._config.set(name, ExternalsDescription.REQUIRED, str(required)) + + if tag: + self._config.set(name, ExternalsDescription.TAG, tag) + + if branch: + self._config.set(name, ExternalsDescription.BRANCH, branch) + + if ref_hash: + self._config.set(name, ExternalsDescription.HASH, ref_hash) + + if externals: + self._config.set(name, ExternalsDescription.EXTERNALS, externals) + + if from_submodule: + self._config.set(name, ExternalsDescription.SUBMODULE, "True") + + def create_section_ext_only(self, name, + required=True, externals=CFG_SUB_NAME): + """Create a config section with autofilling some items and handling + optional items. + + """ + # pylint: disable=R0913 + self._config.add_section(name) + self._config.set(name, ExternalsDescription.PATH, LOCAL_PATH_INDICATOR) + + self._config.set(name, ExternalsDescription.PROTOCOL, + ExternalsDescription.PROTOCOL_EXTERNALS_ONLY) + + self._config.set(name, ExternalsDescription.REPO_URL, + LOCAL_PATH_INDICATOR) + + self._config.set(name, ExternalsDescription.REQUIRED, str(required)) + + if externals: + self._config.set(name, ExternalsDescription.EXTERNALS, externals) + + def create_svn_external(self, name, tag='', branch=''): + """Create a config section for an svn repository. + + """ + self._config.add_section(name) + self._config.set(name, ExternalsDescription.PATH, + os.path.join(EXTERNALS_NAME, name)) + + self._config.set(name, ExternalsDescription.PROTOCOL, + ExternalsDescription.PROTOCOL_SVN) + + self._config.set(name, ExternalsDescription.REPO_URL, SVN_TEST_REPO) + + self._config.set(name, ExternalsDescription.REQUIRED, str(True)) + + if tag: + self._config.set(name, ExternalsDescription.TAG, tag) + + if branch: + self._config.set(name, ExternalsDescription.BRANCH, branch) + + @staticmethod + def create_branch(dest_dir, repo_name, branch, with_commit=False): + """Update a repository branch, and potentially the remote. + """ + # pylint: disable=R0913 + cwd = os.getcwd() + repo_root = os.path.join(dest_dir, EXTERNALS_NAME) + repo_root = os.path.join(repo_root, repo_name) + os.chdir(repo_root) + cmd = ['git', 'checkout', '-b', branch, ] + execute_subprocess(cmd) + if with_commit: + msg = 'start work on {0}'.format(branch) + with open(README_NAME, 'a') as handle: + handle.write(msg) + cmd = ['git', 'add', README_NAME, ] + execute_subprocess(cmd) + cmd = ['git', 'commit', '-m', msg, ] + execute_subprocess(cmd) + os.chdir(cwd) + + @staticmethod + def create_commit(dest_dir, repo_name, local_tracking_branch=None): + """Make a commit on whatever is currently checked out. + + This is used to test sync state changes from local commits on + detached heads and tracking branches. + + """ + cwd = os.getcwd() + repo_root = os.path.join(dest_dir, EXTERNALS_NAME) + repo_root = os.path.join(repo_root, repo_name) + os.chdir(repo_root) + if local_tracking_branch: + cmd = ['git', 'checkout', '-b', local_tracking_branch, ] + execute_subprocess(cmd) + + msg = 'work on great new feature!' + with open(README_NAME, 'a') as handle: + handle.write(msg) + cmd = ['git', 'add', README_NAME, ] + execute_subprocess(cmd) + cmd = ['git', 'commit', '-m', msg, ] + execute_subprocess(cmd) + os.chdir(cwd) + + def update_branch(self, dest_dir, name, branch, repo_type=None, + filename=CFG_NAME): + """Update a repository branch, and potentially the remote. + """ + # pylint: disable=R0913 + self._config.set(name, ExternalsDescription.BRANCH, branch) + + if repo_type: + if repo_type == SIMPLE_LOCAL_ONLY_NAME: + repo_url = SIMPLE_LOCAL_ONLY_NAME + else: + repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', + repo_type) + self._config.set(name, ExternalsDescription.REPO_URL, repo_url) + + try: + # remove the tag if it existed + self._config.remove_option(name, ExternalsDescription.TAG) + except BaseException: + pass + + self.write_config(dest_dir, filename) + + def update_svn_branch(self, dest_dir, name, branch, filename=CFG_NAME): + """Update a repository branch, and potentially the remote. + """ + # pylint: disable=R0913 + self._config.set(name, ExternalsDescription.BRANCH, branch) + + try: + # remove the tag if it existed + self._config.remove_option(name, ExternalsDescription.TAG) + except BaseException: + pass + + self.write_config(dest_dir, filename) + + def update_tag(self, dest_dir, name, tag, repo_type=None, + filename=CFG_NAME, remove_branch=True): + """Update a repository tag, and potentially the remote + + NOTE(bja, 2017-11) remove_branch=False should result in an + overspecified external with both a branch and tag. This is + used for error condition testing. + + """ + # pylint: disable=R0913 + self._config.set(name, ExternalsDescription.TAG, tag) + + if repo_type: + repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) + self._config.set(name, ExternalsDescription.REPO_URL, repo_url) + + try: + # remove the branch if it existed + if remove_branch: + self._config.remove_option(name, ExternalsDescription.BRANCH) + except BaseException: + pass + + self.write_config(dest_dir, filename) + + def update_underspecify_branch_tag(self, dest_dir, name, + filename=CFG_NAME): + """Update a repository protocol, and potentially the remote + """ + # pylint: disable=R0913 + try: + # remove the branch if it existed + self._config.remove_option(name, ExternalsDescription.BRANCH) + except BaseException: + pass + + try: + # remove the tag if it existed + self._config.remove_option(name, ExternalsDescription.TAG) + except BaseException: + pass + + self.write_config(dest_dir, filename) + + def update_underspecify_remove_url(self, dest_dir, name, + filename=CFG_NAME): + """Update a repository protocol, and potentially the remote + """ + # pylint: disable=R0913 + try: + # remove the repo url if it existed + self._config.remove_option(name, ExternalsDescription.REPO_URL) + except BaseException: + pass + + self.write_config(dest_dir, filename) + + def update_protocol(self, dest_dir, name, protocol, repo_type=None, + filename=CFG_NAME): + """Update a repository protocol, and potentially the remote + """ + # pylint: disable=R0913 + self._config.set(name, ExternalsDescription.PROTOCOL, protocol) + + if repo_type: + repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) + self._config.set(name, ExternalsDescription.REPO_URL, repo_url) + + self.write_config(dest_dir, filename) + + +class BaseTestSysCheckout(unittest.TestCase): + """Base class of reusable systems level test setup for + checkout_externals + + """ + # NOTE(bja, 2017-11) pylint complains about long method names, but + # it is hard to differentiate tests without making them more + # cryptic. + # pylint: disable=invalid-name + + status_args = ['--status'] + checkout_args = [] + optional_args = ['--optional'] + verbose_args = ['--status', '--verbose'] + + def setUp(self): + """Setup for all individual checkout_externals tests + """ + # directory we want to return to after the test system and + # checkout_externals are done cd'ing all over the place. + self._return_dir = os.getcwd() + + self._test_id = self.id().split('.')[-1] + + # path to the executable + self._checkout = os.path.join('../checkout_externals') + self._checkout = os.path.abspath(self._checkout) + + # directory where we have test repositories + self._bare_root = os.path.join(os.getcwd(), BARE_REPO_ROOT_NAME) + self._bare_root = os.path.abspath(self._bare_root) + + # set into the environment so var will be expanded in externals files + os.environ[MANIC_TEST_BARE_REPO_ROOT] = self._bare_root + + # set the input file generator + self._generator = GenerateExternalsDescriptionCfgV1() + # set the input file generator for secondary externals + self._sub_generator = GenerateExternalsDescriptionCfgV1() + + def tearDown(self): + """Tear down for individual tests + """ + # remove the env var we added in setup + del os.environ[MANIC_TEST_BARE_REPO_ROOT] + + # return to our common starting point + os.chdir(self._return_dir) + + def setup_test_repo(self, parent_repo_name, dest_dir_in=None): + """Setup the paths and clone the base test repo + + """ + # unique repo for this test + test_dir_name = self._test_id + print("Test repository name: {0}".format(test_dir_name)) + + parent_repo_dir = os.path.join(self._bare_root, parent_repo_name) + if dest_dir_in is None: + dest_dir = os.path.join(os.environ[MANIC_TEST_TMP_REPO_ROOT], + test_dir_name) + else: + dest_dir = dest_dir_in + + # pylint: disable=W0212 + GitRepository._git_clone(parent_repo_dir, dest_dir, VERBOSITY_DEFAULT) + return dest_dir + + @staticmethod + def _add_file_to_repo(under_test_dir, filename, tracked): + """Add a file to the repository so we can put it into a dirty state + + """ + cwd = os.getcwd() + os.chdir(under_test_dir) + with open(filename, 'w') as tmp: + tmp.write('Hello, world!') + + if tracked: + # NOTE(bja, 2018-01) brittle hack to obtain repo dir and + # file name + path_data = filename.split('/') + repo_dir = os.path.join(path_data[0], path_data[1]) + os.chdir(repo_dir) + tracked_file = path_data[2] + cmd = ['git', 'add', tracked_file] + execute_subprocess(cmd) + + os.chdir(cwd) + + @staticmethod + def execute_cmd_in_dir(under_test_dir, args): + """Extecute the checkout command in the appropriate repo dir with the + specified additional args + + Note that we are calling the command line processing and main + routines and not using a subprocess call so that we get code + coverage results! + + """ + cwd = os.getcwd() + checkout_path = os.path.abspath('{0}/../../checkout_externals') + os.chdir(under_test_dir) + cmdline = ['--externals', CFG_NAME, ] + cmdline += args + repo_root = 'MANIC_TEST_BARE_REPO_ROOT={root}'.format( + root=os.environ[MANIC_TEST_BARE_REPO_ROOT]) + manual_cmd = ('Test cmd:\npushd {cwd}; {env} {checkout} {args}'.format( + cwd=under_test_dir, env=repo_root, checkout=checkout_path, + args=' '.join(cmdline))) + printlog(manual_cmd) + options = checkout.commandline_arguments(cmdline) + overall_status, tree_status = checkout.main(options) + os.chdir(cwd) + return overall_status, tree_status + + # ---------------------------------------------------------------- + # + # Check results for generic perturbation of states + # + # ---------------------------------------------------------------- + def _check_generic_empty_default_required(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.EMPTY) + self.assertEqual(tree[name].clean_state, ExternalStatus.DEFAULT) + self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) + + def _check_generic_ok_clean_required(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) + + def _check_generic_ok_dirty_required(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].clean_state, ExternalStatus.DIRTY) + self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) + + def _check_generic_modified_ok_required(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.MODEL_MODIFIED) + self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) + + def _check_generic_empty_default_optional(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.EMPTY) + self.assertEqual(tree[name].clean_state, ExternalStatus.DEFAULT) + self.assertEqual(tree[name].source_type, ExternalStatus.OPTIONAL) + + def _check_generic_ok_clean_optional(self, tree, name): + self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) + self.assertEqual(tree[name].source_type, ExternalStatus.OPTIONAL) + + # ---------------------------------------------------------------- + # + # Check results for individual named externals + # + # ---------------------------------------------------------------- + def _check_simple_tag_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_tag'.format(directory) + self._check_generic_empty_default_required(tree, name) + + def _check_simple_tag_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_tag'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_simple_tag_dirty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_tag'.format(directory) + self._check_generic_ok_dirty_required(tree, name) + + def _check_simple_tag_modified(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_tag'.format(directory) + self._check_generic_modified_ok_required(tree, name) + + def _check_simple_branch_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_branch'.format(directory) + self._check_generic_empty_default_required(tree, name) + + def _check_simple_branch_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_branch'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_simple_branch_modified(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_branch'.format(directory) + self._check_generic_modified_ok_required(tree, name) + + def _check_simple_hash_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_hash'.format(directory) + self._check_generic_empty_default_required(tree, name) + + def _check_simple_hash_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_hash'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_simple_hash_modified(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_hash'.format(directory) + self._check_generic_modified_ok_required(tree, name) + + def _check_simple_req_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_req'.format(directory) + self._check_generic_empty_default_required(tree, name) + + def _check_simple_req_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_req'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_simple_opt_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_opt'.format(directory) + self._check_generic_empty_default_optional(tree, name) + + def _check_simple_opt_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/simp_opt'.format(directory) + self._check_generic_ok_clean_optional(tree, name) + + def _check_mixed_ext_branch_empty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/mixed_req'.format(directory) + self._check_generic_empty_default_required(tree, name) + + def _check_mixed_ext_branch_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/mixed_req'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_mixed_ext_branch_modified(self, tree, directory=EXTERNALS_NAME): + name = './{0}/mixed_req'.format(directory) + self._check_generic_modified_ok_required(tree, name) + + # ---------------------------------------------------------------- + # + # Check results for groups of externals under specific conditions + # + # ---------------------------------------------------------------- + def _check_container_simple_required_pre_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_empty(tree) + self._check_simple_branch_empty(tree) + self._check_simple_hash_empty(tree) + + def _check_container_simple_required_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_simple_tag_empty(tree) + self._check_simple_branch_empty(tree) + self._check_simple_hash_empty(tree) + + def _check_container_simple_required_post_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_simple_branch_ok(tree) + self._check_simple_hash_ok(tree) + + def _check_container_simple_required_out_of_sync(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_modified(tree) + self._check_simple_branch_modified(tree) + self._check_simple_hash_modified(tree) + + def _check_container_simple_optional_pre_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_req_empty(tree) + self._check_simple_opt_empty(tree) + + def _check_container_simple_optional_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_req_empty(tree) + self._check_simple_opt_empty(tree) + + def _check_container_simple_optional_post_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_req_ok(tree) + self._check_simple_opt_empty(tree) + + def _check_container_simple_optional_post_optional(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_req_ok(tree) + self._check_simple_opt_ok(tree) + + def _check_container_simple_required_sb_modified(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_simple_branch_modified(tree) + self._check_simple_hash_ok(tree) + + def _check_container_simple_optional_st_dirty(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_dirty(tree) + self._check_simple_branch_ok(tree) + + def _check_container_full_pre_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_empty(tree) + self._check_simple_branch_empty(tree) + self._check_simple_opt_empty(tree) + self._check_mixed_ext_branch_required_pre_checkout(overall, tree) + + def _check_container_component_post_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_opt_ok(tree) + self._check_simple_tag_empty(tree) + self._check_simple_branch_empty(tree) + + def _check_container_component_post_checkout2(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_opt_ok(tree) + self._check_simple_tag_empty(tree) + self._check_simple_branch_ok(tree) + + def _check_container_full_post_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_simple_branch_ok(tree) + self._check_simple_opt_empty(tree) + self._check_mixed_ext_branch_required_post_checkout(overall, tree) + + def _check_container_full_pre_checkout_ext_change(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_simple_branch_ok(tree) + self._check_simple_opt_empty(tree) + self._check_mixed_ext_branch_required_pre_checkout_ext_change( + overall, tree) + + def _check_container_full_post_checkout_subext_modified( + self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_simple_branch_ok(tree) + self._check_simple_opt_empty(tree) + self._check_mixed_ext_branch_required_post_checkout_subext_modified( + overall, tree) + + def _check_mixed_ext_branch_required_pre_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_mixed_ext_branch_empty(tree, directory=EXTERNALS_NAME) + # NOTE: externals/mixed_req/src should not exist in the tree + # since this is the status before checkout of mixed_req. + + def _check_mixed_ext_branch_required_post_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_mixed_ext_branch_ok(tree, directory=EXTERNALS_NAME) + check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", + SUB_EXTERNALS_PATH) + self._check_simple_branch_ok(tree, directory=check_dir) + + def _check_mixed_ext_branch_required_pre_checkout_ext_change( + self, overall, tree): + # Note, this is the internal tree status just after change the + # externals description file, but before checkout + self.assertEqual(overall, 0) + self._check_mixed_ext_branch_modified(tree, directory=EXTERNALS_NAME) + check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", + SUB_EXTERNALS_PATH) + self._check_simple_branch_ok(tree, directory=check_dir) + + def _check_mixed_ext_branch_required_post_checkout_subext_modified( + self, overall, tree): + # Note, this is the internal tree status just after change the + # externals description file, but before checkout + self.assertEqual(overall, 0) + self._check_mixed_ext_branch_ok(tree, directory=EXTERNALS_NAME) + check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", + SUB_EXTERNALS_PATH) + self._check_simple_branch_modified(tree, directory=check_dir) + + def _check_mixed_cont_simple_required_pre_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_simple_tag_empty(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_empty(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_empty(tree, directory=SUB_EXTERNALS_PATH) + + def _check_mixed_cont_simple_required_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_simple_tag_empty(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_empty(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_empty(tree, directory=SUB_EXTERNALS_PATH) + + def _check_mixed_cont_simple_required_post_checkout(self, overall, tree): + # Note, this is the internal tree status just before checkout + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_ok(tree, directory=EXTERNALS_NAME) + self._check_simple_branch_ok(tree, directory=SUB_EXTERNALS_PATH) + + +class TestSysCheckout(BaseTestSysCheckout): + """Run systems level tests of checkout_externals + + """ + # NOTE(bja, 2017-11) pylint complains about long method names, but + # it is hard to differentiate tests without making them more + # cryptic. + # pylint: disable=invalid-name + + # ---------------------------------------------------------------- + # + # Run systems tests + # + # ---------------------------------------------------------------- + def test_container_simple_required(self): + """Verify that a container with simple subrepos + generates the correct initial status. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # status of empty repo + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_pre_checkout(overall, tree) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # status clean checked out + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_simple_optional(self): + """Verify that container with an optional simple subrepos + generates the correct initial status. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_optional(under_test_dir) + + # check status of empty repo + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_optional_pre_checkout(overall, tree) + + # checkout required + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_optional_checkout(overall, tree) + + # status + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_optional_post_checkout(overall, tree) + + # checkout optional + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.optional_args) + self._check_container_simple_optional_post_checkout(overall, tree) + + # status + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_optional_post_optional(overall, tree) + + def test_container_simple_verbose(self): + """Verify that container with simple subrepos runs with verbose status + output and generates the correct initial status. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # check verbose status + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.verbose_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_simple_dirty(self): + """Verify that a container with simple subrepos + and a dirty status exits gracefully. + + """ + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # add a file to the repo + tracked = True + self._add_file_to_repo(under_test_dir, 'externals/simp_tag/tmp.txt', + tracked) + + # checkout: pre-checkout status should be dirty, did not + # modify working copy. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_optional_st_dirty(overall, tree) + + # verify status is still dirty + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_optional_st_dirty(overall, tree) + + def test_container_simple_untracked(self): + """Verify that a container with simple subrepos and a untracked files + is not considered 'dirty' and will attempt an update. + + """ + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # add a file to the repo + tracked = False + self._add_file_to_repo(under_test_dir, 'externals/simp_tag/tmp.txt', + tracked) + + # checkout: pre-checkout status should be clean, ignoring the + # untracked file. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_post_checkout(overall, tree) + + # verify status is still clean + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_simple_detached_sync(self): + """Verify that a container with simple subrepos generates the correct + out of sync status when making commits from a detached head + state. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # status of empty repo + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_pre_checkout(overall, tree) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # make a commit on the detached head of the tag and hash externals + self._generator.create_commit(under_test_dir, 'simp_tag') + self._generator.create_commit(under_test_dir, 'simp_hash') + self._generator.create_commit(under_test_dir, 'simp_branch') + + # status of repo, branch, tag and hash should all be out of sync! + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_out_of_sync(overall, tree) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + # same pre-checkout out of sync status + self._check_container_simple_required_out_of_sync(overall, tree) + + # now status should be in-sync + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_remote_branch(self): + """Verify that a container with remote branch change works + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # update the config file to point to a different remote with + # the same branch + self._generator.update_branch(under_test_dir, 'simp_branch', + REMOTE_BRANCH_FEATURE2, SIMPLE_FORK_NAME) + + # status of simp_branch should be out of sync + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # checkout new externals + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # status should be synced + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_remote_tag_same_branch(self): + """Verify that a container with remote tag change works. The new tag + should not be in the original repo, only the new remote + fork. The new tag is automatically fetched because it is on + the branch. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_tag(under_test_dir, 'simp_branch', + 'forked-feature-v1', SIMPLE_FORK_NAME) + + # status of simp_branch should be out of sync + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # checkout new externals + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # status should be synced + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_remote_tag_fetch_all(self): + """Verify that a container with remote tag change works. The new tag + should not be in the original repo, only the new remote + fork. It should also not be on a branch that will be fetch, + and therefore not fetched by default with 'git fetch'. It will + only be retreived by 'git fetch --tags' + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_tag(under_test_dir, 'simp_branch', + 'abandoned-feature', SIMPLE_FORK_NAME) + + # status of simp_branch should be out of sync + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # checkout new externals + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_sb_modified(overall, tree) + + # status should be synced + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_preserve_dot(self): + """Verify that after inital checkout, modifying an external git repo + url to '.' and the current branch will leave it unchanged. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_required_checkout(overall, tree) + + # update the config file to point to a different remote with + # the same branch + self._generator.update_branch(under_test_dir, 'simp_branch', + REMOTE_BRANCH_FEATURE2, SIMPLE_FORK_NAME) + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + + # verify status is clean and unmodified + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + # update branch to point to a new branch that only exists in + # the local fork + self._generator.create_branch(under_test_dir, 'simp_branch', + 'private-feature', with_commit=True) + self._generator.update_branch(under_test_dir, 'simp_branch', + 'private-feature', + SIMPLE_LOCAL_ONLY_NAME) + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + + # verify status is clean and unmodified + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_required_post_checkout(overall, tree) + + def test_container_full(self): + """Verify that 'full' container with simple and mixed subrepos + generates the correct initial status. + + The mixed subrepo has a sub-externals file with different + sub-externals on different branches. + + """ + # create the test repository + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + + # create the top level externals file + self._generator.container_full(under_test_dir) + + # inital checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_full_pre_checkout(overall, tree) + + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_full_post_checkout(overall, tree) + + # update the mixed-use repo to point to different branch + self._generator.update_branch(under_test_dir, 'mixed_req', + 'new-feature', MIXED_REPO_NAME) + + # check status out of sync for mixed_req, but sub-externals + # are still in sync + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_full_pre_checkout_ext_change(overall, tree) + + # run the checkout. Now the mixed use external and it's + # sub-exterals should be changed. Returned status is + # pre-checkout! + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_full_pre_checkout_ext_change(overall, tree) + + # check status out of sync for mixed_req, and sub-externals + # are in sync. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_full_post_checkout(overall, tree) + + def test_container_component(self): + """Verify that optional component checkout works + """ + # create the test repository + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + + # create the top level externals file + self._generator.container_full(under_test_dir) + + # inital checkout, first try a nonexistant component argument noref + checkout_args = ['simp_opt', 'noref'] + checkout_args.extend(self.checkout_args) + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, checkout_args) + + checkout_args = ['simp_opt'] + checkout_args.extend(self.checkout_args) + + overall, tree = self.execute_cmd_in_dir(under_test_dir, + checkout_args) + + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_component_post_checkout(overall, tree) + checkout_args.append('simp_branch') + overall, tree = self.execute_cmd_in_dir(under_test_dir, + checkout_args) + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_component_post_checkout2(overall, tree) + + def test_mixed_simple(self): + """Verify that a mixed use repo can serve as a 'full' container, + pulling in a set of externals and a seperate set of sub-externals. + + """ + #import pdb; pdb.set_trace() + # create repository + under_test_dir = self.setup_test_repo(MIXED_REPO_NAME) + # create top level externals file + self._generator.mixed_simple_base(under_test_dir) + # NOTE: sub-externals file is already in the repo so we can + # switch branches during testing. Since this is a mixed-repo + # serving as the top level container repo, we can't switch + # during this test. + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_mixed_cont_simple_required_checkout(overall, tree) + + # verify status is clean and unmodified + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_mixed_cont_simple_required_post_checkout(overall, tree) + + +class TestSysCheckoutSVN(BaseTestSysCheckout): + """Run systems level tests of checkout_externals accessing svn repositories + + SVN tests - these tests use the svn repository interface. Since + they require an active network connection, they are significantly + slower than the git tests. But svn testing is critical. So try to + design the tests to only test svn repository functionality + (checkout, switch) and leave generic testing of functionality like + 'optional' to the fast git tests. + + Example timing as of 2017-11: + + * All other git and unit tests combined take between 4-5 seconds + + * Just checking if svn is available for a single test takes 2 seconds. + + * The single svn test typically takes between 10 and 25 seconds + (depending on the network)! + + NOTE(bja, 2017-11) To enable CI testing we can't use a real remote + repository that restricts access and it seems inappropriate to hit + a random open source repo. For now we are just hitting one of our + own github repos using the github svn server interface. This + should be "good enough" for basic checkout and swich + functionality. But if additional svn functionality is required, a + better solution will be necessary. I think eventually we want to + create a small local svn repository on the fly (doesn't require an + svn server or network connection!) and use it for testing. + + """ + + def _check_svn_branch_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/svn_branch'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_svn_branch_dirty(self, tree, directory=EXTERNALS_NAME): + name = './{0}/svn_branch'.format(directory) + self._check_generic_ok_dirty_required(tree, name) + + def _check_svn_tag_ok(self, tree, directory=EXTERNALS_NAME): + name = './{0}/svn_tag'.format(directory) + self._check_generic_ok_clean_required(tree, name) + + def _check_svn_tag_modified(self, tree, directory=EXTERNALS_NAME): + name = './{0}/svn_tag'.format(directory) + self._check_generic_modified_ok_required(tree, name) + + def _check_container_simple_svn_post_checkout(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_svn_branch_ok(tree) + self._check_svn_tag_ok(tree) + + def _check_container_simple_svn_sb_dirty_st_mod(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_svn_tag_modified(tree) + self._check_svn_branch_dirty(tree) + + def _check_container_simple_svn_sb_clean_st_mod(self, overall, tree): + self.assertEqual(overall, 0) + self._check_simple_tag_ok(tree) + self._check_svn_tag_modified(tree) + self._check_svn_branch_ok(tree) + + @staticmethod + def have_svn_access(): + """Check if we have svn access so we can enable tests that use svn. + + """ + have_svn = False + cmd = ['svn', 'ls', SVN_TEST_REPO, ] + try: + execute_subprocess(cmd) + have_svn = True + except BaseException: + pass + return have_svn + + def skip_if_no_svn_access(self): + """Function decorator to disable svn tests when svn isn't available + """ + have_svn = self.have_svn_access() + if not have_svn: + raise unittest.SkipTest("No svn access") + + def test_container_simple_svn(self): + """Verify that a container repo can pull in an svn branch and svn tag. + + """ + self.skip_if_no_svn_access() + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_svn(under_test_dir) + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + + # verify status is clean and unmodified + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_svn_post_checkout(overall, tree) + + # update description file to make the tag into a branch and + # trigger a switch + self._generator.update_svn_branch(under_test_dir, 'svn_tag', 'trunk') + + # checkout + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + + # verify status is clean and unmodified + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.status_args) + self._check_container_simple_svn_post_checkout(overall, tree) + + # add an untracked file to the repo + tracked = False + self._add_file_to_repo(under_test_dir, + 'externals/svn_branch/tmp.txt', tracked) + + # run a no-op checkout: pre-checkout status should be clean, + # ignoring the untracked file. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_svn_post_checkout(overall, tree) + + # update description file to make the branch into a tag and + # trigger a modified sync status + self._generator.update_svn_branch(under_test_dir, 'svn_tag', + 'tags/cesm2.0.beta07') + + # checkout: pre-checkout status should be clean and modified, + # will modify working copy. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.checkout_args) + self._check_container_simple_svn_sb_clean_st_mod(overall, tree) + + # verify status is still clean and unmodified, last + # checkout modified the working dir state. + overall, tree = self.execute_cmd_in_dir(under_test_dir, + self.verbose_args) + self._check_container_simple_svn_post_checkout(overall, tree) + +class TestSubrepoCheckout(BaseTestSysCheckout): + # Need to store information at setUp time for checking + # pylint: disable=too-many-instance-attributes + """Run tests to ensure proper handling of repos with submodules. + + By default, submodules in git repositories are checked out. A git + repository checked out as a submodule is treated as if it was + listed in an external with the same properties as in the source + .gitmodules file. + """ + + def setUp(self): + """Setup for all submodule checkout tests + Create a repo with two submodule repositories. + """ + + # Run the basic setup + super(TestSubrepoCheckout, self).setUp() + # create test repo + # We need to do this here (rather than have a static repo) because + # git submodules do not allow for variables in .gitmodules files + self._test_repo_name = 'test_repo_with_submodules' + self._bare_branch_name = 'subrepo_branch' + self._config_branch_name = 'subrepo_config_branch' + self._container_extern_name = 'externals_container.cfg' + self._my_test_dir = os.path.join(os.environ[MANIC_TEST_TMP_REPO_ROOT], + self._test_id) + self._repo_dir = os.path.join(self._my_test_dir, self._test_repo_name) + self._checkout_dir = 'repo_with_submodules' + check_dir = self.setup_test_repo(CONTAINER_REPO_NAME, + dest_dir_in=self._repo_dir) + self.assertTrue(self._repo_dir == check_dir) + # Add the submodules + cwd = os.getcwd() + fork_repo_dir = os.path.join(self._bare_root, SIMPLE_FORK_NAME) + simple_repo_dir = os.path.join(self._bare_root, SIMPLE_REPO_NAME) + self._simple_ext_fork_name = SIMPLE_FORK_NAME.split('.')[0] + self._simple_ext_name = SIMPLE_REPO_NAME.split('.')[0] + os.chdir(self._repo_dir) + # Add a branch with a subrepo + cmd = ['git', 'branch', self._bare_branch_name, 'master'] + execute_subprocess(cmd) + cmd = ['git', 'checkout', self._bare_branch_name] + execute_subprocess(cmd) + cmd = ['git', 'submodule', 'add', fork_repo_dir] + execute_subprocess(cmd) + cmd = ['git', 'commit', '-am', "'Added simple-ext-fork as a submodule'"] + execute_subprocess(cmd) + # Save the fork repo hash for comparison + os.chdir(self._simple_ext_fork_name) + self._fork_hash_check = self.get_git_hash() + os.chdir(self._repo_dir) + # Now, create a branch to test from_sbmodule + cmd = ['git', 'branch', + self._config_branch_name, self._bare_branch_name] + execute_subprocess(cmd) + cmd = ['git', 'checkout', self._config_branch_name] + execute_subprocess(cmd) + cmd = ['git', 'submodule', 'add', simple_repo_dir] + execute_subprocess(cmd) + # Checkout feature2 + os.chdir(self._simple_ext_name) + cmd = ['git', 'branch', 'feature2', 'origin/feature2'] + execute_subprocess(cmd) + cmd = ['git', 'checkout', 'feature2'] + execute_subprocess(cmd) + # Save the fork repo hash for comparison + self._simple_hash_check = self.get_git_hash() + os.chdir(self._repo_dir) + self.create_externals_file(filename=self._container_extern_name, + dest_dir=self._repo_dir, from_submodule=True) + cmd = ['git', 'add', self._container_extern_name] + execute_subprocess(cmd) + cmd = ['git', 'commit', '-am', "'Added simple-ext as a submodule'"] + execute_subprocess(cmd) + # Reset to master + cmd = ['git', 'checkout', 'master'] + execute_subprocess(cmd) + os.chdir(cwd) + + @staticmethod + def get_git_hash(revision="HEAD"): + """Return the hash for """ + cmd = ['git', 'rev-parse', revision] + git_out = execute_subprocess(cmd, output_to_caller=True) + return git_out.strip() + + def create_externals_file(self, name='', filename=CFG_NAME, dest_dir=None, + branch_name=None, sub_externals=None, + from_submodule=False): + # pylint: disable=too-many-arguments + """Create a container externals file with only simple externals. + + """ + self._generator.create_config() + + if dest_dir is None: + dest_dir = self._my_test_dir + + if from_submodule: + self._generator.create_section(SIMPLE_FORK_NAME, + self._simple_ext_fork_name, + from_submodule=True) + self._generator.create_section(SIMPLE_REPO_NAME, + self._simple_ext_name, + branch='feature3', path='', + from_submodule=False) + else: + if branch_name is None: + branch_name = 'master' + + self._generator.create_section(self._test_repo_name, + self._checkout_dir, + branch=branch_name, + path=name, externals=sub_externals, + repo_path=self._repo_dir) + + self._generator.write_config(dest_dir, filename=filename) + + def idempotence_check(self, checkout_dir): + """Verify that calling checkout_externals and + checkout_externals --status does not cause errors""" + cwd = os.getcwd() + os.chdir(checkout_dir) + overall, _ = self.execute_cmd_in_dir(self._my_test_dir, + self.checkout_args) + self.assertTrue(overall == 0) + overall, _ = self.execute_cmd_in_dir(self._my_test_dir, + self.status_args) + self.assertTrue(overall == 0) + os.chdir(cwd) + + def test_submodule_checkout_bare(self): + """Verify that a git repo with submodule is properly checked out + This test if for where there is no 'externals' keyword in the + parent repo. + Correct behavior is that the submodule is checked out using + normal git submodule behavior. + """ + simple_ext_fork_tag = "(tag1)" + simple_ext_fork_status = " " + self.create_externals_file(branch_name=self._bare_branch_name) + overall, _ = self.execute_cmd_in_dir(self._my_test_dir, + self.checkout_args) + self.assertTrue(overall == 0) + cwd = os.getcwd() + checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) + fork_file = os.path.join(checkout_dir, + self._simple_ext_fork_name, "readme.txt") + self.assertTrue(os.path.exists(fork_file)) + os.chdir(checkout_dir) + submods = git_submodule_status(checkout_dir) + self.assertEqual(len(submods.keys()), 1) + self.assertTrue(self._simple_ext_fork_name in submods) + submod = submods[self._simple_ext_fork_name] + self.assertTrue('hash' in submod) + self.assertEqual(submod['hash'], self._fork_hash_check) + self.assertTrue('status' in submod) + self.assertEqual(submod['status'], simple_ext_fork_status) + self.assertTrue('tag' in submod) + self.assertEqual(submod['tag'], simple_ext_fork_tag) + os.chdir(cwd) + self.idempotence_check(checkout_dir) + + def test_submodule_checkout_none(self): + """Verify that a git repo with submodule is properly checked out + This test is for when 'externals=None' is in parent repo's + externals cfg file. + Correct behavior is the submodle is not checked out. + """ + self.create_externals_file(branch_name=self._bare_branch_name, + sub_externals="none") + overall, _ = self.execute_cmd_in_dir(self._my_test_dir, + self.checkout_args) + self.assertTrue(overall == 0) + cwd = os.getcwd() + checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) + fork_file = os.path.join(checkout_dir, + self._simple_ext_fork_name, "readme.txt") + self.assertFalse(os.path.exists(fork_file)) + os.chdir(cwd) + self.idempotence_check(checkout_dir) + + def test_submodule_checkout_config(self): # pylint: disable=too-many-locals + """Verify that a git repo with submodule is properly checked out + This test if for when the 'from_submodule' keyword is used in the + parent repo. + Correct behavior is that the submodule is checked out using + normal git submodule behavior. + """ + tag_check = None # Not checked out as submodule + status_check = "-" # Not checked out as submodule + self.create_externals_file(branch_name=self._config_branch_name, + sub_externals=self._container_extern_name) + overall, _ = self.execute_cmd_in_dir(self._my_test_dir, + self.checkout_args) + self.assertTrue(overall == 0) + cwd = os.getcwd() + checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) + fork_file = os.path.join(checkout_dir, + self._simple_ext_fork_name, "readme.txt") + self.assertTrue(os.path.exists(fork_file)) + os.chdir(checkout_dir) + # Check submodule status + submods = git_submodule_status(checkout_dir) + self.assertEqual(len(submods.keys()), 2) + self.assertTrue(self._simple_ext_fork_name in submods) + submod = submods[self._simple_ext_fork_name] + self.assertTrue('hash' in submod) + self.assertEqual(submod['hash'], self._fork_hash_check) + self.assertTrue('status' in submod) + self.assertEqual(submod['status'], status_check) + self.assertTrue('tag' in submod) + self.assertEqual(submod['tag'], tag_check) + self.assertTrue(self._simple_ext_name in submods) + submod = submods[self._simple_ext_name] + self.assertTrue('hash' in submod) + self.assertEqual(submod['hash'], self._simple_hash_check) + self.assertTrue('status' in submod) + self.assertEqual(submod['status'], status_check) + self.assertTrue('tag' in submod) + self.assertEqual(submod['tag'], tag_check) + # Check fork repo status + os.chdir(self._simple_ext_fork_name) + self.assertEqual(self.get_git_hash(), self._fork_hash_check) + os.chdir(checkout_dir) + os.chdir(self._simple_ext_name) + hash_check = self.get_git_hash('origin/feature3') + self.assertEqual(self.get_git_hash(), hash_check) + os.chdir(cwd) + self.idempotence_check(checkout_dir) + +class TestSysCheckoutErrors(BaseTestSysCheckout): + """Run systems level tests of error conditions in checkout_externals + + Error conditions - these tests are designed to trigger specific + error conditions and ensure that they are being handled as + runtime errors (and hopefully usefull error messages) instead of + the default internal message that won't mean anything to the + user, e.g. key error, called process error, etc. + + These are not 'expected failures'. They are pass when a + RuntimeError is raised, fail if any other error is raised (or no + error is raised). + + """ + + # NOTE(bja, 2017-11) pylint complains about long method names, but + # it is hard to differentiate tests without making them more + # cryptic. + # pylint: disable=invalid-name + + def test_error_unknown_protocol(self): + """Verify that a runtime error is raised when the user specified repo + protocol is not known. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_protocol(under_test_dir, 'simp_branch', + 'this-protocol-does-not-exist') + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + def test_error_switch_protocol(self): + """Verify that a runtime error is raised when the user switches + protocols, git to svn. + + TODO(bja, 2017-11) This correctly results in an error, but it + isn't a helpful error message. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_protocol(under_test_dir, 'simp_branch', 'svn') + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + def test_error_unknown_tag(self): + """Verify that a runtime error is raised when the user specified tag + does not exist. + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_tag(under_test_dir, 'simp_branch', + 'this-tag-does-not-exist', SIMPLE_REPO_NAME) + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + def test_error_overspecify_tag_branch(self): + """Verify that a runtime error is raised when the user specified both + tag and a branch + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_tag(under_test_dir, 'simp_branch', + 'this-tag-does-not-exist', SIMPLE_REPO_NAME, + remove_branch=False) + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + def test_error_underspecify_tag_branch(self): + """Verify that a runtime error is raised when the user specified + neither a tag or a branch + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_underspecify_branch_tag(under_test_dir, + 'simp_branch') + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + def test_error_missing_url(self): + """Verify that a runtime error is raised when the user specified + neither a tag or a branch + + """ + # create repo + under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) + self._generator.container_simple_required(under_test_dir) + + # update the config file to point to a different remote with + # the tag instead of branch. Tag MUST NOT be in the original + # repo! + self._generator.update_underspecify_remove_url(under_test_dir, + 'simp_branch') + + with self.assertRaises(RuntimeError): + self.execute_cmd_in_dir(under_test_dir, self.checkout_args) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_sys_repository_git.py b/manage_externals/test/test_sys_repository_git.py new file mode 100644 index 0000000000..f6dbf84284 --- /dev/null +++ b/manage_externals/test/test_sys_repository_git.py @@ -0,0 +1,238 @@ +#!/usr/bin/env python + +"""Tests of some of the functionality in repository_git.py that actually +interacts with git repositories. + +We're calling these "system" tests because we expect them to be a lot +slower than most of the unit tests. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import shutil +import tempfile +import unittest + +from manic.repository_git import GitRepository +from manic.externals_description import ExternalsDescription +from manic.externals_description import ExternalsDescriptionDict +from manic.utils import execute_subprocess + +# NOTE(wjs, 2018-04-09) I find a mix of camel case and underscores to be +# more readable for unit test names, so I'm disabling pylint's naming +# convention check +# pylint: disable=C0103 + +# Allow access to protected members +# pylint: disable=W0212 + + +class GitTestCase(unittest.TestCase): + """Adds some git-specific unit test functionality on top of TestCase""" + + def assertIsHash(self, maybe_hash): + """Assert that the string given by maybe_hash really does look + like a git hash. + """ + + # Ensure it is non-empty + self.assertTrue(maybe_hash, msg="maybe_hash is empty") + + # Ensure it has a single string + self.assertEqual(1, len(maybe_hash.split()), + msg="maybe_hash has multiple strings: {}".format(maybe_hash)) + + # Ensure that the only characters in the string are ones allowed + # in hashes + allowed_chars_set = set('0123456789abcdef') + self.assertTrue(set(maybe_hash) <= allowed_chars_set, + msg="maybe_hash has non-hash characters: {}".format(maybe_hash)) + + +class TestGitTestCase(GitTestCase): + """Tests GitTestCase""" + + def test_assertIsHash_true(self): + """Ensure that assertIsHash passes for something that looks + like a hash""" + self.assertIsHash('abc123') + + def test_assertIsHash_empty(self): + """Ensure that assertIsHash raises an AssertionError for an + empty string""" + with self.assertRaises(AssertionError): + self.assertIsHash('') + + def test_assertIsHash_multipleStrings(self): + """Ensure that assertIsHash raises an AssertionError when + given multiple strings""" + with self.assertRaises(AssertionError): + self.assertIsHash('abc123 def456') + + def test_assertIsHash_badChar(self): + """Ensure that assertIsHash raises an AssertionError when given a + string that has a character that doesn't belong in a hash + """ + with self.assertRaises(AssertionError): + self.assertIsHash('abc123g') + + +class TestGitRepositoryGitCommands(GitTestCase): + """Test some git commands in RepositoryGit + + It's silly that we need to create a repository in order to test + these git commands. Much or all of the git functionality that is + currently in repository_git.py should eventually be moved to a + separate module that is solely responsible for wrapping git + commands; that would allow us to test it independently of this + repository class. + """ + + # ======================================================================== + # Test helper functions + # ======================================================================== + + def setUp(self): + # directory we want to return to after the test system and + # checkout_externals are done cd'ing all over the place. + self._return_dir = os.getcwd() + + self._tmpdir = tempfile.mkdtemp() + os.chdir(self._tmpdir) + + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + '/path/to/local/repo', + ExternalsDescription.TAG: + 'tag1', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'junk', + ExternalsDescription.EXTERNALS: '', + ExternalsDescription.REPO: rdata, + }, + } + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = GitRepository('test', repo) + + def tearDown(self): + # return to our common starting point + os.chdir(self._return_dir) + + shutil.rmtree(self._tmpdir, ignore_errors=True) + + @staticmethod + def make_git_repo(): + """Turn the current directory into an empty git repository""" + execute_subprocess(['git', 'init']) + + @staticmethod + def add_git_commit(): + """Add a git commit in the current directory""" + with open('README', 'a') as myfile: + myfile.write('more info') + execute_subprocess(['git', 'add', 'README']) + execute_subprocess(['git', 'commit', '-m', 'my commit message']) + + @staticmethod + def checkout_git_branch(branchname): + """Checkout a new branch in the current directory""" + execute_subprocess(['git', 'checkout', '-b', branchname]) + + @staticmethod + def make_git_tag(tagname): + """Make a lightweight tag at the current commit""" + execute_subprocess(['git', 'tag', '-m', 'making a tag', tagname]) + + @staticmethod + def checkout_ref(refname): + """Checkout the given refname in the current directory""" + execute_subprocess(['git', 'checkout', refname]) + + # ======================================================================== + # Begin actual tests + # ======================================================================== + + def test_currentHash_returnsHash(self): + """Ensure that the _git_current_hash function returns a hash""" + self.make_git_repo() + self.add_git_commit() + hash_found, myhash = self._repo._git_current_hash() + self.assertTrue(hash_found) + self.assertIsHash(myhash) + + def test_currentHash_outsideGitRepo(self): + """Ensure that the _git_current_hash function returns False when + outside a git repository""" + hash_found, myhash = self._repo._git_current_hash() + self.assertFalse(hash_found) + self.assertEqual('', myhash) + + def test_currentBranch_onBranch(self): + """Ensure that the _git_current_branch function returns the name + of the branch""" + self.make_git_repo() + self.add_git_commit() + self.checkout_git_branch('foo') + branch_found, mybranch = self._repo._git_current_branch() + self.assertTrue(branch_found) + self.assertEqual('foo', mybranch) + + def test_currentBranch_notOnBranch(self): + """Ensure that the _git_current_branch function returns False + when not on a branch""" + self.make_git_repo() + self.add_git_commit() + self.make_git_tag('mytag') + self.checkout_ref('mytag') + branch_found, mybranch = self._repo._git_current_branch() + self.assertFalse(branch_found) + self.assertEqual('', mybranch) + + def test_currentBranch_outsideGitRepo(self): + """Ensure that the _git_current_branch function returns False + when outside a git repository""" + branch_found, mybranch = self._repo._git_current_branch() + self.assertFalse(branch_found) + self.assertEqual('', mybranch) + + def test_currentTag_onTag(self): + """Ensure that the _git_current_tag function returns the name of + the tag""" + self.make_git_repo() + self.add_git_commit() + self.make_git_tag('some_tag') + tag_found, mytag = self._repo._git_current_tag() + self.assertTrue(tag_found) + self.assertEqual('some_tag', mytag) + + def test_currentTag_notOnTag(self): + """Ensure tha the _git_current_tag function returns False when + not on a tag""" + self.make_git_repo() + self.add_git_commit() + self.make_git_tag('some_tag') + self.add_git_commit() + tag_found, mytag = self._repo._git_current_tag() + self.assertFalse(tag_found) + self.assertEqual('', mytag) + + def test_currentTag_outsideGitRepo(self): + """Ensure that the _git_current_tag function returns False when + outside a git repository""" + tag_found, mytag = self._repo._git_current_tag() + self.assertFalse(tag_found) + self.assertEqual('', mytag) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_externals_description.py b/manage_externals/test/test_unit_externals_description.py new file mode 100644 index 0000000000..637f760ee5 --- /dev/null +++ b/manage_externals/test/test_unit_externals_description.py @@ -0,0 +1,401 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the checkout_externals.py module is +already in the python path. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import os.path +import shutil +import unittest + +try: + # python2 + from ConfigParser import SafeConfigParser as config_parser + + def config_string_cleaner(text): + """convert strings into unicode + """ + return text.decode('utf-8') +except ImportError: + # python3 + from configparser import ConfigParser as config_parser + + def config_string_cleaner(text): + """Python3 already uses unicode strings, so just return the string + without modification. + + """ + return text + +from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM +from manic.externals_description import ExternalsDescription +from manic.externals_description import ExternalsDescriptionDict +from manic.externals_description import ExternalsDescriptionConfigV1 +from manic.externals_description import get_cfg_schema_version +from manic.externals_description import read_externals_description_file +from manic.externals_description import create_externals_description + +from manic.global_constants import EMPTY_STR + + +class TestCfgSchemaVersion(unittest.TestCase): + """Test that schema identification for the externals description + returns the correct results. + + """ + + def setUp(self): + """Reusable config object + """ + self._config = config_parser() + self._config.add_section('section1') + self._config.set('section1', 'keword', 'value') + + self._config.add_section(DESCRIPTION_SECTION) + + def test_schema_version_valid(self): + """Test that schema identification returns the correct version for a + valid tag. + + """ + version_str = '2.1.3' + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, version_str) + major, minor, patch = get_cfg_schema_version(self._config) + expected_major = 2 + expected_minor = 1 + expected_patch = 3 + self.assertEqual(expected_major, major) + self.assertEqual(expected_minor, minor) + self.assertEqual(expected_patch, patch) + + def test_schema_section_missing(self): + """Test that an error is returned if the schema section is missing + from the input file. + + """ + self._config.remove_section(DESCRIPTION_SECTION) + with self.assertRaises(RuntimeError): + get_cfg_schema_version(self._config) + + def test_schema_version_missing(self): + """Test that a externals description file without a version raises a + runtime error. + + """ + # Note: the default setup method shouldn't include a version + # keyword, but remove it just to be future proof.... + self._config.remove_option(DESCRIPTION_SECTION, VERSION_ITEM) + with self.assertRaises(RuntimeError): + get_cfg_schema_version(self._config) + + def test_schema_version_not_int(self): + """Test that a externals description file a version that doesn't + decompose to integer major, minor and patch versions raises + runtime error. + + """ + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, 'unknown') + with self.assertRaises(RuntimeError): + get_cfg_schema_version(self._config) + + +class TestModelDescritionConfigV1(unittest.TestCase): + """Test that parsing config/ini fileproduces a correct dictionary + for the externals description. + + """ + # pylint: disable=R0902 + + def setUp(self): + """Boiler plate construction of string containing xml for multiple components. + """ + self._comp1_name = 'comp1' + self._comp1_path = 'path/to/comp1' + self._comp1_protocol = 'svn' + self._comp1_url = 'https://svn.somewhere.com/path/of/comp1' + self._comp1_tag = 'a_nice_tag_v1' + self._comp1_is_required = 'True' + self._comp1_externals = '' + + self._comp2_name = 'comp2' + self._comp2_path = 'path/to/comp2' + self._comp2_protocol = 'git' + self._comp2_url = '/local/clone/of/comp2' + self._comp2_branch = 'a_very_nice_branch' + self._comp2_is_required = 'False' + self._comp2_externals = 'path/to/comp2.cfg' + + def _setup_comp1(self, config): + """Boiler plate construction of xml string for componet 1 + """ + config.add_section(self._comp1_name) + config.set(self._comp1_name, 'local_path', self._comp1_path) + config.set(self._comp1_name, 'protocol', self._comp1_protocol) + config.set(self._comp1_name, 'repo_url', self._comp1_url) + config.set(self._comp1_name, 'tag', self._comp1_tag) + config.set(self._comp1_name, 'required', self._comp1_is_required) + + def _setup_comp2(self, config): + """Boiler plate construction of xml string for componet 2 + """ + config.add_section(self._comp2_name) + config.set(self._comp2_name, 'local_path', self._comp2_path) + config.set(self._comp2_name, 'protocol', self._comp2_protocol) + config.set(self._comp2_name, 'repo_url', self._comp2_url) + config.set(self._comp2_name, 'branch', self._comp2_branch) + config.set(self._comp2_name, 'required', self._comp2_is_required) + config.set(self._comp2_name, 'externals', self._comp2_externals) + + @staticmethod + def _setup_externals_description(config): + """Add the required exernals description section + """ + + config.add_section(DESCRIPTION_SECTION) + config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.1') + + def _check_comp1(self, model): + """Test that component one was constructed correctly. + """ + self.assertTrue(self._comp1_name in model) + comp1 = model[self._comp1_name] + self.assertEqual(comp1[ExternalsDescription.PATH], self._comp1_path) + self.assertTrue(comp1[ExternalsDescription.REQUIRED]) + repo = comp1[ExternalsDescription.REPO] + self.assertEqual(repo[ExternalsDescription.PROTOCOL], + self._comp1_protocol) + self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp1_url) + self.assertEqual(repo[ExternalsDescription.TAG], self._comp1_tag) + self.assertEqual(EMPTY_STR, comp1[ExternalsDescription.EXTERNALS]) + + def _check_comp2(self, model): + """Test that component two was constucted correctly. + """ + self.assertTrue(self._comp2_name in model) + comp2 = model[self._comp2_name] + self.assertEqual(comp2[ExternalsDescription.PATH], self._comp2_path) + self.assertFalse(comp2[ExternalsDescription.REQUIRED]) + repo = comp2[ExternalsDescription.REPO] + self.assertEqual(repo[ExternalsDescription.PROTOCOL], + self._comp2_protocol) + self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp2_url) + self.assertEqual(repo[ExternalsDescription.BRANCH], self._comp2_branch) + self.assertEqual(self._comp2_externals, + comp2[ExternalsDescription.EXTERNALS]) + + def test_one_tag_required(self): + """Test that a component source with a tag is correctly parsed. + """ + config = config_parser() + self._setup_comp1(config) + self._setup_externals_description(config) + model = ExternalsDescriptionConfigV1(config) + print(model) + self._check_comp1(model) + + def test_one_branch_externals(self): + """Test that a component source with a branch is correctly parsed. + """ + config = config_parser() + self._setup_comp2(config) + self._setup_externals_description(config) + model = ExternalsDescriptionConfigV1(config) + print(model) + self._check_comp2(model) + + def test_two_sources(self): + """Test that multiple component sources are correctly parsed. + """ + config = config_parser() + self._setup_comp1(config) + self._setup_comp2(config) + self._setup_externals_description(config) + model = ExternalsDescriptionConfigV1(config) + print(model) + self._check_comp1(model) + self._check_comp2(model) + + def test_cfg_v1_reject_unknown_item(self): + """Test that a v1 description object will reject unknown items + """ + config = config_parser() + self._setup_comp1(config) + self._setup_externals_description(config) + config.set(self._comp1_name, 'junk', 'foobar') + with self.assertRaises(RuntimeError): + ExternalsDescriptionConfigV1(config) + + def test_cfg_v1_reject_v2(self): + """Test that a v1 description object won't try to parse a v2 file. + """ + config = config_parser() + self._setup_comp1(config) + self._setup_externals_description(config) + config.set(DESCRIPTION_SECTION, VERSION_ITEM, '2.0.1') + with self.assertRaises(RuntimeError): + ExternalsDescriptionConfigV1(config) + + def test_cfg_v1_reject_v1_too_new(self): + """Test that a v1 description object won't try to parse a v2 file. + """ + config = config_parser() + self._setup_comp1(config) + self._setup_externals_description(config) + config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.100.0') + with self.assertRaises(RuntimeError): + ExternalsDescriptionConfigV1(config) + + +class TestReadExternalsDescription(unittest.TestCase): + """Test the application logic of read_externals_description_file + """ + TMP_FAKE_DIR = 'fake' + + def setUp(self): + """Setup directory for tests + """ + if not os.path.exists(self.TMP_FAKE_DIR): + os.makedirs(self.TMP_FAKE_DIR) + + def tearDown(self): + """Cleanup tmp stuff on the file system + """ + if os.path.exists(self.TMP_FAKE_DIR): + shutil.rmtree(self.TMP_FAKE_DIR) + + def test_no_file_error(self): + """Test that a runtime error is raised when the file does not exist + + """ + root_dir = os.getcwd() + filename = 'this-file-should-not-exist' + with self.assertRaises(RuntimeError): + read_externals_description_file(root_dir, filename) + + def test_no_dir_error(self): + """Test that a runtime error is raised when the file does not exist + + """ + root_dir = '/path/to/some/repo' + filename = 'externals.cfg' + with self.assertRaises(RuntimeError): + read_externals_description_file(root_dir, filename) + + def test_no_invalid_error(self): + """Test that a runtime error is raised when the file format is invalid + + """ + root_dir = os.getcwd() + filename = 'externals.cfg' + file_path = os.path.join(root_dir, filename) + file_path = os.path.abspath(file_path) + contents = """ + +invalid file format +""" + with open(file_path, 'w') as fhandle: + fhandle.write(contents) + with self.assertRaises(RuntimeError): + read_externals_description_file(root_dir, filename) + os.remove(file_path) + + +class TestCreateExternalsDescription(unittest.TestCase): + """Test the application logic of creat_externals_description + """ + + def setUp(self): + """Create config object used as basis for all tests + """ + self._config = config_parser() + self._gmconfig = config_parser() + self.setup_config() + + def setup_config(self): + """Boiler plate construction of xml string for componet 1 + """ + # Create a standard externals config with a single external + name = 'test' + self._config.add_section(name) + self._config.set(name, ExternalsDescription.PATH, 'externals') + self._config.set(name, ExternalsDescription.PROTOCOL, 'git') + self._config.set(name, ExternalsDescription.REPO_URL, '/path/to/repo') + self._config.set(name, ExternalsDescription.TAG, 'test_tag') + self._config.set(name, ExternalsDescription.REQUIRED, 'True') + + self._config.add_section(DESCRIPTION_SECTION) + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') + + # Create a .gitmodules test + name = 'submodule "gitmodules_test"' + self._gmconfig.add_section(name) + self._gmconfig.set(name, "path", 'externals/test') + self._gmconfig.set(name, "url", '/path/to/repo') + # NOTE(goldy, 2019-03) Should test other possible keywords such as + # fetchRecurseSubmodules, ignore, and shallow + + def test_cfg_v1_ok(self): + """Test that a correct cfg v1 object is created by create_externals_description + + """ + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.3') + ext = create_externals_description(self._config, model_format='cfg') + self.assertIsInstance(ext, ExternalsDescriptionConfigV1) + + def test_cfg_v1_unknown_version(self): + """Test that a config file with unknown schema version is rejected by + create_externals_description. + + """ + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '100.0.3') + with self.assertRaises(RuntimeError): + create_externals_description(self._config, model_format='cfg') + + def test_dict(self): + """Test that a correct cfg v1 object is created by create_externals_description + + """ + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: '/path/to/repo', + ExternalsDescription.TAG: 'tagv1', + } + + desc = { + 'test': { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: '../fake', + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, }, + } + + ext = create_externals_description(desc, model_format='dict') + self.assertIsInstance(ext, ExternalsDescriptionDict) + + def test_cfg_unknown_version(self): + """Test that a runtime error is raised when an unknown file version is + received + + """ + self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '123.456.789') + with self.assertRaises(RuntimeError): + create_externals_description(self._config, model_format='cfg') + + def test_cfg_unknown_format(self): + """Test that a runtime error is raised when an unknown format string is + received + + """ + with self.assertRaises(RuntimeError): + create_externals_description(self._config, model_format='unknown') + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_externals_status.py b/manage_externals/test/test_unit_externals_status.py new file mode 100644 index 0000000000..f8e953f756 --- /dev/null +++ b/manage_externals/test/test_unit_externals_status.py @@ -0,0 +1,299 @@ +#!/usr/bin/env python + +"""Unit test driver for the manic external status reporting module. + +Note: this script assumes the path to the manic package is already in +the python path. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import unittest + +from manic.externals_status import ExternalStatus + + +class TestStatusObject(unittest.TestCase): + """Verify that the Status object behaives as expected. + """ + + def test_exists_empty_all(self): + """If the repository sync-state is empty (doesn't exist), and there is no + clean state, then it is considered not to exist. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.EMPTY + stat.clean_state = ExternalStatus.DEFAULT + exists = stat.exists() + self.assertFalse(exists) + + stat.clean_state = ExternalStatus.EMPTY + exists = stat.exists() + self.assertFalse(exists) + + stat.clean_state = ExternalStatus.UNKNOWN + exists = stat.exists() + self.assertFalse(exists) + + # this state represtens an internal logic error in how the + # repo status was determined. + stat.clean_state = ExternalStatus.STATUS_OK + exists = stat.exists() + self.assertTrue(exists) + + # this state represtens an internal logic error in how the + # repo status was determined. + stat.clean_state = ExternalStatus.DIRTY + exists = stat.exists() + self.assertTrue(exists) + + def test_exists_default_all(self): + """If the repository sync-state is default, then it is considered to exist + regardless of clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.DEFAULT + stat.clean_state = ExternalStatus.DEFAULT + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.EMPTY + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.UNKNOWN + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.STATUS_OK + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.DIRTY + exists = stat.exists() + self.assertTrue(exists) + + def test_exists_unknown_all(self): + """If the repository sync-state is unknown, then it is considered to exist + regardless of clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.UNKNOWN + stat.clean_state = ExternalStatus.DEFAULT + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.EMPTY + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.UNKNOWN + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.STATUS_OK + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.DIRTY + exists = stat.exists() + self.assertTrue(exists) + + def test_exists_modified_all(self): + """If the repository sync-state is modified, then it is considered to exist + regardless of clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.MODEL_MODIFIED + stat.clean_state = ExternalStatus.DEFAULT + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.EMPTY + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.UNKNOWN + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.STATUS_OK + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.DIRTY + exists = stat.exists() + self.assertTrue(exists) + + def test_exists_ok_all(self): + """If the repository sync-state is ok, then it is considered to exist + regardless of clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.STATUS_OK + stat.clean_state = ExternalStatus.DEFAULT + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.EMPTY + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.UNKNOWN + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.STATUS_OK + exists = stat.exists() + self.assertTrue(exists) + + stat.clean_state = ExternalStatus.DIRTY + exists = stat.exists() + self.assertTrue(exists) + + def test_update_ok_all(self): + """If the repository in-sync is ok, then it is safe to + update only if clean state is ok + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.STATUS_OK + stat.clean_state = ExternalStatus.DEFAULT + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.EMPTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.UNKNOWN + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.STATUS_OK + safe_to_update = stat.safe_to_update() + self.assertTrue(safe_to_update) + + stat.clean_state = ExternalStatus.DIRTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + def test_update_modified_all(self): + """If the repository in-sync is modified, then it is safe to + update only if clean state is ok + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.MODEL_MODIFIED + stat.clean_state = ExternalStatus.DEFAULT + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.EMPTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.UNKNOWN + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.STATUS_OK + safe_to_update = stat.safe_to_update() + self.assertTrue(safe_to_update) + + stat.clean_state = ExternalStatus.DIRTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + def test_update_unknown_all(self): + """If the repository in-sync is unknown, then it is not safe to + update, regardless of the clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.UNKNOWN + stat.clean_state = ExternalStatus.DEFAULT + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.EMPTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.UNKNOWN + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.STATUS_OK + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.DIRTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + def test_update_default_all(self): + """If the repository in-sync is default, then it is not safe to + update, regardless of the clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.UNKNOWN + stat.clean_state = ExternalStatus.DEFAULT + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.EMPTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.UNKNOWN + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.STATUS_OK + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.DIRTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + def test_update_empty_all(self): + """If the repository in-sync is empty, then it is not safe to + update, regardless of the clean state. + + """ + stat = ExternalStatus() + stat.sync_state = ExternalStatus.UNKNOWN + stat.clean_state = ExternalStatus.DEFAULT + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.EMPTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.UNKNOWN + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.STATUS_OK + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + stat.clean_state = ExternalStatus.DIRTY + safe_to_update = stat.safe_to_update() + self.assertFalse(safe_to_update) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_repository.py b/manage_externals/test/test_unit_repository.py new file mode 100644 index 0000000000..2152503c2d --- /dev/null +++ b/manage_externals/test/test_unit_repository.py @@ -0,0 +1,197 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the checkout_externals.py module is +already in the python path. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import unittest + +from manic.repository_factory import create_repository +from manic.repository_git import GitRepository +from manic.repository_svn import SvnRepository +from manic.repository import Repository +from manic.externals_description import ExternalsDescription +from manic.global_constants import EMPTY_STR + + +class TestCreateRepositoryDict(unittest.TestCase): + """Test the create_repository functionality to ensure it returns the + propper type of repository and errors for unknown repository + types. + + """ + + def setUp(self): + """Common data needed for all tests in this class + """ + self._name = 'test_name' + self._repo = {ExternalsDescription.PROTOCOL: None, + ExternalsDescription.REPO_URL: 'junk_root', + ExternalsDescription.TAG: 'junk_tag', + ExternalsDescription.BRANCH: EMPTY_STR, + ExternalsDescription.HASH: EMPTY_STR, } + + def test_create_repo_git(self): + """Verify that several possible names for the 'git' protocol + create git repository objects. + + """ + protocols = ['git', 'GIT', 'Git', ] + for protocol in protocols: + self._repo[ExternalsDescription.PROTOCOL] = protocol + repo = create_repository(self._name, self._repo) + self.assertIsInstance(repo, GitRepository) + + def test_create_repo_svn(self): + """Verify that several possible names for the 'svn' protocol + create svn repository objects. + """ + protocols = ['svn', 'SVN', 'Svn', ] + for protocol in protocols: + self._repo[ExternalsDescription.PROTOCOL] = protocol + repo = create_repository(self._name, self._repo) + self.assertIsInstance(repo, SvnRepository) + + def test_create_repo_externals_only(self): + """Verify that an externals only repo returns None. + """ + protocols = ['externals_only', ] + for protocol in protocols: + self._repo[ExternalsDescription.PROTOCOL] = protocol + repo = create_repository(self._name, self._repo) + self.assertEqual(None, repo) + + def test_create_repo_unsupported(self): + """Verify that an unsupported protocol generates a runtime error. + """ + protocols = ['not_a_supported_protocol', ] + for protocol in protocols: + self._repo[ExternalsDescription.PROTOCOL] = protocol + with self.assertRaises(RuntimeError): + create_repository(self._name, self._repo) + + +class TestRepository(unittest.TestCase): + """Test the externals description processing used to create the Repository + base class shared by protocol specific repository classes. + + """ + + def test_tag(self): + """Test creation of a repository object with a tag + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + tag = 'test_tag' + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.TAG: tag, + ExternalsDescription.BRANCH: EMPTY_STR, + ExternalsDescription.HASH: EMPTY_STR, } + repo = Repository(name, repo_info) + print(repo.__dict__) + self.assertEqual(repo.tag(), tag) + self.assertEqual(repo.url(), url) + + def test_branch(self): + """Test creation of a repository object with a branch + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + branch = 'test_branch' + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.BRANCH: branch, + ExternalsDescription.TAG: EMPTY_STR, + ExternalsDescription.HASH: EMPTY_STR, } + repo = Repository(name, repo_info) + print(repo.__dict__) + self.assertEqual(repo.branch(), branch) + self.assertEqual(repo.url(), url) + + def test_hash(self): + """Test creation of a repository object with a hash + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + ref = 'deadc0de' + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.BRANCH: EMPTY_STR, + ExternalsDescription.TAG: EMPTY_STR, + ExternalsDescription.HASH: ref, } + repo = Repository(name, repo_info) + print(repo.__dict__) + self.assertEqual(repo.hash(), ref) + self.assertEqual(repo.url(), url) + + def test_tag_branch(self): + """Test creation of a repository object with a tag and branch raises a + runtimer error. + + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + branch = 'test_branch' + tag = 'test_tag' + ref = EMPTY_STR + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.BRANCH: branch, + ExternalsDescription.TAG: tag, + ExternalsDescription.HASH: ref, } + with self.assertRaises(RuntimeError): + Repository(name, repo_info) + + def test_tag_branch_hash(self): + """Test creation of a repository object with a tag, branch and hash raises a + runtimer error. + + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + branch = 'test_branch' + tag = 'test_tag' + ref = 'deadc0de' + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.BRANCH: branch, + ExternalsDescription.TAG: tag, + ExternalsDescription.HASH: ref, } + with self.assertRaises(RuntimeError): + Repository(name, repo_info) + + def test_no_tag_no_branch(self): + """Test creation of a repository object without a tag or branch raises a + runtimer error. + + """ + name = 'test_repo' + protocol = 'test_protocol' + url = 'test_url' + branch = EMPTY_STR + tag = EMPTY_STR + ref = EMPTY_STR + repo_info = {ExternalsDescription.PROTOCOL: protocol, + ExternalsDescription.REPO_URL: url, + ExternalsDescription.BRANCH: branch, + ExternalsDescription.TAG: tag, + ExternalsDescription.HASH: ref, } + with self.assertRaises(RuntimeError): + Repository(name, repo_info) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_repository_git.py b/manage_externals/test/test_unit_repository_git.py new file mode 100644 index 0000000000..b025fbd429 --- /dev/null +++ b/manage_externals/test/test_unit_repository_git.py @@ -0,0 +1,807 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the checkout_externals.py module is +already in the python path. + +""" +# pylint: disable=too-many-lines,protected-access + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import shutil +import unittest + +from manic.repository_git import GitRepository +from manic.externals_status import ExternalStatus +from manic.externals_description import ExternalsDescription +from manic.externals_description import ExternalsDescriptionDict +from manic.global_constants import EMPTY_STR + +# NOTE(bja, 2017-11) order is important here. origin should be a +# subset of other to trap errors on processing remotes! +GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM = ''' +upstream /path/to/other/repo (fetch) +upstream /path/to/other/repo (push) +other /path/to/local/repo2 (fetch) +other /path/to/local/repo2 (push) +origin /path/to/local/repo (fetch) +origin /path/to/local/repo (push) +''' + + +class TestGitRepositoryCurrentRef(unittest.TestCase): + """test the current_ref command on a git repository + """ + + def setUp(self): + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + '/path/to/local/repo', + ExternalsDescription.TAG: + 'tag1', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'junk', + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = GitRepository('test', repo) + + # + # mock methods replacing git system calls + # + @staticmethod + def _git_current_branch(branch_found, branch_name): + """Return a function that takes the place of + repo._git_current_branch, which returns the given output.""" + def my_git_current_branch(): + """mock function that can take the place of repo._git_current_branch""" + return branch_found, branch_name + return my_git_current_branch + + @staticmethod + def _git_current_tag(tag_found, tag_name): + """Return a function that takes the place of + repo._git_current_tag, which returns the given output.""" + def my_git_current_tag(): + """mock function that can take the place of repo._git_current_tag""" + return tag_found, tag_name + return my_git_current_tag + + @staticmethod + def _git_current_hash(hash_found, hash_name): + """Return a function that takes the place of + repo._git_current_hash, which returns the given output.""" + def my_git_current_hash(): + """mock function that can take the place of repo._git_current_hash""" + return hash_found, hash_name + return my_git_current_hash + + # ------------------------------------------------------------------------ + # Begin tests + # ------------------------------------------------------------------------ + + def test_ref_branch(self): + """Test that we correctly identify we are on a branch + """ + self._repo._git_current_branch = self._git_current_branch( + True, 'feature3') + self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') + self._repo._git_current_hash = self._git_current_hash(True, 'abc123') + expected = 'feature3' + result = self._repo._current_ref() + self.assertEqual(result, expected) + + def test_ref_detached_tag(self): + """Test that we correctly identify that the ref is detached at a tag + """ + self._repo._git_current_branch = self._git_current_branch(False, '') + self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') + self._repo._git_current_hash = self._git_current_hash(True, 'abc123') + expected = 'foo_tag' + result = self._repo._current_ref() + self.assertEqual(result, expected) + + def test_ref_detached_hash(self): + """Test that we can identify ref is detached at a hash + + """ + self._repo._git_current_branch = self._git_current_branch(False, '') + self._repo._git_current_tag = self._git_current_tag(False, '') + self._repo._git_current_hash = self._git_current_hash(True, 'abc123') + expected = 'abc123' + result = self._repo._current_ref() + self.assertEqual(result, expected) + + def test_ref_none(self): + """Test that we correctly identify that we're not in a git repo. + """ + self._repo._git_current_branch = self._git_current_branch(False, '') + self._repo._git_current_tag = self._git_current_tag(False, '') + self._repo._git_current_hash = self._git_current_hash(False, '') + result = self._repo._current_ref() + self.assertEqual(result, EMPTY_STR) + + +class TestGitRepositoryCheckSync(unittest.TestCase): + """Test whether the GitRepository _check_sync_logic functionality is + correct. + + Note: there are a lot of combinations of state: + + - external description - tag, branch + + - working copy + - doesn't exist (not checked out) + - exists, no git info - incorrect protocol, e.g. svn, or tarball? + - exists, git info + - as expected: + - different from expected: + - detached tag, + - detached hash, + - detached branch (compare remote and branch), + - tracking branch (compare remote and branch), + - same remote + - different remote + - untracked branch + + Test list: + - doesn't exist + - exists no git info + + - num_external * (working copy expected + num_working copy different) + - total tests = 16 + + """ + + # NOTE(bja, 2017-11) pylint complains about long method names, but + # it is hard to differentiate tests without making them more + # cryptic. Also complains about too many public methods, but it + # doesn't really make sense to break this up. + # pylint: disable=invalid-name,too-many-public-methods + + TMP_FAKE_DIR = 'fake' + TMP_FAKE_GIT_DIR = os.path.join(TMP_FAKE_DIR, '.git') + + def setUp(self): + """Setup reusable git repository object + """ + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + '/path/to/local/repo', + ExternalsDescription.TAG: 'tag1', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: self.TMP_FAKE_DIR, + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = GitRepository('test', repo) + # The unit tests here don't care about the result of + # _current_ref, but we replace it here so that we don't need to + # worry about calling a possibly slow and possibly + # error-producing command (since _current_ref calls various git + # functions): + self._repo._current_ref = self._current_ref_empty + self._create_tmp_git_dir() + + def tearDown(self): + """Cleanup tmp stuff on the file system + """ + self._remove_tmp_git_dir() + + def _create_tmp_git_dir(self): + """Create a temporary fake git directory for testing purposes. + """ + if not os.path.exists(self.TMP_FAKE_GIT_DIR): + os.makedirs(self.TMP_FAKE_GIT_DIR) + + def _remove_tmp_git_dir(self): + """Remove the temporary fake git directory + """ + if os.path.exists(self.TMP_FAKE_DIR): + shutil.rmtree(self.TMP_FAKE_DIR) + + # + # mock methods replacing git system calls + # + @staticmethod + def _current_ref_empty(): + """Return an empty string. + """ + return EMPTY_STR + + @staticmethod + def _git_remote_origin_upstream(): + """Return an info string that is a checkout hash + """ + return GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM + + @staticmethod + def _git_remote_none(): + """Return an info string that is a checkout hash + """ + return EMPTY_STR + + @staticmethod + def _git_current_hash(myhash): + """Return a function that takes the place of repo._git_current_hash, + which returns the given hash + """ + def my_git_current_hash(): + """mock function that can take the place of repo._git_current_hash""" + return 0, myhash + return my_git_current_hash + + def _git_revparse_commit(self, expected_ref, mystatus, myhash): + """Return a function that takes the place of + repo._git_revparse_commit, which returns a tuple: + (mystatus, myhash). + + Expects the passed-in ref to equal expected_ref + + status = 0 implies success, non-zero implies failure + """ + def my_git_revparse_commit(ref): + """mock function that can take the place of repo._git_revparse_commit""" + self.assertEqual(expected_ref, ref) + return mystatus, myhash + return my_git_revparse_commit + + # ---------------------------------------------------------------- + # + # Tests where working copy doesn't exist or is invalid + # + # ---------------------------------------------------------------- + def test_sync_dir_not_exist(self): + """Test that a directory that doesn't exist returns an error status + + Note: the Repository classes should be prevented from ever + working on an empty directory by the _Source object. + + """ + stat = ExternalStatus() + self._repo._check_sync(stat, 'invalid_directory_name') + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) + # check_dir should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_dir_exist_no_git_info(self): + """Test that a non-existent git repo returns an unknown status + """ + stat = ExternalStatus() + # Now we over-ride the _git_remote_verbose method on the repo to return + # a known value without requiring access to git. + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = 'tag1' + self._repo._git_current_hash = self._git_current_hash('') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'tag1', 1, '') + self._repo._check_sync(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + # ------------------------------------------------------------------------ + # + # Tests where version in configuration file is not a valid reference + # + # ------------------------------------------------------------------------ + + def test_sync_invalid_reference(self): + """Test that an invalid reference returns out-of-sync + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = 'tag1' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'tag1', 1, '') + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + # ---------------------------------------------------------------- + # + # Tests where external description specifies a tag + # + # ---------------------------------------------------------------- + def test_sync_tag_on_same_hash(self): + """Test expect tag on same hash --> status ok + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = 'tag1' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'tag1', 0, 'abc123') + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_tag_on_different_hash(self): + """Test expect tag on a different hash --> status modified + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = 'tag1' + self._repo._git_current_hash = self._git_current_hash('def456') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'tag1', 0, 'abc123') + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + # ---------------------------------------------------------------- + # + # Tests where external description specifies a hash + # + # ---------------------------------------------------------------- + def test_sync_hash_on_same_hash(self): + """Test expect hash on same hash --> status ok + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = '' + self._repo._hash = 'abc' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'abc', 0, 'abc123') + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_hash_on_different_hash(self): + """Test expect hash on a different hash --> status modified + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._tag = '' + self._repo._hash = 'abc' + self._repo._git_current_hash = self._git_current_hash('def456') + self._repo._git_revparse_commit = self._git_revparse_commit( + 'abc', 0, 'abc123') + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + # ---------------------------------------------------------------- + # + # Tests where external description specifies a branch + # + # ---------------------------------------------------------------- + def test_sync_branch_on_same_hash(self): + """Test expect branch on same hash --> status ok + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature-2' + self._repo._tag = '' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('origin/feature-2', 0, 'abc123')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_branch_on_diff_hash(self): + """Test expect branch on diff hash --> status modified + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature-2' + self._repo._tag = '' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('origin/feature-2', 0, 'def456')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_branch_diff_remote(self): + """Test _determine_remote_name with a different remote + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature-2' + self._repo._tag = '' + self._repo._url = '/path/to/other/repo' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('upstream/feature-2', 0, 'def456')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + # The test passes if _git_revparse_commit is called with the + # expected argument + + def test_sync_branch_diff_remote2(self): + """Test _determine_remote_name with a different remote + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature-2' + self._repo._tag = '' + self._repo._url = '/path/to/local/repo2' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('other/feature-2', 0, 'def789')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + # The test passes if _git_revparse_commit is called with the + # expected argument + + def test_sync_branch_on_unknown_remote(self): + """Test expect branch, but remote is unknown --> status modified + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature-2' + self._repo._tag = '' + self._repo._url = '/path/to/unknown/repo' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('unknown_remote/feature-2', 1, '')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_sync_branch_on_untracked_local(self): + """Test expect branch, on untracked branch in local repo --> status ok + + Setting the externals description to '.' indicates that the + user only wants to consider the current local repo state + without fetching from remotes. This is required to preserve + the current branch of a repository during an update. + + """ + stat = ExternalStatus() + self._repo._git_remote_verbose = self._git_remote_origin_upstream + self._repo._branch = 'feature3' + self._repo._tag = '' + self._repo._url = '.' + self._repo._git_current_hash = self._git_current_hash('abc123') + self._repo._git_revparse_commit = ( + self._git_revparse_commit('feature3', 0, 'abc123')) + self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) + # check_sync should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + +class TestGitStatusPorcelain(unittest.TestCase): + """Test parsing of output from git status --porcelain=v1 -z + """ + # pylint: disable=C0103 + GIT_STATUS_PORCELAIN_V1_ALL = ( + r' D INSTALL\0MM Makefile\0M README.md\0R cmakelists.txt\0' + r'CMakeLists.txt\0D commit-message-template.txt\0A stuff.txt\0' + r'?? junk.txt') + + GIT_STATUS_PORCELAIN_CLEAN = r'' + + def test_porcelain_status_dirty(self): + """Verify that git status output is considered dirty when there are + listed files. + + """ + git_output = self.GIT_STATUS_PORCELAIN_V1_ALL + is_dirty = GitRepository._status_v1z_is_dirty(git_output) + self.assertTrue(is_dirty) + + def test_porcelain_status_clean(self): + """Verify that git status output is considered clean when there are no + listed files. + + """ + git_output = self.GIT_STATUS_PORCELAIN_CLEAN + is_dirty = GitRepository._status_v1z_is_dirty(git_output) + self.assertFalse(is_dirty) + + +class TestGitCreateRemoteName(unittest.TestCase): + """Test the create_remote_name method on the GitRepository class + """ + + def setUp(self): + """Common infrastructure for testing _create_remote_name + """ + self._rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + 'empty', + ExternalsDescription.TAG: + 'very_useful_tag', + ExternalsDescription.BRANCH: EMPTY_STR, + ExternalsDescription.HASH: EMPTY_STR, } + self._repo = GitRepository('test', self._rdata) + + def test_remote_git_proto(self): + """Test remote with git protocol + """ + self._repo._url = 'git@git.github.com:very_nice_org/useful_repo' + remote_name = self._repo._create_remote_name() + self.assertEqual(remote_name, 'very_nice_org_useful_repo') + + def test_remote_https_proto(self): + """Test remote with git protocol + """ + self._repo._url = 'https://www.github.com/very_nice_org/useful_repo' + remote_name = self._repo._create_remote_name() + self.assertEqual(remote_name, 'very_nice_org_useful_repo') + + def test_remote_local_abs(self): + """Test remote with git protocol + """ + self._repo._url = '/path/to/local/repositories/useful_repo' + remote_name = self._repo._create_remote_name() + self.assertEqual(remote_name, 'repositories_useful_repo') + + def test_remote_local_rel(self): + """Test remote with git protocol + """ + os.environ['TEST_VAR'] = '/my/path/to/repos' + self._repo._url = '${TEST_VAR}/../../useful_repo' + remote_name = self._repo._create_remote_name() + self.assertEqual(remote_name, 'path_useful_repo') + del os.environ['TEST_VAR'] + + +class TestVerifyTag(unittest.TestCase): + """Test logic verifying that a tag exists and is unique + + """ + + def setUp(self): + """Setup reusable git repository object + """ + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + '/path/to/local/repo', + ExternalsDescription.TAG: 'tag1', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'tmp', + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = GitRepository('test', repo) + + @staticmethod + def _shell_true(url, remote=None): + _ = url + _ = remote + return 0 + + @staticmethod + def _shell_false(url, remote=None): + _ = url + _ = remote + return 1 + + @staticmethod + def _mock_function_true(ref): + _ = ref + return (TestValidRef._shell_true, '97ebc0e0deadc0de') + + @staticmethod + def _mock_function_false(ref): + _ = ref + return (TestValidRef._shell_false, '97ebc0e0deadc0de') + + def test_tag_not_tag_branch_commit(self): + """Verify a non-tag returns false + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_false + self._repo._tag = 'something' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertFalse(received) + + def test_tag_not_tag(self): + """Verify a non-tag, untracked remote returns false + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_true + self._repo._git_lsremote_branch = self._shell_true + self._repo._git_revparse_commit = self._mock_function_false + self._repo._tag = 'tag1' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertFalse(received) + + def test_tag_indeterminant(self): + """Verify an indeterminant tag/branch returns false + """ + self._repo._git_showref_tag = self._shell_true + self._repo._git_showref_branch = self._shell_true + self._repo._git_lsremote_branch = self._shell_true + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = 'something' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertFalse(received) + + def test_tag_is_unique(self): + """Verify a unique tag match returns true + """ + self._repo._git_showref_tag = self._shell_true + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = 'tag1' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertTrue(received) + + def test_tag_is_not_hash(self): + """Verify a commit hash is not classified as a tag + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = '97ebc0e0' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertFalse(received) + + def test_hash_is_commit(self): + """Verify a commit hash is not classified as a tag + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = '97ebc0e0' + remote_name = 'origin' + received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) + self.assertFalse(received) + + +class TestValidRef(unittest.TestCase): + """Test logic verifying that a reference is a valid tag, branch or sha1 + + """ + + def setUp(self): + """Setup reusable git repository object + """ + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'git', + ExternalsDescription.REPO_URL: + '/path/to/local/repo', + ExternalsDescription.TAG: 'tag1', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'tmp', + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = GitRepository('test', repo) + + @staticmethod + def _shell_true(url, remote=None): + _ = url + _ = remote + return 0 + + @staticmethod + def _shell_false(url, remote=None): + _ = url + _ = remote + return 1 + + @staticmethod + def _mock_function_false(ref): + _ = ref + return (TestValidRef._shell_false, '') + + @staticmethod + def _mock_function_true(ref): + _ = ref + return (TestValidRef._shell_true, '') + + def test_valid_ref_is_invalid(self): + """Verify an invalid reference raises an exception + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_false + self._repo._tag = 'invalid_ref' + with self.assertRaises(RuntimeError): + self._repo._check_for_valid_ref(self._repo._tag) + + def test_valid_tag(self): + """Verify a valid tag return true + """ + self._repo._git_showref_tag = self._shell_true + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = 'tag1' + received = self._repo._check_for_valid_ref(self._repo._tag) + self.assertTrue(received) + + def test_valid_branch(self): + """Verify a valid tag return true + """ + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_true + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = self._mock_function_true + self._repo._tag = 'tag1' + received = self._repo._check_for_valid_ref(self._repo._tag) + self.assertTrue(received) + + def test_valid_hash(self): + """Verify a valid hash return true + """ + def _mock_revparse_commit(ref): + _ = ref + return (0, '56cc0b539426eb26810af9e') + + self._repo._git_showref_tag = self._shell_false + self._repo._git_showref_branch = self._shell_false + self._repo._git_lsremote_branch = self._shell_false + self._repo._git_revparse_commit = _mock_revparse_commit + self._repo._hash = '56cc0b5394' + received = self._repo._check_for_valid_ref(self._repo._hash) + self.assertTrue(received) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_repository_svn.py b/manage_externals/test/test_unit_repository_svn.py new file mode 100644 index 0000000000..7ff31c4218 --- /dev/null +++ b/manage_externals/test/test_unit_repository_svn.py @@ -0,0 +1,501 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the checkout_externals.py module is +already in the python path. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import unittest + +from manic.repository_svn import SvnRepository +from manic.externals_status import ExternalStatus +from manic.externals_description import ExternalsDescription +from manic.externals_description import ExternalsDescriptionDict +from manic.global_constants import EMPTY_STR + +# pylint: disable=W0212 + +SVN_INFO_MOSART = """Path: components/mosart +Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/mosart +URL: https://svn-ccsm-models.cgd.ucar.edu/mosart/trunk_tags/mosart1_0_26 +Relative URL: ^/mosart/trunk_tags/mosart1_0_26 +Repository Root: https://svn-ccsm-models.cgd.ucar.edu +Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 +Revision: 86711 +Node Kind: directory +Schedule: normal +Last Changed Author: erik +Last Changed Rev: 86031 +Last Changed Date: 2017-07-07 12:28:10 -0600 (Fri, 07 Jul 2017) +""" +SVN_INFO_CISM = """ +Path: components/cism +Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/cism +URL: https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_37 +Relative URL: ^/glc/trunk_tags/cism2_1_37 +Repository Root: https://svn-ccsm-models.cgd.ucar.edu +Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 +Revision: 86711 +Node Kind: directory +Schedule: normal +Last Changed Author: sacks +Last Changed Rev: 85704 +Last Changed Date: 2017-06-15 05:59:28 -0600 (Thu, 15 Jun 2017) +""" + + +class TestSvnRepositoryCheckURL(unittest.TestCase): + """Verify that the svn_check_url function is working as expected. + """ + + def setUp(self): + """Setup reusable svn repository object + """ + self._name = 'component' + rdata = {ExternalsDescription.PROTOCOL: 'svn', + ExternalsDescription.REPO_URL: + 'https://svn-ccsm-models.cgd.ucar.edu/', + ExternalsDescription.TAG: + 'mosart/trunk_tags/mosart1_0_26', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'junk', + ExternalsDescription.EXTERNALS: '', + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = SvnRepository('test', repo) + + def test_check_url_same(self): + """Test that we correctly identify that the correct URL. + """ + svn_output = SVN_INFO_MOSART + expected_url = self._repo.url() + result, current_version = \ + self._repo._check_url(svn_output, expected_url) + self.assertEqual(result, ExternalStatus.STATUS_OK) + self.assertEqual(current_version, 'mosart/trunk_tags/mosart1_0_26') + + def test_check_url_different(self): + """Test that we correctly reject an incorrect URL. + """ + svn_output = SVN_INFO_CISM + expected_url = self._repo.url() + result, current_version = \ + self._repo._check_url(svn_output, expected_url) + self.assertEqual(result, ExternalStatus.MODEL_MODIFIED) + self.assertEqual(current_version, 'glc/trunk_tags/cism2_1_37') + + def test_check_url_none(self): + """Test that we can handle an empty string for output, e.g. not an svn + repo. + + """ + svn_output = EMPTY_STR + expected_url = self._repo.url() + result, current_version = \ + self._repo._check_url(svn_output, expected_url) + self.assertEqual(result, ExternalStatus.UNKNOWN) + self.assertEqual(current_version, '') + + +class TestSvnRepositoryCheckSync(unittest.TestCase): + """Test whether the SvnRepository svn_check_sync functionality is + correct. + + """ + + def setUp(self): + """Setup reusable svn repository object + """ + self._name = "component" + rdata = {ExternalsDescription.PROTOCOL: 'svn', + ExternalsDescription.REPO_URL: + 'https://svn-ccsm-models.cgd.ucar.edu/', + ExternalsDescription.TAG: + 'mosart/trunk_tags/mosart1_0_26', + } + + data = {self._name: + { + ExternalsDescription.REQUIRED: False, + ExternalsDescription.PATH: 'junk', + ExternalsDescription.EXTERNALS: EMPTY_STR, + ExternalsDescription.REPO: rdata, + }, + } + + model = ExternalsDescriptionDict(data) + repo = model[self._name][ExternalsDescription.REPO] + self._repo = SvnRepository('test', repo) + + @staticmethod + def _svn_info_empty(*_): + """Return an empty info string. Simulates svn info failing. + """ + return '' + + @staticmethod + def _svn_info_synced(*_): + """Return an info sting that is synced with the setUp data + """ + return SVN_INFO_MOSART + + @staticmethod + def _svn_info_modified(*_): + """Return and info string that is modified from the setUp data + """ + return SVN_INFO_CISM + + def test_repo_dir_not_exist(self): + """Test that a directory that doesn't exist returns an error status + + Note: the Repository classes should be prevented from ever + working on an empty directory by the _Source object. + + """ + stat = ExternalStatus() + self._repo._check_sync(stat, 'junk') + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) + # check_dir should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_repo_dir_exist_no_svn_info(self): + """Test that an empty info string returns an unknown status + """ + stat = ExternalStatus() + # Now we over-ride the _svn_info method on the repo to return + # a known value without requiring access to svn. + self._repo._svn_info = self._svn_info_empty + self._repo._check_sync(stat, '.') + self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) + # check_dir should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_repo_dir_synced(self): + """Test that a valid info string that is synced to the repo in the + externals description returns an ok status. + + """ + stat = ExternalStatus() + # Now we over-ride the _svn_info method on the repo to return + # a known value without requiring access to svn. + self._repo._svn_info = self._svn_info_synced + self._repo._check_sync(stat, '.') + self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) + # check_dir should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + def test_repo_dir_modified(self): + """Test that a valid svn info string that is out of sync with the + externals description returns a modified status. + + """ + stat = ExternalStatus() + # Now we over-ride the _svn_info method on the repo to return + # a known value without requiring access to svn. + self._repo._svn_info = self._svn_info_modified + self._repo._check_sync(stat, '.') + self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) + # check_dir should only modify the sync_state, not clean_state + self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) + + +class TestSVNStatusXML(unittest.TestCase): + """Test parsing of svn status xml output + """ + SVN_STATUS_XML_DIRTY_ALL = ''' + + + + + +sacks +2017-06-15T11:59:00.355419Z + + + + + + +sacks +2013-02-07T16:17:56.412878Z + + + + + + +sacks +2017-05-01T16:48:27.893741Z + + + + + + + + + + + + + + + + +''' + + SVN_STATUS_XML_DIRTY_MISSING = ''' + + + + + +sacks +2017-06-15T11:59:00.355419Z + + + + + + + + +''' + + SVN_STATUS_XML_DIRTY_MODIFIED = ''' + + + + + +sacks +2013-02-07T16:17:56.412878Z + + + + + + + + +''' + + SVN_STATUS_XML_DIRTY_DELETED = ''' + + + + + +sacks +2017-05-01T16:48:27.893741Z + + + + + + + + +''' + + SVN_STATUS_XML_DIRTY_UNVERSION = ''' + + + + + + + + + + + +''' + + SVN_STATUS_XML_DIRTY_ADDED = ''' + + + + + + + + + + + +''' + + SVN_STATUS_XML_CLEAN = ''' + + + + + + + + + + + +''' + + def test_xml_status_dirty_missing(self): + """Verify that svn status output is consindered dirty when there is a + missing file. + + """ + svn_output = self.SVN_STATUS_XML_DIRTY_MISSING + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertTrue(is_dirty) + + def test_xml_status_dirty_modified(self): + """Verify that svn status output is consindered dirty when there is a + modified file. + """ + svn_output = self.SVN_STATUS_XML_DIRTY_MODIFIED + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertTrue(is_dirty) + + def test_xml_status_dirty_deleted(self): + """Verify that svn status output is consindered dirty when there is a + deleted file. + """ + svn_output = self.SVN_STATUS_XML_DIRTY_DELETED + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertTrue(is_dirty) + + def test_xml_status_dirty_unversion(self): + """Verify that svn status output ignores unversioned files when making + the clean/dirty decision. + + """ + svn_output = self.SVN_STATUS_XML_DIRTY_UNVERSION + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertFalse(is_dirty) + + def test_xml_status_dirty_added(self): + """Verify that svn status output is consindered dirty when there is a + added file. + """ + svn_output = self.SVN_STATUS_XML_DIRTY_ADDED + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertTrue(is_dirty) + + def test_xml_status_dirty_all(self): + """Verify that svn status output is consindered dirty when there are + multiple dirty files.. + + """ + svn_output = self.SVN_STATUS_XML_DIRTY_ALL + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertTrue(is_dirty) + + def test_xml_status_dirty_clean(self): + """Verify that svn status output is consindered clean when there are + no 'dirty' files. This means accepting untracked and externals. + + """ + svn_output = self.SVN_STATUS_XML_CLEAN + is_dirty = SvnRepository.xml_status_is_dirty( + svn_output) + self.assertFalse(is_dirty) + + +if __name__ == '__main__': + unittest.main() diff --git a/manage_externals/test/test_unit_utils.py b/manage_externals/test/test_unit_utils.py new file mode 100644 index 0000000000..c994e58ebe --- /dev/null +++ b/manage_externals/test/test_unit_utils.py @@ -0,0 +1,350 @@ +#!/usr/bin/env python + +"""Unit test driver for checkout_externals + +Note: this script assume the path to the checkout_externals.py module is +already in the python path. + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import unittest + +from manic.utils import last_n_lines, indent_string +from manic.utils import str_to_bool, execute_subprocess +from manic.utils import is_remote_url, split_remote_url, expand_local_url + + +class TestExecuteSubprocess(unittest.TestCase): + """Test the application logic of execute_subprocess wrapper + """ + + def test_exesub_return_stat_err(self): + """Test that execute_subprocess returns a status code when caller + requests and the executed subprocess fails. + + """ + cmd = ['false'] + status = execute_subprocess(cmd, status_to_caller=True) + self.assertEqual(status, 1) + + def test_exesub_return_stat_ok(self): + """Test that execute_subprocess returns a status code when caller + requests and the executed subprocess succeeds. + + """ + cmd = ['true'] + status = execute_subprocess(cmd, status_to_caller=True) + self.assertEqual(status, 0) + + def test_exesub_except_stat_err(self): + """Test that execute_subprocess raises an exception on error when + caller doesn't request return code + + """ + cmd = ['false'] + with self.assertRaises(RuntimeError): + execute_subprocess(cmd, status_to_caller=False) + + +class TestLastNLines(unittest.TestCase): + """Test the last_n_lines function. + + """ + + def test_last_n_lines_short(self): + """With a message with <= n lines, result of last_n_lines should + just be the original message. + + """ + mystr = """three +line +string +""" + + mystr_truncated = last_n_lines( + mystr, 3, truncation_message='[truncated]') + self.assertEqual(mystr, mystr_truncated) + + def test_last_n_lines_long(self): + """With a message with > n lines, result of last_n_lines should + be a truncated string. + + """ + mystr = """a +big +five +line +string +""" + expected = """[truncated] +five +line +string +""" + + mystr_truncated = last_n_lines( + mystr, 3, truncation_message='[truncated]') + self.assertEqual(expected, mystr_truncated) + + +class TestIndentStr(unittest.TestCase): + """Test the indent_string function. + + """ + + def test_indent_string_singleline(self): + """Test the indent_string function with a single-line string + + """ + mystr = 'foo' + result = indent_string(mystr, 4) + expected = ' foo' + self.assertEqual(expected, result) + + def test_indent_string_multiline(self): + """Test the indent_string function with a multi-line string + + """ + mystr = """hello +hi +goodbye +""" + result = indent_string(mystr, 2) + expected = """ hello + hi + goodbye +""" + self.assertEqual(expected, result) + + +class TestStrToBool(unittest.TestCase): + """Test the string to boolean conversion routine. + + """ + + def test_case_insensitive_true(self): + """Verify that case insensitive variants of 'true' returns the True + boolean. + + """ + values = ['true', 'TRUE', 'True', 'tRuE', 't', 'T', ] + for value in values: + received = str_to_bool(value) + self.assertTrue(received) + + def test_case_insensitive_false(self): + """Verify that case insensitive variants of 'false' returns the False + boolean. + + """ + values = ['false', 'FALSE', 'False', 'fAlSe', 'f', 'F', ] + for value in values: + received = str_to_bool(value) + self.assertFalse(received) + + def test_invalid_str_error(self): + """Verify that a non-true/false string generates a runtime error. + """ + values = ['not_true_or_false', 'A', '1', '0', + 'false_is_not_true', 'true_is_not_false'] + for value in values: + with self.assertRaises(RuntimeError): + str_to_bool(value) + + +class TestIsRemoteURL(unittest.TestCase): + """Crude url checking to determine if a url is local or remote. + + """ + + def test_url_remote_git(self): + """verify that a remote git url is identified. + """ + url = 'git@somewhere' + is_remote = is_remote_url(url) + self.assertTrue(is_remote) + + def test_url_remote_ssh(self): + """verify that a remote ssh url is identified. + """ + url = 'ssh://user@somewhere' + is_remote = is_remote_url(url) + self.assertTrue(is_remote) + + def test_url_remote_http(self): + """verify that a remote http url is identified. + """ + url = 'http://somewhere' + is_remote = is_remote_url(url) + self.assertTrue(is_remote) + + def test_url_remote_https(self): + """verify that a remote https url is identified. + """ + url = 'https://somewhere' + is_remote = is_remote_url(url) + self.assertTrue(is_remote) + + def test_url_local_user(self): + """verify that a local path with '~/path/to/repo' gets rejected + + """ + url = '~/path/to/repo' + is_remote = is_remote_url(url) + self.assertFalse(is_remote) + + def test_url_local_var_curly(self): + """verify that a local path with env var '${HOME}' gets rejected + """ + url = '${HOME}/path/to/repo' + is_remote = is_remote_url(url) + self.assertFalse(is_remote) + + def test_url_local_var(self): + """verify that a local path with an env var '$HOME' gets rejected + """ + url = '$HOME/path/to/repo' + is_remote = is_remote_url(url) + self.assertFalse(is_remote) + + def test_url_local_abs(self): + """verify that a local abs path gets rejected + """ + url = '/path/to/repo' + is_remote = is_remote_url(url) + self.assertFalse(is_remote) + + def test_url_local_rel(self): + """verify that a local relative path gets rejected + """ + url = '../../path/to/repo' + is_remote = is_remote_url(url) + self.assertFalse(is_remote) + + +class TestSplitRemoteURL(unittest.TestCase): + """Crude url checking to determine if a url is local or remote. + + """ + + def test_url_remote_git(self): + """verify that a remote git url is identified. + """ + url = 'git@somewhere.com:org/repo' + received = split_remote_url(url) + self.assertEqual(received, "org/repo") + + def test_url_remote_ssh(self): + """verify that a remote ssh url is identified. + """ + url = 'ssh://user@somewhere.com/path/to/repo' + received = split_remote_url(url) + self.assertEqual(received, 'somewhere.com/path/to/repo') + + def test_url_remote_http(self): + """verify that a remote http url is identified. + """ + url = 'http://somewhere.org/path/to/repo' + received = split_remote_url(url) + self.assertEqual(received, 'somewhere.org/path/to/repo') + + def test_url_remote_https(self): + """verify that a remote http url is identified. + """ + url = 'http://somewhere.gov/path/to/repo' + received = split_remote_url(url) + self.assertEqual(received, 'somewhere.gov/path/to/repo') + + def test_url_local_url_unchanged(self): + """verify that a local path is unchanged + + """ + url = '/path/to/repo' + received = split_remote_url(url) + self.assertEqual(received, url) + + +class TestExpandLocalURL(unittest.TestCase): + """Crude url checking to determine if a url is local or remote. + + Remote should be unmodified. + + Local, should perform user and variable expansion. + + """ + + def test_url_local_user1(self): + """verify that a local path with '~/path/to/repo' gets expanded to an + absolute path. + + NOTE(bja, 2017-11) we can't test for something like: + '~user/path/to/repo' because the user has to be in the local + machine password directory and we don't know a user name that + is valid on every system....? + + """ + field = 'test' + url = '~/path/to/repo' + received = expand_local_url(url, field) + print(received) + self.assertTrue(os.path.isabs(received)) + + def test_url_local_expand_curly(self): + """verify that a local path with '${HOME}' gets expanded to an absolute path. + """ + field = 'test' + url = '${HOME}/path/to/repo' + received = expand_local_url(url, field) + self.assertTrue(os.path.isabs(received)) + + def test_url_local_expand_var(self): + """verify that a local path with '$HOME' gets expanded to an absolute path. + """ + field = 'test' + url = '$HOME/path/to/repo' + received = expand_local_url(url, field) + self.assertTrue(os.path.isabs(received)) + + def test_url_local_env_missing(self): + """verify that a local path with env var that is missing gets left as-is + + """ + field = 'test' + url = '$TMP_VAR/path/to/repo' + received = expand_local_url(url, field) + print(received) + self.assertEqual(received, url) + + def test_url_local_expand_env(self): + """verify that a local path with another env var gets expanded to an + absolute path. + + """ + field = 'test' + os.environ['TMP_VAR'] = '/some/absolute' + url = '$TMP_VAR/path/to/repo' + received = expand_local_url(url, field) + del os.environ['TMP_VAR'] + print(received) + self.assertTrue(os.path.isabs(received)) + self.assertEqual(received, '/some/absolute/path/to/repo') + + def test_url_local_normalize_rel(self): + """verify that a local path with another env var gets expanded to an + absolute path. + + """ + field = 'test' + url = '/this/is/a/long/../path/to/a/repo' + received = expand_local_url(url, field) + print(received) + self.assertEqual(received, '/this/is/a/path/to/a/repo') + + +if __name__ == '__main__': + unittest.main() diff --git a/src/advection/slt/bandij.F90 b/src/advection/slt/bandij.F90 new file mode 100644 index 0000000000..5e0fa303f2 --- /dev/null +++ b/src/advection/slt/bandij.F90 @@ -0,0 +1,85 @@ + +subroutine bandij(dlam ,phib ,lamp ,phip ,iband , & + jband ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate longitude and latitude indices that identify the +! intervals on the extended grid that contain the departure points. +! Upon entry, all dep. points should be within jintmx intervals of the +! Northern- and Southern-most model latitudes. Note: the algorithm +! relies on certain relationships of the intervals in the Gaussian grid. +! +! Method: +! dlam Length of increment in equally spaced longitude grid (rad.) +! phib Latitude values for the extended grid. +! lamp Longitude coordinates of the points. It is assumed that +! 0.0 .le. lamp(i) .lt. 2*pi . +! phip Latitude coordinates of the points. +! iband Longitude index of the points. This index points into +! the extended arrays, e.g., +! lam(iband(i)) .le. lamp(i) .lt. lam(iband(i)+1) . +! jband Latitude index of the points. This index points into +! the extended arrays, e.g., +! phib(jband(i)) .le. phip(i) .lt. phib(jband(i)+1) . +! +! Author: J. Olson +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: platd, i1 + + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: dlam(platd) ! longitude increment + real(r8), intent(in) :: phib(platd) ! latitude coordinates of model grid + real(r8), intent(in) :: lamp(plon,plev) ! longitude coordinates of dep. points + real(r8), intent(in) :: phip(plon,plev) ! latitude coordinates of dep. points + integer , intent(in) :: nlon ! number of longitudes + integer , intent(out) :: iband(plon,plev,4) ! longitude index of dep. points + integer , intent(out) :: jband(plon,plev) ! latitude index of dep. points +!----------------------------------------------------------------------- +! +!---------------------------Local workspace----------------------------- +! + integer i,j,k ! indices + real(r8) dphibr ! reciprocal of an approximate del phi + real(r8) phibs ! latitude of southern-most latitude + real(r8) rdlam(platd) ! reciprocal of longitude increment +! +!----------------------------------------------------------------------- +! + dphibr = 1._r8/( phib(platd/2+1) - phib(platd/2) ) + phibs = phib(1) + do j = 1,platd + rdlam(j) = 1._r8/dlam(j) + end do +! +! Loop over level and longitude + +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon +! +! Latitude indices. +! + jband(i,k) = int ( (phip(i,k) - phibs)*dphibr + 1._r8 ) + if( phip(i,k) >= phib(jband(i,k)+1) ) then + jband(i,k) = jband(i,k) + 1 + end if +! +! Longitude indices. +! + iband(i,k,1) = i1 + int( lamp(i,k)*rdlam(jband(i,k)-1)) + iband(i,k,2) = iband(i,k,1) + iband(i,k,3) = iband(i,k,1) + iband(i,k,4) = iband(i,k,1) + end do + end do + + return +end subroutine bandij diff --git a/src/advection/slt/basdy.F90 b/src/advection/slt/basdy.F90 new file mode 100644 index 0000000000..f5a9a235f6 --- /dev/null +++ b/src/advection/slt/basdy.F90 @@ -0,0 +1,55 @@ + +subroutine basdy(phi ,lbasdy ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute weights for the calculation of derivative estimates at the two +! center points of the four point stencil for each interval in the +! unequally spaced latitude grid. Estimates are from differentiating +! a Lagrange cubic polynomial through the four point stencil. +! +! Method: +! phi Latitude values in the extended grid. +! lbasdy Weights for derivative estimates based on Lagrange cubic +! polynomial on the unequally spaced latitude grid. +! If grid interval j (in extended grid) is surrounded by +! a 4 point stencil, then the derivative at the "bottom" +! of the interval uses the weights lbasdy(1,1,j), +! lbasdy(2,1,j), lbasdy(3,1,j), and lbasdy(4,1,j). +! The derivative at the "top" of the interval +! uses lbasdy(1,2,j), lbasdy(2,2,j), lbasdy(3,2,j), +! and lbasdy(4,2,j). +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use scanslt, only: nxpt, platd + implicit none + +!------------------------------Parameters------------------------------- + integer, parameter :: jfirst = nxpt + 1 ! first index to be computed + integer, parameter :: jlast = platd - nxpt - 1 ! last index to be computed +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: phi(platd) ! latitude coordinates of model grid + real(r8), intent(out) :: lbasdy(4,2,platd) ! derivative estimate weights +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer jj ! index +!----------------------------------------------------------------------- +! + do jj = jfirst,jlast + call lcdbas( phi(jj-1), lbasdy(1,1,jj), lbasdy(1,2,jj) ) + end do +! + return +end subroutine basdy + diff --git a/src/advection/slt/basdz.F90 b/src/advection/slt/basdz.F90 new file mode 100644 index 0000000000..cd6ee79343 --- /dev/null +++ b/src/advection/slt/basdz.F90 @@ -0,0 +1,53 @@ + +subroutine basdz(pkdim ,sig ,lbasdz ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute weights for the calculation of derivative estimates at two +! center points of the four point stencil for each interval in the +! unequally spaced vertical grid (as defined by the array sig). +! Estimates are from differentiating a Lagrange cubic polynomial +! through the four point stencil. +! +! Method: +! pkdim Number of grid points in vertical grid. +! sig Sigma values in the vertical grid. +! lbasdz Weights for derivative estimates based on Lagrange cubic +! polynomial on the unequally spaced vertical grid. +! If grid interval j is surrounded by a 4 point stencil, +! then the derivative at the "top" of the interval (smaller +! sigma value) uses the weights lbasdz(1,1,j),lbasdz(2,1,j), +! lbasdz(3,1,j), and lbasdz(4,1,j). The derivative at the +! "bottom" of the interval uses lbasdz(1,2,j), lbasdz(2,2,j), +! lbasdz(3,2,j), and lbasdz(4,2,j). (Recall the vertical +! level indices increase from the top of the atmosphere +! towards the bottom.) +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: pkdim ! vertical dimension + real(r8), intent(in) :: sig(pkdim) ! sigma levels (actually a generic vert. coord) + real(r8), intent(out):: lbasdz(4,2,pkdim) ! vertical interpolation weights +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer kk ! index +!----------------------------------------------------------------------- +! + do kk = 2,pkdim-2 + call lcdbas( sig(kk-1), lbasdz(1,1,kk), lbasdz(1,2,kk) ) + end do +! + return +end subroutine basdz + diff --git a/src/advection/slt/basiy.F90 b/src/advection/slt/basiy.F90 new file mode 100644 index 0000000000..c3036bfd3c --- /dev/null +++ b/src/advection/slt/basiy.F90 @@ -0,0 +1,44 @@ + +subroutine basiy(phi ,lbasiy ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute weights used in Lagrange cubic polynomial interpolation in +! the central interval of a four point stencil. Done for each interval +! in the unequally spaced latitude grid. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use scanslt, only: nxpt, platd + implicit none + +!------------------------------Parameters------------------------------- + integer, parameter :: jfirst = nxpt + 1 ! first index to be computed + integer, parameter :: jlast = platd - nxpt - 1 ! last index to be computed +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: phi(platd) ! grid values in extended grid + real(r8), intent(out) :: lbasiy(4,2,platd) ! Weights for Lagrange cubic interp +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer jj ! index +!----------------------------------------------------------------------- +! + do jj = jfirst,jlast + call lcbas( phi(jj-1),lbasiy(1,1,jj),lbasiy(1,2,jj) ) + end do +! + return +end subroutine basiy + diff --git a/src/advection/slt/difcor.F90 b/src/advection/slt/difcor.F90 new file mode 100644 index 0000000000..f0c9bdb501 --- /dev/null +++ b/src/advection/slt/difcor.F90 @@ -0,0 +1,115 @@ + +subroutine difcor(klev ,ztodt ,delps ,u ,v , & + qsave ,pdel ,pint ,t ,tdif , & + udif ,vdif ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Add correction term to t and q horizontal diffusions and +! determine the implied heating rate due to momentum diffusion. +! +! Method: +! 1. Add correction term to t and q horizontal diffusions. This term +! provides a partial correction of horizontal diffusion on hybrid (sigma) +! surfaces to horizontal diffusion on pressure surfaces. The appropriate +! function of surface pressure (delps, which already contains the diffusion +! coefficient and the time step) is computed during the transform +! from spherical harmonic coefficients to grid point values. This term +! can only be applied in the portion of the vertical domain in which +! biharmonic horizontal diffusion is employed. In addition, the term is +! unnecessary on pure pressure levels. +! +! 2. Determine the implied heating rate due to momentum diffusion in order +! to conserve total energy and add it to the temperature. +! Reduce complex matrix (ac) to upper Hessenburg matrix (ac) +! +! Author: D. Williamson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plevp, plon + use physconst, only: cpair, cpvir + use hycoef, only: hybi + use cam_control_mod, only : ideal_phys, adiabatic + implicit none + +!------------------------------Arguments-------------------------------- + + integer , intent(in) :: klev ! k-index of top hybrid level + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: ztodt ! twice time step unless nstep = 0 + real(r8), intent(in) :: delps(plon) ! srf press function for correction + real(r8), intent(in) :: u(plon,plev) ! u-wind + real(r8), intent(in) :: v(plon,plev) ! v-wind + real(r8), intent(in) :: qsave(plon,plev) ! moisture fm prv fcst + real(r8), intent(in) :: pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) + real(r8), intent(in) :: pint(plon,plevp) ! pressure at model interfaces + real(r8), intent(inout) :: t(plon,plev) ! temperature + real(r8), intent(inout) :: tdif(plon,plev) ! initial/final temperature diffusion + real(r8), intent(inout) :: udif(plon,plev) ! initial/final u-momentum diffusion + real(r8), intent(inout) :: vdif(plon,plev) ! initial/final v-momentum diffusion + +!---------------------------Local workspace----------------------------- + + integer i,k ! longitude, level indices + real(r8) tcor(plon,plev) ! temperature correction term +!----------------------------------------------------------------------- +! +! Compute the pressure surface correction term for horizontal diffusion of +! temperature. +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=klev,plev + if (k==1) then + do i=1,nlon + tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k+1)*(t(i,k+1)-t(i,k)))*pint(i,plevp) + end do + else if (k==plev) then + do i=1,nlon + tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k)*(t(i,k)-t(i,k-1)))*pint(i,plevp) + end do + else + do i=1,nlon + tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k+1)*(t(i,k+1)-t(i,k)) + & + hybi(k )*(t(i,k)-t(i,k-1)))*pint(i,plevp) + end do + end if + end do +! +! Add the temperture diffusion correction to the diffusive heating term +! and to the temperature. +! + if (.not.adiabatic .and. .not.ideal_phys) then +!$OMP PARALLEL DO PRIVATE (K, I) + do k=klev,plev + do i=1,nlon + tdif(i,k) = tdif(i,k) + tcor(i,k)/ztodt + t(i,k) = t(i,k) + tcor(i,k) + end do + end do +! +! Convert momentum diffusion tendencies to heating rates in order to +! conserve internal energy. Add the heating to the temperature and to +! diffusive heating term. +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + t(i,k) = t(i,k) - ztodt * (u(i,k)*udif(i,k) + v(i,k)*vdif(i,k)) / & + (cpair*(1._r8 + cpvir*qsave(i,k))) + tdif(i,k) = tdif(i,k) - (u(i,k)*udif(i,k) + v(i,k)*vdif(i,k)) / & + (cpair*(1._r8 + cpvir*qsave(i,k))) + end do + end do + end if + + return +end subroutine difcor + diff --git a/src/advection/slt/engy_tdif.F90 b/src/advection/slt/engy_tdif.F90 new file mode 100644 index 0000000000..a3826b19cb --- /dev/null +++ b/src/advection/slt/engy_tdif.F90 @@ -0,0 +1,58 @@ + +subroutine engy_tdif(cwava ,w ,t ,tm1 ,pdel , & + difft ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate contribution of current latitude to del-T integral +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: t (plon,plev) ! temperature + real(r8), intent(in) :: tm1 (plon,plev) ! temperature (previous timestep) + real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces + real(r8), intent(out) :: difft ! accumulator +! +!---------------------------Local variables----------------------------- +! + integer i,k ! longitude, level indices + real(r8) const ! temporary constant +! +!----------------------------------------------------------------------- +! +! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) +! + const = cwava*w*0.5_r8 + difft = 0._r8 +! +! Compute mass integral +! + do k=1,plev + do i=1,nlon + difft = difft + pdel(i,k) + end do + end do + + difft = difft*const + + return +end subroutine engy_tdif diff --git a/src/advection/slt/engy_te.F90 b/src/advection/slt/engy_te.F90 new file mode 100644 index 0000000000..138f4acb9c --- /dev/null +++ b/src/advection/slt/engy_te.F90 @@ -0,0 +1,64 @@ + +subroutine engy_te(cwava ,w ,t ,u ,v , & + phis ,pdel ,ps ,engy , nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate contribution of current latitude to total energy +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use physconst, only: cpair + + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: t (plon,plev) ! temperature + real(r8), intent(in) :: u (plon,plev) ! u-component + real(r8), intent(in) :: v (plon,plev) ! v-component + real(r8), intent(in) :: phis(plon) ! Geopotential + real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces + real(r8), intent(in) :: ps (plon ) ! Surface pressure + real(r8), intent(out) :: engy ! accumulator +! +!---------------------------Local variables----------------------------- +! + integer i,k ! longitude, level indices + real(r8) const ! temporary constant +! +!----------------------------------------------------------------------- +! +! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) +! + const = cwava*w*0.5_r8 + engy = 0._r8 +! + do k=1,plev + do i=1,nlon + engy = engy + ( cpair*t(i,k) + 0.5_r8*( u(i,k)*u(i,k) + v(i,k)*v(i,k) ) )*pdel(i,k) + end do + end do + do i=1,nlon + engy = engy + phis(i)*ps(i) + end do + + engy = engy*const + + return +end subroutine engy_te diff --git a/src/advection/slt/extx.F90 b/src/advection/slt/extx.F90 new file mode 100644 index 0000000000..c76eee27b9 --- /dev/null +++ b/src/advection/slt/extx.F90 @@ -0,0 +1,66 @@ + +subroutine extx (pkcnst, pkdim, fb, kloop) + +!----------------------------------------------------------------------- +! +! Purpose: +! Copy data to the longitude extensions of the extended array +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use scanslt, only: plond, beglatex, endlatex, nxpt, nlonex + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: pkcnst ! dimension construct for 3-D arrays + integer , intent(in) :: pkdim ! vertical dimension + real(r8), intent(inout) :: fb(plond,pkdim*pkcnst,beglatex:endlatex) ! constituents + integer, intent(in) :: kloop ! Limit extent of loop of pkcnst +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i ! longitude index + integer j ! latitude index + integer k ! vertical index + integer nlond ! extended longitude dim + integer i2pi ! start of eastern long. extension + integer pk ! k extent to loop over +!----------------------------------------------------------------------- +! +! Fill west edge points. +! + pk = pkdim*kloop + if(nxpt >= 1) then + do j=beglatex,endlatex + do i=1,nxpt + do k=1,pk + fb(i,k,j) = fb(i+nlonex(j),k,j) + end do + end do + end do + end if +! +! Fill east edge points +! + do j=beglatex,endlatex + i2pi = nxpt + nlonex(j) + 1 + nlond = nlonex(j) + 1 + 2*nxpt + do i=i2pi,nlond + do k=1,pk + fb(i,k,j) = fb(i-nlonex(j),k,j) + end do + end do + end do + + return +end subroutine extx diff --git a/src/advection/slt/extys.F90 b/src/advection/slt/extys.F90 new file mode 100644 index 0000000000..3a99920c0c --- /dev/null +++ b/src/advection/slt/extys.F90 @@ -0,0 +1,137 @@ + +subroutine extys(pkcnst ,pkdim ,fb ,kloop) + +!----------------------------------------------------------------------- +! +! Purpose: +! Fill latitude extensions of a scalar extended array and +! Copy data to the longitude extensions of the extended array +! +! Method: +! This is done in 2 steps: +! 1) interpolate to the pole points; use the mean field value on the +! Gaussian latitude closest to the pole. +! 2) add latitude lines beyond the poles. +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat + use scanslt, only: nxpt, plond, beglatex, endlatex, platd, nlonex, & + jintmx + implicit none + +!------------------------------Parameters------------------------------- + integer, parameter :: istart = nxpt+1 ! index to start computation + integer, parameter :: js = 1 + nxpt + jintmx ! index of southernmost model lat + integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: pkcnst ! dimensioning construct for 3-D arrays + integer , intent(in) :: pkdim ! vertical dimension + real(r8), intent(inout) :: fb(plond,pkdim*pkcnst,beglatex:endlatex) ! Output is same as on entry + !except with the pole latitude and extensions beyond it filled. + integer, intent(in) :: kloop ! If you want to limit the extent of looping over pcnst +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,j,k ! indices + integer istop ! index to stop computation + integer nlon2 ! half the number of real longitudes + real(r8) zave ! accumulator for zonal averaging + integer pk ! dimension to loop over +!----------------------------------------------------------------------- +! +! Fill north pole line. +! + pk = pkdim*kloop +#if ( defined SPMD ) + if (jn+1<=endlatex) then +#endif + do k=1,pkdim*pkcnst + zave = 0.0_r8 + istop = nxpt + nlonex(jn) + do i=istart,istop + zave = zave + fb(i,k,jn ) + end do + zave = zave/nlonex(jn) + istop = nxpt + nlonex(jn+1) + do i=istart,istop + fb(i,k,jn+1) = zave + end do + end do +#if ( defined SPMD ) + end if +#endif +! +! Fill northern lines beyond pole line. +! + if( jn+2 <= platd )then + do j=jn+2,platd +#if ( defined SPMD ) + if (j<=endlatex) then +#endif + nlon2 = nlonex(j)/2 + do k=1,pk + do i=istart,istart+nlon2-1 + fb( i,k,j) = fb(nlon2+i,k,2*jn+2-j) + fb(nlon2+i,k,j) = fb( i,k,2*jn+2-j) + end do + end do +#if ( defined SPMD ) + end if +#endif + end do + end if +! +! Fill south pole line. +! +#if ( defined SPMD ) + if (js-1>=beglatex) then +#endif + do k=1,pk + zave = 0.0_r8 + istop = nxpt + nlonex(js) + do i = istart,istop + zave = zave + fb(i,k,js ) + end do + zave = zave/nlonex(js) + istop = nxpt + nlonex(js-1) + do i=istart,istop + fb(i,k,js-1) = zave + end do + end do +#if ( defined SPMD ) + end if +#endif +! +! Fill southern lines beyond pole line. +! + if( js-2 >= 1 )then + do j=1,js-2 +#if ( defined SPMD ) + if (j>=beglatex) then +#endif + nlon2 = nlonex(j)/2 + do k=1,pk + do i=istart,istart+nlon2-1 + fb( i,k,j) = fb(nlon2+i,k,2*js-2-j) + fb(nlon2+i,k,j) = fb( i,k,2*js-2-j) + end do + end do +#if ( defined SPMD ) + end if +#endif + end do + end if + + return +end subroutine extys diff --git a/src/advection/slt/extyv.F90 b/src/advection/slt/extyv.F90 new file mode 100644 index 0000000000..e60125c6d5 --- /dev/null +++ b/src/advection/slt/extyv.F90 @@ -0,0 +1,177 @@ + +subroutine extyv(pkcnst ,pkdim ,coslam ,sinlam ,ub , & + vb ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Fill latitude extensions of a vector component extended array. +! +! Method: +! This is done in 2 steps: +! 1) interpolate to the pole points; +! use coefficients for zonal wave number 1 on the Gaussian +! latitude closest to the pole. +! 2) add latitude lines beyond the poles. +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat + use scanslt, only: nxpt, platd, nlonex, beglatex, endlatex, plond, & + jintmx + implicit none + +!------------------------------Parameters------------------------------- + integer, parameter :: istart = nxpt+1 ! index to start computation + integer, parameter :: js = 1 + nxpt + jintmx ! index of southernmost model lat + integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer , intent(in) :: pkcnst ! dimensioning construct for 3-D arrays + integer , intent(in) :: pkdim ! vertical dimension + real(r8), intent(in) :: coslam(plond,platd) ! Cos of long at x-grid points (global grid) + real(r8), intent(in) :: sinlam(plond,platd) ! Sin of long at x-grid points (global grid) + real(r8), intent(inout):: ub(plond,pkdim*pkcnst,beglatex:endlatex) ! U-wind with extents + real(r8), intent(inout):: vb(plond,pkdim*pkcnst,beglatex:endlatex) ! V-wind with extents +! +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i ! index + integer ig ! index + integer j ! index + integer k ! index + integer nlon2 ! half the number of real longitudes + integer istop ! index to stop computation + real(r8) zavecv ! accumulator for wavenumber 1 of v + real(r8) zavesv ! accumulator for wavenumber 1 of v + real(r8) zavecu ! accumulator for wavenumber 1 of u + real(r8) zavesu ! accumulator for wavenumber 1 of u + real(r8) zaucvs ! used to couple u and v (wavenumber 1) + real(r8) zavcus ! used to couple u and v (wavenumber 1) +!----------------------------------------------------------------------- +! +! Fill north pole line. +! +#if ( defined SPMD ) + if (jn+1<=endlatex) then ! north pole is on-processor +#endif + do k = 1,pkdim + zavecv = 0.0_r8 + zavesv = 0.0_r8 + zavecu = 0.0_r8 + zavesu = 0.0_r8 + ig = 0 + istop = nxpt + nlonex(jn) + do i = istart,istop + ig = ig + 1 + zavecv = zavecv + vb(i,k,jn )*coslam(ig,jn) + zavesv = zavesv + vb(i,k,jn )*sinlam(ig,jn) + zavecu = zavecu + ub(i,k,jn )*coslam(ig,jn) + zavesu = zavesu + ub(i,k,jn )*sinlam(ig,jn) + end do + zavcus = (zavecv + zavesu)/nlonex(jn) + zaucvs = (zavecu - zavesv)/nlonex(jn) + ig = 0 + istop = nxpt + nlonex(jn+1) + do i = istart,istop + ig = ig + 1 + vb(i,k,jn+1) = zavcus*coslam(ig,jn+1) - zaucvs*sinlam(ig,jn+1) + ub(i,k,jn+1) = zaucvs*coslam(ig,jn+1) + zavcus*sinlam(ig,jn+1) + end do + end do +#if ( defined SPMD ) + end if +#endif +! +! Fill northern lines beyond pole line. +! + if( jn+2 <= platd )then + do j = jn+2,platd +#if ( defined SPMD ) + if (j<=endlatex) then +#endif + nlon2 = nlonex(j)/2 + do k = 1,pkdim + do i = istart,istart+nlon2-1 + vb( i,k,j) = -vb(nlon2+i,k,2*jn+2-j) + vb(nlon2+i,k,j) = -vb( i,k,2*jn+2-j) + ub( i,k,j) = -ub(nlon2+i,k,2*jn+2-j) + ub(nlon2+i,k,j) = -ub( i,k,2*jn+2-j) + end do + end do +#if ( defined SPMD ) + end if +#endif + end do + end if +! +! Fill south pole line. +! +#if ( defined SPMD ) + if (js-1>=beglatex) then ! south pole is on-processor +#endif + do k = 1,pkdim + zavecv = 0.0_r8 + zavesv = 0.0_r8 + zavecu = 0.0_r8 + zavesu = 0.0_r8 + ig = 0 + istop = nxpt + nlonex(js) + do i = istart,istop + ig = ig + 1 + zavecv = zavecv + vb(i,k,js )*coslam(ig,js) + zavesv = zavesv + vb(i,k,js )*sinlam(ig,js) + zavecu = zavecu + ub(i,k,js )*coslam(ig,js) + zavesu = zavesu + ub(i,k,js )*sinlam(ig,js) + end do + zavcus = (zavecv - zavesu)/nlonex(js) + zaucvs = (zavecu + zavesv)/nlonex(js) + ig = 0 + istop = nxpt + nlonex(js-1) + do i = istart,istop + ig = ig + 1 + vb(i,k,js-1) = zavcus*coslam(ig,js-1) + zaucvs*sinlam(ig,js-1) + ub(i,k,js-1) = zaucvs*coslam(ig,js-1) - zavcus*sinlam(ig,js-1) + end do + end do +#if ( defined SPMD ) + end if +#endif +! +! Fill southern lines beyond pole line. +! + if( js-2 >= 1 )then + do j = 1,js-2 +#if ( defined SPMD ) + if (j>=beglatex) then +#endif + nlon2 = nlonex(j)/2 + do k = 1,pkdim + do i = istart,istart+nlon2-1 + vb( i,k,j) = -vb(nlon2+i,k,2*js-2-j) + vb(nlon2+i,k,j) = -vb( i,k,2*js-2-j) + ub( i,k,j) = -ub(nlon2+i,k,2*js-2-j) + ub(nlon2+i,k,j) = -ub( i,k,2*js-2-j) + end do + end do +#if ( defined SPMD ) + end if +#endif + end do + end if +! + return +end subroutine extyv diff --git a/src/advection/slt/flxint.F90 b/src/advection/slt/flxint.F90 new file mode 100644 index 0000000000..804824f96f --- /dev/null +++ b/src/advection/slt/flxint.F90 @@ -0,0 +1,45 @@ + +subroutine flxint (w ,flx ,flxlat ,nlon ) +!----------------------------------------------------------------------- +! +! Purpose: Calculate contribution of current latitude to energy flux integral +! +! Method: +! +! Author: Jerry Olson +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! Arguments +! + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: flx(plon) ! energy field + + integer, intent(in) :: nlon ! number of longitudes + + real(r8), intent(out) :: flxlat ! accumulator for given latitude +! +! Local variables +! + integer :: i ! longitude index +! +!----------------------------------------------------------------------- +! + flxlat = 0._r8 +! + do i=1,nlon + flxlat = flxlat + flx(i) + end do +! +! Integration factor (the 0.5 factor arises because gaussian weights +! sum to 2) +! + flxlat = flxlat*w*0.5_r8/real(nlon,r8) +! + return +end subroutine flxint diff --git a/src/advection/slt/grdxy.F90 b/src/advection/slt/grdxy.F90 new file mode 100644 index 0000000000..4ab40cb3db --- /dev/null +++ b/src/advection/slt/grdxy.F90 @@ -0,0 +1,124 @@ + +subroutine grdxy(dlam ,lam ,phi ,w ,sinlam , & + coslam ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Define the "extended" grid used in the semi-Lagrangian transport +! scheme. The longitudes are equally spaced and the latitudes are +! Gaussian. The global grid is extended to include "wraparound" points +! on all sides. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat + use scanslt, only: nxpt, jintmx, plond, platd, nlonex + use gauaw_mod, only: gauaw + implicit none + +!------------------------------Parameters------------------------------- + integer, parameter :: istart = nxpt+1 ! index for first model long. + integer, parameter :: jstart = nxpt+jintmx+1 ! index for first model lat. + integer, parameter :: jstop = jstart-1+plat ! index for last model lat. +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + real(r8), intent(out) :: dlam(platd) ! longitudinal increment + real(r8), intent(out) :: lam (plond,platd) ! long. coords. in extended grid + real(r8), intent(out) :: phi (platd) ! lat. coords. in extended grid + real(r8), intent(out) :: w (plat) ! Gaussian weights + real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) + real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) +! +! dlam Length of increment in longitude grid. +! lam Longitude values in the extended grid. +! phi Latitude values in the extended grid. +! w Gauss weights for latitudes in the global grid. (These sum +! to 2.0 like the ones in CCM1.) +! sinlam Sine of longitudes in global grid (no extension points). +! coslam Cosine of longitudes in global grid (no extension points). +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,j,ig ! indices + integer nlond ! extended long dim + real(r8) lam0 ! lamda = 0 + real(r8) pi ! 3.14... + real(r8) wrk(platd) ! work space +!----------------------------------------------------------------------- +! + lam0 = 0.0_r8 + pi = 4._r8*atan(1._r8) +! +! Interval length in equally spaced longitude grid. +! + do j=1,platd + dlam(j) = 2._r8*pi/real(nlonex(j),r8) +! +! Longitude values on extended grid. +! + nlond = nlonex(j) + 1 + 2*nxpt + do i = 1,nlond + lam(i,j) = real(i-istart,r8)*dlam(j) + lam0 + end do + end do +! +! Compute Gauss latitudes and weights. On return; phi contains the +! sine of the latitudes starting closest to the north pole and going +! toward the south; w contains the corresponding Gauss weights. +! + call gauaw(phi ,w ,plat ) +! +! Reorder and compute latitude values. +! + do j = jstart,jstop + wrk(j) = asin( phi(jstop-j+1) ) + end do + phi(jstart:jstop) = wrk(jstart:jstop) +! +! North and south poles. +! + phi(jstart-1) = -pi/2.0_r8 + phi(jstop +1) = pi/2.0_r8 +! +! Extend Gauss latitudes below south pole so that the spacing above +! the pole is symmetric, and phi is decreasing, i.e., phi < -pi/2 +! + if( jstart > 2 )then + do j = 1,jstart-2 + phi(j) = -pi - phi(2*jstart-2-j) + end do + end if +! +! Analogously for Northern Hemisphere +! + if( platd > jstop+1 )then + do j = jstop+2,platd + phi(j) = pi - phi(2*jstop+2-j) + end do + end if +! +! Sine and cosine of longitude. +! + do j=1,platd + ig = 0 + do i = istart,nlonex(j)+nxpt + ig = ig + 1 + sinlam(ig,j) = sin( lam(i,j) ) + coslam(ig,j) = cos( lam(i,j) ) + end do + end do + + return +end subroutine grdxy diff --git a/src/advection/slt/hadvtest.h b/src/advection/slt/hadvtest.h new file mode 100644 index 0000000000..9cd2534a6a --- /dev/null +++ b/src/advection/slt/hadvtest.h @@ -0,0 +1,2 @@ +common/savit/usave(plon,plev,plat), vsave(plon,plev,plat), pssave(plon,plat) +real(r8) usave, vsave, pssave diff --git a/src/advection/slt/hordif1.F90 b/src/advection/slt/hordif1.F90 new file mode 100644 index 0000000000..fad8996807 --- /dev/null +++ b/src/advection/slt/hordif1.F90 @@ -0,0 +1,92 @@ + +subroutine hordif1(rearth,phi) + +!----------------------------------------------------------------------- +! +! Purpose: +! Horizontal diffusion of z,d,t,q +! +! Method: +! 1. implicit del**2 form above level kmnhd4 +! 2. implicit del**4 form at level kmnhd4 and below +! 3. courant number based truncation at level kmxhdc and above +! 4. increased del**2 coefficient at level kmxhd2 and above +! +! Computational note: this routine is multitasked by level, hence it +! is called once for each k +! +! Author: +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use pspect + use comspe + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: rearth ! radius of earth + real(r8), intent(inout) :: phi(psp) ! used in spectral truncation of phis +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer ir,ii ! spectral indices + integer mr,mc ! spectral indices + real(r8) k42 ! Nominal Del^4 diffusion coeff at T42 + real(r8) k63 ! Nominal Del^4 diffusion coeff at T63 + real(r8) knn ! Computed Del^4 diffusion coeff at TNN + real(r8) tmp ! temp space + real(r8) hdfst4(pnmax) + integer expon + integer m ! spectral indices + integer(i8) n ! spectral indices +!----------------------------------------------------------------------- +! +! Compute Del^4 diffusion coefficient +! + k42 = 1.e+16_r8 + k63 = 5.e+15_r8 + expon = 25 + + if(pmax-1 <= 42) then + knn = k42 + elseif(pmax-1 == 63) then + knn = k63 + else + if(pmax-1 < 63) then + tmp = log(k42/k63)/log(63._r8*64._r8/42._r8/43._r8) + else + tmp = 2._r8 + endif + knn = k63*(63._r8*64._r8/real(pmax,r8)/real(pmax-1,r8))**tmp + endif +! +! Set the Del^4 diffusion coefficients for each wavenumber +! + hdfst4(1) = 0._r8 + do n=2,pnmax + hdfst4(n) = knn * (n*(n-1)*n*(n-1) ) / rearth**4 + end do +! +! Set the horizontal diffusion factors for each wavenumer at this level +! del^4 diffusion is to be applied and compute time-split implicit +! factors. +! + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m) + ir = mc + 2*n - 1 + ii = ir + 1 + phi(ir) = phi(ir)/(1._r8 + 3600._r8*hdfst4(n+m-1))**expon + phi(ii) = phi(ii)/(1._r8 + 3600._r8*hdfst4(n+m-1))**expon + end do + end do + + return +end subroutine hordif1 diff --git a/src/advection/slt/kdpfnd.F90 b/src/advection/slt/kdpfnd.F90 new file mode 100644 index 0000000000..24e229b359 --- /dev/null +++ b/src/advection/slt/kdpfnd.F90 @@ -0,0 +1,66 @@ + +subroutine kdpfnd(pkdim ,pmap ,sig ,sigdp ,kdpmap , & + kdp ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Determine vertical departure point indices that point into a grid +! containing the full or half sigma levels. Use an artificial evenly +! spaced vertical grid to map into the true model levels. +! +! Method: +! Indices are computed assuming the the sigdp values have +! been constrained so that sig(1) .le. sigdp(i,j) .lt. sig(pkdim). +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: pkdim ! dimension of "sig" + integer , intent(in) :: pmap ! dimension of "kdpmap" + real(r8), intent(in) :: sig (pkdim) ! vertical grid coordinates + integer , intent(in) :: kdpmap(pmap) ! array of model grid indices which + real(r8), intent(in) :: sigdp(plon,plev) ! vertical coords. of departure points + integer , intent(out):: kdp(plon,plev) ! vertical index for each dep. pt. + integer , intent(in) :: nlon ! longitude dimensio +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k,ii ! indices + real(r8) rdel ! recip. of interval in artificial grid + real(r8) sig1ln ! ln (sig(1)) +!----------------------------------------------------------------------- +! + rdel = real(pmap,r8)/( log(sig(pkdim)) - log(sig(1)) ) + sig1ln = log( sig(1) ) +! +!$OMP PARALLEL DO PRIVATE (K, I, II) + do k=1,plev + do i=1,nlon +! +! First guess of the departure point's location in the model grid +! + ii = max0(1,min0(pmap,int((log(sigdp(i,k))-sig1ln)*rdel+1._r8))) + kdp(i,k) = kdpmap(ii) +! +! Determine if location is in next interval +! + if(sigdp(i,k) >= sig(kdp(i,k)+1)) then + kdp(i,k) = kdp(i,k) + 1 + end if + end do + end do + + return +end subroutine kdpfnd diff --git a/src/advection/slt/lcbas.F90 b/src/advection/slt/lcbas.F90 new file mode 100644 index 0000000000..93848804ed --- /dev/null +++ b/src/advection/slt/lcbas.F90 @@ -0,0 +1,58 @@ + +subroutine lcbas (grd, bas1, bas2) + +!----------------------------------------------------------------------- +! +! Purpose: +! Evaluate the partial Lagrangian cubic basis functions (denominator +! only ) for the grid points and gather grid values +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: grd(4) ! grid stencil + real(r8), intent(out):: bas1(4) ! grid values on stencil + real(r8), intent(out):: bas2(4) ! lagrangian basis functions +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + real(r8) x0mx1 ! | + real(r8) x0mx2 ! | + real(r8) x0mx3 ! |- grid value differences used in weights + real(r8) x1mx2 ! | + real(r8) x1mx3 ! | + real(r8) x2mx3 ! | +!----------------------------------------------------------------------- +! + x0mx1 = grd(1) - grd(2) + x0mx2 = grd(1) - grd(3) + x0mx3 = grd(1) - grd(4) + x1mx2 = grd(2) - grd(3) + x1mx3 = grd(2) - grd(4) + x2mx3 = grd(3) - grd(4) + + bas1(1) = grd(1) + bas1(2) = grd(2) + bas1(3) = grd(3) + bas1(4) = grd(4) + + bas2(1) = 1._r8/ ( x0mx1 * x0mx2 * x0mx3 ) + bas2(2) = -1._r8/ ( x0mx1 * x1mx2 * x1mx3 ) + bas2(3) = 1._r8/ ( x0mx2 * x1mx2 * x2mx3 ) + bas2(4) = -1._r8/ ( x0mx3 * x1mx3 * x2mx3 ) + + return +end subroutine lcbas + diff --git a/src/advection/slt/lcdbas.F90 b/src/advection/slt/lcdbas.F90 new file mode 100644 index 0000000000..d3fd1d3f01 --- /dev/null +++ b/src/advection/slt/lcdbas.F90 @@ -0,0 +1,71 @@ + +subroutine lcdbas(grd ,dbas2 ,dbas3 ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate weights used to evaluate derivative estimates at the +! inner grid points of a four point stencil based on Lagrange +! cubic polynomial through four unequally spaced points. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: grd(4) ! grid stencil + real(r8), intent(out):: dbas2(4) ! derivatives at grid point 2. + real(r8), intent(out):: dbas3(4) ! derivatives at grid point 3. +! +! grd Coordinate values of four points in stencil. +! dbas2 Derivatives of the four basis functions at grid point 2. +! dbas3 Derivatives of the four basis functions at grid point 3. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + real(r8) x1 ! | + real(r8) x2 ! |- grid values + real(r8) x3 ! | + real(r8) x4 ! | + real(r8) x1mx2 ! | + real(r8) x1mx3 ! | + real(r8) x1mx4 ! |- differences of grid values + real(r8) x2mx3 ! | + real(r8) x2mx4 ! | + real(r8) x3mx4 ! | +!----------------------------------------------------------------------- +! + x1 = grd(1) + x2 = grd(2) + x3 = grd(3) + x4 = grd(4) + x1mx2 = x1 - x2 + x1mx3 = x1 - x3 + x1mx4 = x1 - x4 + x2mx3 = x2 - x3 + x2mx4 = x2 - x4 + x3mx4 = x3 - x4 + + dbas2(1) = x2mx3 * x2mx4 / ( x1mx2 * x1mx3 * x1mx4 ) + dbas2(2) = -1._r8/x1mx2 + 1._r8/x2mx3 + 1._r8/x2mx4 + dbas2(3) = - x1mx2 * x2mx4 / ( x1mx3 * x2mx3 * x3mx4 ) + dbas2(4) = x1mx2 * x2mx3 / ( x1mx4 * x2mx4 * x3mx4 ) + + dbas3(1) = - x2mx3 * x3mx4 / ( x1mx2 * x1mx3 * x1mx4 ) + dbas3(2) = x1mx3 * x3mx4 / ( x1mx2 * x2mx3 * x2mx4 ) + dbas3(3) = -1._r8/x1mx3 - 1._r8/x2mx3 + 1._r8/x3mx4 + dbas3(4) = - x1mx3 * x2mx3 / ( x1mx4 * x2mx4 * x3mx4 ) + + return +end subroutine lcdbas + diff --git a/src/advection/slt/omcalc.F90 b/src/advection/slt/omcalc.F90 new file mode 100644 index 0000000000..c785fa730c --- /dev/null +++ b/src/advection/slt/omcalc.F90 @@ -0,0 +1,146 @@ + +subroutine omcalc(rcoslat ,d ,u ,v ,dpsl , & + dpsm ,pmid ,pdel ,rpmid ,pbot , & + omga ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate vertical pressure velocity (omga = dp/dt) +! +! Method: +! First evaluate the expressions for omega/p, then rescale to omega at +! the end. +! +! Author: CCM1 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon, plevp + use pspect + use hycoef, only: hybm, hybd, nprlev + implicit none + + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! lonitude dimension + real(r8), intent(in) :: rcoslat(nlon) ! 1 / cos(lat) + real(r8), intent(in) :: d(plon,plev) ! divergence + real(r8), intent(in) :: u(plon,plev) ! zonal wind * cos(lat) + real(r8), intent(in) :: v(plon,plev) ! meridional wind * cos(lat) + real(r8), intent(in) :: dpsl(plon) ! longitudinal component of grad ln(ps) + real(r8), intent(in) :: dpsm(plon) ! latitudinal component of grad ln(ps) + real(r8), intent(in) :: pmid(plon,plev) ! mid-level pressures + real(r8), intent(in) :: pdel(plon,plev) ! layer thicknesses (pressure) + real(r8), intent(in) :: rpmid(plon,plev) ! 1./pmid + real(r8), intent(in) :: pbot(plon) ! bottom interface pressure + real(r8), intent(out):: omga(plon,plev) ! vertical pressure velocity +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer i,k ! longitude, level indices + real(r8) d_i(plev) ! divergence (single colummn) + real(r8) u_i(plev) ! zonal wind * cos(lat) (single colummn) + real(r8) v_i(plev) ! meridional wind * cos(lat) (single colummn) + real(r8) pmid_i(plev) ! mid-level pressures (single colummn) + real(r8) pdel_i(plev) ! layer thicknesses (pressure) (single colummn) + real(r8) rpmid_i(plev) ! 1./pmid (single colummn) + real(r8) omga_i(plev) ! vertical pressure velocity (single colummn) + real(r8) hkk ! diagonal element of hydrostatic matrix + real(r8) hlk ! super diagonal element + real(r8) suml ! partial sum over l = (1, k-1) + real(r8) vgpk ! v dot grad ps + real(r8) tmp ! vector temporary +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (I, SUML, D_I, U_I, V_I, PMID_I, PDEL_I, RPMID_I, & +!$OMP OMGA_I, HKK, VGPK, TMP, HLK) + do i=1,nlon +! +! Zero partial sum +! + suml = 0._r8 +! +! Collect column data +! + d_i = d(i,:) + u_i = u(i,:) + v_i = v(i,:) + pmid_i = pmid(i,:) + pdel_i = pdel(i,:) + rpmid_i = rpmid(i,:) +! +! Pure pressure part: top level +! + hkk = 0.5_r8*rpmid_i(1) + omga_i(1) = -hkk*d_i(1)*pdel_i(1) + suml = suml + d_i(1)*pdel_i(1) +! +! sum(k)(v(j)*ps*grad(lnps)*db(j)) part. Not normally invoked since +! the top layer is normally a pure pressure layer. +! + if (1>=nprlev) then + vgpk = rcoslat(i)*(u_i(1)*dpsl(i) + v_i(1)*dpsm(i))*pbot(i) + tmp = vgpk*hybd(1) + omga_i(1) = omga_i(1) + hybm(1)*rpmid_i(1)*vgpk - hkk*tmp + suml = suml + tmp + end if +! +! Integrals to level above bottom +! + do k=2,plev-1 +! +! Pure pressure part +! + hkk = 0.5_r8*rpmid_i(k) + hlk = rpmid_i(k) + omga_i(k) = -hkk*d_i(k)*pdel_i(k) - hlk*suml + suml = suml + d_i(k)*pdel_i(k) +! +! v(j)*grad(lnps) part +! + if (k>=nprlev) then + vgpk = rcoslat(i)*(u_i(k)*dpsl(i) + v_i(k)*dpsm(i))*pbot(i) + tmp = vgpk*hybd(k) + omga_i(k) = omga_i(k) + hybm(k)*rpmid_i(k)*vgpk - hkk*tmp + suml = suml + tmp + end if + end do +! +! Pure pressure part: bottom level +! + hkk = 0.5_r8*rpmid_i(plev) + hlk = rpmid_i(plev) + omga_i(plev) = -hkk*d_i(plev)*pdel_i(plev) - hlk*suml +! +! v(j)*grad(lnps) part. Normally invoked, but omitted if the model is +! running in pure pressure coordinates throughout (e.g. stratospheric +! mechanistic model). +! + if (plev>=nprlev) then + vgpk = rcoslat(i)*(u_i(plev)*dpsl(i) + v_i(plev)*dpsm(i))* pbot(i) + omga_i(plev) = omga_i(plev) + hybm(plev)*rpmid_i(plev)*vgpk - & + hkk*vgpk*hybd(plev) + end if +! +! The above expressions give omega/p. Rescale to omega. +! + do k=1,plev + omga_i(k) = omga_i(k)*pmid_i(k) + end do +! +! Save results +! + omga(i,:) = omga_i(:) +! + end do +! + return +end subroutine omcalc + diff --git a/src/advection/slt/pdelb0.F90 b/src/advection/slt/pdelb0.F90 new file mode 100644 index 0000000000..b378430127 --- /dev/null +++ b/src/advection/slt/pdelb0.F90 @@ -0,0 +1,49 @@ + +subroutine pdelb0(ps ,pdelb ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the pressure intervals between the interfaces for the "B" +! (surface pressure dependent) portion of the hybrid grid only. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use hycoef, only: hybd + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: ps(plon) ! surface Pressure + real(r8), intent(out):: pdelb(plon,plev) ! pressure difference between interfaces + ! (pressure defined using the "B" part + ! of the hybrid grid only) +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer i,k ! longitude, level indices +!----------------------------------------------------------------------- +! +! Compute del P(B) +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + pdelb(i,k) = hybd(k)*ps(i) + end do + end do + + return +end subroutine pdelb0 + diff --git a/src/advection/slt/phcs.F90 b/src/advection/slt/phcs.F90 new file mode 100644 index 0000000000..41e72b1c92 --- /dev/null +++ b/src/advection/slt/phcs.F90 @@ -0,0 +1,238 @@ + +subroutine phcs(pmn ,hmn ,ix ,x1) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute associated Legendre functions of the first kind of order m and +! degree n, and the associated derivatives for arg x1. + +! Method: +! Compute associated Legendre functions of the first kind of order m and +! degree n, and the associated derivatives for arg x1. The associated +! Legendre functions are evaluated using relationships contained in +! "Tables of Normalized Associated Legendre Polynomials", +! S. L. Belousov (1962). Both the functions and their derivatives are +! ordered in a linear stored rectangular array (with a large enough +! domain to contain the particular wavenumber truncation defined in the +! pspect common block) by column. m = 0->ptrm, and n = m->ptrn + m +! m +! The functions P (x) are normalized such that +! n +! / m 2 +! | [P (x)] dx = 1/2 +! / n +! __ +! and must be multiplied by |2 to match Belousov tables. +! \| +! m +! The derivatives H (x) are defined as +! n m 2 m +! H (x) = -(1-x ) dP (x)/dx +! n n +! +! and are evaluated using the recurrence relationship +! _________________________ +! m m | 2 2 m +! H (x) = nx P (x) - |(n - m )(2n + 1)/(2n - 1) P (x) +! n n \| n-1 +! +! Modified 1/23/97 by Jim Rosinski to use real*16 arithmetic in order to +! achieve (nearly) identical values on all machines. +! +! Author: CCM1 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use pspect + implicit none + +#ifdef NO_R16 + integer,parameter :: r16= selected_real_kind(12) ! 8 byte real +#else + integer,parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: ix ! Dimension of Legendre funct arrays + real(r8), intent(in) :: x1 ! sin of latitude, [sin(phi), or mu] + real(r8), intent(out) :: pmn(ix) ! Legendre function array + real(r8), intent(out) :: hmn(ix) ! Derivative array +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer jmax ! Loop limit (N+1=> 2D wavenumber limit +1) + integer nmax ! Large enough n to envelope truncation + integer(i8) n ! 2-D wavenumber index (up/down column) + integer ml ! intermediate scratch variable + integer k ! counter on terms in trig series expansion + integer(i8) n2 ! 2*n + integer m ! zonal wavenumber index + integer nto ! intermediate scratch variable + integer mto ! intermediate scratch variable + integer j ! 2-D wavenumber index in recurrence evaluation + integer nmaxm ! loop limit in recurrence evaluation + + real(r16) xtemp(3,pmmax+ptrn+1) ! Workspace for evaluating recurrence +! ! relation where xtemp(m-2,n) and +! ! xtemp(m-1,n) contain Pmn's required +! ! to evaluate xtemp(m,n) (i.e.,always +! ! contains three adjacent columns of +! ! the Pmn data structure) +! + real(r16) xx1 ! x1 in extended precision + real(r16) xte ! cosine latitude [cos(phi)] + real(r16) teta ! pi/2 - latitute (colatitude) + real(r16) an ! coefficient on trig. series expansion + real(r16) sinpar ! accumulator in trig. series expansion + real(r16) cospar ! accumulator in trig. series expansion + real(r16) p ! 2-D wavenumber (series expansion) + real(r16) q ! intermediate variable in series expansion + real(r16) r ! zonal wavenumber (recurrence evaluation) + real(r16) p2 ! intermediate variable in series expansion + real(r16) rr ! twice the zonal wavenumber (recurrence) + real(r16) sqp ! intermediate variable in series expansion + real(r16) cosfak ! coef. on cos term in series expansion + real(r16) sinfak ! coef. on sin term in series expansion + real(r16) ateta ! intermediate variable in series expansion + real(r16) costet ! cos term in trigonometric series expansion + real(r16) sintet ! sin term in trigonometric series expansion +! + real(r16) t ! intermediate variable (recurrence evaluation) + real(r16) wm2 ! intermediate variable (recurrence evaluation) + real(r16) wmq2 ! intermediate variable (recurrence evaluation) + real(r16) w ! intermediate variable (recurrence evaluation) + real(r16) wq ! intermediate variable (recurrence evaluation) + real(r16) q2 ! intermediate variable (recurrence evaluation) + real(r16) wt ! intermediate variable (recurrence evaluation) + real(r16) q2d ! intermediate variable (recurrence evaluation) + real(r16) cmn ! cmn recurrence coefficient (see Belousov) + real(r16) xdmn ! dmn recurrence coefficient (see Belousov) + real(r16) emn ! emn recurrence coefficient (see Belousov) + real(r16) n2m1 ! n2 - 1 in extended precision + real(r16) n2m3 ! n2 - 3 in extended precision + real(r16) n2p1nnm1 ! (n2+1)*(n*n-1) in extended precision + real(r16) twopmq ! p + p - q in extended precision +!----------------------------------------------------------------------- +! +! Begin procedure by evaluating the first two columns of the Legendre +! function matrix (i.e., all n for m=0,1) via a trigonometric series +! expansion (see eqs. 19 and 21 in Belousov, 1962). Note that indexing +! is offset by one (e.g., m index for wavenumber m=0 is 1 and so on) +! Setup first ... +! + xx1 = x1 + jmax = ptrn + 1 + nmax = pmmax + jmax + xte = (1._r16-xx1*xx1)**0.5_r16 + teta = acos(xx1) + an = 1._r16 + xtemp(1,1) = 0.5_r16 ! P00 +! +! begin loop over n (2D wavenumber, or degree of associated Legendre +! function) beginning with n=1 (i.e., P00 was assigned above) +! note n odd/even distinction yielding 2 results per n cycle +! + do n=2,nmax + sinpar = 0._r16 + cospar = 0._r16 + ml = n + p = n - 1 + p2 = p*p + sqp = 1._r16/(p2+p)**0.5_r16 + an = an*(1._r16 - 1._r16/(4._r16*p2))**0.5_r16 + cosfak = 1._r16 + sinfak = p*sqp + do k=1,ml,2 + q = k - 1 + twopmq = p + p - q + ateta = (p-q)*teta + costet = cos(ateta) + sintet = sin(ateta) + if (n==k) costet = costet*0.5_r16 + if (k/=1) then + cosfak = (q-1._r16)/q*(twopmq+2._r16)/(twopmq+1._r16)*cosfak + sinfak = cosfak*(p-q)*sqp + end if + cospar = cospar + costet*cosfak + sinpar = sinpar + sintet*sinfak + end do + xtemp(1,n) = an*cospar ! P0n vector + xtemp(2,n-1) = an*sinpar ! P1n vector + end do +! +! Assign Legendre functions and evaluate derivatives for all n and m=0,1 +! + pmn(1) = 0.5_r16 + pmn(1+jmax) = xtemp(2,1) + hmn(1) = 0._r16 + hmn(1+jmax) = xx1*xtemp(2,1) + do n=2,jmax + pmn(n) = xtemp(1,n) + pmn(n+jmax) = xtemp(2,n) + n2 = n + n + n2m1 = n2 - 1 + n2m3 = n2 - 3 + n2p1nnm1 = (n2+1)*(n*n-1) + hmn(n) = (n-1)*(xx1*xtemp(1,n)-(n2m1/n2m3)**0.5_r16*xtemp(1,n-1)) + hmn(n+jmax) = n*xx1*xtemp(2,n)-(n2p1nnm1/n2m1)**0.5_r16*xtemp(2,n-1) + end do +! +! Evaluate recurrence relationship for remaining Legendre functions +! (i.e., m=2 ... PTRM) and associated derivatives (see eq 17, Belousov) +! + do m=3,pmmax + r = m - 1 + rr = r + r + xtemp(3,1) = (1._r16+1._r16/rr)**0.5_r16*xte*xtemp(2,1) + nto = (m-1)*jmax + pmn(nto+1) = xtemp(3,1) + hmn(nto+1) = r*xx1*xtemp(3,1) + nmaxm = nmax - m +! +! Loop over 2-D wavenumber (i.e., degree of Legendre function) +! Pmn's and Hmn's for current zonal wavenumber, r +! + do j=2,nmaxm + mto = nto + j + t = j - 1 + q = rr + t - 1 + wm2 = q + t + w = wm2 + 2 + wq = w*q + q2 = q*q - 1 + wmq2 = wm2*q2 + wt = w*t + q2d = q2 + q2 + cmn = ((wq*(q-2._r16))/(wmq2-q2d))**0.5_r16 + xdmn = ((wq*(t+1._r16))/wmq2)**0.5_r16 + emn = (wt/((q+1._r16)*wm2))**0.5_r16 + xtemp(3,j) = cmn*xtemp(1,j) - xx1*(xdmn*xtemp(1,j+1)-emn*xtemp(3,j-1)) + pmn(mto) = xtemp(3,j) + hmn(mto) = (r+t)*xx1*xtemp(3,j) - (wt*(q+1._r16)/wm2)**0.5_r16*xtemp(3,j-1) + end do +! +! shift Pmn's to left in workspace (setup for next recurrence pass) +! +!++pjr +! not initialized above + xtemp(2,nmax) = 0._r16 + do j=nmaxm,nmax + xtemp(3,j) = 0._r16 + end do +!--pjr + do n=1,nmax + xtemp(1,n) = xtemp(2,n) + xtemp(2,n) = xtemp(3,n) + end do + end do + + return +end subroutine phcs + diff --git a/src/advection/slt/plevs0.F90 b/src/advection/slt/plevs0.F90 new file mode 100644 index 0000000000..f43df7587e --- /dev/null +++ b/src/advection/slt/plevs0.F90 @@ -0,0 +1,63 @@ + +subroutine plevs0 (ncol , ncold ,nver ,ps ,pint , & + pmid ,pdel) + +!----------------------------------------------------------------------- +! +! Purpose: +! Define the pressures of the interfaces and midpoints from the +! coordinate definitions and the surface pressure. +! +! Method: +! +! Author: B. Boville +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plevp + use hycoef, only: hyai, hybi, ps0, hyam, hybm + implicit none + + +!----------------------------------------------------------------------- + integer , intent(in) :: ncol ! Longitude dimension + integer , intent(in) :: ncold ! Declared longitude dimension + integer , intent(in) :: nver ! vertical dimension + real(r8), intent(in) :: ps(ncold) ! Surface pressure (pascals) + real(r8), intent(out) :: pint(ncold,nver+1) ! Pressure at model interfaces + real(r8), intent(out) :: pmid(ncold,nver) ! Pressure at model levels + real(r8), intent(out) :: pdel(ncold,nver) ! Layer thickness (pint(k+1) - pint(k)) +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer i,k ! Longitude, level indices +!----------------------------------------------------------------------- +! +! Set interface pressures +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,nver+1 + do i=1,ncol + pint(i,k) = hyai(k)*ps0 + hybi(k)*ps(i) + end do + end do +! +! Set midpoint pressures and layer thicknesses +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,nver + do i=1,ncol + pmid(i,k) = hyam(k)*ps0 + hybm(k)*ps(i) + pdel(i,k) = pint(i,k+1) - pint(i,k) + end do + end do + + return +end subroutine plevs0 + diff --git a/src/advection/slt/qmassa.F90 b/src/advection/slt/qmassa.F90 new file mode 100644 index 0000000000..dc6055c47b --- /dev/null +++ b/src/advection/slt/qmassa.F90 @@ -0,0 +1,111 @@ +module qmassa + + +contains + +subroutine qmassarun(cwava ,w ,q3 ,pdel ,hw1lat , & + nlon ,q0 ,lat ,pdeld ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate contribution of current latitude to mass of constituents +! being advected by slt. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use constituents, only: pcnst, cnst_get_type_byind + use dycore, only: dycore_is + use cam_abortutils, only: endrun + + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: q3(plon,plev,pcnst) ! constituents + real(r8), intent(in) :: q0(plon,plev,pcnst) ! constituents at begining of time step + real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces + real(r8), intent(out) :: hw1lat(pcnst) ! accumulator + real(r8), intent(in),optional :: pdeld(:,:) ! dry pressure difference for dry-type constituents + ! only used when called from eularian dynamics + + + integer lat +!----------------------------------------------------------------------- +! +!---------------------------Local variables----------------------------- + integer i,k,m ! longitude, level, constituent indices + real(r8) const ! temporary constant +!----------------------------------------------------------------------- +! +! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) +! + const = cwava*w*0.5_r8 + do m=1,pcnst + hw1lat(m) = 0._r8 + end do + +!$OMP PARALLEL DO PRIVATE (M, K, I) + do m=1,pcnst + if (m == 1) then +! +! Compute mass integral for water +! + do k=1,plev + do i=1,nlon + hw1lat(1) = hw1lat(1) + q3(i,k,1)*pdel(i,k) + end do + end do +! +! Compute mass integral for non-water constituents (on either WET or DRY basis) +! + elseif (cnst_get_type_byind(m).eq.'dry' ) then ! dry type constituents + if ( dycore_is ('EUL') ) then ! EUL dycore computes pdeld in time filter + if ( .not. present(pdeld) ) & + call endrun('for dry type cnst with eul dycore, qmassa requires pdeld argument') + do k=1,plev + do i=1,nlon + hw1lat(m) = hw1lat(m) + q3(i,k,m)*pdeld(i,k) + end do + end do + else !dycore SLD + do k=1,plev + do i=1,nlon + hw1lat(m) = hw1lat(m) + q3(i,k,m)*(1._r8 - q0(i,k,1))*pdel(i,k) + end do + end do + endif ! dycore + else !wet type constituents + do k=1,plev + do i=1,nlon + hw1lat(m) = hw1lat(m) + q3(i,k,m)*(1._r8 - q3(i,k,1))*pdel(i,k) + end do + end do + end if !dry or wet + end do + + do m = 1,pcnst + hw1lat(m) = hw1lat(m)*const + end do + + return +end subroutine qmassarun + +end module qmassa + + + + diff --git a/src/advection/slt/qmassd.F90 b/src/advection/slt/qmassd.F90 new file mode 100644 index 0000000000..b8650270b2 --- /dev/null +++ b/src/advection/slt/qmassd.F90 @@ -0,0 +1,69 @@ + +subroutine qmassd(cwava ,etamid ,w ,q1 ,q2 , & + pdel ,hwn ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute comtribution of current latitude to global integral of +! q2*|q2 - q1|*eta +! This is a measure of the difference between the fields before and +! after the SLT "forecast" weighted by the approximate mass of the tracer. +! It is used in the "fixer" which enforces conservation in constituent +! fields transport via SLT. +! +! Method: +! Reference Rasch and Williamson, 1991, Rasch, Boville and Brasseur, 1995 +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use constituents, only: pcnst + + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: cwava ! normalization factor + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: q1(plon,plev) ! constituents (pre -SLT) + real(r8), intent(in) :: q2(plon,plev) ! constituents (post-SLT) + real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces + real(r8), intent(inout) :: hwn(pcnst) ! accumulator for global integrals +! +! cwava l/(g*plon) +! w Gaussian weight. +! q1 Untransported q-field. +! q2 Transported q-field. +! pdel array of pressure differences between layer interfaces (used for mass weighting) +! hwn Mass averaged constituent in units of kg/m**2. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k ! longitude and level indices + real(r8) hwava ! accumulator +!----------------------------------------------------------------------- +! + hwava = 0.0_r8 + do k=1,plev + do i=1,nlon + hwava = hwava + (q2(i,k)* etamid(k)*(abs(q1(i,k) - q2(i,k))))*pdel(i,k) + end do + end do +! +! The 0.5 factor arises because gaussian weights sum to 2 +! + hwn(1) = hwn(1) + cwava*w*hwava*0.5_r8 + + return +end subroutine qmassd + diff --git a/src/advection/slt/reordp.F90 b/src/advection/slt/reordp.F90 new file mode 100644 index 0000000000..a830a9f5e1 --- /dev/null +++ b/src/advection/slt/reordp.F90 @@ -0,0 +1,57 @@ + +subroutine reordp(irow ,iy ,zalp ,zdalp ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Renormalize associated Legendre polynomials and their derivatives. +! +! Method: +! Reorder associated Legendre polynomials and their derivatives from +! column rectangular storage to diagonal pentagonal storage. The +! reordered polynomials and derivatives are returned via common/comspe/ +! +! Author: CCM1 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pspect + use comspe + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: irow ! latitude pair index + integer , intent(in) :: iy ! dimension of input polynomials + real(r8), intent(in) :: zalp(iy) ! Legendre polynomial + real(r8), intent(in) :: zdalp(iy) ! Legendre polynomial derivative +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer mr ! spectral index + integer m ! index along diagonal and row + integer n ! index of diagonal + real(r8) sqrt2 ! sqrt(2) +!----------------------------------------------------------------------- +! +! Multiply ALP and DALP by SQRT(2.) in order to get proper +! normalization. DALP is multiplied by -1 to correct for - sign +! in Copenhagen definition. +! + sqrt2 = sqrt(2._r8) + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m) + alp(mr+n,irow) = zalp((m-1)*pmax + n)*sqrt2 + dalp(mr+n,irow) = -zdalp((m-1)*pmax + n)*sqrt2 + end do + end do + + return +end subroutine reordp + diff --git a/src/advection/slt/scm0.F90 b/src/advection/slt/scm0.F90 new file mode 100644 index 0000000000..8810c180dc --- /dev/null +++ b/src/advection/slt/scm0.F90 @@ -0,0 +1,57 @@ + +subroutine scm0(n ,deli ,df1 ,df2 ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Apply SCM0 limiter to derivative estimates. +! See Rasch and Williamson (1990) +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: n ! length of vectors + real(r8), intent(in) :: deli(n) ! discrete derivative + real(r8), intent(inout) :: df1(n) ! limited left -edge derivative + real(r8), intent(inout) :: df2(n) ! limited right-edge derivative +! +! n Dimension of input arrays. +! deli deli(i) is the discrete derivative on interval i, i.e., +! deli(i) = ( f(i+1) - f(i) )/( x(i+1) - x(i) ). +! df1 df1(i) is the limited derivative at the left edge of interval +! df2 df2(i) is the limited derivative at the right edge of interval +!----------------------------------------------------------------------- + + +!---------------------------Local variables----------------------------- + integer i ! index + real(r8) fac ! factor applied in limiter + real(r8) tmp1 ! derivative factor + real(r8) tmp2 ! abs(tmp1) +!----------------------------------------------------------------------- +! + fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) + do i = 1,n + tmp1 = fac*deli(i) + tmp2 = abs( tmp1 ) + if( deli(i)*df1(i) <= 0.0_r8 ) df1(i) = 0._r8 + if( deli(i)*df2(i) <= 0.0_r8 ) df2(i) = 0._r8 + if( abs( df1(i) ) > tmp2 ) df1(i) = tmp1 + if( abs( df2(i) ) > tmp2 ) df2(i) = tmp1 + end do + + return +end subroutine scm0 + diff --git a/src/advection/slt/xqmass.F90 b/src/advection/slt/xqmass.F90 new file mode 100644 index 0000000000..5db28ff606 --- /dev/null +++ b/src/advection/slt/xqmass.F90 @@ -0,0 +1,150 @@ + +subroutine xqmass(cwava ,etamid ,w ,qo ,qn , & + xo ,xn ,pdela ,pdelb ,hwxal , & + hwxbl ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute comtribution of current latitude to global integrals necessary +! to compute the fixer for the non-water constituents. +! +! Method: +! +! Author: J. Olson, March 1994 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use constituents, only: pcnst, cnst_get_type_byind + + implicit none + +!---------------------------Arguments----------------------------------- + real(r8), intent(in) :: cwava ! normalization factor + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: w ! gaussian weight this latitude + real(r8), intent(in) :: qo(plon,plev ) ! q old (pre -SLT) + real(r8), intent(in) :: qn(plon,plev ) ! q new (post-SLT) + real(r8), intent(in) :: xo(plon,plev,pcnst) ! old constituents (pre -SLT) + real(r8), intent(in) :: xn(plon,plev,pcnst) ! new constituents (post-SLT) + real(r8), intent(in) :: pdela(plon,plev) ! pressure diff between interfaces + integer , intent(in) :: nlon ! number of longitudes + ! based pure pressure part of hybrid grid + real(r8), intent(in) :: pdelb(plon,plev) ! pressure diff between interfaces + ! based sigma part of hybrid grid + real(r8), intent(inout) :: hwxal(pcnst,4) ! partial integrals (weighted by pure + ! pressure part of hybrid pressures) + real(r8), intent(inout) :: hwxbl(pcnst,4) ! partial integrals (weighted by sigma + ! part of hybrid pressures) +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i ! longitude index + integer k ! level index + integer m ! constituent index + integer n ! index for partial integral + real(r8) a ! integral constant + real(r8) xdx,xq1,xqdq,xdxq1 ! work elements + real(r8) xdxqdq ! work elements + real(r8) hwak(4),hwbk(4) ! work arrays + real(r8) q1 (plon,plev) ! work array + real(r8) qdq(plon,plev) ! work array + real(r8) hwalat(4) ! partial integrals (weighted by pure +! ! pressure part of hybrid pressures) + real(r8) hwblat(4) ! partial integrals (weighted by sigma +! ! part of hybrid pressures) + real(r8) etamsq(plev) ! etamid*etamid + real(r8) xnt(plon) ! temp version of xn + character*3 cnst_type ! 'dry' or 'wet' mixing ratio +!----------------------------------------------------------------------- +! + a = cwava*w*0.5_r8 + do k = 1,plev + etamsq(k) = etamid(k)*etamid(k) + end do +! +! Compute terms involving water vapor mixing ratio +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + q1 (i,k) = 1._r8 - qn(i,k) + qdq(i,k) = qn(i,k)*abs(qn(i,k) - qo(i,k)) + end do + end do +! +! Compute partial integrals for non-water constituents +! +!$OMP PARALLEL DO PRIVATE (M, CNST_TYPE, N, HWALAT, HWBLAT, K, HWAK, HWBK, & +!$OMP I, XNT, XDX, XQ1, XQDQ, XDXQ1, XDXQDQ) + do m = 2,pcnst + cnst_type = cnst_get_type_byind(m) + do n = 1,4 + hwalat(n) = 0._r8 + hwblat(n) = 0._r8 + end do + do k = 1,plev + do n = 1,4 + hwak(n) = 0._r8 + hwbk(n) = 0._r8 + end do + + if (cnst_type.eq.'dry' ) then + do i = 1, nlon + if (abs(xn(i,k,m) - xo(i,k,m)) & + .lt.1.0e-13_r8 * max(abs(xn(i,k,m)), abs(xo(i,k,m)))) then + xnt(i) = xo(i,k,m) + else + xnt(i) = xn(i,k,m) + end if + end do + else + do i = 1, nlon + xnt(i) = xn(i,k,m) + end do + end if + + do i = 1,nlon + xdx = xnt(i)*abs(xn(i,k,m) - xo(i,k,m)) + xq1 = xnt(i)*q1 (i,k) + xqdq = xnt(i)*qdq(i,k) + xdxq1 = xdx *q1 (i,k) + xdxqdq = xdx *qdq(i,k) + + hwak(1) = hwak(1) + xq1 *pdela(i,k) + hwbk(1) = hwbk(1) + xq1 *pdelb(i,k) + hwak(2) = hwak(2) + xqdq *pdela(i,k) + hwbk(2) = hwbk(2) + xqdq *pdelb(i,k) + hwak(3) = hwak(3) + xdxq1 *pdela(i,k) + hwbk(3) = hwbk(3) + xdxq1 *pdelb(i,k) + hwak(4) = hwak(4) + xdxqdq*pdela(i,k) + hwbk(4) = hwbk(4) + xdxqdq*pdelb(i,k) + end do + + hwalat(1) = hwalat(1) + hwak(1) + hwblat(1) = hwblat(1) + hwbk(1) + hwalat(2) = hwalat(2) + hwak(2)*etamid(k) + hwblat(2) = hwblat(2) + hwbk(2)*etamid(k) + hwalat(3) = hwalat(3) + hwak(3)*etamid(k) + hwblat(3) = hwblat(3) + hwbk(3)*etamid(k) + hwalat(4) = hwalat(4) + hwak(4)*etamsq(k) + hwblat(4) = hwblat(4) + hwbk(4)*etamsq(k) + end do +! +! The 0.5 factor arises because Gaussian weights sum to 2 +! + do n = 1,4 + hwxal(m,n) = hwxal(m,n) + hwalat(n)*a + hwxbl(m,n) = hwxbl(m,n) + hwblat(n)*a + end do + end do + + return +end subroutine xqmass diff --git a/src/chemistry/aerosol/cldaero_mod.F90 b/src/chemistry/aerosol/cldaero_mod.F90 new file mode 100644 index 0000000000..c199093efb --- /dev/null +++ b/src/chemistry/aerosol/cldaero_mod.F90 @@ -0,0 +1,148 @@ +!---------------------------------------------------------------------------------- +! low level utility module for cloud aerosols +! +! Created by Francis Vitt +!---------------------------------------------------------------------------------- +module cldaero_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver + + implicit none + private + + public :: cldaero_uptakerate + public :: cldaero_conc_t + public :: cldaero_allocate + public :: cldaero_deallocate + + type cldaero_conc_t + real(r8), pointer :: so4c(:,:) + real(r8), pointer :: nh4c(:,:) + real(r8), pointer :: no3c(:,:) + real(r8), pointer :: xlwc(:,:) + real(r8) :: so4_fact + end type cldaero_conc_t + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function cldaero_allocate( ) result( cldconc ) + type(cldaero_conc_t), pointer:: cldconc + + allocate( cldconc ) + allocate( cldconc%so4c(pcols,pver) ) + allocate( cldconc%nh4c(pcols,pver) ) + allocate( cldconc%no3c(pcols,pver) ) + allocate( cldconc%xlwc(pcols,pver) ) + + cldconc%so4c(:,:) = 0._r8 + cldconc%nh4c(:,:) = 0._r8 + cldconc%no3c(:,:) = 0._r8 + cldconc%xlwc(:,:) = 0._r8 + cldconc%so4_fact = 2._r8 + + end function cldaero_allocate + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + subroutine cldaero_deallocate( cldconc ) + type(cldaero_conc_t), pointer :: cldconc + + if ( associated(cldconc%so4c) ) then + deallocate(cldconc%so4c) + nullify(cldconc%so4c) + endif + + if ( associated(cldconc%nh4c) ) then + deallocate(cldconc%nh4c) + nullify(cldconc%nh4c) + endif + + if ( associated(cldconc%no3c) ) then + deallocate(cldconc%no3c) + nullify(cldconc%no3c) + endif + + if ( associated(cldconc%xlwc) ) then + deallocate(cldconc%xlwc) + nullify(cldconc%xlwc) + endif + + deallocate( cldconc ) + nullify( cldconc ) + + end subroutine cldaero_deallocate + +!---------------------------------------------------------------------------------- +! utility function for cloud-borne aerosols +!---------------------------------------------------------------------------------- + + function cldaero_uptakerate( xl, cldnum, cfact, cldfrc, tfld, press ) result( uptkrate ) + use mo_constants, only : pi + + real(r8), intent(in) :: xl, cldnum, cfact, cldfrc, tfld, press + + real(r8) :: uptkrate + + real(r8) :: & + rad_cd, radxnum_cd, num_cd, & + gasdiffus, gasspeed, knudsen, & + fuchs_sutugin, volx34pi_cd + +!----------------------------------------------------------------------- +! compute uptake of h2so4 and msa to cloud water +! +! first-order uptake rate is +! 4*pi*(drop radius)*(drop number conc) +! *(gas diffusivity)*(fuchs sutugin correction) + +! num_cd = (drop number conc in 1/cm^3) + num_cd = 1.0e-3_r8*cldnum*cfact/cldfrc + num_cd = max( num_cd, 0.0_r8 ) + +! rad_cd = (drop radius in cm), computed from liquid water and drop number, +! then bounded by 0.5 and 50.0 micrometers +! radxnum_cd = (drop radius)*(drop number conc) +! volx34pi_cd = (3/4*pi) * (liquid water volume in cm^3/cm^3) + + volx34pi_cd = xl*0.75_r8/pi + +! following holds because volx34pi_cd = num_cd*(rad_cd**3) + radxnum_cd = (volx34pi_cd*num_cd*num_cd)**0.3333333_r8 + +! apply bounds to rad_cd to avoid the occasional unphysical value + if (radxnum_cd .le. volx34pi_cd*4.0e4_r8) then + radxnum_cd = volx34pi_cd*4.0e4_r8 + rad_cd = 50.0e-4_r8 + else if (radxnum_cd .ge. volx34pi_cd*4.0e8_r8) then + radxnum_cd = volx34pi_cd*4.0e8_r8 + rad_cd = 0.5e-4_r8 + else + rad_cd = radxnum_cd/num_cd + end if + +! gasdiffus = h2so4 gas diffusivity from mosaic code (cm^2/s) +! (pmid must be Pa) + gasdiffus = 0.557_r8 * (tfld**1.75_r8) / press + +! gasspeed = h2so4 gas mean molecular speed from mosaic code (cm/s) + gasspeed = 1.455e4_r8 * sqrt(tfld/98.0_r8) + +! knudsen number + knudsen = 3.0_r8*gasdiffus/(gasspeed*rad_cd) + +! following assumes accomodation coefficient = 0.65 +! (Adams & Seinfeld, 2002, JGR, and references therein) +! fuchs_sutugin = (0.75*accom*(1. + knudsen)) / +! (knudsen*(1.0 + knudsen + 0.283*accom) + 0.75*accom) + fuchs_sutugin = (0.4875_r8*(1._r8 + knudsen)) / & + (knudsen*(1.184_r8 + knudsen) + 0.4875_r8) + +! instantaneous uptake rate + uptkrate = 12.56637_r8*radxnum_cd*gasdiffus*fuchs_sutugin + + end function cldaero_uptakerate + +end module cldaero_mod diff --git a/src/chemistry/aerosol/drydep_mod.F90 b/src/chemistry/aerosol/drydep_mod.F90 new file mode 100644 index 0000000000..1e83641d71 --- /dev/null +++ b/src/chemistry/aerosol/drydep_mod.F90 @@ -0,0 +1,268 @@ +module drydep_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid + + ! Shared Data for dry deposition calculation. + + real(r8) rair ! Gas constant for dry air (J/K/kg) + real(r8) gravit ! Gravitational acceleration +! real(r8), allocatable :: phi(:) ! grid latitudes (radians)11 + +contains + +!############################################################################## + +! $Id$ + + subroutine inidrydep( xrair, xgravit) !, xphi ) + +! Initialize dry deposition parameterization. + + implicit none + +! Input arguments: + real(r8), intent(in) :: xrair ! Gas constant for dry air + real(r8), intent(in) :: xgravit ! Gravitational acceleration +! real(r8), intent(in) :: xphi(:) ! grid latitudes (radians) + +! Local variables: + integer i, j, ncid, vid, ns +!----------------------------------------------------------------------- +! ns = size(xphi) +! allocate(phi(ns)) + rair = xrair + gravit = xgravit +! do j = 1, ns +! phi(j) = xphi(j) +! end do + + return + end subroutine inidrydep + +!############################################################################## + + subroutine setdvel( ncol, landfrac, icefrac, ocnfrac, vgl, vgo, vgsi, vg ) + +! Set the deposition velocity depending on whether we are over +! land, ocean, and snow/ice + + + implicit none + +! Input arguments: + + integer, intent(in) :: ncol + real (r8), intent(in) :: landfrac(pcols) ! land fraction + real (r8), intent(in) :: icefrac(pcols) ! ice fraction + real (r8), intent(in) :: ocnfrac(pcols) ! ocean fraction + + real(r8), intent(in) :: vgl ! dry deposition velocity in m/s (land) + real(r8), intent(in) :: vgo ! dry deposition velocity in m/s (ocean) + real(r8), intent(in) :: vgsi ! dry deposition velocity in m/s (snow/ice) + +! Output arguments: + real(r8), intent(out) :: vg(pcols) ! dry deposition velocity in m/s + +! Local variables: + + integer i + real(r8) a + + + do i = 1, ncol + vg(i) = landfrac(i)*vgl + ocnfrac(i)*vgo + icefrac(i)*vgsi +! if (ioro(i).eq.0) then +! vg(i) = vgo +! else if (ioro(i).eq.1) then +! vg(i) = vgl +! else +! vg(i) = vgsi +! endif + end do + + return + end subroutine setdvel + +!############################################################################## + + subroutine ddflux( ncol, vg, q, p, tv, flux ) + +! Compute surface flux due to dry deposition processes. + + + implicit none + +! Input arguments: + integer , intent(in) :: ncol + real(r8), intent(in) :: vg(pcols) ! dry deposition velocity in m/s + real(r8), intent(in) :: q(pcols) ! tracer conc. in surface layer (kg tracer/kg moist air) + real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) + real(r8), intent(in) :: tv(pcols) ! midpoint virtual temperature in surface layer (K) + +! Output arguments: + + real(r8), intent(out) :: flux(pcols) ! flux due to dry deposition in kg/m^s/sec + +! Local variables: + + integer i + + do i = 1, ncol + flux(i) = -vg(i) * q(i) * p(i) /(tv(i) * rair) + end do + + return + end subroutine ddflux + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine d3ddflux +! +! !INTERFACE: +! + subroutine d3ddflux ( ncol, vlc_dry, q,pmid,pdel, tv, dep_dry,dep_dry_tend,dt) +! Description: +!Do 3d- settling deposition calculations following Zender's dust codes, Dec 02. +! +! Author: Natalie Mahowald +! + implicit none + +! Input arguments: + integer , intent(in) :: ncol + real(r8), intent(in) :: vlc_dry(pcols,pver) ! dry deposition velocity in m/s + real(r8), intent(in) :: q(pcols,pver) ! tracer conc. in surface layer (kg tracer/kg moist air) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure in surface layer (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! delta pressure across level (Pa) + real(r8), intent(in) :: tv(pcols,pver) ! midpoint virtual temperature in surface layer (K) + real(r8), intent(in) :: dt ! time step + +! Output arguments: + + real(r8), intent(out) :: dep_dry(pcols) ! flux due to dry deposition in kg /m^s/sec + real(r8), intent(out) :: dep_dry_tend(pcols,pver) ! flux due to dry deposition in kg /m^s/sec + +! Local variables: + + real(r8) :: flux(pcols,0:pver) ! downward flux at each level: kg/m2/s + integer i,k + do i=1,ncol + flux(i,0)=0._r8 + enddo + do k=1,pver + do i = 1, ncol + flux(i,k) = -min(vlc_dry(i,k) * q(i,k) * pmid(i,k) /(tv(i,k) * rair), & + q(i,k)*pdel(i,k)/gravit/dt) + dep_dry_tend(i,k)=(flux(i,k)-flux(i,k-1))/pdel(i,k)*gravit !kg/kg/s + + end do + enddo +! surface flux: + do i=1,ncol + dep_dry(i)=flux(i,pver) + enddo + return + end subroutine d3ddflux + + + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine Calcram +! +! !INTERFACE: +! + + subroutine calcram(ncol,landfrac,icefrac,ocnfrac,obklen,& + ustar,ram1in,ram1,t,pmid,& + pdel,fvin,fv) + ! + ! !DESCRIPTION: + ! + ! Calc aerodynamic resistance over oceans and sea ice (comes in from land model) + ! from Seinfeld and Pandis, p.963. + ! + ! Author: Natalie Mahowald + ! + implicit none + integer, intent(in) :: ncol + real(r8),intent(in) :: ram1in(pcols) !aerodynamical resistance (s/m) + real(r8),intent(in) :: fvin(pcols) ! sfc frc vel from land + real(r8),intent(out) :: ram1(pcols) !aerodynamical resistance (s/m) + real(r8),intent(out) :: fv(pcols) ! sfc frc vel from land + real(r8), intent(in) :: obklen(pcols) ! obklen + real(r8), intent(in) :: ustar(pcols) ! sfc fric vel + real(r8), intent(in) :: landfrac(pcols) ! land fraction + real(r8), intent(in) :: icefrac(pcols) ! ice fraction + real(r8), intent(in) :: ocnfrac(pcols) ! ocean fraction + real(r8), intent(in) :: t(pcols) !atm temperature (K) + real(r8), intent(in) :: pmid(pcols) !atm pressure (Pa) + real(r8), intent(in) :: pdel(pcols) !atm pressure (Pa) + real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length + real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length + real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant + + ! local variables + real(r8) :: z,psi,psi0,nu,nu0,temp,ram + integer :: i + ! write(iulog,*) rair,zzsice,zzocen,gravit,xkar + + + do i=1,ncol + z=pdel(i)*rair*t(i)/pmid(i)/gravit/2.0_r8 !use half the layer height like Ganzefeld and Lelieveld, 1995 + if(obklen(i).eq.0) then + psi=0._r8 + psi0=0._r8 + else + psi=min(max(z/obklen(i),-1.0_r8),1.0_r8) + psi0=min(max(zzocen/obklen(i),-1.0_r8),1.0_r8) + endif + temp=z/zzocen + if(icefrac(i) > 0.5_r8) then + if(obklen(i).gt.0) then + psi0=min(max(zzsice/obklen(i),-1.0_r8),1.0_r8) + else + psi0=0.0_r8 + endif + temp=z/zzsice + endif + if(psi> 0._r8) then + ram=1/xkar/ustar(i)*(log(temp)+4.7_r8*(psi-psi0)) + else + nu=(1.00_r8-15.000_r8*psi)**(.25_r8) + nu0=(1.000_r8-15.000_r8*psi0)**(.25_r8) + if(ustar(i).ne.0._r8) then + ram=1/xkar/ustar(i)*(log(temp) & + +log(((nu0**2+1.00_r8)*(nu0+1.0_r8)**2)/((nu**2+1.0_r8)*(nu+1.00_r8)**2)) & + +2.0_r8*(atan(nu)-atan(nu0))) + else + ram=0._r8 + endif + endif + if(landfrac(i) < 0.000000001_r8) then + fv(i)=ustar(i) + ram1(i)=ram + else + fv(i)=fvin(i) + ram1(i)=ram1in(i) + endif + ! write(iulog,*) i,pdel(i),t(i),pmid(i),gravit,obklen(i),psi,psi0,icefrac(i),nu,nu0,ram,ustar(i),& + ! log(((nu0**2+1.00)*(nu0+1.0)**2)/((nu**2+1.0)*(nu+1.00)**2)),2.0*(atan(nu)-atan(nu0)) + + enddo + + ! fvitt -- fv == 0 causes a floating point exception in + ! dry dep of sea salts and dust + where ( fv(:ncol) == 0._r8 ) + fv(:ncol) = 1.e-12_r8 + endwhere + + return + end subroutine calcram + + +!############################################################################## +end module drydep_mod diff --git a/src/chemistry/aerosol/dust_common.F90 b/src/chemistry/aerosol/dust_common.F90 new file mode 100644 index 0000000000..b5469f6bd5 --- /dev/null +++ b/src/chemistry/aerosol/dust_common.F90 @@ -0,0 +1,253 @@ +!============================================================================= +! Common dust module +!============================================================================= +module dust_common + + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + private + + public :: dust_set_params + +contains + + !============================================================================= + ! + ! !DESCRIPTION: + ! + ! Compute source efficiency factor from topography + ! Initialize other variables used in subroutine Dust: + ! ovr_src_snk_mss(m,n) and tmp1. + ! Define particle diameter and density needed by atm model + ! as well as by dry dep model + ! Source: Paul Ginoux (for source efficiency factor) + ! Modifications by C. Zender and later by S. Levis + ! Rest of subroutine from C. Zender's dust model + !============================================================================= + subroutine dust_set_params( nbin, dmt_grd, dmt_vwr, stk_crc ) + + ! + ! !USES + ! + use physconst, only: pi,rair, gravit + use mo_constants, only: dust_density + use infnan, only: nan, assignment(=) + + ! + ! !ARGUMENTS: + ! + integer, intent(in) :: nbin + real(r8),intent(in) :: dmt_grd(:) + real(r8),intent(out) :: dmt_vwr(:) + real(r8),intent(out) :: stk_crc(:) + + ! + ! !REVISION HISTORY + ! Created by Samual Levis + ! Revised for CAM by Natalie Mahowald + !EOP + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !Local Variables + integer, parameter:: dst_src_nbr =3 + integer, parameter:: sz_nbr =200 + + integer :: m,n !indices + real(r8) :: dmt_min(nbin) ![m] Size grid minimum + real(r8) :: dmt_max(nbin) ![m] Size grid maximum + real(r8) :: dmt_ctr(nbin) ![m] Diameter at bin center + real(r8) :: dmt_dlt(nbin) ![m] Width of size bin + real(r8) :: slp_crc(nbin) ![frc] Slip correction factor + real(r8) :: vlm_rsl(nbin) ![m3 m-3] Volume concentration resolved + real(r8) :: vlc_stk(nbin) ![m s-1] Stokes settling velocity + real(r8) :: vlc_grv(nbin) ![m s-1] Settling velocity + real(r8) :: ryn_nbr_grv(nbin) ![frc] Reynolds number at terminal velocity + real(r8) :: cff_drg_grv(nbin) ![frc] Drag coefficient at terminal velocity + real(r8) :: tmp !temporary + real(r8) :: ln_gsd ![frc] ln(gsd) + real(r8) :: gsd_anl ![frc] Geometric standard deviation + real(r8) :: dmt_vma ![m] Mass median diameter analytic She84 p.75 Tabl.1 + real(r8) :: dmt_nma ![m] Number median particle diameter + real(r8) :: lgn_dst !Lognormal distribution at sz_ctr + real(r8) :: eps_max ![frc] Relative accuracy for convergence + real(r8) :: eps_crr ![frc] Current relative accuracy + real(r8) :: itr_idx ![idx] Counting index + real(r8) :: dns_mdp ![kg m-3] Midlayer density + real(r8) :: mfp_atm ![m] Mean free path of air + real(r8) :: vsc_dyn_atm ![kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm ![kg m-1 s-1] Kinematic viscosity of air + real(r8) :: vlc_grv_old ![m s-1] Previous gravitational settling velocity + real(r8) :: series_ratio !Factor for logarithmic grid + real(r8) :: lngsdsqrttwopi_rcp !Factor in lognormal distribution + real(r8) :: sz_min(sz_nbr) ![m] Size Bin minima + real(r8) :: sz_max(sz_nbr) ![m] Size Bin maxima + real(r8) :: sz_ctr(sz_nbr) ![m] Size Bin centers + real(r8) :: sz_dlt(sz_nbr) ![m] Size Bin widths + + stk_crc(:) = nan + dmt_vwr(:) = nan + + ! Introducing particle diameter. Needed by atm model and by dry dep model. + ! Taken from Charlie Zender's subroutines dst_psd_ini, dst_sz_rsl, + ! grd_mk (dstpsd.F90) and subroutine lgn_evl (psdlgn.F90) + + ! Charlie allows logarithmic or linear option for size distribution + ! however, he hardwires the distribution to logarithmic in his code + ! therefore, I take his logarithmic code only + ! furthermore, if dst_nbr == 4, he overrides the automatic grid calculation + ! he currently works with dst_nbr = 4, so I only take the relevant code + ! if dust_number ever becomes different from 4, must add call grd_mk (dstpsd.F90) + ! as done in subroutine dst_psd_ini + ! note that here dust_number = dst_nbr + + ! Override automatic grid with preset grid if available + do n = 1, nbin + dmt_min(n) = dmt_grd(n) ![m] Max diameter in bin + dmt_max(n) = dmt_grd(n+1) ![m] Min diameter in bin + dmt_ctr(n) = 0.5_r8 * (dmt_min(n)+dmt_max(n)) ![m] Diameter at bin ctr + dmt_dlt(n) = dmt_max(n)-dmt_min(n) ![m] Width of size bin + end do + + ! sets dust_dmt_vwr .... + + ! Bin physical properties + gsd_anl = 2.0_r8 ! [frc] Geometric std dev PaG77 p. 2080 Table1 + ln_gsd = log(gsd_anl) + + ! Set a fundamental statistic for each bin + dmt_vma = 2.524e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + dmt_vma = 3.5e-6_r8 + ! Compute analytic size statistics + ! Convert mass median diameter to number median diameter (call vma2nma) + dmt_nma = dmt_vma * exp(-3.0_r8*ln_gsd*ln_gsd) ! [m] + ! Compute resolved size statistics for each size distribution + ! In C. Zender's code call dst_sz_rsl + do n = 1, nbin + series_ratio = (dmt_max(n)/dmt_min(n))**(1.0_r8/sz_nbr) + sz_min(1) = dmt_min(n) + do m = 2, sz_nbr ! Loop starts at 2 + sz_min(m) = sz_min(m-1) * series_ratio + end do + + ! Derived grid values + do m = 1, sz_nbr-1 ! Loop ends at sz_nbr-1 + sz_max(m) = sz_min(m+1) ! [m] + end do + sz_max(sz_nbr) = dmt_max(n) ! [m] + + ! Final derived grid values + do m = 1, sz_nbr + sz_ctr(m) = 0.5_r8 * (sz_min(m)+sz_max(m)) + sz_dlt(m) = sz_max(m)-sz_min(m) + end do + lngsdsqrttwopi_rcp = 1.0_r8 / (ln_gsd*sqrt(2.0_r8*pi)) + dmt_vwr(n) = 0.0_r8 ! [m] Mass wgted diameter resolved + vlm_rsl(n) = 0.0_r8 ! [m3 m-3] Volume concentration resolved + do m = 1, sz_nbr + ! Evaluate lognormal distribution for these sizes (call lgn_evl) + tmp = log(sz_ctr(m)/dmt_nma) / ln_gsd + lgn_dst = lngsdsqrttwopi_rcp * exp(-0.5_r8*tmp*tmp) / sz_ctr(m) + ! Integrate moments of size distribution + dmt_vwr(n) = dmt_vwr(n) + sz_ctr(m) * & + pi / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + vlm_rsl(n) = vlm_rsl(n) + & + pi / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + end do + dmt_vwr(n) = dmt_vwr(n) / vlm_rsl(n) ![m] Mass weighted diameter resolved + end do + + ! sets stk_crc ... + + ! calculate correction to Stokes' settling velocity (subroutine stk_crc_get) + eps_max = 1.0e-4_r8 + dns_mdp = 100000._r8 / (295.0_r8*rair) ![kg m-3] const prs_mdp & tpt_vrt + ! Size-independent thermokinetic properties + vsc_dyn_atm = 1.72e-5_r8 * ((295.0_r8/273.0_r8)**1.5_r8) * 393.0_r8 / & + (295.0_r8+120.0_r8) ![kg m-1 s-1] RoY94 p.102 tpt_mdp=295.0 + mfp_atm = 2.0_r8 * vsc_dyn_atm / & !SeP97 p. 455 constant prs_mdp, tpt_mdp + (100000._r8*sqrt(8.0_r8/(pi*rair*295.0_r8))) + vsc_knm_atm = vsc_dyn_atm / dns_mdp ![m2 s-1] Kinematic viscosity of air + + do m = 1, nbin + slp_crc(m) = 1.0_r8 + 2.0_r8 * mfp_atm * & + (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / & + dmt_vwr(m) ! [frc] Slip correction factor SeP97 p.464 + vlc_stk(m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dust_density * & + gravit * slp_crc(m) / vsc_dyn_atm ! [m s-1] SeP97 p.466 + end do + + ! For Reynolds number flows Re < 0.1 Stokes' velocity is valid for + ! vlc_grv SeP97 p. 466 (8.42). For larger Re, inertial effects become + ! important and empirical drag coefficients must be employed + ! Implicit equation for Re, Cd, and Vt is SeP97 p. 467 (8.44) + ! Using Stokes' velocity rather than iterative solution with empirical + ! drag coefficient causes 60% errors for D = 200 um SeP97 p. 468 + + ! Iterative solution for drag coefficient, Reynolds number, and terminal veloc + do m = 1, nbin + + ! Initialize accuracy and counter + eps_crr = eps_max + 1.0_r8 ![frc] Current relative accuracy + itr_idx = 0 ![idx] Counting index + + ! Initial guess for vlc_grv is exact for Re < 0.1 + vlc_grv(m) = vlc_stk(m) ![m s-1] + eps_loop: do while(eps_crr > eps_max) + + ! Save terminal velocity for convergence test + vlc_grv_old = vlc_grv(m) ![m s-1] + ryn_nbr_grv(m) = vlc_grv(m) * dmt_vwr(m) / vsc_knm_atm !SeP97 p.460 + + ! Update drag coefficient based on new Reynolds number + if (ryn_nbr_grv(m) < 0.1_r8) then + cff_drg_grv(m) = 24.0_r8 / ryn_nbr_grv(m) !Stokes' law Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 3.0_r8*ryn_nbr_grv(m)/16.0_r8 + & + 9.0_r8*ryn_nbr_grv(m)*ryn_nbr_grv(m)* & + log(2.0_r8*ryn_nbr_grv(m))/160.0_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 500.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 0.15_r8*ryn_nbr_grv(m)**0.687_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0e5_r8) then + cff_drg_grv(m) = 0.44_r8 !Sep97 p.463 (8.32) + else + write(iulog,'(a,es9.2)') "ryn_nbr_grv(m) = ",ryn_nbr_grv(m) + call endrun ('Dustini error: Reynolds number too large in stk_crc_get()') + endif + + ! Update terminal velocity based on new Reynolds number and drag coeff + ! [m s-1] Terminal veloc SeP97 p.467 (8.44) + vlc_grv(m) = sqrt(4.0_r8 * gravit * dmt_vwr(m) * slp_crc(m) * dust_density / & + (3.0_r8*cff_drg_grv(m)*dns_mdp)) + eps_crr = abs((vlc_grv(m)-vlc_grv_old)/vlc_grv(m)) !Relative convergence + if (itr_idx == 12) then + ! Numerical pingpong may occur when Re = 0.1, 2.0, or 500.0 + ! due to discontinuities in derivative of drag coefficient + vlc_grv(m) = 0.5_r8 * (vlc_grv(m)+vlc_grv_old) ! [m s-1] + endif + if (itr_idx > 20) then + write(iulog,*) 'Dustini error: Terminal velocity not converging ',& + ' in stk_crc_get(), breaking loop...' + ! to next iteration + exit eps_loop + endif + itr_idx = itr_idx + 1 + end do eps_loop !end while + end do !end loop over size + + ! Compute factors to convert Stokes' settling velocities to + ! actual settling velocities + do m = 1, nbin + stk_crc(m) = vlc_grv(m) / vlc_stk(m) + end do + + end subroutine dust_set_params + +end module dust_common diff --git a/src/chemistry/aerosol/dust_sediment_mod.F90 b/src/chemistry/aerosol/dust_sediment_mod.F90 new file mode 100644 index 0000000000..96306a61e3 --- /dev/null +++ b/src/chemistry/aerosol/dust_sediment_mod.F90 @@ -0,0 +1,501 @@ +module dust_sediment_mod + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Contains routines to compute tendencies from sedimentation of dust +! +! Author: Phil Rasch +! +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use physconst, only: gravit, rair + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + private + public :: dust_sediment_vel, dust_sediment_tend + + + real (r8), parameter :: vland = 2.8_r8 ! dust fall velocity over land (cm/s) + real (r8), parameter :: vocean = 1.5_r8 ! dust fall velocity over ocean (cm/s) + real (r8), parameter :: mxsedfac = 0.99_r8 ! maximum sedimentation flux factor + +contains + +!=============================================================================== + subroutine dust_sediment_vel (ncol, & + icefrac , landfrac, ocnfrac , pmid , pdel , t , & + dustmr , pvdust ) + +!---------------------------------------------------------------------- + +! Compute gravitational sedimentation velocities for dust + + implicit none + +! Arguments + integer, intent(in) :: ncol ! number of colums to process + + real(r8), intent(in) :: icefrac (pcols) ! sea ice fraction (fraction) + real(r8), intent(in) :: landfrac(pcols) ! land fraction (fraction) + real(r8), intent(in) :: ocnfrac (pcols) ! ocean fraction (fraction) + real(r8), intent(in) :: pmid (pcols,pver) ! pressure of midpoint levels (Pa) + real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa) + real(r8), intent(in) :: t (pcols,pver) ! temperature (K) + real(r8), intent(in) :: dustmr(pcols,pver) ! dust (kg/kg) + + real(r8), intent(out) :: pvdust (pcols,pverp) ! vertical velocity of dust (Pa/s) +! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1)) + +! Local variables + real (r8) :: rho(pcols,pver) ! air density in kg/m3 + real (r8) :: vfall(pcols) ! settling velocity of dust particles (m/s) + + integer i,k + + real (r8) :: lbound, ac, bc, cc + +!----------------------------------------------------------------------- +!--------------------- dust fall velocity ---------------------------- +!----------------------------------------------------------------------- + + do k = 1,pver + do i = 1,ncol + + ! merge the dust fall velocities for land and ocean (cm/s) + ! SHOULD ALSO ACCOUNT FOR ICEFRAC + vfall(i) = vland*landfrac(i) + vocean*(1._r8-landfrac(i)) + !! vfall(i) = vland*landfrac(i) + vocean*ocnfrac(i) + vseaice*icefrac(i) + + ! fall velocity (assume positive downward) + pvdust(i,k+1) = vfall(i) + end do + end do + + return + end subroutine dust_sediment_vel + + +!=============================================================================== + subroutine dust_sediment_tend ( & + ncol, dtime, pint, pmid, pdel, t, & + dustmr ,pvdust, dusttend, sfdust ) + +!---------------------------------------------------------------------- +! Apply Particle Gravitational Sedimentation +!---------------------------------------------------------------------- + + implicit none + +! Arguments + integer, intent(in) :: ncol ! number of colums to process + + real(r8), intent(in) :: dtime ! time step + real(r8), intent(in) :: pint (pcols,pverp) ! interfaces pressure (Pa) + real(r8), intent(in) :: pmid (pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa) + real(r8), intent(in) :: t (pcols,pver) ! temperature (K) + real(r8), intent(in) :: dustmr(pcols,pver) ! dust (kg/kg) + real(r8), intent(in) :: pvdust (pcols,pverp) ! vertical velocity of dust drops (Pa/s) +! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1)) + + real(r8), intent(out) :: dusttend(pcols,pver) ! dust tend + real(r8), intent(out) :: sfdust (pcols) ! surface flux of dust (rain, kg/m/s) + +! Local variables + real(r8) :: fxdust(pcols,pverp) ! fluxes at the interfaces, dust (positive = down) + + integer :: i,k +!---------------------------------------------------------------------- + +! initialize variables + fxdust (:ncol,:) = 0._r8 ! flux at interfaces (dust) + dusttend(:ncol,:) = 0._r8 ! tend (dust) + sfdust(:ncol) = 0._r8 ! sedimentation flux out bot of column (dust) + +! fluxes at interior points + call getflx(ncol, pint, dustmr, pvdust, dtime, fxdust) + +! calculate fluxes at boundaries + do i = 1,ncol + fxdust(i,1) = 0 +! surface flux by upstream scheme + fxdust(i,pverp) = dustmr(i,pver) * pvdust(i,pverp) * dtime + end do + +! filter out any negative fluxes from the getflx routine + do k = 2,pver + fxdust(:ncol,k) = max(0._r8, fxdust(:ncol,k)) + end do + +! Limit the flux out of the bottom of each cell to the water content in each phase. +! Apply mxsedfac to prevent generating very small negative cloud water/ice +! NOTE, REMOVED CLOUD FACTOR FROM AVAILABLE WATER. ALL CLOUD WATER IS IN CLOUDS. +! ***Should we include the flux in the top, to allow for thin surface layers? +! ***Requires simple treatment of cloud overlap, already included below. + do k = 1,pver + do i = 1,ncol + fxdust(i,k+1) = min( fxdust(i,k+1), mxsedfac * dustmr(i,k) * pdel(i,k) ) +!!$ fxdust(i,k+1) = min( fxdust(i,k+1), dustmr(i,k) * pdel(i,k) + fxdust(i,k)) + end do + end do + +! Now calculate the tendencies + do k = 1,pver + do i = 1,ncol +! net flux into cloud changes cloud dust/ice (all flux is out of cloud) + dusttend(i,k) = (fxdust(i,k) - fxdust(i,k+1)) / (dtime * pdel(i,k)) + end do + end do + +! convert flux out the bottom to mass units Pa -> kg/m2/s + sfdust(:ncol) = fxdust(:ncol,pverp) / (dtime*gravit) + + return + end subroutine dust_sediment_tend + +!=============================================================================== + subroutine getflx(ncol, xw, phi, vel, deltat, flux) + +!.....xw1.......xw2.......xw3.......xw4.......xw5.......xw6 +!....psiw1.....psiw2.....psiw3.....psiw4.....psiw5.....psiw6 +!....velw1.....velw2.....velw3.....velw4.....velw5.....velw6 +!.........phi1......phi2.......phi3.....phi4.......phi5....... + + + implicit none + + integer ncol ! number of colums to process + + integer i + integer k + + real (r8) vel(pcols,pverp) + real (r8) flux(pcols,pverp) + real (r8) xw(pcols,pverp) + real (r8) psi(pcols,pverp) + real (r8) phi(pcols,pverp-1) + real (r8) fdot(pcols,pverp) + real (r8) xx(pcols) + real (r8) fxdot(pcols) + real (r8) fxdd(pcols) + + real (r8) psistar(pcols) + real (r8) deltat + + real (r8) xxk(pcols,pver) + + do i = 1,ncol +! integral of phi + psi(i,1) = 0._r8 +! fluxes at boundaries + flux(i,1) = 0 + flux(i,pverp) = 0._r8 + end do + +! integral function + do k = 2,pverp + do i = 1,ncol + psi(i,k) = phi(i,k-1)*(xw(i,k)-xw(i,k-1)) + psi(i,k-1) + end do + end do + + +! calculate the derivatives for the interpolating polynomial + call cfdotmc_pro (ncol, xw, psi, fdot) + +! NEW WAY +! calculate fluxes at interior pts + do k = 2,pver + do i = 1,ncol + xxk(i,k) = xw(i,k)-vel(i,k)*deltat + end do + end do + do k = 2,pver + call cfint2(ncol, xw, psi, fdot, xxk(1,k), fxdot, fxdd, psistar) + do i = 1,ncol + flux(i,k) = (psi(i,k)-psistar(i)) + end do + end do + + + return + end subroutine getflx + + + +!############################################################################## + + subroutine cfint2 (ncol, x, f, fdot, xin, fxdot, fxdd, psistar) + + + implicit none + +! input + integer ncol ! number of colums to process + + real (r8) x(pcols, pverp) + real (r8) f(pcols, pverp) + real (r8) fdot(pcols, pverp) + real (r8) xin(pcols) + +! output + real (r8) fxdot(pcols) + real (r8) fxdd(pcols) + real (r8) psistar(pcols) + + integer i + integer k + integer intz(pcols) + real (r8) dx + real (r8) s + real (r8) c2 + real (r8) c3 + real (r8) xx + real (r8) xinf + real (r8) psi1, psi2, psi3, psim + real (r8) cfint + real (r8) cfnew + real (r8) xins(pcols) + +! the minmod function + real (r8) a, b, c + real (r8) minmod + real (r8) medan + minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b)) + medan(a,b,c) = a + minmod(b-a,c-a) + + do i = 1,ncol + xins(i) = medan(x(i,1), xin(i), x(i,pverp)) + intz(i) = 0 + end do + +! first find the interval + do k = 1,pverp-1 + do i = 1,ncol + if ((xins(i)-x(i,k))*(x(i,k+1)-xins(i)).ge.0._r8) then + intz(i) = k + endif + end do + end do + + do i = 1,ncol + if (intz(i).eq.0) then + write(iulog,*) ' interval was not found for col i ', i + call endrun('DUST_SEDIMENT_MOD:cfint2 -- interval was not found ') + endif + end do + +! now interpolate + do i = 1,ncol + k = intz(i) + dx = (x(i,k+1)-x(i,k)) + s = (f(i,k+1)-f(i,k))/dx + c2 = (3*s-2*fdot(i,k)-fdot(i,k+1))/dx + c3 = (fdot(i,k)+fdot(i,k+1)-2*s)/dx**2 + xx = (xins(i)-x(i,k)) + fxdot(i) = (3*c3*xx + 2*c2)*xx + fdot(i,k) + fxdd(i) = 6*c3*xx + 2*c2 + cfint = ((c3*xx + c2)*xx + fdot(i,k))*xx + f(i,k) + +! limit the interpolant + psi1 = f(i,k)+(f(i,k+1)-f(i,k))*xx/dx + if (k.eq.1) then + psi2 = f(i,1) + else + psi2 = f(i,k) + (f(i,k)-f(i,k-1))*xx/(x(i,k)-x(i,k-1)) + endif + if (k+1.eq.pverp) then + psi3 = f(i,pverp) + else + psi3 = f(i,k+1) - (f(i,k+2)-f(i,k+1))*(dx-xx)/(x(i,k+2)-x(i,k+1)) + endif + psim = medan(psi1, psi2, psi3) + cfnew = medan(cfint, psi1, psim) + if (abs(cfnew-cfint)/(abs(cfnew)+abs(cfint)+1.e-36_r8) .gt..03_r8) then +! CHANGE THIS BACK LATER!!! +! $ .gt..1) then + + +! UNCOMMENT THIS LATER!!! +! write(iulog,*) ' cfint2 limiting important ', cfint, cfnew + + + endif + psistar(i) = cfnew + end do + + return + end subroutine cfint2 + + + +!############################################################################## + + subroutine cfdotmc_pro (ncol, x, f, fdot) + +! prototype version; eventually replace with final SPITFIRE scheme + +! calculate the derivative for the interpolating polynomial +! multi column version + + + implicit none + +! input + integer ncol ! number of colums to process + + real (r8) x(pcols, pverp) + real (r8) f(pcols, pverp) +! output + real (r8) fdot(pcols, pverp) ! derivative at nodes + +! assumed variable distribution +! x1.......x2.......x3.......x4.......x5.......x6 1,pverp points +! f1.......f2.......f3.......f4.......f5.......f6 1,pverp points +! ...sh1.......sh2......sh3......sh4......sh5.... 1,pver points +! .........d2.......d3.......d4.......d5......... 2,pver points +! .........s2.......s3.......s4.......s5......... 2,pver points +! .............dh2......dh3......dh4............. 2,pver-1 points +! .............eh2......eh3......eh4............. 2,pver-1 points +! ..................e3.......e4.................. 3,pver-1 points +! .................ppl3......ppl4................ 3,pver-1 points +! .................ppr3......ppr4................ 3,pver-1 points +! .................t3........t4.................. 3,pver-1 points +! ................fdot3.....fdot4................ 3,pver-1 points + + +! work variables + + + integer i + integer k + + real (r8) a ! work var + real (r8) b ! work var + real (r8) c ! work var + real (r8) s(pcols,pverp) ! first divided differences at nodes + real (r8) sh(pcols,pverp) ! first divided differences between nodes + real (r8) d(pcols,pverp) ! second divided differences at nodes + real (r8) dh(pcols,pverp) ! second divided differences between nodes + real (r8) e(pcols,pverp) ! third divided differences at nodes + real (r8) eh(pcols,pverp) ! third divided differences between nodes + real (r8) pp ! p prime + real (r8) ppl(pcols,pverp) ! p prime on left + real (r8) ppr(pcols,pverp) ! p prime on right + real (r8) qpl + real (r8) qpr + real (r8) ttt + real (r8) t + real (r8) tmin + real (r8) tmax + real (r8) delxh(pcols,pverp) + + +! the minmod function + real (r8) minmod + real (r8) medan + minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b)) + medan(a,b,c) = a + minmod(b-a,c-a) + + do k = 1,pver + + +! first divided differences between nodes + do i = 1, ncol + delxh(i,k) = (x(i,k+1)-x(i,k)) + sh(i,k) = (f(i,k+1)-f(i,k))/delxh(i,k) + end do + +! first and second divided differences at nodes + if (k.ge.2) then + do i = 1,ncol + d(i,k) = (sh(i,k)-sh(i,k-1))/(x(i,k+1)-x(i,k-1)) + s(i,k) = minmod(sh(i,k),sh(i,k-1)) + end do + endif + end do + +! second and third divided diffs between nodes + do k = 2,pver-1 + do i = 1, ncol + eh(i,k) = (d(i,k+1)-d(i,k))/(x(i,k+2)-x(i,k-1)) + dh(i,k) = minmod(d(i,k),d(i,k+1)) + end do + end do + +! treat the boundaries + do i = 1,ncol + e(i,2) = eh(i,2) + e(i,pver) = eh(i,pver-1) +! outside level + fdot(i,1) = sh(i,1) - d(i,2)*delxh(i,1) & + - eh(i,2)*delxh(i,1)*(x(i,1)-x(i,3)) + fdot(i,1) = minmod(fdot(i,1),3*sh(i,1)) + fdot(i,pverp) = sh(i,pver) + d(i,pver)*delxh(i,pver) & + + eh(i,pver-1)*delxh(i,pver)*(x(i,pverp)-x(i,pver-1)) + fdot(i,pverp) = minmod(fdot(i,pverp),3*sh(i,pver)) +! one in from boundary + fdot(i,2) = sh(i,1) + d(i,2)*delxh(i,1) - eh(i,2)*delxh(i,1)*delxh(i,2) + fdot(i,2) = minmod(fdot(i,2),3*s(i,2)) + fdot(i,pver) = sh(i,pver) - d(i,pver)*delxh(i,pver) & + - eh(i,pver-1)*delxh(i,pver)*delxh(i,pver-1) + fdot(i,pver) = minmod(fdot(i,pver),3*s(i,pver)) + end do + + + do k = 3,pver-1 + do i = 1,ncol + e(i,k) = minmod(eh(i,k),eh(i,k-1)) + end do + end do + + + + do k = 3,pver-1 + + do i = 1,ncol + +! p prime at k-0.5 + ppl(i,k)=sh(i,k-1) + dh(i,k-1)*delxh(i,k-1) +! p prime at k+0.5 + ppr(i,k)=sh(i,k) - dh(i,k) *delxh(i,k) + + t = minmod(ppl(i,k),ppr(i,k)) + +! derivate from parabola thru f(i,k-1), f(i,k), and f(i,k+1) + pp = sh(i,k-1) + d(i,k)*delxh(i,k-1) + +! quartic estimate of fdot + fdot(i,k) = pp & + - delxh(i,k-1)*delxh(i,k) & + *( eh(i,k-1)*(x(i,k+2)-x(i,k )) & + + eh(i,k )*(x(i,k )-x(i,k-2)) & + )/(x(i,k+2)-x(i,k-2)) + +! now limit it + qpl = sh(i,k-1) & + + delxh(i,k-1)*minmod(d(i,k-1)+e(i,k-1)*(x(i,k)-x(i,k-2)), & + d(i,k) -e(i,k)*delxh(i,k)) + qpr = sh(i,k) & + + delxh(i,k )*minmod(d(i,k) +e(i,k)*delxh(i,k-1), & + d(i,k+1)+e(i,k+1)*(x(i,k)-x(i,k+2))) + + fdot(i,k) = medan(fdot(i,k), qpl, qpr) + + ttt = minmod(qpl, qpr) + tmin = min(0._r8,3*s(i,k),1.5_r8*t,ttt) + tmax = max(0._r8,3*s(i,k),1.5_r8*t,ttt) + + fdot(i,k) = fdot(i,k) + minmod(tmin-fdot(i,k), tmax-fdot(i,k)) + + end do + + end do + + return + end subroutine cfdotmc_pro +end module dust_sediment_mod diff --git a/src/chemistry/aerosol/mo_setsox.F90 b/src/chemistry/aerosol/mo_setsox.F90 new file mode 100644 index 0000000000..b994e32dd2 --- /dev/null +++ b/src/chemistry/aerosol/mo_setsox.F90 @@ -0,0 +1,879 @@ + +module MO_SETSOX + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + private + public :: sox_inti, setsox + public :: has_sox + + save + logical :: inv_o3 + integer :: id_msa + + integer :: id_so2, id_nh3, id_hno3, id_h2o2, id_o3, id_ho2 + integer :: id_so4, id_h2so4 + + logical :: has_sox = .true. + logical :: inv_so2, inv_nh3, inv_hno3, inv_h2o2, inv_ox, inv_nh4no3, inv_ho2 + + logical :: cloud_borne = .false. + logical :: modal_aerosols = .false. + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine sox_inti + !----------------------------------------------------------------------- + ! ... initialize the hetero sox routine + !----------------------------------------------------------------------- + + use mo_chem_utls, only : get_spc_ndx, get_inv_ndx + use spmd_utils, only : masterproc + use phys_control, only : phys_getopts + use sox_cldaero_mod, only : sox_cldaero_init + + implicit none + + + call phys_getopts( & + prog_modal_aero_out=modal_aerosols ) + + cloud_borne = modal_aerosols + + !----------------------------------------------------------------- + ! ... get species indicies + !----------------------------------------------------------------- + + if (cloud_borne) then + id_h2so4 = get_spc_ndx( 'H2SO4' ) + else + id_so4 = get_spc_ndx( 'SO4' ) + endif + id_msa = get_spc_ndx( 'MSA' ) + + inv_so2 = .false. + id_so2 = get_inv_ndx( 'SO2' ) + inv_so2 = id_so2 > 0 + if ( .not. inv_so2 ) then + id_so2 = get_spc_ndx( 'SO2' ) + endif + + inv_NH3 = .false. + id_NH3 = get_inv_ndx( 'NH3' ) + inv_NH3 = id_NH3 > 0 + if ( .not. inv_NH3 ) then + id_NH3 = get_spc_ndx( 'NH3' ) + endif + + inv_HNO3 = .false. + id_HNO3 = get_inv_ndx( 'HNO3' ) + inv_HNO3 = id_hno3 > 0 + if ( .not. inv_HNO3 ) then + id_HNO3 = get_spc_ndx( 'HNO3' ) + endif + + inv_H2O2 = .false. + id_H2O2 = get_inv_ndx( 'H2O2' ) + inv_H2O2 = id_H2O2 > 0 + if ( .not. inv_H2O2 ) then + id_H2O2 = get_spc_ndx( 'H2O2' ) + endif + + inv_HO2 = .false. + id_HO2 = get_inv_ndx( 'HO2' ) + inv_HO2 = id_HO2 > 0 + if ( .not. inv_HO2 ) then + id_HO2 = get_spc_ndx( 'HO2' ) + endif + + inv_o3 = get_inv_ndx( 'O3' ) > 0 + if (inv_o3) then + id_o3 = get_inv_ndx( 'O3' ) + else + id_o3 = get_spc_ndx( 'O3' ) + endif + inv_ho2 = get_inv_ndx( 'HO2' ) > 0 + if (inv_ho2) then + id_ho2 = get_inv_ndx( 'HO2' ) + else + id_ho2 = get_spc_ndx( 'HO2' ) + endif + + has_sox = (id_so2>0) .and. (id_h2o2>0) .and. (id_o3>0) .and. (id_ho2>0) + if (cloud_borne) then + has_sox = has_sox .and. (id_h2so4>0) + else + has_sox = has_sox .and. (id_so4>0) .and. (id_nh3>0) + endif + + if (masterproc) then + write(iulog,*) 'sox_inti: has_sox = ',has_sox + endif + + if( has_sox ) then + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) 'mozart will do sox aerosols' + write(iulog,*) '-----------------------------------------' + endif + else + return + end if + + call sox_cldaero_init() + + end subroutine sox_inti + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine SETSOX( & + ncol, & + lchnk, & + loffset,& + dtime, & + press, & + pdel, & + tfld, & + mbar, & + lwc, & + cldfrc, & + cldnum, & + xhnm, & + invariants, & + qcw, & + qin, & + xphlwc, & + aqso4, & + aqh2so4,& + aqso4_h2o2, & + aqso4_o3, & + yph_in, & + aqso4_h2o2_3d, & + aqso4_o3_3d & + ) + + !----------------------------------------------------------------------- + ! ... Compute heterogeneous reactions of SOX + ! + ! (0) using initial PH to calculate PH + ! (a) HENRYs law constants + ! (b) PARTIONING + ! (c) PH values + ! + ! (1) using new PH to repeat + ! (a) HENRYs law constants + ! (b) PARTIONING + ! (c) REACTION rates + ! (d) PREDICTION + !----------------------------------------------------------------------- + ! + use ppgrid, only : pcols, pver + use chem_mods, only : gas_pcnst, nfs + use chem_mods, only : adv_mass + use physconst, only : mwdry, gravit + use mo_constants, only : pi + use sox_cldaero_mod, only : sox_cldaero_update, sox_cldaero_create_obj, sox_cldaero_destroy_obj + use cldaero_mod, only : cldaero_conc_t + + ! + implicit none + ! + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! num of columns in chunk + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array + real(r8), intent(in) :: dtime ! time step (sec) + real(r8), intent(in) :: press(:,:) ! midpoint pressure ( Pa ) + real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: tfld(:,:) ! temperature + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), target, intent(in) :: lwc(:,:) ! cloud liquid water content (kg/kg) + real(r8), target, intent(in) :: cldfrc(:,:) ! cloud fraction + real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: xhnm(:,:) ! total atms density ( /cm**3) + real(r8), intent(in) :: invariants(:,:,:) + real(r8), target, intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(inout) :: qin(:,:,:) ! transported species ( vmr ) + real(r8), intent(out) :: xphlwc(:,:) ! pH value multiplied by lwc + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(in), optional :: yph_in ! ph value + real(r8), intent(out), optional :: aqso4_h2o2_3d(:, :) ! 3D SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:, :) ! 3D SO4 aqueous phase chemistry due to O3 (kg/m2) + + + !----------------------------------------------------------------------- + ! ... Local variables + ! + ! xhno3 ... in mixing ratio + !----------------------------------------------------------------------- + integer, parameter :: itermax = 20 + real(r8), parameter :: ph0 = 5.0_r8 ! INITIAL PH VALUES + real(r8), parameter :: const0 = 1.e3_r8/6.023e23_r8 + real(r8), parameter :: xa0 = 11._r8 + real(r8), parameter :: xb0 = -.1_r8 + real(r8), parameter :: xa1 = 1.053_r8 + real(r8), parameter :: xb1 = -4.368_r8 + real(r8), parameter :: xa2 = 1.016_r8 + real(r8), parameter :: xb2 = -2.54_r8 + real(r8), parameter :: xa3 = .816e-32_r8 + real(r8), parameter :: xb3 = .259_r8 + + real(r8), parameter :: kh0 = 9.e3_r8 ! HO2(g) -> Ho2(a) + real(r8), parameter :: kh1 = 2.05e-5_r8 ! HO2(a) -> H+ + O2- + real(r8), parameter :: kh2 = 8.6e5_r8 ! HO2(a) + ho2(a) -> h2o2(a) + o2 + real(r8), parameter :: kh3 = 1.e8_r8 ! HO2(a) + o2- -> h2o2(a) + o2 + real(r8), parameter :: Ra = 8314._r8/101325._r8 ! universal constant (atm)/(M-K) + real(r8), parameter :: xkw = 1.e-14_r8 ! water acidity + + ! + real(r8) :: xdelso4hp(ncol,pver) + + integer :: k, i, iter, file + real(r8) :: wrk, delta + real(r8) :: xph0, aden, xk, xe, x2 + real(r8) :: tz, xl, px, qz, pz, es, qs, patm + real(r8) :: Eso2, Eso4, Ehno3, Eco2, Eh2o, Enh3 + real(r8) :: so2g, h2o2g, co2g, o3g + real(r8) :: hno3a, nh3a, so2a, h2o2a, co2a, o3a + real(r8) :: rah2o2, rao3, pso4, ccc + real(r8) :: cnh3, chno3, com, com1, com2, xra + + real(r8) :: hno3g(ncol,pver), nh3g(ncol,pver) + ! + !----------------------------------------------------------------------- + ! for Ho2(g) -> H2o2(a) formation + ! schwartz JGR, 1984, 11589 + !----------------------------------------------------------------------- + real(r8) :: kh4 ! kh2+kh3 + real(r8) :: xam ! air density /cm3 + real(r8) :: ho2s ! ho2s = ho2(a)+o2- + real(r8) :: r1h2o2 ! prod(h2o2) by ho2 in mole/L(w)/s + real(r8) :: r2h2o2 ! prod(h2o2) by ho2 in mix/s + + real(r8), dimension(ncol,pver) :: & + xhno3, xh2o2, xso2, xso4, xno3, & + xnh3, xnh4, xo3, & + cfact, & + xph, xho2, & + xh2so4, xmsa, xso4_init, & + hehno3, & ! henry law const for hno3 + heh2o2, & ! henry law const for h2o2 + heso2, & ! henry law const for so2 + henh3, & ! henry law const for nh3 + heo3 !!, & ! henry law const for o3 + + real(r8) :: patm_x + + real(r8), dimension(ncol) :: work1 + logical :: converged + + real(r8), pointer :: xso4c(:,:) + real(r8), pointer :: xnh4c(:,:) + real(r8), pointer :: xno3c(:,:) + type(cldaero_conc_t), pointer :: cldconc + + real(r8) :: fact1_hno3, fact2_hno3, fact3_hno3 + real(r8) :: fact1_so2, fact2_so2, fact3_so2, fact4_so2 + real(r8) :: fact1_nh3, fact2_nh3, fact3_nh3 + real(r8) :: tmp_hp, tmp_hso3, tmp_hco3, tmp_nh4, tmp_no3 + real(r8) :: tmp_oh, tmp_so3, tmp_so4 + real(r8) :: tmp_neg, tmp_pos + real(r8) :: yph, yph_lo, yph_hi + real(r8) :: ynetpos, ynetpos_lo, ynetpos_hi + + !----------------------------------------------------------------- + ! ... NOTE: The press array is in pascals and must be + ! mutiplied by 10 to yield dynes/cm**2. + !----------------------------------------------------------------- + !================================================================== + ! ... First set the PH + !================================================================== + ! ... Initial values + ! The values of so2, so4 are after (1) SLT, and CHEM + !----------------------------------------------------------------- + xph0 = 10._r8**(-ph0) ! initial PH value + + do k = 1,pver + cfact(:,k) = xhnm(:,k) & ! /cm3(a) + * 1.e6_r8 & ! /m3(a) + * 1.38e-23_r8/287._r8 & ! Kg(a)/m3(a) + * 1.e-3_r8 ! Kg(a)/L(a) + end do + + cldconc => sox_cldaero_create_obj( cldfrc,qcw,lwc, cfact, ncol, loffset ) + xso4c => cldconc%so4c + xnh4c => cldconc%nh4c + xno3c => cldconc%no3c + + xso4(:,:) = 0._r8 + xno3(:,:) = 0._r8 + xnh4(:,:) = 0._r8 + + do k = 1,pver + xph(:,k) = xph0 ! initial PH value + + if ( inv_so2 ) then + xso2 (:,k) = invariants(:,k,id_so2)/xhnm(:,k) ! mixing ratio + else + xso2 (:,k) = qin(:,k,id_so2) ! mixing ratio + endif + + if (id_hno3 > 0) then + xhno3(:,k) = qin(:,k,id_hno3) + else + xhno3(:,k) = 0.0_r8 + endif + + if ( inv_h2o2 ) then + xh2o2 (:,k) = invariants(:,k,id_h2o2)/xhnm(:,k) ! mixing ratio + else + xh2o2 (:,k) = qin(:,k,id_h2o2) ! mixing ratio + endif + + if (id_nh3 > 0) then + xnh3 (:,k) = qin(:,k,id_nh3) + else + xnh3 (:,k) = 0.0_r8 + endif + + if ( inv_o3 ) then + xo3 (:,k) = invariants(:,k,id_o3)/xhnm(:,k) ! mixing ratio + else + xo3 (:,k) = qin(:,k,id_o3) ! mixing ratio + endif + if ( inv_ho2 ) then + xho2 (:,k) = invariants(:,k,id_ho2)/xhnm(:,k)! mixing ratio + else + xho2 (:,k) = qin(:,k,id_ho2) ! mixing ratio + endif + + if (cloud_borne) then + xh2so4(:,k) = qin(:,k,id_h2so4) + else + xso4 (:,k) = qin(:,k,id_so4) ! mixing ratio + endif + if (id_msa > 0) xmsa (:,k) = qin(:,k,id_msa) + + end do + + !----------------------------------------------------------------- + ! ... Temperature dependent Henry constants + !----------------------------------------------------------------- + ver_loop0: do k = 1,pver !! pver loop for STEP 0 + col_loop0: do i = 1,ncol + + if (cloud_borne .and. cldfrc(i,k)>0._r8) then + xso4(i,k) = xso4c(i,k) / cldfrc(i,k) + xnh4(i,k) = xnh4c(i,k) / cldfrc(i,k) + xno3(i,k) = xno3c(i,k) / cldfrc(i,k) + endif + xl = cldconc%xlwc(i,k) + + if( xl >= 1.e-8_r8 ) then + work1(i) = 1._r8 / tfld(i,k) - 1._r8 / 298._r8 + + !----------------------------------------------------------------- + ! 21-mar-2011 changes by rce + ! ph calculation now uses bisection method to solve the electro-neutrality equation + ! 3-mode aerosols (where so4 is assumed to be nh4hso4) + ! old code set xnh4c = so4c + ! new code sets xnh4c = 0, then uses a -1 charge (instead of -2) + ! for so4 when solving the electro-neutrality equation + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! calculations done before iterating + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + pz = .01_r8*press(i,k) !! pressure in mb + tz = tfld(i,k) + patm = pz/1013._r8 + xam = press(i,k)/(1.38e-23_r8*tz) !air density /M3 + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + ! previous code + ! hehno3(i,k) = xk*(1._r8 + xe/xph(i,k)) + ! px = hehno3(i,k) * Ra * tz * xl + ! hno3g = xhno3(i,k)/(1._r8 + px) + ! Ehno3 = xk*xe*hno3g *patm + ! equivalent new code + ! hehno3 = xk + xk*xe/hplus + ! hno3g = xhno3/(1 + px) + ! = xhno3/(1 + hehno3*ra*tz*xl) + ! = xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus) + ! ehno3 = hno3g*xk*xe*patm + ! = xk*xe*patm*xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus) + ! = ( fact1_hno3 )/(1 + fact2_hno3 *(1 + fact3_hno3/hplus) + ! [hno3-] = ehno3/hplus + xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) ) + xe = 15.4_r8 + fact1_hno3 = xk*xe*patm*xhno3(i,k) + fact2_hno3 = xk*ra*tz*xl + fact3_hno3 = xe + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + ! previous code + ! heso2(i,k) = xk*(1._r8 + wrk*(1._r8 + x2/xph(i,k))) + ! px = heso2(i,k) * Ra * tz * xl + ! so2g = xso2(i,k)/(1._r8+ px) + ! Eso2 = xk*xe*so2g *patm + ! equivalent new code + ! heso2 = xk + xk*xe/hplus * xk*xe*x2/hplus**2 + ! so2g = xso2/(1 + px) + ! = xso2/(1 + heso2*ra*tz*xl) + ! = xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus)) + ! eso2 = so2g*xk*xe*patm + ! = xk*xe*patm*xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus)) + ! = ( fact1_so2 )/(1 + fact2_so2 *(1 + (fact3_so2/hplus)*(1 + fact4_so2/hplus) + ! [hso3-] + 2*[so3--] = (eso2/hplus)*(1 + 2*x2/hplus) + xk = 1.23_r8 *EXP( 3120._r8*work1(i) ) + xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) ) + x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) ) + fact1_so2 = xk*xe*patm*xso2(i,k) + fact2_so2 = xk*ra*tz*xl + fact3_so2 = xe + fact4_so2 = x2 + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + ! previous code + ! henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/xkw) + ! px = henh3(i,k) * Ra * tz * xl + ! nh3g = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px) + ! Enh3 = xk*xe*nh3g/xkw *patm + ! equivalent new code + ! henh3 = xk + xk*xe*hplus/xkw + ! nh3g = xnh34/(1 + px) + ! = xnh34/(1 + henh3*ra*tz*xl) + ! = xnh34/(1 + xk*ra*tz*xl*(1 + xe*hplus/xkw) + ! enh3 = nh3g*xk*xe*patm/xkw + ! = ((xk*xe*patm/xkw)*xnh34)/(1 + xk*ra*tz*xl*(1 + xe*hplus/xkw) + ! = ( fact1_nh3 )/(1 + fact2_nh3 *(1 + fact3_nh3*hplus) + ! [nh4+] = enh3*hplus + xk = 58._r8 *EXP( 4085._r8*work1(i) ) + xe = 1.7e-5_r8*EXP( -4325._r8*work1(i) ) + + fact1_nh3 = (xk*xe*patm/xkw)*(xnh3(i,k)+xnh4(i,k)) + fact2_nh3 = xk*ra*tz*xl + fact3_nh3 = xe/xkw + + !----------------------------------------------------------------- + ! ... h2o effects + !----------------------------------------------------------------- + Eh2o = xkw + + !----------------------------------------------------------------- + ! ... co2 effects + !----------------------------------------------------------------- + co2g = 330.e-6_r8 !330 ppm = 330.e-6 atm + xk = 3.1e-2_r8*EXP( 2423._r8*work1(i) ) + xe = 4.3e-7_r8*EXP(-913._r8 *work1(i) ) + Eco2 = xk*xe*co2g *patm + + !----------------------------------------------------------------- + ! ... so4 effect + !----------------------------------------------------------------- + Eso4 = xso4(i,k)*xhnm(i,k) & ! /cm3(a) + *const0/xl + + + !----------------------------------------------------------------- + ! now use bisection method to solve electro-neutrality equation + ! + ! during the iteration loop, + ! yph_lo = lower ph value that brackets the root (i.e., correct ph) + ! yph_hi = upper ph value that brackets the root (i.e., correct ph) + ! yph = current ph value + ! yposnet_lo and yposnet_hi = net positive ions for + ! yph_lo and yph_hi + !----------------------------------------------------------------- + do iter = 1,itermax + + if (.not. present(yph_in)) then + if (iter == 1) then + ! 1st iteration ph = lower bound value + yph_lo = 2.0_r8 + yph_hi = yph_lo + yph = yph_lo + else if (iter == 2) then + ! 2nd iteration ph = upper bound value + yph_hi = 7.0_r8 + yph = yph_hi + else + ! later iteration ph = mean of the two bracketing values + yph = 0.5_r8*(yph_lo + yph_hi) + end if + else + yph = yph_in + end if + + ! calc current [H+] from ph + xph(i,k) = 10.0_r8**(-yph) + + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + Ehno3 = fact1_hno3/(1.0_r8 + fact2_hno3*(1.0_r8 + fact3_hno3/xph(i,k))) + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + Eso2 = fact1_so2/(1.0_r8 + fact2_so2*(1.0_r8 + (fact3_so2/xph(i,k)) & + *(1.0_r8 + fact4_so2/xph(i,k)))) + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + Enh3 = fact1_nh3/(1.0_r8 + fact2_nh3*(1.0_r8 + fact3_nh3*xph(i,k))) + + tmp_nh4 = Enh3 * xph(i,k) + tmp_hso3 = Eso2 / xph(i,k) + tmp_so3 = tmp_hso3 * 2.0_r8*fact4_so2/xph(i,k) + tmp_hco3 = Eco2 / xph(i,k) + tmp_oh = Eh2o / xph(i,k) + tmp_no3 = Ehno3 / xph(i,k) + tmp_so4 = cldconc%so4_fact*Eso4 + tmp_pos = xph(i,k) + tmp_nh4 + tmp_neg = tmp_oh + tmp_hco3 + tmp_no3 + tmp_hso3 + tmp_so3 + tmp_so4 + + ynetpos = tmp_pos - tmp_neg + + + ! yposnet = net positive ions/charge + ! if the correct ph is bracketed by yph_lo and yph_hi (with yph_lo < yph_hi), + ! then you will have yposnet_lo > 0 and yposnet_hi < 0 + converged = .false. + if (iter > 2) then + if (ynetpos == 0.0_r8) then + ! the exact solution was found (very unlikely) + tmp_hp = xph(i,k) + converged = .true. + exit + else if (ynetpos >= 0.0_r8) then + ! net positive ions are >= 0 for both yph and yph_lo + ! so replace yph_lo with yph + yph_lo = yph + ynetpos_lo = ynetpos + else + ! net positive ions are <= 0 for both yph and yph_hi + ! so replace yph_hi with yph + yph_hi = yph + ynetpos_hi = ynetpos + end if + + if (abs(yph_hi - yph_lo) .le. 0.005_r8) then + ! |yph_hi - yph_lo| <= convergence criterion, so set + ! final ph to their midpoint and exit + ! (.005 absolute error in pH gives .01 relative error in H+) + tmp_hp = xph(i,k) + yph = 0.5_r8*(yph_hi + yph_lo) + xph(i,k) = 10.0_r8**(-yph) + converged = .true. + exit + else + ! do another iteration + converged = .false. + end if + + else if (iter == 1) then + if (ynetpos <= 0.0_r8) then + ! the lower and upper bound ph values (2.0 and 7.0) do not bracket + ! the correct ph, so use the lower bound + tmp_hp = xph(i,k) + converged = .true. + exit + end if + ynetpos_lo = ynetpos + + else ! (iter == 2) + if (ynetpos >= 0.0_r8) then + ! the lower and upper bound ph values (2.0 and 7.0) do not bracket + ! the correct ph, so use they upper bound + tmp_hp = xph(i,k) + converged = .true. + exit + end if + ynetpos_hi = ynetpos + end if + + end do ! iter + + if( .not. converged ) then + write(iulog,*) 'SETSOX: pH failed to converge @ (',i,',',k,'), % change=', & + 100._r8*delta + end if + else + xph(i,k) = 1.e-7_r8 + end if + end do col_loop0 + end do ver_loop0 ! end pver loop for STEP 0 + + !============================================================== + ! ... Now use the actual PH + !============================================================== + ver_loop1: do k = 1,pver + col_loop1: do i = 1,ncol + work1(i) = 1._r8 / tfld(i,k) - 1._r8 / 298._r8 + tz = tfld(i,k) + + xl = cldconc%xlwc(i,k) + + patm = press(i,k)/101300._r8 ! press is in pascal + xam = press(i,k)/(1.38e-23_r8*tz) ! air density /M3 + + !----------------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------------- + xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) ) + xe = 15.4_r8 + hehno3(i,k) = xk*(1._r8 + xe/xph(i,k)) + + !----------------------------------------------------------------- + ! ... h2o2 + !----------------------------------------------------------------- + xk = 7.4e4_r8 *EXP( 6621._r8*work1(i) ) + xe = 2.2e-12_r8 *EXP(-3730._r8*work1(i) ) + heh2o2(i,k) = xk*(1._r8 + xe/xph(i,k)) + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + xk = 1.23_r8 *EXP( 3120._r8*work1(i) ) + xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) ) + x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) ) + + wrk = xe/xph(i,k) + heso2(i,k) = xk*(1._r8 + wrk*(1._r8 + x2/xph(i,k))) + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + xk = 58._r8 *EXP( 4085._r8*work1(i) ) + xe = 1.7e-5_r8*EXP(-4325._r8*work1(i) ) + henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/xkw) + + !----------------------------------------------------------------- + ! ... o3 + !----------------------------------------------------------------- + xk = 1.15e-2_r8 *EXP( 2560._r8*work1(i) ) + heo3(i,k) = xk + + !------------------------------------------------------------------------ + ! ... for Ho2(g) -> H2o2(a) formation + ! schwartz JGR, 1984, 11589 + !------------------------------------------------------------------------ + kh4 = (kh2 + kh3*kh1/xph(i,k)) / ((1._r8 + kh1/xph(i,k))**2) + ho2s = kh0*xho2(i,k)*patm*(1._r8 + kh1/xph(i,k)) ! ho2s = ho2(a)+o2- + r1h2o2 = kh4*ho2s*ho2s ! prod(h2o2) in mole/L(w)/s + + if ( cloud_borne ) then + r2h2o2 = r1h2o2*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s + / const0*1.e+6_r8 & ! correct a bug here ???? + / xam + else + r2h2o2 = r1h2o2*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s + * const0 & ! mole/fm3(a)/s * 1.e-3 = mole/cm3(a)/s + / xam ! /cm3(a)/s / air-den = mix-ratio/s + endif + + if ( .not. modal_aerosols ) then + xh2o2(i,k) = xh2o2(i,k) + r2h2o2*dtime ! updated h2o2 by het production + endif + + !----------------------------------------------- + ! ... Partioning + !----------------------------------------------- + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + px = hehno3(i,k) * Ra * tz * xl + hno3g(i,k) = (xhno3(i,k)+xno3(i,k))/(1._r8 + px) + + !------------------------------------------------------------------------ + ! ... h2o2 + !------------------------------------------------------------------------ + px = heh2o2(i,k) * Ra * tz * xl + h2o2g = xh2o2(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... so2 + !------------------------------------------------------------------------ + px = heso2(i,k) * Ra * tz * xl + so2g = xso2(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... o3 + !------------------------------------------------------------------------ + px = heo3(i,k) * Ra * tz * xl + o3g = xo3(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... nh3 + !------------------------------------------------------------------------ + px = henh3(i,k) * Ra * tz * xl + if (id_nh3>0) then + nh3g(i,k) = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px) + else + nh3g(i,k) = 0._r8 + endif + + !----------------------------------------------- + ! ... Aqueous phase reaction rates + ! SO2 + H2O2 -> SO4 + ! SO2 + O3 -> SO4 + !----------------------------------------------- + + !------------------------------------------------------------------------ + ! ... S(IV) (HSO3) + H2O2 + !------------------------------------------------------------------------ + rah2o2 = 8.e4_r8 * EXP( -3650._r8*work1(i) ) & + / (.1_r8 + xph(i,k)) + + !------------------------------------------------------------------------ + ! ... S(IV)+ O3 + !------------------------------------------------------------------------ + rao3 = 4.39e11_r8 * EXP(-4131._r8/tz) & + + 2.56e3_r8 * EXP(-996._r8 /tz) /xph(i,k) + + !----------------------------------------------------------------- + ! ... Prediction after aqueous phase + ! so4 + ! When Cloud is present + ! + ! S(IV) + H2O2 = S(VI) + ! S(IV) + O3 = S(VI) + ! + ! reference: + ! (1) Seinfeld + ! (2) Benkovitz + !----------------------------------------------------------------- + + !............................ + ! S(IV) + H2O2 = S(VI) + !............................ + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + if (cloud_borne) then + patm_x = patm + else + patm_x = 1._r8 + endif + + if (modal_aerosols) then + + pso4 = rah2o2 * 7.4e4_r8*EXP(6621._r8*work1(i)) * h2o2g * patm_x & + * 1.23_r8 *EXP(3120._r8*work1(i)) * so2g * patm_x + else + pso4 = rah2o2 * heh2o2(i,k) * h2o2g * patm_x & + * heso2(i,k) * so2g * patm_x ! [M/s] + + endif + + pso4 = pso4 & ! [M/s] = [mole/L(w)/s] + * xl & ! [mole/L(a)/s] + / const0 & ! [/L(a)/s] + / xhnm(i,k) + + + ccc = pso4*dtime + ccc = max(ccc, 1.e-30_r8) + + xso4_init(i,k)=xso4(i,k) + + IF (xh2o2(i,k) .gt. xso2(i,k)) THEN + if (ccc .gt. xso2(i,k)) then + xso4(i,k)=xso4(i,k)+xso2(i,k) + if (cloud_borne) then + xh2o2(i,k)=xh2o2(i,k)-xso2(i,k) + xso2(i,k)=1.e-20_r8 + else ! ???? bug ???? + xso2(i,k)=1.e-20_r8 + xh2o2(i,k)=xh2o2(i,k)-xso2(i,k) + endif + else + xso4(i,k) = xso4(i,k) + ccc + xh2o2(i,k) = xh2o2(i,k) - ccc + xso2(i,k) = xso2(i,k) - ccc + end if + + ELSE + if (ccc .gt. xh2o2(i,k)) then + xso4(i,k)=xso4(i,k)+xh2o2(i,k) + xso2(i,k)=xso2(i,k)-xh2o2(i,k) + xh2o2(i,k)=1.e-20_r8 + else + xso4(i,k) = xso4(i,k) + ccc + xh2o2(i,k) = xh2o2(i,k) - ccc + xso2(i,k) = xso2(i,k) - ccc + end if + END IF + + if (modal_aerosols) then + xdelso4hp(i,k) = xso4(i,k) - xso4_init(i,k) + endif + !........................... + ! S(IV) + O3 = S(VI) + !........................... + + pso4 = rao3 * heo3(i,k)*o3g*patm_x * heso2(i,k)*so2g*patm_x ! [M/s] + + pso4 = pso4 & ! [M/s] = [mole/L(w)/s] + * xl & ! [mole/L(a)/s] + / const0 & ! [/L(a)/s] + / xhnm(i,k) ! [mixing ratio/s] + + ccc = pso4*dtime + ccc = max(ccc, 1.e-30_r8) + + xso4_init(i,k)=xso4(i,k) + + if (ccc .gt. xso2(i,k)) then + xso4(i,k) = xso4(i,k) + xso2(i,k) + xso2(i,k) = 1.e-20_r8 + else + xso4(i,k) = xso4(i,k) + ccc + xso2(i,k) = xso2(i,k) - ccc + end if + + END IF !! WHEN CLOUD IS PRESENTED + + end do col_loop1 + end do ver_loop1 + + call sox_cldaero_update( & + ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, & + xdelso4hp, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d=aqso4_h2o2_3d, aqso4_o3_3d=aqso4_o3_3d ) + + xphlwc(:,:) = 0._r8 + do k = 1, pver + do i = 1, ncol + if (cldfrc(i,k)>=1.e-5_r8 .and. lwc(i,k)>=1.e-8_r8) then + xphlwc(i,k) = -1._r8*log10(xph(i,k)) * lwc(i,k) + endif + end do + end do + + call sox_cldaero_destroy_obj(cldconc) + + end subroutine SETSOX + +end module MO_SETSOX diff --git a/src/chemistry/aerosol/soil_erod_mod.F90 b/src/chemistry/aerosol/soil_erod_mod.F90 new file mode 100644 index 0000000000..33d6108761 --- /dev/null +++ b/src/chemistry/aerosol/soil_erod_mod.F90 @@ -0,0 +1,121 @@ +!=============================================================================== +!=============================================================================== +module soil_erod_mod + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + + implicit none + private + + public :: soil_erod_init + public :: soil_erodibility + public :: soil_erod_fact + + real(r8), allocatable :: soil_erodibility(:,:) ! soil erodibility factor + real(r8) :: soil_erod_fact ! tuning parameter for dust emissions + +contains + + !============================================================================= + !============================================================================= + subroutine soil_erod_init( dust_emis_fact, soil_erod_file ) + use interpolate_data, only: lininterp_init, lininterp, lininterp_finish, interp_type + use ppgrid, only: begchunk, endchunk, pcols + use mo_constants, only: pi, d2r + use pio, only: file_desc_t,pio_inq_dimid,pio_inq_dimlen,pio_get_var,pio_inq_varid, PIO_NOWRITE + use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p + use cam_pio_utils, only: cam_pio_openfile + use ioFileMod, only: getfil + + real(r8), intent(in) :: dust_emis_fact + character(len=*), intent(in) :: soil_erod_file + + real(r8), allocatable :: soil_erodibility_in(:,:) ! temporary input array + real(r8), allocatable :: dst_lons(:) + real(r8), allocatable :: dst_lats(:) + character(len=cl) :: infile + integer :: did, vid, nlat, nlon + type(file_desc_t) :: ncid + + type(interp_type) :: lon_wgts, lat_wgts + real(r8) :: to_lats(pcols), to_lons(pcols) + integer :: c, ncols, ierr + real(r8), parameter :: zero=0._r8, twopi=2._r8*pi + + soil_erod_fact = dust_emis_fact + + ! Summary to log file + if (masterproc) then + write(iulog,*) 'soil_erod_mod: soil erodibility dataset: ', trim(soil_erod_file) + write(iulog,*) 'soil_erod_mod: soil_erod_fact = ', soil_erod_fact + end if + + ! for soil erodibility in mobilization, apply inside CAM instead of lsm. + ! read in soil erodibility factors, similar to Zender's boundary conditions + + ! Get file name. + call getfil(soil_erod_file, infile, 0) + call cam_pio_openfile (ncid, trim(infile), PIO_NOWRITE) + + ! Get input data resolution. + ierr = pio_inq_dimid( ncid, 'lon', did ) + ierr = pio_inq_dimlen( ncid, did, nlon ) + + ierr = pio_inq_dimid( ncid, 'lat', did ) + ierr = pio_inq_dimlen( ncid, did, nlat ) + + allocate(dst_lons(nlon)) + allocate(dst_lats(nlat)) + allocate(soil_erodibility_in(nlon,nlat)) + + ierr = pio_inq_varid( ncid, 'lon', vid ) + ierr = pio_get_var( ncid, vid, dst_lons ) + + ierr = pio_inq_varid( ncid, 'lat', vid ) + ierr = pio_get_var( ncid, vid, dst_lats ) + + ierr = pio_inq_varid( ncid, 'mbl_bsn_fct_geo', vid ) + ierr = pio_get_var( ncid, vid, soil_erodibility_in ) + + !----------------------------------------------------------------------- + ! ... convert to radians and setup regridding + !----------------------------------------------------------------------- + dst_lats(:) = d2r * dst_lats(:) + dst_lons(:) = d2r * dst_lons(:) + + allocate( soil_erodibility(pcols,begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soil_erod_init: failed to allocate soil_erodibility_in, ierr = ',ierr + call endrun('soil_erod_init: failed to allocate soil_erodibility_in') + end if + + !----------------------------------------------------------------------- + ! ... regrid .. + !----------------------------------------------------------------------- + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + + call lininterp_init(dst_lons, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(dst_lats, nlat, to_lats, ncols, 1, lat_wgts) + + call lininterp(soil_erodibility_in(:,:), nlon,nlat , soil_erodibility(:,c), ncols, lon_wgts,lat_wgts) + + call lininterp_finish(lat_wgts) + call lininterp_finish(lon_wgts) + end do + deallocate( soil_erodibility_in, stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soil_erod_init: failed to deallocate soil_erodibility_in, ierr = ',ierr + call endrun('soil_erod_init: failed to deallocate soil_erodibility_in') + end if + + deallocate( dst_lats ) + deallocate( dst_lons ) + + end subroutine soil_erod_init + +end module soil_erod_mod diff --git a/src/chemistry/aerosol/sslt_sections.F90 b/src/chemistry/aerosol/sslt_sections.F90 new file mode 100644 index 0000000000..946daf703d --- /dev/null +++ b/src/chemistry/aerosol/sslt_sections.F90 @@ -0,0 +1,120 @@ +!=============================================================================== +! used to compute sea salt surface emissions for modal and sectional aerosol models +!=============================================================================== +module sslt_sections + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + + public :: sslt_sections_init + public :: fluxes + public :: nsections + public :: Dg + public :: rdry + + integer,parameter :: nsections = 31 + + ! only use up to ~20um + real(r8),parameter :: Dg(nsections) = (/ & + 0.0020e-5_r8, 0.0025e-5_r8, 0.0032e-5_r8, & + 0.0040e-5_r8, 0.0051e-5_r8, 0.0065e-5_r8, & + 0.0082e-5_r8, 0.0104e-5_r8, 0.0132e-5_r8, & + 0.0167e-5_r8, 0.0211e-5_r8, 0.0267e-5_r8, & + 0.0338e-5_r8, 0.0428e-5_r8, 0.0541e-5_r8, & + 0.0685e-5_r8, 0.0867e-5_r8, 0.1098e-5_r8, & + 0.1389e-5_r8, 0.1759e-5_r8, 0.2226e-5_r8, & + 0.2818e-5_r8, 0.3571e-5_r8, 0.4526e-5_r8, & + 0.5735e-5_r8, 0.7267e-5_r8, 0.9208e-5_r8, & + 1.1668e-5_r8, 1.4786e-5_r8, 1.8736e-5_r8, & + 2.3742e-5_r8 /) + + real(r8), dimension(nsections) :: bm, rdry, rm + real(r8), dimension(4,nsections) :: consta, constb !constants for calculating emission polynomial + +contains + + !=========================================================================== + !=========================================================================== + subroutine sslt_sections_init() + + integer :: m + + ! use Ekman's ss + rdry(:)=Dg(:)/2._r8 ! meter + ! multiply rm with 1.814 because it should be RH=80% and not dry particles + ! for the parameterization + rm(:)=1.814_r8*rdry(:)*1.e6_r8 ! um + bm(:)=(0.380_r8-log10(rm(:)))/0.65_r8 ! use in Manahan + + ! calculate constants form emission polynomials + do m=1,nsections + if ((m).le.9)then + consta(1,m) = (-2.576_r8)*10._r8**35*Dg(m)**4+5.932_r8*10._r8**28 & + * Dg(m)**3+(-2.867_r8)*10._r8**21*Dg(m)**2+(-3.003_r8) & + * 10._r8**13*Dg(m) + (-2.881_r8)*10._r8**6 + constb(1,m) = 7.188_r8*10._r8**37 & + * Dg(m)**4+(-1.616_r8)*10._r8**31*Dg(m)**3+6.791_r8*10._r8**23 & + * Dg(m)**2+1.829_r8*10._r8**16*Dg(m)+7.609_r8*10._r8**8 + elseif ((m).ge.10.and.(m).le.13)then + consta(2,m) = (-2.452_r8)*10._r8**33*Dg(m)**4+2.404_r8*10._r8**27 & + * Dg(m)**3+(-8.148_r8)*10._r8**20*Dg(m)**2+(1.183_r8)*10._r8**14 & + * Dg(m)+(-6.743_r8)*10._r8**6 + constb(2,m) = 7.368_r8*10._r8**35 & + * Dg(m)**4+(-7.310_r8)*10._r8**29*Dg(m)**3+ 2.528_r8*10._r8**23 & + * Dg(m)**2+(-3.787_r8)*10._r8**16*Dg(m)+ 2.279_r8*10._r8**9 + elseif ((m).ge.14.and.(m).lt.22)then + consta(3,m) = (1.085_r8)*10._r8**29*Dg(m)**4+(-9.841_r8)*10._r8**23 & + * Dg(m)**3+(3.132_r8)*10._r8**18*Dg(m)**2+(-4.165_r8)*10._r8**12 & + * Dg(m)+(2.181_r8)*10._r8**6 + constb(3,m) = (-2.859_r8)*10._r8**31 & + * Dg(m)**4+(2.601_r8)*10._r8**26*Dg(m)**3+(-8.297_r8)*10._r8**20 & + * Dg(m)**2+(1.105_r8)*10._r8**15*Dg(m)+(-5.800_r8)*10._r8**8 + elseif (m.ge.22.and.m.le.40)then + ! use monahan + consta(4,m) = (1.373_r8*rm(m)**(-3)*(1+0.057_r8*rm(m)**1.05_r8) & + * 10**(1.19_r8*exp(-bm(m)**2))) & + * (rm(m)-rm(m-1)) + endif + enddo + end subroutine sslt_sections_init + + !=========================================================================== + !=========================================================================== + function fluxes ( sst, u10cubed, ncol ) result(fi) + + real (r8),intent(in) :: sst(:) + real (r8),intent(in) :: u10cubed(:) + integer ,intent(in) :: ncol + + real (r8) :: fi(ncol,nsections) + + integer :: m + real (r8) :: W(ncol) + + ! Calculations of source strength and size distribution + ! NB the 0.1 is the dlogDp we have to multiplie with to get the flux, but the value dependence + ! of course on what dlogDp you have. You will also have to change the sections of Dg if you use + ! a different number of size bins with different intervals. + + W(:ncol)=3.84e-6_r8*u10cubed(:ncol)*0.1_r8 ! whitecap area + + ! calculate number flux fi (#/m2/s) + fi(:,:)=0._r8 + do m=1,nsections + if (m.le.9)then + fi(:ncol,m)=W(:ncol)*((sst(:ncol))*consta(1,m)+constb(1,m)) + elseif (m.ge.10.and.m.le.13)then + fi(:ncol,m)=W(:ncol)*((sst(:ncol))*consta(2,m)+constb(2,m)) + elseif (m.ge.14.and.m.lt.22)then + fi(:ncol,m)=W(:ncol)*((sst(:ncol))*consta(3,m)+constb(3,m)) + elseif (m.ge.22.and.m.le.40)then + ! use Monahan + fi(:ncol,m)=consta(4,m)*u10cubed(:ncol) + endif + enddo + + end function fluxes + +end module sslt_sections diff --git a/src/chemistry/aerosol/wetdep.F90 b/src/chemistry/aerosol/wetdep.F90 new file mode 100644 index 0000000000..48d672408c --- /dev/null +++ b/src/chemistry/aerosol/wetdep.F90 @@ -0,0 +1,1195 @@ +module wetdep + +!----------------------------------------------------------------------- +! +! Wet deposition routines for both aerosols and gas phase constituents. +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use physconst, only: gravit, rair, tmelt +use phys_control, only: cam_physpkg_is +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +save +private + +public :: wetdepa_v1 ! scavenging codes for very soluble aerosols -- CAM4 version +public :: wetdepa_v2 ! scavenging codes for very soluble aerosols -- CAM5 version +public :: wetdepg ! scavenging of gas phase constituents by henry's law +public :: clddiag ! calc of cloudy volume and rain mixing ratio + +public :: wetdep_inputs_t +public :: wetdep_init +public :: wetdep_inputs_set + +real(r8), parameter :: cmftau = 3600._r8 +real(r8), parameter :: rhoh2o = 1000._r8 ! density of water +real(r8), parameter :: molwta = 28.97_r8 ! molecular weight dry air gm/mole + +type wetdep_inputs_t + real(r8), pointer :: cldt(:,:) => null() ! cloud fraction + real(r8), pointer :: qme(:,:) => null() + real(r8), pointer :: prain(:,:) => null() + real(r8), pointer :: evapr(:,:) => null() + real(r8) :: cldcu(pcols,pver) ! convective cloud fraction, currently empty + real(r8) :: evapc(pcols,pver) ! Evaporation rate of convective precipitation + real(r8) :: cmfdqr(pcols,pver) ! convective production of rain + real(r8) :: conicw(pcols,pver) ! convective in-cloud water + real(r8) :: totcond(pcols, pver) ! total condensate + real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing wet chem and scavenging + real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area at the top interface of current layer + real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer +end type wetdep_inputs_t + +integer :: cld_idx = 0 +integer :: qme_idx = 0 +integer :: prain_idx = 0 +integer :: nevapr_idx = 0 + +integer :: icwmrdp_idx = 0 +integer :: icwmrsh_idx = 0 +integer :: rprddp_idx = 0 +integer :: rprdsh_idx = 0 +integer :: sh_frac_idx = 0 +integer :: dp_frac_idx = 0 +integer :: nevapr_shcu_idx = 0 +integer :: nevapr_dpcu_idx = 0 +integer :: ixcldice, ixcldliq + +!============================================================================== +contains +!============================================================================== + +!============================================================================== +!============================================================================== +subroutine wetdep_init() + use physics_buffer, only: pbuf_get_index + use constituents, only: cnst_get_ind + + cld_idx = pbuf_get_index('CLD') + qme_idx = pbuf_get_index('QME') + prain_idx = pbuf_get_index('PRAIN') + nevapr_idx = pbuf_get_index('NEVAPR') + + icwmrdp_idx = pbuf_get_index('ICWMRDP') + rprddp_idx = pbuf_get_index('RPRDDP') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + rprdsh_idx = pbuf_get_index('RPRDSH') + sh_frac_idx = pbuf_get_index('SH_FRAC' ) + dp_frac_idx = pbuf_get_index('DP_FRAC') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + +endsubroutine wetdep_init + +!============================================================================== +! gathers up the inputs needed for the wetdepa routines +!============================================================================== +subroutine wetdep_inputs_set( state, pbuf, inputs ) + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + + ! args + + type(physics_state), intent(in ) :: state !! physics state + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(wetdep_inputs_t), intent(out) :: inputs !! collection of wetdepa inputs + + ! local vars + + real(r8), pointer :: icwmrdp(:,:) ! in cloud water mixing ratio, deep convection + real(r8), pointer :: rprddp(:,:) ! rain production, deep convection + real(r8), pointer :: icwmrsh(:,:) ! in cloud water mixing ratio, deep convection + real(r8), pointer :: rprdsh(:,:) ! rain production, deep convection + real(r8), pointer :: sh_frac(:,:) ! Shallow convective cloud fraction + real(r8), pointer :: dp_frac(:,:) ! Deep convective cloud fraction + real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. + real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. + + real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume + real(r8) :: cldst(pcols,pver) ! Stratiform cloud fraction + + integer :: itim, ncol + + ncol = state%ncol + itim = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, cld_idx, inputs%cldt, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, qme_idx, inputs%qme ) + call pbuf_get_field(pbuf, prain_idx, inputs%prain ) + call pbuf_get_field(pbuf, nevapr_idx, inputs%evapr ) + call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp ) + call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh ) + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + call pbuf_get_field(pbuf, sh_frac_idx, sh_frac ) + call pbuf_get_field(pbuf, dp_frac_idx, dp_frac ) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + + inputs%cldcu(:ncol,:) = dp_frac(:ncol,:) + sh_frac(:ncol,:) + cldst(:ncol,:) = inputs%cldt(:ncol,:) - inputs%cldcu(:ncol,:) ! Stratiform cloud fraction + inputs%evapc(:ncol,:) = evapcsh(:ncol,:) + evapcdp(:ncol,:) + inputs%cmfdqr(:ncol,:) = rprddp(:ncol,:) + rprdsh(:ncol,:) + + ! sum deep and shallow convection contributions + if (cam_physpkg_is('cam5') .or. cam_physpkg_is('cam6')) then + ! Dec.29.2009. Sungsu + inputs%conicw(:ncol,:) = (icwmrdp(:ncol,:)*dp_frac(:ncol,:) + icwmrsh(:ncol,:)*sh_frac(:ncol,:))/ & + max(0.01_r8, sh_frac(:ncol,:) + dp_frac(:ncol,:)) + else + inputs%conicw(:ncol,:) = icwmrdp(:ncol,:) + icwmrsh(:ncol,:) + end if + + inputs%totcond(:ncol,:) = state%q(:ncol,:,ixcldliq) + state%q(:ncol,:,ixcldice) + + call clddiag( state%t, state%pmid, state%pdel, inputs%cmfdqr, inputs%evapc, & + inputs%cldt, inputs%cldcu, cldst, inputs%qme, inputs%evapr, & + inputs%prain, inputs%cldv, inputs%cldvcu, inputs%cldvst, rainmr, & + state%ncol ) + +end subroutine wetdep_inputs_set + +subroutine clddiag(t, pmid, pdel, cmfdqr, evapc, & + cldt, cldcu, cldst, cme, evapr, & + prain, cldv, cldvcu, cldvst, rain, & + ncol) + + ! ------------------------------------------------------------------------------------ + ! Estimate the cloudy volume which is occupied by rain or cloud water as + ! the max between the local cloud amount or the + ! sum above of (cloud*positive precip production) sum total precip from above + ! ---------------------------------- x ------------------------ + ! sum above of (positive precip ) sum positive precip from above + ! Author: P. Rasch + ! Sungsu Park. Mar.2010 + ! ------------------------------------------------------------------------------------ + + ! Input arguments: + real(r8), intent(in) :: t(pcols,pver) ! temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure at layer midpoints + real(r8), intent(in) :: pdel(pcols,pver) ! pressure difference across layers + real(r8), intent(in) :: cmfdqr(pcols,pver) ! dq/dt due to convective rainout + real(r8), intent(in) :: evapc(pcols,pver) ! Evaporation rate of convective precipitation ( >= 0 ) + real(r8), intent(in) :: cldt(pcols,pver) ! total cloud fraction + real(r8), intent(in) :: cldcu(pcols,pver) ! Cumulus cloud fraction + real(r8), intent(in) :: cldst(pcols,pver) ! Stratus cloud fraction + real(r8), intent(in) :: cme(pcols,pver) ! rate of cond-evap within the cloud + real(r8), intent(in) :: evapr(pcols,pver) ! rate of evaporation of falling precipitation (kg/kg/s) + real(r8), intent(in) :: prain(pcols,pver) ! rate of conversion of condensate to precipitation (kg/kg/s) + integer, intent(in) :: ncol + + ! Output arguments: + real(r8), intent(out) :: cldv(pcols,pver) ! fraction occupied by rain or cloud water + real(r8), intent(out) :: cldvcu(pcols,pver) ! Convective precipitation volume + real(r8), intent(out) :: cldvst(pcols,pver) ! Stratiform precipitation volume + real(r8), intent(out) :: rain(pcols,pver) ! mixing ratio of rain (kg/kg) + + ! Local variables: + integer i, k + real(r8) convfw ! used in fallspeed calculation; taken from findmcnew + real(r8) sumppr(pcols) ! precipitation rate (kg/m2-s) + real(r8) sumpppr(pcols) ! sum of positive precips from above + real(r8) cldv1(pcols) ! precip weighted cloud fraction from above + real(r8) lprec ! local production rate of precip (kg/m2/s) + real(r8) lprecp ! local production rate of precip (kg/m2/s) if positive + real(r8) rho ! air density + real(r8) vfall + real(r8) sumppr_cu(pcols) ! Convective precipitation rate (kg/m2-s) + real(r8) sumpppr_cu(pcols) ! Sum of positive convective precips from above + real(r8) cldv1_cu(pcols) ! Convective precip weighted convective cloud fraction from above + real(r8) lprec_cu ! Local production rate of convective precip (kg/m2/s) + real(r8) lprecp_cu ! Local production rate of convective precip (kg/m2/s) if positive + real(r8) sumppr_st(pcols) ! Stratiform precipitation rate (kg/m2-s) + real(r8) sumpppr_st(pcols) ! Sum of positive stratiform precips from above + real(r8) cldv1_st(pcols) ! Stratiform precip weighted stratiform cloud fraction from above + real(r8) lprec_st ! Local production rate of stratiform precip (kg/m2/s) + real(r8) lprecp_st ! Local production rate of stratiform precip (kg/m2/s) if positive + ! ----------------------------------------------------------------------- + + convfw = 1.94_r8*2.13_r8*sqrt(rhoh2o*gravit*2.7e-4_r8) + do i=1,ncol + sumppr(i) = 0._r8 + cldv1(i) = 0._r8 + sumpppr(i) = 1.e-36_r8 + sumppr_cu(i) = 0._r8 + cldv1_cu(i) = 0._r8 + sumpppr_cu(i) = 1.e-36_r8 + sumppr_st(i) = 0._r8 + cldv1_st(i) = 0._r8 + sumpppr_st(i) = 1.e-36_r8 + end do + + do k = 1,pver + do i = 1,ncol + cldv(i,k) = & + max(min(1._r8, & + cldv1(i)/sumpppr(i) & + )*sumppr(i)/sumpppr(i), & + cldt(i,k) & + ) + lprec = pdel(i,k)/gravit & + *(prain(i,k)+cmfdqr(i,k)-evapr(i,k)) + lprecp = max(lprec,1.e-30_r8) + cldv1(i) = cldv1(i) + cldt(i,k)*lprecp + sumppr(i) = sumppr(i) + lprec + sumpppr(i) = sumpppr(i) + lprecp + + ! For convective precipitation volume at the top interface of each layer. Neglect the current layer. + cldvcu(i,k) = max(min(1._r8,cldv1_cu(i)/sumpppr_cu(i))*(sumppr_cu(i)/sumpppr_cu(i)),0._r8) + lprec_cu = (pdel(i,k)/gravit)*(cmfdqr(i,k)-evapc(i,k)) + lprecp_cu = max(lprec_cu,1.e-30_r8) + cldv1_cu(i) = cldv1_cu(i) + cldcu(i,k)*lprecp_cu + sumppr_cu(i) = sumppr_cu(i) + lprec_cu + sumpppr_cu(i) = sumpppr_cu(i) + lprecp_cu + + ! For stratiform precipitation volume at the top interface of each layer. Neglect the current layer. + cldvst(i,k) = max(min(1._r8,cldv1_st(i)/sumpppr_st(i))*(sumppr_st(i)/sumpppr_st(i)),0._r8) + lprec_st = (pdel(i,k)/gravit)*(prain(i,k)-evapr(i,k)) + lprecp_st = max(lprec_st,1.e-30_r8) + cldv1_st(i) = cldv1_st(i) + cldst(i,k)*lprecp_st + sumppr_st(i) = sumppr_st(i) + lprec_st + sumpppr_st(i) = sumpppr_st(i) + lprecp_st + + rain(i,k) = 0._r8 + if(t(i,k) .gt. tmelt) then + rho = pmid(i,k)/(rair*t(i,k)) + vfall = convfw/sqrt(rho) + rain(i,k) = sumppr(i)/(rho*vfall) + if (rain(i,k).lt.1.e-14_r8) rain(i,k) = 0._r8 + endif + end do + end do + +end subroutine clddiag + +!============================================================================== + +! This is the CAM5 version of wetdepa. + +subroutine wetdepa_v2( & + p, q, pdel, cldt, cldc, & + cmfdqr, evapc, conicw, precs, conds, & + evaps, cwat, tracer, deltat, scavt, & + iscavt, cldvcu, cldvst, dlf, fracis, & + sol_fact, ncol, scavcoef, is_strat_cloudborne, qqcw, & + f_act_conv, icscavt, isscavt, bcscavt, bsscavt, & + convproc_do_aer, rcscavt, rsscavt, & + sol_facti_in, sol_factic_in ) + + !----------------------------------------------------------------------- + ! + ! scavenging code for very soluble aerosols + ! + !----------------------------------------------------------------------- + + real(r8), intent(in) ::& + p(pcols,pver), &! pressure + q(pcols,pver), &! moisture + pdel(pcols,pver), &! pressure thikness + cldt(pcols,pver), &! total cloud fraction + cldc(pcols,pver), &! convective cloud fraction + cmfdqr(pcols,pver), &! rate of production of convective precip + evapc(pcols,pver), &! Evaporation rate of convective precipitation + conicw(pcols,pver), &! convective cloud water + cwat(pcols,pver), &! cloud water amount + precs(pcols,pver), &! rate of production of stratiform precip + conds(pcols,pver), &! rate of production of condensate + evaps(pcols,pver), &! rate of evaporation of precip + cldvcu(pcols,pver), &! Convective precipitation area at the top interface of each layer + cldvst(pcols,pver), &! Stratiform precipitation area at the top interface of each layer + dlf(pcols,pver), &! Detrainment of convective condensate [kg/kg/s] + deltat, &! time step + tracer(pcols,pver) ! trace species + + ! If subroutine is called with just sol_fact: + ! sol_fact is used for both in- and below-cloud scavenging + ! If subroutine is called with optional argument sol_facti_in: + ! sol_fact is used for below cloud scavenging + ! sol_facti is used for in cloud scavenging + + real(r8), intent(in) :: sol_fact + integer, intent(in) :: ncol + real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO) + real(r8), intent(out) ::& + scavt(pcols,pver), &! scavenging tend + iscavt(pcols,pver), &! incloud scavenging tends + fracis(pcols,pver) ! fraction of species not scavenged + + ! Setting is_strat_cloudborne=.true. indicates that tracer is stratiform-cloudborne aerosol. + ! This is only used by MAM code. The optional args qqcw and f_act_conv are not referenced + ! in this case. + ! Setting is_strat_cloudborne=.false. is being used to indicate that the tracers are the + ! interstitial modal aerosols. In this case the optional qqcw (the cloud borne mixing ratio + ! corresponding to the interstitial aerosol) must be provided, as well as the optional f_act_conv. + logical, intent(in), optional :: is_strat_cloudborne + real(r8), intent(in), optional :: qqcw(pcols,pver) + real(r8), intent(in), optional :: f_act_conv(pcols,pver) + + real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud) + real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds + + + real(r8), intent(out), optional :: icscavt(pcols,pver) ! incloud, convective + real(r8), intent(out), optional :: isscavt(pcols,pver) ! incloud, stratiform + real(r8), intent(out), optional :: bcscavt(pcols,pver) ! below cloud, convective + real(r8), intent(out), optional :: bsscavt(pcols,pver) ! below cloud, stratiform + + ! Setting convproc_do_aer=.true. removes the resuspension term from bcscavt and + ! bsscavt and returns those terms as rcscavt and rsscavt respectively. + logical, intent(in), optional :: convproc_do_aer + real(r8), intent(out), optional :: rcscavt(pcols,pver) ! resuspension, convective + real(r8), intent(out), optional :: rsscavt(pcols,pver) ! resuspension, stratiform + + ! local variables + + integer :: i, k + logical :: out_resuspension + + real(r8) :: omsm ! 1 - (a small number) + real(r8) :: clds(pcols) ! stratiform cloud fraction + real(r8) :: fracev(pcols) ! fraction of precip from above that is evaporating + real(r8) :: fracev_cu(pcols) ! Fraction of convective precip from above that is evaporating + real(r8) :: fracp(pcols) ! fraction of cloud water converted to precip + real(r8) :: pdog(pcols) ! work variable (pdel/gravit) + real(r8) :: rpdog(pcols) ! work variable (gravit/pdel) + real(r8) :: precabc(pcols) ! conv precip from above (work array) + real(r8) :: precabs(pcols) ! strat precip from above (work array) + real(r8) :: rat(pcols) ! ratio of amount available to amount removed + real(r8) :: scavab(pcols) ! scavenged tracer flux from above (work array) + real(r8) :: scavabc(pcols) ! scavenged tracer flux from above (work array) + real(r8) :: srcc(pcols) ! tend for convective rain + real(r8) :: srcs(pcols) ! tend for stratiform rain + real(r8) :: srct(pcols) ! work variable + + real(r8) :: fins(pcols) ! fraction of rem. rate by strat rain + real(r8) :: finc(pcols) ! fraction of rem. rate by conv. rain + real(r8) :: conv_scav_ic(pcols) ! convective scavenging incloud + real(r8) :: conv_scav_bc(pcols) ! convective scavenging below cloud + real(r8) :: st_scav_ic(pcols) ! stratiform scavenging incloud + real(r8) :: st_scav_bc(pcols) ! stratiform scavenging below cloud + + real(r8) :: odds(pcols) ! limit on removal rate (proportional to prec) + real(r8) :: dblchek(pcols) + logical :: found + + real(r8) :: trac_qqcw(pcols) + real(r8) :: tracer_incu(pcols) + real(r8) :: tracer_mean(pcols) + + ! For stratiform cloud, cloudborne aerosol is treated explicitly, + ! and sol_facti is 1.0 for cloudborne, 0.0 for interstitial. + ! For convective cloud, cloudborne aerosol is not treated explicitly, + ! and sol_factic is 1.0 for both cloudborne and interstitial. + + real(r8) :: sol_facti ! in cloud fraction of aerosol scavenged + real(r8) :: sol_factb ! below cloud fraction of aerosol scavenged + real(r8) :: sol_factic(pcols,pver) ! in cloud fraction of aerosol scavenged for convective clouds + + real(r8) :: rdeltat + ! ------------------------------------------------------------------------ + + omsm = 1._r8-2*epsilon(1._r8) ! used to prevent roundoff errors below zero + + ! default (if other sol_facts aren't in call, set all to required sol_fact) + sol_facti = sol_fact + sol_factb = sol_fact + + if ( present(sol_facti_in) ) sol_facti = sol_facti_in + + sol_factic = sol_facti + if ( present(sol_factic_in ) ) sol_factic = sol_factic_in + + ! Determine whether resuspension fields are output. + out_resuspension = .false. + if (present(convproc_do_aer)) then + if (convproc_do_aer) then + if (present(bcscavt) .and. present(bsscavt) .and. & + present(rcscavt) .and. present(rsscavt) ) then + out_resuspension = .true. + else + call endrun('wetdepa_v2: bcscavt, bsscavt, rcscavt, rsscavt'// & + ' must be present when convproc_do_aero true') + end if + end if + end if + + ! this section of code is for highly soluble aerosols, + ! the assumption is that within the cloud that + ! all the tracer is in the cloud water + ! + ! for both convective and stratiform clouds, + ! the fraction of cloud water converted to precip defines + ! the amount of tracer which is pulled out. + + precabs(:ncol) = 0.0_r8 + precabc(:ncol) = 0.0_r8 + scavab(:ncol) = 0.0_r8 + scavabc(:ncol) = 0.0_r8 + + do k = 1, pver + do i = 1, ncol + + clds(i) = cldt(i,k) - cldc(i,k) + pdog(i) = pdel(i,k)/gravit + rpdog(i) = gravit/pdel(i,k) + rdeltat = 1.0_r8/deltat + + ! ****************** Evaporation ************************** + ! calculate the fraction of strat precip from above + ! which evaporates within this layer + fracev(i) = evaps(i,k)*pdog(i) & + /max(1.e-12_r8,precabs(i)) + + ! trap to ensure reasonable ratio bounds + fracev(i) = max(0._r8,min(1._r8,fracev(i))) + + ! Same as above but convective precipitation part + fracev_cu(i) = evapc(i,k)*pdog(i)/max(1.e-12_r8,precabc(i)) + fracev_cu(i) = max(0._r8,min(1._r8,fracev_cu(i))) + + ! ****************** Convection *************************** + ! + ! set odds proportional to fraction of the grid box that is swept by the + ! precipitation =precabc/rhoh20*(area of sphere projected on plane + ! /volume of sphere)*deltat + ! assume the radius of a raindrop is 1 e-3 m from Rogers and Yau, + ! unless the fraction of the area that is cloud is less than odds, in which + ! case use the cloud fraction (assumes precabs is in kg/m2/s) + ! is really: precabs*3/4/1000./1e-3*deltat + ! here I use .1 from Balkanski + ! + ! use a local rate of convective rain production for incloud scav + ! + ! Fraction of convective cloud water converted to rain. This version is used + ! in 2 of the 3 branches below before fracp is reused in the stratiform calc. + ! NB: In below formula for fracp conicw is a LWC/IWC that has already + ! precipitated out, i.e., conicw does not contain precipitation + + fracp(i) = cmfdqr(i,k)*deltat / & + max( 1.e-12_r8, cldc(i,k)*conicw(i,k) + (cmfdqr(i,k)+dlf(i,k))*deltat ) + fracp(i) = max( min( 1._r8, fracp(i)), 0._r8 ) + + if ( present(is_strat_cloudborne) ) then + + if ( is_strat_cloudborne ) then + + ! convective scavenging + + conv_scav_ic(i) = 0._r8 + + conv_scav_bc(i) = 0._r8 + + ! stratiform scavenging + + fracp(i) = precs(i,k)*deltat / & + max( 1.e-12_r8, cwat(i,k) + precs(i,k)*deltat ) + fracp(i) = max( 0._r8, min(1._r8, fracp(i)) ) + st_scav_ic(i) = sol_facti *fracp(i)*tracer(i,k)*rdeltat + + st_scav_bc(i) = 0._r8 + + else + + ! convective scavenging + + trac_qqcw(i) = min(qqcw(i,k), & + tracer(i,k)*( clds(i)/max( 0.01_r8, 1._r8-clds(i) ) ) ) + + tracer_incu(i) = f_act_conv(i,k)*(tracer(i,k) + trac_qqcw(i)) + + conv_scav_ic(i) = sol_factic(i,k)*cldc(i,k)*fracp(i)*tracer_incu(i)*rdeltat + + tracer_mean(i) = tracer(i,k)*(1._r8 - cldc(i,k)*f_act_conv(i,k)) - & + cldc(i,k)*f_act_conv(i,k)*trac_qqcw(i) + tracer_mean(i) = max(0._r8,tracer_mean(i)) + + odds(i) = precabc(i)/max(cldvcu(i,k),1.e-5_r8)*scavcoef(i,k)*deltat + odds(i) = max(min(1._r8,odds(i)),0._r8) + conv_scav_bc(i) = sol_factb *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat + + + ! stratiform scavenging + + st_scav_ic(i) = 0._r8 + + odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat + odds(i) = max(min(1._r8,odds(i)),0._r8) + st_scav_bc(i) = sol_factb *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat + + end if + + else + + ! convective scavenging + + conv_scav_ic(i) = sol_factic(i,k)*cldc(i,k)*fracp(i)*tracer(i,k)*rdeltat + + odds(i) = precabc(i)/max(cldvcu(i,k), 1.e-5_r8)*scavcoef(i,k)*deltat + odds(i) = max( min(1._r8, odds(i)), 0._r8) + conv_scav_bc(i) = sol_factb*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat + + ! stratiform scavenging + + ! fracp is the fraction of cloud water converted to precip + ! NB: In below formula for fracp cwat is a LWC/IWC that has already + ! precipitated out, i.e., cwat does not contain precipitation + fracp(i) = precs(i,k)*deltat / & + max( 1.e-12_r8, cwat(i,k) + precs(i,k)*deltat ) + fracp(i) = max( 0._r8, min( 1._r8, fracp(i) ) ) + + ! assume the corresponding amnt of tracer is removed + st_scav_ic(i) = sol_facti*clds(i)*fracp(i)*tracer(i,k)*rdeltat + + odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat + odds(i) = max(min(1._r8,odds(i)),0._r8) + st_scav_bc(i) =sol_factb*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat + + end if + + ! total convective scavenging + srcc(i) = conv_scav_ic(i) + conv_scav_bc(i) + finc(i) = conv_scav_ic(i)/(srcc(i) + 1.e-36_r8) + + ! total stratiform scavenging + srcs(i) = st_scav_ic(i) + st_scav_bc(i) + fins(i) = st_scav_ic(i)/(srcs(i) + 1.e-36_r8) + + ! make sure we dont take out more than is there + ! ratio of amount available to amount removed + rat(i) = tracer(i,k)/max(deltat*(srcc(i)+srcs(i)),1.e-36_r8) + if (rat(i).lt.1._r8) then + srcs(i) = srcs(i)*rat(i) + srcc(i) = srcc(i)*rat(i) + endif + srct(i) = (srcc(i)+srcs(i))*omsm + + + ! fraction that is not removed within the cloud + ! (assumed to be interstitial, and subject to convective transport) + fracp(i) = deltat*srct(i)/max(cldvst(i,k)*tracer(i,k),1.e-36_r8) ! amount removed + fracp(i) = max(0._r8,min(1._r8,fracp(i))) + fracis(i,k) = 1._r8 - fracp(i) + + ! tend is all tracer removed by scavenging, plus all re-appearing from evaporation above + ! Sungsu added cumulus contribution in the below 3 blocks + scavt(i,k) = -srct(i) + (fracev(i)*scavab(i)+fracev_cu(i)*scavabc(i))*rpdog(i) + iscavt(i,k) = -(srcc(i)*finc(i) + srcs(i)*fins(i))*omsm + + if ( present(icscavt) ) icscavt(i,k) = -(srcc(i)*finc(i)) * omsm + if ( present(isscavt) ) isscavt(i,k) = -(srcs(i)*fins(i)) * omsm + + if (.not. out_resuspension) then + if (present(bcscavt)) bcscavt(i,k) = -(srcc(i) * (1-finc(i))) * omsm + & + fracev_cu(i)*scavabc(i)*rpdog(i) + + if (present(bsscavt)) bsscavt(i,k) = -(srcs(i) * (1-fins(i))) * omsm + & + fracev(i)*scavab(i)*rpdog(i) + else + bcscavt(i,k) = -(srcc(i) * (1-finc(i))) * omsm + rcscavt(i,k) = fracev_cu(i)*scavabc(i)*rpdog(i) + + bsscavt(i,k) = -(srcs(i) * (1-fins(i))) * omsm + rsscavt(i,k) = fracev(i)*scavab(i)*rpdog(i) + end if + + dblchek(i) = tracer(i,k) + deltat*scavt(i,k) + + ! now keep track of scavenged mass and precip + scavab(i) = scavab(i)*(1-fracev(i)) + srcs(i)*pdog(i) + precabs(i) = precabs(i) + (precs(i,k) - evaps(i,k))*pdog(i) + scavabc(i) = scavabc(i)*(1-fracev_cu(i)) + srcc(i)*pdog(i) + precabc(i) = precabc(i) + (cmfdqr(i,k) - evapc(i,k))*pdog(i) + + end do ! End of i = 1, ncol + + found = .false. + do i = 1,ncol + if ( dblchek(i) < 0._r8 ) then + found = .true. + exit + end if + end do + + if ( found ) then + do i = 1,ncol + if (dblchek(i) .lt. 0._r8) then + write(iulog,*) ' wetdapa: negative value ', i, k, tracer(i,k), & + dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) + endif + end do + endif + + end do ! End of k = 1, pver + +end subroutine wetdepa_v2 + + +!============================================================================== + +! This is the frozen CAM4 version of wetdepa. + + + subroutine wetdepa_v1( t, p, q, pdel, & + cldt, cldc, cmfdqr, conicw, precs, conds, & + evaps, cwat, tracer, deltat, & + scavt, iscavt, cldv, fracis, sol_fact, ncol, & + scavcoef,icscavt, isscavt, bcscavt, bsscavt, & + sol_facti_in, sol_factbi_in, sol_factii_in, & + sol_factic_in, sol_factiic_in ) + + !----------------------------------------------------------------------- + ! Purpose: + ! scavenging code for very soluble aerosols + ! + ! Author: P. Rasch + ! Modified by T. Bond 3/2003 to track different removals + !----------------------------------------------------------------------- + + implicit none + + real(r8), intent(in) ::& + t(pcols,pver), &! temperature + p(pcols,pver), &! pressure + q(pcols,pver), &! moisture + pdel(pcols,pver), &! pressure thikness + cldt(pcols,pver), &! total cloud fraction + cldc(pcols,pver), &! convective cloud fraction + cmfdqr(pcols,pver), &! rate of production of convective precip + conicw(pcols,pver), &! convective cloud water + cwat(pcols,pver), &! cloud water amount + precs(pcols,pver), &! rate of production of stratiform precip + conds(pcols,pver), &! rate of production of condensate + evaps(pcols,pver), &! rate of evaporation of precip + cldv(pcols,pver), &! total cloud fraction + deltat, &! time step + tracer(pcols,pver) ! trace species + ! If subroutine is called with just sol_fact: + ! sol_fact is used for both in- and below-cloud scavenging + ! If subroutine is called with optional argument sol_facti_in: + ! sol_fact is used for below cloud scavenging + ! sol_facti is used for in cloud scavenging + real(r8), intent(in) :: sol_fact ! solubility factor (fraction of aer scavenged below & in, or just below or sol_facti_in is provided) + real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud) + real(r8), intent(in), optional :: sol_factbi_in ! solubility factor (frac of aerosol scavenged below cloud by ice) + real(r8), intent(in), optional :: sol_factii_in ! solubility factor (frac of aerosol scavenged in cloud by ice) + real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds + real(r8), intent(in), optional :: sol_factiic_in ! sol_factii_in for convective clouds + real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO) + + integer, intent(in) :: ncol + + real(r8), intent(out) ::& + scavt(pcols,pver), &! scavenging tend + iscavt(pcols,pver), &! incloud scavenging tends + fracis(pcols,pver) ! fraction of species not scavenged + + real(r8), intent(out), optional :: icscavt(pcols,pver) ! incloud, convective + real(r8), intent(out), optional :: isscavt(pcols,pver) ! incloud, stratiform + real(r8), intent(out), optional :: bcscavt(pcols,pver) ! below cloud, convective + real(r8), intent(out), optional :: bsscavt(pcols,pver) ! below cloud, stratiform + + ! local variables + + integer i ! x index + integer k ! z index + + real(r8) adjfac ! factor stolen from cmfmca + real(r8) aqfrac ! fraction of tracer in aqueous phase + real(r8) cwatc ! local convective total water amount + real(r8) cwats ! local stratiform total water amount + real(r8) cwatp ! local water amount falling from above precip + real(r8) fracev(pcols) ! fraction of precip from above that is evaporating + real(r8) fracp ! fraction of cloud water converted to precip + real(r8) gafrac ! fraction of tracer in gas phasea + real(r8) hconst ! henry's law solubility constant when equation is expressed + ! in terms of mixing ratios + real(r8) mpla ! moles / liter H2O entering the layer from above + real(r8) mplb ! moles / liter H2O leaving the layer below + real(r8) omsm ! 1 - (a small number) + real(r8) part ! partial pressure of tracer in atmospheres + real(r8) patm ! total pressure in atmospheres + real(r8) pdog ! work variable (pdel/gravit) + real(r8) precabc(pcols) ! conv precip from above (work array) + real(r8) precabs(pcols) ! strat precip from above (work array) + real(r8) precbl ! precip falling out of level (work array) + real(r8) precmin ! minimum convective precip causing scavenging + real(r8) rat(pcols) ! ratio of amount available to amount removed + real(r8) scavab(pcols) ! scavenged tracer flux from above (work array) + real(r8) scavabc(pcols) ! scavenged tracer flux from above (work array) + real(r8) srcc ! tend for convective rain + real(r8) srcs ! tend for stratiform rain + real(r8) srct(pcols) ! work variable + real(r8) tracab(pcols) ! column integrated tracer amount + + real(r8) fins ! fraction of rem. rate by strat rain + real(r8) finc ! fraction of rem. rate by conv. rain + real(r8) srcs1 ! work variable + real(r8) srcs2 ! work variable + real(r8) tc ! temp in celcius + real(r8) weight ! fraction of condensate which is ice + real(r8) cldmabs(pcols) ! maximum cloud at or above this level + real(r8) cldmabc(pcols) ! maximum cloud at or above this level + real(r8) odds ! limit on removal rate (proportional to prec) + real(r8) dblchek(pcols) + logical :: found + + real(r8) sol_facti, sol_factb ! in cloud and below cloud fraction of aerosol scavenged + real(r8) sol_factii, sol_factbi ! in cloud and below cloud fraction of aerosol scavenged by ice + real(r8) sol_factic(pcols,pver) ! sol_facti for convective clouds + real(r8) sol_factiic ! sol_factii for convective clouds + ! sol_factic & solfact_iic added for MODAL_AERO. + ! For stratiform cloud, cloudborne aerosol is treated explicitly, + ! and sol_facti is 1.0 for cloudborne, 0.0 for interstitial. + ! For convective cloud, cloudborne aerosol is not treated explicitly, + ! and sol_factic is 1.0 for both cloudborne and interstitial. + + ! ------------------------------------------------------------------------ +! omsm = 1.-1.e-10 ! used to prevent roundoff errors below zero + omsm = 1._r8-2*epsilon(1._r8) ! used to prevent roundoff errors below zero + precmin = 0.1_r8/8.64e4_r8 ! set critical value to 0.1 mm/day in kg/m2/s + + adjfac = deltat/(max(deltat,cmftau)) ! adjustment factor from hack scheme + + ! default (if other sol_facts aren't in call, set all to required sol_fact + sol_facti = sol_fact + sol_factb = sol_fact + sol_factii = sol_fact + sol_factbi = sol_fact + + if ( present(sol_facti_in) ) sol_facti = sol_facti_in + if ( present(sol_factii_in) ) sol_factii = sol_factii_in + if ( present(sol_factbi_in) ) sol_factbi = sol_factbi_in + + sol_factic = sol_facti + sol_factiic = sol_factii + if ( present(sol_factic_in ) ) sol_factic = sol_factic_in + if ( present(sol_factiic_in) ) sol_factiic = sol_factiic_in + + ! this section of code is for highly soluble aerosols, + ! the assumption is that within the cloud that + ! all the tracer is in the cloud water + ! + ! for both convective and stratiform clouds, + ! the fraction of cloud water converted to precip defines + ! the amount of tracer which is pulled out. + ! + + do i = 1,pcols + precabs(i) = 0 + precabc(i) = 0 + scavab(i) = 0 + scavabc(i) = 0 + tracab(i) = 0 + cldmabs(i) = 0 + cldmabc(i) = 0 + end do + + do k = 1,pver + do i = 1,ncol + tc = t(i,k) - tmelt + weight = max(0._r8,min(-tc*0.05_r8,1.0_r8)) ! fraction of condensate that is ice + weight = 0._r8 ! assume no ice + + pdog = pdel(i,k)/gravit + + ! ****************** Evaporation ************************** + ! calculate the fraction of strat precip from above + ! which evaporates within this layer + fracev(i) = evaps(i,k)*pdel(i,k)/gravit & + /max(1.e-12_r8,precabs(i)) + + ! trap to ensure reasonable ratio bounds + fracev(i) = max(0._r8,min(1._r8,fracev(i))) + + ! ****************** Convection *************************** + ! now do the convective scavenging + + ! set odds proportional to fraction of the grid box that is swept by the + ! precipitation =precabc/rhoh20*(area of sphere projected on plane + ! /volume of sphere)*deltat + ! assume the radius of a raindrop is 1 e-3 m from Rogers and Yau, + ! unless the fraction of the area that is cloud is less than odds, in which + ! case use the cloud fraction (assumes precabs is in kg/m2/s) + ! is really: precabs*3/4/1000./1e-3*deltat + ! here I use .1 from Balkanski + ! + ! use a local rate of convective rain production for incloud scav + !odds=max(min(1._r8, & + ! cmfdqr(i,k)*pdel(i,k)/gravit*0.1_r8*deltat),0._r8) + !++mcb -- change cldc to cldt; change cldt to cldv (9/17/96) + ! srcs1 = cldt(i,k)*odds*tracer(i,k)*(1.-weight) & + ! srcs1 = cldv(i,k)*odds*tracer(i,k)*(1.-weight) & + !srcs1 = cldc(i,k)*odds*tracer(i,k)*(1.-weight) & + ! /deltat + + ! fraction of convective cloud water converted to rain + fracp = cmfdqr(i,k)*deltat/max(1.e-8_r8,conicw(i,k)) + ! note cmfdrq can be negative from evap of rain, so constrain it + fracp = max(min(1._r8,fracp),0._r8) + ! remove that amount from within the convective area +! srcs1 = cldc(i,k)*fracp*tracer(i,k)*(1._r8-weight)/deltat ! liquid only +! srcs1 = cldc(i,k)*fracp*tracer(i,k)/deltat ! any condensation +! srcs1 = 0. + srcs1 = sol_factic(i,k)*cldt(i,k)*fracp*tracer(i,k)*(1._r8-weight)/deltat & ! liquid + + sol_factiic*cldt(i,k)*fracp*tracer(i,k)*(weight)/deltat ! ice + + + !--mcb + + ! scavenge below cloud + + ! cldmabc(i) = max(cldc(i,k),cldmabc(i)) + ! cldmabc(i) = max(cldt(i,k),cldmabc(i)) + cldmabc(i) = max(cldv(i,k),cldmabc(i)) + cldmabc(i) = cldv(i,k) + + odds=max( & + min(1._r8,precabc(i)/max(cldmabc(i),1.e-5_r8) & + *scavcoef(i,k)*deltat),0._r8) ! Dana and Hales coefficient (/mm) + srcs2 = sol_factb*cldmabc(i)*odds*tracer(i,k)*(1._r8-weight)/deltat & ! liquid + + sol_factbi*cldmabc(i)*odds*tracer(i,k)*(weight)/deltat !ice + !Note that using the temperature-determined weight doesn't make much sense here + + + srcc = srcs1 + srcs2 ! convective tend by both processes + finc = srcs1/(srcc + 1.e-36_r8) ! fraction in-cloud + + ! ****************** Stratiform *********************** + ! now do the stratiform scavenging + + ! incloud scavenging + + ! fracp is the fraction of cloud water converted to precip + fracp = precs(i,k)*deltat/max(cwat(i,k),1.e-12_r8) + fracp = max(0._r8,min(1._r8,fracp)) +! fracp = 0. ! for debug + + ! assume the corresponding amnt of tracer is removed + !++mcb -- remove cldc; change cldt to cldv + ! srcs1 = (cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat + ! srcs1 = cldv(i,k)*fracp*tracer(i,k)/deltat & +! srcs1 = cldt(i,k)*fracp*tracer(i,k)/deltat ! all condensate + srcs1 = sol_facti*cldt(i,k)*fracp*tracer(i,k)/deltat*(1._r8-weight) & ! liquid + + sol_factii*cldt(i,k)*fracp*tracer(i,k)/deltat*(weight) ! ice + + + ! below cloud scavenging + +! volume undergoing below cloud scavenging + cldmabs(i) = cldv(i,k) ! precipitating volume +! cldmabs(i) = cldt(i,k) ! local cloud volume + + odds = precabs(i)/max(cldmabs(i),1.e-5_r8)*scavcoef(i,k)*deltat + odds = max(min(1._r8,odds),0._r8) + srcs2 =sol_factb*(cldmabs(i)*odds) *tracer(i,k)*(1._r8-weight)/deltat & ! liquid + + sol_factbi*(cldmabs(i)*odds) *tracer(i,k)*(weight)/deltat ! ice + !Note that using the temperature-determined weight doesn't make much sense here + + + srcs = srcs1 + srcs2 ! total stratiform scavenging + fins=srcs1/(srcs + 1.e-36_r8) ! fraction taken by incloud processes + + ! make sure we dont take out more than is there + ! ratio of amount available to amount removed + rat(i) = tracer(i,k)/max(deltat*(srcc+srcs),1.e-36_r8) + if (rat(i).lt.1._r8) then + srcs = srcs*rat(i) + srcc = srcc*rat(i) + endif + srct(i) = (srcc+srcs)*omsm + + + ! fraction that is not removed within the cloud + ! (assumed to be interstitial, and subject to convective transport) + fracp = deltat*srct(i)/max(cldmabs(i)*tracer(i,k),1.e-36_r8) ! amount removed + fracp = max(0._r8,min(1._r8,fracp)) + fracis(i,k) = 1._r8 - fracp + + ! tend is all tracer removed by scavenging, plus all re-appearing from evaporation above + scavt(i,k) = -srct(i) + fracev(i)*scavab(i)*gravit/pdel(i,k) + iscavt(i,k) = -(srcc*finc + srcs*fins)*omsm + + if ( present(icscavt) ) icscavt(i,k) = -(srcc*finc) * omsm + if ( present(isscavt) ) isscavt(i,k) = -(srcs*fins) * omsm + if ( present(bcscavt) ) bcscavt(i,k) = -(srcc * (1-finc)) * omsm + if ( present(bsscavt) ) bsscavt(i,k) = -(srcs * (1-fins)) * omsm + & + fracev(i)*scavab(i)*gravit/pdel(i,k) + + dblchek(i) = tracer(i,k) + deltat*scavt(i,k) + + ! now keep track of scavenged mass and precip + scavab(i) = scavab(i)*(1-fracev(i)) + srcs*pdel(i,k)/gravit + precabs(i) = precabs(i) + (precs(i,k) - evaps(i,k))*pdel(i,k)/gravit + scavabc(i) = scavabc(i) + srcc*pdel(i,k)/gravit + precabc(i) = precabc(i) + (cmfdqr(i,k))*pdel(i,k)/gravit + tracab(i) = tracab(i) + tracer(i,k)*pdel(i,k)/gravit + + end do + + found = .false. + do i = 1,ncol + if ( dblchek(i) < 0._r8 ) then + found = .true. + exit + end if + end do + + if ( found ) then + do i = 1,ncol + if (dblchek(i) .lt. 0._r8) then + write(iulog,*) ' wetdapa: negative value ', i, k, tracer(i,k), & + dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) + endif + end do + endif + + end do + + end subroutine wetdepa_v1 + +!============================================================================== + +! wetdepg is currently being used for both CAM4 and CAM5 by making use of the +! cam_physpkg_is method. + + subroutine wetdepg( t, p, q, pdel, & + cldt, cldc, cmfdqr, evapc, precs, evaps, & + rain, cwat, tracer, deltat, molwt, & + solconst, scavt, iscavt, cldv, icwmr1, & + icwmr2, fracis, ncol ) + + !----------------------------------------------------------------------- + ! Purpose: + ! scavenging of gas phase constituents by henry's law + ! + ! Author: P. Rasch + !----------------------------------------------------------------------- + + real(r8), intent(in) ::& + t(pcols,pver), &! temperature + p(pcols,pver), &! pressure + q(pcols,pver), &! moisture + pdel(pcols,pver), &! pressure thikness + cldt(pcols,pver), &! total cloud fraction + cldc(pcols,pver), &! convective cloud fraction + cmfdqr(pcols,pver), &! rate of production of convective precip + rain (pcols,pver), &! total rainwater mixing ratio + cwat(pcols,pver), &! cloud water amount + precs(pcols,pver), &! rate of production of stratiform precip + evaps(pcols,pver), &! rate of evaporation of precip +! Sungsu + evapc(pcols,pver), &! Rate of evaporation of convective precipitation +! Sungsu + cldv(pcols,pver), &! estimate of local volume occupied by clouds + icwmr1 (pcols,pver), &! in cloud water mixing ration for zhang scheme + icwmr2 (pcols,pver), &! in cloud water mixing ration for hack scheme + deltat, &! time step + tracer(pcols,pver), &! trace species + molwt ! molecular weights + + integer, intent(in) :: ncol + + real(r8) & + solconst(pcols,pver) ! Henry's law coefficient + + real(r8), intent(out) ::& + scavt(pcols,pver), &! scavenging tend + iscavt(pcols,pver), &! incloud scavenging tends + fracis(pcols, pver) ! fraction of constituent that is insoluble + + ! local variables + + integer i ! x index + integer k ! z index + + real(r8) adjfac ! factor stolen from cmfmca + real(r8) aqfrac ! fraction of tracer in aqueous phase + real(r8) cwatc ! local convective total water amount + real(r8) cwats ! local stratiform total water amount + real(r8) cwatl ! local cloud liq water amount + real(r8) cwatp ! local water amount falling from above precip + real(r8) cwatpl ! local water amount falling from above precip (liq) + real(r8) cwatt ! local sum of strat + conv total water amount + real(r8) cwatti ! cwatt/cldv = cloudy grid volume mixing ratio + real(r8) fracev ! fraction of precip from above that is evaporating + real(r8) fracp ! fraction of cloud water converted to precip + real(r8) gafrac ! fraction of tracer in gas phasea + real(r8) hconst ! henry's law solubility constant when equation is expressed + ! in terms of mixing ratios + real(r8) mpla ! moles / liter H2O entering the layer from above + real(r8) mplb ! moles / liter H2O leaving the layer below + real(r8) omsm ! 1 - (a small number) + real(r8) part ! partial pressure of tracer in atmospheres + real(r8) patm ! total pressure in atmospheres + real(r8) pdog ! work variable (pdel/gravit) + real(r8) precab(pcols) ! precip from above (work array) + real(r8) precbl ! precip work variable + real(r8) precxx ! precip work variable + real(r8) precxx2 ! + real(r8) precic ! precip work variable + real(r8) rat ! ratio of amount available to amount removed + real(r8) scavab(pcols) ! scavenged tracer flux from above (work array) + real(r8) scavabc(pcols) ! scavenged tracer flux from above (work array) + + real(r8) scavmax ! an estimate of the max tracer avail for removal + real(r8) scavbl ! flux removed at bottom of layer + real(r8) fins ! in cloud fraction removed by strat rain + real(r8) finc ! in cloud fraction removed by conv rain + real(r8) rate ! max removal rate estimate + real(r8) scavlimt ! limiting value 1 + real(r8) scavt1 ! limiting value 2 + real(r8) scavin ! scavenging by incloud processes + real(r8) scavbc ! scavenging by below cloud processes + real(r8) tc + real(r8) weight ! ice fraction + real(r8) wtpl ! work variable + real(r8) cldmabs(pcols) ! maximum cloud at or above this level + real(r8) cldmabc(pcols) ! maximum cloud at or above this level + !----------------------------------------------------------- + + omsm = 1._r8-2*epsilon(1._r8) ! used to prevent roundoff errors below zero + + adjfac = deltat/(max(deltat,cmftau)) ! adjustment factor from hack scheme + + ! zero accumulators + do i = 1,pcols + precab(i) = 1.e-36_r8 + scavab(i) = 0._r8 + cldmabs(i) = 0._r8 + end do + + do k = 1,pver + do i = 1,ncol + + tc = t(i,k) - tmelt + weight = max(0._r8,min(-tc*0.05_r8,1.0_r8)) ! fraction of condensate that is ice + + cldmabs(i) = max(cldmabs(i),cldt(i,k)) + + ! partitioning coefs for gas and aqueous phase + ! take as a cloud water amount, the sum of the stratiform amount + ! plus the convective rain water amount + + ! convective amnt is just the local precip rate from the hack scheme + ! since there is no storage of water, this ignores that falling from above + ! cwatc = cmfdqr(i,k)*deltat/adjfac + !++mcb -- test cwatc + cwatc = (icwmr1(i,k) + icwmr2(i,k)) * (1._r8-weight) + !--mcb + + ! strat cloud water amount and also ignore the part falling from above + cwats = cwat(i,k) + + ! cloud water as liq + !++mcb -- add cwatc later (in cwatti) + ! cwatl = (1.-weight)*(cwatc+cwats) + cwatl = (1._r8-weight)*cwats + ! cloud water as ice + !*not used cwati = weight*(cwatc+cwats) + + ! total suspended condensate as liquid + cwatt = cwatl + rain(i,k) + + ! incloud version + !++mcb -- add cwatc here + cwatti = cwatt/max(cldv(i,k), 0.00001_r8) + cwatc + + ! partitioning terms + patm = p(i,k)/1.013e5_r8 ! pressure in atmospheres + hconst = molwta*patm*solconst(i,k)*cwatti/rhoh2o + aqfrac = hconst/(1._r8+hconst) + gafrac = 1/(1._r8+hconst) + fracis(i,k) = gafrac + + + ! partial pressure of the tracer in the gridbox in atmospheres + part = patm*gafrac*tracer(i,k)*molwta/molwt + + ! use henrys law to give moles tracer /liter of water + ! in this volume + ! then convert to kg tracer /liter of water (kg tracer / kg water) + mplb = solconst(i,k)*part*molwt/1000._r8 + + + pdog = pdel(i,k)/gravit + + ! this part of precip will be carried downward but at a new molarity of mpl + precic = pdog*(precs(i,k) + cmfdqr(i,k)) + + ! we cant take out more than entered, plus that available in the cloud + ! scavmax = scavab(i)+tracer(i,k)*cldt(i,k)/deltat*pdog + scavmax = scavab(i)+tracer(i,k)*cldv(i,k)/deltat*pdog + + ! flux of tracer by incloud processes + scavin = precic*(1._r8-weight)*mplb + + ! fraction of precip which entered above that leaves below + if (cam_physpkg_is('cam5') .or. cam_physpkg_is('cam6')) then + ! Sungsu added evaporation of convective precipitation below. + precxx = precab(i)-pdog*(evaps(i,k)+evapc(i,k)) + else + precxx = precab(i)-pdog*evaps(i,k) + end if + precxx = max (precxx,0.0_r8) + + ! flux of tracer by below cloud processes + !++mcb -- removed wtpl because it is now not assigned and previously + ! when it was assigned it was unnecessary: if(tc.gt.0)wtpl=1 + if (tc.gt.0) then + ! scavbc = precxx*wtpl*mplb ! if liquid + scavbc = precxx*mplb ! if liquid + else + precxx2=max(precxx,1.e-36_r8) + scavbc = scavab(i)*precxx2/(precab(i)) ! if ice + endif + + scavbl = min(scavbc + scavin, scavmax) + + ! first guess assuming that henries law works + scavt1 = (scavab(i)-scavbl)/pdog*omsm + + ! pjr this should not be required, but we put it in to make sure we cant remove too much + ! remember, scavt1 is generally negative (indicating removal) + scavt1 = max(scavt1,-tracer(i,k)*cldv(i,k)/deltat) + + !++mcb -- remove this limitation for gas species + !c use the dana and hales or balkanski limit on scavenging + !c rate = precab(i)*0.1 + ! rate = (precic + precxx)*0.1 + ! scavlimt = -tracer(i,k)*cldv(i,k) + ! $ *rate/(1.+rate*deltat) + + ! scavt(i,k) = max(scavt1, scavlimt) + + ! instead just set scavt to scavt1 + scavt(i,k) = scavt1 + !--mcb + + ! now update the amount leaving the layer + scavbl = scavab(i) - scavt(i,k)*pdog + + ! in cloud amount is that formed locally over the total flux out bottom + fins = scavin/(scavin + scavbc + 1.e-36_r8) + iscavt(i,k) = scavt(i,k)*fins + + scavab(i) = scavbl + precab(i) = max(precxx + precic,1.e-36_r8) + + + + end do + end do + + end subroutine wetdepg + +!############################################################################## + +end module wetdep diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 new file mode 100644 index 0000000000..756533556a --- /dev/null +++ b/src/chemistry/bulk_aero/aero_model.F90 @@ -0,0 +1,1153 @@ +!=============================================================================== +! Bulk Aerosol Model +!=============================================================================== +module aero_model + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst, cnst_name, cnst_get_ind + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use perf_mod, only: t_startf, t_stopf + use camsrfexch, only: cam_in_t, cam_out_t + use aerodep_flx, only: aerodep_flx_prescribed + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc + use physconst, only: gravit, rair + use dust_model, only: dust_active, dust_names, dust_nbin + use seasalt_model, only: sslt_active=>seasalt_active, seasalt_names, seasalt_nbin + use spmd_utils, only: masterproc + use physics_buffer, only: pbuf_get_field, pbuf_get_index + use cam_history, only: outfld + use infnan, only: nan, assignment(=) + + implicit none + private + + public :: aero_model_readnl + public :: aero_model_register + public :: aero_model_init + public :: aero_model_gasaerexch ! create, grow, change, and shrink aerosols. + public :: aero_model_drydep ! aerosol dry deposition and sediment + public :: aero_model_wetdep ! aerosol wet removal + public :: aero_model_emissions ! aerosol emissions + public :: aero_model_surfarea ! tropospheric aerosol wet surface area for chemistry + public :: aero_model_strat_surfarea ! stub + + ! Misc private data + + integer :: so4_ndx, cb2_ndx, oc2_ndx, nit_ndx + integer :: soa_ndx, soai_ndx, soam_ndx, soab_ndx, soat_ndx, soax_ndx + + ! Namelist variables + character(len=16) :: wetdep_list(pcnst) = ' ' + character(len=16) :: drydep_list(pcnst) = ' ' + + integer :: ndrydep = 0 + integer,allocatable :: drydep_indices(:) + integer :: nwetdep = 0 + integer,allocatable :: wetdep_indices(:) + logical :: drydep_lq(pcnst) + logical :: wetdep_lq(pcnst) + + integer :: fracis_idx = 0 + + real(r8) :: aer_sol_facti(pcnst) ! in-cloud solubility factor + real(r8) :: aer_sol_factb(pcnst) ! below-cloud solubility factor + real(r8) :: aer_scav_coef(pcnst) + +contains + + !============================================================================= + ! reads aerosol namelist options + !============================================================================= + subroutine aero_model_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_model_readnl' + + ! Namelist variables + character(len=16) :: aer_wetdep_list(pcnst) = ' ' + character(len=16) :: aer_drydep_list(pcnst) = ' ' + + namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list + namelist /aerosol_nl/ aer_sol_facti, aer_sol_factb, aer_scav_coef + !----------------------------------------------------------------------------- + aer_sol_facti = nan + aer_sol_factb = nan + aer_scav_coef = nan + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast(aer_sol_facti, pcnst, mpir8, 0, mpicom) + call mpibcast(aer_sol_factb, pcnst, mpir8, 0, mpicom) + call mpibcast(aer_scav_coef, pcnst, mpir8, 0, mpicom) +#endif + + wetdep_list = aer_wetdep_list + drydep_list = aer_drydep_list + + end subroutine aero_model_readnl + + !============================================================================= + !============================================================================= + subroutine aero_model_register() + use mo_setsoa, only : soa_register + + call soa_register() + end subroutine aero_model_register + + !============================================================================= + !============================================================================= + subroutine aero_model_init( pbuf2d ) + + use mo_chem_utls, only: get_inv_ndx, get_spc_ndx + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + use mo_aerosols, only: aerosols_inti + use mo_setsoa, only: soa_inti + use dust_model, only: dust_init + use seasalt_model, only: seasalt_init + use drydep_mod, only: inidrydep + use wetdep, only: wetdep_init + use mo_setsox, only: has_sox + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + character(len=12), parameter :: subrname = 'aero_model_init' + integer :: m, id + character(len=20) :: dummy + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + + call phys_getopts( history_aerosol_out=history_aerosol ) + call aerosols_inti() + call soa_inti(pbuf2d) + call dust_init() + call seasalt_init() + call wetdep_init() + + fracis_idx = pbuf_get_index('FRACIS') + + nwetdep = 0 + ndrydep = 0 + + count_species: do m = 1,pcnst + if ( len_trim(wetdep_list(m)) /= 0 ) then + nwetdep = nwetdep+1 + endif + if ( len_trim(drydep_list(m)) /= 0 ) then + ndrydep = ndrydep+1 + endif + enddo count_species + + if (nwetdep>0) & + allocate(wetdep_indices(nwetdep)) + if (ndrydep>0) & + allocate(drydep_indices(ndrydep)) + + do m = 1,ndrydep + call cnst_get_ind ( drydep_list(m), id, abort=.false. ) + if (id>0) then + drydep_indices(m) = id + else + call endrun(subrname//': invalid drydep species: '//trim(drydep_list(m)) ) + endif + + if (masterproc) then + write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' + endif + enddo + do m = 1,nwetdep + call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) + if (id>0) then + wetdep_indices(m) = id + else + call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) + endif + + if (masterproc) then + write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' + endif + enddo + + ! set flags for drydep tendencies + drydep_lq(:) = .false. + do m=1,ndrydep + id = drydep_indices(m) + drydep_lq(id) = .true. + enddo + + ! set flags for wetdep tendencies + wetdep_lq(:) = .false. + do m=1,nwetdep + id = wetdep_indices(m) + wetdep_lq(id) = .true. + enddo + + do m = 1,ndrydep + + dummy = trim(drydep_list(m)) // 'TB' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m))//' turbulent dry deposition flux') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = trim(drydep_list(m)) // 'GV' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' gravitational dry deposition flux') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = trim(drydep_list(m)) // 'DD' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' dry deposition flux at bottom (grav + turb)') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = trim(drydep_list(m)) // 'DT' + call addfld (dummy,(/ 'lev' /), 'A','kg/kg/s',trim(drydep_list(m))//' dry deposition') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = trim(drydep_list(m)) // 'DV' + call addfld (dummy,(/ 'lev' /), 'A','m/s',trim(drydep_list(m))//' deposition velocity') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + + enddo + + if (ndrydep>0) then + + call inidrydep(rair, gravit) + + dummy = 'RAM1' + call addfld (dummy,horiz_only, 'A','frac','RAM1') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = 'airFV' + call addfld (dummy,horiz_only, 'A','frac','FV') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + + if (sslt_active) then + dummy = 'SSTSFDRY' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt deposition flux at surface') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + endif + if (dust_active) then + dummy = 'DSTSFDRY' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust deposition flux at surface') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + endif + + endif + + do m = 1,nwetdep + + call addfld (trim(wetdep_list(m))//'SFWET', horiz_only, 'A','kg/m2/s', & + 'Wet deposition flux at surface') + call addfld (trim(wetdep_list(m))//'SFSIC', horiz_only, 'A','kg/m2/s', & + 'Wet deposition flux (incloud, convective) at surface') + call addfld (trim(wetdep_list(m))//'SFSIS', horiz_only, 'A','kg/m2/s', & + 'Wet deposition flux (incloud, stratiform) at surface') + call addfld (trim(wetdep_list(m))//'SFSBC', horiz_only, 'A','kg/m2/s', & + 'Wet deposition flux (belowcloud, convective) at surface') + call addfld (trim(wetdep_list(m))//'SFSBS', horiz_only, 'A','kg/m2/s', & + 'Wet deposition flux (belowcloud, stratiform) at surface') + call addfld (trim(wetdep_list(m))//'WET', (/ 'lev' /), 'A','kg/kg/s', & + 'wet deposition tendency') + call addfld (trim(wetdep_list(m))//'SIC', (/ 'lev' /), 'A','kg/kg/s', & + trim(wetdep_list(m))//' ic wet deposition') + call addfld (trim(wetdep_list(m))//'SIS', (/ 'lev' /), 'A','kg/kg/s', & + trim(wetdep_list(m))//' is wet deposition') + call addfld (trim(wetdep_list(m))//'SBC', (/ 'lev' /), 'A','kg/kg/s', & + trim(wetdep_list(m))//' bc wet deposition') + call addfld (trim(wetdep_list(m))//'SBS', (/ 'lev' /), 'A','kg/kg/s', & + trim(wetdep_list(m))//' bs wet deposition') + enddo + + if (nwetdep>0) then + if (sslt_active) then + dummy = 'SSTSFWET' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt wet deposition flux at surface') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + endif + if (dust_active) then + dummy = 'DSTSFWET' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust wet deposition flux at surface') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + endif + endif + + if (dust_active) then + ! emissions diagnostics .... + + do m = 1, dust_nbin + dummy = trim(dust_names(m)) // 'SF' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(dust_names(m))//' dust surface emission') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + enddo + + dummy = 'DSTSFMBL' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + dummy = 'LND_MBL' + call addfld (dummy,horiz_only, 'A','frac','Soil erodibility factor') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + endif + + if (sslt_active) then + + dummy = 'SSTSFMBL' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + do m = 1, seasalt_nbin + dummy = trim(seasalt_names(m)) // 'SF' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(seasalt_names(m))//' seasalt surface emission') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + enddo + + endif + + if( has_sox ) then + call addfld( 'XPH_LWC',(/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc') + + if ( history_aerosol ) then + call add_default ('XPH_LWC', 1, ' ') + endif + endif + + so4_ndx = get_spc_ndx( 'SO4' ) + soa_ndx = get_spc_ndx( 'SOA' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soam_ndx = get_spc_ndx( 'SOAM' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + nit_ndx = get_spc_ndx( 'NH4NO3' ) + + end subroutine aero_model_init + + !============================================================================= + !============================================================================= + subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) + + use dust_sediment_mod, only: dust_sediment_tend + use drydep_mod, only: d3ddflux, calcram + use dust_model, only: dust_depvel, dust_nbin, dust_names + use seasalt_model, only: sslt_depvel=>seasalt_depvel, sslt_nbin=>seasalt_nbin, sslt_names=>seasalt_names + + ! args + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: obklen(:) + real(r8), intent(in) :: ustar(:) ! sfc fric vel + type(cam_in_t), target, intent(in) :: cam_in ! import state + real(r8), intent(in) :: dt ! time step + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + real(r8), pointer :: landfrac(:) ! land fraction + real(r8), pointer :: icefrac(:) ! ice fraction + real(r8), pointer :: ocnfrac(:) ! ocean fraction + real(r8), pointer :: fvin(:) ! + real(r8), pointer :: ram1in(:) ! for dry dep velocities from land model for progseasalts + + real(r8) :: fv(pcols) ! for dry dep velocities, from land modified over ocean & ice + real(r8) :: ram1(pcols) ! for dry dep velocities, from land modified over ocean & ice + + ! local decarations + + integer, parameter :: naero = sslt_nbin+dust_nbin + integer, parameter :: begslt = 1 + integer, parameter :: endslt = sslt_nbin + integer, parameter :: begdst = sslt_nbin+1 + integer, parameter :: enddst = sslt_nbin+dust_nbin + + integer :: ncol, lchnk + + character(len=6) :: aeronames(naero) ! = (/ sslt_names, dust_names /) + + real(r8) :: vlc_trb(pcols,naero) !Turbulent deposn velocity (m/s) + real(r8) :: vlc_grv(pcols,pver,naero) !grav deposn velocity (m/s) + real(r8) :: vlc_dry(pcols,pver,naero) !dry deposn velocity (m/s) + + real(r8) :: dep_trb(pcols) !kg/m2/s + real(r8) :: dep_grv(pcols) !kg/m2/s (total of grav and trb) + + real(r8) :: tsflx_dst(pcols) + real(r8) :: tsflx_slt(pcols) + real(r8) :: pvaeros(pcols,pverp) ! sedimentation velocity in Pa + real(r8) :: sflx(pcols) + + real(r8) :: tvs(pcols,pver) + real(r8) :: rho(pcols,pver) ! air density in kg/m3 + + integer :: m,mm, i, im + + if (ndrydep<1) return + + landfrac => cam_in%landfrac(:) + icefrac => cam_in%icefrac(:) + ocnfrac => cam_in%ocnfrac(:) + fvin => cam_in%fv(:) + ram1in => cam_in%ram1(:) + + lchnk = state%lchnk + ncol = state%ncol + + ! calc ram and fv over ocean and sea ice ... + call calcram( ncol,landfrac,icefrac,ocnfrac,obklen,& + ustar,ram1in,ram1,state%t(:,pver),state%pmid(:,pver),& + state%pdel(:,pver),fvin,fv) + + call outfld( 'airFV', fv(:), pcols, lchnk ) + call outfld( 'RAM1', ram1(:), pcols, lchnk ) + + ! note that tendencies are not only in sfc layer (because of sedimentation) + ! and that ptend is updated within each subroutine for different species + + call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq) + + aeronames(:sslt_nbin) = sslt_names(:) + aeronames(sslt_nbin+1:) = dust_names(:) + + lchnk = state%lchnk + ncol = state%ncol + + tvs(:ncol,:) = state%t(:ncol,:) + rho(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + + ! compute dep velocities for sea salt and dust... + if (sslt_active) then + call sslt_depvel( state%t(:,:), state%pmid(:,:), state%q(:,:,1), ram1, fv, ncol, lchnk, & + vlc_dry(:,:,begslt:endslt), vlc_trb(:,begslt:endslt), vlc_grv(:,:,begslt:endslt)) + endif + if (dust_active) then + call dust_depvel( state%t(:,:), state%pmid(:,:), ram1, fv, ncol, & + vlc_dry(:,:,begdst:enddst), vlc_trb(:,begdst:enddst), vlc_grv(:,:,begdst:enddst) ) + endif + + tsflx_dst(:)=0._r8 + tsflx_slt(:)=0._r8 + + ! do drydep for each of the bins of dust and seasalt + do m=1,ndrydep + + mm = drydep_indices(m) + findindex: do im = 1,naero + if (trim(cnst_name(mm))==trim(aeronames(im))) exit findindex + enddo findindex + + pvaeros(:ncol,1)=0._r8 + pvaeros(:ncol,2:pverp) = vlc_dry(:ncol,:,im) + + call outfld( trim(cnst_name(mm))//'DV', pvaeros(:,2:pverp), pcols, lchnk ) + + if(.true.) then ! use phil's method + ! convert from meters/sec to pascals/sec + ! pvaeros(:,1) is assumed zero, use density from layer above in conversion + pvaeros(:ncol,2:pverp) = pvaeros(:ncol,2:pverp) * rho(:ncol,:)*gravit + + ! calculate the tendencies and sfc fluxes from the above velocities + call dust_sediment_tend( & + ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & + state%q(:,:,mm) , pvaeros , ptend%q(:,:,mm), sflx ) + else !use charlie's method + call d3ddflux(ncol, vlc_dry(:,:,im), state%q(:,:,mm),state%pmid,state%pdel, tvs,sflx,ptend%q(:,:,mm),dt) + endif + ! apportion dry deposition into turb and gravitational settling for tapes + do i=1,ncol + dep_trb(i)=sflx(i)*vlc_trb(i,im)/vlc_dry(i,pver,im) + dep_grv(i)=sflx(i)*vlc_grv(i,pver,im)/vlc_dry(i,pver,im) + enddo + + if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & + tsflx_slt(:ncol)=tsflx_slt(:ncol)+sflx(:ncol) + if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & + tsflx_dst(:ncol)=tsflx_dst(:ncol)+sflx(:ncol) + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not. aerodep_flx_prescribed()) then + ! set deposition in export state + if (im==begdst) then + cam_out%dstdry1(:ncol) = max(sflx(:ncol), 0._r8) + elseif(im==begdst+1) then + cam_out%dstdry2(:ncol) = max(sflx(:ncol), 0._r8) + elseif(im==begdst+2) then + cam_out%dstdry3(:ncol) = max(sflx(:ncol), 0._r8) + elseif(im==begdst+3) then + cam_out%dstdry4(:ncol) = max(sflx(:ncol), 0._r8) + endif + endif + + call outfld( trim(cnst_name(mm))//'DD', sflx, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'TB', dep_trb, pcols, lchnk ) + call outfld( trim(cnst_name(mm))//'GV', dep_grv, pcols, lchnk ) + call outfld( trim(cnst_name(mm))//'DT', ptend%q(:,:,mm), pcols, lchnk) + + end do + + ! output the total dry deposition + if (sslt_active) then + call outfld( 'SSTSFDRY', tsflx_slt, pcols, lchnk) + endif + if (dust_active) then + call outfld( 'DSTSFDRY', tsflx_dst, pcols, lchnk) + endif + + endsubroutine aero_model_drydep + + !============================================================================= + !============================================================================= + subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) + + use wetdep, only : wetdepa_v1, wetdep_inputs_set, wetdep_inputs_t + use dust_model, only : dust_names + use seasalt_model, only : sslt_names=>seasalt_names + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s] + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + + integer :: ncol ! number of atmospheric columns + integer :: lchnk ! chunk identifier + integer :: m,mm, i,k + + real(r8) :: sflx_tot_dst(pcols) + real(r8) :: sflx_tot_slt(pcols) + + real(r8) :: iscavt(pcols, pver) + real(r8) :: scavt(pcols, pver) + real(r8) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1) + real(r8) :: sflx(pcols) ! deposition flux + + real(r8) :: icscavt(pcols, pver) + real(r8) :: isscavt(pcols, pver) + real(r8) :: bcscavt(pcols, pver) + real(r8) :: bsscavt(pcols, pver) + + real(r8) :: sol_factb, sol_facti + + real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume + real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing scavenging + real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area at the top interface of current layer + real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer + + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + + type(wetdep_inputs_t) :: dep_inputs ! obj that contains inputs to wetdepa routine + + if (nwetdep<1) return + + call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + + call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) + + call wetdep_inputs_set( state, pbuf, dep_inputs ) + + lchnk = state%lchnk + ncol = state%ncol + + sflx_tot_dst(:) = 0._r8 + sflx_tot_slt(:) = 0._r8 + + do m = 1, nwetdep + + mm = wetdep_indices(m) + + sol_factb = aer_sol_factb(m) + sol_facti = aer_sol_facti(m) + + scavcoef(:ncol,:) = aer_scav_coef(m) + + call wetdepa_v1( state%t, state%pmid, state%q(:,:,1), state%pdel, & + dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + dep_inputs%evapr, dep_inputs%totcond, state%q(:,:,mm), dt, & + scavt, iscavt, dep_inputs%cldv, & + fracis(:,:,mm), sol_factb, ncol, & + scavcoef, & + sol_facti_in=sol_facti, & + icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt ) + + ptend%q(:ncol,:,mm)=scavt(:ncol,:) + + call outfld( trim(cnst_name(mm))//'WET', ptend%q(:,:,mm), pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SIC', icscavt , pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) + + sflx(:)=0._r8 + + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+ptend%q(i,k,mm)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) + + if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & + sflx_tot_slt(:ncol) = sflx_tot_slt(:ncol) + sflx(:ncol) + if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & + sflx_tot_dst(:ncol) = sflx_tot_dst(:ncol) + sflx(:ncol) + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not.aerodep_flx_prescribed()) then + ! export deposition fluxes to coupler ??? why "-" sign ??? + if (trim(cnst_name(mm))=='CB2') then + cam_out%bcphiwet(:) = max(-sflx(:), 0._r8) + elseif (trim(cnst_name(mm))=='OC2') then + cam_out%ocphiwet(:) = max(-sflx(:), 0._r8) + elseif (trim(cnst_name(mm))==trim(dust_names(1))) then + cam_out%dstwet1(:) = max(-sflx(:), 0._r8) + elseif (trim(cnst_name(mm))==trim(dust_names(2))) then + cam_out%dstwet2(:) = max(-sflx(:), 0._r8) + elseif (trim(cnst_name(mm))==trim(dust_names(3))) then + cam_out%dstwet3(:) = max(-sflx(:), 0._r8) + elseif (trim(cnst_name(mm))==trim(dust_names(4))) then + cam_out%dstwet4(:) = max(-sflx(:), 0._r8) + endif + endif + + enddo + + if (sslt_active) then + call outfld( 'SSTSFWET', sflx_tot_slt, pcols, lchnk) + endif + if (dust_active) then + call outfld( 'DSTSFWET', sflx_tot_dst, pcols, lchnk) + endif + + endsubroutine aero_model_wetdep + + !------------------------------------------------------------------------- + ! provides aerosol surface area info for sectional aerosols + ! called from mo_usrrxt + !------------------------------------------------------------------------- + subroutine aero_model_surfarea( & + mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, m, ltrop, & + dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_total, reff_trop ) + + use mo_constants, only : pi, avo => avogadro + + ! dummy args + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: radmean ! mean radii in cm + real(r8), intent(in) :: strato_sad(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: ltrop(:) + real(r8), intent(in) :: dlat(:) ! degrees latitude + integer, intent(in) :: het1_ndx + real(r8), intent(in) :: relhum(:,:) + real(r8), intent(in) :: m(:,:) ! total atm density (/cm^3) + real(r8), intent(in) :: sulfate(:,:) + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(inout) :: sfc(:,:,:) + real(r8), intent(inout) :: dm_aer(:,:,:) + real(r8), intent(inout) :: sad_total(:,:) + real(r8), intent(out) :: reff_trop(:,:) + + ! local vars + + integer :: i,k + real(r8) :: rho_air + real(r8) :: v, n, n_exp, r_rd, r_sd + real(r8) :: dm_sulf, dm_sulf_wet, log_sd_sulf, sfc_sulf, sfc_nit + real(r8) :: dm_orgc, dm_orgc_wet, log_sd_orgc, sfc_oc, sfc_soa + real(r8) :: sfc_soai, sfc_soam, sfc_soab, sfc_soat, sfc_soax + real(r8) :: dm_bc, dm_bc_wet, log_sd_bc, sfc_bc + real(r8) :: rxt_sulf, rxt_nit, rxt_oc, rxt_soa + real(r8) :: c_n2o5, c_ho2, c_no2, c_no3 + real(r8) :: s_exp + + !----------------------------------------------------------------- + ! ... parameters for log-normal distribution by number + ! references: + ! Chin et al., JAS, 59, 461, 2003 + ! Liao et al., JGR, 108(D1), 4001, 2003 + ! Martin et al., JGR, 108(D3), 4097, 2003 + !----------------------------------------------------------------- + real(r8), parameter :: rm_sulf = 6.95e-6_r8 ! mean radius of sulfate particles (cm) (Chin) + real(r8), parameter :: sd_sulf = 2.03_r8 ! standard deviation of radius for sulfate (Chin) + real(r8), parameter :: rho_sulf = 1.7e3_r8 ! density of sulfate aerosols (kg/m3) (Chin) + + real(r8), parameter :: rm_orgc = 2.12e-6_r8 ! mean radius of organic carbon particles (cm) (Chin) + real(r8), parameter :: sd_orgc = 2.20_r8 ! standard deviation of radius for OC (Chin) + real(r8), parameter :: rho_orgc = 1.8e3_r8 ! density of OC aerosols (kg/m3) (Chin) + + real(r8), parameter :: rm_bc = 1.18e-6_r8 ! mean radius of soot/BC particles (cm) (Chin) + real(r8), parameter :: sd_bc = 2.00_r8 ! standard deviation of radius for BC (Chin) + real(r8), parameter :: rho_bc = 1.0e3_r8 ! density of BC aerosols (kg/m3) (Chin) + + real(r8), parameter :: mw_so4 = 98.e-3_r8 ! so4 molecular wt (kg/mole) + + integer :: irh, rh_l, rh_u + real(r8) :: factor, rfac_sulf, rfac_oc, rfac_bc, rfac_ss + logical :: zero_aerosols + + !----------------------------------------------------------------- + ! ... table for hygroscopic growth effect on radius (Chin et al) + ! (no growth effect for mineral dust) + !----------------------------------------------------------------- + real(r8), dimension(7) :: table_rh, table_rfac_sulf, table_rfac_bc, table_rfac_oc, table_rfac_ss + + data table_rh(1:7) / 0.0_r8, 0.5_r8, 0.7_r8, 0.8_r8, 0.9_r8, 0.95_r8, 0.99_r8/ + data table_rfac_sulf(1:7) / 1.0_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 1.9_r8, 2.2_r8/ + data table_rfac_oc(1:7) / 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 2.2_r8/ + data table_rfac_bc(1:7) / 1.0_r8, 1.0_r8, 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.9_r8/ + data table_rfac_ss(1:7) / 1.0_r8, 1.6_r8, 1.8_r8, 2.0_r8, 2.4_r8, 2.9_r8, 4.8_r8/ + + !----------------------------------------------------------------- + ! ... exponent for calculating number density + !----------------------------------------------------------------- + n_exp = exp( -4.5_r8*log(sd_sulf)*log(sd_sulf) ) + + dm_sulf = 2._r8 * rm_sulf + dm_orgc = 2._r8 * rm_orgc + dm_bc = 2._r8 * rm_bc + + log_sd_sulf = log(sd_sulf) + log_sd_orgc = log(sd_orgc) + log_sd_bc = log(sd_bc) + + reff_trop(:,:) = 0._r8 + + ver_loop: do k = 1,pver + col_loop: do i = 1,ncol + !------------------------------------------------------------------------- + ! ... air density (kg/m3) + !------------------------------------------------------------------------- + rho_air = pmid(i,k)/(temp(i,k)*287.04_r8) + !------------------------------------------------------------------------- + ! ... aerosol growth interpolated from M.Chin's table + !------------------------------------------------------------------------- + if (relhum(i,k) >= table_rh(7)) then + rfac_sulf = table_rfac_sulf(7) + rfac_oc = table_rfac_oc(7) + rfac_bc = table_rfac_bc(7) + else + do irh = 2,7 + if (relhum(i,k) <= table_rh(irh)) then + exit + end if + end do + rh_l = irh-1 + rh_u = irh + + factor = (relhum(i,k) - table_rh(rh_l))/(table_rh(rh_u) - table_rh(rh_l)) + + rfac_sulf = table_rfac_sulf(rh_l) + factor*(table_rfac_sulf(rh_u) - table_rfac_sulf(rh_l)) + rfac_oc = table_rfac_oc(rh_u) + factor*(table_rfac_oc(rh_u) - table_rfac_oc(rh_l)) + rfac_bc = table_rfac_bc(rh_u) + factor*(table_rfac_bc(rh_u) - table_rfac_bc(rh_l)) + end if + + dm_sulf_wet = dm_sulf * rfac_sulf + dm_orgc_wet = dm_orgc * rfac_oc + dm_bc_wet = dm_bc * rfac_bc + + dm_bc_wet = min(dm_bc_wet ,50.e-6_r8) ! maximum size is 0.5 micron (Chin) + dm_orgc_wet = min(dm_orgc_wet,50.e-6_r8) ! maximum size is 0.5 micron (Chin) + + + !------------------------------------------------------------------------- + ! ... sulfate aerosols + !------------------------------------------------------------------------- + zero_aerosols = k < ltrop(i) + if ( abs( dlat(i) ) > 50._r8 ) then + zero_aerosols = pmid(i,k) < 30000._r8 + endif + !------------------------------------------------------------------------- + ! ... use ubvals climatology for stratospheric sulfate surface area density + !------------------------------------------------------------------------- + if( zero_aerosols ) then + sfc_sulf = strato_sad(i,k) + if ( het1_ndx > 0 ) then + sfc_sulf = 0._r8 ! reaction already taken into account in mo_strato_rates.F90 + end if + sfc_nit = 0._r8 + sfc_soa = 0._r8 + sfc_oc = 0._r8 + sfc_bc = 0._r8 + else + + if( so4_ndx > 0 ) then + !------------------------------------------------------------------------- + ! convert mass mixing ratio of aerosol to cm3/cm3 (cm^3_aerosol/cm^3_air) + ! v=volume density (m^3/m^3) + ! rho_aer=density of aerosol (kg/m^3) + ! v=m*rho_air/rho_aer [kg/kg * (kg/m3)_air/(kg/m3)_aer] + !------------------------------------------------------------------------- + v = mmr(i,k,so4_ndx) * rho_air/rho_sulf + !------------------------------------------------------------------------- + ! calculate the number density of aerosol (aerosols/cm3) + ! assuming a lognormal distribution + ! n = (aerosols/cm3) + ! dm = geometric mean diameter + ! + ! because only the dry mass of the aerosols is known, we + ! use the mean dry radius + !------------------------------------------------------------------------- + n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + !------------------------------------------------------------------------- + ! find surface area of aerosols using dm_wet, log_sd + ! (increase of sd due to RH is negligible) + ! and number density calculated above as distribution + ! parameters + ! sfc = surface area of wet aerosols (cm^2/cm^3) + !------------------------------------------------------------------------- + s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp + + else + !------------------------------------------------------------------------- + ! if so4 not simulated, use off-line sulfate and calculate as above + ! convert sulfate vmr to volume density of aerosol (cm^3_aerosol/cm^3_air) + !------------------------------------------------------------------------- + v = sulfate(i,k) * m(i,k) * mw_so4 / (avo * rho_sulf) *1.e6_r8 + n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp + + end if + + !------------------------------------------------------------------------- + ! ammonium nitrate (follow same procedure as sulfate, using size and density of sulfate) + !------------------------------------------------------------------------- + if( nit_ndx > 0 ) then + v = mmr(i,k,nit_ndx) * rho_air/rho_sulf + n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + sfc_nit = n * pi * (dm_sulf_wet**2._r8) * s_exp + else + sfc_nit = 0._r8 + end if + + !------------------------------------------------------------------------- + ! hydrophylic organic carbon (follow same procedure as sulfate) + !------------------------------------------------------------------------- + if( oc2_ndx > 0 ) then + v = mmr(i,k,oc2_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_oc = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_oc = 0._r8 + end if + + !------------------------------------------------------------------------- + ! secondary organic carbon (follow same procedure as sulfate) + !------------------------------------------------------------------------- + if( soa_ndx > 0 ) then + v = mmr(i,k,soa_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soa = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soa = 0._r8 + end if + + !------------------------------------------------------------------------- + ! black carbon (follow same procedure as sulfate) + !------------------------------------------------------------------------- + if( cb2_ndx > 0 ) then + v = mmr(i,k,cb2_ndx) * rho_air/rho_bc + n = v * (6._r8/pi)*(1._r8/(dm_bc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_bc*log_sd_bc) + sfc_bc = n * pi * (dm_bc_wet**2._r8) * s_exp + else + sfc_bc = 0._r8 + end if + if( soai_ndx > 0 ) then + v = mmr(i,k,soai_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soai = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soai = 0._r8 + end if + if( soam_ndx > 0 ) then + v = mmr(i,k,soam_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soam = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soam = 0._r8 + end if + if( soab_ndx > 0 ) then + v = mmr(i,k,soab_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soab = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soab = 0._r8 + end if + if( soat_ndx > 0 ) then + v = mmr(i,k,soat_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soat = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soat = 0._r8 + end if + if( soax_ndx > 0 ) then + v = mmr(i,k,soax_ndx) * rho_air/rho_orgc + n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + sfc_soax = n * pi * (dm_orgc_wet**2._r8) * s_exp + else + sfc_soax = 0._r8 + end if + sfc_soa = sfc_soa + sfc_soai + sfc_soam + sfc_soab + sfc_soat + sfc_soax + + end if + + sfc(i,k,:) = (/ sfc_sulf, sfc_nit, sfc_oc, sfc_soa, sfc_bc /) + dm_aer(i,k,:) = (/ dm_sulf_wet,dm_sulf_wet,dm_orgc_wet,dm_orgc_wet,dm_bc_wet /) + + !------------------------------------------------------------------------- + ! ... add up total surface area density for output + !------------------------------------------------------------------------- + sad_total(i,k) = sfc_sulf + sfc_nit + sfc_oc + sfc_soa + sfc_bc + + enddo col_loop + enddo ver_loop + + end subroutine aero_model_surfarea + + !------------------------------------------------------------------------- + ! stub + !------------------------------------------------------------------------- + subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + + ! dummy args + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + integer, intent(in) :: ltrop(:) ! tropopause level indices + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: strato_sad(:,:) + real(r8), intent(out) :: reff_strat(:,:) + + strato_sad(:,:) = 0._r8 + reff_strat(:,:) = 0._r8 + + end subroutine aero_model_strat_surfarea + + !============================================================================= + !============================================================================= + subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_rates, & + tfld, pmid, pdel, mbar, relhum, & + zm, qh2o, cwat, cldfr, cldnum, & + airdens, invariants, del_h2so4_gasprod, & + vmr0, vmr, pbuf ) + + use chem_mods, only : gas_pcnst + use mo_aerosols, only : aerosols_formation, has_aerosols + use mo_setsox, only : setsox, has_sox + use mo_setsoa, only : setsoa, has_soa + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: loffset ! offset applied to modal aero "pointers" + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: troplev(:) + real(r8), intent(in) :: delt ! time step size (sec) + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: pmid(:,:) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: relhum(:,:) ! relative humidity + real(r8), intent(in) :: airdens(:,:) ! total atms density (molec/cm**3) + real(r8), intent(in) :: invariants(:,:,:) + real(r8), intent(in) :: del_h2so4_gasprod(:,:) + real(r8), intent(in) :: zm(:,:) + real(r8), intent(in) :: qh2o(:,:) + real(r8), intent(in) :: cwat(:,:) ! cloud liquid water content (kg/kg) + real(r8), intent(in) :: cldfr(:,:) + real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: vmr0(:,:,:) ! initial mixing ratios (before gas-phase chem changes) + real(r8), intent(inout) :: vmr(:,:,:) ! mixing ratios ( vmr ) + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + + real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) + + real(r8) :: aqso4(ncol,1) ! aqueous phase chemistry + real(r8) :: aqh2so4(ncol,1) ! aqueous phase chemistry + real(r8) :: aqso4_h2o2(ncol) ! SO4 aqueous phase chemistry due to H2O2 + real(r8) :: aqso4_o3(ncol) ! SO4 aqueous phase chemistry due to O3 + real(r8) :: xphlwc(ncol,pver) ! pH value multiplied by lwc + + + ! aqueous chemistry ... + + if( has_sox ) then + call setsox( & + ncol, & + lchnk, & + loffset, & + delt, & + pmid, & + pdel, & + tfld, & + mbar, & + cwat, & + cldfr, & + cldnum, & + airdens, & + invariants, & + vmrcw, & + vmr, & + xphlwc, & + aqso4, & + aqh2so4, & + aqso4_h2o2,& + aqso4_o3 & + ) + call outfld( 'XPH_LWC',xphlwc(:ncol,:), ncol , lchnk ) + endif + + if( has_soa ) then + call setsoa( ncol, lchnk, delt, reaction_rates, tfld, airdens, vmr, pbuf) + endif + + if( has_aerosols ) then + call aerosols_formation( ncol, lchnk, tfld, relhum, vmr ) + endif + + + end subroutine aero_model_gasaerexch + + !============================================================================= + !============================================================================= + subroutine aero_model_emissions( state, cam_in ) + use seasalt_model, only: seasalt_emis, seasalt_indices + use dust_model, only: dust_emis, dust_indices + use physics_types, only: physics_state + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + ! local vars + + integer :: lchnk, ncol + integer :: m, mm + real(r8) :: soil_erod_tmp(pcols) + real(r8) :: sflx(pcols) ! accumulate over all bins for output + real(r8) :: u10cubed(pcols) + real (r8), parameter :: z0=0.0001_r8 ! m roughness length over oceans--from ocean model + + lchnk = state%lchnk + ncol = state%ncol + + if (dust_active) then + + call dust_emis( ncol, lchnk, cam_in%dstflx, cam_in%cflx, soil_erod_tmp ) + + ! some dust emis diagnostics ... + sflx(:)=0._r8 + do m=1,dust_nbin + mm = dust_indices(m) + sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + call outfld(trim(dust_names(m))//'SF',cam_in%cflx(:,mm),pcols, lchnk) + enddo + call outfld('DSTSFMBL',sflx(:),pcols,lchnk) + call outfld('LND_MBL',soil_erod_tmp(:),pcols, lchnk ) + endif + + if (sslt_active) then + u10cubed(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2) + ! move the winds to 10m high from the midpoint of the gridbox: + ! follows Tie and Seinfeld and Pandis, p.859 with math. + + u10cubed(:ncol)=u10cubed(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0) + + ! we need them to the 3.41 power, according to Gong et al., 1997: + u10cubed(:ncol)=u10cubed(:ncol)**3.41_r8 + + sflx(:)=0._r8 + + call seasalt_emis( u10cubed, cam_in%sst, cam_in%ocnfrac, ncol, cam_in%cflx ) + + do m=1,seasalt_nbin + mm = seasalt_indices(m) + sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + call outfld(trim(seasalt_names(m))//'SF',cam_in%cflx(:,mm),pcols,lchnk) + enddo + call outfld('SSTSFMBL',sflx(:),pcols,lchnk) + endif + + end subroutine aero_model_emissions + +end module aero_model diff --git a/src/chemistry/bulk_aero/aerosol_depvel.F90 b/src/chemistry/bulk_aero/aerosol_depvel.F90 new file mode 100644 index 0000000000..32d53f0549 --- /dev/null +++ b/src/chemistry/bulk_aero/aerosol_depvel.F90 @@ -0,0 +1,113 @@ +!-------------------------------------------------------------------------------- +! used for dust and seasalt +!-------------------------------------------------------------------------------- +module aerosol_depvel + +contains + +!-------------------------------------------------------------------------------- +! settling velocity +!-------------------------------------------------------------------------------- +subroutine aerosol_depvel_compute( ncol, nlev, naero, t, pmid, ram1, fv, diam, stk_crc, dns_aer, & + vlc_dry, vlc_trb, vlc_grv ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi, gravit, rair, boltz + + ! !ARGUMENTS: + ! + implicit none + ! + integer, intent(in) :: ncol,nlev + integer, intent(in) :: naero + real(r8), intent(in) :: t(:,:) !atm temperature (K) + real(r8), intent(in) :: pmid(:,:) !atm pressure (Pa) + real(r8), intent(in) :: fv(:) !friction velocity (m/s) + real(r8), intent(in) :: ram1(:) !aerodynamical resistance (s/m) + real(r8), intent(in) :: diam(:,:,:) + real(r8), intent(in) :: stk_crc(:) + real(r8), intent(in) :: dns_aer + + real(r8), intent(out) :: vlc_trb(:,:) !Turbulent deposn velocity (m/s) + real(r8), intent(out) :: vlc_grv(:,:,:) !grav deposn velocity (m/s) + real(r8), intent(out) :: vlc_dry(:,:,:) !dry deposn velocity (m/s) + + !------------------------------------------------------------------------ + ! Local Variables + integer :: m,i,k !indices + real(r8) :: vsc_dyn_atm(ncol,nlev) ![kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm(ncol,nlev) ![m2 s-1] Kinematic viscosity of atmosphere + real(r8) :: shm_nbr_xpn ![frc] Sfc-dep exponent for aerosol-diffusion dependence on Schmidt number + real(r8) :: shm_nbr ![frc] Schmidt number + real(r8) :: stk_nbr ![frc] Stokes number + real(r8) :: mfp_atm(ncol,nlev) ![m] Mean free path of air + real(r8) :: dff_aer ![m2 s-1] Brownian diffusivity of particle + real(r8) :: rss_trb ![s m-1] Resistance to turbulent deposition + real(r8) :: slp_crc(ncol,nlev,naero) ![frc] Slip correction factor + real(r8) :: rss_lmn(naero) ![s m-1] Quasi-laminar layer resistance + real(r8) :: tmp !temporary + + ! constants + real(r8),parameter::shm_nbr_xpn_lnd=-2._r8/3._r8 ![frc] shm_nbr_xpn over land + real(r8),parameter::shm_nbr_xpn_ocn=-1._r8/2._r8 ![frc] shm_nbr_xpn over ccean + + real(r8) :: rho !atm density (kg/m**3) + + ! needs fv and ram1 passed in from lnd model + + !------------------------------------------------------------------------ + + do k=1,nlev + do i=1,ncol + rho = pmid(i,k)/rair/t(i,k) + ! from subroutine dst_dps_dry (consider adding sanity checks from line 212) + ! when code asks to use midlayer density, pressure, temperature, + ! I use the data coming in from the atmosphere, ie t(i,k), pmid(i,k) + + ! Quasi-laminar layer resistance: call rss_lmn_get + ! Size-independent thermokinetic properties + vsc_dyn_atm(i,k) = 1.72e-5_r8 * ((t(i,k)/273.0_r8)**1.5_r8) * 393.0_r8 / & + (t(i,k)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102 + mfp_atm(i,k) = 2.0_r8 * vsc_dyn_atm(i,k) / & ![m] SeP97 p. 455 + (pmid(i,k)*sqrt(8.0_r8/(pi*rair*t(i,k)))) + vsc_knm_atm(i,k) = vsc_dyn_atm(i,k) / rho ![m2 s-1] Kinematic viscosity of air + + do m = 1, naero + slp_crc(i,k,m) = 1.0_r8 + 2.0_r8 * mfp_atm(i,k) * & + (1.257_r8+0.4_r8*exp(-1.1_r8*diam(i,k,m)/(2.0_r8*mfp_atm(i,k)))) / & + diam(i,k,m) ![frc] Slip correction factor SeP97 p. 464 + vlc_grv(i,k,m) = (1.0_r8/18.0_r8) * diam(i,k,m) * diam(i,k,m) * dns_aer * & + gravit * slp_crc(i,k,m) / vsc_dyn_atm(i,k) ![m s-1] Stokes' settling velocity SeP97 p. 466 + vlc_grv(i,k,m) = vlc_grv(i,k,m) * stk_crc(m) ![m s-1] Correction to Stokes settling velocity + vlc_dry(i,k,m)=vlc_grv(i,k,m) + end do + + enddo + enddo + k=nlev ! only look at bottom level for next part + do m = 1, naero + do i=1,ncol + stk_nbr = vlc_grv(i,k,m) * fv(i) * fv(i) / (gravit*vsc_knm_atm(i,k)) ![frc] SeP97 p.965 + dff_aer = boltz * t(i,k) * slp_crc(i,k,m) / & ![m2 s-1] + (3.0_r8*pi*vsc_dyn_atm(i,k)*diam(i,k,m)) !SeP97 p.474 + shm_nbr = vsc_knm_atm(i,k) / dff_aer ![frc] SeP97 p.972 + shm_nbr_xpn = shm_nbr_xpn_lnd ![frc] + ! if(ocnfrac.gt.0.5) shm_nbr_xpn=shm_nbr_xpn_ocn + ! fxm: Turning this on dramatically reduces + ! deposition velocity in low wind regimes + ! Schmidt number exponent is -2/3 over solid surfaces and + ! -1/2 over liquid surfaces SlS80 p. 1014 + ! if (oro(i)==0.0) shm_nbr_xpn=shm_nbr_xpn_ocn else shm_nbr_xpn=shm_nbr_xpn_lnd + ! [frc] Surface-dependent exponent for aerosol-diffusion dependence on Schmidt # + tmp = shm_nbr**shm_nbr_xpn + 10.0_r8**(-3.0_r8/stk_nbr) + rss_lmn(m) = 1.0_r8 / (tmp*fv(i)) ![s m-1] SeP97 p.972,965 + + rss_trb = ram1(i) + rss_lmn(m) + ram1(i)*rss_lmn(m)*vlc_grv(i,k,m) ![s m-1] + vlc_trb(i,m) = 1.0_r8 / rss_trb ![m s-1] + vlc_dry(i,k,m) = vlc_trb(i,m) +vlc_grv(i,k,m) + end do !ncol + end do + +end subroutine aerosol_depvel_compute + +end module aerosol_depvel diff --git a/src/chemistry/bulk_aero/dust_model.F90 b/src/chemistry/bulk_aero/dust_model.F90 new file mode 100644 index 0000000000..1a0ff4c5aa --- /dev/null +++ b/src/chemistry/bulk_aero/dust_model.F90 @@ -0,0 +1,167 @@ +!=============================================================================== +! Dust for Bulk Aerosol Model +!=============================================================================== +module dust_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + + implicit none + private + + public :: dust_active + public :: dust_names + public :: dust_nbin + public :: dust_indices + public :: dust_emis + public :: dust_readnl + public :: dust_init + + public :: dust_depvel + + logical :: dust_active = .false. + + integer, parameter :: dust_nbin = 4 + integer, parameter :: dust_nnum = 0 + + character(len=6), parameter :: dust_names(dust_nbin) & + = (/'DST01 ', 'DST02 ', 'DST03 ', 'DST04 '/) + + real(r8), parameter :: dust_dmt_grd(dust_nbin+1) & + = (/ 0.1e-6_r8, 1.0e-6_r8, 2.5e-6_r8, 5.0e-6_r8, 10.0e-6_r8 /) + + integer :: dust_indices(dust_nbin) + real(r8) :: dust_dmt_vwr(dust_nbin) + real(r8) :: dust_stk_crc(dust_nbin) + + real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset +contains + + !============================================================================= + ! reads dust namelist options + !============================================================================= + subroutine dust_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'dust_readnl' + + namelist /dust_nl/ dust_emis_fact, soil_erod_file + + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'dust_nl', status=ierr) + if (ierr == 0) then + read(unitn, dust_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) + call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) +#endif + + end subroutine dust_readnl + + !============================================================================= + !============================================================================= + subroutine dust_init() + use soil_erod_mod, only: soil_erod_init + use constituents, only: cnst_get_ind + use dust_common, only: dust_set_params + + integer :: n + + do n = 1, dust_nbin + call cnst_get_ind(dust_names(n), dust_indices(n),abort=.false.) + end do + dust_active = any(dust_indices(:) > 0) + if (.not.dust_active) return + + call soil_erod_init( dust_emis_fact, soil_erod_file ) + + call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) + + end subroutine dust_init + + !============================================================================== + !============================================================================== + subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) + use soil_erod_mod, only : soil_erod_fact + use soil_erod_mod, only : soil_erodibility + + ! args + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: dust_flux_in(:,:) + real(r8), intent(inout) :: cflx(:,:) + real(r8), intent(out) :: soil_erod(:) + + ! local vars + integer :: i, m, idst + real(r8), parameter :: dust_emis_sclfctr(dust_nbin) & + = (/ 0.011_r8/0.032456_r8, 0.087_r8/0.174216_r8, 0.277_r8/0.4085517_r8, 0.625_r8/0.384811_r8 /) + + ! set dust emissions + + col_loop: do i =1,ncol + + soil_erod(i) = soil_erodibility( i, lchnk ) + + ! adjust emissions based on soil erosion + do m = 1,dust_nbin + + idst = dust_indices(m) + cflx(i,idst) = -dust_flux_in(i,m) & + * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 + + enddo + + end do col_loop + + end subroutine dust_emis + + !=============================================================================== + !=============================================================================== + subroutine dust_depvel( temp, pmid, ram1, fv, ncol, vlc_dry,vlc_trb,vlc_grv ) + use aerosol_depvel, only: aerosol_depvel_compute + use mo_constants, only: dust_density + use ppgrid, only: pver + + real(r8), intent(in) :: temp(:,:) ! temperature + real(r8), intent(in) :: pmid(:,:) ! mid point pressure + real(r8), intent(in) :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), intent(in) :: fv(:) ! friction velocity (m/s) + integer, intent(in) :: ncol + + real(r8), intent(out) :: vlc_trb(:,:) !Turbulent deposn velocity (m/s) + real(r8), intent(out) :: vlc_grv(:,:,:) !grav deposn velocity (m/s) + real(r8), intent(out) :: vlc_dry(:,:,:) !dry deposn velocity (m/s) + + real(r8) :: diam(ncol,pver,dust_nbin) + integer :: m + + do m=1,dust_nbin + diam(:,:,m) = dust_dmt_vwr(m) + enddo + call aerosol_depvel_compute( ncol, pver, dust_nbin, temp, pmid, ram1, fv, diam, dust_stk_crc, dust_density, & + vlc_dry,vlc_trb,vlc_grv) + endsubroutine dust_depvel + +end module dust_model diff --git a/src/chemistry/bulk_aero/mo_aerosols.F90 b/src/chemistry/bulk_aero/mo_aerosols.F90 new file mode 100644 index 0000000000..8747987dc4 --- /dev/null +++ b/src/chemistry/bulk_aero/mo_aerosols.F90 @@ -0,0 +1,270 @@ +module mo_aerosols + !----------------------------------------------------------------- + ! + ! this module computes the production of ammonium nitrate + ! using the formulation by Seinfeld and Pandis (p531, 1998) + ! with the simplification of activity coefficients and + ! aerosol molality using the parameterizations + ! from Metzger et al. (JGR, ACH-16, 107(D16), 2002) + ! + ! written by Jean-Francois Lamarque (April 2004) + ! adapted for CAM (May 2004) + ! + !----------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pver + use cam_logfile, only: iulog + + private + public :: aerosols_inti,aerosols_formation + public :: has_aerosols + + save + + integer, target :: spc_ndx(5) + integer, pointer :: nh3_ndx, nh4no3_ndx, nh4_ndx + integer, pointer :: so4_ndx, hno3_ndx + integer :: xhno3_ndx, xnh4no3_ndx + integer :: nu_i(2) + real(r8) :: zeta_inv + real(r8) :: z_i(2) + logical :: has_aerosols = .true. + +contains + + subroutine aerosols_inti() + + use mo_chem_utls, only : get_spc_ndx + use cam_history, only : addfld + use spmd_utils, only : masterproc + + implicit none + + !----------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------- + integer :: m + + nh3_ndx => spc_ndx(1) + nh4no3_ndx => spc_ndx(2) + so4_ndx => spc_ndx(3) + hno3_ndx => spc_ndx(4) + nh4_ndx => spc_ndx(5) + + !----------------------------------------------------------------- + ! ... set species index + !----------------------------------------------------------------- + nh3_ndx = get_spc_ndx( 'NH3' ) + nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) + so4_ndx = get_spc_ndx( 'SO4' ) + hno3_ndx = get_spc_ndx( 'HNO3' ) + nh4_ndx = get_spc_ndx( 'NH4' ) + xnh4no3_ndx = get_spc_ndx( 'XNH4NO3' ) + xhno3_ndx = get_spc_ndx( 'XHNO3' ) + + has_aerosols = all( spc_ndx(:) > 0 ) + if( .not. has_aerosols ) then + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) 'mozart will NOT do nh4no3' + write(iulog,*) 'following species are missing' + do m = 1,size(spc_ndx) + if( spc_ndx(m) < 1 ) then + write(iulog,*) m + end if + end do + write(iulog,*) '-----------------------------------------' + endif + return + else + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) 'mozart will do nh4no3' + write(iulog,*) '-----------------------------------------' + end if + end if + + ! + ! define parameters + ! + ! ammonium nitrate (NH4NO3) + ! + zeta_inv = 1._r8/4._r8 + nu_i(1) = 4 + z_i (1) = 1._r8 + ! + ! ammonium sulfate + ! + nu_i(2) = 4 + z_i (2) = 0.5_r8 + + call addfld ('TSO4_VMR', (/ 'lev' /), 'A', 'mol/mol','total sulfate in mo_aerosols') + call addfld ('THNO3_VMR',(/ 'lev' /), 'A','mol/mol','total nitric acid in mo_aerosols') + + return + end subroutine aerosols_inti + + subroutine aerosols_formation( ncol, lchnk, tfld, rh, qin) + + use ppgrid, only : pcols, pver + use chem_mods, only : gas_pcnst, adv_mass + use cam_history, only : outfld + + implicit none + ! + ! input arguments + ! + ! + ! input arguments + ! + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: tfld(:,:) ! temperature + real(r8), intent(in) :: rh(:,:) ! relative humidity + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + ! + ! local variables + ! + integer :: i,j,k,n + integer :: domain_number ! concentration domain + real(r8) :: sulfate_state ! fraction of sulfate neutralized by ammonia + real(r8), dimension(ncol,pver) :: tso4, & ! total sulfate + thno3,& ! total nitric acid + txhno3 ! total nitric acid ( XHNO3 ) + real(r8) :: tnh3, & ! total ammonia + fnh3, & ! free ammonia + rhd, & ! relative humidity of deliquescence + gamma, & ! activity coefficient + ssm_nh4no3, & ! single solute molality for NH4NO3 + ta, & ! total ammonia + tn, & ! total nitrate + kp, & ! equilibrium constant + nh4no3 ! ammonium nitrate produced + real(r8) :: log_t + real(r8) :: ti + real(r8) :: xnh4no3 + + do k=1,pver + do i=1,ncol + + ! + ! compute total concentrations + ! + tnh3 = (qin(i,k, nh3_ndx)+qin(i,k,nh4_ndx)) + tso4(i,k) = qin(i,k,so4_ndx) + ! + ! define concentration domain + ! + if ( tnh3 < tso4(i,k) ) then + domain_number = 4 + sulfate_state = 1.0_r8 + elseif ( tnh3 < 2._r8*tso4(i,k) ) then + domain_number = 3 + sulfate_state = 1.5_r8 + else + domain_number = 2 + sulfate_state = 2.0_r8 + endif + ! + ! define free ammonia (ammonia available for ammonium nitrate production) + ! + fnh3 = tnh3 - sulfate_state * tso4(i,k) + fnh3 = max(0._r8,fnh3) + ! + ! convert initial concentrations to ppbv + ! + tso4(i,k) = tso4(i,k) * 1.e9_r8 + tnh3 = tnh3 * 1.e9_r8 + fnh3 = fnh3 * 1.e9_r8 + thno3(i,k) = (qin(i,k,hno3_ndx)+qin(i,k,nh4no3_ndx)) * 1.e9_r8 + if ( xhno3_ndx > 0 .and. xnh4no3_ndx > 0 ) then + txhno3(i,k) = (qin(i,k,xhno3_ndx)+qin(i,k,xnh4no3_ndx)) * 1.e9_r8 + endif + ! + ! compute relative humidity of deliquescence (%) for NH4NO3 + ! (Seinfeld and Pandis, p532) + ! + ti = 1._r8/tfld(i,k) + rhd = 0.01_r8 * exp( 1.6954_r8 + 723.7_r8*ti ) + log_t = log( tfld(i,k)/298._r8 ) + if ( rh(i,k) < rhd ) then + ! + ! crystalline ammonium nitrate + ! + ! compute equilibrium constant + ! + kp = exp( 84.6_r8 - 24220._r8*ti - 6.1_r8*log_t ) + ! + else + ! + ! aqueous phase ammonium nitrate + ! + ! compute activity coefficients (from Menzger et al.) + ! + n = domain_number + gamma = (rh(i,k)**n/(1000._r8/n*(1._r8-rh(i,k))+n))**zeta_inv + ! + ! compute single solute molality for NH4NO3 + ! + ssm_nh4no3 = (1000._r8 * 0.81_r8 * nu_i(1) * (1._r8/rh(i,k)-1._r8)/80._r8)**z_i(1) + ! + ! compute equilibrium constant + ! + kp = (gamma*ssm_nh4no3)**2 * exp( 53.19_r8 - 15850.62_r8*ti + 11.51_r8*log_t ) + + endif + ! + ! calculate production of NH4NO3 (in ppbv) using Seinfeld and Pandis (p534, 1998) + ! + ta = fnh3 + tn = thno3(i,k) + nh4no3 = 0.5_r8 * (ta + tn - sqrt(max(0._r8,(ta+tn)**2 - 4._r8*(ta*tn-kp)))) + nh4no3 = max(0._r8,nh4no3) + if ( xhno3_ndx > 0 .and. xnh4no3_ndx > 0 ) then + tn = txhno3(i,k) + xnh4no3 = 0.5_r8 * (ta + tn - sqrt(max(0._r8,(ta+tn)**2 - 4._r8*(ta*tn-kp)))) + xnh4no3 = max(0._r8,xnh4no3) + endif + ! + ! reset concentrations according to equilibrium calculation + ! + qin(i,k,nh4no3_ndx) = nh4no3 + if ( xhno3_ndx > 0 ) then + qin(i,k,xnh4no3_ndx) = xnh4no3 + endif + qin(i,k,nh3_ndx ) = max(0._r8,(fnh3-nh4no3)) + qin(i,k,nh4_ndx ) = max(0._r8,(tnh3-(fnh3-nh4no3))) + qin(i,k,hno3_ndx ) = max(0._r8,(thno3(i,k)-nh4no3)) + if ( xhno3_ndx > 0 ) then + qin(i,k,xhno3_ndx ) = max(0._r8,(txhno3(i,k)-xnh4no3)) + endif + qin(i,k,so4_ndx ) = tso4(i,k) + ! + ! convert from ppbv to vmr + ! + qin(i,k,nh4no3_ndx) = qin(i,k,nh4no3_ndx) * 1.e-9_r8 + qin(i,k,nh3_ndx ) = qin(i,k,nh3_ndx ) * 1.e-9_r8 + qin(i,k,nh4_ndx ) = qin(i,k,nh4_ndx ) * 1.e-9_r8 + qin(i,k,hno3_ndx ) = qin(i,k,hno3_ndx ) * 1.e-9_r8 + qin(i,k,so4_ndx ) = qin(i,k,so4_ndx ) * 1.e-9_r8 + if ( xhno3_ndx > 0 ) then + qin(i,k,xnh4no3_ndx) = qin(i,k,xnh4no3_ndx) * 1.e-9_r8 + endif + if ( xhno3_ndx > 0 ) then + qin(i,k,xhno3_ndx ) = qin(i,k,xhno3_ndx ) * 1.e-9_r8 + endif + + end do + end do + ! + ! outputs + ! + call outfld ('TSO4_VMR' ,tso4 (:ncol,:), ncol, lchnk ) + call outfld ('THNO3_VMR',thno3(:ncol,:), ncol, lchnk ) + + return + end subroutine aerosols_formation + +end module mo_aerosols diff --git a/src/chemistry/bulk_aero/mo_setsoa.F90 b/src/chemistry/bulk_aero/mo_setsoa.F90 new file mode 100644 index 0000000000..99ec0023c3 --- /dev/null +++ b/src/chemistry/bulk_aero/mo_setsoa.F90 @@ -0,0 +1,1222 @@ +module mo_setsoa + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use ppgrid, only : pcols, pver, begchunk, endchunk + use cam_abortutils, only : endrun + use mo_constants, only : avogadro, Rgas + + implicit none + private + public :: soa_inti, setsoa, has_soa + public :: soa_register + + save + + integer, parameter :: NRX = 10 ! number of SOA forming reactions + integer, parameter :: NPR = 2 ! number of products (always 2!) + integer, target :: spc_ndx(22) + integer, pointer :: soam_ndx, soai_ndx, soab_ndx, soat_ndx, soax_ndx + integer, pointer :: sogm_ndx, sogi_ndx, sogb_ndx, sogt_ndx, sogx_ndx + integer, pointer :: oc1_ndx, oc2_ndx, c10h16_ndx, isop_ndx, o3_ndx, oh_ndx + integer, pointer :: no3_ndx, no_ndx, ho2_ndx, tolo2_ndx, beno2_ndx, xylo2_ndx + + integer :: rxn_soa(nrx),react_ndx(NRX,NPR) + real(r8), dimension(NRX,NPR) :: alpha ! mass-based stoichiometric coefficients + real(r8), dimension(NRX,NPR) :: k_om ! equilibrium gas-particule partition + real(r8), dimension(NRX) :: T1, delH ! Clausium Clayperson parameters (K, J/mol) + real(r8), dimension(nrx,npr) :: fracsog_init ! mass fraction of each SOA class from each reaction + real(r8), dimension(nrx,npr) :: fracsoa_init ! mass fraction of each SOG class from each reaction + + integer :: fracsog_ndx = -1 + integer :: fracsoa_ndx = -1 + + integer, pointer :: soa_ndx + integer, pointer :: bigalk_ndx, toluene_ndx + + real(r8), dimension(6) :: bulk_yield ! total yield of condensable compound (ug/m3/ppm) + real(r8), dimension(6) :: fraction ! fraction of VOC used in reaction + + real(r8), parameter :: OMscale = 2.1_r8 ! scaling factor for OM:OC [Turpin and Lim, 2001] + logical :: has_soa = .false. + logical :: has_soa_equil = .false. + +contains + +!=============================================================================== +!=============================================================================== +subroutine soa_inti(pbuf2d) + use physics_buffer, only : physics_buffer_desc + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + if ( has_soa_equil) then + call soa_inti_equil(pbuf2d) + else + call soa_inti_old() + endif +endsubroutine soa_inti +!=============================================================================== +!=============================================================================== +subroutine setsoa( ncol, lchnk, dt, reaction_rates, tfld, xhnm, vmr, pbuf) + use physics_buffer, only : physics_buffer_desc + use chem_mods, only : gas_pcnst, rxntot + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! number columns in chunkx + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: xhnm(:,:) ! total atms density (molec/cm**3) + real(r8), intent(inout) :: vmr(:,:,:) ! xported species ( vmr ) + type(physics_buffer_desc), pointer :: pbuf(:) + + if ( has_soa_equil) then + call setsoa_equil(dt,reaction_rates,tfld,vmr,xhnm,ncol,lchnk,pbuf) + else + call setsoa_old(dt,reaction_rates,tfld,vmr,xhnm,ncol,lchnk) + endif + +end subroutine setsoa +!=============================================================================== +!=============================================================================== +subroutine soa_inti_old + + use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx + use cam_history, only : addfld + use ppgrid, only : pver + use spmd_utils, only : masterproc + + implicit none + +!----------------------------------------------------------------------- +! ... check if this is an aerosol simulation +!----------------------------------------------------------------------- + if( .not. has_soa ) then + return + end if + + !----------------------------------------------------------------------- + ! ... set reaction indicies + !----------------------------------------------------------------------- + rxn_soa(1) = get_rxt_ndx( 'soa1' ) + if ( rxn_soa(1) <= 0 ) then + rxn_soa(1) = get_rxt_ndx( 'C10H16_O3' ) + end if + rxn_soa(2) = get_rxt_ndx( 'soa2' ) + if ( rxn_soa(2) <= 0 ) then + rxn_soa(2) = get_rxt_ndx( 'C10H16_OH' ) + end if + rxn_soa(3) = get_rxt_ndx( 'soa3' ) + if ( rxn_soa(3) <= 0 ) then + rxn_soa(3) = get_rxt_ndx( 'C10H16_NO3' ) + end if + rxn_soa(4) = get_rxt_ndx( 'soa4' ) + if ( rxn_soa(4) <= 0 ) then + rxn_soa(4) = get_rxt_ndx( 'TOLUENE_OH' ) + end if + rxn_soa(5) = get_rxt_ndx( 'soa4' ) ! TOLUENE is a lumped species and there are two sets of pathways + if ( rxn_soa(5) <= 0 ) then + rxn_soa(5) = get_rxt_ndx( 'TOLUENE_OH' ) + end if + rxn_soa(6) = get_rxt_ndx( 'soa5' ) + if ( rxn_soa(6) <= 0 ) then + rxn_soa(6) = get_rxt_ndx( 'BIGALK_OH' ) + end if + if( all( rxn_soa(:) < 1 ) ) then + has_soa = .false. + return + else + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) 'soa_inti_old: mozart will do soa aerosols' + write(iulog,*) '-----------------------------------------' + endif + end if + +! +! define reactants +! + react_ndx(1,1) = c10h16_ndx + react_ndx(1,2) = o3_ndx + react_ndx(2,1) = c10h16_ndx + react_ndx(2,2) = oh_ndx + react_ndx(3,1) = c10h16_ndx + react_ndx(3,2) = no3_ndx + react_ndx(4,1) = toluene_ndx + react_ndx(4,2) = oh_ndx + react_ndx(5,1) = toluene_ndx + react_ndx(5,2) = oh_ndx + react_ndx(6,1) = bigalk_ndx + react_ndx(6,2) = oh_ndx + + if ( masterproc ) then + write(iulog,*)'soa_inti ',c10h16_ndx, o3_ndx, oh_ndx, no3_ndx, bigalk_ndx, toluene_ndx + write(iulog,*)'soa_inti ',soa_ndx, oc1_ndx, oc2_ndx + write(iulog,*)'soa_inti ',react_ndx + endif +! +! define partitioning coefficients for each reaction +! bulk yields are from Seinfeld and Pandis (1998) +! +! c10h16 + o3 (from Chung and Seinfeld, JGR, 107, 2002) +! + alpha(1,1) = 0.067_r8 + alpha(1,2) = 0.354_r8 + k_om (1,1) = 0.184_r8 + k_om (1,2) = 0.0043_r8 + fraction(1) = 1._r8 + bulk_yield(1) = 762._r8 +! +! c10h16 + oh (from Chung and Seinfeld, JGR, 107, 2002) +! + alpha(2,1) = 0.067_r8 + alpha(2,2) = 0.354_r8 + k_om (2,1) = 0.184_r8 + k_om (2,2) = 0.0043_r8 + fraction(2) = 1._r8 + bulk_yield(2) = 762._r8 +! +! c10h16 + no3 (from Chung and Seinfeld, JGR, 107, 2002) +! + alpha(3,1) = 1.000_r8 + alpha(3,2) = 0.000_r8 + k_om (3,1) = 0.0163_r8 + k_om (3,2) = 0.0000_r8 + fraction(3) = 1._r8 + bulk_yield(3) = 762._r8 +! +! toluene + oh : toluene (from Odum et al., Environ. Sci. Technol., 1892, 1997) +! + alpha(4,1) = 0.038_r8 + alpha(4,2) = 0.167_r8 + k_om (4,1) = 0.042_r8 + k_om (4,2) = 0.0014_r8 + fraction(4) = 0.7_r8 + bulk_yield(4) = 424._r8 +! +! toluene + oh : m-xylene (from Cocker et al., Atmos. Environ., 6079, 2001) +! + alpha(5,1) = 0.120_r8 + alpha(5,2) = 0.019_r8 + k_om (5,1) = 0.060_r8 + k_om (5,2) = 0.010_r8 + fraction(5) = 0.2_r8 + bulk_yield(5) = 419._r8 +! +! bigalk + oh : only for alkanes >= heptane (assume low-yield aromatics as in Lack et al.) +! (from Odum et al., Environ. Sci. Technol., 1892, 1997) +! + alpha(6,1) = 0.071_r8 + alpha(6,2) = 0.138_r8 + k_om (6,1) = 0.053_r8 + k_om (6,2) = 0.0019_r8 + fraction(6) = 0.1_r8 + bulk_yield(6) = 200._r8 +! + call addfld( 'SOA_PROD', (/ 'lev' /), 'A', 'kg/kg/s', 'production of SOA' ) + + return +end subroutine soa_inti_old +! +subroutine setsoa_old(dt,reaction_rates,tfld,vmr,xhnm,ncol,lchnk) +! +! secondary organic aerosol for mozart v2.5 +! +! based on Lack et al., JGR, 109, D03203, 2004 +! +! rewritten by Jean-Francois Lamarque for updated chemical +! mechanism (March 2004) +! +! adapted to CAM (May 2004) +! + use ppgrid, only : pcols, pver + use chem_mods, only : adv_mass, gas_pcnst, rxntot + use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx + use cam_history, only : outfld + use cam_abortutils, only : endrun +! + implicit none +! +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! number columns in chunkx + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(inout) :: vmr(:,:,:) ! xported species ( vmr ) + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: xhnm(:,:) ! total atms density (mol/cm**3) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: i,k,n + real(r8) :: m_0 + real(r8) :: mw_soa,yield,prod,soa_mass + real(r8) :: soa_prod(ncol,pver) +! +! find molecular weight of SOA +! + mw_soa = adv_mass(soa_ndx) +! + do k=1,pver + do i=1,ncol +! +! calculate initial mass of organic aerosols from OC1 and OC2 +! and convert to ug/m3 +! + m_0 = (vmr(i,k,oc1_ndx)+vmr(i,k,oc2_ndx)) * xhnm(i,k) * adv_mass(oc1_ndx)/avogadro * 1.e12_r8 +! +! switch based on a minimum value of m_0. The bulk approach is +! used to initiate the process +! + if ( m_0 <= 0.2_r8 ) then +! +! bulk theory +! + soa_mass = 0._r8 + do n=1,6 +! + if ( rxn_soa(n) <= 0 ) cycle +! + yield = bulk_yield(n) +! +! define chemical production from gas-phase chemistry +! + prod = reaction_rates(i,k,rxn_soa(n)) * fraction(n) & + * vmr(i,k,react_ndx(n,1)) * vmr(i,k,react_ndx(n,2)) * dt +! +! convert from mixing ratio to ppm +! + prod = 1e6_r8 * prod +! +! collect into total SOA mass +! + soa_mass = soa_mass + yield * prod +! + end do +! + else +! +! partitioning theory +! + soa_mass = 0._r8 + do n=1,6 +! + if ( rxn_soa(n) <= 0 ) cycle +! +! define yield from available m_0 +! + yield = soa_yield(m_0,alpha(n,1:2),k_om(n,1:2)) +! +! define chemical production from gas-phase chemistry +! + prod = reaction_rates(i,k,rxn_soa(n)) * fraction(n) & + * vmr(i,k,react_ndx(n,1)) * vmr(i,k,react_ndx(n,2)) * dt +! +! convert from mixing ratio to mass (ug/m3) +! + prod = prod * xhnm(i,k) * mw_soa/avogadro * 1.e12_r8 +! +! collect into total SOA mass +! + soa_mass = soa_mass + yield * prod +! + end do +! + endif +! +! convert from ug/m3 to mixing ratio and update vmr +! + vmr(i,k,soa_ndx) = vmr(i,k,soa_ndx) + soa_mass * 1.e-12_r8 * avogadro/(mw_soa*xhnm(i,k)) + if ( vmr(i,k,soa_ndx) > 1.e0_r8 ) then + write(iulog,*)i,k,soa_mass,m_0 + call endrun('soa_yield: vmr(i,k,soa_ndx) > 1.e0_r8') + endif +! + soa_prod(i,k) = soa_mass*1.e-12_r8*avogadro/(28.966_r8*xhnm(i,k)*dt) + end do + end do +! + call outfld('SOA_PROD',soa_prod(:ncol,:),ncol, lchnk) + return +end subroutine setsoa_old +! +real(r8) function soa_yield(m_0,xalpha,xk) +! + implicit none +! + real(r8), intent(in) :: m_0 + real(r8), intent(in), dimension(2) :: xalpha, xk +! + soa_yield = m_0 * ( ((xalpha(1)*xk(1))/(1._r8+xk(1)*m_0)) & + + ((xalpha(2)*xk(2))/(1._r8+xk(2)*m_0)) ) +! + return +end function soa_yield +! + + !=============================================================================== + !=============================================================================== + subroutine soa_register + use physics_buffer, only : pbuf_add_field, dtype_r8 + use mo_chem_utls, only : get_spc_ndx + + !----------------------------------------------------------------------- + ! ... set species indices + !----------------------------------------------------------------------- + + oc1_ndx => spc_ndx(1) + oc2_ndx => spc_ndx(2) + soam_ndx => spc_ndx(3) + soai_ndx => spc_ndx(4) + soat_ndx => spc_ndx(5) + soab_ndx => spc_ndx(6) + soax_ndx => spc_ndx(7) + c10h16_ndx => spc_ndx(8) + isop_ndx => spc_ndx(9) + tolo2_ndx => spc_ndx(10) + beno2_ndx => spc_ndx(11) + xylo2_ndx => spc_ndx(12) + ho2_ndx => spc_ndx(13) + no_ndx => spc_ndx(14) + o3_ndx => spc_ndx(15) + oh_ndx => spc_ndx(16) + no3_ndx => spc_ndx(17) + sogm_ndx => spc_ndx(18) + sogi_ndx => spc_ndx(19) + sogt_ndx => spc_ndx(20) + sogb_ndx => spc_ndx(21) + sogx_ndx => spc_ndx(22) + + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + c10h16_ndx = get_spc_ndx( 'C10H16') + isop_ndx = get_spc_ndx( 'ISOP' ) + tolo2_ndx = get_spc_ndx( 'TOLO2' ) + beno2_ndx = get_spc_ndx( 'BENO2' ) + xylo2_ndx = get_spc_ndx( 'XYLO2' ) + ho2_ndx = get_spc_ndx( 'HO2' ) + no_ndx = get_spc_ndx( 'NO' ) + o3_ndx = get_spc_ndx( 'OX' ) + if( o3_ndx < 1 ) then + o3_ndx = get_spc_ndx( 'O3' ) + end if + oh_ndx = get_spc_ndx( 'OH' ) + no3_ndx = get_spc_ndx( 'NO3' ) + + soam_ndx = get_spc_ndx( 'SOAM' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + + sogm_ndx = get_spc_ndx( 'SOGM' ) + sogi_ndx = get_spc_ndx( 'SOGI' ) + sogt_ndx = get_spc_ndx( 'SOGT' ) + sogb_ndx = get_spc_ndx( 'SOGB' ) + sogx_ndx = get_spc_ndx( 'SOGX' ) + + has_soa_equil = all( spc_ndx(1:22) > 0 ) + has_soa = has_soa_equil + + if ( has_soa_equil ) then + ! fracsog and fracsoa are added to pbuffer for persistence across restarts + call pbuf_add_field( 'FRACSOG' ,'global',dtype_r8,(/pcols,pver,nrx,npr/), fracsog_ndx) + call pbuf_add_field( 'FRACSOA' ,'global',dtype_r8,(/pcols,pver,nrx,npr/), fracsoa_ndx) + else + ! reassign these ndx pointers... + soa_ndx => spc_ndx(1) + oc1_ndx => spc_ndx(2) + oc2_ndx => spc_ndx(3) + c10h16_ndx => spc_ndx(4) + o3_ndx => spc_ndx(5) + oh_ndx => spc_ndx(6) + no3_ndx => spc_ndx(7) + bigalk_ndx => spc_ndx(8) + toluene_ndx => spc_ndx(9) + + soa_ndx = get_spc_ndx( 'SOA' ) + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + c10h16_ndx = get_spc_ndx( 'C10H16') + o3_ndx = get_spc_ndx( 'OX' ) + if( o3_ndx < 1 ) then + o3_ndx = get_spc_ndx( 'O3' ) + end if + oh_ndx = get_spc_ndx( 'OH' ) + no3_ndx = get_spc_ndx( 'NO3' ) + + bigalk_ndx = get_spc_ndx( 'BIGALK' ) + toluene_ndx = get_spc_ndx( 'TOLUENE' ) + + has_soa = all( spc_ndx(1:7) > 0 ) + endif + + end subroutine soa_register + + !=============================================================================== + !=============================================================================== + subroutine soa_inti_equil(pbuf2d) + + use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx + use cam_history, only : addfld + use ppgrid, only : pver + use spmd_utils, only : masterproc + use cam_control_mod, only: initial_run + use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk, pbuf_get_field + + implicit none + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf_ptr(:) + + integer :: astat + integer :: i,k,j, c + + real(r8), pointer :: fracsog(:,:,:,:) ! mass fraction of each SOA class from each reaction + real(r8), pointer :: fracsoa(:,:,:,:) ! mass fraction of each SOG class from each reaction + + !----------------------------------------------------------------------- + ! ... check if this is an aerosol simulation + !----------------------------------------------------------------------- + if( .not. has_soa ) then + return + end if + + !----------------------------------------------------------------------- + ! ... set reaction indicies + !----------------------------------------------------------------------- + rxn_soa(1) = get_rxt_ndx( 'C10H16_O3' ) + rxn_soa(2) = get_rxt_ndx( 'C10H16_OH' ) + rxn_soa(3) = get_rxt_ndx( 'C10H16_NO3' ) + rxn_soa(4) = get_rxt_ndx( 'ISOP_OH' ) + rxn_soa(5) = get_rxt_ndx( 'TOLO2_HO2' ) + rxn_soa(6) = get_rxt_ndx( 'TOLO2_NO' ) + if (rxn_soa(6)<0) then + rxn_soa(6) = get_rxt_ndx( 'ox_p12' ) + endif + rxn_soa(7) = get_rxt_ndx( 'BENO2_HO2' ) + rxn_soa(8) = get_rxt_ndx( 'BENO2_NO' ) + rxn_soa(9) = get_rxt_ndx( 'XYLO2_HO2' ) + rxn_soa(10) = get_rxt_ndx( 'XYLO2_NO' ) + if( all( rxn_soa(:) < 1 ) ) then + has_soa = .false. + return + else + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) 'soa_inti_equil: mozart will do soa aerosols' + write(iulog,*) '-----------------------------------------' + endif + end if + + ! + ! define reactants + ! + react_ndx(1,1) = c10h16_ndx + react_ndx(1,2) = o3_ndx + react_ndx(2,1) = c10h16_ndx + react_ndx(2,2) = oh_ndx + react_ndx(3,1) = c10h16_ndx + react_ndx(3,2) = no3_ndx + react_ndx(4,1) = isop_ndx + react_ndx(4,2) = oh_ndx + react_ndx(5,1) = tolo2_ndx + react_ndx(5,2) = ho2_ndx + react_ndx(6,1) = tolo2_ndx + react_ndx(6,2) = no_ndx + react_ndx(7,1) = beno2_ndx + react_ndx(7,2) = ho2_ndx + react_ndx(8,1) = beno2_ndx + react_ndx(8,2) = no_ndx + react_ndx(9,1) = xylo2_ndx + react_ndx(9,2) = ho2_ndx + react_ndx(10,1) = xylo2_ndx + react_ndx(10,2) = no_ndx + + if ( masterproc ) then + print *,'soa_inti ',c10h16_ndx, isop_ndx, tolo2_ndx, beno2_ndx, xylo2_ndx,o3_ndx, oh_ndx, no3_ndx + print *,'soa_inti ',soam_ndx, soai_ndx, soab_ndx, soat_ndx, soax_ndx, oc1_ndx, oc2_ndx + print *,'soa_inti ',sogm_ndx, sogi_ndx, sogb_ndx, sogt_ndx, sogx_ndx + print *,'soa_inti ',react_ndx + endif + ! + ! define partitioning coefficients for each reaction + ! bulk yields are from Seinfeld and Pandis (1998) + ! + ! c10h16 + o3 (from Chung and Seinfeld, JGR, 107, 2002) + ! + alpha(1,1) = 0.067_r8 + alpha(1,2) = 0.354_r8 + k_om(1,1) = 0.184_r8 + k_om(1,2) = 0.0043_r8 + T1(1) = 310._r8 + delH(1) = 42.e3_r8 + + ! c10h16 + oh (from Chung and Seinfeld, JGR, 107, 2002) + ! + alpha(2,1) = 0.067_r8 + alpha(2,2) = 0.354_r8 + k_om(2,1) = 0.184_r8 + k_om(2,2) = 0.0043_r8 + T1(2) = 310._r8 + delH(2) = 42.e3_r8 + ! + ! c10h16 + no3 (from Chung and Seinfeld, JGR, 107, 2002) + ! + alpha(3,1) = 1.000_r8 + alpha(3,2) = 0.000_r8 + k_om(3,1) = 0.0163_r8 + k_om(3,2) = 0.0000_r8 + T1(3) = 310._r8 + delH(3) = 42.e3_r8 + ! + !! isop + oh (from Henze and Seinfeld, GRL, 2006): low NOx + !! + ! alpha(4,1) = 0.232_r8 + ! alpha(4,2) = 0.0288_r8 + ! k_om(4,1) = 0.00862_r8 + ! k_om(4,2) = 1.62_r8 + ! T1(4) = 295._r8 + ! delH(4) = 42.e3_r8 + !! + ! isop + oh (from Henze and Seinfeld, GRL, 2006): high NOx + ! + alpha(4,1) = 0.264_r8 + alpha(4,2) = 0.0173_r8 + k_om(4,1) = 0.00115_r8 + k_om(4,2) = 1.52_r8 + T1(4) = 295._r8 + delH(4) = 42.e3_r8 + ! + ! toluene + oh (pers comm Seinfeld and Henze): low NOx (TOLO2 + HO2) + ! + alpha(5,1) = 0.2349_r8 + alpha(5,2) = 0.0_r8 + k_om(5,1) = 1000.0_r8 + k_om(5,2) = 0.0_r8 + T1(5) = 295._r8 + delH(5) = 42.e3_r8 + ! + ! toluene + oh (pers comm Seinfeld and Henze): high NOx (TOLO2 + NO) + ! + alpha(6,1) = 0.0378_r8 + alpha(6,2) = 0.0737_r8 + k_om(6,1) = 0.4300_r8 + k_om(6,2) = 0.0470_r8 + T1(6) = 295._r8 + delH(6) = 42.e3_r8 + ! + ! benzene + oh (pers comm Seinfeld and Henze): low NOx (BENO2 + HO2) + ! + alpha(7,1) = 0.2272_r8 + alpha(7,2) = 0.0_r8 + k_om (7,1) = 1000.0_r8 + k_om (7,2) = 0.0_r8 + T1(7) = 295._r8 + delH(7) = 42.e3_r8 + ! + ! benzene + oh (pers comm Seinfeld and Henze): high NOx (BENO2 + NO) + ! + alpha(8,1) = 0.0442_r8 + alpha(8,2) = 0.5454_r8 + k_om(8,1) = 3.3150_r8 + k_om(8,2) = 0.0090_r8 + T1(8) = 295._r8 + delH(8) = 42.e3_r8 + ! + ! xylene + oh (pers comm Seinfeld and Henze): low NOx (XYLO2 + HO2) + ! + alpha(9,1) = 0.2052_r8 + alpha(9,2) = 0.0_r8 + k_om(9,1) = 1000.0_r8 + k_om(9,2) = 0.0_r8 + T1(9) = 295._r8 + delH(9) = 42.e3_r8 + ! + ! xylene + oh (pers comm Seinfeld and Henze): high NOx (XYLO2 + NO) + ! + alpha(10,1) = 0.0212_r8 + alpha(10,2) = 0.0615_r8 + k_om(10,1) = 0.7610_r8 + k_om(10,2) = 0.0290_r8 + T1(10) = 295._r8 + delH(10) = 42.e3_r8 + ! + call addfld( 'SOAM_PROD', (/ 'lev' /), 'A', 'molec/molec/s', 'production of SOAM' ) + call addfld( 'SOAI_PROD', (/ 'lev' /), 'A', 'molec/molec/s', 'production of SOAI' ) + call addfld( 'SOAT_PROD', (/ 'lev' /), 'A', 'molec/molec/s', 'production of SOAT' ) + call addfld( 'SOAB_PROD', (/ 'lev' /), 'A', 'molec/molec/s', 'production of SOAB' ) + call addfld( 'SOAX_PROD', (/ 'lev' /), 'A', 'molec/molec/s', 'production of SOAX' ) + + call addfld( 'SOAM_dens', (/ 'lev' /), 'A', 'ug/m3', 'density of SOAM' ) + call addfld( 'SOAI_dens', (/ 'lev' /), 'A', 'ug/m3', 'density of SOAI' ) + call addfld( 'SOAT_dens', (/ 'lev' /), 'A', 'ug/m3', 'density of SOAT' ) + call addfld( 'SOAB_dens', (/ 'lev' /), 'A', 'ug/m3', 'density of SOAB' ) + call addfld( 'SOAX_dens', (/ 'lev' /), 'A', 'ug/m3', 'density of SOAX' ) + + ! + !initialize fracsoa for first timestep and store values for future + fracsoa_init(1:3,:)=0.2_r8 + fracsoa_init(3,2)=0._r8 + fracsoa_init(4,:)=0.5_r8 + fracsoa_init(5:10,:)=0.33_r8 + fracsoa_init(5,2)=0._r8 + fracsoa_init(7,2)=0._r8 + fracsoa_init(9,2)=0._r8 + + !initialize fracsog for first timestep and store values for future + fracsog_init(1:3,:)=0.2_r8 + fracsog_init(3,2)=0._r8 + fracsog_init(4,:)=0.5_r8 + fracsog_init(5:10,:)=0.33_r8 + fracsog_init(5,2)=0._r8 + fracsog_init(7,2)=0._r8 + fracsog_init(9,2)=0._r8 + + if (initial_run) then + do c=begchunk, endchunk + pbuf_ptr=>pbuf_get_chunk(pbuf2d, c) + call pbuf_get_field(pbuf_ptr, fracsoa_ndx, fracsoa ) + call pbuf_get_field(pbuf_ptr, fracsog_ndx, fracsog ) + do i = 1,pcols + do k = 1,pver + fracsoa( i,k, :,: ) = fracsoa_init(:,:) + fracsog( i,k, :,: ) = fracsog_init(:,:) + enddo + enddo + enddo + endif + + return + end subroutine soa_inti_equil + !=============================================================================== + ! clh (08/01/06): added T dependence of gas-aerosol phase partitioning + ! added isoprene as SOA precursor [Henze and Seinfeld, 2006] + ! added anthropogenic SOA according to [Henze et al., 2007] + ! split SOA into classes (SOAM=monoterpenes,SOAI=isoprene,SOAB=benzene,SOAT=toluene + ! SOAX=xylene) + ! fixed error in yield calculation + ! added scaling for OC to OM in pre-existing aerosol mass + ! modified yield calculation to allow for re-evaporation + ! Note: do not need to subtract formed aerosol product from reactants, because gas-phase + ! products do not account for entire mass + !=============================================================================== + subroutine setsoa_equil(dt,reaction_rates,tfld,vmr,xhnm,ncol,lchnk,pbuf) + ! + ! updated SOA mechanism + ! based on Chung and Seinfeld, JGR, 2002 + ! + ! implemented in CAM by Colette Heald (summer 2007) + ! + use ppgrid, only : pcols, pver + use chem_mods, only : adv_mass, gas_pcnst, rxntot + use cam_history, only : outfld + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + ! + implicit none + ! + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! number columns in chunkx + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(inout) :: vmr(:,:,:) ! xported species ( vmr ) + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: xhnm(:,:) ! total atms density (molec/cm**3) + type(physics_buffer_desc), pointer :: pbuf(:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i,k,n,p,iter + real(r8) :: T_fac + real(r8) :: delHC, sumorg, poa, mnew, numer, maxM, minM, tol, mw_soa,m_air + real(r8) :: k_om_T(NRX,NPR) ! equilibrium gas-particule partition (T dependent) + real(r8) :: prod(NRX,NPR) ! oxidized produced (alpha_i*delHC) + real(r8) :: sog0(NRX,NPR) ! pre-existing SOG + real(r8) :: soa0(NRX,NPR) ! pre-exisiting SOA + real(r8) :: orggas(NRX,NPR) ! intermediate (SOG0+prod of ox) + real(r8) :: sog(NRX,NPR) ! final SOG + real(r8) :: soa(NRX,NPR) ! final SOA + real(r8), dimension(pcols,pver) :: soam_mass,soai_mass,soat_mass,soab_mass,soax_mass + real(r8), dimension(pcols,pver) :: sogm_mass,sogi_mass,sogt_mass,sogb_mass,sogx_mass + real(r8) :: soam_prod(ncol,pver), soai_prod(ncol,pver),soat_prod(ncol,pver),soab_prod(ncol,pver),soax_prod(ncol,pver) + + real(r8), pointer, dimension(:,:,:,:) :: fracsog ! mass fraction of each SOA class from each reaction + real(r8), pointer, dimension(:,:,:,:) :: fracsoa ! mass fraction of each SOG class from each reaction + + soam_mass(:,:)=0._r8 + soai_mass(:,:)=0._r8 + soat_mass(:,:)=0._r8 + soab_mass(:,:)=0._r8 + soax_mass(:,:)=0._r8 + sogm_mass(:,:)=0._r8 + sogi_mass(:,:)=0._r8 + sogt_mass(:,:)=0._r8 + sogb_mass(:,:)=0._r8 + sogx_mass(:,:)=0._r8 + + call pbuf_get_field(pbuf, fracsoa_ndx, fracsoa ) + call pbuf_get_field(pbuf, fracsog_ndx, fracsog ) + + do i=1,ncol + do k=1,pver + ! + ! INIALIZATION AND LUMPING + ! + ! calculate mass concentration of air (ug/m3) + m_air = xhnm(i,k)*28.966_r8/avogadro*1.e12_r8 + ! + ! calculate initial mass of POA from OC1 and OC2 (in ug/m3) + poa = (vmr(i,k,oc1_ndx)+vmr(i,k,oc2_ndx)) * OMscale * xhnm(i,k) * adv_mass(oc1_ndx)/avogadro * 1.e12_r8 + ! + ! specify pre-existing SOG/SOA for each class (in ug/m3) + + + sog0(1,1)=vmr(i,k,sogm_ndx) * xhnm(i,k) * adv_mass(sogm_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 1,1) + sog0(1,2)=vmr(i,k,sogm_ndx) * xhnm(i,k) * adv_mass(sogm_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 1,2) + sog0(2,1)=vmr(i,k,sogm_ndx) * xhnm(i,k) * adv_mass(sogm_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 2,1) + sog0(2,2)=vmr(i,k,sogm_ndx) * xhnm(i,k) * adv_mass(sogm_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 2,2) + sog0(3,1)=vmr(i,k,sogm_ndx) * xhnm(i,k) * adv_mass(sogm_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 3,1) + sog0(3,2)=0._r8 + sog0(4,1)=vmr(i,k,sogi_ndx) * xhnm(i,k) * adv_mass(sogi_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 4,1) + sog0(4,2)=vmr(i,k,sogi_ndx) * xhnm(i,k) * adv_mass(sogi_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 4,2) + sog0(5,1)=vmr(i,k,sogt_ndx) * xhnm(i,k) * adv_mass(sogt_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 5,1) + sog0(5,2)=0._r8 + sog0(6,1)=vmr(i,k,sogt_ndx) * xhnm(i,k) * adv_mass(sogt_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 6,1) + sog0(6,2)=vmr(i,k,sogt_ndx) * xhnm(i,k) * adv_mass(sogt_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 6,2) + sog0(7,1)=vmr(i,k,sogb_ndx) * xhnm(i,k) * adv_mass(sogb_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 7,1) + sog0(7,2)=0._r8 + sog0(8,1)=vmr(i,k,sogb_ndx) * xhnm(i,k) * adv_mass(sogb_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 8,1) + sog0(8,2)=vmr(i,k,sogb_ndx) * xhnm(i,k) * adv_mass(sogb_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 8,2) + sog0(9,1)=vmr(i,k,sogx_ndx) * xhnm(i,k) * adv_mass(sogx_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 9,1) + sog0(9,2)=0._r8 + sog0(10,1)=vmr(i,k,sogx_ndx) * xhnm(i,k) * adv_mass(sogx_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 10,1) + sog0(10,2)=vmr(i,k,sogx_ndx) * xhnm(i,k) * adv_mass(sogx_ndx)/avogadro * 1.e12_r8 * fracsog(i,k, 10,2) + ! + soa0(1,1)=vmr(i,k,soam_ndx) * xhnm(i,k) * adv_mass(soam_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 1,1) + soa0(1,2)=vmr(i,k,soam_ndx) * xhnm(i,k) * adv_mass(soam_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 1,2) + soa0(2,1)=vmr(i,k,soam_ndx) * xhnm(i,k) * adv_mass(soam_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 2,1) + soa0(2,2)=vmr(i,k,soam_ndx) * xhnm(i,k) * adv_mass(soam_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 2,2) + soa0(3,1)=vmr(i,k,soam_ndx) * xhnm(i,k) * adv_mass(soam_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 3,1) + soa0(3,2)=0._r8 + soa0(4,1)=vmr(i,k,soai_ndx) * xhnm(i,k) * adv_mass(soai_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 4,1) + soa0(4,2)=vmr(i,k,soai_ndx) * xhnm(i,k) * adv_mass(soai_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 4,2) + soa0(5,1)=vmr(i,k,soat_ndx) * xhnm(i,k) * adv_mass(soat_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 5,1) + soa0(5,2)=0._r8 + soa0(6,1)=vmr(i,k,soat_ndx) * xhnm(i,k) * adv_mass(soat_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 6,1) + soa0(6,2)=vmr(i,k,soat_ndx) * xhnm(i,k) * adv_mass(soat_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 6,2) + soa0(7,1)=vmr(i,k,soab_ndx) * xhnm(i,k) * adv_mass(soab_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 7,1) + soa0(7,2)=0._r8 + soa0(8,1)=vmr(i,k,soab_ndx) * xhnm(i,k) * adv_mass(soab_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 8,1) + soa0(8,2)=vmr(i,k,soab_ndx) * xhnm(i,k) * adv_mass(soab_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 8,2) + soa0(9,1)=vmr(i,k,soax_ndx) * xhnm(i,k) * adv_mass(soax_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 9,1) + soa0(9,2)=0._r8 + soa0(10,1)=vmr(i,k,soax_ndx) * xhnm(i,k) * adv_mass(soax_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 10,1) + soa0(10,2)=vmr(i,k,soax_ndx) * xhnm(i,k) * adv_mass(soax_ndx)/avogadro * 1.e12_r8 * fracsoa(i,k, 10,2) + ! + ! + !-------------------------------------------------------------- + ! CHEMISTRY + ! + sumorg=0._r8 + ! + do n=1,NRX + ! + ! temperature dependence of paritioning via Clausiaus Clayperon [C&S, 2002]: clh (02/24/06) + T_fac = tfld(i,k)/T1(n) * exp(delH(n)/Rgas*(1/tfld(i,k) - 1/T1(n))) + k_om_T(n,:)=k_om(n,:)*T_fac + ! + ! find molecular weight of SOA + if ( (n >=1) .and. (n < 4) ) then + mw_soa = adv_mass(soam_ndx) + else if (n == 4) then + mw_soa = adv_mass(soai_ndx) + else if ( (n > 4) .and. (n < 7) ) then + mw_soa = adv_mass(soat_ndx) + else if ( (n >= 7) .and. (n < 9) ) then + mw_soa = adv_mass(soab_ndx) + else if ( (n >= 9) .and. (n < 11) ) then + mw_soa = adv_mass(soax_ndx) + end if + ! + ! define chemical production from gas-phase chemistry (and convert to ug/m3) + delHC = reaction_rates(i,k,rxn_soa(n)) & + * vmr(i,k,react_ndx(n,1)) * vmr(i,k,react_ndx(n,2))* dt & + * xhnm(i,k) * mw_soa/avogadro * 1.e12_r8 + ! + ! specify the new total of gas-phase products (before re-partitioning) + ! and total up all SOA in gas and aerosol phase + do p=1,NPR + orggas(n,p) = sog0(n,p)+alpha(n,p)*delHC + sumorg=sumorg+orggas(n,p)+soa0(n,p) + prod(n,p)=alpha(n,p)*delHC + enddo + ! + enddo + ! + !-------------------------------------------------------------- + ! check to see if no organics no partitioning! + ! (set here to previous timestep concentration+oxprod to preserve mass) + if (sumorg < 1.e-10_r8) then + do n=1,NRX + do p=1,NPR + sog(n,p)=sog0(n,p) + soa(n,p)=soa0(n,p)+prod(n,p) + enddo + enddo + else + ! PARTITION (Need to iteratively solve for MNEW, set tolerances to 0.1 ng/m3 or 1% of MNEW) + ! + numer=0._r8 + maxM=0._r8 + ! If POA is essentially zero, equations simplify + if (POA < 1.e-10_r8) then + do n=1,NRX + do p=1,NPR + numer = numer + k_om_T(n,p)* (orggas(n,p)+soa0(n,p)) + enddo + enddo + ! if numerator is less than 1 then MNEW must be zero + if (numer <= 1._r8) then + mnew=0._r8 + iter=0 + else + minM = 1.e-40_r8 + maxM = poa + sumorg + tol = 1.e-4_r8 + mnew = zeroin(minM,maxM,tol,poa,soa0,orggas,k_om_T,sumorg,iter) + end if + ! + ! if additional organic mass is less than 1% of POA, or difference between the + ! two is less than 0.1 ng/m3 (the tolerance) then POA is partitioning mass + else if ( (sumorg < 0.01_r8*poa) .or. (abs(sumorg-poa) < 1.e-4_r8) ) then + mnew = poa + iter = 0 + ! otherwise solve for MNEW iteratively on interval [poa, poa+sumorg] + else + maxM = poa+sumorg + minM = poa + tol = 1.e-4_r8 + mnew = zeroin(minM,maxM,tol,poa,soa0,orggas,k_om_T,sumorg,iter) + end if + ! + ! + ! Now equilibrium partitioning with new MNEW + ! If no MNEW then all the SOA evaporates to gas-phase + if (mnew > 0._r8) then + do n=1,NRX + do p=1,NPR + soa(n,p)=k_om_T(n,p)*mnew*(orggas(n,p)+soa0(n,p))/(1._r8+k_om_T(n,p)*mnew) + if (k_om_T(n,p) /= 0._r8) then + sog(n,p)=soa(n,p)/(k_om_T(n,p)*mnew) + else + sog(n,p)=0._r8 + end if + enddo + enddo + + else + do n=1,NRX + do p=1,NPR + sog(n,p)=orggas(n,p)+soa0(n,p) + soa(n,p)=1.e-20_r8 + enddo + enddo + end if + ! + end if + ! + !-------------------------------------------------------------- + ! LUMP INTO ARRAYS + do n=1,NRX + do p=1,NPR + if ( (n >=1) .and. (n < 4) ) then + soam_mass(i,k) = soam_mass(i,k) + soa(n,p) + sogm_mass(i,k) = sogm_mass(i,k) + sog(n,p) + else if (n == 4) then + soai_mass(i,k) = soai_mass(i,k) + soa(n,p) + sogi_mass(i,k) = sogi_mass(i,k) + sog(n,p) + else if ( (n > 4) .and. (n < 7) ) then + soat_mass(i,k) = soat_mass(i,k) + soa(n,p) + sogt_mass(i,k) = sogt_mass(i,k) + sog(n,p) + else if ( (n >= 7) .and. (n < 9) ) then + soab_mass(i,k) = soab_mass(i,k) + soa(n,p) + sogb_mass(i,k) = sogb_mass(i,k) + sog(n,p) + else if ( (n >= 9) .and. (n < 11) ) then + soax_mass(i,k) = soax_mass(i,k) + soa(n,p) + sogx_mass(i,k) = sogx_mass(i,k) + sog(n,p) + end if + enddo + enddo + ! + ! Save mass fraction of each SOA rxn to SOA class + ! (but if sumorg essentially zero revert to init fracs OR + ! if mnew = 0 (all evap) then fracsoa revert to old, calculate fracsog only) + if (sumorg < 1.e-10_r8) then + do n=1,NRX + do p=1,NPR + fracsoa(i,k,n,p)=fracsoa_init(n,p) + fracsog(i,k,n,p)=fracsog_init(n,p) + enddo + enddo + else + if (mnew < 1.e-20_r8) then + do n=1,NRX + do p=1,NPR + fracsoa(i,k,n,p)=fracsoa_init(n,p) + if ( (n >=1) .and. (n < 4) ) then + if (sogm_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogm_mass(i,k) + end if + else if (n == 4) then + if (sogi_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogi_mass(i,k) + end if + else if ( (n > 4) .and. (n < 7) ) then + if (sogt_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogt_mass(i,k) + end if + else if ( (n >= 7) .and. (n < 9) ) then + if (sogb_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogb_mass(i,k) + end if + else if ( (n >= 9) .and. (n < 11) ) then + if (sogx_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogx_mass(i,k) + end if + end if + if ( (p==2) .and. (n==3 .or. n==5 .or. n==7 .or. n==9) ) then + fracsog(i,k,n,p)=0._r8 + end if + enddo + enddo + else + do n=1,NRX + do p=1,NPR + if ( (n >=1) .and. (n < 4) ) then + if (soam_mass(i,k) == 0._r8) then + fracsoa(i,k,n,p)=fracsoa_init(n,p) + else + fracsoa(i,k,n,p)=soa(n,p)/soam_mass(i,k) + end if + if (sogm_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogm_mass(i,k) + end if + else if (n == 4) then + if (soai_mass(i,k) == 0._r8) then + fracsoa(i,k,n,p)=fracsoa_init(n,p) + else + fracsoa(i,k,n,p)=soa(n,p)/soai_mass(i,k) + end if + if (sogi_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogi_mass(i,k) + end if + else if ( (n > 4) .and. (n < 7) ) then + if (soat_mass(i,k) == 0._r8) then + fracsoa(i,k,n,p)=fracsoa_init(n,p) + else + fracsoa(i,k,n,p)=soa(n,p)/soat_mass(i,k) + end if + if (sogt_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogt_mass(i,k) + end if + else if ( (n >= 7) .and. (n < 9) ) then + if (soab_mass(i,k) == 0._r8) then + fracsoa(i,k,n,p)=fracsoa_init(n,p) + else + fracsoa(i,k,n,p)=soa(n,p)/soab_mass(i,k) + end if + if (sogb_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogb_mass(i,k) + end if + else if ( (n >= 9) .and. (n < 11) ) then + if (soax_mass(i,k) == 0._r8) then + fracsoa(i,k,n,p)=fracsoa_init(n,p) + else + fracsoa(i,k,n,p)=soa(n,p)/soax_mass(i,k) + end if + if (sogx_mass(i,k) == 0._r8) then + fracsog(i,k,n,p)=fracsog_init(n,p) + else + fracsog(i,k,n,p)=sog(n,p)/sogx_mass(i,k) + end if + end if + if ( (p==2) .and. (n==3 .or. n==5 .or. n==7 .or. n==9) ) then + fracsoa(i,k,n,p)=0._r8 + fracsog(i,k,n,p)=0._r8 + end if + enddo + enddo + end if + end if + ! + !-------------------------------------------------------------- + ! + ! calculate NET production in kg/kg/s (subtract initial mass) + ! + soam_prod(i,k) = ( soam_mass(i,k)*1.e-12_r8*avogadro/(adv_mass(soam_ndx)*xhnm(i,k)) - & + vmr(i,k,soam_ndx) )/dt + soai_prod(i,k) = ( soai_mass(i,k)*1.e-12_r8*avogadro/(adv_mass(soai_ndx)*xhnm(i,k)) - & + vmr(i,k,soai_ndx) )/dt + soat_prod(i,k) = ( soat_mass(i,k)*1.e-12_r8*avogadro/(adv_mass(soat_ndx)*xhnm(i,k)) - & + vmr(i,k,soat_ndx) )/dt + soab_prod(i,k) = ( soab_mass(i,k)*1.e-12_r8*avogadro/(adv_mass(soab_ndx)*xhnm(i,k)) - & + vmr(i,k,soab_ndx) )/dt + soax_prod(i,k) = ( soax_mass(i,k)*1.e-12_r8*avogadro/(adv_mass(soax_ndx)*xhnm(i,k)) - & + vmr(i,k,soax_ndx) )/dt + ! + ! convert from ug/m3 to mixing ratio and update vmr + ! + vmr(i,k,soam_ndx) = soam_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(soam_ndx)*xhnm(i,k)) + vmr(i,k,soai_ndx) = soai_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(soai_ndx)*xhnm(i,k)) + vmr(i,k,soat_ndx) = soat_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(soat_ndx)*xhnm(i,k)) + vmr(i,k,soab_ndx) = soab_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(soab_ndx)*xhnm(i,k)) + vmr(i,k,soax_ndx) = soax_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(soax_ndx)*xhnm(i,k)) + vmr(i,k,sogm_ndx) = sogm_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(sogm_ndx)*xhnm(i,k)) + vmr(i,k,sogi_ndx) = sogi_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(sogi_ndx)*xhnm(i,k)) + vmr(i,k,sogt_ndx) = sogt_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(sogt_ndx)*xhnm(i,k)) + vmr(i,k,sogb_ndx) = sogb_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(sogb_ndx)*xhnm(i,k)) + vmr(i,k,sogx_ndx) = sogx_mass(i,k) * 1.e-12_r8 * avogadro/(adv_mass(sogx_ndx)*xhnm(i,k)) + enddo + enddo + ! + call outfld('SOAM_PROD',soam_prod(:ncol,:),ncol, lchnk) + call outfld('SOAI_PROD',soai_prod(:ncol,:),ncol, lchnk) + call outfld('SOAT_PROD',soat_prod(:ncol,:),ncol, lchnk) + call outfld('SOAB_PROD',soab_prod(:ncol,:),ncol, lchnk) + call outfld('SOAX_PROD',soax_prod(:ncol,:),ncol, lchnk) + + call outfld('SOAM_dens',soam_mass(:ncol,:), ncol, lchnk) + call outfld('SOAI_dens',soai_mass(:ncol,:), ncol, lchnk) + call outfld('SOAT_dens',soat_mass(:ncol,:), ncol, lchnk) + call outfld('SOAB_dens',soab_mass(:ncol,:), ncol, lchnk) + call outfld('SOAX_dens',soax_mass(:ncol,:), ncol, lchnk) + + ! + ! + return + end subroutine setsoa_equil + + !=============================================================================== + !=============================================================================== + real(r8) function zeroin(x1,x2,tol,poa,aer,gas,k,totorg,iter) + ! function to iteratively solve function using bilinear method + ! + implicit none + ! + integer :: iter + real(r8),intent(in) :: x1, x2 ! min/max of interval + real(r8),intent(in) :: tol ! tolerance (interval of uncertainty) + real(r8),intent(in) :: poa,totorg + real(r8),intent(in) :: aer(NRX,NPR), gas(NRX,NPR) ! aerosol and gas phase concentrations + real(r8),intent(in) :: k(NRX,NPR) ! partitioning coeff + ! local vars + real(r8) :: xa,xb,xm,fa,fb,fm + ! + xa=x1 + xb=x2 + xm=0._r8 + fa=soa_function(xa,poa,aer,gas,k) + fb=soa_function(xb,poa,aer,gas,k) + ! + ! check that functions have opposite signs + if (fa >= 0._r8) then + if (fb >=0._r8) then + write(iulog,*) 'ABORT IN ZEROIN: SAME SIGN ON FUNCTION',poa,totorg,x1,x2,fa,fb,aer,gas,k + write(iulog,*) 'ABORT IN ZEROIN: ERROR1: fa, fb ',fa, fb + write(iulog,*) 'ABORT IN ZEROIN: ERROR1: maxval(aer),minval(aer),maxval(gas),minval(gas) ',& + maxval(aer),minval(aer),maxval(gas),minval(gas) + call endrun('ABORT IN ZEROIN: ERROR1') + end if + else + if (fb <=0._r8) then + write(iulog,*) 'ABORT IN ZEROIN: SAME SIGN ON FUNCTION',poa,totorg,x1,x2,fa,fb,aer,gas,k + write(iulog,*) 'ABORT IN ZEROIN: ERROR2: fa, fb ',fa, fb + write(iulog,*) 'ABORT IN ZEROIN: ERROR2: maxval(aer),minval(aer),maxval(gas),minval(gas) ',& + maxval(aer),minval(aer),maxval(gas),minval(gas) + call endrun('ABORT IN ZEROIN: ERROR2') + end if + end if + ! + iter=0 + do while ((abs(xa-xb) > 2._r8*tol) .and. (abs(xa-xb) > 0.01_r8*xm) ) + xm=(xa+xb)/2 + fm=soa_function(xm,poa,aer,gas,k) + if (fa >=0._r8) then + if (fm >=0._r8) then + xa=xm + fa=fm + else + xb=xm + fb=fm + end if + else + if (fm < 0._r8) then + xa=xm + fa=fm + else + xb=xm + fb=fm + end if + end if + iter=iter+1 + enddo + ! + zeroin = (xa+xb)/2 + ! + return + end function zeroin + !=============================================================================== + !=============================================================================== + real(r8) function soa_function(m0,poa,aer,gas,k) + ! function which calculates SOAeqn (trying to minimize to zero) + ! + implicit none + ! + real(r8),intent(in) :: m0,poa + real(r8),intent(in) :: aer(NRX,NPR), gas(NRX,NPR) ! aerosol and gas phase concentrations + real(r8),intent(in) :: k(NRX,NPR) ! partitioning coeff + ! local vars + integer :: n,p + real(r8) :: value + ! + value=0._r8 + ! + do n=1,NRX + do p=1,NPR + value = value + k(n,p)*(gas(n,p)+aer(n,p))/(1._r8 + k(n,p)*m0) + enddo + enddo + soa_function = value + (poa/m0) - 1._r8 + ! + ! write(iulog,*) 'clh soa_function out: ',m0,soa_function + return + end function soa_function + !=============================================================================== + +end module mo_setsoa diff --git a/src/chemistry/bulk_aero/seasalt_model.F90 b/src/chemistry/bulk_aero/seasalt_model.F90 new file mode 100644 index 0000000000..0d16d40e57 --- /dev/null +++ b/src/chemistry/bulk_aero/seasalt_model.F90 @@ -0,0 +1,131 @@ +!=============================================================================== +! Seasalt for Bulk Aerosol Model +!=============================================================================== +module seasalt_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use ppgrid, only: pcols, pver + + implicit none + private + + public :: seasalt_nbin + public :: seasalt_nnum + public :: seasalt_names + public :: seasalt_indices + public :: seasalt_init + public :: seasalt_emis + public :: seasalt_active + + public :: seasalt_depvel + + logical :: seasalt_active = .false. + + integer, parameter :: seasalt_nbin = 4 + integer, parameter :: seasalt_nnum = 0 + + character(len=6), parameter :: seasalt_names(seasalt_nbin) & + = (/'SSLT01', 'SSLT02', 'SSLT03', 'SSLT04'/) + + integer :: seasalt_indices(seasalt_nbin) + + contains + + !============================================================================= + !============================================================================= + subroutine seasalt_init + use cam_history, only: addfld, fieldname_len + use constituents, only: cnst_get_ind + + character(len=fieldname_len) :: dummy + integer :: m + + do m = 1, seasalt_nbin + call cnst_get_ind(seasalt_names(m), seasalt_indices(m),abort=.false.) + enddo + seasalt_active = any(seasalt_indices(:) > 0) + + if (.not.seasalt_active) return + + dummy = 'RH' + call addfld (dummy,(/ 'lev' /), 'A','frac','RH in dry dep calc') + do m = 1,seasalt_nbin + dummy = trim(seasalt_names(m)) // 'DI' + call addfld (dummy,(/ 'lev' /), 'A','m/s',trim(seasalt_names(m))//' deposition diameter') + enddo + + end subroutine seasalt_init + + !============================================================================= + !============================================================================= + subroutine seasalt_emis( u10cubed, srf_temp, ocnfrc, ncol, cflx ) + + ! dummy arguments + real(r8), intent(in) :: u10cubed(:) + real(r8), intent(in) :: srf_temp(:) + real(r8), intent(in) :: ocnfrc(:) + integer, intent(in) :: ncol + real(r8), intent(inout) :: cflx(:,:) + + ! local vars + integer :: ix,m + real(r8), parameter :: sslt_source(seasalt_nbin) = (/ 4.77e-15_r8, 5.19e-14_r8, 1.22e-13_r8, 6.91e-14_r8 /) + + do m = 1, seasalt_nbin + ix = seasalt_indices(m) + cflx(:ncol,ix) = sslt_source(m) * u10cubed(:ncol) * ocnfrc(:ncol) + enddo + + end subroutine seasalt_emis + + !============================================================================= + !============================================================================= + subroutine seasalt_depvel( temp, pmid, q, ram1, fv, ncol, lchnk, vlc_dry,vlc_trb,vlc_grv ) + use aerosol_depvel, only: aerosol_depvel_compute + use wv_saturation, only: qsat + use cam_history, only: outfld + use mo_constants, only: dns_aer_sst=>seasalt_density + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: temp(:,:) ! temperature + real(r8), intent(in) :: pmid(:,:) ! mid point pressure + real(r8), intent(in) :: q(:,:) ! water vapor + real(r8), intent(in) :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), intent(in) :: fv(:) ! friction velocity (m/s) + + real(r8), intent(out) :: vlc_trb(:,:) !Turbulent deposn velocity (m/s) + real(r8), intent(out) :: vlc_grv(:,:,:) !grav deposn velocity (m/s) + real(r8), intent(out) :: vlc_dry(:,:,:) !dry deposn velocity (m/s) + + real(r8) :: r + real(r8) :: wetdia(pcols,pver,seasalt_nbin) + real(r8) :: RH(pcols,pver),es(pcols,pver),qs(pcols,pver) ! for wet radius calculation + real(r8),parameter:: c1=0.7674_r8, c2=3.0790_r8, c3=2.57e-11_r8,c4=-1.424_r8 ! wet radius calculation constants + integer :: m, i,k + + ! set stokes correction to 1.0 for now not a bad assumption for our size range) + real(r8), parameter :: sslt_stk_crc(seasalt_nbin) = (/ 1.0_r8, 1.0_r8, 1.0_r8, 1.0_r8 /) + real(r8), parameter :: sslt_smt_vwr(seasalt_nbin) = (/0.52e-6_r8,2.38e-6_r8,4.86e-6_r8,15.14e-6_r8/) + + !----------------------------------------------------------------------- + + call qsat(temp(:ncol,:),pmid(:ncol,:),es(:ncol,:),qs(:ncol,:)) + RH(:ncol,:)=q(:ncol,:)/qs(:ncol,:) + RH(:ncol,:)=max(0.01_r8,min(0.99_r8,RH(:ncol,:))) + ! set stokes correction to 1.0 for now not a bad assumption for our size range) + do m=1,seasalt_nbin + r=sslt_smt_vwr(m)/2.0_r8 + do k=1,pver + do i=1,ncol + wetdia(i,k,m)=((r**3+c1*r**c2/(c3*r**c4-log(RH(i,k))))**(1._r8/3._r8))*2.0_r8 + enddo + enddo + call outfld( trim(seasalt_names(m))//'DI',wetdia(:,:,m), pcols, lchnk) + enddo + call outfld( 'RH',RH(:,:), pcols, lchnk) + + call aerosol_depvel_compute( ncol, pver, seasalt_nbin, temp, pmid, ram1, fv, wetdia, sslt_stk_crc, dns_aer_sst, & + vlc_dry,vlc_trb,vlc_grv) + + endsubroutine seasalt_depvel + +end module seasalt_model diff --git a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 new file mode 100644 index 0000000000..de475209d7 --- /dev/null +++ b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 @@ -0,0 +1,141 @@ +!---------------------------------------------------------------------------------- +! Bulk aerosol implementation +!---------------------------------------------------------------------------------- +module sox_cldaero_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_so2, id_so4, id_h2o2 + + real(r8), parameter :: small_value = 1.e-20_r8 + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + id_so2 = get_spc_ndx( 'SO2' ) + id_so4 = get_spc_ndx( 'SO4' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + + if ( id_so2<1 ) then + call endrun('sox_cldaero_init: SO2 is not included in chemistry -- should not invoke sox_cldaero_mod...') + endif + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + type(cldaero_conc_t), pointer :: conc_obj + + conc_obj => cldaero_allocate() + + conc_obj%xlwc(:ncol,:) = lwc(:ncol,:)*cfact(:ncol,:) ! cloud water L(water)/L(air) + + end function sox_cldaero_create_obj + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( & + ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d ) + + ! args + + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + ! local vars ... + + integer :: k + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + do k = 1,pver + + if (id_so2>0) then + qin(:,k,id_so2) = MAX( xso2(:,k), small_value ) + endif + if (id_h2o2>0) then + qin(:,k,id_h2o2)= MAX( xh2o2(:,k), small_value ) + endif + + qin(:,k,id_so4) = MAX( xso4(:,k), small_value ) + + end do + + end subroutine sox_cldaero_update + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module sox_cldaero_mod diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 new file mode 100644 index 0000000000..2ad9686a70 --- /dev/null +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -0,0 +1,2784 @@ +!=============================================================================== +! Modal Aerosol Model +!=============================================================================== +module aero_model + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst, cnst_name, cnst_get_ind + use ppgrid, only: pcols, pver, pverp + use phys_control, only: phys_getopts, cam_physpkg_is + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use perf_mod, only: t_startf, t_stopf + use camsrfexch, only: cam_in_t, cam_out_t + use aerodep_flx, only: aerodep_flx_prescribed + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc + use physics_buffer, only: pbuf_get_field, pbuf_get_index, pbuf_set_field + use physconst, only: gravit, rair, rhoh2o + use spmd_utils, only: masterproc + use infnan, only: nan, assignment(=) + + use cam_history, only: outfld, fieldname_len + use chem_mods, only: gas_pcnst, adv_mass + use mo_tracname, only: solsym + + use modal_aero_data,only: cnst_name_cw, lptr_so4_cw_amode + use modal_aero_data,only: ntot_amode, modename_amode, nspec_max + + use ref_pres, only: top_lev => clim_modal_aero_top_lev + + use modal_aero_wateruptake, only: modal_strat_sulfate + use mo_setsox, only: setsox, has_sox + + implicit none + private + + public :: aero_model_readnl + public :: aero_model_register + public :: aero_model_init + public :: aero_model_gasaerexch ! create, grow, change, and shrink aerosols. + public :: aero_model_drydep ! aerosol dry deposition and sediment + public :: aero_model_wetdep ! aerosol wet removal + public :: aero_model_emissions ! aerosol emissions + public :: aero_model_surfarea ! tropopspheric aerosol wet surface area for chemistry + public :: aero_model_strat_surfarea ! stratospheric aerosol wet surface area for chemistry + + public :: calc_1_impact_rate + public :: nimptblgrow_mind, nimptblgrow_maxd + + ! Accessor functions + public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow + + ! Misc private data + + ! number of modes + integer :: nmodes + integer :: pblh_idx = 0 + integer :: dgnum_idx = 0 + integer :: dgnumwet_idx = 0 + integer :: rate1_cw2pr_st_idx = 0 + + integer :: wetdens_ap_idx = 0 + integer :: qaerwat_idx = 0 + + integer :: fracis_idx = 0 + integer :: prain_idx = 0 + integer :: rprddp_idx = 0 + integer :: rprdsh_idx = 0 + integer :: nevapr_shcu_idx = 0 + integer :: nevapr_dpcu_idx = 0 + + integer :: sulfeq_idx = -1 + + integer :: nh3_ndx = 0 + integer :: nh4_ndx = 0 + + ! variables for table lookup of aerosol impaction/interception scavenging rates + integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12 + real(r8) :: dlndg_nimptblgrow + real(r8),allocatable :: scavimptblnum(:,:) + real(r8),allocatable :: scavimptblvol(:,:) + + ! for surf_area_dens + integer,allocatable :: num_idx(:) + integer,allocatable :: index_tot_mass(:,:) + integer,allocatable :: index_chm_mass(:,:) + + integer :: ndx_h2so4 + character(len=fieldname_len), allocatable :: dgnum_name(:), dgnumwet_name(:) + + ! Namelist variables + character(len=16) :: wetdep_list(pcnst) = ' ' + character(len=16) :: drydep_list(pcnst) = ' ' + real(r8) :: sol_facti_cloud_borne = 1._r8 + real(r8) :: sol_factb_interstitial = 0.1_r8 + real(r8) :: sol_factic_interstitial = 0.4_r8 + real(r8) :: seasalt_emis_scale + + integer :: ndrydep = 0 + integer,allocatable :: drydep_indices(:) + integer :: nwetdep = 0 + integer,allocatable :: wetdep_indices(:) + logical :: drydep_lq(pcnst) + logical :: wetdep_lq(pcnst) + + logical :: modal_accum_coarse_exch = .false. + + logical :: convproc_do_aer + +contains + + !============================================================================= + ! reads aerosol namelist options + !============================================================================= + subroutine aero_model_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_model_readnl' + + ! Namelist variables + character(len=16) :: aer_wetdep_list(pcnst) = ' ' + character(len=16) :: aer_drydep_list(pcnst) = ' ' + + namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list, sol_facti_cloud_borne, & + sol_factb_interstitial, sol_factic_interstitial, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale + + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom) + call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom) + call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom) + call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom) + call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom) + call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom) +#endif + + wetdep_list = aer_wetdep_list + drydep_list = aer_drydep_list + + end subroutine aero_model_readnl + + !============================================================================= + !============================================================================= + subroutine aero_model_register() + use modal_aero_data, only: modal_aero_data_reg + + call modal_aero_data_reg() + + end subroutine aero_model_register + + !============================================================================= + !============================================================================= + subroutine aero_model_init( pbuf2d ) + + use mo_chem_utls, only: get_inv_ndx + use cam_history, only: addfld, add_default, horiz_only + use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx + use modal_aero_data, only: cnst_name_cw + use modal_aero_data, only: modal_aero_data_init + use rad_constituents,only: rad_cnst_get_info + use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum + use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin + use drydep_mod, only: inidrydep + use wetdep, only: wetdep_init + + use modal_aero_calcsize, only: modal_aero_calcsize_init + use modal_aero_coag, only: modal_aero_coag_init + use modal_aero_deposition, only: modal_aero_deposition_init + use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init + use modal_aero_newnuc, only: modal_aero_newnuc_init + use modal_aero_rename, only: modal_aero_rename_init + use modal_aero_convproc, only: ma_convproc_init + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + character(len=*), parameter :: subrname = 'aero_model_init' + integer :: m, n, id + character(len=20) :: dummy + + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + logical :: history_chemistry, history_cesm_forcing + + integer :: l + character(len=6) :: test_name + character(len=64) :: errmes + + character(len=2) :: unit_basename ! Units 'kg' or '1' + integer :: errcode + character(len=fieldname_len) :: field_name + + character(len=32) :: spec_name + character(len=32) :: spec_type + character(len=32) :: mode_type + integer :: nspec + + dgnum_idx = pbuf_get_index('DGNUM') + dgnumwet_idx = pbuf_get_index('DGNUMWET') + fracis_idx = pbuf_get_index('FRACIS') + prain_idx = pbuf_get_index('PRAIN') + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + sulfeq_idx = pbuf_get_index('MAMH2SO4EQ',errcode) + + call phys_getopts(history_aerosol_out = history_aerosol, & + history_chemistry_out=history_chemistry, & + history_cesm_forcing_out=history_cesm_forcing, & + convproc_do_aer_out = convproc_do_aer) + + call rad_cnst_get_info(0, nmodes=nmodes) + + call modal_aero_data_init(pbuf2d) + call modal_aero_bcscavcoef_init() + + call modal_aero_rename_init( modal_accum_coarse_exch ) + ! calcsize call must follow rename call + call modal_aero_calcsize_init( pbuf2d ) + call modal_aero_gasaerexch_init + ! coag call must follow gasaerexch call + call modal_aero_coag_init + call modal_aero_newnuc_init + + ! call modal_aero_deposition_init only if the user has not specified + ! prescribed aerosol deposition fluxes + if (.not.aerodep_flx_prescribed()) then + call modal_aero_deposition_init + endif + + if (convproc_do_aer) then + call ma_convproc_init() + endif + + call dust_init() + call seasalt_init(seasalt_emis_scale) + call wetdep_init() + + nwetdep = 0 + ndrydep = 0 + + count_species: do m = 1,pcnst + if ( len_trim(wetdep_list(m)) /= 0 ) then + nwetdep = nwetdep+1 + endif + if ( len_trim(drydep_list(m)) /= 0 ) then + ndrydep = ndrydep+1 + endif + enddo count_species + + if (nwetdep>0) & + allocate(wetdep_indices(nwetdep)) + if (ndrydep>0) & + allocate(drydep_indices(ndrydep)) + + do m = 1,ndrydep + call cnst_get_ind ( drydep_list(m), id, abort=.false. ) + if (id>0) then + drydep_indices(m) = id + else + call endrun(subrname//': invalid drydep species: '//trim(drydep_list(m)) ) + endif + + if (masterproc) then + write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' + endif + enddo + do m = 1,nwetdep + call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) + if (id>0) then + wetdep_indices(m) = id + else + call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) + endif + + if (masterproc) then + write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' + endif + enddo + + if (ndrydep>0) then + + call inidrydep(rair, gravit) + + dummy = 'RAM1' + call addfld (dummy,horiz_only, 'A','frac','RAM1') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + dummy = 'airFV' + call addfld (dummy,horiz_only, 'A','frac','FV') + if ( history_aerosol ) then + call add_default (dummy, 1, ' ') + endif + + endif + + if (dust_active) then + ! emissions diagnostics .... + + do m = 1, dust_nbin+dust_nnum + dummy = trim(dust_names(m)) // 'SF' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(dust_names(m))//' dust surface emission') + if (history_aerosol.or.history_chemistry) then + call add_default (dummy, 1, ' ') + endif + enddo + + dummy = 'DSTSFMBL' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + dummy = 'LND_MBL' + call addfld (dummy,horiz_only, 'A','frac','Soil erodibility factor') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + endif + + if (seasalt_active) then + + dummy = 'SSTSFMBL' + call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + if (history_aerosol) then + call add_default (dummy, 1, ' ') + endif + + do m = 1, seasalt_nbin + dummy = trim(seasalt_names(m)) // 'SF' + call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(seasalt_names(m))//' seasalt surface emission') + if (history_aerosol.or.history_chemistry) then + call add_default (dummy, 1, ' ') + endif + enddo + + endif + + + ! set flags for drydep tendencies + drydep_lq(:) = .false. + do m=1,ndrydep + id = drydep_indices(m) + drydep_lq(id) = .true. + enddo + + ! set flags for wetdep tendencies + wetdep_lq(:) = .false. + do m=1,nwetdep + id = wetdep_indices(m) + wetdep_lq(id) = .true. + enddo + + wetdens_ap_idx = pbuf_get_index('WETDENS_AP') + qaerwat_idx = pbuf_get_index('QAERWAT') + pblh_idx = pbuf_get_index('pblh') + + rate1_cw2pr_st_idx = pbuf_get_index('RATE1_CW2PR_ST') + call pbuf_set_field(pbuf2d, rate1_cw2pr_st_idx, 0.0_r8) + + do m = 1,ndrydep + + ! units + if (drydep_list(m)(1:3) == 'num') then + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + call addfld (trim(drydep_list(m))//'DDF', horiz_only, 'A',unit_basename//'/m2/s ', & + trim(drydep_list(m))//' dry deposition flux at bottom (grav + turb)') + call addfld (trim(drydep_list(m))//'TBF', horiz_only, 'A',unit_basename//'/m2/s', & + trim(drydep_list(m))//' turbulent dry deposition flux') + call addfld (trim(drydep_list(m))//'GVF', horiz_only, 'A',unit_basename//'/m2/s ', & + trim(drydep_list(m))//' gravitational dry deposition flux') + call addfld (trim(drydep_list(m))//'DTQ', (/ 'lev' /), 'A',unit_basename//'/kg/s ', & + trim(drydep_list(m))//' dry deposition') + call addfld (trim(drydep_list(m))//'DDV', (/ 'lev' /), 'A','m/s', & + trim(drydep_list(m))//' deposition velocity') + + if ( history_aerosol.or.history_chemistry ) then + call add_default (trim(drydep_list(m))//'DDF', 1, ' ') + endif + if ( history_aerosol ) then + call add_default (trim(drydep_list(m))//'TBF', 1, ' ') + call add_default (trim(drydep_list(m))//'GVF', 1, ' ') + endif + + enddo + + do m = 1,nwetdep + + ! units + if (wetdep_list(m)(1:3) == 'num') then + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + call addfld (trim(wetdep_list(m))//'SFWET', & + horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux at surface') + call addfld (trim(wetdep_list(m))//'SFSIC', & + horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, convective) at surface') + call addfld (trim(wetdep_list(m))//'SFSIS', & + horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface') + call addfld (trim(wetdep_list(m))//'SFSBC', & + horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface') + call addfld (trim(wetdep_list(m))//'SFSBS', & + horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface') + + if (convproc_do_aer) then + call addfld (trim(wetdep_list(m))//'SFSES', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') + call addfld (trim(wetdep_list(m))//'SFSBD', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') + end if + + call addfld (trim(wetdep_list(m))//'WET',(/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') + call addfld (trim(wetdep_list(m))//'SIC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & + trim(wetdep_list(m))//' ic wet deposition') + call addfld (trim(wetdep_list(m))//'SIS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & + trim(wetdep_list(m))//' is wet deposition') + call addfld (trim(wetdep_list(m))//'SBC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & + trim(wetdep_list(m))//' bc wet deposition') + call addfld (trim(wetdep_list(m))//'SBS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & + trim(wetdep_list(m))//' bs wet deposition') + + if ( history_aerosol .or. history_chemistry ) then + call add_default (trim(wetdep_list(m))//'SFWET', 1, ' ') + endif + if ( history_aerosol ) then + call add_default (trim(wetdep_list(m))//'SFSIC', 1, ' ') + call add_default (trim(wetdep_list(m))//'SFSIS', 1, ' ') + call add_default (trim(wetdep_list(m))//'SFSBC', 1, ' ') + call add_default (trim(wetdep_list(m))//'SFSBS', 1, ' ') + if (convproc_do_aer) then + call add_default (trim(wetdep_list(m))//'SFSES', 1, ' ') + call add_default (trim(wetdep_list(m))//'SFSBD', 1, ' ') + end if + endif + + enddo + + do m = 1,gas_pcnst + + if ( solsym(m)(1:3) == 'num') then + unit_basename = ' 1' ! Units 'kg' or '1' + else + unit_basename = 'kg' ! Units 'kg' or '1' + end if + + call addfld( 'GS_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & + trim(solsym(m))//' gas chemistry/wet removal (for gas species)') + call addfld( 'AQ_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & + trim(solsym(m))//' aqueous chemistry (for gas species)') + if ( history_aerosol ) then + call add_default( 'AQ_'//trim(solsym(m)), 1, ' ') + endif + + enddo + do n = 1,pcnst + if( .not. (cnst_name_cw(n) == ' ') ) then + + if (cnst_name_cw(n)(1:3) == 'num') then + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + call addfld( cnst_name_cw(n), (/ 'lev' /), 'A', unit_basename//'/kg ', & + trim(cnst_name_cw(n))//' in cloud water') + call addfld (trim(cnst_name_cw(n))//'SFWET', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' wet deposition flux at surface') + call addfld (trim(cnst_name_cw(n))//'SFSIC', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' wet deposition flux (incloud, convective) at surface') + call addfld (trim(cnst_name_cw(n))//'SFSIS', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' wet deposition flux (incloud, stratiform) at surface') + call addfld (trim(cnst_name_cw(n))//'SFSBC', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, convective) at surface') + call addfld (trim(cnst_name_cw(n))//'SFSBS', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, stratiform) at surface') + call addfld (trim(cnst_name_cw(n))//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' dry deposition flux at bottom (grav + turb)') + call addfld (trim(cnst_name_cw(n))//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' turbulent dry deposition flux') + call addfld (trim(cnst_name_cw(n))//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(cnst_name_cw(n))//' gravitational dry deposition flux') + + if (convproc_do_aer) then + call addfld (trim(cnst_name_cw(n))//'SFSEC', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') + call addfld (trim(cnst_name_cw(n))//'SFSES', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') + call addfld (trim(cnst_name_cw(n))//'SFSBD', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') + end if + + + if ( history_aerosol.or. history_chemistry ) then + call add_default( cnst_name_cw(n), 1, ' ' ) + call add_default (trim(cnst_name_cw(n))//'SFWET', 1, ' ') + endif + if ( history_aerosol ) then + call add_default (trim(cnst_name_cw(n))//'GVF', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'TBF', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'DDF', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSBS', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSIC', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSBC', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSIS', 1, ' ') + if (convproc_do_aer) then + call add_default (trim(cnst_name_cw(n))//'SFSEC', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSES', 1, ' ') + call add_default (trim(cnst_name_cw(n))//'SFSBD', 1, ' ') + end if + endif + endif + enddo + + allocate(dgnum_name(ntot_amode), dgnumwet_name(ntot_amode)) + do n=1,ntot_amode + dgnum_name(n) = ' ' + dgnumwet_name(n) = ' ' + write(dgnum_name(n),fmt='(a,i1)') 'dgnum',n + write(dgnumwet_name(n),fmt='(a,i1)') 'dgnumwet',n + call addfld( dgnum_name(n), (/ 'lev' /), 'I', 'm', 'Aerosol mode dry diameter' ) + call addfld( dgnumwet_name(n), (/ 'lev' /), 'I', 'm', 'Aerosol mode wet diameter' ) + if ( history_aerosol ) then + call add_default( dgnum_name(n), 1, ' ' ) + call add_default( dgnumwet_name(n), 1, ' ' ) + endif + if ( history_cesm_forcing .and. n<4 ) then + call add_default( dgnumwet_name(n), 8, ' ' ) + endif + + if (modal_strat_sulfate) then + field_name = ' ' + write(field_name,fmt='(a,i1)') 'wtpct_a',n + call addfld( field_name, (/ 'lev' /), 'I', '%', 'Aerosol mode weight percent H2SO4' ) + if ( history_aerosol ) then + call add_default (field_name, 0, 'I') + endif + + field_name = ' ' + write(field_name,fmt='(a,i1)') 'sulfeq_a',n + call addfld( field_name, (/ 'lev' /), 'I', 'kg/kg', 'H2SO4 equilibrium mixing ratio' ) + if ( history_aerosol ) then + call add_default (field_name, 0, 'I') + endif + + field_name = ' ' + write(field_name,fmt='(a,i1)') 'sulden_a',n + call addfld( field_name, (/ 'lev' /), 'I', 'g/cm3', 'Sulfate aerosol particle mass density' ) + if ( history_aerosol ) then + call add_default (field_name, 0, 'I') + endif + + end if + end do + + ndx_h2so4 = get_spc_ndx('H2SO4') + nh3_ndx = get_spc_ndx('NH3') + nh4_ndx = get_spc_ndx('NH4') + + allocate(num_idx(ntot_amode)) + num_idx = -1 + + ! for aero_model_surfarea called from mo_usrrxt + do l=1,ntot_amode + test_name = ' ' + write(test_name,fmt='(a5,i1)') 'num_a',l + num_idx(l) = get_spc_ndx( trim(test_name) ) + if (num_idx(l) < 0) then + write(errmes,fmt='(a,i1)') 'usrrxt_inti: cannot find MAM num_idx ',l + write(iulog,*) errmes + call endrun(errmes) + endif + end do + + allocate(index_tot_mass(nmodes,nspec_max)) + allocate(index_chm_mass(nmodes,nspec_max)) + index_tot_mass = -1 + index_chm_mass = -1 + + ! for surf_area_dens + ! define indeces associated with the various aerosol types + do n = 1,nmodes + call rad_cnst_get_info(0, n, mode_type=mode_type, nspec=nspec) + if ( trim(mode_type) /= 'primary_carbon') then ! ignore the primary_carbon mode + do l = 1, nspec + call rad_cnst_get_info(0, n, l, spec_type=spec_type, spec_name=spec_name) + index_tot_mass(n,l) = get_spc_ndx(spec_name) + if ( trim(spec_type) == 'sulfate' .or. & + trim(spec_type) == 's-organic' .or. & + trim(spec_type) == 'black-c' .or. & + trim(spec_type) == 'ammonium') then + index_chm_mass(n,l) = get_spc_ndx(spec_name) + endif + enddo + endif + enddo + + if (has_sox) then + do m = 1, ntot_amode + + l = lptr_so4_cw_amode(m) + if (l > 0) then + call addfld (& + trim(cnst_name_cw(l))//'AQSO4',horiz_only, 'A','kg/m2/s', & + trim(cnst_name_cw(l))//' aqueous phase chemistry') + call addfld (& + trim(cnst_name_cw(l))//'AQH2SO4',horiz_only, 'A','kg/m2/s', & + trim(cnst_name_cw(l))//' aqueous phase chemistry') + if ( history_aerosol ) then + call add_default (trim(cnst_name_cw(l))//'AQSO4', 1, ' ') + call add_default (trim(cnst_name_cw(l))//'AQH2SO4', 1, ' ') + endif + end if + + end do + + call addfld( 'XPH_LWC', (/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc') + call addfld ('AQSO4_H2O2', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to H2O2') + call addfld ('AQSO4_O3', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to O3') + + if ( history_aerosol ) then + call add_default ('XPH_LWC', 1, ' ') + call add_default ('AQSO4_H2O2', 1, ' ') + call add_default ('AQSO4_O3', 1, ' ') + endif + endif + + end subroutine aero_model_init + + !============================================================================= + !============================================================================= + subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) + + use dust_sediment_mod, only: dust_sediment_tend + use drydep_mod, only: d3ddflux, calcram + use modal_aero_data, only: qqcw_get_field + use modal_aero_data, only: cnst_name_cw + use modal_aero_data, only: alnsg_amode + use modal_aero_data, only: sigmag_amode + use modal_aero_data, only: nspec_amode + use modal_aero_data, only: numptr_amode + use modal_aero_data, only: numptrcw_amode + use modal_aero_data, only: lmassptr_amode + use modal_aero_data, only: lmassptrcw_amode + use modal_aero_deposition, only: set_srf_drydep + + ! args + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: obklen(:) + real(r8), intent(in) :: ustar(:) ! sfc fric vel + type(cam_in_t), target, intent(in) :: cam_in ! import state + real(r8), intent(in) :: dt ! time step + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + real(r8), pointer :: landfrac(:) ! land fraction + real(r8), pointer :: icefrac(:) ! ice fraction + real(r8), pointer :: ocnfrac(:) ! ocean fraction + real(r8), pointer :: fvin(:) ! + real(r8), pointer :: ram1in(:) ! for dry dep velocities from land model for progseasalts + + real(r8) :: fv(pcols) ! for dry dep velocities, from land modified over ocean & ice + real(r8) :: ram1(pcols) ! for dry dep velocities, from land modified over ocean & ice + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: jvlc ! index for last dimension of vlc_xxx arrays + integer :: lphase ! index for interstitial / cloudborne aerosol + integer :: lspec ! index for aerosol number / chem-mass / water-mass + integer :: m ! aerosol mode index + integer :: mm ! tracer index + integer :: i + + real(r8) :: tvs(pcols,pver) + real(r8) :: rho(pcols,pver) ! air density in kg/m3 + real(r8) :: sflx(pcols) ! deposition flux + real(r8) :: dep_trb(pcols) !kg/m2/s + real(r8) :: dep_grv(pcols) !kg/m2/s (total of grav and trb) + real(r8) :: pvmzaer(pcols,pverp) ! sedimentation velocity in Pa + real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species + + real(r8) :: rad_drop(pcols,pver) + real(r8) :: dens_drop(pcols,pver) + real(r8) :: sg_drop(pcols,pver) + real(r8) :: rad_aer(pcols,pver) + real(r8) :: dens_aer(pcols,pver) + real(r8) :: sg_aer(pcols,pver) + + real(r8) :: vlc_dry(pcols,pver,4) ! dep velocity + real(r8) :: vlc_grv(pcols,pver,4) ! dep velocity + real(r8):: vlc_trb(pcols,4) ! dep velocity + real(r8) :: aerdepdryis(pcols,pcnst) ! aerosol dry deposition (interstitial) + real(r8) :: aerdepdrycw(pcols,pcnst) ! aerosol dry deposition (cloud water) + real(r8), pointer :: fldcw(:,:) + real(r8), pointer :: dgncur_awet(:,:,:) + real(r8), pointer :: wetdens(:,:,:) + real(r8), pointer :: qaerwat(:,:,:) + + landfrac => cam_in%landfrac(:) + icefrac => cam_in%icefrac(:) + ocnfrac => cam_in%ocnfrac(:) + fvin => cam_in%fv(:) + ram1in => cam_in%ram1(:) + + lchnk = state%lchnk + ncol = state%ncol + + ! calc ram and fv over ocean and sea ice ... + call calcram( ncol,landfrac,icefrac,ocnfrac,obklen,& + ustar,ram1in,ram1,state%t(:,pver),state%pmid(:,pver),& + state%pdel(:,pver),fvin,fv) + + call outfld( 'airFV', fv(:), pcols, lchnk ) + call outfld( 'RAM1', ram1(:), pcols, lchnk ) + + ! note that tendencies are not only in sfc layer (because of sedimentation) + ! and that ptend is updated within each subroutine for different species + + call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq) + + call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + + tvs(:ncol,:) = state%t(:ncol,:)!*(1+state%q(:ncol,k) + rho(:ncol,:)= state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + +! +! calc settling/deposition velocities for cloud droplets (and cloud-borne aerosols) +! +! *** mean drop radius should eventually be computed from ndrop and qcldwtr + rad_drop(:,:) = 5.0e-6_r8 + dens_drop(:,:) = rhoh2o + sg_drop(:,:) = 1.46_r8 + jvlc = 3 + call modal_aero_depvel_part( ncol,state%t(:,:), state%pmid(:,:), ram1, fv, & + vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & + rad_drop(:,:), dens_drop(:,:), sg_drop(:,:), 0, lchnk) + jvlc = 4 + call modal_aero_depvel_part( ncol,state%t(:,:), state%pmid(:,:), ram1, fv, & + vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & + rad_drop(:,:), dens_drop(:,:), sg_drop(:,:), 3, lchnk) + + + + do m = 1, ntot_amode ! main loop over aerosol modes + + do lphase = 1, 2 ! loop over interstitial / cloud-borne forms + + if (lphase == 1) then ! interstial aerosol - calc settling/dep velocities of mode + +! rad_aer = volume mean wet radius (m) +! dgncur_awet = geometric mean wet diameter for number distribution (m) + rad_aer(1:ncol,:) = 0.5_r8*dgncur_awet(1:ncol,:,m) & + *exp(1.5_r8*(alnsg_amode(m)**2)) +! dens_aer(1:ncol,:) = wet density (kg/m3) + dens_aer(1:ncol,:) = wetdens(1:ncol,:,m) + sg_aer(1:ncol,:) = sigmag_amode(m) + + jvlc = 1 + call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & + vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & + rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 0, lchnk) + jvlc = 2 + call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & + vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & + rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 3, lchnk) + end if + + do lspec = 0, nspec_amode(m)+1 ! loop over number + constituents + water + + if (lspec == 0) then ! number + if (lphase == 1) then + mm = numptr_amode(m) + jvlc = 1 + else + mm = numptrcw_amode(m) + jvlc = 3 + endif + else if (lspec <= nspec_amode(m)) then ! non-water mass + if (lphase == 1) then + mm = lmassptr_amode(lspec,m) + jvlc = 2 + else + mm = lmassptrcw_amode(lspec,m) + jvlc = 4 + endif + else ! water mass +! bypass dry deposition of aerosol water + cycle + if (lphase == 1) then + mm = 0 +! mm = lwaterptr_amode(m) + jvlc = 2 + else + mm = 0 + jvlc = 4 + endif + endif + + + if (mm <= 0) cycle + +! if (lphase == 1) then + if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then + ptend%lq(mm) = .TRUE. + + ! use pvprogseasalts instead (means making the top level 0) + pvmzaer(:ncol,1)=0._r8 + pvmzaer(:ncol,2:pverp) = vlc_dry(:ncol,:,jvlc) + + call outfld( trim(cnst_name(mm))//'DDV', pvmzaer(:,2:pverp), pcols, lchnk ) + + if(.true.) then ! use phil's method + ! convert from meters/sec to pascals/sec + ! pvprogseasalts(:,1) is assumed zero, use density from layer above in conversion + pvmzaer(:ncol,2:pverp) = pvmzaer(:ncol,2:pverp) * rho(:ncol,:)*gravit + + ! calculate the tendencies and sfc fluxes from the above velocities + call dust_sediment_tend( & + ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & + state%q(:,:,mm), pvmzaer, ptend%q(:,:,mm), sflx ) + else !use charlie's method + call d3ddflux( ncol, vlc_dry(:,:,jvlc), state%q(:,:,mm), state%pmid, & + state%pdel, tvs, sflx, ptend%q(:,:,mm), dt ) + endif + + ! apportion dry deposition into turb and gravitational settling for tapes + dep_trb = 0._r8 + dep_grv = 0._r8 + do i=1,ncol + if (vlc_dry(i,pver,jvlc) /= 0._r8) then + dep_trb(i)=sflx(i)*vlc_trb(i,jvlc)/vlc_dry(i,pver,jvlc) + dep_grv(i)=sflx(i)*vlc_grv(i,pver,jvlc)/vlc_dry(i,pver,jvlc) + end if + enddo + + call outfld( trim(cnst_name(mm))//'DDF', sflx, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'TBF', dep_trb, pcols, lchnk ) + call outfld( trim(cnst_name(mm))//'GVF', dep_grv, pcols, lchnk ) + call outfld( trim(cnst_name(mm))//'DTQ', ptend%q(:,:,mm), pcols, lchnk) + aerdepdryis(:ncol,mm) = sflx(:ncol) + + else if ((lphase == 1) .and. (lspec == nspec_amode(m)+1)) then ! aerosol water + ! use pvprogseasalts instead (means making the top level 0) + pvmzaer(:ncol,1)=0._r8 + pvmzaer(:ncol,2:pverp) = vlc_dry(:ncol,:,jvlc) + + if(.true.) then ! use phil's method + ! convert from meters/sec to pascals/sec + ! pvprogseasalts(:,1) is assumed zero, use density from layer above in conversion + pvmzaer(:ncol,2:pverp) = pvmzaer(:ncol,2:pverp) * rho(:ncol,:)*gravit + + ! calculate the tendencies and sfc fluxes from the above velocities + call dust_sediment_tend( & + ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & + qaerwat(:,:,mm), pvmzaer, dqdt_tmp(:,:), sflx ) + else !use charlie's method + call d3ddflux( ncol, vlc_dry(:,:,jvlc), qaerwat(:,:,mm), state%pmid, & + state%pdel, tvs, sflx, dqdt_tmp(:,:), dt ) + endif + + ! apportion dry deposition into turb and gravitational settling for tapes + dep_trb = 0._r8 + dep_grv = 0._r8 + do i=1,ncol + if (vlc_dry(i,pver,jvlc) /= 0._r8) then + dep_trb(i)=sflx(i)*vlc_trb(i,jvlc)/vlc_dry(i,pver,jvlc) + dep_grv(i)=sflx(i)*vlc_grv(i,pver,jvlc)/vlc_dry(i,pver,jvlc) + end if + enddo + + qaerwat(1:ncol,:,mm) = qaerwat(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) * dt + + else ! lphase == 2 + ! use pvprogseasalts instead (means making the top level 0) + pvmzaer(:ncol,1)=0._r8 + pvmzaer(:ncol,2:pverp) = vlc_dry(:ncol,:,jvlc) + fldcw => qqcw_get_field(pbuf, mm,lchnk) + + if(.true.) then ! use phil's method + ! convert from meters/sec to pascals/sec + ! pvprogseasalts(:,1) is assumed zero, use density from layer above in conversion + pvmzaer(:ncol,2:pverp) = pvmzaer(:ncol,2:pverp) * rho(:ncol,:)*gravit + + ! calculate the tendencies and sfc fluxes from the above velocities + call dust_sediment_tend( & + ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & + fldcw(:,:), pvmzaer, dqdt_tmp(:,:), sflx ) + else !use charlie's method + call d3ddflux( ncol, vlc_dry(:,:,jvlc), fldcw(:,:), state%pmid, & + state%pdel, tvs, sflx, dqdt_tmp(:,:), dt ) + endif + + ! apportion dry deposition into turb and gravitational settling for tapes + dep_trb = 0._r8 + dep_grv = 0._r8 + do i=1,ncol + if (vlc_dry(i,pver,jvlc) /= 0._r8) then + dep_trb(i)=sflx(i)*vlc_trb(i,jvlc)/vlc_dry(i,pver,jvlc) + dep_grv(i)=sflx(i)*vlc_grv(i,pver,jvlc)/vlc_dry(i,pver,jvlc) + end if + enddo + + fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt + + call outfld( trim(cnst_name_cw(mm))//'DDF', sflx, pcols, lchnk) + call outfld( trim(cnst_name_cw(mm))//'TBF', dep_trb, pcols, lchnk ) + call outfld( trim(cnst_name_cw(mm))//'GVF', dep_grv, pcols, lchnk ) + aerdepdrycw(:ncol,mm) = sflx(:ncol) + + endif + + enddo ! lspec = 0, nspec_amode(m)+1 + enddo ! lphase = 1, 2 + enddo ! m = 1, ntot_amode + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not.aerodep_flx_prescribed()) then + call set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out) + endif + + endsubroutine aero_model_drydep + + !============================================================================= + !============================================================================= + subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) + + use modal_aero_deposition, only: set_srf_wetdep + use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t + use modal_aero_data + use modal_aero_calcsize, only: modal_aero_calcsize_sub + use modal_aero_wateruptake,only: modal_aero_wateruptake_dr + use modal_aero_convproc, only: deepconv_wetdep_history, ma_convproc_intr + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s] + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + + integer :: m ! tracer index + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + real(r8) :: iscavt(pcols, pver) + + integer :: mm + integer :: i,k + + real(r8) :: icscavt(pcols, pver) + real(r8) :: isscavt(pcols, pver) + real(r8) :: bcscavt(pcols, pver) + real(r8) :: bsscavt(pcols, pver) + real(r8) :: sol_factb, sol_facti + real(r8) :: sol_factic(pcols,pver) + + real(r8) :: sflx(pcols) ! deposition flux + + integer :: jnv ! index for scavcoefnv 3rd dimension + integer :: lphase ! index for interstitial / cloudborne aerosol + integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop + integer :: lspec ! index for aerosol number / chem-mass / water-mass + integer :: lcoardust, lcoarnacl ! indices for coarse mode dust and seasalt masses + real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species + real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01 + real(r8) :: f_act_conv_coarse(pcols,pver) ! similar but for coarse mode ! rce 2010/05/02 + real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl ! rce 2010/05/02 + real(r8) :: fracis_cw(pcols,pver) + real(r8) :: hygro_sum_old(pcols,pver) ! before removal [sum of (mass*hydro/dens)] + real(r8) :: hygro_sum_del(pcols,pver) ! removal change to [sum of (mass*hydro/dens)] + real(r8) :: hygro_sum_old_ik, hygro_sum_new_ik + real(r8) :: prec(pcols) ! precipitation rate + real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species + real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for + ! cloud-borne num & vol (0), + ! interstitial num (1), interstitial vol (2) + real(r8) :: tmpa, tmpb + real(r8) :: tmpdust, tmpnacl + real(r8) :: water_old, water_new ! temporary old/new aerosol water mix-rat + logical :: isprx(pcols,pver) ! true if precipation + real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water) + + ! For unified convection scheme + logical, parameter :: do_aero_water_removal = .false. ! True if aerosol water reduction by wet removal is to be calculated + ! (this has not been fully tested, so best to leave it off) + logical :: do_hygro_sum_del, do_lphase1, do_lphase2 + + real(r8), pointer :: rprddp(:,:) ! rain production, deep convection + real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection + real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. + real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. + + real(r8) :: rprddpsum(pcols) + real(r8) :: rprdshsum(pcols) + real(r8) :: evapcdpsum(pcols) + real(r8) :: evapcshsum(pcols) + + real(r8) :: tmp_resudp, tmp_resush + + real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux + real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux + real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux + real(r8) :: rcscavt(pcols, pver) + real(r8) :: rsscavt(pcols, pver) + real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) ! temporary array to hold qqcw for the current mode + real(r8) :: rtscavt(pcols, pver, 0:nspec_max) + + integer, parameter :: nsrflx_mzaer2cnvpr = 2 + real(r8) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) + ! End unified convection scheme + + real(r8), pointer :: fldcw(:,:) + + real(r8), pointer :: dgnumwet(:,:,:) + real(r8), pointer :: qaerwat(:,:,:) ! aerosol water + + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + + type(wetdep_inputs_t) :: dep_inputs + + lchnk = state%lchnk + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) + + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + + call t_startf('calcsize') + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_calcsize_sub(state, ptend, dt, pbuf) + call t_stopf('calcsize') + + call t_startf('wateruptake') + call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('wateruptake') + + if (nwetdep<1) return + + call wetdep_inputs_set( state, pbuf, dep_inputs ) + + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + + prec(:ncol)=0._r8 + do k=1,pver + where (prec(:ncol) >= 1.e-7_r8) + isprx(:ncol,k) = .true. + elsewhere + isprx(:ncol,k) = .false. + endwhere + prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) & + *state%pdel(:ncol,k)/gravit + end do + + if(convproc_do_aer) then + qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 + aerdepwetis(:,:) = 0.0_r8 + aerdepwetcw(:,:) = 0.0_r8 + else + qsrflx_mzaer2cnvpr(:,:,:) = nan + aerdepwetis(:,:) = nan + aerdepwetcw(:,:) = nan + endif + + ! calculate the mass-weighted sol_factic for coarse mode species + ! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4 + f_act_conv_coarse(:,:) = 0.60_r8 ! rce 2010/05/02 + f_act_conv_coarse_dust = 0.40_r8 ! rce 2010/05/02 + f_act_conv_coarse_nacl = 0.80_r8 ! rce 2010/05/02 + if (modeptr_coarse > 0) then + lcoardust = lptr_dust_a_amode(modeptr_coarse) + lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) + if ((lcoardust > 0) .and. (lcoarnacl > 0)) then + do k = 1, pver + do i = 1, ncol + tmpdust = max( 0.0_r8, state%q(i,k,lcoardust) + ptend%q(i,k,lcoardust)*dt ) + tmpnacl = max( 0.0_r8, state%q(i,k,lcoarnacl) + ptend%q(i,k,lcoarnacl)*dt ) + if ((tmpdust+tmpnacl) > 1.0e-30_r8) then + ! sol_factic_coarse(i,k) = (0.2_r8*tmpdust + 0.4_r8*tmpnacl)/(tmpdust+tmpnacl) ! tuned 1/6 + f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & + + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) ! rce 2010/05/02 + end if + end do + end do + end if + end if + + scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species + + ! Counters for "without" unified convective treatment (i.e. default case) + strt_loop = 1 + end_loop = 2 + stride_loop = 1 + if (convproc_do_aer) then + !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne + !can be saved then applied to interstitial + strt_loop = 2 + end_loop = 1 + stride_loop = -1 + endif + + do m = 1, ntot_amode ! main loop over aerosol modes + + do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms + + ! sol_factb and sol_facti values + ! sol_factb - currently this is basically a tuning factor + ! sol_facti & sol_factic - currently has a physical basis, and reflects activation fraction + ! + ! 2008-mar-07 rce - sol_factb (interstitial) changed from 0.3 to 0.1 + ! - sol_factic (interstitial, dust modes) changed from 1.0 to 0.5 + ! - sol_factic (cloud-borne, pcarb modes) no need to set it to 0.0 + ! because the cloud-borne pcarbon == 0 (no activation) + ! + ! rce 2010/05/02 + ! prior to this date, sol_factic was used for convective in-cloud wet removal, + ! and its value reflected a combination of an activation fraction (which varied between modes) + ! and a tuning factor + ! from this date forward, two parameters are used for convective in-cloud wet removal + ! f_act_conv is the activation fraction + ! note that "non-activation" of aerosol in air entrained into updrafts should + ! be included here + ! eventually we might use the activate routine (with w ~= 1 m/s) to calculate + ! this, but there is still the entrainment issue + ! sol_factic is strictly a tuning factor + ! + if (lphase == 1) then ! interstial aerosol + hygro_sum_old(:,:) = 0.0_r8 + hygro_sum_del(:,:) = 0.0_r8 + call modal_aero_bcscavcoef_get( m, ncol, isprx, dgnumwet, & + scavcoefnv(:,:,1), scavcoefnv(:,:,2) ) + + sol_factb = sol_factb_interstitial ! all below-cloud scav ON (0.1 "tuning factor") + + sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial + + sol_factic = sol_factic_interstitial + + if (m == modeptr_pcarbon) then + ! sol_factic = 0.0_r8 ! conv in-cloud scav OFF (0.0 activation fraction) + f_act_conv = 0.0_r8 ! rce 2010/05/02 + else if ((m == modeptr_finedust) .or. (m == modeptr_coardust)) then + ! sol_factic = 0.2_r8 ! conv in-cloud scav ON (0.5 activation fraction) ! tuned 1/4 + f_act_conv = 0.4_r8 ! rce 2010/05/02 + else + ! sol_factic = 0.4_r8 ! conv in-cloud scav ON (1.0 activation fraction) ! tuned 1/4 + f_act_conv = 0.8_r8 ! rce 2010/05/02 + end if + + else ! cloud-borne aerosol (borne by stratiform cloud drops) + + sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud") + sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor + sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + ! that conv precip collects strat droplets) + f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + + end if + if (convproc_do_aer .and. lphase == 1) then + ! if modal aero convproc is turned on for aerosols, then + ! turn off the convective in-cloud removal for interstitial aerosols + ! (but leave the below-cloud on, as convproc only does in-cloud) + ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls + ! for (stratiform)-cloudborne aerosols, convective wet removal + ! (all forms) is zero, so no action is needed + sol_factic = 0.0_r8 + endif + + ! + ! rce 2010/05/03 + ! wetdepa has "sol_fact" parameters: + ! sol_facti, sol_factic, sol_factb for liquid cloud + + do lspec = 0, nspec_amode(m)+1 ! loop over number + chem constituents + water + + if (lspec == 0) then ! number + if (lphase == 1) then + mm = numptr_amode(m) + jnv = 1 + else + mm = numptrcw_amode(m) + jnv = 0 + endif + else if (lspec <= nspec_amode(m)) then ! non-water mass + if (lphase == 1) then + mm = lmassptr_amode(lspec,m) + jnv = 2 + else + mm = lmassptrcw_amode(lspec,m) + jnv = 0 + endif + else ! water mass + ! bypass wet removal of aerosol water + if(convproc_do_aer) then + if ( .not. do_aero_water_removal ) cycle + else + cycle + endif + if (lphase == 1) then + mm = 0 + ! mm = lwaterptr_amode(m) + jnv = 2 + else + mm = 0 + jnv = 0 + endif + endif + + if (mm <= 0) cycle + + + ! set f_act_conv for interstitial (lphase=1) coarse mode species + ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt + ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt + ! number and sulfate are conceptually partitioned to the dust and seasalt + ! on a mass basis, so the f_act_conv for number and sulfate are + ! mass-weighted averages of the values used for dust/seasalt + if ((lphase == 1) .and. (m == modeptr_coarse)) then + ! sol_factic = sol_factic_coarse + f_act_conv = f_act_conv_coarse ! rce 2010/05/02 + if (lspec > 0) then + if (lmassptr_amode(lspec,m) == lptr_dust_a_amode(m)) then + ! sol_factic = 0.2_r8 ! tuned 1/4 + f_act_conv = f_act_conv_coarse_dust ! rce 2010/05/02 + else if (lmassptr_amode(lspec,m) == lptr_nacl_a_amode(m)) then + ! sol_factic = 0.4_r8 ! tuned 1/6 + f_act_conv = f_act_conv_coarse_nacl ! rce 2010/05/02 + end if + end if + end if + + if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then + ptend%lq(mm) = .TRUE. + dqdt_tmp(:,:) = 0.0_r8 + ! q_tmp reflects changes from modal_aero_calcsize and is the "most current" q + q_tmp(1:ncol,:) = state%q(1:ncol,:,mm) + ptend%q(1:ncol,:,mm)*dt + if(convproc_do_aer) then + !Feed in the saved cloudborne mixing ratios from phase 2 + qqcw_in(:,:) = qqcw_sav(:,:,lspec) + else + fldcw => qqcw_get_field(pbuf, mm,lchnk) + qqcw_in(:,:) = fldcw(:,:) + endif + + call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, & + dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, & + dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & + dlf, fracis(:,:,mm), sol_factb, ncol, & + scavcoefnv(:,:,jnv), & + is_strat_cloudborne=.false., & + qqcw=qqcw_in(:,:), & + f_act_conv=f_act_conv, & + icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & + convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & + sol_facti_in=sol_facti, sol_factic_in=sol_factic ) + + do_hygro_sum_del = .false. + if ( lspec > 0 ) do_hygro_sum_del = .true. + + if(convproc_do_aer) then + do_hygro_sum_del = .false. + ! add resuspension of cloudborne species to dqdt of interstitial species + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,lspec) + if ( (lspec > 0) .and. do_aero_water_removal ) then + do_hygro_sum_del = .true. + endif + endif + + ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) + + call outfld( trim(cnst_name(mm))//'WET', dqdt_tmp(:,:), pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SIC', icscavt, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) + call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) + aerdepwetis(:ncol,mm) = sflx(:ncol) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk) + if (convproc_do_aer) sflxic = sflx + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk) + if (convproc_do_aer)sflxbc = sflx + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk) + + if (convproc_do_aer) then + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + sflxec = sflx + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name(mm))//'SFSES', sflx, pcols, lchnk) + + ! apportion convective surface fluxes to deep and shallow conv + ! this could be done more accurately in subr wetdepa + ! since deep and shallow rarely occur simultaneously, and these + ! fields are just diagnostics, this approximate method is adequate + ! only do this for interstitial aerosol, because conv clouds to not + ! affect the stratiform-cloudborne aerosol + if ( deepconv_wetdep_history) then + + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + rprddpsum(:) = 0.0_r8 + rprdshsum(:) = 0.0_r8 + evapcdpsum(:) = 0.0_r8 + evapcshsum(:) = 0.0_r8 + + do k = 1, pver + rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit + rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit + end do + + do i = 1, ncol + rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 ) + rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 ) + evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 ) + evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 ) + + ! assume that in- and below-cloud removal are proportional to column precip production + tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i)) + tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) + sflxicdp(i) = sflxic(i)*tmpa + sflxbcdp(i) = sflxbc(i)*tmpa + + ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)] + tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 ) + tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 ) + tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 ) + tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) ) + sflxecdp(i) = sflxec(i)*tmpb + end do + call outfld( trim(cnst_name(mm))//'SFSBD', sflxbcdp, pcols, lchnk) + else + sflxec(1:ncol) = 0.0_r8 + sflxecdp(1:ncol) = 0.0_r8 + end if + + ! when ma_convproc_intr is used, convective in-cloud wet removal is done there + ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud + ! contributions + ! so pass the below-cloud contribution to ma_convproc_intr + qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol) + qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol) + + endif + + if (do_hygro_sum_del) then + tmpa = spechygro(lspec,m)/ & + specdens_amode(lspec,m) + tmpb = tmpa*dt + hygro_sum_old(1:ncol,:) = hygro_sum_old(1:ncol,:) & + + tmpa*q_tmp(1:ncol,:) + hygro_sum_del(1:ncol,:) = hygro_sum_del(1:ncol,:) & + + tmpb*dqdt_tmp(1:ncol,:) + end if + + else if ((lphase == 1) .and. (lspec == nspec_amode(m)+1)) then + do_lphase1 = .true. + if(convproc_do_aer) then + do_lphase1 = .false. + if(do_aero_water_removal)do_lphase1 = .true. + endif + if(do_lphase1) then + ! aerosol water -- because of how wetdepa treats evaporation of stratiform + ! precip, it is not appropriate to apply wetdepa to aerosol water + ! instead, "hygro_sum" = [sum of (mass*hygro/dens)] is calculated before and + ! after wet removal, and new water is calculated using + ! new_water = old_water*min(10,(hygro_sum_new/hygro_sum_old)) + ! the "min(10,...)" is to avoid potential problems when hygro_sum_old ~= 0 + ! also, individual wet removal terms (ic,is,bc,bs) are not output to history + ! ptend%lq(mm) = .TRUE. + ! dqdt_tmp(:,:) = 0.0_r8 + do k = 1, pver + do i = 1, ncol + ! water_old = max( 0.0_r8, state%q(i,k,mm)+ptend%q(i,k,mm)*dt ) + water_old = max( 0.0_r8, qaerwat(i,k,mm) ) + hygro_sum_old_ik = max( 0.0_r8, hygro_sum_old(i,k) ) + hygro_sum_new_ik = max( 0.0_r8, hygro_sum_old_ik+hygro_sum_del(i,k) ) + if (hygro_sum_new_ik >= 10.0_r8*hygro_sum_old_ik) then + water_new = 10.0_r8*water_old + else + water_new = water_old*(hygro_sum_new_ik/hygro_sum_old_ik) + end if + ! dqdt_tmp(i,k) = (water_new - water_old)/dt + qaerwat(i,k,mm) = water_new + end do + end do + + ! ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) + + ! call outfld( trim(cnst_name(mm)) + + ! sflx(:)=0._r8 + ! do k=1,pver + ! do i=1,ncol + ! sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit + ! enddo + ! enddo + ! call outfld( trim(cnst_name(mm)) + endif + + elseif (lphase == 2) then + + do_lphase2 = .true. + if (convproc_do_aer) then + do_lphase2 = .false. + if (lspec <= nspec_amode(m)) do_lphase2 = .true. + endif + + if (do_lphase2) then + + dqdt_tmp(:,:) = 0.0_r8 + + if (convproc_do_aer) then + fldcw => qqcw_get_field(pbuf,mm,lchnk) + qqcw_sav(1:ncol,:,lspec) = fldcw(1:ncol,:) + else + fldcw => qqcw_get_field(pbuf, mm,lchnk) + endif + + call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & + dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + dep_inputs%evapr, dep_inputs%totcond, fldcw, dt, & + dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & + dlf, fracis_cw, sol_factb, ncol, & + scavcoefnv(:,:,jnv), & + is_strat_cloudborne=.true., & + icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & + convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & + sol_facti_in=sol_facti, sol_factic_in=sol_factic ) + + if(convproc_do_aer) then + ! save resuspension of cloudborne species + rtscavt(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) + ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source) + ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above) + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,lspec) + endif + + + fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name_cw(mm))//'SFWET', sflx, pcols, lchnk) + aerdepwetcw(:ncol,mm) = sflx(:ncol) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSIC', sflx, pcols, lchnk) + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSIS', sflx, pcols, lchnk) + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSBC', sflx, pcols, lchnk) + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSBS', sflx, pcols, lchnk) + + if(convproc_do_aer) then + sflx(:)=0.0_r8 + do k=1,pver + sflx(1:ncol)=sflx(1:ncol)+rcscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSEC', sflx, pcols, lchnk) + + sflx(:)=0.0_r8 + do k=1,pver + sflx(1:ncol)=sflx(1:ncol)+rsscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit + enddo + call outfld( trim(cnst_name_cw(mm))//'SFSES', sflx, pcols, lchnk) + endif + endif + endif + + enddo ! lspec = 0, nspec_amode(m)+1 + enddo ! lphase = 1, 2 + enddo ! m = 1, ntot_amode + + if (convproc_do_aer) then + call t_startf('ma_convproc') + call ma_convproc_intr( state, ptend, pbuf, dt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis) + call t_stopf('ma_convproc') + endif + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not. aerodep_flx_prescribed()) then + call set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out) + endif + + endsubroutine aero_model_wetdep + + !------------------------------------------------------------------------- + ! provides wet tropospheric aerosol surface area info for modal aerosols + ! called from mo_usrrxt + !------------------------------------------------------------------------- + subroutine aero_model_surfarea( & + mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, rho, ltrop, & + dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_trop, reff_trop ) + + ! dummy args + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: radmean ! mean radii in cm + real(r8), intent(in) :: strato_sad(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: ltrop(:) + real(r8), intent(in) :: dlat(:) ! degrees latitude + integer, intent(in) :: het1_ndx + real(r8), intent(in) :: relhum(:,:) + real(r8), intent(in) :: rho(:,:) ! total atm density (/cm^3) + real(r8), intent(in) :: sulfate(:,:) + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(inout) :: sfc(:,:,:) + real(r8), intent(inout) :: dm_aer(:,:,:) + real(r8), intent(inout) :: sad_trop(:,:) + real(r8), intent(out) :: reff_trop(:,:) + + ! local vars + real(r8), pointer, dimension(:,:,:) :: dgnumwet + integer :: beglev(ncol) + integer :: endlev(ncol) + integer :: i,k + + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) + + beglev(:ncol)=ltrop(:ncol)+1 + endlev(:ncol)=pver + call surf_area_dens( ncol, mmr, pmid, temp, dgnumwet, beglev, endlev, sad_trop, reff_trop, sfc=sfc ) + + do i = 1,ncol + do k = ltrop(i)+1,pver + dm_aer(i,k,:) = dgnumwet(i,k,:) * 1.e2_r8 ! convert m to cm + enddo + enddo + + end subroutine aero_model_surfarea + + !------------------------------------------------------------------------- + ! provides WET stratospheric aerosol surface area info for modal aerosols + ! if modal_strat_sulfate = TRUE -- called from mo_gas_phase_chemdr + !------------------------------------------------------------------------- + subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + + ! dummy args + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + integer, intent(in) :: ltrop(:) ! tropopause level indices + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: strato_sad(:,:) + real(r8), intent(out) :: reff_strat(:,:) + + ! local vars + real(r8), pointer, dimension(:,:,:) :: dgnumwet + integer :: beglev(ncol) + integer :: endlev(ncol) + + reff_strat = 0._r8 + strato_sad = 0._r8 + + if (.not.modal_strat_sulfate) return + + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) + + beglev(:ncol)=top_lev + endlev(:ncol)=ltrop(:ncol) + call surf_area_dens( ncol, mmr, pmid, temp, dgnumwet, beglev, endlev, strato_sad, reff_strat ) + + end subroutine aero_model_strat_surfarea + + !============================================================================= + !============================================================================= + subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_rates, & + tfld, pmid, pdel, mbar, relhum, & + zm, qh2o, cwat, cldfr, cldnum, & + airdens, invariants, del_h2so4_gasprod, & + vmr0, vmr, pbuf ) + + use time_manager, only : get_nstep + use modal_aero_coag, only : modal_aero_coag_sub + use modal_aero_gasaerexch, only : modal_aero_gasaerexch_sub + use modal_aero_newnuc, only : modal_aero_newnuc_sub + use modal_aero_data, only : cnst_name_cw, qqcw_get_field + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: loffset ! offset applied to modal aero "pointers" + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: troplev(pcols) + real(r8), intent(in) :: delt ! time step size (sec) + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: pmid(:,:) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: relhum(:,:) ! relative humidity + real(r8), intent(in) :: airdens(:,:) ! total atms density (molec/cm**3) + real(r8), intent(in) :: invariants(:,:,:) + real(r8), intent(in) :: del_h2so4_gasprod(:,:) + real(r8), intent(in) :: zm(:,:) + real(r8), intent(in) :: qh2o(:,:) + real(r8), intent(in) :: cwat(:,:) ! cloud liquid water content (kg/kg) + real(r8), intent(in) :: cldfr(:,:) + real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: vmr0(:,:,:) ! initial mixing ratios (before gas-phase chem changes) + real(r8), intent(inout) :: vmr(:,:,:) ! mixing ratios ( vmr ) + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + + integer :: n, m + integer :: i,k,l + integer :: nstep + + real(r8) :: del_h2so4_aeruptk(ncol,pver) + + real(r8), pointer :: dgnum(:,:,:), dgnumwet(:,:,:), wetdens(:,:,:) + real(r8), pointer :: pblh(:) ! pbl height (m) + + real(r8), dimension(ncol) :: wrk + character(len=32) :: name + real(r8) :: dvmrcwdt(ncol,pver,gas_pcnst) + real(r8) :: dvmrdt(ncol,pver,gas_pcnst) + real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) + + real(r8) :: aqso4(ncol,ntot_amode) ! aqueous phase chemistry + real(r8) :: aqh2so4(ncol,ntot_amode) ! aqueous phase chemistry + real(r8) :: aqso4_h2o2(ncol) ! SO4 aqueous phase chemistry due to H2O2 + real(r8) :: aqso4_o3(ncol) ! SO4 aqueous phase chemistry due to O3 + real(r8) :: xphlwc(ncol,pver) ! pH value multiplied by lwc + real(r8) :: nh3_beg(ncol,pver) + real(r8), pointer :: fldcw(:,:) + real(r8), pointer :: sulfeq(:,:,:) + + logical :: is_spcam_m2005 +! +! ... initialize nh3 +! + if ( nh3_ndx > 0 ) then + nh3_beg = vmr(1:ncol,:,nh3_ndx) + end if +! + is_spcam_m2005 = cam_physpkg_is('spcam_m2005') + + call pbuf_get_field(pbuf, dgnum_idx, dgnum) + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) + call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens ) + call pbuf_get_field(pbuf, pblh_idx, pblh) + + do n=1,ntot_amode + call outfld(dgnum_name(n), dgnum(1:ncol,1:pver,n), ncol, lchnk ) + call outfld(dgnumwet_name(n), dgnumwet(1:ncol,1:pver,n), ncol, lchnk ) + end do + +! do gas-aerosol exchange (h2so4, msa, nh3 condensation) + + nstep = get_nstep() + + ! calculate tendency due to gas phase chemistry and processes + dvmrdt(:ncol,:,:) = (vmr(:ncol,:,:) - vmr0(:ncol,:,:)) / delt + do m = 1, gas_pcnst + wrk(:) = 0._r8 + do k = 1,pver + wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m)*adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit + end do + name = 'GS_'//trim(solsym(m)) + call outfld( name, wrk(:ncol), ncol, lchnk ) + enddo + +! +! Aerosol processes ... +! + call qqcw2vmr( lchnk, vmrcw, mbar, ncol, loffset, pbuf ) + + if (.not. is_spcam_m2005) then ! regular CAM + dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) + dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) + + ! aqueous chemistry ... + + if( has_sox ) then + call setsox( & + ncol, & + lchnk, & + loffset, & + delt, & + pmid, & + pdel, & + tfld, & + mbar, & + cwat, & + cldfr, & + cldnum, & + airdens, & + invariants, & + vmrcw, & + vmr, & + xphlwc, & + aqso4, & + aqh2so4, & + aqso4_h2o2, & + aqso4_o3 & + ) + + do n = 1, ntot_amode + l = lptr_so4_cw_amode(n) + if (l > 0) then + call outfld( trim(cnst_name_cw(l))//'AQSO4', aqso4(:ncol,n), ncol, lchnk) + call outfld( trim(cnst_name_cw(l))//'AQH2SO4', aqh2so4(:ncol,n), ncol, lchnk) + end if + end do + + call outfld( 'AQSO4_H2O2', aqso4_h2o2(:ncol), ncol, lchnk) + call outfld( 'AQSO4_O3', aqso4_o3(:ncol), ncol, lchnk) + call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk ) + + endif + +! Tendency due to aqueous chemistry + dvmrdt = (vmr - dvmrdt) / delt + dvmrcwdt = (vmrcw - dvmrcwdt) / delt + do m = 1, gas_pcnst + wrk(:) = 0._r8 + do k = 1,pver + wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m) * adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit + end do + name = 'AQ_'//trim(solsym(m)) + call outfld( name, wrk(:ncol), ncol, lchnk ) + enddo + + else if (is_spcam_m2005) then ! SPCAM ECPP +! when ECPP is used, aqueous chemistry is done in ECPP, +! and not updated here. +! Minghuai Wang, 2010-02 (Minghuai.Wang@pnl.gov) +! + dvmrdt = 0.0_r8 + dvmrcwdt = 0.0_r8 + endif + +! do gas-aerosol exchange (h2so4, msa, nh3 condensation) + + if (ndx_h2so4 > 0) then + del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) + else + del_h2so4_aeruptk(:,:) = 0.0_r8 + endif + + call t_startf('modal_gas-aer_exchng') + + if ( sulfeq_idx>0 ) then + call pbuf_get_field( pbuf, sulfeq_idx, sulfeq ) + else + nullify( sulfeq ) + endif + + call modal_aero_gasaerexch_sub( & + lchnk, ncol, nstep, & + loffset, delt, & + tfld, pmid, pdel, & + qh2o, troplev, & + vmr, vmrcw, & + dvmrdt, dvmrcwdt, & + dgnum, dgnumwet, & + sulfeq ) + + if (ndx_h2so4 > 0) then + del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_aeruptk(1:ncol,:) + endif + + call t_stopf('modal_gas-aer_exchng') + + call t_startf('modal_nucl') + + ! do aerosol nucleation (new particle formation) + call modal_aero_newnuc_sub( & + lchnk, ncol, nstep, & + loffset, delt, & + tfld, pmid, pdel, & + zm, pblh, & + qh2o, cldfr, & + vmr, & + del_h2so4_gasprod, del_h2so4_aeruptk ) + + call t_stopf('modal_nucl') + + call t_startf('modal_coag') + + ! do aerosol coagulation + call modal_aero_coag_sub( & + lchnk, ncol, nstep, & + loffset, delt, & + tfld, pmid, pdel, & + vmr, & + dgnum, dgnumwet, & + wetdens ) + + call t_stopf('modal_coag') + + call vmr2qqcw( lchnk, vmrcw, mbar, ncol, loffset, pbuf ) + + ! diagnostics for cloud-borne aerosols... + do n = 1,pcnst + fldcw => qqcw_get_field(pbuf,n,lchnk,errorhandle=.true.) + if(associated(fldcw)) then + call outfld( cnst_name_cw(n), fldcw(:,:), pcols, lchnk ) + endif + end do +! +! ... put missing NH3 into NH4 +! + if ( nh3_ndx > 0 .and. nh4_ndx > 0 ) then + vmr(1:ncol,:,nh4_ndx) = vmr(1:ncol,:,nh4_ndx) + (nh3_beg-vmr(1:ncol,:,nh3_ndx)) + vmr(1:ncol,:,nh4_ndx) = max(0._r8,vmr(1:ncol,:,nh4_ndx)) + end if + + end subroutine aero_model_gasaerexch + + !============================================================================= + !============================================================================= + subroutine aero_model_emissions( state, cam_in ) + use seasalt_model, only: seasalt_emis, seasalt_names, seasalt_indices, seasalt_active,seasalt_nbin + use dust_model, only: dust_emis, dust_names, dust_indices, dust_active,dust_nbin, dust_nnum + use physics_types, only: physics_state + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + ! local vars + + integer :: lchnk, ncol + integer :: m, mm + real(r8) :: soil_erod_tmp(pcols) + real(r8) :: sflx(pcols) ! accumulate over all bins for output + real(r8) :: u10cubed(pcols) + real (r8), parameter :: z0=0.0001_r8 ! m roughness length over oceans--from ocean model + + lchnk = state%lchnk + ncol = state%ncol + + if (dust_active) then + + call dust_emis( ncol, lchnk, cam_in%dstflx, cam_in%cflx, soil_erod_tmp ) + + ! some dust emis diagnostics ... + sflx(:)=0._r8 + do m=1,dust_nbin+dust_nnum + mm = dust_indices(m) + if (m<=dust_nbin) sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + call outfld(trim(dust_names(m))//'SF',cam_in%cflx(:,mm),pcols, lchnk) + enddo + call outfld('DSTSFMBL',sflx(:),pcols,lchnk) + call outfld('LND_MBL',soil_erod_tmp(:),pcols, lchnk ) + endif + + if (seasalt_active) then + u10cubed(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2) + ! move the winds to 10m high from the midpoint of the gridbox: + ! follows Tie and Seinfeld and Pandis, p.859 with math. + + u10cubed(:ncol)=u10cubed(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0) + + ! we need them to the 3.41 power, according to Gong et al., 1997: + u10cubed(:ncol)=u10cubed(:ncol)**3.41_r8 + + sflx(:)=0._r8 + + call seasalt_emis( u10cubed, cam_in%sst, cam_in%ocnfrac, ncol, cam_in%cflx ) + + do m=1,seasalt_nbin + mm = seasalt_indices(m) + sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + call outfld(trim(seasalt_names(m))//'SF',cam_in%cflx(:,mm),pcols,lchnk) + enddo + call outfld('SSTSFMBL',sflx(:),pcols,lchnk) + endif + + end subroutine aero_model_emissions + + !=============================================================================== + ! private methods + + + !============================================================================= + !============================================================================= + subroutine surf_area_dens( ncol, mmr, pmid, temp, diam, beglev, endlev, sad, reff, sfc ) + use mo_constants, only : pi + use modal_aero_data, only : nspec_amode, alnsg_amode + + ! dummy args + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + real(r8), intent(in) :: diam(:,:,:) + integer, intent(in) :: beglev(:) + integer, intent(in) :: endlev(:) + real(r8), intent(out) :: sad(:,:) + real(r8), intent(out) :: reff(:,:) + real(r8),optional, intent(out) :: sfc(:,:,:) + + ! local vars + real(r8) :: sad_mode(pcols,pver,ntot_amode),radeff(pcols,pver) + real(r8) :: vol(pcols,pver),vol_mode(pcols,pver,ntot_amode) + real(r8) :: rho_air + integer :: i,k,l,m + real(r8) :: chm_mass, tot_mass + + ! + ! Compute surface aero for each mode. + ! Total over all modes as the surface area for chemical reactions. + ! + + sad = 0._r8 + sad_mode = 0._r8 + vol = 0._r8 + vol_mode = 0._r8 + reff = 0._r8 + + do i = 1,ncol + do k = beglev(i),endlev(i) + rho_air = pmid(i,k)/(temp(i,k)*287.04_r8) + do l=1,ntot_amode + ! + ! compute a mass weighting of the number + ! + tot_mass = 0._r8 + chm_mass = 0._r8 + do m=1,nspec_amode(l) + if ( index_tot_mass(l,m) > 0 ) & + tot_mass = tot_mass + mmr(i,k,index_tot_mass(l,m)) + if ( index_chm_mass(l,m) > 0 ) & + chm_mass = chm_mass + mmr(i,k,index_chm_mass(l,m)) + end do + if ( tot_mass > 0._r8 ) then + sad_mode(i,k,l) = (chm_mass/tot_mass)**(2._r8/3._r8) * & + mmr(i,k,num_idx(l))*rho_air*pi*diam(i,k,l)**2._r8*& + exp(2._r8*alnsg_amode(l)**2._r8) ! m^2/m^3 + sad_mode(i,k,l) = 1.e-2_r8 * sad_mode(i,k,l) ! cm^2/cm^3 + + vol_mode(i,k,l) = chm_mass/tot_mass * & + mmr(i,k,num_idx(l))*rho_air*pi/6._r8*diam(i,k,l)**3._r8*& + exp(3._r8*alnsg_amode(l)**2._r8) ! m^3/m^3 = cm^3/cm^3 + else + sad_mode(i,k,l) = 0._r8 + vol_mode(i,k,l) = 0._r8 + end if + end do + sad(i,k) = sum(sad_mode(i,k,:)) + vol(i,k) = sum(vol_mode(i,k,:)) + reff(i,k) = 3._r8*vol(i,k)/sad(i,k) + + enddo + enddo + + if (present(sfc)) then + sfc(:,:,:) = sad_mode(:,:,:) + endif + + end subroutine surf_area_dens + + !=============================================================================== + !=============================================================================== + subroutine modal_aero_bcscavcoef_init + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Computes lookup table for aerosol impaction/interception scavenging rates + ! + ! Authors: R. Easter + ! + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use modal_aero_data + use cam_abortutils, only: endrun + + implicit none + + + ! local variables + integer nnfit_maxd + parameter (nnfit_maxd=27) + + integer i, jgrow, jdens, jpress, jtemp, mode, nnfit + integer lunerr + + real(r8) dg0, dg0_cgs, press, & + rhodryaero, rhowetaero, rhowetaero_cgs, rmserr, & + scavratenum, scavratevol, sigmag, & + temp, wetdiaratio, wetvolratio + real(r8) aafitnum(1), xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd) + real(r8) aafitvol(1), xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd) + + allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode)) + allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode)) + + lunerr = 6 + dlndg_nimptblgrow = log( 1.25_r8 ) + + modeloop: do mode = 1, ntot_amode + + sigmag = sigmag_amode(mode) + + rhodryaero = specdens_amode(1,mode) + + growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd + + wetdiaratio = exp( jgrow*dlndg_nimptblgrow ) + dg0 = dgnum_amode(mode)*wetdiaratio + + wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 ) + rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio + rhowetaero = min( rhowetaero, rhodryaero ) + + ! + ! compute impaction scavenging rates at 1 temp-press pair and save + ! + nnfit = 0 + + temp = 273.16_r8 + press = 0.75e6_r8 ! dynes/cm2 + rhowetaero = rhodryaero + + dg0_cgs = dg0*1.0e2_r8 ! m to cm + rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3 + call calc_1_impact_rate( & + dg0_cgs, sigmag, rhowetaero_cgs, temp, press, & + scavratenum, scavratevol, lunerr ) + + nnfit = nnfit + 1 + if (nnfit .gt. nnfit_maxd) then + write(lunerr,9110) + call endrun() + end if +9110 format( '*** subr. modal_aero_bcscavcoef_init -- nnfit too big' ) + + xxfitnum(1,nnfit) = 1._r8 + yyfitnum(nnfit) = log( scavratenum ) + + xxfitvol(1,nnfit) = 1._r8 + yyfitvol(nnfit) = log( scavratevol ) + +5900 continue + + ! + ! skip mlinfit stuff because scav table no longer has dependencies on + ! air temp, air press, and particle wet density + ! just load the log( scavrate--- ) values + ! + !! + !! do linear regression + !! log(scavrate) = a1 + a2*log(wetdens) + !! + ! call mlinft( xxfitnum, yyfitnum, aafitnum, nnfit, 1, 1, rmserr ) + ! call mlinft( xxfitvol, yyfitvol, aafitvol, nnfit, 1, 1, rmserr ) + ! + ! scavimptblnum(jgrow,mode) = aafitnum(1) + ! scavimptblvol(jgrow,mode) = aafitvol(1) + + scavimptblnum(jgrow,mode) = yyfitnum(1) + scavimptblvol(jgrow,mode) = yyfitvol(1) + + enddo growloop + enddo modeloop + return + end subroutine modal_aero_bcscavcoef_init + + !=============================================================================== + !=============================================================================== + subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vlc_grv, & + radius_part, density_part, sig_part, moment, lchnk ) + +! calculates surface deposition velocity of particles +! L. Zhang, S. Gong, J. Padro, and L. Barrie +! A size-seggregated particle dry deposition scheme for an atmospheric aerosol module +! Atmospheric Environment, 35, 549-560, 2001. +! +! Authors: X. Liu + + ! + ! !USES + ! + use physconst, only: pi,boltz, gravit, rair + use mo_drydep, only: n_land_type, fraction_landuse + + ! !ARGUMENTS: + ! + implicit none + ! + real(r8), intent(in) :: t(pcols,pver) !atm temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) !atm pressure (Pa) + real(r8), intent(in) :: fv(pcols) !friction velocity (m/s) + real(r8), intent(in) :: ram1(pcols) !aerodynamical resistance (s/m) + real(r8), intent(in) :: radius_part(pcols,pver) ! mean (volume/number) particle radius (m) + real(r8), intent(in) :: density_part(pcols,pver) ! density of particle material (kg/m3) + real(r8), intent(in) :: sig_part(pcols,pver) ! geometric standard deviation of particles + integer, intent(in) :: moment ! moment of size distribution (0 for number, 2 for surface area, 3 for volume) + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + + real(r8), intent(out) :: vlc_trb(pcols) !Turbulent deposn velocity (m/s) + real(r8), intent(out) :: vlc_grv(pcols,pver) !grav deposn velocity (m/s) + real(r8), intent(out) :: vlc_dry(pcols,pver) !dry deposn velocity (m/s) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + ! Local Variables + integer :: m,i,k,ix !indices + real(r8) :: rho !atm density (kg/m**3) + real(r8) :: vsc_dyn_atm(pcols,pver) ![kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm(pcols,pver) ![m2 s-1] Kinematic viscosity of atmosphere + real(r8) :: shm_nbr ![frc] Schmidt number + real(r8) :: stk_nbr ![frc] Stokes number + real(r8) :: mfp_atm(pcols,pver) ![m] Mean free path of air + real(r8) :: dff_aer ![m2 s-1] Brownian diffusivity of particle + real(r8) :: slp_crc(pcols,pver) ![frc] Slip correction factor + real(r8) :: rss_trb ![s m-1] Resistance to turbulent deposition + real(r8) :: rss_lmn ![s m-1] Quasi-laminar layer resistance + real(r8) :: brownian ! collection efficiency for Browning diffusion + real(r8) :: impaction ! collection efficiency for impaction + real(r8) :: interception ! collection efficiency for interception + real(r8) :: stickfrac ! fraction of particles sticking to surface + real(r8) :: radius_moment(pcols,pver) ! median radius (m) for moment + real(r8) :: lnsig ! ln(sig_part) + real(r8) :: dispersion ! accounts for influence of size dist dispersion on bulk settling velocity + ! assuming radius_part is number mode radius * exp(1.5 ln(sigma)) + + integer :: lt + real(r8) :: lnd_frc + real(r8) :: wrk1, wrk2, wrk3 + + ! constants + real(r8) gamma(11) ! exponent of schmidt number +! data gamma/0.54d+00, 0.56d+00, 0.57d+00, 0.54d+00, 0.54d+00, & +! 0.56d+00, 0.54d+00, 0.54d+00, 0.54d+00, 0.56d+00, & +! 0.50d+00/ + data gamma/0.56e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.56e+00_r8, 0.56e+00_r8, & + 0.56e+00_r8, 0.50e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.54e+00_r8, & + 0.54e+00_r8/ + save gamma + + real(r8) alpha(11) ! parameter for impaction +! data alpha/50.00d+00, 0.95d+00, 0.80d+00, 1.20d+00, 1.30d+00, & +! 0.80d+00, 50.00d+00, 50.00d+00, 2.00d+00, 1.50d+00, & +! 100.00d+00/ + data alpha/1.50e+00_r8, 1.20e+00_r8, 1.20e+00_r8, 0.80e+00_r8, 1.00e+00_r8, & + 0.80e+00_r8, 100.00e+00_r8, 50.00e+00_r8, 2.00e+00_r8, 1.20e+00_r8, & + 50.00e+00_r8/ + save alpha + + real(r8) radius_collector(11) ! radius (m) of surface collectors +! data radius_collector/-1.00d+00, 5.10d-03, 3.50d-03, 3.20d-03, 10.00d-03, & +! 5.00d-03, -1.00d+00, -1.00d+00, 10.00d-03, 10.00d-03, & +! -1.00d+00/ + data radius_collector/10.00e-03_r8, 3.50e-03_r8, 3.50e-03_r8, 5.10e-03_r8, 2.00e-03_r8, & + 5.00e-03_r8, -1.00e+00_r8, -1.00e+00_r8, 10.00e-03_r8, 3.50e-03_r8, & + -1.00e+00_r8/ + save radius_collector + + integer :: iwet(11) ! flag for wet surface = 1, otherwise = -1 +! data iwet/1, -1, -1, -1, -1, & +! -1, -1, -1, 1, -1, & +! 1/ + data iwet/-1, -1, -1, -1, -1, & + -1, 1, -1, 1, -1, & + -1/ + save iwet + + + !------------------------------------------------------------------------ + do k=1,pver + do i=1,ncol + + lnsig = log(sig_part(i,k)) +! use a maximum radius of 50 microns when calculating deposition velocity + radius_moment(i,k) = min(50.0e-6_r8,radius_part(i,k))* & + exp((float(moment)-1.5_r8)*lnsig*lnsig) + dispersion = exp(2._r8*lnsig*lnsig) + + rho=pmid(i,k)/rair/t(i,k) + + ! Quasi-laminar layer resistance: call rss_lmn_get + ! Size-independent thermokinetic properties + vsc_dyn_atm(i,k) = 1.72e-5_r8 * ((t(i,k)/273.0_r8)**1.5_r8) * 393.0_r8 / & + (t(i,k)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102 + mfp_atm(i,k) = 2.0_r8 * vsc_dyn_atm(i,k) / & ![m] SeP97 p. 455 + (pmid(i,k)*sqrt(8.0_r8/(pi*rair*t(i,k)))) + vsc_knm_atm(i,k) = vsc_dyn_atm(i,k) / rho ![m2 s-1] Kinematic viscosity of air + + slp_crc(i,k) = 1.0_r8 + mfp_atm(i,k) * & + (1.257_r8+0.4_r8*exp(-1.1_r8*radius_moment(i,k)/(mfp_atm(i,k)))) / & + radius_moment(i,k) ![frc] Slip correction factor SeP97 p. 464 + vlc_grv(i,k) = (4.0_r8/18.0_r8) * radius_moment(i,k)*radius_moment(i,k)*density_part(i,k)* & + gravit*slp_crc(i,k) / vsc_dyn_atm(i,k) ![m s-1] Stokes' settling velocity SeP97 p. 466 + vlc_grv(i,k) = vlc_grv(i,k) * dispersion + + vlc_dry(i,k)=vlc_grv(i,k) + enddo + enddo + k=pver ! only look at bottom level for next part + do i=1,ncol + dff_aer = boltz * t(i,k) * slp_crc(i,k) / & ![m2 s-1] + (6.0_r8*pi*vsc_dyn_atm(i,k)*radius_moment(i,k)) !SeP97 p.474 + shm_nbr = vsc_knm_atm(i,k) / dff_aer ![frc] SeP97 p.972 + + wrk2 = 0._r8 + wrk3 = 0._r8 + do lt = 1,n_land_type + lnd_frc = fraction_landuse(i,lt,lchnk) + if ( lnd_frc /= 0._r8 ) then + brownian = shm_nbr**(-gamma(lt)) + if (radius_collector(lt) > 0.0_r8) then +! vegetated surface + stk_nbr = vlc_grv(i,k) * fv(i) / (gravit*radius_collector(lt)) + interception = 2.0_r8*(radius_moment(i,k)/radius_collector(lt))**2.0_r8 + else +! non-vegetated surface + stk_nbr = vlc_grv(i,k) * fv(i) * fv(i) / (gravit*vsc_knm_atm(i,k)) ![frc] SeP97 p.965 + interception = 0.0_r8 + endif + impaction = (stk_nbr/(alpha(lt)+stk_nbr))**2.0_r8 + + if (iwet(lt) > 0) then + stickfrac = 1.0_r8 + else + stickfrac = exp(-sqrt(stk_nbr)) + if (stickfrac < 1.0e-10_r8) stickfrac = 1.0e-10_r8 + endif + rss_lmn = 1.0_r8 / (3.0_r8 * fv(i) * stickfrac * (brownian+interception+impaction)) + rss_trb = ram1(i) + rss_lmn + ram1(i)*rss_lmn*vlc_grv(i,k) + + wrk1 = 1.0_r8 / rss_trb + wrk2 = wrk2 + lnd_frc*( wrk1 ) + wrk3 = wrk3 + lnd_frc*( wrk1 + vlc_grv(i,k) ) + endif + enddo ! n_land_type + vlc_trb(i) = wrk2 + vlc_dry(i,k) = wrk3 + enddo !ncol + + return + end subroutine modal_aero_depvel_part + + !=============================================================================== + subroutine modal_aero_bcscavcoef_get( m, ncol, isprx, dgn_awet, scavcoefnum, scavcoefvol ) + + use modal_aero_data + !----------------------------------------------------------------------- + implicit none + + integer,intent(in) :: m, ncol + logical,intent(in):: isprx(pcols,pver) + real(r8), intent(in) :: dgn_awet(pcols,pver,ntot_amode) + real(r8), intent(out) :: scavcoefnum(pcols,pver), scavcoefvol(pcols,pver) + + integer i, k, jgrow + real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum + + + do k = 1, pver + do i = 1, ncol + + ! do only if no precip + if ( isprx(i,k) ) then + ! + ! interpolate table values using log of (actual-wet-size)/(base-dry-size) + + dumdgratio = dgn_awet(i,k,m)/dgnum_amode(m) + + if ((dumdgratio .ge. 0.99_r8) .and. (dumdgratio .le. 1.01_r8)) then + scavimpvol = scavimptblvol(0,m) + scavimpnum = scavimptblnum(0,m) + else + xgrow = log( dumdgratio ) / dlndg_nimptblgrow + jgrow = int( xgrow ) + if (xgrow .lt. 0._r8) jgrow = jgrow - 1 + if (jgrow .lt. nimptblgrow_mind) then + jgrow = nimptblgrow_mind + xgrow = jgrow + else + jgrow = min( jgrow, nimptblgrow_maxd-1 ) + end if + + dumfhi = xgrow - jgrow + dumflo = 1._r8 - dumfhi + + scavimpvol = dumflo*scavimptblvol(jgrow,m) + & + dumfhi*scavimptblvol(jgrow+1,m) + scavimpnum = dumflo*scavimptblnum(jgrow,m) + & + dumfhi*scavimptblnum(jgrow+1,m) + + end if + + ! impaction scavenging removal amount for volume + scavcoefvol(i,k) = exp( scavimpvol ) + ! impaction scavenging removal amount to number + scavcoefnum(i,k) = exp( scavimpnum ) + + ! scavcoef = impaction scav rate (1/h) for precip = 1 mm/h + ! scavcoef = impaction scav rate (1/s) for precip = pfx_inrain + ! (scavcoef/3600) = impaction scav rate (1/s) for precip = 1 mm/h + ! (pfx_inrain*3600) = in-rain-area precip rate (mm/h) + ! impactrate = (scavcoef/3600) * (pfx_inrain*3600) + else + scavcoefvol(i,k) = 0._r8 + scavcoefnum(i,k) = 0._r8 + end if + + end do + end do + + return + end subroutine modal_aero_bcscavcoef_get + + !=============================================================================== + subroutine calc_1_impact_rate( & + dg0, sigmag, rhoaero, temp, press, & + scavratenum, scavratevol, lunerr ) + ! + ! routine computes a single impaction scavenging rate + ! for precipitation rate of 1 mm/h + ! + ! dg0 = geometric mean diameter of aerosol number size distrib. (cm) + ! sigmag = geometric standard deviation of size distrib. + ! rhoaero = density of aerosol particles (g/cm^3) + ! temp = temperature (K) + ! press = pressure (dyne/cm^2) + ! scavratenum = number scavenging rate (1/h) + ! scavratevol = volume or mass scavenging rate (1/h) + ! lunerr = logical unit for error message + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, & + gravity => gravity_cgs, rgas => rgas_cgs + + implicit none + + ! subr. parameters + integer lunerr + real(r8) dg0, sigmag, rhoaero, temp, press, scavratenum, scavratevol + + ! local variables + integer nrainsvmax + parameter (nrainsvmax=50) + real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),& + vfallrainsv(nrainsvmax) + + integer naerosvmax + parameter (naerosvmax=51) + real(r8) aaerosv(naerosvmax), & + ynumaerosv(naerosvmax), yvolaerosv(naerosvmax) + + integer i, ja, jr, na, nr + real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc + real(r8) anumsum, avolsum, cair, chi + real(r8) d, dr, dum, dumfuchs, dx + real(r8) ebrown, eimpact, eintercept, etotal, freepath + real(r8) precip, precipmmhr, precipsum + real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum + real(r8) scavsumnum, scavsumnumbb + real(r8) scavsumvol, scavsumvolbb + real(r8) schmidt, sqrtreynolds, sstar, stokes, sx + real(r8) taurelax, vfall, vfallstp + real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + + + rlo = .005_r8 + rhi = .250_r8 + dr = 0.005_r8 + nr = 1 + nint( (rhi-rlo)/dr ) + if (nr .gt. nrainsvmax) then + write(lunerr,9110) + call endrun() + end if + +9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' ) + + precipmmhr = 1.0_r8 + precip = precipmmhr/36000._r8 + + ag0 = dg0/2._r8 + sx = log( sigmag ) + xg0 = log( ag0 ) + xg3 = xg0 + 3._r8*sx*sx + + xlo = xg3 - 4._r8*sx + xhi = xg3 + 4._r8*sx + dx = 0.2_r8*sx + + dx = max( 0.2_r8*sx, 0.01_r8 ) + xlo = xg3 - max( 4._r8*sx, 2._r8*dx ) + xhi = xg3 + max( 4._r8*sx, 2._r8*dx ) + + na = 1 + nint( (xhi-xlo)/dx ) + if (na .gt. naerosvmax) then + write(lunerr,9120) + call endrun() + end if + +9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' ) + + ! air molar density + cair = press/(rgas*temp) + ! air mass density + rhoair = 28.966_r8*cair + ! molecular freepath + freepath = 2.8052e-10_r8/cair + ! air dynamic viscosity + airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * & + ((temp/296.16_r8)**1.5_r8) + ! air kinemaic viscosity + airkinvisc = airdynvisc/rhoair + ! ratio of water viscosity to air viscosity (from Slinn) + xmuwaterair = 60.0_r8 + + ! + ! compute rain drop number concentrations + ! rrainsv = raindrop radius (cm) + ! xnumrainsv = raindrop number concentration (#/cm^3) + ! (number in the bin, not number density) + ! vfallrainsv = fall velocity (cm/s) + ! + precipsum = 0._r8 + do i = 1, nr + r = rlo + (i-1)*dr + rrainsv(i) = r + xnumrainsv(i) = exp( -r/2.7e-2_r8 ) + + d = 2._r8*r + if (d .le. 0.007_r8) then + vfallstp = 2.88e5_r8 * d**2._r8 + else if (d .le. 0.025_r8) then + vfallstp = 2.8008e4_r8 * d**1.528_r8 + else if (d .le. 0.1_r8) then + vfallstp = 4104.9_r8 * d**1.008_r8 + else if (d .le. 0.25_r8) then + vfallstp = 1812.1_r8 * d**0.638_r8 + else + vfallstp = 1069.8_r8 * d**0.235_r8 + end if + + vfall = vfallstp * sqrt(1.204e-3_r8/rhoair) + vfallrainsv(i) = vfall + precipsum = precipsum + vfall*(r**3)*xnumrainsv(i) + end do + precipsum = precipsum*pi*1.333333_r8 + + rnumsum = 0._r8 + do i = 1, nr + xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum) + rnumsum = rnumsum + xnumrainsv(i) + end do + + ! + ! compute aerosol concentrations + ! aaerosv = particle radius (cm) + ! fnumaerosv = fraction of total number in the bin (--) + ! fvolaerosv = fraction of total volume in the bin (--) + ! + anumsum = 0._r8 + avolsum = 0._r8 + do i = 1, na + x = xlo + (i-1)*dx + a = exp( x ) + aaerosv(i) = a + dum = (x - xg0)/sx + ynumaerosv(i) = exp( -0.5_r8*dum*dum ) + yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a + anumsum = anumsum + ynumaerosv(i) + avolsum = avolsum + yvolaerosv(i) + end do + + do i = 1, na + ynumaerosv(i) = ynumaerosv(i)/anumsum + yvolaerosv(i) = yvolaerosv(i)/avolsum + end do + + + ! + ! compute scavenging + ! + scavsumnum = 0._r8 + scavsumvol = 0._r8 + ! + ! outer loop for rain drop radius + ! + jr_loop: do jr = 1, nr + + r = rrainsv(jr) + vfall = vfallrainsv(jr) + + reynolds = r * vfall / airkinvisc + sqrtreynolds = sqrt( reynolds ) + + ! + ! inner loop for aerosol particle radius + ! + scavsumnumbb = 0._r8 + scavsumvolbb = 0._r8 + + ja_loop: do ja = 1, na + + a = aaerosv(ja) + + chi = a/r + + dum = freepath/a + dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum) + taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc) + + aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8 + aerodiffus = boltz_cgs*temp*taurelax/aeromass + + schmidt = airkinvisc/aerodiffus + stokes = vfall*taurelax/r + + ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / & + (reynolds*schmidt) + + dum = (1._r8 + 2._r8*xmuwaterair*chi) / & + (1._r8 + xmuwaterair/sqrtreynolds) + eintercept = 4._r8*chi*(chi + dum) + + dum = log( 1._r8 + reynolds ) + sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum) + eimpact = 0._r8 + if (stokes .gt. sstar) then + dum = stokes - sstar + eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8 + end if + + etotal = ebrown + eintercept + eimpact + etotal = min( etotal, 1.0_r8 ) + + rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall + + scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja) + scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja) + + enddo ja_loop + + scavsumnum = scavsumnum + scavsumnumbb + scavsumvol = scavsumvol + scavsumvolbb + + enddo jr_loop + + scavratenum = scavsumnum*3600._r8 + scavratevol = scavsumvol*3600._r8 + + return + end subroutine calc_1_impact_rate + + !============================================================================= + !============================================================================= + subroutine qqcw2vmr(lchnk, vmr, mbar, ncol, im, pbuf) + use modal_aero_data, only : qqcw_get_field + use physics_buffer, only : physics_buffer_desc + !----------------------------------------------------------------- + ! ... Xfrom from mass to volume mixing ratio + !----------------------------------------------------------------- + + use chem_mods, only : adv_mass, gas_pcnst + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: lchnk, ncol, im + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(inout) :: vmr(ncol,pver,gas_pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m + real(r8), pointer :: fldcw(:,:) + + do m=1,gas_pcnst + if( adv_mass(m) /= 0._r8 ) then + fldcw => qqcw_get_field(pbuf, m+im,lchnk,errorhandle=.true.) + if(associated(fldcw)) then + do k=1,pver + vmr(:ncol,k,m) = mbar(:ncol,k) * fldcw(:ncol,k) / adv_mass(m) + end do + else + vmr(:,:,m) = 0.0_r8 + end if + end if + end do + end subroutine qqcw2vmr + + + !============================================================================= + !============================================================================= + subroutine vmr2qqcw( lchnk, vmr, mbar, ncol, im, pbuf ) + !----------------------------------------------------------------- + ! ... Xfrom from volume to mass mixing ratio + !----------------------------------------------------------------- + + use m_spc_id + use chem_mods, only : adv_mass, gas_pcnst + use modal_aero_data, only : qqcw_get_field + use physics_buffer, only : physics_buffer_desc + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: lchnk, ncol, im + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m + real(r8), pointer :: fldcw(:,:) + !----------------------------------------------------------------- + ! ... The non-group species + !----------------------------------------------------------------- + do m = 1,gas_pcnst + fldcw => qqcw_get_field(pbuf, m+im,lchnk,errorhandle=.true.) + if( adv_mass(m) /= 0._r8 .and. associated(fldcw)) then + do k = 1,pver + fldcw(:ncol,k) = adv_mass(m) * vmr(:ncol,k,m) / mbar(:ncol,k) + end do + end if + end do + + end subroutine vmr2qqcw + + function get_dlndg_nimptblgrow() result (dlndg_nimptblgrow_ret) + real(r8) :: dlndg_nimptblgrow_ret + dlndg_nimptblgrow_ret = dlndg_nimptblgrow + end function get_dlndg_nimptblgrow + + function get_scavimptblvol() result (scavimptblvol_ret) + real(r8) :: scavimptblvol_ret(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) + scavimptblvol_ret = scavimptblvol + end function get_scavimptblvol + + function get_scavimptblnum() result (scavimptblnum_ret) + real(r8) :: scavimptblnum_ret(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) + scavimptblnum_ret = scavimptblnum + end function get_scavimptblnum + +end module aero_model diff --git a/src/chemistry/modal_aero/dust_model.F90 b/src/chemistry/modal_aero/dust_model.F90 new file mode 100644 index 0000000000..122fed7ff1 --- /dev/null +++ b/src/chemistry/modal_aero/dust_model.F90 @@ -0,0 +1,187 @@ +!=============================================================================== +! Dust for Modal Aerosol Model +!=============================================================================== +module dust_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use modal_aero_data, only: ntot_amode, ndst=>nDust + + implicit none + private + + public :: dust_names + public :: dust_nbin + public :: dust_nnum + public :: dust_indices + public :: dust_emis + public :: dust_readnl + public :: dust_init + public :: dust_active + + integer, protected :: dust_nbin != 2 + integer, protected :: dust_nnum != 2 + character(len=6), protected, allocatable :: dust_names(:) + + real(r8), allocatable :: dust_dmt_grd(:) + real(r8), allocatable :: dust_emis_sclfctr(:) + + integer , protected, allocatable :: dust_indices(:) + real(r8), allocatable :: dust_dmt_vwr(:) + real(r8), allocatable :: dust_stk_crc(:) + + real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset + + logical :: dust_active = .false. + + contains + + !============================================================================= + ! reads dust namelist options + !============================================================================= + subroutine dust_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'dust_readnl' + + namelist /dust_nl/ dust_emis_fact, soil_erod_file + + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'dust_nl', status=ierr) + if (ierr == 0) then + read(unitn, dust_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) + call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) +#endif + + end subroutine dust_readnl + + !============================================================================= + !============================================================================= + subroutine dust_init() + use soil_erod_mod, only: soil_erod_init + use constituents, only: cnst_get_ind + use rad_constituents, only: rad_cnst_get_info + use dust_common, only: dust_set_params + + integer :: l, m, mm, ndx, nspec + character(len=32) :: spec_name + integer, parameter :: mymodes(7) = (/ 2, 1, 3, 4, 5, 6, 7 /) ! tricky order ... + + dust_nbin = ndst + dust_nnum = ndst + + allocate( dust_names(2*ndst) ) + allocate( dust_indices(2*ndst) ) + allocate( dust_dmt_grd(ndst+1) ) + allocate( dust_emis_sclfctr(ndst) ) + allocate( dust_dmt_vwr(ndst) ) + allocate( dust_stk_crc(ndst) ) + + if ( ntot_amode == 3 ) then + dust_dmt_grd(:) = (/ 0.1e-6_r8, 1.0e-6_r8, 10.0e-6_r8/) + dust_emis_sclfctr(:) = (/ 0.011_r8,0.989_r8 /) + elseif ( ntot_amode == 4 ) then + dust_dmt_grd(:) = (/ 0.01e-6_r8, 0.1e-6_r8, 1.0e-6_r8, 10.0e-6_r8 /) ! Aitken dust + dust_emis_sclfctr(:) = (/ 1.65E-05_r8, 0.011_r8, 0.989_r8 /) ! Aitken dust + else if( ntot_amode == 7 ) then + dust_dmt_grd(:) = (/ 0.1e-6_r8, 2.0e-6_r8, 10.0e-6_r8/) + dust_emis_sclfctr(:) = (/ 0.13_r8, 0.87_r8 /) + endif + + ndx = 0 + do mm = 1, ntot_amode + m = mymodes(mm) + call rad_cnst_get_info(0, m, nspec=nspec) + do l = 1, nspec + call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + if (spec_name(:3) == 'dst') then + ndx=ndx+1 + dust_names(ndx) = spec_name + dust_names(ndst+ndx) = 'num_'//spec_name(5:) + call cnst_get_ind(dust_names( ndx), dust_indices( ndx)) + call cnst_get_ind(dust_names(ndst+ndx), dust_indices(ndst+ndx)) + endif + enddo + enddo + + dust_active = any(dust_indices(:) > 0) + if (.not.dust_active) return + + call soil_erod_init( dust_emis_fact, soil_erod_file ) + + call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) + + end subroutine dust_init + + !=============================================================================== + !=============================================================================== + subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) + use soil_erod_mod, only : soil_erod_fact + use soil_erod_mod, only : soil_erodibility + use mo_constants, only : dust_density + use physconst, only : pi + + ! args + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: dust_flux_in(:,:) + real(r8), intent(inout) :: cflx(:,:) + real(r8), intent(out) :: soil_erod(:) + + ! local vars + integer :: i, m, idst, inum + real(r8) :: x_mton + real(r8),parameter :: soil_erod_threshold = 0.1_r8 + + ! set dust emissions + + col_loop: do i =1,ncol + + soil_erod(i) = soil_erodibility( i, lchnk ) + + if( soil_erod(i) .lt. soil_erod_threshold ) soil_erod(i) = 0._r8 + + ! rebin and adjust dust emissons.. + do m = 1,dust_nbin + + idst = dust_indices(m) + + cflx(i,idst) = sum( -dust_flux_in(i,:) ) & + * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 + + x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) + + inum = dust_indices(m+dust_nbin) + + cflx(i,inum) = cflx(i,idst)*x_mton + + enddo + + end do col_loop + + end subroutine dust_emis + +end module dust_model diff --git a/src/chemistry/modal_aero/modal_aero_coag.F90 b/src/chemistry/modal_aero/modal_aero_coag.F90 new file mode 100644 index 0000000000..4e3219ed97 --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_coag.F90 @@ -0,0 +1,2897 @@ +! modal_aero_coag.F90 + + +!---------------------------------------------------------------------- +!BOP +! +! !MODULE: modal_aero_coag --- modal aerosol coagulation +! +! !INTERFACE: + module modal_aero_coag + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use chem_mods, only: gas_pcnst + use modal_aero_data, only: nspec_max + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public modal_aero_coag_sub, modal_aero_coag_init + +! !PUBLIC DATA MEMBERS: + integer, parameter :: pcnstxx = gas_pcnst + +#if ( defined MODAL_AERO_7MODE || defined MODAL_AERO_4MODE ) + integer, parameter, public :: pair_option_acoag = 3 +#elif ( defined MODAL_AERO_3MODE ) + integer, parameter, public :: pair_option_acoag = 1 +#endif +! specifies pairs of modes for which coagulation is calculated +! 1 -- [aitken-->accum] +! 2 -- [aitken-->accum], and [pcarbon-->accum] +! 3 -- [aitken-->accum], [pcarbon-->accum], +! and [aitken-->pcarbon--(aging)-->accum] +! other -- do no coag + + integer, parameter, public :: maxpair_acoag = 10 + integer, protected, public :: maxspec_acoag != nspec_max + + integer, protected, public :: npair_acoag + integer, protected, public :: modefrm_acoag(maxpair_acoag) + integer, protected, public :: modetoo_acoag(maxpair_acoag) + integer, protected, public :: modetooeff_acoag(maxpair_acoag) + integer, protected, public :: nspecfrm_acoag(maxpair_acoag) + integer, allocatable, protected, public :: lspecfrm_acoag(:,:) + integer, allocatable, protected, public :: lspectoo_acoag(:,:) + + integer :: ip_aitacc, ip_aitpca, ip_pcaacc + real(r8), allocatable :: fac_m2v_aitage(:), fac_m2v_pcarbon(:) + +! !DESCRIPTION: This module implements ... +! +! !REVISION HISTORY: +! +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! list private module data here + +!EOC +!---------------------------------------------------------------------- + contains +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: modal_aero_coag_sub --- ... +! +! !INTERFACE: + subroutine modal_aero_coag_sub( & + lchnk, ncol, nstep, & + loffset, deltat_main, & + t, pmid, pdel, & + q, & + dgncur_a, dgncur_awet, & + wetdens_a ) + + +!---------------------------------------------------------------------- +! Authors: R. Easter +!---------------------------------------------------------------------- + +! !USES: + use mo_constants, only: pi + use modal_aero_data + use modal_aero_gasaerexch, only: n_so4_monolayers_pcage + + use cam_abortutils, only: endrun + use cam_history, only: outfld, fieldname_len + use chem_mods, only: adv_mass + use constituents, only: pcnst, cnst_name + use physconst, only: gravit, mwdry, r_universal + use ppgrid, only: pcols, pver + use spmd_utils, only: iam, masterproc + use ref_pres, only: top_lev => clim_modal_aero_top_lev + + implicit none + +! !PARAMETERS: + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns in chunk + integer, intent(in) :: nstep ! model step + integer, intent(in) :: loffset ! offset applied to modal aero "pointers" + + real(r8), intent(in) :: deltat_main ! model timestep (s) + + real(r8), intent(in) :: t(pcols,pver) ! temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + + real(r8), intent(inout) :: q(ncol,pver,pcnstxx) + ! tracer mixing ratio (TMR) array + ! *** MUST BE mol/mol-air or #/mol-air + ! *** NOTE ncol & pcnstxx dimensions + real(r8), intent(in) :: dgncur_a(pcols,pver,ntot_amode) + ! dry geo. mean dia. (m) of number distrib. + real(r8), intent(in) :: dgncur_awet(pcols,pver,ntot_amode) + ! wet geo. mean dia. (m) of number distrib. + real(r8), intent(in) :: wetdens_a(pcols,pver,ntot_amode) + ! density of wet aerosol (kg/m3) + +! !DESCRIPTION: +! computes changes due to coagulation involving +! aitken mode (modeptr_aitken) with accumulation mode (modeptr_accum) +! this version will +! compute changes to mass and number, but not to surface area +! calculates coagulation rate coefficients using either +! new CMAQ V4.6 fast method +! older cmaq slow method (direct gauss-hermite quadrature) +! +! !REVISION HISTORY: +! RCE 07.04.15: Adapted from MIRAGE2 code and CMAQ V4.6 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer :: i, ipair, iq + integer :: idomode(ntot_amode), iselfcoagdone(ntot_amode) + integer :: jfreqcoag, jsoa + integer :: k + integer :: l, l2, lmz, lsfrm, lstoo, lunout + integer :: modefrm, modetoo, mait, macc, mpca + integer :: n, nfreqcoag + + + integer, save :: nerr = 0 ! number of errors for entire run + integer, save :: nerrmax = 9999 ! maximum number of errors before abort + integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1 + + logical, parameter :: fastcoag_flag = .true. ! selects coag rate-coef method + + real(r8) :: aircon + real(r8) :: deltat, deltatinv_main + real(r8) :: dr_so4_monolayers_pcage + real(r8) :: dumexp, dumloss, dumprod + real(r8) :: dumsfc_frm_old, dumsfc_frm_new + real(r8) :: dum_m2v + real(r8) :: fac_volsfc_pcarbon + real(r8) :: lnsg_frm, lnsg_too + real(r8) :: sg_frm, sg_too + real(r8) :: tmpa, tmpb, tmpc, tmpf, tmpg, tmph, tmpn + real(r8) :: tmp1, tmp2 + real(r8) :: tmp_qold + real(r8) :: vol_core, vol_shell + real(r8) :: wetdens_frm, wetdens_too, wetdgnum_frm, wetdgnum_too + real(r8) :: xbetaij0, xbetaij2i, xbetaij2j, xbetaij3, & + xbetaii0, xbetaii2, xbetajj0, xbetajj2 + real(r8) :: xferamt, xferfracvol, xferfrac_pcage, xferfrac_max + real(r8) :: xnumbconc(ntot_amode) + real(r8) :: xnumbconcavg(ntot_amode), xnumbconcnew(ntot_amode) + real(r8) :: ybetaij0(maxpair_acoag), ybetaij3(maxpair_acoag) + real(r8) :: ybetaii0(maxpair_acoag), ybetajj0(maxpair_acoag) + + real(r8) :: dqdt(ncol,pver,pcnstxx) ! TMR "dq/dt" array - NOTE dims + logical :: dotend(pcnst) ! identifies the species that + ! tendencies are computed for + real(r8) :: qsrflx(pcols) + + character(len=fieldname_len+3) :: fieldname + +! begin +! check if any coagulation pairs exist + if (npair_acoag <= 0) return + +!-------------------------------------------------------------------------------- +!!$ if (ldiag1 > 0) then +!!$ if (nstep <= 3) then +!!$ do i = 1, ncol +!!$ if (lonndx(i) /= 37) cycle +!!$ if (latndx(i) /= 23) cycle +!!$ if (nstep > 3) cycle +!!$ write( *, '(/a,i7,i5,2(2x,2i5))' ) & +!!$ '*** modal_aero_coag_sub -- nstep, iam, lat, lon, pcols, ncol =', & +!!$ nstep, iam, latndx(i), lonndx(i), pcols, ncol +!!$ end do +!!$ end if +!!$! if (ncol /= -999888777) return +!!$ if (nstep > 3) call endrun( 'modal_aero_coag_sub -- nstep>3 testing halt' ) +!!$ end if ! (ldiag1 > 0) +!-------------------------------------------------------------------------------- + + dotend(:) = .false. + dqdt(1:ncol,:,:) = 0.0_r8 + + lunout = 6 + + +! +! determine if coagulation will be done on this time-step +! currently coagulation is done every 3 hours +! +! deltat = 3600.0*3.0 + deltat = deltat_main + nfreqcoag = max( 1, nint( deltat/deltat_main ) ) + jfreqcoag = nfreqcoag/2 + xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps + + if (nfreqcoag .gt. 1) then + if ( mod(nstep,nfreqcoag) .ne. jfreqcoag ) return + end if + +! +! set idomode +! + idomode(:) = 0 + do ipair = 1, npair_acoag + idomode(modefrm_acoag(ipair)) = 1 + idomode(modetoo_acoag(ipair)) = 1 + end do + +! +! other init +! + macc = modeptr_accum + mait = modeptr_aitken + mpca = modeptr_pcarbon + + if (mpca > 0 .and. mpca <= ntot_amode) then + ! use 1 mol (bi-)sulfate = 65 cm^3 --> 1 molecule = (4.76e-10 m)^3 + dr_so4_monolayers_pcage = n_so4_monolayers_pcage * 4.76e-10_r8 + fac_volsfc_pcarbon = exp( 2.5_r8*(alnsg_amode(mpca)**2) ) + end if + +! +! loop over levels and columns to calc the coagulation +! +! integrate coagulation changes over deltat = nfreqcoag*deltat_main +! then compute tendencies as +! dqdt = (q(t+deltat) - q(t))/deltat_main +! because tendencies are applied (in physics_update) over deltat_main +! + deltat = nfreqcoag*deltat_main + deltatinv_main = 1.0_r8/(deltat_main*(1.0_r8 + 1.0e-15_r8)) + +main_k: do k = top_lev, pver +main_i: do i = 1, ncol + +! air molar density (kmol/m3) + aircon = (pmid(i,k)/(r_universal*t(i,k))) + +! calculate number conc. (#/m3) for modes doing coagulation + do n = 1, ntot_amode + if (idomode(n) .gt. 0) then + xnumbconc(n) = q(i,k,numptr_amode(n)-loffset)*aircon + xnumbconc(n) = max( 0.0_r8, xnumbconc(n) ) + end if + iselfcoagdone(n) = 0 + end do + +! +! calculate coagulation rates for each pair +! +main_ipair1: do ipair = 1, npair_acoag + + modefrm = modefrm_acoag(ipair) + modetoo = modetoo_acoag(ipair) + +! +! compute coagulation rates using cmaq "fast" method +! (based on E. Whitby's approximation approach) +! here subr. arguments are all in mks unit +! + call getcoags_wrapper_f( & + t(i,k), pmid(i,k), & + dgncur_awet(i,k,modefrm), dgncur_awet(i,k,modetoo), & + sigmag_amode(modefrm), sigmag_amode(modetoo), & + alnsg_amode(modefrm), alnsg_amode(modetoo), & + wetdens_a(i,k,modefrm), wetdens_a(i,k,modetoo), & + xbetaij0, xbetaij2i, xbetaij2j, xbetaij3, & + xbetaii0, xbetaii2, xbetajj0, xbetajj2 ) + + +! test diagnostics begin -------------------------------------------- +!!$ if (ldiag2 > 0) then +!!$ if (nstep <= 3) then +!!$ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) then +!!$ if ((mod(k-1,5) == 0) .or. (k>=23)) then +!!$ +!!$ wetdgnum_frm = dgncur_awet(i,k,modefrm) +!!$ wetdgnum_too = dgncur_awet(i,k,modetoo) +!!$ wetdens_frm = wetdens_a(i,k,modefrm) +!!$ wetdens_too = wetdens_a(i,k,modetoo) +!!$ sg_frm = sigmag_amode(modefrm) +!!$ sg_too = sigmag_amode(modetoo) +!!$ lnsg_frm = alnsg_amode(modefrm) +!!$ lnsg_too = alnsg_amode(modetoo) +!!$ +!!$ call getcoags_wrapper_f( & +!!$ t(i,k), pmid(i,k), & +!!$ wetdgnum_frm, wetdgnum_too, & +!!$ sg_frm, sg_too, & +!!$ lnsg_frm, lnsg_too, & +!!$ wetdens_frm, wetdens_too, & +!!$ xbetaij0, xbetaij2i, xbetaij2j, xbetaij3, & +!!$ xbetaii0, xbetaii2, xbetajj0, xbetajj2 ) +!!$ +!!$ +!!$ write(lunout,9801) +!!$ write(lunout,9810) 'nstep,lat,lon,k,ipair ', & +!!$ nstep, latndx(i), lonndx(i), k, ipair +!!$ write(lunout,9820) 'tk, pmb, aircon, pdel ', & +!!$ t(i,k), pmid(i,k)*1.0e-2_r8, aircon, pdel(i,k)*1.0e-2_r8 +!!$ write(lunout,9820) 'wetdens-cgs, sg f/t', & +!!$ wetdens_frm*1.0e-3_r8, wetdens_too*1.0e-3_r8, & +!!$ sg_frm, sg_too +!!$ write(lunout,9820) 'dgnwet-um, dgndry-um f/t', & +!!$ 1.0e6_r8*wetdgnum_frm, 1.0e6_r8*wetdgnum_too, & +!!$ 1.0e6_r8*dgncur_a(i,k,modefrm), 1.0e6_r8*dgncur_a(i,k,modetoo) +!!$ write(lunout,9820) 'xbeta ij0, ij3, ii0, jj0', & +!!$ xbetaij0, xbetaij3, xbetaii0, xbetajj0 +!!$ write(lunout,9820) 'xbeta ij2i & j, ii2, jj2', & +!!$ xbetaij2i, xbetaij2j, xbetaii2, xbetajj2 +!!$ write(lunout,9820) 'numbii, numbjj, deltat ', & +!!$ xnumbconc(modefrm), xnumbconc(modetoo), deltat +!!$ write(lunout,9820) 'loss ij3, ii0, jj0 ', & +!!$ (xbetaij3*xnumbconc(modetoo)*deltat), & +!!$ (xbetaij0*xnumbconc(modetoo)*deltat+ & +!!$ xbetaii0*xnumbconc(modefrm)*deltat), & +!!$ (xbetajj0*xnumbconc(modetoo)*deltat) +!!$ 9801 format( / 72x, 'ACOAG' ) +!!$ 9810 format( 'ACOAG ', a, 2i8, 3i7, 3(1pe15.6) ) +!!$ 9820 format( 'ACOAG ', a, 4(1pe15.6) ) +!!$ 9830 format( 'ACOAG ', a, i1, a, 4(1pe15.6) ) +!!$ end if +!!$ end if +!!$ end if +!!$ end if ! (ldiag2 > 0) +! test diagnostics end ---------------------------------------------- + + ybetaij0(ipair) = xbetaij0 + ybetaij3(ipair) = xbetaij3 + ybetaii0(ipair) = xbetaii0 + ybetajj0(ipair) = xbetajj0 + + end do main_ipair1 + + + + if ( (pair_option_acoag == 1) .or. & + (pair_option_acoag == 2) ) then +! +! calculate number and mass changes for pair_option_acoag == 1,2 +! +main_ipair2: do ipair = 1, npair_acoag + + modefrm = modefrm_acoag(ipair) + modetoo = modetoo_acoag(ipair) + +! calculate number changes +! apply self-coagulation losses only once to a mode (when iselfcoagdone=0) +! first calc change to "too" mode +! next calc change to "frm" mode, using average number conc of "too" + if ( (mprognum_amode(modetoo) > 0) .and. & + (iselfcoagdone(modetoo) <= 0) ) then + iselfcoagdone(modetoo) = 1 + tmpn = xnumbconc(modetoo) + xnumbconcnew(modetoo) = tmpn/(1.0_r8 + deltat*ybetajj0(ipair)*tmpn) + xnumbconcavg(modetoo) = 0.5_r8*(xnumbconcnew(modetoo) + tmpn) + lstoo = numptr_amode(modetoo) - loffset + q(i,k,lstoo) = xnumbconcnew(modetoo)/aircon + dqdt(i,k,lstoo) = (xnumbconcnew(modetoo)-tmpn)*deltatinv_main/aircon + end if + + if ( (mprognum_amode(modefrm) > 0) .and. & + (iselfcoagdone(modefrm) <= 0) ) then + iselfcoagdone(modefrm) = 1 + tmpn = xnumbconc(modefrm) + tmpa = deltat*ybetaij0(ipair)*xnumbconcavg(modetoo) + tmpb = deltat*ybetaii0(ipair) + tmpc = tmpa + tmpb*tmpn + if (abs(tmpc) < 0.01_r8) then + xnumbconcnew(modefrm) = tmpn*exp(-tmpc) + else if (abs(tmpa) < 0.001_r8) then + xnumbconcnew(modefrm) = & + exp(-tmpa)*tmpn/(1.0_r8 + tmpb*tmpn) + else + tmpf = tmpb*tmpn/tmpc + tmpg = exp(-tmpa) + tmph = tmpg*(1.0_r8 - tmpf)/(1.0_r8 - tmpg*tmpf) + xnumbconcnew(modefrm) = tmpn*max( 0.0_r8, min( 1.0_r8, tmph ) ) + end if + xnumbconcavg(modefrm) = 0.5_r8*(xnumbconcnew(modefrm) + tmpn) + lsfrm = numptr_amode(modefrm) - loffset + q(i,k,lsfrm) = xnumbconcnew(modefrm)/aircon + dqdt(i,k,lsfrm) = (xnumbconcnew(modefrm)-tmpn)*deltatinv_main/aircon + end if + +! calculate mass changes +! xbetaij3*xnumbconc(modetoo) = first order loss rate for modefrm volume +! xferfracvol = fraction of modefrm volume transferred to modetoo over deltat + dumloss = ybetaij3(ipair)*xnumbconcavg(modetoo) + xferfracvol = 1.0_r8 - exp( -dumloss*deltat ) + xferfracvol = max( 0.0_r8, min( xferfrac_max, xferfracvol ) ) + + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) - loffset + lstoo = lspectoo_acoag(iq,ipair) - loffset + if (lsfrm > 0) then + xferamt = q(i,k,lsfrm)*xferfracvol + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xferamt*deltatinv_main + q(i,k,lsfrm) = q(i,k,lsfrm) - xferamt + if (lstoo > 0) then + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xferamt*deltatinv_main + q(i,k,lstoo) = q(i,k,lstoo) + xferamt + end if + end if + end do + + end do main_ipair2 + + + else if (pair_option_acoag == 3) then +! +! calculate number and mass changes for pair_option_acoag == 3 +! + +! calculate number changes to accum mode + if (mprognum_amode(macc) > 0) then + tmpn = xnumbconc(macc) + xnumbconcnew(macc) = tmpn/(1.0_r8 + deltat*ybetajj0(ip_aitacc)*tmpn) + xnumbconcavg(macc) = 0.5_r8*(xnumbconcnew(macc) + tmpn) + lstoo = numptr_amode(macc) - loffset + q(i,k,lstoo) = xnumbconcnew(macc)/aircon + dqdt(i,k,lstoo) = (xnumbconcnew(macc)-tmpn)*deltatinv_main/aircon + end if + +! calculate number changes to primary carbon mode + modefrm = modeptr_pcarbon + if (mprognum_amode(mpca) > 0) then + tmpn = xnumbconc(mpca) + tmpa = deltat*ybetaij0(ip_pcaacc)*xnumbconcavg(macc) + tmpb = deltat*ybetaii0(ip_pcaacc) + tmpc = tmpa + tmpb*tmpn + if (abs(tmpc) < 0.01_r8) then + xnumbconcnew(mpca) = tmpn*exp(-tmpc) + else if (abs(tmpa) < 0.001_r8) then + xnumbconcnew(mpca) = & + exp(-tmpa)*tmpn/(1.0_r8 + tmpb*tmpn) + else + tmpf = tmpb*tmpn/tmpc + tmpg = exp(-tmpa) + tmph = tmpg*(1.0_r8 - tmpf)/(1.0_r8 - tmpg*tmpf) + xnumbconcnew(mpca) = tmpn*max( 0.0_r8, min( 1.0_r8, tmph ) ) + end if + xnumbconcavg(mpca) = 0.5_r8*(xnumbconcnew(mpca) + tmpn) + lsfrm = numptr_amode(mpca) - loffset + q(i,k,lsfrm) = xnumbconcnew(mpca)/aircon + dqdt(i,k,lsfrm) = (xnumbconcnew(mpca)-tmpn)*deltatinv_main/aircon + end if + +! calculate number changes to aitken mode + if (mprognum_amode(mait) > 0) then + tmpn = xnumbconc(mait) + tmpa = deltat*( ybetaij0(ip_aitacc)*xnumbconcavg(macc) & + + ybetaij0(ip_aitpca)*xnumbconcavg(mpca) ) + tmpb = deltat*ybetaii0(ip_aitacc) + tmpc = tmpa + tmpb*tmpn + if (abs(tmpc) < 0.01_r8) then + xnumbconcnew(mait) = tmpn*exp(-tmpc) + else if (abs(tmpa) < 0.001_r8) then + xnumbconcnew(mait) = & + exp(-tmpa)*tmpn/(1.0_r8 + tmpb*tmpn) + else + tmpf = tmpb*tmpn/tmpc + tmpg = exp(-tmpa) + tmph = tmpg*(1.0_r8 - tmpf)/(1.0_r8 - tmpg*tmpf) + xnumbconcnew(mait) = tmpn*max( 0.0_r8, min( 1.0_r8, tmph ) ) + end if + xnumbconcavg(mait) = 0.5_r8*(xnumbconcnew(mait) + tmpn) + lsfrm = numptr_amode(mait) - loffset + q(i,k,lsfrm) = xnumbconcnew(mait)/aircon + dqdt(i,k,lsfrm) = (xnumbconcnew(mait)-tmpn)*deltatinv_main/aircon + end if + + +! calculate mass changes from aitken-->accum direct coagulation and +! aitken-->pcarbon-->accum coagulation/aging +! also calc volume of shell material (so4 & nh4 from aitken-->pcarbon) + dumloss = ybetaij3(ip_aitacc)*xnumbconcavg(macc) & + + ybetaij3(ip_aitpca)*xnumbconcavg(mpca) + tmpa = ybetaij3(ip_aitpca)*xnumbconcavg(mpca)/max( dumloss, 1.0e-37_r8 ) + xferfracvol = 1.0_r8 - exp( -dumloss*deltat ) + xferfracvol = max( 0.0_r8, min( xferfrac_max, xferfracvol ) ) + vol_shell = 0.0_r8 + + ipair = ip_aitacc + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) - loffset + lstoo = lspectoo_acoag(iq,ipair) - loffset + if (lsfrm > 0) then + xferamt = q(i,k,lsfrm)*xferfracvol + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xferamt*deltatinv_main + q(i,k,lsfrm) = q(i,k,lsfrm) - xferamt + if (lstoo > 0) then + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xferamt*deltatinv_main + q(i,k,lstoo) = q(i,k,lstoo) + xferamt + end if + vol_shell = vol_shell + xferamt*tmpa*fac_m2v_aitage(iq) + end if + end do + + +! now calculate aging transfer fraction for pcarbon-->accum +! this duplicates the code in modal_aero_gasaerexch + vol_core = 0.0_r8 + do l = 1, nspec_amode(mpca) + vol_core = vol_core + & + q(i,k,lmassptr_amode(l,mpca)-loffset)*fac_m2v_pcarbon(l) + end do + tmp1 = vol_shell*dgncur_a(i,k,mpca)*fac_volsfc_pcarbon + tmp2 = 6.0_r8*dr_so4_monolayers_pcage*vol_core + tmp2 = max( tmp2, 0.0_r8 ) + if (tmp1 >= tmp2) then + xferfrac_pcage = xferfrac_max + else + xferfrac_pcage = min( tmp1/tmp2, xferfrac_max ) + end if + + +! calculate mass changes from pcarbon-->accum by direct coagulation +! and aging + dumloss = ybetaij3(ip_pcaacc)*xnumbconcavg(macc) + xferfracvol = 1.0_r8 - exp( -dumloss*deltat ) + xferfracvol = xferfracvol + xferfrac_pcage + xferfracvol = max( 0.0_r8, min( xferfrac_max, xferfracvol ) ) + + ipair = ip_pcaacc + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) - loffset + lstoo = lspectoo_acoag(iq,ipair) - loffset + if (lsfrm > 0) then + xferamt = q(i,k,lsfrm)*xferfracvol + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xferamt*deltatinv_main + q(i,k,lsfrm) = q(i,k,lsfrm) - xferamt + if (lstoo > 0) then + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xferamt*deltatinv_main + q(i,k,lstoo) = q(i,k,lstoo) + xferamt + end if + end if + end do + + lsfrm = numptr_amode(mpca) - loffset + lstoo = numptr_amode(macc) - loffset + if (lsfrm > 0) then + xferamt = q(i,k,lsfrm)*xferfrac_pcage + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xferamt*deltatinv_main + q(i,k,lsfrm) = q(i,k,lsfrm) - xferamt + if (lstoo > 0) then + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xferamt*deltatinv_main + q(i,k,lstoo) = q(i,k,lstoo) + xferamt + end if + end if + + + + else ! (pair_option_acoag /= 1,2,3) then + + write(lunout,*) '*** modal_aero_coag_sub error' + write(lunout,*) ' cannot do _coag_sub error pair_option_acoag =', & + pair_option_acoag + call endrun( 'modal_aero_coag_sub error' ) + + + end if ! (pair_option_acoag == ...) + + +! test diagnostics begin -------------------------------------------- +!!$ if (ldiag3 > 0) then +!!$ if (nstep <= 3) then +!!$ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) then +!!$ if ((mod(k-1,5) == 0) .or. (k>=23)) then +!!$ if (pair_option_acoag == 3) then +!!$ write(*,*) +!!$ write(lunout,9820) 'xnumbconcavg ait,acc,pca', & +!!$ xnumbconcavg(mait), xnumbconcavg(macc), xnumbconcavg(mpca) +!!$ write(lunout,9820) 'vshell, core ', & +!!$ vol_shell, vol_core +!!$ write(lunout,9820) 'dr_mono, dgn ', & +!!$ dr_so4_monolayers_pcage, dgncur_a(i,k,mpca) +!!$ write(lunout,9820) 'tmp1, tmp2 ', tmp1, tmp2 +!!$ write(lunout,9820) 'xferfrac_age ', xferfrac_pcage +!!$ end if +!!$ +!!$ do ipair = 1, npair_acoag +!!$ modefrm = modefrm_acoag(ipair) +!!$ modetoo = modetoo_acoag(ipair) +!!$ if (npair_acoag > 1) then +!!$ write(lunout,*) +!!$ write(lunout,9810) 'ipair = ', ipair +!!$ end if +!!$ +!!$ do iq = 1, nspecfrm_acoag(ipair) +!!$ lsfrm = lspecfrm_acoag(iq,ipair) - loffset +!!$ lstoo = lspectoo_acoag(iq,ipair) - loffset +!!$ if (lsfrm > 0) then +!!$ tmp_qold = q(i,k,lsfrm) - dqdt(i,k,lsfrm)*deltat_main +!!$! write(lunout,9820) 'm1 frm dqdt/q0,dqdt,q0/1', & +!!$ write(lunout,9830) 'm', iq, & +!!$ ' frm dqdt/q0,dqdt,q0/1', & +!!$ dqdt(i,k,lsfrm)/tmp_qold, dqdt(i,k,lsfrm), tmp_qold, q(i,k,lsfrm) +!!$ end if +!!$ if (lstoo > 0) then +!!$ tmp_qold = q(i,k,lstoo) - dqdt(i,k,lstoo)*deltat_main +!!$ write(lunout,9830) 'm', iq, & +!!$ ' too dqdt/q0,dqdt,q0/1', & +!!$ dqdt(i,k,lstoo)/tmp_qold, dqdt(i,k,lstoo), tmp_qold, q(i,k,lstoo) +!!$ end if +!!$ end do ! iq +!!$ +!!$ lsfrm = numptr_amode(modefrm) - loffset +!!$ lstoo = numptr_amode(modetoo) - loffset +!!$ if (lsfrm > 0) then +!!$ tmp_qold = q(i,k,lsfrm) - dqdt(i,k,lsfrm)*deltat_main +!!$ write(lunout,9820) 'n frm dqdt/q0,dqdt,q0/1', & +!!$ dqdt(i,k,lsfrm)/tmp_qold, dqdt(i,k,lsfrm), tmp_qold, q(i,k,lsfrm) +!!$ end if +!!$ if (lstoo > 0) then +!!$ tmp_qold = q(i,k,lstoo) - dqdt(i,k,lstoo)*deltat_main +!!$ write(lunout,9820) 'n too dqdt/q0,dqdt,q0/1', & +!!$ dqdt(i,k,lstoo)/tmp_qold, dqdt(i,k,lstoo), tmp_qold, q(i,k,lstoo) +!!$ end if +!!$ +!!$ end do ! ipair +!!$ end if +!!$ end if +!!$ end if +!!$ end if ! (ldiag3 > 0) +! test diagnostics end ---------------------------------------------- + + + + end do main_i + end do main_k + + +! set dotend's + do ipair = 1, npair_acoag + modefrm = modefrm_acoag(ipair) + modetoo = modetoo_acoag(ipair) + + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) - loffset + lstoo = lspectoo_acoag(iq,ipair) - loffset + if (lsfrm > 0) dotend(lsfrm) = .true. + if (lstoo > 0) dotend(lstoo) = .true. + end do + + if (mprognum_amode(modefrm) > 0) then + lsfrm = numptr_amode(modefrm) - loffset + if (lsfrm > 0) dotend(lsfrm) = .true. + end if + if (mprognum_amode(modetoo) > 0) then + lstoo = numptr_amode(modetoo) - loffset + if (lstoo > 0) dotend(lstoo) = .true. + end if + + end do + + +! do history file column-tendency fields + do l = loffset+1, pcnst + lmz = l - loffset + if ( .not. dotend(lmz) ) cycle + + qsrflx(:) = 0.0_r8 + do k = top_lev, pver + do i = 1, ncol + qsrflx(i) = qsrflx(i) + dqdt(i,k,lmz)*pdel(i,k) + end do + end do + qsrflx(:) = qsrflx(:)*(adv_mass(lmz)/(gravit*mwdry)) + fieldname = trim(cnst_name(l)) // '_sfcoag1' + call outfld( fieldname, qsrflx, pcols, lchnk ) +! if (( masterproc ) .and. (nstep < 1)) & +! write(*,'(2(a,2x),1p,e11.3)') & +! 'modal_aero_coag_sub outfld', fieldname, adv_mass(lmz) + end do ! l = ... + + + return + + +!EOC + end subroutine modal_aero_coag_sub + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- + subroutine modal_aero_coag_init +! +! computes pointers for species transfer during coagulation +! + use modal_aero_data + use modal_aero_gasaerexch, only: & + modefrm_pcage, nspecfrm_pcage, lspecfrm_pcage, lspectoo_pcage, & + soa_equivso4_factor + + use cam_abortutils, only: endrun + use cam_history, only: addfld, add_default, fieldname_len, horiz_only + use constituents, only: pcnst, cnst_name + use spmd_utils, only: masterproc + use phys_control, only: phys_getopts + + implicit none + +! local variables + integer :: ipair, iq, iqfrm, iqfrm_aa, iqtoo, iqtoo_aa + integer :: jsoa + integer :: l, l1, l2, lsfrm, lstoo, lunout + integer :: m, mait, mpca, mfrm, mtoo, mtef + integer :: nchfrm, nchfrmskip, nchtoo, nchtooskip, nspec + + character(len=fieldname_len) :: tmpname + character(len=fieldname_len+3) :: fieldname + character(128) :: long_name + character(8) :: unit + + logical :: dotend(pcnst) + logical :: history_aerosol ! Output the MAM aerosol tendencies + + character(len=200) :: msg + + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol ) + + lunout = 6 + + maxspec_acoag = nspec_max + allocate( lspecfrm_acoag(maxspec_acoag,maxpair_acoag) ) + allocate( lspectoo_acoag(maxspec_acoag,maxpair_acoag) ) + allocate( fac_m2v_aitage(nspec_max), fac_m2v_pcarbon(nspec_max) ) + +! +! define "from mode" and "to mode" for each coagulation pairing +! currently just a2-->a1 coagulation +! + if (pair_option_acoag == 1) then + npair_acoag = 1 + modefrm_acoag(1) = modeptr_aitken + modetoo_acoag(1) = modeptr_accum + modetooeff_acoag(1) = modeptr_accum + else if (pair_option_acoag == 2) then + npair_acoag = 2 + modefrm_acoag(1) = modeptr_aitken + modetoo_acoag(1) = modeptr_accum + modetooeff_acoag(1) = modeptr_accum + modefrm_acoag(2) = modeptr_pcarbon + modetoo_acoag(2) = modeptr_accum + modetooeff_acoag(2) = modeptr_accum + else if (pair_option_acoag == 3) then + npair_acoag = 3 + modefrm_acoag(1) = modeptr_aitken + modetoo_acoag(1) = modeptr_accum + modetooeff_acoag(1) = modeptr_accum + modefrm_acoag(2) = modeptr_pcarbon + modetoo_acoag(2) = modeptr_accum + modetooeff_acoag(2) = modeptr_accum + modefrm_acoag(3) = modeptr_aitken + modetoo_acoag(3) = modeptr_pcarbon + modetooeff_acoag(3) = modeptr_accum + if (modefrm_pcage <= 0) then + write(*,*) '*** modal_aero_coag_init error' + write(*,*) ' pair_option_acoag, modefrm_pcage mismatch' + write(*,*) ' pair_option_acoag, modefrm_pcage =', & + pair_option_acoag, modefrm_pcage + call endrun( 'modal_aero_coag_init error' ) + end if + else + npair_acoag = 0 + return + end if + +! +! define species involved in each coagulation pairing +! (include aerosol water) +! +aa_ipair: do ipair = 1, npair_acoag + + mfrm = modefrm_acoag(ipair) + mtoo = modetoo_acoag(ipair) + mtef = modetooeff_acoag(ipair) + if ( (mfrm < 1) .or. (mfrm > ntot_amode) .or. & + (mtoo < 1) .or. (mtoo > ntot_amode) .or. & + (mtef < 1) .or. (mtef > ntot_amode) ) then + write(*,*) '*** modal_aero_coag_init error' + write(*,*) ' ipair, ntot_amode =', ipair, ntot_amode + write(*,*) ' mfrm, mtoo, mtef =', mfrm, mtoo, mtef + call endrun( 'modal_aero_coag_init error' ) + end if + + + mtoo = mtef ! effective modetoo + if (mfrm < 10) then + nchfrmskip = 1 + else if (mfrm < 100) then + nchfrmskip = 2 + else + nchfrmskip = 3 + end if + if (mtoo < 10) then + nchtooskip = 1 + else if (mtoo < 100) then + nchtooskip = 2 + else + nchtooskip = 3 + end if + + nspec = 0 +aa_iqfrm: do iqfrm = 1, nspec_amode(mfrm) + lsfrm = lmassptr_amode(iqfrm,mfrm) + if ((lsfrm .lt. 1) .or. (lsfrm .gt. pcnst)) cycle aa_iqfrm + nchfrm = len( trim( cnst_name(lsfrm) ) ) - nchfrmskip +! find "too" species having same lspectype_amode as the "frm" species +! AND same cnst_name (except for last 1/2/3 characters which are the mode index) + do iqtoo = 1, nspec_amode(mtoo) + lstoo = lmassptr_amode(iqtoo,mtoo) + nchtoo = len( trim( cnst_name(lstoo) ) ) - nchtooskip + if (cnst_name(lsfrm)(1:nchfrm) == cnst_name(lstoo)(1:nchtoo)) then + exit + else + lstoo = 0 + end if + end do + + if ((lstoo < 1) .or. (lstoo > pcnst)) lstoo = 0 + nspec = nspec + 1 + lspecfrm_acoag(nspec,ipair) = lsfrm + lspectoo_acoag(nspec,ipair) = lstoo + end do aa_iqfrm + +! lsfrm = lwaterptr_amode(mfrm) +! if ((lsfrm .ge. 1) .and. (lsfrm .le. pcnst)) then +! lstoo = lwaterptr_amode(mtoo) +! if ((lstoo .lt. 1) .or. (lstoo .gt. pcnst)) lstoo = 0 +! nspec = nspec + 1 +! lspecfrm_acoag(nspec,ipair) = lsfrm +! lspectoo_acoag(nspec,ipair) = lstoo +! end if + + nspecfrm_acoag(ipair) = nspec + end do aa_ipair + +! +! output results +! + if ( masterproc ) then + + write(lunout,9310) + + do ipair = 1, npair_acoag + mfrm = modefrm_acoag(ipair) + mtoo = modetoo_acoag(ipair) + mtef = modetooeff_acoag(ipair) + write(lunout,9320) ipair, mfrm, mtoo, mtef + + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) + lstoo = lspectoo_acoag(iq,ipair) + if (lstoo .gt. 0) then + write(lunout,9330) lsfrm, cnst_name(lsfrm), & + lstoo, cnst_name(lstoo) + else + write(lunout,9340) lsfrm, cnst_name(lsfrm) + end if + end do + + end do ! ipair = ... + write(lunout,*) + + end if ! ( masterproc ) + +9310 format( / 'subr. modal_aero_coag_init' ) +9320 format( 'pair', i3, 5x, 'mode', i3, & + ' ---> mode', i3, ' eff', i3 ) +9330 format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a ) +9340 format( 5x, 'spec', i3, '=', a, ' ---> LOSS' ) + +! set following variables that are used in modal_aero_coag_subr +! + fac_m2v_aitage(:) = 0.0_r8 + fac_m2v_pcarbon(:) = 0.0_r8 + if (pair_option_acoag == 3) then +! following ipair definitions MUST BE CONSISTENT with +! the coding in modal_aero_coag_init for pair_option_acoag == 3 + ip_aitacc = 1 + ip_pcaacc = 2 + ip_aitpca = 3 + + mait = modeptr_aitken + mpca = modeptr_pcarbon + + ipair = ip_aitpca + do iq = 1, nspecfrm_acoag(ipair) + lsfrm = lspecfrm_acoag(iq,ipair) + l2 = -1 + do l1 = 1, nspec_amode(mait) + if (lmassptr_amode(l1,mait) == lsfrm) then + l2 = l1 + exit + end if + end do + if (l2 <= 0) then + write( msg, '(a,5(1x,i12))' ) & + 'modal_aero_coag_init error a001 for ipair, iq, lsfrm', & + ipair, iq, lsfrm + call endrun( msg ) + end if + if (lsfrm == lptr_so4_a_amode(mait)) then +! fac_m2v_aitage(iq) = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_aitage(iq) = specmw_amode(l1,mait) / specdens_amode(l1,mait) + else if (lsfrm == lptr_nh4_a_amode(mait)) then +! fac_m2v_aitage(iq) = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_aitage(iq) = specmw_amode(l1,mait) / specdens_amode(l1,mait) + else + do jsoa = 1, nsoa + if (lsfrm == lptr2_soa_a_amode(mait,jsoa)) then + fac_m2v_aitage(iq) = soa_equivso4_factor(jsoa)* & + !(specmw_amode(l2) / specdens_amode(l2)) + (specmw_amode(l1,mait) / specdens_amode(l1,mait)) + end if +! for soa, the soa_equivso4_factor converts the soa volume into an +! so4(+nh4) volume that has same hygroscopicity contribution as soa +! this allows aging calculations to be done in terms of the amount +! of (equivalent) so4(+nh4) in the shell +! (see modal_aero_gasaerexch) + end do + end if + end do + + do l = 1, nspec_amode(mpca) +!B l2 = lspectype_amode(l,mpca) +! fac_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air) +! [m3-AP/kmol-AP] = [kg-AP/kmol-AP] / [kg-AP/m3-AP] +! fac_m2v_pcarbon(l) = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_pcarbon(l) = specmw_amode(l,mpca) / specdens_amode(l,mpca) + end do + + else + ip_aitacc = -999888777 + ip_pcaacc = -999888777 + ip_aitpca = -999888777 + end if + +! +! create history file column-tendency fields +! + dotend(:) = .false. + do ipair = 1, npair_acoag + do iq = 1, nspecfrm_acoag(ipair) + l = lspecfrm_acoag(iq,ipair) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + l = lspectoo_acoag(iq,ipair) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + end do + + m = modefrm_acoag(ipair) + if ((m > 0) .and. (m <= ntot_amode)) then + l = numptr_amode(m) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + end if + m = modetoo_acoag(ipair) + if ((m > 0) .and. (m <= ntot_amode)) then + l = numptr_amode(m) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + end if + end do ! ipair = ... + + if (pair_option_acoag == 3) then + do iq = 1, nspecfrm_pcage + lsfrm = lspecfrm_pcage(iq) + lstoo = lspectoo_pcage(iq) + if ((lsfrm > 0) .and. (lsfrm <= pcnst)) then + dotend(lsfrm) = .true. + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dotend(lstoo) = .true. + end if + end if + end do + end if + + do l = 1, pcnst + if ( .not. dotend(l) ) cycle + tmpname = cnst_name(l) + unit = 'kg/m2/s' + do m = 1, ntot_amode + if (l == numptr_amode(m)) unit = '#/m2/s' + end do + fieldname = trim(tmpname) // '_sfcoag1' + long_name = trim(tmpname) // ' modal_aero coagulation column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,2x))') & + 'modal_aero_coag_init addfld', fieldname, unit + end do ! l = ... + + + return + end subroutine modal_aero_coag_init + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- + subroutine getcoags_wrapper_f( & + airtemp, airprs, & + dgatk, dgacc, & + sgatk, sgacc, & + xxlsgat, xxlsgac, & + pdensat, pdensac, & + betaij0, betaij2i, betaij2j, betaij3, & + betaii0, betaii2, betajj0, betajj2 ) + use physconst, only: p0 => pstd, & + tmelt, & + boltz +! +! interface to subr. getcoags +! +! interface code adapted from subr. aeroproc of cmaq v4.6, +! with some of the parameter values from module aero_info_ae4 +! + implicit none + +! *** arguments + + real(r8), intent(in) :: airtemp ! air temperature [ k ] + real(r8), intent(in) :: airprs ! air pressure in [ pa ] + + real(r8), intent(in) :: dgatk ! aitken mode geometric mean diameter [m] + real(r8), intent(in) :: dgacc ! accumulation mode geometric mean diam [m] + + real(r8), intent(in) :: sgatk ! aitken mode geometric standard deviation + real(r8), intent(in) :: sgacc ! accumulation mode geometric standard deviation + + real(r8), intent(in) :: xxlsgat ! natural log of geometric standard + real(r8), intent(in) :: xxlsgac ! deviations + + real(r8), intent(in) :: pdensat ! aitken mode particle density [ kg / m**3 ] + real(r8), intent(in) :: pdensac ! accumulation mode density [ kg / m**3 ] + + real(r8), intent(out) :: betaij0, betaij2i, betaij2j, betaij3, & + betaii0, betaii2, betajj0, betajj2 + + +! *** local parameters + real(r8) :: t0 ! standard surface temperature (15 deg C) [ k ] + real(r8), parameter :: two3 = 2.0_r8/3.0_r8 + +! *** local variables + real(r8) amu ! atmospheric dynamic viscosity [ kg/m s ] + real(r8) sqrt_temp ! square root of ambient temperature + real(r8) lamda ! mean free path [ m ] + +! *** intramodal coagulation rates [ m**3/s ] ( 0th & 2nd moments ) + real(r8) batat( 2 ) ! aitken mode + real(r8) bacac( 2 ) ! accumulation mode +! *** intermodal coagulation rates [ m**3/s ] ( 0th & 2nd moments ) + real(r8) batac( 2 ) ! aitken to accumulation + real(r8) bacat( 2 ) ! accumulation from aitken +! *** intermodal coagulation rate [ m**3/s ] ( 3rd moment ) + real(r8) c3ij ! aitken to accumulation +! *** 3rd moment intermodal transfer rate by coagulation + real(r8) c30atac ! aitken to accumulation + +! *** near continnuum regime (independent of mode) + real(r8) knc ! knc = two3 * boltz * airtemp / amu +! *** free molecular regime (depends upon modal density) + real(r8) kfmat ! kfmat = sqrt(3.0*boltz*airtemp/pdensat) + real(r8) kfmac ! kfmac = sqrt(3.0*boltz*airtemp/pdensac) + real(r8) kfmatac ! kfmatac = sqrt( 6.0 * boltz * airtemp / + ! ( pdensat + pdensac ) ) + + real(r8) dumacc2, dumatk2, dumatk3 + + t0 = tmelt + 15._r8 + + sqrt_temp = sqrt( airtemp) + +! *** calculate mean free path [ m ]: +! 6.6328e-8 is the sea level value given in table i.2.8 +! on page 10 of u.s. standard atmosphere 1962 + lamda = 6.6328e-8_r8 * p0 * airtemp / ( t0 * airprs ) + +! *** calculate dynamic viscosity [ kg m**-1 s**-1 ]: +! u.s. standard atmosphere 1962 page 14 expression +! for dynamic viscosity is: +! dynamic viscosity = beta * t * sqrt(t) / ( t + s) +! where beta = 1.458e-6 [ kg sec^-1 k**-0.5 ], s = 110.4 [ k ]. + amu = 1.458e-6_r8 * airtemp * sqrt_temp / ( airtemp + 110.4_r8 ) + +! *** coagulation +! calculate coagulation coefficients using a method dictated by +! the value of fastcoag_flag. if true, the computationally- +! efficient getcoags routine is used. if false, the more intensive +! gauss-hermite numerical quadrature method is used. see section +! 2.1 of bhave et al. (2004) for further discussion. + +! *** calculate term used in equation a6 of binkowski & shankar (1995) + knc = two3 * boltz * airtemp / amu +! *** calculate terms used in equation a5 of binkowski & shankar (1995) + kfmat = sqrt( 3.0_r8 * boltz * airtemp / pdensat ) + kfmac = sqrt( 3.0_r8 * boltz * airtemp / pdensac ) + kfmatac = sqrt( 6.0_r8 * boltz * airtemp / ( pdensat + pdensac ) ) + +! *** transfer of number to accumulation mode from aitken mode is zero + bacat(1) = 0.0_r8 + +! *** calculate intermodal and intramodal coagulation coefficients +! for zeroth and second moments, and intermodal coagulation +! coefficient for third moment + call getcoags( lamda, kfmatac, kfmat, kfmac, knc, & + dgatk, dgacc, sgatk, sgacc, & + xxlsgat, xxlsgac, & + batat(2), batat(1), bacac(2), bacac(1), & + batac(2), bacat(2), batac(1), c3ij ) + +! convert from the "cmaq" coag rate parameters +! to the "mirage2" parameters + dumacc2 = ( (dgacc**2) * exp( 2.0_r8*xxlsgac*xxlsgac ) ) + dumatk2 = ( (dgatk**2) * exp( 2.0_r8*xxlsgat*xxlsgat ) ) + dumatk3 = ( (dgatk**3) * exp( 4.5_r8*xxlsgat*xxlsgat ) ) + + betaii0 = max( 0.0_r8, batat(1) ) + betajj0 = max( 0.0_r8, bacac(1) ) + betaij0 = max( 0.0_r8, batac(1) ) + betaij3 = max( 0.0_r8, c3ij / dumatk3 ) + + betajj2 = max( 0.0_r8, bacac(2) / dumacc2 ) + betaii2 = max( 0.0_r8, batat(2) / dumatk2 ) + betaij2i = max( 0.0_r8, batac(2) / dumatk2 ) + betaij2j = max( 0.0_r8, bacat(2) / dumatk2 ) + + + return + end subroutine getcoags_wrapper_f + + + +! ////////////////////////////////////////////////////////////////// +! subroutine getcoags calculates the coagulation rates using a new +! approximate algorithm for the 2nd moment. the 0th and 3rd moments +! are done by analytic expressions from whitby et al. (1991). the +! correction factors are also similar to those from whitby et al. +! (1991), but are derived from the gauss-hermite numerical +! quadratures used by binkowski and roselle (2003). +! +! called from aerostep as: +! call getcoags( lamda, kfmatac, kfmat, kfmac, knc, +! dgat,dgac, sgatk, sgacc, xxlsgat,xxlsgac, +! batat(2), batat(1), bacac(2), bacac(1), +! batac(2), bacat(2), batac(1), c3ij ) +! where all input and outputs are real*8 +! +! revision history: +! fsb 08/25/03 coded by dr. francis s. binkowksi +! +! fsb 08/25/04 added in-line documentation +! +! rce 04/15/2007 +! code taken from cmaq v4.6 code; converted to f90; +! added "intent" to subr arguments; +! renamed "r4" & "r8" variables to "rx4" & "rx8"; +! changed "real*N" declarations to "real(rN)" (N = 4 or 8) +! +! references: +! 1. whitby, e. r., p. h. mcmurry, u. shankar, and f. s. binkowski, +! modal aerosol dynamics modeling, rep. 600/3-91/020, atmospheric +! research and exposure assessment laboratory, +! u.s. environmental protection agency, research triangle park, n.c., +! (ntis pb91-161729/as), 1991 +! +! 2. binkowski, f.s. an u. shankar, the regional particulate matter +! model 1. model decsription and preliminary results, journal of +! geophysical research, 100, d12, pp 26,191-26,209, +! december 20, 1995. +! +! 3. binkowski, f.s. and s.j. roselle, models-3 community +! multiscale air quality (cmaq) model aerosol component 1: +! model description. j. geophys. res., vol 108, no d6, 4183 +! doi:10.1029/2001jd001409, 2003. + + + subroutine getcoags( lamda, kfmatac, kfmat, kfmac, knc, & + dgatk, dgacc, sgatk, sgacc, xxlsgat,xxlsgac, & + qs11, qn11, qs22, qn22, & + qs12, qs21, qn12, qv12 ) + + implicit none + + real(r8), intent(in) :: lamda ! mean free path [ m ] + +! *** coefficients for free molecular regime + real(r8), intent(in) :: kfmat ! aitken mode + real(r8), intent(in) :: kfmac ! accumulation mode + real(r8), intent(in) :: kfmatac ! aitken to accumulation mode + + real(r8), intent(in) :: knc ! coefficient for near continnuum regime + +! *** modal geometric mean diameters: [ m ] + real(r8), intent(in) :: dgatk ! aitken mode + real(r8), intent(in) :: dgacc ! accumulation mode + +! *** modal geometric standard deviation + real(r8), intent(in) :: sgatk ! atken mode + real(r8), intent(in) :: sgacc ! accumulation mode + +! *** natural log of modal geometric standard deviation + real(r8), intent(in) :: xxlsgat ! aitken mode + real(r8), intent(in) :: xxlsgac ! accumulation mode + +! *** coagulation coefficients + real(r8), intent(out) :: qs11, qn11, qs22, qn22, & + qs12, qs21, qn12, qv12 + + integer ibeta, n1, n2a, n2n ! indices for correction factors + + real(r8) i1fm_at + real(r8) i1nc_at + real(r8) i1_at + + real(r8) i1fm_ac + real(r8) i1nc_ac + real(r8) i1_ac + + real(r8) i1fm + real(r8) i1nc + real(r8) i1 + + real(r8) constii + + real(r8) kngat, kngac + real(r8) one, two, half + parameter( one = 1.0_r8, two = 2.0_r8, half = 0.5_r8 ) + real(r8) a +! parameter( a = 2.492_r8) + parameter( a = 1.246_r8) + real(r8) two3rds + parameter( two3rds = 2._r8 / 3._r8) + + real(r8) sqrttwo ! sqrt(two) + real(r8) dlgsqt2 ! 1/ln( sqrt( 2 ) ) + + + real(r8) esat01 ! aitken mode exp( log^2( sigmag )/8 ) + real(r8) esac01 ! accumulation mode exp( log^2( sigmag )/8 ) + + real(r8) esat04 + real(r8) esac04 + + real(r8) esat05 + real(r8) esac05 + + real(r8) esat08 + real(r8) esac08 + + real(r8) esat09 + real(r8) esac09 + + real(r8) esat16 + real(r8) esac16 + + real(r8) esat20 + real(r8) esac20 + + real(r8) esat24 + real(r8) esac24 + + real(r8) esat25 + real(r8) esac25 + + real(r8) esat36 + real(r8) esac36 + + real(r8) esat49 + + real(r8) esat64 + real(r8) esac64 + + real(r8) esat100 + + real(r8) dgat2, dgac2, dgat3, dgac3 + real(r8) sqdgat, sqdgac + real(r8) sqdgat5, sqdgac5 + real(r8) sqdgat7 + real(r8) r, r2, r3, rx4, r5, r6, rx8 + real(r8) ri1, ri2, ri3, ri4 + real(r8) rat + real(r8) coagfm0, coagnc0 + real(r8) coagfm3, coagnc3 + real(r8) coagfm_at, coagfm_ac + real(r8) coagnc_at, coagnc_ac + real(r8) coagatat0 + real(r8) coagacac0 + real(r8) coagatat2 + real(r8) coagacac2 + real(r8) coagatac0, coagatac3 + real(r8) coagatac2 + real(r8) coagacat2 + real(r8) xm2at, xm3at, xm2ac, xm3ac + +! *** correction factors for coagulation rates + real(r8), save :: bm0( 10 ) ! m0 intramodal fm - rpm values + real(r8), save :: bm0ij( 10, 10, 10 ) ! m0 intermodal fm + real(r8), save :: bm3i( 10, 10, 10 ) ! m3 intermodal fm- rpm values + real(r8), save :: bm2ii(10) ! m2 intramodal fm + real(r8), save :: bm2iitt(10) ! m2 intramodal total + real(r8), save :: bm2ij(10,10,10) ! m2 intermodal fm i to j + real(r8), save :: bm2ji(10,10,10) ! m2 total intermodal j from i + +! *** populate the arrays for the correction factors. + +! rpm 0th moment correction factors for unimodal fm coagulation rates + data bm0 / & + 0.707106785165097_r8, 0.726148960080488_r8, 0.766430744110958_r8, & + 0.814106389441342_r8, 0.861679526483207_r8, 0.903600509090092_r8, & + 0.936578814219156_r8, 0.960098926735545_r8, 0.975646823342881_r8, & + 0.985397173215326_r8 / + + +! fsb new fm correction factors for m0 intermodal coagulation + + data (bm0ij ( 1, 1,ibeta), ibeta = 1,10) / & + 0.628539_r8, 0.639610_r8, 0.664514_r8, 0.696278_r8, 0.731558_r8, & + 0.768211_r8, 0.804480_r8, 0.838830_r8, 0.870024_r8, 0.897248_r8/ + data (bm0ij ( 1, 2,ibeta), ibeta = 1,10) / & + 0.639178_r8, 0.649966_r8, 0.674432_r8, 0.705794_r8, 0.740642_r8, & + 0.776751_r8, 0.812323_r8, 0.845827_r8, 0.876076_r8, 0.902324_r8/ + data (bm0ij ( 1, 3,ibeta), ibeta = 1,10) / & + 0.663109_r8, 0.673464_r8, 0.697147_r8, 0.727637_r8, 0.761425_r8, & + 0.796155_r8, 0.829978_r8, 0.861419_r8, 0.889424_r8, 0.913417_r8/ + data (bm0ij ( 1, 4,ibeta), ibeta = 1,10) / & + 0.693693_r8, 0.703654_r8, 0.726478_r8, 0.755786_r8, 0.787980_r8, & + 0.820626_r8, 0.851898_r8, 0.880459_r8, 0.905465_r8, 0.926552_r8/ + data (bm0ij ( 1, 5,ibeta), ibeta = 1,10) / & + 0.727803_r8, 0.737349_r8, 0.759140_r8, 0.786870_r8, 0.816901_r8, & + 0.846813_r8, 0.874906_r8, 0.900060_r8, 0.921679_r8, 0.939614_r8/ + data (bm0ij ( 1, 6,ibeta), ibeta = 1,10) / & + 0.763461_r8, 0.772483_r8, 0.792930_r8, 0.818599_r8, 0.845905_r8, & + 0.872550_r8, 0.897051_r8, 0.918552_r8, 0.936701_r8, 0.951528_r8/ + data (bm0ij ( 1, 7,ibeta), ibeta = 1,10) / & + 0.799021_r8, 0.807365_r8, 0.826094_r8, 0.849230_r8, 0.873358_r8, & + 0.896406_r8, 0.917161_r8, 0.935031_r8, 0.949868_r8, 0.961828_r8/ + data (bm0ij ( 1, 8,ibeta), ibeta = 1,10) / & + 0.833004_r8, 0.840514_r8, 0.857192_r8, 0.877446_r8, 0.898147_r8, & + 0.917518_r8, 0.934627_r8, 0.949106_r8, 0.960958_r8, 0.970403_r8/ + data (bm0ij ( 1, 9,ibeta), ibeta = 1,10) / & + 0.864172_r8, 0.870734_r8, 0.885153_r8, 0.902373_r8, 0.919640_r8, & + 0.935494_r8, 0.949257_r8, 0.960733_r8, 0.970016_r8, 0.977346_r8/ + data (bm0ij ( 1, 10,ibeta), ibeta = 1,10) / & + 0.891658_r8, 0.897227_r8, 0.909343_r8, 0.923588_r8, 0.937629_r8, & + 0.950307_r8, 0.961151_r8, 0.970082_r8, 0.977236_r8, 0.982844_r8/ + data (bm0ij ( 2, 1,ibeta), ibeta = 1,10) / & + 0.658724_r8, 0.670587_r8, 0.697539_r8, 0.731890_r8, 0.769467_r8, & + 0.807391_r8, 0.843410_r8, 0.875847_r8, 0.903700_r8, 0.926645_r8/ + data (bm0ij ( 2, 2,ibeta), ibeta = 1,10) / & + 0.667070_r8, 0.678820_r8, 0.705538_r8, 0.739591_r8, 0.776758_r8, & + 0.814118_r8, 0.849415_r8, 0.881020_r8, 0.908006_r8, 0.930121_r8/ + data (bm0ij ( 2, 3,ibeta), ibeta = 1,10) / & + 0.686356_r8, 0.697839_r8, 0.723997_r8, 0.757285_r8, 0.793389_r8, & + 0.829313_r8, 0.862835_r8, 0.892459_r8, 0.917432_r8, 0.937663_r8/ + data (bm0ij ( 2, 4,ibeta), ibeta = 1,10) / & + 0.711425_r8, 0.722572_r8, 0.747941_r8, 0.780055_r8, 0.814518_r8, & + 0.848315_r8, 0.879335_r8, 0.906290_r8, 0.928658_r8, 0.946526_r8/ + data (bm0ij ( 2, 5,ibeta), ibeta = 1,10) / & + 0.739575_r8, 0.750307_r8, 0.774633_r8, 0.805138_r8, 0.837408_r8, & + 0.868504_r8, 0.896517_r8, 0.920421_r8, 0.939932_r8, 0.955299_r8/ + data (bm0ij ( 2, 6,ibeta), ibeta = 1,10) / & + 0.769143_r8, 0.779346_r8, 0.802314_r8, 0.830752_r8, 0.860333_r8, & + 0.888300_r8, 0.913014_r8, 0.933727_r8, 0.950370_r8, 0.963306_r8/ + data (bm0ij ( 2, 7,ibeta), ibeta = 1,10) / & + 0.798900_r8, 0.808431_r8, 0.829700_r8, 0.855653_r8, 0.882163_r8, & + 0.906749_r8, 0.928075_r8, 0.945654_r8, 0.959579_r8, 0.970280_r8/ + data (bm0ij ( 2, 8,ibeta), ibeta = 1,10) / & + 0.827826_r8, 0.836542_r8, 0.855808_r8, 0.878954_r8, 0.902174_r8, & + 0.923316_r8, 0.941345_r8, 0.955989_r8, 0.967450_r8, 0.976174_r8/ + data (bm0ij ( 2, 9,ibeta), ibeta = 1,10) / & + 0.855068_r8, 0.862856_r8, 0.879900_r8, 0.900068_r8, 0.919956_r8, & + 0.937764_r8, 0.952725_r8, 0.964726_r8, 0.974027_r8, 0.981053_r8/ + data (bm0ij ( 2, 10,ibeta), ibeta = 1,10) / & + 0.879961_r8, 0.886755_r8, 0.901484_r8, 0.918665_r8, 0.935346_r8, & + 0.950065_r8, 0.962277_r8, 0.971974_r8, 0.979432_r8, 0.985033_r8/ + data (bm0ij ( 3, 1,ibeta), ibeta = 1,10) / & + 0.724166_r8, 0.735474_r8, 0.761359_r8, 0.794045_r8, 0.828702_r8, & + 0.862061_r8, 0.891995_r8, 0.917385_r8, 0.937959_r8, 0.954036_r8/ + data (bm0ij ( 3, 2,ibeta), ibeta = 1,10) / & + 0.730416_r8, 0.741780_r8, 0.767647_r8, 0.800116_r8, 0.834344_r8, & + 0.867093_r8, 0.896302_r8, 0.920934_r8, 0.940790_r8, 0.956237_r8/ + data (bm0ij ( 3, 3,ibeta), ibeta = 1,10) / & + 0.745327_r8, 0.756664_r8, 0.782255_r8, 0.814026_r8, 0.847107_r8, & + 0.878339_r8, 0.905820_r8, 0.928699_r8, 0.946931_r8, 0.960977_r8/ + data (bm0ij ( 3, 4,ibeta), ibeta = 1,10) / & + 0.765195_r8, 0.776312_r8, 0.801216_r8, 0.831758_r8, 0.863079_r8, & + 0.892159_r8, 0.917319_r8, 0.937939_r8, 0.954145_r8, 0.966486_r8/ + data (bm0ij ( 3, 5,ibeta), ibeta = 1,10) / & + 0.787632_r8, 0.798347_r8, 0.822165_r8, 0.850985_r8, 0.880049_r8, & + 0.906544_r8, 0.929062_r8, 0.947218_r8, 0.961288_r8, 0.971878_r8/ + data (bm0ij ( 3, 6,ibeta), ibeta = 1,10) / & + 0.811024_r8, 0.821179_r8, 0.843557_r8, 0.870247_r8, 0.896694_r8, & + 0.920365_r8, 0.940131_r8, 0.955821_r8, 0.967820_r8, 0.976753_r8/ + data (bm0ij ( 3, 7,ibeta), ibeta = 1,10) / & + 0.834254_r8, 0.843709_r8, 0.864356_r8, 0.888619_r8, 0.912245_r8, & + 0.933019_r8, 0.950084_r8, 0.963438_r8, 0.973530_r8, 0.980973_r8/ + data (bm0ij ( 3, 8,ibeta), ibeta = 1,10) / & + 0.856531_r8, 0.865176_r8, 0.883881_r8, 0.905544_r8, 0.926290_r8, & + 0.944236_r8, 0.958762_r8, 0.969988_r8, 0.978386_r8, 0.984530_r8/ + data (bm0ij ( 3, 9,ibeta), ibeta = 1,10) / & + 0.877307_r8, 0.885070_r8, 0.901716_r8, 0.920729_r8, 0.938663_r8, & + 0.953951_r8, 0.966169_r8, 0.975512_r8, 0.982442_r8, 0.987477_r8/ + data (bm0ij ( 3, 10,ibeta), ibeta = 1,10) / & + 0.896234_r8, 0.903082_r8, 0.917645_r8, 0.934069_r8, 0.949354_r8, & + 0.962222_r8, 0.972396_r8, 0.980107_r8, 0.985788_r8, 0.989894_r8/ + data (bm0ij ( 4, 1,ibeta), ibeta = 1,10) / & + 0.799294_r8, 0.809144_r8, 0.831293_r8, 0.858395_r8, 0.885897_r8, & + 0.911031_r8, 0.932406_r8, 0.949642_r8, 0.963001_r8, 0.973062_r8/ + data (bm0ij ( 4, 2,ibeta), ibeta = 1,10) / & + 0.804239_r8, 0.814102_r8, 0.836169_r8, 0.862984_r8, 0.890003_r8, & + 0.914535_r8, 0.935274_r8, 0.951910_r8, 0.964748_r8, 0.974381_r8/ + data (bm0ij ( 4, 3,ibeta), ibeta = 1,10) / & + 0.815910_r8, 0.825708_r8, 0.847403_r8, 0.873389_r8, 0.899185_r8, & + 0.922275_r8, 0.941543_r8, 0.956826_r8, 0.968507_r8, 0.977204_r8/ + data (bm0ij ( 4, 4,ibeta), ibeta = 1,10) / & + 0.831348_r8, 0.840892_r8, 0.861793_r8, 0.886428_r8, 0.910463_r8, & + 0.931614_r8, 0.948993_r8, 0.962593_r8, 0.972872_r8, 0.980456_r8/ + data (bm0ij ( 4, 5,ibeta), ibeta = 1,10) / & + 0.848597_r8, 0.857693_r8, 0.877402_r8, 0.900265_r8, 0.922180_r8, & + 0.941134_r8, 0.956464_r8, 0.968298_r8, 0.977143_r8, 0.983611_r8/ + data (bm0ij ( 4, 6,ibeta), ibeta = 1,10) / & + 0.866271_r8, 0.874764_r8, 0.892984_r8, 0.913796_r8, 0.933407_r8, & + 0.950088_r8, 0.963380_r8, 0.973512_r8, 0.981006_r8, 0.986440_r8/ + data (bm0ij ( 4, 7,ibeta), ibeta = 1,10) / & + 0.883430_r8, 0.891216_r8, 0.907762_r8, 0.926388_r8, 0.943660_r8, & + 0.958127_r8, 0.969499_r8, 0.978070_r8, 0.984351_r8, 0.988872_r8/ + data (bm0ij ( 4, 8,ibeta), ibeta = 1,10) / & + 0.899483_r8, 0.906505_r8, 0.921294_r8, 0.937719_r8, 0.952729_r8, & + 0.965131_r8, 0.974762_r8, 0.981950_r8, 0.987175_r8, 0.990912_r8/ + data (bm0ij ( 4, 9,ibeta), ibeta = 1,10) / & + 0.914096_r8, 0.920337_r8, 0.933373_r8, 0.947677_r8, 0.960579_r8, & + 0.971111_r8, 0.979206_r8, 0.985196_r8, 0.989520_r8, 0.992597_r8/ + data (bm0ij ( 4, 10,ibeta), ibeta = 1,10) / & + 0.927122_r8, 0.932597_r8, 0.943952_r8, 0.956277_r8, 0.967268_r8, & + 0.976147_r8, 0.982912_r8, 0.987882_r8, 0.991450_r8, 0.993976_r8/ + data (bm0ij ( 5, 1,ibeta), ibeta = 1,10) / & + 0.865049_r8, 0.872851_r8, 0.889900_r8, 0.909907_r8, 0.929290_r8, & + 0.946205_r8, 0.959991_r8, 0.970706_r8, 0.978764_r8, 0.984692_r8/ + data (bm0ij ( 5, 2,ibeta), ibeta = 1,10) / & + 0.868989_r8, 0.876713_r8, 0.893538_r8, 0.913173_r8, 0.932080_r8, & + 0.948484_r8, 0.961785_r8, 0.972080_r8, 0.979796_r8, 0.985457_r8/ + data (bm0ij ( 5, 3,ibeta), ibeta = 1,10) / & + 0.878010_r8, 0.885524_r8, 0.901756_r8, 0.920464_r8, 0.938235_r8, & + 0.953461_r8, 0.965672_r8, 0.975037_r8, 0.982005_r8, 0.987085_r8/ + data (bm0ij ( 5, 4,ibeta), ibeta = 1,10) / & + 0.889534_r8, 0.896698_r8, 0.912012_r8, 0.929395_r8, 0.945647_r8, & + 0.959366_r8, 0.970227_r8, 0.978469_r8, 0.984547_r8, 0.988950_r8/ + data (bm0ij ( 5, 5,ibeta), ibeta = 1,10) / & + 0.902033_r8, 0.908713_r8, 0.922848_r8, 0.938648_r8, 0.953186_r8, & + 0.965278_r8, 0.974729_r8, 0.981824_r8, 0.987013_r8, 0.990746_r8/ + data (bm0ij ( 5, 6,ibeta), ibeta = 1,10) / & + 0.914496_r8, 0.920599_r8, 0.933389_r8, 0.947485_r8, 0.960262_r8, & + 0.970743_r8, 0.978839_r8, 0.984858_r8, 0.989225_r8, 0.992348_r8/ + data (bm0ij ( 5, 7,ibeta), ibeta = 1,10) / & + 0.926281_r8, 0.931761_r8, 0.943142_r8, 0.955526_r8, 0.966600_r8, & + 0.975573_r8, 0.982431_r8, 0.987485_r8, 0.991128_r8, 0.993718_r8/ + data (bm0ij ( 5, 8,ibeta), ibeta = 1,10) / & + 0.937029_r8, 0.941877_r8, 0.951868_r8, 0.962615_r8, 0.972112_r8, & + 0.979723_r8, 0.985488_r8, 0.989705_r8, 0.992725_r8, 0.994863_r8/ + data (bm0ij ( 5, 9,ibeta), ibeta = 1,10) / & + 0.946580_r8, 0.950819_r8, 0.959494_r8, 0.968732_r8, 0.976811_r8, & + 0.983226_r8, 0.988047_r8, 0.991550_r8, 0.994047_r8, 0.995806_r8/ + data (bm0ij ( 5, 10,ibeta), ibeta = 1,10) / & + 0.954909_r8, 0.958581_r8, 0.966049_r8, 0.973933_r8, 0.980766_r8, & + 0.986149_r8, 0.990166_r8, 0.993070_r8, 0.995130_r8, 0.996577_r8/ + data (bm0ij ( 6, 1,ibeta), ibeta = 1,10) / & + 0.914182_r8, 0.919824_r8, 0.931832_r8, 0.945387_r8, 0.957999_r8, & + 0.968606_r8, 0.976982_r8, 0.983331_r8, 0.988013_r8, 0.991407_r8/ + data (bm0ij ( 6, 2,ibeta), ibeta = 1,10) / & + 0.917139_r8, 0.922665_r8, 0.934395_r8, 0.947580_r8, 0.959792_r8, & + 0.970017_r8, 0.978062_r8, 0.984138_r8, 0.988609_r8, 0.991843_r8/ + data (bm0ij ( 6, 3,ibeta), ibeta = 1,10) / & + 0.923742_r8, 0.928990_r8, 0.940064_r8, 0.952396_r8, 0.963699_r8, & + 0.973070_r8, 0.980381_r8, 0.985866_r8, 0.989878_r8, 0.992768_r8/ + data (bm0ij ( 6, 4,ibeta), ibeta = 1,10) / & + 0.931870_r8, 0.936743_r8, 0.946941_r8, 0.958162_r8, 0.968318_r8, & + 0.976640_r8, 0.983069_r8, 0.987853_r8, 0.991330_r8, 0.993822_r8/ + data (bm0ij ( 6, 5,ibeta), ibeta = 1,10) / & + 0.940376_r8, 0.944807_r8, 0.954004_r8, 0.963999_r8, 0.972928_r8, & + 0.980162_r8, 0.985695_r8, 0.989779_r8, 0.992729_r8, 0.994833_r8/ + data (bm0ij ( 6, 6,ibeta), ibeta = 1,10) / & + 0.948597_r8, 0.952555_r8, 0.960703_r8, 0.969454_r8, 0.977181_r8, & + 0.983373_r8, 0.988067_r8, 0.991507_r8, 0.993977_r8, 0.995730_r8/ + data (bm0ij ( 6, 7,ibeta), ibeta = 1,10) / & + 0.956167_r8, 0.959648_r8, 0.966763_r8, 0.974326_r8, 0.980933_r8, & + 0.986177_r8, 0.990121_r8, 0.992993_r8, 0.995045_r8, 0.996495_r8/ + data (bm0ij ( 6, 8,ibeta), ibeta = 1,10) / & + 0.962913_r8, 0.965937_r8, 0.972080_r8, 0.978552_r8, 0.984153_r8, & + 0.988563_r8, 0.991857_r8, 0.994242_r8, 0.995938_r8, 0.997133_r8/ + data (bm0ij ( 6, 9,ibeta), ibeta = 1,10) / & + 0.968787_r8, 0.971391_r8, 0.976651_r8, 0.982148_r8, 0.986869_r8, & + 0.990560_r8, 0.993301_r8, 0.995275_r8, 0.996675_r8, 0.997657_r8/ + data (bm0ij ( 6, 10,ibeta), ibeta = 1,10) / & + 0.973822_r8, 0.976047_r8, 0.980523_r8, 0.985170_r8, 0.989134_r8, & + 0.992215_r8, 0.994491_r8, 0.996124_r8, 0.997277_r8, 0.998085_r8/ + data (bm0ij ( 7, 1,ibeta), ibeta = 1,10) / & + 0.947410_r8, 0.951207_r8, 0.959119_r8, 0.967781_r8, 0.975592_r8, & + 0.981981_r8, 0.986915_r8, 0.990590_r8, 0.993266_r8, 0.995187_r8/ + data (bm0ij ( 7, 2,ibeta), ibeta = 1,10) / & + 0.949477_r8, 0.953161_r8, 0.960824_r8, 0.969187_r8, 0.976702_r8, & + 0.982831_r8, 0.987550_r8, 0.991057_r8, 0.993606_r8, 0.995434_r8/ + data (bm0ij ( 7, 3,ibeta), ibeta = 1,10) / & + 0.954008_r8, 0.957438_r8, 0.964537_r8, 0.972232_r8, 0.979095_r8, & + 0.984653_r8, 0.988907_r8, 0.992053_r8, 0.994330_r8, 0.995958_r8/ + data (bm0ij ( 7, 4,ibeta), ibeta = 1,10) / & + 0.959431_r8, 0.962539_r8, 0.968935_r8, 0.975808_r8, 0.981882_r8, & + 0.986759_r8, 0.990466_r8, 0.993190_r8, 0.995153_r8, 0.996552_r8/ + data (bm0ij ( 7, 5,ibeta), ibeta = 1,10) / & + 0.964932_r8, 0.967693_r8, 0.973342_r8, 0.979355_r8, 0.984620_r8, & + 0.988812_r8, 0.991974_r8, 0.994285_r8, 0.995943_r8, 0.997119_r8/ + data (bm0ij ( 7, 6,ibeta), ibeta = 1,10) / & + 0.970101_r8, 0.972517_r8, 0.977428_r8, 0.982612_r8, 0.987110_r8, & + 0.990663_r8, 0.993326_r8, 0.995261_r8, 0.996644_r8, 0.997621_r8/ + data (bm0ij ( 7, 7,ibeta), ibeta = 1,10) / & + 0.974746_r8, 0.976834_r8, 0.981055_r8, 0.985475_r8, 0.989280_r8, & + 0.992265_r8, 0.994488_r8, 0.996097_r8, 0.997241_r8, 0.998048_r8/ + data (bm0ij ( 7, 8,ibeta), ibeta = 1,10) / & + 0.978804_r8, 0.980591_r8, 0.984187_r8, 0.987927_r8, 0.991124_r8, & + 0.993617_r8, 0.995464_r8, 0.996795_r8, 0.997739_r8, 0.998403_r8/ + data (bm0ij ( 7, 9,ibeta), ibeta = 1,10) / & + 0.982280_r8, 0.983799_r8, 0.986844_r8, 0.989991_r8, 0.992667_r8, & + 0.994742_r8, 0.996273_r8, 0.997372_r8, 0.998149_r8, 0.998695_r8/ + data (bm0ij ( 7, 10,ibeta), ibeta = 1,10) / & + 0.985218_r8, 0.986503_r8, 0.989071_r8, 0.991711_r8, 0.993945_r8, & + 0.995669_r8, 0.996937_r8, 0.997844_r8, 0.998484_r8, 0.998932_r8/ + data (bm0ij ( 8, 1,ibeta), ibeta = 1,10) / & + 0.968507_r8, 0.970935_r8, 0.975916_r8, 0.981248_r8, 0.985947_r8, & + 0.989716_r8, 0.992580_r8, 0.994689_r8, 0.996210_r8, 0.997297_r8/ + data (bm0ij ( 8, 2,ibeta), ibeta = 1,10) / & + 0.969870_r8, 0.972210_r8, 0.977002_r8, 0.982119_r8, 0.986619_r8, & + 0.990219_r8, 0.992951_r8, 0.994958_r8, 0.996405_r8, 0.997437_r8/ + data (bm0ij ( 8, 3,ibeta), ibeta = 1,10) / & + 0.972820_r8, 0.974963_r8, 0.979339_r8, 0.983988_r8, 0.988054_r8, & + 0.991292_r8, 0.993738_r8, 0.995529_r8, 0.996817_r8, 0.997734_r8/ + data (bm0ij ( 8, 4,ibeta), ibeta = 1,10) / & + 0.976280_r8, 0.978186_r8, 0.982060_r8, 0.986151_r8, 0.989706_r8, & + 0.992520_r8, 0.994636_r8, 0.996179_r8, 0.997284_r8, 0.998069_r8/ + data (bm0ij ( 8, 5,ibeta), ibeta = 1,10) / & + 0.979711_r8, 0.981372_r8, 0.984735_r8, 0.988263_r8, 0.991309_r8, & + 0.993706_r8, 0.995499_r8, 0.996801_r8, 0.997730_r8, 0.998389_r8/ + data (bm0ij ( 8, 6,ibeta), ibeta = 1,10) / & + 0.982863_r8, 0.984292_r8, 0.987172_r8, 0.990174_r8, 0.992750_r8, & + 0.994766_r8, 0.996266_r8, 0.997352_r8, 0.998125_r8, 0.998670_r8/ + data (bm0ij ( 8, 7,ibeta), ibeta = 1,10) / & + 0.985642_r8, 0.986858_r8, 0.989301_r8, 0.991834_r8, 0.993994_r8, & + 0.995676_r8, 0.996923_r8, 0.997822_r8, 0.998460_r8, 0.998910_r8/ + data (bm0ij ( 8, 8,ibeta), ibeta = 1,10) / & + 0.988029_r8, 0.989058_r8, 0.991116_r8, 0.993240_r8, 0.995043_r8, & + 0.996440_r8, 0.997472_r8, 0.998214_r8, 0.998739_r8, 0.999108_r8/ + data (bm0ij ( 8, 9,ibeta), ibeta = 1,10) / & + 0.990046_r8, 0.990912_r8, 0.992640_r8, 0.994415_r8, 0.995914_r8, & + 0.997073_r8, 0.997925_r8, 0.998536_r8, 0.998968_r8, 0.999271_r8/ + data (bm0ij ( 8, 10,ibeta), ibeta = 1,10) / & + 0.991732_r8, 0.992459_r8, 0.993906_r8, 0.995386_r8, 0.996633_r8, & + 0.997592_r8, 0.998296_r8, 0.998799_r8, 0.999154_r8, 0.999403_r8/ + data (bm0ij ( 9, 1,ibeta), ibeta = 1,10) / & + 0.981392_r8, 0.982893_r8, 0.985938_r8, 0.989146_r8, 0.991928_r8, & + 0.994129_r8, 0.995783_r8, 0.996991_r8, 0.997857_r8, 0.998473_r8/ + data (bm0ij ( 9, 2,ibeta), ibeta = 1,10) / & + 0.982254_r8, 0.983693_r8, 0.986608_r8, 0.989673_r8, 0.992328_r8, & + 0.994424_r8, 0.995998_r8, 0.997146_r8, 0.997969_r8, 0.998553_r8/ + data (bm0ij ( 9, 3,ibeta), ibeta = 1,10) / & + 0.984104_r8, 0.985407_r8, 0.988040_r8, 0.990798_r8, 0.993178_r8, & + 0.995052_r8, 0.996454_r8, 0.997474_r8, 0.998204_r8, 0.998722_r8/ + data (bm0ij ( 9, 4,ibeta), ibeta = 1,10) / & + 0.986243_r8, 0.987386_r8, 0.989687_r8, 0.992087_r8, 0.994149_r8, & + 0.995765_r8, 0.996971_r8, 0.997846_r8, 0.998470_r8, 0.998913_r8/ + data (bm0ij ( 9, 5,ibeta), ibeta = 1,10) / & + 0.988332_r8, 0.989313_r8, 0.991284_r8, 0.993332_r8, 0.995082_r8, & + 0.996449_r8, 0.997465_r8, 0.998200_r8, 0.998723_r8, 0.999093_r8/ + data (bm0ij ( 9, 6,ibeta), ibeta = 1,10) / & + 0.990220_r8, 0.991053_r8, 0.992721_r8, 0.994445_r8, 0.995914_r8, & + 0.997056_r8, 0.997902_r8, 0.998513_r8, 0.998947_r8, 0.999253_r8/ + data (bm0ij ( 9, 7,ibeta), ibeta = 1,10) / & + 0.991859_r8, 0.992561_r8, 0.993961_r8, 0.995403_r8, 0.996626_r8, & + 0.997574_r8, 0.998274_r8, 0.998778_r8, 0.999136_r8, 0.999387_r8/ + data (bm0ij ( 9, 8,ibeta), ibeta = 1,10) / & + 0.993250_r8, 0.993837_r8, 0.995007_r8, 0.996208_r8, 0.997223_r8, & + 0.998007_r8, 0.998584_r8, 0.998999_r8, 0.999293_r8, 0.999499_r8/ + data (bm0ij ( 9, 9,ibeta), ibeta = 1,10) / & + 0.994413_r8, 0.994903_r8, 0.995878_r8, 0.996876_r8, 0.997716_r8, & + 0.998363_r8, 0.998839_r8, 0.999180_r8, 0.999421_r8, 0.999591_r8/ + data (bm0ij ( 9, 10,ibeta), ibeta = 1,10) / & + 0.995376_r8, 0.995785_r8, 0.996597_r8, 0.997425_r8, 0.998121_r8, & + 0.998655_r8, 0.999048_r8, 0.999328_r8, 0.999526_r8, 0.999665_r8/ + data (bm0ij ( 10, 1,ibeta), ibeta = 1,10) / & + 0.989082_r8, 0.989991_r8, 0.991819_r8, 0.993723_r8, 0.995357_r8, & + 0.996637_r8, 0.997592_r8, 0.998286_r8, 0.998781_r8, 0.999132_r8/ + data (bm0ij ( 10, 2,ibeta), ibeta = 1,10) / & + 0.989613_r8, 0.990480_r8, 0.992224_r8, 0.994039_r8, 0.995594_r8, & + 0.996810_r8, 0.997717_r8, 0.998375_r8, 0.998845_r8, 0.999178_r8/ + data (bm0ij ( 10, 3,ibeta), ibeta = 1,10) / & + 0.990744_r8, 0.991523_r8, 0.993086_r8, 0.994708_r8, 0.996094_r8, & + 0.997176_r8, 0.997981_r8, 0.998564_r8, 0.998980_r8, 0.999274_r8/ + data (bm0ij ( 10, 4,ibeta), ibeta = 1,10) / & + 0.992041_r8, 0.992716_r8, 0.994070_r8, 0.995470_r8, 0.996662_r8, & + 0.997591_r8, 0.998280_r8, 0.998778_r8, 0.999133_r8, 0.999383_r8/ + data (bm0ij ( 10, 5,ibeta), ibeta = 1,10) / & + 0.993292_r8, 0.993867_r8, 0.995015_r8, 0.996199_r8, 0.997205_r8, & + 0.997985_r8, 0.998564_r8, 0.998981_r8, 0.999277_r8, 0.999487_r8/ + data (bm0ij ( 10, 6,ibeta), ibeta = 1,10) / & + 0.994411_r8, 0.994894_r8, 0.995857_r8, 0.996847_r8, 0.997685_r8, & + 0.998334_r8, 0.998814_r8, 0.999159_r8, 0.999404_r8, 0.999577_r8/ + data (bm0ij ( 10, 7,ibeta), ibeta = 1,10) / & + 0.995373_r8, 0.995776_r8, 0.996577_r8, 0.997400_r8, 0.998094_r8, & + 0.998630_r8, 0.999026_r8, 0.999310_r8, 0.999512_r8, 0.999654_r8/ + data (bm0ij ( 10, 8,ibeta), ibeta = 1,10) / & + 0.996181_r8, 0.996516_r8, 0.997181_r8, 0.997861_r8, 0.998435_r8, & + 0.998877_r8, 0.999202_r8, 0.999435_r8, 0.999601_r8, 0.999717_r8/ + data (bm0ij ( 10, 9,ibeta), ibeta = 1,10) / & + 0.996851_r8, 0.997128_r8, 0.997680_r8, 0.998242_r8, 0.998715_r8, & + 0.999079_r8, 0.999346_r8, 0.999538_r8, 0.999673_r8, 0.999769_r8/ + data (bm0ij ( 10, 10,ibeta), ibeta = 1,10) / & + 0.997402_r8, 0.997632_r8, 0.998089_r8, 0.998554_r8, 0.998945_r8, & + 0.999244_r8, 0.999464_r8, 0.999622_r8, 0.999733_r8, 0.999811_r8/ + + +! rpm.... 3rd moment nuclei mode corr. fac. for bimodal fm coag rate + + data (bm3i( 1, 1,ibeta ), ibeta=1,10)/ & + 0.70708_r8,0.71681_r8,0.73821_r8,0.76477_r8,0.79350_r8,0.82265_r8,0.85090_r8,0.87717_r8, & + 0.90069_r8,0.92097_r8/ + data (bm3i( 1, 2,ibeta ), ibeta=1,10)/ & + 0.72172_r8,0.73022_r8,0.74927_r8,0.77324_r8,0.79936_r8,0.82601_r8,0.85199_r8,0.87637_r8, & + 0.89843_r8,0.91774_r8/ + data (bm3i( 1, 3,ibeta ), ibeta=1,10)/ & + 0.78291_r8,0.78896_r8,0.80286_r8,0.82070_r8,0.84022_r8,0.85997_r8,0.87901_r8,0.89669_r8, & + 0.91258_r8,0.92647_r8/ + data (bm3i( 1, 4,ibeta ), ibeta=1,10)/ & + 0.87760_r8,0.88147_r8,0.89025_r8,0.90127_r8,0.91291_r8,0.92420_r8,0.93452_r8,0.94355_r8, & + 0.95113_r8,0.95726_r8/ + data (bm3i( 1, 5,ibeta ), ibeta=1,10)/ & + 0.94988_r8,0.95184_r8,0.95612_r8,0.96122_r8,0.96628_r8,0.97085_r8,0.97467_r8,0.97763_r8, & + 0.97971_r8,0.98089_r8/ + data (bm3i( 1, 6,ibeta ), ibeta=1,10)/ & + 0.98318_r8,0.98393_r8,0.98551_r8,0.98728_r8,0.98889_r8,0.99014_r8,0.99095_r8,0.99124_r8, & + 0.99100_r8,0.99020_r8/ + data (bm3i( 1, 7,ibeta ), ibeta=1,10)/ & + 0.99480_r8,0.99504_r8,0.99551_r8,0.99598_r8,0.99629_r8,0.99635_r8,0.99611_r8,0.99550_r8, & + 0.99450_r8,0.99306_r8/ + data (bm3i( 1, 8,ibeta ), ibeta=1,10)/ & + 0.99842_r8,0.99848_r8,0.99858_r8,0.99861_r8,0.99850_r8,0.99819_r8,0.99762_r8,0.99674_r8, & + 0.99550_r8,0.99388_r8/ + data (bm3i( 1, 9,ibeta ), ibeta=1,10)/ & + 0.99951_r8,0.99951_r8,0.99949_r8,0.99939_r8,0.99915_r8,0.99872_r8,0.99805_r8,0.99709_r8, & + 0.99579_r8,0.99411_r8/ + data (bm3i( 1,10,ibeta ), ibeta=1,10)/ & + 0.99984_r8,0.99982_r8,0.99976_r8,0.99962_r8,0.99934_r8,0.99888_r8,0.99818_r8,0.99719_r8, & + 0.99587_r8,0.99417_r8/ + data (bm3i( 2, 1,ibeta ), ibeta=1,10)/ & + 0.72957_r8,0.73993_r8,0.76303_r8,0.79178_r8,0.82245_r8,0.85270_r8,0.88085_r8,0.90578_r8, & + 0.92691_r8,0.94415_r8/ + data (bm3i( 2, 2,ibeta ), ibeta=1,10)/ & + 0.72319_r8,0.73320_r8,0.75547_r8,0.78323_r8,0.81307_r8,0.84287_r8,0.87107_r8,0.89651_r8, & + 0.91852_r8,0.93683_r8/ + data (bm3i( 2, 3,ibeta ), ibeta=1,10)/ & + 0.74413_r8,0.75205_r8,0.76998_r8,0.79269_r8,0.81746_r8,0.84258_r8,0.86685_r8,0.88938_r8, & + 0.90953_r8,0.92695_r8/ + data (bm3i( 2, 4,ibeta ), ibeta=1,10)/ & + 0.82588_r8,0.83113_r8,0.84309_r8,0.85825_r8,0.87456_r8,0.89072_r8,0.90594_r8,0.91972_r8, & + 0.93178_r8,0.94203_r8/ + data (bm3i( 2, 5,ibeta ), ibeta=1,10)/ & + 0.91886_r8,0.92179_r8,0.92831_r8,0.93624_r8,0.94434_r8,0.95192_r8,0.95856_r8,0.96409_r8, & + 0.96845_r8,0.97164_r8/ + data (bm3i( 2, 6,ibeta ), ibeta=1,10)/ & + 0.97129_r8,0.97252_r8,0.97515_r8,0.97818_r8,0.98108_r8,0.98354_r8,0.98542_r8,0.98665_r8, & + 0.98721_r8,0.98709_r8/ + data (bm3i( 2, 7,ibeta ), ibeta=1,10)/ & + 0.99104_r8,0.99145_r8,0.99230_r8,0.99320_r8,0.99394_r8,0.99439_r8,0.99448_r8,0.99416_r8, & + 0.99340_r8,0.99217_r8/ + data (bm3i( 2, 8,ibeta ), ibeta=1,10)/ & + 0.99730_r8,0.99741_r8,0.99763_r8,0.99779_r8,0.99782_r8,0.99762_r8,0.99715_r8,0.99636_r8, & + 0.99519_r8,0.99363_r8/ + data (bm3i( 2, 9,ibeta ), ibeta=1,10)/ & + 0.99917_r8,0.99919_r8,0.99921_r8,0.99915_r8,0.99895_r8,0.99856_r8,0.99792_r8,0.99698_r8, & + 0.99570_r8,0.99404_r8/ + data (bm3i( 2,10,ibeta ), ibeta=1,10)/ & + 0.99973_r8,0.99973_r8,0.99968_r8,0.99955_r8,0.99928_r8,0.99883_r8,0.99814_r8,0.99716_r8, & + 0.99584_r8,0.99415_r8/ + data (bm3i( 3, 1,ibeta ), ibeta=1,10)/ & + 0.78358_r8,0.79304_r8,0.81445_r8,0.84105_r8,0.86873_r8,0.89491_r8,0.91805_r8,0.93743_r8, & + 0.95300_r8,0.96510_r8/ + data (bm3i( 3, 2,ibeta ), ibeta=1,10)/ & + 0.76412_r8,0.77404_r8,0.79635_r8,0.82404_r8,0.85312_r8,0.88101_r8,0.90610_r8,0.92751_r8, & + 0.94500_r8,0.95879_r8/ + data (bm3i( 3, 3,ibeta ), ibeta=1,10)/ & + 0.74239_r8,0.75182_r8,0.77301_r8,0.79956_r8,0.82809_r8,0.85639_r8,0.88291_r8,0.90658_r8, & + 0.92683_r8,0.94350_r8/ + data (bm3i( 3, 4,ibeta ), ibeta=1,10)/ & + 0.78072_r8,0.78758_r8,0.80317_r8,0.82293_r8,0.84437_r8,0.86589_r8,0.88643_r8,0.90526_r8, & + 0.92194_r8,0.93625_r8/ + data (bm3i( 3, 5,ibeta ), ibeta=1,10)/ & + 0.87627_r8,0.88044_r8,0.88981_r8,0.90142_r8,0.91357_r8,0.92524_r8,0.93585_r8,0.94510_r8, & + 0.95285_r8,0.95911_r8/ + data (bm3i( 3, 6,ibeta ), ibeta=1,10)/ & + 0.95176_r8,0.95371_r8,0.95796_r8,0.96297_r8,0.96792_r8,0.97233_r8,0.97599_r8,0.97880_r8, & + 0.98072_r8,0.98178_r8/ + data (bm3i( 3, 7,ibeta ), ibeta=1,10)/ & + 0.98453_r8,0.98523_r8,0.98670_r8,0.98833_r8,0.98980_r8,0.99092_r8,0.99160_r8,0.99179_r8, & + 0.99145_r8,0.99058_r8/ + data (bm3i( 3, 8,ibeta ), ibeta=1,10)/ & + 0.99534_r8,0.99555_r8,0.99597_r8,0.99637_r8,0.99662_r8,0.99663_r8,0.99633_r8,0.99569_r8, & + 0.99465_r8,0.99318_r8/ + data (bm3i( 3, 9,ibeta ), ibeta=1,10)/ & + 0.99859_r8,0.99864_r8,0.99872_r8,0.99873_r8,0.99860_r8,0.99827_r8,0.99768_r8,0.99679_r8, & + 0.99555_r8,0.99391_r8/ + data (bm3i( 3,10,ibeta ), ibeta=1,10)/ & + 0.99956_r8,0.99956_r8,0.99953_r8,0.99942_r8,0.99918_r8,0.99875_r8,0.99807_r8,0.99711_r8, & + 0.99580_r8,0.99412_r8/ + data (bm3i( 4, 1,ibeta ), ibeta=1,10)/ & + 0.84432_r8,0.85223_r8,0.86990_r8,0.89131_r8,0.91280_r8,0.93223_r8,0.94861_r8,0.96172_r8, & + 0.97185_r8,0.97945_r8/ + data (bm3i( 4, 2,ibeta ), ibeta=1,10)/ & + 0.82299_r8,0.83164_r8,0.85101_r8,0.87463_r8,0.89857_r8,0.92050_r8,0.93923_r8,0.95443_r8, & + 0.96629_r8,0.97529_r8/ + data (bm3i( 4, 3,ibeta ), ibeta=1,10)/ & + 0.77870_r8,0.78840_r8,0.81011_r8,0.83690_r8,0.86477_r8,0.89124_r8,0.91476_r8,0.93460_r8, & + 0.95063_r8,0.96316_r8/ + data (bm3i( 4, 4,ibeta ), ibeta=1,10)/ & + 0.76386_r8,0.77233_r8,0.79147_r8,0.81557_r8,0.84149_r8,0.86719_r8,0.89126_r8,0.91275_r8, & + 0.93116_r8,0.94637_r8/ + data (bm3i( 4, 5,ibeta ), ibeta=1,10)/ & + 0.82927_r8,0.83488_r8,0.84756_r8,0.86346_r8,0.88040_r8,0.89704_r8,0.91257_r8,0.92649_r8, & + 0.93857_r8,0.94874_r8/ + data (bm3i( 4, 6,ibeta ), ibeta=1,10)/ & + 0.92184_r8,0.92481_r8,0.93136_r8,0.93925_r8,0.94724_r8,0.95462_r8,0.96104_r8,0.96634_r8, & + 0.97048_r8,0.97348_r8/ + data (bm3i( 4, 7,ibeta ), ibeta=1,10)/ & + 0.97341_r8,0.97457_r8,0.97706_r8,0.97991_r8,0.98260_r8,0.98485_r8,0.98654_r8,0.98760_r8, & + 0.98801_r8,0.98777_r8/ + data (bm3i( 4, 8,ibeta ), ibeta=1,10)/ & + 0.99192_r8,0.99229_r8,0.99305_r8,0.99385_r8,0.99449_r8,0.99486_r8,0.99487_r8,0.99449_r8, & + 0.99367_r8,0.99239_r8/ + data (bm3i( 4, 9,ibeta ), ibeta=1,10)/ & + 0.99758_r8,0.99768_r8,0.99787_r8,0.99800_r8,0.99799_r8,0.99777_r8,0.99727_r8,0.99645_r8, & + 0.99527_r8,0.99369_r8/ + data (bm3i( 4,10,ibeta ), ibeta=1,10)/ & + 0.99926_r8,0.99928_r8,0.99928_r8,0.99921_r8,0.99900_r8,0.99860_r8,0.99795_r8,0.99701_r8, & + 0.99572_r8,0.99405_r8/ + data (bm3i( 5, 1,ibeta ), ibeta=1,10)/ & + 0.89577_r8,0.90190_r8,0.91522_r8,0.93076_r8,0.94575_r8,0.95876_r8,0.96932_r8,0.97751_r8, & + 0.98367_r8,0.98820_r8/ + data (bm3i( 5, 2,ibeta ), ibeta=1,10)/ & + 0.87860_r8,0.88547_r8,0.90052_r8,0.91828_r8,0.93557_r8,0.95075_r8,0.96319_r8,0.97292_r8, & + 0.98028_r8,0.98572_r8/ + data (bm3i( 5, 3,ibeta ), ibeta=1,10)/ & + 0.83381_r8,0.84240_r8,0.86141_r8,0.88425_r8,0.90707_r8,0.92770_r8,0.94510_r8,0.95906_r8, & + 0.96986_r8,0.97798_r8/ + data (bm3i( 5, 4,ibeta ), ibeta=1,10)/ & + 0.78530_r8,0.79463_r8,0.81550_r8,0.84127_r8,0.86813_r8,0.89367_r8,0.91642_r8,0.93566_r8, & + 0.95125_r8,0.96347_r8/ + data (bm3i( 5, 5,ibeta ), ibeta=1,10)/ & + 0.79614_r8,0.80332_r8,0.81957_r8,0.84001_r8,0.86190_r8,0.88351_r8,0.90368_r8,0.92169_r8, & + 0.93718_r8,0.95006_r8/ + data (bm3i( 5, 6,ibeta ), ibeta=1,10)/ & + 0.88192_r8,0.88617_r8,0.89565_r8,0.90728_r8,0.91931_r8,0.93076_r8,0.94107_r8,0.94997_r8, & + 0.95739_r8,0.96333_r8/ + data (bm3i( 5, 7,ibeta ), ibeta=1,10)/ & + 0.95509_r8,0.95698_r8,0.96105_r8,0.96583_r8,0.97048_r8,0.97460_r8,0.97796_r8,0.98050_r8, & + 0.98218_r8,0.98304_r8/ + data (bm3i( 5, 8,ibeta ), ibeta=1,10)/ & + 0.98596_r8,0.98660_r8,0.98794_r8,0.98943_r8,0.99074_r8,0.99172_r8,0.99227_r8,0.99235_r8, & + 0.99192_r8,0.99096_r8/ + data (bm3i( 5, 9,ibeta ), ibeta=1,10)/ & + 0.99581_r8,0.99600_r8,0.99637_r8,0.99672_r8,0.99691_r8,0.99687_r8,0.99653_r8,0.99585_r8, & + 0.99478_r8,0.99329_r8/ + data (bm3i( 5,10,ibeta ), ibeta=1,10)/ & + 0.99873_r8,0.99878_r8,0.99884_r8,0.99883_r8,0.99869_r8,0.99834_r8,0.99774_r8,0.99684_r8, & + 0.99558_r8,0.99394_r8/ + data (bm3i( 6, 1,ibeta ), ibeta=1,10)/ & + 0.93335_r8,0.93777_r8,0.94711_r8,0.95764_r8,0.96741_r8,0.97562_r8,0.98210_r8,0.98701_r8, & + 0.99064_r8,0.99327_r8/ + data (bm3i( 6, 2,ibeta ), ibeta=1,10)/ & + 0.92142_r8,0.92646_r8,0.93723_r8,0.94947_r8,0.96096_r8,0.97069_r8,0.97842_r8,0.98431_r8, & + 0.98868_r8,0.99186_r8/ + data (bm3i( 6, 3,ibeta ), ibeta=1,10)/ & + 0.88678_r8,0.89351_r8,0.90810_r8,0.92508_r8,0.94138_r8,0.95549_r8,0.96693_r8,0.97578_r8, & + 0.98243_r8,0.98731_r8/ + data (bm3i( 6, 4,ibeta ), ibeta=1,10)/ & + 0.83249_r8,0.84124_r8,0.86051_r8,0.88357_r8,0.90655_r8,0.92728_r8,0.94477_r8,0.95880_r8, & + 0.96964_r8,0.97779_r8/ + data (bm3i( 6, 5,ibeta ), ibeta=1,10)/ & + 0.79593_r8,0.80444_r8,0.82355_r8,0.84725_r8,0.87211_r8,0.89593_r8,0.91735_r8,0.93566_r8, & + 0.95066_r8,0.96255_r8/ + data (bm3i( 6, 6,ibeta ), ibeta=1,10)/ & + 0.84124_r8,0.84695_r8,0.85980_r8,0.87575_r8,0.89256_r8,0.90885_r8,0.92383_r8,0.93704_r8, & + 0.94830_r8,0.95761_r8/ + data (bm3i( 6, 7,ibeta ), ibeta=1,10)/ & + 0.92721_r8,0.93011_r8,0.93647_r8,0.94406_r8,0.95166_r8,0.95862_r8,0.96460_r8,0.96949_r8, & + 0.97326_r8,0.97595_r8/ + data (bm3i( 6, 8,ibeta ), ibeta=1,10)/ & + 0.97573_r8,0.97681_r8,0.97913_r8,0.98175_r8,0.98421_r8,0.98624_r8,0.98772_r8,0.98860_r8, & + 0.98885_r8,0.98847_r8/ + data (bm3i( 6, 9,ibeta ), ibeta=1,10)/ & + 0.99271_r8,0.99304_r8,0.99373_r8,0.99444_r8,0.99499_r8,0.99528_r8,0.99522_r8,0.99477_r8, & + 0.99390_r8,0.99258_r8/ + data (bm3i( 6,10,ibeta ), ibeta=1,10)/ & + 0.99782_r8,0.99791_r8,0.99807_r8,0.99817_r8,0.99813_r8,0.99788_r8,0.99737_r8,0.99653_r8, & + 0.99533_r8,0.99374_r8/ + data (bm3i( 7, 1,ibeta ), ibeta=1,10)/ & + 0.95858_r8,0.96158_r8,0.96780_r8,0.97460_r8,0.98073_r8,0.98575_r8,0.98963_r8,0.99252_r8, & + 0.99463_r8,0.99615_r8/ + data (bm3i( 7, 2,ibeta ), ibeta=1,10)/ & + 0.95091_r8,0.95438_r8,0.96163_r8,0.96962_r8,0.97688_r8,0.98286_r8,0.98751_r8,0.99099_r8, & + 0.99353_r8,0.99536_r8/ + data (bm3i( 7, 3,ibeta ), ibeta=1,10)/ & + 0.92751_r8,0.93233_r8,0.94255_r8,0.95406_r8,0.96473_r8,0.97366_r8,0.98070_r8,0.98602_r8, & + 0.98994_r8,0.99278_r8/ + data (bm3i( 7, 4,ibeta ), ibeta=1,10)/ & + 0.88371_r8,0.89075_r8,0.90595_r8,0.92351_r8,0.94028_r8,0.95474_r8,0.96642_r8,0.97544_r8, & + 0.98220_r8,0.98715_r8/ + data (bm3i( 7, 5,ibeta ), ibeta=1,10)/ & + 0.82880_r8,0.83750_r8,0.85671_r8,0.87980_r8,0.90297_r8,0.92404_r8,0.94195_r8,0.95644_r8, & + 0.96772_r8,0.97625_r8/ + data (bm3i( 7, 6,ibeta ), ibeta=1,10)/ & + 0.81933_r8,0.82655_r8,0.84279_r8,0.86295_r8,0.88412_r8,0.90449_r8,0.92295_r8,0.93890_r8, & + 0.95215_r8,0.96281_r8/ + data (bm3i( 7, 7,ibeta ), ibeta=1,10)/ & + 0.89099_r8,0.89519_r8,0.90448_r8,0.91577_r8,0.92732_r8,0.93820_r8,0.94789_r8,0.95616_r8, & + 0.96297_r8,0.96838_r8/ + data (bm3i( 7, 8,ibeta ), ibeta=1,10)/ & + 0.95886_r8,0.96064_r8,0.96448_r8,0.96894_r8,0.97324_r8,0.97701_r8,0.98004_r8,0.98228_r8, & + 0.98371_r8,0.98435_r8/ + data (bm3i( 7, 9,ibeta ), ibeta=1,10)/ & + 0.98727_r8,0.98786_r8,0.98908_r8,0.99043_r8,0.99160_r8,0.99245_r8,0.99288_r8,0.99285_r8, & + 0.99234_r8,0.99131_r8/ + data (bm3i( 7,10,ibeta ), ibeta=1,10)/ & + 0.99621_r8,0.99638_r8,0.99671_r8,0.99700_r8,0.99715_r8,0.99707_r8,0.99670_r8,0.99599_r8, & + 0.99489_r8,0.99338_r8/ + data (bm3i( 8, 1,ibeta ), ibeta=1,10)/ & + 0.97470_r8,0.97666_r8,0.98064_r8,0.98491_r8,0.98867_r8,0.99169_r8,0.99399_r8,0.99569_r8, & + 0.99691_r8,0.99779_r8/ + data (bm3i( 8, 2,ibeta ), ibeta=1,10)/ & + 0.96996_r8,0.97225_r8,0.97693_r8,0.98196_r8,0.98643_r8,0.99003_r8,0.99279_r8,0.99482_r8, & + 0.99630_r8,0.99735_r8/ + data (bm3i( 8, 3,ibeta ), ibeta=1,10)/ & + 0.95523_r8,0.95848_r8,0.96522_r8,0.97260_r8,0.97925_r8,0.98468_r8,0.98888_r8,0.99200_r8, & + 0.99427_r8,0.99590_r8/ + data (bm3i( 8, 4,ibeta ), ibeta=1,10)/ & + 0.92524_r8,0.93030_r8,0.94098_r8,0.95294_r8,0.96397_r8,0.97317_r8,0.98038_r8,0.98582_r8, & + 0.98981_r8,0.99270_r8/ + data (bm3i( 8, 5,ibeta ), ibeta=1,10)/ & + 0.87576_r8,0.88323_r8,0.89935_r8,0.91799_r8,0.93583_r8,0.95126_r8,0.96377_r8,0.97345_r8, & + 0.98072_r8,0.98606_r8/ + data (bm3i( 8, 6,ibeta ), ibeta=1,10)/ & + 0.83078_r8,0.83894_r8,0.85705_r8,0.87899_r8,0.90126_r8,0.92179_r8,0.93950_r8,0.95404_r8, & + 0.96551_r8,0.97430_r8/ + data (bm3i( 8, 7,ibeta ), ibeta=1,10)/ & + 0.85727_r8,0.86294_r8,0.87558_r8,0.89111_r8,0.90723_r8,0.92260_r8,0.93645_r8,0.94841_r8, & + 0.95838_r8,0.96643_r8/ + data (bm3i( 8, 8,ibeta ), ibeta=1,10)/ & + 0.93337_r8,0.93615_r8,0.94220_r8,0.94937_r8,0.95647_r8,0.96292_r8,0.96840_r8,0.97283_r8, & + 0.97619_r8,0.97854_r8/ + data (bm3i( 8, 9,ibeta ), ibeta=1,10)/ & + 0.97790_r8,0.97891_r8,0.98105_r8,0.98346_r8,0.98569_r8,0.98751_r8,0.98879_r8,0.98950_r8, & + 0.98961_r8,0.98912_r8/ + data (bm3i( 8,10,ibeta ), ibeta=1,10)/ & + 0.99337_r8,0.99367_r8,0.99430_r8,0.99493_r8,0.99541_r8,0.99562_r8,0.99551_r8,0.99501_r8, & + 0.99410_r8,0.99274_r8/ + data (bm3i( 9, 1,ibeta ), ibeta=1,10)/ & + 0.98470_r8,0.98594_r8,0.98844_r8,0.99106_r8,0.99334_r8,0.99514_r8,0.99650_r8,0.99749_r8, & + 0.99821_r8,0.99872_r8/ + data (bm3i( 9, 2,ibeta ), ibeta=1,10)/ & + 0.98184_r8,0.98330_r8,0.98624_r8,0.98934_r8,0.99205_r8,0.99420_r8,0.99582_r8,0.99701_r8, & + 0.99787_r8,0.99848_r8/ + data (bm3i( 9, 3,ibeta ), ibeta=1,10)/ & + 0.97288_r8,0.97498_r8,0.97927_r8,0.98385_r8,0.98789_r8,0.99113_r8,0.99360_r8,0.99541_r8, & + 0.99673_r8,0.99766_r8/ + data (bm3i( 9, 4,ibeta ), ibeta=1,10)/ & + 0.95403_r8,0.95741_r8,0.96440_r8,0.97202_r8,0.97887_r8,0.98444_r8,0.98872_r8,0.99190_r8, & + 0.99421_r8,0.99586_r8/ + data (bm3i( 9, 5,ibeta ), ibeta=1,10)/ & + 0.91845_r8,0.92399_r8,0.93567_r8,0.94873_r8,0.96076_r8,0.97079_r8,0.97865_r8,0.98457_r8, & + 0.98892_r8,0.99206_r8/ + data (bm3i( 9, 6,ibeta ), ibeta=1,10)/ & + 0.86762_r8,0.87533_r8,0.89202_r8,0.91148_r8,0.93027_r8,0.94669_r8,0.96013_r8,0.97062_r8, & + 0.97855_r8,0.98441_r8/ + data (bm3i( 9, 7,ibeta ), ibeta=1,10)/ & + 0.84550_r8,0.85253_r8,0.86816_r8,0.88721_r8,0.90671_r8,0.92490_r8,0.94083_r8,0.95413_r8, & + 0.96481_r8,0.97314_r8/ + data (bm3i( 9, 8,ibeta ), ibeta=1,10)/ & + 0.90138_r8,0.90544_r8,0.91437_r8,0.92513_r8,0.93602_r8,0.94615_r8,0.95506_r8,0.96258_r8, & + 0.96868_r8,0.97347_r8/ + data (bm3i( 9, 9,ibeta ), ibeta=1,10)/ & + 0.96248_r8,0.96415_r8,0.96773_r8,0.97187_r8,0.97583_r8,0.97925_r8,0.98198_r8,0.98394_r8, & + 0.98514_r8,0.98559_r8/ + data (bm3i( 9,10,ibeta ), ibeta=1,10)/ & + 0.98837_r8,0.98892_r8,0.99005_r8,0.99127_r8,0.99232_r8,0.99306_r8,0.99339_r8,0.99328_r8, & + 0.99269_r8,0.99161_r8/ + data (bm3i(10, 1,ibeta ), ibeta=1,10)/ & + 0.99080_r8,0.99158_r8,0.99311_r8,0.99471_r8,0.99607_r8,0.99715_r8,0.99795_r8,0.99853_r8, & + 0.99895_r8,0.99925_r8/ + data (bm3i(10, 2,ibeta ), ibeta=1,10)/ & + 0.98910_r8,0.99001_r8,0.99182_r8,0.99371_r8,0.99533_r8,0.99661_r8,0.99757_r8,0.99826_r8, & + 0.99876_r8,0.99912_r8/ + data (bm3i(10, 3,ibeta ), ibeta=1,10)/ & + 0.98374_r8,0.98506_r8,0.98772_r8,0.99051_r8,0.99294_r8,0.99486_r8,0.99630_r8,0.99736_r8, & + 0.99812_r8,0.99866_r8/ + data (bm3i(10, 4,ibeta ), ibeta=1,10)/ & + 0.97238_r8,0.97453_r8,0.97892_r8,0.98361_r8,0.98773_r8,0.99104_r8,0.99354_r8,0.99538_r8, & + 0.99671_r8,0.99765_r8/ + data (bm3i(10, 5,ibeta ), ibeta=1,10)/ & + 0.94961_r8,0.95333_r8,0.96103_r8,0.96941_r8,0.97693_r8,0.98303_r8,0.98772_r8,0.99119_r8, & + 0.99371_r8,0.99551_r8/ + data (bm3i(10, 6,ibeta ), ibeta=1,10)/ & + 0.90943_r8,0.91550_r8,0.92834_r8,0.94275_r8,0.95608_r8,0.96723_r8,0.97600_r8,0.98263_r8, & + 0.98751_r8,0.99103_r8/ + data (bm3i(10, 7,ibeta ), ibeta=1,10)/ & + 0.86454_r8,0.87200_r8,0.88829_r8,0.90749_r8,0.92630_r8,0.94300_r8,0.95687_r8,0.96785_r8, & + 0.97626_r8,0.98254_r8/ + data (bm3i(10, 8,ibeta ), ibeta=1,10)/ & + 0.87498_r8,0.88048_r8,0.89264_r8,0.90737_r8,0.92240_r8,0.93642_r8,0.94877_r8,0.95917_r8, & + 0.96762_r8,0.97429_r8/ + data (bm3i(10, 9,ibeta ), ibeta=1,10)/ & + 0.93946_r8,0.94209_r8,0.94781_r8,0.95452_r8,0.96111_r8,0.96704_r8,0.97203_r8,0.97602_r8, & + 0.97900_r8,0.98106_r8/ + data (bm3i(10,10,ibeta ), ibeta=1,10)/ & + 0.97977_r8,0.98071_r8,0.98270_r8,0.98492_r8,0.98695_r8,0.98858_r8,0.98970_r8,0.99027_r8, & + 0.99026_r8,0.98968_r8/ + +! fsb fm correction for intramodal m2 coagulation + data bm2ii / & + 0.707107_r8, 0.720583_r8, 0.745310_r8, 0.748056_r8, 0.696935_r8, & + 0.604164_r8, 0.504622_r8, 0.416559_r8, 0.343394_r8, 0.283641_r8/ + +! *** total correction for intramodal m2 coagulation + + data bm2iitt / & + 1.000000_r8, 0.907452_r8, 0.680931_r8, 0.409815_r8, 0.196425_r8, & + 0.078814_r8, 0.028473_r8, 0.009800_r8, 0.003322_r8, 0.001129_r8/ + + +! fsb fm correction for m2 i to j coagulation + + data (bm2ij ( 1, 1,ibeta), ibeta = 1,10) / & + 0.707107_r8, 0.716828_r8, 0.738240_r8, 0.764827_r8, 0.793610_r8, & + 0.822843_r8, 0.851217_r8, 0.877670_r8, 0.901404_r8, 0.921944_r8/ + data (bm2ij ( 1, 2,ibeta), ibeta = 1,10) / & + 0.719180_r8, 0.727975_r8, 0.747638_r8, 0.772334_r8, 0.799234_r8, & + 0.826666_r8, 0.853406_r8, 0.878482_r8, 0.901162_r8, 0.920987_r8/ + data (bm2ij ( 1, 3,ibeta), ibeta = 1,10) / & + 0.760947_r8, 0.767874_r8, 0.783692_r8, 0.803890_r8, 0.826015_r8, & + 0.848562_r8, 0.870498_r8, 0.891088_r8, 0.909823_r8, 0.926400_r8/ + data (bm2ij ( 1, 4,ibeta), ibeta = 1,10) / & + 0.830926_r8, 0.836034_r8, 0.847708_r8, 0.862528_r8, 0.878521_r8, & + 0.894467_r8, 0.909615_r8, 0.923520_r8, 0.935959_r8, 0.946858_r8/ + data (bm2ij ( 1, 5,ibeta), ibeta = 1,10) / & + 0.903643_r8, 0.907035_r8, 0.914641_r8, 0.924017_r8, 0.933795_r8, & + 0.943194_r8, 0.951806_r8, 0.959449_r8, 0.966087_r8, 0.971761_r8/ + data (bm2ij ( 1, 6,ibeta), ibeta = 1,10) / & + 0.954216_r8, 0.956094_r8, 0.960211_r8, 0.965123_r8, 0.970068_r8, & + 0.974666_r8, 0.978750_r8, 0.982277_r8, 0.985268_r8, 0.987775_r8/ + data (bm2ij ( 1, 7,ibeta), ibeta = 1,10) / & + 0.980546_r8, 0.981433_r8, 0.983343_r8, 0.985568_r8, 0.987751_r8, & + 0.989735_r8, 0.991461_r8, 0.992926_r8, 0.994150_r8, 0.995164_r8/ + data (bm2ij ( 1, 8,ibeta), ibeta = 1,10) / & + 0.992142_r8, 0.992524_r8, 0.993338_r8, 0.994272_r8, 0.995174_r8, & + 0.995981_r8, 0.996675_r8, 0.997257_r8, 0.997740_r8, 0.998137_r8/ + data (bm2ij ( 1, 9,ibeta), ibeta = 1,10) / & + 0.996868_r8, 0.997026_r8, 0.997361_r8, 0.997742_r8, 0.998106_r8, & + 0.998430_r8, 0.998705_r8, 0.998935_r8, 0.999125_r8, 0.999280_r8/ + data (bm2ij ( 1, 10,ibeta), ibeta = 1,10) / & + 0.998737_r8, 0.998802_r8, 0.998939_r8, 0.999094_r8, 0.999241_r8, & + 0.999371_r8, 0.999481_r8, 0.999573_r8, 0.999648_r8, 0.999709_r8/ + data (bm2ij ( 2, 1,ibeta), ibeta = 1,10) / & + 0.729600_r8, 0.739948_r8, 0.763059_r8, 0.791817_r8, 0.822510_r8, & + 0.852795_r8, 0.881000_r8, 0.905999_r8, 0.927206_r8, 0.944532_r8/ + data (bm2ij ( 2, 2,ibeta), ibeta = 1,10) / & + 0.727025_r8, 0.737116_r8, 0.759615_r8, 0.787657_r8, 0.817740_r8, & + 0.847656_r8, 0.875801_r8, 0.901038_r8, 0.922715_r8, 0.940643_r8/ + data (bm2ij ( 2, 3,ibeta), ibeta = 1,10) / & + 0.738035_r8, 0.746779_r8, 0.766484_r8, 0.791340_r8, 0.818324_r8, & + 0.845546_r8, 0.871629_r8, 0.895554_r8, 0.916649_r8, 0.934597_r8/ + data (bm2ij ( 2, 4,ibeta), ibeta = 1,10) / & + 0.784185_r8, 0.790883_r8, 0.806132_r8, 0.825501_r8, 0.846545_r8, & + 0.867745_r8, 0.888085_r8, 0.906881_r8, 0.923705_r8, 0.938349_r8/ + data (bm2ij ( 2, 5,ibeta), ibeta = 1,10) / & + 0.857879_r8, 0.862591_r8, 0.873238_r8, 0.886539_r8, 0.900645_r8, & + 0.914463_r8, 0.927360_r8, 0.939004_r8, 0.949261_r8, 0.958125_r8/ + data (bm2ij ( 2, 6,ibeta), ibeta = 1,10) / & + 0.925441_r8, 0.928304_r8, 0.934645_r8, 0.942324_r8, 0.950181_r8, & + 0.957600_r8, 0.964285_r8, 0.970133_r8, 0.975147_r8, 0.979388_r8/ + data (bm2ij ( 2, 7,ibeta), ibeta = 1,10) / & + 0.966728_r8, 0.968176_r8, 0.971323_r8, 0.975027_r8, 0.978705_r8, & + 0.982080_r8, 0.985044_r8, 0.987578_r8, 0.989710_r8, 0.991485_r8/ + data (bm2ij ( 2, 8,ibeta), ibeta = 1,10) / & + 0.986335_r8, 0.986980_r8, 0.988362_r8, 0.989958_r8, 0.991511_r8, & + 0.992912_r8, 0.994122_r8, 0.995143_r8, 0.995992_r8, 0.996693_r8/ + data (bm2ij ( 2, 9,ibeta), ibeta = 1,10) / & + 0.994547_r8, 0.994817_r8, 0.995391_r8, 0.996046_r8, 0.996677_r8, & + 0.997238_r8, 0.997719_r8, 0.998122_r8, 0.998454_r8, 0.998727_r8/ + data (bm2ij ( 2, 10,ibeta), ibeta = 1,10) / & + 0.997817_r8, 0.997928_r8, 0.998163_r8, 0.998429_r8, 0.998683_r8, & + 0.998908_r8, 0.999099_r8, 0.999258_r8, 0.999389_r8, 0.999497_r8/ + data (bm2ij ( 3, 1,ibeta), ibeta = 1,10) / & + 0.783612_r8, 0.793055_r8, 0.814468_r8, 0.841073_r8, 0.868769_r8, & + 0.894963_r8, 0.918118_r8, 0.937527_r8, 0.953121_r8, 0.965244_r8/ + data (bm2ij ( 3, 2,ibeta), ibeta = 1,10) / & + 0.772083_r8, 0.781870_r8, 0.803911_r8, 0.831238_r8, 0.859802_r8, & + 0.887036_r8, 0.911349_r8, 0.931941_r8, 0.948649_r8, 0.961751_r8/ + data (bm2ij ( 3, 3,ibeta), ibeta = 1,10) / & + 0.755766_r8, 0.765509_r8, 0.787380_r8, 0.814630_r8, 0.843526_r8, & + 0.871670_r8, 0.897443_r8, 0.919870_r8, 0.938557_r8, 0.953576_r8/ + data (bm2ij ( 3, 4,ibeta), ibeta = 1,10) / & + 0.763816_r8, 0.772145_r8, 0.790997_r8, 0.814784_r8, 0.840434_r8, & + 0.865978_r8, 0.890034_r8, 0.911671_r8, 0.930366_r8, 0.945963_r8/ + data (bm2ij ( 3, 5,ibeta), ibeta = 1,10) / & + 0.813597_r8, 0.819809_r8, 0.833889_r8, 0.851618_r8, 0.870640_r8, & + 0.889514_r8, 0.907326_r8, 0.923510_r8, 0.937768_r8, 0.950003_r8/ + data (bm2ij ( 3, 6,ibeta), ibeta = 1,10) / & + 0.886317_r8, 0.890437_r8, 0.899643_r8, 0.910955_r8, 0.922730_r8, & + 0.934048_r8, 0.944422_r8, 0.953632_r8, 0.961624_r8, 0.968444_r8/ + data (bm2ij ( 3, 7,ibeta), ibeta = 1,10) / & + 0.944565_r8, 0.946855_r8, 0.951872_r8, 0.957854_r8, 0.963873_r8, & + 0.969468_r8, 0.974438_r8, 0.978731_r8, 0.982372_r8, 0.985424_r8/ + data (bm2ij ( 3, 8,ibeta), ibeta = 1,10) / & + 0.976358_r8, 0.977435_r8, 0.979759_r8, 0.982467_r8, 0.985125_r8, & + 0.987540_r8, 0.989642_r8, 0.991425_r8, 0.992916_r8, 0.994150_r8/ + data (bm2ij ( 3, 9,ibeta), ibeta = 1,10) / & + 0.990471_r8, 0.990932_r8, 0.991917_r8, 0.993048_r8, 0.994142_r8, & + 0.995121_r8, 0.995964_r8, 0.996671_r8, 0.997258_r8, 0.997740_r8/ + data (bm2ij ( 3, 10,ibeta), ibeta = 1,10) / & + 0.996199_r8, 0.996389_r8, 0.996794_r8, 0.997254_r8, 0.997694_r8, & + 0.998086_r8, 0.998420_r8, 0.998699_r8, 0.998929_r8, 0.999117_r8/ + data (bm2ij ( 4, 1,ibeta), ibeta = 1,10) / & + 0.844355_r8, 0.852251_r8, 0.869914_r8, 0.891330_r8, 0.912823_r8, & + 0.932259_r8, 0.948642_r8, 0.961767_r8, 0.971897_r8, 0.979510_r8/ + data (bm2ij ( 4, 2,ibeta), ibeta = 1,10) / & + 0.831550_r8, 0.839954_r8, 0.858754_r8, 0.881583_r8, 0.904592_r8, & + 0.925533_r8, 0.943309_r8, 0.957647_r8, 0.968779_r8, 0.977185_r8/ + data (bm2ij ( 4, 3,ibeta), ibeta = 1,10) / & + 0.803981_r8, 0.813288_r8, 0.834060_r8, 0.859400_r8, 0.885285_r8, & + 0.909286_r8, 0.930084_r8, 0.947193_r8, 0.960714_r8, 0.971078_r8/ + data (bm2ij ( 4, 4,ibeta), ibeta = 1,10) / & + 0.781787_r8, 0.791080_r8, 0.811931_r8, 0.837749_r8, 0.864768_r8, & + 0.890603_r8, 0.913761_r8, 0.933477_r8, 0.949567_r8, 0.962261_r8/ + data (bm2ij ( 4, 5,ibeta), ibeta = 1,10) / & + 0.791591_r8, 0.799355_r8, 0.816916_r8, 0.838961_r8, 0.862492_r8, & + 0.885595_r8, 0.907003_r8, 0.925942_r8, 0.942052_r8, 0.955310_r8/ + data (bm2ij ( 4, 6,ibeta), ibeta = 1,10) / & + 0.844933_r8, 0.850499_r8, 0.863022_r8, 0.878593_r8, 0.895038_r8, & + 0.911072_r8, 0.925939_r8, 0.939227_r8, 0.950765_r8, 0.960550_r8/ + data (bm2ij ( 4, 7,ibeta), ibeta = 1,10) / & + 0.912591_r8, 0.916022_r8, 0.923607_r8, 0.932777_r8, 0.942151_r8, & + 0.951001_r8, 0.958976_r8, 0.965950_r8, 0.971924_r8, 0.976965_r8/ + data (bm2ij ( 4, 8,ibeta), ibeta = 1,10) / & + 0.959859_r8, 0.961617_r8, 0.965433_r8, 0.969924_r8, 0.974382_r8, & + 0.978472_r8, 0.982063_r8, 0.985134_r8, 0.987716_r8, 0.989865_r8/ + data (bm2ij ( 4, 9,ibeta), ibeta = 1,10) / & + 0.983377_r8, 0.984162_r8, 0.985844_r8, 0.987788_r8, 0.989681_r8, & + 0.991386_r8, 0.992860_r8, 0.994104_r8, 0.995139_r8, 0.995991_r8/ + data (bm2ij ( 4, 10,ibeta), ibeta = 1,10) / & + 0.993343_r8, 0.993672_r8, 0.994370_r8, 0.995169_r8, 0.995937_r8, & + 0.996622_r8, 0.997209_r8, 0.997700_r8, 0.998106_r8, 0.998439_r8/ + data (bm2ij ( 5, 1,ibeta), ibeta = 1,10) / & + 0.895806_r8, 0.901918_r8, 0.915233_r8, 0.930783_r8, 0.945768_r8, & + 0.958781_r8, 0.969347_r8, 0.977540_r8, 0.983697_r8, 0.988225_r8/ + data (bm2ij ( 5, 2,ibeta), ibeta = 1,10) / & + 0.885634_r8, 0.892221_r8, 0.906629_r8, 0.923540_r8, 0.939918_r8, & + 0.954213_r8, 0.965873_r8, 0.974951_r8, 0.981794_r8, 0.986840_r8/ + data (bm2ij ( 5, 3,ibeta), ibeta = 1,10) / & + 0.860120_r8, 0.867858_r8, 0.884865_r8, 0.904996_r8, 0.924724_r8, & + 0.942177_r8, 0.956602_r8, 0.967966_r8, 0.976616_r8, 0.983043_r8/ + data (bm2ij ( 5, 4,ibeta), ibeta = 1,10) / & + 0.827462_r8, 0.836317_r8, 0.855885_r8, 0.879377_r8, 0.902897_r8, & + 0.924232_r8, 0.942318_r8, 0.956900_r8, 0.968222_r8, 0.976774_r8/ + data (bm2ij ( 5, 5,ibeta), ibeta = 1,10) / & + 0.805527_r8, 0.814279_r8, 0.833853_r8, 0.857892_r8, 0.882726_r8, & + 0.906095_r8, 0.926690_r8, 0.943938_r8, 0.957808_r8, 0.968615_r8/ + data (bm2ij ( 5, 6,ibeta), ibeta = 1,10) / & + 0.820143_r8, 0.827223_r8, 0.843166_r8, 0.863002_r8, 0.883905_r8, & + 0.904128_r8, 0.922585_r8, 0.938687_r8, 0.952222_r8, 0.963255_r8/ + data (bm2ij ( 5, 7,ibeta), ibeta = 1,10) / & + 0.875399_r8, 0.880208_r8, 0.890929_r8, 0.904065_r8, 0.917699_r8, & + 0.930756_r8, 0.942656_r8, 0.953131_r8, 0.962113_r8, 0.969657_r8/ + data (bm2ij ( 5, 8,ibeta), ibeta = 1,10) / & + 0.934782_r8, 0.937520_r8, 0.943515_r8, 0.950656_r8, 0.957840_r8, & + 0.964516_r8, 0.970446_r8, 0.975566_r8, 0.979905_r8, 0.983534_r8/ + data (bm2ij ( 5, 9,ibeta), ibeta = 1,10) / & + 0.971369_r8, 0.972679_r8, 0.975505_r8, 0.978797_r8, 0.982029_r8, & + 0.984964_r8, 0.987518_r8, 0.989685_r8, 0.991496_r8, 0.992994_r8/ + data (bm2ij ( 5, 10,ibeta), ibeta = 1,10) / & + 0.988329_r8, 0.988893_r8, 0.990099_r8, 0.991485_r8, 0.992825_r8, & + 0.994025_r8, 0.995058_r8, 0.995925_r8, 0.996643_r8, 0.997234_r8/ + data (bm2ij ( 6, 1,ibeta), ibeta = 1,10) / & + 0.933384_r8, 0.937784_r8, 0.947130_r8, 0.957655_r8, 0.967430_r8, & + 0.975639_r8, 0.982119_r8, 0.987031_r8, 0.990657_r8, 0.993288_r8/ + data (bm2ij ( 6, 2,ibeta), ibeta = 1,10) / & + 0.926445_r8, 0.931227_r8, 0.941426_r8, 0.952975_r8, 0.963754_r8, & + 0.972845_r8, 0.980044_r8, 0.985514_r8, 0.989558_r8, 0.992498_r8/ + data (bm2ij ( 6, 3,ibeta), ibeta = 1,10) / & + 0.907835_r8, 0.913621_r8, 0.926064_r8, 0.940308_r8, 0.953745_r8, & + 0.965189_r8, 0.974327_r8, 0.981316_r8, 0.986510_r8, 0.990297_r8/ + data (bm2ij ( 6, 4,ibeta), ibeta = 1,10) / & + 0.879088_r8, 0.886306_r8, 0.901945_r8, 0.920079_r8, 0.937460_r8, & + 0.952509_r8, 0.964711_r8, 0.974166_r8, 0.981265_r8, 0.986484_r8/ + data (bm2ij ( 6, 5,ibeta), ibeta = 1,10) / & + 0.846500_r8, 0.854862_r8, 0.873189_r8, 0.894891_r8, 0.916264_r8, & + 0.935315_r8, 0.951197_r8, 0.963812_r8, 0.973484_r8, 0.980715_r8/ + data (bm2ij ( 6, 6,ibeta), ibeta = 1,10) / & + 0.828137_r8, 0.836250_r8, 0.854310_r8, 0.876287_r8, 0.898710_r8, & + 0.919518_r8, 0.937603_r8, 0.952560_r8, 0.964461_r8, 0.973656_r8/ + data (bm2ij ( 6, 7,ibeta), ibeta = 1,10) / & + 0.848595_r8, 0.854886_r8, 0.868957_r8, 0.886262_r8, 0.904241_r8, & + 0.921376_r8, 0.936799_r8, 0.950096_r8, 0.961172_r8, 0.970145_r8/ + data (bm2ij ( 6, 8,ibeta), ibeta = 1,10) / & + 0.902919_r8, 0.906922_r8, 0.915760_r8, 0.926427_r8, 0.937312_r8, & + 0.947561_r8, 0.956758_r8, 0.964747_r8, 0.971525_r8, 0.977175_r8/ + data (bm2ij ( 6, 9,ibeta), ibeta = 1,10) / & + 0.952320_r8, 0.954434_r8, 0.959021_r8, 0.964418_r8, 0.969774_r8, & + 0.974688_r8, 0.979003_r8, 0.982690_r8, 0.985789_r8, 0.988364_r8/ + data (bm2ij ( 6, 10,ibeta), ibeta = 1,10) / & + 0.979689_r8, 0.980650_r8, 0.982712_r8, 0.985093_r8, 0.987413_r8, & + 0.989502_r8, 0.991308_r8, 0.992831_r8, 0.994098_r8, 0.995142_r8/ + data (bm2ij ( 7, 1,ibeta), ibeta = 1,10) / & + 0.958611_r8, 0.961598_r8, 0.967817_r8, 0.974620_r8, 0.980752_r8, & + 0.985771_r8, 0.989650_r8, 0.992543_r8, 0.994653_r8, 0.996171_r8/ + data (bm2ij ( 7, 2,ibeta), ibeta = 1,10) / & + 0.954225_r8, 0.957488_r8, 0.964305_r8, 0.971795_r8, 0.978576_r8, & + 0.984144_r8, 0.988458_r8, 0.991681_r8, 0.994034_r8, 0.995728_r8/ + data (bm2ij ( 7, 3,ibeta), ibeta = 1,10) / & + 0.942147_r8, 0.946158_r8, 0.954599_r8, 0.963967_r8, 0.972529_r8, & + 0.979612_r8, 0.985131_r8, 0.989271_r8, 0.992301_r8, 0.994487_r8/ + data (bm2ij ( 7, 4,ibeta), ibeta = 1,10) / & + 0.921821_r8, 0.927048_r8, 0.938140_r8, 0.950598_r8, 0.962118_r8, & + 0.971752_r8, 0.979326_r8, 0.985046_r8, 0.989254_r8, 0.992299_r8/ + data (bm2ij ( 7, 5,ibeta), ibeta = 1,10) / & + 0.893419_r8, 0.900158_r8, 0.914598_r8, 0.931070_r8, 0.946584_r8, & + 0.959795_r8, 0.970350_r8, 0.978427_r8, 0.984432_r8, 0.988811_r8/ + data (bm2ij ( 7, 6,ibeta), ibeta = 1,10) / & + 0.863302_r8, 0.871111_r8, 0.888103_r8, 0.907990_r8, 0.927305_r8, & + 0.944279_r8, 0.958245_r8, 0.969211_r8, 0.977540_r8, 0.983720_r8/ + data (bm2ij ( 7, 7,ibeta), ibeta = 1,10) / & + 0.850182_r8, 0.857560_r8, 0.873890_r8, 0.893568_r8, 0.913408_r8, & + 0.931591_r8, 0.947216_r8, 0.960014_r8, 0.970121_r8, 0.977886_r8/ + data (bm2ij ( 7, 8,ibeta), ibeta = 1,10) / & + 0.875837_r8, 0.881265_r8, 0.893310_r8, 0.907936_r8, 0.922910_r8, & + 0.936977_r8, 0.949480_r8, 0.960154_r8, 0.968985_r8, 0.976111_r8/ + data (bm2ij ( 7, 9,ibeta), ibeta = 1,10) / & + 0.926228_r8, 0.929445_r8, 0.936486_r8, 0.944868_r8, 0.953293_r8, & + 0.961108_r8, 0.968028_r8, 0.973973_r8, 0.978974_r8, 0.983118_r8/ + data (bm2ij ( 7, 10,ibeta), ibeta = 1,10) / & + 0.965533_r8, 0.967125_r8, 0.970558_r8, 0.974557_r8, 0.978484_r8, & + 0.982050_r8, 0.985153_r8, 0.987785_r8, 0.989982_r8, 0.991798_r8/ + data (bm2ij ( 8, 1,ibeta), ibeta = 1,10) / & + 0.974731_r8, 0.976674_r8, 0.980660_r8, 0.984926_r8, 0.988689_r8, & + 0.991710_r8, 0.994009_r8, 0.995703_r8, 0.996929_r8, 0.997805_r8/ + data (bm2ij ( 8, 2,ibeta), ibeta = 1,10) / & + 0.972062_r8, 0.974192_r8, 0.978571_r8, 0.983273_r8, 0.987432_r8, & + 0.990780_r8, 0.993333_r8, 0.995218_r8, 0.996581_r8, 0.997557_r8/ + data (bm2ij ( 8, 3,ibeta), ibeta = 1,10) / & + 0.964662_r8, 0.967300_r8, 0.972755_r8, 0.978659_r8, 0.983921_r8, & + 0.988181_r8, 0.991444_r8, 0.993859_r8, 0.995610_r8, 0.996863_r8/ + data (bm2ij ( 8, 4,ibeta), ibeta = 1,10) / & + 0.951782_r8, 0.955284_r8, 0.962581_r8, 0.970559_r8, 0.977737_r8, & + 0.983593_r8, 0.988103_r8, 0.991454_r8, 0.993889_r8, 0.995635_r8/ + data (bm2ij ( 8, 5,ibeta), ibeta = 1,10) / & + 0.931947_r8, 0.936723_r8, 0.946751_r8, 0.957843_r8, 0.967942_r8, & + 0.976267_r8, 0.982734_r8, 0.987571_r8, 0.991102_r8, 0.993642_r8/ + data (bm2ij ( 8, 6,ibeta), ibeta = 1,10) / & + 0.905410_r8, 0.911665_r8, 0.924950_r8, 0.939908_r8, 0.953798_r8, & + 0.965469_r8, 0.974684_r8, 0.981669_r8, 0.986821_r8, 0.990556_r8/ + data (bm2ij ( 8, 7,ibeta), ibeta = 1,10) / & + 0.878941_r8, 0.886132_r8, 0.901679_r8, 0.919688_r8, 0.936970_r8, & + 0.951980_r8, 0.964199_r8, 0.973709_r8, 0.980881_r8, 0.986174_r8/ + data (bm2ij ( 8, 8,ibeta), ibeta = 1,10) / & + 0.871653_r8, 0.878218_r8, 0.892652_r8, 0.909871_r8, 0.927034_r8, & + 0.942592_r8, 0.955836_r8, 0.966604_r8, 0.975065_r8, 0.981545_r8/ + data (bm2ij ( 8, 9,ibeta), ibeta = 1,10) / & + 0.900693_r8, 0.905239_r8, 0.915242_r8, 0.927232_r8, 0.939335_r8, & + 0.950555_r8, 0.960420_r8, 0.968774_r8, 0.975651_r8, 0.981188_r8/ + data (bm2ij ( 8, 10,ibeta), ibeta = 1,10) / & + 0.944922_r8, 0.947435_r8, 0.952894_r8, 0.959317_r8, 0.965689_r8, & + 0.971529_r8, 0.976645_r8, 0.981001_r8, 0.984641_r8, 0.987642_r8/ + data (bm2ij ( 9, 1,ibeta), ibeta = 1,10) / & + 0.984736_r8, 0.985963_r8, 0.988453_r8, 0.991078_r8, 0.993357_r8, & + 0.995161_r8, 0.996519_r8, 0.997512_r8, 0.998226_r8, 0.998734_r8/ + data (bm2ij ( 9, 2,ibeta), ibeta = 1,10) / & + 0.983141_r8, 0.984488_r8, 0.987227_r8, 0.990119_r8, 0.992636_r8, & + 0.994632_r8, 0.996137_r8, 0.997238_r8, 0.998030_r8, 0.998595_r8/ + data (bm2ij ( 9, 3,ibeta), ibeta = 1,10) / & + 0.978726_r8, 0.980401_r8, 0.983819_r8, 0.987450_r8, 0.990626_r8, & + 0.993157_r8, 0.995071_r8, 0.996475_r8, 0.997486_r8, 0.998206_r8/ + data (bm2ij ( 9, 4,ibeta), ibeta = 1,10) / & + 0.970986_r8, 0.973224_r8, 0.977818_r8, 0.982737_r8, 0.987072_r8, & + 0.990546_r8, 0.993184_r8, 0.995124_r8, 0.996523_r8, 0.997521_r8/ + data (bm2ij ( 9, 5,ibeta), ibeta = 1,10) / & + 0.958579_r8, 0.961700_r8, 0.968149_r8, 0.975116_r8, 0.981307_r8, & + 0.986301_r8, 0.990112_r8, 0.992923_r8, 0.994954_r8, 0.996404_r8/ + data (bm2ij ( 9, 6,ibeta), ibeta = 1,10) / & + 0.940111_r8, 0.944479_r8, 0.953572_r8, 0.963506_r8, 0.972436_r8, & + 0.979714_r8, 0.985313_r8, 0.989468_r8, 0.992483_r8, 0.994641_r8/ + data (bm2ij ( 9, 7,ibeta), ibeta = 1,10) / & + 0.916127_r8, 0.921878_r8, 0.934003_r8, 0.947506_r8, 0.959899_r8, & + 0.970199_r8, 0.978255_r8, 0.984314_r8, 0.988755_r8, 0.991960_r8/ + data (bm2ij ( 9, 8,ibeta), ibeta = 1,10) / & + 0.893848_r8, 0.900364_r8, 0.914368_r8, 0.930438_r8, 0.945700_r8, & + 0.958824_r8, 0.969416_r8, 0.977603_r8, 0.983746_r8, 0.988262_r8/ + data (bm2ij ( 9, 9,ibeta), ibeta = 1,10) / & + 0.892161_r8, 0.897863_r8, 0.910315_r8, 0.925021_r8, 0.939523_r8, & + 0.952544_r8, 0.963544_r8, 0.972442_r8, 0.979411_r8, 0.984742_r8/ + data (bm2ij ( 9, 10,ibeta), ibeta = 1,10) / & + 0.922260_r8, 0.925966_r8, 0.934047_r8, 0.943616_r8, 0.953152_r8, & + 0.961893_r8, 0.969506_r8, 0.975912_r8, 0.981167_r8, 0.985394_r8/ + data (bm2ij ( 10, 1,ibeta), ibeta = 1,10) / & + 0.990838_r8, 0.991598_r8, 0.993128_r8, 0.994723_r8, 0.996092_r8, & + 0.997167_r8, 0.997969_r8, 0.998552_r8, 0.998969_r8, 0.999265_r8/ + data (bm2ij ( 10, 2,ibeta), ibeta = 1,10) / & + 0.989892_r8, 0.990727_r8, 0.992411_r8, 0.994167_r8, 0.995678_r8, & + 0.996864_r8, 0.997751_r8, 0.998396_r8, 0.998858_r8, 0.999186_r8/ + data (bm2ij ( 10, 3,ibeta), ibeta = 1,10) / & + 0.987287_r8, 0.988327_r8, 0.990428_r8, 0.992629_r8, 0.994529_r8, & + 0.996026_r8, 0.997148_r8, 0.997965_r8, 0.998551_r8, 0.998967_r8/ + data (bm2ij ( 10, 4,ibeta), ibeta = 1,10) / & + 0.982740_r8, 0.984130_r8, 0.986952_r8, 0.989926_r8, 0.992508_r8, & + 0.994551_r8, 0.996087_r8, 0.997208_r8, 0.998012_r8, 0.998584_r8/ + data (bm2ij ( 10, 5,ibeta), ibeta = 1,10) / & + 0.975380_r8, 0.977330_r8, 0.981307_r8, 0.985529_r8, 0.989216_r8, & + 0.992147_r8, 0.994358_r8, 0.995975_r8, 0.997136_r8, 0.997961_r8/ + data (bm2ij ( 10, 6,ibeta), ibeta = 1,10) / & + 0.963911_r8, 0.966714_r8, 0.972465_r8, 0.978614_r8, 0.984022_r8, & + 0.988346_r8, 0.991620_r8, 0.994020_r8, 0.995747_r8, 0.996974_r8/ + data (bm2ij ( 10, 7,ibeta), ibeta = 1,10) / & + 0.947187_r8, 0.951161_r8, 0.959375_r8, 0.968258_r8, 0.976160_r8, & + 0.982540_r8, 0.987409_r8, 0.991000_r8, 0.993592_r8, 0.995441_r8/ + data (bm2ij ( 10, 8,ibeta), ibeta = 1,10) / & + 0.926045_r8, 0.931270_r8, 0.942218_r8, 0.954297_r8, 0.965273_r8, & + 0.974311_r8, 0.981326_r8, 0.986569_r8, 0.990394_r8, 0.993143_r8/ + data (bm2ij ( 10, 9,ibeta), ibeta = 1,10) / & + 0.908092_r8, 0.913891_r8, 0.926288_r8, 0.940393_r8, 0.953667_r8, & + 0.964987_r8, 0.974061_r8, 0.981038_r8, 0.986253_r8, 0.990078_r8/ + data (bm2ij ( 10, 10,ibeta), ibeta = 1,10) / & + 0.911143_r8, 0.915972_r8, 0.926455_r8, 0.938721_r8, 0.950701_r8, & + 0.961370_r8, 0.970329_r8, 0.977549_r8, 0.983197_r8, 0.987518_r8/ + + +! fsb total correction factor for m2 coagulation j from i + + data (bm2ji( 1, 1,ibeta), ibeta = 1,10) / & + 0.753466_r8, 0.756888_r8, 0.761008_r8, 0.759432_r8, 0.748675_r8, & + 0.726951_r8, 0.693964_r8, 0.650915_r8, 0.600227_r8, 0.545000_r8/ + data (bm2ji( 1, 2,ibeta), ibeta = 1,10) / & + 0.824078_r8, 0.828698_r8, 0.835988_r8, 0.838943_r8, 0.833454_r8, & + 0.817148_r8, 0.789149_r8, 0.750088_r8, 0.701887_r8, 0.647308_r8/ + data (bm2ji( 1, 3,ibeta), ibeta = 1,10) / & + 1.007389_r8, 1.014362_r8, 1.028151_r8, 1.041011_r8, 1.047939_r8, & + 1.045707_r8, 1.032524_r8, 1.007903_r8, 0.972463_r8, 0.927667_r8/ + data (bm2ji( 1, 4,ibeta), ibeta = 1,10) / & + 1.246157_r8, 1.255135_r8, 1.274249_r8, 1.295351_r8, 1.313362_r8, & + 1.325187_r8, 1.329136_r8, 1.324491_r8, 1.311164_r8, 1.289459_r8/ + data (bm2ji( 1, 5,ibeta), ibeta = 1,10) / & + 1.450823_r8, 1.459551_r8, 1.478182_r8, 1.499143_r8, 1.518224_r8, & + 1.533312_r8, 1.543577_r8, 1.548882_r8, 1.549395_r8, 1.545364_r8/ + data (bm2ji( 1, 6,ibeta), ibeta = 1,10) / & + 1.575248_r8, 1.581832_r8, 1.595643_r8, 1.610866_r8, 1.624601_r8, & + 1.635690_r8, 1.643913_r8, 1.649470_r8, 1.652688_r8, 1.653878_r8/ + data (bm2ji( 1, 7,ibeta), ibeta = 1,10) / & + 1.638426_r8, 1.642626_r8, 1.651293_r8, 1.660641_r8, 1.668926_r8, & + 1.675571_r8, 1.680572_r8, 1.684147_r8, 1.686561_r8, 1.688047_r8/ + data (bm2ji( 1, 8,ibeta), ibeta = 1,10) / & + 1.669996_r8, 1.672392_r8, 1.677283_r8, 1.682480_r8, 1.687028_r8, & + 1.690651_r8, 1.693384_r8, 1.695372_r8, 1.696776_r8, 1.697734_r8/ + data (bm2ji( 1, 9,ibeta), ibeta = 1,10) / & + 1.686148_r8, 1.687419_r8, 1.689993_r8, 1.692704_r8, 1.695057_r8, & + 1.696922_r8, 1.698329_r8, 1.699359_r8, 1.700099_r8, 1.700621_r8/ + data (bm2ji( 1,10,ibeta), ibeta = 1,10) / & + 1.694364_r8, 1.695010_r8, 1.696313_r8, 1.697676_r8, 1.698853_r8, & + 1.699782_r8, 1.700482_r8, 1.700996_r8, 1.701366_r8, 1.701631_r8/ + data (bm2ji( 2, 1,ibeta), ibeta = 1,10) / & + 0.783166_r8, 0.779369_r8, 0.768044_r8, 0.747572_r8, 0.716709_r8, & + 0.675422_r8, 0.624981_r8, 0.567811_r8, 0.507057_r8, 0.445975_r8/ + data (bm2ji( 2, 2,ibeta), ibeta = 1,10) / & + 0.848390_r8, 0.847100_r8, 0.840874_r8, 0.826065_r8, 0.800296_r8, & + 0.762625_r8, 0.713655_r8, 0.655545_r8, 0.591603_r8, 0.525571_r8/ + data (bm2ji( 2, 3,ibeta), ibeta = 1,10) / & + 1.039894_r8, 1.043786_r8, 1.049445_r8, 1.049664_r8, 1.039407_r8, & + 1.015322_r8, 0.975983_r8, 0.922180_r8, 0.856713_r8, 0.783634_r8/ + data (bm2ji( 2, 4,ibeta), ibeta = 1,10) / & + 1.345995_r8, 1.356064_r8, 1.376947_r8, 1.398304_r8, 1.412685_r8, & + 1.414611_r8, 1.400652_r8, 1.369595_r8, 1.322261_r8, 1.260993_r8/ + data (bm2ji( 2, 5,ibeta), ibeta = 1,10) / & + 1.675575_r8, 1.689859_r8, 1.720957_r8, 1.756659_r8, 1.788976_r8, & + 1.812679_r8, 1.824773_r8, 1.824024_r8, 1.810412_r8, 1.784630_r8/ + data (bm2ji( 2, 6,ibeta), ibeta = 1,10) / & + 1.919835_r8, 1.933483_r8, 1.962973_r8, 1.996810_r8, 2.028377_r8, & + 2.054172_r8, 2.072763_r8, 2.083963_r8, 2.088190_r8, 2.086052_r8/ + data (bm2ji( 2, 7,ibeta), ibeta = 1,10) / & + 2.064139_r8, 2.074105_r8, 2.095233_r8, 2.118909_r8, 2.140688_r8, & + 2.158661_r8, 2.172373_r8, 2.182087_r8, 2.188330_r8, 2.191650_r8/ + data (bm2ji( 2, 8,ibeta), ibeta = 1,10) / & + 2.144871_r8, 2.150990_r8, 2.163748_r8, 2.177731_r8, 2.190364_r8, & + 2.200712_r8, 2.208687_r8, 2.214563_r8, 2.218716_r8, 2.221502_r8/ + data (bm2ji( 2, 9,ibeta), ibeta = 1,10) / & + 2.189223_r8, 2.192595_r8, 2.199540_r8, 2.207033_r8, 2.213706_r8, & + 2.219125_r8, 2.223297_r8, 2.226403_r8, 2.228660_r8, 2.230265_r8/ + data (bm2ji( 2,10,ibeta), ibeta = 1,10) / & + 2.212595_r8, 2.214342_r8, 2.217912_r8, 2.221723_r8, 2.225082_r8, & + 2.227791_r8, 2.229869_r8, 2.231417_r8, 2.232551_r8, 2.233372_r8/ + data (bm2ji( 3, 1,ibeta), ibeta = 1,10) / & + 0.837870_r8, 0.824476_r8, 0.793119_r8, 0.750739_r8, 0.700950_r8, & + 0.646691_r8, 0.590508_r8, 0.534354_r8, 0.479532_r8, 0.426856_r8/ + data (bm2ji( 3, 2,ibeta), ibeta = 1,10) / & + 0.896771_r8, 0.885847_r8, 0.859327_r8, 0.821694_r8, 0.775312_r8, & + 0.722402_r8, 0.665196_r8, 0.605731_r8, 0.545742_r8, 0.486687_r8/ + data (bm2ji( 3, 3,ibeta), ibeta = 1,10) / & + 1.076089_r8, 1.071727_r8, 1.058845_r8, 1.036171_r8, 1.002539_r8, & + 0.957521_r8, 0.901640_r8, 0.836481_r8, 0.764597_r8, 0.689151_r8/ + data (bm2ji( 3, 4,ibeta), ibeta = 1,10) / & + 1.409571_r8, 1.415168_r8, 1.425346_r8, 1.432021_r8, 1.428632_r8, & + 1.409696_r8, 1.371485_r8, 1.312958_r8, 1.236092_r8, 1.145293_r8/ + data (bm2ji( 3, 5,ibeta), ibeta = 1,10) / & + 1.862757_r8, 1.880031_r8, 1.918394_r8, 1.963456_r8, 2.004070_r8, & + 2.030730_r8, 2.036144_r8, 2.016159_r8, 1.970059_r8, 1.900079_r8/ + data (bm2ji( 3, 6,ibeta), ibeta = 1,10) / & + 2.289741_r8, 2.313465_r8, 2.366789_r8, 2.431612_r8, 2.495597_r8, & + 2.549838_r8, 2.588523_r8, 2.608665_r8, 2.609488_r8, 2.591662_r8/ + data (bm2ji( 3, 7,ibeta), ibeta = 1,10) / & + 2.597157_r8, 2.618731_r8, 2.666255_r8, 2.722597_r8, 2.777531_r8, & + 2.825187_r8, 2.862794_r8, 2.889648_r8, 2.906199_r8, 2.913380_r8/ + data (bm2ji( 3, 8,ibeta), ibeta = 1,10) / & + 2.797975_r8, 2.813116_r8, 2.845666_r8, 2.882976_r8, 2.918289_r8, & + 2.948461_r8, 2.972524_r8, 2.990687_r8, 3.003664_r8, 3.012284_r8/ + data (bm2ji( 3, 9,ibeta), ibeta = 1,10) / & + 2.920832_r8, 2.929843_r8, 2.948848_r8, 2.970057_r8, 2.989632_r8, & + 3.006057_r8, 3.019067_r8, 3.028979_r8, 3.036307_r8, 3.041574_r8/ + data (bm2ji( 3,10,ibeta), ibeta = 1,10) / & + 2.989627_r8, 2.994491_r8, 3.004620_r8, 3.015720_r8, 3.025789_r8, & + 3.034121_r8, 3.040664_r8, 3.045641_r8, 3.049347_r8, 3.052066_r8/ + data (bm2ji( 4, 1,ibeta), ibeta = 1,10) / & + 0.893179_r8, 0.870897_r8, 0.820996_r8, 0.759486_r8, 0.695488_r8, & + 0.634582_r8, 0.579818_r8, 0.532143_r8, 0.490927_r8, 0.454618_r8/ + data (bm2ji( 4, 2,ibeta), ibeta = 1,10) / & + 0.948355_r8, 0.927427_r8, 0.880215_r8, 0.821146_r8, 0.758524_r8, & + 0.697680_r8, 0.641689_r8, 0.591605_r8, 0.546919_r8, 0.506208_r8/ + data (bm2ji( 4, 3,ibeta), ibeta = 1,10) / & + 1.109562_r8, 1.093648_r8, 1.056438_r8, 1.007310_r8, 0.951960_r8, & + 0.894453_r8, 0.837364_r8, 0.781742_r8, 0.727415_r8, 0.673614_r8/ + data (bm2ji( 4, 4,ibeta), ibeta = 1,10) / & + 1.423321_r8, 1.417557_r8, 1.402442_r8, 1.379079_r8, 1.347687_r8, & + 1.308075_r8, 1.259703_r8, 1.201983_r8, 1.134778_r8, 1.058878_r8/ + data (bm2ji( 4, 5,ibeta), ibeta = 1,10) / & + 1.933434_r8, 1.944347_r8, 1.968765_r8, 1.997653_r8, 2.023054_r8, & + 2.036554_r8, 2.029949_r8, 1.996982_r8, 1.934982_r8, 1.845473_r8/ + data (bm2ji( 4, 6,ibeta), ibeta = 1,10) / & + 2.547772_r8, 2.577105_r8, 2.645918_r8, 2.735407_r8, 2.830691_r8, & + 2.917268_r8, 2.981724_r8, 3.013684_r8, 3.007302_r8, 2.961560_r8/ + data (bm2ji( 4, 7,ibeta), ibeta = 1,10) / & + 3.101817_r8, 3.139271_r8, 3.225851_r8, 3.336402_r8, 3.453409_r8, & + 3.563116_r8, 3.655406_r8, 3.724014_r8, 3.766113_r8, 3.781394_r8/ + data (bm2ji( 4, 8,ibeta), ibeta = 1,10) / & + 3.540920_r8, 3.573780_r8, 3.647439_r8, 3.737365_r8, 3.828468_r8, & + 3.911436_r8, 3.981317_r8, 4.036345_r8, 4.076749_r8, 4.103751_r8/ + data (bm2ji( 4, 9,ibeta), ibeta = 1,10) / & + 3.856771_r8, 3.879363_r8, 3.928579_r8, 3.986207_r8, 4.042173_r8, & + 4.091411_r8, 4.132041_r8, 4.164052_r8, 4.188343_r8, 4.206118_r8/ + data (bm2ji( 4,10,ibeta), ibeta = 1,10) / & + 4.053923_r8, 4.067191_r8, 4.095509_r8, 4.127698_r8, 4.158037_r8, & + 4.184055_r8, 4.205135_r8, 4.221592_r8, 4.234115_r8, 4.243463_r8/ + data (bm2ji( 5, 1,ibeta), ibeta = 1,10) / & + 0.935846_r8, 0.906814_r8, 0.843358_r8, 0.768710_r8, 0.695885_r8, & + 0.631742_r8, 0.579166_r8, 0.538471_r8, 0.508410_r8, 0.486863_r8/ + data (bm2ji( 5, 2,ibeta), ibeta = 1,10) / & + 0.988308_r8, 0.959524_r8, 0.896482_r8, 0.821986_r8, 0.748887_r8, & + 0.684168_r8, 0.630908_r8, 0.589516_r8, 0.558676_r8, 0.536056_r8/ + data (bm2ji( 5, 3,ibeta), ibeta = 1,10) / & + 1.133795_r8, 1.107139_r8, 1.048168_r8, 0.977258_r8, 0.906341_r8, & + 0.842477_r8, 0.789093_r8, 0.746731_r8, 0.713822_r8, 0.687495_r8/ + data (bm2ji( 5, 4,ibeta), ibeta = 1,10) / & + 1.405692_r8, 1.385781_r8, 1.340706_r8, 1.284776_r8, 1.227085_r8, & + 1.173532_r8, 1.127008_r8, 1.087509_r8, 1.052712_r8, 1.018960_r8/ + data (bm2ji( 5, 5,ibeta), ibeta = 1,10) / & + 1.884992_r8, 1.879859_r8, 1.868463_r8, 1.854995_r8, 1.841946_r8, & + 1.829867_r8, 1.816972_r8, 1.799319_r8, 1.771754_r8, 1.729406_r8/ + data (bm2ji( 5, 6,ibeta), ibeta = 1,10) / & + 2.592275_r8, 2.612268_r8, 2.661698_r8, 2.731803_r8, 2.815139_r8, & + 2.901659_r8, 2.978389_r8, 3.031259_r8, 3.048045_r8, 3.021122_r8/ + data (bm2ji( 5, 7,ibeta), ibeta = 1,10) / & + 3.390321_r8, 3.435519_r8, 3.545615_r8, 3.698419_r8, 3.876958_r8, & + 4.062790_r8, 4.236125_r8, 4.378488_r8, 4.475619_r8, 4.519170_r8/ + data (bm2ji( 5, 8,ibeta), ibeta = 1,10) / & + 4.161376_r8, 4.216558_r8, 4.346896_r8, 4.519451_r8, 4.711107_r8, & + 4.902416_r8, 5.077701_r8, 5.226048_r8, 5.341423_r8, 5.421764_r8/ + data (bm2ji( 5, 9,ibeta), ibeta = 1,10) / & + 4.843961_r8, 4.892035_r8, 5.001492_r8, 5.138515_r8, 5.281684_r8, & + 5.416805_r8, 5.535493_r8, 5.634050_r8, 5.712063_r8, 5.770996_r8/ + data (bm2ji( 5,10,ibeta), ibeta = 1,10) / & + 5.352093_r8, 5.385119_r8, 5.458056_r8, 5.545311_r8, 5.632162_r8, & + 5.710566_r8, 5.777005_r8, 5.830863_r8, 5.873123_r8, 5.905442_r8/ + data (bm2ji( 6, 1,ibeta), ibeta = 1,10) / & + 0.964038_r8, 0.930794_r8, 0.859433_r8, 0.777776_r8, 0.700566_r8, & + 0.634671_r8, 0.582396_r8, 0.543656_r8, 0.517284_r8, 0.501694_r8/ + data (bm2ji( 6, 2,ibeta), ibeta = 1,10) / & + 1.013416_r8, 0.979685_r8, 0.907197_r8, 0.824135_r8, 0.745552_r8, & + 0.678616_r8, 0.625870_r8, 0.587348_r8, 0.561864_r8, 0.547674_r8/ + data (bm2ji( 6, 3,ibeta), ibeta = 1,10) / & + 1.145452_r8, 1.111457_r8, 1.038152_r8, 0.953750_r8, 0.873724_r8, & + 0.805955_r8, 0.753621_r8, 0.717052_r8, 0.694920_r8, 0.684910_r8/ + data (bm2ji( 6, 4,ibeta), ibeta = 1,10) / & + 1.376547_r8, 1.345004_r8, 1.276415_r8, 1.196704_r8, 1.121091_r8, & + 1.058249_r8, 1.012197_r8, 0.983522_r8, 0.970323_r8, 0.968933_r8/ + data (bm2ji( 6, 5,ibeta), ibeta = 1,10) / & + 1.778801_r8, 1.755897_r8, 1.706074_r8, 1.649008_r8, 1.597602_r8, & + 1.560087_r8, 1.540365_r8, 1.538205_r8, 1.549738_r8, 1.568333_r8/ + data (bm2ji( 6, 6,ibeta), ibeta = 1,10) / & + 2.447603_r8, 2.445172_r8, 2.443762_r8, 2.451842_r8, 2.475877_r8, & + 2.519039_r8, 2.580118_r8, 2.653004_r8, 2.727234_r8, 2.789738_r8/ + data (bm2ji( 6, 7,ibeta), ibeta = 1,10) / & + 3.368490_r8, 3.399821_r8, 3.481357_r8, 3.606716_r8, 3.772101_r8, & + 3.969416_r8, 4.184167_r8, 4.396163_r8, 4.582502_r8, 4.721838_r8/ + data (bm2ji( 6, 8,ibeta), ibeta = 1,10) / & + 4.426458_r8, 4.489861_r8, 4.648250_r8, 4.877510_r8, 5.160698_r8, & + 5.477495_r8, 5.803123_r8, 6.111250_r8, 6.378153_r8, 6.586050_r8/ + data (bm2ji( 6, 9,ibeta), ibeta = 1,10) / & + 5.568061_r8, 5.644988_r8, 5.829837_r8, 6.081532_r8, 6.371214_r8, & + 6.672902_r8, 6.963737_r8, 7.226172_r8, 7.449199_r8, 7.627886_r8/ + data (bm2ji( 6,10,ibeta), ibeta = 1,10) / & + 6.639152_r8, 6.707020_r8, 6.863974_r8, 7.065285_r8, 7.281744_r8, & + 7.492437_r8, 7.683587_r8, 7.847917_r8, 7.983296_r8, 8.090977_r8/ + data (bm2ji( 7, 1,ibeta), ibeta = 1,10) / & + 0.980853_r8, 0.945724_r8, 0.871244_r8, 0.787311_r8, 0.708818_r8, & + 0.641987_r8, 0.588462_r8, 0.547823_r8, 0.518976_r8, 0.500801_r8/ + data (bm2ji( 7, 2,ibeta), ibeta = 1,10) / & + 1.026738_r8, 0.990726_r8, 0.914306_r8, 0.828140_r8, 0.747637_r8, & + 0.679351_r8, 0.625127_r8, 0.584662_r8, 0.556910_r8, 0.540749_r8/ + data (bm2ji( 7, 3,ibeta), ibeta = 1,10) / & + 1.146496_r8, 1.108808_r8, 1.028695_r8, 0.938291_r8, 0.854101_r8, & + 0.783521_r8, 0.728985_r8, 0.690539_r8, 0.667272_r8, 0.657977_r8/ + data (bm2ji( 7, 4,ibeta), ibeta = 1,10) / & + 1.344846_r8, 1.306434_r8, 1.224543_r8, 1.132031_r8, 1.046571_r8, & + 0.976882_r8, 0.926488_r8, 0.896067_r8, 0.884808_r8, 0.891027_r8/ + data (bm2ji( 7, 5,ibeta), ibeta = 1,10) / & + 1.670227_r8, 1.634583_r8, 1.558421_r8, 1.472939_r8, 1.396496_r8, & + 1.339523_r8, 1.307151_r8, 1.300882_r8, 1.319622_r8, 1.360166_r8/ + data (bm2ji( 7, 6,ibeta), ibeta = 1,10) / & + 2.224548_r8, 2.199698_r8, 2.148284_r8, 2.095736_r8, 2.059319_r8, & + 2.050496_r8, 2.075654_r8, 2.136382_r8, 2.229641_r8, 2.347958_r8/ + data (bm2ji( 7, 7,ibeta), ibeta = 1,10) / & + 3.104483_r8, 3.105947_r8, 3.118398_r8, 3.155809_r8, 3.230427_r8, & + 3.350585_r8, 3.519071_r8, 3.731744_r8, 3.976847_r8, 4.235616_r8/ + data (bm2ji( 7, 8,ibeta), ibeta = 1,10) / & + 4.288426_r8, 4.331456_r8, 4.447024_r8, 4.633023_r8, 4.891991_r8, & + 5.221458_r8, 5.610060_r8, 6.036467_r8, 6.471113_r8, 6.880462_r8/ + data (bm2ji( 7, 9,ibeta), ibeta = 1,10) / & + 5.753934_r8, 5.837061_r8, 6.048530_r8, 6.363800_r8, 6.768061_r8, & + 7.241280_r8, 7.755346_r8, 8.276666_r8, 8.771411_r8, 9.210826_r8/ + data (bm2ji( 7,10,ibeta), ibeta = 1,10) / & + 7.466219_r8, 7.568810_r8, 7.819032_r8, 8.168340_r8, 8.582973_r8, & + 9.030174_r8, 9.478159_r8, 9.899834_r8, 10.275940_r8, 10.595910_r8/ + data (bm2ji( 8, 1,ibeta), ibeta = 1,10) / & + 0.990036_r8, 0.954782_r8, 0.880531_r8, 0.797334_r8, 0.719410_r8, & + 0.652220_r8, 0.596923_r8, 0.552910_r8, 0.519101_r8, 0.494529_r8/ + data (bm2ji( 8, 2,ibeta), ibeta = 1,10) / & + 1.032428_r8, 0.996125_r8, 0.919613_r8, 0.833853_r8, 0.753611_r8, & + 0.684644_r8, 0.628260_r8, 0.583924_r8, 0.550611_r8, 0.527407_r8/ + data (bm2ji( 8, 3,ibeta), ibeta = 1,10) / & + 1.141145_r8, 1.102521_r8, 1.021017_r8, 0.929667_r8, 0.844515_r8, & + 0.772075_r8, 0.714086_r8, 0.670280_r8, 0.639824_r8, 0.621970_r8/ + data (bm2ji( 8, 4,ibeta), ibeta = 1,10) / & + 1.314164_r8, 1.273087_r8, 1.186318_r8, 1.089208_r8, 0.999476_r8, & + 0.924856_r8, 0.867948_r8, 0.829085_r8, 0.807854_r8, 0.803759_r8/ + data (bm2ji( 8, 5,ibeta), ibeta = 1,10) / & + 1.580611_r8, 1.538518_r8, 1.449529_r8, 1.350459_r8, 1.260910_r8, & + 1.190526_r8, 1.143502_r8, 1.121328_r8, 1.124274_r8, 1.151974_r8/ + data (bm2ji( 8, 6,ibeta), ibeta = 1,10) / & + 2.016773_r8, 1.977721_r8, 1.895727_r8, 1.806974_r8, 1.732891_r8, & + 1.685937_r8, 1.673026_r8, 1.697656_r8, 1.761039_r8, 1.862391_r8/ + data (bm2ji( 8, 7,ibeta), ibeta = 1,10) / & + 2.750093_r8, 2.723940_r8, 2.672854_r8, 2.628264_r8, 2.612250_r8, & + 2.640406_r8, 2.723211_r8, 2.866599_r8, 3.071893_r8, 3.335217_r8/ + data (bm2ji( 8, 8,ibeta), ibeta = 1,10) / & + 3.881905_r8, 3.887143_r8, 3.913667_r8, 3.981912_r8, 4.111099_r8, & + 4.316575_r8, 4.608146_r8, 4.988157_r8, 5.449592_r8, 5.974848_r8/ + data (bm2ji( 8, 9,ibeta), ibeta = 1,10) / & + 5.438870_r8, 5.492742_r8, 5.640910_r8, 5.886999_r8, 6.241641_r8, & + 6.710609_r8, 7.289480_r8, 7.960725_r8, 8.693495_r8, 9.446644_r8/ + data (bm2ji( 8,10,ibeta), ibeta = 1,10) / & + 7.521152_r8, 7.624621_r8, 7.892039_r8, 8.300444_r8, 8.839787_r8, & + 9.493227_r8, 10.231770_r8, 11.015642_r8, 11.799990_r8, 12.542260_r8/ + data (bm2ji( 9, 1,ibeta), ibeta = 1,10) / & + 0.994285_r8, 0.960012_r8, 0.887939_r8, 0.807040_r8, 0.730578_r8, & + 0.663410_r8, 0.606466_r8, 0.559137_r8, 0.520426_r8, 0.489429_r8/ + data (bm2ji( 9, 2,ibeta), ibeta = 1,10) / & + 1.033505_r8, 0.998153_r8, 0.923772_r8, 0.840261_r8, 0.761383_r8, & + 0.692242_r8, 0.633873_r8, 0.585709_r8, 0.546777_r8, 0.516215_r8/ + data (bm2ji( 9, 3,ibeta), ibeta = 1,10) / & + 1.132774_r8, 1.094907_r8, 1.015161_r8, 0.925627_r8, 0.841293_r8, & + 0.767888_r8, 0.706741_r8, 0.657439_r8, 0.619135_r8, 0.591119_r8/ + data (bm2ji( 9, 4,ibeta), ibeta = 1,10) / & + 1.286308_r8, 1.245273_r8, 1.158809_r8, 1.061889_r8, 0.971208_r8, & + 0.893476_r8, 0.830599_r8, 0.782561_r8, 0.748870_r8, 0.729198_r8/ + data (bm2ji( 9, 5,ibeta), ibeta = 1,10) / & + 1.511105_r8, 1.467141_r8, 1.374520_r8, 1.271162_r8, 1.175871_r8, & + 1.096887_r8, 1.037243_r8, 0.997820_r8, 0.978924_r8, 0.980962_r8/ + data (bm2ji( 9, 6,ibeta), ibeta = 1,10) / & + 1.857468_r8, 1.812177_r8, 1.717002_r8, 1.612197_r8, 1.519171_r8, & + 1.448660_r8, 1.405871_r8, 1.393541_r8, 1.413549_r8, 1.467532_r8/ + data (bm2ji( 9, 7,ibeta), ibeta = 1,10) / & + 2.430619_r8, 2.388452_r8, 2.301326_r8, 2.210241_r8, 2.139724_r8, & + 2.104571_r8, 2.114085_r8, 2.174696_r8, 2.291294_r8, 2.467500_r8/ + data (bm2ji( 9, 8,ibeta), ibeta = 1,10) / & + 3.385332_r8, 3.357690_r8, 3.306611_r8, 3.269804_r8, 3.274462_r8, & + 3.340862_r8, 3.484609_r8, 3.717740_r8, 4.048748_r8, 4.481588_r8/ + data (bm2ji( 9, 9,ibeta), ibeta = 1,10) / & + 4.850497_r8, 4.858280_r8, 4.896008_r8, 4.991467_r8, 5.171511_r8, & + 5.459421_r8, 5.873700_r8, 6.426128_r8, 7.119061_r8, 7.942603_r8/ + data (bm2ji( 9,10,ibeta), ibeta = 1,10) / & + 6.957098_r8, 7.020164_r8, 7.197272_r8, 7.499331_r8, 7.946554_r8, & + 8.555048_r8, 9.330503_r8, 10.263610_r8, 11.327454_r8, 12.478332_r8/ + data (bm2ji(10, 1,ibeta), ibeta = 1,10) / & + 0.994567_r8, 0.961842_r8, 0.892854_r8, 0.814874_r8, 0.740198_r8, & + 0.673303_r8, 0.615105_r8, 0.565139_r8, 0.522558_r8, 0.486556_r8/ + data (bm2ji(10, 2,ibeta), ibeta = 1,10) / & + 1.031058_r8, 0.997292_r8, 0.926082_r8, 0.845571_r8, 0.768501_r8, & + 0.699549_r8, 0.639710_r8, 0.588538_r8, 0.545197_r8, 0.508894_r8/ + data (bm2ji(10, 3,ibeta), ibeta = 1,10) / & + 1.122535_r8, 1.086287_r8, 1.009790_r8, 0.923292_r8, 0.840626_r8, & + 0.766982_r8, 0.703562_r8, 0.650004_r8, 0.605525_r8, 0.569411_r8/ + data (bm2ji(10, 4,ibeta), ibeta = 1,10) / & + 1.261142_r8, 1.221555_r8, 1.137979_r8, 1.043576_r8, 0.953745_r8, & + 0.874456_r8, 0.807292_r8, 0.752109_r8, 0.708326_r8, 0.675477_r8/ + data (bm2ji(10, 5,ibeta), ibeta = 1,10) / & + 1.456711_r8, 1.413432_r8, 1.322096_r8, 1.219264_r8, 1.122319_r8, & + 1.038381_r8, 0.969743_r8, 0.916811_r8, 0.879544_r8, 0.858099_r8/ + data (bm2ji(10, 6,ibeta), ibeta = 1,10) / & + 1.741792_r8, 1.695157_r8, 1.596897_r8, 1.487124_r8, 1.385734_r8, & + 1.301670_r8, 1.238638_r8, 1.198284_r8, 1.181809_r8, 1.190689_r8/ + data (bm2ji(10, 7,ibeta), ibeta = 1,10) / & + 2.190197_r8, 2.141721_r8, 2.040226_r8, 1.929245_r8, 1.832051_r8, & + 1.760702_r8, 1.721723_r8, 1.719436_r8, 1.757705_r8, 1.840677_r8/ + data (bm2ji(10, 8,ibeta), ibeta = 1,10) / & + 2.940764_r8, 2.895085_r8, 2.801873_r8, 2.707112_r8, 2.638603_r8, & + 2.613764_r8, 2.644686_r8, 2.741255_r8, 2.912790_r8, 3.168519_r8/ + data (bm2ji(10, 9,ibeta), ibeta = 1,10) / & + 4.186191_r8, 4.155844_r8, 4.101953_r8, 4.069102_r8, 4.089886_r8, & + 4.189530_r8, 4.389145_r8, 4.707528_r8, 5.161567_r8, 5.765283_r8/ + data (bm2ji(10,10,ibeta), ibeta = 1,10) / & + 6.119526_r8, 6.127611_r8, 6.171174_r8, 6.286528_r8, 6.508738_r8, & + 6.869521_r8, 7.396912_r8, 8.113749_r8, 9.034683_r8, 10.162190_r8/ + +! *** end of data statements. + + +! *** start calculations: + + constii = abs( half * ( two ) ** two3rds - one ) + sqrttwo = sqrt(two) + dlgsqt2 = one / log( sqrttwo ) + + esat01 = exp( 0.125_r8 * xxlsgat * xxlsgat ) + esac01 = exp( 0.125_r8 * xxlsgac * xxlsgac ) + + esat04 = esat01 ** 4 + esac04 = esac01 ** 4 + + esat05 = esat04 * esat01 + esac05 = esac04 * esac01 + + esat08 = esat04 * esat04 + esac08 = esac04 * esac04 + + esat09 = esat08 * esat01 + esac09 = esac08 * esac01 + + esat16 = esat08 * esat08 + esac16 = esac08 * esac08 + + esat20 = esat16 * esat04 + esac20 = esac16 * esac04 + + esat24 = esat20 * esat04 + esac24 = esac20 * esac04 + + esat25 = esat20 * esat05 + esac25 = esac20 * esac05 + + esat36 = esat20 * esat16 + esac36 = esac20 * esac16 + + esat49 = esat24 * esat25 + + esat64 = esat20 * esat20 * esat24 + esac64 = esac20 * esac20 * esac24 + + esat100 = esat64 * esat36 + + dgat2 = dgatk * dgatk + dgat3 = dgatk * dgatk * dgatk + dgac2 = dgacc * dgacc + dgac3 = dgacc * dgacc * dgacc + + sqdgat = sqrt( dgatk ) + sqdgac = sqrt( dgacc ) + sqdgat5 = dgat2 * sqdgat + sqdgac5 = dgac2 * sqdgac + sqdgat7 = dgat3 * sqdgat + + xm2at = dgat2 * esat16 + xm3at = dgat3 * esat36 + + xm2ac = dgac2 * esac16 + xm3ac = dgac3 * esac36 + +! *** for the free molecular regime: page h.3 of whitby et al. (1991) + + r = sqdgac / sqdgat + r2 = r * r + r3 = r2 * r + rx4 = r2 * r2 + r5 = r3 * r2 + r6 = r3 * r3 + rx8 = rx4 * rx4 + ri1 = one / r + ri2 = one / r2 + ri3 = one / r3 + ri4 = ri2 * ri2 + kngat = two * lamda / dgatk + kngac = two * lamda / dgacc + + +! *** calculate ratio of geometric mean diameters + rat = dgacc / dgatk +! *** trap subscripts for bm0 and bm0i, between 1 and 10 +! see page h.5 of whitby et al. (1991) + + n2n = max( 1, min( 10, & + nint( 4.0_r8 * ( sgatk - 0.75_r8 ) ) ) ) + + n2a = max( 1, min( 10, & + nint( 4.0_r8 * ( sgacc - 0.75_r8 ) ) ) ) + + n1 = max( 1, min( 10, & + 1 + nint( dlgsqt2 * log( rat ) ) ) ) + +! *** intermodal coagulation + + +! *** set up for zeroeth moment + +! *** near-continuum form: equation h.10a of whitby et al. (1991) + + coagnc0 = knc * ( & + two + a * ( kngat * ( esat04 + r2 * esat16 * esac04 ) & + + kngac * ( esac04 + ri2 * esac16 * esat04 ) ) & + + ( r2 + ri2 ) * esat04 * esac04 ) + + +! *** free-molecular form: equation h.7a of whitby et al. (1991) + + coagfm0 = kfmatac * sqdgat * bm0ij(n1,n2n,n2a) * ( & + esat01 + r * esac01 + two * r2 * esat01 * esac04 & + + rx4 * esat09 * esac16 + ri3 * esat16 * esac09 & + + two * ri1 * esat04 + esac01 ) + + +! *** loss to accumulation mode + +! *** harmonic mean + + coagatac0 = coagnc0 * coagfm0 / ( coagnc0 + coagfm0 ) + + qn12 = coagatac0 + + +! *** set up for second moment +! the second moment equations are new and begin with equations a1 +! through a4 of binkowski and shankar (1995). after some algebraic +! rearrangement and application of the extended mean value theorem +! of integral calculus, equations are obtained that can be solved +! analytically with correction factors as has been done by +! whitby et al. (1991) + +! *** the term ( dp1 + dp2 ) ** (2/3) in equations a3 and a4 of +! binkowski and shankar (1995) is approximated by +! (dgat ** 3 + dgac **3 ) ** 2/3 + +! *** near-continuum form + + i1nc = knc * dgat2 * ( & + two * esat16 & + + r2 * esat04 * esac04 & + + ri2 * esat36 * esac04 & + + a * kngat * ( & + esat04 & + + ri2 * esat16 * esac04 & + + ri4 * esat36 * esac16 & + + r2 * esac04 ) ) + + + + +! *** free-molecular form + + i1fm = kfmatac * sqdgat5 * bm2ij(n1,n2n,n2a) * ( & + esat25 & + + two * r2 * esat09 * esac04 & + + rx4 * esat01 * esac16 & + + ri3 * esat64 * esac09 & + + two * ri1 * esat36 * esac01 & + + r * esat16 * esac01 ) + + + +! *** loss to accumulation mode + +! *** harmonic mean + + i1 = ( i1fm * i1nc ) / ( i1fm + i1nc ) + + coagatac2 = i1 + + qs12 = coagatac2 + + +! *** gain by accumulation mode + + coagacat2 = ( ( one + r6 ) ** two3rds - rx4 ) * i1 + + qs21 = coagacat2 * bm2ji(n1,n2n,n2a) + +! *** set up for third moment + +! *** near-continuum form: equation h.10b of whitby et al. (1991) + + coagnc3 = knc * dgat3 * ( & + two * esat36 & + + a * kngat * ( esat16 + r2 * esat04 * esac04 ) & + + a * kngac * ( esat36 * esac04 + ri2 * esat64 * esac16 ) & + + r2 * esat16 * esac04 + ri2 * esat64 * esac04 ) + + +! *** free_molecular form: equation h.7b of whitby et al. (1991) + + coagfm3 = kfmatac * sqdgat7 * bm3i( n1, n2n, n2a ) * ( & + esat49 & + + r * esat36 * esac01 & + + two * r2 * esat25 * esac04 & + + rx4 * esat09 * esac16 & + + ri3 * esat100 * esac09 & + + two * ri1 * esat64 * esac01 ) + +! *** gain by accumulation mode = loss from aitken mode + +! *** harmonic mean + + coagatac3 = coagnc3 * coagfm3 / ( coagnc3 + coagfm3 ) + + qv12 = coagatac3 + +! *** intramodal coagulation + +! *** zeroeth moment + +! *** aitken mode + +! *** near-continuum form: equation h.12a of whitby et al. (1991) + + coagnc_at = knc * (one + esat08 + a * kngat * (esat20 + esat04)) + +! *** free-molecular form: equation h.11a of whitby et al. (1991) + + coagfm_at = kfmat * sqdgat * bm0(n2n) * & + ( esat01 + esat25 + two * esat05 ) + + +! *** harmonic mean + + coagatat0 = coagfm_at * coagnc_at / ( coagfm_at + coagnc_at ) + + qn11 = coagatat0 + + +! *** accumulation mode + +! *** near-continuum form: equation h.12a of whitby et al. (1991) + + coagnc_ac = knc * (one + esac08 + a * kngac * (esac20 + esac04)) + +! *** free-molecular form: equation h.11a of whitby et al. (1991) + + coagfm_ac = kfmac * sqdgac * bm0(n2a) * & + ( esac01 + esac25 + two * esac05 ) + +! *** harmonic mean + + coagacac0 = coagfm_ac * coagnc_ac / ( coagfm_ac + coagnc_ac ) + + qn22 = coagacac0 + + +! *** set up for second moment +! the second moment equations are new and begin with 3.11a on page +! 45 of whitby et al. (1991). after some algebraic rearrangement and +! application of the extended mean value theorem of integral calculus +! equations are obtained that can be solved analytically with +! correction factors as has been done by whitby et al. (1991) + +! *** aitken mode + +! *** near-continuum + + i1nc_at = knc * dgat2 * ( & + two * esat16 & + + esat04 * esat04 & + + esat36 * esat04 & + + a * kngat * ( & + two * esat04 & + + esat16 * esat04 & + + esat36 * esat16 ) ) + +! *** free- molecular form + + i1fm_at = kfmat * sqdgat5 * bm2ii(n2n) * ( & + esat25 & + + two * esat09 * esat04 & + + esat01 * esat16 & + + esat64 * esat09 & + + two * esat36 * esat01 & + + esat16 * esat01 ) + + i1_at = ( i1nc_at * i1fm_at ) / ( i1nc_at + i1fm_at ) + + coagatat2 = constii * i1_at + + qs11 = coagatat2 * bm2iitt(n2n) + +! *** accumulation mode + +! *** near-continuum + + i1nc_ac = knc * dgac2 * ( & + two * esac16 & + + esac04 * esac04 & + + esac36 * esac04 & + + a * kngac * ( & + two * esac04 & + + esac16 * esac04 & + + esac36 * esac16 ) ) + +! *** free- molecular form + + i1fm_ac = kfmac * sqdgac5 * bm2ii(n2a) * ( & + esac25 & + + two * esac09 * esac04 & + + esac01 * esac16 & + + esac64 * esac09 & + + two * esac36 * esac01 & + + esac16 * esac01 ) + + i1_ac = ( i1nc_ac * i1fm_ac ) / ( i1nc_ac + i1fm_ac ) + + coagacac2 = constii * i1_ac + + qs22 = coagacac2 * bm2iitt(n2a) + + + return + + end subroutine getcoags + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- + + end module modal_aero_coag + + + diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 new file mode 100644 index 0000000000..a335f2eddf --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_convproc.F90 @@ -0,0 +1,2866 @@ + +module modal_aero_convproc +!--------------------------------------------------------------------------------- +! Purpose: +! +! CAM interface to aerosol/trace-gas convective cloud processing scheme +! +! currently these routines assume stratiform and convective clouds only interact +! through the detrainment of convective cloudborne material into stratiform clouds +! +! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed +! by the convective up/downdrafts, but are affected by the detrainment +! +! Author: R. C. Easter +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use physconst, only: gravit, rair +use ppgrid, only: pver, pcols, pverp +use constituents, only: pcnst, cnst_name +use phys_control, only: phys_getopts + +use physics_types, only: physics_state, physics_ptend, physics_ptend_init +use physics_buffer, only: pbuf_add_field, physics_buffer_desc, pbuf_get_index, pbuf_get_field + +use time_manager, only: get_nstep +use cam_history, only: outfld, addfld, add_default, horiz_only +use cam_logfile, only: iulog +use error_messages, only: alloc_err +use cam_abortutils, only: endrun + +use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode +use constituents, only: cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas + +implicit none +private +save + +public :: & + ma_convproc_register, &! + ma_convproc_init, &! + ma_convproc_intr ! + +logical, parameter, public :: convproc_do_gas = .false. +logical, parameter, public :: deepconv_wetdep_history = .true. + +logical, parameter :: use_cwaer_for_activate_maxsat = .false. +logical, parameter :: apply_convproc_tend_to_ptend = .true. + +real(r8) :: hund_ovr_g ! = 100.0_r8/gravit +! used with zm_conv mass fluxes and delta-p +! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] +! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + +! method1_activate_nlayers = number of layers (including cloud base) where activation is applied +integer, parameter :: method1_activate_nlayers = 2 +! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01) +real(r8), parameter :: method2_activate_smaxmax = 0.003_r8 + +! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 but not for ... = 2) +! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 or 2) +! = other -- do nothing involving reduce_actfrac +integer, parameter :: method_reduce_actfrac = 0 +real(r8), parameter :: factor_reduce_actfrac = 0.5_r8 + +! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers +! 2=do secondary activation with prescribed supersat +integer, parameter :: convproc_method_activate = 2 + +logical :: convproc_do_aer + +! physics buffer indices +integer :: fracis_idx = 0 + +integer :: rprddp_idx = 0 +integer :: rprdsh_idx = 0 +integer :: nevapr_shcu_idx = 0 +integer :: nevapr_dpcu_idx = 0 + +integer :: icwmrdp_idx = 0 +integer :: icwmrsh_idx = 0 +integer :: sh_frac_idx = 0 +integer :: dp_frac_idx = 0 + +integer :: zm_mu_idx = 0 +integer :: zm_eu_idx = 0 +integer :: zm_du_idx = 0 +integer :: zm_md_idx = 0 +integer :: zm_ed_idx = 0 +integer :: zm_dp_idx = 0 +integer :: zm_dsubcld_idx = 0 +integer :: zm_jt_idx = 0 +integer :: zm_maxg_idx = 0 +integer :: zm_ideep_idx = 0 + +integer :: cmfmc_sh_idx = 0 +integer :: sh_e_ed_ratio_idx = 0 + +!========================================================================================= +contains +!========================================================================================= + +subroutine ma_convproc_register + +end subroutine ma_convproc_register + +!========================================================================================= + +subroutine ma_convproc_init + + integer :: n, l, ll + integer :: npass_calc_updraft + logical :: history_aerosol + + call phys_getopts( history_aerosol_out=history_aerosol, & + convproc_do_aer_out = convproc_do_aer ) + + call addfld('SH_MFUP_MAX', horiz_only, 'A', 'kg/m2', & + 'Shallow conv. column-max updraft mass flux' ) + call addfld('SH_WCLDBASE', horiz_only, 'A', 'm/s', & + 'Shallow conv. cloudbase vertical velocity' ) + call addfld('SH_KCLDBASE', horiz_only, 'A', '1', & + 'Shallow conv. cloudbase level index' ) + + call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', & + 'Deep conv. column-max updraft mass flux' ) + call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', & + 'Deep conv. cloudbase vertical velocity' ) + call addfld('DP_KCLDBASE', horiz_only, 'A', '1', & + 'Deep conv. cloudbase level index' ) + + ! output wet deposition fields to history + ! I = in-cloud removal; E = precip-evap resuspension + ! C = convective (total); D = deep convective + ! note that the precip-evap resuspension includes that resulting from + ! below-cloud removal, calculated in mz_aero_wet_intr + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + l = numptr_amode(n) + else + l = lmassptr_amode(ll,n) + end if + + call addfld (trim(cnst_name(l))//'SFSEC', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') + if (history_aerosol) then + call add_default(trim(cnst_name(l))//'SFSEC', 1, ' ') + end if + + if ( deepconv_wetdep_history ) then + call addfld (trim(cnst_name(l))//'SFSID', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface') + call addfld (trim(cnst_name(l))//'SFSED', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface') + if (history_aerosol) then + call add_default(trim(cnst_name(l))//'SFSID', 1, ' ') + call add_default(trim(cnst_name(l))//'SFSED', 1, ' ') + end if + end if + end do + end do + end if + + if ( history_aerosol .and. & + ( convproc_do_aer .or. convproc_do_gas) ) then + call add_default( 'SH_MFUP_MAX', 1, ' ' ) + call add_default( 'SH_WCLDBASE', 1, ' ' ) + call add_default( 'SH_KCLDBASE', 1, ' ' ) + call add_default( 'DP_MFUP_MAX', 1, ' ' ) + call add_default( 'DP_WCLDBASE', 1, ' ' ) + call add_default( 'DP_KCLDBASE', 1, ' ' ) + end if + + fracis_idx = pbuf_get_index('FRACIS') + + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + + icwmrdp_idx = pbuf_get_index('ICWMRDP') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + dp_frac_idx = pbuf_get_index('DP_FRAC') + sh_frac_idx = pbuf_get_index('SH_FRAC') + + zm_mu_idx = pbuf_get_index('ZM_MU') + zm_eu_idx = pbuf_get_index('ZM_EU') + zm_du_idx = pbuf_get_index('ZM_DU') + zm_md_idx = pbuf_get_index('ZM_MD') + zm_ed_idx = pbuf_get_index('ZM_ED') + zm_dp_idx = pbuf_get_index('ZM_DP') + zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD') + zm_jt_idx = pbuf_get_index('ZM_JT') + zm_maxg_idx = pbuf_get_index('ZM_MAXG') + zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO') + + if (masterproc ) then + + write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_aer = ', & + convproc_do_aer + write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_gas = ', & + convproc_do_gas + write(iulog,'(a,l12)') 'ma_convproc_init - use_cwaer_for_activate_maxsat = ', & + use_cwaer_for_activate_maxsat + write(iulog,'(a,l12)') 'ma_convproc_init - apply_convproc_tend_to_ptend = ', & + apply_convproc_tend_to_ptend + write(iulog,'(a,i12)') 'ma_convproc_init - convproc_method_activate = ', & + convproc_method_activate + write(iulog,'(a,i12)') 'ma_convproc_init - method1_activate_nlayers = ', & + method1_activate_nlayers + write(iulog,'(a,1pe12.4)') 'ma_convproc_init - method2_activate_smaxmax = ', & + method2_activate_smaxmax + write(iulog,'(a,i12)') 'ma_convproc_init - method_reduce_actfrac = ', & + method_reduce_actfrac + write(iulog,'(a,1pe12.4)') 'ma_convproc_init - factor_reduce_actfrac = ', & + factor_reduce_actfrac + + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + write(iulog,'(a,i12)') 'ma_convproc_init - npass_calc_updraft = ', & + npass_calc_updraft + + end if + +end subroutine ma_convproc_init + +!========================================================================================= + +subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, & + aerdepwetis) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! Does trace gases when convproc_do_gas is .true. +! +! Does deep and shallow convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + + ! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + integer, intent(in) :: nsrflx_mzaer2cnvpr + real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) + real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + + ! Local variables + integer, parameter :: nsrflx = 5 ! last dimension of qsrflx + integer :: l, ll, lchnk + integer :: n, ncol + + real(r8) :: dpdry(pcols,pver) + real(r8) :: dqdt(pcols,pver,pcnst) + real(r8) :: dt + real(r8) :: qa(pcols,pver,pcnst), qb(pcols,pver,pcnst) + real(r8) :: qsrflx(pcols,pcnst,nsrflx) + real(r8) :: sflxic(pcols,pcnst) + real(r8) :: sflxid(pcols,pcnst) + real(r8) :: sflxec(pcols,pcnst) + real(r8) :: sflxed(pcols,pcnst) + + logical :: dotend(pcnst) + !------------------------------------------------------------------------------------------------- + + ! Initialize + lchnk = state%lchnk + ncol = state%ncol + dt = ztodt + + hund_ovr_g = 100.0_r8/gravit + ! used with zm_conv mass fluxes and delta-p + ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] + ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + + sflxic(:,:) = 0.0_r8 + sflxid(:,:) = 0.0_r8 + sflxec(:,:) = 0.0_r8 + sflxed(:,:) = 0.0_r8 + do l = 1, pcnst + if ( (cnst_species_class(l) == cnst_spec_class_aerosol) .and. ptend%lq(l) ) then + sflxec(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,1) + sflxed(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,2) + end if + end do + + ! prepare for deep conv processing + do l = 1, pcnst + if ( ptend%lq(l) ) then + ! calc new q (after calcaersize and mz_aero_wet_intr) + qa(1:ncol,:,l) = state%q(1:ncol,:,l) + dt*ptend%q(1:ncol,:,l) + qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) + else + ! use old q + qb(1:ncol,:,l) = state%q(1:ncol,:,l) + end if + end do + dqdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + + if (convproc_do_aer .or. convproc_do_gas) then + + ! do deep conv processing + + call ma_convproc_dp_intr( & + state, pbuf, dt, & + qb, dqdt, dotend, nsrflx, qsrflx) + + + ! apply deep conv processing tendency and prepare for shallow conv processing + do l = 1, pcnst + if ( .not. dotend(l) ) cycle + + ! calc new q (after ma_convproc_dp_intr) + qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) + qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) + + if ( apply_convproc_tend_to_ptend ) then + ! add dqdt onto ptend%q and set ptend%lq + ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) + ptend%lq(l) = .true. + end if + + if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(l) == cnst_spec_class_gas )) then + ! these used for history file wetdep diagnostics + sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) + sflxid(1:ncol,l) = sflxid(1:ncol,l) + qsrflx(1:ncol,l,4) + sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) + sflxed(1:ncol,l) = sflxed(1:ncol,l) + qsrflx(1:ncol,l,5) + end if + + if (cnst_species_class(l) == cnst_spec_class_aerosol) then + ! this used for surface coupling + aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & + + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) + end if + + end do + + dqdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + + call ma_convproc_sh_intr( & + state, pbuf, dt, & + qb, dqdt, dotend, nsrflx, qsrflx) + + ! apply shallow conv processing tendency + do l = 1, pcnst + if ( .not. dotend(l) ) cycle + + ! calc new q (after ma_convproc_sh_intr) + qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) + qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) + + if ( apply_convproc_tend_to_ptend ) then + ! add dqdt onto ptend%q and set ptend%lq + ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) + ptend%lq(l) = .true. + end if + + if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(l) == cnst_spec_class_gas )) then + sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) + sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) + end if + + if (cnst_species_class(l) == cnst_spec_class_aerosol) then + aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & + + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) + end if + + end do + + end if ! (convproc_do_aer .or. convproc_do_gas) then + + + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + l = numptr_amode(n) + else + l = lmassptr_amode(ll,n) + end if + + call outfld( trim(cnst_name(l))//'SFWET', aerdepwetis(:,l), pcols, lchnk ) + call outfld( trim(cnst_name(l))//'SFSIC', sflxic(:,l), pcols, lchnk ) + call outfld( trim(cnst_name(l))//'SFSEC', sflxec(:,l), pcols, lchnk ) + + if ( deepconv_wetdep_history ) then + call outfld( trim(cnst_name(l))//'SFSID', sflxid(:,l), pcols, lchnk ) + call outfld( trim(cnst_name(l))//'SFSED', sflxed(:,l), pcols, lchnk ) + end if + end do + end do + end if + +end subroutine ma_convproc_intr + +!========================================================================================= + +subroutine ma_convproc_dp_intr( & + state, pbuf, dt, & + q, dqdt, dotend, nsrflx, qsrflx) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! Does trace gases when convproc_do_gas is .true. +! +! This routine does deep convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + + ! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dt ! delta t (model time increment) + + real(r8), intent(in) :: q(pcols,pver,pcnst) + real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) + logical, intent(out) :: dotend(pcnst) + integer, intent(in) :: nsrflx + real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) + + integer :: i + integer :: itmpveca(pcols) + integer :: l, lchnk, lun + integer :: nstep + + real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) + real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + real(r8) :: qaa(pcols,pver,pcnst), qbb(pcols,pver,pcnst) + real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) + + ! physics buffer fields + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) + real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) + real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud) + real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1) + ! mu, md, ..., ideep, lengath are all deep conv variables + real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver) + real(r8), pointer :: md(:,:) ! Downdraft mass flux (negative) (pcols,pver) + real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) + real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) + real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) + ! eu, ed, du are "d(massflux)/dp" and are all positive + real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver) + real(r8), pointer :: dsubcld(:) ! Delta pressure from cloud base to sfc (pcols) + + integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) + integer, pointer :: maxg(:) ! Index of cloud top for each column (pcols) + integer, pointer :: ideep(:) ! Gathering array (pcols) + integer :: lengath ! Gathered min lon indices over which to operate + + + ! Initialize + + lchnk = state%lchnk + nstep = get_nstep() + lun = iulog + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, rprddp_idx, rprddp) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) + call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp) + call pbuf_get_field(pbuf, dp_frac_idx, dp_frac) + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + lengath = count(ideep > 0) + + fracice(:,:) = 0.0_r8 + + ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type + dpdry = 0._r8 + do i = 1, lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + end do + + qaa = q + + ! turn on/off calculations for aerosols and trace gases + do l = 1, pcnst + dotend(l) = .false. + if (cnst_species_class(l) == cnst_spec_class_aerosol) then + if (convproc_do_aer) dotend(l) = .true. + else if (cnst_species_class(l) == cnst_spec_class_gas) then + if (convproc_do_gas) dotend(l) = .true. + end if + end do + + itmpveca(:) = -1 + + call ma_convproc_tend( & + 'deep', & + lchnk, pcnst, nstep, dt, & + state%t, state%pmid, state%pdel, qaa, & + mu, md, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + dp_frac, icwmrdp, rprddp, evapcdp, & + fracice, & + dqdt, dotend, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + lun, itmpveca ) + + call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) + call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) + call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk ) + +end subroutine ma_convproc_dp_intr + + + +!========================================================================================= +subroutine ma_convproc_sh_intr( & + state, pbuf, dt, & + q, dqdt, dotend, nsrflx, qsrflx) +!----------------------------------------------------------------------- +! +! Purpose: +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! Does trace gases when convproc_do_gas is .true. +! +! This routine does shallow convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dt ! delta t (model time increment) + + real(r8), intent(in) :: q(pcols,pver,pcnst) + real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) + logical, intent(out) :: dotend(pcnst) + integer, intent(in) :: nsrflx + real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) + + integer :: i + integer :: itmpveca(pcols) + integer :: k, kaa, kbb, kcc, kk + integer :: l, lchnk, lun + integer :: maxg_minval + integer :: ncol, nstep + + real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) + real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + real(r8) :: qaa(pcols,pver,pcnst) + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf + real(r8) :: tmpveca(300), tmpvecb(300), tmpvecc(300) + real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) + + ! variables that mimic the zm-deep counterparts + real(r8) :: mu(pcols,pver) ! Updraft mass flux (positive) + real(r8) :: md(pcols,pver) ! Downdraft mass flux (negative) + real(r8) :: du(pcols,pver) ! Mass detrain rate from updraft + real(r8) :: eu(pcols,pver) ! Mass entrain rate into updraft + real(r8) :: ed(pcols,pver) ! Mass entrain rate into downdraft + ! eu, ed, du are "d(massflux)/dp" and are all positive + real(r8) :: dp(pcols,pver) ! Delta pressure between interfaces + + integer :: jt(pcols) ! Index of cloud top for each column + integer :: maxg(pcols) ! Index of cloud bot for each column + integer :: ideep(pcols) ! Gathering array + integer :: lengath ! Gathered min lon indices over which to operate + + ! physics buffer fields + real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (kg/kg/s - grid avg) + real(r8), pointer :: evapcsh(:,:) ! Shal conv precip evaporation (kg/kg/s - grid avg) + real(r8), pointer :: icwmrsh(:,:) ! Shal conv cloud condensate (kg/kg - in cloud) + real(r8), pointer :: sh_frac(:,:) ! Shal conv cloud frac (0-1) + + real(r8), pointer :: cmfmcsh(:,:) ! Shallow conv mass flux (pcols,pverp) (kg/m2/s) + real(r8), pointer :: sh_e_ed_ratio(:,:) ! shallow conv [ent/(ent+det)] ratio (pcols,pver) + + ! Initialize + + lchnk = state%lchnk + ncol = state%ncol + nstep = get_nstep() + lun = iulog + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh) + call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh) + call pbuf_get_field(pbuf, sh_frac_idx, sh_frac) + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmcsh) + call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) + + + fracice(:,:) = 0.0_r8 + + ! create mass flux, entrainment, detrainment, and delta-p arrays + ! with same units as the zm-deep + mu(:,:) = 0.0_r8 + md(:,:) = 0.0_r8 + du(:,:) = 0.0_r8 + eu(:,:) = 0.0_r8 + ed(:,:) = 0.0_r8 + jt(:) = -1 + maxg(:) = -1 + ideep(:) = -1 + lengath = ncol + maxg_minval = pver*2 + + ! these dp and dpdry have units of mb + dpdry(1:ncol,:) = state%pdeldry(1:ncol,:)/100._r8 + dp( 1:ncol,:) = state%pdel( 1:ncol,:)/100._r8 + + do i = 1, ncol + ideep(i) = i + + ! load updraft mass flux from cmfmcsh + kk = 0 + do k = 2, pver + ! if mass-flux < 1e-7 kg/m2/s ~= 1e-7 m/s ~= 1 cm/day, treat as zero + if (cmfmcsh(i,k) >= 1.0e-7_r8) then + ! mu has units of mb/s + mu(i,k) = cmfmcsh(i,k) / hund_ovr_g + kk = kk + 1 + if (kk == 1) jt(i) = k - 1 + maxg(i) = k + end if + end do + if (kk <= 0) cycle ! current column has no convection + + ! extend below-cloud source region downwards (how far?) + maxg_minval = min( maxg_minval, maxg(i) ) + kaa = maxg(i) + kbb = min( kaa+4, pver ) + ! kbb = pver + if (kbb > kaa) then + tmpa = sum( dpdry(i,kaa:kbb) ) + do k = kaa+1, kbb + mu(i,k) = mu(i,kaa)*sum( dpdry(i,k:kbb) )/tmpa + end do + maxg(i) = kbb + end if + + ! calc ent / detrainment, using the [ent/(ent+det)] ratio from uw scheme + ! which is equal to [fer_out/(fer_out+fdr_out)] (see uwshcu.F90) + ! + ! note that the ratio is set to -1.0 (invalid) when both fer and fdr are very small + ! and the ratio values are often strange (??) at topmost layer + ! + ! for initial testing, impose a limit of + ! entrainment <= 4 * (net entrainment), OR + ! detrainment <= 4 * (net detrainment) + do k = jt(i), maxg(i) + if (k < pver) then + tmpa = (mu(i,k) - mu(i,k+1))/dpdry(i,k) + else + tmpa = mu(i,k)/dpdry(i,k) + end if + tmpb = sh_e_ed_ratio(i,k) + ! tmpb = -1.0 ! force ent only or det only + if (tmpb < -1.0e-5_r8) then + ! do ent only or det only + if (tmpa >= 0.0_r8) then + ! net entrainment + eu(i,k) = tmpa + else + ! net detrainment + du(i,k) = -tmpa + end if + else + if (tmpa >= 0.0_r8) then + ! net entrainment + if (k >= kaa .or. tmpb < 0.0_r8) then + ! layers at/below initial maxg, or sh_e_ed_ratio is invalid + eu(i,k) = tmpa + else + tmpb = max( tmpb, 0.571_r8 ) + eu(i,k) = tmpa*(tmpb/(2.0_r8*tmpb - 1.0_r8)) + du(i,k) = eu(i,k) - tmpa + end if + else + ! net detrainment + tmpa = -tmpa + if (k <= jt(i) .or. tmpb < 0.0_r8) then + ! layers at/above jt (where ratio is strange??), or sh_e_ed_ratio is invalid + du(i,k) = tmpa + else + tmpb = min( tmpb, 0.429_r8 ) + du(i,k) = tmpa*(1.0_r8 - tmpb)/(1.0_r8 - 2.0_r8*tmpb) + eu(i,k) = du(i,k) - tmpa + end if + end if + end if + end do ! k + + end do ! i + + qaa = q + + ! turn on/off calculations for aerosols and trace gases + do l = 1, pcnst + dotend(l) = .false. + if (cnst_species_class(l) == cnst_spec_class_aerosol) then + if (convproc_do_aer) dotend(l) = .true. + else if (cnst_species_class(l) == cnst_spec_class_gas) then + if (convproc_do_gas) dotend(l) = .true. + end if + end do + + + itmpveca(:) = -1 + + call ma_convproc_tend( & + 'uwsh', & + lchnk, pcnst, nstep, dt, & + state%t, state%pmid, state%pdel, qaa, & + mu, md, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + sh_frac, icwmrsh, rprdsh, evapcsh, & + fracice, & + dqdt, dotend, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + lun, itmpveca ) + + call outfld( 'SH_MFUP_MAX', xx_mfup_max, pcols, lchnk ) + call outfld( 'SH_WCLDBASE', xx_wcldbase, pcols, lchnk ) + call outfld( 'SH_KCLDBASE', xx_kcldbase, pcols, lchnk ) + +end subroutine ma_convproc_sh_intr + +!========================================================================================= + +subroutine ma_convproc_tend( & + convtype, & + lchnk, ncnst, nstep, dt, & + t, pmid, pdel, q, & + mu, md, du, eu, & + ed, dp, dpdry, jt, & + mx, ideep, il1g, il2g, & + cldfrac, icwmr, rprd, evapc, & + fracice, & + dqdt, doconvproc, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + lun, idiag_in ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Convective transport of trace species. +! The trace species need not be conservative, and source/sink terms for +! activation, resuspension, aqueous chemistry and gas uptake, and +! wet removal are all applied. +! Currently this works with the ZM deep convection, but we should be able +! to adapt it for both Hack and McCaa shallow convection +! +! +! Compare to subr convproc which does conservative trace species. +! +! A distinction between "moist" and "dry" mixing ratios is not currently made. +! (P. Rasch comment: Note that we are still assuming that the tracers are +! in a moist mixing ratio this will change soon) + +! +! Method: +! Computes tracer mixing ratios in updraft and downdraft "cells" in a +! Lagrangian manner, with source/sinks applied in the updraft other. +! Then computes grid-cell-mean tendencies by considering +! updraft and downdraft fluxes across layer boundaries +! environment subsidence/lifting fluxes across layer boundaries +! sources and sinks in the updraft +! resuspension of activated species in the grid-cell as a whole +! +! Note1: A better estimate or calculation of either the updraft velocity +! or fractional area is needed. +! Note2: If updraft area is a small fraction of over cloud area, +! then aqueous chemistry is underestimated. These are both +! research areas. +! +! Authors: O. Seland and R. Easter, based on convtran by P. Rasch +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver + use physconst, only: gravit, rair, rhoh2o + use constituents, only: pcnst, cnst_name + + use modal_aero_data, only: cnst_name_cw, & + lmassptr_amode, lmassptrcw_amode, & + ntot_amode, ntot_amode, & + nspec_amode, numptr_amode, numptrcw_amode +! use units, only: getunit + + implicit none + +!----------------------------------------------------------------------- +! +! Input arguments +! + character(len=*), intent(in) :: convtype ! identifies the type of + ! convection ("deep", "shcu") + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncnst ! number of tracers to transport + integer, intent(in) :: nstep ! Time step index + real(r8), intent(in) :: dt ! Model timestep + real(r8), intent(in) :: t(pcols,pver) ! Temperature + real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels + real(r8), intent(in) :: pdel(pcols,pver) ! Pressure thickness of levels + real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture + + real(r8), intent(in) :: mu(pcols,pver) ! Updraft mass flux (positive) + real(r8), intent(in) :: md(pcols,pver) ! Downdraft mass flux (negative) + real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft + real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft + real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft +! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS *** +! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code +! - eventually these should be changed to (kg/m2/s) +! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0 + + real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb) + real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb) +! real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc + integer, intent(in) :: jt(pcols) ! Index of cloud top for each column + integer, intent(in) :: mx(pcols) ! Index of cloud top for each column + integer, intent(in) :: ideep(pcols) ! Gathering array indices + integer, intent(in) :: il1g ! Gathered min lon indices over which to operate + integer, intent(in) :: il2g ! Gathered max lon indices over which to operate +! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index + + real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area + real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang + real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate + real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate + real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + + real(r8), intent(out):: dqdt(pcols,pver,ncnst) ! Tracer tendency array + logical, intent(in) :: doconvproc(ncnst) ! flag for doing convective transport + integer, intent(in) :: nsrflx ! last dimension of qsrflx + real(r8), intent(out):: qsrflx(pcols,pcnst,nsrflx) + ! process-specific column tracer tendencies + ! (1=activation, 2=resuspension, 3=aqueous rxn, + ! 4=wet removal, 5=renaming) + real(r8), intent(out) :: xx_mfup_max(pcols) + real(r8), intent(out) :: xx_wcldbase(pcols) + real(r8), intent(out) :: xx_kcldbase(pcols) + integer, intent(in) :: lun ! unit number for diagnostic output + integer, intent(in) :: idiag_in(pcols) ! flag for diagnostic output + + +!--------------------------Local Variables------------------------------ + +! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2 + integer, parameter :: pcnst_extd = pcnst*2 + + integer :: i, icol ! Work index + integer :: iconvtype ! 1=deep, 2=uw shallow + integer :: idiag_act ! Work index + integer :: iflux_method ! 1=as in convtran (deep), 2=simpler + integer :: ipass_calc_updraft + integer :: itmpa, itmpb ! Work variable + integer :: j, jtsub ! Work index + integer :: k ! Work index + integer :: kactcnt ! Counter for no. of levels having activation + integer :: kactcntb ! Counter for activation diagnostic output + integer :: kactfirst ! Lowest layer with activation (= cloudbase) + integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i)) + integer :: ktop ! Cloud-flux top layer for current i (=jt(i)) + ! Layers between kbot,ktop have mass fluxes + ! but not all have cloud water, because the + ! updraft starts below the cloud base + integer :: km1, km1x ! Work index + integer :: kp1, kp1x ! Work index + integer :: l, ll, la, lc ! Work index + integer :: m, n ! Work index + integer :: merr ! number of errors (i.e., failed diagnostics) + ! for current column + integer :: nerr ! number of errors for entire run + integer :: nerrmax ! maximum number of errors to report + integer :: ncnst_extd + integer :: npass_calc_updraft + integer :: ntsub ! + + logical do_act_this_lev ! flag for doing activation at current level + logical doconvproc_extd(pcnst_extd) ! flag for doing convective transport + + real(r8) aqfrac(pcnst_extd) ! aqueous fraction of constituent in updraft + real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments) + + real(r8) chat(pcnst_extd,pverp) ! mix ratio in env at interfaces + real(r8) cond(pcnst_extd,pverp) ! mix ratio in downdraft at interfaces + real(r8) const(pcnst_extd,pver) ! gathered tracer array + real(r8) conu(pcnst_extd,pverp) ! mix ratio in updraft at interfaces + + real(r8) dcondt(pcnst_extd,pver) ! grid-average TMR tendency for current column + real(r8) dcondt_prevap(pcnst_extd,pver) ! portion of dcondt from precip evaporation + real(r8) dcondt_resusp(pcnst_extd,pver) ! portion of dcondt from resuspension + + real(r8) dcondt_wetdep(pcnst_extd,pver) ! portion of dcondt from wet deposition + real(r8) dconudt_activa(pcnst_extd,pverp) ! d(conu)/dt by activation + real(r8) dconudt_aqchem(pcnst_extd,pverp) ! d(conu)/dt by aqueous chem + real(r8) dconudt_wetdep(pcnst_extd,pverp) ! d(conu)/dt by wet removal + + real(r8) maxflux(pcnst_extd) ! maximum (over layers) of fluxin and fluxout + real(r8) maxflux2(pcnst_extd) ! ditto but computed using method-2 fluxes + real(r8) maxprevap(pcnst_extd) ! maximum (over layers) of dcondt_prevap*dp + real(r8) maxresusp(pcnst_extd) ! maximum (over layers) of dcondt_resusp*dp + real(r8) maxsrce(pcnst_extd) ! maximum (over layers) of netsrce + + real(r8) sumflux(pcnst_extd) ! sum (over layers) of netflux + real(r8) sumflux2(pcnst_extd) ! ditto but computed using method-2 fluxes + real(r8) sumsrce(pcnst_extd) ! sum (over layers) of dp*netsrce + real(r8) sumchng(pcnst_extd) ! sum (over layers) of dp*dcondt + real(r8) sumchng3(pcnst_extd) ! ditto but after call to resusp_conv + real(r8) sumactiva(pcnst_extd) ! sum (over layers) of dp*dconudt_activa + real(r8) sumaqchem(pcnst_extd) ! sum (over layers) of dp*dconudt_aqchem + real(r8) sumprevap(pcnst_extd) ! sum (over layers) of dp*dcondt_prevap + real(r8) sumresusp(pcnst_extd) ! sum (over layers) of dp*dcondt_resusp + real(r8) sumwetdep(pcnst_extd) ! sum (over layers) of dp*dconudt_wetdep + + real(r8) cabv ! mix ratio of constituent above + real(r8) cbel ! mix ratio of constituent below + real(r8) cdifr ! normalized diff between cabv and cbel + real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt + real(r8) clw_cut ! threshold clw value for doing updraft + ! transformation and removal + real(r8) courantmax ! maximum courant no. + real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i + real(r8) dp_i(pver) ! dp(i,k) at current i + real(r8) dt_u(pver) ! lagrangian transport time in the updraft + real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i + real(r8) dqdt_i(pver,pcnst) ! dqdt(i,k,m) at current i + real(r8) dtsub ! dt/ntsub + real(r8) dz ! working layer thickness (m) + real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i + real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i + real(r8) expcdtm1 ! a work variable + real(r8) fa_u(pver) ! fractional area of in the updraft + real(r8) fa_u_dp ! current fa_u(k)*dp_i(k) + real(r8) f_ent ! fraction of the "before-detrainment" updraft + ! massflux at k/k-1 interface resulting from + ! entrainment of level k air + real(r8) fluxin ! a work variable + real(r8) fluxout ! a work variable + real(r8) maxc ! a work variable + real(r8) mbsth ! Threshold for mass fluxes + real(r8) minc ! a work variable + real(r8) md_m_eddp ! a work variable + real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension) + real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension) + ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes + ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry + ! the mu_i/md_i are next calculated by applying the mbsth threshold + real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k) + real(r8) netflux ! a work variable + real(r8) netsrce ! a work variable + real(r8) q_i(pver,pcnst) ! q(i,k,m) at current i + real(r8) qsrflx_i(pcnst,nsrflx) ! qsrflx(i,m,n) at current i + real(r8) relerr_cut ! relative error criterion for diagnostics + real(r8) rhoair_i(pver) ! air density at current i + real(r8) small ! a small number + real(r8) tmpa, tmpb, tmpc ! work variables + real(r8) tmpf ! work variables + real(r8) tmpveca(pcnst_extd) ! work variables + real(r8) tmpmata(pcnst_extd,3) ! work variables + real(r8) xinv_ntsub ! 1.0/ntsub + real(r8) wup(pver) ! working updraft velocity (m/s) + real(r8) zmagl(pver) ! working height above surface (m) + real(r8) zkm ! working height above surface (km) + + character(len=16) :: cnst_name_extd(pcnst_extd) + +!----------------------------------------------------------------------- +! + +! if (nstep > 1) call endrun() + + if (convtype == 'deep') then + iconvtype = 1 + iflux_method = 1 + else if (convtype == 'uwsh') then + iconvtype = 2 + iflux_method = 2 + else + call endrun( '*** ma_convproc_tend -- convtype is not |deep| or |uwsh|' ) + end if + + nerr = 0 + nerrmax = 99 + + ncnst_extd = pcnst_extd + + + small = 1.e-36_r8 +! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) + mbsth = 1.e-15_r8 + + qsrflx(:,:,:) = 0.0_r8 + dqdt(:,:,:) = 0.0_r8 + xx_mfup_max(:) = 0.0_r8 + xx_wcldbase(:) = 0.0_r8 + xx_kcldbase(:) = 0.0_r8 + +! set doconvproc_extd (extended array) values +! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise + doconvproc_extd(:) = .false. + doconvproc_extd(2:ncnst) = doconvproc(2:ncnst) + aqfrac(:) = 0.0_r8 + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + if ( doconvproc(la) ) then + doconvproc_extd(lc) = .true. + aqfrac(lc) = 1.0_r8 + end if + enddo + enddo ! n + + do l = 1, pcnst_extd + if (l <= pcnst) then + cnst_name_extd(l) = cnst_name(l) + else + cnst_name_extd(l) = trim(cnst_name(l-pcnst)) // '_cw' + end if + end do + + +! Loop ever each column that has convection +! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays +i_loop_main_aa: & + do i = il1g, il2g + icol = ideep(i) + + + if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then +! shallow conv case with jt,mx <= 0, which means there is no shallow conv +! in this column -- skip this column + cycle i_loop_main_aa + + else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then +! invalid cloudtop and cloudbase indices -- skip this column + write(lun,9010) 'illegal jt, mx', convtype, lchnk, icol, i, & + jt(i), mx(i) +9010 format( '*** ma_convproc_tend error -- ', a, 5x, 'convtype = ', a / & + '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) ) + cycle i_loop_main_aa + + else if (jt(i) == mx(i)) then +! cloudtop = cloudbase (1 layer cloud) -- skip this column + write(lun,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i) + cycle i_loop_main_aa + + end if + + +! +! cloudtop and cloudbase indices are valid so proceed with calculations +! + +! Load dp_i and cldfrac_i, and calc rhoair_i + do k = 1, pver + dp_i(k) = dpdry(i,k) + cldfrac_i(k) = cldfrac(icol,k) + rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k)) + end do + +! Calc dry mass fluxes +! This is approximate because the updraft air is has different temp and qv than +! the grid mean, but the whole convective parameterization is highly approximate + mu_x(:) = 0.0_r8 + md_x(:) = 0.0_r8 +! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry + do k = pver, 1, -1 + mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k) + xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) ) + end do +! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry + do k = 2, pver + md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1) + end do + +! Load mass fluxes over cloud layers +! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding) +! Zero out values below threshold +! Zero out values at "top of cloudtop", "base of cloudbase" + ktop = jt(i) + kbot = mx(i) + mu_i(:) = 0.0_r8 + md_i(:) = 0.0_r8 + do k = ktop+1, kbot + mu_i(k) = mu_x(k) + if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8 + md_i(k) = md_x(k) + if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8 + end do + mu_i(ktop) = 0.0_r8 + md_i(ktop) = 0.0_r8 + mu_i(kbot+1) = 0.0_r8 + md_i(kbot+1) = 0.0_r8 + +! Compute updraft and downdraft "entrainment*dp" from eu and ed +! Compute "detrainment*dp" from mass conservation + eudp(:) = 0.0_r8 + dudp(:) = 0.0_r8 + eddp(:) = 0.0_r8 + dddp(:) = 0.0_r8 + courantmax = 0.0_r8 + do k = ktop, kbot + if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then + if (du(i,k) <= 0.0_r8) then + eudp(k) = mu_i(k) - mu_i(k+1) + else + eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 ) + dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k) + if (dudp(k) < 1.0e-12_r8*eudp(k)) then + eudp(k) = mu_i(k) - mu_i(k+1) + dudp(k) = 0.0_r8 + end if + end if + end if + if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then + eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 ) + dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k) + if (dddp(k) < 1.0e-12_r8*eddp(k)) then + eddp(k) = md_i(k) - md_i(k+1) + dddp(k) = 0.0_r8 + end if + end if +! courantmax = max( courantmax, (eudp(k)+eddp(k))*dt/dp_i(k) ) ! old version - incorrect + courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) ) + end do ! k + +! number of time substeps needed to maintain "courant number" <= 1 + ntsub = 1 + if (courantmax > (1.0_r8 + 1.0e-6_r8)) then + ntsub = 1 + int( courantmax ) + end if + xinv_ntsub = 1.0_r8/ntsub + dtsub = dt*xinv_ntsub + courantmax = courantmax*xinv_ntsub + +! zmagl(k) = height above surface for middle of level k + zmagl(pver) = 0.0_r8 + do k = pver, 1, -1 + if (k < pver) then + zmagl(k) = zmagl(k+1) + 0.5_r8*dz + end if + dz = dp_i(k)*hund_ovr_g/rhoair_i(k) + zmagl(k) = zmagl(k) + 0.5_r8*dz + end do + +! load tracer mixing ratio array, which will be updated at the end of each jtsub interation + q_i(1:pver,1:pcnst) = q(icol,1:pver,1:pcnst) + +! +! when method_reduce_actfrac = 2, need to do the updraft calc twice +! (1st to get non-adjusted activation amount, 2nd to apply reduction factor) + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + + +jtsub_loop_main_aa: & + do jtsub = 1, ntsub + + +ipass_calc_updraft_loop: & + do ipass_calc_updraft = 1, npass_calc_updraft + + + if (idiag_in(icol) > 0) & + write(lun,'(/a,3x,a,1x,i9,5i5)') 'qakr - convtype,lchnk,i,jt,mx,jtsub,ipass=', & + trim(convtype), lchnk, icol, jt(i), mx(i), jtsub, ipass_calc_updraft + + qsrflx_i(:,:) = 0.0_r8 + dqdt_i(:,:) = 0.0_r8 + + const(:,:) = 0.0_r8 ! zero cloud-phase species + chat(:,:) = 0.0_r8 ! zero cloud-phase species + conu(:,:) = 0.0_r8 + cond(:,:) = 0.0_r8 + + dcondt(:,:) = 0.0_r8 + dcondt_resusp(:,:) = 0.0_r8 + dcondt_wetdep(:,:) = 0.0_r8 + dcondt_prevap(:,:) = 0.0_r8 + dconudt_aqchem(:,:) = 0.0_r8 + dconudt_wetdep(:,:) = 0.0_r8 +! only initialize the activation tendency on ipass=1 + if (ipass_calc_updraft == 1) dconudt_activa(:,:) = 0.0_r8 + +! initialize mixing ratio arrays (chat, const, conu, cond) + do m = 2, ncnst + if ( doconvproc_extd(m) ) then + +! Gather up the constituent + do k = 1,pver + const(m,k) = q_i(k,m) + end do + +! From now on work only with gathered data +! Interpolate environment tracer values to interfaces + do k = 1,pver + km1 = max(1,k-1) + minc = min(const(m,km1),const(m,k)) + maxc = max(const(m,km1),const(m,k)) + if (minc < 0) then + cdifr = 0._r8 + else + cdifr = abs(const(m,k)-const(m,km1))/max(maxc,small) + endif + +! If the two layers differ significantly use a geometric averaging procedure +! But only do that for deep convection. For shallow, use the simple +! averaging which is used in subr cmfmca + if (iconvtype /= 1) then + chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) + else if (cdifr > 1.E-6_r8) then +! if (cdifr > 1.E-6) then + cabv = max(const(m,km1),maxc*1.e-12_r8) + cbel = max(const(m,k),maxc*1.e-12_r8) + chat(m,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel + else ! Small diff, so just arithmetic mean + chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) + end if + +! Set provisional up and down draft values, and tendencies + conu(m,k) = chat(m,k) + cond(m,k) = chat(m,k) + end do ! k + +! Values at surface inferface == values in lowest layer + chat(m,pver+1) = const(m,pver) + conu(m,pver+1) = const(m,pver) + cond(m,pver+1) = const(m,pver) + end if + end do ! m + + + + +! Compute updraft mixing ratios from cloudbase to cloudtop +! No special treatment is needed at k=pver because arrays +! are dimensioned 1:pver+1 +! A time-split approach is used. First, entrainment is applied to produce +! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are +! applied to the initial conu(m,k) to produce a final conu(m,k). +! Detrainment from the updraft uses this final conu(m,k). +! Note that different time-split approaches would give somewhat different +! results + kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1 +k_loop_main_bb: & + do k = kbot, ktop, -1 + kp1 = k+1 + +! cldfrac = conv cloud fractional area. This could represent anvil cirrus area, +! and may not useful for aqueous chem and wet removal calculations + cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 ) +! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k + mu_p_eudp(k) = mu_i(kp1) + eudp(k) + + fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false. + if (mu_p_eudp(k) > mbsth) then +! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top +! of current layer, +! so current layer is a "gap" between two unconnected updrafts, +! so essentially skip all the updraft calculations for this layer + +! First apply changes from entrainment + f_ent = eudp(k)/mu_p_eudp(k) + f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) ) + tmpa = 1.0_r8 - f_ent + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + conu(m,k) = tmpa*conu(m,kp1) + f_ent*const(m,k) + end if + end do + +! estimate updraft velocity (wup) + if (iconvtype /= 1) then +! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + wup(k) = max( 0.1_r8, wup(k) ) + else +! deep - the above method overestimates updraft area and underestimate wup +! the following is based lemone and zipser (j atmos sci, 1980, p. 2455) +! peak updraft (= 4 m/s) is sort of a "grand median" from their GATE data +! and Thunderstorm Project data which they also show +! the vertical profile shape is a crude fit to their median updraft profile + zkm = zmagl(k)*1.0e-3_r8 + if (zkm .ge. 1.0_r8) then + wup(k) = 4.0_r8*((zkm/4.0_r8)**0.21_r8) + else + wup(k) = 2.9897_r8*(zkm**0.5_r8) + end if + wup(k) = max( 0.1_r8, min( 4.0_r8, wup(k) ) ) + end if + +! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u) +! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k) + dt_u(k) = dz/wup(k) + dt_u(k) = min( dt_u(k), dt ) + fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k)) + + +! Now apply transformation and removal changes +! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate +! occasional very small icwmr values from the ZM module + clw_cut = 1.0e-6_r8 + + + if (convproc_method_activate <= 1) then +! aerosol activation - method 1 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) apply +! activatation to the entire updraft +! when kactcnt>1 apply activatation to the amount entrained at this level + if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then + kactcnt = kactcnt + 1 + + idiag_act = idiag_in(icol) + if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then + kactcntb = kactcntb + 1 + if ((kactcntb == 1) .and. (idiag_act > 0)) then + write(lun,'(/a,i9,2i4)') & + 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub + end if + end if + + if (kactcnt == 1) then + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + + kactfirst = k + tmpa = 1.0_r8 + call ma_activate_convproc( & + conu(:,k), dconudt_activa(:,k), conu(:,k), & + tmpa, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), fracice(icol,k), & + pcnst_extd, lun, idiag_act, & + lchnk, icol, k, & + ipass_calc_updraft ) + else if (f_ent > 0.0_r8) then + ! current layer is above cloud base (=first layer with activation) + ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1) + if (k >= kactfirst-(method1_activate_nlayers-1)) then + call ma_activate_convproc( & + conu(:,k), dconudt_activa(:,k), const(:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), fracice(icol,k), & + pcnst_extd, lun, idiag_act, & + lchnk, icol, k, & + ipass_calc_updraft ) + end if + end if +! the following was for cam2 shallow convection (hack), +! but is not appropriate for cam5 (uwshcu) +! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then +! ! for shallow conv, when you move from activation occuring to +! ! not occuring, reset kactcnt=0, because the hack scheme can +! ! produce multiple "1.5 layer clouds" separated by clear air +! kactcnt = 0 +! end if + end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + + else ! (convproc_method_activate >= 2) +! aerosol activation - method 2 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) +! apply "primary" activatation to the entire updraft +! when kactcnt>1 +! apply secondary activatation to the entire updraft +! do this for all levels above cloud base (even if completely glaciated) +! (this is something for sensitivity testing) + do_act_this_lev = .false. + if (kactcnt <= 0) then + if (icwmr(icol,k) > clw_cut) then + do_act_this_lev = .true. + kactcnt = 1 + kactfirst = k + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + end if + else +! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + do_act_this_lev = .true. + kactcnt = kactcnt + 1 +! end if + end if + + idiag_act = idiag_in(icol) + if ( do_act_this_lev ) then + kactcntb = kactcntb + 1 + if ((kactcntb == 1) .and. (idiag_act > 0)) then + write(lun,'(/a,i9,2i4)') & + 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub + end if + + call ma_activate_convproc_method2( & + conu(:,k), dconudt_activa(:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), fracice(icol,k), & + pcnst_extd, lun, idiag_act, & + lchnk, icol, k, & + kactfirst, ipass_calc_updraft ) + end if + + end if ! (convproc_method_activate <= 1) + +! aqueous chemistry +! do glaciated levels as aqchem_conv will eventually do acid vapor uptake +! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff + if (icwmr(icol,k) > clw_cut) then +! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, & +! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), & +! lh2o2(icol,k), lo3(icol,k), dt_u(k) ) + end if + +! wet removal +! +! mirage2 +! rprd = precip formation as a grid-cell average (kgW/kgA/s) +! icwmr = cloud water MR within updraft area (kgW/kgA) +! fupdr = updraft fractional area (--) +! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s) +! B = A/icwmr = rprd/(icwmr*fupdr) +! = first-order removal rate (1/s) +! C = dp/(mup/fupdr) = updraft air residence time in the layer (s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (dp/mup)*rprd/icwmr +! +! Note1: fupdr cancels out in cdt, so need not be specified +! Note2: dp & mup units need only be consistent (e.g., mb & mb/s) +! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme) +! Note4: the "dp" in C above and code below should be the moist dp +! +! cam5 +! clw_preloss = cloud water MR before loss to precip +! = icwmr + dt*(rprd/fupdr) +! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr) +! = rprd/(fupdr*icwmr + dt*rprd) +! = first-order removal rate (1/s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)] +! +! Note1: *** cdt is now sensitive to fupdr, which we do not really know, +! and is not the same as the convective cloud fraction +! Note2: dt is appropriate in the above cdt expression, not dtsub +! +! Apply wet removal at levels where +! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0 +! as wet removal occurs in both liquid and ice clouds +! + cdt(k) = 0.0_r8 + if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then +! if (iconvtype == 1) then + tmpf = 0.5_r8*cldfrac_i(k) + cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / & + (tmpf*icwmr(icol,k) + dt*rprd(icol,k)) +! else if (k < pver) then +! if (eudp(k+1) > 0) cdt(k) = & +! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1)) +! end if + end if + if (cdt(k) > 0.0_r8) then + expcdtm1 = exp(-cdt(k)) - 1.0_r8 + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + dconudt_wetdep(m,k) = conu(m,k)*aqfrac(m)*expcdtm1 + conu(m,k) = conu(m,k) + dconudt_wetdep(m,k) + dconudt_wetdep(m,k) = dconudt_wetdep(m,k) / dt_u(k) + end if + enddo + end if + + end if ! "(mu_p_eudp(k) > mbsth)" + end do k_loop_main_bb ! "k = kbot, ktop, -1" + +! when doing updraft calcs twice, only need to go this far on the first pass + if ( (ipass_calc_updraft == 1) .and. & + (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop + + if (idiag_in(icol) > 0) then + ! do wet removal diagnostics here + do k = kbot, ktop, -1 + if (mu_p_eudp(k) > mbsth) & + write(lun,'(a,i9,3i4,1p,6e10.3)') & + 'qakr - l,i,k,jt; cdt, cldfrac, icwmr, rprd, ...', lchnk, icol, k, jtsub, & + cdt(k), cldfrac_i(k), icwmr(icol,k), rprd(icol,k), dp(i,k), mu_p_eudp(k) + end do + end if + + +! Compute downdraft mixing ratios from cloudtop to cloudbase +! No special treatment is needed at k=2 +! No transformation or removal is applied in the downdraft + do k = ktop, kbot + kp1 = k + 1 +! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1 + md_m_eddp = md_i(k) - eddp(k) + if (md_m_eddp < -mbsth) then + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + cond(m,kp1) = ( md_i(k)*cond(m,k) & + - eddp(k)*const(m,k) ) / md_m_eddp + endif + end do + end if + end do ! k + + +! Now computes fluxes and tendencies +! NOTE: The approach used in convtran applies to inert tracers and +! must be modified to include source and sink terms + sumflux(:) = 0.0_r8 + sumflux2(:) = 0.0_r8 + sumsrce(:) = 0.0_r8 + sumchng(:) = 0.0_r8 + sumchng3(:) = 0.0_r8 + sumactiva(:) = 0.0_r8 + sumaqchem(:) = 0.0_r8 + sumwetdep(:) = 0.0_r8 + sumresusp(:) = 0.0_r8 + sumprevap(:) = 0.0_r8 + + maxflux(:) = 0.0_r8 + maxflux2(:) = 0.0_r8 + maxresusp(:) = 0.0_r8 + maxsrce(:) = 0.0_r8 + maxprevap(:) = 0.0_r8 + +k_loop_main_cc: & + do k = ktop, kbot + kp1 = k+1 + km1 = k-1 + kp1x = min( kp1, pver ) + km1x = max( km1, 1 ) + fa_u_dp = fa_u(k)*dp_i(k) + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + +! First compute fluxes using environment subsidence/lifting and +! entrainment/detrainment into up/downdrafts, +! to provide an additional mass balance check +! (this could be deleted after the code is well tested) + fluxin = mu_i(k)*min(chat(m,k),const(m,km1x)) & + - md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) & + + dudp(k)*conu(m,k) + dddp(k)*cond(m,kp1) + fluxout = mu_i(kp1)*min(chat(m,kp1),const(m,k)) & + - md_i(k)*min(chat(m,k),const(m,k)) & + + (eudp(k) + eddp(k))*const(m,k) + + netflux = fluxin - fluxout + + sumflux2(m) = sumflux2(m) + netflux + maxflux2(m) = max( maxflux2(m), abs(fluxin), abs(fluxout) ) + +! Now compute fluxes as in convtran, and also source/sink terms +! (version 3 limit fluxes outside convection to mass in appropriate layer +! (these limiters are probably only safe for positive definite quantitities +! (it assumes that mu and md already satify a courant number limit of 1) + if (iflux_method /= 2) then + fluxin = mu_i(kp1)*conu(m,kp1) & + + mu_i(k )*min(chat(m,k ),const(m,km1x)) & + - ( md_i(k )*cond(m,k) & + + md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) ) + fluxout = mu_i(k )*conu(m,k) & + + mu_i(kp1)*min(chat(m,kp1),const(m,k )) & + - ( md_i(kp1)*cond(m,kp1) & + + md_i(k )*min(chat(m,k ),const(m,k )) ) + else + fluxin = mu_i(kp1)*conu(m,kp1) & + - ( md_i(k )*cond(m,k) ) + fluxout = mu_i(k )*conu(m,k) & + - ( md_i(kp1)*cond(m,kp1) ) + tmpveca(1) = fluxin ; tmpveca(4) = -fluxout + + ! new method -- simple upstream method for the env subsidence + ! tmpa = net env mass flux (positive up) at top of layer k + tmpa = -( mu_i(k ) + md_i(k ) ) + if (tmpa <= 0.0_r8) then + fluxin = fluxin - tmpa*const(m,km1x) + else + fluxout = fluxout + tmpa*const(m,k ) + end if + tmpveca(2) = fluxin ; tmpveca(5) = -fluxout + ! tmpa = net env mass flux (positive up) at base of layer k + tmpa = -( mu_i(kp1) + md_i(kp1) ) + if (tmpa >= 0.0_r8) then + fluxin = fluxin + tmpa*const(m,kp1x) + else + fluxout = fluxout - tmpa*const(m,k ) + end if + tmpveca(3) = fluxin ; tmpveca(6) = -fluxout + end if + + netflux = fluxin - fluxout + netsrce = fa_u_dp*(dconudt_aqchem(m,k) + & + dconudt_activa(m,k) + dconudt_wetdep(m,k)) + dcondt(m,k) = (netflux+netsrce)/dp_i(k) + + dcondt_wetdep(m,k) = fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) + + sumflux(m) = sumflux(m) + netflux + maxflux(m) = max( maxflux(m), abs(fluxin), abs(fluxout) ) + sumsrce(m) = sumsrce(m) + netsrce + maxsrce(m) = max( maxsrce(m), & + fa_u_dp*max( abs(dconudt_aqchem(m,k)), & + abs(dconudt_activa(m,k)), abs(dconudt_wetdep(m,k)) ) ) + sumchng(m) = sumchng(m) + dcondt(m,k)*dp_i(k) + sumactiva(m) = sumactiva(m) + fa_u_dp*dconudt_activa(m,k) + sumaqchem(m) = sumaqchem(m) + fa_u_dp*dconudt_aqchem(m,k) + sumwetdep(m) = sumwetdep(m) + fa_u_dp*dconudt_wetdep(m,k) + + if ( idiag_in(icol)>0 .and. k==26 .and. & + (m==16 .or. m==23 .or. m==16+pcnst .or. m==23+pcnst) ) then + if (m==16) & + write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & + 'qakww0-'//convtype(1:4), lchnk, icol, k, -1, jtsub, & + dtsub*mu_i(k+1)/dp_i(k), dtsub*mu_i(k)/dp_i(k), dtsub*eudp(k)/dp_i(k), & + dtsub*md_i(k+1)/dp_i(k), dtsub*md_i(k)/dp_i(k), dtsub*eddp(k)/dp_i(k) + + write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,6e11.3)') & + 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k), & + dtsub*fluxin/dp_i(k), -dtsub*fluxout/dp_i(k), & + dtsub*fa_u_dp*dconudt_aqchem(m,k)/dp_i(k), & + dtsub*fa_u_dp*dconudt_activa(m,k)/dp_i(k), & + dtsub*fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) + write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & + 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + dtsub*tmpveca(1:6)/dp_i(k) + end if + + end if ! "(doconvproc_extd(m))" + end do ! "m = 2,ncnst_extd" + end do k_loop_main_cc ! "k = ktop, kbot" + + +! calculate effects of precipitation evaporation + call ma_precpevap_convproc( dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop, pcnst_extd, & + lun, idiag_in(icol), lchnk, & + doconvproc_extd ) + if ( idiag_in(icol)>0 ) then + k = 26 + do m = 16, 23, 7 + write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & + 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) + end do + do m = 16+pcnst, 23+pcnst, 7 + write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & + 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) + end do + end if + + + +! make adjustments to dcondt for activated & unactivated aerosol species +! pairs to account any (or total) resuspension of convective-cloudborne aerosol + call ma_resuspend_convproc( dcondt, dcondt_resusp, & + const, dp_i, ktop, kbot, pcnst_extd ) + if ( idiag_in(icol)>0 ) then + k = 26 + do m = 16, 23, 7 + write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & + 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) + end do + do m = 16+pcnst, 23+pcnst, 7 + write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & + 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & + const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) + end do + end if + + +! calculate new column-tendency variables + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + do k = ktop, kbot + sumchng3(m) = sumchng3(m) + dcondt(m,k)*dp_i(k) + sumresusp(m) = sumresusp(m) + dcondt_resusp(m,k)*dp_i(k) + maxresusp(m) = max( maxresusp(m), & + abs(dcondt_resusp(m,k)*dp_i(k)) ) + sumprevap(m) = sumprevap(m) + dcondt_prevap(m,k)*dp_i(k) + maxprevap(m) = max( maxprevap(m), & + abs(dcondt_prevap(m,k)*dp_i(k)) ) + end do + end if + end do ! m + + +! do checks for mass conservation +! do not expect errors > 1.0e-14, but use a conservative 1.0e-10 here, +! as an error of this size is still not a big concern + relerr_cut = 1.0e-10_r8 + if (nerr < nerrmax) then + merr = 0 + if (courantmax > (1.0_r8 + 1.0e-6_r8)) then + write(lun,9161) '-', trim(convtype), courantmax + merr = merr + 1 + end if + do m = 2, ncnst_extd + if (doconvproc_extd(m)) then + itmpa = 0 + ! sumflux should be ~=0.0 because fluxout of one layer cancels + ! fluxin to adjacent layer + tmpa = sumflux(m) + tmpb = max( maxflux(m), small ) + if (abs(tmpa) > relerr_cut*tmpb) then + write(lun,9151) '1', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) + itmpa = itmpa + 1 + end if + ! sumflux2 involve environment fluxes and entrainment/detrainment + ! to up/downdrafts, and it should be equal to sumchng, + ! and so (sumflux2 - sumsrce) should be ~=0.0 + tmpa = sumflux2(m) - sumsrce(m) + tmpb = max( maxflux2(m), maxsrce(m), small ) + if (abs(tmpa) > relerr_cut*tmpb) then + write(lun,9151) '2', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) + itmpa = itmpa + 10 + end if + ! sunchng = sumflux + sumsrce, so (sumchng - sumsrc) should be ~=0.0 + tmpa = sumchng(m) - sumsrce(m) + tmpb = max( maxflux(m), maxsrce(m), small ) + if (abs(tmpa) > relerr_cut*tmpb) then + write(lun,9151) '3', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) + itmpa = itmpa + 100 + end if + ! sumchng3 = sumchng + sumresusp + sumprevap, + ! so tmpa (below) should be ~=0.0 + tmpa = sumchng3(m) - (sumsrce(m) + sumresusp(m) + sumprevap(m)) + tmpb = max( maxflux(m), maxsrce(m), maxresusp(m), maxprevap(m), small ) + if (abs(tmpa) > relerr_cut*tmpb) then + write(lun,9151) '4', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) + itmpa = itmpa + 1000 + end if + + if (itmpa > 0) merr = merr + 1 + end if + end do ! m + if (merr > 0) write(lun,9181) convtype, lchnk, icol, i, jt(i), mx(i) + nerr = nerr + merr + if (nerr >= nerrmax) write(lun,9171) nerr + end if ! (nerr < nerrmax) then + +9151 format( '*** ma_convproc_tend error, massbal', a, 1x, i5,1x,a, & + ' -- maxflux, sumflux, relerr =', 3(1pe14.6) ) +9161 format( '*** ma_convproc_tend error, courantmax', 2a, 3x, 1pe14.6 ) +9171 format( '*** ma_convproc_tend error, stopping messages after nerr =', i10 ) + +9181 format( '*** ma_convproc_tend error -- convtype, lchnk, icol, il, jt, mx = ', a,2x,5(1x,i10) ) + + +! +! note again the ma_convproc_tend does not apply convective cloud processing +! to the stratiform-cloudborne aerosol +! within this routine, cloudborne aerosols are convective-cloudborne +! +! before tendencies (dcondt, which is loaded into dqdt) are returned, +! the convective-cloudborne aerosol tendencies must be combined +! with the interstitial tendencies +! ma_resuspend_convproc has already done this for the dcondt +! +! the individual process column tendencies (sumwetdep, sumprevap, ...) +! are just diagnostic fields that can be written to history +! tendencies for interstitial and convective-cloudborne aerosol could +! both be passed back and output, if desired +! currently, however, the interstitial and convective-cloudborne tendencies +! are combined (in the next code block) before being passed back (in qsrflx) +! + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + if (doconvproc(la)) then + sumactiva(la) = sumactiva(la) + sumactiva(lc) + sumresusp(la) = sumresusp(la) + sumresusp(lc) + sumaqchem(la) = sumaqchem(la) + sumaqchem(lc) + sumwetdep(la) = sumwetdep(la) + sumwetdep(lc) + sumprevap(la) = sumprevap(la) + sumprevap(lc) +! if (n==1 .and. ll==1) then +! write(lun,*) 'la, sumaqchem(la) =', la, sumaqchem(la) +! endif + end if + enddo ! ll + enddo ! n + +! +! scatter overall tendency back to full array +! + do m = 2, ncnst + if (doconvproc(m)) then + do k = ktop, kbot + dqdt_i(k,m) = dcondt(m,k) + dqdt(icol,k,m) = dqdt(icol,k,m) + dqdt_i(k,m)*xinv_ntsub + end do +! dqdt_i(:,m) = 0. + end if + end do ! m + +! scatter column burden tendencies for various processes to qsrflx + do m = 2, ncnst + if (doconvproc(m)) then + qsrflx_i(m,1) = sumactiva(m)*hund_ovr_g + qsrflx_i(m,2) = sumresusp(m)*hund_ovr_g + qsrflx_i(m,3) = sumaqchem(m)*hund_ovr_g + qsrflx_i(m,4) = sumwetdep(m)*hund_ovr_g + qsrflx_i(m,5) = sumprevap(m)*hund_ovr_g +! qsrflx_i(m,1:4) = 0. + qsrflx(icol,m,1:5) = qsrflx(icol,m,1:5) + qsrflx_i(m,1:5)*xinv_ntsub + end if + end do ! m + + +! diagnostic output of profiles before + if (idiag_in(icol) > 0) then + write(lun, '(/3a,i9,2i4)' ) 'qakr-', trim(convtype), ' - lchnk,i,jtsub', lchnk, icol, jtsub + n = 1 + + do j = 1, 2 + if (j == 1) then + write(lun, '(4a,i4)' ) & + 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & + 'numb & numbcw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub + else + write(lun, '(/4a,i4)' ) & + 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & + 'mass & masscw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub + end if + + do k = 10, pver + tmpveca(:) = 0.0_r8 + do ll = 1, nspec_amode(n) + if (j == 1) then + la = numptr_amode(n) + lc = numptr_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptr_amode(ll,n) + pcnst + end if + tmpveca(1) = tmpveca(1) + q_i(k,la) + tmpveca(2) = tmpveca(2) + const(la,k) + tmpveca(3) = tmpveca(3) + const(lc,k) + tmpveca(4) = tmpveca(4) + conu( la,k) + tmpveca(5) = tmpveca(5) + conu( lc,k) + tmpveca(6) = tmpveca(6) + cond( la,k) + tmpveca(7) = tmpveca(7) + cond( lc,k) + tmpveca(8) = tmpveca(8) + (dcondt(la,k)-dcondt_resusp(la,k))*dtsub + tmpveca(9) = tmpveca(9) + (dcondt(lc,k)-dcondt_resusp(lc,k))*dtsub + tmpveca(10) = tmpveca(8) + tmpveca(9) + if (j == 1) exit + end do ! ll + if ((k > 15) .and. (mod(k,5) == 1)) write(lun,'(a)') + write(lun, '(a,i3,1p,2e10.2, e11.2, 3(2x,2e9.2), 2x,3e10.2 )' ) 'qakr', k, & + mu_i(k), md_i(k), tmpveca(1:10) + end do ! k + end do ! j + + if (pcnst < 0) then + write(lun, '(/a,i4)' ) & + 'qakr - name; burden; qsrflx tot, activa,resusp,aqchem,wetdep,resid', jtsub + do m = 2, ncnst + if ( .not. doconvproc(m) ) cycle + tmpveca(1) = sum( q_i(:,m)*dp_i(:) ) * hund_ovr_g + tmpveca(2) = sum( dqdt_i(:,m)*dp_i(:) ) * hund_ovr_g + tmpveca(3:6) = qsrflx_i(m,1:4) + tmpveca(7) = tmpveca(2) - sum( tmpveca(3:6) ) + write(lun, '(2a,1p,2(2x,e11.3),2x,4e11.3,2x,e11.3)' ) & + 'qakr ', cnst_name_extd(m)(1:10), tmpveca(1:7) + end do ! m + end if ! (pcnst < 0) then + + write(lun, '(/3a,i4)' ) 'qakr-', trim(convtype), & + ' - name; burden; sumchng3, sumactiva,resusp,aqchem,wetdep, resid,resid*dt/burden', jtsub +! write(lun, '(/2a)' ) & +! 'qakr - name; burden; sumchng3; ', & +! 'sumactiva,resusp,aqchem,wetdep,prevap; resid,resid*dtsub/burden' + tmpb = 0.0_r8 + itmpb = 0 + do m = 2, pcnst + if ( .not. doconvproc_extd(m) ) cycle + + tmpmata(:,:) = 0.0_r8 + do j = 1, 3 + l = m + if (j == 3) l = m + pcnst + if ( .not. doconvproc_extd(l) ) cycle + + if (j == 1) then + tmpmata(1,j) = sum( q_i(:,l)*dp_i(:) ) * hund_ovr_g + tmpmata(2,j) = sum( dqdt_i(:,l)*dp_i(:) ) * hund_ovr_g + tmpmata(3:7,j) = qsrflx_i(l,1:5) + else + tmpmata(1,j) = sum( const(l,1:pver)*dp_i(1:pver) ) * hund_ovr_g + tmpmata(2,j) = sumchng3( l) * hund_ovr_g + tmpmata(3,j) = sumactiva(l) * hund_ovr_g + tmpmata(4,j) = sumresusp(l) * hund_ovr_g + tmpmata(5,j) = sumaqchem(l) * hund_ovr_g + tmpmata(6,j) = sumwetdep(l) * hund_ovr_g + tmpmata(7,j) = sumprevap(l) * hund_ovr_g + end if + end do ! j + + tmpmata(3:7,2) = tmpmata(3:7,2) - tmpmata(3:7,3) ! because lc values were added onto la + do j = 1, 3 + tmpmata(8,j) = tmpmata(2,j) - sum( tmpmata(3:7,j) ) ! residual + tmpa = max( tmpmata(1,min(j,2)), 1.0e-20_r8 ) + tmpmata(9,j) = tmpmata(8,j) * dtsub / tmpa + if (abs(tmpmata(9,j)) > tmpb) then + tmpb = abs(tmpmata(9,j)) + itmpb = m + end if + end do + +! write(lun, '(/2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & +! 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:6,1), tmpmata(8:9,1) + write(lun, '(/2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & + 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:9,1) +! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & +! 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:6,2), tmpmata(8:9,2) + write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & + 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:9,2) + if ( .not. doconvproc_extd(l) ) cycle +! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & +! 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:6,3), tmpmata(8:9,3) + write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & + 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:9,3) + end do ! m + write(lun, '(/3a,2i4,1p,e11.2)' ) 'qakr-', trim(convtype), & + ' - max(resid*dt/burden)', jtsub, itmpb, tmpb + + end if ! (idiag_in(icol) > 0) then + + + if (jtsub < ntsub) then + ! update the q_i for the next interation of the jtsub loop + do m = 2, ncnst + if (doconvproc(m)) then + do k = ktop, kbot + q_i(k,m) = max( (q_i(k,m) + dqdt_i(k,m)*dtsub), 0.0_r8 ) + end do + end if + end do ! m + end if + + end do ipass_calc_updraft_loop + + end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop + + + end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop + + return +end subroutine ma_convproc_tend + + + +!========================================================================================= + subroutine ma_precpevap_convproc( & + dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop, pcnst_extd, & + lun, idiag_prevap, lchnk, & + doconvproc_extd ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of wet-removed aerosol species resulting +! precip evaporation +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ppgrid, only: pcols, pver + use constituents, only: pcnst + + use modal_aero_data, only: & + lmassptrcw_amode, nspec_amode, numptrcw_amode + + implicit none + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + integer, intent(in) :: pcnst_extd + + real(r8), intent(inout) :: dcondt(pcnst_extd,pver) + ! overall TMR tendency from convection + real(r8), intent(in) :: dcondt_wetdep(pcnst_extd,pver) + ! portion of TMR tendency due to wet removal + real(r8), intent(inout) :: dcondt_prevap(pcnst_extd,pver) + ! portion of TMR tendency due to precip evaporation + ! (actually, due to the adjustments made here) + ! (on entry, this is 0.0) + + real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered) + real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered) + real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) + + integer, intent(in) :: icol ! normal (ungathered) i index for current column + integer, intent(in) :: ktop ! index of top cloud level for current column + integer, intent(in) :: lun ! logical unit for diagnostic output + integer, intent(in) :: idiag_prevap ! flag for diagnostic output + integer, intent(in) :: lchnk ! chunk index + + logical, intent(in) :: doconvproc_extd(pcnst_extd) ! indicates which species to process + +!----------------------------------------------------------------------- +! local variables + integer :: k, l, ll, m, n + real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb] + real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb] + real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb] + real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation + real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb] + real(r8) :: pr_flux_old + real(r8) :: tmpa, tmpb, tmpc, tmpd + real(r8) :: tmpdp ! delta-pressure (mb) + real(r8) :: wd_flux(pcnst_extd) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb] +!----------------------------------------------------------------------- + + + pr_flux = 0.0_r8 + wd_flux(:) = 0.0_r8 + + if (idiag_prevap > 0) then + write(lun,'(a,i9,i4,5x,a)') 'qakx - lchnk,i', lchnk, icol, & + '// k; pr_flux old,new; delprod,devap; mode-1 numb wetdep,prevap; mass ...' + end if + + do k = ktop, pver + tmpdp = dp_i(k) + + pr_flux_old = pr_flux + del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k)) + pr_flux = pr_flux_old + del_pr_flux_prod + + del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) ) + fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8) + + do m = 2, pcnst_extd + if ( doconvproc_extd(m) ) then + ! use -dcondt_wetdep(m,k) as it is negative (or zero) + wd_flux(m) = wd_flux(m) + tmpdp*max(0.0_r8, -dcondt_wetdep(m,k)) + del_wd_flux_evap = wd_flux(m)*fdel_pr_flux_evap + wd_flux(m) = max( 0.0_r8, wd_flux(m)-del_wd_flux_evap ) + + dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp + dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k) + end if + end do + + pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) + + if (idiag_prevap > 0) then + n = 1 + l = numptrcw_amode(n) + pcnst + tmpa = dcondt_wetdep(l,k) + tmpb = dcondt_prevap(l,k) + tmpc = 0.0_r8 + tmpd = 0.0_r8 + do ll = 1, nspec_amode(n) + l = lmassptrcw_amode(ll,n) + pcnst + tmpc = tmpc + dcondt_wetdep(l,k) + tmpd = tmpd + dcondt_prevap(l,k) + end do + write(lun,'(a,i4,1p,4(2x,2e10.2))') 'qakx', k, & + pr_flux_old, pr_flux, del_pr_flux_prod, -del_pr_flux_evap, & + -tmpa, tmpb, -tmpc, tmpd + end if + end do ! k + + return + end subroutine ma_precpevap_convproc + + + +!========================================================================================= + subroutine ma_activate_convproc( & + conu, dconudt, conent, & + f_ent, dt_u, wup, & + tair, rhoair, fracice, & + pcnst_extd, lun, idiag_act, & + lchnk, i, k, & + ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! conent(l) = TMR of air that is entrained into the updraft from level k +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr ma_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment, +! and is equal to +! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l) +! where +! conu_below(l) = updraft TMR at the k+1/k interface, and +! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux +! from level k entrainment +! +! This routine applies aerosol activation to the entrained tracer, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conent(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! Note: At the lowest layer with cloud water, subr convproc calls this +! routine with conent==conu and f_ent==1.0, with the result that +! activation is applied to the entire updraft tracer flux +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ppgrid, only: pver + use constituents, only: pcnst, cnst_name + use ndrop, only: activate_modal + + use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & + ntot_amode, & + nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & + sigmag_amode, specdens_amode, spechygro, & + voltonumblo_amode, voltonumbhi_amode + + implicit none + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + integer, intent(in) :: pcnst_extd + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(pcnst_extd) + ! conent = TMRs in the entrained air at this level + real(r8), intent(in) :: conent(pcnst_extd) + real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + + real(r8), intent(in) :: fracice ! Fraction of ice within the cloud + ! used as in-cloud wet removal rate + integer, intent(in) :: lun ! logical unit for diagnostic output + integer, intent(in) :: idiag_act ! flag for diagnostic output + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: i ! column index + integer, intent(in) :: k ! level index + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, ll, la, lc, n + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_modal + real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_modal + real(r8) :: flux_fullact ! to understand this, see subr activate_modal + real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated + real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated + real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act + real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + +!----------------------------------------------------------------------- + + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + + delact = dconudt(lc)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(la) ) + delact = max( delact, 0.0_r8 ) + conu(la) = conu(la) - delact + conu(lc) = conu(lc) + delact + dconudt(la) = -delact*dt_u_inv + dconudt(lc) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + return + + end if ! (ipass_calc_updraft == 2) + + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + + do n = 1, ntot_amode +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do ll = 1, nspec_amode(n) + tmpc = max( conent(lmassptr_amode(ll,n)), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conent(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) + tmpc = tmpc / specdens_amode(ll,n) + tmpa = tmpa + tmpc + tmpb = tmpb + tmpc * spechygro(ll,n) + end do + vaerosol(n) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(n) = 0.2_r8 + else + hygro(n) = tmpb/tmpa + end if + +! load a (or a+cw) number and bound it + tmpa = max( conent(numptr_amode(n)), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conent(numptrcw_amode(n)+pcnst), 0.0_r8 ) + naerosol(n) = tmpa * rhoair + naerosol(n) = max( naerosol(n), & + vaerosol(n)*voltonumbhi_amode(n) ) + naerosol(n) = min( naerosol(n), & + vaerosol(n)*voltonumblo_amode(n) ) + +! diagnostic output for testing/development +! if (lun > 0) then +! if (n == 1) then +! write(lun,9500) +! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) +! write(lun,9520) tair, rhoaircgs, airconcgs +! end if +! write(lun,9530) n, ntype(n), vaerosol +! write(lun,9540) naerosol(n), tmp*airconcgs, & +! voltonumbhi_amode(n), voltonumblo_amode(n) +! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) +!9500 format( / 'activate_conv output -- conu values' ) +!9510 format( 3( a, 1pe11.3, 4x ) ) +!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) +!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) +!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) +!9550 format( 'masses ', 6(1pe11.3) ) +! end if + + end do + + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + +! -ubroutine activate_modal( & +! wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & +! na, pmode, nmode, volume, sigman, hygro, & +! fn, fm, fluxn, fluxm, flux_fullact ) +! real(r8) wbar ! grid cell mean vertical velocity (m/s) +! real(r8) sigw ! subgrid standard deviation of vertical vel (m/s) +! real(r8) wdiab ! diabatic vertical velocity (0 if adiabatic) +! real(r8) wminf ! minimum updraft velocity for integration (m/s) +! real(r8) wmaxf ! maximum updraft velocity for integration (m/s) +! real(r8) tair ! air temperature (K) +! real(r8) rhoair ! air density (kg/m3) +! real(r8) na(pmode) ! aerosol number concentration (/m3) +! integer pmode ! dimension of modes +! integer nmode ! number of aerosol modes +! real(r8) volume(pmode) ! aerosol volume concentration (m3/m3) +! real(r8) sigman(pmode) ! geometric standard deviation of aerosol size distribution +! real(r8) hygro(pmode) ! hygroscopicity of aerosol mode + !call activate_modal( & !BSINGH- in CAM5_1_31, the arg. list of activate_modal has reduced + ! wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + ! naerosol, ntot_amode, ntot_amode, vaerosol, sigmag_amode, hygro, & + ! fn, fm, fluxn, fluxm, flux_fullact ) + + call activate_modal( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, ntot_amode, vaerosol, hygro, &!BSINGH- A repeated 'ntot_amode' and 'sigmag_amode' is deleted from the arg. list + fn, fm, fluxn, fluxm, flux_fullact ) + + + +! diagnostic output for testing/development + if (idiag_act > 0) then + n = min( ntot_amode, 3 ) + write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & + 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & + naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & + hygro(1:n), fn(1:n), fm(1:n) + ! convert naer, vaer to number and (approx) mass TMRs + end if +! if (lun > 0) then +! write(lun,9560) (fn(n), n=1,ntot_amode) +! write(lun,9570) (fm(n), n=1,ntot_amode) +!9560 format( 'fnact values ', 6(1pe11.3) ) +!9570 format( 'fmact values ', 6(1pe11.3) ) +! end if + + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + tmp_fact = fn(n) + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + tmp_fact = fm(n) + end if + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conent(la)*tmp_fact*f_ent, conu(la) ) + delact = max( delact, 0.0_r8 ) + conu(la) = conu(la) - delact + conu(lc) = conu(lc) + delact + dconudt(la) = -delact*dt_u_inv + dconudt(lc) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + + return + end subroutine ma_activate_convproc + + + +!========================================================================================= + subroutine ma_activate_convproc_method2( & + conu, dconudt, & + f_ent, dt_u, wup, & + tair, rhoair, fracice, & + pcnst_extd, lun, idiag_act, & + lchnk, i, k, & + kactfirst, ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr ma_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment. +! +! This routine applies aerosol activation to the conu tracer mixing ratios, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - conu(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conu(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! At cloud base (k==kactfirst), primary activation is done using the +! "standard" code in subr activate do diagnose maximum supersaturation. +! Above cloud base, secondary activation is done using a +! prescribed supersaturation. +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ppgrid, only: pver + use constituents, only: pcnst, cnst_name + use ndrop, only: activate_modal + + use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & + ntot_amode, & + nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & + sigmag_amode, specdens_amode, spechygro, & + voltonumblo_amode, voltonumbhi_amode + + implicit none + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + integer, intent(in) :: pcnst_extd + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(pcnst_extd) + real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + + real(r8), intent(in) :: fracice ! Fraction of ice within the cloud + ! used as in-cloud wet removal rate + integer, intent(in) :: lun ! logical unit for diagnostic output + integer, intent(in) :: idiag_act ! flag for diagnostic output + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: i ! column index + integer, intent(in) :: k ! level index + integer, intent(in) :: kactfirst ! k at cloud base + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, ll, la, lc, n + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_modal + real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_modal + real(r8) :: flux_fullact ! to understand this, see subr activate_modal + real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated + real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated + real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act + real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction) + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + +!----------------------------------------------------------------------- + + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + + delact = dconudt(lc)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(la) ) + delact = max( delact, 0.0_r8 ) + conu(la) = conu(la) - delact + conu(lc) = conu(lc) + delact + dconudt(la) = -delact*dt_u_inv + dconudt(lc) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + return + + end if ! (ipass_calc_updraft == 2) + + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + + do n = 1, ntot_amode +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do ll = 1, nspec_amode(n) + tmpc = max( conu(lmassptr_amode(ll,n)), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conu(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) + tmpc = tmpc / specdens_amode(ll,n) + tmpa = tmpa + tmpc + tmpb = tmpb + tmpc * spechygro(ll,n) + end do + vaerosol(n) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(n) = 0.2_r8 + else + hygro(n) = tmpb/tmpa + end if + +! load a (or a+cw) number and bound it + tmpa = max( conu(numptr_amode(n)), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conu(numptrcw_amode(n)+pcnst), 0.0_r8 ) + naerosol(n) = tmpa * rhoair + naerosol(n) = max( naerosol(n), & + vaerosol(n)*voltonumbhi_amode(n) ) + naerosol(n) = min( naerosol(n), & + vaerosol(n)*voltonumblo_amode(n) ) + +! diagnostic output for testing/development +! if (lun > 0) then +! if (n == 1) then +! write(lun,9500) +! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) +! write(lun,9520) tair, rhoaircgs, airconcgs +! end if +! write(lun,9530) n, ntype(n), vaerosol +! write(lun,9540) naerosol(n), tmp*airconcgs, & +! voltonumbhi_amode(n), voltonumblo_amode(n) +! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) +!9500 format( / 'activate_conv output -- conu values' ) +!9510 format( 3( a, 1pe11.3, 4x ) ) +!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) +!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) +!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) +!9550 format( 'masses ', 6(1pe11.3) ) +! end if + + end do + + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + +! -ubroutine activate_modal( & +! wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & +! na, pmode, nmode, volume, sigman, hygro, & +! fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) +! real(r8) wbar ! grid cell mean vertical velocity (m/s) +! real(r8) sigw ! subgrid standard deviation of vertical vel (m/s) +! real(r8) wdiab ! diabatic vertical velocity (0 if adiabatic) +! real(r8) wminf ! minimum updraft velocity for integration (m/s) +! real(r8) wmaxf ! maximum updraft velocity for integration (m/s) +! real(r8) tair ! air temperature (K) +! real(r8) rhoair ! air density (kg/m3) +! real(r8) na(pmode) ! aerosol number concentration (/m3) +! integer pmode ! dimension of modes +! integer nmode ! number of aerosol modes +! real(r8) volume(pmode) ! aerosol volume concentration (m3/m3) +! real(r8) sigman(pmode) ! geometric standard deviation of aerosol size distribution +! real(r8) hygro(pmode) ! hygroscopicity of aerosol mode +! real(r8), optional :: smax_prescribed ! prescribed max. supersaturation for secondary activation + if (k == kactfirst) then +! at cloud base - do primary activation + !call activate_modal( &!BSINGH- in CAM5_1_31, the arg. list of activate_modal has reduced + ! wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + ! naerosol, ntot_amode, ntot_amode, vaerosol, sigmag_amode, hygro, & + ! fn, fm, fluxn, fluxm, flux_fullact ) + + call activate_modal( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, ntot_amode, vaerosol, hygro, &!BSINGH- A repeated 'ntot_amode' and 'sigmag_amode' is deleted from the arg. list + fn, fm, fluxn, fluxm, flux_fullact ) + + + else +! above cloud base - do secondary activation with prescribed supersat +! that is constant with height + smax_prescribed = method2_activate_smaxmax + !call activate_modal( &!BSINGH- in CAM5_1_31, the arg. list of activate_modal has reduced + ! wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + ! naerosol, ntot_amode, ntot_amode, vaerosol, sigmag_amode, hygro, & + ! fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) + call activate_modal( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, ntot_amode, vaerosol, hygro, &!BSINGH- A repeated 'ntot_amode' and 'sigmag_amode' is deleted from the arg. list + fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) + end if + + +! diagnostic output for testing/development + if (idiag_act > 0) then + n = min( ntot_amode, 3 ) + write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & + 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & + naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & + hygro(1:n), fn(1:n), fm(1:n) + ! convert naer, vaer to number and (approx) mass TMRs + end if +! if (lun > 0) then +! write(lun,9560) (fn(n), n=1,ntot_amode) +! write(lun,9570) (fm(n), n=1,ntot_amode) +!9560 format( 'fnact values ', 6(1pe11.3) ) +!9570 format( 'fmact values ', 6(1pe11.3) ) +! end if + + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + tmp_fact = fn(n) + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + tmp_fact = fm(n) + end if + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conu(la)*tmp_fact, conu(la) ) + delact = max( delact, 0.0_r8 ) + conu(la) = conu(la) - delact + conu(lc) = conu(lc) + delact + dconudt(la) = -delact*dt_u_inv + dconudt(lc) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + + return + end subroutine ma_activate_convproc_method2 + + + +!========================================================================================= + subroutine ma_resuspend_convproc( & + dcondt, dcondt_resusp, & + const, dp_i, ktop, kbot, pcnst_extd ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of activated aerosol species resulting from both +! detrainment from updraft and downdraft into environment +! subsidence and lifting of environment, which may move air from +! levels with large-scale cloud to levels with no large-scale cloud +! +! Method: +! Three possible approaches were considered: +! +! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! ratio of dcondt (activated/unactivate) is equal to the ratio of the +! mixing ratios before convection. +! THIS WAS IMPLEMENTED IN MIRAGE2 +! +! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! change to the activated portion is minimized (zero if possible). The +! would minimize effects of convection on the large-scale cloud. +! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective +! clouds have no impact on the stratiform-cloudborne aerosol +! +! 3. Mechanistic approach that treats the details of interactions between +! the large-scale and convective clouds. (Something for the future.) +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ppgrid, only: pver + use constituents, only: pcnst + + use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & + nspec_amode, ntot_amode, numptr_amode, numptrcw_amode + + implicit none + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + integer, intent(in) :: pcnst_extd + real(r8), intent(inout) :: dcondt(pcnst_extd,pver) + ! overall TMR tendency from convection + real(r8), intent(inout) :: dcondt_resusp(pcnst_extd,pver) + ! portion of TMR tendency due to resuspension + ! (actually, due to the adjustments made here) + real(r8), intent(in) :: const(pcnst_extd,pver) ! TMRs before convection + + real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) + integer, intent(in) :: ktop, kbot ! indices of top and bottom cloud levels + +!----------------------------------------------------------------------- +! local variables + integer :: k, ll, la, lc, n + real(r8) :: qa, qc, qac ! working variables (mixing ratios) + real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies) +!----------------------------------------------------------------------- + + + do n = 1, ntot_amode + + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + +! apply adjustments to dcondt for pairs of unactivated (la) and +! activated (lc) aerosol species + if ( (la <= 0) .or. (la > pcnst_extd) ) cycle + if ( (lc <= 0) .or. (lc > pcnst_extd) ) cycle + + do k = ktop, kbot + qdota = dcondt(la,k) + qdotc = dcondt(lc,k) + qdotac = qdota + qdotc + +! mirage2 approach +! qa = max( const(la,k), 0.0_r8 ) +! qc = max( const(lc,k), 0.0_r8 ) +! qac = qa + qc +! if (qac <= 0.0) then +! dcondt(la,k) = qdotac +! dcondt(lc,k) = 0.0 +! else +! dcondt(la,k) = qdotac*(qa/qac) +! dcondt(lc,k) = qdotac*(qc/qac) +! end if + +! cam5 approach + dcondt(la,k) = qdotac + dcondt(lc,k) = 0.0_r8 + + dcondt_resusp(la,k) = (dcondt(la,k) - qdota) + dcondt_resusp(lc,k) = (dcondt(lc,k) - qdotc) + end do + + end do ! "ll = -1, nspec_amode(n)" + end do ! "n = 1, ntot_amode" + + return + end subroutine ma_resuspend_convproc + + + +!========================================================================================= + + + +end module modal_aero_convproc diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/modal_aero/modal_aero_data.F90 new file mode 100644 index 0000000000..e45d254dcc --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_data.F90 @@ -0,0 +1,1204 @@ + module modal_aero_data + +!-------------------------------------------------------------- +! ... Basic aerosol mode parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst, cnst_mw, cnst_name, cnst_get_ind, cnst_set_convtran2, & + cnst_set_spec_class, cnst_spec_class_aerosol, cnst_spec_class_undefined, & + cnst_species_class, cnst_spec_class_gas + use physics_buffer, only: pbuf_add_field, dtype_r8 + use time_manager, only: is_first_step + use phys_control, only: phys_getopts + use infnan, only: nan, assignment(=) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, begchunk, endchunk + use mo_tracname, only: solsym + use chem_mods, only: gas_pcnst + use radconstants, only: nswbands, nlwbands + use shr_const_mod, only: pi => shr_const_pi + use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_mode_props + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk + + implicit none + private + + public :: modal_aero_data_init + public :: modal_aero_data_reg + public :: qqcw_get_field + + integer, public, protected :: nsoa = 0 + integer, public, protected :: npoa = 0 + integer, public, protected :: nbc = 0 + integer, public, protected :: nspec_max = 0 + integer, public, protected :: ntot_amode = 0 + integer, public, protected :: nSeaSalt=0, nDust=0 + integer, public, protected :: nSO4=0, nNH4=0 + + ! + ! definitions for aerosol chemical components + ! + + real(r8), public, protected, allocatable :: specmw_amode(:,:) + character(len=16), public, protected, allocatable :: modename_amode(:) + + integer, public, protected, allocatable :: nspec_amode(:) + + character(len=20), public, protected :: cnst_name_cw( pcnst ) + + ! input mprognum_amode, mdiagnum_amode, mprogsfc_amode, mcalcwater_amode + integer, public, protected, allocatable :: mprognum_amode(:) + integer, public, protected, allocatable :: mdiagnum_amode(:) + integer, public, protected, allocatable :: mprogsfc_amode(:) + integer, public, protected, allocatable :: mcalcwater_amode(:) + + ! input dgnum_amode, dgnumlo_amode, dgnumhi_amode (units = m) + real(r8), public, protected, allocatable :: dgnum_amode(:) + real(r8), public, protected, allocatable :: dgnumlo_amode(:) + real(r8), public, protected, allocatable :: dgnumhi_amode(:) + + ! input sigmag_amode + real(r8), public, protected, allocatable :: sigmag_amode(:) + + ! input crystalization and deliquescence points + real(r8), allocatable :: rhcrystal_amode(:) + real(r8), allocatable :: rhdeliques_amode(:) + + + integer, public, protected, allocatable :: & + lmassptr_amode( :, : ), & + lmassptrcw_amode( :, : ), & + numptr_amode( : ), & + numptrcw_amode( : ) + + real(r8), public, protected, allocatable :: & + alnsg_amode( : ), & + voltonumb_amode( : ), & + voltonumblo_amode( : ), & + voltonumbhi_amode( : ), & + alnv2n_amode( : ), & + alnv2nlo_amode( : ), & + alnv2nhi_amode( : ), & + specdens_amode(:,:), & + spechygro(:,:) + + integer, public, protected, allocatable :: & + lptr_so4_a_amode(:), lptr_so4_cw_amode(:), & + lptr_msa_a_amode(:), lptr_msa_cw_amode(:), & + lptr_nh4_a_amode(:), lptr_nh4_cw_amode(:), & + lptr_no3_a_amode(:), lptr_no3_cw_amode(:), & + lptr_nacl_a_amode(:), lptr_nacl_cw_amode(:),& + lptr_dust_a_amode(:), lptr_dust_cw_amode(:) + + integer, public, protected :: & + modeptr_accum, modeptr_aitken, & + modeptr_ufine, modeptr_coarse, & + modeptr_pcarbon, & + modeptr_finedust, modeptr_fineseas, & + modeptr_coardust, modeptr_coarseas + + !2D lptr variables added by RCE to access speciated species + integer, public, protected, allocatable :: & + lptr2_bc_a_amode(:,:), lptr2_bc_cw_amode(:,:), & + lptr2_pom_a_amode(:,:), lptr2_pom_cw_amode(:,:), & + lptr2_soa_a_amode(:,:), lptr2_soa_cw_amode(:,:), & + lptr2_soa_g_amode(:) + + real(r8), public, protected :: specmw_so4_amode + + logical, public, protected :: soa_multi_species = .false. + + character(len=16), allocatable :: xname_massptr(:,:) ! names of species in each mode + character(len=16), allocatable :: xname_massptrcw(:,:) ! names of cloud-borne species in each mode + + complex(r8), allocatable :: & + specrefndxsw( :,:,: ), & + specrefndxlw( :,:,: ) + + character(len=8), allocatable :: & + aodvisname(: ), & + ssavisname(: ) + character(len=48), allocatable :: & + aodvislongname(: ), & + ssavislongname(: ) + + character(len=8), allocatable :: & + fnactname(: ), & + fmactname(: ), & + nactname(: ) + + character(len=48), allocatable :: & + fnactlongname(: ), & + fmactlongname(: ), & + nactlongname(: ) + + + ! threshold for reporting negatives from subr qneg3 + real(r8) :: qneg3_worst_thresh_amode(pcnst) + + integer :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf + + logical :: convproc_do_aer + logical :: cam_do_aero_conv = .true. + contains + +!-------------------------------------------------------------- +!-------------------------------------------------------------- + subroutine modal_aero_data_reg + + character(len=6) :: xname_numptr, xname_numptrcw + character(len=1) :: modechr + integer :: m, l, iptr,i, n, tot_spec, idx + character(len=3) :: trnum ! used to hold mode number (as characters) + + character(len=20) :: dumStr1, specNameMode + character(len=1000) :: msg + character(len=32) :: spec_name, mode_type + character(len=1) :: modestr + + call rad_cnst_get_info( 0, nmodes=ntot_amode ) + allocate( nspec_amode(ntot_amode) ) + allocate( numptr_amode(ntot_amode) ) + allocate( numptrcw_amode(ntot_amode) ) + allocate(modename_amode(ntot_amode)) + allocate(mprognum_amode(ntot_amode)) + allocate(mdiagnum_amode(ntot_amode)) + allocate(mprogsfc_amode(ntot_amode)) + allocate(mcalcwater_amode(ntot_amode)) + mprognum_amode(:) = 1 + mdiagnum_amode(:) = 0 + mprogsfc_amode(:) = 0 + if (ntot_amode==7) then + mcalcwater_amode(:) = 1 + else + mcalcwater_amode(:) = 0 + endif + allocate(dgnum_amode(ntot_amode)) + allocate(dgnumlo_amode(ntot_amode)) + allocate(dgnumhi_amode(ntot_amode)) + allocate(sigmag_amode(ntot_amode)) + allocate(rhcrystal_amode(ntot_amode)) + allocate(rhdeliques_amode(ntot_amode)) + allocate( & + alnsg_amode( ntot_amode ), & ! + voltonumb_amode( ntot_amode ), & ! + voltonumblo_amode( ntot_amode ), & ! + voltonumbhi_amode( ntot_amode ), & ! + alnv2n_amode( ntot_amode ), & ! + alnv2nlo_amode( ntot_amode ), & ! + alnv2nhi_amode( ntot_amode ), & ! + aodvisname(ntot_amode ), & + ssavisname(ntot_amode ), & + fnactname(ntot_amode ), & + fmactname(ntot_amode ), & + nactname(ntot_amode ), & + fnactlongname(ntot_amode ), & + fmactlongname(ntot_amode ), & + nactlongname(ntot_amode ), & + lptr_so4_a_amode(ntot_amode), lptr_so4_cw_amode(ntot_amode), & + lptr_msa_a_amode(ntot_amode), lptr_msa_cw_amode(ntot_amode), & + lptr_nh4_a_amode(ntot_amode), lptr_nh4_cw_amode(ntot_amode), & + lptr_nacl_a_amode(ntot_amode), lptr_nacl_cw_amode(ntot_amode), & + lptr_dust_a_amode(ntot_amode), lptr_dust_cw_amode(ntot_amode), & + lptr_no3_a_amode(ntot_amode), lptr_no3_cw_amode(ntot_amode) & + ) + + allocate( & + aodvislongname(ntot_amode ), & + ssavislongname(ntot_amode ) & + ) + + do m = 1, ntot_amode + call rad_cnst_get_info(0, m, mode_type=mode_type, nspec=nspec_amode(m)) + modename_amode(m) = mode_type + ! count number of soa, poa, and bc bins in mode 1 + if (m==1) then + do l = 1, nspec_amode(m) + call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + if (spec_name(:3) == 'soa') nsoa=nsoa+1 + if (spec_name(:3) == 'pom') npoa=npoa+1 + if (spec_name(:2) == 'bc' ) nbc =nbc +1 + enddo + endif + enddo + + soa_multi_species = nsoa > 1 + + nspec_max = maxval( nspec_amode ) + + allocate ( specdens_amode(nspec_max,ntot_amode) ) + allocate ( spechygro(nspec_max,ntot_amode) ) + allocate ( specmw_amode(nspec_max,ntot_amode) ) + allocate ( xname_massptr(nspec_max,ntot_amode) ) + allocate ( xname_massptrcw(nspec_max,ntot_amode) ) + specmw_amode = nan + xname_massptr(:,:) = ' ' + xname_massptrcw(:,:) = ' ' + + do m = 1, ntot_amode + do l = 1, nspec_amode(m) + call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + xname_massptr(l,m) = spec_name + write(modestr,'(I1)') m + idx = index( xname_massptr(l,m), '_' ) + xname_massptrcw(l,m) = xname_massptr(l,m)(:idx-1)//'_c'//modestr + if (xname_massptr(l,m)(:3) == 'dst') nDust=nDust+1 + if (xname_massptr(l,m)(:3) == 'ncl') nSeaSalt=nSeaSalt+1 + if (xname_massptr(l,m)(:3) == 'nh4') nNH4=nNH4+1 + if (xname_massptr(l,m)(:3) == 'so4') nSO4=nSO4+1 + enddo + enddo + + allocate( & + lmassptr_amode( nspec_max, ntot_amode ),& + lmassptrcw_amode( nspec_max, ntot_amode ),& + lptr2_pom_a_amode(ntot_amode,npoa), lptr2_pom_cw_amode(ntot_amode,npoa), & + lptr2_soa_a_amode(ntot_amode,nsoa), lptr2_soa_cw_amode(ntot_amode,nsoa), & + lptr2_bc_a_amode(ntot_amode,nbc), lptr2_bc_cw_amode(ntot_amode,nbc), & + lptr2_soa_g_amode(nsoa) & + ) + lptr2_soa_g_amode = -999999 + + allocate( specrefndxsw(nswbands,nspec_max,ntot_amode ) ) + allocate( specrefndxlw(nlwbands,nspec_max,ntot_amode) ) + + do m = 1, ntot_amode + if(nspec_amode(m).gt.nspec_max)then + write(iulog,*)'modal_aero_data_reg: nspec_amode(m).gt.nspec_max ' + write(iulog,*)'modal_aero_data_reg: m,nspec_amode(m), nspec_max=',m, nspec_amode(m), nspec_max + call endrun('modal_aero_data_reg: nspec_amode(m).gt.nspec_max ') + end if + end do + + call phys_getopts(convproc_do_aer_out = convproc_do_aer) + if (convproc_do_aer) cam_do_aero_conv = .false. + + do m = 1, ntot_amode + write(modechr,fmt='(I1)') m + xname_numptr = 'num_a'//modechr + xname_numptrcw = 'num_c'//modechr + + if (masterproc) then + write(iulog,9231) m, modename_amode(m) + write(iulog,9232) & + 'nspec ', & + nspec_amode(m) + write(iulog,9232) & + 'mprognum, mdiagnum, mprogsfc', & + mprognum_amode(m), mdiagnum_amode(m), mprogsfc_amode(m) + write(iulog,9232) & + 'mcalcwater ', & + mcalcwater_amode(m) + endif + + ! define species to hold interstitial & activated number + call search_list_of_names( & + xname_numptr, numptr_amode(m), cnst_name, pcnst ) + if (numptr_amode(m) .le. 0) then + write(iulog,9061) 'xname_numptr', xname_numptr, m + call endrun('modal_aero_data_reg: numptr_amode(m) .le. 0') + end if + if (numptr_amode(m) .gt. pcnst) then + write(iulog,9061) 'numptr_amode', numptr_amode(m), m + write(iulog,9061) 'xname_numptr', xname_numptr, m + call endrun('modal_aero_data_reg: numptr_amode(m) .gt. pcnst') + end if + + call cnst_set_spec_class(numptr_amode(m), cnst_spec_class_aerosol) + call cnst_set_convtran2(numptr_amode(m), cam_do_aero_conv) + + numptrcw_amode(m) = numptr_amode(m) !use the same index for Q and QQCW arrays + if (numptrcw_amode(m) .le. 0) then + write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m + call endrun('modal_aero_data_reg: numptrcw_amode(m) .le. 0') + end if + if (numptrcw_amode(m) .gt. pcnst) then + write(iulog,9061) 'numptrcw_amode', numptrcw_amode(m), m + write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m + call endrun('modal_aero_data_reg: numptrcw_amode(m) .gt. pcnst') + end if + + call pbuf_add_field(xname_numptrcw,'global',dtype_r8,(/pcols,pver/),iptr) + call qqcw_set_ptr(numptrcw_amode(m),iptr) + + ! output mode information + if ( masterproc ) then + write(iulog,9233) 'numptr ', & + numptr_amode(m), xname_numptr + write(iulog,9233) 'numptrcw ', & + numptrcw_amode(m), xname_numptrcw + end if + + ! define the chemical species for the mode + do l = 1, nspec_amode(m) + + call search_list_of_names( & + xname_massptr(l,m), lmassptr_amode(l,m), cnst_name, pcnst ) + if (lmassptr_amode(l,m) .le. 0) then + write(iulog,9062) 'xname_massptr', xname_massptr(l,m), l, m + write(iulog,'(10(a8,1x))')(cnst_name(i),i=1,pcnst) + call endrun('modal_aero_data_reg: lmassptr_amode(l,m) .le. 0') + end if + call cnst_set_spec_class(lmassptr_amode(l,m), cnst_spec_class_aerosol) + call cnst_set_convtran2(lmassptr_amode(l,m), cam_do_aero_conv) + + lmassptrcw_amode(l,m) = lmassptr_amode(l,m) !use the same index for Q and QQCW arrays + if (lmassptrcw_amode(l,m) .le. 0) then + write(iulog,9062) 'xname_massptrcw', xname_massptrcw(l,m), l, m + call endrun('modal_aero_data_reg: lmassptrcw_amode(l,m) .le. 0') + end if + call pbuf_add_field(xname_massptrcw(l,m),'global',dtype_r8,(/pcols,pver/),iptr) + call qqcw_set_ptr(lmassptrcw_amode(l,m), iptr) + + if ( masterproc ) then + write(iulog,9236) 'spec, massptr ', l, & + lmassptr_amode(l,m), xname_massptr(l,m) + write(iulog,9236) 'spec, massptrcw', l, & + lmassptrcw_amode(l,m), xname_massptrcw(l,m) + end if + + end do + + ! set names for aodvis and ssavis + write(unit=trnum,fmt='(i3)') m+100 + + aodvisname(m) = 'AODVIS'//trnum(2:3) + aodvislongname(m) = 'Aerosol optical depth for mode '//trnum(2:3) + ssavisname(m) = 'SSAVIS'//trnum(2:3) + ssavislongname(m) = 'Single-scatter albedo for mode '//trnum(2:3) + fnactname(m) = 'FNACT'//trnum(2:3) + fnactlongname(m) = 'Number faction activated for mode '//trnum(2:3) + fmactname(m) = 'FMACT'//trnum(2:3) + fmactlongname(m) = 'Fraction mass activated for mode'//trnum(2:3) + end do + + ! At this point, species_class is either undefined or aerosol. + ! For the "chemistry species" set the undefined ones to gas, + ! and leave the aerosol ones as is + do i = 1, gas_pcnst + call cnst_get_ind(solsym(i), idx, abort=.false.) + if (idx > 0) then + if (cnst_species_class(idx) == cnst_spec_class_undefined) then + call cnst_set_spec_class(idx, cnst_spec_class_gas) + end if + end if + end do + + if (masterproc) write(iulog,9230) +9230 format( // '*** init_aer_modes mode definitions' ) +9231 format( 'mode = ', i4, ' = "', a, '"' ) +9232 format( 4x, a, 4(1x, i5 ) ) +9233 format( 4x, a15, 4x, i7, '="', a, '"' ) +9236 format( 4x, a15, i4, i7, '="', a, '"' ) +9061 format( '*** subr modesmodal_aero_data_reg - bad ', a / & + 5x, 'name, m = ', a, 5x, i5 ) +9062 format( '*** subr modal_aero_data_reg - bad ', a / & + 5x, 'name, l, m = ', a, 5x, 2i5 ) + end subroutine modal_aero_data_reg + +!-------------------------------------------------------------- +!-------------------------------------------------------------- + subroutine modal_aero_data_init(pbuf2d) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !-------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------- + integer :: l, m, i, lchnk + integer :: m_idx, s_idx, ndx + + character(len=3) :: trnum ! used to hold mode number (as characters) + integer :: qArrIndex + integer :: numaerosols ! number of bulk aerosols in climate list + character(len=20) :: bulkname + complex(r8), pointer :: refindex_aer_sw(:), & + refindex_aer_lw(:) + real(r8), pointer :: qqcw(:,:) + real(r8), parameter :: huge_r8 = huge(1._r8) + character(len=*), parameter :: routine='modal_aero_initialize' + character(len=32) :: spec_type + character(len=32) :: spec_name + character(len=1) :: modestr + integer :: soa_ndx + + !----------------------------------------------------------------------- + + ! Mode specific properties. + do m = 1, ntot_amode + call rad_cnst_get_mode_props(0, m, & + sigmag=sigmag_amode(m), dgnum=dgnum_amode(m), dgnumlo=dgnumlo_amode(m), & + dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m)) + + ! compute frequently used parameters: ln(sigmag), + ! volume-to-number and volume-to-surface conversions, ... + alnsg_amode(m) = log( sigmag_amode(m) ) + + voltonumb_amode(m) = 1._r8 / ( (pi/6._r8)* & + (dgnum_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) ) + voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) ) + voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) ) + + alnv2n_amode(m) = log( voltonumb_amode(m) ) + alnv2nlo_amode(m) = log( voltonumblo_amode(m) ) + alnv2nhi_amode(m) = log( voltonumbhi_amode(m) ) + + end do + lptr2_soa_g_amode(:) = -1 + soa_ndx = 0 + do i = 1, pcnst + if (cnst_name(i)(:4) == 'SOAG') then + soa_ndx = soa_ndx+1 + lptr2_soa_g_amode(soa_ndx) = i + endif + enddo + if (.not.any(lptr2_soa_g_amode>0)) call endrun('modal_aero_data_init: lptr2_soa_g_amode is not set properly') + ! Properties of mode specie types. + + ! values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set + ! Report #243, Max-Planck Institute for Meteorology, 1997a + ! See also Hess, Koepke and Schult, Optical Properties of Aerosols and Clouds (OPAC) + ! BAMS, 1998. + + ! specrefndxsw(:ntot_aspectype) = (/ (1.53, 0.01), (1.53, 0.01), (1.53, 0.01), & + ! (1.55, 0.01), (1.55, 0.01), (1.90, 0.60), & + ! (1.50, 1.0e-8), (1.50, 0.005) /) + ! specrefndxlw(:ntot_aspectype) = (/ (2.0, 0.5), (2.0, 0.5), (2.0, 0.5), & + ! (1.7, 0.5), (1.7, 0.5), (2.22, 0.73), & + ! (1.50, 0.02), (2.6, 0.6) /) + ! get refractive indices from phys_prop files + + ! The following use of the rad_constituent interfaces makes the assumption that the + ! prognostic modes are used in the mode climate (index 0) list. + + if (masterproc) write(iulog,9210) + do m = 1, ntot_amode + do l = 1, nspec_amode(m) + qArrIndex = lmassptr_amode(l,m) !index of the species in the state%q array + call rad_cnst_get_aer_props(0, m, l , & + refindex_aer_sw=refindex_aer_sw, & + refindex_aer_lw=refindex_aer_lw, & + density_aer=specdens_amode(l,m), & + hygro_aer=spechygro(l,m) ) + + if ( soa_multi_species ) then + ! Molecular weight for the species + specmw_amode(l,m) = cnst_mw(qArrIndex) + else ! the follow preserves the molecular weights historically used in MAM + call rad_cnst_get_info(0, m, l, spec_type=spec_type ) + select case( spec_type ) + case('sulfate') + if (ntot_amode==7) then + specmw_amode(l,m) = 96._r8 + else + specmw_amode(l,m) = 115._r8 + endif + case('ammonium') + specmw_amode(l,m) = 18._r8 + case('p-organic','s-organic','black-c') + specmw_amode(l,m) = 12._r8 + case('seasalt') + specmw_amode(l,m) = 58.5_r8 + case('dust') + specmw_amode(l,m) = 135._r8 + case default + call endrun('modal_aero_data_init: species type not recognized: '//trim(spec_type)) + end select + endif + + if(masterproc) then + write(iulog,9212) ' name : ', cnst_name(qArrIndex) + write(iulog,9213) ' density, MW : ', specdens_amode(l,m), specmw_amode(l,m) + write(iulog,9213) ' hygro : ', spechygro(l,m) + endif + do i=1,nswbands + specrefndxsw(i,l,m)=refindex_aer_sw(i) + if(masterproc) write(iulog,9213) 'ref index sw ', (specrefndxsw(i,l,m)) + end do + do i=1,nlwbands + specrefndxlw(i,l,m)=refindex_aer_lw(i) + if(masterproc) write(iulog,9213) 'ref index ir ', (specrefndxlw(i,l,m)) + end do + + enddo + enddo + +9210 format( // '*** init_aer_modes aerosol species-types' ) +9211 format( 'spectype =', i4) +9212 format( 4x, a, 3x, '"', a, '"' ) +9213 format( 4x, a, 5(1pe14.5) ) + + ! set cnst_name_cw + call initaermodes_set_cnstnamecw() + + + ! + ! set the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ... + ! + call initaermodes_setspecptrs + + ! + ! set threshold for reporting negatives from subr qneg3 + ! for aerosol number species set this to + ! 1e3 #/kg ~= 1e-3 #/cm3 for accum, aitken, pcarbon, ufine modes + ! 3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes + ! 1e0 #/kg ~= 1e-6 #/cm3 for other modes which are coarse + ! for other species, set this to zero so that it will be ignored + ! by qneg3 + ! + if ( masterproc ) write(iulog,'(/a)') & + 'mode, modename_amode, qneg3_worst_thresh_amode' + qneg3_worst_thresh_amode(:) = 0.0_r8 + do m = 1, ntot_amode + l = numptr_amode(m) + if ((l <= 0) .or. (l > pcnst)) cycle + + if (m == modeptr_accum) then + qneg3_worst_thresh_amode(l) = 1.0e3_r8 + else if (m == modeptr_aitken) then + qneg3_worst_thresh_amode(l) = 1.0e3_r8 + else if (m == modeptr_pcarbon) then + qneg3_worst_thresh_amode(l) = 1.0e3_r8 + else if (m == modeptr_ufine) then + qneg3_worst_thresh_amode(l) = 1.0e3_r8 + + else if (m == modeptr_fineseas) then + qneg3_worst_thresh_amode(l) = 3.0e1_r8 + else if (m == modeptr_finedust) then + qneg3_worst_thresh_amode(l) = 3.0e1_r8 + + else + qneg3_worst_thresh_amode(l) = 1.0e0_r8 + end if + + if ( masterproc ) write(iulog,'(i3,2x,a,1p,e12.3)') & + m, modename_amode(m), qneg3_worst_thresh_amode(l) + end do + + if (is_first_step()) then + ! initialize cloud bourne constituents in physics buffer + + do i = 1, pcnst + do lchnk = begchunk, endchunk + qqcw => qqcw_get_field(pbuf_get_chunk(pbuf2d,lchnk), i, lchnk, .true.) + if (associated(qqcw)) then + qqcw = 1.e-38_r8 + end if + end do + end do + end if + + end subroutine modal_aero_data_init + +!-------------------------------------------------------------- +!-------------------------------------------------------------- + subroutine qqcw_set_ptr(index, iptr) + use cam_abortutils, only : endrun + + + integer, intent(in) :: index, iptr + + if(index>0 .and. index <= pcnst ) then + qqcw(index)=iptr + else + call endrun('qqcw_set_ptr: attempting to set qqcw pointer already defined') + end if + end subroutine qqcw_set_ptr + +!-------------------------------------------------------------- +!-------------------------------------------------------------- + function qqcw_get_field(pbuf, index, lchnk, errorhandle) + use cam_abortutils, only : endrun + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + integer, intent(in) :: index, lchnk + real(r8), pointer :: qqcw_get_field(:,:) + logical, optional :: errorhandle + type(physics_buffer_desc), pointer :: pbuf(:) + + logical :: error + + nullify(qqcw_get_field) + error = .false. + if (index>0 .and. index <= pcnst) then + if (qqcw(index)>0) then + call pbuf_get_field(pbuf, qqcw(index), qqcw_get_field) + else + error = .true. + endif + else + error = .true. + end if + + if (error .and. .not. present(errorhandle)) then + call endrun('qqcw_get_field: attempt to access undefined qqcw') + end if + + end function qqcw_get_field + +!---------------------------------------------------------------- +! +! nspec_max = maximum allowable number of chemical species +! in each aerosol mode +! +! ntot_amode = number of aerosol modes +! ( ntot_amode_gchm = number of aerosol modes in gchm +! ntot_amode_ccm2 = number of aerosol modes to be made known to ccm2 +! These are temporary until multi-mode activation scavenging is going. +! Until then, ntot_amode is set to either ntot_amode_gchm or +! ntot_amode_ccm2 depending on which code is active ) +! +! msectional - if positive, moving-center sectional code is utilized, +! and each mode is actually a section. +! msectional_concinit - if positive, special code is used to initialize +! the mixing ratios of all the sections. +! +! nspec_amode(m) = number of chemical species in aerosol mode m +! nspec_amode_ccm2(m) = . . . while in ccm2 code +! nspec_amode_gchm(m) = . . . while in gchm code +! nspec_amode_nontracer(m) = number of "non-tracer" chemical +! species while in gchm code +! lspectype_amode(l,m) = species type/i.d. for chemical species l +! in aerosol mode m. (1=sulfate, others to be defined) +! lmassptr_amode(l,m) = gchm r-array index for the mixing ratio +! (moles-x/mole-air) for chemical species l in aerosol mode m +! that is in clear air or interstitial air (but not in cloud water) +! lmassptrcw_amode(l,m) = gchm r-array index for the mixing ratio +! (moles-x/mole-air) for chemical species l in aerosol mode m +! that is currently bound/dissolved in cloud water +! lwaterptr_amode(m) = gchm r-array index for the mixing ratio +! (moles-water/mole-air) for water associated with aerosol mode m +! that is in clear air or interstitial air +! lkohlercptr_amode(m) = gchm r-array index for the kohler "c" parameter +! for aerosol mode m. This is defined on a per-dry-particle-mass basis: +! c = r(i,j,k,lkohlercptr_amode) * [rhodry * (4*pi/3) * rdry^3] +! numptr_amode(m) = gchm r-array index for the number mixing ratio +! (particles/mole-air) for aerosol mode m that is in clear air or +! interstitial are (but not in cloud water). If zero or negative, +! then number is not being simulated. +! ( numptr_amode_gchm(m) = same thing but for within gchm +! numptr_amode_ccm2(m) = same thing but for within ccm2 +! These are temporary, to allow testing number in gchm before ccm2 ) +! numptrcw_amode(m) = gchm r-array index for the number mixing ratio +! (particles/mole-air) for aerosol mode m +! that is currently bound/dissolved in cloud water +! lsfcptr_amode(m) = gchm r-array index for the surface area mixing ratio +! (cm^2/mole-air) for aerosol mode m that is in clear air or +! interstitial are (but not in cloud water). If zero or negative, +! then surface area is not being simulated. +! lsfcptrcw_amode(m) = gchm r-array index for the surface area mixing ratio +! (cm^2/mole-air) for aerosol mode m that is currently +! bound/dissolved in cloud water. +! lsigptr_amode(m) = gchm r-array index for sigmag for aerosol mode m +! that is in clear air or interstitial are (but not in cloud water). +! If zero or negative, then the constant sigmag_amode(m) is used. +! lsigptrcw_amode(m) = gchm r-array index for sigmag for aerosol mode m +! that is currently bound/dissolved in cloud water. +! If zero or negative, then the constant sigmag_amode(m) is used. +! lsigptrac_amode(m) = gchm r-array index for sigmag for aerosol mode m +! for combined clear-air/interstial plus bound/dissolved in cloud water. +! If zero or negative, then the constant sigmag_amode(m) is used. +! +! dgnum_amode(m) = geometric dry mean diameter (m) of the number +! distribution for aerosol mode m. +! (Only used when numptr_amode(m) is zero or negative.) +! dgnumlo_amode(m), dgnumhi_amode(m) = lower and upper limits on the +! geometric dry mean diameter (m) of the number distribution +! (Used when mprognum_amode>0, to limit dgnum to reasonable values) +! sigmag_amode(m) = geometric standard deviation for aerosol mode m +! sigmaglo_amode(m), sigmaghi_amode(m) = lower and upper limits on the +! geometric standard deviation of the number distribution +! (Used when mprogsfc_amode>0, to limit sigmag to reasonable values) +! alnsg_amode(m) = alog( sigmag_amode(m) ) +! alnsglo_amode(m), alnsghi_amode(m) = alog( sigmaglo/hi_amode(m) ) +! voltonumb_amode(m) = ratio of number to volume for mode m +! voltonumblo_amode(m), voltonumbhi_amode(m) = ratio of number to volume +! when dgnum = dgnumlo_amode or dgnumhi_amode, respectively +! voltosfc_amode(m), voltosfclo_amode(m), voltosfchi_amode(m) - ratio of +! surface to volume for mode m (like the voltonumb_amode's) +! alnv2n_amode(m), alnv2nlo_amode(m), alnv2nhi_amode(m) - +! alnv2n_amode(m) = alog( voltonumblo_amode(m) ), ... +! alnv2s_amode(m), alnv2slo_amode(m), alnv2shi_amode(m) - +! alnv2s_amode(m) = alog( voltosfclo_amode(m) ), ... +! rhcrystal_amode(m) = crystalization r.h. for mode m +! rhdeliques_amode(m) = deliquescence r.h. for mode m +! (*** these r.h. values are 0-1 fractions, not 0-100 percentages) +! +! mcalcwater_amode(m) - if positive, water content for mode m will be +! calculated and stored in rclm(k,lwaterptr_amode(m)). Otherwise, no. +! mprognum_amode(m) - if positive, number mixing-ratio for mode m will +! be prognosed. Otherwise, no. +! mdiagnum_amode(m) - if positive, number mixing-ratio for mode m will +! be diagnosed and put into rclm(k,numptr_amode(m)). Otherwise, no. +! mprogsfc_amode(m) - if positive, surface area mixing-ratio for mode m will +! be prognosed, and sigmag will vary temporally and spatially. +! Otherwise, sigmag is constant. +! *** currently surface area is not prognosed when msectional>0 *** +! +! ntot_aspectype = overall number of aerosol chemical species defined (over all modes) +! specdens_amode(l) = dry density (kg/m^3) of aerosol chemical species type l +! specmw_amode(l) = molecular weight (kg/kmol) of aerosol chemical species type l +! specname_amode(l) = name of aerosol chemical species type l +! specrefndxsw(l) = complex refractive index (visible wavelengths) +! of aerosol chemical species type l +! specrefndxlw(l) = complex refractive index (infrared wavelengths) +! of aerosol chemical species type l +! spechygro(l) = hygroscopicity of aerosol chemical species type l +! +! lptr_so4_a_amode(m), lptr_so4_cw_amode(m) = gchm r-array index for the +! mixing ratio for sulfate associated with aerosol mode m +! ("a" and "cw" phases) +! (similar for msa, oc, bc, nacl, dust) +! +! modename_amode(m) = character-variable name for mode m, +! read from mirage2.inp +! modeptr_accum - mode index for the main accumulation mode +! if modeptr_accum = 1, then mode 1 is the main accumulation mode, +! and modename_amode(1) = "accum" +! modeptr_aitken - mode index for the main aitken mode +! if modeptr_aitken = 2, then mode 2 is the main aitken mode, +! and modename_amode(2) = "aitken" +! modeptr_ufine - mode index for the ultrafine mode +! if modeptr_ufine = 3, then mode 3 is the ultrafine mode, +! and modename_amode(3) = "ufine" +! modeptr_coarseas - mode index for the coarse sea-salt mode +! if modeptr_coarseas = 4, then mode 4 is the coarse sea-salt mode, +! and modename_amode(4) = "coarse_seasalt" +! modeptr_coardust - mode index for the coarse dust mode +! if modeptr_coardust = 5, then mode 5 is the coarse dust mode, +! and modename_amode(5) = "coarse_dust" +! +! specdens_XX_amode = dry density (kg/m^3) of aerosol chemical species type XX +! where XX is so4, om, bc, dust, seasalt +! contains same values as the specdens_amode array +! allows values to be referenced differently +! specmw_XX_amode = molecular weight (kg/kmol) of aerosol chemical species type XX +! contains same values as the specmw_amode array +! +!----------------------------------------------------------------------- + + +!-------------------------------------------------------------- +! +! ... aerosol size information for the current chunk +! +!-------------------------------------------------------------- +! +! dgncur = current geometric mean diameters (cm) for number distributions +! dgncur_a - for unactivated particles, dry +! (in physics buffer as DGNUM) +! dgncur_awet - for unactivated particles, wet at grid-cell ambient RH +! (in physics buffer as DGNUMWET) +! +! the dgncur are computed from current mass and number +! mixing ratios in the grid cell, BUT are then adjusted to be within +! the bounds defined by dgnumlo/hi_amode +! +! v2ncur = current (number/volume) ratio based on dgncur and sgcur +! (volume in cm^3/whatever, number in particles/whatever) +! == 1.0 / ( pi/6 * dgncur**3 * exp(4.5*((log(sgcur))**2)) ) +! v2ncur_a - for unactivated particles +! (currently just defined locally) +! + + !============================================================== + subroutine search_list_of_names( & + name_to_find, name_id, list_of_names, list_length ) + ! + ! searches for a name in a list of names + ! + ! name_to_find - the name to be found in the list [input] + ! name_id - the position of "name_to_find" in the "list_of_names". + ! If the name is not found in the list, then name_id=0. [output] + ! list_of_names - the list of names to be searched [input] + ! list_length - the number of names in the list [input] + ! + character(len=*), intent(in):: name_to_find, list_of_names(:) + integer, intent(in) :: list_length + integer, intent(out) :: name_id + + integer :: i + name_id = -999888777 + if (name_to_find .ne. ' ') then + do i = 1, list_length + if (name_to_find .eq. list_of_names(i)) then + name_id = i + exit + end if + end do + end if + end subroutine search_list_of_names + + + !============================================================== + subroutine initaermodes_setspecptrs + ! + ! sets the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ... + ! and writes them to iulog + ! ALSO sets the mode-pointers: modeptr_accum, modeptr_aitken, ... + ! and writes them to iulog + ! ALSO sets values of specdens_XX_amode and specmw_XX_amode + ! (XX = so4, om, bc, dust, seasalt) + ! + implicit none + + ! local variables + integer :: i, l, l2, lmassa, lmassc, m + character(len=1000) :: msg + character*8 :: dumname + character*3 :: tmpch3 + integer, parameter :: init_val=-999888777 + integer :: bc_ndx, soa_ndx, pom_ndx + + ! all processes set the pointers + + modeptr_accum = init_val + modeptr_aitken = init_val + modeptr_ufine = init_val + modeptr_coarse = init_val + modeptr_pcarbon = init_val + modeptr_fineseas = init_val + modeptr_finedust = init_val + modeptr_coarseas = init_val + modeptr_coardust = init_val + do m = 1, ntot_amode + if (modename_amode(m) .eq. 'accum') then + modeptr_accum = m + else if (modename_amode(m) .eq. 'aitken') then + modeptr_aitken = m + else if (modename_amode(m) .eq. 'ufine') then + modeptr_ufine = m + else if (modename_amode(m) .eq. 'coarse') then + modeptr_coarse = m + else if (modename_amode(m) .eq. 'primary_carbon') then + modeptr_pcarbon = m + else if (modename_amode(m) .eq. 'fine_seasalt') then + modeptr_fineseas = m + else if (modename_amode(m) .eq. 'fine_dust') then + modeptr_finedust = m + else if (modename_amode(m) .eq. 'coarse_seasalt') then + modeptr_coarseas = m + else if (modename_amode(m) .eq. 'coarse_dust') then + modeptr_coardust = m + end if + end do + + lptr2_pom_a_amode = init_val + lptr2_pom_cw_amode = init_val + lptr2_soa_a_amode = init_val + lptr2_soa_cw_amode = init_val + lptr2_bc_a_amode = init_val + lptr2_bc_cw_amode = init_val + + do m = 1, ntot_amode + + lptr_so4_a_amode(m) = init_val + lptr_so4_cw_amode(m) = init_val + lptr_msa_a_amode(m) = init_val + lptr_msa_cw_amode(m) = init_val + lptr_nh4_a_amode(m) = init_val + lptr_nh4_cw_amode(m) = init_val + lptr_no3_a_amode(m) = init_val + lptr_no3_cw_amode(m) = init_val + lptr_nacl_a_amode(m) = init_val + lptr_nacl_cw_amode(m) = init_val + lptr_dust_a_amode(m) = init_val + lptr_dust_cw_amode(m) = init_val + + pom_ndx = 0 + soa_ndx = 0 + bc_ndx = 0 + + do l = 1, nspec_amode(m) + lmassa = lmassptr_amode(l,m) + lmassc = lmassptrcw_amode(l,m) + + if (lmassa > 0 .and. lmassa <= pcnst) then + write( msg, '(2a,3(1x,i12),2x,a)' ) & + 'subr initaermodes_setspecptrs error setting lptr_', & + ' - m, l, lmassa, cnst_name = ', m, l, lmassa, cnst_name(lmassa) + else + write( msg, '(2a,3(1x,i12),2x,a)' ) & + 'subr initaermodes_setspecptrs error setting lptr_', & + ' - m, l, lmassa, cnst_name = ', m, l, lmassa, 'UNDEF ' + call endrun( trim(msg) ) + end if + + tmpch3 = cnst_name(lmassa)(:3) + select case (tmpch3) + case('so4') + lptr_so4_a_amode(m) = lmassa + lptr_so4_cw_amode(m) = lmassc + case('msa') + lptr_msa_a_amode(m) = lmassa + lptr_msa_cw_amode(m) = lmassc + case('nh4') + lptr_nh4_a_amode(m) = lmassa + lptr_nh4_cw_amode(m) = lmassc + case('no3') + lptr_no3_a_amode(m) = lmassa + lptr_no3_cw_amode(m) = lmassc + case('dst') + lptr_dust_a_amode(m) = lmassa + lptr_dust_cw_amode(m) = lmassc + case('ncl') + lptr_nacl_a_amode(m) = lmassa + lptr_nacl_cw_amode(m) = lmassc + case('pom') + pom_ndx = pom_ndx+1 + lptr2_pom_a_amode(m,pom_ndx) = lmassa + lptr2_pom_cw_amode(m,pom_ndx) = lmassc + case('soa') + soa_ndx = soa_ndx+1 + lptr2_soa_a_amode(m,soa_ndx) = lmassa + lptr2_soa_cw_amode(m,soa_ndx) = lmassc + case('bc_','bcf','bcb') + bc_ndx = bc_ndx+1 + lptr2_bc_a_amode(m,bc_ndx) = lmassa + lptr2_bc_cw_amode(m,bc_ndx) = lmassc + case default + call endrun( trim(msg) ) + end select + end do ! l + end do ! m + + specmw_so4_amode = 1.0_r8 + + do m = 1, ntot_amode + do l = 1, nspec_amode(m) + dumname = trim(adjustl(xname_massptr(l,m))) + tmpch3 = trim(adjustl(dumname(:3))) + if(trim(adjustl(tmpch3)) == 'so4' .or. trim(adjustl(tmpch3)) == 'SO4') then + specmw_so4_amode = specmw_amode(l,m) + endif + enddo + enddo + + + ! masterproc writes out the pointers + if ( .not. ( masterproc ) ) return + + write(iulog,9230) + write(iulog,*) 'modeptr_accum =', modeptr_accum + write(iulog,*) 'modeptr_aitken =', modeptr_aitken + write(iulog,*) 'modeptr_ufine =', modeptr_ufine + write(iulog,*) 'modeptr_coarse =', modeptr_coarse + write(iulog,*) 'modeptr_pcarbon =', modeptr_pcarbon + write(iulog,*) 'modeptr_fineseas =', modeptr_fineseas + write(iulog,*) 'modeptr_finedust =', modeptr_finedust + write(iulog,*) 'modeptr_coarseas =', modeptr_coarseas + write(iulog,*) 'modeptr_coardust =', modeptr_coardust + + dumname = 'none' + write(iulog,9240) + write(iulog,9000) 'sulfate ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_so4_a_amode(m), lptr_so4_cw_amode(m), 'so4' ) + end do + + write(iulog,9000) 'msa ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_msa_a_amode(m), lptr_msa_cw_amode(m), 'msa' ) + end do + + write(iulog,9000) 'ammonium ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_nh4_a_amode(m), lptr_nh4_cw_amode(m), 'nh4' ) + end do + + write(iulog,9000) 'nitrate ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_no3_a_amode(m), lptr_no3_cw_amode(m), 'no3' ) + end do + + write(iulog,9000) 'p-organic ' + do m = 1, ntot_amode + do i = 1, npoa + write(dumname,'(a,i2.2)') 'pom', i + call initaermodes_setspecptrs_write2b( m, & + lptr2_pom_a_amode(m,i), lptr2_pom_cw_amode(m,i), dumname(1:5) ) + end do + end do + + write(iulog,9000) 's-organic ' + do m = 1, ntot_amode + do i = 1, nsoa + write(dumname,'(a,i2.2)') 'soa', i + call initaermodes_setspecptrs_write2b( m, & + lptr2_soa_a_amode(m,i), lptr2_soa_cw_amode(m,i), dumname(1:5) ) + end do + end do + do i = 1, nsoa + l = lptr2_soa_g_amode(i) + write(iulog,'(i4,2x,i12,2x,a,20x,a,i2.2,a)') i, l, cnst_name(l), 'lptr2_soa', i, '_g' + end do + + write(iulog,9000) 'black-c ' + do m = 1, ntot_amode + do i = 1, nbc + write(dumname,'(a,i2.2)') 'bc', i + call initaermodes_setspecptrs_write2b( m, & + lptr2_bc_a_amode(m,i), lptr2_bc_cw_amode(m,i), dumname(1:5) ) + end do + end do + + write(iulog,9000) 'seasalt ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_nacl_a_amode(m), lptr_nacl_cw_amode(m), 'nacl' ) + end do + + write(iulog,9000) 'dust ' + do m = 1, ntot_amode + call initaermodes_setspecptrs_write2( m, & + lptr_dust_a_amode(m), lptr_dust_cw_amode(m), 'dust' ) + end do + +9000 format( a ) +9230 format( & + / 'mode-pointer output from subr initaermodes_setspecptrs' ) +9240 format( & + / 'species-pointer output from subr initaermodes_setspecptrs' / & + 'mode', 12x, 'id name_a ', 12x, 'id name_cw' ) + + return + end subroutine initaermodes_setspecptrs + + + !============================================================== + subroutine initaermodes_setspecptrs_write2( & + m, laptr, lcptr, txtdum ) + ! + ! does some output for initaermodes_setspecptrs + + use constituents, only: pcnst, cnst_name + + implicit none + + ! subr arguments + integer, intent(in) :: m, laptr, lcptr + character*(*), intent(in) :: txtdum + + ! local variables + character*8 dumnamea, dumnamec + + dumnamea = 'none' + dumnamec = 'none' + if (laptr > pcnst .or. lcptr > pcnst ) then + call endrun('initaermodes_setspecptrs_write2: ERROR') + endif + if (laptr .gt. 0) dumnamea = cnst_name(laptr) + if (lcptr .gt. 0) dumnamec = cnst_name(lcptr) + write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum + +9241 format( i4, 2( 2x, i12, 2x, a ), & + 4x, 'lptr_', a, '_a/cw_amode' ) + + return + end subroutine initaermodes_setspecptrs_write2 + + + !============================================================== + subroutine initaermodes_setspecptrs_write2b( & + m, laptr, lcptr, txtdum ) + ! + ! does some output for initaermodes_setspecptrs + + use constituents, only: pcnst, cnst_name + + implicit none + + ! subr arguments + integer, intent(in) :: m, laptr, lcptr + character*(*), intent(in) :: txtdum + + ! local variables + character*8 dumnamea, dumnamec + + dumnamea = 'none' + dumnamec = 'none' + if (laptr .gt. 0) dumnamea = cnst_name(laptr) + if (lcptr .gt. 0) dumnamec = cnst_name(lcptr) + write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum + +9241 format( i4, 2( 2x, i12, 2x, a ), & + 4x, 'lptr2_', a, '_a/cw_amode' ) + + return + end subroutine initaermodes_setspecptrs_write2b + + !============================================================== + subroutine initaermodes_set_cnstnamecw + ! + ! sets the cnst_name_cw + ! + use constituents, only: pcnst, cnst_name + implicit none + + ! subr arguments (none) + + ! local variables + integer j, l, la, lc, ll, m + + ! set cnst_name_cw + cnst_name_cw = ' ' + do m = 1, ntot_amode + do ll = 0, nspec_amode(m) + if (ll == 0) then + la = numptr_amode(m) + lc = numptrcw_amode(m) + else + la = lmassptr_amode(ll,m) + lc = lmassptrcw_amode(ll,m) + end if + if ((la < 1) .or. (la > pcnst) .or. & + (lc < 1) .or. (lc > pcnst)) then + write(*,'(/2a/a,5(1x,i10))') & + '*** initaermodes_set_cnstnamecw error', & + ' -- bad la or lc', & + ' m, ll, la, lc, pcnst =', m, ll, la, lc, pcnst + call endrun( '*** initaermodes_set_cnstnamecw error' ) + end if + do j = 2, len( cnst_name(la) ) - 1 + if (cnst_name(la)(j:j+1) == '_a') then + cnst_name_cw(lc) = cnst_name(la) + cnst_name_cw(lc)(j:j+1) = '_c' + exit + else if (cnst_name(la)(j:j+1) == '_A') then + cnst_name_cw(lc) = cnst_name(la) + cnst_name_cw(lc)(j:j+1) = '_C' + exit + end if + end do + if (cnst_name_cw(lc) == ' ') then + write(*,'(/2a/a,3(1x,i10),2x,a)') & + '*** initaermodes_set_cnstnamecw error', & + ' -- bad cnst_name(la)', & + ' m, ll, la, cnst_name(la) =', & + m, ll, la, cnst_name(la) + call endrun( '*** initaermodes_set_cnstnamecw error' ) + end if + end do ! ll = 0, nspec_amode(m) + end do ! m = 1, ntot_amode + + if ( masterproc ) then + write(*,'(/a)') 'l, cnst_name(l), cnst_name_cw(l)' + do l = 1, pcnst + write(*,'(i4,2(2x,a))') l, cnst_name(l), cnst_name_cw(l) + end do + end if + + return + end subroutine initaermodes_set_cnstnamecw + + end module modal_aero_data + + diff --git a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 new file mode 100644 index 0000000000..aa7155a78a --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 @@ -0,0 +1,1881 @@ +! modal_aero_gasaerexch.F90 + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!BOP +! +! !MODULE: modal_aero_gasaerexch --- does modal aerosol gas-aerosol exchange +! +! !INTERFACE: + module modal_aero_gasaerexch + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use chem_mods, only: gas_pcnst + use modal_aero_data, only: nspec_max, nsoa, npoa, soa_multi_species + use ref_pres, only: top_lev => clim_modal_aero_top_lev + use ppgrid, only: pcols, pver + use modal_aero_data, only: ntot_amode, numptr_amode, sigmag_amode + use modal_aero_data, only: lptr2_soa_g_amode, lptr2_soa_a_amode, lptr2_pom_a_amode + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public modal_aero_gasaerexch_sub, modal_aero_gasaerexch_init + +! !PUBLIC DATA MEMBERS: + integer, parameter :: pcnstxx = gas_pcnst + integer, protected, public :: maxspec_pcage != nspec_max + + integer, protected, public :: modefrm_pcage + integer, protected, public :: nspecfrm_pcage + integer :: modetoo_pcage + + integer, protected, allocatable, public :: lspecfrm_pcage(:) + integer, protected, allocatable, public :: lspectoo_pcage(:) + + real(r8), parameter, public :: n_so4_monolayers_pcage = 8.0_r8 + +! number of so4(+nh4) monolayers needed to "age" a carbon particle + + real(r8), parameter, public :: & + dr_so4_monolayers_pcage = n_so4_monolayers_pcage * 4.76e-10_r8 +! thickness of the so4 monolayers (m) +! for so4(+nh4), use bi-sulfate mw and 1.77 g/cm3, +! --> 1 mol so4(+nh4) = 65 cm^3 --> 1 molecule = (4.76e-10 m)^3 +! aging criterion is approximate so do not try to distinguish +! sulfuric acid, bisulfate, ammonium sulfate + + real(r8), protected, allocatable, public :: soa_equivso4_factor(:) +! this factor converts an soa volume to a volume of so4(+nh4) +! having same hygroscopicity as the soa + + real (r8) :: fac_m2v_nh4, fac_m2v_so4 + real (r8), allocatable :: fac_m2v_soa(:) + + real (r8), allocatable :: fac_m2v_pcarbon(:) + +! !DESCRIPTION: This module implements ... +! +! !REVISION HISTORY: +! +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! list private module data here + +!EOC +!---------------------------------------------------------------------- + + + contains + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: modal_aero_gasaerexch_sub --- ... +! +! !INTERFACE: +subroutine modal_aero_gasaerexch_sub( & + lchnk, ncol, nstep, & + loffset, deltat, & + t, pmid, pdel, & + qh2o, troplev, & + q, qqcw, & + dqdt_other, dqqcwdt_other, & + dgncur_a, dgncur_awet, & + sulfeq ) + +! !USES: +use modal_aero_data, only: alnsg_amode,lmassptr_amode,cnst_name_cw +use modal_aero_data, only: lptr_so4_a_amode,lptr_nh4_a_amode +use modal_aero_data, only: modeptr_pcarbon,nspec_amode,specmw_amode,specdens_amode +use modal_aero_rename, only: modal_aero_rename_sub + +use cam_history, only: outfld, fieldname_len +use chem_mods, only: adv_mass +use constituents, only: pcnst, cnst_name, cnst_get_ind +use mo_tracname, only: solsym +use physconst, only: gravit, mwdry, rair +use cam_abortutils, only: endrun +use spmd_utils, only: iam, masterproc + + +implicit none + +! !PARAMETERS: + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: nstep ! model time-step number + integer, intent(in) :: loffset ! offset applied to modal aero "ptrs" + integer, intent(in) :: troplev(pcols) ! tropopause vertical index + real(r8), intent(in) :: deltat ! time step (s) + + real(r8), intent(inout) :: q(ncol,pver,pcnstxx) ! tracer mixing ratio (TMR) array + ! *** MUST BE #/kmol-air for number + ! *** MUST BE mol/mol-air for mass + ! *** NOTE ncol dimension + real(r8), intent(inout) :: qqcw(ncol,pver,pcnstxx) + ! like q but for cloud-borner tracers + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! TMR tendency from other continuous + ! growth processes (aqchem, soa??) + ! *** NOTE ncol dimension + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + ! like dqdt_other but for cloud-borner tracers + real(r8), intent(in) :: t(pcols,pver) ! temperature at model levels (K) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: qh2o(pcols,pver) ! water vapor mixing ratio (kg/kg) + real(r8), intent(in) :: dgncur_a(pcols,pver,ntot_amode) + real(r8), intent(in) :: dgncur_awet(pcols,pver,ntot_amode) + real(r8), pointer :: sulfeq(:,:,:) + + ! dry & wet geo. mean dia. (m) of number distrib. + +! !DESCRIPTION: +! computes TMR (tracer mixing ratio) tendencies for gas condensation +! onto aerosol particles +! +! this version does condensation of H2SO4, NH3, and MSA, both treated as +! completely non-volatile (gas --> aerosol, but no aerosol --> gas) +! gas H2SO4 goes to aerosol SO4 +! gas MSA (if present) goes to aerosol SO4 +! aerosol MSA is not distinguished from aerosol SO4 +! gas NH3 (if present) goes to aerosol NH4 +! if gas NH3 is not present, then ???? +! +! +! !REVISION HISTORY: +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer, parameter :: jsrflx_gaexch = 1 + integer, parameter :: jsrflx_rename = 2 + integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1, ldiag4=-1 + integer, parameter :: method_soa = 2 +! method_soa=0 is no uptake +! method_soa=1 is irreversible uptake done like h2so4 uptake +! method_soa=2 is reversible uptake using subr modal_aero_soaexch + + integer :: i, iq, itmpa + integer :: idiagss + integer :: ido_so4a(ntot_amode), ido_nh4a(ntot_amode) + integer :: ido_soaa(ntot_amode,nsoa) + integer :: j, jac, jsrf, jsoa + integer :: k,p + integer :: l, l2, lb, lsfrm, lstoo + integer :: l_so4g, l_nh4g, l_msag + integer :: l_soag(nsoa) + integer :: n, nn, niter, niter_max, ntot_soamode + + logical :: is_dorename_atik, dorename_atik(ncol,pver) + + character(len=fieldname_len+3) :: fieldname + character(len=100) :: msg !BSINGH - msg string for endrun calls + + real (r8) :: avg_uprt_nh4, avg_uprt_so4, avg_uprt_soa(nsoa) + real (r8) :: deltatxx + real (r8) :: dqdt_nh4(ntot_amode), dqdt_so4(ntot_amode) + real (r8) :: dqdt_soa(ntot_amode,nsoa) + real (r8) :: dqdt_soag(nsoa) + real (r8) :: fac_volsfc_pcarbon + real (r8) :: fgain_nh4(ntot_amode), fgain_so4(ntot_amode) + real (r8) :: fgain_soa(ntot_amode,nsoa) + real (r8) :: g0_soa(nsoa) + real(r8) :: mw_poa_host(npoa) ! molec wght of poa used in host code + real(r8) :: mw_soa_host(nsoa) ! molec wght of poa used in host code + real (r8) :: pdel_fac + real (r8) :: qmax_nh4, qnew_nh4, qnew_so4 + real (r8) :: qold_nh4(ntot_amode), qold_so4(ntot_amode) + real (r8) :: qold_poa(ntot_amode,npoa) + real (r8) :: qold_soa(ntot_amode,nsoa) + real (r8) :: qold_soag(nsoa) + real (r8) :: sum_dqdt_msa, sum_dqdt_so4 + real (r8) :: sum_dqdt_soa(nsoa) + real (r8) :: sum_dqdt_nh4, sum_dqdt_nh4_b + real (r8) :: sum_uprt_msa, sum_uprt_nh4, sum_uprt_so4 + real (r8) :: sum_uprt_soa(nsoa) + real (r8) :: tmp1, tmp2, tmpa + real (r8) :: tmp_kxt, tmp_pxt + real (r8) :: tmp_so4a_bgn, tmp_so4a_end + real (r8) :: tmp_so4g_avg, tmp_so4g_bgn, tmp_so4g_equ + real (r8) :: uptkrate(ntot_amode,pcols,pver) + real (r8) :: uptkratebb(ntot_amode) + real (r8) :: uptkrate_soa(ntot_amode,nsoa) + ! gas-to-aerosol mass transfer rates (1/s) + real (r8) :: vol_core, vol_shell + real (r8) :: xferfrac_pcage, xferfrac_max + real (r8) :: xferrate + + logical :: do_msag ! true if msa gas is a species + logical :: do_nh4g ! true if nh3 gas is a species + logical :: do_soag_any ! true if soa gas is a species + logical :: do_soag(nsoa) ! true if soa gas is a species + + logical :: dotend(pcnstxx) ! identifies species directly involved in + ! gas-aerosol exchange (gas condensation) + logical :: dotendqqcw(pcnstxx) ! like dotend but for cloud-borner tracers + logical :: dotendrn(pcnstxx), dotendqqcwrn(pcnstxx) + ! identifies species involved in renaming + ! after "continuous growth" + ! (gas-aerosol exchange and aqchem) + + integer, parameter :: nsrflx = 2 ! last dimension of qsrflx + real(r8) :: dqdt(ncol,pver,pcnstxx) ! TMR "delta q" array - NOTE dims + real(r8) :: dqqcwdt(ncol,pver,pcnstxx) ! like dqdt but for cloud-borner tracers + real(r8) :: qsrflx(pcols,pcnstxx,nsrflx) + ! process-specific column tracer tendencies + ! (1=renaming, 2=gas condensation) + real(r8) :: qconff(pcols,pver),qevapff(pcols,pver) + real(r8) :: qconbb(pcols,pver),qevapbb(pcols,pver) + real(r8) :: qconbg(pcols,pver),qevapbg(pcols,pver) + real(r8) :: qcon(pcols,pver),qevap(pcols,pver) + + real(r8) :: qqcwsrflx(pcols,pcnstxx,nsrflx) + +! following only needed for diagnostics + real(r8) :: qold(ncol,pver,pcnstxx) ! NOTE dims + real(r8) :: qnew(ncol,pver,pcnstxx) ! NOTE dims + real(r8) :: qdel(ncol,pver,pcnstxx) ! NOTE dims + real(r8) :: dumavec(1000), dumbvec(1000), dumcvec(1000) + real(r8) :: qqcwold(ncol,pver,pcnstxx) + real(r8) :: dqdtsv1(ncol,pver,pcnstxx) + real(r8) :: dqqcwdtsv1(ncol,pver,pcnstxx) + + +!---------------------------------------------------------------------- + +! set gas species indices + call cnst_get_ind( 'H2SO4', l_so4g, .false. ) + call cnst_get_ind( 'NH3', l_nh4g, .false. ) + call cnst_get_ind( 'MSA', l_msag, .false. ) + l_so4g = l_so4g - loffset + l_nh4g = l_nh4g - loffset + l_msag = l_msag - loffset + if ((l_so4g <= 0) .or. (l_so4g > pcnstxx)) then + write( *, '(/a/a,2i7)' ) & + '*** modal_aero_gasaerexch_sub -- cannot find H2SO4 species', & + ' l_so4g, loffset =', l_so4g, loffset + call endrun( 'modal_aero_gasaerexch_sub error' ) + end if + do_nh4g = .false. + do_msag = .false. + if ((l_nh4g > 0) .and. (l_nh4g <= pcnstxx)) do_nh4g = .true. + if ((l_msag > 0) .and. (l_msag <= pcnstxx)) do_msag = .true. + + do_soag_any = .false. + do_soag(:) = .false. + do jsoa = 1, nsoa + l_soag(jsoa) = lptr2_soa_g_amode(jsoa) - loffset + if ((method_soa == 1) .or. (method_soa == 2)) then + if ((l_soag(jsoa) > 0) .and. (l_soag(jsoa) <= pcnstxx)) then + do_soag_any = .true. + do_soag(jsoa) = .true. + end if + else if (method_soa /= 0) then + write(*,'(/a,1x,i10)') '*** modal_aero_gasaerexch_sub - bad method_soa =', method_soa + call endrun( 'modal_aero_gasaerexch_sub error' ) + end if + end do ! jsoa + +! set tendency flags + dotend(:) = .false. + dotendqqcw(:) = .false. + ido_so4a(:) = 0 + ido_nh4a(:) = 0 + ido_soaa(:,:) = 0 + + dotend(l_so4g) = .true. + if ( do_nh4g ) dotend(l_nh4g) = .true. + if ( do_msag ) dotend(l_msag) = .true. + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) dotend(l_soag(jsoa)) = .true. + end do + + ntot_soamode = 0 + do n = 1, ntot_amode + l = lptr_so4_a_amode(n)-loffset + if ((l > 0) .and. (l <= pcnstxx)) then + dotend(l) = .true. + ido_so4a(n) = 1 + if ( do_nh4g ) then + l = lptr_nh4_a_amode(n)-loffset + if ((l > 0) .and. (l <= pcnstxx)) then + dotend(l) = .true. + ido_nh4a(n) = 1 + end if + end if + end if + + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) then + l = lptr2_soa_a_amode(n,jsoa)-loffset + if ((l > 0) .and. (l <= pcnstxx)) then + dotend(l) = .true. + ido_soaa(n,jsoa) = 1 + ntot_soamode = n + end if + end if + end do ! jsoa + end do ! n + + + if ( do_soag_any ) ntot_soamode = max( ntot_soamode, modefrm_pcage ) + + if (modefrm_pcage > 0) then + ido_so4a(modefrm_pcage) = 2 + if (ido_nh4a(modetoo_pcage) == 1) ido_nh4a(modefrm_pcage) = 2 + do jsoa = 1, nsoa + if (ido_soaa(modetoo_pcage,jsoa) == 1) ido_soaa(modefrm_pcage,jsoa) = 2 + end do + do iq = 1, nspecfrm_pcage + lsfrm = lspecfrm_pcage(iq)-loffset + lstoo = lspectoo_pcage(iq)-loffset + if ((lsfrm > 0) .and. (lsfrm <= pcnst)) then + dotend(lsfrm) = .true. + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dotend(lstoo) = .true. + end if + end if + end do + + + n = modeptr_pcarbon + fac_volsfc_pcarbon = exp( 2.5_r8*(alnsg_amode(n)**2) ) + xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps + end if + + +! zero out tendencies and other + dqdt(:,:,:) = 0.0_r8 + dqqcwdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + qqcwsrflx(:,:,:) = 0.0_r8 + +!-------Initialize evap/cond diagnostics (ncols x pver)----------- + qconff(:,:) = 0.0_r8 + qevapff(:,:) = 0.0_r8 + qconbb(:,:) = 0.0_r8 + qevapbb(:,:) = 0.0_r8 + qconbg(:,:) = 0.0_r8 + qevapbg(:,:) = 0.0_r8 + qcon(:,:) = 0.0_r8 + qevap(:,:) = 0.0_r8 +!--------------------------------------------------- + +! compute gas-to-aerosol mass transfer rates + call gas_aer_uptkrates( ncol, loffset, & + q, t, pmid, & + dgncur_awet, uptkrate ) + + +! use this for tendency calcs to avoid generating very small negative values + deltatxx = deltat * (1.0_r8 + 1.0e-15_r8) + + + jsrf = jsrflx_gaexch + do k=top_lev,pver + do i=1,ncol + +! fgain_so4(n) = fraction of total h2so4 uptake going to mode n +! fgain_nh4(n) = fraction of total nh3 uptake going to mode n + sum_uprt_so4 = 0.0_r8 + sum_uprt_nh4 = 0.0_r8 + sum_uprt_soa = 0.0_r8 + do n = 1, ntot_amode + uptkratebb(n) = uptkrate(n,i,k) + if (ido_so4a(n) > 0) then + fgain_so4(n) = uptkratebb(n) + sum_uprt_so4 = sum_uprt_so4 + fgain_so4(n) + if (ido_so4a(n) == 1) then + qold_so4(n) = q(i,k,lptr_so4_a_amode(n)-loffset) + else + qold_so4(n) = 0.0_r8 + end if + else + fgain_so4(n) = 0.0_r8 + qold_so4(n) = 0.0_r8 + end if + + if (ido_nh4a(n) > 0) then + ! 2.08 factor is for gas diffusivity (nh3/h2so4) + ! differences in fuch-sutugin and accom coef ignored + fgain_nh4(n) = uptkratebb(n)*2.08_r8 + sum_uprt_nh4 = sum_uprt_nh4 + fgain_nh4(n) + if (ido_nh4a(n) == 1) then + qold_nh4(n) = q(i,k,lptr_nh4_a_amode(n)-loffset) + else + qold_nh4(n) = 0.0_r8 + end if + else + fgain_nh4(n) = 0.0_r8 + qold_nh4(n) = 0.0_r8 + end if + + do j = 1, npoa + l = lptr2_pom_a_amode(n,j)-loffset + if (l > 0) then + qold_poa(n,j) = q(i,k,l) + else + qold_poa(n,j) = 0.0_r8 + end if + end do + + itmpa = 0 + do jsoa = 1, nsoa + if (ido_soaa(n,jsoa) > 0) then + ! 0.81 factor is for gas diffusivity (soa/h2so4) + ! (differences in fuch-sutugin and accom coef ignored) + fgain_soa(n,jsoa) = uptkratebb(n)*0.81_r8 + sum_uprt_soa(jsoa) = sum_uprt_soa(jsoa) + fgain_soa(n,jsoa) + if (ido_soaa(n,jsoa) == 1) then + l = lptr2_soa_a_amode(n,jsoa)-loffset + qold_soa(n,jsoa) = q(i,k,l) + itmpa = itmpa + 1 + else + qold_soa(n,jsoa) = 0.0_r8 + end if + else + fgain_soa(n,jsoa) = 0.0_r8 + qold_soa(n,jsoa) = 0.0_r8 + end if + uptkrate_soa(n,jsoa) = fgain_soa(n,jsoa) + end do ! jsoa + ! in previous code versions with nsoa=1, + ! qold_poa was non-zero (i.e., loaded from q) only when ido_soaa(n)=1 + ! thus qold_poa=0 for the primary carbon mode which has ido_soaa=2 + ! this is probably not how it should be + if (itmpa == 0) qold_poa(n,:) = 0.0_r8 + + end do ! n + + if (sum_uprt_so4 > 0.0_r8) then + do n = 1, ntot_amode + fgain_so4(n) = fgain_so4(n) / sum_uprt_so4 + end do + end if +! at this point (sum_uprt_so4 <= 0.0) only when all the fgain_so4 are zero + if (sum_uprt_nh4 > 0.0_r8) then + do n = 1, ntot_amode + fgain_nh4(n) = fgain_nh4(n) / sum_uprt_nh4 + end do + end if + + do jsoa = 1, nsoa + if (sum_uprt_soa(jsoa) > 0.0_r8) then + do n = 1, ntot_amode + fgain_soa(n,jsoa) = fgain_soa(n,jsoa) / sum_uprt_soa(jsoa) + end do + end if + end do + +! uptake amount (fraction of gas uptaken) over deltat + avg_uprt_so4 = (1.0_r8 - exp(-deltatxx*sum_uprt_so4))/deltatxx + avg_uprt_nh4 = (1.0_r8 - exp(-deltatxx*sum_uprt_nh4))/deltatxx + + do jsoa = 1, nsoa + avg_uprt_soa(jsoa) = (1.0_r8 - exp(-deltatxx*sum_uprt_soa(jsoa)))/deltatxx + end do + +! sum_dqdt_so4 = so4_a tendency from h2so4 gas uptake (mol/mol/s) +! sum_dqdt_msa = msa_a tendency from msa gas uptake (mol/mol/s) +! sum_dqdt_nh4 = nh4_a tendency from nh3 gas uptake (mol/mol/s) +! sum_dqdt_soa = soa_a tendency from soa gas uptake (mol/mol/s) + sum_dqdt_so4 = q(i,k,l_so4g) * avg_uprt_so4 + if ( do_msag ) then + sum_dqdt_msa = q(i,k,l_msag) * avg_uprt_so4 + else + sum_dqdt_msa = 0.0_r8 + end if + if ( do_nh4g ) then + sum_dqdt_nh4 = q(i,k,l_nh4g) * avg_uprt_nh4 + else + sum_dqdt_nh4 = 0.0_r8 + end if + + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) then + sum_dqdt_soa(jsoa) = q(i,k,l_soag(jsoa)) * avg_uprt_soa(jsoa) + else + sum_dqdt_soa(jsoa) = 0.0_r8 + end if + end do + + if ( associated(sulfeq) .and. (k <= troplev(i)) ) then + ! compute TMR tendencies for so4 interstial aerosol due to reversible gas uptake + ! only above the tropopause + + tmp_kxt = deltatxx*sum_uprt_so4 ! sum over modes of uptake_rate*deltat + tmp_pxt = 0.0_r8 + do n = 1, ntot_amode + if (ido_so4a(n) <= 0) cycle + tmp_pxt = tmp_pxt + uptkratebb(n)*sulfeq(i,k,n) + end do + tmp_pxt = max( 0.0_r8, tmp_pxt*deltatxx ) ! sum over modes of uptake_rate*sulfeq*deltat + tmp_so4g_bgn = q(i,k,l_so4g) + ! calc avg h2so4(g) over deltat + if (tmp_kxt >= 1.0e-5_r8) then + ! exponential decay towards equilibrium value solution + tmp_so4g_equ = tmp_pxt/tmp_kxt + tmp_so4g_avg = tmp_so4g_equ + (tmp_so4g_bgn-tmp_so4g_equ)*(1.0_r8-exp(-tmp_kxt))/tmp_kxt + else + ! first order approx for tmp_kxt small + tmp_so4g_avg = tmp_so4g_bgn*(1.0_r8-0.5_r8*tmp_kxt) + 0.5_r8*tmp_pxt + end if + sum_dqdt_so4 = 0.0_r8 + do n = 1, ntot_amode + if (ido_so4a(n) <= 0) cycle + ! calc change to so4(a) in mode n + if (ido_so4a(n) == 1) then + l = lptr_so4_a_amode(n)-loffset + tmp_so4a_bgn = q(i,k,l) + else + tmp_so4a_bgn = 0.0_r8 + end if + tmp_so4a_end = tmp_so4a_bgn + deltatxx*uptkratebb(n)*(tmp_so4g_avg-sulfeq(i,k,n)) + tmp_so4a_end = max( 0.0_r8, tmp_so4a_end ) + dqdt_so4(n) = (tmp_so4a_end - tmp_so4a_bgn)/deltatxx + sum_dqdt_so4 = sum_dqdt_so4 + dqdt_so4(n) + end do + ! do not allow msa condensation in stratosphere + ! ( Note that the code for msa has never been used. + ! The plan was to simulate msa(g), treat it as non-volatile (like h2so4(g)), + ! and treat condensed msa as sulfate, so just one additional tracer. ) + if ( do_msag ) sum_dqdt_msa = 0.0_r8 + + else + ! compute TMR tendencies for so4 interstial aerosol due to simple gas uptake + do n = 1, ntot_amode + dqdt_so4(n) = fgain_so4(n)*(sum_dqdt_so4 + sum_dqdt_msa) + end do + end if + + ! compute TMR tendencies for nh4 interstial aerosol due to simple gas uptake + ! but force nh4/so4 molar ratio <= 2 + sum_dqdt_nh4_b = 0.0_r8 + dqdt_nh4(:) = 0._r8 + if ( do_nh4g ) then + do n = 1, ntot_amode + dqdt_nh4(n) = fgain_nh4(n)*sum_dqdt_nh4 + qnew_nh4 = qold_nh4(n) + dqdt_nh4(n)*deltat + qnew_so4 = qold_so4(n) + dqdt_so4(n)*deltat + qmax_nh4 = 2.0_r8*qnew_so4 + if (qnew_nh4 > qmax_nh4) then + dqdt_nh4(n) = (qmax_nh4 - qold_nh4(n))/deltatxx + end if + sum_dqdt_nh4_b = sum_dqdt_nh4_b + dqdt_nh4(n) + end do + end if + + if (( do_soag_any ) .and. (method_soa > 1)) then +! compute TMR tendencies for soag and soa interstial aerosol +! using soa parameterization + niter_max = 1000 + dqdt_soa(:,:) = 0.0_r8 + dqdt_soag(:) = 0.0_r8 + do jsoa = 1, nsoa + qold_soag(jsoa) = q(i,k,l_soag(jsoa)) + end do + mw_poa_host = 12.0_r8 + mw_soa_host = 250.0_r8 + + call modal_aero_soaexch( deltat, t(i,k), pmid(i,k), & + niter, niter_max, ntot_amode, ntot_soamode, npoa, nsoa, & + mw_poa_host, mw_soa_host, & + qold_soag, qold_soa, qold_poa, uptkrate_soa, & + dqdt_soag, dqdt_soa ) + sum_dqdt_soa(:) = -dqdt_soag(:) + + else if ( do_soag_any ) then +! compute TMR tendencies for soa interstial aerosol +! due to simple gas uptake + + do jsoa = 1, nsoa + do n = 1, ntot_amode + dqdt_soa(n,jsoa) = fgain_soa(n,jsoa)*sum_dqdt_soa(jsoa) + end do + end do + else ! method_soa is neither 1 nor 2, no uptake + dqdt_soa(:,:) = 0.0_r8 + end if + + pdel_fac = pdel(i,k)/gravit + do n = 1, ntot_amode + if (ido_so4a(n) == 1) then + l = lptr_so4_a_amode(n)-loffset + dqdt(i,k,l) = dqdt_so4(n) + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_so4(n)*pdel_fac + end if + + if ( do_nh4g ) then + if (ido_nh4a(n) == 1) then + l = lptr_nh4_a_amode(n)-loffset + dqdt(i,k,l) = dqdt_nh4(n) + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_nh4(n)*pdel_fac + end if + end if + + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) then + if (ido_soaa(n,jsoa) == 1) then + l = lptr2_soa_a_amode(n,jsoa)-loffset + dqdt(i,k,l) = dqdt_soa(n,jsoa) !calculated by modal_aero_soaexch for method_soa=2 + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_soa(n,jsoa)*pdel_fac +!------- Add code for condensation/evaporation diagnostics--- + if (nsoa.eq.15) then !check for current SOA package + if(jsoa.ge.1.and.jsoa.le.5) then ! Fossil SOA species + if (dqdt_soa(n,jsoa).ge.0.0_r8) then + qconff(i,k)=qconff(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + elseif(dqdt_soa(n,jsoa).lt.0.0_r8) then + qevapff(i,k)=qevapff(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + endif + + elseif(jsoa.ge.6.and.jsoa.le.10) then ! Biomass SOA species + if (dqdt_soa(n,jsoa).ge.0.0_r8) then + qconbb(i,k)=qconbb(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + elseif(dqdt_soa(n,jsoa).lt.0.0_r8) then + qevapbb(i,k)=qevapbb(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + endif + + elseif(jsoa.ge.11.and.jsoa.le.15) then ! Biomass SOA species + if (dqdt_soa(n,jsoa).ge.0.0_r8) then + qconbg(i,k)=qconbg(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + elseif(dqdt_soa(n,jsoa).lt.0.0_r8) then + qevapbg(i,k)=qevapbg(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + endif + + endif ! jsoa + endif !nsoa + if (nsoa.eq.5) then !check for current SOA package + if (dqdt_soa(n,jsoa).ge.0.0_r8) then + qcon(i,k)=qcon(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + elseif(dqdt_soa(n,jsoa).lt.0.0_r8) then + qevap(i,k)=qevap(i,k)+dqdt_soa(n,jsoa)*(adv_mass(l)/mwdry) + endif + endif !nsoa +!--------------------------------------------------------------------------------------------------------------------- + end if + end if + end do + end do ! n + +! compute TMR tendencies for h2so4, nh3, and msa gas +! due to simple gas uptake + l = l_so4g + dqdt(i,k,l) = -sum_dqdt_so4 + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt(i,k,l)*pdel_fac + + if ( do_msag ) then + l = l_msag + dqdt(i,k,l) = -sum_dqdt_msa + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt(i,k,l)*pdel_fac + end if + + if ( do_nh4g ) then + l = l_nh4g + dqdt(i,k,l) = -sum_dqdt_nh4_b + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt(i,k,l)*pdel_fac + end if + + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) then + l = l_soag(jsoa) + dqdt(i,k,l) = -sum_dqdt_soa(jsoa) +! dqdt for gas is negative of the sum of dqdt for aerosol soa species in each mode: Manish + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt(i,k,l)*pdel_fac + end if + end do + +! compute TMR tendencies associated with primary carbon aging + if (modefrm_pcage > 0) then + n = modeptr_pcarbon + tmpa = 0.0_r8 + do jsoa = 1, nsoa + tmpa = tmpa + dqdt_soa(n,jsoa)*fac_m2v_soa(jsoa)*soa_equivso4_factor(jsoa) + end do + vol_shell = deltat * & + ( dqdt_so4(n)*fac_m2v_so4 + dqdt_nh4(n)*fac_m2v_nh4 + tmpa ) + vol_core = 0.0_r8 + do l = 1, nspec_amode(n) + vol_core = vol_core + & + q(i,k,lmassptr_amode(l,n)-loffset)*fac_m2v_pcarbon(l) + end do +! ratio1 = vol_shell/vol_core = +! actual hygroscopic-shell-volume/carbon-core-volume after gas uptake +! ratio2 = 6.0_r8*dr_so4_monolayers_pcage/(dgncur_a*fac_volsfc_pcarbon) +! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume +! The 6.0/(dgncur_a*fac_volsfc_pcarbon) = (mode-surface-area/mode-volume) +! Note that vol_shell includes both so4+nh4 AND soa as "equivalent so4", +! The soa_equivso4_factor accounts for the lower hygroscopicity of soa. +! +! Define xferfrac_pcage = min( 1.0, ratio1/ratio2) +! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow +! + tmp1 = vol_shell*dgncur_a(i,k,n)*fac_volsfc_pcarbon + tmp2 = max( 6.0_r8*dr_so4_monolayers_pcage*vol_core, 0.0_r8 ) + if (tmp1 >= tmp2) then + xferfrac_pcage = xferfrac_max + else + xferfrac_pcage = min( tmp1/tmp2, xferfrac_max ) + end if + + if (xferfrac_pcage > 0.0_r8) then + do iq = 1, nspecfrm_pcage + lsfrm = lspecfrm_pcage(iq)-loffset + lstoo = lspectoo_pcage(iq)-loffset + xferrate = (xferfrac_pcage/deltat)*q(i,k,lsfrm) + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xferrate + qsrflx(i,lsfrm,jsrf) = qsrflx(i,lsfrm,jsrf) - xferrate*pdel_fac + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xferrate + qsrflx(i,lstoo,jsrf) = qsrflx(i,lstoo,jsrf) + xferrate*pdel_fac + end if + end do + + if (ido_so4a(modetoo_pcage) > 0) then + l = lptr_so4_a_amode(modetoo_pcage)-loffset + dqdt(i,k,l) = dqdt(i,k,l) + dqdt_so4(modefrm_pcage) + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_so4(modefrm_pcage)*pdel_fac + end if + + if (ido_nh4a(modetoo_pcage) > 0) then + l = lptr_nh4_a_amode(modetoo_pcage)-loffset + dqdt(i,k,l) = dqdt(i,k,l) + dqdt_nh4(modefrm_pcage) + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_nh4(modefrm_pcage)*pdel_fac + end if + + do jsoa = 1, nsoa + if (ido_soaa(modetoo_pcage,jsoa) > 0) then + l = lptr2_soa_a_amode(modetoo_pcage,jsoa)-loffset + dqdt(i,k,l) = dqdt(i,k,l) + dqdt_soa(modefrm_pcage,jsoa) + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt_soa(modefrm_pcage,jsoa)*pdel_fac + end if + end do + + end if + + end if + + end do ! "i = 1, ncol" + end do ! "k = top_lev, pver" + +! set "temporary testing arrays" + qold(:,:,:) = q(:,:,:) + qqcwold(:,:,:) = qqcw(:,:,:) + dqdtsv1(:,:,:) = dqdt(:,:,:) + dqqcwdtsv1(:,:,:) = dqqcwdt(:,:,:) + + +! +! do renaming calcs +! + dotendrn(:) = .false. + dotendqqcwrn(:) = .false. + dorename_atik(1:ncol,:) = .true. + is_dorename_atik = .true. + call modal_aero_rename_sub( & + 'modal_aero_gasaerexch_sub', & + lchnk, ncol, nstep, & + loffset, deltat, & + pdel, troplev, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx ) + + +! This applies dqdt tendencies for all species +! apply the dqdt to update q (and same for qqcw) +! + do l = 1, pcnstxx + if ( dotend(l) .or. dotendrn(l) ) then + do k = top_lev, pver + do i = 1, ncol + q(i,k,l) = q(i,k,l) + dqdt(i,k,l)*deltat + end do + end do + end if + if ( dotendqqcw(l) .or. dotendqqcwrn(l) ) then + do k = top_lev, pver + do i = 1, ncol + qqcw(i,k,l) = qqcw(i,k,l) + dqqcwdt(i,k,l)*deltat + end do + end do + end if + end do + +! diagnostics start ------------------------------------------------------- +!!$ if (ldiag3 > 0) then +!!$ if (icol_diag > 0) then +!!$ i = icol_diag +!!$ write(*,'(a,3i5)') 'gasaerexch ppp nstep,lat,lon', nstep, latndx(i), lonndx(i) +!!$ write(*,'(2i5,3(2x,a))') 0, 0, 'ppp', 'pdel for all k' +!!$ write(*,'(1p,7e12.4)') (pdel(i,k), k=top_lev,pver) +!!$ +!!$ write(*,'(a,3i5)') 'gasaerexch ddd nstep,lat,lon', nstep, latndx(i), lonndx(i) +!!$ do l = 1, pcnstxx +!!$ lb = l + loffset +!!$ +!!$ if ( dotend(l) .or. dotendrn(l) ) then +!!$ write(*,'(2i5,3(2x,a))') 1, l, 'ddd1', cnst_name(lb), 'qold for all k' +!!$ write(*,'(1p,7e12.4)') (qold(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 1, l, 'ddd2', cnst_name(lb), 'qnew for all k' +!!$ write(*,'(1p,7e12.4)') (q(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 1, l, 'ddd3', cnst_name(lb), 'dqdt from conden for all k' +!!$ write(*,'(1p,7e12.4)') (dqdtsv1(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 1, l, 'ddd4', cnst_name(lb), 'dqdt from rename for all k' +!!$ write(*,'(1p,7e12.4)') ((dqdt(i,k,l)-dqdtsv1(i,k,l)), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 1, l, 'ddd5', cnst_name(lb), 'dqdt other for all k' +!!$ write(*,'(1p,7e12.4)') (dqdt_other(i,k,l), k=top_lev,pver) +!!$ end if +!!$ +!!$ if ( dotendqqcw(l) .or. dotendqqcwrn(l) ) then +!!$ write(*,'(2i5,3(2x,a))') 2, l, 'ddd1', cnst_name_cw(lb), 'qold for all k' +!!$ write(*,'(1p,7e12.4)') (qqcwold(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 2, l, 'ddd2', cnst_name_cw(lb), 'qnew for all k' +!!$ write(*,'(1p,7e12.4)') (qqcw(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 2, l, 'ddd3', cnst_name_cw(lb), 'dqdt from conden for all k' +!!$ write(*,'(1p,7e12.4)') (dqqcwdtsv1(i,k,l), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 2, l, 'ddd4', cnst_name_cw(lb), 'dqdt from rename for all k' +!!$ write(*,'(1p,7e12.4)') ((dqqcwdt(i,k,l)-dqqcwdtsv1(i,k,l)), k=top_lev,pver) +!!$ write(*,'(2i5,3(2x,a))') 2, l, 'ddd5', cnst_name_cw(lb), 'dqdt other for all k' +!!$ write(*,'(1p,7e12.4)') (dqqcwdt_other(i,k,l), k=top_lev,pver) +!!$ end if +!!$ +!!$ end do +!!$ +!!$ write(*,'(a,3i5)') 'gasaerexch fff nstep,lat,lon', nstep, latndx(i), lonndx(i) +!!$ do l = 1, pcnstxx +!!$ lb = l + loffset +!!$ if ( dotend(l) .or. dotendrn(l) .or. dotendqqcw(l) .or. dotendqqcwrn(l) ) then +!!$ write(*,'(i5,2(2x,a,2l3))') l, & +!!$ cnst_name(lb), dotend(l), dotendrn(l), & +!!$ cnst_name_cw(lb), dotendqqcw(l), dotendqqcwrn(l) +!!$ end if +!!$ end do +!!$ +!!$ end if +!!$ end if +! diagnostics end --------------------------------------------------------- + +!-----Outfld for condensation/evaporation------------------------------ + if (nsoa.eq.5) then !check for current SOA package + call outfld(trim('qcon_gaex'), qcon(:,:), pcols, lchnk ) + call outfld(trim('qevap_gaex'), qevap(:,:), pcols, lchnk ) + endif +!----------------------------------------------------------------------- + if (nsoa.eq.15) then !check for current SOA package + call outfld(trim('qconff_gaex'), qconff(:,:), pcols, lchnk ) + call outfld(trim('qevapff_gaex'), qevapff(:,:), pcols, lchnk ) + call outfld(trim('qconbb_gaex'), qconbb(:,:), pcols, lchnk ) + call outfld(trim('qevapbb_gaex'), qevapbb(:,:), pcols, lchnk ) + call outfld(trim('qconbg_gaex'), qconbg(:,:), pcols, lchnk ) + call outfld(trim('qevapbg_gaex'), qevapbg(:,:), pcols, lchnk ) + endif +!----------------------------------------------------------------------- + +! do history file column-tendency fields + do l = 1, pcnstxx + lb = l + loffset + do jsrf = 1, 2 + do jac = 1, 2 + if (jac == 1) then + if (jsrf == jsrflx_gaexch) then + if ( .not. dotend(l) ) cycle + fieldname = trim(cnst_name(lb)) // '_sfgaex1' + else if (jsrf == jsrflx_rename) then + if ( .not. dotendrn(l) ) cycle + fieldname = trim(cnst_name(lb)) // '_sfgaex2' + else + cycle + end if + do i = 1, ncol + qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf)*(adv_mass(l)/mwdry) + end do + call outfld( fieldname, qsrflx(:,l,jsrf), pcols, lchnk ) + else + if (jsrf == jsrflx_gaexch) then + cycle + else if (jsrf == jsrflx_rename) then + if ( .not. dotendqqcwrn(l) ) cycle + fieldname = trim(cnst_name_cw(lb)) // '_sfgaex2' + else + cycle + end if + do i = 1, ncol + qqcwsrflx(i,l,jsrf) = qqcwsrflx(i,l,jsrf)*(adv_mass(l)/mwdry) + end do + call outfld( fieldname, qqcwsrflx(:,l,jsrf), pcols, lchnk ) + end if + end do ! jac = ... + end do ! jsrf = ... + end do ! l = ... + + return + end subroutine modal_aero_gasaerexch_sub + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +subroutine gas_aer_uptkrates( ncol, loffset, & + q, t, pmid, & + dgncur_awet, uptkrate ) + +! +! / +! computes uptkrate = | dx dN/dx gas_conden_rate(Dp(x)) +! / +! using Gauss-Hermite quadrature of order nghq=2 +! +! Dp = particle diameter (cm) +! x = ln(Dp) +! dN/dx = log-normal particle number density distribution +! gas_conden_rate(Dp) = 2 * pi * gasdiffus * Dp * F(Kn,ac) +! F(Kn,ac) = Fuchs-Sutugin correction factor +! Kn = Knudsen number +! ac = accomodation coefficient +! + +use physconst, only: mwdry, rair + +implicit none + + + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: loffset + real(r8), intent(in) :: q(ncol,pver,pcnstxx) ! Tracer array (mol,#/mol-air) + real(r8), intent(in) :: t(pcols,pver) ! Temperature in Kelvin + real(r8), intent(in) :: pmid(pcols,pver) ! Air pressure in Pa + real(r8), intent(in) :: dgncur_awet(pcols,pver,ntot_amode) + + real(r8), intent(out) :: uptkrate(ntot_amode,pcols,pver) + ! gas-to-aerosol mass transfer rates (1/s) + + +! local + integer, parameter :: nghq = 2 + integer :: i, iq, k, l1, l2, la, n + + ! Can use sqrt here once Lahey is gone. + real(r8), parameter :: tworootpi = 3.5449077_r8 + real(r8), parameter :: root2 = 1.4142135_r8 + real(r8), parameter :: beta = 2.0_r8 + + real(r8) :: aircon + real(r8) :: const + real(r8) :: dp, dum_m2v + real(r8) :: dryvol_a(pcols,pver) + real(r8) :: gasdiffus, gasspeed + real(r8) :: freepathx2, fuchs_sutugin + real(r8) :: knudsen + real(r8) :: lndp, lndpgn, lnsg + real(r8) :: num_a + real(r8) :: rhoair + real(r8) :: sumghq + real(r8), save :: xghq(nghq), wghq(nghq) ! quadrature abscissae and weights + + data xghq / 0.70710678_r8, -0.70710678_r8 / + data wghq / 0.88622693_r8, 0.88622693_r8 / + + +! outermost loop over all modes + do n = 1, ntot_amode + +! 22-aug-2007 rc easter - get number from q array rather +! than computing a "bounded" number conc. +!! compute dry volume = sum_over_components{ component_mass / density } +!! (m3-AP/mol-air) +!! compute it for all i,k to improve accessing q array +! dryvol_a(1:ncol,:) = 0.0_r8 +! do l1 = 1, nspec_amode(n) +! l2 = lspectype_amode(l1,n) +!! dum_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air) +!! [m3-AP/kmol-AP]= [kg-AP/kmol-AP] / [kg-AP/m3-AP] +! dum_m2v = specmw_amode(l2) / specdens_amode(l2) +! la = lmassptr_amode(l1,n) +! dryvol_a(1:ncol,:) = dryvol_a(1:ncol,:) & +! + max(0.0_r8,q(1:ncol,:,la))*dum_m2v +! end do + +! loops k and i + do k=top_lev,pver + do i=1,ncol + + rhoair = pmid(i,k)/(rair*t(i,k)) ! (kg-air/m3) +! aircon = 1.0e3*rhoair/mwdry ! (mol-air/m3) + +!! "bounded" number conc. (#/m3) +! num_a = dryvol_a(i,k)*v2ncur_a(i,k,n)*aircon + +! number conc. (#/m3) -- note q(i,k,numptr) is (#/kmol-air) +! so need aircon in (kmol-air/m3) + aircon = rhoair/mwdry ! (kmol-air/m3) + num_a = q(i,k,numptr_amode(n)-loffset)*aircon + +! gasdiffus = h2so4 gas diffusivity from mosaic code (m^2/s) +! (pmid must be Pa) + gasdiffus = 0.557e-4_r8 * (t(i,k)**1.75_r8) / pmid(i,k) +! gasspeed = h2so4 gas mean molecular speed from mosaic code (m/s) + gasspeed = 1.470e1_r8 * sqrt(t(i,k)) +! freepathx2 = 2 * (h2so4 mean free path) (m) + freepathx2 = 6.0_r8*gasdiffus/gasspeed + + lnsg = log( sigmag_amode(n) ) + lndpgn = log( dgncur_awet(i,k,n) ) ! (m) + const = tworootpi * num_a * exp(beta*lndpgn + 0.5_r8*(beta*lnsg)**2) + +! sum over gauss-hermite quadrature points + sumghq = 0.0_r8 + do iq = 1, nghq + lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq) + dp = exp(lndp) + +! knudsen number + knudsen = freepathx2/dp +! Changed by Manish Shrivastava on 7/17/2013 to use accom=1; because we do not know better +! following assumes accomodation coefficient = ac = 1. instead 0.65 ! answer change needs to be tested +! (Adams & Seinfeld, 2002, JGR, and references therein) +! fuchs_sutugin = (0.75*ac*(1. + knudsen)) / +! (knudsen*(1.0 + knudsen + 0.283*ac) + 0.75*ac) + fuchs_sutugin = (0.4875_r8*(1._r8 + knudsen)) / & + (knudsen*(1.184_r8 + knudsen) + 0.4875_r8) + sumghq = sumghq + wghq(iq)*dp*fuchs_sutugin/(dp**beta) + end do + uptkrate(n,i,k) = const * gasdiffus * sumghq + + end do ! "do i = 1, ncol" + end do ! "do k = 1, pver" + + end do ! "do n = 1, ntot_soamode" + + + return + end subroutine gas_aer_uptkrates + +!---------------------------------------------------------------------- + + subroutine modal_aero_soaexch( dtfull, temp, pres, & + niter, niter_max, ntot_amode, ntot_soamode, ntot_poaspec, ntot_soaspec, & + mw_poa_host, mw_soa_host, & + g_soa_in, a_soa_in, a_poa_in, xferrate_in, & + g_soa_tend, a_soa_tend ) +! g_soa_tend, a_soa_tend, g0_soa, idiagss ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! calculates condensation/evaporation of "soa gas" +! to/from multiple aerosol modes in 1 grid cell +! +! key assumptions +! (1) ambient equilibrium vapor pressure of soa gas +! is given by p0_soa_298 and delh_vap_soa +! (2) equilibrium vapor pressure of soa gas at aerosol +! particle surface is given by raoults law in the form +! g_star = g0_soa*[a_soa/(a_soa + a_opoa)] +! (3) (oxidized poa)/(total poa) is equal to frac_opoa (constant) +! +! +! Author: R. Easter and R. Zaveri +! Additions to run with multiple BC, SOA and POM's: Shrivastava et al., 2015 +!----------------------------------------------------------------------- + + use mo_constants, only: rgas ! Gas constant (J/K/mol) + + implicit none + + real(r8), intent(in) :: dtfull ! full integration time step (s) + real(r8), intent(in) :: temp ! air temperature (K) + real(r8), intent(in) :: pres ! air pressure (Pa) + integer, intent(out) :: niter ! number of iterations performed + integer, intent(in) :: niter_max ! max allowed number of iterations + integer, intent(in) :: ntot_amode ! number of modes + integer, intent(in) :: ntot_soamode ! number of modes having soa + integer, intent(in) :: ntot_poaspec ! number of poa species + integer, intent(in) :: ntot_soaspec ! number of soa species + real(r8), intent(in) :: mw_poa_host(ntot_poaspec) ! molec wght of poa used in host code + real(r8), intent(in) :: mw_soa_host(ntot_soaspec) ! molec wght of poa used in host code + real(r8), intent(in) :: g_soa_in(ntot_soaspec) ! initial soa gas mixrat (mol/mol at host mw) + real(r8), intent(in) :: a_soa_in(ntot_amode,ntot_soaspec) ! initial soa aerosol mixrat (mol/mol at host mw) + real(r8), intent(in) :: a_poa_in(ntot_amode,ntot_poaspec) ! initial poa aerosol mixrat (mol/mol at host mw) + real(r8), intent(in) :: xferrate_in(ntot_amode,ntot_soaspec) ! gas-aerosol mass transfer rate (1/s) + real(r8), intent(out) :: g_soa_tend(ntot_soaspec) ! soa gas mixrat tendency (mol/mol/s at host mw) + real(r8), intent(out) :: a_soa_tend(ntot_amode,ntot_soaspec) ! soa aerosol mixrat tendency (mol/mol/s at host mw) +! integer, intent(in) :: idiagss + + integer :: ll + integer :: m,k + + logical :: skip_soamode(ntot_amode) ! true if this mode does not have soa + + real(r8), parameter :: a_min1 = 1.0e-20_r8 + real(r8), parameter :: g_min1 = 1.0e-20_r8 + real(r8), parameter :: alpha = 0.05_r8 ! parameter used in calc of time step + real(r8), parameter :: dtsub_fixed = -1.0_r8 ! fixed sub-step for time integration (s) + + real(r8) :: a_ooa_sum_tmp(ntot_soamode) ! total ooa (=soa+opoa) in a mode + real(r8) :: a_opoa(ntot_soamode) ! oxidized-poa aerosol mixrat (mol/mol at actual mw) + real(r8) :: a_soa(ntot_soamode,ntot_soaspec) ! soa aerosol mixrat (mol/mol at actual mw) + real(r8) :: a_soa_tmp(ntot_soamode,ntot_soaspec) ! temporary soa aerosol mixrat (mol/mol) + real(r8) :: beta(ntot_soamode,ntot_soaspec) ! dtcur*xferrate + real(r8) :: delh_vap_soa(ntot_soaspec) ! delh_vap_soa = heat of vaporization for gas soa (J/mol) + real(r8) :: del_g_soa_tmp(ntot_soaspec) + real(r8) :: dtcur ! current time step (s) + real(r8) :: dtmax ! = (dtfull-tcur) + real(r8) :: g0_soa(ntot_soaspec) ! ambient soa gas equilib mixrat (mol/mol at actual mw) + real(r8) :: g_soa(ntot_soaspec) ! soa gas mixrat (mol/mol at actual mw) + real(r8) :: g_star(ntot_soamode,ntot_soaspec) ! soa gas mixrat that is in equilib + ! with each aerosol mode (mol/mol) + real(r8) :: mw_poa(ntot_poaspec) ! actual molec wght of poa + real(r8) :: mw_soa(ntot_soaspec) ! actual molec wght of soa + real(r8) :: opoa_frac(ntot_poaspec) ! fraction of poa that is opoa + real(r8) :: phi(ntot_soamode,ntot_soaspec) ! "relative driving force" + real(r8) :: p0_soa(ntot_soaspec) ! soa gas equilib vapor presssure (atm) + real(r8) :: p0_soa_298(ntot_soaspec) ! p0_soa_298 = soa gas equilib vapor presssure (atm) at 298 k + real(r8) :: sat(ntot_soamode,ntot_soaspec) ! sat(m,ll) = g0_soa(ll)/a_ooa_sum_tmp(m) = g_star(m,ll)/a_soa(m,ll) + ! used by the numerical integration scheme -- it is not a saturation rato! + real(r8) :: tcur ! current integration time (from 0 s) + real(r8) :: tmpa, tmpb, tmpf + real(r8) :: tot_soa(ntot_soaspec) ! g_soa + sum( a_soa(:) ) + real(r8) :: xferrate(ntot_amode,ntot_soaspec) ! gas-aerosol mass transfer rate (1/s) + +! Changed by Manish Shrivastava + opoa_frac(:) = 0.0_r8 !POA does not form solution with SOA for all runs; set opoa_frac=0.0_r8 by Manish Shrivastava + mw_poa(:) = 250.0_r8 + mw_soa(:) = 250.0_r8 + + ! New SOA properties added by Manish Shrivastava on 09/27/2012 + if (ntot_soaspec ==1) then + p0_soa_298(:) = 1.0e-10_r8 + delh_vap_soa(:) = 156.0e3_r8 + opoa_frac(:) = 0.1_r8 + elseif (ntot_soaspec ==2) then + ! same for anthropogenic and biomass burning species + p0_soa_298 (1) = 1.0e-10_r8 + p0_soa_298 (2) = 1.0e-10_r8 + delh_vap_soa(:) = 156.0e3_r8 + elseif(ntot_soaspec ==5) then + ! 5 volatility bins for each of the a combined SOA classes ( including biomass burning, fossil fuel, biogenic) + p0_soa_298 (1) = 9.7831E-13_r8 !soaff0 C*=0.01ug/m3 + p0_soa_298 (2) = 9.7831E-12_r8 !soaff1 C*=0.10ug/m3 + p0_soa_298 (3) = 9.7831E-11_r8 !soaff2 C*=1.0ug/m3 + p0_soa_298 (4) = 9.7831E-10_r8 !soaff3 C*=10.0ug/m3 + p0_soa_298 (5) = 9.7831E-9_r8 !soaff4 C*=100.0ug/m3 + + delh_vap_soa(1) = 153.0e3_r8 + delh_vap_soa(2) = 142.0e3_r8 + delh_vap_soa(3) = 131.0e3_r8 + delh_vap_soa(4) = 120.0e3_r8 + delh_vap_soa(5) = 109.0e3_r8 + elseif(ntot_soaspec ==15) then + ! + ! 5 volatility bins for each of the 3 SOA classes ( biomass burning, fossil fuel, biogenic) + ! SOA species 1-5 are for anthropogenic while 6-10 are for biomass burning SOA + ! SOA species 11-15 are for biogenic SOA, based on Cappa et al., Reference needs to be updated + ! For MW=250.0 + p0_soa_298 (1) = 9.7831E-13_r8 !soaff0 C*=0.01ug/m3 + p0_soa_298 (2) = 9.7831E-12_r8 !soaff1 C*=0.10ug/m3 + p0_soa_298 (3) = 9.7831E-11_r8 !soaff2 C*=1.0ug/m3 + p0_soa_298 (4) = 9.7831E-10_r8 !soaff3 C*=10.0ug/m3 + p0_soa_298 (5) = 9.7831E-9_r8 !soaff4 C*=100.0ug/m3 + p0_soa_298 (6) = 9.7831E-13_r8 !soabb0 C*=0.01ug/m3 + p0_soa_298 (7) = 9.7831E-12_r8 !soabb1 C*=0.10ug/m3 + p0_soa_298 (8) = 9.7831E-11_r8 !soabb2 C*=1.0ug/m3 + p0_soa_298 (9) = 9.7831E-10_r8 !soabb3 C*=10.0ug/m3 + p0_soa_298 (10) = 9.7831E-9_r8 !soabb4 C*=100.0ug/m3 + p0_soa_298 (11) = 9.7831E-13_r8 !soabg0 C*=0.01ug/m3 + p0_soa_298 (12) = 9.7831E-12_r8 !soabg1 C*=0.1ug/m3 + p0_soa_298 (13) = 9.7831E-11_r8 !soabg2 C*=1.0ug/m3 + p0_soa_298 (14) = 9.7831E-10_r8 !soabg3 C*=10.0ug/m3 + p0_soa_298 (15) = 9.7831E-9_r8 !soabg4 C*=100.0ug/m3 + + ! + ! have to be adjusted to 15 species, following the numbers by Epstein et al., 2012 + ! + delh_vap_soa(1) = 153.0e3_r8 + delh_vap_soa(2) = 142.0e3_r8 + delh_vap_soa(3) = 131.0e3_r8 + delh_vap_soa(4) = 120.0e3_r8 + delh_vap_soa(5) = 109.0e3_r8 + delh_vap_soa(6) = 153.0e3_r8 + delh_vap_soa(7) = 142.0e3_r8 + delh_vap_soa(8) = 131.0e3_r8 + delh_vap_soa(9) = 120.0e3_r8 + delh_vap_soa(10) = 109.0e3_r8 + delh_vap_soa(11) = 153.0e3_r8 + delh_vap_soa(12) = 142.0e3_r8 + delh_vap_soa(13) = 131.0e3_r8 + delh_vap_soa(14) = 120.0e3_r8 + delh_vap_soa(15) = 109.0e3_r8 + endif + + !BSINGH - Initialized g_soa_tend and a_soa_tend to circumvent the undefined behavior (04/16/12) + g_soa_tend(:) = 0.0_r8 + a_soa_tend(:,:) = 0.0_r8 + + ! determine which modes have non-zero transfer rates + ! and are involved in the soa gas-aerosol transfer + ! for diameter = 1 nm and number = 1 #/cm3, xferrate ~= 1e-9 s-1 + do m = 1, ntot_soamode + skip_soamode(m) = .true. + do ll = 1, ntot_soaspec + xferrate(m,ll) = xferrate_in(m,ll) + skip_soamode(m) = .false. + end do + end do + + ! convert incoming mixing ratios from mol/mol at the "host-code" molec. weight (12.0 in cam5) + ! to mol/mol at the "actual" molec. weight (currently assumed to be 250.0) + ! also + ! force things to be non-negative + ! calc tot_soa(ll) + ! calc a_opoa (always slightly >0) + do ll = 1, ntot_soaspec + tmpf = mw_soa_host(ll)/mw_soa(ll) + g_soa(ll) = max( g_soa_in(ll), 0.0_r8 ) * tmpf + tot_soa(ll) = g_soa(ll) + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + a_soa(m,ll) = max( a_soa_in(m,ll), 0.0_r8 ) * tmpf + tot_soa(ll) = tot_soa(ll) + a_soa(m,ll) + end do + end do + + tmpf = mw_poa_host(1)/mw_poa(1) + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + a_opoa(m) = 0.0_r8 + do ll = 1, ntot_poaspec + tmpf = mw_poa_host(ll)/mw_poa(ll) + a_opoa(m) = opoa_frac(ll)*a_poa_in(m,ll) + a_opoa(m) = max( a_opoa(m), 1.0e-20_r8 ) ! force to small non-zero value + end do + end do + + ! calc ambient equilibrium soa gas + do ll = 1, ntot_soaspec + p0_soa(ll) = p0_soa_298(ll) * & + exp( -(delh_vap_soa(ll)/rgas)*((1.0_r8/temp)-(1.0_r8/298.0_r8)) ) + g0_soa(ll) = 1.01325e5_r8*p0_soa(ll)/pres + end do + ! IF mw of soa EQ 12 (as in the MAM3 default case), this has to be in + ! should actully talk the mw from the chemistry mechanism and substitute with 12.0 + if (.not.soa_multi_species) then + g0_soa = g0_soa*(150.0_r8/12.0_r8) + else + end if + + niter = 0 + tcur = 0.0_r8 + dtcur = 0.0_r8 + phi(:,:) = 0.0_r8 + g_star(:,:) = 0.0_r8 + +! if (idiagss > 0) then +! write(luna,'(a,1p,10e11.3)') 'p0, g0_soa', p0_soa, g0_soa +! write(luna,'(3a)') & +! 'niter, tcur, dtcur, phi(:), ', & +! 'g_star(:), ', & +! 'a_soa(:), g_soa' +! write(luna,'(3a)') & +! ' sat(:), ', & +! 'sat(:)*a_soa(:) ', & +! 'a_opoa(:)' +! write(luna,'(i3,1p,20e10.2)') niter, tcur, dtcur, & +! phi(:), g_star(:), a_soa(:), g_soa +! end if + + +! integration loop -- does multiple substeps to reach dtfull +time_loop: & + do while (tcur < dtfull-1.0e-3_r8 ) + + niter = niter + 1 + if (niter > niter_max) exit + + tmpa = 0.0_r8 ! time integration parameter for all soa species + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + a_ooa_sum_tmp(m) = a_opoa(m) + sum( a_soa(m,1:ntot_soaspec) ) + end do + do ll = 1, ntot_soaspec + tmpb = 0.0_r8 ! time integration parameter for a single soa species + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + sat(m,ll) = g0_soa(ll)/max( a_ooa_sum_tmp(m), a_min1 ) + g_star(m,ll) = sat(m,ll)*a_soa(m,ll) + phi(m,ll) = (g_soa(ll) - g_star(m,ll))/max( g_soa(ll), g_star(m,ll), g_min1 ) + tmpb = tmpb + xferrate(m,ll)*abs(phi(m,ll)) + end do + tmpa = max( tmpa, tmpb ) + end do + + if (dtsub_fixed > 0.0_r8) then + dtcur = dtsub_fixed + tcur = tcur + dtcur + else + dtmax = dtfull-tcur + if (dtmax*tmpa <= alpha) then +! here alpha/tmpa >= dtmax, so this is final substep + dtcur = dtmax + tcur = dtfull + else + dtcur = alpha/tmpa + tcur = tcur + dtcur + end if + end if + +! step 1 - for modes where soa is condensing, estimate "new" a_soa(m,ll) +! using an explicit calculation with "old" g_soa +! and g_star(m,ll) calculated using "old" a_soa(m,ll) +! do this to get better estimate of "new" a_soa(m,ll) and sat(m,ll) + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + do ll = 1, ntot_soaspec + ! first ll loop calcs a_soa_tmp(m,ll) & a_ooa_sum_tmp + a_soa_tmp(m,ll) = a_soa(m,ll) + beta(m,ll) = dtcur*xferrate(m,ll) + del_g_soa_tmp(ll) = g_soa(ll) - g_star(m,ll) + if (del_g_soa_tmp(ll) > 0.0_r8) then + a_soa_tmp(m,ll) = a_soa(m,ll) + beta(m,ll)*del_g_soa_tmp(ll) + end if + end do + a_ooa_sum_tmp(m) = a_opoa(m) + sum( a_soa_tmp(m,1:ntot_soaspec) ) + do ll = 1, ntot_soaspec + ! second ll loop calcs sat & g_star + if (del_g_soa_tmp(ll) > 0.0_r8) then + sat(m,ll) = g0_soa(ll)/max( a_ooa_sum_tmp(m), a_min1 ) + g_star(m,ll) = sat(m,ll)*a_soa_tmp(m,ll) ! this just needed for diagnostics + end if + end do + end do + +! step 2 - implicit in g_soa and semi-implicit in a_soa, +! with g_star(m,ll) calculated semi-implicitly + do ll = 1, ntot_soaspec + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + tmpa = tmpa + a_soa(m,ll)/(1.0_r8 + beta(m,ll)*sat(m,ll)) + tmpb = tmpb + beta(m,ll)/(1.0_r8 + beta(m,ll)*sat(m,ll)) + end do + + g_soa(ll) = (tot_soa(ll) - tmpa)/(1.0_r8 + tmpb) + g_soa(ll) = max( 0.0_r8, g_soa(ll) ) + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + a_soa(m,ll) = (a_soa(m,ll) + beta(m,ll)*g_soa(ll))/ & + (1.0_r8 + beta(m,ll)*sat(m,ll)) + end do + end do + +! if (idiagss > 0) then +! write(luna,'(i3,1p,20e10.2)') niter, tcur, dtcur, & +! phi(:), g_star(:), a_soa(:), g_soa +! write(luna,'(23x,1p,20e10.2)') & +! sat(:), sat(:)*a_soa(:), a_opoa(:) +! end if + +! if (niter > 9992000) then +! write(luna,'(a)') '*** to many iterations' +! exit +! end if + + end do time_loop + + +! calculate outgoing tendencies (at the host-code molec. weight) +! (a_soa & g_soa are at actual mw, but a_soa_in & g_soa_in are at host-code mw) + do ll = 1, ntot_soaspec + tmpf = mw_soa(ll)/mw_soa_host(ll) + g_soa_tend(ll) = (g_soa(ll)*tmpf - g_soa_in(ll))/dtfull + do m = 1, ntot_soamode + if ( skip_soamode(m) ) cycle + a_soa_tend(m,ll) = (a_soa(m,ll)*tmpf - a_soa_in(m,ll))/dtfull + end do + end do + + + return + + end subroutine modal_aero_soaexch + +!---------------------------------------------------------------------- + +!---------------------------------------------------------------------- + + subroutine modal_aero_gasaerexch_init + +!----------------------------------------------------------------------- +! +! Purpose: +! set do_adjust and do_aitken flags +! create history fields for column tendencies associated with +! modal_aero_calcsize +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +use modal_aero_data +use modal_aero_rename + +use cam_abortutils, only: endrun +use cam_history, only: addfld, add_default, fieldname_len, horiz_only +use constituents, only: pcnst, cnst_get_ind, cnst_name +use spmd_utils, only: masterproc +use phys_control, only: phys_getopts + +implicit none + +!----------------------------------------------------------------------- +! arguments + +!----------------------------------------------------------------------- +! local + integer :: ipair, iq, iqfrm, iqfrm_aa, iqtoo, iqtoo_aa + integer :: jac,jsoa,p + integer :: l, l1, l2, lsfrm, lstoo, lunout + integer :: l_so4g, l_nh4g, l_msag + integer :: m, mfrm, mtoo + integer :: n, nacc, nait + integer :: nchfrm, nchfrmskip, nchtoo, nchtooskip, nspec + + logical :: do_msag, do_nh4g + logical :: do_soag_any, do_soag(nsoa) + logical :: dotend(pcnst), dotendqqcw(pcnst) + + real(r8) :: tmp1, tmp2 + + character(len=fieldname_len) :: tmpnamea, tmpnameb + character(len=fieldname_len+3) :: fieldname + character(128) :: long_name + character(128) :: msg + character(8) :: unit + + logical :: history_aerosol ! Output the MAM aerosol tendencies + logical :: history_aerocom ! Output the aerocom history + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol ) + + maxspec_pcage = nspec_max + allocate(lspecfrm_pcage(maxspec_pcage)) + allocate(lspectoo_pcage(maxspec_pcage)) + allocate(soa_equivso4_factor(nsoa)) + allocate(fac_m2v_soa(nsoa)) + allocate(fac_m2v_pcarbon(nspec_max)) + lunout = 6 +! +! define "from mode" and "to mode" for primary carbon aging +! +! skip (turn off) aging if either is absent, +! or if accum mode so4 is absent +! + modefrm_pcage = -999888777 + modetoo_pcage = -999888777 + if ((modeptr_pcarbon <= 0) .or. (modeptr_accum <= 0)) goto 15000 + l = lptr_so4_a_amode(modeptr_accum) + if ((l < 1) .or. (l > pcnst)) goto 15000 + + modefrm_pcage = modeptr_pcarbon + modetoo_pcage = modeptr_accum + +! +! define species involved in each primary carbon aging pairing +! (include aerosol water) +! +! + mfrm = modefrm_pcage + mtoo = modetoo_pcage + + if (mfrm < 10) then + nchfrmskip = 1 + else if (mfrm < 100) then + nchfrmskip = 2 + else + nchfrmskip = 3 + end if + if (mtoo < 10) then + nchtooskip = 1 + else if (mtoo < 100) then + nchtooskip = 2 + else + nchtooskip = 3 + end if + nspec = 0 + +aa_iqfrm: do iqfrm = -1, nspec_amode(mfrm) + + if (iqfrm == -1) then + lsfrm = numptr_amode(mfrm) + lstoo = numptr_amode(mtoo) + else if (iqfrm == 0) then +! bypass transfer of aerosol water due to primary-carbon aging + cycle aa_iqfrm +! lsfrm = lwaterptr_amode(mfrm) +! lstoo = lwaterptr_amode(mtoo) + else + lsfrm = lmassptr_amode(iqfrm,mfrm) + lstoo = 0 + end if + if ((lsfrm < 1) .or. (lsfrm > pcnst)) cycle aa_iqfrm + + if (lsfrm>0 .and. iqfrm>0 ) then + nchfrm = len( trim( cnst_name(lsfrm) ) ) - nchfrmskip + +! find "too" species having same lspectype_amode as the "frm" species +! AND same cnst_name (except for last 1/2/3 characters which are the mode index) + do iqtoo = 1, nspec_amode(mtoo) +! if ( lspectype_amode(iqtoo,mtoo) .eq. & +! lspectype_amode(iqfrm,mfrm) ) then + lstoo = lmassptr_amode(iqtoo,mtoo) + nchtoo = len( trim( cnst_name(lstoo) ) ) - nchtooskip + if (cnst_name(lsfrm)(1:nchfrm) == cnst_name(lstoo)(1:nchtoo)) then + exit + else + lstoo = 0 + end if +! end if + end do + end if + + if ((lstoo < 1) .or. (lstoo > pcnst)) lstoo = 0 + nspec = nspec + 1 + lspecfrm_pcage(nspec) = lsfrm + lspectoo_pcage(nspec) = lstoo + end do aa_iqfrm + + nspecfrm_pcage = nspec + +! +! output results +! + if ( masterproc ) then + + write(lunout,9310) + + mfrm = modefrm_pcage + mtoo = modetoo_pcage + write(lunout,9320) 1, mfrm, mtoo + + do iq = 1, nspecfrm_pcage + lsfrm = lspecfrm_pcage(iq) + lstoo = lspectoo_pcage(iq) + if (lstoo .gt. 0) then + write(lunout,9330) lsfrm, cnst_name(lsfrm), & + lstoo, cnst_name(lstoo) + else + write(lunout,9340) lsfrm, cnst_name(lsfrm) + end if + end do + + write(lunout,*) + + end if ! ( masterproc ) + +9310 format( / 'subr. modal_aero_gasaerexch_init - primary carbon aging pointers' ) +9320 format( 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3 ) +9330 format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a ) +9340 format( 5x, 'spec', i3, '=', a, ' ---> LOSS' ) + + +15000 continue + +! set tendency flags and gas species indices and flags + dotend(:) = .false. + + call cnst_get_ind( 'H2SO4', l_so4g, .false. ) + if ((l_so4g <= 0) .or. (l_so4g > pcnst)) then + write( *, '(/a/a,2i7)' ) & + '*** modal_aero_gasaerexch_init -- cannot find H2SO4 species', & + ' l_so4g=', l_so4g + call endrun( 'modal_aero_gasaerexch_init error' ) + end if + dotend(l_so4g) = .true. + + call cnst_get_ind( 'NH3', l_nh4g, .false. ) + do_nh4g = .false. + if ((l_nh4g > 0) .and. (l_nh4g <= pcnst)) then + do_nh4g = .true. + dotend(l_nh4g) = .true. + end if + + call cnst_get_ind( 'MSA', l_msag, .false. ) + do_msag = .false. + if ((l_msag > 0) .and. (l_msag <= pcnst)) then + do_msag = .true. + dotend(l_msag) = .true. + end if + + do_soag_any = .false. + do_soag(:) = .false. + do jsoa = 1, nsoa + l = lptr2_soa_g_amode(jsoa) + if ((l > 0) .and. (l <= pcnst)) then + do_soag_any = .true. + do_soag(jsoa) = .true. + dotend(l) = .true. + end if + end do + + + do n = 1, ntot_amode + l = lptr_so4_a_amode(n) + if ((l > 0) .and. (l <= pcnst)) then + dotend(l) = .true. + if ( do_nh4g ) then + l = lptr_nh4_a_amode(n) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + end if + end if + do jsoa = 1, nsoa + if ( do_soag(jsoa) ) then + l = lptr2_soa_a_amode(n,jsoa) + if ((l > 0) .and. (l <= pcnst)) dotend(l) = .true. + end if + end do + end do + + if (modefrm_pcage > 0) then + do iq = 1, nspecfrm_pcage + lsfrm = lspecfrm_pcage(iq) + lstoo = lspectoo_pcage(iq) + if ((lsfrm > 0) .and. (lsfrm <= pcnst)) then + dotend(lsfrm) = .true. + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dotend(lstoo) = .true. + end if + end if + end do + end if + +!---------define history fields for new cond/evap diagnostics---------------------------------------- + fieldname=trim('qconff_gaex') + long_name = trim('3D fields for Fossil SOA condensation') + unit = 'kg/kg/s' + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qconff addfld', fieldname, unit + + fieldname=trim('qevapff_gaex') + long_name = trim('3D fields for Fossil SOA evaporation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qevapff addfld', fieldname, unit + + fieldname=trim('qconbb_gaex') + long_name = trim('3D fields for Biomass SOA condensation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qconbb addfld', fieldname, unit + + fieldname=trim('qevapbb_gaex') + long_name = trim('3D fields for Biomass SOA evaporation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qevapbb addfld', fieldname, unit + + fieldname=trim('qconbg_gaex') + long_name = trim('3D fields for Biogenic SOA condensation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qconbg addfld', fieldname, unit + + fieldname=trim('qevapbg_gaex') + long_name = trim('3D fields for Biogenic SOA evaporation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qevapbg addfld', fieldname, unit + + fieldname=trim('qcon_gaex') + long_name = trim('3D fields for SOA condensation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qcon addfld', fieldname, unit + + fieldname=trim('qevap_gaex') + long_name = trim('3D fields for Biogenic SOA evaporation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'qevap addfld', fieldname, unit +!------------------------------------------------------------------------------ + +! define history fields for basic gas-aer exchange +! and primary carbon aging from that + do l = 1, pcnst + if ( .not. dotend(l) ) cycle + + tmpnamea = cnst_name(l) + fieldname = trim(tmpnamea) // '_sfgaex1' + long_name = trim(tmpnamea) // ' gas-aerosol-exchange primary column tendency' + unit = 'kg/m2/s' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit + + end do ! l = ... +! define history fields for aitken-->accum renaming + dotend(:) = .false. + dotendqqcw(:) = .false. + do ipair = 1, npair_renamexf + do iq = 1, nspecfrm_renamexf(ipair) + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + if ((lsfrm > 0) .and. (lsfrm <= pcnst)) then + dotend(lsfrm) = .true. + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dotend(lstoo) = .true. + end if + end if + + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + if ((lsfrm > 0) .and. (lsfrm <= pcnst)) then + dotendqqcw(lsfrm) = .true. + if ((lstoo > 0) .and. (lstoo <= pcnst)) then + dotendqqcw(lstoo) = .true. + end if + end if + end do ! iq = ... + end do ! ipair = ... + + do l = 1, pcnst + do jac = 1, 2 + if (jac == 1) then + if ( .not. dotend(l) ) cycle + tmpnamea = cnst_name(l) + else + if ( .not. dotendqqcw(l) ) cycle + tmpnamea = cnst_name_cw(l) + end if + + fieldname = trim(tmpnamea) // '_sfgaex2' + long_name = trim(tmpnamea) // ' gas-aerosol-exchange renaming column tendency' + unit = 'kg/m2/s' + if ((tmpnamea(1:3) == 'num') .or. & + (tmpnamea(1:3) == 'NUM')) unit = '#/m2/s' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit + end do ! jac = ... + end do ! l = ... + + +! set for used in aging calcs: +! fac_m2v_so4, fac_m2v_nh4, fac_m2v_soa(:) +! soa_equivso4_factor(:) + soa_equivso4_factor = 0.0_r8 + if (modefrm_pcage > 0) then + n = modeptr_accum + l = lptr_so4_a_amode(n) ; l2 = -1 + if (l <= 0) call endrun( 'modal_aero_gasaerexch_init error a001 finding accum. so4' ) + do l1 = 1, nspec_amode(n) + if (lmassptr_amode(l1,n) == l) then +! l2 = lspectype_amode(l1,n) + l2 = l1 +! fac_m2v_so4 = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_so4 = specmw_amode(l1,n) / specdens_amode(l1,n) +! tmp2 = spechygro(l2) + tmp2 = spechygro(l1,n) + + end if + end do + if (l2 <= 0) call endrun( 'modal_aero_gasaerexch_init error a002 finding accum. so4' ) + + l = lptr_nh4_a_amode(n) ; l2 = -1 + if (l > 0) then + do l1 = 1, nspec_amode(n) + if (lmassptr_amode(l1,n) == l) then +! l2 = lspectype_amode(l1,n) + l2 = l1 +! fac_m2v_nh4 = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_nh4 = specmw_amode(l1,n) / specdens_amode(l1,n) + + end if + end do + if (l2 <= 0) call endrun( 'modal_aero_gasaerexch_init error a002 finding accum. nh4' ) + else + fac_m2v_nh4 = fac_m2v_so4 + end if + + do jsoa = 1, nsoa + l = lptr2_soa_a_amode(n,jsoa) ; l2 = -1 + if (l <= 0) then + write( msg, '(a,i4)') 'modal_aero_gasaerexch_init error a001 finding accum. jsoa =', jsoa + call endrun( msg ) + end if + do l1 = 1, nspec_amode(n) + if (lmassptr_amode(l1,n) == l) then +! l2 = lspectype_amode(l1,n) + l2 = l1 +! fac_m2v_soa(jsoa) = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_soa(jsoa) = specmw_amode(l1,n) / specdens_amode(l1,n) +! soa_equivso4_factor(jsoa) = spechygro(l2)/tmp2 + soa_equivso4_factor(jsoa) = spechygro(l1,n)/tmp2 + end if + end do + if (l2 <= 0) then + write( msg, '(a,i4)') 'modal_aero_gasaerexch_init error a002 finding accum. jsoa =', jsoa + call endrun( msg ) + end if + end do + + fac_m2v_pcarbon(:) = 0.0_r8 + n = modeptr_pcarbon + do l = 1, nspec_amode(n) +! l2 = lspectype_amode(l,n) +! fac_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air) +! [m3-AP/kmol-AP] = [kg-AP/kmol-AP] / [kg-AP/m3-AP] +! fac_m2v_pcarbon(l) = specmw_amode(l2) / specdens_amode(l2) + fac_m2v_pcarbon(l) = specmw_amode(l,n) / specdens_amode(l,n) + end do + end if + + + return + + end subroutine modal_aero_gasaerexch_init + + +!---------------------------------------------------------------------- + +end module modal_aero_gasaerexch + diff --git a/src/chemistry/modal_aero/modal_aero_newnuc.F90 b/src/chemistry/modal_aero/modal_aero_newnuc.F90 new file mode 100644 index 0000000000..7e5bfc4085 --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_newnuc.F90 @@ -0,0 +1,1727 @@ +! modal_aero_newnuc.F90 + + +!---------------------------------------------------------------------- +!BOP +! +! !MODULE: modal_aero_newnuc --- modal aerosol new-particle nucleation +! +! !INTERFACE: +module modal_aero_newnuc + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: r4 => shr_kind_r4 + use mo_constants, only: pi + use chem_mods, only: gas_pcnst + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public modal_aero_newnuc_sub, modal_aero_newnuc_init + +! !PUBLIC DATA MEMBERS: + integer, parameter :: pcnstxx = gas_pcnst + integer :: l_h2so4_sv, l_nh3_sv, lnumait_sv, lnh4ait_sv, lso4ait_sv + +! min h2so4 vapor for nuc calcs = 4.0e-16 mol/mol-air ~= 1.0e4 molecules/cm3, + real(r8), parameter :: qh2so4_cutoff = 4.0e-16_r8 + + real(r8) :: dens_so4a_host + real(r8) :: mw_nh4a_host, mw_so4a_host + +! !DESCRIPTION: This module implements ... +! +! !REVISION HISTORY: +! +! R.Easter 2007.09.14: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! list private module data here + +!EOC +!---------------------------------------------------------------------- + + + contains + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: modal_aero_newnuc_sub --- ... +! +! !INTERFACE: + subroutine modal_aero_newnuc_sub( & + lchnk, ncol, nstep, & + loffset, deltat, & + t, pmid, pdel, & + zm, pblh, & + qv, cld, & + q, & + del_h2so4_gasprod, del_h2so4_aeruptk ) + + +! !USES: + use modal_aero_data + use cam_abortutils, only: endrun + use cam_history, only: outfld, fieldname_len + use chem_mods, only: adv_mass + use constituents, only: pcnst, cnst_name + use physconst, only: gravit, mwdry, r_universal + use ppgrid, only: pcols, pver + use spmd_utils, only: iam, masterproc + use wv_saturation, only: qsat + use ref_pres, only: top_lev=>clim_modal_aero_top_lev + + implicit none + +! !PARAMETERS: + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns in chunk + integer, intent(in) :: nstep ! model step + integer, intent(in) :: loffset ! offset applied to modal aero "pointers" + real(r8), intent(in) :: deltat ! model timestep (s) + + real(r8), intent(in) :: t(pcols,pver) ! temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: zm(pcols,pver) ! midpoint height above surface (m) + real(r8), intent(in) :: pblh(pcols) ! pbl height (m) + real(r8), intent(in) :: qv(pcols,pver) ! specific humidity (kg/kg) + real(r8), intent(in) :: cld(ncol,pver) ! stratiform cloud fraction + ! *** NOTE ncol dimension + real(r8), intent(inout) :: q(ncol,pver,pcnstxx) + ! tracer mixing ratio (TMR) array + ! *** MUST BE mol/mol-air or #/mol-air + ! *** NOTE ncol & pcnstxx dimensions + real(r8), intent(in) :: del_h2so4_gasprod(ncol,pver) + ! h2so4 gas-phase production + ! change over deltat (mol/mol) + real(r8), intent(in) :: del_h2so4_aeruptk(ncol,pver) + ! h2so4 gas-phase loss to + ! aerosol over deltat (mol/mol) + +! !DESCRIPTION: +! computes changes due to aerosol nucleation (new particle formation) +! treats both nucleation and subsequent growth of new particles +! to aitken mode size +! uses the following parameterizations +! vehkamaki et al. (2002) parameterization for binary +! homogeneous nucleation (h2so4-h2o) plus +! kerminen and kulmala (2002) parameterization for +! new particle loss during growth to aitken size +! +! !REVISION HISTORY: +! R.Easter 2007.09.14: Adapted from MIRAGE2 code and CMAQ V4.6 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer :: i, itmp, k, l, lmz, lun, m, mait + integer :: lnumait, lso4ait, lnh4ait + integer :: l_h2so4, l_nh3 + integer :: ldiagveh02 + integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1, ldiag4=-1 + integer, parameter :: newnuc_method_flagaa = 11 +! integer, parameter :: newnuc_method_flagaa = 12 + ! 1=merikanto et al (2007) ternary 2=vehkamaki et al (2002) binary + ! 11=merikanto ternary + first-order boundary layer + ! 12=merikanto ternary + second-order boundary layer + + real(r8) :: adjust_factor + real(r8) :: aircon + real(r8) :: cldx + real(r8) :: dens_nh4so4a + real(r8) :: dmdt_ait, dmdt_aitsv1, dmdt_aitsv2, dmdt_aitsv3 + real(r8) :: dndt_ait, dndt_aitsv1, dndt_aitsv2, dndt_aitsv3 + real(r8) :: dndt(pcols,pver) ! nucleation rate (#/m3/s) + real(r8) :: dnh4dt_ait, dso4dt_ait + real(r8) :: dpnuc + real(r8) :: dplom_mode(1), dphim_mode(1) + real(r8) :: ev_sat(pcols,pver) + real(r8) :: mass1p + real(r8) :: mass1p_aithi, mass1p_aitlo + real(r8) :: pdel_fac + real(r8) :: qh2so4_cur, qh2so4_avg, qh2so4_del + real(r8) :: qnh3_cur, qnh3_del, qnh4a_del + real(r8) :: qnuma_del + real(r8) :: qso4a_del + real(r8) :: qv_sat(pcols,pver) + real(r8) :: qvswtr + real(r8) :: relhum, relhumav, relhumnn + real(r8) :: tmpa, tmpb, tmpc + real(r8) :: tmp_q1, tmp_q2, tmp_q3 + real(r8) :: tmp_frso4, tmp_uptkrate + + integer, parameter :: nsrflx = 1 ! last dimension of qsrflx + real(r8) :: qsrflx(pcols,pcnst,nsrflx) + ! process-specific column tracer tendencies + ! 1 = nucleation (for aerocom) + real(r8) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array -- NOTE dims + logical :: dotend(pcnst) ! flag for doing tendency + logical :: do_nh3 ! flag for doing nh3/nh4 + + + character(len=1) :: tmpch1, tmpch2, tmpch3 + character(len=fieldname_len+3) :: fieldname + + +! begin + lun = 6 + +!-------------------------------------------------------------------------------- +!!$ if (ldiag1 > 0) then +!!$ do i = 1, ncol +!!$ if (lonndx(i) /= 37) cycle +!!$ if (latndx(i) /= 23) cycle +!!$ if (nstep > 3) cycle +!!$ write( lun, '(/a,i7,3i5,f10.2)' ) & +!!$ '*** modal_aero_newnuc_sub -- nstep, iam, lat, lon =', & +!!$ nstep, iam, latndx(i), lonndx(i) +!!$ end do +!!$ if (nstep > 3) call endrun( '*** modal_aero_newnuc_sub -- testing halt after step 3' ) +!!$! if (ncol /= -999888777) return +!!$ end if +!-------------------------------------------------------------------------------- + +!----------------------------------------------------------------------- + l_h2so4 = l_h2so4_sv - loffset + l_nh3 = l_nh3_sv - loffset + lnumait = lnumait_sv - loffset + lnh4ait = lnh4ait_sv - loffset + lso4ait = lso4ait_sv - loffset + +! skip if no aitken mode OR if no h2so4 species + if ((l_h2so4 <= 0) .or. (lso4ait <= 0) .or. (lnumait <= 0)) return + + dotend(:) = .false. + dqdt(1:ncol,:,:) = 0.0_r8 + qsrflx(1:ncol,:,:) = 0.0_r8 + dndt(1:ncol,:) = 0.0_r8 + +! set dotend + mait = modeptr_aitken + dotend(lnumait) = .true. + dotend(lso4ait) = .true. + dotend(l_h2so4) = .true. + + lnh4ait = lptr_nh4_a_amode(mait) - loffset + if ((l_nh3 > 0) .and. (l_nh3 <= pcnst) .and. & + (lnh4ait > 0) .and. (lnh4ait <= pcnst)) then + do_nh3 = .true. + dotend(lnh4ait) = .true. + dotend(l_nh3) = .true. + else + do_nh3 = .false. + end if + + +! dry-diameter limits for "grown" new particles + dplom_mode(1) = exp( 0.67_r8*log(dgnumlo_amode(mait)) & + + 0.33_r8*log(dgnum_amode(mait)) ) + dphim_mode(1) = dgnumhi_amode(mait) + +! mass1p_... = mass (kg) of so4 & nh4 in a single particle of diameter ... +! (assuming same dry density for so4 & nh4) +! mass1p_aitlo - dp = dplom_mode(1) +! mass1p_aithi - dp = dphim_mode(1) + tmpa = dens_so4a_host*pi/6.0_r8 + mass1p_aitlo = tmpa*(dplom_mode(1)**3) + mass1p_aithi = tmpa*(dphim_mode(1)**3) + +! compute qv_sat = saturation specific humidity + call qsat(t(1:ncol, 1:pver), pmid(1:ncol, 1:pver), & + ev_sat(1:ncol, 1:pver), qv_sat(1:ncol, 1:pver)) + + +! +! loop over levels and columns to calc the renaming +! +main_k: do k = top_lev, pver +main_i: do i = 1, ncol + +! skip if completely cloudy, +! because all h2so4 vapor should be cloud-borne + if (cld(i,k) >= 0.99_r8) cycle main_i + +! qh2so4_cur = current qh2so4, after aeruptk + qh2so4_cur = q(i,k,l_h2so4) +! skip if h2so4 vapor < qh2so4_cutoff + if (qh2so4_cur <= qh2so4_cutoff) cycle main_i + + tmpa = max( 0.0_r8, del_h2so4_gasprod(i,k) ) + tmp_q3 = qh2so4_cur +! tmp_q2 = qh2so4 before aeruptk +! (note tmp_q3, tmp_q2 both >= 0.0) + tmp_q2 = tmp_q3 + max( 0.0_r8, -del_h2so4_aeruptk(i,k) ) + +! *** temporary -- in order to get more nucleation +! qh2so4_cur = qh2so4_cur*1.0e1 +! tmp_q3 = tmp_q3*1.0e1 +! tmp_q2 = tmp_q2*1.0e1 +! tmpa = tmpa *1.0e1 + +! tmpb = log( tmp_q2/tmp_q3 ) BUT with some checks added +! tmp_uptkrate = tmpb/deltat + if (tmp_q2 <= tmp_q3) then + tmpb = 0.0_r8 + else + tmpc = tmp_q2 * exp( -20.0_r8 ) + if (tmp_q3 <= tmpc) then + tmp_q3 = tmpc + tmpb = 20.0_r8 + else + tmpb = log( tmp_q2/tmp_q3 ) + end if + end if +! d[ln(qh2so4)]/dt (1/s) from uptake (condensation) to aerosol + tmp_uptkrate = tmpb/deltat + +! qh2so4_avg = estimated average qh2so4 +! when production & loss are done simultaneously + if (tmpb <= 0.1_r8) then + qh2so4_avg = tmp_q3*(1.0_r8 + 0.5_r8*tmpb) - 0.5_r8*tmpa + else + tmpc = tmpa/tmpb + qh2so4_avg = (tmp_q3 - tmpc)*((exp(tmpb)-1.0_r8)/tmpb) + tmpc + end if + if (qh2so4_avg <= qh2so4_cutoff) cycle main_i + + + if ( do_nh3 ) then + qnh3_cur = max( 0.0_r8, q(i,k,l_nh3) ) + else + qnh3_cur = 0.0_r8 + end if + + +! relhumav = grid average RH + qvswtr = qv_sat(i,k) + qvswtr = max( qvswtr, 1.0e-20_r8 ) + relhumav = qv(i,k) / qvswtr + relhumav = max( 0.0_r8, min( 1.0_r8, relhumav ) ) +! relhum = non-cloudy area RH + cldx = max( 0.0_r8, cld(i,k) ) + relhum = (relhumav - cldx) / (1.0_r8 - cldx) + relhum = max( 0.0_r8, min( 1.0_r8, relhum ) ) +! limit RH to between 0.1% and 99% + relhumnn = relhum + relhumnn = max( 0.01_r8, min( 0.99_r8, relhumnn ) ) + +! aircon = air concentration (mol-air/m3) + aircon = 1.0e3_r8*pmid(i,k)/(r_universal*t(i,k)) + + +! call ... routine to get nucleation rates + ldiagveh02 = -1 +!!$ if (ldiag2 > 0) then +!!$ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) then +!!$ if ((k >= 24) .or. (mod(k,4) == 0)) then +!!$ ldiagveh02 = +1 +!!$ write(lun,'(/a,i8,3i4,f8.2,1p,4e10.2)') & +!!$ 'veh02 call - nstep,lat,lon,k; tk,rh,p,cair', & +!!$ nstep, latndx(i), lonndx(i), k, & +!!$ t(i,k), relhumnn, pmid(k,k), aircon +!!$ end if +!!$ end if +!!$ end if + call mer07_veh02_nuc_mosaic_1box( & + newnuc_method_flagaa, & + deltat, t(i,k), relhumnn, pmid(i,k), & + zm(i,k), pblh(i), & + qh2so4_cur, qh2so4_avg, qnh3_cur, tmp_uptkrate, & + mw_so4a_host, & + 1, 1, dplom_mode, dphim_mode, & + itmp, qnuma_del, qso4a_del, qnh4a_del, & + qh2so4_del, qnh3_del, dens_nh4so4a, ldiagveh02 ) +! qh2so4_del, qnh3_del, dens_nh4so4a ) +!---------------------------------------------------------------------- +! subr mer07_veh02_nuc_mosaic_1box( & +! newnuc_method_flagaa, & +! dtnuc, temp_in, rh_in, press_in, & +! qh2so4_cur, qh2so4_avg, qnh3_cur, h2so4_uptkrate, & +! nsize, maxd_asize, dplom_sect, dphim_sect, & +! isize_nuc, qnuma_del, qso4a_del, qnh4a_del, & +! qh2so4_del, qnh3_del, dens_nh4so4a ) +! +!! subr arguments (in) +! real(r8), intent(in) :: dtnuc ! nucleation time step (s) +! real(r8), intent(in) :: temp_in ! temperature, in k +! real(r8), intent(in) :: rh_in ! relative humidity, as fraction +! real(r8), intent(in) :: press_in ! air pressure (pa) +! +! real(r8), intent(in) :: qh2so4_cur, qh2so4_avg +! ! gas h2so4 mixing ratios (mol/mol-air) +! real(r8), intent(in) :: qnh3_cur ! gas nh3 mixing ratios (mol/mol-air) +! ! qxxx_cur = current value (after gas chem and condensation) +! ! qxxx_avg = estimated average value (for simultaneous source/sink calcs) +! real(r8), intent(in) :: h2so4_uptkrate ! h2so4 uptake rate to aerosol (1/s) + +! +! integer, intent(in) :: nsize ! number of aerosol size bins +! integer, intent(in) :: maxd_asize ! dimension for dplom_sect, ... +! real(r8), intent(in) :: dplom_sect(maxd_asize) ! dry diameter at lower bnd of bin (m) +! real(r8), intent(in) :: dphim_sect(maxd_asize) ! dry diameter at upper bnd of bin (m) +! +!! subr arguments (out) +! integer, intent(out) :: isize_nuc ! size bin into which new particles go +! real(r8), intent(out) :: qnuma_del ! change to aerosol number mixing ratio (#/mol-air) +! real(r8), intent(out) :: qso4a_del ! change to aerosol so4 mixing ratio (mol/mol-air) +! real(r8), intent(out) :: qnh4a_del ! change to aerosol nh4 mixing ratio (mol/mol-air) +! real(r8), intent(out) :: qh2so4_del ! change to gas h2so4 mixing ratio (mol/mol-air) +! real(r8), intent(out) :: qnh3_del ! change to gas nh3 mixing ratio (mol/mol-air) +! ! aerosol changes are > 0; gas changes are < 0 +! real(r8), intent(out) :: dens_nh4so4a ! dry-density of the new nh4-so4 aerosol mass (kg/m3) +!---------------------------------------------------------------------- + + +! convert qnuma_del from (#/mol-air) to (#/kmol-air) + qnuma_del = qnuma_del*1.0e3_r8 +! number nuc rate (#/kmol-air/s) from number nuc amt + dndt_ait = qnuma_del/deltat +! fraction of mass nuc going to so4 + tmpa = qso4a_del*mw_so4a_host + tmpb = tmpa + qnh4a_del*mw_nh4a_host + tmp_frso4 = max( tmpa, 1.0e-35_r8 )/max( tmpb, 1.0e-35_r8 ) +! mass nuc rate (kg/kmol-air/s or g/mol...) hhfrom mass nuc amts + dmdt_ait = max( 0.0_r8, (tmpb/deltat) ) + + dndt_aitsv1 = dndt_ait + dmdt_aitsv1 = dmdt_ait + dndt_aitsv2 = 0.0_r8 + dmdt_aitsv2 = 0.0_r8 + dndt_aitsv3 = 0.0_r8 + dmdt_aitsv3 = 0.0_r8 + tmpch1 = ' ' + tmpch2 = ' ' + + if (dndt_ait < 1.0e2_r8) then +! ignore newnuc if number rate < 100 #/kmol-air/s ~= 0.3 #/mg-air/d + dndt_ait = 0.0_r8 + dmdt_ait = 0.0_r8 + tmpch1 = 'A' + + else + dndt_aitsv2 = dndt_ait + dmdt_aitsv2 = dmdt_ait + tmpch1 = 'B' + +! mirage2 code checked for complete h2so4 depletion here, +! but this is now done in mer07_veh02_nuc_mosaic_1box + mass1p = dmdt_ait/dndt_ait + dndt_aitsv3 = dndt_ait + dmdt_aitsv3 = dmdt_ait + +! apply particle size constraints + if (mass1p < mass1p_aitlo) then +! reduce dndt to increase new particle size + dndt_ait = dmdt_ait/mass1p_aitlo + tmpch1 = 'C' + else if (mass1p > mass1p_aithi) then +! reduce dmdt to decrease new particle size + dmdt_ait = dndt_ait*mass1p_aithi + tmpch1 = 'E' + end if + end if + +! *** apply adjustment factor to avoid unrealistically high +! aitken number concentrations in mid and upper troposphere +! adjust_factor = 0.5 +! dndt_ait = dndt_ait * adjust_factor +! dmdt_ait = dmdt_ait * adjust_factor + +! set tendencies + pdel_fac = pdel(i,k)/gravit + +! dso4dt_ait, dnh4dt_ait are (kmol/kmol-air/s) + dso4dt_ait = dmdt_ait*tmp_frso4/mw_so4a_host + dnh4dt_ait = dmdt_ait*(1.0_r8 - tmp_frso4)/mw_nh4a_host + + dqdt(i,k,l_h2so4) = -dso4dt_ait*(1.0_r8-cldx) + qsrflx(i,l_h2so4,1) = qsrflx(i,l_h2so4,1) + dqdt(i,k,l_h2so4)*pdel_fac + q(i,k,l_h2so4) = q(i,k,l_h2so4) + dqdt(i,k,l_h2so4)*deltat + + dqdt(i,k,lso4ait) = dso4dt_ait*(1.0_r8-cldx) + qsrflx(i,lso4ait,1) = qsrflx(i,lso4ait,1) + dqdt(i,k,lso4ait)*pdel_fac + q(i,k,lso4ait) = q(i,k,lso4ait) + dqdt(i,k,lso4ait)*deltat + if (lnumait > 0) then + dqdt(i,k,lnumait) = dndt_ait*(1.0_r8-cldx) +! dndt is (#/m3/s), dqdt(:,:,lnumait) is (#/kmol-air/s), aircon is (mol-air/m3) + dndt(i,k) = dqdt(i,k,lnumait)*aircon*1.0e-3_r8 + qsrflx(i,lnumait,1) = qsrflx(i,lnumait,1) & + + dqdt(i,k,lnumait)*pdel_fac + q(i,k,lnumait) = q(i,k,lnumait) + dqdt(i,k,lnumait)*deltat + end if + + if (( do_nh3 ) .and. (dnh4dt_ait > 0.0_r8)) then + dqdt(i,k,l_nh3) = -dnh4dt_ait*(1.0_r8-cldx) + qsrflx(i,l_nh3,1) = qsrflx(i,l_nh3,1) + dqdt(i,k,l_nh3)*pdel_fac + q(i,k,l_nh3) = q(i,k,l_nh3) + dqdt(i,k,l_nh3)*deltat + + dqdt(i,k,lnh4ait) = dnh4dt_ait*(1.0_r8-cldx) + qsrflx(i,lnh4ait,1) = qsrflx(i,lnh4ait,1) + dqdt(i,k,lnh4ait)*pdel_fac + q(i,k,lnh4ait) = q(i,k,lnh4ait) + dqdt(i,k,lnh4ait)*deltat + end if + +!! temporary diagnostic +! if (ldiag3 > 0) then +! if ((dndt_ait /= 0.0_r8) .or. (dmdt_ait /= 0.0_r8)) then +! write(lun,'(3a,1x,i7,3i5,1p,5e12.4)') & +! 'newnucxx', tmpch1, tmpch2, nstep, lchnk, i, k, & +! dndt_ait, dmdt_ait, cldx +!! call endrun( 'modal_aero_newnuc_sub' ) +! end if +! end if + + +! diagnostic output start ---------------------------------------- +!!$ if (ldiag4 > 0) then +!!$ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) then +!!$ if ((k >= 24) .or. (mod(k,4) == 0)) then +!!$ write(lun,97010) nstep, latndx(i), lonndx(i), k, t(i,k), aircon +!!$ write(lun,97020) 'pmid, pdel ', & +!!$ pmid(i,k), pdel(i,k) +!!$ write(lun,97030) 'qv,qvsw, cld, rh_av, rh_clr ', & +!!$ qv(i,k), qvswtr, cldx, relhumav, relhum +!!$ write(lun,97020) 'h2so4_cur, _pre, _av, nh3_cur', & +!!$ qh2so4_cur, tmp_q2, qh2so4_avg, qnh3_cur +!!$ write(lun,97020) 'del_h2so4_gasprod, _aeruptk ', & +!!$ del_h2so4_gasprod(i,k), del_h2so4_aeruptk(i,k), & +!!$ tmp_uptkrate*3600.0_r8 +!!$ write(lun,97020) ' ' +!!$ write(lun,97050) 'tmpch1, tmpch2 ', tmpch1, tmpch2 +!!$ write(lun,97020) 'dndt_, dmdt_aitsv1 ', & +!!$ dndt_aitsv1, dmdt_aitsv1 +!!$ write(lun,97020) 'dndt_, dmdt_aitsv2 ', & +!!$ dndt_aitsv2, dmdt_aitsv2 +!!$ write(lun,97020) 'dndt_, dmdt_aitsv3 ', & +!!$ dndt_aitsv3, dmdt_aitsv3 +!!$ write(lun,97020) 'dndt_, dmdt_ait ', & +!!$ dndt_ait, dmdt_ait +!!$ write(lun,97020) 'dso4dt_, dnh4dt_ait ', & +!!$ dso4dt_ait, dnh4dt_ait +!!$ write(lun,97020) 'qso4a_del, qh2so4_del ', & +!!$ qso4a_del, qh2so4_del +!!$ write(lun,97020) 'qnh4a_del, qnh3_del ', & +!!$ qnh4a_del, qnh3_del +!!$ write(lun,97020) 'dqdt(h2so4), (nh3) ', & +!!$ dqdt(i,k,l_h2so4), dqdt(i,k,l_nh3) +!!$ write(lun,97020) 'dqdt(so4a), (nh4a), (numa) ', & +!!$ dqdt(i,k,lso4ait), dqdt(i,k,lnh4ait), dqdt(i,k,lnumait) +!!$ +!!$ dpnuc = 0.0_r8 +!!$ if (dndt_aitsv1 > 1.0e-5_r8) dpnuc = (6.0_r8*dmdt_aitsv1/ & +!!$ (pi*dens_so4a_host*dndt_aitsv1))**0.3333333_r8 +!!$ if (dpnuc > 0.0_r8) then +!!$ write(lun,97020) 'dpnuc, dp_aitlo, _aithi ', & +!!$ dpnuc, dplom_mode(1), dphim_mode(1) +!!$ write(lun,97020) 'mass1p, mass1p_aitlo, _aithi ', & +!!$ mass1p, mass1p_aitlo, mass1p_aithi +!!$ end if +!!$ +!!$ 97010 format( / 'NEWNUC nstep,lat,lon,k,tk,cair', i8, 3i4, f8.2, 1pe12.4 ) +!!$ 97020 format( a, 1p, 6e12.4 ) +!!$ 97030 format( a, 1p, 2e12.4, 0p, 5f10.6 ) +!!$ 97040 format( 29x, 1p, 6e12.4 ) +!!$ 97050 format( a, 2(3x,a) ) +!!$ end if +!!$ end if +!!$ end if +! diagnostic output end ------------------------------------------ + + + end do main_i + end do main_k + + +! do history file column-tendency fields + do l = loffset+1, pcnst + lmz = l - loffset + if ( .not. dotend(lmz) ) cycle + + do i = 1, ncol + qsrflx(i,lmz,1) = qsrflx(i,lmz,1)*(adv_mass(lmz)/mwdry) + end do + fieldname = trim(cnst_name(l)) // '_sfnnuc1' + call outfld( fieldname, qsrflx(:,lmz,1), pcols, lchnk ) + +! if (( masterproc ) .and. (nstep < 1)) & +! write(lun,'(2(a,2x),1p,e11.3)') & +! 'modal_aero_newnuc_sub outfld', fieldname, adv_mass(lmz) + end do ! l = ... + + + return +!EOC + end subroutine modal_aero_newnuc_sub + + + +!---------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine mer07_veh02_nuc_mosaic_1box( & + newnuc_method_flagaa, dtnuc, temp_in, rh_in, press_in, & + zm_in, pblh_in, & + qh2so4_cur, qh2so4_avg, qnh3_cur, h2so4_uptkrate, & + mw_so4a_host, & + nsize, maxd_asize, dplom_sect, dphim_sect, & + isize_nuc, qnuma_del, qso4a_del, qnh4a_del, & + qh2so4_del, qnh3_del, dens_nh4so4a, ldiagaa ) +! qh2so4_del, qnh3_del, dens_nh4so4a ) + use mo_constants, only: rgas, & ! Gas constant (J/K/kmol) + avogad => avogadro ! Avogadro's number (1/kmol) + use physconst, only: mw_so4a => mwso4, & ! Molecular weight of sulfate + mw_nh4a => mwnh4 ! Molecular weight of ammonium +!....................................................................... +! +! calculates new particle production from homogeneous nucleation +! over timestep dtnuc, using nucleation rates from either +! merikanto et al. (2007) h2so4-nh3-h2o ternary parameterization +! vehkamaki et al. (2002) h2so4-h2o binary parameterization +! +! the new particles are "grown" to the lower-bound size of the host code's +! smallest size bin. (this "growth" is somewhat ad hoc, and would not be +! necessary if the host code's size bins extend down to ~1 nm.) +! +! if the h2so4 and nh3 mass mixing ratios (mixrats) of the grown new +! particles exceed the current gas mixrats, the new particle production +! is reduced so that the new particle mass mixrats match the gas mixrats. +! +! the correction of kerminen and kulmala (2002) is applied to account +! for loss of the new particles by coagulation as they are +! growing to the "host code mininum size" +! +! revision history +! coded by rc easter, pnnl, xx-apr-2007 +! +! key routines called: subr ternary_nuc_napari +! +! references: +! merikanto, j., i. napari, h. vehkamaki, t. anttila, +! and m. kulmala, 2007, new parameterization of +! sulfuric acid-ammonia-water ternary nucleation +! rates at tropospheric conditions, +! j. geophys. res., 112, d15207, doi:10.1029/2006jd0027977 +! +! vehkamäki, h., m. kulmala, i. napari, k.e.j. lehtinen, +! c. timmreck, m. noppel and a. laaksonen, 2002, +! an improved parameterization for sulfuric acid-water nucleation +! rates for tropospheric and stratospheric conditions, +! j. geophys. res., 107, 4622, doi:10.1029/2002jd002184 +! +! kerminen, v., and m. kulmala, 2002, +! analytical formulae connecting the "real" and the "apparent" +! nucleation rate and the nuclei number concentration +! for atmospheric nucleation events +! +!....................................................................... + implicit none + +! subr arguments (in) + real(r8), intent(in) :: dtnuc ! nucleation time step (s) + real(r8), intent(in) :: temp_in ! temperature, in k + real(r8), intent(in) :: rh_in ! relative humidity, as fraction + real(r8), intent(in) :: press_in ! air pressure (pa) + real(r8), intent(in) :: zm_in ! layer midpoint height (m) + real(r8), intent(in) :: pblh_in ! pbl height (m) + + real(r8), intent(in) :: qh2so4_cur, qh2so4_avg + ! gas h2so4 mixing ratios (mol/mol-air) + real(r8), intent(in) :: qnh3_cur ! gas nh3 mixing ratios (mol/mol-air) + ! qxxx_cur = current value (after gas chem and condensation) + ! qxxx_avg = estimated average value (for simultaneous source/sink calcs) + real(r8), intent(in) :: h2so4_uptkrate ! h2so4 uptake rate to aerosol (1/s) + real(r8), intent(in) :: mw_so4a_host ! mw of so4 aerosol in host code (g/mol) + + integer, intent(in) :: newnuc_method_flagaa ! 1=merikanto et al (2007) ternary + ! 2=vehkamaki et al (2002) binary + integer, intent(in) :: nsize ! number of aerosol size bins + integer, intent(in) :: maxd_asize ! dimension for dplom_sect, ... + real(r8), intent(in) :: dplom_sect(maxd_asize) ! dry diameter at lower bnd of bin (m) + real(r8), intent(in) :: dphim_sect(maxd_asize) ! dry diameter at upper bnd of bin (m) + integer, intent(in) :: ldiagaa + +! subr arguments (out) + integer, intent(out) :: isize_nuc ! size bin into which new particles go + real(r8), intent(out) :: qnuma_del ! change to aerosol number mixing ratio (#/mol-air) + real(r8), intent(out) :: qso4a_del ! change to aerosol so4 mixing ratio (mol/mol-air) + real(r8), intent(out) :: qnh4a_del ! change to aerosol nh4 mixing ratio (mol/mol-air) + real(r8), intent(out) :: qh2so4_del ! change to gas h2so4 mixing ratio (mol/mol-air) + real(r8), intent(out) :: qnh3_del ! change to gas nh3 mixing ratio (mol/mol-air) + ! aerosol changes are > 0; gas changes are < 0 + real(r8), intent(out) :: dens_nh4so4a ! dry-density of the new nh4-so4 aerosol mass (kg/m3) + +! subr arguments (out) passed via common block +! these are used to duplicate the outputs of yang zhang's original test driver +! they are not really needed in wrf-chem + real(r8) :: ratenuclt ! j = ternary nucleation rate from napari param. (cm-3 s-1) + real(r8) :: rateloge ! ln (j) + real(r8) :: cnum_h2so4 ! number of h2so4 molecules in the critical nucleus + real(r8) :: cnum_nh3 ! number of nh3 molecules in the critical nucleus + real(r8) :: cnum_tot ! total number of molecules in the critical nucleus + real(r8) :: radius_cluster ! the radius of cluster (nm) + + +! local variables + integer :: i + integer :: igrow + integer, save :: icase = 0, icase_reldiffmax = 0 +! integer, parameter :: ldiagaa = -1 + integer :: lun + integer :: newnuc_method_flagaa2 + + real(r8), parameter :: onethird = 1.0_r8/3.0_r8 + + real(r8), parameter :: accom_coef_h2so4 = 0.65_r8 ! accomodation coef for h2so4 conden + +! dry densities (kg/m3) molecular weights of aerosol +! ammsulf, ammbisulf, and sulfacid (from mosaic dens_electrolyte values) +! real(r8), parameter :: dens_ammsulf = 1.769e3 +! real(r8), parameter :: dens_ammbisulf = 1.78e3 +! real(r8), parameter :: dens_sulfacid = 1.841e3 +! use following to match cam3 modal_aero densities + real(r8), parameter :: dens_ammsulf = 1.770e3_r8 + real(r8), parameter :: dens_ammbisulf = 1.770e3_r8 + real(r8), parameter :: dens_sulfacid = 1.770e3_r8 + +! molecular weights (g/mol) of aerosol ammsulf, ammbisulf, and sulfacid +! for ammbisulf and sulfacid, use 114 & 96 here rather than 115 & 98 +! because we don't keep track of aerosol hion mass + real(r8), parameter :: mw_ammsulf = 132.0_r8 + real(r8), parameter :: mw_ammbisulf = 114.0_r8 + real(r8), parameter :: mw_sulfacid = 96.0_r8 + + real(r8), save :: reldiffmax = 0.0_r8 + + real(r8) cair ! dry-air molar density (mol/m3) + real(r8) cs_prime_kk ! kk2002 "cs_prime" parameter (1/m2) + real(r8) cs_kk ! kk2002 "cs" parameter (1/s) + real(r8) dens_part ! "grown" single-particle dry density (kg/m3) + real(r8) dfin_kk, dnuc_kk ! kk2002 final/initial new particle wet diameter (nm) + real(r8) dpdry_clus ! critical cluster diameter (m) + real(r8) dpdry_part ! "grown" single-particle dry diameter (m) + real(r8) tmpa, tmpb, tmpc, tmpe, tmpq + real(r8) tmpa1, tmpb1 + real(r8) tmp_m1, tmp_m2, tmp_m3, tmp_n1, tmp_n2, tmp_n3 + real(r8) tmp_spd ! h2so4 vapor molecular speed (m/s) + real(r8) factor_kk + real(r8) fogas, foso4a, fonh4a, fonuma + real(r8) freduce ! reduction factor applied to nucleation rate + ! due to limited availability of h2so4 & nh3 gases + real(r8) freducea, freduceb + real(r8) gamma_kk ! kk2002 "gamma" parameter (nm2*m2/h) + real(r8) gr_kk ! kk2002 "gr" parameter (nm/h) + real(r8) kgaero_per_moleso4a ! (kg dry aerosol)/(mol aerosol so4) + real(r8) mass_part ! "grown" single-particle dry mass (kg) + real(r8) molenh4a_per_moleso4a ! (mol aerosol nh4)/(mol aerosol so4) + real(r8) nh3ppt, nh3ppt_bb ! actual and bounded nh3 (ppt) + real(r8) nu_kk ! kk2002 "nu" parameter (nm) + real(r8) qmolnh4a_del_max ! max production of aerosol nh4 over dtnuc (mol/mol-air) + real(r8) qmolso4a_del_max ! max production of aerosol so4 over dtnuc (mol/mol-air) + real(r8) ratenuclt_bb ! nucleation rate (#/m3/s) + real(r8) ratenuclt_kk ! nucleation rate after kk2002 adjustment (#/m3/s) + real(r8) rh_bb ! bounded value of rh_in + real(r8) so4vol_in ! concentration of h2so4 for nucl. calc., molecules cm-3 + real(r8) so4vol_bb ! bounded value of so4vol_in + real(r8) temp_bb ! bounded value of temp_in + real(r8) voldry_clus ! critical-cluster dry volume (m3) + real(r8) voldry_part ! "grown" single-particle dry volume (m3) + real(r8) wetvol_dryvol ! grown particle (wet-volume)/(dry-volume) + real(r8) wet_volfrac_so4a ! grown particle (dry-volume-from-so4)/(wet-volume) + + + +! +! if h2so4 vapor < qh2so4_cutoff +! exit with new particle formation = 0 +! + isize_nuc = 1 + qnuma_del = 0.0_r8 + qso4a_del = 0.0_r8 + qnh4a_del = 0.0_r8 + qh2so4_del = 0.0_r8 + qnh3_del = 0.0_r8 +! if (qh2so4_avg .le. qh2so4_cutoff) return ! this no longer needed +! if (qh2so4_cur .le. qh2so4_cutoff) return ! this no longer needed + + if ((newnuc_method_flagaa /= 1) .and. & + (newnuc_method_flagaa /= 2) .and. & + (newnuc_method_flagaa /= 11) .and. & + (newnuc_method_flagaa /= 12)) return + + +! +! make call to parameterization routine +! + +! calc h2so4 in molecules/cm3 and nh3 in ppt + cair = press_in/(temp_in*rgas) + so4vol_in = qh2so4_avg * cair * avogad * 1.0e-6_r8 + nh3ppt = qnh3_cur * 1.0e12_r8 + ratenuclt = 1.0e-38_r8 + rateloge = log( ratenuclt ) + + if ( (newnuc_method_flagaa /= 2) .and. & + (nh3ppt >= 0.1_r8) ) then +! make call to merikanto ternary parameterization routine +! (when nh3ppt < 0.1, use binary param instead) + + if (so4vol_in >= 5.0e4_r8) then + temp_bb = max( 235.0_r8, min( 295.0_r8, temp_in ) ) + rh_bb = max( 0.05_r8, min( 0.95_r8, rh_in ) ) + so4vol_bb = max( 5.0e4_r8, min( 1.0e9_r8, so4vol_in ) ) + nh3ppt_bb = max( 0.1_r8, min( 1.0e3_r8, nh3ppt ) ) + call ternary_nuc_merik2007( & + temp_bb, rh_bb, so4vol_bb, nh3ppt_bb, & + rateloge, & + cnum_tot, cnum_h2so4, cnum_nh3, radius_cluster ) + end if + newnuc_method_flagaa2 = 1 + + else +! make call to vehkamaki binary parameterization routine + + if (so4vol_in >= 1.0e4_r8) then + temp_bb = max( 230.15_r8, min( 305.15_r8, temp_in ) ) + rh_bb = max( 1.0e-4_r8, min( 1.0_r8, rh_in ) ) + so4vol_bb = max( 1.0e4_r8, min( 1.0e11_r8, so4vol_in ) ) + call binary_nuc_vehk2002( & + temp_bb, rh_bb, so4vol_bb, & + ratenuclt, rateloge, & + cnum_h2so4, cnum_tot, radius_cluster ) + end if + cnum_nh3 = 0.0_r8 + newnuc_method_flagaa2 = 2 + + end if + + +! do boundary layer nuc + if ((newnuc_method_flagaa == 11) .or. & + (newnuc_method_flagaa == 12)) then + if ( zm_in <= max(pblh_in,100.0_r8) ) then + so4vol_bb = so4vol_in + call pbl_nuc_wang2008( so4vol_bb, & + newnuc_method_flagaa, newnuc_method_flagaa2, & + ratenuclt, rateloge, & + cnum_tot, cnum_h2so4, cnum_nh3, radius_cluster ) + end if + end if + + +! if nucleation rate is less than 1e-6 #/m3/s ~= 0.1 #/cm3/day, +! exit with new particle formation = 0 + if (rateloge .le. -13.82_r8) return +! if (ratenuclt .le. 1.0e-6) return + ratenuclt = exp( rateloge ) + ratenuclt_bb = ratenuclt*1.0e6_r8 + + +! wet/dry volume ratio - use simple kohler approx for ammsulf/ammbisulf + tmpa = max( 0.10_r8, min( 0.95_r8, rh_in ) ) + wetvol_dryvol = 1.0_r8 - 0.56_r8/log(tmpa) + + +! determine size bin into which the new particles go +! (probably it will always be bin #1, but ...) + voldry_clus = ( max(cnum_h2so4,1.0_r8)*mw_so4a + cnum_nh3*mw_nh4a ) / & + (1.0e3_r8*dens_sulfacid*avogad) +! correction when host code sulfate is really ammonium bisulfate/sulfate + voldry_clus = voldry_clus * (mw_so4a_host/mw_so4a) + dpdry_clus = (voldry_clus*6.0_r8/pi)**onethird + + isize_nuc = 1 + dpdry_part = dplom_sect(1) + if (dpdry_clus <= dplom_sect(1)) then + igrow = 1 ! need to clusters to larger size + else if (dpdry_clus >= dphim_sect(nsize)) then + igrow = 0 + isize_nuc = nsize + dpdry_part = dphim_sect(nsize) + else + igrow = 0 + do i = 1, nsize + if (dpdry_clus < dphim_sect(i)) then + isize_nuc = i + dpdry_part = dpdry_clus + dpdry_part = min( dpdry_part, dphim_sect(i) ) + dpdry_part = max( dpdry_part, dplom_sect(i) ) + exit + end if + end do + end if + voldry_part = (pi/6.0_r8)*(dpdry_part**3) + + +! +! determine composition and density of the "grown particles" +! the grown particles are assumed to be liquid +! (since critical clusters contain water) +! so any (nh4/so4) molar ratio between 0 and 2 is allowed +! assume that the grown particles will have +! (nh4/so4 molar ratio) = min( 2, (nh3/h2so4 gas molar ratio) ) +! + if (igrow .le. 0) then +! no "growing" so pure sulfuric acid + tmp_n1 = 0.0_r8 + tmp_n2 = 0.0_r8 + tmp_n3 = 1.0_r8 + else if (qnh3_cur .ge. qh2so4_cur) then +! combination of ammonium sulfate and ammonium bisulfate +! tmp_n1 & tmp_n2 = mole fractions of the ammsulf & ammbisulf + tmp_n1 = (qnh3_cur/qh2so4_cur) - 1.0_r8 + tmp_n1 = max( 0.0_r8, min( 1.0_r8, tmp_n1 ) ) + tmp_n2 = 1.0_r8 - tmp_n1 + tmp_n3 = 0.0_r8 + else +! combination of ammonium bisulfate and sulfuric acid +! tmp_n2 & tmp_n3 = mole fractions of the ammbisulf & sulfacid + tmp_n1 = 0.0_r8 + tmp_n2 = (qnh3_cur/qh2so4_cur) + tmp_n2 = max( 0.0_r8, min( 1.0_r8, tmp_n2 ) ) + tmp_n3 = 1.0_r8 - tmp_n2 + end if + + tmp_m1 = tmp_n1*mw_ammsulf + tmp_m2 = tmp_n2*mw_ammbisulf + tmp_m3 = tmp_n3*mw_sulfacid + dens_part = (tmp_m1 + tmp_m2 + tmp_m3)/ & + ((tmp_m1/dens_ammsulf) + (tmp_m2/dens_ammbisulf) & + + (tmp_m3/dens_sulfacid)) + dens_nh4so4a = dens_part + mass_part = voldry_part*dens_part +! (mol aerosol nh4)/(mol aerosol so4) + molenh4a_per_moleso4a = 2.0_r8*tmp_n1 + tmp_n2 +! (kg dry aerosol)/(mol aerosol so4) + kgaero_per_moleso4a = 1.0e-3_r8*(tmp_m1 + tmp_m2 + tmp_m3) +! correction when host code sulfate is really ammonium bisulfate/sulfate + kgaero_per_moleso4a = kgaero_per_moleso4a * (mw_so4a_host/mw_so4a) + +! fraction of wet volume due to so4a + tmpb = 1.0_r8 + molenh4a_per_moleso4a*17.0_r8/98.0_r8 + wet_volfrac_so4a = 1.0_r8 / ( wetvol_dryvol * tmpb ) + + +! +! calc kerminen & kulmala (2002) correction +! + if (igrow <= 0) then + factor_kk = 1.0_r8 + + else +! "gr" parameter (nm/h) = condensation growth rate of new particles +! use kk2002 eqn 21 for h2so4 uptake, and correct for nh3 & h2o uptake + tmp_spd = 14.7_r8*sqrt(temp_in) ! h2so4 molecular speed (m/s) + gr_kk = 3.0e-9_r8*tmp_spd*mw_sulfacid*so4vol_in/ & + (dens_part*wet_volfrac_so4a) + +! "gamma" parameter (nm2/m2/h) +! use kk2002 eqn 22 +! +! dfin_kk = wet diam (nm) of grown particle having dry dia = dpdry_part (m) + dfin_kk = 1.0e9_r8 * dpdry_part * (wetvol_dryvol**onethird) +! dnuc_kk = wet diam (nm) of cluster + dnuc_kk = 2.0_r8*radius_cluster + dnuc_kk = max( dnuc_kk, 1.0_r8 ) +! neglect (dmean/150)**0.048 factor, +! which should be very close to 1.0 because of small exponent + gamma_kk = 0.23_r8 * (dnuc_kk)**0.2_r8 & + * (dfin_kk/3.0_r8)**0.075_r8 & + * (dens_part*1.0e-3_r8)**(-0.33_r8) & + * (temp_in/293.0_r8)**(-0.75_r8) + +! "cs_prime parameter" (1/m2) +! instead kk2002 eqn 3, use +! cs_prime ~= tmpa / (4*pi*tmpb * h2so4_accom_coef) +! where +! tmpa = -d(ln(h2so4))/dt by conden to particles (1/h units) +! tmpb = h2so4 vapor diffusivity (m2/h units) +! this approx is generally within a few percent of the cs_prime +! calculated directly from eqn 2, +! which is acceptable, given overall uncertainties +! tmpa = -d(ln(h2so4))/dt by conden to particles (1/h units) + tmpa = h2so4_uptkrate * 3600.0_r8 + tmpa1 = tmpa + tmpa = max( tmpa, 0.0_r8 ) +! tmpb = h2so4 gas diffusivity (m2/s, then m2/h) + tmpb = 6.7037e-6_r8 * (temp_in**0.75_r8) / cair + tmpb1 = tmpb ! m2/s + tmpb = tmpb*3600.0_r8 ! m2/h + cs_prime_kk = tmpa/(4.0_r8*pi*tmpb*accom_coef_h2so4) + cs_kk = cs_prime_kk*4.0_r8*pi*tmpb1 + +! "nu" parameter (nm) -- kk2002 eqn 11 + nu_kk = gamma_kk*cs_prime_kk/gr_kk +! nucleation rate adjustment factor (--) -- kk2002 eqn 13 + factor_kk = exp( (nu_kk/dfin_kk) - (nu_kk/dnuc_kk) ) + + end if + ratenuclt_kk = ratenuclt_bb*factor_kk + + +! max production of aerosol dry mass (kg-aero/m3-air) + tmpa = max( 0.0_r8, (ratenuclt_kk*dtnuc*mass_part) ) +! max production of aerosol so4 (mol-so4a/mol-air) + tmpe = tmpa/(kgaero_per_moleso4a*cair) +! max production of aerosol so4 (mol/mol-air) +! based on ratenuclt_kk and mass_part + qmolso4a_del_max = tmpe + +! check if max production exceeds available h2so4 vapor + freducea = 1.0_r8 + if (qmolso4a_del_max .gt. qh2so4_cur) then + freducea = qh2so4_cur/qmolso4a_del_max + end if + +! check if max production exceeds available nh3 vapor + freduceb = 1.0_r8 + if (molenh4a_per_moleso4a .ge. 1.0e-10_r8) then +! max production of aerosol nh4 (ppm) based on ratenuclt_kk and mass_part + qmolnh4a_del_max = qmolso4a_del_max*molenh4a_per_moleso4a + if (qmolnh4a_del_max .gt. qnh3_cur) then + freduceb = qnh3_cur/qmolnh4a_del_max + end if + end if + freduce = min( freducea, freduceb ) + +! if adjusted nucleation rate is less than 1e-12 #/m3/s ~= 0.1 #/cm3/day, +! exit with new particle formation = 0 + if (freduce*ratenuclt_kk .le. 1.0e-12_r8) return + + +! note: suppose that at this point, freduce < 1.0 (no gas-available +! constraints) and molenh4a_per_moleso4a < 2.0 +! if the gas-available constraints is do to h2so4 availability, +! then it would be possible to condense "additional" nh3 and have +! (nh3/h2so4 gas molar ratio) < (nh4/so4 aerosol molar ratio) <= 2 +! one could do some additional calculations of +! dens_part & molenh4a_per_moleso4a to realize this +! however, the particle "growing" is a crude approximate way to get +! the new particles to the host code's minimum particle size, +! are such refinements worth the effort? + + +! changes to h2so4 & nh3 gas (in mol/mol-air), limited by amounts available + tmpa = 0.9999_r8 + qh2so4_del = min( tmpa*qh2so4_cur, freduce*qmolso4a_del_max ) + qnh3_del = min( tmpa*qnh3_cur, qh2so4_del*molenh4a_per_moleso4a ) + qh2so4_del = -qh2so4_del + qnh3_del = -qnh3_del + +! changes to so4 & nh4 aerosol (in mol/mol-air) + qso4a_del = -qh2so4_del + qnh4a_del = -qnh3_del +! change to aerosol number (in #/mol-air) + qnuma_del = 1.0e-3_r8*(qso4a_del*mw_so4a + qnh4a_del*mw_nh4a)/mass_part + +! do the following (tmpa, tmpb, tmpc) calculations as a check +! max production of aerosol number (#/mol-air) + tmpa = max( 0.0_r8, (ratenuclt_kk*dtnuc/cair) ) +! adjusted production of aerosol number (#/mol-air) + tmpb = tmpa*freduce +! relative difference from qnuma_del + tmpc = (tmpb - qnuma_del)/max(tmpb, qnuma_del, 1.0e-35_r8) + + +! +! diagnostic output to fort.41 +! (this should be commented-out or deleted in the wrf-chem version) +! + if (ldiagaa <= 0) return + + icase = icase + 1 + if (abs(tmpc) .gt. abs(reldiffmax)) then + reldiffmax = tmpc + icase_reldiffmax = icase + end if +! do lun = 41, 51, 10 + do lun = 6, 6 +! write(lun,'(/)') + write(lun,'(a,2i9,1p,e10.2)') & + 'vehkam bin-nuc icase, icase_rdmax =', & + icase, icase_reldiffmax, reldiffmax + if (freduceb .lt. freducea) then + if (abs(freducea-freduceb) .gt. & + 3.0e-7_r8*max(freduceb,freducea)) write(lun,'(a,1p,2e15.7)') & + 'freducea, b =', freducea, freduceb + end if + end do + +! output factors so that output matches that of ternucl03 +! fogas = 1.0e6 ! convert mol/mol-air to ppm +! foso4a = 1.0e9*mw_so4a/mw_air ! convert mol-so4a/mol-air to ug/kg-air +! fonh4a = 1.0e9*mw_nh4a/mw_air ! convert mol-nh4a/mol-air to ug/kg-air +! fonuma = 1.0e3/mw_air ! convert #/mol-air to #/kg-air + fogas = 1.0_r8 + foso4a = 1.0_r8 + fonh4a = 1.0_r8 + fonuma = 1.0_r8 + +! do lun = 41, 51, 10 + do lun = 6, 6 + + write(lun,'(a,2i5)') 'newnuc_method_flagaa/aa2', & + newnuc_method_flagaa, newnuc_method_flagaa2 + + write(lun,9210) + write(lun,9201) temp_in, rh_in, & + ratenuclt, 2.0_r8*radius_cluster*1.0e-7_r8, dpdry_part*1.0e2_r8, & + voldry_part*1.0e6_r8, float(igrow) + write(lun,9215) + write(lun,9201) & + qh2so4_avg*fogas, 0.0_r8, & + qh2so4_cur*fogas, qnh3_cur*fogas, & + qh2so4_del*fogas, qnh3_del*fogas, & + qso4a_del*foso4a, qnh4a_del*fonh4a + + write(lun,9220) + write(lun,9201) & + dtnuc, dens_nh4so4a*1.0e-3_r8, & + (qnh3_cur/qh2so4_cur), molenh4a_per_moleso4a, & + qnuma_del*fonuma, tmpb*fonuma, tmpc, freduce + + end do + +! lun = 51 + lun = 6 + write(lun,9230) + write(lun,9201) & + press_in, cair*1.0e-6_r8, so4vol_in, & + wet_volfrac_so4a, wetvol_dryvol, dens_part*1.0e-3_r8 + + if (igrow > 0) then + write(lun,9240) + write(lun,9201) & + tmp_spd, gr_kk, dnuc_kk, dfin_kk, & + gamma_kk, tmpa1, tmpb1, cs_kk + + write(lun,9250) + write(lun,9201) & + cs_prime_kk, nu_kk, factor_kk, ratenuclt, & + ratenuclt_kk*1.0e-6_r8 + end if + +9201 format ( 1p, 40e10.2 ) +9210 format ( & + ' temp rh', & + ' ratenuc dia_clus ddry_part', & + ' vdry_part igrow' ) +9215 format ( & + ' h2so4avg h2so4pre', & + ' h2so4cur nh3_cur', & + ' h2so4del nh3_del', & + ' so4a_del nh4a_del' ) +9220 format ( & + ' dtnuc dens_a nh/so g nh/so a', & + ' numa_del numa_dl2 reldiff freduce' ) +9230 format ( & + ' press_in cair so4_volin', & + ' wet_volfr wetv_dryv dens_part' ) +9240 format ( & + ' tmp_spd gr_kk dnuc_kk dfin_kk', & + ' gamma_kk tmpa1 tmpb1 cs_kk' ) +9250 format ( & + ' cs_pri_kk nu_kk factor_kk ratenuclt', & + ' ratenu_kk' ) + + + return + end subroutine mer07_veh02_nuc_mosaic_1box + + + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine pbl_nuc_wang2008( so4vol, & + newnuc_method_flagaa, newnuc_method_flagaa2, & + ratenucl, rateloge, & + cnum_tot, cnum_h2so4, cnum_nh3, radius_cluster ) +! +! calculates boundary nucleation nucleation rate +! using the first or second-order parameterization in +! wang, m., and j.e. penner, 2008, +! aerosol indirect forcing in a global model with particle nucleation, +! atmos. chem. phys. discuss., 8, 13943-13998 +! + implicit none + +! subr arguments (in) + real(r8), intent(in) :: so4vol ! concentration of h2so4 (molecules cm-3) + integer, intent(in) :: newnuc_method_flagaa + ! [11,12] value selects [first,second]-order parameterization + +! subr arguments (inout) + integer, intent(inout) :: newnuc_method_flagaa2 + real(r8), intent(inout) :: ratenucl ! binary nucleation rate, j (# cm-3 s-1) + real(r8), intent(inout) :: rateloge ! log( ratenucl ) + + real(r8), intent(inout) :: cnum_tot ! total number of molecules + ! in the critical nucleus + real(r8), intent(inout) :: cnum_h2so4 ! number of h2so4 molecules + real(r8), intent(inout) :: cnum_nh3 ! number of nh3 molecules + real(r8), intent(inout) :: radius_cluster ! the radius of cluster (nm) + + +! local variables + real(r8) :: tmp_diam, tmp_mass, tmp_volu + real(r8) :: tmp_rateloge, tmp_ratenucl + +! executable + + +! nucleation rate + if (newnuc_method_flagaa == 11) then + tmp_ratenucl = 1.0e-6_r8 * so4vol + else if (newnuc_method_flagaa == 12) then + tmp_ratenucl = 1.0e-12_r8 * (so4vol**2) + else + return + end if + tmp_rateloge = log( tmp_ratenucl ) + +! exit if pbl nuc rate is lower than (incoming) ternary/binary rate + if (tmp_rateloge <= rateloge) return + + rateloge = tmp_rateloge + ratenucl = tmp_ratenucl + newnuc_method_flagaa2 = newnuc_method_flagaa + +! following wang 2002, assume fresh nuclei are 1 nm diameter +! subsequent code will "grow" them to aitken mode size + radius_cluster = 0.5_r8 + +! assume fresh nuclei are pure h2so4 +! since aitken size >> initial size, the initial composition +! has very little impact on the results + tmp_diam = radius_cluster * 2.0e-7_r8 ! diameter in cm + tmp_volu = (tmp_diam**3) * (pi/6.0_r8) ! volume in cm^3 + tmp_mass = tmp_volu * 1.8_r8 ! mass in g + cnum_h2so4 = (tmp_mass / 98.0_r8) * 6.023e23_r8 ! no. of h2so4 molec assuming pure h2so4 + cnum_tot = cnum_h2so4 + cnum_nh3 = 0.0_r8 + + + return + end subroutine pbl_nuc_wang2008 + + + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine binary_nuc_vehk2002( temp, rh, so4vol, & + ratenucl, rateloge, & + cnum_h2so4, cnum_tot, radius_cluster ) +! +! calculates binary nucleation rate and critical cluster size +! using the parameterization in +! vehkamäki, h., m. kulmala, i. napari, k.e.j. lehtinen, +! c. timmreck, m. noppel and a. laaksonen, 2002, +! an improved parameterization for sulfuric acid-water nucleation +! rates for tropospheric and stratospheric conditions, +! j. geophys. res., 107, 4622, doi:10.1029/2002jd002184 +! + implicit none + +! subr arguments (in) + real(r8), intent(in) :: temp ! temperature (k) + real(r8), intent(in) :: rh ! relative humidity (0-1) + real(r8), intent(in) :: so4vol ! concentration of h2so4 (molecules cm-3) + +! subr arguments (out) + real(r8), intent(out) :: ratenucl ! binary nucleation rate, j (# cm-3 s-1) + real(r8), intent(out) :: rateloge ! log( ratenucl ) + + real(r8), intent(out) :: cnum_h2so4 ! number of h2so4 molecules + ! in the critical nucleus + real(r8), intent(out) :: cnum_tot ! total number of molecules + ! in the critical nucleus + real(r8), intent(out) :: radius_cluster ! the radius of cluster (nm) + + +! local variables + real(r8) :: crit_x + real(r8) :: acoe, bcoe, ccoe, dcoe, ecoe, fcoe, gcoe, hcoe, icoe, jcoe + real(r8) :: tmpa, tmpb + +! executable + + +! calc sulfuric acid mole fraction in critical cluster + crit_x = 0.740997_r8 - 0.00266379_r8 * temp & + - 0.00349998_r8 * log (so4vol) & + + 0.0000504022_r8 * temp * log (so4vol) & + + 0.00201048_r8 * log (rh) & + - 0.000183289_r8 * temp * log (rh) & + + 0.00157407_r8 * (log (rh)) ** 2.0_r8 & + - 0.0000179059_r8 * temp * (log (rh)) ** 2.0_r8 & + + 0.000184403_r8 * (log (rh)) ** 3.0_r8 & + - 1.50345e-6_r8 * temp * (log (rh)) ** 3.0_r8 + + +! calc nucleation rate + acoe = 0.14309_r8+2.21956_r8*temp & + - 0.0273911_r8 * temp**2.0_r8 & + + 0.0000722811_r8 * temp**3.0_r8 + 5.91822_r8/crit_x + + bcoe = 0.117489_r8 + 0.462532_r8 *temp & + - 0.0118059_r8 * temp**2.0_r8 & + + 0.0000404196_r8 * temp**3.0_r8 + 15.7963_r8/crit_x + + ccoe = -0.215554_r8-0.0810269_r8 * temp & + + 0.00143581_r8 * temp**2.0_r8 & + - 4.7758e-6_r8 * temp**3.0_r8 & + - 2.91297_r8/crit_x + + dcoe = -3.58856_r8+0.049508_r8 * temp & + - 0.00021382_r8 * temp**2.0_r8 & + + 3.10801e-7_r8 * temp**3.0_r8 & + - 0.0293333_r8/crit_x + + ecoe = 1.14598_r8 - 0.600796_r8 * temp & + + 0.00864245_r8 * temp**2.0_r8 & + - 0.0000228947_r8 * temp**3.0_r8 & + - 8.44985_r8/crit_x + + fcoe = 2.15855_r8 + 0.0808121_r8 * temp & + -0.000407382_r8 * temp**2.0_r8 & + -4.01957e-7_r8 * temp**3.0_r8 & + + 0.721326_r8/crit_x + + gcoe = 1.6241_r8 - 0.0160106_r8 * temp & + + 0.0000377124_r8 * temp**2.0_r8 & + + 3.21794e-8_r8 * temp**3.0_r8 & + - 0.0113255_r8/crit_x + + hcoe = 9.71682_r8 - 0.115048_r8 * temp & + + 0.000157098_r8 * temp**2.0_r8 & + + 4.00914e-7_r8 * temp**3.0_r8 & + + 0.71186_r8/crit_x + + icoe = -1.05611_r8 + 0.00903378_r8 * temp & + - 0.0000198417_r8 * temp**2.0_r8 & + + 2.46048e-8_r8 * temp**3.0_r8 & + - 0.0579087_r8/crit_x + + jcoe = -0.148712_r8 + 0.00283508_r8 * temp & + - 9.24619e-6_r8 * temp**2.0_r8 & + + 5.00427e-9_r8 * temp**3.0_r8 & + - 0.0127081_r8/crit_x + + tmpa = ( & + acoe & + + bcoe * log (rh) & + + ccoe * ( log (rh))**2.0_r8 & + + dcoe * ( log (rh))**3.0_r8 & + + ecoe * log (so4vol) & + + fcoe * (log (rh)) * (log (so4vol)) & + + gcoe * ((log (rh) ) **2.0_r8) & + * (log (so4vol)) & + + hcoe * (log (so4vol)) **2.0_r8 & + + icoe * log (rh) & + * ((log (so4vol)) **2.0_r8) & + + jcoe * (log (so4vol)) **3.0_r8 & + ) + rateloge = tmpa + tmpa = min( tmpa, log(1.0e38_r8) ) + ratenucl = exp ( tmpa ) +! write(*,*) 'tmpa, ratenucl =', tmpa, ratenucl + + + +! calc number of molecules in critical cluster + acoe = -0.00295413_r8 - 0.0976834_r8*temp & + + 0.00102485_r8 * temp**2.0_r8 & + - 2.18646e-6_r8 * temp**3.0_r8 - 0.101717_r8/crit_x + + bcoe = -0.00205064_r8 - 0.00758504_r8*temp & + + 0.000192654_r8 * temp**2.0_r8 & + - 6.7043e-7_r8 * temp**3.0_r8 - 0.255774_r8/crit_x + + ccoe = +0.00322308_r8 + 0.000852637_r8 * temp & + - 0.0000154757_r8 * temp**2.0_r8 & + + 5.66661e-8_r8 * temp**3.0_r8 & + + 0.0338444_r8/crit_x + + dcoe = +0.0474323_r8 - 0.000625104_r8 * temp & + + 2.65066e-6_r8 * temp**2.0_r8 & + - 3.67471e-9_r8 * temp**3.0_r8 & + - 0.000267251_r8/crit_x + + ecoe = -0.0125211_r8 + 0.00580655_r8 * temp & + - 0.000101674_r8 * temp**2.0_r8 & + + 2.88195e-7_r8 * temp**3.0_r8 & + + 0.0942243_r8/crit_x + + fcoe = -0.038546_r8 - 0.000672316_r8 * temp & + + 2.60288e-6_r8 * temp**2.0_r8 & + + 1.19416e-8_r8 * temp**3.0_r8 & + - 0.00851515_r8/crit_x + + gcoe = -0.0183749_r8 + 0.000172072_r8 * temp & + - 3.71766e-7_r8 * temp**2.0_r8 & + - 5.14875e-10_r8 * temp**3.0_r8 & + + 0.00026866_r8/crit_x + + hcoe = -0.0619974_r8 + 0.000906958_r8 * temp & + - 9.11728e-7_r8 * temp**2.0_r8 & + - 5.36796e-9_r8 * temp**3.0_r8 & + - 0.00774234_r8/crit_x + + icoe = +0.0121827_r8 - 0.00010665_r8 * temp & + + 2.5346e-7_r8 * temp**2.0_r8 & + - 3.63519e-10_r8 * temp**3.0_r8 & + + 0.000610065_r8/crit_x + + jcoe = +0.000320184_r8 - 0.0000174762_r8 * temp & + + 6.06504e-8_r8 * temp**2.0_r8 & + - 1.4177e-11_r8 * temp**3.0_r8 & + + 0.000135751_r8/crit_x + + cnum_tot = exp ( & + acoe & + + bcoe * log (rh) & + + ccoe * ( log (rh))**2.0_r8 & + + dcoe * ( log (rh))**3.0_r8 & + + ecoe * log (so4vol) & + + fcoe * (log (rh)) * (log (so4vol)) & + + gcoe * ((log (rh) ) **2.0_r8) & + * (log (so4vol)) & + + hcoe * (log (so4vol)) **2.0_r8 & + + icoe * log (rh) & + * ((log (so4vol)) **2.0_r8) & + + jcoe * (log (so4vol)) **3.0_r8 & + ) + + cnum_h2so4 = cnum_tot * crit_x + +! calc radius (nm) of critical cluster + radius_cluster = exp( -1.6524245_r8 + 0.42316402_r8*crit_x & + + 0.3346648_r8*log(cnum_tot) ) + + + return + end subroutine binary_nuc_vehk2002 + + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +subroutine modal_aero_newnuc_init + +!----------------------------------------------------------------------- +! +! Purpose: +! set do_adjust and do_aitken flags +! create history fields for column tendencies associated with +! modal_aero_calcsize +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +use modal_aero_data +use modal_aero_rename + +use cam_abortutils, only: endrun +use cam_history, only: addfld, add_default, fieldname_len, horiz_only +use constituents, only: pcnst, cnst_get_ind, cnst_name +use spmd_utils, only: masterproc +use phys_control, only: phys_getopts + + +implicit none + +!----------------------------------------------------------------------- +! arguments + +!----------------------------------------------------------------------- +! local + integer :: l_h2so4, l_nh3 + integer :: lnumait, lnh4ait, lso4ait + integer :: l, l1, l2 + integer :: m, mait + + character(len=fieldname_len) :: tmpname + character(len=fieldname_len+3) :: fieldname + character(128) :: long_name + character(8) :: unit + + logical :: dotend(pcnst) + logical :: history_aerosol ! Output the MAM aerosol tendencies + + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol ) + + +! set these indices +! skip if no h2so4 species +! skip if no aitken mode so4 or num species + l_h2so4_sv = 0 + l_nh3_sv = 0 + lnumait_sv = 0 + lnh4ait_sv = 0 + lso4ait_sv = 0 + + call cnst_get_ind( 'H2SO4', l_h2so4, .false. ) + call cnst_get_ind( 'NH3', l_nh3, .false. ) + + mait = modeptr_aitken + if (mait > 0) then + lnumait = numptr_amode(mait) + lso4ait = lptr_so4_a_amode(mait) + lnh4ait = lptr_nh4_a_amode(mait) + end if + if ((l_h2so4 <= 0) .or. (l_h2so4 > pcnst)) then + write(*,'(/a/)') & + '*** modal_aero_newnuc bypass -- l_h2so4 <= 0' + return + else if ((lso4ait <= 0) .or. (lso4ait > pcnst)) then + write(*,'(/a/)') & + '*** modal_aero_newnuc bypass -- lso4ait <= 0' + return + else if ((lnumait <= 0) .or. (lnumait > pcnst)) then + write(*,'(/a/)') & + '*** modal_aero_newnuc bypass -- lnumait <= 0' + return + else if ((mait <= 0) .or. (mait > ntot_amode)) then + write(*,'(/a/)') & + '*** modal_aero_newnuc bypass -- modeptr_aitken <= 0' + return + end if + + l_h2so4_sv = l_h2so4 + l_nh3_sv = l_nh3 + lnumait_sv = lnumait + lnh4ait_sv = lnh4ait + lso4ait_sv = lso4ait + +! set these constants +! mw_so4a_host is molec-wght of sulfate aerosol in host code +! 96 when nh3/nh4 are simulated +! something else when nh3/nh4 are not simulated + l = lptr_so4_a_amode(mait) ; l2 = -1 + if (l <= 0) call endrun( 'modal_aero_newnuch_init error a001 finding aitken so4' ) + do l1 = 1, nspec_amode(mait) + if (lmassptr_amode(l1,mait) == l) then + l2 = l1 + mw_so4a_host = specmw_amode(l1,mait) + dens_so4a_host = specdens_amode(l1,mait) + end if + end do + if (l2 <= 0) call endrun( 'modal_aero_newnuch_init error a002 finding aitken so4' ) + + l = lptr_nh4_a_amode(mait) ; l2 = -1 + if (l > 0) then + do l1 = 1, nspec_amode(mait) + if (lmassptr_amode(l1,mait) == l) then + l2 = l1 + mw_nh4a_host = specmw_amode(l1,mait) + end if + end do + if (l2 <= 0) call endrun( 'modal_aero_newnuch_init error a002 finding aitken nh4' ) + else + mw_nh4a_host = mw_so4a_host + end if + +! +! create history file column-tendency fields +! + dotend(:) = .false. + dotend(lnumait) = .true. + dotend(lso4ait) = .true. + dotend(l_h2so4) = .true. + if ((l_nh3 > 0) .and. (l_nh3 <= pcnst) .and. & + (lnh4ait > 0) .and. (lnh4ait <= pcnst)) then + dotend(lnh4ait) = .true. + dotend(l_nh3) = .true. + end if + + do l = 1, pcnst + if ( .not. dotend(l) ) cycle + tmpname = cnst_name(l) + unit = 'kg/m2/s' + do m = 1, ntot_amode + if (l == numptr_amode(m)) unit = '#/m2/s' + end do + fieldname = trim(tmpname) // '_sfnnuc1' + long_name = trim(tmpname) // ' modal_aero new particle nucleation column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + if ( masterproc ) write(*,'(3(a,2x))') & + 'modal_aero_newnuc_init addfld', fieldname, unit + end do ! l = ... + + + return + end subroutine modal_aero_newnuc_init + + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +subroutine ternary_nuc_merik2007( t, rh, c2, c3, j_log, ntot, nacid, namm, r ) +!subroutine ternary_fit( t, rh, c2, c3, j_log, ntot, nacid, namm, r ) +! *************************** ternary_fit.f90 ******************************** +! joonas merikanto, 2006 +! +! fortran 90 subroutine that calculates the parameterized composition +! and nucleation rate of critical clusters in h2o-h2so4-nh3 vapor +! +! warning: the fit should not be used outside its limits of validity +! (limits indicated below) +! +! in: +! t: temperature (k), limits 235-295 k +! rh: relative humidity as fraction (eg. 0.5=50%) limits 0.05-0.95 +! c2: sulfuric acid concentration (molecules/cm3) limits 5x10^4 - 10^9 molecules/cm3 +! c3: ammonia mixing ratio (ppt) limits 0.1 - 1000 ppt +! +! out: +! j_log: logarithm of nucleation rate (1/(s cm3)) +! ntot: total number of molecules in the critical cluster +! nacid: number of sulfuric acid molecules in the critical cluster +! namm: number of ammonia molecules in the critical cluster +! r: radius of the critical cluster (nm) +! **************************************************************************** +implicit none + +real(r8), intent(in) :: t, rh, c2, c3 +real(r8), intent(out) :: j_log, ntot, nacid, namm, r +real(r8) :: j, t_onset + +t_onset=143.6002929064716_r8 + 1.0178856665693992_r8*rh + & + 10.196398812974294_r8*log(c2) - & + 0.1849879416839113_r8*log(c2)**2 - 17.161783213150173_r8*log(c3) + & + (109.92469248546053_r8*log(c3))/log(c2) + & + 0.7734119613144357_r8*log(c2)*log(c3) - 0.15576469879527022_r8*log(c3)**2 + +if(t_onset.gt.t) then + + j_log=-12.861848898625231_r8 + 4.905527742256349_r8*c3 - 358.2337705052991_r8*rh -& + 0.05463019231872484_r8*c3*t + 4.8630382337426985_r8*rh*t + & + 0.00020258394697064567_r8*c3*t**2 - 0.02175548069741675_r8*rh*t**2 - & + 2.502406532869512e-7_r8*c3*t**3 + 0.00003212869941055865_r8*rh*t**3 - & + 4.39129415725234e6_r8/log(c2)**2 + (56383.93843154586_r8*t)/log(c2)**2 -& + (239.835990963361_r8*t**2)/log(c2)**2 + & + (0.33765136625580167_r8*t**3)/log(c2)**2 - & + (629.7882041830943_r8*rh)/(c3**3*log(c2)) + & + (7.772806552631709_r8*rh*t)/(c3**3*log(c2)) - & + (0.031974053936299256_r8*rh*t**2)/(c3**3*log(c2)) + & + (0.00004383764128775082_r8*rh*t**3)/(c3**3*log(c2)) + & + 1200.472096232311_r8*log(c2) - 17.37107890065621_r8*t*log(c2) + & + 0.08170681335921742_r8*t**2*log(c2) - 0.00012534476159729881_r8*t**3*log(c2) - & + 14.833042158178936_r8*log(c2)**2 + 0.2932631303555295_r8*t*log(c2)**2 - & + 0.0016497524241142845_r8*t**2*log(c2)**2 + & + 2.844074805239367e-6_r8*t**3*log(c2)**2 - 231375.56676032578_r8*log(c3) - & + 100.21645273730675_r8*rh*log(c3) + 2919.2852552424706_r8*t*log(c3) + & + 0.977886555834732_r8*rh*t*log(c3) - 12.286497122264588_r8*t**2*log(c3) - & + 0.0030511783284506377_r8*rh*t**2*log(c3) + & + 0.017249301826661612_r8*t**3*log(c3) + 2.967320346100855e-6_r8*rh*t**3*log(c3) + & + (2.360931724951942e6_r8*log(c3))/log(c2) - & + (29752.130254319443_r8*t*log(c3))/log(c2) + & + (125.04965118142027_r8*t**2*log(c3))/log(c2) - & + (0.1752996881934318_r8*t**3*log(c3))/log(c2) + & + 5599.912337254629_r8*log(c2)*log(c3) - 70.70896612937771_r8*t*log(c2)*log(c3) + & + 0.2978801613269466_r8*t**2*log(c2)*log(c3) - & + 0.00041866525019504_r8*t**3*log(c2)*log(c3) + 75061.15281456841_r8*log(c3)**2 - & + 931.8802278173565_r8*t*log(c3)**2 + 3.863266220840964_r8*t**2*log(c3)**2 - & + 0.005349472062284983_r8*t**3*log(c3)**2 - & + (732006.8180571689_r8*log(c3)**2)/log(c2) + & + (9100.06398573816_r8*t*log(c3)**2)/log(c2) - & + (37.771091915932004_r8*t**2*log(c3)**2)/log(c2) + & + (0.05235455395566905_r8*t**3*log(c3)**2)/log(c2) - & + 1911.0303773001353_r8*log(c2)*log(c3)**2 + & + 23.6903969622286_r8*t*log(c2)*log(c3)**2 - & + 0.09807872005428583_r8*t**2*log(c2)*log(c3)**2 + & + 0.00013564560238552576_r8*t**3*log(c2)*log(c3)**2 - & + 3180.5610833308_r8*log(c3)**3 + 39.08268568672095_r8*t*log(c3)**3 - & + 0.16048521066690752_r8*t**2*log(c3)**3 + & + 0.00022031380023793877_r8*t**3*log(c3)**3 + & + (40751.075322248245_r8*log(c3)**3)/log(c2) - & + (501.66977622013934_r8*t*log(c3)**3)/log(c2) + & + (2.063469732254135_r8*t**2*log(c3)**3)/log(c2) - & + (0.002836873785758324_r8*t**3*log(c3)**3)/log(c2) + & + 2.792313345723013_r8*log(c2)**2*log(c3)**3 - & + 0.03422552111802899_r8*t*log(c2)**2*log(c3)**3 + & + 0.00014019195277521142_r8*t**2*log(c2)**2*log(c3)**3 - & + 1.9201227328396297e-7_r8*t**3*log(c2)**2*log(c3)**3 - & + 980.923146020468_r8*log(rh) + 10.054155220444462_r8*t*log(rh) - & + 0.03306644502023841_r8*t**2*log(rh) + 0.000034274041225891804_r8*t**3*log(rh) + & + (16597.75554295064_r8*log(rh))/log(c2) - & + (175.2365504237746_r8*t*log(rh))/log(c2) + & + (0.6033215603167458_r8*t**2*log(rh))/log(c2) - & + (0.0006731787599587544_r8*t**3*log(rh))/log(c2) - & + 89.38961120336789_r8*log(c3)*log(rh) + 1.153344219304926_r8*t*log(c3)*log(rh) - & + 0.004954549700267233_r8*t**2*log(c3)*log(rh) + & + 7.096309866238719e-6_r8*t**3*log(c3)*log(rh) + & + 3.1712136610383244_r8*log(c3)**3*log(rh) - & + 0.037822330602328806_r8*t*log(c3)**3*log(rh) + & + 0.0001500555743561457_r8*t**2*log(c3)**3*log(rh) - & + 1.9828365865570703e-7_r8*t**3*log(c3)**3*log(rh) + + j=exp(j_log) + + ntot=57.40091052369212_r8 - 0.2996341884645408_r8*t + & + 0.0007395477768531926_r8*t**2 - & + 5.090604835032423_r8*log(c2) + 0.011016634044531128_r8*t*log(c2) + & + 0.06750032251225707_r8*log(c2)**2 - 0.8102831333223962_r8*log(c3) + & + 0.015905081275952426_r8*t*log(c3) - 0.2044174683159531_r8*log(c2)*log(c3) + & + 0.08918159167625832_r8*log(c3)**2 - 0.0004969033586666147_r8*t*log(c3)**2 + & + 0.005704394549007816_r8*log(c3)**3 + 3.4098703903474368_r8*log(j) - & + 0.014916956508210809_r8*t*log(j) + 0.08459090011666293_r8*log(c3)*log(j) - & + 0.00014800625143907616_r8*t*log(c3)*log(j) + 0.00503804694656905_r8*log(j)**2 + + r=3.2888553966535506e-10_r8 - 3.374171768439839e-12_r8*t + & + 1.8347359507774313e-14_r8*t**2 + 2.5419844298881856e-12_r8*log(c2) - & + 9.498107643050827e-14_r8*t*log(c2) + 7.446266520834559e-13_r8*log(c2)**2 + & + 2.4303397746137294e-11_r8*log(c3) + 1.589324325956633e-14_r8*t*log(c3) - & + 2.034596219775266e-12_r8*log(c2)*log(c3) - 5.59303954457172e-13_r8*log(c3)**2 - & + 4.889507104645867e-16_r8*t*log(c3)**2 + 1.3847024107506764e-13_r8*log(c3)**3 + & + 4.141077193427042e-15_r8*log(j) - 2.6813110884009767e-14_r8*t*log(j) + & + 1.2879071621313094e-12_r8*log(c3)*log(j) - & + 3.80352446061867e-15_r8*t*log(c3)*log(j) - 1.8790172502456827e-14_r8*log(j)**2 + + nacid=-4.7154180661803595_r8 + 0.13436423483953885_r8*t - & + 0.00047184686478816176_r8*t**2 - & + 2.564010713640308_r8*log(c2) + 0.011353312899114723_r8*t*log(c2) + & + 0.0010801941974317014_r8*log(c2)**2 + 0.5171368624197119_r8*log(c3) - & + 0.0027882479896204665_r8*t*log(c3) + 0.8066971907026886_r8*log(c3)**2 - & + 0.0031849094214409335_r8*t*log(c3)**2 - 0.09951184152927882_r8*log(c3)**3 + & + 0.00040072788891745513_r8*t*log(c3)**3 + 1.3276469271073974_r8*log(j) - & + 0.006167654171986281_r8*t*log(j) - 0.11061390967822708_r8*log(c3)*log(j) + & + 0.0004367575329273496_r8*t*log(c3)*log(j) + 0.000916366357266258_r8*log(j)**2 + + namm=71.20073903979772_r8 - 0.8409600103431923_r8*t + & + 0.0024803006590334922_r8*t**2 + & + 2.7798606841602607_r8*log(c2) - 0.01475023348171676_r8*t*log(c2) + & + 0.012264508212031405_r8*log(c2)**2 - 2.009926050440182_r8*log(c3) + & + 0.008689123511431527_r8*t*log(c3) - 0.009141180198955415_r8*log(c2)*log(c3) + & + 0.1374122553905617_r8*log(c3)**2 - 0.0006253227821679215_r8*t*log(c3)**2 + & + 0.00009377332742098946_r8*log(c3)**3 + 0.5202974341687757_r8*log(j) - & + 0.002419872323052805_r8*t*log(j) + 0.07916392322884074_r8*log(c3)*log(j) - & + 0.0003021586030317366_r8*t*log(c3)*log(j) + 0.0046977006608603395_r8*log(j)**2 + +else +! nucleation rate less that 5e-6, setting j_log arbitrary small + j_log=-300._r8 +end if + +return + +end subroutine ternary_nuc_merik2007 + +!---------------------------------------------------------------------- +end module modal_aero_newnuc + + + diff --git a/src/chemistry/modal_aero/modal_aero_rename.F90 b/src/chemistry/modal_aero/modal_aero_rename.F90 new file mode 100644 index 0000000000..aee74d75ac --- /dev/null +++ b/src/chemistry/modal_aero/modal_aero_rename.F90 @@ -0,0 +1,1820 @@ +! modal_aero_rename.F90 +!---------------------------------------------------------------------- +!BOP +! +! !MODULE: modal_aero_rename --- modal aerosol mode merging (renaming) +! +! !INTERFACE: + module modal_aero_rename + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use mo_constants, only: pi + use chem_mods, only: gas_pcnst + use ppgrid, only: pcols, pver + use constituents, only: pcnst, cnst_name + use spmd_utils, only: masterproc + use modal_aero_data, only: maxspec_renamexf=>nspec_max, ntot_amode + use modal_aero_data, only: alnsg_amode, voltonumblo_amode, voltonumbhi_amode, dgnum_amode, nspec_amode + use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode + use modal_aero_data, only: numptr_amode, numptrcw_amode, modeptr_coarse, modeptr_accum + use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode, numptr_amode, numptrcw_amode + use modal_aero_data, only: dgnumhi_amode, dgnumlo_amode, cnst_name_cw, modeptr_aitken + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public modal_aero_rename_sub, modal_aero_rename_init + +! !PUBLIC DATA MEMBERS: + integer, parameter :: pcnstxx = gas_pcnst + +! *** select one of the 3 following options +! *** for maxpair_renamexf = 2 or 3, use mode definition files with +! dgnumhi_amode(modeptr_accum) = 1.1e-6 m +! dgnumlo_amode(modeptr_coarse) = 0.9e-6 m + +! integer, parameter, public :: maxpair_renamexf = 1 +! integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001 /) + +! integer, parameter, public :: maxpair_renamexf = 2 +! integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001, 1003 /) + + integer, parameter, public :: maxpair_renamexf = 3 + integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001, 1003, 3001 /) +! ipair_select_renamexf defines the mode_from and mode_too for each renaming pair +! 2001 = aitken --> accum +! 1003 = accum --> coarse +! 3001 = coarse --> accum + + integer, parameter, public :: method_optbb_renamexf = 2 + + integer, public :: npair_renamexf = -123456789 + integer, protected, public :: modefrm_renamexf(maxpair_renamexf) + integer, protected, public :: modetoo_renamexf(maxpair_renamexf) + integer, protected, public :: nspecfrm_renamexf(maxpair_renamexf) + + integer, allocatable, protected, public :: lspecfrma_renamexf(:,:) + integer, allocatable, protected, public :: lspecfrmc_renamexf(:,:) + integer, allocatable, protected, public :: lspectooa_renamexf(:,:) + integer, allocatable, protected, public :: lspectooc_renamexf(:,:) + + integer, protected, public :: igrow_shrink_renamexf(maxpair_renamexf) + integer, protected, public :: ixferable_all_renamexf(maxpair_renamexf) + integer, protected, public :: ixferable_all_needed_renamexf(maxpair_renamexf) + integer, allocatable, protected, public :: ixferable_a_renamexf(:,:) + integer, allocatable, protected, public :: ixferable_c_renamexf(:,:) + + logical, public :: strat_only_renamexf(maxpair_renamexf) +! strat_only_renamexf - when true for a particular renaming pair, renaming is only +! done in stratosphere (when k < troplev(icol) ) + +! !PRIVATE DATA MEMBERS: + integer, allocatable :: ido_mode_calcaa(:) + real (r8) :: dp_belowcut(maxpair_renamexf) + real (r8) :: dp_cut(maxpair_renamexf) + real (r8) :: dp_xferall_thresh(maxpair_renamexf) + real (r8) :: dp_xfernone_threshaa(maxpair_renamexf) + real (r8), allocatable :: dryvol_smallest(:) + real (r8), allocatable :: factoraa(:) + real (r8), allocatable :: factoryy(:) + real (r8) :: lndp_cut(maxpair_renamexf) + real (r8) :: factor_3alnsg2(maxpair_renamexf) + real (r8), allocatable :: v2nhirlx(:), v2nlorlx(:) + + logical :: modal_accum_coarse_exch = .false. + +! !DESCRIPTION: This module implements ... +! +! !REVISION HISTORY: +! +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! list private module data here + +!EOC +!---------------------------------------------------------------------- +contains + + !------------------------------------------------------------------ + !------------------------------------------------------------------ + subroutine modal_aero_rename_init(modal_accum_coarse_exch_in) + logical, optional, intent(in) :: modal_accum_coarse_exch_in + + allocate( lspecfrma_renamexf(maxspec_renamexf,maxpair_renamexf) ) + allocate( lspecfrmc_renamexf(maxspec_renamexf,maxpair_renamexf) ) + allocate( lspectooa_renamexf(maxspec_renamexf,maxpair_renamexf) ) + allocate( lspectooc_renamexf(maxspec_renamexf,maxpair_renamexf) ) + + allocate( ixferable_a_renamexf(maxspec_renamexf,maxpair_renamexf) ) + allocate( ixferable_c_renamexf(maxspec_renamexf,maxpair_renamexf) ) + allocate( ido_mode_calcaa(ntot_amode) ) + + allocate( dryvol_smallest(ntot_amode) ) + allocate( factoraa(ntot_amode) ) + allocate( factoryy(ntot_amode) ) + + allocate( v2nhirlx(ntot_amode), v2nlorlx(ntot_amode) ) + + if (present(modal_accum_coarse_exch_in)) then + modal_accum_coarse_exch = modal_accum_coarse_exch_in + endif + + if (modal_accum_coarse_exch) then + call modal_aero_rename_acc_crs_init() + else + call modal_aero_rename_no_acc_crs_init() + endif + + end subroutine modal_aero_rename_init + + !------------------------------------------------------------------ + !------------------------------------------------------------------ + subroutine modal_aero_rename_sub( & + fromwhere, lchnk, & + ncol, nstep, & + loffset, deltat, & + pdel, troplev, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx, & + dqdt_rnpos ) + + + ! !PARAMETERS: + character(len=*), intent(in) :: fromwhere ! identifies which module + ! is making the call + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: nstep ! model time-step number + integer, intent(in) :: loffset ! offset applied to modal aero "ptrs" + real(r8), intent(in) :: deltat ! time step (s) + integer, intent(in) :: troplev(pcols) + + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array + ! *** MUST BE mol/mol-air or #/mol-air + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species + + real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process + ! the renaming tendencies are added on + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process + ! currently in cam3 + ! dqdt is from gas (h2so4, nh3) condensation + ! dqdt_other is from aqchem and soa + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which + ! renaming dqdt is computed + logical, intent(inout) :: dotendqqcwrn(pcnstxx) + + logical, intent(in) :: is_dorename_atik ! true if dorename_atik is provided + logical, intent(in) :: dorename_atik(ncol,pver) ! true if renaming should + ! be done at i,k + integer, intent(in) :: jsrflx_rename ! qsrflx index for renaming + integer, intent(in) :: nsrflx ! last dimension of qsrflx + + real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) + ! process-specific column tracer tendencies + real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) + real(r8), optional, intent(out) & + :: dqdt_rnpos(ncol,pver,pcnstxx) + ! the positive (production) part of the renaming tendency + + if (modal_accum_coarse_exch) then + call modal_aero_rename_acc_crs_sub( & + fromwhere, lchnk, & + ncol, nstep, & + loffset, deltat, & + pdel, troplev, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx, & + dqdt_rnpos ) + else + call modal_aero_rename_no_acc_crs_sub( & + fromwhere, lchnk, & + ncol, nstep, & + loffset, deltat, & + pdel, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx ) + endif + end subroutine modal_aero_rename_sub + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +! private methods +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: modal_aero_rename_no_acc_crs_sub --- ... +! +! !INTERFACE: + subroutine modal_aero_rename_no_acc_crs_sub( & + fromwhere, lchnk, & + ncol, nstep, & + loffset, deltat, & + pdel, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx ) + +! !USES: + use physconst, only: gravit, mwdry + use units, only: getunit + use shr_spfn_mod, only: erfc => shr_spfn_erfc + + implicit none + + +! !PARAMETERS: + character(len=*), intent(in) :: fromwhere ! identifies which module + ! is making the call + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: nstep ! model time-step number + integer, intent(in) :: loffset ! offset applied to modal aero "ptrs" + real(r8), intent(in) :: deltat ! time step (s) + + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array + ! *** MUST BE mol/mol-air or #/mol-air + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species + + real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process + ! the renaming tendencies are added on + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process + ! currently in cam3 + ! dqdt is from gas (h2so4, nh3) condensation + ! dqdt_other is from aqchem and soa + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which + ! renaming dqdt is computed + logical, intent(inout) :: dotendqqcwrn(pcnstxx) + + logical, intent(in) :: is_dorename_atik ! true if dorename_atik is provided + logical, intent(in) :: dorename_atik(ncol,pver) ! true if renaming should + ! be done at i,k + integer, intent(in) :: jsrflx_rename ! qsrflx index for renaming + integer, intent(in) :: nsrflx ! last dimension of qsrflx + + real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) + ! process-specific column tracer tendencies + real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) + +! !DESCRIPTION: +! computes TMR (tracer mixing ratio) tendencies for "mode renaming" +! during a continuous growth process +! currently this transfers number and mass (and surface) from the aitken +! to accumulation mode after gas condensation or stratiform-cloud +! aqueous chemistry +! (convective cloud aqueous chemistry not yet implemented) +! +! !REVISION HISTORY: +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer, parameter :: ldiag1=-1 + integer :: i, icol_diag, ipair, iq, j, k, l, l1, la, lc, lunout + integer :: lsfrma, lsfrmc, lstooa, lstooc + integer :: mfrm, mtoo, n, n1, n2, ntot_msa_a + integer :: idomode(ntot_amode) + integer, save :: lun = -1 ! logical unit for diagnostics (6, or other + ! if a special diagnostics file is opened) + + + real (r8) :: deldryvol_a(ncol,pver,ntot_amode) + real (r8) :: deldryvol_c(ncol,pver,ntot_amode) + real (r8) :: deltatinv + real (r8) :: dp_belowcut(maxpair_renamexf) + real (r8) :: dp_cut(maxpair_renamexf) + real (r8) :: dgn_aftr, dgn_xfer + real (r8) :: dgn_t_new, dgn_t_old + real (r8) :: dryvol_t_del, dryvol_t_new + real (r8) :: dryvol_t_old, dryvol_t_oldbnd + real (r8) :: dryvol_a(ncol,pver,ntot_amode) + real (r8) :: dryvol_c(ncol,pver,ntot_amode) + real (r8) :: dryvol_smallest(ntot_amode) + real (r8) :: dum + real (r8) :: dum3alnsg2(maxpair_renamexf) + real (r8) :: dum_m2v, dum_m2vdt + real (r8) :: factoraa(ntot_amode) + real (r8) :: factoryy(ntot_amode) + real (r8) :: frelax + real (r8) :: lndp_cut(maxpair_renamexf) + real (r8) :: lndgn_new, lndgn_old + real (r8) :: lndgv_new, lndgv_old + real (r8) :: num_t_old, num_t_oldbnd + real (r8) :: onethird + real (r8) :: pdel_fac + real (r8) :: tailfr_volnew, tailfr_volold + real (r8) :: tailfr_numnew, tailfr_numold + real (r8) :: v2nhirlx(ntot_amode), v2nlorlx(ntot_amode) + real (r8) :: xfercoef, xfertend + real (r8) :: xferfrac_vol, xferfrac_num, xferfrac_max + + real (r8) :: yn_tail, yv_tail + +! begin + lunout = iulog + +! get logical unit (for output to dumpconv, deactivate the "lun = 6") + lun = iulog + if (lun < 1) then + lun = getunit() + open( unit=lun, file='dump.rename', & + status='unknown', form='formatted' ) + end if + + +! +! calculations done once on initial entry +! +! "init" is now done through chem_init (and things under it) +! if (npair_renamexf .eq. -123456789) then +! npair_renamexf = 0 +! call modal_aero_rename_init +! end if + +! +! check if any renaming pairs exist +! + if (npair_renamexf .le. 0) return +! if (ncol .ne. -123456789) return +! if (fromwhere .eq. 'aqchem') return + +! +! compute aerosol dry-volume for the "from mode" of each renaming pair +! also compute dry-volume change during the continuous growth process +! using the incoming dqdt*deltat +! + deltatinv = 1.0_r8/(deltat*(1.0_r8 + 1.0e-15_r8)) + onethird = 1.0_r8/3.0_r8 + frelax = 27.0_r8 + xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps + + do n = 1, ntot_amode + idomode(n) = 0 + end do + + do ipair = 1, npair_renamexf + if (ipair .gt. 1) goto 8100 + idomode(modefrm_renamexf(ipair)) = 1 + + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + factoraa(mfrm) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mfrm)**2)) + factoraa(mtoo) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mtoo)**2)) + factoryy(mfrm) = sqrt( 0.5_r8 )/alnsg_amode(mfrm) +! dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air) +! used for avoiding overflow. it corresponds to dp = 1 nm +! and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air + dryvol_smallest(mfrm) = 1.0e-25_r8 + v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax + v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax + + dum3alnsg2(ipair) = 3.0_r8 * (alnsg_amode(mfrm)**2) + dp_cut(ipair) = sqrt( & + dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) * & + dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) ) + lndp_cut(ipair) = log( dp_cut(ipair) ) + dp_belowcut(ipair) = 0.99_r8*dp_cut(ipair) + end do + + do n = 1, ntot_amode + if (idomode(n) .gt. 0) then + dryvol_a(1:ncol,:,n) = 0.0_r8 + dryvol_c(1:ncol,:,n) = 0.0_r8 + deldryvol_a(1:ncol,:,n) = 0.0_r8 + deldryvol_c(1:ncol,:,n) = 0.0_r8 + do l1 = 1, nspec_amode(n) +! dum_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air) +! [m3-AP/kmol-AP]= [kg-AP/kmol-AP] / [kg-AP/m3-AP] + dum_m2v = specmw_amode(l1,n) / specdens_amode(l1,n) + dum_m2vdt = dum_m2v*deltat + la = lmassptr_amode(l1,n)-loffset + if (la > 0) then + dryvol_a(1:ncol,:,n) = dryvol_a(1:ncol,:,n) & + + dum_m2v*max( 0.0_r8, & + q(1:ncol,:,la)-deltat*dqdt_other(1:ncol,:,la) ) + deldryvol_a(1:ncol,:,n) = deldryvol_a(1:ncol,:,n) & + + (dqdt_other(1:ncol,:,la) + dqdt(1:ncol,:,la))*dum_m2vdt + end if + + lc = lmassptrcw_amode(l1,n)-loffset + if (lc > 0) then + dryvol_c(1:ncol,:,n) = dryvol_c(1:ncol,:,n) & + + dum_m2v*max( 0.0_r8, & + qqcw(1:ncol,:,lc)-deltat*dqqcwdt_other(1:ncol,:,lc) ) + deldryvol_c(1:ncol,:,n) = deldryvol_c(1:ncol,:,n) & + + (dqqcwdt_other(1:ncol,:,lc) + & + dqqcwdt(1:ncol,:,lc))*dum_m2vdt + end if + end do + end if + end do + + + +! +! loop over levels and columns to calc the renaming +! +mainloop1_k: do k = 1, pver +mainloop1_i: do i = 1, ncol + +! if dorename_atik is provided, then check if renaming needed at this i,k + if (is_dorename_atik) then + if (.not. dorename_atik(i,k)) cycle mainloop1_i + end if + pdel_fac = pdel(i,k)/gravit + +! +! loop over renameing pairs +! +mainloop1_ipair: do ipair = 1, npair_renamexf + + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + +! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode +! in m^3-AP/kmol-air +! dryvol_t_new is the new total dry-volume +! (old/new = before/after the continuous growth) + dryvol_t_old = dryvol_a(i,k,mfrm) + dryvol_c(i,k,mfrm) + dryvol_t_del = deldryvol_a(i,k,mfrm) + deldryvol_c(i,k,mfrm) + dryvol_t_new = dryvol_t_old + dryvol_t_del + dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) ) + +! no renaming if dryvol_t_new ~ 0 or dryvol_t_del ~ 0 + if (dryvol_t_new .le. dryvol_smallest(mfrm)) cycle mainloop1_ipair + if (dryvol_t_del .le. 1.0e-6_r8*dryvol_t_oldbnd) cycle mainloop1_ipair + +! num_t_old is total number in particles/kmol-air + num_t_old = q(i,k,numptr_amode(mfrm)-loffset) + num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset) + num_t_old = max( 0.0_r8, num_t_old ) + dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) ) + num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old ) + num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd ) + +! no renaming if dgnum < "base" dgnum, + dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird + if (dgn_t_new .le. dgnum_amode(mfrm)) cycle mainloop1_ipair + +! compute new fraction of number and mass in the tail (dp > dp_cut) + lndgn_new = log( dgn_t_new ) + lndgv_new = lndgn_new + dum3alnsg2(ipair) + yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm) + yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm) + tailfr_numnew = 0.5_r8*erfc( yn_tail ) + tailfr_volnew = 0.5_r8*erfc( yv_tail ) + +! compute old fraction of number and mass in the tail (dp > dp_cut) + dgn_t_old = & + (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird +! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_old and +! dp_belowcut to guarantee some transfer + if (dgn_t_new .ge. dp_cut(ipair)) then + dgn_t_old = min( dgn_t_old, dp_belowcut(ipair) ) + end if + lndgn_old = log( dgn_t_old ) + lndgv_old = lndgn_old + dum3alnsg2(ipair) + yn_tail = (lndp_cut(ipair) - lndgn_old)*factoryy(mfrm) + yv_tail = (lndp_cut(ipair) - lndgv_old)*factoryy(mfrm) + tailfr_numold = 0.5_r8*erfc( yn_tail ) + tailfr_volold = 0.5_r8*erfc( yv_tail ) + +! transfer fraction is difference between new and old tail-fractions +! transfer fraction for number cannot exceed that of mass + dum = tailfr_volnew*dryvol_t_new - tailfr_volold*dryvol_t_old + if (dum .le. 0.0_r8) cycle mainloop1_ipair + + xferfrac_vol = min( dum, dryvol_t_new )/dryvol_t_new + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) + xferfrac_num = tailfr_numnew - tailfr_numold + xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) ) + +! diagnostic output start ---------------------------------------- +!!$ if (ldiag1 > 0) then +!!$ icol_diag = -1 +!!$ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) icol_diag = i +!!$ if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then +!!$ ! write(lun,97010) fromwhere, nstep, lchnk, i, k, ipair +!!$ write(lun,97010) fromwhere, nstep, latndx(i), lonndx(i), k, ipair +!!$ write(lun,97020) 'drv old/oldbnd/new/del ', & +!!$ dryvol_t_old, dryvol_t_oldbnd, dryvol_t_new, dryvol_t_del +!!$ write(lun,97020) 'num old/oldbnd, dgnold/new ', & +!!$ num_t_old, num_t_oldbnd, dgn_t_old, dgn_t_new +!!$ write(lun,97020) 'tailfr v_old/new, n_old/new', & +!!$ tailfr_volold, tailfr_volnew, tailfr_numold, tailfr_numnew +!!$ dum = max(1.0e-10_r8,xferfrac_vol) / max(1.0e-10_r8,xferfrac_num) +!!$ dgn_xfer = dgn_t_new * dum**onethird +!!$ dum = max(1.0e-10_r8,(1.0_r8-xferfrac_vol)) / & +!!$ max(1.0e-10_r8,(1.0_r8-xferfrac_num)) +!!$ dgn_aftr = dgn_t_new * dum**onethird +!!$ write(lun,97020) 'xferfrac_v/n; dgn_xfer/aftr', & +!!$ xferfrac_vol, xferfrac_num, dgn_xfer, dgn_aftr +!!$ !97010 format( / 'RENAME ', a, ' nx,lc,i,k,ip', i8, 4i4 ) +!!$ 97010 format( / 'RENAME ', a, ' nx,lat,lon,k,ip', i8, 4i4 ) +!!$ 97020 format( a, 6(1pe15.7) ) +!!$ end if +!!$ end if +! diagnostic output end ------------------------------------------ + + +! +! compute tendencies for the renaming transfer +! + j = jsrflx_rename + do iq = 1, nspecfrm_renamexf(ipair) + xfercoef = xferfrac_vol*deltatinv + if (iq .eq. 1) xfercoef = xferfrac_num*deltatinv + + lsfrma = lspecfrma_renamexf(iq,ipair)-loffset + lsfrmc = lspecfrmc_renamexf(iq,ipair)-loffset + lstooa = lspectooa_renamexf(iq,ipair)-loffset + lstooc = lspectooc_renamexf(iq,ipair)-loffset + + if (lsfrma .gt. 0) then + xfertend = xfercoef*max( 0.0_r8, & + (q(i,k,lsfrma)+dqdt(i,k,lsfrma)*deltat) ) + +! diagnostic output start ---------------------------------------- + if (ldiag1 > 0) then + if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then + if (lstooa .gt. 0) then + write(*,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, & + cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), & + deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend), & + deltat*dqdt(i,k,lstooa), deltat*(dqdt(i,k,lstooa) + xfertend) + else + write(*,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, & + cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), & + deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend) + end if + end if + end if +! diagnostic output end ------------------------------------------ + + + dqdt(i,k,lsfrma) = dqdt(i,k,lsfrma) - xfertend + qsrflx(i,lsfrma,j) = qsrflx(i,lsfrma,j) - xfertend*pdel_fac + if (lstooa .gt. 0) then + dqdt(i,k,lstooa) = dqdt(i,k,lstooa) + xfertend + qsrflx(i,lstooa,j) = qsrflx(i,lstooa,j) + xfertend*pdel_fac + end if + end if + + if (lsfrmc .gt. 0) then + xfertend = xfercoef*max( 0.0_r8, & + (qqcw(i,k,lsfrmc)+dqqcwdt(i,k,lsfrmc)*deltat) ) + dqqcwdt(i,k,lsfrmc) = dqqcwdt(i,k,lsfrmc) - xfertend + qqcwsrflx(i,lsfrmc,j) = qqcwsrflx(i,lsfrmc,j) - xfertend*pdel_fac + if (lstooc .gt. 0) then + dqqcwdt(i,k,lstooc) = dqqcwdt(i,k,lstooc) + xfertend + qqcwsrflx(i,lstooc,j) = qqcwsrflx(i,lstooc,j) + xfertend*pdel_fac + end if + end if + + end do ! "iq = 1, nspecfrm_renamexf(ipair)" + + + end do mainloop1_ipair + + + end do mainloop1_i + end do mainloop1_k + +! +! set dotend's +! + dotendrn(:) = .false. + dotendqqcwrn(:) = .false. + do ipair = 1, npair_renamexf + do iq = 1, nspecfrm_renamexf(ipair) + lsfrma = lspecfrma_renamexf(iq,ipair) - loffset + lsfrmc = lspecfrmc_renamexf(iq,ipair) - loffset + lstooa = lspectooa_renamexf(iq,ipair) - loffset + lstooc = lspectooc_renamexf(iq,ipair) - loffset + if (lsfrma .gt. 0) then + dotendrn(lsfrma) = .true. + if (lstooa .gt. 0) dotendrn(lstooa) = .true. + end if + if (lsfrmc .gt. 0) then + dotendqqcwrn(lsfrmc) = .true. + if (lstooc .gt. 0) dotendqqcwrn(lstooc) = .true. + end if + end do + end do + + + return + + +! +! error -- renaming currently just works for 1 pair +! +8100 write(lunout,9050) ipair + call endrun( 'modal_aero_rename_no_acc_crs_sub error' ) +9050 format( / '*** subr. modal_aero_rename_no_acc_crs_sub ***' / & + 4x, 'aerosol renaming not implemented for ipair =', i5 ) + +!EOC + end subroutine modal_aero_rename_no_acc_crs_sub + + + +!------------------------------------------------------------------------- + subroutine modal_aero_rename_no_acc_crs_init +! +! computes pointers for species transfer during aerosol renaming +! (a2 --> a1 transfer) +! transfers include number_a, number_c, mass_a, mass_c and +! water_a +! + + implicit none + +! local variables + integer :: ipair, iq, iqfrm, iqtoo + integer :: lsfrma, lsfrmc, lstooa, lstooc, lunout + integer :: mfrm, mtoo + integer :: n1, n2, nspec + integer :: nchfrma, nchfrmc, nchfrmskip, nchtooa, nchtooc, nchtooskip + + lunout = iulog +! +! define "from mode" and "to mode" for each tail-xfer pairing +! currently just a2-->a1 +! + n1 = modeptr_accum + n2 = modeptr_aitken + if ((n1 .gt. 0) .and. (n2 .gt. 0)) then + npair_renamexf = 1 + modefrm_renamexf(1) = n2 + modetoo_renamexf(1) = n1 + else + npair_renamexf = 0 + return + end if + +! +! define species involved in each tail-xfer pairing +! (include aerosol water) +! +aa_ipair: do ipair = 1, npair_renamexf + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + if (mfrm < 10) then + nchfrmskip = 1 + else if (mfrm < 100) then + nchfrmskip = 2 + else + nchfrmskip = 3 + end if + if (mtoo < 10) then + nchtooskip = 1 + else if (mtoo < 100) then + nchtooskip = 2 + else + nchtooskip = 3 + end if + nspec = 0 +aa_iqfrm: do iqfrm = -1, nspec_amode(mfrm) + if (iqfrm == -1) then + lsfrma = numptr_amode(mfrm) + lstooa = numptr_amode(mtoo) + lsfrmc = numptrcw_amode(mfrm) + lstooc = numptrcw_amode(mtoo) + else if (iqfrm == 0) then +! bypass transfer of aerosol water due to renaming + cycle aa_iqfrm +! lsfrma = lwaterptr_amode(mfrm) +! lsfrmc = 0 +! lstooa = lwaterptr_amode(mtoo) +! lstooc = 0 + else + lsfrma = lmassptr_amode(iqfrm,mfrm) + lsfrmc = lmassptrcw_amode(iqfrm,mfrm) + lstooa = 0 + lstooc = 0 + end if + + + if ((lsfrma < 1) .or. (lsfrma > pcnst)) then + write(lunout,9100) mfrm, iqfrm, lsfrma + call endrun( 'modal_aero_rename_init error aa' ) + end if + if ((lsfrmc < 1) .or. (lsfrmc > pcnst)) then + write(lunout,9102) mfrm, iqfrm, lsfrmc + call endrun( 'modal_aero_rename_init error bb' ) + end if + + + if (iqfrm > 0) then + nchfrma = len( trim( cnst_name(lsfrma) ) ) - nchfrmskip + +! find "too" species having same lspectype_amode as the "frm" species +! AND same cnst_name (except for last 1/2/3 characters which are the mode index) + do iqtoo = 1, nspec_amode(mtoo) +! if ( lspectype_amode(iqtoo,mtoo) .eq. & +! lspectype_amode(iqfrm,mfrm) ) then + lstooa = lmassptr_amode(iqtoo,mtoo) + nchtooa = len( trim( cnst_name(lstooa) ) ) - nchtooskip + if (cnst_name(lsfrma)(1:nchfrma) == cnst_name(lstooa)(1:nchtooa)) then + ! interstitial names match, so check cloudborne names too + nchfrmc = len( trim( cnst_name_cw(lsfrmc) ) ) - nchfrmskip + lstooc = lmassptrcw_amode(iqtoo,mtoo) + nchtooc = len( trim( cnst_name_cw(lstooc) ) ) - nchtooskip + if (cnst_name_cw(lsfrmc)(1:nchfrmc) /= & + cnst_name_cw(lstooc)(1:nchtooc)) lstooc = 0 + exit + else + lstooa = 0 + end if +! end if + end do + end if ! (iqfrm > 0) + + if ((lstooc < 1) .or. (lstooc > pcnst)) lstooc = 0 + if ((lstooa < 1) .or. (lstooa > pcnst)) lstooa = 0 + if (lstooa == 0) then + write(lunout,9104) mfrm, iqfrm, lsfrma, iqtoo, lstooa + call endrun( 'modal_aero_rename_init error cc' ) + end if + if ((lstooc == 0) .and. (iqfrm /= 0)) then + write(lunout,9104) mfrm, iqfrm, lsfrmc, iqtoo, lstooc + call endrun( 'modal_aero_rename_init error dd' ) + end if + + nspec = nspec + 1 + lspecfrma_renamexf(nspec,ipair) = lsfrma + lspectooa_renamexf(nspec,ipair) = lstooa + lspecfrmc_renamexf(nspec,ipair) = lsfrmc + lspectooc_renamexf(nspec,ipair) = lstooc + end do aa_iqfrm + + nspecfrm_renamexf(ipair) = nspec + end do aa_ipair + +9100 format( / '*** subr. modal_aero_rename_no_acc_crs_init' / & + 'lspecfrma out of range' / & + 'modefrm, ispecfrm, lspecfrma =', 3i6 / ) +9102 format( / '*** subr. modal_aero_rename_no_acc_crs_init' / & + 'lspecfrmc out of range' / & + 'modefrm, ispecfrm, lspecfrmc =', 3i6 / ) +9104 format( / '*** subr. modal_aero_rename_no_acc_crs_init' / & + 'lspectooa out of range' / & + 'modefrm, ispecfrm, lspecfrma, ispectoo, lspectooa =', 5i6 / ) +9106 format( / '*** subr. modal_aero_rename_no_acc_crs_init' / & + 'lspectooc out of range' / & + 'modefrm, ispecfrm, lspecfrmc, ispectoo, lspectooc =', 5i6 / ) + +! +! output results +! + if ( masterproc ) then + + write(lunout,9310) + + do 2900 ipair = 1, npair_renamexf + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + write(lunout,9320) ipair, mfrm, mtoo + + do iq = 1, nspecfrm_renamexf(ipair) + lsfrma = lspecfrma_renamexf(iq,ipair) + lstooa = lspectooa_renamexf(iq,ipair) + lsfrmc = lspecfrmc_renamexf(iq,ipair) + lstooc = lspectooc_renamexf(iq,ipair) + if (lstooa .gt. 0) then + write(lunout,9330) lsfrma, cnst_name(lsfrma), & + lstooa, cnst_name(lstooa) + else + write(lunout,9340) lsfrma, cnst_name(lsfrma) + end if + if (lstooc .gt. 0) then + write(lunout,9330) lsfrmc, cnst_name_cw(lsfrmc), & + lstooc, cnst_name_cw(lstooc) + else if (lsfrmc .gt. 0) then + write(lunout,9340) lsfrmc, cnst_name_cw(lsfrmc) + else + write(lunout,9350) + end if + end do + +2900 continue + write(lunout,*) + + end if ! ( masterproc ) + +9310 format( / 'subr. modal_aero_rename_no_acc_crs_init' ) +9320 format( 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3 ) +9330 format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a ) +9340 format( 5x, 'spec', i3, '=', a, ' ---> LOSS' ) +9350 format( 5x, 'no corresponding activated species' ) + + return + end subroutine modal_aero_rename_no_acc_crs_init + +!---------------------------------------------------------------------- +! code for troposphere and stratosphere +! -- allows accumulation to coarse mode exchange +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: modal_aero_rename_acc_crs_sub --- ... +! +! !INTERFACE: + subroutine modal_aero_rename_acc_crs_sub( & + fromwhere, lchnk, & + ncol, nstep, & + loffset, deltat, & + pdel, troplev, & + dotendrn, q, & + dqdt, dqdt_other, & + dotendqqcwrn, qqcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx, qqcwsrflx, & + dqdt_rnpos ) + +! !USES: + + use physconst, only: gravit, mwdry + use units, only: getunit + use shr_spfn_mod, only: erfc => shr_spfn_erfc + + implicit none + + +! !PARAMETERS: + character(len=*), intent(in) :: fromwhere ! identifies which module + ! is making the call + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: nstep ! model time-step number + integer, intent(in) :: loffset ! offset applied to modal aero "ptrs" + real(r8), intent(in) :: deltat ! time step (s) + integer, intent(in) :: troplev(pcols) + + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array + ! *** MUST BE mol/mol-air or #/mol-air + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species + + real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process + ! the renaming tendencies are added on + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process + ! currently in cam3 + ! dqdt is from gas (h2so4, nh3) condensation + ! dqdt_other is from aqchem and soa + ! *** NOTE ncol and pcnstxx dimensions + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which + ! renaming dqdt is computed + logical, intent(inout) :: dotendqqcwrn(pcnstxx) + + logical, intent(in) :: is_dorename_atik ! true if dorename_atik is provided + logical, intent(in) :: dorename_atik(ncol,pver) ! true if renaming should + ! be done at i,k + integer, intent(in) :: jsrflx_rename ! qsrflx index for renaming + integer, intent(in) :: nsrflx ! last dimension of qsrflx + + real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) + ! process-specific column tracer tendencies + real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) + real(r8), optional, intent(out) & + :: dqdt_rnpos(ncol,pver,pcnstxx) + ! the positive (production) part of the renaming tendency + +! !DESCRIPTION: +! computes TMR (tracer mixing ratio) tendencies for "mode renaming" +! during a continuous growth process +! currently this transfers number and mass (and surface) from the aitken +! to accumulation mode after gas condensation or stratiform-cloud +! aqueous chemistry +! (convective cloud aqueous chemistry not yet implemented) +! +! !REVISION HISTORY: +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer, parameter :: ldiag1 = -1 + integer :: i, icol_diag, ipair, iq + integer :: j, k + integer :: l, l1, la, lc, lunout + integer :: lsfrma, lsfrmc, lstooa, lstooc + integer :: mfrm, mtoo, n, n1, n2, ntot_msa_a + integer, save :: lun = -1 ! logical unit for diagnostics (6, or other + ! if a special diagnostics file is opened) + + logical :: l_dqdt_rnpos + logical :: flagaa_shrink, flagbb_shrink + + real (r8) :: deldryvol_a(ncol,pver) + real (r8) :: deldryvol_c(ncol,pver) + real (r8) :: deltatinv + real (r8) :: dgn_aftr, dgn_xfer + real (r8) :: dgn_t_new, dgn_t_old, dgn_t_oldb + real (r8) :: dryvol_t_del, dryvol_t_new, dryvol_t_new_xfab + real (r8) :: dryvol_t_old, dryvol_t_oldb, dryvol_t_oldbnd + real (r8) :: dryvol_a(ncol,pver) + real (r8) :: dryvol_c(ncol,pver) + real (r8) :: dryvol_a_xfab(ncol,pver) + real (r8) :: dryvol_c_xfab(ncol,pver) + real (r8) :: dryvol_xferamt + real (r8) :: lndgn_new, lndgn_old + real (r8) :: lndgv_new, lndgv_old + real (r8) :: num_t_old, num_t_oldbnd + real (r8) :: onethird + real (r8) :: pdel_fac + real (r8) :: tailfr_volnew, tailfr_volold + real (r8) :: tailfr_numnew, tailfr_numold + real (r8) :: tmpa, tmpf + real (r8) :: tmp_m2v, tmp_m2vdt + real (r8) :: xfercoef, xfertend + real (r8) :: xferfrac_vol, xferfrac_num, xferfrac_max + + real (r8) :: yn_tail, yv_tail + +! begin + lunout = iulog + +! get logical unit (for output to dumpconv, deactivate the "lun = 6") + lun = iulog + if (lun < 1) then + lun = getunit() + open( unit=lun, file='dump.rename', & + status='unknown', form='formatted' ) + end if + + +! +! calculations done once on initial entry +! +! "init" is now done through chem_init (and things under it) +! if (npair_renamexf .eq. -123456789) then +! npair_renamexf = 0 +! call modal_aero_rename_init +! end if + +! +! check if any renaming pairs exist +! + if (npair_renamexf .le. 0) return +! if (ncol .ne. -123456789) return +! if (fromwhere .eq. 'aqchem') return + + + deltatinv = 1.0_r8/(deltat*(1.0_r8 + 1.0e-15_r8)) + onethird = 1.0_r8/3.0_r8 + xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps + + if ( present( dqdt_rnpos ) ) then + l_dqdt_rnpos = .true. + dqdt_rnpos(:,:,:) = 0.0_r8 + else + l_dqdt_rnpos = .false. + end if + + + +! +! loop over renaming pairs +! +mainloop1_ipair: do ipair = 1, npair_renamexf + + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + + flagaa_shrink = .false. + if ((mfrm==modeptr_coarse) .and. (mtoo==modeptr_accum)) & + flagaa_shrink = .true. + +! +! compute aerosol dry-volume for the "from mode" of each renaming pair +! also compute dry-volume change during the continuous growth process +! using the incoming dqdt*deltat +! + dryvol_a(:,:) = 0.0_r8 + dryvol_c(:,:) = 0.0_r8 + deldryvol_a(:,:) = 0.0_r8 + deldryvol_c(:,:) = 0.0_r8 + if (ixferable_all_renamexf(ipair) <= 0) then + dryvol_a_xfab(:,:) = 0.0_r8 + dryvol_c_xfab(:,:) = 0.0_r8 + end if + + n = mfrm + do l1 = 1, nspec_amode(n) +! tmp_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air) +! [m3-AP/kmol-AP]= [kg-AP/kmol-AP] / [kg-AP/m3-AP] + tmp_m2v = specmw_amode(l1,n) / specdens_amode(l1,n) + tmp_m2vdt = tmp_m2v*deltat + la = lmassptr_amode(l1,n)-loffset + if (la > 0) then + dryvol_a(1:ncol,:) = dryvol_a(1:ncol,:) & + + tmp_m2v*max( 0.0_r8, & + q(1:ncol,:,la)-deltat*dqdt_other(1:ncol,:,la) ) + deldryvol_a(1:ncol,:) = deldryvol_a(1:ncol,:) & + + (dqdt_other(1:ncol,:,la) + dqdt(1:ncol,:,la))*tmp_m2vdt + if ( (ixferable_all_renamexf(ipair) <= 0) .and. & + (ixferable_a_renamexf(l1,ipair) > 0) ) then + dryvol_a_xfab(1:ncol,:) = dryvol_a_xfab(1:ncol,:) & + + tmp_m2v*max( 0.0_r8, & + q(1:ncol,:,la)+deltat*dqdt(1:ncol,:,la) ) + end if + end if + + lc = lmassptrcw_amode(l1,n)-loffset + if (lc > 0) then + dryvol_c(1:ncol,:) = dryvol_c(1:ncol,:) & + + tmp_m2v*max( 0.0_r8, & + qqcw(1:ncol,:,lc)-deltat*dqqcwdt_other(1:ncol,:,lc) ) + deldryvol_c(1:ncol,:) = deldryvol_c(1:ncol,:) & + + (dqqcwdt_other(1:ncol,:,lc) + & + dqqcwdt(1:ncol,:,lc))*tmp_m2vdt + if ( (ixferable_all_renamexf(ipair) <= 0) .and. & + (ixferable_c_renamexf(l1,ipair) > 0) ) then + dryvol_c_xfab(1:ncol,:) = dryvol_c_xfab(1:ncol,:) & + + tmp_m2v*max( 0.0_r8, & + qqcw(1:ncol,:,lc)+deltat*dqqcwdt(1:ncol,:,lc) ) + end if + end if + end do + +! +! +! loop over levels and columns to calc the renaming +! +! +mainloop1_k: do k = 1, pver +mainloop1_i: do i = 1, ncol + +! if dorename_atik is provided, then check if renaming needed at this i,k + if (is_dorename_atik) then + if (.not. dorename_atik(i,k)) cycle mainloop1_i + end if + +! if strat_only_renamexf is true, then cycle when at or below the tropopause level + if ( strat_only_renamexf(ipair) ) then + if ( k >= troplev(i) ) cycle mainloop1_i + end if + + +! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode +! in m^3-AP/kmol-air +! dryvol_t_new is the new total dry-volume +! (old/new = before/after the continuous growth) + dryvol_t_old = dryvol_a(i,k) + dryvol_c(i,k) + dryvol_t_del = deldryvol_a(i,k) + deldryvol_c(i,k) + dryvol_t_new = dryvol_t_old + dryvol_t_del + dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) ) + +grow_shrink_conditional1: & + if (igrow_shrink_renamexf(ipair) > 0) then +! do renaming for growing particles + +! no renaming if dryvol_t_new ~ 0 + if (dryvol_t_new .le. dryvol_smallest(mfrm)) cycle mainloop1_i +! no renaming if delta_dryvol is very small or negative + if ( (method_optbb_renamexf /= 2) .and. & + (dryvol_t_del .le. 1.0e-6_r8*dryvol_t_oldbnd) ) cycle mainloop1_i + +! num_t_old is total number in particles/kmol-air + num_t_old = q(i,k,numptr_amode(mfrm)-loffset) + num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset) + num_t_old = max( 0.0_r8, num_t_old ) + dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) ) + num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old ) + num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd ) + +! compute new dgnum + dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird +! no renaming if dgn_t_new < threshold value + if (dgn_t_new .le. dp_xfernone_threshaa(ipair)) cycle mainloop1_i + +! compute old dgnum and possibly a smaller value to get more renaming transfer + dgn_t_old = & + (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird + dgn_t_oldb = dgn_t_old + dryvol_t_oldb = dryvol_t_old + if ( method_optbb_renamexf == 2) then + if (dgn_t_old .ge. dp_cut(ipair)) then + ! this revised volume corresponds to dgn_t_old == dp_belowcut, and same number conc + dryvol_t_oldb = dryvol_t_old * (dp_belowcut(ipair)/dgn_t_old)**3 + dgn_t_oldb = dp_belowcut(ipair) + end if + if (dgn_t_new .lt. dp_xferall_thresh(ipair)) then + ! no renaming if delta_dryvol is very small or negative + if ((dryvol_t_new-dryvol_t_oldb) .le. 1.0e-6_r8*dryvol_t_oldbnd) cycle mainloop1_i + end if + + else if (dgn_t_new .ge. dp_cut(ipair)) then +! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_oldb and +! dp_belowcut to guarantee some transfer + dgn_t_oldb = min( dgn_t_oldb, dp_belowcut(ipair) ) + end if + +! compute new fraction of number and mass in the tail (dp > dp_cut) + lndgn_new = log( dgn_t_new ) + lndgv_new = lndgn_new + factor_3alnsg2(ipair) + yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm) + yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm) + tailfr_numnew = 0.5_r8*erfc( yn_tail ) + tailfr_volnew = 0.5_r8*erfc( yv_tail ) + +! compute old fraction of number and mass in the tail (dp > dp_cut) + lndgn_old = log( dgn_t_oldb ) + lndgv_old = lndgn_old + factor_3alnsg2(ipair) + yn_tail = (lndp_cut(ipair) - lndgn_old)*factoryy(mfrm) + yv_tail = (lndp_cut(ipair) - lndgv_old)*factoryy(mfrm) + tailfr_numold = 0.5_r8*erfc( yn_tail ) + tailfr_volold = 0.5_r8*erfc( yv_tail ) + +! transfer fraction is difference between new and old tail-fractions +! transfer fraction for number cannot exceed that of mass + if ( (method_optbb_renamexf == 2) .and. & + (dgn_t_new .ge. dp_xferall_thresh(ipair)) ) then + dryvol_xferamt = dryvol_t_new + else + dryvol_xferamt = tailfr_volnew*dryvol_t_new - tailfr_volold*dryvol_t_oldb + end if + if (dryvol_xferamt .le. 0.0_r8) cycle mainloop1_i + + xferfrac_vol = max( 0.0_r8, (dryvol_xferamt/dryvol_t_new) ) + if ( method_optbb_renamexf == 2 .and. & + (xferfrac_vol >= xferfrac_max) ) then + ! transfer entire contents of mode + xferfrac_vol = 1.0_r8 + xferfrac_num = 1.0_r8 + else + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) + xferfrac_num = tailfr_numnew - tailfr_numold + xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) ) + end if + + if (ixferable_all_renamexf(ipair) <= 0) then + ! not all species are xferable + dryvol_t_new_xfab = max( 0.0_r8, (dryvol_a_xfab(i,k) + dryvol_c_xfab(i,k)) ) + dryvol_xferamt = xferfrac_vol*dryvol_t_new + if (dryvol_t_new_xfab >= 0.999999_r8*dryvol_xferamt) then + ! xferable dryvol can supply the needed dryvol_xferamt + ! but xferfrac_vol must be increased + xferfrac_vol = min( 1.0_r8, (dryvol_xferamt/dryvol_t_new_xfab) ) + else if (dryvol_t_new_xfab >= 1.0e-7_r8*dryvol_xferamt) then + ! xferable dryvol cannot supply the needed dryvol_xferamt + ! so transfer all of it, and reduce the number transfer + xferfrac_vol = 1.0_r8 + xferfrac_num = xferfrac_num*(dryvol_t_new_xfab/dryvol_xferamt) + else + ! xferable dryvol << needed dryvol_xferamt + cycle mainloop1_i + end if + end if + + else grow_shrink_conditional1 +! do renaming for shrinking particles + +! no renaming if (dryvol_t_old ~ 0) + if (dryvol_t_old .le. dryvol_smallest(mfrm)) cycle mainloop1_i + +! when (delta_dryvol is very small or positive), +! which means particles are not evaporating, +! only do renaming if [(flagaa_shrink true) and (in stratosphere)]], +! and set flagbb_shrink true to identify this special case + if (dryvol_t_del .ge. -1.0e-6_r8*dryvol_t_oldbnd) then + if ( ( flagaa_shrink ) .and. ( k < troplev(i) ) ) then + flagbb_shrink = .true. + else + cycle mainloop1_i + end if + else + flagbb_shrink = .false. + end if + +! num_t_old is total number in particles/kmol-air + num_t_old = q(i,k,numptr_amode(mfrm)-loffset) + num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset) + num_t_old = max( 0.0_r8, num_t_old ) + dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) ) + num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old ) + num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd ) + +! compute new dgnum + dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird +! no renaming if (dgn_t_new > xfernone threshold value) + if (dgn_t_new .ge. dp_xfernone_threshaa(ipair)) cycle mainloop1_i +! if (flagbb_shrink true), renaming only when (dgn_t_new <= dp_cut value) + if ( flagbb_shrink ) then + if (dgn_t_new .gt. dp_cut(ipair)) cycle mainloop1_i + end if + + if ( dgn_t_new .le. dp_xferall_thresh(ipair) ) then +! special case of (dgn_t_new <= xferall threshold value) + tailfr_numnew = 1.0_r8 + tailfr_volnew = 1.0_r8 + else +! compute new fraction of number and mass in the tail (dp < dp_cut) + lndgn_new = log( dgn_t_new ) + lndgv_new = lndgn_new + factor_3alnsg2(ipair) + yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm) + yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm) + tailfr_numnew = 1.0_r8 - 0.5_r8*erfc( yn_tail ) + tailfr_volnew = 1.0_r8 - 0.5_r8*erfc( yv_tail ) + end if + +! compute old dgnum + dgn_t_old = & + (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird + dgn_t_oldb = dgn_t_old + dryvol_t_oldb = dryvol_t_old + +! no need to compute old fraction of number and mass in the tail + tailfr_numold = 0.0_r8 + tailfr_volold = 0.0_r8 + +! transfer fraction is new tail-fraction + xferfrac_vol = tailfr_volnew + if (xferfrac_vol .le. 0.0_r8) cycle mainloop1_i + xferfrac_num = tailfr_numnew + + if (xferfrac_vol >= xferfrac_max) then + ! transfer entire contents of mode + xferfrac_vol = 1.0_r8 + xferfrac_num = 1.0_r8 + else + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) +! transfer fraction for number cannot be less than that of volume + xferfrac_num = max( xferfrac_num, xferfrac_vol ) + xferfrac_num = min( xferfrac_max, xferfrac_num ) + end if + + if (ixferable_all_renamexf(ipair) <= 0) then + ! not all species are xferable + dryvol_t_new_xfab = max( 0.0_r8, (dryvol_a_xfab(i,k) + dryvol_c_xfab(i,k)) ) + dryvol_xferamt = xferfrac_vol*dryvol_t_new + if (dryvol_t_new_xfab >= 0.999999_r8*dryvol_xferamt) then + ! xferable dryvol can supply the needed dryvol_xferamt + ! but xferfrac_vol must be increased + xferfrac_vol = min( 1.0_r8, (dryvol_xferamt/dryvol_t_new_xfab) ) + else if (dryvol_t_new_xfab >= 1.0e-7_r8*dryvol_xferamt) then + ! xferable dryvol cannot supply the needed dryvol_xferamt + ! so transfer all of it, and reduce the number transfer + xferfrac_vol = 1.0_r8 + xferfrac_num = xferfrac_num*(dryvol_t_new_xfab/dryvol_xferamt) + else + ! xferable dryvol << needed dryvol_xferamt + cycle mainloop1_i + end if + end if + + endif grow_shrink_conditional1 + + +!! diagnostic output start ---------------------------------------- +!! if (ldiag1 > 0) then +! icol_diag = -1 +! if ((lonndx(i) == 37) .and. (latndx(i) == 23)) icol_diag = i +!! if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then +!! qak +! if (ldiag1 <= 0) then +! if ((i == 1) .and. (k == 1)) then +!! qak +! ! write(lun,97010) fromwhere, nstep, lchnk, i, k, ipair +!! write(lun,97010) fromwhere, nstep, latndx(i), lonndx(i), k, ipair +!! write(lun,97020) 'drv old/oldb/oldbnd/new/del ', & +!! dryvol_t_old, dryvol_t_oldb, dryvol_t_oldbnd, & +!! dryvol_t_new, dryvol_t_del +!! write(lun,97020) 'num old/oldbnd, dgnold/oldb/new', & +!! num_t_old, num_t_oldbnd, dgn_t_old, dgn_t_oldb, dgn_t_new +!! write(lun,97020) 'tailfr v_old/new, n_old/new ', & +!! tailfr_volold, tailfr_volnew, tailfr_numold, tailfr_numnew +! tmpa = max(1.0e-10_r8,xferfrac_vol) / max(1.0e-10_r8,xferfrac_num) +! dgn_xfer = dgn_t_new * tmpa**onethird +! tmpa = max(1.0e-10_r8,(1.0_r8-xferfrac_vol)) / & +! max(1.0e-10_r8,(1.0_r8-xferfrac_num)) +!! dgn_aftr = dgn_t_new * tmpa**onethird +!! write(lun,97020) 'xferfrac_v/n; dgn_xfer/aftr ', & +!! xferfrac_vol, xferfrac_num, dgn_xfer, dgn_aftr +! !97010 format( / 'RENAME ', a, ' nx,lc,i,k,ip', i8, 4i4 ) +! 97010 format( / 'RENAME ', a, ' nx,lat,lon,k,ip', i8, 4i4 ) +! 97020 format( a, 6(1pe15.7) ) +! end if +! end if +! diagnostic output end ------------------------------------------ + + +! +! compute tendencies for the renaming transfer +! + pdel_fac = pdel(i,k)/gravit + j = jsrflx_rename + do iq = 1, nspecfrm_renamexf(ipair) + xfercoef = xferfrac_vol*deltatinv + if (iq .eq. 1) xfercoef = xferfrac_num*deltatinv + + lsfrma = lspecfrma_renamexf(iq,ipair)-loffset + lsfrmc = lspecfrmc_renamexf(iq,ipair)-loffset + lstooa = lspectooa_renamexf(iq,ipair)-loffset + lstooc = lspectooc_renamexf(iq,ipair)-loffset + + if (lsfrma .gt. 0) then + xfertend = xfercoef*max( 0.0_r8, & + (q(i,k,lsfrma)+dqdt(i,k,lsfrma)*deltat) ) + +! diagnostic output start ---------------------------------------- + if (ldiag1 > 0) then + if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then + if (lstooa .gt. 0) then + write(iulog,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, & + cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), & + deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend), & + deltat*dqdt(i,k,lstooa), deltat*(dqdt(i,k,lstooa) + xfertend) + else + write(iulog,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, & + cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), & + deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend) + end if + end if + end if +! diagnostic output end ------------------------------------------ + + + dqdt(i,k,lsfrma) = dqdt(i,k,lsfrma) - xfertend + qsrflx(i,lsfrma,j) = qsrflx(i,lsfrma,j) - xfertend*pdel_fac + if (lstooa .gt. 0) then + dqdt(i,k,lstooa) = dqdt(i,k,lstooa) + xfertend + qsrflx(i,lstooa,j) = qsrflx(i,lstooa,j) + xfertend*pdel_fac + if ( l_dqdt_rnpos ) & + dqdt_rnpos(i,k,lstooa) = dqdt_rnpos(i,k,lstooa) + xfertend + end if + end if + + if (lsfrmc .gt. 0) then + xfertend = xfercoef*max( 0.0_r8, & + (qqcw(i,k,lsfrmc)+dqqcwdt(i,k,lsfrmc)*deltat) ) + dqqcwdt(i,k,lsfrmc) = dqqcwdt(i,k,lsfrmc) - xfertend + qqcwsrflx(i,lsfrmc,j) = qqcwsrflx(i,lsfrmc,j) - xfertend*pdel_fac + if (lstooc .gt. 0) then + dqqcwdt(i,k,lstooc) = dqqcwdt(i,k,lstooc) + xfertend + qqcwsrflx(i,lstooc,j) = qqcwsrflx(i,lstooc,j) + xfertend*pdel_fac + end if + end if + + end do ! "iq = 1, nspecfrm_renamexf(ipair)" + + + end do mainloop1_i + end do mainloop1_k + + + end do mainloop1_ipair + +! +! set dotend's +! + dotendrn(:) = .false. + dotendqqcwrn(:) = .false. + do ipair = 1, npair_renamexf + do iq = 1, nspecfrm_renamexf(ipair) + lsfrma = lspecfrma_renamexf(iq,ipair) - loffset + lsfrmc = lspecfrmc_renamexf(iq,ipair) - loffset + lstooa = lspectooa_renamexf(iq,ipair) - loffset + lstooc = lspectooc_renamexf(iq,ipair) - loffset + if (lsfrma .gt. 0) then + dotendrn(lsfrma) = .true. + if (lstooa .gt. 0) dotendrn(lstooa) = .true. + end if + if (lsfrmc .gt. 0) then + dotendqqcwrn(lsfrmc) = .true. + if (lstooc .gt. 0) dotendqqcwrn(lstooc) = .true. + end if + end do + end do + + + return + + +! +! error -- renaming currently just works for 1 pair +! +8100 write(lunout,9050) ipair + call endrun( 'modal_aero_rename_acc_crs_sub error' ) +9050 format( / '*** subr. modal_aero_rename_acc_crs_sub ***' / & + 4x, 'aerosol renaming not implemented for ipair =', i5 ) + +!EOC + end subroutine modal_aero_rename_acc_crs_sub + + + +!------------------------------------------------------------------------- +! for modal aerosols in the troposphere and stratophere +! -- allows accumulation to coarse mode exchange +!------------------------------------------------------------------------- + subroutine modal_aero_rename_acc_crs_init +! +! computes pointers for species transfer during aerosol renaming +! (a2 --> a1 transfer) +! transfers include number_a, number_c, mass_a, mass_c and +! water_a +! + + implicit none + +! local variables + integer :: i, ipair, iq, iqfrm, iqtooa, iqtooc, itmpa + integer :: l, lsfrma, lsfrmc, lstooa, lstooc, lunout + integer :: mfrm, mtoo + integer :: n1, n2, nspec + integer :: nch_lfrm, nch_ltoo, nch_mfrmid, nch_mtooid + + real (r8) :: frelax + + lunout = iulog + +! +! define "from mode" and "to mode" for each tail-xfer pairing +! using the values in ipair_select_renamexf(:) +! + npair_renamexf = 0 + do ipair = 1, maxpair_renamexf + itmpa = ipair_select_renamexf(ipair) + if (itmpa == 0) then + exit + else if (itmpa == 2001) then + mfrm = modeptr_aitken + mtoo = modeptr_accum + igrow_shrink_renamexf(ipair) = 1 + ixferable_all_needed_renamexf(ipair) = 1 + strat_only_renamexf(ipair) = .false. + else if (itmpa == 1003) then + mfrm = modeptr_accum + mtoo = modeptr_coarse + igrow_shrink_renamexf(ipair) = 1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else if (itmpa == 3001) then + mfrm = modeptr_coarse + mtoo = modeptr_accum + igrow_shrink_renamexf(ipair) = -1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else + write(lunout,'(/2a,3(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'bad ipair_select_renamexf', ipair, itmpa + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + + do i = 1, ipair-1 + if (itmpa .eq. ipair_select_renamexf(i)) then + write(lunout,'(/2a/10(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'duplicates in ipair_select_renamexf', & + ipair_select_renamexf(1:ipair) + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + end do + + if ( (mfrm .ge. 1) .and. (mfrm .le. ntot_amode) .and. & + (mtoo .ge. 1) .and. (mtoo .le. ntot_amode) ) then + npair_renamexf = ipair + modefrm_renamexf(ipair) = mfrm + modetoo_renamexf(ipair) = mtoo + else + write(lunout,'(/2a,3(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'bad mfrm or mtoo', ipair, mfrm, mtoo + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + end do ! ipair + + if (npair_renamexf .le. 0) then + write(lunout,'(/a/a,3(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init -- npair_renamexf = 0' + return + end if + + +! +! define species involved in each tail-xfer pairing +! (include aerosol water) +! + do 1900 ipair = 1, npair_renamexf + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + ixferable_all_renamexf(ipair) = 1 + + if (mfrm < 10) then + nch_mfrmid = 1 + else if (mfrm < 100) then + nch_mfrmid = 2 + else + nch_mfrmid = 3 + end if + if (mtoo < 10) then + nch_mtooid = 1 + else if (mtoo < 100) then + nch_mtooid = 2 + else + nch_mtooid = 3 + end if + + nspec = 0 + do 1490 iqfrm = -1, nspec_amode(mfrm) + if (iqfrm .eq. -1) then + lsfrma = numptr_amode(mfrm) + lstooa = numptr_amode(mtoo) + lsfrmc = numptrcw_amode(mfrm) + lstooc = numptrcw_amode(mtoo) + else if (iqfrm .eq. 0) then +! bypass transfer of aerosol water due to renaming + goto 1490 +! lsfrma = lwaterptr_amode(mfrm) +! lsfrmc = 0 +! lstooa = lwaterptr_amode(mtoo) +! lstooc = 0 + else + lsfrma = lmassptr_amode(iqfrm,mfrm) + lsfrmc = lmassptrcw_amode(iqfrm,mfrm) + lstooa = 0 + lstooc = 0 + end if + + if ((lsfrma .lt. 1) .or. (lsfrma .gt. pcnst)) then + write(lunout,9100) ipair, mfrm, iqfrm, lsfrma + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + if (iqfrm .le. 0) goto 1430 + + if ((lsfrmc .lt. 1) .or. (lsfrmc .gt. pcnst)) then + write(lunout,9102) ipair, mfrm, iqfrm, lsfrmc + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + +! find "too" species having same name (except for mode number) as the "frm" species + nch_lfrm = len(trim(cnst_name(lsfrma))) - nch_mfrmid + iqtooa = -99 + do iq = 1, nspec_amode(mtoo) + l = lmassptr_amode(iq,mtoo) + if ((l .lt. 1) .or. (l .gt. pcnst)) cycle + nch_ltoo = len(trim(cnst_name(l))) - nch_mtooid + if ( cnst_name(lsfrma)(1:nch_lfrm) == & + cnst_name(l )(1:nch_ltoo) ) then + lstooa = l + iqtooa = iq + exit + end if + end do + + nch_lfrm = len(trim(cnst_name_cw(lsfrmc))) - nch_mfrmid + iqtooc = -99 + do iq = 1, nspec_amode(mtoo) + l = lmassptrcw_amode(iq,mtoo) + if ((l .lt. 1) .or. (l .gt. pcnst)) cycle + nch_ltoo = len(trim(cnst_name_cw(l))) - nch_mtooid + if ( cnst_name_cw(lsfrmc)(1:nch_lfrm) == & + cnst_name_cw(l )(1:nch_ltoo) ) then + lstooc = l + iqtooc = iq + exit + end if + end do + +1430 if ((lstooc .lt. 1) .or. (lstooc .gt. pcnst)) lstooc = 0 + if ((lstooa .lt. 1) .or. (lstooa .gt. pcnst)) lstooa = 0 + + if ((lstooa .eq. 0) .or. (lstooc .eq. 0)) then + if ( ( masterproc ) .or. & + ( (lstooa .ne. 0) .or. (lstooc .ne. 0) ) .or. & + ( ixferable_all_needed_renamexf(ipair) .gt. 0 ) ) then + if (lstooa .eq. 0) & + write(lunout,9104) trim(cnst_name(lsfrma)), & + ipair, mfrm, iqfrm, lsfrma, iqtooa, lstooa + if (lstooc .eq. 0) & + write(lunout,9106) trim(cnst_name_cw(lsfrmc)), & + ipair, mfrm, iqfrm, lsfrmc, iqtooc, lstooc + end if + if ((lstooa .ne. 0) .or. (lstooc .ne. 0)) then + write(lunout,9108) + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + if (ixferable_all_needed_renamexf(ipair) .gt. 0) then + write(lunout,9109) + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + ixferable_all_renamexf(ipair) = 0 + if (iqfrm .gt. 0) then + ixferable_a_renamexf(iqfrm,ipair) = 0 + ixferable_c_renamexf(iqfrm,ipair) = 0 + end if + else + nspec = nspec + 1 + lspecfrma_renamexf(nspec,ipair) = lsfrma + lspectooa_renamexf(nspec,ipair) = lstooa + lspecfrmc_renamexf(nspec,ipair) = lsfrmc + lspectooc_renamexf(nspec,ipair) = lstooc + if (iqfrm .gt. 0) then + ixferable_a_renamexf(iqfrm,ipair) = 1 + ixferable_c_renamexf(iqfrm,ipair) = 1 + end if + end if +1490 continue + + nspecfrm_renamexf(ipair) = nspec +1900 continue + +9100 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'lspecfrma out of range' / & + 'ipair, modefrm, ispecfrm, lspecfrma =', 4i6 ) +9102 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'lspecfrmc out of range' / & + 'ipair, modefrm, ispecfrm, lspecfrmc =', 4i6 ) +9104 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'lspectooa out of range for', 2x, a / & + 'ipair, modefrm, ispecfrm, lspecfrma, ispectoo, lspectooa =', 6i6 ) +9106 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'lspectooc out of range for', 2x, a / & + 'ipair, modefrm, ispecfrm, lspecfrmc, ispectoo, lspectooc =', 6i6 ) +9108 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'only one of lspectooa and lspectooc is out of range' ) +9109 format( / '*** subr. modal_aero_rename_acc_crs_init' / & + 'all species must be xferable for this pair' ) + + +! +! +! initialize some working variables +! +! + ido_mode_calcaa(:) = 0 + frelax = 27.0_r8 + + do ipair = 1, npair_renamexf + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + ido_mode_calcaa(mfrm) = 1 + + factoraa(mfrm) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mfrm)**2)) + factoraa(mtoo) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mtoo)**2)) + factoryy(mfrm) = sqrt( 0.5_r8 )/alnsg_amode(mfrm) + +! dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air) +! used for avoiding overflow. it corresponds to dp = 1 nm +! and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air + dryvol_smallest(mfrm) = 1.0e-25_r8 + v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax + v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax + + factor_3alnsg2(ipair) = 3.0_r8 * (alnsg_amode(mfrm)**2) + + dp_cut(ipair) = sqrt( & + dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) * & + dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) ) + dp_xferall_thresh(ipair) = dgnum_amode(mtoo) + dp_xfernone_threshaa(ipair) = dgnum_amode(mfrm) + + if ((mfrm == modeptr_accum) .and. (mtoo == modeptr_coarse)) then + dp_cut(ipair) = 4.4e-7_r8 + dp_xfernone_threshaa(ipair) = 1.6e-7_r8 + dp_xferall_thresh(ipair) = 4.7e-7_r8 + else if ((mfrm == modeptr_coarse) .and. (mtoo == modeptr_accum)) then + dp_cut(ipair) = 4.4e-7_r8 + dp_xfernone_threshaa(ipair) = 4.4e-7_r8 + dp_xferall_thresh(ipair) = 4.1e-7_r8 + end if + + lndp_cut(ipair) = log( dp_cut(ipair) ) + dp_belowcut(ipair) = 0.99_r8*dp_cut(ipair) + end do + + +! +! output results +! + if ( masterproc ) then + + write(lunout,9310) + write(lunout,'(a,1x,i12)') 'method_optbb_renamexf', method_optbb_renamexf + + do 2900 ipair = 1, npair_renamexf + mfrm = modefrm_renamexf(ipair) + mtoo = modetoo_renamexf(ipair) + write(lunout,9320) ipair, mfrm, mtoo, & + igrow_shrink_renamexf(ipair), ixferable_all_renamexf(ipair) + + do iq = 1, nspecfrm_renamexf(ipair) + lsfrma = lspecfrma_renamexf(iq,ipair) + lstooa = lspectooa_renamexf(iq,ipair) + lsfrmc = lspecfrmc_renamexf(iq,ipair) + lstooc = lspectooc_renamexf(iq,ipair) + if (lstooa .gt. 0) then + write(lunout,9330) lsfrma, cnst_name(lsfrma), & + lstooa, cnst_name(lstooa) + else + write(lunout,9340) lsfrma, cnst_name(lsfrma) + end if + if (lstooc .gt. 0) then + write(lunout,9330) lsfrmc, cnst_name_cw(lsfrmc), & + lstooc, cnst_name_cw(lstooc) + else if (lsfrmc .gt. 0) then + write(lunout,9340) lsfrmc, cnst_name_cw(lsfrmc) + else + write(lunout,9350) + end if + end do + + if (igrow_shrink_renamexf(ipair) > 0) then + write(lunout,'(5x,a,1p,2e12.3)') 'mfrm dgnum, dgnumhi ', & + dgnum_amode(mfrm), dgnumhi_amode(mfrm) + write(lunout,'(5x,a,1p,2e12.3)') 'mtoo dgnum, dgnumlo ', & + dgnum_amode(mtoo), dgnumlo_amode(mtoo) + else + write(lunout,'(5x,a,1p,2e12.3)') 'mfrm dgnum, dgnumlo ', & + dgnum_amode(mfrm), dgnumlo_amode(mfrm) + write(lunout,'(5x,a,1p,2e12.3)') 'mtoo dgnum, dgnumhi ', & + dgnum_amode(mtoo), dgnumhi_amode(mtoo) + end if + + write(lunout,'(5x,a,1p,2e12.3)') 'dp_cut ', & + dp_cut(ipair) + write(lunout,'(5x,a,1p,2e12.3)') 'dp_xfernone_threshaa', & + dp_xfernone_threshaa(ipair) + write(lunout,'(5x,a,1p,2e12.3)') 'dp_xferall_thresh ', & + dp_xferall_thresh(ipair) + +2900 continue + write(lunout,*) + + end if ! ( masterproc ) + +9310 format( / 'subr. modal_aero_rename_acc_crs_init' ) +9320 format( / 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3, & + 5x, 'igrow_shrink', i3, 5x, 'ixferable_all', i3 ) +9330 format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a ) +9340 format( 5x, 'spec', i3, '=', a, ' ---> LOSS' ) +9350 format( 5x, 'no corresponding activated species' ) + + + return + end subroutine modal_aero_rename_acc_crs_init + +!---------------------------------------------------------------------- + + end module modal_aero_rename diff --git a/src/chemistry/modal_aero/seasalt_model.F90 b/src/chemistry/modal_aero/seasalt_model.F90 new file mode 100644 index 0000000000..da917ad525 --- /dev/null +++ b/src/chemistry/modal_aero/seasalt_model.F90 @@ -0,0 +1,127 @@ +!=============================================================================== +! Seasalt for Modal Aerosol Model +!=============================================================================== +module seasalt_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use ppgrid, only: pcols, pver + use modal_aero_data,only: ntot_amode, nslt=>nSeaSalt + + implicit none + private + + public :: seasalt_nbin + public :: seasalt_nnum + public :: seasalt_names + public :: seasalt_indices + public :: seasalt_init + public :: seasalt_emis + public :: seasalt_active + + integer, protected :: seasalt_nbin ! = nslt + integer, protected :: seasalt_nnum ! = nnum + + character(len=6), protected, allocatable :: seasalt_names(:) + integer, protected, allocatable :: seasalt_indices(:) + + logical :: seasalt_active = .false. + + real(r8):: emis_scale + +contains + + !============================================================================= + !============================================================================= + subroutine seasalt_init(seasalt_emis_scale) + use sslt_sections, only: sslt_sections_init + use constituents, only: cnst_get_ind + use rad_constituents, only: rad_cnst_get_info + + real(r8), intent(in) :: seasalt_emis_scale + integer :: m, l, nspec, ndx + character(len=32) :: spec_name + + seasalt_nbin = nslt + seasalt_nnum = nslt + allocate(seasalt_names(2*nslt)) + allocate(seasalt_indices(2*nslt)) + + ndx=0 + do m = 1, ntot_amode + call rad_cnst_get_info(0, m, nspec=nspec) + do l = 1, nspec + call rad_cnst_get_info(0, m, l, spec_name=spec_name ) + if (spec_name(:3) == 'ncl') then + ndx=ndx+1 + seasalt_names(ndx) = spec_name + seasalt_names(nslt+ndx) = 'num_'//spec_name(5:) + call cnst_get_ind(seasalt_names( ndx), seasalt_indices( ndx)) + call cnst_get_ind(seasalt_names(nslt+ndx), seasalt_indices(nslt+ndx)) + endif + enddo + enddo + + seasalt_active = any(seasalt_indices(:) > 0) + if (.not.seasalt_active) return + + call sslt_sections_init() + + emis_scale = seasalt_emis_scale + + end subroutine seasalt_init + + !============================================================================= + !============================================================================= + subroutine seasalt_emis( u10cubed, srf_temp, ocnfrc, ncol, cflx ) + + use sslt_sections, only: nsections, fluxes, Dg, rdry + use mo_constants, only: dns_aer_sst=>seasalt_density, pi + + ! dummy arguments + real(r8), intent(in) :: u10cubed(:) + real(r8), intent(in) :: srf_temp(:) + real(r8), intent(in) :: ocnfrc(:) + integer, intent(in) :: ncol + real(r8), intent(inout) :: cflx(:,:) + + ! local vars + integer :: mn, mm, ibin, isec, i + real(r8) :: fi(ncol,nsections) + + real(r8) :: sst_sz_range_lo (nslt) + real(r8) :: sst_sz_range_hi (nslt) + + if (nslt==4) then + sst_sz_range_lo (:) = (/ 0.08e-6_r8, 0.02e-6_r8, 0.3e-6_r8, 1.0e-6_r8 /) ! accu, aitken, fine, coarse + sst_sz_range_hi (:) = (/ 0.3e-6_r8, 0.08e-6_r8, 1.0e-6_r8, 10.0e-6_r8 /) + else if (nslt==3) then + sst_sz_range_lo (:) = (/ 0.08e-6_r8, 0.02e-6_r8, 1.0e-6_r8 /) ! accu, aitken, coarse + sst_sz_range_hi (:) = (/ 1.0e-6_r8, 0.08e-6_r8, 10.0e-6_r8 /) + endif + + fi(:ncol,:nsections) = fluxes( srf_temp, u10cubed, ncol ) + + do ibin = 1,nslt + mm = seasalt_indices(ibin) + mn = seasalt_indices(nslt+ibin) + + if (mn>0) then + do i=1, nsections + if (Dg(i).ge.sst_sz_range_lo(ibin) .and. Dg(i).lt.sst_sz_range_hi(ibin)) then + cflx(:ncol,mn)=cflx(:ncol,mn)+fi(:ncol,i)*ocnfrc(:ncol)*emis_scale !++ ag: scale sea-salt + endif + enddo + endif + + cflx(:ncol,mm)=0.0_r8 + do i=1, nsections + if (Dg(i).ge.sst_sz_range_lo(ibin) .and. Dg(i).lt.sst_sz_range_hi(ibin)) then + cflx(:ncol,mm)=cflx(:ncol,mm)+fi(:ncol,i)*ocnfrc(:ncol)*emis_scale & !++ ag: scale sea-salt + *4._r8/3._r8*pi*rdry(i)**3*dns_aer_sst ! should use dry size, convert from number to mass flux (kg/m2/s) + endif + enddo + + enddo + + end subroutine seasalt_emis + +end module seasalt_model diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 new file mode 100644 index 0000000000..bacf94246c --- /dev/null +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -0,0 +1,520 @@ +!---------------------------------------------------------------------------------- +! Modal aerosol implementation +!---------------------------------------------------------------------------------- +module sox_cldaero_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate + use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode + use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode + use modal_aero_data, only : cnst_name_cw, specmw_so4_amode + use chem_mods, only : adv_mass + use physconst, only : gravit + use phys_control, only : phys_getopts + use cldaero_mod, only : cldaero_uptakerate + use chem_mods, only : gas_pcnst + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_msa, id_h2so4, id_so2, id_h2o2, id_nh3 + + real(r8), parameter :: small_value = 1.e-20_r8 + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + integer :: l, m + logical :: history_aerosol ! Output the MAM aerosol tendencies + + id_msa = get_spc_ndx( 'MSA' ) + id_h2so4 = get_spc_ndx( 'H2SO4' ) + id_so2 = get_spc_ndx( 'SO2' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + id_nh3 = get_spc_ndx( 'NH3' ) + + if (id_h2so4<1 .or. id_so2<1 .or. id_h2o2<1) then + call endrun('sox_cldaero_init:MAM mech does not include necessary species' & + //' -- should not invoke sox_cldaero_mod ') + endif + + call phys_getopts( history_aerosol_out = history_aerosol ) + ! + ! add to history + ! + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + type(cldaero_conc_t), pointer :: conc_obj + + + integer :: id_so4_1a, id_so4_2a, id_so4_3a, id_so4_4a, id_so4_5a, id_so4_6a + integer :: id_nh4_1a, id_nh4_2a, id_nh4_3a, id_nh4_4a, id_nh4_5a, id_nh4_6a + integer :: l,n + integer :: i,k + + logical :: mode7 + + mode7 = ntot_amode == 7 + + conc_obj => cldaero_allocate() + + do k = 1,pver + do i = 1,ncol + if( cldfrc(i,k) >0._r8) then + conc_obj%xlwc(i,k) = lwc(i,k) *cfact(i,k) ! cloud water L(water)/L(air) + conc_obj%xlwc(i,k) = conc_obj%xlwc(i,k) / cldfrc(i,k) ! liquid water in the cloudy fraction of cell + else + conc_obj%xlwc(i,k) = 0._r8 + endif + enddo + enddo + + conc_obj%no3c(:,:) = 0._r8 + + if (mode7) then +#if ( defined MODAL_AERO_7MODE ) +!put ifdef here so ifort will compile + id_so4_1a = lptr_so4_cw_amode(1) - loffset + id_so4_2a = lptr_so4_cw_amode(2) - loffset + id_so4_3a = lptr_so4_cw_amode(4) - loffset + id_so4_4a = lptr_so4_cw_amode(5) - loffset + id_so4_5a = lptr_so4_cw_amode(6) - loffset + id_so4_6a = lptr_so4_cw_amode(7) - loffset + + id_nh4_1a = lptr_nh4_cw_amode(1) - loffset + id_nh4_2a = lptr_nh4_cw_amode(2) - loffset + id_nh4_3a = lptr_nh4_cw_amode(4) - loffset + id_nh4_4a = lptr_nh4_cw_amode(5) - loffset + id_nh4_5a = lptr_nh4_cw_amode(6) - loffset + id_nh4_6a = lptr_nh4_cw_amode(7) - loffset +#endif + conc_obj%so4c(:ncol,:) & + = qcw(:ncol,:,id_so4_1a) & + + qcw(:ncol,:,id_so4_2a) & + + qcw(:ncol,:,id_so4_3a) & + + qcw(:ncol,:,id_so4_4a) & + + qcw(:ncol,:,id_so4_5a) & + + qcw(:ncol,:,id_so4_6a) + + conc_obj%nh4c(:ncol,:) & + = qcw(:ncol,:,id_nh4_1a) & + + qcw(:ncol,:,id_nh4_2a) & + + qcw(:ncol,:,id_nh4_3a) & + + qcw(:ncol,:,id_nh4_4a) & + + qcw(:ncol,:,id_nh4_5a) & + + qcw(:ncol,:,id_nh4_6a) + else + id_so4_1a = lptr_so4_cw_amode(1) - loffset + id_so4_2a = lptr_so4_cw_amode(2) - loffset + id_so4_3a = lptr_so4_cw_amode(3) - loffset + conc_obj%so4c(:ncol,:) & + = qcw(:,:,id_so4_1a) & + + qcw(:,:,id_so4_2a) & + + qcw(:,:,id_so4_3a) + + ! for 3-mode, so4 is assumed to be nh4hso4 + ! the partial neutralization of so4 is handled by using a + ! -1 charge (instead of -2) in the electro-neutrality equation + conc_obj%nh4c(:ncol,:) = 0._r8 + + ! with 3-mode, assume so4 is nh4hso4, and so half-neutralized + conc_obj%so4_fact = 1._r8 + + endif + + end function sox_cldaero_create_obj + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( & + ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) + + ! args + + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + + ! local vars ... + + real(r8) :: dqdt_aqso4(ncol,pver,gas_pcnst), & + dqdt_aqh2so4(ncol,pver,gas_pcnst), & + dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), & + sflx(1:ncol) + + real(r8) :: faqgain_msa(ntot_amode), faqgain_so4(ntot_amode), qnum_c(ntot_amode) + + real(r8) :: delso4_o3rxn, & + dso4dt_aqrxn, dso4dt_hprxn, & + dso4dt_gasuptk, dmsadt_gasuptk, & + dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, & + dqdt_aq, dqdt_wr, dqdt + + real(r8) :: fwetrem, sumf, uptkrate + real(r8) :: delnh3, delnh4 + + integer :: l, n, m + integer :: ntot_msa_c + + integer :: i,k + real(r8) :: xl + + ! make sure dqdt is zero initially, for budgets + dqdt_aqso4(:,:,:) = 0.0_r8 + dqdt_aqh2so4(:,:,:) = 0.0_r8 + dqdt_aqhprxn(:,:) = 0.0_r8 + dqdt_aqo3rxn(:,:) = 0.0_r8 + + lev_loop: do k = 1,pver + col_loop: do i = 1,ncol + cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then + xl = xlwc(i,k) ! / cldfrc(i,k) + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + delso4_o3rxn = xso4(i,k) - xso4_init(i,k) + + if (id_nh3>0) then + delnh3 = nh3g(i,k) - xnh3(i,k) + delnh4 = - delnh3 + endif + + !------------------------------------------------------------------------- + ! compute factors for partitioning aerosol mass gains among modes + ! the factors are proportional to the activated particle MR for each + ! mode, which is the MR of cloud drops "associated with" the mode + ! thus we are assuming the cloud drop size is independent of the + ! associated aerosol mode properties (i.e., drops associated with + ! Aitken and coarse sea-salt particles are same size) + ! + ! qnum_c(n) = activated particle number MR for mode n (these are just + ! used for partitioning among modes, so don't need to divide by cldfrc) + + do n = 1, ntot_amode + qnum_c(n) = 0.0_r8 + l = numptrcw_amode(n) - loffset + if (l > 0) qnum_c(n) = max( 0.0_r8, qcw(i,k,l) ) + end do + + ! force qnum_c(n) to be positive for n=modeptr_accum or n=1 + n = modeptr_accum + if (n <= 0) n = 1 + qnum_c(n) = max( 1.0e-10_r8, qnum_c(n) ) + + ! faqgain_so4(n) = fraction of total so4_c gain going to mode n + ! these are proportional to the activated particle MR for each mode + sumf = 0.0_r8 + do n = 1, ntot_amode + faqgain_so4(n) = 0.0_r8 + if (lptr_so4_cw_amode(n) > 0) then + faqgain_so4(n) = qnum_c(n) + sumf = sumf + faqgain_so4(n) + end if + end do + + if (sumf > 0.0_r8) then + do n = 1, ntot_amode + faqgain_so4(n) = faqgain_so4(n) / sumf + end do + end if + ! at this point (sumf <= 0.0) only when all the faqgain_so4 are zero + + ! faqgain_msa(n) = fraction of total msa_c gain going to mode n + ntot_msa_c = 0 + sumf = 0.0_r8 + do n = 1, ntot_amode + faqgain_msa(n) = 0.0_r8 + if (lptr_msa_cw_amode(n) > 0) then + faqgain_msa(n) = qnum_c(n) + ntot_msa_c = ntot_msa_c + 1 + end if + sumf = sumf + faqgain_msa(n) + end do + + if (sumf > 0.0_r8) then + do n = 1, ntot_amode + faqgain_msa(n) = faqgain_msa(n) / sumf + end do + end if + ! at this point (sumf <= 0.0) only when all the faqgain_msa are zero + + uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) ) + ! average uptake rate over dtime + uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime + + ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s) + ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s) + dso4dt_gasuptk = xh2so4(i,k) * uptkrate + if (id_msa > 0) then + dmsadt_gasuptk = xmsa(i,k) * uptkrate + else + dmsadt_gasuptk = 0.0_r8 + end if + + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 + dmsadt_gasuptk_toso4 = 0.0_r8 + dmsadt_gasuptk_tomsa = dmsadt_gasuptk + if (ntot_msa_c == 0) then + dmsadt_gasuptk_tomsa = 0.0_r8 + dmsadt_gasuptk_toso4 = dmsadt_gasuptk + end if + + !----------------------------------------------------------------------- + ! now compute TMR tendencies + ! this includes the above aqueous so2 chemistry AND + ! the uptake of highly soluble aerosol precursor gases (h2so4, msa, ...) + ! AND the wetremoval of dissolved, unreacted so2 and h2o2 + + dso4dt_aqrxn = (delso4_o3rxn + delso4_hprxn(i,k)) / dtime + dso4dt_hprxn = delso4_hprxn(i,k) / dtime + + ! fwetrem = fraction of in-cloud-water material that is wet removed + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't have so4 & msa wet removal here + + ! compute TMR tendencies for so4 and msa aerosol-in-cloud-water + do n = 1, ntot_amode + l = lptr_so4_cw_amode(n) - loffset + if (l > 0) then + dqdt_aqso4(i,k,l) = faqgain_so4(n)*dso4dt_aqrxn*cldfrc(i,k) + dqdt_aqh2so4(i,k,l) = faqgain_so4(n)* & + (dso4dt_gasuptk + dmsadt_gasuptk_toso4)*cldfrc(i,k) + dqdt_aq = dqdt_aqso4(i,k,l) + dqdt_aqh2so4(i,k,l) + dqdt_wr = -fwetrem*dqdt_aq + dqdt= dqdt_aq + dqdt_wr + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + end if + + l = lptr_msa_cw_amode(n) - loffset + if (l > 0) then + dqdt_aq = faqgain_msa(n)*dmsadt_gasuptk_tomsa*cldfrc(i,k) + dqdt_wr = -fwetrem*dqdt_aq + dqdt = dqdt_aq + dqdt_wr + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + end if + + l = lptr_nh4_cw_amode(n) - loffset + if (l > 0) then + if (delnh4 > 0.0_r8) then + dqdt_aq = faqgain_so4(n)*delnh4/dtime*cldfrc(i,k) + dqdt = dqdt_aq + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + else + dqdt = (qcw(i,k,l)/max(xnh4c(i,k),1.0e-35_r8)) & + *delnh4/dtime*cldfrc(i,k) + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + endif + end if + end do + + ! For gas species, tendency includes + ! reactive uptake to cloud water that essentially transforms the gas to + ! a different species. Wet removal associated with this is applied + ! to the "new" species (e.g., so4_c) rather than to the gas. + ! wet removal of the unreacted gas that is dissolved in cloud water. + ! Need to multiply both these parts by cldfrc + + ! h2so4 (g) & msa (g) + qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k) + if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k) + + ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include so2 wet removal here + + dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime + + ! h2o2 -- the first order loss rate for h2o2 is frh2o2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frh2o2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include h2o2 wet removal here + + dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_hprxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime + + ! NH3 + if (id_nh3>0) then + dqdt_aq = delnh3/dtime*cldfrc(i,k) + dqdt = dqdt_aq + qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime + endif + + ! for SO4 from H2O2/O3 budgets + dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k) + dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k) + + ENDIF !! WHEN CLOUD IS PRESENTED + endif cloud + enddo col_loop + enddo lev_loop + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + do k = 1,pver + + do n = 1, ntot_amode + + l = lptr_so4_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + l = lptr_msa_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + l = lptr_nh4_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + + end do + + qin(:,k,id_so2) = MAX( qin(:,k,id_so2), small_value ) + + if ( id_nh3 > 0 ) then + qin(:,k,id_nh3) = MAX( qin(:,k,id_nh3), small_value ) + endif + + end do + + ! diagnostics + + do n = 1, ntot_amode + m = lptr_so4_cw_amode(n) + l = m - loffset + if (l > 0) then + aqso4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqso4(i,n)=aqso4(i,n)+dqdt_aqso4(i,k,l)*adv_mass(l)/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + + aqh2so4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqh2so4(i,n)=aqh2so4(i,n)+dqdt_aqh2so4(i,k,l)*adv_mass(l)/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + endif + end do + + aqso4_h2o2(:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2(i)=aqso4_h2o2(i)+dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_h2o2_3d)) then + aqso4_h2o2_3d(:,:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2_3d(i,k)=dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + aqso4_o3(:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3(i)=aqso4_o3(i)+dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_o3_3d)) then + aqso4_o3_3d(:,:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3_3d(i,k)=dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + end subroutine sox_cldaero_update + + !---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module sox_cldaero_mod diff --git a/src/chemistry/mozart/cfc11star.F90 b/src/chemistry/mozart/cfc11star.F90 new file mode 100644 index 0000000000..35457a56bc --- /dev/null +++ b/src/chemistry/mozart/cfc11star.F90 @@ -0,0 +1,158 @@ +!--------------------------------------------------------------------------------- +! Manages the CFC11* for radiation +! 4 Dec 2009 -- Francis Vitt created +! 8 Mar 2013 -- expanded for waccm_tsmlt -- fvitt +!--------------------------------------------------------------------------------- +module cfc11star + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + use physics_buffer, only : pbuf_add_field, dtype_r8 + use ppgrid, only : pcols, pver, begchunk, endchunk + use spmd_utils, only : masterproc + use constituents, only : cnst_get_ind + use mo_chem_utls, only : get_inv_ndx + use mo_flbc, only : flbc_get_cfc11eq, flbc_has_cfc11eq + + implicit none + save + + private + public :: register_cfc11star + public :: update_cfc11star + public :: init_cfc11star + + logical :: do_cfc11star + character(len=16), parameter :: pbufname = 'CFC11STAR' + integer :: pbf_idx = -1 + integer, parameter :: ncfcs = 14 + + integer :: indices(ncfcs) + integer :: inv_indices(ncfcs) + + real(r8) :: rel_rf(ncfcs) + character(len=8), parameter :: species(ncfcs) = & + (/ 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CCL4 ','CH3CCL3 ','CH3CL ','HCFC22 ',& + 'HCFC141B','HCFC142B','CF2CLBR ','CF3BR ','H2402 ','HALONS ' /) + +contains + +!--------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------- + subroutine register_cfc11star + + implicit none + + integer :: m + + real(r8), parameter :: cfc_rf(ncfcs) = & + (/ 0.25_r8, 0.30_r8, 0.31_r8, 0.18_r8, 0.13_r8, 0.06_r8, 0.01_r8, 0.20_r8, & + 0.14_r8, 0.20_r8, 0.30_r8, 0.32_r8, 0.33_r8, 0.25_r8 /) ! W/m2/ppb + + do m = 1, ncfcs + call cnst_get_ind(species(m), indices(m), abort=.false.) + if (indices(m)<=0) then + inv_indices(m)=get_inv_ndx(species(m)) + end if + enddo + + do_cfc11star = (any(indices(:)>0).or.any(inv_indices(:)>0)) + if (.not.do_cfc11star) return + + call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver/),pbf_idx) + + rel_rf(:) = cfc_rf(:) / cfc_rf(1) + + endsubroutine register_cfc11star + +!--------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------- + subroutine init_cfc11star(pbuf2d) + use cam_history, only : addfld, horiz_only + use infnan, only : nan, assignment(=) + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + real(r8) :: real_nan + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (.not.do_cfc11star) return + + real_nan = nan + call pbuf_set_field(pbuf2d, pbf_idx, real_nan) + + call addfld(pbufname,(/ 'lev' /),'A','kg/kg','cfc11star for radiation' ) + + if (flbc_has_cfc11eq) then + call addfld('CFC11STAR0', (/ 'lev' /), 'A','kg/kg','cfc11star for radiation before scaling' ) + call addfld('CFC11EQ_LBC', horiz_only, 'A','mole/mole','cfc11eq LBC' ) + endif + + if (masterproc) then + write(iulog,*) 'init_cfc11star: CFC11STAR is added to pbuf2d for radiation' + endif + end subroutine init_cfc11star + +!--------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------- + subroutine update_cfc11star( pbuf2d, phys_state ) + + use cam_history, only : outfld + use physics_types, only : physics_state + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use tracer_cnst, only : get_cnst_data_ptr ! returns pointer to + + implicit none + + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + integer :: lchnk, ncol + integer :: c, m, k + real(r8), pointer :: cf11star(:,:) + real(r8), pointer :: cnst_offline(:,:) + real(r8) :: cfc11eq_vmr(pcols) + real(r8) :: scale_factor(pcols) + real(r8), parameter :: vmr2mmr = 137.35_r8/28.97_r8 + + if (.not.do_cfc11star) return + + do c = begchunk,endchunk + lchnk = phys_state(c)%lchnk + ncol = phys_state(c)%ncol + + call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), pbf_idx, cf11star) + + cf11star(:ncol,:) = 0._r8 + do m = 1, ncfcs + if ( indices(m)>0 ) then + cf11star(:ncol,:) = cf11star(:ncol,:) & + + phys_state(c)%q(:ncol,:,indices(m)) * rel_rf(m) + elseif (inv_indices(m)>0) then + call get_cnst_data_ptr( species(m), phys_state(c), cnst_offline, pbuf_get_chunk(pbuf2d, lchnk) ) + cf11star(:ncol,:) = cf11star(:ncol,:) & + + cnst_offline(:ncol,:) * rel_rf(m) + endif + enddo + + if (flbc_has_cfc11eq) then + call flbc_get_cfc11eq( cfc11eq_vmr, ncol, lchnk ) + + call outfld( 'CFC11EQ_LBC', cfc11eq_vmr(:ncol), ncol, lchnk) + call outfld( 'CFC11STAR0', cf11star(:ncol,:), ncol, lchnk) + + ! scale according to CAM's CFC11_eq + scale_factor(:ncol) = (vmr2mmr*cfc11eq_vmr(:ncol))/cf11star(:ncol,pver) + do k = 1,pver + cf11star(:ncol,k) = scale_factor(:ncol)*cf11star(:ncol,k) + enddo + endif + + call outfld( pbufname, cf11star(:ncol,:), ncol, lchnk) + + enddo + + endsubroutine update_cfc11star + +end module cfc11star diff --git a/src/chemistry/mozart/charge_neutrality.F90 b/src/chemistry/mozart/charge_neutrality.F90 new file mode 100644 index 0000000000..a4b48e1b3a --- /dev/null +++ b/src/chemistry/mozart/charge_neutrality.F90 @@ -0,0 +1,163 @@ +module charge_neutrality + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use chem_mods, only : gas_pcnst + + implicit none + + private + public :: charge_balance + + interface charge_balance + module procedure charge_fix_vmr + module procedure charge_fix_mmr ! for fixing charge balance after vertical diffusion + end interface + + integer, parameter :: pos_ion_n = 20 + character(len=16), parameter :: pos_ion_names(pos_ion_n) = (/ & + 'Np ','N2p ','Op ','O2p ','NOp ', & + 'O4p ','O2p_H2O ','Hp_H2O ','Hp_2H2O ','Hp_3H2O ', & + 'Hp_4H2O ','Hp_5H2O ','H3Op_OH ','Hp_3N1 ','Hp_4N1 ', & + 'NOp_H2O ','NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_N2 ' /) + + integer, parameter :: neg_ion_n = 21 + character(len=16), parameter :: neg_ion_names(neg_ion_n) = (/ & + 'Om ','O2m ','O3m ','O4m ','OHm ', & + 'CO3m ','CO4m ','NO2m ','NO3m ','HCO3m ', & + 'CLm ','CLOm ','CLm_H2O ','CLm_HCL ','CO3m_H2O ', & + 'NO3m_H2O ','CO3m2H2O ','NO2m_H2O ','NO3m2H2O ','NO3mHNO3 ', & + 'NO3m_HCL ' /) + +contains + + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + subroutine charge_fix_vmr( ncol, vmr ) + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(inout) :: vmr(:,:,:) ! concentration + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i, k, n + integer :: elec_ndx + real(r8) :: wrk(ncol,pver) + + elec_ndx = get_spc_ndx('e') + + !-------------------------------------------------------------------- + ! If electrons are in the chemistry add up charges to get electrons + !-------------------------------------------------------------------- + if( elec_ndx > 0 ) then + wrk(:,:) = 0._r8 + + do i = 1,pos_ion_n + n = get_spc_ndx(pos_ion_names(i)) + if (n>0) then + wrk(:ncol,:) = wrk(:ncol,:) + vmr(:ncol,:,n) + endif + enddo + do i = 1,neg_ion_n + n = get_spc_ndx(neg_ion_names(i)) + if (n>0) then + wrk(:ncol,:) = wrk(:ncol,:) - vmr(:ncol,:,n) + endif + enddo + + vmr(:ncol,:,elec_ndx) = max(0._r8,wrk(:ncol,:)) + end if + + end subroutine charge_fix_vmr + + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + subroutine charge_fix_mmr(state, pbuf) + + use constituents, only : cnst_get_ind + use physconst, only : mbarv ! Constituent dependent mbar + use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species in pbuf + use chem_mods, only : adv_mass + use physics_buffer, only : pbuf_get_field,physics_buffer_desc ! Needed to get variables from physics buffer + use physics_types, only : physics_state + use infnan, only : nan, assignment(=) + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type(physics_state), intent(inout), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i, n, ns, nc + integer :: elec_ndx + integer :: lchnk !Chunk number from state structure + integer :: ncol !Number of columns in this chunk from state structure + + real(r8), dimension(:,:,:), pointer :: q ! model mass mixing ratios + real(r8), dimension(:,:), pointer :: qs ! Pointer to access fields in pbuf + real(r8), dimension(:,:), pointer :: mbar + + real(r8) :: vmr(pcols,pver,gas_pcnst) + character(len=16) :: name + + !----------------------------------------------------------------------- + elec_ndx = get_spc_ndx('e') + + !-------------------------------------------------------------------- + ! If electrons are simulated enforce charge neutrality ... + !-------------------------------------------------------------------- + if( elec_ndx > 0 ) then + lchnk = state%lchnk + ncol = state%ncol + q => state%q + mbar => mbarv(:ncol,:,lchnk) + vmr = nan + + do i = 1,pos_ion_n+neg_ion_n + if (i .le. pos_ion_n) then + name = pos_ion_names(i) + else + name = neg_ion_names(i-pos_ion_n) + endif + n = get_spc_ndx(name) + + if (n>0) then + call cnst_get_ind( name, nc, abort=.false. ) + if (nc>0) then + vmr(:ncol,:,n) = mbar(:ncol,:) * q(:ncol,:,nc) / adv_mass(n) + else + ns = slvd_index( name ) + call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) + vmr(:ncol,:,n) = mbar(:ncol,:) * qs(:ncol,:) / adv_mass(n) + endif + endif + enddo + + call charge_balance( ncol, vmr ) + + call cnst_get_ind( 'e', nc, abort=.false. ) + + if (nc>0) then + q(:ncol,:,nc) = adv_mass(elec_ndx) * vmr(:ncol,:,elec_ndx) / mbar(:ncol,:) + else + ns = slvd_index( 'e' ) + call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) + qs(:ncol,:) = adv_mass(elec_ndx) * vmr(:ncol,:,elec_ndx) / mbar(:ncol,:) + endif + + endif + + end subroutine charge_fix_mmr + +end module charge_neutrality diff --git a/src/chemistry/mozart/chem_prod_loss_diags.F90 b/src/chemistry/mozart/chem_prod_loss_diags.F90 new file mode 100644 index 0000000000..021a70c380 --- /dev/null +++ b/src/chemistry/mozart/chem_prod_loss_diags.F90 @@ -0,0 +1,121 @@ +module chem_prod_loss_diags + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt1, clscnt4, gas_pcnst, clsmap, permute + use ppgrid, only : pver + use chem_mods, only : rxntot + use cam_history, only : addfld, outfld, add_default + use mo_tracname, only : solsym + + implicit none + + private + public :: chem_prod_loss_diags_init + public :: chem_prod_loss_diags_out + +contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine chem_prod_loss_diags_init + use phys_control, only : phys_getopts + + + integer :: i,j + logical :: history_scwaccm_forcing + call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) + + do i = 1,clscnt4 + j = clsmap(i,4) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + if (history_scwaccm_forcing ) then + if ( trim(solsym(j))=='CH4' .or. & + trim(solsym(j))=='CFC11' .or. & + trim(solsym(j))=='CFC12' .or. & + trim(solsym(j))=='N2O' ) then + call add_default( trim(solsym(j))//'_CHML', 1, ' ') + endif + endif + enddo + do i = 1,clscnt1 + j = clsmap(i,1) + if (history_scwaccm_forcing ) then + if ( trim(solsym(j))=='CH4' .or. & + trim(solsym(j))=='CFC11' .or. & + trim(solsym(j))=='CFC12' .or. & + trim(solsym(j))=='N2O' ) then + call add_default( trim(solsym(j))//'_CHML', 1, ' ') + endif + endif + enddo + + call addfld('H_PEROX_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'total ROOH production rate' ) !PJY changed "RO2" to "ROOH" + + end subroutine chem_prod_loss_diags_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine chem_prod_loss_diags_out( ncol, lchnk, base_sol, reaction_rates, prod_in, loss_in, xhnm ) + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: base_sol(ncol,pver,gas_pcnst) + real(r8), intent(in) :: reaction_rates(ncol,pver,max(1,rxntot)) + real(r8), intent(in) :: prod_in(ncol,pver,max(1,clscnt4)) + real(r8), intent(in) :: loss_in(ncol,pver,max(1,clscnt4)) + real(r8), intent(in) :: xhnm(ncol,pver) + + real(r8), dimension(ncol,pver,max(1,clscnt4)) :: prod_out, loss_out + real(r8), dimension(ncol,pver) :: prod_hydrogen_peroxides_out + integer :: lev, i, k, j, m + + level_loop : do lev = 1,pver + column_loop : do i = 1,ncol + + !----------------------------------------------------------------------- + ! ... Prod/Loss history buffers... + !----------------------------------------------------------------------- + cls_loop2: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + prod_out(i,lev,k) = prod_in(i,lev,m) + loss_out(i,lev,k) = loss_in(i,lev,m) + end do cls_loop2 + end do column_loop + end do level_loop + + prod_hydrogen_peroxides_out(:,:) = 0._r8 + + do i = 1,clscnt4 + j = clsmap(i,4) + prod_out(:,:,i) = prod_out(:,:,i)*xhnm(:,:) + loss_out(:,:,i) = loss_out(:,:,i)*xhnm(:,:) + call outfld( trim(solsym(j))//'_CHMP', prod_out(:,:,i), ncol, lchnk ) + call outfld( trim(solsym(j))//'_CHML', loss_out(:,:,i), ncol, lchnk ) + ! + ! added code for ROOH production !PJY not "RO2 production" + ! + if ( trim(solsym(j)) == 'ALKOOH' & + .or.trim(solsym(j)) == 'C2H5OOH' & + .or.trim(solsym(j)) == 'CH3OOH' & !PJY added this + .or.trim(solsym(j)) == 'CH3COOH' & + .or.trim(solsym(j)) == 'CH3COOOH' & + .or.trim(solsym(j)) == 'C3H7OOH' & !PJY corrected this (from CH3H7OOH) + .or.trim(solsym(j)) == 'EOOH' & + .or.trim(solsym(j)) == 'ISOPOOH' & + .or.trim(solsym(j)) == 'MACROOH' & + .or.trim(solsym(j)) == 'MEKOOH' & + .or.trim(solsym(j)) == 'POOH' & + .or.trim(solsym(j)) == 'ROOH' & + .or.trim(solsym(j)) == 'TERPOOH' & + .or.trim(solsym(j)) == 'TOLOOH' & + .or.trim(solsym(j)) == 'XOOH' ) then + prod_hydrogen_peroxides_out(:,:) = prod_hydrogen_peroxides_out(:,:) + prod_out(:,:,i) + end if + enddo + + call outfld( 'H_PEROX_CHMP', prod_hydrogen_peroxides_out(:,:), ncol, lchnk ) + + end subroutine chem_prod_loss_diags_out + +end module chem_prod_loss_diags + diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 new file mode 100644 index 0000000000..774d16403b --- /dev/null +++ b/src/chemistry/mozart/chemistry.F90 @@ -0,0 +1,1507 @@ +module chemistry + +!--------------------------------------------------------------------------------- +! "Interactive" gas phase module +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use ppgrid, only : pcols, pver, begchunk, endchunk + use physconst, only : gravit + use constituents, only : pcnst, cnst_add, cnst_name, cnst_fixed_ubc, cnst_type + use chem_mods, only : gas_pcnst + use cam_history, only : fieldname_len + use physics_types, only : physics_state, physics_ptend, physics_ptend_init + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + use mo_gas_phase_chemdr, only : map2chm + use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n + use tracer_data, only : MAXTRCRS + use gcr_ionization, only : gcr_ionization_readnl, gcr_ionization_init, gcr_ionization_adv + use epp_ionization, only : epp_ionization_readnl, epp_ionization_adv + use mo_apex, only : mo_apex_readnl + use ref_pres, only : do_molec_diff, ptop_ref + use phys_control, only : waccmx_is ! WACCM-X switch query function + + implicit none + private + save + +!--------------------------------------------------------------------------------- +! Public interfaces +!--------------------------------------------------------------------------------- + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_readnl ! read chem namelist + public :: chem_is_active ! returns true + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_init ! per timestep initializations + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_emissions + + integer, public :: imozart = -1 ! index of 1st constituent + + ! Namelist variables + + ! control + + integer :: chem_freq = 1 ! time steps + + ! ghg + + character(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate + character(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) + + ! lightning + + real(r8) :: lght_no_prd_factor = 1._r8 + + ! photolysis + + logical :: xactive_prates = .false. + character(len=shr_kind_cl) :: rsf_file = 'rsf_file' + character(len=shr_kind_cl) :: exo_coldens_file = '' + character(len=shr_kind_cl) :: tuv_xsect_file = 'tuv_xsect_file' + character(len=shr_kind_cl) :: o2_xsect_file = 'o2_xsect_file' + character(len=shr_kind_cl) :: xs_coef_file = 'xs_coef_file' + character(len=shr_kind_cl) :: xs_short_file = 'xs_short_file' + character(len=shr_kind_cl) :: xs_long_file = 'xs_long_file' + character(len=shr_kind_cl) :: electron_file = 'electron_file' + character(len=shr_kind_cl) :: euvac_file = 'NONE' + + ! solar / geomag data + + character(len=shr_kind_cl) :: photon_file = 'photon_file' + + ! dry dep + + character(len=shr_kind_cl) :: depvel_file = 'depvel_file' + character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' + character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' + character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' + + ! emis + + character(len=shr_kind_cl) :: airpl_emis_file = '' ! airplane emissions + character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' + character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' + + character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' + integer :: srf_emis_cycle_yr = 0 + integer :: srf_emis_fixed_ymd = 0 + integer :: srf_emis_fixed_tod = 0 + + character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' + integer :: ext_frc_cycle_yr = 0 + integer :: ext_frc_fixed_ymd = 0 + integer :: ext_frc_fixed_tod = 0 + + ! fixed stratosphere + + character(len=shr_kind_cl) :: fstrat_file = 'fstrat_file' + character(len=16) :: fstrat_list(pcnst) = '' + +! for linoz + character(len=shr_kind_cl) :: chlorine_loading_file = '' + character(len=8) :: chlorine_loading_type = 'SERIAL' ! "FIXED" or "SERIAL" + integer :: chlorine_loading_fixed_ymd = 0 ! YYYYMMDD for "FIXED" type + integer :: chlorine_loading_fixed_tod = 0 ! seconds of day for "FIXED" type + +!--------------------------------------------------------------------------------- +! dummy values for specific heats at constant pressure +!--------------------------------------------------------------------------------- + real(r8), parameter :: cptmp = 666._r8 + + character(len=fieldname_len) :: srcnam(gas_pcnst) ! names of source/sink tendencies + + integer :: ixcldliq, ixcldice ! indicies of liquid and ice cloud water + integer :: ndx_cld + integer :: ndx_cmfdqr + integer :: ndx_nevapr + integer :: ndx_prain + integer :: ndx_cldtop + integer :: h2o_ndx + integer :: ixndrop ! cloud droplet number index + integer :: ndx_pblh + integer :: ndx_fsds + + logical :: ghg_chem = .false. ! .true. => use ghg chem package + logical :: chem_step = .true. + logical :: is_active = .false. + + character(len=32) :: chem_name = 'NONE' + logical :: chem_rad_passive = .false. + + ! for MEGAN emissions + integer, allocatable :: megan_indices_map(:) + real(r8),allocatable :: megan_wght_factors(:) + + logical :: chem_use_chemtrop = .false. + +!================================================================================================ +contains +!================================================================================================ + +logical function chem_is (name) + use phys_control, only : cam_chempkg_is + + character(len=*), intent(in) :: name + chem_is = cam_chempkg_is(name) + +end function chem_is + +!================================================================================================ + + subroutine chem_register +!----------------------------------------------------------------------- +! +! Purpose: register advected constituents and physics buffer fields +! +!----------------------------------------------------------------------- + + use mo_sim_dat, only : set_sim_dat + use chem_mods, only : gas_pcnst, adv_mass + use mo_tracname, only : solsym + use mo_chem_utls, only : get_spc_ndx + use short_lived_species, only : slvd_index, short_lived_map=>map, register_short_lived_species + use cfc11star, only : register_cfc11star + use mo_photo, only : photo_register + use mo_aurora, only : aurora_register + use aero_model, only : aero_model_register + + implicit none + +!----------------------------------------------------------------------- +! Local variables +!----------------------------------------------------------------------- + integer :: m, n ! tracer index + real(r8) :: qmin ! min value + logical :: ic_from_cam2 ! wrk variable for initial cond input + logical :: has_fixed_ubc ! wrk variable for upper bndy cond + logical :: has_fixed_ubflx ! wrk variable for upper bndy flux + integer :: ch4_ndx, n2o_ndx, o3_ndx + integer :: cfc11_ndx, cfc12_ndx, o2_1s_ndx, o2_1d_ndx, o2_ndx + integer :: n_ndx, no_ndx, h_ndx, h2_ndx, o_ndx, e_ndx, np_ndx + integer :: op_ndx, o1d_ndx, n2d_ndx, nop_ndx, n2p_ndx, o2p_ndx + integer :: hf_ndx, f_ndx + + character(len=128) :: lng_name ! variable long name + logical :: cam_outfld + character(len=128) :: mixtype + character(len=128) :: molectype + integer :: islvd + +!----------------------------------------------------------------------- +! Set the simulation chemistry variables +!----------------------------------------------------------------------- + call set_sim_dat + + o3_ndx = get_spc_ndx('O3') + ch4_ndx = get_spc_ndx('CH4') + n2o_ndx = get_spc_ndx('N2O') + + cfc11_ndx = get_spc_ndx('CFC11') + cfc12_ndx = get_spc_ndx('CFC12') + o2_1s_ndx = get_spc_ndx('O2_1S') + o2_1d_ndx = get_spc_ndx('O2_1D') + o2_ndx = get_spc_ndx('O2') + n_ndx = get_spc_ndx('N') + no_ndx = get_spc_ndx('NO') + h_ndx = get_spc_ndx('H') + h2_ndx = get_spc_ndx('H2') + o_ndx = get_spc_ndx('O') + e_ndx = get_spc_ndx('e') + np_ndx = get_spc_ndx('Np') + op_ndx = get_spc_ndx('Op') + o1d_ndx = get_spc_ndx('O1D') + n2d_ndx = get_spc_ndx('N2D') + n2p_ndx = get_spc_ndx('N2p') + nop_ndx = get_spc_ndx('NOp') + h2o_ndx = get_spc_ndx('H2O') + o2p_ndx = get_spc_ndx('O2p') + + f_ndx = get_spc_ndx('F') + hf_ndx = get_spc_ndx('HF') + + + !----------------------------------------------------------------------- + ! Set names of diffused variable tendencies and declare them as history variables + !----------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + ! For WACCM-X, change variable has_fixed_ubc from .true. to .false. which is a flag + ! used later to check for a fixed upper boundary condition for species. + !---------------------------------------------------------------------------------- + do m = 1,gas_pcnst + ! setting of these variables is for registration of transported species + ic_from_cam2 = .true. + has_fixed_ubc = .false. + has_fixed_ubflx = .false. + lng_name = trim( solsym(m) ) + molectype = 'minor' + + qmin = 1.e-36_r8 + + if ( lng_name(1:5) .eq. 'num_a' ) then ! aerosol number density + qmin = 1.e-5_r8 + else if ( m == o3_ndx ) then + qmin = 1.e-12_r8 + else if ( m == ch4_ndx ) then + qmin = 1.e-12_r8 + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + has_fixed_ubc = .false. ! diffusive equilibrium at UB + else + has_fixed_ubc = .true. + endif + else if ( m == n2o_ndx ) then + qmin = 1.e-15_r8 + else if( m == cfc11_ndx .or. m == cfc12_ndx ) then + qmin = 1.e-20_r8 + else if( m == o2_1s_ndx .or. m == o2_1d_ndx ) then + ic_from_cam2 = .false. + if( m == o2_1d_ndx ) then + lng_name = 'O2(1-delta)' + else + lng_name = 'O2(1-sigma)' + end if + else if ( m==o2_ndx .or. m==n_ndx .or. m==no_ndx .or. m==h_ndx .or. m==h2_ndx .or. m==o_ndx .or. m==hf_ndx & + .or. m==f_ndx ) then + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + has_fixed_ubc = .false. ! diffusive equilibrium at UB + if ( m == h_ndx ) has_fixed_ubflx = .true. ! fixed flux value for H at UB + if ( m == o2_ndx .or. m == o_ndx ) molectype = 'major' + else + has_fixed_ubc = .true. + endif + else if( m == e_ndx ) then + lng_name = 'electron concentration' + else if( m == np_ndx ) then + lng_name = 'N+' + else if( m == op_ndx ) then + lng_name = 'O+' + else if( m == o1d_ndx ) then + lng_name = 'O(1D)' + else if( m == n2d_ndx ) then + lng_name = 'N(2D)' + else if( m == o2p_ndx ) then + lng_name = 'O2+' + else if( m == n2p_ndx ) then + lng_name = 'N2+' + else if( m == nop_ndx ) then + lng_name = 'NO+' + else if( m == h2o_ndx ) then + map2chm(1) = m + cycle + endif + + cam_outfld=.false. + is_active = .true. + mixtype = 'dry' + + islvd = slvd_index(solsym(m)) + + if ( islvd > 0 ) then + short_lived_map(islvd) = m + else + call cnst_add( solsym(m), adv_mass(m), cptmp, qmin, n, readiv=ic_from_cam2, cam_outfld=cam_outfld, & + mixtype=mixtype, molectype=molectype, fixed_ubc=has_fixed_ubc, fixed_ubflx=has_fixed_ubflx, & + longname=trim(lng_name) ) + + if( imozart == -1 ) then + imozart = n + end if + map2chm(n) = m + endif + + end do + + call register_short_lived_species() + call register_cfc11star() + + if ( waccmx_is('ionosphere') ) then + call photo_register() + call aurora_register() + endif + + ! add fields to pbuf needed by aerosol models + call aero_model_register() + + end subroutine chem_register + +!================================================================================================ + + subroutine chem_readnl(nlfile) + + ! Read chem namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + use linoz_data, only: linoz_data_defaultopts, linoz_data_setopts + use tracer_cnst, only: tracer_cnst_defaultopts, tracer_cnst_setopts + use tracer_srcs, only: tracer_srcs_defaultopts, tracer_srcs_setopts + use aero_model, only: aero_model_readnl + use dust_model, only: dust_readnl + use gas_wetdep_opts, only: gas_wetdep_readnl + use upper_bc, only: ubc_defaultopts, ubc_setopts + use mo_drydep, only: drydep_srf_file + use noy_ubc, only: noy_ubc_readnl + use mo_sulf, only: sulf_readnl + use species_sums_diags,only: species_sums_readnl + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + integer :: unitn, ierr + + ! linoz data + character(len=shr_kind_cl) :: linoz_data_file ! prescribed data file + character(len=shr_kind_cl) :: linoz_data_filelist ! list of prescribed data files (series of files) + character(len=shr_kind_cl) :: linoz_data_path ! absolute path of prescribed data files + character(len=24) :: linoz_data_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default) + logical :: linoz_data_rmfile ! remove data file from local disk (default .false.) + integer :: linoz_data_cycle_yr + integer :: linoz_data_fixed_ymd + integer :: linoz_data_fixed_tod + + ! trop_mozart prescribed constituent concentratons + character(len=shr_kind_cl) :: tracer_cnst_file ! prescribed data file + character(len=shr_kind_cl) :: tracer_cnst_filelist ! list of prescribed data files (series of files) + character(len=shr_kind_cl) :: tracer_cnst_datapath ! absolute path of prescribed data files + character(len=24) :: tracer_cnst_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default) + character(len=shr_kind_cl) :: tracer_cnst_specifier(MAXTRCRS) ! string array where each + logical :: tracer_cnst_rmfile ! remove data file from local disk (default .false.) + integer :: tracer_cnst_cycle_yr + integer :: tracer_cnst_fixed_ymd + integer :: tracer_cnst_fixed_tod + + ! trop_mozart prescribed constituent sourrces/sinks + character(len=shr_kind_cl) :: tracer_srcs_file ! prescribed data file + character(len=shr_kind_cl) :: tracer_srcs_filelist ! list of prescribed data files (series of files) + character(len=shr_kind_cl) :: tracer_srcs_datapath ! absolute path of prescribed data files + character(len=24) :: tracer_srcs_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default) + character(len=shr_kind_cl) :: tracer_srcs_specifier(MAXTRCRS) ! string array where each + logical :: tracer_srcs_rmfile ! remove data file from local disk (default .false.) + integer :: tracer_srcs_cycle_yr + integer :: tracer_srcs_fixed_ymd + integer :: tracer_srcs_fixed_tod + + ! Upper boundary conditions + character(len=shr_kind_cl) :: tgcm_ubc_file + integer :: tgcm_ubc_cycle_yr + integer :: tgcm_ubc_fixed_ymd + integer :: tgcm_ubc_fixed_tod + character(len=32) :: tgcm_ubc_data_type + character(len=shr_kind_cl) :: snoe_ubc_file + ! Upper boundary conditions + real(r8) :: t_pert_ubc ! temperature perturbation at ubc + real(r8) :: no_xfac_ubc ! no multiplicative factor at ubc + + namelist /chem_inparm/ chem_freq, airpl_emis_file, & + euvac_file, photon_file, electron_file, & + depvel_file, xs_coef_file, xs_short_file, & + exo_coldens_file, tuv_xsect_file, o2_xsect_file, & + xs_long_file, rsf_file, & + lght_no_prd_factor, xactive_prates, & + depvel_lnd_file, clim_soilw_file, season_wes_file, drydep_srf_file, & + srf_emis_type, srf_emis_cycle_yr, srf_emis_fixed_ymd, srf_emis_fixed_tod, srf_emis_specifier, & + fstrat_file, fstrat_list, & + ext_frc_specifier, ext_frc_type, ext_frc_cycle_yr, ext_frc_fixed_ymd, ext_frc_fixed_tod + + namelist /chem_inparm/ chem_rad_passive + + ! ghg chem + + namelist /chem_inparm/ bndtvg, h2orates, ghg_chem + + ! linoz inputs + + namelist /chem_inparm/ & + linoz_data_file, linoz_data_filelist, linoz_data_path, & + linoz_data_type, & + linoz_data_rmfile, linoz_data_cycle_yr, linoz_data_fixed_ymd, linoz_data_fixed_tod + namelist /chem_inparm/ & + chlorine_loading_file, chlorine_loading_type, chlorine_loading_fixed_ymd, chlorine_loading_fixed_tod + + ! prescribed chem tracers + + namelist /chem_inparm/ & + tracer_cnst_file, tracer_cnst_filelist, tracer_cnst_datapath, & + tracer_cnst_type, tracer_cnst_specifier, & + tracer_srcs_file, tracer_srcs_filelist, tracer_srcs_datapath, & + tracer_srcs_type, tracer_srcs_specifier, & + tracer_cnst_rmfile, tracer_cnst_cycle_yr, tracer_cnst_fixed_ymd, tracer_cnst_fixed_tod, & + tracer_srcs_rmfile, tracer_srcs_cycle_yr, tracer_srcs_fixed_ymd, tracer_srcs_fixed_tod + + ! upper boundary conditions + namelist /chem_inparm/ tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod, & + snoe_ubc_file, t_pert_ubc, no_xfac_ubc + + ! tropopause level control + namelist /chem_inparm/ chem_use_chemtrop + + ! get the default settings + + call linoz_data_defaultopts( & + linoz_data_file_out = linoz_data_file, & + linoz_data_filelist_out = linoz_data_filelist, & + linoz_data_path_out = linoz_data_path, & + linoz_data_type_out = linoz_data_type, & + linoz_data_rmfile_out = linoz_data_rmfile, & + linoz_data_cycle_yr_out = linoz_data_cycle_yr, & + linoz_data_fixed_ymd_out = linoz_data_fixed_ymd, & + linoz_data_fixed_tod_out = linoz_data_fixed_tod ) + call tracer_cnst_defaultopts( & + tracer_cnst_file_out = tracer_cnst_file, & + tracer_cnst_filelist_out = tracer_cnst_filelist, & + tracer_cnst_datapath_out = tracer_cnst_datapath, & + tracer_cnst_type_out = tracer_cnst_type, & + tracer_cnst_specifier_out = tracer_cnst_specifier, & + tracer_cnst_rmfile_out = tracer_cnst_rmfile, & + tracer_cnst_cycle_yr_out = tracer_cnst_cycle_yr, & + tracer_cnst_fixed_ymd_out = tracer_cnst_fixed_ymd, & + tracer_cnst_fixed_tod_out = tracer_cnst_fixed_tod ) + call tracer_srcs_defaultopts( & + tracer_srcs_file_out = tracer_srcs_file, & + tracer_srcs_filelist_out = tracer_srcs_filelist, & + tracer_srcs_datapath_out = tracer_srcs_datapath, & + tracer_srcs_type_out = tracer_srcs_type, & + tracer_srcs_specifier_out = tracer_srcs_specifier, & + tracer_srcs_rmfile_out = tracer_srcs_rmfile, & + tracer_srcs_cycle_yr_out = tracer_srcs_cycle_yr, & + tracer_srcs_fixed_ymd_out = tracer_srcs_fixed_ymd, & + tracer_srcs_fixed_tod_out = tracer_srcs_fixed_tod ) + + ! Upper boundary conditions + call ubc_defaultopts( & + snoe_ubc_file_out =snoe_ubc_file, & + t_pert_ubc_out =t_pert_ubc, & + no_xfac_ubc_out =no_xfac_ubc, & + tgcm_ubc_file_out = tgcm_ubc_file, & + tgcm_ubc_data_type_out = tgcm_ubc_data_type, & + tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr, & + tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd, & + tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod ) + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'chem_inparm', status=ierr) + if (ierr == 0) then + read(unitn, chem_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun('chem_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + + ! control + + call mpibcast (chem_freq, 1, mpiint, 0, mpicom) + + call mpibcast (chem_rad_passive, 1, mpilog, 0, mpicom) + + ! ghg + + call mpibcast (ghg_chem, 1, mpilog, 0, mpicom) + call mpibcast (bndtvg, len(bndtvg), mpichar, 0, mpicom) + call mpibcast (h2orates, len(h2orates), mpichar, 0, mpicom) + + ! lightning + + call mpibcast (lght_no_prd_factor,1, mpir8, 0, mpicom) + + ! photolysis + + call mpibcast (rsf_file, len(rsf_file), mpichar, 0, mpicom) + call mpibcast (exo_coldens_file, len(exo_coldens_file), mpichar, 0, mpicom) + call mpibcast (tuv_xsect_file, len(tuv_xsect_file), mpichar, 0, mpicom) + call mpibcast (o2_xsect_file, len(o2_xsect_file), mpichar, 0, mpicom) + call mpibcast (xs_coef_file, len(xs_coef_file), mpichar, 0, mpicom) + call mpibcast (xs_short_file, len(xs_short_file), mpichar, 0, mpicom) + call mpibcast (xs_long_file, len(xs_long_file), mpichar, 0, mpicom) + call mpibcast (xactive_prates, 1, mpilog, 0, mpicom) + call mpibcast (electron_file, len(electron_file), mpichar, 0, mpicom) + call mpibcast (euvac_file, len(euvac_file), mpichar, 0, mpicom) + + ! solar / geomag data + + call mpibcast (photon_file, len(photon_file), mpichar, 0, mpicom) + + ! dry dep + + call mpibcast (depvel_lnd_file, len(depvel_lnd_file), mpichar, 0, mpicom) + call mpibcast (depvel_file, len(depvel_file), mpichar, 0, mpicom) + call mpibcast (clim_soilw_file, len(clim_soilw_file), mpichar, 0, mpicom) + call mpibcast (season_wes_file, len(season_wes_file), mpichar, 0, mpicom) + call mpibcast (drydep_srf_file, len(drydep_srf_file), mpichar, 0, mpicom) + + ! emis + + call mpibcast (airpl_emis_file, len(airpl_emis_file), mpichar, 0, mpicom) + call mpibcast (srf_emis_specifier,len(srf_emis_specifier(1))*pcnst,mpichar, 0, mpicom) + call mpibcast (srf_emis_type, len(srf_emis_type), mpichar, 0, mpicom) + call mpibcast (srf_emis_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (srf_emis_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast (srf_emis_fixed_tod,1, mpiint, 0, mpicom) + call mpibcast (ext_frc_specifier, len(ext_frc_specifier(1))*pcnst, mpichar, 0, mpicom) + call mpibcast (ext_frc_type, len(ext_frc_type), mpichar, 0, mpicom) + call mpibcast (ext_frc_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (ext_frc_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (ext_frc_fixed_tod, 1, mpiint, 0, mpicom) + + + ! fixed stratosphere + + call mpibcast (fstrat_file, len(fstrat_file), mpichar, 0, mpicom) + call mpibcast (fstrat_list, len(fstrat_list(1))*pcnst, mpichar, 0, mpicom) + + ! upper boundary + call mpibcast (tgcm_ubc_file, len(tgcm_ubc_file), mpichar, 0, mpicom) + call mpibcast (tgcm_ubc_data_type, len(tgcm_ubc_data_type),mpichar, 0, mpicom) + call mpibcast (tgcm_ubc_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (tgcm_ubc_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (tgcm_ubc_fixed_tod, 1, mpiint, 0, mpicom) + + call mpibcast (snoe_ubc_file, len(snoe_ubc_file), mpichar, 0, mpicom) + call mpibcast (t_pert_ubc, 1, mpir8, 0, mpicom) + call mpibcast (no_xfac_ubc, 1, mpir8, 0, mpicom) + + ! linoz data + + call mpibcast (linoz_data_file, len(linoz_data_file), mpichar, 0, mpicom) + call mpibcast (linoz_data_filelist, len(linoz_data_filelist), mpichar, 0, mpicom) + call mpibcast (linoz_data_path, len(linoz_data_path), mpichar, 0, mpicom) + call mpibcast (linoz_data_type, len(linoz_data_type), mpichar, 0, mpicom) + call mpibcast (linoz_data_rmfile, 1, mpilog, 0, mpicom) + call mpibcast (linoz_data_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (linoz_data_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (linoz_data_fixed_tod, 1, mpiint, 0, mpicom) + + call mpibcast (chlorine_loading_file,len(chlorine_loading_file), mpichar, 0, mpicom) + call mpibcast (chlorine_loading_type,len(chlorine_loading_type), mpichar, 0, mpicom) + call mpibcast (chlorine_loading_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (chlorine_loading_fixed_tod, 1, mpiint, 0, mpicom) + + ! prescribed chemical tracers + + call mpibcast (tracer_cnst_specifier, len(tracer_cnst_specifier(1))*MAXTRCRS, mpichar, 0, mpicom) + call mpibcast (tracer_cnst_file, len(tracer_cnst_file), mpichar, 0, mpicom) + call mpibcast (tracer_cnst_filelist, len(tracer_cnst_filelist), mpichar, 0, mpicom) + call mpibcast (tracer_cnst_datapath, len(tracer_cnst_datapath), mpichar, 0, mpicom) + call mpibcast (tracer_cnst_type, len(tracer_cnst_type), mpichar, 0, mpicom) + call mpibcast (tracer_cnst_rmfile, 1, mpilog, 0, mpicom) + call mpibcast (tracer_cnst_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (tracer_cnst_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (tracer_cnst_fixed_tod, 1, mpiint, 0, mpicom) + + call mpibcast (tracer_srcs_specifier, len(tracer_srcs_specifier(1))*MAXTRCRS, mpichar, 0, mpicom) + call mpibcast (tracer_srcs_file, len(tracer_srcs_file), mpichar, 0, mpicom) + call mpibcast (tracer_srcs_filelist, len(tracer_srcs_filelist), mpichar, 0, mpicom) + call mpibcast (tracer_srcs_datapath, len(tracer_srcs_datapath), mpichar, 0, mpicom) + call mpibcast (tracer_srcs_type, len(tracer_srcs_type), mpichar, 0, mpicom) + call mpibcast (tracer_srcs_rmfile, 1, mpilog, 0, mpicom) + call mpibcast (tracer_srcs_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (tracer_srcs_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (tracer_srcs_fixed_tod, 1, mpiint, 0, mpicom) + + call mpibcast (chem_use_chemtrop,1, mpilog, 0, mpicom) + +#endif + + ! set the options + + call linoz_data_setopts( & + linoz_data_file_in = linoz_data_file, & + linoz_data_filelist_in = linoz_data_filelist, & + linoz_data_path_in = linoz_data_path, & + linoz_data_type_in = linoz_data_type, & + linoz_data_rmfile_in = linoz_data_rmfile, & + linoz_data_cycle_yr_in = linoz_data_cycle_yr, & + linoz_data_fixed_ymd_in = linoz_data_fixed_ymd, & + linoz_data_fixed_tod_in = linoz_data_fixed_tod ) + call tracer_cnst_setopts( & + tracer_cnst_file_in = tracer_cnst_file, & + tracer_cnst_filelist_in = tracer_cnst_filelist, & + tracer_cnst_datapath_in = tracer_cnst_datapath, & + tracer_cnst_type_in = tracer_cnst_type, & + tracer_cnst_specifier_in = tracer_cnst_specifier, & + tracer_cnst_rmfile_in = tracer_cnst_rmfile, & + tracer_cnst_cycle_yr_in = tracer_cnst_cycle_yr, & + tracer_cnst_fixed_ymd_in = tracer_cnst_fixed_ymd, & + tracer_cnst_fixed_tod_in = tracer_cnst_fixed_tod ) + call tracer_srcs_setopts( & + tracer_srcs_file_in = tracer_srcs_file, & + tracer_srcs_filelist_in = tracer_srcs_filelist, & + tracer_srcs_datapath_in = tracer_srcs_datapath, & + tracer_srcs_type_in = tracer_srcs_type, & + tracer_srcs_specifier_in = tracer_srcs_specifier, & + tracer_srcs_rmfile_in = tracer_srcs_rmfile, & + tracer_srcs_cycle_yr_in = tracer_srcs_cycle_yr, & + tracer_srcs_fixed_ymd_in = tracer_srcs_fixed_ymd, & + tracer_srcs_fixed_tod_in = tracer_srcs_fixed_tod ) + + ! Upper boundary conditions + call ubc_setopts( & + snoe_ubc_file_in =snoe_ubc_file, & + t_pert_ubc_in =t_pert_ubc, & + no_xfac_ubc_in =no_xfac_ubc, & + tgcm_ubc_file_in =tgcm_ubc_file, & + tgcm_ubc_data_type_in = tgcm_ubc_data_type, & + tgcm_ubc_cycle_yr_in = tgcm_ubc_cycle_yr, & + tgcm_ubc_fixed_ymd_in = tgcm_ubc_fixed_ymd, & + tgcm_ubc_fixed_tod_in = tgcm_ubc_fixed_tod ) + + call aero_model_readnl(nlfile) + call dust_readnl(nlfile) +! + call gas_wetdep_readnl(nlfile) + call gcr_ionization_readnl(nlfile) + call epp_ionization_readnl(nlfile) + call mo_apex_readnl(nlfile) + call noy_ubc_readnl(nlfile) + call sulf_readnl(nlfile) + call species_sums_readnl(nlfile) + + endsubroutine chem_readnl + +!================================================================================================ + +function chem_is_active() +!----------------------------------------------------------------------- +! Purpose: return true if this package is active +!----------------------------------------------------------------------- + logical :: chem_is_active +!----------------------------------------------------------------------- + chem_is_active = is_active +end function chem_is_active + +!================================================================================================ + + function chem_implements_cnst(name) +!----------------------------------------------------------------------- +! +! Purpose: return true if specified constituent is implemented by this package +! +! Author: B. Eaton +! +!----------------------------------------------------------------------- + use chem_mods, only : gas_pcnst, inv_lst, nfs + use mo_tracname, only : solsym + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + character(len=*), intent(in) :: name ! constituent name + logical :: chem_implements_cnst ! return value +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: m + + chem_implements_cnst = .false. + do m = 1,gas_pcnst + if( trim(name) /= 'H2O' ) then + if( trim(name) == solsym(m) ) then + chem_implements_cnst = .true. + exit + end if + end if + end do + do m = 1,nfs + if( trim(name) /= 'H2O' ) then + if( trim(name) == inv_lst(m) ) then + chem_implements_cnst = .true. + exit + end if + endif + enddo + + end function chem_implements_cnst + + subroutine chem_init(phys_state, pbuf2d) + +!----------------------------------------------------------------------- +! +! Purpose: initialize parameterized greenhouse gas chemistry +! (declare history variables) +! +! Method: +! +! +! +! Author: NCAR CMS +! +!----------------------------------------------------------------------- + use physics_buffer, only : physics_buffer_desc, pbuf_get_index + + use constituents, only : cnst_get_ind + use cam_history, only : addfld, add_default, horiz_only, fieldname_len + use chem_mods, only : gas_pcnst + use mo_chemini, only : chemini + use mo_ghg_chem, only : ghg_chem_init + use mo_tracname, only : solsym + use llnl_O1D_to_2OH_adj, only : O1D_to_2OH_adj_init + use lin_strat_chem, only : lin_strat_chem_inti + use chlorine_loading_data, only : chlorine_loading_init + use cfc11star, only : init_cfc11star + use phys_control, only : phys_getopts + use chem_mods, only : adv_mass + use infnan, only : nan, assignment(=) + use mo_chem_utls, only : get_spc_ndx + use cam_abortutils, only : endrun + use aero_model, only : aero_model_init + use mo_setsox, only : sox_inti + use constituents, only : sflxnam + use noy_ubc, only : noy_ubc_init + use fire_emissions, only : fire_emissions_init + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + + +!----------------------------------------------------------------------- +! Local variables +!----------------------------------------------------------------------- + integer :: m ! tracer indicies + character(len=fieldname_len) :: spc_name + integer :: n, ii + logical :: history_aerosol + logical :: history_chemistry + logical :: history_cesm_forcing + + character(len=2) :: unit_basename ! Units 'kg' or '1' + logical :: history_budget ! output tendencies and state variables for CAM + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + + call phys_getopts( cam_chempkg_out=chem_name, & + history_aerosol_out=history_aerosol , & + history_chemistry_out=history_chemistry , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_cesm_forcing_out = history_cesm_forcing ) + + ! aqueous chem initialization + call sox_inti() + + ! Initialize aerosols + call aero_model_init( pbuf2d ) + +!----------------------------------------------------------------------- +! Get liq and ice cloud water indicies +!----------------------------------------------------------------------- + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + call cnst_get_ind( 'NUMLIQ', ixndrop, abort=.false. ) + +!----------------------------------------------------------------------- +! get pbuf indicies +!----------------------------------------------------------------------- + ndx_cld = pbuf_get_index('CLD') + ndx_cmfdqr = pbuf_get_index('RPRDTOT') + ndx_nevapr = pbuf_get_index('NEVAPR') + ndx_prain = pbuf_get_index('PRAIN') + ndx_cldtop = pbuf_get_index('CLDTOP') + ndx_pblh = pbuf_get_index('pblh') + ndx_fsds = pbuf_get_index('FSDS') + + call addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'geopotential height above surface at interfaces (m)' ) + call addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' ) + +!----------------------------------------------------------------------- +! Set names of chemistry variable tendencies and declare them as history variables +!----------------------------------------------------------------------- + do m = 1,gas_pcnst + spc_name = solsym(m) + srcnam(m) = 'CT_' // spc_name ! chem tendancy (source/sink) + + call addfld( srcnam(m), (/ 'lev' /), 'A', 'kg/kg/s', trim(spc_name)//' source/sink' ) + call cnst_get_ind(solsym(m), n, abort=.false. ) + if ( n > 0 ) then + + if (sflxnam(n)(3:5) == 'num') then ! name is in the form of "SF****" + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + call addfld (sflxnam(n),horiz_only, 'A', unit_basename//'/m2/s',trim(solsym(m))//' surface flux') + if ( history_aerosol .or. history_chemistry ) then + call add_default( sflxnam(n), 1, ' ' ) + endif + + if ( history_cesm_forcing ) then + if ( spc_name == 'NO' .or. spc_name == 'NH3' ) then + call add_default( sflxnam(n), 1, ' ' ) + endif + endif + + ! this is moved out of chem_register because we need to know where (what pressure) + ! the upper boundary is to determine if this is a high top configuration -- after + ! initialization of ref_pres ... + if ( do_molec_diff ) then ! molecular diffusion requires 'wet' mixing ratios + cnst_type(n) = 'wet' + endif + endif + end do + + ! Add chemical tendency of water vapor to water budget output + if ( history_budget ) then + call add_default ('CT_H2O' , history_budget_histfile_num, ' ') + endif + + !----------------------------------------------------------------------- + ! BAB: 2004-09-01 kludge to define a fixed ubc for water vapor + ! required because water vapor is not declared by chemistry but + ! has a fixed ubc only if WACCM chemistry is running. + !----------------------------------------------------------------------- + ! this is moved out of chem_register because we need to know where (what pressure) + ! the upper boundary is to determine if this is a high top configuration -- after + ! initialization of ref_pres ... + if ( 1.e-2_r8 >= ptop_ref .and. ptop_ref > 1.e-5_r8 ) then ! around waccm top, below top of waccmx + cnst_fixed_ubc(1) = .true. + else if ( 1.e1_r8 > ptop_ref .and. ptop_ref > 1.e-2_r8 ) then ! well above top of cam and below top of waccm + call endrun('chem_init: do not know how to set water vapor upper boundary when model top is near mesopause') + endif + + if ( masterproc ) write(iulog,*) 'chem_init: addfld done' + +!----------------------------------------------------------------------- +! Initialize chemistry modules +!----------------------------------------------------------------------- + call chemini & + ( euvac_file & + , photon_file & + , electron_file & + , airpl_emis_file & + , depvel_file & + , depvel_lnd_file & + , clim_soilw_file & + , season_wes_file & + , xs_coef_file & + , xs_short_file & + , xs_long_file & + , rsf_file & + , fstrat_file & + , fstrat_list & + , srf_emis_specifier & + , srf_emis_type & + , srf_emis_cycle_yr & + , srf_emis_fixed_ymd & + , srf_emis_fixed_tod & + , ext_frc_specifier & + , ext_frc_type & + , ext_frc_cycle_yr & + , ext_frc_fixed_ymd & + , ext_frc_fixed_tod & + , xactive_prates & + , exo_coldens_file & + , tuv_xsect_file & + , o2_xsect_file & + , lght_no_prd_factor & + , pbuf2d & + ) + + if ( ghg_chem ) then + call ghg_chem_init(phys_state, bndtvg, h2orates) + endif + + call O1D_to_2OH_adj_init() + + call lin_strat_chem_inti(phys_state) + call chlorine_loading_init( chlorine_loading_file, & + type = chlorine_loading_type, & + ymd = chlorine_loading_fixed_ymd, & + tod = chlorine_loading_fixed_tod ) + + call init_cfc11star(pbuf2d) + + ! MEGAN emissions initialize + if (shr_megan_mechcomps_n>0) then + + allocate( megan_indices_map(shr_megan_mechcomps_n) ) + allocate( megan_wght_factors(shr_megan_mechcomps_n) ) + megan_wght_factors(:) = nan + + do n=1,shr_megan_mechcomps_n + call cnst_get_ind (shr_megan_mechcomps(n)%name, megan_indices_map(n), abort=.false.) + ii = get_spc_ndx(shr_megan_mechcomps(n)%name) + if (ii>0) then + megan_wght_factors(n) = adv_mass(ii)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec) + else + call endrun( 'gas_phase_chemdr_inti: MEGAN compound not in chemistry mechanism : '& + //trim(shr_megan_mechcomps(n)%name)) + endif + + ! MEGAN history fields + call addfld( 'MEG_'//trim(shr_megan_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',& + trim(shr_megan_mechcomps(n)%name)//' MEGAN emissions flux') + if (history_chemistry) then + call add_default('MEG_'//trim(shr_megan_mechcomps(n)%name), 1, ' ') + endif + + enddo + endif + + call noy_ubc_init() + + ! Galatic Cosmic Rays ... + call gcr_ionization_init() + + ! Fire emissions ... + call fire_emissions_init() + + end subroutine chem_init + +!================================================================================ +!================================================================================ + subroutine chem_emissions( state, cam_in ) + use aero_model, only: aero_model_emissions + use camsrfexch, only: cam_in_t + use constituents, only: sflxnam + use cam_history, only: outfld + use mo_srf_emissions, only: set_srf_emissions + use cam_cpl_indices, only: index_x2a_Fall_flxvoc + use fire_emissions, only: fire_emissions_srf + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + ! local vars + + integer :: lchnk, ncol + integer :: i, m,n + + real(r8) :: sflx(pcols,gas_pcnst) + real(r8) :: megflx(pcols) + + lchnk = state%lchnk + ncol = state%ncol + + ! initialize chemistry constituent surface fluxes to zero + do m = 2,pcnst + n = map2chm(m) + if (n>0) cam_in%cflx(:,m) = 0._r8 + enddo + + ! aerosol emissions ... + call aero_model_emissions( state, cam_in ) + + ! MEGAN emissions ... + + if ( index_x2a_Fall_flxvoc>0 .and. shr_megan_mechcomps_n>0 ) then + + ! set MEGAN fluxes + do n = 1,shr_megan_mechcomps_n + do i =1,ncol + megflx(i) = -cam_in%meganflx(i,n) * megan_wght_factors(n) + cam_in%cflx(i,megan_indices_map(n)) = cam_in%cflx(i,megan_indices_map(n)) + megflx(i) + enddo + + ! output MEGAN emis fluxes to history + call outfld('MEG_'//trim(shr_megan_mechcomps(n)%name), megflx(:ncol), ncol, lchnk) + enddo + + endif + + ! prescribed emissions from file ... + + !----------------------------------------------------------------------- + ! ... Set surface emissions + !----------------------------------------------------------------------- + call set_srf_emissions( lchnk, ncol, sflx(:,:) ) + + do m = 1,pcnst + n = map2chm(m) + if ( n /= h2o_ndx .and. n > 0 ) then + cam_in%cflx(:ncol,m) = cam_in%cflx(:ncol,m) + sflx(:ncol,n) + call outfld( sflxnam(m), cam_in%cflx(:ncol,m), ncol,lchnk ) + endif + enddo + + ! fire surface emissions if not elevated forcing + call fire_emissions_srf( lchnk, ncol, cam_in%fireflx, cam_in%cflx ) + + end subroutine chem_emissions + +!================================================================================ + + subroutine chem_init_cnst( name, latvals, lonvals, mask, q) +!----------------------------------------------------------------------- +! +! Purpose: +! Specify initial mass mixing ratios +! +!----------------------------------------------------------------------- + + use chem_mods, only : inv_lst + + use physconst, only : mwdry, mwch4, mwn2o, mwf11, mwf12 + use chem_surfvals, only : chem_surfvals_get + + implicit none + +!----------------------------------------------------------------------- +! Dummy arguments +!----------------------------------------------------------------------- + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + +!----------------------------------------------------------------------- +! Local variables +!----------------------------------------------------------------------- + + real(r8) :: rmwn2o != mwn2o/mwdry ! ratio of mol weight n2o to dry air + real(r8) :: rmwch4 != mwch4/mwdry ! ratio of mol weight ch4 to dry air + real(r8) :: rmwf11 != mwf11/mwdry ! ratio of mol weight cfc11 to dry air + real(r8) :: rmwf12 != mwf12/mwdry ! ratio of mol weight cfc12 to dry air + integer :: ilev, nlev + +!----------------------------------------------------------------------- +! initialize local variables +!----------------------------------------------------------------------- + + rmwn2o = mwn2o/mwdry + rmwch4 = mwch4/mwdry + rmwf11 = mwf11/mwdry + rmwf12 = mwf12/mwdry + +!----------------------------------------------------------------------- +! Get initial mixing ratios +!----------------------------------------------------------------------- + nlev = size(q, 2) + if ( any( inv_lst .eq. name ) ) then + do ilev = 1, nlev + where(mask) + q(:,ilev) = 0.0_r8 + end where + end do + else + do ilev = 1, nlev + where(mask) + q(:,ilev) = 1.e-38_r8 + end where + end do + endif + + if ( ghg_chem ) then + do ilev = 1, nlev + select case (name) + case ('N2O') + where(mask) + q(:,ilev) = rmwn2o * chem_surfvals_get('N2OVMR') + end where + case ('CH4') + where(mask) + q(:,ilev) = rmwch4 * chem_surfvals_get('CH4VMR') + end where + case ('CFC11') + where(mask) + q(:,ilev) = rmwf11 * chem_surfvals_get('F11VMR') + end where + case ('CFC12') + where(mask) + q(:,ilev) = rmwf12 * chem_surfvals_get('F12VMR') + end where + end select + end do + end if + + end subroutine chem_init_cnst + + subroutine chem_timestep_init(phys_state,pbuf2d) + + use time_manager, only : get_nstep + use time_manager, only : get_curr_calday + use mo_srf_emissions, only : set_srf_emissions_time + use mo_sulf, only : set_sulf_time + use mo_extfrc, only : extfrc_timestep_init + use mo_flbc, only : flbc_chk + use tracer_cnst, only : tracer_cnst_adv + use tracer_srcs, only : tracer_srcs_adv + use mo_ghg_chem, only : ghg_chem_timestep_init + + use mo_aurora, only : aurora_timestep_init + use mo_photo, only : photo_timestep_init + use linoz_data, only : linoz_data_adv + use chlorine_loading_data, only : chlorine_loading_advance + use noy_ubc, only : noy_ubc_advance + + use cfc11star, only : update_cfc11star + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! Local variables + !----------------------------------------------------------------------- + real(r8) :: calday + integer :: nstep + + nstep = get_nstep() + chem_step = mod( nstep, chem_freq ) == 0 + + if ( .not. chem_step ) return + + !----------------------------------------------------------------------- + ! get current calendar day of year + !----------------------------------------------------------------------- + calday = get_curr_calday( ) + + !----------------------------------------------------------------------- + ! Set emissions timing factors + !----------------------------------------------------------------------- + call set_srf_emissions_time( pbuf2d, phys_state ) + + !----------------------------------------------------------------------- + ! Set external forcings timing factors + !----------------------------------------------------------------------- + call extfrc_timestep_init( pbuf2d, phys_state ) + + !----------------------------------------------------------------------- + ! Set sulf timing factors + !----------------------------------------------------------------------- + call set_sulf_time( pbuf2d, phys_state ) + + !----------------------------------------------------------------------- + ! Set fixed lower boundary timing factors + !----------------------------------------------------------------------- + call flbc_chk + + !----------------------------------------------------------------------- + ! NOy upper boundary conditions for low top model + !----------------------------------------------------------------------- + call noy_ubc_advance(pbuf2d, phys_state) + + !----------------------------------------------------------------------- + ! Set fixed offline tracers + !----------------------------------------------------------------------- + call tracer_cnst_adv(pbuf2d, phys_state) + + !----------------------------------------------------------------------- + ! Set fixed offline tracer sources + !----------------------------------------------------------------------- + call tracer_srcs_adv(pbuf2d, phys_state) + + !----------------------------------------------------------------------- + ! Advance the linoz data + !----------------------------------------------------------------------- + call linoz_data_adv(pbuf2d, phys_state) + call chlorine_loading_advance() + + if ( ghg_chem ) then + call ghg_chem_timestep_init(phys_state) + endif + + !----------------------------------------------------------------------- + ! Set up aurora + !----------------------------------------------------------------------- + call aurora_timestep_init + + !----------------------------------------------------------------------------- + ! ... setup the time interpolation for mo_photo + !----------------------------------------------------------------------------- + call photo_timestep_init( calday ) + + call update_cfc11star( pbuf2d, phys_state ) + + ! Galatic Cosmic Rays ... + call gcr_ionization_adv( pbuf2d, phys_state ) + call epp_ionization_adv() + + end subroutine chem_timestep_init + + subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) + +!----------------------------------------------------------------------- +! +! Purpose: +! Interface to parameterized greenhouse gas chemisty (source/sink). +! +! Method: +! +! +! +! Author: B.A. Boville +! +!----------------------------------------------------------------------- + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use cam_history, only : outfld + use time_manager, only : get_curr_calday + use mo_gas_phase_chemdr, only : gas_phase_chemdr + use camsrfexch, only : cam_in_t, cam_out_t + use perf_mod, only : t_startf, t_stopf + use tropopause, only : tropopause_findChemTrop, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE, tropopause_find + use mo_drydep, only : drydep_update + use mo_neu_wetdep, only : neu_wetdep_tend + use aerodep_flx, only : aerodep_flx_prescribed + + implicit none + +!----------------------------------------------------------------------- +! Dummy arguments +!----------------------------------------------------------------------- + real(r8), intent(in) :: dt ! time step + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(inout) :: cam_out + real(r8), intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry + + + type(physics_buffer_desc), pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! Local variables +!----------------------------------------------------------------------- + integer :: i, k, m, n ! indicies + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + real(r8) :: calday ! current calendar day of year + real(r8) :: cldw(pcols,pver) ! cloud water (kg/kg) + real(r8) :: chem_dt ! time step + real(r8) :: drydepflx(pcols,pcnst) ! dry deposition fluxes (kg/m2/s) + real(r8) :: wetdepflx(pcols,pcnst) ! wet deposition fluxes (kg/m2/s) + integer :: tropLev(pcols), tropLevChem(pcols) + real(r8) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg) + real(r8), pointer :: fsds(:) ! longwave down at sfc + real(r8), pointer :: pblh(:) + real(r8), pointer :: prain(:,:) + real(r8), pointer :: cldfr(:,:) + real(r8), pointer :: cmfdqr(:,:) + real(r8), pointer :: nevapr(:,:) + real(r8), pointer :: cldtop(:) + real(r8) :: nhx_nitrogen_flx(pcols) + real(r8) :: noy_nitrogen_flx(pcols) + + integer :: tim_ndx + + logical :: lq(pcnst) + + if ( .not. chem_step ) return + + chem_dt = chem_freq*dt + + lchnk = state%lchnk + ncol = state%ncol + + lq(:) = .false. + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + lq(n) = .true. + end if + end do + if ( ghg_chem ) lq(1) = .true. + + call physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq) + + call drydep_update( state, cam_in ) + +!----------------------------------------------------------------------- +! get current calendar day of year +!----------------------------------------------------------------------- + calday = get_curr_calday() + +!----------------------------------------------------------------------- +! get tropopause level +!----------------------------------------------------------------------- + if (chem_is('super_fast_llnl') .or. chem_is('super_fast_llnl_mam3')) then + call tropopause_find(state, tropLev, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + tropLevChem=tropLev + else + if (.not.chem_use_chemtrop) then + call tropopause_find(state,tropLev) + tropLevChem=tropLev + else + call tropopause_find(state,tropLev) + call tropopause_findChemTrop(state, tropLevChem) + endif + endif + + tim_ndx = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ndx_fsds, fsds) + call pbuf_get_field(pbuf, ndx_pblh, pblh) + call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_cld, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) ) + call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_cldtop, cldtop ) + +!----------------------------------------------------------------------- +! call Neu wet dep scheme +!----------------------------------------------------------------------- + call neu_wetdep_tend(lchnk,ncol,state%q,state%pmid,state%pdel,state%zi,state%t,dt, & + prain, nevapr, cldfr, cmfdqr, ptend%q, wetdepflx) + +!----------------------------------------------------------------------- +! compute tendencies and surface fluxes +!----------------------------------------------------------------------- + call t_startf( 'chemdr' ) + do k = 1,pver + cldw(:ncol,k) = state%q(:ncol,k,ixcldliq) + state%q(:ncol,k,ixcldice) + if (ixndrop>0) & + ncldwtr(:ncol,k) = state%q(:ncol,k,ixndrop) + end do + + call gas_phase_chemdr(lchnk, ncol, imozart, state%q, & + state%phis, state%zm, state%zi, calday, & + state%t, state%pmid, state%pdel, state%pint, & + cldw, tropLev, tropLevChem, ncldwtr, state%u, state%v, & + chem_dt, state%ps, xactive_prates, & + fsds, cam_in%ts, cam_in%asdir, cam_in%ocnfrac, cam_in%icefrac, & + cam_out%precc, cam_out%precl, cam_in%snowhland, ghg_chem, state%latmapback, & + drydepflx, wetdepflx, cam_in%cflx, cam_in%fireflx, cam_in%fireztop, & + nhx_nitrogen_flx, noy_nitrogen_flx, ptend%q, pbuf ) + if (associated(cam_out%nhx_nitrogen_flx)) then + cam_out%nhx_nitrogen_flx(:ncol) = nhx_nitrogen_flx(:ncol) + endif + if (associated(cam_out%noy_nitrogen_flx)) then + cam_out%noy_nitrogen_flx(:ncol) = noy_nitrogen_flx(:ncol) + endif + + call t_stopf( 'chemdr' ) + +!----------------------------------------------------------------------- +! set flags for tracer tendencies (water and gas phase constituents) +! record tendencies on history files +!----------------------------------------------------------------------- + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + call outfld( srcnam(m), ptend%q(:,:,n), pcols, lchnk ) + end if + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not.aerodep_flx_prescribed()) then + ! set deposition fluxes in the export state + select case (trim(cnst_name(n))) + case('CB1') + do i = 1, ncol + cam_out%bcphodry(i) = max(drydepflx(i,n), 0._r8) + end do + case('CB2') + do i = 1, ncol + cam_out%bcphidry(i) = max(drydepflx(i,n), 0._r8) + end do + case('OC1') + do i = 1, ncol + cam_out%ocphodry(i) = max(drydepflx(i,n), 0._r8) + end do + case('OC2') + do i = 1, ncol + cam_out%ocphidry(i) = max(drydepflx(i,n), 0._r8) + end do + end select + endif + end do + if ( ghg_chem ) then + ptend%lq(1) = .true. + call outfld( 'CT_H2O_GHG', ptend%q(:,:,1), pcols, lchnk ) + endif + + call outfld( 'HEIGHT', state%zi(:ncol,:), ncol, lchnk ) + +!----------------------------------------------------------------------- +! turn off water vapor tendency if radiatively passive +!----------------------------------------------------------------------- + if (chem_rad_passive) then + ptend%lq(1) = .false. + ptend%q(:ncol,:,1) = 0._r8 + endif + +!----------------------------------------------------------------------- +! Compute water vapor flux required to make conservation check +!----------------------------------------------------------------------- + fh2o(:ncol) = 0._r8 + do k = 1,pver + fh2o(:ncol) = fh2o(:ncol) + ptend%q(:ncol,k,1)*state%pdel(:ncol,k)/gravit + end do + end subroutine chem_timestep_tend + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine chem_final + end subroutine chem_final + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + + subroutine chem_init_restart( File ) + use pio, only : file_desc_t + use tracer_cnst, only: init_tracer_cnst_restart + use tracer_srcs, only: init_tracer_srcs_restart + use linoz_data, only : init_linoz_data_restart + implicit none + type(file_desc_t),intent(inout) :: File ! pio File pointer + + ! + ! data for offline tracers + ! + call init_tracer_cnst_restart(File) + call init_tracer_srcs_restart(File) + call init_linoz_data_restart(File) + end subroutine chem_init_restart +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine chem_write_restart( File ) + use tracer_cnst, only: write_tracer_cnst_restart + use tracer_srcs, only: write_tracer_srcs_restart + use linoz_data, only: write_linoz_data_restart + use pio, only : file_desc_t + implicit none + type(file_desc_t) :: File + + ! + ! data for offline tracers + ! + call write_tracer_cnst_restart(File) + call write_tracer_srcs_restart(File) + call write_linoz_data_restart(File) + end subroutine chem_write_restart + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine chem_read_restart( File ) + use tracer_cnst, only: read_tracer_cnst_restart + use tracer_srcs, only: read_tracer_srcs_restart + use linoz_data, only: read_linoz_data_restart + + use pio, only : file_desc_t + implicit none + type(file_desc_t) :: File + + ! + ! data for offline tracers + ! + call read_tracer_cnst_restart(File) + call read_tracer_srcs_restart(File) + call read_linoz_data_restart(File) + end subroutine chem_read_restart + +end module chemistry diff --git a/src/chemistry/mozart/chlorine_loading_data.F90 b/src/chemistry/mozart/chlorine_loading_data.F90 new file mode 100644 index 0000000000..7b4d99eef2 --- /dev/null +++ b/src/chemistry/mozart/chlorine_loading_data.F90 @@ -0,0 +1,298 @@ +!----------------------------------------------------------------------- +! chlorine loading data for LINOZ +!----------------------------------------------------------------------- +module chlorine_loading_data + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use linoz_data, only: has_linoz_data + + implicit none + + save + private + public :: chlorine_loading_init + public :: chlorine_loading_advance + + public :: chlorine_loading + + real(r8) :: chlorine_loading + + integer :: ntimes + + integer, parameter :: nt = 2 + real(r8) :: iloading(nt) + + real(r8), allocatable :: data_times(:) + + integer :: last_index = 1 + + logical :: initialized = .false. + + logical :: fixed + real(r8) :: offset_time + +! namelist vars + character(len=256) :: chlorine_loading_file = '' + character(len=8) :: chlorine_loading_type = 'SERIAL' ! "FIXED" or "SERIAL" + integer :: chlorine_loading_ymd = 0 ! YYYYMMDD for "FIXED" type + integer :: chlorine_loading_tod = 0 ! seconds of day for "FIXED" type + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine chlorine_loading_init( file, type, ymd, tod ) + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_noerr, pio_inq_dimid, pio_inq_varid, pio_get_var, pio_inq_dimlen, & + pio_internal_error, pio_bcast_error, pio_seterrorhandling, pio_closefile + use ioFileMod, only : getfil + + ! inputs + character(len=256), intent(in) :: file + character(len=8), optional, intent(in) :: type + integer, optional, intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local vars + integer :: astat, dimid, vid, data_vid + character(len=256) :: filen + real(r8), allocatable :: loading(:) + integer, allocatable :: dates(:) + integer, allocatable :: datesecs(:) + type(file_desc_t) :: file_id + + integer :: i, ierr + + real(r8) :: model_time, time + + chlorine_loading_file = file + + if (.not.has_linoz_data) return + + if ( present(type) ) then + chlorine_loading_type = type + endif + if ( present(ymd) ) then + chlorine_loading_ymd = ymd + endif + if ( present(tod) ) then + chlorine_loading_tod = tod + endif + + fixed = trim(chlorine_loading_type) == 'FIXED' + + if (masterproc) then + write(iulog,*) 'chlorine_loading_init: chlorine_loading_file = ',trim(chlorine_loading_file) + write(iulog,*) 'chlorine_loading_init: chlorine_loading_type = ',trim(chlorine_loading_type) + write(iulog,*) 'chlorine_loading_init: chlorine_loading_ymd = ',chlorine_loading_ymd + write(iulog,*) 'chlorine_loading_init: chlorine_loading_tod = ',chlorine_loading_tod + endif + + + call getfil( chlorine_loading_file, filen, 0 ) + call cam_pio_openfile( file_id, filen, 0 ) + if ( masterproc ) write(iulog,*)'chlorine_loading_init: data file = ',trim(filen) + ierr = pio_inq_dimid( file_id, 'time', dimid ) + ierr = pio_inq_dimlen( file_id, dimid, ntimes ) + ierr = pio_inq_varid( file_id, 'chlorine_loading', data_vid ) + + allocate(data_times(ntimes), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'chlorine_loading_init: failed to allocate data_times; error = ',astat + call endrun('chlorine_loading_init') + end if + + allocate(dates(ntimes), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'chlorine_loading_init: failed to allocate dates; error = ',astat + call endrun('chlorine_loading_init') + end if + + allocate(datesecs(ntimes), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'chlorine_loading_init: failed to allocate datesecs; error = ',astat + call endrun('chlorine_loading_init') + end if + + + ierr = pio_inq_varid( file_id, 'date', vid ) + ierr = pio_get_var( file_id, vid, dates ) + call pio_seterrorhandling(file_id, PIO_BCAST_ERROR) + ierr = pio_inq_varid( file_id, 'datesec', vid ) + call pio_seterrorhandling(file_id, PIO_INTERNAL_ERROR) + if (ierr == PIO_NOERR) then + ierr = pio_get_var( file_id, vid, datesecs ) + else + datesecs(:) = 0 + endif + call pio_closefile(file_id) + + + offset_time = 0._r8 + + if ( (chlorine_loading_ymd > 0) .or. (chlorine_loading_tod > 0) ) then + if (fixed) then + call get_model_time( model_time ) + call convert_date( chlorine_loading_ymd, chlorine_loading_tod, time ) + offset_time = time - model_time + else + call endrun('chlorine_loading_init: cannont specify chlorine_loading_fixed_ymd ' & + // 'or chlorine_loading_fixed_tod if chlorine_loading_type is not FIXED' ) + endif + endif + + call convert_dates( dates, datesecs, data_times ) + + data_times = data_times - offset_time + + deallocate(dates) + + ! need to force data loading when the model starts at a time =/ 00:00:00.000 + ! -- may occur in restarts also + call chlorine_loading_advance() + initialized = .true. + + end subroutine chlorine_loading_init + +!----------------------------------------------------------------------- +! Reads in the ETF data for the current date. +!----------------------------------------------------------------------- + subroutine chlorine_loading_advance( ) + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_closefile, pio_inq_varid, pio_get_var + use physconst, only : cday + use ioFileMod, only : getfil + + integer :: year, month, day, sec + integer :: index, i + integer :: offset(1), count(1) + logical :: do_adv, read_data + real(r8) :: time, delt + type(file_desc_t) :: file_id + integer :: data_vid, ierr + character(len=256) :: filen + + + if (.not.has_linoz_data) return + if ( fixed .and. initialized ) return + + index = -1 + call get_model_time( time, year=year, month=month, day=day, seconds=sec ) + + read_data = time > data_times(last_index) .or. .not.initialized + + if ( read_data ) then + + find_ndx: do i = last_index, ntimes + if ( data_times(i) - time > 1.e-6_r8 ) then + index = i-1 + exit find_ndx + endif + enddo find_ndx + + last_index = index+1 + + if ( index < 1 ) then + write(iulog,102) year,month,day,sec + call endrun('chlorine_loading_advance: failed to read data from '//trim(chlorine_loading_file)) + endif + + ! get the surrounding time slices + offset = (/ index /) + count = (/ nt /) + + call getfil( chlorine_loading_file, filen, 0 ) + call cam_pio_openfile( file_id, filen, 0 ) + if ( masterproc ) write(iulog,*)'chlorine_loading_advance: data file = ',trim(filen) + ierr = pio_inq_varid( file_id, 'chlorine_loading', data_vid ) + ierr = pio_get_var( file_id, data_vid, offset, count, iloading ) + call pio_closefile(file_id) + else + index = last_index - 1 + endif + + delt = ( time - data_times(index) ) / ( data_times(index+1) - data_times(index) ) + + ! this assures that FIXED data are b4b on restarts + if ( fixed ) then + delt = dble(int(delt*cday+.5_r8))/dble(cday) + endif + + chlorine_loading = iloading(1) + delt*( iloading(2) - iloading(1) ) + + if ( masterproc ) then + write(iulog,101) year, month, day, sec, chlorine_loading + endif + +101 FORMAT('chlorine_loading_advance: date, loading : ',i4.4,'-',i2.2,'-',i2.2,'-',i5.5,', ',f12.6) +102 FORMAT('chlorine_loading_advance: not able to find data for : ',i4.4,'-',i2.2,'-',i2.2,'-',i5.5) + + end subroutine chlorine_loading_advance + + !--------------------------------------------------------------------------- + ! private methods + !--------------------------------------------------------------------------- + subroutine convert_dates( dates, secs, times ) + + use time_manager, only: set_time_float_from_date + + integer, intent(in) :: dates(:) + integer, intent(in) :: secs(:) + + real(r8), intent(out) :: times(:) + + integer :: year, month, day, sec,n ,i + + n = size( dates ) + + do i=1,n + year = dates(i)/10000 + month = (dates(i)-year*10000)/100 + day = dates(i)-year*10000-month*100 + sec = secs(i) + call set_time_float_from_date( times(i), year, month, day, sec ) + enddo + + end subroutine convert_dates + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine convert_date( date, sec, time ) + + integer, intent(in) :: date + integer, intent(in) :: sec + real(r8), intent(out) :: time + + integer :: dates(1), secs(1) + real(r8) :: times(1) + dates(1) = date + secs(1) = sec + call convert_dates( dates, secs, times ) + time = times(1) + end subroutine convert_date + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine get_model_time( time, year, month, day, seconds ) + + use time_manager, only: get_curr_date + + real(r8), intent(out) :: time + integer, optional, intent(out) :: year, month, day, seconds + + integer :: yr, mn, dy, sc, date + + call get_curr_date(yr, mn, dy, sc) + date = yr*10000 + mn*100 + dy + call convert_date( date, sc, time ) + + if (present(year)) year = yr + if (present(month)) month = mn + if (present(day)) day = dy + if (present(seconds)) seconds = sc + + end subroutine get_model_time + +end module chlorine_loading_data diff --git a/src/chemistry/mozart/clybry_fam.F90 b/src/chemistry/mozart/clybry_fam.F90 new file mode 100644 index 0000000000..69ee0ba54d --- /dev/null +++ b/src/chemistry/mozart/clybry_fam.F90 @@ -0,0 +1,289 @@ +!----------------------------------------------------------------------- +! +! Manages the adjustment of ClOy and BrOy family components in response +! to conservation issues resulting from advection. +! +! Created by: Francis Vitt +! Date: 21 May 2008 +! Modified by Stacy Walters +! Date: 13 August 2008 +!----------------------------------------------------------------------- + +module clybry_fam + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver + use chem_mods, only : gas_pcnst, adv_mass + use constituents, only : pcnst + use short_lived_species,only: set_short_lived_species,get_short_lived_species + + implicit none + + save + + private + public :: clybry_fam_set + public :: clybry_fam_adj + public :: clybry_fam_init + + integer :: id_cly,id_bry + + integer :: id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2 + integer :: id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr + + logical :: has_clybry + +contains + + !------------------------------------------ + !------------------------------------------ + subroutine clybry_fam_init + + use mo_chem_utls, only : get_spc_ndx + implicit none + + integer :: ids(16) + + id_cly = get_spc_ndx('CLY') + id_bry = get_spc_ndx('BRY') + + id_cl = get_spc_ndx('CL') + id_clo = get_spc_ndx('CLO') + id_hocl = get_spc_ndx('HOCL') + id_cl2 = get_spc_ndx('CL2') + id_cl2o2 = get_spc_ndx('CL2O2') + id_oclo = get_spc_ndx('OCLO') + id_hcl = get_spc_ndx('HCL') + id_clono2 = get_spc_ndx('CLONO2') + + id_br = get_spc_ndx('BR') + id_bro = get_spc_ndx('BRO') + id_hbr = get_spc_ndx('HBR') + id_brono2 = get_spc_ndx('BRONO2') + id_brcl = get_spc_ndx('BRCL') + id_hobr = get_spc_ndx('HOBR') + + ids = (/ id_cly,id_bry, & + id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2, & + id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr /) + + has_clybry = all( ids(:) > 0 ) + + endsubroutine clybry_fam_init + +!-------------------------------------------------------------- +! set the ClOy and BrOy mass mixing ratios +! - this is call before advection +!-------------------------------------------------------------- + subroutine clybry_fam_set( ncol, lchnk, map2chm, q, pbuf ) + + use time_manager, only : get_nstep + use physics_buffer, only : physics_buffer_desc + + implicit none + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: ncol, lchnk + integer, intent(in) :: map2chm(pcnst) + real(r8), intent(inout) :: q(pcols,pver,pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8) :: wrk(ncol,pver,2) + real(r8) :: mmr(pcols,pver,gas_pcnst) + integer :: n, m + + if (.not. has_clybry) return + + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + mmr(:ncol,:,m) = q(:ncol,:, n) + endif + enddo + call get_short_lived_species( mmr, lchnk, ncol, pbuf ) + +!-------------------------------------------------------------- +! ... form updated chlorine, bromine atom mass mixing ratios +!-------------------------------------------------------------- + wrk(:,:,1) = cloy( mmr, pcols, ncol ) + wrk(:,:,2) = broy( mmr, pcols, ncol ) + + mmr(:ncol,:,id_cly) = wrk(:,:,1) + mmr(:ncol,:,id_bry) = wrk(:,:,2) + + call set_short_lived_species( mmr, lchnk, ncol, pbuf ) + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + q(:ncol,:, n) = mmr(:ncol,:,m) + endif + enddo + + end subroutine clybry_fam_set + +!-------------------------------------------------------------- +! adjust the ClOy and BrOy individual family members +! - this is call after advection +!-------------------------------------------------------------- + subroutine clybry_fam_adj( ncol, lchnk, map2chm, q, pbuf ) + + use time_manager, only : is_first_step + use physics_buffer, only : physics_buffer_desc + + implicit none + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: ncol, lchnk + integer, intent(in) :: map2chm(pcnst) + real(r8), intent(inout) :: q(pcols,pver,pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + real(r8) :: factor(ncol,pver) + real(r8) :: wrk(ncol,pver) + real(r8) :: mmr(pcols,pver,gas_pcnst) + + integer :: n, m + + if (.not. has_clybry) return + +!-------------------------------------------------------------- +! ... CLY,BRY are not adjusted until the end of the first timestep +!-------------------------------------------------------------- + if (is_first_step()) return + + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + mmr(:ncol,:,m) = q(:ncol,:, n) + endif + enddo + call get_short_lived_species( mmr, lchnk, ncol, pbuf ) + +!-------------------------------------------------------------- +! ... form updated chlorine atom mass mixing ratio +!-------------------------------------------------------------- + wrk(:,:) = cloy( mmr, pcols, ncol ) + + factor(:ncol,:) = mmr(:ncol,:,id_cly) / wrk(:ncol,:) +!-------------------------------------------------------------- +! ... adjust "group" members +!-------------------------------------------------------------- + mmr(:ncol,:,id_cl) = factor(:ncol,:)*mmr(:ncol,:,id_cl) + mmr(:ncol,:,id_clo) = factor(:ncol,:)*mmr(:ncol,:,id_clo) + mmr(:ncol,:,id_hocl) = factor(:ncol,:)*mmr(:ncol,:,id_hocl) + mmr(:ncol,:,id_cl2) = factor(:ncol,:)*mmr(:ncol,:,id_cl2) + mmr(:ncol,:,id_cl2o2) = factor(:ncol,:)*mmr(:ncol,:,id_cl2o2) + mmr(:ncol,:,id_oclo) = factor(:ncol,:)*mmr(:ncol,:,id_oclo) + mmr(:ncol,:,id_hcl) = factor(:ncol,:)*mmr(:ncol,:,id_hcl) + mmr(:ncol,:,id_clono2) = factor(:ncol,:)*mmr(:ncol,:,id_clono2) + +!-------------------------------------------------------------- +! ... form updated bromine atom mass mixing ratio +!-------------------------------------------------------------- + wrk(:,:) = broy( mmr, pcols, ncol ) + + factor(:ncol,:) = mmr(:ncol,:,id_bry) / wrk(:ncol,:) +!-------------------------------------------------------------- +! ... adjust "group" members +!-------------------------------------------------------------- + mmr(:ncol,:,id_br) = factor(:ncol,:)*mmr(:ncol,:,id_br) + mmr(:ncol,:,id_bro) = factor(:ncol,:)*mmr(:ncol,:,id_bro) + mmr(:ncol,:,id_hbr) = factor(:ncol,:)*mmr(:ncol,:,id_hbr) + mmr(:ncol,:,id_brono2) = factor(:ncol,:)*mmr(:ncol,:,id_brono2) + mmr(:ncol,:,id_brcl) = factor(:ncol,:)*mmr(:ncol,:,id_brcl) + mmr(:ncol,:,id_hobr) = factor(:ncol,:)*mmr(:ncol,:,id_hobr) + + call set_short_lived_species( mmr, lchnk, ncol, pbuf ) + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + q(:ncol,:, n) = mmr(:ncol,:,m) + endif + enddo + + end subroutine clybry_fam_adj + +!-------------------------------------------------------------- +! private methods +!-------------------------------------------------------------- + +!-------------------------------------------------------------- +! compute the mass mixing retio of ClOy +!-------------------------------------------------------------- + function cloy( q, pcols, ncol ) + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: pcols + integer, intent(in) :: ncol + real(r8), intent(in) :: q(pcols,pver,gas_pcnst) + +!-------------------------------------------------------------- +! ... function declaration +!-------------------------------------------------------------- + real(r8) :: cloy(ncol,pver) + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + real(r8) :: wrk(ncol) + integer :: k + + do k = 1,pver + wrk(:) = q(:ncol,k,id_cl) /adv_mass(id_cl) & + + q(:ncol,k,id_clo) /adv_mass(id_clo) & + + q(:ncol,k,id_hocl) /adv_mass(id_hocl) & + + 2._r8*( q(:ncol,k,id_cl2) /adv_mass(id_cl2) & + + q(:ncol,k,id_cl2o2)/adv_mass(id_cl2o2) ) & + + q(:ncol,k,id_oclo) /adv_mass(id_oclo) & + + q(:ncol,k,id_hcl) /adv_mass(id_hcl) & + + q(:ncol,k,id_clono2) /adv_mass(id_clono2) + cloy(:,k) = adv_mass(id_cl) * wrk(:) + end do + + end function cloy + +!-------------------------------------------------------------- +! compute the mass mixing retio of BrOy +!-------------------------------------------------------------- + function broy( q, pcols, ncol ) + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: pcols + integer, intent(in) :: ncol + real(r8), intent(in) :: q(pcols,pver,gas_pcnst) + +!-------------------------------------------------------------- +! ... function declaration +!-------------------------------------------------------------- + real(r8) :: broy(ncol,pver) + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + real(r8) :: wrk(ncol) + integer :: k + + do k = 1,pver + wrk(:) = q(:ncol,k,id_br) /adv_mass(id_br) & + + q(:ncol,k,id_bro) /adv_mass(id_bro) & + + q(:ncol,k,id_hbr) /adv_mass(id_hbr) & + + q(:ncol,k,id_brono2)/adv_mass(id_brono2) & + + q(:ncol,k,id_brcl) /adv_mass(id_brcl) & + + q(:ncol,k,id_hobr) /adv_mass(id_hobr) + broy(:,k) = adv_mass(id_br) * wrk(:) + end do + + end function broy + +end module clybry_fam diff --git a/src/chemistry/mozart/epp_ionization.F90 b/src/chemistry/mozart/epp_ionization.F90 new file mode 100644 index 0000000000..2c46bf818a --- /dev/null +++ b/src/chemistry/mozart/epp_ionization.F90 @@ -0,0 +1,508 @@ +!------------------------------------------------------------------------------- +! Energetic Particle Precipitation (EPP) forcings module +! Manages ionization of the atmosphere due to energetic particles, which consists of +! solar protons events (SPE), galactic cosmic rays(GCR), medium energy electrons (MEE) +!------------------------------------------------------------------------------- +module epp_ionization + use shr_kind_mod, only : r8 => shr_kind_r8, cs => shr_kind_cs, cl=> shr_kind_cl + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use phys_grid, only : pcols, pver, begchunk, endchunk, get_ncols_p + use pio, only : var_desc_t, file_desc_t + use pio, only : pio_get_var, pio_inq_varid, pio_get_att + use pio, only : pio_inq_varndims, pio_inq_vardimid, pio_inq_dimname, pio_inq_dimlen + use pio, only : PIO_NOWRITE + use cam_pio_utils, only : cam_pio_openfile + use ioFileMod, only : getfil + use input_data_utils, only : time_coordinate + + implicit none + private + + public :: epp_ionization_readnl ! read namelist variables + public :: epp_ionization_init ! initialization + public :: epp_ionization_adv ! read and time/space interpolate the data + public :: epp_ionization_ionpairs! ion pairs production rates + public :: epp_ionization_setmag ! update geomagnetic coordinates mapping + public :: epp_ionization_active + + character(len=cl) :: epp_all_filepath = 'NONE' + character(len=cs) :: epp_all_varname = 'epp_ion_rates' + character(len=cl) :: epp_mee_filepath = 'NONE' + character(len=cs) :: epp_mee_varname = 'iprm' + character(len=cl) :: epp_spe_filepath = 'NONE' + character(len=cs) :: epp_spe_varname = 'iprp' + character(len=cl) :: epp_gcr_filepath = 'NONE' + character(len=cs) :: epp_gcr_varname = 'iprg' + + logical, protected :: epp_ionization_active = .false. + + type input_obj_t + type(file_desc_t) :: fid + type(var_desc_t) :: vid + character(len=32) :: units + integer :: nlevs = 0 + integer :: nglats = 0 + real(r8), allocatable :: press(:) + real(r8), allocatable :: glats(:) + real(r8), allocatable :: gwght(:,:) ! (pcol, begchunk:endchunk) + integer, allocatable :: glatn(:,:) ! (pcol, begchunk:endchunk) + real(r8), allocatable :: indata(:,:,:,:) ! (pcol,nlevs,begchunk:endchunk,2) inputs at indexm and indexp + type(time_coordinate) :: time_coord + endtype input_obj_t + + type(input_obj_t), pointer :: epp_in => null() + type(input_obj_t), pointer :: spe_in => null() + type(input_obj_t), pointer :: mee_in => null() + type(input_obj_t), pointer :: gcr_in => null() + +contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mpi_character, masterprocid + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'epp_ionization_readnl' + + namelist /epp_ionization_nl/ epp_all_filepath, epp_all_varname, & + epp_mee_filepath, epp_mee_varname, epp_spe_filepath, epp_spe_varname, epp_gcr_filepath, epp_gcr_varname + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'epp_ionization_nl', status=ierr) + if (ierr == 0) then + read(unitn, epp_ionization_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(epp_all_filepath, len(epp_all_filepath), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_mee_filepath, len(epp_mee_filepath), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_spe_filepath, len(epp_spe_filepath), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_gcr_filepath, len(epp_gcr_filepath), mpi_character, masterprocid, mpicom, ierr) + + call mpi_bcast(epp_all_varname, len(epp_all_varname), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_mee_varname, len(epp_mee_varname), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_spe_varname, len(epp_spe_varname), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(epp_gcr_varname, len(epp_gcr_varname), mpi_character, masterprocid, mpicom, ierr) + + epp_ionization_active = epp_all_filepath /= 'NONE' + epp_ionization_active = epp_mee_filepath /= 'NONE' .or. epp_ionization_active + epp_ionization_active = epp_spe_filepath /= 'NONE' .or. epp_ionization_active + epp_ionization_active = epp_gcr_filepath /= 'NONE' .or. epp_ionization_active + + if ( epp_ionization_active .and. masterproc ) then + write(iulog,*) subname//':: epp_all_filepath = '//trim(epp_all_filepath) + write(iulog,*) subname//':: epp_mee_filepath = '//trim(epp_mee_filepath) + write(iulog,*) subname//':: epp_spe_filepath = '//trim(epp_spe_filepath) + write(iulog,*) subname//':: epp_gcr_filepath = '//trim(epp_gcr_filepath) + endif + + end subroutine epp_ionization_readnl + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_init() + use cam_history, only : addfld + + character(len=32) :: fldunits + fldunits = '' + + if (epp_all_filepath /= 'NONE') then + epp_in => create_input_obj(epp_all_filepath,epp_all_varname) + fldunits = trim(epp_in%units) + else + if (epp_mee_filepath /= 'NONE') then + mee_in => create_input_obj(epp_mee_filepath,epp_mee_varname) + fldunits = trim(mee_in%units) + endif + if (epp_spe_filepath /= 'NONE') then + spe_in => create_input_obj(epp_spe_filepath,epp_spe_varname) + fldunits = trim(spe_in%units) + endif + if (epp_gcr_filepath /= 'NONE') then + gcr_in => create_input_obj(epp_gcr_filepath,epp_gcr_varname) + fldunits = trim(gcr_in%units) + endif + endif + call addfld( 'EPPions', (/ 'lev' /), 'A', fldunits, 'EPP ionization data' ) + + end subroutine epp_ionization_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_setmag( maglat ) + real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) + + if (.not.epp_ionization_active) return + + if ( associated(epp_in) ) then + call set_wghts(maglat,epp_in) + else + if ( associated(mee_in) ) then + call set_wghts(maglat,mee_in) + endif + if ( associated(spe_in) ) then + call set_wghts(maglat,spe_in) + endif + if ( associated(gcr_in) ) then + call set_wghts(maglat,gcr_in) + endif + endif + + end subroutine epp_ionization_setmag + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_adv + + if (.not.epp_ionization_active) return + + if ( associated(epp_in) ) then + call update_input(epp_in) + else + if ( associated(spe_in) ) then + call update_input(spe_in) + endif + if ( associated(gcr_in) ) then + call update_input(gcr_in) + endif + if ( associated(mee_in) ) then + call update_input(mee_in) + endif + endif + + end subroutine epp_ionization_adv + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_ionpairs( ncol, lchnk, pmid, temp, ionpairs ) + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: pmid(:,:), temp(:,:) + real(r8), intent(out) :: ionpairs(:,:) ! ion pair production rate + + ionpairs = 0._r8 + if (.not.epp_ionization_active) return + + if ( associated(epp_in) ) then + ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, epp_in ) + else + if ( associated(spe_in) ) then + ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, spe_in ) + endif + if ( associated(gcr_in) ) then + ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, gcr_in ) + endif + if ( associated(mee_in) ) then + ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, mee_in ) + endif + endif + + end subroutine epp_ionization_ionpairs + + ! private methods + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine update_input( input ) + type(input_obj_t), pointer :: input + + if ( input%time_coord%read_more() ) then + call input%time_coord%advance() + call read_next_data( input ) + else + call input%time_coord%advance() + endif + + end subroutine update_input + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine read_next_data( input ) + type(input_obj_t), pointer :: input + + ! read data corresponding surrounding time indices + if ( input%nglats > 0 ) then + call read_2d_profile( input ) + else + call read_1d_profile( input ) + endif + + end subroutine read_next_data + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) + use interpolate_data, only : lininterp + use physconst, only : rairv + use cam_history, only : outfld + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: pmid(:,:) ! Pa + real(r8), intent(in) :: temp(:,:) ! K + type(input_obj_t), pointer :: input + real(r8) :: ionpairs(ncol,pver) + + real(r8) :: fctr1, fctr2 + real(r8) :: wrk(ncol,input%nlevs) + real(r8) :: ions_diags(ncol,pver) ! for diagnostics + integer :: i + + if (input%time_coord%time_interp) then + ! time interpolate + fctr1 = input%time_coord%wghts(1) + fctr2 = input%time_coord%wghts(2) + wrk(:ncol,:) = fctr1*input%indata(:ncol,:,lchnk,1) + fctr2*input%indata(:ncol,:,lchnk,2) + else + wrk(:ncol,:) = input%indata(:ncol,:,lchnk,1) + endif + + ! vertical interpolate ... + ! interpolate to model levels + do i = 1,ncol + + ! interpolate over log pressure + call lininterp( wrk(i,:input%nlevs), log(input%press(:input%nlevs)*1.e2_r8), input%nlevs, & + ionpairs(i,:pver), log(pmid(i,:pver)), pver ) + ions_diags(i,:pver) = ionpairs(i,:pver) + + if ( index(trim(input%units), 'g^-1') > 0 ) then + ! convert to ionpairs/cm3/sec + ionpairs(i,:pver) = ionpairs(i,:pver) *(1.e-3_r8*pmid(i,:pver)/(rairv(i,:pver,lchnk)*temp(i,:pver))) + endif + enddo + + call outfld( 'EPPions', ions_diags(:ncol,:), ncol, lchnk ) + + end function interp_ionpairs + + !----------------------------------------------------------------------------- + ! read 2D profile (geomag-lat vs press) and transfer to geographic grid + !----------------------------------------------------------------------------- + subroutine read_2d_profile( input ) + + type(input_obj_t), pointer :: input + + ! local vars + real(r8) :: wrk2d( input%nglats, input%nlevs, 2 ) + integer :: t, c, i, ntimes, ncols, ierr + real(r8) :: wght1, wght2 + integer :: gndx1, gndx2 + integer :: cnt(3), strt(3) + + if (input%time_coord%time_interp) then + ntimes = 2 + else + ntimes = 1 + endif + + cnt(1) = input%nglats + cnt(2) = input%nlevs + cnt(3) = ntimes + + strt(:) = 1 + strt(3) = input%time_coord%indxs(1) + + ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk2d ) + + do t = 1,ntimes + do c=begchunk,endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + gndx1 = input%glatn(i,c) + if (gndx1>0) then + wght1 = input%gwght(i,c) + gndx2 = gndx1+1 + if (gndx2.le.input%nglats) then + wght2 = 1._r8-wght1 + input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) & + + wght2*wrk2d(gndx2,:,t) + else + input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) + endif + else + input%indata(i,:,c,t) = 0._r8 + endif + end do + end do + end do + + end subroutine read_2d_profile + + !----------------------------------------------------------------------------- + ! read 1D vertical profile and transfer to geographic grid poleward of 60 degrees geomag-lat + !----------------------------------------------------------------------------- + subroutine read_1d_profile( input ) + + type(input_obj_t), pointer :: input + + ! local vars + real(r8) :: wrk( input%nlevs, 2 ) + integer :: t, c, i, ntimes, ncols, ierr + integer :: cnt(2), strt(2) + + if (input%time_coord%time_interp) then + ntimes = 2 + else + ntimes = 1 + endif + + cnt(1) = input%nlevs + cnt(2) = ntimes + + strt(:) = 1 + strt(2) = input%time_coord%indxs(1) + + ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk ) + + do t = 1,ntimes + do c=begchunk,endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + input%indata(i,:,c,t) = input%gwght(i,c)*wrk(:,t) + end do + end do + end do + + end subroutine read_1d_profile + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + function create_input_obj( path, varname ) result(in_obj) + use infnan, only : nan, assignment(=) + + character(*), intent(in) :: path + character(*), intent(in) :: varname + type(input_obj_t), pointer :: in_obj + + character(len=cl) :: filen + character(len=cl) :: data_units + character(len=cs) :: dimname + integer :: i, ierr + integer, allocatable :: dimids(:) + integer :: pres_did, pres_vid, glat_did, glat_vid, ndims + + if (path .eq. 'NONE') return + + allocate(in_obj) + + call in_obj%time_coord%initialize( path ) + + call getfil( path, filen, 0 ) + call cam_pio_openfile( in_obj%fid, filen, PIO_NOWRITE ) + + ierr = pio_inq_varid( in_obj%fid, varname, in_obj%vid ) + + ierr = pio_get_att( in_obj%fid, in_obj%vid, 'units', data_units) + in_obj%units = trim(data_units(1:32)) + + ierr = pio_inq_varndims( in_obj%fid, in_obj%vid, ndims ) + allocate( dimids(ndims) ) + + ierr = pio_inq_vardimid( in_obj%fid, in_obj%vid, dimids) + pres_did = -1 + glat_did = -1 + do i = 1,ndims + ierr = pio_inq_dimname( in_obj%fid, dimids(i), dimname ) + select case( trim(dimname(1:4)) ) + case ( 'pres', 'lev', 'plev' ) + pres_did = dimids(i) + ierr = pio_inq_varid( in_obj%fid, dimname, pres_vid) + case ( 'glat' ) + glat_did = dimids(i) + ierr = pio_inq_varid( in_obj%fid, dimname, glat_vid) + case default + end select + end do + + deallocate( dimids ) + + if (pres_did>0) then + ierr = pio_inq_dimlen( in_obj%fid, pres_did, in_obj%nlevs ) + allocate( in_obj%press(in_obj%nlevs) ) + ierr = pio_get_var( in_obj%fid, pres_vid, in_obj%press ) + endif + if (glat_did>0) then + ierr = pio_inq_dimlen( in_obj%fid, glat_did, in_obj%nglats ) + allocate( in_obj%glats(in_obj%nglats) ) + ierr = pio_get_var( in_obj%fid, glat_vid, in_obj%glats ) + allocate( in_obj%glatn(pcols,begchunk:endchunk) ) + endif + + allocate( in_obj%gwght(pcols,begchunk:endchunk) ) + + if (in_obj%time_coord%time_interp) then + allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,2) ) + else + allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,1) ) + endif + in_obj%indata = nan + + end function create_input_obj + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine set_wghts( maglat, input ) + + real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) + type(input_obj_t), pointer :: input + + integer :: i, c, ncols, imag + + if (input%nglats>1) then ! read in general EPP 2D ionpairs production rates + do c = begchunk,endchunk + ncols = get_ncols_p(c) + col_loop: do i = 1,ncols + if ( maglat(i,c) .lt. input%glats(1) ) then + input%glatn(i,c) = 1 + input%gwght(i,c) = 1._r8 + elseif ( maglat(i,c) .gt. input%glats(input%nglats) ) then + input%glatn(i,c) = input%nglats + input%gwght(i,c) = 1._r8 + else + mag_loop: do imag = 1,input%nglats-1 + if ( maglat(i,c) .ge. input%glats(imag) .and. & + maglat(i,c) .lt. input%glats(imag+1) ) then + input%gwght(i,c) = (input%glats(imag+1)-maglat(i,c) ) & + / (input%glats(imag+1)-input%glats(imag)) + input%glatn(i,c) = imag + exit mag_loop + endif + enddo mag_loop + endif + enddo col_loop + enddo + else ! read in 1D SPE ionpairs profile ... + do c = begchunk,endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + if ( abs(maglat(i,c)) .ge. 60._r8 ) then ! poleward of 60 degrees + input%gwght(i,c) = 1._r8 + else + input%gwght(i,c) = 0._r8 + endif + enddo + enddo + endif + + call read_next_data( input ) ! update the inputs when wghts are updated + + end subroutine set_wghts + +end module epp_ionization diff --git a/src/chemistry/mozart/euvac.F90 b/src/chemistry/mozart/euvac.F90 new file mode 100644 index 0000000000..32d573326c --- /dev/null +++ b/src/chemistry/mozart/euvac.F90 @@ -0,0 +1,127 @@ +!----------------------------------------------------------------------- +! An emperical model which uses F10.7 index to provide EUV solar spectrum +! Richards, P.G., et al, EUVAC, A solar EUV flux model for aeronomic +! calculations, J.Geophys. Res., 99, 8981 - 8992, 1994 +!----------------------------------------------------------------------- + module euvac + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none + + private + public :: euvac_init + public :: euvac_set_etf + public :: euvac_etf + + save + + integer :: nbins + real(r8), allocatable :: refmin(:) + real(r8), allocatable :: afac(:) + real(r8), target, allocatable :: euvac_etf(:) + + logical :: euvac_on + + contains + + subroutine euvac_init (euvac_file) +!--------------------------------------------------------------- +! ... initialize euvac etf module +!--------------------------------------------------------------- + + use cam_pio_utils, only : cam_pio_openfile + use pio, only : pio_nowrite, pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & + pio_get_var, file_desc_t, pio_closefile + use error_messages, only : alloc_err + use ioFileMod, only : getfil + implicit none + + character(len=*), intent(in) :: euvac_file + +!--------------------------------------------------------------- +! ... local variables +!--------------------------------------------------------------- + type(file_desc_t) :: ncid + integer :: ierr + integer :: dimid + integer :: varid + integer :: astat + character(len=256) :: locfn + + euvac_on = len_trim(euvac_file)>0 .and. euvac_file.ne.'NONE' + if (.not.euvac_on) return + +!----------------------------------------------------------------------- +! ... readin the etf data +!----------------------------------------------------------------------- + call getfil( euvac_file, locfn, 0 ) + call cam_pio_openfile (ncid, trim(locfn), PIO_NOWRITE) +!----------------------------------------------------------------------- +! ... get number of bins +!----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'bin', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, nbins ) + +!----------------------------------------------------------------------- +! ... allocate primary arrays +!----------------------------------------------------------------------- + allocate( refmin(nbins), afac(nbins), euvac_etf(nbins), stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'euvac_init', 'wc ... euvac_etf', nbins ) + end if +!----------------------------------------------------------------------- +! ... read primary arrays +!----------------------------------------------------------------------- + ierr = pio_inq_varid( ncid, 'REFMIN', varid ) + ierr = pio_get_var( ncid, varid, refmin ) + ierr = pio_inq_varid( ncid, 'AFAC', varid ) + ierr = pio_get_var( ncid, varid, afac ) + + call pio_closefile( ncid ) + + end subroutine euvac_init + + subroutine euvac_set_etf( f107, f107a ) +!--------------------------------------------------------------- +! ... set euvac etf +!--------------------------------------------------------------- + + use spmd_utils, only : masterproc + + implicit none + +!--------------------------------------------------------------- +! ... dummy arguments +!--------------------------------------------------------------- + real(r8), intent(in) :: f107 + real(r8), intent(in) :: f107a + +!--------------------------------------------------------------- +! ... local variables +!--------------------------------------------------------------- + real(r8), parameter :: factor = 80._r8 + real(r8) :: pindex + + if (.not.euvac_on) return + + pindex = .5_r8*(f107 + f107a) - factor + euvac_etf(:) = refmin(:) * max( .8_r8,(1._r8 + afac(:)*pindex) ) + + if( masterproc ) then + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) 'euvac_set_etf: f107,f107a = ',f107,f107a +#ifdef EUVAC_DIAGS + write(iulog,*) 'euvac_set_etf: etf' + do w = 1,nbins + write(iulog,'(1p,2g15.7)') euvac_etf(w) + end do +#endif + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) ' ' + end if + + end subroutine euvac_set_etf + + end module euvac diff --git a/src/chemistry/mozart/fire_emissions.F90 b/src/chemistry/mozart/fire_emissions.F90 new file mode 100644 index 0000000000..9411411cce --- /dev/null +++ b/src/chemistry/mozart/fire_emissions.F90 @@ -0,0 +1,272 @@ +!================================================================================ +! manages mapping of CLM generated wild fire emissions to chemical constituents +!================================================================================ +module fire_emissions + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use shr_fire_emis_mod, only : shr_fire_emis_mechcomps, shr_fire_emis_mechcomps_n, shr_fire_emis_elevated + use shr_const_mod, only : pi => SHR_CONST_PI + use shr_const_mod, only : avogad => SHR_CONST_AVOGAD ! Avogadro's number ~ molecules/kmole + use cam_abortutils, only : endrun + use cam_cpl_indices, only : index_x2a_Fall_flxfire + use cam_history, only : addfld, horiz_only, outfld, fieldname_len + use cam_logfile, only : iulog + use ppgrid, only : pver, pverp + use constituents, only : cnst_get_ind + use rad_constituents, only : rad_cnst_get_aer_props, rad_cnst_num_name + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx + use chem_mods, only : adv_mass ! g/mole + use infnan, only : nan, assignment(=) + + implicit none + private + save + + public :: fire_emissions_init + public :: fire_emissions_srf + public :: fire_emissions_vrt + + ! for surface emissions + integer, allocatable :: fire_emis_indices_map(:) + + ! for vertically distributed forcings + integer, allocatable :: frc_spc_map(:) + integer, allocatable :: chm_spc_map(:) + integer, allocatable :: frc_num_map(:) + real(r8), allocatable :: spc_mass_factor(:) + real(r8), allocatable :: num_mass_factor(:) + character(len=fieldname_len), allocatable :: fire_frc_name(:) + character(len=fieldname_len), allocatable :: fire_numfrc_name(:) + character(len=fieldname_len), allocatable :: fire_sflx_name(:) + character(len=fieldname_len), allocatable :: fire_vflx_name(:) + +!================================================================================ +contains +!================================================================================ + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine fire_emissions_init() + + + ! local vars + integer :: n, ii + + integer :: frc_ndx, spc_ndx, ndx + integer :: mode, spec + character(len=16) :: name + character(len=32) :: spc_name + character(len=32) :: num_name + + real(r8), parameter :: demis_acc = 0.134e-6_r8 ! meters + ! volume-mean emissions diameter of primary BC/OM aerosols, see : + ! Liu et al, Toward a minimal representation of aerosols in climate models: + ! Description and evaluation in the Community Atmosphere Model CAM5. + ! Geosci. Model Dev., 5, 709–739, doi:10.5194/gmd-5-709-2012 + ! and Table S1 in Supplement: http://www.geosci-model-dev.net/5/709/2012/gmd-5-709-2012-supplement.pdf + + real(r8), parameter :: x_numfact = 1.e-6_r8 * avogad * 6.0_r8 / (pi*(demis_acc**3)) ! 1.e-6 converts m-3 to cm-3. + real(r8) :: specdens ! kg/m3 + logical :: found + + if (shr_fire_emis_mechcomps_n<1) return + + if (shr_fire_emis_elevated) then ! initialize elevated forcings + + allocate( frc_spc_map(shr_fire_emis_mechcomps_n) ) + allocate( chm_spc_map(shr_fire_emis_mechcomps_n) ) + allocate( frc_num_map(shr_fire_emis_mechcomps_n) ) + allocate( spc_mass_factor(shr_fire_emis_mechcomps_n) ) + allocate( num_mass_factor(shr_fire_emis_mechcomps_n) ) + allocate( fire_frc_name(shr_fire_emis_mechcomps_n) ) + allocate( fire_numfrc_name(shr_fire_emis_mechcomps_n) ) + allocate( fire_sflx_name(shr_fire_emis_mechcomps_n) ) + allocate( fire_vflx_name(shr_fire_emis_mechcomps_n) ) + + frc_spc_map(:) = -1 + frc_num_map(:) = -1 + spc_mass_factor(:) = nan + num_mass_factor(:) = nan + + call addfld ('Fire_ZTOP', horiz_only, 'A', 'm', 'top of vertical fire emissions' ) + + do n=1,shr_fire_emis_mechcomps_n + + name = shr_fire_emis_mechcomps(n)%name + fire_frc_name(n) = 'FireFrc_'//trim(name) + fire_sflx_name(n) = 'FireSFLX_'//trim(name) + fire_vflx_name(n) = 'FireVFLX_'//trim(name) + + call addfld (fire_frc_name(n), (/'lev'/), 'A','molecules/cm^3/s', 'vertical fire emissions for '//trim(name)) + call addfld (fire_sflx_name(n),horiz_only,'A','kg/m^2/s', 'surface fire emissions for '//trim(name)) + call addfld (fire_vflx_name(n),horiz_only,'A','kg/m^2/s', 'vertically integrated fire emissions for '//trim(name)) + + frc_ndx = get_extfrc_ndx( name ) + spc_ndx = get_spc_ndx( name ) + + if (frc_ndx>0 .and. spc_ndx>0) then + frc_spc_map(n) = frc_ndx + chm_spc_map(n) = spc_ndx + else + write(iulog,*) 'fire_emissions_init: not able to map '//trim(name)//' to chem species/forcing ' + write(iulog,*) 'fire_emissions_init: ... frc_ndx = ',frc_ndx + write(iulog,*) 'fire_emissions_init: ... spc_ndx = ',spc_ndx + call endrun('fire_emissions_init: not able to map '//trim(name)//' to chem species/forcing ') + endif + + spc_mass_factor(n) = 1.e-6_r8 * avogad / adv_mass(spc_ndx) ! 1.e-6 converts m-3 to cm-3. + ! (molecules/kmole) / (g/mole) --> molecules/kg + + ! for MAM need to include cooresponding forcings of number densities + + found = rad_cnst_num_name(0, name, num_name, mode_out=mode, spec_out=spec ) + + if ( found ) then + + frc_ndx = get_extfrc_ndx( num_name ) + + call rad_cnst_get_aer_props(0, mode, spec, density_aer=specdens) + frc_num_map(n) = frc_ndx + num_mass_factor(n) = x_numfact / specdens + + fire_numfrc_name(n) = 'FireFrc_'//trim(name)//'_'//trim(num_name) + call addfld (fire_numfrc_name(n),(/'lev'/), 'A', 'molecules/cm^3/s', & + 'vertical fire emissions for '//trim(num_name)//' due to component '//trim(name)) + + endif + + enddo + + else ! initialize surface emissions + + allocate( fire_emis_indices_map(shr_fire_emis_mechcomps_n) ) + + do n=1,shr_fire_emis_mechcomps_n + call cnst_get_ind (shr_fire_emis_mechcomps(n)%name, fire_emis_indices_map(n), abort=.false. ) + + ii = get_spc_ndx(shr_fire_emis_mechcomps(n)%name) + if (ii<1) then + call endrun('gas_phase_chemdr_inti: Fire emissions compound not in chemistry mechanism : '& + //trim(shr_fire_emis_mechcomps(n)%name)) + endif + + ! Fire emis history fields + call addfld( 'FireSF_'//trim(shr_fire_emis_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',& + trim(shr_fire_emis_mechcomps(n)%name)//' Fire emissions flux') + + enddo + + endif + + end subroutine fire_emissions_init + + !------------------------------------------------------------------------------ + ! sets surface emissions + !------------------------------------------------------------------------------ + subroutine fire_emissions_srf( lchnk, ncol, fireflx, sflx ) + + ! dummy args + integer, intent(in) :: lchnk, ncol + real(r8), pointer, intent(in) :: fireflx(:,:) + real(r8), intent(inout) :: sflx(:,:) + + ! local vars + integer :: i, n + + ! fire surface emissions if not elevated forcing + if ((.not.shr_fire_emis_elevated) .and. index_x2a_Fall_flxfire>0 .and. shr_fire_emis_mechcomps_n>0 ) then + + ! set Fire Emis fluxes ( add to other emis ) + do i =1,ncol + do n = 1,shr_fire_emis_mechcomps_n + sflx(i,fire_emis_indices_map(n)) & + = sflx(i,fire_emis_indices_map(n)) + fireflx(i,n) + enddo + end do + + ! output fire emis fluxes to history + do n = 1,shr_fire_emis_mechcomps_n + call outfld('FireSF_'//trim(shr_fire_emis_mechcomps(n)%name), fireflx(:ncol,n), ncol, lchnk) + enddo + + endif + + end subroutine fire_emissions_srf + + !------------------------------------------------------------------------------ + ! sets vertical emissions (forcings) + ! vertically distributes wild fire emissions + !------------------------------------------------------------------------------ + subroutine fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, frcing ) + + ! args + integer, intent(in) :: ncol,lchnk + real(r8), intent(in) :: zint(:,:) ! interface geopot above surface (km) + real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire surface emissions (kg/m2/sec) + real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vert distribution of fire surface emissions (m) + real(r8), intent(inout) :: frcing(:,:,:) ! insitu forcings (molecules/cm3/sec) + + ! local vars + real(r8) :: vertical_fire(ncol,pver), ztop + integer :: n, i,k + real(r8) :: fire_frc(ncol,pver) + real(r8) :: sflx(ncol) + + if (.not.shr_fire_emis_elevated) return + if (shr_fire_emis_mechcomps_n<1) return + + ! define vertical_fire from Dentener units /m + do k=1,pver + do i=1,ncol + ztop = fire_ztop(i)*1.e-3_r8 ! convert m to km + if(zint(i,k)ztop.and.zint(i,k+1) molecules/cm3/s + fire_frc(:ncol,k) = fire_sflx(:ncol,n) * vertical_fire(:ncol,k) * spc_mass_factor(n) ! molecules/cm3/s + enddo + call outfld( fire_frc_name(n), fire_frc, ncol, lchnk ) + frcing(:ncol,:,frc_spc_map(n)) = frcing(:ncol,:,frc_spc_map(n)) + fire_frc(:ncol,:) + + ! for debugging ... + ! vertical intergration of the forcing should get back the surface flux + sflx(:) = 0._r8 + do k = 1,pver + sflx(:ncol) = sflx(:ncol) + 1.e5_r8*(zint(:ncol,k)-zint(:ncol,k+1))*fire_frc(:ncol,k) ! molecules/cm3/s --> molecules/cm2/sec + enddo + sflx(:ncol) = sflx(:ncol) * 1.e4_r8 * adv_mass(chm_spc_map(n))/avogad ! molecules/cm2/sec --> kg/m2/sec + ! / avogad --> kmoles/cm2/sec + ! * adv_mass --> kg/cm2/sec + ! * 1.e4 --> kg/ m2/sec + call outfld( fire_vflx_name(n), sflx(:ncol ), ncol, lchnk ) + call outfld( fire_sflx_name(n), fire_sflx(:ncol,n), ncol, lchnk ) + + ! for MAM need to include corresponding forcings of number densities + if (frc_num_map(n)>0) then + do k = 1,pver + fire_frc(:ncol,k) = fire_sflx(:ncol,n) * vertical_fire(:ncol,k) * num_mass_factor(n) ! molecules/cm3/s + enddo + call outfld( fire_numfrc_name(n), fire_frc, ncol, lchnk ) + frcing(:ncol,:,frc_num_map(n)) = frcing(:ncol,:,frc_num_map(n)) + fire_frc(:ncol,:) + endif + + enddo + + call outfld( 'Fire_ZTOP', fire_ztop(:ncol), ncol, lchnk ) + + end subroutine fire_emissions_vrt + +end module fire_emissions diff --git a/src/chemistry/mozart/gas_wetdep_opts.F90 b/src/chemistry/mozart/gas_wetdep_opts.F90 new file mode 100644 index 0000000000..bf6b1d550e --- /dev/null +++ b/src/chemistry/mozart/gas_wetdep_opts.F90 @@ -0,0 +1,76 @@ +!----------------------------------------------------------------------- +! Reads namelist options for gas-phase wet deposition +! +! Created by Francis Vitt -- 22 Apr 2011 +!----------------------------------------------------------------------- +module gas_wetdep_opts + + use constituents, only : pcnst + use cam_logfile, only : iulog + use constituents, only : pcnst + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + + implicit none + + character(len=16), protected :: gas_wetdep_list(pcnst) = ' ' + character(len=3), protected :: gas_wetdep_method = 'MOZ' + integer, protected :: gas_wetdep_cnt = 0 + +contains + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + + subroutine gas_wetdep_readnl(nlfile) + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit +#ifdef SPMD + use mpishorthand, only: mpichar, mpicom +#endif + + implicit none + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, i, ierr + + namelist /wetdep_inparm/ gas_wetdep_list + namelist /wetdep_inparm/ gas_wetdep_method + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'wetdep_inparm', status=ierr) + if (ierr == 0) then + read(unitn, wetdep_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun('mo_neu_wetdep->wetdep_readnl: ERROR reading wetdep_inparm namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast (gas_wetdep_list, len(gas_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast (gas_wetdep_method, len(gas_wetdep_method), mpichar, 0, mpicom) +#endif + + gas_wetdep_cnt = 0 + do i = 1,pcnst + if ( len_trim(gas_wetdep_list(i)) > 0 ) then + gas_wetdep_cnt = gas_wetdep_cnt + 1 + endif + enddo + + if (( gas_wetdep_cnt>0 ).and.( .not.(gas_wetdep_method=='MOZ' .or. gas_wetdep_method=='NEU' & + .or. gas_wetdep_method=='OFF') )) then + call endrun('gas_wetdep_readnl; gas_wetdep_method must be set to either MOZ or NEU') + endif + + end subroutine gas_wetdep_readnl + +end module gas_wetdep_opts diff --git a/src/chemistry/mozart/gcr_ionization.F90 b/src/chemistry/mozart/gcr_ionization.F90 new file mode 100644 index 0000000000..bff9e2e6e5 --- /dev/null +++ b/src/chemistry/mozart/gcr_ionization.F90 @@ -0,0 +1,163 @@ +module gcr_ionization + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld,trfile + use cam_logfile, only : iulog + use physics_buffer, only : physics_buffer_desc + use physics_types, only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use tracer_data, only : trcdata_init, advance_trcdata + + implicit none + private + public :: gcr_ionization_readnl + public :: gcr_ionization_init + public :: gcr_ionization_adv + public :: gcr_ionization_ionpairs + + type(trfld), pointer :: fields(:) + type(trfile), save :: file + + character(len=32) :: specifier(1) = 'prod' + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: datatype = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + + logical :: has_gcr_ionization = .false. + +contains + !------------------------------------------------------------------- + !------------------------------------------------------------------- + subroutine gcr_ionization_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'gcr_ionization_readnl' + + character(len=16) :: gcr_ionization_fldname + character(len=256) :: gcr_ionization_filename + character(len=256) :: gcr_ionization_datapath + character(len=256) :: gcr_ionization_filelist + character(len=32) :: gcr_ionization_datatype + integer :: gcr_ionization_cycle_yr + integer :: gcr_ionization_fixed_ymd + integer :: gcr_ionization_fixed_tod + + namelist /gcr_ionization_nl/ & + gcr_ionization_fldname, & + gcr_ionization_filename, & + gcr_ionization_datapath, & + gcr_ionization_filelist, & + gcr_ionization_datatype, & + gcr_ionization_cycle_yr, & + gcr_ionization_fixed_ymd, & + gcr_ionization_fixed_tod + + gcr_ionization_fldname = specifier(1) + gcr_ionization_filename = filename + gcr_ionization_datapath = datapath + gcr_ionization_filelist = filelist + gcr_ionization_datatype = datatype + gcr_ionization_cycle_yr = cycle_yr + gcr_ionization_fixed_ymd = fixed_ymd + gcr_ionization_fixed_tod = fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'gcr_ionization_nl', status=ierr) + if (ierr == 0) then + read(unitn, gcr_ionization_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(gcr_ionization_fldname, len(gcr_ionization_fldname), mpichar, 0, mpicom) + call mpibcast(gcr_ionization_filename, len(gcr_ionization_filename), mpichar, 0, mpicom) + call mpibcast(gcr_ionization_filelist, len(gcr_ionization_filelist), mpichar, 0, mpicom) + call mpibcast(gcr_ionization_datapath, len(gcr_ionization_datapath), mpichar, 0, mpicom) + call mpibcast(gcr_ionization_datatype, len(gcr_ionization_datatype), mpichar, 0, mpicom) + call mpibcast(gcr_ionization_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(gcr_ionization_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(gcr_ionization_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier(1) = gcr_ionization_fldname + filename = gcr_ionization_filename + filelist = gcr_ionization_filelist + datapath = gcr_ionization_datapath + datatype = gcr_ionization_datatype + cycle_yr = gcr_ionization_cycle_yr + fixed_ymd = gcr_ionization_fixed_ymd + fixed_tod = gcr_ionization_fixed_tod + + ! Turn on galactic cosmic rays if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_gcr_ionization = .true. + + end subroutine gcr_ionization_readnl + + !------------------------------------------------------------------- + !------------------------------------------------------------------- + subroutine gcr_ionization_init() + + if (.not.has_gcr_ionization) return + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype ) + + end subroutine gcr_ionization_init + + !------------------------------------------------------------------- + !------------------------------------------------------------------- + subroutine gcr_ionization_adv( pbuf2d, state ) + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (.not.has_gcr_ionization) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + end subroutine gcr_ionization_adv + + !------------------------------------------------------------------- + !------------------------------------------------------------------- + subroutine gcr_ionization_ionpairs( ncol, lchnk, ionpairs ) + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + real(r8), intent(out) :: ionpairs(:,:) + + ionpairs(:,:) = 0._r8 + + if (.not.has_gcr_ionization) return + + ionpairs(:ncol,:) = fields(1)%data(:ncol,:,lchnk) + + end subroutine gcr_ionization_ionpairs + + +end module gcr_ionization diff --git a/src/chemistry/mozart/lin_strat_chem.F90 b/src/chemistry/mozart/lin_strat_chem.F90 new file mode 100644 index 0000000000..e67352bfb6 --- /dev/null +++ b/src/chemistry/mozart/lin_strat_chem.F90 @@ -0,0 +1,300 @@ + +!-------------------------------------------------------------------- +! linearized ozone chemistry LINOZ +! from Hsu and Prather, JGR, 2008 +! +! written by Jean-Francois Lamarque (September 2008) +! modified by +! 24 Oct 2008 -- Francis Vitt +! 9 Dec 2008 -- Philip Cameron-Smith, LLNL, -- added ltrop +!-------------------------------------------------------------------- +module lin_strat_chem + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : begchunk, endchunk + use physics_types, only : physics_state + use cam_logfile, only : iulog + use cam_abortutils, only : endrun + ! + implicit none + ! + private ! all unless made public + + save + ! + ! define public components of module + ! + public :: lin_strat_chem_inti, lin_strat_chem_solve + public :: do_lin_strat_chem + + integer :: index_o3 + logical :: do_lin_strat_chem + + +contains + +!-------------------------------------------------------------------- +!-------------------------------------------------------------------- + subroutine lin_strat_chem_inti(phys_state) + ! + ! initialize linearized stratospheric chemistry by reading + ! input parameters from netcdf file and interpolate to + ! present model grid + ! + use linoz_data, only : linoz_data_init, has_linoz_data + use ppgrid, only : pver + use mo_chem_utls, only : get_spc_ndx + use cam_history, only : addfld, horiz_only, add_default + use physics_buffer, only : physics_buffer_desc + use phys_control, only : phys_getopts + + implicit none + + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + + logical :: history_chemistry + + call phys_getopts(history_chemistry_out=history_chemistry) + + if (.not.has_linoz_data) return + + ! + ! find index of ozone + ! + index_o3 = get_spc_ndx('O3') + do_lin_strat_chem = has_linoz_data + if ( index_o3 <= 0 ) then + write(iulog,*) ' No ozone in the chemical mechanism, skipping lin_strat_chem' + do_lin_strat_chem = .false. + return + end if + + ! check for synoz + + if( get_spc_ndx( 'SYNOZ' ) > 0 .and. has_linoz_data) then + call endrun('lin_strat_chem_inti: cannot have both synoz and linoz') + endif + + ! initialize the linoz data + + call linoz_data_init() + + ! define additional output + + call addfld( 'LINOZ_DO3' , (/ 'lev' /), 'A', '/s' , 'ozone vmr tendency by linearized ozone chemistry' ) + call addfld( 'LINOZ_DO3_PSC', (/ 'lev' /), 'A', '/s' , 'ozone vmr loss by PSCs using Carille et al. (1990)' ) + call addfld( 'LINOZ_SSO3' , (/ 'lev' /), 'A', 'kg' , 'steady state ozone in LINOZ' ) + call addfld( 'LINOZ_O3COL' , (/ 'lev' /), 'A', 'DU' , 'ozone column above' ) + call addfld( 'LINOZ_O3CLIM' , (/ 'lev' /), 'A', 'mol/mol', 'climatology of ozone in LINOZ' ) + call addfld( 'LINOZ_SZA' , horiz_only, 'A', 'degrees', 'solar zenith angle in LINOZ' ) + + if (history_chemistry) then + call add_default( 'LINOZ_DO3' , 1, ' ' ) + call add_default( 'LINOZ_DO3_PSC', 1, ' ' ) + call add_default( 'LINOZ_SSO3' , 1, ' ' ) + call add_default( 'LINOZ_O3COL' , 1, ' ' ) + call add_default( 'LINOZ_O3CLIM' , 1, ' ' ) + call add_default( 'LINOZ_SZA' , 1, ' ' ) + end if + + return + end subroutine lin_strat_chem_inti + + +!-------------------------------------------------------------------- +!-------------------------------------------------------------------- + subroutine lin_strat_chem_solve( ncol, lchnk, o3_vmr, o3col, temp, sza, pmid, delta_t, rlats, ltrop ) + + use chlorine_loading_data, only: chlorine_loading + + ! + ! this subroutine updates the ozone mixing ratio in the stratosphere + ! using linearized chemistry + ! + + use ppgrid, only : pcols, pver + use physconst, only : pi + use cam_history, only : outfld + use linoz_data, only : fields, o3_clim_ndx,t_clim_ndx,o3col_clim_ndx,PmL_clim_ndx,dPmL_dO3_ndx,& + dPmL_dT_ndx,dPmL_dO3col_ndx,cariolle_pscs_ndx + ! + ! dummy arguments + ! + integer, intent(in) :: ncol ! number of columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(inout), dimension(ncol ,pver) :: o3_vmr ! ozone volume mixing ratio + real(r8), intent(in) , dimension(ncol ,pver) :: o3col ! ozone column above box (mol/cm^2) + real(r8), intent(in) , dimension(pcols,pver) :: temp ! temperature (K) + real(r8), intent(in) , dimension(ncol ) :: sza ! local solar zenith angle + real(r8), intent(in) , dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) + real(r8), intent(in) :: delta_t ! timestep size (secs) + real(r8), intent(in) :: rlats(ncol) ! column latitudes (radians) + integer, intent(in) , dimension(pcols) :: ltrop ! chunk index + ! + ! local + ! + integer :: i,k,n !,index_lat,index_month + real(r8) :: o3col_du,delta_temp,delta_o3col,o3_old,o3_new,delta_o3 + real(r8) :: max_sza, psc_loss + real(r8) :: o3_clim + real(r8), dimension(ncol) :: lats + real(r8), dimension(ncol,pver) :: do3_linoz,do3_linoz_psc,ss_o3,o3col_du_diag,o3clim_linoz_diag + + real(r8), dimension(:,:), pointer :: linoz_o3_clim + real(r8), dimension(:,:), pointer :: linoz_t_clim + real(r8), dimension(:,:), pointer :: linoz_o3col_clim + real(r8), dimension(:,:), pointer :: linoz_PmL_clim + real(r8), dimension(:,:), pointer :: linoz_dPmL_dO3 + real(r8), dimension(:,:), pointer :: linoz_dPmL_dT + real(r8), dimension(:,:), pointer :: linoz_dPmL_dO3col + real(r8), dimension(:,:), pointer :: linoz_cariolle_psc + + ! + ! parameters + ! + real(r8), parameter :: convert_to_du = 1._r8/(2.687e16_r8) ! convert ozone column from mol/cm^2 to DU + real(r8), parameter :: degrees_to_radians = pi/180._r8 ! conversion factors + real(r8), parameter :: radians_to_degrees = 180._r8/pi + real(r8), parameter :: temp_activation_cariolle = 193._r8 ! O3 loss freq when T below temp_activation_cariolle (K) + real(r8), parameter :: chlorine_loading_1987 = 2.5977_r8 ! EESC value (ppbv) + real(r8), parameter :: chlorine_loading_bgnd = 0.0000_r8 ! EESC value (ppbv) for background conditions + real(r8), parameter :: pressure_threshold = 210.e+2_r8 ! {PJC} for diagnostics only + + ! + ! skip if no ozone field available + ! + if ( .not. do_lin_strat_chem ) return + + ! + ! associate the field pointers + ! + linoz_o3_clim => fields(o3_clim_ndx) %data(:,:,lchnk ) + linoz_t_clim => fields(t_clim_ndx) %data(:,:,lchnk ) + linoz_o3col_clim => fields(o3col_clim_ndx) %data(:,:,lchnk ) + linoz_PmL_clim => fields(PmL_clim_ndx) %data(:,:,lchnk ) + linoz_dPmL_dO3 => fields(dPmL_dO3_ndx) %data(:,:,lchnk ) + linoz_dPmL_dT => fields(dPmL_dT_ndx) %data(:,:,lchnk ) + linoz_dPmL_dO3col => fields(dPmL_dO3col_ndx) %data(:,:,lchnk ) + linoz_cariolle_psc => fields(cariolle_pscs_ndx)%data(:,:,lchnk ) + + ! + ! initialize output arrays + ! + do3_linoz = 0._r8 + do3_linoz_psc = 0._r8 + o3col_du_diag = 0._r8 + o3clim_linoz_diag = 0._r8 + ss_o3 = 0._r8 + ! + ! convert lats from radians to degrees + ! + lats = rlats * radians_to_degrees + + LOOP_COL: do i=1,ncol + LOOP_LEV: do k=1,ltrop(i) + ! + ! climatological ozone + ! + o3_clim = linoz_o3_clim(i,k) + ! + ! skip if not in the stratosphere + ! + if ( pmid(i,k) > pressure_threshold ) THEN ! PJC diagnostic + WRITE(iulog,*)'LINOZ WARNING: Exceeded PRESSURE threshold (i,k,p_threshold,pmid,o3)=',& + i,k,nint(pressure_threshold/100._r8),'mb',nint(pmid(i,k)/100._r8),'mb',nint(o3_vmr(i,k)*1e9_r8),'ppb' !PJC +! cycle LOOP_LEV + endif + ! + ! diagnostic for output + ! + o3clim_linoz_diag(i,k) = o3_clim + ! + ! old ozone mixing ratio + ! + o3_old = o3_vmr(i,k) + ! + ! convert o3col from mol/cm2 + ! + o3col_du = o3col(i,k) * convert_to_du + o3col_du_diag(i,k) = o3col_du + ! + ! compute differences from climatology + ! + delta_temp = temp(i,k) - linoz_t_clim (i,k) + delta_o3col = o3col_du - linoz_o3col_clim(i,k) + + + ! + ! steady state ozone + ! + ss_o3(i,k) = o3_clim - ( linoz_PmL_clim (i,k) & + + delta_o3col * linoz_dPmL_dO3col(i,k) & + + delta_temp * linoz_dPmL_dT (i,k) & + ) / linoz_dPmL_dO3 (i,k) + + + ! + ! ozone change + ! + delta_o3 = (ss_o3(i,k)-o3_old) * (1._r8 - exp(linoz_dPmL_dO3(i,k)*delta_t)) + ! + ! define new ozone mixing ratio + ! + o3_new = o3_old + delta_o3 + ! + ! output diagnostic + ! + do3_linoz(i,k) = delta_o3/delta_t + ! + ! PSC activation (follows Cariolle et al 1990.) + ! + ! use only if abs(latitude) > 40. + ! + if ( abs(lats(i)) > 40._r8 ) then + if ( (chlorine_loading-chlorine_loading_bgnd) > 0._r8 ) then + if ( temp(i,k) <= temp_activation_cariolle ) then + ! + ! define maximum SZA for PSC loss (= tangent height at sunset) + ! + max_sza = (90._r8 + sqrt( max( 16._r8*log10(100000._r8/pmid(i,k)),0._r8))) +#ifdef DEBUG + write(iulog,*)sza(i),max_sza +#endif + if ( (sza(i)*radians_to_degrees) <= max_sza ) then + + psc_loss = exp(-linoz_cariolle_psc(i,k) & + * (chlorine_loading/chlorine_loading_1987)**2 & + * delta_t ) + + o3_new = o3_old * psc_loss + ! + ! output diagnostic + ! + do3_linoz_psc(i,k) = (o3_new-o3_old)/delta_t + ! + end if + end if + end if + end if + ! + ! update ozone vmr + ! + o3_vmr(i,k) = o3_new + + end do LOOP_LEV + end do LOOP_COL + ! + ! output + ! + call outfld( 'LINOZ_DO3' , do3_linoz , ncol, lchnk ) + call outfld( 'LINOZ_DO3_PSC', do3_linoz_psc , ncol, lchnk ) + call outfld( 'LINOZ_SSO3' , ss_o3 , ncol, lchnk ) + call outfld( 'LINOZ_O3COL' , o3col_du_diag , ncol, lchnk ) + call outfld( 'LINOZ_O3CLIM' , o3clim_linoz_diag , ncol, lchnk ) + call outfld( 'LINOZ_SZA' ,(sza*radians_to_degrees), ncol, lchnk ) + + return + end subroutine lin_strat_chem_solve + +end module lin_strat_chem diff --git a/src/chemistry/mozart/linoz_data.F90 b/src/chemistry/mozart/linoz_data.F90 new file mode 100644 index 0000000000..b4a4dc263f --- /dev/null +++ b/src/chemistry/mozart/linoz_data.F90 @@ -0,0 +1,315 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of linoz data +! Created by: Francis Vitt +!------------------------------------------------------------------- +module linoz_data + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld,trfile + use cam_logfile, only : iulog + + implicit none + + private ! all unless made public + save + + public :: fields + public :: linoz_data_init + public :: linoz_data_adv + public :: init_linoz_data_restart + public :: write_linoz_data_restart + public :: read_linoz_data_restart + public :: has_linoz_data + public :: linoz_data_defaultopts + public :: linoz_data_setopts + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + logical :: has_linoz_data = .false. + integer, parameter, public :: N_FLDS = 8 + integer :: number_flds + + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: datatype = 'CYCLICAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + + character(len=16), dimension(N_FLDS), parameter :: fld_names = & ! data field names + (/'o3_clim ','t_clim ','o3col_clim ','PmL_clim ', & + 'dPmL_dO3 ','dPmL_dT ','dPmL_dO3col ','cariolle_pscs '/) + + character(len=16), dimension(N_FLDS), parameter :: fld_units = & ! data field names + (/'vmr ','K ','Dobson Units ','mr/s ', & + '/s ','mr/K ','mr/DU ','/s '/) + + integer :: index_map(N_FLDS) + + integer, public, parameter :: o3_clim_ndx = 1 + integer, public, parameter :: t_clim_ndx = 2 + integer, public, parameter :: o3col_clim_ndx = 3 + integer, public, parameter :: PmL_clim_ndx = 4 + + integer, public, parameter :: dPmL_dO3_ndx = 5 + integer, public, parameter :: dPmL_dT_ndx = 6 + integer, public, parameter :: dPmL_dO3col_ndx = 7 + integer, public, parameter :: cariolle_pscs_ndx = 8 + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine linoz_data_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld + use ppgrid, only : pver + use error_messages, only: handle_err + use ppgrid, only: pcols, pver, begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + implicit none + + integer :: ndx, istat, i + + if ( has_linoz_data ) then + if ( masterproc ) then + write(iulog,*) 'linoz_data_ini: linoz data :'//trim(filename) + endif + else + return + endif + + allocate(file%in_pbuf(size(fld_names))) + file%in_pbuf(:) = .false. + call trcdata_init( fld_names, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + number_flds = 0 + if (associated(fields)) number_flds = size( fields ) + + if( number_flds < 1 ) then + if ( masterproc ) then + write(iulog,*) 'linoz_data_init: There are no linoz data' + write(iulog,*) ' ' + endif + return + end if + + do i = 1,number_flds + ndx = get_ndx( fields(i)%fldnam ) + index_map(i) = ndx + + if (ndx < 1) then + call endrun('linoz_data_init: '//trim(fields(i)%fldnam)//' is not one of the named linoz data fields ') + endif + call addfld(fld_names(i), (/ 'lev' /), 'I', fld_units(i), 'linoz data' ) + enddo + + + end subroutine linoz_data_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine linoz_data_setopts(& + linoz_data_file_in, & + linoz_data_filelist_in, & + linoz_data_path_in, & + linoz_data_type_in, & + linoz_data_rmfile_in, & + linoz_data_cycle_yr_in, & + linoz_data_fixed_ymd_in, & + linoz_data_fixed_tod_in & + ) + + implicit none + + character(len=*), intent(in), optional :: linoz_data_file_in + character(len=*), intent(in), optional :: linoz_data_filelist_in + character(len=*), intent(in), optional :: linoz_data_path_in + character(len=*), intent(in), optional :: linoz_data_type_in + logical, intent(in), optional :: linoz_data_rmfile_in + integer, intent(in), optional :: linoz_data_cycle_yr_in + integer, intent(in), optional :: linoz_data_fixed_ymd_in + integer, intent(in), optional :: linoz_data_fixed_tod_in + + if ( present(linoz_data_file_in) ) then + filename = linoz_data_file_in + endif + if ( present(linoz_data_filelist_in) ) then + filelist = linoz_data_filelist_in + endif + if ( present(linoz_data_path_in) ) then + datapath = linoz_data_path_in + endif + if ( present(linoz_data_type_in) ) then + datatype = linoz_data_type_in + endif + if ( present(linoz_data_rmfile_in) ) then + rmv_file = linoz_data_rmfile_in + endif + if ( present(linoz_data_cycle_yr_in) ) then + cycle_yr = linoz_data_cycle_yr_in + endif + if ( present(linoz_data_fixed_ymd_in) ) then + fixed_ymd = linoz_data_fixed_ymd_in + endif + if ( present(linoz_data_fixed_tod_in) ) then + fixed_tod = linoz_data_fixed_tod_in + endif + + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_linoz_data = .true. + + endsubroutine linoz_data_setopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine linoz_data_defaultopts( & + linoz_data_file_out, & + linoz_data_filelist_out, & + linoz_data_path_out, & + linoz_data_type_out, & + linoz_data_rmfile_out, & + linoz_data_cycle_yr_out, & + linoz_data_fixed_ymd_out,& + linoz_data_fixed_tod_out & + ) + + implicit none + + character(len=*), intent(out), optional :: linoz_data_file_out + character(len=*), intent(out), optional :: linoz_data_filelist_out + character(len=*), intent(out), optional :: linoz_data_path_out + character(len=*), intent(out), optional :: linoz_data_type_out + logical, intent(out), optional :: linoz_data_rmfile_out + integer, intent(out), optional :: linoz_data_cycle_yr_out + integer, intent(out), optional :: linoz_data_fixed_ymd_out + integer, intent(out), optional :: linoz_data_fixed_tod_out + + if ( present(linoz_data_file_out) ) then + linoz_data_file_out = filename + endif + if ( present(linoz_data_filelist_out) ) then + linoz_data_filelist_out = filelist + endif + if ( present(linoz_data_path_out) ) then + linoz_data_path_out = datapath + endif + if ( present(linoz_data_type_out) ) then + linoz_data_type_out = datatype + endif + if ( present(linoz_data_rmfile_out) ) then + linoz_data_rmfile_out = rmv_file + endif + if ( present(linoz_data_cycle_yr_out) ) then + linoz_data_cycle_yr_out = cycle_yr + endif + if ( present(linoz_data_fixed_ymd_out) ) then + linoz_data_fixed_ymd_out = fixed_ymd + endif + if ( present(linoz_data_fixed_tod_out) ) then + linoz_data_fixed_tod_out = fixed_tod + endif + + endsubroutine linoz_data_defaultopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine linoz_data_adv( pbuf2d, state ) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : boltz ! J/K/molecule + use physics_buffer, only : physics_buffer_desc + + implicit none + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(in):: state(begchunk:endchunk) + + ! local vars + integer :: ind,c,ncol,i + real(r8) :: to_mmr(pcols,pver) + + if( .not. has_linoz_data ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! set the tracer fields with the correct units + do i = 1,number_flds + ind = index_map(i) + do c = begchunk,endchunk + ncol = state(c)%ncol + call outfld( fields(i)%fldnam, fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk ) + enddo + enddo + + end subroutine linoz_data_adv + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine init_linoz_data_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: piofile ! pio File pointer + + call init_trc_restart( 'linoz_data', piofile, file ) + + end subroutine init_linoz_data_restart +!------------------------------------------------------------------- + subroutine write_linoz_data_restart( PioFile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_T) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_linoz_data_restart + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine read_linoz_data_restart( PioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_T) :: piofile + + call read_trc_restart( 'linoz_data', piofile, file ) + + end subroutine read_linoz_data_restart + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + integer function get_ndx( name ) + + implicit none + character(len=*), intent(in) :: name + + integer :: i + + get_ndx = 0 + do i = 1,N_FLDS + if ( trim(name) == trim(fld_names(i)) ) then + get_ndx = i + return + endif + enddo + + end function get_ndx + +end module linoz_data diff --git a/src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 b/src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 new file mode 100644 index 0000000000..f66af99b38 --- /dev/null +++ b/src/chemistry/mozart/llnl_O1D_to_2OH_adj.F90 @@ -0,0 +1,85 @@ +!=========================================================================== +! Combine several reactions into one pseudo reaction to correct the +! photolysis rate J(O1D) to incorporate the effect of the other reactions. +! +! Creator: Philip Cameron-Smith +!=========================================================================== + +module llnl_O1D_to_2OH_adj + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: O1D_to_2OH_adj, O1D_to_2OH_adj_init + + integer :: jo1d_ndx + +contains +!=========================================================================== + +!=========================================================================== +!=========================================================================== + subroutine O1D_to_2OH_adj_init + use mo_chem_utls, only : get_rxt_ndx + use cam_logfile, only : iulog + use spmd_utils, only : masterproc + + implicit none + + jo1d_ndx = get_rxt_ndx( 'j2oh' ) + if (masterproc) then + write (iulog,*) 'O1D_to_2OH_adj_init: Found j2oh index in O1D_to_2OH_adj_init of ', jo1d_ndx + write (iulog,*) 'O1D_to_2OH_adj_init: O1D_to_2OH_adj is active' + endif + + end subroutine O1D_to_2OH_adj_init + +!=========================================================================== +!=========================================================================== + subroutine O1D_to_2OH_adj( p_rate, inv, m, ncol, tfld ) + + use chem_mods, only : nfs, phtcnt, rxntot, nfs !PJC added rxntot, nfs + use ppgrid, only : pcols, pver !PJC added pcols + use mo_setinv, only : n2_ndx, o2_ndx, h2o_ndx !PJC + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy arguments + !-------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: inv(ncol,pver,nfs) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: p_rate(ncol,pver,rxntot) + real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol) + real(r8) :: n2_rate(ncol,pver) + real(r8) :: o2_rate(ncol,pver) + real(r8) :: h2o_rate(ncol,pver) + + real(r8), parameter :: x1 = 2.15e-11_r8 + real(r8), parameter :: x2 = 3.30e-11_r8 + real(r8), parameter :: x3 = 1.63e-10_r8 + real(r8), parameter :: y1 = 110.0_r8 + real(r8), parameter :: y2 = 55.0_r8 + real(r8), parameter :: y3 = 60.0_r8 + + if (jo1d_ndx<1) return + + n2_rate(:,:) = x1 * Exp ( y1 / tfld(:ncol,:)) * inv(:,:,n2_ndx) + o2_rate(:,:) = x2 * Exp ( y2 / tfld(:ncol,:)) * inv(:,:,o2_ndx) + h2o_rate(:,:) = x3 * Exp ( y3 / tfld(:ncol,:)) * inv(:,:,h2o_ndx) + + p_rate(:,:,jo1d_ndx) = p_rate(:,:,jo1d_ndx) * & + (h2o_rate(:,:) / (h2o_rate(:,:) + n2_rate(:,:) + o2_rate(:,:))) + + end subroutine O1D_to_2OH_adj + +end module llnl_O1D_to_2OH_adj diff --git a/src/chemistry/mozart/m_sad_data.F90 b/src/chemistry/mozart/m_sad_data.F90 new file mode 100644 index 0000000000..ef748d3c42 --- /dev/null +++ b/src/chemistry/mozart/m_sad_data.F90 @@ -0,0 +1,53 @@ + + module m_sad_data + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + integer :: i, k + + save + + real(r8), dimension(5,22) :: a, b + +!---------------------------------------------------------------------- +! Water activities for the H2SO4/H2O system. +!---------------------------------------------------------------------- + data ((a(i,k), i = 1,5), k = 1,6) & + / 4.930600776_r8, -2.8124576227e2_r8, 3.617194350e4_r8, -7.3921080947e5_r8, -1.1640936469e8_r8, & + -1.6902946223e1_r8, 5.7843291724e3_r8, -1.2462848248e5_r8, 3.1325022591e7_r8, -2.2068275308e9_r8, & + -3.9722280419e1_r8, 1.2350607474e4_r8, -3.4299494505e5_r8, 6.2642389672e7_r8, -3.9706964493e9_r8, & + -5.5968384906e1_r8, 1.2922351288e4_r8, 1.3504086346e6_r8, -1.7890533860e8_r8, 8.8498119334e9_r8, & + -8.2938840352e1_r8, 2.2079294414e4_r8, 2.9469683691e5_r8, -3.1424855089e7_r8, 1.0884875646e9_r8, & + -1.0647596744e2_r8, 2.7525067463e4_r8, 4.2061852240e5_r8, -5.1877378665e7_r8, 2.2849838182e9_r8 / +!---------------------------------------------------------------------- +! Water activities for the HNO3/H2O system. +!---------------------------------------------------------------------- + data ((a(i,k), i = 1,5), k = 7,12) & + / 2.5757237579e-1_r8, 3.4615149493e3_r8, -1.1460419802e6_r8, 1.6003066569e8_r8, -8.2005020704e9_r8, & + -2.3081801501e1_r8, 9.7545732474e3_r8, -1.0751476647e6_r8, 1.2845681641e8_r8, -5.6387338050e9_r8, & + -1.1454916074e2_r8, 6.7557746435e4_r8, -1.5833469853e7_r8, 2.0068038322e9_r8, -9.5789893230e10_r8, & + -3.7614906671e2_r8, 2.5721043666e5_r8, -6.9093891724e7_r8, 8.8886258262e9_r8, -4.3013954256e11_r8, & + -1.1566205559e3_r8, 8.5657451707e5_r8, -2.4386088798e8_r8, 3.1789555772e10_r8, -1.5566652191e12_r8, & + -2.9858872606e3_r8, 2.2912842052e6_r8, -6.6825883931e8_r8, 8.7835101682e10_r8, -4.3330365673e12_r8 / +!---------------------------------------------------------------------- +! Ion activities for the H2SO4/H2O system. +!---------------------------------------------------------------------- + data ((b(i,k), i = 1,5) , k = 13,16) & + / -9.8727713620e1_r8, 1.5892180900_r8, -1.0611069051e-2_r8, 3.1437317659e-5_r8, -3.5694366687e-8_r8, & + 2.6972534510e1_r8, -4.1774114259e-1_r8, 2.7534704937e-3_r8, -8.0885350553e-6_r8, 9.0919984894e-9_r8, & + -3.1506575361_r8, 5.1477027299e-2_r8, -3.4697470359e-4_r8, 1.0511865215e-6_r8, -1.2167638793e-9_r8, & + 8.9194643751e-2_r8, -1.4398498884e-3_r8, 9.5874823381e-6_r8, -2.8832930837e-8_r8, 3.3199717594e-11_r8 / +!---------------------------------------------------------------------- +! Ion activities for the HNO3/H2O system. +!---------------------------------------------------------------------- + data ((b(i,k), i = 1,5) , k = 17,22) & + / -9.3085785070e-1_r8, 1.1200784716e-2_r8, -8.7594232370e-5_r8, 2.9290261722e-7_r8, -3.6297845637e-10_r8, & + -9.9276927926e+0_r8, 1.3861173987e-1_r8, -7.5302447966e-4_r8, 1.9053537417e-6_r8, -1.8847180104e-9_r8, & + 8.9976745608e-1_r8, -1.1682398549e-2_r8, 6.1056862242e-5_r8, -1.5087523503e-7_r8, 1.4643716979e-10_r8, & + -3.8389447725e-2_r8, 4.8922229154e-4_r8, -2.5494288719e-6_r8, 6.33063502160e-9_r8, -6.1901374001e-12_r8, & + 7.1911444008e-4_r8, -8.7957856299e-6_r8, 4.4035804399e-8_r8, -1.0509519536e-10_r8, 9.8591778862e-14_r8, & + -5.2736179784e-6_r8, 6.3762209490e-8_r8, -3.1557072358e-10_r8, 7.4508569217e-13_r8, -6.9083781268e-16_r8 / + + end module m_sad_data diff --git a/src/chemistry/mozart/mo_aero_settling.F90 b/src/chemistry/mozart/mo_aero_settling.F90 new file mode 100644 index 0000000000..8219d1c0f0 --- /dev/null +++ b/src/chemistry/mozart/mo_aero_settling.F90 @@ -0,0 +1,232 @@ + +!====================================================================== +! +! ROUTINE +! strat_aer_settling +! +! Date... +! 8 November 1999 +! +! Programmed by... +! Douglas E. Kinnison +! +! Modified for WACCM2 on 3 September 2004 - Removed ICE +! Modified for WACCM3 on 8 November 2004 - added NAT 7um mode. +! +! DESCRIPTION +! This routine vertically redistributes condensed phase HNO3. +! +! For each aerosol type the terminal velocity is calculated. This +! quantity is dependent on: 1) the mass density of the aerosol; +! 2) the radius; 3) the dynamic viscosity; 4) shape; and the Cunningham +! correction factor for spherical particles. See Fuchs, The Mechanics +! of Aerosols Oxford, Pergmann Press, pp 27-31, 1964 and Kasten, +! Falling Speed of Aerosol Particles, J. of Appl. Met., 7, 944-947, +! 1968 for details. For aerosol with a radius of 3 microns (e.g., NAT) +! and 10 microns (e.g., ICE) the terminal velocity (cm sec-1) is 0.2 +! and 1.7 respectively. +! +! The flux of condensed phase HNO3 is then derived using the +! following equation: +! Flux (molec cm-2 s-1) = V * C * exp (8*ln^2 sigma). +! +! where: V is terminal velocity (cm sec-1) +! C is condensed phase conc (molecules cm-3) +! sigma is the width of the log normal distribution. +! +! The approach of settling the entire aerosol size distribution is +! based on work of Considine et al., JGR, 1999. +! +! The routine is a straighforward approach, starting at the top zone +! (highest altitude) and progressing towards the surface. The gross +! settling of condensed phase HNO3 is simply the quanity: +! Flux * dt/dz. +! +! +! ARGUMENTS +! +! All of the following components are grid center quanitities. +! +! INPUT: +! ad Air Density (molecules cm-3) +! press Pressure (Pascals) +! timestep Gross chemistry timestep (in seconds) +! temp Temperature (K) +! hno3_cond Condensed phase HNO3 (mole fraction) +! radius_nat Mean radius of NAT (cm) +! zstar log pressure altitude coordinate (km) +! +! OUTPUT: +! hno3_cond vertically modified +! +!====================================================================== + + module mo_aero_settling + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: strat_aer_settling + public :: strat_aer_settl_init + + contains + + subroutine strat_aer_settl_init + + use cam_history, only : addfld + + implicit none + + call addfld( 'VEL_NAT1', (/ 'lev' /), 'I', 'cm/s', 'small nat settling velocity' ) + call addfld( 'VEL_NAT2', (/ 'lev' /), 'I', 'cm/s', 'large nat settling velocity' ) + + end subroutine strat_aer_settl_init + + + subroutine strat_aer_settling( ad, press, timestep, zstar, temp, & + hno3_cond, radius_nat, ncol, lchnk, aero_ndx ) + + use ppgrid, only : pcols, pver + use physconst, only : gravit + use cam_history, only : outfld + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: aero_ndx ! aerosol index + real(r8), intent(in) :: timestep ! model time step (s) + real(r8), intent(in) :: ad(ncol,pver) ! Air density (molecules cm-3) + real(r8), intent(in) :: radius_nat(ncol,pver) ! Mean radius of NAT (cm) + real(r8), intent(in) :: zstar(ncol,pver) ! altitude (km) + real(r8), intent(in) :: press(pcols,pver) ! Pressure (Pa) + real(r8), intent(in) :: temp(pcols,pver) ! temperature (K) + real(r8), intent(inout) :: hno3_cond(ncol,pver) ! Condensed Phase HNO3 (VMR) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: avo_num = 6.022e23_r8, & ! molecules/mole + MW_air = 28.8_r8, & ! grams/mole air + nat_dens = 1.6_r8, & ! g/cm^3 + shape_fac_nat = 1.0_r8, & ! TBD + sigma_nat = 1.6_r8, & ! Width of distribution + av_const = 2.117265e4_r8, & ! (8*8.31448*1000 / PI) + km2cm = 1.e5_r8, & ! km to cm + m2cm = 1.e2_r8, & ! m to cm + c1 = 2._r8/9._r8 + + integer :: i, k, kp1 + real(r8) :: gravity ! gravity cm/s^2 + real(r8) :: Cc_nat ! Cunningham Correction Factor + real(r8) :: dt_dz ! dt / dz, sec cm-1 + real(r8) :: flux_nat ! aerosol flux, molec cm-2 sec-1 + real(r8) :: mean_vel ! mean velocity, cm sec-1 + real(r8) :: mfp ! Mean Free Path + real(r8) :: vel_nat ! Terminal velocity (cm sec-1) + real(r8) :: rad_nat ! wrk radius nat (cm) + real(r8) :: visc ! Dynamic viscosity of air + real(r8) :: depos ! molecules/cm**3 deposited + real(r8) :: atm_dens, atm_densa ! total atm density and inverse + real(r8) :: cond_hno3 ! wrk variables + real(r8) :: const_nat ! wrk variables + real(r8) :: t ! working temperatue + real(r8) :: velnat(ncol,pver) ! holding variable for output + logical :: lon_mask(ncol) ! longitude logic mask + + gravity = gravit*m2cm ! (cm/s^2) + + const_nat = exp( 8._r8*(log(sigma_nat))**2 ) + do k = 1,pver + velnat(:,k) = 0._r8 + end do + + +!---------------------------------------------------------------------- +! ... derive Aerosol Settling (explicit approach) +!---------------------------------------------------------------------- +Level_loop : & + do k = 2,pver-1 +!---------------------------------------------------------------------- +! ... operate between 2.0hPa and 300hPa and only where nat exist +!---------------------------------------------------------------------- + kp1 = k + 1 + lon_mask(:) = press(:ncol,k) >= 2.e2_r8 .and. press(:ncol,k) <= 300.e2_r8 & + .and. (radius_nat(:,k) > 0._r8 ) + if( any( lon_mask(:) ) ) then +Column_loop : & + do i = 1,ncol + if( lon_mask(i) ) then + t = temp(i,k) +!---------------------------------------------------------------------- +! ... General Setup for NAT +! Calculate the settling of the NAT Aerosol +! NOTE: Index "k" is the box that is being calculated +! Index "k-1" is flux from above into the k box +! A positive NET {flux*dt/dz} adds to the "k" box +!---------------------------------------------------------------------- +! ... mean Molecular Velocity, cm sec-1 +!---------------------------------------------------------------------- + mean_vel = sqrt( av_const*t/MW_air )*100._r8 +!---------------------------------------------------------------------- +! ... dynamic Viscosity, g cm-1 sec-1 +!---------------------------------------------------------------------- + visc = (t*1.458e-6_r8)**1.5_r8 /(t + 110.4_r8)*10000._r8 +!---------------------------------------------------------------------- +! ... mean Free Path, cm +!---------------------------------------------------------------------- + atm_dens = ad(i,k) + atm_densa = 1._r8/atm_dens + mfp = visc* avo_num / (.499_r8*atm_dens*MW_air*mean_vel) +!---------------------------------------------------------------------- +! ... dt / dz, sec cm-1; NOTE: zstar is in km +!---------------------------------------------------------------------- + dt_dz = timestep / ((zstar(i,k-1) - zstar(i,k))*km2cm) +!---------------------------------------------------------------------- +! ... calculate NAT Aerosol Settling +!---------------------------------------------------------------------- + rad_nat = radius_nat(i,k) + cond_hno3 = hno3_cond(i,k)*atm_dens +!---------------------------------------------------------------------- +! ... Cunningham Correction Factor, Unitless +!---------------------------------------------------------------------- + Cc_nat = 1._r8 + (mfp/rad_nat)*(1.246_r8 + .42_r8*exp( -.87_r8*rad_nat/mfp )) +!---------------------------------------------------------------------- +! ... terminal Velocity of Aerosol, cm sec-1 +!---------------------------------------------------------------------- + vel_nat = c1*rad_nat**2 * nat_dens*gravity*Cc_nat/visc*shape_fac_nat + velnat(i,k) = vel_nat +!---------------------------------------------------------------------- +! ... aerosol Flux, Cond-phase molecules cm-2 sec-1 +!---------------------------------------------------------------------- + flux_nat = cond_hno3*vel_nat* const_nat +!---------------------------------------------------------------------- +! ... calculate NAT Aerosol Settling (i.e., HNO3 redistribution) +!---------------------------------------------------------------------- + depos = min( cond_hno3,flux_nat*dt_dz ) +!---------------------------------------------------------------------- +! ... modify the HNO3_cond in level "k" +!---------------------------------------------------------------------- + hno3_cond(i,k) = (cond_hno3 - depos)*atm_densa +!---------------------------------------------------------------------- +! ... modify the HNO3_cond in level "k+1" +!---------------------------------------------------------------------- + hno3_cond(i,kp1) = hno3_cond(i,kp1) + depos/ad(i,kp1) + end if + end do Column_loop + end if + end do Level_loop + +!---------------------------------------------------------------------- +! ... output nat velocity +!---------------------------------------------------------------------- + if( aero_ndx == 1 ) then + call outfld( 'VEL_NAT1', velnat, ncol, lchnk ) + else if( aero_ndx == 2 ) then + call outfld( 'VEL_NAT2', velnat, ncol, lchnk ) + end if + + end subroutine strat_aer_settling + + end module mo_aero_settling diff --git a/src/chemistry/mozart/mo_airglow.F90 b/src/chemistry/mozart/mo_airglow.F90 new file mode 100644 index 0000000000..91d934a6ff --- /dev/null +++ b/src/chemistry/mozart/mo_airglow.F90 @@ -0,0 +1,104 @@ + + module mo_airglow + + use shr_kind_mod, only : r8 => shr_kind_r8 + use physconst, only : avogad + use cam_abortutils, only : endrun + + implicit none + + save + + integer , parameter :: nag = 3 + real(r8), parameter :: secpday = 86400._r8 + real(r8), parameter :: daypsec = 1._r8/secpday + real(r8), parameter :: hc = 6.62608e-34_r8*2.9979e8_r8/1.e-9_r8 + real(r8), parameter :: wc_o2_1s = 1._r8/762._r8 + real(r8), parameter :: wc_o2_1d = 1._r8/1270._r8 + real(r8), parameter :: wc_o1d = 1._r8/630._r8 + + integer :: rid_ag1, rid_ag2, rid_ag3 + logical :: has_airglow + + private + public :: airglow, init_airglow + + contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine init_airglow + use mo_chem_utls, only : get_rxt_ndx + use cam_history, only : addfld + use ppgrid, only : pver + + implicit none + + rid_ag1 = get_rxt_ndx( 'ag1' ) + rid_ag2 = get_rxt_ndx( 'ag2' ) + rid_ag3 = get_rxt_ndx( 'ag3' ) + + has_airglow = rid_ag1 > 0 .and. rid_ag2 > 0 .and. rid_ag3 > 0 + + if (.not. has_airglow) return + + call addfld( 'AIRGLW1', (/ 'lev' /), 'I', 'K/s', 'O2_1D -> O2 + 1.27 micron airglow loss' ) + call addfld( 'AIRGLW2', (/ 'lev' /), 'I', 'K/s', 'O2_1S -> O2 + 762nm airglow loss' ) + call addfld( 'AIRGLW3', (/ 'lev' /), 'I', 'K/s', 'O1D -> O + 630 nm airglow loss' ) + call addfld( 'AIRGLWTOT', (/ 'lev' /), 'I', 'K/s', 'airglow total loss' ) + + endsubroutine init_airglow + + subroutine airglow( ag_tot, o2_1s, o2_1d, o1d, rxt, cp, & + ncol, lchnk ) +!----------------------------------------------------------------------- +! ... forms the airglow heating rates +!----------------------------------------------------------------------- + + use chem_mods, only : rxntot + use ppgrid, only : pver + use cam_history, only : outfld + use mo_constants, only : avo => avogadro + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: rxt(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: o2_1s(ncol,pver) ! concentration (mol/mol) + real(r8), intent(in) :: o2_1d(ncol,pver) ! concentration (mol/mol) + real(r8), intent(in) :: o1d(ncol,pver) ! concentration (mol/mol) + real(r8), intent(in) :: cp(ncol,pver) ! specific heat capacity + real(r8), intent(out) :: ag_tot(ncol,pver) ! airglow total heating rate (K/s) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + real(r8) :: tmp(ncol) + real(r8) :: ag_rate(ncol,pver,nag) + + if (.not. has_airglow) return + + do k = 1,pver + tmp(:) = hc * avo / cp(:,k) + ag_rate(:,k,1) = tmp(:)*rxt(:,k,rid_ag1)*o2_1d(:,k)*wc_o2_1d + ag_rate(:,k,2) = tmp(:)*rxt(:,k,rid_ag2)*o2_1s(:,k)*wc_o2_1s + ag_rate(:,k,3) = tmp(:)*rxt(:,k,rid_ag3)*o1d(:,k)*wc_o1d + ag_tot(:,k) = ag_rate(:,k,1) + ag_rate(:,k,2) + ag_rate(:,k,3) + end do + +!----------------------------------------------------------------------- +! ... output the rates +!----------------------------------------------------------------------- + call outfld( 'AIRGLW1', ag_rate(:,:,1), ncol, lchnk ) + call outfld( 'AIRGLW2', ag_rate(:,:,2), ncol, lchnk ) + call outfld( 'AIRGLW3', ag_rate(:,:,3), ncol, lchnk ) + call outfld( 'AIRGLWTOT', ag_tot, ncol, lchnk ) + + end subroutine airglow + + end module mo_airglow diff --git a/src/chemistry/mozart/mo_airmas.F90 b/src/chemistry/mozart/mo_airmas.F90 new file mode 100644 index 0000000000..e75f0544be --- /dev/null +++ b/src/chemistry/mozart/mo_airmas.F90 @@ -0,0 +1,94 @@ + module mo_airmas + + private + public :: airmas + + contains + + subroutine airmas( z, zen, dsdh, nid, cz, & + vcol, scol ) +!----------------------------------------------------------------------------- +! purpose: +! calculate vertical and slant air columns, in spherical geometry, as a +! function of altitude. +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real, specified altitude working grid (km) (i) +! zen - real, solar zenith angle (degrees) (i) +! dsdh - real, slant path of direct beam through each layer crossed (o) +! when travelling from the top of the atmosphere to layer i; +! dsdh(i,j), i = 0..nz-1, j = 1..nz-1 +! nid - integer, number of layers crossed by the direct beam when (o) +! travelling from the top of the atmosphere to layer i; +! nid(i), i = 0..nz-1 +! vcol - real, output, vertical air column, molec cm-2, above level iz +! scol - real, output, slant air column in direction of sun, above iz +! also in molec cm-2 +!----------------------------------------------------------------------------- + + use mo_params, only : largest + use ppgrid, only : pverp, pver + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nid(0:pver) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: zen + real(r8), intent(in) :: dsdh(0:pver,pver) + real(r8), intent(in) :: cz(pverp) + real(r8), intent(out) :: vcol(pverp) + real(r8), intent(out) :: scol(pverp) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: id, j + real(r8) :: sum, ssum, vsum, ratio + +!----------------------------------------------------------------------------- +! ... calculate vertical and slant column from each level: work downward +!----------------------------------------------------------------------------- + vsum = 0._r8 + ssum = 0._r8 + do id = 1,pver + vsum = vsum + cz(pverp-id) + vcol(pverp-id) = vsum + sum = 0._r8 + if( nid(id) < 0 ) then + sum = largest + else +!----------------------------------------------------------------------------- +! ... single pass layers: +!----------------------------------------------------------------------------- + do j = 1,min( nid(id),id ) + sum = sum + cz(pverp-j)*dsdh(id,j) + end do +!----------------------------------------------------------------------------- +! ... double pass layers: +!----------------------------------------------------------------------------- + do j = min( nid(id),id )+1,nid(id) + sum = sum + 2._r8*cz(pverp-j)*dsdh(id,j) + end do + end if + scol(pverp - id) = sum + end do + +!----------------------------------------------------------------------------- +! ... special section to set scol(pverp) +!----------------------------------------------------------------------------- + if( scol(pver-1) /= 0._r8 ) then + ratio = scol(pver)/scol(pver-1) + scol(pverp) = ratio * scol(pver) + else + scol(pverp) = 0._r8 + end if + + end subroutine airmas + + end module mo_airmas diff --git a/src/chemistry/mozart/mo_airplane.F90 b/src/chemistry/mozart/mo_airplane.F90 new file mode 100644 index 0000000000..5c4a9a3369 --- /dev/null +++ b/src/chemistry/mozart/mo_airplane.F90 @@ -0,0 +1,350 @@ +module mo_airplane + !-------------------------------------------------------------------- + ! ... Airplane insitu emission sources + !-------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use pio, only : pio_inq_dimid, pio_inq_dimlen, pio_get_var, & + file_desc_t, var_desc_t, pio_inq_vardimid, pio_inq_varndims, pio_nowrite, & + pio_inq_varid, pio_closefile + + use cam_pio_utils, only : cam_pio_openfile + use cam_logfile, only : iulog + implicit none + + private + + save + + real(r8), allocatable :: & + pno(:,:,:), & + pco(:,:,:), & + air_altitude(:) + public :: airpl_set, airpl_src + + + + logical :: has_airpl_src = .false. + +contains + + subroutine airpl_set( lchnk, ncol, no_ndx, co_ndx, xno_ndx, cldtop, zint_abs, extfrc) + use ppgrid, only : pver + use cam_history, only : outfld + + implicit none + integer, intent(in) :: lchnk, ncol, no_ndx, co_ndx, xno_ndx + real(r8), intent(in) :: cldtop(:), zint_abs(:,:) + real(r8), intent(inout) :: extfrc(:,:,:) + + +! Local Variables + real(r8), dimension(ncol,pver) :: no_air, co_air + real(r8) :: ztab_top, ztab_bot, zdel, zdeli, frac, zlev_top, zlev_bot + integer :: nlev + integer :: cldind, kk, i, k + + no_air(:,:) = 0._r8 + co_air(:,:) = 0._r8 + + if(has_airpl_src) then + !--------------------------------------------------------------------- + ! ... Add the airplane emissions; must do vertical interpolation + !--------------------------------------------------------------------- + ztab_top = maxval( air_altitude ) + ztab_bot = minval( air_altitude ) + nlev = size(air_altitude) - 1 + + !--------------------------------------------------------------------- + ! ... add the airplane emissions; must do vertical interpolation + ! Note: the interpolation code is conserving and assumes the + ! aircraft emission vertical grid is uniform with a + ! one kilometer spacing + !--------------------------------------------------------------------- + level_loop : do k = 1,pver + long_loop : do i = 1,ncol + zlev_top = zint_abs(i,k) ! altitude at top of model level (km) + zlev_bot = zint_abs(i,k+1) ! altitude at bottom of model level (km) + zdel = (zlev_top - zlev_bot) * 1.e5_r8 ! model level thickness (cm) + zdeli = 1._r8/zdel + if( zlev_bot <= ztab_top .and. zlev_top >= ztab_bot ) then + do kk = 1,nlev + if( zlev_bot <= air_altitude(kk+1) .and. zlev_top >= air_altitude(kk) ) then + frac = (min( zlev_top, air_altitude(kk+1) ) - max( zlev_bot, air_altitude(kk) )) & + /(air_altitude(kk+1) - air_altitude(kk)) ! *del_alti(kk) + if( no_ndx > 0 ) then + extfrc(i,k,no_ndx) = extfrc(i,k,no_ndx) + frac * pno(i,kk,lchnk) * zdeli + no_air(i,k) = frac * pno(i,kk,lchnk) * zdeli + end if + if( xno_ndx > 0 ) then + extfrc(i,k,xno_ndx) = extfrc(i,k,xno_ndx) + frac * pno(i,kk,lchnk) * zdeli + end if + if( co_ndx > 0 ) then + extfrc(i,k,co_ndx) = extfrc(i,k,co_ndx) + frac * pco(i,kk,lchnk) * zdeli + co_air(i,k) = frac * pco(i,kk,lchnk) * zdeli + end if + end if + end do + end if + if( k == pver ) then + do kk = 1,nlev + if( zlev_bot > air_altitude(kk) ) then + frac = (min( zlev_bot, air_altitude(kk+1) ) - air_altitude(kk)) & + /(air_altitude(kk+1) - air_altitude(kk)) ! *del_alti(kk) + if( no_ndx > 0 ) then + extfrc(i,k,no_ndx) = extfrc(i,k,no_ndx) + frac * pno(i,kk,lchnk) * zdeli + no_air(i,k) = frac * pno(i,kk,lchnk) * zdeli + end if + if( xno_ndx > 0 ) then + extfrc(i,k,xno_ndx) = extfrc(i,k,xno_ndx) + frac * pno(i,kk,lchnk) * zdeli + end if + if( co_ndx > 0 ) then + extfrc(i,k,co_ndx) = extfrc(i,k,co_ndx) + frac * pco(i,kk,lchnk) * zdeli + co_air(i,k) = frac * pco(i,kk,lchnk) * zdeli + end if + else + exit + end if + end do + end if + end do long_loop + end do level_loop + + end if + call outfld( 'NO_Aircraft', no_air(:ncol,:), ncol, lchnk ) + call outfld( 'CO_Aircraft', co_air(:ncol,:), ncol, lchnk ) + + end subroutine airpl_set + + + subroutine airpl_src( airpl_emis_file ) + !----------------------------------------------------------------------- + ! ... Initialize airplane emissions + ! Note: The emissions are read in in units of molecules/cm**2/s + ! on a vertically resolved grid. + ! Conversion to units of molec/cm**3/s is done in SETEXT + !----------------------------------------------------------------------- + use spmd_utils, only : masterproc + use interpolate_data, only : lininterp_init, lininterp, lininterp_finish, & + interp_type + use chem_mods, only : adv_mass + use ioFileMod, only : getfil + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p, ngcols_p + use ppgrid, only : begchunk, endchunk, pcols + use mo_constants, only : pi, d2r, rearth + use gmean_mod, only : gmean + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------------- + character(len=*), intent(in) :: airpl_emis_file + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + real(r8), parameter :: msq2cmsq = 1.e4_r8, zero=0._r8, twopi=2._r8*pi + integer :: ios, k, j + integer :: nlat, nlon, nlev, ndims + integer :: ierr + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + integer :: dimid_lat, dimid_lon, dimid_lev + integer :: dimid(3) + real(r8), allocatable :: lat(:), lon(:) + real(r8), allocatable :: pno_in(:,:,:), pco_in(:,:,:) + real(r8) :: total(2), tmp + real(r8) :: factor + character(len=256) :: locfn + integer :: co_ndx, no_ndx + type(interp_type) :: lon_wgts, lat_wgts + real(r8) :: to_lats(pcols), to_lons(pcols) + integer :: ncols, c + + co_ndx = get_extfrc_ndx('CO') + no_ndx = get_extfrc_ndx('NO') + + if ( co_ndx < 0 .and. no_ndx < 0 ) then + if( masterproc ) then + write(iulog,*) 'airpl_src: NO and CO do not have external source --> no aircraft sources will be applied' + endif + return + endif + + if ( len_trim(airpl_emis_file) == 0 ) then + return + endif + + has_airpl_src = .true. + + co_ndx = get_spc_ndx('CO') + no_ndx = get_spc_ndx('NO') + + + !----------------------------------------------------------------------- + ! ... Open NetCDF file + !----------------------------------------------------------------------- + call getfil (airpl_emis_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + + !----------------------------------------------------------------------- + ! ... Get grid dimensions from file + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) + allocate( lat(nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: lat allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( piofile, 'lat', vid ) + ierr = pio_get_var( piofile, vid, lat ) + lat(:nlat) = lat(:nlat) * d2r + + ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) + ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) + allocate( lon(nlon), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: lon allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( piofile, 'lon', vid ) + ierr = pio_get_var( piofile, vid, lon ) + lon(:nlon) = lon(:nlon) * d2r + + ierr = pio_inq_dimid( piofile, 'altitude', dimid_lev ) + ierr = pio_inq_dimlen( piofile, dimid_lev, nlev ) + allocate( air_altitude(nlev+1), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: air_altitude allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( piofile, 'altitude', vid ) + ierr = pio_get_var( piofile, vid, air_altitude(1:nlev) ) + air_altitude(nlev+1) = air_altitude(nlev) + (air_altitude(nlev) - air_altitude(nlev-1)) + + !----------------------------------------------------------------------- + ! ... Set up regridding + !----------------------------------------------------------------------- + + allocate( pno_in(nlon,nlat,nlev), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: pno_in allocation error = ',ierr + call endrun + end if + allocate( pco_in(nlon,nlat,nlev), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: pco_in allocation error = ',ierr + call endrun + end if + allocate(pno(pcols,nlev,begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: pno allocation error = ',ierr + call endrun + end if + allocate( pco(pcols,nlev,begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: pco allocation error = ',ierr + call endrun + end if + + !----------------------------------------------------------------------- + ! ... Read emissions + !----------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'nox', vid ) + ierr = pio_inq_varndims( piofile, vid, ndims ) + if( ndims /= 3 ) then + write(iulog,*) 'airpl_src: variable nox has ndims = ',ndims,', expecting 3' + call endrun + end if + ierr = pio_inq_vardimid( piofile, vid, dimid ) + if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. dimid(3) /= dimid_lev ) then + write(iulog,*) 'airpl_src: Dimensions in wrong order for variable nox' + write(iulog,*) '... Expecting (lon, lat, lev)' + call endrun + end if + ierr = pio_get_var( piofile, vid, & + (/ 1, 1, 1/), & ! start + (/ nlon, nlat, nlev /), & ! count + pno_in ) + + ierr = pio_inq_varid( piofile, 'co', vid ) + ierr = pio_inq_varndims( piofile, vid, ndims ) + + if( ndims /= 3 ) then + write(iulog,*) 'READ_SFLX: variable co has ndims = ',ndims,', expecting 3' + call endrun + end if + ierr = pio_inq_vardimid( piofile, vid, dimid ) + if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. dimid(3) /= dimid_lev ) then + write(iulog,*) 'airpl_src: Dimensions in wrong order for variable co' + write(iulog,*) '... Expecting (lon, lat, lev)' + call endrun + end if + ierr = pio_get_var( piofile, vid, & + (/ 1, 1, 1/), & ! start + (/ nlon, nlat, nlev /), & ! count + pco_in ) + call pio_closefile( piofile ) + + !----------------------------------------------------------------------- + ! ... Regrid emissions + !----------------------------------------------------------------------- + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + call lininterp_init(lon, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(lat, nlat, to_lats, ncols, 1, lat_wgts) + + do k = 1,nlev + call lininterp(pno_in(:,:,k), nlon, nlat, pno(:,k,c), ncols, lon_wgts, lat_wgts) + call lininterp(pco_in(:,:,k), nlon, nlat, pco(:,k,c), ncols, lon_wgts, lat_wgts) + enddo + call lininterp_finish(lon_wgts) + call lininterp_finish(lat_wgts) + enddo + + deallocate( pno_in, pco_in, lon, lat, stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'airpl_src: Failed to deallocate pno_in,pco_in; ierr = ',ierr + call endrun + end if + !----------------------------------------------------------------------- + ! ... Get global emission from this source + !----------------------------------------------------------------------- + total = zero + do k=1,nlev + call gmean(pno(:,k,:), tmp) + total(1)= total(1)+tmp + call gmean(pco(:,k,:), tmp) + total(2)= total(2)+tmp + end do + + if(masterproc) then + + factor = 86400._r8 * 365._r8 & ! sec / year + / 6.022e23_r8 & ! molec / mole + * 1.e-12_r8 & ! Tg / g + * msq2cmsq & ! meters**2 to cm**2 + * 4._r8*pi*rearth*rearth ! global mean to global total + + write(iulog,*) 'airpl_src: nlev = ',nlev + !----------------------------------------------------------------------- + ! ... Convert totals from molec cm^-2 s^-1 to Tg y^-1 + !----------------------------------------------------------------------- + if (no_ndx .gt. 0) then + total(1) = total(1) * adv_mass(no_ndx) * factor + write(iulog,'('' airpl_src Aircraft emissions: '',a6,'' = '',f10.3,1X,a6)') 'NO',total(1),'TgN/y' + endif + if (co_ndx .gt. 0) then + total(2) = total(2) * adv_mass(co_ndx) * factor + write(iulog,'('' airpl_src Aircraft emissions: '',a6,'' = '',f10.3,1X,a6)') 'CO',total(2),'Tg/y' + endif + end if + + end subroutine airpl_src + +end module mo_airplane diff --git a/src/chemistry/mozart/mo_apex.F90 b/src/chemistry/mozart/mo_apex.F90 new file mode 100644 index 0000000000..b38d26df4f --- /dev/null +++ b/src/chemistry/mozart/mo_apex.F90 @@ -0,0 +1,400 @@ +module mo_apex + +!------------------------------------------------------------------------------- +! Purpose: +! +! Calculate apex coordinates and magnetic field magnitudes +! at global geographic grid for year of current model run. +! +! Method: +! +! The magnetic field parameters output by this module are time and height +! independent. They are chunked for waccm physics, i.e., allocated as +! (pcols,begchunk:endchunk) +! Interface sub apexmag is called once per run from sub inti. +! Sub apexmag may be called for years 1900 through 2005. +! This module is dependent on routines in apex_subs.F (modified IGRF model). +! Apex_subs has several authors, but has been modified and maintained +! in recent years by Roy Barnes (bozo@ucar.edu). +! Subs apxmka and apxmall are called with the current lat x lon grid +! resolution. +! +! Author: Ben Foster, foster@ucar.edu (Nov, 2003) +!------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, begchunk, endchunk ! physics grid + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use apex, only: apex_mka, apex_mall, apex_dypol, apex_set_igrf + use apex, only: apex_beg_yr, apex_end_yr + implicit none + + private + public :: mo_apex_readnl + public :: mo_apex_init + public :: mo_apex_init1 + public :: alatm, alonm, bnorth, beast, bdown, bmag + public :: d1vec, d2vec, colatp, elonp + public :: maglon0 ! geographic longitude at the equator where geomagnetic longitude is zero (radians) + + ! year to initialize apex + real(r8), public, protected :: geomag_year = -1._r8 + logical, public, protected :: geomag_year_updated = .true. + + integer :: fixed_geomag_year = -1 + +!------------------------------------------------------------------------------- +! Magnetic field output arrays, chunked for physics: +! (these are allocated (pcols,begchunk:endchunk) by sub allocate_arrays) +!------------------------------------------------------------------------------- + real(r8), protected, allocatable, dimension(:,:) :: & ! (pcols,begchunk:endchunk) + alatm, & ! apex mag latitude at each geographic grid point (radians) + alonm, & ! apex mag longitude at each geographic grid point (radians) + bnorth, & ! northward component of magnetic field + beast, & ! eastward component of magnetic field + bdown, & ! downward component of magnetic field + bmag ! magnitude of magnetic field + real(r8), protected, allocatable, dimension(:,:,:) :: & ! (3,pcols,begchunk:endchunk) + d1vec, & ! base vectors more-or-less magnetic eastward direction + d2vec ! base vectors more-or-less magnetic downward/equatorward direction + real(r8), protected :: & + colatp, & ! geocentric colatitude of geomagnetic dipole north pole (deg) + elonp ! East longitude of geomagnetic dipole north pole (deg) + + real(r8), protected :: maglon0 + + character(len=256) :: igrf_geomag_coefs_file = 'igrf_geomag_coefs_file' + +contains + +!====================================================================== +!====================================================================== +subroutine mo_apex_readnl(nlfile) + + use namelist_utils, only : find_group_name + use units, only : getunit, freeunit + use spmd_utils, only : mpicom, masterprocid, mpi_integer, mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'mo_apex_readnl' + + namelist /geomag_nl/ fixed_geomag_year, igrf_geomag_coefs_file + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'geomag_nl', status=ierr) + if (ierr == 0) then + read(unitn, geomag_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(fixed_geomag_year, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(igrf_geomag_coefs_file, len(igrf_geomag_coefs_file), mpi_character, masterprocid, mpicom, ierr) + +end subroutine mo_apex_readnl + +!====================================================================== +!====================================================================== +subroutine mo_apex_init1() + use time_manager, only: get_curr_date + use dyn_grid, only: get_horiz_grid_dim_d + + integer :: i, j, ist ! indices + + integer :: nglats + integer :: nglons + integer, parameter :: ngalts = 2 ! number of altitudes + + real(r8), allocatable :: gridlats(:) + real(r8), allocatable :: gridlons(:) + real(r8) :: gridalts(ngalts) ! altitudes passed to apxmka + + integer :: ngcols, hdim1_d, hdim2_d + integer :: yr, mon, day, sec + + ! read the IGRF coefs from file + call apex_set_igrf( igrf_geomag_coefs_file ) + + if (fixed_geomag_year>0) then + yr = fixed_geomag_year + else + call get_curr_date(yr, mon, day, sec) + end if + + if ( yr < apex_beg_yr ) yr = apex_beg_yr + if ( yr > apex_end_yr-1 ) yr = apex_end_yr-1 + + if (.not.(yr > geomag_year)) then + geomag_year_updated = .false. + return + else + geomag_year_updated = .true. + endif + + geomag_year = dble(yr)+0.5_r8 + +!------------------------------------------------------------------------------- +! Center min, max altitudes about 130 km +!------------------------------------------------------------------------------- + gridalts(:ngalts) = (/ 90._r8, 170._r8 /) + +!------------------------------------------------------------------------------- +! Initialize APEX with a regular lat/lon grid ... +! (Note apex_mka expects longitudes in -180 -> +180) +!------------------------------------------------------------------------------- + call get_horiz_grid_dim_d(hdim1_d,hdim2_d) + ngcols = hdim1_d*hdim2_d + if ( ngcols < 1000 ) then ! 10-degrees + nglats = 19 + nglons = 37 + elseif ( ngcols < 10000 ) then ! 5-degrees + nglats = 37 + nglons = 73 + elseif ( ngcols < 20000 ) then ! 2-degree + nglats = 91 + nglons = 181 + elseif ( ngcols < 100000 ) then ! 1-degree + nglats = 181 + nglons = 361 + else ! half-degee + nglats = 361 + nglons = 721 + endif + + allocate ( gridlats(nglats), gridlons(nglons) ) + do i = 1,nglons + gridlons(i) = -180._r8 + dble(i-1)*360._r8/(nglons-1) + enddo + do j = 1,nglats + gridlats(j) = -90._r8 + dble(j-1)*180._r8/(nglats-1) + enddo + + call apex_mka( geomag_year, gridlats, gridlons, gridalts, & + nglats, nglons, ngalts, ist ) + + if( ist /= 0 ) then + write(iulog,"(/,'>>> mo_apex_init: Error from apxmka: ist=',i5)") ist + call endrun("mo_apex_init: Error from apxmka") + end if + + deallocate( gridlats, gridlons ) + + if (masterproc) then + if (fixed_geomag_year<1) then + write(iulog, "('mo_apex_init: model yr,mon,day,sec ',4i6)") yr, mon, day, sec + endif + write(iulog, "('mo_apex_init: nglons,nglats ', 2i6)") nglons, nglats + endif + +end subroutine mo_apex_init1 + +!====================================================================== +!====================================================================== +subroutine mo_apex_init(phys_state) +!------------------------------------------------------------------------------- +! Driver for apex code to calculate apex magnetic coordinates at +! current geographic spatial resolution for given year. This calls +! routines in apex_subs.F. +! +! This is called once per run from sub inti. +!------------------------------------------------------------------------------- + + use physconst,only : pi + use physics_types, only: physics_state + use epp_ionization,only: epp_ionization_setmag + + ! Input/output arguments + type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state + +!------------------------------------------------------------------------------- +! Local variables +!------------------------------------------------------------------------------- + real(r8), parameter :: re = 6.378165e8_r8 ! earth radius (cm) + real(r8), parameter :: h0 = 9.0e6_r8 ! base height (90 km) + real(r8), parameter :: hs = 1.3e7_r8 + real(r8), parameter :: eps = 1.e-6_r8 ! epsilon + real(r8), parameter :: cm2km = 1.e-5_r8 + + integer :: c, i, ist ! indices + integer :: ncol + + real(r8) :: alt, hr, alon, alat, & ! apxmall args + vmp, w, d, be3, sim, xlatqd, f, si, collat, collon + +!------------------------------------------------------------------------------- +! Non-scalar arguments returned by APXMALL: +!------------------------------------------------------------------------------- + real(r8) :: bhat(3) + real(r8) :: d3(3) + real(r8) :: e1(3), e2(3), e3(3) + real(r8) :: f1(2), f2(2) + + real(r8) :: bg(3), d1g(3), d2g(3), bmg + + real(r8) :: rdum + + real(r8) :: maglat(pcols,begchunk:endchunk) + + real(r8), parameter :: rtd = 180._r8/pi ! radians to degrees + real(r8), parameter :: dtr = pi/180._r8 ! degrees to radians + + call mo_apex_init1() + if ((.not.geomag_year_updated) .and. (allocated(alatm))) return + +!------------------------------------------------------------------------------- +! Allocate output arrays +!------------------------------------------------------------------------------- + call allocate_arrays() + + alt = hs*cm2km ! altitude for apxmall (km) + hr = alt ! reference altitude (km) + +!------------------------------------------------------------------------------ +! Apex coords alon, alat are returned for each geographic grid point: +! first form global arrays +!------------------------------------------------------------------------------ + do c = begchunk, endchunk + ncol = phys_state(c)%ncol + do i = 1,ncol + collat = phys_state(c)%lat(i)*rtd ! latitude of current column (deg) + collon = phys_state(c)%lon(i)*rtd ! latitude of current column (deg) + if ( collon < -180._r8 ) collon = collon+360._r8 + if ( collon > 180._r8 ) collon = collon-360._r8 + call apex_mall( & + collat, collon, alt, hr, & ! Inputs + bg, bhat, bmag(i,c), si, & ! Mag Fld + alon, alat, & ! Apex lon,lat output + vmp, w, d, be3, sim, d1vec(:,i,c), d2vec(:,i,c), d3, e1, e2, e3, & ! Mod Apex + xlatqd, f, f1, f2, ist ) ! Qsi-Dpl + if( ist /= 0 ) then + write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist + call endrun('mo_apex_init: Error from apxmall') + end if + beast (i,c) = bg(1) + bnorth(i,c) = bg(2) + bdown (i,c) = -bg(3) + alonm (i,c) = alon*dtr ! mag lons (radians) + alatm (i,c) = alat*dtr ! mag lats (radians) + maglat(i,c) = alat ! mag lats (degrees) + enddo + enddo + + ! find geograghic latitude ( maglon0 ) where the geomagnetic latitude is zero at the equator + ! by first extracting the geographic coordinates at zero degrees longitude ... + collat = 0._r8 + collon = 0._r8 + call apex_mall( & + collat, collon, alt, hr, & ! Inputs + bg, bhat, bmg, si, & ! Mag Fld + alon, alat, & ! Apex lon,lat output + vmp, w, d, be3, sim, d1g, d2g, d3, e1, e2, e3, & ! Mod Apex + xlatqd, f, f1, f2, ist ) ! Qsi-Dpl + + if( ist /= 0 ) then + write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist + call endrun('mo_apex_init: Error from apxmall') + end if + + maglon0 = -alon*dtr ! (radians) geograghic latitude where the geomagnetic latitude is zero + ! where longitude ranges from -180E to 180E + + call apex_dypol( colatp, elonp, rdum ) ! get geomagnetic dipole north pole + + if (masterproc) then + write(iulog, "('mo_apex_init: colatp,elonp ', 2f12.6)") colatp, elonp + write(iulog, "('mo_apex_init: Calculated apex magnetic coordinates for year AD ',f8.2)") geomag_year + endif + + call epp_ionization_setmag(maglat) + +end subroutine mo_apex_init + +subroutine allocate_arrays +!------------------------------------------------------------------------------ +! Allocate module output arrays for chunked physics grid. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! local variables +!------------------------------------------------------------------------------ + integer :: istat ! status of allocate statements + + if (.not.allocated(alatm)) then + allocate(alatm(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of alatm failed: istat=',i5)") istat + call endrun + end if + end if + + if (.not.allocated(alonm)) then + allocate(alonm(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of alonm failed: istat=',i5)") istat + call endrun + end if + end if + + if (.not.allocated(bnorth)) then + allocate(bnorth(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of bnorth failed: istat=',i5)") istat + call endrun + end if + end if + + if (.not.allocated(beast)) then + allocate(beast(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of beast failed: istat=',i5)") istat + call endrun + end if + end if + + if (.not.allocated(bdown)) then + allocate(bdown(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of bdown failed: istat=',i5)") istat + call endrun + end if + end if + + if (.not.allocated(bmag)) then + allocate(bmag(pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of bmag failed: istat=',i5)") istat + call endrun + end if + end if + if (.not.allocated(d1vec)) then + allocate(d1vec(3,pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of d1vec failed: istat=',i5)") istat + call endrun + endif + endif + + if (.not.allocated(d2vec)) then + allocate(d2vec(3,pcols,begchunk:endchunk),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> allocate_arrays: allocate of d2vec failed: istat=',i5)") istat + call endrun + endif + endif + +end subroutine allocate_arrays + +end module mo_apex diff --git a/src/chemistry/mozart/mo_aurora.F90 b/src/chemistry/mozart/mo_aurora.F90 new file mode 100644 index 0000000000..ebe49ec4f3 --- /dev/null +++ b/src/chemistry/mozart/mo_aurora.F90 @@ -0,0 +1,103 @@ +!----------------------------------------------------------------------- +! Stub version +! +!----------------------------------------------------------------------- + +module mo_aurora + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pver,pcols + + implicit none + + interface aurora + module procedure aurora_prod + module procedure aurora_hrate + end interface aurora + +contains + + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_register + + endsubroutine aurora_register + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_inti + + end subroutine aurora_inti + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_timestep_init + + end subroutine aurora_timestep_init + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_prod( tn, o2, o1, mbar, rlats, & + qo2p, qop, qn2p, qnp, pmid, & + lchnk, calday, ncol, rlons, pbuf ) + + use physics_buffer,only: physics_buffer_desc + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: & + ncol, & ! column count + lchnk ! chunk index + real(r8), intent(in) :: & + calday ! calendar day of year + real(r8), intent(in) :: & + tn(pcols,pver), & ! neutral gas temperature (K) + o2(ncol,pver), & ! O2 concentration (kg/kg) + o1(ncol,pver), & ! O concentration (kg/kg) + mbar(ncol,pver) ! mean molecular weight (g/mole) + real(r8), intent(in) :: & + pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: & + rlats(ncol), & ! column latitudes (radians) + rlons(ncol) + real(r8), intent(out) :: & + qo2p(ncol,pver), & ! o2+ production + qop(ncol,pver), & ! o+ production + qn2p(ncol,pver), & ! n2+ production + qnp(ncol,pver) ! n+ production + + type(physics_buffer_desc),pointer :: pbuf(:) + + end subroutine aurora_prod + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_hrate( tn, mbar, rlats, & + aur_hrate, cpair, pmid, lchnk, calday, & + ncol, rlons ) + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: & + ncol, & ! column count + lchnk ! chunk index + real(r8), intent(in) :: & + calday ! calendar day of year + real(r8), intent(in) :: & + tn(pcols,pver), & ! neutral gas temperature (K) + mbar(ncol,pver) ! mean molecular weight (g/mole) + real(r8), intent(in) :: & + cpair(ncol,pver) ! specific heat capacity (J/K/kg) + real(r8), intent(in) :: & + pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: & + rlats(ncol), & ! column latitudes (radians) + rlons(ncol) + real(r8), intent(out) :: & + aur_hrate(ncol,pver) ! auroral heating rate + + end subroutine aurora_hrate + +end module mo_aurora diff --git a/src/chemistry/mozart/mo_calcoe.F90 b/src/chemistry/mozart/mo_calcoe.F90 new file mode 100644 index 0000000000..e399854611 --- /dev/null +++ b/src/chemistry/mozart/mo_calcoe.F90 @@ -0,0 +1,45 @@ + + module mo_calcoe + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: calcoe + + contains + + subroutine calcoe( c, xz, tt, adjin, adjcoe ) +!----------------------------------------------------------------------------- +! parameters: +! adjcoe - real(r8), coross section adjust coefficients (in and out) +! c(5,28)-polynomal coef +! tt -nomarlized temperature +!-----------------------------------------------------------------------------* + + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: adjin + real(r8), intent(in) :: tt + real(r8), intent(in) :: c(5) + real(r8), intent(in) :: xz(pverp) + real(r8), intent(inout) :: adjcoe(:) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: x + + do k = 1,pverp + x = xz(k) + adjcoe(k) = adjin * (1._r8 + .01_r8*(c(1) + x*(c(2) + x*(c(3) + x*(c(4) + x*c(5)))))) + end do + + end subroutine calcoe + + end module mo_calcoe diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 new file mode 100644 index 0000000000..1620422e12 --- /dev/null +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -0,0 +1,162 @@ + +module mo_chem_utls + + private + public :: get_spc_ndx, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx + + save + +contains + + integer function get_spc_ndx( spc_name ) + !----------------------------------------------------------------------- + ! ... return overall species index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : gas_pcnst + use mo_tracname, only : tracnam => solsym + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: spc_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_spc_ndx = -1 + do m = 1,gas_pcnst + if( trim( spc_name ) == trim( tracnam(m) ) ) then + get_spc_ndx = m + exit + end if + end do + + end function get_spc_ndx + + integer function get_inv_ndx( invariant ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : nfs, inv_lst + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: invariant + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_inv_ndx = -1 + do m = 1,nfs + if( trim( invariant ) == trim( inv_lst(m) ) ) then + get_inv_ndx = m + exit + end if + end do + + end function get_inv_ndx + + integer function get_het_ndx( het_name ) + !----------------------------------------------------------------------- + ! ... return overall het process index associated with spc_name + !----------------------------------------------------------------------- + + use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: het_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_het_ndx=-1 + + do m=1,gas_wetdep_cnt + + if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then + get_het_ndx = get_spc_ndx( gas_wetdep_list(m) ) + return + endif + + enddo + + end function get_het_ndx + + integer function get_extfrc_ndx( frc_name ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : extcnt, extfrc_lst + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: frc_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_extfrc_ndx = -1 + if( extcnt > 0 ) then + do m = 1,max(1,extcnt) + if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then + get_extfrc_ndx = m + exit + end if + end do + end if + + end function get_extfrc_ndx + + integer function get_rxt_ndx( rxt_tag ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: rxt_tag + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_rxt_ndx = -1 + do m = 1,rxt_tag_cnt + if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then + get_rxt_ndx = rxt_tag_map(m) + exit + end if + end do + + end function get_rxt_ndx + +end module mo_chem_utls diff --git a/src/chemistry/mozart/mo_chemini.F90 b/src/chemistry/mozart/mo_chemini.F90 new file mode 100644 index 0000000000..17db6665c7 --- /dev/null +++ b/src/chemistry/mozart/mo_chemini.F90 @@ -0,0 +1,244 @@ + +module mo_chemini + + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + + implicit none + + private + public :: chemini + +contains + + subroutine chemini & + ( euvac_file & + , photon_file & + , electron_file & + , airpl_emis_file & + , depvel_file & + , depvel_lnd_file & + , clim_soilw_file & + , season_wes_file & + , xs_coef_file & + , xs_short_file & + , xs_long_file & + , rsf_file & + , fstrat_file & + , fstrat_list & + , srf_emis_specifier & + , srf_emis_type & + , srf_emis_cycle_yr & + , srf_emis_fixed_ymd & + , srf_emis_fixed_tod & + , ext_frc_specifier & + , ext_frc_type & + , ext_frc_cycle_yr & + , ext_frc_fixed_ymd & + , ext_frc_fixed_tod & + , xactive_prates & + , exo_coldens_file & + , tuv_xsect_file & + , o2_xsect_file & + , lght_no_prd_factor & + , pbuf2d & + ) + + !----------------------------------------------------------------------- + ! ... Chemistry module intialization + !----------------------------------------------------------------------- + + use mo_airplane, only : airpl_src + use mo_srf_emissions, only : srf_emissions_inti + use mo_sulf, only : sulf_inti + use mo_photo, only : photo_inti + use mo_lightning, only : lightning_inti + use mo_drydep, only : drydep_inti + use seq_drydep_mod, only : DD_XLND, DD_XATM, drydep_method + use mo_imp_sol, only : imp_slv_inti + use mo_exp_sol, only : exp_sol_inti + use spmd_utils, only : iam + use mo_fstrat, only : fstrat_inti + use mo_sethet, only : sethet_inti + use mo_usrrxt, only : usrrxt_inti + use mo_extfrc, only : extfrc_inti + use mo_setext, only : setext_inti + use mo_setinv, only : setinv_inti + use mo_gas_phase_chemdr,only: gas_phase_chemdr_inti + + use tracer_cnst, only : tracer_cnst_init + use tracer_srcs, only : tracer_srcs_init + use mo_synoz, only : synoz_inti + use mo_chem_utls, only : get_spc_ndx + use mo_airglow, only : init_airglow + use mo_mean_mass, only : init_mean_mass + use mo_mass_xforms, only : init_mass_xforms + use mo_strato_rates, only : init_strato_rates + use mo_cph, only : init_cph + use mo_sad, only : sad_inti + use euvac, only : euvac_init + use mo_heatnirco2, only : heatnirco2_init + use mo_waccm_hrates, only : init_hrates + use mo_aurora, only : aurora_inti + use clybry_fam, only : clybry_fam_init + use mo_neu_wetdep, only : neu_wetdep_init + use physics_buffer, only : physics_buffer_desc + + implicit none + + character(len=*), intent(in) :: euvac_file + character(len=*), intent(in) :: photon_file + character(len=*), intent(in) :: electron_file + + character(len=*), intent(in) :: airpl_emis_file + character(len=*), intent(in) :: depvel_file + character(len=*), intent(in) :: depvel_lnd_file + character(len=*), intent(in) :: clim_soilw_file + character(len=*), intent(in) :: season_wes_file + character(len=*), intent(in) :: xs_coef_file + character(len=*), intent(in) :: xs_short_file + character(len=*), intent(in) :: xs_long_file + character(len=*), intent(in) :: rsf_file + character(len=*), intent(in) :: fstrat_file + character(len=*), intent(in) :: fstrat_list(:) + character(len=*), dimension(:), intent(in) :: srf_emis_specifier + character(len=*), dimension(:), intent(in) :: ext_frc_specifier + logical, intent(in) :: xactive_prates + character(len=*), intent(in) :: exo_coldens_file + character(len=*), intent(in) :: tuv_xsect_file + character(len=*), intent(in) :: o2_xsect_file + real(r8), intent(in) :: lght_no_prd_factor + character(len=*), intent(in) :: ext_frc_type + integer, intent(in) :: ext_frc_cycle_yr + integer, intent(in) :: ext_frc_fixed_ymd + integer, intent(in) :: ext_frc_fixed_tod + character(len=*), intent(in) :: srf_emis_type + integer, intent(in) :: srf_emis_cycle_yr + integer, intent(in) :: srf_emis_fixed_ymd + integer, intent(in) :: srf_emis_fixed_tod + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... initialize the implicit solver + !----------------------------------------------------------------------- + call imp_slv_inti() + call exp_sol_inti() + + call gas_phase_chemdr_inti() + + call init_mean_mass + call init_mass_xforms + + call setinv_inti() + call sethet_inti() + call usrrxt_inti() + call init_hrates + call init_airglow + + call init_strato_rates + call init_cph + + !----------------------------------------------------------------------- + ! ... initialize tracer modules + !----------------------------------------------------------------------- + call tracer_cnst_init() + call tracer_srcs_init() + + !----------------------------------------------------------------------- + ! ... read time-independent airplane emissions + !----------------------------------------------------------------------- + call airpl_src(airpl_emis_file) + if (masterproc) write(iulog,*) 'chemini: after airpl_src on node ',iam + + !----------------------------------------------------------------------- + ! ... read time-dependent surface flux dataset + !----------------------------------------------------------------------- + call srf_emissions_inti ( srf_emis_specifier, srf_emis_type, srf_emis_cycle_yr, srf_emis_fixed_ymd, srf_emis_fixed_tod) + + if (masterproc) write(iulog,*) 'chemini: after srf_emissions_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize external forcings module + !----------------------------------------------------------------------- + call setext_inti() + call extfrc_inti(ext_frc_specifier, ext_frc_type, ext_frc_cycle_yr, ext_frc_fixed_ymd, ext_frc_fixed_tod) + if (masterproc) write(iulog,*) 'chemini: after extfrc_inti on node ',iam + + call sulf_inti() + if (masterproc) write(iulog,*) 'chemini: after sulf_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize the sad module + !----------------------------------------------------------------------- + call sad_inti(pbuf2d) + if (masterproc) write(iulog,*) 'chemini: after sad_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize the lightning module + !----------------------------------------------------------------------- + call lightning_inti(lght_no_prd_factor) + if (masterproc) write(iulog,*) 'chemini: after lightning_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize the dry deposition module + !----------------------------------------------------------------------- + if ( drydep_method == DD_XATM .or. drydep_method == DD_XLND ) then + call drydep_inti(depvel_lnd_file, clim_soilw_file, season_wes_file ) + else + call drydep_inti( depvel_file ) + endif + + if (masterproc) write(iulog,*) 'chemini: after drydep_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... Initialize the upper boundary module + !----------------------------------------------------------------------- + call fstrat_inti( fstrat_file, fstrat_list ) + if (masterproc) write(iulog,*) 'chemini: after fstrat_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize the co2 nir heating module + !----------------------------------------------------------------------- + call heatnirco2_init + + !----------------------------------------------------------------------- + ! ... initialize photorate module + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! ... initialize the euvac etf module + !----------------------------------------------------------------------- + call euvac_init (euvac_file) + + call photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & + photon_file, electron_file, & + exo_coldens_file, tuv_xsect_file, o2_xsect_file, xactive_prates ) + + if (masterproc) write(iulog,*) 'chemini: after photo_inti on node ',iam + + !----------------------------------------------------------------------- + ! ... initialize the stratospheric ozone source + !----------------------------------------------------------------------- + if( get_spc_ndx( 'SYNOZ' ) > 0 ) then + call synoz_inti( ) + ! over ride the ozone constituent used for radiation feedbacks + end if + + !----------------------------------------------------------------------- + ! ... initialize ion production + !----------------------------------------------------------------------- + call aurora_inti + if (masterproc) write(iulog,*) 'chemini: after aurora_inti' + + call neu_wetdep_init() + if (masterproc) write(iulog,*) 'chemini: after wetdep_init' + + call clybry_fam_init() + + if (masterproc) write(iulog,*) 'chemini: finished on node ',iam + + end subroutine chemini + +end module mo_chemini diff --git a/src/chemistry/mozart/mo_chm_diags.F90 b/src/chemistry/mozart/mo_chm_diags.F90 new file mode 100644 index 0000000000..5145c044e2 --- /dev/null +++ b/src/chemistry/mozart/mo_chm_diags.F90 @@ -0,0 +1,886 @@ +module mo_chm_diags + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : gas_pcnst + use mo_tracname, only : solsym + use chem_mods, only : rxntot, nfs, gas_pcnst, indexm, adv_mass + use ppgrid, only : pver + use mo_constants, only : rgrav, rearth + use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx + use cam_history, only : fieldname_len + use mo_jeuv, only : neuv + use gas_wetdep_opts,only : gas_wetdep_method + + implicit none + private + + public :: chm_diags_inti + public :: chm_diags + public :: het_diags + + integer :: id_n,id_no,id_no2,id_no3,id_n2o5,id_hno3,id_ho2no2,id_clono2,id_brono2 + integer :: id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_brcl + integer :: id_ccl4,id_cfc11,id_cfc113,id_ch3ccl3,id_cfc12,id_ch3cl,id_hcfc22,id_cf3br,id_cf2clbr + integer :: id_cfc114,id_cfc115,id_hcfc141b,id_hcfc142b,id_h1202,id_h2402,id_ch2br2,id_chbr3 + integer :: id_hf,id_f,id_cof2,id_cofcl,id_ch3br + integer :: id_br,id_bro,id_hbr,id_hobr,id_ch4,id_h2o,id_h2 + integer :: id_o,id_o2,id_h, id_h2o2, id_n2o + integer :: id_co2,id_o3,id_oh,id_ho2,id_so4_a1,id_so4_a2,id_so4_a3 + integer :: id_num_a2,id_num_a3,id_dst_a3,id_ncl_a3 + integer :: id_ndep,id_nhdep + + integer, parameter :: NJEUV = neuv + integer :: rid_jeuv(NJEUV), rid_jno_i, rid_jno + + logical :: has_jeuvs, has_jno_i, has_jno + + integer :: nox_species(3), noy_species(26) + integer :: clox_species(6), cloy_species(9), tcly_species(21) + integer :: brox_species(4), broy_species(6), tbry_species(13) + integer :: foy_species(4), tfy_species(16) + integer :: hox_species(4) + integer :: toth_species(3) + integer :: sox_species(3) + integer :: nhx_species(2) + integer :: aer_species(gas_pcnst) + + character(len=fieldname_len) :: dtchem_name(gas_pcnst) + character(len=fieldname_len) :: depvel_name(gas_pcnst) + character(len=fieldname_len) :: depflx_name(gas_pcnst) + character(len=fieldname_len) :: wetdep_name(gas_pcnst) + character(len=fieldname_len) :: wtrate_name(gas_pcnst) + + real(r8), parameter :: N_molwgt = 14.00674_r8 + real(r8), parameter :: S_molwgt = 32.066_r8 + +contains + + subroutine chm_diags_inti + !-------------------------------------------------------------------- + ! ... initialize utility routine + !-------------------------------------------------------------------- + + use cam_history, only : addfld, add_default, horiz_only + use constituents, only : cnst_get_ind, cnst_longname + use phys_control, only : phys_getopts + use mo_drydep, only : has_drydep + use species_sums_diags, only : species_sums_init + + integer :: j, k, m, n + character(len=16) :: jname, spc_name, attr + character(len=2) :: jchar + character(len=2) :: unit_basename ! Units 'kg' or '1' + + integer :: id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3 + integer :: id_so2, id_so4, id_h2so4 + integer :: id_nh3, id_nh4 + integer :: id_honitr + integer :: id_alknit + integer :: id_isopnita + integer :: id_isopnitb + integer :: id_isopnooh + integer :: id_nc4ch2oh + integer :: id_nc4cho + integer :: id_noa + integer :: id_nterpooh + integer :: id_pbznit + integer :: id_terpnit + integer :: id_dst01, id_dst02, id_dst03, id_dst04, id_sslt01, id_sslt02, id_sslt03, id_sslt04 + integer :: id_soa, id_oc1, id_oc2, id_cb1, id_cb2 + integer :: id_soam,id_soai,id_soat,id_soab,id_soax + integer :: id_bry, id_cly + + logical :: history_aerosol ! Output the MAM aerosol tendencies + logical :: history_chemistry + logical :: history_cesm_forcing + logical :: history_scwaccm_forcing + logical :: history_chemspecies_srf ! output the chemistry constituents species in the surface layer + integer :: bulkaero_species(20) + + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_chemspecies_srf_out = history_chemspecies_srf, & + history_cesm_forcing_out = history_cesm_forcing, & + history_scwaccm_forcing_out = history_scwaccm_forcing ) + + id_bry = get_spc_ndx( 'BRY' ) + id_cly = get_spc_ndx( 'CLY' ) + + id_n = get_spc_ndx( 'N' ) + id_no = get_spc_ndx( 'NO' ) + id_no2 = get_spc_ndx( 'NO2' ) + id_no3 = get_spc_ndx( 'NO3' ) + id_n2o5 = get_spc_ndx( 'N2O5' ) + id_n2o = get_spc_ndx( 'N2O' ) + id_hno3 = get_spc_ndx( 'HNO3' ) + id_ho2no2 = get_spc_ndx( 'HO2NO2' ) + id_clono2 = get_spc_ndx( 'CLONO2' ) + id_brono2 = get_spc_ndx( 'BRONO2' ) + id_cl = get_spc_ndx( 'CL' ) + id_clo = get_spc_ndx( 'CLO' ) + id_hocl = get_spc_ndx( 'HOCL' ) + id_cl2 = get_spc_ndx( 'CL2' ) + id_cl2o2 = get_spc_ndx( 'CL2O2' ) + id_oclo = get_spc_ndx( 'OCLO' ) + id_hcl = get_spc_ndx( 'HCL' ) + id_brcl = get_spc_ndx( 'BRCL' ) + + id_co2 = get_spc_ndx( 'CO2' ) + id_o3 = get_spc_ndx( 'O3' ) + id_oh = get_spc_ndx( 'OH' ) + id_ho2 = get_spc_ndx( 'HO2' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + id_so4_a1 = get_spc_ndx( 'so4_a1' ) + id_so4_a2 = get_spc_ndx( 'so4_a2' ) + id_so4_a3 = get_spc_ndx( 'so4_a3' ) + id_num_a2 = get_spc_ndx( 'num_a2' ) + id_num_a3 = get_spc_ndx( 'num_a3' ) + id_dst_a3 = get_spc_ndx( 'dst_a3' ) + id_ncl_a3 = get_spc_ndx( 'ncl_a3' ) + + id_f = get_spc_ndx( 'F' ) + id_hf = get_spc_ndx( 'HF' ) + id_cofcl = get_spc_ndx( 'COFCL' ) + id_cof2 = get_spc_ndx( 'COF2' ) + + id_ccl4 = get_spc_ndx( 'CCL4' ) + id_cfc11 = get_spc_ndx( 'CFC11' ) + + id_cfc113 = get_spc_ndx( 'CFC113' ) + id_cfc114 = get_spc_ndx( 'CFC114' ) + id_cfc115 = get_spc_ndx( 'CFC115' ) + + id_ch3ccl3 = get_spc_ndx( 'CH3CCL3' ) + id_cfc12 = get_spc_ndx( 'CFC12' ) + id_ch3cl = get_spc_ndx( 'CH3CL' ) + + id_hcfc22 = get_spc_ndx( 'HCFC22' ) + id_hcfc141b= get_spc_ndx( 'HCFC141B' ) + id_hcfc142b= get_spc_ndx( 'HCFC142B' ) + + id_cf2clbr = get_spc_ndx( 'CF2CLBR' ) + id_cf3br = get_spc_ndx( 'CF3BR' ) + id_ch3br = get_spc_ndx( 'CH3BR' ) + id_h1202 = get_spc_ndx( 'H1202' ) + id_h2402 = get_spc_ndx( 'H2402' ) + id_ch2br2 = get_spc_ndx( 'CH2BR2' ) + id_chbr3 = get_spc_ndx( 'CHBR3' ) + + id_br = get_spc_ndx( 'BR' ) + id_bro = get_spc_ndx( 'BRO' ) + id_hbr = get_spc_ndx( 'HBR' ) + id_hobr = get_spc_ndx( 'HOBR' ) + id_ch4 = get_spc_ndx( 'CH4' ) + id_h2o = get_spc_ndx( 'H2O' ) + id_h2 = get_spc_ndx( 'H2' ) + id_o = get_spc_ndx( 'O' ) + id_o2 = get_spc_ndx( 'O2' ) + id_h = get_spc_ndx( 'H' ) + + id_pan = get_spc_ndx( 'PAN' ) + id_onit = get_spc_ndx( 'ONIT' ) + id_mpan = get_spc_ndx( 'MPAN' ) + id_isopno3 = get_spc_ndx( 'ISOPNO3' ) + id_onitr = get_spc_ndx( 'ONITR' ) + id_nh4no3 = get_spc_ndx( 'NH4NO3' ) + + id_honitr = get_spc_ndx( 'HONITR' ) + id_alknit = get_spc_ndx( 'ALKNIT' ) + id_isopnita = get_spc_ndx( 'ISOPNITA' ) + id_isopnitb = get_spc_ndx( 'ISOPNITB' ) + id_isopnooh = get_spc_ndx( 'ISOPNOOH' ) + id_nc4ch2oh = get_spc_ndx( 'NC4CH2OH' ) + id_nc4cho = get_spc_ndx( 'NC4CHO' ) + id_noa = get_spc_ndx( 'NOA' ) + id_nterpooh = get_spc_ndx( 'NTERPOOH' ) + id_pbznit = get_spc_ndx( 'PBZNIT' ) + id_terpnit = get_spc_ndx( 'TERPNIT' ) + id_ndep = get_spc_ndx( 'NDEP' ) + id_nhdep = get_spc_ndx( 'NHDEP' ) + + id_so2 = get_spc_ndx( 'SO2' ) + id_so4 = get_spc_ndx( 'SO4' ) + id_h2so4 = get_spc_ndx( 'H2SO4' ) + + id_nh3 = get_spc_ndx( 'NH3' ) + id_nh4 = get_spc_ndx( 'NH4' ) + id_nh4no3 = get_spc_ndx( 'NH4NO3' ) + + id_dst01 = get_spc_ndx( 'DST01' ) + id_dst02 = get_spc_ndx( 'DST02' ) + id_dst03 = get_spc_ndx( 'DST03' ) + id_dst04 = get_spc_ndx( 'DST04' ) + id_sslt01 = get_spc_ndx( 'SSLT01' ) + id_sslt02 = get_spc_ndx( 'SSLT02' ) + id_sslt03 = get_spc_ndx( 'SSLT03' ) + id_sslt04 = get_spc_ndx( 'SSLT04' ) + id_soa = get_spc_ndx( 'SOA' ) + id_so4 = get_spc_ndx( 'SO4' ) + id_oc1 = get_spc_ndx( 'OC1' ) + id_oc2 = get_spc_ndx( 'OC2' ) + id_cb1 = get_spc_ndx( 'CB1' ) + id_cb2 = get_spc_ndx( 'CB2' ) + + rid_jno = get_rxt_ndx( 'jno' ) + rid_jno_i = get_rxt_ndx( 'jno_i' ) + + id_soam = get_spc_ndx( 'SOAM' ) + id_soai = get_spc_ndx( 'SOAI' ) + id_soat = get_spc_ndx( 'SOAT' ) + id_soab = get_spc_ndx( 'SOAB' ) + id_soax = get_spc_ndx( 'SOAX' ) + + +!... NOY species + nox_species = (/ id_n, id_no, id_no2 /) + noy_species = (/ id_n, id_no, id_no2, id_no3, id_n2o5, id_hno3, id_ho2no2, id_clono2, & + id_brono2, id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3, & + id_honitr, id_alknit, id_isopnita, id_isopnitb, id_isopnooh, id_nc4ch2oh, & + id_nc4cho, id_noa, id_nterpooh, id_pbznit, id_terpnit /) +!... HOX species + hox_species = (/ id_h, id_oh, id_ho2, id_h2o2 /) + +!... CLOY species + clox_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo /) + cloy_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo, id_hcl, id_clono2, id_brcl /) + tcly_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo, id_hcl, id_clono2, id_brcl, & + id_ccl4, id_cfc11, id_cfc113, id_cfc114, id_cfc115, id_ch3ccl3, id_cfc12, id_ch3cl, & + id_hcfc22, id_hcfc141b, id_hcfc142b, id_cf2clbr /) + +!... FOY species + foy_species = (/ id_F, id_hf, id_cofcl, id_cof2 /) + tfy_species = (/ id_f, id_hf, id_cofcl, id_cof2, id_cfc11, id_cfc12, id_cfc113, id_cfc114, id_cfc115, & + id_hcfc22, id_hcfc141b, id_hcfc142b, id_cf2clbr, id_cf3br, id_h1202, id_h2402 /) + +!... BROY species + brox_species = (/ id_br, id_bro, id_brcl, id_hobr /) + broy_species = (/ id_br, id_bro, id_hbr, id_brono2, id_brcl, id_hobr /) + tbry_species = (/ id_br, id_bro, id_hbr, id_brono2, id_brcl, id_hobr, id_cf2clbr, id_cf3br, id_ch3br, id_h1202, & + id_h2402, id_ch2br2, id_chbr3 /) + + sox_species = (/ id_so2, id_so4, id_h2so4 /) + nhx_species = (/ id_nh3, id_nh4 /) + bulkaero_species(:) = -1 + bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, & + id_sslt01, id_sslt02, id_sslt03, id_sslt04, & + id_soa, id_so4, id_oc1, id_oc2, id_cb1, id_cb2, id_nh4no3, & + id_soam,id_soai,id_soat,id_soab,id_soax /) + + aer_species(:) = -1 + n = 1 + do m = 1,gas_pcnst + k=0 + if ( any(bulkaero_species(:)==m) ) k=1 + if ( k==0 ) k = index(trim(solsym(m)), '_a') + if ( k==0 ) k = index(trim(solsym(m)), '_c') + if ( k>0 ) then ! must be aerosol species + aer_species(n) = m + n = n+1 + endif + enddo + + toth_species = (/ id_ch4, id_h2o, id_h2 /) + + call addfld( 'NOX', (/ 'lev' /), 'A', 'mol/mol', 'nox (N+NO+NO2)' ) + call addfld( 'NOY', (/ 'lev' /), 'A', 'mol/mol', & + 'noy = total nitrogen (N+NO+NO2+NO3+2N2O5+HNO3+HO2NO2+ORGNOY+NH4NO3' ) + call addfld( 'NOY_SRF', horiz_only, 'A', 'mol/mol', 'surface noy volume mixing ratio' ) + call addfld( 'HOX', (/ 'lev' /), 'A', 'mol/mol', 'HOx (H+OH+HO2+2H2O2)' ) + + call addfld( 'BROX', (/ 'lev' /), 'A', 'mol/mol', 'brox (Br+BrO+BRCl+HOBr)' ) + call addfld( 'BROY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic bromine (Br+BrO+HOBr+BrONO2+HBr+BrCl)' ) + call addfld( 'TBRY', (/ 'lev' /), 'A', 'mol/mol', 'total Br (ORG+INORG) volume mixing ratio' ) + + call addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', 'clox (Cl+CLO+HOCl+2Cl2+2Cl2O2+OClO' ) + call addfld( 'CLOY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic chlorine (Cl+ClO+2Cl2+2Cl2O2+OClO+HOCl+ClONO2+HCl+BrCl)' ) + call addfld( 'TCLY', (/ 'lev' /), 'A', 'mol/mol', 'total Cl (ORG+INORG) volume mixing ratio' ) + + call addfld( 'FOY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic fluorine (F+HF+COFCL+2COF2)' ) + call addfld( 'TFY', (/ 'lev' /), 'A', 'mol/mol', 'total F (ORG+INORG) volume mixing ratio' ) + + call addfld( 'TOTH', (/ 'lev' /), 'A', 'mol/mol', 'total H2 volume mixing ratio' ) + + call addfld( 'NOY_mmr', (/ 'lev' /), 'A', 'kg/kg', 'NOy mass mixing ratio' ) + call addfld( 'SOX_mmr', (/ 'lev' /), 'A', 'kg/kg', 'SOx mass mixing ratio' ) + call addfld( 'NHX_mmr', (/ 'lev' /), 'A', 'kg/kg', 'NHx mass mixing ratio' ) + + do j = 1,NJEUV + write( jchar, '(I2)' ) j + jname = 'jeuv_'//trim(adjustl(jchar)) + rid_jeuv(j) = get_rxt_ndx( trim(jname) ) + enddo + + has_jeuvs = all( rid_jeuv(:) > 0 ) + has_jno_i = rid_jno_i>0 + has_jno = rid_jno>0 + + if ( has_jeuvs ) then + call addfld( 'PION_EUV', (/ 'lev' /), 'I', '/cm^3/s', 'total euv ionization rate' ) + call addfld( 'PEUV1', (/ 'lev' /), 'I', '/cm^3/s', '(j1+j2+j3)*o' ) + call addfld( 'PEUV1e', (/ 'lev' /), 'I', '/cm^3/s', '(j14+j15+j16)*o' ) + call addfld( 'PEUV2', (/ 'lev' /), 'I', '/cm^3/s', 'j4*n' ) + call addfld( 'PEUV3', (/ 'lev' /), 'I', '/cm^3/s', '(j5+j7+j8+j9)*o2' ) + call addfld( 'PEUV3e', (/ 'lev' /), 'I', '/cm^3/s', '(j17+j19+j20+j21)*o2' ) + call addfld( 'PEUV4', (/ 'lev' /), 'I', '/cm^3/s', '(j10+j11)*n2' ) + call addfld( 'PEUV4e', (/ 'lev' /), 'I', '/cm^3/s', '(j22+j23)*n2' ) + call addfld( 'PEUVN2D', (/ 'lev' /), 'I', '/cm^3/s', '(j11+j13)*n2' ) + call addfld( 'PEUVN2De', (/ 'lev' /), 'I', '/cm^3/s', '(j23+j25)*n2' ) + endif + if ( has_jno ) then + call addfld( 'PJNO', (/ 'lev' /), 'I', '/cm^3/s', 'jno*no' ) + endif + if ( has_jno_i ) then + call addfld( 'PJNO_I', (/ 'lev' /), 'I', '/cm^3/s', 'jno_i*no' ) + endif +! +! CCMI +! + call addfld( 'DO3CHM_TRP', horiz_only, 'A', 'kg/s', 'integrated net tendency from chem in troposphere', & + flag_xyfill=.True. ) + call addfld( 'DO3CHM_LMS', horiz_only, 'A', 'kg/s', 'integrated net tendency from chem in lowermost stratosphere', & + flag_xyfill=.True. ) +! + do m = 1,gas_pcnst + + spc_name = trim(solsym(m)) + + call cnst_get_ind(spc_name, n, abort=.false. ) + if ( n > 0 ) then + attr = cnst_longname(n) + elseif ( trim(spc_name) == 'H2O' ) then + attr = 'water vapor' + else + attr = spc_name + endif + + depvel_name(m) = 'DV_'//trim(spc_name) + depflx_name(m) = 'DF_'//trim(spc_name) + dtchem_name(m) = 'D'//trim(spc_name)//'CHM' + + call addfld( depvel_name(m), horiz_only, 'A', 'cm/s', 'deposition velocity ' ) + call addfld( depflx_name(m), horiz_only, 'A', 'kg/m2/s', 'dry deposition flux ' ) + call addfld( dtchem_name(m), (/ 'lev' /), 'A', 'kg/s', 'net tendency from chem' ) + + if (has_drydep(spc_name).and.history_chemistry) then + call add_default( depflx_name(m), 1, ' ' ) + endif + + if (gas_wetdep_method=='MOZ') then + wetdep_name(m) = 'WD_'//trim(spc_name) + wtrate_name(m) = 'WDR_'//trim(spc_name) + + call addfld( wetdep_name(m), horiz_only, 'A', 'kg/s', spc_name//' wet deposition' ) + call addfld( wtrate_name(m), (/ 'lev' /), 'A', '/s', spc_name//' wet deposition rate' ) + endif + + if (spc_name(1:3) == 'num') then + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + if ( any( aer_species == m ) ) then + call addfld( spc_name, (/ 'lev' /), 'A', unit_basename//'/kg ', trim(attr)//' concentration') + call addfld( trim(spc_name)//'_SRF', horiz_only, 'A', unit_basename//'/kg', trim(attr)//" in bottom layer") + else + call addfld( spc_name, (/ 'lev' /), 'A', 'mol/mol', trim(attr)//' concentration') + call addfld( trim(spc_name)//'_SRF', horiz_only, 'A', 'mol/mol', trim(attr)//" in bottom layer") + endif + + if ((m /= id_cly) .and. (m /= id_bry)) then + if (history_aerosol.or.history_chemistry) then + call add_default( spc_name, 1, ' ' ) + endif + if (history_chemspecies_srf) then + call add_default( trim(spc_name)//'_SRF', 1, ' ' ) + endif + endif + + if ( history_cesm_forcing ) then + if (m==id_o3) call add_default( spc_name, 1, ' ') + if (m==id_oh) call add_default( spc_name, 1, ' ') + if (m==id_no3) call add_default( spc_name, 1, ' ') + if (m==id_ho2) call add_default( spc_name, 1, ' ') + + if (m==id_o3) call add_default( spc_name, 8, ' ') + if (m==id_so4_a1) call add_default( spc_name, 8, ' ') + if (m==id_so4_a2) call add_default( spc_name, 8, ' ') + if (m==id_so4_a3) call add_default( spc_name, 8, ' ') + + if (m==id_num_a2) call add_default( spc_name, 8, ' ') + if (m==id_num_a3) call add_default( spc_name, 8, ' ') + if (m==id_dst_a3) call add_default( spc_name, 8, ' ') + if (m==id_ncl_a3) call add_default( spc_name, 8, ' ') + + endif + if ( history_scwaccm_forcing ) then + if (m==id_co2) call add_default( spc_name, 8, ' ') + if (m==id_h) call add_default( spc_name, 8, ' ') + if (m==id_no) call add_default( spc_name, 8, ' ') + if (m==id_o) call add_default( spc_name, 8, ' ') + if (m==id_o2) call add_default( spc_name, 8, ' ') + if (m==id_o3) call add_default( spc_name, 8, ' ') + if (m==id_h2o) call add_default( spc_name, 1, ' ') + if (m==id_ch4 ) call add_default( spc_name, 1, ' ') + if (m==id_n2o ) call add_default( spc_name, 1, ' ') + if (m==id_cfc11 ) call add_default( spc_name, 1, ' ') + if (m==id_cfc12 ) call add_default( spc_name, 1, ' ') + endif + + enddo + + call addfld( 'MASS', (/ 'lev' /), 'A', 'kg', 'mass of grid box' ) + call addfld( 'AREA', horiz_only, 'A', 'm2', 'area of grid box' ) + + call addfld( 'dry_deposition_NOy_as_N', horiz_only, 'I', 'kg/m2/s', 'NOy dry deposition flux ' ) + call addfld( 'DF_SOX', horiz_only, 'I', 'kg/m2/s', 'SOx dry deposition flux ' ) + call addfld( 'dry_deposition_NHx_as_N', horiz_only, 'I', 'kg/m2/s', 'NHx dry deposition flux ' ) + if (gas_wetdep_method=='NEU') then + call addfld( 'wet_deposition_NOy_as_N', horiz_only, 'A', 'kg/m2/s', 'NOy wet deposition' ) + call addfld( 'wet_deposition_NHx_as_N', horiz_only, 'A', 'kg/m2/s', 'NHx wet deposition' ) + elseif (gas_wetdep_method=='MOZ') then + call addfld( 'wet_deposition_NOy_as_N', horiz_only, 'A', 'kg/s', 'NOy wet deposition' ) + call addfld( 'WD_SOX', horiz_only, 'A', 'kg/s', 'SOx wet deposition' ) + call addfld( 'wet_deposition_NHx_as_N', horiz_only, 'A', 'kg/s', 'NHx wet deposition' ) + endif + if ( history_cesm_forcing ) then + call add_default('dry_deposition_NOy_as_N', 1, ' ') + call add_default('dry_deposition_NHx_as_N', 1, ' ') + call add_default('wet_deposition_NOy_as_N', 1, ' ') + call add_default('wet_deposition_NHx_as_N', 1, ' ') + endif + + call species_sums_init() + + end subroutine chm_diags_inti + + subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depflx, mmr_tend, pdel, pmid, ltrop, & + wetdepflx, nhx_nitrogen_flx, noy_nitrogen_flx ) + !-------------------------------------------------------------------- + ! ... utility routine to output chemistry diagnostic variables + !-------------------------------------------------------------------- + + use cam_history, only : outfld + use phys_grid, only : get_area_all_p + use species_sums_diags, only : species_sums_output +! +! CCMI +! + use cam_history_support, only : fillvalue + + !-------------------------------------------------------------------- + ! ... dummy arguments + !-------------------------------------------------------------------- + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) + real(r8), intent(in) :: mmr(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt_rates(ncol,pver,rxntot) + real(r8), intent(in) :: invariants(ncol,pver,max(1,nfs)) + real(r8), intent(in) :: depvel(ncol, gas_pcnst) + real(r8), intent(in) :: depflx(ncol, gas_pcnst) + real(r8), intent(in) :: mmr_tend(ncol,pver,gas_pcnst) + real(r8), intent(in) :: pdel(ncol,pver) + real(r8), intent(in) :: pmid(ncol,pver) + integer, intent(in) :: ltrop(ncol) + real(r8), intent(in) :: wetdepflx(ncol, gas_pcnst) + real(r8), intent(out) :: nhx_nitrogen_flx(ncol) ! kgN/m2/sec + real(r8), intent(out) :: noy_nitrogen_flx(ncol) ! kgN/m2/sec + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer :: i, k, m + real(r8) :: wrk(ncol,pver) + ! real(r8) :: tmp(ncol,pver) + ! real(r8) :: m(ncol,pver) + real(r8) :: un2(ncol) + + real(r8), dimension(ncol,pver) :: vmr_nox, vmr_noy, vmr_clox, vmr_cloy, vmr_tcly, vmr_brox, vmr_broy, vmr_toth + real(r8), dimension(ncol,pver) :: vmr_tbry, vmr_foy, vmr_tfy + real(r8), dimension(ncol,pver) :: mmr_noy, mmr_sox, mmr_nhx, net_chem + real(r8), dimension(ncol) :: df_noy, df_sox, df_nhx, do3chm_trp, do3chm_lms + real(r8), dimension(ncol) :: wd_noy, wd_nhx + real(r8), dimension(ncol,pver) :: vmr_hox + + real(r8) :: area(ncol), mass(ncol,pver) + real(r8) :: wgt + + !-------------------------------------------------------------------- + ! ... "diagnostic" groups + !-------------------------------------------------------------------- + vmr_nox(:ncol,:) = 0._r8 + vmr_noy(:ncol,:) = 0._r8 + vmr_hox(:ncol,:) = 0._r8 + vmr_clox(:ncol,:) = 0._r8 + vmr_cloy(:ncol,:) = 0._r8 + vmr_tcly(:ncol,:) = 0._r8 + vmr_brox(:ncol,:) = 0._r8 + vmr_broy(:ncol,:) = 0._r8 + vmr_tbry(:ncol,:) = 0._r8 + vmr_foy(:ncol,:) = 0._r8 + vmr_tfy(:ncol,:) = 0._r8 + vmr_toth(:ncol,:) = 0._r8 + mmr_noy(:ncol,:) = 0._r8 + mmr_sox(:ncol,:) = 0._r8 + mmr_nhx(:ncol,:) = 0._r8 + df_noy(:ncol) = 0._r8 + df_sox(:ncol) = 0._r8 + df_nhx(:ncol) = 0._r8 + + wd_noy(:ncol) = 0._r8 + wd_nhx(:ncol) = 0._r8 + + call get_area_all_p(lchnk, ncol, area) + area = area * rearth**2 + + do k = 1,pver + mass(:ncol,k) = pdel(:ncol,k) * area(:ncol) * rgrav + enddo + + call outfld( 'AREA', area(:ncol), ncol, lchnk ) + call outfld( 'MASS', mass(:ncol,:), ncol, lchnk ) + + do m = 1,gas_pcnst + + !...FOY (counting Fluorines, not chlorines or bromines) + if ( m == id_cfc12 .or. m == id_hcfc22 .or. m == id_cf2clbr .or. m == id_h1202 .or. m == id_hcfc142b & + .or. m == id_cof2 ) then + wgt = 2._r8 + elseif ( m == id_cfc113 .or. m == id_cf3br ) then + wgt = 3._r8 + elseif ( m == id_cfc114 .or. m == id_h2402 ) then + wgt = 4._r8 + elseif ( m == id_cfc115 ) then + wgt = 5._r8 + else + wgt = 1._r8 + endif + if ( any( foy_species == m ) ) then + vmr_foy(:ncol,:) = vmr_foy(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( tfy_species == m ) ) then + vmr_tfy(:ncol,:) = vmr_tfy(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + +!... counting chlorine and bromines, etc... (and total H2 species) + if ( m == id_ch4 .or. m == id_n2o5 .or. m == id_cfc12 .or. m == id_cl2 .or. m == id_cl2o2 .or. m==id_h2o2 ) then + wgt = 2._r8 + elseif (m == id_cfc114 .or. m == id_hcfc141b .or. m == id_h1202 .or. m == id_h2402 .or. m == id_ch2br2 ) then + wgt = 2._r8 + elseif ( m == id_cfc11 .or. m == id_cfc113 .or. m == id_ch3ccl3 .or. m == id_chbr3 ) then + wgt = 3._r8 + elseif ( m == id_ccl4 ) then + wgt = 4._r8 + else + wgt = 1._r8 + endif +!...NOY + if ( any( nox_species == m ) ) then + vmr_nox(:ncol,:) = vmr_nox(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( noy_species == m ) ) then + vmr_noy(:ncol,:) = vmr_noy(:ncol,:) + wgt * vmr(:ncol,:,m) + endif +!...NOY, SOX, NHX + if ( any( noy_species == m ) ) then + mmr_noy(:ncol,:) = mmr_noy(:ncol,:) + wgt * mmr(:ncol,:,m) + endif + if ( any( sox_species == m ) ) then + mmr_sox(:ncol,:) = mmr_sox(:ncol,:) + wgt * mmr(:ncol,:,m) + endif + if ( any( nhx_species == m ) ) then + mmr_nhx(:ncol,:) = mmr_nhx(:ncol,:) + wgt * mmr(:ncol,:,m) + endif +!...CLOY + if ( any( clox_species == m ) ) then + vmr_clox(:ncol,:) = vmr_clox(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( cloy_species == m ) ) then + vmr_cloy(:ncol,:) = vmr_cloy(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( tcly_species == m ) ) then + vmr_tcly(:ncol,:) = vmr_tcly(:ncol,:) + wgt * vmr(:ncol,:,m) + endif +!...BROY + if ( any( brox_species == m ) ) then + vmr_brox(:ncol,:) = vmr_brox(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( broy_species == m ) ) then + vmr_broy(:ncol,:) = vmr_broy(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + if ( any( tbry_species == m ) ) then + vmr_tbry(:ncol,:) = vmr_tbry(:ncol,:) + wgt * vmr(:ncol,:,m) + endif +!...HOY + if ( any ( toth_species == m ) ) then + vmr_toth(:ncol,:) = vmr_toth(:ncol,:) + wgt * vmr(:ncol,:,m) + endif +!...HOx + if ( any( hox_species == m ) ) then + vmr_hox(:ncol,:) = vmr_hox(:ncol,:) + wgt * vmr(:ncol,:,m) + endif + + if ( any( aer_species == m ) ) then + call outfld( solsym(m), mmr(:ncol,:,m), ncol ,lchnk ) + call outfld( trim(solsym(m))//'_SRF', mmr(:ncol,pver,m), ncol ,lchnk ) + else + call outfld( solsym(m), vmr(:ncol,:,m), ncol ,lchnk ) + call outfld( trim(solsym(m))//'_SRF', vmr(:ncol,pver,m), ncol ,lchnk ) + endif + + call outfld( depvel_name(m), depvel(:ncol,m), ncol ,lchnk ) + call outfld( depflx_name(m), depflx(:ncol,m), ncol ,lchnk ) + + if ( any( noy_species == m ) ) then + df_noy(:ncol) = df_noy(:ncol) + wgt * depflx(:ncol,m)*N_molwgt/adv_mass(m) + endif + if ( any( sox_species == m ) ) then + df_sox(:ncol) = df_sox(:ncol) + wgt * depflx(:ncol,m)*S_molwgt/adv_mass(m) + endif + if ( any( nhx_species == m ) ) then + df_nhx(:ncol) = df_nhx(:ncol) + wgt * depflx(:ncol,m)*N_molwgt/adv_mass(m) + endif + + if ( any( noy_species == m ) ) then + wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + endif + if ( any( nhx_species == m ) ) then + wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + endif +! +! add contribution from non-conservation tracers +! + if ( id_ndep == m ) then + wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + end if + if ( id_nhdep == m ) then + wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + end if + + do k=1,pver + do i=1,ncol + net_chem(i,k) = mmr_tend(i,k,m) * mass(i,k) + end do + end do + call outfld( dtchem_name(m), net_chem(:ncol,:), ncol, lchnk ) +! +! CCMI +! + if ( trim(dtchem_name(m)) == 'DO3CHM' ) then + do3chm_trp(:) = 0._r8 + do i=1,ncol + do k=ltrop(i),pver + do3chm_trp(i) = do3chm_trp(i) + net_chem(i,k) + end do + end do + where ( do3chm_trp == 0._r8 ) + do3chm_trp = fillvalue + end where + call outfld('DO3CHM_TRP',do3chm_trp(:ncol), ncol, lchnk ) + do3chm_lms(:) = 0._r8 + do i=1,ncol + do k=1,pver + if ( pmid(i,k) > 100.e2_r8 .and. k < ltrop(i) ) then + do3chm_lms(i) = do3chm_lms(i) + net_chem(i,k) + end if + end do + end do + where ( do3chm_lms == 0._r8 ) + do3chm_lms = fillvalue + end where + call outfld('DO3CHM_LMS',do3chm_lms(:ncol), ncol, lchnk ) + end if +! + enddo + + + call outfld( 'NOX', vmr_nox (:ncol,:), ncol, lchnk ) + call outfld( 'NOY', vmr_noy (:ncol,:), ncol, lchnk ) + call outfld( 'HOX', vmr_hox (:ncol,:), ncol, lchnk ) + call outfld( 'NOY_SRF', vmr_noy(:ncol,pver), ncol, lchnk ) + call outfld( 'CLOX', vmr_clox (:ncol,:), ncol, lchnk ) + call outfld( 'CLOY', vmr_cloy (:ncol,:), ncol, lchnk ) + call outfld( 'BROX', vmr_brox (:ncol,:), ncol, lchnk ) + call outfld( 'BROY', vmr_broy (:ncol,:), ncol, lchnk ) + call outfld( 'TCLY', vmr_tcly (:ncol,:), ncol, lchnk ) + call outfld( 'TBRY', vmr_tbry (:ncol,:), ncol, lchnk ) + call outfld( 'FOY', vmr_foy (:ncol,:), ncol, lchnk ) + call outfld( 'TFY', vmr_tfy (:ncol,:), ncol, lchnk ) + call outfld( 'TOTH', vmr_toth (:ncol,:), ncol, lchnk ) + + call outfld( 'NOY_mmr', mmr_noy(:ncol,:), ncol ,lchnk ) + call outfld( 'SOX_mmr', mmr_sox(:ncol,:), ncol ,lchnk ) + call outfld( 'NHX_mmr', mmr_nhx(:ncol,:), ncol ,lchnk ) + call outfld( 'dry_deposition_NOy_as_N', df_noy(:ncol), ncol ,lchnk ) + call outfld( 'DF_SOX', df_sox(:ncol), ncol ,lchnk ) + call outfld( 'dry_deposition_NHx_as_N', df_nhx(:ncol), ncol ,lchnk ) + if (gas_wetdep_method=='NEU') then + wd_noy(:ncol) = -wd_noy(:ncol) ! downward is possitive + wd_nhx(:ncol) = -wd_nhx(:ncol) + call outfld( 'wet_deposition_NOy_as_N', wd_noy(:ncol), ncol, lchnk ) + call outfld( 'wet_deposition_NHx_as_N', wd_nhx(:ncol), ncol, lchnk ) + end if + + nhx_nitrogen_flx = df_nhx + wd_nhx + noy_nitrogen_flx = df_noy + wd_noy + + !-------------------------------------------------------------------- + ! ... euv ion production + !-------------------------------------------------------------------- + + jeuvs: if ( has_jeuvs ) then + do k = 1,pver + un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h)) + wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(1)) + rxt_rates(:,k,rid_jeuv(2)) & + + rxt_rates(:,k,rid_jeuv(3)) + rxt_rates(:,k,rid_jeuv(14)) & + + rxt_rates(:,k,rid_jeuv(15)) + rxt_rates(:,k,rid_jeuv(16))) & + + vmr(:,k,id_n)*rxt_rates(:,k,rid_jeuv(4)) & + + vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(5)) + rxt_rates(:,k,rid_jeuv(7)) & + + rxt_rates(:,k,rid_jeuv(8)) + rxt_rates(:,k,rid_jeuv(9)) & + + rxt_rates(:,k,rid_jeuv(17)) + rxt_rates(:,k,rid_jeuv(19)) & + + rxt_rates(:,k,rid_jeuv(20)) + rxt_rates(:,k,rid_jeuv(21))) & + + un2(:)*(rxt_rates(:,k,rid_jeuv(6)) + rxt_rates(:,k,rid_jeuv(10)) & + + rxt_rates(:,k,rid_jeuv(11)) + rxt_rates(:,k,rid_jeuv(18)) & + + rxt_rates(:,k,rid_jeuv(22)) + rxt_rates(:,k,rid_jeuv(23))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PION_EUV', wrk, ncol, lchnk ) + + do k = 1,pver + wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(1)) + rxt_rates(:,k,rid_jeuv(2)) & + + rxt_rates(:,k,rid_jeuv(3))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV1', wrk, ncol, lchnk ) + do k = 1,pver + wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(14)) + rxt_rates(:,k,rid_jeuv(15)) & + + rxt_rates(:,k,rid_jeuv(16))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV1e', wrk, ncol, lchnk ) + do k = 1,pver + wrk(:,k) = vmr(:,k,id_n)*rxt_rates(:,k,rid_jeuv(4)) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV2', wrk, ncol, lchnk ) + do k = 1,pver + wrk(:,k) = vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(5)) + rxt_rates(:,k,rid_jeuv(7)) & + + rxt_rates(:,k,rid_jeuv(8)) + rxt_rates(:,k,rid_jeuv(9))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV3', wrk, ncol, lchnk ) + do k = 1,pver + wrk(:,k) = vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(17)) + rxt_rates(:,k,rid_jeuv(19)) & + + rxt_rates(:,k,rid_jeuv(20)) + rxt_rates(:,k,rid_jeuv(21))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV3e', wrk, ncol, lchnk ) + do k = 1,pver + un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h)) + wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(6)) + rxt_rates(:,k,rid_jeuv(10)) + rxt_rates(:,k,rid_jeuv(11))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV4', wrk, ncol, lchnk ) + do k = 1,pver + un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h)) + wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(18)) + rxt_rates(:,k,rid_jeuv(22)) + rxt_rates(:,k,rid_jeuv(23))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUV4e', wrk, ncol, lchnk ) + do k = 1,pver + un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h)) + wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(11)) + rxt_rates(:,k,rid_jeuv(13))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUVN2D', wrk, ncol, lchnk ) + do k = 1,pver + un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h)) + wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(23)) + rxt_rates(:,k,rid_jeuv(25))) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PEUVN2De', wrk, ncol, lchnk ) + endif jeuvs + + if ( has_jno_i ) then + do k = 1,pver + wrk(:,k) = vmr(:,k,id_no)*rxt_rates(:,k,rid_jno_i) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PJNO_I', wrk, ncol, lchnk ) + endif + if ( has_jno ) then + do k = 1,pver + wrk(:,k) = vmr(:,k,id_no)*rxt_rates(:,k,rid_jno) + wrk(:,k) = wrk(:,k) * invariants(:,k,indexm) + end do + call outfld( 'PJNO', wrk, ncol, lchnk ) + endif + + call species_sums_output(vmr, mmr, ncol, lchnk) + + end subroutine chm_diags + + subroutine het_diags( het_rates, mmr, pdel, lchnk, ncol ) + + use cam_history, only : outfld + use phys_grid, only : get_wght_all_p + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) + real(r8), intent(in) :: mmr(ncol,pver,gas_pcnst) + real(r8), intent(in) :: pdel(ncol,pver) + + real(r8), dimension(ncol) :: noy_wk, sox_wk, nhx_wk, wrk_wd + integer :: m, k + real(r8) :: wght(ncol) + ! + ! output integrated wet deposition field + ! + noy_wk(:) = 0._r8 + sox_wk(:) = 0._r8 + nhx_wk(:) = 0._r8 + + call get_wght_all_p(lchnk, ncol, wght) + + do m = 1,gas_pcnst + ! + ! compute vertical integral + ! + wrk_wd(:ncol) = 0._r8 + do k = 1,pver + wrk_wd(:ncol) = wrk_wd(:ncol) + het_rates(:ncol,k,m) * mmr(:ncol,k,m) * pdel(:ncol,k) + end do + ! + wrk_wd(:ncol) = wrk_wd(:ncol) * rgrav * wght(:ncol) * rearth**2 + ! + if (gas_wetdep_method=='MOZ') then + call outfld( wetdep_name(m), wrk_wd(:ncol), ncol, lchnk ) + call outfld( wtrate_name(m), het_rates(:ncol,:,m), ncol, lchnk ) + + if ( any(noy_species == m ) ) then + noy_wk(:ncol) = noy_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m) + endif + if ( m == id_n2o5 ) then ! 2 NOy molecules in N2O5 + noy_wk(:ncol) = noy_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m) + endif + if ( any(sox_species == m ) ) then + sox_wk(:ncol) = sox_wk(:ncol) + wrk_wd(:ncol)*S_molwgt/adv_mass(m) + endif + if ( any(nhx_species == m ) ) then + nhx_wk(:ncol) = nhx_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m) + endif + endif + end do + if (gas_wetdep_method=='MOZ') then + call outfld( 'wet_deposition_NOy_as_N', noy_wk(:ncol), ncol, lchnk ) + call outfld( 'WD_SOX', sox_wk(:ncol), ncol, lchnk ) + call outfld( 'wet_deposition_NHx_as_N', nhx_wk(:ncol), ncol, lchnk ) + endif + + end subroutine het_diags + +end module mo_chm_diags diff --git a/src/chemistry/mozart/mo_cph.F90 b/src/chemistry/mozart/mo_cph.F90 new file mode 100644 index 0000000000..18e384bb48 --- /dev/null +++ b/src/chemistry/mozart/mo_cph.F90 @@ -0,0 +1,166 @@ +!--------------------------------------------------------------------- +! ... compute chemical potential heating +!--------------------------------------------------------------------- + +module mo_cph + + use shr_kind_mod,only : r8 => shr_kind_r8 + use chem_mods, only : ncph=>enthalpy_cnt, exotherm=>cph_enthalpy, cph_rid + + implicit none + + save + + !============================================================== + !... Doug Kinnison, dkin@ucar.edu + ! + !... Enthalpy Data are taken from Atkinson et al., + ! Evaluated kinetic and photochemical data for atmospheric + ! chemistry: Volume I, Atmos. Chem. Phys., 4, 1461-1738. + !... Heats of formation at 0K. + !... Units: kJ mol-1 + ! + !... Exception to the Atkinson et al. reference (@0K unless noted) + ! (4), (5), (8), (9), (10, (11), (14), (15), (27), (28) at 298K + ! (7) h + o2 -> oh + o2 is multiplied by 0.6 (Mlynczak) to represent + ! AG loss of excited OH. + ! (25) n2d + o2 -> no + o1d taken from Roble, UMLT, Johnson and Killeen. + ! (26) n2d + o -> n + o taken from Roble, UMLT, Johnson and Killeen. + ! (30-41) Taken from Roble, UMLT, Johnson and Killeen Ed., Geophys. Mono. 87 + !============================================================== + !... Enthalpy Data are specified in preprocessor input mechanism file + !... F Vitt -- 29 Oct 2013 + !============================================================== + + private + public :: cph, init_cph + + logical :: has_cph + character(len=24) :: fldnames(ncph) + logical, parameter :: debug = .false. + +contains + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine init_cph + + use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx + use cam_history, only : addfld, add_default + use chem_mods, only : rxt_tag_lst, rxt_tag_map, rxt_tag_cnt + use cam_abortutils, only : endrun + + implicit none + + character(len=64) :: longname + integer :: i, n, tagndx + + has_cph = ncph > 0 + + if (.not.has_cph) return + + if ( any(exotherm(:) == 0._r8) ) then + call endrun('init_cph: Enthalpies for chemical heating must be specified in mechanism file') + endif + + do i = 1,ncph + + findtagndx: do n = 1,rxt_tag_cnt + if ( rxt_tag_map(n) == cph_rid(i) ) then + tagndx = n + exit findtagndx + endif + enddo findtagndx + + if (debug) then + if ( i< 10 ) then + write(fldnames(i),fmt='("CPH",i1)') i + else if (i<100) then + write(fldnames(i),fmt='("CPH",i2)') i + else if (i<1000) then + write(fldnames(i),fmt='("CPH",i3)') i + endif + else + fldnames(i) = 'CPH_'//trim(rxt_tag_lst(tagndx)) + endif + + write( longname, fmt='(f12.6)') exotherm(i) + longname = trim(adjustl(longname))//' kcal/mol chem pot heating rate for rxtn '//trim(rxt_tag_lst(tagndx)) + call addfld( fldnames(i), (/ 'lev' /), 'I', 'K/s', trim(longname) ) + if (debug) then + call add_default( fldnames(i), 10, ' ' ) + endif + enddo + + call addfld( 'QCP', (/ 'lev' /), 'I', 'K/s', 'chem pot heating rate' ) + + end subroutine init_cph + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine cph( cph_tot, vmr, rxt, cp, mbar, kbot, ncol, lchnk ) + + !----------------------------------------------------------------------- + ! ... forms the chemical potential heating rates + !----------------------------------------------------------------------- + + use chem_mods, only : gas_pcnst, rxntot + use ppgrid, only : pver + use cam_history, only : outfld + use mo_rxt_rates_conv, only : set_rates + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: kbot ! bottom vert index + real(r8), intent(in) :: rxt(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: cp(ncol,pver) ! specific heat capacity (J/K/kg) + real(r8), intent(in) :: mbar(ncol,pver) ! atm mean mass (g/mole) + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) ! concentrations (mol/mol) + real(r8), intent(out) :: cph_tot(ncol,pver) ! total heating (K/s) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i, k + real(r8) :: tmp(ncol,pver) + real(r8) :: cph_rate(ncol,pver,ncph) + real(r8) :: rxt_rates(ncol,pver,rxntot) + + if (.not.has_cph) return + + ! get the reaction rates from rate constants ... + rxt_rates(:ncol,:,:) = rxt(:ncol,:,:) + call set_rates( rxt_rates, vmr, ncol ) + + ! compute corresponding chem heating rates ... + cph_rate(:,:,:) = 0._r8 + tmp(:ncol,:) = 1._r8 / (1.e-6_r8*cp(:ncol,:)*mbar(:ncol,:)) + do i = 1,ncph + cph_rate(:ncol,:,i) = tmp(:ncol,:) * rxt_rates(:ncol,:,cph_rid(i)) * exotherm(i) + enddo + + ! compute total heating rate ... + cph_tot(:,:) = 0._r8 + do k = 1,kbot + do i = 1,ncol + cph_tot(i,k) = sum( cph_rate(i,k,:) ) + end do + end do + + ! output diagnostics + do i = 1,ncph + if ( exotherm(i)>0._r8) then + call outfld( fldnames(i), cph_rate(:,:,i), ncol, lchnk ) + endif + enddo + + call outfld( 'QCP', cph_tot(:,:), ncol, lchnk ) + + end subroutine cph + +end module mo_cph diff --git a/src/chemistry/mozart/mo_drydep.F90 b/src/chemistry/mozart/mo_drydep.F90 new file mode 100644 index 0000000000..9241af802e --- /dev/null +++ b/src/chemistry/mozart/mo_drydep.F90 @@ -0,0 +1,3300 @@ +module mo_drydep + + !--------------------------------------------------------------------- + ! ... Dry deposition velocity input data and code for netcdf input + !--------------------------------------------------------------------- + +!LKE (10/11/2010): added HCN, CH3CN, HCOOH +!LKE (7/30/2015): added new TS1 species (phenooh, iepox, noa, etc.) + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use chem_mods, only : gas_pcnst + use pmgrid, only : plev, plevp + use spmd_utils, only : masterproc, iam + use ppgrid, only : pcols, begchunk, endchunk + use mo_tracname, only : solsym + use cam_abortutils, only : endrun + use ioFileMod, only : getfil + use pio + use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile + use cam_logfile, only : iulog + use dyn_grid, only : get_dyn_grid_parm, get_horiz_grid_d + use scamMod, only : single_column + + use seq_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping + use physconst, only : karman + + implicit none + + save + + interface drydep_inti + module procedure dvel_inti_table + module procedure dvel_inti_xactive + module procedure dvel_inti_fromlnd + end interface + + interface drydep + module procedure drydep_table + module procedure drydep_xactive + module procedure drydep_fromlnd + end interface + + private + public :: drydep_inti, drydep, set_soilw, chk_soilw, has_drydep + public :: drydep_update + public :: n_land_type, fraction_landuse, drydep_srf_file + + real(r8) :: dels + real(r8), allocatable :: days(:) ! day of year for soilw + real(r8), allocatable :: dvel(:,:,:,:) ! depvel array interpolated to model grid + real(r8), allocatable :: dvel_interp(:,:,:) ! depvel array interpolated to grid and time + integer :: last, next ! day indicies + integer :: ndays ! # of days in soilw file + integer :: map(gas_pcnst) ! indices for drydep species + integer :: nspecies ! number of depvel species in input file + + integer :: pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & + h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & + ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & + c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & + no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & + hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & + xooh_ndx, ch3cho_ndx, isopooh_ndx + integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx + integer :: soa_ndx, so4_ndx, cb1_ndx, cb2_ndx, oc1_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, & + sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx + integer :: soam_ndx, soai_ndx, soat_ndx, soab_ndx, soax_ndx, & + sogm_ndx, sogi_ndx, sogt_ndx, sogb_ndx, sogx_ndx + + logical :: alkooh_dd, mekooh_dd, tolooh_dd, terpooh_dd, ch3cooh_dd + logical :: soa_dd, so4_dd, cb1_dd, cb2_dd, oc1_dd, oc2_dd, nh3_dd, nh4no3_dd, & + sa1_dd, sa2_dd, sa3_dd, sa4_dd, nh4_dd + logical :: soam_dd, soai_dd, soat_dd, soab_dd, soax_dd, & + sogm_dd, sogi_dd, sogt_dd, sogb_dd, sogx_dd + + logical :: pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& + h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & + ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & + c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & + glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd + + integer :: so2_ndx + integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx + logical :: ch3cn_dd, hcn_dd, hcooh_dd + + integer :: o3a_ndx,xpan_ndx,xmpan_ndx,xno2_ndx,xhno3_ndx,xonit_ndx,xonitr_ndx,xno_ndx,xho2no2_ndx,xnh4no3_ndx + logical :: o3a_dd, xpan_dd, xmpan_dd, xno2_dd, xhno3_dd, xonit_dd, xonitr_dd, xno_dd, xho2no2_dd, xnh4no3_dd + +!lke-TS1 + integer :: phenooh_ndx, benzooh_ndx, c6h5ooh_ndx, bzooh_ndx, xylolooh_ndx, xylenooh_ndx + integer :: terp2ooh_ndx, terprod1_ndx, terprod2_ndx, hmprop_ndx, mboooh_ndx, hpald_ndx, iepox_ndx + integer :: noa_ndx, alknit_ndx, isopnita_ndx, isopnitb_ndx, honitr_ndx, isopnooh_ndx + integer :: nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx + logical :: phenooh_dd, benzooh_dd, c6h5ooh_dd, bzooh_dd, xylolooh_dd, xylenooh_dd + logical :: terp2ooh_dd, terprod1_dd, terprod2_dd, hmprop_dd, mboooh_dd, hpald_dd, iepox_dd + logical :: noa_dd, alknit_dd, isopnita_dd, isopnitb_dd, honitr_dd, isopnooh_dd + logical :: nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd + + integer :: cohc_ndx=-1, come_ndx=-1 + integer, parameter :: NTAGS = 50 + integer :: cotag_ndx(NTAGS) + integer :: tag_cnt + + integer :: & + o3_tab_ndx = -1, & + h2o2_tab_ndx = -1, & + ch3ooh_tab_ndx = -1, & + co_tab_ndx = -1, & + ch3cho_tab_ndx = -1 + logical :: & + o3_in_tab = .false., & + h2o2_in_tab = .false., & + ch3ooh_in_tab = .false., & + co_in_tab = .false., & + ch3cho_in_tab = .false. + + real(r8), parameter :: small_value = 1.e-36_r8 + real(r8), parameter :: large_value = 1.e36_r8 + real(r8), parameter :: diffm = 1.789e-5_r8 + real(r8), parameter :: diffk = 1.461e-5_r8 + real(r8), parameter :: difft = 2.060e-5_r8 + real(r8), parameter :: vonkar = karman + real(r8), parameter :: ric = 0.2_r8 + real(r8), parameter :: r = 287.04_r8 + real(r8), parameter :: cp = 1004._r8 + real(r8), parameter :: grav = 9.81_r8 + real(r8), parameter :: p00 = 100000._r8 + real(r8), parameter :: wh2o = 18.0153_r8 + real(r8), parameter :: ph = 1.e-5_r8 + real(r8), parameter :: ph_inv = 1._r8/ph + real(r8), parameter :: rovcp = r/cp + + integer, pointer :: index_season_lai(:,:) + + logical, public :: has_dvel(gas_pcnst) = .false. + integer :: map_dvel(gas_pcnst) = 0 + real(r8) , allocatable :: soilw_3d(:,:,:) + + logical, parameter :: dyn_soilw = .false. + + real(r8), allocatable :: fraction_landuse(:,:,:) + real(r8), allocatable, dimension(:,:,:) :: dep_ra ! [s/m] aerodynamic resistance + real(r8), allocatable, dimension(:,:,:) :: dep_rb ! [s/m] resistance across sublayer + integer, parameter :: n_land_type = 11 + + integer, allocatable :: spc_ndx(:) ! nddvels + real(r8), public :: crb + + type lnd_dvel_type + real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s) + end type lnd_dvel_type + + type(lnd_dvel_type), allocatable :: lnd(:) + character(len=SHR_KIND_CL) :: drydep_srf_file + +contains + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine dvel_inti_fromlnd + use mo_chem_utls, only : get_spc_ndx + use cam_abortutils, only : endrun + use chem_mods, only : adv_mass + use seq_drydep_mod, only : dfoxd + + implicit none + + integer :: ispc, l + + allocate(spc_ndx(nddvels)) + allocate( lnd(begchunk:endchunk) ) + + do ispc = 1,nddvels + + spc_ndx(ispc) = get_spc_ndx(drydep_list(ispc)) + if (spc_ndx(ispc) < 1) then + write(*,*) 'drydep_inti: '//trim(drydep_list(ispc))//' is not included in species set' + call endrun('drydep_init: invalid dry deposition species') + endif + + enddo + + crb = (difft/diffm)**(2._r8/3._r8) !.666666_r8 + + endsubroutine dvel_inti_fromlnd + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_update( state, cam_in ) + use physics_types, only : physics_state + use camsrfexch, only : cam_in_t + use seq_drydep_mod, only : drydep_method, DD_XLND + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in + + if (nddvels<1) return + if (drydep_method /= DD_XLND) return + + lnd(state%lchnk)%dvel => cam_in%depvel + + end subroutine drydep_update + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_fromlnd( ocnfrac, icefrac, ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, dvelocity, dflx, mmr, & + tv, soilw, rh, ncol, lonndx, latndx, lchnk ) + + !------------------------------------------------------------------------------------- + ! combines the deposition velocities provided by the land model with deposition + ! velocities over ocean and sea ice + !------------------------------------------------------------------------------------- + + use ppgrid, only : pcols + use chem_mods, only : gas_pcnst + +#if (defined OFFLINE_DYN) + use metdata, only: get_met_fields +#endif + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + + real(r8), intent(in) :: icefrac(pcols) + real(r8), intent(in) :: ocnfrac(pcols) + + integer, intent(in) :: ncol + integer, intent(in) :: ncdate ! present date (yyyymmdd) + real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) + real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) + real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) + real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) + real(r8), intent(in) :: rh(ncol,1) ! relative humidity + real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) + real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) + real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: snow(pcols) ! snow height (m) + real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction + real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) + real(r8), intent(in) :: tv(pcols) ! potential temperature + real(r8), intent(in) :: mmr(pcols,plev,gas_pcnst) ! constituent concentration (kg/kg) + real(r8), intent(out) :: dvelocity(ncol,gas_pcnst) ! deposition velocity (cm/s) + real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! deposition flux (/cm^2/s) + + integer, intent(in) :: latndx(pcols) ! chunk latitude indicies + integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies + integer, intent(in) :: lchnk ! chunk number + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8) :: ocnice_dvel(ncol,gas_pcnst) + real(r8) :: ocnice_dflx(pcols,gas_pcnst) + + real(r8), dimension(ncol) :: term ! work array + integer :: ispec + real(r8) :: lndfrac(pcols) +#if (defined OFFLINE_DYN) + real(r8) :: met_ocnfrac(pcols) + real(r8) :: met_icefrac(pcols) +#endif + integer :: i + + lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol) + + where( lndfrac(:ncol) < 0._r8 ) + lndfrac(:ncol) = 0._r8 + endwhere + +#if (defined OFFLINE_DYN) + call get_met_fields(lndfrac, met_ocnfrac, met_icefrac, lchnk, ncol) +#endif + + !------------------------------------------------------------------------------------- + ! ... initialize + !------------------------------------------------------------------------------------- + dvelocity(:,:) = 0._r8 + + !------------------------------------------------------------------------------------- + ! ... compute the dep velocities over ocean and sea ice + ! land type 7 is used for ocean + ! land type 8 is used for sea ice + !------------------------------------------------------------------------------------- + call drydep_xactive( ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, ocnice_dvel, ocnice_dflx, mmr, & + tv, soilw, rh, ncol, lonndx, latndx, lchnk, & +#if (defined OFFLINE_DYN) + ocnfrc=met_ocnfrac,icefrc=met_icefrac, beglandtype=7, endlandtype=8 ) +#else + ocnfrc=ocnfrac,icefrc=icefrac, beglandtype=7, endlandtype=8 ) +#endif + term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) + + do ispec = 1,nddvels + !------------------------------------------------------------------------------------- + ! ... merge the land component with the non-land component + ! ocn and ice already have fractions factored in + !------------------------------------------------------------------------------------- + dvelocity(:ncol,spc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) & + + ocnice_dvel(:ncol,spc_ndx(ispec)) + enddo + + !------------------------------------------------------------------------------------- + ! ... special adjustments + !------------------------------------------------------------------------------------- + if( mpan_ndx>0 ) then + dvelocity(:ncol,mpan_ndx) = dvelocity(:ncol,mpan_ndx)/3._r8 + endif + if( xmpan_ndx>0 ) then + dvelocity(:ncol,xmpan_ndx) = dvelocity(:ncol,xmpan_ndx)/3._r8 + endif + if( hcn_ndx>0 ) then + dvelocity(:ncol,hcn_ndx) = ocnice_dvel(:ncol,hcn_ndx) ! should be zero over land + endif + if( ch3cn_ndx>0 ) then + dvelocity(:ncol,ch3cn_ndx) = ocnice_dvel(:ncol,ch3cn_ndx) ! should be zero over land + endif + + ! HCOOH, use CH3COOH dep.vel + if( hcooh_ndx > 0 .and. ch3cooh_ndx > 0 ) then + if( has_dvel(hcooh_ndx) ) then + dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx) + end if + end if + + !------------------------------------------------------------------------------------- + ! ... assign CO tags to CO + ! put this kludge in for now ... + ! -- should be able to set all these via the table mapping in seq_drydep_mod + !------------------------------------------------------------------------------------- + if( cohc_ndx>0 .and. co_ndx>0 ) then + dvelocity(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) + dflx(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,cohc_ndx) + endif + if( come_ndx>0 .and. co_ndx>0 ) then + dvelocity(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) + dflx(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,come_ndx) + endif + + if ( co_ndx>0 ) then + do i=1,tag_cnt + dvelocity(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) + dflx(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,cotag_ndx(i)) + enddo + endif + + do ispec = 1,nddvels + !------------------------------------------------------------------------------------- + ! ... compute the deposition flux + !------------------------------------------------------------------------------------- + dflx(:ncol,spc_ndx(ispec)) = dvelocity(:ncol,spc_ndx(ispec)) * term(:ncol) * mmr(:ncol,plev,spc_ndx(ispec)) + end do + + end subroutine drydep_fromlnd + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine dvel_inti_table( depvel_file ) + !--------------------------------------------------------------------------- + ! ... Initialize module, depvel arrays, and a few other variables. + ! The depvel fields will be linearly interpolated to the correct time + !--------------------------------------------------------------------------- + + use mo_constants, only : d2r, r2d + use ioFileMod, only : getfil + use string_utils, only : to_lower, GLC + use mo_chem_utls, only : get_spc_ndx + use constituents, only : pcnst + use interpolate_data, only : lininterp_init, lininterp, lininterp_finish,interp_type + use mo_constants, only : pi + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + + implicit none + + character(len=*), intent(in) :: depvel_file + + !--------------------------------------------------------------------------- + ! ... Local variables + !--------------------------------------------------------------------------- + integer :: nlat, nlon, nmonth, ndims + integer :: dimid_lat, dimid_lon, dimid_species, dimid_time + integer :: dimid(4), count(4), start(4) + integer :: m, ispecies, nchar, ierr + real(r8) :: scale_factor + + real(r8), allocatable :: dvel_lats(:), dvel_lons(:) + real(r8), allocatable :: dvel_in(:,:,:,:) ! input depvel array + character(len=50) :: units + character(len=20), allocatable :: species_names(:) ! names of depvel species + logical :: found + type(file_desc_t) :: piofile + type(var_desc_t) :: vid, vid_dvel + + character(len=shr_kind_cl) :: locfn + integer :: mm,n + + integer :: i, c, ncols + real(r8) :: to_lats(pcols), to_lons(pcols) + type(interp_type) :: lon_wgts, lat_wgts + real(r8), parameter :: zero=0._r8, twopi=2._r8*pi + + mm = 1 + do m = 1,pcnst + if ( len_trim(drydep_list(m))==0 ) exit + n = get_spc_ndx(drydep_list(m)) + if ( n < 1 ) then + write(iulog,*) 'drydep_inti: '//drydep_list(m)//' is not included in species set' + call endrun('drydep_init: invalid dry deposition species') + endif + enddo + + if( masterproc ) then + write(iulog,*) 'drydep_inti: following species have dry deposition' + do i=1,nddvels + if( len_trim(drydep_list(i)) > 0 ) then + write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' + endif + enddo + write(iulog,*) 'drydep_inti:' + endif + + if ( nddvels < 1 ) return + + !--------------------------------------------------------------------------- + ! ... Setup species maps + !--------------------------------------------------------------------------- + o3a_ndx = get_spc_ndx( 'O3A') + xpan_ndx = get_spc_ndx( 'XPAN') + xmpan_ndx = get_spc_ndx( 'XMPAN') + xno2_ndx = get_spc_ndx( 'XNO2') + xhno3_ndx = get_spc_ndx( 'XHNO3') + xonit_ndx = get_spc_ndx( 'XONIT') + xonitr_ndx = get_spc_ndx( 'XONITR') + xno_ndx = get_spc_ndx( 'XNO') + xho2no2_ndx = get_spc_ndx( 'XHO2NO2') + o3a_dd = has_drydep( 'O3A') + xpan_dd = has_drydep( 'XPAN') + xmpan_dd = has_drydep( 'XMPAN') + xno2_dd = has_drydep( 'XNO2') + xhno3_dd = has_drydep( 'XHNO3') + xonit_dd = has_drydep( 'XONIT') + xonitr_dd = has_drydep( 'XONITR') + xno_dd = has_drydep( 'XNO') + xho2no2_dd = has_drydep( 'XHO2NO2') + + pan_ndx = get_spc_ndx( 'PAN') + mpan_ndx = get_spc_ndx( 'MPAN') + no2_ndx = get_spc_ndx( 'NO2') + hno3_ndx = get_spc_ndx( 'HNO3') + co_ndx = get_spc_ndx( 'CO') + o3_ndx = get_spc_ndx( 'O3') + if( o3_ndx < 1 ) then + o3_ndx = get_spc_ndx( 'OX') + end if + h2o2_ndx = get_spc_ndx( 'H2O2') + onit_ndx = get_spc_ndx( 'ONIT') + onitr_ndx = get_spc_ndx( 'ONITR') + ch4_ndx = get_spc_ndx( 'CH4') + ch2o_ndx = get_spc_ndx( 'CH2O') + ch3ooh_ndx = get_spc_ndx( 'CH3OOH') + ch3cho_ndx = get_spc_ndx( 'CH3CHO') + ch3cocho_ndx = get_spc_ndx( 'CH3COCHO') + pooh_ndx = get_spc_ndx( 'POOH') + ch3coooh_ndx = get_spc_ndx( 'CH3COOOH') + c2h5ooh_ndx = get_spc_ndx( 'C2H5OOH') + eooh_ndx = get_spc_ndx( 'EOOH') + c3h7ooh_ndx = get_spc_ndx( 'C3H7OOH') + rooh_ndx = get_spc_ndx( 'ROOH') + ch3coch3_ndx = get_spc_ndx( 'CH3COCH3') + no_ndx = get_spc_ndx( 'NO') + ho2no2_ndx = get_spc_ndx( 'HO2NO2') + glyald_ndx = get_spc_ndx( 'GLYALD') + hyac_ndx = get_spc_ndx( 'HYAC') + ch3oh_ndx = get_spc_ndx( 'CH3OH') + c2h5oh_ndx = get_spc_ndx( 'C2H5OH') + macrooh_ndx = get_spc_ndx( 'MACROOH') + isopooh_ndx = get_spc_ndx( 'ISOPOOH') + xooh_ndx = get_spc_ndx( 'XOOH') + hydrald_ndx = get_spc_ndx( 'HYDRALD') + h2_ndx = get_spc_ndx( 'H2') + Pb_ndx = get_spc_ndx( 'Pb') + o3s_ndx = get_spc_ndx( 'O3S') + o3inert_ndx = get_spc_ndx( 'O3INERT') + alkooh_ndx = get_spc_ndx( 'ALKOOH') + mekooh_ndx = get_spc_ndx( 'MEKOOH') + tolooh_ndx = get_spc_ndx( 'TOLOOH') + terpooh_ndx = get_spc_ndx( 'TERPOOH') + ch3cooh_ndx = get_spc_ndx( 'CH3COOH') + soam_ndx = get_spc_ndx( 'SOAM' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + sogm_ndx = get_spc_ndx( 'SOGM' ) + sogi_ndx = get_spc_ndx( 'SOGI' ) + sogt_ndx = get_spc_ndx( 'SOGT' ) + sogb_ndx = get_spc_ndx( 'SOGB' ) + sogx_ndx = get_spc_ndx( 'SOGX' ) + soa_ndx = get_spc_ndx( 'SOA' ) + so4_ndx = get_spc_ndx( 'SO4' ) + cb1_ndx = get_spc_ndx( 'CB1' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + nh3_ndx = get_spc_ndx( 'NH3' ) + nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) + xnh4no3_ndx = get_spc_ndx( 'XNH4NO3' ) + sa1_ndx = get_spc_ndx( 'SA1' ) + sa2_ndx = get_spc_ndx( 'SA2' ) + sa3_ndx = get_spc_ndx( 'SA3' ) + sa4_ndx = get_spc_ndx( 'SA4' ) + nh4_ndx = get_spc_ndx( 'NH4' ) + alkooh_dd = has_drydep( 'ALKOOH') + mekooh_dd = has_drydep( 'MEKOOH') + tolooh_dd = has_drydep( 'TOLOOH') + terpooh_dd = has_drydep( 'TERPOOH') + ch3cooh_dd = has_drydep( 'CH3COOH') + soam_dd = has_drydep( 'SOAM' ) + soai_dd = has_drydep( 'SOAI' ) + soat_dd = has_drydep( 'SOAT' ) + soab_dd = has_drydep( 'SOAB' ) + soax_dd = has_drydep( 'SOAX' ) + sogm_dd = has_drydep( 'SOGM' ) + sogi_dd = has_drydep( 'SOGI' ) + sogt_dd = has_drydep( 'SOGT' ) + sogb_dd = has_drydep( 'SOGB' ) + sogx_dd = has_drydep( 'SOGX' ) + soa_dd = has_drydep( 'SOA' ) + so4_dd = has_drydep( 'SO4' ) + cb1_dd = has_drydep( 'CB1' ) + cb2_dd = has_drydep( 'CB2' ) + oc1_dd = has_drydep( 'OC1' ) + oc2_dd = has_drydep( 'OC2' ) + nh3_dd = has_drydep( 'NH3' ) + nh4no3_dd = has_drydep( 'NH4NO3' ) + xnh4no3_dd = has_drydep( 'XNH4NO3' ) + sa1_dd = has_drydep( 'SA1' ) + sa2_dd = has_drydep( 'SA2' ) + sa3_dd = has_drydep( 'SA3' ) + sa4_dd = has_drydep( 'SA4' ) + nh4_dd = has_drydep( 'NH4' ) + pan_dd = has_drydep( 'PAN') + mpan_dd = has_drydep( 'MPAN') + no2_dd = has_drydep( 'NO2') + hno3_dd = has_drydep( 'HNO3') + co_dd = has_drydep( 'CO') + o3_dd = has_drydep( 'O3') + if( .not. o3_dd ) then + o3_dd = has_drydep( 'OX') + end if + h2o2_dd = has_drydep( 'H2O2') + onit_dd = has_drydep( 'ONIT') + onitr_dd = has_drydep( 'ONITR') + ch4_dd = has_drydep( 'CH4') + ch2o_dd = has_drydep( 'CH2O') + ch3ooh_dd = has_drydep( 'CH3OOH') + ch3cho_dd = has_drydep( 'CH3CHO') + c2h5oh_dd = has_drydep( 'C2H5OH') + eooh_dd = has_drydep( 'EOOH') + ch3cocho_dd = has_drydep( 'CH3COCHO') + pooh_dd = has_drydep( 'POOH') + ch3coooh_dd = has_drydep( 'CH3COOOH') + c2h5ooh_dd = has_drydep( 'C2H5OOH') + c3h7ooh_dd = has_drydep( 'C3H7OOH') + rooh_dd = has_drydep( 'ROOH') + ch3coch3_dd = has_drydep( 'CH3COCH3') + glyald_dd = has_drydep( 'GLYALD') + hyac_dd = has_drydep( 'HYAC') + ch3oh_dd = has_drydep( 'CH3OH') + macrooh_dd = has_drydep( 'MACROOH') + isopooh_dd = has_drydep( 'ISOPOOH') + xooh_dd = has_drydep( 'XOOH') + hydrald_dd = has_drydep( 'HYDRALD') + h2_dd = has_drydep( 'H2') + Pb_dd = has_drydep( 'Pb') + o3s_dd = has_drydep( 'O3S') + o3inert_dd = has_drydep( 'O3INERT') + ch3cn_dd = has_drydep( 'CH3CN') + hcn_dd = has_drydep( 'HCN') + hcooh_dd = has_drydep( 'HCOOH') + ch3cn_ndx = get_spc_ndx( 'CH3CN') + hcn_ndx = get_spc_ndx( 'HCN') + hcooh_ndx = get_spc_ndx( 'HCOOH' ) + + if( masterproc ) then + write(iulog,*) 'dvel_inti: diagnostics' + write(iulog,'(10i5)') pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & + h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & + ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & + c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & + no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & + hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & + xooh_ndx, ch3cho_ndx, isopooh_ndx, noa_ndx, alknit_ndx, isopnita_ndx, & + honitr_ndx, isopnooh_ndx, nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx + write(iulog,*) pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& + h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & + ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & + c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & + glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd, & + noa_dd, alknit_dd, isopnita_dd, & + honitr_dd, isopnooh_dd, nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd + endif + !--------------------------------------------------------------------------- + ! ... Open NetCDF file + !--------------------------------------------------------------------------- + call getfil (depvel_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + + !--------------------------------------------------------------------------- + ! ... Get variable ID for dep vel array + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'dvel', vid_dvel ) + + !--------------------------------------------------------------------------- + ! ... Inquire about dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) + ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) + ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) + ierr = pio_inq_dimid( piofile, 'species', dimid_species ) + ierr = pio_inq_dimlen( piofile, dimid_species, nspecies ) + ierr = pio_inq_dimid( piofile, 'time', dimid_time ) + ierr = pio_inq_dimlen( piofile, dimid_time, nmonth ) + if(masterproc) write(iulog,*) 'dvel_inti: dimensions (nlon,nlat,nspecies,nmonth) = ',nlon,nlat,nspecies,nmonth + + !--------------------------------------------------------------------------- + ! ... Check dimensions of dvel variable. Must be (lon, lat, species, month). + !--------------------------------------------------------------------------- + ierr = pio_inq_varndims( piofile, vid_dvel, ndims ) + + if( masterproc .and. ndims /= 4 ) then + write(iulog,*) 'dvel_inti: dvel has ',ndims,' dimensions. Expecting 4.' + call endrun + end if + ierr = pio_inq_vardimid( piofile, vid_dvel, dimid ) + + if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. & + dimid(3) /= dimid_species .or. dimid(4) /= dimid_time ) then + write(iulog,*) 'dvel_inti: Dimensions in wrong order for dvel' + write(iulog,*) '... Expecting (lon, lat, species, month)' + call endrun + end if + + !--------------------------------------------------------------------------- + ! ... Allocate depvel lats, lons and read + !--------------------------------------------------------------------------- + allocate( dvel_lats(nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_lats vector' + call endrun + end if + allocate( dvel_lons(nlon), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_lons vector' + call endrun + end if + + ierr = pio_inq_varid( piofile, 'lat', vid ) + ierr = pio_get_var( piofile, vid, dvel_lats ) + ierr = pio_inq_varid( piofile, 'lon', vid ) + ierr = pio_get_var( piofile, vid, dvel_lons ) + + !--------------------------------------------------------------------------- + ! ... Set the transform from inputs lats to simulation lats + !--------------------------------------------------------------------------- + dvel_lats(:nlat) = d2r * dvel_lats(:nlat) + dvel_lons(:nlon) = d2r * dvel_lons(:nlon) + + !--------------------------------------------------------------------------- + ! ... Allocate dvel and read data from file + !--------------------------------------------------------------------------- + allocate( dvel_in(nlon, nlat ,nspecies, nmonth), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_in' + call endrun + end if + start = (/ 1, 1, 1, 1 /) + count = (/ nlon, nlat, nspecies, nmonth /) + + ierr = pio_get_var( piofile, vid_dvel, start, count, dvel_in ) + + + !--------------------------------------------------------------------------- + ! ... Check units of deposition velocity. If necessary, convert to cm/s. + !--------------------------------------------------------------------------- + units(:) = ' ' + ierr = pio_get_att( piofile, vid_dvel, 'units', units ) + if( to_lower(trim(units(:GLC(units)))) == 'm/s' ) then +#ifdef DEBUG + if(masterproc) write(iulog,*) 'dvel_inti: depvel units = m/s. Converting to cm/s' +#endif + scale_factor = 100._r8 + elseif( to_lower(trim(units(:GLC(units)))) == 'cm/s' ) then +#ifdef DEBUG + if(masterproc) write(iulog,*) 'dvel_inti: depvel units = cm/s' +#endif + scale_factor = 1._r8 + else +#ifdef DEBUG + if(masterproc) then + write(iulog,*) 'dvel_inti: Warning! depvel units unknown = ', to_lower(trim(units)) + write(iulog,*) ' ... proceeding with scale_factor=1' + end if +#endif + scale_factor = 1._r8 + end if + + dvel_in(:,:,:,:) = scale_factor*dvel_in(:,:,:,:) + + !--------------------------------------------------------------------------- + ! ... Regrid deposition velocities + !--------------------------------------------------------------------------- + allocate( dvel(pcols,begchunk:endchunk,nspecies,nmonth),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel' + call endrun + end if + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + call lininterp_init(dvel_lons, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(dvel_lats, nlat, to_lats, ncols, 1, lat_wgts) + + do ispecies = 1,nspecies + do m = 1,12 + call lininterp( dvel_in( :,:,ispecies,m ), nlon, nlat, dvel(:,c,ispecies,m), ncols,lon_wgts,lat_wgts) + end do + end do + + call lininterp_finish(lat_wgts) + call lininterp_finish(lon_wgts) + end do + + deallocate( dvel_in ) + deallocate( dvel_lats, dvel_lons ) + + !--------------------------------------------------------------------------- + ! ... Read in species names and determine mapping to tracer numbers + !--------------------------------------------------------------------------- + allocate( species_names(nspecies), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: species_names allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( piofile, 'species_name', vid ) + ierr = pio_inq_varndims( piofile, vid, ndims ) + + ierr = pio_inq_vardimid( piofile, vid, dimid ) + + ierr = pio_inq_dimlen( piofile, dimid(1), nchar ) + map(:) = 0 + do ispecies = 1,nspecies + start(:2) = (/ 1, ispecies /) + count(:2) = (/ nchar, 1 /) + species_names(ispecies)(:) = ' ' + ierr = pio_get_var( piofile, vid, start(1:2), count(1:2), species_names(ispecies:ispecies) ) + if( species_names(ispecies) == 'O3' ) then + o3_in_tab = .true. + o3_tab_ndx = ispecies + else if( species_names(ispecies) == 'H2O2' ) then + h2o2_in_tab = .true. + h2o2_tab_ndx = ispecies + else if( species_names(ispecies) == 'CH3OOH' ) then + ch3ooh_in_tab = .true. + ch3ooh_tab_ndx = ispecies + else if( species_names(ispecies) == 'CO' ) then + co_in_tab = .true. + co_tab_ndx = ispecies + else if( species_names(ispecies) == 'CH3CHO' ) then + ch3cho_in_tab = .true. + ch3cho_tab_ndx = ispecies + end if + found = .false. + do m = 1,gas_pcnst + if( species_names(ispecies) == solsym(m) .or. & + (species_names(ispecies) == 'O3' .and. solsym(m) == 'OX') .or. & + (species_names(ispecies) == 'HNO4' .and. solsym(m) == 'HO2NO2') ) then + if ( has_drydep( solsym(m) ) ) then + map(m) = ispecies + found = .true. +#ifdef DEBUG + if( masterproc ) then + write(iulog,*) 'dvel_inti: ispecies, m, tracnam = ',ispecies,m,trim(solsym(m)) + end if +#endif + exit + end if + end if + end do + if( .not. found ) then + write(iulog,*) 'dvel_inti: Warning! DVEL species ',trim(species_names(ispecies)),' not found' + endif + end do + deallocate( species_names ) + + call cam_pio_closefile( piofile ) + + !--------------------------------------------------------------------------- + ! ... Allocate dvel_interp array + !--------------------------------------------------------------------------- + allocate( dvel_interp(pcols,begchunk:endchunk,nspecies),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_interp; error = ',ierr + call endrun + end if + + end subroutine dvel_inti_table + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine interpdvel( calday, ncol, lchnk ) + !--------------------------------------------------------------------------- + ! ... Interpolate the fields whose values are required at the + ! begining of a timestep. + !--------------------------------------------------------------------------- + + use time_manager, only : get_calday + + implicit none + + !--------------------------------------------------------------------------- + ! ... Dummy arguments + !--------------------------------------------------------------------------- + real(r8), intent(in) :: calday ! Interpolate the input data to calday + integer, intent(in) :: ncol, lchnk + + !--------------------------------------------------------------------------- + ! ... Local variables + !--------------------------------------------------------------------------- + integer :: m, last, next + integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + real(r8) :: calday_loc, last_days, next_days + real(r8), save :: dys(12) + logical, save :: entered = .false. + + if( .not. entered ) then + do m = 1,12 + dys(m) = get_calday( dates(m), 0 ) + end do + entered = .true. + end if + + if( calday < dys(1) ) then + next = 1 + last = 12 + else if( calday >= dys(12) ) then + next = 1 + last = 12 + else + do m = 11,1,-1 + if( calday >= dys(m) ) then + exit + end if + end do + last = m + next = m + 1 + end if + + last_days = dys( last ) + next_days = dys( next ) + calday_loc = calday + + if( next_days < last_days ) then + next_days = next_days + 365._r8 + end if + if( calday_loc < last_days ) then + calday_loc = calday_loc + 365._r8 + end if + + do m = 1,nspecies + call intp2d( last_days, next_days, calday_loc, ncol, lchnk, & + dvel(:,lchnk,m,last), & + dvel(:,lchnk,m,next), & + dvel_interp(:,lchnk,m) ) + end do + + end subroutine interpdvel + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine intp2d( t1, t2, tint, ncol, lchnk, f1, f2, fint ) + !----------------------------------------------------------------------- + ! ... Linearly interpolate between f1(t1) and f2(t2) to fint(tint). + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + real(r8), intent(in) :: & + t1, & ! time level of f1 + t2, & ! time level of f2 + tint ! interpolant time + real(r8), dimension(pcols), intent(in) :: & + f1, & ! field at time t1 + f2 ! field at time t2 + + integer, intent(in) :: ncol, lchnk + + real(r8), intent(out) :: & + fint(pcols) ! field at time tint + + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + real(r8) :: factor + + factor = (tint - t1)/(t2 - t1) + + fint(:ncol) = f1(:ncol) + (f2(:ncol) - f1(:ncol))*factor + + end subroutine intp2d + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_table( calday, tsurf, zen_angle, & + depvel, dflx, q, p, & + tv, ncol, icefrac, ocnfrac, lchnk ) + !-------------------------------------------------------- + ! ... Form the deposition velocities for this + ! latitude slice + !-------------------------------------------------------- + + use physconst, only : rair,pi + use dycore, only : dycore_is + + implicit none + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: q(pcols,plev,gas_pcnst) ! tracer mmr (kg/kg) + real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) + real(r8), intent(in) :: tv(pcols) ! virtual temperature in surface layer (K) + real(r8), intent(in) :: calday ! time of year in days + real(r8), intent(in) :: tsurf(pcols) ! surface temperature (K) + real(r8), intent(in) :: zen_angle(ncol) ! zenith angle (radians) + real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! flux due to dry deposition (kg/m^2/sec) + real(r8), intent(out) :: depvel(ncol,gas_pcnst) ! deposition vel (cm/s) + + real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction + real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction + + integer, intent(in) :: lchnk + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, i + real(r8), dimension(ncol) :: vel, glace, temp_fac, wrk, tmp + real(r8), dimension(ncol) :: o3_tab_dvel + real(r8), dimension(ncol) :: ocean + + real(r8), parameter :: pid2 = .5_r8 * pi + + if(dycore_is('UNSTRUCTURED')) then + call endrun( 'Option not supported for unstructured atmosphere grids ') + end if + + !----------------------------------------------------------------------- + ! ... Note the factor 1.e-2 in the wrk array calculation is + ! to transform the incoming dep vel from cm/s to m/s + !----------------------------------------------------------------------- + wrk(:ncol) = 1.e-2_r8 * p(:ncol) / (rair * tv(:ncol)) + + !-------------------------------------------------------- + ! ... Initialize all deposition velocities to zero + !-------------------------------------------------------- + depvel(:,:) = 0._r8 + + !-------------------------------------------------------- + ! ... Time interpolate primary depvel array + ! (also seaice and npp) + !-------------------------------------------------------- + call interpdvel( calday, ncol, lchnk ) + + if( o3_in_tab ) then + do i=1,ncol + o3_tab_dvel(i) = dvel_interp(i,lchnk,o3_tab_ndx) + enddo + end if + + !-------------------------------------------------------- + ! ... Set deposition velocities + !-------------------------------------------------------- + do m = 1,gas_pcnst + if( map(m) /= 0 ) then + do i = 1,ncol + depvel(i,m) = dvel_interp(i,lchnk,map(m)) + dflx(i,m) = wrk(i) * depvel(i,m) * q(i,plev,m) + enddo + end if + end do + + !-------------------------------------------------------- + ! ... Set some variables needed for some dvel calculations + !-------------------------------------------------------- + temp_fac(:ncol) = min( 1._r8, max( 0._r8, (tsurf(:ncol) - 268._r8) / 5._r8 ) ) + ocean(:ncol) = icefrac(:ncol)+ocnfrac(:ncol) + glace(:ncol) = icefrac(:ncol) + (1._r8 - ocean(:ncol)) * (1._r8 - temp_fac(:ncol)) + glace(:ncol) = min( 1._r8,glace(:ncol) ) + + !-------------------------------------------------------- + ! ... Set pan & mpan + !-------------------------------------------------------- + if( o3_in_tab ) then + tmp(:ncol) = o3_tab_dvel(:ncol) / 3._r8 + else + tmp(:) = 0._r8 + end if + if( pan_dd ) then + if( map(pan_ndx) == 0 ) then + depvel(:ncol,pan_ndx) = tmp(:ncol) + dflx(:ncol,pan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pan_ndx) + end if + end if + if( mpan_dd ) then + if( map(mpan_ndx) == 0 ) then + depvel(:ncol,mpan_ndx) = tmp(:ncol) + dflx(:ncol,mpan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mpan_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Set no2 dvel + !-------------------------------------------------------- + if( no2_dd ) then + if( map(no2_ndx) == 0 .and. o3_in_tab ) then + depvel(:ncol,no2_ndx) = (.6_r8*o3_tab_dvel(:ncol) + .055_r8*ocean(:ncol)) * .9_r8 + dflx(:ncol,no2_ndx) = wrk(:) * depvel(:ncol,no2_ndx) * q(:ncol,plev,no2_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Set hno3 dvel + !-------------------------------------------------------- + tmp(:ncol) = (2._r8 - ocnfrac(:ncol)) * (1._r8 - glace(:ncol)) + .05_r8 * glace(:ncol) + if( hno3_dd ) then + if( map(hno3_ndx) == 0 ) then + depvel(:ncol,hno3_ndx) = tmp(:ncol) + dflx(:ncol,hno3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hno3_ndx) + else + tmp(:ncol) = depvel(:ncol,hno3_ndx) + end if + end if + if( onitr_dd ) then + if( map(onitr_ndx) == 0 ) then + depvel(:ncol,onitr_ndx) = tmp(:ncol) + dflx(:ncol,onitr_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onitr_ndx) + end if + end if + if( isopooh_dd ) then + if( map(isopooh_ndx) == 0 ) then + depvel(:ncol,isopooh_ndx) = tmp(:ncol) + dflx(:ncol,isopooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,isopooh_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Set h2o2 dvel + !-------------------------------------------------------- + if( .not. h2o2_in_tab ) then + if( o3_in_tab ) then + tmp(:ncol) = .05_r8*glace(:ncol) + ocean(:ncol) - icefrac(:ncol) & + + (1._r8 - (glace(:) + ocean(:ncol)) + icefrac(:ncol)) & + *max( 1._r8,1._r8/(.5_r8 + 1._r8/(6._r8*o3_tab_dvel(:ncol))) ) + else + tmp(:ncol) = 0._r8 + end if + else + do i=1,ncol + tmp(i) = dvel_interp(i,lchnk,h2o2_tab_ndx) + enddo + end if + if( h2o2_dd ) then + if( map(h2o2_ndx) == 0 ) then + depvel(:ncol,h2o2_ndx) = tmp(:ncol) + dflx(:ncol,h2o2_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,h2o2_ndx) + end if + end if + !-------------------------------------------------------- + ! ... Set hcn dvel + !-------------------------------------------------------- + if( hcn_dd ) then + if( map(hcn_ndx) == 0 ) then + depvel(:ncol,hcn_ndx) = ocnfrac(:ncol)*0.2_r8 + endif + endif + !-------------------------------------------------------- + ! ... Set ch3cn dvel + !-------------------------------------------------------- + if( ch3cn_dd ) then + if( map(ch3cn_ndx) == 0 ) then + depvel(:,ch3cn_ndx) = ocnfrac(:ncol)*0.2_r8 + endif + endif + !-------------------------------------------------------- + ! ... Set onit + !-------------------------------------------------------- + if( onit_dd ) then + if( map(onit_ndx) == 0 ) then + depvel(:ncol,onit_ndx) = tmp(:ncol) + dflx(:ncol,onit_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onit_ndx) + end if + end if + if( ch3cocho_dd ) then + if( map(ch3cocho_ndx) == 0 ) then + depvel(:ncol,ch3cocho_ndx) = tmp(:ncol) + dflx(:ncol,ch3cocho_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3cocho_ndx) + end if + end if + if( ch3ooh_in_tab ) then + do i=1,ncol + tmp(i) = dvel_interp(i,lchnk,ch3ooh_tab_ndx) + enddo + else + tmp(:ncol) = .5_r8 * tmp(:ncol) + end if + if( ch3ooh_dd ) then + if( map(ch3ooh_ndx) == 0 ) then + depvel(:ncol,ch3ooh_ndx) = tmp(:ncol) + dflx(:ncol,ch3ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3ooh_ndx) + end if + end if + if( pooh_dd ) then + if( map(pooh_ndx) == 0 ) then + depvel(:ncol,pooh_ndx) = tmp(:ncol) + dflx(:ncol,pooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pooh_ndx) + end if + end if + if( ch3coooh_dd ) then + if( map(ch3coooh_ndx) == 0 ) then + depvel(:ncol,ch3coooh_ndx) = tmp(:ncol) + dflx(:ncol,ch3coooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coooh_ndx) + end if + end if + if( c2h5ooh_dd ) then + if( map(c2h5ooh_ndx) == 0 ) then + depvel(:ncol,c2h5ooh_ndx) = tmp(:ncol) + dflx(:ncol,c2h5ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5ooh_ndx) + end if + end if + if( c3h7ooh_dd ) then + if( map(c3h7ooh_ndx) == 0 ) then + depvel(:ncol,c3h7ooh_ndx) = tmp(:ncol) + dflx(:ncol,c3h7ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c3h7ooh_ndx) + end if + end if + if( rooh_dd ) then + if( map(rooh_ndx) == 0 ) then + depvel(:ncol,rooh_ndx) = tmp(:ncol) + dflx(:ncol,rooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,rooh_ndx) + end if + end if + if( macrooh_dd ) then + if( map(macrooh_ndx) == 0 ) then + depvel(:ncol,macrooh_ndx) = tmp(:ncol) + dflx(:ncol,macrooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,macrooh_ndx) + end if + end if + if( xooh_dd ) then + if( map(xooh_ndx) == 0 ) then + depvel(:ncol,xooh_ndx) = tmp(:ncol) + dflx(:ncol,xooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,xooh_ndx) + end if + end if + if( ch3oh_dd ) then + if( map(ch3oh_ndx) == 0 ) then + depvel(:ncol,ch3oh_ndx) = tmp(:ncol) + dflx(:ncol,ch3oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3oh_ndx) + end if + end if + if( c2h5oh_dd ) then + if( map(c2h5oh_ndx) == 0 ) then + depvel(:ncol,c2h5oh_ndx) = tmp(:ncol) + dflx(:ncol,c2h5oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5oh_ndx) + end if + end if + if( alkooh_dd ) then + if( map(alkooh_ndx) == 0 ) then + depvel(:ncol,alkooh_ndx) = tmp(:ncol) + dflx(:ncol,alkooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,alkooh_ndx) + end if + end if + if( mekooh_dd ) then + if( map(mekooh_ndx) == 0 ) then + depvel(:ncol,mekooh_ndx) = tmp(:ncol) + dflx(:ncol,mekooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mekooh_ndx) + end if + end if + if( tolooh_dd ) then + if( map(tolooh_ndx) == 0 ) then + depvel(:ncol,tolooh_ndx) = tmp(:ncol) + dflx(:ncol,tolooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,tolooh_ndx) + end if + end if + if( o3_in_tab ) then + tmp(:ncol) = o3_tab_dvel(:ncol) + else + tmp(:ncol) = 0._r8 + end if + if( ch2o_dd ) then + if( map(ch2o_ndx) == 0 ) then + depvel(:ncol,ch2o_ndx) = tmp(:ncol) + dflx(:ncol,ch2o_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch2o_ndx) + end if + end if + + if( hydrald_dd ) then + if( map(hydrald_ndx) == 0 ) then + depvel(:ncol,hydrald_ndx) = tmp(:ncol) + dflx(:ncol,hydrald_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hydrald_ndx) + end if + end if + if( ch3cooh_dd ) then + if( map(ch3cooh_ndx) == 0 ) then + depvel(:ncol,ch3cooh_ndx) = depvel(:ncol,ch2o_ndx) + dflx(:ncol,ch3cooh_ndx) = wrk(:ncol) * depvel(:ncol,ch3cooh_ndx) * q(:ncol,plev,ch3cooh_ndx) + end if + end if + if( eooh_dd ) then + if( map(eooh_ndx) == 0 ) then + depvel(:ncol,eooh_ndx) = depvel(:ncol,ch2o_ndx) + dflx(:ncol,eooh_ndx) = wrk(:ncol) * depvel(:ncol,eooh_ndx) * q(:ncol,plev,eooh_ndx) + end if + end if + ! HCOOH - set to CH3COOH + if( hcooh_dd ) then + if( map(hcooh_ndx) == 0 ) then + depvel(:ncol,hcooh_ndx) = depvel(:ncol,ch2o_ndx) + dflx(:ncol,hcooh_ndx) = wrk(:ncol) * depvel(:ncol,hcooh_ndx) * q(:ncol,plev,hcooh_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Set co and related species dep vel + !-------------------------------------------------------- + if( co_in_tab ) then + do i=1,ncol + tmp(i) = dvel_interp(i,lchnk,co_tab_ndx) + enddo + else + tmp(:) = 0._r8 + end if + if( co_dd ) then + if( map(co_ndx) == 0 ) then + depvel(:ncol,co_ndx) = tmp(:ncol) + dflx(:ncol,co_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,co_ndx) + end if + end if + if( ch3coch3_dd ) then + if( map(ch3coch3_ndx) == 0 ) then + depvel(:ncol,ch3coch3_ndx) = tmp(:ncol) + dflx(:ncol,ch3coch3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coch3_ndx) + end if + end if + if( hyac_dd ) then + if( map(hyac_ndx) == 0 ) then + depvel(:ncol,hyac_ndx) = tmp(:ncol) + dflx(:ncol,hyac_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hyac_ndx) + end if + end if + if( h2_dd ) then + if( map(h2_ndx) == 0 ) then + depvel(:ncol,h2_ndx) = tmp(:ncol) * 1.5_r8 ! Hough(1991) + dflx(:ncol,h2_ndx) = wrk(:ncol) * depvel(:ncol,h2_ndx) * q(:ncol,plev,h2_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Set glyald + !-------------------------------------------------------- + if( glyald_dd ) then + if( map(glyald_ndx) == 0 ) then + if( ch3cho_dd ) then + depvel(:ncol,glyald_ndx) = depvel(:ncol,ch3cho_ndx) + else if( ch3cho_in_tab ) then + do i=1,ncol + depvel(i,glyald_ndx) = dvel_interp(i,lchnk,ch3cho_tab_ndx) + enddo + else + depvel(:ncol,glyald_ndx) = 0._r8 + end if + dflx(:ncol,glyald_ndx) = wrk(:ncol) * depvel(:ncol,glyald_ndx) * q(:ncol,plev,glyald_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... Lead deposition + !-------------------------------------------------------- + if( Pb_dd ) then + if( map(Pb_ndx) == 0 ) then + depvel(:ncol,Pb_ndx) = ocean(:ncol) * .05_r8 + (1._r8 - ocean(:ncol)) * .2_r8 + dflx(:ncol,Pb_ndx) = wrk(:ncol) * depvel(:ncol,Pb_ndx) * q(:ncol,plev,Pb_ndx) + end if + end if + + !-------------------------------------------------------- + ! ... diurnal dependence for OX dvel + !-------------------------------------------------------- + if( o3_dd .or. o3s_dd .or. o3inert_dd ) then + if( o3_dd .or. o3_in_tab ) then + if( o3_dd ) then + tmp(:ncol) = max( 1._r8,sqrt( (depvel(:ncol,o3_ndx) - .2_r8)**3/.27_r8 + 4._r8*depvel(:ncol,o3_ndx) + .67_r8 ) ) + vel(:ncol) = depvel(:ncol,o3_ndx) + else if( o3_in_tab ) then + tmp(:ncol) = max( 1._r8,sqrt( (o3_tab_dvel(:ncol) - .2_r8)**3/.27_r8 + 4._r8*o3_tab_dvel(:ncol) + .67_r8 ) ) + vel(:ncol) = o3_tab_dvel(:ncol) + end if + where( abs( zen_angle(:) ) > pid2 ) + vel(:) = vel(:) / tmp(:) + elsewhere + vel(:) = vel(:) * tmp(:) + endwhere + + else + vel(:ncol) = 0._r8 + end if + if( o3_dd ) then + depvel(:ncol,o3_ndx) = vel(:ncol) + dflx(:ncol,o3_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3_ndx) + end if + !-------------------------------------------------------- + ! ... Set stratospheric O3 deposition + !-------------------------------------------------------- + if( o3s_dd ) then + depvel(:ncol,o3s_ndx) = vel(:ncol) + dflx(:ncol,o3s_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3s_ndx) + end if + if( o3inert_dd ) then + depvel(:ncol,o3inert_ndx) = vel(:ncol) + dflx(:ncol,o3inert_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3inert_ndx) + end if + end if + + if( xno2_dd ) then + if( map(xno2_ndx) == 0 ) then + depvel(:ncol,xno2_ndx) = depvel(:ncol,no2_ndx) + dflx(:ncol,xno2_ndx) = wrk(:ncol) * depvel(:ncol,xno2_ndx) * q(:ncol,plev,xno2_ndx) + end if + endif + if( o3a_dd ) then + if( map(o3a_ndx) == 0 ) then + depvel(:ncol,o3a_ndx) = depvel(:ncol,o3_ndx) + dflx(:ncol,o3a_ndx) = wrk(:ncol) * depvel(:ncol,o3a_ndx) * q(:ncol,plev,o3a_ndx) + end if + endif + if( xhno3_dd ) then + if( map(xhno3_ndx) == 0 ) then + depvel(:ncol,xhno3_ndx) = depvel(:ncol,hno3_ndx) + dflx(:ncol,xhno3_ndx) = wrk(:ncol) * depvel(:ncol,xhno3_ndx) * q(:ncol,plev,xhno3_ndx) + end if + endif + if( xnh4no3_dd ) then + if( map(xnh4no3_ndx) == 0 ) then + depvel(:ncol,xnh4no3_ndx) = depvel(:ncol,nh4no3_ndx) + dflx(:ncol,xnh4no3_ndx) = wrk(:ncol) * depvel(:ncol,xnh4no3_ndx) * q(:ncol,plev,xnh4no3_ndx) + end if + endif + if( xpan_dd ) then + if( map(xpan_ndx) == 0 ) then + depvel(:ncol,xpan_ndx) = depvel(:ncol,pan_ndx) + dflx(:ncol,xpan_ndx) = wrk(:ncol) * depvel(:ncol,xpan_ndx) * q(:ncol,plev,xpan_ndx) + end if + endif + if( xmpan_dd ) then + if( map(xmpan_ndx) == 0 ) then + depvel(:ncol,xmpan_ndx) = depvel(:ncol,mpan_ndx) + dflx(:ncol,xmpan_ndx) = wrk(:ncol) * depvel(:ncol,xmpan_ndx) * q(:ncol,plev,xmpan_ndx) + end if + endif + if( xonit_dd ) then + if( map(xonit_ndx) == 0 ) then + depvel(:ncol,xonit_ndx) = depvel(:ncol,onit_ndx) + dflx(:ncol,xonit_ndx) = wrk(:ncol) * depvel(:ncol,xonit_ndx) * q(:ncol,plev,xonit_ndx) + end if + endif + if( xonitr_dd ) then + if( map(xonitr_ndx) == 0 ) then + depvel(:ncol,xonitr_ndx) = depvel(:ncol,onitr_ndx) + dflx(:ncol,xonitr_ndx) = wrk(:ncol) * depvel(:ncol,xonitr_ndx) * q(:ncol,plev,xonitr_ndx) + end if + endif + if( xno_dd ) then + if( map(xno_ndx) == 0 ) then + depvel(:ncol,xno_ndx) = depvel(:ncol,no_ndx) + dflx(:ncol,xno_ndx) = wrk(:ncol) * depvel(:ncol,xno_ndx) * q(:ncol,plev,xno_ndx) + end if + endif + if( xho2no2_dd ) then + if( map(xho2no2_ndx) == 0 ) then + depvel(:ncol,xho2no2_ndx) = depvel(:ncol,ho2no2_ndx) + dflx(:ncol,xho2no2_ndx) = wrk(:ncol) * depvel(:ncol,xho2no2_ndx) * q(:ncol,plev,xho2no2_ndx) + end if + endif + !lke-TS1 + if( phenooh_dd ) then + if( map(phenooh_ndx) == 0 ) then + depvel(:ncol,phenooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,phenooh_ndx) = wrk(:ncol) * depvel(:ncol,phenooh_ndx) * q(:ncol,plev,phenooh_ndx) + end if + endif + if( benzooh_dd ) then + if( map(benzooh_ndx) == 0 ) then + depvel(:ncol,benzooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,benzooh_ndx) = wrk(:ncol) * depvel(:ncol,benzooh_ndx) * q(:ncol,plev,benzooh_ndx) + end if + endif + if( c6h5ooh_dd ) then + if( map(c6h5ooh_ndx) == 0 ) then + depvel(:ncol,c6h5ooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,c6h5ooh_ndx) = wrk(:ncol) * depvel(:ncol,c6h5ooh_ndx) * q(:ncol,plev,c6h5ooh_ndx) + end if + endif + if( bzooh_dd ) then + if( map(bzooh_ndx) == 0 ) then + depvel(:ncol,bzooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,bzooh_ndx) = wrk(:ncol) * depvel(:ncol,bzooh_ndx) * q(:ncol,plev,bzooh_ndx) + end if + endif + if( xylolooh_dd ) then + if( map(xylolooh_ndx) == 0 ) then + depvel(:ncol,xylolooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,xylolooh_ndx) = wrk(:ncol) * depvel(:ncol,xylolooh_ndx) * q(:ncol,plev,xylolooh_ndx) + end if + endif + if( xylenooh_dd ) then + if( map(xylenooh_ndx) == 0 ) then + depvel(:ncol,xylenooh_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,xylenooh_ndx) = wrk(:ncol) * depvel(:ncol,xylenooh_ndx) * q(:ncol,plev,xylenooh_ndx) + end if + endif + if( terpooh_dd ) then + if( map(terpooh_ndx) == 0 ) then + depvel(:ncol,terpooh_ndx) = depvel(:ncol,isopooh_ndx) + dflx(:ncol,terpooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terpooh_ndx) + end if + end if + if( terp2ooh_dd ) then + if( map(terp2ooh_ndx) == 0 ) then + depvel(:ncol,terp2ooh_ndx) = depvel(:ncol,isopooh_ndx) + dflx(:ncol,terp2ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terp2ooh_ndx) + end if + end if + if( terprod1_dd ) then + if( map(terprod1_ndx) == 0 ) then + depvel(:ncol,terprod1_ndx) = depvel(:ncol,hyac_ndx) + dflx(:ncol,terprod1_ndx) = wrk(:ncol) * depvel(:ncol,terprod1_ndx) * q(:ncol,plev,terprod1_ndx) + end if + endif + if( terprod2_dd ) then + if( map(terprod2_ndx) == 0 ) then + depvel(:ncol,terprod2_ndx) = depvel(:ncol,hyac_ndx) + dflx(:ncol,terprod2_ndx) = wrk(:ncol) * depvel(:ncol,terprod2_ndx) * q(:ncol,plev,terprod2_ndx) + end if + endif + if( hmprop_dd ) then + if( map(hmprop_ndx) == 0 ) then + depvel(:ncol,hmprop_ndx) = depvel(:ncol,glyald_ndx) + dflx(:ncol,hmprop_ndx) = wrk(:ncol) * depvel(:ncol,hmprop_ndx) * q(:ncol,plev,hmprop_ndx) + end if + endif + if( mboooh_dd ) then + if( map(mboooh_ndx) == 0 ) then + depvel(:ncol,mboooh_ndx) = depvel(:ncol,isopooh_ndx) + dflx(:ncol,mboooh_ndx) = wrk(:ncol) * depvel(:ncol,mboooh_ndx) * q(:ncol,plev,mboooh_ndx) + end if + endif + if( hpald_dd ) then + if( map(hpald_ndx) == 0 ) then + depvel(:ncol,hpald_ndx) = depvel(:ncol,ch3ooh_ndx) + dflx(:ncol,hpald_ndx) = wrk(:ncol) * depvel(:ncol,hpald_ndx) * q(:ncol,plev,hpald_ndx) + end if + endif + if( iepox_dd ) then + if( map(iepox_ndx) == 0 ) then + depvel(:ncol,iepox_ndx) = depvel(:ncol,hyac_ndx) + dflx(:ncol,iepox_ndx) = wrk(:ncol) * depvel(:ncol,iepox_ndx) * q(:ncol,plev,iepox_ndx) + end if + endif + if( noa_dd ) then + if( map(noa_ndx) == 0 ) then + depvel(:ncol,noa_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,noa_ndx) = wrk(:ncol) * depvel(:ncol,noa_ndx) * q(:ncol,plev,noa_ndx) + end if + endif + if( alknit_dd ) then + if( map(alknit_ndx) == 0 ) then + depvel(:ncol,alknit_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,alknit_ndx) = wrk(:ncol) * depvel(:ncol,alknit_ndx) * q(:ncol,plev,alknit_ndx) + end if + endif + if( isopnita_dd ) then + if( map(isopnita_ndx) == 0 ) then + depvel(:ncol,isopnita_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,isopnita_ndx) = wrk(:ncol) * depvel(:ncol,isopnita_ndx) * q(:ncol,plev,isopnita_ndx) + end if + endif + if( isopnitb_dd ) then + if( map(isopnitb_ndx) == 0 ) then + depvel(:ncol,isopnitb_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,isopnitb_ndx) = wrk(:ncol) * depvel(:ncol,isopnitb_ndx) * q(:ncol,plev,isopnitb_ndx) + end if + endif + if( honitr_dd ) then + if( map(honitr_ndx) == 0 ) then + depvel(:ncol,honitr_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,honitr_ndx) = wrk(:ncol) * depvel(:ncol,honitr_ndx) * q(:ncol,plev,honitr_ndx) + end if + endif + if( isopnooh_dd ) then + if( map(isopnooh_ndx) == 0 ) then + depvel(:ncol,isopnooh_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,isopnooh_ndx) = wrk(:ncol) * depvel(:ncol,isopnooh_ndx) * q(:ncol,plev,isopnooh_ndx) + end if + endif + if( nc4cho_dd ) then + if( map(nc4cho_ndx) == 0 ) then + depvel(:ncol,nc4cho_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,nc4cho_ndx) = wrk(:ncol) * depvel(:ncol,nc4cho_ndx) * q(:ncol,plev,nc4cho_ndx) + end if + endif + if( nc4ch2oh_dd ) then + if( map(nc4ch2oh_ndx) == 0 ) then + depvel(:ncol,nc4ch2oh_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,nc4ch2oh_ndx) = wrk(:ncol) * depvel(:ncol,nc4ch2oh_ndx) * q(:ncol,plev,nc4ch2oh_ndx) + end if + endif + if( terpnit_dd ) then + if( map(terpnit_ndx) == 0 ) then + depvel(:ncol,terpnit_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,terpnit_ndx) = wrk(:ncol) * depvel(:ncol,terpnit_ndx) * q(:ncol,plev,terpnit_ndx) + end if + endif + if( nterpooh_dd ) then + if( map(nterpooh_ndx) == 0 ) then + depvel(:ncol,nterpooh_ndx) = depvel(:ncol,h2o2_ndx) + dflx(:ncol,nterpooh_ndx) = wrk(:ncol) * depvel(:ncol,nterpooh_ndx) * q(:ncol,plev,nterpooh_ndx) + end if + endif + + + end subroutine drydep_table + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine dvel_inti_xactive( depvel_lnd_file, clim_soilw_file, season_wes_file ) + !------------------------------------------------------------------------------------- + ! ... intialize interactive drydep + !------------------------------------------------------------------------------------- + use dycore, only : dycore_is + use mo_constants, only : r2d + use chem_mods, only : adv_mass + use mo_chem_utls, only : get_spc_ndx + use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND + use phys_control, only : phys_getopts + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file, season_wes_file + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + integer :: i, j, ii, jj, jl, ju + integer :: nlon_veg, nlat_veg, npft_veg + integer :: nlat_lai, npft_lai, pos_min, imin + integer :: dimid + integer :: m, n, l, id + integer :: length1, astat + integer, allocatable :: wk_lai(:,:,:) + integer, allocatable :: index_season_lai_j(:,:) + integer :: k, num_max, k_max + integer :: num_seas(5) + integer :: plon, plat + integer :: ierr, ndx + + real(r8) :: spc_mass + real(r8) :: diff_min, target_lat + real(r8), allocatable :: vegetation_map(:,:,:) + real(r8), pointer :: soilw_map(:,:,:) + real(r8), allocatable :: work(:,:) + real(r8), allocatable :: landmask(:,:) + real(r8), allocatable :: urban(:,:) + real(r8), allocatable :: lake(:,:) + real(r8), allocatable :: wetland(:,:) + real(r8), allocatable :: lon_veg(:) + real(r8), allocatable :: lon_veg_edge(:) + real(r8), allocatable :: lat_veg(:) + real(r8), allocatable :: lat_veg_edge(:) + real(r8), allocatable :: lat_lai(:) + real(r8), allocatable :: clat(:) + character(len=32) :: test_name + character(len=4) :: tag_name + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + logical :: do_soilw + + character(len=shr_kind_cl) :: locfn + logical :: prog_modal_aero + + ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + + call dvel_inti_fromlnd() + + if( masterproc ) then + write(iulog,*) 'drydep_inti: following species have dry deposition' + do i=1,nddvels + if( len_trim(drydep_list(i)) > 0 ) then + write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' + endif + enddo + write(iulog,*) 'drydep_inti:' + endif + + !------------------------------------------------------------------------------------- + ! ... get species indices + !------------------------------------------------------------------------------------- + xpan_ndx = get_spc_ndx( 'XPAN' ) + xmpan_ndx = get_spc_ndx( 'XMPAN' ) + o3a_ndx = get_spc_ndx( 'O3A' ) + + ch4_ndx = get_spc_ndx( 'CH4' ) + h2_ndx = get_spc_ndx( 'H2' ) + co_ndx = get_spc_ndx( 'CO' ) + Pb_ndx = get_spc_ndx( 'Pb' ) + pan_ndx = get_spc_ndx( 'PAN' ) + mpan_ndx = get_spc_ndx( 'MPAN' ) + o3_ndx = get_spc_ndx( 'OX' ) + if( o3_ndx < 0 ) then + o3_ndx = get_spc_ndx( 'O3' ) + end if + so2_ndx = get_spc_ndx( 'SO2' ) + alkooh_ndx = get_spc_ndx( 'ALKOOH') + mekooh_ndx = get_spc_ndx( 'MEKOOH') + tolooh_ndx = get_spc_ndx( 'TOLOOH') + terpooh_ndx = get_spc_ndx( 'TERPOOH') + ch3cooh_ndx = get_spc_ndx( 'CH3COOH') + soa_ndx = get_spc_ndx( 'SOA' ) + so4_ndx = get_spc_ndx( 'SO4' ) + cb1_ndx = get_spc_ndx( 'CB1' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + nh3_ndx = get_spc_ndx( 'NH3' ) + nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) + sa1_ndx = get_spc_ndx( 'SA1' ) + sa2_ndx = get_spc_ndx( 'SA2' ) + sa3_ndx = get_spc_ndx( 'SA3' ) + sa4_ndx = get_spc_ndx( 'SA4' ) + nh4_ndx = get_spc_ndx( 'NH4' ) + alkooh_dd = has_drydep( 'ALKOOH') + mekooh_dd = has_drydep( 'MEKOOH') + tolooh_dd = has_drydep( 'TOLOOH') + terpooh_dd = has_drydep( 'TERPOOH') + ch3cooh_dd = has_drydep( 'CH3COOH') + soa_dd = has_drydep( 'SOA' ) + so4_dd = has_drydep( 'SO4' ) + cb1_dd = has_drydep( 'CB1' ) + cb2_dd = has_drydep( 'CB2' ) + oc1_dd = has_drydep( 'OC1' ) + oc2_dd = has_drydep( 'OC2' ) + nh3_dd = has_drydep( 'NH3' ) + nh4no3_dd = has_drydep( 'NH4NO3' ) + sa1_dd = has_drydep( 'SA1' ) + sa2_dd = has_drydep( 'SA2' ) + sa3_dd = has_drydep( 'SA3' ) + sa4_dd = has_drydep( 'SA4' ) + nh4_dd = has_drydep( 'NH4' ) +! + soam_ndx = get_spc_ndx( 'SOAM' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + sogm_ndx = get_spc_ndx( 'SOGM' ) + sogi_ndx = get_spc_ndx( 'SOGI' ) + sogt_ndx = get_spc_ndx( 'SOGT' ) + sogb_ndx = get_spc_ndx( 'SOGB' ) + sogx_ndx = get_spc_ndx( 'SOGX' ) + soam_dd = has_drydep ( 'SOAM' ) + soai_dd = has_drydep ( 'SOAI' ) + soat_dd = has_drydep ( 'SOAT' ) + soab_dd = has_drydep ( 'SOAB' ) + soax_dd = has_drydep ( 'SOAX' ) + sogm_dd = has_drydep ( 'SOGM' ) + sogi_dd = has_drydep ( 'SOGI' ) + sogt_dd = has_drydep ( 'SOGT' ) + sogb_dd = has_drydep ( 'SOGB' ) + sogx_dd = has_drydep ( 'SOGX' ) +! + hcn_ndx = get_spc_ndx( 'HCN') + ch3cn_ndx = get_spc_ndx( 'CH3CN') + +!lke-TS1 + phenooh_ndx = get_spc_ndx( 'PHENOOH') + benzooh_ndx = get_spc_ndx( 'BENZOOH') + c6h5ooh_ndx = get_spc_ndx( 'C6H5OOH') + bzooh_ndx = get_spc_ndx( 'BZOOH') + xylolooh_ndx = get_spc_ndx( 'XYLOLOOH') + xylenooh_ndx = get_spc_ndx( 'XYLENOOH') + terp2ooh_ndx = get_spc_ndx( 'TERP2OOH') + terprod1_ndx = get_spc_ndx( 'TERPROD1') + terprod2_ndx = get_spc_ndx( 'TERPROD2') + hmprop_ndx = get_spc_ndx( 'HMPROP') + mboooh_ndx = get_spc_ndx( 'MBOOOH') + hpald_ndx = get_spc_ndx( 'HPALD') + iepox_ndx = get_spc_ndx( 'IEPOX') + noa_ndx = get_spc_ndx( 'NOA') + alknit_ndx = get_spc_ndx( 'ALKNIT') + isopnita_ndx = get_spc_ndx( 'ISOPNITA') + isopnitb_ndx = get_spc_ndx( 'ISOPNITB') + honitr_ndx = get_spc_ndx( 'HONITR') + isopnooh_ndx = get_spc_ndx( 'ISOPNOOH') + nc4cho_ndx = get_spc_ndx( 'NC4CHO') + nc4ch2oh_ndx = get_spc_ndx( 'NC4CH2OH') + terpnit_ndx = get_spc_ndx( 'TERPNIT') + nterpooh_ndx = get_spc_ndx( 'NTERPOOH') + phenooh_dd = has_drydep( 'PHENOOH') + benzooh_dd = has_drydep( 'BENZOOH') + c6h5ooh_dd = has_drydep( 'C6H5OOH') + bzooh_dd = has_drydep( 'BZOOH') + xylolooh_dd = has_drydep( 'XYLOLOOH') + xylenooh_dd = has_drydep( 'XYLENOOH') + terp2ooh_dd = has_drydep( 'TERP2OOH') + terprod1_dd = has_drydep( 'TERPROD1') + terprod2_dd = has_drydep( 'TERPROD2') + hmprop_dd = has_drydep( 'HMPROP') + mboooh_dd = has_drydep( 'MBOOOH') + hpald_dd = has_drydep( 'HPALD') + iepox_dd = has_drydep( 'IEPOX') + noa_dd = has_drydep( 'NOA') + alknit_dd = has_drydep( 'ALKNIT') + isopnita_dd = has_drydep( 'ISOPNITA') + isopnitb_dd = has_drydep( 'ISOPNITB') + honitr_dd = has_drydep( 'HONITR') + isopnooh_dd = has_drydep( 'ISOPNOOH') + nc4cho_dd = has_drydep( 'NC4CHO') + nc4ch2oh_dd = has_drydep( 'NC4CH2OH') + terpnit_dd = has_drydep( 'TERPNIT') + nterpooh_dd = has_drydep( 'NTERPOOH') +! + cohc_ndx = get_spc_ndx( 'COhc' ) + come_ndx = get_spc_ndx( 'COme' ) + + tag_cnt=0 + cotag_ndx(:)=-1 + do i = 1,NTAGS + write(tag_name,'(a2,i2.2)') 'CO',i + ndx = get_spc_ndx(tag_name) + if (ndx>0) then + tag_cnt = tag_cnt+1 + cotag_ndx(tag_cnt) = ndx + endif + enddo + + o3s_ndx = get_spc_ndx( 'O3S' ) + + do i=1,nddvels + if ( mapping(i) > 0 ) then + test_name = drydep_list(i) + m = get_spc_ndx( test_name ) + has_dvel(m) = .true. + map_dvel(m) = i + endif + enddo + + if( all( .not. has_dvel(:) ) ) then + return + end if + + !--------------------------------------------------------------------------- + ! ... allocate module variables + !--------------------------------------------------------------------------- + allocate( dep_ra(pcols,n_land_type,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate dep_ra; error = ',astat + call endrun + end if + allocate( dep_rb(pcols,n_land_type,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate dep_rb; error = ',astat + call endrun + end if + + if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then + return + endif + + do_soilw = .not. dyn_soilw .and. (has_drydep( 'H2' ) .or. has_drydep( 'CO' )) + allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat + call endrun + end if + if(do_soilw) then + allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat + call endrun + end if + end if + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + allocate( index_season_lai_j(n_land_type,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai_j; error = ',astat + call endrun + end if + if(dycore_is('UNSTRUCTURED') ) then + call get_landuse_and_soilw_from_file(do_soilw) + allocate( index_season_lai(plon,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat + call endrun + end if + else + allocate( index_season_lai(plat,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read landuse map + !--------------------------------------------------------------------------- + call getfil (depvel_lnd_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlon_veg ) + ierr = pio_inq_dimid( piofile, 'lat', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlat_veg ) + ierr = pio_inq_dimid( piofile, 'pft', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, npft_veg ) + !--------------------------------------------------------------------------- + ! ... allocate arrays + !--------------------------------------------------------------------------- + allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & + landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & + lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read the vegetation map and landmask + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'PCT_PFT', vid ) + ierr = pio_get_var( piofile, vid, vegetation_map ) + + ierr = pio_inq_varid( piofile, 'LANDMASK', vid ) + ierr = pio_get_var( piofile, vid, landmask ) + + ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid ) + ierr = pio_get_var( piofile, vid, urban ) + + ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid ) + ierr = pio_get_var( piofile, vid, lake ) + + ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid ) + ierr = pio_get_var( piofile, vid, wetland ) + + call cam_pio_closefile( piofile ) + + !--------------------------------------------------------------------------- + ! scale vegetation, urban, lake, and wetland to fraction + !--------------------------------------------------------------------------- + vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:) + wetland(:,:) = .01_r8 * wetland(:,:) + lake(:,:) = .01_r8 * lake(:,:) + urban(:,:) = .01_r8 * urban(:,:) +#ifdef DEBUG + if(masterproc) then + write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map) + write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland) + write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask) + end if +#endif + !--------------------------------------------------------------------------- + ! ... define lat-lon of vegetation map (1x1) + !--------------------------------------------------------------------------- + lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) + lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) + lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) + lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) + !--------------------------------------------------------------------------- + ! ... read soilw table if necessary + !--------------------------------------------------------------------------- + + if( do_soilw ) then + call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map ) + end if + + !--------------------------------------------------------------------------- + ! ... regrid to model grid + !--------------------------------------------------------------------------- + + call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & + lon_veg, lon_veg_edge, landmask, urban, lake, & + wetland, vegetation_map, soilw_map, do_soilw ) + + deallocate( vegetation_map, work, stat=astat ) + deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) + deallocate( landmask, urban, lake, wetland, stat=astat ) + if( do_soilw ) then + deallocate( soilw_map, stat=astat ) + end if + endif ! Unstructured grid + + if (drydep_method == DD_XLND) then + return + endif + + !--------------------------------------------------------------------------- + ! ... read LAI based season indeces + !--------------------------------------------------------------------------- + call getfil (season_wes_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lat', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlat_lai ) + ierr = pio_inq_dimid( piofile, 'pft', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, npft_lai ) + !--------------------------------------------------------------------------- + ! ... allocate arrays + !--------------------------------------------------------------------------- + allocate( lat_lai(nlat_lai), wk_lai(nlat_lai,npft_lai,12), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read the latitude and the season indicies + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'lat', vid ) + ierr = pio_get_var( piofile, vid, lat_lai ) + + ierr = pio_inq_varid( piofile, 'season_wes', vid ) + ierr = pio_get_var( piofile, vid, wk_lai ) + + call cam_pio_closefile( piofile ) + + + if(dycore_is('UNSTRUCTURED') ) then + ! For unstructured grids plon is the 1d horizontal grid size and plat=1 + allocate(clat(plon)) + call get_horiz_grid_d(plon, clat_d_out=clat) + jl = 1 + ju = plon + else + allocate(clat(plat)) + call get_horiz_grid_d(plat, clat_d_out=clat) + jl = 1 + ju = plat + end if + imin = 1 + do j = 1,ju + diff_min = 10._r8 + pos_min = -99 + target_lat = clat(j)*r2d + do i = imin,nlat_lai + if( abs(lat_lai(i) - target_lat) < diff_min ) then + diff_min = abs(lat_lai(i) - target_lat) + pos_min = i + end if + end do + if( pos_min < 0 ) then + write(iulog,*) 'dvel_inti: cannot find ',target_lat,' at j,pos_min,diff_min = ',j,pos_min,diff_min + write(iulog,*) 'dvel_inti: imin,nlat_lai = ',imin,nlat_lai + write(iulog,*) 'dvel_inti: lat_lai' + write(iulog,'(1p,10g12.5)') lat_lai(:) + call endrun + end if + if(dycore_is('UNSTRUCTURED') ) then + imin=1 + else + imin = pos_min + end if + index_season_lai_j(:,:) = wk_lai(pos_min,:,:) + + !--------------------------------------------------------------------------- + ! specify the season as the most frequent in the 11 vegetation classes + ! this was done to remove a banding problem in dvel (JFL Oct 04) + !--------------------------------------------------------------------------- + do m = 1,12 + num_seas = 0 + do l = 1,11 + do k = 1,5 + if( index_season_lai_j(l,m) == k ) then + num_seas(k) = num_seas(k) + 1 + exit + end if + end do + end do + + num_max = -1 + do k = 1,5 + if( num_seas(k) > num_max ) then + num_max = num_seas(k) + k_max = k + endif + end do + + index_season_lai(j,m) = k_max + end do + end do + + deallocate( lat_lai, wk_lai, clat, index_season_lai_j) + + end subroutine dvel_inti_xactive + + !------------------------------------------------------------------------------------- + subroutine get_landuse_and_soilw_from_file(do_soilw) + use ncdio_atm, only : infld + logical, intent(in) :: do_soilw + logical :: readvar + + type(file_desc_t) :: piofile + character(len=shr_kind_cl) :: locfn + logical :: lexist + + call getfil (drydep_srf_file, locfn, 1, lexist) + if(lexist) then + call cam_pio_openfile(piofile, locfn, PIO_NOWRITE) + + call infld('fraction_landuse', piofile, 'ncol','class',1,pcols,1,n_land_type, begchunk,endchunk, & + fraction_landuse, readvar, gridname='physgrid') + if (.not. readvar) then + write(iulog,*)'**************************************' + write(iulog,*)'get_landuse_and_soilw_from_file: INFO:' + write(iulog,*)' fraction_landuse not read from file: ' + write(iulog,*)' ', trim(locfn) + write(iulog,*)' setting all values to zero' + write(iulog,*)'**************************************' + fraction_landuse = 0._r8 + end if + + if(do_soilw) then + call infld('soilw', piofile, 'ncol','month',1,pcols,1,12, begchunk,endchunk, & + soilw_3d, readvar, gridname='physgrid') + end if + + call cam_pio_closefile(piofile) + else + call endrun('Unstructured grids require drydep_srf_file ') + end if + + + end subroutine get_landuse_and_soilw_from_file + + !------------------------------------------------------------------------------------- + subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & + lon_veg, lon_veg_edge, landmask, urban, lake, & + wetland, vegetation_map, soilw_map, do_soilw ) + + use mo_constants, only : r2d + use scamMod, only : latiop,loniop,scmlat,scmlon,scm_cambfb_mode + use shr_scam_mod , only: shr_scam_getCloseLatLon ! Standardized system subroutines + use cam_initfiles, only: initial_file_get_id + use dycore, only : dycore_is + use phys_grid, only : scatter_field_to_chunk + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + integer, intent(in) :: plon, plat, nlon_veg, nlat_veg, npft_veg + real(r8), pointer :: soilw_map(:,:,:) + real(r8), intent(in) :: landmask(nlon_veg,nlat_veg) + real(r8), intent(in) :: urban(nlon_veg,nlat_veg) + real(r8), intent(in) :: lake(nlon_veg,nlat_veg) + real(r8), intent(in) :: wetland(nlon_veg,nlat_veg) + real(r8), intent(in) :: vegetation_map(nlon_veg,nlat_veg,npft_veg) + real(r8), intent(in) :: lon_veg(nlon_veg) + real(r8), intent(in) :: lon_veg_edge(nlon_veg+1) + real(r8), intent(in) :: lat_veg(nlat_veg) + real(r8), intent(in) :: lat_veg_edge(nlat_veg+1) + logical, intent(in) :: do_soilw + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8) :: closelat,closelon + integer :: latidx,lonidx + + integer, parameter :: veg_ext = 20 + type(file_desc_t), pointer :: piofile + integer :: i, j, ii, jj, jl, ju, i_ndx, n + integer, dimension(plon+1) :: ind_lon + integer, dimension(plat+1) :: ind_lat + real(r8) :: total_land + real(r8), dimension(plon+1) :: lon_edge + real(r8), dimension(plat+1) :: lat_edge + real(r8) :: lat1, lat2, lon1, lon2 + real(r8) :: x1, x2, y1, y2, dx, dy + real(r8) :: area, total_area + real(r8), dimension(npft_veg+3) :: fraction + real(r8) :: total_soilw_area + real(r8) :: fraction_soilw + real(r8) :: total_soilw(12) + + real(r8), dimension(-veg_ext:nlon_veg+veg_ext) :: lon_veg_edge_ext + integer, dimension(-veg_ext:nlon_veg+veg_ext) :: mapping_ext + + real(r8), allocatable :: lam(:), phi(:), garea(:) + + logical, parameter :: has_npole = .true. + integer :: ploniop,platiop + real(r8) :: tmp_frac_lu(plon,n_land_type,plat), tmp_soilw_3d(plon,12,plat) + + if(dycore_is('UNSTRUCTURED') ) then + ! For unstructured grids plon is the 1d horizontal grid size and plat=1 + allocate(lam(plon), phi(plon)) + call get_horiz_grid_d(plon, clat_d_out=phi) + else + allocate(lam(plon), phi(plat)) + call get_horiz_grid_d(plat, clat_d_out=phi) + endif + call get_horiz_grid_d(plon, clon_d_out=lam) + + + jl = 1 + ju = plon + + if (single_column) then + if (scm_cambfb_mode) then + piofile => initial_file_get_id() + call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + ploniop=size(loniop) + platiop=size(latiop) + else + latidx=1 + lonidx=1 + ploniop=1 + platiop=1 + end if + + lon_edge(1) = loniop(lonidx) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d + + if (lonidx.lt.ploniop) then + lon_edge(2) = loniop(lonidx+1) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d + else + lon_edge(2) = lon_edge(1) + (loniop(2) - loniop(1)) * r2d + end if + + lat_edge(1) = latiop(latidx) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d + + if (latidx.lt.platiop) then + lat_edge(2) = latiop(latidx+1) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d + else + lat_edge(2) = lat_edge(1) + (latiop(2) - latiop(1)) * r2d + end if + else + do i = 1,plon + lon_edge(i) = lam(i) * r2d - .5_r8*(lam(2) - lam(1)) * r2d + end do + lon_edge(plon+1) = lon_edge(plon) + (lam(2) - lam(1)) * r2d + if( .not. has_npole ) then + do j = 1,plat+1 + lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d + end do + else + do j = 1,plat + lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d + end do + lat_edge(plat+1) = lat_edge(plat) + (phi(2) - phi(1)) * r2d + end if + end if + do j = 1,plat+1 + lat_edge(j) = min( lat_edge(j), 90._r8 ) + lat_edge(j) = max( lat_edge(j),-90._r8 ) + end do + + !------------------------------------------------------------------------------------- + ! wrap around the longitudes + !------------------------------------------------------------------------------------- + do i = -veg_ext,0 + lon_veg_edge_ext(i) = lon_veg_edge(nlon_veg+i) - 360._r8 + mapping_ext (i) = nlon_veg+i + end do + do i = 1,nlon_veg + lon_veg_edge_ext(i) = lon_veg_edge(i) + mapping_ext (i) = i + end do + do i = nlon_veg+1,nlon_veg+veg_ext + lon_veg_edge_ext(i) = lon_veg_edge(i-nlon_veg) + 360._r8 + mapping_ext (i) = i-nlon_veg + end do +#ifdef DEBUG + write(iulog,*) 'interp_map : lon_edge ',lon_edge + write(iulog,*) 'interp_map : lat_edge ',lat_edge + write(iulog,*) 'interp_map : mapping_ext ',mapping_ext +#endif + do j = 1,plon+1 + lon1 = lon_edge(j) + do i = -veg_ext,nlon_veg+veg_ext + dx = lon_veg_edge_ext(i ) - lon1 + dy = lon_veg_edge_ext(i+1) - lon1 + if( dx*dy <= 0._r8 ) then + ind_lon(j) = i + exit + end if + end do + end do + + do j = 1,plat+1 + lat1 = lat_edge(j) + do i = 1,nlat_veg + dx = lat_veg_edge(i ) - lat1 + dy = lat_veg_edge(i+1) - lat1 + if( dx*dy <= 0._r8 ) then + ind_lat(j) = i + exit + end if + end do + end do +#ifdef DEBUG + write(iulog,*) 'interp_map : ind_lon ',ind_lon + write(iulog,*) 'interp_map : ind_lat ',ind_lat +#endif + lat_loop : do j = 1,plat + lon_loop : do i = 1,plon + total_area = 0._r8 + fraction = 0._r8 + total_soilw(:) = 0._r8 + total_soilw_area = 0._r8 + do jj = ind_lat(j),ind_lat(j+1) + y1 = max( lat_edge(j),lat_veg_edge(jj) ) + y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) + dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj)) + do ii =ind_lon(i),ind_lon(i+1) + i_ndx = mapping_ext(ii) + x1 = max( lon_edge(i),lon_veg_edge_ext(ii) ) + x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) + dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii)) + area = dx * dy + total_area = total_area + area + !----------------------------------------------------------------- + ! ... special case for ocean grid point + !----------------------------------------------------------------- + if( nint(landmask(i_ndx,jj)) == 0 ) then + fraction(npft_veg+1) = fraction(npft_veg+1) + area + else + do n = 1,npft_veg + fraction(n) = fraction(n) + vegetation_map(i_ndx,jj,n) * area + end do + fraction(npft_veg+1) = fraction(npft_veg+1) + area * lake (i_ndx,jj) + fraction(npft_veg+2) = fraction(npft_veg+2) + area * wetland(i_ndx,jj) + fraction(npft_veg+3) = fraction(npft_veg+3) + area * urban (i_ndx,jj) + !----------------------------------------------------------------- + ! ... check if land accounts for the whole area. + ! If not, the remaining area is in the ocean + !----------------------------------------------------------------- + total_land = sum(vegetation_map(i_ndx,jj,:)) & + + urban (i_ndx,jj) & + + lake (i_ndx,jj) & + + wetland(i_ndx,jj) + if( total_land < 1._r8 ) then + fraction(npft_veg+1) = fraction(npft_veg+1) + (1._r8 - total_land) * area + end if + !------------------------------------------------------------------------------------- + ! ... compute weighted average of soilw over grid (non-water only) + !------------------------------------------------------------------------------------- + if( do_soilw ) then + fraction_soilw = total_land - (lake(i_ndx,jj) + wetland(i_ndx,jj)) + total_soilw_area = total_soilw_area + fraction_soilw * area + total_soilw(:) = total_soilw(:) + fraction_soilw * area * soilw_map(i_ndx,jj,:) + end if + end if + end do + end do + !------------------------------------------------------------------------------------- + ! ... divide by total area of grid box + !------------------------------------------------------------------------------------- + fraction(:) = fraction(:)/total_area + !------------------------------------------------------------------------------------- + ! ... make sure we don't have too much or too little + !------------------------------------------------------------------------------------- + if( abs( sum(fraction) - 1._r8) > .001_r8 ) then + fraction(:) = fraction(:)/sum(fraction) + end if + !------------------------------------------------------------------------------------- + ! ... map to Wesely land classification + !------------------------------------------------------------------------------------- + + + + + tmp_frac_lu(i, 1, j) = fraction(20) + tmp_frac_lu(i, 2, j) = sum(fraction(16:17)) + tmp_frac_lu(i, 3, j) = sum(fraction(13:15)) + tmp_frac_lu(i, 4, j) = sum(fraction( 5: 9)) + tmp_frac_lu(i, 5, j) = sum(fraction( 2: 4)) + tmp_frac_lu(i, 6, j) = fraction(19) + tmp_frac_lu(i, 7, j) = fraction(18) + tmp_frac_lu(i, 8, j) = fraction( 1) + tmp_frac_lu(i, 9, j) = 0._r8 + tmp_frac_lu(i,10, j) = 0._r8 + tmp_frac_lu(i,11, j) = sum(fraction(10:12)) + if( do_soilw ) then + if( total_soilw_area > 0._r8 ) then + tmp_soilw_3d(i,:,j) = total_soilw(:)/total_soilw_area + else + tmp_soilw_3d(i,:,j) = -99._r8 + end if + end if + end do lon_loop + end do lat_loop + !------------------------------------------------------------------------------------- + ! ... reshape according to lat-lon blocks + !------------------------------------------------------------------------------------- + call scatter_field_to_chunk(1,n_land_type,1,plon,tmp_frac_lu,fraction_landuse) + if(do_soilw) call scatter_field_to_chunk(1,12,1,plon,tmp_soilw_3d,soilw_3d) + !------------------------------------------------------------------------------------- + ! ... make sure there are no out of range values + !------------------------------------------------------------------------------------- + where (fraction_landuse < 0._r8) fraction_landuse = 0._r8 + where (fraction_landuse > 1._r8) fraction_landuse = 1._r8 + + end subroutine interp_map + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_xactive( ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, dvel, dflx, mmr, & + tv, soilw, rh, ncol, lonndx, latndx, lchnk, & + ocnfrc, icefrc, beglandtype, endlandtype ) + !------------------------------------------------------------------------------------- + ! code based on wesely (atmospheric environment, 1989, vol 23, p. 1293-1304) for + ! calculation of r_c, and on walcek et. al. (atmospheric enviroment, 1986, + ! vol. 20, p. 949-964) for calculation of r_a and r_b + ! + ! as suggested in walcek (u_i)(u*_i) = (u_a)(u*_a) + ! is kept constant where i represents a subgrid environment and a the + ! grid average environment. thus the calculation proceeds as follows: + ! va the grid averaged wind is calculated on dots + ! z0(i) the grid averaged roughness coefficient is calculated + ! ri(i) the grid averaged richardson number is calculated + ! --> the grid averaged (u_a)(u*_a) is calculated + ! --> subgrid scale u*_i is calculated assuming (u_i) given as above + ! --> final deposotion velocity is weighted average of subgrid scale velocities + ! + ! code written by P. Hess, rewritten in fortran 90 by JFL (August 2000) + ! modified by JFL to be used in MOZART-2 (October 2002) + !------------------------------------------------------------------------------------- + + use seq_drydep_mod, only: z0, rgso, rgss, h2_a, h2_b, h2_c, ri, rclo, rcls, rlu, rac + use seq_drydep_mod, only: seq_drydep_setHCoeff, foxd, drat + use physconst, only: tmelt + use seq_drydep_mod, only: drydep_method, DD_XLND + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: ncdate ! present date (yyyymmdd) + real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) + real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) + real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) + real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) + real(r8), intent(in) :: rh(ncol,1) ! relative humidity + real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) + real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) + real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: snow(pcols) ! snow height (m) + real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction + real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) + real(r8), intent(in) :: tv(pcols) ! potential temperature + real(r8), intent(in) :: mmr(pcols,plev,gas_pcnst) ! constituent concentration (kg/kg) + real(r8), intent(out) :: dvel(ncol,gas_pcnst) ! deposition velocity (cm/s) + real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! deposition flux (/cm^2/s) + + integer, intent(in) :: latndx(pcols) ! chunk latitude indicies + integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies + integer, intent(in) :: lchnk ! chunk number + + integer, intent(in), optional :: beglandtype + integer, intent(in), optional :: endlandtype + + real(r8), intent(in), optional :: ocnfrc(pcols) + real(r8), intent(in), optional :: icefrc(pcols) + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8), parameter :: scaling_to_cm_per_s = 100._r8 + real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s + + integer :: i, ispec, lt, m + integer :: sndx + integer :: month + + real(r8) :: slope = 0._r8 + real(r8) :: z0water ! revised z0 over water + real(r8) :: p ! pressure at midpoint first layer + real(r8) :: pg ! surface pressure + real(r8) :: es ! saturation vapor pressure + real(r8) :: ws ! saturation mixing ratio + real(r8) :: hvar ! constant to compute xmol + real(r8) :: h ! constant to compute xmol + real(r8) :: psih ! stability correction factor + real(r8) :: rs ! constant for calculating rsmx + real(r8) :: rmx ! resistance by vegetation + real(r8) :: zovl ! ratio of z to m-o length + real(r8) :: cvarb ! cvar averaged over landtypes + real(r8) :: bb ! b averaged over landtypes + real(r8) :: ustarb ! ustar averaged over landtypes + real(r8) :: tc(ncol) ! temperature in celsius + real(r8) :: cts(ncol) ! correction to rlu rcl and rgs for frost + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location and species + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,nddvels) :: heff + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location only + !------------------------------------------------------------------------------------- + integer :: index_season(ncol,n_land_type) + real(r8), dimension(ncol) :: tha ! atmospheric virtual potential temperature + real(r8), dimension(ncol) :: thg ! ground virtual potential temperature + real(r8), dimension(ncol) :: z ! height of lowest level + real(r8), dimension(ncol) :: va ! magnitude of v on cross points + real(r8), dimension(ncol) :: ribn ! richardson number + real(r8), dimension(ncol) :: qs ! saturation specific humidity + real(r8), dimension(ncol) :: crs ! multiplier to calculate crs + real(r8), dimension(ncol) :: rdc ! part of lower canopy resistance + real(r8), dimension(ncol) :: uustar ! u*ustar (assumed constant over grid) + real(r8), dimension(ncol) :: z0b ! average roughness length over grid + real(r8), dimension(ncol) :: wrk ! work array + real(r8), dimension(ncol) :: term ! work array + real(r8), dimension(ncol) :: resc ! work array + real(r8), dimension(ncol) :: lnd_frc ! work array + logical, dimension(ncol) :: unstable + logical, dimension(ncol) :: has_rain + logical, dimension(ncol) :: has_dew + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location and landtype + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,n_land_type) :: rds ! resistance for deposition of sulfate + real(r8), dimension(ncol,n_land_type) :: b ! buoyancy parameter for unstable conditions + real(r8), dimension(ncol,n_land_type) :: cvar ! height parameter + real(r8), dimension(ncol,n_land_type) :: ustar ! friction velocity + real(r8), dimension(ncol,n_land_type) :: xmol ! monin-obukhov length + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location, landtype and species + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rsmx ! vegetative resistance (plant mesophyll) + real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rclx ! lower canopy resistance + real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rlux ! vegetative resistance (upper canopy) + real(r8), dimension(ncol,n_land_type) :: rlux_o3 ! vegetative resistance (upper canopy) + real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rgsx ! ground resistance + real(r8) :: pmid(ncol,1) ! for seasalt aerosols + real(r8) :: tfld(ncol,1) ! for seasalt aerosols + real(r8) :: fact, vds + real(r8) :: rc ! combined surface resistance + real(r8) :: var_soilw, dv_soil_h2, fact_h2 ! h2 dvel wrking variables + logical :: fr_lnduse(ncol,n_land_type) ! wrking array + real(r8) :: dewm ! multiplier for rs when dew occurs + + real(r8) :: lcl_frc_landuse(ncol,n_land_type) + + integer :: beglt, endlt + + !------------------------------------------------------------------------------------- + ! jfl : mods for PAN + !------------------------------------------------------------------------------------- + real(r8) :: dv_pan + real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, & + 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /) + real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, & + 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) + + if (present( beglandtype)) then + beglt = beglandtype + else + beglt = 1 + endif + if (present( endlandtype)) then + endlt = endlandtype + else + endlt = n_land_type + endif + + !------------------------------------------------------------------------------------- + ! initialize + !------------------------------------------------------------------------------------- + do m = 1,gas_pcnst + dvel(:,m) = 0._r8 + end do + + if( all( .not. has_dvel(:) ) ) then + return + end if + + !------------------------------------------------------------------------------------- + ! define species-dependent parameters (temperature dependent) + !------------------------------------------------------------------------------------- + call seq_drydep_setHCoeff( ncol, sfc_temp, heff ) + + do lt = 1,n_land_type + dep_ra (:,lt,lchnk) = 0._r8 + dep_rb (:,lt,lchnk) = 0._r8 + rds(:,lt) = 0._r8 + end do + + !------------------------------------------------------------------------------------- + ! ... set month + !------------------------------------------------------------------------------------- + month = mod( ncdate,10000 )/100 + + !------------------------------------------------------------------------------------- + ! define which season (relative to Northern hemisphere climate) + !------------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------------- + ! define season index based on fixed LAI + !------------------------------------------------------------------------------------- + if ( drydep_method == DD_XLND ) then + index_season = 4 + else + do i = 1,ncol + index_season(i,:) = index_season_lai(latndx(i),month) + end do + endif + !------------------------------------------------------------------------------------- + ! special case for snow covered terrain + !------------------------------------------------------------------------------------- + do i = 1,ncol + if( snow(i) > .01_r8 ) then + index_season(i,:) = 4 + end if + end do + !------------------------------------------------------------------------------------- + ! scale rain and define logical arrays + !------------------------------------------------------------------------------------- + has_rain(:ncol) = rain(:ncol) > rain_threshold + + !------------------------------------------------------------------------------------- + ! loop over longitude points + !------------------------------------------------------------------------------------- + col_loop : do i = 1,ncol + p = pressure_10m(i) + pg = pressure_sfc(i) + !------------------------------------------------------------------------------------- + ! potential temperature + !------------------------------------------------------------------------------------- + tha(i) = air_temp(i) * (p00/p )**rovcp * (1._r8 + .61_r8*spec_hum(i)) + thg(i) = sfc_temp(i) * (p00/pg)**rovcp * (1._r8 + .61_r8*spec_hum(i)) + !------------------------------------------------------------------------------------- + ! height of 1st level + !------------------------------------------------------------------------------------- + z(i) = - r/grav * air_temp(i) * (1._r8 + .61_r8*spec_hum(i)) * log(p/pg) + !------------------------------------------------------------------------------------- + ! wind speed + !------------------------------------------------------------------------------------- + va(i) = max( .01_r8,wind_speed(i) ) + !------------------------------------------------------------------------------------- + ! Richardson number + !------------------------------------------------------------------------------------- + ribn(i) = z(i) * grav * (tha(i) - thg(i))/thg(i) / (va(i)*va(i)) + ribn(i) = min( ribn(i),ric ) + unstable(i) = ribn(i) < 0._r8 + !------------------------------------------------------------------------------------- + ! saturation vapor pressure (Pascals) + ! saturation mixing ratio + ! saturation specific humidity + !------------------------------------------------------------------------------------- + es = 611._r8*exp( 5414.77_r8*(sfc_temp(i) - tmelt)/(tmelt*sfc_temp(i)) ) + ws = .622_r8*es/(pg - es) + qs(i) = ws/(1._r8 + ws) + has_dew(i) = .false. + if( qs(i) <= spec_hum(i) ) then + has_dew(i) = .true. + end if + if( sfc_temp(i) < tmelt ) then + has_dew(i) = .false. + end if + !------------------------------------------------------------------------------------- + ! constant in determining rs + !------------------------------------------------------------------------------------- + tc(i) = sfc_temp(i) - tmelt + if( sfc_temp(i) > tmelt .and. sfc_temp(i) < 313.15_r8 ) then + crs(i) = (1._r8 + (200._r8/(solar_flux(i) + .1_r8))**2) * (400._r8/(tc(i)*(40._r8 - tc(i)))) + else + crs(i) = large_value + end if + !------------------------------------------------------------------------------------- + ! rdc (lower canopy res) + !------------------------------------------------------------------------------------- + rdc(i) = 100._r8*(1._r8 + 1000._r8/(solar_flux(i) + 10._r8))/(1._r8 + 1000._r8*slope) + end do col_loop + + !------------------------------------------------------------------------------------- + ! ... form working arrays + !------------------------------------------------------------------------------------- + do lt = 1,n_land_type + do i=1,ncol + if ( drydep_method == DD_XLND ) then + lcl_frc_landuse(i,lt) = 0._r8 + else + lcl_frc_landuse(i,lt) = fraction_landuse(i,lt,lchnk) + endif + enddo + end do + if ( present(ocnfrc) .and. present(icefrc) ) then + do i=1,ncol + ! land type 7 is used for ocean + ! land type 8 is used for sea ice + lcl_frc_landuse(i,7) = ocnfrc(i) + lcl_frc_landuse(i,8) = icefrc(i) + enddo + endif + do lt = 1,n_land_type + do i=1,ncol + fr_lnduse(i,lt) = lcl_frc_landuse(i,lt) > 0._r8 + enddo + end do + + !------------------------------------------------------------------------------------- + ! find grid averaged z0: z0bar (the roughness length) z_o=exp[S(f_i*ln(z_oi))] + ! this is calculated so as to find u_i, assuming u*u=u_i*u_i + !------------------------------------------------------------------------------------- + z0b(:) = 0._r8 + do lt = 1,n_land_type + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + z0b(i) = z0b(i) + lcl_frc_landuse(i,lt) * log( z0(index_season(i,lt),lt) ) + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! find the constant velocity uu*=(u_i)(u*_i) + !------------------------------------------------------------------------------------- + do i = 1,ncol + z0b(i) = exp( z0b(i) ) + cvarb = vonkar/log( z(i)/z0b(i) ) + !------------------------------------------------------------------------------------- + ! unstable and stable cases + !------------------------------------------------------------------------------------- + if( unstable(i) ) then + bb = 9.4_r8*(cvarb**2)*sqrt( abs(ribn(i))*z(i)/z0b(i) ) + ustarb = cvarb * va(i) * sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*bb)) ) + else + ustarb = cvarb * va(i)/(1._r8 + 4.7_r8*ribn(i)) + end if + uustar(i) = va(i)*ustarb + end do + + !------------------------------------------------------------------------------------- + ! calculate the friction velocity for each land type u_i=uustar/u*_i + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( unstable(i) ) then + cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) + b(i,lt) = 9.4_r8*(cvar(i,lt)**2)* sqrt( abs(ribn(i))*z(i)/z0(index_season(i,lt),lt) ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)*sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*b(i,lt))) ) ) + else + cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) + end if + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! revise calculation of friction velocity and z0 over water + !------------------------------------------------------------------------------------- + lt = 7 + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( unstable(i) ) then + z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) + cvar(i,lt) = vonkar/(log( z(i)/z0water )) + b(i,lt) = 9.4_r8*(cvar(i,lt)**2)*sqrt( abs(ribn(i))*z(i)/z0water ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)* sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8+ 7.4_r8*b(i,lt))) ) ) + else + z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) + cvar(i,lt) = vonkar/(log(z(i)/z0water)) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) + end if + end if + end do + + !------------------------------------------------------------------------------------- + ! compute monin-obukhov length for unstable and stable conditions/ sublayer resistance + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + hvar = (va(i)/0.74_r8) * (tha(i) - thg(i)) * (cvar(i,lt)**2) + if( unstable(i) ) then ! unstable + h = hvar*(1._r8 - (9.4_r8*ribn(i)/(1._r8 + 5.3_r8*b(i,lt)))) + else + h = hvar/((1._r8+4.7_r8*ribn(i))**2) + end if + xmol(i,lt) = thg(i) * ustar(i,lt) * ustar(i,lt) / (vonkar * grav * h) + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! psih + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( xmol(i,lt) < 0._r8 ) then + zovl = z(i)/xmol(i,lt) + zovl = max( -1._r8,zovl ) + psih = exp( .598_r8 + .39_r8*log( -zovl ) - .09_r8*(log( -zovl ))**2 ) + vds = 2.e-3_r8*ustar(i,lt) * (1._r8 + (300/(-xmol(i,lt)))**0.666_r8) + else + zovl = z(i)/xmol(i,lt) + zovl = min( 1._r8,zovl ) + psih = -5._r8 * zovl + vds = 2.e-3_r8*ustar(i,lt) + end if + dep_ra (i,lt,lchnk) = (vonkar - psih*cvar(i,lt))/(ustar(i,lt)*vonkar*cvar(i,lt)) + dep_rb (i,lt,lchnk) = (2._r8/(vonkar*ustar(i,lt))) * crb + rds(i,lt) = 1._r8/vds + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! surface resistance : depends on both land type and species + ! land types are computed seperately, then resistance is computed as average of values + ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 + ! + ! compute rsmx = 1/(rs+rm) : multiply by 3 if surface is wet + !------------------------------------------------------------------------------------- + species_loop1 : do ispec = 1,gas_pcnst + if( has_dvel(ispec) ) then + m = map_dvel(ispec) + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + sndx = index_season(i,lt) + if( ispec == o3_ndx .or. ispec == o3a_ndx .or. ispec == so2_ndx ) then + rmx = 0._r8 + else + rmx = 1._r8/(heff(i,m)/3000._r8 + 100._r8*foxd(m)) + end if + cts(i) = 1000._r8*exp( - tc(i) - 4._r8 ) ! correction for frost + rgsx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rgss(sndx,lt))) + (foxd(m)/rgso(sndx,lt))) + !------------------------------------------------------------------------------------- + ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) + !------------------------------------------------------------------------------------- + if( ispec == h2_ndx .or. ispec == co_ndx .or. ispec == ch4_ndx ) then + if( ispec == co_ndx ) then + fact_h2 = 1.0_r8 + elseif ( ispec == h2_ndx ) then + fact_h2 = 0.5_r8 + elseif ( ispec == ch4_ndx ) then + fact_h2 = 50.0_r8 + end if + !------------------------------------------------------------------------------------- + ! no deposition on snow, ice, desert, and water + !------------------------------------------------------------------------------------- + if( lt == 1 .or. lt == 7 .or. lt == 8 .or. sndx == 4 ) then + rgsx(i,lt,ispec) = large_value + else + var_soilw = max( .1_r8,min( soilw(i),.3_r8 ) ) + if( lt == 3 ) then + var_soilw = log( var_soilw ) + end if + dv_soil_h2 = h2_c(lt) + var_soilw*(h2_b(lt) + var_soilw*h2_a(lt)) + if( dv_soil_h2 > 0._r8 ) then + rgsx(i,lt,ispec) = fact_h2/(dv_soil_h2*1.e-4_r8) + end if + end if + end if + if( lt == 7 ) then + rclx(i,lt,ispec) = large_value + rsmx(i,lt,ispec) = large_value + rlux(i,lt,ispec) = large_value + else + rs = ri(sndx,lt)*crs(i) + if ( has_dew(i) .or. has_rain(i) ) then + dewm = 3._r8 + else + dewm = 1._r8 + end if + rsmx(i,lt,ispec) = (dewm*rs*drat(m) + rmx) + !------------------------------------------------------------------------------------- + ! jfl : special case for PAN + !------------------------------------------------------------------------------------- + if( ispec == pan_ndx .or. ispec == xpan_ndx ) then + dv_pan = c0_pan(lt) * (1._r8 - exp( -k_pan(lt)*(dewm*rs*drat(m))*1.e-2_r8 )) + if( dv_pan > 0._r8 .and. sndx /= 4 ) then + rsmx(i,lt,ispec) = ( 1._r8/dv_pan ) + end if + end if + rclx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rcls(sndx,lt))) + (foxd(m)/rclo(sndx,lt))) + rlux(i,lt,ispec) = cts(i) + rlu(sndx,lt)/(1.e-5_r8*heff(i,m) + foxd(m)) + end if + end if + end do + end do + end if + end do species_loop1 + + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + sndx = index_season(i,lt) + !------------------------------------------------------------------------------------- + ! ... no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( has_dew(i) ) then + rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + rlu(sndx,lt)) + if( o3_ndx > 0 ) then + rlux(i,lt,o3_ndx) = rlux_o3(i,lt) + endif + if( o3a_ndx > 0 ) then + rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) + endif + end if + if( has_rain(i) ) then + ! rlux(i,lt,o3_ndx) = 1./(1.e-3 + (1./(3.*rlu(sndx,lt)))) + rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + 3._r8*rlu(sndx,lt)) + if( o3_ndx > 0 ) then + rlux(i,lt,o3_ndx) = rlux_o3(i,lt) + endif + if( o3a_ndx > 0 ) then + rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) + endif + end if + end if + + if ( o3_ndx > 0 ) then + rclx(i,lt,o3_ndx) = cts(i) + rclo(index_season(i,lt),lt) + rlux(i,lt,o3_ndx) = cts(i) + rlux(i,lt,o3_ndx) + end if + if ( o3a_ndx > 0 ) then + rclx(i,lt,o3a_ndx) = cts(i) + rclo(index_season(i,lt),lt) + rlux(i,lt,o3a_ndx) = cts(i) + rlux(i,lt,o3a_ndx) + end if + + end if + end do + end if + end do + + species_loop2 : do ispec = 1,gas_pcnst + m = map_dvel(ispec) + if( has_dvel(ispec) ) then + if( ispec /= o3_ndx .and. ispec /= o3a_ndx .and. ispec /= so2_ndx ) then + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + !------------------------------------------------------------------------------------- + ! no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( has_dew(i) ) then + rlux(i,lt,ispec) = 1._r8/((1._r8/(3._r8*rlux(i,lt,ispec))) & + + 1.e-7_r8*heff(i,m) + foxd(m)/rlux_o3(i,lt)) + end if + end if + + end if + end do + end if + end do + else if( ispec == so2_ndx ) then + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + !------------------------------------------------------------------------------------- + ! no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( qs(i) <= spec_hum(i) ) then + rlux(i,lt,ispec) = 100._r8 + end if + if( has_rain(i) ) then + ! rlux(i,lt,ispec) = 1./(2.e-4 + (1./(3.*rlu(index_season(i,lt),lt)))) + rlux(i,lt,ispec) = 15._r8*rlu(index_season(i,lt),lt)/(5._r8 + 3.e-3_r8*rlu(index_season(i,lt),lt)) + end if + end if + rclx(i,lt,ispec) = cts(i) + rcls(index_season(i,lt),lt) + rlux(i,lt,ispec) = cts(i) + rlux(i,lt,ispec) + + end if + end do + end if + end do + do i = 1,ncol + if( fr_lnduse(i,1) .and. (has_dew(i) .or. has_rain(i)) ) then + rlux(i,1,ispec) = 50._r8 + end if + end do + end if + end if + end do species_loop2 + + !------------------------------------------------------------------------------------- + ! compute rc + !------------------------------------------------------------------------------------- + term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) + species_loop3 : do ispec = 1,gas_pcnst + if( has_dvel(ispec) ) then + wrk(:) = 0._r8 + lt_loop: do lt = beglt,endlt + do i = 1,ncol + if (fr_lnduse(i,lt)) then + resc(i) = 1._r8/( 1._r8/rsmx(i,lt,ispec) + 1._r8/rlux(i,lt,ispec) & + + 1._r8/(rdc(i) + rclx(i,lt,ispec)) & + + 1._r8/(rac(index_season(i,lt),lt) + rgsx(i,lt,ispec))) + + resc(i) = max( 10._r8,resc(i) ) + + lnd_frc(i) = lcl_frc_landuse(i,lt) + endif + enddo + !------------------------------------------------------------------------------------- + ! ... compute average deposition velocity + !------------------------------------------------------------------------------------- + select case( solsym(ispec) ) + case( 'SO2' ) + if( lt == 7 ) then + where( fr_lnduse(:ncol,lt) ) + ! assume no surface resistance for SO2 over water` + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) + endwhere + else + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:)) + endwhere + end if + + ! JFL - increase in dry deposition of SO2 to improve bias over US/Europe + wrk(:) = wrk(:) * 2._r8 + + case( 'SO4' ) + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + rds(:,lt)) + endwhere + case( 'NH4', 'NH4NO3', 'XNH4NO3' ) + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + 0.5_r8*rds(:,lt)) + endwhere + + !------------------------------------------------------------------------------------- + ! ... special case for Pb (for consistency with offline code) + !------------------------------------------------------------------------------------- + case( 'Pb' ) + if( lt == 7 ) then + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:) * 0.05e-2_r8 + endwhere + else + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 + endwhere + end if + + !------------------------------------------------------------------------------------- + ! ... special case for carbon aerosols + !------------------------------------------------------------------------------------- + case( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB','SOAX' ) + if ( drydep_method == DD_XLND ) then + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.10e-2_r8 + endwhere + else + wrk(:ncol) = 0.10e-2_r8 + endif + + !------------------------------------------------------------------------------------- + ! deposition over ocean for HCN, CH3CN + ! velocity estimated from aircraft measurements (E.Apel, INTEX-B) + !------------------------------------------------------------------------------------- + case( 'HCN','CH3CN' ) + if( lt == 7 ) then ! over ocean only + where( fr_lnduse(:ncol,lt) .and. snow(:ncol) < 0.01_r8 ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 + endwhere + end if + case default + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:ncol)) + endwhere + end select + end do lt_loop + dvel(:ncol,ispec) = wrk(:ncol) * scaling_to_cm_per_s + dflx(:ncol,ispec) = term(:ncol) * dvel(:ncol,ispec) * mmr(:ncol,plev,ispec) + end if + + end do species_loop3 + + if ( beglt > 1 ) return + + !------------------------------------------------------------------------------------- + ! ... special adjustments + !------------------------------------------------------------------------------------- + if( mpan_ndx > 0 ) then + if( has_dvel(mpan_ndx) ) then + dvel(:ncol,mpan_ndx) = dvel(:ncol,mpan_ndx)/3._r8 + dflx(:ncol,mpan_ndx) = term(:ncol) * dvel(:ncol,mpan_ndx) * mmr(:ncol,plev,mpan_ndx) + end if + end if + if( xmpan_ndx > 0 ) then + if( has_dvel(xmpan_ndx) ) then + dvel(:ncol,xmpan_ndx) = dvel(:ncol,xmpan_ndx)/3._r8 + dflx(:ncol,xmpan_ndx) = term(:ncol) * dvel(:ncol,xmpan_ndx) * mmr(:ncol,plev,xmpan_ndx) + end if + end if + + ! HCOOH, use CH3COOH dep.vel + if( hcooh_ndx > 0) then + if( has_dvel(hcooh_ndx) ) then + dvel(:ncol,hcooh_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,hcooh_ndx) = term(:ncol) * dvel(:ncol,hcooh_ndx) * mmr(:ncol,plev,hcooh_ndx) + end if + end if +! +! SOG species +! + if( sogm_ndx > 0) then + if( has_dvel(sogm_ndx) ) then + dvel(:ncol,sogm_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogm_ndx) = term(:ncol) * dvel(:ncol,sogm_ndx) * mmr(:ncol,plev,sogm_ndx) + end if + end if + if( sogi_ndx > 0) then + if( has_dvel(sogi_ndx) ) then + dvel(:ncol,sogi_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogi_ndx) = term(:ncol) * dvel(:ncol,sogi_ndx) * mmr(:ncol,plev,sogi_ndx) + end if + end if + if( sogt_ndx > 0) then + if( has_dvel(sogt_ndx) ) then + dvel(:ncol,sogt_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogt_ndx) = term(:ncol) * dvel(:ncol,sogt_ndx) * mmr(:ncol,plev,sogt_ndx) + end if + end if + if( sogb_ndx > 0) then + if( has_dvel(sogb_ndx) ) then + dvel(:ncol,sogb_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogb_ndx) = term(:ncol) * dvel(:ncol,sogb_ndx) * mmr(:ncol,plev,sogb_ndx) + end if + end if + if( sogx_ndx > 0) then + if( has_dvel(sogx_ndx) ) then + dvel(:ncol,sogx_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogx_ndx) = term(:ncol) * dvel(:ncol,sogx_ndx) * mmr(:ncol,plev,sogx_ndx) + end if + end if +! + end subroutine drydep_xactive + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine soilw_inti( ncfile, nlon_veg, nlat_veg, soilw_map ) + !------------------------------------------------------------------ + ! ... read primary soil moisture table + !------------------------------------------------------------------ + + use time_manager, only : get_calday + + implicit none + + !------------------------------------------------------------------ + ! ... dummy args + !------------------------------------------------------------------ + integer, intent(in) :: & + nlon_veg, & + nlat_veg + real(r8), pointer :: soilw_map(:,:,:) + character(len=*), intent(in) :: ncfile ! file name of netcdf file containing data + + !------------------------------------------------------------------ + ! ... local variables + !------------------------------------------------------------------ + integer :: gndx = 0 + integer :: nlat, & ! # of lats in soilw file + nlon ! # of lons in soilw file + integer :: i, ip, k, m + integer :: j, jl, ju + integer :: lev, day, ierr + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + + integer :: dimid_lat, dimid_lon, dimid_time + integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + + character(len=shr_kind_cl) :: locfn + + !----------------------------------------------------------------------- + ! ... open netcdf file + !----------------------------------------------------------------------- + call getfil (ncfile, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + + !----------------------------------------------------------------------- + ! ... get longitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) + ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) + if( nlon /= nlon_veg ) then + write(iulog,*) 'soilw_inti: soil and vegetation lons differ; ',nlon, nlon_veg + call endrun + end if + !----------------------------------------------------------------------- + ! ... get latitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) + if( nlat /= nlat_veg ) then + write(iulog,*) 'soilw_inti: soil and vegetation lats differ; ',nlat, nlat_veg + call endrun + end if + !----------------------------------------------------------------------- + ! ... set times (days of year) + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'time', dimid_time ) + ierr = pio_inq_dimlen( piofile, dimid_time, ndays ) + if( ndays /= 12 ) then + write(iulog,*) 'soilw_inti: dataset not a cyclical year' + call endrun + end if + allocate( days(ndays),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soilw_inti: days allocation error = ',ierr + call endrun + end if + do m = 1,min(12,ndays) + days(m) = get_calday( dates(m), 0 ) + end do + + !------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------ + allocate( soilw_map(nlon,nlat,ndays), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soilw_inti: soilw_map allocation error = ',ierr + call endrun + end if + + !------------------------------------------------------------------ + ! ... read in the soil moisture + !------------------------------------------------------------------ + ierr = pio_inq_varid( piofile, 'SOILW', vid ) + ierr = pio_get_var( piofile, vid, soilw_map ) + !------------------------------------------------------------------ + ! ... close file + !------------------------------------------------------------------ + call cam_pio_closefile( piofile ) + + end subroutine soilw_inti + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine chk_soilw( calday ) + !-------------------------------------------------------------------- + ! ... check timing for ub values + !-------------------------------------------------------------------- + + use mo_constants, only : dayspy + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + real(r8), intent(in) :: calday + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer :: m, upper + real(r8) :: numer, denom + + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + if( calday < days(1) ) then + next = 1 + last = ndays + else + if( days(ndays) < dayspy ) then + upper = ndays + else + upper = ndays - 1 + end if + do m = upper,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = mod( m,ndays ) + 1 + end if + numer = calday - days(last) + denom = days(next) - days(last) + if( numer < 0._r8 ) then + numer = dayspy + numer + end if + if( denom < 0._r8 ) then + denom = dayspy + denom + end if + dels = max( min( 1._r8,numer/denom ),0._r8 ) + + end subroutine chk_soilw + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine set_soilw( soilw, lchnk, calday ) + !-------------------------------------------------------------------- + ! ... set the soil moisture + !-------------------------------------------------------------------- + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + real(r8), intent(inout) :: soilw(pcols) + integer, intent(in) :: lchnk ! chunk indice + real(r8), intent(in) :: calday + + + integer :: i, ilon,ilat + + call chk_soilw( calday ) + + soilw(:) = soilw_3d(:,last,lchnk) + dels *( soilw_3d(:,next,lchnk) - soilw_3d(:,last,lchnk)) + + end subroutine set_soilw + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + function has_drydep( name ) + + implicit none + + character(len=*), intent(in) :: name + + logical :: has_drydep + integer :: i + + has_drydep = .false. + + do i=1,nddvels + if ( trim(name) == trim(drydep_list(i)) ) then + has_drydep = .true. + exit + endif + enddo + + endfunction has_drydep + +end module mo_drydep diff --git a/src/chemistry/mozart/mo_extfrc.F90 b/src/chemistry/mozart/mo_extfrc.F90 new file mode 100644 index 0000000000..bb77dc2aa1 --- /dev/null +++ b/src/chemistry/mozart/mo_extfrc.F90 @@ -0,0 +1,416 @@ +module mo_extfrc + !--------------------------------------------------------------- + ! ... insitu forcing module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pver, pverp + use chem_mods, only : gas_pcnst, extcnt, extfrc_lst, frc_from_dataset, adv_mass + use spmd_utils, only : masterproc + use cam_abortutils,only : endrun + use cam_history, only : addfld, outfld, add_default, horiz_only + use cam_history_support,only : max_fieldname_len + use cam_logfile, only : iulog + use tracer_data, only : trfld,trfile + use mo_constants, only : avogadro + + implicit none + + type :: forcing + integer :: frc_ndx + real(r8) :: scalefactor + character(len=265):: filename + character(len=16) :: species + integer :: nsectors + character(len=32),pointer :: sectors(:) + type(trfld), pointer :: fields(:) + type(trfile) :: file + end type forcing + + private + public :: extfrc_inti + public :: extfrc_set + public :: extfrc_timestep_init + + save + + integer, parameter :: time_span = 1 + + character(len=256) :: filename + + type(forcing), allocatable :: forcings(:) + integer :: n_frc_files = 0 + +contains + + subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfrc_fixed_ymd, extfrc_fixed_tod) + + !----------------------------------------------------------------------- + ! ... initialize the surface forcings + !----------------------------------------------------------------------- + use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile + use pio, only : pio_inquire, pio_inq_varndims + use pio, only : pio_inq_varname, pio_nowrite, file_desc_t + use pio, only : pio_get_att, PIO_NOERR, PIO_GLOBAL + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use mo_chem_utls, only : get_extfrc_ndx + use chem_mods, only : frc_from_dataset + use tracer_data, only : trcdata_init + use phys_control, only : phys_getopts + use string_utils, only : GLC + use m_MergeSorts, only : IndexSort + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), dimension(:), intent(in) :: extfrc_specifier + character(len=*), intent(in) :: extfrc_type_in + integer , intent(in) :: extfrc_cycle_yr + integer , intent(in) :: extfrc_fixed_ymd + integer , intent(in) :: extfrc_fixed_tod + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: astat + integer :: j, l, m, n, i,mm ! Indices + character(len=16) :: spc_name + character(len=256) :: frc_fnames(gas_pcnst) + real(r8) :: frc_scalefactor(gas_pcnst) + character(len=16) :: frc_species(gas_pcnst) + integer :: frc_indexes(gas_pcnst) + integer :: indx(gas_pcnst) + + integer :: vid, ndims, nvars, isec, ierr + type(file_desc_t) :: ncid + character(len=32) :: varname + + character(len=1), parameter :: filelist = '' + character(len=1), parameter :: datapath = '' + logical , parameter :: rmv_file = .false. + logical :: history_aerosol + logical :: history_chemistry + logical :: history_cesm_forcing + + character(len=32) :: extfrc_type = ' ' + character(len=80) :: file_interp_type = ' ' + character(len=256) :: tmp_string = ' ' + character(len=32) :: xchr = ' ' + real(r8) :: xdbl + + !----------------------------------------------------------------------- + + call phys_getopts( & + history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_cesm_forcing_out = history_cesm_forcing ) + + !----------------------------------------------------------------------- + ! ... species has insitu forcing ? + !----------------------------------------------------------------------- + + !write(iulog,*) 'Species with insitu forcings' + mm = 0 + indx(:) = 0 + + count_emis: do n=1,gas_pcnst + + if ( len_trim(extfrc_specifier(n) ) == 0 ) then + exit count_emis + endif + + i = scan(extfrc_specifier(n),'->') + spc_name = trim(adjustl(extfrc_specifier(n)(:i-1))) + + ! need to parse out scalefactor ... + tmp_string = adjustl(extfrc_specifier(n)(i+2:)) + j = scan( tmp_string, '*' ) + if (j>0) then + xchr = tmp_string(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*') + else + xdbl = 1._r8 + endif + filename = trim(tmp_string) + + m = get_extfrc_ndx( spc_name ) + + if ( m < 1 ) then + call endrun('extfrc_inti: '//trim(spc_name)// ' does not have an external source') + endif + + if ( .not. frc_from_dataset(m) ) then + call endrun('extfrc_inti: '//trim(spc_name)//' cannot have external forcing from additional dataset') + endif + + mm = mm+1 + frc_species(mm) = spc_name + frc_fnames(mm) = filename + frc_indexes(mm) = m + frc_scalefactor(mm) = xdbl + + indx(n)=n + + enddo count_emis + + n_frc_files = mm + + if( n_frc_files < 1 ) then + if (masterproc) write(iulog,*) 'There are no species with insitu forcings' + return + end if + + if (masterproc) write(iulog,*) ' ' + + !----------------------------------------------------------------------- + ! ... allocate forcings type array + !----------------------------------------------------------------------- + allocate( forcings(n_frc_files), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'extfrc_inti: failed to allocate forcings array; error = ',astat + call endrun('extfrc_inti: failed to allocate forcings array') + end if + + !----------------------------------------------------------------------- + ! Sort the input files so that the emissions sources are summed in the + ! same order regardless of the order of the input files in the namelist + !----------------------------------------------------------------------- + if (n_frc_files > 0) then + call IndexSort(n_frc_files, indx, frc_fnames) + end if + + !----------------------------------------------------------------------- + ! ... setup the forcing type array + !----------------------------------------------------------------------- + do m=1,n_frc_files + forcings(m)%frc_ndx = frc_indexes(indx(m)) + forcings(m)%species = frc_species(indx(m)) + forcings(m)%filename = frc_fnames(indx(m)) + forcings(m)%scalefactor = frc_scalefactor(indx(m)) + enddo + + do n= 1,extcnt + if (frc_from_dataset(n)) then + spc_name = extfrc_lst(n) + call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', & + 'external forcing for '//trim(spc_name) ) + call addfld( trim(spc_name)//'_CLXF', horiz_only, 'A', 'molec/cm2/s', & + 'vertically intergrated external forcing for '//trim(spc_name) ) + call addfld( trim(spc_name)//'_CMXF', horiz_only, 'A', 'kg/m2/s', & + 'vertically intergrated external forcing for '//trim(spc_name) ) + if ( history_aerosol .or. history_chemistry ) then + call add_default( trim(spc_name)//'_CLXF', 1, ' ' ) + call add_default( trim(spc_name)//'_CMXF', 1, ' ' ) + endif + if ( history_cesm_forcing .and. spc_name == 'NO2' ) then + call add_default( trim(spc_name)//'_CLXF', 1, ' ' ) + call add_default( trim(spc_name)//'_CMXF', 1, ' ' ) + endif + endif + enddo + + if (masterproc) then + !----------------------------------------------------------------------- + ! ... diagnostics + !----------------------------------------------------------------------- + write(iulog,*) ' ' + write(iulog,*) 'extfrc_inti: diagnostics' + write(iulog,*) ' ' + write(iulog,*) 'extfrc timing specs' + write(iulog,*) 'type = ',extfrc_type + if( extfrc_type == 'FIXED' ) then + write(iulog,*) ' fixed date = ', extfrc_fixed_ymd + write(iulog,*) ' fixed time = ', extfrc_fixed_tod + else if( extfrc_type == 'CYCLICAL' ) then + write(iulog,*) ' cycle year = ',extfrc_cycle_yr + end if + write(iulog,*) ' ' + write(iulog,*) 'there are ',n_frc_files,' species with external forcing files' + do m = 1,n_frc_files + write(iulog,*) ' ' + write(iulog,*) 'forcing type ',m + write(iulog,*) 'species = ',trim(forcings(m)%species) + write(iulog,*) 'frc ndx = ',forcings(m)%frc_ndx + write(iulog,*) 'filename= ',trim(forcings(m)%filename) + end do + write(iulog,*) ' ' + endif + + !----------------------------------------------------------------------- + ! read emis files to determine number of sectors + !----------------------------------------------------------------------- + frcing_loop: do m = 1, n_frc_files + + forcings(m)%nsectors = 0 + + call cam_pio_openfile ( ncid, trim(forcings(m)%filename), PIO_NOWRITE) + ierr = pio_inquire (ncid, nVariables=nvars) + + do vid = 1,nvars + + ierr = pio_inq_varndims (ncid, vid, ndims) + + if( ndims < 4 ) then + cycle + elseif( ndims > 4 ) then + ierr = pio_inq_varname (ncid, vid, varname) + write(iulog,*) 'extfrc_inti: Skipping variable ', trim(varname),', ndims = ',ndims, & + ' , species=',trim(forcings(m)%species) + cycle + end if + + forcings(m)%nsectors = forcings(m)%nsectors+1 + + enddo + + allocate( forcings(m)%sectors(forcings(m)%nsectors), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'extfrc_inti: failed to allocate forcings(m)%sectors array; error = ',astat + call endrun + end if + + isec = 1 + do vid = 1,nvars + + ierr = pio_inq_varndims (ncid, vid, ndims) + if( ndims == 4 ) then + ierr = pio_inq_varname(ncid, vid, forcings(m)%sectors(isec)) + isec = isec+1 + endif + + enddo + + ! Global attribute 'input_method' overrides the ext_frc_type namelist setting on + ! a file-by-file basis. If the ext_frc file does not contain the 'input_method' + ! attribute then the ext_frc_type namelist setting is used. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + if ( ierr == PIO_NOERR) then + l = GLC(file_interp_type) + extfrc_type(1:l) = file_interp_type(1:l) + extfrc_type(l+1:) = ' ' + else + extfrc_type = trim(extfrc_type_in) + endif + + call cam_pio_closefile (ncid) + + allocate(forcings(m)%file%in_pbuf(size(forcings(m)%sectors))) + forcings(m)%file%in_pbuf(:) = .false. + call trcdata_init( forcings(m)%sectors, & + forcings(m)%filename, filelist, datapath, & + forcings(m)%fields, & + forcings(m)%file, & + rmv_file, extfrc_cycle_yr, extfrc_fixed_ymd, extfrc_fixed_tod, trim(extfrc_type) ) + + enddo frcing_loop + + + end subroutine extfrc_inti + + subroutine extfrc_timestep_init( pbuf2d, state ) + !----------------------------------------------------------------------- + ! ... check serial case for time span + !----------------------------------------------------------------------- + + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use tracer_data, only : advance_trcdata + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + do m = 1,n_frc_files + call advance_trcdata( forcings(m)%fields, forcings(m)%file, state, pbuf2d ) + end do + + end subroutine extfrc_timestep_init + + subroutine extfrc_set( lchnk, zint, frcing, ncol ) + + !-------------------------------------------------------- + ! ... form the external forcing + !-------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + + implicit none + + !-------------------------------------------------------- + ! ... dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: zint(ncol, pverp) ! interface geopot above surface (km) + real(r8), intent(inout) :: frcing(ncol,pver,extcnt) ! insitu forcings (molec/cm^3/s) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: m, n + character(len=max_fieldname_len) :: xfcname + real(r8) :: frcing_col(1:ncol), frcing_col_kg(1:ncol) + integer :: k, isec + real(r8),parameter :: km_to_cm = 1.e5_r8 + real(r8),parameter :: cm2_to_m2 = 1.e4_r8 + real(r8),parameter :: kg_to_g = 1.e-3_r8 + real(r8) :: molec_to_kg + integer :: spc_ndx + + if( n_frc_files < 1 .or. extcnt < 1 ) then + return + end if + + frcing(:,:,:) = 0._r8 + + !-------------------------------------------------------- + ! ... set non-zero forcings + !-------------------------------------------------------- + file_loop : do m = 1,n_frc_files + + n = forcings(m)%frc_ndx + + do isec = 1,forcings(m)%nsectors + frcing(:ncol,:,n) = frcing(:ncol,:,n) + forcings(m)%scalefactor*forcings(m)%fields(isec)%data(:ncol,:,lchnk) + enddo + + enddo file_loop + + frc_loop : do n = 1,extcnt + if (frc_from_dataset(n)) then + + xfcname = trim(extfrc_lst(n))//'_XFRC' + call outfld( xfcname, frcing(:ncol,:,n), ncol, lchnk ) + + spc_ndx = get_spc_ndx( extfrc_lst(n) ) + molec_to_kg = adv_mass( spc_ndx ) / avogadro *cm2_to_m2 * kg_to_g + + frcing_col(:ncol) = 0._r8 + frcing_col_kg(:ncol) = 0._r8 + do k = 1,pver + frcing_col(:ncol) = frcing_col(:ncol) + frcing(:ncol,k,n)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm + frcing_col_kg(:ncol) = frcing_col_kg(:ncol) + frcing(:ncol,k,n)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm*molec_to_kg + enddo + + xfcname = trim(extfrc_lst(n))//'_CLXF' + call outfld( xfcname, frcing_col(:ncol), ncol, lchnk ) + xfcname = trim(extfrc_lst(n))//'_CMXF' + call outfld( xfcname, frcing_col_kg(:ncol), ncol, lchnk ) + endif + end do frc_loop + + end subroutine extfrc_set + + +end module mo_extfrc diff --git a/src/chemistry/mozart/mo_fstrat.F90 b/src/chemistry/mozart/mo_fstrat.F90 new file mode 100644 index 0000000000..2cdb4c588f --- /dev/null +++ b/src/chemistry/mozart/mo_fstrat.F90 @@ -0,0 +1,1013 @@ +module mo_fstrat + !--------------------------------------------------------------- + ! ... variables for the upper boundary values + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver,pverp, begchunk, endchunk + use chem_mods, only : gas_pcnst + use cam_abortutils, only : endrun + use cam_pio_utils, only : cam_pio_openfile + use pio + use cam_logfile, only : iulog + + implicit none + + private + public :: fstrat_inti + public :: set_fstrat_vals + public :: set_fstrat_h2o + public :: has_fstrat + + save + + real(r8), parameter :: taurelax = 864000._r8 ! 10 days + integer :: gndx = 0 + integer :: table_nox_ndx = -1 + integer :: table_h2o_ndx = -1 + integer :: table_ox_ndx = -1 + integer :: table_synoz_ndx = -1 + integer :: no_ndx + integer :: no2_ndx + integer :: h2o_ndx + integer :: ox_ndx + integer :: o3s_ndx + integer :: o3inert_ndx + integer :: o3a_ndx + integer :: xno_ndx + integer :: xno2_ndx + integer :: synoz_ndx + integer :: o3rad_ndx + real(r8) :: facrelax + real(r8) :: days(12) + real(r8), allocatable :: ub_plevs(:) ! table midpoint pressure levels (Pa) + real(r8), allocatable :: ub_plevse(:) ! table edge pressure levels (Pa) + integer :: ub_nlevs ! # of levs in ubc file + integer :: ub_nlat ! # of lats in ubc file + integer :: ub_nspecies ! # of species in ubc file + integer :: ub_nmonth ! # of months in ubc file + real(r8), allocatable :: mr_ub(:,:,:,:,:) ! vmr + integer, allocatable :: map(:) ! species indices for ubc species + logical :: sim_has_nox + integer :: dtime ! model time step (s) + logical :: has_fstrat(gas_pcnst) + +contains + + subroutine fstrat_inti( fstrat_file, fstrat_list ) + !------------------------------------------------------------------ + ! ... initialize upper boundary values + !------------------------------------------------------------------ + + use mo_constants, only : d2r + use phys_grid, only : get_ncols_p, get_rlat_all_p + + use time_manager, only : get_step_size + use time_manager, only : get_calday + use ioFileMod, only : getfil + use spmd_utils, only : masterproc +#ifdef SPMD + use mpishorthand, only : mpicom,mpiint,mpir8 +#endif + use mo_tracname, only : solsym + use chem_mods, only : gas_pcnst + use mo_chem_utls, only : get_spc_ndx, get_inv_ndx + use constituents, only : pcnst + use interpolate_data, only : interp_type, lininterp_init, lininterp + implicit none + + character(len=*), intent(in) :: fstrat_file + character(len=*), intent(in) :: fstrat_list(:) + + !------------------------------------------------------------------ + ! ... local variables + !------------------------------------------------------------------ + real(r8), parameter :: mb2pa = 100._r8 + + integer :: i, j, nchar + integer :: spcno, lev, month, ierr + integer :: vid, ndims + type(file_desc_t) :: ncid + integer :: dimid_lat, dimid_lev, dimid_species, dimid_month + integer :: dimid(4) + integer :: start(4) + integer :: count(4) + integer, parameter :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + integer :: ncols, c + real(r8), allocatable :: mr_ub_in(:,:,:,:) + real(r8), allocatable :: lat(:) + real(r8) :: to_lats(pcols) + character(len=80) :: attribute + character(len=8) :: wrk_name + character(len=25), allocatable :: ub_species_names(:) + character(len=256) :: locfn + type(interp_type) :: lat_wgts + + + !----------------------------------------------------------------------- + ! ... get species indicies + !----------------------------------------------------------------------- + no_ndx = get_spc_ndx( 'NO' ) + no2_ndx = get_spc_ndx( 'NO2' ) + sim_has_nox = no_ndx > 0 .or. no2_ndx > 0 + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + o3s_ndx = get_spc_ndx( 'O3S' ) + o3inert_ndx = get_spc_ndx( 'O3INERT' ) + o3rad_ndx = get_spc_ndx( 'O3RAD' ) + synoz_ndx = get_spc_ndx( 'SYNOZ' ) + o3a_ndx = get_spc_ndx( 'O3A' ) + xno_ndx = get_spc_ndx( 'XNO' ) + xno2_ndx = get_spc_ndx( 'XNO2' ) + + if (.not.((o3rad_ndx > 0) .eqv. (synoz_ndx > 0))) then + call endrun('fstrat_inti: Both SYNOZ and O3RAD are required in chemical mechanism.') + endif + if(masterproc) then + if (synoz_ndx > 0) then + if ( .not. any(fstrat_list == 'O3RAD') ) then + write(iulog,*) 'fstrat_inti: ***WARNING*** O3RAD is not include in fstrat_list namelist variable' + endif + else if (ox_ndx > 0) then + if ( .not. any(fstrat_list == 'O3') ) then + write(iulog,*) 'fstrat_inti: ***WARNING*** O3 is not include in fstrat_list namelist variable' + endif + endif + end if + h2o_ndx = get_spc_ndx( 'H2O' ) + if( h2o_ndx < 0 ) then + h2o_ndx = get_inv_ndx( 'H2O' ) + end if + + has_fstrat(:) = .false. + + do i = 1,pcnst + + if ( len_trim(fstrat_list(i))==0 ) exit + + j = get_spc_ndx(fstrat_list(i)) + + if ( j > 0 ) then + has_fstrat(j) = .true. + else + write(iulog,*) 'fstrat_inti: '//trim(fstrat_list(i))//' is not included in species set' + call endrun('fstrat_inti: invalid fixed stratosphere species') + endif + + enddo + + if (.not. any(has_fstrat(:))) return + + !----------------------------------------------------------------------- + ! ... open netcdf file + !----------------------------------------------------------------------- + call getfil (fstrat_file, locfn, 0) + call cam_pio_openfile (ncid, trim(locfn), PIO_NOWRITE) + !----------------------------------------------------------------------- + ! ... get latitude + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( ncid, dimid_lat, ub_nlat ) + allocate( lat(ub_nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: lat allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( ncid, 'lat', vid ) + ierr = pio_get_var( ncid, vid, lat ) + lat(:ub_nlat) = lat(:ub_nlat) * d2r + + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: failed to deallocate lat; ierr = ',ierr + call endrun + end if + + !----------------------------------------------------------------------- + ! ... get vertical coordinate (if necessary, convert units to pa) + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lev', dimid_lev ) + ierr = pio_inq_dimlen( ncid, dimid_lev, ub_nlevs ) + allocate( ub_plevs(ub_nlevs), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: ub_plevs allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( ncid, 'lev', vid ) + ierr = pio_get_var( ncid, vid, ub_plevs ) + attribute(:) = ' ' + call pio_seterrorhandling(ncid, pio_BCAST_error) + ierr = pio_get_att( ncid, vid, 'units', attribute ) + call pio_seterrorhandling(ncid, pio_INTERNAL_error) + if( ierr == PIO_noerr )then + if( trim(attribute) == 'mb' .or. trim(attribute) == 'hpa' )then + if (masterproc) write(iulog,*) 'fstrat_inti: units for lev = ',trim(attribute),'... converting to pa' + ub_plevs(:) = mb2pa * ub_plevs(:) + else if( trim(attribute) /= 'pa' .and. trim(attribute) /= 'pa' )then + write(iulog,*) 'fstrat_inti: unknown units for lev, units=*',trim(attribute),'*' + write(iulog,*) 'fstrat_inti: ',attribute=='mb',trim(attribute)=='mb',attribute(1:2)=='mb' + call endrun + end if + else + write(iulog,*) 'fstrat_inti: warning! units attribute for lev missing, assuming mb' + ub_plevs(:) = mb2pa * ub_plevs(:) + end if + !----------------------------------------------------------------------- + ! ... get time and species dimensions + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'month', dimid_month ) + ierr = pio_inq_dimlen( ncid, dimid_month, ub_nmonth ) + if( ub_nmonth /= 12 )then + write(iulog,*) 'fstrat_inti: error! number of months = ',ub_nmonth,', expecting 12' + call endrun + end if + ierr = pio_inq_dimid( ncid, 'species', dimid_species ) + ierr = pio_inq_dimlen( ncid, dimid_species, ub_nspecies ) + + !------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------ + allocate( mr_ub_in(ub_nlat,ub_nspecies,ub_nmonth,ub_nlevs), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: mr_ub_in allocation error = ',ierr + call endrun + end if + allocate( mr_ub(pcols,ub_nspecies,ub_nmonth,ub_nlevs,begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: mr_ub allocation error = ',ierr + call endrun + end if + + !------------------------------------------------------------------ + ! ... read in the species names + !------------------------------------------------------------------ + + ierr = pio_inq_varid( ncid, 'specname', vid ) + ierr = pio_inq_vardimid( ncid, vid, dimid ) + ierr = pio_inq_dimlen( ncid, dimid(1), nchar ) + allocate( ub_species_names(ub_nspecies), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: ub_species_names allocation error = ',ierr + call endrun + end if + allocate( map(ub_nspecies), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: map allocation error = ',ierr + call endrun + end if + + table_loop : do i = 1,ub_nspecies + start(:2) = (/ 1, i /) + count(:2) = (/ nchar, 1 /) + ub_species_names(i)(:) = ' ' + ierr = pio_get_var( ncid, vid, start(:2), count(:2), ub_species_names(i:i)) + if( trim(ub_species_names(i)) == 'NOX' ) then + table_nox_ndx = i + else if( trim(ub_species_names(i)) == 'H2O' ) then + table_h2o_ndx = i + else if( trim(ub_species_names(i)) == 'OX' ) then + table_ox_ndx = i + else if( trim(ub_species_names(i)) == 'SYNOZ' ) then + table_synoz_ndx = i + end if + map(i) = 0 + do j = 1,gas_pcnst + if( trim(ub_species_names(i)) == trim(solsym(j)) ) then + if( has_fstrat(j) ) then + map(i) = j + if( masterproc ) write(iulog,*) 'fstrat_inti: '//trim(solsym(j))//' is fixed in stratosphere' + exit + end if + endif + end do + if( map(i) == 0 ) then + if( trim(ub_species_names(i)) == 'OX' ) then + if( o3rad_ndx > 0 ) then + wrk_name = 'O3RAD' + else + wrk_name = 'O3' + end if + do j = 1,gas_pcnst + if( trim(wrk_name) == trim(solsym(j)) ) then + if( has_fstrat(j) ) then + if( masterproc ) write(iulog,*) 'fstrat_inti: '//trim(solsym(j))//' is fixed in stratosphere' + map(i) = j + exit + end if + end if + end do + if( map(i) == 0 ) then + write(iulog,*) 'fstrat_inti: ubc table species ',trim(ub_species_names(i)), ' not used' + end if + else if( (trim(ub_species_names(i)) /= 'NOX') .and. (trim(ub_species_names(i)) /= 'H2O') ) then + write(iulog,*) 'fstrat_inti: ubc table species ',trim(ub_species_names(i)), ' not used' + end if + end if + end do table_loop + + if( table_nox_ndx > 0 ) then + if ( any(fstrat_list(:) == 'NO') .or. any(fstrat_list(:) == 'NO2') ) then + map(table_nox_ndx) = gas_pcnst + 1 + else + write(iulog,*) 'fstrat_inti: ubc table species ',trim(ub_species_names(table_nox_ndx)), ' not used' + endif + end if + if( table_h2o_ndx > 0 ) then + if ( h2o_ndx > 0 ) then + map(table_h2o_ndx) = gas_pcnst + 2 + else + write(iulog,*) 'fstrat_inti: ubc table species ',trim(ub_species_names(table_h2o_ndx)), ' not used' + endif + end if + + if (masterproc) write(iulog,*) 'fstrat_inti: h2o_ndx, table_h2o_ndx = ', h2o_ndx, table_h2o_ndx + + !------------------------------------------------------------------ + ! ... check dimensions for vmr variable + !------------------------------------------------------------------ + ierr = pio_inq_varid( ncid, 'vmr', vid ) + ierr = pio_inq_varndims( ncid, vid, ndims ) + if( ndims /= 4 ) then + write(iulog,*) 'fstrat_inti: error! variable vmr has ndims = ',ndims,', expecting 4' + call endrun + end if + ierr = pio_inq_vardimid( ncid, vid, dimid ) + if( dimid(1) /= dimid_lat .or. dimid(2) /= dimid_species .or. & + dimid(3) /= dimid_month .or. dimid(4) /= dimid_lev )then + write(iulog,*) 'fstrat_inti: error! dimensions in wrong order for variable vmr,'// & + 'expecting (lat,species,month,lev)' + call endrun + end if + + !------------------------------------------------------------------ + ! ... read in the ub mixing ratio values + !------------------------------------------------------------------ + start = (/ 1, 1, 1, 1 /) + count = (/ ub_nlat, ub_nspecies, ub_nmonth, ub_nlevs /) + + ierr = pio_get_var( ncid, vid, start, count, mr_ub_in ) + call pio_closefile (ncid) + !-------------------------------------------------------------------- + ! ... regrid + !-------------------------------------------------------------------- + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call lininterp_init(lat,ub_nlat, to_lats, ncols, 1, lat_wgts) + + do lev = 1,ub_nlevs + do month = 1,ub_nmonth + do spcno = 1,ub_nspecies + if( map(spcno) > 0 ) then + + call lininterp(mr_ub_in(:,spcno, month, lev), ub_nlat, mr_ub(:,spcno,month,lev,c), & + ncols, lat_wgts) + + ! call regrid_1d( mr_ub_in(:,spcno,month,lev), mr_ub(:,spcno,month,lev), gndx, & + ! do_lat=.true.,to_lat_min=1, to_lat_max=plat ) +#ifdef DEBUG + if( lev == 25 .and. month == 1 .and. spcno == 1 ) then + write(iulog,*) 'mr_ub_in=' + write(iulog,'(10f7.1)') mr_ub_in(:,spcno,month,lev)*1.e9_r8 + write(iulog,*) 'mr_ub=' + write(iulog,'(10f7.1)') mr_ub(:,spcno,month,lev)*1.e9_r8 + end if +#endif + ! mr_ub(1,spcno,month,lev) = mr_ub(2,spcno,month,lev) + ! mr_ub(plat,spcno,month,lev) = mr_ub(plat-1,spcno,month,lev) + + end if + + end do + end do + end do + end do + !-------------------------------------------------------- + ! ... initialize the monthly day of year times + !-------------------------------------------------------- + do month = 1,12 + days(month) = get_calday( dates(month), 0 ) + end do + + !-------------------------------------------------------- + ! ... set up the relaxation for lower stratosphere + !-------------------------------------------------------- + ! ... taurelax = relaxation timescale (in sec) + ! facrelax = fractional relaxation towards ubc + ! 1 => use ubc + ! 0 => ignore ubc, use model concentrations + !-------------------------------------------------------- + dtime = get_step_size() + facrelax = 1._r8 - exp( -real(dtime)/taurelax ) + + !-------------------------------------------------------- + ! ... setup conserving interp for OX + !-------------------------------------------------------- + if( table_ox_ndx > 0 ) then + allocate( ub_plevse(ub_nlevs-1), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'fstrat_inti: ub_plevse allocation error = ',ierr + call endrun + end if + ub_plevse(1:ub_nlevs-1) = .5_r8*(ub_plevs(1:ub_nlevs-1) + ub_plevs(2:ub_nlevs)) + end if + + end subroutine fstrat_inti + + subroutine set_fstrat_vals( vmr, pmid, pint, ltrop, calday, ncol,lchnk ) + + !-------------------------------------------------------------------- + ! ... set the upper boundary values for : + ! ox, nox, hno3, ch4, co, n2o, n2o5 & stratospheric o3 + !-------------------------------------------------------------------- + + use mo_synoz, only : synoz_region => po3 + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + integer, intent(in) :: lchnk ! chunk number + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: ltrop(pcols) ! tropopause vertical index + real(r8), intent(in) :: calday ! day of year including fraction + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressure (Pa) + real(r8), intent(inout) :: vmr(ncol,pver,gas_pcnst) ! species concentrations (mol/mol) + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer, parameter :: zlower = pver + real(r8), parameter :: synoz_thres = 100.e-9_r8 ! synoz threshold + real(r8), parameter :: o3rad_relax = 0.5_r8*86400._r8 ! 1/2 day relaxation constant + real(r8), parameter :: synoz_relax = 2._r8*86400._r8 ! 2 day relaxation constant + real(r8), parameter :: synoz_strat_relax = 5._r8*86400._r8 ! 5 day relaxation constant + + integer :: m, last, next, i, k, k1, km + integer :: astat + integer :: kmax(ncol) + integer :: levrelax + integer :: kl(ncol,zlower) + integer :: ku(ncol,zlower) + real(r8) :: vmrrelax + real(r8) :: fac_relax + real(r8) :: pinterp + real(r8) :: nox_ubc, xno, xno2, rno + real(r8) :: dels + real(r8) :: delp(ncol,zlower) + real(r8) :: pint_vals(2) + real(r8), allocatable :: table_ox(:) + logical :: found_trop + integer :: lat + + if (.not. any(has_fstrat(:))) return + + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + if( calday < days(1) ) then + next = 1 + last = 12 + dels = (365._r8 + calday - days(12)) / (365._r8 + days(1) - days(12)) + else if( calday >= days(12) ) then + next = 1 + last = 12 + dels = (calday - days(12)) / (365._r8 + days(1) - days(12)) + else + do m = 11,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = m + 1 + dels = (calday - days(m)) / (days(m+1) - days(m)) + end if + dels = max( min( 1._r8,dels ),0._r8 ) + + !-------------------------------------------------------- + ! ... setup the pressure interpolation + !-------------------------------------------------------- + do k = 1,zlower + do i = 1,ncol + if( pmid(i,k) <= ub_plevs(1) ) then + kl(i,k) = 1 + ku(i,k) = 1 + delp(i,k) = 0._r8 + else if( pmid(i,k) >= ub_plevs(ub_nlevs) ) then + kl(i,k) = ub_nlevs + ku(i,k) = ub_nlevs + delp(i,k) = 0._r8 + else + pinterp = pmid(i,k) + do k1 = 2,ub_nlevs + if( pinterp <= ub_plevs(k1) ) then + ku(i,k) = k1 + kl(i,k) = k1 - 1 + delp(i,k) = log( pinterp/ub_plevs(kl(i,k)) ) & + / log( ub_plevs(ku(i,k))/ub_plevs(kl(i,k)) ) + exit + end if + end do + end if + end do + end do + + !-------------------------------------------------------- + ! ... find max level less than 50 mb + ! fix UB vals from top of model to this level + !-------------------------------------------------------- + do i = 1,ncol + do k = 2,pver + if( pmid(i,k) > 50.e2_r8 ) then + kmax(i) = k + exit + end if + end do + end do + + !-------------------------------------------------------- + ! ... setup for ox conserving interp + !-------------------------------------------------------- + if( table_ox_ndx > 0 ) then + if( map(table_ox_ndx) > 0 ) then + allocate( table_ox(ub_nlevs-2),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'set_fstrat_vals: table_ox allocation error = ',astat + call endrun + end if +#ifdef UB_DEBUG + write(iulog,*) ' ' + write(iulog,*) 'set_fstrat_vals: ub_nlevs = ',ub_nlevs + write(iulog,*) 'set_fstrat_vals: ub_plevse' + write(iulog,'(1p5g15.7)') ub_plevse(:) + write(iulog,*) ' ' +#endif + end if + end if + + !-------------------------------------------------------- + ! ... set the mixing ratios at upper boundary + !-------------------------------------------------------- + species_loop : do m = 1,ub_nspecies + ub_overwrite : if( map(m) > 0 ) then + if( m == table_ox_ndx ) then + do i = 1,ncol + + table_ox(1:ub_nlevs-2) = mr_ub(i,m,last,2:ub_nlevs-1,lchnk) & + + dels*(mr_ub(i,m,next,2:ub_nlevs-1,lchnk) & + - mr_ub(i,m,last,2:ub_nlevs-1,lchnk)) +#ifdef UB_DEBUG + write(iulog,*) 'set_fstrat_vals: table_ox @ lat = ',lat + write(iulog,'(1p5g15.7)') table_ox(:) + write(iulog,*) ' ' +#endif + + km = kmax(i) +#ifdef UB_DEBUG + write(iulog,*) 'set_fstrat_vals: pint with km = ',km + write(iulog,'(1p5g15.7)') pint(i,:km+1) + write(iulog,*) ' ' + write(iulog,*) 'set_fstrat_vals: pmid with km = ',km + write(iulog,'(1p5g15.7)') pmid(i,:km) + write(iulog,*) ' ' +#endif + call rebin( ub_nlevs-2, km, ub_plevse, pint(i,:km+1), table_ox, vmr(i,:km,map(m)) ) +#ifdef UB_DEBUG + write(iulog,*) 'set_fstrat_vals: ub o3 @ lat = ',lat + write(iulog,'(1p5g15.7)') vmr(i,:km,map(m)) +#endif + end do + deallocate( table_ox ) + cycle species_loop + end if + do i = 1,ncol + do k = 1,kmax(i) + pint_vals(1) = mr_ub(i,m,last,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,last,ku(i,k),lchnk) & + - mr_ub(i,m,last,kl(i,k),lchnk)) + pint_vals(2) = mr_ub(i,m,next,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,next,ku(i,k),lchnk) & + - mr_ub(i,m,next,kl(i,k),lchnk)) + if( m /= table_nox_ndx .and. m /= table_h2o_ndx .and. m /= table_synoz_ndx ) then + vmr(i,k,map(m)) = pint_vals(1) & + + dels * (pint_vals(2) - pint_vals(1)) + else if( m == table_nox_ndx .and. sim_has_nox ) then + + nox_ubc = pint_vals(1) + dels * (pint_vals(2) - pint_vals(1)) + if( no_ndx > 0 ) then + xno = vmr(i,k,no_ndx) + else + xno = 0._r8 + end if + if( no2_ndx > 0 ) then + xno2 = vmr(i,k,no2_ndx) + else + xno2 = 0._r8 + end if + rno = xno / (xno + xno2) + if( no_ndx > 0 ) then + vmr(i,k,no_ndx) = rno * nox_ubc + end if + if( no2_ndx > 0 ) then + vmr(i,k,no2_ndx) = (1._r8 - rno) * nox_ubc + end if + end if + end do + end do + end if ub_overwrite + end do species_loop + + col_loop2 : do i = 1,ncol + !-------------------------------------------------------- + ! ... relax lower stratosphere to extended ubc + ! check to make sure ubc is not being imposed too low + ! levrelax = lowest model level (highest pressure) + ! in which to relax to ubc + !-------------------------------------------------------- + levrelax = ltrop(i) + do while( pmid(i,levrelax) > ub_plevs(ub_nlevs) ) + levrelax = levrelax - 1 + end do +#ifdef DEBUG + if( levrelax /= ltrop(i) ) then + write(iulog,*) 'warning -- raised ubc: ',lat,i, + ltrop(i)-1,nint(pmid(i,ltrop(i)-1)/mb2pa),'mb -->', + levrelax,nint(pmid(i,levrelax)/mb2pa),'mb' + end if +#endif + level_loop2 : do k = kmax(i)+1,levrelax + if( sim_has_nox ) then + if( no_ndx > 0 ) then + xno = vmr(i,k,no_ndx) + else + xno = 0._r8 + end if + if( no2_ndx > 0 ) then + xno2 = vmr(i,k,no2_ndx) + else + xno2 = 0._r8 + end if + rno = xno / (xno + xno2) + nox_ubc = xno + xno2 + end if + do m = 1,ub_nspecies + if( map(m) < 1 ) then + cycle + end if + pint_vals(1) = mr_ub(i,m,last,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,last,ku(i,k),lchnk) & + - mr_ub(i,m,last,kl(i,k),lchnk)) + pint_vals(2) = mr_ub(i,m,next,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,next,ku(i,k),lchnk) & + - mr_ub(i,m,next,kl(i,k),lchnk)) + vmrrelax = pint_vals(1) & + + dels * (pint_vals(2) - pint_vals(1)) + if( m /= table_nox_ndx .and. m /= table_h2o_ndx .and. m /= table_synoz_ndx ) then + vmr(i,k,map(m)) = vmr(i,k,map(m)) & + + (vmrrelax - vmr(i,k,map(m))) * facrelax + else if( m == table_nox_ndx .and. sim_has_nox) then + + nox_ubc = nox_ubc + (vmrrelax - nox_ubc) * facrelax + end if + end do + if( sim_has_nox ) then + if( no_ndx > 0 ) then + vmr(i,k,no_ndx) = rno * nox_ubc + end if + if( no2_ndx > 0 ) then + vmr(i,k,no2_ndx) = (1._r8 - rno) * nox_ubc + end if + end if + end do level_loop2 + + has_synoz : if( synoz_ndx > 0 ) then + if ( synoz_ndx > 0 .and. table_synoz_ndx > 0 ) then + fac_relax = 1._r8 - exp( -real(dtime) / synoz_strat_relax ) + do k = 1,pver + m = table_synoz_ndx + if ( synoz_region(i,k,lchnk) > 0._r8 ) then + pint_vals(1) = mr_ub(i,m,last,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,last,ku(i,k),lchnk) & + - mr_ub(i,m,last,kl(i,k),lchnk)) + pint_vals(2) = mr_ub(i,m,next,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,next,ku(i,k),lchnk) & + - mr_ub(i,m,next,kl(i,k),lchnk)) + vmrrelax = pint_vals(1) & + + dels * (pint_vals(2) - pint_vals(1)) + vmr(i,k,map(m)) = vmr(i,k,map(m)) & + + (vmrrelax - vmr(i,k,map(m))) * fac_relax + endif + enddo + endif + + !-------------------------------------------------------- + ! ... special assignments if synoz is present + ! update ox, o3s, o3inert in the stratosphere + !-------------------------------------------------------- + if( ox_ndx > 0 ) then + do k = 1,levrelax + if( vmr(i,k,synoz_ndx) >= synoz_thres ) then + vmr(i,k,ox_ndx) = vmr(i,k,synoz_ndx) + end if + end do + end if + if( o3s_ndx > 0 ) then + do k = 1,levrelax + if( vmr(i,k,synoz_ndx) >= synoz_thres ) then + vmr(i,k,o3s_ndx) = vmr(i,k,synoz_ndx) + end if + end do + end if + if( o3rad_ndx > 0 .and. o3inert_ndx > 0 ) then + vmr(i,:ltrop(i),o3inert_ndx) = vmr(i,:ltrop(i),o3rad_ndx) + end if + !-------------------------------------------------------- + ! ... O3RAD is relaxed to climatology in the stratosphere + ! (done above) and OX in the troposphere + !-------------------------------------------------------- + if( o3rad_ndx > 0 .and. ox_ndx > 0 ) then + fac_relax = 1._r8 - exp( -real(dtime) / o3rad_relax ) + do k = levrelax+1,pver + vmr(i,k,o3rad_ndx) = vmr(i,k,o3rad_ndx) & + + (vmr(i,k,ox_ndx) - vmr(i,k,o3rad_ndx)) * fac_relax + end do + end if + !-------------------------------------------------------- + ! ... relax synoz to 25 ppbv in lower troposphere + ! (p > 500 hPa) with an e-fold time of 2 days + ! (Mc Linden et al., JGR, p14,660, 2000) + !-------------------------------------------------------- + fac_relax = 1._r8 - exp( -real(dtime) / synoz_relax ) + vmrrelax = 25.e-9_r8 + do k = levrelax+2,pver + if( pmid(i,k) >= 50000._r8 ) then + vmr(i,k,synoz_ndx) = vmr(i,k,synoz_ndx) & + + (vmrrelax - vmr(i,k,synoz_ndx)) * fac_relax + end if + end do + else has_synoz + + !-------------------------------------------------------- + ! ... set O3S and O3INERT to OX when no synoz + !-------------------------------------------------------- + if( ox_ndx > 0 ) then + if( o3s_ndx > 0 ) then + vmr(i,:ltrop(i),o3s_ndx) = vmr(i,:ltrop(i),ox_ndx) + end if + if( o3inert_ndx > 0 ) then + vmr(i,:ltrop(i),o3inert_ndx) = vmr(i,:ltrop(i),ox_ndx) + end if + end if + + end if has_synoz + + if ( o3a_ndx > 0 ) then + vmr(i,:ltrop(i),o3a_ndx) = (1._r8 - facrelax ) * vmr(i,:ltrop(i),o3a_ndx) + endif + if ( xno_ndx > 0 ) then + vmr(i,:ltrop(i),xno_ndx) = (1._r8 - facrelax ) * vmr(i,:ltrop(i),xno_ndx) + endif + if ( xno2_ndx > 0 ) then + vmr(i,:ltrop(i),xno2_ndx) = (1._r8 - facrelax ) * vmr(i,:ltrop(i),xno2_ndx) + endif + + end do col_loop2 + + end subroutine set_fstrat_vals + + subroutine set_fstrat_h2o( h2o, pmid, ltrop, calday, ncol, lchnk ) + !-------------------------------------------------------------------- + ! ... set the h2o upper boundary values + !-------------------------------------------------------------------- + + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: ltrop(pcols) ! tropopause vertical index + integer, intent(in) :: lchnk + real(r8), intent(in) :: calday ! day of year including fraction + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(inout) :: h2o(ncol,pver) ! h2o concentration (mol/mol) + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer, parameter :: zlower = pver + + integer :: m, last, next, i, k, k1 + integer :: kmax(ncol) + integer :: levrelax + integer :: kl(ncol,zlower) + integer :: ku(ncol,zlower) + real(r8) :: vmrrelax + real(r8) :: fac_relax + real(r8) :: pinterp + real(r8) :: dels + real(r8) :: delp(ncol,zlower) + real(r8) :: pint_vals(2) + logical :: found_trop + integer :: lat + + h2o_overwrite : if( h2o_ndx > 0 .and. table_h2o_ndx > 0 ) then + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + if( calday < days(1) ) then + next = 1 + last = 12 + dels = (365._r8 + calday - days(12)) / (365._r8 + days(1) - days(12)) + else if( calday >= days(12) ) then + next = 1 + last = 12 + dels = (calday - days(12)) / (365._r8 + days(1) - days(12)) + else + do m = 11,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = m + 1 + dels = (calday - days(m)) / (days(m+1) - days(m)) + end if + dels = max( min( 1._r8,dels ),0._r8 ) + + !-------------------------------------------------------- + ! ... setup the pressure interpolation + !-------------------------------------------------------- + do k = 1,zlower + do i = 1,ncol + if( pmid(i,k) <= ub_plevs(1) ) then + kl(i,k) = 1 + ku(i,k) = 1 + delp(i,k) = 0._r8 + else if( pmid(i,k) >= ub_plevs(ub_nlevs) ) then + kl(i,k) = ub_nlevs + ku(i,k) = ub_nlevs + delp(i,k) = 0._r8 + else + pinterp = pmid(i,k) + do k1 = 2,ub_nlevs + if( pinterp <= ub_plevs(k1) ) then + ku(i,k) = k1 + kl(i,k) = k1 - 1 + delp(i,k) = log( pinterp/ub_plevs(kl(i,k)) ) & + / log( ub_plevs(ku(i,k))/ub_plevs(kl(i,k)) ) + exit + end if + end do + end if + end do + end do + + !-------------------------------------------------------- + ! ... Find max level less than 50 mb + ! fix UB vals from top of model to this level + !-------------------------------------------------------- + do i = 1,ncol + do k = 2,pver + if( pmid(i,k) > 50.e2_r8 ) then + kmax(i) = k + exit + end if + end do + end do + !-------------------------------------------------------- + ! ... set the mixing ratio at upper boundary + !-------------------------------------------------------- + m = table_h2o_ndx + do i = 1,ncol + do k = 1,kmax(i) + pint_vals(1) = mr_ub(i,m,last,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,last,ku(i,k),lchnk) & + - mr_ub(i,m,last,kl(i,k),lchnk)) + pint_vals(2) = mr_ub(i,m,next,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,next,ku(i,k),lchnk) & + - mr_ub(i,m,next,kl(i,k),lchnk)) + h2o(i,k) = pint_vals(1) & + + dels * (pint_vals(2) - pint_vals(1)) + end do + end do + + col_loop2 : do i = 1,ncol + !-------------------------------------------------------- + ! ... relax lower stratosphere to extended ubc + ! check to make sure ubc is not being imposed too low + ! levrelax = lowest model level (highest pressure) + ! in which to relax to ubc + !-------------------------------------------------------- + levrelax = ltrop(i) + do while( pmid(i,levrelax) > ub_plevs(ub_nlevs) ) + levrelax = levrelax - 1 + end do +#ifdef DEBUG + if( levrelax /= ltrop(i) ) then + write(iulog,*) 'warning -- raised ubc: ',lat,i, + ltrop(i)-1,nint(pmid(i,ltrop(i)-1)/100._r8),'mb -->', + levrelax,nint(pmid(i,levrelax)/100._r8),'mb' + end if +#endif + do k = kmax(i)+1,levrelax + pint_vals(1) = mr_ub(i,m,last,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,last,ku(i,k),lchnk) & + - mr_ub(i,m,last,kl(i,k),lchnk)) + pint_vals(2) = mr_ub(i,m,next,kl(i,k),lchnk) & + + delp(i,k) & + * (mr_ub(i,m,next,ku(i,k),lchnk) & + - mr_ub(i,m,next,kl(i,k),lchnk)) + vmrrelax = pint_vals(1) & + + dels * (pint_vals(2) - pint_vals(1)) + h2o(i,k) = h2o(i,k) + (vmrrelax - h2o(i,k)) * facrelax + end do + end do col_loop2 + end if h2o_overwrite + + end subroutine set_fstrat_h2o + + subroutine rebin( nsrc, ntrg, src_x, trg_x, src, trg ) + !--------------------------------------------------------------- + ! ... rebin src to trg + !--------------------------------------------------------------- + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: trg_x(ntrg+1) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + integer :: i, l + integer :: si, si1 + integer :: sil, siu + real(r8) :: y + real(r8) :: sl, su + real(r8) :: tl, tu + + !--------------------------------------------------------------- + ! ... check interval overlap + !--------------------------------------------------------------- + ! if( trg_x(1) < src_x(1) .or. trg_x(ntrg+1) > src_x(nsrc+1) ) then + ! write(iulog,*) 'rebin: target grid is outside source grid' + ! write(iulog,*) ' target grid from ',trg_x(1),' to ',trg_x(ntrg+1) + ! write(iulog,*) ' source grid from ',src_x(1),' to ',src_x(nsrc+1) + ! call endrun + ! end if + + do i = 1,ntrg + tl = trg_x(i) + if( tl < src_x(nsrc+1) ) then + do sil = 1,nsrc+1 + if( tl <= src_x(sil) ) then + exit + end if + end do + tu = trg_x(i+1) + do siu = 1,nsrc+1 + if( tu <= src_x(siu) ) then + exit + end if + end do + y = 0._r8 + sil = max( sil,2 ) + siu = min( siu,nsrc+1 ) + do si = sil,siu + si1 = si - 1 + sl = max( tl,src_x(si1) ) + su = min( tu,src_x(si) ) + y = y + (su - sl)*src(si1) + end do + trg(i) = y/(trg_x(i+1) - trg_x(i)) + else + trg(i) = 0._r8 + end if + end do + + end subroutine rebin + +end module mo_fstrat diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 new file mode 100644 index 0000000000..0b99fff1ad --- /dev/null +++ b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 @@ -0,0 +1,1176 @@ +module mo_gas_phase_chemdr + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod, only : pi => shr_const_pi + use constituents, only : pcnst + use cam_history, only : fieldname_len + use chem_mods, only : phtcnt, rxntot, gas_pcnst + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map, extcnt, num_rnts + use dust_model, only : dust_names, ndust => dust_nbin + use ppgrid, only : pcols, pver + use phys_control, only : phys_getopts + use carma_flags_mod, only : carma_hetchem_feedback + use chem_prod_loss_diags, only: chem_prod_loss_diags_init, chem_prod_loss_diags_out + + implicit none + save + + private + public :: gas_phase_chemdr, gas_phase_chemdr_inti + public :: map2chm + + integer :: map2chm(pcnst) = 0 ! index map to/from chemistry/constituents list + + integer :: synoz_ndx, so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, dst_ndx, cldice_ndx, snow_ndx + integer :: o3_ndx, o3s_ndx + integer :: het1_ndx + integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain + integer :: ndx_h2so4 +! +! CCMI +! + integer :: st80_25_ndx + integer :: st80_25_tau_ndx + integer :: aoa_nh_ndx + integer :: aoa_nh_ext_ndx + integer :: nh_5_ndx + integer :: nh_50_ndx + integer :: nh_50w_ndx + integer :: sad_pbf_ndx + integer :: cb1_ndx,cb2_ndx,oc1_ndx,oc2_ndx,dst1_ndx,dst2_ndx,sslt1_ndx,sslt2_ndx + integer :: soa_ndx,soai_ndx,soam_ndx,soat_ndx,soab_ndx,soax_ndx + + character(len=fieldname_len),dimension(rxt_tag_cnt) :: tag_names + character(len=fieldname_len),dimension(extcnt) :: extfrc_name + + logical :: pm25_srf_diag + logical :: pm25_srf_diag_soa + + logical :: convproc_do_aer + integer :: ele_temp_ndx, ion_temp_ndx + +contains + + subroutine gas_phase_chemdr_inti() + + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx + use cam_history, only : addfld,add_default,horiz_only + use mo_chm_diags, only : chm_diags_inti + use constituents, only : cnst_get_ind + use physics_buffer, only : pbuf_get_index + use rate_diags, only : rate_diags_init + use cam_abortutils, only : endrun + + implicit none + + character(len=3) :: string + integer :: n, m, err, ii + logical :: history_cesm_forcing + character(len=16) :: unitstr + !----------------------------------------------------------------------- + logical :: history_scwaccm_forcing + + call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) + + call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing ) + + ndx_h2so4 = get_spc_ndx('H2SO4') +! +! CCMI +! + st80_25_ndx = get_spc_ndx ('ST80_25') + st80_25_tau_ndx = get_rxt_ndx ('ST80_25_tau') + aoa_nh_ndx = get_spc_ndx ('AOA_NH') + aoa_nh_ext_ndx = get_extfrc_ndx('AOA_NH') + nh_5_ndx = get_spc_ndx('NH_5') + nh_50_ndx = get_spc_ndx('NH_50') + nh_50w_ndx = get_spc_ndx('NH_50W') +! + cb1_ndx = get_spc_ndx('CB1') + cb2_ndx = get_spc_ndx('CB2') + oc1_ndx = get_spc_ndx('OC1') + oc2_ndx = get_spc_ndx('OC2') + dst1_ndx = get_spc_ndx('DST01') + dst2_ndx = get_spc_ndx('DST02') + sslt1_ndx = get_spc_ndx('SSLT01') + sslt2_ndx = get_spc_ndx('SSLT02') + soa_ndx = get_spc_ndx('SOA') + soam_ndx = get_spc_ndx('SOAM') + soai_ndx = get_spc_ndx('SOAI') + soat_ndx = get_spc_ndx('SOAT') + soab_ndx = get_spc_ndx('SOAB') + soax_ndx = get_spc_ndx('SOAX') + + pm25_srf_diag = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & + .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & + .and. soa_ndx>0 + + pm25_srf_diag_soa = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & + .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & + .and. soam_ndx>0 .and. soai_ndx>0 .and. soat_ndx>0 .and. soab_ndx>0 .and. soax_ndx>0 + + if ( pm25_srf_diag .or. pm25_srf_diag_soa) then + call addfld('PM25_SRF',horiz_only,'I','kg/kg','bottom layer PM2.5 mixing ratio' ) + endif + call addfld('U_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) + call addfld('V_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) + call addfld('Q_SRF',horiz_only,'I','kg/kg','bottom layer specific humidity' ) +! + het1_ndx= get_rxt_ndx('het1') + o3_ndx = get_spc_ndx('O3') + o3s_ndx = get_spc_ndx('O3S') + o_ndx = get_spc_ndx('O') + o2_ndx = get_spc_ndx('O2') + so4_ndx = get_spc_ndx('SO4') + h2o_ndx = get_spc_ndx('H2O') + hno3_ndx = get_spc_ndx('HNO3') + hcl_ndx = get_spc_ndx('HCL') + dst_ndx = get_spc_ndx( dust_names(1) ) + synoz_ndx = get_extfrc_ndx( 'SYNOZ' ) + call cnst_get_ind( 'CLDICE', cldice_ndx ) + call cnst_get_ind( 'SNOWQM', snow_ndx, abort=.false. ) + + + do m = 1,extcnt + WRITE(UNIT=string, FMT='(I2.2)') m + extfrc_name(m) = 'extfrc_'// trim(string) + call addfld( extfrc_name(m), (/ 'lev' /), 'I', ' ', 'ext frcing' ) + end do + + do n = 1,rxt_tag_cnt + tag_names(n) = trim(rxt_tag_lst(n)) + if (n<=phtcnt) then + call addfld( tag_names(n), (/ 'lev' /), 'I', '/s', 'photolysis rate constant' ) + else + ii = n-phtcnt + select case(num_rnts(ii)) + case(1) + unitstr='/s' + case(2) + unitstr='cm3/molecules/s' + case(3) + unitstr='cm6/molecules2/s' + case default + call endrun('gas_phase_chemdr_inti: invalid value in num_rnts used to set units in reaction rate constant') + end select + call addfld( tag_names(n), (/ 'lev' /), 'I', unitstr, 'reaction rate constant' ) + endif + if (history_scwaccm_forcing) then + select case (trim(tag_names(n))) + case ('jh2o_a', 'jh2o_b', 'jh2o_c' ) + call add_default( tag_names(n), 1, ' ') + end select + endif + enddo + + call addfld( 'DTCBS', horiz_only, 'I', ' ','photolysis diagnostic black carbon OD' ) + call addfld( 'DTOCS', horiz_only, 'I', ' ','photolysis diagnostic organic carbon OD' ) + call addfld( 'DTSO4', horiz_only, 'I', ' ','photolysis diagnostic SO4 OD' ) + call addfld( 'DTSOA', horiz_only, 'I', ' ','photolysis diagnostic SOA OD' ) + call addfld( 'DTANT', horiz_only, 'I', ' ','photolysis diagnostic NH4SO4 OD' ) + call addfld( 'DTSAL', horiz_only, 'I', ' ','photolysis diagnostic salt OD' ) + call addfld( 'DTDUST', horiz_only, 'I', ' ','photolysis diagnostic dust OD' ) + call addfld( 'DTTOTAL', horiz_only, 'I', ' ','photolysis diagnostic total aerosol OD' ) + call addfld( 'FRACDAY', horiz_only, 'I', ' ','photolysis diagnostic fraction of day' ) + + call addfld( 'QDSAD', (/ 'lev' /), 'I', '/s', 'water vapor sad delta' ) + call addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'stratospheric aerosol SAD' ) + call addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'chemical sulfate aerosol SAD' ) + call addfld( 'SAD_SAGE', (/ 'lev' /), 'I', 'cm2/cm3', 'SAGE sulfate aerosol SAD' ) + call addfld( 'SAD_LNAT', (/ 'lev' /), 'I', 'cm2/cm3', 'large-mode NAT aerosol SAD' ) + call addfld( 'SAD_ICE', (/ 'lev' /), 'I', 'cm2/cm3', 'water-ice aerosol SAD' ) + call addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'chemical sad sulfate' ) + call addfld( 'RAD_LNAT', (/ 'lev' /), 'I', 'cm', 'large nat radius' ) + call addfld( 'RAD_ICE', (/ 'lev' /), 'I', 'cm', 'sad ice' ) + call addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'tropospheric aerosol SAD' ) + call addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'aerosol surface area density' ) + if (history_cesm_forcing) then + call add_default ('SAD_AERO',8,' ') + endif + call addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'aerosol effective radius' ) + call addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'mol/mol', 'tropospheric aerosol SAD' ) + call addfld( 'QDSETT', (/ 'lev' /), 'I', '/s', 'water vapor settling delta' ) + call addfld( 'QDCHEM', (/ 'lev' /), 'I', '/s', 'water vapor chemistry delta') + call addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total HNO3' ) + call addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' ) + call addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' ) + call addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hno3' ) + call addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase h2o' ) + call addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total hcl' ) + call addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hcl' ) + call addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HCL' ) + + if (het1_ndx>0) then + call addfld( 'het1_total', (/ 'lev' /), 'I', '/s', 'total N2O5 + H2O het rate constant' ) + endif + call addfld( 'SZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) + + call chm_diags_inti() + call rate_diags_init() + +!----------------------------------------------------------------------- +! get pbuf indicies +!----------------------------------------------------------------------- + ndx_cldfr = pbuf_get_index('CLD') + ndx_cmfdqr = pbuf_get_index('RPRDTOT') + ndx_nevapr = pbuf_get_index('NEVAPR') + ndx_prain = pbuf_get_index('PRAIN') + ndx_cldtop = pbuf_get_index('CLDTOP') + + sad_pbf_ndx= pbuf_get_index('VOLC_SAD',errcode=err) ! prescribed strat aerosols (volcanic) + if (.not.sad_pbf_ndx>0) sad_pbf_ndx = pbuf_get_index('SADSULF',errcode=err) ! CARMA's version of strat aerosols + + ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index + ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index + + ! diagnostics for stratospheric heterogeneous reactions + call addfld( 'GAMMA_HET1', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'GAMMA_HET2', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'GAMMA_HET3', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'GAMMA_HET4', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'GAMMA_HET5', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'GAMMA_HET6', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + call addfld( 'WTPER', (/ 'lev' /), 'I', '%', 'H2SO4 Weight Percent' ) + + call chem_prod_loss_diags_init + + end subroutine gas_phase_chemdr_inti + + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & + phis, zm, zi, calday, & + tfld, pmid, pdel, pint, & + cldw, troplev, troplevchem, & + ncldwtr, ufld, vfld, & + delt, ps, xactive_prates, & + fsds, ts, asdir, ocnfrac, icefrac, & + precc, precl, snowhland, ghg_chem, latmapback, & + drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, qtend, pbuf) + + !----------------------------------------------------------------------- + ! ... Chem_solver advances the volumetric mixing ratio + ! forward one time step via a combination of explicit, + ! ebi, hov, fully implicit, and/or rodas algorithms. + !----------------------------------------------------------------------- + + use chem_mods, only : nabscol, nfs, indexm, clscnt4 + use physconst, only : rga + use mo_photo, only : set_ub_col, setcol, table_photo, xactive_photo + use mo_exp_sol, only : exp_sol + use mo_imp_sol, only : imp_sol + use mo_setrxt, only : setrxt + use mo_adjrxt, only : adjrxt + use mo_phtadj, only : phtadj + use llnl_O1D_to_2OH_adj,only : O1D_to_2OH_adj + use mo_usrrxt, only : usrrxt + use mo_setinv, only : setinv + use mo_negtrc, only : negtrc + use mo_sulf, only : sulf_interp + use mo_setext, only : setext + use fire_emissions, only : fire_emissions_vrt + use mo_sethet, only : sethet + use mo_drydep, only : drydep, set_soilw + use seq_drydep_mod, only : DD_XLND, DD_XATM, DD_TABL, drydep_method + use mo_fstrat, only : set_fstrat_vals, set_fstrat_h2o + use noy_ubc, only : noy_ubc_set + use mo_flbc, only : flbc_set + use phys_grid, only : get_rlat_all_p, get_rlon_all_p, get_lat_all_p, get_lon_all_p + use mo_mean_mass, only : set_mean_mass + use cam_history, only : outfld + use wv_saturation, only : qsat + use constituents, only : cnst_mw + use mo_drydep, only : has_drydep + use time_manager, only : get_ref_date + use mo_ghg_chem, only : ghg_chem_set_rates, ghg_chem_set_flbc + use mo_sad, only : sad_strat_calc + use charge_neutrality, only : charge_balance + use mo_strato_rates, only : ratecon_sfstrat + use mo_aero_settling, only : strat_aer_settling + use shr_orb_mod, only : shr_orb_decl + use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr + use mo_strato_rates, only : has_strato_chem + use short_lived_species,only: set_short_lived_species,get_short_lived_species + use mo_chm_diags, only : chm_diags, het_diags + use perf_mod, only : t_startf, t_stopf + use gas_wetdep_opts, only : gas_wetdep_method + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use infnan, only : nan, assignment(=) + use rate_diags, only : rate_diags_calc + use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri + use orbit, only : zenith +! +! LINOZ +! + use lin_strat_chem, only : do_lin_strat_chem, lin_strat_chem_solve + use linoz_data, only : has_linoz_data +! +! for aqueous chemistry and aerosol growth +! + use aero_model, only : aero_model_gasaerexch + + use aero_model, only : aero_model_strat_surfarea + use time_manager, only : is_first_step + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: imozart ! gas phase start index in q + real(r8), intent(in) :: delt ! timestep (s) + real(r8), intent(in) :: calday ! day of year + real(r8), intent(in) :: ps(pcols) ! surface pressure + real(r8), intent(in) :: phis(pcols) ! surface geopotential + real(r8),target,intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: ufld(pcols,pver) ! zonal velocity (m/s) + real(r8), intent(in) :: vfld(pcols,pver) ! meridional velocity (m/s) + real(r8), intent(in) :: cldw(pcols,pver) ! cloud water (kg/kg) + real(r8), intent(in) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg) + real(r8), intent(in) :: zm(pcols,pver) ! midpoint geopotential height above the surface (m) + real(r8), intent(in) :: zi(pcols,pver+1) ! interface geopotential height above the surface (m) + real(r8), intent(in) :: pint(pcols,pver+1) ! interface pressures (Pa) + real(r8), intent(in) :: q(pcols,pver,pcnst) ! species concentrations (kg/kg) + real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire emssions surface flux (kg/m^2/s) + real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vertical distribution of fire emssions (m) + logical, intent(in) :: xactive_prates + real(r8), intent(in) :: fsds(pcols) ! longwave down at sfc + real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction + real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction + real(r8), intent(in) :: asdir(pcols) ! albedo: shortwave, direct + real(r8), intent(in) :: ts(pcols) ! sfc temp (merged w/ocean if coupled) + real(r8), intent(in) :: precc(pcols) ! + real(r8), intent(in) :: precl(pcols) ! + real(r8), intent(in) :: snowhland(pcols) ! + logical, intent(in) :: ghg_chem + integer, intent(in) :: latmapback(pcols) + integer, intent(in) :: troplev(pcols) ! trop/strat separation vertical index + integer, intent(in) :: troplevchem(pcols) ! trop/strat chemistry separation vertical index + real(r8), intent(inout) :: qtend(pcols,pver,pcnst) ! species tendencies (kg/kg/s) + real(r8), intent(inout) :: cflx(pcols,pcnst) ! constituent surface flux (kg/m^2/s) + real(r8), intent(out) :: drydepflx(pcols,pcnst) ! dry deposition flux (kg/m^2/s) + real(r8), intent(in) :: wetdepflx(pcols,pcnst) ! wet deposition flux (kg/m^2/s) + real(r8), intent(out) :: nhx_nitrogen_flx(pcols) + real(r8), intent(out) :: noy_nitrogen_flx(pcols) + + type(physics_buffer_desc), pointer :: pbuf(:) + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + real(r8), parameter :: m2km = 1.e-3_r8 + real(r8), parameter :: Pa2mb = 1.e-2_r8 + + real(r8), pointer :: prain(:,:) + real(r8), pointer :: nevapr(:,:) + real(r8), pointer :: cmfdqr(:,:) + real(r8), pointer :: cldfr(:,:) + real(r8), pointer :: cldtop(:) + + integer :: i, k, m, n + integer :: tim_ndx + real(r8) :: delt_inverse + real(r8) :: esfact + integer :: latndx(pcols) ! chunk lat indicies + integer :: lonndx(pcols) ! chunk lon indicies + real(r8) :: invariants(ncol,pver,nfs) + real(r8) :: col_dens(ncol,pver,max(1,nabscol)) ! column densities (molecules/cm^2) + real(r8) :: col_delta(ncol,0:pver,max(1,nabscol)) ! layer column densities (molecules/cm^2) + real(r8) :: extfrc(ncol,pver,max(1,extcnt)) + real(r8) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) + real(r8) :: reaction_rates(ncol,pver,max(1,rxntot)) ! reaction rates + real(r8) :: depvel(ncol,gas_pcnst) ! dry deposition velocity (cm/s) + real(r8) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! washout rate (1/s) + real(r8), dimension(ncol,pver) :: & + h2ovmr, & ! water vapor volume mixing ratio + mbar, & ! mean wet atmospheric mass ( amu ) + zmid, & ! midpoint geopotential in km + zmidr, & ! midpoint geopotential in km realitive to surf + sulfate, & ! trop sulfate aerosols + pmb ! pressure at midpoints ( hPa ) + real(r8), dimension(ncol,pver) :: & + cwat, & ! cloud water mass mixing ratio (kg/kg) + wrk + real(r8), dimension(ncol,pver+1) :: & + zintr ! interface geopotential in km realitive to surf + real(r8), dimension(ncol,pver+1) :: & + zint ! interface geopotential in km + real(r8), dimension(ncol) :: & + zen_angle, & ! solar zenith angles + zsurf, & ! surface height (m) + rlats, rlons ! chunk latitudes and longitudes (radians) + real(r8) :: sza(ncol) ! solar zenith angles (degrees) + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: relhum(ncol,pver) ! relative humidity + real(r8) :: satv(ncol,pver) ! wrk array for relative humidity + real(r8) :: satq(ncol,pver) ! wrk array for relative humidity + + integer :: j + integer :: ltrop_sol(pcols) ! tropopause vertical index used in chem solvers + real(r8), pointer :: strato_sad(:,:) ! stratospheric sad (1/cm) + + real(r8) :: sad_trop(pcols,pver) ! total tropospheric sad (cm^2/cm^3) + real(r8) :: reff(pcols,pver) ! aerosol effective radius (cm) + real(r8) :: reff_strat(pcols,pver) ! stratospheric aerosol effective radius (cm) + + real(r8) :: tvs(pcols) + integer :: ncdate,yr,mon,day,sec + real(r8) :: wind_speed(pcols) ! surface wind speed (m/s) + logical, parameter :: dyn_soilw = .false. + logical :: table_soilw + real(r8) :: soilw(pcols) + real(r8) :: prect(pcols) + real(r8) :: sflx(pcols,gas_pcnst) + real(r8) :: wetdepflx_diag(pcols,gas_pcnst) + real(r8) :: dust_vmr(ncol,pver,ndust) + real(r8) :: dt_diag(pcols,8) ! od diagnostics + real(r8) :: fracday(pcols) ! fraction of day + real(r8) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg) + real(r8) :: ommr(ncol,pver) ! o concentration (kg/kg) + real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) + real(r8) :: mmr_new(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) + real(r8) :: hno3_gas(ncol,pver) ! hno3 gas phase concentration (mol/mol) + real(r8) :: hno3_cond(ncol,pver,2) ! hno3 condensed phase concentration (mol/mol) + real(r8) :: hcl_gas(ncol,pver) ! hcl gas phase concentration (mol/mol) + real(r8) :: hcl_cond(ncol,pver) ! hcl condensed phase concentration (mol/mol) + real(r8) :: h2o_gas(ncol,pver) ! h2o gas phase concentration (mol/mol) + real(r8) :: h2o_cond(ncol,pver) ! h2o condensed phase concentration (mol/mol) + real(r8) :: cldice(pcols,pver) ! cloud water "ice" (kg/kg) + real(r8) :: radius_strat(ncol,pver,3) ! radius of sulfate, nat, & ice ( cm ) + real(r8) :: sad_strat(ncol,pver,3) ! surf area density of sulfate, nat, & ice ( cm^2/cm^3 ) + real(r8) :: mmr_tend(pcols,pver,gas_pcnst) ! chemistry species tendencies (kg/kg/s) + real(r8) :: qh2o(pcols,pver) ! specific humidity (kg/kg) + real(r8) :: delta + + ! for aerosol formation.... + real(r8) :: del_h2so4_gasprod(ncol,pver) + real(r8) :: vmr0(ncol,pver,gas_pcnst) + +! +! CCMI +! + real(r8) :: xlat + real(r8) :: pm25(ncol) + + real(r8) :: dlats(ncol) + + real(r8), dimension(ncol,pver) :: & ! aerosol reaction diagnostics + gprob_n2o5, & + gprob_cnt_hcl, & + gprob_cnt_h2o, & + gprob_bnt_h2o, & + gprob_hocl_hcl, & + gprob_hobr_hcl, & + wtper + + real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer + real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer + real(r8) :: prod_out(ncol,pver,max(1,clscnt4)) + real(r8) :: loss_out(ncol,pver,max(1,clscnt4)) + + if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 .and. .not.is_first_step()) then + call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) + call pbuf_get_field(pbuf, ion_temp_ndx, ion_temp_fld) + else + ele_temp_fld => tfld + ion_temp_fld => tfld + endif + + ! initialize to NaN to hopefully catch user defined rxts that go unset + reaction_rates(:,:,:) = nan + + delt_inverse = 1._r8 / delt + !----------------------------------------------------------------------- + ! ... Get chunck latitudes and longitudes + !----------------------------------------------------------------------- + call get_lat_all_p( lchnk, ncol, latndx ) + call get_lon_all_p( lchnk, ncol, lonndx ) + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + tim_ndx = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_cldfr, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) ) + call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_get_field(pbuf, ndx_cldtop, cldtop ) + + reff_strat(:,:) = 0._r8 + + dlats(:) = rlats(:)*rad2deg ! convert to degrees + + !----------------------------------------------------------------------- + ! ... Calculate cosine of zenith angle + ! then cast back to angle (radians) + !----------------------------------------------------------------------- + call zenith( calday, rlats, rlons, zen_angle, ncol ) + zen_angle(:) = acos( zen_angle(:) ) + + sza(:) = zen_angle(:) * rad2deg + call outfld( 'SZA', sza, ncol, lchnk ) + + !----------------------------------------------------------------------- + ! ... Xform geopotential height from m to km + ! and pressure from Pa to mb + !----------------------------------------------------------------------- + zsurf(:ncol) = rga * phis(:ncol) + do k = 1,pver + zintr(:ncol,k) = m2km * zi(:ncol,k) + zmidr(:ncol,k) = m2km * zm(:ncol,k) + zmid(:ncol,k) = m2km * (zm(:ncol,k) + zsurf(:ncol)) + zint(:ncol,k) = m2km * (zi(:ncol,k) + zsurf(:ncol)) + pmb(:ncol,k) = Pa2mb * pmid(:ncol,k) + end do + zint(:ncol,pver+1) = m2km * (zi(:ncol,pver+1) + zsurf(:ncol)) + zintr(:ncol,pver+1)= m2km * zi(:ncol,pver+1) + + !----------------------------------------------------------------------- + ! ... map incoming concentrations to working array + !----------------------------------------------------------------------- + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + mmr(:ncol,:,n) = q(:ncol,:,m) + end if + end do + + call get_short_lived_species( mmr, lchnk, ncol, pbuf ) + + !----------------------------------------------------------------------- + ! ... Set atmosphere mean mass + !----------------------------------------------------------------------- + call set_mean_mass( ncol, mmr, mbar ) + + !----------------------------------------------------------------------- + ! ... Xform from mmr to vmr + !----------------------------------------------------------------------- + call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) + +! +! CCMI +! +! reset STE tracer to specific vmr of 200 ppbv +! + if ( st80_25_ndx > 0 ) then + where ( pmid(:ncol,:) < 80.e+2_r8 ) + vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8 + end where + end if +! +! reset AOA_NH, NH_5, NH_50, NH_50W surface mixing ratios between 30N and 50N +! + if ( aoa_nh_ndx>0 ) then + do j=1,ncol + xlat = dlats(j) + if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + vmr(j,pver,aoa_nh_ndx) = 0._r8 + end if + end do + end if + if ( nh_5_ndx>0 ) then + do j=1,ncol + xlat = dlats(j) + if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + vmr(j,pver,nh_5_ndx) = 100.e-9_r8 + end if + end do + end if + if ( nh_50_ndx>0 ) then + do j=1,ncol + xlat = dlats(j) + if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + vmr(j,pver,nh_50_ndx) = 100.e-9_r8 + end if + end do + end if + if ( nh_50w_ndx>0 ) then + do j=1,ncol + xlat = dlats(j) + if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + vmr(j,pver,nh_50w_ndx) = 100.e-9_r8 + end if + end do + end if + + if (h2o_ndx>0) then + !----------------------------------------------------------------------- + ! ... store water vapor in wrk variable + !----------------------------------------------------------------------- + qh2o(:ncol,:) = mmr(:ncol,:,h2o_ndx) + h2ovmr(:ncol,:) = vmr(:ncol,:,h2o_ndx) + else + qh2o(:ncol,:) = q(:ncol,:,1) + !----------------------------------------------------------------------- + ! ... Xform water vapor from mmr to vmr and set upper bndy values + !----------------------------------------------------------------------- + call h2o_to_vmr( q(:ncol,:,1), h2ovmr(:ncol,:), mbar(:ncol,:), ncol ) + + call set_fstrat_h2o( h2ovmr, pmid, troplev, calday, ncol, lchnk ) + + endif + + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + call charge_balance( ncol, vmr ) + + !----------------------------------------------------------------------- + ! ... Set the "invariants" + !----------------------------------------------------------------------- + call setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf ) + + !----------------------------------------------------------------------- + ! ... stratosphere aerosol surface area + !----------------------------------------------------------------------- + if (sad_pbf_ndx>0) then + call pbuf_get_field(pbuf, sad_pbf_ndx, strato_sad) + else + allocate(strato_sad(pcols,pver)) + strato_sad(:,:) = 0._r8 + + ! Prognostic modal stratospheric sulfate: compute dry strato_sad + call aero_model_strat_surfarea( ncol, mmr, pmid, tfld, troplevchem, pbuf, strato_sad, reff_strat ) + + endif + + stratochem: if ( has_strato_chem ) then + !----------------------------------------------------------------------- + ! ... initialize condensed and gas phases; all hno3 to gas + !----------------------------------------------------------------------- + hcl_cond(:,:) = 0.0_r8 + hcl_gas (:,:) = 0.0_r8 + do k = 1,pver + hno3_gas(:,k) = vmr(:,k,hno3_ndx) + h2o_gas(:,k) = h2ovmr(:,k) + hcl_gas(:,k) = vmr(:,k,hcl_ndx) + wrk(:,k) = h2ovmr(:,k) + if (snow_ndx>0) then + cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + q(:ncol,k,snow_ndx) + else + cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + endif + end do + do m = 1,2 + do k = 1,pver + hno3_cond(:,k,m) = 0._r8 + end do + end do + + call mmr2vmri( cldice(:ncol,:), h2o_cond(:ncol,:), mbar(:ncol,:), cnst_mw(cldice_ndx), ncol ) + + !----------------------------------------------------------------------- + ! ... call SAD routine + !----------------------------------------------------------------------- + call sad_strat_calc( lchnk, invariants(:ncol,:,indexm), pmb, tfld, hno3_gas, & + hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, strato_sad(:ncol,:), radius_strat, & + sad_strat, ncol, pbuf ) + +! NOTE: output of total HNO3 is before vmr is set to gas-phase. + call outfld( 'HNO3_TOTAL', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) + + + do k = 1,pver + vmr(:,k,hno3_ndx) = hno3_gas(:,k) + h2ovmr(:,k) = h2o_gas(:,k) + vmr(:,k,h2o_ndx) = h2o_gas(:,k) + wrk(:,k) = (h2ovmr(:,k) - wrk(:,k))*delt_inverse + end do + + call outfld( 'QDSAD', wrk(:,:), ncol, lchnk ) +! + call outfld( 'SAD_STRAT', strato_sad(:ncol,:), ncol, lchnk ) + call outfld( 'SAD_SULFC', sad_strat(:,:,1), ncol, lchnk ) + call outfld( 'SAD_LNAT', sad_strat(:,:,2), ncol, lchnk ) + call outfld( 'SAD_ICE', sad_strat(:,:,3), ncol, lchnk ) +! + call outfld( 'RAD_SULFC', radius_strat(:,:,1), ncol, lchnk ) + call outfld( 'RAD_LNAT', radius_strat(:,:,2), ncol, lchnk ) + call outfld( 'RAD_ICE', radius_strat(:,:,3), ncol, lchnk ) +! + call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol, lchnk ) + call outfld( 'HNO3_STS', hno3_cond(:,:,1), ncol, lchnk ) + call outfld( 'HNO3_NAT', hno3_cond(:,:,2), ncol, lchnk ) +! + call outfld( 'HCL_TOTAL', vmr(:ncol,:,hcl_ndx), ncol, lchnk ) + call outfld( 'HCL_GAS', hcl_gas (:,:), ncol ,lchnk ) + call outfld( 'HCL_STS', hcl_cond(:,:), ncol ,lchnk ) + + !----------------------------------------------------------------------- + ! ... call aerosol reaction rates + !----------------------------------------------------------------------- + call ratecon_sfstrat( ncol, invariants(:,:,indexm), pmid, tfld, & + radius_strat(:,:,1), sad_strat(:,:,1), sad_strat(:,:,2), & + sad_strat(:,:,3), h2ovmr, vmr, reaction_rates, & + gprob_n2o5, gprob_cnt_hcl, gprob_cnt_h2o, gprob_bnt_h2o, & + gprob_hocl_hcl, gprob_hobr_hcl, wtper ) + + call outfld( 'GAMMA_HET1', gprob_n2o5 (:ncol,:), ncol, lchnk ) + call outfld( 'GAMMA_HET2', gprob_cnt_h2o (:ncol,:), ncol, lchnk ) + call outfld( 'GAMMA_HET3', gprob_bnt_h2o (:ncol,:), ncol, lchnk ) + call outfld( 'GAMMA_HET4', gprob_cnt_hcl (:ncol,:), ncol, lchnk ) + call outfld( 'GAMMA_HET5', gprob_hocl_hcl(:ncol,:), ncol, lchnk ) + call outfld( 'GAMMA_HET6', gprob_hobr_hcl(:ncol,:), ncol, lchnk ) + call outfld( 'WTPER', wtper (:ncol,:), ncol, lchnk ) + + endif stratochem + +! NOTE: For gas-phase solver only. +! ratecon_sfstrat needs total hcl. + if (hcl_ndx>0) then + vmr(:,:,hcl_ndx) = hcl_gas(:,:) + endif + + !----------------------------------------------------------------------- + ! ... Set the column densities at the upper boundary + !----------------------------------------------------------------------- + call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk) + + !----------------------------------------------------------------------- + ! ... Set rates for "tabular" and user specified reactions + !----------------------------------------------------------------------- + call setrxt( reaction_rates, tfld, invariants(1,1,indexm), ncol ) + + sulfate(:,:) = 0._r8 + if ( .not. carma_hetchem_feedback ) then + if( so4_ndx < 1 ) then ! get offline so4 field if not prognostic + call sulf_interp( ncol, lchnk, sulfate ) + else + sulfate(:,:) = vmr(:,:,so4_ndx) + endif + endif + + !----------------------------------------------------------------- + ! ... zero out sulfate above tropopause + !----------------------------------------------------------------- + do k = 1, pver + do i = 1, ncol + if (k < troplevchem(i)) then + sulfate(i,k) = 0.0_r8 + end if + end do + end do + + call outfld( 'SULF_TROP', sulfate(:ncol,:), ncol, lchnk ) + + !----------------------------------------------------------------- + ! ... compute the relative humidity + !----------------------------------------------------------------- + call qsat(tfld(:ncol,:), pmid(:ncol,:), satv, satq) + + do k = 1,pver + relhum(:,k) = .622_r8 * h2ovmr(:,k) / satq(:,k) + relhum(:,k) = max( 0._r8,min( 1._r8,relhum(:,k) ) ) + end do + + cwat(:ncol,:pver) = cldw(:ncol,:pver) + + call usrrxt( reaction_rates, tfld, ion_temp_fld, ele_temp_fld, invariants, h2ovmr, & + pmid, invariants(:,:,indexm), sulfate, mmr, relhum, strato_sad, & + troplevchem, dlats, ncol, sad_trop, reff, cwat, mbar, pbuf ) + + call outfld( 'SAD_TROP', sad_trop(:ncol,:), ncol, lchnk ) + + ! Add trop/strat components of SAD for output + sad_trop(:ncol,:)=sad_trop(:ncol,:)+strato_sad(:ncol,:) + call outfld( 'SAD_AERO', sad_trop(:ncol,:), ncol, lchnk ) + + ! Add trop/strat components of effective radius for output + reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:) + call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk ) + + if (het1_ndx>0) then + call outfld( 'het1_total', reaction_rates(:,:,het1_ndx), ncol, lchnk ) + endif + + if (ghg_chem) then + call ghg_chem_set_rates( reaction_rates, latmapback, zen_angle, ncol, lchnk ) + endif + + do i = phtcnt+1,rxt_tag_cnt + call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + enddo + + call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver ) + + !----------------------------------------------------------------------- + ! ... Compute the photolysis rates at time = t(n+1) + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! ... Set the column densities + !----------------------------------------------------------------------- + call setcol( col_delta, col_dens, vmr, pdel, ncol ) + + !----------------------------------------------------------------------- + ! ... Calculate the photodissociation rates + !----------------------------------------------------------------------- + + esfact = 1._r8 + call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & + delta, esfact ) + + + if ( xactive_prates ) then + if ( dst_ndx > 0 ) then + dust_vmr(:ncol,:,1:ndust) = vmr(:ncol,:,dst_ndx:dst_ndx+ndust-1) + else + dust_vmr(:ncol,:,:) = 0._r8 + endif + + !----------------------------------------------------------------- + ! ... compute the photolysis rates + !----------------------------------------------------------------- + call xactive_photo( reaction_rates, vmr, tfld, cwat, cldfr, & + pmid, zmidr, col_dens, zen_angle, asdir, & + invariants(1,1,indexm), ps, ts, & + esfact, relhum, dust_vmr, dt_diag, fracday, ncol, lchnk ) + + call outfld('DTCBS', dt_diag(:ncol,1), ncol, lchnk ) + call outfld('DTOCS', dt_diag(:ncol,2), ncol, lchnk ) + call outfld('DTSO4', dt_diag(:ncol,3), ncol, lchnk ) + call outfld('DTANT', dt_diag(:ncol,4), ncol, lchnk ) + call outfld('DTSAL', dt_diag(:ncol,5), ncol, lchnk ) + call outfld('DTDUST', dt_diag(:ncol,6), ncol, lchnk ) + call outfld('DTSOA', dt_diag(:ncol,7), ncol, lchnk ) + call outfld('DTTOTAL', dt_diag(:ncol,8), ncol, lchnk ) + call outfld('FRACDAY', fracday(:ncol), ncol, lchnk ) + + else + !----------------------------------------------------------------- + ! ... lookup the photolysis rates from table + !----------------------------------------------------------------- + call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, & + col_dens, zen_angle, asdir, cwat, cldfr, & + esfact, vmr, invariants, ncol, lchnk, pbuf ) + endif + + do i = 1,phtcnt + call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + enddo + + !----------------------------------------------------------------------- + ! ... Adjust the photodissociation rates + !----------------------------------------------------------------------- + call O1D_to_2OH_adj( reaction_rates, invariants, invariants(:,:,indexm), ncol, tfld ) + call phtadj( reaction_rates, invariants, invariants(:,:,indexm), ncol,pver ) + + !----------------------------------------------------------------------- + ! ... Compute the extraneous frcing at time = t(n+1) + !----------------------------------------------------------------------- + if ( o2_ndx > 0 .and. o_ndx > 0 ) then + do k = 1,pver + o2mmr(:ncol,k) = mmr(:ncol,k,o2_ndx) + ommr(:ncol,k) = mmr(:ncol,k,o_ndx) + end do + endif + call setext( extfrc, zint, zintr, cldtop, & + zmid, lchnk, tfld, o2mmr, ommr, & + pmid, mbar, rlats, calday, ncol, rlons, pbuf ) + ! include forcings from fire emissions ... + call fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, extfrc ) + + do m = 1,extcnt + if( m /= synoz_ndx .and. m /= aoa_nh_ext_ndx ) then + do k = 1,pver + extfrc(:ncol,k,m) = extfrc(:ncol,k,m) / invariants(:ncol,k,indexm) + end do + endif + call outfld( extfrc_name(m), extfrc(:ncol,:,m), ncol, lchnk ) + end do + + !----------------------------------------------------------------------- + ! ... Form the washout rates + !----------------------------------------------------------------------- + if ( gas_wetdep_method=='MOZ' ) then + call sethet( het_rates, pmid, zmid, phis, tfld, & + cmfdqr, prain, nevapr, delt, invariants(:,:,indexm), & + vmr, ncol, lchnk ) + if (.not. convproc_do_aer) then + call het_diags( het_rates(:ncol,:,:), mmr(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) + endif + else + het_rates = 0._r8 + end if +! +! CCMI +! +! set loss to below the tropopause only +! + if ( st80_25_tau_ndx > 0 ) then + do i = 1,ncol + reaction_rates(i,1:troplev(i),st80_25_tau_ndx) = 0._r8 + enddo + end if + + if ( has_linoz_data ) then + ltrop_sol(:ncol) = troplev(:ncol) + else + ltrop_sol(:ncol) = 0 ! apply solver to all levels + endif + + ! save h2so4 before gas phase chem (for later new particle nucleation) + if (ndx_h2so4 > 0) then + del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) + else + del_h2so4_gasprod(:,:) = 0.0_r8 + endif + + vmr0(:ncol,:,:) = vmr(:ncol,:,:) ! mixing ratios before chemistry changes + + !======================================================================= + ! ... Call the class solution algorithms + !======================================================================= + !----------------------------------------------------------------------- + ! ... Solve for "Explicit" species + !----------------------------------------------------------------------- + call exp_sol( vmr, reaction_rates, het_rates, extfrc, delt, invariants(1,1,indexm), ncol, lchnk, ltrop_sol ) + + !----------------------------------------------------------------------- + ! ... Solve for "Implicit" species + !----------------------------------------------------------------------- + if ( has_strato_chem ) wrk(:,:) = vmr(:,:,h2o_ndx) + call t_startf('imp_sol') + ! + call imp_sol( vmr, reaction_rates, het_rates, extfrc, delt, & + ncol,pver, lchnk, prod_out, loss_out ) + + call t_stopf('imp_sol') + + call chem_prod_loss_diags_out( ncol, lchnk, vmr, reaction_rates, prod_out, loss_out, invariants(:ncol,:,indexm) ) + if( h2o_ndx>0) call outfld( 'H2O_GAS', vmr(1,1,h2o_ndx), ncol ,lchnk ) + + ! reset O3S to O3 in the stratosphere ... + if ( o3_ndx > 0 .and. o3s_ndx > 0 ) then + do i = 1,ncol + vmr(i,1:troplev(i),o3s_ndx) = vmr(i,1:troplev(i),o3_ndx) + end do + end if + + if (convproc_do_aer) then + call vmr2mmr( vmr(:ncol,:,:), mmr_new(:ncol,:,:), mbar(:ncol,:), ncol ) + ! mmr_new = average of mmr values before and after imp_sol + mmr_new(:ncol,:,:) = 0.5_r8*( mmr(:ncol,:,:) + mmr_new(:ncol,:,:) ) + call het_diags( het_rates(:ncol,:,:), mmr_new(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) + endif + + ! save h2so4 change by gas phase chem (for later new particle nucleation) + if (ndx_h2so4 > 0) then + del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_gasprod(1:ncol,:) + endif + +! +! Aerosol processes ... +! + + call aero_model_gasaerexch( imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, & + tfld, pmid, pdel, mbar, relhum, & + zm, qh2o, cwat, cldfr, ncldwtr, & + invariants(:,:,indexm), invariants, del_h2so4_gasprod, & + vmr0, vmr, pbuf ) + + if ( has_strato_chem ) then + + wrk(:ncol,:) = (vmr(:ncol,:,h2o_ndx) - wrk(:ncol,:))*delt_inverse + call outfld( 'QDCHEM', wrk(:ncol,:), ncol, lchnk ) + call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) + + !----------------------------------------------------------------------- + ! ... aerosol settling + ! first settle hno3(2) using radius ice + ! secnd settle hno3(3) using radius large nat + !----------------------------------------------------------------------- + wrk(:,:) = vmr(:,:,h2o_ndx) +#ifdef ALT_SETTL + where( h2o_cond(:,:) > 0._r8 ) + settl_rad(:,:) = radius_strat(:,:,3) + elsewhere + settl_rad(:,:) = 0._r8 + endwhere + call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + hno3_cond(1,1,2), settl_rad, ncol, lchnk, 1 ) + + where( h2o_cond(:,:) == 0._r8 ) + settl_rad(:,:) = radius_strat(:,:,2) + elsewhere + settl_rad(:,:) = 0._r8 + endwhere + call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + hno3_cond(1,1,2), settl_rad, ncol, lchnk, 2 ) +#else + call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + hno3_cond(1,1,2), radius_strat(1,1,2), ncol, lchnk, 2 ) +#endif + + !----------------------------------------------------------------------- + ! ... reform total hno3 and hcl = gas + all condensed + !----------------------------------------------------------------------- +! NOTE: vmr for hcl and hno3 is gas-phase at this point. +! hno3_cond(:,k,1) = STS; hno3_cond(:,k,2) = NAT + + do k = 1,pver + vmr(:,k,hno3_ndx) = vmr(:,k,hno3_ndx) + hno3_cond(:,k,1) & + + hno3_cond(:,k,2) + vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k) + + end do + + wrk(:,:) = (vmr(:,:,h2o_ndx) - wrk(:,:))*delt_inverse + call outfld( 'QDSETT', wrk(:,:), ncol, lchnk ) + + endif + +! +! LINOZ +! + if ( do_lin_strat_chem ) then + call lin_strat_chem_solve( ncol, lchnk, vmr(:,:,o3_ndx), col_dens(:,:,1), tfld, zen_angle, pmid, delt, rlats, troplev ) + end if + + !----------------------------------------------------------------------- + ! ... Check for negative values and reset to zero + !----------------------------------------------------------------------- + call negtrc( 'After chemistry ', vmr, ncol ) + + !----------------------------------------------------------------------- + ! ... Set upper boundary mmr values + !----------------------------------------------------------------------- + call set_fstrat_vals( vmr, pmid, pint, troplev, calday, ncol,lchnk ) + + !----------------------------------------------------------------------- + ! ... Set fixed lower boundary mmr values + !----------------------------------------------------------------------- + call flbc_set( vmr, ncol, lchnk, map2chm ) + + !----------------------------------------------------------------------- + ! set NOy UBC + !----------------------------------------------------------------------- + call noy_ubc_set( lchnk, ncol, vmr ) + + if ( ghg_chem ) then + call ghg_chem_set_flbc( vmr, ncol ) + endif + + !----------------------------------------------------------------------- + ! force ion/electron balance -- ext forcings likely do not conserve charge + !----------------------------------------------------------------------- + call charge_balance( ncol, vmr ) + + !----------------------------------------------------------------------- + ! ... Xform from vmr to mmr + !----------------------------------------------------------------------- + call vmr2mmr( vmr(:ncol,:,:), mmr_tend(:ncol,:,:), mbar(:ncol,:), ncol ) + + call set_short_lived_species( mmr_tend, lchnk, ncol, pbuf ) + + !----------------------------------------------------------------------- + ! ... Form the tendencies + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + mmr_new(:ncol,:,m) = mmr_tend(:ncol,:,m) + mmr_tend(:ncol,:,m) = (mmr_tend(:ncol,:,m) - mmr(:ncol,:,m))*delt_inverse + enddo + + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n) + end if + end do + + tvs(:ncol) = tfld(:ncol,pver) * (1._r8 + qh2o(:ncol,pver)) + + sflx(:,:) = 0._r8 + call get_ref_date(yr, mon, day, sec) + ncdate = yr*10000 + mon*100 + day + wind_speed(:ncol) = sqrt( ufld(:ncol,pver)*ufld(:ncol,pver) + vfld(:ncol,pver)*vfld(:ncol,pver) ) + prect(:ncol) = precc(:ncol) + precl(:ncol) + + if ( drydep_method == DD_XLND ) then + soilw = -99 + call drydep( ocnfrac, icefrac, ncdate, ts, ps, & + wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & + snowhland, fsds, depvel, sflx, mmr, & + tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) + else if ( drydep_method == DD_XATM ) then + table_soilw = has_drydep( 'H2' ) .or. has_drydep( 'CO' ) + if( .not. dyn_soilw .and. table_soilw ) then + call set_soilw( soilw, lchnk, calday ) + end if + call drydep( ncdate, ts, ps, & + wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & + snowhland, fsds, depvel, sflx, mmr, & + tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) + else if ( drydep_method == DD_TABL ) then + call drydep( calday, ts, zen_angle, & + depvel, sflx, mmr, pmid(:,pver), & + tvs, ncol, icefrac, ocnfrac, lchnk ) + endif + + drydepflx(:,:) = 0._r8 + do m = 1,pcnst + n = map2chm( m ) + if ( n > 0 ) then + cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n) + drydepflx(:ncol,m) = sflx(:ncol,n) + wetdepflx_diag(:ncol,n) = wetdepflx(:ncol,m) + endif + end do + + call chm_diags( lchnk, ncol, vmr(:ncol,:,:), mmr_new(:ncol,:,:), & + reaction_rates(:ncol,:,:), invariants(:ncol,:,:), depvel(:ncol,:), sflx(:ncol,:), & + mmr_tend(:ncol,:,:), pdel(:ncol,:), pmid(:ncol,:), troplev(:ncol), wetdepflx_diag(:ncol,:), & + nhx_nitrogen_flx(:ncol), noy_nitrogen_flx(:ncol) ) + + call rate_diags_calc( reaction_rates(:,:,:), vmr(:,:,:), invariants(:,:,indexm), ncol, lchnk ) +! +! jfl +! +! surface vmr +! + if ( pm25_srf_diag ) then + pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & + + mmr_new(:ncol,pver,cb2_ndx) & + + mmr_new(:ncol,pver,oc1_ndx) & + + mmr_new(:ncol,pver,oc2_ndx) & + + mmr_new(:ncol,pver,dst1_ndx) & + + mmr_new(:ncol,pver,dst2_ndx) & + + mmr_new(:ncol,pver,sslt1_ndx) & + + mmr_new(:ncol,pver,sslt2_ndx) & + + mmr_new(:ncol,pver,soa_ndx) & + + mmr_new(:ncol,pver,so4_ndx) + call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) + endif + if ( pm25_srf_diag_soa ) then + pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & + + mmr_new(:ncol,pver,cb2_ndx) & + + mmr_new(:ncol,pver,oc1_ndx) & + + mmr_new(:ncol,pver,oc2_ndx) & + + mmr_new(:ncol,pver,dst1_ndx) & + + mmr_new(:ncol,pver,dst2_ndx) & + + mmr_new(:ncol,pver,sslt1_ndx) & + + mmr_new(:ncol,pver,sslt2_ndx) & + + mmr_new(:ncol,pver,soam_ndx) & + + mmr_new(:ncol,pver,soai_ndx) & + + mmr_new(:ncol,pver,soat_ndx) & + + mmr_new(:ncol,pver,soab_ndx) & + + mmr_new(:ncol,pver,soax_ndx) & + + mmr_new(:ncol,pver,so4_ndx) + call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) + endif +! +! + call outfld('Q_SRF',qh2o(:ncol,pver) , ncol, lchnk ) + call outfld('U_SRF',ufld(:ncol,pver) , ncol, lchnk ) + call outfld('V_SRF',vfld(:ncol,pver) , ncol, lchnk ) + +! + if (.not.sad_pbf_ndx>0) then + deallocate(strato_sad) + endif + + end subroutine gas_phase_chemdr + +end module mo_gas_phase_chemdr diff --git a/src/chemistry/mozart/mo_ghg_chem.F90 b/src/chemistry/mozart/mo_ghg_chem.F90 new file mode 100644 index 0000000000..d362e35f83 --- /dev/null +++ b/src/chemistry/mozart/mo_ghg_chem.F90 @@ -0,0 +1,213 @@ +!----------------------------------------------------------------- +! Manages the reaction rates of the green house gas species. +! This is used with the reduced ghg chemical mechanism. +! +! Created by: Francis Vitt -- 20 Aug 2008 +!----------------------------------------------------------------- +module mo_ghg_chem + + use shr_kind_mod, only : r8 => shr_kind_r8 + use boundarydata, only : boundarydata_type, boundarydata_init, boundarydata_update + use physics_types, only : physics_state + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver, begchunk, endchunk + + implicit none + + private + save + + public :: ghg_chem_set_rates + public :: ghg_chem_set_flbc + public :: ghg_chem_init + public :: ghg_chem_timestep_init + public :: ghg_chem_final + + integer, parameter :: ncnst=4 ! number of constituents + type(boundarydata_type) :: chemdata + character(len=6), dimension(ncnst), parameter :: nc_names = & ! constituent names + (/'TN2O ', 'TCH4 ', 'TCFC11', 'TCFC12'/) + + integer :: n2o_rxt, ch4_rxt, cfc11_rxt, cfc12_rxt, lyman_alpha_rxt + integer :: n2o_ndx, ch4_ndx, cfc11_ndx, cfc12_ndx + integer :: ghg_ndx(ncnst) + character(len=6) :: ghg_bnd_names(ncnst) + + logical :: lyman_alpha = .false. + type(boundarydata_type) :: h2orate_data + character(len=4), parameter :: h2orate_name = 'jh2o' + +contains + +!----------------------------------------------------------------- +!----------------------------------------------------------------- + subroutine ghg_chem_init(phys_state, bndtvg, h2orates) + use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx + use cam_history, only : addfld + + implicit none + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + character(len=*), intent(in) :: bndtvg ! pathname for greenhouse gas loss rate + character(len=*),optional, intent(in) :: h2orates ! lyman-alpha h2o loss rates + + integer :: ids(8) + integer :: m,mm + + n2o_rxt = get_rxt_ndx( 'n2o_loss' ) + ch4_rxt = get_rxt_ndx( 'ch4_loss' ) + cfc11_rxt = get_rxt_ndx( 'cfc11_loss' ) + cfc12_rxt = get_rxt_ndx( 'cfc12_loss' ) + lyman_alpha_rxt = get_rxt_ndx( 'lyman_alpha' ) + + n2o_ndx = get_spc_ndx('N2O') + ch4_ndx = get_spc_ndx('CH4') + cfc11_ndx = get_spc_ndx('CFC11') + cfc12_ndx = get_spc_ndx('CFC12') + + ids(1) = n2o_rxt + ids(2) = ch4_rxt + ids(3) = cfc11_rxt + ids(4) = cfc12_rxt + ids(5) = n2o_ndx + ids(6) = ch4_ndx + ids(7) = cfc11_ndx + ids(8) = cfc12_ndx + + if( any( ids < 1 ) ) then + call endrun('need to configure with ghg chemistry mechanism') + endif + + call boundarydata_init(bndtvg,phys_state,nc_names,ncnst,chemdata) + + if ( present( h2orates ) ) then + if ( len_trim( h2orates ) > 0 .and. lyman_alpha_rxt > 0 ) then + lyman_alpha = .true. + call boundarydata_init(h2orates,phys_state,(/h2orate_name/),1,h2orate_data) + endif + endif + + call addfld( 'GHG_CFC11_R', (/ 'lev' /), 'I', '1/sec', 'prescribed cfc11 loss rate for ghg chem' ) + call addfld( 'GHG_CFC12_R', (/ 'lev' /), 'I', '1/sec', 'prescribed cfc12 loss rate for ghg chem' ) + call addfld( 'GHG_N2O_R', (/ 'lev' /), 'I', '1/sec', 'prescribed n2o loss rate for ghg chem' ) + call addfld( 'GHG_CH4_R', (/ 'lev' /), 'I', '1/sec', 'prescribed ch4 loss rate for ghg chem' ) + call addfld( 'GHG_H2O_R', (/ 'lev' /), 'I', '1/sec', 'prescribed h2o loss rate for ghg chem' ) + + ghg_ndx = (/ n2o_ndx, ch4_ndx, cfc11_ndx, cfc12_ndx /) + ghg_bnd_names = (/ 'N2OVMR', 'CH4VMR', 'F11VMR', 'F12VMR' /) + + end subroutine ghg_chem_init + +!----------------------------------------------------------------- +!----------------------------------------------------------------- + subroutine ghg_chem_timestep_init(phys_state) + implicit none + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + + call boundarydata_update(phys_state,chemdata) + if (lyman_alpha) then + call boundarydata_update(phys_state,h2orate_data) + endif + end subroutine ghg_chem_timestep_init + +!----------------------------------------------------------------- +!----------------------------------------------------------------- + subroutine ghg_chem_set_rates( rxn_rates, latmapback, zen_angle, ncol, lchnk ) + use chem_mods, only : rxntot + use cam_history, only : outfld + use mo_constants, only : pi + + implicit none + + integer, intent(in) :: ncol ! number columns in chunk + real(r8), intent(inout) :: rxn_rates(ncol,pver,rxntot) ! ghg loss rates + integer, intent(in) :: latmapback(pcols) + real(r8), intent(in) :: zen_angle(ncol) + integer, intent(in) :: lchnk ! chunk index + + integer :: i,k + real(r8), parameter :: half_pi = pi/2._r8 + + do k=1,pver-2 + do i=1,ncol + rxn_rates(i,k,n2o_rxt) = chemdata%datainst(latmapback(i),k,lchnk,1) + rxn_rates(i,k,ch4_rxt) = chemdata%datainst(latmapback(i),k,lchnk,2) + rxn_rates(i,k,cfc11_rxt) = chemdata%datainst(latmapback(i),k,lchnk,3) + rxn_rates(i,k,cfc12_rxt) = chemdata%datainst(latmapback(i),k,lchnk,4) + enddo + enddo + + rxn_rates(:ncol,pver-1:pver,n2o_rxt) = 0._r8 + rxn_rates(:ncol,pver-1:pver,ch4_rxt) = 0._r8 + rxn_rates(:ncol,pver-1:pver,cfc11_rxt) = 0._r8 + rxn_rates(:ncol,pver-1:pver,cfc12_rxt) = 0._r8 + + call outfld( 'GHG_CFC11_R', rxn_rates(:ncol,:,cfc11_rxt), ncol, lchnk ) + call outfld( 'GHG_CFC12_R', rxn_rates(:ncol,:,cfc12_rxt), ncol, lchnk ) + call outfld( 'GHG_N2O_R', rxn_rates(:ncol,:,n2o_rxt), ncol, lchnk ) + call outfld( 'GHG_CH4_R', rxn_rates(:ncol,:,ch4_rxt), ncol, lchnk ) + + if (lyman_alpha_rxt > 0) then + rxn_rates(:ncol,:,lyman_alpha_rxt) = 0._r8 + endif + + if (lyman_alpha) then + do i=1,ncol + if (zen_angle(i) < half_pi) then + rxn_rates(i,:,lyman_alpha_rxt) = h2orate_data%datainst(latmapback(i),:,lchnk,1) + endif + enddo + + call outfld( 'GHG_H2O_R', rxn_rates(:ncol,:,lyman_alpha_rxt), ncol, lchnk ) + endif + + endsubroutine ghg_chem_set_rates + +!----------------------------------------------------------------- +!----------------------------------------------------------------- + subroutine ghg_chem_set_flbc( vmr, ncol ) + use chem_surfvals, only : chem_surfvals_get + use chem_mods, only : gas_pcnst + use mo_flbc, only : has_flbc + implicit none + + integer, intent(in) :: ncol ! number columns in chunk + real(r8), intent(inout) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) + integer :: i,ndx + + do i = 1,ncnst + ndx = ghg_ndx(i) + if ( has_flbc(ndx)) then + vmr(:ncol, pver-1, ndx) = vmr(:ncol, pver, ndx) + else + vmr(:ncol, pver-1:pver, ndx) = chem_surfvals_get(ghg_bnd_names(i)) + endif + enddo + + endsubroutine ghg_chem_set_flbc + +!----------------------------------------------------------------- +!----------------------------------------------------------------- + subroutine ghg_chem_final + implicit none + + deallocate(chemdata%fields) + deallocate(chemdata%datainst) + deallocate(chemdata%cdates) + deallocate(chemdata%lat) + deallocate(chemdata%zi) + + if (lyman_alpha) then + + deallocate(h2orate_data%fields) + deallocate(h2orate_data%datainst) + deallocate(h2orate_data%cdates) + deallocate(h2orate_data%lat) + deallocate(h2orate_data%zi) + + endif + + end subroutine ghg_chem_final + +end module mo_ghg_chem diff --git a/src/chemistry/mozart/mo_heatnirco2.F90 b/src/chemistry/mozart/mo_heatnirco2.F90 new file mode 100644 index 0000000000..1287e0cab3 --- /dev/null +++ b/src/chemistry/mozart/mo_heatnirco2.F90 @@ -0,0 +1,559 @@ + + module mo_heatnirco2 + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + + private + public :: heatnirco2 + public :: heatnirco2_init + + integer,parameter :: ndpara = 62 + integer,parameter :: ncolgr = 10 + + real(r8) :: xspara(ndpara) + real(r8) :: zppara(ndpara) = (/ & + -17.00_r8, -16.75_r8, -16.50_r8, -16.25_r8, -16.00_r8, & + -15.75_r8, -15.50_r8, -15.25_r8, -15.00_r8, -14.75_r8, & + -14.50_r8, -14.25_r8, -14.00_r8, -13.75_r8, -13.50_r8, & + -13.25_r8, -13.00_r8, -12.75_r8, -12.50_r8, -12.25_r8, & + -12.00_r8, -11.75_r8, -11.50_r8, -11.25_r8, -11.00_r8, & + -10.75_r8, -10.50_r8, -10.25_r8, -10.00_r8, -9.75_r8, & + -9.50_r8, -9.25_r8, -9.00_r8, -8.75_r8, -8.50_r8, & + -8.25_r8, -8.00_r8, -7.75_r8, -7.50_r8, -7.25_r8, & + -7.00_r8, -6.75_r8, -6.50_r8, -6.25_r8, -6.00_r8, & + -5.75_r8, -5.50_r8, -5.25_r8, -5.00_r8, -4.75_r8, & + -4.50_r8, -4.25_r8, -4.00_r8, -3.75_r8, -3.50_r8, & + -3.25_r8, -3.00_r8, -2.75_r8, -2.50_r8, -2.25_r8, & + -2.00_r8, -1.75_r8 /) + real(r8) :: co2stand(ndpara) + real(r8) :: colmpara(ndpara,ncolgr) + real(r8) :: corrnormpara(ndpara,ncolgr) + + contains + + subroutine heatnirco2( co2, scco2, pmid, htng, kbot, zarg, sza ) + + use cam_abortutils, only : endrun + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer,intent(in) :: kbot ! vertical dimension + real(r8), intent(in) :: sza + real(r8), intent(in) :: zarg(kbot) ! midpoint geopot (m) + real(r8), intent(in) :: co2(kbot) ! co2 concentration (mol/mol) + real(r8), intent(in) :: scco2(kbot) ! co2 slant column (molec/cm^2) + real(r8), intent(in) :: pmid(kbot) ! model midpoint pressure (Pa) + real(r8), intent(out) :: htng(kbot) ! co2 near ir heating (K/day) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: smallvalue = 1.0e-20_r8 + real(r8), parameter :: pa2hPa = 1.e-2_r8 + + integer :: icolm, icolmp1 + integer :: k, kk, kndx + real(r8) :: reldcolm + real(r8) :: delp + real(r8) :: pinterp + real(r8) :: colzpint + real(r8) :: co2std + real(r8) :: colparai(ncolgr) + real(r8) :: corrnorai(ncolgr) + + htng(:kbot) = smallvalue +#ifdef NIR_DEBUG + write(iulog,*) ' ' + write(iulog,*) '===============================================' + write(iulog,*) 'heatnirco2: kbot,sza = ',kbot,sza + write(iulog,*) 'heatnirco2: co2' + write(iulog,'(1p,5g15.7)') co2(:) + write(iulog,*) 'heatnirco2: scco2' + write(iulog,'(1p,5g15.7)') scco2(:) + write(iulog,*) 'heatnirco2: pmid' + write(iulog,'(1p,5g15.7)') pmid(:) + write(iulog,*) 'heatnirco2: zarg' + write(iulog,'(1p,5g15.7)') zarg(:) + write(iulog,*) 'heatnirco2: xspara' + write(iulog,'(1p,5g15.7)') xspara(:) +#endif +!----------------------------------------------------------------------- +! ... vertical and column interpolation +!----------------------------------------------------------------------- +level_loop : & + do k = 1,kbot +!----------------------------------------------------------------------- +! ... first setup pressure interpolation +!----------------------------------------------------------------------- + pinterp = pmid(k) * pa2hPa + colzpint = log( scco2(k) ) + if( pinterp <= xspara(ndpara) ) then + colparai(:) = colmpara(ndpara,:) + corrnorai(:) = corrnormpara(ndpara,:) + co2std = co2stand(ndpara) + else if( pinterp > xspara(1) ) then + colparai(:) = colmpara(1,:) + corrnorai(:) = corrnormpara(1,:) + co2std = co2stand(1) + else + do kk = ndpara-1,1,-1 + if( pinterp <= xspara(kk) ) then + kndx = kk + 1 + delp = (pinterp - xspara(kndx))/(xspara(kk) - xspara(kndx)) + colparai(:) = colmpara(kndx,:) + delp*(colmpara(kk,:) - colmpara(kndx,:)) + corrnorai(:) = corrnormpara(kndx,:) & + + delp*(corrnormpara(kk,:) - corrnormpara(kndx,:)) + co2std = co2stand(kndx) + delp*(co2stand(kk) - co2stand(kndx)) + exit + end if + end do + end if + +!----------------------------------------------------------------------- +! Linear interpolation over column density for given altitude point +!----------------------------------------------------------------------- + if( colzpint < colparai(1) ) then + htng(k) = corrnorai(1) + else if( colzpint >= colparai(ncolgr) ) then + htng(k) = corrnorai(ncolgr) + else +loop1: do icolm = 1,ncolgr-1 + icolmp1 = icolm + 1 + if( colzpint >= colparai(icolm) .and. & + colzpint < colparai(icolmp1) ) then + reldcolm = (colzpint - colparai(icolm)) & + /(colparai(icolmp1) - colparai(icolm)) + htng(k) = corrnorai(icolm) & + + (corrnorai(icolmp1) - corrnorai(icolm))*reldcolm + exit loop1 + end if + end do loop1 + end if +#ifdef NIR_DEBUG + write(iulog,*) 'heatnirco2: k, kk, kndx, icolm, icolmp1 = ',k,kk,kndx,icolm,icolmp1 + write(iulog,*) 'heatnirco2: colparai' + write(iulog,'(1p,5g15.7)') colparai(:) + write(iulog,*) 'heatnirco2: corrnorai' + write(iulog,'(1p,5g15.7)') corrnorai(:) + write(iulog,*) 'heatnirco2: pinterp,colzpint,delp,reldcolm,co2std,htng' + write(iulog,'(1p,6g15.7)') pinterp,colzpint,delp,reldcolm,co2std,htng(k) +#endif + +!----------------------------------------------------------------------- +! From normalized value to the one corresponding to the given vmrco2 +!----------------------------------------------------------------------- + htng(k) = htng(k) * co2(k)/co2std + end do level_loop + + end subroutine heatnirco2 + + subroutine heatnirco2_init +!----------------------------------------------------------------------- +! Called once per run from init (init.F) to define module data. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + + do k = 1,ndpara + xspara(k) = 5.e-7_r8 * exp( -zppara(k) ) + end do + + co2stand = (/ & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, 3.6000e-04_r8, & + 3.6000e-04_r8, 3.6000e-04_r8, 3.5867e-04_r8, 3.5534e-04_r8, 3.5134e-04_r8, & + 3.4401e-04_r8, 3.3235e-04_r8, 3.1668e-04_r8, 2.9902e-04_r8, 2.8102e-04_r8, & + 2.6235e-04_r8, 2.4335e-04_r8, 2.2435e-04_r8, 2.0535e-04_r8, 1.8635e-04_r8, & + 1.6735e-04_r8, 1.4835e-04_r8, 1.3002e-04_r8, 1.1202e-04_r8, 9.5350e-05_r8, & + 8.2013e-05_r8, 7.1344e-05_r8, 6.2010e-05_r8, 5.3675e-05_r8, 4.6341e-05_r8, & + 3.9341e-05_r8, 3.2341e-05_r8, 2.6006e-05_r8, 2.0672e-05_r8, 1.5672e-05_r8, & + 1.1338e-05_r8, 8.0032e-06_r8 /) + + colmpara(1,:) = (/ & + 4.5112e+01_r8, 4.5647e+01_r8, 4.6183e+01_r8, 4.6719e+01_r8, 4.7254e+01_r8, & + 4.7789e+01_r8, 4.8325e+01_r8, 4.8861e+01_r8, 4.9396e+01_r8, 4.9931e+01_r8 /) + colmpara(2,:) = (/ & + 4.4862e+01_r8, 4.5398e+01_r8, 4.5934e+01_r8, 4.6469e+01_r8, 4.7004e+01_r8, & + 4.7540e+01_r8, 4.8076e+01_r8, 4.8611e+01_r8, 4.9147e+01_r8, 4.9682e+01_r8 /) + colmpara(3,:) = (/ & + 4.4613e+01_r8, 4.5148e+01_r8, 4.5684e+01_r8, 4.6220e+01_r8, 4.6755e+01_r8, & + 4.7290e+01_r8, 4.7826e+01_r8, 4.8362e+01_r8, 4.8897e+01_r8, 4.9432e+01_r8 /) + colmpara(4,:) = (/ & + 4.4363e+01_r8, 4.4899e+01_r8, 4.5435e+01_r8, 4.5970e+01_r8, 4.6506e+01_r8, & + 4.7041e+01_r8, 4.7577e+01_r8, 4.8112e+01_r8, 4.8647e+01_r8, 4.9183e+01_r8 /) + colmpara(5,:) = (/ & + 4.4114e+01_r8, 4.4650e+01_r8, 4.5185e+01_r8, 4.5721e+01_r8, 4.6256e+01_r8, & + 4.6791e+01_r8, 4.7327e+01_r8, 4.7863e+01_r8, 4.8398e+01_r8, 4.8933e+01_r8 /) + colmpara(6,:) = (/ & + 4.3865e+01_r8, 4.4401e+01_r8, 4.4936e+01_r8, 4.5471e+01_r8, 4.6007e+01_r8, & + 4.6542e+01_r8, 4.7078e+01_r8, 4.7613e+01_r8, 4.8149e+01_r8, 4.8684e+01_r8 /) + colmpara(7,:) = (/ & + 4.3615e+01_r8, 4.4151e+01_r8, 4.4686e+01_r8, 4.5222e+01_r8, 4.5757e+01_r8, & + 4.6293e+01_r8, 4.6828e+01_r8, 4.7364e+01_r8, 4.7899e+01_r8, 4.8435e+01_r8 /) + colmpara(8,:) = (/ & + 4.3366e+01_r8, 4.3901e+01_r8, 4.4437e+01_r8, 4.4972e+01_r8, 4.5508e+01_r8, & + 4.6043e+01_r8, 4.6579e+01_r8, 4.7114e+01_r8, 4.7650e+01_r8, 4.8185e+01_r8 /) + colmpara(9,:) = (/ & + 4.3116e+01_r8, 4.3652e+01_r8, 4.4188e+01_r8, 4.4723e+01_r8, 4.5258e+01_r8, & + 4.5794e+01_r8, 4.6329e+01_r8, 4.6865e+01_r8, 4.7400e+01_r8, 4.7936e+01_r8 /) + colmpara(10,:) = (/ & + 4.2867e+01_r8, 4.3402e+01_r8, 4.3938e+01_r8, 4.4473e+01_r8, 4.5009e+01_r8, & + 4.5544e+01_r8, 4.6080e+01_r8, 4.6616e+01_r8, 4.7151e+01_r8, 4.7686e+01_r8 /) + colmpara(11,:) = (/ & + 4.2617e+01_r8, 4.3153e+01_r8, 4.3688e+01_r8, 4.4224e+01_r8, 4.4759e+01_r8, & + 4.5295e+01_r8, 4.5830e+01_r8, 4.6366e+01_r8, 4.6901e+01_r8, 4.7437e+01_r8 /) + colmpara(12,:) = (/ & + 4.2368e+01_r8, 4.2903e+01_r8, 4.3439e+01_r8, 4.3974e+01_r8, 4.4510e+01_r8, & + 4.5045e+01_r8, 4.5581e+01_r8, 4.6116e+01_r8, 4.6651e+01_r8, 4.7187e+01_r8 /) + colmpara(13,:) = (/ & + 4.2118e+01_r8, 4.2654e+01_r8, 4.3189e+01_r8, 4.3725e+01_r8, 4.4260e+01_r8, & + 4.4796e+01_r8, 4.5331e+01_r8, 4.5867e+01_r8, 4.6402e+01_r8, 4.6938e+01_r8 /) + colmpara(14,:) = (/ & + 4.1869e+01_r8, 4.2404e+01_r8, 4.2940e+01_r8, 4.3475e+01_r8, 4.4011e+01_r8, & + 4.4546e+01_r8, 4.5082e+01_r8, 4.5617e+01_r8, 4.6153e+01_r8, 4.6688e+01_r8 /) + colmpara(15,:) = (/ & + 4.1619e+01_r8, 4.2155e+01_r8, 4.2690e+01_r8, 4.3225e+01_r8, 4.3761e+01_r8, & + 4.4296e+01_r8, 4.4832e+01_r8, 4.5367e+01_r8, 4.5903e+01_r8, 4.6438e+01_r8 /) + colmpara(16,:) = (/ & + 4.1369e+01_r8, 4.1905e+01_r8, 4.2440e+01_r8, 4.2976e+01_r8, 4.3511e+01_r8, & + 4.4046e+01_r8, 4.4582e+01_r8, 4.5118e+01_r8, 4.5653e+01_r8, 4.6188e+01_r8 /) + colmpara(17,:) = (/ & + 4.1119e+01_r8, 4.1655e+01_r8, 4.2190e+01_r8, 4.2726e+01_r8, 4.3261e+01_r8, & + 4.3797e+01_r8, 4.4332e+01_r8, 4.4868e+01_r8, 4.5403e+01_r8, 4.5938e+01_r8 /) + colmpara(18,:) = (/ & + 4.0869e+01_r8, 4.1405e+01_r8, 4.1940e+01_r8, 4.2476e+01_r8, 4.3011e+01_r8, & + 4.3547e+01_r8, 4.4082e+01_r8, 4.4618e+01_r8, 4.5153e+01_r8, 4.5688e+01_r8 /) + colmpara(19,:) = (/ & + 4.0619e+01_r8, 4.1154e+01_r8, 4.1690e+01_r8, 4.2226e+01_r8, 4.2761e+01_r8, & + 4.3296e+01_r8, 4.3832e+01_r8, 4.4367e+01_r8, 4.4903e+01_r8, 4.5438e+01_r8 /) + colmpara(20,:) = (/ & + 4.0368e+01_r8, 4.0904e+01_r8, 4.1439e+01_r8, 4.1975e+01_r8, 4.2510e+01_r8, & + 4.3046e+01_r8, 4.3581e+01_r8, 4.4117e+01_r8, 4.4652e+01_r8, 4.5188e+01_r8 /) + colmpara(21,:) = (/ & + 4.0117e+01_r8, 4.0653e+01_r8, 4.1189e+01_r8, 4.1724e+01_r8, 4.2259e+01_r8, & + 4.2795e+01_r8, 4.3330e+01_r8, 4.3866e+01_r8, 4.4402e+01_r8, 4.4937e+01_r8 /) + colmpara(22,:) = (/ & + 3.9866e+01_r8, 4.0402e+01_r8, 4.0937e+01_r8, 4.1473e+01_r8, 4.2008e+01_r8, & + 4.2544e+01_r8, 4.3080e+01_r8, 4.3615e+01_r8, 4.4150e+01_r8, 4.4686e+01_r8 /) + colmpara(23,:) = (/ & + 3.9615e+01_r8, 4.0150e+01_r8, 4.0686e+01_r8, 4.1221e+01_r8, 4.1757e+01_r8, & + 4.2292e+01_r8, 4.2828e+01_r8, 4.3363e+01_r8, 4.3899e+01_r8, 4.4434e+01_r8 /) + colmpara(24,:) = (/ & + 3.9363e+01_r8, 3.9898e+01_r8, 4.0434e+01_r8, 4.0969e+01_r8, 4.1505e+01_r8, & + 4.2040e+01_r8, 4.2576e+01_r8, 4.3111e+01_r8, 4.3647e+01_r8, 4.4182e+01_r8 /) + colmpara(25,:) = (/ & + 3.9110e+01_r8, 3.9645e+01_r8, 4.0181e+01_r8, 4.0716e+01_r8, 4.1252e+01_r8, & + 4.1787e+01_r8, 4.2323e+01_r8, 4.2858e+01_r8, 4.3394e+01_r8, 4.3929e+01_r8 /) + colmpara(26,:) = (/ & + 3.8856e+01_r8, 3.9391e+01_r8, 3.9927e+01_r8, 4.0462e+01_r8, 4.0998e+01_r8, & + 4.1533e+01_r8, 4.2069e+01_r8, 4.2604e+01_r8, 4.3140e+01_r8, 4.3675e+01_r8 /) + colmpara(27,:) = (/ & + 3.8601e+01_r8, 3.9136e+01_r8, 3.9672e+01_r8, 4.0207e+01_r8, 4.0743e+01_r8, & + 4.1278e+01_r8, 4.1814e+01_r8, 4.2349e+01_r8, 4.2885e+01_r8, 4.3420e+01_r8 /) + colmpara(28,:) = (/ & + 3.8344e+01_r8, 3.8879e+01_r8, 3.9415e+01_r8, 3.9950e+01_r8, 4.0486e+01_r8, & + 4.1021e+01_r8, 4.1557e+01_r8, 4.2092e+01_r8, 4.2628e+01_r8, 4.3163e+01_r8 /) + colmpara(29,:) = (/ & + 3.8085e+01_r8, 3.8620e+01_r8, 3.9156e+01_r8, 3.9692e+01_r8, 4.0227e+01_r8, & + 4.0762e+01_r8, 4.1298e+01_r8, 4.1833e+01_r8, 4.2369e+01_r8, 4.2904e+01_r8 /) + colmpara(30,:) = (/ & + 3.7823e+01_r8, 3.8359e+01_r8, 3.8894e+01_r8, 3.9430e+01_r8, 3.9965e+01_r8, & + 4.0501e+01_r8, 4.1036e+01_r8, 4.1572e+01_r8, 4.2107e+01_r8, 4.2642e+01_r8 /) + colmpara(31,:) = (/ & + 3.7558e+01_r8, 3.8093e+01_r8, 3.8628e+01_r8, 3.9164e+01_r8, 3.9699e+01_r8, & + 4.0235e+01_r8, 4.0771e+01_r8, 4.1306e+01_r8, 4.1842e+01_r8, 4.2377e+01_r8 /) + colmpara(32,:) = (/ & + 3.7287e+01_r8, 3.7823e+01_r8, 3.8358e+01_r8, 3.8894e+01_r8, 3.9429e+01_r8, & + 3.9965e+01_r8, 4.0500e+01_r8, 4.1036e+01_r8, 4.1571e+01_r8, 4.2107e+01_r8 /) + colmpara(33,:) = (/ & + 3.7011e+01_r8, 3.7547e+01_r8, 3.8082e+01_r8, 3.8617e+01_r8, 3.9153e+01_r8, & + 3.9689e+01_r8, 4.0224e+01_r8, 4.0759e+01_r8, 4.1295e+01_r8, 4.1830e+01_r8 /) + colmpara(34,:) = (/ & + 3.6728e+01_r8, 3.7263e+01_r8, 3.7799e+01_r8, 3.8334e+01_r8, 3.8870e+01_r8, & + 3.9405e+01_r8, 3.9941e+01_r8, 4.0476e+01_r8, 4.1012e+01_r8, 4.1547e+01_r8 /) + colmpara(35,:) = (/ & + 3.6437e+01_r8, 3.6972e+01_r8, 3.7508e+01_r8, 3.8043e+01_r8, 3.8578e+01_r8, & + 3.9114e+01_r8, 3.9650e+01_r8, 4.0185e+01_r8, 4.0720e+01_r8, 4.1256e+01_r8 /) + colmpara(36,:) = (/ & + 3.6136e+01_r8, 3.6672e+01_r8, 3.7207e+01_r8, 3.7743e+01_r8, 3.8278e+01_r8, & + 3.8814e+01_r8, 3.9349e+01_r8, 3.9885e+01_r8, 4.0420e+01_r8, 4.0956e+01_r8 /) + colmpara(37,:) = (/ & + 3.5827e+01_r8, 3.6363e+01_r8, 3.6898e+01_r8, 3.7434e+01_r8, 3.7969e+01_r8, & + 3.8505e+01_r8, 3.9040e+01_r8, 3.9575e+01_r8, 4.0111e+01_r8, 4.0647e+01_r8 /) + colmpara(38,:) = (/ & + 3.5511e+01_r8, 3.6046e+01_r8, 3.6582e+01_r8, 3.7117e+01_r8, 3.7653e+01_r8, & + 3.8188e+01_r8, 3.8724e+01_r8, 3.9259e+01_r8, 3.9795e+01_r8, 4.0331e+01_r8 /) + colmpara(39,:) = (/ & + 3.5189e+01_r8, 3.5724e+01_r8, 3.6259e+01_r8, 3.6795e+01_r8, 3.7331e+01_r8, & + 3.7866e+01_r8, 3.8402e+01_r8, 3.8937e+01_r8, 3.9472e+01_r8, 4.0008e+01_r8 /) + colmpara(40,:) = (/ & + 3.4860e+01_r8, 3.5395e+01_r8, 3.5931e+01_r8, 3.6466e+01_r8, 3.7002e+01_r8, & + 3.7538e+01_r8, 3.8073e+01_r8, 3.8608e+01_r8, 3.9144e+01_r8, 3.9679e+01_r8 /) + colmpara(41,:) = (/ & + 3.4525e+01_r8, 3.5061e+01_r8, 3.5596e+01_r8, 3.6132e+01_r8, 3.6667e+01_r8, & + 3.7203e+01_r8, 3.7738e+01_r8, 3.8274e+01_r8, 3.8809e+01_r8, 3.9345e+01_r8 /) + colmpara(42,:) = (/ & + 3.4184e+01_r8, 3.4719e+01_r8, 3.5254e+01_r8, 3.5790e+01_r8, 3.6326e+01_r8, & + 3.6861e+01_r8, 3.7396e+01_r8, 3.7932e+01_r8, 3.8467e+01_r8, 3.9003e+01_r8 /) + colmpara(43,:) = (/ & + 3.3835e+01_r8, 3.4370e+01_r8, 3.4906e+01_r8, 3.5441e+01_r8, 3.5977e+01_r8, & + 3.6512e+01_r8, 3.7048e+01_r8, 3.7583e+01_r8, 3.8119e+01_r8, 3.8654e+01_r8 /) + colmpara(44,:) = (/ & + 3.3478e+01_r8, 3.4014e+01_r8, 3.4549e+01_r8, 3.5085e+01_r8, 3.5620e+01_r8, & + 3.6155e+01_r8, 3.6691e+01_r8, 3.7227e+01_r8, 3.7762e+01_r8, 3.8297e+01_r8 /) + colmpara(45,:) = (/ & + 3.3112e+01_r8, 3.3648e+01_r8, 3.4183e+01_r8, 3.4719e+01_r8, 3.5254e+01_r8, & + 3.5790e+01_r8, 3.6325e+01_r8, 3.6861e+01_r8, 3.7396e+01_r8, 3.7932e+01_r8 /) + colmpara(46,:) = (/ & + 3.2738e+01_r8, 3.3273e+01_r8, 3.3808e+01_r8, 3.4344e+01_r8, 3.4880e+01_r8, & + 3.5415e+01_r8, 3.5950e+01_r8, 3.6486e+01_r8, 3.7021e+01_r8, 3.7557e+01_r8 /) + colmpara(47,:) = (/ & + 3.2354e+01_r8, 3.2889e+01_r8, 3.3425e+01_r8, 3.3960e+01_r8, 3.4496e+01_r8, & + 3.5031e+01_r8, 3.5567e+01_r8, 3.6102e+01_r8, 3.6638e+01_r8, 3.7173e+01_r8 /) + colmpara(48,:) = (/ & + 3.1963e+01_r8, 3.2498e+01_r8, 3.3034e+01_r8, 3.3569e+01_r8, 3.4105e+01_r8, & + 3.4640e+01_r8, 3.5176e+01_r8, 3.5711e+01_r8, 3.6247e+01_r8, 3.6782e+01_r8 /) + colmpara(49,:) = (/ & + 3.1567e+01_r8, 3.2103e+01_r8, 3.2638e+01_r8, 3.3174e+01_r8, 3.3709e+01_r8, & + 3.4244e+01_r8, 3.4780e+01_r8, 3.5316e+01_r8, 3.5851e+01_r8, 3.6386e+01_r8 /) + colmpara(50,:) = (/ & + 3.1171e+01_r8, 3.1707e+01_r8, 3.2242e+01_r8, 3.2778e+01_r8, 3.3314e+01_r8, & + 3.3849e+01_r8, 3.4384e+01_r8, 3.4920e+01_r8, 3.5456e+01_r8, 3.5991e+01_r8 /) + colmpara(51,:) = (/ & + 3.0777e+01_r8, 3.1313e+01_r8, 3.1848e+01_r8, 3.2384e+01_r8, 3.2919e+01_r8, & + 3.3455e+01_r8, 3.3990e+01_r8, 3.4526e+01_r8, 3.5062e+01_r8, 3.5597e+01_r8 /) + colmpara(52,:) = (/ & + 3.0379e+01_r8, 3.0914e+01_r8, 3.1450e+01_r8, 3.1985e+01_r8, 3.2521e+01_r8, & + 3.3056e+01_r8, 3.3592e+01_r8, 3.4127e+01_r8, 3.4663e+01_r8, 3.5198e+01_r8 /) + colmpara(53,:) = (/ & + 2.9970e+01_r8, 3.0506e+01_r8, 3.1041e+01_r8, 3.1577e+01_r8, 3.2112e+01_r8, & + 3.2648e+01_r8, 3.3183e+01_r8, 3.3719e+01_r8, 3.4254e+01_r8, 3.4790e+01_r8 /) + colmpara(54,:) = (/ & + 2.9547e+01_r8, 3.0083e+01_r8, 3.0618e+01_r8, 3.1154e+01_r8, 3.1689e+01_r8, & + 3.2225e+01_r8, 3.2760e+01_r8, 3.3296e+01_r8, 3.3831e+01_r8, 3.4367e+01_r8 /) + colmpara(55,:) = (/ & + 2.9104e+01_r8, 2.9640e+01_r8, 3.0175e+01_r8, 3.0711e+01_r8, 3.1246e+01_r8, & + 3.1782e+01_r8, 3.2317e+01_r8, 3.2853e+01_r8, 3.3388e+01_r8, 3.3924e+01_r8 /) + colmpara(56,:) = (/ & + 2.8636e+01_r8, 2.9171e+01_r8, 2.9707e+01_r8, 3.0242e+01_r8, 3.0778e+01_r8, & + 3.1313e+01_r8, 3.1849e+01_r8, 3.2384e+01_r8, 3.2920e+01_r8, 3.3455e+01_r8 /) + colmpara(57,:) = (/ & + 2.8140e+01_r8, 2.8675e+01_r8, 2.9211e+01_r8, 2.9746e+01_r8, 3.0282e+01_r8, & + 3.0817e+01_r8, 3.1353e+01_r8, 3.1888e+01_r8, 3.2424e+01_r8, 3.2960e+01_r8 /) + colmpara(58,:) = (/ & + 2.7615e+01_r8, 2.8151e+01_r8, 2.8686e+01_r8, 2.9221e+01_r8, 2.9757e+01_r8, & + 3.0292e+01_r8, 3.0828e+01_r8, 3.1364e+01_r8, 3.1899e+01_r8, 3.2435e+01_r8 /) + colmpara(59,:) = (/ & + 2.7048e+01_r8, 2.7583e+01_r8, 2.8119e+01_r8, 2.8654e+01_r8, 2.9190e+01_r8, & + 2.9725e+01_r8, 3.0261e+01_r8, 3.0796e+01_r8, 3.1332e+01_r8, 3.1867e+01_r8 /) + colmpara(60,:) = (/ & + 2.6417e+01_r8, 2.6952e+01_r8, 2.7488e+01_r8, 2.8023e+01_r8, 2.8558e+01_r8, & + 2.9094e+01_r8, 2.9630e+01_r8, 3.0165e+01_r8, 3.0701e+01_r8, 3.1236e+01_r8 /) + colmpara(61,:) = (/ & + 2.5690e+01_r8, 2.6226e+01_r8, 2.6761e+01_r8, 2.7297e+01_r8, 2.7832e+01_r8, & + 2.8368e+01_r8, 2.8903e+01_r8, 2.9439e+01_r8, 2.9974e+01_r8, 3.0510e+01_r8 /) + colmpara(62,:) = (/ & + 2.4753e+01_r8, 2.5288e+01_r8, 2.5824e+01_r8, 2.6359e+01_r8, 2.6895e+01_r8, & + 2.7430e+01_r8, 2.7966e+01_r8, 2.8501e+01_r8, 2.9036e+01_r8, 2.9572e+01_r8 /) + + corrnormpara(1,:) = (/ & + 1.0127e+00_r8, 7.6998e-01_r8, 5.8224e-01_r8, 4.2806e-01_r8, 2.9084e-01_r8, & + 1.9402e-01_r8, 1.3023e-01_r8, 9.1149e-02_r8, 6.4704e-02_r8, 4.7688e-02_r8/) + corrnormpara(2,:) = (/ & + 1.0187e+00_r8, 7.7869e-01_r8, 5.9453e-01_r8, 4.4852e-01_r8, 3.1375e-01_r8, & + 2.1065e-01_r8, 1.3653e-01_r8, 9.1144e-02_r8, 6.1994e-02_r8, 4.4571e-02_r8/) + corrnormpara(3,:) = (/ & + 1.0270e+00_r8, 7.8203e-01_r8, 5.9534e-01_r8, 4.5240e-01_r8, 3.2403e-01_r8, & + 2.2302e-01_r8, 1.4233e-01_r8, 8.9070e-02_r8, 5.6653e-02_r8, 3.8611e-02_r8/) + corrnormpara(4,:) = (/ & + 1.0373e+00_r8, 7.8500e-01_r8, 5.9297e-01_r8, 4.4837e-01_r8, 3.2384e-01_r8, & + 2.2687e-01_r8, 1.4450e-01_r8, 8.4366e-02_r8, 4.9511e-02_r8, 3.1025e-02_r8/) + corrnormpara(5,:) = (/ & + 1.0490e+00_r8, 7.8929e-01_r8, 5.9130e-01_r8, 4.4231e-01_r8, 3.1728e-01_r8, & + 2.2191e-01_r8, 1.4024e-01_r8, 7.6380e-02_r8, 4.1139e-02_r8, 2.2905e-02_r8/) + corrnormpara(6,:) = (/ & + 1.0617e+00_r8, 7.9456e-01_r8, 5.9057e-01_r8, 4.3581e-01_r8, 3.0571e-01_r8, & + 2.0872e-01_r8, 1.2728e-01_r8, 6.2907e-02_r8, 3.0269e-02_r8, 1.4243e-02_r8/) + corrnormpara(7,:) = (/ & + 1.0773e+00_r8, 8.0212e-01_r8, 5.9180e-01_r8, 4.2987e-01_r8, 2.8925e-01_r8, & + 1.8822e-01_r8, 1.0372e-01_r8, 3.4590e-02_r8, 1.2018e-02_r8, 3.8835e-03_r8/) + corrnormpara(8,:) = (/ & + 1.1003e+00_r8, 8.1612e-01_r8, 5.9836e-01_r8, 4.2760e-01_r8, 2.8986e-01_r8, & + 1.8413e-01_r8, 9.7462e-02_r8, 4.0988e-02_r8, 7.2898e-03_r8, -9.4405e-03_r8/) + corrnormpara(9,:) = (/ & + 1.1409e+00_r8, 8.4433e-01_r8, 6.1714e-01_r8, 4.3559e-01_r8, 2.9400e-01_r8, & + 1.8117e-01_r8, 8.9445e-02_r8, 3.9187e-02_r8, -2.7993e-03_r8, -2.3482e-02_r8/) + corrnormpara(10,:) = (/ & + 1.2102e+00_r8, 8.9617e-01_r8, 6.5632e-01_r8, 4.6226e-01_r8, 3.0804e-01_r8, & + 1.8559e-01_r8, 8.5822e-02_r8, 3.2302e-02_r8, -1.1882e-02_r8, -3.1824e-02_r8/) + corrnormpara(11,:) = (/ & + 1.3155e+00_r8, 9.7740e-01_r8, 7.2026e-01_r8, 5.1267e-01_r8, 3.4425e-01_r8, & + 2.1050e-01_r8, 1.0137e-01_r8, 4.2290e-02_r8, -6.6371e-03_r8, -2.9570e-02_r8/) + corrnormpara(12,:) = (/ & + 1.4568e+00_r8, 1.0872e+00_r8, 8.0860e-01_r8, 5.8668e-01_r8, 3.7564e-01_r8, & + 2.2742e-01_r8, 1.1522e-01_r8, 6.0656e-02_r8, 1.5509e-02_r8, -1.3943e-02_r8/) + corrnormpara(13,:) = (/ & + 1.6291e+00_r8, 1.2209e+00_r8, 9.1448e-01_r8, 6.7723e-01_r8, 4.4810e-01_r8, & + 2.8628e-01_r8, 1.6087e-01_r8, 8.2129e-02_r8, 3.7453e-02_r8, 1.2558e-02_r8/) + corrnormpara(14,:) = (/ & + 1.8231e+00_r8, 1.3678e+00_r8, 1.0284e+00_r8, 7.7316e-01_r8, 5.4154e-01_r8, & + 3.6841e-01_r8, 2.3079e-01_r8, 1.3201e-01_r8, 7.5752e-02_r8, 4.5007e-02_r8/) + corrnormpara(15,:) = (/ & + 2.0245e+00_r8, 1.5178e+00_r8, 1.1409e+00_r8, 8.6451e-01_r8, 6.2741e-01_r8, & + 4.4552e-01_r8, 2.9960e-01_r8, 1.9064e-01_r8, 1.2103e-01_r8, 7.7739e-02_r8/) + corrnormpara(16,:) = (/ & + 2.2205e+00_r8, 1.6645e+00_r8, 1.2499e+00_r8, 9.4698e-01_r8, 7.0103e-01_r8, & + 5.1247e-01_r8, 3.5917e-01_r8, 2.4008e-01_r8, 1.5973e-01_r8, 1.0640e-01_r8/) + corrnormpara(17,:) = (/ & + 2.4095e+00_r8, 1.8035e+00_r8, 1.3532e+00_r8, 1.0211e+00_r8, 7.6117e-01_r8, & + 5.6591e-01_r8, 4.0665e-01_r8, 2.7886e-01_r8, 1.9017e-01_r8, 1.2938e-01_r8/) + corrnormpara(18,:) = (/ & + 2.5945e+00_r8, 1.9315e+00_r8, 1.4449e+00_r8, 1.0869e+00_r8, 8.0855e-01_r8, & + 6.0410e-01_r8, 4.3994e-01_r8, 3.0564e-01_r8, 2.1118e-01_r8, 1.4559e-01_r8/) + corrnormpara(19,:) = (/ & + 2.7711e+00_r8, 2.0436e+00_r8, 1.5179e+00_r8, 1.1386e+00_r8, 8.4343e-01_r8, & + 6.2755e-01_r8, 4.5825e-01_r8, 3.2012e-01_r8, 2.2249e-01_r8, 1.5473e-01_r8/) + corrnormpara(20,:) = (/ & + 2.9222e+00_r8, 2.1322e+00_r8, 1.5680e+00_r8, 1.1720e+00_r8, 8.6482e-01_r8, & + 6.3853e-01_r8, 4.6350e-01_r8, 3.2373e-01_r8, 2.2527e-01_r8, 1.5753e-01_r8/) + corrnormpara(21,:) = (/ & + 3.0229e+00_r8, 2.1936e+00_r8, 1.5980e+00_r8, 1.1857e+00_r8, 8.7186e-01_r8, & + 6.3904e-01_r8, 4.5877e-01_r8, 3.1914e-01_r8, 2.2164e-01_r8, 1.5567e-01_r8/) + corrnormpara(22,:) = (/ & + 3.0587e+00_r8, 2.2270e+00_r8, 1.6153e+00_r8, 1.1860e+00_r8, 8.6554e-01_r8, & + 6.3031e-01_r8, 4.4655e-01_r8, 3.0841e-01_r8, 2.1341e-01_r8, 1.5074e-01_r8/) + corrnormpara(23,:) = (/ & + 3.0304e+00_r8, 2.2330e+00_r8, 1.6267e+00_r8, 1.1810e+00_r8, 8.4969e-01_r8, & + 6.1375e-01_r8, 4.2865e-01_r8, 2.9308e-01_r8, 2.0168e-01_r8, 1.4361e-01_r8/) + corrnormpara(24,:) = (/ & + 2.9488e+00_r8, 2.2160e+00_r8, 1.6360e+00_r8, 1.1770e+00_r8, 8.2992e-01_r8, & + 5.9196e-01_r8, 4.0652e-01_r8, 2.7399e-01_r8, 1.8695e-01_r8, 1.3468e-01_r8/) + corrnormpara(25,:) = (/ & + 2.8341e+00_r8, 2.2280e+00_r8, 1.6729e+00_r8, 1.1866e+00_r8, 8.3395e-01_r8, & + 5.9046e-01_r8, 4.0163e-01_r8, 2.7945e-01_r8, 1.8343e-01_r8, 1.2405e-01_r8/) + corrnormpara(26,:) = (/ & + 2.6932e+00_r8, 2.1887e+00_r8, 1.6860e+00_r8, 1.2020e+00_r8, 8.3694e-01_r8, & + 5.8129e-01_r8, 3.8726e-01_r8, 2.7069e-01_r8, 1.7119e-01_r8, 1.1151e-01_r8/) + corrnormpara(27,:) = (/ & + 2.5405e+00_r8, 2.0861e+00_r8, 1.6620e+00_r8, 1.2163e+00_r8, 8.0881e-01_r8, & + 5.3543e-01_r8, 3.3890e-01_r8, 2.1588e-01_r8, 1.3605e-01_r8, 9.7129e-02_r8/) + corrnormpara(28,:) = (/ & + 2.3765e+00_r8, 2.0097e+00_r8, 1.6517e+00_r8, 1.2423e+00_r8, 8.4083e-01_r8, & + 5.4485e-01_r8, 3.3131e-01_r8, 2.1040e-01_r8, 1.2250e-01_r8, 8.1111e-02_r8/) + corrnormpara(29,:) = (/ & + 2.2055e+00_r8, 1.9224e+00_r8, 1.6294e+00_r8, 1.2636e+00_r8, 8.7801e-01_r8, & + 5.6100e-01_r8, 3.2565e-01_r8, 2.0542e-01_r8, 1.0852e-01_r8, 6.4218e-02_r8/) + corrnormpara(30,:) = (/ & + 2.0096e+00_r8, 1.7961e+00_r8, 1.5707e+00_r8, 1.2597e+00_r8, 8.8893e-01_r8, & + 5.5944e-01_r8, 3.0422e-01_r8, 1.8113e-01_r8, 8.4620e-02_r8, 4.6343e-02_r8/) + corrnormpara(31,:) = (/ & + 1.8388e+00_r8, 1.6814e+00_r8, 1.5111e+00_r8, 1.2497e+00_r8, 8.9772e-01_r8, & + 5.6143e-01_r8, 2.8445e-01_r8, 1.5706e-01_r8, 6.0365e-02_r8, 2.9833e-02_r8/) + corrnormpara(32,:) = (/ & + 1.6396e+00_r8, 1.5305e+00_r8, 1.4078e+00_r8, 1.1951e+00_r8, 8.7151e-01_r8, & + 5.4223e-01_r8, 2.4998e-01_r8, 1.2041e-01_r8, 2.5746e-02_r8, 7.6820e-03_r8/) + corrnormpara(33,:) = (/ & + 1.5550e+00_r8, 1.4667e+00_r8, 1.3663e+00_r8, 1.1810e+00_r8, 8.7444e-01_r8, & + 5.4784e-01_r8, 2.3483e-01_r8, 9.4771e-02_r8, -5.0855e-03_r8, -1.1990e-02_r8/) + corrnormpara(34,:) = (/ & + 1.5314e+00_r8, 1.4440e+00_r8, 1.3477e+00_r8, 1.1757e+00_r8, 8.8300e-01_r8, & + 5.6149e-01_r8, 2.2941e-01_r8, 7.1049e-02_r8, -4.1493e-02_r8, -3.9332e-02_r8/) + corrnormpara(35,:) = (/ & + 1.7270e+00_r8, 1.6064e+00_r8, 1.4824e+00_r8, 1.2918e+00_r8, 9.9076e-01_r8, & + 6.5768e-01_r8, 2.9160e-01_r8, 9.1000e-02_r8, -5.7683e-02_r8, -6.3116e-02_r8/) + corrnormpara(36,:) = (/ & + 2.0397e+00_r8, 1.8621e+00_r8, 1.6875e+00_r8, 1.4588e+00_r8, 1.1422e+00_r8, & + 7.9506e-01_r8, 3.9605e-01_r8, 1.3928e-01_r8, -6.2587e-02_r8, -9.5685e-02_r8/) + corrnormpara(37,:) = (/ & + 2.2668e+00_r8, 2.0382e+00_r8, 1.8186e+00_r8, 1.5593e+00_r8, 1.2376e+00_r8, & + 8.9109e-01_r8, 4.7986e-01_r8, 1.7537e-01_r8, -7.7256e-02_r8, -1.5153e-01_r8/) + corrnormpara(38,:) = (/ & + 2.3460e+00_r8, 2.0887e+00_r8, 1.8443e+00_r8, 1.5690e+00_r8, 1.2543e+00_r8, & + 9.1963e-01_r8, 5.1685e-01_r8, 1.8720e-01_r8, -9.8736e-02_r8, -2.1873e-01_r8/) + corrnormpara(39,:) = (/ & + 2.3330e+00_r8, 2.0637e+00_r8, 1.8110e+00_r8, 1.5281e+00_r8, 1.2244e+00_r8, & + 9.0429e-01_r8, 5.2074e-01_r8, 1.9076e-01_r8, -1.0517e-01_r8, -2.6267e-01_r8/) + corrnormpara(40,:) = (/ & + 2.2348e+00_r8, 1.9681e+00_r8, 1.7201e+00_r8, 1.4351e+00_r8, 1.1484e+00_r8, & + 8.4754e-01_r8, 4.9071e-01_r8, 1.8348e-01_r8, -9.6347e-02_r8, -2.6481e-01_r8/) + corrnormpara(41,:) = (/ & + 2.1025e+00_r8, 1.8445e+00_r8, 1.6021e+00_r8, 1.3071e+00_r8, 1.0438e+00_r8, & + 7.6659e-01_r8, 4.4062e-01_r8, 1.6942e-01_r8, -7.5640e-02_r8, -2.2199e-01_r8/) + corrnormpara(42,:) = (/ & + 1.9475e+00_r8, 1.7005e+00_r8, 1.4648e+00_r8, 1.1508e+00_r8, 9.1109e-01_r8, & + 6.6102e-01_r8, 3.6639e-01_r8, 1.3488e-01_r8, -6.7300e-02_r8, -1.6573e-01_r8/) + corrnormpara(43,:) = (/ & + 1.7615e+00_r8, 1.5319e+00_r8, 1.3075e+00_r8, 9.7985e-01_r8, 7.5181e-01_r8, & + 5.1793e-01_r8, 2.4758e-01_r8, 5.6814e-02_r8, -1.0011e-01_r8, -1.3994e-01_r8/) + corrnormpara(44,:) = (/ & + 1.5496e+00_r8, 1.3439e+00_r8, 1.1379e+00_r8, 8.1610e-01_r8, 5.7226e-01_r8, & + 3.1847e-01_r8, 4.8379e-02_r8, -9.4852e-02_r8, -1.9907e-01_r8, -1.7544e-01_r8/) + corrnormpara(45,:) = (/ & + 1.3282e+00_r8, 1.1519e+00_r8, 9.7038e-01_r8, 6.7744e-01_r8, 3.8117e-01_r8, & + 4.9884e-02_r8, -2.7429e-01_r8, -3.5478e-01_r8, -3.8500e-01_r8, -2.7837e-01_r8/) + corrnormpara(46,:) = (/ & + 1.1036e+00_r8, 9.5974e-01_r8, 8.0834e-01_r8, 5.6022e-01_r8, 1.8634e-01_r8, & + -2.7016e-01_r8, -7.2208e-01_r8, -7.3811e-01_r8, -6.7652e-01_r8, -4.4553e-01_r8/) + corrnormpara(47,:) = (/ & + 8.8569e-01_r8, 7.7516e-01_r8, 6.5602e-01_r8, 4.5814e-01_r8, 2.0128e-02_r8, & + -5.5226e-01_r8, -1.1772e+00_r8, -1.1949e+00_r8, -1.0850e+00_r8, -6.9480e-01_r8/) + corrnormpara(48,:) = (/ & + 6.9026e-01_r8, 6.0924e-01_r8, 5.1984e-01_r8, 3.6822e-01_r8, -7.9705e-02_r8, & + -6.9601e-01_r8, -1.4791e+00_r8, -1.6532e+00_r8, -1.6410e+00_r8, -1.1362e+00_r8/) + corrnormpara(49,:) = (/ & + 5.1458e-01_r8, 4.5782e-01_r8, 3.9370e-01_r8, 2.8169e-01_r8, -1.1179e-01_r8, & + -6.7907e-01_r8, -1.5384e+00_r8, -2.0210e+00_r8, -2.3049e+00_r8, -1.9254e+00_r8/) + corrnormpara(50,:) = (/ & + 3.6681e-01_r8, 3.2819e-01_r8, 2.8391e-01_r8, 2.0345e-01_r8, -1.0147e-01_r8, & + -5.6092e-01_r8, -1.3819e+00_r8, -2.1793e+00_r8, -2.8408e+00_r8, -2.9029e+00_r8/) + corrnormpara(51,:) = (/ & + 2.4572e-01_r8, 2.1994e-01_r8, 1.8976e-01_r8, 1.3317e-01_r8, -8.4483e-02_r8, & + -4.2521e-01_r8, -1.1176e+00_r8, -2.0715e+00_r8, -2.9853e+00_r8, -3.5512e+00_r8/) + corrnormpara(52,:) = (/ & + 1.3765e-01_r8, 1.2118e-01_r8, 1.0134e-01_r8, 6.3601e-02_r8, -8.1307e-02_r8, & + -3.1424e-01_r8, -8.3137e-01_r8, -1.7228e+00_r8, -2.6429e+00_r8, -3.4631e+00_r8/) + corrnormpara(53,:) = (/ & + 3.9753e-02_r8, 2.9513e-02_r8, 1.7194e-02_r8, -6.4057e-03_r8, -9.6451e-02_r8, & + -2.4263e-01_r8, -5.8604e-01_r8, -1.2695e+00_r8, -2.0044e+00_r8, -2.7729e+00_r8/) + corrnormpara(54,:) = (/ & + -4.9228e-02_r8, -6.7635e-02_r8, -8.4465e-02_r8, -1.0228e-01_r8, -1.5492e-01_r8, & + -2.4047e-01_r8, -4.4807e-01_r8, -9.0507e-01_r8, -1.4082e+00_r8, -1.9908e+00_r8/) + corrnormpara(55,:) = (/ & + -1.2942e-01_r8, -1.5302e-01_r8, -1.7275e-01_r8, -1.8669e-01_r8, -2.1598e-01_r8, & + -2.6364e-01_r8, -3.8122e-01_r8, -6.5929e-01_r8, -9.6948e-01_r8, -1.3556e+00_r8/) + corrnormpara(56,:) = (/ & + -1.9101e-01_r8, -2.0825e-01_r8, -2.2230e-01_r8, -2.3063e-01_r8, -2.4588e-01_r8, & + -2.7113e-01_r8, -3.3375e-01_r8, -4.8833e-01_r8, -6.6192e-01_r8, -8.8584e-01_r8/) + corrnormpara(57,:) = (/ & + -2.2531e-01_r8, -2.3179e-01_r8, -2.3703e-01_r8, -2.4020e-01_r8, -2.4747e-01_r8, & + -2.5995e-01_r8, -2.9111e-01_r8, -3.6874e-01_r8, -4.5632e-01_r8, -5.6825e-01_r8/) + corrnormpara(58,:) = (/ & + -2.3044e-01_r8, -2.3034e-01_r8, -2.3035e-01_r8, -2.3068e-01_r8, -2.3375e-01_r8, & + -2.3952e-01_r8, -2.5404e-01_r8, -2.8977e-01_r8, -3.3031e-01_r8, -3.7962e-01_r8/) + corrnormpara(59,:) = (/ & + -2.1246e-01_r8, -2.1209e-01_r8, -2.1172e-01_r8, -2.1162e-01_r8, -2.1269e-01_r8, & + -2.1506e-01_r8, -2.2143e-01_r8, -2.3725e-01_r8, -2.5530e-01_r8, -2.7715e-01_r8/) + corrnormpara(60,:) = (/ & + -1.7345e-01_r8, -1.7352e-01_r8, -1.7358e-01_r8, -1.7338e-01_r8, -1.7352e-01_r8, & + -1.7428e-01_r8, -1.7682e-01_r8, -1.8326e-01_r8, -1.9064e-01_r8, -1.9988e-01_r8/) + corrnormpara(61,:) = (/ & + -1.2718e-01_r8, -1.2718e-01_r8, -1.2722e-01_r8, -1.2698e-01_r8, -1.2675e-01_r8, & + -1.2695e-01_r8, -1.2775e-01_r8, -1.2992e-01_r8, -1.3249e-01_r8, -1.3566e-01_r8/) + corrnormpara(62,:) = (/ & + -8.6627e-02_r8, -8.6640e-02_r8, -8.6627e-02_r8, -8.6447e-02_r8, -8.6173e-02_r8, & + -8.6140e-02_r8, -8.6281e-02_r8, -8.6855e-02_r8, -8.7563e-02_r8, -8.8431e-02_r8/) + + end subroutine heatnirco2_init + + end module mo_heatnirco2 diff --git a/src/chemistry/mozart/mo_inter.F90 b/src/chemistry/mozart/mo_inter.F90 new file mode 100644 index 0000000000..3b95d0de9a --- /dev/null +++ b/src/chemistry/mozart/mo_inter.F90 @@ -0,0 +1,332 @@ + + module mo_inter + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + + integer :: nintervals + integer, allocatable :: xi(:), xcnt(:) + real(r8), allocatable :: xfrac(:,:) + + contains + + subroutine inter2( ng, xg, yg, n, x, y, ierr ) +!----------------------------------------------------------------------------- +! purpose: +! map input data given on single, discrete points onto a set of target +! bins. +! the original input data are given on single, discrete points of an +! arbitrary grid and are being linearly interpolated onto a specified set +! of target bins. in general, this is the case for most of the weighting +! functions (action spectra, molecular cross section, and quantum yield +! data), which have to be matched onto the specified wavelength intervals. +! the average value in each target bin is found by averaging the trapezoi- +! dal area underneath the input data curve (constructed by linearly connec- +! ting the discrete input values). +! some caution should be used near the endpoints of the grids. if the +! input data set does not span the range of the target grid, an error +! message is printed and the execution is stopped, as extrapolation of the +! data is not permitted. +! if the input data does not encompass the target grid, use addpnt to +! expand the input array. +!----------------------------------------------------------------------------- +! parameters: +! ng - integer, number of bins + 1 in the target grid (i) +! xg - real, target grid (e.g., wavelength grid); bin i is defined (i) +! as [xg(i),xg(i+1)] (i = 1..ng-1) +! yg - real, y-data re-gridded onto xg, yg(i) specifies the value for (o) +! bin i (i = 1..ng-1) +! n - integer, number of points in input grid (i) +! x - real, grid on which input data are defined (i) +! y - real, input y-data (i) +!----------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: ng, n + integer, intent(out) :: ierr + real(r8), intent(in) :: x(n) + real(r8), intent(in) :: y(n) + real(r8), intent(in) :: xg(ng) + real(r8), intent(out) :: yg(ng) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: ngintv + integer :: i, k, jstart + real(r8) :: area, xgl, xgu + real(r8) :: darea, slope + real(r8) :: a1, a2, b1, b2 + + ierr = 0 +!----------------------------------------------------------------------------- +! ... test for correct ordering of data, by increasing value of x +!----------------------------------------------------------------------------- + do i = 2,n + if( x(i) <= x(i-1) ) then + ierr = 1 + write(iulog,*) 'inter2: x coord not monotonically increasing' + return + end if + end do + + do i = 2,ng + if( xg(i) <= xg(i-1) ) then + ierr = 2 + write(iulog,*) 'inter2: xg coord not monotonically increasing' + return + end if + end do + +!----------------------------------------------------------------------------- +! ... check for xg-values outside the x-range +!----------------------------------------------------------------------------- + if( x(1) > xg(1) .or. x(n) < xg(ng) ) then + write(iulog,*) 'inter2: data does not span grid' + write(iulog,*) ' use addpnt to expand data and re-run' +! call endrun + end if + +!----------------------------------------------------------------------------- +! ... find the integral of each grid interval and use this to +! calculate the average y value for the interval +! xgl and xgu are the lower and upper limits of the grid interval +!----------------------------------------------------------------------------- + jstart = 1 + ngintv = ng - 1 + do i = 1,ngintv +!----------------------------------------------------------------------------- +! ... initalize: +!----------------------------------------------------------------------------- + area = 0._r8 + xgl = xg(i) + xgu = xg(i+1) +!----------------------------------------------------------------------------- +! ... discard data before the first grid interval and after the +! last grid interval +! for internal grid intervals, start calculating area by interpolating +! between the last point which lies in the previous interval and the +! first point inside the current interval +!----------------------------------------------------------------------------- + k = jstart + if( k <= n-1 ) then +!----------------------------------------------------------------------------- +! ... if both points are before the first grid, go to the next point +!----------------------------------------------------------------------------- + do + if( x(k+1) <= xgl ) then + jstart = k - 1 + k = k+1 + if( k <= n-1 ) then + cycle + else + exit + end if + else + exit + end if + end do +!----------------------------------------------------------------------------- +! ... if the last point is beyond the end of the grid, +! complete and go to the next grid +!----------------------------------------------------------------------------- + do + if( k <= n-1 .and. x(k) < xgu ) then + jstart = k-1 +!----------------------------------------------------------------------------- +! ... compute x-coordinates of increment +!----------------------------------------------------------------------------- + a1 = max( x(k),xgl ) + a2 = min( x(k+1),xgu ) +!----------------------------------------------------------------------------- +! ... if points coincide, contribution is zero +!----------------------------------------------------------------------------- + if( x(k+1) == x(k) ) then + darea = 0._r8 + else + slope = (y(k+1) - y(k))/(x(k+1) - x(k)) + b1 = y(k) + slope*(a1 - x(k)) + b2 = y(k) + slope*(a2 - x(k)) + darea = .5_r8*(a2 - a1)*(b2 + b1) + end if +!----------------------------------------------------------------------------- +! ... find the area under the trapezoid from a1 to a2 +!----------------------------------------------------------------------------- + area = area + darea + k = k+1 + cycle + else + exit + end if + end do + end if +!----------------------------------------------------------------------------- +! ... calculate the average y after summing the areas in the interval +!----------------------------------------------------------------------------- + yg(i) = area/(xgu - xgl) + end do + + end subroutine inter2 + + subroutine inter_inti( ng, xg, n, x ) +!----------------------------------------------------------------------------- +! ... initialization +!----------------------------------------------------------------------------- + + use cam_abortutils, only : endrun + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: ng, n + real(r8), intent(in) :: xg(ng) + real(r8), intent(in) :: x(n) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, ii, iil, astat + integer :: ndim(1) +#ifdef DEBUG + write(iulog,*) 'inter3: diagnostics; ng,n = ',ng,n + write(iulog,'('' xg '' )') + write(iulog,'(1p,5e21.13)') xg(:ng) + write(iulog,'('' x '' )') + write(iulog,'(1p,5e21.13)') x(:n) +#endif + allocate( xi(ng), xcnt(ng-1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'inter_inti: failed to allocate wrk arrays; error = ',astat + call endrun + else + xi(:) = 0 + xcnt(:) = 0 + end if + iil = 1 + do i = 1,ng + do ii = iil,n-1 + if( xg(i) < x(ii) ) then + xi(i) = ii - 1 + iil = ii + exit + end if + end do + end do + nintervals = count( xi(:) /= 0 ) + if( nintervals == 0 ) then + write(iulog,*) 'inter_inti: wavelength grids do not overlap' + call endrun + else + nintervals = nintervals - 1 + end if + xcnt(1:nintervals) = xi(2:nintervals+1) - xi(1:nintervals) + 1 + ndim(:) = maxval( xcnt(1:nintervals) ) + allocate( xfrac(ndim(1),nintervals),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'inter_inti: failed to allocate wrk array; error = ',astat + call endrun + else + xfrac(:,:) = 1._r8 + end if + do i = 1,nintervals + iil = xi(i) + xfrac(1,i) = (min( x(iil+1),xg(i+1) ) - xg(i))/(x(iil+1) - x(iil)) + if( xcnt(i) > 1 ) then + iil = xi(i) + xcnt(i) - 1 + xfrac(xcnt(i),i) = (xg(i+1) - x(iil))/(x(iil+1) - x(iil)) + end if + end do + write(iulog,*) 'inter_inti: diagnostics; ng,n,nintervals = ',ng,n,nintervals + write(iulog,'('' xi'')') + write(iulog,'(10i4)') xi(1:nintervals+1) + write(iulog,'('' xcnt'')') + write(iulog,'(10i4)') xcnt(1:nintervals) + write(iulog,'('' xfrac'')') + do i = 1,nintervals + write(iulog,'(1p,5e21.13)') xfrac(1:xcnt(i),i) + end do + + end subroutine inter_inti + + subroutine inter3( ng, xg, yg, n, x, y ) +!----------------------------------------------------------------------------- +! purpose: +! map input data given on a set of bins onto a different set of target +! bins. +! the input data are given on a set of bins (representing the integral +! of the input quantity over the range of each bin) and are being matched +! onto another set of bins (target grid). a typical example would be an +! input data set spcifying the extra-terrestrial flux on wavelength inter- +! vals, that has to be matched onto the working wavelength grid. +! the resulting area in a given bin of the target grid is calculated by +! simply adding all fractional areas of the input data that cover that +! particular target bin. +! some caution should be used near the endpoints of the grids. if the +! input data do not span the full range of the target grid, the area in +! the "missing" bins will be assumed to be zero. if the input data extend +! beyond the upper limit of the target grid, the user has the option to +! integrate the "overhang" data and fold the remaining area back into the +! last target bin. using this option is recommended when re-gridding +! vertical profiles that directly affect the total optical depth of the +! model atmosphere. +!----------------------------------------------------------------------------- +! parameters: +! ng - integer, number of bins + 1 in the target grid (i) +! xg - real, target grid (e.g. working wavelength grid); bin i (i) +! is defined as [xg(i),xg(i+1)] (i = 1..ng-1) +! yg - real, y-data re-gridded onto xg; yg(i) specifies the (o) +! y-value for bin i (i = 1..ng-1) +! n - integer, number of bins + 1 in the input grid (i) +! x - real, input grid (e.g. data wavelength grid); bin i is (i) +! defined as [x(i),x(i+1)] (i = 1..n-1) +! y - real, input y-data on grid x; y(i) specifies the (i) +! y-value for bin i (i = 1..n-1) +!----------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: n, ng + real(r8), intent(in) :: xg(ng) + real(r8), intent(in) :: x(n) + real(r8), intent(in) :: y(n) + real(r8), intent(out) :: yg(ng) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, ii, iil + +!----------------------------------------------------------------------------- +! ... do interpolation +!----------------------------------------------------------------------------- + yg(:) = 0._r8 + do i = 1,nintervals + iil = xi(i) + ii = xcnt(i) + if( ii == 1 ) then + yg(i) = xfrac(1,i)*y(iil) + else + yg(i) = dot_product( xfrac(1:ii,i),y(iil:iil+ii-1) ) + end if + end do +#ifdef DEBUG + write(iulog,'('' y '')') + write(iulog,'(1p,5e21.13)') y + write(iulog,'('' yg '')') + write(iulog,'(1p,5e21.13)') yg(1:nintervals) +#endif + + end subroutine inter3 + + end module mo_inter diff --git a/src/chemistry/mozart/mo_jeuv.F90 b/src/chemistry/mozart/mo_jeuv.F90 new file mode 100644 index 0000000000..c13255250e --- /dev/null +++ b/src/chemistry/mozart/mo_jeuv.F90 @@ -0,0 +1,662 @@ + module mo_jeuv + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use euvac, only : euvac_etf + use solar_euv_data, only : solar_euv_data_etf, solar_euv_data_active + use spmd_utils, only : masterproc, masterprocid, mpicom, mpi_real8 + + implicit none + + private + public :: jeuv_init, jeuv, heuv, neuv + public :: nIonRates + + save + +!------------------------------------------------------------------------------ +! define EUV photolysis cross sections, branching ratios, +! wavelength parameters,etc +!------------------------------------------------------------------------------ + integer, parameter :: neuv = 26 ! number of photolysis/ionization reactions + integer, parameter :: nIonRates = 11 ! number of photo-ionizations rates needed for waccmx + integer, parameter :: nmaj = 3 ! number of major neutral species (O,O2,N2) + integer, parameter :: nspecies = 5 ! number of neutral species(O,N,O2,N2,CO2) + integer, parameter :: nstat = 6 ! maximum number of ionization/dissociation + ! /excitation states for each speies + integer, parameter :: lmax = 23 ! number of wavelength bins in EUV + + real(r8), parameter :: heat_eff_fac = .08_r8 ! heating efficiency factor + ! Solar EUV direct heating was increased from 5% to 8% to bring it closer to the + ! TIE-GCM value (5% applied twice for a total of 10%) -- Hanli Liu & Stan Solomon + + real(r8), parameter :: hc = 6.62608e-34_r8 * 2.9979e8_r8 / 1.e-9_r8 + + real(r8) :: sigabs(lmax,nspecies) ! absorption cross sections of major species + real(r8) :: branch_p(lmax,nstat,nmaj) = 0._r8 ! branching ratios for photoionization/dissociation + real(r8) :: branch_e(lmax,nstat,nmaj) = 0._r8 ! branching ratios for photoelectron ionization/dissociation/excitation + real(r8) :: energy(lmax) ! solar energy + + real(r8), pointer :: solar_etf(:) + logical :: do_heating(13) + + contains + + subroutine jeuv_init (photon_file, electron_file, indexer) +!============================================================================== +! Purpose: +! read tabulated data: +! (1) thermosphere neutral species' absorption cross sections, +! photoionization/dissociation branching ratios +! (2) read photoelectron enhancement factor, photoelectron ionization/ +! dissociation/excitation branching ratios +! (3) read solar flux +!============================================================================== + + use units, only : getunit, freeunit + use ioFileMod, only : getfil + use mo_chem_utls, only : get_rxt_ndx + + implicit none + + character(len=*), intent(in) :: photon_file + character(len=*), intent(in) :: electron_file + integer, optional,intent(inout) :: indexer(:) + +!------------------------------------------------------------------------------ +! local variables +!------------------------------------------------------------------------------ + integer :: i, j, m ! loop indicies + integer :: unit ! fortran i/o unit number + integer :: istat ! file op status + real(r8) :: waves(lmax) ! wavelength array for short bound of bins (A) + real(r8) :: wavel(lmax) ! wavelength array for long bound of bins (A) + real(r8) :: wc(lmax) ! wavelength bin center (nm) + character(len=200) :: str,fmt ! string for comments in data file + character(len=256) :: locfn + + integer :: jeuv_1_ndx, ierr, jndx + character(len=2) :: mstring + character(len=7) :: jstring + logical :: do_jeuv + + do_jeuv=.false. + do_heating=.false. + + do m = 1,neuv + write ( mstring, '(I2)' ) m + jstring = 'jeuv_'//trim(adjustl(mstring)) + jndx = get_rxt_ndx( jstring ) + if (jndx>0) then + do_jeuv=.true. + indexer(m) = jndx + endif + if (jndx>0 .and. m<14) then + do_heating(m) = .true. + endif + enddo + + if (.not.do_jeuv) return + + if (solar_euv_data_active) then + solar_etf => solar_euv_data_etf + else + solar_etf => euvac_etf + endif + + if ( size(solar_etf) /= lmax ) then + write(iulog,*) 'jeuv_init: the size of solar_etf is incorrect ' + write(iulog,*) ' ... size(solar_etf) = ',size(solar_etf) + write(iulog,*) ' .............. lmax = ',lmax + call endrun('jeuv_init: the size of solar_etf is incorrect ') + endif + +!------------------------------------------------------------------------------ +! read from data file the absorption cross sections for neutral species, +! braching ratios for photoionization/dissociation, and braching ratios +! for photoelectron ionization/dissociation/excitation +!------------------------------------------------------------------------------ + master: if (masterproc) then ! read in ascii data only on master task then b-cast + !------------------------------------------------------------------------------ + ! read neutral species' absorption cross section and + ! photoionization/dissociation branching ratio + !------------------------------------------------------------------------------ + unit = getunit() + call getfil( photon_file, locfn, 0 ) + open( unit, file = trim(locfn), status='UNKNOWN', iostat=istat ) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to open ',trim(locfn),'; error = ',istat + call endrun + end if + !------------------------------------------------------------------------------ + ! read O + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt = "(f7.2,2x,f7.2,2x,f9.3,4(2x,f7.3))" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), sigabs(i,1), (branch_p(i,j,1),j=1,4) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + !------------------------------------------------------------------------------ + ! read O2 + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt = "(f7.2,2x,f7.2,2x,f9.3,5(2x,f7.3))" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), sigabs(i,2), (branch_p(i,j,2),j=1,5) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + !------------------------------------------------------------------------------ + ! read N2 + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), sigabs(i,3), (branch_p(i,j,3),j=1,5) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + !------------------------------------------------------------------------------ + ! read N + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt = "(f7.2,2x,f7.2,2x,f9.3)" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), sigabs(i,4) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + + !------------------------------------------------------------------------------ + ! read CO2 + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt = "(f7.2,2x,f7.2,2x,f9.3)" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), sigabs(i,5) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read CO2 data ',trim(locfn),'; error = ',istat + call endrun + end if + end do + + close( unit ) + + !------------------------------------------------------------------------------ + ! unit transfer for absorption cross sections + ! from Megabarns to cm^2 + !------------------------------------------------------------------------------ + sigabs(:,:) = sigabs(:,:)*1.e-18_r8 + + !------------------------------------------------------------------------------ + ! read photoelectron ionization/dissociation/excitation branching ratio + !------------------------------------------------------------------------------ + call getfil( electron_file, locfn, 0 ) + open( unit, file = trim(locfn), status='UNKNOWN', iostat=istat ) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to open ',trim(locfn),'; error = ',istat + call endrun + end if + !------------------------------------------------------------------------------ + ! read O + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt="(f7.2,2x,f7.2,5(2x,f8.3))" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), (branch_e(i,j,1),j=1,5) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + !------------------------------------------------------------------------------ + ! read O2 + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + fmt = "(f7.2,2x,f7.2,6(2x,f8.3))" + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), (branch_e(i,j,2),j=1,6) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + !------------------------------------------------------------------------------ + ! read N2 + !------------------------------------------------------------------------------ + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + read(unit,*,iostat=istat) str + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + do i = 1,lmax + read(unit,fmt,iostat=istat) waves(i), wavel(i), (branch_e(i,j,3),j=1,6) + if( istat /= 0 ) then + write(iulog,*) 'jeuv_init: failed to read ',trim(locfn),'; error = ',istat + call endrun + end if + end do + + close( unit ) + + call freeunit( unit ) + end if master + + call mpi_bcast(sigabs, lmax*nspecies, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(branch_p, lmax*nstat*nmaj, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(branch_e, lmax*nstat*nmaj, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(waves, lmax, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(wavel, lmax, mpi_real8, masterprocid, mpicom, ierr) + + wc(:) = .1_r8*(waves(:) + wavel(:))*0.5_r8 ! A to nm + energy(:) = heat_eff_fac*hc/wc(:) + + end subroutine jeuv_init + + subroutine jeuv( nlev, zen, occ, o2cc, n2cc, & + zkm, euv_prates) +!============================================================================== +! Purpose: +! Calculate euv photolysis/ionization rates (in s-1) +!============================================================================== +! Arguments: +! nlev: number of model vertical levels +! zen: solar zenith angle in degree +! occ: atmoic oxygen number density (#/cm3) +! o2cc: molecular oxygen number density (#/cm3) +! n2cc: molecular nitrogen number density (#/cm3) +! zkm: altitude of model levels in KM +! euv_prates: array for EUV photolysis/ionization rates +!============================================================================== +! Approach: +! call sphers +! input: zenith angle +! output: dsdh and nid used in slant column routine +! call slant_col +! input: dsdh and nid, etc +! output: slant column density +! calculate photon production rates and photoelectron production rates +!============================================================================== +! Photolysis/ionization considered in EUV calculation +! +! O + hv --> O+ (4S) + e* ! J1 +! O + hv --> O+ (2D) + e* ! J2 +! O + hv --> O+ (2P) + e* ! J3 +! N (4S) + hv --> N+ + e* ! J4 +! O2 + hv --> O2+ + e* ! J5 +! N2 + hv --> N2+ + e* ! J6 +! O2 + hv --> O + O+(4S) + e* ! J7 +! O2 + hv --> O + O+(2D) + e* ! J8 +! O2 + hv --> O + O+(2P) + e* ! J9 +! N2 + hv --> N (4S) + N+ + e* ! J10 +! N2 + hv --> N (2D) + N+ + e* ! J11 +! O2 + hv --> O (3P) + O (3P) ! J12 +! N2 + hv --> N (4S) + N (2D) ! J13 +! +! O + e* --> O+ (4S) + e* + e ! J14 +! O + e* --> O+ (2D) + e*+ e ! J15 +! O + e* --> O+ (2P) + e*+ e ! J16 +! O2 + e* --> O2+ + e*+ e ! J17 +! N2 + e*--> N2+ + e*+ e ! J18 +! O2 + e* --> O + O+(4S) + e*+ e ! J19 +! O2 + e*--> O + O+(2D) + e*+ e ! J20 +! O2 + e* --> O + O+(2P) + e*+ e ! J21 +! N2 + e* --> N (4S) + N+ + e*+ e ! J22 +! N2 + e* --> N (2D) + N+ + e*+ e ! J23 +! O2 + e* --> O (3P) + O (3P) + e* ! J24 +! N2 + e* --> N (4S) + N (2D) + e* ! J25 +!============================================================================== + + use mo_jshort, only : sphers, slant_col + + implicit none + +!------------------------------------------------------------------------------ +! dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev ! model vertical levels + real(r8), intent(in) :: zen ! Zenith angle in degree + real(r8), intent(in) :: occ(nlev) ! atmic oxygen number density (#/cm3) + real(r8), intent(in) :: o2cc(nlev) ! Molecular oxygen number density (#/cm3) + real(r8), intent(in) :: n2cc(nlev) ! molecular nitrogen number density(#/cm3) + real(r8), intent(in) :: zkm(nlev) ! Altitude, km,from top to bottom + real(r8), intent(out) :: euv_prates(:,:) ! EUV photolysis/ionization rates (s-1) + +!------------------------------------------------------------------------------ +! local variables +!------------------------------------------------------------------------------ + real(r8), parameter :: km2cm = 1.e5_r8 + integer :: l, k, m, n ! loop indecies + real(r8) :: tau(lmax) ! wavelength dependant optical depth + real(r8) :: delz(nlev) ! layer thickness (cm) + real(r8) :: scol(nlev,nmaj) ! major species' (O,O2,N2) Slant Column Density + real(r8) :: nflux(nlev,lmax) + real(r8) :: wrk(nmaj) ! temporary array for photoabsorption rate + real(r8) :: absorp(nlev,lmax) ! temporary array for photoabsorption rate + real(r8) :: ioniz(nlev,lmax) ! temporary array for photoionization rate + real(r8) :: dsdh(0:nlev,nlev) ! Slant path of direct beam through each layer + ! crossed when travelling from the top of the atmosphere + ! to layer i; dsdh(i,j), i = 0..NZ-1, j = 1..NZ-1 + integer :: nid(0:nlev) ! Number of layers crossed by the direct + ! beam when travelling from the top of the + ! atmosphere to layer i; NID(i), i = 0..NZ-1 + real(r8) :: p_photon(nlev,nstat,nspecies) ! photoionization/dissociation rates(s-1) (O,O2,N2,N) + real(r8) :: p_electron(nlev,nstat,nmaj) ! photoelectron ionization/dissociation rates(s-1) (O,O2,N2) + + real(r8) :: prates(nlev,neuv) +!------------------------------------------------------------------------------ +! zero arrays +!------------------------------------------------------------------------------ + p_photon(:,:,:) = 0._r8 + p_electron(:,:,:) = 0._r8 + + call sphers( nlev, zkm, zen, dsdh, nid ) + delz(1:nlev-1) = km2cm*(zkm(1:nlev-1) - zkm(2:nlev)) + call slant_col( nlev, delz, dsdh, nid, occ, scol ) + call slant_col( nlev, delz, dsdh, nid, o2cc, scol(1,2) ) + call slant_col( nlev, delz, dsdh, nid, n2cc, scol(1,3) ) + +!------------------------------------------------------------------------------ +! The calculation is in the order from model bottom to model top +! because scol array is in this order. +!------------------------------------------------------------------------------ + do k = 1,nlev + wrk(:) = scol(k,:) + tau(:) = matmul( sigabs(:,:nmaj),wrk ) + where( tau(:) < 20._r8 ) + nflux(k,:) = solar_etf(:) * exp( -tau(:) ) + elsewhere + nflux(k,:) = 0._r8 + endwhere + end do + +!------------------------------------------------------------------------------ +! remember occ,o2cc and n2cc is from top to bottom +!------------------------------------------------------------------------------ + do m = 1,nspecies + do l = 1,lmax + absorp(:,l) = sigabs(l,m) * nflux(:,l) + end do + if( m <= nmaj ) then + do l = 1,lmax + ioniz(:,l) = absorp(:,l) * branch_p(l,1,m) + end do + do n = 1,nstat + p_photon(:,n,m) = matmul( absorp,branch_p(:,n,m) ) + p_electron(:,n,m) = matmul( ioniz,branch_e(:,n,m) ) + end do + else + p_photon(:,1,m) = matmul( nflux,sigabs(:,m) ) + end if + end do + +!------------------------------------------------------------------------------ +! set photolysis/ionization rate for each reaction +!------------------------------------------------------------------------------ + prates(:,1) = p_photon(:,2,1) + prates(:,2) = p_photon(:,3,1) + prates(:,3) = p_photon(:,4,1) + prates(:,4) = p_photon(:,1,4) + prates(:,5) = p_photon(:,2,2) + p_photon(:,3,2) + prates(:,6) = p_photon(:,2,3) + p_photon(:,3,3) + prates(:,7) = .54_r8*p_photon(:,4,2) + prates(:,8) = .24_r8*p_photon(:,4,2) + prates(:,9) = .22_r8*p_photon(:,4,2) + prates(:,10) = .2_r8*p_photon(:,4,3) + prates(:,11) = .8_r8*p_photon(:,4,3) + prates(:,12) = p_photon(:,5,2) + prates(:,13) = p_photon(:,5,3) + prates(:,14) = p_electron(:,2,1) + prates(:,15) = p_electron(:,3,1) + prates(:,16) = p_electron(:,4,1) + prates(:,17) = p_electron(:,2,2) + p_electron(:,3,2) + prates(:,18) = p_electron(:,2,3) + p_electron(:,3,3) + prates(:,19) = .54_r8*p_electron(:,4,2) + prates(:,20) = .24_r8*p_electron(:,4,2) + prates(:,21) = .22_r8*p_electron(:,4,2) + prates(:,22) = .2_r8*p_electron(:,4,3) + prates(:,23) = .8_r8*p_electron(:,4,3) + prates(:,24) = p_electron(:,5,2) + prates(:,25) = p_electron(:,5,3) + prates(:,26) = p_photon(:,1,5) + + do m = 1,neuv + euv_prates(:,m) = prates(nlev:1:-1,m) + enddo + + end subroutine jeuv + + subroutine heuv( nlev, zen, occ, o2cc, n2cc, & + o_vmr, o2_vmr, n2_vmr, cparg, mw, & + zkm, euv_hrates, kbot ) +!============================================================================== +! Purpose: +! Calculate euv photolysis heating rates +!============================================================================== +! Arguments: +! nlev: number of model vertical levels +! zen: solar zenith angle in degree +! occ: atmoic oxygen number density (#/cm3) +! o2cc: molecular oxygen number density (#/cm3) +! n2cc: molecular nitrogen number density (#/cm3) +! zkm: altitude of model levels in KM +! euv_prates: array for EUV photolysis/ionization rates +!============================================================================== +! Approach: +! call sphers +! input: zenith angle +! output: dsdh and nid used in slant column routine +! call slant_col +! input: dsdh and nid, etc +! output: slant column density +! calculate photon production rates and photoelectron production rates +!============================================================================== +! Photolysis/ionization considered in EUV heating rate calculation +! O + hv --> O+ (4S) + e* ! J1 +! O + hv --> O+ (2D) + e* ! J2 +! O + hv --> O+ (2P) + e* ! J3 +! N (4S) + hv --> N+ + e* ! J4 +! O2 + hv --> O2+ + e* ! J5 +! N2 + hv --> N2+ + e* ! J6 +! O2 + hv --> O + O+(4S) + e* ! J7 +! O2 + hv --> O + O+(2D) + e* ! J8 +! O2 + hv --> O + O+(2P) + e* ! J9 +! N2 + hv --> N (4S) + N+ + e* ! J10 +! N2 + hv --> N (2D) + N+ + e* ! J11 +! O2 + hv --> O (3P) + O (3P) ! J12 +! N2 + hv --> N (4S) + N (2D) ! J13 +!============================================================================== + + use mo_jshort, only : sphers, slant_col + use physconst, only : avogad + + implicit none + +!------------------------------------------------------------------------------ +! dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev ! model vertical levels + integer, intent(in) :: kbot ! heating vertical levels + real(r8), intent(in) :: zen ! zenith angle (degrees) + real(r8), intent(in) :: occ(nlev) ! atomic oxygen number density (molecules/cm^3) + real(r8), intent(in) :: o2cc(nlev) ! molecular oxygen concentration (molecules/cm^3) + real(r8), intent(in) :: n2cc(nlev) ! molecular nitrogen concentration (molecules/cm^3) + real(r8), intent(in) :: o_vmr(nlev) ! atomic oxygen concentration (mol/mol) + real(r8), intent(in) :: o2_vmr(nlev) ! molecular oxygen concentration (mol/mol) + real(r8), intent(in) :: n2_vmr(nlev) ! molecular nitrogen concentration (mol/mol) + real(r8), intent(in) :: zkm(nlev) ! midpoint geopotential (km) + real(r8), intent(in) :: cparg(nlev) ! specific heat capacity + real(r8), intent(in) :: mw(nlev) ! atm mean mass + real(r8), intent(out) :: euv_hrates(:) ! euv heating rates + +!------------------------------------------------------------------------------ +! local variables +!------------------------------------------------------------------------------ + real(r8), parameter :: km2cm = 1.e5_r8 + integer :: l, k, k1, m, n ! indicies + real(r8) :: tau(lmax) ! wavelength dependant optical depth + real(r8) :: delz(nlev) ! layer thickness (cm) + real(r8) :: hfactor(kbot) + real(r8) :: scol(nlev,nmaj) ! major species' (O,O2,N2) Slant Column Density + real(r8) :: nflux(kbot,lmax) + real(r8) :: prates(kbot,13) ! working photorates array + real(r8) :: wrk(nmaj) ! temporary array for photoabsorption rate + real(r8) :: absorp(kbot,lmax) ! temporary array for photoabsorption rate + real(r8) :: dsdh(0:nlev,nlev) ! Slant path of direct beam through each layer + ! crossed when travelling from the top of the atmosphere + ! to layer i; dsdh(i,j), i = 0..NZ-1, j = 1..NZ-1 + integer :: nid(0:nlev) ! Number of layers crossed by the direct + ! beam when travelling from the top of the + ! atmosphere to layer i; NID(i), i = 0..NZ-1 + real(r8) :: p_photon(kbot,nstat,nspecies) ! photoionization/dissociation rates(s-1) (O,O2,N2,N) + +!------------------------------------------------------------------------------ +! zero arrays +!------------------------------------------------------------------------------ + p_photon(:,:,:) = 0._r8 + + call sphers( nlev, zkm, zen, dsdh, nid ) + delz(1:nlev-1) = km2cm*(zkm(1:nlev-1) - zkm(2:nlev)) + call slant_col( nlev, delz, dsdh, nid, occ, scol ) + call slant_col( nlev, delz, dsdh, nid, o2cc, scol(1,2) ) + call slant_col( nlev, delz, dsdh, nid, n2cc, scol(1,3) ) + +!------------------------------------------------------------------------------ +! The calculation is in the order from model bottom to model top +! because scol array is in this order. +!------------------------------------------------------------------------------ + do k = 1,kbot + k1 = nlev - kbot + k + wrk(:) = scol(k1,:) + tau(:) = matmul( sigabs(:,:nmaj),wrk ) + where( tau(:) < 20._r8 ) + nflux(k,:) = energy(:) * solar_etf(:) * exp( -tau(:) ) + elsewhere + nflux(k,:) = 0._r8 + endwhere + end do + +!------------------------------------------------------------------------------ +! remember occ,o2cc and n2cc is from top to bottom +!------------------------------------------------------------------------------ + do m = 1,nspecies + do l = 1,lmax + absorp(:,l) = sigabs(l,m) * nflux(:,l) + end do + if( m <= nmaj ) then + do n = 1,nstat + p_photon(:,n,m) = matmul( absorp,branch_p(:,n,m) ) + end do + else + p_photon(:,1,m) = matmul( nflux,sigabs(:,m) ) + end if + end do + +!------------------------------------------------------------------------------ +! use photolysis rates to compute heating rates +! only EUV photolysis reactions in the mechanism contribute to heating +!------------------------------------------------------------------------------ + prates = 0._r8 + + if (do_heating(1)) prates(:,1) = p_photon(:,2,1) + if (do_heating(2)) prates(:,2) = p_photon(:,3,1) + if (do_heating(3)) prates(:,3) = p_photon(:,4,1) + + if (do_heating(5)) prates(:,5) = p_photon(:,2,2) + p_photon(:,3,2) + if (do_heating(6)) prates(:,6) = p_photon(:,2,3) + p_photon(:,3,3) + if (do_heating(7)) prates(:,7) = .54_r8*p_photon(:,4,2) + if (do_heating(8)) prates(:,8) = .24_r8*p_photon(:,4,2) + if (do_heating(9)) prates(:,9) = .22_r8*p_photon(:,4,2) + if (do_heating(10)) prates(:,10) = .2_r8*p_photon(:,4,3) + if (do_heating(11)) prates(:,11) = .8_r8*p_photon(:,4,3) + if (do_heating(12)) prates(:,12) = p_photon(:,5,2) + if (do_heating(13)) prates(:,13) = p_photon(:,5,3) + hfactor(:) = avogad/(cparg(:kbot)*mw(:kbot)) + euv_hrates(kbot+1:nlev) = 0._r8 + euv_hrates(:kbot) = ((prates(kbot:1:-1,1) + prates(kbot:1:-1,2) + prates(kbot:1:-1,3))*o_vmr(:kbot) & + + (prates(kbot:1:-1,5) + prates(kbot:1:-1,7) + prates(kbot:1:-1,8) & + + prates(kbot:1:-1,9) + prates(kbot:1:-1,12))*o2_vmr(:kbot) & + + (prates(kbot:1:-1,6) + prates(kbot:1:-1,10) & + + prates(kbot:1:-1,11) + prates(kbot:1:-1,13))*n2_vmr(:kbot))*hfactor(:) + + end subroutine heuv + + end module mo_jeuv diff --git a/src/chemistry/mozart/mo_jlong.F90 b/src/chemistry/mozart/mo_jlong.F90 new file mode 100644 index 0000000000..dcc5bf77ae --- /dev/null +++ b/src/chemistry/mozart/mo_jlong.F90 @@ -0,0 +1,961 @@ +#ifdef AIX +#define USE_ESSL +#endif +#define USE_BDE + + module mo_jlong + + use shr_kind_mod, only : r4 => shr_kind_r4 + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use cam_abortutils, only : endrun +#ifdef SPMD + use mpishorthand, only : mpicom,mpiint,mpir8, mpilog, mpir4 +#endif + use spmd_utils, only : masterproc + + implicit none + + interface jlong + module procedure jlong_photo + module procedure jlong_hrates + end interface + + private + public :: jlong_init + public :: jlong_timestep_init + public :: jlong + public :: numj + + save + + real(r8), parameter :: hc = 6.62608e-34_r8 * 2.9979e8_r8 / 1.e-9_r8 + real(r8), parameter :: wc_o2_b = 242.37_r8 ! (nm) + real(r8), parameter :: wc_o3_a = 310.32_r8 ! (nm) + real(r8), parameter :: wc_o3_b = 1179.87_r8 ! (nm) + + integer :: nw ! wavelengths >200nm + integer :: nt ! number of temperatures in xsection table + integer :: np_xs ! number of pressure levels in xsection table + integer :: numj ! number of photorates in xsqy, rsf + integer :: nump ! number of altitudes in rsf + integer :: numsza ! number of zen angles in rsf + integer :: numalb ! number of albedos in rsf + integer :: numcolo3 ! number of o3 columns in rsf + real(r4), allocatable :: xsqy(:,:,:,:) + real(r8), allocatable :: wc(:) + real(r8), allocatable :: we(:) + real(r8), allocatable :: wlintv(:) + real(r8), allocatable :: etfphot(:) + real(r8), allocatable :: bde_o2_b(:) + real(r8), allocatable :: bde_o3_a(:) + real(r8), allocatable :: bde_o3_b(:) + real(r8), allocatable :: xs_o2b(:,:,:) + real(r8), allocatable :: xs_o3a(:,:,:) + real(r8), allocatable :: xs_o3b(:,:,:) + real(r8), allocatable :: p(:) + real(r8), allocatable :: del_p(:) + real(r8), allocatable :: prs(:) + real(r8), allocatable :: dprs(:) + real(r8), allocatable :: sza(:) + real(r8), allocatable :: del_sza(:) + real(r8), allocatable :: alb(:) + real(r8), allocatable :: del_alb(:) + real(r8), allocatable :: o3rat(:) + real(r8), allocatable :: del_o3rat(:) + real(r8), allocatable :: colo3(:) + real(r4), allocatable :: rsf_tab(:,:,:,:,:) + logical :: jlong_used = .false. + + contains + + subroutine jlong_init( xs_long_file, rsf_file, lng_indexer ) + + use ppgrid, only : pver + use mo_util, only : rebin + use solar_irrad_data,only : data_nw => nbins, data_we => we, data_etf => sol_etf + + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent(inout) :: lng_indexer(:) + character(len=*), intent(in) :: xs_long_file, rsf_file + +!------------------------------------------------------------------------------ +! ... read Cross Section * QY NetCDF file +! find temperature index for given altitude +! derive cross*QY results, returns xsqy(nj,nz,nw) +!------------------------------------------------------------------------------ + call get_xsqy( xs_long_file, lng_indexer ) + +!------------------------------------------------------------------------------ +! ... read radiative source function NetCDF file +!------------------------------------------------------------------------------ + if(masterproc) write(iulog,*) 'jlong_init: before get_rsf' + call get_rsf(rsf_file) + if(masterproc) write(iulog,*) 'jlong_init: after get_rsf' + + we(:nw) = wc(:nw) - .5_r8*wlintv(:nw) + we(nw+1) = wc(nw) + .5_r8*wlintv(nw) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------' + endif + call rebin( data_nw, nw, data_we, we, data_etf, etfphot ) + if (masterproc) then + write(iulog,*) 'jlong_init: etfphot after data rebin' + write(iulog,'(1p,5g15.7)') etfphot(:) + write(iulog,*) '--------------------------------------------------' + write(iulog,*) ' ' + endif + + jlong_used = .true. + + end subroutine jlong_init + + subroutine get_xsqy( xs_long_file, lng_indexer ) +!=============================================================================! +! PURPOSE: ! +! Reads a NetCDF file that contains: ! +! cross section * QY temperature dependence, >200nm ! +! ! +!=============================================================================! +! PARAMETERS: ! +! Input: ! +! filepath.... NetCDF filepath that contains the "cross sections" ! +!=============================================================================! +! EDIT HISTORY: ! +! Created by Doug Kinnison, 3/14/2002 ! +!=============================================================================! + + use ioFileMod, only : getfil + use error_messages, only : alloc_err + use chem_mods, only : phtcnt, pht_alias_lst, rxt_tag_lst + use netcdf, only: & + nf90_open, & + nf90_nowrite, & + nf90_inq_dimid, & + nf90_inquire_dimension, & + nf90_inq_varid, & + nf90_noerr, & + nf90_get_var, & + nf90_close + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(inout) :: lng_indexer(:) + character(len=*) :: xs_long_file + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + integer :: varid, dimid, ndx + integer :: ncid + integer :: iret + integer :: i, k, m, n + integer :: wrk_ndx(phtcnt) + character(len=256) :: locfn + + Masterproc_only : if( masterproc ) then + !------------------------------------------------------------------------------ + ! ... open NetCDF File + !------------------------------------------------------------------------------ + call getfil(xs_long_file, locfn, 0) + iret = nf90_open(trim(locfn), NF90_NOWRITE, ncid) + + !------------------------------------------------------------------------------ + ! ... get dimensions + !------------------------------------------------------------------------------ + iret = nf90_inq_dimid( ncid, 'numtemp', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= nt ) + iret = nf90_inq_dimid( ncid, 'numwl', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= nw ) + iret = nf90_inq_dimid( ncid, 'numprs', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= np_xs ) + !------------------------------------------------------------------------------ + ! ... check for cross section in dataset + !------------------------------------------------------------------------------ + do m = 1,phtcnt + if( pht_alias_lst(m,2) == ' ' ) then + iret = nf90_inq_varid( ncid, rxt_tag_lst(m), varid ) + if( iret == nf90_noerr ) then + lng_indexer(m) = varid + end if + else if( pht_alias_lst(m,2) == 'userdefined' ) then + lng_indexer(m) = -1 + else + iret = nf90_inq_varid( ncid, pht_alias_lst(m,2), varid ) + if( iret == nf90_noerr ) then + lng_indexer(m) = varid + else + write(iulog,*) 'get_xsqy : ',rxt_tag_lst(m)(:len_trim(rxt_tag_lst(m))),' alias ', & + pht_alias_lst(m,2)(:len_trim(pht_alias_lst(m,2))),' not in dataset' + call endrun + end if + end if + end do + numj = 0 + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then + cycle + end if + numj = numj + 1 + end if + end do + + !------------------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------------------ + + allocate( xsqy(numj,nw,nt,np_xs),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_xsqy', 'xsqy', numj*nt*np_xs*nw ) + end if + allocate( prs(np_xs),dprs(np_xs-1),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_xsqy', 'prs,dprs', np_xs ) + end if + allocate( xs_o2b(nw,nt,np_xs),xs_o3a(nw,nt,np_xs),xs_o3b(nw,nt,np_xs),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_xsqy', 'xs_o2b ... xs_o3b', np_xs ) + end if + !------------------------------------------------------------------------------ + ! ... read cross sections + !------------------------------------------------------------------------------ + ndx = 0 + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then + cycle + end if + ndx = ndx + 1 + iret = nf90_get_var( ncid, lng_indexer(m), xsqy(ndx,:,:,:) ) + end if + end do + if( ndx /= numj ) then + write(iulog,*) 'get_xsqy : ndx count /= cross section count' + call endrun + end if + iret = nf90_inq_varid( ncid, 'jo2_b', varid ) + iret = nf90_get_var( ncid, varid, xs_o2b ) + iret = nf90_inq_varid( ncid, 'jo3_a', varid ) + iret = nf90_get_var( ncid, varid, xs_o3a ) + iret = nf90_inq_varid( ncid, 'jo3_b', varid ) + iret = nf90_get_var( ncid, varid, xs_o3b ) + !------------------------------------------------------------------------------ + ! ... setup final lng_indexer + !------------------------------------------------------------------------------ + ndx = 0 + wrk_ndx(:) = lng_indexer(:) + do m = 1,phtcnt + if( wrk_ndx(m) > 0 ) then + ndx = ndx + 1 + i = wrk_ndx(m) + where( wrk_ndx(:) == i ) + lng_indexer(:) = ndx + wrk_ndx(:) = -100000 + end where + end if + end do + + iret = nf90_inq_varid( ncid, 'pressure', varid ) + iret = nf90_get_var( ncid, varid, prs ) + iret = nf90_close( ncid ) + end if Masterproc_only + +#ifdef SPMD +! call mpibarrier( mpicom ) + call mpibcast( numj, 1, mpiint, 0, mpicom ) + call mpibcast( nt, 1, mpiint, 0, mpicom ) + call mpibcast( nw, 1, mpiint, 0, mpicom ) + call mpibcast( np_xs, 1, mpiint, 0, mpicom ) + call mpibcast( lng_indexer, phtcnt, mpiint, 0, mpicom ) +#endif + if( .not. masterproc ) then + !------------------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------------------ + allocate( xsqy(numj,nw,nt,np_xs),stat=iret ) + if( iret /= nf90_noerr) then + write(iulog,*) 'get_xsqy : failed to allocate xsqy ; error = ',iret + call endrun + end if + allocate( prs(np_xs),dprs(np_xs-1),stat=iret ) + if( iret /= nf90_noerr) then + write(iulog,*) 'get_xsqy : failed to allocate prs,dprs ; error = ',iret + call endrun + end if + allocate( xs_o2b(nw,nt,np_xs),xs_o3a(nw,nt,np_xs),xs_o3b(nw,nt,np_xs),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_xsqy', 'xs_o2b ... xs_o3b', np_xs ) + end if + end if +#ifdef SPMD +! call mpibarrier( mpicom ) + call mpibcast( prs, np_xs, mpir8, 0, mpicom ) + call mpibcast( xsqy, numj*nt*np_xs*nw, mpir4, 0, mpicom ) + call mpibcast( xs_o2b, nw*nt*np_xs, mpir8, 0, mpicom ) + call mpibcast( xs_o3a, nw*nt*np_xs, mpir8, 0, mpicom ) + call mpibcast( xs_o3b, nw*nt*np_xs, mpir8, 0, mpicom ) +#endif + dprs(:np_xs-1) = 1._r8/(prs(1:np_xs-1) - prs(2:np_xs)) + + end subroutine get_xsqy + + subroutine get_rsf(rsf_file) +!=============================================================================! +! PURPOSE: ! +! Reads a NetCDF file that contains: +! Radiative Souce function ! +!=============================================================================! +! PARAMETERS: ! +! Input: ! +! filepath.... NetCDF file that contains the RSF ! +! ! +! Output: ! +! rsf ........ Radiative Source Function (quanta cm-2 sec-1 ! +! ! +! EDIT HISTORY: ! +! Created by Doug Kinnison, 3/14/2002 ! +!=============================================================================! + + use ioFileMod, only : getfil + use error_messages, only : alloc_err + use netcdf, only: & + nf90_open, & + nf90_nowrite, & + nf90_inq_dimid, & + nf90_inquire_dimension, & + nf90_inq_varid, & + nf90_noerr, & + nf90_get_var, & + nf90_close + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + character(len=*) :: rsf_file + +!------------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------------ + integer :: varid, dimid + integer :: ncid + integer :: i, j, k, l, w + integer :: iret + integer :: count(5) + integer :: start(5) + real(r8) :: wrk + character(len=256) :: locfn + + Masterproc_only : if( masterproc ) then + !------------------------------------------------------------------------------ + ! ... open NetCDF File + !------------------------------------------------------------------------------ + call getfil(rsf_file, locfn, 0) + iret = nf90_open(trim(locfn), NF90_NOWRITE, ncid) + + !------------------------------------------------------------------------------ + ! ... get dimensions + !------------------------------------------------------------------------------ + iret = nf90_inq_dimid( ncid, 'numz', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= nump ) + iret = nf90_inq_dimid( ncid, 'numsza', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= numsza ) + iret = nf90_inq_dimid( ncid, 'numalb', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= numalb ) + iret = nf90_inq_dimid( ncid, 'numcolo3fact', dimid ) + iret = nf90_inquire_dimension( ncid, dimid,len= numcolo3 ) + + end if Masterproc_only +#ifdef SPMD +! call mpibarrier( mpicom ) + call mpibcast( nump, 1, mpiint, 0, mpicom ) + call mpibcast( numsza, 1, mpiint, 0, mpicom ) + call mpibcast( numalb, 1, mpiint, 0, mpicom ) + call mpibcast( numcolo3, 1, mpiint, 0, mpicom ) +#endif +!------------------------------------------------------------------------------ +! ... allocate arrays +!------------------------------------------------------------------------------ + allocate( wc(nw),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'wc', nw ) + end if + allocate( wlintv(nw),we(nw+1),etfphot(nw),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'wlintv,etfphot', nw ) + end if + allocate( bde_o2_b(nw),bde_o3_a(nw),bde_o3_b(nw),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'bde', nw ) + end if + allocate( p(nump),del_p(nump-1),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'p,delp', nump ) + end if + allocate( sza(numsza),del_sza(numsza-1),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'sza,del_sza', numsza ) + end if + allocate( alb(numalb),del_alb(numalb-1),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'alb,del_alb', numalb ) + end if + allocate( o3rat(numcolo3),del_o3rat(numcolo3-1),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'o3rat,del_o3rat', numcolo3 ) + end if + allocate( colo3(nump),stat=iret ) + if( iret /= 0 ) then + call alloc_err( iret, 'get_rsf', 'colo3', nump ) + end if + allocate( rsf_tab(nw,nump,numsza,numcolo3,numalb),stat=iret ) + if( iret /= 0 ) then + write(iulog,*) 'get_rsf : dimensions = ',nw,nump,numsza,numcolo3,numalb + call alloc_err( iret, 'get_rsf', 'rsf_tab', numalb*numcolo3*numsza*nump ) + end if + + Masterproc_only2 : if( masterproc ) then + !------------------------------------------------------------------------------ + ! ... read variables + !------------------------------------------------------------------------------ + iret = nf90_inq_varid( ncid, 'wc', varid ) + iret = nf90_get_var( ncid, varid, wc ) + iret = nf90_inq_varid( ncid, 'wlintv', varid ) + iret = nf90_get_var( ncid, varid, wlintv ) + iret = nf90_inq_varid( ncid, 'pm', varid ) + iret = nf90_get_var( ncid, varid, p ) + iret = nf90_inq_varid( ncid, 'sza', varid ) + iret = nf90_get_var( ncid, varid, sza ) + iret = nf90_inq_varid( ncid, 'alb', varid ) + iret = nf90_get_var( ncid, varid, alb ) + iret = nf90_inq_varid( ncid, 'colo3fact', varid ) + iret = nf90_get_var( ncid, varid, o3rat ) + iret = nf90_inq_varid( ncid, 'colo3', varid ) + iret = nf90_get_var( ncid, varid, colo3 ) + + iret = nf90_inq_varid( ncid, 'RSF', varid ) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) '----------------------------------------------' + write(iulog,*) 'get_rsf: numalb, numcolo3, numsza, nump = ', & + numalb, numcolo3, numsza, nump + write(iulog,*) 'get_rsf: size of rsf_tab = ',size(rsf_tab,dim=1),size(rsf_tab,dim=2), & + size(rsf_tab,dim=3),size(rsf_tab,dim=4),size(rsf_tab,dim=5) + write(iulog,*) '----------------------------------------------' + write(iulog,*) ' ' + endif + + iret = nf90_get_var( ncid, varid, rsf_tab ) + iret = nf90_close( ncid ) + + do w = 1,nw + wrk = wlintv(w) + rsf_tab(w,:,:,:,:) = wrk*rsf_tab(w,:,:,:,:) + enddo + + end if Masterproc_only2 +#ifdef SPMD + call mpibcast( wc, nw, mpir8, 0, mpicom ) + call mpibcast( wlintv, nw, mpir8, 0, mpicom ) + call mpibcast( p, nump, mpir8, 0, mpicom ) + call mpibcast( sza, numsza, mpir8, 0, mpicom ) + call mpibcast( alb, numalb, mpir8, 0, mpicom ) + call mpibcast( o3rat, numcolo3, mpir8, 0, mpicom ) + call mpibcast( colo3, nump, mpir8, 0, mpicom ) + do w = 1,nw + call mpibcast( rsf_tab(w,:,:,:,:), numalb*numcolo3*numsza*nump, mpir4, 0, mpicom ) + enddo +#endif +#ifdef USE_BDE + if (masterproc) write(iulog,*) 'Jlong using bdes' + bde_o2_b(:) = max( 0._r8, hc*(wc_o2_b - wc(:))/(wc_o2_b*wc(:)) ) + bde_o3_a(:) = max( 0._r8, hc*(wc_o3_a - wc(:))/(wc_o3_a*wc(:)) ) + bde_o3_b(:) = max( 0._r8, hc*(wc_o3_b - wc(:))/(wc_o3_b*wc(:)) ) +#else + if (masterproc) write(iulog,*) 'Jlong not using bdes' + bde_o2_b(:) = hc/wc(:) + bde_o3_a(:) = hc/wc(:) + bde_o3_b(:) = hc/wc(:) +#endif + + del_p(:nump-1) = 1._r8/abs(p(1:nump-1)- p(2:nump)) + del_sza(:numsza-1) = 1._r8/(sza(2:numsza) - sza(1:numsza-1)) + del_alb(:numalb-1) = 1._r8/(alb(2:numalb) - alb(1:numalb-1)) + del_o3rat(:numcolo3-1) = 1._r8/(o3rat(2:numcolo3) - o3rat(1:numcolo3-1)) + + end subroutine get_rsf + + subroutine jlong_timestep_init +!--------------------------------------------------------------- +! ... set etfphot if required +!--------------------------------------------------------------- + + use mo_util, only : rebin + + use solar_irrad_data,only : data_nw => nbins, data_we => we, data_etf => sol_etf + + implicit none + + if (.not.jlong_used) return + + call rebin( data_nw, nw, data_we, we, data_etf, etfphot ) + + end subroutine jlong_timestep_init + + subroutine jlong_hrates( nlev, sza_in, alb_in, p_in, t_in, & + mw, o2_vmr, o3_vmr, colo3_in, qrl_col, & + cparg, kbot ) +!============================================================================== +! Purpose: +! To calculate the thermal heating rates longward of 200nm. +!============================================================================== +! Approach: +! 1) Reads the Cross Section*QY NetCDF file +! 2) Given a temperature profile, derives the appropriate XS*QY +! +! 3) Reads the Radiative Source function (RSF) NetCDF file +! Units = quanta cm-2 sec-1 +! +! 4) Indices are supplied to select a RSF that is consistent with +! the reference atmosphere in TUV (for direct comparision of J's). +! This approach will be replaced in the global model. Here colo3, zenith +! angle, and altitude will be inputed and the correct entry in the table +! will be derived. +!============================================================================== + + use physconst, only : avogad + use error_messages, only : alloc_err + + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent (in) :: nlev ! number vertical levels + integer, intent (in) :: kbot ! heating levels + real(r8), intent(in) :: o2_vmr(nlev) ! o2 conc (mol/mol) + real(r8), intent(in) :: o3_vmr(nlev) ! o3 conc (mol/mol) + real(r8), intent(in) :: sza_in ! solar zenith angle (degrees) + real(r8), intent(in) :: alb_in(nlev) ! albedo + real(r8), intent(in) :: p_in(nlev) ! midpoint pressure (hPa) + real(r8), intent(in) :: t_in(nlev) ! Temperature profile (K) + real(r8), intent(in) :: colo3_in(nlev) ! o3 column density (molecules/cm^3) + real(r8), intent(in) :: mw(nlev) ! atms molecular weight + real(r8), intent(in) :: cparg(nlev) ! specific heat capacity + real(r8), intent(inout) :: qrl_col(:,:) ! heating rates + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: astat + integer :: k, km, m + integer :: t_index ! Temperature index + integer :: pndx + real(r8) :: ptarget + real(r8) :: delp + real(r8) :: hfactor + real(r8), allocatable :: rsf(:,:) ! Radiative source function + real(r8), allocatable :: xswk(:,:) ! working xsection array + real(r8), allocatable :: wrk(:) ! work vector + +!---------------------------------------------------------------------- +! ... allocate variables +!---------------------------------------------------------------------- + allocate( rsf(nw,kbot),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jlong_hrates', 'rsf', nw*nlev ) + end if + allocate( xswk(nw,3),wrk(nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jlong_hrates', 'xswk,wrk', 3*nw ) + end if + +!---------------------------------------------------------------------- +! ... interpolate table rsf to model variables +!---------------------------------------------------------------------- + call interpolate_rsf( alb_in, sza_in, p_in, colo3_in, kbot, rsf ) + +!------------------------------------------------------------------------------ +! ... calculate thermal heating rates for wavelengths >200nm +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! LLNL LUT approach to finding temperature index... +! Calculate the temperature index into the cross section +! data which lists coss sections for temperatures from +! 150 to 350 degrees K. Make sure the index is a value +! between 1 and 201. +!------------------------------------------------------------------------------ + qrl_col(kbot+1:nlev,:) = 0._r8 +level_loop_1 : & + do k = 1,kbot +!---------------------------------------------------------------------- +! ... get index into xsqy +!---------------------------------------------------------------------- + t_index = t_in(k) - 148.5_r8 + t_index = min( 201,max( t_index,1) ) +!---------------------------------------------------------------------- +! ... find pressure level +!---------------------------------------------------------------------- + ptarget = p_in(k) + if( ptarget >= prs(1) ) then + xswk(:,1) = xs_o2b(:,t_index,1) + xswk(:,2) = xs_o3a(:,t_index,1) + xswk(:,3) = xs_o3b(:,t_index,1) + else if( ptarget <= prs(np_xs) ) then + xswk(:,1) = xs_o2b(:,t_index,np_xs) + xswk(:,2) = xs_o3a(:,t_index,np_xs) + xswk(:,3) = xs_o3b(:,t_index,np_xs) + else + do km = 2,np_xs + if( ptarget >= prs(km) ) then + pndx = km - 1 + delp = (prs(pndx) - ptarget)*dprs(pndx) + exit + end if + end do + xswk(:,1) = xs_o2b(:,t_index,pndx) & + + delp*(xs_o2b(:,t_index,pndx+1) - xs_o2b(:,t_index,pndx)) + xswk(:,2) = xs_o3a(:,t_index,pndx) & + + delp*(xs_o3a(:,t_index,pndx+1) - xs_o3a(:,t_index,pndx)) + xswk(:,3) = xs_o3b(:,t_index,pndx) & + + delp*(xs_o3b(:,t_index,pndx+1) - xs_o3b(:,t_index,pndx)) + end if + hfactor = avogad/(cparg(k)*mw(k)) + wrk(:) = xswk(:,1)*bde_o2_b(:) + qrl_col(k,2) = dot_product( wrk(:),rsf(:,k) ) * o2_vmr(k) * hfactor + wrk(:) = xswk(:,2)*bde_o3_a(:) + qrl_col(k,3) = dot_product( wrk(:),rsf(:,k) ) * o3_vmr(k) * hfactor + wrk(:) = xswk(:,3)*bde_o3_b(:) + qrl_col(k,4) = dot_product( wrk(:),rsf(:,k) ) * o3_vmr(k) * hfactor + end do level_loop_1 + + deallocate( rsf, xswk, wrk ) + + end subroutine jlong_hrates + + subroutine jlong_photo( nlev, sza_in, alb_in, p_in, t_in, & + colo3_in, j_long ) +!============================================================================== +! Purpose: +! To calculate the total J for selective species longward of 200nm. +!============================================================================== +! Approach: +! 1) Reads the Cross Section*QY NetCDF file +! 2) Given a temperature profile, derives the appropriate XS*QY +! +! 3) Reads the Radiative Source function (RSF) NetCDF file +! Units = quanta cm-2 sec-1 +! +! 4) Indices are supplied to select a RSF that is consistent with +! the reference atmosphere in TUV (for direct comparision of J's). +! This approach will be replaced in the global model. Here colo3, zenith +! angle, and altitude will be inputed and the correct entry in the table +! will be derived. +!============================================================================== + + use spmd_utils, only : masterproc + use error_messages, only : alloc_err + + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent (in) :: nlev ! number vertical levels + real(r8), intent(in) :: sza_in ! solar zenith angle (degrees) + real(r8), intent(in) :: alb_in(nlev) ! albedo + real(r8), intent(in) :: p_in(nlev) ! midpoint pressure (hPa) + real(r8), intent(in) :: t_in(nlev) ! Temperature profile (K) + real(r8), intent(in) :: colo3_in(nlev) ! o3 column density (molecules/cm^3) + real(r8), intent(out) :: j_long(:,:) ! photo rates (1/s) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: astat + integer :: k, km, m + integer :: wn + integer :: t_index ! Temperature index + integer :: pndx + real(r8) :: ptarget + real(r8) :: delp + real(r8) :: hfactor + real(r8), allocatable :: rsf(:,:) ! Radiative source function + real(r8), allocatable :: xswk(:,:) ! working xsection array + +!---------------------------------------------------------------------- +! ... allocate variables +!---------------------------------------------------------------------- + allocate( rsf(nw,nlev),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jlong_photo', 'rsf', nw*nlev ) + end if + allocate( xswk(numj,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jlong_photo', 'xswk', numj*nw ) + end if + +!---------------------------------------------------------------------- +! ... interpolate table rsf to model variables +!---------------------------------------------------------------------- + call interpolate_rsf( alb_in, sza_in, p_in, colo3_in, nlev, rsf ) + +!------------------------------------------------------------------------------ +! ... calculate total Jlong for wavelengths >200nm +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! LLNL LUT approach to finding temperature index... +! Calculate the temperature index into the cross section +! data which lists coss sections for temperatures from +! 150 to 350 degrees K. Make sure the index is a value +! between 1 and 201. +!------------------------------------------------------------------------------ +level_loop_1 : & + do k = 1,nlev +!---------------------------------------------------------------------- +! ... get index into xsqy +!---------------------------------------------------------------------- + t_index = t_in(k) - 148.5_r8 + t_index = min( 201,max( t_index,1) ) +!---------------------------------------------------------------------- +! ... find pressure level +!---------------------------------------------------------------------- + ptarget = p_in(k) + if( ptarget >= prs(1) ) then + do wn = 1,nw + xswk(:,wn) = xsqy(:,wn,t_index,1) + end do + else if( ptarget <= prs(np_xs) ) then + do wn = 1,nw + xswk(:,wn) = xsqy(:,wn,t_index,np_xs) + end do + else + do km = 2,np_xs + if( ptarget >= prs(km) ) then + pndx = km - 1 + delp = (prs(pndx) - ptarget)*dprs(pndx) + exit + end if + end do + do wn = 1,nw + xswk(:,wn) = xsqy(:,wn,t_index,pndx) & + + delp*(xsqy(:,wn,t_index,pndx+1) - xsqy(:,wn,t_index,pndx)) + end do + end if +#ifdef USE_ESSL + call dgemm( 'N', 'N', numj, 1, nw, & + 1._r8, xswk, numj, rsf(1,k), nw, & + 0._r8, j_long(1,k), numj ) +#else + j_long(:,k) = matmul( xswk(:,:),rsf(:,k) ) +#endif + end do level_loop_1 + + deallocate( rsf, xswk ) + + end subroutine jlong_photo + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +! ... interpolate table rsf to model variables +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- + subroutine interpolate_rsf( alb_in, sza_in, p_in, colo3_in, kbot, rsf ) + + use error_messages, only : alloc_err + + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + real(r8), intent(in) :: alb_in(:) ! albedo + real(r8), intent(in) :: sza_in ! solar zenith angle (degrees) + integer, intent(in) :: kbot ! heating levels + real(r8), intent(in) :: p_in(:) ! midpoint pressure (hPa) + real(r8), intent(in) :: colo3_in(:) ! o3 column density (molecules/cm^3) + real(r8), intent(out) :: rsf(:,:) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: astat + integer :: is, iv, ial + integer :: isp1, ivp1, ialp1 + real(r8), dimension(3) :: dels + real(r8), dimension(0:1,0:1,0:1) :: wghtl, wghtu + real(r8) :: psum_u + real(r8), allocatable :: psum_l(:) + real(r8) :: v3ratl, v3ratu + integer :: pind, albind + real(r8) :: wrk0, wrk1, wght1 + integer :: iz, k, m + integer :: izl + integer :: ratindl, ratindu + integer :: wn + +!---------------------------------------------------------------------- +! ... allocate variables +!---------------------------------------------------------------------- + allocate( psum_l(nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jlong_hrates', 'psum_l', nw ) + end if + +!---------------------------------------------------------------------- +! ... find the zenith angle index ( same for all levels ) +!---------------------------------------------------------------------- + do is = 1,numsza + if( sza(is) > sza_in ) then + exit + end if + end do + is = max( min( is,numsza ) - 1,1 ) + isp1 = is + 1 + dels(1) = max( 0._r8,min( 1._r8,(sza_in - sza(is)) * del_sza(is) ) ) + wrk0 = 1._r8 - dels(1) + + izl = 2 +Level_loop : & + do k = kbot,1,-1 +!---------------------------------------------------------------------- +! ... find albedo indicies +!---------------------------------------------------------------------- + do ial = 1,numalb + if( alb(ial) > alb_in(k) ) then + exit + end if + end do + albind = max( min( ial,numalb ) - 1,1 ) +!---------------------------------------------------------------------- +! ... find pressure level indicies +!---------------------------------------------------------------------- + if( p_in(k) > p(1) ) then + pind = 2 + wght1 = 1._r8 + else if( p_in(k) <= p(nump) ) then + pind = nump + wght1 = 0._r8 + else + do iz = izl,nump + if( p(iz) < p_in(k) ) then + izl = iz + exit + end if + end do + pind = max( min( iz,nump ),2 ) + wght1 = max( 0._r8,min( 1._r8,(p_in(k) - p(pind)) * del_p(pind-1) ) ) + end if +!---------------------------------------------------------------------- +! ... find "o3 ratios" +!---------------------------------------------------------------------- + v3ratu = colo3_in(k) / colo3(pind-1) + do iv = 1,numcolo3 + if( o3rat(iv) > v3ratu ) then + exit + end if + end do + ratindu = max( min( iv,numcolo3 ) - 1,1 ) + + if( colo3(pind) /= 0._r8 ) then + v3ratl = colo3_in(k) / colo3(pind) + do iv = 1,numcolo3 + if( o3rat(iv) > v3ratl ) then + exit + end if + end do + ratindl = max( min( iv,numcolo3 ) - 1,1 ) + else + ratindl = ratindu + v3ratl = o3rat(ratindu) + end if + +!---------------------------------------------------------------------- +! ... compute the weigths +!---------------------------------------------------------------------- + ial = albind + ialp1 = ial + 1 + iv = ratindl + + dels(2) = max( 0._r8,min( 1._r8,(v3ratl - o3rat(iv)) * del_o3rat(iv) ) ) + dels(3) = max( 0._r8,min( 1._r8,(alb_in(k) - alb(ial)) * del_alb(ial) ) ) + + wrk1 = (1._r8 - dels(2))*(1._r8 - dels(3)) + wghtl(0,0,0) = wrk0*wrk1 + wghtl(1,0,0) = dels(1)*wrk1 + wrk1 = (1._r8 - dels(2))*dels(3) + wghtl(0,0,1) = wrk0*wrk1 + wghtl(1,0,1) = dels(1)*wrk1 + wrk1 = dels(2)*(1._r8 - dels(3)) + wghtl(0,1,0) = wrk0*wrk1 + wghtl(1,1,0) = dels(1)*wrk1 + wrk1 = dels(2)*dels(3) + wghtl(0,1,1) = wrk0*wrk1 + wghtl(1,1,1) = dels(1)*wrk1 + + iv = ratindu + dels(2) = max( 0._r8,min( 1._r8,(v3ratu - o3rat(iv)) * del_o3rat(iv) ) ) + + wrk1 = (1._r8 - dels(2))*(1._r8 - dels(3)) + wghtu(0,0,0) = wrk0*wrk1 + wghtu(1,0,0) = dels(1)*wrk1 + wrk1 = (1._r8 - dels(2))*dels(3) + wghtu(0,0,1) = wrk0*wrk1 + wghtu(1,0,1) = dels(1)*wrk1 + wrk1 = dels(2)*(1._r8 - dels(3)) + wghtu(0,1,0) = wrk0*wrk1 + wghtu(1,1,0) = dels(1)*wrk1 + wrk1 = dels(2)*dels(3) + wghtu(0,1,1) = wrk0*wrk1 + wghtu(1,1,1) = dels(1)*wrk1 + + iz = pind + iv = ratindl + ivp1 = iv + 1 + do wn = 1,nw + psum_l(wn) = wghtl(0,0,0) * rsf_tab(wn,iz,is,iv,ial) & + + wghtl(0,0,1) * rsf_tab(wn,iz,is,iv,ialp1) & + + wghtl(0,1,0) * rsf_tab(wn,iz,is,ivp1,ial) & + + wghtl(0,1,1) * rsf_tab(wn,iz,is,ivp1,ialp1) & + + wghtl(1,0,0) * rsf_tab(wn,iz,isp1,iv,ial) & + + wghtl(1,0,1) * rsf_tab(wn,iz,isp1,iv,ialp1) & + + wghtl(1,1,0) * rsf_tab(wn,iz,isp1,ivp1,ial) & + + wghtl(1,1,1) * rsf_tab(wn,iz,isp1,ivp1,ialp1) + end do + + iz = iz - 1 + iv = ratindu + ivp1 = iv + 1 + do wn = 1,nw + psum_u = wghtu(0,0,0) * rsf_tab(wn,iz,is,iv,ial) & + + wghtu(0,0,1) * rsf_tab(wn,iz,is,iv,ialp1) & + + wghtu(0,1,0) * rsf_tab(wn,iz,is,ivp1,ial) & + + wghtu(0,1,1) * rsf_tab(wn,iz,is,ivp1,ialp1) & + + wghtu(1,0,0) * rsf_tab(wn,iz,isp1,iv,ial) & + + wghtu(1,0,1) * rsf_tab(wn,iz,isp1,iv,ialp1) & + + wghtu(1,1,0) * rsf_tab(wn,iz,isp1,ivp1,ial) & + + wghtu(1,1,1) * rsf_tab(wn,iz,isp1,ivp1,ialp1) + rsf(wn,k) = (psum_l(wn) + wght1*(psum_u - psum_l(wn))) + end do +!------------------------------------------------------------------------------ +! etfphot comes in as photons/cm^2/sec/nm (rsf includes the wlintv factor -- nm) +! ... --> convert to photons/cm^2/s +!------------------------------------------------------------------------------ + rsf(:,k) = etfphot(:) * rsf(:,k) + + end do Level_loop + + deallocate( psum_l ) + + end subroutine interpolate_rsf + + + end module mo_jlong diff --git a/src/chemistry/mozart/mo_jpl.F90 b/src/chemistry/mozart/mo_jpl.F90 new file mode 100644 index 0000000000..3768cf4f7e --- /dev/null +++ b/src/chemistry/mozart/mo_jpl.F90 @@ -0,0 +1,41 @@ + + module mo_jpl + + private + public :: jpl + + contains + + subroutine jpl( rate, m, factor, ko, kinf, ncol ) +!----------------------------------------------------------------- +! ... Calculate JPL troe rate +!----------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + +!----------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: factor + real(r8), intent(in) :: ko(ncol) + real(r8), intent(in) :: kinf(ncol) + real(r8), intent(in) :: m(ncol) + real(r8), intent(out) :: rate(ncol) + +!----------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------- + real(r8) :: xpo(ncol) + + xpo(:) = ko(:) * m(:) / kinf(:) + rate(:) = ko(:) / (1._r8 + xpo(:)) + xpo(:) = log10( xpo(:) ) + xpo(:) = 1._r8 / (1._r8 + xpo(:)*xpo(:)) + rate(:) = rate(:) * factor**xpo(:) + + end subroutine jpl + + end module mo_jpl diff --git a/src/chemistry/mozart/mo_jshort.F90 b/src/chemistry/mozart/mo_jshort.F90 new file mode 100644 index 0000000000..e6b635c7be --- /dev/null +++ b/src/chemistry/mozart/mo_jshort.F90 @@ -0,0 +1,1876 @@ +#ifdef AIX +#define USE_ESSL +#endif +#define USE_BDE + + module mo_jshort + + use shr_kind_mod, only : r8 => shr_kind_r8 + use physconst, only : pi + use mo_constants, only : d2r + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use spmd_utils, only : masterproc + use ppgrid, only : pver + use phys_control, only : waccmx_is + + implicit none + + interface jshort + module procedure jshort_photo + module procedure jshort_hrates + end interface + + private + public :: jshort_init + public :: jshort_timestep_init + public :: jshort + public :: sphers + public :: slant_col + public :: nj + + save + +!------------------------------------------------------------------------------ +! ... define altitude and wavelength parameters +!------------------------------------------------------------------------------ + integer, parameter :: num_ms93tuv = 4 ! wavelength bins for MS, 93 + integer, parameter :: nw_ms93 = 4 ! wavelength bins for MS, 93 + integer, parameter :: nsrc_tot = 19 ! total bins for SRC + integer, parameter :: nsrb_tot = 14 ! total bins <200nm for SRB + integer, parameter :: nsrbtuv = 17 ! total SRB bins in TUV + real(r8), parameter :: hc = 6.62608e-34_r8 * 2.9979e8_r8 / 1.e-9_r8 + real(r8), parameter :: wc_o2_a = 175.05_r8 ! (nm) + real(r8), parameter :: wc_o2_b = 242.37_r8 ! (nm) + real(r8), parameter :: wc_o3_a = 310.32_r8 ! (nm) + real(r8), parameter :: wc_o3_b = 1179.87_r8 ! (nm) + real(r8), parameter :: we_ms(nw_ms93+1) = (/ 181.6_r8, 183.1_r8, 184.6_r8, 190.2_r8, 192.5_r8 /) + + integer :: nw ! Number of wavelength bins <200nm + integer :: nj ! Number of photorates + real(r8) :: wtno50(6,2) + real(r8) :: wtno90(6,2) + real(r8) :: wtno100(6,2) + real(r8) :: csno50(6,2) + real(r8) :: csno90(6,2) + real(r8) :: csno100(6,2) + real(r8) :: ac(20,nsrbtuv) + real(r8) :: bc(20,nsrbtuv) ! chebyshev polynomial coeffs + real(r8) :: wave_num(nsrbtuv) + real(r8), allocatable :: wc(:) + real(r8), allocatable :: we(:) + real(r8), allocatable :: wlintv(:) + real(r8), allocatable :: bde_o2_a(:) + real(r8), allocatable :: bde_o2_b(:) + real(r8), allocatable :: bde_o3_a(:) + real(r8), allocatable :: bde_o3_b(:) + real(r8), allocatable :: etfphot(:) + real(r8), allocatable :: etfphot_ms93(:) + real(r8), allocatable :: xs_o2src(:) + real(r8), allocatable :: xs_o3a(:) + real(r8), allocatable :: xs_o3b(:) + real(r8), allocatable :: xs_wl(:,:) + + contains + + subroutine jshort_init( xs_coef_file, xs_short_file, sht_indexer ) +!------------------------------------------------------------------------------ +! ... initialize photorates for 120nm <= lambda <= 200nm +!------------------------------------------------------------------------------ + + use mo_util, only : rebin + use solar_irrad_data, only : data_nbins=>nbins, data_we => we, data_etf => sol_etf + + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + character(len=*), intent(in) :: xs_coef_file, xs_short_file + integer, intent(inout) :: sht_indexer(:) + +!------------------------------------------------------------------------------ +! ... set the wavelength grid, exoatmospheric flux, +! and cross sections (for <200nm) - contained in +! a NetCDF file +!------------------------------------------------------------------------------ + call get_crs( xs_short_file, sht_indexer ) + if(masterproc) then + write(iulog,*) ' ' + write(iulog,*) '============================================' + write(iulog,*) 'jshort_init: finished get_crs' + write(iulog,*) 'jshort_init: nj, nw = ',nj,nw + write(iulog,*) 'jshort_init: wc' + write(iulog,*) wc(:) + write(iulog,*) '============================================' + write(iulog,*) ' ' + end if + we(:nw) = wc(:nw) - .5_r8*wlintv(:nw) + we(nw+1) = wc(nw) + .5_r8*wlintv(nw) + if(masterproc) then + write(iulog,*) ' ' + write(iulog,*) '-------------------------------------------' + write(iulog,*) 'jshort_init: diagnostics before rebin' + write(iulog,*) 'jshort_init: data_nbins, nw = ',data_nbins,nw + write(iulog,*) 'jshort_init: data_we range' + write(iulog,'(1p,5g15.7)') minval(data_we(:)),maxval(data_we(:)) + write(iulog,*) 'jshort_init: we range' + write(iulog,'(1p,5g15.7)') minval(we(:)),maxval(we(:)) + end if + call rebin( data_nbins, nw, data_we, we, data_etf, etfphot ) + if(masterproc) then + write(iulog,*) 'jshort_init: etfphot' + write(iulog,'(1p,5g15.7)') etfphot(:) + write(iulog,*) '-------------------------------------------' + write(iulog,*) ' ' + write(iulog,*) 'jshort_init: diagnostics for ms93' + call rebin( data_nbins, nw_ms93, data_we, we_ms, data_etf, etfphot_ms93 ) + write(iulog,'(1p,5g15.7)') etfphot_ms93(:) + write(iulog,*) '-------------------------------------------' + write(iulog,*) ' ' + end if +!------------------------------------------------------------------------------ +! ... loads Chebyshev polynomial Coeff +!------------------------------------------------------------------------------ + call xs_init(xs_coef_file) + +!------------------------------------------------------------------------------ +! ... initialize no photolysis +!------------------------------------------------------------------------------ + call jno_init + + end subroutine jshort_init + + subroutine get_crs( xs_short_file, sht_indexer ) +!============================================================================= +! PURPOSE: +! Reads a NetCDF file that contains: +! Cross_sections*quantum yield data for species <200nm. +! Exoatmospheric flux on the wavelength grid of the crs +!============================================================================= +! PARAMETERS: +! Input: +! xs_short_file.... NetCDF file that contains the crs*QY for wavenum species +! +! Output: +! xs_species.. Cross Sections * QY data for each species +! etfphot..... Exoatmospheric flux in photons cm-2 s-1 nm-1 +! etfphot_ms93.Minshwanner and Siskind JNO SRB etf (on MS93 grid) +! wc.......... wavelength center (nm) +! numwl ...... Number of wavelengths < 200nm in NetCDF input file +! wlintv ..... Wavelength inteval for grid, nm +!============================================================================= +! EDIT HISTORY: +! Created by Doug Kinnison, 1/14/2002 +! Modified by S. Walters, 4/2/2003 +!============================================================================= + + use chem_mods, only : phtcnt, pht_alias_lst, rxt_tag_lst + use ioFileMod, only : getfil + use error_messages, only : alloc_err + use pio, only : file_desc_t, pio_get_var, pio_closefile, pio_noerr, & + pio_seterrorhandling, pio_bcast_error, pio_internal_error, pio_inq_varid, & + pio_inq_dimlen, pio_nowrite, pio_inq_dimid + use cam_pio_utils, only : cam_pio_openfile + implicit none + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent(inout) :: sht_indexer(:) + character(len=*), intent(in) :: xs_short_file + +!------------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------------ + integer :: wn + type(file_desc_t) :: ncid + integer :: ierr + integer :: i, m, ndx + integer :: varid, dimid + integer :: wrk_ndx(phtcnt) + real(r8), allocatable :: xs_species(:) + character(len=256) :: locfn + +!------------------------------------------------------------------------------ +! ... open NetCDF File +!------------------------------------------------------------------------------ + call getfil(xs_short_file, locfn, 0) + call cam_pio_openfile(ncid, trim(locfn), PIO_NOWRITE) + +!------------------------------------------------------------------------------ +! ... get dimensions +!------------------------------------------------------------------------------ + ierr = pio_inq_dimid( ncid, 'numwl', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, nw ) + +!------------------------------------------------------------------------------ +! ... check for cross section in dataset +!------------------------------------------------------------------------------ + call pio_seterrorhandling(ncid, pio_bcast_error) + do m = 1,phtcnt + if( pht_alias_lst(m,1) == ' ' ) then + ierr = pio_inq_varid( ncid, rxt_tag_lst(m), varid ) + if( ierr == PIO_noerr ) then + sht_indexer(m) = varid + end if + else if( pht_alias_lst(m,1) == 'userdefined' ) then + sht_indexer(m) = -1 + else + ierr = pio_inq_varid( ncid, pht_alias_lst(m,1), varid ) + if( ierr == PIO_noerr ) then + sht_indexer(m) = varid + else + write(iulog,*) 'get_crs : ',rxt_tag_lst(m)(:len_trim(rxt_tag_lst(m))),' alias ', & + pht_alias_lst(m,1)(:len_trim(pht_alias_lst(m,1))),' not in dataset' + call endrun + end if + end if + end do + call pio_seterrorhandling(ncid, pio_internal_error) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) '###############################################' + write(iulog,*) 'get_crs: sht_indexer' + write(iulog,'(10i6)') sht_indexer(:) + write(iulog,*) '###############################################' + write(iulog,*) ' ' + endif + + nj = 0 + do m = 1,phtcnt + if( sht_indexer(m) > 0 ) then + if( any( sht_indexer(:m-1) == sht_indexer(m) ) ) then + cycle + end if + nj = nj + 1 + end if + end do + +!------------------------------------------------------------------------------ +! ... allocate arrays +!------------------------------------------------------------------------------ + allocate( wc(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'wc', nw ) + end if + allocate( we(nw+1),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'we', nw+1 ) + end if + allocate( wlintv(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'wlintv', nw ) + end if + allocate( etfphot(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'etfphot', nw ) + end if + allocate( bde_o2_a(nw),bde_o2_b(nw),bde_o3_a(nw),bde_o3_b(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'bde_o2_a ... bde_o3_b', nw ) + end if + allocate( etfphot_ms93(nw_ms93),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'etfphot_ms93', nw_ms93 ) + end if + allocate( xs_o2src(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'xs_o2src', nw ) + end if + allocate( xs_o3a(nw),xs_o3b(nw),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'xs_o3a,xs_o3b', nw ) + end if + allocate( xs_species(nw),xs_wl(nw,nj),stat=ierr ) + if( ierr /= 0 ) then + call alloc_err( ierr, 'get_crs', 'xs_species,xs_wl', nw*nj ) + end if + +!------------------------------------------------------------------------------ +! ... read arrays +!------------------------------------------------------------------------------ + ierr = pio_inq_varid( ncid, 'wc', varid ) + ierr = pio_get_var( ncid, varid, wc ) + ierr = pio_inq_varid( ncid, 'wlintv', varid ) + ierr = pio_get_var( ncid, varid, wlintv ) + ierr = pio_inq_varid( ncid, 'xs_o2src', varid ) + ierr = pio_get_var( ncid, varid, xs_o2src ) + ndx = 0 + do m = 1,phtcnt + if( sht_indexer(m) > 0 ) then + if( any( sht_indexer(:m-1) == sht_indexer(m) ) ) then + cycle + end if + ierr = pio_get_var( ncid, sht_indexer(m), xs_species ) + ndx = ndx + 1 + xs_wl(:,ndx) = xs_species(:)*wlintv(:) + end if + end do + deallocate( xs_species ) + if( ndx /= nj ) then + write(iulog,*) 'get_crs : ndx count /= cross section count' + call endrun + end if + !------------------------------------------------------------------------------ + ! ... get jo3 cross sections + !------------------------------------------------------------------------------ + ierr = pio_inq_varid( ncid, 'jo3_a', varid ) + ierr = pio_get_var( ncid, varid, xs_o3a ) + ierr = pio_inq_varid( ncid, 'jo3_b', varid ) + ierr = pio_get_var( ncid, varid, xs_o3b ) + !------------------------------------------------------------------------------ + ! ... setup final sht_indexer + !------------------------------------------------------------------------------ + ndx = 0 + wrk_ndx(:) = sht_indexer(:) + do m = 1,phtcnt + if( wrk_ndx(m) > 0 ) then + ndx = ndx + 1 + i = wrk_ndx(m) + where( wrk_ndx(:) == i ) + sht_indexer(:) = ndx + wrk_ndx(:) = -100000 + end where + end if + end do + + call pio_closefile( ncid ) + +#ifdef USE_BDE + if (masterproc) write(iulog,*) 'Jshort using bdes' +#else + if (masterproc) write(iulog,*) 'Jshort not using bdes' +#endif + do wn = 1,nw +#ifdef USE_BDE + bde_o2_a(wn) = max(0._r8, hc*(wc_o2_a - wc(wn))/(wc_o2_a*wc(wn)) ) + bde_o2_b(wn) = max(0._r8, hc*(wc_o2_b - wc(wn))/(wc_o2_b*wc(wn)) ) + bde_o3_a(wn) = max(0._r8, hc*(wc_o3_a - wc(wn))/(wc_o3_a*wc(wn)) ) + bde_o3_b(wn) = max(0._r8, hc*(wc_o3_b - wc(wn))/(wc_o3_b*wc(wn)) ) +#else + bde_o2_a(wn) = hc/wc(wn) + bde_o2_b(wn) = hc/wc(wn) + bde_o3_a(wn) = hc/wc(wn) + bde_o3_b(wn) = hc/wc(wn) +#endif + end do + + end subroutine get_crs + + subroutine xs_init(xs_coef_file) +!------------------------------------------------------------- +! ... Loads XS_COEFFS containing the Chebyshev +! polynomial coeffs necessary to calculate O2 effective +! cross-sections +!------------------------------------------------------------- + + use ioFileMod, only : getfil + use units, only : getunit, freeunit + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + character(len=*), intent(in) :: xs_coef_file + +!------------------------------------------------------------- +! ... Local variables +!------------------------------------------------------------- + integer :: unit ! file unit number + integer :: istat ! i/o status + integer :: i, j + character(len=256) :: locfn + +!---------------------------------------------------------------------- +! ... Get first strato photo rate file +!---------------------------------------------------------------------- + call getfil(xs_coef_file, locfn, 0) +!---------------------------------------------------------------------- +! ... open file +!---------------------------------------------------------------------- + unit = getunit() + open( unit = unit, & + file = trim(locfn), & + status = 'old', & + form = 'formatted', & + iostat = istat ) + if( istat /= 0 ) then +!---------------------------------------------------------------------- +! ... Open error exit +!---------------------------------------------------------------------- + write(iulog,*) 'xs_init: error ',istat,' opening file ',trim(locfn) + call endrun + end if +!---------------------------------------------------------------------- +! ... read file +!---------------------------------------------------------------------- + read(unit,901) + do i = 1,20 + read(unit,903,iostat=istat) ac(i,:) + if( istat /= 0 ) then + write(iulog,*) 'xs_init: error ',istat,' reading ac' + call endrun + end if + end do + + read(unit,901) + do i = 1,20 + read(unit,903,iostat=istat) bc(i,:) + if( istat /= 0 ) then + write(iulog,*) 'xs_init: error ',istat,' reading bc' + call endrun + end if + end do + close( unit ) + call freeunit( unit ) + + wave_num(17:1:-1) = (/ (48250._r8 + (500._r8*i),i=1,17) /) + + 901 format( / ) + 903 format( 17(e23.14,1x)) + + end subroutine xs_init + + subroutine jno_init +!------------------------------------------------------------- +! ... Initialization for no photolysis +!------------------------------------------------------------- + + implicit none + +!------------------------------------------------------------- +! ... Local variables +!------------------------------------------------------------- + real(r8), dimension(24) :: a, b, c + +!------------------------------------------------------------------------------ +! ... 6 sub-intervals for O2 5-0 at 265K, +! 2 sub-sub-intervals for NO 0-0 at 250K +!------------------------------------------------------------------------------ + a(:) = (/ 0._r8, 0._r8, 0._r8, 0._r8, & + 5.12e-02_r8, 5.68e-03_r8, 1.32e-18_r8, 4.41e-17_r8, & + 1.36e-01_r8, 1.52e-02_r8, 6.35e-19_r8, 4.45e-17_r8, & + 1.65e-01_r8, 1.83e-02_r8, 7.09e-19_r8, 4.50e-17_r8, & + 1.41e-01_r8, 1.57e-02_r8, 2.18e-19_r8, 2.94e-17_r8, & + 4.50e-02_r8, 5.00e-03_r8, 4.67e-19_r8, 4.35e-17_r8 /) + +!------------------------------------------------------------------------------ +! ... sub-intervals for o2 9-0 band, +! 2 sub-sub-intervals for no 1-0 at 250 k +!------------------------------------------------------------------------------ + b(:) = (/ 0._r8, 0._r8, 0._r8, 0._r8, & + 0._r8, 0._r8, 0._r8, 0._r8, & + 1.93e-03_r8, 2.14e-04_r8, 3.05e-21_r8, 3.20e-21_r8, & + 9.73e-02_r8, 1.08e-02_r8, 5.76e-19_r8, 5.71e-17_r8, & + 9.75e-02_r8, 1.08e-02_r8, 2.29e-18_r8, 9.09e-17_r8, & + 3.48e-02_r8, 3.86e-03_r8, 2.21e-18_r8, 6.00e-17_r8 /) + +!------------------------------------------------------------------------------ +! ... sub-intervals for o2 10-0 band, +! 2 sub-sub-intervals for no 1-0 at 250 k +!------------------------------------------------------------------------------ + c(:) = (/ 4.50e-02_r8, 5.00e-03_r8, 1.80e-18_r8, 1.40e-16_r8, & + 1.80e-01_r8, 2.00e-02_r8, 1.50e-18_r8, 1.52e-16_r8, & + 2.25e-01_r8, 2.50e-02_r8, 5.01e-19_r8, 7.00e-17_r8, & + 2.25e-01_r8, 2.50e-02_r8, 7.20e-20_r8, 2.83e-17_r8, & + 1.80e-01_r8, 2.00e-02_r8, 6.72e-20_r8, 2.73e-17_r8, & + 4.50e-02_r8, 5.00e-03_r8, 1.49e-21_r8, 6.57e-18_r8 /) + + wtno50 (1:6,1) = a(1:24:4) + wtno50 (1:6,2) = a(2:24:4) + csno50 (1:6,1) = a(3:24:4) + csno50 (1:6,2) = a(4:24:4) + wtno90 (1:6,1) = b(1:24:4) + wtno90 (1:6,2) = b(2:24:4) + csno90 (1:6,1) = b(3:24:4) + csno90 (1:6,2) = b(4:24:4) + wtno100(1:6,1) = c(1:24:4) + wtno100(1:6,2) = c(2:24:4) + csno100(1:6,1) = c(3:24:4) + csno100(1:6,2) = c(4:24:4) + + end subroutine jno_init + + subroutine jshort_timestep_init +!--------------------------------------------------------------- +! ... set etfphot if required +!--------------------------------------------------------------- + + use mo_util, only : rebin + use solar_irrad_data, only : data_nbins=>nbins, data_we => we, data_etf => sol_etf + + implicit none + + call rebin( data_nbins, nw, data_we, we, data_etf, etfphot ) + call rebin( data_nbins, nw_ms93, data_we, we_ms, data_etf, etfphot_ms93 ) + + end subroutine jshort_timestep_init + + subroutine jshort_hrates( nlev, zen, o2_vmr, o3_vmr, o2cc, & + o3cc, tlev, zkm, mw, qrs, cparg, & + lchnk, long, co2cc, scco2, do_diag ) +!==============================================================================! +! Subroutine Jshort ! +!==============================================================================! +! Purpose: ! +! To calculate thermal heating rates for lamba < 200 nm +!==============================================================================! +! This routine uses JO2 parameterizations based on: ! +! Lyman alpha... Chabrillat and Kockarts, GRL, 25, 2659, 1998 ! +! SRC .......... Brasseur and Solomon, 1986 (from TUV) ! +! SRB .......... Koppers and Murtagh, Ann. Geophys., 14, 68-79, 1996 ! +! (supplied by Dan Marsh, NCAR ACD ! +! and JNO: ! +! SRB .......... Minschwanner and Siskind, JGR< 98, 20401, 1993. ! +!==============================================================================! +! Input: ! +! o2cc....... O2 concentration, molecule cm-3 ! +! o3cc....... O3 concentration, molecule cm-3 ! +! zen........ zenith angle, units = degrees ! +! tlev....... Temperature Profile (K) ! +! zkm ....... Altitude, km ! +! ! +! Output: ! +! qrs ... short wavelength thermal heating rates +!==============================================================================! +! ! +! Approach: ! +! ! +! 1) Call sphers (taken from TUV) ! +! -> derives dsdh and nid used in slant column routines ! +! -> zenith angle dependent ! +! ! +! 2) Call slant_col (taken from TUV) ! +! -> derives the slant column for each species ! +! ! +! 3) Calls get_crs ! +! -> read a NetCDF file ! +! -> returns cross sections*quantum yields for all species that ! +! have absorption below 200nm. ! +! ! +! 4) Derives transmission and photolysis rates for selective species ! +! ! +!==============================================================================! +! EDIT HISTORY: ! +! Created by Doug Kinnison, 3/14/2002 ! +!==============================================================================! + + use physconst, only : avogad + use error_messages, only : alloc_err + + implicit none + + integer, parameter :: branch = 2 ! two photolysis pathways for JO2 + real(r8), parameter :: km2cm = 1.e5_r8 + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev ! model vertical levels + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: long ! chunk index + real(r8), intent(in) :: zen ! Zenith angle (degrees) + real(r8), intent(in) :: o2_vmr(nlev) ! o2 conc (mol/mol) + real(r8), intent(in) :: o3_vmr(nlev) ! o3 conc (mol/mol) + real(r8), intent(in) :: o2cc(nlev) ! o2 conc (mol/cm^3) + real(r8), intent(in) :: co2cc(nlev) ! co2 conc (mol/cm^3) + real(r8), intent(in) :: o3cc(nlev) ! o3 conc (mol/cm^3) + real(r8), intent(in) :: tlev(nlev) ! Temperature profile + real(r8), intent(in) :: zkm(nlev) ! Altitude, km + real(r8), intent(in) :: mw(nlev) ! atms molecular weight + real(r8), intent(in) :: cparg(nlev) ! column specific heat capacity + real(r8), intent(inout) :: qrs(:,:) ! sw heating rates + real(r8), intent(out) :: scco2(nlev) ! co2 column concentration (molec/cm^2) + logical, intent(in) :: do_diag + +!------------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------------ + integer :: k, k1 ! Altitude indicies + integer :: wn ! Wavelength index + integer :: astat + integer :: nid(0:nlev) ! Number of layers crossed by the direct + ! beam when travelling from the top of the + ! atmosphere to layer i; NID(i), i = 0..NZ-1 + real(r8) :: hfactor + real(r8) :: dsdh(0:nlev,nlev) ! Slant path of direct beam through each + ! layer crossed when travelling from the top of + ! the atmosphere to layer i; DSDH(i,j), i = 0. + ! NZ-1, j = 1..NZ-1 (see sphers.f) + real(r8), allocatable :: fnorm(:,:) ! Normalized ETF + real(r8), allocatable :: trans_o2(:,:) ! Transmission o2 (total) + real(r8), allocatable :: trans_o3(:,:) ! Transmission, ozone + real(r8), allocatable :: wrk(:) ! wrk array + real(r8) :: jo2_lya(nlev) ! Total photolytic rate constant for Ly alpha + real(r8) :: jo2_srb(nlev) ! Total JO2 for SRB + real(r8) :: jo2_src(nlev) ! Total JO2 for SRC + real(r8) :: delz(nlev) ! layer thickness (cm) + real(r8) :: o2scol(nlev) ! O2 Slant Column + real(r8) :: o3scol(nlev) ! O3 Slant Column + real(r8) :: rmla(nlev) ! Transmission, Lyman Alpha (other species) + real(r8) :: ro2la(nlev) ! Transmission, Lyman Alpha (for JO2) + real(r8) :: tlevmin(nlev) + real(r8) :: abs_col(nlev) + real(r8) :: tsrb(nlev,nsrbtuv) ! Transmission in the SRB + real(r8) :: xs_o2srb(nlev,nsrbtuv) ! Cross section * QY for O2 in SRB + + allocate( fnorm(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_hrates', 'fnorm', nw*nlev ) + end if + allocate( trans_o2(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_hrates', 'trans_o2', nw*nlev ) + end if + allocate( trans_o3(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_hrates', 'trans_o3', nw*nlev ) + end if + allocate( wrk(nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_hrates', 'wrk', nw ) + end if + +!------------------------------------------------------------------------------ +! ... derive Slant Path for Spherical Atmosphere +!------------------------------------------------------------------------------ + call sphers( nlev, zkm, zen, dsdh, nid ) + +!------------------------------------------------------------------------------ +! ... derive O2, O3, and CO2 slant columns +!------------------------------------------------------------------------------ + delz(1:nlev-1) = km2cm*(zkm(1:nlev-1) - zkm(2:nlev)) + call slant_col( nlev, delz, dsdh, nid, o2cc, o2scol ) + call slant_col( nlev, delz, dsdh, nid, o3cc, o3scol ) + call slant_col( nlev, delz, dsdh, nid, co2cc, scco2 ) + +!------------------------------------------------------------------------------ +! ... transmission due to ozone +!------------------------------------------------------------------------------ + do wn = 1,nw + abs_col(:) = min( (xs_o3a(wn) + xs_o3b(wn))*o3scol(:),100._r8 ) + trans_o3(:,wn) = exp( -abs_col(:) ) + end do + +!------------------------------------------------------------------------------ +! ... derive the cross section and transmission for +! molecular oxygen Lya, SRC, and SRB's +!------------------------------------------------------------------------------ +! ... transmission due to molecular oxygen in the SRC +!------------------------------------------------------------------------------ + do wn = 1,nsrc_tot + abs_col(:) = min( xs_o2src(wn)*o2scol(:),100._r8 ) + trans_o2(:,wn) = exp( -abs_col(:) ) + end do + +!------------------------------------------------------------------------------ +! ... transmission and cross sections due to O2 at lyman alpha +!------------------------------------------------------------------------------ + call lymana( nlev, o2scol, rmla, ro2la ) + +!------------------------------------------------------------------------------ +! ... place lya reduction faction in transmission array +! this must follow the SRC placement (above) +!------------------------------------------------------------------------------ + trans_o2(:,1) = rmla(:) + +!------------------------------------------------------------------------------ +! ... Molecular Oxygen, SRB +!------------------------------------------------------------------------------ +! ... Koppers Grid (see Koppers and Murtagh, Ann. Geophys., 14, 68-79, 1996) +! # wl(i) wl(i+1) +! 1 174.4 177.0 +! 2 177.0 178.6 +! 3 178.6 180.2 +! 4 180.2 181.8 +! 5 181.8 183.5 +! 6 183.5 185.2 +! 7 185.2 186.9 +! 8 186.9 188.7 +! 9 188.7 190.5 +! 10 190.5 192.3 +! 11 192.3 194.2 +! 12 194.2 196.1 +! 13 196.1 198.0 +! 14 198.0 200.0 < O(3P) + O(3P) +! Shortward of 174.65 the product is O2 + hv => O(3P) + O(1D) +! The QY is assumed to be unity in both wavelength ranges. +! +! ... Lyman Alpha QY +! O2 + hv -> O(3P) + O(3P) at Lyman Alpha has a QY = 0.47 +! O2 + hv -> O(3P) + O(1D) at Lyman Alpha has a QY = 0.53 +! Lacoursiere et al., J. Chem. Phys. 110., 1949-1958, 1999. +!------------------------------------------------------------------------------ +! ... lyman alpha +!------------------------------------------------------------------------------ + jo2_lya(:) = etfphot(1)*ro2la(:)*wlintv(1) + + wrk(1:nsrc_tot) = xs_o2src(1:nsrc_tot)*wlintv(1:nsrc_tot) & + *bde_o2_a(1:nsrc_tot) + wrk(1) = 0._r8 +!------------------------------------------------------------------------------ +! ... o2 src heating +!------------------------------------------------------------------------------ + if( do_diag ) then + write(iulog,*) '-------------------------------------------------' + write(iulog,*) 'jshort_hrates: fnorm,wrk at long,lchnk = ',long,lchnk + write(iulog,'(1p,5g12.5)') fnorm(nlev,1:nsrc_tot) + write(iulog,*) ' ' + write(iulog,'(1p,5g12.5)') wrk(1:nsrc_tot) + write(iulog,*) '-------------------------------------------------' + end if +#ifdef USE_ESSL + call dgemm( 'N', 'N', nlev, 1, nsrc_tot, & + 1._r8, fnorm, nlev, wrk, nw, & + 0._r8, qrs, nlev ) +#else + qrs(:,1) = matmul( fnorm(:,1:nsrc_tot),wrk(1:nsrc_tot) ) +#endif +!------------------------------------------------------------------------------ +! ... o2 srb heating +!------------------------------------------------------------------------------ + do k = 1,nlev + wrk(1:nsrb_tot) = xs_o2srb(k,1:nsrb_tot)*wlintv(nsrc_tot+1:nsrc_tot+nsrb_tot) & + *bde_o2_b(nsrc_tot+1:nsrc_tot+nsrb_tot) + qrs(k,2) = dot_product( fnorm(k,nsrc_tot+1:nsrc_tot+nsrb_tot),wrk(1:nsrb_tot) ) + end do + + if( do_diag ) then + write(iulog,*) '-------------------------------------------------' + write(iulog,*) 'jshort_hrates: lya,bde_o2_a,qrs(nlev) at long,lchnk = ',long,lchnk + write(iulog,'(1p,5g12.5)') jo2_lya(nlev),bde_o2_a(2),qrs(nlev,1) + write(iulog,*) '-------------------------------------------------' + end if +!------------------------------------------------------------------------------ +! ... total o2 heating +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! ... Branch 1, O2 + hv => O(3P) + O(3P); wavelengths >175nm +!------------------------------------------------------------------------------ + qrs(:,2) = qrs(:,2) + jo2_lya(:)*.47_r8*bde_o2_b(2) +!------------------------------------------------------------------------------ +! ... Branch 2, O2 + hv => O(3P) + O(1D); wavelengths <175nm +!------------------------------------------------------------------------------ + qrs(:,1) = qrs(:,1) + jo2_lya(:)*.53_r8*bde_o2_a(2) + if( do_diag ) then + write(iulog,*) '-------------------------------------------------' + write(iulog,*) 'jshort_hrates: o2(1),qrs(nlev) at long,lchnk = ',long,lchnk + write(iulog,'(1p,5g12.5)') o2_vmr(1),qrs(nlev,1) + write(iulog,*) '-------------------------------------------------' + end if + +!------------------------------------------------------------------------------ +! ... the o3 heating rates +!------------------------------------------------------------------------------ + wrk(:) = xs_o3a(:)*wlintv(:)*bde_o3_a(:) +#ifdef USE_ESSL + call dgemm( 'N', 'N', nlev, 1, nw, & + 1._r8, fnorm, nlev, wrk, nw, & + 0._r8, qrs(1,3), nlev ) +#else + qrs(:,3) = matmul( fnorm,wrk ) +#endif + wrk(:) = xs_o3b(:)*wlintv(:)*bde_o3_b(:) +#ifdef USE_ESSL + call dgemm( 'N', 'N', nlev, 1, nw, & + 1._r8, fnorm, nlev, wrk, nw, & + 0._r8, qrs(1,4), nlev ) +#else + qrs(:,4) = matmul( fnorm,wrk ) +#endif + +!------------------------------------------------------------------------------ +! ... form actual heating rates (k/s) +!------------------------------------------------------------------------------ + do k = 1,nlev + k1 = nlev - k + 1 + hfactor = avogad/(cparg(k1)*mw(k1)) + qrs(k,1) = qrs(k,1)*hfactor*o2_vmr(k1) + qrs(k,2) = qrs(k,2)*hfactor*o2_vmr(k1) + qrs(k,3) = qrs(k,3)*hfactor*o3_vmr(k1) + qrs(k,4) = qrs(k,4)*hfactor*o3_vmr(k1) + end do + + deallocate( fnorm, trans_o2, trans_o3, wrk ) + + end subroutine jshort_hrates + + subroutine jshort_photo( nlev, zen, n2cc, o2cc, o3cc, & + nocc, tlev, zkm, jo2_sht, jno_sht, jsht ) +!==============================================================================! +! Subroutine Jshort ! +! ! +!==============================================================================! +! Purpose: ! +! To calculate the total J for JO2, JNO, and selective species below 200nm.! +! ! +!==============================================================================! +! This routine uses JO2 parameterizations based on: ! +! Lyman alpha... Chabrillat and Kockarts, GRL, 25, 2659, 1998 ! +! SRC .......... Brasseur and Solomon, 1986 (from TUV) ! +! SRB .......... Koppers and Murtagh, Ann. Geophys., 14, 68-79, 1996 ! +! (supplied by Dan Marsh, NCAR ACD ! +! and JNO: ! +! SRB .......... Minschwanner and Siskind, JGR< 98, 20401, 1993. ! +! ! +!==============================================================================! +! Input: ! +! n2cc....... N2 concentration, molecule cm-3 ! +! o2cc....... O2 concentration, molecule cm-3 ! +! o3cc....... O3 concentration, molecule cm-3 ! +! nocc....... NO concentration, molecule cm-3 ! +! n2cc....... N2 concentration, molecule cm-3 ! +! zen........ zenith angle, units = degrees ! +! tlev....... Temperature Profile (K) ! +! zkm ....... Altitude, km ! +! ! +! Output: ! +! jo2_sht ... O2 photolytic rate constant, sec-1, <200nm ! +! jno_sht ... NO photolytic rate constant, sec-1, SRB ! +! jsht. Photolytic rate constant for other species below 200nm ! +! ! +!==============================================================================! +! ! +! Approach: ! +! ! +! 1) Call sphers (taken from TUV) ! +! -> derives dsdh and nid used in slant column routines ! +! -> zenith angle dependent ! +! ! +! 2) Call slant_col (taken from TUV) ! +! -> derives the slant column for each species ! +! ! +! 3) Calls get_crs ! +! -> read a NetCDF file ! +! -> returns cross sections*quantum yields for all species that ! +! have absorption below 200nm. ! +! ! +! 4) Derives transmission and photolysis rates for selective species ! +! ! +!==============================================================================! +! EDIT HISTORY: ! +! Created by Doug Kinnison, 3/14/2002 ! +!==============================================================================! + + use error_messages, only : alloc_err + + implicit none + + integer, parameter :: branch = 2 ! two photolysis pathways for JO2 + real(r8), parameter :: km2cm = 1.e5_r8 + +!------------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev ! model vertical levels + real(r8), intent(in) :: zen ! Zenith angle (degrees) + real(r8), intent(in) :: n2cc(nlev) ! Molecular Nitrogen conc (mol/cm^3) + real(r8), intent(in) :: o2cc(nlev) ! Molecular Oxygen conc (mol/cm^3) + real(r8), intent(in) :: o3cc(nlev) ! Ozone concentration (mol/cm^3) + real(r8), intent(in) :: nocc(nlev) ! Nitric Oxide conc (mol/cm^3) + real(r8), intent(in) :: tlev(nlev) ! Temperature profile + real(r8), intent(in) :: zkm(nlev) ! Altitude, km + real(r8), intent(out) :: jo2_sht(nlev,branch) ! JO2, sec-1, <200nm + real(r8), intent(out) :: jno_sht(nlev) ! JNO, sec-1, SRB + real(r8), intent(out) :: jsht(:,:) ! Additional J's + +!------------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------------ + integer :: k ! Altitude index + integer :: wn ! Wavelength index + integer :: astat + integer :: nid(0:nlev) ! Number of layers crossed by the direct + ! beam when travelling from the top of the + ! atmosphere to layer i; NID(i), i = 0..NZ-1 + real(r8) :: hfactor + real(r8) :: dsdh(0:nlev,nlev) ! Slant path of direct beam through each + ! layer crossed when travelling from the top of + ! the atmosphere to layer i; DSDH(i,j), i = 0. + ! NZ-1, j = 1..NZ-1 (see sphers.f) + real(r8), allocatable :: fnorm(:,:) ! Normalized ETF + real(r8), allocatable :: trans_o2(:,:) ! Transmission o2 (total) + real(r8), allocatable :: trans_o3(:,:) ! Transmission, ozone + real(r8), allocatable :: wrk(:) ! wrk array + real(r8) :: jo2_lya(nlev) ! Total photolytic rate constant for Ly alpha + real(r8) :: jo2_srb(nlev) ! Total JO2 for SRB + real(r8) :: jo2_src(nlev) ! Total JO2 for SRC + real(r8) :: delz(nlev) ! layer thickness (cm) + real(r8) :: o2scol(nlev) ! O2 Slant Column + real(r8) :: o3scol(nlev) ! O3 Slant Column + real(r8) :: noscol(nlev) ! NO Slant Column + real(r8) :: rmla(nlev) ! Transmission, Lyman Alpha (other species) + real(r8) :: ro2la(nlev) ! Transmission, Lyman Alpha (for JO2) + real(r8) :: tlevmin(nlev) + real(r8) :: abs_col(nlev) + real(r8) :: tsrb(nlev,nsrbtuv) ! Transmission in the SRB + real(r8) :: xs_o2srb(nlev,nsrbtuv) ! Cross section * QY for O2 in SRB + + allocate( fnorm(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_photo', 'fnorm', nw*nlev ) + end if + allocate( trans_o2(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_photo', 'trans_o2', nw*nlev ) + end if + allocate( trans_o3(nlev,nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_photo', 'trans_o3', nw*nlev ) + end if + allocate( wrk(nw),stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'jshort_photo', 'wrk', nw ) + end if + +!------------------------------------------------------------------------------ +! ... Derive Slant Path for Spherical Atmosphere +!------------------------------------------------------------------------------ + call sphers( nlev, zkm, zen, dsdh, nid ) + +!------------------------------------------------------------------------------ +! ... Derive O2, O3, and NO Slant Column +!------------------------------------------------------------------------------ + delz(1:nlev-1) = km2cm*(zkm(1:nlev-1) - zkm(2:nlev)) + call slant_col( nlev, delz, dsdh, nid, o2cc, o2scol ) + call slant_col( nlev, delz, dsdh, nid, o3cc, o3scol ) + call slant_col( nlev, delz, dsdh, nid, nocc, noscol ) + +!------------------------------------------------------------------------------ +! ... Transmission due to ozone +!------------------------------------------------------------------------------ + do wn = 1,nw + abs_col(:) = min( (xs_o3a(wn) + xs_o3b(wn))*o3scol(:),100._r8 ) + trans_o3(:,wn) = exp( -abs_col(:) ) + end do + +!------------------------------------------------------------------------------ +! ... Derive the cross section and transmission for +! molecular oxygen Lya, SRC, and SRB's +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! ... Transmission due to molecular oxygen in the SRC +!------------------------------------------------------------------------------ + do wn = 1,nsrc_tot + abs_col(:) = min( xs_o2src(wn)*o2scol(:),100._r8 ) + trans_o2(:,wn) = exp( -abs_col(:) ) + end do + +!------------------------------------------------------------------------------ +! ... Transmission and cross sections due to O2 at lyman alpha +!------------------------------------------------------------------------------ + call lymana( nlev, o2scol, rmla, ro2la ) + +!------------------------------------------------------------------------------ +! ... Place lya reduction faction in transmission array +! ... This must follow the SRC placement (above) +!------------------------------------------------------------------------------ + trans_o2(:,1) = rmla(:) + +!------------------------------------------------------------------------------ +! ... Molecular Oxygen, SRB +!------------------------------------------------------------------------------ +! ... Koppers Grid (see Koppers and Murtagh, Ann. Geophys., 14, 68-79, 1996) +! # wl(i) wl(i+1) +! 1 174.4 177.0 +! 2 177.0 178.6 +! 3 178.6 180.2 +! 4 180.2 181.8 +! 5 181.8 183.5 +! 6 183.5 185.2 +! 7 185.2 186.9 +! 8 186.9 188.7 +! 9 188.7 190.5 +! 10 190.5 192.3 +! 11 192.3 194.2 +! 12 194.2 196.1 +! 13 196.1 198.0 +! 14 198.0 200.0 < O(3P) + O(3P) +! Shortward of 174.65 the product is O2 + hv => O(3P) + O(1D) +! The QY is assumed to be unity in both wavelength ranges. +! +! ... Lyman Alpha QY +! O2 + hv -> O(3P) + O(3P) at Lyman Alpha has a QY = 0.47 +! O2 + hv -> O(3P) + O(1D) at Lyman Alpha has a QY = 0.53 +! Lacoursiere et al., J. Chem. Phys. 110., 1949-1958, 1999. +!------------------------------------------------------------------------------ +! ... Lyman Alpha +!------------------------------------------------------------------------------ + jo2_lya(:) = etfphot(1)*ro2la(:)*wlintv(1) + + wrk(1:nsrc_tot) = xs_o2src(1:nsrc_tot)*wlintv(1:nsrc_tot) + wrk(1) = 0._r8 +!------------------------------------------------------------------------------ +! ... o2 src photolysis +!------------------------------------------------------------------------------ +#ifdef USE_ESSL + call dgemm( 'N', 'N', nlev, 1, nsrc_tot, & + 1._r8, fnorm, nlev, wrk, nw, & + 0._r8, jo2_src, nlev ) +#else + jo2_src(:) = matmul( fnorm(:,1:nsrc_tot),wrk(1:nsrc_tot) ) +#endif +!------------------------------------------------------------------------------ +! ... o2 srb photolysis +!------------------------------------------------------------------------------ + do k = 1,nlev + wrk(1:nsrb_tot) = xs_o2srb(k,1:nsrb_tot)*wlintv(nsrc_tot+1:nsrc_tot+nsrb_tot) + jo2_srb(k) = dot_product( fnorm(k,nsrc_tot+1:nsrc_tot+nsrb_tot),wrk(1:nsrb_tot) ) + end do + +!------------------------------------------------------------------------------ +! ... total o2 photolysis +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! ... Branch 1, O2 + hv => O(3P) + O(3P); wavelengths >175nm +!------------------------------------------------------------------------------ + jo2_sht(:,1) = jo2_lya(:)*.47_r8 + jo2_srb(:) +!------------------------------------------------------------------------------ +! ... Branch 2, O2 + hv => O(3P) + O(1D); wavelengths <175nm +!------------------------------------------------------------------------------ + jo2_sht(:,2) = jo2_lya(:)*.53_r8 + jo2_src(:) + +!------------------------------------------------------------------------------ +! ... Derive the NO rate constant Minsch. and Siskind, JGR, 98, 20401, 1993 +!------------------------------------------------------------------------------ + call calc_jno( nlev, etfphot_ms93, n2cc, o2scol, o3scol, & + noscol, jno_sht ) + +!------------------------------------------------------------------------------ +! ... Derive addtional rate constants for species with wl < 200 nm.! +! Temperature dependence of the cross sections are not included in this +! version. +!------------------------------------------------------------------------------ +#if defined USE_ESSL + call dgemm( 'N', 'N', nlev, nj, nw, & + 1._r8, fnorm, nlev, xs_wl, nw, & + 0._r8, jsht, nlev ) +#else + jsht(:,:) = matmul( fnorm,xs_wl ) +#endif + + deallocate( fnorm, trans_o2, trans_o3, wrk ) + + end subroutine jshort_photo + + subroutine sphers( nlev, z, zenith_angle, dsdh, nid ) +!=============================================================================! +! Subroutine sphers ! +!=============================================================================! +! PURPOSE: ! +! Calculate slant path over vertical depth ds/dh in spherical geometry. ! +! Calculation is based on: A.Dahlback, and K.Stamnes, A new spheric model ! +! for computing the radiation field available for photolysis and heating ! +! at twilight, Planet.Space Sci., v39, n5, pp. 671-683, 1991 (Appendix B) ! +!=============================================================================! +! PARAMETERS: ! +! NZ - INTEGER, number of specified altitude levels in the working (I) ! +! grid ! +! Z - REAL, specified altitude working grid (km) (I) ! +! ZEN - REAL, solar zenith angle (degrees) (I) ! +! DSDH - REAL, slant path of direct beam through each layer crossed (O) ! +! when travelling from the top of the atmosphere to layer i; ! +! DSDH(i,j), i = 0..NZ-1, j = 1..NZ-1 ! +! NID - INTEGER, number of layers crossed by the direct beam when (O) ! +! travelling from the top of the atmosphere to layer i; ! +! NID(i), i = 0..NZ-1 ! +!=============================================================================! +! EDIT HISTORY: ! +! Original: Taken By Doug Kinnison from Sasha Madronich, TUV Code, V4.1a, ! +! on 1/1/02 ! +!=============================================================================! + + use physconst, only : rearth + + implicit none + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev ! number model vertical levels + integer, intent(out) :: nid(0:nlev) ! see above + real(r8), intent (in) :: zenith_angle ! zenith_angle + real(r8), intent (in) :: z(nlev) ! geometric altitude (km) + real(r8), intent (out) :: dsdh(0:nlev,nlev) ! see above + + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + real(r8) :: radius + real(r8) :: re + real(r8) :: zenrad + real(r8) :: rpsinz + real(r8) :: const0 + real(r8) :: rj + real(r8) :: rjp1 + real(r8) :: dsj + real(r8) :: dhj + real(r8) :: ga + real(r8) :: gb + real(r8) :: sm + real(r8) :: zd(0:nlev-1) + + integer :: i + integer :: j + integer :: k + integer :: id + integer :: nlayer + + + radius = rearth*1.e-3_r8 ! radius earth (km) + +!------------------------------------------------------------------------------ +! ... set zenith angle in radians +!------------------------------------------------------------------------------ + zenrad = zenith_angle*d2r + const0 = sin( zenrad ) + +!------------------------------------------------------------------------------ +! ... set number of layers: +!------------------------------------------------------------------------------ + nlayer = nlev - 1 + +!------------------------------------------------------------------------------ +! ... include the elevation above sea level to the radius of the earth: +!------------------------------------------------------------------------------ + re = radius + z(nlev) + +!------------------------------------------------------------------------------ +! ... inverse coordinate of z +!------------------------------------------------------------------------------ + do k = 0,nlayer + zd(k) = z(k+1) - z(nlev) + end do + +!------------------------------------------------------------------------------ +! ... initialize dsdh(i,j), nid(i) +!------------------------------------------------------------------------------ + nid(:) = 0 + do j = 1,nlev + dsdh(:,j) = 0._r8 + end do + +!------------------------------------------------------------------------------ +! ... calculate ds/dh of every layer +!------------------------------------------------------------------------------ + do i = 0,nlayer + rpsinz = (re + zd(i)) * const0 + if( zenith_angle <= 90._r8 .or. rpsinz >= re ) then +!------------------------------------------------------------------------------ +! Find index of layer in which the screening height lies +!------------------------------------------------------------------------------ + id = i + if( zenith_angle > 90._r8 ) then + do j = 1,nlayer + if( rpsinz < (zd(j-1) + re) .and. rpsinz >= (zd(j) + re) ) then + id = j + exit + end if + end do + end if + + do j = 1,id + sm = 1._r8 + if( j == id .and. id == i .and. zenith_angle > 90._r8 ) then + sm = -1._r8 + end if + rj = re + zd(j-1) + rjp1 = re + zd(j) + dhj = zd(j-1) - zd(j) + ga = max( rj*rj - rpsinz*rpsinz,0._r8 ) + gb = max( rjp1*rjp1 - rpsinz*rpsinz,0._r8 ) + if( id > i .and. j == id ) then + dsj = sqrt( ga ) + else + dsj = sqrt( ga ) - sm*sqrt( gb ) + end if + dsdh(i,j) = dsj / dhj + end do + nid(i) = id + else + nid(i) = -1 + end if + end do + + end subroutine sphers + + subroutine slant_col( nlev, delz, dsdh, nid, absden, scol ) +!=============================================================================! +! PURPOSE: ! +! Derive Column +!=============================================================================! +! PARAMETERS: ! +! NLEV - INTEGER, number of specified altitude levels in the working (I) ! +! grid ! +! DELZ - REAL, specified altitude working grid (km) (I) ! +! DSDH - REAL, slant path of direct beam through each layer crossed (O) ! +! when travelling from the top of the atmosphere to layer i; ! +! DSDH(i,j), i = 0..NZ-1, j = 1..NZ-1 ! +! NID - INTEGER, number of layers crossed by the direct beam when (O) ! +! travelling from the top of the atmosphere to layer i; ! +! NID(i), i = 0..NZ-1 ! +! specified altitude at each specified wavelength ! +! absden - REAL, absorber concentration, molecules cm-3 ! +! SCOL - REAL, absorber Slant Column, molecules cm-2 ! +!=============================================================================! +! EDIT HISTORY: ! +! 09/01 Read in profile from an input file, DEK ! +! 01/02 Taken from Sasha Madronich's TUV code ! +!=============================================================================! + + implicit none + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev + integer, intent(in) :: nid(0:nlev) ! see above + real(r8), intent(in) :: delz(nlev) ! layer thickness (cm) + real(r8), intent(in) :: dsdh(0:nlev,nlev) ! see above + real(r8), intent(in) :: absden(nlev) ! absorber concentration (molec. cm-3) + real(r8), intent(out) :: scol(nlev) ! absorber Slant Column (molec. cm-2) + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + real(r8), parameter :: largest = 1.e+36_r8 + + real(r8) :: sum + real(r8) :: hscale + real(r8) :: numer, denom + real(r8) :: cz(nlev) + + integer :: id + integer :: j + integer :: k + +!------------------------------------------------------------------------------ +! ... compute column increments (logarithmic integrals) +!------------------------------------------------------------------------------ + do k = 1,nlev-1 + if( absden(k) /= 0._r8 .and. absden(k+1) /= 0._r8 ) then + cz(nlev-k) = (absden(k) - absden(k+1))/log( absden(k)/absden(k+1) ) * delz(k) + else + cz(nlev-k) = .5_r8*(absden(k) + absden(k+1)) * delz(k) + end if + end do + +!------------------------------------------------------------------------------ +! ... Include exponential tail integral from infinity to model top +! specify scale height near top of data.For WACCM-X model, scale +! height needs to be increased for higher model top +!------------------------------------------------------------------------------ + if (nlev==pver) then + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + hscale = 20.e5_r8 + else + hscale = 10.e5_r8 + endif + cz(nlev-1) = cz(nlev-1) + hscale * absden(1) + endif + +!------------------------------------------------------------------------------ +! ... Calculate vertical and slant column from each level: +! work downward +!------------------------------------------------------------------------------ + do id = 0,nlev-1 + sum = 0._r8 + if( nid(id) >= 0 ) then +!------------------------------------------------------------------------------ +! ... Single pass layers: +!------------------------------------------------------------------------------ + do j = 1, min(nid(id), id) + sum = sum + cz(nlev-j)*dsdh(id,j) + end do +!------------------------------------------------------------------------------ +! ... Double pass layers: +!------------------------------------------------------------------------------ + do j = min(nid(id),id)+1, nid(id) + sum = sum + 2._r8*cz(nlev-j)*dsdh(id,j) + end do + else + sum = largest + end if + scol(nlev-id) = sum + end do + scol(nlev) = .95_r8*scol(nlev-1) + + end subroutine slant_col + + subroutine lymana( nlev, o2scol, rm, ro2 ) +!-----------------------------------------------------------------------------! +! PURPOSE: ! +! Calculate the effective absorption cross section of O2 in the Lyman-Alpha ! +! bands and an effective O2 optical depth at all altitudes. Parameterized ! +! after: Chabrillat, S., and G. Kockarts, Simple parameterization of the ! +! absorption of the solar Lyman-Alpha line, Geophysical Research Letters, ! +! Vol.24, No.21, pp 2659-2662, 1997. ! +!-----------------------------------------------------------------------------! +! PARAMETERS: ! +! nz - INTEGER, number of specified altitude levels in the working (I) ! +! grid ! +! o2scol - REAL, slant overhead O2 column (molec/cc) at each specified (I) ! +! altitude ! +! dto2la - REAL, optical depth due to O2 absorption at each specified (O) ! +! vertical layer ! +! xso2la - REAL, molecular absorption cross section in LA bands (O) ! +!-----------------------------------------------------------------------------! +! EDIT HISTORY: ! +! 01/15/2002 Taken from Sasha Madronich's TUV Version 4.1a, Doug Kinnison ! ! +! 01/15/2002 Upgraded to F90, DK ! +!-----------------------------------------------------------------------------! + + implicit none + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev + real(r8), intent(in) :: o2scol(nlev) + real(r8), intent(out) :: ro2(nlev) + real(r8), intent(out) :: rm(nlev) + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + real(r8),save :: b(3) + real(r8),save :: c(3) + real(r8),save :: d(3) + real(r8),save :: e(3) + + data b / 6.8431e-01_r8, 2.29841e-01_r8, 8.65412e-02_r8 /, & + c / 8.22114e-21_r8, 1.77556e-20_r8, 8.22112e-21_r8 /, & + d / 6.0073e-21_r8, 4.28569e-21_r8, 1.28059e-20_r8 /, & + e / 8.21666e-21_r8, 1.63296e-20_r8, 4.85121e-17_r8 / + + integer :: i, k + real(r8) :: wrk, term + +!------------------------------------------------------------------------------ +! ... Calculate reduction factors at every altitude +!------------------------------------------------------------------------------ + do k = 1,nlev + wrk = 0._r8 + do i = 1,2 ! pc Dan Marsh + term = e(i)*o2scol(k) + if( term < 100._r8 ) then + wrk = wrk + d(i) * exp( -term ) + end if + end do + ro2(k) = wrk + wrk = 0._r8 + do i = 1,3 + term = c(i)*o2scol(k) + if( term < 100._r8 ) then + wrk = wrk + b(i) * exp( -term ) + end if + end do + rm(k) = wrk + end do + + end subroutine lymana + + subroutine calc_o2srb( nlev, nid, o2col, tlev, tsrb, xscho2 ) +!-----------------------------------------------------------------------------! +! PURPOSE: ! +! Calculate the equivalent absorption cross section of O2 in the SR bands. ! +! The algorithm is based on parameterization of G.A. Koppers, and ! +! D.P. Murtagh [ref. Ann.Geophys., 14 68-79, 1996] ! +! Final values do include effects from the Herzberg continuum. ! +!-----------------------------------------------------------------------------! +! PARAMETERS: ! +! NZ - INTEGER, number of specified altitude levels in the working (I) ! +! grid ! +! O2COL - REAL, slant overhead O2 column (molec/cc) at each specified (I) ! +! altitude ! +! TLEV - tmeperature at each level (I) ! +! TSRB - REAL, transmission for the SRB ! +! XSCHO2 - REAL, molecular absorption cross section in SR bands at (O) ! +! each specified wavelength. Includes Herzberg continuum ! +!-----------------------------------------------------------------------------! +! EDIT HISTORY: Taken from TUV, 1/17/2002 ! +! This code was supplied to TUV by Dan Marsh. ! +!-----------------------------------------------------------------------------! + + implicit none + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev + integer, intent(in) :: nid(0:nlev) + real(r8), intent (in) :: o2col(nlev) + real(r8), intent (in) :: tlev(nlev) + real(r8), intent (out) :: tsrb(nlev,nsrbtuv) + real(r8), intent (out) :: xscho2(nlev,nsrbtuv) + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + integer :: i, k, ktop, ktop1, kbot + real(r8) :: x, dto2 + real(r8) :: den, num + real(r8) :: term1, term2 + real(r8) :: dtsrb(nlev) + real(r8) :: tsrb_rev(nlev,nsrbtuv) + real(r8) :: xs(nsrbtuv) + +!------------------------------------------------------------------------------ +! ... Calculate cross sections +!------------------------------------------------------------------------------ + ktop = nlev + kbot = 0 + + do k = 1,nlev + x = log( o2col(k) ) + if( x >= 38._r8 .and. x <= 56._r8 ) then + call effxs( x, tlev(k), xs ) + xscho2(k,:) = xs(:) + else if( x < 38._r8 ) then + ktop1 = k-1 + ktop = min( ktop1,ktop ) + else if( x > 56._r8 ) then + kbot = k + end if + end do + + if ( kbot == nlev ) then + tsrb(:,:) = 0._r8 + xscho2(:,:) = 0._r8 + return + endif +!------------------------------------------------------ +! ... Fill in cross section where X is out of range +! by repeating edge table values +!------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + + ! Need to be careful with nlev values for kbot and ktop. + ! This was handled by Hanli Liu fix. + if ( kbot < nlev ) then + do k = 1,kbot + xscho2(k,:) = xscho2(kbot+1,:) + end do + if (ktop < nlev) then + do k = ktop+1,nlev + xscho2(k,:) = xscho2(ktop,:) + end do + else + xscho2(nlev,:) = 2.0e-19_r8 + endif + else + do k = 1,kbot + xscho2(k,:) = 2.0e-19_r8 + enddo + endif + + else + do k = 1,kbot + xscho2(k,:) = xscho2(kbot+1,:) + end do + do k = ktop+1,nlev + xscho2(k,:) = xscho2(ktop,:) + end do + endif + +!------------------------------------------------------- +! ... Calculate incremental optical depths +!------------------------------------------------------- + do i = 1,nsrbtuv + do k = 1,nlev-1 + if( nid(nlev-k) /= -1 ) then +!------------------------------------------------------- +! ... Calculate an optical depth weighted by density +!------------------------------------------------------- + num = xscho2(k+1,i)*o2col(k+1) - xscho2(k,i)*o2col(k) + if( num == 0._r8 ) then + write(iulog,*) 'calc_o2srb : o2col(k:k+1),xscho2(k:k+1,i) = ',o2col(k:k+1),xscho2(k:k+1,i),' @ i,k = ',i,k + end if + term1 = log( xscho2(k+1,i)/xscho2(k,i) ) + term2 = log( o2col(k+1)/o2col(k) ) + if( term2 == 0._r8 ) then + write(iulog,*) 'calc_o2srb : o2col(k:k+1),xscho2(k:k+1,i) = ',o2col(k:k+1),xscho2(k:k+1,i),' @ i,k = ',i,k + call endrun + end if + den = 1._r8 + log( xscho2(k+1,i)/xscho2(k,i) )/log( o2col(k+1)/o2col(k) ) + dto2 = abs(num/den) + if( dto2 < 100._r8 ) then + dtsrb(k) = exp( -dto2 ) + else + dtsrb(k) = 0._r8 + end if + else + dtsrb(k) = 0._r8 + end if + end do +!----------------------------------------------- +! ... Calculate Transmission for SRB +!----------------------------------------------- + if (nlev==pver) then ! waccm + tsrb(nlev,i) = 1._r8 + do k = nlev-1,1,-1 + tsrb(k,i) = tsrb(k+1,i)*dtsrb(k) + end do + else ! cam-chem + tsrb(nlev,i) = exp(-xscho2(nlev,i)*o2col(nlev)) + do k = nlev-1,1,-1 + tsrb(k,i) = tsrb(k+1,i)*dtsrb(k) + end do + endif + + end do + + end subroutine calc_o2srb + + subroutine effxs( x, t, xs ) +!------------------------------------------------------------- +! Subroutine for evaluating the effective cross section +! of O2 in the Schumann-Runge bands using parameterization +! of G.A. Koppers, and D.P. Murtagh [ref. Ann.Geophys., 14 +! 68-79, 1996] +! +! method: +! ln(xs) = A(X)[T-220]+B(X) +! X = log of slant column of O2 +! A,B calculated from chebyshev polynomial coeffs +! AC and BC using NR routine chebev. Assume interval +! is 38 0._r8 ) then + write(iulog,*) 'x not in range in chebev', x + jchebev = 0._r8 + return + end if + + d = 0._r8 + dd = 0._r8 + y = (2._r8*x - a - b)/(b - a) + y2 = 2._r8*y + do j = m,2,-1 + sv = d + d = y2*d - dd + c(j) + dd = sv + end do + + jchebev = y*d - dd + .5_r8*c(1) + + end function jchebev + + end subroutine calc_params + + subroutine calc_jno( nlev, etfphot_ms93, n2cc, o2scol, o3scol, & + noscol, jno ) +!-----------------------------------------------------------------------------! +! PURPOSE: ! +! Compute the total photolytic rate constant for NO in the SR bands ! +! - following the approach of Minshwanner and Siskind, JGR, ! +! 98, D11, 20401-20412, 1993. ! +! ! +!-----------------------------------------------------------------------------! +! PARAMETERS: ! +! NZ - INTEGER, number of specified altitude levels ! +! ! +! etfphot_ms93 - Extraterrestrial Flux, within the MS 1993 Grid ! +! units of photons cm-2 sec-1 nm-1 ! +! n2cc - N2 conc (molecules cm-3) ! +! o3scol - Ozone Slant Column (molecules cm-2) ! +! o2scol - Oxygen Slant Column (molecules cm-2) ! +! noscol - Nitric Oxide Slant Column(molecules cm-2) ! +! ! +! LOCAL VARIABLES: ! +! tauo3 - Transmission factor in the Hartley Band of O3 ! +! etfphot_ms93 - Solar Irr. on Minschwaner and Siskind 1993 (MS93) Grid ! +! xs_o3ms93 - O3 cross section on the MS93 Grid ! +! ! +! OUTPUT VARIABLES: ! +! jno - photolytic rate constant ! +! each specified altitude ! +! ! +!-----------------------------------------------------------------------------! +! EDIT HISTORY: ! +! 08/01 Created, Doug Kinnison, NCAR, ACD ! +!-----------------------------------------------------------------------------! + + implicit none + +!------------------------------------------------------------------------------ +! ... Dummy arguments +!------------------------------------------------------------------------------ + integer, intent(in) :: nlev + real(r8), intent(in) :: etfphot_ms93(num_ms93tuv) + real(r8), intent(in) :: n2cc(nlev) + real(r8), intent(in) :: o3scol(nlev) + real(r8), intent(in) :: o2scol(nlev) + real(r8), intent(in) :: noscol(nlev) + real(r8), intent(out) :: jno(nlev) + +!------------------------------------------------------------------------------ +! ... Local variables +!------------------------------------------------------------------------------ + integer :: i, iw, lev + real(r8) :: jno50 + real(r8) :: jno90 + real(r8) :: jno100 + real(r8) :: tauo3(nlev,num_ms93tuv) + +!------------------------------------------------------------------------------ +! ... O3 SRB Cross Sections from WMO 1985, interpolated onto MS, 1993 grid +!------------------------------------------------------------------------------ + real(r8), save :: xso3_ms93(num_ms93tuv) = (/ 7.3307600e-19_r8, 6.9660105E-19_r8, 5.9257699E-19_r8, 4.8372219E-19_r8 /) + +!------------------------------------------------------------------------------ +! ... delta wavelength of the MS, 1993 grid +!------------------------------------------------------------------------------ + real(r8), save :: wlintv_ms93(num_ms93tuv) = (/ 1.50_r8, 1.50_r8, 5.6_r8, 2.3_r8 /) + +!------------------------------------------------------------------------------ +! ... O2 SRB Cross Sections for the six ODF regions, MS, 1993 +!------------------------------------------------------------------------------ + real(r8), save :: cs250(6) = (/ 1.117e-23_r8, 2.447e-23_r8, 7.188e-23_r8, 3.042e-22_r8, 1.748e-21_r8, 1.112e-20_r8 /) + real(r8), save :: cs290(6) = (/ 1.350e-22_r8, 2.991e-22_r8, 7.334e-22_r8, 3.074e-21_r8, 1.689e-20_r8, 1.658e-19_r8 /) + real(r8), save :: cs2100(6) = (/ 2.968e-22_r8, 5.831e-22_r8, 2.053e-21_r8, 8.192e-21_r8, 4.802e-20_r8, 2.655e-19_r8 /) + +!------------------------------------------------------------------------------ +! ... derive tauo3 for the three o2 srb +! ... iw = 1,2, and 4 are used below for jno +!------------------------------------------------------------------------------ + do iw = 1,num_ms93tuv + tauo3(:,iw) = exp( -xso3_ms93(iw)*o3scol(:) ) + end do + +!------------------------------------------------------------------------------ +! ... Call PJNO Function to derive SR Band JNO contributions +! Called in order of wavelength interval (shortest firs) +!------------------------------------------------------------------------------ + do lev = 1,nlev + jno100 = pjno( 1, cs2100, wtno100, csno100 ) + jno90 = pjno( 2, cs290, wtno90, csno90 ) + jno50 = pjno( 4, cs250, wtno50, csno50 ) + jno(lev) = jno50 + jno90 + jno100 + end do + + contains + + function pjno( w, cso2, wtno, csno ) +!------------------------------------------------------------------------------ +! ... uses xsec at center of g subinterval for o2 +! uses mean values for no +!------------------------------------------------------------------------------ + implicit none + +!------------------------------------------------------------------------------ +! ... parameters +!------------------------------------------------------------------------------ + integer, parameter :: ngint = 6 + integer, parameter :: nno = 2 + +!---------------------------------------------------------------- +! ... Dummy arguments +!---------------------------------------------------------------- + integer, intent(in) :: w + real(r8), intent(in) :: cso2(ngint) + real(r8), intent(in) :: csno(ngint,nno) + real(r8), intent(in) :: wtno(ngint,nno) + +!---------------------------------------------------------------- +! ... Function declarations +!---------------------------------------------------------------- + real(r8) :: pjno + +!---------------------------------------------------------------- +! ... Local variables +!---------------------------------------------------------------- + integer :: jj, i, k + real(r8) :: tauno + real(r8) :: transno + real(r8) :: transo2 + real(r8) :: tauo2 + real(r8) :: jno + real(r8) :: jno1 + +!---------------------------------------------------------------- +! ... derive the photolysis frequency for no within a given +! srb (i.e., 5-0, 9-0, 10-0) +!---------------------------------------------------------------- + jno = 0._r8 + do k = 1,ngint + tauo2 = o2scol(lev) * cso2(k) + if( tauo2 < 50._r8 ) then + transo2 = exp( -tauo2 ) + else + transo2 = 0._r8 + end if + jno1 = 0._r8 + do jj = 1,nno + tauno = noscol(lev)*csno(k,jj) + if( tauno < 50._r8 ) then + transno = exp( -tauno ) + else + transno = 0._r8 + end if + jno1 = jno1 + csno(k,jj) * wtno(k,jj) * transno + end do + jno = jno + jno1*transo2 + end do + + pjno = wlintv_ms93(w)*etfphot_ms93(w)*tauo3(lev,w)*jno + +!---------------------------------------------------------------- +! ... correct for the predissociation of the deltq 1-0 +! transition in the srb (5-0) +!---------------------------------------------------------------- + if( w == 4 ) then + pjno = 1.65e9_r8/(5.1e7_r8 + 1.65e9_r8 + (1.5e-9_r8*n2cc(nlev-lev+1)))*pjno + end if + + end function pjno + + end subroutine calc_jno + + end module mo_jshort diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 new file mode 100644 index 0000000000..66fc6305cc --- /dev/null +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -0,0 +1,403 @@ +module mo_lightning + !---------------------------------------------------------------------- + ! ... the lightning module + !---------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : begchunk, endchunk, pcols, pver + use phys_grid, only : ngcols_p + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use spmd_utils, only : masterproc, mpicom + + implicit none + + private + public :: lightning_inti + public :: lightning_no_prod + public :: prod_no + + save + + real(r8) :: csrf + real(r8) :: factor = 0.1_r8 ! user-controlled scaling factor to achieve arbitrary no prod. + real(r8) :: geo_factor ! grid cell area factor + real(r8) :: vdist(16,3) ! vertical distribution of lightning + real(r8), allocatable :: prod_no(:,:,:) + real(r8), allocatable :: glob_prod_no_col(:,:) + real(r8), allocatable :: flash_freq(:,:) + integer :: no_ndx,xno_ndx + logical :: has_no_lightning_prod = .false. + +contains + + subroutine lightning_inti( lght_no_prd_factor ) + !---------------------------------------------------------------------- + ! ... initialize the lightning module + !---------------------------------------------------------------------- + use mo_constants, only : pi + use ioFileMod, only : getfil + use mo_chem_utls, only : get_spc_ndx + + use cam_history, only : addfld, add_default, horiz_only + use dyn_grid, only : get_dyn_grid_parm + use phys_control, only : phys_getopts + + implicit none + + !---------------------------------------------------------------------- + ! ... dummy args + !---------------------------------------------------------------------- + real(r8), intent(in) :: lght_no_prd_factor ! lightning no production factor + + !---------------------------------------------------------------------- + ! ... local variables + !---------------------------------------------------------------------- + integer :: astat + integer :: ncid + integer :: dimid + integer :: vid + integer :: gndx + integer :: jl, ju + integer :: nlat, nlon + integer :: plon, plat + real(r8), allocatable :: lats(:) + real(r8), allocatable :: lons(:) + real(r8), allocatable :: landmask(:,:) + character(len=256) :: locfn + logical :: history_cesm_forcing + + call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) + + no_ndx = get_spc_ndx('NO') + xno_ndx = get_spc_ndx('XNO') + + has_no_lightning_prod = no_ndx>0 .or. xno_ndx>0 + if (.not.has_no_lightning_prod) return + + + if( lght_no_prd_factor /= 1._r8 ) then + factor = factor*lght_no_prd_factor + end if + + + if (masterproc) write(iulog,*) 'lght_inti: lightning no production scaling factor = ',factor + + !---------------------------------------------------------------------- + ! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) + ! km for profile itype + !---------------------------------------------------------------------- + vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont + 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) + vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine + 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) + vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont + 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) + + allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat + call endrun + end if + allocate( flash_freq(pcols,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'lght_inti: failed to allocate flash_freq; error = ',astat + call endrun + end if + allocate( glob_prod_no_col(pcols,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'lght_inti: failed to allocate glob_prod_no_col; error = ',astat + call endrun + end if + prod_no(:,:,:) = 0._r8 + flash_freq(:,:) = 0._r8 + geo_factor = ngcols_p/(4._r8*pi) + + + call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) + call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) + call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height + call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone + call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + + if ( history_cesm_forcing ) then + call add_default('LNO_COL_PROD',1,' ') + endif + + end subroutine lightning_inti + + subroutine lightning_no_prod( state, pbuf2d, cam_in ) + !---------------------------------------------------------------------- + ! ... set no production from lightning + !---------------------------------------------------------------------- + use physics_types, only : physics_state + + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use physconst, only : rga + use phys_grid, only : get_rlat_all_p, get_lat_all_p, get_lon_all_p, get_wght_all_p + use cam_history, only : outfld + use camsrfexch, only : cam_in_t + use shr_reprosum_mod, only : shr_reprosum_calc + use mo_constants, only : rearth, d2r + implicit none + + !---------------------------------------------------------------------- + ! ... dummy args + !---------------------------------------------------------------------- + type(physics_state), intent(in) :: state(begchunk:endchunk) ! physics state + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state + + !---------------------------------------------------------------------- + ! ... local variables + !---------------------------------------------------------------------- + real(r8), parameter :: land = 1._r8 + real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 + + integer :: i, c + integer :: cldtind ! level index for cloud top + integer :: cldbind ! level index for cloud base > 273k + integer :: surf_type + integer :: file ! file index + integer :: k, kk, zlow_ind, zhigh_ind, itype + real(r8) :: glob_flashfreq ! global flash frequency [s-1] + real(r8) :: glob_noprod ! global rate of no production [as tgn/yr] + real(r8) :: frac_sum ! work variable + real(r8) :: zlow + real(r8) :: zhigh + real(r8) :: zlow_scal + real(r8) :: zhigh_scal + real(r8) :: fraction + real(r8) :: dchgz + real(r8) :: dchgzone(pcols,begchunk:endchunk) ! depth of discharge zone [km] + real(r8) :: cldhgt(pcols,begchunk:endchunk) ! cloud top height [km] + real(r8) :: cgic(pcols,begchunk:endchunk) ! cloud-ground/intracloud discharge ratio + real(r8) :: flash_energy(pcols,begchunk:endchunk) ! energy of flashes per second + real(r8) :: prod_no_col(pcols,begchunk:endchunk) ! global no production rate for diagnostics + real(r8) :: wrk, wrk1, wrk2(1) + integer :: ncol ! columns per chunk + integer :: lchnk ! columns per chunk + real(r8),pointer :: cldtop(:) ! cloud top level index + real(r8),pointer :: cldbot(:) ! cloud bottom level index + real(r8) :: zmid(pcols,pver) ! geopot height above surface at midpoints (m) + real(r8) :: zint(pcols,pver+1,begchunk:endchunk) ! geopot height above surface at interfaces (m) + real(r8) :: zsurf(pcols) ! geopot height above surface at interfaces (m) + real(r8) :: rlats(pcols,begchunk:endchunk) ! column latitudes in chunks + real(r8) :: wght(pcols) + + !---------------------------------------------------------------------- + ! ... parameters to determine cg/ic ratio [price and rind, 1993] + !---------------------------------------------------------------------- + real(r8), parameter :: ca = .021_r8 + real(r8), parameter :: cb = -.648_r8 + real(r8), parameter :: cc = 7.49_r8 + real(r8), parameter :: cd = -36.54_r8 + real(r8), parameter :: ce = 64.09_r8 + real(r8), parameter :: t0 = 273._r8 + real(r8), parameter :: m2km = 1.e-3_r8 + real(r8), parameter :: km2cm = 1.e5_r8 + real(r8), parameter :: lat25 = 25._r8*d2r ! 25 degrees latitude in radians + integer :: cldtop_ndx, cldbot_ndx + integer :: istat + real(r8) :: flash_freq_land, flash_freq_ocn + + if (.not.has_no_lightning_prod) return + + !---------------------------------------------------------------------- + ! ... initialization + !---------------------------------------------------------------------- + + flash_freq(:,:) = 0._r8 + prod_no(:,:,:) = 0._r8 + prod_no_col(:,:) = 0._r8 + cldhgt(:,:) = 0._r8 + dchgzone(:,:) = 0._r8 + cgic(:,:) = 0._r8 + flash_energy(:,:) = 0._r8 + glob_prod_no_col(:,:) = 0._r8 + + cldtop_ndx = pbuf_get_index('CLDTOP') + cldbot_ndx = pbuf_get_index('CLDBOT') + + !-------------------------------------------------------------------------------- + ! ... estimate flash frequency and resulting no emissions + ! [price, penner, prather, 1997 (jgr)] + ! lightning only occurs in convective clouds with a discharge zone, i.e. + ! an altitude range where liquid water, ice crystals, and graupel coexist. + ! we test this by examining the temperature at the cloud base. + ! it is assumed that only one thunderstorm occurs per grid box, and its + ! flash frequency is determined by the maximum cloud top height (not the + ! depth of the discharge zone). this is somewhat speculative but yields + ! reasonable results. + ! + ! the cg/ic ratio is determined by an empirical formula from price and + ! rind [1993]. the average energy of a cg flash is estimated as 6.7e9 j, + ! and the average energy of a ic flash is assumed to be 1/10 of that value. + ! the no production rate is assumed proportional to the discharge energy + ! with 1e17 n atoms per j. the total number of n atoms is then distributed + ! over the complete column of grid boxes. + !-------------------------------------------------------------------------------- + Chunk_loop : do c = begchunk,endchunk + ncol = state(c)%ncol + lchnk = state(c)%lchnk + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldbot_ndx, cldbot ) + zsurf(:ncol) = state(c)%phis(:ncol)*rga + call get_rlat_all_p( c, ncol, rlats(1,c) ) + call get_wght_all_p(c, ncol, wght) + + do k = 1,pver + zmid(:ncol,k) = state(c)%zm(:ncol,k) + zsurf(:ncol) + zint(:ncol,k,c) = state(c)%zi(:ncol,k) + zsurf(:ncol) + end do + zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) + + col_loop : do i = 1,ncol + !-------------------------------------------------------------------------------- + ! ... find cloud top and bottom level above 273k + !-------------------------------------------------------------------------------- + cldtind = nint( cldtop(i) ) + cldbind = nint( cldbot(i) ) + do + if( cldbind <= cldtind .or. state(c)%t(i,cldbind) < t0 ) then + exit + end if + cldbind = cldbind - 1 + end do + cloud_layer : if( cldtind < pver .and. cldtind > 0 .and. cldtind < cldbind ) then + !-------------------------------------------------------------------------------- + ! ... compute cloud top height and depth of charging zone + !-------------------------------------------------------------------------------- + cldhgt(i,c) = m2km*max( 0._r8,zint(i,cldtind,c) ) + dchgz = cldhgt(i,c) - m2km*zmid(i,cldbind) + dchgzone(i,c) = dchgz + !-------------------------------------------------------------------------------- + ! ... compute flash frequency for given cloud top height + ! (flashes storm^-1 min^-1) + !-------------------------------------------------------------------------------- + flash_freq_land = 3.44e-5_r8 * cldhgt(i,c)**4.9_r8 + flash_freq_ocn = 6.40e-4_r8 * cldhgt(i,c)**1.7_r8 + flash_freq(i,c) = cam_in(c)%landfrac(i)*flash_freq_land + & + cam_in(c)%ocnfrac(i) *flash_freq_ocn + + !-------------------------------------------------------------------------------- + ! ... compute cg/ic ratio + ! cgic = proportion of cg flashes (=pg from ppp paper) + !-------------------------------------------------------------------------------- + cgic(i,c) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) + if( dchgz < 5.5_r8 ) then + cgic(i,c) = 0._r8 + else if( dchgz > 14._r8 ) then + cgic(i,c) = .02_r8 + end if + !-------------------------------------------------------------------------------- + ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) + ! and convert to total energy per second + ! set ic = cg + !-------------------------------------------------------------------------------- + flash_energy(i,c) = 6.7e9_r8 * flash_freq(i,c)/60._r8 + !-------------------------------------------------------------------------------- + ! ... LKE Aug 23, 2005: scale production to account for different grid + ! box sizes. This requires a reduction in the overall fudge factor + ! (e.g., from 1.2 to 0.5) + !-------------------------------------------------------------------------------- + flash_energy(i,c) = flash_energy(i,c) * wght(i) * geo_factor + !-------------------------------------------------------------------------------- + ! ... compute number of n atoms produced per second + ! and convert to n atoms per second per cm2 and apply fudge factor + !-------------------------------------------------------------------------------- + prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c)/(1.e4_r8*rearth*rearth*wght(i)) * factor + + !-------------------------------------------------------------------------------- + ! ... compute global no production rate in tgn/yr: + ! tgn per second: * 14.00674 * 1.65979e-24 * 1.e-12 + ! nb: 1.65979e-24 = 1/avo + ! tgn per year: * secpyr + !-------------------------------------------------------------------------------- + glob_prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c) & + * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor + + end if cloud_layer + end do Col_loop + end do Chunk_loop + !-------------------------------------------------------------------------------- + ! ... Accumulate global total, convert to flashes per second + ! ... Accumulate global NO production rate + !-------------------------------------------------------------------------------- + kk = pcols*(endchunk-begchunk+1) + call shr_reprosum_calc( flash_freq, wrk2,kk,kk,1, commid=mpicom) + glob_flashfreq=wrk2(1)/60._r8 + call shr_reprosum_calc( glob_prod_no_col, wrk2,kk,kk,1, commid=mpicom) + glob_noprod = wrk2(1) + if( masterproc ) then + write(iulog,*) ' ' + write(iulog,'(''Global flash freq (/s), lightning NOx (TgN/y) = '',2f10.4)') & + glob_flashfreq, glob_noprod + end if + + if( glob_noprod > 0._r8 ) then + !-------------------------------------------------------------------------------- + ! ... Distribute production up to cloud top [Pickering et al., 1998 (JGR)] + !-------------------------------------------------------------------------------- + do c = begchunk,endchunk + ncol = state(c)%ncol + lchnk = state(c)%lchnk + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) + do i = 1,ncol + cldtind = nint( cldtop(i) ) + if( prod_no_col(i,c) > 0._r8 ) then + if( cldhgt(i,c) > 0._r8 ) then + if( abs( rlats(i,c) ) > lat25 ) then + itype = 1 ! midlatitude continental + else if( nint( cam_in(c)%landfrac(i) ) == land ) then + itype = 3 ! tropical continental + else + itype = 2 ! topical marine + end if + frac_sum = 0._r8 + do k = cldtind,pver + zlow = zint(i,k+1,c) * m2km ! lower interface height (km) + zlow_scal = zlow * 16._r8/cldhgt(i,c) ! scale to 16 km convection height + zlow_ind = max( 1,INT(zlow_scal)+1 ) ! lowest vdist index to include in layer + zhigh = zint(i,k,c) * m2km ! upper interface height (km) + zhigh_scal = zhigh * 16._r8/cldhgt(i,c) ! height (km) scaled to 16km convection height + zhigh_ind = max( 1,MIN( 16,INT(zhigh_scal)+1 ) ) ! highest vdist index to include in layer + do kk = zlow_ind,zhigh_ind + wrk = kk + wrk1 = kk - 1 + fraction = min( zhigh_scal,wrk ) & ! fraction of vdist in this model layer + - max( zlow_scal,wrk1 ) + fraction = max( 0._r8, min( 1._r8,fraction ) ) + frac_sum = frac_sum + fraction*vdist(kk,itype) + prod_no(i,k,c) = prod_no(i,k,c) & ! sum the fraction of column NOx in layer k + + fraction*vdist(kk,itype)*.01_r8 + end do + prod_no(i,k,c) = prod_no_col(i,c) * prod_no(i,k,c) & ! multiply fraction by column amount + / (km2cm*(zhigh - zlow)) ! and convert to atom N cm^-3 s^-1 + end do + end if + end if + end do + end do + end if + + !-------------------------------------------------------------------------------- + ! ... output lightning no production to history file + !-------------------------------------------------------------------------------- + do c = begchunk,endchunk + lchnk = state(c)%lchnk + call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) + call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) + call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) + call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) + call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) + call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) + call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) + enddo + + end subroutine lightning_no_prod + +end module mo_lightning diff --git a/src/chemistry/mozart/mo_lymana.F90 b/src/chemistry/mozart/mo_lymana.F90 new file mode 100644 index 0000000000..71db02ab30 --- /dev/null +++ b/src/chemistry/mozart/mo_lymana.F90 @@ -0,0 +1,97 @@ + + module mo_lymana + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + integer, parameter :: nla = 2 + + contains + + subroutine lymana( o2col, secchi, dto2la, xso2la ) +!----------------------------------------------------------------------------- +! purpose: +! calculate the effective absorption cross section of o2 in the lyman-alpha +! bands and an effective o2 optical depth at all altitudes. parameterized +! after: chabrillat, s., and g. kockarts, simple parameterization of the +! absorption of the solar lyman-alpha line, geophysical research letters, +! vol.24, no.21, pp 2659-2662, 1997. +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! o2col - real, slant overhead o2 column (molec/cc) at each specified (i) +! altitude +! dto2la - real, optical depth due to o2 absorption at each specified (o) +! vertical layer +! xso2la - real, molecular absorption cross section in la bands (o) +!----------------------------------------------------------------------------- + + use mo_params + use ppgrid, only: pver, pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: o2col(pverp) + real(r8), intent(in) :: secchi(pverp) + real(r8), intent(out) :: dto2la(pver,nla-1) + real(r8), intent(out) :: xso2la(pverp,nla-1) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, k, kp1 + real(r8), dimension(pverp) :: rm, ro2 + real(r8), save :: b(3), c(3), d(3), e(3) + + data b / 6.8431e-01_r8, 2.29841e-01_r8, 8.65412e-02_r8/, & + c /8.22114e-21_r8, 1.77556e-20_r8, 8.22112e-21_r8/, & + d / 6.0073e-21_r8, 4.28569e-21_r8, 1.28059e-20_r8/, & + e /8.21666e-21_r8, 1.63296e-20_r8, 4.85121e-17_r8/ + +!----------------------------------------------------------------------------- +! ... calculate reduction factors at every altitude +!----------------------------------------------------------------------------- + rm(:) = 0._r8 + ro2(:) = 0._r8 + do k = 1,pverp + do i = 1,3 + rm(k) = rm(k) + b(i) * exp( -c(i)*o2col(k) ) + ro2(k) = ro2(k) + d(i) * exp( -e(i)*o2col(k) ) + end do + end do + +!----------------------------------------------------------------------------- +! ... calculate effective o2 optical depths and effective o2 cross sections +!----------------------------------------------------------------------------- + do k = 1,pver + if( rm(k) > 1.e-100_r8 ) then + kp1 = k + 1 + if( rm(kp1) > 0._r8 ) then + dto2la(k,1) = log( rm(kp1) )/secchi(kp1) - log( rm(k) )/secchi(k) + else + dto2la(k,1) = 1000._r8 + end if + else + dto2la(k,1) = 1000._r8 + end if + end do + do k = 1,pverp + if( rm(k) > 1.e-100_r8 ) then + if( ro2(k) > 1.e-100_r8 ) then + xso2la(k,1) = ro2(k)/rm(k) + else + xso2la(k,1) = 0._r8 + end if + else + xso2la(k,1) = 0._r8 + end if + end do + + end subroutine lymana + + end module mo_lymana diff --git a/src/chemistry/mozart/mo_mass_xforms.F90 b/src/chemistry/mozart/mo_mass_xforms.F90 new file mode 100644 index 0000000000..473bbdc996 --- /dev/null +++ b/src/chemistry/mozart/mo_mass_xforms.F90 @@ -0,0 +1,222 @@ +module mo_mass_xforms + + use ppgrid, only : pcols, pver + use shr_kind_mod, only : r8 => shr_kind_r8 + + + private + public :: mmr2vmr, mmr2vmri, vmr2mmr, vmr2mmri, h2o_to_vmr, h2o_to_mmr, init_mass_xforms + save + + real(r8) :: adv_mass_h2o = 18._r8 + +contains + + subroutine init_mass_xforms + use mo_chem_utls, only : get_spc_ndx + use chem_mods, only : adv_mass + + implicit none + + integer :: id_h2o + + id_h2o = get_spc_ndx('H2O') + + if ( id_h2o > 0 ) then + adv_mass_h2o = adv_mass(id_h2o) + else + adv_mass_h2o = 18._r8 + endif + + endsubroutine init_mass_xforms + + subroutine mmr2vmr( mmr, vmr, mbar, ncol ) + !----------------------------------------------------------------- + ! ... Xfrom from mass to volume mixing ratio + !----------------------------------------------------------------- + + use chem_mods, only : adv_mass, gas_pcnst + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: mmr(ncol,pver,gas_pcnst) + real(r8), intent(inout) :: vmr(ncol,pver,gas_pcnst) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m + + do m = 1,gas_pcnst + if( adv_mass(m) /= 0._r8 ) then + do k = 1,pver + vmr(:ncol,k,m) = mbar(:ncol,k) * mmr(:ncol,k,m) / adv_mass(m) + end do + end if + end do + + end subroutine mmr2vmr + + subroutine mmr2vmri( mmr, vmr, mbar, mi, ncol ) + !----------------------------------------------------------------- + ! ... Xfrom from mass to volume mixing ratio + !----------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: mi + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: mmr(ncol,pver) + real(r8), intent(inout) :: vmr(ncol,pver) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k + real(r8) :: rmi + + rmi = 1._r8/mi + do k = 1,pver + vmr(:ncol,k) = mbar(:ncol,k) * mmr(:ncol,k) * rmi + end do + + end subroutine mmr2vmri + + subroutine vmr2mmr( vmr, mmr, mbar, ncol ) + !----------------------------------------------------------------- + ! ... Xfrom from volume to mass mixing ratio + !----------------------------------------------------------------- + + use m_spc_id + use chem_mods, only : adv_mass, gas_pcnst + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) + real(r8), intent(inout) :: mmr(ncol,pver,gas_pcnst) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m + + !----------------------------------------------------------------- + ! ... The non-group species + !----------------------------------------------------------------- + do m = 1,gas_pcnst + if( adv_mass(m) /= 0._r8 ) then + do k = 1,pver + mmr(:ncol,k,m) = adv_mass(m) * vmr(:ncol,k,m) / mbar(:ncol,k) + end do + end if + end do + + end subroutine vmr2mmr + + subroutine vmr2mmri( vmr, mmr, mbar, mi, ncol ) + !----------------------------------------------------------------- + ! ... Xfrom from volume to mass mixing ratio + !----------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: mi + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: vmr(ncol,pver) + real(r8), intent(inout) :: mmr(ncol,pver) + + !----------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------- + integer :: k, m + + !----------------------------------------------------------------- + ! ... mass to volume mixing for individual species + !----------------------------------------------------------------- + do k = 1,pver + mmr(:ncol,k) = mi * vmr(:ncol,k) / mbar(:ncol,k) + end do + + end subroutine vmr2mmri + + subroutine h2o_to_vmr( h2o_mmr, h2o_vmr, mbar, ncol ) + !----------------------------------------------------------------------- + ! ... Transform water vapor from mass to volumetric mixing ratio + !----------------------------------------------------------------------- + + use chem_mods, only : adv_mass + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), dimension(ncol,pver), intent(in) :: & + h2o_mmr ! specific humidity ( mmr ) + real(r8), dimension(ncol,pver), intent(in) :: & + mbar ! atmos mean mass + real(r8), dimension(ncol,pver), intent(out) :: & + h2o_vmr ! water vapor vmr + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: k + + do k = 1,pver + h2o_vmr(:ncol,k) = mbar(:ncol,k) * h2o_mmr(:ncol,k) / adv_mass_h2o + end do + + end subroutine h2o_to_vmr + + subroutine h2o_to_mmr( h2o_vmr, h2o_mmr, mbar, ncol ) + !----------------------------------------------------------------------- + ! ... Transform water vapor from volumetric to mass mixing ratio + !----------------------------------------------------------------------- + + use chem_mods, only : adv_mass + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), dimension(ncol,pver), intent(in) :: & + mbar ! atmos mean mass + real(r8), dimension(ncol,pver), intent(in) :: & + h2o_vmr ! water vapor vmr + real(r8), dimension(ncol,pver), intent(out) :: & + h2o_mmr ! specific humidity ( mmr ) + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: k + + do k = 1,pver + h2o_mmr(:ncol,k) = h2o_vmr(:ncol,k) * adv_mass_h2o / mbar(:ncol,k) + end do + + end subroutine h2o_to_mmr + +end module mo_mass_xforms diff --git a/src/chemistry/mozart/mo_mean_mass.F90 b/src/chemistry/mozart/mo_mean_mass.F90 new file mode 100644 index 0000000000..8bf030ce02 --- /dev/null +++ b/src/chemistry/mozart/mo_mean_mass.F90 @@ -0,0 +1,94 @@ + +module mo_mean_mass + + implicit none + + private + public :: set_mean_mass, init_mean_mass + + integer :: id_o2, id_o, id_h, id_n + +contains + + subroutine init_mean_mass + use mo_chem_utls, only : get_spc_ndx + + implicit none + + id_o2 = get_spc_ndx('O2') + id_o = get_spc_ndx('O') + id_h = get_spc_ndx('H') + id_n = get_spc_ndx('N') + + endsubroutine init_mean_mass + + subroutine set_mean_mass( ncol, mmr, mbar ) + !----------------------------------------------------------------- + ! ... Set the invariant densities (molecules/cm**3) + !----------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pver, pcols + use chem_mods, only : adv_mass, gas_pcnst + use physconst, only : mwdry ! molecular weight of dry air + use cam_abortutils, only : endrun + use phys_control, only : waccmx_is !WACCM-X runtime switch + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) ! species concentrations (kg/kg) + real(r8), intent(out) :: mbar(:,:) ! mean mass (g/mole) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k + real(r8) :: xn2(ncol) ! n2 mmr + real(r8) :: fn2(ncol) ! n2 vmr + real(r8) :: fo(ncol) ! o vmr + real(r8) :: fo2(ncol) ! o2 vmr + real(r8) :: fh(ncol) ! h vmr + real(r8) :: ftot(ncol) ! total vmr + real(r8) :: mean_mass(ncol) ! wrk variable + + logical :: fixed_mbar ! Fixed mean mass flag + + !------------------------------------------- + ! Mean mass not fixed for WACCM-X + !------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + fixed_mbar = .false. + else + fixed_mbar = .true. + endif + + if( fixed_mbar ) then + !----------------------------------------------------------------- + ! ... use CAM meam molecular weight + !----------------------------------------------------------------- + mbar(:ncol,:pver) = mwdry + else + if ( id_o2 > 0 .and. id_o > 0 .and. id_h > 0 .and. id_n > 0 ) then + !----------------------------------------------------------------- + ! ... set the mean mass + !----------------------------------------------------------------- + do k = 1,pver + xn2(:) = 1._r8 - (mmr(:ncol,k,id_o2) + mmr(:ncol,k,id_o) + mmr(:ncol,k,id_h)) + fn2(:) = .5_r8 * xn2(:) / adv_mass(id_n) + fo2(:) = mmr(:ncol,k,id_o2) / adv_mass(id_o2) + fo(:) = mmr(:ncol,k,id_o) / adv_mass(id_o) + fh(:) = mmr(:ncol,k,id_h) / adv_mass(id_h) + mbar(:ncol,k) = 1._r8 / (fn2(:) + fo2(:) + fo(:) + fh(:)) + end do + else + call endrun('set_mean_mass: not able to compute mean mass') + endif + endif + + end subroutine set_mean_mass + +end module mo_mean_mass diff --git a/src/chemistry/mozart/mo_negtrc.F90 b/src/chemistry/mozart/mo_negtrc.F90 new file mode 100644 index 0000000000..a7ec05f01e --- /dev/null +++ b/src/chemistry/mozart/mo_negtrc.F90 @@ -0,0 +1,45 @@ + + module mo_negtrc + + private + public :: negtrc + + contains + + subroutine negtrc( header, fld, ncol ) +!----------------------------------------------------------------------- +! ... Check for negative constituent values and +! replace with zero value +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use chem_mods, only : gas_pcnst + use ppgrid, only : pver + + implicit none + +!----------------------------------------------------------------------- +! ... Dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol + character(len=*), intent(in) :: header + real(r8), intent(inout) :: fld(ncol,pver,gas_pcnst) ! field to check + +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: m + integer :: nneg ! flag counter + + do m = 1,gas_pcnst + nneg = count( fld(:,:,m) < 0._r8 ) + if( nneg > 0 ) then + where( fld(:,:,m) < 0._r8 ) + fld(:,:,m) = 0._r8 + endwhere + end if + end do + + end subroutine negtrc + + end module mo_negtrc diff --git a/src/chemistry/mozart/mo_neu_wetdep.F90 b/src/chemistry/mozart/mo_neu_wetdep.F90 new file mode 100644 index 0000000000..b187b83e69 --- /dev/null +++ b/src/chemistry/mozart/mo_neu_wetdep.F90 @@ -0,0 +1,1765 @@ +! +! code written by J.-F. Lamarque, S. Walters and F. Vitt +! based on the original code from J. Neu developed for UC Irvine +! model +! +! LKE 2/23/2018 - correct setting flag for mass-limited (HNO3,etc.) vs Henry's Law washout +! +module mo_neu_wetdep +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use constituents, only : pcnst + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use seq_drydep_mod, only : n_species_table, species_name_table, dheff + use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt +! + implicit none +! + private + public :: neu_wetdep_init + public :: neu_wetdep_tend +! + save +! + integer, allocatable, dimension(:) :: mapping_to_heff,mapping_to_mmr + real(r8),allocatable, dimension(:) :: mol_weight + logical ,allocatable, dimension(:) :: ice_uptake + integer :: index_cldice,index_cldliq,nh3_ndx,co2_ndx + logical :: debug = .false. + integer :: hno3_ndx = 0 + integer :: h2o2_ndx = 0 +! +! diagnostics +! + logical :: do_diag = .false. + integer, parameter :: kdiag = 18 +! + real(r8), parameter :: zero = 0._r8 + real(r8), parameter :: one = 1._r8 +! + logical :: do_neu_wetdep +! + real(r8), parameter :: TICE=263._r8 + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +subroutine neu_wetdep_init +! + use constituents, only : cnst_get_ind,cnst_mw + use cam_history, only : addfld, add_default, horiz_only + use phys_control, only : phys_getopts +! + integer :: m,l + character*20 :: test_name + + logical :: history_chemistry + + call phys_getopts(history_chemistry_out=history_chemistry) + + do_neu_wetdep = gas_wetdep_method == 'NEU' .and. gas_wetdep_cnt>0 + + if (.not.do_neu_wetdep) return + + allocate( mapping_to_heff(gas_wetdep_cnt) ) + allocate( mapping_to_mmr(gas_wetdep_cnt) ) + allocate( ice_uptake(gas_wetdep_cnt) ) + allocate( mol_weight(gas_wetdep_cnt) ) + +! +! find mapping to heff table +! + if ( debug ) then + print '(a,i4)','gas_wetdep_cnt=',gas_wetdep_cnt + print '(a,i4)','n_species_table=',n_species_table + end if + mapping_to_heff = -99 + do m=1,gas_wetdep_cnt +! + test_name = gas_wetdep_list(m) + if ( debug ) print '(i4,a)',m,trim(test_name) +! +! mapping based on the MOZART4 wet removal subroutine; +! this might need to be redone (JFL: Sep 2010) +! + select case( trim(test_name) ) +! +! CCMI: added SO2t and NH_50W +! + case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' ) + test_name = 'CH2O' + case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' ) + test_name = 'H2O2' + case ( 'SO2t' ) + test_name = 'SO2' + case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL') + test_name = 'HNO3' + case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4', 'NH4NO3' ) + test_name = 'HNO3' + case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' ) + test_name = 'CH3OOH' + case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) + test_name = 'CH3OOH' + case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) + test_name = 'HNO3' + case( 'TERPROD1', 'TERPROD2' ) + test_name = 'CH2O' + case( 'HMPROP' ) + test_name = 'GLYALD' + case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' ) + test_name = 'H2O2' + case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) + test_name = 'H2O2' + case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + end select +! + do l = 1,n_species_table +! +! if ( debug ) print '(i4,a)',l,trim(species_name_table(l)) +! + if( trim(test_name) == trim( species_name_table(l) ) ) then + mapping_to_heff(m) = l + if ( debug ) print '(a,a,i4)','mapping to heff of ',trim(species_name_table(l)),l + exit + end if + end do + if ( mapping_to_heff(m) == -99 ) then + if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name) +! call endrun() + end if +! +! special cases for NH3 and CO2 +! + if ( trim(test_name) == 'NH3' ) then + nh3_ndx = m + end if + if ( trim(test_name) == 'CO2' ) then + co2_ndx = m + end if + if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then + hno3_ndx = m + end if +! + end do + + if (any ( mapping_to_heff(:) == -99 )) call endrun('mo_neu_wet->depwetdep_init: unmapped species error' ) +! + if ( debug ) then + print '(a,i4)','co2_ndx',co2_ndx + print '(a,i4)','nh3_ndx',nh3_ndx + end if +! +! find mapping to species +! + mapping_to_mmr = -99 + do m=1,gas_wetdep_cnt + if ( debug ) print '(i4,a)',m,trim(gas_wetdep_list(m)) + call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. ) + if ( debug ) print '(a,i4)','mapping_to_mmr ',mapping_to_mmr(m) + if ( mapping_to_mmr(m) <= 0 ) then + print *,'problem with mapping_to_mmr of ',gas_wetdep_list(m) + call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m))) + end if + end do +! +! define species-dependent arrays +! + do m=1,gas_wetdep_cnt +! + mol_weight(m) = cnst_mw(mapping_to_mmr(m)) + if ( debug ) print '(i4,a,f8.4)',m,' mol_weight ',mol_weight(m) + ice_uptake(m) = .false. + if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then + ice_uptake(m) = .true. + end if +! +! + end do +! +! indices for cloud quantities +! + call cnst_get_ind( 'CLDICE', index_cldice ) + call cnst_get_ind( 'CLDLIQ', index_cldliq ) +! +! define output +! + do m=1,gas_wetdep_cnt + call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency') + call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') + call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') + if (history_chemistry) then + call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') + call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') + end if + end do +! + if ( do_diag ) then + call addfld ('QT_RAIN_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_RIME_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_WASH_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_EVAP_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + if (history_chemistry) then + call add_default('QT_RAIN_HNO3',1,' ') + call add_default('QT_RIME_HNO3',1,' ') + call add_default('QT_WASH_HNO3',1,' ') + call add_default('QT_EVAP_HNO3',1,' ') + end if + end if +! + return +! +end subroutine neu_wetdep_init +! +subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & + prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int) +! + use ppgrid, only : pcols, pver +!!DEK + use phys_grid, only : get_area_all_p, get_rlat_all_p + use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G + use cam_history, only : outfld +! + implicit none +! + integer, intent(in) :: lchnk,ncol + real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! mass mixing ratio (kg/kg) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: zint(pcols,pver+1) ! interface geopotential height above the surface (m) + real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: delt ! timestep (s) +! + real(r8), intent(in) :: prain(ncol, pver) + real(r8), intent(in) :: nevapr(ncol, pver) + real(r8), intent(in) :: cld(ncol, pver) + real(r8), intent(in) :: cmfdqr(ncol, pver) + real(r8), intent(inout) :: wd_tend(pcols,pver,pcnst) + real(r8), intent(inout) :: wd_tend_int(pcols,pcnst) +! +! local arrays and variables +! + integer :: i,k,l,kk,m,id + real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m) + real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2 + real(r8), dimension(ncol) :: area, wk_out + real(r8), dimension(ncol,pver) :: cldice,cldliq,cldfrc,totprec,totevap,delz,delp,p + real(r8), dimension(ncol,pver) :: rls,evaprate,mass_in_layer,temp + real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: trc_mass,heff,dtwr + real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: wd_mmr + logical , dimension(gas_wetdep_cnt) :: tckaqb + integer , dimension(ncol) :: test_flag +! +! arrays for HNO3 diagnostics +! + real(r8), dimension(ncol,pver) :: qt_rain,qt_rime,qt_wash,qt_evap +! +! for Henry's law calculations +! + real(r8), parameter :: t0 = 298._r8 + real(r8), parameter :: ph = 1.e-5_r8 + real(r8), parameter :: ph_inv = 1._r8/ph + real(r8) :: e298, dhr + real(r8), dimension(ncol) :: dk1s,dk2s,wrk +!!DEK + real(r8) :: pi + real(r8) :: lats(pcols) +! +! from cam/src/physics/cam/stratiform.F90 +! +!!DEK + pi = 4._r8*atan(1.0_r8) + + if (.not.do_neu_wetdep) return +! +! don't do anything if there are no species to be removed +! + if ( gas_wetdep_cnt == 0 ) return +! +! reset output variables +! + wd_tend_int = 0._r8 +! +! get area (in radians square) +! + call get_area_all_p(lchnk, ncol, area) + area = area * rearth**2 ! in m^2 +! +! reverse order along the vertical before calling +! J. Neu's wet removal subroutine +! + do k=1,pver + kk = pver - k + 1 + do i=1,ncol +! + mass_in_layer(i,k) = area(i) * pdel(i,kk)/gravit ! kg +! + cldice (i,k) = mmr(i,kk,index_cldice) ! kg/kg + cldliq (i,k) = mmr(i,kk,index_cldliq) ! kg/kg + cldfrc (i,k) = cld(i,kk) ! unitless +! + totprec(i,k) = (prain(i,kk)+cmfdqr(i,kk)) & + * mass_in_layer(i,k) ! kg/s + totevap(i,k) = nevapr(i,kk) * mass_in_layer(i,k) ! kg/s +! + delz(i,k) = zint(i,kk) - zint(i,kk+1) ! in m +! + temp(i,k) = tfld(i,kk) +! +! convert tracer mass to kg to kg/kg +! + trc_mass(i,k,:) = mmr(i,kk,mapping_to_mmr(:)) * mass_in_layer(i,k) +! + delp(i,k) = pdel(i,kk) * 0.01_r8 ! in hPa + p (i,k) = pmid(i,kk) * 0.01_r8 ! in hPa +! + end do + end do +! +! define array for tendency calculation (on model grid) +! + dtwr(1:ncol,:,:) = mmr(1:ncol,:,mapping_to_mmr(:)) +! +! compute 1) integrated precipitation flux across the interfaces (rls) +! 2) evaporation rate +! + rls (:,pver) = 0._r8 + evaprate (:,pver) = 0._r8 + do k=pver-1,1,-1 + rls (:,k) = max(0._r8,totprec(:,k)-totevap(:,k)+rls(:,k+1)) + !evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+totprec(:,k)+1.e-36_r8)) + evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+1.e-36_r8)) + end do +! +! compute effective Henry's law coefficients +! code taken from models/drv/shr/seq_drydep_mod.F90 +! + heff = 0._r8 + do k=1,pver +! + kk = pver - k + 1 +! + wrk(:) = (t0-tfld(1:ncol,kk))/(t0*tfld(1:ncol,kk)) +! + do m=1,gas_wetdep_cnt +! + l = mapping_to_heff(m) + id = 6*(l - 1) + e298 = dheff(id+1) + dhr = dheff(id+2) + heff(:,k,m) = e298*exp( dhr*wrk(:) ) + test_flag = -99 + if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,k,m) /= 0._r8 ) + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + test_flag = 1 + heff(:,k,m) = dk1s(:)*ph_inv + endwhere + end if +! + if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug ) print '(a,i4)','heff for m=',m +! + if( dheff(id+5) /= 0._r8 ) then + if( nh3_ndx > 0 .or. co2_ndx > 0 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(id+5) + dhr = dheff(id+6) + dk2s(:) = e298*exp( dhr*wrk(:) ) + if( m == co2_ndx ) then + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) + else if( m == nh3_ndx ) then + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + else + write(iulog,*) 'error in assigning henrys law coefficients' + write(iulog,*) 'species ',m + end if + end if + end if +! + end do + end do +! + if ( debug ) then + print '(a,50f8.2)','tckaqb ',tckaqb + print '(a,50e12.4)','heff ',heff(1,1,:) + print '(a,50i4)' ,'ice_uptake ',ice_uptake + print '(a,50f8.2)','mol_weight ',mol_weight(:) + print '(a,50f8.2)','temp ',temp(1,:) + print '(a,50f8.2)','p ',p (1,:) + end if +! +! call J. Neu's subroutine +! + do i=1,ncol +! + call washo(pver,gas_wetdep_cnt,delt,trc_mass(i,:,:),mass_in_layer(i,:),p(i,:),delz(i,:) & + ,rls(i,:),cldliq(i,:),cldice(i,:),cldfrc(i,:),temp(i,:),evaprate(i,:) & + ,area(i),heff(i,:,:),mol_weight(:),tckaqb(:),ice_uptake(:) & + ,qt_rain(i,:),qt_rime(i,:),qt_wash(i,:),qt_evap(i,:) ) +! + end do +! +! compute tendencies and convert back to mmr +! on original vertical grid +! + do k=1,pver + kk = pver - k + 1 + do i=1,ncol +! +! convert tracer mass from kg +! + wd_mmr(i,kk,:) = trc_mass(i,k,:) / mass_in_layer(i,k) +! + end do + end do +! +! tendency calculation (on model grid) +! + dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:) + dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt + +!!DEK polarward of 60S, 60N and <200hPa set to zero! + call get_rlat_all_p(lchnk, pcols, lats ) + do k = 1, pver + do i= 1, ncol + if ( abs( lats(i)*180._r8/pi ) > 60._r8 ) then + if ( pmid(i,k) < 20000._r8) then + dtwr(i,k,:) = 0._r8 + endif + endif + end do + end do +! +! output tendencies +! + do m=1,gas_wetdep_cnt + wd_tend(1:ncol,:,mapping_to_mmr(m)) = wd_tend(1:ncol,:,mapping_to_mmr(m)) + dtwr(1:ncol,:,m) + call outfld( 'DTWR_'//trim(gas_wetdep_list(m)),dtwr(:,:,m),ncol,lchnk ) + + call outfld( 'HEFF_'//trim(gas_wetdep_list(m)),heff(:,pver:1:-1,m),ncol,lchnk ) +! +! vertical integrated wet deposition rate [kg/m2/s] +! + wk_out = 0._r8 + do k=1,pver + kk = pver - k + 1 + wk_out(1:ncol) = wk_out(1:ncol) + (dtwr(1:ncol,k,m) * mass_in_layer(1:ncol,kk)/area(1:ncol)) + end do + call outfld( 'WD_'//trim(gas_wetdep_list(m)),wk_out,ncol,lchnk ) +! +! to be used in mo_chm_diags to compute wet_deposition_NOy_as_N and wet_deposition_NHx_as_N (units: kg/m2/s) +! + if ( debug) print *,'mo_neu ',mapping_to_mmr(m),(wk_out(1:ncol)) + wd_tend_int(1:ncol,mapping_to_mmr(m)) = wk_out(1:ncol) +! + end do +! + if ( do_diag ) then + call outfld('QT_RAIN_HNO3', qt_rain, ncol, lchnk ) + call outfld('QT_RIME_HNO3', qt_rime, ncol, lchnk ) + call outfld('QT_WASH_HNO3', qt_wash, ncol, lchnk ) + call outfld('QT_EVAP_HNO3', qt_evap, ncol, lchnk ) + end if +! + return +end subroutine neu_wetdep_tend + +!----------------------------------------------------------------------- +! +! Original code from Jessica Neu +! Updated by S. Walters and J.-F. Lamarque (March-April 2011) +! +!----------------------------------------------------------------------- + + subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & + RLS,CLWC,CIWC,CFR,TEM,EVAPRATE,GAREA,HSTAR,TCMASS,TCKAQB, & + TCNION, qt_rain, qt_rime, qt_wash, qt_evap) +! + implicit none + +!----------------------------------------------------------------------- +!---p-conde 5.4 (2007) -----called from main----- +!---called from pmain to calculate rainout and washout of tracers +!---revised by JNEU 8/2007 +!--- +!-LAER has been removed - no scavenging for aerosols +!-LAER could be used as LWASHTYP +!---WILL THIS WORK FOR T42->T21??????????? +!----------------------------------------------------------------------- + + integer LPAR, NTRACE + real(r8), intent(inout) :: QTTJFL(LPAR,NTRACE) + real(r8), intent(in) :: DTSCAV, QM(LPAR),POFL(LPAR),DELZ(LPAR),GAREA + real(r8), intent(in) :: RLS(LPAR),CLWC(LPAR),CIWC(LPAR),CFR(LPAR),TEM(LPAR), & + EVAPRATE(LPAR) + real(r8), intent(in) :: HSTAR(LPAR,NTRACE),TCMASS(NTRACE) + logical , intent(in) :: TCKAQB(NTRACE),TCNION(NTRACE) +! + real(r8), intent(inout) :: qt_rain(lpar) + real(r8), intent(inout) :: qt_rime(lpar) + real(r8), intent(inout) :: qt_wash(lpar) + real(r8), intent(inout) :: qt_evap(lpar) +! + integer I,J,L,N,LE, LM1 + real(r8), dimension(LPAR) :: CFXX + real(r8), dimension(LPAR) :: QTT, QTTNEW + + real(r8) WRK, RNEW_TST + real(r8) CLWX + real(r8) RNEW,RPRECIP,DELTARIMEMASS,DELTARIME,RAMPCT + real(r8) MASSLOSS + real(r8) DOR,DNEW,DEMP,COLEFFSNOW,RHOSNOW + real(r8) WEMP,REMP,RRAIN,RWASH + real(r8) QTPRECIP,QTRAIN,QTCXA,QTAX,QTOC + + real(r8) FAMA,RAMA,DAMA,FCA,RCA,DCA + real(r8) FAX,RAX,DAX,FCXA,RCXA,DCXA,FCXB,RCXB,DCXB + real(r8) RAXADJ,FAXADJ,RAXADJF + real(r8) QTDISCF,QTDISRIME,QTDISCXA + real(r8) QTEVAPAXP,QTEVAPAXW,QTEVAPAX + real(r8) QTWASHAX + real(r8) QTEVAPCXAP,QTEVAPCXAW,QTEVAPCXA + real(r8) QTWASHCXA,QTRIMECXA + real(r8) QTRAINCXA,QTRAINCXB + real(r8) QTTOPCA,QTTOPAA,QTTOPCAX,QTTOPAAX + + real(r8) AMPCT,AMCLPCT,CLNEWPCT,CLNEWAMPCT,CLOLDPCT,CLOLDAMPCT + real(r8) RAXLOC,RCXALOC,RCXBLOC,RCALOC,RAMALOC,RCXPCT + + real(r8) QTNETLCXA,QTNETLCXB,QTNETLAX,QTNETL + real(r8) QTDISSTAR + + + real(r8), parameter :: CFMIN=0.1_r8 + real(r8), parameter :: CWMIN=1.0e-5_r8 + real(r8), parameter :: DMIN=1.0e-1_r8 !mm + real(r8), parameter :: VOLPOW=1._r8/3._r8 + real(r8), parameter :: RHORAIN=1.0e3_r8 !kg/m3 + real(r8), parameter :: RHOSNOWFIX=1.0e2_r8 !kg/m3 + real(r8), parameter :: COLEFFRAIN=0.7_r8 + real(r8), parameter :: TMIX=258._r8 + real(r8), parameter :: TFROZ=240._r8 + real(r8), parameter :: COLEFFAER=0.05_r8 +! +! additional work arrays and diagnostics +! + real(r8) :: rls_wrk(lpar) + real(r8) :: rnew_wrk(lpar) + real(r8) :: rca_wrk(lpar) + real(r8) :: fca_wrk(lpar) + real(r8) :: rcxa_wrk(lpar) + real(r8) :: fcxa_wrk(lpar) + real(r8) :: rcxb_wrk(lpar) + real(r8) :: fcxb_wrk(lpar) + real(r8) :: rax_wrk(lpar,2) + real(r8) :: fax_wrk(lpar,2) + real(r8) :: rama_wrk(lpar) + real(r8) :: fama_wrk(lpar) + real(r8) :: deltarime_wrk(lpar) + real(r8) :: clwx_wrk(lpar) + real(r8) :: frc(lpar,3) + real(r8) :: rlsog(lpar) +! + logical :: is_hno3 + logical :: rls_flag(lpar) + logical :: rnew_flag(lpar) + logical :: cf_trigger(lpar) + logical :: freezing(lpar) +! + real(r8), parameter :: four = 4._r8 + real(r8), parameter :: adj_factor = one + 10._r8*epsilon( one ) +! + integer :: LWASHTYP,LICETYP +! + if ( debug ) then + print '(a,50f8.2)','tckaqb ',tckaqb + print '(a,50e12.4)','hstar ',hstar(1,:) + print '(a,50i4)' ,'ice_uptake ',TCNION + print '(a,50f8.2)','mol_weight ',TCMASS(:) + print '(a,50f8.2)','temp ',tem(:) + print '(a,50f8.2)','p ',pofl(:) + end if + +!----------------------------------------------------------------------- + LE = LPAR-1 +! + rls_flag(1:le) = rls(1:le) > zero + freezing(1:le) = tem(1:le) < tice + rlsog(1:le) = rls(1:le)/garea +! +species_loop : & + do N = 1,NTRACE + QTT(:lpar) = QTTJFL(:lpar,N) + QTTNEW(:lpar) = QTTJFL(:lpar,N) + is_hno3 = n == hno3_ndx + if( is_hno3 ) then + qt_rain(:lpar) = zero + qt_rime(:lpar) = zero + qt_wash(:lpar) = zero + qt_evap(:lpar) = zero + rca_wrk(:lpar) = zero + fca_wrk(:lpar) = zero + rcxa_wrk(:lpar) = zero + fcxa_wrk(:lpar) = zero + rcxb_wrk(:lpar) = zero + fcxb_wrk(:lpar) = zero + rls_wrk(:lpar) = zero + rnew_wrk(:lpar) = zero + cf_trigger(:lpar) = .false. + clwx_wrk(:lpar) = -9999._r8 + deltarime_wrk(:lpar) = -9999._r8 + rax_wrk(:lpar,:) = zero + fax_wrk(:lpar,:) = zero + endif + +!----------------------------------------------------------------------- +! check whether soluble in ice +!----------------------------------------------------------------------- + if( TCNION(N) ) then + LICETYP = 1 + else + LICETYP = 2 + end if + +!----------------------------------------------------------------------- +! initialization +!----------------------------------------------------------------------- + QTTOPAA = zero + QTTOPCA = zero + + RCA = zero + FCA = zero + DCA = zero + RAMA = zero + FAMA = zero + DAMA = zero + + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero +!----------------------------------------------------------------------- +! Check whether precip in top layer - if so, require CF ge 0.2 +!----------------------------------------------------------------------- + if( RLS(LE) > zero ) then + CFXX(LE) = max( CFMIN,CFR(LE) ) + else + CFXX(LE) = CFR(LE) + endif + + rnew_flag(1:le) = .false. + +level_loop : & + do L = LE,1,-1 + LM1 = L - 1 + FAX = zero + RAX = zero + DAX = zero + FCXA = zero + FCXB = zero + DCXA = zero + DCXB = zero + RCXA = zero + RCXB = zero + + QTDISCF = zero + QTDISRIME = zero + QTDISCXA = zero + + QTEVAPAXP = zero + QTEVAPAXW = zero + QTEVAPAX = zero + QTWASHAX = zero + + QTEVAPCXAP = zero + QTEVAPCXAW = zero + QTEVAPCXA = zero + QTRIMECXA = zero + QTWASHCXA = zero + QTRAINCXA = zero + QTRAINCXB = zero + + RAMPCT = zero + RCXPCT = zero + + RCXALOC = zero + RCXBLOC = zero + RAXLOC = zero + RAMALOC = zero + RCALOC = zero + + RPRECIP = zero + DELTARIMEMASS = zero + DELTARIME = zero + DOR = zero + DNEW = zero + + QTTOPAAX = zero + QTTOPCAX = zero + +has_rls : & + if( rls_flag(l) ) then +!----------------------------------------------------------------------- +!-----Evaporate ambient precip and decrease area------------------------- +!-----If ice, diam=diam falling from above If rain, diam=4mm (not used) +!-----Evaporate tracer contained in evaporated precip +!-----Can't evaporate more than we start with----------------------------- +!-----Don't do washout until we adjust ambient precip to match Rbot if needed +!------(after RNEW if statements) +!----------------------------------------------------------------------- + FAX = max( zero,FAMA*(one - evaprate(l)) ) + RAX = RAMA !kg/m2/s + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: l,rls,fax = ',l,rls(l),fax + endif + endif + if( FAMA > zero ) then + if( freezing(l) ) then + DAX = DAMA !mm + else + DAX = four !mm - not necessary + endif + else + DAX = zero + endif + + if( RAMA > zero ) then + QTEVAPAXP = min( QTTOPAA,EVAPRATE(L)*QTTOPAA ) + else + QTEVAPAXP = zero + endif + if( is_hno3 ) then + rax_wrk(l,1) = rax + fax_wrk(l,1) = fax + endif + + +!----------------------------------------------------------------------- +! Determine how much the in-cloud precip rate has increased------ +!----------------------------------------------------------------------- + WRK = RAX*FAX + RCA*FCA + if( WRK > 0._r8 ) then + RNEW_TST = RLS(L)/(GAREA * WRK) + else + RNEW_TST = 10._r8 + endif + RNEW = RLSOG(L) - (RAX*FAX + RCA*FCA) !GBA*CF + rnew_wrk(l) = rnew_tst + if ( debug ) then + if( is_hno3 .and. l == kdiag-1 ) then + write(*,*) ' ' + write(*,*) 'washout: rls,rax,fax,rca,fca' + write(*,'(1p,5g15.7)') rls(l),rax,fax,rca,fca + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! if RNEW>0, there is growth and/or new precip formation +!----------------------------------------------------------------------- +has_rnew: if( rlsog(l) > adj_factor*(rax*fax + rca*fca) ) then +!----------------------------------------------------------------------- +! Min cloudwater requirement for cloud with new precip +! Min CF is set at top for LE, at end for other levels +! CWMIN is only needed for new precip formation - do not need for RNEW<0 +!----------------------------------------------------------------------- + if( cfxx(l) == zero ) then + if ( do_diag ) then + write(*,*) 'cfxx(l) == zero',l + write(*,*) qttjfl(:,n) + write(*,*) qm(:) + write(*,*) pofl(:) + write(*,*) delz(:) + write(*,*) rls(:) + write(*,*) clwc(:) + write(*,*) ciwc(:) + write(*,*) cfr(:) + write(*,*) tem(:) + write(*,*) evaprate(:) + write(*,*) hstar(:,n) + end if +! +! if we are here,, that means that there is +! a inconsistency and this will lead to a division +! by 0 later on! This column should then be skipped +! + QTTJFL(:lpar,n) = QTT(:lpar) + cycle species_loop +! +! call endrun() +! + endif + rnew_flag(l) = .true. + CLWX = max( CLWC(L)+CIWC(L),CWMIN*CFXX(L) ) + if( is_hno3 ) then + clwx_wrk(l) = clwx + endif +!----------------------------------------------------------------------- +! Area of old cloud and new cloud +!----------------------------------------------------------------------- + FCXA = FCA + FCXB = max( zero,CFXX(L)-FCXA ) +!----------------------------------------------------------------------- +! ICE +! For ice and mixed phase, grow precip in old cloud by riming +! Use only portion of cloudwater in old cloud fraction +! and rain above old cloud fraction +! COLEFF from Lohmann and Roeckner (1996), Loss rate from Rotstayn (1997) +!----------------------------------------------------------------------- +is_freezing : & + if( freezing(l) ) then + COLEFFSNOW = exp( 2.5e-2_r8*(TEM(L) - TICE) ) + if( TEM(L) <= TFROZ ) then + RHOSNOW = RHOSNOWFIX + else + RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX + endif + if( FCXA > zero ) then + if( DCA > zero ) then + DELTARIMEMASS = CLWX*QM(L)*(FCXA/CFXX(L))* & + (one - exp( (-COLEFFSNOW/(DCA*1.e-3_r8))*((RCA)/(2._r8*RHOSNOW))*DTSCAV )) !uses GBA R + else + DELTARIMEMASS = zero + endif + else + DELTARIMEMASS = zero + endif +!----------------------------------------------------------------------- +! Increase in precip rate due to riming (kg/m2/s): +! Limit to total increase in R in cloud +!----------------------------------------------------------------------- + if( FCXA > zero ) then + DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA + else + DELTARIME = zero + endif + if( is_hno3 ) then + deltarime_wrk(l) = deltarime + endif +!----------------------------------------------------------------------- +! Find diameter of rimed precip, must be at least .1mm +!----------------------------------------------------------------------- + if( RCA > zero ) then + DOR = max( DMIN,(((RCA+DELTARIME)/RCA)**VOLPOW)*DCA ) + else + DOR = zero + endif +!----------------------------------------------------------------------- +! If there is some in-cloud precip left, we have new precip formation +! Will be spread over whole cloud fraction +!----------------------------------------------------------------------- +! Calculate precip rate in old and new cloud fractions +!----------------------------------------------------------------------- + RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !kg/m2/s !GBA +!----------------------------------------------------------------------- +! Calculate precip rate in old and new cloud fractions +!----------------------------------------------------------------------- + RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA + RCXB = RPRECIP !kg/m2/s GBA + +!----------------------------------------------------------------------- +! Find diameter of new precip from empirical relation using Rprecip +! in given area of box- use density of water, not snow, to convert kg/s +! to mm/s -> as given in Field and Heymsfield +! Also calculate diameter of mixed precip,DCXA, from empirical relation +! using total R in FCXA - this will give larger particles than averaging DOR and +! DNEW in the next level +! DNEW and DCXA must be at least .1mm +!----------------------------------------------------------------------- + if( RPRECIP > zero ) then + WEMP = (CLWX*QM(L))/(GAREA*CFXX(L)*DELZ(L)) !kg/m3 + REMP = RPRECIP/((RHORAIN/1.e3_r8)) !mm/s local + DNEW = DEMPIRICAL( WEMP, REMP ) + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: wemp,remp.dnew @ l = ',l + write(*,'(1p,3g15.7)') wemp,remp,dnew + write(*,*) ' ' + endif + endif + DNEW = max( DMIN,DNEW ) + if( FCXB > zero ) then + DCXB = DNEW + else + DCXB = zero + endif + else + DCXB = zero + endif + + if( FCXA > zero ) then + WEMP = (CLWX*QM(L)*(FCXA/CFXX(L)))/(GAREA*FCXA*DELZ(L)) !kg/m3 + REMP = RCXA/((RHORAIN/1.e3_r8)) !mm/s local + DEMP = DEMPIRICAL( WEMP, REMP ) + DCXA = ((RCA+DELTARIME)/RCXA)*DOR + (RPRECIP/RCXA)*DNEW + DCXA = max( DEMP,DCXA ) + DCXA = max( DMIN,DCXA ) + else + DCXA = zero + endif + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: rca,rcxa,deltarime,dor,rprecip,dnew @ l = ',l + write(*,'(1p,6g15.7)') rca,rcxa,deltarime,dor,rprecip,dnew + write(*,*) 'washout: dcxa,dcxb,wemp,remp,demp' + write(*,'(1p,5g15.7)') dcxa,dcxb,wemp,remp,demp + write(*,*) ' ' + end if + endif + + if( QTT(L) > zero ) then +!----------------------------------------------------------------------- +! ICE SCAVENGING +!----------------------------------------------------------------------- +! For ice, rainout only hno3/aerosols using new precip +! Tracer dissolved given by Kaercher and Voigt (2006) for T<258K +! For T>258K, use Henry's Law with Retention coefficient +! Rain out in whole CF +!----------------------------------------------------------------------- + if( RPRECIP > zero ) then + if( LICETYP == 1 ) then + RRAIN = RPRECIP*GAREA !kg/s local + call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & + TEM(L),POFL(L),QM(L), & + QTT(L)*CFXX(L),QTDISCF ) + call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & + QM(L), QTT(L), QTDISCF, QTRAIN ) + WRK = QTRAIN/CFXX(L) + QTRAINCXA = FCXA*WRK + QTRAINCXB = FCXB*WRK + elseif( LICETYP == 2 ) then + QTRAINCXA = zero + QTRAINCXB = zero + endif + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: Ice Scavenging' + write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l + write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! For ice, accretion removal for hno3 and aerosols is propotional to riming, +! no accretion removal for gases +! remove only in mixed portion of cloud +! Limit DELTARIMEMASS to RNEW*DTSCAV for ice - evaporation of rimed ice to match +! RNEW precip rate would result in HNO3 escaping from ice (no trapping) +!----------------------------------------------------------------------- + if( DELTARIME > zero ) then + if( LICETYP == 1 ) then + if( TEM(L) <= TFROZ ) then + RHOSNOW = RHOSNOWFIX + else + RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX + endif + QTCXA = QTT(L)*FCXA + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISRIME ) + QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: fcxa,dca,rca,qtdisstar @ l = ',l + write(*,'(1p,4g15.7)') fcxa,dca,rca,qtdisstar + write(*,*) ' ' + endif + endif + QTRIMECXA = QTCXA* & + (one - exp((-COLEFFSNOW/(DCA*1.e-3_r8))* & + (RCA/(2._r8*RHOSNOW))* & !uses GBA R + (QTDISSTAR/QTCXA)*DTSCAV)) + QTRIMECXA = min( QTRIMECXA, & + ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) + elseif( LICETYP == 2 ) then + QTRIMECXA = zero + endif + endif + else + QTRAINCXA = zero + QTRAINCXB = zero + QTRIMECXA = zero + endif +!----------------------------------------------------------------------- +! For ice, no washout in interstitial cloud air +!----------------------------------------------------------------------- + QTWASHCXA = zero + QTEVAPCXA = zero + +!----------------------------------------------------------------------- +! RAIN +! For rain, accretion increases rain rate but diameter remains constant +! Diameter is 4mm (not used) +!----------------------------------------------------------------------- + else is_freezing + if( FCXA > zero ) then + DELTARIMEMASS = (CLWX*QM(L))*(FCXA/CFXX(L))* & + (one - exp( -0.24_r8*COLEFFRAIN*((RCA)**0.75_r8)*DTSCAV )) !local + else + DELTARIMEMASS = zero + endif +!----------------------------------------------------------------------- +! Increase in precip rate due to riming (kg/m2/s): +! Limit to total increase in R in cloud +!----------------------------------------------------------------------- + if( FCXA > zero ) then + DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA + else + DELTARIME = zero + endif +!----------------------------------------------------------------------- +! If there is some in-cloud precip left, we have new precip formation +!----------------------------------------------------------------------- + RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !GBA + + RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA + RCXB = RPRECIP !kg/m2/s GBA + DCXA = FOUR + if( FCXB > zero ) then + DCXB = FOUR + else + DCXB = zero + endif +!----------------------------------------------------------------------- +! RAIN SCAVENGING +! For rain, rainout both hno3/aerosols and gases using new precip +!----------------------------------------------------------------------- + if( QTT(L) > zero ) then + if( RPRECIP > zero ) then + RRAIN = (RPRECIP*GAREA) !kg/s local + call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & + TEM(L), POFL(L), QM(L), & + QTT(L)*CFXX(L), QTDISCF ) + call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & + QM(L), QTT(L), QTDISCF, QTRAIN ) + WRK = QTRAIN/CFXX(L) + QTRAINCXA = FCXA*WRK + QTRAINCXB = FCXB*WRK + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: Rain Scavenging' + write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l + write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! For rain, accretion removal is propotional to riming +! caclulate for hno3/aerosols and gases +! Remove only in mixed portion of cloud +! Limit DELTARIMEMASS to RNEW*DTSCAV +!----------------------------------------------------------------------- + if( DELTARIME > zero ) then + QTCXA = QTT(L)*FCXA + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISRIME ) + QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) + QTRIMECXA = QTCXA* & + (one - exp(-0.24_r8*COLEFFRAIN* & + ((RCA)**0.75_r8)* & !local + (QTDISSTAR/QTCXA)*DTSCAV)) + QTRIMECXA = min( QTRIMECXA, & + ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) + else + QTRIMECXA = zero + endif + else + QTRAINCXA = zero + QTRAINCXB = zero + QTRIMECXA = zero + endif +!----------------------------------------------------------------------- +! For rain, washout gases and HNO3/aerosols using rain from above old cloud +! Washout for HNO3/aerosols is only on non-dissolved portion, impaction-style +! Washout for gases is on non-dissolved portion, limited by QTTOP+QTRIME +!----------------------------------------------------------------------- + if( RCA > zero ) then + QTPRECIP = FCXA*QTT(L) - QTDISRIME + if( HSTAR(L,N) > 1.e4_r8 ) then + if( QTPRECIP > zero ) then + QTWASHCXA = QTPRECIP*(one - exp( -0.24_r8*COLEFFAER*((RCA)**0.75_r8)*DTSCAV )) !local + else + QTWASHCXA = zero + endif + QTEVAPCXA = zero + else + RWASH = RCA*GAREA !kg/s local + if( QTPRECIP > zero ) then + call WASHGAS( RWASH, FCA, DTSCAV, QTTOPCA+QTRIMECXA, & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTPRECIP, QTWASHCXA, QTEVAPCXA ) + else + QTWASHCXA = zero + QTEVAPCXA = zero + endif + endif + endif + endif is_freezing +!----------------------------------------------------------------------- +! If RNEW zero ) then + RCXA = min( RCA,RLS(L)/(GAREA*FCXA) ) !kg/m2/s GBA + if( FAX > zero .and. ((RCXA+1.e-12_r8) < RLS(L)/(GAREA*FCXA)) ) then + RAXADJF = RLS(L)/GAREA - RCXA*FCXA + RAMPCT = RAXADJF/(RAX*FAX) + FAXADJ = RAMPCT*FAX + if( FAXADJ > zero ) then + RAXADJ = RAXADJF/FAXADJ + else + RAXADJ = zero + endif + else + RAXADJ = zero + RAMPCT = zero + FAXADJ = zero + endif + else + RCXA = zero + if( FAX > zero ) then + RAXADJF = RLS(L)/GAREA + RAMPCT = RAXADJF/(RAX*FAX) + FAXADJ = RAMPCT*FAX + if( FAXADJ > zero ) then + RAXADJ = RAXADJF/FAXADJ + else + RAXADJ = zero + endif + else + RAXADJ = zero + RAMPCT = zero + FAXADJ = zero + endif + endif + + QTEVAPAXP = min( QTTOPAA,QTTOPAA - (RAMPCT*(QTTOPAA-QTEVAPAXP)) ) + FAX = FAXADJ + RAX = RAXADJ + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: l,fcxa,fax = ',l,fcxa,fax + endif + endif + +!----------------------------------------------------------------------- +! IN-CLOUD EVAPORATION/WASHOUT +! If precip out the bottom of the cloud is 0, evaporate everything +! If there is no cloud, QTTOPCA=0, so nothing happens +!----------------------------------------------------------------------- + if( RCXA <= zero ) then + QTEVAPCXA = QTTOPCA + RCXA = zero + DCXA = zero + else +!----------------------------------------------------------------------- +! If rain out the bottom of the cloud is >0 (but .le. RCA): +! For ice, decrease particle size, +! no washout +! no evap for non-ice gases (b/c there is nothing in ice) +! TTmix, hno3&aerosols are incorporated into ice structure: +! do not release +! For rain, assume full evaporation of some raindrops +! proportional evaporation for all species +! washout for gases using Rbot +! impact washout for hno3/aerosol portion in gas phase +!----------------------------------------------------------------------- +! if (TEM(L) < TICE ) then +is_freezing_a : & + if( freezing(l) ) then + QTWASHCXA = zero + DCXA = ((RCXA/RCA)**VOLPOW)*DCA + if( LICETYP == 1 ) then + if( TEM(L) <= TMIX ) then + MASSLOSS = (RCA-RCXA)*FCXA*GAREA*DTSCAV +!----------------------------------------------------------------------- +! note-QTT doesn't matter b/c T<258K +!----------------------------------------------------------------------- + call DISGAS( (MASSLOSS/QM(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTT(L), QTEVAPCXA ) + QTEVAPCXA = min( QTTOPCA,QTEVAPCXA ) + else + QTEVAPCXA = zero + endif + elseif( LICETYP == 2 ) then + QTEVAPCXA = zero + endif + else is_freezing_a + QTEVAPCXAP = (RCA - RCXA)/RCA*QTTOPCA + DCXA = FOUR + QTCXA = FCXA*QTT(L) + if( HSTAR(L,N) > 1.e4_r8 ) then + if( QTT(L) > zero ) then + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISCXA ) + if( QTCXA > QTDISCXA ) then + QTWASHCXA = (QTCXA - QTDISCXA)*(one - exp( -0.24_r8*COLEFFAER*((RCXA)**0.75_r8)*DTSCAV )) !local + else + QTWASHCXA = zero + endif + QTEVAPCXAW = zero + else + QTWASHCXA = zero + QTEVAPCXAW = zero + endif + else + RWASH = RCXA*GAREA !kg/s local + call WASHGAS( RWASH, FCXA, DTSCAV, QTTOPCA, HSTAR(L,N), & + TEM(L), POFL(L), QM(L), & + QTCXA-QTDISCXA, QTWASHCXA, QTEVAPCXAW ) + endif + QTEVAPCXA = QTEVAPCXAP + QTEVAPCXAW + endif is_freezing_a + endif + endif has_rnew + +!----------------------------------------------------------------------- +! AMBIENT WASHOUT +! Ambient precip is finalized - if it is rain, washout +! no ambient washout for ice, since gases are in vapor phase +!----------------------------------------------------------------------- + if( RAX > zero ) then + if( .not. freezing(l) ) then + QTAX = FAX*QTT(L) + if( HSTAR(L,N) > 1.e4_r8 ) then + QTWASHAX = QTAX* & + (one - exp(-0.24_r8*COLEFFAER* & + ((RAX)**0.75_r8)*DTSCAV)) !local + QTEVAPAXW = zero + else + RWASH = RAX*GAREA !kg/s local + call WASHGAS( RWASH, FAX, DTSCAV, QTTOPAA, HSTAR(L,N), & + TEM(L), POFL(L), QM(L), QTAX, & + QTWASHAX, QTEVAPAXW ) + endif + else + QTEVAPAXW = zero + QTWASHAX = zero + endif + else + QTEVAPAXW = zero + QTWASHAX = zero + endif + QTEVAPAX = QTEVAPAXP + QTEVAPAXW + +!----------------------------------------------------------------------- +! END SCAVENGING +! Require CF if our ambient evaporation rate would give less +! precip than R from model. +!----------------------------------------------------------------------- + if( do_diag .and. is_hno3 ) then + rls_wrk(l) = rls(l)/garea + rca_wrk(l) = rca + fca_wrk(l) = fca + rcxa_wrk(l) = rcxa + fcxa_wrk(l) = fcxa + rcxb_wrk(l) = rcxb + fcxb_wrk(l) = fcxb + rax_wrk(l,2) = rax + fax_wrk(l,2) = fax + endif +upper_level : & + if( L > 1 ) then + FAMA = max( FCXA + FCXB + FAX - CFR(LM1),zero ) + if( FAX > zero ) then + RAXLOC = RAX/FAX + else + RAXLOC = zero + endif + if( FCXA > zero ) then + RCXALOC = RCXA/FCXA + else + RCXALOC = zero + endif + if( FCXB > zero ) then + RCXBLOC = RCXB/FCXB + else + RCXBLOC = zero + endif + + if( CFR(LM1) >= CFMIN ) then + CFXX(LM1) = CFR(LM1) + else + if( adj_factor*RLSOG(LM1) >= (RCXA*FCXA + RCXB*FCXB + RAX*FAX)*(one - EVAPRATE(LM1)) ) then + CFXX(LM1) = CFMIN + cf_trigger(lm1) = .true. + else + CFXX(LM1) = CFR(LM1) + endif + if( is_hno3 .and. lm1 == kdiag .and. debug ) then + write(*,*) ' ' + write(*,*) 'washout: rls,garea,rcxa,fcxa,rcxb,fcxb,rax,fax' + write(*,'(1p,8g15.7)') rls(lm1),garea,rcxa,fcxa,rcxb,fcxb,rax,fax + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! Figure out what will go into ambient and cloud below +! Don't do for lowest level +!----------------------------------------------------------------------- + if( FAX > zero ) then + RAXLOC = RAX/FAX + AMPCT = max( zero,min( one,(CFXX(L) + FAX - CFXX(LM1))/FAX ) ) + AMCLPCT = one - AMPCT + else + RAXLOC = zero + AMPCT = zero + AMCLPCT = zero + endif + if( FCXB > zero ) then + RCXBLOC = RCXB/FCXB + CLNEWPCT = max( zero,min( (CFXX(LM1) - FCXA)/FCXB,one ) ) + CLNEWAMPCT = one - CLNEWPCT + else + RCXBLOC = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + endif + if( FCXA > zero ) then + RCXALOC = RCXA/FCXA + CLOLDPCT = max( zero,min( CFXX(LM1)/FCXA,one ) ) + CLOLDAMPCT = one - CLOLDPCT + else + RCXALOC = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + endif +!----------------------------------------------------------------------- +! Remix everything for the next level +!----------------------------------------------------------------------- + FCA = min( CFXX(LM1),FCXA*CLOLDPCT + CLNEWPCT*FCXB + AMCLPCT*FAX ) + if( FCA > zero ) then +!----------------------------------------------------------------------- +! Maintain cloud core by reducing NC and AM area going into cloud below +!----------------------------------------------------------------------- + RCA = (RCXA*FCXA*CLOLDPCT + RCXB*FCXB*CLNEWPCT + RAX*FAX*AMCLPCT)/FCA + if ( debug ) then + if( is_hno3 ) then + write(*,*) ' ' + write(*,*) 'washout: rcxa,fcxa,cloldpctrca,rca,fca,dcxa @ l = ',l + write(*,'(1p,6g15.7)') rcxa,fcxa,cloldpct,rca,fca,dcxa + write(*,*) 'washout: rcxb,fcxb,clnewpct,dcxb' + write(*,'(1p,4g15.7)') rcxb,fcxb,clnewpct,dcxb + write(*,*) 'washout: rax,fax,amclpct,dax' + write(*,'(1p,4g15.7)') rax,fax,amclpct,dax + write(*,*) ' ' + endif + endif + + if (RCA > zero) then + DCA = (RCXA*FCXA*CLOLDPCT)/(RCA*FCA)*DCXA + & + (RCXB*FCXB*CLNEWPCT)/(RCA*FCA)*DCXB + & + (RAX*FAX*AMCLPCT)/(RCA*FCA)*DAX + else + DCA = zero + FCA = zero + endif + + else + FCA = zero + DCA = zero + RCA = zero + endif + + FAMA = FCXA + FCXB + FAX - CFXX(LM1) + if( FAMA > zero ) then + RAMA = (RCXA*FCXA*CLOLDAMPCT + RCXB*FCXB*CLNEWAMPCT + RAX*FAX*AMPCT)/FAMA + if( RAMA > zero ) then + DAMA = (RCXA*FCXA*CLOLDAMPCT)/(RAMA*FAMA)*DCXA + & + (RCXB*FCXB*CLNEWAMPCT)/(RAMA*FAMA)*DCXB + & + (RAX*FAX*AMPCT)/(RAMA*FAMA)*DAX + else + FAMA = zero + DAMA = zero + endif + else + FAMA = zero + DAMA = zero + RAMA = zero + endif + else upper_level + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + endif upper_level + else has_rls + RNEW = zero + QTEVAPCXA = QTTOPCA + QTEVAPAX = QTTOPAA + if( L > 1 ) then + if( RLS(LM1) > zero ) then + CFXX(LM1) = max( CFMIN,CFR(LM1) ) +! if( CFR(LM1) >= CFMIN ) then +! CFXX(LM1) = CFR(LM1) +! else +! CFXX(LM1) = CFMIN +! endif + else + CFXX(LM1) = CFR(LM1) + endif + endif + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + RCA = zero + RAMA = zero + FCA = zero + FAMA = zero + DCA = zero + DAMA = zero + endif has_rls + + if( do_diag .and. is_hno3 ) then + fama_wrk(l) = fama + rama_wrk(l) = rama + endif +!----------------------------------------------------------------------- +! Net loss can not exceed QTT in each region +!----------------------------------------------------------------------- + QTNETLCXA = QTRAINCXA + QTRIMECXA + QTWASHCXA - QTEVAPCXA + QTNETLCXA = min( QTT(L)*FCXA,QTNETLCXA ) + + QTNETLCXB =QTRAINCXB + QTNETLCXB = min( QTT(L)*FCXB,QTNETLCXB ) + + QTNETLAX = QTWASHAX - QTEVAPAX + QTNETLAX = min( QTT(L)*FAX,QTNETLAX ) + + QTTNEW(L) = QTT(L) - (QTNETLCXA + QTNETLCXB + QTNETLAX) + + if( do_diag .and. is_hno3 ) then + qt_rain(l) = qtraincxa + qtraincxb + qt_rime(l) = qtrimecxa + qt_wash(l) = qtwashcxa + qtwashax + qt_evap(l) = qtevapcxa + qtevapax + frc(l,1) = qtnetlcxa + frc(l,2) = qtnetlcxb + frc(l,3) = qtnetlax + endif + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: qtraincxa, qtraincxb, qtrimecxa @ level = ',l + write(*,'(1p,3g15.7)') qtraincxa, qtraincxb, qtrimecxa + write(*,*) ' ' + endif + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: hno3, hno3, qtnetlca,b, qtnetlax @ level = ',l + write(*,'(1p,5g15.7)') qttnew(l), qtt(l), qtnetlcxa, qtnetlcxb, qtnetlax + write(*,*) 'washout: qtwashax, qtevapax,fax,fama' + write(*,'(1p,5g15.7)') qtwashax, qtevapax, fax, fama + endif + endif + + QTTOPCAX = (QTTOPCA + QTNETLCXA)*CLOLDPCT + QTNETLCXB*CLNEWPCT + (QTTOPAA + QTNETLAX)*AMCLPCT + QTTOPAAX = (QTTOPCA + QTNETLCXA)*CLOLDAMPCT + QTNETLCXB*CLNEWAMPCT + (QTTOPAA + QTNETLAX)*AMPCT + QTTOPCA = QTTOPCAX + QTTOPAA = QTTOPAAX + end do level_loop + + if ( debug ) then + if( is_hno3 ) then + write(*,*) ' ' + write(*,*) 'washout: clwx_wrk' + write(*,'(1p,5g15.7)') clwx_wrk(1:le) + write(*,*) 'washout: cfr' + write(*,'(1p,5g15.7)') cfr(1:le) + write(*,*) 'washout: cfxx' + write(*,'(1p,5g15.7)') cfxx(1:le) + write(*,*) 'washout: cf trigger' + write(*,'(10l4)') cf_trigger(1:le) + write(*,*) 'washout: evaprate' + write(*,'(1p,5g15.7)') evaprate(1:le) + write(*,*) 'washout: rls' + write(*,'(1p,5g15.7)') rls(1:le) + write(*,*) 'washout: rls/garea' + write(*,'(1p,5g15.7)') rls_wrk(1:le) + write(*,*) 'washout: rnew_wrk' + write(*,'(1p,5g15.7)') rnew_wrk(1:le) + write(*,*) 'washout: rnew_flag' + write(*,'(10l4)') rnew_flag(1:le) + write(*,*) 'washout: deltarime_wrk' + write(*,'(1p,5g15.7)') deltarime_wrk(1:le) + write(*,*) 'washout: rama_wrk' + write(*,'(1p,5g15.7)') rama_wrk(1:le) + write(*,*) 'washout: fama_wrk' + write(*,'(1p,5g15.7)') fama_wrk(1:le) + write(*,*) 'washout: rca_wrk' + write(*,'(1p,5g15.7)') rca_wrk(1:le) + write(*,*) 'washout: fca_wrk' + write(*,'(1p,5g15.7)') fca_wrk(1:le) + write(*,*) 'washout: rcxa_wrk' + write(*,'(1p,5g15.7)') rcxa_wrk(1:le) + write(*,*) 'washout: fcxa_wrk' + write(*,'(1p,5g15.7)') fcxa_wrk(1:le) + write(*,*) 'washout: rcxb_wrk' + write(*,'(1p,5g15.7)') rcxb_wrk(1:le) + write(*,*) 'washout: fcxb_wrk' + write(*,'(1p,5g15.7)') fcxb_wrk(1:le) + write(*,*) 'washout: rax1_wrk' + write(*,'(1p,5g15.7)') rax_wrk(1:le,1) + write(*,*) 'washout: fax1_wrk' + write(*,'(1p,5g15.7)') fax_wrk(1:le,1) + write(*,*) 'washout: rax2_wrk' + write(*,'(1p,5g15.7)') rax_wrk(1:le,2) + write(*,*) 'washout: fax2_wrk' + write(*,'(1p,5g15.7)') fax_wrk(1:le,2) + write(*,*) 'washout: rls_flag' + write(*,'(1p,10l4)') rls_flag(1:le) + write(*,*) 'washout: freezing' + write(*,'(1p,10l4)') freezing(1:le) + write(*,*) 'washout: qtnetlcxa' + write(*,'(1p,5g15.7)') frc(1:le,1) + write(*,*) 'washout: qtnetlcxb' + write(*,'(1p,5g15.7)') frc(1:le,2) + write(*,*) 'washout: qtnetlax' + write(*,'(1p,5g15.7)') frc(1:le,3) + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! reload new tracer mass and rescale moments: check upper limits (LE) +!----------------------------------------------------------------------- + QTTJFL(:le,N) = QTTNEW(:le) + + end do species_loop +! + return + end subroutine washo +!--------------------------------------------------------------------- + subroutine DISGAS (CLWX,CFX,MOLMASS,HSTAR,TM,PR,QM,QT,QTDIS) +!--------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: CLWX,CFX !cloud water,cloud fraction + real(r8), intent(in) :: MOLMASS !molecular mass of tracer + real(r8), intent(in) :: HSTAR !Henry's Law coeffs A*exp(-B/T) + real(r8), intent(in) :: TM !temperature of box (K) + real(r8), intent(in) :: PR !pressure of box (hPa) + real(r8), intent(in) :: QM !air mass in box (kg) + real(r8), intent(in) :: QT !tracer in box (kg) + real(r8), intent(out) :: QTDIS !tracer dissolved in aqueous phase + + real(r8) MUEMP + real(r8), parameter :: INV298 = 1._r8/298._r8 + real(r8), parameter :: TMIX=258._r8 + real(r8), parameter :: RETEFF=0.5_r8 +!---Next calculate rate of uptake of tracer + +!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) +!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 +!---limit temperature effects to T above freezing +!----MU from fit to Kaercher and Voigt (2006) + + if(TM .ge. TICE) then + QTDIS=(HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM) + elseif (TM .le. TMIX) then + MUEMP=exp(-14.2252_r8+(1.55704e-1_r8*TM)-(7.1929e-4_r8*(TM**2.0_r8))) + QTDIS=MUEMP*(MOLMASS/18._r8)*(CLWX*QM) + else + QTDIS=RETEFF*((HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM)) + endif + + return + end subroutine DISGAS + +!----------------------------------------------------------------------- + subroutine RAINGAS (RRAIN,DTSCAV,CLWX,CFX,QM,QT,QTDIS,QTRAIN) +!----------------------------------------------------------------------- +!---New trace-gas rainout from large-scale precip with two time scales, +!---one based on precip formation from cloud water and one based on +!---Henry's Law solubility: correct limit for delta-t +!--- +!---NB this code does not consider the aqueous dissociation (eg, C-q) +!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would +!--- require that we keep track of the pH of the falling rain. +!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! +!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 +!--- can be considered with enhanced values of KHA. +!--- +!---Does NOT now use RMC (moist conv rain) but could, assuming 30% coverage +!----------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: RRAIN !new rain formation in box (kg/s) + real(r8), intent(in) :: DTSCAV !time step (s) + real(r8), intent(in) :: CLWX,CFX !cloud water and cloud fraction + real(r8), intent(in) :: QM !air mass in box (kg) + real(r8), intent(in) :: QT !tracer in box (kg) + real(r8), intent(in) :: QTDIS !tracer in aqueous phase (kg) + real(r8), intent(out) :: QTRAIN !tracer picked up by new rain + + real(r8) QTLF,QTDISSTAR + + + + + + QTDISSTAR=(QTDIS*(QT*CFX))/(QTDIS+(QT*CFX)) + +!---Tracer Loss frequency (1/s) within cloud fraction: + QTLF = (RRAIN*QTDISSTAR)/(CLWX*QM*QT*CFX) + +!---in time = DTSCAV, the amount of QTT scavenged is calculated +!---from CF*AMOUNT OF UPTAKE + QTRAIN = QT*CFX*(1._r8 - exp(-DTSCAV*QTLF)) + + return + end subroutine RAINGAS + + +!----------------------------------------------------------------------- + subroutine WASHGAS (RWASH,BOXF,DTSCAV,QTRTOP,HSTAR,TM,PR,QM, & + QT,QTWASH,QTEVAP) +!----------------------------------------------------------------------- +!---for most gases below-cloud washout assume Henry-Law equilib with precip +!---assumes that precip is liquid, if frozen, do not call this sub +!---since solubility is moderate, fraction of box with rain does not matter +!---NB this code does not consider the aqueous dissociation (eg, C-q) +!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would +!--- require that we keep track of the pH of the falling rain. +!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! +!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 +!--- can be considered with enhanced values of KHA. +!----------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: RWASH ! precip leaving bottom of box (kg/s) + real(r8), intent(in) :: BOXF ! fraction of box with washout + real(r8), intent(in) :: DTSCAV ! time step (s) + real(r8), intent(in) :: QTRTOP ! tracer-T in rain entering top of box +! over time step (kg) + real(r8), intent(in) :: HSTAR ! Henry's Law coeffs A*exp(-B/T) + real(r8), intent(in) :: TM ! temperature of box (K) + real(r8), intent(in) :: PR ! pressure of box (hPa) + real(r8), intent(in) :: QT ! tracer in box (kg) + real(r8), intent(in) :: QM ! air mass in box (kg) + real(r8), intent(out) :: QTWASH ! tracer picked up by precip (kg) + real(r8), intent(out) :: QTEVAP ! tracer evaporated from precip (kg) + + real(r8), parameter :: INV298 = 1._r8/298._r8 + real(r8) :: FWASH, QTMAX, QTDIF + +!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) +!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 +!---limit temperature effects to T above freezing + +! +! jfl +! +! added test for BOXF = 0. +! + if ( BOXF == 0._r8 ) then + QTWASH = 0._r8 + QTEVAP = 0._r8 + return + end if + +!---effective washout frequency (1/s): + FWASH = (RWASH*HSTAR*29.e-6_r8*PR)/(QM*BOXF) +!---equilib amount of T (kg) in rain thru bottom of box over time step + QTMAX = QT*FWASH*DTSCAV + if (QTMAX .gt. QTRTOP) then +!---more of tracer T can go into rain + QTDIF = min (QT, QTMAX-QTRTOP) + QTWASH = QTDIF * (1._r8 - exp(-DTSCAV*FWASH)) + QTEVAP=0._r8 + else +!--too much of T in rain, must degas/evap T + QTWASH = 0._r8 + QTEVAP = QTRTOP - QTMAX + endif + + return + end subroutine WASHGAS + +!----------------------------------------------------------------------- + function DEMPIRICAL (CWATER,RRATE) +!----------------------------------------------------------------------- + use shr_spfn_mod, only: shr_spfn_gamma + + implicit none + real(r8), intent(in) :: CWATER + real(r8), intent(in) :: RRATE + + real(r8) :: DEMPIRICAL + + real(r8) RRATEX,WX,THETA,PHI,ETA,BETA,ALPHA,BEE + real(r8) GAMTHETA,GAMBETA + + + + RRATEX=RRATE*3600._r8 !mm/hr + WX=CWATER*1.0e3_r8 !g/m3 + + if(RRATEX .gt. 0.04_r8) then + THETA=exp(-1.43_r8*dlog10(7._r8*RRATEX))+2.8_r8 + else + THETA=5._r8 + endif + PHI=RRATEX/(3600._r8*10._r8) !cgs units + ETA=exp((3.01_r8*THETA)-10.5_r8) + BETA=THETA/(1._r8+0.638_r8) + ALPHA=exp(4._r8*(BETA-3.5_r8)) + BEE=(.638_r8*THETA/(1._r8+.638_r8))-1.0_r8 + GAMTHETA = shr_spfn_gamma(THETA) + GAMBETA = shr_spfn_gamma(BETA+1._r8) + DEMPIRICAL=(((WX*ETA*GAMTHETA)/(1.0e6_r8*ALPHA*PHI*GAMBETA))** & + (-1._r8/BEE))*10._r8 ! in mm (wx/1e6 for cgs) + + + return + end function DEMPIRICAL +! +end module mo_neu_wetdep diff --git a/src/chemistry/mozart/mo_params.F90 b/src/chemistry/mozart/mo_params.F90 new file mode 100644 index 0000000000..555936713b --- /dev/null +++ b/src/chemistry/mozart/mo_params.F90 @@ -0,0 +1,34 @@ + + module mo_params + + use shr_kind_mod, only : r8 => shr_kind_r8 + use physconst, only : rearth + + implicit none + + integer, parameter :: kz = 100 ! altitudes + integer, parameter :: kw = 650 ! wavelengths +!---------------------------------------------------------------------------- +! ... number of weighting functions +! wavelength dependent +!---------------------------------------------------------------------------- + integer, parameter :: ks = 60 +!---------------------------------------------------------------------------- +! ... wavelength and altitude dependent +!---------------------------------------------------------------------------- + integer, parameter :: kj = 70 + +!---------------------------------------------------------------------------- +! ... number of photorates to use from tuv +!---------------------------------------------------------------------------- + integer, parameter :: tuv_jmax = 31 + +!---------------------------------------------------------------------------- +! ... delta for adding points at beginning or end of data grids +!---------------------------------------------------------------------------- + real(r8), parameter :: deltax = 1.e-4_r8 + + real(r8) :: largest + real(r8) :: smallest + + end module mo_params diff --git a/src/chemistry/mozart/mo_pchem.F90 b/src/chemistry/mozart/mo_pchem.F90 new file mode 100644 index 0000000000..d132ddbcbb --- /dev/null +++ b/src/chemistry/mozart/mo_pchem.F90 @@ -0,0 +1,137 @@ + + module mo_pchem + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: pchem + + contains + + subroutine pchem( nw, wl, wc, tlev, & + airlev, nlng, pht_tag, xs ) +!----------------------------------------------------------------------------- +! purpose: +! load various "weighting functions" (products of cross section and +! quantum yield at each altitude and for wavelength). the altitude +! dependence is necessary to ensure the consideration of pressure and +! temperature dependence of the cross sections or quantum yields. +! the actual reading, evaluation and interpolation is done is separate +! subroutines for ease of management and manipulation. please refer to +! the inline documentation of the specific subroutines for detail information. +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use ppgrid, only : pverp + use cam_logfile, only : iulog + use mo_xsections + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + integer, intent(in) :: nlng + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:,:) + character(len=32), intent(in) :: pht_tag(:) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: m + integer :: astat + character(len=32) :: jtag + +rate_loop : & + do m = 1,nlng + jtag = trim( pht_tag(m)) + select case( jtag ) + case( 'jo3p', 'jo1d', 'j2oh' ) +!----------------------------------------------------------------------------- +! ... o3 + hv -> (both channels) (tmp dep) +!----------------------------------------------------------------------------- + call r01( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jn2o5' ) +!----------------------------------------------------------------------------- +! ... n2o5 + hv -> (both channels) (tmp dep) +!----------------------------------------------------------------------------- + call r04( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jn2o' ) +!----------------------------------------------------------------------------- +! ... n2o + hv -> n2 + o(1d) (tmp dep) +!----------------------------------------------------------------------------- + call r44( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jh2o2' ) +!----------------------------------------------------------------------------- +! ... h2o2 + hv -> 2 oh +!----------------------------------------------------------------------------- + call r08( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jhno3' ) +!---------------------------------------------------------------------------- +! ... hno3 + hv -> oh + no2 +!----------------------------------------------------------------------------- + call r06( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jch2o_a', 'jch2o_b' ) +!----------------------------------------------------------------------------- +! ... ch2o + hv -> (both channels) +!----------------------------------------------------------------------------- + call r10( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jch3cocho','jmgly' ) +!----------------------------------------------------------------------------- +! ... ch3cocho + hv -> products +!----------------------------------------------------------------------------- + call r14( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jch3coch3', 'jacet' ) +!----------------------------------------------------------------------------- +! ... ch3coch3 + hv -> products +!----------------------------------------------------------------------------- + call r15( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jch3ono2' ) +!----------------------------------------------------------------------------- +! ... ch3ono2 + hv -> ch3o + no2 +!----------------------------------------------------------------------------- + call r17( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jpan' ) +!----------------------------------------------------------------------------- +! ... pan + hv -> products +!----------------------------------------------------------------------------- + call r18( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + case( 'jmvk' ) +!----------------------------------------------------------------------------- +! ... mvk + hv -> products +!----------------------------------------------------------------------------- + call xs_mvk( nw, wl, wc, tlev, airlev, xs(:,:,m) ) + case( 'jch3cho_a', 'jch3cho_b', 'jch3cho_c' ) +!----------------------------------------------------------------------------- +! ... ch3cho + hv -> products +! (a) ch3cho + hv -> ch3 + hco +! (b) ch3cho + hv -> ch4 + co +! (c) ch3cho + hv -> ch3co + h +!----------------------------------------------------------------------------- + call r11( nw, wl, wc, tlev, airlev, jtag, xs(:,:,m) ) + end select + end do rate_loop + + end subroutine pchem + + end module mo_pchem diff --git a/src/chemistry/mozart/mo_photo.F90 b/src/chemistry/mozart/mo_photo.F90 new file mode 100644 index 0000000000..a953c2db74 --- /dev/null +++ b/src/chemistry/mozart/mo_photo.F90 @@ -0,0 +1,1769 @@ +module mo_photo + !---------------------------------------------------------------------- + ! ... photolysis interp table and related arrays + !---------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver, pverp, begchunk, endchunk + use cam_abortutils, only : endrun + use mo_constants, only : pi,r2d,boltz,d2r + use ref_pres, only : num_pr_lev, ptop_ref + use pio + use cam_pio_utils, only : cam_pio_openfile + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + use phys_control, only : waccmx_is + use solar_parms_data, only : f107=>solar_parms_f107, f107a=>solar_parms_f107a + + implicit none + + private + + public :: photo_inti, table_photo, xactive_photo + public :: set_ub_col + public :: setcol + public :: photo_timestep_init + public :: photo_register + + save + + real(r8), parameter :: kg2g = 1.e3_r8 + integer, parameter :: pverm = pver - 1 + + integer :: jno_ndx + integer :: jonitr_ndx + integer :: jho2no2_ndx + integer :: jch3cho_a_ndx, jch3cho_b_ndx, jch3cho_c_ndx + integer :: jo2_a_ndx, jo2_b_ndx + integer :: ox_ndx, o3_ndx, o3_inv_ndx, o3rad_ndx + integer :: oc1_ndx, oc2_ndx + integer :: cb1_ndx, cb2_ndx + integer :: soa_ndx + integer :: ant_ndx + integer :: so4_ndx + integer :: sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx + integer :: n2_ndx, no_ndx, o2_ndx, o_ndx + integer, allocatable :: lng_indexer(:) + integer, allocatable :: sht_indexer(:) + integer, allocatable :: euv_indexer(:) + + integer :: ki + integer :: last + integer :: next + integer :: n_exo_levs + real(r8) :: delp + real(r8) :: dels + real(r8), allocatable :: days(:) + real(r8), allocatable :: levs(:) + real(r8), allocatable :: o2_exo_coldens(:,:,:,:) + real(r8), allocatable :: o3_exo_coldens(:,:,:,:) + logical :: o_is_inv + logical :: o2_is_inv + logical :: n2_is_inv + logical :: o3_is_inv + logical :: no_is_inv + logical :: has_o2_col + logical :: has_o3_col + logical :: has_fixed_press + real(r8) :: max_zen_angle ! degrees + + integer :: jo1d_ndx, jo3p_ndx, jno2_ndx, jn2o5_ndx + integer :: jhno3_ndx, jno3_ndx, jpan_ndx, jmpan_ndx + + integer :: jo1da_ndx, jo3pa_ndx, jno2a_ndx, jn2o5a_ndx, jn2o5b_ndx + integer :: jhno3a_ndx, jno3a_ndx, jpana_ndx, jmpana_ndx, jho2no2a_ndx + integer :: jonitra_ndx + + integer :: jppi_ndx, jepn1_ndx, jepn2_ndx, jepn3_ndx, jepn4_ndx, jepn6_ndx + integer :: jepn7_ndx, jpni1_ndx, jpni2_ndx, jpni3_ndx, jpni4_ndx, jpni5_ndx + logical :: do_jeuv = .false. + logical :: do_jshort = .false. +#ifdef DEBUG + logical :: do_diag = .false. +#endif + integer :: ion_rates_idx = -1 + +contains + + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine photo_register + use mo_jeuv, only : nIonRates + use physics_buffer,only : pbuf_add_field, dtype_r8 + + ! add photo-ionization rates to phys buffer for waccmx ionosphere module + + call pbuf_add_field('IonRates' , 'physpkg', dtype_r8, (/pcols,pver,nIonRates/), ion_rates_idx) ! Ionization rates for O+,O2+,N+,N2+,NO+ + + endsubroutine photo_register + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & + photon_file, electron_file, & + exo_coldens_file, tuv_xsect_file, o2_xsect_file, xactive_prates ) + !---------------------------------------------------------------------- + ! ... initialize photolysis module + !---------------------------------------------------------------------- + + use mo_photoin, only : photoin_inti + use mo_tuv_inti, only : tuv_inti + use mo_tuv_inti, only : nlng + use mo_seto2, only : o2_xsect_inti + use interpolate_data, only: lininterp_init, lininterp, lininterp_finish, interp_type + use chem_mods, only : phtcnt + use chem_mods, only : ncol_abs => nabscol + use chem_mods, only : rxt_tag_lst, pht_alias_lst, pht_alias_mult + use time_manager, only : get_calday + use ioFileMod, only : getfil + use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx, get_inv_ndx + use mo_jlong, only : jlong_init + use seasalt_model, only : sslt_names=>seasalt_names, sslt_ncnst=>seasalt_nbin + use mo_jshort, only : jshort_init + use mo_jeuv, only : jeuv_init, neuv + use phys_grid, only : get_ncols_p, get_rlat_all_p + use solar_irrad_data,only : has_spectrum + use photo_bkgrnd, only : photo_bkgrnd_init + use cam_history, only : addfld + + implicit none + + !---------------------------------------------------------------------- + ! ... dummy arguments + !---------------------------------------------------------------------- + character(len=*), intent(in) :: xs_long_file, rsf_file + character(len=*), intent(in) :: exo_coldens_file + character(len=*), intent(in) :: tuv_xsect_file + character(len=*), intent(in) :: o2_xsect_file + logical, intent(in) :: xactive_prates + ! waccm + character(len=*), intent(in) :: xs_coef_file + character(len=*), intent(in) :: xs_short_file + character(len=*), intent(in) :: photon_file + character(len=*), intent(in) :: electron_file + + !---------------------------------------------------------------------- + ! ... local variables + !---------------------------------------------------------------------- + real(r8), parameter :: hPa2Pa = 100._r8 + integer :: k, n + type(file_desc_t) :: ncid + type(var_desc_t) :: vid + type(interp_type) :: lat_wgts + integer :: dimid + integer :: nlat + integer :: ntimes + integer :: astat + integer :: ndx + integer :: spc_ndx + integer :: ierr + integer :: c, ncols + integer, allocatable :: dates(:) + real(r8) :: pinterp + real(r8), allocatable :: lats(:) + real(r8), allocatable :: coldens(:,:,:) + character(len=256) :: locfn + character(len=256) :: filespec + real(r8), parameter :: trop_thrshld = 1._r8 ! Pa + real(r8) :: to_lats(pcols) + + + if( phtcnt < 1 ) then + return + end if + + !---------------------------------------------------------------------------- + ! Need a larger maximum zenith angle for WACCM-X extended to high altitudes + !---------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + max_zen_angle = 116._r8 + else if ( ptop_ref < 10._r8 ) then + max_zen_angle = 97.01_r8 ! degrees + else + max_zen_angle = 88.85_r8 ! degrees + endif + + ! jeuv_1,,, jeuv_25 --> need euv calculations --> must be waccm + ! how to determine if shrt calc is needed ?? -- use top level pressure => waccm = true ? false + + if ( .not. has_spectrum ) then + write(iulog,*) 'photo_inti: solar_irrad_data file needs to contain irradiance spectrum' + call endrun('photo_inti: ERROR -- solar irradiance spectrum is missing') + endif + + !---------------------------------------------------------------------- + ! ... allocate indexers + !---------------------------------------------------------------------- + allocate( lng_indexer(phtcnt),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: lng_indexer allocation error = ',astat + call endrun + end if + lng_indexer(:) = 0 + allocate( sht_indexer(phtcnt),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: Failed to allocate sht_indexer; error = ',astat + call endrun + end if + sht_indexer(:) = 0 + allocate( euv_indexer(neuv),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: Failed to allocate euv_indexer; error = ',astat + call endrun + end if + euv_indexer(:) = 0 + + jno_ndx = get_rxt_ndx( 'jno' ) + jo2_a_ndx = get_rxt_ndx( 'jo2_a' ) + jo2_b_ndx = get_rxt_ndx( 'jo2_b' ) + + jo1da_ndx = get_rxt_ndx( 'jo1da' ) + jo3pa_ndx = get_rxt_ndx( 'jo3pa' ) + jno2a_ndx = get_rxt_ndx( 'jno2a' ) + jn2o5a_ndx = get_rxt_ndx( 'jn2o5a' ) + jn2o5b_ndx = get_rxt_ndx( 'jn2o5b' ) + jhno3a_ndx = get_rxt_ndx( 'jhno3a' ) + jno3a_ndx = get_rxt_ndx( 'jno3a' ) + jpana_ndx = get_rxt_ndx( 'jpana' ) + jmpana_ndx = get_rxt_ndx( 'jmpana' ) + jho2no2a_ndx = get_rxt_ndx( 'jho2no2a' ) + jonitra_ndx = get_rxt_ndx( 'jonitra' ) + + jo1d_ndx = get_rxt_ndx( 'jo1d' ) + jo3p_ndx = get_rxt_ndx( 'jo3p' ) + jno2_ndx = get_rxt_ndx( 'jno2' ) + jn2o5_ndx = get_rxt_ndx( 'jn2o5' ) + jn2o5_ndx = get_rxt_ndx( 'jn2o5' ) + jhno3_ndx = get_rxt_ndx( 'jhno3' ) + jno3_ndx = get_rxt_ndx( 'jno3' ) + jpan_ndx = get_rxt_ndx( 'jpan' ) + jmpan_ndx = get_rxt_ndx( 'jmpan' ) + jho2no2_ndx = get_rxt_ndx( 'jho2no2' ) + jonitr_ndx = get_rxt_ndx( 'jonitr' ) + + jppi_ndx = get_rxt_ndx( 'jppi' ) + jepn1_ndx = get_rxt_ndx( 'jepn1' ) + jepn2_ndx = get_rxt_ndx( 'jepn2' ) + jepn3_ndx = get_rxt_ndx( 'jepn3' ) + jepn4_ndx = get_rxt_ndx( 'jepn4' ) + jepn6_ndx = get_rxt_ndx( 'jepn6' ) + jepn7_ndx = get_rxt_ndx( 'jepn7' ) + jpni1_ndx = get_rxt_ndx( 'jpni1' ) + jpni2_ndx = get_rxt_ndx( 'jpni2' ) + jpni3_ndx = get_rxt_ndx( 'jpni3' ) + jpni4_ndx = get_rxt_ndx( 'jpni4' ) + ! added to v02 + jpni5_ndx = get_rxt_ndx( 'jpni5' ) + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + o3_ndx = get_spc_ndx( 'O3' ) + o3rad_ndx = get_spc_ndx( 'O3RAD' ) + o3_inv_ndx = get_inv_ndx( 'O3' ) + + n2_ndx = get_inv_ndx( 'N2' ) + n2_is_inv = n2_ndx > 0 + if( .not. n2_is_inv ) then + n2_ndx = get_spc_ndx( 'N2' ) + end if + o2_ndx = get_inv_ndx( 'O2' ) + o2_is_inv = o2_ndx > 0 + if( .not. o2_is_inv ) then + o2_ndx = get_spc_ndx( 'O2' ) + end if + no_ndx = get_spc_ndx( 'NO' ) + no_is_inv = no_ndx < 1 + if( no_is_inv ) then + no_ndx = get_inv_ndx( 'NO' ) + end if + o3_is_inv = o3_ndx < 1 + + o_ndx = get_spc_ndx( 'O' ) + o_is_inv = o_ndx < 1 + if( o_is_inv ) then + o_ndx = get_inv_ndx( 'O' ) + end if + + do_jshort = o_ndx>0 .and. o2_ndx>0 .and. (o3_ndx>0.or.o3_inv_ndx>0) .and. n2_ndx>0 .and. no_ndx>0 + + call jeuv_init( photon_file, electron_file, euv_indexer ) + do_jeuv = any(euv_indexer(:)>0) + + !---------------------------------------------------------------------- + ! ... call module initializers + !---------------------------------------------------------------------- + is_xactive : if( xactive_prates ) then + do_jshort = .false. + jch3cho_a_ndx = get_rxt_ndx( 'jch3cho_a' ) + jch3cho_b_ndx = get_rxt_ndx( 'jch3cho_b' ) + jch3cho_c_ndx = get_rxt_ndx( 'jch3cho_c' ) + jonitr_ndx = get_rxt_ndx( 'jonitr' ) + jho2no2_ndx = get_rxt_ndx( 'jho2no2' ) + call tuv_inti( pverp, tuv_xsect_file, lng_indexer ) + else is_xactive + call jlong_init( xs_long_file, rsf_file, lng_indexer ) + if (do_jeuv) then + call photo_bkgrnd_init() + call addfld('Qbkgndtot', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_o1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_o2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_n2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_n1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_no', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + endif + if (do_jshort) then + call jshort_init( xs_coef_file, xs_short_file, sht_indexer ) + endif + jho2no2_ndx = get_rxt_ndx( 'jho2no2_b' ) + end if is_xactive + + !---------------------------------------------------------------------- + ! ... check that each photorate is in short or long datasets + !---------------------------------------------------------------------- + if( any( ( abs(sht_indexer(:)) + abs(lng_indexer(:)) ) == 0 ) ) then + write(iulog,*) ' ' + write(iulog,*) 'photo_inti: the following photorate(s) are not in' + write(iulog,*) ' either the short or long datasets' + write(iulog,*) ' ' + do ndx = 1,phtcnt + if( abs(sht_indexer(ndx)) + abs(lng_indexer(ndx)) == 0 ) then + write(iulog,*) ' ',trim( rxt_tag_lst(ndx) ) + end if + end do + call endrun + end if + + !---------------------------------------------------------------------- + ! ... output any aliased photorates + !---------------------------------------------------------------------- + if( masterproc ) then + if( any( pht_alias_lst(:,1) /= ' ' ) ) then + write(iulog,*) ' ' + write(iulog,*) 'photo_inti: the following short photorate(s) are aliased' + write(iulog,*) ' ' + do ndx = 1,phtcnt + if( pht_alias_lst(ndx,1) /= ' ' ) then + if( pht_alias_mult(ndx,1) == 1._r8 ) then + write(iulog,*) ' ',trim(rxt_tag_lst(ndx)),' -> ',trim(pht_alias_lst(ndx,1)) + else + write(iulog,*) ' ',trim(rxt_tag_lst(ndx)),' -> ',pht_alias_mult(ndx,1),'*',trim(pht_alias_lst(ndx,1)) + end if + end if + end do + end if + if( any( pht_alias_lst(:,2) /= ' ' ) ) then + write(iulog,*) ' ' + write(iulog,*) 'photo_inti: the following long photorate(s) are aliased' + write(iulog,*) ' ' + do ndx = 1,phtcnt + if( pht_alias_lst(ndx,2) /= ' ' ) then + if( pht_alias_mult(ndx,2) == 1._r8 ) then + write(iulog,*) ' ',trim(rxt_tag_lst(ndx)),' -> ',trim(pht_alias_lst(ndx,2)) + else + write(iulog,*) ' ',trim(rxt_tag_lst(ndx)),' -> ',pht_alias_mult(ndx,2),'*',trim(pht_alias_lst(ndx,2)) + end if + end if + end do + end if + + write(iulog,*) ' ' + write(iulog,*) '*********************************************' + write(iulog,*) 'photo_inti: euv_indexer' + write(iulog,'(10i6)') euv_indexer(:) + write(iulog,*) 'photo_inti: sht_indexer' + write(iulog,'(10i6)') sht_indexer(:) + write(iulog,*) 'photo_inti: lng_indexer' + write(iulog,'(10i6)') lng_indexer(:) + write(iulog,*) '*********************************************' + write(iulog,*) ' ' + endif + + if( xactive_prates ) then + call o2_xsect_inti( o2_xsect_file ) + call photoin_inti( nlng, lng_indexer ) + end if + + !---------------------------------------------------------------------- + ! ... check for o2, o3 absorber columns + !---------------------------------------------------------------------- + if( ncol_abs > 0 ) then + spc_ndx = ox_ndx + if( spc_ndx < 1 ) then + spc_ndx = o3_ndx + end if + if( spc_ndx > 0 ) then + has_o3_col = .true. + else + has_o3_col = .false. + end if + if( ncol_abs > 1 ) then + if( o2_ndx > 1 ) then + has_o2_col = .true. + else + has_o2_col = .false. + end if + else + has_o2_col = .false. + end if + else + has_o2_col = .false. + has_o3_col = .false. + end if + + if ( len_trim(exo_coldens_file) == 0 ) then + has_o2_col = .false. + has_o3_col = .false. + endif + + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + cb1_ndx = get_spc_ndx( 'CB1' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + soa_ndx = get_spc_ndx( 'SOA' ) + ant_ndx = get_spc_ndx( 'NH4NO3' ) + so4_ndx = get_spc_ndx( 'SO4' ) + if (sslt_ncnst == 4) then + sa1_ndx = get_spc_ndx( sslt_names(1) ) + sa2_ndx = get_spc_ndx( sslt_names(2) ) + sa3_ndx = get_spc_ndx( sslt_names(3) ) + sa4_ndx = get_spc_ndx( sslt_names(4) ) + endif + + has_abs_columns : if( has_o2_col .or. has_o3_col ) then + !----------------------------------------------------------------------- + ! ... open exo coldens file + !----------------------------------------------------------------------- + filespec = trim( exo_coldens_file ) + call getfil( filespec, locfn, 0 ) + call cam_pio_openfile( ncid, trim(locfn), PIO_NOWRITE ) + + !----------------------------------------------------------------------- + ! ... get grid dimensions from file + !----------------------------------------------------------------------- + ! ... timing + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'month', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, ntimes ) + + if( ntimes /= 12 ) then + call endrun('photo_inti: exo coldens is not annual period') + end if + allocate( dates(ntimes),days(ntimes),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: dates,days allocation error = ',astat + call endrun + end if + dates(:) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + !----------------------------------------------------------------------- + ! ... initialize the monthly day of year times + !----------------------------------------------------------------------- + do n = 1,ntimes + days(n) = get_calday( dates(n), 0 ) + end do + deallocate( dates ) + !----------------------------------------------------------------------- + ! ... latitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lat', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, nlat ) + allocate( lats(nlat), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: lats allocation error = ',astat + call endrun + end if + ierr = pio_inq_varid( ncid, 'lat', vid ) + ierr = pio_get_var( ncid, vid, lats ) + lats(:nlat) = lats(:nlat) * d2r + !----------------------------------------------------------------------- + ! ... levels + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lev', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, n_exo_levs ) + allocate( levs(n_exo_levs), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: levs allocation error = ',astat + call endrun + end if + ierr = pio_inq_varid( ncid, 'lev', vid ) + ierr = pio_get_var( ncid, vid, levs ) + levs(:n_exo_levs) = levs(:n_exo_levs) * hPa2Pa + !----------------------------------------------------------------------- + ! ... set up regridding + !----------------------------------------------------------------------- + + allocate( coldens(nlat,n_exo_levs,ntimes),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: coldens allocation error = ',astat + call endrun + end if + if( has_o2_col ) then + allocate( o2_exo_coldens(n_exo_levs,pcols,begchunk:endchunk,ntimes),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: o2_exo_coldens allocation error = ',astat + call endrun + end if + ierr = pio_inq_varid( ncid, 'O2_column_density', vid ) + ierr = pio_get_var( ncid, vid,coldens ) + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call lininterp_init(lats, nlat, to_lats, ncols, 1, lat_wgts) + do n=1,ntimes + do k = 1,n_exo_levs + call lininterp(coldens(:,k,n), nlat, o2_exo_coldens(k,:,c,n), ncols, lat_wgts) + end do + end do + call lininterp_finish(lat_wgts) + enddo + + + end if + if( has_o3_col ) then + allocate( o3_exo_coldens(n_exo_levs,pcols,begchunk:endchunk,ntimes),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: o3_exo_coldens allocation error = ',astat + call endrun + end if + ierr = pio_inq_varid( ncid, 'O3_column_density', vid ) + ierr = pio_get_var( ncid, vid,coldens ) + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call lininterp_init(lats, nlat, to_lats, ncols, 1, lat_wgts) + do n=1,ntimes + do k = 1,n_exo_levs + call lininterp(coldens(:,k,n), nlat, o3_exo_coldens(k,:,c,n), ncols, lat_wgts) + end do + end do + call lininterp_finish(lat_wgts) + enddo + end if + call pio_closefile (ncid) + deallocate( coldens,stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo_inti: failed to deallocate coldens; error = ',astat + call endrun + end if + has_fixed_press = (num_pr_lev .ne. 0) + !----------------------------------------------------------------------- + ! ... setup the pressure interpolation + !----------------------------------------------------------------------- + if( has_fixed_press ) then + pinterp = ptop_ref + if( pinterp <= levs(1) ) then + ki = 1 + delp = 0._r8 + else + do ki = 2,n_exo_levs + if( pinterp <= levs(ki) ) then + delp = log( pinterp/levs(ki-1) )/log( levs(ki)/levs(ki-1) ) + exit + end if + end do + end if +#ifdef DEBUG + write(iulog,*) '-----------------------------------' + write(iulog,*) 'photo_inti: diagnostics' + write(iulog,*) 'ki, delp = ',ki,delp + write(iulog,*) 'pinterp,levs(ki-1:ki) = ',pinterp,levs(ki-1:ki) + write(iulog,*) '-----------------------------------' +#endif + end if + end if has_abs_columns + + end subroutine photo_inti + + subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & + col_dens, zen_angle, srf_alb, lwc, clouds, & + esfact, vmr, invariants, ncol, lchnk, pbuf ) +!----------------------------------------------------------------- +! ... table photorates for wavelengths > 200nm +!----------------------------------------------------------------- + + use chem_mods, only : ncol_abs => nabscol, phtcnt, gas_pcnst, nfs + use chem_mods, only : pht_alias_mult, indexm + use mo_jshort, only : nsht => nj, jshort + use mo_jlong, only : nlng => numj, jlong + use mo_jeuv, only : neuv, jeuv, nIonRates + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + use photo_bkgrnd, only : photo_bkgrnd_calc + use cam_history, only : outfld + use infnan, only : nan, assignment(=) + + implicit none + +!----------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------- + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + real(r8), intent(in) :: esfact ! earth sun distance factor + real(r8), intent(in) :: vmr(ncol,pver,max(1,gas_pcnst)) ! vmr + real(r8), intent(in) :: col_dens(ncol,pver,ncol_abs) ! column densities (molecules/cm^2) + real(r8), intent(in) :: zen_angle(ncol) ! solar zenith angle (radians) + real(r8), intent(in) :: srf_alb(pcols) ! surface albedo + real(r8), intent(in) :: lwc(ncol,pver) ! liquid water content (kg/kg) + real(r8), intent(in) :: clouds(ncol,pver) ! cloud fraction + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoint (Pa) + real(r8), intent(in) :: temper(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: zmid(ncol,pver) ! midpoint height (km) + real(r8), intent(in) :: zint(ncol,pver) ! interface height (km) + real(r8), intent(in) :: invariants(ncol,pver,max(1,nfs)) ! invariant densities (molecules/cm^3) + real(r8), intent(inout) :: photos(ncol,pver,phtcnt) ! photodissociation rates (1/s) + type(physics_buffer_desc),pointer :: pbuf(:) + +!----------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------- + real(r8), parameter :: Pa2mb = 1.e-2_r8 ! pascals to mb + + integer :: i, k, m ! indicies + integer :: astat + real(r8) :: sza + real(r8) :: alias_factor + real(r8) :: fac1(pver) ! work space for j(no) calc + real(r8) :: fac2(pver) ! work space for j(no) calc + real(r8) :: colo3(pver) ! vertical o3 column density + real(r8) :: parg(pver) ! vertical pressure array (hPa) + + real(r8) :: cld_line(pver) ! vertical cloud array + real(r8) :: lwc_line(pver) ! vertical lwc array + real(r8) :: eff_alb(pver) ! effective albedo from cloud modifications + real(r8) :: cld_mult(pver) ! clould multiplier + real(r8), allocatable :: lng_prates(:,:) ! photorates matrix (1/s) + real(r8), allocatable :: sht_prates(:,:) ! photorates matrix (1/s) + real(r8), allocatable :: euv_prates(:,:) ! photorates matrix (1/s) + + + real(r8), allocatable :: zarg(:) + real(r8), allocatable :: tline(:) ! vertical temperature array + real(r8), allocatable :: o_den(:) ! o density (molecules/cm^3) + real(r8), allocatable :: o2_den(:) ! o2 density (molecules/cm^3) + real(r8), allocatable :: o3_den(:) ! o3 density (molecules/cm^3) + real(r8), allocatable :: no_den(:) ! no density (molecules/cm^3) + real(r8), allocatable :: n2_den(:) ! n2 density (molecules/cm^3) + real(r8), allocatable :: jno_sht(:) ! no short photorate + real(r8), allocatable :: jo2_sht(:,:) ! o2 short photorate + + real(r8), pointer :: ionRates(:,:,:) ! Pointer to ionization rates for O+,O2+,N+,N2+,NO+ in pbuf (s-1 from modules mo_jeuv and mo_jshort) + + integer :: n_jshrt_levs, p1, p2 + real(r8) :: ideltaZkm + + real(r8) :: qbktot(ncol,pver) + real(r8) :: qbko1(ncol,pver) + real(r8) :: qbko2(ncol,pver) + real(r8) :: qbkn2(ncol,pver) + real(r8) :: qbkn1(ncol,pver) + real(r8) :: qbkno(ncol,pver) + + qbktot(:,:) = nan + qbko1(:,:) = nan + qbko2(:,:) = nan + qbkn2(:,:) = nan + qbkn1(:,:) = nan + qbkno(:,:) = nan + + if( phtcnt < 1 ) then + return + end if + + if ((.not.do_jshort) .or. (ptop_ref < 10._r8)) then + n_jshrt_levs = pver + p1 = 1 + p2 = pver + else + n_jshrt_levs = pver+1 + p1 = 2 + p2 = pver+1 + endif + + allocate( zarg(n_jshrt_levs) ) + allocate( tline(n_jshrt_levs) ) + if (do_jshort) then + allocate( o_den(n_jshrt_levs) ) + allocate( o2_den(n_jshrt_levs) ) + allocate( o3_den(n_jshrt_levs) ) + allocate( no_den(n_jshrt_levs) ) + allocate( n2_den(n_jshrt_levs) ) + allocate( jno_sht(n_jshrt_levs) ) + allocate( jo2_sht(n_jshrt_levs,2) ) + endif + +!----------------------------------------------------------------- +! ... allocate short, long temp arrays +!----------------------------------------------------------------- + if ( do_jeuv ) then + if (neuv>0) then + allocate( euv_prates(pver,neuv),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo: Failed to allocate euv_prates; error = ',astat + call endrun + end if + endif + endif + + if (nsht>0) then + allocate( sht_prates(n_jshrt_levs,nsht),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo: Failed to allocate sht_prates; error = ',astat + call endrun + end if + endif + + if (nlng>0) then + allocate( lng_prates(nlng,pver),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photo: Failed to allocate lng_prates; error = ',astat + call endrun + end if + endif + +!----------------------------------------------------------------- +! ... zero all photorates +!----------------------------------------------------------------- + do m = 1,max(1,phtcnt) + do k = 1,pver + photos(:,k,m) = 0._r8 + end do + end do + +!------------------------------------------------------------------------------------------------------------ +! Point to production rates array in physics buffer where rates will be stored for ionosphere module +! access. Also, initialize rates to zero before column loop since only daylight values are filled +!------------------------------------------------------------------------------------------------------------ + if (ion_rates_idx>0) then + call pbuf_get_field(pbuf, ion_rates_idx, ionRates) + ionRates(:,:,:) = 0._r8 + endif + + col_loop : do i = 1,ncol + if (do_jshort) then + + if ( o_is_inv ) then + o_den(p1:p2) = invariants(i,:pver,o_ndx) + else + o_den(p1:p2) = vmr(i,:pver,o_ndx) * invariants(i,:pver,indexm) + endif + if ( o2_is_inv ) then + o2_den(p1:p2) = invariants(i,:pver,o2_ndx) + else + o2_den(p1:p2) = vmr(i,:pver,o2_ndx) * invariants(i,:pver,indexm) + endif + if ( o3_is_inv ) then + o3_den(p1:p2) = invariants(i,:pver,o3_inv_ndx) + else + o3_den(p1:p2) = vmr(i,:,o3_ndx) * invariants(i,:pver,indexm) + endif + if ( n2_is_inv ) then + n2_den(p1:p2) = invariants(i,:,n2_ndx) + else + n2_den(p1:p2) = vmr(i,:pver,n2_ndx) * invariants(i,:pver,indexm) + endif + if ( no_is_inv ) then + no_den(p1:p2) = invariants(i,:pver,no_ndx) + else + no_den(p1:p2) = vmr(i,:pver,no_ndx) * invariants(i,:pver,indexm) + endif + + endif + sza = zen_angle(i)*r2d + daylight : if( sza >= 0._r8 .and. sza < max_zen_angle ) then + parg(:) = Pa2mb*pmid(i,:) + colo3(:) = col_dens(i,:,1) + fac1(:) = pdel(i,:) + lwc_line(:) = lwc(i,:) + cld_line(:) = clouds(i,:) + + + tline(p1:p2) = temper(i,:pver) + + zarg(p1:p2) = zmid(i,:pver) + + if ( ptop_ref > 10._r8 ) then + if (jppi_ndx > 0 ) photos(i,:,jppi_ndx) = photos(i,:,jppi_ndx) + esfact * 0.42_r8 + if (jepn1_ndx > 0 ) photos(i,:,jepn1_ndx) = photos(i,:,jepn1_ndx) + esfact * 1.4_r8 + if (jepn2_ndx > 0 ) photos(i,:,jepn2_ndx) = photos(i,:,jepn2_ndx) + esfact * 3.8e-1_r8 + if (jepn3_ndx > 0 ) photos(i,:,jepn3_ndx) = photos(i,:,jepn3_ndx) + esfact * 4.7e-2_r8 + if (jepn4_ndx > 0 ) photos(i,:,jepn4_ndx) = photos(i,:,jepn4_ndx) + esfact * 1.1_r8 + if (jepn6_ndx > 0 ) photos(i,:,jepn6_ndx) = photos(i,:,jepn6_ndx) + esfact * 8.0e-4_r8 + if (jepn7_ndx > 0 ) photos(i,:,jepn7_ndx) = photos(i,:,jepn7_ndx) + esfact * 5.2e-2_r8 + if (jpni1_ndx > 0 ) photos(i,:,jpni1_ndx) = photos(i,:,jpni1_ndx) + esfact * 0.47_r8 + if (jpni2_ndx > 0 ) photos(i,:,jpni2_ndx) = photos(i,:,jpni2_ndx) + esfact * 0.24_r8 + if (jpni3_ndx > 0 ) photos(i,:,jpni3_ndx) = photos(i,:,jpni3_ndx) + esfact * 0.15_r8 + if (jpni4_ndx > 0 ) photos(i,:,jpni4_ndx) = photos(i,:,jpni4_ndx) + esfact * 6.2e-3_r8 + ! added to v02 + if (jpni5_ndx > 0 ) photos(i,:,jpni5_ndx) = photos(i,:,jpni5_ndx) + esfact * 1.0_r8 + endif + if (do_jshort) then + if ( ptop_ref > 10._r8 ) then + !----------------------------------------------------------------- + ! Only for lower lid versions of CAM (i.e., not for WACCM) + ! Column O3 and O2 above the top of the model + ! DEK 20110224 + !----------------------------------------------------------------- + ideltaZkm = 1._r8/(zint(i,1) - zint(i,2)) + + !----------------------------------------------------------------- + !... set density (units: molecules cm-3) + !... used for jshort + !....... Assuming a scale height of 7km for ozone + !....... Assuming a scale height of 7km for O2 + !----------------------------------------------------------------- + o3_den(1) = o3_den(2)*7.0_r8 * ideltaZkm + + o2_den(1) = o2_den(2)*7.0_r8 * ideltaZkm + + no_den(1) = no_den(2)*0.9_r8 + + n2_den(1) = n2_den(2)*0.9_r8 + + tline(1) = tline(2) + 5.0_r8 + + zarg(1) = zarg(2) + (zint(i,1) - zint(i,2)) + + endif + + !----------------------------------------------------------------- + ! ... short wave length component + !----------------------------------------------------------------- + call jshort( n_jshrt_levs, sza, n2_den, o2_den, o3_den, & + no_den, tline, zarg, jo2_sht, jno_sht, sht_prates ) + + do m = 1,phtcnt + if( sht_indexer(m) > 0 ) then + alias_factor = pht_alias_mult(m,1) + if( alias_factor == 1._r8 ) then + photos(i,pver:1:-1,m) = sht_prates(1:pver,sht_indexer(m)) + else + photos(i,pver:1:-1,m) = alias_factor * sht_prates(1:pver,sht_indexer(m)) + end if + end if + end do + + if( jno_ndx > 0 ) photos(i,pver:1:-1,jno_ndx) = jno_sht(1:pver) + if( jo2_a_ndx > 0 ) photos(i,pver:1:-1,jo2_a_ndx) = jo2_sht(1:pver,2) + if( jo2_b_ndx > 0 ) photos(i,pver:1:-1,jo2_b_ndx) = jo2_sht(1:pver,1) + endif + + if ( do_jeuv ) then + !----------------------------------------------------------------- + ! ... euv photorates do not include cloud effects ?? + !----------------------------------------------------------------- + call jeuv( pver, sza, o_den, o2_den, n2_den, zarg, euv_prates ) + do m = 1,neuv + if( euv_indexer(m) > 0 ) then + photos(i,:,euv_indexer(m)) = esfact * euv_prates(:,m) + endif + enddo + endif + + !----------------------------------------------------------------- + ! ... compute eff_alb and cld_mult -- needs to be before jlong + !----------------------------------------------------------------- + call cloud_mod( zen_angle(i), cld_line, lwc_line, fac1, srf_alb(i), & + eff_alb, cld_mult ) + cld_mult(:) = esfact * cld_mult(:) + + !----------------------------------------------------------------- + ! ... long wave length component + !----------------------------------------------------------------- + call jlong( pver, sza, eff_alb, parg, tline, colo3, lng_prates ) + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + alias_factor = pht_alias_mult(m,2) + if( alias_factor == 1._r8 ) then + photos(i,:,m) = (photos(i,:,m) + lng_prates(lng_indexer(m),:))*cld_mult(:) + else + photos(i,:,m) = (photos(i,:,m) + alias_factor * lng_prates(lng_indexer(m),:))*cld_mult(:) + end if + end if + end do + + !----------------------------------------------------------------- + ! ... calculate j(no) from formula + !----------------------------------------------------------------- + if( (jno_ndx > 0) .and. (.not.do_jshort)) then + if( has_o2_col .and. has_o3_col ) then + fac1(:) = 1.e-8_r8 * (abs(col_dens(i,:,2)/cos(zen_angle(i))))**.38_r8 + fac2(:) = 5.e-19_r8 * abs(col_dens(i,:,1)/cos(zen_angle(i))) + photos(i,:,jno_ndx) = photos(i,:,jno_ndx) + 4.5e-6_r8 * exp( -(fac1(:) + fac2(:)) ) + end if + end if + + !----------------------------------------------------------------- + ! ... add near IR correction to ho2no2 + !----------------------------------------------------------------- + if( jho2no2_ndx > 0 ) then + photos(i,:,jho2no2_ndx) = photos(i,:,jho2no2_ndx) + 1.e-5_r8*cld_mult(:) + endif + + ! Save photo-ionization rates to physics buffer accessed in ionosphere module for WACCMX + if (ion_rates_idx>0) then + + ionRates(i,1:pver,1:nIonRates) = esfact * euv_prates(1:pver,1:nIonRates) + + endif + + end if daylight + + if (do_jeuv) then + !----------------------------------------------------------------- + ! include background ionization ... + ! outside daylight block so this is applied in all columns + !----------------------------------------------------------------- + call photo_bkgrnd_calc( f107, o_den, o2_den, n2_den, no_den, zint(i,:),& + photos(i,:,:), qbko1_out=qbko1(i,:), qbko2_out=qbko2(i,:), & + qbkn2_out=qbkn2(i,:), qbkn1_out=qbkn1(i,:), qbkno_out=qbkno(i,:) ) + endif + + end do col_loop + + if ( do_jeuv ) then + qbktot(:ncol,:) = qbko1(:ncol,:)+qbko2(:ncol,:)+qbkn2(:ncol,:)+qbkn1(:ncol,:)+qbkno(:ncol,:) + call outfld( 'Qbkgndtot', qbktot(:ncol,:),ncol, lchnk ) + call outfld( 'Qbkgnd_o1', qbko1(:ncol,:), ncol, lchnk ) + call outfld( 'Qbkgnd_o2', qbko2(:ncol,:), ncol, lchnk ) + call outfld( 'Qbkgnd_n2', qbkn2(:ncol,:), ncol, lchnk ) + call outfld( 'Qbkgnd_n1', qbkn1(:ncol,:), ncol, lchnk ) + call outfld( 'Qbkgnd_no', qbkno(:ncol,:), ncol, lchnk ) + endif + + if ( allocated(lng_prates) ) deallocate( lng_prates ) + if ( allocated(sht_prates) ) deallocate( sht_prates ) + if ( allocated(euv_prates) ) deallocate( euv_prates ) + + if ( allocated(zarg) ) deallocate( zarg ) + if ( allocated(tline) ) deallocate( tline ) + if ( allocated(o_den) ) deallocate( o_den ) + if ( allocated(o2_den) ) deallocate( o2_den ) + if ( allocated(o3_den) ) deallocate( o3_den ) + if ( allocated(no_den) ) deallocate( no_den ) + if ( allocated(n2_den) ) deallocate( n2_den ) + if ( allocated(jno_sht) ) deallocate( jno_sht ) + if ( allocated(jo2_sht) ) deallocate( jo2_sht ) + + call set_xnox_photo( photos, ncol ) + + end subroutine table_photo + + subroutine xactive_photo( photos, vmr, temper, cwat, cldfr, & + pmid, zmid, col_dens, zen_angle, srf_alb, & + tdens, ps, ts, esfact, relhum, dust_vmr, & + dt_diag, fracday, & + ncol, lchnk ) + !----------------------------------------------------------------- + ! ... fast online photo rates + !----------------------------------------------------------------- + + use ppgrid, only : pver, pverp + use chem_mods, only : ncol_abs => nabscol, pcnstm1 => gas_pcnst, phtcnt + use chem_mods, only : pht_alias_mult + use mo_params, only : kw + use mo_wavelen, only : nw + use mo_photoin, only : photoin + use mo_tuv_inti, only : nlng + use time_manager, only : get_curr_date + use dust_model, only : dust_nbin + use phys_grid, only : get_rlat_all_p, get_rlon_all_p + + implicit none + + !---------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------- + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: esfact ! earth sun distance factor + real(r8), intent(in) :: ps(pcols) ! surface pressure (Pa) + real(r8), intent(in) :: ts(ncol) ! surface temperature (K) + real(r8), intent(in) :: col_dens(ncol,pver,ncol_abs) ! column densities (molecules/cm^2) + real(r8), intent(in) :: zen_angle(ncol) ! solar zenith angle (radians) + real(r8), intent(in) :: srf_alb(pcols) ! surface albedo + real(r8), intent(in) :: tdens(ncol,pver) ! total atms density (molecules/cm^3) + real(r8), intent(in) :: vmr(ncol,pver,pcnstm1) ! species concentration (mol/mol) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: zmid(ncol,pver) ! midpoint height (m) + real(r8), intent(in) :: temper(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: relhum(ncol,pver) ! relative humidity + real(r8), intent(in) :: cwat(ncol,pver) ! cloud water (kg/kg) + real(r8), intent(in) :: cldfr(ncol,pver) ! cloud fraction + real(r8), intent(in) :: dust_vmr(ncol,pver,dust_nbin)! dust concentration (mol/mol) + real(r8), intent(inout) :: photos(ncol,pver,phtcnt) ! photodissociation rates (1/s) + real(r8), intent(out) :: dt_diag(pcols,8) ! od diagnostics + real(r8), intent(out) :: fracday(pcols) ! fraction of day + !----------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------- + integer, parameter :: k_diag = 3 + real(r8), parameter :: secant_limit = 50._r8 + + integer :: astat + integer :: i ! index + integer :: k ! index + integer :: m ! index + integer :: ndx ! index + integer :: spc_ndx ! index + integer :: yr, mon, day, tod ! time of day (seconds past 0Z) + integer :: ncdate ! current date(yyyymmdd) + + real(r8) :: sza + real(r8) :: secant + real(r8) :: alias_factor + real(r8) :: alat + real(r8) :: along + real(r8) :: ut + real(r8) :: fac1(pver) ! work space for j(no) calc + real(r8) :: fac2(pver) ! work space for j(no) calc + real(r8) :: tlay(pver) ! vertical temperature array at layer midpoint + real(r8) :: tline(pverp) ! vertical temperature array + real(r8) :: xlwc(pverp) ! cloud water (kg/kg) + real(r8) :: xfrc(pverp) ! cloud fraction xuexi + real(r8) :: airdens(pverp) ! atmospheric density + real(r8) :: o3line(pverp) ! vertical o3 vmr + real(r8) :: aerocs1(pverp) + real(r8) :: aerocs2(pverp) + real(r8) :: aercbs1(pverp) + real(r8) :: aercbs2(pverp) + real(r8) :: aersoa(pverp) + real(r8) :: aerant(pverp) + real(r8) :: aerso4(pverp) + real(r8) :: aerds(4,pverp) + real(r8) :: rh(pverp) + real(r8) :: zarg(pverp) ! vertical height array + real(r8) :: aersal(pverp,4) + real(r8) :: albedo(kw) ! wavelenght dependent albedo + real(r8) :: dt_xdiag(8) ! wrk array + real(r8), allocatable :: prates(:,:) ! photorates matrix + + logical :: zagtz(ncol) ! zenith angle > 0 flag array + real(r8), dimension(ncol) :: rlats, rlons ! chunk latitudes and longitudes (radians) + + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + + !----------------------------------------------------------------- + ! ... any photorates ? + !----------------------------------------------------------------- + if( phtcnt < 1 ) then + return + end if + + !----------------------------------------------------------------- + ! ... zero all photorates + !----------------------------------------------------------------- + do m = 1,phtcnt + do k = 1,pver + photos(:,k,m) = 0._r8 + end do + end do + +!----------------------------------------------------------------- +! ... allocate "working" rate array +!----------------------------------------------------------------- + allocate( prates(pverp,nlng), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'xactive_photo: failed to allocate prates; error = ',astat + call endrun + end if + + zagtz(:) = zen_angle(:) < .99_r8*pi/2._r8 .and. zen_angle(:) > 0._r8 !! daylight + fracday(:) = 0._r8 + dt_diag(:,:) = 0._r8 + + call get_curr_date(yr, mon, day, tod, 0) + ncdate = yr*10000 + mon*100 + day + ut = real(tod)/3600._r8 +#ifdef DEBUG + write(iulog,*) 'photo: nj = ',nlng + write(iulog,*) 'photo: esfact = ',esfact +#endif + col_loop : do i = 1,ncol +daylight : & + if( zagtz(i) ) then + sza = zen_angle(i)*r2d + secant = 1._r8 / cos( zen_angle(i) ) +secant_in_bounds : & + if( secant <= secant_limit ) then + fracday(i) = 1._r8 + zarg(pverp:2:-1) = zmid(i,:) + zarg(1) = 0._r8 + airdens(pverp:2:-1) = tdens(i,:) + airdens(1) = 10._r8 * ps(i) / (boltz*ts(i)) + if( o3rad_ndx > 0 ) then + spc_ndx = o3rad_ndx + else + spc_ndx = ox_ndx + end if + if( spc_ndx < 1 ) then + spc_ndx = o3_ndx + end if + if( spc_ndx > 0 ) then + o3line(pverp:2:-1) = vmr(i,:,spc_ndx) + else + o3line(pverp:2:-1) = 0._r8 + end if + o3line(1) = o3line(2) + tline(pverp:2:-1) = temper(i,:) + tline(1) = tline(2) + rh(pverp:2:-1) = relhum(i,:) + rh(1) = rh(2) + xlwc(pverp:2:-1) = cwat(i,:) * pmid(i,:)/(temper(i,:)*287._r8) * kg2g !! TIE + xlwc(1) = xlwc(2) + xfrc(pverp:2:-1) = cldfr(i,:) ! cloud fraction + xfrc(1) = xfrc(2) + tlay(1:pver) = .5_r8*(tline(1:pver) + tline(2:pverp)) + albedo(1:nw) = srf_alb(i) + + alat = rlats(i) + along= rlons(i) + + if( oc1_ndx > 0 ) then + aerocs1(pverp:2:-1) = vmr(i,:,oc1_ndx) + else + aerocs1(pverp:2:-1) = 0._r8 + end if + aerocs1(1) = aerocs1(2) + if( oc2_ndx > 0 ) then + aerocs2(pverp:2:-1) = vmr(i,:,oc2_ndx) + else + aerocs2(pverp:2:-1) = 0._r8 + end if + aerocs2(1) = aerocs2(2) + if( cb1_ndx > 0 ) then + aercbs1(pverp:2:-1) = vmr(i,:,cb1_ndx) + else + aercbs1(pverp:2:-1) = 0._r8 + end if + aercbs1(1) = aercbs1(2) + if( cb2_ndx > 0 ) then + aercbs2(pverp:2:-1) = vmr(i,:,cb2_ndx) + else + aercbs2(pverp:2:-1) = 0._r8 + end if + aercbs2(1) = aercbs2(2) + if( soa_ndx > 0 ) then + aersoa(pverp:2:-1) = vmr(i,:,soa_ndx) + else + aersoa(pverp:2:-1) = 0._r8 + end if + aersoa(1) = aersoa(2) + if( ant_ndx > 0 ) then + aerant(pverp:2:-1) = vmr(i,:,ant_ndx) + else + aerant(pverp:2:-1) = 0._r8 + end if + aerant(1) = aerant(2) + if( so4_ndx > 0 ) then + aerso4(pverp:2:-1) = vmr(i,:,so4_ndx) + else + aerso4(pverp:2:-1) = 0._r8 + end if + aerso4(1) = aerso4(2) + if ( dust_nbin == 4 ) then + do ndx = 1,4 + aerds(ndx,pverp:2:-1) = dust_vmr(i,:,ndx) + end do + else + do ndx = 1,4 + aerds(ndx,pverp:2:-1) = 0._r8 + end do + endif + aerds(1,1) = aerds(1,2) + aerds(2,1) = aerds(2,2) + aerds(3,1) = aerds(3,2) + aerds(4,1) = aerds(4,2) + if( sa1_ndx > 0 ) then + aersal(pverp:2:-1,1) = vmr(i,:,sa1_ndx) + else + aersal(pverp:2:-1,1) = 0._r8 + end if + if( sa2_ndx > 0 ) then + aersal(pverp:2:-1,2) = vmr(i,:,sa2_ndx) + else + aersal(pverp:2:-1,2) = 0._r8 + end if + if( sa3_ndx > 0 ) then + aersal(pverp:2:-1,3) = vmr(i,:,sa3_ndx) + else + aersal(pverp:2:-1,3) = 0._r8 + end if + if( sa4_ndx > 0 ) then + aersal(pverp:2:-1,4) = vmr(i,:,sa4_ndx) + else + aersal(pverp:2:-1,4) = 0._r8 + end if + aersal(1,:) = aersal(2,:) + call photoin( ncdate, alat, along, & + ut, esfact, col_dens(i,1,1), col_dens(i,1,2), albedo, & + zarg, tline, tlay, xlwc, xfrc, & + airdens, aerocs1, aerocs2, aercbs1, aercbs2, & + aersoa, aerant, aerso4, aersal, aerds, o3line, rh, & + prates, sza, nw, dt_xdiag ) + dt_diag(i,:) = dt_xdiag(:) + + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + alias_factor = pht_alias_mult(m,2) + if( alias_factor == 1._r8 ) then + photos(i,:,m) = prates(1:pver,lng_indexer(m)) + else + photos(i,:,m) = alias_factor * prates(1:pver,lng_indexer(m)) + end if + end if + +#ifdef DEBUG + if( do_diag ) then + write(iulog,'(''xactive_photo: prates('',i2,'',.)'')') m + write(iulog,'(1p,5e21.13)') photos(i,:pver,m) + write(iulog,*) ' ' + end if +#endif + + end do +!----------------------------------------------------------------- +! ... set j(onitr) +!----------------------------------------------------------------- + if( jonitr_ndx > 0 ) then + if( jch3cho_a_ndx > 0 ) then + photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jch3cho_a_ndx) + end if + if( jch3cho_b_ndx > 0 ) then + photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jonitr_ndx) + photos(i,1:pver,jch3cho_b_ndx) + end if + if( jch3cho_c_ndx > 0 ) then + photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jonitr_ndx) + photos(i,1:pver,jch3cho_c_ndx) + end if + end if +!----------------------------------------------------------------- +! ... calculate j(no) from formula +!----------------------------------------------------------------- + if( jno_ndx > 0 ) then + if( has_o2_col .and. has_o3_col ) then + fac1(:) = 1.e-8_r8 * (col_dens(i,:,2)/cos(zen_angle(i)))**.38_r8 + fac2(:) = 5.e-19_r8 * col_dens(i,:,1) / cos(zen_angle(i)) + photos(i,:,jno_ndx) = 4.5e-6_r8 * exp( -(fac1(:) + fac2(:)) ) + end if + end if +!----------------------------------------------------------------- +! ... add near IR correction to j(ho2no2) +!----------------------------------------------------------------- + if( jho2no2_ndx > 0 ) then + photos(i,:,jho2no2_ndx) = photos(i,:,jho2no2_ndx) + 1.e-5_r8 + endif + end if secant_in_bounds + end if daylight + end do col_loop + + call set_xnox_photo( photos, ncol ) + + deallocate( prates ) + + end subroutine xactive_photo + + subroutine cloud_mod( zen_angle, clouds, lwc, delp, srf_alb, & + eff_alb, cld_mult ) + !----------------------------------------------------------------------- + ! ... cloud alteration factors for photorates and albedo + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + real(r8), intent(in) :: zen_angle ! zenith angle + real(r8), intent(in) :: srf_alb ! surface albedo + real(r8), intent(in) :: clouds(pver) ! cloud fraction + real(r8), intent(in) :: lwc(pver) ! liquid water content (mass mr) + real(r8), intent(in) :: delp(pver) ! del press about midpoint in pascals + real(r8), intent(out) :: eff_alb(pver) ! effective albedo + real(r8), intent(out) :: cld_mult(pver) ! photolysis mult factor + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: k + real(r8) :: coschi + real(r8) :: del_lwp(pver) + real(r8) :: del_tau(pver) + real(r8) :: above_tau(pver) + real(r8) :: below_tau(pver) + real(r8) :: above_cld(pver) + real(r8) :: below_cld(pver) + real(r8) :: above_tra(pver) + real(r8) :: below_tra(pver) + real(r8) :: fac1(pver) + real(r8) :: fac2(pver) + + real(r8), parameter :: rgrav = 1._r8/9.80616_r8 + + !--------------------------------------------------------- + ! ... modify lwc for cloud fraction and form + ! liquid water path for each layer + !--------------------------------------------------------- + where( clouds(:) /= 0._r8 ) + del_lwp(:) = rgrav * lwc(:) * delp(:) * 1.e3_r8 / clouds(:) + elsewhere + del_lwp(:) = 0._r8 + endwhere + !--------------------------------------------------------- + ! ... form tau for each model layer + !--------------------------------------------------------- + where( clouds(:) /= 0._r8 ) + del_tau(:) = del_lwp(:) *.155_r8 * clouds(:)**1.5_r8 + elsewhere + del_tau(:) = 0._r8 + end where + !--------------------------------------------------------- + ! ... form integrated tau from top down + !--------------------------------------------------------- + above_tau(1) = 0._r8 + do k = 1,pverm + above_tau(k+1) = del_tau(k) + above_tau(k) + end do + !--------------------------------------------------------- + ! ... form integrated tau from bottom up + !--------------------------------------------------------- + below_tau(pver) = 0._r8 + do k = pverm,1,-1 + below_tau(k) = del_tau(k+1) + below_tau(k+1) + end do + !--------------------------------------------------------- + ! ... form vertically averaged cloud cover above and below + !--------------------------------------------------------- + above_cld(1) = 0._r8 + do k = 1,pverm + above_cld(k+1) = clouds(k) * del_tau(k) + above_cld(k) + end do + do k = 2,pver + if( above_tau(k) /= 0._r8 ) then + above_cld(k) = above_cld(k) / above_tau(k) + else + above_cld(k) = above_cld(k-1) + end if + end do + below_cld(pver) = 0._r8 + do k = pverm,1,-1 + below_cld(k) = clouds(k+1) * del_tau(k+1) + below_cld(k+1) + end do + do k = pverm,1,-1 + if( below_tau(k) /= 0._r8 ) then + below_cld(k) = below_cld(k) / below_tau(k) + else + below_cld(k) = below_cld(k+1) + end if + end do + !--------------------------------------------------------- + ! ... modify above_tau and below_tau via jfm + !--------------------------------------------------------- + where( above_cld(2:pver) /= 0._r8 ) + above_tau(2:pver) = above_tau(2:pver) / above_cld(2:pver) + end where + where( below_cld(:pverm) /= 0._r8 ) + below_tau(:pverm) = below_tau(:pverm) / below_cld(:pverm) + end where + where( above_tau(2:pver) < 5._r8 ) + above_cld(2:pver) = 0._r8 + end where + where( below_tau(:pverm) < 5._r8 ) + below_cld(:pverm) = 0._r8 + end where + !--------------------------------------------------------- + ! ... form transmission factors + !--------------------------------------------------------- + above_tra(:) = 11.905_r8 / (9.524_r8 + above_tau(:)) + below_tra(:) = 11.905_r8 / (9.524_r8 + below_tau(:)) + !--------------------------------------------------------- + ! ... form effective albedo + !--------------------------------------------------------- + where( below_cld(:) /= 0._r8 ) + eff_alb(:) = srf_alb + below_cld(:) * (1._r8 - below_tra(:)) & + * (1._r8 - srf_alb) + elsewhere + eff_alb(:) = srf_alb + end where + coschi = max( cos( zen_angle ),.5_r8 ) + where( del_lwp(:)*.155_r8 < 5._r8 ) + fac1(:) = 0._r8 + elsewhere + fac1(:) = 1.4_r8 * coschi - 1._r8 + end where + fac2(:) = min( 0._r8,1.6_r8*coschi*above_tra(:) - 1._r8 ) + cld_mult(:) = 1._r8 + fac1(:) * clouds(:) + fac2(:) * above_cld(:) + cld_mult(:) = max( .05_r8,cld_mult(:) ) + + end subroutine cloud_mod + + subroutine set_ub_col( col_delta, vmr, invariants, ptop, pdel, ncol, lchnk ) + !--------------------------------------------------------------- + ! ... set the column densities at the upper boundary + !--------------------------------------------------------------- + + use chem_mods, only : nfs, ncol_abs=>nabscol, indexm + use chem_mods, only : nabscol, gas_pcnst, indexm + use chem_mods, only : gas_pcnst + + implicit none + + !--------------------------------------------------------------- + ! ... dummy args + !--------------------------------------------------------------- + real(r8), intent(in) :: ptop(pcols) ! top pressure (Pa) + integer, intent(in) :: ncol ! number of columns in current chunk + integer, intent(in) :: lchnk ! latitude indicies in chunk + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) ! xported species vmr + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: invariants(ncol,pver,nfs) + real(r8), intent(out) :: col_delta(ncol,0:pver,max(1,nabscol)) ! /cm**2 o2,o3 col dens above model + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + !--------------------------------------------------------------- + ! note: xfactor = 10.*r/(k*g) in cgs units. + ! the factor 10. is to convert pdel + ! from pascals to dyne/cm**2. + !--------------------------------------------------------------- + real(r8), parameter :: xfactor = 2.8704e21_r8/(9.80616_r8*1.38044_r8) + integer :: k, kl, spc_ndx + real(r8) :: tint_vals(2) + real(r8) :: o2_exo_col(ncol) + real(r8) :: o3_exo_col(ncol) + integer :: i + + !--------------------------------------------------------------- + ! ... assign column density at the upper boundary + ! the first column is o3 and the second is o2. + ! add 10 du o3 column above top of model. + !--------------------------------------------------------------- + !--------------------------------------------------------------- + ! ... set exo absorber columns + !--------------------------------------------------------------- + has_abs_cols : if( has_o2_col .and. has_o3_col ) then + if( has_fixed_press ) then + kl = ki - 1 + if( has_o2_col ) then + do i = 1,ncol + if ( kl > 0 ) then + tint_vals(1) = o2_exo_coldens(kl,i,lchnk,last) & + + delp * (o2_exo_coldens(ki,i,lchnk,last) & + - o2_exo_coldens(kl,i,lchnk,last)) + tint_vals(2) = o2_exo_coldens(kl,i,lchnk,next) & + + delp * (o2_exo_coldens(ki,i,lchnk,next) & + - o2_exo_coldens(kl,i,lchnk,next)) + else + tint_vals(1) = o2_exo_coldens( 1,i,lchnk,last) + tint_vals(2) = o2_exo_coldens( 1,i,lchnk,next) + endif + o2_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) + end do + else + o2_exo_col(:) = 0._r8 + end if + if( has_o3_col ) then + do i = 1,ncol + if ( kl > 0 ) then + tint_vals(1) = o3_exo_coldens(kl,i,lchnk,last) & + + delp * (o3_exo_coldens(ki,i,lchnk,last) & + - o3_exo_coldens(kl,i,lchnk,last)) + tint_vals(2) = o3_exo_coldens(kl,i,lchnk,next) & + + delp * (o3_exo_coldens(ki,i,lchnk,next) & + - o3_exo_coldens(kl,i,lchnk,next)) + else + tint_vals(1) = o3_exo_coldens( 1,i,lchnk,last) + tint_vals(2) = o3_exo_coldens( 1,i,lchnk,next) + endif + o3_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) + end do + else + o3_exo_col(:) = 0._r8 + end if +#ifdef DEBUG + write(iulog,*) '-----------------------------------' + write(iulog,*) 'o2_exo_col' + write(iulog,'(1p,5g15.7)') o2_exo_col(:) + write(iulog,*) 'o3_exo_col' + write(iulog,'(1p,5g15.7)') o3_exo_col(:) + write(iulog,*) '-----------------------------------' +#endif + else + !--------------------------------------------------------------- + ! ... do pressure interpolation + !--------------------------------------------------------------- + call p_interp( lchnk, ncol, ptop, o2_exo_col, o3_exo_col ) + end if + else + o2_exo_col(:) = 0._r8 + o3_exo_col(:) = 0._r8 + end if has_abs_cols + + if( o3rad_ndx > 0 ) then + spc_ndx = o3rad_ndx + else + spc_ndx = ox_ndx + end if + if( spc_ndx < 1 ) then + spc_ndx = o3_ndx + end if + if( spc_ndx > 0 ) then + col_delta(:,0,1) = o3_exo_col(:) + do k = 1,pver + col_delta(:ncol,k,1) = xfactor * pdel(:ncol,k) * vmr(:ncol,k,spc_ndx) + end do + else if( o3_inv_ndx > 0 ) then + col_delta(:,0,1) = o3_exo_col(:) + do k = 1,pver + col_delta(:ncol,k,1) = xfactor * pdel(:ncol,k) * invariants(:ncol,k,o3_inv_ndx)/invariants(:ncol,k,indexm) + end do + else + col_delta(:,:,1) = 0._r8 + end if + if( ncol_abs > 1 ) then + if( o2_ndx > 1 ) then + col_delta(:,0,2) = o2_exo_col(:) + if( o2_is_inv ) then + do k = 1,pver + col_delta(:ncol,k,2) = xfactor * pdel(:ncol,k) * invariants(:ncol,k,o2_ndx)/invariants(:ncol,k,indexm) + end do + else + do k = 1,pver + col_delta(:ncol,k,2) = xfactor * pdel(:ncol,k) * vmr(:ncol,k,o2_ndx) + end do + endif + else + col_delta(:,:,2) = 0._r8 + end if + end if + + end subroutine set_ub_col + + subroutine p_interp( lchnk, ncol, ptop, o2_exo_col, o3_exo_col ) + !--------------------------------------------------------------- + ! ... pressure interpolation for exo col density + !--------------------------------------------------------------- + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: ncol ! no. of columns + real(r8), intent(out) :: o2_exo_col(ncol) ! exo model o2 column density (molecules/cm^2) + real(r8), intent(out) :: o3_exo_col(ncol) ! exo model o3 column density (molecules/cm^2) + integer, intent(in) :: lchnk ! latitude indicies in chunk + real(r8) :: ptop(pcols) ! top pressure (Pa) + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + integer :: i, ki, kl + real(r8) :: pinterp + real(r8) :: delp + real(r8) :: tint_vals(2) + + do i = 1,ncol + pinterp = ptop(i) + if( pinterp < levs(1) ) then + ki = 0 + delp = 0._r8 + else + do ki = 2,n_exo_levs + if( pinterp <= levs(ki) ) then + delp = log( pinterp/levs(ki-1) )/log( levs(ki)/levs(ki-1) ) + exit + end if + end do + end if + kl = ki - 1 + if( has_o2_col ) then + tint_vals(1) = o2_exo_coldens(kl,i,lchnk,last) & + + delp * (o2_exo_coldens(ki,i,lchnk,last) & + - o2_exo_coldens(kl,i,lchnk,last)) + tint_vals(2) = o2_exo_coldens(kl,i,lchnk,next) & + + delp * (o2_exo_coldens(ki,i,lchnk,next) & + - o2_exo_coldens(kl,i,lchnk,next)) + o2_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) + else + o2_exo_col(i) = 0._r8 + end if + if( has_o3_col ) then + tint_vals(1) = o3_exo_coldens(kl,i,lchnk,last) & + + delp * (o3_exo_coldens(ki,i,lchnk,last) & + - o3_exo_coldens(kl,i,lchnk,last)) + tint_vals(2) = o3_exo_coldens(kl,i,lchnk,next) & + + delp * (o3_exo_coldens(ki,i,lchnk,next) & + - o3_exo_coldens(kl,i,lchnk,next)) + o3_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) + else + o3_exo_col(i) = 0._r8 + end if + end do + + end subroutine p_interp + + subroutine setcol( col_delta, col_dens, vmr, pdel, ncol ) + !--------------------------------------------------------------- + ! ... set the column densities + !--------------------------------------------------------------- + + use chem_mods, only : ncol_abs=>nabscol, gas_pcnst + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: ncol ! no. of columns in current chunk + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) ! xported species vmr + real(r8), intent(in) :: pdel(pcols,pver) ! delta about midpoints + real(r8), intent(in) :: col_delta(:,0:,:) ! layer column densities (molecules/cm^2) + real(r8), intent(out) :: col_dens(:,:,:) ! column densities ( /cm**2 ) + + !--------------------------------------------------------------- + ! the local variables + !--------------------------------------------------------------- + integer :: k, km1, m ! long, alt indicies + + !--------------------------------------------------------------- + ! note: xfactor = 10.*r/(k*g) in cgs units. + ! the factor 10. is to convert pdel + ! from pascals to dyne/cm**2. + !--------------------------------------------------------------- + real(r8), parameter :: xfactor = 2.8704e21_r8/(9.80616_r8*1.38044_r8) + + !--------------------------------------------------------------- + ! ... compute column densities down to the + ! current eta index in the calling routine. + ! the first column is o3 and the second is o2. + !--------------------------------------------------------------- + do m = 1,ncol_abs + col_dens(:,1,m) = col_delta(:,0,m) + .5_r8 * col_delta(:,1,m) + do k = 2,pver + km1 = k - 1 + col_dens(:,k,m) = col_dens(:,km1,m) + .5_r8 * (col_delta(:,km1,m) + col_delta(:,k,m)) + end do + enddo + + end subroutine setcol + + subroutine photo_timestep_init( calday ) + use euvac, only : euvac_set_etf + use mo_jshort, only : jshort_timestep_init + use mo_jlong, only : jlong_timestep_init + use solar_euv_data, only : solar_euv_data_active + + !----------------------------------------------------------------------------- + ! ... setup the time interpolation + !----------------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------------- + real(r8), intent(in) :: calday ! day of year at end of present time step + + !----------------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------------- + integer :: m + + if ( do_jeuv ) then + if (.not.solar_euv_data_active) then + call euvac_set_etf( f107, f107a ) + end if + endif + + if( has_o2_col .or. has_o3_col ) then + if( calday < days(1) ) then + next = 1 + last = 12 + dels = (365._r8 + calday - days(12)) / (365._r8 + days(1) - days(12)) + else if( calday >= days(12) ) then + next = 1 + last = 12 + dels = (calday - days(12)) / (365._r8 + days(1) - days(12)) + else + do m = 11,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = m + 1 + dels = (calday - days(m)) / (days(m+1) - days(m)) + end if +#ifdef DEBUG + write(iulog,*) '-----------------------------------' + write(iulog,*) 'photo_timestep_init: diagnostics' + write(iulog,*) 'calday, last, next, dels = ',calday,last,next,dels + write(iulog,*) '-----------------------------------' +#endif + end if + + !----------------------------------------------------------------------- + ! Set jlong etf + !----------------------------------------------------------------------- + call jlong_timestep_init + + if ( do_jshort ) then + !----------------------------------------------------------------------- + ! Set jshort etf + !----------------------------------------------------------------------- + call jshort_timestep_init + endif + + end subroutine photo_timestep_init + + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + subroutine set_xnox_photo( photos, ncol ) + use chem_mods, only : phtcnt + implicit none + integer, intent(in) :: ncol + real(r8), intent(inout) :: photos(ncol,pver,phtcnt) ! photodissociation rates (1/s) + + if( jno2a_ndx > 0 .and. jno2_ndx > 0 ) then + photos(:,:,jno2a_ndx) = photos(:,:,jno2_ndx) + end if + if( jn2o5a_ndx > 0 .and. jn2o5_ndx > 0 ) then + photos(:,:,jn2o5a_ndx) = photos(:,:,jn2o5_ndx) + end if + if( jn2o5b_ndx > 0 .and. jn2o5_ndx > 0 ) then + photos(:,:,jn2o5b_ndx) = photos(:,:,jn2o5_ndx) + end if + if( jhno3a_ndx > 0 .and. jhno3_ndx > 0 ) then + photos(:,:,jhno3a_ndx) = photos(:,:,jhno3_ndx) + end if + + if( jno3a_ndx > 0 .and. jno3_ndx > 0 ) then + photos(:,:,jno3a_ndx) = photos(:,:,jno3_ndx) + end if + if( jho2no2a_ndx > 0 .and. jho2no2_ndx > 0 ) then + photos(:,:,jho2no2a_ndx) = photos(:,:,jho2no2_ndx) + end if + if( jmpana_ndx > 0 .and. jmpan_ndx > 0 ) then + photos(:,:,jmpana_ndx) = photos(:,:,jmpan_ndx) + end if + if( jpana_ndx > 0 .and. jpan_ndx > 0 ) then + photos(:,:,jpana_ndx) = photos(:,:,jpan_ndx) + end if + if( jonitra_ndx > 0 .and. jonitr_ndx > 0 ) then + photos(:,:,jonitra_ndx) = photos(:,:,jonitr_ndx) + end if + if( jo1da_ndx > 0 .and. jo1d_ndx > 0 ) then + photos(:,:,jo1da_ndx) = photos(:,:,jo1d_ndx) + end if + if( jo3pa_ndx > 0 .and. jo3p_ndx > 0 ) then + photos(:,:,jo3pa_ndx) = photos(:,:,jo3p_ndx) + end if + + endsubroutine set_xnox_photo + +end module mo_photo diff --git a/src/chemistry/mozart/mo_photoin.F90 b/src/chemistry/mozart/mo_photoin.F90 new file mode 100644 index 0000000000..fed1d1f6cf --- /dev/null +++ b/src/chemistry/mozart/mo_photoin.F90 @@ -0,0 +1,463 @@ + +module mo_photoin + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use cam_abortutils, only : endrun + + implicit none + + save + + public :: photoin_inti + public :: photoin + private + + integer :: jo2_ndx = 0 + + logical, allocatable :: z_dep(:) + character(len=32), allocatable :: pht_tag(:) + +contains + + subroutine photoin_inti( nlng, lng_indexer ) + !------------------------------------------------------------- + ! ... assign use masks + !------------------------------------------------------------- + + use mo_params, only : largest + use mo_setcld, only : setcld_inti + use chem_mods, only : phtcnt, rxt_tag_lst + + implicit none + + !------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------- + + integer, intent(in) :: nlng + integer, intent(in) :: lng_indexer(:) + + !------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------- + integer :: astat + integer :: m + integer :: ndx + character(len=32) :: jname + + !------------------------------------------------------------- + ! ... allocate module arrays + !------------------------------------------------------------- + has_photorates : if( nlng > 0 ) then + allocate( z_dep(nlng), pht_tag(nlng), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photoin_inti: failed to allocate z_dep; error = ',astat + call endrun + end if + ndx = 0 + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then + cycle + end if + ndx = ndx + 1 + pht_tag(ndx) = trim( rxt_tag_lst(m)) + end if + end do + if( ndx /= nlng ) then + write(iulog,*) 'photoin_inti: corrupted lng_indexer' + call endrun + end if + write(iulog,*) ' ' + write(iulog,*) 'photoin_inti: lng_indexer name mapping' + write(iulog,'(5a)') pht_tag(:) + write(iulog,*) ' ' + !------------------------------------------------------------- + ! ... search for jo2 + !------------------------------------------------------------- + do m = 1,nlng + if( pht_tag(m) == 'jo2' ) then + jo2_ndx = m + exit + end if + end do + write(iulog,*) ' ' + write(iulog,*) 'photoin_inti: jo2 index = ',jo2_ndx + write(iulog,*) ' ' + !------------------------------------------------------------- + ! ... set altitude dependence logical array + !------------------------------------------------------------- + z_dep(:) = .true. + do m = 1,nlng + jname = pht_tag(m) + select case( jname ) + case( 'jno2', 'jno3', 'jho2', 'jhno2', 'jho2no2' ) + z_dep(m) = .false. + case( 'jc2h5cho', 'jchocho', 'jch3ooh' ) + z_dep(m) = .false. + end select + end do + + !------------------------------------------------------------- + ! ... intialize cloud layer module + !------------------------------------------------------------- + call setcld_inti + + end if has_photorates + + end subroutine photoin_inti + + subroutine photoin( idate, alat, along, & + ut, esfact, o3top, o2top, albedo, & + z, tlev, tlay, xlwc, xfrc, & + airlev, aocs1, aocs2, acbs1, acbs2, & + asoa, aant, aso4, asal, ads, o3, rh, & + prate, zen, nw, dt_xdiag ) + !---------------------------------------------------------- + ! ... interactive photolysis interface routine + !---------------------------------------------------------- + + use mo_tuv_inti, only : nlng + use mo_params, only : kj, kw + use mo_wavelen, only : deltaw, sflx, wc, wl, wu + use mo_wavelab , only : sj + use mo_zadj, only : adj_coeffs + use mo_setair, only : setair + use mo_setozo, only : setozo + use mo_pchem, only : pchem + use mo_sphers, only : sphers + use mo_airmas, only : airmas + use mo_setz, only : setz + use mo_seto2, only : set_o2_xsect + use mo_rtlink, only : rtlink + use mo_setcld, only : setcld !, mreg + use mo_setaer, only : setaer + use ppgrid, only : pver, pverp + + implicit none + + !---------------------------------------------------------- + ! ... dummy arguments + !---------------------------------------------------------- + integer, intent(in) :: idate + integer, intent(in) :: nw + real(r8), intent(in) :: alat, along, o3top, o2top + real(r8), intent(in) :: ut, esfact + real(r8), intent(in) :: zen + real(r8), intent(in) :: albedo(kw) + real(r8), intent(in) :: tlay(pver) + real(r8), intent(in) :: xlwc(pverp) ! cloud water (g/m3) + real(r8), intent(in) :: xfrc(pverp) ! cloud fraction + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: aocs1(pverp) + real(r8), intent(in) :: aocs2(pverp) + real(r8), intent(in) :: acbs1(pverp) + real(r8), intent(in) :: acbs2(pverp) + real(r8), intent(in) :: asoa(pverp) + real(r8), intent(in) :: aant(pverp) + real(r8), intent(in) :: aso4(pverp) + real(r8), intent(in) :: asal(pverp,4) + real(r8), intent(in) :: ads(4,pverp) + real(r8), intent(in) :: rh(pverp) + real(r8), intent(inout) :: o3(pverp) + real(r8), intent(out) :: prate(pverp,nlng) + real(r8), intent(out) :: dt_xdiag(:) + + !---------------------------------------------------------- + ! ... local variables + !---------------------------------------------------------- + integer :: i, j, k, km, wn, n, astat + real(r8) :: factor, delzint + real(r8) :: wcen + real(r8), allocatable :: xs(:,:,:) + real(r8), allocatable :: adjcoe(:,:) ! ftuv adjustment factor + + !---------------------------------------------------------- + ! ... altitude grid + !---------------------------------------------------------- + real(r8) :: colinc(pverp) + real(r8) :: vcol(pverp) + real(r8) :: scol(pverp) + real(r8) :: to3(pverp) + + !---------------------------------------------------------- + ! ... solar zenith angle + ! slant pathlengths in spherical geometry + !---------------------------------------------------------- + integer :: nid(0:pver) + real(r8) :: dsdh(0:pver,pver) + + !---------------------------------------------------------- + ! ... extra terrestrial solar flux and earth-sun distance ^-2 + !---------------------------------------------------------- + real(r8) :: etf(nw) + real(r8) :: delw(nw) + real(r8) :: xsec(nw) + + !-------------------------------------------------------------- + ! ... atmospheric optical parameters: + !-------------------------------------------------------------- + integer, parameter :: mreg = 16 + integer :: nreg ! regions at each grid + real(r8) :: dtrl(pver,nw) + real(r8) :: dto3(pver,nw) + real(r8) :: dto2(pver,nw) + real(r8) :: dtcld(pver,nw) + real(r8) :: omcld(pver,nw) + real(r8) :: gcld(pver,nw) + + real(r8) :: dtcbs1(pver,nw) + real(r8) :: dtcbs2(pver,nw) + real(r8) :: omcbs1(pver,nw) + real(r8) :: omcbs2(pver,nw) + real(r8) :: gcbs1(pver,nw) + real(r8) :: gcbs2(pver,nw) + + real(r8) :: dtocs1(pver,nw) + real(r8) :: dtocs2(pver,nw) + real(r8) :: omocs1(pver,nw) + real(r8) :: omocs2(pver,nw) + real(r8) :: gocs1(pver,nw) + real(r8) :: gocs2(pver,nw) + + real(r8) :: dtant(pver,nw) + real(r8) :: omant(pver,nw) + real(r8) :: gant(pver,nw) + + real(r8) :: dtsoa(pver,nw) + real(r8) :: dtso4(pver,nw) + real(r8) :: omso4(pver,nw) + real(r8) :: gso4(pver,nw) + + real(r8) :: dtsal(pver,nw,4) + real(r8) :: omsal(pver,nw,4) + real(r8) :: gsal(pver,nw,4) + + real(r8) :: dtds1(pver,nw) + real(r8) :: dtds2(pver,nw) + real(r8) :: dtds3(pver,nw) + real(r8) :: dtds4(pver,nw) + real(r8) :: omds1(pver,nw) + real(r8) :: omds2(pver,nw) + real(r8) :: omds3(pver,nw) + real(r8) :: omds4(pver,nw) + real(r8) :: gds1(pver,nw) + real(r8) :: gds2(pver,nw) + real(r8) :: gds3(pver,nw) + real(r8) :: gds4(pver,nw) + + real(r8) :: optr(pver,mreg) ! cld opt (z dependent) at each region + real(r8) :: fp(mreg) ! probability at each region + + real(r8) :: xso2(nw,pverp) + + !-------------------------------------------------------------- + ! ... spectral irradiance and actinic flux (scalar irradiance): + !-------------------------------------------------------------- + real(r8) :: radfld(pverp,nw) + real(r8) :: radxx(pverp,nw) + + !------------------------------------------------------------- + ! ... j-values: + !------------------------------------------------------------- + integer :: jn, m + + !------------------------------------------------------------- + ! ... location and time + !------------------------------------------------------------- + integer :: iyear, imonth, iday + real(r8) :: dtime, ut0 + + !------------------------------------------------------------- + ! ... allocate wrking xsection array + !------------------------------------------------------------- + allocate( xs(nw,pverp,nlng), adjcoe(pverp,nlng), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'photoin: failed to allocate xs, adjcoe; error = ',astat + call endrun + end if + + etf(1:nw) = sflx(1:nw) * esfact ! earth-sun distance effect + !------------------------------------------------------- + ! ... air profile and rayleigh optical depths (inter-face) + !------------------------------------------------------- + call setair( z, nw, wc, airlev, dtrl, colinc, o2top ) + + !------------------------------------------------------------- + ! ... ozone optical depths (must give temperature) (inter-face) + !------------------------------------------------------------- + call setozo( z, nw, wl, tlay, dto3, to3, o3, airlev, o3top ) + + !------------------------------------------------------------- + ! ... cloud optical depths + !------------------------------------------------------------- + call setcld( z, xlwc, xfrc, nreg, fp, optr ) + + !------------------------------------------------------------- + ! ... aerosol optical depths + !------------------------------------------------------------- + call setaer( z, airlev, rh, aocs1, aocs2, & + acbs1, acbs2,& + aant, aso4, asal, ads, asoa, & + dtcbs1, dtcbs2, omcbs1, omcbs2, gcbs1, gcbs2, & + dtocs1, dtocs2, omocs1, omocs2, gocs1, gocs2, & + dtant, omant, gant, & + dtso4, omso4, gso4, & + dtsal, omsal, gsal, & + dtds1, dtds2, dtds3, dtds4, & + omds1, omds2, omds3, omds4, & + gds1, gds2, gds3, gds4, dtsoa, nw ) + dt_xdiag(1) = sum( dtcbs1(:,16) + dtcbs2(:,16) ) + dt_xdiag(2) = sum( dtocs1(:,16) + dtocs2(:,16) ) + dt_xdiag(3) = sum( dtso4(:,16) ) + dt_xdiag(4) = sum( dtant(:,16) ) + dt_xdiag(5) = sum( dtsal(:,16,1) + dtsal(:,16,2) + dtsal(:,16,3) + dtsal(:,16,4) ) + dt_xdiag(6) = sum( dtds1(:,16) + dtds2(:,16) + dtds3(:,16) + dtds4(:,16) ) + dt_xdiag(7) = sum( dtsoa(:,16) ) + dt_xdiag(8) = sum( dt_xdiag(1:6) ) + + !------------------------------------------------------------ + ! ... photo-chemical and photo-biological weigting functions. + ! for pchem, need to know temperature and pressure profiles. + ! output: + ! from pchem: sj(kj,kz,kw) - for each reaction + !------------------------------------------------------------- + xs(:,:,1:nlng) = sj(:,:,1:nlng) + call pchem( nw, wl, wc, tlev, & + airlev, nlng, pht_tag, xs ) + + !------------------------------------------------------------- + ! ... slant path lengths for spherical geometry + !------------------------------------------------------------- + call sphers( z, zen, dsdh, nid ) + call airmas( z, zen, dsdh, nid, colinc, vcol, scol ) + + !--------------------------------------------------------------- + ! ... modification of coefficent of j-vales function of to3 and zenith + !--------------------------------------------------------------- + call setz( to3, tlev, adj_coeffs, zen, adjcoe, pht_tag ) + + !------------------------------------------------------------------ + ! ... effective o2 optical depth (sr bands, must know zenith angle!) + ! assign o2 cross section to sj(1,*,*) + !------------------------------------------------------------------ + call set_o2_xsect( z, nw, wl, colinc, vcol, scol, dto2, xso2 ) + if( jo2_ndx > 0 ) then + xs(:,:,jo2_ndx) = xso2(:,:) + end if + + delw(:nw) = deltaw(:nw) * etf(:nw) + + !--------------------------------------------------- + ! ... monochromatic radiative transfer: + ! outputs are fdir, fdn, fup + !--------------------------------------------------- + + ! set for cloud only + + do wn = 1,nw + radfld(:,wn) = 0._r8 + omcld(:,wn) = .9999_r8 + gcld (:,wn) = .85_r8 + end do + + Cld_reg_loop : do n = 1,nreg + factor = fp(n) + do wn = 1,nw + dtcld(:,wn) = optr(:,n) + end do + +#ifdef NO_AEROSOL + dtcbs1(:,:) = 0._r8 + dtcbs2(:,:) = 0._r8 + dtocs1(:,:) = 0._r8 + dtocs2(:,:) = 0._r8 + dtant(:,:) = 0._r8 + dtso4(:,:) = 0._r8 + dtsal(:,:,:) = 0._r8 + dtds1(:,:) = 0._r8 + dtds2(:,:) = 0._r8 + dtds3(:,:) = 0._r8 + dtds4(:,:) = 0._r8 + + omcbs1(:,:) = 0._r8 + omcbs2(:,:) = 0._r8 + omocs1(:,:) = 0._r8 + omocs2(:,:) = 0._r8 + omant(:,:) = 0._r8 + omso4(:,:) = 0._r8 + omsal(:,:,:) = 0._r8 + omds1(:,:) = 0._r8 + omds2(:,:) = 0._r8 + omds3(:,:) = 0._r8 + omds4(:,:) = 0._r8 + + gcbs1(:,:) = 0._r8 + gcbs2(:,:) = 0._r8 + gocs1(:,:) = 0._r8 + gocs2(:,:) = 0._r8 + gant(:,:) = 0._r8 + gso4(:,:) = 0._r8 + gsal(:,:,:) = 0._r8 + gds1(:,:) = 0._r8 + gds2(:,:) = 0._r8 + gds3(:,:) = 0._r8 + gds4(:,:) = 0._r8 +#endif + call rtlink( z, nw, albedo, zen, dsdh, & + nid, dtrl, dto3, dto2, & + dtcld, omcld, gcld, & + dtcbs1, omcbs1, gcbs1, & + dtcbs2, omcbs2, gcbs2, & + dtocs1, omocs1, gocs1, & + dtocs2, omocs2, gocs2, & + dtant, omant, gant, & + dtso4, omso4, gso4, & + dtsal, omsal, gsal, & + dtds1, omds1, gds1, & + dtds2, omds2, gds2, & + dtds3, omds3, gds3, & + dtds4, omds4, gds4, radxx ) + do wn = 1,nw + radfld(:,wn) = radfld(:,wn) + radxx(:,wn)*factor + end do + end do Cld_reg_loop + + !---------------------------------------------------------- + ! ... interplation at the top level + !---------------------------------------------------------- + delzint = (z(pver-1) - z(pver-2))/(z(pver) - z(pver-1)) + do wn = 1,nw + radfld(1,wn) = radfld(2,wn) + (radfld(2,wn) - radfld(3,wn))*delzint + radfld(1,wn) = max( radfld(1,wn),radfld(2,wn) ) + end do + + !---------------------------------------------------------- + ! ... j-val calculation + ! spherical irradiance (actinic flux) + ! as a function of altitude + ! convert to quanta s-1 nm-1 cm-2 + ! (1.e-4 * (wc*1e-9) / (hc = 6.62e-34 * 2.998e8)) + !---------------------------------------------------------- + rate_loop : do m = 1,nlng + if( .not. z_dep(m) ) then + xsec(:nw) = xs(:nw,1,m) * delw(:nw) + prate(:pverp,m) = matmul( radfld, xsec ) + else + do k = 1,pverp + km = pverp - k + 1 + xsec(:nw) = xs(:nw,km,m) * delw(:nw) + prate(k,m) = dot_product( radfld(k,:nw), xsec(:nw) ) + end do + end if + prate(1:pverp,m) = prate(1:pverp,m) * adjcoe(pverp:1:-1,m) + end do rate_loop + + deallocate( xs, adjcoe ) + + end subroutine photoin + +end module mo_photoin diff --git a/src/chemistry/mozart/mo_ps2str.F90 b/src/chemistry/mozart/mo_ps2str.F90 new file mode 100644 index 0000000000..f5fd143a05 --- /dev/null +++ b/src/chemistry/mozart/mo_ps2str.F90 @@ -0,0 +1,331 @@ + + module mo_ps2str + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: ps2str + + contains + + subroutine ps2str( nw, zen, rsfc, tauu, omu, & + gu, dsdh, nid, radfld ) +!----------------------------------------------------------------------------- +! purpose: +! solve two-stream equations for multiple layers. the subroutine is based +! on equations from: toon et al., j.geophys.res., v94 (d13), nov 20, 1989. +! it contains 9 two-stream methods to choose from. a pseudo-spherical +! correction has also been added. +!----------------------------------------------------------------------------- +! parameters: +! nlevel - integer, number of specified altitude levels in the working (i) +! grid +! zen - real(r8), solar zenith angle (degrees) (i) +! rsfc - real(r8), surface albedo at current wavelength (i) +! tauu - real(r8), unscaled optical depth of each layer (i) +! omu - real(r8), unscaled single scattering albedo of each layer (i) +! gu - real(r8), unscaled asymmetry parameter of each layer (i) +! dsdh - real(r8), slant path of direct beam through each layer crossed (i) +! when travelling from the top of the atmosphere to layer i; +! dsdh(i,j), i = 0..nz-1, j = 1..nz-1 +! nid - integer, number of layers crossed by the direct beam when (i) +! travelling from the top of the atmosphere to layer i; +! nid(i), i = 0..nz-1 +! delta - logical, switch to use delta-scaling (i) +! .true. -> apply delta-scaling +! .false.-> do not apply delta-scaling +! fdr - real(r8), contribution of the direct component to the total (o) +! actinic flux at each altitude level +! fup - real(r8), contribution of the diffuse upwelling component to (o) +! the total actinic flux at each altitude level +! fdn - real(r8), contribution of the diffuse downwelling component to (o) +! the total actinic flux at each altitude level +! edr - real(r8), contribution of the direct component to the total (o) +! spectral irradiance at each altitude level +! eup - real(r8), contribution of the diffuse upwelling component to (o) +! the total spectral irradiance at each altitude level +! edn - real(r8), contribution of the diffuse downwelling component to (o) +! the total spectral irradiance at each altitude level +!----------------------------------------------------------------------------- + + use mo_params, only : smallest, largest + use mo_constants, only : d2r + use ppgrid, only : pver, pverp + use mo_trislv, only : tridec, trislv + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + integer, intent(in) :: nid(0:pver) + real(r8), intent(in) :: zen + real(r8), intent(in) :: rsfc(nw) + real(r8), intent(in) :: tauu(pver,nw) + real(r8), intent(in) :: omu(pver,nw) + real(r8), intent(in) :: gu(pver,nw) + real(r8), intent(in) :: dsdh(0:pver,pver) + real(r8), intent(out) :: radfld(pverp,nw) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! ... mu = cosine of solar zenith angle +! rsfc = surface albedo +! tauu = unscaled optical depth of each layer +! omu = unscaled single scattering albedo +! gu = unscaled asymmetry factor +! klev = max dimension of number of layers in atmosphere +! nlayer = number of layers in the atmosphere +! nlevel = nlayer + 1 = number of levels +!----------------------------------------------------------------------------- + integer, parameter :: mrows = 2*pver + integer, parameter :: pverm = pver - 1 + real(r8), parameter :: eps = 1.e-3_r8 + real(r8), parameter :: pifs = 1._r8 + real(r8), parameter :: fdn0 = 0._r8 + + integer :: row + integer :: lev + integer :: i, ip1, wn + integer :: j, jl, ju + + real(r8) :: precis, wrk + real(r8) :: tempg + real(r8) :: mu, suma + real(r8) :: g, om + real(r8) :: gam1, gam2, gam3, gam4 + real(r8), dimension(pver) :: f, gi, omi + real(r8), dimension(0:pverp) :: tauc, mu2 + real(r8), dimension(pver) :: lam, taun, bgam + real(r8), dimension(pver) :: cdn + real(r8), dimension(0:pverp,nw) :: tausla + real(r8), dimension(pver,nw) :: cup, cuptn, cdntn + real(r8), dimension(pver,nw) :: e1, e2, e3, e4 + real(r8), dimension(mrows) :: a, b, d, e + real(r8), dimension(nw,mrows) :: sub, main, super, y +!----------------------------------------------------------------------------- +! ... for calculations of associated legendre polynomials for gama1,2,3,4 +! in delta-function, modified quadrature, hemispheric constant, +! hybrid modified eddington-delta function metods, p633,table1. +! w.e.meador and w.r.weaver, gas,1980,v37,p.630 +! w.j.wiscombe and g.w. grams, gas,1976,v33,p2440, +! uncomment the following two lines and the appropriate statements +! further down. +!----------------------------------------------------------------------------- + real(r8) :: expon, expon0, expon1, divisr, temp, up, dn + real(r8) :: ssfc + +!----------------------------------------------------------------------------- +! ... initial conditions: pi*solar flux = 1; diffuse incidence = 0 +!----------------------------------------------------------------------------- + precis = epsilon( precis ) + + mu = cos( zen*d2r ) +wave_loop : & + do wn = 1,nw +!----------------------------------------------------------------------------- +! ... compute coefficients for each layer: +! gam1 - gam4 = 2-stream coefficients, different for different approximations +! expon0 = calculation of e when tau is zero +! expon1 = calculation of e when tau is taun +! cup and cdn = calculation when tau is zero +! cuptn and cdntn = calc. when tau is taun +! divisr = prevents division by zero +!----------------------------------------------------------------------------- + tauc(0:pverp) = 0._r8 + tausla(0:pverp,wn) = 0._r8 + mu2(0:pverp) = sqrt( smallest ) + +!----------------------------------------------------------------------------- +! ... delta-scaling. have to be done for delta-eddington approximation, +! delta discrete ordinate, practical improved flux method, delta function, +! and hybrid modified eddington-delta function methods approximations +!----------------------------------------------------------------------------- + f(1:pver) = gu(:,wn)*gu(:,wn) + gi(1:pver) = (gu(:,wn) - f(1:pver))/(1._r8 - f(1:pver)) + omi(1:pver) = (1._r8 - f(1:pver))*omu(1:pver,wn)/(1._r8 - omu(1:pver,wn)*f(1:pver)) + taun(1:pver) = (1._r8 - omu(1:pver,wn)*f(1:pver))*tauu(1:pver,wn) + +!----------------------------------------------------------------------------- +! ... calculate slant optical depth at the top of the atmosphere when zen>90. +! in this case, higher altitude of the top layer is recommended which can +! be easily changed in gridz.f. +!----------------------------------------------------------------------------- + if( zen > 90._r8 ) then + if( nid(0) < 0 ) then + tausla(0,wn) = largest + else + ju = nid(0) + tausla(0,wn) = 2._r8*dot_product( taun(1:ju),dsdh(0,1:ju) ) + end if + end if +level_loop : & + do i = 1,pver + g = gi(i) + om = omi(i) + tauc(i) = tauc(i-1) + taun(i) +!----------------------------------------------------------------------------- +! ... stay away from 1 by precision. for g, also stay away from -1 +!----------------------------------------------------------------------------- + tempg = min( abs(g),1._r8 - precis ) + g = sign( tempg,g ) + om = min( om,1._r8 - precis ) +!----------------------------------------------------------------------------- +! ... calculate slant optical depth +!----------------------------------------------------------------------------- + if( nid(i) < 0 ) then + tausla(i,wn) = largest + else + ju = min( nid(i),i ) + suma = dot_product( taun(1:ju),dsdh(i,1:ju) ) + jl = min( nid(i),i ) + 1 + tausla(i,wn) = suma + 2._r8*dot_product( taun(jl:nid(i)),dsdh(i,jl:nid(i)) ) + if( tausla(i,wn) == tausla(i-1,wn) ) then + mu2(i) = sqrt( largest ) + else + mu2(i) = (tauc(i) - tauc(i-1))/(tausla(i,wn) - tausla(i-1,wn)) + mu2(i) = sign( max( abs(mu2(i)),sqrt(smallest) ),mu2(i) ) + end if + end if +!----------------------------------------------------------------------------- +! ... the following gamma equations are from pg 16,289, table 1 +! eddington approximation(joseph et al., 1976, jas, 33, 2452): +!----------------------------------------------------------------------------- + gam1 = .25_r8*(7._r8 - om*(4._r8 + 3._r8*g)) + gam2 = -.25_r8*(1._r8 - om*(4._r8 - 3._r8*g)) + gam3 = .25_r8*(2._r8 - 3._r8*g*mu) + gam4 = 1._r8 - gam3 +!----------------------------------------------------------------------------- +! ... lambda = pg 16,290 equation 21 +! big gamma = pg 16,290 equation 22 +!----------------------------------------------------------------------------- + lam(i) = sqrt( gam1*gam1 - gam2*gam2 ) + bgam(i) = (gam1 - lam(i))/gam2 + wrk = lam(i)*taun(i) + if( wrk < 500._r8 ) then + expon = exp( -wrk ) + else + expon = 0._r8 + end if +!----------------------------------------------------------------------------- +! ... e1 - e4 = pg 16,292 equation 44 +!----------------------------------------------------------------------------- + e1(i,wn) = 1._r8 + bgam(i)*expon + e2(i,wn) = 1._r8 - bgam(i)*expon + e3(i,wn) = bgam(i) + expon + e4(i,wn) = bgam(i) - expon +!----------------------------------------------------------------------------- +! ... the following sets up for the c equations 23, and 24 +! found on page 16,290 +! prevent division by zero (if lambda=1/mu, shift 1/mu^2 by eps = 1.e-3 +! which is approx equiv to shifting mu by 0.5*eps* (mu)**3 +!----------------------------------------------------------------------------- + if( tausla(i-1,wn) < 500._r8 ) then + expon0 = exp( -tausla(i-1,wn) ) + else + expon0 = 0._r8 + end if + if( tausla(i,wn) < 500._r8 ) then + expon1 = exp( -tausla(i,wn) ) + else + expon1 = 0._r8 + end if + divisr = lam(i)*lam(i) - 1._r8/(mu2(i)*mu2(i)) + temp = max( eps,abs(divisr) ) + divisr = 1._r8/sign( temp,divisr ) + up = om*pifs*((gam1 - 1._r8/mu2(i))*gam3 + gam4*gam2)*divisr + dn = om*pifs*((gam1 + 1._r8/mu2(i))*gam4 + gam2*gam3)*divisr +!----------------------------------------------------------------------------- +! ... cup and cdn are when tau is equal to zero +! cuptn and cdntn are when tau is equal to taun +!----------------------------------------------------------------------------- + cup(i,wn) = up*expon0 + cdn(i) = dn*expon0 + cuptn(i,wn) = up*expon1 + cdntn(i,wn) = dn*expon1 + end do level_loop + +!----------------------------------------------------------------------------- +! ... set up matrix +! ssfc = pg 16,292 equation 37 where pi fs is one (unity). +!----------------------------------------------------------------------------- + if( tausla(pver,wn) < 500._r8 ) then + ssfc = rsfc(wn)*mu*exp( -tausla(pver,wn) )*pifs + else + ssfc = 0._r8 + end if + +!----------------------------------------------------------------------------- +! ... the following are from pg 16,292 equations 39 - 43. +! set up first row of matrix: +!----------------------------------------------------------------------------- + a(1) = 0._r8 + b(1) = e1(1,wn) + d(1) = -e2(1,wn) + e(1) = fdn0 - cdn(1) + +!----------------------------------------------------------------------------- +! ... set up odd rows 3 thru (mrows - 1): +!----------------------------------------------------------------------------- + a(3:mrows-1:2) = e2(1:pverm,wn)*e3(1:pverm,wn) - e4(1:pverm,wn)*e1(1:pverm,wn) + b(3:mrows-1:2) = e1(1:pverm,wn)*e1(2:pver,wn) - e3(1:pverm,wn)*e3(2:pver,wn) + d(3:mrows-1:2) = e3(1:pverm,wn)*e4(2:pver,wn) - e1(1:pverm,wn)*e2(2:pver,wn) + e(3:mrows-1:2) = e3(1:pverm,wn)*(cup(2:pver,wn) - cuptn(1:pverm,wn)) + e1(1:pverm,wn)*(cdntn(1:pverm,wn) - cdn(2:pver)) + +!----------------------------------------------------------------------------- +! ... set up even rows 2 thru (mrows - 2): +!----------------------------------------------------------------------------- + a(2:mrows-2:2) = e2(2:pver,wn)*e1(1:pverm,wn) - e3(1:pverm,wn)*e4(2:pver,wn) + b(2:mrows-2:2) = e2(1:pverm,wn)*e2(2:pver,wn) - e4(1:pverm,wn)*e4(2:pver,wn) + d(2:mrows-2:2) = e1(2:pver,wn)*e4(2:pver,wn) - e2(2:pver,wn)*e3(2:pver,wn) + e(2:mrows-2:2) = (cup(2:pver,wn) - cuptn(1:pverm,wn))*e2(2:pver,wn) - (cdn(2:pver) - cdntn(1:pverm,wn))*e4(2:pver,wn) + +!----------------------------------------------------------------------------- +! ... set up last row of matrix at mrows: +!----------------------------------------------------------------------------- + a(mrows) = e1(pver,wn) - rsfc(wn)*e3(pver,wn) + b(mrows) = e2(pver,wn) - rsfc(wn)*e4(pver,wn) + d(mrows) = 0._r8 + e(mrows) = ssfc - cuptn(pver,wn) + rsfc(wn)*cdntn(pver,wn) + + sub(wn,1:mrows) = a(1:mrows) + main(wn,1:mrows) = b(1:mrows) + super(wn,1:mrows) = d(1:mrows) + y(wn,1:mrows) = e(1:mrows) + end do wave_loop + +!----------------------------------------------------------------------------- +! ... solve the system +!----------------------------------------------------------------------------- + call tridec( nw, mrows, sub, main, super ) + call trislv( nw, mrows, sub, main, super, y ) + +!----------------------------------------------------------------------------- +! ... unfold solution of matrix, compute output fluxes +!----------------------------------------------------------------------------- + do wn = 1,nw +!----------------------------------------------------------------------------- +! ... the following equations are from pg 16,291 equations 31 & 32 +!----------------------------------------------------------------------------- + e(:mrows) = y(wn,:mrows) + if( tausla(0,wn) < 500._r8 ) then + radfld(1,wn) = 2._r8*(fdn0 + e(1)*e3(1,wn) - e(2)*e4(1,wn) + cup(1,wn)) + exp( -tausla(0,wn) ) + else + radfld(1,wn) = 2._r8*(fdn0 + e(1)*e3(1,wn) - e(2)*e4(1,wn) + cup(1,wn)) + end if + where( tausla(1:pver,wn) < 500._r8 ) + cdn(1:pver) = exp( -tausla(1:pver,wn) ) + elsewhere + cdn(1:pver) = 0._r8 + endwhere + radfld(2:pverp,wn) = 2._r8*(e(1:mrows-1:2)*(e3(1:pver,wn) + e1(1:pver,wn)) & + + e(2:mrows:2)*(e4(1:pver,wn) + e2(1:pver,wn)) & + + cdntn(1:pver,wn) + cuptn(1:pver,wn)) + cdn(1:pver) + end do + + end subroutine ps2str + + end module mo_ps2str diff --git a/src/chemistry/mozart/mo_rtlink.F90 b/src/chemistry/mozart/mo_rtlink.F90 new file mode 100644 index 0000000000..00bf911bfc --- /dev/null +++ b/src/chemistry/mozart/mo_rtlink.F90 @@ -0,0 +1,265 @@ + +module mo_rtlink + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: rtlink + +contains + + subroutine rtlink( z, nw, albedo, zen, dsdh, & + nid, & + dtrl, & + dto3, & + dto2, & + dtcld, omcld, gcld, & + dtcbs1, omcbs1, gcbs1, & + dtcbs2, omcbs2, gcbs2, & + dtocs1, omocs1, gocs1, & + dtocs2, omocs2, gocs2, & + dtant, omant, gant, & + dtso4, omso4, gso4, & + dtsal, omsal, gsal, & + dtds1, omds1, gds1, & + dtds2, omds2, gds2, & + dtds3, omds3, gds3, & + dtds4, omds4, gds4, & + radfld ) + + !----------------------------------------------------------------------- + ! + ! Rewritten by P. Hess, April 2005 to account for new mie lookup table + ! + ! + ! prefix dt = optical depth + ! prefix om = single scattering albedo + ! prefix g = asymmetery parameter + ! prefix ds = optical depth x single scattering albedo + ! prefix da = optical depth x (1-single scattering albedo) + ! suffix 1 = dry + ! suffix 2 = wet + ! cgs = soot, + ! ocs = organic carbon + soa (all soluble) + ! ant = ammonia nitrate + ! sal = sea-salt (4 bins) + ! ds1 - ds4 = dust + !----------------------------------------------------------------------- + + use mo_params, only : smallest + use mo_ps2str, only : ps2str + use ppgrid, only : pver, pverp + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: nw + integer, intent(in) :: nid(0:pver) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: albedo(nw) + real(r8), intent(in) :: zen + real(r8), intent(in) :: dtrl(pver,nw) + real(r8), intent(in) :: dto3(pver,nw) + real(r8), intent(in) :: dto2(pver,nw) + real(r8), intent(in) :: dtcld(pver,nw) + real(r8), intent(in) :: omcld(pver,nw) + real(r8), intent(in) :: gcld(pver,nw) + + real(r8), intent(in) :: dtcbs1(pver,nw) + real(r8), intent(in) :: omcbs1(pver,nw) + real(r8), intent(in) :: gcbs1(pver,nw) + + real(r8), intent(in) :: dtcbs2(pver,nw) + real(r8), intent(in) :: omcbs2(pver,nw) + real(r8), intent(in) :: gcbs2(pver,nw) + + real(r8), intent(in) :: dtocs1(pver,nw) + real(r8), intent(in) :: omocs1(pver,nw) + real(r8), intent(in) :: gocs1(pver,nw) + + real(r8), intent(in) :: dtocs2(pver,nw) + real(r8), intent(in) :: omocs2(pver,nw) + real(r8), intent(in) :: gocs2(pver,nw) + + real(r8), intent(in) :: dtant(pver,nw) + real(r8), intent(in) :: omant(pver,nw) + real(r8), intent(in) :: gant(pver,nw) + real(r8), intent(in) :: dtso4(pver,nw) + real(r8), intent(in) :: omso4(pver,nw) + real(r8), intent(in) :: gso4(pver,nw) + real(r8), intent(in) :: dtsal(pver,nw,4) + real(r8), intent(in) :: omsal(pver,nw,4) + real(r8), intent(in) :: gsal(pver,nw,4) + real(r8), intent(in) :: dtds1(pver,nw) + real(r8), intent(in) :: omds1(pver,nw) + real(r8), intent(in) :: gds1(pver,nw) + real(r8), intent(in) :: dtds2(pver,nw) + real(r8), intent(in) :: omds2(pver,nw) + real(r8), intent(in) :: gds2(pver,nw) + real(r8), intent(in) :: dtds3(pver,nw) + real(r8), intent(in) :: omds3(pver,nw) + real(r8), intent(in) :: gds3(pver,nw) + real(r8), intent(in) :: dtds4(pver,nw) + real(r8), intent(in) :: omds4(pver,nw) + real(r8), intent(in) :: gds4(pver,nw) + + real(r8), intent(in) :: dsdh(0:pver,pver) + real(r8), intent(out) :: radfld(pverp,nw) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: k, kk, wn + real(r8) :: daaer, dtsct, dtabs, dsaer, dscld, dacld + real(r8) :: dscbs1, dacbs1 + real(r8) :: dscbs2, dacbs2 + real(r8) :: dsocs1, daocs1 + real(r8) :: dsocs2, daocs2 + real(r8) :: dsant, daant + real(r8) :: dsso4, daso4 + real(r8) :: dssal1, dssal2, dssal3, dssal4 + real(r8) :: dasal1, dasal2, dasal3, dasal4 + real(r8) :: dsds1, dads1 + real(r8) :: dsds2, dads2 + real(r8) :: dsds3, dads3 + real(r8) :: dsds4, dads4 + real(r8) :: wrk + real(r8) :: dt(pver,nw) + real(r8) :: om(pver,nw) + real(r8) :: g(pver,nw) + + !----------------------------------------------------------------------- + ! ... set any coefficients specific to rt scheme + !----------------------------------------------------------------------- + wave_loop : do wn = 1,nw + level_loop : do k = 1,pver + kk = pverp - k + !----------------------------------------------------------------------- + ! scattering and absorbing optical depths + !----------------------------------------------------------------------- + dscld = dtcld(k,wn)*omcld(k,wn) + dacld = dtcld(k,wn)*abs( 1._r8 - omcld(k,wn) ) + !----------------------------------------------------------------------- + ! black carbon + !----------------------------------------------------------------------- + wrk = max( min( omcbs1(k,wn),1._r8 ),smallest ) + dscbs1 = dtcbs1(k,wn)*wrk + dacbs1 = dtcbs1(k,wn)*(1._r8 - wrk) + + wrk = max( min( omcbs2(k,wn),1._r8 ),smallest ) + dscbs2 = dtcbs2(k,wn)*wrk + dacbs2 = dtcbs2(k,wn)*(1._r8 - wrk) + !----------------------------------------------------------------------- + ! organic carbon and soa + !----------------------------------------------------------------------- + wrk = max( min( omocs1(k,wn),1._r8 ),smallest ) + dsocs1 = dtocs1(k,wn)*wrk + daocs1 = dtocs1(k,wn)*(1._r8 - wrk) + + wrk = max( min( omocs2(k,wn),1._r8 ),smallest ) + dsocs2 = dtocs2(k,wn)*wrk + daocs2 = dtocs2(k,wn)*(1._r8 - wrk) + !----------------------------------------------------------------------- + ! ammonia sulfate + !----------------------------------------------------------------------- + wrk = max( min( omant(k,wn),1._r8 ),smallest ) + dsant = dtant(k,wn)*wrk + daant = dtant(k,wn)*(1._r8 - wrk) + !----------------------------------------------------------------------- + ! ammonia sulfate + !----------------------------------------------------------------------- + wrk = max( min( omso4(k,wn),1._r8 ),smallest ) + dsso4 = dtso4(k,wn)*wrk + daso4 = dtso4(k,wn)*(1._r8 - wrk) + !----------------------------------------------------------------------- + ! summation to this point + !----------------------------------------------------------------------- + dtsct = dtrl(k,wn) + dscld & + + dscbs2 + dscbs1 + dsocs2 + dsocs1 + dsant + dsso4 + dtabs = dto3(k,wn) + dto2(k,wn) + dacld & + + dacbs2 + dacbs1 + daocs2 + daocs1 + daant + daso4 + !----------------------------------------------------------------------- + ! sea salt + !----------------------------------------------------------------------- + wrk = max( min( omsal(k,wn,1),1._r8 ),smallest ) + dssal1 = dtsal(k,wn,1)*wrk + dasal1 = dtsal(k,wn,1)*(1._r8 - wrk) + + wrk = max( min( omsal(k,wn,2),1._r8 ),smallest ) + dssal2 = dtsal(k,wn,2)*wrk + dasal2 = dtsal(k,wn,2)*(1._r8 - wrk) + + wrk = max( min( omsal(k,wn,3),1._r8 ),smallest ) + dssal3 = dtsal(k,wn,3)*wrk + dasal3 = dtsal(k,wn,3)*(1._r8 - wrk) + + wrk = max( min( omsal(k,wn,4),1._r8 ),smallest ) + dssal4 = dtsal(k,wn,4)*wrk + dasal4 = dtsal(k,wn,4)*(1._r8 - wrk) + !----------------------------------------------------------------------- + ! summation + !----------------------------------------------------------------------- + dtsct = dtsct + dssal1 + dssal2 + dssal3 + dssal4 + dtabs = dtabs + dasal1 + dasal2 + dasal3 + dasal4 + + wrk = max( min( omds1(k,wn),1._r8 ),smallest ) + dsds1 = dtds1(k,wn)*wrk + dads1 = dsds1*(1._r8 - wrk) + + wrk = max( min( omds2(k,wn),1._r8 ),smallest ) + dsds2 = dtds2(k,wn)*wrk + dads2 = dsds2*(1._r8 - wrk) + + wrk = max( min( omds3(k,wn),1._r8 ),smallest ) + dsds3 = dtds3(k,wn)*wrk + dads3 = dsds3*(1._r8 - wrk) + + wrk = max( min( omds4(k,wn),1._r8 ),smallest ) + dsds4 = dtds4(k,wn)*wrk + dads4 = dsds4*(1._r8 - wrk) + + dtsct = dtsct + dsds1 + dsds2 + dsds3 + dsds4 + dtabs = dtabs + dads1 + dads2 + dads3 + dads4 + + dtabs = max( dtabs,smallest ) + dtsct = max( dtsct,smallest ) + !----------------------------------------------------------------------- + ! ... invert z-coordinate + !----------------------------------------------------------------------- + dt(kk,wn) = dtsct + dtabs + if( dtsct /= smallest ) then + om(kk,wn) = dtsct/(dtsct + dtabs) + g(kk,wn) = gcld(k,wn)*dscld & + + gcbs1(k,wn)*dscbs1 & + + gcbs2(k,wn)*dscbs2 & + + gocs2(k,wn)*dsocs2 & + + gocs1(k,wn)*dsocs1 & + + gant(k,wn)*dsant & + + gso4(k,wn)*dsso4 & + + gsal(k,wn,1)*dssal1 & + + gsal(k,wn,2)*dssal2 & + + gsal(k,wn,3)*dssal3 & + + gsal(k,wn,4)*dssal4 + + g(kk,wn) = g(kk,wn) & + + gds1(k,wn)*dsds1 + gds2(k,wn)*dsds2 & + + gds3(k,wn)*dsds3 + gds4(k,wn)*dsds4 + g(kk,wn) = min( max( g(kk,wn)/dtsct,smallest ),1._r8 ) + else + om(kk,wn) = smallest + g(kk,wn) = smallest + end if + end do level_loop + end do wave_loop + + !----------------------------------------------------------------------- + ! ... call rt routine + !----------------------------------------------------------------------- + call ps2str( nw, zen, albedo, dt, om, & + g, dsdh, nid, radfld ) + + end subroutine rtlink + +end module mo_rtlink diff --git a/src/chemistry/mozart/mo_sad.F90 b/src/chemistry/mozart/mo_sad.F90 new file mode 100644 index 0000000000..9a41103cb4 --- /dev/null +++ b/src/chemistry/mozart/mo_sad.F90 @@ -0,0 +1,1644 @@ + module mo_sad + + use shr_kind_mod, only : r8 => shr_kind_r8 + use physconst, only : pi + use ppgrid, only : pcols, pver + use m_sad_data, only : a, b + use cam_logfile, only : iulog + use spmd_utils, only : masterproc + + + implicit none + + private + public :: sad_inti + public :: sad_strat_calc + public :: sad_top + + save + + real(r8), parameter :: four_thrd = 4._r8/3._r8 + real(r8), parameter :: one_thrd = 1._r8/3._r8 + real(r8), parameter :: two_thrd = 2._r8/3._r8 + real(r8), parameter :: four_pi = 4._r8*pi + + integer :: sad_top + integer :: sad_topp + + contains + + + subroutine sad_inti(pbuf2d) +!---------------------------------------------------------------------- +! ... initialize the sad module +!---------------------------------------------------------------------- + + use time_manager, only : is_first_step + use ref_pres, only : pref_mid_norm + use cam_history, only : addfld + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + implicit none + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +!---------------------------------------------------------------------- +! ... Local variables +!---------------------------------------------------------------------- + integer :: k + +!---------------------------------------------------------------------- +! ... find level where etamids are all > 1 hPa +!---------------------------------------------------------------------- + sad_top = 0 + do k = pver,1,-1 + if( (pref_mid_norm(k)) < .001_r8 ) then + sad_top = k + exit + end if + end do + sad_topp = sad_top + 1 + if (masterproc) then + write(iulog,*) 'sad_inti: sad capped at level ',sad_top + write(iulog,*) ' whose midpoint is ',pref_mid_norm(sad_topp)*1.e3_r8,' hPa' + endif + + call addfld( 'H2SO4M_C', (/ 'lev' /), 'I', 'ug/m3', 'chemical sulfate aerosol mass' ) + + end subroutine sad_inti +!=============================================================================== +! ROUTINE +! sad_strat_calc +! +! Date... +! 14 October 1999 +! +! Programmed by... +! Douglas E. Kinnison +! Modified by +! Stacy Walters +! 1 November 1999 +! Modified by +! Doug Kinnison +! 1 September 2004; Condensed phase H2O passed in from CAM +! 2 November 2004; New treatment of denitrificatoin (NAT) +! 14 November 2004; STS mode of operation. +! 27 March 2008; Using original NAT approach. +! 08 November 2010; STS Approach (HNO3 => STS; then HNO3 => NAT) +! 24 March 2011; updated mask logic and removed sm NAT logic +! 14 April 2011; updated EQUIL logic +! 19 December 2012; updated using Wegner et al., JGR, 2013a,b. +! 25 April 2013; Removed volcanic heating logic. +! +! DESCRIPTION +! +! This routine has the logic to derive the surface area density for +! three types of aerosols: Sulfate (LBS, STS); Nitric Acid Trihydrate (NAT); +! and Water-ICE. The surface area density is stored in sad_strat(3). The +! first, second, and third dimensions are SULFATE, NAT, and ICE SAD +! respectively. The effective radius of each particle is also stored +! in radius_strat(3). +! +! NOTE1: For Sulfate and H2O ICE calculations +! The Surface Area and Volume Densities are calculated from the +! second and third moment of the LOG Normal Distribution. For an example +! see Binkowski et al., JGR, 100, 26191-26209, 1995. The Volume Density +! is substituted into the SAD equation so that the SAD is dependent on +! the # of particles cm-3, the width of the distribution (sigma), and +! the volume density of the aerosol. This approach is discussed in +! Considine et al., 2000 and Kinnison et al., 2007. +! +! NOTE2: For the ternary solution calculation +! the total sulfate mass is derived from the SAGEII SAD data. This approach +! has been previously used in Considine et al., JGR, 1999. The thermodynamic +! models used in this routine are from A. Tabazedeh et al, 1994. +! +! NOTE3: Updates to the PSC scheme is discussed in Wegner et al., 2013a. +! 80% of the total HNO3 is allowed to see STS, 20% NAT. The number density of +! the NAT and ICE particles are is set to 0.01 and 0.1 particle cm-3 respectively. +! +! NOTE4: The HCl solubility (in STS) has been added and evalutede in Wegner et al., 2013b. +! This solubility is based on Carslaw et al., 1995. +! +! REFERENCES for this PSC module: +! Considine, D. B., A. R. Douglass, P. S. Connell, D. E. Kinnison, and D. A., Rotman, +! A polar stratospheric cloud parameterization for the three dimensional model of +! the global modeling initiative and its response to stratospheric aircraft, +! J. Geophys. Res., 105, 3955-3975, 2000. +! +! Kinnison, D. E.,et al., Sensitivity of chemical tracers to meteorological +! parameters in the MOZART-3 chemical transport model, J. Geophys. Res., +! 112, D20302, doi:10.1029/2006JD007879, 2007. +! +! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, S. Solomon, and M. von Hobe, +! On the depletion of HCl in the Antarctic polar vortex, +! in review J. Geophys. Res., 2013. +! +! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, and S. Solomon, +! Polar Stratospheric Clouds in SD-WACCM4, in review J. Geophys. Res., 2013. +! +! Tabazedeh, A., R. P. Turco, K. Drdla, M. Z. Jacobson, and O. B, Toon, A study +! of the type I polar stratosphere cloud formation, +! Geophys. Res. Lett., 21, 1619-1622, 1994. +! +! Carslaw, K. S., S. L. Clegg, and P. Brimblecombe, A thermodynamic model of the +! system HCl-HNO3-H2SO4-H2O, including solubilities of HBr, from <200 to 328K, +! J. Phys. Chem., 99, 11,557-11,574, doi:1021/100029a039, 1995. +! +! +! ARGUMENTS +! INPUT: +! hno3_gas Nitric Acid gas phase abundance (mole fraction) +! hno3_cond(2) Nitric Acid cond. phase abundance (mole fraction) +! (1) in STS; (2) in NAT +! h2o_cond Water condensed phase (mole fraction) +! h2o_gas Water gas-phase abundance (mole fraction) +! +! hcl_gas HCL gas-phase abundance (mole fraction) +! hcl_cond HCl condensed phase (STS) (mole fraction) +! +! sage_sad SAGEII surface area density (cm2-aer cm-3 atm) +! m Airdensity (molecules cm-3) +! press Pressure (hPa) +! +! +! OUTPUT: +! +! hno3_gas = Gas-phase HNO3 Used in chemical solver. +! hno3_cond(1) = Condensed HNO3 from STS Not used in mo_aero_settling.F90 +! hno3_cond(2) = Condensed HNO3 from NAT Used in mo_aero_settling.F90 +! +! hcl_gas = Gas-phase HCL Used in chemical solver. +! hcl_cond = Condensed HCl from STS +! +! SAD_strat(1) = Sulfate Aerosol... Used in mo_strato_rates.F90 +! SAD_strat(2) = NAT Aerosol.... Used in mo_strato_rates.F90 +! SAD_strat(3) = Water-Ice......... Used in mo_strato_rates.F90 +! +! RAD_strat(1) = Sulfate Aerosol... Used in mo_strato_rates.F90 +! RAD_strat(2) = NAT large mode.... Used in mo_aero_settling.F90 +! RAD_strat(3) = Water-Ice......... Not used in mo_aero_settling.F90 +! +! NOTE1: The sum of hno3_cond(1-2) will be added to hno3_gas for advection of HNO3 in +! mo_gas_phase_chemdr.F90. +! +! NOTE2: The sum of hcl_cond will be added to hcl_gas for advection of HCl in +! mo_gas_phase_chemdr.F90. +! +! NOTE3: This routine does not partition H2O. +! +! +! ROUTINES Called (in and below this routine): +! +! sad_strat_calc +! nat_sat_temp ...... derives the NAT saturation temp +! +! sulfate_sad_calc .. Calculates the sulfate SAD; HNO3, H2O cond. phase +! calc_radius_lbs ... Calculates the radius for a H2SO4 Binary soln. (T>200K) +! sad_to_h2so4 ...... Derives H2SO4 abundance (micrograms m-3) +! from SAGEII SAD. +! density............ A. Tabazedeh binary thermo model +! equil.............. A. Tabazedeh ternary thermo. model +! +! nat_sad_calc....... Calculates the NAT SAD; HNO3, H2O cond. phase +! nat_cond........... Derives the NAT HNO3 gas/cond partitioning +! +! ice_sad_calc....... derives the ICE SAD and H2O gas/cond partitioning +!=============================================================================== + + subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & + hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, & + sad_sage, radius_strat, sad_strat, ncol, pbuf ) + + use cam_history, only : outfld + use physics_buffer, only : physics_buffer_desc + + implicit none + +!------------------------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------------------------- + integer, intent(in) :: lchnk ! chnk id + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: m (ncol,pver) ! Air density (molecules cm-3) + real(r8), intent(in) :: sad_sage (ncol,pver) ! SAGEII surface area density (cm2 aer. cm-3 air) + real(r8), intent(in) :: press (ncol,pver) ! Pressure, hPa + real(r8), intent(in) :: temper (pcols,pver) ! Temperature (K) + real(r8), intent(inout) :: h2o_gas (ncol,pver) ! H2O gas-phase (mole fraction) + real(r8), intent(inout) :: h2o_cond (ncol,pver) ! H2O condensed phase (mole fraction) + real(r8), intent(inout) :: hno3_gas (ncol,pver) ! HNO3 condensed phase (mole fraction) + real(r8), intent(inout) :: hno3_cond (ncol,pver,2) ! HNO3 condensed phase (mole fraction) + real(r8), intent(inout) :: hcl_gas (ncol,pver) ! HCL gas-phase (mole fraction) + real(r8), intent(inout) :: hcl_cond (ncol,pver) ! HCL condensed phase (mole fraction) + real(r8), intent(out) :: radius_strat(ncol,pver,3) ! Radius of Sulfate, NAT, and ICE (cm) + real(r8), intent(out) :: sad_strat (ncol,pver,3) ! Surface area density of Sulfate, NAT, ICE (cm2 cm-3) + +!------------------------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------------------------- + real(r8), parameter :: temp_floor = 0._r8 + + integer :: i, k, n + integer :: dims(1) + real(r8) :: hno3_total (ncol,pver) ! HNO3 total = gas-phase + condensed + real(r8) :: h2o_total (ncol,pver) ! H2O total = gas-phase + condensed + real(r8) :: radius_lbs (ncol,pver) ! Radius of Liquid Binary Sulfate (cm) + real(r8) :: radius_sulfate(ncol,pver) ! Radius of Sulfate aerosol (cm) + real(r8) :: radius_nat (ncol,pver) ! Radius of NAT aerosol (cm) + real(r8) :: radius_ice (ncol,pver) ! Radius of ICE aerosol (cm) + real(r8) :: sad_nat (ncol,pver) ! SAD of NAT aerosol (cm2 cm-3) + real(r8) :: sad_sulfate (ncol,pver) ! SAD of Sulfate aerosol (cm2 cm-3) + real(r8) :: sad_ice (ncol,pver) ! SAD of ICE aerosol (cm2 cm-3) + real(r8) :: tsat_nat (ncol,pver) ! Temperature for NAT saturation + real(r8) :: h2o_avail (ncol,pver) ! H2O temporary arrays + real(r8) :: hno3_avail (ncol,pver) ! HNO3 temporary array + real(r8) :: hno3_gas_nat (ncol,pver) ! HNO3 after call to NAT routines + real(r8) :: hno3_gas_sulf (ncol,pver) ! HNO3 after call to STS routines + real(r8) :: hno3_cond_nat (ncol,pver) ! HNO3 condensed after call to NAT + real(r8) :: hno3_cond_sulf(ncol,pver) ! HNO3 condensed after call to STS routines + real(r8) :: hcl_total (ncol,pver) ! HCl total = gas-phase + condensed + real(r8) :: hcl_avail (ncol,pver) ! HCL temporary arrays + real(r8) :: hcl_gas_sulf (ncol,pver) ! HCL after call to STS routines + real(r8) :: hcl_cond_sulf (ncol,pver) ! HCL condensed after call to STS routines + real(r8) :: temp (pcols,pver) ! wrk temperature array + real(r8) :: h2so4m (ncol,pver) ! wrk array + + logical :: z_val(ncol) + + logical :: mask_lbs(ncol,pver) ! LBS mask T: P>300hPa; P<2hPa2hPa; SAGE<1e-15; T>200K + logical :: mask_ice(ncol,pver) ! ICE mask T: .not. mask_lbs; h2o_cond>0 + logical :: mask_sts(ncol,pver) ! STS mask T: .not. mask_sts + logical :: mask_nat(ncol,pver) ! NAT mask T: mask_sts=T; T 200K or SAD_SULF <= 1e-15 or +! P < 2hPa or P > 300hPa +! ... mask_sts = false .... .not. mask_lbs +! ... mask_nat = false .... T <= TSAT_NAT +! ... mask_ice = false .... H2O_COND > 0.0 +!====================================================================== +!====================================================================== + + do k = sad_topp,pver + mask_lbs(:,k) = temp(:ncol,k) > 200._r8 .or. sad_sage(:,k) <= 1.e-15_r8 & + .or. press(:ncol,k) < 2._r8 .or. press(:ncol,k) > 300._r8 + end do + +sage_sad : & + if( any( mask_lbs(:,sad_topp:pver) ) ) then + do k = sad_topp,pver + where( mask_lbs(:,k) ) + sad_strat(:,k,1) = sad_sage(:,k) + sad_strat(:,k,2) = 0._r8 + sad_strat(:,k,3) = 0._r8 + endwhere + end do +!---------------------------------------------------------------------- +! ... Calculate Liquid Binary Sulfate Radius +!---------------------------------------------------------------------- + call calc_radius_lbs( ncol, mask_lbs, sad_sage, radius_lbs ) + do k = sad_topp,pver + where( mask_lbs(:,k) ) + radius_strat(:,k,1) = radius_lbs(:,k) + radius_strat(:,k,2) = 0._r8 + radius_strat(:,k,3) = 0._r8 + hno3_gas (:,k) = hno3_total(:,k) + hno3_cond (:,k,1) = 0._r8 + hno3_cond (:,k,2) = 0._r8 + hcl_gas (:,k) = hcl_total(:,k) + hcl_cond (:,k) = 0._r8 + endwhere + end do + if( all( mask_lbs(:,sad_topp:pver) ) ) then + call outfld( 'H2SO4M_C', h2so4m(:ncol,:), ncol, lchnk ) + return + end if + end if sage_sad + +!====================================================================== +!====================================================================== +! ... Logic for deriving ICE +! Ice formation occurs here if condensed phase H2O exists. +! +! mask_lbs = false.... T > 200K or SAD_SULF < 1e-15 or +! P >2hPa or P <300hPa +! mask_ice = true .... H2O_COND > 0.0 +!====================================================================== +!====================================================================== + do k = sad_topp,pver + do i = 1,ncol + if( .not. mask_lbs(i,k) ) then + mask_ice(i,k) = h2o_cond(i,k) > 0._r8 + else + mask_ice(i,k) = .false. + end if + end do + end do + +all_ice : & + if( any( mask_ice(:,sad_topp:pver) ) ) then + do k = sad_topp,pver + where( mask_ice(:,k) ) + h2o_avail(:,k) = h2o_cond(:,k) + endwhere + end do +!---------------------------------------------------------------------- +! ... ICE +!---------------------------------------------------------------------- + call ice_sad_calc( ncol, press, temp, m, h2o_avail, & + sad_ice, radius_ice, mask_ice ) + + do k = sad_topp,pver + where( mask_ice(:,k) ) + sad_strat (:,k,3) = sad_ice (:,k) + radius_strat(:,k,3) = radius_ice (:,k) + endwhere + end do + end if all_ice + +!====================================================================== +!====================================================================== +! ... LOGIC for STS and NAT +! +! mask_lbs = false .... T > 200K or SAD_SULF <= 1e-15 or +! P < 2hPa or P >300hPa +! mask_sts = true .... not mask_lbs +! mask_nat = true .... T <= TSAT_NAT and mask_sts = true +!====================================================================== +!====================================================================== + + do k = sad_topp,pver + do i = 1,ncol + if( .not. mask_lbs(i,k) ) then + mask_sts(i,k) = .true. + else + mask_sts(i,k) = .false. + end if + end do + end do +!---------------------------------------------------------------------- +! ... STS (80% of total HNO3 logic) +!---------------------------------------------------------------------- +! NOTE: STS only sees 80% of the total HNO3 (Wegner et al., JGR, 2013a) +sts_nat_sad : & + if( any( mask_sts(:,sad_topp:pver) ) ) then + do k = sad_topp,pver + where( mask_sts(:,k) ) + h2o_avail (:,k) = h2o_gas (:,k) + hno3_avail(:,k) = hno3_total(:,k)*eighty_percent + hcl_avail (:,k) = hcl_total (:,k) + endwhere + if( any(mask_sts(:,k)) ) then + where( mask_sts(:,k) ) + z_val(:) = hno3_avail(:,k) == 0._r8 + elsewhere + z_val(:) = .false. + endwhere + if( any( z_val(:) ) ) then + write(iulog,*) 'sad_strat_calc: Before CHEM Sulfate_SAD_CALC_1 has zero hno3_avail at lchnk,k = ',lchnk,k + end if + end if + end do + + call sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail, & + sad_sage, m, hno3_gas_sulf, hno3_cond_sulf, & + hcl_gas_sulf, hcl_cond_sulf, sad_sulfate, & + radius_sulfate, mask_sts, lchnk, 1, h2so4m, .true.) + do k = sad_topp,pver + where( mask_sts(:,k) ) + sad_strat (:,k,1) = sad_sulfate (:,k) + radius_strat(:,k,1) = radius_sulfate(:,k) + hno3_gas (:,k) = hno3_gas_sulf (:,k) + hno3_cond (:,k,1) = hno3_cond_sulf(:,k) + hcl_gas (:,k) = hcl_gas_sulf (:,k) + hcl_cond (:,k) = hcl_cond_sulf (:,k) + endwhere + end do + +!---------------------------------------------------------------------- +! ... NAT (20% of total HNO3 logic) +! ... using total H2O and gas-phase HNO3 after STS calc +!---------------------------------------------------------------------- +! NOTE: NAT only sees 20% of the total HNO3 (Wegner et al., JGR, 2013a) + hno3_avail(:,:) = hno3_total(:,:)*twenty_percent + call nat_sat_temp( ncol, hno3_avail, h2o_avail, press, tsat_nat, mask_sts) + + do k = sad_topp,pver + do i = 1,ncol + if( .not. mask_lbs(i,k) ) then + mask_nat(i,k) = temp(i,k) <= tsat_nat(i,k) + else + mask_nat(i,k) = .false. + end if + end do + end do + + do k = sad_topp,pver + where( mask_nat(:,k) ) + h2o_avail (:,k) = h2o_gas (:,k) + hno3_avail(:,k) = hno3_total (:,k)*twenty_percent + endwhere + if( any(mask_nat(:,k)) ) then + where( mask_nat(:,k) ) + z_val(:) = hno3_avail(:,k) == 0._r8 + elsewhere + z_val(:) = .false. + endwhere + if( any( z_val(:) ) ) then + write(iulog,*) 'sad_nat_calc: After CHEM Sulf_SAD_CALC_1 has zero hno3_avail at lchnk,k = ',lchnk,k + end if + end if + end do + + call nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & + hno3_gas_nat, hno3_cond_nat, & + sad_nat, radius_nat, mask_nat ) + + +! NOTE: Add in gas-phase from STS with gas-phase from NAT + do k = sad_topp,pver + where( mask_nat(:,k) ) + sad_strat (:,k,2) = sad_nat (:,k) + radius_strat(:,k,2) = radius_nat (:,k) + hno3_gas (:,k) = hno3_gas_sulf (:,k) + hno3_gas_nat (:,k) + hno3_cond (:,k,2) = hno3_cond_nat (:,k) + endwhere + end do + +! NOTE: If NAT does not form (in STS region), need to add the 20% of the total HNO3 back to gas-phase + do k = sad_topp,pver + do i = 1,ncol + if ( .not. mask_nat(i,k) ) then + if ( mask_sts(i,k) ) then + hno3_gas (i,k) = hno3_gas_sulf(i,k) + hno3_total(i,k)*twenty_percent + end if + end if + end do + end do + + end if sts_nat_sad + + + call outfld( 'H2SO4M_C', h2so4m(:ncol,:), ncol, lchnk ) + + end subroutine sad_strat_calc + + subroutine nat_sat_temp( ncol, hno3_total, h2o_avail, press, tsat_nat, mask ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: press(ncol,pver) + real(r8), intent(in) :: h2o_avail(ncol,pver) + real(r8), intent(in) :: hno3_total(ncol,pver) + real(r8), intent(out) :: tsat_nat(ncol,pver) + logical, intent(in) :: mask(ncol,pver) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: ssrNAT = 10.0_r8 + real(r8), parameter :: ssrNATi = .1_r8 + real(r8), parameter :: aa = -2.7836_r8, & + bb = -0.00088_r8, & + cc = 38.9855_r8, & + dd = -11397.0_r8, & + ee = 0.009179_r8 + integer :: k, i + real(r8) :: bbb ! temporary variable + real(r8) :: ccc ! temporary variable + real(r8) :: wrk ! temporary variable + real(r8) :: tmp ! temporary variable + real(r8) :: phno3 ! hno3 partial pressure + real(r8) :: ph2o ! h2o partial pressure + + tsat_nat(:,:) = 0._r8 + +!---------------------------------------------------------------------- +! ... Derive HNO3 and H2O partial pressure (torr) +! where: 0.7501 = 760/1013. +!---------------------------------------------------------------------- + do k = sad_topp,pver + do i = 1,ncol + if( mask(i,k) ) then + + bbb = press(i,k) * .7501_r8 + phno3 = hno3_total(i,k) * bbb + ph2o = h2o_avail(i,k) * bbb + + if( phno3 > 0._r8 ) then +!---------------------------------------------------------------------- +! ... Calculate NAT Saturation Threshold Temperature +! Hanson and Mauersberger: GRL, Vol.15, 8, p855-858, 1988. +! Substitute m(T) and b(T) into Equation (1). Rearrange and +! solve quadratic eqation. +!---------------------------------------------------------------------- + tmp = log10( ph2o ) + wrk = 1._r8 / (ee + bb*tmp) + bbb = (aa*tmp - log10( phno3*ssrNATi ) + cc) * wrk + ccc = dd *wrk + tsat_nat(i,k) = .5_r8 * (-bbb + sqrt( bbb*bbb - 4._r8*ccc )) + endif + endif + enddo + end do + + end subroutine nat_sat_temp + + subroutine calc_radius_lbs( ncol, mask, sad_sage, radius_lbs ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: sad_sage(ncol,pver) + real(r8), intent(out) :: radius_lbs(ncol,pver) + logical, intent(in) :: mask(ncol,pver) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: k + real(r8) :: lbs_vol_dens(ncol) ! Vol Density (cm3 aer / cm3 air) + +!---------------------------------------------------------------------- +! ... parameters +!---------------------------------------------------------------------- + real(r8), parameter :: lbs_part_dens = 10._r8, sigma_lbs = 1.6_r8 + +!---------------------------------------------------------------------- +! ... calculate the volume density (cm3 aerosol / cm3 air) +! calculate the mean radius for binary soln +!---------------------------------------------------------------------- + do k = sad_topp,pver + where( mask(:,k) ) + lbs_vol_dens(:) = ((sad_sage(:,k)**1.5_r8)/3._r8)/sqrt( four_pi*lbs_part_dens ) & + *exp( 1.5_r8*(log( sigma_lbs ))**2 ) + radius_lbs(:,k) = (3._r8*lbs_vol_dens(:)/(four_pi*lbs_part_dens))**one_thrd & + *exp( -1.5_r8*(log( sigma_lbs ))**2 ) + endwhere + end do + + end subroutine calc_radius_lbs + + subroutine ice_sad_calc( ncol, press, temp, m, h2o_avail, & + sad_ice, radius_ice, mask ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: press (ncol,pver) + real(r8), intent(in) :: temp (pcols,pver) + real(r8), intent(in) :: m (ncol,pver) + real(r8), intent(in) :: h2o_avail (ncol,pver) + real(r8), intent(out) :: sad_ice (ncol,pver) + real(r8), intent(out) :: radius_ice(ncol,pver) + logical, intent(in) :: mask (ncol,pver) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: & + avo_num = 6.02214e23_r8, & + aconst = -2663.5_r8, & + bconst = 12.537_r8, & + ice_mass_dens = 1._r8, & + ice_part_dens = 1.e-1_r8, & + mwh2o = 18._r8, & + sigma_ice = 1.6_r8, & + ice_dens_aer = ice_mass_dens / (mwh2o/avo_num), & + ice_dens_aeri = 1._r8/ice_dens_aer + + integer :: k + real(r8) :: h2o_cond_ice(ncol) ! Condensed phase H2O (from CAM) + real(r8) :: voldens_ice (ncol) ! Volume Density, um3 cm-3 + + do k = sad_topp,pver + where( mask(:,k) ) +!---------------------------------------------------------------------- +! .... Convert condensed phase to molecules cm-3 units +!---------------------------------------------------------------------- + h2o_cond_ice(:) = h2o_avail(:,k) * m(:,k) +!---------------------------------------------------------------------- +! .... ICE volume density ..... +!---------------------------------------------------------------------- + voldens_ice(:) = h2o_cond_ice(:)*ice_dens_aeri +!---------------------------------------------------------------------- +! .... Calculate the SAD from log normal distribution ..... +!---------------------------------------------------------------------- + sad_ice(:,k) = (four_pi*ice_part_dens)**one_thrd & + *(3._r8*voldens_ice(:))**two_thrd & + *exp( -(log( sigma_ice ))**2 ) +!---------------------------------------------------------------------- +! .... Calculate the radius from log normal distribution ..... +!---------------------------------------------------------------------- + radius_ice(:,k) = (3._r8*h2o_cond_ice(:) & + /(ice_dens_aer*four_pi*ice_part_dens))**one_thrd & + *exp( -1.5_r8*(log( sigma_ice ))**2 ) + endwhere + end do + + end subroutine ice_sad_calc + + subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail, & + sad_sage, m, hno3_gas, hno3_cond, & + hcl_gas, hcl_cond, sad_sulfate, & + radius_sulfate, mask, lchnk, flag, h2so4m, is_chem) + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk, flag + real(r8), intent(in) :: temp (pcols,pver) + real(r8), intent(in) :: press (ncol,pver) + real(r8), intent(in) :: m (ncol,pver) + real(r8), intent(in) :: h2o_avail (ncol,pver) + real(r8), intent(in) :: hno3_avail (ncol,pver) + real(r8), intent(in) :: hcl_avail (ncol,pver) + real(r8), intent(in) :: sad_sage (ncol,pver) + real(r8), intent(out) :: hno3_gas (ncol,pver) ! Gas-phase HNO3, mole fraction + real(r8), intent(out) :: hno3_cond (ncol,pver) ! Condensed phase HNO3, mole fraction + real(r8), intent(out) :: hcl_gas (ncol,pver) ! Gas-phase HCL, mole fraction + real(r8), intent(out) :: hcl_cond (ncol,pver) ! Condensed phase HCL, mole fraction + real(r8), intent(out) :: sad_sulfate(ncol,pver) + real(r8), intent(out) :: radius_sulfate(ncol,pver) + real(r8), intent(inout) :: h2so4m (ncol,pver) ! mass per volume, micro grams m-3 + logical, intent(in) :: is_chem ! chemistry calc switch + logical, intent(in) :: mask (ncol,pver) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: t_limit = 200._r8 + real(r8), parameter :: avo_num = 6.02214e23_r8 + real(r8), parameter :: mwh2so4 = 98.076_r8 + real(r8), parameter :: sigma_sulfate = 1.6_r8 + real(r8), parameter :: sulfate_part_dens = 10._r8 + + integer :: i, k + integer :: cnt1, cnt2 + real(r8) :: ratio + real(r8) :: vals(2) + real(r8) :: h2so4_aer_dens (ncol,pver) ! grams cm-3 solution + real(r8) :: h2so4_cond (ncol,pver) ! Condensed H2SO4 (moles cm-3 air) + real(r8) :: sulfate_vol_dens(ncol,pver) ! Volume Density, cm3 aerosol cm-3 air + real(r8) :: wtf (ncol,pver) ! weight fraction of H2SO4 in ternary soln + real(r8) :: wts (ncol,pver) ! weight percent of ternary solution + +! Carslaw HCl solubility + real(r8) :: wts0 (ncol,pver) ! weight percent of H2SO4 is LBS + real(r8) :: wtn (ncol,pver) ! weight percent of HNO3 in STS + real(r8) :: ch2so4 (ncol,pver) ! Total H2SO4 (moles / cm3 of air) + real(r8) :: molh2so4 (ncol,pver) ! Equil molality of H2SO4 in STS + real(r8) :: molhno3 (ncol,pver) ! Equil molality of HNO3 in STS + real(r8) :: AD (ncol,pver) ! air density (molecules cm-3) + real(r8) :: xmf (ncol,pver) ! + real(r8) :: hhcl (ncol,pver) ! henry's solubility of hcl in binary + real(r8) :: phcl0 (ncol,pver) ! partial pressure of hcl (hPa) + real(r8) :: h2so4vmr (ncol,pver) ! atmospheric mole fraction of H2SO4 + real(r8) :: nsul (ncol,pver) ! moles / m3- H2SO4 pure liquid + real(r8) :: mcl (ncol,pver) ! molality of hcl in ? + real(r8) :: wtcl (ncol,pver) ! + real(r8) :: phcl (ncol,pver) ! partial pressure of hcl (over aerosol) + real(r8) :: parthcl (ncol,pver) ! fraction of HCl in gas-phase +! + real(r8) :: packer (ncol*pver) + logical :: do_equil ! local mask + logical :: mask_lt (ncol,pver) ! local temperature mask + logical :: maskx (ncol,pver) + logical :: converged (ncol,pver) ! EQUIL convergence test + + hcl_gas (:,:) = 0.0_r8 + hcl_cond(:,:) = 0.0_r8 + parthcl (:,:) = 0.0_r8 + phcl0 (:,:) = 0.0_r8 + + do k = sad_topp,pver + mask_lt(:,k) = mask(:,k) + end do + +!---------------------------------------------------------------------- +! ... derive H2SO4 (micro grams / m3) from SAGEII SAD +!---------------------------------------------------------------------- + call sad2h2so4( h2o_avail, press, sad_sage, temp, sulfate_vol_dens, & + h2so4_aer_dens, h2so4m, mask, ncol ) + +!---------------------------------------------------------------------- +! ... limit h2so4m +!---------------------------------------------------------------------- + + do k = sad_topp,pver + do i = 1,ncol + if( mask(i,k) ) then + if( h2so4m(i,k) <= 0._r8 ) then + h2so4m(i,k) = 1.e-2_r8 + end if + end if + end do + end do + + if( is_chem ) then + else + do k = sad_topp,pver + where( mask(:ncol,k) ) + mask_lt(:ncol,k) = temp(:ncol,k) < t_limit + end where + end do + end if + + if( is_chem ) then + do_equil = .true. + else + do_equil = any( mask_lt(:,sad_topp:pver) ) + end if + +!---------------------------------------------------------------------- +! .... Calculate the ternary soln volume density +!---------------------------------------------------------------------- + if( do_equil ) then + + call equil( temp, h2so4m, hno3_avail, h2o_avail, press, & + hno3_cond, h2so4_cond, wts, wtn, wts0, molh2so4, molhno3, mask_lt, ncol, & + lchnk, flag, is_chem, converged ) + + do k = sad_topp,pver + + where( ( mask_lt(:ncol,k) ) .AND. ( converged(:ncol,k) ) ) + +!---------------------------------------------------------------------- +! .... convert h2o, hno3 from moles cm-3 air to molecules cm-3 air +!---------------------------------------------------------------------- + hno3_cond(:ncol,k) = min( hno3_cond(:ncol,k),hno3_avail(:ncol,k) ) + hno3_gas(:ncol,k) = hno3_avail(:ncol,k) - hno3_cond(:ncol,k) + +!---------------------------------------------------------------------- +! .... Derive ternary volume density (cm3 aer / cm3 air) +!---------------------------------------------------------------------- + wtf(:ncol,k) = .01_r8* wts(:ncol,k) + sulfate_vol_dens(:ncol,k) = h2so4_cond(:ncol,k)*mwh2so4/(wtf(:ncol,k)*h2so4_aer_dens(:ncol,k)) + +! Carslaw solubility +!---------------------------------------------------------------------- +! .... Partition HCl (gas/condensed) *** Carslaw +!---------------------------------------------------------------------- +! THE SOLUBILITY OF HCL +! HHCl (MOL/KG/ATM) taken form Shi et al., JGR 2001 +! + +! .... Convert weight % to weight fraction + wtn(:ncol,k) = wtn(:ncol,k) * 0.01_r8 + wts0(:ncol,k) = wts0(:ncol,k) * 0.01_r8 + +! .... Derive xmf (mole fraction H2SO4 in LBS ) + xmf(:ncol,k) = (wts0(:ncol,k)*100.0_r8)/((wts0(:ncol,k)*100.0_r8)+ & + (100.0_r8-(wts0(:ncol,k)*100._r8))*98.0_r8/18.0_r8) + +! .... Derive hhcl (henry's solubility of hcl in binary) + hhcl(:ncol,k) = (0.094_r8-0.61_r8*xmf(:ncol,k)+1.2_r8*xmf(:ncol,k)**2.0_r8) & + *exp(-8.68_r8+(8515.0_r8-10718.0_r8*xmf(:ncol,k)**(0.7_r8))/temp(:ncol,k)) + +! .... Derive phcl0 (partial pressure of hcl( hPa)) + phcl0(:ncol,k) = hcl_avail(:ncol,k)*press(:ncol,k) / 1013.26_r8 + +! .... Derive H2SO4 vmr (h2so4_cond = mole / cm-3) + AD(:ncol,k) = (6.022098e23_r8 * press(:ncol,k) / 1013.26_r8) & + / (temp(:ncol,k)*8.2058e-2_r8*1000.0_r8) + h2so4vmr(:ncol,k) = (h2so4_cond(:ncol,k)*6.022098e23_r8) / AD(:ncol,k) + +! .... Derive nsul (moles / m3 H2SO4 pure liquid ) + nsul(:ncol,k) = h2so4vmr(:ncol,k) * press(:ncol,k) * 100.0_r8 / 8.314_r8 / temp(:ncol,k) + +! .... Derive mcl (molality of hcl) + mcl(:ncol,k) = (1.0_r8/8.314e-5_r8/temp(:ncol,k)*phcl0(:ncol,k))/(nsul(:ncol,k)/molh2so4(:ncol,k) + & + 1.0_r8/(8.314e-5_r8)/temp(:ncol,k)/hhcl(:ncol,k)) + +! .... Derive wtcl ( ) + wtcl(:ncol,k) = mcl(:ncol,k)*36.5_r8/(1000.0_r8 + 98.12_r8*molh2so4(:ncol,k) + 63.03_r8*molhno3(:ncol,k)) + +! .... Derive phcl (partial pressure over the aerosol) + phcl(:ncol,k) = mcl(:ncol,k)/hhcl(:ncol,k) + +! .... Derive parhcl (fraction of HCl in gas-phase) + where(phcl0(:ncol,k)>0._r8) + parthcl(:ncol,k) = 1.0_r8 - (phcl0(:ncol,k) - phcl(:ncol,k)) / phcl0(:ncol,k) + elsewhere + parthcl(:ncol,k) = 0._r8 + endwhere + +! .... Partition HCl (gas/condensed) + hcl_gas (:ncol,k) = hcl_avail(:ncol,k) * parthcl(:ncol,k) + hcl_cond(:ncol,k) = hcl_avail(:ncol,k) - hcl_gas(:ncol,k) + + elsewhere + hno3_cond(:ncol,k) = 0.0_r8 + hno3_gas(:ncol,k) = hno3_avail(:ncol,k) + hcl_cond (:ncol,k) = 0.0_r8 + hcl_gas (:ncol,k) = hcl_avail(:ncol,k) + + endwhere + end do + + end if + + do k = sad_topp,pver + where( mask(:,k) ) +!---------------------------------------------------------------------- +! .... Calculate the SAD (assuming ternary solution) +!---------------------------------------------------------------------- + sad_sulfate(:,k) = (four_pi*sulfate_part_dens)**one_thrd & + *(3._r8*sulfate_vol_dens(:,k))**two_thrd & + *exp( -(log( sigma_sulfate ))**2 ) + +!---------------------------------------------------------------------- +! .... Calculate the radius (assuming ternary solution) (in cm?) +!---------------------------------------------------------------------- + radius_sulfate(:,k) = (3._r8*sulfate_vol_dens(:,k) & + /(four_pi*sulfate_part_dens))**one_thrd & + *exp( -1.5_r8*(log( sigma_sulfate ))**2 ) + endwhere + + end do + + end subroutine sulfate_sad_calc + + + subroutine nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & + hno3_gas, hno3_cond, sad_nat, radius_nat, mask ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: press (ncol,pver) + real(r8), intent(in) :: m (ncol,pver) + real(r8), intent(in) :: temp (pcols,pver) + real(r8), intent(in) :: h2o_avail (ncol,pver) + real(r8), intent(in) :: hno3_avail(ncol,pver) + real(r8), intent(out) :: hno3_cond (ncol,pver) ! HNO3 in condensed phase (mole fraction) + real(r8), intent(out) :: hno3_gas (ncol,pver) ! HNO3 in gas-phase (mole fraction) + real(r8), intent(out) :: sad_nat (ncol,pver) + real(r8), intent(out) :: radius_nat(ncol,pver) + logical, intent(in) :: mask(ncol,pver) ! grid mask + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: k, i + real(r8) :: nat_dens_condphase(ncol, pver) ! Condensed phase NAT, molec cm-3 + real(r8) :: voldens_nat (ncol, pver) ! Volume Density, um3 cm-3 + real(r8) :: hno3_cond_total (ncol, pver) ! Total Condensed phase HNO3 + +!---------------------------------------------------------------------- +! ... parameters +!---------------------------------------------------------------------- + real(r8), parameter :: avo_num = 6.02214e23_r8, & + nat_mass_dens = 1.6_r8, & + nat_part_dens = 1.0e-2_r8, & + mwnat = 117._r8, & + sigma_nat = 1.6_r8, & + nat_dens_aer = nat_mass_dens / (mwnat/avo_num), & + nat_dens_aeri = 1._r8/nat_dens_aer + +!---------------------------------------------------------------------- +! ... Derive HNO3 paritioning (call A. Tabazedeh routine for NAT) +!---------------------------------------------------------------------- + call nat_cond( ncol, press, temp, h2o_avail, hno3_avail, & + hno3_gas, hno3_cond_total, mask ) + + do k = sad_topp,pver + do i = 1,ncol +masked : if( mask(i,k) ) then + +!---------------------------------------------------------------------- +! .... Set Condensed phase for return arguments +!---------------------------------------------------------------------- + hno3_cond(i,k) = hno3_cond_total(i,k) + +!---------------------------------------------------------------------- +! .... Calculated Condensed Phase NAT (i.e. HNO3) in +! molecules cm-3 of air units. +!---------------------------------------------------------------------- + nat_dens_condphase(i,k) = hno3_cond_total(i,k) * m(i,k) + +!---------------------------------------------------------------------- +! .... Calculate the Volume Density +!---------------------------------------------------------------------- + voldens_nat(i,k) = nat_dens_condphase(i,k) * nat_dens_aeri + +!---------------------------------------------------------------------- +! .... Calculate the SAD from log normal distribution +! .... Assuming sigma and nad_part_dens (# particles per cm3 of air) +!---------------------------------------------------------------------- + sad_nat(i,k) = (four_pi*nat_part_dens)**(one_thrd) & + *(3._r8*voldens_nat(i,k))**(two_thrd) & + *exp( -(log( sigma_nat )**2 )) + +!---------------------------------------------------------------------- +! .... Calculate the radius of NAT from log normal distribution +! .... Assuming sigma and nat_part_dens (# particles per cm3 +! .... of air) +!---------------------------------------------------------------------- + radius_nat(i,k) = (3._r8*nat_dens_condphase(i,k) & + /(nat_dens_aer*four_pi*nat_part_dens))**(one_thrd) & + *exp( -1.5_r8*(log( sigma_nat ))**2 ) + + end if masked + end do + end do + + end subroutine nat_sad_calc + + subroutine nat_cond( ncol, press, temp, h2o_avail, hno3_avail, & + hno3_gas, hno3_cond, mask ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: press(ncol,pver) + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: h2o_avail(ncol,pver) + real(r8), intent(in) :: hno3_avail(ncol,pver) + real(r8), intent(out) :: hno3_gas(ncol,pver) + real(r8), intent(out) :: hno3_cond(ncol,pver) + logical, intent(in) :: mask(ncol,pver) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: aa = -2.7836_r8, & + bb = -0.00088_r8, & + cc = 38.9855_r8, & + dd = -11397.0_r8, & + ee = 0.009179_r8 + + integer :: i, k + real(r8) :: bt ! temporary variable + real(r8) :: mt ! temporary variable + real(r8) :: t ! temporary variable + real(r8) :: logPhno3 ! temporary variable + real(r8) :: phno3 ! hno3 partial pressure + real(r8) :: ph2o ! h2o partial pressure + real(r8) :: phno3_eq ! partial pressure above NAT + real(r8) :: wrk + + do k = sad_topp,pver + do i = 1,ncol +!---------------------------------------------------------------------- +! .... Derive HNO3 and H2O partial pressure (torr) +! where: 0.7501 = 760/1013. +!---------------------------------------------------------------------- + if( mask(i,k) ) then + wrk = press(i,k) * .7501_r8 + phno3 = hno3_avail(i,k) * wrk + ph2o = h2o_avail(i,k) * wrk +!---------------------------------------------------------------------- +! Calculating the temperature coefficients for the variation of HNO3 +! and H2O vapor pressure (torr) over a trihydrate solution of HNO3/H2O +! The coefficients are taken from Hanson and Mauersberger: +! GRL, Vol.15, 8, p855-858, 1988. +!---------------------------------------------------------------------- + t = temp(i,k) + bt = cc + dd/t + ee*t + mt = aa + bb*t + + logphno3 = mt*log10( ph2o ) + bt + phno3_eq = 10._r8**logphno3 + + if( phno3 > phno3_eq ) then + wrk = 1._r8 / wrk + hno3_cond(i,k) = (phno3 - phno3_eq) * wrk + hno3_gas(i,k) = phno3_eq * wrk + else + hno3_cond(i,k) = 0._r8 + hno3_gas(i,k) = hno3_avail(i,k) + end if + end if + end do + end do + + end subroutine nat_cond + + subroutine sad2h2so4( h2o, press, sad_sage, temp, lbs_vol_dens, & + h2so4_aer_dens, h2so4m, mask, ncol ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: h2o(ncol,pver) ! h2o mole fraction + real(r8), intent(in) :: sad_sage(ncol,pver) ! sad from SAGEII cm2 aer, cm-3 air + real(r8), intent(in) :: press(ncol,pver) ! pressure (hPa) + real(r8), intent(in) :: temp(pcols,pver) ! temperature (K) + real(r8), intent(inout) :: h2so4m(ncol,pver) ! microgram/m**3 of air, + real(r8), intent(out) :: h2so4_aer_dens(ncol,pver) ! units: grams / cm3-aerosol + real(r8), intent(out) :: lbs_vol_dens(ncol,pver) ! cm3 aer / cm3 air + logical, intent(in) :: mask(ncol,pver) ! activation mask + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: lbs_part_dens = 10._r8 + real(r8), parameter :: sigma_lbs = 1.6_r8 + real(r8), parameter :: t_floor = 180._r8 + + integer :: i, k, l + real(r8) :: wts0 + real(r8) :: p ! pressure, torr + real(r8) :: tr ! inverse temperature + real(r8) :: c(6) + +!---------------------------------------------------------------------- +! ... Calculate the volume density (cm3 aerosol / cm3 air) +!---------------------------------------------------------------------- + do k = sad_topp,pver + do i = 1,ncol + if( mask(i,k) ) then + lbs_vol_dens(i,k) = ((sad_sage(i,k)**1.5_r8)/3._r8)/sqrt( four_pi*lbs_part_dens ) & + *exp( 1.5_r8*(log( sigma_lbs ))**2 ) +!---------------------------------------------------------------------- +! ... calculate Molality from Tabazadeh EQUIL routine (binary soln) +!---------------------------------------------------------------------- +! ... DEK, added a minimum to temperature +!---------------------------------------------------------------------- + p = h2o(i,k) * press(i,k) * .7501_r8 + tr = 1._r8 / max( t_floor,temp(i,k) ) + + do l = 1,6 + c(l) = exp( a(1,l) + tr*(a(2,l) + tr*(a(3,l) + tr*(a(4,l) + tr*a(5,l)))) ) + end do +!---------------------------------------------------------------------- +! ... H2SO4/H2O pure weight percent and molality (moles gram-1) +!---------------------------------------------------------------------- + wts0 = max( 0._r8,c(1) + p*(-c(2) + p*(c(3) + p*(-c(4) + p*(c(5) - p*c(6))))) ) +!---------------------------------------------------------------------- +! ... derive weight fraction for density routine +!---------------------------------------------------------------------- + wts0 = .01_r8 *wts0 +!---------------------------------------------------------------------- +! ... calculate the binary solution density, grams / cm3-aerosol +!---------------------------------------------------------------------- + h2so4_aer_dens(i,k) = max( 0._r8,density( temp(i,k), wts0 ) ) +!---------------------------------------------------------------------- +! ... calculate the H2SO4 micrograms m-3 abundance for binary soln +!---------------------------------------------------------------------- + h2so4m(i,k) = lbs_vol_dens(i,k)*h2so4_aer_dens(i,k)*wts0*1.e12_r8 + end if + end do + end do + + end subroutine sad2h2so4 + +!====================================================================== +! +! ROUTINE +! EQUIL +! +! Date... +! 7 October 1999 +! +! Programmed by... +! A. Tabazadeh +! +! DESCRIPTION +! Ternary solution routine +! +! ARGUMENTS +! +!.... INPUT: +! +! H2SO4m = microgram/m**3 of air +! HNO3r = mole fraction +! H2Or = mole fraction +! PTOTAL = hPa +! +!.... Output +! +! Cwater = Total moles of liguid water / cm**3 of air +! hno3_cond = HNO3 Condensed phase (mole fraction) +! CH2SO4 = Total H2SO4 moles / cm**3 of air +! WTS = Weight percent of H2SO4 in the ternary aerosol +! +!====================================================================== + subroutine equil( temper, h2so4m, hno3_avail, h2o_avail, press, & + hno3_cond, ch2so4, wts, wtn, wts0, molh2so4, molhno3, mask, ncol, & + lchnk, flag, is_chem, converged) +!---------------------------------------------------------------------- +! Written by Azadeh Tabazadeh (1993) +! (modified from EQUISOLV -- M. Z. Jacobson -- see below) +! NASA Ames Research Center , Tel. (415) 604 - 1096 +! +! This program solves the equilibrium composition for the ternary +! system of H2SO4/HNO3/H2O under typical stratospheric conditions. +! The formulation of this work is described by Tabazadeh, A., +! Turco, R. P., and Jacobson, M. Z. (1994), "A model for studying +! the composition and chemical effects of stratospheric aerosols," +! J. Geophys. Res., 99, 12,897, 1994. * +! +! The solution mechanism for the equilibrium equations is des- +! cribed by Jacobson, M. Z., Turco, R. P., and Tabazadeh, A. +! (1994), "Simulating Equilibrium within aerosols and non-equil- +! ibrium between gases and aerosols," J. Geophys. Res., in review. +! The mechanism is also codified in the fortran program, EQUISOLV, +! by M.Z. Jacobson (1991-3). EQUISOLV solves any number of +! gas / liquid / solid / ionic equilibrium equations simultan- +! eously and includes treatment of the water equations and act- +! ivity coefficients. The activity coeffients currently in +! EQUISOLV are valid for tropospheric temperatures. The acitiv- +! ities listed here are valid for stratospheric temperatures only. +! +! DEFINING PARAMETERS +! +! *NOTE* Solver parameters including, F, Z, QN, QD, and deltaX +! are described in Jacobson et al. +! +! PTOTAL = Total atmospheric pressure in mb +! H2SO4m = Total mass of H2SO4 (microgram/m**3 of air) +! HNO3r = HNO3 mixing ratio +! H2Or = H2O mixing ratio +! P = Partial pressure of water in units of torr +! pures = molality for a pure H2SO4/H2O system +! puren = molality for a pure HNO3/H2O sytem +! WTS0 = weight percent of H2SO4 in a pure H2SO4/H2O system +! WTN0 = weight percent of HNO3 in a pure HNO3/H2O system +! WTS = weight percent of H2SO4 in the ternary aerosol +! WTN = weight percent of HNO3 in the ternary aerosol +! PHNO3 = HNO3 vapor pressure over the ternary system in atm +! HNO3 = HNO3 vapor concentration over the ternary system (#/cm3) +! CH2SO4 = Total H2SO4 moles / cm**3 of air +! CHNO3 = Total HNO3 moles / cm**3 of air +! CHplus = Total H+ moles / cm**3 0f air +! CPHNO3 = Total moles of HNO3 gas / cm**3 of air +! CNO3 = Total moles of NO3- / cm**3 0f air +! Cwater = Total moles of liguid water / cm**3 of air +! KS = Solubility constant for dissolution of HNO3 in +! water ( HNO3(gas) === H+(aq) + NO3- (aq) ) +! nm = HNO3 molality at the STREN of the ternary solution +! sm = H2SO4 molality at the STREN of the ternary solution +! molHNO3 = Equilibrium molality of HNO3 in the ternary solution +! molH2SO4= Equilibrium molality of H2SO4 in the ternary solution +! STREN = ionic strenght for the ternary solutin, which in +! this case is = 3 * molH2SO4 + molHNO3 +! acts = Pure mean binary activity coefficient for the H2SO4/ +! H2O system evaluated at the STREN of the ternary system +! actn = Pure mean binary activity coefficient for the HNO3/ +! H2O system evaluated at the STREN of the ternary system +! ymix = Mixed binary activity coefficient for the HNO3/H2O in +! the ternary solution +!---------------------------------------------------------------------- + + use cam_abortutils, only : endrun + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: lchnk + integer, intent(in) :: flag + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: h2so4m(ncol,pver) + real(r8), intent(in) :: hno3_avail(ncol,pver) + real(r8), intent(in) :: h2o_avail(ncol,pver) + real(r8), intent(in) :: press(ncol,pver) + real(r8), intent(in) :: temper(pcols,pver) + real(r8), intent(out) :: hno3_cond(ncol,pver) + real(r8), intent(out) :: ch2so4(ncol,pver) + real(r8), intent(out) :: wts(ncol,pver) + real(r8), intent(out) :: wtn(ncol,pver) + real(r8), intent(out) :: wts0(ncol,pver) + real(r8), intent(out) :: molh2so4(ncol,pver) + real(r8), intent(out) :: molhno3(ncol,pver) + logical, intent(in) :: is_chem + logical, intent(in) :: mask(ncol,pver) ! activation mask + logical, intent(out) :: converged(ncol,pver) +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- +! integer, parameter :: itermax = 50 + integer, parameter :: itermax = 100 + real(r8), parameter :: con_lim = .00005_r8 + real(r8), parameter :: t0 = 298.15_r8 + real(r8), parameter :: ks0 = 2.45e6_r8 + real(r8), parameter :: lower_delx = 1.e-10_r8 + real(r8), parameter :: upper_delx = .98_r8 + real(r8), parameter :: con_crit_chem = 5.e-5_r8 + + integer :: i, iter, k, l, nstep + real(r8) :: reduction_factor + real(r8) :: p + real(r8) :: tr + real(r8) :: wtn0 + real(r8) :: pures + real(r8) :: puren + real(r8) :: chno3 + real(r8) :: chplus + real(r8) :: cno3 + real(r8) :: wrk + real(r8) :: z, num, den + real(r8) :: deltax + real(r8) :: chplusnew + real(r8) :: cno3new + real(r8) :: stren + real(r8) :: sm + real(r8) :: actn + real(r8) :: acts + real(r8) :: nm + real(r8) :: ks + real(r8) :: lnks + real(r8) :: lnks0 + real(r8) :: mixyln + real(r8) :: wrk_h2so4 + real(r8) :: cphno3new + real(r8) :: con_val + real(r8) :: t, t1, t2, f, f1, f2, ymix, hplus, wtotal, ratio + real(r8) :: con_crit + real(r8) :: h2o_cond(ncol,pver) + real(r8) :: fratio(0:itermax) + real(r8) :: delx(0:itermax) + real(r8) :: delz(0:itermax) + real(r8) :: c(12) + real(r8) :: d(13:22) + logical :: interval_set + logical :: positive + + converged(:,:) = .false. + + lnks0 = log( ks0 ) + if( is_chem ) then + con_crit = con_crit_chem + else + con_crit = con_crit_chem + end if + Level_loop : do k = sad_topp,pver + Column_loop : do i = 1,ncol + if( mask(i,k) ) then + p = h2o_avail(i,k) * press(i,k) * .7501_r8 +!---------------------------------------------------------------------- +! Calculating the molality for pure binary systems of H2SO4/H2O +! and HNO3/H2O at a given temperature and water vapor pressure +! profile (relative humiditiy). Water activities were used to +! calculate the molalities as described in Tabazadeh et al. (1994). +!---------------------------------------------------------------------- + t = max( 180._r8,temper(i,k) ) + tr = 1._r8/t + do l = 1,12 + c(l) = exp( a(1,l) + tr*(a(2,l) + tr*(a(3,l) + tr*(a(4,l) + tr*a(5,l)))) ) + end do +!---------------------------------------------------------------------- +! ... H2SO4/H2O pure weight percent and molality +!---------------------------------------------------------------------- + wts0(i,k) = max( 0.01_r8,c(1) + p*(-c(2) + p*(c(3) + p*(-c(4) + p*(c(5) - p*c(6))))) ) + pures = (wts0(i,k) * 1000._r8)/(100._r8 - wts0(i,k)) + pures = pures / 98._r8 +!---------------------------------------------------------------------- +! ... HNO3/H2O pure weight percent and molality +!---------------------------------------------------------------------- + puren = max( 0._r8,c(7) + p*(-c(8) + p*(c(9) + p*(-c(10) + p*(c(11) - p*c(12))))) ) +! wtn0 = (puren * 6300._r8) /(puren * 63._r8 + 1000._r8) +!---------------------------------------------------------------------- +! The solving scheme is described both in Jacobson et al. and Tabazadeh +! et al.. Assumptions: +! (1) H2SO4 is present only in the aqueous-phase +! (2) H2SO4 and HNO3 in solution are fully dissocated into H+ +! SO42- and NO3- +! (3) PHNO3 + NO3- = constant +!---------------------------------------------------------------------- + ch2so4(i,k) = (h2so4m(i,k)*1.e-12_r8) / 98._r8 + if( pures > 0._r8 ) then + wrk_h2so4 = (1000._r8*ch2so4(i,k))/(pures*18._r8) + else + wrk_h2so4 = 0._r8 + end if + chno3 = 1.2029e-5_r8 * press(i,k) * tr * hno3_avail(i,k) + do l = 13,22 + d(l) = b(1,l) + t*(b(2,l) + t*(b(3,l) + t*(b(4,l) + t*b(5,l)))) + end do +!---------------------------------------------------------------------- +! Note that KS depends only on the temperature +!---------------------------------------------------------------------- + t1 = (t - t0)/(t*t0) + t2 = t0/t - 1._r8 - log( t0/t ) + lnks = lnks0 - 8792.3984_r8 * t1 - 16.8439_r8 * t2 + ks = exp( lnks ) + + converged(i,k) = .false. +!---------------------------------------------------------------------- +! Setting up initial guesses for the equations above. Note that +! for the initial choices the mass and the charge must be conserved. +!---------------------------------------------------------------------- + delx(0) = .5_r8 + z = .5_r8 + delz(0) = .5_r8 + fratio(0) = 0._r8 + reduction_factor = .1_r8 + interval_set = .false. +Iter_loop : do iter = 1,itermax +!---------------------------------------------------------------------- +! Cwater is the water equation as described in Tabazadeh et +! al. and Jacobson et al. +!---------------------------------------------------------------------- + cno3new = chno3 * delx(iter-1) + cphno3new = chno3 * (1._r8 - delx(iter-1)) + if( puren > 0._r8 ) then + t1 = (1000._r8*cno3new)/(puren*18._r8) + else + t1 = 0._r8 + end if + h2o_cond(i,k) = t1 + wrk_h2so4 + if( h2o_cond(i,k) > 0._r8 ) then + wrk = 1.e3_r8 / (18._r8 * h2o_cond(i,k)) + molhno3(i,k) = cno3new * wrk + molh2so4(i,k) = ch2so4(i,k) * wrk + else + molhno3(i,k) = 0._r8 + molh2so4(i,k) = 0._r8 + end if + stren = molhno3(i,k) + 3._r8 * molh2so4(i,k) +!---------------------------------------------------------------------- +! (1) Calculate the activity of H2SO4 at a given STREN +!---------------------------------------------------------------------- + sm = stren/3._r8 + acts = d(13) + sm*(d(14) + sm*(d(15) + sm*d(16))) +!---------------------------------------------------------------------- +! (2) Calculate the activity for HNO3 at a given STREN +!---------------------------------------------------------------------- + nm = stren + actn = d(17) + nm*(d(18) + nm*(d(19) + nm*(d(20) + nm*(d(21) + nm*d(22))))) +!---------------------------------------------------------------------- +! (3) Calculate the mixed activity coefficient for HNO3 at STREN +! as described by Tabazadeh et al. +!---------------------------------------------------------------------- + f1 = 2._r8 * (molh2so4(i,k) + molhno3(i,k)) * actn + f2 = 2.25_r8 * molh2so4(i,k) * acts + + if (stren > 0._r8) then + mixyln = (f1 + f2) / (2._r8 * stren) + else + mixyln = 0._r8 + end if + ymix = exp( mixyln ) + hplus = 2._r8 * molh2so4(i,k) + molhno3(i,k) + num = ymix**2 * hplus * molhno3(i,k) + den = 1000._r8 * cphno3new * .0820578_r8 * t * ks + if( chno3 == 0._r8 ) then + converged(i,k) = .true. + exit Iter_loop + end if +!---------------------------------------------------------------------- +! the denominator +! Calculate the ratio F, check convergence +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +! Calculate the ratio F and reset the deltaX (see Jacobson et al.) +!---------------------------------------------------------------------- +!!DEK +! When the numerator is zero, it can drive the denominator +! to 0, which resulted in a NaN for f and also the fraction +! ratio. Assume that in this case, the limit of f would +! really approach 1, not infinity and thus converge the +! solution. + if ((num .eq. 0._r8) .and. (den .eq. 0._r8)) then + f = 1._r8 + else + f = num / den + end if + fratio(iter) = abs( f ) - 1._r8 + con_val = abs( f - 1._r8 ) + if( con_val <= con_lim ) then + converged(i,k) = .true. + exit Iter_loop + end if +!---------------------------------------------------------------------- +! non-convergence; setup next iterate +!---------------------------------------------------------------------- + if( interval_set ) then + z = reduction_factor * z + delz(iter) = z + if( f > 1._r8 ) then + deltax = -z + else + deltax = z + end if + delx(iter) = delx(iter-1) + deltax + else + if( iter == 1 ) then + if( fratio(iter) >= 1._r8 ) then + positive = .false. + else + positive = .true. + end if + end if + if( fratio(iter)*fratio(iter-1) < 0._r8 ) then + interval_set = .true. + reduction_factor = .5_r8 + delx(iter) = .5_r8*(delx(iter-1) + delx(iter-2)) + z = .5_r8*abs( delx(iter-1) - delx(iter-2) ) + else + if( .not. positive ) then + delx(iter) = reduction_factor * delx(iter-1) + else + delx(iter) = reduction_factor + delx(iter-1) + if( delx(iter) > upper_delx ) then + delx(iter) = .5_r8 + interval_set = .true. + reduction_factor = .5_r8 + end if + end if + end if + end if + end do Iter_loop + + wtotal = molhno3(i,k) * 63._r8 + molh2so4(i,k) * 98._r8 + 1000._r8 + wts(i,k) = (molh2so4(i,k) * 9800._r8) / wtotal + wtn(i,k) = (molhno3(i,k) *6300._r8)/ wtotal + if( cno3new /= 0._r8 .or. cphno3new /= 0._r8 ) then + ratio = max( 0._r8,min( 1._r8,cno3new/(cphno3new + cno3new) ) ) + hno3_cond(i,k) = ratio*hno3_avail(i,k) + else + hno3_cond(i,k) = 0._r8 + end if + if( .not. converged(i,k) ) then + write(iulog,*) 'equil: Failed to converge @ is_chem,flag,lchnk,i,k,f = ',is_chem,flag,lchnk,i,k,f + write(iulog,*) ' wts0,pures,puren,chno3,ch2so4 = ',wts0(i,k),pures,puren,chno3,ch2so4(i,k) + write(iulog,*) ' stren,mixyln,ymix,hplus,num,den = ',stren,mixyln,ymix,hplus,num,den + write(iulog,*) ' h2o_avail,hno3_avail,p,t = ',h2o_avail(i,k),hno3_avail(i,k),press(i,k),temper(i,k) + write(iulog,*) ' molhno3,molh2so4,h2o_cond,hno3_cond = ', & + molhno3(i,k),molh2so4(i,k),h2o_cond(i,k),hno3_cond(i,k) + if( con_val > .05_r8 ) then + write(iulog,*) ' ' + write(iulog,*) 'equil; diagnostics at lchnk, flag, i, k, iter = ',lchnk,flag,i,k,iter + write(iulog,*) 'equil; fratio' + write(iulog,'(5(1pg15.7))') fratio(0:iter-1) + write(iulog,*) ' ' + write(iulog,*) 'equil; delx' + write(iulog,'(5(1pg15.7))') delx(0:iter-1) + write(iulog,*) ' ' + write(iulog,*) 'equil; delz' + write(iulog,'(5(1pg15.7))') delz(0:iter-1) + write(iulog,*) ' ' + else if( iter > 50 ) then + write(iulog,*) 'equil: Iterations are beyond 50, number of iter = ',iter + write(iulog,*) 'equil: converged @ is_chem,flag,lchnk,i,k = ' + write(iulog,*) is_chem,flag,lchnk,i,k + write(iulog,*) 'equil: converged @ f, num, den = ' + write(iulog,*) f, num, den + write(iulog,*) ' h2o_avail,hno3_avail,p,t = ' + write(iulog,*) h2o_avail(i,k),hno3_avail(i,k),press(i,k),temper(i,k) + write(iulog,*) ' molhno3(i,k),molh2so4(i,k),h2o_cond,hno3_cond = ' + write(iulog,*) molhno3(i,k),molh2so4(i,k),h2o_cond(i,k),hno3_cond(i,k) + end if + end if + end if + end do Column_loop + end do Level_loop + + end subroutine equil + +!====================================================================== +! +! +! ROUTINE +! DENSITY +! +! Date... +! 7 October 1999 +! +! Programmed by... +! A. Tabazadeh +! +! DESCRIPTION +! Calculates the density (g cm-3) of a binary sulfate solution. +! +! ARGUMENTS +! INPUT +! T Temperature +! w Weight fraction +! +! OUTPUT +! den Density of the Binary Solution (g cm-3) +! +!====================================================================== + + function density( temp, w ) + + implicit none + +!---------------------------------------------------------------------- +! ... Dummy arguments +!---------------------------------------------------------------------- + real(r8), intent(in) :: temp, w + +!---------------------------------------------------------------------- +! ... Function declarations +!---------------------------------------------------------------------- + real(r8) :: density + +!---------------------------------------------------------------------- +! ... Local variables +!---------------------------------------------------------------------- + real(r8), parameter :: a9 = -268.2616e4_r8, a10 = 576.4288e3_r8 + + real(r8) :: a0, a1, a2, a3, a4, a5, a6, a7 ,a8 + real(r8) :: c1, c2, c3, c4 + +!---------------------------------------------------------------------- +! ... Temperature variables +!---------------------------------------------------------------------- + c1 = temp - 273.15_r8 + c2 = c1**2 + c3 = c1*c2 + c4 = c1*c3 +!---------------------------------------------------------------------- +! Polynomial Coefficients +!---------------------------------------------------------------------- + a0 = 999.8426_r8 + 334.5402e-4_r8*c1 - 569.1304e-5_r8*c2 + a1 = 547.2659_r8 - 530.0445e-2_r8*c1 + 118.7671e-4_r8*c2 + 599.0008e-6_r8*c3 + a2 = 526.295e1_r8 + 372.0445e-1_r8*c1 + 120.1909e-3_r8*c2 - 414.8594e-5_r8*c3 + 119.7973e-7_r8*c4 + a3 = -621.3958e2_r8 - 287.7670_r8*c1 - 406.4638e-3_r8*c2 + 111.9488e-4_r8*c3 + 360.7768e-7_r8*c4 + a4 = 409.0293e3_r8 + 127.0854e1_r8*c1 + 326.9710e-3_r8*c2 - 137.7435e-4_r8*c3 - 263.3585e-7_r8*c4 + a5 = -159.6989e4_r8 - 306.2836e1_r8*c1 + 136.6499e-3_r8*c2 + 637.3031e-5_r8*c3 + a6 = 385.7411e4_r8 + 408.3717e1_r8*c1 - 192.7785e-3_r8*c2 + a7 = -580.8064e4_r8 - 284.4401e1_r8*c1 + a8 = 530.1976e4_r8 + 809.1053_r8*c1 +!---------------------------------------------------------------------- +! ... Summation +!---------------------------------------------------------------------- + density = .001_r8*(a0 + w*(a1 + w*(a2 + w*(a3 + w*(a4 + w*(a5 + w*(a6 + w*(a7 + w*(a8 + w*(a9 + w*a10)))))))))) + + end function density + + end module mo_sad diff --git a/src/chemistry/mozart/mo_schu.F90 b/src/chemistry/mozart/mo_schu.F90 new file mode 100644 index 0000000000..a10699a16c --- /dev/null +++ b/src/chemistry/mozart/mo_schu.F90 @@ -0,0 +1,289 @@ + + module mo_schu + +!!$ use ppgrid, only : pverp +!!$ use mo_grid, only : plevp + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + integer, parameter :: ngast = 17 + integer, parameter :: tdim = 501 + real(r8), parameter :: t_del = 5._r8/(tdim-1) + real(r8), parameter :: t_fac = (tdim-1)/5._r8 + + integer :: ii, jj + real(r8) :: d_table(0:tdim,ngast-1) + real(r8) :: x_table(0:tdim,ngast-1) + real(r8) :: o2_table(tdim) + real(r8), dimension(12,ngast-1) :: a, b + +!----------------------------------------------------------------------------- +! a(16,12) coefficients for rj(m) (table 1 in kockarts 1994) +! b(16,12) rj(o2)(table 2 in kockarts 1994) +! rjm attenuation coefficients rj(m) +! rjo2 rj(o2) +!----------------------------------------------------------------------------- + data ((a(jj,ii),jj=1,12),ii=1,ngast-1) / & +!a 57000-56500.5 cm-1 + 1.13402e-01_r8,1.00088e-20_r8,3.48747e-01_r8,2.76282e-20_r8,3.47322e-01_r8,1.01267e-19_r8, & + 1.67351e-01_r8,5.63588e-19_r8,2.31433e-02_r8,1.68267e-18_r8,0.00000e+00_r8,0.00000e+00_r8, & +!a 56500-56000.5 cm-1 + 2.55268e-03_r8,1.64489e-21_r8,1.85483e-01_r8,2.03591e-21_r8,2.60603e-01_r8,4.62276e-21_r8, & + 2.50337e-01_r8,1.45106e-20_r8,1.92340e-01_r8,7.57381e-20_r8,1.06363e-01_r8,7.89634e-19_r8, & +!a 56000-55500.5 cm-1 + 4.21594e-03_r8,8.46639e-22_r8,8.91886e-02_r8,1.12935e-21_r8,2.21334e-01_r8,1.67868e-21_r8, & + 2.84446e-01_r8,3.94782e-21_r8,2.33442e-01_r8,1.91554e-20_r8,1.63433e-01_r8,2.25346e-19_r8, & +!a 55500-55000.5 cm-1 + 3.93529e-03_r8,6.79660e-22_r8,4.46906e-02_r8,9.00358e-22_r8,1.33060e-01_r8,1.55952e-21_r8, & + 3.25506e-01_r8,3.43763e-21_r8,2.79405e-01_r8,1.62086e-20_r8,2.10316e-01_r8,1.53883e-19_r8, & +!a 55000-54500.5 cm-1 + 2.60939e-03_r8,2.33791e-22_r8,2.08101e-02_r8,3.21734e-22_r8,1.67186e-01_r8,5.77191e-22_r8, & + 2.80694e-01_r8,1.33362e-21_r8,3.26867e-01_r8,6.10533e-21_r8,1.96539e-01_r8,7.83142e-20_r8, & +!a 54500-54000.5 cm-1 + 9.33711e-03_r8,1.32897e-22_r8,3.63980e-02_r8,1.78786e-22_r8,1.46182e-01_r8,3.38285e-22_r8, & + 3.81762e-01_r8,8.93773e-22_r8,2.58549e-01_r8,4.28115e-21_r8,1.64773e-01_r8,4.67537e-20_r8, & +!a 54000-53500.5 cm-1 + 9.51799e-03_r8,1.00252e-22_r8,3.26320e-02_r8,1.33766e-22_r8,1.45962e-01_r8,2.64831e-22_r8, & + 4.49823e-01_r8,6.42879e-22_r8,2.14207e-01_r8,3.19594e-21_r8,1.45616e-01_r8,2.77182e-20_r8, & +!a 53500-53000.5 cm-1 + 7.87331e-03_r8,3.38291e-23_r8,6.91451e-02_r8,4.77708e-23_r8,1.29786e-01_r8,8.30805e-23_r8, & + 3.05103e-01_r8,2.36167e-22_r8,3.35007e-01_r8,8.59109e-22_r8,1.49766e-01_r8,9.63516e-21_r8, & +!a 53000-52500.5 cm-1 + 6.92175e-02_r8,1.56323e-23_r8,1.44403e-01_r8,3.03795e-23_r8,2.94489e-01_r8,1.13219e-22_r8, & + 3.34773e-01_r8,3.48121e-22_r8,9.73632e-02_r8,2.10693e-21_r8,5.94308e-02_r8,1.26195e-20_r8, & +!a 52500-52000.5 cm-1 + 1.47873e-01_r8,8.62033e-24_r8,3.15881e-01_r8,3.51859e-23_r8,4.08077e-01_r8,1.90524e-22_r8, & + 8.08029e-02_r8,9.93062e-22_r8,3.90399e-02_r8,6.38738e-21_r8,8.13330e-03_r8,9.93644e-22_r8, & +!a 52000-51500.5 cm-1 + 1.50269e-01_r8,1.02621e-23_r8,2.39823e-01_r8,3.48120e-23_r8,3.56408e-01_r8,1.69494e-22_r8, & + 1.61277e-01_r8,6.59294e-22_r8,8.89713e-02_r8,2.94571e-21_r8,3.25063e-03_r8,1.25548e-20_r8, & +!a 51500-51000.5 cm-1 + 2.55746e-01_r8,8.49877e-24_r8,2.94733e-01_r8,2.06878e-23_r8,2.86382e-01_r8,9.30992e-23_r8, & + 1.21011e-01_r8,3.66239e-22_r8,4.21105e-02_r8,1.75700e-21_r8,0.00000e+00_r8,0.00000e+00_r8, & +!a 51000-50500.5 cm-1 + 5.40111e-01_r8,7.36085e-24_r8,2.93263e-01_r8,2.46742e-23_r8,1.63417e-01_r8,1.37832e-22_r8, & + 3.23781e-03_r8,2.15052e-21_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8, & +!a 50500-50000.5 cm-1 + 8.18514e-01_r8,7.17937e-24_r8,1.82262e-01_r8,4.17496e-23_r8,0.00000e+00_r8,0.00000e+00_r8, & + 0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8, & +!a 50000-49500.5 cm-1 + 8.73680e-01_r8,7.13444e-24_r8,1.25583e-01_r8,2.77819e-23_r8,0.00000e+00_r8,0.00000e+00_r8, & + 0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8, & +!a 49500-49000.5 cm-1 + 3.32476e-04_r8,7.00362e-24_r8,9.89000e-01_r8,6.99600e-24_r8,0.00000e+00_r8,0.00000e+00_r8, & + 0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8 / + + + data ((b(jj,ii),jj=1,12),ii=1,ngast-1) / & +! 57000-56500.5 cm-1 + 1.07382e-21_r8,9.95029e-21_r8,7.19430e-21_r8,2.48960e-20_r8,2.53735e-20_r8,7.54467e-20_r8, & + 4.48987e-20_r8,2.79981e-19_r8,9.72535e-20_r8,9.29745e-19_r8,2.30892e-20_r8,4.08009e-17_r8, & +! 56500-56000.5 cm-1 + 3.16903e-22_r8,1.98251e-21_r8,5.87326e-22_r8,3.44057e-21_r8,2.53094e-21_r8,8.81484e-21_r8, & + 8.82299e-21_r8,4.17179e-20_r8,2.64703e-20_r8,2.43792e-19_r8,8.73831e-20_r8,1.46371e-18_r8, & +! 56000-55500.5 cm-1 + 1.64421e-23_r8,9.26011e-22_r8,2.73137e-22_r8,1.33640e-21_r8,9.79188e-22_r8,2.99706e-21_r8, & + 3.37768e-21_r8,1.39438e-20_r8,1.47898e-20_r8,1.04322e-19_r8,4.08014e-20_r8,6.31023e-19_r8, & +! 55500-55000.5 cm-1 + 8.68729e-24_r8,7.31056e-22_r8,8.78313e-23_r8,1.07173e-21_r8,8.28170e-22_r8,2.54986e-21_r8, & + 2.57643e-21_r8,9.42698e-21_r8,9.92377e-21_r8,5.21402e-20_r8,3.34301e-20_r8,2.91785e-19_r8, & +! 55000-54500.5 cm-1 + 1.20679e-24_r8,2.44092e-22_r8,2.64326e-23_r8,4.03998e-22_r8,2.53514e-22_r8,8.53166e-22_r8, & + 1.29834e-21_r8,3.74482e-21_r8,5.12103e-21_r8,2.65798e-20_r8,2.10948e-20_r8,2.35315e-19_r8, & +! 54500-54000.5 cm-1 + 2.79656e-24_r8,1.40820e-22_r8,3.60824e-23_r8,2.69510e-22_r8,4.02850e-22_r8,8.83735e-22_r8, & + 1.77198e-21_r8,6.60221e-21_r8,9.60992e-21_r8,8.13558e-20_r8,4.95591e-21_r8,1.22858e-17_r8, & +! 54000-53500.5 cm-1 + 2.36959e-24_r8,1.07535e-22_r8,2.83333e-23_r8,2.16789e-22_r8,3.35242e-22_r8,6.42753e-22_r8, & + 1.26395e-21_r8,5.43183e-21_r8,4.88083e-21_r8,5.42670e-20_r8,3.27481e-21_r8,1.58264e-17_r8, & +! 53500-53000.5 cm-1 + 8.65018e-25_r8,3.70310e-23_r8,1.04351e-23_r8,6.43574e-23_r8,1.17431e-22_r8,2.70904e-22_r8, & + 4.88705e-22_r8,1.65505e-21_r8,2.19776e-21_r8,2.71172e-20_r8,2.65257e-21_r8,2.13945e-17_r8, & +! 53000-52500.5 cm-1 + 9.63263e-25_r8,1.54249e-23_r8,4.78065e-24_r8,2.97642e-23_r8,6.40637e-23_r8,1.46464e-22_r8, & + 1.82634e-22_r8,7.12786e-22_r8,1.64805e-21_r8,2.37376e-17_r8,9.33059e-22_r8,1.13741e-20_r8, & +! 52500-52000.5 cm-1 + 1.08414e-24_r8,8.37560e-24_r8,9.15550e-24_r8,2.99295e-23_r8,9.38405e-23_r8,1.95845e-22_r8, & + 2.84356e-22_r8,3.39699e-21_r8,1.94524e-22_r8,2.72227e-19_r8,1.18924e-21_r8,3.20246e-17_r8, & +! 52000-51500.5 cm-1 + 1.52817e-24_r8,1.01885e-23_r8,1.22946e-23_r8,4.16517e-23_r8,9.01287e-23_r8,2.34869e-22_r8, & + 1.93510e-22_r8,1.44956e-21_r8,1.81051e-22_r8,5.17773e-21_r8,9.82059e-22_r8,6.22768e-17_r8, & +! 51500-51000.5 cm-1 + 2.12813e-24_r8,8.48035e-24_r8,5.23338e-24_r8,1.93052e-23_r8,1.99464e-23_r8,7.48997e-23_r8, & + 4.96642e-22_r8,6.15691e-17_r8,4.47504e-23_r8,2.76004e-22_r8,8.26788e-23_r8,1.65278e-21_r8, & +! 51000-50500.5 cm-1 + 3.81336e-24_r8,7.32307e-24_r8,5.60549e-24_r8,2.04651e-23_r8,3.36883e-22_r8,6.15708e-17_r8, & + 2.09877e-23_r8,1.07474e-22_r8,9.13562e-24_r8,8.41252e-22_r8,0.00000e+00_r8,0.00000e+00_r8, & +! 50500-50000.5 cm-1 + 5.75373e-24_r8,7.15986e-24_r8,5.90031e-24_r8,3.05375e-23_r8,2.97196e-22_r8,8.92000e-17_r8, & + 8.55920e-24_r8,1.66709e-17_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8, & +! 50000-49500.5 cm-1 + 6.21281e-24_r8,7.13108e-24_r8,3.30780e-24_r8,2.61196e-23_r8,1.30783e-22_r8,9.42550e-17_r8, & + 2.69241e-24_r8,1.46500e-17_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8, & +! 49500-49000.5 cm-1 + 6.81118e-24_r8,6.98767e-24_r8,7.55667e-25_r8,2.75124e-23_r8,1.94044e-22_r8,1.45019e-16_r8, & + 1.92236e-24_r8,3.73223e-17_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8,0.00000e+00_r8 / + + contains + + subroutine schu_inti +!----------------------------------------------------------------------------- +! ... initialize the tables +!----------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, iw, k, j1, jp1, j + real(r8) :: col + real(r8), dimension(6) :: a0, a1, b0, b1 + + do iw = 1,ngast-1 + x_table(0,iw) = sum( a(1:11:2,iw) ) + d_table(0,iw) = sum( b(1:11:2,iw) ) + do k = 1,tdim + col = 22._r8 + t_del*real(k-1) + o2_table(k) = col + col = 10._r8**col + a1(:) = a(2:12:2,iw)*col + b1(:) = b(2:12:2,iw)*col + where( a1(:) < 500._r8 ) + a0(:) = exp( -a1(:) ) + elsewhere + a0(:) = 0._r8 + endwhere + where( b1(:) < 500._r8 ) + b0(:) = exp( -b1(:) ) + elsewhere + b0(:) = 0._r8 + endwhere + x_table(k,iw) = dot_product( a(1:11:2,iw),a0(:) ) + d_table(k,iw) = dot_product( b(1:11:2,iw),b0(:) ) + end do + end do + + end subroutine schu_inti + + subroutine schu( o2col, secchi, dto2, xscho2 ) +!----------------------------------------------------------------------------- +! purpose: +! calculate the equivalent absorption cross section of o2 in the sr bands. +! the algorithm is based on: g.kockarts, penetration of solar radiation +! in the schumann-runge bands of molecular oxygen: a robust approximation, +! annales geophysicae, v12, n12, pp. 1207ff, dec 1994. calculation is +! done on the wavelength grid used by kockarts (1994). final values do +! include effects from the herzberg continuum. +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! o2col - real, slant overhead o2 column (molec/cc) at each specified (i) +! altitude +! dto2 - real, optical depth due to o2 absorption at each specified (o) +! vertical layer at each specified wavelength +! xscho2 - real, molecular absorption cross section in sr bands at (o) +! each specified wavelength. includes herzberg continuum +!----------------------------------------------------------------------------- + +!!$ use mo_grid, only : plev, plevp + use ppgrid, only : pver,pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(inout) :: dto2(pver,ngast-1) + real(r8), intent(inout) :: xscho2(pverp,ngast-1) + real(r8), intent(in) :: o2col(pverp) + real(r8), intent(in) :: secchi(pverp) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, iw, j, j1, jp1, k, ki, kp1 + integer :: index(pverp) + integer :: minind(1), maxind(1) + real(r8) :: a0, a1, b0, b1 + real(r8), dimension(6) :: ac, bc + real(r8), dimension(pverp,6) :: aa, bb + real(r8), dimension(pverp) :: rjm, rjo2 + real(r8), dimension(pverp) :: rjmi, rjo2i, lo2col, dels + + +!----------------------------------------------------------------------------- +! ... initialize r(m) +!----------------------------------------------------------------------------- + rjm(1:pverp) = 0._r8 + rjo2(1:pverp) = 0._r8 + +!----------------------------------------------------------------------------- +! ... initialize the table interpolation +!----------------------------------------------------------------------------- + where( o2col(:) /= 0 ) + lo2col(:) = log10( o2col(:) ) + endwhere + do ki = 1,pverp + if( o2col(ki) /= 0._r8 ) then + if( lo2col(ki) <= o2_table(1) ) then + dels(ki) = 0._r8 + index(ki) = 1 + else if( lo2col(ki) >= o2_table(tdim) ) then + dels(ki) = 1._r8 + index(ki) = tdim-1 + else + do k = 2,tdim + if( lo2col(ki) <= o2_table(k) ) then + dels(ki) = t_fac*(lo2col(ki) - o2_table(k-1)) + index(ki) = k-1 + exit + end if + end do + end if + else + index(ki) = 0 + dels(ki) = 0._r8 + end if + end do + +!----------------------------------------------------------------------------- +! ... calculate sum of exponentials (eqs 7 and 8 of kockarts 1994) +!----------------------------------------------------------------------------- + do iw = 1,ngast-1 + do k = 1,pverp + ki = index(k) + rjm(k) = x_table(ki,iw) + dels(k)*(x_table(ki+1,iw) - x_table(ki,iw)) + rjo2(k) = d_table(ki,iw) + dels(k)*(d_table(ki+1,iw) - d_table(ki,iw)) + end do + + do k = 1,pver + if( rjm(k) > 1.e-100_r8 ) then + kp1 = k + 1 + if( rjm(kp1) > 0._r8 ) then + dto2(k,iw) = log( rjm(kp1) ) / secchi(kp1) - log( rjm(k) ) * secchi(k) + else + dto2(k,iw) = 1000._r8 + end if + else + dto2(k,iw) = 1000._r8 + end if + end do + do k = 1,pverp + if( rjm(k) > 1.e-100_r8 ) then + if( rjo2(k) > 1.e-100_r8 ) then + xscho2(k,iw) = rjo2(k)/rjm(k) + else + xscho2(k,iw) = 0._r8 + end if + else + xscho2(k,iw) = 0._r8 + end if + end do + end do + + end subroutine schu + + end module mo_schu diff --git a/src/chemistry/mozart/mo_setaer.F90 b/src/chemistry/mozart/mo_setaer.F90 new file mode 100644 index 0000000000..34442f5ae5 --- /dev/null +++ b/src/chemistry/mozart/mo_setaer.F90 @@ -0,0 +1,1191 @@ + + module mo_setaer + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: setaer + + save + + real(r8), parameter :: qext_so4(8,17) = reshape( (/ & ! m^2/gram (NH4)_2(SO4) + 7.15_r8, 10.29_r8, 12.86_r8, 15.45_r8, 21.52_r8, 30.97_r8, 50.30_r8, 72.31_r8, & + 7.15_r8, 10.30_r8, 12.87_r8, 15.48_r8, 21.58_r8, 31.07_r8, 50.43_r8, 72.49_r8, & + 7.14_r8, 10.29_r8, 12.88_r8, 15.51_r8, 21.68_r8, 31.23_r8, 50.67_r8, 72.78_r8, & + 7.12_r8, 10.28_r8, 12.89_r8, 15.55_r8, 21.78_r8, 31.41_r8, 50.94_r8, 73.10_r8, & + 7.09_r8, 10.26_r8, 12.89_r8, 15.57_r8, 21.88_r8, 31.61_r8, 51.27_r8, 73.48_r8, & + 7.06_r8, 10.22_r8, 12.87_r8, 15.59_r8, 21.98_r8, 31.81_r8, 51.64_r8, 73.95_r8, & + 7.01_r8, 10.43_r8, 12.96_r8, 15.24_r8, 22.10_r8, 32.23_r8, 52.39_r8, 74.86_r8, & + 6.96_r8, 10.35_r8, 12.93_r8, 15.20_r8, 22.12_r8, 32.39_r8, 52.72_r8, 75.39_r8, & + 6.89_r8, 10.26_r8, 12.87_r8, 15.16_r8, 22.11_r8, 32.49_r8, 53.05_r8, 75.85_r8, & + 6.54_r8, 9.80_r8, 12.36_r8, 14.68_r8, 21.88_r8, 32.74_r8, 54.25_r8, 77.77_r8, & + 6.21_r8, 9.34_r8, 11.86_r8, 14.14_r8, 21.41_r8, 32.55_r8, 55.02_r8, 79.20_r8, & + 6.07_r8, 9.14_r8, 11.62_r8, 13.88_r8, 21.17_r8, 32.33_r8, 55.08_r8, 79.56_r8, & + 5.90_r8, 8.90_r8, 11.32_r8, 13.57_r8, 20.80_r8, 32.03_r8, 55.17_r8, 80.02_r8, & + 5.31_r8, 8.04_r8, 10.31_r8, 12.42_r8, 19.45_r8, 30.76_r8, 54.62_r8, 80.61_r8, & + 4.56_r8, 6.97_r8, 9.00_r8, 10.92_r8, 17.55_r8, 28.69_r8, 53.02_r8, 80.43_r8, & + 3.23_r8, 5.02_r8, 6.59_r8, 8.09_r8, 13.57_r8, 23.64_r8, 47.11_r8, 75.36_r8, & + 2.37_r8, 3.73_r8, 4.95_r8, 6.14_r8, 10.65_r8, 19.54_r8, 41.41_r8, 69.26_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dso4(7,17) = qext_so4(2:8,:) - qext_so4(1:7,:) + + real(r8), parameter :: ssa_so4(8,17) = reshape( (/ & + 1.00000_r8,0.99907_r8,0.99855_r8,0.99810_r8,0.99724_r8,0.99623_r8,0.99469_r8,0.99340_r8, & + 1.00000_r8,0.99976_r8,0.99962_r8,0.99950_r8,0.99928_r8,0.99900_r8,0.99857_r8,0.99820_r8, & + 1.00000_r8,0.99996_r8,0.99994_r8,0.99992_r8,0.99989_r8,0.99984_r8,0.99978_r8,0.99971_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99998_r8,0.99998_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.99999_r8,0.99999_r8,0.99999_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dso4(7,17) = ssa_so4(2:8,:) - ssa_so4(1:7,:) + + real(r8), parameter :: asm_so4(8,17) = reshape( (/ & + 0.67_r8, 0.68_r8, 0.68_r8, 0.68_r8, 0.69_r8, 0.70_r8, 0.71_r8, 0.73_r8, & + 0.67_r8, 0.68_r8, 0.68_r8, 0.68_r8, 0.69_r8, 0.70_r8, 0.72_r8, 0.73_r8, & + 0.67_r8, 0.68_r8, 0.69_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.72_r8, 0.73_r8, & + 0.67_r8, 0.69_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.74_r8, & + 0.67_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.69_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.72_r8, 0.72_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.73_r8, 0.74_r8, 0.75_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.74_r8, 0.74_r8, 0.75_r8, & + 0.67_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.75_r8, 0.75_r8, 0.76_r8, 0.76_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.77_r8, 0.77_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.77_r8, 0.77_r8, 0.77_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.77_r8, 0.77_r8, 0.77_r8, & + 0.66_r8, 0.71_r8, 0.73_r8, 0.75_r8, 0.77_r8, 0.77_r8, 0.78_r8, 0.78_r8, & + 0.66_r8, 0.71_r8, 0.73_r8, 0.75_r8, 0.77_r8, 0.78_r8, 0.79_r8, 0.79_r8, & + 0.64_r8, 0.69_r8, 0.72_r8, 0.73_r8, 0.76_r8, 0.78_r8, 0.79_r8, 0.80_r8, & + 0.62_r8, 0.67_r8, 0.70_r8, 0.72_r8, 0.75_r8, 0.77_r8, 0.79_r8, 0.80_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dso4(7,17) = asm_so4(2:8,:) - asm_so4(1:7,:) + + real(r8), parameter :: qext_ant(8,17) = reshape( (/ & ! m^2/gram (NH4)NO3 + 7.27_r8, 10.47_r8, 13.08_r8, 15.72_r8, 21.90_r8, 31.51_r8, 51.17_r8, 73.57_r8, & + 7.27_r8, 10.48_r8, 13.09_r8, 15.74_r8, 21.96_r8, 31.60_r8, 51.30_r8, 73.75_r8, & + 7.26_r8, 10.47_r8, 13.10_r8, 15.78_r8, 22.05_r8, 31.77_r8, 51.55_r8, 74.04_r8, & + 7.24_r8, 10.46_r8, 13.11_r8, 15.82_r8, 22.16_r8, 31.96_r8, 51.83_r8, 74.37_r8, & + 7.22_r8, 10.43_r8, 13.11_r8, 15.84_r8, 22.26_r8, 32.15_r8, 52.16_r8, 74.76_r8, & + 7.18_r8, 10.40_r8, 13.10_r8, 15.86_r8, 22.36_r8, 32.37_r8, 52.53_r8, 75.24_r8, & + 7.14_r8, 10.35_r8, 13.06_r8, 15.86_r8, 22.44_r8, 32.58_r8, 52.94_r8, 75.75_r8, & + 7.08_r8, 10.53_r8, 13.15_r8, 15.47_r8, 22.50_r8, 32.95_r8, 53.64_r8, 76.69_r8, & + 7.01_r8, 10.44_r8, 13.09_r8, 15.42_r8, 22.49_r8, 33.05_r8, 53.97_r8, 77.17_r8, & + 6.65_r8, 9.96_r8, 12.57_r8, 14.93_r8, 22.26_r8, 33.31_r8, 55.19_r8, 79.12_r8, & + 6.32_r8, 9.50_r8, 12.06_r8, 14.38_r8, 21.78_r8, 33.11_r8, 55.97_r8, 80.57_r8, & + 6.17_r8, 9.30_r8, 11.82_r8, 14.12_r8, 21.53_r8, 32.89_r8, 56.04_r8, 80.94_r8, & + 6.00_r8, 9.05_r8, 11.52_r8, 13.80_r8, 21.16_r8, 32.59_r8, 56.13_r8, 81.41_r8, & + 5.40_r8, 8.18_r8, 10.49_r8, 12.63_r8, 19.79_r8, 31.29_r8, 55.57_r8, 82.01_r8, & + 4.64_r8, 7.09_r8, 9.16_r8, 11.11_r8, 17.86_r8, 29.19_r8, 53.94_r8, 81.83_r8, & + 3.28_r8, 5.11_r8, 6.70_r8, 8.23_r8, 13.80_r8, 24.05_r8, 47.93_r8, 76.67_r8, & + 2.41_r8, 3.79_r8, 5.04_r8, 6.24_r8, 10.83_r8, 19.88_r8, 42.13_r8, 70.46_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dant(7,17) = qext_ant(2:8,:) - qext_ant(1:7,:) + + real(r8), parameter :: ssa_ant(8,17) = reshape( (/ & + 1.00000_r8,0.99907_r8,0.99855_r8,0.99810_r8,0.99724_r8,0.99623_r8,0.99469_r8,0.99340_r8, & + 1.00000_r8,0.99976_r8,0.99962_r8,0.99950_r8,0.99928_r8,0.99900_r8,0.99857_r8,0.99820_r8, & + 1.00000_r8,0.99996_r8,0.99994_r8,0.99992_r8,0.99989_r8,0.99984_r8,0.99978_r8,0.99971_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99998_r8,0.99998_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.99999_r8,0.99999_r8,0.99999_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dant(7,17) = ssa_ant(2:8,:) - ssa_ant(1:7,:) + + real(r8), parameter :: asm_ant(8,17) = reshape( (/ & + 0.67_r8, 0.68_r8, 0.68_r8, 0.68_r8, 0.69_r8, 0.70_r8, 0.71_r8, 0.73_r8, & + 0.67_r8, 0.68_r8, 0.68_r8, 0.68_r8, 0.69_r8, 0.70_r8, 0.72_r8, 0.73_r8, & + 0.67_r8, 0.68_r8, 0.69_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.72_r8, 0.73_r8, & + 0.67_r8, 0.69_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.74_r8, & + 0.67_r8, 0.69_r8, 0.70_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.69_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.72_r8, 0.72_r8, 0.73_r8, 0.74_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.73_r8, 0.74_r8, 0.75_r8, & + 0.67_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.74_r8, 0.74_r8, 0.75_r8, & + 0.67_r8, 0.71_r8, 0.72_r8, 0.73_r8, 0.75_r8, 0.75_r8, 0.76_r8, 0.76_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.77_r8, 0.77_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.77_r8, 0.77_r8, 0.77_r8, & + 0.67_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.77_r8, 0.77_r8, 0.77_r8, & + 0.66_r8, 0.71_r8, 0.73_r8, 0.75_r8, 0.77_r8, 0.77_r8, 0.78_r8, 0.78_r8, & + 0.66_r8, 0.71_r8, 0.73_r8, 0.75_r8, 0.77_r8, 0.78_r8, 0.79_r8, 0.79_r8, & + 0.64_r8, 0.69_r8, 0.72_r8, 0.73_r8, 0.76_r8, 0.78_r8, 0.79_r8, 0.80_r8, & + 0.62_r8, 0.67_r8, 0.70_r8, 0.72_r8, 0.75_r8, 0.77_r8, 0.79_r8, 0.80_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dant(7,17) = asm_ant(2:8,:) - asm_ant(1:7,:) + +!-------------------------------------------------------------------- +! dust: bin 1 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_ds1(17) = & + (/ 1.99_r8, 1.99_r8, 1.99_r8, 1.99_r8, 2.00_r8, 2.00_r8, 2.00_r8, 2.01_r8, & + 2.03_r8, 2.13_r8, 2.20_r8, 2.20_r8, 2.20_r8, 2.23_r8, 2.45_r8, 2.82_r8, 2.77_r8 /) + + real(r8), parameter :: ssa_ds1(17) = & + (/ 0.71575_r8, 0.71916_r8, 0.72437_r8, 0.73098_r8, 0.73895_r8, 0.74845_r8, 0.75953_r8, & + 0.77247_r8, 0.78667_r8, 0.84334_r8, 0.88486_r8, 0.89887_r8, 0.91254_r8, 0.94728_r8, & + 0.97546_r8, 0.99257_r8, 0.99627_r8 /) + + real(r8), parameter :: asm_ds1(17) = & + (/ 0.81_r8, 0.80_r8, 0.80_r8, 0.79_r8, 0.78_r8, 0.78_r8, 0.77_r8, 0.76_r8, 0.75_r8, 0.71_r8,& + 0.68_r8, 0.67_r8, 0.65_r8, 0.62_r8, 0.62_r8, 0.68_r8, 0.69_r8 /) +!-------------------------------------------------------------------- +! dust: bin 2 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_ds2(17) = & + (/ 0.77_r8, 0.77_r8, 0.77_r8, 0.77_r8, 0.78_r8, 0.78_r8, 0.78_r8, 0.79_r8, 0.79_r8, 0.79_r8, & + 0.79_r8, 0.80_r8, 0.81_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.92_r8 /) + + real(r8), parameter :: ssa_ds2(17) = & + (/0.59522_r8, 0.59816_r8, 0.60304_r8, 0.60951_r8, 0.61766_r8, 0.62757_r8, 0.63939_r8,& + 0.65308_r8, 0.66760_r8, 0.72707_r8, 0.78134_r8, 0.80412_r8, 0.82832_r8, 0.88852_r8,& + 0.93596_r8, 0.97452_r8, 0.98760_r8 /) + + real(r8), parameter :: asm_ds2(17) = & + (/0.91_r8, 0.90_r8, 0.90_r8, 0.90_r8, 0.89_r8, 0.89_r8, 0.88_r8, 0.87_r8, 0.87_r8, 0.83_r8, & + 0.80_r8, 0.80_r8, 0.79_r8, 0.76_r8, 0.72_r8, 0.64_r8, 0.62_r8 /) +!-------------------------------------------------------------------- +! dust: bin 3 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_ds3(17) = & + (/0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.36_r8, 0.37_r8, & + 0.37_r8, 0.37_r8, 0.37_r8, 0.37_r8, 0.38_r8, 0.38_r8 /) + + real(r8), parameter :: ssa_ds3(17) = & + (/0.54872_r8, 0.54937_r8, 0.55055_r8, 0.55244_r8, 0.55533_r8, 0.55919_r8, 0.56387_r8, 0.56968_r8, & + 0.57716_r8, 0.62358_r8, 0.67763_r8, 0.70405_r8, 0.73102_r8, 0.81296_r8, 0.88850_r8, 0.95481_r8, & + 0.97307_r8/) + + real(r8), parameter :: asm_ds3(17) = & + (/ 0.94_r8, 0.94_r8, 0.94_r8, 0.94_r8, 0.94_r8, 0.94_r8, 0.93_r8, 0.93_r8, 0.92_r8, 0.90_r8, 0.88_r8, & + 0.87_r8, 0.85_r8, 0.82_r8, 0.78_r8, 0.75_r8, 0.73_r8 /) + +!-------------------------------------------------------------------- +! dust: bin 4 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_ds4(17) = & + (/0.18_r8, 0.18_r8, 0.18_r8, 0.18_r8, 0.18_r8, 0.18_r8, 0.18_r8, 0.19_r8, 0.19_r8, 0.19_r8, 0.19_r8, 0.19_r8, & + 0.19_r8, 0.19_r8, 0.19_r8, 0.19_r8, 0.20_r8 /) + + real(r8), parameter :: ssa_ds4(17) = & + (/0.55982_r8, 0.56067_r8, 0.56205_r8, 0.56381_r8, 0.56604_r8, 0.56911_r8, 0.57321_r8, 0.57809_r8, 0.58376_r8, & + 0.60863_r8, 0.62981_r8, 0.64251_r8, 0.65974_r8, 0.73256_r8, 0.82372_r8, 0.92454_r8, 0.95662_r8 /) + + real(r8), parameter :: asm_ds4(17) = & + (/ 0.94_r8, 0.94_r8, 0.94_r8, 0.94_r8, 0.94_r8, 0.93_r8, 0.93_r8, 0.93_r8, 0.93_r8, 0.91_r8, 0.91_r8, 0.90_r8, & + 0.89_r8, 0.87_r8, 0.83_r8, 0.79_r8, 0.77_r8 /) + +!-------------------------------------------------------------------- +! black carbon +!-------------------------------------------------------------------- + real(r8), parameter :: qext_cbs(8,17) = reshape( (/ & + 26.47_r8, 26.47_r8, 26.47_r8, 68.55_r8, 54.51_r8, 68.55_r8, 93.69_r8, 128.49_r8, & + 26.35_r8, 26.35_r8, 26.35_r8, 67.19_r8, 53.53_r8, 67.19_r8, 91.62_r8, 125.62_r8, & + 26.15_r8, 26.15_r8, 26.15_r8, 65.24_r8, 52.13_r8, 65.24_r8, 88.62_r8, 121.44_r8, & + 25.89_r8, 25.89_r8, 25.89_r8, 63.07_r8, 50.57_r8, 63.07_r8, 85.27_r8, 116.72_r8, & + 25.59_r8, 25.59_r8, 25.59_r8, 60.75_r8, 48.90_r8, 60.75_r8, 81.69_r8, 111.62_r8, & + 25.23_r8, 25.23_r8, 25.23_r8, 58.35_r8, 47.17_r8, 58.35_r8, 77.96_r8, 106.29_r8, & + 24.82_r8, 24.82_r8, 24.82_r8, 55.92_r8, 45.41_r8, 55.92_r8, 74.20_r8, 100.86_r8, & + 24.36_r8, 24.36_r8, 24.36_r8, 53.51_r8, 43.65_r8, 53.51_r8, 70.46_r8, 95.43_r8, & + 23.89_r8, 23.89_r8, 23.89_r8, 51.24_r8, 41.98_r8, 51.24_r8, 66.95_r8, 90.33_r8, & + 21.92_r8, 21.92_r8, 21.92_r8, 43.84_r8, 36.46_r8, 43.84_r8, 55.67_r8, 73.81_r8, & + 20.35_r8, 20.35_r8, 20.35_r8, 39.12_r8, 32.87_r8, 39.12_r8, 48.65_r8, 63.58_r8, & + 19.59_r8, 19.59_r8, 19.59_r8, 37.26_r8, 31.38_r8, 37.26_r8, 46.12_r8, 60.08_r8, & + 18.52_r8, 18.52_r8, 18.52_r8, 34.78_r8, 29.37_r8, 34.78_r8, 42.83_r8, 55.62_r8, & + 15.51_r8, 15.51_r8, 15.51_r8, 28.14_r8, 23.92_r8, 28.14_r8, 34.14_r8, 43.91_r8, & + 12.45_r8, 12.45_r8, 12.45_r8, 21.75_r8, 18.64_r8, 21.75_r8, 25.93_r8, 32.95_r8, & + 8.38_r8, 8.38_r8, 8.38_r8, 13.90_r8, 12.07_r8, 13.90_r8, 16.12_r8, 20.04_r8, & + 6.13_r8, 6.13_r8, 6.13_r8, 9.74_r8, 8.56_r8, 9.74_r8, 11.00_r8, 13.35_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dcbs(7,17) = qext_cbs(2:8,:) - qext_cbs(1:7,:) + + real(r8), parameter :: ssa_cbs(8,17) = reshape( (/ & + 0.30538_r8,0.30538_r8,0.30538_r8,0.58171_r8,0.52858_r8,0.58171_r8,0.66772_r8,0.73300_r8, & + 0.30531_r8,0.30531_r8,0.30531_r8,0.57816_r8,0.52490_r8,0.57816_r8,0.66490_r8,0.73116_r8, & + 0.30524_r8,0.30524_r8,0.30524_r8,0.57281_r8,0.51947_r8,0.57281_r8,0.66041_r8,0.72800_r8, & + 0.30519_r8,0.30519_r8,0.30519_r8,0.56680_r8,0.51346_r8,0.56680_r8,0.65519_r8,0.72418_r8, & + 0.30520_r8,0.30520_r8,0.30520_r8,0.56029_r8,0.50707_r8,0.56029_r8,0.64937_r8,0.71979_r8, & + 0.30530_r8,0.30530_r8,0.30530_r8,0.55345_r8,0.50049_r8,0.55345_r8,0.64304_r8,0.71487_r8, & + 0.30552_r8,0.30552_r8,0.30552_r8,0.54644_r8,0.49387_r8,0.54644_r8,0.63633_r8,0.70948_r8, & + 0.30588_r8,0.30588_r8,0.30588_r8,0.53936_r8,0.48731_r8,0.53936_r8,0.62932_r8,0.70368_r8, & + 0.30637_r8,0.30637_r8,0.30637_r8,0.53261_r8,0.48117_r8,0.53261_r8,0.62241_r8,0.69779_r8, & + 0.30947_r8,0.30947_r8,0.30947_r8,0.50973_r8,0.46122_r8,0.50973_r8,0.59715_r8,0.67476_r8, & + 0.31199_r8,0.31199_r8,0.31199_r8,0.49449_r8,0.44836_r8,0.49449_r8,0.57921_r8,0.65742_r8, & + 0.30839_r8,0.30839_r8,0.30839_r8,0.48822_r8,0.44229_r8,0.48822_r8,0.57287_r8,0.65174_r8, & + 0.30122_r8,0.30122_r8,0.30122_r8,0.47923_r8,0.43325_r8,0.47923_r8,0.56425_r8,0.64429_r8, & + 0.27707_r8,0.27707_r8,0.27707_r8,0.44969_r8,0.40365_r8,0.44969_r8,0.53566_r8,0.61916_r8, & + 0.24673_r8,0.24673_r8,0.24673_r8,0.41274_r8,0.36689_r8,0.41274_r8,0.49934_r8,0.58653_r8, & + 0.19216_r8,0.19216_r8,0.19216_r8,0.34214_r8,0.29839_r8,0.34214_r8,0.42664_r8,0.51768_r8, & + 0.15153_r8,0.15153_r8,0.15153_r8,0.28528_r8,0.24454_r8,0.28528_r8,0.36566_r8,0.45729_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dcbs(7,17) = ssa_cbs(2:8,:) - ssa_cbs(1:7,:) + + real(r8), parameter :: asm_cbs(8,17) = reshape( (/ & + 0.59_r8, 0.59_r8, 0.59_r8, 0.71_r8, 0.70_r8, 0.71_r8, 0.71_r8, 0.72_r8, & + 0.59_r8, 0.59_r8, 0.59_r8, 0.71_r8, 0.70_r8, 0.71_r8, 0.72_r8, 0.72_r8, & + 0.59_r8, 0.59_r8, 0.59_r8, 0.71_r8, 0.69_r8, 0.71_r8, 0.72_r8, 0.72_r8, & + 0.58_r8, 0.58_r8, 0.58_r8, 0.70_r8, 0.69_r8, 0.70_r8, 0.72_r8, 0.72_r8, & + 0.57_r8, 0.57_r8, 0.57_r8, 0.70_r8, 0.69_r8, 0.70_r8, 0.72_r8, 0.72_r8, & + 0.56_r8, 0.56_r8, 0.56_r8, 0.70_r8, 0.68_r8, 0.70_r8, 0.71_r8, 0.72_r8, & + 0.55_r8, 0.55_r8, 0.55_r8, 0.69_r8, 0.68_r8, 0.69_r8, 0.71_r8, 0.72_r8, & + 0.54_r8, 0.54_r8, 0.54_r8, 0.69_r8, 0.67_r8, 0.69_r8, 0.71_r8, 0.72_r8, & + 0.53_r8, 0.53_r8, 0.53_r8, 0.68_r8, 0.66_r8, 0.68_r8, 0.70_r8, 0.72_r8, & + 0.49_r8, 0.49_r8, 0.49_r8, 0.65_r8, 0.63_r8, 0.65_r8, 0.68_r8, 0.70_r8, & + 0.46_r8, 0.46_r8, 0.46_r8, 0.63_r8, 0.60_r8, 0.63_r8, 0.66_r8, 0.68_r8, & + 0.45_r8, 0.45_r8, 0.45_r8, 0.62_r8, 0.59_r8, 0.62_r8, 0.65_r8, 0.68_r8, & + 0.44_r8, 0.44_r8, 0.44_r8, 0.61_r8, 0.58_r8, 0.61_r8, 0.64_r8, 0.67_r8, & + 0.41_r8, 0.41_r8, 0.41_r8, 0.58_r8, 0.55_r8, 0.58_r8, 0.61_r8, 0.64_r8, & + 0.37_r8, 0.37_r8, 0.37_r8, 0.54_r8, 0.51_r8, 0.54_r8, 0.58_r8, 0.61_r8, & + 0.32_r8, 0.32_r8, 0.32_r8, 0.47_r8, 0.45_r8, 0.47_r8, 0.51_r8, 0.55_r8, & + 0.28_r8, 0.28_r8, 0.28_r8, 0.42_r8, 0.40_r8, 0.42_r8, 0.46_r8, 0.50_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dcbs(7,17) = asm_cbs(2:8,:) - asm_cbs(1:7,:) + +!-------------------------------------------------------------------- +! organic carbon +!-------------------------------------------------------------------- + real(r8), parameter :: qext_ocs(8,17) = reshape( (/ & + 5.38_r8, 8.22_r8, 11.03_r8, 13.09_r8, 14.66_r8, 18.31_r8, 25.39_r8, 28.27_r8, & + 5.37_r8, 8.20_r8, 11.00_r8, 13.06_r8, 14.63_r8, 18.29_r8, 25.39_r8, 28.28_r8, & + 5.35_r8, 8.16_r8, 10.95_r8, 13.02_r8, 14.59_r8, 18.26_r8, 25.39_r8, 28.29_r8, & + 5.33_r8, 8.12_r8, 10.90_r8, 12.96_r8, 14.53_r8, 18.21_r8, 25.38_r8, 28.30_r8, & + 5.30_r8, 8.06_r8, 10.83_r8, 12.89_r8, 14.46_r8, 18.15_r8, 25.34_r8, 28.27_r8, & + 5.26_r8, 8.00_r8, 10.74_r8, 12.80_r8, 14.37_r8, 18.07_r8, 25.29_r8, 28.24_r8, & + 5.22_r8, 7.92_r8, 10.65_r8, 12.71_r8, 14.28_r8, 17.98_r8, 25.22_r8, 28.19_r8, & + 5.17_r8, 7.84_r8, 10.54_r8, 12.59_r8, 14.15_r8, 17.85_r8, 25.13_r8, 28.12_r8, & + 5.12_r8, 7.75_r8, 10.42_r8, 12.47_r8, 14.02_r8, 17.71_r8, 25.01_r8, 28.00_r8, & + 4.86_r8, 7.35_r8, 9.90_r8, 11.89_r8, 13.41_r8, 17.05_r8, 24.35_r8, 27.38_r8, & + 4.65_r8, 7.01_r8, 9.46_r8, 11.39_r8, 12.87_r8, 16.45_r8, 23.70_r8, 26.73_r8, & + 4.56_r8, 6.88_r8, 9.29_r8, 11.20_r8, 12.67_r8, 16.21_r8, 23.44_r8, 26.46_r8, & + 4.44_r8, 6.70_r8, 9.06_r8, 10.95_r8, 12.38_r8, 15.89_r8, 23.06_r8, 26.07_r8, & + 4.06_r8, 6.14_r8, 8.32_r8, 10.10_r8, 11.46_r8, 14.81_r8, 21.77_r8, 24.72_r8, & + 3.61_r8, 5.47_r8, 7.44_r8, 9.08_r8, 10.34_r8, 13.47_r8, 20.09_r8, 22.94_r8, & + 2.81_r8, 4.27_r8, 5.86_r8, 7.22_r8, 8.26_r8, 10.91_r8, 16.70_r8, 19.24_r8, & + 2.25_r8, 3.44_r8, 4.74_r8, 5.89_r8, 6.77_r8, 9.04_r8, 14.12_r8, 16.39_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_docs(7,17) = qext_ocs(2:8,:) - qext_ocs(1:7,:) + + real(r8), parameter :: ssa_ocs(8,17) = reshape( (/ & + 0.67508_r8,0.73829_r8,0.78690_r8,0.80446_r8,0.82190_r8,0.84991_r8,0.87960_r8,0.88715_r8, & + 0.67840_r8,0.74179_r8,0.79056_r8,0.80819_r8,0.82564_r8,0.85366_r8,0.88338_r8,0.89096_r8, & + 0.68373_r8,0.74715_r8,0.79586_r8,0.81346_r8,0.83078_r8,0.85852_r8,0.88777_r8,0.89520_r8, & + 0.69072_r8,0.75403_r8,0.80249_r8,0.81995_r8,0.83703_r8,0.86424_r8,0.89272_r8,0.89991_r8, & + 0.69947_r8,0.76249_r8,0.81046_r8,0.82767_r8,0.84441_r8,0.87098_r8,0.89863_r8,0.90556_r8, & + 0.71012_r8,0.77261_r8,0.81984_r8,0.83676_r8,0.85311_r8,0.87886_r8,0.90536_r8,0.91195_r8, & + 0.72284_r8,0.78447_r8,0.83062_r8,0.84703_r8,0.86276_r8,0.88742_r8,0.91264_r8,0.91888_r8, & + 0.73788_r8,0.79817_r8,0.84282_r8,0.85864_r8,0.87367_r8,0.89703_r8,0.92063_r8,0.92642_r8, & + 0.75456_r8,0.81304_r8,0.85573_r8,0.87075_r8,0.88494_r8,0.90689_r8,0.92883_r8,0.93416_r8, & + 0.83969_r8,0.88348_r8,0.91349_r8,0.92370_r8,0.93306_r8,0.94713_r8,0.96070_r8,0.96392_r8, & + 0.92455_r8,0.94805_r8,0.96298_r8,0.96787_r8,0.97222_r8,0.97858_r8,0.98451_r8,0.98588_r8, & + 0.93919_r8,0.95861_r8,0.97073_r8,0.97469_r8,0.97818_r8,0.98326_r8,0.98796_r8,0.98905_r8, & + 0.94732_r8,0.96439_r8,0.97494_r8,0.97838_r8,0.98140_r8,0.98578_r8,0.98983_r8,0.99076_r8, & + 0.96028_r8,0.97347_r8,0.98153_r8,0.98416_r8,0.98643_r8,0.98973_r8,0.99275_r8,0.99344_r8, & + 0.96294_r8,0.97536_r8,0.98295_r8,0.98546_r8,0.98760_r8,0.99068_r8,0.99351_r8,0.99416_r8, & + 0.95723_r8,0.97159_r8,0.98043_r8,0.98344_r8,0.98593_r8,0.98957_r8,0.99290_r8,0.99366_r8, & + 0.94701_r8,0.96465_r8,0.97566_r8,0.97951_r8,0.98263_r8,0.98721_r8,0.99143_r8,0.99239_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_docs(7,17) = ssa_ocs(2:8,:) - ssa_ocs(1:7,:) + + real(r8), parameter :: asm_ocs(8,17) = reshape( (/ & + 0.77_r8, 0.76_r8, 0.75_r8, 0.74_r8, 0.74_r8, 0.73_r8, 0.73_r8, 0.73_r8, & + 0.77_r8, 0.76_r8, 0.75_r8, 0.74_r8, 0.74_r8, 0.74_r8, 0.73_r8, 0.73_r8, & + 0.77_r8, 0.76_r8, 0.75_r8, 0.75_r8, 0.74_r8, 0.74_r8, 0.74_r8, 0.74_r8, & + 0.76_r8, 0.76_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.74_r8, 0.74_r8, 0.74_r8, & + 0.76_r8, 0.76_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, & + 0.75_r8, 0.76_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, & + 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, & + 0.74_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.76_r8, & + 0.74_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.76_r8, 0.76_r8, 0.76_r8, 0.76_r8, & + 0.71_r8, 0.73_r8, 0.75_r8, 0.75_r8, 0.75_r8, 0.76_r8, 0.76_r8, 0.76_r8, & + 0.68_r8, 0.72_r8, 0.74_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.76_r8, 0.77_r8, & + 0.68_r8, 0.72_r8, 0.74_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.76_r8, 0.77_r8, & + 0.68_r8, 0.71_r8, 0.74_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.77_r8, 0.77_r8, & + 0.67_r8, 0.71_r8, 0.74_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.77_r8, 0.77_r8, & + 0.66_r8, 0.71_r8, 0.73_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.77_r8, 0.77_r8, & + 0.65_r8, 0.70_r8, 0.73_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.77_r8, 0.78_r8, & + 0.64_r8, 0.69_r8, 0.72_r8, 0.73_r8, 0.74_r8, 0.76_r8, 0.77_r8, 0.77_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_docs(7,17) = asm_ocs(2:8,:) - asm_ocs(1:7,:) + +!-------------------------------------------------------------------- +! sea-salt bin 1 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_sal01(8,17) = reshape( (/ & + 2.18_r8, 3.87_r8, 5.09_r8, 6.46_r8, 0.00_r8, 15.67_r8, 29.00_r8, 40.81_r8, & + 2.19_r8, 3.89_r8, 5.13_r8, 6.49_r8, 0.00_r8, 15.67_r8, 29.03_r8, 40.76_r8, & + 2.18_r8, 3.83_r8, 5.16_r8, 6.45_r8, 0.00_r8, 15.62_r8, 29.02_r8, 40.81_r8, & + 2.17_r8, 3.82_r8, 5.23_r8, 6.39_r8, 0.00_r8, 15.72_r8, 29.06_r8, 40.86_r8, & + 2.15_r8, 3.85_r8, 5.24_r8, 6.45_r8, 0.00_r8, 15.71_r8, 29.13_r8, 40.89_r8, & + 2.14_r8, 3.93_r8, 5.18_r8, 6.56_r8, 0.00_r8, 15.71_r8, 29.13_r8, 40.90_r8, & + 2.15_r8, 4.01_r8, 5.18_r8, 6.57_r8, 0.00_r8, 15.85_r8, 29.34_r8, 41.03_r8, & + 2.18_r8, 4.02_r8, 5.27_r8, 6.48_r8, 0.00_r8, 15.72_r8, 29.21_r8, 41.15_r8, & + 2.23_r8, 3.96_r8, 5.38_r8, 6.50_r8, 0.00_r8, 15.88_r8, 29.50_r8, 41.17_r8, & + 2.39_r8, 4.09_r8, 5.34_r8, 6.71_r8, 0.00_r8, 16.08_r8, 29.66_r8, 41.58_r8, & + 2.34_r8, 4.34_r8, 5.61_r8, 6.69_r8, 0.00_r8, 16.05_r8, 29.95_r8, 41.93_r8, & + 2.31_r8, 4.35_r8, 5.75_r8, 6.84_r8, 0.00_r8, 16.07_r8, 29.72_r8, 41.59_r8, & + 2.26_r8, 4.28_r8, 5.85_r8, 7.10_r8, 0.00_r8, 16.45_r8, 29.96_r8, 42.10_r8, & + 2.36_r8, 4.10_r8, 5.62_r8, 7.20_r8, 0.00_r8, 16.62_r8, 30.41_r8, 42.58_r8, & + 2.78_r8, 4.50_r8, 5.61_r8, 6.85_r8, 0.00_r8, 17.18_r8, 31.51_r8, 42.82_r8, & + 3.20_r8, 5.65_r8, 7.29_r8, 8.64_r8, 0.00_r8, 17.51_r8, 32.64_r8, 44.52_r8, & + 3.02_r8, 5.74_r8, 7.96_r8, 9.96_r8, 0.00_r8, 18.03_r8, 33.24_r8, 47.22_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dsal01(7,17) = qext_sal01(2:8,:) - qext_sal01(1:7,:) + + real(r8), parameter :: ssa_sal01(8,17) = reshape( (/ & + 0.99971_r8,0.99603_r8,0.99413_r8,0.99292_r8,0.00000_r8,0.98870_r8,0.98441_r8,0.98456_r8, & + 0.99972_r8,0.99886_r8,0.99844_r8,0.99822_r8,0.00000_r8,0.99688_r8,0.99566_r8,0.99559_r8, & + 0.99972_r8,0.99970_r8,0.99965_r8,0.99965_r8,0.00000_r8,0.99948_r8,0.99928_r8,0.99927_r8, & + 0.99974_r8,0.99983_r8,0.99989_r8,0.99990_r8,0.00000_r8,0.99992_r8,0.99993_r8,0.99993_r8, & + 0.99975_r8,0.99987_r8,0.99990_r8,0.99992_r8,0.00000_r8,0.99994_r8,0.99996_r8,0.99996_r8, & + 0.99977_r8,0.99988_r8,0.99991_r8,0.99993_r8,0.00000_r8,0.99997_r8,0.99998_r8,0.99998_r8, & + 0.99979_r8,0.99990_r8,0.99992_r8,0.99993_r8,0.00000_r8,0.99997_r8,0.99998_r8,0.99999_r8, & + 0.99982_r8,0.99991_r8,0.99993_r8,0.99994_r8,0.00000_r8,0.99997_r8,0.99999_r8,0.99999_r8, & + 0.99984_r8,0.99992_r8,0.99994_r8,0.99995_r8,0.00000_r8,0.99998_r8,0.99999_r8,0.99999_r8, & + 0.99992_r8,0.99996_r8,0.99997_r8,0.99998_r8,0.00000_r8,0.99999_r8,0.99999_r8,1.00000_r8, & + 0.99996_r8,0.99998_r8,0.99999_r8,0.99999_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99997_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99998_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,0.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dsal01(7,17) = ssa_sal01(2:8,:) - ssa_sal01(1:7,:) + + real(r8), parameter :: asm_sal01(8,17) = reshape( (/ & + 0.73_r8, 0.75_r8, 0.75_r8, 0.76_r8, 0.00_r8, 0.78_r8, 0.79_r8, 0.80_r8, & + 0.72_r8, 0.74_r8, 0.75_r8, 0.76_r8, 0.00_r8, 0.78_r8, 0.79_r8, 0.80_r8, & + 0.72_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.00_r8, 0.78_r8, 0.79_r8, 0.80_r8, & + 0.72_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.00_r8, 0.79_r8, 0.80_r8, 0.80_r8, & + 0.71_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.00_r8, 0.79_r8, 0.80_r8, 0.81_r8, & + 0.71_r8, 0.75_r8, 0.76_r8, 0.77_r8, 0.00_r8, 0.79_r8, 0.80_r8, 0.81_r8, & + 0.70_r8, 0.75_r8, 0.75_r8, 0.77_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.81_r8, & + 0.70_r8, 0.75_r8, 0.76_r8, 0.76_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.82_r8, & + 0.70_r8, 0.74_r8, 0.76_r8, 0.76_r8, 0.00_r8, 0.80_r8, 0.81_r8, 0.82_r8, & + 0.69_r8, 0.73_r8, 0.75_r8, 0.77_r8, 0.00_r8, 0.80_r8, 0.81_r8, 0.82_r8, & + 0.66_r8, 0.73_r8, 0.75_r8, 0.75_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.82_r8, & + 0.64_r8, 0.72_r8, 0.75_r8, 0.75_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.82_r8, & + 0.62_r8, 0.71_r8, 0.75_r8, 0.76_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.82_r8, & + 0.61_r8, 0.68_r8, 0.71_r8, 0.74_r8, 0.00_r8, 0.79_r8, 0.81_r8, 0.82_r8, & + 0.66_r8, 0.70_r8, 0.70_r8, 0.71_r8, 0.00_r8, 0.78_r8, 0.80_r8, 0.81_r8, & + 0.73_r8, 0.78_r8, 0.78_r8, 0.77_r8, 0.00_r8, 0.75_r8, 0.78_r8, 0.80_r8, & + 0.74_r8, 0.80_r8, 0.82_r8, 0.82_r8, 0.00_r8, 0.75_r8, 0.77_r8, 0.79_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dsal01(7,17) = asm_sal01(2:8,:) - asm_sal01(1:7,:) + +!-------------------------------------------------------------------- +! sea-salt bin 2 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_sal02(8,17) = reshape( (/ & + 0.63_r8, 1.15_r8, 1.56_r8, 1.95_r8, 3.07_r8, 4.83_r8, 8.83_r8, 14.00_r8, & + 0.63_r8, 1.15_r8, 1.56_r8, 1.95_r8, 3.07_r8, 4.82_r8, 8.83_r8, 14.00_r8, & + 0.63_r8, 1.15_r8, 1.56_r8, 1.96_r8, 3.07_r8, 4.83_r8, 8.83_r8, 14.01_r8, & + 0.64_r8, 1.16_r8, 1.56_r8, 1.96_r8, 3.07_r8, 4.83_r8, 8.84_r8, 14.02_r8, & + 0.64_r8, 1.16_r8, 1.56_r8, 1.96_r8, 3.08_r8, 4.84_r8, 8.84_r8, 14.01_r8, & + 0.64_r8, 1.16_r8, 1.57_r8, 1.96_r8, 3.08_r8, 4.84_r8, 8.86_r8, 14.04_r8, & + 0.64_r8, 1.16_r8, 1.57_r8, 1.96_r8, 3.09_r8, 4.85_r8, 8.86_r8, 14.05_r8, & + 0.64_r8, 1.16_r8, 1.57_r8, 1.97_r8, 3.09_r8, 4.85_r8, 8.86_r8, 14.04_r8, & + 0.64_r8, 1.17_r8, 1.57_r8, 1.97_r8, 3.09_r8, 4.86_r8, 8.88_r8, 14.08_r8, & + 0.65_r8, 1.18_r8, 1.59_r8, 1.99_r8, 3.11_r8, 4.88_r8, 8.92_r8, 14.12_r8, & + 0.66_r8, 1.19_r8, 1.59_r8, 2.00_r8, 3.13_r8, 4.91_r8, 8.95_r8, 14.17_r8, & + 0.66_r8, 1.18_r8, 1.60_r8, 2.01_r8, 3.13_r8, 4.91_r8, 8.96_r8, 14.17_r8, & + 0.66_r8, 1.19_r8, 1.61_r8, 2.00_r8, 3.15_r8, 4.92_r8, 8.98_r8, 14.20_r8, & + 0.67_r8, 1.21_r8, 1.62_r8, 2.03_r8, 3.17_r8, 4.96_r8, 9.03_r8, 14.27_r8, & + 0.67_r8, 1.22_r8, 1.65_r8, 2.04_r8, 3.19_r8, 5.00_r8, 9.08_r8, 14.36_r8, & + 0.70_r8, 1.24_r8, 1.67_r8, 2.10_r8, 3.26_r8, 5.10_r8, 9.21_r8, 14.53_r8, & + 0.75_r8, 1.30_r8, 1.67_r8, 2.09_r8, 3.32_r8, 5.21_r8, 9.32_r8, 14.58_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dsal02(7,17) = qext_sal02(2:8,:) - qext_sal02(1:7,:) + + real(r8), parameter :: ssa_sal02(8,17) = reshape( (/ & + 0.99919_r8,0.98950_r8,0.98773_r8,0.98690_r8,0.98636_r8,0.98579_r8,0.98479_r8,0.98335_r8, & + 0.99919_r8,0.99678_r8,0.99634_r8,0.99621_r8,0.99608_r8,0.99603_r8,0.99579_r8,0.99540_r8, & + 0.99923_r8,0.99911_r8,0.99916_r8,0.99924_r8,0.99925_r8,0.99933_r8,0.99930_r8,0.99925_r8, & + 0.99927_r8,0.99958_r8,0.99968_r8,0.99975_r8,0.99986_r8,0.99990_r8,0.99992_r8,0.99993_r8, & + 0.99931_r8,0.99961_r8,0.99973_r8,0.99980_r8,0.99989_r8,0.99993_r8,0.99996_r8,0.99997_r8, & + 0.99935_r8,0.99965_r8,0.99975_r8,0.99979_r8,0.99990_r8,0.99995_r8,0.99997_r8,0.99998_r8, & + 0.99942_r8,0.99970_r8,0.99976_r8,0.99983_r8,0.99991_r8,0.99995_r8,0.99998_r8,0.99999_r8, & + 0.99947_r8,0.99973_r8,0.99979_r8,0.99983_r8,0.99991_r8,0.99996_r8,0.99998_r8,0.99999_r8, & + 0.99951_r8,0.99976_r8,0.99982_r8,0.99986_r8,0.99992_r8,0.99995_r8,0.99998_r8,0.99999_r8, & + 0.99973_r8,0.99987_r8,0.99990_r8,0.99992_r8,0.99995_r8,0.99997_r8,0.99999_r8,0.99999_r8, & + 0.99986_r8,0.99992_r8,0.99996_r8,0.99997_r8,0.99998_r8,0.99998_r8,0.99999_r8,1.00000_r8, & + 0.99991_r8,0.99995_r8,0.99996_r8,0.99997_r8,0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8, & + 0.99994_r8,0.99997_r8,0.99998_r8,0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8,1.00000_r8, & + 0.99999_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99998_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99999_r8,0.99999_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dsal02(7,17) = ssa_sal02(2:8,:) - ssa_sal02(1:7,:) + + real(r8), parameter :: asm_sal02(8,17) = reshape( (/ & + 0.78_r8, 0.80_r8, 0.80_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, & + 0.78_r8, 0.80_r8, 0.80_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, & + 0.78_r8, 0.80_r8, 0.80_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, & + 0.78_r8, 0.80_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, 0.82_r8, & + 0.78_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, & + 0.78_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, & + 0.78_r8, 0.80_r8, 0.81_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.84_r8, & + 0.78_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.84_r8, & + 0.78_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, & + 0.77_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.85_r8, & + 0.76_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.76_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.76_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.75_r8, 0.80_r8, 0.81_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.74_r8, 0.79_r8, 0.81_r8, 0.81_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.72_r8, 0.77_r8, 0.79_r8, 0.80_r8, 0.82_r8, 0.83_r8, 0.84_r8, 0.85_r8, & + 0.71_r8, 0.75_r8, 0.77_r8, 0.78_r8, 0.81_r8, 0.83_r8, 0.84_r8, 0.85_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dsal02(7,17) = asm_sal02(2:8,:) - asm_sal02(1:7,:) + +!-------------------------------------------------------------------- +! sea-salt bin 3 +!-------------------------------------------------------------------- + real(r8), parameter :: qext_sal03(8,17) = reshape( (/ & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.91_r8, 1.44_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.91_r8, 1.44_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.91_r8, 1.44_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.91_r8, 1.44_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.44_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.66_r8, 4.21_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.66_r8, 4.20_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.66_r8, 4.21_r8, & + 0.19_r8, 0.34_r8, 0.46_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.67_r8, 4.21_r8, & + 0.19_r8, 0.34_r8, 0.47_r8, 0.58_r8, 0.92_r8, 1.45_r8, 2.68_r8, 4.22_r8, & + 0.19_r8, 0.34_r8, 0.47_r8, 0.58_r8, 0.92_r8, 1.46_r8, 2.67_r8, 4.22_r8, & + 0.19_r8, 0.35_r8, 0.47_r8, 0.59_r8, 0.92_r8, 1.46_r8, 2.68_r8, 4.23_r8, & + 0.19_r8, 0.35_r8, 0.47_r8, 0.59_r8, 0.93_r8, 1.46_r8, 2.68_r8, 4.23_r8, & + 0.19_r8, 0.35_r8, 0.47_r8, 0.59_r8, 0.93_r8, 1.47_r8, 2.69_r8, 4.25_r8, & + 0.19_r8, 0.35_r8, 0.48_r8, 0.60_r8, 0.94_r8, 1.48_r8, 2.71_r8, 4.27_r8, & + 0.20_r8, 0.36_r8, 0.48_r8, 0.60_r8, 0.94_r8, 1.49_r8, 2.72_r8, 4.29_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dsal03(7,17) = qext_sal03(2:8,:) - qext_sal03(1:7,:) + + real(r8), parameter :: ssa_sal03(8,17) = reshape( (/ & + 0.99903_r8,0.98942_r8,0.98658_r8,0.98454_r8,0.98105_r8,0.97736_r8,0.97161_r8,0.96631_r8, & + 0.99907_r8,0.99687_r8,0.99611_r8,0.99559_r8,0.99470_r8,0.99369_r8,0.99208_r8,0.99059_r8, & + 0.99910_r8,0.99917_r8,0.99917_r8,0.99913_r8,0.99905_r8,0.99893_r8,0.99870_r8,0.99847_r8, & + 0.99911_r8,0.99958_r8,0.99970_r8,0.99976_r8,0.99982_r8,0.99985_r8,0.99987_r8,0.99986_r8, & + 0.99915_r8,0.99961_r8,0.99973_r8,0.99980_r8,0.99987_r8,0.99990_r8,0.99993_r8,0.99993_r8, & + 0.99919_r8,0.99963_r8,0.99974_r8,0.99981_r8,0.99988_r8,0.99992_r8,0.99995_r8,0.99996_r8, & + 0.99923_r8,0.99965_r8,0.99976_r8,0.99983_r8,0.99990_r8,0.99994_r8,0.99996_r8,0.99997_r8, & + 0.99929_r8,0.99968_r8,0.99978_r8,0.99984_r8,0.99991_r8,0.99994_r8,0.99997_r8,0.99998_r8, & + 0.99935_r8,0.99970_r8,0.99979_r8,0.99985_r8,0.99991_r8,0.99995_r8,0.99997_r8,0.99998_r8, & + 0.99958_r8,0.99980_r8,0.99987_r8,0.99990_r8,0.99994_r8,0.99997_r8,0.99998_r8,0.99999_r8, & + 0.99976_r8,0.99989_r8,0.99992_r8,0.99995_r8,0.99997_r8,0.99998_r8,0.99999_r8,1.00000_r8, & + 0.99982_r8,0.99991_r8,0.99994_r8,0.99996_r8,0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8, & + 0.99987_r8,0.99994_r8,0.99996_r8,0.99997_r8,0.99998_r8,0.99999_r8,1.00000_r8,1.00000_r8, & + 0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99999_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99994_r8,0.99996_r8,0.99997_r8,0.99997_r8,0.99997_r8,0.99997_r8,0.99997_r8,0.99997_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dsal03(7,17) = ssa_sal03(2:8,:) - ssa_sal03(1:7,:) + + real(r8), parameter :: asm_sal03(8,17) = reshape( (/ & + 0.81_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, & + 0.81_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.83_r8, & + 0.81_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, & + 0.81_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, & + 0.81_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, & + 0.81_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.84_r8, & + 0.81_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.85_r8, & + 0.81_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, & + 0.81_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.85_r8, & + 0.81_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, & + 0.80_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, & + 0.80_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.86_r8, & + 0.80_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.86_r8, 0.87_r8, & + 0.80_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, & + 0.80_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, & + 0.79_r8, 0.83_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, & + 0.78_r8, 0.82_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.87_r8, 0.87_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dsal03(7,17) = asm_sal03(2:8,:) - asm_sal03(1:7,:) + + real(r8), parameter :: qext_sal04(8,17) = reshape( (/ & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.69_r8, 1.26_r8, 1.99_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.68_r8, 1.26_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.69_r8, 1.26_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.28_r8, 0.43_r8, 0.69_r8, 1.26_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.27_r8, 0.43_r8, 0.69_r8, 1.27_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.28_r8, 0.44_r8, 0.69_r8, 1.27_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.28_r8, 0.44_r8, 0.69_r8, 1.27_r8, 2.00_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.28_r8, 0.44_r8, 0.69_r8, 1.27_r8, 2.01_r8, & + 0.09_r8, 0.16_r8, 0.22_r8, 0.28_r8, 0.44_r8, 0.69_r8, 1.27_r8, 2.01_r8, & + 0.09_r8, 0.17_r8, 0.22_r8, 0.28_r8, 0.44_r8, 0.70_r8, 1.28_r8, 2.02_r8 & + /),(/8,17/)) + + real(r8), parameter :: qext_dsal04(7,17) = qext_sal04(2:8,:) - qext_sal04(1:7,:) + + real(r8), parameter :: ssa_sal04(8,17) = reshape( (/ & + 0.99874_r8,0.98463_r8,0.97956_r8,0.97596_r8,0.96927_r8,0.96213_r8,0.95108_r8,0.94110_r8, & + 0.99879_r8,0.99541_r8,0.99411_r8,0.99316_r8,0.99134_r8,0.98932_r8,0.98605_r8,0.98300_r8, & + 0.99881_r8,0.99880_r8,0.99873_r8,0.99866_r8,0.99846_r8,0.99820_r8,0.99771_r8,0.99723_r8, & + 0.99887_r8,0.99940_r8,0.99954_r8,0.99963_r8,0.99971_r8,0.99975_r8,0.99976_r8,0.99975_r8, & + 0.99893_r8,0.99946_r8,0.99960_r8,0.99969_r8,0.99978_r8,0.99984_r8,0.99988_r8,0.99988_r8, & + 0.99899_r8,0.99949_r8,0.99963_r8,0.99972_r8,0.99982_r8,0.99987_r8,0.99991_r8,0.99993_r8, & + 0.99907_r8,0.99952_r8,0.99966_r8,0.99974_r8,0.99984_r8,0.99989_r8,0.99994_r8,0.99995_r8, & + 0.99915_r8,0.99957_r8,0.99969_r8,0.99977_r8,0.99985_r8,0.99991_r8,0.99995_r8,0.99997_r8, & + 0.99923_r8,0.99960_r8,0.99971_r8,0.99979_r8,0.99987_r8,0.99992_r8,0.99996_r8,0.99997_r8, & + 0.99954_r8,0.99976_r8,0.99983_r8,0.99987_r8,0.99992_r8,0.99995_r8,0.99997_r8,0.99998_r8, & + 0.99976_r8,0.99988_r8,0.99991_r8,0.99993_r8,0.99996_r8,0.99998_r8,0.99999_r8,0.99999_r8, & + 0.99982_r8,0.99991_r8,0.99993_r8,0.99995_r8,0.99997_r8,0.99998_r8,0.99999_r8,0.99999_r8, & + 0.99988_r8,0.99994_r8,0.99995_r8,0.99997_r8,0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8, & + 0.99998_r8,0.99999_r8,0.99999_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99999_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8,1.00000_r8, & + 0.99990_r8,0.99993_r8,0.99995_r8,0.99996_r8,0.99997_r8,0.99997_r8,0.99997_r8,0.99997_r8 & + /),(/8,17/)) + + real(r8), parameter :: ssa_dsal04(7,17) = ssa_sal04(2:8,:) - ssa_sal03(1:7,:) + + real(r8), parameter :: asm_sal04(8,17) = reshape( (/ & + 0.82_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, & + 0.82_r8, 0.82_r8, 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, & + 0.82_r8, 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, & + 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.84_r8, & + 0.82_r8, 0.83_r8, 0.83_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.84_r8, & + 0.82_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.84_r8, & + 0.82_r8, 0.83_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.85_r8, & + 0.82_r8, 0.84_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.85_r8, 0.85_r8, & + 0.82_r8, 0.84_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.85_r8, 0.85_r8, 0.85_r8, & + 0.82_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.86_r8, 0.86_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.86_r8, 0.87_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, 0.87_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.86_r8, 0.87_r8, 0.87_r8, 0.87_r8, & + 0.81_r8, 0.85_r8, 0.85_r8, 0.86_r8, 0.87_r8, 0.87_r8, 0.87_r8, 0.88_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.87_r8, 0.87_r8, 0.88_r8, 0.88_r8, & + 0.81_r8, 0.84_r8, 0.85_r8, 0.86_r8, 0.87_r8, 0.87_r8, 0.88_r8, 0.88_r8 & + /),(/8,17/)) + + real(r8), parameter :: asm_dsal04(7,17) = asm_sal04(2:8,:) - asm_sal03(1:7,:) + + contains + + subroutine setaer( z, airden, rh, aocs1, aocs2, acbs1, acbs2,& + aant, aso4, asal, ads, asoa, & + dtcbs1, dtcbs2, omcbs1, omcbs2, gcbs1, gcbs2, & + dtocs1, dtocs2, omocs1, omocs2, gocs1, gocs2, & + dtant, omant, gant, & + dtso4, omso4, gso4, & + dtsal, omsal, gsal, & + dtds1, dtds2, dtds3, dtds4, & + omds1, omds2, omds3, omds4, & + gds1, gds2, gds3, gds4, dtsoa, nw ) +!----------------------------------------------------------------------------- +! ... calculate aerosol optical depth +!----------------------------------------------------------------------------- +! AEROSOL TYPES: +! ocs1, ocs2, cbs1, cbs2, ant, so4, ds1-ds4,soa, sal +! where 1=hydrophobic, 2=hydrophilic; +! +! PARAMETERS: +! NZ - INTEGER, number of specified altitude levels in the working +! grid +! Z - REAL, specified altitude working grid (km) +! axxx aerosoling mix ratio (where xxx is aerosol type) +! +! dtxxx REAL, optical depth (absorption) +! omxxx REAL, single albedo +! gxxx asysmetry factor +! +!----------------------------------------------------------------------------- +! VERTICAL DOMAIN is from bottom(1) to TOP (TOP=plevp) +! CCM from top(1) to bottom(plevp) +! +! Converted to MIE Look-up Table by P. Hess, April 2005 +!----------------------------------------------------------------------------- + + use mo_constants, only : pi + use ppgrid, only : pver, pverp + use chem_mods, only : adv_mass + use mo_constants, only : avogadro + use mo_chem_utls, only : get_spc_ndx + use dust_model, only : dust_names + use seasalt_model, only : sslt_names=>seasalt_names + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: aocs1(pverp) + real(r8), intent(in) :: aocs2(pverp) + real(r8), intent(in) :: acbs1(pverp) + real(r8), intent(in) :: acbs2(pverp) + real(r8), intent(in) :: aant(pverp) + real(r8), intent(in) :: aso4(pverp) + real(r8), intent(in) :: asal(pverp,4) + real(r8), intent(in) :: ads(4,pverp) + real(r8), intent(in) :: asoa(pverp) + real(r8), intent(in) :: rh(pverp) + real(r8), intent(in) :: airden(pverp) ! molecules air / cm^3 + + real(r8), intent(out) :: dtcbs1(pver,nw) + real(r8), intent(out) :: dtcbs2(pver,nw) + real(r8), intent(out) :: omcbs1(pver,nw) + real(r8), intent(out) :: omcbs2(pver,nw) + real(r8), intent(out) :: gcbs1(pver,nw) + real(r8), intent(out) :: gcbs2(pver,nw) + + real(r8), intent(out) :: dtocs1(pver,nw) + real(r8), intent(out) :: dtocs2(pver,nw) + real(r8), intent(out) :: dtsoa(pver,nw) + real(r8), intent(out) :: omocs1(pver,nw) + real(r8), intent(out) :: omocs2(pver,nw) + real(r8), intent(out) :: gocs1(pver,nw) + real(r8), intent(out) :: gocs2(pver,nw) + + real(r8), intent(out) :: dtant(pver,nw) + real(r8), intent(out) :: omant(pver,nw) + real(r8), intent(out) :: gant(pver,nw) + + real(r8), intent(out) :: dtso4(pver,nw) + real(r8), intent(out) :: omso4(pver,nw) + real(r8), intent(out) :: gso4(pver,nw) + + real(r8), intent(out) :: dtsal(pver,nw,4) + real(r8), intent(out) :: omsal(pver,nw,4) + real(r8), intent(out) :: gsal(pver,nw,4) + + + real(r8), intent(out) :: dtds1(pver,nw) + real(r8), intent(out) :: dtds2(pver,nw) + real(r8), intent(out) :: dtds3(pver,nw) + real(r8), intent(out) :: dtds4(pver,nw) + real(r8), intent(out) :: omds1(pver,nw) + real(r8), intent(out) :: omds2(pver,nw) + real(r8), intent(out) :: omds3(pver,nw) + real(r8), intent(out) :: omds4(pver,nw) + real(r8), intent(out) :: gds1(pver,nw) + real(r8), intent(out) :: gds2(pver,nw) + real(r8), intent(out) :: gds3(pver,nw) + real(r8), intent(out) :: gds4(pver,nw) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: km2m = 1.e3_r8 + real(r8), parameter :: cm3_2_m3 = 1.e6_r8 + real(r8), parameter :: s2as = 1.37557_r8 ! conversion factor from mass SO4 to mass (NH4)2(SO4) (assumed in mie calculation). + real(r8), parameter :: rhmax = .98_r8 ! maximum relative humidity allowed + real(r8), parameter :: con_fac = km2m*cm3_2_m3/avogadro + + integer :: k, n, ndx, wn + integer :: rh_l + integer :: rh_u + integer :: rh_ndx(pver) + real(r8) :: mw + real(r8) :: delrh + real(r8) :: rhtest + real(r8) :: dz(pver) + real(r8) :: del_rh(pver) + real(r8) :: gpm2(pver) + real(r8) :: table_rh(8) = (/ 0._r8, .5_r8, .7_r8, .8_r8, .9_r8, .95_r8, .98_r8, .99_r8 /) + +!----------------------------------------------------------------------------- +! Tables are based on the following wavelength bins from ftuv +! 178.60- 180.00 +! 180.00- 183.00 +! 183.00- 187.00 +! 187.00- 192.00 +! 192.00- 198.00 +! 198.00- 205.00 +! 205.00- 213.00 +! 213.00- 222.00 +! 222.00- 231.00 +! 241.00- 289.90 +! 289.90- 305.50 +! 305.50- 313.50 +! 313.50- 337.50 +! 337.50- 420.00 +! 420.00- 475.00 +! 475.00- 729.00 +! 729.00- 743.60 +! +! For aerosol types so4 and ant data tabulated for CAM is used in wavelength bins for which it exists +! This data has been created by D. Fillmore in the file aerOptics.nc +! Data is weighted by wavelength bin +! +! Otherwise, tables have been recreated by P. Hess +! +! Refractive indices and other DATA is mostly from OPAC dataset Hess et al., ..... +! +! SULFATE +! +! r_m = 0.05 ; from Grant 1999 ! median radius of number distribution (microns) +! sigma = alog10(2.00) ! standard deviation of distribution +! rmin = 0.005 ! minimum radius microns +! rmax = 20.0 ! maximum radius microns +! rho = 1.76 ! grams / cm^3 +! PARAMETERS NEEDED FOR CALCULATING KOHLER CURVES for calculating growth with relative humidity +! nu_s = 3.0 +! rho_u = rho +! rho_s = rho +! gamma = 1.0 +! phi = 0.717 ; optimal fit to water activity curves of Tang 1994 +! eps = 1.0 +! +! REFRACTIVE INDEXES FOR SULFATE (for wavelength um) +! 0.300, 0.405, 0.535, 0.656, 0.706, 0.800, 1.00, 1.07, +! 1.15, 1.20, 1.30, 1.40, 1.50, 1.58, 1.60, 1.70, 1.80, +! 1.90, 2.00, 2.05, 2.14, 2.20, 2.30, 2.40, 2.50, 2.63, +! 2.78, 2.94, 3.08, 3.13, 3.18, 3.23, 3.30, 3.33, 3.39, +! 3.45, 3.51, 3.57, 3.85, 4.17, 4.55, 4.76, 5.26] +! +! REAL +! 1.53, 1.53, 1.52, 1.52, 1.52, 1.52, 1.51, 1.51, $ +! 1.51, 1.50, 1.50, 1.50, 1.49, 1.49, 1.49, 1.49, 1.48, $ +! 1.48, 1.47, 1.47, 1.47, 1.46, 1.46, 1.45, 1.44, 1.42, $ +! 1.40, 1.33, 1.27, 1.39, 1.49, 1.48, 1.56, 1.61, 1.61, $ +! 1.60, 1.62, 1.63, 1.56, 1.53, 1.49, 1.48, 1.44] +! +! IMAGINARY +! 1.0e-7, 1.0e-7, 1.0e-7, 1.0e-7, 1.0e-7, 1.0e-7, 3.5e-7, 2.4e-6, +! 9.5e-7, 3.4e-6, 1.7e-5, 1.1e-5, 3.4e-5, 2.1e-4, 1.9e-4, 9.0e-5, 7.6e-5, $ +! 1.5e-4, 1.0e-3, 1.5e-3, 3.4e-3, 1.7e-3, 7.7e-4, 4.5e-4, 3.5e-4, 9.0e-4, $ +! 5.0e-3, 5.0e-2, 2.3e-1, 3.3e-1, 2.7e-1, 2.4e-1, 2.7e-1, 2.4e-1, 1.7e-1, $ +! 1.5e-1, 1.4e-1, 1.0e-1, 2.0e-2, 1.0e-2, 7.0e-3, 6.0e-3, 7.0e-3] +! +! +! NH4NO3 +! +! treated the same as sulphate except +! rho=1.73 (Lowenthal, 1999, Atmospheric Environment). +! +! DUST +! +! dust is treated as 4 size distributions +! 0.05 - 0.5; 0.5 - 1.25; 1.25 - 2.5; 2.5 - 5.0 microns +! each bin is part of a distribution with median number r_m = 2.524 * exp(- 3.0 * log(2.00)^2) / 2 [number median radius] +! r_m = 0.298, sigma = 2.00, rho = 2.650 +! +! note this treatment of dust is somewhat different than that made in CAM, where each size bin +! has a different number median radius +! +! dust is not assumed to take up water. +! +! refractive indexes are as in CAM (Fillmore...) +! +! ORGANIC CARBON +! +! In absence of data for organic aerosol +! refractive indexes are taken as for WASO: based on Fillmore (and OPAC). This is similar to +! the formulation used in Liao and Seinfeld, 2004, JGR. +! The growth of organic carbon with relative humidity is assumed constant at all radii following +! hygrscopic growth given in Chen et al. : rel. hum: 0, 50, 70, 80, 90, 95, 98, 99 +! multiplier for radius: 1, 1.2, 1.4, 1.5, 1.6, 1.8, 2.1 , 2.2 +! +! SOA +! +! Treated the same as organic aerosol. +! +! SOOT +! +! Refractive index are taken from Fillmore based on OPAC. +! In a different formulation than that followed in CAM we let hydrophillic soot grow. +! The growth of organic carbon with relative humidity is assumed constant at all radii following +! hygrscopic growth given in Chen et al. : rel. hum: 0, 50, 70, 80, 90, 95, 98, 99 +! multiplier for radius: (1, 1, 1, 1.2, 1.4, 1.5, 1.7, 1.9] +! +! +! SEA SALT +! +! Assumes 4 bins: 0.1 - 0.5, 0.5-1.5, 1.5-5, 5-10 um assuming a step distribution +! additional parameters used calculation +! phi = 0.8 +! mol_s = 35.453 + 22.98977 +! nu_s = 2.0 +! rmin = 0.005, rmax = 500, nr = 300 +! +! refractive indices are from fillmore +!----------------------------------------------------------------------------- + +!----------------------------------------------------------------------------- +! ... vertical interval dz +!----------------------------------------------------------------------------- + do k = 1,pver + dz(k) = abs( z(k+1) - z(k) ) * airden(k) * con_fac + end do + +!---------------------------------------------------------------------------- +! ... calculate interpolatant for relative humidity +!---------------------------------------------------------------------------- + do k = 1,pver + rhtest = min( rh(k),rhmax ) + do rh_u = 2,8 + if( rhtest <= table_rh(rh_u) ) then + exit + end if + end do + rh_l = rh_u - 1 + rh_ndx(k) = rh_l + del_rh(k) = (rhtest - table_rh(rh_l))/(table_rh(rh_u) - table_rh(rh_l)) + end do + +!----------------------------------------------------------------------------- +! ... so4 +!----------------------------------------------------------------------------- + ndx = get_spc_ndx('SO4') + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = s2as * dz(:) * aso4(:pver) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtso4(k,wn) = gpm2(k)*(qext_so4(rh_l,wn) + delrh*qext_dso4(rh_l,wn)) + omso4(k,wn) = ssa_so4(rh_l,wn) + delrh*ssa_dso4(rh_l,wn) + gso4(k,wn) = asm_so4(rh_l,wn) + delrh*asm_dso4(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtso4(:,wn) = 0._r8 + omso4(:,wn) = 0._r8 + gso4(:,wn) = 0._r8 + end do + end if + +!----------------------------------------------------------------------------- +! ... ant: nh4no3 +!----------------------------------------------------------------------------- + ndx = get_spc_ndx('NH4NO3') + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * aant(:pver) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtant(k,wn) = gpm2(k)*(qext_ant(rh_l,wn) + delrh*qext_dant(rh_l,wn)) + omant(k,wn) = ssa_ant(rh_l,wn) + delrh*ssa_dant(rh_l,wn) + gant(k,wn) = asm_ant(rh_l,wn) + delrh*asm_dant(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtant(:,wn) = 0._r8 + omant(:,wn) = 0._r8 + gant(:,wn) = 0._r8 + end do + end if + +!----------------------------------------------------------------------------- +! ... cbs : blackcarbons +!----------------------------------------------------------------------------- + ndx = get_spc_ndx('CB1') + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * acbs1(:pver) * mw + do wn = 1,nw + dtcbs1(:,wn) = gpm2(:)*qext_cbs(1,wn) + omcbs1(:,wn) = ssa_cbs(1,wn) + gcbs1(:,wn) = asm_cbs(1,wn) + end do + else + do wn = 1,nw + dtcbs1(:,wn) = 0._r8 + omcbs1(:,wn) = 0._r8 + gcbs1(:,wn) = 0._r8 + end do + end if + + ndx = get_spc_ndx('CB2') + if( ndx > 0 ) then + gpm2(:) = dz(:) * acbs2(:pver) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtcbs2(k,wn) = gpm2(k)*(qext_cbs(rh_l,wn) + delrh*qext_dcbs(rh_l,wn)) + omcbs2(k,wn) = ssa_cbs(rh_l,wn) + delrh*ssa_dcbs(rh_l,wn) + gcbs2(k,wn) = asm_cbs(rh_l,wn) + delrh*asm_dcbs(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtcbs2(:,wn) = 0._r8 + omcbs2(:,wn) = 0._r8 + gcbs2(:,wn) = 0._r8 + end do + end if + +!----------------------------------------------------------------------------- +! ... ocs : organic carbons +!----------------------------------------------------------------------------- + ndx = get_spc_ndx('OC1') + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * aocs1(:pver) * mw + do wn = 1,nw + dtocs1(:,wn) = gpm2(:)*qext_ocs(1,wn) + omocs1(:,wn) = ssa_ocs(1,wn) + gocs1(:,wn) = asm_ocs(1,wn) + end do + else + do wn = 1,nw + dtocs1(:,wn) = 0._r8 + omocs1(:,wn) = 0._r8 + gocs1(:,wn) = 0._r8 + end do + end if + + ndx = get_spc_ndx('OC2') + if( ndx > 0 ) then + gpm2(:) = dz(:) * aocs2(:pver) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtocs2(k,wn) = gpm2(k)*(qext_ocs(rh_l,wn) + delrh*qext_docs(rh_l,wn)) + omocs2(k,wn) = ssa_ocs(rh_l,wn) + delrh*ssa_docs(rh_l,wn) + gocs2(k,wn) = asm_ocs(rh_l,wn) + delrh*asm_docs(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtocs2(:,wn) = 0._r8 + omocs2(:,wn) = 0._r8 + gocs2(:,wn) = 0._r8 + end do + end if + +!----------------------------------------------------------------------------- +! ... soa : secondary organic +!----------------------------------------------------------------------------- + ndx = get_spc_ndx('SOA') + if( ndx > 0 ) then + ndx = get_spc_ndx('OC2') + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * asoa(:pver) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + dtsoa(k,wn) = gpm2(k)*(qext_ocs(rh_l,wn) + del_rh(k)*qext_docs(rh_l,wn)) + dtocs2(k,wn) = dtocs2(k,wn) + dtsoa(k,wn) + end do + end do + end if + else + do wn = 1,nw + dtsoa(:,wn) = 0._r8 + end do + end if + +!----------------------------------------------------------------------------- +! ... dust +!----------------------------------------------------------------------------- + ndx = get_spc_ndx(dust_names(1)) + if (ndx >0) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * ads(1,:pver) * mw + do wn = 1,nw + dtds1(:,wn) = gpm2(:)*qext_ds1(wn) + omds1(:,wn) = ssa_ds1(wn) + gds1(:,wn) = asm_ds1(wn) + end do + else + do wn = 1,nw + dtds1(:,wn) = 0._r8 + omds1(:,wn) = 0._r8 + gds1(:,wn) = 0._r8 + end do + endif + ndx = get_spc_ndx(dust_names(2)) + if (ndx >0) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * ads(2,:pver) * mw + do wn = 1,nw + dtds2(:,wn) = gpm2(:)*qext_ds2(wn) + omds2(:,wn) = ssa_ds2(wn) + gds2(:,wn) = asm_ds2(wn) + end do + else + do wn = 1,nw + dtds2(:,wn) = 0._r8 + omds2(:,wn) = 0._r8 + gds2(:,wn) = 0._r8 + end do + endif + ndx = get_spc_ndx(dust_names(3)) + if (ndx >0) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * ads(3,:pver) * mw + do wn = 1,nw + dtds3(:,wn) = gpm2(:)*qext_ds3(wn) + omds3(:,wn) = ssa_ds3(wn) + gds3(:,wn) = asm_ds3(wn) + end do + else + do wn = 1,nw + dtds3(:,wn) = 0._r8 + omds3(:,wn) = 0._r8 + gds3(:,wn) = 0._r8 + end do + endif + ndx = get_spc_ndx(dust_names(4)) + if (ndx >0) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * ads(4,:pver) * mw + do wn = 1,nw + dtds4(:,wn) = gpm2(:)*qext_ds4(wn) + omds4(:,wn) = ssa_ds4(wn) + gds4(:,wn) = asm_ds4(wn) + end do + else + do wn = 1,nw + dtds4(:,wn) = 0._r8 + omds4(:,wn) = 0._r8 + gds4(:,wn) = 0._r8 + end do + endif + +!----------------------------------------------------------------------------- +! ... sea salts +!----------------------------------------------------------------------------- + ndx = get_spc_ndx(sslt_names(1)) + + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * asal(:pver,1) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtsal(k,wn,1) = gpm2(k)*(qext_sal01(rh_l,wn) + delrh*qext_dsal01(rh_l,wn)) + omsal(k,wn,1) = ssa_sal01(rh_l,wn) + delrh*ssa_dsal01(rh_l,wn) + gsal(k,wn,1) = asm_sal01(rh_l,wn) + delrh*asm_dsal01(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtsal(:,wn,1) = 0._r8 + omsal(:,wn,1) = 0._r8 + gsal(:,wn,1) = 0._r8 + end do + end if + + ndx = get_spc_ndx(sslt_names(2)) + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * asal(:pver,2) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtsal(k,wn,2) = gpm2(k)*(qext_sal02(rh_l,wn) + delrh*qext_dsal02(rh_l,wn)) + omsal(k,wn,2) = ssa_sal02(rh_l,wn) + delrh*ssa_dsal02(rh_l,wn) + gsal(k,wn,2) = asm_sal02(rh_l,wn) + delrh*asm_dsal02(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtsal(:,wn,2) = 0._r8 + omsal(:,wn,2) = 0._r8 + gsal(:,wn,2) = 0._r8 + end do + end if + + ndx = get_spc_ndx(sslt_names(3)) + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * asal(:pver,3) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtsal(k,wn,3) = gpm2(k)*(qext_sal03(rh_l,wn) + delrh*qext_dsal03(rh_l,wn)) + omsal(k,wn,3) = ssa_sal03(rh_l,wn) + delrh*ssa_dsal03(rh_l,wn) + gsal(k,wn,3) = asm_sal03(rh_l,wn) + delrh*asm_dsal03(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtsal(:,wn,3) = 0._r8 + omsal(:,wn,3) = 0._r8 + gsal(:,wn,3) = 0._r8 + end do + end if + + ndx = get_spc_ndx(sslt_names(4)) + if( ndx > 0 ) then + mw = adv_mass( ndx ) + gpm2(:) = dz(:) * asal(:pver,4) * mw + do wn = 1,nw + do k = 1,pver + rh_l = rh_ndx(k) + delrh = del_rh(k) + dtsal(k,wn,4) = gpm2(k)*(qext_sal04(rh_l,wn) + delrh*qext_dsal04(rh_l,wn)) + omsal(k,wn,4) = ssa_sal04(rh_l,wn) + delrh*ssa_dsal04(rh_l,wn) + gsal(k,wn,4) = asm_sal04(rh_l,wn) + delrh*asm_dsal04(rh_l,wn) + end do + end do + else + do wn = 1,nw + dtsal(:,wn,4) = 0._r8 + omsal(:,wn,4) = 0._r8 + gsal(:,wn,4) = 0._r8 + end do + end if + + end subroutine setaer + + end module mo_setaer diff --git a/src/chemistry/mozart/mo_setair.F90 b/src/chemistry/mozart/mo_setair.F90 new file mode 100644 index 0000000000..eba922c8ed --- /dev/null +++ b/src/chemistry/mozart/mo_setair.F90 @@ -0,0 +1,105 @@ + + module mo_setair + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setair + + contains + + subroutine setair( z, nw, wc, airlev, dtrl, & + cz, o2top ) +!----------------------------------------------------------------------------- +! purpose: +! set up an altitude profile of air molecules. subroutine includes a +! shape-conserving scaling method that allows scaling of the entire +! profile to a given sea-level pressure. +!----------------------------------------------------------------------------- +! parameters: +! pmbnew - real(r8), sea-level pressure (mb) to which profile should be +! scaled. if pmbnew < 0, no scaling is done +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real(r8), specified altitude working grid (km) (i) +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! airlev - real(r8), air density (molec/cc) at each specified altitude (o) +! dtrl - real(r8), rayleigh optical depth at each specified altitude (o) +! and each specified wavelength +! cz - real(r8), number of air molecules per cm^2 at each specified (o) +! altitude layer +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use ppgrid, only : pver, pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: o2top + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: airlev(pverp) +!----------------------------------------------------------------------------- +! ... air density (molec cm-3) at each grid level +! rayleigh optical depths +!----------------------------------------------------------------------------- + real(r8), intent(out) :: dtrl(pver,nw) + real(r8), intent(out) :: cz(pverp) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k, kp1, wn + real(r8) :: hscale + real(r8) :: srayl + real(r8) :: deltaz + real(r8) :: wmicrn, xx + +!----------------------------------------------------- +! ... compute column increments (logarithmic integrals) +!----------------------------------------------------- + do k = 1,pver + kp1 = k + 1 + deltaz = 1.e5_r8 * (z(kp1) - z(k)) + cz(k) = (airlev(kp1) - airlev(k)) / log( airlev(kp1)/airlev(k) ) * deltaz + end do + +!----------------------------------------------------- +! ... include exponential tail integral from infinity to 50 km, +! fold tail integral into top layer +! specify scale height near top of data. (scale height at 40km????) +!----------------------------------------------------- +! hscale = 8.05e5 + cz(pverp) = o2top/.2095_r8 + +!----------------------------------------------------- +! ... compute rayleigh cross sections and depths: +!----------------------------------------------------- + do wn = 1,nw +!----------------------------------------------------- +! ... rayleigh scattering cross section from wmo 1985 (originally from +! nicolet, m., on the molecular scattering in the terrestrial atmosphere: +! an empirical formula for its calculation in the homoshpere, planet. +! space sci., 32, 1467-1468, 1984. +!----------------------------------------------------- + wmicrn = 1.e-3_r8*wc(wn) + if( wmicrn <= .55_r8 ) then + xx = 3.6772_r8 + 0.389_r8*wmicrn + 0.09426_r8/wmicrn + else + xx = 4.04_r8 + end if + srayl = 4.02e-28_r8/(wmicrn)**xx + dtrl(1:pver-1,wn) = cz(1:pver-1)*srayl + dtrl(pver,wn) = (cz(pver) + cz(pverp))*srayl + end do + + end subroutine setair + + end module mo_setair diff --git a/src/chemistry/mozart/mo_setcld.F90 b/src/chemistry/mozart/mo_setcld.F90 new file mode 100644 index 0000000000..7d7afc617a --- /dev/null +++ b/src/chemistry/mozart/mo_setcld.F90 @@ -0,0 +1,480 @@ + + module mo_setcld + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + save + + integer, parameter :: nblk = 10, & ! maximum dimension of cloud blks (sing+mu + mreg = 16, & ! maximum dimension of regions + nmax = 3 ! Maximum number of the blocks + real(r8), parameter :: wden = 1.0_r8 * 1.e6_r8 ! g/m3 (1 m3 water = 1e6 g water) + real(r8), parameter :: re = 10.0_r8 * 1.e-6_r8 ! assuming cloud drop radius = 10 um to M + real(r8), parameter :: cldmin = 0.01_r8 ! minimum cld cover + + integer :: r1(1,2) = reshape( (/ 0, 1 /),(/1,2/) ) ! 1=blk, 2=binary prob (regions) + integer :: r2(2,4) = reshape( (/ 0,0, 0,1, 1,1, 1,0/), (/2,4/) ) + integer :: r3(3,8) = reshape( (/ 0,0,0, 0,0,1, 0,1,0, 0,1,1, & + 1,0,0, 1,0,1, 1,1,0, 1,1,1/), (/3,8/) ) + integer :: r4(4,16) = reshape( (/ 0,0,0,0, 0,0,1,0, 0,0,1,1, 0,0,0,1, & + 0,1,0,0, 0,1,1,0, 0,1,1,1, 0,1,0,1, & + 1,0,0,0, 1,0,1,0, 1,0,1,1, 1,0,0,1, & + 1,1,0,0, 1,1,1,0, 1,1,1,1, 1,1,0,1/),(/4,16/) ) + real(r8) :: a1(1,2), b1(1,2) + real(r8) :: a2(2,4), b2(2,4) + real(r8) :: a3(3,8), b3(3,8) + real(r8) :: a4(4,16), b4(4,16) + + private + public :: setcld, setcld_inti + + contains + + subroutine setcld_inti +!----------------------------------------------------------------------------- +! ... Initialize setcld module +!----------------------------------------------------------------------------- + + implicit none + + a1(:,:) = r1(:,:) + a2(:,:) = r2(:,:) + a3(:,:) = r3(:,:) + a4(:,:) = r4(:,:) + + b1(:,:) = (-1)**r1(:,:) + b2(:,:) = (-1)**r2(:,:) + b3(:,:) = (-1)**r3(:,:) + b4(:,:) = (-1)**r4(:,:) + + + end subroutine setcld_inti + + subroutine setcld( z, xlwc, cldfrc, nreg, fp, optr) +!----------------------------------------------------------------------------- +! PURPOSE: +! Set up an altitude profile of ozone, and corresponding absorption +! optical depths. Subroutine includes a shape-conserving scaling method +! that allows scaling of the entire profile to a given overhead ozone +! column amount. +!----------------------------------------------------------------------------- +! PARAMETERS: +! PARAMETERS: +! NZ - INTEGER, number of specified altitude levels in the working (I) +! grid +! Z - REAL, specified altitude working grid (km) (I) +! XLWC Cloud water content g/M3 (I) +! CLDFRC Cloud fraction +! +! NREG INTEGER regions # (O) +! +! FP REAL, probability at each region (O) +! +! optr REAL, optical depth at each region (O) +! +!----------------------------------------------------------------------------- +! VERTICAL DOMAIN is from bottom(1) to TOP (TOP=plevp) +! CCM from top(1) to bottom(plevp) +!----------------------------------------------------------------------------- +! Calculate the UV flux at short wave-length +! with cloud overlap conditions +! References - Stubenrauch, J. Climate, 273-1997 +! +! regions +! n=1 n=2 n=3 n=4(nreg) +! ------------------------ +! ! ! ! ! ! +! ! !==========! ! cld(3),opt(3) nblk(2) nki=1 sing-layer (maximum cover=cld(3) +! ! ! ! ! ! +! ! ! ======== ! cld(2),opt(2) +! ! ! ===========! cld(1),opt(1) nblk(1), nki=2 mult-layer (maximum cover=cld(1) +! ! ! ! ! ! +!------------------------------ +! +! PROCESSURES: +! +! (1) To find cloud layers +! +! (2) To find single layer cloud ======= +! +! (3) To find mult adjcent cloud layers ======== +! =========== +! +! (4) To deteming # (NBLK) of cloud layers (Single + mult) +! +! (5) To find maximum cloud cover at each cloud block +! +! (6) To assume in mult-layer, all layer cld cover=maximum cover +! and cloud opt will be adjusted to be maximum cover +! opt = opt * cld/cld-max +! +! (7) To determine # of regions (NREG) +! nreg = 2**nblk +! +! (8) To determine the binary probality of NREG +! NBLK=1 r1 (nreg=2) +! NBLK=2 r2 (nreg=4) +! NBLK=3 r3 (nreg=8) +! NBLK=4 r4 (nreg=16) +! +! The maximum nblk in each horizontal grid = 4, nblk<=4 +! to elimanite the nblk>4, find smaller opt, and let opt(small=0) +! +! (9) To calculate the probality at each region +! +! clear sky = 1-cld +! so cld-cov = 1-{PRODUCT[1 to nblk] (1-cld)} +! +! (10) To get opt (wei opt) at each vertical level at each hor grid +! +! (11) input opt in rtlink for flux at each region +! need a do-loop for call rtlink +! to get flxreg(nreg=1,2,...) +! +! (12) Adding each flux at each region weighted by +! probability of each region +! +! FLUX = flxreg(1)*prob(1) + flxreg(2)*prob(2) + .... +!---------------------------------------------------------------------------- + + use mo_params + use mo_waveo3 + use ppgrid, only: pver, pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: xlwc(pverp) + real(r8), intent(in) :: cldfrc(pverp) + real(r8), intent(out) :: optr(pver,mreg) ! cld opt (z dependent) at each region + real(r8), intent(out) :: fp(mreg) ! probality at each region + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: ilat, nn, m, mm + integer :: k, l, n ! vertical index for each blk + integer :: nb, & ! # blk index found + nreg ! # regions found + integer :: indx(1) ! wrk array + integer :: ki(nblk), ki2(nblk) ! level count in each cloud block + integer :: kl(nblk), ku(nblk) ! top, bot level index in each cloud block + integer :: kl2(nblk), ku2(nblk) ! top, bot level index in each cloud block + + real(r8) :: small + real(r8) :: wrk + real(r8) :: cld(pverp) + real(r8) :: optin(pver) + real(r8) :: opt(pver) ! cld opt where cloud is found + + real(r8) :: cldadj(pver,nblk), & ! cld cover at each block nblk=1,2,.. + zkadj(pver,nblk), & ! blk height at each block nblk=1,2,.. + optadj(pver,nblk), & ! cld opt at each block nblk=1,2,.. + optwe(pver,nblk), & ! cld opt(weighted) at each block nblk=1,2,.. + opta(nblk), & ! total cld opt(weighted) at each block nblk=1,2,.. + zbk(nblk), & ! wrk array + maxcld(nblk) ! maximum cloud cover at each blk + + real(r8) :: cldadj2(pver,nblk), & ! cld cover at each block nblk=1,2,.. + zkadj2(pver,nblk), & ! blk height at each block nblk=1,2,.. + optadj2(pver,nblk) ! cld opt at each block nblk=1,2,.. + + logical :: mask(nblk) ! wrk array + +!----------------------------------------------------------------------------- +! ... adjust cloud fraction for cloud liquid water content +!----------------------------------------------------------------------------- + do k = 1,pverp + if( xlwc(k) <= .01_r8 .and. cldfrc(k) /= 0._r8 ) then + cld(k) = 0._r8 + else + cld(k) = cldfrc(k) + end if + end do + +Have_clouds : & + if( count( cld(:pver) > cldmin ) > 0 ) then +!----------------------------------------------------------------------------- +! ... Find cloud layers +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! ... calculate cloud optical depth T +! following Liao et al. JGR, 104, 23697, 1999 +!----------------------------------------------------------------------------- + do k = 1,pver + optin(k) = max( 1.5_r8 * xlwc(k)*(z(k+1) - z(k))*1.e3_r8/ (wden * re),0._r8 ) + end do +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) 'k, z(k), cld(k),xlwc(k),optin(k)' + do k = 1,pver + write(iulog,981) k,z(k),cld(k),xlwc(k),optin(k) + end do + write(iulog,*) '--------------------------------------------------------' +#endif +!-------------------------------------------------------- +! ... find cloud layer and make adjcent layer block +!-------------------------------------------------------- + nb = 1 + mm = 0 + do k = 1,pver + if( cld(k) > cldmin ) then + mm = mm + 1 + cldadj(mm,nb) = cld(k) + zkadj(mm,nb) = z(k) + optadj(mm,nb) = optin(k) + ki(nb) = mm + ku(nb) = k + if( mm == 1 ) then + kl(nb) = k + end if + if( cld(k+1) <= cldmin) then + mm = 0 + nb = nb + 1 + end if + end if + end do + + if( mm == 0 ) then + nb = nb - 1 + end if + +!-------------------------------------------------------- +! ...Maximum overlap for adjacent cloud layers +! (1) to find maximum cld cover +!-------------------------------------------------------- + do l = 1,nb + maxcld(l) = maxval( cldadj(1:ki(l),l) ) !maxcld= maxmum cloud in one block + end do + +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) 'setcld: has ',nb,' cloud layers' + write(iulog,*) ' ki,kl,ku' + write(iulog,*) ki(:nb) + write(iulog,*) kl(:nb) + write(iulog,*) ku(:nb) + write(iulog,'(1p,10g12.5)') maxcld(:nb) + write(iulog,*) ' ' +#endif + +!-------------------------------------------------------- +! ... limit the total block <= nmax +!-------------------------------------------------------- + if( nb > nmax ) then +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) 'setcld: has ',nb,' cloud layers' + write(iulog,*) ' ki,kl,ku' + write(iulog,*) ki(:nb) + write(iulog,*) kl(:nb) + write(iulog,*) ku(:nb) + write(iulog,'(1p,10g12.5)') maxcld(:nb) +#endif + do l = 1,nb + opta(l) = sum( optadj(1:ki(l),l) )/maxcld(l) + zbk(l) = maxcld(l) + ki2(l) = ki(l) + kl2(l) = kl(l) + ku2(l) = ku(l) + do k = 1,ki(l) + cldadj2(k,l) = cldadj(k,l) + zkadj2(k,l) = zkadj(k,l) + optadj2(k,l) = optadj(k,l) + end do + end do +#ifdef DEBUG + write(iulog,'(1p,10g12.5)') opta(:nb) + write(iulog,*) ' ' +#endif + mask(:nb) = .true. + do l = 1,nmax + indx(:) = maxloc( opta(:nb),mask=mask(:nb) ) + mask(indx(1)) = .false. + end do + nn = 0 + do l = 1,nb + if( .not. mask(l) ) then + nn = nn + 1 + ki(nn) = ki2(l) + kl(nn) = kl2(l) + ku(nn) = ku2(l) + maxcld(nn) = zbk(l) + do k = 1,ki(nn) + cldadj(k,nn) = cldadj2(k,l) + zkadj (k,nn) = zkadj2(k,l) + optadj(k,nn) = optadj2(k,l) + end do + end if + end do + nb = nmax +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) 'setcld: has ',nb,' cloud layers' + write(iulog,*) ' ki,kl,ku' + write(iulog,*) ki(:nb) + write(iulog,*) kl(:nb) + write(iulog,*) ku(:nb) + write(iulog,'(1p,10g12.5)') maxcld(:nb) + write(iulog,*) ' ' +#endif + end if +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) 'nb, l, k, zkadj, cldadj, optadj' + do l = 1,nb + do k = 1,ki(l) + write(iulog,992) nb,l,k,zkadj(k,l),cldadj(k,l),optadj(k,l) + end do + end do + write(iulog,*) '--------------------------------------------------------' +#endif + +!-------------------------------------------------------- +! (2) calculate the weighted cloud optical depth +!-------------------------------------------------------- + do l = 1,nb + if( maxcld(l) > 0._r8 ) then + wrk = 1._r8/maxcld(l) + do k = 1,ki(l) + optwe(k,l) = cldadj(k,l)*optadj(k,l)*wrk + end do + else + do k = 1,ki(l) + optwe(k,l) = 0._r8 + end do + end if + end do +!-------------------------------------------------------- +! (3) calculate the probability +!-------------------------------------------------------- + nreg = 2**nb ! each column of grid has nregions; nreg probobilities + zbk(:nb) = 1._r8 - maxcld(:nb) + if( nb == 1 ) then + do n = 1,nreg + fp(n) = product( a1(:nb,n) + b1(:nb,n)*zbk(:nb) ) + end do + else if( nb == 2 ) then + do n = 1,nreg + fp(n) = product( a2(:nb,n) + b2(:nb,n)*zbk(:nb) ) + end do + else if( nb == 3 ) then + do n = 1,nreg + fp(n) = product( a3(:nb,n) + b3(:nb,n)*zbk(:nb) ) + end do + else if( nb == 4 ) then + do n = 1,nreg + fp(n) = product( a4(:nb,n) + b4(:nb,n)*zbk(:nb) ) + end do + else if( nb == 0 ) then + do n = 1,nreg + fp(n) = 1._r8 + end do + end if +#ifdef DEBUG + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) 'nreg,fp' + write(iulog,993) nreg,(fp(n),n=1,nreg) + write(iulog,*) 'nreg,k,zkadj,optwe' + do l = 1,nb + do k = 1,ki(l) + write(iulog,994) nreg,k,zkadj(k,l),optwe(k,l) + end do + end do + write(iulog,*) '--------------------------------------------------------' +#endif + +!------------------------------------------------- +! (4) convert to weight optical depth at each region +!------------------------------------------------- + do n = 1,nreg + optr(:,n) = 0._r8 + end do + if( nb == 1) then + do n = 1,nreg + do l = 1,nb + if( r1(l,n) /= 0 ) then + do k = kl(l),ku(l) + optr(k,n) = optwe(k-kl(l)+1,l) + end do + end if + end do + end do + else if( nb == 2 ) then + do n = 1,nreg + do l = 1,nb + if( r2(l,n) /= 0 ) then + do k = kl(l),ku(l) + optr(k,n) = optwe(k-kl(l)+1,l) + end do + end if + end do + end do + else if( nb == 3 ) then + do n = 1,nreg + do l = 1,nb + if( r3(l,n) /= 0 ) then + do k = kl(l),ku(l) + optr(k,n) = optwe(k-kl(l)+1,l) + end do + end if + end do + end do + else if( nb == 4 ) then + do n = 1,nreg + do l = 1,nb + if( r4(l,n) /= 0 ) then + do k = kl(l),ku(l) + optr(k,n) = optwe(k-kl(l)+1,l) + end do + end if + end do + end do + else if( nb == 0 ) then + do k = 1,pver + optr(k,1) = 0._r8 + end do + end if + else +!----------------------------------------------------------------------------- +! ... no clouds are found +!----------------------------------------------------------------------------- + nreg = 1 + do k = 1,pver + optr(k,1) = 0._r8 ! clear sky + end do + fp(1) = 1._r8 + end if Have_clouds + +#ifdef DEBUG + if( nreg > 1 ) then + write(iulog,*) ' ' + write(iulog,*) '--------------------------------------------------------' + write(iulog,*) 'fp' + write(iulog,'(1p,10g12.5)') fp(1:nreg) + do n = 1,nreg + write(iulog,*) 'z,optr for nreg = ',n + do k = 1,pver + write(iulog,'(1p,2g15.5)') z(k),optr(k,n) + end do + write(iulog,*) ' ' + end do + write(iulog,*) '--------------------------------------------------------' + end if +#endif + + 981 format(i10,4g10.3) + 992 format(3i10,3g13.3) + 993 format(i10,10g13.3) + 994 format(2i10,10g13.3) + + end subroutine setcld + + end module mo_setcld diff --git a/src/chemistry/mozart/mo_setext.F90 b/src/chemistry/mozart/mo_setext.F90 new file mode 100644 index 0000000000..13f7eef98a --- /dev/null +++ b/src/chemistry/mozart/mo_setext.F90 @@ -0,0 +1,332 @@ + +module mo_setext + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod,only : pi => shr_const_pi + use cam_logfile, only : iulog + + private + public :: setext_inti, setext, has_ions + + save + + integer :: co_ndx, no_ndx, synoz_ndx, xno_ndx, o_ndx + integer :: op_ndx, o2p_ndx, np_ndx, n2p_ndx, n2d_ndx, n_ndx, e_ndx, oh_ndx + logical :: has_ions = .false. + integer :: aoa_nh_ndx + + character(len=32) :: chempkg + +contains + + subroutine setext_inti + !-------------------------------------------------------- + ! ... Initialize the external forcing module + !-------------------------------------------------------- + + use mo_chem_utls, only : get_extfrc_ndx + use cam_history, only : addfld + use spmd_utils, only : masterproc + use phys_control, only : phys_getopts + + implicit none + + call phys_getopts( cam_chempkg_out = chempkg ) + + co_ndx = get_extfrc_ndx( 'CO' ) + no_ndx = get_extfrc_ndx( 'NO' ) + synoz_ndx = get_extfrc_ndx( 'SYNOZ' ) + xno_ndx = get_extfrc_ndx( 'XNO' ) + aoa_nh_ndx = get_extfrc_ndx('AOA_NH') + + op_ndx = get_extfrc_ndx( 'Op' ) + o2p_ndx = get_extfrc_ndx( 'O2p' ) + np_ndx = get_extfrc_ndx( 'Np' ) + n2p_ndx = get_extfrc_ndx( 'N2p' ) + n2d_ndx = get_extfrc_ndx( 'N2D' ) + n_ndx = get_extfrc_ndx( 'N' ) + e_ndx = get_extfrc_ndx( 'e' ) + oh_ndx = get_extfrc_ndx( 'OH' ) + o_ndx = get_extfrc_ndx( 'O' ) + + has_ions = op_ndx > 0 .and. o2p_ndx > 0 .and. np_ndx > 0 .and. n2p_ndx > 0 .and. e_ndx > 0 + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'setext_inti: diagnostics: co_ndx, no_ndx, synoz_ndx, xno_ndx' + write(iulog,'(10i5)') co_ndx, no_ndx, synoz_ndx, xno_ndx + endif + + call addfld( 'NO_Lightning', (/ 'lev' /), 'A','molec/cm3/s', 'lightning NO source' ) + call addfld( 'NO_Aircraft', (/ 'lev' /), 'A', 'molec/cm3/s', 'aircraft NO source' ) + call addfld( 'CO_Aircraft', (/ 'lev' /), 'A', 'molec/cm3/s', 'aircraft CO source' ) + + call addfld( 'EPP_ionpairs', (/ 'lev' /), 'A', 'pairs/cm3/s', 'EPP ionization forcing' ) + call addfld( 'GCR_ionpairs', (/ 'lev' /), 'A', 'pairs/cm3/s', 'GCR ionization forcing' ) + + if (index(chempkg,'waccm_mad')<1) then + if ( n2d_ndx > 0 .and. n_ndx>0 ) then + call addfld( 'N4S_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event N(4S) source' ) + call addfld( 'N2D_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event N(2D) source' ) + elseif ( no_ndx > 0 .and. n_ndx>0 ) then + call addfld( 'N4S_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event N(4S) source' ) + call addfld( 'NO_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event NO source' ) + endif + if ( oh_ndx > 0 ) then + call addfld( 'OH_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event OH source' ) + endif + endif + if ( has_ions ) then + call addfld( 'P_Op', (/ 'lev' /), 'I', '/s', 'production o+' ) + call addfld( 'P_O2p', (/ 'lev' /), 'I', '/s', 'production o2+' ) + call addfld( 'P_N2p', (/ 'lev' /), 'I', '/s', 'production n2+' ) + call addfld( 'P_Np', (/ 'lev' /), 'I', '/s', 'production n+' ) + call addfld( 'P_IONS', (/ 'lev' /), 'I', '/s', 'total ion production' ) + endif + + if ( aoa_nh_ndx > 0 ) then + call addfld('AOA_NH_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', 'external forcing for AOA_NH' ) + endif + + end subroutine setext_inti + + subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & + zmid, lchnk, tfld, o2mmr, ommr, & + pmid, mbar, rlats, calday, ncol, rlons, pbuf ) + !-------------------------------------------------------- + ! ... for this latitude slice: + ! - form the production from datasets + ! - form the nox (xnox) production from lighing + ! - form the nox (xnox) production from airplanes + ! - form the co production from airplanes + !-------------------------------------------------------- + + use cam_history, only : outfld + use ppgrid, only : pver, pcols + use mo_airplane, only : airpl_set + use chem_mods, only : extcnt + use mo_lightning, only : prod_no + + use mo_extfrc, only : extfrc_set + use chem_mods, only : extcnt + use tracer_srcs, only : num_tracer_srcs, tracer_src_flds, get_srcs_data + use mo_chem_utls, only : get_extfrc_ndx + use mo_synoz, only : po3 + + use mo_aurora, only : aurora + use gcr_ionization, only : gcr_ionization_ionpairs + use epp_ionization, only : epp_ionization_ionpairs + use spehox, only : hox_prod_factor + + use physics_buffer, only : physics_buffer_desc + + implicit none + + !-------------------------------------------------------- + ! ... dummy arguments + !-------------------------------------------------------- + !-------------------------------------------------------- + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: zint_abs(ncol,pver+1) ! interface geopot height ( km ) + real(r8), intent(in) :: zint_rel(ncol,pver+1) ! interface geopot height ( km ) + real(r8), intent(in) :: cldtop(ncol) ! cloud top index + real(r8), intent(out) :: extfrc(ncol,pver,extcnt) ! the "extraneous" forcing + + real(r8), intent(in) :: calday ! calendar day of year + real(r8), intent(in) :: rlats(ncol) ! column latitudes (radians) + real(r8), intent(in) :: rlons(ncol) ! column longitudes (radians) + real(r8), intent(in) :: zmid(ncol,pver) ! midpoint geopot height ( km ) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: mbar(ncol,pver) ! mean molecular mass (g/mole) + real(r8), intent(in) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg) + real(r8), intent(in) :: ommr(ncol,pver) ! o concentration (kg/kg) + + type(physics_buffer_desc),pointer :: pbuf(:) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: i, k, cldind + real(r8) :: srcs_offline( ncol, pver ) + integer :: ndx + + real(r8), dimension(ncol,pver) :: no_lgt + + real(r8) :: gcr_ipr(ncol,pver) ! ion pairs production rate associated with galactic comsic rays + real(r8) :: epp_ipr(ncol,pver) ! ion pairs production rate associated with energetic particles + real(r8) :: epp_hox(ncol,pver) ! HOx production rate associated with energetic particles + + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: xlat + + extfrc(:,:,:) = 0._r8 + + no_lgt(:,:) = 0._r8 + + !-------------------------------------------------------- + ! ... set frcing from datasets + !-------------------------------------------------------- + call extfrc_set( lchnk, zint_rel, extfrc, ncol ) + + !-------------------------------------------------------- + ! ... set nox production from lighting + ! note: from ground to cloud top production is c shaped + !-------------------------------------------------------- + if ( no_ndx > 0 ) then + do i = 1,ncol + cldind = nint( cldtop(i) ) + if( cldind < pver .and. cldind > 0 ) then + extfrc(i,cldind:pver,no_ndx) = extfrc(i,cldind:pver,no_ndx) & + + prod_no(i,cldind:pver,lchnk) + no_lgt(i,cldind:pver) = prod_no(i,cldind:pver,lchnk) + end if + end do + endif + if ( xno_ndx > 0 ) then + do i = 1,ncol + cldind = nint( cldtop(i) ) + if( cldind < pver .and. cldind > 0 ) then + extfrc(i,cldind:pver,xno_ndx) = extfrc(i,cldind:pver,xno_ndx) & + + prod_no(i,cldind:pver,lchnk) + end if + end do + endif + + call outfld( 'NO_Lightning', no_lgt(:ncol,:), ncol, lchnk ) + + call airpl_set( lchnk, ncol, no_ndx, co_ndx, xno_ndx, cldtop, zint_abs, extfrc) + + !--------------------------------------------------------------------- + ! ... synoz production + !--------------------------------------------------------------------- + if( synoz_ndx > 0 ) then + do k = 1,pver + extfrc(:ncol,k,synoz_ndx) = extfrc(:ncol,k,synoz_ndx) + po3(:ncol,k,lchnk) + end do + end if + + do i = 1,num_tracer_srcs + + ndx = get_extfrc_ndx( tracer_src_flds(i) ) + call get_srcs_data( tracer_src_flds(i), srcs_offline, ncol, lchnk, pbuf ) + do k = 1,pver + extfrc(:ncol,k,ndx) = extfrc(:ncol,k,ndx) + srcs_offline(:ncol,k) + enddo + + enddo + +! +! CCMI : external forcing for AOA_NH +! set to 100 ppb per year +! + if ( aoa_nh_ndx > 0 ) then + extfrc(:ncol,:,aoa_nh_ndx) = 1.e-7_r8/(86400._r8*365._r8) + do i=1,ncol + xlat = rlats(i)*rad2deg ! convert to degrees + if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + extfrc(i,pver,aoa_nh_ndx) = 0._r8 + end if + end do + call outfld('AOA_NH_XFRC',extfrc(:ncol,:,aoa_nh_ndx), ncol, lchnk ) + end if + + if ( has_ions ) then + !--------------------------------------------------------------------- + ! ... set ion auroral production + !--------------------------------------------------------------------- + + call aurora( tfld, o2mmr, ommr, mbar, rlats, & + extfrc(:,:,o2p_ndx), extfrc(:,:,op_ndx), extfrc(:,:,n2p_ndx), extfrc(:,:,np_ndx), pmid, & + lchnk, calday, ncol, rlons, pbuf ) + !--------------------------------------------------------------------- + ! ... set n(2d) and n(4s) auroral production + ! Stan Solomon HAO + ! include production of N by secondary auroral hot electrons (e_s*): + ! this is not a "real" reaction; instead, the production is parameterized in terms + ! of the production rate of N2+ by primary electrons, QN2P (which is in the model), + ! as follows: + !--------------------------------------------------------------------- + do k = 1,pver + extfrc(:,k,n2d_ndx) = 1.57_r8*.6_r8*extfrc(:,k,n2p_ndx) + extfrc(:,k,n_ndx) = 1.57_r8*.4_r8*extfrc(:,k,n2p_ndx) + end do + !--------------------------------------------------------------------- + ! ... set electron auroral production + !--------------------------------------------------------------------- + do k = 1,pver + extfrc(:,k,e_ndx) = extfrc(:,k,op_ndx) + extfrc(:,k,o2p_ndx) & + + extfrc(:,k,np_ndx) + extfrc(:,k,n2p_ndx) + end do + + call outfld( 'P_Op', extfrc(:,:,op_ndx), ncol, lchnk ) + call outfld( 'P_O2p', extfrc(:,:,o2p_ndx), ncol, lchnk ) + call outfld( 'P_Np', extfrc(:,:,np_ndx), ncol, lchnk ) + call outfld( 'P_N2p', extfrc(:,:,n2p_ndx), ncol, lchnk ) + call outfld( 'P_IONS',extfrc(:,:,n2d_ndx), ncol, lchnk ) + + endif + + !--------------------------------------------------------------------- + ! ... set SPE NOx and HOx production + ! Jackman et al., JGR, 2005 + ! production of 1.25 Nitrogen atoms/ion pair with branching ratios + ! of 0.55 N(4S) and 0.7 N(2D). + !--------------------------------------------------------------------- + !--------------------------------------------------------------------- + ! ion pairs production due to Galactic Cosmic Rays + !--------------------------------------------------------------------- + call gcr_ionization_ionpairs( ncol, lchnk, gcr_ipr ) + call outfld( 'GCR_ionpairs', gcr_ipr, ncol, lchnk ) + + !--------------------------------------------------------------------- + ! ion pairs production due to Energetic Particle Precipitation + !--------------------------------------------------------------------- + call epp_ionization_ionpairs( ncol, lchnk, pmid, tfld, epp_ipr ) + call outfld( 'EPP_ionpairs', epp_ipr, ncol, lchnk ) + + epp_ipr(:ncol,:pver) = epp_ipr(:ncol,:) + gcr_ipr(:ncol,:) + + if (index(chempkg,'waccm_mad')<1) then + ! D-region ion chemistry is NOT active + if ( n2d_ndx>0 .and. n_ndx>0 ) then + extfrc(:ncol,:pver,n2d_ndx) = extfrc(:ncol,:pver,n2d_ndx) + 0.7_r8*epp_ipr(:ncol,:pver) + extfrc(:ncol,:pver, n_ndx) = extfrc(:ncol,:pver, n_ndx) + 0.55_r8*epp_ipr(:ncol,:pver) + call outfld( 'N2D_EPP', 0.7_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! N(2D) produciton (molec/cm3/s) + call outfld( 'N4S_EPP',0.55_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! N(4S) produciton (molec/cm3/s) + elseif ( no_ndx>0 .and. n_ndx>0 ) then + ! for mechanisms that do not include N2D -- the EPP produce NO + extfrc(:ncol,:pver, no_ndx) = extfrc(:ncol,:pver, no_ndx) + 0.7_r8*epp_ipr(:ncol,:pver) + extfrc(:ncol,:pver, n_ndx) = extfrc(:ncol,:pver, n_ndx) + 0.55_r8*epp_ipr(:ncol,:pver) + call outfld( 'NO_EPP', 0.7_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! NO produciton (molec/cm3/s) + call outfld( 'N4S_EPP',0.55_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! N(4S) produciton (molec/cm3/s) + endif + if ( oh_ndx > 0 ) then + do i = 1,ncol + epp_hox(i,:pver) = epp_ipr(i,:pver)*hox_prod_factor( epp_ipr(i,:pver), zmid(i,:pver) ) + end do + extfrc(:ncol,:pver, oh_ndx) = extfrc(:ncol,:pver, oh_ndx) + epp_hox(:ncol,:pver) + call outfld( 'OH_EPP' , epp_hox(:ncol,:), ncol, lchnk ) ! HOX produciton (molec/cm3/s) + endif + else + ! D-region ion chemistry is active ... + ! N2p production + extfrc(:ncol,:pver,n2p_ndx) = extfrc(:ncol,:pver,n2p_ndx) + 0.585_r8 * epp_ipr(:ncol,:pver) + ! O2p production + extfrc(:ncol,:pver,o2p_ndx) = extfrc(:ncol,:pver,o2p_ndx) + 0.15_r8 * epp_ipr(:ncol,:pver) + ! Np + extfrc(:ncol,:pver,np_ndx) = extfrc(:ncol,:pver,np_ndx) + 0.185_r8 * epp_ipr(:ncol,:pver) + ! Op + extfrc(:ncol,:pver,op_ndx) = extfrc(:ncol,:pver,op_ndx) + 0.076_r8 * epp_ipr(:ncol,:pver) + ! N2D/N4S branching + ! new initial rates + extfrc(:ncol,:pver,n2d_ndx) = extfrc(:ncol,:pver,n2d_ndx) + 0.583_r8 * epp_ipr(:ncol,:pver) + extfrc(:ncol,:pver,n_ndx) = extfrc(:ncol,:pver,n_ndx) + 0.502_r8 * epp_ipr(:ncol,:pver) + ! O + extfrc(:ncol,:pver,o_ndx) = extfrc(:ncol,:pver,o_ndx) + 1.074_r8 * epp_ipr(:ncol,:pver) + endif + + end subroutine setext + +end module mo_setext diff --git a/src/chemistry/mozart/mo_sethet.F90 b/src/chemistry/mozart/mo_sethet.F90 new file mode 100644 index 0000000000..455543d4a6 --- /dev/null +++ b/src/chemistry/mozart/mo_sethet.F90 @@ -0,0 +1,884 @@ + +module mo_sethet + +! +! LKE (10/11/2010): added HCN, CH3CN, HCOOH to cesm1_0_beta07_offline version +! HCN, CH3CN have new Henry's Law coefficients, HCOOH is set to CH3COOH +! LKE (10/18/2010): SO2 washout corrected based on recommendation of R.Easter, PNNL +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use gas_wetdep_opts, only: gas_wetdep_cnt, gas_wetdep_method, gas_wetdep_list + use phys_control, only: phys_getopts + + private + public :: sethet_inti, sethet + + save + + integer :: h2o2_ndx, hno3_ndx, ch2o_ndx, ch3ooh_ndx, ch3coooh_ndx, & + ho2no2_ndx, ch3cocho_ndx, xooh_ndx, onitr_ndx, glyald_ndx, & + ch3cho_ndx, mvk_ndx, macr_ndx, pooh_ndx, c2h5ooh_ndx, & + c3h7ooh_ndx, rooh_ndx, isopno3_ndx, onit_ndx, Pb_ndx, & + macrooh_ndx, isopooh_ndx, ch3oh_ndx, c2h5oh_ndx, hyac_ndx, hydrald_ndx + integer :: spc_h2o2_ndx, spc_hno3_ndx + integer :: spc_so2_ndx + integer :: spc_sogm_ndx, spc_sogi_ndx, spc_sogt_ndx, spc_sogb_ndx, spc_sogx_ndx + + integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx + integer :: so2_ndx, soa_ndx, so4_ndx, cb2_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, & + sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx, h2so4_ndx + integer :: xisopno3_ndx,xho2no2_ndx,xonitr_ndx,xhno3_ndx,xonit_ndx + integer :: clono2_ndx, brono2_ndx, hcl_ndx, n2o5_ndx, hocl_ndx, hobr_ndx, hbr_ndx + integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx + integer, allocatable :: wetdep_map(:) + integer :: sogm_ndx, sogi_ndx, sogt_ndx, sogb_ndx, sogx_ndx + logical :: do_wetdep + + ! prognostic modal aerosols + logical :: prog_modal_aero + +contains + + subroutine sethet_inti + !----------------------------------------------------------------------- + ! ... intialize the wet removal rate constants routine + !----------------------------------------------------------------------- + + use mo_chem_utls, only : get_het_ndx, get_spc_ndx + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + + integer :: k, m + + do_wetdep = gas_wetdep_cnt>0 .and. gas_wetdep_method=='MOZ' + if ( .not. do_wetdep) return + + call phys_getopts( prog_modal_aero_out = prog_modal_aero ) + + allocate( wetdep_map(gas_wetdep_cnt)) + + do k=1,gas_wetdep_cnt + m = get_het_ndx( trim(gas_wetdep_list(k))) + if (m>0) then + wetdep_map(k) = m + else + call endrun('sethet_inti: cannot map '//trim(gas_wetdep_list(k))) + endif + enddo + + xisopno3_ndx = get_het_ndx( 'XISOPNO3' ) + xho2no2_ndx = get_het_ndx( 'XHO2NO2' ) + xonitr_ndx = get_het_ndx( 'XONITR' ) + xhno3_ndx = get_het_ndx( 'XHNO3' ) + xonit_ndx = get_het_ndx( 'XONIT' ) + + spc_h2o2_ndx = get_spc_ndx( 'H2O2' ) + spc_hno3_ndx = get_spc_ndx( 'HNO3' ) + spc_so2_ndx = get_spc_ndx( 'SO2' ) + + clono2_ndx = get_het_ndx( 'CLONO2' ) + brono2_ndx = get_het_ndx( 'BRONO2' ) + hcl_ndx = get_het_ndx( 'HCL' ) + n2o5_ndx = get_het_ndx( 'N2O5' ) + hocl_ndx = get_het_ndx( 'HOCL' ) + hobr_ndx = get_het_ndx( 'HOBR' ) + hbr_ndx = get_het_ndx( 'HBR' ) + + h2o2_ndx = get_het_ndx( 'H2O2' ) + hno3_ndx = get_het_ndx( 'HNO3' ) + ch2o_ndx = get_het_ndx( 'CH2O' ) + ch3ooh_ndx = get_het_ndx( 'CH3OOH' ) + ch3coooh_ndx = get_het_ndx( 'CH3COOOH' ) + ho2no2_ndx = get_het_ndx( 'HO2NO2' ) + ch3cocho_ndx = get_het_ndx( 'CH3COCHO' ) + xooh_ndx = get_het_ndx( 'XOOH' ) + onitr_ndx = get_het_ndx( 'ONITR' ) + glyald_ndx = get_het_ndx( 'GLYALD' ) + ch3cho_ndx = get_het_ndx( 'CH3CHO' ) + mvk_ndx = get_het_ndx( 'MVK' ) + macr_ndx = get_het_ndx( 'MACR' ) + pooh_ndx = get_het_ndx( 'POOH' ) + c2h5ooh_ndx = get_het_ndx( 'C2H5OOH' ) + c3h7ooh_ndx = get_het_ndx( 'C3H7OOH' ) + rooh_ndx = get_het_ndx( 'ROOH' ) + isopno3_ndx = get_het_ndx( 'ISOPNO3' ) + onit_ndx = get_het_ndx( 'ONIT' ) + Pb_ndx = get_het_ndx( 'Pb' ) + macrooh_ndx = get_het_ndx( 'MACROOH' ) + isopooh_ndx = get_het_ndx( 'ISOPOOH' ) + ch3oh_ndx = get_het_ndx( 'CH3OH' ) + c2h5oh_ndx = get_het_ndx( 'C2H5OH' ) + hyac_ndx = get_het_ndx( 'HYAC' ) + hydrald_ndx = get_het_ndx( 'HYDRALD' ) + alkooh_ndx = get_het_ndx( 'ALKOOH' ) + mekooh_ndx = get_het_ndx( 'MEKOOH' ) + tolooh_ndx = get_het_ndx( 'TOLOOH' ) + terpooh_ndx = get_het_ndx( 'TERPOOH' ) + ch3cooh_ndx = get_het_ndx( 'CH3COOH' ) + so2_ndx = get_het_ndx( 'SO2' ) + soa_ndx = get_het_ndx( 'SOA' ) + sogb_ndx = get_het_ndx( 'SOGB' ) + sogi_ndx = get_het_ndx( 'SOGI' ) + sogm_ndx = get_het_ndx( 'SOGM' ) + sogt_ndx = get_het_ndx( 'SOGT' ) + sogx_ndx = get_het_ndx( 'SOGX' ) + so4_ndx = get_het_ndx( 'SO4' ) + cb2_ndx = get_het_ndx( 'CB2' ) + oc2_ndx = get_het_ndx( 'OC2' ) + nh3_ndx = get_het_ndx( 'NH3' ) + nh4no3_ndx = get_het_ndx( 'NH4NO3' ) + nh4_ndx = get_het_ndx( 'NH4' ) + h2so4_ndx = get_het_ndx( 'H2SO4' ) + sa1_ndx = get_het_ndx( 'SA1' ) + sa2_ndx = get_het_ndx( 'SA2' ) + sa3_ndx = get_het_ndx( 'SA3' ) + sa4_ndx = get_het_ndx( 'SA4' ) + ch3cn_ndx = get_het_ndx( 'CH3CN' ) + hcn_ndx = get_het_ndx( 'HCN' ) + hcooh_ndx = get_het_ndx( 'HCOOH' ) + + if (masterproc) then + write(iulog,*) 'sethet_inti: new ndx ',so2_ndx,soa_ndx,so4_ndx,cb2_ndx,oc2_ndx, & + nh3_ndx,nh4no3_ndx,sa1_ndx,sa2_ndx,sa3_ndx,sa4_ndx + write(iulog,*) ' ' + write(iulog,*) 'sethet_inti: diagnotics ' + write(iulog,'(10i5)') h2o2_ndx, hno3_ndx, ch2o_ndx, ch3ooh_ndx, ch3coooh_ndx, & + ho2no2_ndx, ch3cocho_ndx, xooh_ndx, onitr_ndx, glyald_ndx, & + ch3cho_ndx, mvk_ndx, macr_ndx, pooh_ndx, c2h5ooh_ndx, & + c3h7ooh_ndx, rooh_ndx, isopno3_ndx, onit_ndx, Pb_ndx, & + macrooh_ndx, isopooh_ndx, ch3oh_ndx, c2h5oh_ndx, hyac_ndx, hydrald_ndx + endif + + end subroutine sethet_inti + + subroutine sethet( het_rates, press, zmid, phis, tfld, & + cmfdqr, nrain, nevapr, delt, xhnm, & + qin, ncol, lchnk ) + !----------------------------------------------------------------------- + ! ... compute rainout loss rates (1/s) + !----------------------------------------------------------------------- + + use physconst, only : rga,pi + use chem_mods, only : gas_pcnst + use ppgrid, only : pver, pcols + use phys_grid, only : get_rlat_all_p + use cam_abortutils, only : endrun + use mo_constants, only : avo => avogadro, boltz_cgs + + implicit none + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: delt ! time step ( s ) + real(r8), intent(in) :: press(pcols,pver) ! pressure in pascals + real(r8), intent(in) :: cmfdqr(ncol,pver) ! dq/dt for convection + real(r8), intent(in) :: nrain(ncol,pver) ! stratoform precip + real(r8), intent(in) :: nevapr(ncol,pver) ! evaporation + real(r8), intent(in) :: qin(ncol,pver,gas_pcnst) ! xported species ( vmr ) + real(r8), intent(in) :: zmid(ncol,pver) ! midpoint geopot (km) + real(r8), intent(in) :: phis(pcols) ! surf geopot + real(r8), intent(in) :: tfld(pcols,pver) ! temperature (k) + real(r8), intent(in) :: xhnm(ncol,pver) ! total atms density ( /cm^3) + real(r8), intent(out) :: het_rates(ncol,pver,gas_pcnst) ! rainout loss rates + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + real(r8), parameter :: xrm = .189_r8 ! mean diameter of rain drop (cm) + real(r8), parameter :: xum = 748._r8 ! mean rain drop terminal velocity (cm/s) + real(r8), parameter :: xvv = 6.18e-2_r8 ! kinetic viscosity (cm^2/s) + real(r8), parameter :: xdg = .112_r8 ! mass transport coefficient (cm/s) + real(r8), parameter :: t0 = 298._r8 ! reference temperature (k) + real(r8), parameter :: xph0 = 1.e-5_r8 ! cloud [h+] + real(r8), parameter :: satf_hno3 = .016_r8 ! saturation factor for hno3 in clouds + real(r8), parameter :: satf_h2o2 = .016_r8 ! saturation factor for h2o2 in clouds + real(r8), parameter :: satf_so2 = .016_r8 ! saturation factor for so2 in clouds + real(r8), parameter :: satf_ch2o = .1_r8 ! saturation factor for ch2o in clouds + real(r8), parameter :: satf_sog = .016_r8 ! saturation factor for sog in clouds + real(r8), parameter :: const0 = boltz_cgs * 1.e-6_r8 ! (atmospheres/deg k/cm^3) + real(r8), parameter :: hno3_diss = 15.4_r8 ! hno3 dissociation constant + real(r8), parameter :: geo_fac = 6._r8 ! geometry factor (surf area/volume = geo_fac/diameter) + real(r8), parameter :: mass_air = 29._r8 ! mass of background atmosphere (amu) + real(r8), parameter :: mass_h2o = 18._r8 ! mass of water vapor (amu) + real(r8), parameter :: h2o_mol = 1.e3_r8/mass_h2o ! (gm/mol water) + real(r8), parameter :: km2cm = 1.e5_r8 ! convert km to cm + real(r8), parameter :: m2km = 1.e-3_r8 ! convert m to km + real(r8), parameter :: cm3_2_m3 = 1.e-6_r8 ! convert cm^3 to m^3 + real(r8), parameter :: m3_2_cm3 = 1.e6_r8 ! convert m^3 to cm^3 + real(r8), parameter :: liter_per_gram = 1.e-3_r8 + real(r8), parameter :: avo2 = avo * liter_per_gram * cm3_2_m3 ! (liter/gm/mol*(m/cm)^3) + + integer :: i, m, k, kk ! indicies + real(r8) :: xkgm ! mass flux on rain drop + real(r8) :: all1, all2 ! work variables + real(r8) :: stay ! fraction of layer traversed by falling drop in timestep delt + real(r8) :: xeqca1, xeqca2, xca1, xca2, xdtm + real(r8) :: xxx1, xxx2, yhno3, yh2o2 + real(r8) :: all3, xeqca3, xca3, xxx3, yso2, so2_diss + real(r8) :: all4, xeqca4, xca4, xxx4 + real(r8) :: all5, xeqca5, xca5, xxx5 + real(r8) :: all6, xeqca6, xca6, xxx6 + real(r8) :: all7, xeqca7, xca7, xxx7 + real(r8) :: all8, xeqca8, xca8, xxx8 + real(r8) :: ysogm,ysogi,ysogt,ysogb,ysogx + + real(r8), dimension(ncol) :: & + xk0, work1, work2, work3, zsurf + real(r8), dimension(pver) :: & + xgas1, xgas2 + real(r8), dimension(pver) :: xgas3, xgas4, xgas5, xgas6, xgas7, xgas8 + real(r8), dimension(ncol) :: & + tmp0_rates, tmp1_rates + real(r8), dimension(ncol,pver) :: & + delz, & ! layer depth about interfaces (cm) + xhno3, & ! hno3 concentration (molecules/cm^3) + xh2o2, & ! h2o2 concentration (molecules/cm^3) + xso2, & ! so2 concentration (molecules/cm^3) + xsogm, & ! sogm concentration (molecules/cm^3) + xsogi, & ! sogi concentration (molecules/cm^3) + xsogt, & ! sogt concentration (molecules/cm^3) + xsogb, & ! sogb concentration (molecules/cm^3) + xsogx, & ! sogx concentration (molecules/cm^3) + xliq, & ! liquid rain water content in a grid cell (gm/m^3) + rain ! conversion rate of water vapor into rain water (molecules/cm^3/s) + real(r8), dimension(ncol,pver) :: & + xhen_hno3, xhen_h2o2, xhen_ch2o, xhen_ch3ooh, xhen_ch3co3h, & + xhen_ch3cocho, xhen_xooh, xhen_onitr, xhen_ho2no2, xhen_glyald, & + xhen_ch3cho, xhen_mvk, xhen_macr,xhen_sog + real(r8), dimension(ncol,pver) :: & + xhen_nh3, xhen_ch3cooh + real(r8), dimension(ncol,pver,8) :: tmp_hetrates + real(r8), dimension(ncol,pver) :: precip + real(r8), dimension(ncol,pver) :: xhen_hcn, xhen_ch3cn, xhen_so2 + + integer :: ktop_all + integer :: ktop(ncol) ! 100 mb level + + real(r8) :: rlat(pcols) ! latitude in radians for columns + real(r8) :: p_limit + real(r8), parameter :: d2r = pi/180._r8 +! +! jfl : new variables for rescaling sum of positive values to actual amount +! + real(r8) :: total_rain,total_pos + character(len=3) :: hetratestrg + real(r8), parameter :: MISSING = -999999._r8 + integer :: mm + +! + !----------------------------------------------------------------- + ! note: the press array is in pascals and must be + ! mutiplied by 10 to yield dynes/cm**2. + !----------------------------------------------------------------- + ! ... set wet deposition for + ! 1. h2o2 2. hno3 + ! 3. ch2o 4. ch3ooh + ! 5. pooh 6. ch3coooh + ! 7. ho2no2 8. onit + ! 9. mvk 10. macr + ! 11. c2h5ooh 12. c3h7ooh + ! 13. rooh 14. ch3cocho + ! 15. pb 16. macrooh + ! 17. xooh 18. onitr + ! 19. isopooh 20. ch3oh + ! 21. c2h5oh 22. glyald + ! 23. hyac 24. hydrald + ! 25. ch3cho 26. isopno3 + !----------------------------------------------------------------- + + het_rates(:,:,:) = 0._r8 + + if ( .not. do_wetdep) return + + call get_rlat_all_p(lchnk, ncol, rlat) + + do mm = 1,gas_wetdep_cnt + m = wetdep_map(mm) + if ( m>0 ) then + het_rates(:,:,m) = MISSING + endif + end do + + !----------------------------------------------------------------- + ! ... the 2 and .6 multipliers are from a formula by frossling (1938) + !----------------------------------------------------------------- + xkgm = xdg/xrm * 2._r8 + xdg/xrm * .6_r8 * sqrt( xrm*xum/xvv ) * (xvv/xdg)**(1._r8/3._r8) + + !----------------------------------------------------------------- + ! ... Find 100 mb level + !----------------------------------------------------------------- + do i = 1,ncol + if ( abs(rlat(i)) > 60._r8*d2r ) then + p_limit = 300.e2_r8 + else + p_limit = 100.e2_r8 + endif + k_loop: do k = pver,1,-1 + if( press(i,k) < p_limit ) then + ktop(i) = k + exit k_loop + end if + end do k_loop + end do + ktop_all = minval( ktop(:) ) +! +! jfl +! +! this is added to rescale the variable precip (which can only be positive) +! to the actual vertical integral of positive and negative values. This +! removes point storms +! + do i = 1,ncol + total_rain = 0._r8 + total_pos = 0._r8 + do k = 1,pver + precip(i,k) = cmfdqr(i,k) + nrain(i,k) - nevapr(i,k) + total_rain = total_rain + precip(i,k) + if ( precip(i,k) < 0._r8 ) precip(i,k) = 0._r8 + total_pos = total_pos + precip(i,k) + end do + if ( total_rain <= 0._r8 ) then + precip(i,:) = 0._r8 + else + do k = 1,pver + precip(i,k) = precip(i,k) * total_rain/total_pos + end do + end if + end do + + do k = 1,pver + !jfl precip(:ncol,k) = cmfdqr(:ncol,k) + nrain(:ncol,k) - nevapr(:ncol,k) + rain(:ncol,k) = mass_air*precip(:ncol,k)*xhnm(:ncol,k) / mass_h2o + xliq(:ncol,k) = precip(:ncol,k) * delt * xhnm(:ncol,k) / avo*mass_air * m3_2_cm3 + if( spc_hno3_ndx > 0 ) then + xhno3(:ncol,k) = qin(:ncol,k,spc_hno3_ndx) * xhnm(:ncol,k) + else + xhno3(:ncol,k) = 0._r8 + end if + if( spc_h2o2_ndx > 0 ) then + xh2o2(:ncol,k) = qin(:ncol,k,spc_h2o2_ndx) * xhnm(:ncol,k) + else + xh2o2(:ncol,k) = 0._r8 + end if + if( spc_sogm_ndx > 0 ) then + xsogm(:ncol,k) = qin(:ncol,k,spc_sogm_ndx) * xhnm(:ncol,k) + else + xsogm(:ncol,k) = 0._r8 + end if + if( spc_sogi_ndx > 0 ) then + xsogi(:ncol,k) = qin(:ncol,k,spc_sogi_ndx) * xhnm(:ncol,k) + else + xsogi(:ncol,k) = 0._r8 + end if + if( spc_sogt_ndx > 0 ) then + xsogt(:ncol,k) = qin(:ncol,k,spc_sogt_ndx) * xhnm(:ncol,k) + else + xsogt(:ncol,k) = 0._r8 + end if + if( spc_sogb_ndx > 0 ) then + xsogb(:ncol,k) = qin(:ncol,k,spc_sogb_ndx) * xhnm(:ncol,k) + else + xsogb(:ncol,k) = 0._r8 + end if + if( spc_sogx_ndx > 0 ) then + xsogx(:ncol,k) = qin(:ncol,k,spc_sogx_ndx) * xhnm(:ncol,k) + else + xsogx(:ncol,k) = 0._r8 + end if + if( spc_so2_ndx > 0 ) then + xso2(:ncol,k) = qin(:ncol,k,spc_so2_ndx) * xhnm(:ncol,k) + else + xso2(:ncol,k) = 0._r8 + end if + end do + + zsurf(:ncol) = m2km * phis(:ncol) * rga + do k = ktop_all,pver-1 + delz(:ncol,k) = abs( (zmid(:ncol,k) - zmid(:ncol,k+1))*km2cm ) + end do + delz(:ncol,pver) = abs( (zmid(:ncol,pver) - zsurf(:ncol) )*km2cm ) + + !----------------------------------------------------------------- + ! ... part 0b, for temperature dependent of henrys + ! xxhe1 = henry con for hno3 + ! xxhe2 = henry con for h2o2 + !lwh 10/00 -- take henry''s law constants from brasseur et al. [1999], + ! appendix j. for hno3, also consider dissociation to + ! get effective henry''s law constant; equilibrium + ! constant for dissociation from brasseur et al. [1999], + ! appendix k. assume ph=5 (set as xph0 above). + ! heff = h*k/[h+] for hno3 (complete dissociation) + ! heff = h for h2o2 (no dissociation) + ! heff = h * (1 + k/[h+]) (in general) + !----------------------------------------------------------------- + do k = ktop_all,pver + work1(:ncol) = (t0 - tfld(:ncol,k))/(t0*tfld(:ncol,k)) + !----------------------------------------------------------------- + ! ... effective henry''s law constants: + ! hno3, h2o2, ch2o, ch3ooh, ch3coooh (brasseur et al., 1999) + ! xooh, onitr, macrooh (j.-f. muller; brocheton, 1999) + ! isopooh (equal to hno3, as for macrooh) + ! ho2no2 (mozart-1) + ! ch3cocho, hoch2cho (betterton and hoffman, environ. sci. technol., 1988) + ! ch3cho (staudinger and roberts, crit. rev. sci. technol., 1996) + ! mvk, macr (allen et al., environ. toxicol. chem., 1998) + ! soag_bg(0-4), soag_ff_bb(0-4) (Hodzic et al., 2014) + !----------------------------------------------------------------- + xk0(:) = 2.1e5_r8 *exp( 8700._r8*work1(:) ) + xhen_hno3(:,k) = xk0(:) * ( 1._r8 + hno3_diss / xph0 ) + xhen_h2o2(:,k) = 7.45e4_r8 * exp( 6620._r8 * work1(:) ) + xhen_ch2o(:,k) = 6.3e3_r8 * exp( 6460._r8 * work1(:) ) + xhen_ch3ooh(:,k) = 2.27e2_r8 * exp( 5610._r8 * work1(:) ) + xhen_ch3co3h(:,k) = 4.73e2_r8 * exp( 6170._r8 * work1(:) ) + xhen_ch3cocho(:,k) = 3.70e3_r8 * exp( 7275._r8 * work1(:) ) + xhen_xooh(:,k) = 90.5_r8 * exp( 5607._r8 * work1(:) ) + xhen_onitr(:,k) = 7.51e3_r8 * exp( 6485._r8 * work1(:) ) + xhen_ho2no2(:,k) = 2.e4_r8 + xhen_glyald(:,k) = 4.1e4_r8 * exp( 4600._r8 * work1(:) ) + xhen_ch3cho(:,k) = 1.4e1_r8 * exp( 5600._r8 * work1(:) ) + xhen_mvk(:,k) = 21._r8 * exp( 7800._r8 * work1(:) ) + xhen_macr(:,k) = 4.3_r8 * exp( 5300._r8 * work1(:) ) + xhen_ch3cooh(:,k) = 4.1e3_r8 * exp( 6300._r8 * work1(:) ) + xhen_sog(:,k) = 5.e5_r8 * exp (12._r8 * work1(:) ) + ! + ! calculation for NH3 using the parameters in drydep_tables.F90 + ! + xhen_nh3 (:,k) = 1.e6_r8 + xhen_ch3cn(:,k) = 50._r8 * exp( 4000._r8 * work1(:) ) + xhen_hcn(:,k) = 12._r8 * exp( 5000._r8 * work1(:) ) + do i = 1, ncol + so2_diss = 1.23e-2_r8 * exp( 1960._r8 * work1(i) ) + xhen_so2(i,k) = 1.23_r8 * exp( 3120._r8 * work1(i) ) * ( 1._r8 + so2_diss / xph0 ) + end do + ! + tmp_hetrates(:,k,:) = 0._r8 + end do + + !----------------------------------------------------------------- + ! ... part 1, solve for high henry constant ( hno3, h2o2) + !----------------------------------------------------------------- + col_loop : do i = 1,ncol + xgas1(:) = xhno3(i,:) ! xgas will change during + xgas2(:) = xh2o2(i,:) ! different levels wash + xgas3(:) = xso2 (i,:) + xgas4(:) = xsogm(i,:) + xgas5(:) = xsogi(i,:) + xgas6(:) = xsogt(i,:) + xgas7(:) = xsogb(i,:) + xgas8(:) = xsogx(i,:) + level_loop1 : do kk = ktop(i),pver + stay = 1._r8 + if( rain(i,kk) /= 0._r8 ) then ! finding rain cloud + all1 = 0._r8 ! accumulation to justisfy saturation + all2 = 0._r8 + all3 = 0._r8 + all4 = 0._r8 + all5 = 0._r8 + all6 = 0._r8 + all7 = 0._r8 + all8 = 0._r8 + stay = ((zmid(i,kk) - zsurf(i))*km2cm)/(xum*delt) + stay = min( stay,1._r8 ) + !----------------------------------------------------------------- + ! ... calculate the saturation concentration eqca + !----------------------------------------------------------------- + do k = kk,pver ! cal washout below cloud + xeqca1 = xgas1(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_hno3(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca2 = xgas2(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_h2o2(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca3 = xgas3(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_so2( i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca4 = xgas4(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_sog(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca5 = xgas5(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_sog(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca6 = xgas6(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_sog(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca7 = xgas7(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_sog(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + xeqca8 = xgas8(k) & + / (xliq(i,kk)*avo2 + 1._r8/(xhen_sog(i,k)*const0*tfld(i,k))) & + * xliq(i,kk)*avo2 + + !----------------------------------------------------------------- + ! ... calculate ca; inside cloud concentration in #/cm3(air) + !----------------------------------------------------------------- + xca1 = geo_fac*xkgm*xgas1(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca2 = geo_fac*xkgm*xgas2(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca3 = geo_fac*xkgm*xgas3(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca4 = geo_fac*xkgm*xgas4(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca5 = geo_fac*xkgm*xgas5(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca6 = geo_fac*xkgm*xgas6(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca7 = geo_fac*xkgm*xgas7(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + xca8 = geo_fac*xkgm*xgas8(k)/(xrm*xum)*delz(i,k) * xliq(i,kk) * cm3_2_m3 + + !----------------------------------------------------------------- + ! ... if is not saturated + ! hno3(gas)_new = hno3(gas)_old - hno3(h2o) + ! otherwise + ! hno3(gas)_new = hno3(gas)_old + !----------------------------------------------------------------- + all1 = all1 + xca1 + all2 = all2 + xca2 + if( all1 < xeqca1 ) then + xgas1(k) = max( xgas1(k) - xca1,0._r8 ) + end if + if( all2 < xeqca2 ) then + xgas2(k) = max( xgas2(k) - xca2,0._r8 ) + end if + all3 = all3 + xca3 + if( all3 < xeqca3 ) then + xgas3(k) = max( xgas3(k) - xca3,0._r8 ) + end if + all4 = all4 + xca4 + all5 = all5 + xca5 + all6 = all6 + xca6 + all7 = all7 + xca7 + all8 = all8 + xca8 + if( all4 < xeqca4 ) then + xgas4(k) = max( xgas4(k) - xca4,0._r8 ) + end if + if( all5 < xeqca5 ) then + xgas5(k) = max( xgas5(k) - xca5,0._r8 ) + end if + if( all6 < xeqca6 ) then + xgas6(k) = max( xgas6(k) - xca6,0._r8 ) + end if + if( all7 < xeqca7 ) then + xgas7(k) = max( xgas7(k) - xca7,0._r8 ) + end if + if( all8 < xeqca8 ) then + xgas8(k) = max( xgas8(k) - xca8,0._r8 ) + end if + end do + end if + !----------------------------------------------------------------- + ! ... calculate the lifetime of washout (second) + ! after all layers washout + ! the concentration of hno3 is reduced + ! then the lifetime xtt is calculated by + ! + ! xtt = (xhno3(ini) - xgas1(new))/(dt*xhno3(ini)) + ! where dt = passing time (s) in vertical + ! path below the cloud + ! dt = dz(cm)/um(cm/s) + !----------------------------------------------------------------- + xdtm = delz(i,kk) / xum ! the traveling time in each dz + xxx1 = (xhno3(i,kk) - xgas1(kk)) + xxx2 = (xh2o2(i,kk) - xgas2(kk)) + if( xxx1 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + yhno3 = xhno3(i,kk)/xxx1 * xdtm + else + yhno3 = 1.e29_r8 + end if + if( xxx2 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + yh2o2 = xh2o2(i,kk)/xxx2 * xdtm + else + yh2o2 = 1.e29_r8 + end if + tmp_hetrates(i,kk,1) = max( 1._r8 / yh2o2,0._r8 ) * stay + tmp_hetrates(i,kk,2) = max( 1._r8 / yhno3,0._r8 ) * stay + xxx3 = (xso2( i,kk) - xgas3(kk)) + if( xxx3 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + yso2 = xso2( i,kk)/xxx3 * xdtm + else + yso2 = 1.e29_r8 + end if + tmp_hetrates(i,kk,3) = max( 1._r8 / yso2, 0._r8 ) * stay + xxx4 = (xsogm(i,kk) - xgas4(kk)) + xxx5 = (xsogi(i,kk) - xgas5(kk)) + xxx6 = (xsogt(i,kk) - xgas6(kk)) + xxx7 = (xsogb(i,kk) - xgas7(kk)) + xxx8 = (xsogx(i,kk) - xgas8(kk)) + if( xxx4 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + ysogm = xsogm(i,kk)/xxx4 * xdtm + else + ysogm = 1.e29_r8 + end if + if( xxx5 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + ysogi = xsogi(i,kk)/xxx5 * xdtm + else + ysogi = 1.e29_r8 + end if + if( xxx6 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + ysogt = xsogt(i,kk)/xxx6 * xdtm + else + ysogt = 1.e29_r8 + end if + if( xxx7 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + ysogb = xsogb(i,kk)/xxx7 * xdtm + else + ysogb = 1.e29_r8 + end if + if( xxx8 /= 0._r8 ) then ! if no washout lifetime = 1.e29 + ysogx = xsogx(i,kk)/xxx8 * xdtm + else + ysogx = 1.e29_r8 + end if + tmp_hetrates(i,kk,4) = max( 1._r8 / ysogm,0._r8 ) * stay + tmp_hetrates(i,kk,5) = max( 1._r8 / ysogi,0._r8 ) * stay + tmp_hetrates(i,kk,6) = max( 1._r8 / ysogt,0._r8 ) * stay + tmp_hetrates(i,kk,7) = max( 1._r8 / ysogb,0._r8 ) * stay + tmp_hetrates(i,kk,8) = max( 1._r8 / ysogx,0._r8 ) * stay + end do level_loop1 + end do col_loop + + !----------------------------------------------------------------- + ! ... part 2, in-cloud solve for low henry constant + ! hno3 and h2o2 have both in and under cloud + !----------------------------------------------------------------- + level_loop2 : do k = ktop_all,pver + Column_loop2 : do i=1,ncol + if ( rain(i,k) <= 0._r8 ) then + het_rates(i,k,:) = 0._r8 + cycle + endif + + work1(i) = avo2 * xliq(i,k) + work2(i) = const0 * tfld(i,k) + work3(i) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch2o(i,k)*work2(i)))),0._r8 ) & + * satf_ch2o + if( ch2o_ndx > 0 ) then + het_rates(i,k,ch2o_ndx) = work3(i) + end if + if( isopno3_ndx > 0 ) then + het_rates(i,k,isopno3_ndx) = work3(i) + end if + if( xisopno3_ndx > 0 ) then + het_rates(i,k,xisopno3_ndx) = work3(i) + end if + if( hyac_ndx > 0 ) then + het_rates(i,k,hyac_ndx) = work3(i) + end if + if( hydrald_ndx > 0 ) then + het_rates(i,k,hydrald_ndx) = work3(i) + end if + + work3(i) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3ooh(i,k)*work2(i)))),0._r8 ) + if( ch3ooh_ndx > 0 ) then + het_rates(i,k,ch3ooh_ndx) = work3(i) + end if + if( pooh_ndx > 0 ) then + het_rates(i,k,pooh_ndx) = work3(i) + end if + if( c2h5ooh_ndx > 0 ) then + het_rates(i,k,c2h5ooh_ndx) = work3(i) + end if + if( c3h7ooh_ndx > 0 ) then + het_rates(i,k,c3h7ooh_ndx) = work3(i) + end if + if( rooh_ndx > 0 ) then + het_rates(i,k,rooh_ndx) = work3(i) + end if + if( ch3oh_ndx > 0 ) then + het_rates(i,k,ch3oh_ndx) = work3(i) + end if + if( c2h5oh_ndx > 0 ) then + het_rates(i,k,c2h5oh_ndx) = work3(i) + end if + if( alkooh_ndx > 0 ) then + het_rates(i,k,alkooh_ndx) = work3(i) + end if + if( mekooh_ndx > 0 ) then + het_rates(i,k,mekooh_ndx) = work3(i) + end if + if( tolooh_ndx > 0 ) then + het_rates(i,k,tolooh_ndx) = work3(i) + end if + if( terpooh_ndx > 0 ) then + het_rates(i,k,terpooh_ndx) = work3(i) + end if + + if( ch3coooh_ndx > 0 ) then + het_rates(i,k,ch3coooh_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3co3h(i,k)*work2(i)))),0._r8 ) + end if + if( ho2no2_ndx > 0 ) then + het_rates(i,k,ho2no2_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ho2no2(i,k)*work2(i)))),0._r8 ) + end if + if( xho2no2_ndx > 0 ) then + het_rates(i,k,xho2no2_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ho2no2(i,k)*work2(i)))),0._r8 ) + end if + if( ch3cocho_ndx > 0 ) then + het_rates(i,k,ch3cocho_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3cocho(i,k)*work2(i)))),0._r8 ) + end if + if( xooh_ndx > 0 ) then + het_rates(i,k,xooh_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_xooh(i,k)*work2(i)))),0._r8 ) + end if + if( onitr_ndx > 0 ) then + het_rates(i,k,onitr_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_onitr(i,k)*work2(i)))),0._r8 ) + end if + if( xonitr_ndx > 0 ) then + het_rates(i,k,xonitr_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_onitr(i,k)*work2(i)))),0._r8 ) + end if + if( glyald_ndx > 0 ) then + het_rates(i,k,glyald_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_glyald(i,k)*work2(i)))),0._r8 ) + end if + if( ch3cho_ndx > 0 ) then + het_rates(i,k,ch3cho_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3cho(i,k)*work2(i)))),0._r8 ) + end if + if( mvk_ndx > 0 ) then + het_rates(i,k,mvk_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_mvk(i,k)*work2(i)))),0._r8 ) + end if + if( macr_ndx > 0 ) then + het_rates(i,k,macr_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_macr(i,k)*work2(i)))),0._r8 ) + end if + if( h2o2_ndx > 0 ) then + work3(i) = satf_h2o2 * max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_h2o2(i,k)*work2(i)))),0._r8 ) + het_rates(i,k,h2o2_ndx) = work3(i) + tmp_hetrates(i,k,1) + end if + if ( prog_modal_aero .and. so2_ndx>0 .and. h2o2_ndx>0 ) then + het_rates(i,k,so2_ndx) = het_rates(i,k,h2o2_ndx) + elseif( so2_ndx > 0 ) then + work3(i) = satf_so2 * max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_so2( i,k)*work2(i)))),0._r8 ) + het_rates(i,k,so2_ndx ) = work3(i) + tmp_hetrates(i,k,3) + endif +! + work3(i) = satf_sog * max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_sog(i,k)*work2(i)))),0._r8 ) + if( sogm_ndx > 0 ) then + het_rates(i,k,sogm_ndx) = work3(i) + tmp_hetrates(i,k,4) + end if + if( sogi_ndx > 0 ) then + het_rates(i,k,sogi_ndx) = work3(i) + tmp_hetrates(i,k,5) + end if + if( sogt_ndx > 0 ) then + het_rates(i,k,sogt_ndx) = work3(i) + tmp_hetrates(i,k,6) + end if + if( sogb_ndx > 0 ) then + het_rates(i,k,sogb_ndx) = work3(i) + tmp_hetrates(i,k,7) + end if + if( sogx_ndx > 0 ) then + het_rates(i,k,sogx_ndx) = work3(i) + tmp_hetrates(i,k,8) + end if +! + work3(i) = tmp_hetrates(i,k,2) + satf_hno3 * & + max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_hno3(i,k)*work2(i)))),0._r8 ) + tmp0_rates(i) = work3(i) + tmp1_rates(i) = .2_r8*work3(i) + if( hno3_ndx > 0 ) then + het_rates(i,k,hno3_ndx) = work3(i) + end if + if( xhno3_ndx > 0 ) then + het_rates(i,k,xhno3_ndx) = work3(i) + end if + if( onit_ndx > 0 ) then + het_rates(i,k,onit_ndx) = work3(i) + end if + if( xonit_ndx > 0 ) then + het_rates(i,k,xonit_ndx) = work3(i) + end if + if( Pb_ndx > 0 ) then + het_rates(i,k,Pb_ndx) = work3(i) + end if + if( macrooh_ndx > 0 ) then + het_rates(i,k,macrooh_ndx) = work3(i) + end if + if( isopooh_ndx > 0 ) then + het_rates(i,k,isopooh_ndx) = work3(i) + end if + + if( clono2_ndx > 0 ) then + het_rates(i,k, clono2_ndx) = work3(i) + end if + if( brono2_ndx > 0 ) then + het_rates(i,k, brono2_ndx) = work3(i) + end if + if( hcl_ndx > 0 ) then + het_rates(i,k, hcl_ndx) = work3(i) + end if + if( n2o5_ndx > 0 ) then + het_rates(i,k, n2o5_ndx) = work3(i) + end if + if( hocl_ndx > 0 ) then + het_rates(i,k, hocl_ndx) = work3(i) + end if + if( hobr_ndx > 0 ) then + het_rates(i,k, hobr_ndx) = work3(i) + end if + if( hbr_ndx > 0 ) then + het_rates(i,k, hbr_ndx) = work3(i) + end if + + if( soa_ndx > 0 ) then + het_rates(i,k,soa_ndx) = tmp1_rates(i) + end if + if( oc2_ndx > 0 ) then + het_rates(i,k,oc2_ndx) = tmp1_rates(i) + end if + if( cb2_ndx > 0 ) then + het_rates(i,k,cb2_ndx) = tmp1_rates(i) + end if + if( so4_ndx > 0 ) then + het_rates(i,k,so4_ndx) = tmp1_rates(i) + end if + if( sa1_ndx > 0 ) then + het_rates(i,k,sa1_ndx) = tmp1_rates(i) + end if + if( sa2_ndx > 0 ) then + het_rates(i,k,sa2_ndx) = tmp1_rates(i) + end if + if( sa3_ndx > 0 ) then + het_rates(i,k,sa3_ndx) = tmp1_rates(i) + end if + if( sa4_ndx > 0 ) then + het_rates(i,k,sa4_ndx) = tmp1_rates(i) + end if + + if( h2so4_ndx > 0 ) then + het_rates(i,k,h2so4_ndx) = tmp0_rates(i) + end if + if( nh4_ndx > 0 ) then + het_rates(i,k,nh4_ndx) = tmp0_rates(i) + end if + if( nh4no3_ndx > 0 ) then + het_rates(i,k,nh4no3_ndx ) = tmp0_rates(i) + end if + if( nh3_ndx > 0 ) then + het_rates(i,k,nh3_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_nh3(i,k)*work2(i)))),0._r8 ) + end if + + if( ch3cooh_ndx > 0 ) then + het_rates(i,k,ch3cooh_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3cooh(i,k)*work2(i)))),0._r8 ) + end if + if( hcooh_ndx > 0 ) then + het_rates(i,k,hcooh_ndx) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3cooh(i,k)*work2(i)))),0._r8 ) + endif + if ( hcn_ndx > 0 ) then + het_rates(i,k,hcn_ndx ) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_hcn(i,k)*work2(i)))),0._r8 ) + endif + if ( ch3cn_ndx > 0 ) then + het_rates(i,k,ch3cn_ndx ) = max( rain(i,k) / (h2o_mol*(work1(i) + 1._r8/(xhen_ch3cn(i,k)*work2(i)))),0._r8 ) + endif + + end do Column_loop2 + end do level_loop2 + + !----------------------------------------------------------------- + ! ... Set rates above tropopause = 0. + !----------------------------------------------------------------- + do mm = 1,gas_wetdep_cnt + m = wetdep_map(mm) + do i = 1,ncol + do k = 1,ktop(i) + het_rates(i,k,m) = 0._r8 + end do + end do + if ( any( het_rates(:ncol,:,m) == MISSING) ) then + write(hetratestrg,'(I3)') m + call endrun('sethet: het_rates (wet dep) not set for het reaction number : '//hetratestrg) + endif + end do + + end subroutine sethet + +end module mo_sethet diff --git a/src/chemistry/mozart/mo_setinv.F90 b/src/chemistry/mozart/mo_setinv.F90 new file mode 100644 index 0000000000..c36b70b8c6 --- /dev/null +++ b/src/chemistry/mozart/mo_setinv.F90 @@ -0,0 +1,153 @@ + +module mo_setinv + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use chem_mods, only : inv_lst, nfs, gas_pcnst + use cam_history, only : addfld, outfld + use ppgrid, only : pcols, pver + + implicit none + + save + + integer :: id_o, id_o2, id_h + integer :: m_ndx, o2_ndx, n2_ndx, h2o_ndx, o3_ndx + logical :: has_o2, has_n2, has_h2o, has_o3, has_var_o2 + + private + public :: setinv_inti, setinv, has_h2o, o2_ndx, h2o_ndx, n2_ndx + +contains + + subroutine setinv_inti + !----------------------------------------------------------------- + ! ... initialize the module + !----------------------------------------------------------------- + + use mo_chem_utls, only : get_inv_ndx, get_spc_ndx + use spmd_utils, only : masterproc + + implicit none + + integer :: i + + m_ndx = get_inv_ndx( 'M' ) + n2_ndx = get_inv_ndx( 'N2' ) + o2_ndx = get_inv_ndx( 'O2' ) + h2o_ndx = get_inv_ndx( 'H2O' ) + o3_ndx = get_inv_ndx( 'O3' ) + + id_o = get_spc_ndx('O') + id_o2 = get_spc_ndx('O2') + id_h = get_spc_ndx('H') + + has_var_o2 = id_o2>0 .and. id_o>0 .and. id_h>0 + + has_n2 = n2_ndx > 0 + has_o2 = o2_ndx > 0 + has_h2o = h2o_ndx > 0 + has_o3 = o3_ndx > 0 + + if (masterproc) write(iulog,*) 'setinv_inti: m,n2,o2,h2o ndx = ',m_ndx,n2_ndx,o2_ndx,h2o_ndx + + do i = 1,nfs + call addfld( trim(inv_lst(i))//'_dens', (/ 'lev' /),'A', 'molecules/cm3', 'invariant density' ) + !call addfld( trim(inv_lst(i))//'_mmr', (/ 'lev' /),'A', 'kg/kg', 'invariant density' ) + call addfld( trim(inv_lst(i))//'_vmr', (/ 'lev' /),'A', 'mole/mole', 'invariant density' ) + enddo + + end subroutine setinv_inti + + subroutine setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf ) + !----------------------------------------------------------------- + ! ... set the invariant densities (molecules/cm**3) + !----------------------------------------------------------------- + + use mo_constants, only : boltz_cgs + use tracer_cnst, only : num_tracer_cnst, tracer_cnst_flds, get_cnst_data + use mo_chem_utls, only : get_inv_ndx + use physics_buffer, only : physics_buffer_desc + + implicit none + + !----------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------- + integer, intent(in) :: ncol ! chunk column count + real(r8), intent(in) :: tfld(pcols,pver) ! temperature + real(r8), intent(in) :: h2ovmr(ncol,pver) ! water vapor vmr + real(r8), intent(in) :: pmid(pcols,pver) ! pressure + integer, intent(in) :: lchnk ! chunk number + real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) ! vmr + real(r8), intent(out) :: invariants(ncol,pver,nfs) ! invariant array + type(physics_buffer_desc), pointer :: pbuf(:) + + + real(r8) :: cnst_offline( ncol, pver ) + + !----------------------------------------------------------------- + ! .. local variables + !----------------------------------------------------------------- + integer :: k, i, ndx + real(r8), parameter :: Pa_xfac = 10._r8 ! Pascals to dyne/cm^2 + real(r8) :: sum1(ncol) + real(r8) :: tmp_out(ncol,pver) + + !----------------------------------------------------------------- + ! note: invariants are in cgs density units. + ! the pmid array is in pascals and must be + ! mutiplied by 10. to yield dynes/cm**2. + !----------------------------------------------------------------- + invariants(:,:,:) = 0._r8 + !----------------------------------------------------------------- + ! ... set m, n2, o2, and h2o densities + !----------------------------------------------------------------- + do k = 1,pver + invariants(:ncol,k,m_ndx) = Pa_xfac * pmid(:ncol,k) / (boltz_cgs*tfld(:ncol,k)) + end do + + if( has_n2 ) then + if ( has_var_o2 ) then + do k = 1,pver + sum1(:ncol) = (vmr(:ncol,k,id_o) + vmr(:ncol,k,id_o2) + vmr(:ncol,k,id_h)) + invariants(:ncol,k,n2_ndx) = (1._r8 - sum1(:)) * invariants(:ncol,k,m_ndx) + end do + else + do k = 1,pver + invariants(:ncol,k,n2_ndx) = .79_r8 * invariants(:ncol,k,m_ndx) + end do + endif + end if + if( has_o2 ) then + do k = 1,pver + invariants(:ncol,k,o2_ndx) = .21_r8 * invariants(:ncol,k,m_ndx) + end do + end if + if( has_h2o ) then + do k = 1,pver + invariants(:ncol,k,h2o_ndx) = h2ovmr(:ncol,k) * invariants(:ncol,k,m_ndx) + end do + end if + + do i = 1,num_tracer_cnst + + call get_cnst_data( tracer_cnst_flds(i), cnst_offline, ncol, lchnk, pbuf ) + ndx = get_inv_ndx( tracer_cnst_flds(i) ) + + do k = 1,pver + invariants(:ncol,k,ndx) = cnst_offline(:ncol,k)*invariants(:ncol,k,m_ndx) + enddo + + enddo + + do i = 1,nfs + tmp_out(:ncol,:) = invariants(:ncol,:,i) + call outfld( trim(inv_lst(i))//'_dens', tmp_out(:ncol,:), ncol, lchnk ) + tmp_out(:ncol,:) = invariants(:ncol,:,i) / invariants(:ncol,:,m_ndx) + call outfld( trim(inv_lst(i))//'_vmr', tmp_out(:ncol,:), ncol, lchnk ) + enddo + + end subroutine setinv + +end module mo_setinv diff --git a/src/chemistry/mozart/mo_seto2.F90 b/src/chemistry/mozart/mo_seto2.F90 new file mode 100644 index 0000000000..c4c8886030 --- /dev/null +++ b/src/chemistry/mozart/mo_seto2.F90 @@ -0,0 +1,394 @@ + + module mo_seto2 + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + + implicit none + + private + public :: o2_xsect_inti + public :: set_o2_xsect + + save + + integer :: nsrc + integer :: ngast + integer :: nla + integer :: nwint + real(r8), allocatable :: wlint(:) + real(r8), allocatable :: xso2int(:) + real(r8), allocatable :: wlla(:) + real(r8), allocatable :: wlgast(:) + + contains + + subroutine o2_xsect_inti( o2_xsect_file ) +!----------------------------------------------------------------------------- +! purpose: +! compute equivalent optical depths for o2 absorption, parameterized in +! the sr bands and the lyman-alpha line. +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real(r8), specified altitude working grid (km) (i) +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! cz - real(r8), number of air molecules per cm^2 at each specified (i) +! altitude layer +! zen - real(r8), solar zenith angle (i) +! dto2 - real(r8), optical depth due to o2 absorption at each specified (o) +! vertical layer at each specified wavelength +! xso2 - real(r8), molecular absorption cross section in sr bands at (o) +! each specified altitude and wavelength. includes herzberg +! continuum. +!----------------------------------------------------------------------------- + + use mo_params, only : deltax + use mo_inter, only : inter2 + use mo_inter, only : inter_inti + use mo_wavelen, only : nw, wl + use ioFileMod, only : getfil + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & + pio_get_var, pio_closefile, pio_nowrite + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + character(len=*), intent(in) :: o2_xsect_file + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + type(file_desc_t) :: ncid + integer :: dimid + integer :: vid + integer :: astat + integer :: iret + integer :: i, wn, n + integer :: wrk_ind(4) + real(r8), allocatable :: x1(:) + real(r8), allocatable :: y1(:) + character(len=256) :: filespec + character(len=256) :: locfn + integer :: ierr +!----------------------------------------------------------------------------- +! ... cross section data for use outside the sr-bands (combined from +! brasseur and solomon and the jpl 1994 recommendation) +!----------------------------------------------------------------------------- + +!----------------------------------------------------------------------------- +! ... read o2 cross section data outside sr-bands +!----------------------------------------------------------------------------- +! ... o2 absorption cross sections: +! from 116 nm to 245 nm, including schumann-runge continumm +! from brasseur and solomon 1986. +!----------------------------------------------------------------------------- + filespec = trim( o2_xsect_file ) + call getfil( filespec, locfn, 0 ) + call cam_pio_openfile( ncid, trim( locfn ), PIO_NOWRITE ) +!--------------------------------------------------------------------------- +! ... get the dimensions +!--------------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'nosr', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, nsrc ) + ierr = pio_inq_dimid( ncid, 'ngast', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, ngast ) + ierr = pio_inq_dimid( ncid, 'nla', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, nla ) +!--------------------------------------------------------------------------- +! ... allocate arrays +!--------------------------------------------------------------------------- + allocate( wlint(nsrc), xso2int(nsrc), x1(nsrc), y1(nsrc), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'o2_xsect_inti: failed to allocate wlint ... y1; error = ',astat + call endrun + end if + allocate( wlgast(ngast), wlla(nla), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'o2_xsect_inti: failed to allocate wlgast, wlla; error = ',astat + call endrun + end if +!--------------------------------------------------------------------------- +! ... read the wave bin coordinates +!--------------------------------------------------------------------------- + ierr = pio_inq_varid( ncid, 'wl_src', vid ) + ierr = pio_get_var( ncid, vid, x1 ) + ierr = pio_inq_varid( ncid, 'xs_src', vid ) + ierr = pio_get_var( ncid, vid, y1 ) + ierr = pio_inq_varid( ncid, 'wl_gast', vid ) + ierr = pio_get_var( ncid, vid, wlgast ) + ierr = pio_inq_varid( ncid, 'wl_lym', vid ) + ierr = pio_get_var( ncid, vid, wlla ) + call pio_closefile( ncid ) +!----------------------------------------------------------------------------- +! ... put together the internal grid by "pasting" the lyman-alpha grid and +! kockarts grid into the combination of brasseur/solomon and jpl grid +!----------------------------------------------------------------------------- + wlint(1:9) = x1(1:9) + nwint = 9 + wlint(nwint+1:nwint+2) = wlla(1:2) + nwint = 11 + wlint(nwint+1:nwint+36) = x1(12:47) + nwint = 47 + wlint(nwint+1:nwint+ngast) = wlgast(1:ngast) + nwint = nwint + ngast + wlint(nwint+1:nwint+41) = x1(65:105) + nwint = nwint + 41 + wrk_ind(1:4) = (/ nsrc, ngast, nla, nwint /) +!----------------------------------------------------------------------------- +! ... initialize interpolation module +!----------------------------------------------------------------------------- + call inter_inti( nw+1, wl, nsrc, wlint ) +!----------------------------------------------------------------------------- +! ... interpolate brasseur/solomon and jpl data onto internal grid +!----------------------------------------------------------------------------- + call inter2( nsrc, wlint, xso2int, nsrc, x1, y1, iret ) + deallocate( x1, y1 ) + + + end subroutine o2_xsect_inti + + subroutine set_o2_xsect( z, nw, wl, cz, & + vcol, scol, dto2, xso2 ) +!----------------------------------------------------------------------------- +! purpose: +! compute equivalent optical depths for o2 absorption, parameterized in +! the sr bands and the lyman-alpha line. +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real(r8), specified altitude working grid (km) +! nw - integer, number of specified intervals + 1 in working +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in +! working wavelength grid +! cz - real(r8), number of air molecules per cm^2 at each specified +! altitude layer +! zen - real(r8), solar zenith angle +! dto2 - real(r8), optical depth due to o2 absorption at each specified (o) +! vertical layer at each specified wavelength +! xso2 - real(r8), molecular absorption cross section in sr bands at (o) +! each specified altitude and wavelength. includes herzberg +! continuum. +!----------------------------------------------------------------------------- +! edit history: +! 02/98 included lyman-alpha parameterization +! 03/97 fix dto2 problem at top level (nz) +! 02/97 changed offset for grid-end interpolation to relative number +! (x * (1 +- deltax)) +! 08/96 modified for early exit, no redundant read of data and smaller +! internal grid if possible; internal grid uses user grid points +! whenever possible +! 07/96 modified to work on internal grid and interpolate final values +! onto the user-defined grid +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use mo_wavelen, only : delw_bin + use mo_inter, only : inter3 + use mo_schu, only : schu + use mo_lymana, only : lymana + use ppgrid, only : pver, pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: cz(pverp) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: vcol(pverp) + real(r8), intent(in) :: scol(pverp) + real(r8), intent(out) :: dto2(pver,nw) + real(r8), intent(out) :: xso2(nw,pverp) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: wn, k, igast + integer :: astat + real(r8) :: secchi(pverp) + +!----------------------------------------------------------------------------- +! ... o2 optical depth and equivalent cross section on kockarts grid +!----------------------------------------------------------------------------- + real(r8), allocatable :: dto2k(:,:) + real(r8), allocatable :: xso2k(:,:) +!----------------------------------------------------------------------------- +! ... o2 optical depth and equivalent cross section in the lyman-alpha region +!----------------------------------------------------------------------------- + real(r8), allocatable :: dto2la(:,:) + real(r8), allocatable :: xso2la(:,:) +!----------------------------------------------------------------------------- +! ... temporary one-dimensional storage for optical depth and cross section values +! xxtmp - on internal grid +! xxuser - on user defined grid +!----------------------------------------------------------------------------- + real(r8), dimension(2*kw) :: dttmp, xstmp + real(r8) :: dtuser(kw) + real(r8) :: xsuser(kw) + real(r8) :: o2col(pverp) + + real(r8) :: x, y + real(r8) :: delo2 + +!----------------------------------------------------------------------------- +! ... allocate local variables +!----------------------------------------------------------------------------- + allocate( dto2k(pver,ngast-1), xso2k(pverp,ngast-1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'set_o2_xsect: failed to allocate dto2k,xso2k; error = ',astat + call endrun + end if + allocate( dto2la(pver,nla-1), xso2la(pverp,nla-1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'set_o2_xsect: failed to allocate dto2k,xso2k; error = ',astat + call endrun + end if +!----------------------------------------------------------------------------- +! ... check, whether user grid is in the o2 absorption band at all... +! if not, set cross section and optical depth values to zero and return +!----------------------------------------------------------------------------- + dto2(:pver,:nw) = 0._r8 + xso2(:nw,:pverp) = 0._r8 + if( wl(1) > 243._r8 ) then + return + end if + +!----------------------------------------------------------------------------- +! ... sec xhi or chapman calculation +! for zen > 95 degrees, use zen = 95. (this is only to compute effective o2 +! cross sections. still, better than setting dto2 = 0. as was done up to +! version 4.0) sm 1/2000 +! in future could replace with mu2(iz) (but mu2 is also wavelength-depenedent) +! or imporved chapman function +!----------------------------------------------------------------------------- + +!----------------------------------------------------------------------------- +! ... slant o2 column +!----------------------------------------------------------------------------- + o2col(1:pverp) = 0.2095_r8 * scol(1:pverp) + +!----------------------------------------------------------------------------- +! ... effective secant of solar zenith angle. use 2.0 if no direct sun. +! for nz, use value at nz-1 +!----------------------------------------------------------------------------- + secchi(1:pver) = scol(1:pver)/vcol(1:pver) + where( secchi(1:pver) == 0._r8 ) + secchi(1:pver) = 2._r8 + endwhere + secchi(pverp) = secchi(pver) + +!----------------------------------------------------------------------------- +! ... if necessary: +! kockarts parameterization of the sr bands, output values of o2 +! optical depth and o2 equivalent cross section are on his grid +!----------------------------------------------------------------------------- + if( wl(1) < wlgast(ngast) .and. wl(nw+1) > wlgast(1) ) then + call schu( o2col, secchi, dto2k, xso2k ) + else + dto2k(:,:) = 0._r8 + xso2k(:,:) = 0._r8 + end if + +!----------------------------------------------------------------------------- +! ... lyman-alpha parameterization, output values of o2 opticaldepth +! and o2 effective (equivalent) cross section +!----------------------------------------------------------------------------- + if( wl(1) <= wlla(nla) .and. wl(nw+1) >= wlla(1) ) then + call lymana( o2col, secchi, dto2la, xso2la ) + else + dto2la(:,:) = 0._r8 + xso2la(:,:) = 0._r8 + end if + +!----------------------------------------------------------------------------- +! ... loop through the altitude levels +!----------------------------------------------------------------------------- +level_loop : & + do k = 1,pverp + igast = 0 +!----------------------------------------------------------------------------- +! ... loop through the internal wavelength grid +!----------------------------------------------------------------------------- + do wn = 1,nwint-1 +!----------------------------------------------------------------------------- +! ... if outside kockarts grid and outside lyman-alpha, use the +! jpl/brasseur+solomon data, if inside +! kockarts grid, use the parameterized values from the call to schu, +! if inside lyman-alpha, use the paraemterized values from call to lymana +!----------------------------------------------------------------------------- + if( wlint(wn+1) <= wlgast(1) .or. wlint(wn) >= wlgast(ngast) ) then + if( wlint(wn+1) <= wlla(1) .or. wlint(wn) >= wlla(nla) ) then + xstmp(wn) = xso2int(wn) + else + xstmp(wn) = xso2la(k,1) + end if + else + igast = igast + 1 + xstmp(wn) = xso2k(k,igast) + end if +!----------------------------------------------------------------------------- +! ... compute the area in each bin (for correct interpolation purposes only!) +!----------------------------------------------------------------------------- + xstmp(wn) = xstmp(wn) * (wlint(wn+1) - wlint(wn)) + end do +!----------------------------------------------------------------------------- +! ... interpolate o2 cross section from the internal grid onto the user grid +!----------------------------------------------------------------------------- + call inter3( nw+1, wl, xsuser, nwint, wlint, xstmp ) + xso2(:nw,k) = xsuser(:nw) * delw_bin(:nw) + end do level_loop + + do k = 1,pver + igast = 0 + delo2 = .2095_r8 * cz(k) ! vertical o2 column +!----------------------------------------------------------------------------- +! ... loop through the internal wavelength grid +!----------------------------------------------------------------------------- + do wn = 1,nwint-1 +!----------------------------------------------------------------------------- +! ... if outside kockarts grid and outside lyman-alpha, use the +! jpl/brasseur+solomon data, if inside +! kockarts grid, use the parameterized values from the call to schu, +! if inside lyman-alpha, use the paraemterized values from call to lymana +!----------------------------------------------------------------------------- + if( wlint(wn+1) <= wlgast(1) .or. wlint(wn) >= wlgast(ngast) ) then + if( wlint(wn+1) <= wlla(1) .or. wlint(wn) >= wlla(nla) ) then + dttmp(wn) = xso2int(wn) * delo2 + else + dttmp(wn) = dto2la(k,1) + end if + else + igast = igast + 1 + dttmp(wn) = dto2k(k,igast) + end if +!----------------------------------------------------------------------------- +! ... compute the area in each bin (for correct interpolation purposes only!) +!----------------------------------------------------------------------------- + dttmp(wn) = dttmp(wn) * (wlint(wn+1) - wlint(wn)) + end do +!----------------------------------------------------------------------------- +! ... interpolate o2 optical depth from the internal grid onto the user grid +!----------------------------------------------------------------------------- + call inter3( nw+1, wl, dtuser, nwint, wlint, dttmp ) + dto2(k,:nw) = dtuser(:nw) * delw_bin(:nw) + end do + + deallocate( dto2k, xso2k, dto2la, xso2la ) + + end subroutine set_o2_xsect + + end module mo_seto2 diff --git a/src/chemistry/mozart/mo_setozo.F90 b/src/chemistry/mozart/mo_setozo.F90 new file mode 100644 index 0000000000..a1953fdc2e --- /dev/null +++ b/src/chemistry/mozart/mo_setozo.F90 @@ -0,0 +1,111 @@ + + module mo_setozo + + use shr_kind_mod, only : r8 => shr_kind_r8 + + contains + + subroutine setozo( z, nw, wl, tlay, dto3, & + to3, o3, airlev, o3top ) +!----------------------------------------------------------------------------- +! purpose: +! set up an altitude profile of ozone, and corresponding absorption +! optical depths. subroutine includes a shape-conserving scaling method +! that allows scaling of the entire profile to a given overhead ozone +! column amount. +!----------------------------------------------------------------------------- +! parameters: +! dobnew - real, overhead ozone column amount (du) to which profile (i) +! should be scaled. if dobnew < 0, no scaling is done +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real, specified altitude working grid (km) +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real, vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! xso3 - real, molecular absoprtion cross section (cm^2) of o3 at (i) +! each specified wavelength (wmo value at 273) +! s226 - real, molecular absoprtion cross section (cm^2) of o3 at (i) +! each specified wavelength (value from molina and molina at 226k) +! s263 - real, molecular absoprtion cross section (cm^2) of o3 at (i) +! each specified wavelength (value from molina and molina at 263k) +! s298 - real, molecular absoprtion cross section (cm^2) of o3 at (i) +! each specified wavelength (value from molina and molina at 298k) +! tlay - real, temperature (k) at each specified altitude layer (i) +! dto3 - real, optical depth due to ozone absorption at each (o) +! specified altitude at each specified wavelength +! to3 - real, totol ozone column (o) +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use mo_waveo3, only : xso3, s226, s263, s298 + use ppgrid, only : pver, pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: o3top + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: z(pverp) + real(r8), intent(in) :: tlay(pver) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(out) :: dto3(pver,nw) + real(r8), intent(out) :: to3(pverp) + real(r8), intent(inout) :: o3(pverp) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: wave_lims(2) = (/ 240.5_r8, 350._r8 /) + real(r8), parameter :: t_lims(3) = (/ 226._r8, 263._r8, 298._r8 /) + real(r8), parameter :: tfac1 = 1._r8/(t_lims(2) - t_lims(1)) + real(r8), parameter :: tfac2 = 1._r8/(t_lims(3) - t_lims(2)) + + integer :: k, wn + real(r8) :: so3 + real(r8) :: cz(pverp) + +!----------------------------------------------------------------------------- +! ... compute column increments +!----------------------------------------------------------------------------- + o3(1:pverp) = o3(1:pverp)*airlev(1:pverp) + cz(1:pver) = .5_r8*(o3(2:pverp) + o3(1:pver)) * 1.e5_r8 * (z(2:pverp) - z(1:pver)) + to3(pverp) = o3top + do k = pver,1,-1 + to3(k) = to3(k+1) + cz(k) + end do + +!----------------------------------------------------------------------------- +! ... include exponential tail integral from infinity to 50 km, +! fold tail integral into top layer +! specify scale height near top of data. +!----------------------------------------------------------------------------- + + cz(pver) = cz(pver) + o3top +!----------------------------------------------------------------------------- +! ... calculate ozone optical depth for each layer, with temperature +! correction. output, dto3(kz,kw) +!----------------------------------------------------------------------------- + do wn = 1,nw + if( wl(wn) > wave_lims(1) .and. wl(wn+1) < wave_lims(2) ) then + do k = 1,pver + if( tlay(k) < t_lims(2) ) then + so3 = s226(wn) + (s263(wn) - s226(wn)) * tfac1 * (tlay(k) - t_lims(1)) + else + so3 = s263(wn) + (s298(wn) - s263(wn)) * tfac2 * (tlay(k) - t_lims(2)) + end if + dto3(k,wn) = cz(k)*so3 + end do + else + dto3(1:pver,wn) = cz(1:pver) * xso3(wn) + end if + end do + + end subroutine setozo + + end module mo_setozo + diff --git a/src/chemistry/mozart/mo_setz.F90 b/src/chemistry/mozart/mo_setz.F90 new file mode 100644 index 0000000000..e750338ca2 --- /dev/null +++ b/src/chemistry/mozart/mo_setz.F90 @@ -0,0 +1,160 @@ + + module mo_setz + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + private + public :: setz + + contains + + subroutine setz( cz, tlev, c, zen, adjcoe, pht_tag ) +!----------------------------------------------------------------------------- +! adjcoe - adjust cross section coefficients +!----------------------------------------------------------------------------- + + use mo_params, only : kj + use mo_calcoe, only : calcoe + use ppgrid, only : pverp + use chem_mods, only : phtcnt + use mo_tuv_inti, only : nlng, ncof + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: zen ! zenith angle (degrees) + real(r8), intent(in) :: cz(pverp) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: c(:,:,:) + real(r8), intent(out) :: adjcoe(:,:) + character(len=32), intent(in) :: pht_tag(:) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer, parameter :: nzen = 4 + real(r8), parameter :: zen_angles(nzen) = (/ 20.5_r8, 40.5_r8, 60.5_r8, 80._r8 /) + + integer :: astat + integer :: ndx + integer :: m + real(r8) :: tt + real(r8) :: adj_fac + real(r8) :: interp_factor + real(r8) :: c0, c1, c2 + real(r8) :: xz(pverp) + real(r8), allocatable :: wrk(:,:) + character(len=32) :: jname + +!----------------------------------------------------------------------------- +! 1 o2 + hv -> o + o +! 2 o3 -> o2 + o(1d) +! 3 o3 -> o2 + o(3p) +! 4 no2 -> no + o(3p) +! 5 no3 -> no + o2 +! 6 no3 -> no2 + o(3p) +! 7 n2o5 -> no3 + no + o(3p) +! 8 n2o5 -> no3 + no2 +! 9 n2o + hv -> n2 + o(1d) +! 10 ho2 + hv -> oh + o +! 11 h2o2 -> 2 oh +! 12 hno2 -> oh + no +! 13 hno3 -> oh + no2 +! 14 hno4 -> ho2 + no2 +! 15 ch2o -> h + hco +! 16 ch2o -> h2 + co +! 17 ch3cho -> ch3 + hco +! 18 ch3cho -> ch4 + co +! 19 ch3cho -> ch3co + h +! 20 c2h5cho -> c2h5 + hco +! 21 chocho -> products +! 22 ch3cocho -> products +! 23 ch3coch3 +! 24 ch3ooh -> ch3o + oh +! 25 ch3ono2 -> ch3o+no2 +! 26 pan + hv -> products +!----------------------------------------------------------------------------- + + xz(1:pverp) = cz(1:pverp)*1.e-18_r8 + do m = 1,nlng + adjcoe(1:pverp,m) = 1._r8 + end do + if( zen < zen_angles(1) ) then + ndx = 1 + interp_factor = 0._r8 + else if( zen >= zen_angles(nzen) ) then + ndx = nzen + interp_factor = 0._r8 + else + do ndx = 1,nzen-1 + if( zen >= zen_angles(ndx) .and. zen < zen_angles(ndx+1) ) then +!!$ interp_factor = (zen - zen_angles(ndx-1))/(zen_angles(ndx) - zen_angles(ndx-1)) + interp_factor = (zen - zen_angles(ndx))/(zen_angles(ndx+1) - zen_angles(ndx)) + exit + end if + end do + end if + + allocate( wrk(pverp,2), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'setz: failed to all wrk; error = ',astat + call endrun + end if + + tt = tlev(1)/281._r8 +rate_loop : & + do m = 1,nlng + jname = trim(pht_tag(m)) + if( jname /= 'jo1d' .and. jname /= 'j2oh' .and. jname /= 'jh2o2' ) then + adj_fac = 1._r8 + else if( (jname == 'jo1d') .or. (jname == 'j2oh') ) then +!---------------------------------------------------------------------- +! ... temperature modification +! t0.9 (1.05) t0.95(1.025) t1.0(1.0) t1.15(1.02) t1.1(1.04) +!---------------------------------------------------------------------- + select case( ndx ) + case( 1 ) + c0 = 4.52372_r8 ; c1 = -5.94317_r8 ; c2 = 2.63156_r8 + case( 2 ) + c0 = 4.99378_r8 ; c1 = -7.92752_r8 ; c2 = 3.94715_r8 + case( 3 ) + c0 = .969867_r8 ; c1 = -.841035_r8 ; c2 = .878835_r8 + case( 4 ) + c0 = 1.07801_r8 ; c1 = -2.39580_r8 ; c2 = 2.32632_r8 + end select + adj_fac = c0 + tt*(c1 + c2*tt) + else if( jname == 'jh2o2' ) then +!---------------------------------------------------------------------- +! ... temperature modification +! t0.9 (1.05) t0.95(1.025) t1.0(1.0) t1.15(1.02) t1.1(1.04) +!---------------------------------------------------------------------- + select case( ndx ) + case( 1 ) + c0 = 2.43360_r8 ; c1 = -3.61363_r8 ; c2 = 2.19018_r8 + case( 2 ) + c0 = 3.98265_r8 ; c1 = -6.90516_r8 ; c2 = 3.93602_r8 + case( 3 ) + c0 = 3.49843_r8 ; c1 = -5.98839_r8 ; c2 = 3.50262_r8 + case( 4 ) + c0 = 3.06312_r8 ; c1 = -5.26281_r8 ; c2 = 3.20980_r8 + end select + adj_fac = c0 + tt*(c1 + c2*tt) + end if + call calcoe( c(:,m,ndx), xz, tt, adj_fac, wrk(:,1) ) + if( interp_factor /= 0._r8 ) then + call calcoe( c(:,m,ndx+1), xz, tt, adj_fac, wrk(:,2) ) + adjcoe(:,m) = wrk(:,1) + interp_factor * (wrk(:,2) - wrk(:,1)) + else + adjcoe(:,m) = wrk(:,1) + end if + end do rate_loop + + deallocate( wrk ) + + end subroutine setz + + end module mo_setz diff --git a/src/chemistry/mozart/mo_snoe.F90 b/src/chemistry/mozart/mo_snoe.F90 new file mode 100644 index 0000000000..79b7e99834 --- /dev/null +++ b/src/chemistry/mozart/mo_snoe.F90 @@ -0,0 +1,505 @@ + module mo_snoe +!---------------------------------------------------------------------- +! An empirical model of nitric oxide (NO) in the lower thermosphere +! (100 - 150 km altitude), based on measurements from the Student +! Nitric Oxide Explorer (SNOE). Model uses empirical orthogonal functions +! (EOFs) derived from the SNOE dataset to describe spatial variability +! in NO. Model NO is the sum of a mean distribution and EOFs multiplied +! by coefficients based on geophysical parameters. These geophysical +! parameters are day of year, Kp magnetic index and F10.7 solar uv index. +! +! Model is utilized by calling subroutine snoe_3d(), which returns +! a 3-D distribution of NO on geographic coordinates (lon/lat are +! supplied by user). Altitude is fixed to SNOE grid (every 3.33 km). +! +! +! DRM 4/03 +!---------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols + use physconst, only : pi + use mo_constants, only : r2d, d2r + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + implicit none + + private + + public :: snoe_inti, snoe_timestep_init, set_no_ubc + public :: ndx_no + + save + + integer, parameter :: nmodes = 3 + real(r8), parameter :: delz = 104.6_r8 ! delta z (km) + real(r8), parameter :: re = 6471._r8 ! radial distance from ED at 100 km altitude (km) + real(r8), parameter :: delx = -399.1_r8 ! delta x (km) + real(r8), parameter :: dely = -286.1_r8 ! delta y (km) + real(r8), parameter :: twopi = 2._r8*pi, pid2=0.5_r8*pi + real(r8), parameter :: theta_n = d2r*(90._r8 - 78.98_r8) ! co-latitude of CD North Pole (radians) + real(r8), parameter :: phi_n = d2r*289.1_r8 ! longitude of CD North Pole (radians) + + integer :: nmlat + integer :: nlev + integer :: ndx_no + + +!---------------------------------------------------------------------- +! ... snoe mean and eof data +!---------------------------------------------------------------------- + real(r8), allocatable :: mlat(:,:) ! magnetic latitudes corresponding to geo latitudes (radians) + real(r8), allocatable :: mlat2d(:) ! snoe latitudes (degrees) + real(r8), allocatable :: lev(:) ! snoe levels (km) + real(r8), allocatable :: no_mean(:,:) ! mean no + real(r8), allocatable :: eofs(:,:,:) ! empirical orthogonal ftns + real(r8), allocatable :: snoe_no(:,:,:) ! snoe no interpolated to model lons (molecules/cm^3) + + real(r8) :: cthetan + real(r8) :: sthetan + + contains + + subroutine snoe_inti(snoe_ubc_file) +!---------------------------------------------------------------------- +! ... initialize snoe +!---------------------------------------------------------------------- + + use ppgrid, only : begchunk, endchunk + use constituents, only : cnst_get_ind, cnst_fixed_ubc + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + character(len=*), intent(in) :: snoe_ubc_file + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: astat + +!---------------------------------------------------------------------- +! ... do we have no with a fixed ubc ? +!---------------------------------------------------------------------- + call cnst_get_ind( 'NO', ndx_no, abort=.false. ) + if( ndx_no > 0 ) then + if( .not. cnst_fixed_ubc(ndx_no) ) then + return + end if + else + return + end if + + + + cthetan = cos( theta_n ) + sthetan = sin( theta_n ) +!---------------------------------------------------------------------- +! ... read snoe netcdf file +!---------------------------------------------------------------------- + call snoe_rdeof(snoe_ubc_file) + allocate( snoe_no(pcols,nlev,begchunk:endchunk), & + mlat(pcols,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'snoe_inti: failed to allocate snoe_no,mlat; error = ',astat + call endrun + end if + +!---------------------------------------------------------------------- +! ... get lon/lat transformed to magnetic coords +!---------------------------------------------------------------------- + call geo2mag + + end subroutine snoe_inti + + subroutine snoe_rdeof(snoe_ubc_file) +!---------------------------------------------------------------------- +! ... read in eofs from netcdf file +!---------------------------------------------------------------------- + + use ioFileMod, only : getfil + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_get_var, pio_closefile, & + pio_nowrite, pio_inq_varid, pio_inq_dimid, pio_inq_dimlen + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + character(len=*), intent(in) :: snoe_ubc_file + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: istat, ierr + integer :: dim_id, var_id + type(file_desc_t) :: ncid + character(len=256) :: locfn + +!---------------------------------------------------------------------- + +#ifdef SNOE_DIAGS + write(iulog,*) 'snoe_rdeof: entered routine' +#endif + +!---------------------------------------------------------------------- +! ... open the netcdf file +!---------------------------------------------------------------------- + call getfil(snoe_ubc_file, locfn, 0) + call cam_pio_openfile( ncid, trim(locfn), PIO_NOWRITE) + +!---------------------------------------------------------------------- +! ... read the snoe dimensions +!---------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lat', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, nmlat ) + ierr = pio_inq_dimid( ncid, 'lev', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, nlev ) + +!---------------------------------------------------------------------- +! ... allocate snoe variables +!---------------------------------------------------------------------- + allocate( mlat2d(nmlat), lev(nlev), & + no_mean(nmlat,nlev), eofs(nmlat,nlev,nmodes), stat=istat ) + if( istat /= 0 ) then + write(iulog,*) 'snoe_rdeof: failed to allocate mlat2d ... eofs; error = ',istat + call endrun + end if + +!---------------------------------------------------------------------- +! ... read the snoe variables +!---------------------------------------------------------------------- + ierr = pio_inq_varid( ncid, 'NO', var_id ) + ierr = pio_get_var( ncid, var_id, no_mean ) + + ierr = pio_inq_varid( ncid, 'EOF', var_id ) + ierr = pio_get_var( ncid, var_id, (/1,1,1/), (/nmlat, nlev, nmodes/), eofs ) + + ierr = pio_inq_varid( ncid, 'lat', var_id ) + ierr = pio_get_var( ncid, var_id, mlat2d ) + mlat2d(:) = d2r*mlat2d(:) + + ierr = pio_inq_varid( ncid, 'z', var_id ) + ierr = pio_get_var( ncid, var_id, lev ) + +!---------------------------------------------------------------------- +! ... close the netcdf file +!---------------------------------------------------------------------- + call pio_closefile( ncid) + + end subroutine snoe_rdeof + + subroutine geo2mag +!---------------------------------------------------------------------- +! ... converts geographic latitude and longitude pair +! to eccentric dipole (ED) geomagnetic coordinates +!---------------------------------------------------------------------- + + use ppgrid, only : begchunk, endchunk + use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p + + implicit none + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: c, i, j + integer :: ncol + real(r8) :: cdlat + real(r8) :: wrk + real(r8) :: smaglat, cmaglat, cmaglon, smaglon + real(r8) :: edlon, sedlon, cedlon, edlat, cedlat + real(r8) :: singlat, cosglat + real(r8) :: rlons(pcols) + real(r8) :: rlats(pcols) + +!---------------------------------------------------------------------- +! ... start with centered dipole (CD) coordinates +!---------------------------------------------------------------------- +chunk_loop : & + do c = begchunk,endchunk + ncol = get_ncols_p( c ) + call get_rlon_all_p( c, ncol, rlons ) + call get_rlat_all_p( c, ncol, rlats ) +column_loop : & + do i = 1,ncol + singlat = sin( rlats(i) ) + cosglat = cos( rlats(i) ) + wrk = rlons(i) - phi_n + cdlat = acos( singlat * cthetan + cosglat * sthetan * cos(wrk) ) + smaglat = sin( cdlat ) + cmaglat = cos( cdlat ) + cmaglon = -(singlat - cthetan * cmaglat) / (sthetan * smaglat) + smaglon = cosglat * sin(wrk) / smaglat +!---------------------------------------------------------------------- +! ... convert CD coords to ED coords- equation (39 a,b) of Fraser-Smith +!---------------------------------------------------------------------- + sedlon = re * smaglat * smaglon - dely + cedlon = re * smaglat * cmaglon - delx + edlon = atan2( sedlon, cedlon ) ! ED magnetic long. (degrees) + cedlat = (re * cmaglat - delz) * cos(edlon) + edlat = atan2( cedlon, cedlat ) ! ED magnetic latitude (degrees) +!---------------------------------------------------------------------- +! ... convert co-latitudes into latitudes +!---------------------------------------------------------------------- + if( edlat < 0._r8 ) then + edlat = edlat + pi + end if + mlat(i,c) = pid2 - edlat + end do column_loop + end do chunk_loop + + end subroutine geo2mag + + subroutine snoe_timestep_init( kp, f107 ) +!---------------------------------------------------------------------- +! ... driver routine that provides access to empirical model +! data returned is three dimensional (on geographic coordinates) +!---------------------------------------------------------------------- + + use time_manager, only : get_curr_calday + use ppgrid, only : pcols, begchunk, endchunk + use phys_grid, only : get_ncols_p + use spmd_utils, only : masterproc + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + real(r8), intent(in) :: kp ! solar activity index + real(r8), intent(in) :: f107 ! solar activity index + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: astat, c + integer :: ncol + real(r8) :: doy ! day of year + real(r8), allocatable :: zm(:,:) ! zonal mean nitric oxide distribution (molecules/cm^3) + + allocate( zm(nmlat,nlev),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'snoe_3d: failed to allocate zm; error = ',astat + call endrun + end if + doy = aint( get_curr_calday() ) +#ifdef SNOE_DIAGS + if( masterproc ) then + write(iulog,*) ' ' + write(iulog,*) 'set_snoe_no: doy,kp,f107 = ',doy,kp,f107 + write(iulog,*) ' ' + end if +#endif + !---------------------------------------------------------------------- + ! ... obtain SNOE zonal mean data in geomagnetic coordinates + !---------------------------------------------------------------------- + call snoe_zm( doy, kp, f107, zm ) + + !---------------------------------------------------------------------- + ! ... map mean to model longitudes + !---------------------------------------------------------------------- + do c = begchunk,endchunk + ncol = get_ncols_p( c ) + call snoe_zmto3d( c, ncol, zm, nmlat, nlev ) + end do + deallocate( zm ) + + end subroutine snoe_timestep_init + + subroutine set_no_ubc( lchunk, ncol, zint, mmr, rho ) +!---------------------------------------------------------------------- +! ... set no mixing ratio at the model top interface level +!---------------------------------------------------------------------- + + use constituents, only : pcnst, cnst_mw + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: lchunk + integer, intent(in) :: ncol + real(r8), intent(in) :: zint(pcols) ! geopot height (km) + real(r8), intent(in) :: rho(pcols) ! total atm density (kg/m^3) + real(r8), intent(inout) :: mmr(pcols,pcnst) ! concentration at top interface (kg/kg) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + real(r8), parameter :: amu_fac = 1.65979e-27_r8 ! kg/amu + real(r8), parameter :: cm3_2_m3 = 1.e6_r8 + integer :: astat, i, k, ks, ks1 + real(r8) :: zinterp, zfac, mfac + +!---------------------------------------------------------------------- +! ... map to model levels +!---------------------------------------------------------------------- + if( ndx_no > 0 ) then +column_loop : & + do i = 1,ncol + zinterp = zint(i) + if( zinterp >= lev(1) ) then + mmr(i,ndx_no) = snoe_no(i,1,lchunk) + else if( zint(i) < lev(nlev) ) then + mmr(i,ndx_no) = 0._r8 + else + do ks = 2,nlev + if( zinterp >= lev(ks) ) then + ks1 = ks - 1 + zfac = (zinterp - lev(ks))/(lev(ks1) - lev(ks)) + mmr(i,ndx_no) = snoe_no(i,ks,lchunk) & + + zfac*(snoe_no(i,ks1,lchunk) - snoe_no(i,ks,lchunk)) + exit + end if + end do + end if + end do column_loop + mfac = amu_fac * cm3_2_m3 * cnst_mw(ndx_no) + mmr(:ncol,ndx_no) = mmr(:ncol,ndx_no) * mfac /rho(:ncol) + end if + + end subroutine set_no_ubc + + subroutine snoe_zm( doy, kp, f107, zm ) +!---------------------------------------------------------------------- +! ... calculates zonal mean nitric oxide distribution on a given day +! and solar conditions (represented by the f10.7 and kp indices) +!---------------------------------------------------------------------- + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + real(r8), intent(in) :: doy + real(r8), intent(in) :: kp + real(r8), intent(in) :: f107 + real(r8), intent(out) :: zm(:,:) + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: k + real(r8) :: theta0 ! day number in degrees + real(r8) :: dec ! solar declination angle + real(r8) :: m1, m2, m3 ! coefficients for first 3 eofs + +#ifdef SNOE_DIAGS + write(iulog,*) 'snoe_zm: doy, kp, f107 = ',doy,kp,f107 +#endif + +!---------------------------------------------------------------------- +! ... calculate coefficients (m1 to m3) for eofs based on +! geophysical parametes eof1 - kp +!---------------------------------------------------------------------- + + m1 = kp * 0.785760_r8 - 1.94262_r8 + +!---------------------------------------------------------------------- +! ... eof2 - declination +!---------------------------------------------------------------------- + theta0 = twopi * (doy - 1._r8) / 365._r8 + + dec = .006918_r8 & + - .399912_r8 * cos(theta0) + .070257_r8 * sin(theta0) & + - .006758_r8 * cos(2._r8*theta0) + .000907_r8 * sin(2._r8*theta0) & + - .002697_r8 * cos(3._r8*theta0) + .001480_r8 * sin(3._r8*theta0) + + dec = dec * r2d + +#ifdef SNOE_DIAGS + write(iulog,*) 'snoe_zm: dec = ',dec +#endif + m2 = -.319782_r8 + dec*(.0973109_r8 + dec*(.000489814_r8 - dec*.000103608_r8)) + +!---------------------------------------------------------------------- +! ... eof3 - f107 +!---------------------------------------------------------------------- + m3 = log10(f107) * 6.44069_r8 - 13.9832_r8 + +#ifdef SNOE_DIAGS + write(iulog,*) 'snoe_zm: m1, m2, m3 = ',m1,m2,m3 +#endif + +!---------------------------------------------------------------------- +! ... zonal mean distrib. is sum of mean and eofs +!---------------------------------------------------------------------- + do k = 1,nlev + zm(:,k) = no_mean(:,k) - m1 * eofs(:,k,1) + m2 * eofs(:,k,2) - m3 * eofs(:,k,3) + end do + + end subroutine snoe_zm + + subroutine snoe_zmto3d( lchunk, ncol, zm, nmlat, nlev ) +!---------------------------------------------------------------------- +! ... interpolate zonal mean on magnetic grid +! to 3d field in geographic coords +!---------------------------------------------------------------------- + + implicit none + +!---------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------- + integer, intent(in) :: lchunk + integer, intent(in) :: ncol + integer, intent(in) :: nmlat + integer, intent(in) :: nlev + real(r8), intent(in) :: zm(nmlat,nlev) ! zonal mean snoe no concentration + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: k + + do k = 1,nlev + call interpol( nmlat, mlat2d, zm(1,k), ncol, mlat(1,lchunk), snoe_no(1,k,lchunk) ) + end do + + end subroutine snoe_zmto3d + + subroutine interpol( nin, xin, yin, nout, xout, yout ) +!----------------------------------------------------------------------- +! ... linear interpolation +! does not extrapolate, but repeats edge values +!----------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: nin, nout + real(r8), intent(in) :: xin(nin) + real(r8), intent(in) :: yin(nin) + real(r8), intent(in) :: xout(nout) + real(r8), intent(out) :: yout(nout) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: i, j + + do j = 1,nout + if( xout(j) < xin(1) ) then + yout(j) = yin(1) + else + if( xout(j) > xin(nin) ) then + yout(j) = yin(nin) + else + do i = 1, nin-1 + if ((xout(j) >= xin(i)) .and. (xout(j) < xin(i+1)) ) then + yout(j) = yin(i) & + + (yin(i+1) - yin(i)) * (xout(j) - xin(i)) / (xin(i+1) - xin(i)) + end if + end do + end if + end if + end do + + end subroutine interpol + + end module mo_snoe diff --git a/src/chemistry/mozart/mo_sphers.F90 b/src/chemistry/mozart/mo_sphers.F90 new file mode 100644 index 0000000000..edb731d87f --- /dev/null +++ b/src/chemistry/mozart/mo_sphers.F90 @@ -0,0 +1,121 @@ + + module mo_sphers + + contains + + subroutine sphers( z, zen, dsdh, nid ) +!----------------------------------------------------------------------------- +! purpose: +! calculate slant path over vertical depth ds/dh in spherical geometry. +! calculation is based on: a.dahlback, and k.stamnes, a new spheric model +! for computing the radiation field available for photolysis and heating +! at twilight, planet.space sci., v39, n5, pp. 671-683, 1991 (appendix b) +!----------------------------------------------------------------------------- +! parameters: +! nz - integer, number of specified altitude levels in the working (i) +! grid +! z - real, specified altitude working grid (km) (i) +! zen - real, solar zenith angle (degrees) (i) +! dsdh - real, slant path of direct beam through each layer crossed (o) +! when travelling from the top of the atmosphere to layer i; +! dsdh(i,j), i = 0..nz-1, j = 1..nz-1 +! nid - integer, number of layers crossed by the direct beam when (o) +! travelling from the top of the atmosphere to layer i; +! nid(i), i = 0..nz-1 +!----------------------------------------------------------------------------- + + use mo_params, only : rearth + use mo_constants, only : d2r + use ppgrid, only : pver, pverp + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: zen + real(r8), intent(in) :: z(pverp) + integer, intent(out) :: nid(0:pver) + real(r8), intent(out) :: dsdh(0:pver,pver) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: i, j, k + integer :: id + real(r8) :: re, ze(pverp) + real(r8) :: zd(0:pver) + real(r8) :: zenrad, rpsinz, rj, rjp1, dsj, dhj, ga, gb, sm + real(r8) :: radius + + radius = rearth*1.e-3_r8 ! rearth m -> km + zenrad = zen*d2r +!----------------------------------------------------------------------------- +! ... include the elevation above sea level to the radius of the earth: +!----------------------------------------------------------------------------- + re = radius + z(1) +!----------------------------------------------------------------------------- +! ... correspondingly z changed to the elevation above earth surface: +!----------------------------------------------------------------------------- + ze(1:pverp) = z(1:pverp) - z(1) + +!----------------------------------------------------------------------------- +! ... inverse coordinate of z +!----------------------------------------------------------------------------- + zd(0) = ze(pverp) + do k = 1,pver + zd(k) = ze(pverp - k) + end do + +!----------------------------------------------------------------------------- +! ... initialize dsdh(i,j), nid(i) +!----------------------------------------------------------------------------- + dsdh(0:pver,1:pver) = 0._r8 + nid(0:pver) = 0 + +!----------------------------------------------------------------------------- +! ... calculate ds/dh of every layer +!----------------------------------------------------------------------------- + do i = 0,pver + rpsinz = (re + zd(i)) * sin(zenrad) + if( zen > 90._r8 .and. rpsinz < re ) then + nid(i) = -1 + else +!----------------------------------------------------------------------------- +! ... find index of layer in which the screening height lies +!----------------------------------------------------------------------------- + id = i + if( zen > 90._r8 ) then + do j = 1,pver + if( (rpsinz < ( zd(j-1) + re ) ) .and. (rpsinz >= ( zd(j) + re )) ) then + id = j + end if + end do + end if + + do j = 1,id + if( j == id .and. id == i .and. zen > 90._r8) then + sm = -1._r8 + else + sm = 1._r8 + end if + rj = re + zd(j-1) + rjp1 = re + zd(j) + dhj = zd(j-1) - zd(j) + ga = max( 0._r8,rj*rj - rpsinz*rpsinz ) + gb = max( 0._r8,rjp1*rjp1 - rpsinz*rpsinz ) + if( id > i .and. j == id ) then + dsj = sqrt( ga ) + else + dsj = sqrt( ga ) - sm*sqrt( gb ) + end if + dsdh(i,j) = dsj / dhj + end do + nid(i) = id + end if + end do + + end subroutine sphers + + end module mo_sphers diff --git a/src/chemistry/mozart/mo_srf_emissions.F90 b/src/chemistry/mozart/mo_srf_emissions.F90 new file mode 100644 index 0000000000..f1cc056d9c --- /dev/null +++ b/src/chemistry/mozart/mo_srf_emissions.F90 @@ -0,0 +1,451 @@ +module mo_srf_emissions + !--------------------------------------------------------------- + ! ... surface emissions module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : gas_pcnst + use spmd_utils, only : masterproc,iam + use mo_tracname, only : solsym + use cam_abortutils,only : endrun + use ioFileMod, only : getfil + use ppgrid, only : pcols, begchunk, endchunk + use cam_logfile, only : iulog + use tracer_data, only : trfld,trfile + + implicit none + + type :: emission + integer :: spc_ndx + real(r8) :: mw + real(r8) :: scalefactor + character(len=256):: filename + character(len=16) :: species + character(len=8) :: units + integer :: nsectors + character(len=32),pointer :: sectors(:) + type(trfld), pointer :: fields(:) + type(trfile) :: file + end type emission + + private + + public :: srf_emissions_inti, set_srf_emissions, set_srf_emissions_time + + save + + real(r8), parameter :: amufac = 1.65979e-23_r8 ! 1.e4* kg / amu + logical :: has_emis(gas_pcnst) + type(emission), allocatable :: emissions(:) + integer :: n_emis_files + integer :: c10h16_ndx, isop_ndx + +contains + + subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, emis_fixed_ymd, emis_fixed_tod ) + + !----------------------------------------------------------------------- + ! ... initialize the surface emissions + !----------------------------------------------------------------------- + + use chem_mods, only : adv_mass + use mo_constants, only : d2r, pi, rearth + use string_utils, only : to_upper + use mo_chem_utls, only : get_spc_ndx + use tracer_data, only : trcdata_init + use cam_pio_utils, only : cam_pio_openfile + use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims + use pio, only : pio_inq_varname, file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use chem_surfvals, only : flbc_list + use string_utils, only : GLC + use m_MergeSorts, only : IndexSort + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: srf_emis_specifier(:) + character(len=*), intent(in) :: emis_type_in + integer, intent(in) :: emis_cycle_yr + integer, intent(in) :: emis_fixed_ymd + integer, intent(in) :: emis_fixed_tod + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: astat + integer :: j, l, m, n, i, nn ! Indices + character(len=16) :: spc_name + character(len=256) :: filename + + character(len=16) :: emis_species(gas_pcnst) + character(len=256) :: emis_filenam(gas_pcnst) + integer :: emis_indexes(gas_pcnst) + integer :: indx(gas_pcnst) + real(r8) :: emis_scalefactor(gas_pcnst) + + integer :: vid, nvars, isec + integer, allocatable :: vndims(:) + type(file_desc_t) :: ncid + character(len=32) :: varname + character(len=256) :: locfn + integer :: ierr + character(len=1), parameter :: filelist = '' + character(len=1), parameter :: datapath = '' + logical , parameter :: rmv_file = .false. + + character(len=32) :: emis_type = ' ' + character(len=80) :: file_interp_type = ' ' + character(len=256) :: tmp_string = ' ' + character(len=32) :: xchr = ' ' + real(r8) :: xdbl + + has_emis(:) = .false. + nn = 0 + indx(:) = 0 + + count_emis: do n=1,gas_pcnst + if ( len_trim(srf_emis_specifier(n) ) == 0 ) then + exit count_emis + endif + + i = scan(srf_emis_specifier(n),'->') + spc_name = trim(adjustl(srf_emis_specifier(n)(:i-1))) + + ! need to parse out scalefactor ... + tmp_string = adjustl(srf_emis_specifier(n)(i+2:)) + j = scan( tmp_string, '*' ) + if (j>0) then + xchr = tmp_string(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*') + else + xdbl = 1._r8 + endif + filename = trim(tmp_string) + + m = get_spc_ndx(spc_name) + + if (m > 0) then + has_emis(m) = .true. + else + write(iulog,*) 'srf_emis_inti: spc_name ',spc_name,' is not included in the simulation' + call endrun('srf_emis_inti: invalid surface emission specification') + endif + + if (any( flbc_list == spc_name )) then + call endrun('srf_emis_inti: ERROR -- cannot specify both fixed LBC ' & + //'and emissions for the same species: '//trim(spc_name)) + endif + + nn = nn+1 + emis_species(nn) = spc_name + emis_filenam(nn) = filename + emis_indexes(nn) = m + emis_scalefactor(nn) = xdbl + + indx(n)=n + + enddo count_emis + + n_emis_files = nn + + if (masterproc) write(iulog,*) 'srf_emis_inti: n_emis_files = ',n_emis_files + + allocate( emissions(n_emis_files), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'srf_emis_inti: failed to allocate emissions array; error = ',astat + call endrun('srf_emis_inti: failed to allocate emissions array') + end if + + !----------------------------------------------------------------------- + ! Sort the input files so that the emissions sources are summed in the + ! same order regardless of the order of the input files in the namelist + !----------------------------------------------------------------------- + if (n_emis_files > 0) then + call IndexSort(n_emis_files, indx, emis_filenam) + end if + + !----------------------------------------------------------------------- + ! ... setup the emission type array + !----------------------------------------------------------------------- + do m=1,n_emis_files + emissions(m)%spc_ndx = emis_indexes(indx(m)) + emissions(m)%units = 'Tg/y' + emissions(m)%species = emis_species(indx(m)) + emissions(m)%mw = adv_mass(emis_indexes(indx(m))) ! g / mole + emissions(m)%filename = emis_filenam(indx(m)) + emissions(m)%scalefactor = emis_scalefactor(indx(m)) + enddo + + !----------------------------------------------------------------------- + ! read emis files to determine number of sectors + !----------------------------------------------------------------------- + spc_loop: do m = 1, n_emis_files + + emissions(m)%nsectors = 0 + + call getfil (emissions(m)%filename, locfn, 0) + call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE) + ierr = pio_inquire (ncid, nvariables=nvars) + + allocate(vndims(nvars)) + + do vid = 1,nvars + + ierr = pio_inq_varndims (ncid, vid, vndims(vid)) + + if( vndims(vid) < 3 ) then + cycle + elseif( vndims(vid) > 3 ) then + ierr = pio_inq_varname (ncid, vid, varname) + write(iulog,*) 'srf_emis_inti: Skipping variable ', trim(varname),', ndims = ',vndims(vid), & + ' , species=',trim(emissions(m)%species) + cycle + end if + + emissions(m)%nsectors = emissions(m)%nsectors+1 + + enddo + + allocate( emissions(m)%sectors(emissions(m)%nsectors), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'srf_emis_inti: failed to allocate emissions(m)%sectors array; error = ',astat + call endrun + end if + + isec = 1 + + do vid = 1,nvars + if( vndims(vid) == 3 ) then + ierr = pio_inq_varname(ncid, vid, emissions(m)%sectors(isec)) + isec = isec+1 + endif + + enddo + deallocate(vndims) + + ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on + ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! attribute then the srf_emis_type namelist setting is used. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + if ( ierr == PIO_NOERR) then + l = GLC(file_interp_type) + emis_type(1:l) = file_interp_type(1:l) + emis_type(l+1:) = ' ' + else + emis_type = trim(emis_type_in) + endif + + call pio_closefile (ncid) + + allocate(emissions(m)%file%in_pbuf(size(emissions(m)%sectors))) + emissions(m)%file%in_pbuf(:) = .false. + + call trcdata_init( emissions(m)%sectors, & + emissions(m)%filename, filelist, datapath, & + emissions(m)%fields, & + emissions(m)%file, & + rmv_file, emis_cycle_yr, emis_fixed_ymd, emis_fixed_tod, trim(emis_type) ) + + enddo spc_loop + + c10h16_ndx = get_spc_ndx('C10H16') + isop_ndx = get_spc_ndx('ISOP') + + end subroutine srf_emissions_inti + + subroutine set_srf_emissions_time( pbuf2d, state ) + !----------------------------------------------------------------------- + ! ... check serial case for time span + !----------------------------------------------------------------------- + + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use tracer_data, only : advance_trcdata + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + do m = 1,n_emis_files + call advance_trcdata( emissions(m)%fields, emissions(m)%file, state, pbuf2d ) + end do + + end subroutine set_srf_emissions_time + + ! adds surf flux specified in file to sflx + subroutine set_srf_emissions( lchnk, ncol, sflx ) + !-------------------------------------------------------- + ! ... form the surface fluxes for this latitude slice + !-------------------------------------------------------- + + use mo_constants, only : pi + use time_manager, only : get_curr_calday + use string_utils, only : to_lower, GLC + use phys_grid, only : get_rlat_all_p, get_rlon_all_p + + implicit none + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: sflx(:,:) ! surface emissions ( kg/m^2/s ) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: i, m, n + real(r8) :: factor + real(r8) :: dayfrac ! fration of day in light + real(r8) :: iso_off ! time iso flux turns off + real(r8) :: iso_on ! time iso flux turns on + + logical :: polar_day,polar_night + real(r8) :: doy_loc + real(r8) :: sunon,sunoff + real(r8) :: loc_angle + real(r8) :: latitude + real(r8) :: declination + real(r8) :: tod + real(r8) :: calday + + real(r8), parameter :: dayspy = 365._r8 + real(r8), parameter :: twopi = 2.0_r8 * pi + real(r8), parameter :: pid2 = 0.5_r8 * pi + real(r8), parameter :: dec_max = 23.45_r8 * pi/180._r8 + + real(r8) :: flux(ncol) + real(r8) :: mfactor + integer :: isec + + character(len=12),parameter :: mks_units(4) = (/ "kg/m2/s ", & + "kg/m2/sec ", & + "kg/m^2/s ", & + "kg/m^2/sec " /) + character(len=12) :: units + + real(r8), dimension(ncol) :: rlats, rlons + + sflx(:,:) = 0._r8 + + !-------------------------------------------------------- + ! ... set non-zero emissions + !-------------------------------------------------------- + emis_loop : do m = 1,n_emis_files + + n = emissions(m)%spc_ndx + + flux(:) = 0._r8 + do isec = 1,emissions(m)%nsectors + flux(:ncol) = flux(:ncol) + emissions(m)%scalefactor*emissions(m)%fields(isec)%data(:ncol,1,lchnk) + enddo + + units = to_lower(trim(emissions(m)%fields(1)%units(:GLC(emissions(m)%fields(1)%units)))) + + if ( any( mks_units(:) == units ) ) then + sflx(:ncol,n) = sflx(:ncol,n) + flux(:ncol) + else + mfactor = amufac * emissions(m)%mw + sflx(:ncol,n) = sflx(:ncol,n) + flux(:ncol) * mfactor + endif + + end do emis_loop + + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + + calday = get_curr_calday() + doy_loc = aint( calday ) + declination = dec_max * cos((doy_loc - 172._r8)*twopi/dayspy) + tod = (calday - doy_loc) + .5_r8 + + do i = 1,ncol + ! + polar_day = .false. + polar_night = .false. + ! + loc_angle = tod * twopi + rlons(i) + loc_angle = mod( loc_angle,twopi ) + latitude = rlats(i) + ! + !------------------------------------------------------------------ + ! determine if in polar day or night + ! if not in polar day or night then + ! calculate terminator longitudes + !------------------------------------------------------------------ + if( abs(latitude) >= (pid2 - abs(declination)) ) then + if( sign(1._r8,declination) == sign(1._r8,latitude) ) then + polar_day = .true. + sunoff = 2._r8*twopi + sunon = -twopi + else + polar_night = .true. + end if + else + sunoff = acos( -tan(declination)*tan(latitude) ) + sunon = twopi - sunoff + end if + + !-------------------------------------------------------- + ! ... adjust alpha-pinene for diurnal variation + !-------------------------------------------------------- + if( c10h16_ndx > 0 ) then + if( has_emis(c10h16_ndx) ) then + if( .not. polar_night .and. .not. polar_day ) then + dayfrac = sunoff / pi + sflx(i,c10h16_ndx) = sflx(i,c10h16_ndx) / (.7_r8 + .3_r8*dayfrac) + if( loc_angle >= sunoff .and. loc_angle <= sunon ) then + sflx(i,c10h16_ndx) = sflx(i,c10h16_ndx) * .7_r8 + endif + end if + end if + end if + + !-------------------------------------------------------- + ! ... adjust isoprene for diurnal variation + !-------------------------------------------------------- + if( isop_ndx > 0 ) then + if( has_emis(isop_ndx) ) then + if( .not. polar_night ) then + if( polar_day ) then + iso_off = .8_r8 * pi + iso_on = 1.2_r8 * pi + else + iso_off = .8_r8 * sunoff + iso_on = 2._r8 * pi - iso_off + end if + if( loc_angle >= iso_off .and. loc_angle <= iso_on ) then + sflx(i,isop_ndx) = 0._r8 + else + factor = loc_angle - iso_on + if( factor <= 0._r8 ) then + factor = factor + 2._r8*pi + end if + factor = factor / (2._r8*iso_off + 1.e-6_r8) + sflx(i,isop_ndx) = sflx(i,isop_ndx) * 2._r8 / iso_off * pi * (sin(pi*factor))**2 + end if + else + sflx(i,isop_ndx) = 0._r8 + end if + end if + end if + + end do + + end subroutine set_srf_emissions + +end module mo_srf_emissions diff --git a/src/chemistry/mozart/mo_strato_rates.F90 b/src/chemistry/mozart/mo_strato_rates.F90 new file mode 100644 index 0000000000..da3c16bb4e --- /dev/null +++ b/src/chemistry/mozart/mo_strato_rates.F90 @@ -0,0 +1,886 @@ + + module mo_strato_rates +!======================================================================= +! ROUTINE +! ratecon_sfstrat.f +! +! Date... +! 15 August 2002 +! 11 April 2008 +! 15 December 2014 +! +! Programmed by... +! Douglas E. Kinnison +! +! DESCRIPTION +! +! Derivation of the rate constant for reactions on +! sulfate, NAT, and ICE aerosols. +! +! +! Sulfate Aerosol Reactions Rxn# Gamma +! N2O5 + H2O(l) => 2HNO3 (1) f(wt%) +! ClONO2 + H2O(l) => HOCl + HNO3 (2) f(T,P,HCl,H2O,r) +! BrONO2 + H2O(l) => HOBr + HNO3 (3) f(T,P,H2O,r) +! ClONO2 + HCl(l) => Cl2 + HNO3 (4) f(T,P,HCl,H2O,r) +! HOCl + HCl(l) => Cl2 + H2O (5) f(T,P,HCl,HOCl,H2O,r) +! HOBr + HCl(l) => BrCl + H2O (6) f(T,P,HCl,HOBr,H2O,r) +! +! Nitric Acid Tri-hydrate Reactions Rxn# Gamma Reference +! N2O5 + H2O(s) => 2HNO3 (7) 4e-4 JPL10-6 +! ClONO2 + H2O(s) => HOCl + HNO3 (8) 4e-3 JPL10-6 +! ClONO2 + HCl(s) => Cl2 + HNO3 (9) 0.2 JPL10-6 +! HOCl + HCl(s) => Cl2 + H2O (10) 0.1 JPL10-6 +! BrONO2 + H2O(s) => HOBr + HNO3 (11) 0.006 Davies et JGR, 2003 +! +! WATER-ICE Aersol Reactions Rxn# Gamma +! N2O5 + H2O(s) => 2HNO3 (12) 0.02 JPL10-6 +! ClONO2 + H2O(s) => HOCl + HNO3 (13) 0.3 JPL10-6 +! BrONO2 + H2O(s) => HOBr + HNO3 (14) 0.3 JPL10-6 +! ClONO2 + HCl(s) => Cl2 + HNO3 (15) 0.3 JPL10-6 +! HOCl + HCl(s) => Cl2 + H2O (16) 0.2 JPL10-6 +! HOBr + HCl(s) => BrCl + H2O (17) 0.3 JPL10-6 +! +! NOTE: The rate constants derived from species reacting with H2O are +! first order (i.e., sec-1 units) - an example is N2O5 + H2O = 2HNO3. +! Other reactions, e.g., ClONO2 + HCl have rate constants that +! are second order (i.e., cm+3 molecules-1 sec-1 units). In all +! of these types of reactions the derived first order rate constant +! {0.25*(mean Velocity)*SAD*gamma} is divided by the HCl abundance +! to derive the correct second order units. +! +! NOTE: Liquid Sulfate Aerosols... +! See coding for references on how the Sulfate Aerosols were handled. +! Approach follows Shi et al., JGR, 106, D20, 24259, 2001. +! +! +! INPUT: +! ad . .... air density, molec. cm-3 +! pmid ..... pressures, hPa +! temp ..... temperatures, K +! rad_sulfate ..... Surface area density, cm2 cm-3 +! sad_sulfate ..... Surface area density, cm2 cm-3 +! sad_nat ..... Surface area density, cm2 cm-3 +! sad_ice ..... Surface area density, cm2 cm-3 +! brono2mv ..... BrONO2 Volume Mixing Ratio +! clono2mvr ..... ClONO2 Volume Mixing Ratio +! h2omvr ..... H2O Volume Mixing Ratio +! hclmvr ..... HCl Volume Mixing Ratio +! hobrmvr ..... HOBr Volume Mixing Ratio +! hoclmvr ..... HOCl Volume Mixing Ratio +! n2o5mvr ..... N2O5 Volume Mixing Ratio +! +! OUTPUT: +! +! rxt ..... Rate constant (s-1 and cm3 sec-1 molec-1) +!======================================================================= + + private + public :: ratecon_sfstrat, init_strato_rates, has_strato_chem + + integer :: id_brono2, id_clono2, id_hcl, id_hocl, & + id_hobr, id_n2o5 + integer :: rid_het1, rid_het2, rid_het3, rid_het4, rid_het5, & + rid_het6, rid_het7, rid_het8, rid_het9, rid_het10, & + rid_het11, rid_het12, rid_het13, rid_het14, rid_het15, & + rid_het16, rid_het17 + + logical :: has_strato_chem + + contains + + subroutine init_strato_rates + + use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx + use mo_aero_settling, only : strat_aer_settl_init + use ppgrid, only : pcols, pver + + implicit none + + integer :: ids(23) + + rid_het1 = get_rxt_ndx( 'het1' ) + rid_het2 = get_rxt_ndx( 'het2' ) + rid_het3 = get_rxt_ndx( 'het3' ) + rid_het4 = get_rxt_ndx( 'het4' ) + rid_het5 = get_rxt_ndx( 'het5' ) + rid_het6 = get_rxt_ndx( 'het6' ) + rid_het7 = get_rxt_ndx( 'het7' ) + rid_het8 = get_rxt_ndx( 'het8' ) + rid_het9 = get_rxt_ndx( 'het9' ) + rid_het10 = get_rxt_ndx( 'het10' ) + rid_het11 = get_rxt_ndx( 'het11' ) + rid_het12 = get_rxt_ndx( 'het12' ) + rid_het13 = get_rxt_ndx( 'het13' ) + rid_het14 = get_rxt_ndx( 'het14' ) + rid_het15 = get_rxt_ndx( 'het15' ) + rid_het16 = get_rxt_ndx( 'het16' ) + rid_het17 = get_rxt_ndx( 'het17' ) + + id_brono2 = get_spc_ndx( 'BRONO2' ) + id_clono2 = get_spc_ndx( 'CLONO2' ) + id_hcl = get_spc_ndx( 'HCL' ) + id_hocl = get_spc_ndx( 'HOCL' ) + id_hobr = get_spc_ndx( 'HOBR' ) + id_n2o5 = get_spc_ndx( 'N2O5' ) + + ids(:) = (/ rid_het1, rid_het2, rid_het3, rid_het4, rid_het5, rid_het6, rid_het7, rid_het8, & + rid_het9, rid_het10, rid_het11, rid_het12, rid_het13, rid_het14, rid_het15, & + rid_het16, rid_het17, id_brono2, id_clono2, id_hcl, id_hocl, id_hobr, id_n2o5 /) + + has_strato_chem = all( ids(:) > 0 ) + + if (.not. has_strato_chem) return + + call strat_aer_settl_init + + endsubroutine init_strato_rates + + subroutine ratecon_sfstrat( ncol, ad, pmid, temp, rad_sulfate, sad_sulfate, & + sad_nat, sad_ice, h2ovmr, vmr, rxt, & + gprob_n2o5, gprob_cnt_hcl, gprob_cnt_h2o, gprob_bnt_h2o, & + gprob_hocl_hcl, gprob_hobr_hcl, wtper ) + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : adv_mass, rxntot, gas_pcnst + use ppgrid, only : pcols, pver + use mo_sad, only : sad_top + use cam_logfile, only : iulog + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + real(r8), dimension(ncol,pver,gas_pcnst), intent(in) :: & ! species concentrations (mol/mol) + vmr + real(r8), dimension(ncol,pver), intent(in) :: & + ad, & ! Air Density (molec. cm-3) + rad_sulfate, & ! Radius of Sulfate Aerosol (cm) + sad_ice, & ! ICE Surface Area Density (cm-1) + sad_nat, & ! NAT Surface Area Density (cm-1) + sad_sulfate, & ! Sulfate Surface Area Density (cm-1) + h2ovmr ! water vapor volume mixing ratio( gas phase ) + real(r8), dimension(pcols,pver), intent(in) :: & + pmid, & ! pressure (Pa) + temp ! temperature (K) + + real(r8), intent(out) :: & + rxt(ncol,pver,rxntot) ! rate constants + + real(r8), dimension(ncol,pver), intent(out) :: & ! diagnostics + gprob_n2o5, & + gprob_cnt_hcl, & + gprob_cnt_h2o, & + gprob_bnt_h2o, & + gprob_hocl_hcl, & + gprob_hobr_hcl, & + wtper + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: small_div = 1.e-16_r8 ! for divid by excess species + real(r8), parameter :: av_const = 2.117265e4_r8 ! (8*8.31448*1000 / PI) + real(r8), parameter :: pa2mb = 1.e-2_r8 ! Pa to mb + real(r8), parameter :: m2cm = 100._r8 ! meters to cms + + integer :: & + i, & ! altitude loop index + k, & ! level loop index + m ! species index + +!----------------------------------------------------------------------- +! ... variables for gamma calculations +!----------------------------------------------------------------------- + real(r8) :: & + brono2vmr, & ! BrONO2 Volume Mixing Ratio + clono2vmr, & ! ClONO2 Volume Mixing Ratio + hclvmr, & ! HCl Volume Mixing Ratio + hcldeni, & ! inverse of HCl density + cntdeni, & ! inverse of ClONO2 density + hocldeni, & ! inverse of HOCl density + hobrdeni, & ! inverse of HOBr density + hoclvmr, & ! HOCl Volume Mixing Ratio + hobrvmr, & ! HOBr Volume Mixing Ratio + n2o5vmr ! N2O5 Volume Mixing Ratio + + real(r8) :: & + av_n2o5, & ! N2O5 Mean Velocity (cm s-1) + av_clono2, & ! ClONO2 Mean Velocity (cm s-1) + av_brono2, & ! BrONO2Mean Velocity (cm s-1) + av_hocl, & ! HOCl Mean Velocity (cm s-1) + av_hobr ! HOBr Mean Velocity (cm s-1) + + real(r8) :: & + pzero_h2o, & ! H2O sat vapor press (mbar) + e0, e1, e2, e3, & ! coefficients for H2O sat vapor press. + aw, & ! Water activity + m_h2so4, & ! H2SO4 molality (mol/kg) + wt, & ! wt % H2SO4 + y1, y2, & ! used in H2SO4 molality + & a1, b1, c1, d1, & ! used in H2SO4 molality + a2, b2, c2, d2 ! used in H2SO4 molality + + real(r8) :: & + z1, z2, z3, & ! used in H2SO4 soln density + den_h2so4, & ! H2SO4 soln density, g/cm3 + mol_h2so4, & ! Molality of H2SO4, mol / kg + molar_h2so4, & ! Molarity of H2SO4, mol / l + x_h2so4, & ! H2SO4 mole fraction + aconst, tzero, & ! used in viscosity of H2SO4 + vis_h2so4, & ! H2SO4 viscosity + ah, & ! Acid activity, molarity units + term1,term2,term3,term4, & ! used in ah + term5,term6,term7,term0, & + T_limit, & ! temporary variable for temp (185-260K range) + T_limiti, & ! 1./T_limit + T_limitsq, & ! sqrt( T_limit ) + rad_sulf, & ! temporary variable for sulfate radius (cm) + sadsulf, & ! temporary variable for sulfate radius (cm) + sadice, & ! temporary variable for sulfate radius (cm) + sadnat ! temporary variable for sulfate radius (cm) + + real(r8) :: & + C_cnt, S_cnt, & ! used in H_cnt + H_cnt, & ! Henry's law coeff. for ClONO2 + H_hcl, & ! Henry's law coeff. for HCl + D_cnt, & + k_hydr, & + k_h2o, & + k_h, & + k_hcl, & + rdl_cnt, & + f_cnt, & + M_hcl, & + atmos + + real(r8) :: & + Gamma_b_h2o, & + Gamma_cnt_rxn, & + Gamma_b_hcl, & + Gamma_s, & + Fhcl, & + Gamma_s_prime, & + Gamma_b_hcl_prime, & + Gamma_b, & + gprob_rxn, & + gprob_tot, & + gprob_cnt + + real(r8) :: & + D_hocl, & + k_hocl_hcl, & + C_hocl, & + S_hocl, & + H_hocl, & + Gamma_hocl_rxn, & + rdl_hocl, & + f_hocl + + real(r8) :: & + h1, h2, h3, & + alpha + + real(r8) :: & + C_hobr, & + D_hobr, & + aa, bb, cc, dd, & + k_hobr_hcl, & + k_dl, & + k_wasch, & + H_hobr, & + rdl_hobr, & + Gamma_hobr_rxn, & + f_hobr + + real(r8) :: & + pmb,& ! Pressure, mbar (hPa) + pH2O_atm,& ! Partial press. H2O (atm) + pH2O_hPa,& ! Partial press. H2O (hPa) + pHCl_atm,& ! Partial press. HCl (atm) + pCNT_atm ! Partial press. ClONO2 (atm) + +!----------------------------------------------------------------------- +! ... Used in pzero h2o calculation +!----------------------------------------------------------------------- + real(r8), parameter :: wt_e0 = 18.452406985_r8 + real(r8), parameter :: wt_e1 = 3505.1578807_r8 + real(r8), parameter :: wt_e2 = 330918.55082_r8 + real(r8), parameter :: wt_e3 = 12725068.262_r8 + + real(r8) :: & + wrk, tmp + + + + if (.not. has_strato_chem) return + +!----------------------------------------------------------------------- +! ... intialize rate constants +!----------------------------------------------------------------------- + do k = 1,pver + rxt(:,k,rid_het1) = 0._r8 + rxt(:,k,rid_het2) = 0._r8 + rxt(:,k,rid_het3) = 0._r8 + rxt(:,k,rid_het4) = 0._r8 + rxt(:,k,rid_het5) = 0._r8 + rxt(:,k,rid_het6) = 0._r8 + rxt(:,k,rid_het7) = 0._r8 + rxt(:,k,rid_het8) = 0._r8 + rxt(:,k,rid_het9) = 0._r8 + rxt(:,k,rid_het10) = 0._r8 + rxt(:,k,rid_het11) = 0._r8 + rxt(:,k,rid_het12) = 0._r8 + rxt(:,k,rid_het13) = 0._r8 + rxt(:,k,rid_het14) = 0._r8 + rxt(:,k,rid_het15) = 0._r8 + rxt(:,k,rid_het16) = 0._r8 + rxt(:,k,rid_het17) = 0._r8 + + gprob_n2o5(:,k) = 0._r8 + gprob_cnt_h2o(:,k) = 0._r8 + gprob_cnt_hcl(:,k) = 0._r8 + gprob_bnt_h2o(:,k) = 0._r8 + gprob_hocl_hcl(:,k)= 0._r8 + gprob_hobr_hcl(:,k)= 0._r8 + wtper(:,k) = 0._r8 + end do + +!----------------------------------------------------------------------- +! ... set rate constants +!----------------------------------------------------------------------- +Level_loop : & + do k = sad_top+1,pver +column_loop : & + do i = 1,ncol +!----------------------------------------------------------------------- +! ... set species, pmb, and atmos +!----------------------------------------------------------------------- + brono2vmr = vmr(i,k,id_brono2) + clono2vmr = vmr(i,k,id_clono2) + hclvmr = vmr(i,k,id_hcl) + hoclvmr = vmr(i,k,id_hocl) + hobrvmr = vmr(i,k,id_hobr) + if( hclvmr > 0._r8 ) then + hcldeni = 1._r8/(hclvmr*ad(i,k)) + end if + if( clono2vmr > 0._r8 ) then + cntdeni = 1._r8/(clono2vmr*ad(i,k)) + end if + if( hoclvmr > 0._r8 ) then + hocldeni = 1._r8/(hoclvmr*ad(i,k)) + end if + if( hobrvmr > 0._r8 ) then + hobrdeni = 1._r8/(hobrvmr*ad(i,k)) + end if + n2o5vmr = vmr(i,k,id_n2o5) + sadsulf = sad_sulfate(i,k) + sadnat = sad_nat(i,k) + sadice = sad_ice(i,k) + pmb = pa2mb*pmid(i,k) + atmos = pmb/1013.25_r8 + +!----------------------------------------------------------------------- +! ... setup for stratospheric aerosols +! data range set: 185K - 240K; Tabazedeh GRL, 24, 1931, 1997 +!----------------------------------------------------------------------- + T_limit = max( temp(i,k),185._r8 ) + T_limit = min( T_limit,240._r8 ) + T_limiti = 1._r8/T_limit + T_limitsq = sqrt( T_limit ) + +!----------------------------------------------------------------------- +! .... Average velocity (8RT*1000/(PI*MW))**1/2 * 100.(units cm s-1) +! .... or (av_const*T/M2)**1/2 +!----------------------------------------------------------------------- + wrk = av_const*T_limit + av_n2o5 = sqrt( wrk/adv_mass(id_n2o5) )*m2cm + av_clono2 = sqrt( wrk/adv_mass(id_clono2) )*m2cm + av_brono2 = sqrt( wrk/adv_mass(id_brono2) )*m2cm + av_hocl = sqrt( wrk/adv_mass(id_hocl) )*m2cm + av_hobr = sqrt( wrk/adv_mass(id_hobr) )*m2cm +has_sadsulf : & + if( sadsulf > 0._r8 ) then +!----------------------------------------------------------------------- +! .... Partial Pressure of H2O, ClONO2, and HCl in atmospheres +!----------------------------------------------------------------------- + if( hclvmr > 0._r8 ) then + pHCl_atm = hclvmr*atmos + else + pHCl_atm = 0._r8 + end if + + if( clono2vmr > 0._r8 ) then + pCNT_atm = clono2vmr*atmos + else + pCNT_atm = 0._r8 + end if + + if( h2ovmr(i,k) > 0._r8 ) then + pH2O_atm = h2ovmr(i,k)*atmos + else + pH2O_atm = 0._r8 + end if +!----------------------------------------------------------------------- +! .... Partial Pressure of H2O in hPa +!----------------------------------------------------------------------- + pH2O_hpa = h2ovmr(i,k)*pmb +!----------------------------------------------------------------------- +! .... Calculate the h2so4 Wt% and Activity of H2O - +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Saturation Water Vapor Pressure (mbar) +!----------------------------------------------------------------------- + pzero_h2o = exp( wt_e0 - T_limiti*(wt_e1 + T_limiti*(wt_e2 - T_limiti*wt_e3)) ) +!----------------------------------------------------------------------- +! ... H2O activity +! ... if the activity of H2O goes above 1.0, wt% can go negative +!----------------------------------------------------------------------- + aw = ph2o_hpa / pzero_h2o + aw = min( aw,1._r8 ) + aw = max( aw,.001_r8 ) +!----------------------------------------------------------------------- +! ... h2so4 Molality (mol/kg) +!----------------------------------------------------------------------- + if( aw <= .05_r8 ) then + a1 = 12.37208932_r8 + b1 = -0.16125516114_r8 + c1 = -30.490657554_r8 + d1 = -2.1133114241_r8 + a2 = 13.455394705_r8 + b2 = -0.1921312255_r8 + c2 = -34.285174607_r8 + d2 = -1.7620073078_r8 + else if( aw > .05_r8 .and. aw < .85_r8 ) then + a1 = 11.820654354_r8 + b1 = -0.20786404244_r8 + c1 = -4.807306373_r8 + d1 = -5.1727540348_r8 + a2 = 12.891938068_r8 + b2 = -0.23233847708_r8 + c2 = -6.4261237757_r8 + d2 = -4.9005471319_r8 + else + a1 = -180.06541028_r8 + b1 = -0.38601102592_r8 + c1 = -93.317846778_r8 + d1 = 273.88132245_r8 + a2 = -176.95814097_r8 + b2 = -0.36257048154_r8 + c2 = -90.469744201_r8 + d2 = 267.45509988_r8 + end if +!----------------------------------------------------------------------- +! ... h2so4 mole fraction +!----------------------------------------------------------------------- + y1 = a1*(aw**b1) + c1*aw + d1 + y2 = a2*(aw**b2) + c2*aw + d2 + m_h2so4 = y1 + ((T_limit - 190._r8)*(y2 - y1)) / 70._r8 +!----------------------------------------------------------------------- +! ... h2so4 Weight Percent +!----------------------------------------------------------------------- + wt = 9800._r8*m_h2so4 / (98._r8*m_h2so4 + 1000._r8) + wtper(i,k) = wt +!----------------------------------------------------------------------- +! .... Parameters for h2so4 Solution +!----------------------------------------------------------------------- +! ... h2so4 Solution Density (g/cm3) +!----------------------------------------------------------------------- + wrk = T_limit*T_limit + z1 = .12364_r8 - 5.6e-7_r8*wrk + z2 = -.02954_r8 + 1.814e-7_r8*wrk + z3 = 2.343e-3_r8 - T_limit*1.487e-6_r8 - 1.324e-8_r8*wrk +!----------------------------------------------------------------------- +! ... where mol_h2so4 is molality in mol/kg +!----------------------------------------------------------------------- + den_h2so4 = 1._r8 + m_h2so4*(z1 + z2*sqrt(m_h2so4) + z3*m_h2so4) +!----------------------------------------------------------------------- +! ... h2so4 Molarity, mol / l +!----------------------------------------------------------------------- + molar_h2so4 = den_h2so4*wt/9.8_r8 +!----------------------------------------------------------------------- +! ... h2so4 Mole fraction +!----------------------------------------------------------------------- + x_h2so4 = wt / (wt + ((100._r8 - wt)*98._r8/18._r8)) + term1 = .094_r8 - x_h2so4*(.61_r8 - 1.2_r8*x_h2so4) + term2 = (8515._r8 - 10718._r8*(x_h2so4**.7_r8))*T_limiti + H_hcl = term1 * exp( -8.68_r8 + term2 ) + M_hcl = H_hcl*pHCl_atm +!----------------------------------------------------------------------- +! ... h2so4 solution viscosity +!----------------------------------------------------------------------- + aconst = 169.5_r8 + wt*(5.18_r8 - wt*(.0825_r8 - 3.27e-3_r8*wt)) + tzero = 144.11_r8 + wt*(.166_r8 - wt*(.015_r8 - 2.18e-4_r8*wt)) + vis_h2so4 = aconst/(T_limit**1.43_r8) * exp( 448._r8/(T_limit - tzero) ) +!----------------------------------------------------------------------- +! ... Acid activity in molarity +!----------------------------------------------------------------------- + term1 = 60.51_r8 + term2 = .095_r8*wt + wrk = wt*wt + term3 = .0077_r8*wrk + term4 = 1.61e-5_r8*wt*wrk + term5 = (1.76_r8 + 2.52e-4_r8*wrk) * T_limitsq + term6 = -805.89_r8 + (253.05_r8*(wt**.076_r8)) + term7 = T_limitsq + ah = exp( term1 - term2 + term3 - term4 - term5 + term6/term7 ) + if( ah <= 0._r8 ) then + write(iulog,*) 'ratecon: ah <= 0 at i,k, = ',i,k + write(iulog,*) 'ratecon: term1,term2,term3,term4,term5,term6,term7,wt,T_limit,ah = ', & + term1,term2,term3,term4,term5,term6,term7,wt,T_limit,ah + end if + + wrk = .25_r8*sadsulf + rad_sulf = max( rad_sulfate(i,k),1.e-6_r8 ) +!----------------------------------------------------------------------- +! N2O5 + H2O(liq) => 2.00*HNO3 Sulfate Aerosol Reaction +!----------------------------------------------------------------------- + term0 = -25.5265_r8 - wt*(.133188_r8 - wt*(.00930846_r8 - 9.0194e-5_r8*wt)) + term1 = 9283.76_r8 + wt*(115.345_r8 - wt*(5.19258_r8 - .0483464_r8*wt)) + term2 = -851801._r8 - wt*(22191.2_r8 - wt*(766.916_r8 - 6.85427_r8*wt)) + gprob_n2o5(i,k) = exp( term0 + T_limiti*(term1 + term2*T_limiti) ) + rxt(i,k,rid_het1) = max( 0._r8,wrk*av_n2o5*gprob_n2o5(i,k) ) + +!----------------------------------------------------------------------- +! ClONO2 + H2O(liq) = HOCl + HNO3 Sulfate Aerosol Reaction +!----------------------------------------------------------------------- +! ... NOTE: Aerosol radius in units of cm. +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Radius sulfate set (from sad module) +! Set min radius to 0.01 microns (1e-6 cm) +! Typical radius is 0.1 microns (1e-5 cm) +! f_cnt may go negative under if not set. +!----------------------------------------------------------------------- + C_cnt = 1474._r8*T_limitsq + S_cnt = .306_r8 + 24._r8*T_limiti + term1 = exp( -S_cnt*molar_h2so4 ) + H_cnt = 1.6e-6_r8 * exp( 4710._r8*T_limiti )*term1 + D_cnt = 5.e-8_r8*T_limit / vis_h2so4 + k_h = 1.22e12_r8*exp( -6200._r8*T_limiti ) + k_h2o = 1.95e10_r8*exp( -2800._r8*T_limiti ) + k_hydr = (k_h2o + k_h*ah)*aw + k_hcl = 7.9e11_r8*ah*D_cnt*M_hcl + rdl_cnt = sqrt( D_cnt/(k_hydr + k_hcl) ) + term1 = 1._r8/tanh( rad_sulf/rdl_cnt ) + term2 = rdl_cnt/rad_sulf + f_cnt = term1 - term2 + if( f_cnt > 0._r8 ) then + term1 = 4._r8*H_cnt*.082_r8*T_limit + term2 = sqrt( D_cnt*k_hydr ) + Gamma_b_h2o = term1*term2/C_cnt + term1 = sqrt( 1._r8 + k_hcl/k_hydr ) + Gamma_cnt_rxn = f_cnt*Gamma_b_h2o*term1 + Gamma_b_hcl = Gamma_cnt_rxn*k_hcl/(k_hcl + k_hydr) + term1 = exp( -1374._r8*T_limiti ) + Gamma_s = 66.12_r8*H_cnt*M_hcl*term1 + if( pHCl_atm > 0._r8 ) then + term1 = .612_r8*(Gamma_s+Gamma_b_hcl)* pCNT_atm/pHCl_atm + Fhcl = 1._r8/(1._r8 + term1) + else + Fhcl = 1._r8 + end if + Gamma_s_prime = Fhcl*Gamma_s + Gamma_b_hcl_prime = Fhcl*Gamma_b_hcl + term1 = Gamma_cnt_rxn*k_hydr + term2 = k_hcl + k_hydr + Gamma_b = Gamma_b_hcl_prime + (term1/term2) + term1 = 1._r8 / (Gamma_s_prime + Gamma_b) + gprob_cnt = 1._r8 / (1._r8 + term1) + term1 = Gamma_s_prime + Gamma_b_hcl_prime + term2 = Gamma_s_prime + Gamma_b + gprob_cnt_hcl(i,k) = gprob_cnt * term1/term2 + gprob_cnt_h2o(i,k) = gprob_cnt - gprob_cnt_hcl(i,k) + else + gprob_cnt_h2o(i,k) = 0._r8 + gprob_cnt_hcl(i,k) = 0._r8 + Fhcl = 1._r8 + end if + + rxt(i,k,rid_het2) = max( 0._r8,wrk*av_clono2*gprob_cnt_h2o(i,k) ) + +!----------------------------------------------------------------------- +! ... BrONO2 + H2O(liq) = HOBr + HNO3 Sulfate Aerosol Reaction +!----------------------------------------------------------------------- + h1 = 29.24_r8 + h2 = -.396_r8 + h3 = .114_r8 + alpha = .805_r8 + gprob_rxn = exp( h1 + h2*wt ) + h3 + term1 = 1._r8/alpha + term2 = 1._r8/gprob_rxn + gprob_bnt_h2o(i,k) = 1._r8 / (term1 + term2) + rxt(i,k,rid_het3) = max( 0._r8,wrk*av_brono2*gprob_bnt_h2o(i,k) ) + +!----------------------------------------------------------------------- +! ... ClONO2 + HCl(liq) = Cl2 + HNO3 Sulfate Aerosol Reaction +!----------------------------------------------------------------------- + if( hclvmr > small_div .and. clono2vmr > small_div ) then + if ( hclvmr > clono2vmr ) then + rxt(i,k,rid_het4) = max( 0._r8,wrk*av_clono2*gprob_cnt_hcl(i,k) )*hcldeni + else + rxt(i,k,rid_het4) = max( 0._r8,wrk*av_clono2*gprob_cnt_hcl(i,k) )*cntdeni + end if + end if + +!----------------------------------------------------------------------- +! ... HOCl + HCl(liq) = Cl2 + H2O Sulfate Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Radius sulfate set (from sad module) +! Set min radius to 0.01 microns (1e-6 cm) +! Typical radius is 0.1 microns (1e-5 cm) +! f_hocl may go negative under if not set. +!----------------------------------------------------------------------- + if( pCNT_atm > 0._r8 ) then + D_hocl = 6.4e-8_r8*T_limit/vis_h2so4 + k_hocl_hcl = 1.25e9_r8*ah*D_hocl*M_hcl + C_hocl = 2009._r8*T_limitsq + S_hocl = .0776_r8 + 59.18_r8*T_limiti + term1 = exp( -S_hocl*molar_h2so4 ) + H_hocl = 1.91e-6_r8 * exp( 5862.4_r8*T_limiti )*term1 + term1 = 4._r8*H_hocl*.082_r8*T_limit + term2 = sqrt( D_hocl*k_hocl_hcl ) + Gamma_hocl_rxn = term1*term2/C_hocl + rdl_hocl = sqrt( D_hocl/k_hocl_hcl ) + term1 = 1._r8/tanh( rad_sulf/rdl_hocl ) + term2 = rdl_hocl/rad_sulf + f_hocl = term1 - term2 + if( f_hocl > 0._r8 ) then + term1 = 1._r8 / (f_hocl*Gamma_hocl_rxn*Fhcl) + gprob_hocl_hcl(i,k) = 1._r8 / (1._r8 + term1) + else + gprob_hocl_hcl(i,k) = 0._r8 + end if + + if( hclvmr > small_div .and. hoclvmr > small_div ) then + if ( hclvmr > hoclvmr ) then + rxt(i,k,rid_het5) = max( 0._r8,wrk*av_hocl*gprob_hocl_hcl(i,k) )*hcldeni + else + rxt(i,k,rid_het5) = max( 0._r8,wrk*av_hocl*gprob_hocl_hcl(i,k) )*hocldeni + end if + end if + end if + +!----------------------------------------------------------------------- +! ... HOBr + HCl(liq) = BrCl + H2O Sulfate Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Radius sulfate set (from sad module) +! Set min radius to 0.01 microns (1e-6 cm) +! Typical radius is 0.1 microns (1e-5 cm) +! f_hobr may go negative under if not set. +!----------------------------------------------------------------------- + C_hobr = 1477._r8*T_limitsq + D_hobr = 9.e-9_r8 +!----------------------------------------------------------------------- +! ... Taken from Waschewsky and Abbat +! Dave Hanson (PC) suggested we divide this rc by eight to agee +! with his data (Hanson, 108, D8, 4239, JGR, 2003). +! k1=k2*Mhcl for gamma(HOBr) +!----------------------------------------------------------------------- + k_wasch = .125_r8 * exp( .542_r8*wt - 6440._r8*T_limiti + 10.3_r8) +!----------------------------------------------------------------------- +! ... Taken from Hanson 2002. +!----------------------------------------------------------------------- + H_hobr = exp( -9.86_r8 + 5427._r8*T_limiti ) + k_dl = 7.5e14_r8*D_hobr*2._r8 ! or 7.5e14*D *(2nm) +!----------------------------------------------------------------------- +! ... If k_wasch is GE than the diffusion limit... +!----------------------------------------------------------------------- + if( M_hcl > 0._r8 ) then + if( k_wasch >= k_dl ) then + k_hobr_hcl = k_dl * M_hcl + else + k_hobr_hcl = k_wasch * M_hcl + end if + term1 = 4._r8*H_hobr*.082_r8*T_limit + term2 = sqrt( D_hobr*k_hobr_hcl ) + tmp = rad_sulf/term2 + Gamma_hobr_rxn = term1*term2/C_hobr + rdl_hobr = sqrt( D_hobr/k_hobr_hcl ) + if( tmp < 1.e2_r8 ) then + term1 = 1._r8/tanh( rad_sulf/rdl_hobr ) + else + term1 = 1._r8 + end if + term2 = rdl_hobr/rad_sulf + f_hobr = term1 - term2 + if( f_hobr > 0._r8 ) then + term1 = 1._r8 / (f_hobr*Gamma_hobr_rxn) + gprob_hobr_hcl(i,k)= 1._r8 / (1._r8 + term1) + else + gprob_hobr_hcl(i,k)= 0._r8 + end if + if( hclvmr > small_div .and. hobrvmr > small_div ) then + if ( hclvmr > hobrvmr ) then + rxt(i,k,rid_het6) = max( 0._r8,wrk*av_hobr*gprob_hobr_hcl(i,k) )*hcldeni + else + rxt(i,k,rid_het6) = max( 0._r8,wrk*av_hobr*gprob_hobr_hcl(i,k) )*hobrdeni + end if + end if + end if + + end if has_sadsulf + +has_sadnat : & + if( sadnat > 0._r8 ) then + wrk = .25_r8*sadnat +!----------------------------------------------------------------------- +! ... N2O5 + H2O(s) => 2HNO3 NAT Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for NAT. +! also see Hanson and Ravi, JPC, 97, 2802-2803, 1993. +! gprob_tot = 4.e-4 +!----------------------------------------------------------------------- + rxt(i,k,rid_het7) = wrk*av_n2o5*4.e-4_r8 + +!----------------------------------------------------------------------- +! ClONO2 + H2O(s) => HNO3 + HOCl NAT Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for NAT. +! also see Hanson and Ravi, JPC, 97, 2802-2803, 1993. +! gprob_tot = 0.004 +!----------------------------------------------------------------------- + rxt(i,k,rid_het8) = wrk*av_clono2*4.0e-3_r8 + +!----------------------------------------------------------------------- +! ... ClONO2 + HCl(s) => HNO3 + Cl2, NAT Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for NAT. +! also see Hanson and Ravi, JPC, 96, 2682-2691, 1992. +! gprob_tot = 0.2 +!----------------------------------------------------------------------- + if( hclvmr > small_div .and. clono2vmr > small_div ) then + if ( hclvmr > clono2vmr ) then + rxt(i,k,rid_het9) = wrk*av_clono2*0.2_r8*hcldeni + else + rxt(i,k,rid_het9) = wrk*av_clono2*0.2_r8*cntdeni + end if + end if + +!----------------------------------------------------------------------- +! ... HOCl + HCl(s) => H2O + Cl2 NAT Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for NAT. +! see Hanson and Ravi, JPC, 96, 2682-2691, 1992. +! and Abbatt and Molina, GRL, 19, 461-464, 1992. +! gprob_tot = 0.1 +!----------------------------------------------------------------------- + if( hclvmr > small_div .and. hoclvmr > small_div ) then + if ( hclvmr > hoclvmr ) then + rxt(i,k,rid_het10) = wrk*av_hocl*0.1_r8*hcldeni + else + rxt(i,k,rid_het10) = wrk*av_hocl*0.1_r8*hocldeni + end if + end if + +!----------------------------------------------------------------------- +! ... BrONO2 + H2O(s) => HOBr + HNO3 NAT Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Davies et al., +! JGR, 108, NO. D5, 8322, doi:10.1029/2001JD000445, 2003 +! gprob_tot = 0.006 +!----------------------------------------------------------------------- + rxt(i,k,rid_het11) = wrk*av_brono2*0.006_r8 + + end if has_sadnat + +has_sadice : & + if( sadice > 0._r8 ) then + wrk = .25_r8*sadice +!----------------------------------------------------------------------- +! N2O5 + H2O(s) => 2HNO3 ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! also see Hanson and Ravi, JPC, 97, 2802-2803, 1993. +! gprob_tot = 0.02 +!----------------------------------------------------------------------- + rxt(i,k,rid_het12) = wrk*av_n2o5*0.02_r8 + +!----------------------------------------------------------------------- +! ... ClONO2 + H2O(s) => HNO3 + HOCl ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! also see Hanson and Ravi, JGR, 96, 17307-17314, 1991. +! gprob_tot = 0.3 +!----------------------------------------------------------------------- + rxt(i,k,rid_het13) = wrk*av_clono2*0.3_r8 + +!----------------------------------------------------------------------- +! ... BrONO2 + H2O(s) => HNO3 + HOBr ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! also see Hanson and Ravi, JPC, 97, 2802-2803, 1993. +! could be as high as 1.0 +! gprob_tot = 0.3 +!----------------------------------------------------------------------- + rxt(i,k,rid_het14) = wrk*av_brono2*0.3_r8 + +!----------------------------------------------------------------------- +! ClONO2 + HCl(s) => HNO3 + Cl2, ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! also see Hanson and Ravi, GRL, 15, 17-20, 1988. +! also see Lue et al., +! gprob_tot = 0.3 +!----------------------------------------------------------------------- + if( hclvmr > small_div .and. clono2vmr > small_div ) then + if ( hclvmr > clono2vmr ) then + rxt(i,k,rid_het15) = wrk*av_clono2*0.3_r8*hcldeni + else + rxt(i,k,rid_het15) = wrk*av_clono2*0.3_r8*cntdeni + end if + end if +! +!----------------------------------------------------------------------- +! ... HOCl + HCl(s) => H2O + Cl2, ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! also see Hanson and Ravi, JPC, 96, 2682-2691, 1992. +! also see Abbatt and Molina, GRL, 19, 461-464, 1992. +! gprob_tot = 0.2 +!----------------------------------------------------------------------- + if( hoclvmr > small_div .and. hclvmr > small_div ) then + if ( hclvmr > hoclvmr ) then + rxt(i,k,rid_het16) = wrk*av_hocl*0.2_r8*hcldeni + else + rxt(i,k,rid_het16) = wrk*av_hocl*0.2_r8*hocldeni + end if + end if + +!----------------------------------------------------------------------- +! HOBr + HCl(s) => H2O + BrCl, ICE Aerosol Reaction +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... gprob based on JPL10-6 for ICE. +! Abbatt GRL, 21, 665-668, 1994. +! gprob_tot = 0.3 +!----------------------------------------------------------------------- + if( hobrvmr > small_div .and. hclvmr > small_div ) then + if ( hclvmr > hobrvmr ) then + rxt(i,k,rid_het17) = wrk*av_hobr*0.3_r8*hcldeni + else + rxt(i,k,rid_het17) = wrk*av_hobr*0.3_r8*hobrdeni + end if + end if + + end if has_sadice + end do column_loop + end do Level_loop + + end subroutine ratecon_sfstrat + + end module mo_strato_rates diff --git a/src/chemistry/mozart/mo_sulf.F90 b/src/chemistry/mozart/mo_sulf.F90 new file mode 100644 index 0000000000..cb3bdcf7ba --- /dev/null +++ b/src/chemistry/mozart/mo_sulf.F90 @@ -0,0 +1,236 @@ + + + module mo_sulf +!--------------------------------------------------------------- +! ... Annual cycle for sulfur +!--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use tracer_data, only : trfld,trfile + use physics_types, only : physics_state + use ppgrid, only : begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + use ppgrid, only : pcols, pver + + use spmd_utils, only : masterproc + + implicit none + + private + public :: sulf_inti, set_sulf_time, sulf_interp, sulf_readnl + + save + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + logical :: read_sulf = .false. + + character(len=16) :: fld_name = 'SULFATE' + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = ' ' + character(len=256) :: datapath = ' ' + character(len=32) :: datatype = 'CYCLICAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + + logical :: has_sulf_file = .false. + + contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +subroutine sulf_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'sulf_readnl' + + character(len=16) :: sulf_name + character(len=256) :: sulf_file + character(len=256) :: sulf_filelist + character(len=256) :: sulf_datapath + character(len=32) :: sulf_type + logical :: sulf_rmfile + integer :: sulf_cycle_yr + integer :: sulf_fixed_ymd + integer :: sulf_fixed_tod + + namelist /sulf_nl/ & + sulf_name, & + sulf_file, & + sulf_filelist, & + sulf_datapath, & + sulf_type, & + sulf_rmfile, & + sulf_cycle_yr, & + sulf_fixed_ymd, & + sulf_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + sulf_name = fld_name + sulf_file = filename + sulf_filelist = filelist + sulf_datapath = datapath + sulf_type = datatype + sulf_rmfile = rmv_file + sulf_cycle_yr = cycle_yr + sulf_fixed_ymd= fixed_ymd + sulf_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'sulf_nl', status=ierr) + if (ierr == 0) then + read(unitn, sulf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(sulf_name, len(sulf_name), mpichar, 0, mpicom) + call mpibcast(sulf_file, len(sulf_file), mpichar, 0, mpicom) + call mpibcast(sulf_filelist, len(sulf_filelist), mpichar, 0, mpicom) + call mpibcast(sulf_datapath, len(sulf_datapath), mpichar, 0, mpicom) + call mpibcast(sulf_type, len(sulf_type), mpichar, 0, mpicom) + call mpibcast(sulf_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(sulf_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(sulf_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(sulf_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + fld_name = sulf_name + filename = sulf_file + filelist = sulf_filelist + datapath = sulf_datapath + datatype = sulf_type + rmv_file = sulf_rmfile + cycle_yr = sulf_cycle_yr + fixed_ymd = sulf_fixed_ymd + fixed_tod = sulf_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_sulf_file = .true. + +end subroutine sulf_readnl + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine sulf_inti() +!----------------------------------------------------------------------- +! ... Open netCDF file containing annual sulfur data. Initialize +! arrays with the data to be interpolated to the current time. +! +! It is assumed that the time coordinate is increasing +! and represents calendar days; range = [1.,366.). +!----------------------------------------------------------------------- + use spmd_utils, only : masterproc + use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx + use interpolate_data, only : lininterp_init, lininterp, lininterp_finish, interp_type + use tracer_data, only : trcdata_init + use cam_history, only : addfld + + implicit none + +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: ndxs(5), so4_ndx + + character(len=8), parameter :: fld_names(1) = (/'SULFATE '/) + + ndxs(1) = get_rxt_ndx( 'usr_N2O5_aer' ) + ndxs(2) = get_rxt_ndx( 'usr_NO3_aer' ) + ndxs(3) = get_rxt_ndx( 'usr_NO2_aer' ) + ndxs(4) = get_rxt_ndx( 'usr_HO2_aer' ) + ndxs(5) = get_rxt_ndx( 'het1' ) + so4_ndx = get_spc_ndx( 'SO4' ) + if ( so4_ndx < 1 ) so4_ndx = get_spc_ndx( 'so4_a1' ) + + read_sulf = any( ndxs > 0) .and. (so4_ndx < 0) .and. has_sulf_file + + if ( .not. read_sulf ) return + + allocate(file%in_pbuf(size(fld_names))) + file%in_pbuf(:) = .false. + call trcdata_init( (/ fld_name /), filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + call addfld('SULFATE', (/ 'lev' /), 'I','VMR', 'sulfate data' ) + + end subroutine sulf_inti + + subroutine set_sulf_time( pbuf2d, state ) +!-------------------------------------------------------------------- +! ... Check and set time interpolation indicies +!-------------------------------------------------------------------- + use tracer_data, only : advance_trcdata + + implicit none + +!-------------------------------------------------------------------- +! ... Dummy args +!-------------------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(in):: state(begchunk:endchunk) + + if ( .not. read_sulf ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + end subroutine set_sulf_time + + subroutine sulf_interp( ncol, lchnk, ccm_sulf ) +!----------------------------------------------------------------------- +! ... Time interpolate sulfatei to current time +!----------------------------------------------------------------------- + use cam_history, only : outfld + + implicit none + +!----------------------------------------------------------------------- +! ... Dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk number + real(r8), intent(out) :: ccm_sulf(:,:) ! output sulfate + +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + + ccm_sulf(:,:) = 0._r8 + + if ( .not. read_sulf ) return + + ccm_sulf(:ncol,:) = fields(1)%data(:ncol,:,lchnk) + + call outfld( 'SULFATE', ccm_sulf(:ncol,:), ncol, lchnk ) + + end subroutine sulf_interp + + end module mo_sulf diff --git a/src/chemistry/mozart/mo_synoz.F90 b/src/chemistry/mozart/mo_synoz.F90 new file mode 100644 index 0000000000..e4c1fa58da --- /dev/null +++ b/src/chemistry/mozart/mo_synoz.F90 @@ -0,0 +1,233 @@ + +module mo_synoz + + !-------------------------------------------------------------------- + ! ... synthetic stratospheric ozone emission source + !-------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + + save + + real(r8), allocatable :: po3(:,:,:) + + private + public :: synoz_inti + public :: po3 + +contains + + subroutine synoz_inti( ) + !----------------------------------------------------------------------- + ! ... initialize synoz emissions + ! note: the emissions are in in units of molecules/cm**3/s + !----------------------------------------------------------------------- + + use dyn_grid, only : get_dyn_grid_parm + use ppgrid, only : pcols, begchunk, endchunk, pver, pverp + use ref_pres, only : pref_mid, pref_edge + use phys_grid, only : scatter_field_to_chunk + use chem_mods, only : adv_mass + use mo_chem_utls, only : get_spc_ndx + use spmd_utils, only : masterproc + use physconst, only : pi, & + grav => gravit, & ! m/s^2 + dry_mass => mwdry, & ! kg/kmole + seconds_in_day => cday, & + rearth ! m + use cam_abortutils, only : endrun + use dyn_grid, only : get_dyn_grid_parm_real1d + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + real(r8), parameter :: latmin = -30._r8 + real(r8), parameter :: latmax = 30._r8 + real(r8), parameter :: prsmin = 1000._r8 + real(r8), parameter :: prsmax = 7000._r8 + real(r8), parameter :: ozone_source_per_year = 500._r8 ! global/annual average of ozone source (Tg/yr) + real(r8), parameter :: tg2kg = 1.e9_r8 + real(r8), parameter :: days_per_year = 365._r8 + + integer :: i, j, k, jl, ju + integer :: jmin, jmax, kmin, kmax + integer :: synoz_ndx + integer :: astat + integer :: plon, plat, plev + + real(r8) :: diff, diff_min, diff_max + real(r8) :: total_mass = 0._r8 + real(r8) :: seq + real(r8), allocatable :: sf(:) + real(r8), allocatable :: prs(:) + real(r8), allocatable :: dp(:) + real(r8), allocatable :: wk(:,:,:) + real(r8), allocatable :: lat(:),latwts(:) + + allocate( po3(pcols,pver,begchunk:endchunk), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'synoz_inti: failed to allocate po3; error = ',astat + call endrun + end if + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + plev = get_dyn_grid_parm('plev') + + allocate(lat(plat),latwts(plat) ) + + lat = get_dyn_grid_parm_real1d('latdeg') + latwts = get_dyn_grid_parm_real1d('w') + + allocate( wk(plon,plev,plat), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'synoz_inti: failed to allocate wk; error = ',astat + call endrun + end if + + Masterproc_only : if( masterproc ) then + !----------------------------------------------------------------------- + ! ... allocate memory -- for global grid + !----------------------------------------------------------------------- + allocate( prs(plev), dp(plev), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'synoz_inti: failed to allocate prs, dp; error = ',astat + call endrun + end if + + !----------------------------------------------------------------------- + ! ... find indices of the latitudinal box + !----------------------------------------------------------------------- + jmin = -99 + jmax = -99 + diff_min = 1.e20_r8 + diff_max = 1.e20_r8 + do j = 1,plat + diff = abs(lat(j)-latmin) + if( diff < diff_min ) then + diff_min = diff + jmin = j + end if + diff = abs(lat(j)-latmax) + if( diff < diff_max ) then + diff_max = diff + jmax = j + end if + end do + + !----------------------------------------------------------------------- + ! ... make sure we found them + !----------------------------------------------------------------------- + if( jmin < 0 .or. jmax < 0 ) then + write(iulog,*) 'synoz_inti: problem finding the min/max lat in synoz_inti',jmin,jmax + call endrun + end if + !----------------------------------------------------------------------- + ! ... define pressure arrays, assuming surface pressure = 1000 hPa + !----------------------------------------------------------------------- + prs(:) = pref_mid(:) + dp(:) = pref_edge(2:pverp) - pref_edge(1:pver) + + !----------------------------------------------------------------------- + ! ... find indices of the pressure box + !----------------------------------------------------------------------- + kmin = -99 + kmax = -99 + diff_min = 1.e20_r8 + diff_max = 1.e20_r8 + do k = 1,plev + diff = abs( prs(k) - prsmin ) + if( diff < diff_min ) then + diff_min = diff + kmin = k + end if + diff = abs( prs(k) - prsmax ) + if( diff < diff_max ) then + diff_max = diff + kmax = k + end if + end do + + !----------------------------------------------------------------------- + ! ... make sure we found them + !----------------------------------------------------------------------- + if( kmin < 0 .or. kmax < 0 ) then + write(iulog,*) 'synoz_inti: problem finding the min/max prs in synoz_inti',kmin,kmax + call endrun + end if + + !----------------------------------------------------------------------- + ! ... define geometric factors (in SI) + !----------------------------------------------------------------------- + seq = 2._r8*pi*rearth**2/real(plon) + allocate(sf(plat)) + do j = 1,plat + sf(j) = seq*latwts(j) + end do + + !----------------------------------------------------------------------- + ! ... find index of synoz + !----------------------------------------------------------------------- + synoz_ndx = get_spc_ndx('SYNOZ') + has_synoz : if( synoz_ndx > 0 ) then + !----------------------------------------------------------------------- + ! ... compute total mass (in kg) over the domain for which + ! the ozone source will be defined + !----------------------------------------------------------------------- + total_mass = 0._r8 + do k = kmin,kmax + do j = jmin,jmax + total_mass = total_mass + dp(k)/grav * sf(j) + end do + end do + total_mass = total_mass * plon +#ifdef DEBUG + write(iulog,*)'synoz_inti: total mass = ',total_mass +#endif + !----------------------------------------------------------------------- + ! ... define the location of the ozone source + !----------------------------------------------------------------------- + wk(:,:,:) = 0._r8 + do k = kmin,kmax + do j = jmin,jmax + wk(1:plon,k,j) = 1._r8 + end do + end do + !----------------------------------------------------------------------- + ! ... define the ozone source as vmr/s (what is needed for the chemistry solver) + ! note : a change in chemdr is made to avoid the division by invariants + !----------------------------------------------------------------------- + wk(:,:,:) = wk(:,:,:) * (ozone_source_per_year*tg2kg/total_mass) & + / (seconds_in_day*days_per_year) & + * (dry_mass/adv_mass(synoz_ndx)) + write(iulog,*) 'synoz_inti: max wk = ',maxval( wk(:,:,:) ) + deallocate( prs, dp ) + end if has_synoz + + deallocate(sf) + + endif Masterproc_only + + !----------------------------------------------------------------------- + ! ... scatter to mpi tasks + !----------------------------------------------------------------------- + call scatter_field_to_chunk(1, plev, 1, plon, wk, po3) + + !----------------------------------------------------------------------- + ! ... deallocate memory + !----------------------------------------------------------------------- + deallocate( wk ) + deallocate( lat, latwts ) + + end subroutine synoz_inti + +end module mo_synoz diff --git a/src/chemistry/mozart/mo_tgcm_ubc.F90 b/src/chemistry/mozart/mo_tgcm_ubc.F90 new file mode 100644 index 0000000000..3f88b229e9 --- /dev/null +++ b/src/chemistry/mozart/mo_tgcm_ubc.F90 @@ -0,0 +1,176 @@ +!--------------------------------------------------------------- +! ... tgcm upper bndy values +!--------------------------------------------------------------- + + module mo_tgcm_ubc + + use ppgrid, only : pver + use shr_kind_mod, only : r8 => shr_kind_r8 + use constituents, only : pcnst, cnst_fixed_ubc + + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + use tracer_data, only : trfld,trfile,MAXTRCRS + use cam_history, only : addfld, horiz_only + + implicit none + + private + public :: tgcm_ubc_inti, set_tgcm_ubc, tgcm_timestep_init + + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + integer :: ub_nspecies + character(len=16) :: ubc_name(MAXTRCRS) + integer :: map(MAXTRCRS) + + logical :: ubc_from_tgcm(pcnst) = .false. + + contains + + subroutine tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod) + !------------------------------------------------------------------ + ! ... initialize upper boundary values + !------------------------------------------------------------------ + use tracer_data, only : trcdata_init + + use constituents, only : cnst_get_ind + + !------------------------------------------------------------------ + ! ... dummy args + !------------------------------------------------------------------ + character(len=*), intent(in) :: tgcm_ubc_file + integer, intent(in) :: tgcm_ubc_cycle_yr + integer, intent(in) :: tgcm_ubc_fixed_ymd + integer, intent(in) :: tgcm_ubc_fixed_tod + character(len=32), intent(in) :: tgcm_ubc_data_type + + + ! local vars + integer :: vid, i,ii + + character(len=256), parameter :: filelist = ' ' + character(len=256), parameter :: datapath = ' ' + logical, parameter :: rmv_file = .false. + integer, parameter :: nubc = 1 + character(len=4), parameter :: species(nubc) = (/'H2 '/) + character(len=4) :: specifier(nubc) = ' ' + + ii = 0 + + do i = 1,nubc + call cnst_get_ind( species(i), vid, abort=.false. ) + if( vid > 0 ) then + if( cnst_fixed_ubc(vid) ) then + ii = ii+1 + specifier(ii) = species(i) ! set specifier to the species that actually + ! are registered to have a specified upper bounary + ! so that the species mapping is correct + ubc_from_tgcm(vid) = .true. + map(ii) = vid ! elements in map array correspond to elements in specifier + ubc_name(ii) = trim(species(i))//'_tgcm' + call addfld( ubc_name(ii), horiz_only, 'I', 'kg/kg', 'upper boundary mmr' ) + end if + end if + enddo + + ub_nspecies = count( ubc_from_tgcm ) + + if (ub_nspecies > 0) then + file%top_bndry = .true. + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, tgcm_ubc_file, filelist, datapath, fields, file, & + rmv_file, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod, tgcm_ubc_data_type) + endif + + end subroutine tgcm_ubc_inti + + subroutine tgcm_timestep_init(pbuf2d, state ) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + !-------------------------------------------------------------------- + ! ... Advance ub values + !-------------------------------------------------------------------- + implicit none + + ! args + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (ub_nspecies > 0) then + call advance_trcdata( fields, file, state, pbuf2d ) + endif + + end subroutine tgcm_timestep_init + + subroutine set_tgcm_ubc( lchunk, ncol, mmr, mw_dry ) + !-------------------------------------------------------------------- + ! ... Set the upper boundary values h2o, h2, and h + !-------------------------------------------------------------------- + + use ppgrid, only : pcols + use constituents, only : cnst_get_ind, cnst_mw + + use cam_history, only : outfld + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + integer, intent(in) :: lchunk ! chunk id + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(in) :: mw_dry(pcols) ! mean mass at top model level + real(r8), intent(inout) :: mmr(pcols,pcnst) + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + real(r8), parameter :: h2o_ubc_vmr = 2.e-8_r8 ! fixed ub h2o concentration (kg/kg) + real(r8), parameter :: ch4_ubc_vmr = 2.e-10_r8 ! fixed ub ch4 concentration (kg/kg) + + integer :: m,n + + if (ub_nspecies > 0) then + do m = 1,ub_nspecies +!--------------------------------------------------------------- +! ... tgcm upper bndy values +!--------------------------------------------------------------- + + n = map(m) + mmr(:ncol,n) = fields(m)%data(:ncol,1,lchunk) + call outfld( ubc_name(m), mmr(:ncol,n), ncol, lchunk ) + enddo + endif + + !-------------------------------------------------------- + ! ... special section to set h2o and ch4 ub concentrations + !-------------------------------------------------------- + mmr(:ncol,1) = cnst_mw(1)*h2o_ubc_vmr/mw_dry(:ncol) + call cnst_get_ind( 'CH4', m, abort=.false. ) + if( m > 0 ) then + mmr(:ncol,m) = cnst_mw(m)*ch4_ubc_vmr/mw_dry(:ncol) + end if + +#ifdef TGCM_DIAGS + call cnst_get_ind( 'H2', m, abort=.false. ) + if( m > 0 ) then + write(iulog,*) 'set_ub_vals: diagnostics for chunk = ',lchunk + write(iulog,*) 'last,next,dels = ',last,next,dels + write(iulog,*) 'h2 mmr at level ',k + write(iulog,'(1x,1p,10g12.5)') mmr(:ncol,m)) + end if +#endif + + end subroutine set_tgcm_ubc + + end module mo_tgcm_ubc diff --git a/src/chemistry/mozart/mo_tracname.F90 b/src/chemistry/mozart/mo_tracname.F90 new file mode 100644 index 0000000000..c8b4aabfdb --- /dev/null +++ b/src/chemistry/mozart/mo_tracname.F90 @@ -0,0 +1,14 @@ + + module mo_tracname +!----------------------------------------------------------- +! ... List of advected and non-advected trace species, and +! surface fluxes for the advected species. +!----------------------------------------------------------- + + use chem_mods, only : grpcnt, gas_pcnst + + implicit none + + character(len=16) :: solsym(gas_pcnst) ! species names + + end module mo_tracname diff --git a/src/chemistry/mozart/mo_trislv.F90 b/src/chemistry/mozart/mo_trislv.F90 new file mode 100644 index 0000000000..c99fc20a75 --- /dev/null +++ b/src/chemistry/mozart/mo_trislv.F90 @@ -0,0 +1,156 @@ + + module mo_trislv + + use shr_kind_mod, only : r8 => shr_kind_r8 + + contains + + subroutine tridec( syscnt, order, lower, main, upper ) +!-------------------------------------------------------------------- +! dimension of lower(syscnt,order), main(syscnt,order), upper(syscnt,order) +! arguments +! +! latest revision june 1995 +! +! purpose trdi computes the solution of the tridiagonal +! linear system, +! b(1)*x(1)+c(1)*x(2) = y(1) +! a(i)*x(i-1)+b(i)*x(i)+c(i)*x(i+1) = y(i) +! i=2,3,...,n-1 +! a(n)*x(n-1)+b(n)*x(n) = y(n) +! +! usage call trdi (n, a, b, c, x ) +! +! arguments +! +! on input n +! the number of unknowns. this subroutine +! requires that n be greater than 2. +! +! a +! the subdiagonal of the matrix is stored in +! locations a(2) through a(n). +! +! b +! the diagonal of the matrix is stored in +! locations b(1) through b(n). +! +! c +! the super-diagonal of the matrix is stored in +! locations c(1) through c(n-1). +! +! x +! the right-hand side of the equations is +! stored in y(1) through y(n). +! +! on output x +! an array which contains the solution to the +! system of equations. +! +! special conditions this subroutine executes satisfactorily +! if the input matrix is diagonally dominant +! and non-singular. the diagonal elements +! are used to pivot, and no tests are made to +! determine singularity. if a singular, or +! nearly singular, matrix is used as input, +! a divide by zero or floating point overflow +! may result. +! +! precision compiler dependent +! +! language fortran +! +! history originally written by nancy werner at ncar +! in october, 1973. modified by s. walters at +! ncar in june 1989 to functionally replace +! the cal routine tridla. +! +! portability fortran 90 +! +! algorithm an lu-decomposition is obtained using the +! algorithm described in the reference below. +! +! to avoid unnecessary divisions, the alpha +! values used in the routine are the +! reciprocals of the alpha values described +! in the reference below. +! +! accuracy every component of the residual of the linear +! system (i.e. the difference between y and +! the matrix applied to x) should be less in +! magnitude than ten times the machine precision +! times the matrix order times the maximum +! absolute component of the solution vector +! times the largest absolute row sum of the +! input matrix. +! +! timing the timing is roughly proportional to the +! order n of the linear system. +! +! references analysis of numerical methods by +! e. isaacson and h. keller +! (john wiley and sons, 1966) pp. 55-58. +!-------------------------------------------------------------------- + + implicit none + +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: syscnt, order + real(r8), intent(in), dimension(syscnt,order) :: lower + real(r8), intent(inout), dimension(syscnt,order) :: main, upper + +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: i + +!---------------------------------------------------------------------- +! ... lu-decomposition +!---------------------------------------------------------------------- + main(:,1) = 1._r8 / main(:,1) + upper(:,1) = upper(:,1)*main(:,1) + do i = 2,order-1 + main(:,i) = 1._r8 / (main(:,i) - lower(:,i)*upper(:,i-1)) + upper(:,i) = upper(:,i)*main(:,i) + end do + + end subroutine tridec + + subroutine trislv( syscnt, order, lower, main, upper, x ) + + implicit none + +!---------------------------------------------------------------------- +! ... dummy args +!---------------------------------------------------------------------- + integer, intent(in) :: syscnt, order + real(r8), intent(in), dimension(syscnt,order) :: lower, & + main, & + upper + real(r8), intent(inout), dimension(syscnt,order) :: x + +!---------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------- + integer :: i, im1, j, n, nm1 + + nm1 = order - 1 + n = order +!---------------------------------------------------------------------- +! ... solve the system +!---------------------------------------------------------------------- + x(:,1) = x(:,1)*main(:,1) + do i = 2,nm1 + x(:,i) = (x(:,i) - lower(:,i)*x(:,i-1))*main(:,i) + end do + + x(:,n) = (x(:,n) - lower(:,n)*x(:,nm1))/(main(:,n) - lower(:,n)*upper(:,nm1)) + do i = nm1,1,-1 + x(:,i) = x(:,i) - upper(:,i)*x(:,i+1) + end do + + end subroutine trislv + + end module mo_trislv diff --git a/src/chemistry/mozart/mo_tuv_inti.F90 b/src/chemistry/mozart/mo_tuv_inti.F90 new file mode 100644 index 0000000000..e6ccde0ecc --- /dev/null +++ b/src/chemistry/mozart/mo_tuv_inti.F90 @@ -0,0 +1,341 @@ + +module mo_tuv_inti + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: nj + public :: nlng, nzen, ncof + public :: tuv_inti + + save + + integer :: nj + integer :: nlng + integer :: nzen, ncof + +contains + + subroutine tuv_inti( nz, tuv_xsect_file, lng_indexer ) + !----------------------------------------------------------------------------- + ! purpose: + ! read 17 bins data outputed from tuv + !----------------------------------------------------------------------------- + ! parameters: + ! nw - integer, number of specified intervals + 1 in working + ! wavelength grid + ! wl - real(r8), vector of lower limits of wavelength intervals in + ! working wavelength grid + ! wc - real(r8), vector of center of wavelength intervals in + ! working wavelength grid + ! wu - real(r8), vector of upper limits of wavelength intervals in + ! working wavelength grid + ! f - real(r8), spectral irradiance at the top of the atmosphere at + ! each specified wavelength + !----------------------------------------------------------------------------- + ! edit history: + ! 10/2000 similified by xuexi + !----------------------------------------------------------------------------- + + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + use cam_abortutils, only : endrun + use mo_params, only : kj, kw, smallest, largest + use mo_waveall, only : r01g1, r01g2, r01g3, r01g4, & + r04g, r08g, r06g1, r06g2, & + r10g1, r10g2, r10g3, r10g4, r10g5, & + r11g, r11g1, r11g2, r11g3, r11g4, & + r14g, r14g1, r14g2, & + r15g, r15g1, r15g2, r15g3, & + r17g, r17g1, & + r18g, r18g2 + use mo_wavelab, only : sj + use mo_wavelen, only : nw, deltaw, delw_bin, sflx, wc, wl, wu + use mo_waveo3, only : xso3, s226, s263, s298 + use mo_zadj, only : adj_coeffs + use mo_schu, only : schu_inti + use mo_xsections, only : r44_inti, r08_inti + use chem_mods, only : phtcnt, pht_alias_lst, rxt_tag_lst + use ioFileMod, only : getfil + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_nowrite, pio_closefile, & + pio_inq_dimid, pio_inq_varid, pio_inq_dimlen, pio_get_var, & + pio_seterrorhandling, pio_bcast_error, pio_internal_error, pio_noerr + implicit none + + !----------------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------------- + integer, intent(in) :: nz + integer, intent(inout) :: lng_indexer(phtcnt) + character(len=*), intent(in) :: tuv_xsect_file + + !----------------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------------- + type(file_desc_t) :: ncid + integer :: ndx + integer :: dimid, vid + integer :: iw, ios, iret + integer :: k, m + integer :: ind_wrk(4) + integer :: wrk_ndx(phtcnt) + real(r8), allocatable :: coeff_adj(:,:) + character(len=256) :: filespec + character(len=256) :: locfn + character(len=20) :: coeff_tag + + !------------------------------------------------------------------------ + ! for wl(iw) .lt. 150.01 susim_hi.flx + ! for wl(iw) .ge. 150.01 and wl(iw) .le. 400 atlas3.flx + ! for wl(iw) .gt. 400 neckel & labs + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + ! input data files including: + ! (0) wavelength nw,wl,wc,wu + ! (1) solar flux + ! (2) o3 cross sections + ! (3) other cross + ! (4) t dependence parameter of cross section + !------------------------------------------------------------------------ + + !--------------------------------------------------------------------------- + ! ... open netcdf file + !--------------------------------------------------------------------------- + filespec = trim( tuv_xsect_file ) + call getfil( filespec, locfn, 0 ) + call cam_pio_openfile( ncid, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + iret = pio_inq_dimid( ncid, 'nw', dimid ) + iret = pio_inq_dimlen( ncid, dimid, nw ) + iret = pio_inq_dimid( ncid, 'nzen', dimid ) + iret = pio_inq_dimlen( ncid, dimid, nzen ) + iret = pio_inq_dimid( ncid, 'ncof', dimid ) + iret = pio_inq_dimlen( ncid, dimid, ncof ) + !--------------------------------------------------------------------------- + ! ... read the wave bin coordinates + !--------------------------------------------------------------------------- + iret = pio_inq_varid( ncid, 'wl', vid ) + iret = pio_get_var( ncid, vid, wl(1:nw) ) + iret = pio_inq_varid( ncid, 'wc', vid ) + iret = pio_get_var( ncid, vid, wc(1:nw) ) + iret = pio_inq_varid( ncid, 'wu', vid ) + iret = pio_get_var( ncid, vid, wu(1:nw) ) + wl(nw+1) = wu(nw) + write(iulog,*) ' ' + write(iulog,*) 'tuv_inti: wl(nw+1) = ',wl(nw+1) + !------------------------------------------------------------------------ + ! ... solar flux + !------------------------------------------------------------------------ + iret = pio_inq_varid( ncid, 'sflx', vid ) + iret = pio_get_var( ncid, vid, sflx(1:nw) ) + !------------------------------------------------------------------------ + ! ... o3 cross (t dependence) + !------------------------------------------------------------------------ + iret = pio_inq_varid( ncid, 'xso3', vid ) + iret = pio_get_var( ncid, vid, xso3(1:nw) ) + iret = pio_inq_varid( ncid, 's226', vid ) + iret = pio_get_var( ncid, vid, s226(1:nw) ) + iret = pio_inq_varid( ncid, 's263', vid ) + iret = pio_get_var( ncid, vid, s263(1:nw) ) + iret = pio_inq_varid( ncid, 's298', vid ) + iret = pio_get_var( ncid, vid, s298(1:nw) ) + !--------------------------------------------------------------------------- + ! ... temperature dependent cross section parameters + !--------------------------------------------------------------------------- + iret = pio_inq_varid( ncid, 'r01g1', vid ) + iret = pio_get_var( ncid, vid, r01g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r01g2', vid ) + iret = pio_get_var( ncid, vid, r01g2(1:nw) ) + iret = pio_inq_varid( ncid, 'r01g3', vid ) + iret = pio_get_var( ncid, vid, r01g3(1:nw) ) + iret = pio_inq_varid( ncid, 'r01g4', vid ) + iret = pio_get_var( ncid, vid, r01g4(1:nw) ) + + iret = pio_inq_varid( ncid, 'r04g', vid ) + iret = pio_get_var( ncid, vid, r04g(1:nw) ) + + iret = pio_inq_varid( ncid, 'r08g', vid ) + iret = pio_get_var( ncid, vid, r08g(1:nw) ) + + iret = pio_inq_varid( ncid, 'r06g1', vid ) + iret = pio_get_var( ncid, vid, r06g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r06g2', vid ) + iret = pio_get_var( ncid, vid, r06g2(1:nw) ) + + iret = pio_inq_varid( ncid, 'r10g1', vid ) + iret = pio_get_var( ncid, vid, r10g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r10g2', vid ) + iret = pio_get_var( ncid, vid, r10g2(1:nw) ) + iret = pio_inq_varid( ncid, 'r10g3', vid ) + iret = pio_get_var( ncid, vid, r10g3(1:nw) ) + iret = pio_inq_varid( ncid, 'r10g4', vid ) + iret = pio_get_var( ncid, vid, r10g4(1:nw) ) + iret = pio_inq_varid( ncid, 'r10g5', vid ) + iret = pio_get_var( ncid, vid, r10g5(1:nw) ) + + iret = pio_inq_varid( ncid, 'r11g', vid ) + iret = pio_get_var( ncid, vid, r11g(1:nw) ) + iret = pio_inq_varid( ncid, 'r11g1', vid ) + iret = pio_get_var( ncid, vid, r11g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r11g2', vid ) + iret = pio_get_var( ncid, vid, r11g2(1:nw) ) + iret = pio_inq_varid( ncid, 'r11g3', vid ) + iret = pio_get_var( ncid, vid, r11g3(1:nw) ) + iret = pio_inq_varid( ncid, 'r11g4', vid ) + iret = pio_get_var( ncid, vid, r11g4(1:nw) ) + + iret = pio_inq_varid( ncid, 'r14g', vid ) + iret = pio_get_var( ncid, vid, r14g(1:nw) ) + iret = pio_inq_varid( ncid, 'r14g1', vid ) + iret = pio_get_var( ncid, vid, r14g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r14g2', vid ) + iret = pio_get_var( ncid, vid, r14g2(1:nw) ) + + iret = pio_inq_varid( ncid, 'r15g', vid ) + iret = pio_get_var( ncid, vid, r15g(1:nw) ) + iret = pio_inq_varid( ncid, 'r15g1', vid ) + iret = pio_get_var( ncid, vid, r15g1(1:nw) ) + iret = pio_inq_varid( ncid, 'r15g2', vid ) + iret = pio_get_var( ncid, vid, r15g2(1:nw) ) + iret = pio_inq_varid( ncid, 'r15g3', vid ) + iret = pio_get_var( ncid, vid, r15g3(1:nw) ) + + iret = pio_inq_varid( ncid, 'r17g', vid ) + iret = pio_get_var( ncid, vid, r17g(1:nw) ) + iret = pio_inq_varid( ncid, 'r17g1', vid ) + iret = pio_get_var( ncid, vid, r17g1(1:nw) ) + + iret = pio_inq_varid( ncid, 'r18g', vid ) + iret = pio_get_var( ncid, vid, r18g(1:nw) ) + iret = pio_inq_varid( ncid, 'r18g2', vid ) + iret = pio_get_var( ncid, vid, r18g2(1:nw) ) + !------------------------------------------------------------------------------ + ! ... check for cross section in dataset + !------------------------------------------------------------------------------ + call pio_seterrorhandling(ncid, pio_bcast_error) + do m = 1,phtcnt + if( pht_alias_lst(m,2) == ' ' ) then + iret = pio_inq_varid( ncid, rxt_tag_lst(m), vid ) + if( iret == pio_noerr ) then + lng_indexer(m) = vid + end if + else if( pht_alias_lst(m,2) == 'userdefined' ) then + lng_indexer(m) = -1 + else + iret = pio_inq_varid( ncid, trim(pht_alias_lst(m,2)), vid ) + if( iret == pio_noerr ) then + lng_indexer(m) = vid + else + write(iulog,*) 'tuv_inti : ',rxt_tag_lst(m)(:len_trim(rxt_tag_lst(m))),' alias ', & + pht_alias_lst(m,2)(:len_trim(pht_alias_lst(m,2))),' not in dataset' + call endrun + end if + end if + end do + call pio_seterrorhandling(ncid, pio_internal_error) + nlng = 0 + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then + cycle + end if + nlng = nlng + 1 + end if + end do + !--------------------------------------------------------------------------- + ! ... allocate the cross section array + !--------------------------------------------------------------------------- + allocate( sj(nw,nz,nlng), adj_coeffs(ncof,nlng,nzen), coeff_adj(ncof,nzen), stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'tuv_inti: failed to allocate sj ... coeff_adj; error = ',ios + call endrun + end if + sj(:,:,:) = 0._r8 + adj_coeffs(:,:,:) = 0._r8 + write(iulog,*) 'tuv_inti: nlng = ',nlng + write(iulog,*) 'tuv_inti: lng_indexer' + write(iulog,'(10i5)') lng_indexer(:) + if( nlng > 0 ) then + write(iulog,*) ' ' + write(iulog,*) 'tuv_inti: photo xsect analysis' + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + write(iulog,*) trim(rxt_tag_lst(m)),lng_indexer(m) + end if + end do + end if + ndx = 0 + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then + cycle + end if + ndx = ndx + 1 + iret = pio_get_var( ncid, lng_indexer(m), sj(1:nw,1,ndx) ) + + do k = 2,nz + sj(:,k,ndx) = sj(:,1,ndx) + end do + coeff_tag = trim(rxt_tag_lst(m)) // '_adj' + iret = pio_inq_varid( ncid, trim(coeff_tag), vid ) + iret = pio_get_var( ncid, vid, coeff_adj ) + + adj_coeffs(:,ndx,1:nzen) = coeff_adj(:,1:nzen) + end if + end do + if( ndx /= nlng ) then + write(iulog,*) 'tuv_inti : ndx count /= cross section count' + call endrun + end if + !------------------------------------------------------------------------------ + ! ... setup final lng_indexer + !------------------------------------------------------------------------------ + ndx = 0 + wrk_ndx(:) = lng_indexer(:) + do m = 1,phtcnt + if( wrk_ndx(m) > 0 ) then + ndx = ndx + 1 + k = wrk_ndx(m) + where( wrk_ndx(:) == k ) + lng_indexer(:) = ndx + wrk_ndx(:) = -100000 + end where + end if + end do + if( nlng > 0 ) then + write(iulog,*) ' ' + write(iulog,*) 'tuv_inti: photo xsect analysis' + do m = 1,phtcnt + if( lng_indexer(m) > 0 ) then + write(iulog,*) trim(rxt_tag_lst(m)),lng_indexer(m) + end if + end do + end if + !--------------------------------------------------------------------------- + ! ... close netcdf file + !--------------------------------------------------------------------------- + call pio_closefile( ncid ) + deallocate( coeff_adj ) + + + delw_bin(:nw) = wu(:nw) - wl(:nw) + deltaw(:nw) = delw_bin(:nw) * wc(:nw) * 5.039e11_r8 + delw_bin(:nw) = 1._r8/delw_bin(:nw) + largest = huge( largest ) + smallest = tiny( largest ) + + write(iulog,'(''tuv_inti: smallest,largest = '',1p,2e21.13)') smallest,largest + + call schu_inti + call r44_inti( nw, wc ) + call r08_inti( nw, wl, wc ) + + end subroutine tuv_inti + +end module mo_tuv_inti diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 new file mode 100644 index 0000000000..5e09aa3ca5 --- /dev/null +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -0,0 +1,1577 @@ +module mo_usrrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use ppgrid, only : pver, pcols + + implicit none + + private + public :: usrrxt, usrrxt_inti, usrrxt_hrates + + save + + integer :: usr_O_O2_ndx + integer :: usr_HO2_HO2_ndx + integer :: usr_N2O5_M_ndx + integer :: usr_HNO3_OH_ndx + integer :: usr_HO2NO2_M_ndx + integer :: usr_N2O5_aer_ndx + integer :: usr_NO3_aer_ndx + integer :: usr_NO2_aer_ndx + integer :: usr_CO_OH_a_ndx + integer :: usr_CO_OH_b_ndx + integer :: usr_PAN_M_ndx + integer :: usr_CH3COCH3_OH_ndx + integer :: usr_MCO3_NO2_ndx + integer :: usr_MPAN_M_ndx + integer :: usr_XOOH_OH_ndx + integer :: usr_SO2_OH_ndx + integer :: usr_DMS_OH_ndx + integer :: usr_HO2_aer_ndx + integer :: usr_GLYOXAL_aer_ndx + + integer :: tag_NO2_NO3_ndx + integer :: tag_NO2_OH_ndx + integer :: tag_NO2_HO2_ndx + integer :: tag_C2H4_OH_ndx + integer :: tag_C3H6_OH_ndx + integer :: tag_CH3CO3_NO2_ndx + +!lke-TS1 + integer :: usr_PBZNIT_M_ndx + integer :: tag_ACBZO2_NO2_ndx + integer :: usr_ISOPNITA_aer_ndx + integer :: usr_ISOPNITB_aer_ndx + integer :: usr_ONITR_aer_ndx + integer :: usr_HONITR_aer_ndx + integer :: usr_TERPNIT_aer_ndx + integer :: usr_NTERPOOH_aer_ndx + integer :: usr_NC4CHO_aer_ndx + integer :: usr_NC4CH2OH_aer_ndx +! + integer :: usr_OA_O2_NDX + integer :: usr_XNO2NO3_M_ndx + integer :: usr_NO2XNO3_M_ndx + integer :: usr_XHNO3_OH_ndx + integer :: usr_XHO2NO2_M_ndx + integer :: usr_XNO2NO3_aer_ndx + integer :: usr_NO2XNO3_aer_ndx + integer :: usr_XNO3_aer_ndx + integer :: usr_XNO2_aer_ndx + integer :: usr_XPAN_M_ndx + integer :: usr_XMPAN_M_ndx + integer :: usr_MCO3_XNO2_ndx + + integer :: usr_C2O3_NO2_ndx + integer :: usr_C2H4_OH_ndx + integer :: usr_XO2N_HO2_ndx + integer :: usr_C2O3_XNO2_ndx + + integer :: tag_XO2N_NO_ndx + integer :: tag_XO2_HO2_ndx + integer :: tag_XO2_NO_ndx + + integer :: usr_O_O_ndx + integer :: usr_CL2O2_M_ndx + integer :: usr_SO3_H2O_ndx + integer :: tag_CLO_CLO_M_ndx + + integer :: ion1_ndx, ion2_ndx, ion3_ndx, ion11_ndx + integer :: elec1_ndx, elec2_ndx, elec3_ndx + integer :: elec4_ndx, elec5_ndx, elec6_ndx + integer :: het1_ndx + + integer, parameter :: nean = 3 + integer :: ean_ndx(nean) + integer, parameter :: nrpe = 5 + integer :: rpe_ndx(nrpe) + integer, parameter :: npir = 16 + integer :: pir_ndx(npir) + integer, parameter :: nedn = 2 + integer :: edn_ndx(nedn) + integer, parameter :: nnir = 13 + integer :: nir_ndx(nnir) + integer, parameter :: niira = 112 + integer :: iira_ndx(niira) + integer, parameter :: niirb = 14 + integer :: iirb_ndx(niirb) + + integer :: usr_clm_h2o_m_ndx, usr_clm_hcl_m_ndx + integer :: usr_oh_co_ndx, het_no2_h2o_ndx, usr_oh_dms_ndx, aq_so2_h2o2_ndx, aq_so2_o3_ndx + + integer :: h2o_ndx +! +! jfl +! + integer, parameter :: num_strat_tau = 22 + integer :: usr_strat_tau_ndx(num_strat_tau) +! +!lke++ + integer :: usr_COhc_OH_ndx + integer :: usr_COme_OH_ndx + integer :: usr_CO01_OH_ndx + integer :: usr_CO02_OH_ndx + integer :: usr_CO03_OH_ndx + integer :: usr_CO04_OH_ndx + integer :: usr_CO05_OH_ndx + integer :: usr_CO06_OH_ndx + integer :: usr_CO07_OH_ndx + integer :: usr_CO08_OH_ndx + integer :: usr_CO09_OH_ndx + integer :: usr_CO10_OH_ndx + integer :: usr_CO11_OH_ndx + integer :: usr_CO12_OH_ndx + integer :: usr_CO13_OH_ndx + integer :: usr_CO14_OH_ndx + integer :: usr_CO15_OH_ndx + integer :: usr_CO16_OH_ndx + integer :: usr_CO17_OH_ndx + integer :: usr_CO18_OH_ndx + integer :: usr_CO19_OH_ndx + integer :: usr_CO20_OH_ndx + integer :: usr_CO21_OH_ndx + integer :: usr_CO22_OH_ndx + integer :: usr_CO23_OH_ndx + integer :: usr_CO24_OH_ndx + integer :: usr_CO25_OH_ndx + integer :: usr_CO26_OH_ndx + integer :: usr_CO27_OH_ndx + integer :: usr_CO28_OH_ndx + integer :: usr_CO29_OH_ndx + integer :: usr_CO30_OH_ndx + integer :: usr_CO31_OH_ndx + integer :: usr_CO32_OH_ndx + integer :: usr_CO33_OH_ndx + integer :: usr_CO34_OH_ndx + integer :: usr_CO35_OH_ndx + integer :: usr_CO36_OH_ndx + integer :: usr_CO37_OH_ndx + integer :: usr_CO38_OH_ndx + integer :: usr_CO39_OH_ndx + integer :: usr_CO40_OH_ndx + integer :: usr_CO41_OH_ndx + integer :: usr_CO42_OH_ndx +!lke-- + + real(r8), parameter :: t0 = 300._r8 ! K + real(r8), parameter :: trlim2 = 17._r8/3._r8 ! K + real(r8), parameter :: trlim3 = 15._r8/3._r8 ! K + + logical :: has_ion_rxts, has_d_chem + +contains + + subroutine usrrxt_inti + !----------------------------------------------------------------- + ! ... intialize the user reaction constants module + !----------------------------------------------------------------- + + use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx + use spmd_utils, only : masterproc + + implicit none + + character(len=4) :: xchar + character(len=32) :: rxtname + integer :: i + +! +! full tropospheric chemistry +! + usr_O_O2_ndx = get_rxt_ndx( 'usr_O_O2' ) + usr_HO2_HO2_ndx = get_rxt_ndx( 'usr_HO2_HO2' ) + usr_N2O5_M_ndx = get_rxt_ndx( 'usr_N2O5_M' ) + usr_HNO3_OH_ndx = get_rxt_ndx( 'usr_HNO3_OH' ) + usr_HO2NO2_M_ndx = get_rxt_ndx( 'usr_HO2NO2_M' ) + usr_N2O5_aer_ndx = get_rxt_ndx( 'usr_N2O5_aer' ) + usr_NO3_aer_ndx = get_rxt_ndx( 'usr_NO3_aer' ) + usr_NO2_aer_ndx = get_rxt_ndx( 'usr_NO2_aer' ) + usr_CO_OH_a_ndx = get_rxt_ndx( 'usr_CO_OH_a' ) + usr_CO_OH_b_ndx = get_rxt_ndx( 'usr_CO_OH_b' ) + usr_PAN_M_ndx = get_rxt_ndx( 'usr_PAN_M' ) + usr_CH3COCH3_OH_ndx = get_rxt_ndx( 'usr_CH3COCH3_OH' ) + usr_MCO3_NO2_ndx = get_rxt_ndx( 'usr_MCO3_NO2' ) + usr_MPAN_M_ndx = get_rxt_ndx( 'usr_MPAN_M' ) + usr_XOOH_OH_ndx = get_rxt_ndx( 'usr_XOOH_OH' ) + usr_SO2_OH_ndx = get_rxt_ndx( 'usr_SO2_OH' ) + usr_DMS_OH_ndx = get_rxt_ndx( 'usr_DMS_OH' ) + usr_HO2_aer_ndx = get_rxt_ndx( 'usr_HO2_aer' ) + usr_GLYOXAL_aer_ndx = get_rxt_ndx( 'usr_GLYOXAL_aer' ) + ! + tag_NO2_NO3_ndx = get_rxt_ndx( 'tag_NO2_NO3' ) + tag_NO2_OH_ndx = get_rxt_ndx( 'tag_NO2_OH' ) + tag_NO2_HO2_ndx = get_rxt_ndx( 'tag_NO2_HO2' ) + tag_C2H4_OH_ndx = get_rxt_ndx( 'tag_C2H4_OH' ) + tag_C3H6_OH_ndx = get_rxt_ndx( 'tag_C3H6_OH' ) + tag_CH3CO3_NO2_ndx = get_rxt_ndx( 'tag_CH3CO3_NO2' ) +!lke-TS1 + usr_PBZNIT_M_ndx = get_rxt_ndx( 'usr_PBZNIT_M' ) + tag_ACBZO2_NO2_ndx = get_rxt_ndx( 'tag_ACBZO2_NO2' ) + usr_ISOPNITA_aer_ndx = get_rxt_ndx( 'usr_ISOPNITA_aer' ) + usr_ISOPNITB_aer_ndx = get_rxt_ndx( 'usr_ISOPNITB_aer' ) + usr_ONITR_aer_ndx = get_rxt_ndx( 'usr_ONITR_aer' ) + usr_HONITR_aer_ndx = get_rxt_ndx( 'usr_HONITR_aer' ) + usr_TERPNIT_aer_ndx = get_rxt_ndx( 'usr_TERPNIT_aer' ) + usr_NTERPOOH_aer_ndx = get_rxt_ndx( 'usr_NTERPOOH_aer' ) + usr_NC4CHO_aer_ndx = get_rxt_ndx( 'usr_NC4CHO_aer' ) + usr_NC4CH2OH_aer_ndx = get_rxt_ndx( 'usr_NC4CH2OH_aer' ) + ! + ! additional reactions for O3A/XNO + ! + usr_OA_O2_ndx = get_rxt_ndx( 'usr_OA_O2' ) + usr_XNO2NO3_M_ndx = get_rxt_ndx( 'usr_XNO2NO3_M' ) + usr_NO2XNO3_M_ndx = get_rxt_ndx( 'usr_NO2XNO3_M' ) + usr_XNO2NO3_aer_ndx = get_rxt_ndx( 'usr_XNO2NO3_aer' ) + usr_NO2XNO3_aer_ndx = get_rxt_ndx( 'usr_NO2XNO3_aer' ) + usr_XHNO3_OH_ndx = get_rxt_ndx( 'usr_XHNO3_OH' ) + usr_XNO3_aer_ndx = get_rxt_ndx( 'usr_XNO3_aer' ) + usr_XNO2_aer_ndx = get_rxt_ndx( 'usr_XNO2_aer' ) + usr_MCO3_XNO2_ndx = get_rxt_ndx( 'usr_MCO3_XNO2' ) + usr_XPAN_M_ndx = get_rxt_ndx( 'usr_XPAN_M' ) + usr_XMPAN_M_ndx = get_rxt_ndx( 'usr_XMPAN_M' ) + usr_XHO2NO2_M_ndx = get_rxt_ndx( 'usr_XHO2NO2_M' ) +! +! reduced hydrocarbon chemistry +! + usr_C2O3_NO2_ndx = get_rxt_ndx( 'usr_C2O3_NO2' ) + usr_C2H4_OH_ndx = get_rxt_ndx( 'usr_C2H4_OH' ) + usr_XO2N_HO2_ndx = get_rxt_ndx( 'usr_XO2N_HO2' ) + usr_C2O3_XNO2_ndx = get_rxt_ndx( 'usr_C2O3_XNO2' ) +! + tag_XO2N_NO_ndx = get_rxt_ndx( 'tag_XO2N_NO' ) + tag_XO2_HO2_ndx = get_rxt_ndx( 'tag_XO2_HO2' ) + tag_XO2_NO_ndx = get_rxt_ndx( 'tag_XO2_NO' ) +! +! stratospheric chemistry +! + usr_O_O_ndx = get_rxt_ndx( 'usr_O_O' ) + usr_CL2O2_M_ndx = get_rxt_ndx( 'usr_CL2O2_M' ) + usr_SO3_H2O_ndx = get_rxt_ndx( 'usr_SO3_H2O' ) +! + tag_CLO_CLO_M_ndx = get_rxt_ndx( 'tag_CLO_CLO_M' ) + if (tag_CLO_CLO_M_ndx<0) then ! for backwards compatibility + tag_CLO_CLO_M_ndx = get_rxt_ndx( 'tag_CLO_CLO' ) + endif +! +! reactions to remove BAM aerosols in the stratosphere +! + usr_strat_tau_ndx( 1) = get_rxt_ndx( 'usr_CB1_strat_tau' ) + usr_strat_tau_ndx( 2) = get_rxt_ndx( 'usr_CB2_strat_tau' ) + usr_strat_tau_ndx( 3) = get_rxt_ndx( 'usr_OC1_strat_tau' ) + usr_strat_tau_ndx( 4) = get_rxt_ndx( 'usr_OC2_strat_tau' ) + usr_strat_tau_ndx( 5) = get_rxt_ndx( 'usr_SO4_strat_tau' ) + usr_strat_tau_ndx( 6) = get_rxt_ndx( 'usr_SOA_strat_tau' ) + usr_strat_tau_ndx( 7) = get_rxt_ndx( 'usr_NH4_strat_tau' ) + usr_strat_tau_ndx( 8) = get_rxt_ndx( 'usr_NH4NO3_strat_tau' ) + usr_strat_tau_ndx( 9) = get_rxt_ndx( 'usr_SSLT01_strat_tau' ) + usr_strat_tau_ndx(10) = get_rxt_ndx( 'usr_SSLT02_strat_tau' ) + usr_strat_tau_ndx(11) = get_rxt_ndx( 'usr_SSLT03_strat_tau' ) + usr_strat_tau_ndx(12) = get_rxt_ndx( 'usr_SSLT04_strat_tau' ) + usr_strat_tau_ndx(13) = get_rxt_ndx( 'usr_DST01_strat_tau' ) + usr_strat_tau_ndx(14) = get_rxt_ndx( 'usr_DST02_strat_tau' ) + usr_strat_tau_ndx(15) = get_rxt_ndx( 'usr_DST03_strat_tau' ) + usr_strat_tau_ndx(16) = get_rxt_ndx( 'usr_DST04_strat_tau' ) + usr_strat_tau_ndx(17) = get_rxt_ndx( 'usr_SO2t_strat_tau' ) + usr_strat_tau_ndx(18) = get_rxt_ndx( 'usr_SOAI_strat_tau' ) + usr_strat_tau_ndx(19) = get_rxt_ndx( 'usr_SOAM_strat_tau' ) + usr_strat_tau_ndx(20) = get_rxt_ndx( 'usr_SOAB_strat_tau' ) + usr_strat_tau_ndx(21) = get_rxt_ndx( 'usr_SOAT_strat_tau' ) + usr_strat_tau_ndx(22) = get_rxt_ndx( 'usr_SOAX_strat_tau' ) +! +! stratospheric aerosol chemistry +! + het1_ndx = get_rxt_ndx( 'het1' ) +! +! ion chemistry +! + ion1_ndx = get_rxt_ndx( 'ion_Op_O2' ) + ion2_ndx = get_rxt_ndx( 'ion_Op_N2' ) + ion3_ndx = get_rxt_ndx( 'ion_N2p_Oa' ) + ion11_ndx = get_rxt_ndx( 'ion_N2p_Ob' ) + + elec1_ndx = get_rxt_ndx( 'elec1' ) + elec2_ndx = get_rxt_ndx( 'elec2' ) + elec3_ndx = get_rxt_ndx( 'elec3' ) + + do i = 1,nean + write (xchar,'(i4)') i + rxtname = 'ean'//trim(adjustl(xchar)) + ean_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,nrpe + write (xchar,'(i4)') i + rxtname = 'rpe'//trim(adjustl(xchar)) + rpe_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,npir + write (xchar,'(i4)') i + rxtname = 'pir'//trim(adjustl(xchar)) + pir_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,nedn + write (xchar,'(i4)') i + rxtname = 'edn'//trim(adjustl(xchar)) + edn_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,nnir + write (xchar,'(i4)') i + rxtname = 'nir'//trim(adjustl(xchar)) + nir_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,niira + write (xchar,'(i4)') i + rxtname = 'iira'//trim(adjustl(xchar)) + iira_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + do i = 1,niirb + write (xchar,'(i4)') i + rxtname = 'iirb'//trim(adjustl(xchar)) + iirb_ndx(i) = get_rxt_ndx(trim(rxtname)) + enddo + + usr_clm_h2o_m_ndx = get_rxt_ndx( 'usr_CLm_H2O_M' ) + usr_clm_hcl_m_ndx = get_rxt_ndx( 'usr_CLm_HCL_M' ) + + elec4_ndx = get_rxt_ndx( 'Op2P_ea' ) + elec5_ndx = get_rxt_ndx( 'Op2P_eb' ) + elec6_ndx = get_rxt_ndx( 'Op2D_e' ) + + has_ion_rxts = ion1_ndx>0 .and. ion2_ndx>0 .and. ion3_ndx>0 .and. elec1_ndx>0 & + .and. elec2_ndx>0 .and. elec3_ndx>0 + + has_d_chem = & + all(ean_ndx>0) .and. & + all(rpe_ndx>0) .and. & + all(pir_ndx>0) .and. & + all(edn_ndx>0) .and. & + all(nir_ndx>0) .and. & + all(iira_ndx>0) .and. & + all(iirb_ndx>0) .and. & + usr_clm_h2o_m_ndx>0 .and. usr_clm_hcl_m_ndx>0 + + h2o_ndx = get_spc_ndx( 'H2O' ) + + ! + ! llnl super fast + ! + usr_oh_co_ndx = get_rxt_ndx( 'usr_oh_co' ) + het_no2_h2o_ndx = get_rxt_ndx( 'het_no2_h2o' ) + usr_oh_dms_ndx = get_rxt_ndx( 'usr_oh_dms' ) + aq_so2_h2o2_ndx = get_rxt_ndx( 'aq_so2_h2o2' ) + aq_so2_o3_ndx = get_rxt_ndx( 'aq_so2_o3' ) + +!lke++ +! CO tags +! + usr_COhc_OH_ndx = get_rxt_ndx( 'usr_COhc_OH' ) + usr_COme_OH_ndx = get_rxt_ndx( 'usr_COme_OH' ) + usr_CO01_OH_ndx = get_rxt_ndx( 'usr_CO01_OH' ) + usr_CO02_OH_ndx = get_rxt_ndx( 'usr_CO02_OH' ) + usr_CO03_OH_ndx = get_rxt_ndx( 'usr_CO03_OH' ) + usr_CO04_OH_ndx = get_rxt_ndx( 'usr_CO04_OH' ) + usr_CO05_OH_ndx = get_rxt_ndx( 'usr_CO05_OH' ) + usr_CO06_OH_ndx = get_rxt_ndx( 'usr_CO06_OH' ) + usr_CO07_OH_ndx = get_rxt_ndx( 'usr_CO07_OH' ) + usr_CO08_OH_ndx = get_rxt_ndx( 'usr_CO08_OH' ) + usr_CO09_OH_ndx = get_rxt_ndx( 'usr_CO09_OH' ) + usr_CO10_OH_ndx = get_rxt_ndx( 'usr_CO10_OH' ) + usr_CO11_OH_ndx = get_rxt_ndx( 'usr_CO11_OH' ) + usr_CO12_OH_ndx = get_rxt_ndx( 'usr_CO12_OH' ) + usr_CO13_OH_ndx = get_rxt_ndx( 'usr_CO13_OH' ) + usr_CO14_OH_ndx = get_rxt_ndx( 'usr_CO14_OH' ) + usr_CO15_OH_ndx = get_rxt_ndx( 'usr_CO15_OH' ) + usr_CO16_OH_ndx = get_rxt_ndx( 'usr_CO16_OH' ) + usr_CO17_OH_ndx = get_rxt_ndx( 'usr_CO17_OH' ) + usr_CO18_OH_ndx = get_rxt_ndx( 'usr_CO18_OH' ) + usr_CO19_OH_ndx = get_rxt_ndx( 'usr_CO19_OH' ) + usr_CO20_OH_ndx = get_rxt_ndx( 'usr_CO20_OH' ) + usr_CO21_OH_ndx = get_rxt_ndx( 'usr_CO21_OH' ) + usr_CO22_OH_ndx = get_rxt_ndx( 'usr_CO22_OH' ) + usr_CO23_OH_ndx = get_rxt_ndx( 'usr_CO23_OH' ) + usr_CO24_OH_ndx = get_rxt_ndx( 'usr_CO24_OH' ) + usr_CO25_OH_ndx = get_rxt_ndx( 'usr_CO25_OH' ) + usr_CO26_OH_ndx = get_rxt_ndx( 'usr_CO26_OH' ) + usr_CO27_OH_ndx = get_rxt_ndx( 'usr_CO27_OH' ) + usr_CO28_OH_ndx = get_rxt_ndx( 'usr_CO28_OH' ) + usr_CO29_OH_ndx = get_rxt_ndx( 'usr_CO29_OH' ) + usr_CO30_OH_ndx = get_rxt_ndx( 'usr_CO30_OH' ) + usr_CO31_OH_ndx = get_rxt_ndx( 'usr_CO31_OH' ) + usr_CO32_OH_ndx = get_rxt_ndx( 'usr_CO32_OH' ) + usr_CO33_OH_ndx = get_rxt_ndx( 'usr_CO33_OH' ) + usr_CO34_OH_ndx = get_rxt_ndx( 'usr_CO34_OH' ) + usr_CO35_OH_ndx = get_rxt_ndx( 'usr_CO35_OH' ) + usr_CO36_OH_ndx = get_rxt_ndx( 'usr_CO36_OH' ) + usr_CO37_OH_ndx = get_rxt_ndx( 'usr_CO37_OH' ) + usr_CO38_OH_ndx = get_rxt_ndx( 'usr_CO38_OH' ) + usr_CO39_OH_ndx = get_rxt_ndx( 'usr_CO39_OH' ) + usr_CO40_OH_ndx = get_rxt_ndx( 'usr_CO40_OH' ) + usr_CO41_OH_ndx = get_rxt_ndx( 'usr_CO41_OH' ) + usr_CO42_OH_ndx = get_rxt_ndx( 'usr_CO42_OH' ) +!lke-- + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'usrrxt_inti: diagnostics ' + write(iulog,'(10i5)') usr_O_O2_ndx,usr_HO2_HO2_ndx,tag_NO2_NO3_ndx,usr_N2O5_M_ndx,tag_NO2_OH_ndx,usr_HNO3_OH_ndx & + ,tag_NO2_HO2_ndx,usr_HO2NO2_M_ndx,usr_N2O5_aer_ndx,usr_NO3_aer_ndx,usr_NO2_aer_ndx & + ,usr_CO_OH_b_ndx,tag_C2H4_OH_ndx,tag_C3H6_OH_ndx,tag_CH3CO3_NO2_ndx,usr_PAN_M_ndx,usr_CH3COCH3_OH_ndx & + ,usr_MCO3_NO2_ndx,usr_MPAN_M_ndx,usr_XOOH_OH_ndx,usr_SO2_OH_ndx,usr_DMS_OH_ndx,usr_HO2_aer_ndx & + ,usr_GLYOXAL_aer_ndx,usr_ISOPNITA_aer_ndx,usr_ISOPNITB_aer_ndx,usr_ONITR_aer_ndx,usr_HONITR_aer_ndx & + ,usr_TERPNIT_aer_ndx,usr_NTERPOOH_aer_ndx,usr_NC4CHO_aer_ndx,usr_NC4CH2OH_aer_ndx + + end if + + end subroutine usrrxt_inti + + subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & + pmid, m, sulfate, mmr, relhum, strato_sad, & + tropchemlev, dlat, ncol, sad_trop, reff_trop, cwat, mbar, pbuf ) + +!----------------------------------------------------------------- +! ... set the user specified reaction rates +!----------------------------------------------------------------- + + use mo_constants, only : pi, avo => avogadro, boltz_cgs, rgas + use chem_mods, only : nfs, rxntot, gas_pcnst, inv_m_ndx=>indexm + use mo_setinv, only : inv_o2_ndx=>o2_ndx, inv_h2o_ndx=>h2o_ndx + use physics_buffer,only : physics_buffer_desc + use carma_flags_mod, only : carma_hetchem_feedback + use aero_model, only : aero_model_surfarea + use rad_constituents,only : rad_cnst_get_info + + implicit none + +!----------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: tropchemlev(pcols) ! trop/strat reaction separation vertical index + real(r8), intent(in) :: dlat(:) ! degrees latitude + real(r8), intent(in) :: temp(pcols,pver) ! temperature (K); neutral temperature + real(r8), intent(in) :: tempi(pcols,pver) ! ionic temperature (K); only used if ion chemistry + real(r8), intent(in) :: tempe(pcols,pver) ! electronic temperature (K); only used if ion chemistry + real(r8), intent(in) :: m(ncol,pver) ! total atm density (/cm^3) + real(r8), intent(in) :: sulfate(ncol,pver) ! sulfate aerosol (mol/mol) + real(r8), intent(in) :: strato_sad(pcols,pver) ! stratospheric aerosol sad (1/cm) + real(r8), intent(in) :: h2ovmr(ncol,pver) ! water vapor (mol/mol) + real(r8), intent(in) :: relhum(ncol,pver) ! relative humidity + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: invariants(ncol,pver,nfs) ! invariants density (/cm^3) + real(r8), intent(in) :: mmr(pcols,pver,gas_pcnst) ! species concentrations (kg/kg) + real(r8), intent(in) :: cwat(ncol,pver) !PJC Condensed Water (liquid+ice) (kg/kg) + real(r8), intent(in) :: mbar(ncol,pver) !PJC Molar mass of air (g/mol) + real(r8), intent(inout) :: rxt(ncol,pver,rxntot) ! gas phase rates + real(r8), intent(out) :: sad_trop(pcols,pver) ! tropospheric surface area density (cm2/cm3) + real(r8), intent(out) :: reff_trop(pcols,pver) ! tropospheric effective radius (cm) + type(physics_buffer_desc), pointer :: pbuf(:) + +!----------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------- + + real(r8), parameter :: dg = 0.1_r8 ! mole diffusion =0.1 cm2/s (Dentener, 1993) + +!----------------------------------------------------------------- +! ... reaction probabilities for heterogeneous reactions +!----------------------------------------------------------------- + real(r8), parameter :: gamma_n2o5 = 0.10_r8 ! from Jacob, Atm Env, 34, 2131, 2000 + real(r8), parameter :: gamma_ho2 = 0.20_r8 ! + real(r8), parameter :: gamma_no2 = 0.0001_r8 ! + real(r8), parameter :: gamma_no3 = 0.001_r8 ! + real(r8), parameter :: gamma_glyoxal = 2.0e-4_r8 ! Washenfelder et al, JGR, 2011 +!TS1 species + real(r8), parameter :: gamma_isopnita = 0.005_r8 ! from Fisher et al., ACP, 2016 + real(r8), parameter :: gamma_isopnitb = 0.005_r8 ! + real(r8), parameter :: gamma_onitr = 0.005_r8 ! + real(r8), parameter :: gamma_honitr = 0.005_r8 ! + real(r8), parameter :: gamma_terpnit = 0.01_r8 ! + real(r8), parameter :: gamma_nterpooh = 0.01_r8 ! + real(r8), parameter :: gamma_nc4cho = 0.005_r8 ! + real(r8), parameter :: gamma_nc4ch2oh = 0.005_r8 ! + + + integer :: i, k + integer :: l + real(r8) :: tp(ncol) ! 300/t + real(r8) :: tinv(ncol) ! 1/t + real(r8) :: ko(ncol) + real(r8) :: term1(ncol) + real(r8) :: term2(ncol) + real(r8) :: kinf(ncol) + real(r8) :: fc(ncol) + real(r8) :: xr(ncol) + real(r8) :: sur(ncol) + real(r8) :: sqrt_t(ncol) ! sqrt( temp ) + real(r8) :: sqrt_t_58(ncol) ! sqrt( temp / 58.) + real(r8) :: exp_fac(ncol) ! vector exponential + real(r8) :: lwc(ncol) + real(r8) :: ko_m(ncol) + real(r8) :: k0(ncol) + real(r8) :: kinf_m(ncol) + real(r8) :: o2(ncol) + real(r8) :: c_n2o5, c_ho2, c_no2, c_no3, c_glyoxal +!TS1 species + real(r8) :: c_isopnita, c_isopnitb, c_onitr, c_honitr, c_terpnit, c_nterpooh + real(r8) :: c_nc4cho, c_nc4ch2oh + + real(r8) :: amas + !----------------------------------------------------------------- + ! ... density of sulfate aerosol + !----------------------------------------------------------------- + real(r8), parameter :: gam1 = 0.04_r8 ! N2O5+SUL ->2HNO3 + real(r8), parameter :: wso4 = 98._r8 + real(r8), parameter :: den = 1.15_r8 ! each molecule of SO4(aer) density g/cm3 + !------------------------------------------------- + ! ... volume of sulfate particles + ! assuming mean rm + ! continient 0.05um 0.07um 0.09um + ! ocean 0.09um 0.25um 0.37um + ! 0.16um Blake JGR,7195, 1995 + !------------------------------------------------- + real(r8), parameter :: rm1 = 0.16_r8*1.e-4_r8 ! mean radii in cm + real(r8), parameter :: fare = 4._r8*pi*rm1*rm1 ! each mean particle(r=0.1u) area cm2/cm3 + + !----------------------------------------------------------------------- + ! ... Aqueous phase sulfur quantities for SO2 + H2O2 and SO2 + O3 + !----------------------------------------------------------------------- + real(r8), parameter :: HENRY298_H2O2 = 7.45e+04_r8 + real(r8), parameter :: H298_H2O2 = -1.45e+04_r8 + real(r8), parameter :: HENRY298_SO2 = 1.23e+00_r8 + real(r8), parameter :: H298_SO2 = -6.25e+03_r8 + real(r8), parameter :: K298_SO2_HSO3 = 1.3e-02_r8 + real(r8), parameter :: H298_SO2_HSO3 = -4.16e+03_r8 + real(r8), parameter :: R_CONC = 82.05e+00_r8 / avo + real(r8), parameter :: R_CAL = rgas * 0.239006e+00_r8 + real(r8), parameter :: K_AQ = 7.57e+07_r8 + real(r8), parameter :: ER_AQ = 4.43e+03_r8 + + real(r8), parameter :: HENRY298_O3 = 1.13e-02_r8 + real(r8), parameter :: H298_O3 = -5.04e+03_r8 + real(r8), parameter :: K298_HSO3_SO3 = 6.6e-08_r8 + real(r8), parameter :: H298_HSO3_SO3 = -2.23e+03_r8 + real(r8), parameter :: K0_AQ = 2.4e+04_r8 + real(r8), parameter :: ER0_AQ = 0.0e+00_r8 + real(r8), parameter :: K1_AQ = 3.7e+05_r8 + real(r8), parameter :: ER1_AQ = 5.53e+03_r8 + real(r8), parameter :: K2_AQ = 1.5e+09_r8 + real(r8), parameter :: ER2_AQ = 5.28e+03_r8 + + real(r8), parameter :: pH = 4.5e+00_r8 + + real(r8), pointer :: sfc(:), dm_aer(:) + integer :: ntot_amode + + real(r8), pointer :: sfc_array(:,:,:), dm_array(:,:,:) + + ! get info about the modal aerosols + ! get ntot_amode + call rad_cnst_get_info(0, nmodes=ntot_amode) + + if (ntot_amode>0) then + allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) ) + else + allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) ) + endif + + sfc_array(:,:,:) = 0._r8 + dm_array(:,:,:) = 0._r8 + sad_trop(:,:) = 0._r8 + reff_trop(:,:) = 0._r8 + + if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 ) then + +! sad_trop should be set outside of usrrxt ?? + if( carma_hetchem_feedback ) then + sad_trop(:ncol,:pver)=strato_sad(:ncol,:pver) + else + + call aero_model_surfarea( & + mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & + het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop ) + + endif + endif + + level_loop : do k = 1,pver + tinv(:) = 1._r8 / temp(:ncol,k) + tp(:) = 300._r8 * tinv(:) + sqrt_t(:) = sqrt( temp(:ncol,k) ) + sqrt_t_58(:) = sqrt( temp(:ncol,k) / 58.0_r8 ) + +!----------------------------------------------------------------- +! ... o + o2 + m --> o3 + m (JPL15-10) +!----------------------------------------------------------------- + if( usr_O_O2_ndx > 0 ) then + rxt(:,k,usr_O_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8 + end if + if( usr_OA_O2_ndx > 0 ) then + rxt(:,k,usr_OA_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8 + end if + +!----------------------------------------------------------------- +! ... o + o + m -> o2 + m +!----------------------------------------------------------------- + if ( usr_O_O_ndx > 0 ) then + rxt(:,k,usr_O_O_ndx) = 2.76e-34_r8 * exp( 720.0_r8*tinv(:) ) + end if + +!----------------------------------------------------------------- +! ... cl2o2 + m -> 2*clo + m (JPL15-10) +!----------------------------------------------------------------- + if ( usr_CL2O2_M_ndx > 0 ) then + if ( tag_CLO_CLO_M_ndx > 0 ) then + ko(:) = 2.16e-27_r8 * exp( 8537.0_r8* tinv(:) ) + rxt(:,k,usr_CL2O2_M_ndx) = rxt(:,k,tag_CLO_CLO_M_ndx)/ko(:) + else + rxt(:,k,usr_CL2O2_M_ndx) = 0._r8 + end if + end if + +!----------------------------------------------------------------- +! ... so3 + 2*h2o --> h2so4 + h2o +! Note: this reaction proceeds by the 2 intermediate steps below +! so3 + h2o --> adduct +! adduct + h2o --> h2so4 + h2o +! (Lovejoy et al., JCP, pp. 19911-19916, 1996) +! The first order rate constant used here is recommended by JPL 2011. +! This rate involves the water vapor number density. +!----------------------------------------------------------------- + + if ( usr_SO3_H2O_ndx > 0 ) then + call comp_exp( exp_fac, 6540.0_r8*tinv(:), ncol ) + if( h2o_ndx > 0 ) then + fc(:) = 8.5e-21_r8 * m(:,k) * h2ovmr(:,k) * exp_fac(:) + else + fc(:) = 8.5e-21_r8 * invariants(:,k,inv_h2o_ndx) * exp_fac(:) + end if + rxt(:,k,usr_SO3_H2O_ndx) = 1.0e-20_r8 * fc(:) + end if + +!----------------------------------------------------------------- +! ... n2o5 + m --> no2 + no3 + m (JPL15-10) +!----------------------------------------------------------------- + if( usr_N2O5_M_ndx > 0 ) then + if( tag_NO2_NO3_ndx > 0 ) then + call comp_exp( exp_fac, -10840.0_r8*tinv, ncol ) + rxt(:,k,usr_N2O5_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) * 1.724138e26_r8 * exp_fac(:) + else + rxt(:,k,usr_N2O5_M_ndx) = 0._r8 + end if + end if + if( usr_XNO2NO3_M_ndx > 0 ) then + if( tag_NO2_NO3_ndx > 0 ) then + call comp_exp( exp_fac, -10840.0_r8*tinv, ncol ) + rxt(:,k,usr_XNO2NO3_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) *1.724138e26_r8 * exp_fac(:) + else + rxt(:,k,usr_XNO2NO3_M_ndx) = 0._r8 + end if + end if + if( usr_NO2XNO3_M_ndx > 0 ) then + if( tag_NO2_NO3_ndx > 0 ) then + call comp_exp( exp_fac, -10840.0_r8*tinv, ncol ) + rxt(:,k,usr_NO2XNO3_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) * 1.734138e26_r8 * exp_fac(:) + else + rxt(:,k,usr_NO2XNO3_M_ndx) = 0._r8 + end if + end if + +!----------------------------------------------------------------- +! set rates for: +! ... hno3 + oh --> no3 + h2o +! ho2no2 + m --> ho2 + no2 + m +!----------------------------------------------------------------- + if( usr_HNO3_OH_ndx > 0 ) then + call comp_exp( exp_fac, 1335._r8*tinv, ncol ) + ko(:) = m(:,k) * 6.5e-34_r8 * exp_fac(:) + call comp_exp( exp_fac, 2199._r8*tinv, ncol ) + ko(:) = ko(:) / (1._r8 + ko(:)/(2.7e-17_r8*exp_fac(:))) + call comp_exp( exp_fac, 460._r8*tinv, ncol ) + rxt(:,k,usr_HNO3_OH_ndx) = ko(:) + 2.4e-14_r8*exp_fac(:) + end if + if( usr_XHNO3_OH_ndx > 0 ) then + call comp_exp( exp_fac, 1335._r8*tinv, ncol ) + ko(:) = m(:,k) * 6.5e-34_r8 * exp_fac(:) + call comp_exp( exp_fac, 2199._r8*tinv, ncol ) + ko(:) = ko(:) / (1._r8 + ko(:)/(2.7e-17_r8*exp_fac(:))) + call comp_exp( exp_fac, 460._r8*tinv, ncol ) + rxt(:,k,usr_XHNO3_OH_ndx) = ko(:) + 2.4e-14_r8*exp_fac(:) + end if + if( usr_HO2NO2_M_ndx > 0 ) then + if( tag_NO2_HO2_ndx > 0 ) then + call comp_exp( exp_fac, -10900._r8*tinv, ncol ) + rxt(:,k,usr_HO2NO2_M_ndx) = rxt(:,k,tag_NO2_HO2_ndx) * exp_fac(:) / 2.1e-27_r8 + else + rxt(:,k,usr_HO2NO2_M_ndx) = 0._r8 + end if + end if + if( usr_XHO2NO2_M_ndx > 0 ) then + if( tag_NO2_HO2_ndx > 0 ) then + call comp_exp( exp_fac, -10900._r8*tinv, ncol ) + rxt(:,k,usr_XHO2NO2_M_ndx) = rxt(:,k,tag_NO2_HO2_ndx) * exp_fac(:) / 2.1e-27_r8 + else + rxt(:,k,usr_XHO2NO2_M_ndx) = 0._r8 + end if + end if +!----------------------------------------------------------------- +! co + oh --> co2 + ho2 (combined branches - do not use with CO_OH_b) +!----------------------------------------------------------------- + if( usr_CO_OH_a_ndx > 0 ) then + rxt(:,k,usr_CO_OH_a_ndx) = 1.5e-13_r8 * & + (1._r8 + 6.e-7_r8*boltz_cgs*m(:,k)*temp(:ncol,k)) + end if +!----------------------------------------------------------------- +! ... co + oh --> co2 + h (second branch JPL15-10, with CO+OH+M) +!----------------------------------------------------------------- + if( usr_CO_OH_b_ndx > 0 ) then + kinf(:) = 2.1e+09_r8 * (temp(:ncol,k)/ t0)**(6.1_r8) + ko (:) = 1.5e-13_r8 + + term1(:) = ko(:) / ( (kinf(:) / m(:,k)) ) + term2(:) = ko(:) / (1._r8 + term1(:)) + + term1(:) = log10( term1(:) ) + term1(:) = 1.0_r8 / (1.0_r8 + term1(:)*term1(:)) + + rxt(:ncol,k,usr_CO_OH_b_ndx) = term2(:) * (0.6_r8)**term1(:) + end if + +!----------------------------------------------------------------- +! ... ho2 + ho2 --> h2o2 +! note: this rate involves the water vapor number density +!----------------------------------------------------------------- + if( usr_HO2_HO2_ndx > 0 ) then + + call comp_exp( exp_fac, 460._r8*tinv, ncol ) + ko(:) = 3.0e-13_r8 * exp_fac(:) + call comp_exp( exp_fac, 920._r8*tinv, ncol ) + kinf(:) = 2.1e-33_r8 * m(:,k) * exp_fac(:) + call comp_exp( exp_fac, 2200._r8*tinv, ncol ) + + if( h2o_ndx > 0 ) then + fc(:) = 1._r8 + 1.4e-21_r8 * m(:,k) * h2ovmr(:,k) * exp_fac(:) + else + fc(:) = 1._r8 + 1.4e-21_r8 * invariants(:,k,inv_h2o_ndx) * exp_fac(:) + end if + rxt(:,k,usr_HO2_HO2_ndx) = (ko(:) + kinf(:)) * fc(:) + + end if + +!----------------------------------------------------------------- +! ... mco3 + no2 -> mpan +!----------------------------------------------------------------- + if( usr_MCO3_NO2_ndx > 0 ) then + rxt(:,k,usr_MCO3_NO2_ndx) = 1.1e-11_r8 * tp(:) / m(:,k) + end if + if( usr_MCO3_XNO2_ndx > 0 ) then + rxt(:,k,usr_MCO3_XNO2_ndx) = 1.1e-11_r8 * tp(:) / m(:,k) + end if + +!----------------------------------------------------------------- +! ... pan + m --> ch3co3 + no2 + m (JPL15-10) +!----------------------------------------------------------------- + call comp_exp( exp_fac, -14000._r8*tinv, ncol ) + if( usr_PAN_M_ndx > 0 ) then + if( tag_CH3CO3_NO2_ndx > 0 ) then + rxt(:,k,usr_PAN_M_ndx) = rxt(:,k,tag_CH3CO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:) + else + rxt(:,k,usr_PAN_M_ndx) = 0._r8 + end if + end if + if( usr_XPAN_M_ndx > 0 ) then + if( tag_CH3CO3_NO2_ndx > 0 ) then + rxt(:,k,usr_XPAN_M_ndx) = rxt(:,k,tag_CH3CO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:) + else + rxt(:,k,usr_XPAN_M_ndx) = 0._r8 + end if + end if + +!----------------------------------------------------------------- +! ... mpan + m --> mco3 + no2 + m (JPL15-10) +!----------------------------------------------------------------- + if( usr_MPAN_M_ndx > 0 ) then + if( usr_MCO3_NO2_ndx > 0 ) then + rxt(:,k,usr_MPAN_M_ndx) = rxt(:,k,usr_MCO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:) + else + rxt(:,k,usr_MPAN_M_ndx) = 0._r8 + end if + end if + if( usr_XMPAN_M_ndx > 0 ) then + if( usr_MCO3_NO2_ndx > 0 ) then + rxt(:,k,usr_XMPAN_M_ndx) = rxt(:,k,usr_MCO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:) + else + rxt(:,k,usr_XMPAN_M_ndx) = 0._r8 + end if + end if + +!lke-TS1 +!----------------------------------------------------------------- +! ... pbznit + m --> acbzo2 + no2 + m +!----------------------------------------------------------------- + if( usr_PBZNIT_M_ndx > 0 ) then + if( tag_ACBZO2_NO2_ndx > 0 ) then + rxt(:,k,usr_PBZNIT_M_ndx) = rxt(:,k,tag_ACBZO2_NO2_ndx) * 1.111e28_r8 * exp_fac(:) + else + rxt(:,k,usr_PBZNIT_M_ndx) = 0._r8 + end if + end if + +!----------------------------------------------------------------- +! ... xooh + oh -> h2o + oh +!----------------------------------------------------------------- + if( usr_XOOH_OH_ndx > 0 ) then + call comp_exp( exp_fac, 253._r8*tinv, ncol ) + rxt(:,k,usr_XOOH_OH_ndx) = temp(:ncol,k)**2._r8 * 7.69e-17_r8 * exp_fac(:) + end if + +!----------------------------------------------------------------- +! ... ch3coch3 + oh -> ro2 + h2o +!----------------------------------------------------------------- + if( usr_CH3COCH3_OH_ndx > 0 ) then + call comp_exp( exp_fac, -2000._r8*tinv, ncol ) + rxt(:,k,usr_CH3COCH3_OH_ndx) = 3.82e-11_r8 * exp_fac(:) + 1.33e-13_r8 + end if + +!----------------------------------------------------------------- +! ... DMS + OH --> .5 * SO2 +!----------------------------------------------------------------- + if( usr_DMS_OH_ndx > 0 ) then + call comp_exp( exp_fac, 7460._r8*tinv, ncol ) + ko(:) = 1._r8 + 5.5e-31_r8 * exp_fac * m(:,k) * 0.21_r8 + call comp_exp( exp_fac, 7810._r8*tinv, ncol ) + rxt(:,k,usr_DMS_OH_ndx) = 1.7e-42_r8 * exp_fac * m(:,k) * 0.21_r8 / ko(:) + end if + +!----------------------------------------------------------------- +! ... SO2 + OH --> SO4 (REFERENCE?? - not Liao) +!----------------------------------------------------------------- + if( usr_SO2_OH_ndx > 0 ) then + fc(:) = 3.0e-31_r8 *(300._r8*tinv(:))**3.3_r8 + ko(:) = fc(:)*m(:,k)/(1._r8 + fc(:)*m(:,k)/1.5e-12_r8) + rxt(:,k,usr_SO2_OH_ndx) = ko(:)*.6_r8**(1._r8 + (log10(fc(:)*m(:,k)/1.5e-12_r8))**2._r8)**(-1._r8) + end if +! +! reduced hydrocarbon scheme +! + if ( usr_C2O3_NO2_ndx > 0 ) then + ko(:) = 2.6e-28_r8 * m(:,k) + kinf(:) = 1.2e-11_r8 + rxt(:,k,usr_C2O3_NO2_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log10(ko/kinf))**2)) + end if + if ( usr_C2O3_XNO2_ndx > 0 ) then + ko(:) = 2.6e-28_r8 * m(:,k) + kinf(:) = 1.2e-11_r8 + rxt(:,k,usr_C2O3_XNO2_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log10(ko/kinf))**2)) + end if + if ( usr_C2H4_OH_ndx > 0 ) then + ko(:) = 1.0e-28_r8 * m(:,k) + kinf(:) = 8.8e-12_r8 + rxt(:,k,usr_C2H4_OH_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log(ko/kinf))**2)) + end if + if ( usr_XO2N_HO2_ndx > 0 ) then + rxt(:,k,usr_XO2N_HO2_ndx) = rxt(:,k,tag_XO2N_NO_ndx)*rxt(:,k,tag_XO2_HO2_ndx)/(rxt(:,k,tag_XO2_NO_ndx)+1.e-36_r8) + end if + +! +! hydrolysis reactions on wetted aerosols +! + if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 & + .or. usr_GLYOXAL_aer_ndx > 0 ) then + + long_loop : do i = 1,ncol + + sfc => sfc_array(i,k,:) + dm_aer => dm_array(i,k,:) + + c_n2o5 = 1.40e3_r8 * sqrt_t(i) ! mean molecular speed of n2o5 + c_no3 = 1.85e3_r8 * sqrt_t(i) ! mean molecular speed of no3 + c_no2 = 2.15e3_r8 * sqrt_t(i) ! mean molecular speed of no2 + c_ho2 = 2.53e3_r8 * sqrt_t(i) ! mean molecular speed of ho2 + c_glyoxal = 1.455e4_r8 * sqrt_t_58(i) ! mean molecular speed of ho2 + c_isopnita = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of isopnita + c_isopnitb = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of isopnitb + c_onitr = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of onitr + c_honitr = 1.26e3_r8 * sqrt_t(i) ! mean molecular speed of honitr + c_terpnit = 0.992e3_r8 * sqrt_t(i) ! mean molecular speed of terpnit + c_nterpooh = 0.957e3_r8 * sqrt_t(i) ! mean molecular speed of nterpooh + c_nc4cho = 1.21e3_r8 * sqrt_t(i) ! mean molecular speed of nc4cho + c_nc4ch2oh = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of nc4ch2oh + + !------------------------------------------------------------------------- + ! Heterogeneous reaction rates for uptake of a gas on an aerosol: + ! rxt = sfc / ( (rad_aer/Dg_gas) + (4/(c_gas*gamma_gas))) + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! ... n2o5 -> 2 hno3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_N2O5_aer_ndx > 0 ) then + rxt(i,k,usr_N2O5_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 ) + end if + if( usr_XNO2NO3_aer_ndx > 0 ) then + rxt(i,k,usr_XNO2NO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 ) + end if + if( usr_NO2XNO3_aer_ndx > 0 ) then + rxt(i,k,usr_NO2XNO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 ) + end if + !------------------------------------------------------------------------- + ! ... no3 -> hno3 (on sulfate, nh4no3, oc, soa) + !------------------------------------------------------------------------- + if( usr_NO3_aer_ndx > 0 ) then + rxt(i,k,usr_NO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no3, gamma_no3 ) + end if + if( usr_XNO3_aer_ndx > 0 ) then + rxt(i,k,usr_XNO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no3, gamma_no3 ) + end if + !------------------------------------------------------------------------- + ! ... no2 -> 0.5 * (ho+no+hno3) (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_NO2_aer_ndx > 0 ) then + rxt(i,k,usr_NO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no2, gamma_no2 ) + end if + if( usr_XNO2_aer_ndx > 0 ) then + rxt(i,k,usr_XNO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no2, gamma_no2 ) + end if + + !------------------------------------------------------------------------- + ! ... ho2 -> 0.5 * h2o2 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_HO2_aer_ndx > 0 ) then + rxt(i,k,usr_HO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_ho2, gamma_ho2 ) + end if + !------------------------------------------------------------------------- + ! ... glyoxal -> soag1 (on sulfate, nh4no3, oc2, soa) + ! first order uptake, Fuchs and Sutugin, 1971, dCg = 1/4 * gamma * ! A * |v_mol| * Cg * dt + !------------------------------------------------------------------------- + if( usr_GLYOXAL_aer_ndx > 0 ) then + rxt(i,k,usr_GLYOXAL_aer_ndx) = hetrxtrate_gly( sfc, c_glyoxal, gamma_glyoxal ) + end if + !------------------------------------------------------------------------- + ! ... ISOPNITA -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_ISOPNITA_aer_ndx > 0 ) then + rxt(i,k,usr_ISOPNITA_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_isopnita, gamma_isopnita ) + end if + !------------------------------------------------------------------------- + ! ... ISOPNITB -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_ISOPNITB_aer_ndx > 0 ) then + rxt(i,k,usr_ISOPNITB_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_isopnitb, gamma_isopnitb ) + end if + !------------------------------------------------------------------------- + ! ... ONITR -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_ONITR_aer_ndx > 0 ) then + rxt(i,k,usr_ONITR_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_onitr, gamma_onitr ) + end if + !------------------------------------------------------------------------- + ! ... HONITR -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_HONITR_aer_ndx > 0 ) then + rxt(i,k,usr_HONITR_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_honitr, gamma_honitr ) + end if + !------------------------------------------------------------------------- + ! ... TERPNIT -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_TERPNIT_aer_ndx > 0 ) then + rxt(i,k,usr_TERPNIT_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_terpnit, gamma_terpnit ) + end if + !------------------------------------------------------------------------- + ! ... NTERPOOH -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_NTERPOOH_aer_ndx > 0 ) then + rxt(i,k,usr_NTERPOOH_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nterpooh, gamma_nterpooh ) + end if + !------------------------------------------------------------------------- + ! ... NC4CHO -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_NC4CHO_aer_ndx > 0 ) then + rxt(i,k,usr_NC4CHO_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nc4cho, gamma_nc4cho ) + end if + !------------------------------------------------------------------------- + ! ... NC4CH2OH -> HNO3 (on sulfate, nh4no3, oc2, soa) + !------------------------------------------------------------------------- + if( usr_NC4CH2OH_aer_ndx > 0 ) then + rxt(i,k,usr_NC4CH2OH_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nc4ch2oh, gamma_nc4ch2oh ) + end if + + end do long_loop + end if + + ! LLNL super fast chem reaction rates + + !----------------------------------------------------------------------- + ! ... CO + OH --> CO2 + HO2 + !----------------------------------------------------------------------- + if ( usr_oh_co_ndx > 0 ) then + ko(:) = 5.9e-33_r8 * tp(:)**1.4_r8 + kinf(:) = 1.1e-12_r8 * (temp(:ncol,k) / 300._r8)**1.3_r8 + ko_m(:) = ko(:) * m(:,k) + k0(:) = 1.5e-13_r8 * (temp(:ncol,k) / 300._r8)**0.6_r8 + kinf_m(:) = (2.1e+09_r8 * (temp(:ncol,k) / 300._r8)**6.1_r8) / m(:,k) + rxt(:,k,usr_oh_co_ndx) = (ko_m(:)/(1._r8+(ko_m(:)/kinf(:)))) * & + 0.6_r8**(1._r8/(1._r8+(log10(ko_m(:)/kinf(:)))**2._r8)) + & + (k0(:)/(1._r8+(k0(:)/kinf_m(:)))) * & + 0.6_r8**(1._r8/(1._r8+(log10(k0(:)/kinf_m(:)))**2._r8)) + endif + !----------------------------------------------------------------------- + ! ... NO2 + H2O --> 0.5 HONO + 0.5 HNO3 + !----------------------------------------------------------------------- + if ( het_no2_h2o_ndx > 0 ) then + rxt(:,k,het_no2_h2o_ndx) = 4.0e-24_r8 + endif + !----------------------------------------------------------------------- + ! ... DMS + OH --> 0.75 SO2 + 0.25 MSA + !----------------------------------------------------------------------- + if ( usr_oh_dms_ndx > 0 ) then + o2(:ncol) = invariants(:ncol,k,inv_o2_ndx) + rxt(:,k,usr_oh_dms_ndx) = 2.000e-10_r8 * exp(5820.0_r8 * tinv(:)) / & + ((2.000e29_r8 / o2(:)) + exp(6280.0_r8 * tinv(:))) + endif + if ( aq_so2_h2o2_ndx > 0 .or. aq_so2_o3_ndx > 0 ) then + lwc(:) = cwat(:ncol,k) * invariants(:ncol,k,inv_m_ndx) * mbar(:ncol,k) /avo !PJC convert kg/kg to g/cm3 + !----------------------------------------------------------------------- + ! ... SO2 + H2O2 --> S(VI) + !----------------------------------------------------------------------- + if ( aq_so2_h2o2_ndx > 0 ) then + rxt(:,k,aq_so2_h2o2_ndx) = lwc(:) * 1.0e-03_r8 * avo * & + K_AQ * & + + exp(ER_AQ * ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + HENRY298_SO2 * & + K298_SO2_HSO3 * & + HENRY298_H2O2 * & + exp(((H298_SO2 + H298_SO2_HSO3 + H298_H2O2) / R_CAL) * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + (R_CONC * temp(:ncol,k))**2.0e+00_r8 / & + + (1.0e+00_r8 + 13.0e+00_r8 * 10.0e+00_r8**(-pH)) + endif + !----------------------------------------------------------------------- + ! ... SO2 + O3 --> S(VI) + !----------------------------------------------------------------------- + if (aq_so2_o3_ndx >0) then + rxt(:,k,aq_so2_o3_ndx) = lwc(:) * 1.0e-03_r8 * avo * & + HENRY298_SO2 * exp((H298_SO2 / R_CAL) * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + (K0_AQ * exp(ER0_AQ * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) + & + K298_SO2_HSO3 * exp((H298_SO2_HSO3 / R_CAL) * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + (K1_AQ * exp(ER1_AQ * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) / & + 10.0e+00_r8**(-pH) + K2_AQ * exp(ER2_AQ * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + K298_HSO3_SO3 * exp((H298_HSO3_SO3 / R_CAL) * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) / & + (10.0e+00_r8**(-pH))**2.0e+00_r8) ) * & + HENRY298_O3 * exp((H298_O3 / R_CAL) * & + ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * & + (R_CONC * temp(:ncol,k))**2.0e+00_r8 + endif + endif + + if ( has_d_chem ) then + + call comp_exp( exp_fac, -600._r8 * tinv, ncol ) + rxt(:,k,ean_ndx(1)) = 1.e-31_r8 * tp(:) * exp_fac(:) + rxt(:,k,ean_ndx(2)) = 9.1e-12_r8 * tp(:)**(-1.46_r8) + call comp_exp( exp_fac, -193._r8 * tinv, ncol ) + rxt(:,k,ean_ndx(3)) = (4.e-30_r8 * exp_fac(:)) * 0.21_r8 + + rxt(:,k,rpe_ndx(1)) = 4.2e-6_r8 * tp(:)**0.5_r8 + rxt(:,k,rpe_ndx(2)) = 6.3e-7_r8 * tp(:)**0.5_r8 + rxt(:,k,rpe_ndx(3)) = 2.5e-6_r8 * tp(:)**0.1_r8 + rxt(:,k,rpe_ndx(4)) = 2.48e-6_r8 * tp(:)**0.76_r8 + rxt(:,k,rpe_ndx(5)) = 1.4e-6_r8 * tp(:)**0.4_r8 + + rxt(:,k,pir_ndx(1)) = 4.e-30_r8 * tp(:)**2.93_r8 + rxt(:,k,pir_ndx(2)) = 4.6e-27_r8 * tp(:)**4._r8 + + call comp_exp( exp_fac, -15900._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(3)) = (2.5e-2_r8 * tp(:)**5._r8) * exp_fac(:) + rxt(:,k,pir_ndx(4)) = 2.3e-27_r8 * tp(:)**7.5_r8 + + call comp_exp( exp_fac, -10272._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(5)) = (2.6e-3_r8 * tp(:)**8.5_r8) * exp_fac(:) + rxt(:,k,pir_ndx(6)) = 3.6e-27_r8 * tp(:)**8.1_r8 + + call comp_exp( exp_fac, -9000._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(7)) = (1.5e-1_r8 * tp(:)**9.1_r8) * exp_fac(:) + rxt(:,k,pir_ndx(8)) = 4.6e-28_r8 * tp(:)**14._r8 + + call comp_exp( exp_fac, -6400._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(9)) = (1.7e-3_r8 * tp(:)**15._r8) * exp_fac(:) + rxt(:,k,pir_ndx(10)) = 1.35e-28_r8 * tp(:)**2.83_r8 + + rxt(:,k,pir_ndx(11)) = 1.e-27_r8 * (308._r8 * tinv(:))**4.7_r8 + rxt(:,k,pir_ndx(12)) = rxt(:,k,pir_ndx(11)) + rxt(:,k,pir_ndx(13)) = 1.4e-29_r8 * tp(:)**4._r8 + + call comp_exp( exp_fac, -3872._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(14)) = (3.4e-7_r8 * tp(:)**5._r8) * exp_fac(:) + + rxt(:,k,pir_ndx(15)) = 3.0e-31_r8 * tp(:)**4.3_r8 + call comp_exp( exp_fac, -2093._r8 * tinv, ncol ) + rxt(:,k,pir_ndx(16)) = (1.5e-8_r8 * tp(:)**4.3_r8) * exp_fac(:) + + rxt(:,k,edn_ndx(1)) = 3.1e-10_r8 * tp(:)**0.83_r8 + call comp_exp( exp_fac, -4990._r8 * tinv, ncol ) + rxt(:,k,edn_ndx(2)) = (1.9e-12_r8 * tp(:)**(-1.5_r8)) * exp_fac(:) + + rxt(:,k,nir_ndx(1)) = 1.05e-12_r8 * tp(:)**2.15_r8 + rxt(:,k,nir_ndx(2)) = 2.5e-11_r8 * tp(:)**0.79_r8 + rxt(:,k,nir_ndx(3)) = 7.5e-11_r8 * tp(:)**0.79_r8 + rxt(:,k,nir_ndx(4)) = rxt(:,k,nir_ndx(1)) + rxt(:,k,nir_ndx(5)) = 1.3e-11_r8 * tp(:)**1.64_r8 + rxt(:,k,nir_ndx(6)) = 3.3e-11_r8 * tp(:)**2.38_r8 + + call comp_exp( exp_fac, -7300_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(7)) = (1.0e-3_r8 * tp(:)) * exp_fac(:) + call comp_exp( exp_fac, -7050_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(8)) = (7.2e-4_r8 * tp(:)) * exp_fac(:) + call comp_exp( exp_fac, -6800_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(9)) = (6.5e-3_r8 * tp(:)) * exp_fac(:) + call comp_exp( exp_fac, -7600_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(10)) = (5.7e-4_r8 * tp(:)) * exp_fac(:) + + call comp_exp( exp_fac, -7150_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(11)) = (1.5e-2_r8 * tp(:)) * exp_fac(:) + + call comp_exp( exp_fac, -13130_r8 * tinv, ncol ) + rxt(:,k,nir_ndx(12)) = (6.0e-3_r8 * tp(:)) * exp_fac(:) + rxt(:,k,nir_ndx(13)) = 5.22e-28_r8 * tp(:)**2.62_r8 + + rxt(:,k,iira_ndx(1)) = 6.0e-8_r8 * tp(:)**.5_r8 + do i = 2,niira + rxt(:,k,iira_ndx(i)) = rxt(:,k,iira_ndx(i-1)) + enddo + + rxt(:,k,iirb_ndx(1)) = 1.25e-25_r8 * tp(:)**4._r8 + do i = 2,niirb + rxt(:,k,iirb_ndx(i)) = rxt(:,k,iirb_ndx(i-1)) + enddo + + call comp_exp( exp_fac, -6600._r8 * tinv, ncol ) + rxt(:,k,usr_clm_h2o_m_ndx) = 2.e-8_r8 * exp_fac(:) + + call comp_exp( exp_fac, -11926._r8 * tinv, ncol ) + rxt(:,k,usr_clm_hcl_m_ndx) = tinv(:) * exp_fac(:) + + endif + end do level_loop + +!----------------------------------------------------------------- +! ... the ionic rates +!----------------------------------------------------------------- + if ( has_ion_rxts ) then + level_loop2 : do k = 1,pver + tp(:ncol) = (2._r8*tempi(:ncol,k) + temp(:ncol,k)) / ( 3._r8 * t0 ) + tp(:) = max( min( tp(:),20._r8 ),1._r8 ) + rxt(:,k,ion1_ndx) = 2.82e-11_r8 + tp(:)*(-7.74e-12_r8 + tp(:)*(1.073e-12_r8 & + + tp(:)*(-5.17e-14_r8 + 9.65e-16_r8*tp(:)))) + tp(:ncol) = (.6363_r8*tempi(:ncol,k) + .3637_r8*temp(:ncol,k)) / t0 + tp(:) = max( min( tp(:),trlim2 ),1._r8 ) + rxt(:,k,ion2_ndx) = 1.533e-12_r8 + tp(:)*(-5.92e-13_r8 + tp(:)*8.6e-14_r8) + tp(:ncol) = 2._r8 * t0 /(tempi(:ncol,k) + temp(:ncol,k)) + where( tp(:ncol) < trlim3 ) + rxt(:,k,ion3_ndx) = 1.4e-10_r8 * tp(:)**.44_r8 + rxt(:,k,ion11_ndx) = 1.e-11_r8 * tp(:)**.23_r8 + elsewhere + rxt(:,k,ion3_ndx) = 5.2e-11_r8 / tp(:)**.2_r8 + rxt(:,k,ion11_ndx) = 3.6e-12_r8 / tp(:)**.41_r8 + end where + tp(:ncol) = t0 / tempe(:ncol,k) + rxt(:,k,elec1_ndx) = 4.e-7_r8 * tp(:)**.85_r8 + rxt(:,k,elec3_ndx) = 1.8e-7_r8 * tp(:)**.39_r8 + where( tp(:ncol) < 4._r8 ) + rxt(:,k,elec2_ndx) = 2.7e-7_r8 * tp(:)**.7_r8 + elsewhere + rxt(:,k,elec2_ndx) = 1.6e-7_r8 * tp(:)**.55_r8 + end where + end do level_loop2 + endif + + ! quenching of O+(2P) and O+(2D) by e to produce O+ + ! See TABLE 1 of Roble (1995) + ! drm 2015-07-27 + if (elec4_ndx > 0 .and. elec5_ndx > 0 .and. elec6_ndx > 0) then + do k=1,pver + tp(:ncol) = sqrt(300._r8 / tempe(:ncol,k)) + rxt(:,k,elec4_ndx) = 1.5e-7_r8 * tp(:) + rxt(:,k,elec5_ndx) = 4.0e-8_r8 * tp(:) + rxt(:,k,elec6_ndx) = 6.6e-8_r8 * tp(:) + end do + endif + +!----------------------------------------------------------------- +! ... tropospheric "aerosol" rate constants +!----------------------------------------------------------------- + if ( het1_ndx > 0 .AND. (.NOT. usr_N2O5_aer_ndx > 0) ) then + amas = 4._r8*pi*rm1**3*den/3._r8 ! each mean particle(r=0.1u) mass (g) + do k = 1,pver +!------------------------------------------------------------------------- +! ... estimate humidity effect on aerosols (from Shettle and Fenn, 1979) +! xr is a factor of the increase aerosol radii with hum (hum=0., factor=1) +!------------------------------------------------------------------------- + xr(:) = .999151_r8 + relhum(:ncol,k)*(1.90445_r8 + relhum(:ncol,k)*(-6.35204_r8 + relhum(:ncol,k)*5.32061_r8)) +!------------------------------------------------------------------------- +! ... estimate sulfate particles surface area (cm2/cm3) in each grid +!------------------------------------------------------------------------- + if ( carma_hetchem_feedback ) then + sur(:ncol) = strato_sad(:ncol,k) + else + sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3 + / amas & ! xform g/cm3 to num particels/cm3 + * fare & ! xform num particels/cm3 to cm2/cm3 + * xr(:)*xr(:) ! humidity factor + endif +!----------------------------------------------------------------- +! ... compute the "aerosol" reaction rates +!----------------------------------------------------------------- +! k = gam * A * velo/4 +! +! where velo = sqrt[ 8*bk*T/pi/(w/av) ] +! bk = 1.381e-16 +! av = 6.02e23 +! w = 108 (n2o5) HO2(33) CH2O (30) NH3(15) +! +! so that velo = 1.40e3*sqrt(T) (n2o5) gama=0.1 +! so that velo = 2.53e3*sqrt(T) (HO2) gama>0.2 +! so that velo = 2.65e3*sqrt(T) (CH2O) gama>0.022 +! so that velo = 3.75e3*sqrt(T) (NH3) gama=0.4 +!-------------------------------------------------------- +!----------------------------------------------------------------- +! ... use this n2o5 -> 2*hno3 only in tropopause +!----------------------------------------------------------------- + rxt(:,k,het1_ndx) = rxt(:,k,het1_ndx) & + +.25_r8 * gam1 * sur(:) * 1.40e3_r8 * sqrt( temp(:ncol,k) ) + end do + end if + +!lke++ +!----------------------------------------------------------------- +! ... CO tags +!----------------------------------------------------------------- + if( usr_CO_OH_b_ndx > 0 ) then + if( usr_COhc_OH_ndx > 0 ) then + rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_COme_OH_ndx > 0 ) then + rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO01_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO02_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO03_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO04_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO05_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO06_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO07_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO08_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO09_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO10_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO11_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO12_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO13_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO14_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO15_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO16_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO17_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO18_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO19_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO20_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO21_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO22_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO23_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO24_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO25_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO26_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO27_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO28_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO29_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO30_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO31_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO32_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO33_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO34_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO35_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO36_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO37_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO38_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO39_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO40_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO41_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + if( usr_CO42_OH_ndx > 0 ) then + rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + end if + end if +!lke-- +! +! jfl : additional BAM removal reactions. Zero out below the tropopause +! + do l=1,num_strat_tau +! + if ( usr_strat_tau_ndx(l) > 0 ) then + do i=1,ncol + rxt(i,tropchemlev(i)+1:pver,usr_strat_tau_ndx(l)) = 0._r8 + end do + end if +! + end do +! + + deallocate( sfc_array, dm_array ) + + end subroutine usrrxt + + subroutine usrrxt_hrates( rxt, tempn, tempi, tempe, & + h2ovmr, m, ncol, kbot ) +!----------------------------------------------------------------- +! ... set the user specified reaction rates for heating +!----------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use ppgrid, only : pver, pcols + + implicit none + +!----------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------- + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: kbot ! heating levels + real(r8), intent(in) :: tempn(pcols,pver) ! neutral temperature (K) + real(r8), intent(in) :: tempi(pcols,pver) ! ion temperature (K) + real(r8), intent(in) :: tempe(pcols,pver) ! electron temperature (K) + real(r8), intent(in) :: m(ncol,pver) ! total atm density (1/cm^3) + real(r8), intent(in) :: h2ovmr(ncol,pver) ! water vapor (vmr) + real(r8), intent(inout) :: rxt(ncol,pver,rxntot) ! gas phase rates + +!----------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------- + + integer :: k + real(r8), dimension(ncol) :: & + tp, & + tinv, & + ko, & + kinf, & + fc + +!----------------------------------------------------------------- +! ... o + o2 + m --> o3 + m +!----------------------------------------------------------------- + do k = 1,kbot + tinv(:ncol) = 1._r8 / tempn(:ncol,k) + tp(:) = 300._r8 * tinv(:) + rxt(:,k,usr_O_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8 + +!----------------------------------------------------------------- +! ... o + o + m -> o2 + m +!----------------------------------------------------------------- + rxt(:,k,usr_O_O_ndx) = 2.76e-34_r8 * exp( 720.0_r8*tinv(:) ) + +!----------------------------------------------------------------- +! ... ho2 + ho2 --> h2o2 +! Note: this rate involves the water vapor number density +!----------------------------------------------------------------- + ko(:) = 3.0e-13_r8 * exp( 460._r8*tinv(:) ) + kinf(:) = 2.1e-33_r8 * m(:,k) * exp( 920._r8*tinv(:) ) + fc(:) = 1._r8 + 1.4e-21_r8 * m(:,k) * h2ovmr(:,k) * exp( 2200._r8*tinv(:) ) + rxt(:,k,usr_HO2_HO2_ndx) = (ko(:) + kinf(:)) * fc(:) + + end do + +!----------------------------------------------------------------- +! ... the ionic rates +!----------------------------------------------------------------- + if ( has_ion_rxts ) then + level_loop2 : do k = 1,kbot + tp(:ncol) = (2._r8*tempi(:ncol,k) + tempn(:ncol,k)) / ( 3._r8 * t0 ) + tp(:) = max( min( tp(:),20._r8 ),1._r8 ) + rxt(:,k,ion1_ndx) = 2.82e-11_r8 + tp(:)*(-7.74e-12_r8 + tp(:)*(1.073e-12_r8 & + + tp(:)*(-5.17e-14_r8 + 9.65e-16_r8*tp(:)))) + tp(:ncol) = (.6363_r8*tempi(:ncol,k) + .3637_r8*tempn(:ncol,k)) / t0 + tp(:) = max( min( tp(:),trlim2 ),1._r8 ) + rxt(:,k,ion2_ndx) = 1.533e-12_r8 + tp(:)*(-5.92e-13_r8 + tp(:)*8.6e-14_r8) + tp(:ncol) = 2._r8 * t0 /(tempi(:ncol,k) + tempn(:ncol,k)) + where( tp(:ncol) < trlim3 ) + rxt(:,k,ion3_ndx) = 1.4e-10_r8 * tp(:)**.44_r8 + elsewhere + rxt(:,k,ion3_ndx) = 5.2e-11_r8 / tp(:)**.2_r8 + endwhere + tp(:ncol) = t0 / tempe(:ncol,k) + rxt(:,k,elec1_ndx) = 4.e-7_r8 * tp(:)**.85_r8 + rxt(:,k,elec3_ndx) = 1.8e-7_r8 * tp(:)**.39_r8 + where( tp(:ncol) < 4._r8 ) + rxt(:,k,elec2_ndx) = 2.7e-7_r8 * tp(:)**.7_r8 + elsewhere + rxt(:,k,elec2_ndx) = 1.6e-7_r8 * tp(:)**.55_r8 + endwhere + end do level_loop2 + endif + end subroutine usrrxt_hrates + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + subroutine comp_exp( x, y, n ) + + implicit none + + real(r8), intent(out) :: x(:) + real(r8), intent(in) :: y(:) + integer, intent(in) :: n + +#ifdef IBM + call vexp( x, y, n ) +#else + x(:n) = exp( y(:n) ) +#endif + + end subroutine comp_exp + + !------------------------------------------------------------------------- + ! Heterogeneous reaction rates for uptake of a gas on an aerosol: + !------------------------------------------------------------------------- + function hetrxtrate( sfc, dm_aer, dg_gas, c_gas, gamma_gas ) result(rate) + + real(r8), intent(in) :: sfc(:) + real(r8), intent(in) :: dm_aer(:) + real(r8), intent(in) :: dg_gas + real(r8), intent(in) :: c_gas + real(r8), intent(in) :: gamma_gas + real(r8) :: rate + + real(r8),allocatable :: rxt(:) + integer :: n, i + + n = size(sfc) + + allocate(rxt(n)) + do i=1,n + rxt(i) = sfc(i) / (0.5_r8*dm_aer(i)/dg_gas + (4._r8/(c_gas*gamma_gas))) + enddo + + rate = sum(rxt) + + deallocate(rxt) + + endfunction hetrxtrate + + !------------------------------------------------------------------------- + ! Heterogeneous reaction rates for uptake of a glyoxal gas on an aerosol: + !------------------------------------------------------------------------- + function hetrxtrate_gly( sfc, c_gas, gamma_gas ) result(rate) + + real(r8), intent(in) :: sfc(:) + real(r8), intent(in) :: c_gas + real(r8), intent(in) :: gamma_gas + real(r8) :: rate + + real(r8),allocatable :: rxt(:) + integer :: n, i + + n = size(sfc) + + allocate(rxt(n)) + do i=1,n + rxt(i) = 0.25_r8 * c_gas * sfc(i) * gamma_gas + enddo + + rate = sum(rxt) + + deallocate(rxt) + + endfunction hetrxtrate_gly + + +end module mo_usrrxt diff --git a/src/chemistry/mozart/mo_waccm_hrates.F90 b/src/chemistry/mozart/mo_waccm_hrates.F90 new file mode 100644 index 0000000000..66ecc6e5ef --- /dev/null +++ b/src/chemistry/mozart/mo_waccm_hrates.F90 @@ -0,0 +1,462 @@ + + module mo_waccm_hrates + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use physics_buffer, only : pbuf_get_index, pbuf_get_field + + implicit none + + save + + real(r8), parameter :: secpday = 86400._r8 + real(r8), parameter :: daypsec = 1._r8/secpday + real(r8), parameter :: aur_therm = 807._r8 + real(r8), parameter :: jkcal = 4184._r8 + real(r8), parameter :: aur_heat_eff = .05_r8 + real(r8), parameter :: aur_hconst = 1.e3_r8*jkcal*aur_therm*aur_heat_eff + + real(r8) :: max_zen_angle + + private + public :: waccm_hrates, init_hrates, has_hrates + + integer :: id_co2, id_o2, id_o3, id_o2_1d, id_o2_1s, id_o1d, id_h2o, id_o, id_h + logical :: has_hrates + integer :: ele_temp_ndx, ion_temp_ndx + + contains + + subroutine init_hrates( ) + use mo_chem_utls, only : get_spc_ndx + use cam_history, only : addfld + use ref_pres, only : ptop_ref, psurf_ref + + + implicit none + + integer :: ids(9), err + character(len=128) :: attr ! netcdf variable attribute + + id_co2 = get_spc_ndx( 'CO2' ) + id_o2 = get_spc_ndx( 'O2' ) + id_o3 = get_spc_ndx( 'O3' ) + id_o2_1d = get_spc_ndx( 'O2_1D' ) + id_o2_1s = get_spc_ndx( 'O2_1S' ) + id_o1d = get_spc_ndx( 'O1D' ) + id_h2o = get_spc_ndx( 'H2O' ) + id_o = get_spc_ndx( 'O' ) + id_h = get_spc_ndx( 'H' ) + + ids = (/ id_co2, id_o2, id_o3, id_o2_1d, id_o2_1s, id_o1d, id_h2o, id_o, id_h /) + + has_hrates = all( ids(:) > 0 ) .and. ptop_ref < 0.0004_r8 * psurf_ref + + if (.not. has_hrates) return + + call addfld( 'CPAIR', (/ 'lev' /), 'I', 'J/K/kg', 'specific heat cap air' ) + call addfld( 'QRS_AUR', (/ 'lev' /), 'I', 'K/s', 'total auroral heating rate' ) + call addfld( 'QRS_CO2NIR', (/ 'lev' /), 'I', 'K/s', 'co2 nir heating rate' ) + call addfld( 'QTHERMAL', (/ 'lev' /), 'I', 'K/s', 'non-euv photolysis heating rate' ) + call addfld( 'QRS_MLT', (/ 'lev' /), 'I', 'K/s', 'Total heating rate (unmerged with tropospheric RT heating)' ) + + attr = 'O2 + hv -> O1D + O3P solar heating rate < 200nm' + call addfld( 'QRS_SO2A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O2 + hv -> O3P + O3P solar heating rate < 200nm' + call addfld( 'QRS_SO2B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O3 + hv -> O1D + O2_1S solar heating rate < 200nm' + call addfld( 'QRS_SO3A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O3 + hv -> O3P + O2 solar heating rate < 200nm' + call addfld( 'QRS_SO3B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O2 + hv -> 2*O3P solar heating rate > 200nm' + call addfld( 'QRS_LO2B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O3 + hv -> O1D + O2_1S solar heating rate > 200nm' + call addfld( 'QRS_LO3A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'O3 + hv -> O3P + O2 solar heating rate > 200nm' + call addfld( 'QRS_LO3B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'Total O3 solar heating > 200nm' + call addfld( 'QRS_LO3', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'total euv heating rate' + call addfld( 'QRS_EUV', (/ 'lev' /), 'I', 'K/s', trim(attr) ) + attr = 'total jo2 euv photolysis rate' + call addfld( 'JO2_EUV', (/ 'lev' /), 'I', '/s', trim(attr) ) + + ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index + ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index + + end subroutine init_hrates + + subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf ) +!----------------------------------------------------------------------- +! ... computes the short wavelength heating rates +!----------------------------------------------------------------------- + + use chem_mods, only : nabscol, nfs, gas_pcnst, rxntot, indexm + use ppgrid, only : pcols, pver + use physconst, only : rga, mbarv, cpairv + use constituents, only : pcnst + use mo_gas_phase_chemdr,only: map2chm + use mo_photo, only : set_ub_col, setcol + use mo_jlong, only : jlong + use mo_jshort, only : jshort + use mo_jeuv, only : heuv + use mo_cph, only : cph + use mo_heatnirco2, only : heatnirco2 + use mo_airglow, only : airglow + use mo_aurora, only : aurora + use mo_setrxt, only : setrxt_hrates + use mo_adjrxt, only : adjrxt + use mo_usrrxt, only : usrrxt_hrates + use mo_setinv, only : setinv + use mo_mass_xforms, only : mmr2vmr + use physics_types, only : physics_state + use phys_grid, only : get_rlat_all_p, get_rlon_all_p, & + get_lat_all_p, get_lon_all_p + use mo_mean_mass, only : set_mean_mass + use set_cp, only : calc_cp + use cam_history, only : outfld + use shr_orb_mod, only : shr_orb_decl + use time_manager, only : get_curr_calday + use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr + use mo_constants, only : r2d + use short_lived_species,only: get_short_lived_species + use physics_buffer, only : physics_buffer_desc + use phys_control, only : waccmx_is + use orbit, only : zenith + use time_manager, only : is_first_step + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! number columns in chunk + type(physics_state),target, intent(in) :: state ! physics state structure + real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo + integer, intent(in) :: bot_mlt_lev ! lowest model level where MLT heating is needed + real(r8), intent(out) :: qrs_tot(pcols,pver) ! total heating (K/s) + type(physics_buffer_desc), pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: lchnk ! chunk index + real(r8), parameter :: m2km = 1.e-3_r8 + real(r8), parameter :: Pa2mb = 1.e-2_r8 + + integer :: i, k, m, n + integer :: kbot_hrates + real(r8) :: esfact + real(r8) :: sza ! solar zenith angle (degrees) + integer :: latndx(pcols) ! chunk lat indicies + integer :: lonndx(pcols) ! chunk lon indicies + real(r8) :: invariants(ncol,pver,nfs) + real(r8) :: col_dens(ncol,pver,max(1,nabscol)) ! column densities (molecules/cm^2) + real(r8) :: col_delta(ncol,0:pver,max(1,nabscol)) ! layer column densities (molecules/cm^2) + real(r8) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) + real(r8) :: reaction_rates(ncol,pver,rxntot) ! reaction rates + real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) + real(r8) :: h2ovmr(ncol,pver) ! water vapor concentration (mol/mol) + real(r8) :: mbar(ncol,pver) ! mean wet atmospheric mass (kg/mole) + real(r8) :: zmid(ncol,pver) ! midpoint geopotential (km) + real(r8) :: cpair(ncol,pver) ! specific heat capacity (J/K/kg) + real(r8) :: cphrate(ncol,pver) ! chemical pot heat rate (K/s) + real(r8) :: aghrate(ncol,pver) ! airglow heat rate (K/s) + real(r8) :: qrs_col(pver,4) ! column thermal heating < 200nm + real(r8) :: qrl_col(pver,4) ! column thermal heating > 200nm + real(r8) :: qrs(ncol,pver,4) ! chunk thermal heating < 200nm + real(r8) :: qrl(ncol,pver,4) ! chunk thermal heating > 200nm + real(r8) :: euv_hrate_col(pver) ! column euv thermal heating rate + real(r8) :: co2_hrate_col(pver) ! column co2 nir heating rate + real(r8) :: euv_hrate(ncol,pver) ! chunk euv thermal heating rate + real(r8) :: aur_hrate(ncol,pver) ! chunk auroral heating rate + real(r8) :: co2_hrate(ncol,pver) ! chunk co2 nir heating rate + real(r8) :: colo3(pver) ! vertical o3 column density + real(r8) :: zarg(pver) ! vertical height array + real(r8) :: parg(pver) ! vertical pressure array (hPa) + real(r8) :: tline(pver) ! vertical temperature array + real(r8) :: eff_alb(pver) ! albedo + real(r8) :: mw(pver) ! atms molecular weight + real(r8) :: n2_line(pver) ! n2 density (mol/mol) + real(r8) :: o_line(pver) ! o density (mol/mol) + real(r8) :: o2_line(pver) ! o2 density (mol/mol) + real(r8) :: o3_line(pver) ! o3 density (mol/mol) + real(r8) :: co2_line(pver) ! co2 density (mol/mol) + real(r8) :: scco2(pver) ! co2 slant column concentration (molec/cm^2) + real(r8) :: scco2i(pver) ! co2 slant column concentration (molec/cm^2) + real(r8) :: occ(pver) ! o density (molecules/cm^3) + real(r8) :: o2cc(pver) ! o2 density (molecules/cm^3) + real(r8) :: co2cc(pver) ! co2 density (molecules/cm^3) + real(r8) :: n2cc(pver) ! n2 density (molecules/cm^3) + real(r8) :: o3cc(pver) ! o3 density (molecules/cm^3) + real(r8) :: cparg(pver) ! specific heat capacity + real(r8) :: zen_angle(ncol) ! solar zenith angles (radians) + real(r8) :: zsurf(ncol) ! surface height (m) + real(r8) :: rlats(ncol) ! chunk latitudes (radians) + real(r8) :: rlons(ncol) ! chunk longitudes (radians) + real(r8) :: calday ! day of year + real(r8) :: delta ! solar declination (radians) + logical :: do_diag + + real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer + real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer + + if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 .and. .not.is_first_step()) then + call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) + call pbuf_get_field(pbuf, ion_temp_ndx, ion_temp_fld) + else + ele_temp_fld => state%t + ion_temp_fld => state%t + endif + + qrs_tot(:ncol,:) = 0._r8 + if (.not. has_hrates) return + +!------------------------------------------------------------------------- +! ... set maximum zenith angle - higher value for higher top model +!------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + max_zen_angle = 116._r8 + else + max_zen_angle = 97.01_r8 ! degrees + endif + +!----------------------------------------------------------------------- +! ... get chunk latitudes and longitudes +!----------------------------------------------------------------------- + lchnk = state%lchnk + + call get_lat_all_p( lchnk, ncol, latndx ) + call get_lon_all_p( lchnk, ncol, lonndx ) + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + +!----------------------------------------------------------------------- +! ... set lower limit for heating rates which is now dictated by radheat module +!----------------------------------------------------------------------- + kbot_hrates = bot_mlt_lev + kbot_hrates = min( kbot_hrates,pver ) +! write(iulog,*) 'hrates: kbot_hrates = ',kbot_hrates + +!----------------------------------------------------------------------- +! ... calculate cosine of zenith angle then cast back to angle +!----------------------------------------------------------------------- + calday = get_curr_calday() + call zenith( calday, rlats, rlons, zen_angle, ncol ) + zen_angle(:) = acos( zen_angle(:) ) + +!----------------------------------------------------------------------- +! ... map incoming concentrations to working array +!----------------------------------------------------------------------- + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + do k = 1,pver + mmr(:ncol,k,n) = state%q(:ncol,k,m) + end do + end if + end do + call get_short_lived_species( mmr, lchnk, ncol, pbuf ) + +!----------------------------------------------------------------------- +! ... set atmosphere mean mass +!----------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + do k = 1,pver + mbar(:ncol,k) = mbarv(:ncol,k,lchnk) + enddo + else + call set_mean_mass( ncol, mmr, mbar ) + endif +! +!----------------------------------------------------------------------- +! ... xform from mmr to vmr +!----------------------------------------------------------------------- + call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) +!----------------------------------------------------------------------- +! ... xform water vapor from mmr to vmr +!----------------------------------------------------------------------- + do k = 1,pver + h2ovmr(:ncol,k) = vmr(:ncol,k,id_h2o) + end do +!----------------------------------------------------------------------- +! ... xform geopotential height from m to km +! and pressure from Pa to mb +!----------------------------------------------------------------------- + zsurf(:ncol) = rga * state%phis(:ncol) + do k = 1,pver + zmid(:ncol,k) = m2km * (state%zm(:ncol,k) + zsurf(:ncol)) + end do + +!----------------------------------------------------------------------- +! ... set the "invariants" +!----------------------------------------------------------------------- + call setinv( invariants, state%t, h2ovmr, vmr, state%pmid, ncol, lchnk, pbuf ) + +!----------------------------------------------------------------------- +! ... set the column densities at the upper boundary +!----------------------------------------------------------------------- + call set_ub_col( col_delta, vmr, invariants, state%pint(:,1), state%pdel, ncol, lchnk ) + +!----------------------------------------------------------------------- +! ... set rates for "tabular" and user specified reactions +!----------------------------------------------------------------------- + do m = 1,rxntot + do k = 1,pver + reaction_rates(:,k,m) = 0._r8 + end do + end do + call setrxt_hrates( reaction_rates, state%t, invariants(1,1,indexm), ncol, kbot_hrates ) + call usrrxt_hrates( reaction_rates, state%t, ele_temp_fld, ion_temp_fld, & + h2ovmr, invariants(:,:,indexm), ncol, kbot_hrates ) + call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver ) + +!----------------------------------------------------------------------- +! ... set cp array +!----------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + do k = 1, pver + cpair(:ncol,k) = cpairv(:ncol,k,lchnk) + enddo + else + call calc_cp( ncol, vmr, cpair ) + endif + + call outfld( 'CPAIR', cpair, ncol, lchnk ) +#ifdef HRATES_DEBUG + write(iulog,*) ' ' + write(iulog,*) '---------------------------------------------' + write(iulog,*) 'waccm_hrates: cp at lchnk = ',lchnk + write(iulog,'(1p,5g15.7)') cpair(1,:) + write(iulog,*) '---------------------------------------------' + write(iulog,*) ' ' +#endif + +!----------------------------------------------------------------------- +! ... set the earth-sun distance factor +!----------------------------------------------------------------------- + call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & + delta, esfact ) +!----------------------------------------------------------------------- +! ... set the column densities +!----------------------------------------------------------------------- + call setcol( col_delta, col_dens, vmr, state%pdel, ncol ) +!----------------------------------------------------------------------- +! ... compute the thermal heating rates +!----------------------------------------------------------------------- + do m = 1,4 + do k = 1,pver + qrs(:,k,m) = 0._r8 + qrl(:,k,m) = 0._r8 + end do + end do + do k = 1,pver + euv_hrate(:,k) = 0._r8 + co2_hrate(:,k) = 0._r8 + end do +column_loop : & + do i = 1,ncol + sza = zen_angle(i)*r2d + if( sza < max_zen_angle ) then + zarg(:) = zmid(i,:) + parg(:) = Pa2mb*state%pmid(i,:) + colo3(:) = col_dens(i,:,1) + tline(:) = state%t(i,:) + eff_alb(:) = asdir(i) + o_line(:) = vmr(i,:,id_o) + o2_line(:) = vmr(i,:,id_o2) + co2_line(:) = vmr(i,:,id_co2) + n2_line(:) = 1._r8 - (o_line(:) + o2_line(:) + vmr(i,:,id_h)) + o3_line(:) = vmr(i,:,id_o3) + occ(:) = o_line(:) * invariants(i,:,indexm) + o2cc(:) = o2_line(:) * invariants(i,:,indexm) + co2cc(:) = co2_line(:) * invariants(i,:,indexm) + n2cc(:) = n2_line(:) * invariants(i,:,indexm) + o3cc(:) = o3_line(:) * invariants(i,:,indexm) + mw(:) = mbar(i,:) + cparg(:) = cpair(i,:) + do_diag = .false. + call jshort( pver, sza, o2_line, o3_line, o2cc, & + o3cc, tline, zarg, mw, qrs_col, & + cparg, lchnk, i, co2cc, scco2, do_diag ) + call jlong( pver, sza, eff_alb, parg, tline, & + mw, o2_line, o3_line, colo3, qrl_col, & + cparg, kbot_hrates ) + do m = 1,4 + qrs(i,pver:1:-1,m) = qrs_col(:,m) * esfact + end do + do m = 2,4 + qrl(i,:,m) = qrl_col(:,m) * esfact + end do + call heuv( pver, sza, occ, o2cc, n2cc, & + o_line, o2_line, n2_line, cparg, mw, & + zarg, euv_hrate_col, kbot_hrates ) + euv_hrate(i,:) = euv_hrate_col(:) * esfact + scco2i(1:pver) = scco2(pver:1:-1) + call heatnirco2( co2_line, scco2i, state%pmid(i,:kbot_hrates), co2_hrate_col, kbot_hrates, & + zarg, sza ) +#ifdef HRATES_DEBUG + write(iulog,*) '===================================' + write(iulog,*) 'hrates: diagnostics for heatco2nir' + write(iulog,*) 'hrates: co2_line' + write(iulog,'(1p,5g15.7)') co2_line(:) + write(iulog,*) 'hrates: scco2' + write(iulog,'(1p,5g15.7)') scco2i(:) + write(iulog,*) 'hrates: co2_hrate' + write(iulog,'(1p,5g15.7)') co2_hrate_col(:) + write(iulog,*) '===================================' +#endif + co2_hrate(i,:kbot_hrates) = co2_hrate_col(:kbot_hrates) * esfact * daypsec + end if + end do column_loop + + + call outfld( 'QRS_SO2A', qrs(:,:,1), ncol, lchnk ) + call outfld( 'QRS_SO2B', qrs(:,:,2), ncol, lchnk ) + call outfld( 'QRS_SO3A', qrs(:,:,3), ncol, lchnk ) + call outfld( 'QRS_SO3B', qrs(:,:,4), ncol, lchnk ) + call outfld( 'QRS_LO2B', qrl(:,:,2), ncol, lchnk ) + call outfld( 'QRS_LO3A', qrl(:,:,3), ncol, lchnk ) + call outfld( 'QRS_LO3B', qrl(:,:,4), ncol, lchnk ) + call outfld( 'QRS_LO3', qrl(:,:,3)+qrl(:,:,4), ncol, lchnk ) + call outfld( 'QRS_EUV', euv_hrate(:,:), ncol, lchnk ) + call outfld( 'QRS_CO2NIR', co2_hrate(:,:), ncol, lchnk ) + +!----------------------------------------------------------------------- +! ... chemical pot heating rate +!----------------------------------------------------------------------- + call cph( cphrate, vmr, reaction_rates, cpair, mbar, & + kbot_hrates, ncol, lchnk ) + +!----------------------------------------------------------------------- +! ... auroral ion production +!----------------------------------------------------------------------- + call aurora( state%t, mbar, rlats, & + aur_hrate, cpair, state%pmid, lchnk, calday, & + ncol, rlons ) + do k = 1,pver + aur_hrate(:,k) = aur_hrate(:,k)/invariants(:,k,indexm) + end do + call outfld( 'QRS_AUR', aur_hrate(:,:), ncol, lchnk ) + +!----------------------------------------------------------------------- +! ... airglow heating rate +!----------------------------------------------------------------------- + call airglow( aghrate, vmr(1,1,id_o2_1s), vmr(1,1,id_o2_1d), vmr(1,1,id_o1d), reaction_rates, cpair, & + ncol, lchnk ) + +!----------------------------------------------------------------------- +! ... form total heating rate +!----------------------------------------------------------------------- + do k = 1,kbot_hrates + qrs_tot(:ncol,k) = qrs(:,k,1) + qrs(:,k,2) + qrs(:,k,3) + qrs(:,k,4) & + + qrl(:,k,1) + qrl(:,k,2) + qrl(:,k,3) + qrl(:,k,4) + end do + call outfld( 'QTHERMAL', qrs_tot, pcols, lchnk ) + do k = 1,kbot_hrates + qrs_tot(:ncol,k) = qrs_tot(:ncol,k) & + + cphrate(:,k) + euv_hrate(:,k) + aur_hrate(:,k) + co2_hrate(:,k) + end do + call outfld( 'QRS_MLT', qrs_tot, pcols, lchnk ) + + end subroutine waccm_hrates + + end module mo_waccm_hrates diff --git a/src/chemistry/mozart/mo_waveall.F90 b/src/chemistry/mozart/mo_waveall.F90 new file mode 100644 index 0000000000..98b528763d --- /dev/null +++ b/src/chemistry/mozart/mo_waveall.F90 @@ -0,0 +1,18 @@ + + module mo_waveall + + use shr_kind_mod, only : r8 => shr_kind_r8 + use mo_params, only : kw + + implicit none + + real(r8), dimension(kw) :: r01g1, r01g2, r01g3, r01g4, & + r04g, r08g, r06g1, r06g2, & + r10g1, r10g2, r10g3, r10g4, r10g5, & + r11g, r11g1, r11g2, r11g3, r11g4, & + r14g, r14g1, r14g2, & + r15g, r15g1, r15g2, r15g3, & + r17g, r17g1, & + r18g, r18g2 + + end module mo_waveall diff --git a/src/chemistry/mozart/mo_wavelab.F90 b/src/chemistry/mozart/mo_wavelab.F90 new file mode 100644 index 0000000000..6e0a2ac81e --- /dev/null +++ b/src/chemistry/mozart/mo_wavelab.F90 @@ -0,0 +1,11 @@ + + module mo_wavelab + + use mo_params, only : kj + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + real(r8), allocatable :: sj(:,:,:) + + end module mo_wavelab diff --git a/src/chemistry/mozart/mo_wavelen.F90 b/src/chemistry/mozart/mo_wavelen.F90 new file mode 100644 index 0000000000..5c0badc87f --- /dev/null +++ b/src/chemistry/mozart/mo_wavelen.F90 @@ -0,0 +1,15 @@ + + module mo_wavelen + + use mo_params, only : kw + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + integer :: nw + real(r8) :: wl(kw), wc(kw), wu(kw) + real(r8) :: deltaw(kw) + real(r8) :: delw_bin(kw) + real(r8) :: sflx(kw) + + end module mo_wavelen diff --git a/src/chemistry/mozart/mo_waveo3.F90 b/src/chemistry/mozart/mo_waveo3.F90 new file mode 100644 index 0000000000..50174f86bd --- /dev/null +++ b/src/chemistry/mozart/mo_waveo3.F90 @@ -0,0 +1,11 @@ + + module mo_waveo3 + + use mo_params, only : kw + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + real(r8), dimension(kw) :: xso3, s226, s263, s298 + + end module mo_waveo3 diff --git a/src/chemistry/mozart/mo_xsections.F90 b/src/chemistry/mozart/mo_xsections.F90 new file mode 100644 index 0000000000..649f9fe9e3 --- /dev/null +++ b/src/chemistry/mozart/mo_xsections.F90 @@ -0,0 +1,1392 @@ + + module mo_xsections + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: r08_inti, r44_inti + public :: r01, r04, r06, r08, r10, r11 + public :: r14, r15, r17, r18, r44, xs_mvk + + save + + real(r8), allocatable :: a(:) + real(r8), allocatable :: b(:) + real(r8), allocatable :: suma(:) + real(r8), allocatable :: sumb(:) + + contains + + subroutine r01( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide the product of (cross section) x (quantum yield) for the two +! o3 photolysis reactions: +! (a) o3 + hv -> o2 + o(1d) +! (b) o3 + hv -> o2 + o(3p) +! cross section: combined data from wmo 85 ozone assessment (use 273k +! value from 175.439-847.5 nm) and data from molina and +! molina (use in hartley and huggins bans (240.5-350 nm) +! quantum yield: choice between +! (1) data from michelsen et al, 1994 +! (2) jpl 87 recommendation +! (3) jpl 90/92 recommendation (no "tail") +! (4) data from shetter et al., 1996 +! (5) jpl 97 recommendation +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- +! edit history: +! 05/98 original, adapted from former jspec1 subroutine +!----------------------------------------------------------------------------- +! this program is free software; you can redistribute it and/or modify +! it under the terms of the gnu general public license as published by the +! free software foundation; either version 2 of the license, or (at your +! option) any later version. +! the tuv package is distributed in the hope that it will be useful, but +! without any warranty; without even the implied warranty of merchantibi- +! lity or fitness for a particular purpose. see the gnu general public +! license for more details. +! free software foundation, inc., 675 mass ave, cambridge, ma 02139, usa. +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use ppgrid, only : pverp + use mo_waveo3 + use mo_waveall, only : r01g1, r01g2 + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: c0 = 12._r8/19._r8 + real(r8), parameter :: a1 = 0.887_r8 + real(r8), parameter :: a2 = 2.35_r8 + real(r8), parameter :: a3 = 57.0_r8 + real(r8), parameter :: wc1 = 302._r8 + real(r8), parameter :: wc2 = 311.1_r8 + real(r8), parameter :: wc3 = 313.9_r8 + real(r8), parameter :: v2 = 820.0_r8 + real(r8), parameter :: v3 = 1190.0_r8 + real(r8), parameter :: w1 = 7.9_r8 + real(r8), parameter :: w2 = 2.2_r8 + real(r8), parameter :: w3 = 7.4_r8 + real(r8), parameter :: xk = 0.695_r8 + + integer :: i, wn + integer :: myld + real(r8) :: qy1d, qy3p, so3, wrk, tinv + logical :: tl + +!----------------------------------------------------------------------------- +! NEW O3 qy 2002 +! Matsumi et al., 2002 +!----------------------------------------------------------------------------- + integer, parameter :: kmats = 7 + + myld = kmats + +level_loop : & + do i = 1,pverp + tinv = 1._r8/tlev(i) + tl = tlev(i) < 263._r8 + if( tl ) then + wrk = (tlev(i) - 226._r8)/(263._r8 - 226._r8) + else + wrk = (tlev(i) - 263._r8)/(298._r8 - 263._r8) + end if +wave_loop : & + do wn = 1,nw + if( wl(wn) > 240.5_r8 .and. wl(wn+1) < 350._r8 ) then + if( tl ) then + so3 = s226(wn) + (s263(wn) - s226(wn)) * wrk + else + so3 = s263(wn) + (s298(wn) - s263(wn)) * wrk + end if + else + so3 = xso3(wn) + end if +!----------------------------------------------------------------------------- +! ... from jpl97 +!----------------------------------------------------------------------------- + if( wc(wn) < 271._r8 ) then + qy1d = .87_r8 + else if( wc(wn) >= 271._r8 .and. wc(wn) < 290._r8 ) then + qy1d = .87_r8 + (wc(wn) - 271._r8)*c0 + else if( wc(wn) >= 290._r8 .and. wc(wn) < 305._r8 ) then + qy1d = .95_r8 + else if( wc(wn) >= 305._r8 .and. wc(wn) <= 325._r8 ) then + qy1d = r01g1(wn) * exp ( -r01g2(wn)*tinv ) + else + qy1d = 0._r8 + end if +!------------------------------------------------------------------------------- +! ... from jpl2000 +!------------------------------------------------------------------------------- + if( wc(wn) < 300._r8 ) then + qy1d = 0.95_r8 + else if( wc(wn) >= 300._r8 .and. wc(wn) < 331._r8 ) then + qy1d = a1*exp( -((wc(wn) - wc1 )/w1)**4 ) & + + a2*(tlev(i)/300._r8)**4*exp( -v2/xk*tinv ) & + * exp( -((wc(wn) - wc2)/w2)**2 ) & + + a3*exp( -v3/xk*tinv ) * exp( -((wc(wn) - wc3)/w3)**2 ) & + + 0.06_r8 + else if( wc(wn) >= 331._r8 .and. wc(wn) <= 345._r8 ) then + qy1d = 0.06_r8 + else + qy1d = 0._r8 + end if + + if( myld == kmats ) then + qy1d = fo3qy( wc(wn), tlev(i) ) + end if + + if( (trim( jlabel ) == 'jo1d') .or. (trim( jlabel ) == 'j2oh') ) then + xs(wn,i) = qy1d*so3 + else + qy3p = 1._r8 - qy1d + xs(wn,i) = qy3p*so3 + end if + end do wave_loop + end do level_loop + + end subroutine r01 + + function fo3qy( w, t ) +!----------------------------------------------------------------------------- +! PURPOSE: +! function to calculate the quantum yield O3 + hv -> O(1D) + O2, +! according to: +! Matsumi, Y., F. J. Comes, G. Hancock, A. Hofzumanhays, A. J. Hynes, +! M. Kawasaki, and A. R. Ravishankara, QUantum yields for production of O(1D) +! in the ultraviolet photolysis of ozone: Recommendation based on evaluation +! of laboratory data, J. Geophys. Res., 107, 10.1029/2001JD000510, 2002. +!----------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: w + real(r8), intent(in) :: t + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8) :: kt + real(r8) :: q1 + real(r8) :: q2 + real(r8) :: a(3) = (/ 0.8036_r8, 8.9061_r8, 0.1192_r8 /) + real(r8) :: x(3) = (/ 304.225_r8, 314.957_r8, 310.737_r8 /) + real(r8) :: om(3) = (/ 5.576_r8, 6.601_r8, 2.187_r8 /) + +!----------------------------------------------------------------------------- +! ... function declarations +!----------------------------------------------------------------------------- + real(r8) :: fo3qy + + fo3qy = 0._r8 + kt = 0.695_r8 * t + q1 = 1._r8 + q2 = exp( -825.518_r8/kt ) + + if( w <= 305._r8 ) then + fo3qy = .90_r8 + else if( w > 305._r8 .and. w <= 328._r8 ) then + fo3qy = 0.0765_r8 & + + a(1)* (q1/(q1+q2))*exp( -((x(1)-w)/om(1))**4 ) & + + a(2)*(t/300._r8)**2 *(q2/(q1+q2))*exp( -((x(2)-w)/om(2))**2 ) & + + a(3)*(t/300._r8)**1.5_r8 *exp( -((x(3)-w)/om(3))**2 ) + else if( w > 328._r8 .and. w <= 340._r8 ) then + fo3qy = 0.08_r8 + else if( w > 340._r8 ) then + fo3qy = 0._r8 + end if + + end function fo3qy + + subroutine r04( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product of (cross section) x (quantum yiels) for n2o5 photolysis +! reactions: +! (a) n2o5 + hv -> no3 + no + o(3p) +! (b) n2o5 + hv -> no3 + no2 +! cross section from jpl97: use tabulated values up to 280 nm, use expon. +! expression for >285nm, linearly interpolate +! between s(280) and s(285,t) in between +! quantum yield: analysis of data in jpl94 (->dataj1/yld/n2o5.qy) +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- +! edit history: +! 05/98 original, adapted from former jspec1 subroutine +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: xs280 = 1.16999993e-19_r8 + + integer :: k, wn + real(r8) :: qy + real(r8) :: xsect, xst285 + real(r8) :: t + +!----------------------------------------------------------------------------- +! ... n2o5 photodissociation +!----------------------------------------------------------------------------- +! ... cross section from jpl97, table up to 280 nm +! quantum yield : see dataj1/yld/n2o5.qy for explanation +! correct for t-dependence of cross section +!----------------------------------------------------------------------------- +level_loop : & + do k = 1,pverp +!----------------------------------------------------------------------------- +! ... temperature dependence only valid for 225 - 300 k. +!----------------------------------------------------------------------------- + t = 1._r8/max( 225._r8,min( tlev(k),300._r8 ) ) +wave_loop : & + do wn = 1,nw + qy = max( 0._r8,min( 1._r8, 3.832441_r8 - 0.012809638_r8 * wc(wn) ) ) +!----------------------------------------------------------------------------- +! ... evaluate exponential +!----------------------------------------------------------------------------- + if( wl(wn) >= 285._r8 .and. wl(wn+1) <= 380._r8 ) then +!!$ xs(wn,k) = qy * 1.e-20_r8*exp( 2.735_r8 + (4728.5_r8 - 17.127_r8*wc(wn)) * t ) +! fvitt - made to match the old jn2o5 + xs(wn,k) = (1._r8 - qy) * 1.e-20_r8*exp( 2.735_r8 + (4728.5_r8 - 17.127_r8*wc(wn)) * t ) +!----------------------------------------------------------------------------- +! ... between 280 and 285, interpolate between temperature evaluated exponential +! at 285 nm and the tabulated value at 280 nm. +!----------------------------------------------------------------------------- + else if( wl(wn) >= 280._r8 .and. wl(wn+1) <= 286._r8 ) then + xst285 = 1.e-20_r8* exp( 2.735_r8 + (4728.5_r8 - 17.127_r8*286._r8)*t ) + xsect = xs280 + (wc(wn) - 280._r8)*(xst285 - xs280)/(286._r8 - 280._r8) +!!$ xs(wn,k) = qy * xsect + xs(wn,k) = (1._r8-qy) * xsect +!----------------------------------------------------------------------------- +! ... use tabulated values +!----------------------------------------------------------------------------- + else if (wl(wn) <= 280._r8 ) then +!!$ xs(wn,k) = qy * r04g(wn) + xs(wn,k) = (1._r8-qy) * r04g(wn) +!----------------------------------------------------------------------------- +! ... beyond 380 nm, set to zero +!----------------------------------------------------------------------------- + else + xs(wn,k) = 0._r8 + end if + end do wave_loop + end do level_loop + + end subroutine r04 + + subroutine r44_inti( nw, wc ) +!----------------------------------------------------------------------------- +! ... initialize subroutine r44 +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wc(kw) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! ... cross sections according to jpl97 recommendation (identical to 94 rec.) +! see file dataj1/abs/n2o_jpl94.abs for detail +!----------------------------------------------------------------------------- + real(r8), parameter :: a0 = 68.21023_r8 + real(r8), parameter :: a1 = -4.071805_r8 + real(r8), parameter :: a2 = 4.301146e-02_r8 + real(r8), parameter :: a3 = -1.777846e-04_r8 + real(r8), parameter :: a4 = 2.520672e-07_r8 + + real(r8), parameter :: b0 = 123.4014_r8 + real(r8), parameter :: b1 = -2.116255_r8 + real(r8), parameter :: b2 = 1.111572e-02_r8 + real(r8), parameter :: b3 = -1.881058e-05_r8 + + integer :: wn + integer :: astat + real(r8) :: lambda + + allocate( a(nw), b(nw), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'r44_inti: a,b allocate failed; error = ',astat + call endrun + end if + do wn = 1,nw + lambda = wc(wn) + if( lambda >= 173._r8 .and. lambda <= 240._r8 ) then + a(wn) = (((a4*lambda + a3)*lambda + a2)*lambda + a1)*lambda + a0 + b(wn) = ((b3*lambda + b2)*lambda + b1)*lambda + b0 + end if + end do + + end subroutine r44_inti + + subroutine r44( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for n2o photolysis: +! n2o + hv -> n2 + o(1d) +! cross section: from jpl 97 recommendation +! quantum yield: assumed to be unity, based on greenblatt and ravishankara +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- +! edit history: +! 05/98 original, adapted from former jspec1 subroutine +!----------------------------------------------------------------------------- + + use mo_params + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw), wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: t + +!----------------------------------------------------------------------------- +! ... n2o photodissociation +!----------------------------------------------------------------------------- +! ... quantum yield of n(4s) and no(2pi) is less than 1% (greenblatt and +! ravishankara), so quantum yield of o(1d) is assumed to be unity +!----------------------------------------------------------------------------- + do k = 1,pverp + t = max( 194._r8,min( tlev(k),320._r8 ) ) - 300._r8 + where( wc(:nw) >= 173._r8 .and. wc(:nw) <= 240._r8 ) + xs(:nw,k) = exp( a(:nw) + t*exp( b(:nw) ) ) + elsewhere + xs(:nw,k) = 0._r8 + endwhere + end do + + end subroutine r44 + + subroutine r08_inti( nw, wl, wc ) +!----------------------------------------------------------------------------- +! ... initialize subroutine r08 +!----------------------------------------------------------------------------- + + use mo_params, only : kw + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: a0 = 6.4761e+04_r8 + real(r8), parameter :: a1 = -9.2170972e+02_r8 + real(r8), parameter :: a2 = 4.535649_r8 + real(r8), parameter :: a3 = -4.4589016e-03_r8 + real(r8), parameter :: a4 = -4.035101e-05_r8 + real(r8), parameter :: a5 = 1.6878206e-07_r8 + real(r8), parameter :: a6 = -2.652014e-10_r8 + real(r8), parameter :: a7 = 1.5534675e-13_r8 + + real(r8), parameter :: b0 = 6.8123e+03_r8 + real(r8), parameter :: b1 = -5.1351e+01_r8 + real(r8), parameter :: b2 = 1.1522e-01_r8 + real(r8), parameter :: b3 = -3.0493e-05_r8 + real(r8), parameter :: b4 = -1.0924e-07_r8 + + integer :: astat + integer :: wn + real(r8) :: lambda + + allocate( suma(nw), sumb(nw), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'r08_inti: suma,sumb allocate failed; error = ',astat + call endrun + end if + do wn = 1,nw + if( wl(wn) >= 260._r8 .and. wl(wn) < 350._r8 ) then + lambda = wc(wn) + suma(wn) = ((((((a7*lambda + a6)*lambda + a5)*lambda + a4)*lambda +a3)*lambda + a2)*lambda + a1)*lambda + a0 + sumb(wn) = (((b4*lambda + b3)*lambda + b2)*lambda + b1)*lambda + b0 + end if + end do + + end subroutine r08_inti + + subroutine r08( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product of (cross section) x (quantum yield) for h2o2 photolysis +! h2o2 + hv -> 2 oh +! cross section: from jpl97, tabulated values @ 298k for <260nm, t-depend. +! parameterization for 260-350nm +! quantum yield: assumed to be unity +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- +! edit history: +! 05/98 original, adapted from former jspec1 subroutine +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: t + real(r8) :: chi + +!----------------------------------------------------------------------------- +! ... h2o2 photodissociation +! cross section from lin et al. 1978 +!----------------------------------------------------------------------------- + do k = 1,pverp + t = 1._r8/min( max( tlev(k),200._r8 ),400._r8 ) + chi = 1._r8/(1._r8 + exp( -1265._r8*t )) +!----------------------------------------------------------------------------- +! ... parameterization (jpl94) +! range 260-350 nm; 200-400 k +!----------------------------------------------------------------------------- + where( wl(:nw) > 260._r8 .and. wl(:nw) < 350._r8 ) + xs(:nw,k) = (chi * suma(:nw) + (1._r8 - chi)*sumb(:nw))*1.e-21_r8 + elsewhere + xs(:nw,k) = r08g(:nw) + endwhere + end do + + end subroutine r08 + + subroutine r06( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product of (cross section) x (quantum yield) for hno3 photolysis +! hno3 + hv -> oh + no2 +! cross section: burkholder et al., 1993 +! quantum yield: assumed to be unity +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: wrk + +!----------------------------------------------------------------------------- +! ... hno3 photodissociation +!----------------------------------------------------------------------------- +! ... hno3 cross section parameters from burkholder et al. 1993 +! quantum yield = 1 +! correct for temperature dependence +!----------------------------------------------------------------------------- + do k = 1,pverp + wrk = 1.e-3_r8*(tlev(k) - 298._r8) + xs(:nw,k) = r06g1(:nw) * 1.e-20_r8 * exp( r06g2(:nw)*wrk ) + end do + + end subroutine r06 + + subroutine r10( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product of (cross section) x (quantum yield) for ch2o photolysis * +! (a) ch2o + hv -> h + hco +! (b) ch2o + hv -> h2 + co +! cross section: choice between +! 1) bass et al., 1980 (resolution: 0.025 nm) +! 2) moortgat and schneider (resolution: 1 nm) +! 3) cantrell et al. (orig res.) for > 301 nm, +! iupac 92, 97 elsewhere +! 4) cantrell et al. (2.5 nm res.) for > 301 nm, +! iupac 92, 97 elsewhere +! 5) rogers et al., 1990 +! 6) new ncar recommendation, based on averages of +! cantrell et al., moortgat and schneider, and rogers +! et al. +! quantum yield: choice between +! 1) evaluation by madronich 1991 (unpublished) +! 2) iupac 89, 92, 97 +! 3) madronich, based on 1), updated 1998. +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer, parameter :: mopt1 = 6 + integer, parameter :: mopt2 = 1 + real(r8), parameter :: c0 = 1._r8/70._r8 + + integer :: k, wn + real(r8) :: phi1, phi2, phi20, ak300, akt + real(r8) :: qy, qy1, qy2, qy3, t, t1 + real(r8) :: sigma, sig, slope + +!----------------------------------------------------------------------------- +! ... ch2o photodissociatation +!----------------------------------------------------------------------------- +! ... combine +! y1 = xsect +! y2 = xsect(223), cantrell et al. +! y3 = xsect(293), cantrell et al. +! y4 = qy for radical channel +! y5 = qy for molecular channel +! pressure and temperature dependent for w > 330. +!----------------------------------------------------------------------------- +level_loop : & + do k = 1,pverp + t = max( 223.15_r8,min( tlev(k),293.15_r8 ) ) + t1 = airlev(k) +wave_loop : & + do wn = 1,nw + if( mopt1 == 6 ) then + sig = r10g2(wn) + else + sig = r10g1(wn) + end if +!----------------------------------------------------------------------------- +! ... correct cross section for temperature dependence for > 301. nm +!----------------------------------------------------------------------------- + if( wl(wn) >= 301._r8 ) then + if( mopt1 == 3 .or. mopt1 == 6 ) then + sig = r10g2(wn) + r10g3(wn) * (t - 273.15_r8) + else if( mopt1 == 4 ) then + slope = (r10g3(wn) - r10g2(wn)) * c0 + slope = (r10g3(wn) - r10g2(wn)) * c0 + sig = r10g2(wn) + slope * (t - 223._r8) + end if + end if + sig = max( sig,0._r8 ) +!----------------------------------------------------------------------------- +! ... quantum yields: +! temperature and pressure dependence beyond 330 nm +!----------------------------------------------------------------------------- + qy1 = r10g4(wn) + if( trim(jlabel) == 'jch2o_a' ) then + xs(wn,k) = sig * qy1 + else + if( wc(wn) >= 330._r8 .and. r10g5(wn) > 0._r8 ) then + phi1 = r10g4(wn) + phi2 = r10g5(wn) + phi20 = 1._r8 - phi1 + ak300 = (phi20 - phi2)/(phi20*phi2*2.54e+19_r8) + akt = ak300*(1._r8 + 61.69_r8*(1._r8 - tlev(k)/300._r8)*(wc(wn)/329._r8 - 1._r8)) + qy2 = 1._r8 / ((1._r8/phi20) + t1*akt) + else + qy2 = r10g5(wn) + end if + qy2 = min( 1._r8,max( 0._r8,qy2 ) ) + xs(wn,k) = sig * qy2 + end if + end do wave_loop + end do level_loop + + end subroutine r10 + + subroutine r11( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for ch3cho photolysis: +! (a) ch3cho + hv -> ch3 + hco +! (b) ch3cho + hv -> ch4 + co +! (c) ch3cho + hv -> ch3co + h +! cross section: choice between +! (1) iupac 97 data, from martinez et al. +! (2) calvert and pitts +! (3) martinez et al., table 1 scanned from paper +! (4) kfa tabulations +! quantum yields: choice between +! (1) iupac 97, pressure correction using horowith and +! calvert, 1982 +! (2) ncar data file, from moortgat, 1986 +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: c0 = 1._r8/2.465e19_r8 + integer, parameter :: mabs = 3 + integer, parameter :: myld = 1 + + integer :: k, wn + real(r8) :: qy1 + real(r8) :: sig, t + +!----------------------------------------------------------------------------- +! ... ch3cho photolysis +! 1: ch3 + hco +! 2: ch4 + co +! 3: ch3co + h +!----------------------------------------------------------------------------- +! ... options +! mabs for cross sections +! myld for quantum yields +! +! absorption: +! 1: iupac-97 data, from martinez et al. +! 2: calvert and pitts +! 3: martinez et al., table 1 scanned from paper +! 4: kfa tabulations, 6 choices, see file open statements +! +! quantum yield +! 1: dataj1/ch3cho/ch3cho_iup.yld +! pressure correction using horowitz and calvert 1982, +! based on slope/intercept of stern-volmer plots +! +! 2: ncar data file, from moortgat 1986. +!----------------------------------------------------------------------------- + + do k = 1,pverp + t = airlev(k)*c0 + do wn = 1,nw + sig = r11g(wn) +!----------------------------------------------------------------------------- +! ... pressure correction for channel 1, ch3 + cho +! based on horowitz and calvert 1982. +!----------------------------------------------------------------------------- + if( trim( jlabel ) == 'jch3cho_a' ) then + qy1 = r11g1(wn) * (1._r8 + r11g4(wn))/(1._r8 + r11g4(wn)*t) + qy1 = min( 1._r8,max( 0._r8,qy1 ) ) + xs(wn,k) = sig * qy1 + else if( trim( jlabel ) == 'jch3cho_b' ) then + xs(wn,k) = sig * r11g2(wn) + else if( trim( jlabel ) == 'jch3cho_c' ) then + xs(wn,k) = sig * r11g3(wn) + end if + end do + end do + + end subroutine r11 + + subroutine r14( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide the product (cross section) x (quantum yield) for ch3cocho +! photolysis: +! ch3cocho + hv -> products +! +! cross section: choice between +! (1) from meller et al., 1991, as tabulated by iupac 97 +! 5 nm resolution (table 1) for < 402 nm +! 2 nm resolution (table 2) for > 402 nm +! (2) average at 1 nm of staffelbach et al., 1995, and +! meller et al., 1991 +! (3) plum et al., 1983, as tabulated by kfa +! (4) meller et al., 1991 (0.033 nm res.), as tab. by kfa +! (5) meller et al., 1991 (1.0 nm res.), as tab. by kfa +! (6) staffelbach et al., 1995, as tabulated by kfa +! quantum yield: choice between +! (1) plum et al., fixed at 0.107 +! (2) plum et al., divided by 2, fixed at 0.0535 +! (3) staffelbach et al., 0.45 for < 300 nm, 0 for > 430 nm +! linear interp. in between +! (4) koch and moortgat, prv. comm., 1997 +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8), parameter :: sig2 = .45_r8 + real(r8), parameter :: sig3 = 1._r8/130._r8 + real(r8), parameter :: expfac = 760._r8/2.456e19_r8 + + integer :: k, wn + real(r8) :: qy + real(r8) :: phi0, kq + +!----------------------------------------------------------------------------- +! ... ch3cocho photolysis +!----------------------------------------------------------------------------- +! ... options +! mabs for cross sections +! myld for quantum yields +! +! absorption: +! 1: from meller et al. (1991), as tabulated by iupac-97 +! for wc < 402, use coarse data (5 nm, table 1) +! for wc > 402, use finer data (2 nm, table 2) +! 2: average at 1nm of staffelbach et al. 1995 and meller et al. 1991 +! cross section from kfa tables: +! 3: ch3cocho.001 - plum et al. 1983 +! 4: ch3cocho.002 - meller et al. 1991, 0.033 nm resolution +! 5: ch3cocho.003 - meller et al. 1991, 1.0 nm resolution +! 6: ch3cocho.004 - staffelbach et al. 1995 +! +! quantum yield +! 1: plum et al., 0.107 +! 2: plum et al., divided by two = 0.0535 +! 3: staffelbach et al., 0.45 at wc .le. 300, 0 for wc .gt. 430, linear +! interp in between +! 4: koch and moortgat, prv. comm. 1997. - pressure-dependent +! * 5: Chen, Y., W. Wang, and L. Zhu, Wavelength-dependent photolysis of methylglyoxal +! * in the 290-440 nm region, J Phys Chem A, 104, 11126-11131, 2000 +!----------------------------------------------------------------------------- + do k = 1,pverp + do wn = 1,nw + phi0 = 1._r8 - (wc(wn) - 380._r8)/60._r8 + phi0 = max( 0._r8,min( phi0,1._r8 ) ) + kq = 1.36e8_r8 * exp( -8793._r8/wc(wn) ) + if( phi0 > 0._r8 ) then + if( wc(wn) >= 380._r8 .and. wc(wn) <= 440._r8 ) then + qy = phi0 / (phi0 + kq * airlev(k) * expfac ) + else + qy = phi0 + end if + else + qy = 0._r8 + end if + xs(wn,k) = r14g(wn) * qy + end do + end do + + end subroutine r14 + + subroutine r15( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for ch3coch3 photolysis +! ch3coch3 + hv -> products +! +! cross section: choice between +! (1) calvert and pitts +! (2) martinez et al., 1991, alson in iupac 97 +! (3) noaa, 1998, unpublished as of 01/98 +! quantum yield: choice between +! (1) gardiner et al, 1984 +! (2) iupac 97 +! (3) mckeen et al., 1997 +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer, parameter :: mabs = 2 + integer, parameter :: myld = 3 + + integer :: k, wn + real(r8) :: qy + real(r8) :: sig + real(r8) :: a, b, t, t1 + real(r8) :: m, fco, fac, w + +!----------------------------------------------------------------------------- +! ... ch3coch3 photodissociation +!----------------------------------------------------------------------------- +! ... options +! mabs for cross sections +! myld for quantum yields +! +! absorption: +! 1: cross section from calvert and pitts +! 2: martinez et al. 1991, also in iupac97 +! 3: noaa 1998, unpublished as of jan 98. +! +! quantum yield +! 1: gardiner et al. 1984 +! 2: iupac 97 +! 3: mckeen, s. a., t. gierczak, j. b. burkholder, p. o. wennberg, t. f. hanisco, +! e. r. keim, r.-s. gao, s. c. liu, a. r. ravishankara, and d. w. fahey, +! the photochemistry of acetone in the upper troposphere: a source of +! odd-hydrogen radicals, geophys. res. lett., 24, 3177-3180, 1997. +! 4: Blitz, M. A., D. E. Heard, M. J. Pilling, S. R. Arnold, and M. P. Chipperfield +! (2004), Pressure and temperature-dependent quantum yields for the +! photodissociation of acetone between 279 and 327.5 nm, Geophys. +! Res. Lett., 31, L06111, doi:10.1029/2003GL018793. +! +!----------------------------------------------------------------------------- + do k = 1,pverp + m = airlev(k) + t = tlev(k) + do wn = 1,nw + sig = r15g(wn) + w = wc(wn) + call qyacet( w, t, m, fco, fac ) + qy = min( 1._r8,max( 0._r8,fac ) ) + xs(wn,k) = sig*qy + end do + end do + + end subroutine r15 + + subroutine qyacet( w, t, m, fco, fac ) +!----------------------------------------------------------------------------- +! Compute acetone quantum yields according to the parameterization of: +! Blitz, M. A., D. E. Heard, M. J. Pilling, S. R. Arnold, and M. P. Chipperfield +! (2004), Pressure and temperature-dependent quantum yields for the +! photodissociation of acetone between 279 and 327.5 nm, Geophys. +! Res. Lett., 31, L06111, doi:10.1029/2003GL018793. +!----------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + real(r8), intent(in) :: w ! w = wavelength (nm) + real(r8), intent(in) :: t ! T = temperature (K) + real(r8), intent(in) :: m ! m = air number density (molec/cm^3) + real(r8), intent(out) :: fco ! fco = quantum yield for product CO + real(r8), intent(out) :: fac ! fac = quantum yield for product CH3CO (acetyl radical) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + real(r8) :: a0, a1, a2, a3, a4 + real(r8) :: b0, b1, b2, b3, b4 + real(r8) :: c3 + real(r8) :: cA0, cA1, cA2, cA3, cA4 + real(r8) :: tratio + real(r8) :: wrk + +!----------------------------------------------------------------------------- +!** set out-of-range values: +! use low pressure limits for shorter wavelengths +! set to zero beyound 327.5 +!----------------------------------------------------------------------------- + if( w < 279._r8 ) then + fco = 0.05_r8 + fac = 0.95_r8 + else if( w > 327.5_r8 ) then + fco = 0._r8 + fac = 0._r8 + else +!----------------------------------------------------------------------------- +! ... CO (carbon monoxide) quantum yields +!----------------------------------------------------------------------------- + tratio = t/295._r8 + a0 = .350_r8 * tratio**(-1.28_r8) + b0 = .068_r8 * tratio**(-2.65_r8) + cA0 = exp( b0*(w - 248._r8) ) * a0 / (1._r8 - a0) + fco = 1._r8 / (1._r8 + cA0) +!----------------------------------------------------------------------------- +! ... CH3CO (acetyl radical) quantum yields: +!----------------------------------------------------------------------------- + if( w >= 279._r8 .and. w < 302._r8 ) then + a1 = 1.600e-19_r8 * tratio**(-2.38_r8) + b1 = 0.55e-3_r8 * tratio**(-3.19_r8) + cA1 = a1 * exp( -b1*((1.e7_r8/w) - 33113._r8) ) + fac = (1._r8 - fco) / (1._r8 + cA1 * m) + else if( w >= 302._r8 .and. w < 327.5_r8 ) then + a2 = 1.62e-17_r8 * tratio**(-10.03_r8) + b2 = 1.79e-3_r8 * tratio**(-1.364_r8) + wrk = 1.e7_r8/w + cA2 = a2 * exp( -b2*(wrk - 30488._r8) ) + a3 = 26.29_r8 * tratio**(-6.59_r8) + b3 = 5.72e-7_r8 * tratio**(-2.93_r8) + c3 = 30006._r8 * tratio**(-0.064_r8) + ca3 = a3 * exp( -b3*(wrk - c3)**2 ) + a4 = 1.67e-15_r8 * tratio**(-7.25_r8) + b4 = 2.08e-3_r8 * tratio**(-1.16_r8) + cA4 = a4 * exp( -b4*(wrk - 30488._r8) ) + fac = (1._r8 - fco) * (1._r8 + cA3 + cA4 * m) & + /((1._r8 + cA3 + cA2 * M)*(1._r8 + cA4 * m)) + end if + end if + + end subroutine qyacet + + subroutine r17( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for ch3ono2 +! photolysis: +! ch3ono2 + hv -> ch3o + no2 +! +! cross section: choice between +! (1) calvert and pitts, 1966 +! (2) talukdar, burkholder, hunter, gilles, roberts, +! ravishankara, 1997 +! (3) iupac 97, table of values for 198k +! (4) iupac 97, temperature-dependent equation +! (5) taylor et al, 1980 +! (6) fit from roberts and fajer, 1989 +! (7) rattigan et al., 1992 +! (8) libuda and zabel, 1995 +! quantum yield: assumed to be unity +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: t + +!----------------------------------------------------------------------------- +! ... ch3ono2 photodissociation +!----------------------------------------------------------------------------- +! ... mabs: absorption cross section options: +! 1: calvert and pitts 1966 +! 2: talukdar, burkholder, hunter, gilles, roberts, ravishankara, 1997. +! 3: iupac-97, table of values for 298k. +! 4: iupac-97, temperature-dependent equation +! 5: taylor et al. 1980 +! 6: fit from roberts and fajer, 1989 +! 7: rattigan et al. 1992 +! 8: libuda and zabel 1995 +!----------------------------------------------------------------------------- + do k = 1,pverp + t = tlev(k) - 298._r8 + xs(:nw,k) = r17g(:nw) * exp( r17g1(:nw)*t ) + end do + + end subroutine r17 + + subroutine r18( nw, wl, wc, tlev, airlev, jlabel, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for pan photolysis: +! pan + hv -> products +! +! cross section: from talukdar et al., 1995 +! quantum yield: assumed to be unity +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! j - integer, counter for number of weighting functions defined (io) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +! jlabel - character*40, string identifier for each photolysis reaction (o) +! defined +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + character(len=*), intent(in) :: jlabel + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + real(r8) :: t + +!----------------------------------------------------------------------------- +! ... pan photodissociation +!----------------------------------------------------------------------------- +! ... cross section from senum et al., 1984, j.phys.chem. 88/7, 1269-1270 +! quantum yield +! yet unknown, but assumed to be 1.0 (talukdar et al., 1995) +!----------------------------------------------------------------------------- + do k = 1,pverp + t = tlev(k) - 298._r8 + xs(:nw,k) = r18g(:nw) * exp( r18g2(:nw)*t ) + end do + + end subroutine r18 + + subroutine xs_mvk( nw, wl, wc, tlev, airlev, xs ) +!----------------------------------------------------------------------------- +! purpose: +! provide product (cross section) x (quantum yield) for mvk photolysis: +! mvk + hv -> products +!----------------------------------------------------------------------------- +! parameters: +! nw - integer, number of specified intervals + 1 in working (i) +! wavelength grid +! wl - real(r8), vector of lower limits of wavelength intervals in (i) +! working wavelength grid +! wc - real(r8), vector of center points of wavelength intervals in (i) +! working wavelength grid +! nz - integer, number of altitude levels in working altitude grid (i) +! tlev - real(r8), temperature (k) at each specified altitude level (i) +! airlev - real(r8), air density (molec/cc) at each altitude level (i) +! sq - real(r8), cross section x quantum yield (cm^2) for each (o) +! photolysis reaction defined, at each defined wavelength and +! at each defined altitude level +!----------------------------------------------------------------------------- + + use mo_params + use mo_waveall + use ppgrid, only : pverp + + implicit none + +!----------------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------------- + integer, intent(in) :: nw + real(r8), intent(in) :: wl(kw) + real(r8), intent(in) :: wc(kw) + real(r8), intent(in) :: tlev(pverp) + real(r8), intent(in) :: airlev(pverp) + real(r8), intent(inout) :: xs(:,:) + +!----------------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------------- + integer :: k + integer :: w + real(r8) :: denomi + real(r8) :: qy(nw) + + do k = 1,pverp + denomi = 1._r8/(5.5_r8 + 9.2e-19_r8*airlev(k)) + qy(:) = exp( -.055_r8*(wc(:nw) - 308._r8) )*denomi + xs(:nw,k) = min( qy(:nw),1._r8 ) * xs(:nw,k) + end do + + end subroutine xs_mvk + + end module mo_xsections diff --git a/src/chemistry/mozart/mo_zadj.F90 b/src/chemistry/mozart/mo_zadj.F90 new file mode 100644 index 0000000000..eb0ebc6e16 --- /dev/null +++ b/src/chemistry/mozart/mo_zadj.F90 @@ -0,0 +1,10 @@ + + module mo_zadj + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + real(r8), allocatable :: adj_coeffs(:,:,:) + + end module mo_zadj diff --git a/src/chemistry/mozart/noy_ubc.F90 b/src/chemistry/mozart/noy_ubc.F90 new file mode 100644 index 0000000000..37974670aa --- /dev/null +++ b/src/chemistry/mozart/noy_ubc.F90 @@ -0,0 +1,247 @@ +!======================================================================== +! NOy at upper boundary for CAM-Chem +!======================================================================== + +module noy_ubc + + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + use tracer_data, only : trfld,trfile,MAXTRCRS + use cam_history, only : addfld, horiz_only + + implicit none + + private + public :: noy_ubc_init + public :: noy_ubc_set + public :: noy_ubc_advance + public :: noy_ubc_readnl + + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + integer :: ub_nspecies + character(len=16) :: ubc_name(MAXTRCRS) + integer :: map(MAXTRCRS) = -1 + + character(len=256) :: noy_ubc_filename = 'NONE' + character(len=256) :: noy_ubc_filelist = ' ' + character(len=256) :: noy_ubc_datapath = ' ' + character(len=32) :: noy_ubc_datatype = 'SERIAL' + logical :: noy_ubc_rmv_file = .false. + integer :: noy_ubc_cycle_yr = 0 + integer :: noy_ubc_fixed_ymd = 0 + integer :: noy_ubc_fixed_tod = 0 + + real(r8) :: fac_relax + + logical :: has_noy_ubc = .false. + +contains + + !====================================================================== + !====================================================================== + subroutine noy_ubc_readnl(nlfile) + + use namelist_utils, only : find_group_name + use units, only : getunit, freeunit + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_integer + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'noy_ubc_readnl' + + namelist /noy_ubc_nl/ & + noy_ubc_filename, noy_ubc_filelist, noy_ubc_datapath, noy_ubc_datatype, & + noy_ubc_cycle_yr, noy_ubc_fixed_ymd, noy_ubc_fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'noy_ubc_nl', status=ierr) + if (ierr == 0) then + read(unitn, noy_ubc_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(noy_ubc_filename, len(noy_ubc_filename), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_filelist, len(noy_ubc_filelist), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_datapath, len(noy_ubc_datapath), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_datatype, len(noy_ubc_datatype), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(noy_ubc_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + + has_noy_ubc = len_trim(noy_ubc_filename) > 0 .and. noy_ubc_filename.ne.'NONE' + + end subroutine noy_ubc_readnl + + !====================================================================== + !====================================================================== + subroutine noy_ubc_init() + + !------------------------------------------------------------------ + ! ... initialize upper boundary values + !------------------------------------------------------------------ + use tracer_data, only : trcdata_init + use mo_chem_utls, only : get_spc_ndx + + !------------------------------------------------------------------ + ! ... dummy args + !------------------------------------------------------------------ + + ! local vars + integer :: vid, i,ii + + integer, parameter :: nubc = 4 + character(len=4), parameter :: species(nubc) = (/'NO ','NO2 ','HNO3','N2O5'/) + character(len=4) :: specifier(nubc) = ' ' + + if (.not.has_noy_ubc) return + + ii = 0 + + do i = 1,nubc + vid = get_spc_ndx(species(i)) + if( vid > 0 ) then + ii = ii+1 + specifier(ii) = species(i) ! set specifier to the species that actually + ! are in the simulation so that the species mapping is correct + map(ii) = vid + ubc_name(ii) = trim(specifier(i))//'_ubc' + call addfld( ubc_name(ii), horiz_only, 'I', 'mol/mol', 'upper boundary vmr' ) + + end if + enddo + + ub_nspecies = count( map(:)>0 ) + + if (ub_nspecies > 0) then + file%top_bndry = .true. + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, noy_ubc_filename, noy_ubc_filelist, noy_ubc_datapath, fields, file, & + noy_ubc_rmv_file, noy_ubc_cycle_yr, noy_ubc_fixed_ymd, noy_ubc_fixed_tod, noy_ubc_datatype) + endif + + end subroutine noy_ubc_init + + !====================================================================== + !====================================================================== + subroutine noy_ubc_advance(pbuf2d, state) + + use tracer_data, only : advance_trcdata + use physics_types, only : physics_state + use physics_buffer, only : physics_buffer_desc + use time_manager, only : get_step_size + + !-------------------------------------------------------------------- + ! ... Advance ub values + !-------------------------------------------------------------------- + implicit none + + ! args + type(physics_state), intent(in) :: state(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) +! + integer :: dtime ! model time step (s) + real(r8), parameter :: tau_relax = 864000._r8 ! 10 days + + if (.not.has_noy_ubc) return +! +! define relaxation factor +! + dtime = get_step_size() + fac_relax = 1._r8 - exp( -real(dtime)/tau_relax ) +! + if (ub_nspecies > 0) then + call advance_trcdata( fields, file, state, pbuf2d ) + endif + + end subroutine noy_ubc_advance + + !====================================================================== + ! ... Set the upper boundary values + !====================================================================== + subroutine noy_ubc_set( lchnk, ncol, vmr ) + use cam_history, only : outfld + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(inout) :: vmr(:,:,:) + + integer :: m,n,m1,m2,i + real(r8) :: xno,xno2,xnox,rno,dtime + real(r8) :: yno,yno2,ynox + + if (.not.has_noy_ubc) return +! +! only update model top layer (index=1) +! + if (ub_nspecies > 0) then + do m = 1,ub_nspecies + if ( trim(fields(m)%fldnam) == 'NO' .or. trim(fields(m)%fldnam) == 'NO2' ) cycle + n = map(m) + vmr(:ncol,1,n) = fields(m)%data(:ncol,1,lchnk) + call outfld( ubc_name(m), vmr(:ncol,1,n), ncol, lchnk ) + enddo + endif +! +! special case for NO & NO2 +! + m1 = -99 + m2 = -99 + do m=1,ub_nspecies + if ( trim(fields(m)%fldnam) == 'NO' ) m1 = m + if ( trim(fields(m)%fldnam) == 'NO2' ) m2 = m + end do + if ( m1 > 0 .and. m2 > 0 ) then +! + do i=1,ncol +! + xno = vmr(i,1,map(m1)) + xno2 = vmr(i,1,map(m2)) + xnox = xno + xno2 + rno = xno/xnox +! + yno = fields(m1)%data(i,1,lchnk) + yno2 = fields(m2)%data(i,1,lchnk) + ynox = yno + yno2 +! +! relax model NOx towards the specified values +! + xnox = xnox + (ynox - xnox) * fac_relax +! +! use original ratio to redistribute updated NOx between NO and NO2 +! + vmr(i,1,map(m1)) = rno * xnox + vmr(i,1,map(m2)) = (1._r8-rno) * xnox +! + end do +! + call outfld( ubc_name(m1), vmr(:ncol,1,map(m1)), ncol, lchnk ) + call outfld( ubc_name(m2), vmr(:ncol,1,map(m2)), ncol, lchnk ) + end if +! + end subroutine noy_ubc_set + +end module noy_ubc diff --git a/src/chemistry/mozart/photo_bkgrnd.F90 b/src/chemistry/mozart/photo_bkgrnd.F90 new file mode 100644 index 0000000000..bb212fd42d --- /dev/null +++ b/src/chemistry/mozart/photo_bkgrnd.F90 @@ -0,0 +1,217 @@ +!---------------------------------------------------------------------------- +! For calculating background ionization due to star light, geo-corona radiation +! Applicable to high altitudes of WACCM and WACCMX +! Module created by Francis Vitt 14 Feb 2013 +! Background ionization algorithm provided by Stan Solomn +!---------------------------------------------------------------------------- +module photo_bkgrnd + + use shr_kind_mod, only : r8 => shr_kind_r8 + use mo_chem_utls, only : get_rxt_ndx + use ppgrid, only : pver + + implicit none + + private + public :: photo_bkgrnd_calc + public :: photo_bkgrnd_init + + integer :: jo_ndx, jo2_ndx, jn2_ndx, jn_ndx, jno_ndx + +contains + + !---------------------------------------------------------------------------- + ! look up corresponding reaction rate indices + !---------------------------------------------------------------------------- + subroutine photo_bkgrnd_init() + jo_ndx = get_rxt_ndx( 'jeuv_1' ) ! O + hv -> Op + e + jo2_ndx = get_rxt_ndx( 'jeuv_5' ) ! O2 + hv -> O2p + e + jn2_ndx = get_rxt_ndx( 'jeuv_6' ) ! N2 + hv -> N2p + e + jn_ndx = get_rxt_ndx( 'jeuv_10') ! N2 + hv -> N + Np + e + jno_ndx = get_rxt_ndx( 'jno_i' ) ! NO + hv -> NOp + e + end subroutine photo_bkgrnd_init + + !---------------------------------------------------------------------------- + ! Adds background ionization rates to WACCM's photolysis rates + !---------------------------------------------------------------------------- + subroutine photo_bkgrnd_calc(f107, o_den, o2_den, n2_den, no_den, zint, rates, & + qbko1_out, qbko2_out, qbkn2_out, qbkn1_out, qbkno_out ) + + ! arguments + real(r8), intent(in) :: f107 + real(r8), intent(in) :: o_den(:) ! N density (molecules/cm^3) + real(r8), intent(in) :: o2_den(:) ! O2 density (molecules/cm^3) + real(r8), intent(in) :: n2_den(:) ! N2 density (molecules/cm^3) + real(r8), intent(in) :: no_den(:) ! NO density (molecules/cm^3) + real(r8), intent(in) :: zint(:) ! interface height (km) + + real(r8), intent(inout) :: rates(:,:) ! photolysis rates (sec-1) + + real(r8), intent(out), optional :: qbko1_out(:) ! rate (cm-3 sec-1) of O + hv -> Op + e + real(r8), intent(out), optional :: qbko2_out(:) ! rate (cm-3 sec-1) of O2 + hv -> O2p + e + real(r8), intent(out), optional :: qbkn2_out(:) ! rate (cm-3 sec-1) of N2 + hv -> N2p + e + real(r8), intent(out), optional :: qbkn1_out(:) ! rate (cm-3 sec-1) of N + hv -> Np + e + real(r8), intent(out), optional :: qbkno_out(:) ! rate (cm-3 sec-1) of N2 + hv -> NOp + e + + ! local vars + real(r8), parameter :: km2cm = 1.e5_r8 + integer, parameter :: nmaj = 3 + + real(r8) :: zmaj(nmaj,pver) + real(r8) :: zno(pver) + real(r8) :: zvcd(nmaj,pver) + real(r8) :: delz(pver) + real(r8) :: qbko1(pver) + real(r8) :: qbko2(pver) + real(r8) :: qbkn2(pver) + real(r8) :: qbkn1(pver) + real(r8) :: qbkno(pver) + + integer :: k + + zmaj(1,:) = o_den(:) + zmaj(2,:) = o2_den(:) + zmaj(3,:) = n2_den(:) + zno(:) = no_den(:) + + ! thickness of each layer (cm) + delz(1:pver-1) = km2cm*(zint(1:pver-1) - zint(2:pver)) + delz(pver) = delz(pver-1) + + zvcd(:,:) = 0._r8 + + ! intergate column above each layer + do k = 2,pver + zvcd(1,k) = zvcd(1,k-1) + delz(k) * o_den(k) + zvcd(2,k) = zvcd(2,k-1) + delz(k) * o2_den(k) + zvcd(3,k) = zvcd(3,k-1) + delz(k) * n2_den(k) + enddo + + ! invoke Stan's background ionization method -- returns rates (cm-3 sec-1) + call qback (zmaj,zno,zvcd,f107,nmaj,pver,qbko1,qbko2,qbkn2,qbkn1,qbkno) + + ! divide by densities to get photolysis rates (sec-1) + if (jo_ndx>0) rates(:,jo_ndx) = rates(:,jo_ndx) + qbko1(:)/o_den(:) + if (jo2_ndx>0) rates(:,jo2_ndx) = rates(:,jo2_ndx) + qbko2(:)/o2_den(:) + if (jn2_ndx>0) rates(:,jn2_ndx) = rates(:,jn2_ndx) + qbkn2(:)/n2_den(:) + if (jn_ndx >0) rates(:,jn_ndx) = rates(:,jn_ndx) + qbkn1(:)/n2_den(:) + if (jno_ndx>0) rates(:,jno_ndx) = rates(:,jno_ndx) + qbkno(:)/no_den(:) + + ! for diagnostics + if (present(qbko1_out)) qbko1_out(:) = qbko1(:) + if (present(qbko2_out)) qbko2_out(:) = qbko2(:) + if (present(qbkn2_out)) qbkn2_out(:) = qbkn2(:) + if (present(qbkn1_out)) qbkn1_out(:) = qbkn1(:) + if (present(qbkno_out)) qbkno_out(:) = qbkno(:) + + endsubroutine photo_bkgrnd_calc + +!---------------------------------------------------------------------------- +! Private Method +!---------------------------------------------------------------------------- +! +! Stan Solomon, 11/88, 11/92 +! Comment updated 3/05 +! New version uses updated TIE-GCM and TIME-GCM qinite.F formulation, 1/13 +! +! Estimates background ("nighttime") ionization rates. +! Four components are used: +! Geocoronal Lyman-beta 102.6 nm (ionizes O2 only) +! Geocoronal He I 58.4 nm +! Geocoronal He II 30.4 nm +! Geocoronal Lyman-alpha 121.6 nm (ionizes NO only) +! +! Definitions: +! +! zmaj major species O, O2, N2 at each altitude +! zno nitric oxide at each altitude +! zvcd vertical column density for each major species above each altitude +! photoi photoionization rates for each state, species, altitude +! f107 solar 10.7 cm radio flux activity index +! jm number of altitude levels +! nmaj number of major species (3) +! nst number of states +! +! al photon flux at 102.6 nm, 58.4 nm, 30.4 nm +! flyan photon flux at 121.6 nm +! sa absorption cross sections for O, O2, N2 at each wavelength +! si ionization cross sections for O, O2, N2 at each wavelength +! flyan photon flux at 121.6 nm +! salyao2 absorption cross section for O2 at 121.6 nm +! silyano ionization cross section for NO at 121.6 nm +! bn2p branching ratio for N2+ from ionization of N2 +! bn1p branching ratio for N+ from ionization of N2 +! tau optical depth +! qbko1 production rate of O+ +! qbko2 production rate of O2+ +! qbkn2 production rate of N2+ +! qbkn1 production rate of N+ +! qbkno production rate of NO+ +! +! All units cgs. +! +! +subroutine qback (zmaj,zno,zvcd,f107,nmaj,jm,qbko1,qbko2,qbkn2,qbkn1,qbkno) + + ! args: + integer, intent(in) :: nmaj,jm + real(r8), intent(in) :: f107 + real(r8), intent(in) :: zmaj(nmaj,jm), zno(jm), zvcd(nmaj,jm) + real(r8), intent(out) :: qbko1(jm),qbko2(jm),qbkn2(jm),qbkn1(jm),qbkno(jm) + + ! local vars: + real(r8) :: al(3), sa(3,3), si(3,3) + real(r8) :: salyao2, silyano, bn2p, bn1p + real(r8) :: flyan + real(r8) :: tau + integer :: j,l + + data al /1.5e7_r8, 1.5e6_r8, 1.5e6_r8/ + + data sa / 0._r8, 1.6e-18_r8, 0._r8, & + 10.2e-18_r8, 22.0e-18_r8, 23.1e-18_r8, & + 8.4e-18_r8, 16.0e-18_r8, 11.6e-18_r8/ + + data si / 0._r8, 1.0e-18_r8, 0._r8, & + 10.2e-18_r8, 22.0e-18_r8, 23.1e-18_r8, & + 8.4e-18_r8, 16.0e-18_r8, 11.6e-18_r8/ + + data salyao2/8.0e-21_r8/ + data silyano/2.0e-18_r8/ + data bn2p/0.86_r8/ + data bn1p/0.14_r8/ + +! +! Calculate Lyman-alpha 121.6 nm geocoronal flux as a function of F10.7: +! + flyan = 5.E9_r8*(1._r8+0.002_r8*(f107-65._r8)) +! +! Loop over altitudes: +! + do j=1,jm +! +! Calculate optical depth and ionization rates for major species: +! + qbko1(j)=0._r8 + qbko2(j)=0._r8 + qbkn2(j)=0._r8 + qbkn1(j)=0._r8 + do l=1,3 + tau=(sa(1,l)*zvcd(1,j)+sa(2,l)*zvcd(2,j)+sa(3,l)*zvcd(3,j)) + qbko1(j) = qbko1(j) + al(l)*si(1,l)*zmaj(1,j)*exp(-tau) + qbko2(j) = qbko2(j) + al(l)*si(2,l)*zmaj(2,j)*exp(-tau) + qbkn2(j) = qbkn2(j) + bn2p*(al(l)*si(3,l)*zmaj(3,j)*exp(-tau)) + qbkn1(j) = qbkn1(j) + bn1p*(al(l)*si(3,l)*zmaj(3,j)*exp(-tau)) + enddo +! +! Calculate optical depth of Ly-alpha, and ionization rate of NO: +! + tau = salyao2*zvcd(2,j) + qbkno(j) = flyan*silyano*zno(j)*exp(-tau) + + enddo + + return +end subroutine qback + +end module photo_bkgrnd diff --git a/src/chemistry/mozart/rate_diags.F90 b/src/chemistry/mozart/rate_diags.F90 new file mode 100644 index 0000000000..d230657e31 --- /dev/null +++ b/src/chemistry/mozart/rate_diags.F90 @@ -0,0 +1,175 @@ +!-------------------------------------------------------------------------------- +! Manages writing reaction rates to history +!-------------------------------------------------------------------------------- +module rate_diags + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : CL => SHR_KIND_CL + use cam_history, only : fieldname_len + use cam_history, only : addfld, add_default + use cam_history, only : outfld + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use ppgrid, only : pver + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use sums_utils, only : sums_grp_t, parse_sums + + implicit none + private + public :: rate_diags_init + public :: rate_diags_calc + public :: rate_diags_readnl + + character(len=fieldname_len) :: rate_names(rxt_tag_cnt) + + integer :: ngrps = 0 + type(sums_grp_t), allocatable :: grps(:) + + integer, parameter :: maxlines = 200 + character(len=CL), allocatable :: rxn_rate_sums(:) + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine rate_diags_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mpi_character, masterprocid + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + namelist /rxn_rate_diags_nl/ rxn_rate_sums + + allocate( rxn_rate_sums( maxlines ) ) + rxn_rate_sums(:) = ' ' + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rxn_rate_diags_nl', status=ierr) + if (ierr == 0) then + read(unitn, rxn_rate_diags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('rate_diags_readnl:: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(rxn_rate_sums,len(rxn_rate_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) + + end subroutine rate_diags_readnl +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine rate_diags_init + use phys_control, only : phys_getopts + + integer :: i, len, pos + character(len=64) :: name + logical :: history_scwaccm_forcing + + call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) + + do i = 1,rxt_tag_cnt + pos = 0 + pos = index(rxt_tag_lst(i),'tag_') + if (pos <= 0) pos = index(rxt_tag_lst(i),'usr_') + if (pos <= 0) pos = index(rxt_tag_lst(i),'cph_') + if (pos <= 0) pos = index(rxt_tag_lst(i),'ion_') + if (pos>0) then + name = 'r_'//trim(rxt_tag_lst(i)(5:)) + else + name = 'r_'//trim(rxt_tag_lst(i)(1:)) + endif + len = min(fieldname_len,len_trim(name)) + rate_names(i) = trim(name(1:len)) + call addfld(rate_names(i), (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate') + if (history_scwaccm_forcing .and. rate_names(i) == 'r_O1D_H2O') then + call add_default( rate_names(i), 1, ' ') + endif + enddo + + ! parse the terms of the summations + call parse_sums(rxn_rate_sums, ngrps, grps) + deallocate( rxn_rate_sums ) + + do i = 1, ngrps + call addfld( grps(i)%name, (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate group') + enddo + + end subroutine rate_diags_init + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk ) + + use mo_rxt_rates_conv, only: set_rates + + real(r8), intent(inout) :: rxt_rates(:,:,:) ! 'molec/cm3/sec' + real(r8), intent(in) :: vmr(:,:,:) + real(r8), intent(in) :: m(:,:) ! air density (molecules/cm3) + integer, intent(in) :: ncol, lchnk + + integer :: i, j, ndx + real(r8) :: group_rate(ncol,pver) + + call set_rates( rxt_rates, vmr, ncol ) + + ! output individual tagged rates + do i = 1, rxt_tag_cnt + ! convert from vmr/sec to molecules/cm3/sec + rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:ncol,:) + call outfld( rate_names(i), rxt_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + enddo + + ! output rate groups ( or families ) + do i = 1, ngrps + group_rate(:,:) = 0._r8 + do j = 1, grps(i)%nmembers + ndx = lookup_tag_ndx(grps(i)%term(j)) + group_rate(:ncol,:) = group_rate(:ncol,:) + grps(i)%multipler(j)*rxt_rates(:ncol,:,ndx) + enddo + call outfld( grps(i)%name, group_rate(:ncol,:), ncol, lchnk ) + end do + + end subroutine rate_diags_calc + +!------------------------------------------------------------------- +! Private routines : +!------------------------------------------------------------------- +!------------------------------------------------------------------- + +!------------------------------------------------------------------- +! finds the index corresponging to a given reacton name +!------------------------------------------------------------------- + function lookup_tag_ndx( name ) result( ndx ) + character(len=*) :: name + integer :: ndx + + integer :: i + + ndx = -1 + + findloop: do i = 1,rxt_tag_cnt + if (trim(name) .eq. trim(rate_names(i)(3:))) then + ndx = i + return + endif + end do findloop + + if (ndx<0) then + call endrun('rate_diags: not able to find rxn tag name: '//trim(name)) + endif + + end function lookup_tag_ndx + +end module rate_diags diff --git a/src/chemistry/mozart/set_cp.F90 b/src/chemistry/mozart/set_cp.F90 new file mode 100644 index 0000000000..f6e83e79a1 --- /dev/null +++ b/src/chemistry/mozart/set_cp.F90 @@ -0,0 +1,128 @@ + +module set_cp + + use shr_kind_mod, only : r8 => shr_kind_r8 + use physconst, only : r_universal + + implicit none + + private + public :: calc_cp + + save + + real(r8), parameter :: ur = .5_r8 * r_universal + +contains + + subroutine calc_cp( ncol, vmr, cpairz ) + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + + use ppgrid, only : pver + use physconst, only : cpair + use chem_mods, only : adv_mass + use mo_chem_utls, only : get_spc_ndx, get_inv_ndx + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: vmr(:,:,:) ! species vmrentrations (mol/mol) + real(r8), intent(inout) :: cpairz(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: k, n + real(r8) :: ro_mw, ro2_mw, rn2_mw ! inverse molecular weights + real(r8) :: hvmr(ncol,pver) ! h vmrentration (mol/mol) + real(r8) :: n2vmr(ncol,pver) ! n2 vmrentration (mol/mol) + real(r8) :: o3vmr(ncol,pver) ! o3 vmrentration (mol/mol) + real(r8) :: o2vmr(ncol,pver) ! o2 vmrentration (mol/mol) + real(r8) :: ovmr(ncol,pver) ! o vmrentration (mol/mol) + + logical, parameter :: fixed_cp = .true. + + if( fixed_cp ) then + !----------------------------------------------------------------------- + ! ... use same cp as rest of CAM + !----------------------------------------------------------------------- + cpairz(:ncol,:pver) = cpair + else + !----------------------------------------------------------------------- + ! ... caculate cp based on ratio of molecules to atoms + !----------------------------------------------------------------------- + n = get_spc_ndx( 'O' ) + if( n > 0 ) then + ro_mw = 1._r8/adv_mass(n) + do k = 1,pver + ovmr(:,k) = vmr(:ncol,k,n) + end do + else + ro_mw = 1._r8 + do k = 1,pver + ovmr(:,k) = 0._r8 + end do + end if + n = get_spc_ndx( 'O2' ) + if( n > 0 ) then + ro2_mw = 1._r8/adv_mass(n) + do k = 1,pver + o2vmr(:,k) = vmr(:ncol,k,n) + end do + else + ro2_mw = 1._r8 + do k = 1,pver + o2vmr(:,k) = 0._r8 + end do + end if + n = get_spc_ndx( 'O3' ) + if( n > 0 ) then + do k = 1,pver + o3vmr(:,k) = vmr(:ncol,k,n) + end do + else + do k = 1,pver + o3vmr(:,k) = 0._r8 + end do + end if + n = get_spc_ndx( 'H' ) + if( n > 0 ) then + do k = 1,pver + hvmr(:,k) = vmr(:ncol,k,n) + end do + else + do k = 1,pver + hvmr(:,k) = 0._r8 + end do + end if + !----------------------------------------------------------------------- + ! ... calculate n2 concentration + !----------------------------------------------------------------------- + do k = 1,pver + n2vmr(:,k) = 1._r8 - (ovmr(:,k) + o2vmr(:,k) + hvmr(:,k)) + end do + n = get_spc_ndx( 'N' ) + if( n > 0 ) then + rn2_mw = .5_r8/adv_mass(n) + else + rn2_mw = 1._r8 + end if + + !----------------------------------------------------------------------- + ! ... calculate cp + !----------------------------------------------------------------------- + do k = 1,pver + cpairz(:ncol,k) = & + ur *(7._r8*(o2vmr(:ncol,k)*ro2_mw + n2vmr(:ncol,k)*rn2_mw) & + + 5._r8*(ovmr(:ncol,k) + o3vmr(:ncol,k))*ro_mw) + end do + endif + + end subroutine calc_cp + +end module set_cp diff --git a/src/chemistry/mozart/short_lived_species.F90 b/src/chemistry/mozart/short_lived_species.F90 new file mode 100644 index 0000000000..cbf49bdb86 --- /dev/null +++ b/src/chemistry/mozart/short_lived_species.F90 @@ -0,0 +1,180 @@ +!--------------------------------------------------------------------- +! Manages the storage of non-transported short-lived chemical species +! in the physics buffer. +! +! Created by: Francis Vitt -- 20 Aug 2008 +!--------------------------------------------------------------------- +module short_lived_species + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : slvd_lst, nslvd, gas_pcnst + use cam_logfile, only : iulog + use ppgrid, only : pcols, pver, begchunk, endchunk + use spmd_utils, only : masterproc + + + implicit none + + save + private + public :: map + public :: register_short_lived_species + public :: initialize_short_lived_species + public :: set_short_lived_species + public :: get_short_lived_species + public :: slvd_index + public :: pbf_idx + + integer :: pbf_idx + integer :: map(nslvd) + + character(len=16), parameter :: pbufname = 'ShortLivedSpecies' + +contains + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine register_short_lived_species + use physics_buffer, only : pbuf_add_field, dtype_r8 + + implicit none + + integer :: m + + if ( nslvd < 1 ) return + + call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx) + + end subroutine register_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine initialize_short_lived_species(ncid_ini, pbuf2d) + use cam_grid_support, only : cam_grid_check, cam_grid_id + use cam_grid_support, only : cam_grid_get_dim_names + use cam_abortutils, only : endrun + use mo_tracname, only : solsym + use ncdio_atm, only : infld + use pio, only : file_desc_t + use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk, pbuf_get_field + + implicit none + + type(file_desc_t), intent(inout) :: ncid_ini + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: m,n,lchnk + integer :: grid_id + character(len=8) :: fieldname + character(len=4) :: dim1name, dim2name + logical :: found + real(r8),pointer :: tmpptr(:,:,:) ! temporary pointer + real(r8),pointer :: tmpptr2(:,:,:) ! temporary pointer + character(len=*), parameter :: subname='INITIALIZE_SHORT_LIVED_SPECIES' + + if ( nslvd < 1 ) return + + found = .false. + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + call pbuf_set_field(pbuf2d, pbf_idx, 0._r8) + + allocate(tmpptr(pcols,pver,begchunk:endchunk)) + + do m=1,nslvd + n = map(m) + fieldname = solsym(n) + call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tmpptr, found, gridname='physgrid') + + if (.not.found) then + tmpptr(:,:,:) = 1.e-36_r8 + endif + + call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/)) + + if (masterproc) write(iulog,*) fieldname, ' is set to short-lived' + + enddo + + deallocate(tmpptr) + + end subroutine initialize_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) + + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + implicit none + + real(r8), intent(in) :: q(pcols,pver,gas_pcnst) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + integer :: m,n + + if ( nslvd < 1 ) return + + do m=1,nslvd + n = map(m) + call pbuf_set_field(pbuf, pbf_idx, q(:,:,n), start=(/1,1,m/),kount=(/pcols,pver,1/)) + enddo + + end subroutine set_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + real(r8), intent(inout) :: q(pcols,pver,gas_pcnst) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8),pointer :: tmpptr(:,:) + + + integer :: m,n + + if ( nslvd < 1 ) return + + do m=1,nslvd + n = map(m) + call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) + q(:ncol,:,n) = tmpptr(:ncol,:) + enddo + + endsubroutine get_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + function slvd_index( name ) + implicit none + + character(len=*) :: name + integer :: slvd_index + + integer :: m + + slvd_index = -1 + + if ( nslvd < 1 ) return + + do m=1,nslvd + if ( name == slvd_lst(m) ) then + slvd_index = m + return + endif + enddo + + endfunction slvd_index + +end module short_lived_species diff --git a/src/chemistry/mozart/species_sums_diags.F90 b/src/chemistry/mozart/species_sums_diags.F90 new file mode 100644 index 0000000000..20431e952c --- /dev/null +++ b/src/chemistry/mozart/species_sums_diags.F90 @@ -0,0 +1,138 @@ +!-------------------------------------------------------------------------------- +! Species summations for history +!-------------------------------------------------------------------------------- +module species_sums_diags + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : CL => SHR_KIND_CL + use cam_history, only : addfld + use cam_history, only : outfld + use ppgrid, only : pver + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use mo_chem_utls, only : get_spc_ndx + use sums_utils, only : sums_grp_t, parse_sums + + implicit none + private + public :: species_sums_init + public :: species_sums_output + public :: species_sums_readnl + + integer :: n_vmr_grps = 0 + type(sums_grp_t), allocatable :: vmr_grps(:) + integer :: n_mmr_grps = 0 + type(sums_grp_t), allocatable :: mmr_grps(:) + + integer, parameter :: maxlines = 200 + character(len=CL), allocatable :: vmr_sums(:) + character(len=CL), allocatable :: mmr_sums(:) + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine species_sums_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mpi_character, masterprocid + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + namelist /species_sums_nl/ vmr_sums, mmr_sums + + allocate( vmr_sums( maxlines ) ) + vmr_sums(:) = ' ' + allocate( mmr_sums( maxlines ) ) + mmr_sums(:) = ' ' + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'species_sums_nl', status=ierr) + if (ierr == 0) then + read(unitn, species_sums_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('species_sums_readnl:: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(vmr_sums,len(vmr_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(mmr_sums,len(mmr_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) + + end subroutine species_sums_readnl +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine species_sums_init + + integer :: i + + ! parse the terms of the summations + call parse_sums(vmr_sums, n_vmr_grps, vmr_grps) + deallocate( vmr_sums ) + call parse_sums(mmr_sums, n_mmr_grps, mmr_grps) + deallocate( mmr_sums ) + + ! add history fields + do i = 1, n_vmr_grps + call addfld( vmr_grps(i)%name, (/ 'lev' /),'A', 'mole/mole','summation of species volume mixing ratios') + enddo + do i = 1, n_mmr_grps + call addfld( mmr_grps(i)%name, (/ 'lev' /),'A', 'kg/kg','summation of species mass mixing ratios') + enddo + + end subroutine species_sums_init + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine species_sums_output( vmr, mmr, ncol, lchnk ) + + real(r8), intent(in) :: vmr(:,:,:) + real(r8), intent(in) :: mmr(:,:,:) + integer, intent(in) :: ncol, lchnk + + integer :: i, j, spc_ndx + real(r8) :: group_sum(ncol,pver) + character(len=16) :: spc_name + + ! output species groups ( or families ) + do i = 1, n_vmr_grps + ! look up the corresponding species index ... + group_sum(:,:) = 0._r8 + do j = 1, vmr_grps(i)%nmembers + spc_name = vmr_grps(i)%term(j) + spc_ndx = get_spc_ndx( spc_name ) + if ( spc_ndx < 1 ) then + call endrun('species_sums_output species name not found : '//trim(spc_name)) + endif + group_sum(:ncol,:) = group_sum(:ncol,:) + vmr_grps(i)%multipler(j)*vmr(:ncol,:,spc_ndx) + enddo + call outfld( vmr_grps(i)%name, group_sum(:ncol,:), ncol, lchnk ) + end do + do i = 1, n_mmr_grps + ! look up the corresponding species index ... + group_sum(:,:) = 0._r8 + do j = 1, mmr_grps(i)%nmembers + spc_name = mmr_grps(i)%term(j) + spc_ndx = get_spc_ndx( spc_name ) + if ( spc_ndx < 1 ) then + call endrun('species_sums_output species name not found : '//trim(spc_name)) + endif + group_sum(:ncol,:) = group_sum(:ncol,:) + mmr_grps(i)%multipler(j)*mmr(:ncol,:,spc_ndx) + enddo + call outfld( mmr_grps(i)%name, group_sum(:ncol,:), ncol, lchnk ) + end do + + end subroutine species_sums_output + +end module species_sums_diags diff --git a/src/chemistry/mozart/spehox.F90 b/src/chemistry/mozart/spehox.F90 new file mode 100644 index 0000000000..8cadb886f8 --- /dev/null +++ b/src/chemistry/mozart/spehox.F90 @@ -0,0 +1,188 @@ +module spehox + +!----------------------------------------------------------------------- +! +! BOP +! +! !MODULE: spedata +! +! !DESCRIPTION +! Determines the HOx production factor assoctioned with +! solar proton ionization. +! +! !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private ! all unless made public + save + + public hox_prod_factor + +! !REVISION HISTORY: +! 17 Nov 2005 Francis Vitt Creation +! +! EOP +!----------------------------------------------------------------------- +! $Id: spehox.F90,v 1.1.2.1 2006/05/03 20:53:09 stacy Exp $ +! $Author: stacy $ +!----------------------------------------------------------------------- +! HOx production per ion pair (cm^-3 s-1) from Figure 2 +! of Solomon et al. (1981) +! +! Data source: +! Dr. Charles H. Jackman, Code 916 +! NASA/Goddard Space Flight Center +! Greenbelt, MD 20771 +! ph:301-614-6053 fx:301-614-5903 Charles.H.Jackman@nasa.gov +! +! Alt(km) 10 100 1000 10000 100000 +! +! 40.0 2.00 2.00 2.00 1.99 1.99 +! 42.5 2.00 2.00 1.99 1.99 1.99 +! 45.0 2.00 2.00 1.99 1.99 1.99 +! 47.5 2.00 2.00 1.99 1.99 1.98 +! 50.0 2.00 1.99 1.99 1.98 1.98 +! 52.5 2.00 1.99 1.99 1.98 1.95 +! 55.0 2.00 1.99 1.98 1.97 1.93 +! 57.5 2.00 1.99 1.98 1.95 1.89 +! 60.0 1.99 1.98 1.97 1.94 1.85 +! 62.5 1.99 1.98 1.96 1.90 1.81 +! 65.0 1.99 1.98 1.94 1.87 1.77 +! 67.5 1.98 1.96 1.91 1.82 1.72 +! 70.0 1.98 1.94 1.87 1.77 1.64 +! 72.5 1.96 1.90 1.80 1.70 1.50 +! 75.0 1.93 1.84 1.73 1.60 1.30 +! 77.5 1.84 1.72 1.60 1.40 0.93 +! 80.0 1.60 1.40 1.20 0.95 0.40 +! 82.5 0.80 0.60 0.40 0.15 0.00 +! 85.0 0.30 0.15 0.10 0.00 0.00 +! 87.5 0.00 0.00 0.00 0.00 0.00 +! 90.0 0.00 0.00 0.00 0.00 0.00 +!----------------------------------------------------------------------- + + integer, parameter :: nalts = 21 + integer, parameter :: nprods = 5 + real(r8) :: alts(nalts) + real(r8) :: log_ion_prod(nprods) + real(r8) :: factor_tbl(nalts,nprods) + + data alts(1:21) / 40.0_r8, 42.5_r8, 45.0_r8, 47.5_r8, 50.0_r8, 52.5_r8, 55.0_r8, 57.5_r8, & + 60.0_r8, 62.5_r8, 65.0_r8, 67.5_r8, 70.0_r8, 72.5_r8, 75.0_r8, 77.5_r8, & + 80.0_r8, 82.5_r8, 85.0_r8, 87.5_r8, 90.0_r8 / + + data log_ion_prod(1:5) / 1._r8, 2._r8, 3._r8, 4._r8, 5._r8 / + + data factor_tbl( 1,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 / + data factor_tbl( 2,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 / + data factor_tbl( 3,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 / + data factor_tbl( 4,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 / + data factor_tbl( 5,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 / + data factor_tbl( 6,1:5) / 2.00_r8, 1.99_r8, 1.99_r8, 1.98_r8, 1.95_r8 / + data factor_tbl( 7,1:5) / 2.00_r8, 1.99_r8, 1.98_r8, 1.97_r8, 1.93_r8 / + data factor_tbl( 8,1:5) / 2.00_r8, 1.99_r8, 1.98_r8, 1.95_r8, 1.89_r8 / + data factor_tbl( 9,1:5) / 1.99_r8, 1.98_r8, 1.97_r8, 1.94_r8, 1.85_r8 / + data factor_tbl(10,1:5) / 1.99_r8, 1.98_r8, 1.96_r8, 1.90_r8, 1.81_r8 / + data factor_tbl(11,1:5) / 1.99_r8, 1.98_r8, 1.94_r8, 1.87_r8, 1.77_r8 / + data factor_tbl(12,1:5) / 1.98_r8, 1.96_r8, 1.91_r8, 1.82_r8, 1.72_r8 / + data factor_tbl(13,1:5) / 1.98_r8, 1.94_r8, 1.87_r8, 1.77_r8, 1.64_r8 / + data factor_tbl(14,1:5) / 1.96_r8, 1.90_r8, 1.80_r8, 1.70_r8, 1.50_r8 / + data factor_tbl(15,1:5) / 1.93_r8, 1.84_r8, 1.73_r8, 1.60_r8, 1.30_r8 / + data factor_tbl(16,1:5) / 1.84_r8, 1.72_r8, 1.60_r8, 1.40_r8, 0.93_r8 / + data factor_tbl(17,1:5) / 1.60_r8, 1.40_r8, 1.20_r8, 0.95_r8, 0.40_r8 / + data factor_tbl(18,1:5) / 0.80_r8, 0.60_r8, 0.40_r8, 0.15_r8, 0.00_r8 / + data factor_tbl(19,1:5) / 0.30_r8, 0.15_r8, 0.10_r8, 0.00_r8, 0.00_r8 / + data factor_tbl(20,1:5) / 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 / + data factor_tbl(21,1:5) / 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 / + +contains + +!----------------------------------------------------------------------- +! Returns the HOx production factor for the ionization profile +!----------------------------------------------------------------------- + function hox_prod_factor( ion_pairs, zmid ) + + use ppgrid, only : pver + ! for each level interpolate the factor table + + implicit none + + real(r8),intent(in) :: ion_pairs(pver) + real(r8),intent(in) :: zmid(pver) + real(r8) :: hox_prod_factor(pver) + + integer :: k + integer :: lastk + + + lastk = 1 + + ! start at the bottom since the table goes from bottom to top + do k = pver,1,-1 + hox_prod_factor(k) = interp_factor_tbl( ion_pairs(k), zmid(k), lastk ) + enddo + + end function hox_prod_factor + +!----------------------------------------------------------------------- +! bilinear interpolates the above table of factors +!----------------------------------------------------------------------- + function interp_factor_tbl( ionp, z, lastk ) + + implicit none + + real(r8),intent(in) :: ionp + real(r8),intent(in) :: z + integer, intent(inout) :: lastk + real(r8) :: interp_factor_tbl + + integer :: i + real(r8) :: logp + real(r8) :: atlwgt1,atlwgt2 + real(r8) :: prodwgt1,prodwgt2 + real(r8) :: fact(nprods) + + if (ionp <= 0._r8 ) then + interp_factor_tbl = 0._r8 + return + endif + + ! interpolate log10 of the ionization rate since the table is + ! on a log scale. + logp = log10(ionp) + + if ( z <= alts(1) ) then + fact(:) = factor_tbl(1,:) + else if ( z >= alts(nalts) ) then + fact(:) = factor_tbl(nalts,:) + else + do i = lastk,nalts + if ( z > alts(i) .and. z <= alts(i+1) ) then + atlwgt1 = (alts(i+1) - z)/(alts(i+1) - alts(i)) + atlwgt2 = (z - alts(i))/(alts(i+1) - alts(i)) + fact(:) = atlwgt1*factor_tbl(i,:) + atlwgt2*factor_tbl(i+1,:) + lastk = i + exit + endif + enddo + endif + + if ( logp <= log_ion_prod(1) ) then + interp_factor_tbl = fact(1) + else if ( logp >= log_ion_prod(nprods) ) then + interp_factor_tbl = fact(nprods) + else + do i = 1,nprods + if ( logp > log_ion_prod(i) .and. logp <= log_ion_prod(i+1) ) then + prodwgt1 = (log_ion_prod(i+1) - logp)/(log_ion_prod(i+1) - log_ion_prod(i)) + prodwgt2 = (logp - log_ion_prod(i))/(log_ion_prod(i+1) - log_ion_prod(i)) + interp_factor_tbl = prodwgt1*fact(i) + prodwgt2*fact(i+1) + exit + endif + enddo + endif + + end function interp_factor_tbl + +end module spehox diff --git a/src/chemistry/mozart/sums_utils.F90 b/src/chemistry/mozart/sums_utils.F90 new file mode 100644 index 0000000000..e0dcb339e9 --- /dev/null +++ b/src/chemistry/mozart/sums_utils.F90 @@ -0,0 +1,125 @@ +!------------------------------------------------------------------- +! shared utilities for diagnostics summations +!------------------------------------------------------------------- +module sums_utils + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : CL => SHR_KIND_CL + use shr_kind_mod, only : CXX => SHR_KIND_CXX + + implicit none + + !------------------------------------------------------------------- + ! object which holds the terms of a summation + !------------------------------------------------------------------- + type sums_grp_t + character(len=64) :: name + integer :: nmembers = 0 + character(len=64), allocatable :: term(:) + real(r8), allocatable :: multipler(:) + endtype sums_grp_t + +contains + + !------------------------------------------------------------------- + ! parses summation strings + !------------------------------------------------------------------- + subroutine parse_sums(sums, ngrps, grps) + + character(len=CL), intent(in ) :: sums(:) + integer, intent(out) :: ngrps + type(sums_grp_t), allocatable, intent(out) :: grps(:) + + integer :: ndxs(512) + integer :: nelem, i,j,k + character(len=CXX) :: tmp_str, tmp_name + + character(len=8) :: xchr ! multipler + real(r8) :: xdbl + + logical :: more_to_come + integer, parameter :: maxgrps = 100 + character(len=CXX) :: sums_grps(maxgrps) + + character(len=CXX) :: sum_string + + sums_grps(:) = ' ' + + ! combine lines that have a trailing "+" with the next line + i=1 + j=1 + do while( len_trim(sums(i)) > 0 ) + + k = scan(sums(i), '+', back=.true. ) + more_to_come = k == len_trim(sums(i)) ! line ends with "+" + + if ( more_to_come ) then + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(sums(i))) + else + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(sums(i))) + j = j+1 + endif + i = i+1 + + end do + + ngrps = j-1 + + ! a group is a summation of terms + + ! parse the individual sum strings... and form the groupings + has_grps: if (ngrps>0) then + + allocate( grps(ngrps) ) + + ! from shr_megan_mod ... should be generalized and shared... + grploop: do i = 1,ngrps + + ! parse out the term names + ! from first parsing out the terms in the summation equation ("+" separates the terms) + + sum_string = sums_grps(i) + j = scan( sum_string, '=' ) + nelem = 1 + ndxs(nelem) = j ! ndxs stores the index of each term of the equation + + ! find indices of all the terms in the equation + tmp_str = trim( sum_string(j+1:) ) + j = scan( tmp_str, '+' ) + do while(j>0) + nelem = nelem+1 + ndxs(nelem) = ndxs(nelem-1) + j + tmp_str = tmp_str(j+1:) + j = scan( tmp_str, '+' ) + enddo + ndxs(nelem+1) = len(sum_string)+1 + + grps(i)%nmembers = nelem ! number of terms + grps(i)%name = trim(adjustl( sum_string(:ndxs(1)-1))) ! thing to the left of the "=" is used as the name of the group + + ! now that we have the number of terms in the summation allocate memory for the terms + allocate(grps(i)%term(nelem)) + allocate(grps(i)%multipler(nelem)) + + ! now parse out the multiplier from the terms + elmloop: do k = 1,nelem + + grps(i)%multipler(k) = 1._r8 + ! get the term name which follows the '*' operator if the is one + tmp_name = adjustl(sum_string(ndxs(k)+1:ndxs(k+1)-1)) + j = scan( tmp_name, '*' ) + if (j>0) then + xchr = tmp_name(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + grps(i)%multipler(k) = xdbl ! store the multiplier + tmp_name = adjustl(tmp_name(j+1:)) ! get the term name (right of the '*') + endif + grps(i)%term(k) = trim(tmp_name) + + enddo elmloop + enddo grploop + endif has_grps + + end subroutine parse_sums + + +end module sums_utils diff --git a/src/chemistry/mozart/sv_decomp.F90 b/src/chemistry/mozart/sv_decomp.F90 new file mode 100644 index 0000000000..0540f1f575 --- /dev/null +++ b/src/chemistry/mozart/sv_decomp.F90 @@ -0,0 +1,364 @@ +!------------------------------------------------------------------------- +! purpose: singular value decomposition +! +! method: +! given a matrix a(1:m,1:n), with physical dimensions mp by np, +! this routine computes its singular value decomposition, +! the matrix u replaces a on output. the +! diagonal matrix of singular values w is output as a vector +! w(1:n). the matrix v (not the transpose v^t) is output as +! v(1:n,1:n). +! +! author: a. maute dec 2003 +! (* copyright (c) 1985 numerical recipes software -- svdcmp *! +! from numerical recipes 1986 pp. 60 or can be find on web-sites +!------------------------------------------------------------------------- + + module sv_decomp + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: svdcmp + public :: svbksb + + integer, parameter :: nmax = 1600 + + contains + + subroutine svdcmp( a, m, n, mp, np, w, v ) +!------------------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------------------- + integer, intent(in) :: m + integer, intent(in) :: n + integer, intent(in) :: mp + integer, intent(in) :: np + real(r8), intent(inout) :: a(mp,np) + real(r8), intent(out) :: v(np,np) + real(r8), intent(out) :: w(np) + +!------------------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------------------- + integer :: i, its, j, k, l, nm + real(r8) :: anorm + real(r8) :: c + real(r8) :: f + real(r8) :: g + real(r8) :: h + real(r8) :: s + real(r8) :: scale + real(r8) :: x, y, z + real(r8) :: rv1(nmax) + logical :: cnd1 + logical :: cnd2 + + g = 0.0_r8 + scale = 0.0_r8 + anorm = 0.0_r8 + +loop1 : & + do i = 1,n + l = i + 1 + rv1(i) = scale*g + g = 0.0_r8 + s = 0.0_r8 + scale = 0.0_r8 + if( i <= m ) then + do k = i,m + scale = scale + abs(a(k,i)) + end do + if( scale /= 0.0_r8 ) then + do k = i,m + a(k,i) = a(k,i)/scale + s = s + a(k,i)*a(k,i) + end do + f = a(i,i) + g = -sign(sqrt(s),f) + h = f*g - s + a(i,i) = f - g + if( i /= n ) then + do j = l,n + s = 0.0_r8 + do k = i,m + s = s + a(k,i)*a(k,j) + end do + f = s/h + do k = i,m + a(k,j) = a(k,j) + f*a(k,i) + end do + end do + end if + do k = i,m + a(k,i) = scale*a(k,i) + end do + endif + endif + w(i) = scale *g + g = 0.0_r8 + s = 0.0_r8 + scale = 0.0_r8 + if( i <= m .and. i /= n ) then + do k = l,n + scale = scale + abs(a(i,k)) + end do + if( scale /= 0.0_r8 ) then + do k = l,n + a(i,k) = a(i,k)/scale + s = s + a(i,k)*a(i,k) + end do + f = a(i,l) + g = -sign(sqrt(s),f) + h = f*g - s + a(i,l) = f - g + do k = l,n + rv1(k) = a(i,k)/h + end do + if( i /= m ) then + do j = l,m + s = 0.0_r8 + do k = l,n + s = s + a(j,k)*a(i,k) + end do + do k = l,n + a(j,k) = a(j,k) + s*rv1(k) + end do + end do + end if + do k = l,n + a(i,k) = scale*a(i,k) + end do + end if + end if + anorm = max( anorm,(abs(w(i)) + abs(rv1(i))) ) + end do loop1 + + do i = n,1,-1 + if( i < n ) then + if( g /= 0.0_r8 ) then + do j = l,n + v(j,i) = (a(i,j)/a(i,l))/g + end do + do j = l,n + s = 0.0_r8 + do k = l,n + s = s + a(i,k)*v(k,j) + end do + do k = l,n + v(k,j) = v(k,j) + s*v(k,i) + end do + end do + end if + do j = l,n + v(i,j) = 0.0_r8 + v(j,i) = 0.0_r8 + end do + end if + v(i,i) = 1.0_r8 + g = rv1(i) + l = i + end do + + do i = n,1,-1 + l = i + 1 + g = w(i) + if( i < n ) then + do j = l,n + a(i,j) = 0.0_r8 + end do + end if + if( g /= 0.0_r8 ) then + g = 1.0_r8/g + if( i /= n ) then + do j = l,n + s = 0.0_r8 + do k = l,m + s = s + a(k,i)*a(k,j) + end do + f = (s/a(i,i))*g + do k = i,m + a(k,j) = a(k,j) + f*a(k,i) + end do + end do + end if + do j = i,m + a(j,i) = a(j,i)*g + end do + else + do j = i,m + a(j,i) = 0.0_r8 + end do + end if + a(i,i) = a(i,i) + 1.0_r8 + end do + + do k = n,1,-1 +loop2 : do its = 1,30 + do l = k,1,-1 + nm = l - 1 + cnd1 = abs( rv1(l) ) + anorm == anorm + if( cnd1 ) then + cnd2 = .false. + exit + end if + cnd2 = abs( w(nm) ) + anorm == anorm + if( cnd2 ) then + cnd1 = .true. + exit + else if( l == 1 ) then + cnd1 = .true. + cnd2 = .true. + end if + end do + + if( cnd2 ) then + c = 0.0_r8 + s = 1.0_r8 + do i = l,k + f = s*rv1(i) + if( (abs(f) + anorm) /= anorm ) then + g = w(i) + h = sqrt(f*f + g*g) + w(i) = h + h = 1.0_r8/h + c = (g*h) + s = -(f*h) + do j = 1,m + y = a(j,nm) + z = a(j,i) + a(j,nm) = (y*c) + (z*s) + a(j,i) = -(y*s) + (z*c) + end do + end if + end do + end if + + if( cnd1 ) then + z = w(k) + if( l == k ) then + if( z < 0.0_r8 ) then + w(k) = -z + do j = 1,n + v(j,k) = -v(j,k) + end do + end if + exit loop2 + end if + end if + + x = w(l) + nm = k - 1 + y = w(nm) + g = rv1(nm) + h = rv1(k) + f = ((y - z)*(y + z) + (g - h)*(g + h))/(2.0_r8*h*y) + g = sqrt( f*f + 1.0_r8 ) + f = ((x - z)*(x + z) + h*((y/(f + sign(g,f))) - h))/x + c = 1.0_r8 + s = 1.0_r8 + do j = l,nm + i = j + 1 + g = rv1(i) + y = w(i) + h = s*g + g = c*g + z = sqrt( f*f + h*h ) + rv1(j) = z + c = f/z + s = h/z + f = (x*c)+(g*s) + g = -(x*s)+(g*c) + h = y*s + y = y*c + do nm = 1,n + x = v(nm,j) + z = v(nm,i) + v(nm,j) = (x*c)+(z*s) + v(nm,i) = -(x*s)+(z*c) + end do + z = sqrt( f*f + h*h ) + w(j) = z + if( z /= 0.0_r8 ) then + z = 1.0_r8/z + c = f*z + s = h*z + end if + f = (c*g)+(s*y) + x = -(s*g)+(c*y) + do nm = 1,m + y = a(nm,j) + z = a(nm,i) + a(nm,j) = (y*c)+(z*s) + a(nm,i) = -(y*s)+(z*c) + end do + end do + rv1(l) = 0.0_r8 + rv1(k) = f + w(k) = x + end do loop2 + end do + + end subroutine svdcmp + +!------------------------------------------------------------------------- +! purpose: solves a*x = b +! +! method: +! solves a*x = b for a vector x, where a is specified by the arrays +! u,w,v as returned by svdcmp. m and n +! are the logical dimensions of a, and will be equal for square matrices. +! mp and np are the physical dimensions of a. b(1:m) is the input right-hand +! side. x(1:n) is the output solution vector. no input quantities are +! destroyed, so the routine may be called sequentially with different b +! +! author: a. maute dec 2002 +! (* copyright (c) 1985 numerical recipes software -- svbksb *! +! from numerical recipes 1986 pp. 57 or can be find on web-sites +!------------------------------------------------------------------------- + + subroutine svbksb( u, w, v, m, n, mp, np, b, x ) +!------------------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------------------- + integer, intent(in) :: m + integer, intent(in) :: n + integer, intent(in) :: mp + integer, intent(in) :: np + real(r8), intent(in) :: u(mp,np) + real(r8), intent(in) :: w(np) + real(r8), intent(in) :: v(np,np) + real(r8), intent(in) :: b(mp) + real(r8), intent(out) :: x(np) + +!------------------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------------------- + integer :: i, j, jj + real(r8) :: s + real(r8) :: tmp(nmax) + + do j = 1,n + s = 0._r8 + if( w(j) /= 0._r8 ) then + do i = 1,m + s = s + u(i,j)*b(i) + end do + s = s/w(j) + endif + tmp(j) = s + end do + + do j = 1,n + s = 0._r8 + do jj = 1,n + s = s + v(j,jj)*tmp(jj) + end do + x(j) = s + end do + + end subroutine svbksb + + end module sv_decomp diff --git a/src/chemistry/mozart/tracer_cnst.F90 b/src/chemistry/mozart/tracer_cnst.F90 new file mode 100644 index 0000000000..803e3e1061 --- /dev/null +++ b/src/chemistry/mozart/tracer_cnst.F90 @@ -0,0 +1,371 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of offline tracer fields +! Created by: Francis Vitt -- 2 May 2006 +!------------------------------------------------------------------- +module tracer_cnst + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld,trfile,MAXTRCRS + use cam_logfile, only : iulog + + implicit none + + private ! all unless made public + save + + public :: tracer_cnst_init + public :: num_tracer_cnst + public :: tracer_cnst_flds + public :: tracer_cnst_adv + public :: get_cnst_data + public :: get_cnst_data_ptr + public :: write_tracer_cnst_restart + public :: read_tracer_cnst_restart + public :: tracer_cnst_defaultopts + public :: tracer_cnst_setopts + public :: init_tracer_cnst_restart + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + integer :: num_tracer_cnst + character(len=16), pointer :: tracer_cnst_flds(:) => null() + real(r8), allocatable, target, dimension(:,:,:,:) :: data_q ! constituent mass mixing ratios + + character(len=64) :: specifier(MAXTRCRS) = '' + character(len=256) :: filename = 'tracer_cnst_file' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: data_type = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_cnst_init() + + use mo_chem_utls,only : get_inv_ndx + use tracer_data, only : trcdata_init + use cam_history, only : addfld + use error_messages, only: handle_err + use ppgrid, only: pcols, pver, begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + implicit none + + integer :: i ,ndx, istat + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type) + + num_tracer_cnst = 0 + if (associated(fields)) num_tracer_cnst = size( fields ) + + if( num_tracer_cnst < 1 ) then + if ( masterproc ) then + write(iulog,*) 'There are no offline invariant species' + write(iulog,*) ' ' + endif + return + end if + + allocate( tracer_cnst_flds(num_tracer_cnst), stat=istat) + call handle_err(istat, 'tracer_cnst_init: ERROR allocating tracer_cnst_flds') + + + do i = 1, num_tracer_cnst + + ndx = get_inv_ndx( fields(i)%fldnam ) + + if (ndx < 1) then + write(iulog,*) fields(i)%fldnam//' is not an invariant' + call endrun('tracer_cnst_init') + endif + + tracer_cnst_flds(i) = fields(i)%fldnam + + call addfld(trim(fields(i)%fldnam), (/ 'lev' /), & + 'I','mol/mol', 'prescribed tracer constituent' ) + enddo + + allocate(data_q(pcols,pver,num_tracer_cnst,begchunk:endchunk), stat=istat) + call handle_err(istat, 'tracer_cnst_init: ERROR allocating data_q') + + end subroutine tracer_cnst_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_cnst_setopts( & + tracer_cnst_file_in, & + tracer_cnst_filelist_in, & + tracer_cnst_datapath_in, & + tracer_cnst_type_in, & + tracer_cnst_specifier_in, & + tracer_cnst_rmfile_in, & + tracer_cnst_cycle_yr_in, & + tracer_cnst_fixed_ymd_in, & + tracer_cnst_fixed_tod_in & + ) + + implicit none + + character(len=*), intent(in), optional :: tracer_cnst_file_in + character(len=*), intent(in), optional :: tracer_cnst_filelist_in + character(len=*), intent(in), optional :: tracer_cnst_datapath_in + character(len=*), intent(in), optional :: tracer_cnst_type_in + character(len=*), intent(in), optional :: tracer_cnst_specifier_in(:) + logical, intent(in), optional :: tracer_cnst_rmfile_in + integer, intent(in), optional :: tracer_cnst_cycle_yr_in + integer, intent(in), optional :: tracer_cnst_fixed_ymd_in + integer, intent(in), optional :: tracer_cnst_fixed_tod_in + + if ( present(tracer_cnst_file_in) ) then + filename = tracer_cnst_file_in + endif + if ( present(tracer_cnst_filelist_in) ) then + filelist = tracer_cnst_filelist_in + endif + if ( present(tracer_cnst_datapath_in) ) then + datapath = tracer_cnst_datapath_in + endif + if ( present(tracer_cnst_type_in) ) then + data_type = tracer_cnst_type_in + endif + if ( present(tracer_cnst_specifier_in) ) then + specifier = tracer_cnst_specifier_in + endif + if ( present(tracer_cnst_rmfile_in) ) then + rmv_file = tracer_cnst_rmfile_in + endif + if ( present(tracer_cnst_cycle_yr_in) ) then + cycle_yr = tracer_cnst_cycle_yr_in + endif + if ( present(tracer_cnst_fixed_ymd_in) ) then + fixed_ymd = tracer_cnst_fixed_ymd_in + endif + if ( present(tracer_cnst_fixed_tod_in) ) then + fixed_tod = tracer_cnst_fixed_tod_in + endif + + endsubroutine tracer_cnst_setopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_cnst_defaultopts( & + tracer_cnst_file_out, & + tracer_cnst_filelist_out, & + tracer_cnst_datapath_out, & + tracer_cnst_type_out, & + tracer_cnst_specifier_out,& + tracer_cnst_rmfile_out, & + tracer_cnst_cycle_yr_out, & + tracer_cnst_fixed_ymd_out,& + tracer_cnst_fixed_tod_out & + ) + + implicit none + + character(len=*), intent(out), optional :: tracer_cnst_file_out + character(len=*), intent(out), optional :: tracer_cnst_filelist_out + character(len=*), intent(out), optional :: tracer_cnst_datapath_out + character(len=*), intent(out), optional :: tracer_cnst_type_out + character(len=*), intent(out), optional :: tracer_cnst_specifier_out(:) + logical, intent(out), optional :: tracer_cnst_rmfile_out + integer, intent(out), optional :: tracer_cnst_cycle_yr_out + integer, intent(out), optional :: tracer_cnst_fixed_ymd_out + integer, intent(out), optional :: tracer_cnst_fixed_tod_out + + if ( present(tracer_cnst_file_out) ) then + tracer_cnst_file_out = filename + endif + if ( present(tracer_cnst_filelist_out) ) then + tracer_cnst_filelist_out = filelist + endif + if ( present(tracer_cnst_datapath_out) ) then + tracer_cnst_datapath_out = datapath + endif + if ( present(tracer_cnst_type_out) ) then + tracer_cnst_type_out = data_type + endif + if ( present(tracer_cnst_specifier_out) ) then + tracer_cnst_specifier_out = specifier + endif + if ( present(tracer_cnst_rmfile_out) ) then + tracer_cnst_rmfile_out = rmv_file + endif + if ( present(tracer_cnst_cycle_yr_out) ) then + tracer_cnst_cycle_yr_out = cycle_yr + endif + if ( present(tracer_cnst_fixed_ymd_out) ) then + tracer_cnst_fixed_ymd_out = fixed_ymd + endif + if ( present(tracer_cnst_fixed_tod_out) ) then + tracer_cnst_fixed_tod_out = fixed_tod + endif + + endsubroutine tracer_cnst_defaultopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_cnst_adv( pbuf2d, state ) + + use physics_buffer, only : physics_buffer_desc + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use chem_mods, only : fix_mass + use mo_chem_utls, only : get_inv_ndx + use cam_history, only : outfld + use physconst, only: mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only: boltz + + implicit none + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: i,ind,c,ncol + real(r8) :: to_vmr(pcols,pver) + + if( num_tracer_cnst < 1 ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! copy prescribed tracer fields into state variable with the correct units + + do i = 1,num_tracer_cnst + ind = get_inv_ndx( tracer_cnst_flds(i) ) + do c = begchunk,endchunk + ncol = state(c)%ncol + + select case ( to_lower(trim(fields(i)%units(:GLC(fields(i)%units)))) ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_vmr(:ncol,:) = (1.e6_r8*boltz*state(c)%t(:ncol,:))/(state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr') + to_vmr(:ncol,:) = mwdry/fix_mass(ind) + case ('mol/mol','mole/mole','vmr') + to_vmr(:ncol,:) = 1._r8 + case default + write(iulog,*) 'tracer_cnst_adv: units = ',trim(fields(i)%units) ,' are not recognized' + call endrun('tracer_cnst_adv: units are not recognized') + end select + + fields(i)%data(:ncol,:,c) = to_vmr(:ncol,:) * fields(i)%data(:ncol,:,c) ! vmr + call outfld( trim(tracer_cnst_flds(i)), fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk ) + + enddo + enddo + + end subroutine tracer_cnst_adv + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_cnst_data( field_name, data, ncol, lchnk, pbuf ) + + use tracer_data, only : get_fld_data + use physics_buffer, only : physics_buffer_desc + + implicit none + + character(len=*), intent(in) :: field_name + real(r8), intent(out) :: data(:,:) + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + if( num_tracer_cnst < 1 ) return + + call get_fld_data( fields, field_name, data, ncol, lchnk, pbuf ) + + end subroutine get_cnst_data + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_cnst_data_ptr(name, state, q, pbuf) + + use tracer_data, only : get_fld_data, get_fld_ndx + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use chem_mods, only : fix_mass + use mo_chem_utls, only : get_inv_ndx + use physics_types, only : physics_state + use ppgrid, only : pcols, pver + use physics_buffer, only : physics_buffer_desc + + implicit none + + character(len=*), intent(in) :: name + type(physics_state), intent(in) :: state + real(r8), pointer, dimension(:,:) :: q ! constituent mass mixing ratio + type(physics_buffer_desc), pointer :: pbuf(:) + + integer :: lchnk + integer :: ncol + integer :: inv_id, idx + + lchnk = state%lchnk + ncol = state%ncol + + ! make sure the requested constituent can be provided + inv_id = get_inv_ndx(name) + if (.not. inv_id > 0) then + if (masterproc) then + write(iulog,*) 'get_cnst_data_ptr: '//name//' is not a prescribed tracer constituent' + endif + return + endif + + + call get_fld_ndx( fields, name, idx ) + call get_fld_data( fields, name, data_q(:,:,idx,lchnk), ncol, lchnk, pbuf ) + + data_q(:ncol,:,idx,lchnk) = data_q(:ncol,:,idx,lchnk)*fix_mass(inv_id)/mwdry ! vmr->mmr + q => data_q(:,:,idx,lchnk) + + end subroutine get_cnst_data_ptr + +!------------------------------------------------------------------- + + subroutine init_tracer_cnst_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'tracer_cnst', piofile, file ) + + end subroutine init_tracer_cnst_restart +!------------------------------------------------------------------- + subroutine write_tracer_cnst_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_tracer_cnst_restart + +!------------------------------------------------------------------- + subroutine read_tracer_cnst_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call read_trc_restart( 'tracer_cnst', piofile, file ) + + end subroutine read_tracer_cnst_restart + +end module tracer_cnst diff --git a/src/chemistry/mozart/tracer_srcs.F90 b/src/chemistry/mozart/tracer_srcs.F90 new file mode 100644 index 0000000000..bec087e581 --- /dev/null +++ b/src/chemistry/mozart/tracer_srcs.F90 @@ -0,0 +1,296 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of offline tracer sources +! Created by: Francis Vitt -- 2 May 2006 +!------------------------------------------------------------------- +module tracer_srcs + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + + use tracer_data, only : trfld,trfile,MAXTRCRS + use cam_logfile, only : iulog + + implicit none + + private ! all unless made public + save + + public :: tracer_srcs_init + public :: num_tracer_srcs + public :: tracer_src_flds + public :: tracer_srcs_adv + public :: get_srcs_data + public :: write_tracer_srcs_restart + public :: read_tracer_srcs_restart + public :: tracer_srcs_defaultopts + public :: tracer_srcs_setopts + public :: init_tracer_srcs_restart + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + integer :: num_tracer_srcs + character(len=16), allocatable :: tracer_src_flds(:) + + character(len=64) :: specifier(MAXTRCRS) = '' + character(len=256) :: filename = 'tracer_srcs_file' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: data_type = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_srcs_init() + + use mo_chem_utls, only : get_extfrc_ndx + use tracer_data, only : trcdata_init + use cam_history, only : addfld + + implicit none + + integer :: i ,ndx + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type) + + num_tracer_srcs = 0 + if (associated(fields)) num_tracer_srcs = size( fields ) + + if( num_tracer_srcs < 1 ) then + + if (masterproc) then + write(iulog,*) 'There are no offline tracer sources' + write(iulog,*) ' ' + end if + return + end if + + allocate( tracer_src_flds(num_tracer_srcs)) + + do i = 1, num_tracer_srcs + + ndx = get_extfrc_ndx( fields(i)%fldnam ) + + if (ndx < 1) then + write(iulog,*) fields(i)%fldnam//' is not configured to have an external source' + call endrun('tracer_srcs_init') + endif + + tracer_src_flds(i) = fields(i)%fldnam + + call addfld(trim(fields(i)%fldnam)//'_trsrc', (/ 'lev' /), 'I','/cm3/s', 'tracer source rate' ) + + enddo + + end subroutine tracer_srcs_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_srcs_setopts( & + tracer_srcs_file_in, & + tracer_srcs_filelist_in, & + tracer_srcs_datapath_in, & + tracer_srcs_type_in, & + tracer_srcs_specifier_in, & + tracer_srcs_rmfile_in, & + tracer_srcs_cycle_yr_in, & + tracer_srcs_fixed_ymd_in, & + tracer_srcs_fixed_tod_in & + ) + + implicit none + + character(len=*), intent(in), optional :: tracer_srcs_file_in + character(len=*), intent(in), optional :: tracer_srcs_filelist_in + character(len=*), intent(in), optional :: tracer_srcs_datapath_in + character(len=*), intent(in), optional :: tracer_srcs_type_in + character(len=*), intent(in), optional :: tracer_srcs_specifier_in(:) + logical, intent(in), optional :: tracer_srcs_rmfile_in + integer, intent(in), optional :: tracer_srcs_cycle_yr_in + integer, intent(in), optional :: tracer_srcs_fixed_ymd_in + integer, intent(in), optional :: tracer_srcs_fixed_tod_in + + if ( present(tracer_srcs_file_in) ) then + filename = tracer_srcs_file_in + endif + if ( present(tracer_srcs_filelist_in) ) then + filelist = tracer_srcs_filelist_in + endif + if ( present(tracer_srcs_datapath_in) ) then + datapath = tracer_srcs_datapath_in + endif + if ( present(tracer_srcs_type_in) ) then + data_type = tracer_srcs_type_in + endif + if ( present(tracer_srcs_specifier_in) ) then + specifier = tracer_srcs_specifier_in + endif + if ( present(tracer_srcs_rmfile_in) ) then + rmv_file = tracer_srcs_rmfile_in + endif + if ( present(tracer_srcs_cycle_yr_in) ) then + cycle_yr = tracer_srcs_cycle_yr_in + endif + if ( present(tracer_srcs_fixed_ymd_in) ) then + fixed_ymd = tracer_srcs_fixed_ymd_in + endif + if ( present(tracer_srcs_fixed_tod_in) ) then + fixed_tod = tracer_srcs_fixed_tod_in + endif + + endsubroutine tracer_srcs_setopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_srcs_defaultopts( & + tracer_srcs_file_out, & + tracer_srcs_filelist_out, & + tracer_srcs_datapath_out, & + tracer_srcs_type_out, & + tracer_srcs_specifier_out,& + tracer_srcs_rmfile_out, & + tracer_srcs_cycle_yr_out, & + tracer_srcs_fixed_ymd_out,& + tracer_srcs_fixed_tod_out & + ) + + implicit none + + character(len=*), intent(out), optional :: tracer_srcs_file_out + character(len=*), intent(out), optional :: tracer_srcs_filelist_out + character(len=*), intent(out), optional :: tracer_srcs_datapath_out + character(len=*), intent(out), optional :: tracer_srcs_type_out + character(len=*), intent(out), optional :: tracer_srcs_specifier_out(:) + logical, intent(out), optional :: tracer_srcs_rmfile_out + integer, intent(out), optional :: tracer_srcs_cycle_yr_out + integer, intent(out), optional :: tracer_srcs_fixed_ymd_out + integer, intent(out), optional :: tracer_srcs_fixed_tod_out + + if ( present(tracer_srcs_file_out) ) then + tracer_srcs_file_out = filename + endif + if ( present(tracer_srcs_filelist_out) ) then + tracer_srcs_filelist_out = filelist + endif + if ( present(tracer_srcs_datapath_out) ) then + tracer_srcs_datapath_out = datapath + endif + if ( present(tracer_srcs_type_out) ) then + tracer_srcs_type_out = data_type + endif + if ( present(tracer_srcs_specifier_out) ) then + tracer_srcs_specifier_out = specifier + endif + if ( present(tracer_srcs_rmfile_out) ) then + tracer_srcs_rmfile_out = rmv_file + endif + if ( present(tracer_srcs_cycle_yr_out) ) then + tracer_srcs_cycle_yr_out = cycle_yr + endif + if ( present(tracer_srcs_fixed_ymd_out) ) then + tracer_srcs_fixed_ymd_out = fixed_ymd + endif + if ( present(tracer_srcs_fixed_tod_out) ) then + tracer_srcs_fixed_tod_out = fixed_tod + endif + + endsubroutine tracer_srcs_defaultopts + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine tracer_srcs_adv( pbuf2d, state ) + + use tracer_data, only : advance_trcdata + use ppgrid, only : begchunk, endchunk + use physics_types,only : physics_state + use cam_history, only : outfld + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: i,c,ncol + + if( num_tracer_srcs < 1 ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + do c = begchunk,endchunk + ncol = state(c)%ncol + do i = 1,num_tracer_srcs + call outfld( trim(fields(i)%fldnam)//'_trsrc', fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk ) + enddo + enddo + + end subroutine tracer_srcs_adv + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_srcs_data( field_name, data, ncol, lchnk, pbuf ) + + use tracer_data, only : get_fld_data + use physics_buffer, only : physics_buffer_desc + + implicit none + + character(len=*), intent(in) :: field_name + real(r8), intent(out) :: data(:,:) + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + if( num_tracer_srcs < 1 ) return + + call get_fld_data( fields, field_name, data, ncol, lchnk, pbuf ) + + end subroutine get_srcs_data + +!------------------------------------------------------------------- + + subroutine init_tracer_srcs_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'tracer_srcs', piofile, file ) + + end subroutine init_tracer_srcs_restart +!------------------------------------------------------------------- + subroutine write_tracer_srcs_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_tracer_srcs_restart + +!------------------------------------------------------------------- + + subroutine read_tracer_srcs_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call read_trc_restart( 'tracer_srcs', piofile, file ) + + end subroutine read_tracer_srcs_restart + + +end module tracer_srcs diff --git a/src/chemistry/mozart/upper_bc.F90 b/src/chemistry/mozart/upper_bc.F90 new file mode 100644 index 0000000000..71a4a65b0c --- /dev/null +++ b/src/chemistry/mozart/upper_bc.F90 @@ -0,0 +1,377 @@ + +module upper_bc + +!--------------------------------------------------------------------------------- +! Module to compute the upper boundary condition for temperature (dry static energy) +! and trace gases. Uses the MSIS model, and SNOE and TIME GCM data. +! +! original code by Stacy Walters +! adapted by B. A. Boville +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod,only: grav => shr_const_g, & ! gravitational constant (m/s^2) + kboltz => shr_const_boltz, & ! Boltzmann constant + pi => shr_const_pi, & ! pi + rEarth => shr_const_rearth ! Earth radius + use ppgrid, only: pcols, pver, pverp + use constituents, only: pcnst + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use ref_pres, only: ptop_ref + + implicit none + private + save +! +! Public interfaces +! + public :: ubc_defaultopts ! set default values of namelist variables + public :: ubc_setopts ! get namelist input + public :: ubc_init ! global initialization + public :: ubc_timestep_init ! time step initialization + public :: ubc_get_vals ! get ubc values for this step + +! Namelist variables + character(len=256) :: snoe_ubc_file = ' ' + real(r8) :: t_pert_ubc = 0._r8 + real(r8) :: no_xfac_ubc = 1._r8 + + character(len=256) :: tgcm_ubc_file = ' ' + integer :: tgcm_ubc_cycle_yr = 0 + integer :: tgcm_ubc_fixed_ymd = 0 + integer :: tgcm_ubc_fixed_tod = 0 + integer :: f_ndx, hf_ndx + character(len=32) :: tgcm_ubc_data_type = 'CYCLICAL' + + logical :: apply_upper_bc = .false. + +!================================================================================================ +contains +!================================================================================================ + +subroutine ubc_defaultopts(tgcm_ubc_file_out, tgcm_ubc_data_type_out, tgcm_ubc_cycle_yr_out, tgcm_ubc_fixed_ymd_out, & + tgcm_ubc_fixed_tod_out, snoe_ubc_file_out, t_pert_ubc_out, no_xfac_ubc_out) +!----------------------------------------------------------------------- +! Purpose: Return default runtime options +!----------------------------------------------------------------------- + + real(r8), intent(out), optional :: t_pert_ubc_out + real(r8), intent(out), optional :: no_xfac_ubc_out + character(len=*), intent(out), optional :: tgcm_ubc_file_out + character(len=*), intent(out), optional :: snoe_ubc_file_out + integer , intent(out), optional :: tgcm_ubc_cycle_yr_out + integer , intent(out), optional :: tgcm_ubc_fixed_ymd_out + integer , intent(out), optional :: tgcm_ubc_fixed_tod_out + character(len=*), intent(out), optional :: tgcm_ubc_data_type_out + +!----------------------------------------------------------------------- + + if ( present(tgcm_ubc_file_out) ) then + tgcm_ubc_file_out = tgcm_ubc_file + endif + if ( present(tgcm_ubc_data_type_out) ) then + tgcm_ubc_data_type_out = tgcm_ubc_data_type + endif + if ( present(tgcm_ubc_cycle_yr_out) ) then + tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr + endif + if ( present(tgcm_ubc_fixed_ymd_out) ) then + tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd + endif + if ( present(tgcm_ubc_fixed_tod_out) ) then + tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod + endif + if ( present(snoe_ubc_file_out) ) then + snoe_ubc_file_out = snoe_ubc_file + endif + if ( present(t_pert_ubc_out) ) then + t_pert_ubc_out = t_pert_ubc + endif + if ( present(no_xfac_ubc_out) ) then + no_xfac_ubc_out = no_xfac_ubc + endif + +end subroutine ubc_defaultopts + +!================================================================================================ + +subroutine ubc_setopts(tgcm_ubc_file_in, tgcm_ubc_data_type_in, tgcm_ubc_cycle_yr_in, tgcm_ubc_fixed_ymd_in, & + tgcm_ubc_fixed_tod_in, snoe_ubc_file_in, t_pert_ubc_in, no_xfac_ubc_in) +!----------------------------------------------------------------------- +! Purpose: Set runtime options +!----------------------------------------------------------------------- + + use cam_abortutils, only : endrun + + real(r8), intent(in), optional :: t_pert_ubc_in + real(r8), intent(in), optional :: no_xfac_ubc_in + character(len=*), intent(in), optional :: tgcm_ubc_file_in + character(len=*), intent(in), optional :: snoe_ubc_file_in + integer , intent(in), optional :: tgcm_ubc_cycle_yr_in + integer , intent(in), optional :: tgcm_ubc_fixed_ymd_in + integer , intent(in), optional :: tgcm_ubc_fixed_tod_in + character(len=*), intent(in), optional :: tgcm_ubc_data_type_in + +!----------------------------------------------------------------------- + + if ( present(tgcm_ubc_file_in) ) then + tgcm_ubc_file = tgcm_ubc_file_in + endif + if ( present(tgcm_ubc_data_type_in) ) then + tgcm_ubc_data_type = tgcm_ubc_data_type_in + endif + if ( present(tgcm_ubc_cycle_yr_in) ) then + tgcm_ubc_cycle_yr = tgcm_ubc_cycle_yr_in + endif + if ( present(tgcm_ubc_fixed_ymd_in) ) then + tgcm_ubc_fixed_ymd = tgcm_ubc_fixed_ymd_in + endif + if ( present(tgcm_ubc_fixed_tod_in) ) then + tgcm_ubc_fixed_tod = tgcm_ubc_fixed_tod_in + endif + if ( present(snoe_ubc_file_in) ) then + snoe_ubc_file = snoe_ubc_file_in + endif + if ( present(t_pert_ubc_in) ) then + t_pert_ubc = t_pert_ubc_in + endif + if ( present(no_xfac_ubc_in) ) then + no_xfac_ubc = no_xfac_ubc_in + if( no_xfac_ubc < 0._r8 ) then + write(iulog,*) 'ubc_setopts: no_xfac_ubc = ',no_xfac_ubc,' must be >= 0' + call endrun + end if + endif + +end subroutine ubc_setopts + +!=============================================================================== + + subroutine ubc_init() +!----------------------------------------------------------------------- +! Initialization of time independent fields for the upper boundary condition +! Calls initialization routine for MSIS, TGCM and SNOE +!----------------------------------------------------------------------- + use mo_tgcm_ubc, only: tgcm_ubc_inti + use mo_snoe, only: snoe_inti + use mo_msis_ubc, only: msis_ubc_inti + use constituents,only: cnst_get_ind + +!---------------------------Local workspace----------------------------- + logical :: zonal_avg +!----------------------------------------------------------------------- + apply_upper_bc = ptop_ref<1._r8 ! Pa + + if (.not.apply_upper_bc) return + + call cnst_get_ind('F', f_ndx, abort=.false.) + call cnst_get_ind('HF', hf_ndx, abort=.false.) + + zonal_avg = .false. + +!----------------------------------------------------------------------- +! ... initialize the tgcm upper boundary module +!----------------------------------------------------------------------- + call tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod) + if (masterproc) write(iulog,*) 'ubc_init: after tgcm_ubc_inti' + +!----------------------------------------------------------------------- +! ... initialize the snoe module +!----------------------------------------------------------------------- + call snoe_inti(snoe_ubc_file) + if (masterproc) write(iulog,*) 'ubc_init: after snoe_inti' + +!----------------------------------------------------------------------- +! ... initialize the msis module +!----------------------------------------------------------------------- + call msis_ubc_inti( zonal_avg ) + if (masterproc) write(iulog,*) 'ubc_init: after msis_ubc_inti' + + end subroutine ubc_init + +!=============================================================================== + + subroutine ubc_timestep_init(pbuf2d, state) +!----------------------------------------------------------------------- +! timestep dependent setting +!----------------------------------------------------------------------- + + use solar_parms_data, only: kp=>solar_parms_kp, ap=>solar_parms_ap, f107=>solar_parms_f107 + use solar_parms_data, only: f107a=>solar_parms_f107a, f107p=>solar_parms_f107p + use mo_msis_ubc, only: msis_timestep_init + use mo_tgcm_ubc, only: tgcm_timestep_init + use mo_snoe, only: snoe_timestep_init + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use physics_buffer, only: physics_buffer_desc + + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (.not.apply_upper_bc) return + + call msis_timestep_init( ap, f107p, f107a ) + call tgcm_timestep_init( pbuf2d, state ) + call snoe_timestep_init( kp, f107 ) + + end subroutine ubc_timestep_init + +!=============================================================================== + + subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & + msis_temp, ubc_mmr, ubc_flux) + +!----------------------------------------------------------------------- +! interface routine for vertical diffusion and pbl scheme +!----------------------------------------------------------------------- + use mo_msis_ubc, only: get_msis_ubc + use mo_snoe, only: set_no_ubc, ndx_no + use mo_tgcm_ubc, only: set_tgcm_ubc + use cam_abortutils, only: endrun + use physconst, only: avogad, rairv, mbarv, rga ! Avogadro, gas constant, mean mass, universal gas constant + use phys_control, only: waccmx_is + use constituents, only: cnst_get_ind, cnst_mw, cnst_fixed_ubc ! Needed for ubc_flux + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures + real(r8), intent(in) :: zi(pcols,pverp) ! interface geoptl height above sfc + real(r8), intent(in) :: t(pcols,pver) ! midpoint temperature + real(r8), intent(in),target :: q(pcols,pver,pcnst) ! contituent mixing ratios (kg/kg) + real(r8), intent(in) :: omega(pcols,pver) ! Vertical pressure velocity (Pa/s) + real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m2/s2) + + real(r8), intent(out) :: msis_temp(pcols) ! upper bndy temperature (K) + real(r8), intent(out) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) + real(r8), intent(out) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) + +!---------------------------Local storage------------------------------- + integer :: m ! constituent index + integer :: ierr ! error flag for allocates + integer :: indx_H ! cnst index for H + integer :: indx_HE ! cnst index for He + integer :: iCol ! column loop counter + + real(r8), parameter :: m2km = 1.e-3_r8 ! meter to km + real(r8) :: rho_top(pcols) ! density at top interface + real(r8) :: z_top(pcols) ! height of top interface (km) + + real(r8), parameter :: hfluxlimitfac = 0.72_r8 ! Hydrogen upper boundary flux limiting factor + + real(r8) :: nmbartop ! Top level density (rho) + real(r8) :: zkt ! Factor for H Jean's escape flux calculation + real(r8) :: nDensHETop ! Helium number density (kg/m3) + real(r8) :: pScaleHeight ! Scale height (m) + real(r8) :: wN2 ! Neutral vertical velocity second level (m/s) + real(r8) :: wN3 ! Neutral vertical velocity at third level (m/s) + real(r8) :: wNTop ! Neutral vertical velocity at top level (m/s) + + real(r8), pointer :: qh_top(:) ! Top level hydrogen mixing ratio (kg/kg) +!----------------------------------------------------------------------- + + ubc_mmr(:,:) = 0._r8 + ubc_flux(:,:) = 0._r8 + msis_temp(:) = 0._r8 + + if (.not. apply_upper_bc) return + + call get_msis_ubc( lchnk, ncol, msis_temp, ubc_mmr ) + if( t_pert_ubc /= 0._r8 ) then + msis_temp(:ncol) = msis_temp(:ncol) + t_pert_ubc + if( any( msis_temp(:ncol) < 0._r8 ) ) then + write(iulog,*) 'ubc_get_vals: msis temp < 0 after applying offset = ',t_pert_ubc + call endrun + end if + end if + + !-------------------------------------------------------------------------------------------- + ! For WACCM-X, calculate upper boundary H flux + !-------------------------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + + call cnst_get_ind('H', indx_H) + qh_top => q(:,1,indx_H) + + do iCol = 1, ncol + !-------------------------------------------------- + ! Get total density (rho) at top level + !-------------------------------------------------- + nmbartop = 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) / ( rairv(iCol,1,lchnk) * t(iCol,1) ) + + !--------------------------------------------------------------------- + ! Calculate factor for Jean's escape flux once here, used twice below + !--------------------------------------------------------------------- + zkt = (rEarth + ( 0.5_r8 * ( zi(iCol,1) + zi(iCol,2) ) + rga * phis(iCol) ) ) * & + cnst_mw(indx_H) / avogad * grav / ( kboltz * t(iCol,1) ) + + ubc_flux(iCol,indx_H) = hfluxlimitfac * SQRT(kboltz/(2.0_r8 * pi * cnst_mw(indx_H) / avogad)) * & + qh_top(iCol) * nmbartop * & + SQRT(t(iCol,1)) * (1._r8 + zkt) * EXP(-zkt) + + ubc_flux(iCol,indx_H) = ubc_flux(iCol,indx_H) * & + (2.03E-13_r8 * qh_top(iCol) * nmbartop / (cnst_mw(indx_H) / avogad) * t(iCol,1)) + + !-------------------------------------------------------------------------------------------------------------- + ! Need to get helium number density (SI units) from mass mixing ratio. mbarv is kg/mole, same as rMass units + ! kg/kg * (kg/mole)/(kg/mole) * (Pa or N/m*m)/((Joules/K or N*m/K) * (K)) = m-3 + !--------------------------------------------------------------------------------------------------------------- +! nDensHETop = qhe_top(iCol) * mbarv(iCol,1,lchnk) / cnst_mw(indx_HE) * & +! 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) / (kboltz * t(iCol,1)) +! +! !------------------------------------------------------------------------------------------------------ +! ! Get midpoint vertical velocity for top level by extrapolating from two levels below top (Pa/s)*P +! !------------------------------------------------------------------------------------------------------ +! +! pScaleHeight = .5_r8*(rairv(iCol,2,lchnk)*t(iCol,1) + rairv(iCol,1,lchnk)*t(iCol,1)) / grav +! wN2 = -omega(iCol,2) / 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) * pScaleHeight +! +! pScaleHeight = .5_r8 * (rairv(iCol,3,lchnk)*t(iCol,2) + rairv(iCol,2,lchnk)*t(iCol,2)) / grav +! wN3 = -omega(iCol,3) / 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) * pScaleHeight +! +! !---------------------------------------------------- +! ! Get top midpoint level vertical velocity +! !---------------------------------------------------- +! wNTop = 1.5_r8 * wN2 - 0.5_r8 * wN3 +! +! !----------------------------------------------------------------------------------------------------------------- +! ! Helium upper boundary flux is just helium density multiplied by vertical velocity (kg*/m3)*(m/s) = kg/s/m^2) +! !----------------------------------------------------------------------------------------------------------------- +! ubc_flux(iCol,indx_HE) = -ndensHETop * wNTop +! + enddo + + ubc_mmr(:ncol,ndx_no) = 0.0_r8 + + else ! for waccm + + rho_top(:ncol) = pint(:ncol,1) / (rairv(:ncol,1,lchnk)*msis_temp(:ncol)) + z_top(:ncol) = m2km * zi(:ncol,1) + + call set_no_ubc ( lchnk, ncol, z_top, ubc_mmr, rho_top ) + if( ndx_no > 0 .and. no_xfac_ubc /= 1._r8 ) then + ubc_mmr(:ncol,ndx_no) = no_xfac_ubc * ubc_mmr(:ncol,ndx_no) + end if + + endif + + call set_tgcm_ubc( lchnk, ncol, ubc_mmr, mbarv(:,1,lchnk)) + + if (f_ndx .GT. 0) then + ubc_mmr(:ncol, f_ndx) = 1.0e-15_r8 + endif + if (hf_ndx .GT. 0) then + ubc_mmr(:ncol, hf_ndx) = 1.0e-15_r8 + endif + + ! Zero out constituent ubc's that are not used. + do m = 1, pcnst + if (.not. cnst_fixed_ubc(m)) then + ubc_mmr(:,m) = 0._r8 + end if + end do + + end subroutine ubc_get_vals + +end module upper_bc diff --git a/src/chemistry/pp_none/chem_mech.in b/src/chemistry/pp_none/chem_mech.in new file mode 100644 index 0000000000..24befc2774 --- /dev/null +++ b/src/chemistry/pp_none/chem_mech.in @@ -0,0 +1,50 @@ +SPECIES + + Solution + End Solution + + Fixed + M + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + End Explicit + Implicit + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis + End Photolysis + + Reactions + End Reactions + + Ext Forcing + End Ext Forcing + +END CHEMISTRY + +SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + +END SIMULATION PARAMETERS + + diff --git a/src/chemistry/pp_none/chem_mods.F90 b/src/chemistry/pp_none/chem_mods.F90 new file mode 100644 index 0000000000..4dc00c6ced --- /dev/null +++ b/src/chemistry/pp_none/chem_mods.F90 @@ -0,0 +1,49 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 0, & ! number of photolysis reactions + rxntot = 0, & ! number of total reactions + gascnt = 0, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 0, & ! number of "gas phase" species + nfs = 1, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 0, & ! number of non-zero matrix entries + extcnt = 0, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 0, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 0, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_none/chemistry.F90 b/src/chemistry/pp_none/chemistry.F90 new file mode 100644 index 0000000000..bdb8c9ae0b --- /dev/null +++ b/src/chemistry/pp_none/chemistry.F90 @@ -0,0 +1,234 @@ +!================================================================================================ +! This is the 'none' chemistry module. +! Most of the routines return without doing anything. +!================================================================================================ + +module chemistry + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: begchunk, endchunk, pcols + + + implicit none + private + save + ! + ! Public interfaces + ! + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_init ! time interpolate chemical loss frequencies + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_readnl ! read chem namelist + public :: chem_reset_fluxes + public :: chem_emissions + + interface chem_write_restart + module procedure chem_write_restart_bin + module procedure chem_write_restart_pio + end interface + interface chem_read_restart + module procedure chem_read_restart_bin + module procedure chem_read_restart_pio + end interface + + ! Private data + +!================================================================================================ +contains +!================================================================================================ + + logical function chem_is (name) + + character(len=*), intent(in) :: name + + chem_is = .false. + if (name == 'none' ) then + chem_is = .true. + end if + + end function chem_is + +!================================================================================================ + + subroutine chem_register + use aero_model, only : aero_model_register + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents for parameterized greenhouse gas chemistry + ! + !----------------------------------------------------------------------- + + ! for prescribed aerosols + call aero_model_register() + + end subroutine chem_register + +!================================================================================================ + + subroutine chem_readnl(nlfile) + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + + end subroutine chem_readnl + +!================================================================================================ + + function chem_is_active() + !----------------------------------------------------------------------- + logical :: chem_is_active + !----------------------------------------------------------------------- + chem_is_active = .false. + end function chem_is_active + +!================================================================================================ + + function chem_implements_cnst(name) + !----------------------------------------------------------------------- + ! + ! Purpose: return true if specified constituent is implemented by this package + ! + ! Author: B. Eaton + ! + !----------------------------------------------------------------------- + implicit none + !-----------------------------Arguments--------------------------------- + + character(len=*), intent(in) :: name ! constituent name + logical :: chem_implements_cnst ! return value + + chem_implements_cnst = .false. + + end function chem_implements_cnst + +!=============================================================================== + + subroutine chem_init(phys_state, pbuf2d) + !----------------------------------------------------------------------- + ! + ! Purpose: initialize parameterized greenhouse gas chemistry + ! (declare history variables) + ! + !----------------------------------------------------------------------- + use physics_buffer, only : physics_buffer_desc + use aero_model, only : aero_model_init + + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! for prescribed aerosols + call aero_model_init(pbuf2d) + + end subroutine chem_init + +!=============================================================================== + + subroutine chem_timestep_init(phys_state, pbuf2d) + use physics_buffer, only : physics_buffer_desc + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + + end subroutine chem_timestep_init + +!=============================================================================== + + subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) + use physics_buffer, only: physics_buffer_desc + use cam_history, only: outfld + use camsrfexch, only: cam_in_t, cam_out_t + !----------------------------------------------------------------------- + ! + ! Arguments: + ! + real(r8), intent(in) :: dt ! time step + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry + + return + end subroutine chem_timestep_tend + +!=============================================================================== + + subroutine chem_init_cnst(name, latvals, lonvals, mask, q) + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + + return + end subroutine chem_init_cnst + +!=============================================================================== + subroutine chem_final + return + end subroutine chem_final +!=============================================================================== + subroutine chem_write_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + return + end subroutine chem_write_restart_bin +!=============================================================================== + subroutine chem_read_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + return + end subroutine chem_read_restart_bin +!=============================================================================== + subroutine chem_write_restart_pio( File ) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_write_restart_pio +!=============================================================================== + subroutine chem_read_restart_pio( File ) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_read_restart_pio +!=============================================================================== + subroutine chem_init_restart(File) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_init_restart +!================================================================================ + subroutine chem_reset_fluxes( fptr, cam_in ) + use camsrfexch, only : cam_in_t + + real(r8), pointer :: fptr(:,:) ! pointer into array data + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + + end subroutine chem_reset_fluxes +!================================================================================ + subroutine chem_emissions( state, cam_in ) + use camsrfexch, only: cam_in_t + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + end subroutine chem_emissions +end module chemistry diff --git a/src/chemistry/pp_none/m_spc_id.F90 b/src/chemistry/pp_none/m_spc_id.F90 new file mode 100644 index 0000000000..14a949048d --- /dev/null +++ b/src/chemistry/pp_none/m_spc_id.F90 @@ -0,0 +1,3 @@ + module m_spc_id + implicit none + end module m_spc_id diff --git a/src/chemistry/pp_none/mo_adjrxt.F90 b/src/chemistry/pp_none/mo_adjrxt.F90 new file mode 100644 index 0000000000..94f2dcce83 --- /dev/null +++ b/src/chemistry/pp_none/mo_adjrxt.F90 @@ -0,0 +1,17 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_none/mo_exp_sol.F90 b/src/chemistry/pp_none/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_none/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_none/mo_imp_sol.F90 b/src/chemistry/pp_none/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_none/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_none/mo_indprd.F90 b/src/chemistry/pp_none/mo_indprd.F90 new file mode 100644 index 0000000000..14a30845c5 --- /dev/null +++ b/src/chemistry/pp_none/mo_indprd.F90 @@ -0,0 +1,21 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_none/mo_lin_matrix.F90 b/src/chemistry/pp_none/mo_lin_matrix.F90 new file mode 100644 index 0000000000..e31e8adb68 --- /dev/null +++ b/src/chemistry/pp_none/mo_lin_matrix.F90 @@ -0,0 +1,20 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_none/mo_lu_factor.F90 b/src/chemistry/pp_none/mo_lu_factor.F90 new file mode 100644 index 0000000000..839694e123 --- /dev/null +++ b/src/chemistry/pp_none/mo_lu_factor.F90 @@ -0,0 +1,13 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_none/mo_lu_solve.F90 b/src/chemistry/pp_none/mo_lu_solve.F90 new file mode 100644 index 0000000000..0d93206bde --- /dev/null +++ b/src/chemistry/pp_none/mo_lu_solve.F90 @@ -0,0 +1,15 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_none/mo_nln_matrix.F90 b/src/chemistry/pp_none/mo_nln_matrix.F90 new file mode 100644 index 0000000000..5639927a58 --- /dev/null +++ b/src/chemistry/pp_none/mo_nln_matrix.F90 @@ -0,0 +1,18 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_none/mo_phtadj.F90 b/src/chemistry/pp_none/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_none/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_none/mo_prod_loss.F90 b/src/chemistry/pp_none/mo_prod_loss.F90 new file mode 100644 index 0000000000..845c4670b9 --- /dev/null +++ b/src/chemistry/pp_none/mo_prod_loss.F90 @@ -0,0 +1,33 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_none/mo_rxt_rates_conv.F90 b/src/chemistry/pp_none/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..5596a8e98f --- /dev/null +++ b/src/chemistry/pp_none/mo_rxt_rates_conv.F90 @@ -0,0 +1,12 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_none/mo_setrxt.F90 b/src/chemistry/pp_none/mo_setrxt.F90 new file mode 100644 index 0000000000..a82675a8be --- /dev/null +++ b/src/chemistry/pp_none/mo_setrxt.F90 @@ -0,0 +1,52 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_super_fast_llnl/chem_mech.doc b/src/chemistry/pp_super_fast_llnl/chem_mech.doc new file mode 100644 index 0000000000..0e0c4c4c5a --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/chem_mech.doc @@ -0,0 +1,131 @@ + + + Solution species + ( 1) O3 + ( 2) OH (HO) + ( 3) HO2 + ( 4) H2O2 + ( 5) NO + ( 6) NO2 + ( 7) HNO3 + ( 8) CO + ( 9) CH2O + ( 10) CH3O2 + ( 11) CH3OOH (CH4O2) + ( 12) DMS (C2H6S) + ( 13) SO2 (O2S) + ( 14) SO4 + ( 15) ISOP (C5H8) + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) H2O + ( 5) CH4 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CO + + Implicit + -------- + ( 1) O3 + ( 2) OH + ( 3) HO2 + ( 4) H2O2 + ( 5) NO + ( 6) NO2 + ( 7) HNO3 + ( 8) CH2O + ( 9) CH3O2 + ( 10) CH3OOH + ( 11) DMS + ( 12) SO2 + ( 13) SO4 + ( 14) ISOP + + Photolysis + j2oh ( 1) O3 + hv -> 2*OH rate = ** User defined ** ( 1) + jh2o2 ( 2) H2O2 + hv -> 2*OH rate = ** User defined ** ( 2) + jno2 ( 3) NO2 + hv -> NO + O3 rate = ** User defined ** ( 3) + jch2o_a ( 4) CH2O + hv -> CO + 2*HO2 rate = ** User defined ** ( 4) + jch2o_b ( 5) CH2O + hv -> CO rate = ** User defined ** ( 5) + jch3ooh ( 6) CH3OOH + hv -> CH2O + HO2 + OH rate = ** User defined ** ( 6) + + Reactions + ( 1) O3 + OH -> HO2 + O2 rate = 1.70E-12*exp( -940./t) ( 7) + out6 ( 2) HO2 + O3 -> 2*O2 + OH rate = 1.00E-14*exp( -490./t) ( 8) + ( 3) HO2 + OH -> H2O + O2 rate = 4.80E-11*exp( 250./t) ( 9) + usr_HO2_HO2 ( 4) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 10) + ( 5) H2O2 + OH -> H2O + HO2 rate = 1.80E-12 ( 11) + ( 6) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) ( 12) + ( 7) HO2 + NO -> NO2 + OH rate = 3.50E-12*exp( 250./t) ( 13) + ( 8) NO2 + OH + M -> HNO3 troe : ko=1.80E-30*(300/t)**3.00 ( 14) + ki=2.80E-11 + f=0.60 + ( 9) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) ( 15) + usr_oh_co ( 10) CO + OH -> HO2 rate = ** User defined ** ( 16) + ( 11) CH2O + OH -> CO + H2O + HO2 rate = 5.50E-12*exp( 125./t) ( 17) + ( 12) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) ( 18) + ( 13) CH3OOH + OH -> CH3O2 + H2O rate = 2.70E-12*exp( 200./t) ( 19) + ( 14) CH3OOH + OH -> CH2O + H2O + OH rate = 1.10E-12*exp( 200./t) ( 20) + ( 15) CH3O2 + NO -> CH2O + HO2 + NO2 rate = 2.80E-12*exp( 300./t) ( 21) + ( 16) CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 rate = 9.50E-14*exp( 390./t) ( 22) + het_no2_h2o ( 17) H2O + NO2 -> 0.50*HNO3 rate = ** User defined ** ( 23) + ( 18) DMS + OH -> SO2 rate = 1.10E-11*exp( -240./t) ( 24) + usr_oh_dms ( 19) DMS + OH -> 0.75*SO2 rate = ** User defined ** ( 25) + tag_so2_oh_m ( 20) OH + SO2 + M -> SO4 troe : ko=3.30E-31*(300/t)**4.30 ( 26) + ki=1.60E-12 + f=0.60 + aq_so2_h2o2 ( 21) H2O2 + SO2 -> SO4 rate = ** User defined ** ( 27) + aq_so2_o3 ( 22) O3 + SO2 -> SO4 rate = ** User defined ** ( 28) + isop_oh ( 23) ISOP + OH -> 2*{CH3O2-1.5*OH} rate = 2.70E-11*exp( 390./t) ( 29) + isop_o3 ( 24) ISOP + O3 -> 0.87*CH2O + 1.86*CH3O2 + 0.06*HO2 + 0.05*CO rate = 5.59E-15*exp( -1814./t) ( 30) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) SO4 (dataset) + + + Equation Report + + d(O3)/dt = j3*NO2 + - j1*O3 - r1*OH*O3 - r2*HO2*O3 - r6*NO*O3 - r22*SO2*O3 - r24*ISOP*O3 + d(OH)/dt = 2*j1*O3 + 2*j2*H2O2 + j6*CH3OOH + r2*HO2*O3 + r7*HO2*NO + - r9*CH4*OH - r1*O3*OH - r3*HO2*OH - r5*H2O2*OH - r8*M*NO2*OH - r10*CO*OH - r11*CH2O*OH + - r13*CH3OOH*OH - r18*DMS*OH - r19*DMS*OH - r20*M*SO2*OH - r23*ISOP*OH + d(HO2)/dt = 2*j4*CH2O + j6*CH3OOH + r1*O3*OH + r5*H2O2*OH + r10*CO*OH + r11*CH2O*OH + r15*CH3O2*NO + + .8*r16*CH3O2*CH3O2 + .06*r24*ISOP*O3 + - r2*O3*HO2 - r3*OH*HO2 - 2*r4*HO2*HO2 - r7*NO*HO2 - r12*CH3O2*HO2 + d(H2O2)/dt = r4*HO2*HO2 + - j2*H2O2 - r5*OH*H2O2 - r21*SO2*H2O2 + d(NO)/dt = j3*NO2 + - r6*O3*NO - r7*HO2*NO - r15*CH3O2*NO + d(NO2)/dt = r6*NO*O3 + r7*HO2*NO + r15*CH3O2*NO + - j3*NO2 - r17*H2O*NO2 - r8*M*OH*NO2 + d(HNO3)/dt = .5*r17*H2O*NO2 + r8*M*NO2*OH + d(CO)/dt = j4*CH2O + j5*CH2O + r11*CH2O*OH + .05*r24*ISOP*O3 + - r10*OH*CO + d(CH2O)/dt = j6*CH3OOH + r14*CH3OOH*OH + r15*CH3O2*NO + 2*r16*CH3O2*CH3O2 + .87*r24*ISOP*O3 + - j4*CH2O - j5*CH2O - r11*OH*CH2O + d(CH3O2)/dt = r9*CH4*OH + r13*CH3OOH*OH + 1.86*r24*ISOP*O3 + - r12*HO2*CH3O2 - r15*NO*CH3O2 - 2*r16*CH3O2*CH3O2 + d(CH3OOH)/dt = r12*CH3O2*HO2 + - j6*CH3OOH - r13*OH*CH3OOH - r14*OH*CH3OOH + d(DMS)/dt = - r18*OH*DMS - r19*OH*DMS + d(SO2)/dt = r18*DMS*OH + .75*r19*DMS*OH + - r20*M*OH*SO2 - r21*H2O2*SO2 - r22*O3*SO2 + d(SO4)/dt = r20*M*OH*SO2 + r21*H2O2*SO2 + r22*O3*SO2 + d(ISOP)/dt = - r23*OH*ISOP - r24*O3*ISOP diff --git a/src/chemistry/pp_super_fast_llnl/chem_mech.in b/src/chemistry/pp_super_fast_llnl/chem_mech.in new file mode 100644 index 0000000000..6b10579d99 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/chem_mech.in @@ -0,0 +1,89 @@ + SPECIES + + Solution + O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2 + CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, + SO4, ISOP -> C5H8 + End Solution + + Fixed + M, N2, O2, H2O, CH4 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + END Species + + Solution classes + Explicit + CO + End explicit + Implicit + O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH + DMS, SO2, SO4, ISOP + End implicit + END Solution classes + + CHEMISTRY + Photolysis +[j2oh->,jo3_a] O3 + hv -> 2*OH +[jh2o2] H2O2 + hv -> 2*OH +[jno2] NO2 + hv -> NO + O3 +[jch2o_a] CH2O + hv -> CO + 2*HO2 +[jch2o_b] CH2O + hv -> CO +[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH + End Photolysis + + Reactions + O3 + OH -> HO2 + O2 ; 1.700E-12, -940 +[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 + HO2 + OH -> H2O + O2 ; 4.800E-11, 250 +[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 1.800E-12 + NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 + HO2 + NO -> NO2 + OH ; 3.500E-12, 250 + NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 + CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 +[usr_oh_co] CO + OH -> HO2 + CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 + CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 + CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 + CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 + CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 + CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 +[het_no2_h2o] H2O + NO2 -> 0.50*HNO3 + DMS + OH -> SO2 ; 1.100E-11, -240 +[usr_oh_dms] DMS + OH -> 0.75*SO2 +[tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 +[aq_so2_h2o2] H2O2 + SO2 -> SO4 +[aq_so2_o3] O3 + SO2 -> SO4 +[isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390 +[isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814 + End reactions + + Ext forcing + NO <- dataset + NO2 <- dataset + CO <- dataset + SO2 <- dataset + SO4 <- dataset + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_super_fast_llnl/chem_mods.F90 b/src/chemistry/pp_super_fast_llnl/chem_mods.F90 new file mode 100644 index 0000000000..3ddda33343 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 6, & ! number of photolysis reactions + rxntot = 30, & ! number of total reactions + gascnt = 24, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 15, & ! number of "gas phase" species + nfs = 5, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 83, & ! number of non-zero matrix entries + extcnt = 5, & ! number of species with external forcing + clscnt1 = 1, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 14, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 16, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 b/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 new file mode 100644 index 0000000000..e7740277b0 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/m_rxt_id.F90 @@ -0,0 +1,33 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_j2oh = 1 + integer, parameter :: rid_jh2o2 = 2 + integer, parameter :: rid_jno2 = 3 + integer, parameter :: rid_jch2o_a = 4 + integer, parameter :: rid_jch2o_b = 5 + integer, parameter :: rid_jch3ooh = 6 + integer, parameter :: rid_out6 = 8 + integer, parameter :: rid_usr_HO2_HO2 = 10 + integer, parameter :: rid_usr_oh_co = 16 + integer, parameter :: rid_het_no2_h2o = 23 + integer, parameter :: rid_usr_oh_dms = 25 + integer, parameter :: rid_tag_so2_oh_m = 26 + integer, parameter :: rid_aq_so2_h2o2 = 27 + integer, parameter :: rid_aq_so2_o3 = 28 + integer, parameter :: rid_isop_oh = 29 + integer, parameter :: rid_isop_o3 = 30 + integer, parameter :: rid_r0007 = 7 + integer, parameter :: rid_r0009 = 9 + integer, parameter :: rid_r0011 = 11 + integer, parameter :: rid_r0012 = 12 + integer, parameter :: rid_r0013 = 13 + integer, parameter :: rid_r0014 = 14 + integer, parameter :: rid_r0015 = 15 + integer, parameter :: rid_r0017 = 17 + integer, parameter :: rid_r0018 = 18 + integer, parameter :: rid_r0019 = 19 + integer, parameter :: rid_r0020 = 20 + integer, parameter :: rid_r0021 = 21 + integer, parameter :: rid_r0022 = 22 + integer, parameter :: rid_r0024 = 24 + end module m_rxt_id diff --git a/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 b/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 new file mode 100644 index 0000000000..2a61218daf --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/m_spc_id.F90 @@ -0,0 +1,18 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_OH = 2 + integer, parameter :: id_HO2 = 3 + integer, parameter :: id_H2O2 = 4 + integer, parameter :: id_NO = 5 + integer, parameter :: id_NO2 = 6 + integer, parameter :: id_HNO3 = 7 + integer, parameter :: id_CO = 8 + integer, parameter :: id_CH2O = 9 + integer, parameter :: id_CH3O2 = 10 + integer, parameter :: id_CH3OOH = 11 + integer, parameter :: id_DMS = 12 + integer, parameter :: id_SO2 = 13 + integer, parameter :: id_SO4 = 14 + integer, parameter :: id_ISOP = 15 + end module m_spc_id diff --git a/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 b/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 new file mode 100644 index 0000000000..c49338f386 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_adjrxt.F90 @@ -0,0 +1,43 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 14) = rate(:,:, 14) * inv(:,:, 1) + rate(:,:, 15) = rate(:,:, 15) * inv(:,:, 5) + rate(:,:, 23) = rate(:,:, 23) * inv(:,:, 4) + rate(:,:, 26) = rate(:,:, 26) * inv(:,:, 1) + rate(:,:, 7) = rate(:,:, 7) * m(:,:) + rate(:,:, 8) = rate(:,:, 8) * m(:,:) + rate(:,:, 9) = rate(:,:, 9) * m(:,:) + rate(:,:, 10) = rate(:,:, 10) * m(:,:) + rate(:,:, 11) = rate(:,:, 11) * m(:,:) + rate(:,:, 12) = rate(:,:, 12) * m(:,:) + rate(:,:, 13) = rate(:,:, 13) * m(:,:) + rate(:,:, 14) = rate(:,:, 14) * m(:,:) + rate(:,:, 16) = rate(:,:, 16) * m(:,:) + rate(:,:, 17) = rate(:,:, 17) * m(:,:) + rate(:,:, 18) = rate(:,:, 18) * m(:,:) + rate(:,:, 19) = rate(:,:, 19) * m(:,:) + rate(:,:, 20) = rate(:,:, 20) * m(:,:) + rate(:,:, 21) = rate(:,:, 21) * m(:,:) + rate(:,:, 22) = rate(:,:, 22) * m(:,:) + rate(:,:, 24) = rate(:,:, 24) * m(:,:) + rate(:,:, 25) = rate(:,:, 25) * m(:,:) + rate(:,:, 26) = rate(:,:, 26) * m(:,:) + rate(:,:, 27) = rate(:,:, 27) * m(:,:) + rate(:,:, 28) = rate(:,:, 28) * m(:,:) + rate(:,:, 29) = rate(:,:, 29) * m(:,:) + rate(:,:, 30) = rate(:,:, 30) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_super_fast_llnl/mo_exp_sol.F90 b/src/chemistry/pp_super_fast_llnl/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 b/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 b/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 new file mode 100644 index 0000000000..3c35342f3a --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_indprd.F90 @@ -0,0 +1,46 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = (rxt(:,:,4) +rxt(:,:,5) +rxt(:,:,17)*y(:,:,2))*y(:,:,9) & + +.050_r8*rxt(:,:,30)*y(:,:,15)*y(:,:,1) + extfrc(:,:,3) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,10) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,12) = + extfrc(:,:,1) + prod(:,:,9) = + extfrc(:,:,2) + prod(:,:,1) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,5) = + extfrc(:,:,4) + prod(:,:,2) = + extfrc(:,:,5) + prod(:,:,6) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 b/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 new file mode 100644 index 0000000000..cede1b323c --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_lin_matrix.F90 @@ -0,0 +1,61 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(41) = -( rxt(1) + het_rates(1) ) + mat(33) = rxt(3) + mat(74) = -( rxt(15) + rxt(16)*y(8) + het_rates(2) ) + mat(44) = 2.000_r8*rxt(1) + mat(10) = 2.000_r8*rxt(2) + mat(29) = rxt(6) + mat(51) = -( het_rates(3) ) + mat(24) = 2.000_r8*rxt(4) + mat(28) = rxt(6) + mat(72) = rxt(16)*y(8) + mat(7) = -( rxt(2) + het_rates(4) ) + mat(59) = -( het_rates(5) ) + mat(34) = rxt(3) + mat(32) = -( rxt(3) + rxt(23) + het_rates(6) ) + mat(1) = -( het_rates(7) ) + mat(31) = .500_r8*rxt(23) + mat(23) = -( rxt(4) + rxt(5) + het_rates(9) ) + mat(26) = rxt(6) + mat(83) = -( het_rates(10) ) + mat(75) = rxt(15) + mat(27) = -( rxt(6) + het_rates(11) ) + mat(3) = -( het_rates(12) ) + mat(13) = -( het_rates(13) ) + mat(2) = -( het_rates(14) ) + mat(17) = -( het_rates(15) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 b/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 new file mode 100644 index 0000000000..52c9520293 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_lu_factor.F90 @@ -0,0 +1,161 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = lu(4) * lu(3) + lu(5) = lu(5) * lu(3) + lu(66) = lu(66) - lu(4) * lu(64) + lu(74) = lu(74) - lu(5) * lu(64) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(9) = lu(9) * lu(7) + lu(10) = lu(10) * lu(7) + lu(13) = lu(13) - lu(8) * lu(12) + lu(15) = - lu(9) * lu(12) + lu(16) = lu(16) - lu(10) * lu(12) + lu(47) = - lu(8) * lu(46) + lu(51) = lu(51) - lu(9) * lu(46) + lu(53) = lu(53) - lu(10) * lu(46) + lu(66) = lu(66) - lu(8) * lu(65) + lu(72) = lu(72) - lu(9) * lu(65) + lu(74) = lu(74) - lu(10) * lu(65) + lu(13) = 1._r8 / lu(13) + lu(14) = lu(14) * lu(13) + lu(15) = lu(15) * lu(13) + lu(16) = lu(16) * lu(13) + lu(41) = lu(41) - lu(14) * lu(37) + lu(42) = lu(42) - lu(15) * lu(37) + lu(44) = lu(44) - lu(16) * lu(37) + lu(50) = lu(50) - lu(14) * lu(47) + lu(51) = lu(51) - lu(15) * lu(47) + lu(53) = lu(53) - lu(16) * lu(47) + lu(71) = lu(71) - lu(14) * lu(66) + lu(72) = lu(72) - lu(15) * lu(66) + lu(74) = lu(74) - lu(16) * lu(66) + lu(17) = 1._r8 / lu(17) + lu(18) = lu(18) * lu(17) + lu(19) = lu(19) * lu(17) + lu(20) = lu(20) * lu(17) + lu(21) = lu(21) * lu(17) + lu(22) = lu(22) * lu(17) + lu(39) = lu(39) - lu(18) * lu(38) + lu(41) = lu(41) - lu(19) * lu(38) + lu(42) = lu(42) - lu(20) * lu(38) + lu(44) = lu(44) - lu(21) * lu(38) + lu(45) = lu(45) - lu(22) * lu(38) + lu(68) = lu(68) - lu(18) * lu(67) + lu(71) = lu(71) - lu(19) * lu(67) + lu(72) = lu(72) - lu(20) * lu(67) + lu(74) = lu(74) - lu(21) * lu(67) + lu(75) = lu(75) - lu(22) * lu(67) + lu(23) = 1._r8 / lu(23) + lu(24) = lu(24) * lu(23) + lu(25) = lu(25) * lu(23) + lu(28) = lu(28) - lu(24) * lu(26) + lu(29) = lu(29) - lu(25) * lu(26) + lu(42) = lu(42) - lu(24) * lu(39) + lu(44) = lu(44) - lu(25) * lu(39) + lu(58) = lu(58) - lu(24) * lu(55) + lu(60) = lu(60) - lu(25) * lu(55) + lu(72) = lu(72) - lu(24) * lu(68) + lu(74) = lu(74) - lu(25) * lu(68) + lu(80) = lu(80) - lu(24) * lu(76) + lu(82) = - lu(25) * lu(76) + lu(27) = 1._r8 / lu(27) + lu(28) = lu(28) * lu(27) + lu(29) = lu(29) * lu(27) + lu(30) = lu(30) * lu(27) + lu(51) = lu(51) - lu(28) * lu(48) + lu(53) = lu(53) - lu(29) * lu(48) + lu(54) = lu(54) - lu(30) * lu(48) + lu(72) = lu(72) - lu(28) * lu(69) + lu(74) = lu(74) - lu(29) * lu(69) + lu(75) = lu(75) - lu(30) * lu(69) + lu(80) = lu(80) - lu(28) * lu(77) + lu(82) = lu(82) - lu(29) * lu(77) + lu(83) = lu(83) - lu(30) * lu(77) + lu(32) = 1._r8 / lu(32) + lu(33) = lu(33) * lu(32) + lu(34) = lu(34) * lu(32) + lu(35) = lu(35) * lu(32) + lu(41) = lu(41) - lu(33) * lu(40) + lu(43) = lu(43) - lu(34) * lu(40) + lu(44) = lu(44) - lu(35) * lu(40) + lu(50) = lu(50) - lu(33) * lu(49) + lu(52) = lu(52) - lu(34) * lu(49) + lu(53) = lu(53) - lu(35) * lu(49) + lu(57) = lu(57) - lu(33) * lu(56) + lu(59) = lu(59) - lu(34) * lu(56) + lu(60) = lu(60) - lu(35) * lu(56) + lu(71) = lu(71) - lu(33) * lu(70) + lu(73) = - lu(34) * lu(70) + lu(74) = lu(74) - lu(35) * lu(70) + lu(79) = - lu(33) * lu(78) + lu(81) = lu(81) - lu(34) * lu(78) + lu(82) = lu(82) - lu(35) * lu(78) + lu(41) = 1._r8 / lu(41) + lu(42) = lu(42) * lu(41) + lu(43) = lu(43) * lu(41) + lu(44) = lu(44) * lu(41) + lu(45) = lu(45) * lu(41) + lu(51) = lu(51) - lu(42) * lu(50) + lu(52) = lu(52) - lu(43) * lu(50) + lu(53) = lu(53) - lu(44) * lu(50) + lu(54) = lu(54) - lu(45) * lu(50) + lu(58) = lu(58) - lu(42) * lu(57) + lu(59) = lu(59) - lu(43) * lu(57) + lu(60) = lu(60) - lu(44) * lu(57) + lu(61) = lu(61) - lu(45) * lu(57) + lu(72) = lu(72) - lu(42) * lu(71) + lu(73) = lu(73) - lu(43) * lu(71) + lu(74) = lu(74) - lu(44) * lu(71) + lu(75) = lu(75) - lu(45) * lu(71) + lu(80) = lu(80) - lu(42) * lu(79) + lu(81) = lu(81) - lu(43) * lu(79) + lu(82) = lu(82) - lu(44) * lu(79) + lu(83) = lu(83) - lu(45) * lu(79) + lu(51) = 1._r8 / lu(51) + lu(52) = lu(52) * lu(51) + lu(53) = lu(53) * lu(51) + lu(54) = lu(54) * lu(51) + lu(59) = lu(59) - lu(52) * lu(58) + lu(60) = lu(60) - lu(53) * lu(58) + lu(61) = lu(61) - lu(54) * lu(58) + lu(73) = lu(73) - lu(52) * lu(72) + lu(74) = lu(74) - lu(53) * lu(72) + lu(75) = lu(75) - lu(54) * lu(72) + lu(81) = lu(81) - lu(52) * lu(80) + lu(82) = lu(82) - lu(53) * lu(80) + lu(83) = lu(83) - lu(54) * lu(80) + lu(59) = 1._r8 / lu(59) + lu(60) = lu(60) * lu(59) + lu(61) = lu(61) * lu(59) + lu(74) = lu(74) - lu(60) * lu(73) + lu(75) = lu(75) - lu(61) * lu(73) + lu(82) = lu(82) - lu(60) * lu(81) + lu(83) = lu(83) - lu(61) * lu(81) + lu(74) = 1._r8 / lu(74) + lu(75) = lu(75) * lu(74) + lu(83) = lu(83) - lu(75) * lu(82) + lu(83) = 1._r8 / lu(83) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 b/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 new file mode 100644 index 0000000000..f01fc70a2a --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_lu_solve.F90 @@ -0,0 +1,135 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(5) = b(5) - lu(4) * b(3) + b(13) = b(13) - lu(5) * b(3) + b(5) = b(5) - lu(8) * b(4) + b(11) = b(11) - lu(9) * b(4) + b(13) = b(13) - lu(10) * b(4) + b(10) = b(10) - lu(14) * b(5) + b(11) = b(11) - lu(15) * b(5) + b(13) = b(13) - lu(16) * b(5) + b(7) = b(7) - lu(18) * b(6) + b(10) = b(10) - lu(19) * b(6) + b(11) = b(11) - lu(20) * b(6) + b(13) = b(13) - lu(21) * b(6) + b(14) = b(14) - lu(22) * b(6) + b(11) = b(11) - lu(24) * b(7) + b(13) = b(13) - lu(25) * b(7) + b(11) = b(11) - lu(28) * b(8) + b(13) = b(13) - lu(29) * b(8) + b(14) = b(14) - lu(30) * b(8) + b(10) = b(10) - lu(33) * b(9) + b(12) = b(12) - lu(34) * b(9) + b(13) = b(13) - lu(35) * b(9) + b(11) = b(11) - lu(42) * b(10) + b(12) = b(12) - lu(43) * b(10) + b(13) = b(13) - lu(44) * b(10) + b(14) = b(14) - lu(45) * b(10) + b(12) = b(12) - lu(52) * b(11) + b(13) = b(13) - lu(53) * b(11) + b(14) = b(14) - lu(54) * b(11) + b(13) = b(13) - lu(60) * b(12) + b(14) = b(14) - lu(61) * b(12) + b(14) = b(14) - lu(75) * b(13) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(14) = b(14) * lu(83) + b(13) = b(13) - lu(82) * b(14) + b(12) = b(12) - lu(81) * b(14) + b(11) = b(11) - lu(80) * b(14) + b(10) = b(10) - lu(79) * b(14) + b(9) = b(9) - lu(78) * b(14) + b(8) = b(8) - lu(77) * b(14) + b(7) = b(7) - lu(76) * b(14) + b(13) = b(13) * lu(74) + b(12) = b(12) - lu(73) * b(13) + b(11) = b(11) - lu(72) * b(13) + b(10) = b(10) - lu(71) * b(13) + b(9) = b(9) - lu(70) * b(13) + b(8) = b(8) - lu(69) * b(13) + b(7) = b(7) - lu(68) * b(13) + b(6) = b(6) - lu(67) * b(13) + b(5) = b(5) - lu(66) * b(13) + b(4) = b(4) - lu(65) * b(13) + b(3) = b(3) - lu(64) * b(13) + b(2) = b(2) - lu(63) * b(13) + b(1) = b(1) - lu(62) * b(13) + b(12) = b(12) * lu(59) + b(11) = b(11) - lu(58) * b(12) + b(10) = b(10) - lu(57) * b(12) + b(9) = b(9) - lu(56) * b(12) + b(7) = b(7) - lu(55) * b(12) + b(11) = b(11) * lu(51) + b(10) = b(10) - lu(50) * b(11) + b(9) = b(9) - lu(49) * b(11) + b(8) = b(8) - lu(48) * b(11) + b(5) = b(5) - lu(47) * b(11) + b(4) = b(4) - lu(46) * b(11) + b(10) = b(10) * lu(41) + b(9) = b(9) - lu(40) * b(10) + b(7) = b(7) - lu(39) * b(10) + b(6) = b(6) - lu(38) * b(10) + b(5) = b(5) - lu(37) * b(10) + b(2) = b(2) - lu(36) * b(10) + b(9) = b(9) * lu(32) + b(1) = b(1) - lu(31) * b(9) + b(8) = b(8) * lu(27) + b(7) = b(7) - lu(26) * b(8) + b(7) = b(7) * lu(23) + b(6) = b(6) * lu(17) + b(5) = b(5) * lu(13) + b(4) = b(4) - lu(12) * b(5) + b(2) = b(2) - lu(11) * b(5) + b(4) = b(4) * lu(7) + b(2) = b(2) - lu(6) * b(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 b/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 new file mode 100644 index 0000000000..51b90f8c72 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_nln_matrix.F90 @@ -0,0 +1,181 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(41) = -(rxt(7)*y(2) + rxt(8)*y(3) + rxt(12)*y(5) + rxt(28)*y(13) + rxt(30) & + *y(15)) + mat(71) = -rxt(7)*y(1) + mat(50) = -rxt(8)*y(1) + mat(57) = -rxt(12)*y(1) + mat(14) = -rxt(28)*y(1) + mat(19) = -rxt(30)*y(1) + mat(74) = -(rxt(7)*y(1) + rxt(9)*y(3) + rxt(11)*y(4) + rxt(14)*y(6) + rxt(17) & + *y(9) + rxt(19)*y(11) + (rxt(24) + rxt(25)) * y(12) + rxt(26) & + *y(13) + rxt(29)*y(15)) + mat(44) = -rxt(7)*y(2) + mat(53) = -rxt(9)*y(2) + mat(10) = -rxt(11)*y(2) + mat(35) = -rxt(14)*y(2) + mat(25) = -rxt(17)*y(2) + mat(29) = -rxt(19)*y(2) + mat(5) = -(rxt(24) + rxt(25)) * y(2) + mat(16) = -rxt(26)*y(2) + mat(21) = -rxt(29)*y(2) + mat(44) = mat(44) + rxt(8)*y(3) + mat(53) = mat(53) + rxt(8)*y(1) + rxt(13)*y(5) + mat(60) = rxt(13)*y(3) + mat(51) = -(rxt(8)*y(1) + rxt(9)*y(2) + 4._r8*rxt(10)*y(3) + rxt(13)*y(5) & + + rxt(18)*y(10)) + mat(42) = -rxt(8)*y(3) + mat(72) = -rxt(9)*y(3) + mat(58) = -rxt(13)*y(3) + mat(80) = -rxt(18)*y(3) + mat(42) = mat(42) + rxt(7)*y(2) + .060_r8*rxt(30)*y(15) + mat(72) = mat(72) + rxt(7)*y(1) + rxt(11)*y(4) + rxt(17)*y(9) + mat(9) = rxt(11)*y(2) + mat(58) = mat(58) + rxt(21)*y(10) + mat(24) = rxt(17)*y(2) + mat(80) = mat(80) + rxt(21)*y(5) + 1.600_r8*rxt(22)*y(10) + mat(20) = .060_r8*rxt(30)*y(1) + mat(7) = -(rxt(11)*y(2) + rxt(27)*y(13)) + mat(65) = -rxt(11)*y(4) + mat(12) = -rxt(27)*y(4) + mat(46) = 2.000_r8*rxt(10)*y(3) + mat(59) = -(rxt(12)*y(1) + rxt(13)*y(3) + rxt(21)*y(10)) + mat(43) = -rxt(12)*y(5) + mat(52) = -rxt(13)*y(5) + mat(81) = -rxt(21)*y(5) + mat(32) = -(rxt(14)*y(2)) + mat(70) = -rxt(14)*y(6) + mat(40) = rxt(12)*y(5) + mat(49) = rxt(13)*y(5) + mat(56) = rxt(12)*y(1) + rxt(13)*y(3) + rxt(21)*y(10) + mat(78) = rxt(21)*y(5) + mat(62) = rxt(14)*y(6) + mat(31) = rxt(14)*y(2) + mat(23) = -(rxt(17)*y(2)) + mat(68) = -rxt(17)*y(9) + mat(39) = .870_r8*rxt(30)*y(15) + mat(68) = mat(68) + rxt(20)*y(11) + mat(55) = rxt(21)*y(10) + mat(76) = rxt(21)*y(5) + 4.000_r8*rxt(22)*y(10) + mat(26) = rxt(20)*y(2) + mat(18) = .870_r8*rxt(30)*y(1) + mat(83) = -(rxt(18)*y(3) + rxt(21)*y(5) + 4._r8*rxt(22)*y(10)) + mat(54) = -rxt(18)*y(10) + mat(61) = -rxt(21)*y(10) + mat(45) = 1.860_r8*rxt(30)*y(15) + mat(75) = rxt(19)*y(11) + mat(30) = rxt(19)*y(2) + mat(22) = 1.860_r8*rxt(30)*y(1) + mat(27) = -((rxt(19) + rxt(20)) * y(2)) + mat(69) = -(rxt(19) + rxt(20)) * y(11) + mat(48) = rxt(18)*y(10) + mat(77) = rxt(18)*y(3) + mat(3) = -((rxt(24) + rxt(25)) * y(2)) + mat(64) = -(rxt(24) + rxt(25)) * y(12) + mat(13) = -(rxt(26)*y(2) + rxt(27)*y(4) + rxt(28)*y(1)) + mat(66) = -rxt(26)*y(13) + mat(8) = -rxt(27)*y(13) + mat(37) = -rxt(28)*y(13) + mat(66) = mat(66) + (rxt(24)+.750_r8*rxt(25))*y(12) + mat(4) = (rxt(24)+.750_r8*rxt(25))*y(2) + mat(36) = rxt(28)*y(13) + mat(63) = rxt(26)*y(13) + mat(6) = rxt(27)*y(13) + mat(11) = rxt(28)*y(1) + rxt(26)*y(2) + rxt(27)*y(4) + mat(17) = -(rxt(29)*y(2) + rxt(30)*y(1)) + mat(67) = -rxt(29)*y(15) + mat(38) = -rxt(30)*y(15) + end subroutine nlnmat01 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = mat( 3) + lmat( 3) + mat( 7) = mat( 7) + lmat( 7) + mat( 10) = mat( 10) + lmat( 10) + mat( 13) = mat( 13) + lmat( 13) + mat( 17) = mat( 17) + lmat( 17) + mat( 23) = mat( 23) + lmat( 23) + mat( 24) = mat( 24) + lmat( 24) + mat( 26) = mat( 26) + lmat( 26) + mat( 27) = mat( 27) + lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = mat( 29) + lmat( 29) + mat( 31) = mat( 31) + lmat( 31) + mat( 32) = mat( 32) + lmat( 32) + mat( 33) = lmat( 33) + mat( 34) = lmat( 34) + mat( 41) = mat( 41) + lmat( 41) + mat( 44) = mat( 44) + lmat( 44) + mat( 51) = mat( 51) + lmat( 51) + mat( 59) = mat( 59) + lmat( 59) + mat( 72) = mat( 72) + lmat( 72) + mat( 74) = mat( 74) + lmat( 74) + mat( 75) = mat( 75) + lmat( 75) + mat( 83) = mat( 83) + lmat( 83) + mat( 15) = 0._r8 + mat( 47) = 0._r8 + mat( 73) = 0._r8 + mat( 79) = 0._r8 + mat( 82) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 7) = mat( 7) - dti + mat( 13) = mat( 13) - dti + mat( 17) = mat( 17) - dti + mat( 23) = mat( 23) - dti + mat( 27) = mat( 27) - dti + mat( 32) = mat( 32) - dti + mat( 41) = mat( 41) - dti + mat( 51) = mat( 51) - dti + mat( 59) = mat( 59) - dti + mat( 74) = mat( 74) - dti + mat( 83) = mat( 83) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 b/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 b/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 new file mode 100644 index 0000000000..356c80bb59 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_prod_loss.F90 @@ -0,0 +1,80 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = (rxt(:,:,16)* y(:,:,2) + het_rates(:,:,8))* y(:,:,8) + prod(:,:,1) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(10) = (rxt(7)* y(2) +rxt(8)* y(3) +rxt(12)* y(5) +rxt(28)* y(13) & + +rxt(30)* y(15) + rxt(1) + het_rates(1))* y(1) + prod(10) =rxt(3)*y(6) + loss(13) = (rxt(7)* y(1) +rxt(9)* y(3) +rxt(11)* y(4) +rxt(14)* y(6) +rxt(16) & + * y(8) +rxt(17)* y(9) +rxt(19)* y(11) + (rxt(24) +rxt(25))* y(12) & + +rxt(26)* y(13) +rxt(29)* y(15) + rxt(15) + het_rates(2))* y(2) + prod(13) = (2.000_r8*rxt(1) +rxt(8)*y(3))*y(1) +rxt(13)*y(5)*y(3) & + +2.000_r8*rxt(2)*y(4) +rxt(6)*y(11) + loss(11) = (rxt(8)* y(1) +rxt(9)* y(2) + 2._r8*rxt(10)* y(3) +rxt(13)* y(5) & + +rxt(18)* y(10) + het_rates(3))* y(3) + prod(11) = (rxt(16)*y(8) +rxt(7)*y(1) +rxt(11)*y(4) +rxt(17)*y(9))*y(2) & + + (rxt(21)*y(5) +.800_r8*rxt(22)*y(10))*y(10) +.060_r8*rxt(30)*y(15) & + *y(1) +2.000_r8*rxt(4)*y(9) +rxt(6)*y(11) + loss(4) = (rxt(11)* y(2) +rxt(27)* y(13) + rxt(2) + het_rates(4))* y(4) + prod(4) =rxt(10)*y(3)*y(3) + loss(12) = (rxt(12)* y(1) +rxt(13)* y(3) +rxt(21)* y(10) + het_rates(5)) & + * y(5) + prod(12) =rxt(3)*y(6) + loss(9) = (rxt(14)* y(2) + rxt(3) + rxt(23) + het_rates(6))* y(6) + prod(9) = (rxt(12)*y(1) +rxt(13)*y(3) +rxt(21)*y(10))*y(5) + loss(1) = ( + het_rates(7))* y(7) + prod(1) = (.500_r8*rxt(23) +rxt(14)*y(2))*y(6) + loss(7) = (rxt(17)* y(2) + rxt(4) + rxt(5) + het_rates(9))* y(9) + prod(7) = (rxt(21)*y(5) +2.000_r8*rxt(22)*y(10))*y(10) + (rxt(6) + & + rxt(20)*y(2))*y(11) +.870_r8*rxt(30)*y(15)*y(1) + loss(14) = (rxt(18)* y(3) +rxt(21)* y(5) + 2._r8*rxt(22)* y(10) & + + het_rates(10))* y(10) + prod(14) = (rxt(15) +rxt(19)*y(11))*y(2) +1.860_r8*rxt(30)*y(15)*y(1) + loss(8) = ((rxt(19) +rxt(20))* y(2) + rxt(6) + het_rates(11))* y(11) + prod(8) =rxt(18)*y(10)*y(3) + loss(3) = ((rxt(24) +rxt(25))* y(2) + het_rates(12))* y(12) + prod(3) = 0._r8 + loss(5) = (rxt(28)* y(1) +rxt(26)* y(2) +rxt(27)* y(4) + het_rates(13)) & + * y(13) + prod(5) = (rxt(24)*y(12) +.750_r8*rxt(25)*y(12))*y(2) + loss(2) = ( + het_rates(14))* y(14) + prod(2) = (rxt(26)*y(2) +rxt(27)*y(4) +rxt(28)*y(1))*y(13) + loss(6) = (rxt(30)* y(1) +rxt(29)* y(2) + het_rates(15))* y(15) + prod(6) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_super_fast_llnl/mo_rxt_rates_conv.F90 b/src/chemistry/pp_super_fast_llnl/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..0ed345e585 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_rxt_rates_conv.F90 @@ -0,0 +1,42 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*H2O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 6) ! rate_const*NO2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 9) ! rate_const*CH2O + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 9) ! rate_const*CH2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 11) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 1)*sol(:ncol,:, 2) ! rate_const*O3*OH + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 3)*sol(:ncol,:, 2) ! rate_const*HO2*OH + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 4)*sol(:ncol,:, 2) ! rate_const*H2O2*OH + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 3)*sol(:ncol,:, 5) ! rate_const*HO2*NO + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 2) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 8)*sol(:ncol,:, 2) ! rate_const*CO*OH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 10)*sol(:ncol,:, 3) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 10)*sol(:ncol,:, 5) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 10)*sol(:ncol,:, 10) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 6) ! rate_const*H2O*NO2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 12)*sol(:ncol,:, 2) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 12)*sol(:ncol,:, 2) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 2)*sol(:ncol,:, 13) ! rate_const*M*OH*SO2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 4)*sol(:ncol,:, 13) ! rate_const*H2O2*SO2 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 1)*sol(:ncol,:, 13) ! rate_const*O3*SO2 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 15)*sol(:ncol,:, 2) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 15)*sol(:ncol,:, 1) ! rate_const*ISOP*O3 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 b/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 new file mode 100644 index 0000000000..0f14d55169 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_setrxt.F90 @@ -0,0 +1,104 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,11) = 1.800E-12_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,7) = 1.700E-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:,8) = 1.000E-14_r8 * exp( -490._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,9) = 4.800E-11_r8 * exp_fac(:,:) + rate(:,:,13) = 3.500E-12_r8 * exp_fac(:,:) + rate(:,:,12) = 3.000E-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:,15) = 2.450E-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,17) = 5.500E-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,18) = 4.100E-13_r8 * exp( 750._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,19) = 2.700E-12_r8 * exp_fac(:,:) + rate(:,:,20) = 1.100E-12_r8 * exp_fac(:,:) + rate(:,:,21) = 2.800E-12_r8 * exp( 300._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 390._r8 * itemp(:,:) ) + rate(:,:,22) = 9.500E-14_r8 * exp_fac(:,:) + rate(:,:,29) = 2.700E-11_r8 * exp_fac(:,:) + rate(:,:,24) = 1.100E-11_r8 * exp( -240._r8 * itemp(:,:) ) + rate(:,:,30) = 5.590E-15_r8 * exp( -1814._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 1.800E-30_r8 * itemp(:,:)**3.00_r8 + kinf(:,:) = 2.800E-11_r8 + call jpl( rate(1,1,14), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 3.300E-31_r8 * itemp(:,:)**4.30_r8 + kinf(:,:) = 1.600E-12_r8 + call jpl( rate(1,1,26), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 b/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 new file mode 100644 index 0000000000..d05e3bdb96 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl/mo_sim_dat.F90 @@ -0,0 +1,130 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 1, 0, 0, 14, 0 /) + + cls_rxt_cnt(:,1) = (/ 4, 1, 0, 1 /) + cls_rxt_cnt(:,4) = (/ 0, 9, 21, 14 /) + + solsym(: 15) = (/ 'O3 ','OH ','HO2 ','H2O2 ','NO ', & + 'NO2 ','HNO3 ','CO ','CH2O ','CH3O2 ', & + 'CH3OOH ','DMS ','SO2 ','SO4 ','ISOP ' /) + + adv_mass(: 15) = (/ 47.998200_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, 30.006140_r8, & + 46.005540_r8, 63.012340_r8, 28.010400_r8, 30.025200_r8, 47.032000_r8, & + 48.039400_r8, 62.132400_r8, 64.064800_r8, 96.063600_r8, 68.114200_r8 /) + + crb_mass(: 15) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8 /) + + fix_mass(: 5) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 18.0142000_r8, 16.0406000_r8 /) + + clsmap(: 1,1) = (/ 8 /) + clsmap(: 14,4) = (/ 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, & + 12, 13, 14, 15 /) + + permute(: 14,4) = (/ 10, 13, 11, 4, 12, 9, 1, 7, 14, 8, & + 3, 5, 2, 6 /) + + diag_map(: 14) = (/ 1, 2, 3, 7, 13, 17, 23, 27, 32, 41, & + 51, 59, 74, 83 /) + + extfrc_lst(: 5) = (/ 'NO ','NO2 ','CO ','SO2 ','SO4 ' /) + + frc_from_dataset(: 5) = (/ .true., .true., .true., .true., .true. /) + + inv_lst(: 5) = (/ 'M ', 'N2 ', 'O2 ', 'H2O ', 'CH4 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 16) = (/ 'j2oh ', 'jh2o2 ', & + 'jno2 ', 'jch2o_a ', & + 'jch2o_b ', 'jch3ooh ', & + 'out6 ', 'usr_HO2_HO2 ', & + 'usr_oh_co ', 'het_no2_h2o ', & + 'usr_oh_dms ', 'tag_so2_oh_m ', & + 'aq_so2_h2o2 ', 'aq_so2_o3 ', & + 'isop_oh ', 'isop_o3 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 8, 10, 16, 23, & + 25, 26, 27, 28, 29, 30 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ 'jo3_a ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc b/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc new file mode 100644 index 0000000000..b0cd0b631d --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.doc @@ -0,0 +1,179 @@ + + + Solution species + ( 1) O3 + ( 2) OH (HO) + ( 3) HO2 + ( 4) H2O2 + ( 5) NO + ( 6) NO2 + ( 7) HNO3 + ( 8) CO + ( 9) CH2O + ( 10) CH3O2 + ( 11) CH3OOH (CH4O2) + ( 12) DMS (C2H6S) + ( 13) SO2 (O2S) + ( 14) ISOP (C5H8) + ( 15) H2SO4 + ( 16) SOAG (C) + ( 17) so4_a1 (NH4HSO4) + ( 18) pom_a1 (C) + ( 19) soa_a1 (C) + ( 20) bc_a1 (C) + ( 21) dst_a1 (AlSiO5) + ( 22) ncl_a1 (NaCl) + ( 23) num_a1 (H) + ( 24) so4_a2 (NH4HSO4) + ( 25) soa_a2 (C) + ( 26) ncl_a2 (NaCl) + ( 27) num_a2 (H) + ( 28) dst_a3 (AlSiO5) + ( 29) ncl_a3 (NaCl) + ( 30) so4_a3 (NH4HSO4) + ( 31) num_a3 (H) + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) H2O + ( 5) CH4 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CO + + Implicit + -------- + ( 1) O3 + ( 2) OH + ( 3) HO2 + ( 4) H2O2 + ( 5) NO + ( 6) NO2 + ( 7) HNO3 + ( 8) CH2O + ( 9) CH3O2 + ( 10) CH3OOH + ( 11) DMS + ( 12) SO2 + ( 13) ISOP + ( 14) H2SO4 + ( 15) SOAG + ( 16) so4_a1 + ( 17) pom_a1 + ( 18) soa_a1 + ( 19) bc_a1 + ( 20) dst_a1 + ( 21) ncl_a1 + ( 22) num_a1 + ( 23) so4_a2 + ( 24) soa_a2 + ( 25) ncl_a2 + ( 26) num_a2 + ( 27) dst_a3 + ( 28) ncl_a3 + ( 29) so4_a3 + ( 30) num_a3 + + Photolysis + j2oh ( 1) O3 + hv -> 2*OH rate = ** User defined ** ( 1) + jh2o2 ( 2) H2O2 + hv -> 2*OH rate = ** User defined ** ( 2) + jno2 ( 3) NO2 + hv -> NO + O3 rate = ** User defined ** ( 3) + jch2o_a ( 4) CH2O + hv -> CO + 2*HO2 rate = ** User defined ** ( 4) + jch2o_b ( 5) CH2O + hv -> CO rate = ** User defined ** ( 5) + jch3ooh ( 6) CH3OOH + hv -> CH2O + HO2 + OH rate = ** User defined ** ( 6) + + Reactions + ( 1) O3 + OH -> HO2 + O2 rate = 1.70E-12*exp( -940./t) ( 7) + out6 ( 2) HO2 + O3 -> 2*O2 + OH rate = 1.00E-14*exp( -490./t) ( 8) + ( 3) HO2 + OH -> H2O + O2 rate = 4.80E-11*exp( 250./t) ( 9) + usr_HO2_HO2 ( 4) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 10) + ( 5) H2O2 + OH -> H2O + HO2 rate = 1.80E-12 ( 11) + ( 6) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) ( 12) + ( 7) HO2 + NO -> NO2 + OH rate = 3.50E-12*exp( 250./t) ( 13) + ( 8) NO2 + OH + M -> HNO3 troe : ko=1.80E-30*(300/t)**3.00 ( 14) + ki=2.80E-11 + f=0.60 + ( 9) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) ( 15) + usr_oh_co ( 10) CO + OH -> HO2 rate = ** User defined ** ( 16) + ( 11) CH2O + OH -> CO + H2O + HO2 rate = 5.50E-12*exp( 125./t) ( 17) + ( 12) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) ( 18) + ( 13) CH3OOH + OH -> CH3O2 + H2O rate = 2.70E-12*exp( 200./t) ( 19) + ( 14) CH3OOH + OH -> CH2O + H2O + OH rate = 1.10E-12*exp( 200./t) ( 20) + ( 15) CH3O2 + NO -> CH2O + HO2 + NO2 rate = 2.80E-12*exp( 300./t) ( 21) + ( 16) CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 rate = 9.50E-14*exp( 390./t) ( 22) + het_no2_h2o ( 17) H2O + NO2 -> 0.50*HNO3 rate = ** User defined ** ( 23) + ( 18) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 24) + usr_DMS_OH ( 19) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 25) + usr_SO2_OH ( 20) SO2 + OH -> H2SO4 rate = ** User defined ** ( 26) + isop_oh ( 21) ISOP + OH -> 2*{CH3O2-1.5*OH} rate = 2.70E-11*exp( 390./t) ( 27) + isop_o3 ( 22) ISOP + O3 -> 0.87*CH2O + 1.86*CH3O2 + 0.06*HO2 + 0.05*CO rate = 5.59E-15*exp( -1814./t) ( 28) + +Extraneous prod/loss species + ( 1) NO + ( 2) NO2 (dataset) + ( 3) SO2 (dataset) + ( 4) so4_a1 (dataset) + ( 5) so4_a2 (dataset) + ( 6) pom_a1 (dataset) + ( 7) bc_a1 (dataset) + ( 8) num_a1 (dataset) + ( 9) num_a2 (dataset) + + + Equation Report + + d(O3)/dt = j3*NO2 + - j1*O3 - r1*OH*O3 - r2*HO2*O3 - r6*NO*O3 - r22*ISOP*O3 + d(OH)/dt = 2*j1*O3 + 2*j2*H2O2 + j6*CH3OOH + r2*HO2*O3 + r7*HO2*NO + - r9*CH4*OH - r1*O3*OH - r3*HO2*OH - r5*H2O2*OH - r8*M*NO2*OH - r10*CO*OH - r11*CH2O*OH + - r13*CH3OOH*OH - r18*DMS*OH - r19*DMS*OH - r20*SO2*OH - r21*ISOP*OH + d(HO2)/dt = 2*j4*CH2O + j6*CH3OOH + r1*O3*OH + r5*H2O2*OH + r10*CO*OH + r11*CH2O*OH + r15*CH3O2*NO + + .8*r16*CH3O2*CH3O2 + .5*r19*DMS*OH + .06*r22*ISOP*O3 + - r2*O3*HO2 - r3*OH*HO2 - 2*r4*HO2*HO2 - r7*NO*HO2 - r12*CH3O2*HO2 + d(H2O2)/dt = r4*HO2*HO2 + - j2*H2O2 - r5*OH*H2O2 + d(NO)/dt = j3*NO2 + - r6*O3*NO - r7*HO2*NO - r15*CH3O2*NO + d(NO2)/dt = r6*NO*O3 + r7*HO2*NO + r15*CH3O2*NO + - j3*NO2 - r17*H2O*NO2 - r8*M*OH*NO2 + d(HNO3)/dt = .5*r17*H2O*NO2 + r8*M*NO2*OH + d(CO)/dt = j4*CH2O + j5*CH2O + r11*CH2O*OH + .05*r22*ISOP*O3 + - r10*OH*CO + d(CH2O)/dt = j6*CH3OOH + r14*CH3OOH*OH + r15*CH3O2*NO + 2*r16*CH3O2*CH3O2 + .87*r22*ISOP*O3 + - j4*CH2O - j5*CH2O - r11*OH*CH2O + d(CH3O2)/dt = r9*CH4*OH + r13*CH3OOH*OH + 1.86*r22*ISOP*O3 + - r12*HO2*CH3O2 - r15*NO*CH3O2 - 2*r16*CH3O2*CH3O2 + d(CH3OOH)/dt = r12*CH3O2*HO2 + - j6*CH3OOH - r13*OH*CH3OOH - r14*OH*CH3OOH + d(DMS)/dt = - r18*OH*DMS - r19*OH*DMS + d(SO2)/dt = r18*DMS*OH + .5*r19*DMS*OH + - r20*OH*SO2 + d(ISOP)/dt = - r21*OH*ISOP - r22*O3*ISOP + d(H2SO4)/dt = r20*SO2*OH + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 diff --git a/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in b/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in new file mode 100644 index 0000000000..7c844d8f57 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/chem_mech.in @@ -0,0 +1,113 @@ +* Superfast LLNL mechanism with MAM3 aerosols +* for use with photolysis lookup table +* November 2012 (Dan Bergmann and Philip Cameron-Smith) + +SPECIES + + Solution + O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2 + CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, + ISOP -> C5H8 + H2SO4, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + End Solution + + Fixed + M, N2, O2, H2O, CH4 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + CO + End Explicit + Implicit + O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH + DMS, SO2, ISOP + H2SO4, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, num_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis +[j2oh->,jo3_a] O3 + hv -> 2*OH +[jh2o2] H2O2 + hv -> 2*OH +[jno2] NO2 + hv -> NO + O3 +[jch2o_a] CH2O + hv -> CO + 2*HO2 +[jch2o_b] CH2O + hv -> CO +[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH + End Photolysis + + Reactions + O3 + OH -> HO2 + O2 ; 1.700E-12, -940 +[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 + HO2 + OH -> H2O + O2 ; 4.800E-11, 250 +[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 1.800E-12 + NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 + HO2 + NO -> NO2 + OH ; 3.500E-12, 250 + NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 + CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 +[usr_oh_co] CO + OH -> HO2 + CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 + CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 + CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 + CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 + CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 + CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 +[het_no2_h2o] H2O + NO2 -> 0.50*HNO3 + DMS + OH -> SO2 ; 9.600E-12, -234 +[usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 +[usr_SO2_OH] SO2 + OH -> H2SO4 +[isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390 +[isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814 + + End Reactions + + Ext Forcing + NO + NO2 <- dataset + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + bc_a1 <- dataset + num_a1 <- dataset + num_a2 <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 b/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 new file mode 100644 index 0000000000..de37ec69da --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 6, & ! number of photolysis reactions + rxntot = 28, & ! number of total reactions + gascnt = 22, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 31, & ! number of "gas phase" species + nfs = 5, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 92, & ! number of non-zero matrix entries + extcnt = 9, & ! number of species with external forcing + clscnt1 = 1, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 30, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 14, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 b/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 new file mode 100644 index 0000000000..6c7be55d89 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/m_rxt_id.F90 @@ -0,0 +1,31 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_j2oh = 1 + integer, parameter :: rid_jh2o2 = 2 + integer, parameter :: rid_jno2 = 3 + integer, parameter :: rid_jch2o_a = 4 + integer, parameter :: rid_jch2o_b = 5 + integer, parameter :: rid_jch3ooh = 6 + integer, parameter :: rid_out6 = 8 + integer, parameter :: rid_usr_HO2_HO2 = 10 + integer, parameter :: rid_usr_oh_co = 16 + integer, parameter :: rid_het_no2_h2o = 23 + integer, parameter :: rid_usr_DMS_OH = 25 + integer, parameter :: rid_usr_SO2_OH = 26 + integer, parameter :: rid_isop_oh = 27 + integer, parameter :: rid_isop_o3 = 28 + integer, parameter :: rid_r0007 = 7 + integer, parameter :: rid_r0009 = 9 + integer, parameter :: rid_r0011 = 11 + integer, parameter :: rid_r0012 = 12 + integer, parameter :: rid_r0013 = 13 + integer, parameter :: rid_r0014 = 14 + integer, parameter :: rid_r0015 = 15 + integer, parameter :: rid_r0017 = 17 + integer, parameter :: rid_r0018 = 18 + integer, parameter :: rid_r0019 = 19 + integer, parameter :: rid_r0020 = 20 + integer, parameter :: rid_r0021 = 21 + integer, parameter :: rid_r0022 = 22 + integer, parameter :: rid_r0024 = 24 + end module m_rxt_id diff --git a/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 b/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 new file mode 100644 index 0000000000..b4543d369c --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/m_spc_id.F90 @@ -0,0 +1,34 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_OH = 2 + integer, parameter :: id_HO2 = 3 + integer, parameter :: id_H2O2 = 4 + integer, parameter :: id_NO = 5 + integer, parameter :: id_NO2 = 6 + integer, parameter :: id_HNO3 = 7 + integer, parameter :: id_CO = 8 + integer, parameter :: id_CH2O = 9 + integer, parameter :: id_CH3O2 = 10 + integer, parameter :: id_CH3OOH = 11 + integer, parameter :: id_DMS = 12 + integer, parameter :: id_SO2 = 13 + integer, parameter :: id_ISOP = 14 + integer, parameter :: id_H2SO4 = 15 + integer, parameter :: id_SOAG = 16 + integer, parameter :: id_so4_a1 = 17 + integer, parameter :: id_pom_a1 = 18 + integer, parameter :: id_soa_a1 = 19 + integer, parameter :: id_bc_a1 = 20 + integer, parameter :: id_dst_a1 = 21 + integer, parameter :: id_ncl_a1 = 22 + integer, parameter :: id_num_a1 = 23 + integer, parameter :: id_so4_a2 = 24 + integer, parameter :: id_soa_a2 = 25 + integer, parameter :: id_ncl_a2 = 26 + integer, parameter :: id_num_a2 = 27 + integer, parameter :: id_dst_a3 = 28 + integer, parameter :: id_ncl_a3 = 29 + integer, parameter :: id_so4_a3 = 30 + integer, parameter :: id_num_a3 = 31 + end module m_spc_id diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 new file mode 100644 index 0000000000..9b5036bb4e --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_adjrxt.F90 @@ -0,0 +1,40 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 14) = rate(:,:, 14) * inv(:,:, 1) + rate(:,:, 15) = rate(:,:, 15) * inv(:,:, 5) + rate(:,:, 23) = rate(:,:, 23) * inv(:,:, 4) + rate(:,:, 7) = rate(:,:, 7) * m(:,:) + rate(:,:, 8) = rate(:,:, 8) * m(:,:) + rate(:,:, 9) = rate(:,:, 9) * m(:,:) + rate(:,:, 10) = rate(:,:, 10) * m(:,:) + rate(:,:, 11) = rate(:,:, 11) * m(:,:) + rate(:,:, 12) = rate(:,:, 12) * m(:,:) + rate(:,:, 13) = rate(:,:, 13) * m(:,:) + rate(:,:, 14) = rate(:,:, 14) * m(:,:) + rate(:,:, 16) = rate(:,:, 16) * m(:,:) + rate(:,:, 17) = rate(:,:, 17) * m(:,:) + rate(:,:, 18) = rate(:,:, 18) * m(:,:) + rate(:,:, 19) = rate(:,:, 19) * m(:,:) + rate(:,:, 20) = rate(:,:, 20) * m(:,:) + rate(:,:, 21) = rate(:,:, 21) * m(:,:) + rate(:,:, 22) = rate(:,:, 22) * m(:,:) + rate(:,:, 24) = rate(:,:, 24) * m(:,:) + rate(:,:, 25) = rate(:,:, 25) * m(:,:) + rate(:,:, 26) = rate(:,:, 26) * m(:,:) + rate(:,:, 27) = rate(:,:, 27) * m(:,:) + rate(:,:, 28) = rate(:,:, 28) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_exp_sol.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 new file mode 100644 index 0000000000..cb729db565 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_indprd.F90 @@ -0,0 +1,62 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = (rxt(:,:,4) +rxt(:,:,5) +rxt(:,:,17)*y(:,:,2))*y(:,:,9) & + +.050_r8*rxt(:,:,28)*y(:,:,14)*y(:,:,1) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,30) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,29) = + extfrc(:,:,1) + prod(:,:,25) = + extfrc(:,:,2) + prod(:,:,1) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,19) = + extfrc(:,:,3) + prod(:,:,22) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = + extfrc(:,:,4) + prod(:,:,5) = + extfrc(:,:,6) + prod(:,:,6) = 0._r8 + prod(:,:,7) = + extfrc(:,:,7) + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = + extfrc(:,:,8) + prod(:,:,11) = + extfrc(:,:,5) + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = + extfrc(:,:,9) + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 new file mode 100644 index 0000000000..f9baa9dfba --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_lin_matrix.F90 @@ -0,0 +1,77 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(92) = -( rxt(1) + het_rates(1) ) + mat(47) = rxt(3) + mat(57) = -( rxt(15) + rxt(16)*y(8) + het_rates(2) ) + mat(88) = 2.000_r8*rxt(1) + mat(27) = 2.000_r8*rxt(2) + mat(40) = rxt(6) + mat(66) = -( het_rates(3) ) + mat(37) = 2.000_r8*rxt(4) + mat(41) = rxt(6) + mat(58) = rxt(16)*y(8) + mat(26) = -( rxt(2) + het_rates(4) ) + mat(83) = -( het_rates(5) ) + mat(46) = rxt(3) + mat(44) = -( rxt(3) + rxt(23) + het_rates(6) ) + mat(1) = -( het_rates(7) ) + mat(43) = .500_r8*rxt(23) + mat(35) = -( rxt(4) + rxt(5) + het_rates(9) ) + mat(38) = rxt(6) + mat(75) = -( het_rates(10) ) + mat(59) = rxt(15) + mat(39) = -( rxt(6) + het_rates(11) ) + mat(23) = -( het_rates(12) ) + mat(20) = -( het_rates(13) ) + mat(29) = -( het_rates(14) ) + mat(2) = -( het_rates(15) ) + mat(3) = -( het_rates(16) ) + mat(4) = -( het_rates(17) ) + mat(5) = -( het_rates(18) ) + mat(6) = -( het_rates(19) ) + mat(7) = -( het_rates(20) ) + mat(8) = -( het_rates(21) ) + mat(9) = -( het_rates(22) ) + mat(10) = -( het_rates(23) ) + mat(11) = -( het_rates(24) ) + mat(12) = -( het_rates(25) ) + mat(13) = -( het_rates(26) ) + mat(14) = -( het_rates(27) ) + mat(15) = -( het_rates(28) ) + mat(16) = -( het_rates(29) ) + mat(17) = -( het_rates(30) ) + mat(18) = -( het_rates(31) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 new file mode 100644 index 0000000000..1aff1030db --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_factor.F90 @@ -0,0 +1,171 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(20) = 1._r8 / lu(20) + lu(21) = lu(21) * lu(20) + lu(24) = lu(24) - lu(21) * lu(22) + lu(57) = lu(57) - lu(21) * lu(50) + lu(23) = 1._r8 / lu(23) + lu(24) = lu(24) * lu(23) + lu(25) = lu(25) * lu(23) + lu(57) = lu(57) - lu(24) * lu(51) + lu(58) = lu(58) - lu(25) * lu(51) + lu(26) = 1._r8 / lu(26) + lu(27) = lu(27) * lu(26) + lu(28) = lu(28) * lu(26) + lu(57) = lu(57) - lu(27) * lu(52) + lu(58) = lu(58) - lu(28) * lu(52) + lu(65) = lu(65) - lu(27) * lu(62) + lu(66) = lu(66) - lu(28) * lu(62) + lu(29) = 1._r8 / lu(29) + lu(30) = lu(30) * lu(29) + lu(31) = lu(31) * lu(29) + lu(32) = lu(32) * lu(29) + lu(33) = lu(33) * lu(29) + lu(34) = lu(34) * lu(29) + lu(54) = lu(54) - lu(30) * lu(53) + lu(57) = lu(57) - lu(31) * lu(53) + lu(58) = lu(58) - lu(32) * lu(53) + lu(59) = lu(59) - lu(33) * lu(53) + lu(61) = lu(61) - lu(34) * lu(53) + lu(86) = lu(86) - lu(30) * lu(85) + lu(88) = lu(88) - lu(31) * lu(85) + lu(89) = lu(89) - lu(32) * lu(85) + lu(90) = lu(90) - lu(33) * lu(85) + lu(92) = lu(92) - lu(34) * lu(85) + lu(35) = 1._r8 / lu(35) + lu(36) = lu(36) * lu(35) + lu(37) = lu(37) * lu(35) + lu(40) = lu(40) - lu(36) * lu(38) + lu(41) = lu(41) - lu(37) * lu(38) + lu(57) = lu(57) - lu(36) * lu(54) + lu(58) = lu(58) - lu(37) * lu(54) + lu(73) = - lu(36) * lu(70) + lu(74) = lu(74) - lu(37) * lu(70) + lu(80) = lu(80) - lu(36) * lu(78) + lu(81) = lu(81) - lu(37) * lu(78) + lu(88) = lu(88) - lu(36) * lu(86) + lu(89) = lu(89) - lu(37) * lu(86) + lu(39) = 1._r8 / lu(39) + lu(40) = lu(40) * lu(39) + lu(41) = lu(41) * lu(39) + lu(42) = lu(42) * lu(39) + lu(57) = lu(57) - lu(40) * lu(55) + lu(58) = lu(58) - lu(41) * lu(55) + lu(59) = lu(59) - lu(42) * lu(55) + lu(65) = lu(65) - lu(40) * lu(63) + lu(66) = lu(66) - lu(41) * lu(63) + lu(67) = lu(67) - lu(42) * lu(63) + lu(73) = lu(73) - lu(40) * lu(71) + lu(74) = lu(74) - lu(41) * lu(71) + lu(75) = lu(75) - lu(42) * lu(71) + lu(44) = 1._r8 / lu(44) + lu(45) = lu(45) * lu(44) + lu(46) = lu(46) * lu(44) + lu(47) = lu(47) * lu(44) + lu(57) = lu(57) - lu(45) * lu(56) + lu(60) = - lu(46) * lu(56) + lu(61) = lu(61) - lu(47) * lu(56) + lu(65) = lu(65) - lu(45) * lu(64) + lu(68) = lu(68) - lu(46) * lu(64) + lu(69) = lu(69) - lu(47) * lu(64) + lu(73) = lu(73) - lu(45) * lu(72) + lu(76) = lu(76) - lu(46) * lu(72) + lu(77) = - lu(47) * lu(72) + lu(80) = lu(80) - lu(45) * lu(79) + lu(83) = lu(83) - lu(46) * lu(79) + lu(84) = lu(84) - lu(47) * lu(79) + lu(88) = lu(88) - lu(45) * lu(87) + lu(91) = lu(91) - lu(46) * lu(87) + lu(92) = lu(92) - lu(47) * lu(87) + lu(57) = 1._r8 / lu(57) + lu(58) = lu(58) * lu(57) + lu(59) = lu(59) * lu(57) + lu(60) = lu(60) * lu(57) + lu(61) = lu(61) * lu(57) + lu(66) = lu(66) - lu(58) * lu(65) + lu(67) = lu(67) - lu(59) * lu(65) + lu(68) = lu(68) - lu(60) * lu(65) + lu(69) = lu(69) - lu(61) * lu(65) + lu(74) = lu(74) - lu(58) * lu(73) + lu(75) = lu(75) - lu(59) * lu(73) + lu(76) = lu(76) - lu(60) * lu(73) + lu(77) = lu(77) - lu(61) * lu(73) + lu(81) = lu(81) - lu(58) * lu(80) + lu(82) = lu(82) - lu(59) * lu(80) + lu(83) = lu(83) - lu(60) * lu(80) + lu(84) = lu(84) - lu(61) * lu(80) + lu(89) = lu(89) - lu(58) * lu(88) + lu(90) = lu(90) - lu(59) * lu(88) + lu(91) = lu(91) - lu(60) * lu(88) + lu(92) = lu(92) - lu(61) * lu(88) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(66) = 1._r8 / lu(66) + lu(67) = lu(67) * lu(66) + lu(68) = lu(68) * lu(66) + lu(69) = lu(69) * lu(66) + lu(75) = lu(75) - lu(67) * lu(74) + lu(76) = lu(76) - lu(68) * lu(74) + lu(77) = lu(77) - lu(69) * lu(74) + lu(82) = lu(82) - lu(67) * lu(81) + lu(83) = lu(83) - lu(68) * lu(81) + lu(84) = lu(84) - lu(69) * lu(81) + lu(90) = lu(90) - lu(67) * lu(89) + lu(91) = lu(91) - lu(68) * lu(89) + lu(92) = lu(92) - lu(69) * lu(89) + lu(75) = 1._r8 / lu(75) + lu(76) = lu(76) * lu(75) + lu(77) = lu(77) * lu(75) + lu(83) = lu(83) - lu(76) * lu(82) + lu(84) = lu(84) - lu(77) * lu(82) + lu(91) = lu(91) - lu(76) * lu(90) + lu(92) = lu(92) - lu(77) * lu(90) + lu(83) = 1._r8 / lu(83) + lu(84) = lu(84) * lu(83) + lu(92) = lu(92) - lu(84) * lu(91) + lu(92) = 1._r8 / lu(92) + end subroutine lu_fac02 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 new file mode 100644 index 0000000000..59e0e0eb20 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_lu_solve.F90 @@ -0,0 +1,144 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(26) = b(26) - lu(21) * b(19) + b(26) = b(26) - lu(24) * b(20) + b(27) = b(27) - lu(25) * b(20) + b(26) = b(26) - lu(27) * b(21) + b(27) = b(27) - lu(28) * b(21) + b(23) = b(23) - lu(30) * b(22) + b(26) = b(26) - lu(31) * b(22) + b(27) = b(27) - lu(32) * b(22) + b(28) = b(28) - lu(33) * b(22) + b(30) = b(30) - lu(34) * b(22) + b(26) = b(26) - lu(36) * b(23) + b(27) = b(27) - lu(37) * b(23) + b(26) = b(26) - lu(40) * b(24) + b(27) = b(27) - lu(41) * b(24) + b(28) = b(28) - lu(42) * b(24) + b(26) = b(26) - lu(45) * b(25) + b(29) = b(29) - lu(46) * b(25) + b(30) = b(30) - lu(47) * b(25) + b(27) = b(27) - lu(58) * b(26) + b(28) = b(28) - lu(59) * b(26) + b(29) = b(29) - lu(60) * b(26) + b(30) = b(30) - lu(61) * b(26) + b(28) = b(28) - lu(67) * b(27) + b(29) = b(29) - lu(68) * b(27) + b(30) = b(30) - lu(69) * b(27) + b(29) = b(29) - lu(76) * b(28) + b(30) = b(30) - lu(77) * b(28) + b(30) = b(30) - lu(84) * b(29) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(30) = b(30) * lu(92) + b(29) = b(29) - lu(91) * b(30) + b(28) = b(28) - lu(90) * b(30) + b(27) = b(27) - lu(89) * b(30) + b(26) = b(26) - lu(88) * b(30) + b(25) = b(25) - lu(87) * b(30) + b(23) = b(23) - lu(86) * b(30) + b(22) = b(22) - lu(85) * b(30) + b(29) = b(29) * lu(83) + b(28) = b(28) - lu(82) * b(29) + b(27) = b(27) - lu(81) * b(29) + b(26) = b(26) - lu(80) * b(29) + b(25) = b(25) - lu(79) * b(29) + b(23) = b(23) - lu(78) * b(29) + b(28) = b(28) * lu(75) + b(27) = b(27) - lu(74) * b(28) + b(26) = b(26) - lu(73) * b(28) + b(25) = b(25) - lu(72) * b(28) + b(24) = b(24) - lu(71) * b(28) + b(23) = b(23) - lu(70) * b(28) + b(27) = b(27) * lu(66) + b(26) = b(26) - lu(65) * b(27) + b(25) = b(25) - lu(64) * b(27) + b(24) = b(24) - lu(63) * b(27) + b(21) = b(21) - lu(62) * b(27) + b(26) = b(26) * lu(57) + b(25) = b(25) - lu(56) * b(26) + b(24) = b(24) - lu(55) * b(26) + b(23) = b(23) - lu(54) * b(26) + b(22) = b(22) - lu(53) * b(26) + b(21) = b(21) - lu(52) * b(26) + b(20) = b(20) - lu(51) * b(26) + b(19) = b(19) - lu(50) * b(26) + b(2) = b(2) - lu(49) * b(26) + b(1) = b(1) - lu(48) * b(26) + b(25) = b(25) * lu(44) + b(1) = b(1) - lu(43) * b(25) + b(24) = b(24) * lu(39) + b(23) = b(23) - lu(38) * b(24) + b(23) = b(23) * lu(35) + b(22) = b(22) * lu(29) + b(21) = b(21) * lu(26) + b(20) = b(20) * lu(23) + b(19) = b(19) - lu(22) * b(20) + b(19) = b(19) * lu(20) + b(2) = b(2) - lu(19) * b(19) + b(18) = b(18) * lu(18) + b(17) = b(17) * lu(17) + b(16) = b(16) * lu(16) + b(15) = b(15) * lu(15) + b(14) = b(14) * lu(14) + b(13) = b(13) * lu(13) + b(12) = b(12) * lu(12) + b(11) = b(11) * lu(11) + b(10) = b(10) * lu(10) + b(9) = b(9) * lu(9) + b(8) = b(8) * lu(8) + b(7) = b(7) * lu(7) + b(6) = b(6) * lu(6) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 new file mode 100644 index 0000000000..cdb1a39b74 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_nln_matrix.F90 @@ -0,0 +1,206 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(92) = -(rxt(7)*y(2) + rxt(8)*y(3) + rxt(12)*y(5) + rxt(28)*y(14)) + mat(61) = -rxt(7)*y(1) + mat(69) = -rxt(8)*y(1) + mat(84) = -rxt(12)*y(1) + mat(34) = -rxt(28)*y(1) + mat(57) = -(rxt(7)*y(1) + rxt(9)*y(3) + rxt(11)*y(4) + rxt(14)*y(6) + rxt(17) & + *y(9) + rxt(19)*y(11) + (rxt(24) + rxt(25)) * y(12) + rxt(26) & + *y(13) + rxt(27)*y(14)) + mat(88) = -rxt(7)*y(2) + mat(65) = -rxt(9)*y(2) + mat(27) = -rxt(11)*y(2) + mat(45) = -rxt(14)*y(2) + mat(36) = -rxt(17)*y(2) + mat(40) = -rxt(19)*y(2) + mat(24) = -(rxt(24) + rxt(25)) * y(2) + mat(21) = -rxt(26)*y(2) + mat(31) = -rxt(27)*y(2) + mat(88) = mat(88) + rxt(8)*y(3) + mat(65) = mat(65) + rxt(8)*y(1) + rxt(13)*y(5) + mat(80) = rxt(13)*y(3) + mat(66) = -(rxt(8)*y(1) + rxt(9)*y(2) + 4._r8*rxt(10)*y(3) + rxt(13)*y(5) & + + rxt(18)*y(10)) + mat(89) = -rxt(8)*y(3) + mat(58) = -rxt(9)*y(3) + mat(81) = -rxt(13)*y(3) + mat(74) = -rxt(18)*y(3) + mat(89) = mat(89) + rxt(7)*y(2) + .060_r8*rxt(28)*y(14) + mat(58) = mat(58) + rxt(7)*y(1) + rxt(11)*y(4) + rxt(17)*y(9) & + + .500_r8*rxt(25)*y(12) + mat(28) = rxt(11)*y(2) + mat(81) = mat(81) + rxt(21)*y(10) + mat(37) = rxt(17)*y(2) + mat(74) = mat(74) + rxt(21)*y(5) + 1.600_r8*rxt(22)*y(10) + mat(25) = .500_r8*rxt(25)*y(2) + mat(32) = .060_r8*rxt(28)*y(1) + mat(26) = -(rxt(11)*y(2)) + mat(52) = -rxt(11)*y(4) + mat(62) = 2.000_r8*rxt(10)*y(3) + mat(83) = -(rxt(12)*y(1) + rxt(13)*y(3) + rxt(21)*y(10)) + mat(91) = -rxt(12)*y(5) + mat(68) = -rxt(13)*y(5) + mat(76) = -rxt(21)*y(5) + mat(44) = -(rxt(14)*y(2)) + mat(56) = -rxt(14)*y(6) + mat(87) = rxt(12)*y(5) + mat(64) = rxt(13)*y(5) + mat(79) = rxt(12)*y(1) + rxt(13)*y(3) + rxt(21)*y(10) + mat(72) = rxt(21)*y(5) + mat(48) = rxt(14)*y(6) + mat(43) = rxt(14)*y(2) + mat(35) = -(rxt(17)*y(2)) + mat(54) = -rxt(17)*y(9) + mat(86) = .870_r8*rxt(28)*y(14) + mat(54) = mat(54) + rxt(20)*y(11) + mat(78) = rxt(21)*y(10) + mat(70) = rxt(21)*y(5) + 4.000_r8*rxt(22)*y(10) + mat(38) = rxt(20)*y(2) + mat(30) = .870_r8*rxt(28)*y(1) + mat(75) = -(rxt(18)*y(3) + rxt(21)*y(5) + 4._r8*rxt(22)*y(10)) + mat(67) = -rxt(18)*y(10) + mat(82) = -rxt(21)*y(10) + mat(90) = 1.860_r8*rxt(28)*y(14) + mat(59) = rxt(19)*y(11) + mat(42) = rxt(19)*y(2) + mat(33) = 1.860_r8*rxt(28)*y(1) + mat(39) = -((rxt(19) + rxt(20)) * y(2)) + mat(55) = -(rxt(19) + rxt(20)) * y(11) + mat(63) = rxt(18)*y(10) + mat(71) = rxt(18)*y(3) + mat(23) = -((rxt(24) + rxt(25)) * y(2)) + mat(51) = -(rxt(24) + rxt(25)) * y(12) + mat(20) = -(rxt(26)*y(2)) + mat(50) = -rxt(26)*y(13) + mat(50) = mat(50) + (rxt(24)+.500_r8*rxt(25))*y(12) + mat(22) = (rxt(24)+.500_r8*rxt(25))*y(2) + mat(29) = -(rxt(27)*y(2) + rxt(28)*y(1)) + mat(53) = -rxt(27)*y(14) + mat(85) = -rxt(28)*y(14) + mat(49) = rxt(26)*y(13) + mat(19) = rxt(26)*y(2) + end subroutine nlnmat01 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 20) = mat( 20) + lmat( 20) + mat( 23) = mat( 23) + lmat( 23) + mat( 26) = mat( 26) + lmat( 26) + mat( 27) = mat( 27) + lmat( 27) + mat( 29) = mat( 29) + lmat( 29) + mat( 35) = mat( 35) + lmat( 35) + mat( 37) = mat( 37) + lmat( 37) + mat( 38) = mat( 38) + lmat( 38) + mat( 39) = mat( 39) + lmat( 39) + mat( 40) = mat( 40) + lmat( 40) + mat( 41) = lmat( 41) + mat( 43) = mat( 43) + lmat( 43) + mat( 44) = mat( 44) + lmat( 44) + mat( 46) = lmat( 46) + mat( 47) = lmat( 47) + mat( 57) = mat( 57) + lmat( 57) + mat( 58) = mat( 58) + lmat( 58) + mat( 59) = mat( 59) + lmat( 59) + mat( 66) = mat( 66) + lmat( 66) + mat( 75) = mat( 75) + lmat( 75) + mat( 83) = mat( 83) + lmat( 83) + mat( 88) = mat( 88) + lmat( 88) + mat( 92) = mat( 92) + lmat( 92) + mat( 60) = 0._r8 + mat( 73) = 0._r8 + mat( 77) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 20) = mat( 20) - dti + mat( 23) = mat( 23) - dti + mat( 26) = mat( 26) - dti + mat( 29) = mat( 29) - dti + mat( 35) = mat( 35) - dti + mat( 39) = mat( 39) - dti + mat( 44) = mat( 44) - dti + mat( 57) = mat( 57) - dti + mat( 66) = mat( 66) - dti + mat( 75) = mat( 75) - dti + mat( 83) = mat( 83) - dti + mat( 92) = mat( 92) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 new file mode 100644 index 0000000000..d39cbed397 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_prod_loss.F90 @@ -0,0 +1,112 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = (rxt(:,:,16)* y(:,:,2) + het_rates(:,:,8))* y(:,:,8) + prod(:,:,1) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(30) = (rxt(7)* y(2) +rxt(8)* y(3) +rxt(12)* y(5) +rxt(28)* y(14) & + + rxt(1) + het_rates(1))* y(1) + prod(30) =rxt(3)*y(6) + loss(26) = (rxt(7)* y(1) +rxt(9)* y(3) +rxt(11)* y(4) +rxt(14)* y(6) +rxt(16) & + * y(8) +rxt(17)* y(9) +rxt(19)* y(11) + (rxt(24) +rxt(25))* y(12) & + +rxt(26)* y(13) +rxt(27)* y(14) + rxt(15) + het_rates(2))* y(2) + prod(26) = (2.000_r8*rxt(1) +rxt(8)*y(3))*y(1) +rxt(13)*y(5)*y(3) & + +2.000_r8*rxt(2)*y(4) +rxt(6)*y(11) + loss(27) = (rxt(8)* y(1) +rxt(9)* y(2) + 2._r8*rxt(10)* y(3) +rxt(13)* y(5) & + +rxt(18)* y(10) + het_rates(3))* y(3) + prod(27) = (rxt(16)*y(8) +rxt(7)*y(1) +rxt(11)*y(4) +rxt(17)*y(9) + & + .500_r8*rxt(25)*y(12))*y(2) + (rxt(21)*y(5) +.800_r8*rxt(22)*y(10)) & + *y(10) +.060_r8*rxt(28)*y(14)*y(1) +2.000_r8*rxt(4)*y(9) +rxt(6) & + *y(11) + loss(21) = (rxt(11)* y(2) + rxt(2) + het_rates(4))* y(4) + prod(21) =rxt(10)*y(3)*y(3) + loss(29) = (rxt(12)* y(1) +rxt(13)* y(3) +rxt(21)* y(10) + het_rates(5)) & + * y(5) + prod(29) =rxt(3)*y(6) + loss(25) = (rxt(14)* y(2) + rxt(3) + rxt(23) + het_rates(6))* y(6) + prod(25) = (rxt(12)*y(1) +rxt(13)*y(3) +rxt(21)*y(10))*y(5) + loss(1) = ( + het_rates(7))* y(7) + prod(1) = (.500_r8*rxt(23) +rxt(14)*y(2))*y(6) + loss(23) = (rxt(17)* y(2) + rxt(4) + rxt(5) + het_rates(9))* y(9) + prod(23) = (rxt(21)*y(5) +2.000_r8*rxt(22)*y(10))*y(10) + (rxt(6) + & + rxt(20)*y(2))*y(11) +.870_r8*rxt(28)*y(14)*y(1) + loss(28) = (rxt(18)* y(3) +rxt(21)* y(5) + 2._r8*rxt(22)* y(10) & + + het_rates(10))* y(10) + prod(28) = (rxt(15) +rxt(19)*y(11))*y(2) +1.860_r8*rxt(28)*y(14)*y(1) + loss(24) = ((rxt(19) +rxt(20))* y(2) + rxt(6) + het_rates(11))* y(11) + prod(24) =rxt(18)*y(10)*y(3) + loss(20) = ((rxt(24) +rxt(25))* y(2) + het_rates(12))* y(12) + prod(20) = 0._r8 + loss(19) = (rxt(26)* y(2) + het_rates(13))* y(13) + prod(19) = (rxt(24)*y(12) +.500_r8*rxt(25)*y(12))*y(2) + loss(22) = (rxt(28)* y(1) +rxt(27)* y(2) + het_rates(14))* y(14) + prod(22) = 0._r8 + loss(2) = ( + het_rates(15))* y(15) + prod(2) =rxt(26)*y(13)*y(2) + loss(3) = ( + het_rates(16))* y(16) + prod(3) = 0._r8 + loss(4) = ( + het_rates(17))* y(17) + prod(4) = 0._r8 + loss(5) = ( + het_rates(18))* y(18) + prod(5) = 0._r8 + loss(6) = ( + het_rates(19))* y(19) + prod(6) = 0._r8 + loss(7) = ( + het_rates(20))* y(20) + prod(7) = 0._r8 + loss(8) = ( + het_rates(21))* y(21) + prod(8) = 0._r8 + loss(9) = ( + het_rates(22))* y(22) + prod(9) = 0._r8 + loss(10) = ( + het_rates(23))* y(23) + prod(10) = 0._r8 + loss(11) = ( + het_rates(24))* y(24) + prod(11) = 0._r8 + loss(12) = ( + het_rates(25))* y(25) + prod(12) = 0._r8 + loss(13) = ( + het_rates(26))* y(26) + prod(13) = 0._r8 + loss(14) = ( + het_rates(27))* y(27) + prod(14) = 0._r8 + loss(15) = ( + het_rates(28))* y(28) + prod(15) = 0._r8 + loss(16) = ( + het_rates(29))* y(29) + prod(16) = 0._r8 + loss(17) = ( + het_rates(30))* y(30) + prod(17) = 0._r8 + loss(18) = ( + het_rates(31))* y(31) + prod(18) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..dcbe8afe65 --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_rxt_rates_conv.F90 @@ -0,0 +1,40 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*H2O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 6) ! rate_const*NO2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 9) ! rate_const*CH2O + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 9) ! rate_const*CH2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 11) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 1)*sol(:ncol,:, 2) ! rate_const*O3*OH + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 3)*sol(:ncol,:, 2) ! rate_const*HO2*OH + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 4)*sol(:ncol,:, 2) ! rate_const*H2O2*OH + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 3)*sol(:ncol,:, 5) ! rate_const*HO2*NO + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 2) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 8)*sol(:ncol,:, 2) ! rate_const*CO*OH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 10)*sol(:ncol,:, 3) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 10)*sol(:ncol,:, 5) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 10)*sol(:ncol,:, 10) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 6) ! rate_const*H2O*NO2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 12)*sol(:ncol,:, 2) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 12)*sol(:ncol,:, 2) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 13)*sol(:ncol,:, 2) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 14)*sol(:ncol,:, 2) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 14)*sol(:ncol,:, 1) ! rate_const*ISOP*O3 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 new file mode 100644 index 0000000000..87fa6f0c2d --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_setrxt.F90 @@ -0,0 +1,100 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,11) = 1.800E-12_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,7) = 1.700E-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:,8) = 1.000E-14_r8 * exp( -490._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,9) = 4.800E-11_r8 * exp_fac(:,:) + rate(:,:,13) = 3.500E-12_r8 * exp_fac(:,:) + rate(:,:,12) = 3.000E-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:,15) = 2.450E-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,17) = 5.500E-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,18) = 4.100E-13_r8 * exp( 750._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,19) = 2.700E-12_r8 * exp_fac(:,:) + rate(:,:,20) = 1.100E-12_r8 * exp_fac(:,:) + rate(:,:,21) = 2.800E-12_r8 * exp( 300._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 390._r8 * itemp(:,:) ) + rate(:,:,22) = 9.500E-14_r8 * exp_fac(:,:) + rate(:,:,27) = 2.700E-11_r8 * exp_fac(:,:) + rate(:,:,24) = 9.600E-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,28) = 5.590E-15_r8 * exp( -1814._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 1.800E-30_r8 * itemp(:,:)**3.00_r8 + kinf(:,:) = 2.800E-11_r8 + call jpl( rate(1,1,14), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 b/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 new file mode 100644 index 0000000000..283c4f55ca --- /dev/null +++ b/src/chemistry/pp_super_fast_llnl_mam3/mo_sim_dat.F90 @@ -0,0 +1,146 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 1, 0, 0, 30, 0 /) + + cls_rxt_cnt(:,1) = (/ 4, 1, 0, 1 /) + cls_rxt_cnt(:,4) = (/ 0, 9, 19, 30 /) + + solsym(: 31) = (/ 'O3 ','OH ','HO2 ','H2O2 ','NO ', & + 'NO2 ','HNO3 ','CO ','CH2O ','CH3O2 ', & + 'CH3OOH ','DMS ','SO2 ','ISOP ','H2SO4 ', & + 'SOAG ','so4_a1 ','pom_a1 ','soa_a1 ','bc_a1 ', & + 'dst_a1 ','ncl_a1 ','num_a1 ','so4_a2 ','soa_a2 ', & + 'ncl_a2 ','num_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ', & + 'num_a3 ' /) + + adv_mass(: 31) = (/ 47.998200_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, 30.006140_r8, & + 46.005540_r8, 63.012340_r8, 28.010400_r8, 30.025200_r8, 47.032000_r8, & + 48.039400_r8, 62.132400_r8, 64.064800_r8, 68.114200_r8, 98.078400_r8, & + 12.011000_r8, 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 135.064039_r8, 58.442468_r8, 1.007400_r8, 115.107340_r8, 12.011000_r8, & + 58.442468_r8, 1.007400_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, & + 1.007400_r8 /) + + crb_mass(: 31) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_r8, 60.055000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8 /) + + fix_mass(: 5) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 18.0142000_r8, 16.0406000_r8 /) + + clsmap(: 1,1) = (/ 8 /) + clsmap(: 30,4) = (/ 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31 /) + + permute(: 30,4) = (/ 30, 26, 27, 21, 29, 25, 1, 23, 28, 24, & + 20, 19, 22, 2, 3, 4, 5, 6, 7, 8, & + 9, 10, 11, 12, 13, 14, 15, 16, 17, 18 /) + + diag_map(: 30) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 20, 23, & + 26, 29, 35, 39, 44, 57, 66, 75, 83, 92 /) + + extfrc_lst(: 9) = (/ 'NO ','NO2 ','SO2 ','so4_a1 ','so4_a2 ', & + 'pom_a1 ','bc_a1 ','num_a1 ','num_a2 ' /) + + frc_from_dataset(: 9) = (/ .false., .true., .true., .true., .true., & + .true., .true., .true., .true. /) + + inv_lst(: 5) = (/ 'M ', 'N2 ', 'O2 ', 'H2O ', 'CH4 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 14) = (/ 'j2oh ', 'jh2o2 ', & + 'jno2 ', 'jch2o_a ', & + 'jch2o_b ', 'jch3ooh ', & + 'out6 ', 'usr_HO2_HO2 ', & + 'usr_oh_co ', 'het_no2_h2o ', & + 'usr_DMS_OH ', 'usr_SO2_OH ', & + 'isop_oh ', 'isop_o3 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 8, 10, 16, 23, & + 25, 26, 27, 28 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ 'jo3_a ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_terminator/chem_mech.doc b/src/chemistry/pp_terminator/chem_mech.doc new file mode 100644 index 0000000000..ec2acce749 --- /dev/null +++ b/src/chemistry/pp_terminator/chem_mech.doc @@ -0,0 +1,41 @@ + + + Solution species + ( 1) CL (Cl) + ( 2) CL2 (Cl2) + ( 3) RHO (H) + + + Invariant species + ( 1) M + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) CL + ( 2) CL2 + ( 3) RHO + + Photolysis + + Reactions + toy_k1 ( 1) CL2 -> 2.*CL rate = ** User defined ** ( 1) + toy_k2 ( 2) CL + CL -> CL2 rate = ** User defined ** ( 2) + +Extraneous prod/loss species + + + Equation Report + + d(CL)/dt = 2*r1*CL2 + - 2*r2*CL*CL + d(CL2)/dt = r2*CL*CL + - r1*CL2 + d(RHO)/dt = 0 diff --git a/src/chemistry/pp_terminator/chem_mech.in b/src/chemistry/pp_terminator/chem_mech.in new file mode 100644 index 0000000000..72050b16e6 --- /dev/null +++ b/src/chemistry/pp_terminator/chem_mech.in @@ -0,0 +1,53 @@ +SPECIES + + Solution + CL -> Cl, CL2 -> Cl2, RHO -> H + End Solution + + Fixed + M + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + End Explicit + Implicit + CL, CL2, RHO + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis + End Photolysis + + Reactions + [toy_k1] CL2 -> 2.*CL + [toy_k2] CL + CL -> CL2 + End Reactions + + Ext Forcing + End Ext Forcing + +END CHEMISTRY + +SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + +END SIMULATION PARAMETERS + diff --git a/src/chemistry/pp_terminator/chem_mods.F90 b/src/chemistry/pp_terminator/chem_mods.F90 new file mode 100644 index 0000000000..31d67260c3 --- /dev/null +++ b/src/chemistry/pp_terminator/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 0, & ! number of photolysis reactions + rxntot = 2, & ! number of total reactions + gascnt = 2, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 3, & ! number of "gas phase" species + nfs = 1, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 5, & ! number of non-zero matrix entries + extcnt = 0, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 3, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 2, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_terminator/chemistry.F90 b/src/chemistry/pp_terminator/chemistry.F90 new file mode 100644 index 0000000000..20d24047a5 --- /dev/null +++ b/src/chemistry/pp_terminator/chemistry.F90 @@ -0,0 +1,432 @@ +!================================================================================================ +! This is the "toy" chemistry module. +!================================================================================================ + +module chemistry + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use ppgrid, only: begchunk, endchunk, pcols + use ppgrid, only: pver + use constituents, only: pcnst, cnst_add + use mo_gas_phase_chemdr, only: map2chm + use mo_constants, only: pi + use shr_const_mod, only: molw_dryair=>SHR_CONST_MWDAIR + use mo_chem_utls, only : get_spc_ndx + use chem_mods, only : gas_pcnst, adv_mass + use mo_sim_dat, only: set_sim_dat + implicit none + private + save + ! + ! Public interfaces + ! + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_init ! time interpolate chemical loss frequencies + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_readnl ! read chem namelist + public :: chem_reset_fluxes + public :: chem_emissions + + interface chem_write_restart + module procedure chem_write_restart_bin + module procedure chem_write_restart_pio + end interface + interface chem_read_restart + module procedure chem_read_restart_bin + module procedure chem_read_restart_pio + end interface + + ! Private data + integer, parameter :: nspecies = 3 + + integer :: idx_cl =-1 + integer :: idx_cl2=-1 + + real(r8), parameter :: k1_lat_center = pi* 20.0_r8/180._r8 + real(r8), parameter :: k1_lon_center = pi*300.0_r8/180._r8 + + character(len=8) :: species(nspecies) = (/ 'CL ','CL2 ','RHO '/) + integer :: indices(nspecies) + +!================================================================================================ +contains +!================================================================================================ + + logical function chem_is (name) + + character(len=*), intent(in) :: name + + chem_is = .false. + if (name == 'toy' ) then + chem_is = .true. + end if + + end function chem_is + +!================================================================================================ + + subroutine chem_register + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents for parameterized greenhouse gas chemistry + ! + !----------------------------------------------------------------------- + + real(r8), parameter :: cptmp = 666._r8 + real(r8), parameter :: qmin = -1.e36_r8 + + logical :: camout + integer :: i, n + + do i = 1, nspecies + camout = trim(species(i)) .eq. 'RHO' + call cnst_add( species(i), adv_mass(i), cptmp, qmin, n, & + readiv=.true.,mixtype='dry',cam_outfld=camout) + indices(i) = n + map2chm(n) = i + enddo + + call set_sim_dat() + + idx_cl = get_spc_ndx('CL') + idx_cl2 = get_spc_ndx('CL2') + + end subroutine chem_register + +!================================================================================================ + + subroutine chem_readnl(nlfile) + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + end subroutine chem_readnl + +!================================================================================================ + + function chem_is_active() + !----------------------------------------------------------------------- + logical :: chem_is_active + !----------------------------------------------------------------------- + chem_is_active = .true. + end function chem_is_active + +!================================================================================================ + + function chem_implements_cnst(name) + !----------------------------------------------------------------------- + ! + ! Purpose: return true if specified constituent is implemented by this package + ! + ! Author: B. Eaton + ! + !----------------------------------------------------------------------- + implicit none + !-----------------------------Arguments--------------------------------- + + character(len=*), intent(in) :: name ! constituent name + logical :: chem_implements_cnst ! return value + + integer :: i + + chem_implements_cnst = .false. + + do i = 1, nspecies + if (trim(species(i)) .eq. trim(name)) then + chem_implements_cnst = .true. + exit + end if + end do + + end function chem_implements_cnst + +!=============================================================================== + + subroutine chem_init(phys_state, pbuf2d) + !----------------------------------------------------------------------- + ! + ! Purpose: initialize parameterized greenhouse gas chemistry + ! (declare history variables) + ! + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc + use cam_history, only: addfld, add_default, horiz_only + + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: i + + do i = 1, nspecies + call addfld ( species(i), (/'lev'/), 'A', 'mole/mole', trim(species(i))//' mixing ratio' ) + call add_default ( species(i), 1, ' ') + enddo + + call addfld( 'k1', horiz_only, 'A', '/s ', 'reaction rate ' ) + call addfld( 'k2', horiz_only, 'A', '/s ', 'reaction rate ' ) + call add_default ( 'k1', 1, ' ') + call add_default ( 'k2', 1, ' ') + + call addfld ( 'CLy', (/'lev'/), 'A', 'mole/mole', 'CLy mixing ratio' ) + call add_default ( 'CLy', 1, ' ') + ! + ! terminator diagnostics (DCMIP2016) + ! + call addfld ( 'iCLy', horiz_only, 'A','mole/mole','Average mass-weighted column-integrated CLy mixing ratio') + call add_default ( 'iCLy', 1, ' ') + + call addfld ( 'iCL', horiz_only, 'A','mole/mole','Average mass-weighted column-integrated CL mixing ratio') + call add_default ( 'iCL', 1, ' ') + + call addfld ( 'iCL2', horiz_only, 'A','mole/mole','Average mass-weighted column-integrated CL2 mixing ratio') + call add_default ( 'iCL2', 1, ' ') + end subroutine chem_init + +!=============================================================================== + + subroutine chem_timestep_init(phys_state, pbuf2d) + use physics_buffer, only: physics_buffer_desc + + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + end subroutine chem_timestep_init + +!=============================================================================== + + subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o ) + + use physics_buffer, only: physics_buffer_desc + use cam_history, only: outfld + use camsrfexch, only: cam_in_t, cam_out_t + use cam_history, only: hist_fld_active + !----------------------------------------------------------------------- + ! + ! Arguments: + ! + real(r8), intent(in) :: dt ! time step + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry + + real(r8) :: a(pver),b(pver),c(pver),d(pver) + + real(r8) :: k1(pcols) + real(r8) :: k2(pcols) + + real(r8) :: cly(pcols,pver) + real(r8) :: cl (pcols,pver) + real(r8) :: cl2(pcols,pver) + real(r8) :: new_cl (pcols,pver) + real(r8) :: new_cl2(pcols,pver) + + real(r8) :: integrated(pcols) + + integer :: ncol,lchnk, i + logical :: lq(pcnst) + integer :: m,n + + real(r8) :: r(pcols), det(pcols,pver), e(pcols,pver) + real(r8) :: cl_f(pcols,pver),cl2_f(pcols,pver) + real(r8) :: l(pcols,pver) + + do n = 1,pcnst + m = map2chm(n) + if( m > 0 ) then + lq(n) = .true. + end if + end do + + call physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq) + + lchnk = state%lchnk + ncol = state%ncol + + do i = 1,ncol + k1(i) = max(0.0_r8, sin(state%lat(i))*sin(k1_lat_center) + & + cos(state%lat(i))*cos(k1_lat_center)*cos(state%lon(i)-k1_lon_center) ) + enddo + k2(:) = 1._r8 + + call outfld('k1', k1, pcols, lchnk ) + call outfld('k2', k2, pcols, lchnk ) + + cl(:ncol,:) = (molw_dryair/adv_mass(idx_cl ))*state%q(:ncol,:,indices(1)) + cl2(:ncol,:) = (molw_dryair/adv_mass(idx_cl2))*state%q(:ncol,:,indices(2)) + + do i = 1,ncol + + r(i) = k1(i)/(4._r8*k2(i)) + cly(i,:) = cl(i,:) + 2._r8* cl2(i,:) + + det(i,:) = sqrt(r(i)*r(i) + 2._r8*r(i)*cly(i,:)) + e(i,:) = exp(-4._r8*k2(i)*det(i,:)*dt) + + where( abs(det(i,:) * k2(i) * dt) .gt. 1e-16_r8) + l(i,:) = (1._r8 - e(i,:))/det(i,:)/dt + elsewhere + l(i,:) = 4._r8*k2(i) + endwhere + + cl_f(i,:) = -l(i,:)*(cl(i,:) - det(i,:) + r(i) )*(cl(i,:) + det(i,:) + r(i)) / ( 1._r8 +e(i,:) + dt*l(i,:)*(cl(i,:) + r(i))) + cl2_f(i,:) = -cl_f(i,:) / 2._r8 + + enddo + + ptend%q(:ncol,:,indices(1)) = (adv_mass(idx_cl )/molw_dryair)*( cl_f (:ncol,:) ) + ptend%q(:ncol,:,indices(2)) = (adv_mass(idx_cl2)/molw_dryair)*( cl2_f(:ncol,:) ) + + cly(:ncol,:) = 2._r8*(cl2(:ncol,:) + dt * cl2_f(:ncol,:)) + (cl(:ncol,:) + dt * cl_f(:ncol,:)) + + call outfld('CLy', cly, pcols, lchnk ) + call outfld ( species(1), cl (:ncol,:) + dt * cl_f (:ncol,:), ncol, lchnk ) + call outfld ( species(2), cl2(:ncol,:) + dt * cl2_f(:ncol,:), ncol, lchnk ) + ! + ! terminator diagnostics (DCMIP2016) + ! + if ( hist_fld_active('iCL')) then + integrated(:ncol) = SUM(state%pdeldry(:ncol,:)*cl(:ncol,:),DIM=2)/SUM(state%pdeldry(:ncol,:),DIM=2) + call outfld('iCL', integrated, pcols, lchnk ) + end if + if ( hist_fld_active('iCL2')) then + integrated(:ncol) = SUM(state%pdeldry(:ncol,:)*cl2(:ncol,:),DIM=2)/SUM(state%pdeldry(:ncol,:),DIM=2) + call outfld('iCL2', integrated, pcols, lchnk ) + end if + if ( hist_fld_active('iCLy')) then + integrated(:ncol) = SUM(state%pdeldry(:ncol,:)*cly(:ncol,:),DIM=2)/SUM(state%pdeldry(:ncol,:),DIM=2) + call outfld('iCLy', integrated, pcols, lchnk ) + end if + return + end subroutine chem_timestep_tend + +!=============================================================================== + subroutine chem_init_cnst(name, latvals, lonvals, mask, q) + +!----------------------------------------------------------------------- +! Dummy arguments +!----------------------------------------------------------------------- + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (ncol, plev + real(r8) :: q_vmr(size(q, 1)) ! volume mixing ratio (ncol) + real(r8) :: det(size(q, 1)) + real(r8) :: krat(size(q, 1)) + + real(r8) :: k1(size(q, 1)) + real(r8) :: k2(size(q, 1)) + + real(r8) :: h + integer :: i, k + integer :: blksize + + real(r8), parameter :: init_vmr_cl2 = 2e-6_r8 + real(r8), parameter :: init_vmr_cl = 0._r8 + + blksize = size(q, 1) + + do i = 1, blksize + k1(i) = max(0.0_r8, sin(latvals(i))*sin(k1_lat_center) + & + cos(latvals(i))*cos(k1_lat_center)*cos(lonvals(i)-k1_lon_center)) + end do + k2(:) = 1._r8 + + krat(:) = k1(:) / (4._r8 * k2(:)) + + h = init_vmr_cl + 2._r8 * init_vmr_cl2 + + det(:) = sqrt(krat(:) * krat(:) + 2._r8 * h * krat(:)) + + if (trim(name) == trim(species(1)) ) then + do k = 1, pver + q_vmr(:) = (det(:)-krat(:)) + where(mask) + q(:,k) = q_vmr(:) * adv_mass(idx_cl ) / molw_dryair + end where + end do + else if (trim(name) == trim(species(2))) then + do k = 1, pver + q_vmr(:) = h / 2._r8 - (det(:) - krat(:)) / 2._r8 + where(mask) + q(:,k) = q_vmr(:) * adv_mass(idx_cl2) / molw_dryair + end where + end do + else if (trim(name) == trim(species(3))) then + do k = 1, pver + where(mask) + q(:,k) = 1.0_r8 + end where + end do + end if + + return + + end subroutine chem_init_cnst + +!=============================================================================== + subroutine chem_final + return + end subroutine chem_final +!=============================================================================== + subroutine chem_write_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + return + end subroutine chem_write_restart_bin +!=============================================================================== + subroutine chem_read_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + return + end subroutine chem_read_restart_bin +!=============================================================================== + subroutine chem_write_restart_pio( File ) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_write_restart_pio +!=============================================================================== + subroutine chem_read_restart_pio( File ) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_read_restart_pio +!=============================================================================== + subroutine chem_init_restart(File) + use pio, only : file_desc_t + type(file_desc_t) :: File + return + end subroutine chem_init_restart +!================================================================================ + subroutine chem_reset_fluxes( fptr, cam_in ) + use camsrfexch, only : cam_in_t + + real(r8), pointer :: fptr(:,:) ! pointer into array data + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + + end subroutine chem_reset_fluxes +!================================================================================ + subroutine chem_emissions( state, cam_in ) + use camsrfexch, only: cam_in_t + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + end subroutine chem_emissions + +end module chemistry diff --git a/src/chemistry/pp_terminator/m_rxt_id.F90 b/src/chemistry/pp_terminator/m_rxt_id.F90 new file mode 100644 index 0000000000..eca8c7ceba --- /dev/null +++ b/src/chemistry/pp_terminator/m_rxt_id.F90 @@ -0,0 +1,5 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_toy_k1 = 1 + integer, parameter :: rid_toy_k2 = 2 + end module m_rxt_id diff --git a/src/chemistry/pp_terminator/m_spc_id.F90 b/src/chemistry/pp_terminator/m_spc_id.F90 new file mode 100644 index 0000000000..0bd49e77bb --- /dev/null +++ b/src/chemistry/pp_terminator/m_spc_id.F90 @@ -0,0 +1,6 @@ + module m_spc_id + implicit none + integer, parameter :: id_CL = 1 + integer, parameter :: id_CL2 = 2 + integer, parameter :: id_RHO = 3 + end module m_spc_id diff --git a/src/chemistry/pp_terminator/mo_adjrxt.F90 b/src/chemistry/pp_terminator/mo_adjrxt.F90 new file mode 100644 index 0000000000..fcc990497e --- /dev/null +++ b/src/chemistry/pp_terminator/mo_adjrxt.F90 @@ -0,0 +1,18 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 2) = rate(:,:, 2) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_terminator/mo_exp_sol.F90 b/src/chemistry/pp_terminator/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_terminator/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_terminator/mo_imp_sol.F90 b/src/chemistry/pp_terminator/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_terminator/mo_indprd.F90 b/src/chemistry/pp_terminator/mo_indprd.F90 new file mode 100644 index 0000000000..893c317739 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_indprd.F90 @@ -0,0 +1,29 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_terminator/mo_lin_matrix.F90 b/src/chemistry/pp_terminator/mo_lin_matrix.F90 new file mode 100644 index 0000000000..2647563d69 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_lin_matrix.F90 @@ -0,0 +1,40 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(5) = -( het_rates(1) ) + mat(3) = 2.000_r8*rxt(1) + mat(2) = -( rxt(1) + het_rates(2) ) + mat(1) = -( het_rates(3) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_terminator/mo_lu_factor.F90 b/src/chemistry/pp_terminator/mo_lu_factor.F90 new file mode 100644 index 0000000000..0c255a6b84 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_lu_factor.F90 @@ -0,0 +1,27 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = lu(3) * lu(2) + lu(5) = lu(5) - lu(3) * lu(4) + lu(5) = 1._r8 / lu(5) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_terminator/mo_lu_solve.F90 b/src/chemistry/pp_terminator/mo_lu_solve.F90 new file mode 100644 index 0000000000..6a7d79a49b --- /dev/null +++ b/src/chemistry/pp_terminator/mo_lu_solve.F90 @@ -0,0 +1,57 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(3) = b(3) - lu(3) * b(2) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(3) = b(3) * lu(5) + b(2) = b(2) - lu(4) * b(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_terminator/mo_nln_matrix.F90 b/src/chemistry/pp_terminator/mo_nln_matrix.F90 new file mode 100644 index 0000000000..b16cdb611e --- /dev/null +++ b/src/chemistry/pp_terminator/mo_nln_matrix.F90 @@ -0,0 +1,61 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(5) = -(4._r8*rxt(2)*y(1)) + mat(4) = 2.000_r8*rxt(2)*y(1) + end subroutine nlnmat01 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 5) = mat( 5) + lmat( 5) + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 5) = mat( 5) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_terminator/mo_phtadj.F90 b/src/chemistry/pp_terminator/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_terminator/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_terminator/mo_prod_loss.F90 b/src/chemistry/pp_terminator/mo_prod_loss.F90 new file mode 100644 index 0000000000..2dd79dbf4b --- /dev/null +++ b/src/chemistry/pp_terminator/mo_prod_loss.F90 @@ -0,0 +1,42 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(3) = (2._r8*rxt(2)* y(1) + het_rates(1))* y(1) + prod(3) =2.000_r8*rxt(1)*y(2) + loss(2) = ( + rxt(1) + het_rates(2))* y(2) + prod(2) =rxt(2)*y(1)*y(1) + loss(1) = ( + het_rates(3))* y(3) + prod(1) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_terminator/mo_rxt_rates_conv.F90 b/src/chemistry/pp_terminator/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..f654e7c457 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_rxt_rates_conv.F90 @@ -0,0 +1,14 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 2) ! rate_const*CL2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*CL*CL + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_terminator/mo_setrxt.F90 b/src/chemistry/pp_terminator/mo_setrxt.F90 new file mode 100644 index 0000000000..a82675a8be --- /dev/null +++ b/src/chemistry/pp_terminator/mo_setrxt.F90 @@ -0,0 +1,52 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_terminator/mo_sim_dat.F90 b/src/chemistry/pp_terminator/mo_sim_dat.F90 new file mode 100644 index 0000000000..67ad6828c0 --- /dev/null +++ b/src/chemistry/pp_terminator/mo_sim_dat.F90 @@ -0,0 +1,81 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 3, 0 /) + + cls_rxt_cnt(:,4) = (/ 0, 1, 1, 3 /) + + solsym(: 3) = (/ 'CL ','CL2 ','RHO ' /) + + adv_mass(: 3) = (/ 35.452700_r8, 70.905400_r8, 1.007400_r8 /) + + crb_mass(: 3) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 1) = (/ 0.00000000_r8 /) + + clsmap(: 3,4) = (/ 1, 2, 3 /) + + permute(: 3,4) = (/ 3, 2, 1 /) + + diag_map(: 3) = (/ 1, 2, 5 /) + + inv_lst(: 1) = (/ 'M ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 2) = (/ 'toy_k1 ', 'toy_k2 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_bam/chem_mech.doc b/src/chemistry/pp_trop_bam/chem_mech.doc new file mode 100644 index 0000000000..9965ac380a --- /dev/null +++ b/src/chemistry/pp_trop_bam/chem_mech.doc @@ -0,0 +1,96 @@ + + + Solution species + ( 1) H2O2 + ( 2) SO2 + ( 3) SO4 + ( 4) DMS (CH3SCH3) + ( 5) OC1 (C) + ( 6) OC2 (C) + ( 7) CB1 (C) + ( 8) CB2 (C) + ( 9) SSLT01 (NaCl) + ( 10) SSLT02 (NaCl) + ( 11) SSLT03 (NaCl) + ( 12) SSLT04 (NaCl) + ( 13) DST01 (AlSiO5) + ( 14) DST02 (AlSiO5) + ( 15) DST03 (AlSiO5) + ( 16) DST04 (AlSiO5) + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) H2O + ( 5) O3 + ( 6) OH + ( 7) NO3 + ( 8) HO2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) H2O2 + ( 2) SO2 + ( 3) SO4 + ( 4) DMS + ( 5) CB1 + ( 6) CB2 + ( 7) OC1 + ( 8) OC2 + ( 9) SSLT01 + ( 10) SSLT02 + ( 11) SSLT03 + ( 12) SSLT04 + ( 13) DST01 + ( 14) DST02 + ( 15) DST03 + ( 16) DST04 + + Photolysis + jh2o2 ( 1) H2O2 + hv -> 2*OH rate = ** User defined ** ( 1) + + Reactions + usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 2) + ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + usr_SO2_OH ( 3) SO2 + OH -> SO4 rate = ** User defined ** ( 4) + ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) + usr_DMS_OH ( 5) DMS + OH -> .5*SO2 rate = ** User defined ** ( 6) + ( 6) DMS + NO3 -> SO2 rate = 1.90E-13*exp( 520./t) ( 7) + ( 7) CB1 -> CB2 rate = 1.01E-05 ( 8) + ( 8) OC1 -> OC2 rate = 1.01E-05 ( 9) + +Extraneous prod/loss species + ( 1) SO2 (dataset) + ( 2) SO4 (dataset) + + + Equation Report + + d(H2O2)/dt = r1 + - j1*H2O2 - r2*OH*H2O2 + d(SO2)/dt = r4*OH*DMS + .5*r5*OH*DMS + r6*NO3*DMS + - r3*OH*SO2 + d(SO4)/dt = r3*OH*SO2 + d(DMS)/dt = - r4*OH*DMS - r5*OH*DMS - r6*NO3*DMS + d(OC1)/dt = - r8*OC1 + d(OC2)/dt = r8*OC1 + d(CB1)/dt = - r7*CB1 + d(CB2)/dt = r7*CB1 + d(SSLT01)/dt = 0 + d(SSLT02)/dt = 0 + d(SSLT03)/dt = 0 + d(SSLT04)/dt = 0 + d(DST01)/dt = 0 + d(DST02)/dt = 0 + d(DST03)/dt = 0 + d(DST04)/dt = 0 diff --git a/src/chemistry/pp_trop_bam/chem_mech.in b/src/chemistry/pp_trop_bam/chem_mech.in new file mode 100644 index 0000000000..4089e09c21 --- /dev/null +++ b/src/chemistry/pp_trop_bam/chem_mech.in @@ -0,0 +1,73 @@ +* Bulk Aerosol Model (BAM) + + SPECIES + + Solution + H2O2, SO2, SO4, DMS -> CH3SCH3 + OC1 -> C, OC2 -> C + CB1 -> C, CB2 -> C + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + End Solution + + Fixed + M, N2, O2, H2O + O3, OH, NO3, HO2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + H2O2, SO2, SO4, DMS + CB1, CB2 + OC1, OC2 + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + [jh2o2] H2O2 + hv -> 2*OH + End Photolysis + + Reactions + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + [usr_SO2_OH] SO2 + OH -> SO4 + DMS + OH -> SO2 ; 9.6e-12,-234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + DMS + NO3 -> SO2 ; 1.9e-13, 520. + CB1 -> CB2 ; 1.006e-05 + OC1 -> OC2 ; 1.006e-05 + End Reactions + + Ext Forcing + SO2 <- dataset + SO4 <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS + diff --git a/src/chemistry/pp_trop_bam/chem_mods.F90 b/src/chemistry/pp_trop_bam/chem_mods.F90 new file mode 100644 index 0000000000..ab1506844e --- /dev/null +++ b/src/chemistry/pp_trop_bam/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 1, & ! number of photolysis reactions + rxntot = 9, & ! number of total reactions + gascnt = 8, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 16, & ! number of "gas phase" species + nfs = 8, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 20, & ! number of non-zero matrix entries + extcnt = 2, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 16, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 4, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_bam/m_rxt_id.F90 b/src/chemistry/pp_trop_bam/m_rxt_id.F90 new file mode 100644 index 0000000000..059da83b29 --- /dev/null +++ b/src/chemistry/pp_trop_bam/m_rxt_id.F90 @@ -0,0 +1,12 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_usr_HO2_HO2 = 2 + integer, parameter :: rid_usr_SO2_OH = 4 + integer, parameter :: rid_usr_DMS_OH = 6 + integer, parameter :: rid_r0003 = 3 + integer, parameter :: rid_r0005 = 5 + integer, parameter :: rid_r0007 = 7 + integer, parameter :: rid_r0008 = 8 + integer, parameter :: rid_r0009 = 9 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_bam/m_spc_id.F90 b/src/chemistry/pp_trop_bam/m_spc_id.F90 new file mode 100644 index 0000000000..1490cb4fe0 --- /dev/null +++ b/src/chemistry/pp_trop_bam/m_spc_id.F90 @@ -0,0 +1,19 @@ + module m_spc_id + implicit none + integer, parameter :: id_H2O2 = 1 + integer, parameter :: id_SO2 = 2 + integer, parameter :: id_SO4 = 3 + integer, parameter :: id_DMS = 4 + integer, parameter :: id_OC1 = 5 + integer, parameter :: id_OC2 = 6 + integer, parameter :: id_CB1 = 7 + integer, parameter :: id_CB2 = 8 + integer, parameter :: id_SSLT01 = 9 + integer, parameter :: id_SSLT02 = 10 + integer, parameter :: id_SSLT03 = 11 + integer, parameter :: id_SSLT04 = 12 + integer, parameter :: id_DST01 = 13 + integer, parameter :: id_DST02 = 14 + integer, parameter :: id_DST03 = 15 + integer, parameter :: id_DST04 = 16 + end module m_spc_id diff --git a/src/chemistry/pp_trop_bam/mo_adjrxt.F90 b/src/chemistry/pp_trop_bam/mo_adjrxt.F90 new file mode 100644 index 0000000000..bc4bf9e366 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_adjrxt.F90 @@ -0,0 +1,28 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 6) + rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 6) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 6) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 6) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 7) + rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 8) * inv(:,:, 8) * im(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_bam/mo_exp_sol.F90 b/src/chemistry/pp_trop_bam/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_bam/mo_imp_sol.F90 b/src/chemistry/pp_trop_bam/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_bam/mo_indprd.F90 b/src/chemistry/pp_trop_bam/mo_indprd.F90 new file mode 100644 index 0000000000..7770524556 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_indprd.F90 @@ -0,0 +1,42 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) =rxt(:,:,2) + prod(:,:,3) = + extfrc(:,:,1) + prod(:,:,2) = + extfrc(:,:,2) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 b/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 new file mode 100644 index 0000000000..e0e591156f --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_lin_matrix.F90 @@ -0,0 +1,56 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + rxt(3) + het_rates(1) ) + mat(4) = -( rxt(4) + het_rates(2) ) + mat(5) = rxt(5) + .500_r8*rxt(6) + rxt(7) + mat(2) = -( het_rates(3) ) + mat(3) = rxt(4) + mat(6) = -( rxt(5) + rxt(6) + rxt(7) + het_rates(4) ) + mat(7) = -( rxt(8) + het_rates(7) ) + mat(9) = -( het_rates(8) ) + mat(8) = rxt(8) + mat(10) = -( rxt(9) + het_rates(5) ) + mat(12) = -( het_rates(6) ) + mat(11) = rxt(9) + mat(13) = -( het_rates(9) ) + mat(14) = -( het_rates(10) ) + mat(15) = -( het_rates(11) ) + mat(16) = -( het_rates(12) ) + mat(17) = -( het_rates(13) ) + mat(18) = -( het_rates(14) ) + mat(19) = -( het_rates(15) ) + mat(20) = -( het_rates(16) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_bam/mo_lu_factor.F90 b/src/chemistry/pp_trop_bam/mo_lu_factor.F90 new file mode 100644 index 0000000000..49caa86472 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_lu_factor.F90 @@ -0,0 +1,40 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(4) = 1._r8 / lu(4) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = lu(11) * lu(10) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_bam/mo_lu_solve.F90 b/src/chemistry/pp_trop_bam/mo_lu_solve.F90 new file mode 100644 index 0000000000..2ad12fd5b9 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_lu_solve.F90 @@ -0,0 +1,72 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(6) = b(6) - lu(8) * b(5) + b(8) = b(8) - lu(11) * b(7) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(16) = b(16) * lu(20) + b(15) = b(15) * lu(19) + b(14) = b(14) * lu(18) + b(13) = b(13) * lu(17) + b(12) = b(12) * lu(16) + b(11) = b(11) * lu(15) + b(10) = b(10) * lu(14) + b(9) = b(9) * lu(13) + b(8) = b(8) * lu(12) + b(7) = b(7) * lu(10) + b(6) = b(6) * lu(9) + b(5) = b(5) * lu(7) + b(4) = b(4) * lu(6) + b(3) = b(3) - lu(5) * b(4) + b(3) = b(3) * lu(4) + b(2) = b(2) - lu(3) * b(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 b/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 new file mode 100644 index 0000000000..a1dbf92203 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_nln_matrix.F90 @@ -0,0 +1,71 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 4) = mat( 4) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_bam/mo_phtadj.F90 b/src/chemistry/pp_trop_bam/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_bam/mo_prod_loss.F90 b/src/chemistry/pp_trop_bam/mo_prod_loss.F90 new file mode 100644 index 0000000000..fc3988282e --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_prod_loss.F90 @@ -0,0 +1,68 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + rxt(3) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(3) = ( + rxt(4) + het_rates(2))* y(2) + prod(3) = (rxt(5) +.500_r8*rxt(6) +rxt(7))*y(4) + loss(2) = ( + het_rates(3))* y(3) + prod(2) =rxt(4)*y(2) + loss(4) = ( + rxt(5) + rxt(6) + rxt(7) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(8) + het_rates(7))* y(7) + prod(5) = 0._r8 + loss(6) = ( + het_rates(8))* y(8) + prod(6) =rxt(8)*y(7) + loss(7) = ( + rxt(9) + het_rates(5))* y(5) + prod(7) = 0._r8 + loss(8) = ( + het_rates(6))* y(6) + prod(8) =rxt(9)*y(5) + loss(9) = ( + het_rates(9))* y(9) + prod(9) = 0._r8 + loss(10) = ( + het_rates(10))* y(10) + prod(10) = 0._r8 + loss(11) = ( + het_rates(11))* y(11) + prod(11) = 0._r8 + loss(12) = ( + het_rates(12))* y(12) + prod(12) = 0._r8 + loss(13) = ( + het_rates(13))* y(13) + prod(13) = 0._r8 + loss(14) = ( + het_rates(14))* y(14) + prod(14) = 0._r8 + loss(15) = ( + het_rates(15))* y(15) + prod(15) = 0._r8 + loss(16) = ( + het_rates(16))* y(16) + prod(16) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..67518f3269 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_rxt_rates_conv.F90 @@ -0,0 +1,21 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*H2O2 + ! rate_const + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 2) ! rate_const*OH*SO2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 4) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 7) ! rate_const*CB1 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 5) ! rate_const*OC1 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_bam/mo_setrxt.F90 b/src/chemistry/pp_trop_bam/mo_setrxt.F90 new file mode 100644 index 0000000000..95bfa4bb88 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_setrxt.F90 @@ -0,0 +1,75 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + + rate(:,:,8) = 1.006e-05_r8 + rate(:,:,9) = 1.006e-05_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_bam/mo_sim_dat.F90 b/src/chemistry/pp_trop_bam/mo_sim_dat.F90 new file mode 100644 index 0000000000..c8f7f601c3 --- /dev/null +++ b/src/chemistry/pp_trop_bam/mo_sim_dat.F90 @@ -0,0 +1,120 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 16, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 8, 0, 16 /) + + solsym(: 16) = (/ 'H2O2 ','SO2 ','SO4 ','DMS ','OC1 ', & + 'OC2 ','CB1 ','CB2 ','SSLT01 ','SSLT02 ', & + 'SSLT03 ','SSLT04 ','DST01 ','DST02 ','DST03 ', & + 'DST04 ' /) + + adv_mass(: 16) = (/ 34.013600_r8, 64.064800_r8, 96.063600_r8, 62.132400_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 58.442468_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 135.064039_r8 /) + + crb_mass(: 16) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8 /) + + fix_mass(: 8) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 18.0142000_r8, 47.9982000_r8, & + 17.0068000_r8, 62.0049400_r8, 33.0062000_r8 /) + + clsmap(: 16,4) = (/ 1, 2, 3, 4, 7, 8, 5, 6, 9, 10, & + 11, 12, 13, 14, 15, 16 /) + + permute(: 16,4) = (/ 1, 3, 2, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16 /) + + diag_map(: 16) = (/ 1, 2, 4, 6, 7, 9, 10, 12, 13, 14, & + 15, 16, 17, 18, 19, 20 /) + + extfrc_lst(: 2) = (/ 'SO2 ','SO4 ' /) + + frc_from_dataset(: 2) = (/ .true., .true. /) + + inv_lst(: 8) = (/ 'M ', 'N2 ', 'O2 ', 'H2O ', 'O3 ', & + 'OH ', 'NO3 ', 'HO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 4) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', & + 'usr_SO2_OH ', 'usr_DMS_OH ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 4, 6 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ' /) + pht_alias_lst(:,2) = (/ ' ' /) + pht_alias_mult(:,1) = (/ 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_ghg/chem_mech.doc b/src/chemistry/pp_trop_ghg/chem_mech.doc new file mode 100644 index 0000000000..93d7f5f47b --- /dev/null +++ b/src/chemistry/pp_trop_ghg/chem_mech.doc @@ -0,0 +1,51 @@ + + + Solution species + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 (CFCl3) + ( 4) CFC12 (CF2Cl2) + ( 5) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 + ( 4) CFC12 + ( 5) H2O + + Photolysis + + Reactions + ch4_loss ( 1) CH4 -> 2.*H2O rate = ** User defined ** ( 1) + n2o_loss ( 2) N2O -> (No products) rate = ** User defined ** ( 2) + cfc11_loss ( 3) CFC11 -> (No products) rate = ** User defined ** ( 3) + cfc12_loss ( 4) CFC12 -> (No products) rate = ** User defined ** ( 4) + lyman_alpha ( 5) H2O -> (No products) rate = ** User defined ** ( 5) + +Extraneous prod/loss species + + + Equation Report + + d(CH4)/dt = - r1*CH4 + d(N2O)/dt = - r2*N2O + d(CFC11)/dt = - r3*CFC11 + d(CFC12)/dt = - r4*CFC12 + d(H2O)/dt = 2*r1*CH4 + - r5*H2O diff --git a/src/chemistry/pp_trop_ghg/chem_mech.in b/src/chemistry/pp_trop_ghg/chem_mech.in new file mode 100644 index 0000000000..d20671a259 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/chem_mech.in @@ -0,0 +1,57 @@ + SPECIES + + Solution + CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2, H2O + End Solution + + Fixed + M, N2, O2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + CH4, N2O, CFC11, CFC12, H2O + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + End Photolysis + + Reactions + [ch4_loss] CH4 -> 2.* H2O + [n2o_loss] N2O -> + [cfc11_loss] CFC11 -> + [cfc12_loss] CFC12 -> + [lyman_alpha] H2O -> + End Reactions + + Ext Forcing + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS + + diff --git a/src/chemistry/pp_trop_ghg/chem_mods.F90 b/src/chemistry/pp_trop_ghg/chem_mods.F90 new file mode 100644 index 0000000000..b89c8308f5 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 0, & ! number of photolysis reactions + rxntot = 5, & ! number of total reactions + gascnt = 5, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 5, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 6, & ! number of non-zero matrix entries + extcnt = 0, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 5, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 5, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_ghg/m_rxt_id.F90 b/src/chemistry/pp_trop_ghg/m_rxt_id.F90 new file mode 100644 index 0000000000..a2c78d2381 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/m_rxt_id.F90 @@ -0,0 +1,8 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_ch4_loss = 1 + integer, parameter :: rid_n2o_loss = 2 + integer, parameter :: rid_cfc11_loss = 3 + integer, parameter :: rid_cfc12_loss = 4 + integer, parameter :: rid_lyman_alpha = 5 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_ghg/m_spc_id.F90 b/src/chemistry/pp_trop_ghg/m_spc_id.F90 new file mode 100644 index 0000000000..1a2625b12d --- /dev/null +++ b/src/chemistry/pp_trop_ghg/m_spc_id.F90 @@ -0,0 +1,8 @@ + module m_spc_id + implicit none + integer, parameter :: id_CH4 = 1 + integer, parameter :: id_N2O = 2 + integer, parameter :: id_CFC11 = 3 + integer, parameter :: id_CFC12 = 4 + integer, parameter :: id_H2O = 5 + end module m_spc_id diff --git a/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 b/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 new file mode 100644 index 0000000000..94f2dcce83 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_adjrxt.F90 @@ -0,0 +1,17 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_ghg/mo_exp_sol.F90 b/src/chemistry/pp_trop_ghg/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 b/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_ghg/mo_indprd.F90 b/src/chemistry/pp_trop_ghg/mo_indprd.F90 new file mode 100644 index 0000000000..de6a52e4d1 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_indprd.F90 @@ -0,0 +1,31 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 b/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 new file mode 100644 index 0000000000..38a2e6094a --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_lin_matrix.F90 @@ -0,0 +1,42 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + het_rates(1) ) + mat(3) = -( rxt(2) + het_rates(2) ) + mat(4) = -( rxt(3) + het_rates(3) ) + mat(5) = -( rxt(4) + het_rates(4) ) + mat(6) = -( rxt(5) + het_rates(5) ) + mat(2) = 2.000_r8*rxt(1) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 b/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 new file mode 100644 index 0000000000..93c12c312a --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_lu_factor.F90 @@ -0,0 +1,28 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 b/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 new file mode 100644 index 0000000000..9edb11193c --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_lu_solve.F90 @@ -0,0 +1,58 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(5) = b(5) - lu(2) * b(1) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(5) = b(5) * lu(6) + b(4) = b(4) * lu(5) + b(3) = b(3) * lu(4) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 b/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 new file mode 100644 index 0000000000..cad55bf083 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_nln_matrix.F90 @@ -0,0 +1,46 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_ghg/mo_phtadj.F90 b/src/chemistry/pp_trop_ghg/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 b/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 new file mode 100644 index 0000000000..015d5e6d60 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_prod_loss.F90 @@ -0,0 +1,46 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + rxt(2) + het_rates(2))* y(2) + prod(2) = 0._r8 + loss(3) = ( + rxt(3) + het_rates(3))* y(3) + prod(3) = 0._r8 + loss(4) = ( + rxt(4) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(5) + het_rates(5))* y(5) + prod(5) =2.000_r8*rxt(1)*y(1) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e6c98049bf --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_rxt_rates_conv.F90 @@ -0,0 +1,17 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*CH4 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*N2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*CFC11 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 4) ! rate_const*CFC12 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*H2O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_ghg/mo_setrxt.F90 b/src/chemistry/pp_trop_ghg/mo_setrxt.F90 new file mode 100644 index 0000000000..a82675a8be --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_setrxt.F90 @@ -0,0 +1,52 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 b/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 new file mode 100644 index 0000000000..d551c4eab8 --- /dev/null +++ b/src/chemistry/pp_trop_ghg/mo_sim_dat.F90 @@ -0,0 +1,83 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 5, 0 /) + + cls_rxt_cnt(:,4) = (/ 0, 5, 0, 5 /) + + solsym(: 5) = (/ 'CH4 ','N2O ','CFC11 ','CFC12 ','H2O ' /) + + adv_mass(: 5) = (/ 16.040600_r8, 44.012880_r8, 137.367503_r8, 120.913206_r8, 18.014200_r8 /) + + crb_mass(: 5) = (/ 12.011000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8 /) + + clsmap(: 5,4) = (/ 1, 2, 3, 4, 5 /) + + permute(: 5,4) = (/ 1, 2, 3, 4, 5 /) + + diag_map(: 5) = (/ 1, 3, 4, 5, 6 /) + + inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 5) = (/ 'ch4_loss ', 'n2o_loss ', & + 'cfc11_loss ', 'cfc12_loss ', & + 'lyman_alpha ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_mam3/chem_mech.doc b/src/chemistry/pp_trop_mam3/chem_mech.doc new file mode 100644 index 0000000000..e5769cb859 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/chem_mech.doc @@ -0,0 +1,114 @@ + + + Solution species + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS (CH3SCH3) + ( 5) SOAG (C) + ( 6) so4_a1 (NH4HSO4) + ( 7) pom_a1 (C) + ( 8) soa_a1 (C) + ( 9) bc_a1 (C) + ( 10) dst_a1 (AlSiO5) + ( 11) ncl_a1 (NaCl) + ( 12) num_a1 (H) + ( 13) so4_a2 (NH4HSO4) + ( 14) soa_a2 (C) + ( 15) ncl_a2 (NaCl) + ( 16) num_a2 (H) + ( 17) dst_a3 (AlSiO5) + ( 18) ncl_a3 (NaCl) + ( 19) so4_a3 (NH4HSO4) + ( 20) num_a3 (H) + ( 21) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) O3 + ( 5) OH + ( 6) NO3 + ( 7) HO2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS + ( 5) SOAG + ( 6) so4_a1 + ( 7) pom_a1 + ( 8) soa_a1 + ( 9) bc_a1 + ( 10) dst_a1 + ( 11) ncl_a1 + ( 12) num_a1 + ( 13) so4_a2 + ( 14) soa_a2 + ( 15) ncl_a2 + ( 16) num_a2 + ( 17) dst_a3 + ( 18) ncl_a3 + ( 19) so4_a3 + ( 20) num_a3 + ( 21) H2O + + Photolysis + jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + + Reactions + usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) + ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) + ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) + usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) + ( 6) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 7) + +Extraneous prod/loss species + ( 1) SO2 (dataset) + ( 2) so4_a1 (dataset) + ( 3) so4_a2 (dataset) + ( 4) pom_a1 (dataset) + ( 5) bc_a1 (dataset) + ( 6) num_a1 (dataset) + ( 7) num_a2 (dataset) + ( 8) H2O (dataset) + + + Equation Report + + d(H2O2)/dt = r1 + - j1*H2O2 - r2*OH*H2O2 + d(H2SO4)/dt = r3*OH*SO2 + d(SO2)/dt = r4*OH*DMS + .5*r5*OH*DMS + r6*NO3*DMS + - r3*OH*SO2 + d(DMS)/dt = - r4*OH*DMS - r5*OH*DMS - r6*NO3*DMS + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 + d(H2O)/dt = r2*OH*H2O2 diff --git a/src/chemistry/pp_trop_mam3/chem_mech.in b/src/chemistry/pp_trop_mam3/chem_mech.in new file mode 100644 index 0000000000..b6584d0ff2 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/chem_mech.in @@ -0,0 +1,82 @@ + SPECIES + + Solution + H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + H2O + End Solution + + Fixed + M, N2, O2, O3, OH, NO3, HO2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + H2O2, H2SO4, SO2, DMS, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, num_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + H2O + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + [jh2o2] H2O2 + hv -> + End Photolysis + + Reactions + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + [usr_SO2_OH] SO2 + OH -> H2SO4 + DMS + OH -> SO2 ; 9.6e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + End Reactions + + Ext Forcing + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + bc_a1 <- dataset + num_a1 <- dataset + num_a2 <- dataset + H2O <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_trop_mam3/chem_mods.F90 b/src/chemistry/pp_trop_mam3/chem_mods.F90 new file mode 100644 index 0000000000..69af9e22ab --- /dev/null +++ b/src/chemistry/pp_trop_mam3/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 1, & ! number of photolysis reactions + rxntot = 7, & ! number of total reactions + gascnt = 6, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 21, & ! number of "gas phase" species + nfs = 7, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 24, & ! number of non-zero matrix entries + extcnt = 8, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 21, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 4, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_mam3/m_rxt_id.F90 b/src/chemistry/pp_trop_mam3/m_rxt_id.F90 new file mode 100644 index 0000000000..0eff5755d9 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/m_rxt_id.F90 @@ -0,0 +1,10 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_usr_HO2_HO2 = 2 + integer, parameter :: rid_usr_SO2_OH = 4 + integer, parameter :: rid_usr_DMS_OH = 6 + integer, parameter :: rid_r0003 = 3 + integer, parameter :: rid_r0005 = 5 + integer, parameter :: rid_r0007 = 7 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_mam3/m_spc_id.F90 b/src/chemistry/pp_trop_mam3/m_spc_id.F90 new file mode 100644 index 0000000000..6ea2722a33 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/m_spc_id.F90 @@ -0,0 +1,24 @@ + module m_spc_id + implicit none + integer, parameter :: id_H2O2 = 1 + integer, parameter :: id_H2SO4 = 2 + integer, parameter :: id_SO2 = 3 + integer, parameter :: id_DMS = 4 + integer, parameter :: id_SOAG = 5 + integer, parameter :: id_so4_a1 = 6 + integer, parameter :: id_pom_a1 = 7 + integer, parameter :: id_soa_a1 = 8 + integer, parameter :: id_bc_a1 = 9 + integer, parameter :: id_dst_a1 = 10 + integer, parameter :: id_ncl_a1 = 11 + integer, parameter :: id_num_a1 = 12 + integer, parameter :: id_so4_a2 = 13 + integer, parameter :: id_soa_a2 = 14 + integer, parameter :: id_ncl_a2 = 15 + integer, parameter :: id_num_a2 = 16 + integer, parameter :: id_dst_a3 = 17 + integer, parameter :: id_ncl_a3 = 18 + integer, parameter :: id_so4_a3 = 19 + integer, parameter :: id_num_a3 = 20 + integer, parameter :: id_H2O = 21 + end module m_spc_id diff --git a/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 b/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 new file mode 100644 index 0000000000..f58daf1689 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_adjrxt.F90 @@ -0,0 +1,28 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 5) + rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 5) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 5) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 6) + rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_mam3/mo_exp_sol.F90 b/src/chemistry/pp_trop_mam3/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 b/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_mam3/mo_indprd.F90 b/src/chemistry/pp_trop_mam3/mo_indprd.F90 new file mode 100644 index 0000000000..bf419d2b39 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_indprd.F90 @@ -0,0 +1,47 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) =rxt(:,:,2) + prod(:,:,2) = 0._r8 + prod(:,:,3) = + extfrc(:,:,1) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = + extfrc(:,:,2) + prod(:,:,7) = + extfrc(:,:,4) + prod(:,:,8) = 0._r8 + prod(:,:,9) = + extfrc(:,:,5) + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = + extfrc(:,:,6) + prod(:,:,13) = + extfrc(:,:,3) + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = + extfrc(:,:,7) + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = + extfrc(:,:,8) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 new file mode 100644 index 0000000000..88bb0aa92a --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_lin_matrix.F90 @@ -0,0 +1,60 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + rxt(3) + het_rates(1) ) + mat(3) = -( het_rates(2) ) + mat(4) = rxt(4) + mat(5) = -( rxt(4) + het_rates(3) ) + mat(6) = rxt(5) + .500_r8*rxt(6) + rxt(7) + mat(7) = -( rxt(5) + rxt(6) + rxt(7) + het_rates(4) ) + mat(8) = -( het_rates(5) ) + mat(9) = -( het_rates(6) ) + mat(10) = -( het_rates(7) ) + mat(11) = -( het_rates(8) ) + mat(12) = -( het_rates(9) ) + mat(13) = -( het_rates(10) ) + mat(14) = -( het_rates(11) ) + mat(15) = -( het_rates(12) ) + mat(16) = -( het_rates(13) ) + mat(17) = -( het_rates(14) ) + mat(18) = -( het_rates(15) ) + mat(19) = -( het_rates(16) ) + mat(20) = -( het_rates(17) ) + mat(21) = -( het_rates(18) ) + mat(22) = -( het_rates(19) ) + mat(23) = -( het_rates(20) ) + mat(24) = -( het_rates(21) ) + mat(2) = rxt(3) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 b/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 new file mode 100644 index 0000000000..309f831c44 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_lu_factor.F90 @@ -0,0 +1,44 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(5) = 1._r8 / lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 b/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 new file mode 100644 index 0000000000..9a16fea90b --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_lu_solve.F90 @@ -0,0 +1,76 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(21) = b(21) - lu(2) * b(1) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(21) = b(21) * lu(24) + b(20) = b(20) * lu(23) + b(19) = b(19) * lu(22) + b(18) = b(18) * lu(21) + b(17) = b(17) * lu(20) + b(16) = b(16) * lu(19) + b(15) = b(15) * lu(18) + b(14) = b(14) * lu(17) + b(13) = b(13) * lu(16) + b(12) = b(12) * lu(15) + b(11) = b(11) * lu(14) + b(10) = b(10) * lu(13) + b(9) = b(9) * lu(12) + b(8) = b(8) * lu(11) + b(7) = b(7) * lu(10) + b(6) = b(6) * lu(9) + b(5) = b(5) * lu(8) + b(4) = b(4) * lu(7) + b(3) = b(3) - lu(6) * b(4) + b(3) = b(3) * lu(5) + b(2) = b(2) - lu(4) * b(3) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 new file mode 100644 index 0000000000..f15e6974ea --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_nln_matrix.F90 @@ -0,0 +1,80 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 5) = mat( 5) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_mam3/mo_phtadj.F90 b/src/chemistry/pp_trop_mam3/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 b/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 new file mode 100644 index 0000000000..6c5408229b --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_prod_loss.F90 @@ -0,0 +1,78 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + rxt(3) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + het_rates(2))* y(2) + prod(2) =rxt(4)*y(3) + loss(3) = ( + rxt(4) + het_rates(3))* y(3) + prod(3) = (rxt(5) +.500_r8*rxt(6) +rxt(7))*y(4) + loss(4) = ( + rxt(5) + rxt(6) + rxt(7) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + het_rates(5))* y(5) + prod(5) = 0._r8 + loss(6) = ( + het_rates(6))* y(6) + prod(6) = 0._r8 + loss(7) = ( + het_rates(7))* y(7) + prod(7) = 0._r8 + loss(8) = ( + het_rates(8))* y(8) + prod(8) = 0._r8 + loss(9) = ( + het_rates(9))* y(9) + prod(9) = 0._r8 + loss(10) = ( + het_rates(10))* y(10) + prod(10) = 0._r8 + loss(11) = ( + het_rates(11))* y(11) + prod(11) = 0._r8 + loss(12) = ( + het_rates(12))* y(12) + prod(12) = 0._r8 + loss(13) = ( + het_rates(13))* y(13) + prod(13) = 0._r8 + loss(14) = ( + het_rates(14))* y(14) + prod(14) = 0._r8 + loss(15) = ( + het_rates(15))* y(15) + prod(15) = 0._r8 + loss(16) = ( + het_rates(16))* y(16) + prod(16) = 0._r8 + loss(17) = ( + het_rates(17))* y(17) + prod(17) = 0._r8 + loss(18) = ( + het_rates(18))* y(18) + prod(18) = 0._r8 + loss(19) = ( + het_rates(19))* y(19) + prod(19) = 0._r8 + loss(20) = ( + het_rates(20))* y(20) + prod(20) = 0._r8 + loss(21) = ( + het_rates(21))* y(21) + prod(21) =rxt(3)*y(1) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_mam3/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mam3/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..703c6c35a4 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_rxt_rates_conv.F90 @@ -0,0 +1,19 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*H2O2 + ! rate_const + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*OH*SO2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 4) ! rate_const*NO3*DMS + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_mam3/mo_setrxt.F90 b/src/chemistry/pp_trop_mam3/mo_setrxt.F90 new file mode 100644 index 0000000000..261e09cf50 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_setrxt.F90 @@ -0,0 +1,73 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 b/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 new file mode 100644 index 0000000000..e2cf6b80f5 --- /dev/null +++ b/src/chemistry/pp_trop_mam3/mo_sim_dat.F90 @@ -0,0 +1,128 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 21, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 6, 0, 21 /) + + solsym(: 21) = (/ 'H2O2 ','H2SO4 ','SO2 ','DMS ','SOAG ', & + 'so4_a1 ','pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ', & + 'ncl_a1 ','num_a1 ','so4_a2 ','soa_a2 ','ncl_a2 ', & + 'num_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ','num_a3 ', & + 'H2O ' /) + + adv_mass(: 21) = (/ 34.013600_r8, 98.078400_r8, 64.064800_r8, 62.132400_r8, 12.011000_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 58.442468_r8, 1.007400_r8, 115.107340_r8, 12.011000_r8, 58.442468_r8, & + 1.007400_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, 1.007400_r8, & + 18.014200_r8 /) + + crb_mass(: 21) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8 /) + + fix_mass(: 7) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & + 62.0049400_r8, 33.0062000_r8 /) + + clsmap(: 21,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21 /) + + permute(: 21,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21 /) + + diag_map(: 21) = (/ 1, 3, 5, 7, 8, 9, 10, 11, 12, 13, & + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, & + 24 /) + + extfrc_lst(: 8) = (/ 'SO2 ','so4_a1 ','so4_a2 ','pom_a1 ','bc_a1 ', & + 'num_a1 ','num_a2 ','H2O ' /) + + frc_from_dataset(: 8) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true. /) + + inv_lst(: 7) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & + 'NO3 ', 'HO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 4) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', & + 'usr_SO2_OH ', 'usr_DMS_OH ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 4, 6 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ' /) + pht_alias_lst(:,2) = (/ ' ' /) + pht_alias_mult(:,1) = (/ 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_mam4/chem_mech.doc b/src/chemistry/pp_trop_mam4/chem_mech.doc new file mode 100644 index 0000000000..e2158e70f9 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/chem_mech.doc @@ -0,0 +1,127 @@ + + + Solution species + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS (CH3SCH3) + ( 5) SOAG (C) + ( 6) so4_a1 (NH4HSO4) + ( 7) pom_a1 (C) + ( 8) soa_a1 (C) + ( 9) bc_a1 (C) + ( 10) dst_a1 (AlSiO5) + ( 11) ncl_a1 (NaCl) + ( 12) num_a1 (H) + ( 13) so4_a2 (NH4HSO4) + ( 14) dst_a2 (AlSiO5) + ( 15) soa_a2 (C) + ( 16) ncl_a2 (NaCl) + ( 17) num_a2 (H) + ( 18) dst_a3 (AlSiO5) + ( 19) ncl_a3 (NaCl) + ( 20) so4_a3 (NH4HSO4) + ( 21) num_a3 (H) + ( 22) pom_a4 (C) + ( 23) bc_a4 (C) + ( 24) num_a4 (H) + ( 25) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) O3 + ( 5) OH + ( 6) NO3 + ( 7) HO2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS + ( 5) SOAG + ( 6) so4_a1 + ( 7) pom_a1 + ( 8) soa_a1 + ( 9) bc_a1 + ( 10) dst_a1 + ( 11) ncl_a1 + ( 12) num_a1 + ( 13) so4_a2 + ( 14) soa_a2 + ( 15) ncl_a2 + ( 16) dst_a2 + ( 17) num_a2 + ( 18) dst_a3 + ( 19) ncl_a3 + ( 20) so4_a3 + ( 21) num_a3 + ( 22) pom_a4 + ( 23) bc_a4 + ( 24) num_a4 + ( 25) H2O + + Photolysis + jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + + Reactions + usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) + ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) + ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) + usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) + ( 6) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 7) + +Extraneous prod/loss species + ( 1) SO2 (dataset) + ( 2) so4_a1 (dataset) + ( 3) so4_a2 (dataset) + ( 4) pom_a4 (dataset) + ( 5) bc_a4 (dataset) + ( 6) num_a1 (dataset) + ( 7) num_a2 (dataset) + ( 8) num_a4 (dataset) + ( 9) H2O (dataset) + + + Equation Report + + d(H2O2)/dt = r1 + - j1*H2O2 - r2*OH*H2O2 + d(H2SO4)/dt = r3*OH*SO2 + d(SO2)/dt = r4*OH*DMS + .5*r5*OH*DMS + r6*NO3*DMS + - r3*OH*SO2 + d(DMS)/dt = - r4*OH*DMS - r5*OH*DMS - r6*NO3*DMS + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(dst_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 + d(pom_a4)/dt = 0 + d(bc_a4)/dt = 0 + d(num_a4)/dt = 0 + d(H2O)/dt = r2*OH*H2O2 diff --git a/src/chemistry/pp_trop_mam4/chem_mech.in b/src/chemistry/pp_trop_mam4/chem_mech.in new file mode 100644 index 0000000000..9b7d3e5948 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/chem_mech.in @@ -0,0 +1,86 @@ + SPECIES + + Solution + H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4, dst_a2 -> AlSiO5 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + pom_a4 -> C, bc_a4 -> C + num_a4 -> H + H2O + End Solution + + Fixed + M, N2, O2, O3, OH, NO3, HO2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + H2O2, H2SO4, SO2, DMS, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, dst_a2, num_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + pom_a4, bc_a4, num_a4 + H2O + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + [jh2o2] H2O2 + hv -> + End Photolysis + + Reactions + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + [usr_SO2_OH] SO2 + OH -> H2SO4 + DMS + OH -> SO2 ; 9.6e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + End Reactions + + Ext Forcing + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + H2O <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_trop_mam4/chem_mods.F90 b/src/chemistry/pp_trop_mam4/chem_mods.F90 new file mode 100644 index 0000000000..abde1282ad --- /dev/null +++ b/src/chemistry/pp_trop_mam4/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 1, & ! number of photolysis reactions + rxntot = 7, & ! number of total reactions + gascnt = 6, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 25, & ! number of "gas phase" species + nfs = 7, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 28, & ! number of non-zero matrix entries + extcnt = 9, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 25, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 4, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_mam4/m_rxt_id.F90 b/src/chemistry/pp_trop_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..0eff5755d9 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/m_rxt_id.F90 @@ -0,0 +1,10 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_usr_HO2_HO2 = 2 + integer, parameter :: rid_usr_SO2_OH = 4 + integer, parameter :: rid_usr_DMS_OH = 6 + integer, parameter :: rid_r0003 = 3 + integer, parameter :: rid_r0005 = 5 + integer, parameter :: rid_r0007 = 7 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_mam4/m_spc_id.F90 b/src/chemistry/pp_trop_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..7450960c34 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/m_spc_id.F90 @@ -0,0 +1,28 @@ + module m_spc_id + implicit none + integer, parameter :: id_H2O2 = 1 + integer, parameter :: id_H2SO4 = 2 + integer, parameter :: id_SO2 = 3 + integer, parameter :: id_DMS = 4 + integer, parameter :: id_SOAG = 5 + integer, parameter :: id_so4_a1 = 6 + integer, parameter :: id_pom_a1 = 7 + integer, parameter :: id_soa_a1 = 8 + integer, parameter :: id_bc_a1 = 9 + integer, parameter :: id_dst_a1 = 10 + integer, parameter :: id_ncl_a1 = 11 + integer, parameter :: id_num_a1 = 12 + integer, parameter :: id_so4_a2 = 13 + integer, parameter :: id_dst_a2 = 14 + integer, parameter :: id_soa_a2 = 15 + integer, parameter :: id_ncl_a2 = 16 + integer, parameter :: id_num_a2 = 17 + integer, parameter :: id_dst_a3 = 18 + integer, parameter :: id_ncl_a3 = 19 + integer, parameter :: id_so4_a3 = 20 + integer, parameter :: id_num_a3 = 21 + integer, parameter :: id_pom_a4 = 22 + integer, parameter :: id_bc_a4 = 23 + integer, parameter :: id_num_a4 = 24 + integer, parameter :: id_H2O = 25 + end module m_spc_id diff --git a/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 b/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..f58daf1689 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 @@ -0,0 +1,28 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 5) + rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 5) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 5) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 6) + rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_mam4/mo_exp_sol.F90 b/src/chemistry/pp_trop_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 b/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_mam4/mo_indprd.F90 b/src/chemistry/pp_trop_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..90cfc291ba --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_indprd.F90 @@ -0,0 +1,51 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) =rxt(:,:,2) + prod(:,:,2) = 0._r8 + prod(:,:,3) = + extfrc(:,:,1) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = + extfrc(:,:,2) + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = + extfrc(:,:,6) + prod(:,:,13) = + extfrc(:,:,3) + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = + extfrc(:,:,7) + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) = + extfrc(:,:,4) + prod(:,:,23) = + extfrc(:,:,5) + prod(:,:,24) = + extfrc(:,:,8) + prod(:,:,25) = + extfrc(:,:,9) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..7f07f8dab2 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 @@ -0,0 +1,64 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + rxt(3) + het_rates(1) ) + mat(3) = -( het_rates(2) ) + mat(4) = rxt(4) + mat(5) = -( rxt(4) + het_rates(3) ) + mat(6) = rxt(5) + .500_r8*rxt(6) + rxt(7) + mat(7) = -( rxt(5) + rxt(6) + rxt(7) + het_rates(4) ) + mat(8) = -( het_rates(5) ) + mat(9) = -( het_rates(6) ) + mat(10) = -( het_rates(7) ) + mat(11) = -( het_rates(8) ) + mat(12) = -( het_rates(9) ) + mat(13) = -( het_rates(10) ) + mat(14) = -( het_rates(11) ) + mat(15) = -( het_rates(12) ) + mat(16) = -( het_rates(13) ) + mat(17) = -( het_rates(15) ) + mat(18) = -( het_rates(16) ) + mat(19) = -( het_rates(14) ) + mat(20) = -( het_rates(17) ) + mat(21) = -( het_rates(18) ) + mat(22) = -( het_rates(19) ) + mat(23) = -( het_rates(20) ) + mat(24) = -( het_rates(21) ) + mat(25) = -( het_rates(22) ) + mat(26) = -( het_rates(23) ) + mat(27) = -( het_rates(24) ) + mat(28) = -( het_rates(25) ) + mat(2) = rxt(3) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 b/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..63b64c2ee2 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 @@ -0,0 +1,48 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(5) = 1._r8 / lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(25) = 1._r8 / lu(25) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 b/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..17204afd5f --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 @@ -0,0 +1,80 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(25) = b(25) - lu(2) * b(1) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(25) = b(25) * lu(28) + b(24) = b(24) * lu(27) + b(23) = b(23) * lu(26) + b(22) = b(22) * lu(25) + b(21) = b(21) * lu(24) + b(20) = b(20) * lu(23) + b(19) = b(19) * lu(22) + b(18) = b(18) * lu(21) + b(17) = b(17) * lu(20) + b(16) = b(16) * lu(19) + b(15) = b(15) * lu(18) + b(14) = b(14) * lu(17) + b(13) = b(13) * lu(16) + b(12) = b(12) * lu(15) + b(11) = b(11) * lu(14) + b(10) = b(10) * lu(13) + b(9) = b(9) * lu(12) + b(8) = b(8) * lu(11) + b(7) = b(7) * lu(10) + b(6) = b(6) * lu(9) + b(5) = b(5) * lu(8) + b(4) = b(4) * lu(7) + b(3) = b(3) - lu(6) * b(4) + b(3) = b(3) * lu(5) + b(2) = b(2) - lu(4) * b(3) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..b4f1e41c20 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 @@ -0,0 +1,88 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 5) = mat( 5) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 25) = mat( 25) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_mam4/mo_phtadj.F90 b/src/chemistry/pp_trop_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 b/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..cdca283d11 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 @@ -0,0 +1,86 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + rxt(3) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + het_rates(2))* y(2) + prod(2) =rxt(4)*y(3) + loss(3) = ( + rxt(4) + het_rates(3))* y(3) + prod(3) = (rxt(5) +.500_r8*rxt(6) +rxt(7))*y(4) + loss(4) = ( + rxt(5) + rxt(6) + rxt(7) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + het_rates(5))* y(5) + prod(5) = 0._r8 + loss(6) = ( + het_rates(6))* y(6) + prod(6) = 0._r8 + loss(7) = ( + het_rates(7))* y(7) + prod(7) = 0._r8 + loss(8) = ( + het_rates(8))* y(8) + prod(8) = 0._r8 + loss(9) = ( + het_rates(9))* y(9) + prod(9) = 0._r8 + loss(10) = ( + het_rates(10))* y(10) + prod(10) = 0._r8 + loss(11) = ( + het_rates(11))* y(11) + prod(11) = 0._r8 + loss(12) = ( + het_rates(12))* y(12) + prod(12) = 0._r8 + loss(13) = ( + het_rates(13))* y(13) + prod(13) = 0._r8 + loss(14) = ( + het_rates(15))* y(15) + prod(14) = 0._r8 + loss(15) = ( + het_rates(16))* y(16) + prod(15) = 0._r8 + loss(16) = ( + het_rates(14))* y(14) + prod(16) = 0._r8 + loss(17) = ( + het_rates(17))* y(17) + prod(17) = 0._r8 + loss(18) = ( + het_rates(18))* y(18) + prod(18) = 0._r8 + loss(19) = ( + het_rates(19))* y(19) + prod(19) = 0._r8 + loss(20) = ( + het_rates(20))* y(20) + prod(20) = 0._r8 + loss(21) = ( + het_rates(21))* y(21) + prod(21) = 0._r8 + loss(22) = ( + het_rates(22))* y(22) + prod(22) = 0._r8 + loss(23) = ( + het_rates(23))* y(23) + prod(23) = 0._r8 + loss(24) = ( + het_rates(24))* y(24) + prod(24) = 0._r8 + loss(25) = ( + het_rates(25))* y(25) + prod(25) =rxt(3)*y(1) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..703c6c35a4 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,19 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*H2O2 + ! rate_const + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*OH*SO2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 4) ! rate_const*NO3*DMS + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_mam4/mo_setrxt.F90 b/src/chemistry/pp_trop_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..261e09cf50 --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_setrxt.F90 @@ -0,0 +1,73 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 b/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..e8811864db --- /dev/null +++ b/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 @@ -0,0 +1,128 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 25, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 6, 0, 25 /) + + solsym(: 25) = (/ 'H2O2 ','H2SO4 ','SO2 ','DMS ','SOAG ', & + 'so4_a1 ','pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ', & + 'ncl_a1 ','num_a1 ','so4_a2 ','dst_a2 ','soa_a2 ', & + 'ncl_a2 ','num_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ', & + 'num_a3 ','pom_a4 ','bc_a4 ','num_a4 ','H2O ' /) + + adv_mass(: 25) = (/ 34.013600_r8, 98.078400_r8, 64.064800_r8, 62.132400_r8, 12.011000_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 58.442468_r8, 1.007400_r8, 115.107340_r8, 135.064039_r8, 12.011000_r8, & + 58.442468_r8, 1.007400_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, & + 1.007400_r8, 12.011000_r8, 12.011000_r8, 1.007400_r8, 18.014200_r8 /) + + crb_mass(: 25) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 7) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & + 62.0049400_r8, 33.0062000_r8 /) + + clsmap(: 25,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 15, 16, 14, 17, 18, 19, 20, & + 21, 22, 23, 24, 25 /) + + permute(: 25,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25 /) + + diag_map(: 25) = (/ 1, 3, 5, 7, 8, 9, 10, 11, 12, 13, & + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, & + 24, 25, 26, 27, 28 /) + + extfrc_lst(: 9) = (/ 'SO2 ','so4_a1 ','so4_a2 ','pom_a4 ','bc_a4 ', & + 'num_a1 ','num_a2 ','num_a4 ','H2O ' /) + + frc_from_dataset(: 9) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true. /) + + inv_lst(: 7) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & + 'NO3 ', 'HO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 4) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', & + 'usr_SO2_OH ', 'usr_DMS_OH ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 4, 6 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ' /) + pht_alias_lst(:,2) = (/ ' ' /) + pht_alias_mult(:,1) = (/ 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_mam7/chem_mech.doc b/src/chemistry/pp_trop_mam7/chem_mech.doc new file mode 100644 index 0000000000..a09ea3279e --- /dev/null +++ b/src/chemistry/pp_trop_mam7/chem_mech.doc @@ -0,0 +1,167 @@ + + + Solution species + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS (CH3SCH3) + ( 5) NH3 + ( 6) SOAG (C) + ( 7) so4_a1 (SO4) + ( 8) nh4_a1 (NH4) + ( 9) pom_a1 (C) + ( 10) soa_a1 (C) + ( 11) bc_a1 (C) + ( 12) ncl_a1 (NaCl) + ( 13) num_a1 (H) + ( 14) so4_a2 (SO4) + ( 15) nh4_a2 (NH4) + ( 16) soa_a2 (C) + ( 17) ncl_a2 (NaCl) + ( 18) num_a2 (H) + ( 19) pom_a3 (C) + ( 20) bc_a3 (C) + ( 21) num_a3 (H) + ( 22) ncl_a4 (NaCl) + ( 23) so4_a4 (SO4) + ( 24) nh4_a4 (NH4) + ( 25) num_a4 (H) + ( 26) dst_a5 (AlSiO5) + ( 27) so4_a5 (SO4) + ( 28) nh4_a5 (NH4) + ( 29) num_a5 (H) + ( 30) ncl_a6 (NaCl) + ( 31) so4_a6 (SO4) + ( 32) nh4_a6 (NH4) + ( 33) num_a6 (H) + ( 34) dst_a7 (AlSiO5) + ( 35) so4_a7 (SO4) + ( 36) nh4_a7 (NH4) + ( 37) num_a7 (H) + ( 38) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) O3 + ( 5) OH + ( 6) NO3 + ( 7) HO2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) H2O2 + ( 2) H2SO4 + ( 3) SO2 + ( 4) DMS + ( 5) NH3 + ( 6) SOAG + ( 7) so4_a1 + ( 8) nh4_a1 + ( 9) pom_a1 + ( 10) soa_a1 + ( 11) bc_a1 + ( 12) ncl_a1 + ( 13) num_a1 + ( 14) so4_a2 + ( 15) nh4_a2 + ( 16) soa_a2 + ( 17) ncl_a2 + ( 18) num_a2 + ( 19) pom_a3 + ( 20) bc_a3 + ( 21) num_a3 + ( 22) ncl_a4 + ( 23) so4_a4 + ( 24) nh4_a4 + ( 25) num_a4 + ( 26) dst_a5 + ( 27) so4_a5 + ( 28) nh4_a5 + ( 29) num_a5 + ( 30) ncl_a6 + ( 31) so4_a6 + ( 32) nh4_a6 + ( 33) num_a6 + ( 34) dst_a7 + ( 35) so4_a7 + ( 36) nh4_a7 + ( 37) num_a7 + ( 38) H2O + + Photolysis + jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + + Reactions + usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) + ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) + ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) + usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) + ( 6) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 7) + ( 7) NH3 + OH -> H2O rate = 1.70E-12*exp( -710./t) ( 8) + +Extraneous prod/loss species + ( 1) SO2 (dataset) + ( 2) so4_a1 (dataset) + ( 3) so4_a2 (dataset) + ( 4) num_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) pom_a3 (dataset) + ( 7) bc_a3 (dataset) + ( 8) num_a3 (dataset) + ( 9) H2O (dataset) + + + Equation Report + + d(H2O2)/dt = r1 + - j1*H2O2 - r2*OH*H2O2 + d(H2SO4)/dt = r3*OH*SO2 + d(SO2)/dt = r4*OH*DMS + .5*r5*OH*DMS + r6*NO3*DMS + - r3*OH*SO2 + d(DMS)/dt = - r4*OH*DMS - r5*OH*DMS - r6*NO3*DMS + d(NH3)/dt = - r7*OH*NH3 + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(nh4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(nh4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(pom_a3)/dt = 0 + d(bc_a3)/dt = 0 + d(num_a3)/dt = 0 + d(ncl_a4)/dt = 0 + d(so4_a4)/dt = 0 + d(nh4_a4)/dt = 0 + d(num_a4)/dt = 0 + d(dst_a5)/dt = 0 + d(so4_a5)/dt = 0 + d(nh4_a5)/dt = 0 + d(num_a5)/dt = 0 + d(ncl_a6)/dt = 0 + d(so4_a6)/dt = 0 + d(nh4_a6)/dt = 0 + d(num_a6)/dt = 0 + d(dst_a7)/dt = 0 + d(so4_a7)/dt = 0 + d(nh4_a7)/dt = 0 + d(num_a7)/dt = 0 + d(H2O)/dt = r2*OH*H2O2 + r7*OH*NH3 diff --git a/src/chemistry/pp_trop_mam7/chem_mech.in b/src/chemistry/pp_trop_mam7/chem_mech.in new file mode 100644 index 0000000000..1dd94178da --- /dev/null +++ b/src/chemistry/pp_trop_mam7/chem_mech.in @@ -0,0 +1,110 @@ + SPECIES + + Solution + H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, + SOAG -> C + so4_a1 -> SO4, + nh4_a1 -> NH4 + pom_a1 -> C, + soa_a1 -> C, + bc_a1 -> C, + ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> SO4, + nh4_a2 -> NH4 + soa_a2 -> C, + ncl_a2 -> NaCl + num_a2 -> H + pom_a3 -> C, + bc_a3 -> C + num_a3 -> H + ncl_a4 -> NaCl, + so4_a4 -> SO4 + nh4_a4 -> NH4, + num_a4 -> H + dst_a5 -> AlSiO5, + so4_a5 -> SO4 + nh4_a5 -> NH4, + num_a5 -> H + ncl_a6 -> NaCl, + so4_a6 -> SO4 + nh4_a6 -> NH4, + num_a6 -> H + dst_a7 -> AlSiO5, + so4_a7 -> SO4 + nh4_a7 -> NH4, + num_a7 -> H + H2O + End Solution + + Fixed + M, N2, O2, O3, OH, NO3, HO2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + H2O2, H2SO4, SO2, DMS, NH3, SOAG + so4_a1, nh4_a1, pom_a1 + soa_a1, bc_a1, ncl_a1, num_a1 + so4_a2, nh4_a2, soa_a2, ncl_a2 + num_a2 + pom_a3, bc_a3, num_a3 + ncl_a4, so4_a4, nh4_a4, num_a4 + dst_a5, so4_a5, nh4_a5, num_a5 + ncl_a6, so4_a6, nh4_a6, num_a6 + dst_a7, so4_a7, nh4_a7, num_a7 + H2O + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + [jh2o2] H2O2 + hv -> + End Photolysis + + Reactions + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + [usr_SO2_OH] SO2 + OH -> H2SO4 + DMS + OH -> SO2 ; 9.6e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + NH3 + OH -> H2O ; 1.7e-12, -710. + End Reactions + + Ext Forcing + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + num_a1 <- dataset + num_a2 <- dataset + pom_a3 <- dataset + bc_a3 <- dataset + num_a3 <- dataset + H2O <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_trop_mam7/chem_mods.F90 b/src/chemistry/pp_trop_mam7/chem_mods.F90 new file mode 100644 index 0000000000..b40e9525b6 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 1, & ! number of photolysis reactions + rxntot = 8, & ! number of total reactions + gascnt = 7, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 38, & ! number of "gas phase" species + nfs = 7, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 42, & ! number of non-zero matrix entries + extcnt = 9, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 38, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 4, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_mam7/m_rxt_id.F90 b/src/chemistry/pp_trop_mam7/m_rxt_id.F90 new file mode 100644 index 0000000000..18c3dc9627 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/m_rxt_id.F90 @@ -0,0 +1,11 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_usr_HO2_HO2 = 2 + integer, parameter :: rid_usr_SO2_OH = 4 + integer, parameter :: rid_usr_DMS_OH = 6 + integer, parameter :: rid_r0003 = 3 + integer, parameter :: rid_r0005 = 5 + integer, parameter :: rid_r0007 = 7 + integer, parameter :: rid_r0008 = 8 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_mam7/m_spc_id.F90 b/src/chemistry/pp_trop_mam7/m_spc_id.F90 new file mode 100644 index 0000000000..274e2d4661 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/m_spc_id.F90 @@ -0,0 +1,41 @@ + module m_spc_id + implicit none + integer, parameter :: id_H2O2 = 1 + integer, parameter :: id_H2SO4 = 2 + integer, parameter :: id_SO2 = 3 + integer, parameter :: id_DMS = 4 + integer, parameter :: id_NH3 = 5 + integer, parameter :: id_SOAG = 6 + integer, parameter :: id_so4_a1 = 7 + integer, parameter :: id_nh4_a1 = 8 + integer, parameter :: id_pom_a1 = 9 + integer, parameter :: id_soa_a1 = 10 + integer, parameter :: id_bc_a1 = 11 + integer, parameter :: id_ncl_a1 = 12 + integer, parameter :: id_num_a1 = 13 + integer, parameter :: id_so4_a2 = 14 + integer, parameter :: id_nh4_a2 = 15 + integer, parameter :: id_soa_a2 = 16 + integer, parameter :: id_ncl_a2 = 17 + integer, parameter :: id_num_a2 = 18 + integer, parameter :: id_pom_a3 = 19 + integer, parameter :: id_bc_a3 = 20 + integer, parameter :: id_num_a3 = 21 + integer, parameter :: id_ncl_a4 = 22 + integer, parameter :: id_so4_a4 = 23 + integer, parameter :: id_nh4_a4 = 24 + integer, parameter :: id_num_a4 = 25 + integer, parameter :: id_dst_a5 = 26 + integer, parameter :: id_so4_a5 = 27 + integer, parameter :: id_nh4_a5 = 28 + integer, parameter :: id_num_a5 = 29 + integer, parameter :: id_ncl_a6 = 30 + integer, parameter :: id_so4_a6 = 31 + integer, parameter :: id_nh4_a6 = 32 + integer, parameter :: id_num_a6 = 33 + integer, parameter :: id_dst_a7 = 34 + integer, parameter :: id_so4_a7 = 35 + integer, parameter :: id_nh4_a7 = 36 + integer, parameter :: id_num_a7 = 37 + integer, parameter :: id_H2O = 38 + end module m_spc_id diff --git a/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 b/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 new file mode 100644 index 0000000000..a0ec298dc5 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_adjrxt.F90 @@ -0,0 +1,29 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 5) + rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 5) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 5) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 6) + rate(:,:, 8) = rate(:,:, 8) * inv(:,:, 5) + rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_mam7/mo_exp_sol.F90 b/src/chemistry/pp_trop_mam7/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 b/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_mam7/mo_indprd.F90 b/src/chemistry/pp_trop_mam7/mo_indprd.F90 new file mode 100644 index 0000000000..8f13a86192 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_indprd.F90 @@ -0,0 +1,64 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) =rxt(:,:,2) + prod(:,:,2) = 0._r8 + prod(:,:,3) = + extfrc(:,:,1) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = + extfrc(:,:,2) + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = + extfrc(:,:,4) + prod(:,:,14) = + extfrc(:,:,3) + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = + extfrc(:,:,5) + prod(:,:,19) = + extfrc(:,:,6) + prod(:,:,20) = + extfrc(:,:,7) + prod(:,:,21) = + extfrc(:,:,8) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,31) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,38) = + extfrc(:,:,9) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 new file mode 100644 index 0000000000..9d28a12135 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_lin_matrix.F90 @@ -0,0 +1,78 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + rxt(3) + het_rates(1) ) + mat(3) = -( het_rates(2) ) + mat(4) = rxt(4) + mat(5) = -( rxt(4) + het_rates(3) ) + mat(6) = rxt(5) + .500_r8*rxt(6) + rxt(7) + mat(7) = -( rxt(5) + rxt(6) + rxt(7) + het_rates(4) ) + mat(8) = -( rxt(8) + het_rates(5) ) + mat(10) = -( het_rates(6) ) + mat(11) = -( het_rates(7) ) + mat(12) = -( het_rates(8) ) + mat(13) = -( het_rates(9) ) + mat(14) = -( het_rates(10) ) + mat(15) = -( het_rates(11) ) + mat(16) = -( het_rates(12) ) + mat(17) = -( het_rates(13) ) + mat(18) = -( het_rates(14) ) + mat(19) = -( het_rates(15) ) + mat(20) = -( het_rates(16) ) + mat(21) = -( het_rates(17) ) + mat(22) = -( het_rates(18) ) + mat(23) = -( het_rates(19) ) + mat(24) = -( het_rates(20) ) + mat(25) = -( het_rates(21) ) + mat(26) = -( het_rates(22) ) + mat(27) = -( het_rates(23) ) + mat(28) = -( het_rates(24) ) + mat(29) = -( het_rates(25) ) + mat(30) = -( het_rates(26) ) + mat(31) = -( het_rates(27) ) + mat(32) = -( het_rates(28) ) + mat(33) = -( het_rates(29) ) + mat(34) = -( het_rates(30) ) + mat(35) = -( het_rates(31) ) + mat(36) = -( het_rates(32) ) + mat(37) = -( het_rates(33) ) + mat(38) = -( het_rates(34) ) + mat(39) = -( het_rates(35) ) + mat(40) = -( het_rates(36) ) + mat(41) = -( het_rates(37) ) + mat(42) = -( het_rates(38) ) + mat(2) = rxt(3) + mat(9) = rxt(8) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 b/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 new file mode 100644 index 0000000000..2ceed6f16e --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_lu_factor.F90 @@ -0,0 +1,62 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(5) = 1._r8 / lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = lu(9) * lu(8) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(25) = 1._r8 / lu(25) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) + lu(31) = 1._r8 / lu(31) + lu(32) = 1._r8 / lu(32) + lu(33) = 1._r8 / lu(33) + lu(34) = 1._r8 / lu(34) + lu(35) = 1._r8 / lu(35) + lu(36) = 1._r8 / lu(36) + lu(37) = 1._r8 / lu(37) + lu(38) = 1._r8 / lu(38) + lu(39) = 1._r8 / lu(39) + lu(40) = 1._r8 / lu(40) + lu(41) = 1._r8 / lu(41) + lu(42) = 1._r8 / lu(42) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 b/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 new file mode 100644 index 0000000000..da689fe81f --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_lu_solve.F90 @@ -0,0 +1,94 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(38) = b(38) - lu(2) * b(1) + b(38) = b(38) - lu(9) * b(5) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(38) = b(38) * lu(42) + b(37) = b(37) * lu(41) + b(36) = b(36) * lu(40) + b(35) = b(35) * lu(39) + b(34) = b(34) * lu(38) + b(33) = b(33) * lu(37) + b(32) = b(32) * lu(36) + b(31) = b(31) * lu(35) + b(30) = b(30) * lu(34) + b(29) = b(29) * lu(33) + b(28) = b(28) * lu(32) + b(27) = b(27) * lu(31) + b(26) = b(26) * lu(30) + b(25) = b(25) * lu(29) + b(24) = b(24) * lu(28) + b(23) = b(23) * lu(27) + b(22) = b(22) * lu(26) + b(21) = b(21) * lu(25) + b(20) = b(20) * lu(24) + b(19) = b(19) * lu(23) + b(18) = b(18) * lu(22) + b(17) = b(17) * lu(21) + b(16) = b(16) * lu(20) + b(15) = b(15) * lu(19) + b(14) = b(14) * lu(18) + b(13) = b(13) * lu(17) + b(12) = b(12) * lu(16) + b(11) = b(11) * lu(15) + b(10) = b(10) * lu(14) + b(9) = b(9) * lu(13) + b(8) = b(8) * lu(12) + b(7) = b(7) * lu(11) + b(6) = b(6) * lu(10) + b(5) = b(5) * lu(8) + b(4) = b(4) * lu(7) + b(3) = b(3) - lu(6) * b(4) + b(3) = b(3) * lu(5) + b(2) = b(2) - lu(4) * b(3) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 new file mode 100644 index 0000000000..7c8be8bb70 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_nln_matrix.F90 @@ -0,0 +1,115 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = lmat( 33) + mat( 34) = lmat( 34) + mat( 35) = lmat( 35) + mat( 36) = lmat( 36) + mat( 37) = lmat( 37) + mat( 38) = lmat( 38) + mat( 39) = lmat( 39) + mat( 40) = lmat( 40) + mat( 41) = lmat( 41) + mat( 42) = lmat( 42) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 5) = mat( 5) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 25) = mat( 25) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti + mat( 31) = mat( 31) - dti + mat( 32) = mat( 32) - dti + mat( 33) = mat( 33) - dti + mat( 34) = mat( 34) - dti + mat( 35) = mat( 35) - dti + mat( 36) = mat( 36) - dti + mat( 37) = mat( 37) - dti + mat( 38) = mat( 38) - dti + mat( 39) = mat( 39) - dti + mat( 40) = mat( 40) - dti + mat( 41) = mat( 41) - dti + mat( 42) = mat( 42) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_mam7/mo_phtadj.F90 b/src/chemistry/pp_trop_mam7/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 b/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 new file mode 100644 index 0000000000..146ca15702 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_prod_loss.F90 @@ -0,0 +1,112 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + rxt(3) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + het_rates(2))* y(2) + prod(2) =rxt(4)*y(3) + loss(3) = ( + rxt(4) + het_rates(3))* y(3) + prod(3) = (rxt(5) +.500_r8*rxt(6) +rxt(7))*y(4) + loss(4) = ( + rxt(5) + rxt(6) + rxt(7) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(8) + het_rates(5))* y(5) + prod(5) = 0._r8 + loss(6) = ( + het_rates(6))* y(6) + prod(6) = 0._r8 + loss(7) = ( + het_rates(7))* y(7) + prod(7) = 0._r8 + loss(8) = ( + het_rates(8))* y(8) + prod(8) = 0._r8 + loss(9) = ( + het_rates(9))* y(9) + prod(9) = 0._r8 + loss(10) = ( + het_rates(10))* y(10) + prod(10) = 0._r8 + loss(11) = ( + het_rates(11))* y(11) + prod(11) = 0._r8 + loss(12) = ( + het_rates(12))* y(12) + prod(12) = 0._r8 + loss(13) = ( + het_rates(13))* y(13) + prod(13) = 0._r8 + loss(14) = ( + het_rates(14))* y(14) + prod(14) = 0._r8 + loss(15) = ( + het_rates(15))* y(15) + prod(15) = 0._r8 + loss(16) = ( + het_rates(16))* y(16) + prod(16) = 0._r8 + loss(17) = ( + het_rates(17))* y(17) + prod(17) = 0._r8 + loss(18) = ( + het_rates(18))* y(18) + prod(18) = 0._r8 + loss(19) = ( + het_rates(19))* y(19) + prod(19) = 0._r8 + loss(20) = ( + het_rates(20))* y(20) + prod(20) = 0._r8 + loss(21) = ( + het_rates(21))* y(21) + prod(21) = 0._r8 + loss(22) = ( + het_rates(22))* y(22) + prod(22) = 0._r8 + loss(23) = ( + het_rates(23))* y(23) + prod(23) = 0._r8 + loss(24) = ( + het_rates(24))* y(24) + prod(24) = 0._r8 + loss(25) = ( + het_rates(25))* y(25) + prod(25) = 0._r8 + loss(26) = ( + het_rates(26))* y(26) + prod(26) = 0._r8 + loss(27) = ( + het_rates(27))* y(27) + prod(27) = 0._r8 + loss(28) = ( + het_rates(28))* y(28) + prod(28) = 0._r8 + loss(29) = ( + het_rates(29))* y(29) + prod(29) = 0._r8 + loss(30) = ( + het_rates(30))* y(30) + prod(30) = 0._r8 + loss(31) = ( + het_rates(31))* y(31) + prod(31) = 0._r8 + loss(32) = ( + het_rates(32))* y(32) + prod(32) = 0._r8 + loss(33) = ( + het_rates(33))* y(33) + prod(33) = 0._r8 + loss(34) = ( + het_rates(34))* y(34) + prod(34) = 0._r8 + loss(35) = ( + het_rates(35))* y(35) + prod(35) = 0._r8 + loss(36) = ( + het_rates(36))* y(36) + prod(36) = 0._r8 + loss(37) = ( + het_rates(37))* y(37) + prod(37) = 0._r8 + loss(38) = ( + het_rates(38))* y(38) + prod(38) =rxt(3)*y(1) +rxt(8)*y(5) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_mam7/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mam7/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e42c0dadd7 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_rxt_rates_conv.F90 @@ -0,0 +1,20 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*H2O2 + ! rate_const + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*OH*SO2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 4) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 5) ! rate_const*OH*NH3 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_mam7/mo_setrxt.F90 b/src/chemistry/pp_trop_mam7/mo_setrxt.F90 new file mode 100644 index 0000000000..072fd7f544 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_setrxt.F90 @@ -0,0 +1,74 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,8) = 1.7e-12_r8 * exp( -710._r8 * itemp(:,:) ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 b/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 new file mode 100644 index 0000000000..58230cdc13 --- /dev/null +++ b/src/chemistry/pp_trop_mam7/mo_sim_dat.F90 @@ -0,0 +1,140 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 38, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 7, 0, 38 /) + + solsym(: 38) = (/ 'H2O2 ','H2SO4 ','SO2 ','DMS ','NH3 ', & + 'SOAG ','so4_a1 ','nh4_a1 ','pom_a1 ','soa_a1 ', & + 'bc_a1 ','ncl_a1 ','num_a1 ','so4_a2 ','nh4_a2 ', & + 'soa_a2 ','ncl_a2 ','num_a2 ','pom_a3 ','bc_a3 ', & + 'num_a3 ','ncl_a4 ','so4_a4 ','nh4_a4 ','num_a4 ', & + 'dst_a5 ','so4_a5 ','nh4_a5 ','num_a5 ','ncl_a6 ', & + 'so4_a6 ','nh4_a6 ','num_a6 ','dst_a7 ','so4_a7 ', & + 'nh4_a7 ','num_a7 ','H2O ' /) + + adv_mass(: 38) = (/ 34.013600_r8, 98.078400_r8, 64.064800_r8, 62.132400_r8, 17.028940_r8, & + 12.011000_r8, 96.063600_r8, 18.036340_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 58.442468_r8, 1.007400_r8, 96.063600_r8, 18.036340_r8, & + 12.011000_r8, 58.442468_r8, 1.007400_r8, 12.011000_r8, 12.011000_r8, & + 1.007400_r8, 58.442468_r8, 96.063600_r8, 18.036340_r8, 1.007400_r8, & + 135.064039_r8, 96.063600_r8, 18.036340_r8, 1.007400_r8, 58.442468_r8, & + 96.063600_r8, 18.036340_r8, 1.007400_r8, 135.064039_r8, 96.063600_r8, & + 18.036340_r8, 1.007400_r8, 18.014200_r8 /) + + crb_mass(: 38) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 7) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & + 62.0049400_r8, 33.0062000_r8 /) + + clsmap(: 38,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38 /) + + permute(: 38,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38 /) + + diag_map(: 38) = (/ 1, 3, 5, 7, 8, 10, 11, 12, 13, 14, & + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, & + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, & + 35, 36, 37, 38, 39, 40, 41, 42 /) + + extfrc_lst(: 9) = (/ 'SO2 ','so4_a1 ','so4_a2 ','num_a1 ','num_a2 ', & + 'pom_a3 ','bc_a3 ','num_a3 ','H2O ' /) + + frc_from_dataset(: 9) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true. /) + + inv_lst(: 7) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & + 'NO3 ', 'HO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 4) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', & + 'usr_SO2_OH ', 'usr_DMS_OH ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 4, 6 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ' /) + pht_alias_lst(:,2) = (/ ' ' /) + pht_alias_mult(:,1) = (/ 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_mozart/chem_mech.doc b/src/chemistry/pp_trop_mozart/chem_mech.doc new file mode 100644 index 0000000000..22a861e7c9 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/chem_mech.doc @@ -0,0 +1,778 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O1D (O) + ( 4) N2O + ( 5) NO + ( 6) NO2 + ( 7) NO3 + ( 8) HNO3 + ( 9) HO2NO2 + ( 10) N2O5 + ( 11) H2 + ( 12) OH + ( 13) HO2 + ( 14) H2O2 + ( 15) CH4 + ( 16) CO + ( 17) CH3O2 + ( 18) CH3OOH + ( 19) CH2O + ( 20) CH3OH + ( 21) C2H5OH + ( 22) C2H4 + ( 23) EO (HOCH2CH2O) + ( 24) EO2 (HOCH2CH2O2) + ( 25) CH3COOH + ( 26) GLYALD (HOCH2CHO) + ( 27) C2H6 + ( 28) C2H5O2 + ( 29) C2H5OOH + ( 30) CH3CHO + ( 31) CH3CO3 + ( 32) CH3COOOH + ( 33) C3H6 + ( 34) C3H8 + ( 35) C3H7O2 + ( 36) C3H7OOH + ( 37) PO2 (C3H6OHO2) + ( 38) POOH (C3H6OHOOH) + ( 39) CH3COCH3 + ( 40) RO2 (CH3COCH2O2) + ( 41) ROOH (CH3COCH2OOH) + ( 42) BIGENE (C4H8) + ( 43) ENEO2 (C4H9O3) + ( 44) MEK (C4H8O) + ( 45) MEKO2 (C4H7O3) + ( 46) MEKOOH (C4H8O3) + ( 47) BIGALK (C5H12) + ( 48) ALKO2 (C5H11O2) + ( 49) ALKOOH (C5H12O2) + ( 50) ISOP (C5H8) + ( 51) ISOPO2 (HOCH2COOCH3CHCH2) + ( 52) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 53) MVK (CH2CHCOCH3) + ( 54) MACR (CH2CCH3CHO) + ( 55) MACRO2 (CH3COCHO2CH2OH) + ( 56) MACROOH (CH3COCHOOHCH2OH) + ( 57) MCO3 (CH2CCH3CO3) + ( 58) HYDRALD (HOCH2CCH3CHCHO) + ( 59) HYAC (CH3COCH2OH) + ( 60) CH3COCHO + ( 61) XO2 (HOCH2COOCH3CHOHCHO) + ( 62) XOOH (HOCH2COOHCH3CHOHCHO) + ( 63) C10H16 + ( 64) TERPO2 (C10H17O3) + ( 65) TERPOOH (C10H18O3) + ( 66) TOLUENE (C7H8) + ( 67) CRESOL (C7H8O) + ( 68) TOLO2 (C7H9O5) + ( 69) TOLOOH (C7H10O5) + ( 70) XOH (C7H10O6) + ( 71) BIGALD (C5H6O2) + ( 72) GLYOXAL (C2H2O2) + ( 73) PAN (CH3CO3NO2) + ( 74) ONIT (CH3COCH2ONO2) + ( 75) MPAN (CH2CCH3CO3NO2) + ( 76) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 77) ONITR (CH2CCH3CHONO2CH2OH) + ( 78) CB1 (C) + ( 79) CB2 (C) + ( 80) OC1 (C) + ( 81) OC2 (C) + ( 82) SOA (C12) + ( 83) SO2 + ( 84) DMS (CH3SCH3) + ( 85) SO4 + ( 86) NH3 + ( 87) NH4 + ( 88) NH4NO3 + ( 89) SSLT01 (NaCl) + ( 90) SSLT02 (NaCl) + ( 91) SSLT03 (NaCl) + ( 92) SSLT04 (NaCl) + ( 93) DST01 (AlSiO5) + ( 94) DST02 (AlSiO5) + ( 95) DST03 (AlSiO5) + ( 96) DST04 (AlSiO5) + ( 97) Rn + ( 98) Pb + ( 99) HCN + (100) CH3CN + (101) C2H2 + (102) HCOOH + (103) HOCH2OO + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) H2O + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CO + ( 4) Rn + ( 5) Pb + ( 6) H2 + ( 7) HCN + ( 8) CH3CN + + Implicit + -------- + ( 1) O3 + ( 2) O1D + ( 3) O + ( 4) NO + ( 5) NO2 + ( 6) NO3 + ( 7) HNO3 + ( 8) HO2NO2 + ( 9) N2O5 + ( 10) OH + ( 11) HO2 + ( 12) H2O2 + ( 13) CH3O2 + ( 14) CH3OOH + ( 15) CH2O + ( 16) CH3OH + ( 17) C2H5OH + ( 18) C2H4 + ( 19) EO + ( 20) EO2 + ( 21) CH3COOH + ( 22) GLYALD + ( 23) C2H6 + ( 24) C2H5O2 + ( 25) C2H5OOH + ( 26) CH3CHO + ( 27) CH3CO3 + ( 28) CH3COOOH + ( 29) C3H6 + ( 30) C3H8 + ( 31) C3H7O2 + ( 32) C3H7OOH + ( 33) PO2 + ( 34) POOH + ( 35) CH3COCH3 + ( 36) RO2 + ( 37) ROOH + ( 38) BIGENE + ( 39) ENEO2 + ( 40) BIGALK + ( 41) ALKO2 + ( 42) ALKOOH + ( 43) MEK + ( 44) MEKO2 + ( 45) MEKOOH + ( 46) ISOP + ( 47) ISOPO2 + ( 48) ISOPOOH + ( 49) MVK + ( 50) MACR + ( 51) MACRO2 + ( 52) MACROOH + ( 53) MCO3 + ( 54) HYDRALD + ( 55) HYAC + ( 56) CH3COCHO + ( 57) XO2 + ( 58) XOOH + ( 59) C10H16 + ( 60) TERPO2 + ( 61) TERPOOH + ( 62) TOLUENE + ( 63) CRESOL + ( 64) TOLO2 + ( 65) TOLOOH + ( 66) XOH + ( 67) BIGALD + ( 68) GLYOXAL + ( 69) PAN + ( 70) ONIT + ( 71) MPAN + ( 72) ISOPNO3 + ( 73) ONITR + ( 74) SO2 + ( 75) DMS + ( 76) SO4 + ( 77) NH3 + ( 78) NH4 + ( 79) NH4NO3 + ( 80) SOA + ( 81) CB1 + ( 82) CB2 + ( 83) OC1 + ( 84) OC2 + ( 85) C2H2 + ( 86) HCOOH + ( 87) HOCH2OO + ( 88) SSLT01 + ( 89) SSLT02 + ( 90) SSLT03 + ( 91) SSLT04 + ( 92) DST01 + ( 93) DST02 + ( 94) DST03 + ( 95) DST04 + + Photolysis + jo2 ( 1) O2 + hv -> 2*O rate = ** User defined ** ( 1) + jo1d ( 2) O3 + hv -> O1D + O2 rate = ** User defined ** ( 2) + jo3p ( 3) O3 + hv -> O + O2 rate = ** User defined ** ( 3) + jn2o ( 4) N2O + hv -> O1D + N2 rate = ** User defined ** ( 4) + jno2 ( 5) NO2 + hv -> NO + O rate = ** User defined ** ( 5) + jn2o5 ( 6) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 6) + jhno3 ( 7) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 7) + jno3_a ( 8) NO3 + hv -> .89*NO2 + .11*NO + .89*O3 rate = ** User defined ** ( 8) + jno3_b ( 9) NO3 + hv -> .89*NO2 + .11*NO + .89*O3 rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 rate = ** User defined ** ( 11) + jch3ooh ( 12) CH3OOH + hv -> CH2O + HO2 + OH rate = ** User defined ** ( 12) + jch2o_a ( 13) CH2O + hv -> CO + 2*HO2 rate = ** User defined ** ( 13) + jch2o_b ( 14) CH2O + hv -> CO + H2 rate = ** User defined ** ( 14) + jh2o2 ( 15) H2O2 + hv -> 2*OH rate = ** User defined ** ( 15) + jch3cho ( 16) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 16) + jpooh ( 17) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 17) + jch3co3h ( 18) CH3COOOH + hv -> CH3O2 + OH + {CO2} rate = ** User defined ** ( 18) + jpan ( 19) PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*{CO2} rate = ** User defined ** ( 19) + jmpan ( 20) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 20) + jmacr_a ( 21) MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH rate = ** User defined ** ( 21) + + .67*CO + jmacr_b ( 22) MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH rate = ** User defined ** ( 22) + + .67*CO + jmvk ( 23) MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 rate = ** User defined ** ( 23) + jc2h5ooh ( 24) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 24) + jc3h7ooh ( 25) C3H7OOH + hv -> .82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 25) + jrooh ( 26) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 26) + jacet ( 27) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 27) + jmgly ( 28) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 28) + jxooh ( 29) XOOH + hv -> OH rate = ** User defined ** ( 29) + jonitr ( 30) ONITR + hv -> HO2 + CO + NO2 + CH2O rate = ** User defined ** ( 30) + jisopooh ( 31) ISOPOOH + hv -> .402*MVK + .288*MACR + .69*CH2O + HO2 rate = ** User defined ** ( 31) + jhyac ( 32) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 32) + jglyald ( 33) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 33) + jmek ( 34) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 34) + jbigald ( 35) BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 rate = ** User defined ** ( 35) + + .18*CH3COCHO + jglyoxal ( 36) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 36) + jalkooh ( 37) ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK rate = ** User defined ** ( 37) + + OH + jmekooh ( 38) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 38) + jtolooh ( 39) TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD rate = ** User defined ** ( 39) + jterpooh ( 40) TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR rate = ** User defined ** ( 40) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** ( 41) + ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 42) + o1d_n2 ( 3) O1D + N2 -> O + N2 rate = 2.10E-11*exp( 115./t) ( 43) + o1d_o2 ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) ( 44) + ox_l1 ( 5) O1D + H2O -> 2*OH rate = 2.20E-10 ( 45) + ( 6) H2 + O1D -> HO2 + OH rate = 1.10E-10 ( 46) + ( 7) H2 + OH -> H2O + HO2 rate = 2.80E-12*exp( -1800./t) ( 47) + ( 8) O + OH -> HO2 + O2 rate = 2.20E-11*exp( 120./t) ( 48) + ( 9) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) ( 49) + ox_l2 ( 10) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) ( 50) + ox_l3 ( 11) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) ( 51) + usr_HO2_HO2 ( 12) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 52) + ( 13) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 53) + ( 14) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) ( 54) + ( 15) OH + OH -> H2O + O rate = 1.80E-12 ( 55) + ( 16) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 ( 56) + ki=2.60E-11 + f=0.60 + ( 17) N2O + O1D -> N2 + O2 rate = 4.90E-11 ( 57) + ( 18) N2O + O1D -> 2*NO rate = 6.70E-11 ( 58) + ox_p1 ( 19) NO + HO2 -> NO2 + OH rate = 3.50E-12*exp( 250./t) ( 59) + ( 20) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) ( 60) + ( 21) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) ( 61) + ( 22) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) ( 62) + ( 23) NO3 + HO2 -> OH + NO2 rate = 3.50E-12 ( 63) + tag_NO2_NO3 ( 24) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 ( 64) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 25) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** ( 65) + tag_NO2_OH ( 26) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 ( 66) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 27) HNO3 + OH -> NO3 + H2O rate = ** User defined ** ( 67) + ( 28) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) ( 68) + tag_NO2_HO2 ( 29) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 ( 69) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + ( 30) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) ( 70) + usr_HO2NO2_M ( 31) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** ( 71) + ( 32) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) ( 72) + ( 33) CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 rate = 1.50E-10 ( 73) + ox_p2 ( 34) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) ( 74) + ( 35) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) ( 75) + ( 36) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) ( 76) + ( 37) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) ( 77) + ( 38) CH3OOH + OH -> .7*CH3O2 + .3*OH + .3*CH2O + H2O rate = 3.80E-12*exp( 200./t) ( 78) + ( 39) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) ( 79) + ( 40) CH2O + OH -> CO + H2O + HO2 rate = 9.00E-12 ( 80) + ( 41) CO + OH + M -> {CO2} + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 ( 81) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + usr_CO_OH_b ( 42) CO + OH -> {CO2} + HO2 rate = ** User defined ** ( 82) + ( 43) CH3OH + OH -> HO2 + CH2O rate = 7.30E-12*exp( -620./t) ( 83) + ( 44) HCOOH + OH -> HO2 + {CO2} + H2O rate = 4.50E-13 ( 84) + ( 45) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) ( 85) + ( 46) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) ( 86) + ( 47) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) ( 87) + ( 48) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) ( 88) + ( 49) C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 troe : ko=5.50E-30 ( 89) + + .35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + tag_C2H4_OH ( 50) C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M troe : ko=1.00E-28*(300/t)**0.80 ( 90) + ki=8.80E-12 + f=0.60 + ox_l6 ( 51) C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH rate = 1.20E-14*exp( -2630./t) ( 91) + ox_p16 ( 52) EO2 + NO -> EO + NO2 rate = 4.20E-12*exp( 180./t) ( 92) + ( 53) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 ( 93) + ( 54) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) ( 94) + ( 55) C2H6 + OH -> C2H5O2 + H2O rate = 8.70E-12*exp( -1070./t) ( 95) + ox_p5 ( 56) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) ( 96) + ( 57) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) ( 97) + ( 58) C2H5O2 + CH3O2 -> .7*CH2O + .8*CH3CHO + HO2 + .3*CH3OH + .2*C2H5OH rate = 2.00E-13 ( 98) + ( 59) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + .4*C2H5OH rate = 6.80E-14 ( 99) + ( 60) C2H5OOH + OH -> .5*C2H5O2 + .5*CH3CHO + .5*OH rate = 3.80E-12*exp( 200./t) (100) + ( 61) CH3CHO + OH -> CH3CO3 + H2O rate = 5.60E-12*exp( 270./t) (101) + ( 62) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (102) + ox_p4 ( 63) CH3CO3 + NO -> CH3O2 + {CO2} + NO2 rate = 8.10E-12*exp( 270./t) (103) + tag_CH3CO3_NO2 ( 64) CH3CO3 + NO2 + M -> PAN + M troe : ko=8.50E-29*(300/t)**6.50 (104) + ki=1.10E-11*(300/t) + f=0.60 + ( 65) CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 rate = 4.30E-13*exp( 1040./t) (105) + ( 66) CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*{CO2} + .1*CH3COOH rate = 2.00E-12*exp( 500./t) (106) + ( 67) CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*{CO2} + H2O rate = 1.00E-12 (107) + ( 68) PAN + OH -> CH2O + NO3 + {CO2} rate = 4.00E-14 (108) + usr_PAN_M ( 69) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (109) + ( 70) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*{CO2} rate = 2.50E-12*exp( 500./t) (110) + ( 71) GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*{CO2} rate = 1.00E-11 (111) + ( 72) GLYOXAL + OH -> HO2 + CO + {CO2} rate = 1.10E-11 (112) + ( 73) CH3COOH + OH -> CH3O2 + {CO2} + H2O rate = 7.00E-13 (113) + ( 74) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (114) + tag_C3H6_OH ( 75) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (115) + ki=3.00E-11 + f=0.50 + ox_l4 ( 76) C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 + .56*CO rate = 6.50E-15*exp( -1900./t) (116) + + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + ( 77) C3H6 + NO3 -> ONIT rate = 4.60E-13*exp( -1156./t) (117) + ox_p3 ( 78) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (118) + ( 79) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (119) + ( 80) POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (120) + ( 81) C3H8 + OH -> C3H7O2 + H2O rate = 1.00E-11*exp( -665./t) (121) + ox_p9 ( 82) C3H7O2 + NO -> .82*CH3COCH3 + NO2 + HO2 + .27*CH3CHO rate = 4.20E-12*exp( 180./t) (122) + ( 83) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (123) + ( 84) C3H7O2 + CH3O2 -> CH2O + HO2 + .82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (124) + ( 85) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (125) + usr_CH3COCH3_OH ( 86) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (126) + ox_p10 ( 87) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (127) + ( 88) RO2 + HO2 -> ROOH + O2 rate = 8.60E-13*exp( 700./t) (128) + ( 89) RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC + .5*CH3COCHO rate = 7.10E-13*exp( 500./t) (129) + + .5*CH3OH + ( 90) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (130) + ( 91) ONIT + OH -> NO2 + CH3COCHO rate = 6.80E-13 (131) + ( 92) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (132) + ( 93) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (133) + ( 94) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (134) + ( 95) BIGENE + OH -> ENEO2 rate = 5.40E-11 (135) + ox_p15 ( 96) ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (136) + ( 97) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (137) + ox_p17 ( 98) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (138) + ( 99) MEKO2 + HO2 -> MEKOOH rate = 7.50E-13*exp( 700./t) (139) + (100) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (140) + (101) MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*{CO2} + M troe : ko=8.00E-27*(300/t)**3.50 (141) + ki=3.00E-11 + f=0.50 + soa5 (102) BIGALK + OH -> ALKO2 rate = 3.50E-12 (142) + ox_p14 (103) ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .75*MEK rate = 4.20E-12*exp( 180./t) (143) + + .9*NO2 + .1*ONIT + (104) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (144) + (105) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (145) + (106) ISOP + OH -> ISOPO2 rate = 2.54E-11*exp( 410./t) (146) + ox_l5 (107) ISOP + O3 -> .4*MACR + .2*MVK + .07*C3H6 + .27*OH + .06*HO2 rate = 1.05E-14*exp( -2000./t) (147) + + .6*CH2O + .3*CO + .1*O3 + .2*MCO3 + .2*CH3COOH + ox_p6 (108) ISOPO2 + NO -> .08*ONITR + .92*NO2 + HO2 + .55*CH2O + .23*MACR rate = 4.40E-12*exp( 180./t) (148) + + .32*MVK + .37*HYDRALD + (109) ISOPO2 + NO3 -> HO2 + NO2 + .6*CH2O + .25*MACR + .35*MVK rate = 2.40E-12 (149) + + .4*HYDRALD + (110) ISOPO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (150) + (111) ISOPOOH + OH -> .8*XO2 + .2*ISOPO2 rate = 1.52E-11*exp( 200./t) (151) + (112) ISOPO2 + CH3O2 -> .25*CH3OH + HO2 + 1.2*CH2O + .19*MACR + .26*MVK rate = 5.00E-13*exp( 400./t) (152) + + .3*HYDRALD + (113) ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6*CH2O + {CO2} + .25*MACR rate = 1.40E-11 (153) + + .35*MVK + .4*HYDRALD + (114) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (154) + (115) ISOPNO3 + NO -> 1.206*NO2 + .794*HO2 + .072*CH2O + .167*MACR rate = 2.70E-12*exp( 360./t) (155) + + .039*MVK + .794*ONITR + (116) ISOPNO3 + NO3 -> 1.206*NO2 + .072*CH2O + .167*MACR + .039*MVK rate = 2.40E-12 (156) + + .794*ONITR + .794*HO2 + (117) ISOPNO3 + HO2 -> .206*NO2 + .794*HO2 + .008*CH2O + .167*MACR rate = 8.00E-13*exp( 700./t) (157) + + .039*MVK + .794*ONITR + (118) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (158) + ox_l7 (119) MVK + O3 -> .8*CH2O + .95*CH3COCHO + .08*OH + .2*O3 + .06*HO2 rate = 7.52E-16*exp( -1521./t) (159) + + .05*CO + .04*CH3CHO + (120) MACR + OH -> .5*MACRO2 + .5*H2O + .5*MCO3 rate = 1.86E-11*exp( 175./t) (160) + ox_l8 (121) MACR + O3 -> .8*CH3COCHO + .275*HO2 + .2*CO + .2*O3 + .7*CH2O rate = 4.40E-15*exp( -2500./t) (161) + + .215*OH + ox_p7 (122) MACRO2 + NO -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO + .53*CH3CO3 rate = 2.70E-12*exp( 360./t) (162) + + .53*GLYALD + .22*HYAC + .22*CO + (123) MACRO2 + NO -> 0.8*ONITR rate = 1.30E-13*exp( 360./t) (163) + (124) MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO + .22*CO rate = 2.40E-12 (164) + + .53*GLYALD + .22*HYAC + .53*CH3CO3 + (125) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (165) + (126) MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO rate = 5.00E-13*exp( 400./t) (166) + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + (127) MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + {CO2} rate = 1.40E-11 (167) + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + (128) MACROOH + OH -> .5*MCO3 + .2*MACRO2 + .1*OH + .2*HO2 rate = 2.30E-11*exp( 200./t) (168) + ox_p8 (129) MCO3 + NO -> NO2 + CH2O + CH3CO3 + {CO2} rate = 5.30E-12*exp( 360./t) (169) + (130) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + {CO2} rate = 5.00E-12 (170) + (131) MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 rate = 4.30E-13*exp( 1040./t) (171) + (132) MCO3 + CH3O2 -> 2*CH2O + HO2 + {CO2} + CH3CO3 rate = 2.00E-12*exp( 500./t) (172) + (133) MCO3 + CH3CO3 -> 2*{CO2} + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (173) + (134) MCO3 + MCO3 -> 2*{CO2} + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (174) + usr_MCO3_NO2 (135) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (175) + usr_MPAN_M (136) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (176) + (137) ONITR + OH -> HYDRALD + .4*NO2 + HO2 rate = 4.50E-11 (177) + (138) ONITR + NO3 -> HYDRALD + NO2 + HO2 rate = 1.40E-12*exp( -1860./t) (178) + (139) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (179) + ox_p11 (140) XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL + .25*HYAC rate = 2.70E-12*exp( 360./t) (180) + + .25*CH3COCHO + .25*GLYALD + (141) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (181) + + .25*CH3COCHO + .25*GLYALD + (142) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (182) + (143) XO2 + CH3O2 -> .3*CH3OH + 0.8*HO2 + .7*CH2O + .2*CO + .1*HYAC rate = 5.00E-13*exp( 400./t) (183) + + .1*GLYOXAL + .1*CH3COCHO + .1*GLYALD + (144) XO2 + CH3CO3 -> 0.5*CO + CH3O2 + HO2 + {CO2} + {.25GLYOXAL} rate = 1.30E-12*exp( 640./t) (184) + + .25*HYAC + .25*CH3COCHO + .25*GLYALD + (145) XOOH + OH -> H2O + XO2 rate = 1.90E-12*exp( 190./t) (185) + usr_XOOH_OH (146) XOOH + OH -> H2O + OH rate = ** User defined ** (186) + soa4 (147) TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 rate = 1.70E-12*exp( 352./t) (187) + (148) CRESOL + OH -> XOH rate = 3.00E-12 (188) + (149) XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 rate = 1.00E-11 (189) + ox_p12 (150) TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + .9*NO2 rate = 4.20E-12*exp( 180./t) (190) + + .9*HO2 + (151) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (191) + (152) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (192) + soa2 (153) C10H16 + OH -> TERPO2 rate = 1.20E-11*exp( 444./t) (193) + soa1 (154) C10H16 + O3 -> .7*OH + MVK + MACR + HO2 rate = 1.00E-15*exp( -732./t) (194) + soa3 (155) C10H16 + NO3 -> TERPO2 + NO2 rate = 1.20E-12*exp( 490./t) (195) + ox_p13 (156) TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 rate = 4.20E-12*exp( 180./t) (196) + (157) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (197) + (158) TERPOOH + OH -> TERPO2 rate = 3.80E-12*exp( 200./t) (198) + (159) Rn -> Pb rate = 2.10E-06 (199) + usr_N2O5_aer (160) N2O5 -> 2*HNO3 rate = ** User defined ** (200) + usr_NO3_aer (161) NO3 -> HNO3 rate = ** User defined ** (201) + usr_NO2_aer (162) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (202) + (163) CB1 -> CB2 rate = 7.10E-06 (203) + usr_SO2_OH (164) SO2 + OH -> SO4 rate = ** User defined ** (204) + (165) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (205) + usr_DMS_OH (166) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** (206) + (167) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (207) + (168) NH3 + OH -> H2O rate = 1.70E-12*exp( -710./t) (208) + (169) OC1 -> OC2 rate = 7.10E-06 (209) + usr_HO2_aer (170) HO2 -> 0.5*H2O2 rate = ** User defined ** (210) + (171) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (211) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + (172) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (212) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) CO (dataset) + ( 3) SO2 (dataset) + ( 4) SO4 (dataset) + + + Equation Report + + d(O3)/dt = .89*j8*NO3 + .89*j9*NO3 + r1*O2*M*O + .25*r65*CH3CO3*HO2 + .1*r107*ISOP*O3 + .2*r119*MVK*O3 + + .2*r121*MACR*O3 + .25*r131*MCO3*HO2 + - j2*O3 - j3*O3 - r2*O*O3 - r10*OH*O3 - r11*HO2*O3 - r20*NO*O3 - r22*NO2*O3 - r51*C2H4*O3 + - r76*C3H6*O3 - r107*ISOP*O3 - r119*MVK*O3 - r121*MACR*O3 - r154*C10H16*O3 + d(O)/dt = 2*j1*O2 + j3*O3 + j5*NO2 + r3*N2*O1D + r4*O2*O1D + r15*OH*OH + - r1*O2*M*O - r2*O3*O - r8*OH*O - r9*HO2*O - r21*NO2*O + d(O1D)/dt = j2*O3 + j4*N2O + - r3*N2*O1D - r4*O2*O1D - r5*H2O*O1D - r6*H2*O1D - r17*N2O*O1D - r18*N2O*O1D - r33*CH4*O1D + d(N2O)/dt = - j4*N2O - r17*O1D*N2O - r18*O1D*N2O + d(NO)/dt = j5*NO2 + .11*j8*NO3 + .11*j9*NO3 + .5*r162*NO2 + 2*r18*N2O*O1D + r21*NO2*O + - r19*HO2*NO - r20*O3*NO - r28*NO3*NO - r34*CH3O2*NO - r47*HOCH2OO*NO - r52*EO2*NO + - r56*C2H5O2*NO - r63*CH3CO3*NO - r78*PO2*NO - r82*C3H7O2*NO - r87*RO2*NO - r96*ENEO2*NO + - r98*MEKO2*NO - r103*ALKO2*NO - r108*ISOPO2*NO - r115*ISOPNO3*NO - r122*MACRO2*NO + - r123*MACRO2*NO - r129*MCO3*NO - r140*XO2*NO - r150*TOLO2*NO - r156*TERPO2*NO + d(NO2)/dt = j6*N2O5 + j7*HNO3 + .89*j8*NO3 + .89*j9*NO3 + .66*j10*HO2NO2 + .66*j11*HO2NO2 + .6*j19*PAN + + j20*MPAN + j30*ONITR + r25*M*N2O5 + r31*M*HO2NO2 + r69*M*PAN + r136*M*MPAN + r19*NO*HO2 + + r20*NO*O3 + r23*NO3*HO2 + 2*r28*NO3*NO + r30*HO2NO2*OH + r34*CH3O2*NO + r47*HOCH2OO*NO + + r52*EO2*NO + r56*C2H5O2*NO + r63*CH3CO3*NO + r78*PO2*NO + r82*C3H7O2*NO + r87*RO2*NO + + r91*ONIT*OH + r96*ENEO2*NO + r98*MEKO2*NO + .9*r103*ALKO2*NO + .92*r108*ISOPO2*NO + + r109*ISOPO2*NO3 + 1.206*r115*ISOPNO3*NO + 1.206*r116*ISOPNO3*NO3 + .206*r117*ISOPNO3*HO2 + + r122*MACRO2*NO + r124*MACRO2*NO3 + r129*MCO3*NO + r130*MCO3*NO3 + .4*r137*ONITR*OH + + r138*ONITR*NO3 + r140*XO2*NO + r141*XO2*NO3 + .7*r149*XOH*NO2 + .9*r150*TOLO2*NO + + r155*C10H16*NO3 + r156*TERPO2*NO + - j5*NO2 - r162*NO2 - r21*O*NO2 - r22*O3*NO2 - r24*M*NO3*NO2 - r26*M*OH*NO2 - r29*M*HO2*NO2 + - r64*M*CH3CO3*NO2 - r135*M*MCO3*NO2 - r149*XOH*NO2 + d(NO3)/dt = j6*N2O5 + .33*j10*HO2NO2 + .33*j11*HO2NO2 + .4*j19*PAN + r25*M*N2O5 + r22*NO2*O3 + r27*HNO3*OH + + r68*PAN*OH + .5*r101*M*MPAN*OH + - j8*NO3 - j9*NO3 - r161*NO3 - r23*HO2*NO3 - r24*M*NO2*NO3 - r28*NO*NO3 - r39*CH2O*NO3 + - r62*CH3CHO*NO3 - r77*C3H6*NO3 - r93*CH3COCHO*NO3 - r109*ISOPO2*NO3 - r114*ISOP*NO3 + - r116*ISOPNO3*NO3 - r124*MACRO2*NO3 - r130*MCO3*NO3 - r138*ONITR*NO3 - r141*XO2*NO3 + - r155*C10H16*NO3 - r167*DMS*NO3 + d(HNO3)/dt = 2*r160*N2O5 + r161*NO3 + .5*r162*NO2 + r26*M*NO2*OH + r39*CH2O*NO3 + r62*CH3CHO*NO3 + + r93*CH3COCHO*NO3 + r167*DMS*NO3 + - j7*HNO3 - r27*OH*HNO3 + d(HO2NO2)/dt = r29*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r31*M*HO2NO2 - r30*OH*HO2NO2 + d(N2O5)/dt = r24*M*NO2*NO3 + - j6*N2O5 - r25*M*N2O5 - r160*N2O5 + d(H2)/dt = j14*CH2O + .05*r33*CH4*O1D + - r6*O1D*H2 - r7*OH*H2 + d(OH)/dt = j7*HNO3 + .33*j10*HO2NO2 + .33*j11*HO2NO2 + j12*CH3OOH + 2*j15*H2O2 + j17*POOH + j18*CH3COOOH + + .33*j21*MACR + .33*j22*MACR + j24*C2H5OOH + j25*C3H7OOH + j26*ROOH + j29*XOOH + j37*ALKOOH + + j38*MEKOOH + j39*TOLOOH + j40*TERPOOH + 2*r5*H2O*O1D + .5*r162*NO2 + r6*H2*O1D + r9*HO2*O + + r11*HO2*O3 + r19*NO*HO2 + r23*NO3*HO2 + .75*r33*CH4*O1D + .3*r38*CH3OOH*OH + .65*r49*M*C2H2*OH + + .12*r51*C2H4*O3 + .5*r60*C2H5OOH*OH + .33*r76*C3H6*O3 + .5*r80*POOH*OH + .27*r107*ISOP*O3 + + .08*r119*MVK*O3 + .215*r121*MACR*O3 + .1*r128*MACROOH*OH + .7*r154*C10H16*O3 + - r7*H2*OH - r8*O*OH - r10*O3*OH - r13*H2O2*OH - r14*HO2*OH - 2*r15*OH*OH - 2*r16*M*OH*OH + - r26*M*NO2*OH - r27*HNO3*OH - r30*HO2NO2*OH - r32*CH4*OH - r38*CH3OOH*OH - r40*CH2O*OH + - r41*M*CO*OH - r42*CO*OH - r43*CH3OH*OH - r44*HCOOH*OH - r49*M*C2H2*OH - r50*M*C2H4*OH + - r55*C2H6*OH - r60*C2H5OOH*OH - r61*CH3CHO*OH - r67*CH3COOOH*OH - r68*PAN*OH - r71*GLYALD*OH + - r72*GLYOXAL*OH - r73*CH3COOH*OH - r74*C2H5OH*OH - r75*M*C3H6*OH - r80*POOH*OH - r81*C3H8*OH + - r85*C3H7OOH*OH - r86*CH3COCH3*OH - r90*ROOH*OH - r91*ONIT*OH - r92*CH3COCHO*OH - r94*HYAC*OH + - r95*BIGENE*OH - r97*MEK*OH - r100*MEKOOH*OH - r101*M*MPAN*OH - r102*BIGALK*OH - r105*ALKOOH*OH + - r106*ISOP*OH - r111*ISOPOOH*OH - r118*MVK*OH - r120*MACR*OH - r128*MACROOH*OH - r137*ONITR*OH + - r139*HYDRALD*OH - r145*XOOH*OH - r147*TOLUENE*OH - r148*CRESOL*OH - r152*TOLOOH*OH + - r153*C10H16*OH - r158*TERPOOH*OH - r164*SO2*OH - r165*DMS*OH - r166*DMS*OH - r168*NH3*OH + - r171*M*HCN*OH - r172*CH3CN*OH + d(HO2)/dt = .66*j10*HO2NO2 + .66*j11*HO2NO2 + j12*CH3OOH + 2*j13*CH2O + j16*CH3CHO + j17*POOH + .67*j21*MACR + + .67*j22*MACR + j24*C2H5OOH + j25*C3H7OOH + j28*CH3COCHO + j30*ONITR + j31*ISOPOOH + j32*HYAC + + 2*j33*GLYALD + .56*j35*BIGALD + 2*j36*GLYOXAL + .9*j37*ALKOOH + j40*TERPOOH + r31*M*HO2NO2 + + r46*HOCH2OO + r53*O2*EO + r54*EO + r6*H2*O1D + r7*H2*OH + r8*O*OH + r10*OH*O3 + r13*H2O2*OH + + .4*r33*CH4*O1D + r34*CH3O2*NO + 2*r35*CH3O2*CH3O2 + r39*CH2O*NO3 + r40*CH2O*OH + r41*M*CO*OH + + r42*CO*OH + r43*CH3OH*OH + r44*HCOOH*OH + r47*HOCH2OO*NO + .35*r49*M*C2H2*OH + + .25*r50*M*C2H4*OH + .12*r51*C2H4*O3 + r56*C2H5O2*NO + r58*C2H5O2*CH3O2 + 1.2*r59*C2H5O2*C2H5O2 + + .9*r66*CH3CO3*CH3O2 + r71*GLYALD*OH + r72*GLYOXAL*OH + r74*C2H5OH*OH + .19*r76*C3H6*O3 + + r78*PO2*NO + r82*C3H7O2*NO + r84*C3H7O2*CH3O2 + .3*r89*RO2*CH3O2 + r94*HYAC*OH + r96*ENEO2*NO + + .5*r101*M*MPAN*OH + .9*r103*ALKO2*NO + .06*r107*ISOP*O3 + r108*ISOPO2*NO + r109*ISOPO2*NO3 + + r112*ISOPO2*CH3O2 + r113*ISOPO2*CH3CO3 + .794*r115*ISOPNO3*NO + .794*r116*ISOPNO3*NO3 + + .794*r117*ISOPNO3*HO2 + .06*r119*MVK*O3 + .275*r121*MACR*O3 + .47*r122*MACRO2*NO + + .47*r124*MACRO2*NO3 + .73*r126*MACRO2*CH3O2 + .47*r127*MACRO2*CH3CO3 + .2*r128*MACROOH*OH + + r132*MCO3*CH3O2 + r137*ONITR*OH + r138*ONITR*NO3 + r140*XO2*NO + r141*XO2*NO3 + + .8*r143*XO2*CH3O2 + r144*XO2*CH3CO3 + .25*r147*TOLUENE*OH + .7*r149*XOH*NO2 + .9*r150*TOLO2*NO + + r154*C10H16*O3 + r156*TERPO2*NO + .5*r166*DMS*OH + r171*M*HCN*OH + r172*CH3CN*OH + - r170*HO2 - r9*O*HO2 - r11*O3*HO2 - 2*r12*HO2*HO2 - r14*OH*HO2 - r19*NO*HO2 - r23*NO3*HO2 + - r29*M*NO2*HO2 - r37*CH3O2*HO2 - r45*CH2O*HO2 - r48*HOCH2OO*HO2 - r57*C2H5O2*HO2 + - r65*CH3CO3*HO2 - r79*PO2*HO2 - r83*C3H7O2*HO2 - r88*RO2*HO2 - r99*MEKO2*HO2 - r104*ALKO2*HO2 + - r110*ISOPO2*HO2 - r117*ISOPNO3*HO2 - r125*MACRO2*HO2 - r131*MCO3*HO2 - r142*XO2*HO2 + - r151*TOLO2*HO2 - r157*TERPO2*HO2 + d(H2O2)/dt = .5*r170*HO2 + r12*HO2*HO2 + r16*M*OH*OH + - j15*H2O2 - r13*OH*H2O2 + d(CH4)/dt = .08*r76*C3H6*O3 + - r32*OH*CH4 - r33*O1D*CH4 + d(CO)/dt = j13*CH2O + j14*CH2O + j16*CH3CHO + .67*j21*MACR + .67*j22*MACR + .7*j23*MVK + j28*CH3COCHO + + j30*ONITR + j33*GLYALD + .45*j35*BIGALD + 2*j36*GLYOXAL + r39*CH2O*NO3 + r40*CH2O*OH + + .35*r49*M*C2H2*OH + .5*r51*C2H4*O3 + r72*GLYOXAL*OH + .56*r76*C3H6*O3 + r92*CH3COCHO*OH + + r93*CH3COCHO*NO3 + .3*r107*ISOP*O3 + .05*r119*MVK*O3 + .2*r121*MACR*O3 + .22*r122*MACRO2*NO + + .22*r124*MACRO2*NO3 + .11*r126*MACRO2*CH3O2 + .22*r127*MACRO2*CH3CO3 + .5*r140*XO2*NO + + .5*r141*XO2*NO3 + .2*r143*XO2*CH3O2 + .5*r144*XO2*CH3CO3 + - r41*M*OH*CO - r42*OH*CO + d(CH3O2)/dt = j16*CH3CHO + j18*CH3COOOH + .4*j19*PAN + .3*j23*MVK + j27*CH3COCH3 + r32*CH4*OH + + .75*r33*CH4*O1D + .7*r38*CH3OOH*OH + r63*CH3CO3*NO + .9*r66*CH3CO3*CH3O2 + + 2*r70*CH3CO3*CH3CO3 + r73*CH3COOH*OH + .31*r76*C3H6*O3 + r113*ISOPO2*CH3CO3 + + r127*MACRO2*CH3CO3 + r133*MCO3*CH3CO3 + r144*XO2*CH3CO3 + - r34*NO*CH3O2 - 2*r35*CH3O2*CH3O2 - 2*r36*CH3O2*CH3O2 - r37*HO2*CH3O2 - r58*C2H5O2*CH3O2 + - r66*CH3CO3*CH3O2 - r84*C3H7O2*CH3O2 - r89*RO2*CH3O2 - r112*ISOPO2*CH3O2 - r126*MACRO2*CH3O2 + - r132*MCO3*CH3O2 - r143*XO2*CH3O2 + d(CH3OOH)/dt = r37*CH3O2*HO2 + - j12*CH3OOH - r38*OH*CH3OOH + d(CH2O)/dt = j12*CH3OOH + j17*POOH + .67*j21*MACR + .67*j22*MACR + j26*ROOH + j30*ONITR + .69*j31*ISOPOOH + + j32*HYAC + j33*GLYALD + .1*j37*ALKOOH + r46*HOCH2OO + 2*r54*EO + .25*r33*CH4*O1D + + r34*CH3O2*NO + 2*r35*CH3O2*CH3O2 + r36*CH3O2*CH3O2 + .3*r38*CH3OOH*OH + r43*CH3OH*OH + + .5*r50*M*C2H4*OH + r51*C2H4*O3 + .7*r58*C2H5O2*CH3O2 + r66*CH3CO3*CH3O2 + .5*r67*CH3COOOH*OH + + r68*PAN*OH + .8*r71*GLYALD*OH + .54*r76*C3H6*O3 + r78*PO2*NO + r84*C3H7O2*CH3O2 + r87*RO2*NO + + .8*r89*RO2*CH3O2 + .5*r96*ENEO2*NO + .5*r101*M*MPAN*OH + .1*r103*ALKO2*NO + .6*r107*ISOP*O3 + + .55*r108*ISOPO2*NO + .6*r109*ISOPO2*NO3 + 1.2*r112*ISOPO2*CH3O2 + .6*r113*ISOPO2*CH3CO3 + + .072*r115*ISOPNO3*NO + .072*r116*ISOPNO3*NO3 + .008*r117*ISOPNO3*HO2 + .8*r119*MVK*O3 + + .7*r121*MACR*O3 + .25*r122*MACRO2*NO + .25*r124*MACRO2*NO3 + .88*r126*MACRO2*CH3O2 + + .25*r127*MACRO2*CH3CO3 + r129*MCO3*NO + r130*MCO3*NO3 + 2*r132*MCO3*CH3O2 + r133*MCO3*CH3CO3 + + 2*r134*MCO3*MCO3 + .7*r143*XO2*CH3O2 + - j13*CH2O - j14*CH2O - r39*NO3*CH2O - r40*OH*CH2O - r45*HO2*CH2O + d(CH3OH)/dt = r36*CH3O2*CH3O2 + .3*r58*C2H5O2*CH3O2 + .5*r89*RO2*CH3O2 + .25*r112*ISOPO2*CH3O2 + + .25*r126*MACRO2*CH3O2 + .3*r143*XO2*CH3O2 + - r43*OH*CH3OH + d(C2H5OH)/dt = .2*r58*C2H5O2*CH3O2 + .4*r59*C2H5O2*C2H5O2 + - r74*OH*C2H5OH + d(C2H4)/dt = - r50*M*OH*C2H4 - r51*O3*C2H4 + d(EO)/dt = r52*EO2*NO + - r53*O2*EO - r54*EO + d(EO2)/dt = .75*r50*M*C2H4*OH + - r52*NO*EO2 + d(CH3COOH)/dt = .25*r65*CH3CO3*HO2 + .1*r66*CH3CO3*CH3O2 + .25*r76*C3H6*O3 + .2*r107*ISOP*O3 + + .25*r131*MCO3*HO2 + - r73*OH*CH3COOH + d(GLYALD)/dt = r53*O2*EO + .53*r122*MACRO2*NO + .53*r124*MACRO2*NO3 + .26*r126*MACRO2*CH3O2 + + .53*r127*MACRO2*CH3CO3 + .25*r140*XO2*NO + .25*r141*XO2*NO3 + .1*r143*XO2*CH3O2 + + .25*r144*XO2*CH3CO3 + - j33*GLYALD - r71*OH*GLYALD + d(C2H6)/dt = - r55*OH*C2H6 + d(C2H5O2)/dt = j34*MEK + r55*C2H6*OH + .5*r60*C2H5OOH*OH + - r56*NO*C2H5O2 - r57*HO2*C2H5O2 - r58*CH3O2*C2H5O2 - 2*r59*C2H5O2*C2H5O2 + d(C2H5OOH)/dt = r57*C2H5O2*HO2 + - j24*C2H5OOH - r60*OH*C2H5OOH + d(CH3CHO)/dt = j17*POOH + j24*C2H5OOH + .4*j37*ALKOOH + j38*MEKOOH + r56*C2H5O2*NO + .8*r58*C2H5O2*CH3O2 + + 1.6*r59*C2H5O2*C2H5O2 + .5*r60*C2H5OOH*OH + r74*C2H5OH*OH + .5*r76*C3H6*O3 + r78*PO2*NO + + .27*r82*C3H7O2*NO + r96*ENEO2*NO + r98*MEKO2*NO + .4*r103*ALKO2*NO + .04*r119*MVK*O3 + - j16*CH3CHO - r61*OH*CH3CHO - r62*NO3*CH3CHO + d(CH3CO3)/dt = .6*j19*PAN + .67*j21*MACR + .67*j22*MACR + .3*j23*MVK + j26*ROOH + j27*CH3COCH3 + + j28*CH3COCHO + j32*HYAC + j34*MEK + .13*j35*BIGALD + j38*MEKOOH + r69*M*PAN + + r61*CH3CHO*OH + r62*CH3CHO*NO3 + .5*r67*CH3COOOH*OH + r87*RO2*NO + .3*r89*RO2*CH3O2 + + r92*CH3COCHO*OH + r93*CH3COCHO*NO3 + r98*MEKO2*NO + .53*r122*MACRO2*NO + .53*r124*MACRO2*NO3 + + .26*r126*MACRO2*CH3O2 + .53*r127*MACRO2*CH3CO3 + r129*MCO3*NO + r130*MCO3*NO3 + + r132*MCO3*CH3O2 + 2*r134*MCO3*MCO3 + - r63*NO*CH3CO3 - r64*M*NO2*CH3CO3 - r65*HO2*CH3CO3 - r66*CH3O2*CH3CO3 - 2*r70*CH3CO3*CH3CO3 + - r113*ISOPO2*CH3CO3 - r127*MACRO2*CH3CO3 - r144*XO2*CH3CO3 + d(CH3COOOH)/dt = .75*r65*CH3CO3*HO2 + .75*r131*MCO3*HO2 + - j18*CH3COOOH - r67*OH*CH3COOOH + d(C3H6)/dt = .7*j23*MVK + .07*r107*ISOP*O3 + - r75*M*OH*C3H6 - r76*O3*C3H6 - r77*NO3*C3H6 + d(C3H8)/dt = - r81*OH*C3H8 + d(C3H7O2)/dt = r81*C3H8*OH + r85*C3H7OOH*OH + - r82*NO*C3H7O2 - r83*HO2*C3H7O2 - r84*CH3O2*C3H7O2 + d(C3H7OOH)/dt = r83*C3H7O2*HO2 + - j25*C3H7OOH - r85*OH*C3H7OOH + d(PO2)/dt = r75*M*C3H6*OH + .5*r80*POOH*OH + - r78*NO*PO2 - r79*HO2*PO2 + d(POOH)/dt = r79*PO2*HO2 + - j17*POOH - r80*OH*POOH + d(CH3COCH3)/dt = .82*j25*C3H7OOH + .25*j37*ALKOOH + .1*j40*TERPOOH + .82*r82*C3H7O2*NO + .82*r84*C3H7O2*CH3O2 + + .5*r96*ENEO2*NO + .25*r103*ALKO2*NO + .1*r156*TERPO2*NO + - j27*CH3COCH3 - r86*OH*CH3COCH3 + d(RO2)/dt = r86*CH3COCH3*OH + r90*ROOH*OH + - r87*NO*RO2 - r88*HO2*RO2 - r89*CH3O2*RO2 + d(ROOH)/dt = r88*RO2*HO2 + - j26*ROOH - r90*OH*ROOH + d(BIGENE)/dt = - r95*OH*BIGENE + d(ENEO2)/dt = r95*BIGENE*OH + - r96*NO*ENEO2 + d(MEK)/dt = .8*j37*ALKOOH + .75*r103*ALKO2*NO + - j34*MEK - r97*OH*MEK + d(MEKO2)/dt = r97*MEK*OH + r100*MEKOOH*OH + - r98*NO*MEKO2 - r99*HO2*MEKO2 + d(MEKOOH)/dt = r99*MEKO2*HO2 + - j38*MEKOOH - r100*OH*MEKOOH + d(BIGALK)/dt = - r102*OH*BIGALK + d(ALKO2)/dt = r102*BIGALK*OH + r105*ALKOOH*OH + - r103*NO*ALKO2 - r104*HO2*ALKO2 + d(ALKOOH)/dt = r104*ALKO2*HO2 + - j37*ALKOOH - r105*OH*ALKOOH + d(ISOP)/dt = - r106*OH*ISOP - r107*O3*ISOP - r114*NO3*ISOP + d(ISOPO2)/dt = r106*ISOP*OH + .2*r111*ISOPOOH*OH + - r108*NO*ISOPO2 - r109*NO3*ISOPO2 - r110*HO2*ISOPO2 - r112*CH3O2*ISOPO2 - r113*CH3CO3*ISOPO2 + d(ISOPOOH)/dt = r110*ISOPO2*HO2 + - j31*ISOPOOH - r111*OH*ISOPOOH + d(MVK)/dt = .402*j31*ISOPOOH + j40*TERPOOH + .2*r107*ISOP*O3 + .32*r108*ISOPO2*NO + .35*r109*ISOPO2*NO3 + + .26*r112*ISOPO2*CH3O2 + .35*r113*ISOPO2*CH3CO3 + .039*r115*ISOPNO3*NO + .039*r116*ISOPNO3*NO3 + + .039*r117*ISOPNO3*HO2 + r154*C10H16*O3 + r156*TERPO2*NO + - j23*MVK - r118*OH*MVK - r119*O3*MVK + d(MACR)/dt = .288*j31*ISOPOOH + j40*TERPOOH + .4*r107*ISOP*O3 + .23*r108*ISOPO2*NO + .25*r109*ISOPO2*NO3 + + .19*r112*ISOPO2*CH3O2 + .25*r113*ISOPO2*CH3CO3 + .167*r115*ISOPNO3*NO + .167*r116*ISOPNO3*NO3 + + .167*r117*ISOPNO3*HO2 + r154*C10H16*O3 + r156*TERPO2*NO + - j21*MACR - j22*MACR - r120*OH*MACR - r121*O3*MACR + d(MACRO2)/dt = r118*MVK*OH + .5*r120*MACR*OH + .2*r128*MACROOH*OH + - r122*NO*MACRO2 - r123*NO*MACRO2 - r124*NO3*MACRO2 - r125*HO2*MACRO2 - r126*CH3O2*MACRO2 + - r127*CH3CO3*MACRO2 + d(MACROOH)/dt = r125*MACRO2*HO2 + - r128*OH*MACROOH + d(MCO3)/dt = j20*MPAN + .33*j21*MACR + .33*j22*MACR + r136*M*MPAN + .2*r107*ISOP*O3 + .5*r120*MACR*OH + + .5*r128*MACROOH*OH + - r129*NO*MCO3 - r130*NO3*MCO3 - r131*HO2*MCO3 - r132*CH3O2*MCO3 - r133*CH3CO3*MCO3 + - 2*r134*MCO3*MCO3 - r135*M*NO2*MCO3 + d(HYDRALD)/dt = .37*r108*ISOPO2*NO + .4*r109*ISOPO2*NO3 + .3*r112*ISOPO2*CH3O2 + .4*r113*ISOPO2*CH3CO3 + + r137*ONITR*OH + r138*ONITR*NO3 + - r139*OH*HYDRALD + d(HYAC)/dt = .5*r80*POOH*OH + .2*r89*RO2*CH3O2 + .5*r101*M*MPAN*OH + .22*r122*MACRO2*NO + .22*r124*MACRO2*NO3 + + .23*r126*MACRO2*CH3O2 + .22*r127*MACRO2*CH3CO3 + .25*r140*XO2*NO + .25*r141*XO2*NO3 + + .1*r143*XO2*CH3O2 + .25*r144*XO2*CH3CO3 + - j32*HYAC - r94*OH*HYAC + d(CH3COCHO)/dt = .18*j35*BIGALD + .45*j39*TOLOOH + .5*r89*RO2*CH3O2 + r91*ONIT*OH + r94*HYAC*OH + + .95*r119*MVK*O3 + .8*r121*MACR*O3 + .25*r122*MACRO2*NO + .25*r124*MACRO2*NO3 + + .24*r126*MACRO2*CH3O2 + .25*r127*MACRO2*CH3CO3 + .25*r140*XO2*NO + .25*r141*XO2*NO3 + + .1*r143*XO2*CH3O2 + .25*r144*XO2*CH3CO3 + .45*r150*TOLO2*NO + - j28*CH3COCHO - r92*OH*CH3COCHO - r93*NO3*CH3COCHO + d(XO2)/dt = .8*r111*ISOPOOH*OH + r139*HYDRALD*OH + r145*XOOH*OH + - r140*NO*XO2 - r141*NO3*XO2 - r142*HO2*XO2 - r143*CH3O2*XO2 - r144*CH3CO3*XO2 + d(XOOH)/dt = r142*XO2*HO2 + - j29*XOOH - r145*OH*XOOH - r146*OH*XOOH + d(C10H16)/dt = - r153*OH*C10H16 - r154*O3*C10H16 - r155*NO3*C10H16 + d(TERPO2)/dt = r153*C10H16*OH + r155*C10H16*NO3 + r158*TERPOOH*OH + - r156*NO*TERPO2 - r157*HO2*TERPO2 + d(TERPOOH)/dt = r157*TERPO2*HO2 + - j40*TERPOOH - r158*OH*TERPOOH + d(TOLUENE)/dt = - r147*OH*TOLUENE + d(CRESOL)/dt = .25*r147*TOLUENE*OH + - r148*OH*CRESOL + d(TOLO2)/dt = .7*r147*TOLUENE*OH + r152*TOLOOH*OH + - r150*NO*TOLO2 - r151*HO2*TOLO2 + d(TOLOOH)/dt = r151*TOLO2*HO2 + - j39*TOLOOH - r152*OH*TOLOOH + d(XOH)/dt = r148*CRESOL*OH + - r149*NO2*XOH + d(BIGALD)/dt = .9*j39*TOLOOH + .7*r149*XOH*NO2 + .9*r150*TOLO2*NO + - j35*BIGALD + d(GLYOXAL)/dt = .13*j35*BIGALD + .45*j39*TOLOOH + .65*r49*M*C2H2*OH + .2*r71*GLYALD*OH + .25*r140*XO2*NO + + .25*r141*XO2*NO3 + .1*r143*XO2*CH3O2 + .45*r150*TOLO2*NO + - j36*GLYOXAL - r72*OH*GLYOXAL + d(PAN)/dt = r64*M*CH3CO3*NO2 + - j19*PAN - r69*M*PAN - r68*OH*PAN + d(ONIT)/dt = r77*C3H6*NO3 + .1*r103*ALKO2*NO + - r91*OH*ONIT + d(MPAN)/dt = r135*M*MCO3*NO2 + - j20*MPAN - r136*M*MPAN - r101*M*OH*MPAN + d(ISOPNO3)/dt = r114*ISOP*NO3 + - r115*NO*ISOPNO3 - r116*NO3*ISOPNO3 - r117*HO2*ISOPNO3 + d(ONITR)/dt = .08*r108*ISOPO2*NO + .794*r115*ISOPNO3*NO + .794*r116*ISOPNO3*NO3 + .794*r117*ISOPNO3*HO2 + + .8*r123*MACRO2*NO + - j30*ONITR - r137*OH*ONITR - r138*NO3*ONITR + d(CB1)/dt = - r163*CB1 + d(CB2)/dt = r163*CB1 + d(OC1)/dt = - r169*OC1 + d(OC2)/dt = r169*OC1 + d(SOA)/dt = 0 + d(SO2)/dt = r165*DMS*OH + .5*r166*DMS*OH + r167*DMS*NO3 + - r164*OH*SO2 + d(DMS)/dt = - r165*OH*DMS - r166*OH*DMS - r167*NO3*DMS + d(SO4)/dt = r164*SO2*OH + d(NH3)/dt = - r168*OH*NH3 + d(NH4)/dt = 0 + d(NH4NO3)/dt = 0 + d(SSLT01)/dt = 0 + d(SSLT02)/dt = 0 + d(SSLT03)/dt = 0 + d(SSLT04)/dt = 0 + d(DST01)/dt = 0 + d(DST02)/dt = 0 + d(DST03)/dt = 0 + d(DST04)/dt = 0 + d(Rn)/dt = - r159*Rn + d(Pb)/dt = r159*Rn + d(HCN)/dt = - r171*M*OH*HCN + d(CH3CN)/dt = - r172*OH*CH3CN + d(C2H2)/dt = - r49*M*OH*C2H2 + d(HCOOH)/dt = r47*HOCH2OO*NO + r48*HOCH2OO*HO2 + .35*r49*M*C2H2*OH + .5*r51*C2H4*O3 + - r44*OH*HCOOH + d(HOCH2OO)/dt = r45*CH2O*HO2 + - r46*HOCH2OO - r47*NO*HOCH2OO - r48*HO2*HOCH2OO diff --git a/src/chemistry/pp_trop_mozart/chem_mech.in b/src/chemistry/pp_trop_mozart/chem_mech.in new file mode 100644 index 0000000000..81da7968cb --- /dev/null +++ b/src/chemistry/pp_trop_mozart/chem_mech.in @@ -0,0 +1,355 @@ +* MOZART-4 mechanism (as in Emmons et al., 2010) +* plus: HCN, CH3CN, C2H2, HCOOH, HOCH2OO +* for use with photolysis lookup table +* Nov 8, 2010: RO2+CH3O2 rate corrected +* April 26, 2011: sync 133spc to trop_mozart and JPL06 +* March 15, 2012: correct HCN+OH and MPAN+OH (add +M) + +SPECIES + + Solution + O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2 + CH4, CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH + CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH + BIGENE -> C4H8, ENEO2 -> C4H9O3 + MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3 + BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2 + ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2 + MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO + MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH + MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH + CH3COCHO, XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO + C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3 + TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5 + XOH -> C7H10O6, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2 + PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2 + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH + CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12 + SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3 + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + Rn, Pb + HCN, CH3CN, C2H2, HCOOH, HOCH2OO + End Solution + + Fixed + M, N2, O2, H2O + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + CH4, N2O, CO, Rn, Pb, H2, HCN, CH3CN + End Explicit + Implicit + O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2 + CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO, EO2, CH3COOH, GLYALD + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH + BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH + ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3 + HYDRALD, HYAC, CH3COCHO, XO2, XOOH + C10H16, TERPO2, TERPOOH + TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL + PAN, ONIT, MPAN, ISOPNO3, ONITR + SO2, DMS, SO4, NH3, NH4, NH4NO3, SOA + CB1, CB2, OC1, OC2 + C2H2, HCOOH, HOCH2OO + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis + [jo2->,jo2_b] O2 + hv -> 2*O + [jo1d->,jo3_a] O3 + hv -> O1D + O2 + [jo3p->,jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno2] NO2 + hv -> NO + O + [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH + [jch2o_a] CH2O + hv -> CO + 2 * HO2 + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o2] H2O2 + hv -> 2*OH + [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 + [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH + [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 + [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 + [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 + [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmvk] MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 + [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH + [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> .82 * CH3COCH3 + OH + HO2 + [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH + [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 + [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 + [jxooh->,jch3ooh] XOOH + hv -> OH + [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O + [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2 + [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O + [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O + [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 + [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO + [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 + [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH + [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO + [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR + End Photolysis + + Reactions + [usr_O_O2] O + O2 + M -> O3 + M + O + O3 -> 2*O2 ; 8e-12, -2060 + [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115 + [o1d_o2] O1D + O2 -> O + O2 ; 3.30e-11, 55. + [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10 + H2 + O1D -> HO2 + OH ; 1.1e-10 + H2 + OH -> H2O + HO2 ; 2.8e-12, -1800 + O + OH -> HO2 + O2 ; 2.2e-11, 120 + HO2 + O -> OH + O2 ; 3e-11, 200 + [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 + [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490 + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + OH + HO2 -> H2O + O2 ; 4.8e-11, 250 + OH + OH -> H2O + O ; 1.8e-12 + OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6 + N2O + O1D -> N2 + O2 ; 4.9e-11 + N2O + O1D -> 2*NO ; 6.7e-11 + [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250 + NO + O3 -> NO2 + O2 ; 3e-12, -1500 + NO2 + O -> NO + O2 ; 5.1e-12, 210 + NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 + NO3 + HO2 -> OH + NO2 ; 3.5e-12 + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + NO3 + NO -> 2*NO2 ; 1.5e-11, 170 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.0e-31,3.4, 2.9e-12,1.1, .6 + HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 + CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10 + [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 + CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424 + CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706 + CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 + CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200 + CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058 + CH2O + OH -> CO + H2O +HO2 ; 9.e-12 + CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [usr_CO_OH_b] CO + OH -> CO2 + HO2 + CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620 + HCOOH + OH -> HO2 + CO2 + H2O ; 4.5e-13 + CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 + HOCH2OO -> CH2O + HO2 ; 2.4e12, -7000 + HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 + HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +*C2 + C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.5e-30,0,8.3e-13,-2,.6 + + .35*CO + M + [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6 + [ox_l6] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630 + [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180 + EO + O2 -> GLYALD + HO2 ; 1.e-14 + EO -> 2 * CH2O + HO2 ; 1.6e11,-4150 + C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070 + [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 + C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 + C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13 + + .3 * CH3OH + .2 * C2H5OH + C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14 + C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200 + CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270 + CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 + [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 + [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6 + CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040 + CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500 + CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12 + PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14 + [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M + CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500 + GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11 + GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11 + CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13 + C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230 + +*C3 + [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5 + [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900 + + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + C3H6 + NO3 -> ONIT ; 4.6e-13,-1156 + [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 + PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 + POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200 + C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -665 + [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180 + C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 + C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40 + C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 + [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O + [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 + RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700 + RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 7.1e-13, 500 + + .5*CH3COCHO + .5*CH3OH + ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 + ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13 + CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830 + CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 + HYAC + OH -> CH3COCHO + HO2 ; 3.e-12 + +*C4 + BIGENE + OH -> ENEO2 ; 5.4e-11 + [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180 + MEK + OH -> MEKO2 ; 2.3e-12, -170 + [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 + MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700 + MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 + MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 ; 8.e-27,3.5,3.e-11,0.,.5 + + .5*CO2 + M + +*C5 + [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12 + [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180 + + .75*MEK + .9*NO2 + .1*ONIT + ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 + ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 + ISOP + OH -> ISOPO2 ; 2.54e-11, 410 + [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000 + + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3 + + .2 * MCO3 + .2 * CH3COOH + [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 4.4e-12, 180 + + .23 * MACR + .32 * MVK + .37 * HYDRALD + ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12 + + .35 * MVK + .4 * HYDRALD + ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700 + ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200 + ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400 + + .19 * MACR + .26 * MVK + .3 * HYDRALD + ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11 + + .25 * MACR + .35 * MVK + .4 * HYDRALD + ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446 + ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360 + + .039 * MVK + .794 * ONITR + ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12 + + .794 * ONITR + .794 * HO2 + ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700 + + .167 * MACR + .039 * MVK + .794 * ONITR + MVK + OH -> MACRO2 ; 4.13e-12, 452 + [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521 + + .06 * HO2 + .05 * CO + .04 * CH3CHO + MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175 + [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500 + + .7 * CH2O + .215 * OH + [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360 + + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD + + .22 * HYAC + .22 * CO + MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360 + MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12 + + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3 + MACRO2 + HO2 -> MACROOH ; 8.e-13, 700 + MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400 + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11 + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200 + [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360 + MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12 + MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040 + MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500 + MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 + MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530 + [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M + [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M + ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11 + ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860 + HYDRALD + OH -> XO2 ; 1.86e-11,175 + [ox_p11] XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL ; 2.7e-12, 360. + + .25*HYAC + .25*CH3COCHO + .25*GLYALD + XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12 + + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD + XO2 + HO2 -> XOOH ; 8.e-13, 700 + XO2 + CH3O2 -> .3 * CH3OH + 0.8*HO2 + .7 * CH2O ; 5.00e-13, 400. + + .2 * CO + .1 * HYAC + + .1*GLYOXAL + .1 * CH3COCHO + .1 * GLYALD + XO2 + CH3CO3 -> 0.5*CO + CH3O2 + HO2 + CO2 + .25 GLYOXAL ; 1.30e-12, 640. + + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD + XOOH + OH -> H2O + XO2 ; 1.90e-12, 190 + [usr_XOOH_OH] XOOH + OH -> H2O + OH + +*C7 + [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352 + CRESOL + OH -> XOH ; 3.e-12 + XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11 + [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180 + + .9*NO2 + .9*HO2 + TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 + TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 + +*C10 + [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444 + [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732 + [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490 + [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180 + TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 + TERPOOH + OH -> TERPO2 ; 3.8e-12, 200 + + Rn -> Pb ; 2.1e-6 +*het/aerosol rxns + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + CB1 -> CB2 ; 7.1e-6 + [usr_SO2_OH] SO2 + OH -> SO4 + DMS + OH -> SO2 ; 9.6e-12,-234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + NH3 + OH -> H2O ; 1.7e-12, -710. + OC1 -> OC2 ; 7.1e-6 + [usr_HO2_aer] HO2 -> 0.5*H2O2 +*cyanides + HCN + OH + M -> HO2 + M ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8 + CH3CN + OH -> HO2 ;7.8e-13, -1050 + End Reactions + + Ext Forcing + NO <- dataset + CO <- dataset + SO2 <- dataset + SO4 <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_trop_mozart/chem_mods.F90 b/src/chemistry/pp_trop_mozart/chem_mods.F90 new file mode 100644 index 0000000000..9b41d9c1cb --- /dev/null +++ b/src/chemistry/pp_trop_mozart/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 40, & ! number of photolysis reactions + rxntot = 212, & ! number of total reactions + gascnt = 172, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 103, & ! number of "gas phase" species + nfs = 4, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 824, & ! number of non-zero matrix entries + extcnt = 4, & ! number of species with external forcing + clscnt1 = 8, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 95, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 95, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_trop_mozart/m_rxt_id.F90 b/src/chemistry/pp_trop_mozart/m_rxt_id.F90 new file mode 100644 index 0000000000..5f10807da5 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/m_rxt_id.F90 @@ -0,0 +1,215 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2 = 1 + integer, parameter :: rid_jo1d = 2 + integer, parameter :: rid_jo3p = 3 + integer, parameter :: rid_jn2o = 4 + integer, parameter :: rid_jno2 = 5 + integer, parameter :: rid_jn2o5 = 6 + integer, parameter :: rid_jhno3 = 7 + integer, parameter :: rid_jno3_a = 8 + integer, parameter :: rid_jno3_b = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jch3ooh = 12 + integer, parameter :: rid_jch2o_a = 13 + integer, parameter :: rid_jch2o_b = 14 + integer, parameter :: rid_jh2o2 = 15 + integer, parameter :: rid_jch3cho = 16 + integer, parameter :: rid_jpooh = 17 + integer, parameter :: rid_jch3co3h = 18 + integer, parameter :: rid_jpan = 19 + integer, parameter :: rid_jmpan = 20 + integer, parameter :: rid_jmacr_a = 21 + integer, parameter :: rid_jmacr_b = 22 + integer, parameter :: rid_jmvk = 23 + integer, parameter :: rid_jc2h5ooh = 24 + integer, parameter :: rid_jc3h7ooh = 25 + integer, parameter :: rid_jrooh = 26 + integer, parameter :: rid_jacet = 27 + integer, parameter :: rid_jmgly = 28 + integer, parameter :: rid_jxooh = 29 + integer, parameter :: rid_jonitr = 30 + integer, parameter :: rid_jisopooh = 31 + integer, parameter :: rid_jhyac = 32 + integer, parameter :: rid_jglyald = 33 + integer, parameter :: rid_jmek = 34 + integer, parameter :: rid_jbigald = 35 + integer, parameter :: rid_jglyoxal = 36 + integer, parameter :: rid_jalkooh = 37 + integer, parameter :: rid_jmekooh = 38 + integer, parameter :: rid_jtolooh = 39 + integer, parameter :: rid_jterpooh = 40 + integer, parameter :: rid_usr_O_O2 = 41 + integer, parameter :: rid_o1d_n2 = 43 + integer, parameter :: rid_o1d_o2 = 44 + integer, parameter :: rid_ox_l1 = 45 + integer, parameter :: rid_ox_l2 = 50 + integer, parameter :: rid_ox_l3 = 51 + integer, parameter :: rid_usr_HO2_HO2 = 52 + integer, parameter :: rid_ox_p1 = 59 + integer, parameter :: rid_tag_NO2_NO3 = 64 + integer, parameter :: rid_usr_N2O5_M = 65 + integer, parameter :: rid_tag_NO2_OH = 66 + integer, parameter :: rid_usr_HNO3_OH = 67 + integer, parameter :: rid_tag_NO2_HO2 = 69 + integer, parameter :: rid_usr_HO2NO2_M = 71 + integer, parameter :: rid_ox_p2 = 74 + integer, parameter :: rid_usr_CO_OH_b = 82 + integer, parameter :: rid_tag_C2H4_OH = 90 + integer, parameter :: rid_ox_l6 = 91 + integer, parameter :: rid_ox_p16 = 92 + integer, parameter :: rid_ox_p5 = 96 + integer, parameter :: rid_ox_p4 = 103 + integer, parameter :: rid_tag_CH3CO3_NO2 = 104 + integer, parameter :: rid_usr_PAN_M = 109 + integer, parameter :: rid_tag_C3H6_OH = 115 + integer, parameter :: rid_ox_l4 = 116 + integer, parameter :: rid_ox_p3 = 118 + integer, parameter :: rid_ox_p9 = 122 + integer, parameter :: rid_usr_CH3COCH3_OH = 126 + integer, parameter :: rid_ox_p10 = 127 + integer, parameter :: rid_ox_p15 = 136 + integer, parameter :: rid_ox_p17 = 138 + integer, parameter :: rid_soa5 = 142 + integer, parameter :: rid_ox_p14 = 143 + integer, parameter :: rid_ox_l5 = 147 + integer, parameter :: rid_ox_p6 = 148 + integer, parameter :: rid_ox_l7 = 159 + integer, parameter :: rid_ox_l8 = 161 + integer, parameter :: rid_ox_p7 = 162 + integer, parameter :: rid_ox_p8 = 169 + integer, parameter :: rid_usr_MCO3_NO2 = 175 + integer, parameter :: rid_usr_MPAN_M = 176 + integer, parameter :: rid_ox_p11 = 180 + integer, parameter :: rid_usr_XOOH_OH = 186 + integer, parameter :: rid_soa4 = 187 + integer, parameter :: rid_ox_p12 = 190 + integer, parameter :: rid_soa2 = 193 + integer, parameter :: rid_soa1 = 194 + integer, parameter :: rid_soa3 = 195 + integer, parameter :: rid_ox_p13 = 196 + integer, parameter :: rid_usr_N2O5_aer = 200 + integer, parameter :: rid_usr_NO3_aer = 201 + integer, parameter :: rid_usr_NO2_aer = 202 + integer, parameter :: rid_usr_SO2_OH = 204 + integer, parameter :: rid_usr_DMS_OH = 206 + integer, parameter :: rid_usr_HO2_aer = 210 + integer, parameter :: rid_r0042 = 42 + integer, parameter :: rid_r0046 = 46 + integer, parameter :: rid_r0047 = 47 + integer, parameter :: rid_r0048 = 48 + integer, parameter :: rid_r0049 = 49 + integer, parameter :: rid_r0053 = 53 + integer, parameter :: rid_r0054 = 54 + integer, parameter :: rid_r0055 = 55 + integer, parameter :: rid_r0056 = 56 + integer, parameter :: rid_r0057 = 57 + integer, parameter :: rid_r0058 = 58 + integer, parameter :: rid_r0060 = 60 + integer, parameter :: rid_r0061 = 61 + integer, parameter :: rid_r0062 = 62 + integer, parameter :: rid_r0063 = 63 + integer, parameter :: rid_r0068 = 68 + integer, parameter :: rid_r0070 = 70 + integer, parameter :: rid_r0072 = 72 + integer, parameter :: rid_r0073 = 73 + integer, parameter :: rid_r0075 = 75 + integer, parameter :: rid_r0076 = 76 + integer, parameter :: rid_r0077 = 77 + integer, parameter :: rid_r0078 = 78 + integer, parameter :: rid_r0079 = 79 + integer, parameter :: rid_r0080 = 80 + integer, parameter :: rid_r0081 = 81 + integer, parameter :: rid_r0083 = 83 + integer, parameter :: rid_r0084 = 84 + integer, parameter :: rid_r0085 = 85 + integer, parameter :: rid_r0086 = 86 + integer, parameter :: rid_r0087 = 87 + integer, parameter :: rid_r0088 = 88 + integer, parameter :: rid_r0089 = 89 + integer, parameter :: rid_r0093 = 93 + integer, parameter :: rid_r0094 = 94 + integer, parameter :: rid_r0095 = 95 + integer, parameter :: rid_r0097 = 97 + integer, parameter :: rid_r0098 = 98 + integer, parameter :: rid_r0099 = 99 + integer, parameter :: rid_r0100 = 100 + integer, parameter :: rid_r0101 = 101 + integer, parameter :: rid_r0102 = 102 + integer, parameter :: rid_r0105 = 105 + integer, parameter :: rid_r0106 = 106 + integer, parameter :: rid_r0107 = 107 + integer, parameter :: rid_r0108 = 108 + integer, parameter :: rid_r0110 = 110 + integer, parameter :: rid_r0111 = 111 + integer, parameter :: rid_r0112 = 112 + integer, parameter :: rid_r0113 = 113 + integer, parameter :: rid_r0114 = 114 + integer, parameter :: rid_r0117 = 117 + integer, parameter :: rid_r0119 = 119 + integer, parameter :: rid_r0120 = 120 + integer, parameter :: rid_r0121 = 121 + integer, parameter :: rid_r0123 = 123 + integer, parameter :: rid_r0124 = 124 + integer, parameter :: rid_r0125 = 125 + integer, parameter :: rid_r0128 = 128 + integer, parameter :: rid_r0129 = 129 + integer, parameter :: rid_r0130 = 130 + integer, parameter :: rid_r0131 = 131 + integer, parameter :: rid_r0132 = 132 + integer, parameter :: rid_r0133 = 133 + integer, parameter :: rid_r0134 = 134 + integer, parameter :: rid_r0135 = 135 + integer, parameter :: rid_r0137 = 137 + integer, parameter :: rid_r0139 = 139 + integer, parameter :: rid_r0140 = 140 + integer, parameter :: rid_r0141 = 141 + integer, parameter :: rid_r0144 = 144 + integer, parameter :: rid_r0145 = 145 + integer, parameter :: rid_r0146 = 146 + integer, parameter :: rid_r0149 = 149 + integer, parameter :: rid_r0150 = 150 + integer, parameter :: rid_r0151 = 151 + integer, parameter :: rid_r0152 = 152 + integer, parameter :: rid_r0153 = 153 + integer, parameter :: rid_r0154 = 154 + integer, parameter :: rid_r0155 = 155 + integer, parameter :: rid_r0156 = 156 + integer, parameter :: rid_r0157 = 157 + integer, parameter :: rid_r0158 = 158 + integer, parameter :: rid_r0160 = 160 + integer, parameter :: rid_r0163 = 163 + integer, parameter :: rid_r0164 = 164 + integer, parameter :: rid_r0165 = 165 + integer, parameter :: rid_r0166 = 166 + integer, parameter :: rid_r0167 = 167 + integer, parameter :: rid_r0168 = 168 + integer, parameter :: rid_r0170 = 170 + integer, parameter :: rid_r0171 = 171 + integer, parameter :: rid_r0172 = 172 + integer, parameter :: rid_r0173 = 173 + integer, parameter :: rid_r0174 = 174 + integer, parameter :: rid_r0177 = 177 + integer, parameter :: rid_r0178 = 178 + integer, parameter :: rid_r0179 = 179 + integer, parameter :: rid_r0181 = 181 + integer, parameter :: rid_r0182 = 182 + integer, parameter :: rid_r0183 = 183 + integer, parameter :: rid_r0184 = 184 + integer, parameter :: rid_r0185 = 185 + integer, parameter :: rid_r0188 = 188 + integer, parameter :: rid_r0189 = 189 + integer, parameter :: rid_r0191 = 191 + integer, parameter :: rid_r0192 = 192 + integer, parameter :: rid_r0197 = 197 + integer, parameter :: rid_r0198 = 198 + integer, parameter :: rid_r0199 = 199 + integer, parameter :: rid_r0203 = 203 + integer, parameter :: rid_r0205 = 205 + integer, parameter :: rid_r0207 = 207 + integer, parameter :: rid_r0208 = 208 + integer, parameter :: rid_r0209 = 209 + integer, parameter :: rid_r0211 = 211 + integer, parameter :: rid_r0212 = 212 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_mozart/m_spc_id.F90 b/src/chemistry/pp_trop_mozart/m_spc_id.F90 new file mode 100644 index 0000000000..bc58f03184 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/m_spc_id.F90 @@ -0,0 +1,106 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O1D = 3 + integer, parameter :: id_N2O = 4 + integer, parameter :: id_NO = 5 + integer, parameter :: id_NO2 = 6 + integer, parameter :: id_NO3 = 7 + integer, parameter :: id_HNO3 = 8 + integer, parameter :: id_HO2NO2 = 9 + integer, parameter :: id_N2O5 = 10 + integer, parameter :: id_H2 = 11 + integer, parameter :: id_OH = 12 + integer, parameter :: id_HO2 = 13 + integer, parameter :: id_H2O2 = 14 + integer, parameter :: id_CH4 = 15 + integer, parameter :: id_CO = 16 + integer, parameter :: id_CH3O2 = 17 + integer, parameter :: id_CH3OOH = 18 + integer, parameter :: id_CH2O = 19 + integer, parameter :: id_CH3OH = 20 + integer, parameter :: id_C2H5OH = 21 + integer, parameter :: id_C2H4 = 22 + integer, parameter :: id_EO = 23 + integer, parameter :: id_EO2 = 24 + integer, parameter :: id_CH3COOH = 25 + integer, parameter :: id_GLYALD = 26 + integer, parameter :: id_C2H6 = 27 + integer, parameter :: id_C2H5O2 = 28 + integer, parameter :: id_C2H5OOH = 29 + integer, parameter :: id_CH3CHO = 30 + integer, parameter :: id_CH3CO3 = 31 + integer, parameter :: id_CH3COOOH = 32 + integer, parameter :: id_C3H6 = 33 + integer, parameter :: id_C3H8 = 34 + integer, parameter :: id_C3H7O2 = 35 + integer, parameter :: id_C3H7OOH = 36 + integer, parameter :: id_PO2 = 37 + integer, parameter :: id_POOH = 38 + integer, parameter :: id_CH3COCH3 = 39 + integer, parameter :: id_RO2 = 40 + integer, parameter :: id_ROOH = 41 + integer, parameter :: id_BIGENE = 42 + integer, parameter :: id_ENEO2 = 43 + integer, parameter :: id_MEK = 44 + integer, parameter :: id_MEKO2 = 45 + integer, parameter :: id_MEKOOH = 46 + integer, parameter :: id_BIGALK = 47 + integer, parameter :: id_ALKO2 = 48 + integer, parameter :: id_ALKOOH = 49 + integer, parameter :: id_ISOP = 50 + integer, parameter :: id_ISOPO2 = 51 + integer, parameter :: id_ISOPOOH = 52 + integer, parameter :: id_MVK = 53 + integer, parameter :: id_MACR = 54 + integer, parameter :: id_MACRO2 = 55 + integer, parameter :: id_MACROOH = 56 + integer, parameter :: id_MCO3 = 57 + integer, parameter :: id_HYDRALD = 58 + integer, parameter :: id_HYAC = 59 + integer, parameter :: id_CH3COCHO = 60 + integer, parameter :: id_XO2 = 61 + integer, parameter :: id_XOOH = 62 + integer, parameter :: id_C10H16 = 63 + integer, parameter :: id_TERPO2 = 64 + integer, parameter :: id_TERPOOH = 65 + integer, parameter :: id_TOLUENE = 66 + integer, parameter :: id_CRESOL = 67 + integer, parameter :: id_TOLO2 = 68 + integer, parameter :: id_TOLOOH = 69 + integer, parameter :: id_XOH = 70 + integer, parameter :: id_BIGALD = 71 + integer, parameter :: id_GLYOXAL = 72 + integer, parameter :: id_PAN = 73 + integer, parameter :: id_ONIT = 74 + integer, parameter :: id_MPAN = 75 + integer, parameter :: id_ISOPNO3 = 76 + integer, parameter :: id_ONITR = 77 + integer, parameter :: id_CB1 = 78 + integer, parameter :: id_CB2 = 79 + integer, parameter :: id_OC1 = 80 + integer, parameter :: id_OC2 = 81 + integer, parameter :: id_SOA = 82 + integer, parameter :: id_SO2 = 83 + integer, parameter :: id_DMS = 84 + integer, parameter :: id_SO4 = 85 + integer, parameter :: id_NH3 = 86 + integer, parameter :: id_NH4 = 87 + integer, parameter :: id_NH4NO3 = 88 + integer, parameter :: id_SSLT01 = 89 + integer, parameter :: id_SSLT02 = 90 + integer, parameter :: id_SSLT03 = 91 + integer, parameter :: id_SSLT04 = 92 + integer, parameter :: id_DST01 = 93 + integer, parameter :: id_DST02 = 94 + integer, parameter :: id_DST03 = 95 + integer, parameter :: id_DST04 = 96 + integer, parameter :: id_Rn = 97 + integer, parameter :: id_Pb = 98 + integer, parameter :: id_HCN = 99 + integer, parameter :: id_CH3CN = 100 + integer, parameter :: id_C2H2 = 101 + integer, parameter :: id_HCOOH = 102 + integer, parameter :: id_HOCH2OO = 103 + end module m_spc_id diff --git a/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 b/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 new file mode 100644 index 0000000000..e92846d77b --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 @@ -0,0 +1,192 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 43) = rate(:,:, 43) * inv(:,:, 2) + rate(:,:, 44) = rate(:,:, 44) * inv(:,:, 3) + rate(:,:, 45) = rate(:,:, 45) * inv(:,:, 4) + rate(:,:, 56) = rate(:,:, 56) * inv(:,:, 1) + rate(:,:, 64) = rate(:,:, 64) * inv(:,:, 1) + rate(:,:, 65) = rate(:,:, 65) * inv(:,:, 1) + rate(:,:, 66) = rate(:,:, 66) * inv(:,:, 1) + rate(:,:, 69) = rate(:,:, 69) * inv(:,:, 1) + rate(:,:, 71) = rate(:,:, 71) * inv(:,:, 1) + rate(:,:, 81) = rate(:,:, 81) * inv(:,:, 1) + rate(:,:, 89) = rate(:,:, 89) * inv(:,:, 1) + rate(:,:, 90) = rate(:,:, 90) * inv(:,:, 1) + rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 3) + rate(:,:,104) = rate(:,:,104) * inv(:,:, 1) + rate(:,:,109) = rate(:,:,109) * inv(:,:, 1) + rate(:,:,115) = rate(:,:,115) * inv(:,:, 1) + rate(:,:,141) = rate(:,:,141) * inv(:,:, 1) + rate(:,:,175) = rate(:,:,175) * inv(:,:, 1) + rate(:,:,176) = rate(:,:,176) * inv(:,:, 1) + rate(:,:,211) = rate(:,:,211) * inv(:,:, 1) + rate(:,:, 41) = rate(:,:, 41) * inv(:,:, 3) * inv(:,:, 1) + rate(:,:, 42) = rate(:,:, 42) * m(:,:) + rate(:,:, 46) = rate(:,:, 46) * m(:,:) + rate(:,:, 47) = rate(:,:, 47) * m(:,:) + rate(:,:, 48) = rate(:,:, 48) * m(:,:) + rate(:,:, 49) = rate(:,:, 49) * m(:,:) + rate(:,:, 50) = rate(:,:, 50) * m(:,:) + rate(:,:, 51) = rate(:,:, 51) * m(:,:) + rate(:,:, 52) = rate(:,:, 52) * m(:,:) + rate(:,:, 53) = rate(:,:, 53) * m(:,:) + rate(:,:, 54) = rate(:,:, 54) * m(:,:) + rate(:,:, 55) = rate(:,:, 55) * m(:,:) + rate(:,:, 56) = rate(:,:, 56) * m(:,:) + rate(:,:, 57) = rate(:,:, 57) * m(:,:) + rate(:,:, 58) = rate(:,:, 58) * m(:,:) + rate(:,:, 59) = rate(:,:, 59) * m(:,:) + rate(:,:, 60) = rate(:,:, 60) * m(:,:) + rate(:,:, 61) = rate(:,:, 61) * m(:,:) + rate(:,:, 62) = rate(:,:, 62) * m(:,:) + rate(:,:, 63) = rate(:,:, 63) * m(:,:) + rate(:,:, 64) = rate(:,:, 64) * m(:,:) + rate(:,:, 66) = rate(:,:, 66) * m(:,:) + rate(:,:, 67) = rate(:,:, 67) * m(:,:) + rate(:,:, 68) = rate(:,:, 68) * m(:,:) + rate(:,:, 69) = rate(:,:, 69) * m(:,:) + rate(:,:, 70) = rate(:,:, 70) * m(:,:) + rate(:,:, 72) = rate(:,:, 72) * m(:,:) + rate(:,:, 73) = rate(:,:, 73) * m(:,:) + rate(:,:, 74) = rate(:,:, 74) * m(:,:) + rate(:,:, 75) = rate(:,:, 75) * m(:,:) + rate(:,:, 76) = rate(:,:, 76) * m(:,:) + rate(:,:, 77) = rate(:,:, 77) * m(:,:) + rate(:,:, 78) = rate(:,:, 78) * m(:,:) + rate(:,:, 79) = rate(:,:, 79) * m(:,:) + rate(:,:, 80) = rate(:,:, 80) * m(:,:) + rate(:,:, 81) = rate(:,:, 81) * m(:,:) + rate(:,:, 82) = rate(:,:, 82) * m(:,:) + rate(:,:, 83) = rate(:,:, 83) * m(:,:) + rate(:,:, 84) = rate(:,:, 84) * m(:,:) + rate(:,:, 85) = rate(:,:, 85) * m(:,:) + rate(:,:, 87) = rate(:,:, 87) * m(:,:) + rate(:,:, 88) = rate(:,:, 88) * m(:,:) + rate(:,:, 89) = rate(:,:, 89) * m(:,:) + rate(:,:, 90) = rate(:,:, 90) * m(:,:) + rate(:,:, 91) = rate(:,:, 91) * m(:,:) + rate(:,:, 92) = rate(:,:, 92) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 96) = rate(:,:, 96) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:,100) = rate(:,:,100) * m(:,:) + rate(:,:,101) = rate(:,:,101) * m(:,:) + rate(:,:,102) = rate(:,:,102) * m(:,:) + rate(:,:,103) = rate(:,:,103) * m(:,:) + rate(:,:,104) = rate(:,:,104) * m(:,:) + rate(:,:,105) = rate(:,:,105) * m(:,:) + rate(:,:,106) = rate(:,:,106) * m(:,:) + rate(:,:,107) = rate(:,:,107) * m(:,:) + rate(:,:,108) = rate(:,:,108) * m(:,:) + rate(:,:,110) = rate(:,:,110) * m(:,:) + rate(:,:,111) = rate(:,:,111) * m(:,:) + rate(:,:,112) = rate(:,:,112) * m(:,:) + rate(:,:,113) = rate(:,:,113) * m(:,:) + rate(:,:,114) = rate(:,:,114) * m(:,:) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,116) = rate(:,:,116) * m(:,:) + rate(:,:,117) = rate(:,:,117) * m(:,:) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,123) = rate(:,:,123) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,126) = rate(:,:,126) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_mozart/mo_exp_sol.F90 b/src/chemistry/pp_trop_mozart/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 b/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_mozart/mo_indprd.F90 b/src/chemistry/pp_trop_mozart/mo_indprd.F90 new file mode 100644 index 0000000000..5e02cb9eaf --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_indprd.F90 @@ -0,0 +1,148 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) =.080_r8*rxt(:,:,116)*y(:,:,33)*y(:,:,1) + prod(:,:,2) = 0._r8 + prod(:,:,3) = (.500_r8*rxt(:,:,91)*y(:,:,22) + & + .560_r8*rxt(:,:,116)*y(:,:,33) +.300_r8*rxt(:,:,147)*y(:,:,50) + & + .050_r8*rxt(:,:,159)*y(:,:,53) +.200_r8*rxt(:,:,161)*y(:,:,54)) & + *y(:,:,1) + (rxt(:,:,79)*y(:,:,19) +rxt(:,:,133)*y(:,:,60) + & + .220_r8*rxt(:,:,164)*y(:,:,55) +.500_r8*rxt(:,:,181)*y(:,:,61)) & + *y(:,:,7) + (rxt(:,:,80)*y(:,:,19) +.350_r8*rxt(:,:,89)*y(:,:,101) + & + rxt(:,:,112)*y(:,:,72) +rxt(:,:,132)*y(:,:,60))*y(:,:,12) & + + (.220_r8*rxt(:,:,162)*y(:,:,5) +.110_r8*rxt(:,:,166)*y(:,:,17) + & + .220_r8*rxt(:,:,167)*y(:,:,31))*y(:,:,55) & + + (.500_r8*rxt(:,:,180)*y(:,:,5) +.200_r8*rxt(:,:,183)*y(:,:,17) + & + .500_r8*rxt(:,:,184)*y(:,:,31))*y(:,:,61) + (rxt(:,:,13) + & + rxt(:,:,14))*y(:,:,19) + (.670_r8*rxt(:,:,21) +.670_r8*rxt(:,:,22)) & + *y(:,:,54) +rxt(:,:,33)*y(:,:,26) +rxt(:,:,16)*y(:,:,30) & + +.700_r8*rxt(:,:,23)*y(:,:,53) +rxt(:,:,28)*y(:,:,60) & + +.450_r8*rxt(:,:,35)*y(:,:,71) +2.000_r8*rxt(:,:,36)*y(:,:,72) & + +rxt(:,:,30)*y(:,:,77) + extfrc(:,:,2) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) =rxt(:,:,14)*y(:,:,19) + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,91) = 0._r8 + prod(:,:,30) =rxt(:,:,4)*y(:,:,4) + prod(:,:,59) =2.000_r8*rxt(:,:,1) + prod(:,:,88) = + extfrc(:,:,1) + prod(:,:,93) = 0._r8 + prod(:,:,94) = 0._r8 + prod(:,:,58) = 0._r8 + prod(:,:,41) = 0._r8 + prod(:,:,31) = 0._r8 + prod(:,:,89) = 0._r8 + prod(:,:,90) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,92) = 0._r8 + prod(:,:,43) = 0._r8 + prod(:,:,82) = 0._r8 + prod(:,:,62) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,38) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,45) = 0._r8 + prod(:,:,50) = 0._r8 + prod(:,:,63) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,71) = 0._r8 + prod(:,:,42) = 0._r8 + prod(:,:,76) = 0._r8 + prod(:,:,95) = 0._r8 + prod(:,:,49) = 0._r8 + prod(:,:,75) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,72) = 0._r8 + prod(:,:,40) = 0._r8 + prod(:,:,67) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,68) = 0._r8 + prod(:,:,78) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,70) = 0._r8 + prod(:,:,65) = 0._r8 + prod(:,:,51) = 0._r8 + prod(:,:,66) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,74) = 0._r8 + prod(:,:,86) = 0._r8 + prod(:,:,61) = 0._r8 + prod(:,:,84) = 0._r8 + prod(:,:,80) = 0._r8 + prod(:,:,85) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,87) = 0._r8 + prod(:,:,44) = 0._r8 + prod(:,:,79) = 0._r8 + prod(:,:,81) = 0._r8 + prod(:,:,83) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,64) = 0._r8 + prod(:,:,77) = 0._r8 + prod(:,:,53) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,46) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,56) = 0._r8 + prod(:,:,54) = 0._r8 + prod(:,:,57) = 0._r8 + prod(:,:,47) = 0._r8 + prod(:,:,60) = 0._r8 + prod(:,:,69) = 0._r8 + prod(:,:,73) = 0._r8 + prod(:,:,22) = + extfrc(:,:,3) + prod(:,:,32) = 0._r8 + prod(:,:,1) = + extfrc(:,:,4) + prod(:,:,17) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,39) = 0._r8 + prod(:,:,48) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 new file mode 100644 index 0000000000..422f5c18f5 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_lin_matrix.F90 @@ -0,0 +1,264 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(716) = -( rxt(2) + rxt(3) + het_rates(1) ) + mat(798) = .890_r8*rxt(8) + .890_r8*rxt(9) + mat(223) = rxt(41) + mat(63) = -( rxt(43) + rxt(44) + rxt(45) + rxt(46)*y(11) + rxt(57)*y(4) & + + rxt(58)*y(4) + rxt(73)*y(15) + het_rates(3) ) + mat(691) = rxt(2) + mat(219) = -( rxt(41) + het_rates(2) ) + mat(696) = rxt(3) + mat(756) = rxt(5) + mat(64) = rxt(43) + rxt(44) + mat(558) = -( het_rates(5) ) + mat(762) = rxt(5) + .500_r8*rxt(202) + mat(795) = .110_r8*rxt(8) + .110_r8*rxt(9) + mat(66) = 2.000_r8*rxt(58)*y(4) + mat(767) = -( rxt(5) + rxt(202) + het_rates(6) ) + mat(72) = rxt(6) + rxt(65) + mat(217) = rxt(7) + mat(800) = .890_r8*rxt(8) + .890_r8*rxt(9) + mat(124) = .660_r8*rxt(10) + .660_r8*rxt(11) + rxt(71) + mat(212) = .600_r8*rxt(19) + rxt(109) + mat(231) = rxt(20) + rxt(176) + mat(347) = rxt(30) + mat(801) = -( rxt(8) + rxt(9) + rxt(201) + het_rates(7) ) + mat(73) = rxt(6) + rxt(65) + mat(125) = .330_r8*rxt(10) + .330_r8*rxt(11) + mat(213) = .400_r8*rxt(19) + mat(215) = -( rxt(7) + het_rates(8) ) + mat(71) = 2.000_r8*rxt(200) + mat(776) = rxt(201) + mat(755) = .500_r8*rxt(202) + mat(121) = -( rxt(10) + rxt(11) + rxt(71) + het_rates(9) ) + mat(70) = -( rxt(6) + rxt(65) + rxt(200) + het_rates(10) ) + mat(634) = -( rxt(47)*y(11) + rxt(72)*y(15) + rxt(81)*y(16) + rxt(82)*y(16) & + + rxt(211)*y(99) + rxt(212)*y(100) + het_rates(12) ) + mat(216) = rxt(7) + mat(122) = .330_r8*rxt(10) + .330_r8*rxt(11) + mat(133) = rxt(12) + mat(50) = 2.000_r8*rxt(15) + mat(181) = rxt(17) + mat(165) = rxt(18) + mat(425) = .330_r8*rxt(21) + .330_r8*rxt(22) + mat(129) = rxt(24) + mat(119) = rxt(25) + mat(87) = rxt(26) + mat(58) = rxt(29) + mat(267) = rxt(37) + mat(99) = rxt(38) + mat(151) = rxt(39) + mat(188) = rxt(40) + mat(67) = 2.000_r8*rxt(45) + rxt(46)*y(11) + .750_r8*rxt(73)*y(15) + mat(763) = .500_r8*rxt(202) + mat(685) = -( rxt(210) + het_rates(13) ) + mat(123) = .660_r8*rxt(10) + .660_r8*rxt(11) + rxt(71) + mat(134) = rxt(12) + mat(441) = 2.000_r8*rxt(13) + mat(385) = rxt(16) + mat(182) = rxt(17) + mat(426) = .670_r8*rxt(21) + .670_r8*rxt(22) + mat(130) = rxt(24) + mat(120) = rxt(25) + mat(432) = rxt(28) + mat(346) = rxt(30) + mat(240) = rxt(31) + mat(418) = rxt(32) + mat(249) = 2.000_r8*rxt(33) + mat(206) = .560_r8*rxt(35) + mat(192) = 2.000_r8*rxt(36) + mat(268) = .900_r8*rxt(37) + mat(189) = rxt(40) + mat(161) = rxt(86) + mat(55) = rxt(93) + rxt(94) + mat(68) = rxt(46)*y(11) + .400_r8*rxt(73)*y(15) + mat(635) = rxt(47)*y(11) + rxt(81)*y(16) + rxt(82)*y(16) + rxt(211)*y(99) & + + rxt(212)*y(100) + mat(49) = -( rxt(15) + het_rates(14) ) + mat(641) = .500_r8*rxt(210) + mat(746) = -( het_rates(17) ) + mat(386) = rxt(16) + mat(166) = rxt(18) + mat(211) = .400_r8*rxt(19) + mat(470) = .300_r8*rxt(23) + mat(290) = rxt(27) + mat(637) = rxt(72)*y(15) + mat(69) = .750_r8*rxt(73)*y(15) + mat(131) = -( rxt(12) + het_rates(18) ) + mat(438) = -( rxt(13) + rxt(14) + het_rates(19) ) + mat(132) = rxt(12) + mat(180) = rxt(17) + mat(422) = .670_r8*rxt(21) + .670_r8*rxt(22) + mat(86) = rxt(26) + mat(343) = rxt(30) + mat(235) = .690_r8*rxt(31) + mat(416) = rxt(32) + mat(247) = rxt(33) + mat(266) = .100_r8*rxt(37) + mat(158) = rxt(86) + mat(54) = 2.000_r8*rxt(94) + mat(65) = .250_r8*rxt(73)*y(15) + mat(241) = -( het_rates(20) ) + mat(80) = -( het_rates(21) ) + mat(106) = -( het_rates(22) ) + mat(52) = -( rxt(93) + rxt(94) + het_rates(23) ) + mat(140) = -( het_rates(24) ) + mat(168) = -( het_rates(25) ) + mat(246) = -( rxt(33) + het_rates(26) ) + mat(53) = rxt(93) + mat(21) = -( het_rates(27) ) + mat(321) = -( het_rates(28) ) + mat(173) = rxt(34) + mat(126) = -( rxt(24) + het_rates(29) ) + mat(383) = -( rxt(16) + het_rates(30) ) + mat(178) = rxt(17) + mat(128) = rxt(24) + mat(265) = .400_r8*rxt(37) + mat(98) = rxt(38) + mat(824) = -( het_rates(31) ) + mat(214) = .600_r8*rxt(19) + rxt(109) + mat(428) = .670_r8*rxt(21) + .670_r8*rxt(22) + mat(473) = .300_r8*rxt(23) + mat(88) = rxt(26) + mat(291) = rxt(27) + mat(435) = rxt(28) + mat(419) = rxt(32) + mat(175) = rxt(34) + mat(207) = .130_r8*rxt(35) + mat(100) = rxt(38) + mat(163) = -( rxt(18) + het_rates(32) ) + mat(370) = -( het_rates(33) ) + mat(459) = .700_r8*rxt(23) + mat(24) = -( het_rates(34) ) + mat(331) = -( het_rates(35) ) + mat(116) = -( rxt(25) + het_rates(36) ) + mat(279) = -( het_rates(37) ) + mat(176) = -( rxt(17) + het_rates(38) ) + mat(287) = -( rxt(27) + het_rates(39) ) + mat(117) = .820_r8*rxt(25) + mat(262) = .250_r8*rxt(37) + mat(184) = .100_r8*rxt(40) + mat(404) = -( het_rates(40) ) + mat(84) = -( rxt(26) + het_rates(41) ) + mat(27) = -( het_rates(42) ) + mat(89) = -( het_rates(43) ) + mat(30) = -( het_rates(47) ) + mat(306) = -( het_rates(48) ) + mat(260) = -( rxt(37) + het_rates(49) ) + mat(171) = -( rxt(34) + het_rates(44) ) + mat(259) = .800_r8*rxt(37) + mat(271) = -( het_rates(45) ) + mat(96) = -( rxt(38) + het_rates(46) ) + mat(352) = -( het_rates(50) ) + mat(501) = -( het_rates(51) ) + mat(233) = -( rxt(31) + het_rates(52) ) + mat(464) = -( rxt(23) + het_rates(53) ) + mat(237) = .402_r8*rxt(31) + mat(187) = rxt(40) + mat(420) = -( rxt(21) + rxt(22) + het_rates(54) ) + mat(234) = .288_r8*rxt(31) + mat(186) = rxt(40) + mat(482) = -( het_rates(55) ) + mat(101) = -( het_rates(56) ) + mat(517) = -( het_rates(57) ) + mat(228) = rxt(20) + rxt(176) + mat(424) = .330_r8*rxt(21) + .330_r8*rxt(22) + mat(136) = -( het_rates(58) ) + mat(414) = -( rxt(32) + het_rates(59) ) + mat(430) = -( rxt(28) + het_rates(60) ) + mat(204) = .180_r8*rxt(35) + mat(150) = .450_r8*rxt(39) + mat(451) = -( het_rates(61) ) + mat(56) = -( rxt(29) + het_rates(62) ) + mat(250) = -( het_rates(63) ) + mat(392) = -( het_rates(64) ) + mat(183) = -( rxt(40) + het_rates(65) ) + mat(36) = -( het_rates(66) ) + mat(41) = -( het_rates(67) ) + mat(195) = -( het_rates(68) ) + mat(146) = -( rxt(39) + het_rates(69) ) + mat(59) = -( het_rates(70) ) + mat(203) = -( rxt(35) + het_rates(71) ) + mat(149) = .900_r8*rxt(39) + mat(190) = -( rxt(36) + het_rates(72) ) + mat(202) = .130_r8*rxt(35) + mat(147) = .450_r8*rxt(39) + mat(208) = -( rxt(19) + rxt(109) + het_rates(73) ) + mat(152) = -( het_rates(74) ) + mat(225) = -( rxt(20) + rxt(176) + het_rates(75) ) + mat(292) = -( het_rates(76) ) + mat(342) = -( rxt(30) + het_rates(77) ) + mat(34) = -( het_rates(83) ) + mat(75) = -( het_rates(84) ) + mat(1) = -( het_rates(85) ) + mat(19) = -( het_rates(86) ) + mat(2) = -( het_rates(87) ) + mat(3) = -( het_rates(88) ) + mat(4) = -( het_rates(82) ) + mat(5) = -( rxt(203) + het_rates(78) ) + mat(7) = -( het_rates(79) ) + mat(6) = rxt(203) + mat(8) = -( rxt(209) + het_rates(80) ) + mat(10) = -( het_rates(81) ) + mat(9) = rxt(209) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(44) = -( het_rates(101) ) + mat(113) = -( het_rates(102) ) + mat(157) = -( rxt(86) + het_rates(103) ) + mat(11) = -( het_rates(89) ) + mat(12) = -( het_rates(90) ) + mat(13) = -( het_rates(91) ) + mat(14) = -( het_rates(92) ) + mat(15) = -( het_rates(93) ) + mat(16) = -( het_rates(94) ) + mat(17) = -( het_rates(95) ) + mat(18) = -( het_rates(96) ) + end subroutine linmat02 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 b/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 new file mode 100644 index 0000000000..59fbd41b86 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_lu_factor.F90 @@ -0,0 +1,2394 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = lu(6) * lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = lu(9) * lu(8) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = lu(20) * lu(19) + lu(634) = lu(634) - lu(20) * lu(567) + lu(21) = 1._r8 / lu(21) + lu(22) = lu(22) * lu(21) + lu(23) = lu(23) * lu(21) + lu(616) = lu(616) - lu(22) * lu(568) + lu(634) = lu(634) - lu(23) * lu(568) + lu(24) = 1._r8 / lu(24) + lu(25) = lu(25) * lu(24) + lu(26) = lu(26) * lu(24) + lu(617) = lu(617) - lu(25) * lu(569) + lu(634) = lu(634) - lu(26) * lu(569) + lu(27) = 1._r8 / lu(27) + lu(28) = lu(28) * lu(27) + lu(29) = lu(29) * lu(27) + lu(582) = lu(582) - lu(28) * lu(570) + lu(634) = lu(634) - lu(29) * lu(570) + lu(30) = 1._r8 / lu(30) + lu(31) = lu(31) * lu(30) + lu(32) = lu(32) * lu(30) + lu(615) = lu(615) - lu(31) * lu(571) + lu(634) = lu(634) - lu(32) * lu(571) + lu(34) = 1._r8 / lu(34) + lu(35) = lu(35) * lu(34) + lu(77) = lu(77) - lu(35) * lu(74) + lu(634) = lu(634) - lu(35) * lu(572) + lu(796) = lu(796) - lu(35) * lu(770) + lu(36) = 1._r8 / lu(36) + lu(37) = lu(37) * lu(36) + lu(38) = lu(38) * lu(36) + lu(39) = lu(39) * lu(36) + lu(40) = lu(40) * lu(36) + lu(574) = lu(574) - lu(37) * lu(573) + lu(601) = lu(601) - lu(38) * lu(573) + lu(634) = lu(634) - lu(39) * lu(573) + lu(635) = lu(635) - lu(40) * lu(573) + lu(41) = 1._r8 / lu(41) + lu(42) = lu(42) * lu(41) + lu(43) = lu(43) * lu(41) + lu(578) = lu(578) - lu(42) * lu(574) + lu(634) = lu(634) - lu(43) * lu(574) + lu(44) = 1._r8 / lu(44) + lu(45) = lu(45) * lu(44) + lu(46) = lu(46) * lu(44) + lu(47) = lu(47) * lu(44) + lu(48) = lu(48) * lu(44) + lu(586) = lu(586) - lu(45) * lu(575) + lu(600) = lu(600) - lu(46) * lu(575) + lu(634) = lu(634) - lu(47) * lu(575) + lu(635) = lu(635) - lu(48) * lu(575) + lu(49) = 1._r8 / lu(49) + lu(50) = lu(50) * lu(49) + lu(51) = lu(51) * lu(49) + lu(634) = lu(634) - lu(50) * lu(576) + lu(635) = lu(635) - lu(51) * lu(576) + lu(684) = lu(684) - lu(50) * lu(641) + lu(685) = lu(685) - lu(51) * lu(641) + lu(52) = 1._r8 / lu(52) + lu(53) = lu(53) * lu(52) + lu(54) = lu(54) * lu(52) + lu(55) = lu(55) * lu(52) + lu(141) = - lu(53) * lu(139) + lu(142) = - lu(54) * lu(139) + lu(144) = - lu(55) * lu(139) + lu(537) = lu(537) - lu(53) * lu(526) + lu(552) = lu(552) - lu(54) * lu(526) + lu(560) = lu(560) - lu(55) * lu(526) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(56) = 1._r8 / lu(56) + lu(57) = lu(57) * lu(56) + lu(58) = lu(58) * lu(56) + lu(451) = lu(451) - lu(57) * lu(444) + lu(453) = - lu(58) * lu(444) + lu(628) = lu(628) - lu(57) * lu(577) + lu(634) = lu(634) - lu(58) * lu(577) + lu(678) = lu(678) - lu(57) * lu(642) + lu(684) = lu(684) - lu(58) * lu(642) + lu(59) = 1._r8 / lu(59) + lu(60) = lu(60) * lu(59) + lu(61) = lu(61) * lu(59) + lu(62) = lu(62) * lu(59) + lu(602) = - lu(60) * lu(578) + lu(635) = lu(635) - lu(61) * lu(578) + lu(638) = lu(638) - lu(62) * lu(578) + lu(753) = lu(753) - lu(60) * lu(750) + lu(764) = lu(764) - lu(61) * lu(750) + lu(767) = lu(767) - lu(62) * lu(750) + lu(63) = 1._r8 / lu(63) + lu(64) = lu(64) * lu(63) + lu(65) = lu(65) * lu(63) + lu(66) = lu(66) * lu(63) + lu(67) = lu(67) * lu(63) + lu(68) = lu(68) * lu(63) + lu(69) = lu(69) * lu(63) + lu(696) = lu(696) - lu(64) * lu(691) + lu(707) = lu(707) - lu(65) * lu(691) + lu(713) = lu(713) - lu(66) * lu(691) + lu(714) = lu(714) - lu(67) * lu(691) + lu(715) = lu(715) - lu(68) * lu(691) + lu(717) = lu(717) - lu(69) * lu(691) + lu(70) = 1._r8 / lu(70) + lu(71) = lu(71) * lu(70) + lu(72) = lu(72) * lu(70) + lu(73) = lu(73) * lu(70) + lu(755) = lu(755) - lu(71) * lu(751) + lu(767) = lu(767) - lu(72) * lu(751) + lu(768) = lu(768) - lu(73) * lu(751) + lu(776) = lu(776) - lu(71) * lu(771) + lu(800) = lu(800) - lu(72) * lu(771) + lu(801) = lu(801) - lu(73) * lu(771) + lu(75) = 1._r8 / lu(75) + lu(76) = lu(76) * lu(75) + lu(77) = lu(77) * lu(75) + lu(78) = lu(78) * lu(75) + lu(79) = lu(79) * lu(75) + lu(604) = lu(604) - lu(76) * lu(579) + lu(634) = lu(634) - lu(77) * lu(579) + lu(635) = lu(635) - lu(78) * lu(579) + lu(639) = lu(639) - lu(79) * lu(579) + lu(776) = lu(776) - lu(76) * lu(772) + lu(796) = lu(796) - lu(77) * lu(772) + lu(797) = lu(797) - lu(78) * lu(772) + lu(801) = lu(801) - lu(79) * lu(772) + lu(80) = 1._r8 / lu(80) + lu(81) = lu(81) * lu(80) + lu(82) = lu(82) * lu(80) + lu(83) = lu(83) * lu(80) + lu(322) = lu(322) - lu(81) * lu(318) + lu(325) = - lu(82) * lu(318) + lu(326) = lu(326) - lu(83) * lu(318) + lu(621) = lu(621) - lu(81) * lu(580) + lu(634) = lu(634) - lu(82) * lu(580) + lu(635) = lu(635) - lu(83) * lu(580) + lu(731) = lu(731) - lu(81) * lu(721) + lu(743) = - lu(82) * lu(721) + lu(744) = lu(744) - lu(83) * lu(721) + lu(84) = 1._r8 / lu(84) + lu(85) = lu(85) * lu(84) + lu(86) = lu(86) * lu(84) + lu(87) = lu(87) * lu(84) + lu(88) = lu(88) * lu(84) + lu(404) = lu(404) - lu(85) * lu(402) + lu(407) = lu(407) - lu(86) * lu(402) + lu(409) = - lu(87) * lu(402) + lu(413) = lu(413) - lu(88) * lu(402) + lu(623) = lu(623) - lu(85) * lu(581) + lu(627) = lu(627) - lu(86) * lu(581) + lu(634) = lu(634) - lu(87) * lu(581) + lu(640) = lu(640) - lu(88) * lu(581) + lu(673) = lu(673) - lu(85) * lu(643) + lu(677) = lu(677) - lu(86) * lu(643) + lu(684) = lu(684) - lu(87) * lu(643) + lu(690) = lu(690) - lu(88) * lu(643) + lu(89) = 1._r8 / lu(89) + lu(90) = lu(90) * lu(89) + lu(91) = lu(91) * lu(89) + lu(92) = lu(92) * lu(89) + lu(93) = lu(93) * lu(89) + lu(94) = lu(94) * lu(89) + lu(95) = lu(95) * lu(89) + lu(540) = lu(540) - lu(90) * lu(527) + lu(546) = lu(546) - lu(91) * lu(527) + lu(552) = lu(552) - lu(92) * lu(527) + lu(558) = lu(558) - lu(93) * lu(527) + lu(560) = lu(560) - lu(94) * lu(527) + lu(563) = lu(563) - lu(95) * lu(527) + lu(614) = lu(614) - lu(90) * lu(582) + lu(621) = lu(621) - lu(91) * lu(582) + lu(627) = lu(627) - lu(92) * lu(582) + lu(633) = - lu(93) * lu(582) + lu(635) = lu(635) - lu(94) * lu(582) + lu(638) = lu(638) - lu(95) * lu(582) + lu(96) = 1._r8 / lu(96) + lu(97) = lu(97) * lu(96) + lu(98) = lu(98) * lu(96) + lu(99) = lu(99) * lu(96) + lu(100) = lu(100) * lu(96) + lu(271) = lu(271) - lu(97) * lu(270) + lu(272) = lu(272) - lu(98) * lu(270) + lu(274) = - lu(99) * lu(270) + lu(277) = lu(277) - lu(100) * lu(270) + lu(612) = lu(612) - lu(97) * lu(583) + lu(621) = lu(621) - lu(98) * lu(583) + lu(634) = lu(634) - lu(99) * lu(583) + lu(640) = lu(640) - lu(100) * lu(583) + lu(663) = lu(663) - lu(97) * lu(644) + lu(671) = - lu(98) * lu(644) + lu(684) = lu(684) - lu(99) * lu(644) + lu(690) = lu(690) - lu(100) * lu(644) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(101) = 1._r8 / lu(101) + lu(102) = lu(102) * lu(101) + lu(103) = lu(103) * lu(101) + lu(104) = lu(104) * lu(101) + lu(105) = lu(105) * lu(101) + lu(482) = lu(482) - lu(102) * lu(474) + lu(483) = - lu(103) * lu(474) + lu(485) = - lu(104) * lu(474) + lu(486) = lu(486) - lu(105) * lu(474) + lu(630) = lu(630) - lu(102) * lu(584) + lu(632) = lu(632) - lu(103) * lu(584) + lu(634) = lu(634) - lu(104) * lu(584) + lu(635) = lu(635) - lu(105) * lu(584) + lu(680) = lu(680) - lu(102) * lu(645) + lu(682) = lu(682) - lu(103) * lu(645) + lu(684) = lu(684) - lu(104) * lu(645) + lu(685) = lu(685) - lu(105) * lu(645) + lu(106) = 1._r8 / lu(106) + lu(107) = lu(107) * lu(106) + lu(108) = lu(108) * lu(106) + lu(109) = lu(109) * lu(106) + lu(110) = lu(110) * lu(106) + lu(111) = lu(111) * lu(106) + lu(112) = lu(112) * lu(106) + lu(586) = lu(586) - lu(107) * lu(585) + lu(592) = lu(592) - lu(108) * lu(585) + lu(627) = lu(627) - lu(109) * lu(585) + lu(634) = lu(634) - lu(110) * lu(585) + lu(635) = lu(635) - lu(111) * lu(585) + lu(636) = lu(636) - lu(112) * lu(585) + lu(693) = lu(693) - lu(107) * lu(692) + lu(694) = - lu(108) * lu(692) + lu(707) = lu(707) - lu(109) * lu(692) + lu(714) = lu(714) - lu(110) * lu(692) + lu(715) = lu(715) - lu(111) * lu(692) + lu(716) = lu(716) - lu(112) * lu(692) + lu(113) = 1._r8 / lu(113) + lu(114) = lu(114) * lu(113) + lu(115) = lu(115) * lu(113) + lu(160) = - lu(114) * lu(156) + lu(161) = lu(161) - lu(115) * lu(156) + lu(559) = lu(559) - lu(114) * lu(528) + lu(560) = lu(560) - lu(115) * lu(528) + lu(634) = lu(634) - lu(114) * lu(586) + lu(635) = lu(635) - lu(115) * lu(586) + lu(684) = lu(684) - lu(114) * lu(646) + lu(685) = lu(685) - lu(115) * lu(646) + lu(714) = lu(714) - lu(114) * lu(693) + lu(715) = lu(715) - lu(115) * lu(693) + lu(116) = 1._r8 / lu(116) + lu(117) = lu(117) * lu(116) + lu(118) = lu(118) * lu(116) + lu(119) = lu(119) * lu(116) + lu(120) = lu(120) * lu(116) + lu(330) = lu(330) - lu(117) * lu(329) + lu(331) = lu(331) - lu(118) * lu(329) + lu(336) = - lu(119) * lu(329) + lu(337) = lu(337) - lu(120) * lu(329) + lu(614) = lu(614) - lu(117) * lu(587) + lu(617) = lu(617) - lu(118) * lu(587) + lu(634) = lu(634) - lu(119) * lu(587) + lu(635) = lu(635) - lu(120) * lu(587) + lu(665) = - lu(117) * lu(647) + lu(669) = lu(669) - lu(118) * lu(647) + lu(684) = lu(684) - lu(119) * lu(647) + lu(685) = lu(685) - lu(120) * lu(647) + lu(121) = 1._r8 / lu(121) + lu(122) = lu(122) * lu(121) + lu(123) = lu(123) * lu(121) + lu(124) = lu(124) * lu(121) + lu(125) = lu(125) * lu(121) + lu(634) = lu(634) - lu(122) * lu(588) + lu(635) = lu(635) - lu(123) * lu(588) + lu(638) = lu(638) - lu(124) * lu(588) + lu(639) = lu(639) - lu(125) * lu(588) + lu(684) = lu(684) - lu(122) * lu(648) + lu(685) = lu(685) - lu(123) * lu(648) + lu(688) = lu(688) - lu(124) * lu(648) + lu(689) = lu(689) - lu(125) * lu(648) + lu(763) = lu(763) - lu(122) * lu(752) + lu(764) = lu(764) - lu(123) * lu(752) + lu(767) = lu(767) - lu(124) * lu(752) + lu(768) = lu(768) - lu(125) * lu(752) + lu(126) = 1._r8 / lu(126) + lu(127) = lu(127) * lu(126) + lu(128) = lu(128) * lu(126) + lu(129) = lu(129) * lu(126) + lu(130) = lu(130) * lu(126) + lu(321) = lu(321) - lu(127) * lu(319) + lu(322) = lu(322) - lu(128) * lu(319) + lu(325) = lu(325) - lu(129) * lu(319) + lu(326) = lu(326) - lu(130) * lu(319) + lu(616) = lu(616) - lu(127) * lu(589) + lu(621) = lu(621) - lu(128) * lu(589) + lu(634) = lu(634) - lu(129) * lu(589) + lu(635) = lu(635) - lu(130) * lu(589) + lu(668) = lu(668) - lu(127) * lu(649) + lu(671) = lu(671) - lu(128) * lu(649) + lu(684) = lu(684) - lu(129) * lu(649) + lu(685) = lu(685) - lu(130) * lu(649) + lu(131) = 1._r8 / lu(131) + lu(132) = lu(132) * lu(131) + lu(133) = lu(133) * lu(131) + lu(134) = lu(134) * lu(131) + lu(135) = lu(135) * lu(131) + lu(627) = lu(627) - lu(132) * lu(590) + lu(634) = lu(634) - lu(133) * lu(590) + lu(635) = lu(635) - lu(134) * lu(590) + lu(637) = lu(637) - lu(135) * lu(590) + lu(677) = lu(677) - lu(132) * lu(650) + lu(684) = lu(684) - lu(133) * lu(650) + lu(685) = lu(685) - lu(134) * lu(650) + lu(687) = lu(687) - lu(135) * lu(650) + lu(736) = lu(736) - lu(132) * lu(722) + lu(743) = lu(743) - lu(133) * lu(722) + lu(744) = lu(744) - lu(134) * lu(722) + lu(746) = lu(746) - lu(135) * lu(722) + lu(136) = 1._r8 / lu(136) + lu(137) = lu(137) * lu(136) + lu(138) = lu(138) * lu(136) + lu(344) = - lu(137) * lu(341) + lu(345) = lu(345) - lu(138) * lu(341) + lu(498) = - lu(137) * lu(491) + lu(504) = - lu(138) * lu(491) + lu(553) = lu(553) - lu(137) * lu(529) + lu(559) = lu(559) - lu(138) * lu(529) + lu(628) = lu(628) - lu(137) * lu(591) + lu(634) = lu(634) - lu(138) * lu(591) + lu(737) = lu(737) - lu(137) * lu(723) + lu(743) = lu(743) - lu(138) * lu(723) + lu(790) = lu(790) - lu(137) * lu(773) + lu(796) = lu(796) - lu(138) * lu(773) + lu(812) = lu(812) - lu(137) * lu(803) + lu(818) = - lu(138) * lu(803) + lu(140) = 1._r8 / lu(140) + lu(141) = lu(141) * lu(140) + lu(142) = lu(142) * lu(140) + lu(143) = lu(143) * lu(140) + lu(144) = lu(144) * lu(140) + lu(145) = lu(145) * lu(140) + lu(537) = lu(537) - lu(141) * lu(530) + lu(552) = lu(552) - lu(142) * lu(530) + lu(558) = lu(558) - lu(143) * lu(530) + lu(560) = lu(560) - lu(144) * lu(530) + lu(563) = lu(563) - lu(145) * lu(530) + lu(609) = lu(609) - lu(141) * lu(592) + lu(627) = lu(627) - lu(142) * lu(592) + lu(633) = lu(633) - lu(143) * lu(592) + lu(635) = lu(635) - lu(144) * lu(592) + lu(638) = lu(638) - lu(145) * lu(592) + lu(697) = - lu(141) * lu(694) + lu(707) = lu(707) - lu(142) * lu(694) + lu(713) = lu(713) - lu(143) * lu(694) + lu(715) = lu(715) - lu(144) * lu(694) + lu(718) = lu(718) - lu(145) * lu(694) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(146) = 1._r8 / lu(146) + lu(147) = lu(147) * lu(146) + lu(148) = lu(148) * lu(146) + lu(149) = lu(149) * lu(146) + lu(150) = lu(150) * lu(146) + lu(151) = lu(151) * lu(146) + lu(194) = lu(194) - lu(147) * lu(193) + lu(195) = lu(195) - lu(148) * lu(193) + lu(196) = lu(196) - lu(149) * lu(193) + lu(197) = lu(197) - lu(150) * lu(193) + lu(199) = - lu(151) * lu(193) + lu(600) = lu(600) - lu(147) * lu(593) + lu(601) = lu(601) - lu(148) * lu(593) + lu(602) = lu(602) - lu(149) * lu(593) + lu(626) = lu(626) - lu(150) * lu(593) + lu(634) = lu(634) - lu(151) * lu(593) + lu(657) = - lu(147) * lu(651) + lu(658) = lu(658) - lu(148) * lu(651) + lu(659) = - lu(149) * lu(651) + lu(676) = - lu(150) * lu(651) + lu(684) = lu(684) - lu(151) * lu(651) + lu(152) = 1._r8 / lu(152) + lu(153) = lu(153) * lu(152) + lu(154) = lu(154) * lu(152) + lu(155) = lu(155) * lu(152) + lu(310) = - lu(153) * lu(301) + lu(313) = - lu(154) * lu(301) + lu(316) = lu(316) - lu(155) * lu(301) + lu(373) = - lu(153) * lu(367) + lu(376) = lu(376) - lu(154) * lu(367) + lu(380) = - lu(155) * lu(367) + lu(551) = lu(551) - lu(153) * lu(531) + lu(559) = lu(559) - lu(154) * lu(531) + lu(563) = lu(563) - lu(155) * lu(531) + lu(626) = lu(626) - lu(153) * lu(594) + lu(634) = lu(634) - lu(154) * lu(594) + lu(638) = lu(638) - lu(155) * lu(594) + lu(788) = lu(788) - lu(153) * lu(774) + lu(796) = lu(796) - lu(154) * lu(774) + lu(800) = lu(800) - lu(155) * lu(774) + lu(157) = 1._r8 / lu(157) + lu(158) = lu(158) * lu(157) + lu(159) = lu(159) * lu(157) + lu(160) = lu(160) * lu(157) + lu(161) = lu(161) * lu(157) + lu(162) = lu(162) * lu(157) + lu(438) = lu(438) - lu(158) * lu(436) + lu(439) = - lu(159) * lu(436) + lu(440) = lu(440) - lu(160) * lu(436) + lu(441) = lu(441) - lu(161) * lu(436) + lu(442) = - lu(162) * lu(436) + lu(552) = lu(552) - lu(158) * lu(532) + lu(558) = lu(558) - lu(159) * lu(532) + lu(559) = lu(559) - lu(160) * lu(532) + lu(560) = lu(560) - lu(161) * lu(532) + lu(563) = lu(563) - lu(162) * lu(532) + lu(677) = lu(677) - lu(158) * lu(652) + lu(683) = lu(683) - lu(159) * lu(652) + lu(684) = lu(684) - lu(160) * lu(652) + lu(685) = lu(685) - lu(161) * lu(652) + lu(688) = lu(688) - lu(162) * lu(652) + lu(163) = 1._r8 / lu(163) + lu(164) = lu(164) * lu(163) + lu(165) = lu(165) * lu(163) + lu(166) = lu(166) * lu(163) + lu(167) = lu(167) * lu(163) + lu(516) = lu(516) - lu(164) * lu(511) + lu(519) = - lu(165) * lu(511) + lu(522) = lu(522) - lu(166) * lu(511) + lu(525) = lu(525) - lu(167) * lu(511) + lu(627) = lu(627) - lu(164) * lu(595) + lu(634) = lu(634) - lu(165) * lu(595) + lu(637) = lu(637) - lu(166) * lu(595) + lu(640) = lu(640) - lu(167) * lu(595) + lu(677) = lu(677) - lu(164) * lu(653) + lu(684) = lu(684) - lu(165) * lu(653) + lu(687) = lu(687) - lu(166) * lu(653) + lu(690) = lu(690) - lu(167) * lu(653) + lu(811) = lu(811) - lu(164) * lu(804) + lu(818) = lu(818) - lu(165) * lu(804) + lu(821) = lu(821) - lu(166) * lu(804) + lu(824) = lu(824) - lu(167) * lu(804) + lu(168) = 1._r8 / lu(168) + lu(169) = lu(169) * lu(168) + lu(170) = lu(170) * lu(168) + lu(361) = lu(361) - lu(169) * lu(349) + lu(364) = - lu(170) * lu(349) + lu(376) = lu(376) - lu(169) * lu(368) + lu(379) = lu(379) - lu(170) * lu(368) + lu(519) = lu(519) - lu(169) * lu(512) + lu(522) = lu(522) - lu(170) * lu(512) + lu(634) = lu(634) - lu(169) * lu(596) + lu(637) = lu(637) - lu(170) * lu(596) + lu(684) = lu(684) - lu(169) * lu(654) + lu(687) = lu(687) - lu(170) * lu(654) + lu(714) = lu(714) - lu(169) * lu(695) + lu(717) = lu(717) - lu(170) * lu(695) + lu(743) = lu(743) - lu(169) * lu(724) + lu(746) = lu(746) - lu(170) * lu(724) + lu(818) = lu(818) - lu(169) * lu(805) + lu(821) = lu(821) - lu(170) * lu(805) + lu(171) = 1._r8 / lu(171) + lu(172) = lu(172) * lu(171) + lu(173) = lu(173) * lu(171) + lu(174) = lu(174) * lu(171) + lu(175) = lu(175) * lu(171) + lu(261) = - lu(172) * lu(259) + lu(264) = - lu(173) * lu(259) + lu(267) = lu(267) - lu(174) * lu(259) + lu(269) = - lu(175) * lu(259) + lu(304) = - lu(172) * lu(302) + lu(307) = - lu(173) * lu(302) + lu(313) = lu(313) - lu(174) * lu(302) + lu(317) = - lu(175) * lu(302) + lu(538) = lu(538) - lu(172) * lu(533) + lu(543) = lu(543) - lu(173) * lu(533) + lu(559) = lu(559) - lu(174) * lu(533) + lu(565) = lu(565) - lu(175) * lu(533) + lu(612) = lu(612) - lu(172) * lu(597) + lu(616) = lu(616) - lu(173) * lu(597) + lu(634) = lu(634) - lu(174) * lu(597) + lu(640) = lu(640) - lu(175) * lu(597) + lu(176) = 1._r8 / lu(176) + lu(177) = lu(177) * lu(176) + lu(178) = lu(178) * lu(176) + lu(179) = lu(179) * lu(176) + lu(180) = lu(180) * lu(176) + lu(181) = lu(181) * lu(176) + lu(182) = lu(182) * lu(176) + lu(279) = lu(279) - lu(177) * lu(278) + lu(280) = lu(280) - lu(178) * lu(278) + lu(281) = - lu(179) * lu(278) + lu(282) = lu(282) - lu(180) * lu(278) + lu(284) = - lu(181) * lu(278) + lu(285) = lu(285) - lu(182) * lu(278) + lu(613) = lu(613) - lu(177) * lu(598) + lu(621) = lu(621) - lu(178) * lu(598) + lu(624) = lu(624) - lu(179) * lu(598) + lu(627) = lu(627) - lu(180) * lu(598) + lu(634) = lu(634) - lu(181) * lu(598) + lu(635) = lu(635) - lu(182) * lu(598) + lu(664) = lu(664) - lu(177) * lu(655) + lu(671) = lu(671) - lu(178) * lu(655) + lu(674) = - lu(179) * lu(655) + lu(677) = lu(677) - lu(180) * lu(655) + lu(684) = lu(684) - lu(181) * lu(655) + lu(685) = lu(685) - lu(182) * lu(655) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(183) = 1._r8 / lu(183) + lu(184) = lu(184) * lu(183) + lu(185) = lu(185) * lu(183) + lu(186) = lu(186) * lu(183) + lu(187) = lu(187) * lu(183) + lu(188) = lu(188) * lu(183) + lu(189) = lu(189) * lu(183) + lu(391) = lu(391) - lu(184) * lu(390) + lu(392) = lu(392) - lu(185) * lu(390) + lu(394) = lu(394) - lu(186) * lu(390) + lu(395) = lu(395) - lu(187) * lu(390) + lu(397) = - lu(188) * lu(390) + lu(398) = lu(398) - lu(189) * lu(390) + lu(614) = lu(614) - lu(184) * lu(599) + lu(622) = lu(622) - lu(185) * lu(599) + lu(625) = lu(625) - lu(186) * lu(599) + lu(629) = lu(629) - lu(187) * lu(599) + lu(634) = lu(634) - lu(188) * lu(599) + lu(635) = lu(635) - lu(189) * lu(599) + lu(665) = lu(665) - lu(184) * lu(656) + lu(672) = lu(672) - lu(185) * lu(656) + lu(675) = lu(675) - lu(186) * lu(656) + lu(679) = lu(679) - lu(187) * lu(656) + lu(684) = lu(684) - lu(188) * lu(656) + lu(685) = lu(685) - lu(189) * lu(656) + lu(190) = 1._r8 / lu(190) + lu(191) = lu(191) * lu(190) + lu(192) = lu(192) * lu(190) + lu(199) = lu(199) - lu(191) * lu(194) + lu(200) = lu(200) - lu(192) * lu(194) + lu(205) = - lu(191) * lu(202) + lu(206) = lu(206) - lu(192) * lu(202) + lu(248) = lu(248) - lu(191) * lu(245) + lu(249) = lu(249) - lu(192) * lu(245) + lu(453) = lu(453) - lu(191) * lu(445) + lu(454) = lu(454) - lu(192) * lu(445) + lu(559) = lu(559) - lu(191) * lu(534) + lu(560) = lu(560) - lu(192) * lu(534) + lu(634) = lu(634) - lu(191) * lu(600) + lu(635) = lu(635) - lu(192) * lu(600) + lu(684) = lu(684) - lu(191) * lu(657) + lu(685) = lu(685) - lu(192) * lu(657) + lu(743) = lu(743) - lu(191) * lu(725) + lu(744) = lu(744) - lu(192) * lu(725) + lu(796) = lu(796) - lu(191) * lu(775) + lu(797) = lu(797) - lu(192) * lu(775) + lu(195) = 1._r8 / lu(195) + lu(196) = lu(196) * lu(195) + lu(197) = lu(197) * lu(195) + lu(198) = lu(198) * lu(195) + lu(199) = lu(199) * lu(195) + lu(200) = lu(200) * lu(195) + lu(201) = lu(201) * lu(195) + lu(536) = lu(536) - lu(196) * lu(535) + lu(551) = lu(551) - lu(197) * lu(535) + lu(558) = lu(558) - lu(198) * lu(535) + lu(559) = lu(559) - lu(199) * lu(535) + lu(560) = lu(560) - lu(200) * lu(535) + lu(563) = lu(563) - lu(201) * lu(535) + lu(602) = lu(602) - lu(196) * lu(601) + lu(626) = lu(626) - lu(197) * lu(601) + lu(633) = lu(633) - lu(198) * lu(601) + lu(634) = lu(634) - lu(199) * lu(601) + lu(635) = lu(635) - lu(200) * lu(601) + lu(638) = lu(638) - lu(201) * lu(601) + lu(659) = lu(659) - lu(196) * lu(658) + lu(676) = lu(676) - lu(197) * lu(658) + lu(683) = lu(683) - lu(198) * lu(658) + lu(684) = lu(684) - lu(199) * lu(658) + lu(685) = lu(685) - lu(200) * lu(658) + lu(688) = lu(688) - lu(201) * lu(658) + lu(203) = 1._r8 / lu(203) + lu(204) = lu(204) * lu(203) + lu(205) = lu(205) * lu(203) + lu(206) = lu(206) * lu(203) + lu(207) = lu(207) * lu(203) + lu(551) = lu(551) - lu(204) * lu(536) + lu(559) = lu(559) - lu(205) * lu(536) + lu(560) = lu(560) - lu(206) * lu(536) + lu(565) = lu(565) - lu(207) * lu(536) + lu(626) = lu(626) - lu(204) * lu(602) + lu(634) = lu(634) - lu(205) * lu(602) + lu(635) = lu(635) - lu(206) * lu(602) + lu(640) = lu(640) - lu(207) * lu(602) + lu(676) = lu(676) - lu(204) * lu(659) + lu(684) = lu(684) - lu(205) * lu(659) + lu(685) = lu(685) - lu(206) * lu(659) + lu(690) = lu(690) - lu(207) * lu(659) + lu(759) = - lu(204) * lu(753) + lu(763) = lu(763) - lu(205) * lu(753) + lu(764) = lu(764) - lu(206) * lu(753) + lu(769) = lu(769) - lu(207) * lu(753) + lu(208) = 1._r8 / lu(208) + lu(209) = lu(209) * lu(208) + lu(210) = lu(210) * lu(208) + lu(211) = lu(211) * lu(208) + lu(212) = lu(212) * lu(208) + lu(213) = lu(213) * lu(208) + lu(214) = lu(214) * lu(208) + lu(627) = lu(627) - lu(209) * lu(603) + lu(634) = lu(634) - lu(210) * lu(603) + lu(637) = lu(637) - lu(211) * lu(603) + lu(638) = lu(638) - lu(212) * lu(603) + lu(639) = lu(639) - lu(213) * lu(603) + lu(640) = lu(640) - lu(214) * lu(603) + lu(760) = - lu(209) * lu(754) + lu(763) = lu(763) - lu(210) * lu(754) + lu(766) = - lu(211) * lu(754) + lu(767) = lu(767) - lu(212) * lu(754) + lu(768) = lu(768) - lu(213) * lu(754) + lu(769) = lu(769) - lu(214) * lu(754) + lu(811) = lu(811) - lu(209) * lu(806) + lu(818) = lu(818) - lu(210) * lu(806) + lu(821) = lu(821) - lu(211) * lu(806) + lu(822) = lu(822) - lu(212) * lu(806) + lu(823) = - lu(213) * lu(806) + lu(824) = lu(824) - lu(214) * lu(806) + lu(215) = 1._r8 / lu(215) + lu(216) = lu(216) * lu(215) + lu(217) = lu(217) * lu(215) + lu(218) = lu(218) * lu(215) + lu(384) = lu(384) - lu(216) * lu(382) + lu(387) = - lu(217) * lu(382) + lu(388) = lu(388) - lu(218) * lu(382) + lu(431) = lu(431) - lu(216) * lu(429) + lu(433) = - lu(217) * lu(429) + lu(434) = lu(434) - lu(218) * lu(429) + lu(440) = lu(440) - lu(216) * lu(437) + lu(442) = lu(442) - lu(217) * lu(437) + lu(443) = lu(443) - lu(218) * lu(437) + lu(634) = lu(634) - lu(216) * lu(604) + lu(638) = lu(638) - lu(217) * lu(604) + lu(639) = lu(639) - lu(218) * lu(604) + lu(763) = lu(763) - lu(216) * lu(755) + lu(767) = lu(767) - lu(217) * lu(755) + lu(768) = lu(768) - lu(218) * lu(755) + lu(796) = lu(796) - lu(216) * lu(776) + lu(800) = lu(800) - lu(217) * lu(776) + lu(801) = lu(801) - lu(218) * lu(776) + lu(219) = 1._r8 / lu(219) + lu(220) = lu(220) * lu(219) + lu(221) = lu(221) * lu(219) + lu(222) = lu(222) * lu(219) + lu(223) = lu(223) * lu(219) + lu(224) = lu(224) * lu(219) + lu(633) = lu(633) - lu(220) * lu(605) + lu(634) = lu(634) - lu(221) * lu(605) + lu(635) = lu(635) - lu(222) * lu(605) + lu(636) = lu(636) - lu(223) * lu(605) + lu(638) = lu(638) - lu(224) * lu(605) + lu(683) = lu(683) - lu(220) * lu(660) + lu(684) = lu(684) - lu(221) * lu(660) + lu(685) = lu(685) - lu(222) * lu(660) + lu(686) = lu(686) - lu(223) * lu(660) + lu(688) = lu(688) - lu(224) * lu(660) + lu(713) = lu(713) - lu(220) * lu(696) + lu(714) = lu(714) - lu(221) * lu(696) + lu(715) = lu(715) - lu(222) * lu(696) + lu(716) = lu(716) - lu(223) * lu(696) + lu(718) = lu(718) - lu(224) * lu(696) + lu(762) = lu(762) - lu(220) * lu(756) + lu(763) = lu(763) - lu(221) * lu(756) + lu(764) = lu(764) - lu(222) * lu(756) + lu(765) = lu(765) - lu(223) * lu(756) + lu(767) = lu(767) - lu(224) * lu(756) + lu(225) = 1._r8 / lu(225) + lu(226) = lu(226) * lu(225) + lu(227) = lu(227) * lu(225) + lu(228) = lu(228) * lu(225) + lu(229) = lu(229) * lu(225) + lu(230) = lu(230) * lu(225) + lu(231) = lu(231) * lu(225) + lu(232) = lu(232) * lu(225) + lu(514) = - lu(226) * lu(513) + lu(516) = lu(516) - lu(227) * lu(513) + lu(517) = lu(517) - lu(228) * lu(513) + lu(519) = lu(519) - lu(229) * lu(513) + lu(520) = lu(520) - lu(230) * lu(513) + lu(523) = lu(523) - lu(231) * lu(513) + lu(524) = lu(524) - lu(232) * lu(513) + lu(624) = lu(624) - lu(226) * lu(606) + lu(627) = lu(627) - lu(227) * lu(606) + lu(632) = lu(632) - lu(228) * lu(606) + lu(634) = lu(634) - lu(229) * lu(606) + lu(635) = lu(635) - lu(230) * lu(606) + lu(638) = lu(638) - lu(231) * lu(606) + lu(639) = lu(639) - lu(232) * lu(606) + lu(758) = - lu(226) * lu(757) + lu(760) = lu(760) - lu(227) * lu(757) + lu(761) = lu(761) - lu(228) * lu(757) + lu(763) = lu(763) - lu(229) * lu(757) + lu(764) = lu(764) - lu(230) * lu(757) + lu(767) = lu(767) - lu(231) * lu(757) + lu(768) = lu(768) - lu(232) * lu(757) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(233) = 1._r8 / lu(233) + lu(234) = lu(234) * lu(233) + lu(235) = lu(235) * lu(233) + lu(236) = lu(236) * lu(233) + lu(237) = lu(237) * lu(233) + lu(238) = lu(238) * lu(233) + lu(239) = lu(239) * lu(233) + lu(240) = lu(240) * lu(233) + lu(495) = lu(495) - lu(234) * lu(492) + lu(497) = lu(497) - lu(235) * lu(492) + lu(498) = lu(498) - lu(236) * lu(492) + lu(499) = lu(499) - lu(237) * lu(492) + lu(501) = lu(501) - lu(238) * lu(492) + lu(504) = lu(504) - lu(239) * lu(492) + lu(505) = lu(505) - lu(240) * lu(492) + lu(625) = lu(625) - lu(234) * lu(607) + lu(627) = lu(627) - lu(235) * lu(607) + lu(628) = lu(628) - lu(236) * lu(607) + lu(629) = lu(629) - lu(237) * lu(607) + lu(631) = lu(631) - lu(238) * lu(607) + lu(634) = lu(634) - lu(239) * lu(607) + lu(635) = lu(635) - lu(240) * lu(607) + lu(675) = lu(675) - lu(234) * lu(661) + lu(677) = lu(677) - lu(235) * lu(661) + lu(678) = lu(678) - lu(236) * lu(661) + lu(679) = lu(679) - lu(237) * lu(661) + lu(681) = lu(681) - lu(238) * lu(661) + lu(684) = lu(684) - lu(239) * lu(661) + lu(685) = lu(685) - lu(240) * lu(661) + lu(241) = 1._r8 / lu(241) + lu(242) = lu(242) * lu(241) + lu(243) = lu(243) * lu(241) + lu(244) = lu(244) * lu(241) + lu(323) = lu(323) - lu(242) * lu(320) + lu(325) = lu(325) - lu(243) * lu(320) + lu(326) = lu(326) - lu(244) * lu(320) + lu(407) = lu(407) - lu(242) * lu(403) + lu(409) = lu(409) - lu(243) * lu(403) + lu(410) = lu(410) - lu(244) * lu(403) + lu(450) = lu(450) - lu(242) * lu(446) + lu(453) = lu(453) - lu(243) * lu(446) + lu(454) = lu(454) - lu(244) * lu(446) + lu(480) = lu(480) - lu(242) * lu(475) + lu(485) = lu(485) - lu(243) * lu(475) + lu(486) = lu(486) - lu(244) * lu(475) + lu(497) = lu(497) - lu(242) * lu(493) + lu(504) = lu(504) - lu(243) * lu(493) + lu(505) = lu(505) - lu(244) * lu(493) + lu(627) = lu(627) - lu(242) * lu(608) + lu(634) = lu(634) - lu(243) * lu(608) + lu(635) = lu(635) - lu(244) * lu(608) + lu(736) = lu(736) - lu(242) * lu(726) + lu(743) = lu(743) - lu(243) * lu(726) + lu(744) = lu(744) - lu(244) * lu(726) + lu(246) = 1._r8 / lu(246) + lu(247) = lu(247) * lu(246) + lu(248) = lu(248) * lu(246) + lu(249) = lu(249) * lu(246) + lu(450) = lu(450) - lu(247) * lu(447) + lu(453) = lu(453) - lu(248) * lu(447) + lu(454) = lu(454) - lu(249) * lu(447) + lu(480) = lu(480) - lu(247) * lu(476) + lu(485) = lu(485) - lu(248) * lu(476) + lu(486) = lu(486) - lu(249) * lu(476) + lu(552) = lu(552) - lu(247) * lu(537) + lu(559) = lu(559) - lu(248) * lu(537) + lu(560) = lu(560) - lu(249) * lu(537) + lu(627) = lu(627) - lu(247) * lu(609) + lu(634) = lu(634) - lu(248) * lu(609) + lu(635) = lu(635) - lu(249) * lu(609) + lu(707) = lu(707) - lu(247) * lu(697) + lu(714) = lu(714) - lu(248) * lu(697) + lu(715) = lu(715) - lu(249) * lu(697) + lu(736) = lu(736) - lu(247) * lu(727) + lu(743) = lu(743) - lu(248) * lu(727) + lu(744) = lu(744) - lu(249) * lu(727) + lu(789) = lu(789) - lu(247) * lu(777) + lu(796) = lu(796) - lu(248) * lu(777) + lu(797) = lu(797) - lu(249) * lu(777) + lu(811) = lu(811) - lu(247) * lu(807) + lu(818) = lu(818) - lu(248) * lu(807) + lu(819) = lu(819) - lu(249) * lu(807) + lu(250) = 1._r8 / lu(250) + lu(251) = lu(251) * lu(250) + lu(252) = lu(252) * lu(250) + lu(253) = lu(253) * lu(250) + lu(254) = lu(254) * lu(250) + lu(255) = lu(255) * lu(250) + lu(256) = lu(256) * lu(250) + lu(257) = lu(257) * lu(250) + lu(258) = lu(258) * lu(250) + lu(622) = lu(622) - lu(251) * lu(610) + lu(625) = lu(625) - lu(252) * lu(610) + lu(629) = lu(629) - lu(253) * lu(610) + lu(634) = lu(634) - lu(254) * lu(610) + lu(635) = lu(635) - lu(255) * lu(610) + lu(636) = lu(636) - lu(256) * lu(610) + lu(638) = lu(638) - lu(257) * lu(610) + lu(639) = lu(639) - lu(258) * lu(610) + lu(702) = - lu(251) * lu(698) + lu(705) = lu(705) - lu(252) * lu(698) + lu(709) = lu(709) - lu(253) * lu(698) + lu(714) = lu(714) - lu(254) * lu(698) + lu(715) = lu(715) - lu(255) * lu(698) + lu(716) = lu(716) - lu(256) * lu(698) + lu(718) = lu(718) - lu(257) * lu(698) + lu(719) = lu(719) - lu(258) * lu(698) + lu(784) = lu(784) - lu(251) * lu(778) + lu(787) = lu(787) - lu(252) * lu(778) + lu(791) = lu(791) - lu(253) * lu(778) + lu(796) = lu(796) - lu(254) * lu(778) + lu(797) = lu(797) - lu(255) * lu(778) + lu(798) = lu(798) - lu(256) * lu(778) + lu(800) = lu(800) - lu(257) * lu(778) + lu(801) = lu(801) - lu(258) * lu(778) + lu(260) = 1._r8 / lu(260) + lu(261) = lu(261) * lu(260) + lu(262) = lu(262) * lu(260) + lu(263) = lu(263) * lu(260) + lu(264) = lu(264) * lu(260) + lu(265) = lu(265) * lu(260) + lu(266) = lu(266) * lu(260) + lu(267) = lu(267) * lu(260) + lu(268) = lu(268) * lu(260) + lu(269) = lu(269) * lu(260) + lu(304) = lu(304) - lu(261) * lu(303) + lu(305) = lu(305) - lu(262) * lu(303) + lu(306) = lu(306) - lu(263) * lu(303) + lu(307) = lu(307) - lu(264) * lu(303) + lu(308) = lu(308) - lu(265) * lu(303) + lu(311) = lu(311) - lu(266) * lu(303) + lu(313) = lu(313) - lu(267) * lu(303) + lu(314) = lu(314) - lu(268) * lu(303) + lu(317) = lu(317) - lu(269) * lu(303) + lu(612) = lu(612) - lu(261) * lu(611) + lu(614) = lu(614) - lu(262) * lu(611) + lu(615) = lu(615) - lu(263) * lu(611) + lu(616) = lu(616) - lu(264) * lu(611) + lu(621) = lu(621) - lu(265) * lu(611) + lu(627) = lu(627) - lu(266) * lu(611) + lu(634) = lu(634) - lu(267) * lu(611) + lu(635) = lu(635) - lu(268) * lu(611) + lu(640) = lu(640) - lu(269) * lu(611) + lu(663) = lu(663) - lu(261) * lu(662) + lu(665) = lu(665) - lu(262) * lu(662) + lu(667) = lu(667) - lu(263) * lu(662) + lu(668) = lu(668) - lu(264) * lu(662) + lu(671) = lu(671) - lu(265) * lu(662) + lu(677) = lu(677) - lu(266) * lu(662) + lu(684) = lu(684) - lu(267) * lu(662) + lu(685) = lu(685) - lu(268) * lu(662) + lu(690) = lu(690) - lu(269) * lu(662) + lu(271) = 1._r8 / lu(271) + lu(272) = lu(272) * lu(271) + lu(273) = lu(273) * lu(271) + lu(274) = lu(274) * lu(271) + lu(275) = lu(275) * lu(271) + lu(276) = lu(276) * lu(271) + lu(277) = lu(277) * lu(271) + lu(308) = lu(308) - lu(272) * lu(304) + lu(312) = lu(312) - lu(273) * lu(304) + lu(313) = lu(313) - lu(274) * lu(304) + lu(314) = lu(314) - lu(275) * lu(304) + lu(316) = lu(316) - lu(276) * lu(304) + lu(317) = lu(317) - lu(277) * lu(304) + lu(546) = lu(546) - lu(272) * lu(538) + lu(558) = lu(558) - lu(273) * lu(538) + lu(559) = lu(559) - lu(274) * lu(538) + lu(560) = lu(560) - lu(275) * lu(538) + lu(563) = lu(563) - lu(276) * lu(538) + lu(565) = lu(565) - lu(277) * lu(538) + lu(621) = lu(621) - lu(272) * lu(612) + lu(633) = lu(633) - lu(273) * lu(612) + lu(634) = lu(634) - lu(274) * lu(612) + lu(635) = lu(635) - lu(275) * lu(612) + lu(638) = lu(638) - lu(276) * lu(612) + lu(640) = lu(640) - lu(277) * lu(612) + lu(671) = lu(671) - lu(272) * lu(663) + lu(683) = lu(683) - lu(273) * lu(663) + lu(684) = lu(684) - lu(274) * lu(663) + lu(685) = lu(685) - lu(275) * lu(663) + lu(688) = lu(688) - lu(276) * lu(663) + lu(690) = lu(690) - lu(277) * lu(663) + lu(279) = 1._r8 / lu(279) + lu(280) = lu(280) * lu(279) + lu(281) = lu(281) * lu(279) + lu(282) = lu(282) * lu(279) + lu(283) = lu(283) * lu(279) + lu(284) = lu(284) * lu(279) + lu(285) = lu(285) * lu(279) + lu(286) = lu(286) * lu(279) + lu(371) = lu(371) - lu(280) * lu(369) + lu(372) = - lu(281) * lu(369) + lu(374) = lu(374) - lu(282) * lu(369) + lu(375) = - lu(283) * lu(369) + lu(376) = lu(376) - lu(284) * lu(369) + lu(377) = lu(377) - lu(285) * lu(369) + lu(380) = lu(380) - lu(286) * lu(369) + lu(546) = lu(546) - lu(280) * lu(539) + lu(549) = lu(549) - lu(281) * lu(539) + lu(552) = lu(552) - lu(282) * lu(539) + lu(558) = lu(558) - lu(283) * lu(539) + lu(559) = lu(559) - lu(284) * lu(539) + lu(560) = lu(560) - lu(285) * lu(539) + lu(563) = lu(563) - lu(286) * lu(539) + lu(621) = lu(621) - lu(280) * lu(613) + lu(624) = lu(624) - lu(281) * lu(613) + lu(627) = lu(627) - lu(282) * lu(613) + lu(633) = lu(633) - lu(283) * lu(613) + lu(634) = lu(634) - lu(284) * lu(613) + lu(635) = lu(635) - lu(285) * lu(613) + lu(638) = lu(638) - lu(286) * lu(613) + lu(671) = lu(671) - lu(280) * lu(664) + lu(674) = lu(674) - lu(281) * lu(664) + lu(677) = lu(677) - lu(282) * lu(664) + lu(683) = lu(683) - lu(283) * lu(664) + lu(684) = lu(684) - lu(284) * lu(664) + lu(685) = lu(685) - lu(285) * lu(664) + lu(688) = lu(688) - lu(286) * lu(664) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(287) = 1._r8 / lu(287) + lu(288) = lu(288) * lu(287) + lu(289) = lu(289) * lu(287) + lu(290) = lu(290) * lu(287) + lu(291) = lu(291) * lu(287) + lu(309) = - lu(288) * lu(305) + lu(313) = lu(313) - lu(289) * lu(305) + lu(315) = - lu(290) * lu(305) + lu(317) = lu(317) - lu(291) * lu(305) + lu(333) = - lu(288) * lu(330) + lu(336) = lu(336) - lu(289) * lu(330) + lu(338) = lu(338) - lu(290) * lu(330) + lu(340) = - lu(291) * lu(330) + lu(393) = - lu(288) * lu(391) + lu(397) = lu(397) - lu(289) * lu(391) + lu(399) = - lu(290) * lu(391) + lu(401) = - lu(291) * lu(391) + lu(548) = lu(548) - lu(288) * lu(540) + lu(559) = lu(559) - lu(289) * lu(540) + lu(562) = lu(562) - lu(290) * lu(540) + lu(565) = lu(565) - lu(291) * lu(540) + lu(623) = lu(623) - lu(288) * lu(614) + lu(634) = lu(634) - lu(289) * lu(614) + lu(637) = lu(637) - lu(290) * lu(614) + lu(640) = lu(640) - lu(291) * lu(614) + lu(673) = lu(673) - lu(288) * lu(665) + lu(684) = lu(684) - lu(289) * lu(665) + lu(687) = lu(687) - lu(290) * lu(665) + lu(690) = lu(690) - lu(291) * lu(665) + lu(732) = lu(732) - lu(288) * lu(728) + lu(743) = lu(743) - lu(289) * lu(728) + lu(746) = lu(746) - lu(290) * lu(728) + lu(749) = lu(749) - lu(291) * lu(728) + lu(292) = 1._r8 / lu(292) + lu(293) = lu(293) * lu(292) + lu(294) = lu(294) * lu(292) + lu(295) = lu(295) * lu(292) + lu(296) = lu(296) * lu(292) + lu(297) = lu(297) * lu(292) + lu(298) = lu(298) * lu(292) + lu(299) = lu(299) * lu(292) + lu(300) = lu(300) * lu(292) + lu(351) = - lu(293) * lu(350) + lu(354) = lu(354) - lu(294) * lu(350) + lu(355) = lu(355) - lu(295) * lu(350) + lu(357) = lu(357) - lu(296) * lu(350) + lu(360) = - lu(297) * lu(350) + lu(362) = lu(362) - lu(298) * lu(350) + lu(365) = - lu(299) * lu(350) + lu(366) = lu(366) - lu(300) * lu(350) + lu(545) = lu(545) - lu(293) * lu(541) + lu(550) = lu(550) - lu(294) * lu(541) + lu(552) = lu(552) - lu(295) * lu(541) + lu(554) = lu(554) - lu(296) * lu(541) + lu(558) = lu(558) - lu(297) * lu(541) + lu(560) = lu(560) - lu(298) * lu(541) + lu(563) = lu(563) - lu(299) * lu(541) + lu(564) = lu(564) - lu(300) * lu(541) + lu(670) = lu(670) - lu(293) * lu(666) + lu(675) = lu(675) - lu(294) * lu(666) + lu(677) = lu(677) - lu(295) * lu(666) + lu(679) = lu(679) - lu(296) * lu(666) + lu(683) = lu(683) - lu(297) * lu(666) + lu(685) = lu(685) - lu(298) * lu(666) + lu(688) = lu(688) - lu(299) * lu(666) + lu(689) = lu(689) - lu(300) * lu(666) + lu(780) = lu(780) - lu(293) * lu(779) + lu(787) = lu(787) - lu(294) * lu(779) + lu(789) = lu(789) - lu(295) * lu(779) + lu(791) = lu(791) - lu(296) * lu(779) + lu(795) = lu(795) - lu(297) * lu(779) + lu(797) = lu(797) - lu(298) * lu(779) + lu(800) = lu(800) - lu(299) * lu(779) + lu(801) = lu(801) - lu(300) * lu(779) + lu(306) = 1._r8 / lu(306) + lu(307) = lu(307) * lu(306) + lu(308) = lu(308) * lu(306) + lu(309) = lu(309) * lu(306) + lu(310) = lu(310) * lu(306) + lu(311) = lu(311) * lu(306) + lu(312) = lu(312) * lu(306) + lu(313) = lu(313) * lu(306) + lu(314) = lu(314) * lu(306) + lu(315) = lu(315) * lu(306) + lu(316) = lu(316) * lu(306) + lu(317) = lu(317) * lu(306) + lu(543) = lu(543) - lu(307) * lu(542) + lu(546) = lu(546) - lu(308) * lu(542) + lu(548) = lu(548) - lu(309) * lu(542) + lu(551) = lu(551) - lu(310) * lu(542) + lu(552) = lu(552) - lu(311) * lu(542) + lu(558) = lu(558) - lu(312) * lu(542) + lu(559) = lu(559) - lu(313) * lu(542) + lu(560) = lu(560) - lu(314) * lu(542) + lu(562) = lu(562) - lu(315) * lu(542) + lu(563) = lu(563) - lu(316) * lu(542) + lu(565) = lu(565) - lu(317) * lu(542) + lu(616) = lu(616) - lu(307) * lu(615) + lu(621) = lu(621) - lu(308) * lu(615) + lu(623) = lu(623) - lu(309) * lu(615) + lu(626) = lu(626) - lu(310) * lu(615) + lu(627) = lu(627) - lu(311) * lu(615) + lu(633) = lu(633) - lu(312) * lu(615) + lu(634) = lu(634) - lu(313) * lu(615) + lu(635) = lu(635) - lu(314) * lu(615) + lu(637) = lu(637) - lu(315) * lu(615) + lu(638) = lu(638) - lu(316) * lu(615) + lu(640) = lu(640) - lu(317) * lu(615) + lu(668) = lu(668) - lu(307) * lu(667) + lu(671) = lu(671) - lu(308) * lu(667) + lu(673) = lu(673) - lu(309) * lu(667) + lu(676) = lu(676) - lu(310) * lu(667) + lu(677) = lu(677) - lu(311) * lu(667) + lu(683) = lu(683) - lu(312) * lu(667) + lu(684) = lu(684) - lu(313) * lu(667) + lu(685) = lu(685) - lu(314) * lu(667) + lu(687) = lu(687) - lu(315) * lu(667) + lu(688) = lu(688) - lu(316) * lu(667) + lu(690) = lu(690) - lu(317) * lu(667) + lu(321) = 1._r8 / lu(321) + lu(322) = lu(322) * lu(321) + lu(323) = lu(323) * lu(321) + lu(324) = lu(324) * lu(321) + lu(325) = lu(325) * lu(321) + lu(326) = lu(326) * lu(321) + lu(327) = lu(327) * lu(321) + lu(328) = lu(328) * lu(321) + lu(546) = lu(546) - lu(322) * lu(543) + lu(552) = lu(552) - lu(323) * lu(543) + lu(558) = lu(558) - lu(324) * lu(543) + lu(559) = lu(559) - lu(325) * lu(543) + lu(560) = lu(560) - lu(326) * lu(543) + lu(562) = lu(562) - lu(327) * lu(543) + lu(563) = lu(563) - lu(328) * lu(543) + lu(621) = lu(621) - lu(322) * lu(616) + lu(627) = lu(627) - lu(323) * lu(616) + lu(633) = lu(633) - lu(324) * lu(616) + lu(634) = lu(634) - lu(325) * lu(616) + lu(635) = lu(635) - lu(326) * lu(616) + lu(637) = lu(637) - lu(327) * lu(616) + lu(638) = lu(638) - lu(328) * lu(616) + lu(671) = lu(671) - lu(322) * lu(668) + lu(677) = lu(677) - lu(323) * lu(668) + lu(683) = lu(683) - lu(324) * lu(668) + lu(684) = lu(684) - lu(325) * lu(668) + lu(685) = lu(685) - lu(326) * lu(668) + lu(687) = lu(687) - lu(327) * lu(668) + lu(688) = lu(688) - lu(328) * lu(668) + lu(731) = lu(731) - lu(322) * lu(729) + lu(736) = lu(736) - lu(323) * lu(729) + lu(742) = lu(742) - lu(324) * lu(729) + lu(743) = lu(743) - lu(325) * lu(729) + lu(744) = lu(744) - lu(326) * lu(729) + lu(746) = lu(746) - lu(327) * lu(729) + lu(747) = lu(747) - lu(328) * lu(729) + lu(331) = 1._r8 / lu(331) + lu(332) = lu(332) * lu(331) + lu(333) = lu(333) * lu(331) + lu(334) = lu(334) * lu(331) + lu(335) = lu(335) * lu(331) + lu(336) = lu(336) * lu(331) + lu(337) = lu(337) * lu(331) + lu(338) = lu(338) * lu(331) + lu(339) = lu(339) * lu(331) + lu(340) = lu(340) * lu(331) + lu(546) = lu(546) - lu(332) * lu(544) + lu(548) = lu(548) - lu(333) * lu(544) + lu(552) = lu(552) - lu(334) * lu(544) + lu(558) = lu(558) - lu(335) * lu(544) + lu(559) = lu(559) - lu(336) * lu(544) + lu(560) = lu(560) - lu(337) * lu(544) + lu(562) = lu(562) - lu(338) * lu(544) + lu(563) = lu(563) - lu(339) * lu(544) + lu(565) = lu(565) - lu(340) * lu(544) + lu(621) = lu(621) - lu(332) * lu(617) + lu(623) = lu(623) - lu(333) * lu(617) + lu(627) = lu(627) - lu(334) * lu(617) + lu(633) = lu(633) - lu(335) * lu(617) + lu(634) = lu(634) - lu(336) * lu(617) + lu(635) = lu(635) - lu(337) * lu(617) + lu(637) = lu(637) - lu(338) * lu(617) + lu(638) = lu(638) - lu(339) * lu(617) + lu(640) = lu(640) - lu(340) * lu(617) + lu(671) = lu(671) - lu(332) * lu(669) + lu(673) = lu(673) - lu(333) * lu(669) + lu(677) = lu(677) - lu(334) * lu(669) + lu(683) = lu(683) - lu(335) * lu(669) + lu(684) = lu(684) - lu(336) * lu(669) + lu(685) = lu(685) - lu(337) * lu(669) + lu(687) = lu(687) - lu(338) * lu(669) + lu(688) = lu(688) - lu(339) * lu(669) + lu(690) = lu(690) - lu(340) * lu(669) + lu(731) = lu(731) - lu(332) * lu(730) + lu(732) = lu(732) - lu(333) * lu(730) + lu(736) = lu(736) - lu(334) * lu(730) + lu(742) = lu(742) - lu(335) * lu(730) + lu(743) = lu(743) - lu(336) * lu(730) + lu(744) = lu(744) - lu(337) * lu(730) + lu(746) = lu(746) - lu(338) * lu(730) + lu(747) = lu(747) - lu(339) * lu(730) + lu(749) = lu(749) - lu(340) * lu(730) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(342) = 1._r8 / lu(342) + lu(343) = lu(343) * lu(342) + lu(344) = lu(344) * lu(342) + lu(345) = lu(345) * lu(342) + lu(346) = lu(346) * lu(342) + lu(347) = lu(347) * lu(342) + lu(348) = lu(348) * lu(342) + lu(355) = lu(355) - lu(343) * lu(351) + lu(356) = - lu(344) * lu(351) + lu(361) = lu(361) - lu(345) * lu(351) + lu(362) = lu(362) - lu(346) * lu(351) + lu(365) = lu(365) - lu(347) * lu(351) + lu(366) = lu(366) - lu(348) * lu(351) + lu(480) = lu(480) - lu(343) * lu(477) + lu(481) = - lu(344) * lu(477) + lu(485) = lu(485) - lu(345) * lu(477) + lu(486) = lu(486) - lu(346) * lu(477) + lu(488) = lu(488) - lu(347) * lu(477) + lu(489) = lu(489) - lu(348) * lu(477) + lu(497) = lu(497) - lu(343) * lu(494) + lu(498) = lu(498) - lu(344) * lu(494) + lu(504) = lu(504) - lu(345) * lu(494) + lu(505) = lu(505) - lu(346) * lu(494) + lu(508) = lu(508) - lu(347) * lu(494) + lu(509) = lu(509) - lu(348) * lu(494) + lu(552) = lu(552) - lu(343) * lu(545) + lu(553) = lu(553) - lu(344) * lu(545) + lu(559) = lu(559) - lu(345) * lu(545) + lu(560) = lu(560) - lu(346) * lu(545) + lu(563) = lu(563) - lu(347) * lu(545) + lu(564) = lu(564) - lu(348) * lu(545) + lu(627) = lu(627) - lu(343) * lu(618) + lu(628) = lu(628) - lu(344) * lu(618) + lu(634) = lu(634) - lu(345) * lu(618) + lu(635) = lu(635) - lu(346) * lu(618) + lu(638) = lu(638) - lu(347) * lu(618) + lu(639) = lu(639) - lu(348) * lu(618) + lu(677) = lu(677) - lu(343) * lu(670) + lu(678) = lu(678) - lu(344) * lu(670) + lu(684) = lu(684) - lu(345) * lu(670) + lu(685) = lu(685) - lu(346) * lu(670) + lu(688) = lu(688) - lu(347) * lu(670) + lu(689) = lu(689) - lu(348) * lu(670) + lu(789) = lu(789) - lu(343) * lu(780) + lu(790) = lu(790) - lu(344) * lu(780) + lu(796) = lu(796) - lu(345) * lu(780) + lu(797) = lu(797) - lu(346) * lu(780) + lu(800) = lu(800) - lu(347) * lu(780) + lu(801) = lu(801) - lu(348) * lu(780) + lu(352) = 1._r8 / lu(352) + lu(353) = lu(353) * lu(352) + lu(354) = lu(354) * lu(352) + lu(355) = lu(355) * lu(352) + lu(356) = lu(356) * lu(352) + lu(357) = lu(357) * lu(352) + lu(358) = lu(358) * lu(352) + lu(359) = lu(359) * lu(352) + lu(360) = lu(360) * lu(352) + lu(361) = lu(361) * lu(352) + lu(362) = lu(362) * lu(352) + lu(363) = lu(363) * lu(352) + lu(364) = lu(364) * lu(352) + lu(365) = lu(365) * lu(352) + lu(366) = lu(366) * lu(352) + lu(620) = lu(620) - lu(353) * lu(619) + lu(625) = lu(625) - lu(354) * lu(619) + lu(627) = lu(627) - lu(355) * lu(619) + lu(628) = lu(628) - lu(356) * lu(619) + lu(629) = lu(629) - lu(357) * lu(619) + lu(631) = lu(631) - lu(358) * lu(619) + lu(632) = lu(632) - lu(359) * lu(619) + lu(633) = lu(633) - lu(360) * lu(619) + lu(634) = lu(634) - lu(361) * lu(619) + lu(635) = lu(635) - lu(362) * lu(619) + lu(636) = lu(636) - lu(363) * lu(619) + lu(637) = lu(637) - lu(364) * lu(619) + lu(638) = lu(638) - lu(365) * lu(619) + lu(639) = lu(639) - lu(366) * lu(619) + lu(700) = lu(700) - lu(353) * lu(699) + lu(705) = lu(705) - lu(354) * lu(699) + lu(707) = lu(707) - lu(355) * lu(699) + lu(708) = - lu(356) * lu(699) + lu(709) = lu(709) - lu(357) * lu(699) + lu(711) = - lu(358) * lu(699) + lu(712) = lu(712) - lu(359) * lu(699) + lu(713) = lu(713) - lu(360) * lu(699) + lu(714) = lu(714) - lu(361) * lu(699) + lu(715) = lu(715) - lu(362) * lu(699) + lu(716) = lu(716) - lu(363) * lu(699) + lu(717) = lu(717) - lu(364) * lu(699) + lu(718) = lu(718) - lu(365) * lu(699) + lu(719) = lu(719) - lu(366) * lu(699) + lu(782) = lu(782) - lu(353) * lu(781) + lu(787) = lu(787) - lu(354) * lu(781) + lu(789) = lu(789) - lu(355) * lu(781) + lu(790) = lu(790) - lu(356) * lu(781) + lu(791) = lu(791) - lu(357) * lu(781) + lu(793) = lu(793) - lu(358) * lu(781) + lu(794) = lu(794) - lu(359) * lu(781) + lu(795) = lu(795) - lu(360) * lu(781) + lu(796) = lu(796) - lu(361) * lu(781) + lu(797) = lu(797) - lu(362) * lu(781) + lu(798) = lu(798) - lu(363) * lu(781) + lu(799) = - lu(364) * lu(781) + lu(800) = lu(800) - lu(365) * lu(781) + lu(801) = lu(801) - lu(366) * lu(781) + lu(370) = 1._r8 / lu(370) + lu(371) = lu(371) * lu(370) + lu(372) = lu(372) * lu(370) + lu(373) = lu(373) * lu(370) + lu(374) = lu(374) * lu(370) + lu(375) = lu(375) * lu(370) + lu(376) = lu(376) * lu(370) + lu(377) = lu(377) * lu(370) + lu(378) = lu(378) * lu(370) + lu(379) = lu(379) * lu(370) + lu(380) = lu(380) * lu(370) + lu(381) = lu(381) * lu(370) + lu(460) = lu(460) - lu(371) * lu(459) + lu(461) = - lu(372) * lu(459) + lu(462) = lu(462) - lu(373) * lu(459) + lu(463) = lu(463) - lu(374) * lu(459) + lu(466) = - lu(375) * lu(459) + lu(467) = lu(467) - lu(376) * lu(459) + lu(468) = lu(468) - lu(377) * lu(459) + lu(469) = lu(469) - lu(378) * lu(459) + lu(470) = lu(470) - lu(379) * lu(459) + lu(471) = - lu(380) * lu(459) + lu(472) = - lu(381) * lu(459) + lu(621) = lu(621) - lu(371) * lu(620) + lu(624) = lu(624) - lu(372) * lu(620) + lu(626) = lu(626) - lu(373) * lu(620) + lu(627) = lu(627) - lu(374) * lu(620) + lu(633) = lu(633) - lu(375) * lu(620) + lu(634) = lu(634) - lu(376) * lu(620) + lu(635) = lu(635) - lu(377) * lu(620) + lu(636) = lu(636) - lu(378) * lu(620) + lu(637) = lu(637) - lu(379) * lu(620) + lu(638) = lu(638) - lu(380) * lu(620) + lu(639) = lu(639) - lu(381) * lu(620) + lu(701) = lu(701) - lu(371) * lu(700) + lu(704) = - lu(372) * lu(700) + lu(706) = lu(706) - lu(373) * lu(700) + lu(707) = lu(707) - lu(374) * lu(700) + lu(713) = lu(713) - lu(375) * lu(700) + lu(714) = lu(714) - lu(376) * lu(700) + lu(715) = lu(715) - lu(377) * lu(700) + lu(716) = lu(716) - lu(378) * lu(700) + lu(717) = lu(717) - lu(379) * lu(700) + lu(718) = lu(718) - lu(380) * lu(700) + lu(719) = lu(719) - lu(381) * lu(700) + lu(783) = lu(783) - lu(371) * lu(782) + lu(786) = lu(786) - lu(372) * lu(782) + lu(788) = lu(788) - lu(373) * lu(782) + lu(789) = lu(789) - lu(374) * lu(782) + lu(795) = lu(795) - lu(375) * lu(782) + lu(796) = lu(796) - lu(376) * lu(782) + lu(797) = lu(797) - lu(377) * lu(782) + lu(798) = lu(798) - lu(378) * lu(782) + lu(799) = lu(799) - lu(379) * lu(782) + lu(800) = lu(800) - lu(380) * lu(782) + lu(801) = lu(801) - lu(381) * lu(782) + lu(383) = 1._r8 / lu(383) + lu(384) = lu(384) * lu(383) + lu(385) = lu(385) * lu(383) + lu(386) = lu(386) * lu(383) + lu(387) = lu(387) * lu(383) + lu(388) = lu(388) * lu(383) + lu(389) = lu(389) * lu(383) + lu(467) = lu(467) - lu(384) * lu(460) + lu(468) = lu(468) - lu(385) * lu(460) + lu(470) = lu(470) - lu(386) * lu(460) + lu(471) = lu(471) - lu(387) * lu(460) + lu(472) = lu(472) - lu(388) * lu(460) + lu(473) = lu(473) - lu(389) * lu(460) + lu(559) = lu(559) - lu(384) * lu(546) + lu(560) = lu(560) - lu(385) * lu(546) + lu(562) = lu(562) - lu(386) * lu(546) + lu(563) = lu(563) - lu(387) * lu(546) + lu(564) = lu(564) - lu(388) * lu(546) + lu(565) = lu(565) - lu(389) * lu(546) + lu(634) = lu(634) - lu(384) * lu(621) + lu(635) = lu(635) - lu(385) * lu(621) + lu(637) = lu(637) - lu(386) * lu(621) + lu(638) = lu(638) - lu(387) * lu(621) + lu(639) = lu(639) - lu(388) * lu(621) + lu(640) = lu(640) - lu(389) * lu(621) + lu(684) = lu(684) - lu(384) * lu(671) + lu(685) = lu(685) - lu(385) * lu(671) + lu(687) = lu(687) - lu(386) * lu(671) + lu(688) = lu(688) - lu(387) * lu(671) + lu(689) = lu(689) - lu(388) * lu(671) + lu(690) = lu(690) - lu(389) * lu(671) + lu(714) = lu(714) - lu(384) * lu(701) + lu(715) = lu(715) - lu(385) * lu(701) + lu(717) = lu(717) - lu(386) * lu(701) + lu(718) = lu(718) - lu(387) * lu(701) + lu(719) = lu(719) - lu(388) * lu(701) + lu(720) = - lu(389) * lu(701) + lu(743) = lu(743) - lu(384) * lu(731) + lu(744) = lu(744) - lu(385) * lu(731) + lu(746) = lu(746) - lu(386) * lu(731) + lu(747) = lu(747) - lu(387) * lu(731) + lu(748) = - lu(388) * lu(731) + lu(749) = lu(749) - lu(389) * lu(731) + lu(796) = lu(796) - lu(384) * lu(783) + lu(797) = lu(797) - lu(385) * lu(783) + lu(799) = lu(799) - lu(386) * lu(783) + lu(800) = lu(800) - lu(387) * lu(783) + lu(801) = lu(801) - lu(388) * lu(783) + lu(802) = lu(802) - lu(389) * lu(783) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(392) = 1._r8 / lu(392) + lu(393) = lu(393) * lu(392) + lu(394) = lu(394) * lu(392) + lu(395) = lu(395) * lu(392) + lu(396) = lu(396) * lu(392) + lu(397) = lu(397) * lu(392) + lu(398) = lu(398) * lu(392) + lu(399) = lu(399) * lu(392) + lu(400) = lu(400) * lu(392) + lu(401) = lu(401) * lu(392) + lu(548) = lu(548) - lu(393) * lu(547) + lu(550) = lu(550) - lu(394) * lu(547) + lu(554) = lu(554) - lu(395) * lu(547) + lu(558) = lu(558) - lu(396) * lu(547) + lu(559) = lu(559) - lu(397) * lu(547) + lu(560) = lu(560) - lu(398) * lu(547) + lu(562) = lu(562) - lu(399) * lu(547) + lu(563) = lu(563) - lu(400) * lu(547) + lu(565) = lu(565) - lu(401) * lu(547) + lu(623) = lu(623) - lu(393) * lu(622) + lu(625) = lu(625) - lu(394) * lu(622) + lu(629) = lu(629) - lu(395) * lu(622) + lu(633) = lu(633) - lu(396) * lu(622) + lu(634) = lu(634) - lu(397) * lu(622) + lu(635) = lu(635) - lu(398) * lu(622) + lu(637) = lu(637) - lu(399) * lu(622) + lu(638) = lu(638) - lu(400) * lu(622) + lu(640) = lu(640) - lu(401) * lu(622) + lu(673) = lu(673) - lu(393) * lu(672) + lu(675) = lu(675) - lu(394) * lu(672) + lu(679) = lu(679) - lu(395) * lu(672) + lu(683) = lu(683) - lu(396) * lu(672) + lu(684) = lu(684) - lu(397) * lu(672) + lu(685) = lu(685) - lu(398) * lu(672) + lu(687) = lu(687) - lu(399) * lu(672) + lu(688) = lu(688) - lu(400) * lu(672) + lu(690) = lu(690) - lu(401) * lu(672) + lu(703) = - lu(393) * lu(702) + lu(705) = lu(705) - lu(394) * lu(702) + lu(709) = lu(709) - lu(395) * lu(702) + lu(713) = lu(713) - lu(396) * lu(702) + lu(714) = lu(714) - lu(397) * lu(702) + lu(715) = lu(715) - lu(398) * lu(702) + lu(717) = lu(717) - lu(399) * lu(702) + lu(718) = lu(718) - lu(400) * lu(702) + lu(720) = lu(720) - lu(401) * lu(702) + lu(785) = - lu(393) * lu(784) + lu(787) = lu(787) - lu(394) * lu(784) + lu(791) = lu(791) - lu(395) * lu(784) + lu(795) = lu(795) - lu(396) * lu(784) + lu(796) = lu(796) - lu(397) * lu(784) + lu(797) = lu(797) - lu(398) * lu(784) + lu(799) = lu(799) - lu(399) * lu(784) + lu(800) = lu(800) - lu(400) * lu(784) + lu(802) = lu(802) - lu(401) * lu(784) + lu(404) = 1._r8 / lu(404) + lu(405) = lu(405) * lu(404) + lu(406) = lu(406) * lu(404) + lu(407) = lu(407) * lu(404) + lu(408) = lu(408) * lu(404) + lu(409) = lu(409) * lu(404) + lu(410) = lu(410) * lu(404) + lu(411) = lu(411) * lu(404) + lu(412) = lu(412) * lu(404) + lu(413) = lu(413) * lu(404) + lu(549) = lu(549) - lu(405) * lu(548) + lu(551) = lu(551) - lu(406) * lu(548) + lu(552) = lu(552) - lu(407) * lu(548) + lu(558) = lu(558) - lu(408) * lu(548) + lu(559) = lu(559) - lu(409) * lu(548) + lu(560) = lu(560) - lu(410) * lu(548) + lu(562) = lu(562) - lu(411) * lu(548) + lu(563) = lu(563) - lu(412) * lu(548) + lu(565) = lu(565) - lu(413) * lu(548) + lu(624) = lu(624) - lu(405) * lu(623) + lu(626) = lu(626) - lu(406) * lu(623) + lu(627) = lu(627) - lu(407) * lu(623) + lu(633) = lu(633) - lu(408) * lu(623) + lu(634) = lu(634) - lu(409) * lu(623) + lu(635) = lu(635) - lu(410) * lu(623) + lu(637) = lu(637) - lu(411) * lu(623) + lu(638) = lu(638) - lu(412) * lu(623) + lu(640) = lu(640) - lu(413) * lu(623) + lu(674) = lu(674) - lu(405) * lu(673) + lu(676) = lu(676) - lu(406) * lu(673) + lu(677) = lu(677) - lu(407) * lu(673) + lu(683) = lu(683) - lu(408) * lu(673) + lu(684) = lu(684) - lu(409) * lu(673) + lu(685) = lu(685) - lu(410) * lu(673) + lu(687) = lu(687) - lu(411) * lu(673) + lu(688) = lu(688) - lu(412) * lu(673) + lu(690) = lu(690) - lu(413) * lu(673) + lu(704) = lu(704) - lu(405) * lu(703) + lu(706) = lu(706) - lu(406) * lu(703) + lu(707) = lu(707) - lu(407) * lu(703) + lu(713) = lu(713) - lu(408) * lu(703) + lu(714) = lu(714) - lu(409) * lu(703) + lu(715) = lu(715) - lu(410) * lu(703) + lu(717) = lu(717) - lu(411) * lu(703) + lu(718) = lu(718) - lu(412) * lu(703) + lu(720) = lu(720) - lu(413) * lu(703) + lu(733) = lu(733) - lu(405) * lu(732) + lu(735) = lu(735) - lu(406) * lu(732) + lu(736) = lu(736) - lu(407) * lu(732) + lu(742) = lu(742) - lu(408) * lu(732) + lu(743) = lu(743) - lu(409) * lu(732) + lu(744) = lu(744) - lu(410) * lu(732) + lu(746) = lu(746) - lu(411) * lu(732) + lu(747) = lu(747) - lu(412) * lu(732) + lu(749) = lu(749) - lu(413) * lu(732) + lu(786) = lu(786) - lu(405) * lu(785) + lu(788) = lu(788) - lu(406) * lu(785) + lu(789) = lu(789) - lu(407) * lu(785) + lu(795) = lu(795) - lu(408) * lu(785) + lu(796) = lu(796) - lu(409) * lu(785) + lu(797) = lu(797) - lu(410) * lu(785) + lu(799) = lu(799) - lu(411) * lu(785) + lu(800) = lu(800) - lu(412) * lu(785) + lu(802) = lu(802) - lu(413) * lu(785) + lu(414) = 1._r8 / lu(414) + lu(415) = lu(415) * lu(414) + lu(416) = lu(416) * lu(414) + lu(417) = lu(417) * lu(414) + lu(418) = lu(418) * lu(414) + lu(419) = lu(419) * lu(414) + lu(449) = lu(449) - lu(415) * lu(448) + lu(450) = lu(450) - lu(416) * lu(448) + lu(453) = lu(453) - lu(417) * lu(448) + lu(454) = lu(454) - lu(418) * lu(448) + lu(458) = lu(458) - lu(419) * lu(448) + lu(462) = lu(462) - lu(415) * lu(461) + lu(463) = lu(463) - lu(416) * lu(461) + lu(467) = lu(467) - lu(417) * lu(461) + lu(468) = lu(468) - lu(418) * lu(461) + lu(473) = lu(473) - lu(419) * lu(461) + lu(479) = lu(479) - lu(415) * lu(478) + lu(480) = lu(480) - lu(416) * lu(478) + lu(485) = lu(485) - lu(417) * lu(478) + lu(486) = lu(486) - lu(418) * lu(478) + lu(490) = lu(490) - lu(419) * lu(478) + lu(515) = - lu(415) * lu(514) + lu(516) = lu(516) - lu(416) * lu(514) + lu(519) = lu(519) - lu(417) * lu(514) + lu(520) = lu(520) - lu(418) * lu(514) + lu(525) = lu(525) - lu(419) * lu(514) + lu(551) = lu(551) - lu(415) * lu(549) + lu(552) = lu(552) - lu(416) * lu(549) + lu(559) = lu(559) - lu(417) * lu(549) + lu(560) = lu(560) - lu(418) * lu(549) + lu(565) = lu(565) - lu(419) * lu(549) + lu(626) = lu(626) - lu(415) * lu(624) + lu(627) = lu(627) - lu(416) * lu(624) + lu(634) = lu(634) - lu(417) * lu(624) + lu(635) = lu(635) - lu(418) * lu(624) + lu(640) = lu(640) - lu(419) * lu(624) + lu(676) = lu(676) - lu(415) * lu(674) + lu(677) = lu(677) - lu(416) * lu(674) + lu(684) = lu(684) - lu(417) * lu(674) + lu(685) = lu(685) - lu(418) * lu(674) + lu(690) = lu(690) - lu(419) * lu(674) + lu(706) = lu(706) - lu(415) * lu(704) + lu(707) = lu(707) - lu(416) * lu(704) + lu(714) = lu(714) - lu(417) * lu(704) + lu(715) = lu(715) - lu(418) * lu(704) + lu(720) = lu(720) - lu(419) * lu(704) + lu(735) = lu(735) - lu(415) * lu(733) + lu(736) = lu(736) - lu(416) * lu(733) + lu(743) = lu(743) - lu(417) * lu(733) + lu(744) = lu(744) - lu(418) * lu(733) + lu(749) = lu(749) - lu(419) * lu(733) + lu(759) = lu(759) - lu(415) * lu(758) + lu(760) = lu(760) - lu(416) * lu(758) + lu(763) = lu(763) - lu(417) * lu(758) + lu(764) = lu(764) - lu(418) * lu(758) + lu(769) = lu(769) - lu(419) * lu(758) + lu(788) = lu(788) - lu(415) * lu(786) + lu(789) = lu(789) - lu(416) * lu(786) + lu(796) = lu(796) - lu(417) * lu(786) + lu(797) = lu(797) - lu(418) * lu(786) + lu(802) = lu(802) - lu(419) * lu(786) + lu(810) = lu(810) - lu(415) * lu(808) + lu(811) = lu(811) - lu(416) * lu(808) + lu(818) = lu(818) - lu(417) * lu(808) + lu(819) = lu(819) - lu(418) * lu(808) + lu(824) = lu(824) - lu(419) * lu(808) + lu(420) = 1._r8 / lu(420) + lu(421) = lu(421) * lu(420) + lu(422) = lu(422) * lu(420) + lu(423) = lu(423) * lu(420) + lu(424) = lu(424) * lu(420) + lu(425) = lu(425) * lu(420) + lu(426) = lu(426) * lu(420) + lu(427) = lu(427) * lu(420) + lu(428) = lu(428) * lu(420) + lu(496) = - lu(421) * lu(495) + lu(497) = lu(497) - lu(422) * lu(495) + lu(500) = - lu(423) * lu(495) + lu(502) = - lu(424) * lu(495) + lu(504) = lu(504) - lu(425) * lu(495) + lu(505) = lu(505) - lu(426) * lu(495) + lu(506) = - lu(427) * lu(495) + lu(510) = lu(510) - lu(428) * lu(495) + lu(551) = lu(551) - lu(421) * lu(550) + lu(552) = lu(552) - lu(422) * lu(550) + lu(555) = lu(555) - lu(423) * lu(550) + lu(557) = lu(557) - lu(424) * lu(550) + lu(559) = lu(559) - lu(425) * lu(550) + lu(560) = lu(560) - lu(426) * lu(550) + lu(561) = lu(561) - lu(427) * lu(550) + lu(565) = lu(565) - lu(428) * lu(550) + lu(626) = lu(626) - lu(421) * lu(625) + lu(627) = lu(627) - lu(422) * lu(625) + lu(630) = lu(630) - lu(423) * lu(625) + lu(632) = lu(632) - lu(424) * lu(625) + lu(634) = lu(634) - lu(425) * lu(625) + lu(635) = lu(635) - lu(426) * lu(625) + lu(636) = lu(636) - lu(427) * lu(625) + lu(640) = lu(640) - lu(428) * lu(625) + lu(676) = lu(676) - lu(421) * lu(675) + lu(677) = lu(677) - lu(422) * lu(675) + lu(680) = lu(680) - lu(423) * lu(675) + lu(682) = lu(682) - lu(424) * lu(675) + lu(684) = lu(684) - lu(425) * lu(675) + lu(685) = lu(685) - lu(426) * lu(675) + lu(686) = lu(686) - lu(427) * lu(675) + lu(690) = lu(690) - lu(428) * lu(675) + lu(706) = lu(706) - lu(421) * lu(705) + lu(707) = lu(707) - lu(422) * lu(705) + lu(710) = - lu(423) * lu(705) + lu(712) = lu(712) - lu(424) * lu(705) + lu(714) = lu(714) - lu(425) * lu(705) + lu(715) = lu(715) - lu(426) * lu(705) + lu(716) = lu(716) - lu(427) * lu(705) + lu(720) = lu(720) - lu(428) * lu(705) + lu(735) = lu(735) - lu(421) * lu(734) + lu(736) = lu(736) - lu(422) * lu(734) + lu(739) = lu(739) - lu(423) * lu(734) + lu(741) = lu(741) - lu(424) * lu(734) + lu(743) = lu(743) - lu(425) * lu(734) + lu(744) = lu(744) - lu(426) * lu(734) + lu(745) = - lu(427) * lu(734) + lu(749) = lu(749) - lu(428) * lu(734) + lu(788) = lu(788) - lu(421) * lu(787) + lu(789) = lu(789) - lu(422) * lu(787) + lu(792) = lu(792) - lu(423) * lu(787) + lu(794) = lu(794) - lu(424) * lu(787) + lu(796) = lu(796) - lu(425) * lu(787) + lu(797) = lu(797) - lu(426) * lu(787) + lu(798) = lu(798) - lu(427) * lu(787) + lu(802) = lu(802) - lu(428) * lu(787) + lu(810) = lu(810) - lu(421) * lu(809) + lu(811) = lu(811) - lu(422) * lu(809) + lu(814) = lu(814) - lu(423) * lu(809) + lu(816) = lu(816) - lu(424) * lu(809) + lu(818) = lu(818) - lu(425) * lu(809) + lu(819) = lu(819) - lu(426) * lu(809) + lu(820) = lu(820) - lu(427) * lu(809) + lu(824) = lu(824) - lu(428) * lu(809) + lu(430) = 1._r8 / lu(430) + lu(431) = lu(431) * lu(430) + lu(432) = lu(432) * lu(430) + lu(433) = lu(433) * lu(430) + lu(434) = lu(434) * lu(430) + lu(435) = lu(435) * lu(430) + lu(453) = lu(453) - lu(431) * lu(449) + lu(454) = lu(454) - lu(432) * lu(449) + lu(456) = lu(456) - lu(433) * lu(449) + lu(457) = lu(457) - lu(434) * lu(449) + lu(458) = lu(458) - lu(435) * lu(449) + lu(467) = lu(467) - lu(431) * lu(462) + lu(468) = lu(468) - lu(432) * lu(462) + lu(471) = lu(471) - lu(433) * lu(462) + lu(472) = lu(472) - lu(434) * lu(462) + lu(473) = lu(473) - lu(435) * lu(462) + lu(485) = lu(485) - lu(431) * lu(479) + lu(486) = lu(486) - lu(432) * lu(479) + lu(488) = lu(488) - lu(433) * lu(479) + lu(489) = lu(489) - lu(434) * lu(479) + lu(490) = lu(490) - lu(435) * lu(479) + lu(504) = lu(504) - lu(431) * lu(496) + lu(505) = lu(505) - lu(432) * lu(496) + lu(508) = lu(508) - lu(433) * lu(496) + lu(509) = lu(509) - lu(434) * lu(496) + lu(510) = lu(510) - lu(435) * lu(496) + lu(519) = lu(519) - lu(431) * lu(515) + lu(520) = lu(520) - lu(432) * lu(515) + lu(523) = lu(523) - lu(433) * lu(515) + lu(524) = lu(524) - lu(434) * lu(515) + lu(525) = lu(525) - lu(435) * lu(515) + lu(559) = lu(559) - lu(431) * lu(551) + lu(560) = lu(560) - lu(432) * lu(551) + lu(563) = lu(563) - lu(433) * lu(551) + lu(564) = lu(564) - lu(434) * lu(551) + lu(565) = lu(565) - lu(435) * lu(551) + lu(634) = lu(634) - lu(431) * lu(626) + lu(635) = lu(635) - lu(432) * lu(626) + lu(638) = lu(638) - lu(433) * lu(626) + lu(639) = lu(639) - lu(434) * lu(626) + lu(640) = lu(640) - lu(435) * lu(626) + lu(684) = lu(684) - lu(431) * lu(676) + lu(685) = lu(685) - lu(432) * lu(676) + lu(688) = lu(688) - lu(433) * lu(676) + lu(689) = lu(689) - lu(434) * lu(676) + lu(690) = lu(690) - lu(435) * lu(676) + lu(714) = lu(714) - lu(431) * lu(706) + lu(715) = lu(715) - lu(432) * lu(706) + lu(718) = lu(718) - lu(433) * lu(706) + lu(719) = lu(719) - lu(434) * lu(706) + lu(720) = lu(720) - lu(435) * lu(706) + lu(743) = lu(743) - lu(431) * lu(735) + lu(744) = lu(744) - lu(432) * lu(735) + lu(747) = lu(747) - lu(433) * lu(735) + lu(748) = lu(748) - lu(434) * lu(735) + lu(749) = lu(749) - lu(435) * lu(735) + lu(763) = lu(763) - lu(431) * lu(759) + lu(764) = lu(764) - lu(432) * lu(759) + lu(767) = lu(767) - lu(433) * lu(759) + lu(768) = lu(768) - lu(434) * lu(759) + lu(769) = lu(769) - lu(435) * lu(759) + lu(796) = lu(796) - lu(431) * lu(788) + lu(797) = lu(797) - lu(432) * lu(788) + lu(800) = lu(800) - lu(433) * lu(788) + lu(801) = lu(801) - lu(434) * lu(788) + lu(802) = lu(802) - lu(435) * lu(788) + lu(818) = lu(818) - lu(431) * lu(810) + lu(819) = lu(819) - lu(432) * lu(810) + lu(822) = lu(822) - lu(433) * lu(810) + lu(823) = lu(823) - lu(434) * lu(810) + lu(824) = lu(824) - lu(435) * lu(810) + lu(438) = 1._r8 / lu(438) + lu(439) = lu(439) * lu(438) + lu(440) = lu(440) * lu(438) + lu(441) = lu(441) * lu(438) + lu(442) = lu(442) * lu(438) + lu(443) = lu(443) * lu(438) + lu(452) = lu(452) - lu(439) * lu(450) + lu(453) = lu(453) - lu(440) * lu(450) + lu(454) = lu(454) - lu(441) * lu(450) + lu(456) = lu(456) - lu(442) * lu(450) + lu(457) = lu(457) - lu(443) * lu(450) + lu(466) = lu(466) - lu(439) * lu(463) + lu(467) = lu(467) - lu(440) * lu(463) + lu(468) = lu(468) - lu(441) * lu(463) + lu(471) = lu(471) - lu(442) * lu(463) + lu(472) = lu(472) - lu(443) * lu(463) + lu(484) = lu(484) - lu(439) * lu(480) + lu(485) = lu(485) - lu(440) * lu(480) + lu(486) = lu(486) - lu(441) * lu(480) + lu(488) = lu(488) - lu(442) * lu(480) + lu(489) = lu(489) - lu(443) * lu(480) + lu(503) = lu(503) - lu(439) * lu(497) + lu(504) = lu(504) - lu(440) * lu(497) + lu(505) = lu(505) - lu(441) * lu(497) + lu(508) = lu(508) - lu(442) * lu(497) + lu(509) = lu(509) - lu(443) * lu(497) + lu(518) = lu(518) - lu(439) * lu(516) + lu(519) = lu(519) - lu(440) * lu(516) + lu(520) = lu(520) - lu(441) * lu(516) + lu(523) = lu(523) - lu(442) * lu(516) + lu(524) = lu(524) - lu(443) * lu(516) + lu(558) = lu(558) - lu(439) * lu(552) + lu(559) = lu(559) - lu(440) * lu(552) + lu(560) = lu(560) - lu(441) * lu(552) + lu(563) = lu(563) - lu(442) * lu(552) + lu(564) = lu(564) - lu(443) * lu(552) + lu(633) = lu(633) - lu(439) * lu(627) + lu(634) = lu(634) - lu(440) * lu(627) + lu(635) = lu(635) - lu(441) * lu(627) + lu(638) = lu(638) - lu(442) * lu(627) + lu(639) = lu(639) - lu(443) * lu(627) + lu(683) = lu(683) - lu(439) * lu(677) + lu(684) = lu(684) - lu(440) * lu(677) + lu(685) = lu(685) - lu(441) * lu(677) + lu(688) = lu(688) - lu(442) * lu(677) + lu(689) = lu(689) - lu(443) * lu(677) + lu(713) = lu(713) - lu(439) * lu(707) + lu(714) = lu(714) - lu(440) * lu(707) + lu(715) = lu(715) - lu(441) * lu(707) + lu(718) = lu(718) - lu(442) * lu(707) + lu(719) = lu(719) - lu(443) * lu(707) + lu(742) = lu(742) - lu(439) * lu(736) + lu(743) = lu(743) - lu(440) * lu(736) + lu(744) = lu(744) - lu(441) * lu(736) + lu(747) = lu(747) - lu(442) * lu(736) + lu(748) = lu(748) - lu(443) * lu(736) + lu(762) = lu(762) - lu(439) * lu(760) + lu(763) = lu(763) - lu(440) * lu(760) + lu(764) = lu(764) - lu(441) * lu(760) + lu(767) = lu(767) - lu(442) * lu(760) + lu(768) = lu(768) - lu(443) * lu(760) + lu(795) = lu(795) - lu(439) * lu(789) + lu(796) = lu(796) - lu(440) * lu(789) + lu(797) = lu(797) - lu(441) * lu(789) + lu(800) = lu(800) - lu(442) * lu(789) + lu(801) = lu(801) - lu(443) * lu(789) + lu(817) = lu(817) - lu(439) * lu(811) + lu(818) = lu(818) - lu(440) * lu(811) + lu(819) = lu(819) - lu(441) * lu(811) + lu(822) = lu(822) - lu(442) * lu(811) + lu(823) = lu(823) - lu(443) * lu(811) + end subroutine lu_fac09 + subroutine lu_fac10( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(451) = 1._r8 / lu(451) + lu(452) = lu(452) * lu(451) + lu(453) = lu(453) * lu(451) + lu(454) = lu(454) * lu(451) + lu(455) = lu(455) * lu(451) + lu(456) = lu(456) * lu(451) + lu(457) = lu(457) * lu(451) + lu(458) = lu(458) * lu(451) + lu(484) = lu(484) - lu(452) * lu(481) + lu(485) = lu(485) - lu(453) * lu(481) + lu(486) = lu(486) - lu(454) * lu(481) + lu(487) = lu(487) - lu(455) * lu(481) + lu(488) = lu(488) - lu(456) * lu(481) + lu(489) = lu(489) - lu(457) * lu(481) + lu(490) = lu(490) - lu(458) * lu(481) + lu(503) = lu(503) - lu(452) * lu(498) + lu(504) = lu(504) - lu(453) * lu(498) + lu(505) = lu(505) - lu(454) * lu(498) + lu(507) = lu(507) - lu(455) * lu(498) + lu(508) = lu(508) - lu(456) * lu(498) + lu(509) = lu(509) - lu(457) * lu(498) + lu(510) = lu(510) - lu(458) * lu(498) + lu(558) = lu(558) - lu(452) * lu(553) + lu(559) = lu(559) - lu(453) * lu(553) + lu(560) = lu(560) - lu(454) * lu(553) + lu(562) = lu(562) - lu(455) * lu(553) + lu(563) = lu(563) - lu(456) * lu(553) + lu(564) = lu(564) - lu(457) * lu(553) + lu(565) = lu(565) - lu(458) * lu(553) + lu(633) = lu(633) - lu(452) * lu(628) + lu(634) = lu(634) - lu(453) * lu(628) + lu(635) = lu(635) - lu(454) * lu(628) + lu(637) = lu(637) - lu(455) * lu(628) + lu(638) = lu(638) - lu(456) * lu(628) + lu(639) = lu(639) - lu(457) * lu(628) + lu(640) = lu(640) - lu(458) * lu(628) + lu(683) = lu(683) - lu(452) * lu(678) + lu(684) = lu(684) - lu(453) * lu(678) + lu(685) = lu(685) - lu(454) * lu(678) + lu(687) = lu(687) - lu(455) * lu(678) + lu(688) = lu(688) - lu(456) * lu(678) + lu(689) = lu(689) - lu(457) * lu(678) + lu(690) = lu(690) - lu(458) * lu(678) + lu(713) = lu(713) - lu(452) * lu(708) + lu(714) = lu(714) - lu(453) * lu(708) + lu(715) = lu(715) - lu(454) * lu(708) + lu(717) = lu(717) - lu(455) * lu(708) + lu(718) = lu(718) - lu(456) * lu(708) + lu(719) = lu(719) - lu(457) * lu(708) + lu(720) = lu(720) - lu(458) * lu(708) + lu(742) = lu(742) - lu(452) * lu(737) + lu(743) = lu(743) - lu(453) * lu(737) + lu(744) = lu(744) - lu(454) * lu(737) + lu(746) = lu(746) - lu(455) * lu(737) + lu(747) = lu(747) - lu(456) * lu(737) + lu(748) = lu(748) - lu(457) * lu(737) + lu(749) = lu(749) - lu(458) * lu(737) + lu(795) = lu(795) - lu(452) * lu(790) + lu(796) = lu(796) - lu(453) * lu(790) + lu(797) = lu(797) - lu(454) * lu(790) + lu(799) = lu(799) - lu(455) * lu(790) + lu(800) = lu(800) - lu(456) * lu(790) + lu(801) = lu(801) - lu(457) * lu(790) + lu(802) = lu(802) - lu(458) * lu(790) + lu(817) = lu(817) - lu(452) * lu(812) + lu(818) = lu(818) - lu(453) * lu(812) + lu(819) = lu(819) - lu(454) * lu(812) + lu(821) = lu(821) - lu(455) * lu(812) + lu(822) = lu(822) - lu(456) * lu(812) + lu(823) = lu(823) - lu(457) * lu(812) + lu(824) = lu(824) - lu(458) * lu(812) + lu(464) = 1._r8 / lu(464) + lu(465) = lu(465) * lu(464) + lu(466) = lu(466) * lu(464) + lu(467) = lu(467) * lu(464) + lu(468) = lu(468) * lu(464) + lu(469) = lu(469) * lu(464) + lu(470) = lu(470) * lu(464) + lu(471) = lu(471) * lu(464) + lu(472) = lu(472) * lu(464) + lu(473) = lu(473) * lu(464) + lu(500) = lu(500) - lu(465) * lu(499) + lu(503) = lu(503) - lu(466) * lu(499) + lu(504) = lu(504) - lu(467) * lu(499) + lu(505) = lu(505) - lu(468) * lu(499) + lu(506) = lu(506) - lu(469) * lu(499) + lu(507) = lu(507) - lu(470) * lu(499) + lu(508) = lu(508) - lu(471) * lu(499) + lu(509) = lu(509) - lu(472) * lu(499) + lu(510) = lu(510) - lu(473) * lu(499) + lu(555) = lu(555) - lu(465) * lu(554) + lu(558) = lu(558) - lu(466) * lu(554) + lu(559) = lu(559) - lu(467) * lu(554) + lu(560) = lu(560) - lu(468) * lu(554) + lu(561) = lu(561) - lu(469) * lu(554) + lu(562) = lu(562) - lu(470) * lu(554) + lu(563) = lu(563) - lu(471) * lu(554) + lu(564) = lu(564) - lu(472) * lu(554) + lu(565) = lu(565) - lu(473) * lu(554) + lu(630) = lu(630) - lu(465) * lu(629) + lu(633) = lu(633) - lu(466) * lu(629) + lu(634) = lu(634) - lu(467) * lu(629) + lu(635) = lu(635) - lu(468) * lu(629) + lu(636) = lu(636) - lu(469) * lu(629) + lu(637) = lu(637) - lu(470) * lu(629) + lu(638) = lu(638) - lu(471) * lu(629) + lu(639) = lu(639) - lu(472) * lu(629) + lu(640) = lu(640) - lu(473) * lu(629) + lu(680) = lu(680) - lu(465) * lu(679) + lu(683) = lu(683) - lu(466) * lu(679) + lu(684) = lu(684) - lu(467) * lu(679) + lu(685) = lu(685) - lu(468) * lu(679) + lu(686) = lu(686) - lu(469) * lu(679) + lu(687) = lu(687) - lu(470) * lu(679) + lu(688) = lu(688) - lu(471) * lu(679) + lu(689) = lu(689) - lu(472) * lu(679) + lu(690) = lu(690) - lu(473) * lu(679) + lu(710) = lu(710) - lu(465) * lu(709) + lu(713) = lu(713) - lu(466) * lu(709) + lu(714) = lu(714) - lu(467) * lu(709) + lu(715) = lu(715) - lu(468) * lu(709) + lu(716) = lu(716) - lu(469) * lu(709) + lu(717) = lu(717) - lu(470) * lu(709) + lu(718) = lu(718) - lu(471) * lu(709) + lu(719) = lu(719) - lu(472) * lu(709) + lu(720) = lu(720) - lu(473) * lu(709) + lu(739) = lu(739) - lu(465) * lu(738) + lu(742) = lu(742) - lu(466) * lu(738) + lu(743) = lu(743) - lu(467) * lu(738) + lu(744) = lu(744) - lu(468) * lu(738) + lu(745) = lu(745) - lu(469) * lu(738) + lu(746) = lu(746) - lu(470) * lu(738) + lu(747) = lu(747) - lu(471) * lu(738) + lu(748) = lu(748) - lu(472) * lu(738) + lu(749) = lu(749) - lu(473) * lu(738) + lu(792) = lu(792) - lu(465) * lu(791) + lu(795) = lu(795) - lu(466) * lu(791) + lu(796) = lu(796) - lu(467) * lu(791) + lu(797) = lu(797) - lu(468) * lu(791) + lu(798) = lu(798) - lu(469) * lu(791) + lu(799) = lu(799) - lu(470) * lu(791) + lu(800) = lu(800) - lu(471) * lu(791) + lu(801) = lu(801) - lu(472) * lu(791) + lu(802) = lu(802) - lu(473) * lu(791) + lu(814) = lu(814) - lu(465) * lu(813) + lu(817) = lu(817) - lu(466) * lu(813) + lu(818) = lu(818) - lu(467) * lu(813) + lu(819) = lu(819) - lu(468) * lu(813) + lu(820) = lu(820) - lu(469) * lu(813) + lu(821) = lu(821) - lu(470) * lu(813) + lu(822) = lu(822) - lu(471) * lu(813) + lu(823) = lu(823) - lu(472) * lu(813) + lu(824) = lu(824) - lu(473) * lu(813) + lu(482) = 1._r8 / lu(482) + lu(483) = lu(483) * lu(482) + lu(484) = lu(484) * lu(482) + lu(485) = lu(485) * lu(482) + lu(486) = lu(486) * lu(482) + lu(487) = lu(487) * lu(482) + lu(488) = lu(488) * lu(482) + lu(489) = lu(489) * lu(482) + lu(490) = lu(490) * lu(482) + lu(502) = lu(502) - lu(483) * lu(500) + lu(503) = lu(503) - lu(484) * lu(500) + lu(504) = lu(504) - lu(485) * lu(500) + lu(505) = lu(505) - lu(486) * lu(500) + lu(507) = lu(507) - lu(487) * lu(500) + lu(508) = lu(508) - lu(488) * lu(500) + lu(509) = lu(509) - lu(489) * lu(500) + lu(510) = lu(510) - lu(490) * lu(500) + lu(557) = lu(557) - lu(483) * lu(555) + lu(558) = lu(558) - lu(484) * lu(555) + lu(559) = lu(559) - lu(485) * lu(555) + lu(560) = lu(560) - lu(486) * lu(555) + lu(562) = lu(562) - lu(487) * lu(555) + lu(563) = lu(563) - lu(488) * lu(555) + lu(564) = lu(564) - lu(489) * lu(555) + lu(565) = lu(565) - lu(490) * lu(555) + lu(632) = lu(632) - lu(483) * lu(630) + lu(633) = lu(633) - lu(484) * lu(630) + lu(634) = lu(634) - lu(485) * lu(630) + lu(635) = lu(635) - lu(486) * lu(630) + lu(637) = lu(637) - lu(487) * lu(630) + lu(638) = lu(638) - lu(488) * lu(630) + lu(639) = lu(639) - lu(489) * lu(630) + lu(640) = lu(640) - lu(490) * lu(630) + lu(682) = lu(682) - lu(483) * lu(680) + lu(683) = lu(683) - lu(484) * lu(680) + lu(684) = lu(684) - lu(485) * lu(680) + lu(685) = lu(685) - lu(486) * lu(680) + lu(687) = lu(687) - lu(487) * lu(680) + lu(688) = lu(688) - lu(488) * lu(680) + lu(689) = lu(689) - lu(489) * lu(680) + lu(690) = lu(690) - lu(490) * lu(680) + lu(712) = lu(712) - lu(483) * lu(710) + lu(713) = lu(713) - lu(484) * lu(710) + lu(714) = lu(714) - lu(485) * lu(710) + lu(715) = lu(715) - lu(486) * lu(710) + lu(717) = lu(717) - lu(487) * lu(710) + lu(718) = lu(718) - lu(488) * lu(710) + lu(719) = lu(719) - lu(489) * lu(710) + lu(720) = lu(720) - lu(490) * lu(710) + lu(741) = lu(741) - lu(483) * lu(739) + lu(742) = lu(742) - lu(484) * lu(739) + lu(743) = lu(743) - lu(485) * lu(739) + lu(744) = lu(744) - lu(486) * lu(739) + lu(746) = lu(746) - lu(487) * lu(739) + lu(747) = lu(747) - lu(488) * lu(739) + lu(748) = lu(748) - lu(489) * lu(739) + lu(749) = lu(749) - lu(490) * lu(739) + lu(794) = lu(794) - lu(483) * lu(792) + lu(795) = lu(795) - lu(484) * lu(792) + lu(796) = lu(796) - lu(485) * lu(792) + lu(797) = lu(797) - lu(486) * lu(792) + lu(799) = lu(799) - lu(487) * lu(792) + lu(800) = lu(800) - lu(488) * lu(792) + lu(801) = lu(801) - lu(489) * lu(792) + lu(802) = lu(802) - lu(490) * lu(792) + lu(816) = lu(816) - lu(483) * lu(814) + lu(817) = lu(817) - lu(484) * lu(814) + lu(818) = lu(818) - lu(485) * lu(814) + lu(819) = lu(819) - lu(486) * lu(814) + lu(821) = lu(821) - lu(487) * lu(814) + lu(822) = lu(822) - lu(488) * lu(814) + lu(823) = lu(823) - lu(489) * lu(814) + lu(824) = lu(824) - lu(490) * lu(814) + lu(501) = 1._r8 / lu(501) + lu(502) = lu(502) * lu(501) + lu(503) = lu(503) * lu(501) + lu(504) = lu(504) * lu(501) + lu(505) = lu(505) * lu(501) + lu(506) = lu(506) * lu(501) + lu(507) = lu(507) * lu(501) + lu(508) = lu(508) * lu(501) + lu(509) = lu(509) * lu(501) + lu(510) = lu(510) * lu(501) + lu(557) = lu(557) - lu(502) * lu(556) + lu(558) = lu(558) - lu(503) * lu(556) + lu(559) = lu(559) - lu(504) * lu(556) + lu(560) = lu(560) - lu(505) * lu(556) + lu(561) = lu(561) - lu(506) * lu(556) + lu(562) = lu(562) - lu(507) * lu(556) + lu(563) = lu(563) - lu(508) * lu(556) + lu(564) = lu(564) - lu(509) * lu(556) + lu(565) = lu(565) - lu(510) * lu(556) + lu(632) = lu(632) - lu(502) * lu(631) + lu(633) = lu(633) - lu(503) * lu(631) + lu(634) = lu(634) - lu(504) * lu(631) + lu(635) = lu(635) - lu(505) * lu(631) + lu(636) = lu(636) - lu(506) * lu(631) + lu(637) = lu(637) - lu(507) * lu(631) + lu(638) = lu(638) - lu(508) * lu(631) + lu(639) = lu(639) - lu(509) * lu(631) + lu(640) = lu(640) - lu(510) * lu(631) + lu(682) = lu(682) - lu(502) * lu(681) + lu(683) = lu(683) - lu(503) * lu(681) + lu(684) = lu(684) - lu(504) * lu(681) + lu(685) = lu(685) - lu(505) * lu(681) + lu(686) = lu(686) - lu(506) * lu(681) + lu(687) = lu(687) - lu(507) * lu(681) + lu(688) = lu(688) - lu(508) * lu(681) + lu(689) = lu(689) - lu(509) * lu(681) + lu(690) = lu(690) - lu(510) * lu(681) + lu(712) = lu(712) - lu(502) * lu(711) + lu(713) = lu(713) - lu(503) * lu(711) + lu(714) = lu(714) - lu(504) * lu(711) + lu(715) = lu(715) - lu(505) * lu(711) + lu(716) = lu(716) - lu(506) * lu(711) + lu(717) = lu(717) - lu(507) * lu(711) + lu(718) = lu(718) - lu(508) * lu(711) + lu(719) = lu(719) - lu(509) * lu(711) + lu(720) = lu(720) - lu(510) * lu(711) + lu(741) = lu(741) - lu(502) * lu(740) + lu(742) = lu(742) - lu(503) * lu(740) + lu(743) = lu(743) - lu(504) * lu(740) + lu(744) = lu(744) - lu(505) * lu(740) + lu(745) = lu(745) - lu(506) * lu(740) + lu(746) = lu(746) - lu(507) * lu(740) + lu(747) = lu(747) - lu(508) * lu(740) + lu(748) = lu(748) - lu(509) * lu(740) + lu(749) = lu(749) - lu(510) * lu(740) + lu(794) = lu(794) - lu(502) * lu(793) + lu(795) = lu(795) - lu(503) * lu(793) + lu(796) = lu(796) - lu(504) * lu(793) + lu(797) = lu(797) - lu(505) * lu(793) + lu(798) = lu(798) - lu(506) * lu(793) + lu(799) = lu(799) - lu(507) * lu(793) + lu(800) = lu(800) - lu(508) * lu(793) + lu(801) = lu(801) - lu(509) * lu(793) + lu(802) = lu(802) - lu(510) * lu(793) + lu(816) = lu(816) - lu(502) * lu(815) + lu(817) = lu(817) - lu(503) * lu(815) + lu(818) = lu(818) - lu(504) * lu(815) + lu(819) = lu(819) - lu(505) * lu(815) + lu(820) = lu(820) - lu(506) * lu(815) + lu(821) = lu(821) - lu(507) * lu(815) + lu(822) = lu(822) - lu(508) * lu(815) + lu(823) = lu(823) - lu(509) * lu(815) + lu(824) = lu(824) - lu(510) * lu(815) + lu(517) = 1._r8 / lu(517) + lu(518) = lu(518) * lu(517) + lu(519) = lu(519) * lu(517) + lu(520) = lu(520) * lu(517) + lu(521) = lu(521) * lu(517) + lu(522) = lu(522) * lu(517) + lu(523) = lu(523) * lu(517) + lu(524) = lu(524) * lu(517) + lu(525) = lu(525) * lu(517) + lu(558) = lu(558) - lu(518) * lu(557) + lu(559) = lu(559) - lu(519) * lu(557) + lu(560) = lu(560) - lu(520) * lu(557) + lu(561) = lu(561) - lu(521) * lu(557) + lu(562) = lu(562) - lu(522) * lu(557) + lu(563) = lu(563) - lu(523) * lu(557) + lu(564) = lu(564) - lu(524) * lu(557) + lu(565) = lu(565) - lu(525) * lu(557) + lu(633) = lu(633) - lu(518) * lu(632) + lu(634) = lu(634) - lu(519) * lu(632) + lu(635) = lu(635) - lu(520) * lu(632) + lu(636) = lu(636) - lu(521) * lu(632) + lu(637) = lu(637) - lu(522) * lu(632) + lu(638) = lu(638) - lu(523) * lu(632) + lu(639) = lu(639) - lu(524) * lu(632) + lu(640) = lu(640) - lu(525) * lu(632) + lu(683) = lu(683) - lu(518) * lu(682) + lu(684) = lu(684) - lu(519) * lu(682) + lu(685) = lu(685) - lu(520) * lu(682) + lu(686) = lu(686) - lu(521) * lu(682) + lu(687) = lu(687) - lu(522) * lu(682) + lu(688) = lu(688) - lu(523) * lu(682) + lu(689) = lu(689) - lu(524) * lu(682) + lu(690) = lu(690) - lu(525) * lu(682) + lu(713) = lu(713) - lu(518) * lu(712) + lu(714) = lu(714) - lu(519) * lu(712) + lu(715) = lu(715) - lu(520) * lu(712) + lu(716) = lu(716) - lu(521) * lu(712) + lu(717) = lu(717) - lu(522) * lu(712) + lu(718) = lu(718) - lu(523) * lu(712) + lu(719) = lu(719) - lu(524) * lu(712) + lu(720) = lu(720) - lu(525) * lu(712) + lu(742) = lu(742) - lu(518) * lu(741) + lu(743) = lu(743) - lu(519) * lu(741) + lu(744) = lu(744) - lu(520) * lu(741) + lu(745) = lu(745) - lu(521) * lu(741) + lu(746) = lu(746) - lu(522) * lu(741) + lu(747) = lu(747) - lu(523) * lu(741) + lu(748) = lu(748) - lu(524) * lu(741) + lu(749) = lu(749) - lu(525) * lu(741) + lu(762) = lu(762) - lu(518) * lu(761) + lu(763) = lu(763) - lu(519) * lu(761) + lu(764) = lu(764) - lu(520) * lu(761) + lu(765) = lu(765) - lu(521) * lu(761) + lu(766) = lu(766) - lu(522) * lu(761) + lu(767) = lu(767) - lu(523) * lu(761) + lu(768) = lu(768) - lu(524) * lu(761) + lu(769) = lu(769) - lu(525) * lu(761) + lu(795) = lu(795) - lu(518) * lu(794) + lu(796) = lu(796) - lu(519) * lu(794) + lu(797) = lu(797) - lu(520) * lu(794) + lu(798) = lu(798) - lu(521) * lu(794) + lu(799) = lu(799) - lu(522) * lu(794) + lu(800) = lu(800) - lu(523) * lu(794) + lu(801) = lu(801) - lu(524) * lu(794) + lu(802) = lu(802) - lu(525) * lu(794) + lu(817) = lu(817) - lu(518) * lu(816) + lu(818) = lu(818) - lu(519) * lu(816) + lu(819) = lu(819) - lu(520) * lu(816) + lu(820) = lu(820) - lu(521) * lu(816) + lu(821) = lu(821) - lu(522) * lu(816) + lu(822) = lu(822) - lu(523) * lu(816) + lu(823) = lu(823) - lu(524) * lu(816) + lu(824) = lu(824) - lu(525) * lu(816) + lu(558) = 1._r8 / lu(558) + lu(559) = lu(559) * lu(558) + lu(560) = lu(560) * lu(558) + lu(561) = lu(561) * lu(558) + lu(562) = lu(562) * lu(558) + lu(563) = lu(563) * lu(558) + lu(564) = lu(564) * lu(558) + lu(565) = lu(565) * lu(558) + lu(634) = lu(634) - lu(559) * lu(633) + lu(635) = lu(635) - lu(560) * lu(633) + lu(636) = lu(636) - lu(561) * lu(633) + lu(637) = lu(637) - lu(562) * lu(633) + lu(638) = lu(638) - lu(563) * lu(633) + lu(639) = lu(639) - lu(564) * lu(633) + lu(640) = lu(640) - lu(565) * lu(633) + lu(684) = lu(684) - lu(559) * lu(683) + lu(685) = lu(685) - lu(560) * lu(683) + lu(686) = lu(686) - lu(561) * lu(683) + lu(687) = lu(687) - lu(562) * lu(683) + lu(688) = lu(688) - lu(563) * lu(683) + lu(689) = lu(689) - lu(564) * lu(683) + lu(690) = lu(690) - lu(565) * lu(683) + lu(714) = lu(714) - lu(559) * lu(713) + lu(715) = lu(715) - lu(560) * lu(713) + lu(716) = lu(716) - lu(561) * lu(713) + lu(717) = lu(717) - lu(562) * lu(713) + lu(718) = lu(718) - lu(563) * lu(713) + lu(719) = lu(719) - lu(564) * lu(713) + lu(720) = lu(720) - lu(565) * lu(713) + lu(743) = lu(743) - lu(559) * lu(742) + lu(744) = lu(744) - lu(560) * lu(742) + lu(745) = lu(745) - lu(561) * lu(742) + lu(746) = lu(746) - lu(562) * lu(742) + lu(747) = lu(747) - lu(563) * lu(742) + lu(748) = lu(748) - lu(564) * lu(742) + lu(749) = lu(749) - lu(565) * lu(742) + lu(763) = lu(763) - lu(559) * lu(762) + lu(764) = lu(764) - lu(560) * lu(762) + lu(765) = lu(765) - lu(561) * lu(762) + lu(766) = lu(766) - lu(562) * lu(762) + lu(767) = lu(767) - lu(563) * lu(762) + lu(768) = lu(768) - lu(564) * lu(762) + lu(769) = lu(769) - lu(565) * lu(762) + lu(796) = lu(796) - lu(559) * lu(795) + lu(797) = lu(797) - lu(560) * lu(795) + lu(798) = lu(798) - lu(561) * lu(795) + lu(799) = lu(799) - lu(562) * lu(795) + lu(800) = lu(800) - lu(563) * lu(795) + lu(801) = lu(801) - lu(564) * lu(795) + lu(802) = lu(802) - lu(565) * lu(795) + lu(818) = lu(818) - lu(559) * lu(817) + lu(819) = lu(819) - lu(560) * lu(817) + lu(820) = lu(820) - lu(561) * lu(817) + lu(821) = lu(821) - lu(562) * lu(817) + lu(822) = lu(822) - lu(563) * lu(817) + lu(823) = lu(823) - lu(564) * lu(817) + lu(824) = lu(824) - lu(565) * lu(817) + end subroutine lu_fac10 + subroutine lu_fac11( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(634) = 1._r8 / lu(634) + lu(635) = lu(635) * lu(634) + lu(636) = lu(636) * lu(634) + lu(637) = lu(637) * lu(634) + lu(638) = lu(638) * lu(634) + lu(639) = lu(639) * lu(634) + lu(640) = lu(640) * lu(634) + lu(685) = lu(685) - lu(635) * lu(684) + lu(686) = lu(686) - lu(636) * lu(684) + lu(687) = lu(687) - lu(637) * lu(684) + lu(688) = lu(688) - lu(638) * lu(684) + lu(689) = lu(689) - lu(639) * lu(684) + lu(690) = lu(690) - lu(640) * lu(684) + lu(715) = lu(715) - lu(635) * lu(714) + lu(716) = lu(716) - lu(636) * lu(714) + lu(717) = lu(717) - lu(637) * lu(714) + lu(718) = lu(718) - lu(638) * lu(714) + lu(719) = lu(719) - lu(639) * lu(714) + lu(720) = lu(720) - lu(640) * lu(714) + lu(744) = lu(744) - lu(635) * lu(743) + lu(745) = lu(745) - lu(636) * lu(743) + lu(746) = lu(746) - lu(637) * lu(743) + lu(747) = lu(747) - lu(638) * lu(743) + lu(748) = lu(748) - lu(639) * lu(743) + lu(749) = lu(749) - lu(640) * lu(743) + lu(764) = lu(764) - lu(635) * lu(763) + lu(765) = lu(765) - lu(636) * lu(763) + lu(766) = lu(766) - lu(637) * lu(763) + lu(767) = lu(767) - lu(638) * lu(763) + lu(768) = lu(768) - lu(639) * lu(763) + lu(769) = lu(769) - lu(640) * lu(763) + lu(797) = lu(797) - lu(635) * lu(796) + lu(798) = lu(798) - lu(636) * lu(796) + lu(799) = lu(799) - lu(637) * lu(796) + lu(800) = lu(800) - lu(638) * lu(796) + lu(801) = lu(801) - lu(639) * lu(796) + lu(802) = lu(802) - lu(640) * lu(796) + lu(819) = lu(819) - lu(635) * lu(818) + lu(820) = lu(820) - lu(636) * lu(818) + lu(821) = lu(821) - lu(637) * lu(818) + lu(822) = lu(822) - lu(638) * lu(818) + lu(823) = lu(823) - lu(639) * lu(818) + lu(824) = lu(824) - lu(640) * lu(818) + lu(685) = 1._r8 / lu(685) + lu(686) = lu(686) * lu(685) + lu(687) = lu(687) * lu(685) + lu(688) = lu(688) * lu(685) + lu(689) = lu(689) * lu(685) + lu(690) = lu(690) * lu(685) + lu(716) = lu(716) - lu(686) * lu(715) + lu(717) = lu(717) - lu(687) * lu(715) + lu(718) = lu(718) - lu(688) * lu(715) + lu(719) = lu(719) - lu(689) * lu(715) + lu(720) = lu(720) - lu(690) * lu(715) + lu(745) = lu(745) - lu(686) * lu(744) + lu(746) = lu(746) - lu(687) * lu(744) + lu(747) = lu(747) - lu(688) * lu(744) + lu(748) = lu(748) - lu(689) * lu(744) + lu(749) = lu(749) - lu(690) * lu(744) + lu(765) = lu(765) - lu(686) * lu(764) + lu(766) = lu(766) - lu(687) * lu(764) + lu(767) = lu(767) - lu(688) * lu(764) + lu(768) = lu(768) - lu(689) * lu(764) + lu(769) = lu(769) - lu(690) * lu(764) + lu(798) = lu(798) - lu(686) * lu(797) + lu(799) = lu(799) - lu(687) * lu(797) + lu(800) = lu(800) - lu(688) * lu(797) + lu(801) = lu(801) - lu(689) * lu(797) + lu(802) = lu(802) - lu(690) * lu(797) + lu(820) = lu(820) - lu(686) * lu(819) + lu(821) = lu(821) - lu(687) * lu(819) + lu(822) = lu(822) - lu(688) * lu(819) + lu(823) = lu(823) - lu(689) * lu(819) + lu(824) = lu(824) - lu(690) * lu(819) + lu(716) = 1._r8 / lu(716) + lu(717) = lu(717) * lu(716) + lu(718) = lu(718) * lu(716) + lu(719) = lu(719) * lu(716) + lu(720) = lu(720) * lu(716) + lu(746) = lu(746) - lu(717) * lu(745) + lu(747) = lu(747) - lu(718) * lu(745) + lu(748) = lu(748) - lu(719) * lu(745) + lu(749) = lu(749) - lu(720) * lu(745) + lu(766) = lu(766) - lu(717) * lu(765) + lu(767) = lu(767) - lu(718) * lu(765) + lu(768) = lu(768) - lu(719) * lu(765) + lu(769) = lu(769) - lu(720) * lu(765) + lu(799) = lu(799) - lu(717) * lu(798) + lu(800) = lu(800) - lu(718) * lu(798) + lu(801) = lu(801) - lu(719) * lu(798) + lu(802) = lu(802) - lu(720) * lu(798) + lu(821) = lu(821) - lu(717) * lu(820) + lu(822) = lu(822) - lu(718) * lu(820) + lu(823) = lu(823) - lu(719) * lu(820) + lu(824) = lu(824) - lu(720) * lu(820) + lu(746) = 1._r8 / lu(746) + lu(747) = lu(747) * lu(746) + lu(748) = lu(748) * lu(746) + lu(749) = lu(749) * lu(746) + lu(767) = lu(767) - lu(747) * lu(766) + lu(768) = lu(768) - lu(748) * lu(766) + lu(769) = lu(769) - lu(749) * lu(766) + lu(800) = lu(800) - lu(747) * lu(799) + lu(801) = lu(801) - lu(748) * lu(799) + lu(802) = lu(802) - lu(749) * lu(799) + lu(822) = lu(822) - lu(747) * lu(821) + lu(823) = lu(823) - lu(748) * lu(821) + lu(824) = lu(824) - lu(749) * lu(821) + lu(767) = 1._r8 / lu(767) + lu(768) = lu(768) * lu(767) + lu(769) = lu(769) * lu(767) + lu(801) = lu(801) - lu(768) * lu(800) + lu(802) = lu(802) - lu(769) * lu(800) + lu(823) = lu(823) - lu(768) * lu(822) + lu(824) = lu(824) - lu(769) * lu(822) + lu(801) = 1._r8 / lu(801) + lu(802) = lu(802) * lu(801) + lu(824) = lu(824) - lu(802) * lu(823) + lu(824) = 1._r8 / lu(824) + end subroutine lu_fac11 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 b/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 new file mode 100644 index 0000000000..ae8d6ac0c1 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_lu_solve.F90 @@ -0,0 +1,910 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(6) = b(6) - lu(6) * b(5) + b(8) = b(8) - lu(9) * b(7) + b(89) = b(89) - lu(20) * b(17) + b(71) = b(71) - lu(22) * b(18) + b(89) = b(89) - lu(23) * b(18) + b(72) = b(72) - lu(25) * b(19) + b(89) = b(89) - lu(26) * b(19) + b(35) = b(35) - lu(28) * b(20) + b(89) = b(89) - lu(29) * b(20) + b(70) = b(70) - lu(31) * b(21) + b(89) = b(89) - lu(32) * b(21) + b(89) = b(89) - lu(35) * b(22) + b(24) = b(24) - lu(37) * b(23) + b(55) = b(55) - lu(38) * b(23) + b(89) = b(89) - lu(39) * b(23) + b(90) = b(90) - lu(40) * b(23) + b(29) = b(29) - lu(42) * b(24) + b(89) = b(89) - lu(43) * b(24) + b(39) = b(39) - lu(45) * b(25) + b(54) = b(54) - lu(46) * b(25) + b(89) = b(89) - lu(47) * b(25) + b(90) = b(90) - lu(48) * b(25) + b(89) = b(89) - lu(50) * b(26) + b(90) = b(90) - lu(51) * b(26) + b(63) = b(63) - lu(53) * b(27) + b(82) = b(82) - lu(54) * b(27) + b(90) = b(90) - lu(55) * b(27) + b(83) = b(83) - lu(57) * b(28) + b(89) = b(89) - lu(58) * b(28) + b(56) = b(56) - lu(60) * b(29) + b(90) = b(90) - lu(61) * b(29) + b(93) = b(93) - lu(62) * b(29) + b(59) = b(59) - lu(64) * b(30) + b(82) = b(82) - lu(65) * b(30) + b(88) = b(88) - lu(66) * b(30) + b(89) = b(89) - lu(67) * b(30) + b(90) = b(90) - lu(68) * b(30) + b(92) = b(92) - lu(69) * b(30) + b(58) = b(58) - lu(71) * b(31) + b(93) = b(93) - lu(72) * b(31) + b(94) = b(94) - lu(73) * b(31) + b(58) = b(58) - lu(76) * b(32) + b(89) = b(89) - lu(77) * b(32) + b(90) = b(90) - lu(78) * b(32) + b(94) = b(94) - lu(79) * b(32) + b(76) = b(76) - lu(81) * b(33) + b(89) = b(89) - lu(82) * b(33) + b(90) = b(90) - lu(83) * b(33) + b(78) = b(78) - lu(85) * b(34) + b(82) = b(82) - lu(86) * b(34) + b(89) = b(89) - lu(87) * b(34) + b(95) = b(95) - lu(88) * b(34) + b(68) = b(68) - lu(90) * b(35) + b(76) = b(76) - lu(91) * b(35) + b(82) = b(82) - lu(92) * b(35) + b(88) = b(88) - lu(93) * b(35) + b(90) = b(90) - lu(94) * b(35) + b(93) = b(93) - lu(95) * b(35) + b(66) = b(66) - lu(97) * b(36) + b(76) = b(76) - lu(98) * b(36) + b(89) = b(89) - lu(99) * b(36) + b(95) = b(95) - lu(100) * b(36) + b(85) = b(85) - lu(102) * b(37) + b(87) = b(87) - lu(103) * b(37) + b(89) = b(89) - lu(104) * b(37) + b(90) = b(90) - lu(105) * b(37) + b(39) = b(39) - lu(107) * b(38) + b(45) = b(45) - lu(108) * b(38) + b(82) = b(82) - lu(109) * b(38) + b(89) = b(89) - lu(110) * b(38) + b(90) = b(90) - lu(111) * b(38) + b(91) = b(91) - lu(112) * b(38) + b(89) = b(89) - lu(114) * b(39) + b(90) = b(90) - lu(115) * b(39) + b(68) = b(68) - lu(117) * b(40) + b(72) = b(72) - lu(118) * b(40) + b(89) = b(89) - lu(119) * b(40) + b(90) = b(90) - lu(120) * b(40) + b(89) = b(89) - lu(122) * b(41) + b(90) = b(90) - lu(123) * b(41) + b(93) = b(93) - lu(124) * b(41) + b(94) = b(94) - lu(125) * b(41) + b(71) = b(71) - lu(127) * b(42) + b(76) = b(76) - lu(128) * b(42) + b(89) = b(89) - lu(129) * b(42) + b(90) = b(90) - lu(130) * b(42) + b(82) = b(82) - lu(132) * b(43) + b(89) = b(89) - lu(133) * b(43) + b(90) = b(90) - lu(134) * b(43) + b(92) = b(92) - lu(135) * b(43) + b(83) = b(83) - lu(137) * b(44) + b(89) = b(89) - lu(138) * b(44) + b(63) = b(63) - lu(141) * b(45) + b(82) = b(82) - lu(142) * b(45) + b(88) = b(88) - lu(143) * b(45) + b(90) = b(90) - lu(144) * b(45) + b(93) = b(93) - lu(145) * b(45) + b(54) = b(54) - lu(147) * b(46) + b(55) = b(55) - lu(148) * b(46) + b(56) = b(56) - lu(149) * b(46) + b(81) = b(81) - lu(150) * b(46) + b(89) = b(89) - lu(151) * b(46) + b(81) = b(81) - lu(153) * b(47) + b(89) = b(89) - lu(154) * b(47) + b(93) = b(93) - lu(155) * b(47) + b(82) = b(82) - lu(158) * b(48) + b(88) = b(88) - lu(159) * b(48) + b(89) = b(89) - lu(160) * b(48) + b(90) = b(90) - lu(161) * b(48) + b(93) = b(93) - lu(162) * b(48) + b(82) = b(82) - lu(164) * b(49) + b(89) = b(89) - lu(165) * b(49) + b(92) = b(92) - lu(166) * b(49) + b(95) = b(95) - lu(167) * b(49) + b(89) = b(89) - lu(169) * b(50) + b(92) = b(92) - lu(170) * b(50) + b(66) = b(66) - lu(172) * b(51) + b(71) = b(71) - lu(173) * b(51) + b(89) = b(89) - lu(174) * b(51) + b(95) = b(95) - lu(175) * b(51) + b(67) = b(67) - lu(177) * b(52) + b(76) = b(76) - lu(178) * b(52) + b(79) = b(79) - lu(179) * b(52) + b(82) = b(82) - lu(180) * b(52) + b(89) = b(89) - lu(181) * b(52) + b(90) = b(90) - lu(182) * b(52) + b(68) = b(68) - lu(184) * b(53) + b(77) = b(77) - lu(185) * b(53) + b(80) = b(80) - lu(186) * b(53) + b(84) = b(84) - lu(187) * b(53) + b(89) = b(89) - lu(188) * b(53) + b(90) = b(90) - lu(189) * b(53) + b(89) = b(89) - lu(191) * b(54) + b(90) = b(90) - lu(192) * b(54) + b(56) = b(56) - lu(196) * b(55) + b(81) = b(81) - lu(197) * b(55) + b(88) = b(88) - lu(198) * b(55) + b(89) = b(89) - lu(199) * b(55) + b(90) = b(90) - lu(200) * b(55) + b(93) = b(93) - lu(201) * b(55) + b(81) = b(81) - lu(204) * b(56) + b(89) = b(89) - lu(205) * b(56) + b(90) = b(90) - lu(206) * b(56) + b(95) = b(95) - lu(207) * b(56) + b(82) = b(82) - lu(209) * b(57) + b(89) = b(89) - lu(210) * b(57) + b(92) = b(92) - lu(211) * b(57) + b(93) = b(93) - lu(212) * b(57) + b(94) = b(94) - lu(213) * b(57) + b(95) = b(95) - lu(214) * b(57) + b(89) = b(89) - lu(216) * b(58) + b(93) = b(93) - lu(217) * b(58) + b(94) = b(94) - lu(218) * b(58) + b(88) = b(88) - lu(220) * b(59) + b(89) = b(89) - lu(221) * b(59) + b(90) = b(90) - lu(222) * b(59) + b(91) = b(91) - lu(223) * b(59) + b(93) = b(93) - lu(224) * b(59) + b(79) = b(79) - lu(226) * b(60) + b(82) = b(82) - lu(227) * b(60) + b(87) = b(87) - lu(228) * b(60) + b(89) = b(89) - lu(229) * b(60) + b(90) = b(90) - lu(230) * b(60) + b(93) = b(93) - lu(231) * b(60) + b(94) = b(94) - lu(232) * b(60) + b(80) = b(80) - lu(234) * b(61) + b(82) = b(82) - lu(235) * b(61) + b(83) = b(83) - lu(236) * b(61) + b(84) = b(84) - lu(237) * b(61) + b(86) = b(86) - lu(238) * b(61) + b(89) = b(89) - lu(239) * b(61) + b(90) = b(90) - lu(240) * b(61) + b(82) = b(82) - lu(242) * b(62) + b(89) = b(89) - lu(243) * b(62) + b(90) = b(90) - lu(244) * b(62) + b(82) = b(82) - lu(247) * b(63) + b(89) = b(89) - lu(248) * b(63) + b(90) = b(90) - lu(249) * b(63) + b(77) = b(77) - lu(251) * b(64) + b(80) = b(80) - lu(252) * b(64) + b(84) = b(84) - lu(253) * b(64) + b(89) = b(89) - lu(254) * b(64) + b(90) = b(90) - lu(255) * b(64) + b(91) = b(91) - lu(256) * b(64) + b(93) = b(93) - lu(257) * b(64) + b(94) = b(94) - lu(258) * b(64) + b(66) = b(66) - lu(261) * b(65) + b(68) = b(68) - lu(262) * b(65) + b(70) = b(70) - lu(263) * b(65) + b(71) = b(71) - lu(264) * b(65) + b(76) = b(76) - lu(265) * b(65) + b(82) = b(82) - lu(266) * b(65) + b(89) = b(89) - lu(267) * b(65) + b(90) = b(90) - lu(268) * b(65) + b(95) = b(95) - lu(269) * b(65) + b(76) = b(76) - lu(272) * b(66) + b(88) = b(88) - lu(273) * b(66) + b(89) = b(89) - lu(274) * b(66) + b(90) = b(90) - lu(275) * b(66) + b(93) = b(93) - lu(276) * b(66) + b(95) = b(95) - lu(277) * b(66) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(76) = b(76) - lu(280) * b(67) + b(79) = b(79) - lu(281) * b(67) + b(82) = b(82) - lu(282) * b(67) + b(88) = b(88) - lu(283) * b(67) + b(89) = b(89) - lu(284) * b(67) + b(90) = b(90) - lu(285) * b(67) + b(93) = b(93) - lu(286) * b(67) + b(78) = b(78) - lu(288) * b(68) + b(89) = b(89) - lu(289) * b(68) + b(92) = b(92) - lu(290) * b(68) + b(95) = b(95) - lu(291) * b(68) + b(73) = b(73) - lu(293) * b(69) + b(80) = b(80) - lu(294) * b(69) + b(82) = b(82) - lu(295) * b(69) + b(84) = b(84) - lu(296) * b(69) + b(88) = b(88) - lu(297) * b(69) + b(90) = b(90) - lu(298) * b(69) + b(93) = b(93) - lu(299) * b(69) + b(94) = b(94) - lu(300) * b(69) + b(71) = b(71) - lu(307) * b(70) + b(76) = b(76) - lu(308) * b(70) + b(78) = b(78) - lu(309) * b(70) + b(81) = b(81) - lu(310) * b(70) + b(82) = b(82) - lu(311) * b(70) + b(88) = b(88) - lu(312) * b(70) + b(89) = b(89) - lu(313) * b(70) + b(90) = b(90) - lu(314) * b(70) + b(92) = b(92) - lu(315) * b(70) + b(93) = b(93) - lu(316) * b(70) + b(95) = b(95) - lu(317) * b(70) + b(76) = b(76) - lu(322) * b(71) + b(82) = b(82) - lu(323) * b(71) + b(88) = b(88) - lu(324) * b(71) + b(89) = b(89) - lu(325) * b(71) + b(90) = b(90) - lu(326) * b(71) + b(92) = b(92) - lu(327) * b(71) + b(93) = b(93) - lu(328) * b(71) + b(76) = b(76) - lu(332) * b(72) + b(78) = b(78) - lu(333) * b(72) + b(82) = b(82) - lu(334) * b(72) + b(88) = b(88) - lu(335) * b(72) + b(89) = b(89) - lu(336) * b(72) + b(90) = b(90) - lu(337) * b(72) + b(92) = b(92) - lu(338) * b(72) + b(93) = b(93) - lu(339) * b(72) + b(95) = b(95) - lu(340) * b(72) + b(82) = b(82) - lu(343) * b(73) + b(83) = b(83) - lu(344) * b(73) + b(89) = b(89) - lu(345) * b(73) + b(90) = b(90) - lu(346) * b(73) + b(93) = b(93) - lu(347) * b(73) + b(94) = b(94) - lu(348) * b(73) + b(75) = b(75) - lu(353) * b(74) + b(80) = b(80) - lu(354) * b(74) + b(82) = b(82) - lu(355) * b(74) + b(83) = b(83) - lu(356) * b(74) + b(84) = b(84) - lu(357) * b(74) + b(86) = b(86) - lu(358) * b(74) + b(87) = b(87) - lu(359) * b(74) + b(88) = b(88) - lu(360) * b(74) + b(89) = b(89) - lu(361) * b(74) + b(90) = b(90) - lu(362) * b(74) + b(91) = b(91) - lu(363) * b(74) + b(92) = b(92) - lu(364) * b(74) + b(93) = b(93) - lu(365) * b(74) + b(94) = b(94) - lu(366) * b(74) + b(76) = b(76) - lu(371) * b(75) + b(79) = b(79) - lu(372) * b(75) + b(81) = b(81) - lu(373) * b(75) + b(82) = b(82) - lu(374) * b(75) + b(88) = b(88) - lu(375) * b(75) + b(89) = b(89) - lu(376) * b(75) + b(90) = b(90) - lu(377) * b(75) + b(91) = b(91) - lu(378) * b(75) + b(92) = b(92) - lu(379) * b(75) + b(93) = b(93) - lu(380) * b(75) + b(94) = b(94) - lu(381) * b(75) + b(89) = b(89) - lu(384) * b(76) + b(90) = b(90) - lu(385) * b(76) + b(92) = b(92) - lu(386) * b(76) + b(93) = b(93) - lu(387) * b(76) + b(94) = b(94) - lu(388) * b(76) + b(95) = b(95) - lu(389) * b(76) + b(78) = b(78) - lu(393) * b(77) + b(80) = b(80) - lu(394) * b(77) + b(84) = b(84) - lu(395) * b(77) + b(88) = b(88) - lu(396) * b(77) + b(89) = b(89) - lu(397) * b(77) + b(90) = b(90) - lu(398) * b(77) + b(92) = b(92) - lu(399) * b(77) + b(93) = b(93) - lu(400) * b(77) + b(95) = b(95) - lu(401) * b(77) + b(79) = b(79) - lu(405) * b(78) + b(81) = b(81) - lu(406) * b(78) + b(82) = b(82) - lu(407) * b(78) + b(88) = b(88) - lu(408) * b(78) + b(89) = b(89) - lu(409) * b(78) + b(90) = b(90) - lu(410) * b(78) + b(92) = b(92) - lu(411) * b(78) + b(93) = b(93) - lu(412) * b(78) + b(95) = b(95) - lu(413) * b(78) + b(81) = b(81) - lu(415) * b(79) + b(82) = b(82) - lu(416) * b(79) + b(89) = b(89) - lu(417) * b(79) + b(90) = b(90) - lu(418) * b(79) + b(95) = b(95) - lu(419) * b(79) + b(81) = b(81) - lu(421) * b(80) + b(82) = b(82) - lu(422) * b(80) + b(85) = b(85) - lu(423) * b(80) + b(87) = b(87) - lu(424) * b(80) + b(89) = b(89) - lu(425) * b(80) + b(90) = b(90) - lu(426) * b(80) + b(91) = b(91) - lu(427) * b(80) + b(95) = b(95) - lu(428) * b(80) + b(89) = b(89) - lu(431) * b(81) + b(90) = b(90) - lu(432) * b(81) + b(93) = b(93) - lu(433) * b(81) + b(94) = b(94) - lu(434) * b(81) + b(95) = b(95) - lu(435) * b(81) + b(88) = b(88) - lu(439) * b(82) + b(89) = b(89) - lu(440) * b(82) + b(90) = b(90) - lu(441) * b(82) + b(93) = b(93) - lu(442) * b(82) + b(94) = b(94) - lu(443) * b(82) + b(88) = b(88) - lu(452) * b(83) + b(89) = b(89) - lu(453) * b(83) + b(90) = b(90) - lu(454) * b(83) + b(92) = b(92) - lu(455) * b(83) + b(93) = b(93) - lu(456) * b(83) + b(94) = b(94) - lu(457) * b(83) + b(95) = b(95) - lu(458) * b(83) + b(85) = b(85) - lu(465) * b(84) + b(88) = b(88) - lu(466) * b(84) + b(89) = b(89) - lu(467) * b(84) + b(90) = b(90) - lu(468) * b(84) + b(91) = b(91) - lu(469) * b(84) + b(92) = b(92) - lu(470) * b(84) + b(93) = b(93) - lu(471) * b(84) + b(94) = b(94) - lu(472) * b(84) + b(95) = b(95) - lu(473) * b(84) + b(87) = b(87) - lu(483) * b(85) + b(88) = b(88) - lu(484) * b(85) + b(89) = b(89) - lu(485) * b(85) + b(90) = b(90) - lu(486) * b(85) + b(92) = b(92) - lu(487) * b(85) + b(93) = b(93) - lu(488) * b(85) + b(94) = b(94) - lu(489) * b(85) + b(95) = b(95) - lu(490) * b(85) + b(87) = b(87) - lu(502) * b(86) + b(88) = b(88) - lu(503) * b(86) + b(89) = b(89) - lu(504) * b(86) + b(90) = b(90) - lu(505) * b(86) + b(91) = b(91) - lu(506) * b(86) + b(92) = b(92) - lu(507) * b(86) + b(93) = b(93) - lu(508) * b(86) + b(94) = b(94) - lu(509) * b(86) + b(95) = b(95) - lu(510) * b(86) + b(88) = b(88) - lu(518) * b(87) + b(89) = b(89) - lu(519) * b(87) + b(90) = b(90) - lu(520) * b(87) + b(91) = b(91) - lu(521) * b(87) + b(92) = b(92) - lu(522) * b(87) + b(93) = b(93) - lu(523) * b(87) + b(94) = b(94) - lu(524) * b(87) + b(95) = b(95) - lu(525) * b(87) + b(89) = b(89) - lu(559) * b(88) + b(90) = b(90) - lu(560) * b(88) + b(91) = b(91) - lu(561) * b(88) + b(92) = b(92) - lu(562) * b(88) + b(93) = b(93) - lu(563) * b(88) + b(94) = b(94) - lu(564) * b(88) + b(95) = b(95) - lu(565) * b(88) + b(90) = b(90) - lu(635) * b(89) + b(91) = b(91) - lu(636) * b(89) + b(92) = b(92) - lu(637) * b(89) + b(93) = b(93) - lu(638) * b(89) + b(94) = b(94) - lu(639) * b(89) + b(95) = b(95) - lu(640) * b(89) + b(91) = b(91) - lu(686) * b(90) + b(92) = b(92) - lu(687) * b(90) + b(93) = b(93) - lu(688) * b(90) + b(94) = b(94) - lu(689) * b(90) + b(95) = b(95) - lu(690) * b(90) + b(92) = b(92) - lu(717) * b(91) + b(93) = b(93) - lu(718) * b(91) + b(94) = b(94) - lu(719) * b(91) + b(95) = b(95) - lu(720) * b(91) + b(93) = b(93) - lu(747) * b(92) + b(94) = b(94) - lu(748) * b(92) + b(95) = b(95) - lu(749) * b(92) + b(94) = b(94) - lu(768) * b(93) + b(95) = b(95) - lu(769) * b(93) + b(95) = b(95) - lu(802) * b(94) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(95) = b(95) * lu(824) + b(94) = b(94) - lu(823) * b(95) + b(93) = b(93) - lu(822) * b(95) + b(92) = b(92) - lu(821) * b(95) + b(91) = b(91) - lu(820) * b(95) + b(90) = b(90) - lu(819) * b(95) + b(89) = b(89) - lu(818) * b(95) + b(88) = b(88) - lu(817) * b(95) + b(87) = b(87) - lu(816) * b(95) + b(86) = b(86) - lu(815) * b(95) + b(85) = b(85) - lu(814) * b(95) + b(84) = b(84) - lu(813) * b(95) + b(83) = b(83) - lu(812) * b(95) + b(82) = b(82) - lu(811) * b(95) + b(81) = b(81) - lu(810) * b(95) + b(80) = b(80) - lu(809) * b(95) + b(79) = b(79) - lu(808) * b(95) + b(63) = b(63) - lu(807) * b(95) + b(57) = b(57) - lu(806) * b(95) + b(50) = b(50) - lu(805) * b(95) + b(49) = b(49) - lu(804) * b(95) + b(44) = b(44) - lu(803) * b(95) + b(94) = b(94) * lu(801) + b(93) = b(93) - lu(800) * b(94) + b(92) = b(92) - lu(799) * b(94) + b(91) = b(91) - lu(798) * b(94) + b(90) = b(90) - lu(797) * b(94) + b(89) = b(89) - lu(796) * b(94) + b(88) = b(88) - lu(795) * b(94) + b(87) = b(87) - lu(794) * b(94) + b(86) = b(86) - lu(793) * b(94) + b(85) = b(85) - lu(792) * b(94) + b(84) = b(84) - lu(791) * b(94) + b(83) = b(83) - lu(790) * b(94) + b(82) = b(82) - lu(789) * b(94) + b(81) = b(81) - lu(788) * b(94) + b(80) = b(80) - lu(787) * b(94) + b(79) = b(79) - lu(786) * b(94) + b(78) = b(78) - lu(785) * b(94) + b(77) = b(77) - lu(784) * b(94) + b(76) = b(76) - lu(783) * b(94) + b(75) = b(75) - lu(782) * b(94) + b(74) = b(74) - lu(781) * b(94) + b(73) = b(73) - lu(780) * b(94) + b(69) = b(69) - lu(779) * b(94) + b(64) = b(64) - lu(778) * b(94) + b(63) = b(63) - lu(777) * b(94) + b(58) = b(58) - lu(776) * b(94) + b(54) = b(54) - lu(775) * b(94) + b(47) = b(47) - lu(774) * b(94) + b(44) = b(44) - lu(773) * b(94) + b(32) = b(32) - lu(772) * b(94) + b(31) = b(31) - lu(771) * b(94) + b(22) = b(22) - lu(770) * b(94) + b(93) = b(93) * lu(767) + b(92) = b(92) - lu(766) * b(93) + b(91) = b(91) - lu(765) * b(93) + b(90) = b(90) - lu(764) * b(93) + b(89) = b(89) - lu(763) * b(93) + b(88) = b(88) - lu(762) * b(93) + b(87) = b(87) - lu(761) * b(93) + b(82) = b(82) - lu(760) * b(93) + b(81) = b(81) - lu(759) * b(93) + b(79) = b(79) - lu(758) * b(93) + b(60) = b(60) - lu(757) * b(93) + b(59) = b(59) - lu(756) * b(93) + b(58) = b(58) - lu(755) * b(93) + b(57) = b(57) - lu(754) * b(93) + b(56) = b(56) - lu(753) * b(93) + b(41) = b(41) - lu(752) * b(93) + b(31) = b(31) - lu(751) * b(93) + b(29) = b(29) - lu(750) * b(93) + b(92) = b(92) * lu(746) + b(91) = b(91) - lu(745) * b(92) + b(90) = b(90) - lu(744) * b(92) + b(89) = b(89) - lu(743) * b(92) + b(88) = b(88) - lu(742) * b(92) + b(87) = b(87) - lu(741) * b(92) + b(86) = b(86) - lu(740) * b(92) + b(85) = b(85) - lu(739) * b(92) + b(84) = b(84) - lu(738) * b(92) + b(83) = b(83) - lu(737) * b(92) + b(82) = b(82) - lu(736) * b(92) + b(81) = b(81) - lu(735) * b(92) + b(80) = b(80) - lu(734) * b(92) + b(79) = b(79) - lu(733) * b(92) + b(78) = b(78) - lu(732) * b(92) + b(76) = b(76) - lu(731) * b(92) + b(72) = b(72) - lu(730) * b(92) + b(71) = b(71) - lu(729) * b(92) + b(68) = b(68) - lu(728) * b(92) + b(63) = b(63) - lu(727) * b(92) + b(62) = b(62) - lu(726) * b(92) + b(54) = b(54) - lu(725) * b(92) + b(50) = b(50) - lu(724) * b(92) + b(44) = b(44) - lu(723) * b(92) + b(43) = b(43) - lu(722) * b(92) + b(33) = b(33) - lu(721) * b(92) + b(91) = b(91) * lu(716) + b(90) = b(90) - lu(715) * b(91) + b(89) = b(89) - lu(714) * b(91) + b(88) = b(88) - lu(713) * b(91) + b(87) = b(87) - lu(712) * b(91) + b(86) = b(86) - lu(711) * b(91) + b(85) = b(85) - lu(710) * b(91) + b(84) = b(84) - lu(709) * b(91) + b(83) = b(83) - lu(708) * b(91) + b(82) = b(82) - lu(707) * b(91) + b(81) = b(81) - lu(706) * b(91) + b(80) = b(80) - lu(705) * b(91) + b(79) = b(79) - lu(704) * b(91) + b(78) = b(78) - lu(703) * b(91) + b(77) = b(77) - lu(702) * b(91) + b(76) = b(76) - lu(701) * b(91) + b(75) = b(75) - lu(700) * b(91) + b(74) = b(74) - lu(699) * b(91) + b(64) = b(64) - lu(698) * b(91) + b(63) = b(63) - lu(697) * b(91) + b(59) = b(59) - lu(696) * b(91) + b(50) = b(50) - lu(695) * b(91) + b(45) = b(45) - lu(694) * b(91) + b(39) = b(39) - lu(693) * b(91) + b(38) = b(38) - lu(692) * b(91) + b(30) = b(30) - lu(691) * b(91) + b(90) = b(90) * lu(685) + b(89) = b(89) - lu(684) * b(90) + b(88) = b(88) - lu(683) * b(90) + b(87) = b(87) - lu(682) * b(90) + b(86) = b(86) - lu(681) * b(90) + b(85) = b(85) - lu(680) * b(90) + b(84) = b(84) - lu(679) * b(90) + b(83) = b(83) - lu(678) * b(90) + b(82) = b(82) - lu(677) * b(90) + b(81) = b(81) - lu(676) * b(90) + b(80) = b(80) - lu(675) * b(90) + b(79) = b(79) - lu(674) * b(90) + b(78) = b(78) - lu(673) * b(90) + b(77) = b(77) - lu(672) * b(90) + b(76) = b(76) - lu(671) * b(90) + b(73) = b(73) - lu(670) * b(90) + b(72) = b(72) - lu(669) * b(90) + b(71) = b(71) - lu(668) * b(90) + b(70) = b(70) - lu(667) * b(90) + b(69) = b(69) - lu(666) * b(90) + b(68) = b(68) - lu(665) * b(90) + b(67) = b(67) - lu(664) * b(90) + b(66) = b(66) - lu(663) * b(90) + b(65) = b(65) - lu(662) * b(90) + b(61) = b(61) - lu(661) * b(90) + b(59) = b(59) - lu(660) * b(90) + b(56) = b(56) - lu(659) * b(90) + b(55) = b(55) - lu(658) * b(90) + b(54) = b(54) - lu(657) * b(90) + b(53) = b(53) - lu(656) * b(90) + b(52) = b(52) - lu(655) * b(90) + b(50) = b(50) - lu(654) * b(90) + b(49) = b(49) - lu(653) * b(90) + b(48) = b(48) - lu(652) * b(90) + b(46) = b(46) - lu(651) * b(90) + b(43) = b(43) - lu(650) * b(90) + b(42) = b(42) - lu(649) * b(90) + b(41) = b(41) - lu(648) * b(90) + b(40) = b(40) - lu(647) * b(90) + b(39) = b(39) - lu(646) * b(90) + b(37) = b(37) - lu(645) * b(90) + b(36) = b(36) - lu(644) * b(90) + b(34) = b(34) - lu(643) * b(90) + b(28) = b(28) - lu(642) * b(90) + b(26) = b(26) - lu(641) * b(90) + b(89) = b(89) * lu(634) + b(88) = b(88) - lu(633) * b(89) + b(87) = b(87) - lu(632) * b(89) + b(86) = b(86) - lu(631) * b(89) + b(85) = b(85) - lu(630) * b(89) + b(84) = b(84) - lu(629) * b(89) + b(83) = b(83) - lu(628) * b(89) + b(82) = b(82) - lu(627) * b(89) + b(81) = b(81) - lu(626) * b(89) + b(80) = b(80) - lu(625) * b(89) + b(79) = b(79) - lu(624) * b(89) + b(78) = b(78) - lu(623) * b(89) + b(77) = b(77) - lu(622) * b(89) + b(76) = b(76) - lu(621) * b(89) + b(75) = b(75) - lu(620) * b(89) + b(74) = b(74) - lu(619) * b(89) + b(73) = b(73) - lu(618) * b(89) + b(72) = b(72) - lu(617) * b(89) + b(71) = b(71) - lu(616) * b(89) + b(70) = b(70) - lu(615) * b(89) + b(68) = b(68) - lu(614) * b(89) + b(67) = b(67) - lu(613) * b(89) + b(66) = b(66) - lu(612) * b(89) + b(65) = b(65) - lu(611) * b(89) + b(64) = b(64) - lu(610) * b(89) + b(63) = b(63) - lu(609) * b(89) + b(62) = b(62) - lu(608) * b(89) + b(61) = b(61) - lu(607) * b(89) + b(60) = b(60) - lu(606) * b(89) + b(59) = b(59) - lu(605) * b(89) + b(58) = b(58) - lu(604) * b(89) + b(57) = b(57) - lu(603) * b(89) + b(56) = b(56) - lu(602) * b(89) + b(55) = b(55) - lu(601) * b(89) + b(54) = b(54) - lu(600) * b(89) + b(53) = b(53) - lu(599) * b(89) + b(52) = b(52) - lu(598) * b(89) + b(51) = b(51) - lu(597) * b(89) + b(50) = b(50) - lu(596) * b(89) + b(49) = b(49) - lu(595) * b(89) + b(47) = b(47) - lu(594) * b(89) + b(46) = b(46) - lu(593) * b(89) + b(45) = b(45) - lu(592) * b(89) + b(44) = b(44) - lu(591) * b(89) + b(43) = b(43) - lu(590) * b(89) + b(42) = b(42) - lu(589) * b(89) + b(41) = b(41) - lu(588) * b(89) + b(40) = b(40) - lu(587) * b(89) + b(39) = b(39) - lu(586) * b(89) + b(38) = b(38) - lu(585) * b(89) + b(37) = b(37) - lu(584) * b(89) + b(36) = b(36) - lu(583) * b(89) + b(35) = b(35) - lu(582) * b(89) + b(34) = b(34) - lu(581) * b(89) + b(33) = b(33) - lu(580) * b(89) + b(32) = b(32) - lu(579) * b(89) + b(29) = b(29) - lu(578) * b(89) + b(28) = b(28) - lu(577) * b(89) + b(26) = b(26) - lu(576) * b(89) + b(25) = b(25) - lu(575) * b(89) + b(24) = b(24) - lu(574) * b(89) + b(23) = b(23) - lu(573) * b(89) + b(22) = b(22) - lu(572) * b(89) + b(21) = b(21) - lu(571) * b(89) + b(20) = b(20) - lu(570) * b(89) + b(19) = b(19) - lu(569) * b(89) + b(18) = b(18) - lu(568) * b(89) + b(17) = b(17) - lu(567) * b(89) + b(1) = b(1) - lu(566) * b(89) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(88) = b(88) * lu(558) + b(87) = b(87) - lu(557) * b(88) + b(86) = b(86) - lu(556) * b(88) + b(85) = b(85) - lu(555) * b(88) + b(84) = b(84) - lu(554) * b(88) + b(83) = b(83) - lu(553) * b(88) + b(82) = b(82) - lu(552) * b(88) + b(81) = b(81) - lu(551) * b(88) + b(80) = b(80) - lu(550) * b(88) + b(79) = b(79) - lu(549) * b(88) + b(78) = b(78) - lu(548) * b(88) + b(77) = b(77) - lu(547) * b(88) + b(76) = b(76) - lu(546) * b(88) + b(73) = b(73) - lu(545) * b(88) + b(72) = b(72) - lu(544) * b(88) + b(71) = b(71) - lu(543) * b(88) + b(70) = b(70) - lu(542) * b(88) + b(69) = b(69) - lu(541) * b(88) + b(68) = b(68) - lu(540) * b(88) + b(67) = b(67) - lu(539) * b(88) + b(66) = b(66) - lu(538) * b(88) + b(63) = b(63) - lu(537) * b(88) + b(56) = b(56) - lu(536) * b(88) + b(55) = b(55) - lu(535) * b(88) + b(54) = b(54) - lu(534) * b(88) + b(51) = b(51) - lu(533) * b(88) + b(48) = b(48) - lu(532) * b(88) + b(47) = b(47) - lu(531) * b(88) + b(45) = b(45) - lu(530) * b(88) + b(44) = b(44) - lu(529) * b(88) + b(39) = b(39) - lu(528) * b(88) + b(35) = b(35) - lu(527) * b(88) + b(27) = b(27) - lu(526) * b(88) + b(87) = b(87) * lu(517) + b(82) = b(82) - lu(516) * b(87) + b(81) = b(81) - lu(515) * b(87) + b(79) = b(79) - lu(514) * b(87) + b(60) = b(60) - lu(513) * b(87) + b(50) = b(50) - lu(512) * b(87) + b(49) = b(49) - lu(511) * b(87) + b(86) = b(86) * lu(501) + b(85) = b(85) - lu(500) * b(86) + b(84) = b(84) - lu(499) * b(86) + b(83) = b(83) - lu(498) * b(86) + b(82) = b(82) - lu(497) * b(86) + b(81) = b(81) - lu(496) * b(86) + b(80) = b(80) - lu(495) * b(86) + b(73) = b(73) - lu(494) * b(86) + b(62) = b(62) - lu(493) * b(86) + b(61) = b(61) - lu(492) * b(86) + b(44) = b(44) - lu(491) * b(86) + b(85) = b(85) * lu(482) + b(83) = b(83) - lu(481) * b(85) + b(82) = b(82) - lu(480) * b(85) + b(81) = b(81) - lu(479) * b(85) + b(79) = b(79) - lu(478) * b(85) + b(73) = b(73) - lu(477) * b(85) + b(63) = b(63) - lu(476) * b(85) + b(62) = b(62) - lu(475) * b(85) + b(37) = b(37) - lu(474) * b(85) + b(84) = b(84) * lu(464) + b(82) = b(82) - lu(463) * b(84) + b(81) = b(81) - lu(462) * b(84) + b(79) = b(79) - lu(461) * b(84) + b(76) = b(76) - lu(460) * b(84) + b(75) = b(75) - lu(459) * b(84) + b(83) = b(83) * lu(451) + b(82) = b(82) - lu(450) * b(83) + b(81) = b(81) - lu(449) * b(83) + b(79) = b(79) - lu(448) * b(83) + b(63) = b(63) - lu(447) * b(83) + b(62) = b(62) - lu(446) * b(83) + b(54) = b(54) - lu(445) * b(83) + b(28) = b(28) - lu(444) * b(83) + b(82) = b(82) * lu(438) + b(58) = b(58) - lu(437) * b(82) + b(48) = b(48) - lu(436) * b(82) + b(81) = b(81) * lu(430) + b(58) = b(58) - lu(429) * b(81) + b(80) = b(80) * lu(420) + b(79) = b(79) * lu(414) + b(78) = b(78) * lu(404) + b(62) = b(62) - lu(403) * b(78) + b(34) = b(34) - lu(402) * b(78) + b(77) = b(77) * lu(392) + b(68) = b(68) - lu(391) * b(77) + b(53) = b(53) - lu(390) * b(77) + b(76) = b(76) * lu(383) + b(58) = b(58) - lu(382) * b(76) + b(75) = b(75) * lu(370) + b(67) = b(67) - lu(369) * b(75) + b(50) = b(50) - lu(368) * b(75) + b(47) = b(47) - lu(367) * b(75) + b(74) = b(74) * lu(352) + b(73) = b(73) - lu(351) * b(74) + b(69) = b(69) - lu(350) * b(74) + b(50) = b(50) - lu(349) * b(74) + b(73) = b(73) * lu(342) + b(44) = b(44) - lu(341) * b(73) + b(72) = b(72) * lu(331) + b(68) = b(68) - lu(330) * b(72) + b(40) = b(40) - lu(329) * b(72) + b(71) = b(71) * lu(321) + b(62) = b(62) - lu(320) * b(71) + b(42) = b(42) - lu(319) * b(71) + b(33) = b(33) - lu(318) * b(71) + b(70) = b(70) * lu(306) + b(68) = b(68) - lu(305) * b(70) + b(66) = b(66) - lu(304) * b(70) + b(65) = b(65) - lu(303) * b(70) + b(51) = b(51) - lu(302) * b(70) + b(47) = b(47) - lu(301) * b(70) + b(69) = b(69) * lu(292) + b(68) = b(68) * lu(287) + b(67) = b(67) * lu(279) + b(52) = b(52) - lu(278) * b(67) + b(66) = b(66) * lu(271) + b(36) = b(36) - lu(270) * b(66) + b(65) = b(65) * lu(260) + b(51) = b(51) - lu(259) * b(65) + b(64) = b(64) * lu(250) + b(63) = b(63) * lu(246) + b(54) = b(54) - lu(245) * b(63) + b(62) = b(62) * lu(241) + b(61) = b(61) * lu(233) + b(60) = b(60) * lu(225) + b(59) = b(59) * lu(219) + b(58) = b(58) * lu(215) + b(57) = b(57) * lu(208) + b(56) = b(56) * lu(203) + b(54) = b(54) - lu(202) * b(56) + b(55) = b(55) * lu(195) + b(54) = b(54) - lu(194) * b(55) + b(46) = b(46) - lu(193) * b(55) + b(54) = b(54) * lu(190) + b(53) = b(53) * lu(183) + b(52) = b(52) * lu(176) + b(51) = b(51) * lu(171) + b(50) = b(50) * lu(168) + b(49) = b(49) * lu(163) + b(48) = b(48) * lu(157) + b(39) = b(39) - lu(156) * b(48) + b(47) = b(47) * lu(152) + b(46) = b(46) * lu(146) + b(45) = b(45) * lu(140) + b(27) = b(27) - lu(139) * b(45) + b(44) = b(44) * lu(136) + b(43) = b(43) * lu(131) + b(42) = b(42) * lu(126) + b(41) = b(41) * lu(121) + b(40) = b(40) * lu(116) + b(39) = b(39) * lu(113) + b(38) = b(38) * lu(106) + b(37) = b(37) * lu(101) + b(36) = b(36) * lu(96) + b(35) = b(35) * lu(89) + b(34) = b(34) * lu(84) + b(33) = b(33) * lu(80) + b(32) = b(32) * lu(75) + b(22) = b(22) - lu(74) * b(32) + b(31) = b(31) * lu(70) + b(30) = b(30) * lu(63) + b(29) = b(29) * lu(59) + b(28) = b(28) * lu(56) + b(27) = b(27) * lu(52) + b(26) = b(26) * lu(49) + b(25) = b(25) * lu(44) + b(24) = b(24) * lu(41) + b(23) = b(23) * lu(36) + b(22) = b(22) * lu(34) + b(1) = b(1) - lu(33) * b(22) + b(21) = b(21) * lu(30) + b(20) = b(20) * lu(27) + b(19) = b(19) * lu(24) + b(18) = b(18) * lu(21) + b(17) = b(17) * lu(19) + b(16) = b(16) * lu(18) + b(15) = b(15) * lu(17) + b(14) = b(14) * lu(16) + b(13) = b(13) * lu(15) + b(12) = b(12) * lu(14) + b(11) = b(11) * lu(13) + b(10) = b(10) * lu(12) + b(9) = b(9) * lu(11) + b(8) = b(8) * lu(10) + b(7) = b(7) * lu(8) + b(6) = b(6) * lu(7) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv04 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 new file mode 100644 index 0000000000..e7de9dc324 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_nln_matrix.F90 @@ -0,0 +1,1349 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(716) = -(rxt(42)*y(2) + rxt(50)*y(12) + rxt(51)*y(13) + rxt(60)*y(5) & + + rxt(62)*y(6) + rxt(91)*y(22) + rxt(116)*y(33) + rxt(147)*y(50) & + + rxt(159)*y(53) + rxt(161)*y(54) + rxt(194)*y(63)) + mat(223) = -rxt(42)*y(1) + mat(636) = -rxt(50)*y(1) + mat(686) = -rxt(51)*y(1) + mat(561) = -rxt(60)*y(1) + mat(765) = -rxt(62)*y(1) + mat(112) = -rxt(91)*y(1) + mat(378) = -rxt(116)*y(1) + mat(363) = -rxt(147)*y(1) + mat(469) = -rxt(159)*y(1) + mat(427) = -rxt(161)*y(1) + mat(256) = -rxt(194)*y(1) + mat(716) = mat(716) + .100_r8*rxt(147)*y(50) + .200_r8*rxt(159)*y(53) & + + .200_r8*rxt(161)*y(54) + mat(686) = mat(686) + .250_r8*rxt(105)*y(31) + .250_r8*rxt(171)*y(57) + mat(820) = .250_r8*rxt(105)*y(13) + mat(363) = mat(363) + .100_r8*rxt(147)*y(1) + mat(469) = mat(469) + .200_r8*rxt(159)*y(1) + mat(427) = mat(427) + .200_r8*rxt(161)*y(1) + mat(521) = .250_r8*rxt(171)*y(13) + mat(219) = -(rxt(42)*y(1) + rxt(48)*y(12) + rxt(49)*y(13) + rxt(61)*y(6)) + mat(696) = -rxt(42)*y(2) + mat(605) = -rxt(48)*y(2) + mat(660) = -rxt(49)*y(2) + mat(756) = -rxt(61)*y(2) + mat(605) = mat(605) + 2.000_r8*rxt(55)*y(12) + mat(558) = -(rxt(59)*y(13) + rxt(60)*y(1) + rxt(68)*y(7) + rxt(74)*y(17) & + + rxt(87)*y(103) + rxt(92)*y(24) + rxt(96)*y(28) + rxt(103) & + *y(31) + rxt(118)*y(37) + rxt(122)*y(35) + rxt(127)*y(40) & + + rxt(136)*y(43) + rxt(138)*y(45) + rxt(143)*y(48) + rxt(148) & + *y(51) + rxt(155)*y(76) + (rxt(162) + rxt(163)) * y(55) + rxt(169) & + *y(57) + rxt(180)*y(61) + rxt(190)*y(68) + rxt(196)*y(64)) + mat(683) = -rxt(59)*y(5) + mat(713) = -rxt(60)*y(5) + mat(795) = -rxt(68)*y(5) + mat(742) = -rxt(74)*y(5) + mat(159) = -rxt(87)*y(5) + mat(143) = -rxt(92)*y(5) + mat(324) = -rxt(96)*y(5) + mat(817) = -rxt(103)*y(5) + mat(283) = -rxt(118)*y(5) + mat(335) = -rxt(122)*y(5) + mat(408) = -rxt(127)*y(5) + mat(93) = -rxt(136)*y(5) + mat(273) = -rxt(138)*y(5) + mat(312) = -rxt(143)*y(5) + mat(503) = -rxt(148)*y(5) + mat(297) = -rxt(155)*y(5) + mat(484) = -(rxt(162) + rxt(163)) * y(5) + mat(518) = -rxt(169)*y(5) + mat(452) = -rxt(180)*y(5) + mat(198) = -rxt(190)*y(5) + mat(396) = -rxt(196)*y(5) + mat(220) = rxt(61)*y(6) + mat(762) = rxt(61)*y(2) + mat(767) = -(rxt(61)*y(2) + rxt(62)*y(1) + rxt(64)*y(7) + rxt(66)*y(12) & + + rxt(69)*y(13) + rxt(104)*y(31) + rxt(175)*y(57) + rxt(189) & + *y(70)) + mat(224) = -rxt(61)*y(6) + mat(718) = -rxt(62)*y(6) + mat(800) = -rxt(64)*y(6) + mat(638) = -rxt(66)*y(6) + mat(688) = -rxt(69)*y(6) + mat(822) = -rxt(104)*y(6) + mat(523) = -rxt(175)*y(6) + mat(62) = -rxt(189)*y(6) + mat(718) = mat(718) + rxt(60)*y(5) + mat(563) = rxt(60)*y(1) + 2.000_r8*rxt(68)*y(7) + rxt(59)*y(13) + rxt(74) & + *y(17) + rxt(92)*y(24) + rxt(96)*y(28) + rxt(103)*y(31) & + + rxt(122)*y(35) + rxt(118)*y(37) + rxt(127)*y(40) + rxt(136) & + *y(43) + .900_r8*rxt(143)*y(48) + rxt(138)*y(45) & + + .920_r8*rxt(148)*y(51) + rxt(162)*y(55) + rxt(169)*y(57) & + + rxt(180)*y(61) + rxt(196)*y(64) + .900_r8*rxt(190)*y(68) & + + 1.206_r8*rxt(155)*y(76) + rxt(87)*y(103) + mat(767) = mat(767) + .700_r8*rxt(189)*y(70) + mat(800) = mat(800) + 2.000_r8*rxt(68)*y(5) + rxt(63)*y(13) + rxt(149)*y(51) & + + rxt(164)*y(55) + rxt(170)*y(57) + rxt(181)*y(61) + rxt(195) & + *y(63) + 1.206_r8*rxt(156)*y(76) + rxt(178)*y(77) + mat(124) = rxt(70)*y(12) + mat(638) = mat(638) + rxt(70)*y(9) + rxt(131)*y(74) + .400_r8*rxt(177)*y(77) + mat(688) = mat(688) + rxt(59)*y(5) + rxt(63)*y(7) + .206_r8*rxt(157)*y(76) + mat(747) = rxt(74)*y(5) + mat(145) = rxt(92)*y(5) + mat(328) = rxt(96)*y(5) + mat(822) = mat(822) + rxt(103)*y(5) + mat(339) = rxt(122)*y(5) + mat(286) = rxt(118)*y(5) + mat(412) = rxt(127)*y(5) + mat(95) = rxt(136)*y(5) + mat(316) = .900_r8*rxt(143)*y(5) + mat(276) = rxt(138)*y(5) + mat(508) = .920_r8*rxt(148)*y(5) + rxt(149)*y(7) + mat(488) = rxt(162)*y(5) + rxt(164)*y(7) + mat(523) = mat(523) + rxt(169)*y(5) + rxt(170)*y(7) + mat(456) = rxt(180)*y(5) + rxt(181)*y(7) + mat(257) = rxt(195)*y(7) + mat(400) = rxt(196)*y(5) + mat(201) = .900_r8*rxt(190)*y(5) + mat(62) = mat(62) + .700_r8*rxt(189)*y(6) + mat(155) = rxt(131)*y(12) + mat(299) = 1.206_r8*rxt(155)*y(5) + 1.206_r8*rxt(156)*y(7) + .206_r8*rxt(157) & + *y(13) + mat(347) = rxt(178)*y(7) + .400_r8*rxt(177)*y(12) + mat(162) = rxt(87)*y(5) + mat(801) = -(rxt(63)*y(13) + rxt(64)*y(6) + rxt(68)*y(5) + rxt(79)*y(19) & + + rxt(102)*y(30) + rxt(117)*y(33) + rxt(133)*y(60) + rxt(149) & + *y(51) + rxt(154)*y(50) + rxt(156)*y(76) + rxt(164)*y(55) & + + rxt(170)*y(57) + rxt(178)*y(77) + rxt(181)*y(61) + rxt(195) & + *y(63) + rxt(207)*y(84)) + mat(689) = -rxt(63)*y(7) + mat(768) = -rxt(64)*y(7) + mat(564) = -rxt(68)*y(7) + mat(443) = -rxt(79)*y(7) + mat(388) = -rxt(102)*y(7) + mat(381) = -rxt(117)*y(7) + mat(434) = -rxt(133)*y(7) + mat(509) = -rxt(149)*y(7) + mat(366) = -rxt(154)*y(7) + mat(300) = -rxt(156)*y(7) + mat(489) = -rxt(164)*y(7) + mat(524) = -rxt(170)*y(7) + mat(348) = -rxt(178)*y(7) + mat(457) = -rxt(181)*y(7) + mat(258) = -rxt(195)*y(7) + mat(79) = -rxt(207)*y(7) + mat(719) = rxt(62)*y(6) + mat(768) = mat(768) + rxt(62)*y(1) + mat(218) = rxt(67)*y(12) + mat(639) = rxt(67)*y(8) + rxt(108)*y(73) + .500_r8*rxt(141)*y(75) + mat(213) = rxt(108)*y(12) + mat(232) = .500_r8*rxt(141)*y(12) + mat(215) = -(rxt(67)*y(12)) + mat(604) = -rxt(67)*y(8) + mat(755) = rxt(66)*y(12) + mat(776) = rxt(79)*y(19) + rxt(102)*y(30) + rxt(133)*y(60) + rxt(207)*y(84) + mat(604) = mat(604) + rxt(66)*y(6) + mat(437) = rxt(79)*y(7) + mat(382) = rxt(102)*y(7) + mat(429) = rxt(133)*y(7) + mat(76) = rxt(207)*y(7) + mat(121) = -(rxt(70)*y(12)) + mat(588) = -rxt(70)*y(9) + mat(752) = rxt(69)*y(13) + mat(648) = rxt(69)*y(6) + mat(751) = rxt(64)*y(7) + mat(771) = rxt(64)*y(6) + mat(634) = -(rxt(48)*y(2) + rxt(50)*y(1) + rxt(53)*y(14) + rxt(54)*y(13) & + + (4._r8*rxt(55) + 4._r8*rxt(56)) * y(12) + rxt(66)*y(6) + rxt(67) & + *y(8) + rxt(70)*y(9) + rxt(78)*y(18) + rxt(80)*y(19) + rxt(83) & + *y(20) + rxt(84)*y(102) + rxt(89)*y(101) + rxt(90)*y(22) + rxt(95) & + *y(27) + rxt(100)*y(29) + rxt(101)*y(30) + rxt(107)*y(32) & + + rxt(108)*y(73) + rxt(111)*y(26) + rxt(112)*y(72) + rxt(113) & + *y(25) + rxt(114)*y(21) + rxt(115)*y(33) + rxt(120)*y(38) & + + rxt(121)*y(34) + rxt(125)*y(36) + rxt(126)*y(39) + rxt(130) & + *y(41) + rxt(131)*y(74) + rxt(132)*y(60) + rxt(134)*y(59) & + + rxt(135)*y(42) + rxt(137)*y(44) + rxt(140)*y(46) + rxt(141) & + *y(75) + rxt(142)*y(47) + rxt(145)*y(49) + rxt(146)*y(50) & + + rxt(151)*y(52) + rxt(158)*y(53) + rxt(160)*y(54) + rxt(168) & + *y(56) + rxt(177)*y(77) + rxt(179)*y(58) + rxt(185)*y(62) & + + rxt(187)*y(66) + rxt(188)*y(67) + rxt(192)*y(69) + rxt(193) & + *y(63) + rxt(198)*y(65) + rxt(204)*y(83) + (rxt(205) + rxt(206) & + ) * y(84) + rxt(208)*y(86)) + mat(221) = -rxt(48)*y(12) + mat(714) = -rxt(50)*y(12) + mat(50) = -rxt(53)*y(12) + mat(684) = -rxt(54)*y(12) + mat(763) = -rxt(66)*y(12) + mat(216) = -rxt(67)*y(12) + mat(122) = -rxt(70)*y(12) + mat(133) = -rxt(78)*y(12) + mat(440) = -rxt(80)*y(12) + mat(243) = -rxt(83)*y(12) + mat(114) = -rxt(84)*y(12) + mat(47) = -rxt(89)*y(12) + mat(110) = -rxt(90)*y(12) + mat(23) = -rxt(95)*y(12) + mat(129) = -rxt(100)*y(12) + mat(384) = -rxt(101)*y(12) + mat(165) = -rxt(107)*y(12) + mat(210) = -rxt(108)*y(12) + mat(248) = -rxt(111)*y(12) + mat(191) = -rxt(112)*y(12) + mat(169) = -rxt(113)*y(12) + mat(82) = -rxt(114)*y(12) + mat(376) = -rxt(115)*y(12) + mat(181) = -rxt(120)*y(12) + mat(26) = -rxt(121)*y(12) + mat(119) = -rxt(125)*y(12) + mat(289) = -rxt(126)*y(12) + mat(87) = -rxt(130)*y(12) + mat(154) = -rxt(131)*y(12) + mat(431) = -rxt(132)*y(12) + mat(417) = -rxt(134)*y(12) + mat(29) = -rxt(135)*y(12) + mat(174) = -rxt(137)*y(12) + mat(99) = -rxt(140)*y(12) + mat(229) = -rxt(141)*y(12) + mat(32) = -rxt(142)*y(12) + mat(267) = -rxt(145)*y(12) + mat(361) = -rxt(146)*y(12) + mat(239) = -rxt(151)*y(12) + mat(467) = -rxt(158)*y(12) + mat(425) = -rxt(160)*y(12) + mat(104) = -rxt(168)*y(12) + mat(345) = -rxt(177)*y(12) + mat(138) = -rxt(179)*y(12) + mat(58) = -rxt(185)*y(12) + mat(39) = -rxt(187)*y(12) + mat(43) = -rxt(188)*y(12) + mat(151) = -rxt(192)*y(12) + mat(254) = -rxt(193)*y(12) + mat(188) = -rxt(198)*y(12) + mat(35) = -rxt(204)*y(12) + mat(77) = -(rxt(205) + rxt(206)) * y(12) + mat(20) = -rxt(208)*y(12) + mat(714) = mat(714) + rxt(51)*y(13) + .120_r8*rxt(91)*y(22) & + + .330_r8*rxt(116)*y(33) + .270_r8*rxt(147)*y(50) & + + .080_r8*rxt(159)*y(53) + .215_r8*rxt(161)*y(54) & + + .700_r8*rxt(194)*y(63) + mat(221) = mat(221) + rxt(49)*y(13) + mat(559) = rxt(59)*y(13) + mat(796) = rxt(63)*y(13) + mat(634) = mat(634) + .300_r8*rxt(78)*y(18) + .500_r8*rxt(100)*y(29) & + + .500_r8*rxt(120)*y(38) + .100_r8*rxt(168)*y(56) & + + .650_r8*rxt(89)*y(101) + mat(684) = mat(684) + rxt(51)*y(1) + rxt(49)*y(2) + rxt(59)*y(5) + rxt(63) & + *y(7) + mat(133) = mat(133) + .300_r8*rxt(78)*y(12) + mat(110) = mat(110) + .120_r8*rxt(91)*y(1) + mat(129) = mat(129) + .500_r8*rxt(100)*y(12) + mat(376) = mat(376) + .330_r8*rxt(116)*y(1) + mat(181) = mat(181) + .500_r8*rxt(120)*y(12) + mat(361) = mat(361) + .270_r8*rxt(147)*y(1) + mat(467) = mat(467) + .080_r8*rxt(159)*y(1) + mat(425) = mat(425) + .215_r8*rxt(161)*y(1) + mat(104) = mat(104) + .100_r8*rxt(168)*y(12) + mat(254) = mat(254) + .700_r8*rxt(194)*y(1) + mat(47) = mat(47) + .650_r8*rxt(89)*y(12) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(685) = -(rxt(49)*y(2) + rxt(51)*y(1) + 4._r8*rxt(52)*y(13) + rxt(54) & + *y(12) + rxt(59)*y(5) + rxt(63)*y(7) + rxt(69)*y(6) + rxt(77) & + *y(17) + rxt(85)*y(19) + rxt(88)*y(103) + rxt(97)*y(28) + rxt(105) & + *y(31) + rxt(119)*y(37) + rxt(123)*y(35) + rxt(128)*y(40) & + + rxt(139)*y(45) + rxt(144)*y(48) + rxt(150)*y(51) + rxt(157) & + *y(76) + rxt(165)*y(55) + rxt(171)*y(57) + rxt(182)*y(61) & + + rxt(191)*y(68) + rxt(197)*y(64)) + mat(222) = -rxt(49)*y(13) + mat(715) = -rxt(51)*y(13) + mat(635) = -rxt(54)*y(13) + mat(560) = -rxt(59)*y(13) + mat(797) = -rxt(63)*y(13) + mat(764) = -rxt(69)*y(13) + mat(744) = -rxt(77)*y(13) + mat(441) = -rxt(85)*y(13) + mat(161) = -rxt(88)*y(13) + mat(326) = -rxt(97)*y(13) + mat(819) = -rxt(105)*y(13) + mat(285) = -rxt(119)*y(13) + mat(337) = -rxt(123)*y(13) + mat(410) = -rxt(128)*y(13) + mat(275) = -rxt(139)*y(13) + mat(314) = -rxt(144)*y(13) + mat(505) = -rxt(150)*y(13) + mat(298) = -rxt(157)*y(13) + mat(486) = -rxt(165)*y(13) + mat(520) = -rxt(171)*y(13) + mat(454) = -rxt(182)*y(13) + mat(200) = -rxt(191)*y(13) + mat(398) = -rxt(197)*y(13) + mat(715) = mat(715) + rxt(50)*y(12) + .120_r8*rxt(91)*y(22) & + + .190_r8*rxt(116)*y(33) + .060_r8*rxt(147)*y(50) & + + .060_r8*rxt(159)*y(53) + .275_r8*rxt(161)*y(54) + rxt(194) & + *y(63) + mat(222) = mat(222) + rxt(48)*y(12) + mat(560) = mat(560) + rxt(74)*y(17) + rxt(96)*y(28) + rxt(122)*y(35) & + + rxt(118)*y(37) + rxt(136)*y(43) + .900_r8*rxt(143)*y(48) & + + rxt(148)*y(51) + .470_r8*rxt(162)*y(55) + rxt(180)*y(61) & + + rxt(196)*y(64) + .900_r8*rxt(190)*y(68) + .794_r8*rxt(155) & + *y(76) + rxt(87)*y(103) + mat(764) = mat(764) + .700_r8*rxt(189)*y(70) + mat(797) = mat(797) + rxt(79)*y(19) + rxt(149)*y(51) + .470_r8*rxt(164)*y(55) & + + rxt(181)*y(61) + .794_r8*rxt(156)*y(76) + rxt(178)*y(77) + mat(635) = mat(635) + rxt(50)*y(1) + rxt(48)*y(2) + rxt(53)*y(14) + rxt(80) & + *y(19) + rxt(83)*y(20) + rxt(114)*y(21) + .250_r8*rxt(90)*y(22) & + + rxt(111)*y(26) + .200_r8*rxt(168)*y(56) + rxt(134)*y(59) & + + .250_r8*rxt(187)*y(66) + rxt(112)*y(72) + .500_r8*rxt(141) & + *y(75) + rxt(177)*y(77) + .500_r8*rxt(206)*y(84) & + + .350_r8*rxt(89)*y(101) + rxt(84)*y(102) + mat(685) = mat(685) + .794_r8*rxt(157)*y(76) + mat(51) = rxt(53)*y(12) + mat(744) = mat(744) + rxt(74)*y(5) + 4.000_r8*rxt(75)*y(17) + rxt(98)*y(28) & + + .900_r8*rxt(106)*y(31) + rxt(124)*y(35) + .300_r8*rxt(129) & + *y(40) + rxt(152)*y(51) + .730_r8*rxt(166)*y(55) + rxt(172) & + *y(57) + .800_r8*rxt(183)*y(61) + mat(441) = mat(441) + rxt(79)*y(7) + rxt(80)*y(12) + mat(244) = rxt(83)*y(12) + mat(83) = rxt(114)*y(12) + mat(111) = .120_r8*rxt(91)*y(1) + .250_r8*rxt(90)*y(12) + mat(249) = rxt(111)*y(12) + mat(326) = mat(326) + rxt(96)*y(5) + rxt(98)*y(17) + 2.400_r8*rxt(99)*y(28) + mat(819) = mat(819) + .900_r8*rxt(106)*y(17) + rxt(153)*y(51) & + + .470_r8*rxt(167)*y(55) + rxt(184)*y(61) + mat(377) = .190_r8*rxt(116)*y(1) + mat(337) = mat(337) + rxt(122)*y(5) + rxt(124)*y(17) + mat(285) = mat(285) + rxt(118)*y(5) + mat(410) = mat(410) + .300_r8*rxt(129)*y(17) + mat(94) = rxt(136)*y(5) + mat(314) = mat(314) + .900_r8*rxt(143)*y(5) + mat(362) = .060_r8*rxt(147)*y(1) + mat(505) = mat(505) + rxt(148)*y(5) + rxt(149)*y(7) + rxt(152)*y(17) & + + rxt(153)*y(31) + mat(468) = .060_r8*rxt(159)*y(1) + mat(426) = .275_r8*rxt(161)*y(1) + mat(486) = mat(486) + .470_r8*rxt(162)*y(5) + .470_r8*rxt(164)*y(7) & + + .730_r8*rxt(166)*y(17) + .470_r8*rxt(167)*y(31) + mat(105) = .200_r8*rxt(168)*y(12) + mat(520) = mat(520) + rxt(172)*y(17) + mat(418) = rxt(134)*y(12) + mat(454) = mat(454) + rxt(180)*y(5) + rxt(181)*y(7) + .800_r8*rxt(183)*y(17) & + + rxt(184)*y(31) + mat(255) = rxt(194)*y(1) + mat(398) = mat(398) + rxt(196)*y(5) + mat(40) = .250_r8*rxt(187)*y(12) + mat(200) = mat(200) + .900_r8*rxt(190)*y(5) + mat(61) = .700_r8*rxt(189)*y(6) + mat(192) = rxt(112)*y(12) + mat(230) = .500_r8*rxt(141)*y(12) + mat(298) = mat(298) + .794_r8*rxt(155)*y(5) + .794_r8*rxt(156)*y(7) & + + .794_r8*rxt(157)*y(13) + mat(346) = rxt(178)*y(7) + rxt(177)*y(12) + mat(78) = .500_r8*rxt(206)*y(12) + mat(48) = .350_r8*rxt(89)*y(12) + mat(115) = rxt(84)*y(12) + mat(161) = mat(161) + rxt(87)*y(5) + mat(49) = -(rxt(53)*y(12)) + mat(576) = -rxt(53)*y(14) + mat(576) = mat(576) + 2.000_r8*rxt(56)*y(12) + mat(641) = 2.000_r8*rxt(52)*y(13) + mat(746) = -(rxt(74)*y(5) + (4._r8*rxt(75) + 4._r8*rxt(76)) * y(17) + rxt(77) & + *y(13) + rxt(98)*y(28) + rxt(106)*y(31) + rxt(124)*y(35) + rxt(129) & + *y(40) + rxt(152)*y(51) + rxt(166)*y(55) + rxt(172)*y(57) & + + rxt(183)*y(61)) + mat(562) = -rxt(74)*y(17) + mat(687) = -rxt(77)*y(17) + mat(327) = -rxt(98)*y(17) + mat(821) = -rxt(106)*y(17) + mat(338) = -rxt(124)*y(17) + mat(411) = -rxt(129)*y(17) + mat(507) = -rxt(152)*y(17) + mat(487) = -rxt(166)*y(17) + mat(522) = -rxt(172)*y(17) + mat(455) = -rxt(183)*y(17) + mat(717) = .310_r8*rxt(116)*y(33) + mat(562) = mat(562) + rxt(103)*y(31) + mat(637) = .700_r8*rxt(78)*y(18) + rxt(113)*y(25) + mat(746) = mat(746) + .900_r8*rxt(106)*y(31) + mat(135) = .700_r8*rxt(78)*y(12) + mat(170) = rxt(113)*y(12) + mat(821) = mat(821) + rxt(103)*y(5) + .900_r8*rxt(106)*y(17) & + + 4.000_r8*rxt(110)*y(31) + rxt(153)*y(51) + rxt(167)*y(55) & + + rxt(173)*y(57) + rxt(184)*y(61) + mat(379) = .310_r8*rxt(116)*y(1) + mat(507) = mat(507) + rxt(153)*y(31) + mat(487) = mat(487) + rxt(167)*y(31) + mat(522) = mat(522) + rxt(173)*y(31) + mat(455) = mat(455) + rxt(184)*y(31) + mat(131) = -(rxt(78)*y(12)) + mat(590) = -rxt(78)*y(18) + mat(650) = rxt(77)*y(17) + mat(722) = rxt(77)*y(13) + mat(438) = -(rxt(79)*y(7) + rxt(80)*y(12) + rxt(85)*y(13)) + mat(789) = -rxt(79)*y(19) + mat(627) = -rxt(80)*y(19) + mat(677) = -rxt(85)*y(19) + mat(707) = rxt(91)*y(22) + .540_r8*rxt(116)*y(33) + .600_r8*rxt(147)*y(50) & + + .800_r8*rxt(159)*y(53) + .700_r8*rxt(161)*y(54) + mat(552) = rxt(74)*y(17) + rxt(118)*y(37) + rxt(127)*y(40) + .500_r8*rxt(136) & + *y(43) + .100_r8*rxt(143)*y(48) + .550_r8*rxt(148)*y(51) & + + .250_r8*rxt(162)*y(55) + rxt(169)*y(57) + .072_r8*rxt(155) & + *y(76) + mat(789) = mat(789) + .600_r8*rxt(149)*y(51) + .250_r8*rxt(164)*y(55) & + + rxt(170)*y(57) + .072_r8*rxt(156)*y(76) + mat(627) = mat(627) + .300_r8*rxt(78)*y(18) + rxt(83)*y(20) + .500_r8*rxt(90) & + *y(22) + .800_r8*rxt(111)*y(26) + .500_r8*rxt(107)*y(32) & + + rxt(108)*y(73) + .500_r8*rxt(141)*y(75) + mat(677) = mat(677) + .008_r8*rxt(157)*y(76) + mat(736) = rxt(74)*y(5) + (4.000_r8*rxt(75)+2.000_r8*rxt(76))*y(17) & + + .700_r8*rxt(98)*y(28) + rxt(106)*y(31) + rxt(124)*y(35) & + + .800_r8*rxt(129)*y(40) + 1.200_r8*rxt(152)*y(51) & + + .880_r8*rxt(166)*y(55) + 2.000_r8*rxt(172)*y(57) & + + .700_r8*rxt(183)*y(61) + mat(132) = .300_r8*rxt(78)*y(12) + mat(242) = rxt(83)*y(12) + mat(109) = rxt(91)*y(1) + .500_r8*rxt(90)*y(12) + mat(247) = .800_r8*rxt(111)*y(12) + mat(323) = .700_r8*rxt(98)*y(17) + mat(811) = rxt(106)*y(17) + .600_r8*rxt(153)*y(51) + .250_r8*rxt(167)*y(55) & + + rxt(173)*y(57) + mat(164) = .500_r8*rxt(107)*y(12) + mat(374) = .540_r8*rxt(116)*y(1) + mat(334) = rxt(124)*y(17) + mat(282) = rxt(118)*y(5) + mat(407) = rxt(127)*y(5) + .800_r8*rxt(129)*y(17) + mat(92) = .500_r8*rxt(136)*y(5) + mat(311) = .100_r8*rxt(143)*y(5) + mat(355) = .600_r8*rxt(147)*y(1) + mat(497) = .550_r8*rxt(148)*y(5) + .600_r8*rxt(149)*y(7) + 1.200_r8*rxt(152) & + *y(17) + .600_r8*rxt(153)*y(31) + mat(463) = .800_r8*rxt(159)*y(1) + mat(422) = .700_r8*rxt(161)*y(1) + mat(480) = .250_r8*rxt(162)*y(5) + .250_r8*rxt(164)*y(7) + .880_r8*rxt(166) & + *y(17) + .250_r8*rxt(167)*y(31) + mat(516) = rxt(169)*y(5) + rxt(170)*y(7) + 2.000_r8*rxt(172)*y(17) + rxt(173) & + *y(31) + 4.000_r8*rxt(174)*y(57) + mat(450) = .700_r8*rxt(183)*y(17) + mat(209) = rxt(108)*y(12) + mat(227) = .500_r8*rxt(141)*y(12) + mat(295) = .072_r8*rxt(155)*y(5) + .072_r8*rxt(156)*y(7) + .008_r8*rxt(157) & + *y(13) + mat(241) = -(rxt(83)*y(12)) + mat(608) = -rxt(83)*y(20) + mat(726) = 2.000_r8*rxt(76)*y(17) + .300_r8*rxt(98)*y(28) + .500_r8*rxt(129) & + *y(40) + .250_r8*rxt(152)*y(51) + .250_r8*rxt(166)*y(55) & + + .300_r8*rxt(183)*y(61) + mat(320) = .300_r8*rxt(98)*y(17) + mat(403) = .500_r8*rxt(129)*y(17) + mat(493) = .250_r8*rxt(152)*y(17) + mat(475) = .250_r8*rxt(166)*y(17) + mat(446) = .300_r8*rxt(183)*y(17) + mat(80) = -(rxt(114)*y(12)) + mat(580) = -rxt(114)*y(21) + mat(721) = .200_r8*rxt(98)*y(28) + mat(318) = .200_r8*rxt(98)*y(17) + .800_r8*rxt(99)*y(28) + mat(106) = -(rxt(90)*y(12) + rxt(91)*y(1)) + mat(585) = -rxt(90)*y(22) + mat(692) = -rxt(91)*y(22) + mat(526) = rxt(92)*y(24) + mat(139) = rxt(92)*y(5) + mat(140) = -(rxt(92)*y(5)) + mat(530) = -rxt(92)*y(24) + mat(592) = .750_r8*rxt(90)*y(22) + mat(108) = .750_r8*rxt(90)*y(12) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(168) = -(rxt(113)*y(12)) + mat(596) = -rxt(113)*y(25) + mat(695) = .250_r8*rxt(116)*y(33) + .200_r8*rxt(147)*y(50) + mat(654) = .250_r8*rxt(105)*y(31) + .250_r8*rxt(171)*y(57) + mat(724) = .100_r8*rxt(106)*y(31) + mat(805) = .250_r8*rxt(105)*y(13) + .100_r8*rxt(106)*y(17) + mat(368) = .250_r8*rxt(116)*y(1) + mat(349) = .200_r8*rxt(147)*y(1) + mat(512) = .250_r8*rxt(171)*y(13) + mat(246) = -(rxt(111)*y(12)) + mat(609) = -rxt(111)*y(26) + mat(537) = .530_r8*rxt(162)*y(55) + .250_r8*rxt(180)*y(61) + mat(777) = .530_r8*rxt(164)*y(55) + .250_r8*rxt(181)*y(61) + mat(727) = .260_r8*rxt(166)*y(55) + .100_r8*rxt(183)*y(61) + mat(807) = .530_r8*rxt(167)*y(55) + .250_r8*rxt(184)*y(61) + mat(476) = .530_r8*rxt(162)*y(5) + .530_r8*rxt(164)*y(7) + .260_r8*rxt(166) & + *y(17) + .530_r8*rxt(167)*y(31) + mat(447) = .250_r8*rxt(180)*y(5) + .250_r8*rxt(181)*y(7) + .100_r8*rxt(183) & + *y(17) + .250_r8*rxt(184)*y(31) + mat(21) = -(rxt(95)*y(12)) + mat(568) = -rxt(95)*y(27) + mat(321) = -(rxt(96)*y(5) + rxt(97)*y(13) + rxt(98)*y(17) + 4._r8*rxt(99) & + *y(28)) + mat(543) = -rxt(96)*y(28) + mat(668) = -rxt(97)*y(28) + mat(729) = -rxt(98)*y(28) + mat(616) = rxt(95)*y(27) + .500_r8*rxt(100)*y(29) + mat(22) = rxt(95)*y(12) + mat(127) = .500_r8*rxt(100)*y(12) + mat(126) = -(rxt(100)*y(12)) + mat(589) = -rxt(100)*y(29) + mat(649) = rxt(97)*y(28) + mat(319) = rxt(97)*y(13) + mat(383) = -(rxt(101)*y(12) + rxt(102)*y(7)) + mat(621) = -rxt(101)*y(30) + mat(783) = -rxt(102)*y(30) + mat(701) = .500_r8*rxt(116)*y(33) + .040_r8*rxt(159)*y(53) + mat(546) = rxt(96)*y(28) + .270_r8*rxt(122)*y(35) + rxt(118)*y(37) + rxt(136) & + *y(43) + .400_r8*rxt(143)*y(48) + rxt(138)*y(45) + mat(621) = mat(621) + rxt(114)*y(21) + .500_r8*rxt(100)*y(29) + mat(731) = .800_r8*rxt(98)*y(28) + mat(81) = rxt(114)*y(12) + mat(322) = rxt(96)*y(5) + .800_r8*rxt(98)*y(17) + 3.200_r8*rxt(99)*y(28) + mat(128) = .500_r8*rxt(100)*y(12) + mat(371) = .500_r8*rxt(116)*y(1) + mat(332) = .270_r8*rxt(122)*y(5) + mat(280) = rxt(118)*y(5) + mat(91) = rxt(136)*y(5) + mat(308) = .400_r8*rxt(143)*y(5) + mat(272) = rxt(138)*y(5) + mat(460) = .040_r8*rxt(159)*y(1) + mat(824) = -(rxt(103)*y(5) + rxt(104)*y(6) + rxt(105)*y(13) + rxt(106)*y(17) & + + 4._r8*rxt(110)*y(31) + rxt(153)*y(51) + rxt(167)*y(55) + rxt(184) & + *y(61)) + mat(565) = -rxt(103)*y(31) + mat(769) = -rxt(104)*y(31) + mat(690) = -rxt(105)*y(31) + mat(749) = -rxt(106)*y(31) + mat(510) = -rxt(153)*y(31) + mat(490) = -rxt(167)*y(31) + mat(458) = -rxt(184)*y(31) + mat(565) = mat(565) + rxt(127)*y(40) + rxt(138)*y(45) + .530_r8*rxt(162) & + *y(55) + rxt(169)*y(57) + mat(802) = rxt(102)*y(30) + .530_r8*rxt(164)*y(55) + rxt(170)*y(57) & + + rxt(133)*y(60) + mat(640) = rxt(101)*y(30) + .500_r8*rxt(107)*y(32) + rxt(132)*y(60) + mat(749) = mat(749) + .300_r8*rxt(129)*y(40) + .260_r8*rxt(166)*y(55) & + + rxt(172)*y(57) + mat(389) = rxt(102)*y(7) + rxt(101)*y(12) + mat(824) = mat(824) + .530_r8*rxt(167)*y(55) + mat(167) = .500_r8*rxt(107)*y(12) + mat(413) = rxt(127)*y(5) + .300_r8*rxt(129)*y(17) + mat(277) = rxt(138)*y(5) + mat(490) = mat(490) + .530_r8*rxt(162)*y(5) + .530_r8*rxt(164)*y(7) & + + .260_r8*rxt(166)*y(17) + .530_r8*rxt(167)*y(31) + mat(525) = rxt(169)*y(5) + rxt(170)*y(7) + rxt(172)*y(17) + 4.000_r8*rxt(174) & + *y(57) + mat(435) = rxt(133)*y(7) + rxt(132)*y(12) + mat(163) = -(rxt(107)*y(12)) + mat(595) = -rxt(107)*y(32) + mat(653) = .750_r8*rxt(105)*y(31) + .750_r8*rxt(171)*y(57) + mat(804) = .750_r8*rxt(105)*y(13) + mat(511) = .750_r8*rxt(171)*y(13) + mat(370) = -(rxt(115)*y(12) + rxt(116)*y(1) + rxt(117)*y(7)) + mat(620) = -rxt(115)*y(33) + mat(700) = -rxt(116)*y(33) + mat(782) = -rxt(117)*y(33) + mat(700) = mat(700) + .070_r8*rxt(147)*y(50) + mat(353) = .070_r8*rxt(147)*y(1) + mat(24) = -(rxt(121)*y(12)) + mat(569) = -rxt(121)*y(34) + mat(331) = -(rxt(122)*y(5) + rxt(123)*y(13) + rxt(124)*y(17)) + mat(544) = -rxt(122)*y(35) + mat(669) = -rxt(123)*y(35) + mat(730) = -rxt(124)*y(35) + mat(617) = rxt(121)*y(34) + rxt(125)*y(36) + mat(25) = rxt(121)*y(12) + mat(118) = rxt(125)*y(12) + mat(116) = -(rxt(125)*y(12)) + mat(587) = -rxt(125)*y(36) + mat(647) = rxt(123)*y(35) + mat(329) = rxt(123)*y(13) + mat(279) = -(rxt(118)*y(5) + rxt(119)*y(13)) + mat(539) = -rxt(118)*y(37) + mat(664) = -rxt(119)*y(37) + mat(613) = rxt(115)*y(33) + .500_r8*rxt(120)*y(38) + mat(369) = rxt(115)*y(12) + mat(177) = .500_r8*rxt(120)*y(12) + mat(176) = -(rxt(120)*y(12)) + mat(598) = -rxt(120)*y(38) + mat(655) = rxt(119)*y(37) + mat(278) = rxt(119)*y(13) + mat(287) = -(rxt(126)*y(12)) + mat(614) = -rxt(126)*y(39) + mat(540) = .820_r8*rxt(122)*y(35) + .500_r8*rxt(136)*y(43) + .250_r8*rxt(143) & + *y(48) + .100_r8*rxt(196)*y(64) + mat(728) = .820_r8*rxt(124)*y(35) + mat(330) = .820_r8*rxt(122)*y(5) + .820_r8*rxt(124)*y(17) + mat(90) = .500_r8*rxt(136)*y(5) + mat(305) = .250_r8*rxt(143)*y(5) + mat(391) = .100_r8*rxt(196)*y(5) + mat(404) = -(rxt(127)*y(5) + rxt(128)*y(13) + rxt(129)*y(17)) + mat(548) = -rxt(127)*y(40) + mat(673) = -rxt(128)*y(40) + mat(732) = -rxt(129)*y(40) + mat(623) = rxt(126)*y(39) + rxt(130)*y(41) + mat(288) = rxt(126)*y(12) + mat(85) = rxt(130)*y(12) + mat(84) = -(rxt(130)*y(12)) + mat(581) = -rxt(130)*y(41) + mat(643) = rxt(128)*y(40) + mat(402) = rxt(128)*y(13) + mat(27) = -(rxt(135)*y(12)) + mat(570) = -rxt(135)*y(42) + mat(89) = -(rxt(136)*y(5)) + mat(527) = -rxt(136)*y(43) + mat(582) = rxt(135)*y(42) + mat(28) = rxt(135)*y(12) + mat(30) = -(rxt(142)*y(12)) + mat(571) = -rxt(142)*y(47) + mat(306) = -(rxt(143)*y(5) + rxt(144)*y(13)) + mat(542) = -rxt(143)*y(48) + mat(667) = -rxt(144)*y(48) + mat(615) = rxt(142)*y(47) + rxt(145)*y(49) + mat(31) = rxt(142)*y(12) + mat(263) = rxt(145)*y(12) + mat(260) = -(rxt(145)*y(12)) + mat(611) = -rxt(145)*y(49) + mat(662) = rxt(144)*y(48) + mat(303) = rxt(144)*y(13) + mat(171) = -(rxt(137)*y(12)) + mat(597) = -rxt(137)*y(44) + mat(533) = .750_r8*rxt(143)*y(48) + mat(302) = .750_r8*rxt(143)*y(5) + mat(271) = -(rxt(138)*y(5) + rxt(139)*y(13)) + mat(538) = -rxt(138)*y(45) + mat(663) = -rxt(139)*y(45) + mat(612) = rxt(137)*y(44) + rxt(140)*y(46) + mat(172) = rxt(137)*y(12) + mat(97) = rxt(140)*y(12) + mat(96) = -(rxt(140)*y(12)) + mat(583) = -rxt(140)*y(46) + mat(644) = rxt(139)*y(45) + mat(270) = rxt(139)*y(13) + mat(352) = -(rxt(146)*y(12) + rxt(147)*y(1) + rxt(154)*y(7)) + mat(619) = -rxt(146)*y(50) + mat(699) = -rxt(147)*y(50) + mat(781) = -rxt(154)*y(50) + mat(501) = -(rxt(148)*y(5) + rxt(149)*y(7) + rxt(150)*y(13) + rxt(152)*y(17) & + + rxt(153)*y(31)) + mat(556) = -rxt(148)*y(51) + mat(793) = -rxt(149)*y(51) + mat(681) = -rxt(150)*y(51) + mat(740) = -rxt(152)*y(51) + mat(815) = -rxt(153)*y(51) + mat(631) = rxt(146)*y(50) + .200_r8*rxt(151)*y(52) + mat(358) = rxt(146)*y(12) + mat(238) = .200_r8*rxt(151)*y(12) + mat(233) = -(rxt(151)*y(12)) + mat(607) = -rxt(151)*y(52) + mat(661) = rxt(150)*y(51) + mat(492) = rxt(150)*y(13) + mat(464) = -(rxt(158)*y(12) + rxt(159)*y(1)) + mat(629) = -rxt(158)*y(53) + mat(709) = -rxt(159)*y(53) + mat(709) = mat(709) + .200_r8*rxt(147)*y(50) + rxt(194)*y(63) + mat(554) = .320_r8*rxt(148)*y(51) + rxt(196)*y(64) + .039_r8*rxt(155)*y(76) + mat(791) = .350_r8*rxt(149)*y(51) + .039_r8*rxt(156)*y(76) + mat(679) = .039_r8*rxt(157)*y(76) + mat(738) = .260_r8*rxt(152)*y(51) + mat(813) = .350_r8*rxt(153)*y(51) + mat(357) = .200_r8*rxt(147)*y(1) + mat(499) = .320_r8*rxt(148)*y(5) + .350_r8*rxt(149)*y(7) + .260_r8*rxt(152) & + *y(17) + .350_r8*rxt(153)*y(31) + mat(253) = rxt(194)*y(1) + mat(395) = rxt(196)*y(5) + mat(296) = .039_r8*rxt(155)*y(5) + .039_r8*rxt(156)*y(7) + .039_r8*rxt(157) & + *y(13) + mat(420) = -(rxt(160)*y(12) + rxt(161)*y(1)) + mat(625) = -rxt(160)*y(54) + mat(705) = -rxt(161)*y(54) + mat(705) = mat(705) + .400_r8*rxt(147)*y(50) + rxt(194)*y(63) + mat(550) = .230_r8*rxt(148)*y(51) + rxt(196)*y(64) + .167_r8*rxt(155)*y(76) + mat(787) = .250_r8*rxt(149)*y(51) + .167_r8*rxt(156)*y(76) + mat(675) = .167_r8*rxt(157)*y(76) + mat(734) = .190_r8*rxt(152)*y(51) + mat(809) = .250_r8*rxt(153)*y(51) + mat(354) = .400_r8*rxt(147)*y(1) + mat(495) = .230_r8*rxt(148)*y(5) + .250_r8*rxt(149)*y(7) + .190_r8*rxt(152) & + *y(17) + .250_r8*rxt(153)*y(31) + mat(252) = rxt(194)*y(1) + mat(394) = rxt(196)*y(5) + mat(294) = .167_r8*rxt(155)*y(5) + .167_r8*rxt(156)*y(7) + .167_r8*rxt(157) & + *y(13) + end subroutine nlnmat03 + subroutine nlnmat04( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(482) = -((rxt(162) + rxt(163)) * y(5) + rxt(164)*y(7) + rxt(165)*y(13) & + + rxt(166)*y(17) + rxt(167)*y(31)) + mat(555) = -(rxt(162) + rxt(163)) * y(55) + mat(792) = -rxt(164)*y(55) + mat(680) = -rxt(165)*y(55) + mat(739) = -rxt(166)*y(55) + mat(814) = -rxt(167)*y(55) + mat(630) = rxt(158)*y(53) + .500_r8*rxt(160)*y(54) + .200_r8*rxt(168)*y(56) + mat(465) = rxt(158)*y(12) + mat(423) = .500_r8*rxt(160)*y(12) + mat(102) = .200_r8*rxt(168)*y(12) + mat(101) = -(rxt(168)*y(12)) + mat(584) = -rxt(168)*y(56) + mat(645) = rxt(165)*y(55) + mat(474) = rxt(165)*y(13) + mat(517) = -(rxt(169)*y(5) + rxt(170)*y(7) + rxt(171)*y(13) + rxt(172)*y(17) & + + rxt(173)*y(31) + 4._r8*rxt(174)*y(57) + rxt(175)*y(6)) + mat(557) = -rxt(169)*y(57) + mat(794) = -rxt(170)*y(57) + mat(682) = -rxt(171)*y(57) + mat(741) = -rxt(172)*y(57) + mat(816) = -rxt(173)*y(57) + mat(761) = -rxt(175)*y(57) + mat(712) = .200_r8*rxt(147)*y(50) + mat(632) = .500_r8*rxt(160)*y(54) + .500_r8*rxt(168)*y(56) + mat(359) = .200_r8*rxt(147)*y(1) + mat(424) = .500_r8*rxt(160)*y(12) + mat(103) = .500_r8*rxt(168)*y(12) + mat(136) = -(rxt(179)*y(12)) + mat(591) = -rxt(179)*y(58) + mat(529) = .370_r8*rxt(148)*y(51) + mat(773) = .400_r8*rxt(149)*y(51) + rxt(178)*y(77) + mat(591) = mat(591) + rxt(177)*y(77) + mat(723) = .300_r8*rxt(152)*y(51) + mat(803) = .400_r8*rxt(153)*y(51) + mat(491) = .370_r8*rxt(148)*y(5) + .400_r8*rxt(149)*y(7) + .300_r8*rxt(152) & + *y(17) + .400_r8*rxt(153)*y(31) + mat(341) = rxt(178)*y(7) + rxt(177)*y(12) + mat(414) = -(rxt(134)*y(12)) + mat(624) = -rxt(134)*y(59) + mat(549) = .220_r8*rxt(162)*y(55) + .250_r8*rxt(180)*y(61) + mat(786) = .220_r8*rxt(164)*y(55) + .250_r8*rxt(181)*y(61) + mat(624) = mat(624) + .500_r8*rxt(120)*y(38) + .500_r8*rxt(141)*y(75) + mat(733) = .200_r8*rxt(129)*y(40) + .230_r8*rxt(166)*y(55) + .100_r8*rxt(183) & + *y(61) + mat(808) = .220_r8*rxt(167)*y(55) + .250_r8*rxt(184)*y(61) + mat(179) = .500_r8*rxt(120)*y(12) + mat(405) = .200_r8*rxt(129)*y(17) + mat(478) = .220_r8*rxt(162)*y(5) + .220_r8*rxt(164)*y(7) + .230_r8*rxt(166) & + *y(17) + .220_r8*rxt(167)*y(31) + mat(448) = .250_r8*rxt(180)*y(5) + .250_r8*rxt(181)*y(7) + .100_r8*rxt(183) & + *y(17) + .250_r8*rxt(184)*y(31) + mat(226) = .500_r8*rxt(141)*y(12) + mat(430) = -(rxt(132)*y(12) + rxt(133)*y(7)) + mat(626) = -rxt(132)*y(60) + mat(788) = -rxt(133)*y(60) + mat(706) = .950_r8*rxt(159)*y(53) + .800_r8*rxt(161)*y(54) + mat(551) = .250_r8*rxt(162)*y(55) + .250_r8*rxt(180)*y(61) + .450_r8*rxt(190) & + *y(68) + mat(788) = mat(788) + .250_r8*rxt(164)*y(55) + .250_r8*rxt(181)*y(61) + mat(626) = mat(626) + rxt(134)*y(59) + rxt(131)*y(74) + mat(735) = .500_r8*rxt(129)*y(40) + .240_r8*rxt(166)*y(55) + .100_r8*rxt(183) & + *y(61) + mat(810) = .250_r8*rxt(167)*y(55) + .250_r8*rxt(184)*y(61) + mat(406) = .500_r8*rxt(129)*y(17) + mat(462) = .950_r8*rxt(159)*y(1) + mat(421) = .800_r8*rxt(161)*y(1) + mat(479) = .250_r8*rxt(162)*y(5) + .250_r8*rxt(164)*y(7) + .240_r8*rxt(166) & + *y(17) + .250_r8*rxt(167)*y(31) + mat(415) = rxt(134)*y(12) + mat(449) = .250_r8*rxt(180)*y(5) + .250_r8*rxt(181)*y(7) + .100_r8*rxt(183) & + *y(17) + .250_r8*rxt(184)*y(31) + mat(197) = .450_r8*rxt(190)*y(5) + mat(153) = rxt(131)*y(12) + mat(451) = -(rxt(180)*y(5) + rxt(181)*y(7) + rxt(182)*y(13) + rxt(183)*y(17) & + + rxt(184)*y(31)) + mat(553) = -rxt(180)*y(61) + mat(790) = -rxt(181)*y(61) + mat(678) = -rxt(182)*y(61) + mat(737) = -rxt(183)*y(61) + mat(812) = -rxt(184)*y(61) + mat(628) = .800_r8*rxt(151)*y(52) + rxt(179)*y(58) + rxt(185)*y(62) + mat(236) = .800_r8*rxt(151)*y(12) + mat(137) = rxt(179)*y(12) + mat(57) = rxt(185)*y(12) + mat(56) = -((rxt(185) + rxt(186)) * y(12)) + mat(577) = -(rxt(185) + rxt(186)) * y(62) + mat(642) = rxt(182)*y(61) + mat(444) = rxt(182)*y(13) + mat(250) = -(rxt(193)*y(12) + rxt(194)*y(1) + rxt(195)*y(7)) + mat(610) = -rxt(193)*y(63) + mat(698) = -rxt(194)*y(63) + mat(778) = -rxt(195)*y(63) + mat(392) = -(rxt(196)*y(5) + rxt(197)*y(13)) + mat(547) = -rxt(196)*y(64) + mat(672) = -rxt(197)*y(64) + mat(784) = rxt(195)*y(63) + mat(622) = rxt(193)*y(63) + rxt(198)*y(65) + mat(251) = rxt(195)*y(7) + rxt(193)*y(12) + mat(185) = rxt(198)*y(12) + mat(183) = -(rxt(198)*y(12)) + mat(599) = -rxt(198)*y(65) + mat(656) = rxt(197)*y(64) + mat(390) = rxt(197)*y(13) + mat(36) = -(rxt(187)*y(12)) + mat(573) = -rxt(187)*y(66) + mat(41) = -(rxt(188)*y(12)) + mat(574) = -rxt(188)*y(67) + mat(574) = mat(574) + .250_r8*rxt(187)*y(66) + mat(37) = .250_r8*rxt(187)*y(12) + mat(195) = -(rxt(190)*y(5) + rxt(191)*y(13)) + mat(535) = -rxt(190)*y(68) + mat(658) = -rxt(191)*y(68) + mat(601) = .700_r8*rxt(187)*y(66) + rxt(192)*y(69) + mat(38) = .700_r8*rxt(187)*y(12) + mat(148) = rxt(192)*y(12) + mat(146) = -(rxt(192)*y(12)) + mat(593) = -rxt(192)*y(69) + mat(651) = rxt(191)*y(68) + mat(193) = rxt(191)*y(13) + mat(59) = -(rxt(189)*y(6)) + mat(750) = -rxt(189)*y(70) + mat(578) = rxt(188)*y(67) + mat(42) = rxt(188)*y(12) + mat(536) = .900_r8*rxt(190)*y(68) + mat(753) = .700_r8*rxt(189)*y(70) + mat(196) = .900_r8*rxt(190)*y(5) + mat(60) = .700_r8*rxt(189)*y(6) + mat(190) = -(rxt(112)*y(12)) + mat(600) = -rxt(112)*y(72) + mat(534) = .250_r8*rxt(180)*y(61) + .450_r8*rxt(190)*y(68) + mat(775) = .250_r8*rxt(181)*y(61) + mat(600) = mat(600) + .200_r8*rxt(111)*y(26) + .650_r8*rxt(89)*y(101) + mat(725) = .100_r8*rxt(183)*y(61) + mat(245) = .200_r8*rxt(111)*y(12) + mat(445) = .250_r8*rxt(180)*y(5) + .250_r8*rxt(181)*y(7) + .100_r8*rxt(183) & + *y(17) + mat(194) = .450_r8*rxt(190)*y(5) + mat(46) = .650_r8*rxt(89)*y(12) + mat(208) = -(rxt(108)*y(12)) + mat(603) = -rxt(108)*y(73) + mat(754) = rxt(104)*y(31) + mat(806) = rxt(104)*y(6) + mat(152) = -(rxt(131)*y(12)) + mat(594) = -rxt(131)*y(74) + mat(531) = .100_r8*rxt(143)*y(48) + mat(774) = rxt(117)*y(33) + mat(367) = rxt(117)*y(7) + mat(301) = .100_r8*rxt(143)*y(5) + mat(225) = -(rxt(141)*y(12)) + mat(606) = -rxt(141)*y(75) + mat(757) = rxt(175)*y(57) + mat(513) = rxt(175)*y(6) + mat(292) = -(rxt(155)*y(5) + rxt(156)*y(7) + rxt(157)*y(13)) + mat(541) = -rxt(155)*y(76) + mat(779) = -rxt(156)*y(76) + mat(666) = -rxt(157)*y(76) + mat(779) = mat(779) + rxt(154)*y(50) + mat(350) = rxt(154)*y(7) + mat(342) = -(rxt(177)*y(12) + rxt(178)*y(7)) + mat(618) = -rxt(177)*y(77) + mat(780) = -rxt(178)*y(77) + mat(545) = .080_r8*rxt(148)*y(51) + .800_r8*rxt(163)*y(55) + .794_r8*rxt(155) & + *y(76) + mat(780) = mat(780) + .794_r8*rxt(156)*y(76) + mat(670) = .794_r8*rxt(157)*y(76) + mat(494) = .080_r8*rxt(148)*y(5) + mat(477) = .800_r8*rxt(163)*y(5) + mat(293) = .794_r8*rxt(155)*y(5) + .794_r8*rxt(156)*y(7) + .794_r8*rxt(157) & + *y(13) + mat(34) = -(rxt(204)*y(12)) + mat(572) = -rxt(204)*y(83) + mat(770) = rxt(207)*y(84) + mat(572) = mat(572) + (rxt(205)+.500_r8*rxt(206))*y(84) + mat(74) = rxt(207)*y(7) + (rxt(205)+.500_r8*rxt(206))*y(12) + mat(75) = -((rxt(205) + rxt(206)) * y(12) + rxt(207)*y(7)) + mat(579) = -(rxt(205) + rxt(206)) * y(84) + mat(772) = -rxt(207)*y(84) + mat(566) = rxt(204)*y(83) + mat(33) = rxt(204)*y(12) + mat(19) = -(rxt(208)*y(12)) + mat(567) = -rxt(208)*y(86) + mat(44) = -(rxt(89)*y(12)) + mat(575) = -rxt(89)*y(101) + mat(113) = -(rxt(84)*y(12)) + mat(586) = -rxt(84)*y(102) + mat(693) = .500_r8*rxt(91)*y(22) + mat(528) = rxt(87)*y(103) + mat(586) = mat(586) + .350_r8*rxt(89)*y(101) + mat(646) = rxt(88)*y(103) + mat(107) = .500_r8*rxt(91)*y(1) + mat(45) = .350_r8*rxt(89)*y(12) + mat(156) = rxt(87)*y(5) + rxt(88)*y(13) + mat(157) = -(rxt(87)*y(5) + rxt(88)*y(13)) + mat(532) = -rxt(87)*y(103) + mat(652) = -rxt(88)*y(103) + mat(652) = mat(652) + rxt(85)*y(19) + mat(436) = rxt(85)*y(13) + end subroutine nlnmat04 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = mat( 19) + lmat( 19) + mat( 21) = mat( 21) + lmat( 21) + mat( 24) = mat( 24) + lmat( 24) + mat( 27) = mat( 27) + lmat( 27) + mat( 30) = mat( 30) + lmat( 30) + mat( 34) = mat( 34) + lmat( 34) + mat( 36) = mat( 36) + lmat( 36) + mat( 41) = mat( 41) + lmat( 41) + mat( 44) = mat( 44) + lmat( 44) + mat( 49) = mat( 49) + lmat( 49) + mat( 50) = mat( 50) + lmat( 50) + mat( 52) = lmat( 52) + mat( 53) = lmat( 53) + mat( 54) = lmat( 54) + mat( 55) = lmat( 55) + mat( 56) = mat( 56) + lmat( 56) + mat( 58) = mat( 58) + lmat( 58) + mat( 59) = mat( 59) + lmat( 59) + mat( 63) = lmat( 63) + mat( 64) = lmat( 64) + mat( 65) = lmat( 65) + mat( 66) = lmat( 66) + mat( 67) = lmat( 67) + mat( 68) = lmat( 68) + mat( 69) = lmat( 69) + mat( 70) = lmat( 70) + mat( 71) = lmat( 71) + mat( 72) = lmat( 72) + mat( 73) = lmat( 73) + mat( 75) = mat( 75) + lmat( 75) + mat( 80) = mat( 80) + lmat( 80) + mat( 84) = mat( 84) + lmat( 84) + mat( 86) = lmat( 86) + mat( 87) = mat( 87) + lmat( 87) + mat( 88) = lmat( 88) + mat( 89) = mat( 89) + lmat( 89) + mat( 96) = mat( 96) + lmat( 96) + mat( 98) = lmat( 98) + mat( 99) = mat( 99) + lmat( 99) + mat( 100) = lmat( 100) + mat( 101) = mat( 101) + lmat( 101) + mat( 106) = mat( 106) + lmat( 106) + mat( 113) = mat( 113) + lmat( 113) + mat( 116) = mat( 116) + lmat( 116) + mat( 117) = lmat( 117) + mat( 119) = mat( 119) + lmat( 119) + mat( 120) = lmat( 120) + mat( 121) = mat( 121) + lmat( 121) + mat( 122) = mat( 122) + lmat( 122) + mat( 123) = lmat( 123) + mat( 124) = mat( 124) + lmat( 124) + mat( 125) = lmat( 125) + mat( 126) = mat( 126) + lmat( 126) + mat( 128) = mat( 128) + lmat( 128) + mat( 129) = mat( 129) + lmat( 129) + mat( 130) = lmat( 130) + mat( 131) = mat( 131) + lmat( 131) + mat( 132) = mat( 132) + lmat( 132) + mat( 133) = mat( 133) + lmat( 133) + mat( 134) = lmat( 134) + mat( 136) = mat( 136) + lmat( 136) + mat( 140) = mat( 140) + lmat( 140) + mat( 146) = mat( 146) + lmat( 146) + mat( 147) = lmat( 147) + mat( 149) = lmat( 149) + mat( 150) = lmat( 150) + mat( 151) = mat( 151) + lmat( 151) + mat( 152) = mat( 152) + lmat( 152) + mat( 157) = mat( 157) + lmat( 157) + mat( 158) = lmat( 158) + mat( 161) = mat( 161) + lmat( 161) + mat( 163) = mat( 163) + lmat( 163) + mat( 165) = mat( 165) + lmat( 165) + mat( 166) = lmat( 166) + mat( 168) = mat( 168) + lmat( 168) + mat( 171) = mat( 171) + lmat( 171) + mat( 173) = lmat( 173) + mat( 175) = lmat( 175) + mat( 176) = mat( 176) + lmat( 176) + mat( 178) = lmat( 178) + mat( 180) = lmat( 180) + mat( 181) = mat( 181) + lmat( 181) + mat( 182) = lmat( 182) + mat( 183) = mat( 183) + lmat( 183) + mat( 184) = lmat( 184) + mat( 186) = lmat( 186) + mat( 187) = lmat( 187) + mat( 188) = mat( 188) + lmat( 188) + mat( 189) = lmat( 189) + mat( 190) = mat( 190) + lmat( 190) + mat( 192) = mat( 192) + lmat( 192) + mat( 195) = mat( 195) + lmat( 195) + mat( 202) = lmat( 202) + mat( 203) = lmat( 203) + mat( 204) = lmat( 204) + mat( 206) = lmat( 206) + mat( 207) = lmat( 207) + mat( 208) = mat( 208) + lmat( 208) + mat( 211) = lmat( 211) + mat( 212) = lmat( 212) + mat( 213) = mat( 213) + lmat( 213) + mat( 214) = lmat( 214) + mat( 215) = mat( 215) + lmat( 215) + mat( 216) = mat( 216) + lmat( 216) + mat( 217) = lmat( 217) + mat( 219) = mat( 219) + lmat( 219) + mat( 223) = mat( 223) + lmat( 223) + mat( 225) = mat( 225) + lmat( 225) + mat( 228) = lmat( 228) + mat( 231) = lmat( 231) + mat( 233) = mat( 233) + lmat( 233) + mat( 234) = lmat( 234) + mat( 235) = lmat( 235) + mat( 237) = lmat( 237) + mat( 240) = lmat( 240) + mat( 241) = mat( 241) + lmat( 241) + mat( 246) = mat( 246) + lmat( 246) + mat( 247) = mat( 247) + lmat( 247) + mat( 249) = mat( 249) + lmat( 249) + mat( 250) = mat( 250) + lmat( 250) + mat( 259) = lmat( 259) + mat( 260) = mat( 260) + lmat( 260) + mat( 262) = lmat( 262) + mat( 265) = lmat( 265) + mat( 266) = lmat( 266) + mat( 267) = mat( 267) + lmat( 267) + mat( 268) = lmat( 268) + mat( 271) = mat( 271) + lmat( 271) + mat( 279) = mat( 279) + lmat( 279) + mat( 287) = mat( 287) + lmat( 287) + mat( 290) = lmat( 290) + mat( 291) = lmat( 291) + mat( 292) = mat( 292) + lmat( 292) + mat( 306) = mat( 306) + lmat( 306) + mat( 321) = mat( 321) + lmat( 321) + mat( 331) = mat( 331) + lmat( 331) + mat( 342) = mat( 342) + lmat( 342) + mat( 343) = lmat( 343) + mat( 346) = mat( 346) + lmat( 346) + mat( 347) = mat( 347) + lmat( 347) + mat( 352) = mat( 352) + lmat( 352) + mat( 370) = mat( 370) + lmat( 370) + mat( 383) = mat( 383) + lmat( 383) + mat( 385) = lmat( 385) + mat( 386) = lmat( 386) + mat( 392) = mat( 392) + lmat( 392) + mat( 404) = mat( 404) + lmat( 404) + mat( 414) = mat( 414) + lmat( 414) + mat( 416) = lmat( 416) + mat( 418) = mat( 418) + lmat( 418) + mat( 419) = lmat( 419) + mat( 420) = mat( 420) + lmat( 420) + mat( 422) = mat( 422) + lmat( 422) + mat( 424) = mat( 424) + lmat( 424) + mat( 425) = mat( 425) + lmat( 425) + mat( 426) = mat( 426) + lmat( 426) + mat( 428) = lmat( 428) + mat( 430) = mat( 430) + lmat( 430) + mat( 432) = lmat( 432) + mat( 435) = mat( 435) + lmat( 435) + mat( 438) = mat( 438) + lmat( 438) + mat( 441) = mat( 441) + lmat( 441) + mat( 451) = mat( 451) + lmat( 451) + mat( 459) = lmat( 459) + mat( 464) = mat( 464) + lmat( 464) + mat( 470) = lmat( 470) + mat( 473) = lmat( 473) + mat( 482) = mat( 482) + lmat( 482) + mat( 501) = mat( 501) + lmat( 501) + mat( 517) = mat( 517) + lmat( 517) + mat( 558) = mat( 558) + lmat( 558) + mat( 634) = mat( 634) + lmat( 634) + mat( 635) = mat( 635) + lmat( 635) + mat( 637) = mat( 637) + lmat( 637) + mat( 641) = mat( 641) + lmat( 641) + mat( 685) = mat( 685) + lmat( 685) + mat( 691) = lmat( 691) + mat( 696) = mat( 696) + lmat( 696) + mat( 716) = mat( 716) + lmat( 716) + mat( 746) = mat( 746) + lmat( 746) + mat( 755) = mat( 755) + lmat( 755) + mat( 756) = mat( 756) + lmat( 756) + mat( 762) = mat( 762) + lmat( 762) + mat( 763) = mat( 763) + lmat( 763) + mat( 767) = mat( 767) + lmat( 767) + mat( 776) = mat( 776) + lmat( 776) + mat( 795) = mat( 795) + lmat( 795) + mat( 798) = lmat( 798) + mat( 800) = mat( 800) + lmat( 800) + mat( 801) = mat( 801) + lmat( 801) + mat( 824) = mat( 824) + lmat( 824) + mat( 141) = 0._r8 + mat( 142) = 0._r8 + mat( 144) = 0._r8 + mat( 160) = 0._r8 + mat( 199) = 0._r8 + mat( 205) = 0._r8 + mat( 261) = 0._r8 + mat( 264) = 0._r8 + mat( 269) = 0._r8 + mat( 274) = 0._r8 + mat( 281) = 0._r8 + mat( 284) = 0._r8 + mat( 304) = 0._r8 + mat( 307) = 0._r8 + mat( 309) = 0._r8 + mat( 310) = 0._r8 + mat( 313) = 0._r8 + mat( 315) = 0._r8 + mat( 317) = 0._r8 + mat( 325) = 0._r8 + mat( 333) = 0._r8 + mat( 336) = 0._r8 + mat( 340) = 0._r8 + mat( 344) = 0._r8 + mat( 351) = 0._r8 + mat( 356) = 0._r8 + mat( 360) = 0._r8 + mat( 364) = 0._r8 + mat( 365) = 0._r8 + mat( 372) = 0._r8 + mat( 373) = 0._r8 + mat( 375) = 0._r8 + mat( 380) = 0._r8 + mat( 387) = 0._r8 + mat( 393) = 0._r8 + mat( 397) = 0._r8 + mat( 399) = 0._r8 + mat( 401) = 0._r8 + mat( 409) = 0._r8 + mat( 433) = 0._r8 + mat( 439) = 0._r8 + mat( 442) = 0._r8 + mat( 453) = 0._r8 + mat( 461) = 0._r8 + mat( 466) = 0._r8 + mat( 471) = 0._r8 + mat( 472) = 0._r8 + mat( 481) = 0._r8 + mat( 483) = 0._r8 + mat( 485) = 0._r8 + mat( 496) = 0._r8 + mat( 498) = 0._r8 + mat( 500) = 0._r8 + mat( 502) = 0._r8 + mat( 504) = 0._r8 + mat( 506) = 0._r8 + mat( 514) = 0._r8 + mat( 515) = 0._r8 + mat( 519) = 0._r8 + mat( 602) = 0._r8 + mat( 633) = 0._r8 + mat( 657) = 0._r8 + mat( 659) = 0._r8 + mat( 665) = 0._r8 + mat( 671) = 0._r8 + mat( 674) = 0._r8 + mat( 676) = 0._r8 + mat( 694) = 0._r8 + mat( 697) = 0._r8 + mat( 702) = 0._r8 + mat( 703) = 0._r8 + mat( 704) = 0._r8 + mat( 708) = 0._r8 + mat( 710) = 0._r8 + mat( 711) = 0._r8 + mat( 720) = 0._r8 + mat( 743) = 0._r8 + mat( 745) = 0._r8 + mat( 748) = 0._r8 + mat( 758) = 0._r8 + mat( 759) = 0._r8 + mat( 760) = 0._r8 + mat( 766) = 0._r8 + mat( 785) = 0._r8 + mat( 799) = 0._r8 + mat( 818) = 0._r8 + mat( 823) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 21) = mat( 21) - dti + mat( 24) = mat( 24) - dti + mat( 27) = mat( 27) - dti + mat( 30) = mat( 30) - dti + mat( 34) = mat( 34) - dti + mat( 36) = mat( 36) - dti + mat( 41) = mat( 41) - dti + mat( 44) = mat( 44) - dti + mat( 49) = mat( 49) - dti + mat( 52) = mat( 52) - dti + mat( 56) = mat( 56) - dti + mat( 59) = mat( 59) - dti + mat( 63) = mat( 63) - dti + mat( 70) = mat( 70) - dti + mat( 75) = mat( 75) - dti + mat( 80) = mat( 80) - dti + mat( 84) = mat( 84) - dti + mat( 89) = mat( 89) - dti + mat( 96) = mat( 96) - dti + mat( 101) = mat( 101) - dti + mat( 106) = mat( 106) - dti + mat( 113) = mat( 113) - dti + mat( 116) = mat( 116) - dti + mat( 121) = mat( 121) - dti + mat( 126) = mat( 126) - dti + mat( 131) = mat( 131) - dti + mat( 136) = mat( 136) - dti + mat( 140) = mat( 140) - dti + mat( 146) = mat( 146) - dti + mat( 152) = mat( 152) - dti + mat( 157) = mat( 157) - dti + mat( 163) = mat( 163) - dti + mat( 168) = mat( 168) - dti + mat( 171) = mat( 171) - dti + mat( 176) = mat( 176) - dti + mat( 183) = mat( 183) - dti + mat( 190) = mat( 190) - dti + mat( 195) = mat( 195) - dti + mat( 203) = mat( 203) - dti + mat( 208) = mat( 208) - dti + mat( 215) = mat( 215) - dti + mat( 219) = mat( 219) - dti + mat( 225) = mat( 225) - dti + mat( 233) = mat( 233) - dti + mat( 241) = mat( 241) - dti + mat( 246) = mat( 246) - dti + mat( 250) = mat( 250) - dti + mat( 260) = mat( 260) - dti + mat( 271) = mat( 271) - dti + mat( 279) = mat( 279) - dti + mat( 287) = mat( 287) - dti + mat( 292) = mat( 292) - dti + mat( 306) = mat( 306) - dti + mat( 321) = mat( 321) - dti + mat( 331) = mat( 331) - dti + mat( 342) = mat( 342) - dti + mat( 352) = mat( 352) - dti + mat( 370) = mat( 370) - dti + mat( 383) = mat( 383) - dti + mat( 392) = mat( 392) - dti + mat( 404) = mat( 404) - dti + mat( 414) = mat( 414) - dti + mat( 420) = mat( 420) - dti + mat( 430) = mat( 430) - dti + mat( 438) = mat( 438) - dti + mat( 451) = mat( 451) - dti + mat( 464) = mat( 464) - dti + mat( 482) = mat( 482) - dti + mat( 501) = mat( 501) - dti + mat( 517) = mat( 517) - dti + mat( 558) = mat( 558) - dti + mat( 634) = mat( 634) - dti + mat( 685) = mat( 685) - dti + mat( 716) = mat( 716) - dti + mat( 746) = mat( 746) - dti + mat( 767) = mat( 767) - dti + mat( 801) = mat( 801) - dti + mat( 824) = mat( 824) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_mozart/mo_phtadj.F90 b/src/chemistry/pp_trop_mozart/mo_phtadj.F90 new file mode 100644 index 0000000000..c0e15c937e --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_phtadj.F90 @@ -0,0 +1,26 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 1) = p_rate(:,k, 1) * inv(:,k, 3) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 b/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 new file mode 100644 index 0000000000..81ade0ee6b --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_prod_loss.F90 @@ -0,0 +1,452 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = (rxt(:,:,73)* y(:,:,3) +rxt(:,:,72)* y(:,:,12) & + + het_rates(:,:,15))* y(:,:,15) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,57) +rxt(:,:,58))* y(:,:,3) + rxt(:,:,4) & + + het_rates(:,:,4))* y(:,:,4) + prod(:,:,2) = 0._r8 + loss(:,:,3) = ((rxt(:,:,81) +rxt(:,:,82))* y(:,:,12) + het_rates(:,:,16)) & + * y(:,:,16) + prod(:,:,3) = 0._r8 + loss(:,:,4) = ( + rxt(:,:,199) + het_rates(:,:,97))* y(:,:,97) + prod(:,:,4) = 0._r8 + loss(:,:,5) = ( + het_rates(:,:,98))* y(:,:,98) + prod(:,:,5) =rxt(:,:,199)*y(:,:,97) + loss(:,:,6) = (rxt(:,:,46)* y(:,:,3) +rxt(:,:,47)* y(:,:,12) & + + het_rates(:,:,11))* y(:,:,11) + prod(:,:,6) =.050_r8*rxt(:,:,73)*y(:,:,15)*y(:,:,3) + loss(:,:,7) = (rxt(:,:,211)* y(:,:,12) + het_rates(:,:,99))* y(:,:,99) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,212)* y(:,:,12) + het_rates(:,:,100))* y(:,:,100) + prod(:,:,8) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(91) = (rxt(42)* y(2) +rxt(60)* y(5) +rxt(62)* y(6) +rxt(50)* y(12) & + +rxt(51)* y(13) +rxt(91)* y(22) +rxt(116)* y(33) +rxt(147)* y(50) & + +rxt(159)* y(53) +rxt(161)* y(54) +rxt(194)* y(63) + rxt(2) + rxt(3) & + + het_rates(1))* y(1) + prod(91) = (.100_r8*rxt(147)*y(50) +.200_r8*rxt(159)*y(53) + & + .200_r8*rxt(161)*y(54))*y(1) + (.890_r8*rxt(8) +.890_r8*rxt(9))*y(7) & + + (.250_r8*rxt(105)*y(31) +.250_r8*rxt(171)*y(57))*y(13) +rxt(41) & + *y(2) + loss(30) = ((rxt(57) +rxt(58))* y(4) +rxt(46)* y(11) +rxt(73)* y(15) & + + rxt(43) + rxt(44) + rxt(45) + het_rates(3))* y(3) + prod(30) =rxt(2)*y(1) + loss(59) = (rxt(42)* y(1) +rxt(61)* y(6) +rxt(48)* y(12) +rxt(49)* y(13) & + + rxt(41) + het_rates(2))* y(2) + prod(59) = (rxt(43) +rxt(44))*y(3) +rxt(3)*y(1) +rxt(5)*y(6) +rxt(55)*y(12) & + *y(12) + loss(88) = (rxt(60)* y(1) +rxt(68)* y(7) +rxt(59)* y(13) +rxt(74)* y(17) & + +rxt(92)* y(24) +rxt(96)* y(28) +rxt(103)* y(31) +rxt(122)* y(35) & + +rxt(118)* y(37) +rxt(127)* y(40) +rxt(136)* y(43) +rxt(138)* y(45) & + +rxt(143)* y(48) +rxt(148)* y(51) + (rxt(162) +rxt(163))* y(55) & + +rxt(169)* y(57) +rxt(180)* y(61) +rxt(196)* y(64) +rxt(190)* y(68) & + +rxt(155)* y(76) +rxt(87)* y(103) + het_rates(5))* y(5) + prod(88) = (rxt(5) +.500_r8*rxt(202) +rxt(61)*y(2))*y(6) + (.110_r8*rxt(8) + & + .110_r8*rxt(9))*y(7) +2.000_r8*rxt(58)*y(4)*y(3) + loss(93) = (rxt(62)* y(1) +rxt(61)* y(2) +rxt(64)* y(7) +rxt(66)* y(12) & + +rxt(69)* y(13) +rxt(104)* y(31) +rxt(175)* y(57) +rxt(189)* y(70) & + + rxt(5) + rxt(202) + het_rates(6))* y(6) + prod(93) = (rxt(59)*y(13) +rxt(60)*y(1) +2.000_r8*rxt(68)*y(7) + & + rxt(74)*y(17) +rxt(87)*y(103) +rxt(92)*y(24) +rxt(96)*y(28) + & + rxt(103)*y(31) +rxt(118)*y(37) +rxt(122)*y(35) +rxt(127)*y(40) + & + rxt(136)*y(43) +rxt(138)*y(45) +.900_r8*rxt(143)*y(48) + & + .920_r8*rxt(148)*y(51) +1.206_r8*rxt(155)*y(76) +rxt(162)*y(55) + & + rxt(169)*y(57) +rxt(180)*y(61) +.900_r8*rxt(190)*y(68) + & + rxt(196)*y(64))*y(5) + (.890_r8*rxt(8) +.890_r8*rxt(9) + & + rxt(63)*y(13) +rxt(149)*y(51) +1.206_r8*rxt(156)*y(76) + & + rxt(164)*y(55) +rxt(170)*y(57) +rxt(178)*y(77) +rxt(181)*y(61) + & + rxt(195)*y(63))*y(7) + (.660_r8*rxt(10) +.660_r8*rxt(11) +rxt(71) + & + rxt(70)*y(12))*y(9) + (rxt(6) +rxt(65))*y(10) + (rxt(131)*y(74) + & + .400_r8*rxt(177)*y(77))*y(12) + (.600_r8*rxt(19) +rxt(109))*y(73) & + + (rxt(20) +rxt(176))*y(75) +.700_r8*rxt(189)*y(70)*y(6) +rxt(7) & + *y(8) +.206_r8*rxt(157)*y(76)*y(13) +rxt(30)*y(77) + loss(94) = (rxt(68)* y(5) +rxt(64)* y(6) +rxt(63)* y(13) +rxt(79)* y(19) & + +rxt(102)* y(30) +rxt(117)* y(33) +rxt(154)* y(50) +rxt(149)* y(51) & + +rxt(164)* y(55) +rxt(170)* y(57) +rxt(133)* y(60) +rxt(181)* y(61) & + +rxt(195)* y(63) +rxt(156)* y(76) +rxt(178)* y(77) +rxt(207)* y(84) & + + rxt(8) + rxt(9) + rxt(201) + het_rates(7))* y(7) + prod(94) = (rxt(67)*y(8) +rxt(108)*y(73) +.500_r8*rxt(141)*y(75))*y(12) & + + (.330_r8*rxt(10) +.330_r8*rxt(11))*y(9) + (rxt(6) +rxt(65))*y(10) & + +rxt(62)*y(6)*y(1) +.400_r8*rxt(19)*y(73) + loss(58) = (rxt(67)* y(12) + rxt(7) + het_rates(8))* y(8) + prod(58) = (rxt(201) +rxt(79)*y(19) +rxt(102)*y(30) +rxt(133)*y(60) + & + rxt(207)*y(84))*y(7) + (.500_r8*rxt(202) +rxt(66)*y(12))*y(6) & + +2.000_r8*rxt(200)*y(10) + loss(41) = (rxt(70)* y(12) + rxt(10) + rxt(11) + rxt(71) + het_rates(9)) & + * y(9) + prod(41) =rxt(69)*y(13)*y(6) + loss(31) = ( + rxt(6) + rxt(65) + rxt(200) + het_rates(10))* y(10) + prod(31) =rxt(64)*y(7)*y(6) + loss(89) = (rxt(50)* y(1) +rxt(48)* y(2) +rxt(66)* y(6) +rxt(67)* y(8) & + +rxt(70)* y(9) +rxt(47)* y(11) + 2._r8*(rxt(55) +rxt(56))* y(12) & + +rxt(54)* y(13) +rxt(53)* y(14) +rxt(72)* y(15) + (rxt(81) +rxt(82)) & + * y(16) +rxt(78)* y(18) +rxt(80)* y(19) +rxt(83)* y(20) +rxt(114) & + * y(21) +rxt(90)* y(22) +rxt(113)* y(25) +rxt(111)* y(26) +rxt(95) & + * y(27) +rxt(100)* y(29) +rxt(101)* y(30) +rxt(107)* y(32) +rxt(115) & + * y(33) +rxt(121)* y(34) +rxt(125)* y(36) +rxt(120)* y(38) +rxt(126) & + * y(39) +rxt(130)* y(41) +rxt(135)* y(42) +rxt(137)* y(44) +rxt(140) & + * y(46) +rxt(142)* y(47) +rxt(145)* y(49) +rxt(146)* y(50) +rxt(151) & + * y(52) +rxt(158)* y(53) +rxt(160)* y(54) +rxt(168)* y(56) +rxt(179) & + * y(58) +rxt(134)* y(59) +rxt(132)* y(60) +rxt(185)* y(62) +rxt(193) & + * y(63) +rxt(198)* y(65) +rxt(187)* y(66) +rxt(188)* y(67) +rxt(192) & + * y(69) +rxt(112)* y(72) +rxt(108)* y(73) +rxt(131)* y(74) +rxt(141) & + * y(75) +rxt(177)* y(77) +rxt(204)* y(83) + (rxt(205) +rxt(206)) & + * y(84) +rxt(208)* y(86) +rxt(211)* y(99) +rxt(212)* y(100) +rxt(89) & + * y(101) +rxt(84)* y(102) + het_rates(12))* y(12) + prod(89) = (rxt(51)*y(13) +.120_r8*rxt(91)*y(22) +.330_r8*rxt(116)*y(33) + & + .270_r8*rxt(147)*y(50) +.080_r8*rxt(159)*y(53) + & + .215_r8*rxt(161)*y(54) +.700_r8*rxt(194)*y(63))*y(1) & + + (.300_r8*rxt(78)*y(18) +.650_r8*rxt(89)*y(101) + & + .500_r8*rxt(100)*y(29) +.500_r8*rxt(120)*y(38) + & + .100_r8*rxt(168)*y(56))*y(12) + (2.000_r8*rxt(45) +rxt(46)*y(11) + & + .750_r8*rxt(73)*y(15))*y(3) + (rxt(49)*y(2) +rxt(59)*y(5) + & + rxt(63)*y(7))*y(13) + (.330_r8*rxt(10) +.330_r8*rxt(11))*y(9) & + + (.330_r8*rxt(21) +.330_r8*rxt(22))*y(54) +.500_r8*rxt(202)*y(6) & + +rxt(7)*y(8) +2.000_r8*rxt(15)*y(14) +rxt(12)*y(18) +rxt(24)*y(29) & + +rxt(18)*y(32) +rxt(25)*y(36) +rxt(17)*y(38) +rxt(26)*y(41) +rxt(38) & + *y(46) +rxt(37)*y(49) +rxt(29)*y(62) +rxt(40)*y(65) +rxt(39)*y(69) + loss(90) = (rxt(51)* y(1) +rxt(49)* y(2) +rxt(59)* y(5) +rxt(69)* y(6) & + +rxt(63)* y(7) +rxt(54)* y(12) + 2._r8*rxt(52)* y(13) +rxt(77) & + * y(17) +rxt(85)* y(19) +rxt(97)* y(28) +rxt(105)* y(31) +rxt(123) & + * y(35) +rxt(119)* y(37) +rxt(128)* y(40) +rxt(139)* y(45) +rxt(144) & + * y(48) +rxt(150)* y(51) +rxt(165)* y(55) +rxt(171)* y(57) +rxt(182) & + * y(61) +rxt(197)* y(64) +rxt(191)* y(68) +rxt(157)* y(76) +rxt(88) & + * y(103) + rxt(210) + het_rates(13))* y(13) + prod(90) = (rxt(47)*y(11) +rxt(81)*y(16) +rxt(82)*y(16) +rxt(211)*y(99) + & + rxt(212)*y(100) +rxt(48)*y(2) +rxt(50)*y(1) +rxt(53)*y(14) + & + rxt(80)*y(19) +rxt(83)*y(20) +rxt(84)*y(102) + & + .350_r8*rxt(89)*y(101) +.250_r8*rxt(90)*y(22) +rxt(111)*y(26) + & + rxt(112)*y(72) +rxt(114)*y(21) +rxt(134)*y(59) + & + .500_r8*rxt(141)*y(75) +.200_r8*rxt(168)*y(56) +rxt(177)*y(77) + & + .250_r8*rxt(187)*y(66) +.500_r8*rxt(206)*y(84))*y(12) & + + (rxt(74)*y(17) +rxt(87)*y(103) +rxt(96)*y(28) +rxt(118)*y(37) + & + rxt(122)*y(35) +rxt(136)*y(43) +.900_r8*rxt(143)*y(48) + & + rxt(148)*y(51) +.794_r8*rxt(155)*y(76) +.470_r8*rxt(162)*y(55) + & + rxt(180)*y(61) +.900_r8*rxt(190)*y(68) +rxt(196)*y(64))*y(5) & + + (2.000_r8*rxt(75)*y(17) +rxt(98)*y(28) +.900_r8*rxt(106)*y(31) + & + rxt(124)*y(35) +.300_r8*rxt(129)*y(40) +rxt(152)*y(51) + & + .730_r8*rxt(166)*y(55) +rxt(172)*y(57) +.800_r8*rxt(183)*y(61))*y(17) & + + (.120_r8*rxt(91)*y(22) +.190_r8*rxt(116)*y(33) + & + .060_r8*rxt(147)*y(50) +.060_r8*rxt(159)*y(53) + & + .275_r8*rxt(161)*y(54) +rxt(194)*y(63))*y(1) + (rxt(79)*y(19) + & + rxt(149)*y(51) +.794_r8*rxt(156)*y(76) +.470_r8*rxt(164)*y(55) + & + rxt(178)*y(77) +rxt(181)*y(61))*y(7) + (.660_r8*rxt(10) + & + .660_r8*rxt(11) +rxt(71))*y(9) + (rxt(153)*y(51) + & + .470_r8*rxt(167)*y(55) +rxt(184)*y(61))*y(31) + (rxt(46)*y(11) + & + .400_r8*rxt(73)*y(15))*y(3) + (rxt(93) +rxt(94))*y(23) & + + (.670_r8*rxt(21) +.670_r8*rxt(22))*y(54) +.700_r8*rxt(189)*y(70) & + *y(6) +.794_r8*rxt(157)*y(76)*y(13) +rxt(12)*y(18) +2.000_r8*rxt(13) & + *y(19) +2.000_r8*rxt(33)*y(26) +1.200_r8*rxt(99)*y(28)*y(28) +rxt(24) & + *y(29) +rxt(16)*y(30) +rxt(25)*y(36) +rxt(17)*y(38) +.900_r8*rxt(37) & + *y(49) +rxt(31)*y(52) +rxt(32)*y(59) +rxt(28)*y(60) +rxt(40)*y(65) & + +.560_r8*rxt(35)*y(71) +2.000_r8*rxt(36)*y(72) +rxt(30)*y(77) & + +rxt(86)*y(103) + loss(26) = (rxt(53)* y(12) + rxt(15) + het_rates(14))* y(14) + prod(26) = (.500_r8*rxt(210) +rxt(52)*y(13))*y(13) +rxt(56)*y(12)*y(12) + loss(92) = (rxt(74)* y(5) +rxt(77)* y(13) + 2._r8*(rxt(75) +rxt(76))* y(17) & + +rxt(98)* y(28) +rxt(106)* y(31) +rxt(124)* y(35) +rxt(129)* y(40) & + +rxt(152)* y(51) +rxt(166)* y(55) +rxt(172)* y(57) +rxt(183)* y(61) & + + het_rates(17))* y(17) + prod(92) = (rxt(103)*y(5) +.900_r8*rxt(106)*y(17) +2.000_r8*rxt(110)*y(31) + & + rxt(153)*y(51) +rxt(167)*y(55) +rxt(173)*y(57) +rxt(184)*y(61))*y(31) & + + (rxt(72)*y(15) +.700_r8*rxt(78)*y(18) +rxt(113)*y(25))*y(12) & + +.310_r8*rxt(116)*y(33)*y(1) +.750_r8*rxt(73)*y(15)*y(3) +rxt(16) & + *y(30) +rxt(18)*y(32) +rxt(27)*y(39) +.300_r8*rxt(23)*y(53) & + +.400_r8*rxt(19)*y(73) + loss(43) = (rxt(78)* y(12) + rxt(12) + het_rates(18))* y(18) + prod(43) =rxt(77)*y(17)*y(13) + loss(82) = (rxt(79)* y(7) +rxt(80)* y(12) +rxt(85)* y(13) + rxt(13) + rxt(14) & + + het_rates(19))* y(19) + prod(82) = (rxt(74)*y(5) +2.000_r8*rxt(75)*y(17) +rxt(76)*y(17) + & + .700_r8*rxt(98)*y(28) +rxt(106)*y(31) +rxt(124)*y(35) + & + .800_r8*rxt(129)*y(40) +1.200_r8*rxt(152)*y(51) + & + .880_r8*rxt(166)*y(55) +2.000_r8*rxt(172)*y(57) + & + .700_r8*rxt(183)*y(61))*y(17) + (rxt(118)*y(37) +rxt(127)*y(40) + & + .500_r8*rxt(136)*y(43) +.100_r8*rxt(143)*y(48) + & + .550_r8*rxt(148)*y(51) +.072_r8*rxt(155)*y(76) + & + .250_r8*rxt(162)*y(55) +rxt(169)*y(57))*y(5) & + + (.300_r8*rxt(78)*y(18) +rxt(83)*y(20) +.500_r8*rxt(90)*y(22) + & + .500_r8*rxt(107)*y(32) +rxt(108)*y(73) +.800_r8*rxt(111)*y(26) + & + .500_r8*rxt(141)*y(75))*y(12) + (rxt(91)*y(22) + & + .540_r8*rxt(116)*y(33) +.600_r8*rxt(147)*y(50) + & + .800_r8*rxt(159)*y(53) +.700_r8*rxt(161)*y(54))*y(1) & + + (.600_r8*rxt(149)*y(51) +.072_r8*rxt(156)*y(76) + & + .250_r8*rxt(164)*y(55) +rxt(170)*y(57))*y(7) & + + (.600_r8*rxt(153)*y(51) +.250_r8*rxt(167)*y(55) +rxt(173)*y(57)) & + *y(31) + (.670_r8*rxt(21) +.670_r8*rxt(22))*y(54) & + +.250_r8*rxt(73)*y(15)*y(3) +.008_r8*rxt(157)*y(76)*y(13) +rxt(12) & + *y(18) +2.000_r8*rxt(94)*y(23) +rxt(33)*y(26) +rxt(17)*y(38) +rxt(26) & + *y(41) +.100_r8*rxt(37)*y(49) +.690_r8*rxt(31)*y(52) & + +2.000_r8*rxt(174)*y(57)*y(57) +rxt(32)*y(59) +rxt(30)*y(77) & + +rxt(86)*y(103) + loss(62) = (rxt(83)* y(12) + het_rates(20))* y(20) + prod(62) = (rxt(76)*y(17) +.300_r8*rxt(98)*y(28) +.500_r8*rxt(129)*y(40) + & + .250_r8*rxt(152)*y(51) +.250_r8*rxt(166)*y(55) + & + .300_r8*rxt(183)*y(61))*y(17) + loss(33) = (rxt(114)* y(12) + het_rates(21))* y(21) + prod(33) = (.200_r8*rxt(98)*y(17) +.400_r8*rxt(99)*y(28))*y(28) + loss(38) = (rxt(91)* y(1) +rxt(90)* y(12) + het_rates(22))* y(22) + prod(38) = 0._r8 + loss(27) = ( + rxt(93) + rxt(94) + het_rates(23))* y(23) + prod(27) =rxt(92)*y(24)*y(5) + loss(45) = (rxt(92)* y(5) + het_rates(24))* y(24) + prod(45) =.750_r8*rxt(90)*y(22)*y(12) + loss(50) = (rxt(113)* y(12) + het_rates(25))* y(25) + prod(50) = (.250_r8*rxt(116)*y(33) +.200_r8*rxt(147)*y(50))*y(1) & + + (.250_r8*rxt(105)*y(31) +.250_r8*rxt(171)*y(57))*y(13) & + +.100_r8*rxt(106)*y(31)*y(17) + loss(63) = (rxt(111)* y(12) + rxt(33) + het_rates(26))* y(26) + prod(63) = (.530_r8*rxt(162)*y(5) +.530_r8*rxt(164)*y(7) + & + .260_r8*rxt(166)*y(17) +.530_r8*rxt(167)*y(31))*y(55) & + + (.250_r8*rxt(180)*y(5) +.250_r8*rxt(181)*y(7) + & + .100_r8*rxt(183)*y(17) +.250_r8*rxt(184)*y(31))*y(61) +rxt(93)*y(23) + loss(18) = (rxt(95)* y(12) + het_rates(27))* y(27) + prod(18) = 0._r8 + loss(71) = (rxt(96)* y(5) +rxt(97)* y(13) +rxt(98)* y(17) + 2._r8*rxt(99) & + * y(28) + het_rates(28))* y(28) + prod(71) = (rxt(95)*y(27) +.500_r8*rxt(100)*y(29))*y(12) +rxt(34)*y(44) + loss(42) = (rxt(100)* y(12) + rxt(24) + het_rates(29))* y(29) + prod(42) =rxt(97)*y(28)*y(13) + loss(76) = (rxt(102)* y(7) +rxt(101)* y(12) + rxt(16) + het_rates(30))* y(30) + prod(76) = (rxt(96)*y(28) +rxt(118)*y(37) +.270_r8*rxt(122)*y(35) + & + rxt(136)*y(43) +rxt(138)*y(45) +.400_r8*rxt(143)*y(48))*y(5) & + + (.500_r8*rxt(116)*y(33) +.040_r8*rxt(159)*y(53))*y(1) & + + (.500_r8*rxt(100)*y(29) +rxt(114)*y(21))*y(12) & + + (.800_r8*rxt(98)*y(17) +1.600_r8*rxt(99)*y(28))*y(28) +rxt(24) & + *y(29) +rxt(17)*y(38) +rxt(38)*y(46) +.400_r8*rxt(37)*y(49) + loss(95) = (rxt(103)* y(5) +rxt(104)* y(6) +rxt(105)* y(13) +rxt(106)* y(17) & + + 2._r8*rxt(110)* y(31) +rxt(153)* y(51) +rxt(167)* y(55) +rxt(184) & + * y(61) + het_rates(31))* y(31) + prod(95) = (rxt(127)*y(40) +rxt(138)*y(45) +.530_r8*rxt(162)*y(55) + & + rxt(169)*y(57))*y(5) + (rxt(102)*y(30) +rxt(133)*y(60) + & + .530_r8*rxt(164)*y(55) +rxt(170)*y(57))*y(7) + (rxt(101)*y(30) + & + .500_r8*rxt(107)*y(32) +rxt(132)*y(60))*y(12) & + + (.300_r8*rxt(129)*y(40) +.260_r8*rxt(166)*y(55) +rxt(172)*y(57)) & + *y(17) + (.670_r8*rxt(21) +.670_r8*rxt(22))*y(54) & + + (.600_r8*rxt(19) +rxt(109))*y(73) +.530_r8*rxt(167)*y(55)*y(31) & + +rxt(27)*y(39) +rxt(26)*y(41) +rxt(34)*y(44) +rxt(38)*y(46) & + +.300_r8*rxt(23)*y(53) +2.000_r8*rxt(174)*y(57)*y(57) +rxt(32)*y(59) & + +rxt(28)*y(60) +.130_r8*rxt(35)*y(71) + loss(49) = (rxt(107)* y(12) + rxt(18) + het_rates(32))* y(32) + prod(49) = (.750_r8*rxt(105)*y(31) +.750_r8*rxt(171)*y(57))*y(13) + loss(75) = (rxt(116)* y(1) +rxt(117)* y(7) +rxt(115)* y(12) + het_rates(33)) & + * y(33) + prod(75) =.070_r8*rxt(147)*y(50)*y(1) +.700_r8*rxt(23)*y(53) + loss(19) = (rxt(121)* y(12) + het_rates(34))* y(34) + prod(19) = 0._r8 + loss(72) = (rxt(122)* y(5) +rxt(123)* y(13) +rxt(124)* y(17) + het_rates(35)) & + * y(35) + prod(72) = (rxt(121)*y(34) +rxt(125)*y(36))*y(12) + loss(40) = (rxt(125)* y(12) + rxt(25) + het_rates(36))* y(36) + prod(40) =rxt(123)*y(35)*y(13) + loss(67) = (rxt(118)* y(5) +rxt(119)* y(13) + het_rates(37))* y(37) + prod(67) = (rxt(115)*y(33) +.500_r8*rxt(120)*y(38))*y(12) + loss(52) = (rxt(120)* y(12) + rxt(17) + het_rates(38))* y(38) + prod(52) =rxt(119)*y(37)*y(13) + loss(68) = (rxt(126)* y(12) + rxt(27) + het_rates(39))* y(39) + prod(68) = (.820_r8*rxt(122)*y(35) +.500_r8*rxt(136)*y(43) + & + .250_r8*rxt(143)*y(48) +.100_r8*rxt(196)*y(64))*y(5) & + +.820_r8*rxt(124)*y(35)*y(17) +.820_r8*rxt(25)*y(36) & + +.250_r8*rxt(37)*y(49) +.100_r8*rxt(40)*y(65) + loss(78) = (rxt(127)* y(5) +rxt(128)* y(13) +rxt(129)* y(17) + het_rates(40)) & + * y(40) + prod(78) = (rxt(126)*y(39) +rxt(130)*y(41))*y(12) + loss(34) = (rxt(130)* y(12) + rxt(26) + het_rates(41))* y(41) + prod(34) =rxt(128)*y(40)*y(13) + loss(20) = (rxt(135)* y(12) + het_rates(42))* y(42) + prod(20) = 0._r8 + loss(35) = (rxt(136)* y(5) + het_rates(43))* y(43) + prod(35) =rxt(135)*y(42)*y(12) + loss(21) = (rxt(142)* y(12) + het_rates(47))* y(47) + prod(21) = 0._r8 + loss(70) = (rxt(143)* y(5) +rxt(144)* y(13) + het_rates(48))* y(48) + prod(70) = (rxt(142)*y(47) +rxt(145)*y(49))*y(12) + loss(65) = (rxt(145)* y(12) + rxt(37) + het_rates(49))* y(49) + prod(65) =rxt(144)*y(48)*y(13) + loss(51) = (rxt(137)* y(12) + rxt(34) + het_rates(44))* y(44) + prod(51) =.750_r8*rxt(143)*y(48)*y(5) +.800_r8*rxt(37)*y(49) + loss(66) = (rxt(138)* y(5) +rxt(139)* y(13) + het_rates(45))* y(45) + prod(66) = (rxt(137)*y(44) +rxt(140)*y(46))*y(12) + loss(36) = (rxt(140)* y(12) + rxt(38) + het_rates(46))* y(46) + prod(36) =rxt(139)*y(45)*y(13) + loss(74) = (rxt(147)* y(1) +rxt(154)* y(7) +rxt(146)* y(12) + het_rates(50)) & + * y(50) + prod(74) = 0._r8 + loss(86) = (rxt(148)* y(5) +rxt(149)* y(7) +rxt(150)* y(13) +rxt(152)* y(17) & + +rxt(153)* y(31) + het_rates(51))* y(51) + prod(86) = (rxt(146)*y(50) +.200_r8*rxt(151)*y(52))*y(12) + loss(61) = (rxt(151)* y(12) + rxt(31) + het_rates(52))* y(52) + prod(61) =rxt(150)*y(51)*y(13) + loss(84) = (rxt(159)* y(1) +rxt(158)* y(12) + rxt(23) + het_rates(53))* y(53) + prod(84) = (.320_r8*rxt(148)*y(5) +.350_r8*rxt(149)*y(7) + & + .260_r8*rxt(152)*y(17) +.350_r8*rxt(153)*y(31))*y(51) & + + (.039_r8*rxt(155)*y(5) +.039_r8*rxt(156)*y(7) + & + .039_r8*rxt(157)*y(13))*y(76) + (.200_r8*rxt(147)*y(50) + & + rxt(194)*y(63))*y(1) +rxt(196)*y(64)*y(5) +.402_r8*rxt(31)*y(52) & + +rxt(40)*y(65) + loss(80) = (rxt(161)* y(1) +rxt(160)* y(12) + rxt(21) + rxt(22) & + + het_rates(54))* y(54) + prod(80) = (.230_r8*rxt(148)*y(5) +.250_r8*rxt(149)*y(7) + & + .190_r8*rxt(152)*y(17) +.250_r8*rxt(153)*y(31))*y(51) & + + (.167_r8*rxt(155)*y(5) +.167_r8*rxt(156)*y(7) + & + .167_r8*rxt(157)*y(13))*y(76) + (.400_r8*rxt(147)*y(50) + & + rxt(194)*y(63))*y(1) +rxt(196)*y(64)*y(5) +.288_r8*rxt(31)*y(52) & + +rxt(40)*y(65) + loss(85) = ((rxt(162) +rxt(163))* y(5) +rxt(164)* y(7) +rxt(165)* y(13) & + +rxt(166)* y(17) +rxt(167)* y(31) + het_rates(55))* y(55) + prod(85) = (rxt(158)*y(53) +.500_r8*rxt(160)*y(54) +.200_r8*rxt(168)*y(56)) & + *y(12) + loss(37) = (rxt(168)* y(12) + het_rates(56))* y(56) + prod(37) =rxt(165)*y(55)*y(13) + loss(87) = (rxt(169)* y(5) +rxt(175)* y(6) +rxt(170)* y(7) +rxt(171)* y(13) & + +rxt(172)* y(17) +rxt(173)* y(31) + 2._r8*rxt(174)* y(57) & + + het_rates(57))* y(57) + prod(87) = (.330_r8*rxt(21) +.330_r8*rxt(22) +.500_r8*rxt(160)*y(12))*y(54) & + + (rxt(20) +rxt(176))*y(75) +.200_r8*rxt(147)*y(50)*y(1) & + +.500_r8*rxt(168)*y(56)*y(12) + loss(44) = (rxt(179)* y(12) + het_rates(58))* y(58) + prod(44) = (.370_r8*rxt(148)*y(5) +.400_r8*rxt(149)*y(7) + & + .300_r8*rxt(152)*y(17) +.400_r8*rxt(153)*y(31))*y(51) & + + (rxt(177)*y(12) +rxt(178)*y(7))*y(77) + loss(79) = (rxt(134)* y(12) + rxt(32) + het_rates(59))* y(59) + prod(79) = (.220_r8*rxt(162)*y(5) +.220_r8*rxt(164)*y(7) + & + .230_r8*rxt(166)*y(17) +.220_r8*rxt(167)*y(31))*y(55) & + + (.250_r8*rxt(180)*y(5) +.250_r8*rxt(181)*y(7) + & + .100_r8*rxt(183)*y(17) +.250_r8*rxt(184)*y(31))*y(61) & + + (.500_r8*rxt(120)*y(38) +.500_r8*rxt(141)*y(75))*y(12) & + +.200_r8*rxt(129)*y(40)*y(17) + loss(81) = (rxt(133)* y(7) +rxt(132)* y(12) + rxt(28) + het_rates(60))* y(60) + prod(81) = (.250_r8*rxt(162)*y(5) +.250_r8*rxt(164)*y(7) + & + .240_r8*rxt(166)*y(17) +.250_r8*rxt(167)*y(31))*y(55) & + + (.250_r8*rxt(180)*y(5) +.250_r8*rxt(181)*y(7) + & + .100_r8*rxt(183)*y(17) +.250_r8*rxt(184)*y(31))*y(61) & + + (.950_r8*rxt(159)*y(53) +.800_r8*rxt(161)*y(54))*y(1) & + + (rxt(131)*y(74) +rxt(134)*y(59))*y(12) +.450_r8*rxt(190)*y(68) & + *y(5) +.500_r8*rxt(129)*y(40)*y(17) +.450_r8*rxt(39)*y(69) & + +.180_r8*rxt(35)*y(71) + loss(83) = (rxt(180)* y(5) +rxt(181)* y(7) +rxt(182)* y(13) +rxt(183)* y(17) & + +rxt(184)* y(31) + het_rates(61))* y(61) + prod(83) = (.800_r8*rxt(151)*y(52) +rxt(179)*y(58) +rxt(185)*y(62))*y(12) + loss(28) = ((rxt(185) +rxt(186))* y(12) + rxt(29) + het_rates(62))* y(62) + prod(28) =rxt(182)*y(61)*y(13) + loss(64) = (rxt(194)* y(1) +rxt(195)* y(7) +rxt(193)* y(12) + het_rates(63)) & + * y(63) + prod(64) = 0._r8 + loss(77) = (rxt(196)* y(5) +rxt(197)* y(13) + het_rates(64))* y(64) + prod(77) = (rxt(193)*y(63) +rxt(198)*y(65))*y(12) +rxt(195)*y(63)*y(7) + loss(53) = (rxt(198)* y(12) + rxt(40) + het_rates(65))* y(65) + prod(53) =rxt(197)*y(64)*y(13) + loss(23) = (rxt(187)* y(12) + het_rates(66))* y(66) + prod(23) = 0._r8 + loss(24) = (rxt(188)* y(12) + het_rates(67))* y(67) + prod(24) =.250_r8*rxt(187)*y(66)*y(12) + loss(55) = (rxt(190)* y(5) +rxt(191)* y(13) + het_rates(68))* y(68) + prod(55) = (.700_r8*rxt(187)*y(66) +rxt(192)*y(69))*y(12) + loss(46) = (rxt(192)* y(12) + rxt(39) + het_rates(69))* y(69) + prod(46) =rxt(191)*y(68)*y(13) + loss(29) = (rxt(189)* y(6) + het_rates(70))* y(70) + prod(29) =rxt(188)*y(67)*y(12) + loss(56) = ( + rxt(35) + het_rates(71))* y(71) + prod(56) =.900_r8*rxt(190)*y(68)*y(5) +.700_r8*rxt(189)*y(70)*y(6) & + +.900_r8*rxt(39)*y(69) + loss(54) = (rxt(112)* y(12) + rxt(36) + het_rates(72))* y(72) + prod(54) = (.250_r8*rxt(180)*y(5) +.250_r8*rxt(181)*y(7) + & + .100_r8*rxt(183)*y(17))*y(61) + (.650_r8*rxt(89)*y(101) + & + .200_r8*rxt(111)*y(26))*y(12) +.450_r8*rxt(190)*y(68)*y(5) & + +.450_r8*rxt(39)*y(69) +.130_r8*rxt(35)*y(71) + loss(57) = (rxt(108)* y(12) + rxt(19) + rxt(109) + het_rates(73))* y(73) + prod(57) =rxt(104)*y(31)*y(6) + loss(47) = (rxt(131)* y(12) + het_rates(74))* y(74) + prod(47) =.100_r8*rxt(143)*y(48)*y(5) +rxt(117)*y(33)*y(7) + loss(60) = (rxt(141)* y(12) + rxt(20) + rxt(176) + het_rates(75))* y(75) + prod(60) =rxt(175)*y(57)*y(6) + loss(69) = (rxt(155)* y(5) +rxt(156)* y(7) +rxt(157)* y(13) + het_rates(76)) & + * y(76) + prod(69) =rxt(154)*y(50)*y(7) + loss(73) = (rxt(178)* y(7) +rxt(177)* y(12) + rxt(30) + het_rates(77))* y(77) + prod(73) = (.080_r8*rxt(148)*y(51) +.794_r8*rxt(155)*y(76) + & + .800_r8*rxt(163)*y(55))*y(5) + (.794_r8*rxt(156)*y(7) + & + .794_r8*rxt(157)*y(13))*y(76) + loss(22) = (rxt(204)* y(12) + het_rates(83))* y(83) + prod(22) = (rxt(205)*y(12) +.500_r8*rxt(206)*y(12) +rxt(207)*y(7))*y(84) + loss(32) = (rxt(207)* y(7) + (rxt(205) +rxt(206))* y(12) + het_rates(84)) & + * y(84) + prod(32) = 0._r8 + loss(1) = ( + het_rates(85))* y(85) + prod(1) =rxt(204)*y(83)*y(12) + loss(17) = (rxt(208)* y(12) + het_rates(86))* y(86) + prod(17) = 0._r8 + loss(2) = ( + het_rates(87))* y(87) + prod(2) = 0._r8 + loss(3) = ( + het_rates(88))* y(88) + prod(3) = 0._r8 + loss(4) = ( + het_rates(82))* y(82) + prod(4) = 0._r8 + loss(5) = ( + rxt(203) + het_rates(78))* y(78) + prod(5) = 0._r8 + loss(6) = ( + het_rates(79))* y(79) + prod(6) =rxt(203)*y(78) + loss(7) = ( + rxt(209) + het_rates(80))* y(80) + prod(7) = 0._r8 + loss(8) = ( + het_rates(81))* y(81) + prod(8) =rxt(209)*y(80) + loss(25) = (rxt(89)* y(12) + het_rates(101))* y(101) + prod(25) = 0._r8 + loss(39) = (rxt(84)* y(12) + het_rates(102))* y(102) + prod(39) = (rxt(87)*y(5) +rxt(88)*y(13))*y(103) +.500_r8*rxt(91)*y(22)*y(1) & + +.350_r8*rxt(89)*y(101)*y(12) + loss(48) = (rxt(87)* y(5) +rxt(88)* y(13) + rxt(86) + het_rates(103))* y(103) + prod(48) =rxt(85)*y(19)*y(13) + loss(9) = ( + het_rates(89))* y(89) + prod(9) = 0._r8 + loss(10) = ( + het_rates(90))* y(90) + prod(10) = 0._r8 + loss(11) = ( + het_rates(91))* y(91) + prod(11) = 0._r8 + loss(12) = ( + het_rates(92))* y(92) + prod(12) = 0._r8 + loss(13) = ( + het_rates(93))* y(93) + prod(13) = 0._r8 + loss(14) = ( + het_rates(94))* y(94) + prod(14) = 0._r8 + loss(15) = ( + het_rates(95))* y(95) + prod(15) = 0._r8 + loss(16) = ( + het_rates(96))* y(96) + prod(16) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..ea7f19f726 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_rxt_rates_conv.F90 @@ -0,0 +1,224 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 4) ! rate_const*N2O + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 6) ! rate_const*NO2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 10) ! rate_const*N2O5 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 8) ! rate_const*HNO3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 7) ! rate_const*NO3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 7) ! rate_const*NO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 9) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 18) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 14) ! rate_const*H2O2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 30) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 38) ! rate_const*POOH + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 32) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 73) ! rate_const*PAN + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 75) ! rate_const*MPAN + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 54) ! rate_const*MACR + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 54) ! rate_const*MACR + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 53) ! rate_const*MVK + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 29) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 36) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 41) ! rate_const*ROOH + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 39) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 60) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 62) ! rate_const*XOOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 77) ! rate_const*ONITR + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 52) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 59) ! rate_const*HYAC + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 26) ! rate_const*GLYALD + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 44) ! rate_const*MEK + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 71) ! rate_const*BIGALD + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 72) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 46) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 69) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 65) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 2) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 3) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 3) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 3) ! rate_const*H2O*O1D + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 11)*sol(:ncol,:, 3) ! rate_const*H2*O1D + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 11)*sol(:ncol,:, 12) ! rate_const*H2*OH + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 2)*sol(:ncol,:, 12) ! rate_const*O*OH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 13)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 12)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 13)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 13)*sol(:ncol,:, 13) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 14)*sol(:ncol,:, 12) ! rate_const*H2O2*OH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 12)*sol(:ncol,:, 13) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 12)*sol(:ncol,:, 12) ! rate_const*OH*OH + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 12)*sol(:ncol,:, 12) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*N2O*O1D + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*N2O*O1D + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 5)*sol(:ncol,:, 13) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 6)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 7)*sol(:ncol,:, 13) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 6)*sol(:ncol,:, 7) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 10) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 6)*sol(:ncol,:, 12) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 8)*sol(:ncol,:, 12) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 7)*sol(:ncol,:, 5) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 6)*sol(:ncol,:, 13) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 9)*sol(:ncol,:, 12) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 9) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 15)*sol(:ncol,:, 12) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 15)*sol(:ncol,:, 3) ! rate_const*CH4*O1D + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 17)*sol(:ncol,:, 5) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 17)*sol(:ncol,:, 17) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 17)*sol(:ncol,:, 17) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 17)*sol(:ncol,:, 13) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 18)*sol(:ncol,:, 12) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 19)*sol(:ncol,:, 7) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 19)*sol(:ncol,:, 12) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 16)*sol(:ncol,:, 12) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 16)*sol(:ncol,:, 12) ! rate_const*CO*OH + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 20)*sol(:ncol,:, 12) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 102)*sol(:ncol,:, 12) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 19)*sol(:ncol,:, 13) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 103) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 103)*sol(:ncol,:, 5) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 103)*sol(:ncol,:, 13) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 101)*sol(:ncol,:, 12) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 22)*sol(:ncol,:, 12) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 22)*sol(:ncol,:, 1) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 24)*sol(:ncol,:, 5) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 23) ! rate_const*O2*EO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 23) ! rate_const*EO + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 27)*sol(:ncol,:, 12) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 28)*sol(:ncol,:, 5) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 28)*sol(:ncol,:, 13) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 28)*sol(:ncol,:, 17) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 29)*sol(:ncol,:, 12) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 30)*sol(:ncol,:, 12) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 30)*sol(:ncol,:, 7) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 31)*sol(:ncol,:, 5) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 31)*sol(:ncol,:, 6) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 31)*sol(:ncol,:, 13) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 31)*sol(:ncol,:, 17) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 32)*sol(:ncol,:, 12) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 73)*sol(:ncol,:, 12) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 73) ! rate_const*M*PAN + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 31)*sol(:ncol,:, 31) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 26)*sol(:ncol,:, 12) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 72)*sol(:ncol,:, 12) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 25)*sol(:ncol,:, 12) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 21)*sol(:ncol,:, 12) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 33)*sol(:ncol,:, 12) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 33)*sol(:ncol,:, 1) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 33)*sol(:ncol,:, 7) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 37)*sol(:ncol,:, 5) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 37)*sol(:ncol,:, 13) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 38)*sol(:ncol,:, 12) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 34)*sol(:ncol,:, 12) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 35)*sol(:ncol,:, 5) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 35)*sol(:ncol,:, 13) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 35)*sol(:ncol,:, 17) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 36)*sol(:ncol,:, 12) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 39)*sol(:ncol,:, 12) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 40)*sol(:ncol,:, 5) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 40)*sol(:ncol,:, 13) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 40)*sol(:ncol,:, 17) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 41)*sol(:ncol,:, 12) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 74)*sol(:ncol,:, 12) ! rate_const*ONIT*OH + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 60)*sol(:ncol,:, 12) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 60)*sol(:ncol,:, 7) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 59)*sol(:ncol,:, 12) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 42)*sol(:ncol,:, 12) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 43)*sol(:ncol,:, 5) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 44)*sol(:ncol,:, 12) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 45)*sol(:ncol,:, 5) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 45)*sol(:ncol,:, 13) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 46)*sol(:ncol,:, 12) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 75)*sol(:ncol,:, 12) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 47)*sol(:ncol,:, 12) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 48)*sol(:ncol,:, 5) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 48)*sol(:ncol,:, 13) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 49)*sol(:ncol,:, 12) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 50)*sol(:ncol,:, 12) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 50)*sol(:ncol,:, 1) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 51)*sol(:ncol,:, 5) ! rate_const*ISOPO2*NO + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 51)*sol(:ncol,:, 7) ! rate_const*ISOPO2*NO3 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 51)*sol(:ncol,:, 13) ! rate_const*ISOPO2*HO2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 52)*sol(:ncol,:, 12) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 51)*sol(:ncol,:, 17) ! rate_const*ISOPO2*CH3O2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 51)*sol(:ncol,:, 31) ! rate_const*ISOPO2*CH3CO3 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 50)*sol(:ncol,:, 7) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 76)*sol(:ncol,:, 5) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 76)*sol(:ncol,:, 7) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 76)*sol(:ncol,:, 13) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 53)*sol(:ncol,:, 12) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 53)*sol(:ncol,:, 1) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 54)*sol(:ncol,:, 12) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 54)*sol(:ncol,:, 1) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 55)*sol(:ncol,:, 5) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 55)*sol(:ncol,:, 5) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 55)*sol(:ncol,:, 7) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 55)*sol(:ncol,:, 13) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 55)*sol(:ncol,:, 17) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 55)*sol(:ncol,:, 31) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 56)*sol(:ncol,:, 12) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 57)*sol(:ncol,:, 5) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 57)*sol(:ncol,:, 7) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 57)*sol(:ncol,:, 13) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 57)*sol(:ncol,:, 17) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 57)*sol(:ncol,:, 31) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 57)*sol(:ncol,:, 57) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 57)*sol(:ncol,:, 6) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 75) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 77)*sol(:ncol,:, 12) ! rate_const*ONITR*OH + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 77)*sol(:ncol,:, 7) ! rate_const*ONITR*NO3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 58)*sol(:ncol,:, 12) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 61)*sol(:ncol,:, 5) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 61)*sol(:ncol,:, 7) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 61)*sol(:ncol,:, 13) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 61)*sol(:ncol,:, 17) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 61)*sol(:ncol,:, 31) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 62)*sol(:ncol,:, 12) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 62)*sol(:ncol,:, 12) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 66)*sol(:ncol,:, 12) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 67)*sol(:ncol,:, 12) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 70)*sol(:ncol,:, 6) ! rate_const*XOH*NO2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 68)*sol(:ncol,:, 5) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 68)*sol(:ncol,:, 13) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 69)*sol(:ncol,:, 12) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 63)*sol(:ncol,:, 12) ! rate_const*C10H16*OH + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 63)*sol(:ncol,:, 1) ! rate_const*C10H16*O3 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 63)*sol(:ncol,:, 7) ! rate_const*C10H16*NO3 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 64)*sol(:ncol,:, 5) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 64)*sol(:ncol,:, 13) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 65)*sol(:ncol,:, 12) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 97) ! rate_const*Rn + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 10) ! rate_const*N2O5 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 7) ! rate_const*NO3 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 6) ! rate_const*NO2 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 78) ! rate_const*CB1 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 83)*sol(:ncol,:, 12) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 84)*sol(:ncol,:, 12) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 84)*sol(:ncol,:, 12) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 84)*sol(:ncol,:, 7) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 86)*sol(:ncol,:, 12) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 80) ! rate_const*OC1 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 13) ! rate_const*HO2 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 99)*sol(:ncol,:, 12) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 100)*sol(:ncol,:, 12) ! rate_const*CH3CN*OH + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_mozart/mo_setrxt.F90 b/src/chemistry/pp_trop_mozart/mo_setrxt.F90 new file mode 100644 index 0000000000..f5f00aad1d --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_setrxt.F90 @@ -0,0 +1,279 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,45) = 2.2e-10_r8 + rate(:,:,46) = 1.1e-10_r8 + rate(:,:,55) = 1.8e-12_r8 + rate(:,:,57) = 4.9e-11_r8 + rate(:,:,58) = 6.7e-11_r8 + rate(:,:,63) = 3.5e-12_r8 + rate(:,:,73) = 1.5e-10_r8 + rate(:,:,80) = 9.e-12_r8 + rate(:,:,84) = 4.5e-13_r8 + rate(:,:,93) = 1.e-14_r8 + rate(:,:,98) = 2.e-13_r8 + rate(:,:,99) = 6.8e-14_r8 + rate(:,:,107) = 1e-12_r8 + rate(:,:,108) = 4.e-14_r8 + rate(:,:,111) = 1.e-11_r8 + rate(:,:,112) = 1.1e-11_r8 + rate(:,:,113) = 7.e-13_r8 + rate(:,:,131) = 6.8e-13_r8 + rate(:,:,134) = 3.e-12_r8 + rate(:,:,135) = 5.4e-11_r8 + rate(:,:,142) = 3.5e-12_r8 + rate(:,:,149) = 2.4e-12_r8 + rate(:,:,153) = 1.4e-11_r8 + rate(:,:,156) = 2.4e-12_r8 + rate(:,:,164) = 2.4e-12_r8 + rate(:,:,167) = 1.4e-11_r8 + rate(:,:,170) = 5.e-12_r8 + rate(:,:,177) = 4.5e-11_r8 + rate(:,:,181) = 2.40e-12_r8 + rate(:,:,188) = 3.e-12_r8 + rate(:,:,189) = 1.e-11_r8 + rate(:,:,199) = 2.1e-6_r8 + rate(:,:,203) = 7.1e-6_r8 + rate(:,:,209) = 7.1e-6_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,42) = 8e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,43) = 2.1e-11_r8 * exp( 115._r8 * itemp(:,:) ) + rate(:,:,44) = 3.30e-11_r8 * exp( 55._r8 * itemp(:,:) ) + rate(:,:,47) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,48) = 2.2e-11_r8 * exp( 120._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,49) = 3e-11_r8 * exp_fac(:,:) + rate(:,:,78) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,100) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,120) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,125) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,130) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,140) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,145) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,151) = 1.52e-11_r8 * exp_fac(:,:) + rate(:,:,168) = 2.3e-11_r8 * exp_fac(:,:) + rate(:,:,192) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,198) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,50) = 1.7e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:,51) = 1.e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,53) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,54) = 4.8e-11_r8 * exp_fac(:,:) + rate(:,:,59) = 3.5e-12_r8 * exp_fac(:,:) + rate(:,:,60) = 3e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:,61) = 5.1e-12_r8 * exp( 210._r8 * itemp(:,:) ) + rate(:,:,62) = 1.2e-13_r8 * exp( -2450._r8 * itemp(:,:) ) + rate(:,:,68) = 1.5e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,70) = 1.3e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,72) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 300._r8 * itemp(:,:) ) + rate(:,:,74) = 2.8e-12_r8 * exp_fac(:,:) + rate(:,:,127) = 2.9e-12_r8 * exp_fac(:,:) + rate(:,:,75) = 5.e-13_r8 * exp( -424._r8 * itemp(:,:) ) + rate(:,:,76) = 1.9e-14_r8 * exp( 706._r8 * itemp(:,:) ) + rate(:,:,77) = 4.1e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,79) = 6.0e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,83) = 7.3e-12_r8 * exp( -620._r8 * itemp(:,:) ) + rate(:,:,85) = 9.7e-15_r8 * exp( 625._r8 * itemp(:,:) ) + rate(:,:,86) = 2.4e12_r8 * exp( -7000._r8 * itemp(:,:) ) + rate(:,:,87) = 2.6e-12_r8 * exp( 265._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 700._r8 * itemp(:,:) ) + rate(:,:,88) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,97) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,119) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,123) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,128) = 8.6e-13_r8 * exp_fac(:,:) + rate(:,:,139) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,144) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,150) = 8.e-13_r8 * exp_fac(:,:) + rate(:,:,157) = 8.e-13_r8 * exp_fac(:,:) + rate(:,:,165) = 8.e-13_r8 * exp_fac(:,:) + rate(:,:,182) = 8.e-13_r8 * exp_fac(:,:) + rate(:,:,191) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,197) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,91) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 180._r8 * itemp(:,:) ) + rate(:,:,92) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,118) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,122) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,136) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,138) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,143) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,148) = 4.4e-12_r8 * exp_fac(:,:) + rate(:,:,190) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,196) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,94) = 1.6e11_r8 * exp( -4150._r8 * itemp(:,:) ) + rate(:,:,95) = 8.7e-12_r8 * exp( -1070._r8 * itemp(:,:) ) + rate(:,:,96) = 2.6e-12_r8 * exp( 365._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,101) = 5.6e-12_r8 * exp_fac(:,:) + rate(:,:,103) = 8.1e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1900._r8 * itemp(:,:) ) + rate(:,:,102) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,116) = 6.5e-15_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 1040._r8 * itemp(:,:) ) + rate(:,:,105) = 4.3e-13_r8 * exp_fac(:,:) + rate(:,:,171) = 4.30e-13_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 500._r8 * itemp(:,:) ) + rate(:,:,106) = 2.0e-12_r8 * exp_fac(:,:) + rate(:,:,110) = 2.5e-12_r8 * exp_fac(:,:) + rate(:,:,129) = 7.1e-13_r8 * exp_fac(:,:) + rate(:,:,172) = 2.0e-12_r8 * exp_fac(:,:) + rate(:,:,114) = 6.9e-12_r8 * exp( -230._r8 * itemp(:,:) ) + rate(:,:,117) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:,:) ) + rate(:,:,121) = 1.0e-11_r8 * exp( -665._r8 * itemp(:,:) ) + rate(:,:,124) = 3.75e-13_r8 * exp( -40._r8 * itemp(:,:) ) + rate(:,:,132) = 8.4e-13_r8 * exp( 830._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1860._r8 * itemp(:,:) ) + rate(:,:,133) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,178) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,137) = 2.3e-12_r8 * exp( -170._r8 * itemp(:,:) ) + rate(:,:,146) = 2.54e-11_r8 * exp( 410._r8 * itemp(:,:) ) + rate(:,:,147) = 1.05e-14_r8 * exp( -2000._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 400._r8 * itemp(:,:) ) + rate(:,:,152) = 5.e-13_r8 * exp_fac(:,:) + rate(:,:,166) = 5.e-13_r8 * exp_fac(:,:) + rate(:,:,183) = 5.00e-13_r8 * exp_fac(:,:) + rate(:,:,154) = 3.03e-12_r8 * exp( -446._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 360._r8 * itemp(:,:) ) + rate(:,:,155) = 2.7e-12_r8 * exp_fac(:,:) + rate(:,:,162) = 2.7e-12_r8 * exp_fac(:,:) + rate(:,:,163) = 1.3e-13_r8 * exp_fac(:,:) + rate(:,:,169) = 5.3e-12_r8 * exp_fac(:,:) + rate(:,:,180) = 2.7e-12_r8 * exp_fac(:,:) + rate(:,:,158) = 4.13e-12_r8 * exp( 452._r8 * itemp(:,:) ) + rate(:,:,159) = 7.52e-16_r8 * exp( -1521._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 175._r8 * itemp(:,:) ) + rate(:,:,160) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,179) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,161) = 4.4e-15_r8 * exp( -2500._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 530._r8 * itemp(:,:) ) + rate(:,:,173) = 4.6e-12_r8 * exp_fac(:,:) + rate(:,:,174) = 2.3e-12_r8 * exp_fac(:,:) + rate(:,:,184) = 1.30e-12_r8 * exp( 640._r8 * itemp(:,:) ) + rate(:,:,185) = 1.90e-12_r8 * exp( 190._r8 * itemp(:,:) ) + rate(:,:,187) = 1.7e-12_r8 * exp( 352._r8 * itemp(:,:) ) + rate(:,:,193) = 1.2e-11_r8 * exp( 444._r8 * itemp(:,:) ) + rate(:,:,194) = 1.e-15_r8 * exp( -732._r8 * itemp(:,:) ) + rate(:,:,195) = 1.2e-12_r8 * exp( 490._r8 * itemp(:,:) ) + rate(:,:,205) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,207) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,208) = 1.7e-12_r8 * exp( -710._r8 * itemp(:,:) ) + rate(:,:,212) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 6.9e-31_r8 * itemp(:,:)**1._r8 + kinf(:,:) = 2.6e-11_r8 + call jpl( rate(1,1,56), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 2.e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**.7_r8 + call jpl( rate(1,1,64), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,66), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.0e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,69), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,81), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.5e-30_r8 + kinf(:,:) = 8.3e-13_r8 * itemp(:,:)**(-2._r8) + call jpl( rate(1,1,89), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 1.e-28_r8 * itemp(:,:)**.8_r8 + kinf(:,:) = 8.8e-12_r8 + call jpl( rate(1,1,90), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 8.5e-29_r8 * itemp(:,:)**6.5_r8 + kinf(:,:) = 1.1e-11_r8 * itemp(:,:) + call jpl( rate(1,1,104), m, .6_r8, ko, kinf, n ) + + ko(:,:) = 8.e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.e-11_r8 + call jpl( rate(1,1,115), m, .5_r8, ko, kinf, n ) + + ko(:,:) = 8.e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.e-11_r8 + call jpl( rate(1,1,141), m, .5_r8, ko, kinf, n ) + + ko(:,:) = 4.28e-33_r8 + kinf(:,:) = 9.30e-15_r8 * itemp(:,:)**(-4.42_r8) + call jpl( rate(1,1,211), m, 0.8_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 b/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 new file mode 100644 index 0000000000..5e4c0bfe61 --- /dev/null +++ b/src/chemistry/pp_trop_mozart/mo_sim_dat.F90 @@ -0,0 +1,299 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 8, 0, 0, 95, 0 /) + + cls_rxt_cnt(:,1) = (/ 30, 12, 0, 8 /) + cls_rxt_cnt(:,4) = (/ 2, 65, 144, 95 /) + + solsym(:103) = (/ 'O3 ','O ','O1D ','N2O ','NO ', & + 'NO2 ','NO3 ','HNO3 ','HO2NO2 ','N2O5 ', & + 'H2 ','OH ','HO2 ','H2O2 ','CH4 ', & + 'CO ','CH3O2 ','CH3OOH ','CH2O ','CH3OH ', & + 'C2H5OH ','C2H4 ','EO ','EO2 ','CH3COOH ', & + 'GLYALD ','C2H6 ','C2H5O2 ','C2H5OOH ','CH3CHO ', & + 'CH3CO3 ','CH3COOOH ','C3H6 ','C3H8 ','C3H7O2 ', & + 'C3H7OOH ','PO2 ','POOH ','CH3COCH3 ','RO2 ', & + 'ROOH ','BIGENE ','ENEO2 ','MEK ','MEKO2 ', & + 'MEKOOH ','BIGALK ','ALKO2 ','ALKOOH ','ISOP ', & + 'ISOPO2 ','ISOPOOH ','MVK ','MACR ','MACRO2 ', & + 'MACROOH ','MCO3 ','HYDRALD ','HYAC ','CH3COCHO ', & + 'XO2 ','XOOH ','C10H16 ','TERPO2 ','TERPOOH ', & + 'TOLUENE ','CRESOL ','TOLO2 ','TOLOOH ','XOH ', & + 'BIGALD ','GLYOXAL ','PAN ','ONIT ','MPAN ', & + 'ISOPNO3 ','ONITR ','CB1 ','CB2 ','OC1 ', & + 'OC2 ','SOA ','SO2 ','DMS ','SO4 ', & + 'NH3 ','NH4 ','NH4NO3 ','SSLT01 ','SSLT02 ', & + 'SSLT03 ','SSLT04 ','DST01 ','DST02 ','DST03 ', & + 'DST04 ','Rn ','Pb ','HCN ','CH3CN ', & + 'C2H2 ','HCOOH ','HOCH2OO ' /) + + adv_mass(:103) = (/ 47.998200_r8, 15.999400_r8, 15.999400_r8, 44.012880_r8, 30.006140_r8, & + 46.005540_r8, 62.004940_r8, 63.012340_r8, 79.011740_r8, 108.010480_r8, & + 2.014800_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, 16.040600_r8, & + 28.010400_r8, 47.032000_r8, 48.039400_r8, 30.025200_r8, 32.040000_r8, & + 46.065800_r8, 28.051600_r8, 61.057800_r8, 77.057200_r8, 60.050400_r8, & + 60.050400_r8, 30.066400_r8, 61.057800_r8, 62.065200_r8, 44.051000_r8, & + 75.042400_r8, 76.049800_r8, 42.077400_r8, 44.092200_r8, 75.083600_r8, & + 76.091000_r8, 91.083000_r8, 92.090400_r8, 58.076800_r8, 89.068200_r8, & + 90.075600_r8, 56.103200_r8, 105.108800_r8, 72.102600_r8, 103.094000_r8, & + 104.101400_r8, 72.143800_r8, 103.135200_r8, 104.142600_r8, 68.114200_r8, & + 117.119800_r8, 118.127200_r8, 70.087800_r8, 70.087800_r8, 119.093400_r8, & + 120.100800_r8, 101.079200_r8, 100.113000_r8, 74.076200_r8, 72.061400_r8, & + 149.118600_r8, 150.126000_r8, 136.228400_r8, 185.234000_r8, 186.241400_r8, & + 92.136200_r8, 108.135600_r8, 173.140600_r8, 174.148000_r8, 190.147400_r8, & + 98.098200_r8, 58.035600_r8, 121.047940_r8, 119.074340_r8, 147.084740_r8, & + 162.117940_r8, 147.125940_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 144.132000_r8, 64.064800_r8, 62.132400_r8, 96.063600_r8, & + 17.028940_r8, 18.036340_r8, 80.041280_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 58.442468_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 135.064039_r8, 222.000000_r8, 207.200000_r8, 27.025140_r8, 41.050940_r8, & + 26.036800_r8, 46.024600_r8, 63.031400_r8 /) + + crb_mass(:103) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, 36.033000_r8, & + 60.055000_r8, 60.055000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 84.077000_r8, 84.077000_r8, 84.077000_r8, 84.077000_r8, 84.077000_r8, & + 60.055000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 48.044000_r8, & + 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 144.132000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 12.011000_r8 /) + + fix_mass(: 4) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 18.0142000_r8 /) + + clsmap(: 8,1) = (/ 15, 4, 16, 97, 98, 11, 99, 100 /) + clsmap(: 95,4) = (/ 1, 3, 2, 5, 6, 7, 8, 9, 10, 12, & + 13, 14, 17, 18, 19, 20, 21, 22, 23, 24, & + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, & + 35, 36, 37, 38, 39, 40, 41, 42, 43, 47, & + 48, 49, 44, 45, 46, 50, 51, 52, 53, 54, & + 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, & + 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, & + 75, 76, 77, 83, 84, 85, 86, 87, 88, 82, & + 78, 79, 80, 81, 101, 102, 103, 89, 90, 91, & + 92, 93, 94, 95, 96 /) + + permute(: 95,4) = (/ 91, 30, 59, 88, 93, 94, 58, 41, 31, 89, & + 90, 26, 92, 43, 82, 62, 33, 38, 27, 45, & + 50, 63, 18, 71, 42, 76, 95, 49, 75, 19, & + 72, 40, 67, 52, 68, 78, 34, 20, 35, 21, & + 70, 65, 51, 66, 36, 74, 86, 61, 84, 80, & + 85, 37, 87, 44, 79, 81, 83, 28, 64, 77, & + 53, 23, 24, 55, 46, 29, 56, 54, 57, 47, & + 60, 69, 73, 22, 32, 1, 17, 2, 3, 4, & + 5, 6, 7, 8, 25, 39, 48, 9, 10, 11, & + 12, 13, 14, 15, 16 /) + + diag_map(: 95) = (/ 1, 2, 3, 4, 5, 7, 8, 10, 11, 12, & + 13, 14, 15, 16, 17, 18, 19, 21, 24, 27, & + 30, 34, 36, 41, 44, 49, 52, 56, 59, 63, & + 70, 75, 80, 84, 89, 96, 101, 106, 113, 116, & + 121, 126, 131, 136, 140, 146, 152, 157, 163, 168, & + 171, 176, 183, 190, 195, 203, 208, 215, 219, 225, & + 233, 241, 246, 250, 260, 271, 279, 287, 292, 306, & + 321, 331, 342, 352, 370, 383, 392, 404, 414, 420, & + 430, 438, 451, 464, 482, 501, 517, 558, 634, 685, & + 716, 746, 767, 801, 824 /) + + extfrc_lst(: 4) = (/ 'NO ','CO ','SO2 ','SO4 ' /) + + frc_from_dataset(: 4) = (/ .true., .true., .true., .true. /) + + inv_lst(: 4) = (/ 'M ', 'N2 ', 'O2 ', 'H2O ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 95) = (/ 'jo2 ', 'jo1d ', & + 'jo3p ', 'jn2o ', & + 'jno2 ', 'jn2o5 ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o2 ', 'jch3cho ', & + 'jpooh ', 'jch3co3h ', & + 'jpan ', 'jmpan ', & + 'jmacr_a ', 'jmacr_b ', & + 'jmvk ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jrooh ', & + 'jacet ', 'jmgly ', & + 'jxooh ', 'jonitr ', & + 'jisopooh ', 'jhyac ', & + 'jglyald ', 'jmek ', & + 'jbigald ', 'jglyoxal ', & + 'jalkooh ', 'jmekooh ', & + 'jtolooh ', 'jterpooh ', & + 'usr_O_O2 ', 'o1d_n2 ', & + 'o1d_o2 ', 'ox_l1 ', & + 'ox_l2 ', 'ox_l3 ', & + 'usr_HO2_HO2 ', 'ox_p1 ', & + 'tag_NO2_NO3 ', 'usr_N2O5_M ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'tag_NO2_HO2 ', 'usr_HO2NO2_M ', & + 'ox_p2 ', 'usr_CO_OH_b ', & + 'tag_C2H4_OH ', 'ox_l6 ', & + 'ox_p16 ', 'ox_p5 ', & + 'ox_p4 ', 'tag_CH3CO3_NO2 ', & + 'usr_PAN_M ', 'tag_C3H6_OH ', & + 'ox_l4 ', 'ox_p3 ', & + 'ox_p9 ', 'usr_CH3COCH3_OH ', & + 'ox_p10 ', 'ox_p15 ', & + 'ox_p17 ', 'soa5 ', & + 'ox_p14 ', 'ox_l5 ', & + 'ox_p6 ', 'ox_l7 ', & + 'ox_l8 ', 'ox_p7 ', & + 'ox_p8 ', 'usr_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ox_p11 ', & + 'usr_XOOH_OH ', 'soa4 ', & + 'ox_p12 ', 'soa2 ', & + 'soa1 ', 'soa3 ', & + 'ox_p13 ', 'usr_N2O5_aer ', & + 'usr_NO3_aer ', 'usr_NO2_aer ', & + 'usr_SO2_OH ', 'usr_DMS_OH ', & + 'usr_HO2_aer ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 43, 44, 45, 50, 51, 52, 59, 64, 65, & + 66, 67, 69, 71, 74, 82, 90, 91, 92, 96, & + 103, 104, 109, 115, 116, 118, 122, 126, 127, 136, & + 138, 142, 143, 147, 148, 159, 161, 162, 169, 175, & + 176, 180, 186, 187, 190, 193, 194, 195, 196, 200, & + 201, 202, 204, 206, 210 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ 'jo2_b ', 'jo3_a ', 'jo3_b ', ' ', & + ' ', 'jn2o5_a ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + 'jch3ooh ', 'jh2o2 ', ' ', 'jpan ', & + ' ', ' ', ' ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + 'jch3ooh ', 'jch3cho ', 'jch3ooh ', ' ', & + ' ', 'jacet ', 'jno2 ', 'jmgly ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, .28_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .2_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 3, 2, 2, 3, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 1, 2, 2, 3, 3, & + 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, & + 1, 1, 1, 2, 2, 2, 2, 2, 1, 1, & + 3, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc new file mode 100644 index 0000000000..0232844e60 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc @@ -0,0 +1,1761 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BENZENE (C6H6) + ( 8) BENZOOH (C6H8O5) + ( 9) BEPOMUC (C6H6O3) + ( 10) BIGALD (C5H6O2) + ( 11) BIGALD1 (C4H4O2) + ( 12) BIGALD2 (C5H6O2) + ( 13) BIGALD3 (C5H6O2) + ( 14) BIGALD4 (C6H8O2) + ( 15) BIGALK (C5H12) + ( 16) BIGENE (C4H8) + ( 17) BR (Br) + ( 18) BRCL (BrCl) + ( 19) BRO (BrO) + ( 20) BRONO2 (BrONO2) + ( 21) BRY + ( 22) BZALD (C7H6O) + ( 23) BZOOH (C7H8O2) + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH (C6H5OOH) + ( 33) CCL4 (CCl4) + ( 34) CF2CLBR (CF2ClBr) + ( 35) CF3BR (CF3Br) + ( 36) CFC11 (CFCl3) + ( 37) CFC113 (CCl2FCClF2) + ( 38) CFC114 (CClF2CClF2) + ( 39) CFC115 (CClF2CF3) + ( 40) CFC12 (CF2Cl2) + ( 41) CH2BR2 (CH2Br2) + ( 42) CH2O + ( 43) CH3BR (CH3Br) + ( 44) CH3CCL3 (CH3CCl3) + ( 45) CH3CHO + ( 46) CH3CL (CH3Cl) + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 (CHBr3) + ( 56) CL (Cl) + ( 57) CL2 (Cl2) + ( 58) CL2O2 (Cl2O2) + ( 59) CLO (ClO) + ( 60) CLONO2 (ClONO2) + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL (COFCl) + ( 66) CRESOL (C7H8O) + ( 67) DMS (CH3SCH3) + ( 68) dst_a1 (AlSiO5) + ( 69) dst_a2 (AlSiO5) + ( 70) dst_a3 (AlSiO5) + ( 71) E90 (CO) + ( 72) EOOH (HOCH2CH2OOH) + ( 73) F + ( 74) GLYALD (HOCH2CHO) + ( 75) GLYOXAL (C2H2O2) + ( 76) H + ( 77) H2 + ( 78) H2402 (CBrF2CBrF2) + ( 79) H2O2 + ( 80) H2SO4 (H2SO4) + ( 81) HBR (HBr) + ( 82) HCFC141B (CH3CCl2F) + ( 83) HCFC142B (CH3CClF2) + ( 84) HCFC22 (CHF2Cl) + ( 85) HCL (HCl) + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2NO2 + ( 91) HOBR (HOBr) + ( 92) HOCL (HOCl) + ( 93) HONITR (C4H9NO4) + ( 94) HPALD (HOOCH2CCH3CHCHO) + ( 95) HYAC (CH3COCH2OH) + ( 96) HYDRALD (HOCH2CCH3CHCHO) + ( 97) IEPOX (C5H10O3) + ( 98) ISOP (C5H8) + ( 99) ISOPNITA (C5H9NO4) + (100) ISOPNITB (C5H9NO4) + (101) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (102) ISOPNOOH (C5H9NO5) + (103) ISOPOOH (HOCH2COOHCH3CHCH2) + (104) IVOC (C13H28) + (105) MACR (CH2CCH3CHO) + (106) MACROOH (CH3COCHOOHCH2OH) + (107) MEK (C4H8O) + (108) MEKOOH (C4H8O3) + (109) MPAN (CH2CCH3CO3NO2) + (110) MTERP (C10H16) + (111) MVK (CH2CHCOCH3) + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH (C5H9NO4) + (116) NC4CHO (C5H7NO4) + (117) ncl_a1 (NaCl) + (118) ncl_a2 (NaCl) + (119) ncl_a3 (NaCl) + (120) NH3 + (121) NH4 + (122) NH_5 (CO) + (123) NH_50 (CO) + (124) NO + (125) NO2 + (126) NO3 + (127) NOA (CH3COCH2ONO2) + (128) NTERPOOH (C10H17NO5) + (129) num_a1 (H) + (130) num_a2 (H) + (131) num_a3 (H) + (132) num_a4 (H) + (133) O + (134) O3 + (135) OCLO (OClO) + (136) OCS (OCS) + (137) ONITR (C4H7NO4) + (138) PAN (CH3CO3NO2) + (139) PBZNIT (C7H5O3NO2) + (140) PHENO (C6H5O) + (141) PHENOL (C6H5OH) + (142) PHENOOH (C6H8O6) + (143) pom_a1 (C) + (144) pom_a4 (C) + (145) POOH (C3H6OHOOH) + (146) ROOH (CH3COCH2OOH) + (147) S (S) + (148) SF6 + (149) SO (SO) + (150) SO2 + (151) SO3 (SO3) + (152) so4_a1 (NH4HSO4) + (153) so4_a2 (NH4HSO4) + (154) so4_a3 (NH4HSO4) + (155) soa1_a1 (C15H38O2) + (156) soa1_a2 (C15H38O2) + (157) soa2_a1 (C15H38O2) + (158) soa2_a2 (C15H38O2) + (159) soa3_a1 (C15H38O2) + (160) soa3_a2 (C15H38O2) + (161) soa4_a1 (C15H38O2) + (162) soa4_a2 (C15H38O2) + (163) soa5_a1 (C15H38O2) + (164) soa5_a2 (C15H38O2) + (165) SOAG0 (C15H38O2) + (166) SOAG1 (C15H38O2) + (167) SOAG2 (C15H38O2) + (168) SOAG3 (C15H38O2) + (169) SOAG4 (C15H38O2) + (170) ST80_25 (CO) + (171) SVOC (C22H46) + (172) TEPOMUC (C7H8O3) + (173) TERP2OOH (C10H18O3) + (174) TERPNIT (C10H17NO4) + (175) TERPOOH (C10H18O3) + (176) TERPROD1 (C10H16O2) + (177) TERPROD2 (C9H14O2) + (178) TOLOOH (C7H10O5) + (179) TOLUENE (C7H8) + (180) XOOH (HOCH2COOHCH3CHOHCHO) + (181) XYLENES (C8H10) + (182) XYLENOOH (C8H12O5) + (183) XYLOL (C8H10O) + (184) XYLOLOOH (C8H12O6) + (185) NHDEP (N) + (186) NDEP (N) + (187) ACBZO2 (C7H5O3) + (188) ALKO2 (C5H11O2) + (189) BENZO2 (C6H7O5) + (190) BZOO (C7H7O2) + (191) C2H5O2 + (192) C3H7O2 + (193) C6H5O2 + (194) CH3CO3 + (195) CH3O2 + (196) DICARBO2 (C5H5O4) + (197) ENEO2 (C4H9O3) + (198) EO (HOCH2CH2O) + (199) EO2 (HOCH2CH2O2) + (200) HO2 + (201) HOCH2OO + (202) ISOPAO2 (HOC5H8O2) + (203) ISOPBO2 (HOC5H8O2) + (204) MACRO2 (CH3COCHO2CH2OH) + (205) MALO2 (C4H3O4) + (206) MCO3 (CH2CCH3CO3) + (207) MDIALO2 (C4H5O4) + (208) MEKO2 (C4H7O3) + (209) NTERPO2 (C10H16NO5) + (210) O1D (O) + (211) OH + (212) PHENO2 (C6H7O6) + (213) PO2 (C3H6OHO2) + (214) RO2 (CH3COCH2O2) + (215) TERP2O2 (C10H15O4) + (216) TERPO2 (C10H17O3) + (217) TOLO2 (C7H9O5) + (218) XO2 (HOCH2COOCH3CHOHCHO) + (219) XYLENO2 (C8H11O5) + (220) XYLOLO2 (C8H11O6) + (221) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) AOA_NH + ( 2) BRY + ( 3) CCL4 + ( 4) CF2CLBR + ( 5) CF3BR + ( 6) CFC11 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) CFC12 + ( 11) CH2BR2 + ( 12) CH3BR + ( 13) CH3CCL3 + ( 14) CH3CL + ( 15) CH4 + ( 16) CHBR3 + ( 17) CLY + ( 18) CO2 + ( 19) E90 + ( 20) H2402 + ( 21) HCFC141B + ( 22) HCFC142B + ( 23) HCFC22 + ( 24) N2O + ( 25) NH_5 + ( 26) NH_50 + ( 27) SF6 + ( 28) ST80_25 + ( 29) NHDEP + ( 30) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) bc_a1 + ( 4) bc_a4 + ( 5) BCARY + ( 6) BENZENE + ( 7) BENZOOH + ( 8) BEPOMUC + ( 9) BIGALD + ( 10) BIGALD1 + ( 11) BIGALD2 + ( 12) BIGALD3 + ( 13) BIGALD4 + ( 14) BIGALK + ( 15) BIGENE + ( 16) BR + ( 17) BRCL + ( 18) BRO + ( 19) BRONO2 + ( 20) BZALD + ( 21) BZOOH + ( 22) C2H2 + ( 23) C2H4 + ( 24) C2H5OH + ( 25) C2H5OOH + ( 26) C2H6 + ( 27) C3H6 + ( 28) C3H7OOH + ( 29) C3H8 + ( 30) C6H5OOH + ( 31) CH2O + ( 32) CH3CHO + ( 33) CH3CN + ( 34) CH3COCH3 + ( 35) CH3COCHO + ( 36) CH3COOH + ( 37) CH3COOOH + ( 38) CH3OH + ( 39) CH3OOH + ( 40) CL + ( 41) CL2 + ( 42) CL2O2 + ( 43) CLO + ( 44) CLONO2 + ( 45) CO + ( 46) COF2 + ( 47) COFCL + ( 48) CRESOL + ( 49) DMS + ( 50) dst_a1 + ( 51) dst_a2 + ( 52) dst_a3 + ( 53) EOOH + ( 54) F + ( 55) GLYALD + ( 56) GLYOXAL + ( 57) H + ( 58) H2 + ( 59) H2O2 + ( 60) H2SO4 + ( 61) HBR + ( 62) HCL + ( 63) HCN + ( 64) HCOOH + ( 65) HF + ( 66) HNO3 + ( 67) HO2NO2 + ( 68) HOBR + ( 69) HOCL + ( 70) HONITR + ( 71) HPALD + ( 72) HYAC + ( 73) HYDRALD + ( 74) IEPOX + ( 75) ISOP + ( 76) ISOPNITA + ( 77) ISOPNITB + ( 78) ISOPNO3 + ( 79) ISOPNOOH + ( 80) ISOPOOH + ( 81) IVOC + ( 82) MACR + ( 83) MACROOH + ( 84) MEK + ( 85) MEKOOH + ( 86) MPAN + ( 87) MTERP + ( 88) MVK + ( 89) N + ( 90) N2O5 + ( 91) NC4CH2OH + ( 92) NC4CHO + ( 93) ncl_a1 + ( 94) ncl_a2 + ( 95) ncl_a3 + ( 96) NH3 + ( 97) NH4 + ( 98) NO + ( 99) NO2 + (100) NO3 + (101) NOA + (102) NTERPOOH + (103) num_a1 + (104) num_a2 + (105) num_a3 + (106) num_a4 + (107) O + (108) O3 + (109) OCLO + (110) OCS + (111) ONITR + (112) PAN + (113) PBZNIT + (114) PHENO + (115) PHENOL + (116) PHENOOH + (117) pom_a1 + (118) pom_a4 + (119) POOH + (120) ROOH + (121) S + (122) SO + (123) SO2 + (124) SO3 + (125) so4_a1 + (126) so4_a2 + (127) so4_a3 + (128) soa1_a1 + (129) soa1_a2 + (130) soa2_a1 + (131) soa2_a2 + (132) soa3_a1 + (133) soa3_a2 + (134) soa4_a1 + (135) soa4_a2 + (136) soa5_a1 + (137) soa5_a2 + (138) SOAG0 + (139) SOAG1 + (140) SOAG2 + (141) SOAG3 + (142) SOAG4 + (143) SVOC + (144) TEPOMUC + (145) TERP2OOH + (146) TERPNIT + (147) TERPOOH + (148) TERPROD1 + (149) TERPROD2 + (150) TOLOOH + (151) TOLUENE + (152) XOOH + (153) XYLENES + (154) XYLENOOH + (155) XYLOL + (156) XYLOLOOH + (157) ACBZO2 + (158) ALKO2 + (159) BENZO2 + (160) BZOO + (161) C2H5O2 + (162) C3H7O2 + (163) C6H5O2 + (164) CH3CO3 + (165) CH3O2 + (166) DICARBO2 + (167) ENEO2 + (168) EO + (169) EO2 + (170) HO2 + (171) HOCH2OO + (172) ISOPAO2 + (173) ISOPBO2 + (174) MACRO2 + (175) MALO2 + (176) MCO3 + (177) MDIALO2 + (178) MEKO2 + (179) NTERPO2 + (180) O1D + (181) OH + (182) PHENO2 + (183) PO2 + (184) RO2 + (185) TERP2O2 + (186) TERPO2 + (187) TOLO2 + (188) XO2 + (189) XYLENO2 + (190) XYLOLO2 + (191) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_a ( 2) H2O + hv -> OH + H rate = ** User defined ** ( 2) + jh2o_c ( 3) H2O + hv -> 2*H + O rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_a ( 5) O2 + hv -> O + O1D rate = ** User defined ** ( 5) + jo2_b ( 6) O2 + hv -> 2*O rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2 rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno2 ( 16) NO2 + hv -> NO + O rate = ** User defined ** ( 16) + jno3_b ( 17) NO3 + hv -> NO + O2 rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jalknit ( 19) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 19) + + 0.8*MEK + jalkooh ( 20) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + OH + jbenzooh ( 21) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 21) + jbepomuc ( 22) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 22) + jbigald ( 23) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 23) + + 0.18*CH3COCHO + jbigald1 ( 24) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 24) + jbigald2 ( 25) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 25) + jbigald3 ( 26) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 26) + jbigald4 ( 27) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 27) + jbzooh ( 28) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 28) + jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) + jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) + jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) + jch2o_a ( 32) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 32) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) + jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) + jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) + jch3co3h ( 37) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 37) + jch3ooh ( 38) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 38) + jch4_a ( 39) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 39) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 41) CO2 + hv -> CO + O rate = ** User defined ** ( 41) + jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) + jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) + jglyoxal ( 44) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 44) + jhonitr ( 45) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 45) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) + jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) + jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) + jisopooh ( 49) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 49) + jmacr_a ( 50) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 50) + jmacr_b ( 51) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 51) + jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) + jmekooh ( 53) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 53) + jmpan ( 54) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 54) + jmvk ( 55) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 55) + jnc4cho ( 56) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 56) + jnoa ( 57) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 57) + jnterpooh ( 58) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 58) + jonitr ( 59) ONITR + hv -> NO2 rate = ** User defined ** ( 59) + jpan ( 60) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 60) + jphenooh ( 61) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jrooh ( 63) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 63) + jtepomuc ( 64) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 64) + jterp2ooh ( 65) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 65) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 66) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 66) + jterpooh ( 67) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 67) + jterprd1 ( 68) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 68) + jterprd2 ( 69) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 69) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 70) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 70) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 71) XOOH + hv -> OH rate = ** User defined ** ( 71) + jxylenooh ( 72) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 72) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 73) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 73) + jbrcl ( 74) BRCL + hv -> BR + CL rate = ** User defined ** ( 74) + jbro ( 75) BRO + hv -> BR + O rate = ** User defined ** ( 75) + jbrono2_b ( 76) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 76) + jbrono2_a ( 77) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 77) + jccl4 ( 78) CCL4 + hv -> 4*CL rate = ** User defined ** ( 78) + jcf2clbr ( 79) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 79) + jcf3br ( 80) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 80) + jcfcl3 ( 81) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 81) + jcfc113 ( 82) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 82) + jcfc114 ( 83) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 83) + jcfc115 ( 84) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 84) + jcf2cl2 ( 85) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 85) + jch2br2 ( 86) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 86) + jch3br ( 87) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 87) + jch3ccl3 ( 88) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 88) + jch3cl ( 89) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 89) + jchbr3 ( 90) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 90) + jcl2 ( 91) CL2 + hv -> 2*CL rate = ** User defined ** ( 91) + jcl2o2 ( 92) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 92) + jclo ( 93) CLO + hv -> CL + O rate = ** User defined ** ( 93) + jclono2_a ( 94) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 94) + jclono2_b ( 95) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 95) + jcof2 ( 96) COF2 + hv -> 2*F rate = ** User defined ** ( 96) + jcofcl ( 97) COFCL + hv -> F + CL rate = ** User defined ** ( 97) + jh2402 ( 98) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 98) + jhbr ( 99) HBR + hv -> BR + H rate = ** User defined ** ( 99) + jhcfc141b (100) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (100) + jhcfc142b (101) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (101) + jhcfc22 (102) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (102) + jhcl (103) HCL + hv -> H + CL rate = ** User defined ** (103) + jhf (104) HF + hv -> H + F rate = ** User defined ** (104) + jhobr (105) HOBR + hv -> BR + OH rate = ** User defined ** (105) + jhocl (106) HOCL + hv -> OH + CL rate = ** User defined ** (106) + joclo (107) OCLO + hv -> O + CLO rate = ** User defined ** (107) + jsf6 (108) SF6 + hv -> {sink} rate = ** User defined ** (108) + jh2so4 (109) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (109) + jocs (110) OCS + hv -> S + CO rate = ** User defined ** (110) + jso (111) SO + hv -> S + O rate = ** User defined ** (111) + jso2 (112) SO2 + hv -> SO + O rate = ** User defined ** (112) + jso3 (113) SO3 + hv -> SO2 + O rate = ** User defined ** (113) + jsoa1_a1 (114) soa1_a1 + hv -> (No products) rate = ** User defined ** (114) + jsoa1_a2 (115) soa1_a2 + hv -> (No products) rate = ** User defined ** (115) + jsoa2_a1 (116) soa2_a1 + hv -> (No products) rate = ** User defined ** (116) + jsoa2_a2 (117) soa2_a2 + hv -> (No products) rate = ** User defined ** (117) + jsoa3_a1 (118) soa3_a1 + hv -> (No products) rate = ** User defined ** (118) + jsoa3_a2 (119) soa3_a2 + hv -> (No products) rate = ** User defined ** (119) + jsoa4_a1 (120) soa4_a1 + hv -> (No products) rate = ** User defined ** (120) + jsoa4_a2 (121) soa4_a2 + hv -> (No products) rate = ** User defined ** (121) + jsoa5_a1 (122) soa5_a1 + hv -> (No products) rate = ** User defined ** (122) + jsoa5_a2 (123) soa5_a2 + hv -> (No products) rate = ** User defined ** (123) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 (124) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (125) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (126) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (127) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 (128) + O_O3 ( 6) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (129) + usr_O_O ( 7) O + O + M -> O2 + M rate = ** User defined ** (130) + usr_O_O2 ( 8) O + O2 + M -> O3 + M rate = ** User defined ** (131) + H2_O ( 9) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (132) + H2O2_O ( 10) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (133) + H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (134) + H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (135) + H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (136) + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (137) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (138) + HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (139) + H_O3 ( 17) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (140) + OH_H2 ( 18) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (141) + OH_H2O2 ( 19) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (142) + OH_HO2 ( 20) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (143) + OH_O ( 21) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (144) + OH_O3 ( 22) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (145) + OH_OH ( 23) OH + OH -> H2O + O rate = 1.80E-12 (146) + OH_OH_M ( 24) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (147) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (148) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (149) + N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (150) + N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (151) + N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (152) + N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (153) + N_O2 ( 31) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (154) + NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (155) + NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (156) + NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (157) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (158) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (159) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.00E-11 (160) + NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (161) + N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (162) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (163) + NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (164) + NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (165) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 43) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (166) + O1D_N2Ob ( 44) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (167) + tag_NO2_HO2 ( 45) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (168) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (169) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 47) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (170) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 48) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (171) + usr_HO2NO2_M ( 49) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (172) + usr_N2O5_M ( 50) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (173) + CL_CH2O ( 51) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (174) + CL_CH4 ( 52) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (175) + CL_H2 ( 53) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (176) + CL_H2O2 ( 54) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (177) + CL_HO2a ( 55) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (178) + CL_HO2b ( 56) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (179) + CL_O3 ( 57) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (180) + CLO_CH3O2 ( 58) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (181) + CLO_CLOa ( 59) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (182) + CLO_CLOb ( 60) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (183) + CLO_CLOc ( 61) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (184) + CLO_HO2 ( 62) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (185) + CLO_NO ( 63) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (186) + CLONO2_CL ( 64) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (187) + CLO_NO2_M ( 65) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (188) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 66) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (189) + CLONO2_OH ( 67) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (190) + CLO_O ( 68) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (191) + CLO_OHa ( 69) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (192) + CLO_OHb ( 70) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (193) + HCL_O ( 71) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (194) + HCL_OH ( 72) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (195) + HOCL_CL ( 73) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (196) + HOCL_O ( 74) HOCL + O -> CLO + OH rate = 1.70E-13 (197) + HOCL_OH ( 75) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (198) + O1D_CCL4 ( 76) O1D + CCL4 -> 4*CL rate = 2.61E-10 (199) + O1D_CF2CLBR ( 77) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (200) + O1D_CFC11 ( 78) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (201) + O1D_CFC113 ( 79) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (202) + O1D_CFC114 ( 80) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (203) + O1D_CFC115 ( 81) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (204) + O1D_CFC12 ( 82) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (205) + O1D_HCLa ( 83) O1D + HCL -> CL + OH rate = 9.90E-11 (206) + O1D_HCLb ( 84) O1D + HCL -> CLO + H rate = 3.30E-12 (207) + tag_CLO_CLO_M ( 85) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (208) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 86) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (209) + BR_CH2O ( 87) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (210) + BR_HO2 ( 88) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (211) + BR_O3 ( 89) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (212) + BRO_BRO ( 90) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (213) + BRO_CLOa ( 91) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (214) + BRO_CLOb ( 92) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (215) + BRO_CLOc ( 93) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (216) + BRO_HO2 ( 94) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (217) + BRO_NO ( 95) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (218) + BRO_NO2_M ( 96) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (219) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 97) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (220) + BRO_O ( 98) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (221) + BRO_OH ( 99) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (222) + HBR_O (100) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (223) + HBR_OH (101) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (224) + HOBR_O (102) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (225) + O1D_CF3BR (103) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (226) + O1D_CHBR3 (104) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (227) + O1D_H2402 (105) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (228) + O1D_HBRa (106) O1D + HBR -> BR + OH rate = 9.00E-11 (229) + O1D_HBRb (107) O1D + HBR -> BRO + H rate = 3.00E-11 (230) + F_CH4 (108) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (231) + F_H2 (109) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (232) + F_H2O (110) F + H2O -> HF + OH rate = 1.40E-11 (233) + F_HNO3 (111) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (234) + O1D_COF2 (112) O1D + COF2 -> 2*F rate = 2.14E-11 (235) + O1D_COFCL (113) O1D + COFCL -> F + CL rate = 1.90E-10 (236) + CH2BR2_CL (114) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (237) + CH2BR2_OH (115) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (238) + CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (239) + CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (240) + CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (241) + CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (242) + CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (243) + CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (244) + CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (245) + HCFC141B_OH (123) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (246) + HCFC142B_OH (124) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (247) + HCFC22_OH (125) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (248) + O1D_CH2BR2 (126) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (249) + O1D_CH3BR (127) O1D + CH3BR -> BR rate = 1.80E-10 (250) + O1D_HCFC141B (128) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (251) + O1D_HCFC142B (129) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (252) + O1D_HCFC22 (130) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (253) + CH2O_HO2 (131) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (254) + CH2O_NO3 (132) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (255) + CH2O_O (133) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (256) + CH2O_OH (134) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (257) + CH3O2_CH3O2a (135) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (258) + CH3O2_CH3O2b (136) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (259) + CH3O2_HO2 (137) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (260) + CH3O2_NO (138) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (261) + CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (262) + CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (263) + CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (264) + CO_OH_M (142) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (265) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (266) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (267) + HOCH2OO_HO2 (145) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (268) + HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (269) + HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (270) + O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (271) + O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (272) + O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (273) + O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (274) + usr_CO_OH_b (152) CO + OH -> CO2 + H rate = ** User defined ** (275) + C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (276) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (277) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (278) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (279) + C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (280) + C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (281) + + 0.2*C2H5OH + C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (282) + C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (283) + C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (284) + C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (285) + C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (286) + C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (287) + CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (288) + CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (289) + CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (290) + CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (291) + CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (292) + + 0.1*CH3COOH + CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (293) + + 0.45*CH3O2 + CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (294) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (295) + CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (296) + EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (297) + EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (298) + EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (299) + EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (300) + GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (301) + GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (302) + PAN_OH (180) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (303) + tag_C2H4_OH (181) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (304) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (305) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_PAN_M (183) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (306) + C3H6_NO3 (184) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (307) + C3H6_O3 (185) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (308) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (186) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (309) + C3H7O2_HO2 (187) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (310) + C3H7O2_NO (188) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (311) + C3H7OOH_OH (189) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (312) + C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (313) + CH3COCHO_NO3 (191) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (314) + CH3COCHO_OH (192) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (315) + HYAC_OH (193) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (316) + NOA_OH (194) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (317) + PO2_HO2 (195) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (318) + PO2_NO (196) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (319) + POOH_OH (197) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (320) + RO2_CH3O2 (198) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (321) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (199) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (322) + RO2_NO (200) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (323) + ROOH_OH (201) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (324) + tag_C3H6_OH (202) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (325) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (203) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (326) + BIGENE_NO3 (204) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (327) + BIGENE_OH (205) BIGENE + OH -> ENEO2 rate = 5.40E-11 (328) + ENEO2_NO (206) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (329) + ENEO2_NOb (207) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (330) + HONITR_OH (208) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (331) + MACRO2_CH3CO3 (209) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (332) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (210) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (333) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (211) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (334) + MACRO2_NO3 (212) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (335) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (213) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (336) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (214) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (337) + MACR_O3 (215) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (338) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (216) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (339) + MACROOH_OH (217) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (340) + MCO3_CH3CO3 (218) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (341) + MCO3_CH3O2 (219) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (342) + MCO3_HO2 (220) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (343) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (221) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (344) + MCO3_NO (222) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (345) + MCO3_NO3 (223) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (346) + MEKO2_HO2 (224) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (347) + MEKO2_NO (225) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (348) + MEK_OH (226) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (349) + MEKOOH_OH (227) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (350) + MPAN_OH_M (228) MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 troe : ko=8.00E-27*(300/t)**3.50 (351) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (229) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (352) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (230) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (353) + usr_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (354) + usr_MPAN_M (232) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (355) + ALKNIT_OH (233) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (356) + ALKO2_HO2 (234) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (357) + ALKO2_NO (235) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (358) + + NO2 + ALKO2_NOb (236) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (359) + ALKOOH_OH (237) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (360) + BIGALK_OH (238) BIGALK + OH -> ALKO2 rate = 3.50E-12 (361) + HPALD_OH (239) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (362) + HYDRALD_OH (240) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (363) + IEPOX_OH (241) IEPOX + OH -> XO2 rate = 1.30E-11 (364) + ISOPAO2_CH3CO3 (242) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (365) + ISOPAO2_CH3O2 (243) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (366) + + 0.44*MVK + ISOPAO2_HO2 (244) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (367) + ISOPAO2_NO (245) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (368) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (246) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (369) + ISOPBO2_CH3CO3 (247) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (370) + ISOPBO2_CH3O2 (248) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (371) + ISOPBO2_HO2 (249) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (372) + ISOPBO2_M (250) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (373) + ISOPBO2_NO (251) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (374) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (252) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (375) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (253) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (376) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (254) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (377) + ISOP_NO3 (255) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (378) + ISOPNO3_CH3CO3 (256) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (379) + ISOPNO3_CH3O2 (257) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (380) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (258) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (381) + ISOPNO3_NO (259) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (382) + ISOPNO3_NO3 (260) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (383) + ISOPNOOH_OH (261) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (384) + ISOP_O3 (262) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (385) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (263) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (386) + ISOPOOH_OH (264) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (387) + NC4CH2OH_OH (265) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (388) + NC4CHO_OH (266) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (389) + XO2_CH3CO3 (267) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (390) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (268) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (391) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (269) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (392) + XO2_NO (270) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (393) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (271) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (394) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (272) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (395) + ACBZO2_HO2 (273) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (396) + ACBZO2_NO (274) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (397) + BENZENE_OH (275) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (398) + BENZO2_HO2 (276) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (399) + BENZO2_NO (277) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (400) + BENZOOH_OH (278) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (401) + BZALD_OH (279) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (402) + BZOO_HO2 (280) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (403) + BZOOH_OH (281) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (404) + BZOO_NO (282) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (405) + C6H5O2_HO2 (283) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (406) + C6H5O2_NO (284) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (407) + C6H5OOH_OH (285) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (408) + CRESOL_OH (286) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (409) + DICARBO2_HO2 (287) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (410) + + 0.33*CH3O2 + DICARBO2_NO (288) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (411) + + 0.83*CH3O2 + DICARBO2_NO2 (289) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (412) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (290) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (413) + MALO2_NO (291) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (414) + MALO2_NO2 (292) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (415) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (293) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (416) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (294) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (417) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (295) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (418) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (296) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (419) + PHENO2_NO (297) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (420) + PHENOL_OH (298) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (421) + PHENO_NO2 (299) PHENO + NO2 -> NDEP rate = 2.10E-12 (422) + PHENO_O3 (300) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (423) + PHENOOH_OH (301) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (424) + tag_ACBZO2_NO2 (302) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (425) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (303) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (426) + TOLO2_NO (304) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (427) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (305) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (428) + TOLUENE_OH (306) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (429) + + 0.28*HO2 + usr_PBZNIT_M (307) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (430) + XYLENES_OH (308) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (431) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (309) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (432) + XYLENO2_NO (310) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (433) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (311) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (434) + XYLOLO2_HO2 (312) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (435) + XYLOLO2_NO (313) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (436) + XYLOL_OH (314) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (437) + XYLOLOOH_OH (315) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (438) + BCARY_NO3 (316) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (439) + BCARY_O3 (317) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (440) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (318) BCARY + OH -> TERPO2 rate = 2.00E-10 (441) + MTERP_NO3 (319) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (442) + MTERP_O3 (320) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (443) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (321) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (444) + NTERPO2_CH3O2 (322) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (445) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (323) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (446) + NTERPO2_NO (324) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (447) + NTERPO2_NO3 (325) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (448) + NTERPOOH_OH (326) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (449) + TERP2O2_CH3O2 (327) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (450) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (328) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (451) + TERP2O2_NO (329) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (452) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (330) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (453) + TERPNIT_OH (331) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (454) + TERPO2_CH3O2 (332) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (455) + + 0.025*CH3COCH3 + TERPO2_HO2 (333) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (456) + TERPO2_NO (334) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (457) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (335) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (458) + TERPROD1_NO3 (336) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (459) + TERPROD1_OH (337) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (460) + TERPROD2_OH (338) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (461) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + OCS_O (339) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (462) + OCS_OH (340) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (463) + S_O2 (341) S + O2 -> SO + O rate = 2.30E-12 (464) + S_O3 (342) S + O3 -> SO + O2 rate = 1.20E-11 (465) + SO_BRO (343) SO + BRO -> SO2 + BR rate = 5.70E-11 (466) + SO_CLO (344) SO + CLO -> SO2 + CL rate = 2.80E-11 (467) + S_OH (345) S + OH -> SO + H rate = 6.60E-11 (468) + SO_NO2 (346) SO + NO2 -> SO2 + NO rate = 1.40E-11 (469) + SO_O2 (347) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (470) + SO_O3 (348) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (471) + SO_OCLO (349) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (472) + SO_OH (350) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (473) + usr_SO2_OH (351) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (474) + usr_SO3_H2O (352) SO3 + H2O -> H2SO4 rate = ** User defined ** (475) + DMS_NO3 (353) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (476) + DMS_OHa (354) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (477) + NH3_OH (355) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (478) + usr_DMS_OH (356) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (479) + usr_GLYOXAL_aer (357) GLYOXAL -> SOAG0 rate = ** User defined ** (480) + usr_HO2_aer (358) HO2 -> 0.5*H2O2 rate = ** User defined ** (481) + usr_HONITR_aer (359) HONITR -> HNO3 rate = ** User defined ** (482) + usr_ISOPNITA_aer (360) ISOPNITA -> HNO3 rate = ** User defined ** (483) + usr_ISOPNITB_aer (361) ISOPNITB -> HNO3 rate = ** User defined ** (484) + usr_N2O5_aer (362) N2O5 -> 2*HNO3 rate = ** User defined ** (485) + usr_NC4CH2OH_aer (363) NC4CH2OH -> HNO3 rate = ** User defined ** (486) + usr_NC4CHO_aer (364) NC4CHO -> HNO3 rate = ** User defined ** (487) + usr_NH4_strat_ta (365) NH4 -> NHDEP rate = 6.34E-08 (488) + usr_NO2_aer (366) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (489) + usr_NO3_aer (367) NO3 -> HNO3 rate = ** User defined ** (490) + usr_NTERPOOH_aer (368) NTERPOOH -> HNO3 rate = ** User defined ** (491) + usr_ONITR_aer (369) ONITR -> HNO3 rate = ** User defined ** (492) + usr_TERPNIT_aer (370) TERPNIT -> HNO3 rate = ** User defined ** (493) + BCARY_NO3_vbs (371) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (494) + BCARY_O3_vbs (372) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (495) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (373) BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.00E-10 (496) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BENZENE_OH_vbs (374) BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 rate = 2.30E-12*exp( -193./t) (497) + + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 + ISOP_NO3_vbs (375) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (498) + ISOP_O3_vbs (376) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (499) + ISOP_OH_vbs (377) ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.54E-11*exp( 410./t) (500) + + 0.0271*SOAG3 + 0.0474*SOAG4 + IVOC_OH (378) IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 1.34E-11 (501) + + 0.0076*SOAG3 + 0.0113*SOAG4 + MTERP_NO3_vbs (379) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (502) + MTERP_O3_vbs (380) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (503) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERP_OH_vbs (381) MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 1.20E-11*exp( 440./t) (504) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + SVOC_OH (382) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (505) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (383) TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 rate = 1.70E-12*exp( 352./t) (506) + + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0232*SOAG4 + XYLENES_OH_vbs (384) XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 rate = 1.70E-11 (507) + + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 + het1 (385) N2O5 -> 2*HNO3 rate = ** User defined ** (508) + het10 (386) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (509) + het11 (387) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (510) + het12 (388) N2O5 -> 2*HNO3 rate = ** User defined ** (511) + het13 (389) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (512) + het14 (390) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (513) + het15 (391) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (514) + het16 (392) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (515) + het17 (393) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (516) + het2 (394) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (517) + het3 (395) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (518) + het4 (396) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (519) + het5 (397) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (520) + het6 (398) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (521) + het7 (399) N2O5 -> 2*HNO3 rate = ** User defined ** (522) + het8 (400) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (523) + het9 (401) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (524) + E90_tau (402) E90 -> {sink} rate = 1.29E-07 (525) + NH_50_tau (403) NH_50 -> (No products) rate = 2.31E-07 (526) + NH_5_tau (404) NH_5 -> (No products) rate = 2.31E-06 (527) + ST80_25_tau (405) ST80_25 -> (No products) rate = 4.63E-07 (528) + +Extraneous prod/loss species + ( 1) so4_a2 (dataset) + ( 2) NO (dataset) + ( 3) NO2 (dataset) + ( 4) SO2 (dataset) + ( 5) SVOC (dataset) + ( 6) pom_a1 (dataset) + ( 7) pom_a4 (dataset) + ( 8) so4_a1 (dataset) + ( 9) CO (dataset) + (10) bc_a1 (dataset) + (11) bc_a4 (dataset) + (12) num_a1 (dataset) + (13) num_a2 (dataset) + (14) num_a4 (dataset) + (15) OH + (16) N + (17) AOA_NH + + + Equation Report + + d(ALKNIT)/dt = r236*ALKO2*NO + - j19*ALKNIT - r233*OH*ALKNIT + d(ALKOOH)/dt = r234*ALKO2*HO2 + - j20*ALKOOH - r237*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r316*NO3*BCARY - r317*O3*BCARY - r318*OH*BCARY + d(BENZENE)/dt = - r275*OH*BENZENE + d(BENZOOH)/dt = r276*BENZO2*HO2 + - j21*BENZOOH - r278*OH*BENZOOH + d(BEPOMUC)/dt = .12*r275*BENZENE*OH + - j22*BEPOMUC + d(BIGALD)/dt = .1*r317*BCARY*O3 + .1*r320*MTERP*O3 + - j23*BIGALD + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r277*BENZO2*NO + + .2*r304*TOLO2*NO + .06*r310*XYLENO2*NO + - j24*BIGALD1 + d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r304*TOLO2*NO + .2*r310*XYLENO2*NO + - j25*BIGALD2 + d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r304*TOLO2*NO + + .15*r310*XYLENO2*NO + - j26*BIGALD3 + d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r310*XYLENO2*NO + - j27*BIGALD4 + d(BIGALK)/dt = .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r238*OH*BIGALK + d(BIGENE)/dt = - r204*NO3*BIGENE - r205*OH*BIGENE + d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR + + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH + + r103*O1D*CF3BR + 3*r104*O1D*CHBR3 + 2*r105*O1D*H2402 + r106*O1D*HBR + 2*r114*CH2BR2*CL + + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r343*SO*BRO + - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR + d(BRCL)/dt = r93*BRO*CLO + r393*HOBR*HCL + r398*HOBR*HCL + - j74*BRCL + d(BRO)/dt = j76*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR + - j75*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO + - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r343*SO*BRO + d(BRONO2)/dt = r96*M*BRO*NO2 + - j76*BRONO2 - j77*BRONO2 - r387*BRONO2 - r390*BRONO2 - r395*BRONO2 - r97*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j28*BZOOH + r282*BZOO*NO + - r279*OH*BZALD + d(BZOOH)/dt = r280*BZOO*HO2 + - j28*BZOOH - r281*OH*BZOOH + d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 + d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r181*M*OH*C2H4 + d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 + - r161*OH*C2H5OH + d(C2H5OOH)/dt = r159*C2H5O2*HO2 + - j29*C2H5OOH - r162*OH*C2H5OOH + d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 + d(C3H6)/dt = .7*j55*MVK + .13*r262*ISOP*O3 + - r184*NO3*C3H6 - r185*O3*C3H6 - r202*M*OH*C3H6 + d(C3H7OOH)/dt = r187*C3H7O2*HO2 + - j30*C3H7OOH - r189*OH*C3H7OOH + d(C3H8)/dt = - r190*OH*C3H8 + d(C6H5OOH)/dt = r283*C6H5O2*HO2 + - j31*C6H5OOH - r285*OH*C6H5OOH + d(CCL4)/dt = - j78*CCL4 - r76*O1D*CCL4 + d(CF2CLBR)/dt = - j79*CF2CLBR - r77*O1D*CF2CLBR + d(CF3BR)/dt = - j80*CF3BR - r103*O1D*CF3BR + d(CFC11)/dt = - j81*CFC11 - r78*O1D*CFC11 + d(CFC113)/dt = - j82*CFC113 - r79*O1D*CFC113 + d(CFC114)/dt = - j83*CFC114 - r80*O1D*CFC114 + d(CFC115)/dt = - j84*CFC115 - r81*O1D*CFC115 + d(CFC12)/dt = - j85*CFC12 - r82*O1D*CFC12 + d(CH2BR2)/dt = - j86*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j40*CH4 + j43*GLYALD + .33*j45*HONITR + + j47*HYAC + .69*j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH + + .375*j65*TERP2OOH + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO + + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + + .3*r140*CH3OOH*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 + + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH + + .5*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 + + r200*RO2*NO + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 + + .88*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 + + r218*MCO3*CH3CO3 + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + + r223*MCO3*NO3 + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + 1.5*r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + .75*r248*ISOPBO2*CH3O2 + .3*r253*ISOPNITA*OH + .8*r257*ISOPNO3*CH3O2 + .91*r262*ISOP*O3 + + .25*r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + .25*r270*XO2*NO + .34*r317*BCARY*O3 + + .34*r320*MTERP*O3 + .75*r322*NTERPO2*CH3O2 + .93*r327*TERP2O2*CH3O2 + .34*r329*TERP2O2*NO + + .95*r332*TERPO2*CH3O2 + .32*r334*TERPO2*NO + .68*r338*TERPROD2*OH + - j32*CH2O - j33*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O + - r133*O*CH2O - r134*OH*CH2O + d(CH3BR)/dt = - j87*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR + d(CH3CCL3)/dt = - j88*CH3CCL3 - r118*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH + + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + .5*r162*C2H5OOH*OH + .5*r185*C3H6*O3 + .27*r188*C3H7O2*NO + r196*PO2*NO + r204*BIGENE*NO3 + + r206*ENEO2*NO + .2*r224*MEKO2*HO2 + r225*MEKO2*NO + .1*r229*MVK*O3 + .8*r233*ALKNIT*OH + + .4*r235*ALKO2*NO + - j34*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO + d(CH3CL)/dt = - j89*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL + d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH + + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r186*C3H7O2*CH3O2 + .82*r188*C3H7O2*NO + + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .8*r233*ALKNIT*OH + .25*r235*ALKO2*NO + + .52*r317*BCARY*O3 + .52*r320*MTERP*O3 + .15*r327*TERP2O2*CH3O2 + .27*r329*TERP2O2*NO + + .025*r332*TERPO2*CH3O2 + .04*r334*TERPO2*NO + .5*r338*TERPROD2*OH + - j35*CH3COCH3 - r203*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j23*BIGALD + j27*BIGALD4 + .4*j70*TOLOOH + .54*j72*XYLENOOH + .51*j73*XYLOLOOH + + r193*HYAC*OH + r194*NOA*OH + .5*r198*RO2*CH3O2 + .25*r209*MACRO2*CH3CO3 + + .24*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .88*r215*MACR*O3 + + .5*r229*MVK*O3 + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + + .17*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .4*r304*TOLO2*NO + + .54*r310*XYLENO2*NO + .51*r313*XYLOLO2*NO + - j36*CH3COCHO - r191*NO3*CH3COCHO - r192*OH*CH3COCHO + d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r185*C3H6*O3 + .15*r220*MCO3*HO2 + - r172*OH*CH3COOH + d(CH3COOOH)/dt = .4*r170*CH3CO3*HO2 + .4*r220*MCO3*HO2 + - j37*CH3COOOH - r173*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 + + .25*r243*ISOPAO2*CH3O2 + .25*r248*ISOPBO2*CH3O2 + .2*r257*ISOPNO3*CH3O2 + .3*r268*XO2*CH3O2 + + .25*r322*NTERPO2*CH3O2 + .25*r327*TERP2O2*CH3O2 + .25*r332*TERPO2*CH3O2 + - r139*OH*CH3OH + d(CH3OOH)/dt = r137*CH3O2*HO2 + - j38*CH3OOH - r140*OH*CH3OOH + d(CH4)/dt = .1*r185*C3H6*O3 + - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - r150*O1D*CH4 + d(CHBR3)/dt = - j90*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 + d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j94*CLONO2 + + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*HOCL + r58*CLO*CH3O2 + + 2*r59*CLO*CLO + r61*CLO*CLO + r63*CLO*NO + r68*CLO*O + r69*CLO*OH + r71*HCL*O + r72*HCL*OH + + 4*r76*O1D*CCL4 + r77*O1D*CF2CLBR + 2*r78*O1D*CFC11 + 2*r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + r81*O1D*CFC115 + 2*r82*O1D*CFC12 + r83*O1D*HCL + r92*BRO*CLO + r113*O1D*COFCL + + 3*r118*CH3CCL3*OH + r120*CH3CL*OH + r123*HCFC141B*OH + r124*HCFC142B*OH + r125*HCFC22*OH + + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r344*SO*CLO + - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL + - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL + - r163*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r386*HOCL*HCL + r391*CLONO2*HCL + r392*HOCL*HCL + r396*CLONO2*HCL + + r397*HOCL*HCL + r401*CLONO2*HCL + - j91*CL2 + d(CL2O2)/dt = r85*M*CLO*CLO + - j92*CL2O2 - r86*M*CL2O2 + d(CLO)/dt = j95*CLONO2 + j107*OCLO + r86*M*CL2O2 + r86*M*CL2O2 + r56*CL*HO2 + r57*CL*O3 + r66*CLONO2*O + + r73*HOCL*CL + r74*HOCL*O + r75*HOCL*OH + r84*O1D*HCL + r349*SO*OCLO + - j93*CLO - r58*CH3O2*CLO - 2*r59*CLO*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - r62*HO2*CLO + - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO + - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r344*SO*CLO + d(CLONO2)/dt = r65*M*CLO*NO2 + - j94*CLONO2 - j95*CLONO2 - r389*CLONO2 - r394*CLONO2 - r400*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r391*HCL*CLONO2 - r396*HCL*CLONO2 - r401*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O + + j34*CH3CHO + j36*CH3COCHO + .38*j40*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + + .33*j45*HONITR + 1.34*j51*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + + 1.7*j69*TERPROD2 + j110*OCS + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + + r133*CH2O*O + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + + .56*r185*C3H6*O3 + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .22*r209*MACRO2*CH3CO3 + + .11*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .65*r215*MACR*O3 + + .56*r229*MVK*O3 + .62*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .2*r268*XO2*CH3O2 + .25*r270*XO2*NO + + .5*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + + .4*r291*MALO2*NO + .14*r293*MDIALO2*HO2 + .35*r294*MDIALO2*NO + .23*r317*BCARY*O3 + + .23*r320*MTERP*O3 + .125*r327*TERP2O2*CH3O2 + .225*r329*TERP2O2*NO + .7*r338*TERPROD2*OH + + r339*OCS*O + r340*OCS*OH + - r142*M*OH*CO - r152*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j40*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r142*M*CO*OH + + r144*HCOOH*OH + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 + + 2*r218*MCO3*CH3CO3 + r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + .5*r228*M*MPAN*OH + + .1*r229*MVK*O3 + r242*ISOPAO2*CH3CO3 + r267*XO2*CH3CO3 + .27*r317*BCARY*O3 + .27*r320*MTERP*O3 + + .5*r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + 1.8*r338*TERPROD2*OH + - j41*CO2 + d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 + + j101*HCFC142B + j102*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + 2*r81*O1D*CFC115 + r82*O1D*CFC12 + r103*O1D*CF3BR + 2*r105*O1D*H2402 + r124*HCFC142B*OH + + r125*HCFC22*OH + r129*O1D*HCFC142B + r130*O1D*HCFC22 + - j96*COF2 - r112*O1D*COF2 + d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + + r128*O1D*HCFC141B + - j97*COFCL - r113*O1D*COFCL + d(CRESOL)/dt = .18*r306*TOLUENE*OH + - r286*OH*CRESOL + d(DMS)/dt = - r353*NO3*DMS - r354*OH*DMS - r356*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r402*E90 + d(EOOH)/dt = r174*EO2*HO2 + - j42*EOOH + d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + + 2*r112*O1D*COF2 + r113*O1D*COFCL + - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F + d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r177*O2*EO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + r265*NC4CH2OH*OH + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .125*r327*TERP2O2*CH3O2 + + .225*r329*TERP2O2*NO + - j43*GLYALD - r178*OH*GLYALD + d(GLYOXAL)/dt = j21*BENZOOH + .13*j23*BIGALD + .7*j61*PHENOOH + .6*j70*TOLOOH + .34*j72*XYLENOOH + + .17*j73*XYLOLOOH + .65*r154*M*C2H2*OH + .2*r178*GLYALD*OH + .05*r251*ISOPBO2*NO + + .05*r252*ISOPBO2*NO3 + r266*NC4CHO*OH + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + + .25*r270*XO2*NO + .25*r271*XO2*NO3 + r277*BENZO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .7*r297*PHENO2*NO + .6*r304*TOLO2*NO + + .34*r310*XYLENO2*NO + .17*r313*XYLOLO2*NO + - j44*GLYOXAL - r357*GLYOXAL - r179*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j32*CH2O + j38*CH3OOH + j39*CH4 + .33*j40*CH4 + j99*HBR + j103*HCL + + j104*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r152*CO*OH + r340*OCS*OH + r345*S*OH + + r350*SO*OH + - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r11*H*HO2 + r150*O1D*CH4 + - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 + d(H2402)/dt = - j98*H2402 - r105*O1D*H2402 + d(H2O2)/dt = .5*r358*HO2 + r24*M*OH*OH + r25*HO2*HO2 + - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 + d(H2SO4)/dt = r352*SO3*H2O + - j109*H2SO4 + d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 + - j99*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR + d(HCFC141B)/dt = - j100*HCFC141B - r123*OH*HCFC141B - r128*O1D*HCFC141B + d(HCFC142B)/dt = - j101*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B + d(HCFC22)/dt = - j102*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 + d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL + - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r386*HOCL*HCL + - r391*CLONO2*HCL - r392*HOCL*HCL - r393*HOBR*HCL - r396*CLONO2*HCL - r397*HOCL*HCL + - r398*HOBR*HCL - r401*CLONO2*HCL + d(HCN)/dt = - r143*M*OH*HCN - r151*O1D*HCN + d(HCOOH)/dt = r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + .37*r156*C2H4*O3 + .12*r185*C3H6*O3 + + .33*r215*MACR*O3 + .12*r229*MVK*O3 + .11*r262*ISOP*O3 + .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r144*OH*HCOOH + d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 + - j104*HF + d(HNO3)/dt = r359*HONITR + r360*ISOPNITA + r361*ISOPNITB + 2*r362*N2O5 + r363*NC4CH2OH + r364*NC4CHO + + .5*r366*NO2 + r367*NO3 + r368*NTERPOOH + r369*ONITR + r370*TERPNIT + 2*r385*N2O5 + + r387*BRONO2 + 2*r388*N2O5 + r389*CLONO2 + r390*BRONO2 + r394*CLONO2 + r395*BRONO2 + + 2*r399*N2O5 + r400*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r165*CH3CHO*NO3 + + r191*CH3COCHO*NO3 + r353*DMS*NO3 + r391*CLONO2*HCL + r396*CLONO2*HCL + r401*CLONO2*HCL + - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 + d(HO2NO2)/dt = r45*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 + d(HOBR)/dt = r387*BRONO2 + r390*BRONO2 + r395*BRONO2 + r94*BRO*HO2 + - j105*HOBR - r102*O*HOBR - r393*HCL*HOBR - r398*HCL*HOBR + d(HOCL)/dt = r389*CLONO2 + r394*CLONO2 + r400*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r386*HCL*HOCL - r392*HCL*HOCL + - r397*HCL*HOCL + d(HONITR)/dt = r207*ENEO2*NO + r214*MACRO2*NO + .3*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + - j45*HONITR - r359*HONITR - r208*OH*HONITR + d(HPALD)/dt = r250*ISOPBO2 + - j46*HPALD - r239*OH*HPALD + d(HYAC)/dt = .17*j45*HONITR + .5*r197*POOH*OH + .2*r198*RO2*CH3O2 + .22*r209*MACRO2*CH3CO3 + + .23*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .5*r228*M*MPAN*OH + + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + - j47*HYAC - r193*OH*HYAC + d(HYDRALD)/dt = r247*ISOPBO2*CH3CO3 + .75*r248*ISOPBO2*CH3O2 + .87*r251*ISOPBO2*NO + .95*r252*ISOPBO2*NO3 + - r240*OH*HYDRALD + d(IEPOX)/dt = .6*r264*ISOPOOH*OH + - r241*OH*IEPOX + d(ISOP)/dt = - r255*NO3*ISOP - r262*O3*ISOP - r263*OH*ISOP + d(ISOPNITA)/dt = .08*r245*ISOPAO2*NO + - r360*ISOPNITA - r253*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r251*ISOPBO2*NO + - r361*ISOPNITB - r254*OH*ISOPNITB + d(ISOPNO3)/dt = r255*ISOP*NO3 + - r256*CH3CO3*ISOPNO3 - r257*CH3O2*ISOPNO3 - r258*HO2*ISOPNO3 - r259*NO*ISOPNO3 + - r260*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r258*ISOPNO3*HO2 + - j48*ISOPNOOH - r261*OH*ISOPNOOH + d(ISOPOOH)/dt = j48*ISOPNOOH + r244*ISOPAO2*HO2 + r249*ISOPBO2*HO2 + - j49*ISOPOOH - r264*OH*ISOPOOH + d(IVOC)/dt = - r378*OH*IVOC + d(MACR)/dt = .288*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO + + .4*r246*ISOPAO2*NO3 + .3*r262*ISOP*O3 + - j50*MACR - j51*MACR - r215*O3*MACR - r216*OH*MACR + d(MACROOH)/dt = r211*MACRO2*HO2 + - r217*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r235*ALKO2*NO + - j52*MEK - r226*OH*MEK + d(MEKOOH)/dt = .8*r224*MEKO2*HO2 + - j53*MEKOOH - r227*OH*MEKOOH + d(MPAN)/dt = r231*M*MCO3*NO2 + - j54*MPAN - r232*M*MPAN - r228*M*OH*MPAN + d(MTERP)/dt = - r319*NO3*MTERP - r320*O3*MTERP - r321*OH*MTERP + d(MVK)/dt = .402*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO + + .6*r246*ISOPAO2*NO3 + .2*r262*ISOP*O3 + - j55*MVK - r229*O3*MVK - r230*OH*MVK + d(N)/dt = j15*NO + - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N + d(N2O)/dt = r28*N*NO2 + - j12*N2O - r43*O1D*N2O - r44*O1D*N2O + d(N2O5)/dt = r46*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r362*N2O5 - r385*N2O5 - r388*N2O5 - r399*N2O5 + d(NC4CH2OH)/dt = .2*r257*ISOPNO3*CH3O2 + - r363*NC4CH2OH - r265*OH*NC4CH2OH + d(NC4CHO)/dt = r256*ISOPNO3*CH3CO3 + .8*r257*ISOPNO3*CH3O2 + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + - j56*NC4CHO - r364*NC4CHO - r266*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r355*OH*NH3 + d(NH4)/dt = - r365*NH4 + d(NH_5)/dt = - r404*NH_5 + d(NH_50)/dt = - r403*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r366*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + + 2*r43*O1D*N2O + r346*SO*NO2 + - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO + - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + - r188*C3H7O2*NO - r196*PO2*NO - r200*RO2*NO - r206*ENEO2*NO - r207*ENEO2*NO - r213*MACRO2*NO + - r214*MACRO2*NO - r222*MCO3*NO - r225*MEKO2*NO - r235*ALKO2*NO - r236*ALKO2*NO - r245*ISOPAO2*NO + - r251*ISOPBO2*NO - r259*ISOPNO3*NO - r270*XO2*NO - r274*ACBZO2*NO - r277*BENZO2*NO + - r282*BZOO*NO - r284*C6H5O2*NO - r288*DICARBO2*NO - r291*MALO2*NO - r294*MDIALO2*NO + - r297*PHENO2*NO - r304*TOLO2*NO - r310*XYLENO2*NO - r313*XYLOLO2*NO - r324*NTERPO2*NO + - r329*TERP2O2*NO - r334*TERPO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 + + j95*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT + + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 + + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + + r171*CH3CO3*NO + r175*EO2*NO + r188*C3H7O2*NO + r194*NOA*OH + r196*PO2*NO + r200*RO2*NO + + r204*BIGENE*NO3 + r206*ENEO2*NO + r212*MACRO2*NO3 + r213*MACRO2*NO + r222*MCO3*NO + + r223*MCO3*NO3 + r225*MEKO2*NO + r233*ALKNIT*OH + r235*ALKO2*NO + .92*r245*ISOPAO2*NO + + r246*ISOPAO2*NO3 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r270*XO2*NO + r271*XO2*NO3 + r274*ACBZO2*NO + + r277*BENZO2*NO + r282*BZOO*NO + r284*C6H5O2*NO + r288*DICARBO2*NO + r291*MALO2*NO + + r294*MDIALO2*NO + r297*PHENO2*NO + r304*TOLO2*NO + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .5*r322*NTERPO2*CH3O2 + 1.6*r324*NTERPO2*NO + 2*r325*NTERPO2*NO3 + .9*r329*TERP2O2*NO + + r331*TERPNIT*OH + .8*r334*TERPO2*NO + - j16*NO2 - r366*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 + - r182*M*CH3CO3*NO2 - r231*M*MCO3*NO2 - r289*M*DICARBO2*NO2 - r292*M*MALO2*NO2 + - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r346*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j94*CLONO2 + r50*M*N2O5 + + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH + + r97*BRONO2*O + r111*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH + - j17*NO3 - j18*NO3 - r367*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 + - r204*BIGENE*NO3 - r212*MACRO2*NO3 - r223*MCO3*NO3 - r246*ISOPAO2*NO3 - r252*ISOPBO2*NO3 + - r255*ISOP*NO3 - r260*ISOPNO3*NO3 - r271*XO2*NO3 - r316*BCARY*NO3 - r319*MTERP*NO3 + - r325*NTERPO2*NO3 - r336*TERPROD1*NO3 - r353*DMS*NO3 + d(NOA)/dt = r184*C3H6*NO3 + .5*r254*ISOPNITB*OH + r261*ISOPNOOH*OH + r265*NC4CH2OH*OH + r266*NC4CHO*OH + - j57*NOA - r194*OH*NOA + d(NTERPOOH)/dt = r323*NTERPO2*HO2 + - j58*NTERPOOH - r368*NTERPOOH - r326*OH*NTERPOOH + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j40*CH4 + + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r3*N2*O1D + + r4*O2*O1D + r31*O2*N + r341*O2*S + r347*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O + - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r339*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 + - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r342*S*O3 - r348*SO*O3 + d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO + - j107*OCLO - r349*SO*OCLO + d(OCS)/dt = - j110*OCS - r339*O*OCS - r340*OH*OCS + d(ONITR)/dt = r208*HONITR*OH + .1*r329*TERP2O2*NO + - j59*ONITR - r369*ONITR + d(PAN)/dt = r182*M*CH3CO3*NO2 + - j60*PAN - r183*M*PAN - r180*OH*PAN + d(PBZNIT)/dt = r302*M*ACBZO2*NO2 + - r307*M*PBZNIT + d(PHENO)/dt = j31*C6H5OOH + r284*C6H5O2*NO + .07*r286*CRESOL*OH + .06*r298*PHENOL*OH + .07*r314*XYLOL*OH + - r299*NO2*PHENO - r300*O3*PHENO + d(PHENOL)/dt = .53*r275*BENZENE*OH + - r298*OH*PHENOL + d(PHENOOH)/dt = r296*PHENO2*HO2 + - j61*PHENOOH - r301*OH*PHENOOH + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r195*PO2*HO2 + - j62*POOH - r197*OH*POOH + d(ROOH)/dt = .85*r199*RO2*HO2 + - j63*ROOH - r201*OH*ROOH + d(S)/dt = j110*OCS + j111*SO + - r341*O2*S - r342*O3*S - r345*OH*S + d(SF6)/dt = - j108*SF6 + d(SO)/dt = j112*SO2 + r341*O2*S + r339*OCS*O + r342*S*O3 + r345*S*OH + - j111*SO - r347*O2*SO - r343*BRO*SO - r344*CLO*SO - r346*NO2*SO - r348*O3*SO - r349*OCLO*SO + - r350*OH*SO + d(SO2)/dt = j113*SO3 + r347*O2*SO + r340*OCS*OH + r343*SO*BRO + r344*SO*CLO + r346*SO*NO2 + r348*SO*O3 + + r349*SO*OCLO + r350*SO*OH + r353*DMS*NO3 + r354*DMS*OH + .5*r356*DMS*OH + - j112*SO2 - r351*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r351*SO2*OH + - j113*SO3 - r352*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soa1_a1)/dt = - j114*soa1_a1 + d(soa1_a2)/dt = - j115*soa1_a2 + d(soa2_a1)/dt = - j116*soa2_a1 + d(soa2_a2)/dt = - j117*soa2_a2 + d(soa3_a1)/dt = - j118*soa3_a1 + d(soa3_a2)/dt = - j119*soa3_a2 + d(soa4_a1)/dt = - j120*soa4_a1 + d(soa4_a2)/dt = - j121*soa4_a2 + d(soa5_a1)/dt = - j122*soa5_a1 + d(soa5_a2)/dt = - j123*soa5_a2 + d(SOAG0)/dt = r357*GLYOXAL + .2202*r372*BCARY*O3 + .2202*r373*BCARY*OH + .0023*r374*BENZENE*OH + + .0031*r377*ISOP*OH + .2381*r378*IVOC*OH + .0508*r380*MTERP*O3 + .0508*r381*MTERP*OH + + .5931*r382*SVOC*OH + .1364*r383*TOLUENE*OH + .1677*r384*XYLENES*OH + d(SOAG1)/dt = .2067*r372*BCARY*O3 + .2067*r373*BCARY*OH + .0008*r374*BENZENE*OH + .0035*r377*ISOP*OH + + .1308*r378*IVOC*OH + .1149*r380*MTERP*O3 + .1149*r381*MTERP*OH + .1534*r382*SVOC*OH + + .0101*r383*TOLUENE*OH + .0174*r384*XYLENES*OH + d(SOAG2)/dt = .0653*r372*BCARY*O3 + .0653*r373*BCARY*OH + .0843*r374*BENZENE*OH + .0003*r377*ISOP*OH + + .0348*r378*IVOC*OH + .0348*r380*MTERP*O3 + .0348*r381*MTERP*OH + .0459*r382*SVOC*OH + + .0763*r383*TOLUENE*OH + .086*r384*XYLENES*OH + d(SOAG3)/dt = .17493*r371*BCARY*NO3 + .1284*r372*BCARY*O3 + .1284*r373*BCARY*OH + .0443*r374*BENZENE*OH + + .059024*r375*ISOP*NO3 + .0033*r376*ISOP*O3 + .0271*r377*ISOP*OH + .0076*r378*IVOC*OH + + .17493*r379*MTERP*NO3 + .0554*r380*MTERP*O3 + .0554*r381*MTERP*OH + .0085*r382*SVOC*OH + + .2157*r383*TOLUENE*OH + .0512*r384*XYLENES*OH + d(SOAG4)/dt = .59019*r371*BCARY*NO3 + .114*r372*BCARY*O3 + .114*r373*BCARY*OH + .1621*r374*BENZENE*OH + + .025024*r375*ISOP*NO3 + .0474*r377*ISOP*OH + .0113*r378*IVOC*OH + .59019*r379*MTERP*NO3 + + .1278*r380*MTERP*O3 + .1278*r381*MTERP*OH + .0128*r382*SVOC*OH + .0232*r383*TOLUENE*OH + + .1598*r384*XYLENES*OH + d(ST80_25)/dt = - r405*ST80_25 + d(SVOC)/dt = - r382*OH*SVOC + d(TEPOMUC)/dt = .1*r306*TOLUENE*OH + .23*r308*XYLENES*OH + - j64*TEPOMUC + d(TERP2OOH)/dt = r328*TERP2O2*HO2 + - j65*TERP2OOH - r330*OH*TERP2OOH + d(TERPNIT)/dt = .5*r322*NTERPO2*CH3O2 + .2*r324*NTERPO2*NO + .2*r334*TERPO2*NO + - j66*TERPNIT - r370*TERPNIT - r331*OH*TERPNIT + d(TERPOOH)/dt = r333*TERPO2*HO2 + - j67*TERPOOH - r335*OH*TERPOOH + d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r317*BCARY*O3 + .33*r320*MTERP*O3 + + .5*r322*NTERPO2*CH3O2 + .8*r324*NTERPO2*NO + r325*NTERPO2*NO3 + r331*TERPNIT*OH + + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + - j68*TERPROD1 - r336*NO3*TERPROD1 - r337*OH*TERPROD1 + d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r317*BCARY*O3 + .3*r320*MTERP*O3 + r327*TERP2O2*CH3O2 + + .9*r329*TERP2O2*NO + - j69*TERPROD2 - r338*OH*TERPROD2 + d(TOLOOH)/dt = r303*TOLO2*HO2 + - j70*TOLOOH - r305*OH*TOLOOH + d(TOLUENE)/dt = - r306*OH*TOLUENE + d(XOOH)/dt = r269*XO2*HO2 + - j71*XOOH - r272*OH*XOOH + d(XYLENES)/dt = - r308*OH*XYLENES + d(XYLENOOH)/dt = r309*XYLENO2*HO2 + - j72*XYLENOOH - r311*OH*XYLENOOH + d(XYLOL)/dt = .15*r308*XYLENES*OH + - r314*OH*XYLOL + d(XYLOLOOH)/dt = r312*XYLOLO2*HO2 + - j73*XYLOLOOH - r315*OH*XYLOLOOH + d(NHDEP)/dt = r365*NH4 + r355*NH3*OH + d(NDEP)/dt = .5*r228*M*MPAN*OH + r289*M*DICARBO2*NO2 + r292*M*MALO2*NO2 + r295*M*MDIALO2*NO2 + r299*PHENO*NO2 + + .2*r324*NTERPO2*NO + .5*r336*TERPROD1*NO3 + d(ACBZO2)/dt = r307*M*PBZNIT + r279*BZALD*OH + - r273*HO2*ACBZO2 - r274*NO*ACBZO2 - r302*M*NO2*ACBZO2 + d(ALKO2)/dt = r237*ALKOOH*OH + r238*BIGALK*OH + - r234*HO2*ALKO2 - r235*NO*ALKO2 - r236*NO*ALKO2 + d(BENZO2)/dt = .35*r275*BENZENE*OH + r278*BENZOOH*OH + - r276*HO2*BENZO2 - r277*NO*BENZO2 + d(BZOO)/dt = r281*BZOOH*OH + .07*r306*TOLUENE*OH + .06*r308*XYLENES*OH + - r280*HO2*BZOO - r282*NO*BZOO + d(C2H5O2)/dt = j52*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH + - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 + d(C3H7O2)/dt = r189*C3H7OOH*OH + r190*C3H8*OH + - r186*CH3O2*C3H7O2 - r187*HO2*C3H7O2 - r188*NO*C3H7O2 + d(C6H5O2)/dt = .4*r273*ACBZO2*HO2 + r274*ACBZO2*NO + r285*C6H5OOH*OH + r300*PHENO*O3 + - r283*HO2*C6H5O2 - r284*NO*C6H5O2 + d(CH3CO3)/dt = .13*j23*BIGALD + j27*BIGALD4 + j35*CH3COCH3 + j36*CH3COCHO + .33*j45*HONITR + j47*HYAC + + 1.34*j50*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH + + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r183*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH + + .5*r173*CH3COOOH*OH + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .3*r198*RO2*CH3O2 + + .15*r199*RO2*HO2 + r200*RO2*NO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .1*r215*MACR*O3 + r219*MCO3*CH3O2 + + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + .2*r224*MEKO2*HO2 + + r225*MEKO2*NO + .28*r229*MVK*O3 + .08*r262*ISOP*O3 + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .65*r338*TERPROD2*OH + - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 + - r182*M*NO2*CH3CO3 - r209*MACRO2*CH3CO3 - r242*ISOPAO2*CH3CO3 - r247*ISOPBO2*CH3CO3 + - r256*ISOPNO3*CH3CO3 - r267*XO2*CH3CO3 + d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j39*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR + + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 + + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .45*r170*CH3CO3*HO2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .28*r185*C3H6*O3 + r209*MACRO2*CH3CO3 + r218*MCO3*CH3CO3 + + r242*ISOPAO2*CH3CO3 + r247*ISOPBO2*CH3CO3 + r256*ISOPNO3*CH3CO3 + .05*r262*ISOP*O3 + + r267*XO2*CH3CO3 + .33*r287*DICARBO2*HO2 + .83*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + + .17*r294*MDIALO2*NO + - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 + - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r186*C3H7O2*CH3O2 - r198*RO2*CH3O2 + - r210*MACRO2*CH3O2 - r219*MCO3*CH3O2 - r243*ISOPAO2*CH3O2 - r248*ISOPBO2*CH3O2 + - r257*ISOPNO3*CH3O2 - r268*XO2*CH3O2 - r322*NTERPO2*CH3O2 - r327*TERP2O2*CH3O2 + - r332*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j25*BIGALD2 + - r287*HO2*DICARBO2 - r288*NO*DICARBO2 - r289*M*NO2*DICARBO2 + d(ENEO2)/dt = r205*BIGENE*OH + - r206*NO*ENEO2 - r207*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r175*EO2*NO + - r176*EO - r177*O2*EO + d(EO2)/dt = r181*M*C2H4*OH + - r174*HO2*EO2 - r175*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + .56*j23*BIGALD + + j24*BIGALD1 + .6*j25*BIGALD2 + .6*j26*BIGALD3 + j27*BIGALD4 + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR + + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + 1.34*j50*MACR + .66*j51*MACR + j56*NC4CHO + + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH + + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r14*O2*M*H + + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 + + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 + + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*CO*OH + + r143*M*HCN*OH + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + .35*r154*M*C2H2*OH + + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + r178*GLYALD*OH + r179*GLYOXAL*OH + + .28*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r188*C3H7O2*NO + r193*HYAC*OH + r196*PO2*NO + + .3*r198*RO2*CH3O2 + r206*ENEO2*NO + r208*HONITR*OH + .47*r209*MACRO2*CH3CO3 + + .73*r210*MACRO2*CH3O2 + .47*r212*MACRO2*NO3 + .47*r213*MACRO2*NO + .14*r215*MACR*O3 + + .2*r217*MACROOH*OH + r219*MCO3*CH3O2 + .5*r228*M*MPAN*OH + .28*r229*MVK*O3 + r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + r247*ISOPBO2*CH3CO3 + r248*ISOPBO2*CH3O2 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + + .3*r253*ISOPNITA*OH + r254*ISOPNITB*OH + r256*ISOPNO3*CH3CO3 + 1.2*r257*ISOPNO3*CH3O2 + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r261*ISOPNOOH*OH + .37*r262*ISOP*O3 + r265*NC4CH2OH*OH + + r266*NC4CHO*OH + r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + r270*XO2*NO + r271*XO2*NO3 + + .65*r275*BENZENE*OH + r277*BENZO2*NO + r282*BZOO*NO + .73*r286*CRESOL*OH + + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .33*r293*MDIALO2*HO2 + .83*r294*MDIALO2*NO + r297*PHENO2*NO + .8*r298*PHENOL*OH + r304*TOLO2*NO + + .28*r306*TOLUENE*OH + .38*r308*XYLENES*OH + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .63*r314*XYLOL*OH + .57*r317*BCARY*O3 + .57*r320*MTERP*O3 + .5*r322*NTERPO2*CH3O2 + + r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + + .2*r338*TERPROD2*OH + r351*SO2*OH + .5*r356*DMS*OH + - r358*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 + - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r187*C3H7O2*HO2 - r195*PO2*HO2 + - r199*RO2*HO2 - r211*MACRO2*HO2 - r220*MCO3*HO2 - r224*MEKO2*HO2 - r234*ALKO2*HO2 + - r244*ISOPAO2*HO2 - r249*ISOPBO2*HO2 - r258*ISOPNO3*HO2 - r269*XO2*HO2 - r273*ACBZO2*HO2 + - r276*BENZO2*HO2 - r280*BZOO*HO2 - r283*C6H5O2*HO2 - r287*DICARBO2*HO2 - r290*MALO2*HO2 + - r293*MDIALO2*HO2 - r296*PHENO2*HO2 - r303*TOLO2*HO2 - r309*XYLENO2*HO2 - r312*XYLOLO2*HO2 + - r323*NTERPO2*HO2 - r328*TERP2O2*HO2 - r333*TERPO2*HO2 + d(HOCH2OO)/dt = r131*CH2O*HO2 + - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r263*ISOP*OH + - r242*CH3CO3*ISOPAO2 - r243*CH3O2*ISOPAO2 - r244*HO2*ISOPAO2 - r245*NO*ISOPAO2 + - r246*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r263*ISOP*OH + - r250*ISOPBO2 - r247*CH3CO3*ISOPBO2 - r248*CH3O2*ISOPBO2 - r249*HO2*ISOPBO2 + - r251*NO*ISOPBO2 - r252*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r216*MACR*OH + .2*r217*MACROOH*OH + r230*MVK*OH + - r209*CH3CO3*MACRO2 - r210*CH3O2*MACRO2 - r211*HO2*MACRO2 - r212*NO3*MACRO2 - r213*NO*MACRO2 + - r214*NO*MACRO2 + d(MALO2)/dt = .6*j24*BIGALD1 + - r290*HO2*MALO2 - r291*NO*MALO2 - r292*M*NO2*MALO2 + d(MCO3)/dt = .66*j50*MACR + j54*MPAN + r232*M*MPAN + .5*r216*MACR*OH + .5*r217*MACROOH*OH + - r218*CH3CO3*MCO3 - r219*CH3O2*MCO3 - r220*HO2*MCO3 - 2*r221*MCO3*MCO3 - r222*NO*MCO3 + - r223*NO3*MCO3 - r231*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j26*BIGALD3 + - r293*HO2*MDIALO2 - r294*NO*MDIALO2 - r295*M*NO2*MDIALO2 + d(MEKO2)/dt = r226*MEK*OH + r227*MEKOOH*OH + - r224*HO2*MEKO2 - r225*NO*MEKO2 + d(NTERPO2)/dt = r316*BCARY*NO3 + r319*MTERP*NO3 + r326*NTERPOOH*OH + .5*r336*TERPROD1*NO3 + - r322*CH3O2*NTERPO2 - r323*HO2*NTERPO2 - r324*NO*NTERPO2 - r325*NO3*NTERPO2 + d(O1D)/dt = j5*O2 + j1*H2O + j7*O3 + j12*N2O + - r3*N2*O1D - r4*O2*O1D - r1*H2*O1D - r2*H2O*O1D - r5*O3*O1D - r43*N2O*O1D - r44*N2O*O1D + - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D + - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D + - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D + - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D + - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j40*CH4 + j42*EOOH + j46*HPALD + + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + j67*TERPOOH + + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + .5*r366*NO2 + + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 + + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL + + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH + + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH + + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + .24*r215*MACR*O3 + + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + .32*r262*ISOP*O3 + + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + .4*r287*DICARBO2*HO2 + + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*O3 + - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH + - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH + - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH + - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH + - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH + - r142*M*CO*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH + - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH + - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH - r181*M*C2H4*OH + - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH - r197*POOH*OH + - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH - r208*HONITR*OH + - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH - r230*MVK*OH + - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH - r240*HYDRALD*OH + - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH - r263*ISOP*OH + - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH - r275*BENZENE*OH + - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH - r286*CRESOL*OH + - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH - r308*XYLENES*OH + - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH - r321*MTERP*OH + - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH - r337*TERPROD1*OH + - r338*TERPROD2*OH - r340*OCS*OH - r345*S*OH - r350*SO*OH - r351*SO2*OH - r354*DMS*OH + - r355*NH3*OH - r356*DMS*OH + d(PHENO2)/dt = .2*r286*CRESOL*OH + .14*r298*PHENOL*OH + r301*PHENOOH*OH + - r296*HO2*PHENO2 - r297*NO*PHENO2 + d(PO2)/dt = .5*r197*POOH*OH + r202*M*C3H6*OH + - r195*HO2*PO2 - r196*NO*PO2 + d(RO2)/dt = .15*j69*TERPROD2 + r201*ROOH*OH + r203*CH3COCH3*OH + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .15*r338*TERPROD2*OH + - r198*CH3O2*RO2 - r199*HO2*RO2 - r200*NO*RO2 + d(TERP2O2)/dt = r330*TERP2OOH*OH + .5*r336*TERPROD1*NO3 + r337*TERPROD1*OH + - r327*CH3O2*TERP2O2 - r328*HO2*TERP2O2 - r329*NO*TERP2O2 + d(TERPO2)/dt = r318*BCARY*OH + r321*MTERP*OH + r335*TERPOOH*OH + - r332*CH3O2*TERPO2 - r333*HO2*TERPO2 - r334*NO*TERPO2 + d(TOLO2)/dt = r305*TOLOOH*OH + .65*r306*TOLUENE*OH + - r303*HO2*TOLO2 - r304*NO*TOLO2 + d(XO2)/dt = r239*HPALD*OH + r240*HYDRALD*OH + r241*IEPOX*OH + .4*r264*ISOPOOH*OH + .5*r272*XOOH*OH + - r267*CH3CO3*XO2 - r268*CH3O2*XO2 - r269*HO2*XO2 - r270*NO*XO2 - r271*NO3*XO2 + d(XYLENO2)/dt = .56*r308*XYLENES*OH + r311*XYLENOOH*OH + - r309*HO2*XYLENO2 - r310*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r314*XYLOL*OH + r315*XYLOLOOH*OH + - r312*HO2*XYLOLO2 - r313*NO*XYLOLO2 + d(H2O)/dt = .05*j40*CH4 + j109*H2SO4 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + r23*OH*OH + + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + r115*CH2BR2*OH + + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + r134*CH2O*OH + + r140*CH3OOH*OH + r141*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + r172*CH3COOH*OH + + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + r197*POOH*OH + + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r355*NH3*OH + r386*HOCL*HCL + + r392*HOCL*HCL + r393*HOBR*HCL + r397*HOCL*HCL + r398*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r352*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in new file mode 100644 index 0000000000..7961638008 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in @@ -0,0 +1,1163 @@ +* Comments +* User-given Tag Description: TS1-simpleVBS for CESM2.0 +* Tag database identifier : MZ198_TS1-simpleVBS_20180423 +* Tag created by : lke +* Tag created from branch : TS1-simpleVBS +* Tag created on : 2018-04-23 17:49:48.65279-06 +* Comments for this tag follow: +* lke : 2018-04-23 : Latest change only removes O3S loss reactions. + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CHO, + CH3CL -> CH3Cl, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + O, + O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + pom_a1 -> C, + pom_a4 -> C, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soa1_a1 -> C15H38O2, + soa1_a2 -> C15H38O2, + soa2_a1 -> C15H38O2, + soa2_a2 -> C15H38O2, + soa3_a1 -> C15H38O2, + soa3_a2 -> C15H38O2, + soa4_a1 -> C15H38O2, + soa4_a2 -> C15H38O2, + soa5_a1 -> C15H38O2, + soa5_a2 -> C15H38O2, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H18O3, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BENZO2 -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + NTERPO2 -> C10H16NO5, + O1D -> O, + OH, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, N2, O2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BENZO2, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + NTERPO2, + O1D, + OH, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + XO2, + XYLENO2, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + AOA_NH + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH3BR + CH3CCL3 + CH3CL + CH4 + CHBR3 + CLY + CO2 + E90 + H2402 + HCFC141B + HCFC142B + HCFC22 + N2O + NH_5 + NH_50 + SF6 + ST80_25 + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + bc_a1 + bc_a4 + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CH2O + CH3CHO + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CL + CL2 + CL2O2 + CLO + CLONO2 + CO + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2O2 + H2SO4 + HBR + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPOOH + IVOC + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + N + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + O + O3 + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pom_a1 + pom_a4 + POOH + ROOH + S + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + SVOC + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BENZO2 + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + NTERPO2 + O1D + OH + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + XO2 + XYLENO2 + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_a] H2O + hv -> OH + H +[jh2o_c] H2O + hv -> 2*H + O +[jh2o2] H2O2 + hv -> 2*OH +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo3_a] O3 + hv -> O1D + O2 +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_b] NO3 + hv -> NO + O2 +[jno3_a] NO3 + hv -> NO2 + O +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 +[jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 +[jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 +[jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jco2] CO2 + hv -> CO + O +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O +********************************* +*** soa +********************************* +[jsoa1_a1->,.0004*jno2] soa1_a1 + hv -> +[jsoa1_a2->,.0004*jno2] soa1_a2 + hv -> +[jsoa2_a1->,.0004*jno2] soa2_a1 + hv -> +[jsoa2_a2->,.0004*jno2] soa2_a2 + hv -> +[jsoa3_a1->,.0004*jno2] soa3_a1 + hv -> +[jsoa3_a2->,.0004*jno2] soa3_a2 + hv -> +[jsoa4_a1->,.0004*jno2] soa4_a1 + hv -> +[jsoa4_a2->,.0004*jno2] soa4_a2 + hv -> +[jsoa5_a1->,.0004*jno2] soa5_a1 + hv -> +[jsoa5_a2->,.0004*jno2] soa5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2ab] O1D + O2 -> O + O2 ; 3.3e-11, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 1.5e-11, -3600 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.5e-11, 170 +[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.3e-12, 270 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 ; 5e-13, -424 +[CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14, 706 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.9e-12, -345 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 +[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH_b] CO + OH -> CO2 + H +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.6e-29, 3.3, 3.1e-10, 1, 0.6 +[C2H4_O3] C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O ; 1.2e-14, -2630 +[C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH ; 6.8e-14 +[C2H5O2_CH3O2] C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH + 0.2*C2H5OH ; 2e-13 +[C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 +[C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 +[C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12, -230 +[C2H5OOH_OH] C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH ; 3.8e-12, 200 +[C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.2e-11, -70 +[C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020 +[CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 +[CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.9e-12, 500 +[CH3CO3_CH3O2] CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 + 0.1*CH3COOH ; 2e-12, 500 +[CH3CO3_HO2] CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH + 0.45*CH3O2 ; 4.3e-13, 1040 +[CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 +[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7e-13 +[CH3COOOH_OH] CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O ; 1e-12 +[EO2_HO2] EO2 + HO2 -> EOOH ; 7.5e-13, 700 +[EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.2e-12, 180 +[EO_M] EO -> 2*CH2O + HO2 ; 1.6e+11, -4150 +[EO_O2] EO + O2 -> GLYALD + HO2 ; 1e-14 +[GLYALD_OH] GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 ; 1e-11 +[GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 +[PAN_OH] PAN + OH -> CH2O + NO3 ; 4e-14 +[tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.6e-29, 3.1, 9e-12, 0.85, 0.48 +[tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M +********************************* +*** C3 +********************************* +[C3H6_NO3] C3H6 + NO3 -> NOA ; 4.6e-13, -1156 +[C3H6_O3] C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH ; 6.5e-15, -1900 +[C3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 ; 3.75e-13, -40 +[C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 +[C3H7O2_NO] C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO ; 4.2e-12, 180 +[C3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 +[C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 8.7e-12, -615 +[CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 +[CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13, 830 +[HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3e-12 +[NOA_OH] NOA + OH -> NO2 + CH3COCHO ; 6.7e-13 +[PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 +[PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 +[POOH_OH] POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O ; 3.8e-12, 200 +[RO2_CH3O2] RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC + 0.5*CH3COCHO + 0.5*CH3OH ; 7.1e-13, 500 +[RO2_HO2] RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 ; 8.6e-13, 700 +[RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 +[ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 +[tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O +********************************* +*** C4 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 ; 1.4e-11 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC ; 5e-13, 400 +[MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8e-13, 700 +[MACRO2_NO3] MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 ; 2.4e-12 +[MACRO2_NOa] MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO ; 2.7e-12, 360 +[MACRO2_NOb] MACRO2 + NO -> HONITR ; 1.3e-13, 360 +[MACR_O3] MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 ; 1.5e-15, -2100 +[MACR_OH] MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 ; 2.3e-11, 200 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 +[MCO3_CH3O2] MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 ; 2.3e-12, 530 +[MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5e-12 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[MPAN_OH_M] MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 + M + 0.5*NDEP ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVK_O3] MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH ; 8.5e-16, -1520 +[MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452 +[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[ISOP_O3] ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 ; 1.05e-14, -2000 +[ISOP_OH] ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[XO2_CH3CO3] XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 ; 1.3e-12, 640 +[XO2_CH3O2] XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD ; 5e-13, 400 +[XO2_HO2] XO2 + HO2 -> XOOH ; 8e-13, 700 +[XO2_NO] XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD ; 2.7e-12, 360 +[XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*GLYALD ; 2.4e-12 +[XOOH_OH] XOOH + OH -> 0.5*XO2 + 0.5*OH ; 1.52e-12, 200 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** Sulfur +********************************* +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.7e-11, 335 +[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> HNO3 +[usr_NH4_strat_tau] NH4 -> 1*NHDEP ; 6.34e-08 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +[usr_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 2.3e-12, -193 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.54e-11, 410 +[IVOC_OH] IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 1.2e-11, 440 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0232*SOAG4 ; 1.7e-12, 352 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 1.7e-11 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Tracers +********************************* +[E90_tau] E90 -> sink ; 1.29e-07 +[NH_50_tau] NH_50 -> ; 2.31e-07 +[NH_5_tau] NH_5 -> ; 2.31e-06 +[ST80_25_tau] ST80_25 -> ; 4.63e-07 + End Reactions + + Ext Forcing + so4_a2 <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + SVOC <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + so4_a1 <- dataset + CO <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + OH + N + AOA_NH + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid +* vec_ftns = on + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 new file mode 100644 index 0000000000..8050030043 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 123, & ! number of photolysis reactions + rxntot = 528, & ! number of total reactions + gascnt = 405, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 221, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2022, & ! number of non-zero matrix entries + extcnt = 17, & ! number of species with external forcing + clscnt1 = 30, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 191, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 528, & + enthalpy_cnt = 18, & + nslvd = 34 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 new file mode 100644 index 0000000000..d1bf9756a2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 @@ -0,0 +1,531 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_a = 2 + integer, parameter :: rid_jh2o_c = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_a = 5 + integer, parameter :: rid_jo2_b = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno2 = 16 + integer, parameter :: rid_jno3_b = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jalknit = 19 + integer, parameter :: rid_jalkooh = 20 + integer, parameter :: rid_jbenzooh = 21 + integer, parameter :: rid_jbepomuc = 22 + integer, parameter :: rid_jbigald = 23 + integer, parameter :: rid_jbigald1 = 24 + integer, parameter :: rid_jbigald2 = 25 + integer, parameter :: rid_jbigald3 = 26 + integer, parameter :: rid_jbigald4 = 27 + integer, parameter :: rid_jbzooh = 28 + integer, parameter :: rid_jc2h5ooh = 29 + integer, parameter :: rid_jc3h7ooh = 30 + integer, parameter :: rid_jc6h5ooh = 31 + integer, parameter :: rid_jch2o_a = 32 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch3cho = 34 + integer, parameter :: rid_jacet = 35 + integer, parameter :: rid_jmgly = 36 + integer, parameter :: rid_jch3co3h = 37 + integer, parameter :: rid_jch3ooh = 38 + integer, parameter :: rid_jch4_a = 39 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jco2 = 41 + integer, parameter :: rid_jeooh = 42 + integer, parameter :: rid_jglyald = 43 + integer, parameter :: rid_jglyoxal = 44 + integer, parameter :: rid_jhonitr = 45 + integer, parameter :: rid_jhpald = 46 + integer, parameter :: rid_jhyac = 47 + integer, parameter :: rid_jisopnooh = 48 + integer, parameter :: rid_jisopooh = 49 + integer, parameter :: rid_jmacr_a = 50 + integer, parameter :: rid_jmacr_b = 51 + integer, parameter :: rid_jmek = 52 + integer, parameter :: rid_jmekooh = 53 + integer, parameter :: rid_jmpan = 54 + integer, parameter :: rid_jmvk = 55 + integer, parameter :: rid_jnc4cho = 56 + integer, parameter :: rid_jnoa = 57 + integer, parameter :: rid_jnterpooh = 58 + integer, parameter :: rid_jonitr = 59 + integer, parameter :: rid_jpan = 60 + integer, parameter :: rid_jphenooh = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jrooh = 63 + integer, parameter :: rid_jtepomuc = 64 + integer, parameter :: rid_jterp2ooh = 65 + integer, parameter :: rid_jterpnit = 66 + integer, parameter :: rid_jterpooh = 67 + integer, parameter :: rid_jterprd1 = 68 + integer, parameter :: rid_jterprd2 = 69 + integer, parameter :: rid_jtolooh = 70 + integer, parameter :: rid_jxooh = 71 + integer, parameter :: rid_jxylenooh = 72 + integer, parameter :: rid_jxylolooh = 73 + integer, parameter :: rid_jbrcl = 74 + integer, parameter :: rid_jbro = 75 + integer, parameter :: rid_jbrono2_b = 76 + integer, parameter :: rid_jbrono2_a = 77 + integer, parameter :: rid_jccl4 = 78 + integer, parameter :: rid_jcf2clbr = 79 + integer, parameter :: rid_jcf3br = 80 + integer, parameter :: rid_jcfcl3 = 81 + integer, parameter :: rid_jcfc113 = 82 + integer, parameter :: rid_jcfc114 = 83 + integer, parameter :: rid_jcfc115 = 84 + integer, parameter :: rid_jcf2cl2 = 85 + integer, parameter :: rid_jch2br2 = 86 + integer, parameter :: rid_jch3br = 87 + integer, parameter :: rid_jch3ccl3 = 88 + integer, parameter :: rid_jch3cl = 89 + integer, parameter :: rid_jchbr3 = 90 + integer, parameter :: rid_jcl2 = 91 + integer, parameter :: rid_jcl2o2 = 92 + integer, parameter :: rid_jclo = 93 + integer, parameter :: rid_jclono2_a = 94 + integer, parameter :: rid_jclono2_b = 95 + integer, parameter :: rid_jcof2 = 96 + integer, parameter :: rid_jcofcl = 97 + integer, parameter :: rid_jh2402 = 98 + integer, parameter :: rid_jhbr = 99 + integer, parameter :: rid_jhcfc141b = 100 + integer, parameter :: rid_jhcfc142b = 101 + integer, parameter :: rid_jhcfc22 = 102 + integer, parameter :: rid_jhcl = 103 + integer, parameter :: rid_jhf = 104 + integer, parameter :: rid_jhobr = 105 + integer, parameter :: rid_jhocl = 106 + integer, parameter :: rid_joclo = 107 + integer, parameter :: rid_jsf6 = 108 + integer, parameter :: rid_jh2so4 = 109 + integer, parameter :: rid_jocs = 110 + integer, parameter :: rid_jso = 111 + integer, parameter :: rid_jso2 = 112 + integer, parameter :: rid_jso3 = 113 + integer, parameter :: rid_jsoa1_a1 = 114 + integer, parameter :: rid_jsoa1_a2 = 115 + integer, parameter :: rid_jsoa2_a1 = 116 + integer, parameter :: rid_jsoa2_a2 = 117 + integer, parameter :: rid_jsoa3_a1 = 118 + integer, parameter :: rid_jsoa3_a2 = 119 + integer, parameter :: rid_jsoa4_a1 = 120 + integer, parameter :: rid_jsoa4_a2 = 121 + integer, parameter :: rid_jsoa5_a1 = 122 + integer, parameter :: rid_jsoa5_a2 = 123 + integer, parameter :: rid_O1D_H2 = 124 + integer, parameter :: rid_O1D_H2O = 125 + integer, parameter :: rid_O1D_N2 = 126 + integer, parameter :: rid_O1D_O2ab = 127 + integer, parameter :: rid_O1D_O3 = 128 + integer, parameter :: rid_O_O3 = 129 + integer, parameter :: rid_usr_O_O = 130 + integer, parameter :: rid_usr_O_O2 = 131 + integer, parameter :: rid_H2_O = 132 + integer, parameter :: rid_H2O2_O = 133 + integer, parameter :: rid_H_HO2 = 134 + integer, parameter :: rid_H_HO2a = 135 + integer, parameter :: rid_H_HO2b = 136 + integer, parameter :: rid_H_O2 = 137 + integer, parameter :: rid_HO2_O = 138 + integer, parameter :: rid_HO2_O3 = 139 + integer, parameter :: rid_H_O3 = 140 + integer, parameter :: rid_OH_H2 = 141 + integer, parameter :: rid_OH_H2O2 = 142 + integer, parameter :: rid_OH_HO2 = 143 + integer, parameter :: rid_OH_O = 144 + integer, parameter :: rid_OH_O3 = 145 + integer, parameter :: rid_OH_OH = 146 + integer, parameter :: rid_OH_OH_M = 147 + integer, parameter :: rid_usr_HO2_HO2 = 148 + integer, parameter :: rid_HO2NO2_OH = 149 + integer, parameter :: rid_N_NO = 150 + integer, parameter :: rid_N_NO2a = 151 + integer, parameter :: rid_N_NO2b = 152 + integer, parameter :: rid_N_NO2c = 153 + integer, parameter :: rid_N_O2 = 154 + integer, parameter :: rid_NO2_O = 155 + integer, parameter :: rid_NO2_O3 = 156 + integer, parameter :: rid_NO2_O_M = 157 + integer, parameter :: rid_NO3_HO2 = 158 + integer, parameter :: rid_NO3_NO = 159 + integer, parameter :: rid_NO3_O = 160 + integer, parameter :: rid_NO3_OH = 161 + integer, parameter :: rid_N_OH = 162 + integer, parameter :: rid_NO_HO2 = 163 + integer, parameter :: rid_NO_O3 = 164 + integer, parameter :: rid_NO_O_M = 165 + integer, parameter :: rid_O1D_N2Oa = 166 + integer, parameter :: rid_O1D_N2Ob = 167 + integer, parameter :: rid_tag_NO2_HO2 = 168 + integer, parameter :: rid_tag_NO2_NO3 = 169 + integer, parameter :: rid_tag_NO2_OH = 170 + integer, parameter :: rid_usr_HNO3_OH = 171 + integer, parameter :: rid_usr_HO2NO2_M = 172 + integer, parameter :: rid_usr_N2O5_M = 173 + integer, parameter :: rid_CL_CH2O = 174 + integer, parameter :: rid_CL_CH4 = 175 + integer, parameter :: rid_CL_H2 = 176 + integer, parameter :: rid_CL_H2O2 = 177 + integer, parameter :: rid_CL_HO2a = 178 + integer, parameter :: rid_CL_HO2b = 179 + integer, parameter :: rid_CL_O3 = 180 + integer, parameter :: rid_CLO_CH3O2 = 181 + integer, parameter :: rid_CLO_CLOa = 182 + integer, parameter :: rid_CLO_CLOb = 183 + integer, parameter :: rid_CLO_CLOc = 184 + integer, parameter :: rid_CLO_HO2 = 185 + integer, parameter :: rid_CLO_NO = 186 + integer, parameter :: rid_CLONO2_CL = 187 + integer, parameter :: rid_CLO_NO2_M = 188 + integer, parameter :: rid_CLONO2_O = 189 + integer, parameter :: rid_CLONO2_OH = 190 + integer, parameter :: rid_CLO_O = 191 + integer, parameter :: rid_CLO_OHa = 192 + integer, parameter :: rid_CLO_OHb = 193 + integer, parameter :: rid_HCL_O = 194 + integer, parameter :: rid_HCL_OH = 195 + integer, parameter :: rid_HOCL_CL = 196 + integer, parameter :: rid_HOCL_O = 197 + integer, parameter :: rid_HOCL_OH = 198 + integer, parameter :: rid_O1D_CCL4 = 199 + integer, parameter :: rid_O1D_CF2CLBR = 200 + integer, parameter :: rid_O1D_CFC11 = 201 + integer, parameter :: rid_O1D_CFC113 = 202 + integer, parameter :: rid_O1D_CFC114 = 203 + integer, parameter :: rid_O1D_CFC115 = 204 + integer, parameter :: rid_O1D_CFC12 = 205 + integer, parameter :: rid_O1D_HCLa = 206 + integer, parameter :: rid_O1D_HCLb = 207 + integer, parameter :: rid_tag_CLO_CLO_M = 208 + integer, parameter :: rid_usr_CL2O2_M = 209 + integer, parameter :: rid_BR_CH2O = 210 + integer, parameter :: rid_BR_HO2 = 211 + integer, parameter :: rid_BR_O3 = 212 + integer, parameter :: rid_BRO_BRO = 213 + integer, parameter :: rid_BRO_CLOa = 214 + integer, parameter :: rid_BRO_CLOb = 215 + integer, parameter :: rid_BRO_CLOc = 216 + integer, parameter :: rid_BRO_HO2 = 217 + integer, parameter :: rid_BRO_NO = 218 + integer, parameter :: rid_BRO_NO2_M = 219 + integer, parameter :: rid_BRONO2_O = 220 + integer, parameter :: rid_BRO_O = 221 + integer, parameter :: rid_BRO_OH = 222 + integer, parameter :: rid_HBR_O = 223 + integer, parameter :: rid_HBR_OH = 224 + integer, parameter :: rid_HOBR_O = 225 + integer, parameter :: rid_O1D_CF3BR = 226 + integer, parameter :: rid_O1D_CHBR3 = 227 + integer, parameter :: rid_O1D_H2402 = 228 + integer, parameter :: rid_O1D_HBRa = 229 + integer, parameter :: rid_O1D_HBRb = 230 + integer, parameter :: rid_F_CH4 = 231 + integer, parameter :: rid_F_H2 = 232 + integer, parameter :: rid_F_H2O = 233 + integer, parameter :: rid_F_HNO3 = 234 + integer, parameter :: rid_O1D_COF2 = 235 + integer, parameter :: rid_O1D_COFCL = 236 + integer, parameter :: rid_CH2BR2_CL = 237 + integer, parameter :: rid_CH2BR2_OH = 238 + integer, parameter :: rid_CH3BR_CL = 239 + integer, parameter :: rid_CH3BR_OH = 240 + integer, parameter :: rid_CH3CCL3_OH = 241 + integer, parameter :: rid_CH3CL_CL = 242 + integer, parameter :: rid_CH3CL_OH = 243 + integer, parameter :: rid_CHBR3_CL = 244 + integer, parameter :: rid_CHBR3_OH = 245 + integer, parameter :: rid_HCFC141B_OH = 246 + integer, parameter :: rid_HCFC142B_OH = 247 + integer, parameter :: rid_HCFC22_OH = 248 + integer, parameter :: rid_O1D_CH2BR2 = 249 + integer, parameter :: rid_O1D_CH3BR = 250 + integer, parameter :: rid_O1D_HCFC141B = 251 + integer, parameter :: rid_O1D_HCFC142B = 252 + integer, parameter :: rid_O1D_HCFC22 = 253 + integer, parameter :: rid_CH2O_HO2 = 254 + integer, parameter :: rid_CH2O_NO3 = 255 + integer, parameter :: rid_CH2O_O = 256 + integer, parameter :: rid_CH2O_OH = 257 + integer, parameter :: rid_CH3O2_CH3O2a = 258 + integer, parameter :: rid_CH3O2_CH3O2b = 259 + integer, parameter :: rid_CH3O2_HO2 = 260 + integer, parameter :: rid_CH3O2_NO = 261 + integer, parameter :: rid_CH3OH_OH = 262 + integer, parameter :: rid_CH3OOH_OH = 263 + integer, parameter :: rid_CH4_OH = 264 + integer, parameter :: rid_CO_OH_M = 265 + integer, parameter :: rid_HCN_OH = 266 + integer, parameter :: rid_HCOOH_OH = 267 + integer, parameter :: rid_HOCH2OO_HO2 = 268 + integer, parameter :: rid_HOCH2OO_M = 269 + integer, parameter :: rid_HOCH2OO_NO = 270 + integer, parameter :: rid_O1D_CH4a = 271 + integer, parameter :: rid_O1D_CH4b = 272 + integer, parameter :: rid_O1D_CH4c = 273 + integer, parameter :: rid_O1D_HCN = 274 + integer, parameter :: rid_usr_CO_OH_b = 275 + integer, parameter :: rid_C2H2_CL_M = 276 + integer, parameter :: rid_C2H2_OH_M = 277 + integer, parameter :: rid_C2H4_CL_M = 278 + integer, parameter :: rid_C2H4_O3 = 279 + integer, parameter :: rid_C2H5O2_C2H5O2 = 280 + integer, parameter :: rid_C2H5O2_CH3O2 = 281 + integer, parameter :: rid_C2H5O2_HO2 = 282 + integer, parameter :: rid_C2H5O2_NO = 283 + integer, parameter :: rid_C2H5OH_OH = 284 + integer, parameter :: rid_C2H5OOH_OH = 285 + integer, parameter :: rid_C2H6_CL = 286 + integer, parameter :: rid_C2H6_OH = 287 + integer, parameter :: rid_CH3CHO_NO3 = 288 + integer, parameter :: rid_CH3CHO_OH = 289 + integer, parameter :: rid_CH3CN_OH = 290 + integer, parameter :: rid_CH3CO3_CH3CO3 = 291 + integer, parameter :: rid_CH3CO3_CH3O2 = 292 + integer, parameter :: rid_CH3CO3_HO2 = 293 + integer, parameter :: rid_CH3CO3_NO = 294 + integer, parameter :: rid_CH3COOH_OH = 295 + integer, parameter :: rid_CH3COOOH_OH = 296 + integer, parameter :: rid_EO2_HO2 = 297 + integer, parameter :: rid_EO2_NO = 298 + integer, parameter :: rid_EO_M = 299 + integer, parameter :: rid_EO_O2 = 300 + integer, parameter :: rid_GLYALD_OH = 301 + integer, parameter :: rid_GLYOXAL_OH = 302 + integer, parameter :: rid_PAN_OH = 303 + integer, parameter :: rid_tag_C2H4_OH = 304 + integer, parameter :: rid_tag_CH3CO3_NO2 = 305 + integer, parameter :: rid_usr_PAN_M = 306 + integer, parameter :: rid_C3H6_NO3 = 307 + integer, parameter :: rid_C3H6_O3 = 308 + integer, parameter :: rid_C3H7O2_CH3O2 = 309 + integer, parameter :: rid_C3H7O2_HO2 = 310 + integer, parameter :: rid_C3H7O2_NO = 311 + integer, parameter :: rid_C3H7OOH_OH = 312 + integer, parameter :: rid_C3H8_OH = 313 + integer, parameter :: rid_CH3COCHO_NO3 = 314 + integer, parameter :: rid_CH3COCHO_OH = 315 + integer, parameter :: rid_HYAC_OH = 316 + integer, parameter :: rid_NOA_OH = 317 + integer, parameter :: rid_PO2_HO2 = 318 + integer, parameter :: rid_PO2_NO = 319 + integer, parameter :: rid_POOH_OH = 320 + integer, parameter :: rid_RO2_CH3O2 = 321 + integer, parameter :: rid_RO2_HO2 = 322 + integer, parameter :: rid_RO2_NO = 323 + integer, parameter :: rid_ROOH_OH = 324 + integer, parameter :: rid_tag_C3H6_OH = 325 + integer, parameter :: rid_usr_CH3COCH3_OH = 326 + integer, parameter :: rid_BIGENE_NO3 = 327 + integer, parameter :: rid_BIGENE_OH = 328 + integer, parameter :: rid_ENEO2_NO = 329 + integer, parameter :: rid_ENEO2_NOb = 330 + integer, parameter :: rid_HONITR_OH = 331 + integer, parameter :: rid_MACRO2_CH3CO3 = 332 + integer, parameter :: rid_MACRO2_CH3O2 = 333 + integer, parameter :: rid_MACRO2_HO2 = 334 + integer, parameter :: rid_MACRO2_NO3 = 335 + integer, parameter :: rid_MACRO2_NOa = 336 + integer, parameter :: rid_MACRO2_NOb = 337 + integer, parameter :: rid_MACR_O3 = 338 + integer, parameter :: rid_MACR_OH = 339 + integer, parameter :: rid_MACROOH_OH = 340 + integer, parameter :: rid_MCO3_CH3CO3 = 341 + integer, parameter :: rid_MCO3_CH3O2 = 342 + integer, parameter :: rid_MCO3_HO2 = 343 + integer, parameter :: rid_MCO3_MCO3 = 344 + integer, parameter :: rid_MCO3_NO = 345 + integer, parameter :: rid_MCO3_NO3 = 346 + integer, parameter :: rid_MEKO2_HO2 = 347 + integer, parameter :: rid_MEKO2_NO = 348 + integer, parameter :: rid_MEK_OH = 349 + integer, parameter :: rid_MEKOOH_OH = 350 + integer, parameter :: rid_MPAN_OH_M = 351 + integer, parameter :: rid_MVK_O3 = 352 + integer, parameter :: rid_MVK_OH = 353 + integer, parameter :: rid_usr_MCO3_NO2 = 354 + integer, parameter :: rid_usr_MPAN_M = 355 + integer, parameter :: rid_ALKNIT_OH = 356 + integer, parameter :: rid_ALKO2_HO2 = 357 + integer, parameter :: rid_ALKO2_NO = 358 + integer, parameter :: rid_ALKO2_NOb = 359 + integer, parameter :: rid_ALKOOH_OH = 360 + integer, parameter :: rid_BIGALK_OH = 361 + integer, parameter :: rid_HPALD_OH = 362 + integer, parameter :: rid_HYDRALD_OH = 363 + integer, parameter :: rid_IEPOX_OH = 364 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 365 + integer, parameter :: rid_ISOPAO2_CH3O2 = 366 + integer, parameter :: rid_ISOPAO2_HO2 = 367 + integer, parameter :: rid_ISOPAO2_NO = 368 + integer, parameter :: rid_ISOPAO2_NO3 = 369 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 370 + integer, parameter :: rid_ISOPBO2_CH3O2 = 371 + integer, parameter :: rid_ISOPBO2_HO2 = 372 + integer, parameter :: rid_ISOPBO2_M = 373 + integer, parameter :: rid_ISOPBO2_NO = 374 + integer, parameter :: rid_ISOPBO2_NO3 = 375 + integer, parameter :: rid_ISOPNITA_OH = 376 + integer, parameter :: rid_ISOPNITB_OH = 377 + integer, parameter :: rid_ISOP_NO3 = 378 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 379 + integer, parameter :: rid_ISOPNO3_CH3O2 = 380 + integer, parameter :: rid_ISOPNO3_HO2 = 381 + integer, parameter :: rid_ISOPNO3_NO = 382 + integer, parameter :: rid_ISOPNO3_NO3 = 383 + integer, parameter :: rid_ISOPNOOH_OH = 384 + integer, parameter :: rid_ISOP_O3 = 385 + integer, parameter :: rid_ISOP_OH = 386 + integer, parameter :: rid_ISOPOOH_OH = 387 + integer, parameter :: rid_NC4CH2OH_OH = 388 + integer, parameter :: rid_NC4CHO_OH = 389 + integer, parameter :: rid_XO2_CH3CO3 = 390 + integer, parameter :: rid_XO2_CH3O2 = 391 + integer, parameter :: rid_XO2_HO2 = 392 + integer, parameter :: rid_XO2_NO = 393 + integer, parameter :: rid_XO2_NO3 = 394 + integer, parameter :: rid_XOOH_OH = 395 + integer, parameter :: rid_ACBZO2_HO2 = 396 + integer, parameter :: rid_ACBZO2_NO = 397 + integer, parameter :: rid_BENZENE_OH = 398 + integer, parameter :: rid_BENZO2_HO2 = 399 + integer, parameter :: rid_BENZO2_NO = 400 + integer, parameter :: rid_BENZOOH_OH = 401 + integer, parameter :: rid_BZALD_OH = 402 + integer, parameter :: rid_BZOO_HO2 = 403 + integer, parameter :: rid_BZOOH_OH = 404 + integer, parameter :: rid_BZOO_NO = 405 + integer, parameter :: rid_C6H5O2_HO2 = 406 + integer, parameter :: rid_C6H5O2_NO = 407 + integer, parameter :: rid_C6H5OOH_OH = 408 + integer, parameter :: rid_CRESOL_OH = 409 + integer, parameter :: rid_DICARBO2_HO2 = 410 + integer, parameter :: rid_DICARBO2_NO = 411 + integer, parameter :: rid_DICARBO2_NO2 = 412 + integer, parameter :: rid_MALO2_HO2 = 413 + integer, parameter :: rid_MALO2_NO = 414 + integer, parameter :: rid_MALO2_NO2 = 415 + integer, parameter :: rid_MDIALO2_HO2 = 416 + integer, parameter :: rid_MDIALO2_NO = 417 + integer, parameter :: rid_MDIALO2_NO2 = 418 + integer, parameter :: rid_PHENO2_HO2 = 419 + integer, parameter :: rid_PHENO2_NO = 420 + integer, parameter :: rid_PHENOL_OH = 421 + integer, parameter :: rid_PHENO_NO2 = 422 + integer, parameter :: rid_PHENO_O3 = 423 + integer, parameter :: rid_PHENOOH_OH = 424 + integer, parameter :: rid_tag_ACBZO2_NO2 = 425 + integer, parameter :: rid_TOLO2_HO2 = 426 + integer, parameter :: rid_TOLO2_NO = 427 + integer, parameter :: rid_TOLOOH_OH = 428 + integer, parameter :: rid_TOLUENE_OH = 429 + integer, parameter :: rid_usr_PBZNIT_M = 430 + integer, parameter :: rid_XYLENES_OH = 431 + integer, parameter :: rid_XYLENO2_HO2 = 432 + integer, parameter :: rid_XYLENO2_NO = 433 + integer, parameter :: rid_XYLENOOH_OH = 434 + integer, parameter :: rid_XYLOLO2_HO2 = 435 + integer, parameter :: rid_XYLOLO2_NO = 436 + integer, parameter :: rid_XYLOL_OH = 437 + integer, parameter :: rid_XYLOLOOH_OH = 438 + integer, parameter :: rid_BCARY_NO3 = 439 + integer, parameter :: rid_BCARY_O3 = 440 + integer, parameter :: rid_BCARY_OH = 441 + integer, parameter :: rid_MTERP_NO3 = 442 + integer, parameter :: rid_MTERP_O3 = 443 + integer, parameter :: rid_MTERP_OH = 444 + integer, parameter :: rid_NTERPO2_CH3O2 = 445 + integer, parameter :: rid_NTERPO2_HO2 = 446 + integer, parameter :: rid_NTERPO2_NO = 447 + integer, parameter :: rid_NTERPO2_NO3 = 448 + integer, parameter :: rid_NTERPOOH_OH = 449 + integer, parameter :: rid_TERP2O2_CH3O2 = 450 + integer, parameter :: rid_TERP2O2_HO2 = 451 + integer, parameter :: rid_TERP2O2_NO = 452 + integer, parameter :: rid_TERP2OOH_OH = 453 + integer, parameter :: rid_TERPNIT_OH = 454 + integer, parameter :: rid_TERPO2_CH3O2 = 455 + integer, parameter :: rid_TERPO2_HO2 = 456 + integer, parameter :: rid_TERPO2_NO = 457 + integer, parameter :: rid_TERPOOH_OH = 458 + integer, parameter :: rid_TERPROD1_NO3 = 459 + integer, parameter :: rid_TERPROD1_OH = 460 + integer, parameter :: rid_TERPROD2_OH = 461 + integer, parameter :: rid_OCS_O = 462 + integer, parameter :: rid_OCS_OH = 463 + integer, parameter :: rid_S_O2 = 464 + integer, parameter :: rid_S_O3 = 465 + integer, parameter :: rid_SO_BRO = 466 + integer, parameter :: rid_SO_CLO = 467 + integer, parameter :: rid_S_OH = 468 + integer, parameter :: rid_SO_NO2 = 469 + integer, parameter :: rid_SO_O2 = 470 + integer, parameter :: rid_SO_O3 = 471 + integer, parameter :: rid_SO_OCLO = 472 + integer, parameter :: rid_SO_OH = 473 + integer, parameter :: rid_usr_SO2_OH = 474 + integer, parameter :: rid_usr_SO3_H2O = 475 + integer, parameter :: rid_DMS_NO3 = 476 + integer, parameter :: rid_DMS_OHa = 477 + integer, parameter :: rid_NH3_OH = 478 + integer, parameter :: rid_usr_DMS_OH = 479 + integer, parameter :: rid_usr_GLYOXAL_aer = 480 + integer, parameter :: rid_usr_HO2_aer = 481 + integer, parameter :: rid_usr_HONITR_aer = 482 + integer, parameter :: rid_usr_ISOPNITA_aer = 483 + integer, parameter :: rid_usr_ISOPNITB_aer = 484 + integer, parameter :: rid_usr_N2O5_aer = 485 + integer, parameter :: rid_usr_NC4CH2OH_aer = 486 + integer, parameter :: rid_usr_NC4CHO_aer = 487 + integer, parameter :: rid_usr_NH4_strat_tau = 488 + integer, parameter :: rid_usr_NO2_aer = 489 + integer, parameter :: rid_usr_NO3_aer = 490 + integer, parameter :: rid_usr_NTERPOOH_aer = 491 + integer, parameter :: rid_usr_ONITR_aer = 492 + integer, parameter :: rid_usr_TERPNIT_aer = 493 + integer, parameter :: rid_BCARY_NO3_vbs = 494 + integer, parameter :: rid_BCARY_O3_vbs = 495 + integer, parameter :: rid_BCARY_OH_vbs = 496 + integer, parameter :: rid_BENZENE_OH_vbs = 497 + integer, parameter :: rid_ISOP_NO3_vbs = 498 + integer, parameter :: rid_ISOP_O3_vbs = 499 + integer, parameter :: rid_ISOP_OH_vbs = 500 + integer, parameter :: rid_IVOC_OH = 501 + integer, parameter :: rid_MTERP_NO3_vbs = 502 + integer, parameter :: rid_MTERP_O3_vbs = 503 + integer, parameter :: rid_MTERP_OH_vbs = 504 + integer, parameter :: rid_SVOC_OH = 505 + integer, parameter :: rid_TOLUENE_OH_vbs = 506 + integer, parameter :: rid_XYLENES_OH_vbs = 507 + integer, parameter :: rid_het1 = 508 + integer, parameter :: rid_het10 = 509 + integer, parameter :: rid_het11 = 510 + integer, parameter :: rid_het12 = 511 + integer, parameter :: rid_het13 = 512 + integer, parameter :: rid_het14 = 513 + integer, parameter :: rid_het15 = 514 + integer, parameter :: rid_het16 = 515 + integer, parameter :: rid_het17 = 516 + integer, parameter :: rid_het2 = 517 + integer, parameter :: rid_het3 = 518 + integer, parameter :: rid_het4 = 519 + integer, parameter :: rid_het5 = 520 + integer, parameter :: rid_het6 = 521 + integer, parameter :: rid_het7 = 522 + integer, parameter :: rid_het8 = 523 + integer, parameter :: rid_het9 = 524 + integer, parameter :: rid_E90_tau = 525 + integer, parameter :: rid_NH_50_tau = 526 + integer, parameter :: rid_NH_5_tau = 527 + integer, parameter :: rid_ST80_25_tau = 528 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 new file mode 100644 index 0000000000..dfdbdcd20e --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/m_spc_id.F90 @@ -0,0 +1,224 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BENZENE = 7 + integer, parameter :: id_BENZOOH = 8 + integer, parameter :: id_BEPOMUC = 9 + integer, parameter :: id_BIGALD = 10 + integer, parameter :: id_BIGALD1 = 11 + integer, parameter :: id_BIGALD2 = 12 + integer, parameter :: id_BIGALD3 = 13 + integer, parameter :: id_BIGALD4 = 14 + integer, parameter :: id_BIGALK = 15 + integer, parameter :: id_BIGENE = 16 + integer, parameter :: id_BR = 17 + integer, parameter :: id_BRCL = 18 + integer, parameter :: id_BRO = 19 + integer, parameter :: id_BRONO2 = 20 + integer, parameter :: id_BRY = 21 + integer, parameter :: id_BZALD = 22 + integer, parameter :: id_BZOOH = 23 + integer, parameter :: id_C2H2 = 24 + integer, parameter :: id_C2H4 = 25 + integer, parameter :: id_C2H5OH = 26 + integer, parameter :: id_C2H5OOH = 27 + integer, parameter :: id_C2H6 = 28 + integer, parameter :: id_C3H6 = 29 + integer, parameter :: id_C3H7OOH = 30 + integer, parameter :: id_C3H8 = 31 + integer, parameter :: id_C6H5OOH = 32 + integer, parameter :: id_CCL4 = 33 + integer, parameter :: id_CF2CLBR = 34 + integer, parameter :: id_CF3BR = 35 + integer, parameter :: id_CFC11 = 36 + integer, parameter :: id_CFC113 = 37 + integer, parameter :: id_CFC114 = 38 + integer, parameter :: id_CFC115 = 39 + integer, parameter :: id_CFC12 = 40 + integer, parameter :: id_CH2BR2 = 41 + integer, parameter :: id_CH2O = 42 + integer, parameter :: id_CH3BR = 43 + integer, parameter :: id_CH3CCL3 = 44 + integer, parameter :: id_CH3CHO = 45 + integer, parameter :: id_CH3CL = 46 + integer, parameter :: id_CH3CN = 47 + integer, parameter :: id_CH3COCH3 = 48 + integer, parameter :: id_CH3COCHO = 49 + integer, parameter :: id_CH3COOH = 50 + integer, parameter :: id_CH3COOOH = 51 + integer, parameter :: id_CH3OH = 52 + integer, parameter :: id_CH3OOH = 53 + integer, parameter :: id_CH4 = 54 + integer, parameter :: id_CHBR3 = 55 + integer, parameter :: id_CL = 56 + integer, parameter :: id_CL2 = 57 + integer, parameter :: id_CL2O2 = 58 + integer, parameter :: id_CLO = 59 + integer, parameter :: id_CLONO2 = 60 + integer, parameter :: id_CLY = 61 + integer, parameter :: id_CO = 62 + integer, parameter :: id_CO2 = 63 + integer, parameter :: id_COF2 = 64 + integer, parameter :: id_COFCL = 65 + integer, parameter :: id_CRESOL = 66 + integer, parameter :: id_DMS = 67 + integer, parameter :: id_dst_a1 = 68 + integer, parameter :: id_dst_a2 = 69 + integer, parameter :: id_dst_a3 = 70 + integer, parameter :: id_E90 = 71 + integer, parameter :: id_EOOH = 72 + integer, parameter :: id_F = 73 + integer, parameter :: id_GLYALD = 74 + integer, parameter :: id_GLYOXAL = 75 + integer, parameter :: id_H = 76 + integer, parameter :: id_H2 = 77 + integer, parameter :: id_H2402 = 78 + integer, parameter :: id_H2O2 = 79 + integer, parameter :: id_H2SO4 = 80 + integer, parameter :: id_HBR = 81 + integer, parameter :: id_HCFC141B = 82 + integer, parameter :: id_HCFC142B = 83 + integer, parameter :: id_HCFC22 = 84 + integer, parameter :: id_HCL = 85 + integer, parameter :: id_HCN = 86 + integer, parameter :: id_HCOOH = 87 + integer, parameter :: id_HF = 88 + integer, parameter :: id_HNO3 = 89 + integer, parameter :: id_HO2NO2 = 90 + integer, parameter :: id_HOBR = 91 + integer, parameter :: id_HOCL = 92 + integer, parameter :: id_HONITR = 93 + integer, parameter :: id_HPALD = 94 + integer, parameter :: id_HYAC = 95 + integer, parameter :: id_HYDRALD = 96 + integer, parameter :: id_IEPOX = 97 + integer, parameter :: id_ISOP = 98 + integer, parameter :: id_ISOPNITA = 99 + integer, parameter :: id_ISOPNITB = 100 + integer, parameter :: id_ISOPNO3 = 101 + integer, parameter :: id_ISOPNOOH = 102 + integer, parameter :: id_ISOPOOH = 103 + integer, parameter :: id_IVOC = 104 + integer, parameter :: id_MACR = 105 + integer, parameter :: id_MACROOH = 106 + integer, parameter :: id_MEK = 107 + integer, parameter :: id_MEKOOH = 108 + integer, parameter :: id_MPAN = 109 + integer, parameter :: id_MTERP = 110 + integer, parameter :: id_MVK = 111 + integer, parameter :: id_N = 112 + integer, parameter :: id_N2O = 113 + integer, parameter :: id_N2O5 = 114 + integer, parameter :: id_NC4CH2OH = 115 + integer, parameter :: id_NC4CHO = 116 + integer, parameter :: id_ncl_a1 = 117 + integer, parameter :: id_ncl_a2 = 118 + integer, parameter :: id_ncl_a3 = 119 + integer, parameter :: id_NH3 = 120 + integer, parameter :: id_NH4 = 121 + integer, parameter :: id_NH_5 = 122 + integer, parameter :: id_NH_50 = 123 + integer, parameter :: id_NO = 124 + integer, parameter :: id_NO2 = 125 + integer, parameter :: id_NO3 = 126 + integer, parameter :: id_NOA = 127 + integer, parameter :: id_NTERPOOH = 128 + integer, parameter :: id_num_a1 = 129 + integer, parameter :: id_num_a2 = 130 + integer, parameter :: id_num_a3 = 131 + integer, parameter :: id_num_a4 = 132 + integer, parameter :: id_O = 133 + integer, parameter :: id_O3 = 134 + integer, parameter :: id_OCLO = 135 + integer, parameter :: id_OCS = 136 + integer, parameter :: id_ONITR = 137 + integer, parameter :: id_PAN = 138 + integer, parameter :: id_PBZNIT = 139 + integer, parameter :: id_PHENO = 140 + integer, parameter :: id_PHENOL = 141 + integer, parameter :: id_PHENOOH = 142 + integer, parameter :: id_pom_a1 = 143 + integer, parameter :: id_pom_a4 = 144 + integer, parameter :: id_POOH = 145 + integer, parameter :: id_ROOH = 146 + integer, parameter :: id_S = 147 + integer, parameter :: id_SF6 = 148 + integer, parameter :: id_SO = 149 + integer, parameter :: id_SO2 = 150 + integer, parameter :: id_SO3 = 151 + integer, parameter :: id_so4_a1 = 152 + integer, parameter :: id_so4_a2 = 153 + integer, parameter :: id_so4_a3 = 154 + integer, parameter :: id_soa1_a1 = 155 + integer, parameter :: id_soa1_a2 = 156 + integer, parameter :: id_soa2_a1 = 157 + integer, parameter :: id_soa2_a2 = 158 + integer, parameter :: id_soa3_a1 = 159 + integer, parameter :: id_soa3_a2 = 160 + integer, parameter :: id_soa4_a1 = 161 + integer, parameter :: id_soa4_a2 = 162 + integer, parameter :: id_soa5_a1 = 163 + integer, parameter :: id_soa5_a2 = 164 + integer, parameter :: id_SOAG0 = 165 + integer, parameter :: id_SOAG1 = 166 + integer, parameter :: id_SOAG2 = 167 + integer, parameter :: id_SOAG3 = 168 + integer, parameter :: id_SOAG4 = 169 + integer, parameter :: id_ST80_25 = 170 + integer, parameter :: id_SVOC = 171 + integer, parameter :: id_TEPOMUC = 172 + integer, parameter :: id_TERP2OOH = 173 + integer, parameter :: id_TERPNIT = 174 + integer, parameter :: id_TERPOOH = 175 + integer, parameter :: id_TERPROD1 = 176 + integer, parameter :: id_TERPROD2 = 177 + integer, parameter :: id_TOLOOH = 178 + integer, parameter :: id_TOLUENE = 179 + integer, parameter :: id_XOOH = 180 + integer, parameter :: id_XYLENES = 181 + integer, parameter :: id_XYLENOOH = 182 + integer, parameter :: id_XYLOL = 183 + integer, parameter :: id_XYLOLOOH = 184 + integer, parameter :: id_NHDEP = 185 + integer, parameter :: id_NDEP = 186 + integer, parameter :: id_ACBZO2 = 187 + integer, parameter :: id_ALKO2 = 188 + integer, parameter :: id_BENZO2 = 189 + integer, parameter :: id_BZOO = 190 + integer, parameter :: id_C2H5O2 = 191 + integer, parameter :: id_C3H7O2 = 192 + integer, parameter :: id_C6H5O2 = 193 + integer, parameter :: id_CH3CO3 = 194 + integer, parameter :: id_CH3O2 = 195 + integer, parameter :: id_DICARBO2 = 196 + integer, parameter :: id_ENEO2 = 197 + integer, parameter :: id_EO = 198 + integer, parameter :: id_EO2 = 199 + integer, parameter :: id_HO2 = 200 + integer, parameter :: id_HOCH2OO = 201 + integer, parameter :: id_ISOPAO2 = 202 + integer, parameter :: id_ISOPBO2 = 203 + integer, parameter :: id_MACRO2 = 204 + integer, parameter :: id_MALO2 = 205 + integer, parameter :: id_MCO3 = 206 + integer, parameter :: id_MDIALO2 = 207 + integer, parameter :: id_MEKO2 = 208 + integer, parameter :: id_NTERPO2 = 209 + integer, parameter :: id_O1D = 210 + integer, parameter :: id_OH = 211 + integer, parameter :: id_PHENO2 = 212 + integer, parameter :: id_PO2 = 213 + integer, parameter :: id_RO2 = 214 + integer, parameter :: id_TERP2O2 = 215 + integer, parameter :: id_TERPO2 = 216 + integer, parameter :: id_TOLO2 = 217 + integer, parameter :: id_XO2 = 218 + integer, parameter :: id_XYLENO2 = 219 + integer, parameter :: id_XYLOLO2 = 220 + integer, parameter :: id_H2O = 221 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 new file mode 100644 index 0000000000..177d6d717b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 @@ -0,0 +1,416 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:,126) = rate(:,:,126) * inv(:,:, 2) + rate(:,:,127) = rate(:,:,127) * inv(:,:, 3) + rate(:,:,130) = rate(:,:,130) * inv(:,:, 1) + rate(:,:,147) = rate(:,:,147) * inv(:,:, 1) + rate(:,:,154) = rate(:,:,154) * inv(:,:, 3) + rate(:,:,157) = rate(:,:,157) * inv(:,:, 1) + rate(:,:,165) = rate(:,:,165) * inv(:,:, 1) + rate(:,:,168) = rate(:,:,168) * inv(:,:, 1) + rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) + rate(:,:,170) = rate(:,:,170) * inv(:,:, 1) + rate(:,:,172) = rate(:,:,172) * inv(:,:, 1) + rate(:,:,173) = rate(:,:,173) * inv(:,:, 1) + rate(:,:,188) = rate(:,:,188) * inv(:,:, 1) + rate(:,:,208) = rate(:,:,208) * inv(:,:, 1) + rate(:,:,209) = rate(:,:,209) * inv(:,:, 1) + rate(:,:,219) = rate(:,:,219) * inv(:,:, 1) + rate(:,:,265) = rate(:,:,265) * inv(:,:, 1) + rate(:,:,266) = rate(:,:,266) * inv(:,:, 1) + rate(:,:,276) = rate(:,:,276) * inv(:,:, 1) + rate(:,:,277) = rate(:,:,277) * inv(:,:, 1) + rate(:,:,278) = rate(:,:,278) * inv(:,:, 1) + rate(:,:,300) = rate(:,:,300) * inv(:,:, 3) + rate(:,:,304) = rate(:,:,304) * inv(:,:, 1) + rate(:,:,305) = rate(:,:,305) * inv(:,:, 1) + rate(:,:,306) = rate(:,:,306) * inv(:,:, 1) + rate(:,:,325) = rate(:,:,325) * inv(:,:, 1) + rate(:,:,351) = rate(:,:,351) * inv(:,:, 1) + rate(:,:,354) = rate(:,:,354) * inv(:,:, 1) + rate(:,:,355) = rate(:,:,355) * inv(:,:, 1) + rate(:,:,412) = rate(:,:,412) * inv(:,:, 1) + rate(:,:,415) = rate(:,:,415) * inv(:,:, 1) + rate(:,:,418) = rate(:,:,418) * inv(:,:, 1) + rate(:,:,425) = rate(:,:,425) * inv(:,:, 1) + rate(:,:,430) = rate(:,:,430) * inv(:,:, 1) + rate(:,:,464) = rate(:,:,464) * inv(:,:, 3) + rate(:,:,470) = rate(:,:,470) * inv(:,:, 3) + rate(:,:,131) = rate(:,:,131) * inv(:,:, 3) * inv(:,:, 1) + rate(:,:,137) = rate(:,:,137) * inv(:,:, 3) * inv(:,:, 1) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,264) = rate(:,:,264) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,274) = rate(:,:,274) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,277) = rate(:,:,277) * m(:,:) + rate(:,:,278) = rate(:,:,278) * m(:,:) + rate(:,:,279) = rate(:,:,279) * m(:,:) + rate(:,:,280) = rate(:,:,280) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,285) = rate(:,:,285) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,288) = rate(:,:,288) * m(:,:) + rate(:,:,289) = rate(:,:,289) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,292) = rate(:,:,292) * m(:,:) + rate(:,:,293) = rate(:,:,293) * m(:,:) + rate(:,:,294) = rate(:,:,294) * m(:,:) + rate(:,:,295) = rate(:,:,295) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + rate(:,:,301) = rate(:,:,301) * m(:,:) + rate(:,:,302) = rate(:,:,302) * m(:,:) + rate(:,:,303) = rate(:,:,303) * m(:,:) + rate(:,:,304) = rate(:,:,304) * m(:,:) + rate(:,:,305) = rate(:,:,305) * m(:,:) + rate(:,:,307) = rate(:,:,307) * m(:,:) + rate(:,:,308) = rate(:,:,308) * m(:,:) + rate(:,:,309) = rate(:,:,309) * m(:,:) + rate(:,:,310) = rate(:,:,310) * m(:,:) + rate(:,:,311) = rate(:,:,311) * m(:,:) + rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:,313) = rate(:,:,313) * m(:,:) + rate(:,:,314) = rate(:,:,314) * m(:,:) + rate(:,:,315) = rate(:,:,315) * m(:,:) + rate(:,:,316) = rate(:,:,316) * m(:,:) + rate(:,:,317) = rate(:,:,317) * m(:,:) + rate(:,:,318) = rate(:,:,318) * m(:,:) + rate(:,:,319) = rate(:,:,319) * m(:,:) + rate(:,:,320) = rate(:,:,320) * m(:,:) + rate(:,:,321) = rate(:,:,321) * m(:,:) + rate(:,:,322) = rate(:,:,322) * m(:,:) + rate(:,:,323) = rate(:,:,323) * m(:,:) + rate(:,:,324) = rate(:,:,324) * m(:,:) + rate(:,:,325) = rate(:,:,325) * m(:,:) + rate(:,:,326) = rate(:,:,326) * m(:,:) + rate(:,:,327) = rate(:,:,327) * m(:,:) + rate(:,:,328) = rate(:,:,328) * m(:,:) + rate(:,:,329) = rate(:,:,329) * m(:,:) + rate(:,:,330) = rate(:,:,330) * m(:,:) + rate(:,:,331) = rate(:,:,331) * m(:,:) + rate(:,:,332) = rate(:,:,332) * m(:,:) + rate(:,:,333) = rate(:,:,333) * m(:,:) + rate(:,:,334) = rate(:,:,334) * m(:,:) + rate(:,:,335) = rate(:,:,335) * m(:,:) + rate(:,:,336) = rate(:,:,336) * m(:,:) + rate(:,:,337) = rate(:,:,337) * m(:,:) + rate(:,:,338) = rate(:,:,338) * m(:,:) + rate(:,:,339) = rate(:,:,339) * m(:,:) + rate(:,:,340) = rate(:,:,340) * m(:,:) + rate(:,:,341) = rate(:,:,341) * m(:,:) + rate(:,:,342) = rate(:,:,342) * m(:,:) + rate(:,:,343) = rate(:,:,343) * m(:,:) + rate(:,:,344) = rate(:,:,344) * m(:,:) + rate(:,:,345) = rate(:,:,345) * m(:,:) + rate(:,:,346) = rate(:,:,346) * m(:,:) + rate(:,:,347) = rate(:,:,347) * m(:,:) + rate(:,:,348) = rate(:,:,348) * m(:,:) + rate(:,:,349) = rate(:,:,349) * m(:,:) + rate(:,:,350) = rate(:,:,350) * m(:,:) + rate(:,:,351) = rate(:,:,351) * m(:,:) + rate(:,:,352) = rate(:,:,352) * m(:,:) + rate(:,:,353) = rate(:,:,353) * m(:,:) + rate(:,:,354) = rate(:,:,354) * m(:,:) + rate(:,:,356) = rate(:,:,356) * m(:,:) + rate(:,:,357) = rate(:,:,357) * m(:,:) + rate(:,:,358) = rate(:,:,358) * m(:,:) + rate(:,:,359) = rate(:,:,359) * m(:,:) + rate(:,:,360) = rate(:,:,360) * m(:,:) + rate(:,:,361) = rate(:,:,361) * m(:,:) + rate(:,:,362) = rate(:,:,362) * m(:,:) + rate(:,:,363) = rate(:,:,363) * m(:,:) + rate(:,:,364) = rate(:,:,364) * m(:,:) + rate(:,:,365) = rate(:,:,365) * m(:,:) + rate(:,:,366) = rate(:,:,366) * m(:,:) + rate(:,:,367) = rate(:,:,367) * m(:,:) + rate(:,:,368) = rate(:,:,368) * m(:,:) + rate(:,:,369) = rate(:,:,369) * m(:,:) + rate(:,:,370) = rate(:,:,370) * m(:,:) + rate(:,:,371) = rate(:,:,371) * m(:,:) + rate(:,:,372) = rate(:,:,372) * m(:,:) + rate(:,:,374) = rate(:,:,374) * m(:,:) + rate(:,:,375) = rate(:,:,375) * m(:,:) + rate(:,:,376) = rate(:,:,376) * m(:,:) + rate(:,:,377) = rate(:,:,377) * m(:,:) + rate(:,:,378) = rate(:,:,378) * m(:,:) + rate(:,:,379) = rate(:,:,379) * m(:,:) + rate(:,:,380) = rate(:,:,380) * m(:,:) + rate(:,:,381) = rate(:,:,381) * m(:,:) + rate(:,:,382) = rate(:,:,382) * m(:,:) + rate(:,:,383) = rate(:,:,383) * m(:,:) + rate(:,:,384) = rate(:,:,384) * m(:,:) + rate(:,:,385) = rate(:,:,385) * m(:,:) + rate(:,:,386) = rate(:,:,386) * m(:,:) + rate(:,:,387) = rate(:,:,387) * m(:,:) + rate(:,:,388) = rate(:,:,388) * m(:,:) + rate(:,:,389) = rate(:,:,389) * m(:,:) + rate(:,:,390) = rate(:,:,390) * m(:,:) + rate(:,:,391) = rate(:,:,391) * m(:,:) + rate(:,:,392) = rate(:,:,392) * m(:,:) + rate(:,:,393) = rate(:,:,393) * m(:,:) + rate(:,:,394) = rate(:,:,394) * m(:,:) + rate(:,:,395) = rate(:,:,395) * m(:,:) + rate(:,:,396) = rate(:,:,396) * m(:,:) + rate(:,:,397) = rate(:,:,397) * m(:,:) + rate(:,:,398) = rate(:,:,398) * m(:,:) + rate(:,:,399) = rate(:,:,399) * m(:,:) + rate(:,:,400) = rate(:,:,400) * m(:,:) + rate(:,:,401) = rate(:,:,401) * m(:,:) + rate(:,:,402) = rate(:,:,402) * m(:,:) + rate(:,:,403) = rate(:,:,403) * m(:,:) + rate(:,:,404) = rate(:,:,404) * m(:,:) + rate(:,:,405) = rate(:,:,405) * m(:,:) + rate(:,:,406) = rate(:,:,406) * m(:,:) + rate(:,:,407) = rate(:,:,407) * m(:,:) + rate(:,:,408) = rate(:,:,408) * m(:,:) + rate(:,:,409) = rate(:,:,409) * m(:,:) + rate(:,:,410) = rate(:,:,410) * m(:,:) + rate(:,:,411) = rate(:,:,411) * m(:,:) + rate(:,:,412) = rate(:,:,412) * m(:,:) + rate(:,:,413) = rate(:,:,413) * m(:,:) + rate(:,:,414) = rate(:,:,414) * m(:,:) + rate(:,:,415) = rate(:,:,415) * m(:,:) + rate(:,:,416) = rate(:,:,416) * m(:,:) + rate(:,:,417) = rate(:,:,417) * m(:,:) + rate(:,:,418) = rate(:,:,418) * m(:,:) + rate(:,:,419) = rate(:,:,419) * m(:,:) + rate(:,:,420) = rate(:,:,420) * m(:,:) + rate(:,:,421) = rate(:,:,421) * m(:,:) + rate(:,:,422) = rate(:,:,422) * m(:,:) + rate(:,:,423) = rate(:,:,423) * m(:,:) + rate(:,:,424) = rate(:,:,424) * m(:,:) + rate(:,:,425) = rate(:,:,425) * m(:,:) + rate(:,:,426) = rate(:,:,426) * m(:,:) + rate(:,:,427) = rate(:,:,427) * m(:,:) + rate(:,:,428) = rate(:,:,428) * m(:,:) + rate(:,:,429) = rate(:,:,429) * m(:,:) + rate(:,:,431) = rate(:,:,431) * m(:,:) + rate(:,:,432) = rate(:,:,432) * m(:,:) + rate(:,:,433) = rate(:,:,433) * m(:,:) + rate(:,:,434) = rate(:,:,434) * m(:,:) + rate(:,:,435) = rate(:,:,435) * m(:,:) + rate(:,:,436) = rate(:,:,436) * m(:,:) + rate(:,:,437) = rate(:,:,437) * m(:,:) + rate(:,:,438) = rate(:,:,438) * m(:,:) + rate(:,:,439) = rate(:,:,439) * m(:,:) + rate(:,:,440) = rate(:,:,440) * m(:,:) + rate(:,:,441) = rate(:,:,441) * m(:,:) + rate(:,:,442) = rate(:,:,442) * m(:,:) + rate(:,:,443) = rate(:,:,443) * m(:,:) + rate(:,:,444) = rate(:,:,444) * m(:,:) + rate(:,:,445) = rate(:,:,445) * m(:,:) + rate(:,:,446) = rate(:,:,446) * m(:,:) + rate(:,:,447) = rate(:,:,447) * m(:,:) + rate(:,:,448) = rate(:,:,448) * m(:,:) + rate(:,:,449) = rate(:,:,449) * m(:,:) + rate(:,:,450) = rate(:,:,450) * m(:,:) + rate(:,:,451) = rate(:,:,451) * m(:,:) + rate(:,:,452) = rate(:,:,452) * m(:,:) + rate(:,:,453) = rate(:,:,453) * m(:,:) + rate(:,:,454) = rate(:,:,454) * m(:,:) + rate(:,:,455) = rate(:,:,455) * m(:,:) + rate(:,:,456) = rate(:,:,456) * m(:,:) + rate(:,:,457) = rate(:,:,457) * m(:,:) + rate(:,:,458) = rate(:,:,458) * m(:,:) + rate(:,:,459) = rate(:,:,459) * m(:,:) + rate(:,:,460) = rate(:,:,460) * m(:,:) + rate(:,:,461) = rate(:,:,461) * m(:,:) + rate(:,:,462) = rate(:,:,462) * m(:,:) + rate(:,:,463) = rate(:,:,463) * m(:,:) + rate(:,:,465) = rate(:,:,465) * m(:,:) + rate(:,:,466) = rate(:,:,466) * m(:,:) + rate(:,:,467) = rate(:,:,467) * m(:,:) + rate(:,:,468) = rate(:,:,468) * m(:,:) + rate(:,:,469) = rate(:,:,469) * m(:,:) + rate(:,:,471) = rate(:,:,471) * m(:,:) + rate(:,:,472) = rate(:,:,472) * m(:,:) + rate(:,:,473) = rate(:,:,473) * m(:,:) + rate(:,:,474) = rate(:,:,474) * m(:,:) + rate(:,:,475) = rate(:,:,475) * m(:,:) + rate(:,:,476) = rate(:,:,476) * m(:,:) + rate(:,:,477) = rate(:,:,477) * m(:,:) + rate(:,:,478) = rate(:,:,478) * m(:,:) + rate(:,:,479) = rate(:,:,479) * m(:,:) + rate(:,:,494) = rate(:,:,494) * m(:,:) + rate(:,:,495) = rate(:,:,495) * m(:,:) + rate(:,:,496) = rate(:,:,496) * m(:,:) + rate(:,:,497) = rate(:,:,497) * m(:,:) + rate(:,:,498) = rate(:,:,498) * m(:,:) + rate(:,:,499) = rate(:,:,499) * m(:,:) + rate(:,:,500) = rate(:,:,500) * m(:,:) + rate(:,:,501) = rate(:,:,501) * m(:,:) + rate(:,:,502) = rate(:,:,502) * m(:,:) + rate(:,:,503) = rate(:,:,503) * m(:,:) + rate(:,:,504) = rate(:,:,504) * m(:,:) + rate(:,:,505) = rate(:,:,505) * m(:,:) + rate(:,:,506) = rate(:,:,506) * m(:,:) + rate(:,:,507) = rate(:,:,507) * m(:,:) + rate(:,:,509) = rate(:,:,509) * m(:,:) + rate(:,:,514) = rate(:,:,514) * m(:,:) + rate(:,:,515) = rate(:,:,515) * m(:,:) + rate(:,:,516) = rate(:,:,516) * m(:,:) + rate(:,:,519) = rate(:,:,519) * m(:,:) + rate(:,:,520) = rate(:,:,520) * m(:,:) + rate(:,:,521) = rate(:,:,521) * m(:,:) + rate(:,:,524) = rate(:,:,524) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 new file mode 100644 index 0000000000..9a9a6f0058 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 @@ -0,0 +1,276 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) = + extfrc(:,17) + prod(:,2) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) =.100_r8*rxt(:,308)*y(:,134)*y(:,29) + prod(:,16) = 0._r8 + prod(:,17) = 0._r8 + prod(:,18) = (rxt(:,265)*y(:,62) +rxt(:,267)*y(:,87) +rxt(:,275)*y(:,62) + & + rxt(:,295)*y(:,50) +.500_r8*rxt(:,296)*y(:,51) + & + .800_r8*rxt(:,301)*y(:,74) +rxt(:,302)*y(:,75) + & + .500_r8*rxt(:,351)*y(:,109) +1.800_r8*rxt(:,461)*y(:,177))*y(:,211) & + + (2.000_r8*rxt(:,291)*y(:,194) +.900_r8*rxt(:,292)*y(:,195) + & + rxt(:,294)*y(:,124) +2.000_r8*rxt(:,341)*y(:,206) + & + rxt(:,365)*y(:,202) +rxt(:,390)*y(:,218))*y(:,194) & + + (.200_r8*rxt(:,308)*y(:,29) +.100_r8*rxt(:,352)*y(:,111) + & + .270_r8*rxt(:,440)*y(:,6) +.270_r8*rxt(:,443)*y(:,110))*y(:,134) & + + (rxt(:,342)*y(:,195) +.450_r8*rxt(:,343)*y(:,200) + & + 2.000_r8*rxt(:,344)*y(:,206))*y(:,206) & + + (.500_r8*rxt(:,450)*y(:,195) +.900_r8*rxt(:,452)*y(:,124)) & + *y(:,215) +rxt(:,37)*y(:,51) +.400_r8*rxt(:,60)*y(:,138) +rxt(:,65) & + *y(:,173) +.800_r8*rxt(:,69)*y(:,177) + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,24) =rxt(:,151)*y(:,125)*y(:,112) + prod(:,25) = 0._r8 + prod(:,26) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) =rxt(:,478)*y(:,211)*y(:,120) +rxt(:,488)*y(:,121) + prod(:,30) = (rxt(:,412)*y(:,196) +rxt(:,415)*y(:,205) +rxt(:,418)*y(:,207) + & + rxt(:,422)*y(:,140))*y(:,125) +.500_r8*rxt(:,351)*y(:,211)*y(:,109) & + +.200_r8*rxt(:,447)*y(:,209)*y(:,124) +.500_r8*rxt(:,459)*y(:,176) & + *y(:,126) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,121) = 0._r8 + prod(:,120) = 0._r8 + prod(:,1) = + extfrc(:,10) + prod(:,2) = + extfrc(:,11) + prod(:,144) = 0._r8 + prod(:,46) = 0._r8 + prod(:,85) = 0._r8 + prod(:,47) = 0._r8 + prod(:,86) = 0._r8 + prod(:,96) = 0._r8 + prod(:,68) = 0._r8 + prod(:,117) = 0._r8 + prod(:,75) = 0._r8 + prod(:,60) = 0._r8 + prod(:,81) = 0._r8 + prod(:,174) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +2.000_r8*rxt(:,86)*y(:,41) & + +rxt(:,87)*y(:,43) +3.000_r8*rxt(:,90)*y(:,55) +2.000_r8*rxt(:,98) & + *y(:,78) + prod(:,61) = 0._r8 + prod(:,187) = 0._r8 + prod(:,110) = 0._r8 + prod(:,62) = 0._r8 + prod(:,78) = 0._r8 + prod(:,70) = 0._r8 + prod(:,111) = 0._r8 + prod(:,64) = 0._r8 + prod(:,79) = 0._r8 + prod(:,71) = 0._r8 + prod(:,149) = 0._r8 + prod(:,90) = 0._r8 + prod(:,39) = 0._r8 + prod(:,65) = 0._r8 + prod(:,189) =.180_r8*rxt(:,40)*y(:,54) + prod(:,161) = 0._r8 + prod(:,38) = 0._r8 + prod(:,147) = 0._r8 + prod(:,166) = 0._r8 + prod(:,108) = 0._r8 + prod(:,102) = 0._r8 + prod(:,134) = 0._r8 + prod(:,91) = 0._r8 + prod(:,184) =4.000_r8*rxt(:,78)*y(:,33) +rxt(:,79)*y(:,34) & + +2.000_r8*rxt(:,81)*y(:,36) +2.000_r8*rxt(:,82)*y(:,37) & + +2.000_r8*rxt(:,83)*y(:,38) +rxt(:,84)*y(:,39) +2.000_r8*rxt(:,85) & + *y(:,40) +3.000_r8*rxt(:,88)*y(:,44) +rxt(:,89)*y(:,46) +rxt(:,100) & + *y(:,82) +rxt(:,101)*y(:,83) +rxt(:,102)*y(:,84) + prod(:,45) = 0._r8 + prod(:,36) = 0._r8 + prod(:,183) = 0._r8 + prod(:,148) = 0._r8 + prod(:,155) =.380_r8*rxt(:,40)*y(:,54) +rxt(:,41)*y(:,63) + extfrc(:,9) + prod(:,40) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +rxt(:,82)*y(:,37) & + +2.000_r8*rxt(:,83)*y(:,38) +2.000_r8*rxt(:,84)*y(:,39) +rxt(:,85) & + *y(:,40) +2.000_r8*rxt(:,98)*y(:,78) +rxt(:,101)*y(:,83) +rxt(:,102) & + *y(:,84) + prod(:,50) =rxt(:,81)*y(:,36) +rxt(:,82)*y(:,37) +rxt(:,100)*y(:,82) + prod(:,52) = 0._r8 + prod(:,69) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,41) = 0._r8 + prod(:,132) =rxt(:,80)*y(:,35) +rxt(:,84)*y(:,39) + prod(:,151) = 0._r8 + prod(:,142) = 0._r8 + prod(:,176) = (rxt(:,39) +.330_r8*rxt(:,40))*y(:,54) + prod(:,162) =1.440_r8*rxt(:,40)*y(:,54) + prod(:,114) = 0._r8 + prod(:,42) = 0._r8 + prod(:,138) = 0._r8 + prod(:,177) = 0._r8 + prod(:,49) = 0._r8 + prod(:,133) = 0._r8 + prod(:,57) = 0._r8 + prod(:,175) = 0._r8 + prod(:,83) = 0._r8 + prod(:,131) = 0._r8 + prod(:,136) = 0._r8 + prod(:,154) = 0._r8 + prod(:,58) = 0._r8 + prod(:,156) = 0._r8 + prod(:,72) = 0._r8 + prod(:,43) = 0._r8 + prod(:,139) = 0._r8 + prod(:,113) = 0._r8 + prod(:,107) = 0._r8 + prod(:,164) = 0._r8 + prod(:,89) = 0._r8 + prod(:,123) = 0._r8 + prod(:,34) = 0._r8 + prod(:,165) = 0._r8 + prod(:,73) = 0._r8 + prod(:,104) = 0._r8 + prod(:,74) = 0._r8 + prod(:,106) = 0._r8 + prod(:,145) = 0._r8 + prod(:,169) = 0._r8 + prod(:,82) = + extfrc(:,16) + prod(:,67) = 0._r8 + prod(:,84) = 0._r8 + prod(:,152) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,37) = 0._r8 + prod(:,9) = 0._r8 + prod(:,190) = + extfrc(:,2) + prod(:,185) = + extfrc(:,3) + prod(:,179) = 0._r8 + prod(:,141) = 0._r8 + prod(:,87) = 0._r8 + prod(:,10) = + extfrc(:,12) + prod(:,11) = + extfrc(:,13) + prod(:,12) = 0._r8 + prod(:,13) = + extfrc(:,14) + prod(:,188) =.180_r8*rxt(:,40)*y(:,54) +rxt(:,41)*y(:,63) + (rxt(:,5) + & + 2.000_r8*rxt(:,6)) + prod(:,186) = 0._r8 + prod(:,76) = 0._r8 + prod(:,80) = 0._r8 + prod(:,59) = 0._r8 + prod(:,97) = 0._r8 + prod(:,44) = 0._r8 + prod(:,98) = 0._r8 + prod(:,48) = 0._r8 + prod(:,77) = 0._r8 + prod(:,14) = + extfrc(:,6) + prod(:,15) = + extfrc(:,7) + prod(:,109) = 0._r8 + prod(:,88) = 0._r8 + prod(:,103) = 0._r8 + prod(:,167) = 0._r8 + prod(:,140) = + extfrc(:,4) + prod(:,63) = 0._r8 + prod(:,16) = + extfrc(:,8) + prod(:,17) = + extfrc(:,1) + prod(:,18) = 0._r8 + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,24) = 0._r8 + prod(:,25) = 0._r8 + prod(:,26) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,35) = + extfrc(:,5) + prod(:,53) = 0._r8 + prod(:,115) = 0._r8 + prod(:,118) = 0._r8 + prod(:,99) = 0._r8 + prod(:,150) = 0._r8 + prod(:,153) = 0._r8 + prod(:,116) = 0._r8 + prod(:,51) = 0._r8 + prod(:,54) = 0._r8 + prod(:,55) = 0._r8 + prod(:,124) = 0._r8 + prod(:,56) = 0._r8 + prod(:,92) = 0._r8 + prod(:,105) = 0._r8 + prod(:,146) = 0._r8 + prod(:,100) = 0._r8 + prod(:,93) = 0._r8 + prod(:,137) = 0._r8 + prod(:,135) = 0._r8 + prod(:,119) = 0._r8 + prod(:,173) = 0._r8 + prod(:,182) =rxt(:,87)*y(:,43) +rxt(:,89)*y(:,46) +rxt(:,39)*y(:,54) + prod(:,129) = 0._r8 + prod(:,112) = 0._r8 + prod(:,66) = 0._r8 + prod(:,125) = 0._r8 + prod(:,178) = 0._r8 + prod(:,94) = 0._r8 + prod(:,168) = 0._r8 + prod(:,171) = 0._r8 + prod(:,170) = 0._r8 + prod(:,126) = 0._r8 + prod(:,172) = 0._r8 + prod(:,143) = 0._r8 + prod(:,122) = 0._r8 + prod(:,159) = 0._r8 + prod(:,180) =rxt(:,12)*y(:,113) +rxt(:,5) + prod(:,181) =.330_r8*rxt(:,40)*y(:,54) + extfrc(:,15) + prod(:,95) = 0._r8 + prod(:,130) = 0._r8 + prod(:,160) = 0._r8 + prod(:,158) = 0._r8 + prod(:,157) = 0._r8 + prod(:,127) = 0._r8 + prod(:,163) = 0._r8 + prod(:,128) = 0._r8 + prod(:,101) = 0._r8 + prod(:,191) =.050_r8*rxt(:,40)*y(:,54) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 new file mode 100644 index 0000000000..fcc7a60bbf --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 @@ -0,0 +1,618 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,533) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,522) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,4) ) + mat(k,2) = -( het_rates(k,5) ) + mat(k,761) = -( het_rates(k,6) ) + mat(k,81) = -( het_rates(k,7) ) + mat(k,284) = -( rxt(k,21) + het_rates(k,8) ) + mat(k,87) = -( rxt(k,22) + het_rates(k,9) ) + mat(k,290) = -( rxt(k,23) + het_rates(k,10) ) + mat(k,353) = -( rxt(k,24) + het_rates(k,11) ) + mat(k,285) = .500_r8*rxt(k,21) + mat(k,88) = rxt(k,22) + mat(k,493) = .200_r8*rxt(k,70) + mat(k,561) = .060_r8*rxt(k,72) + mat(k,190) = -( rxt(k,25) + het_rates(k,12) ) + mat(k,492) = .200_r8*rxt(k,70) + mat(k,559) = .200_r8*rxt(k,72) + mat(k,503) = -( rxt(k,26) + het_rates(k,13) ) + mat(k,151) = rxt(k,46) + mat(k,870) = rxt(k,56) + mat(k,495) = .200_r8*rxt(k,70) + mat(k,562) = .150_r8*rxt(k,72) + mat(k,224) = -( rxt(k,27) + het_rates(k,14) ) + mat(k,560) = .210_r8*rxt(k,72) + mat(k,158) = -( het_rates(k,15) ) + mat(k,258) = -( het_rates(k,16) ) + mat(k,1250) = -( het_rates(k,17) ) + mat(k,162) = rxt(k,74) + mat(k,1849) = rxt(k,75) + mat(k,445) = rxt(k,77) + mat(k,696) = rxt(k,99) + mat(k,641) = rxt(k,105) + mat(k,1467) = rxt(k,200)*y(k,34) + rxt(k,226)*y(k,35) & + + 3.000_r8*rxt(k,227)*y(k,55) + 2.000_r8*rxt(k,228)*y(k,78) & + + 2.000_r8*rxt(k,249)*y(k,41) + rxt(k,250)*y(k,43) + mat(k,1724) = 2.000_r8*rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & + + 3.000_r8*rxt(k,244)*y(k,55) + mat(k,1614) = 2.000_r8*rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) & + + 3.000_r8*rxt(k,245)*y(k,55) + mat(k,161) = -( rxt(k,74) + het_rates(k,18) ) + mat(k,1862) = -( rxt(k,75) + het_rates(k,19) ) + mat(k,449) = rxt(k,76) + mat(k,443) = -( rxt(k,76) + rxt(k,77) + rxt(k,510) + rxt(k,513) + rxt(k,518) & + + het_rates(k,20) ) + mat(k,164) = -( het_rates(k,22) ) + mat(k,239) = rxt(k,28) + mat(k,240) = -( rxt(k,28) + het_rates(k,23) ) + mat(k,199) = -( het_rates(k,24) ) + mat(k,451) = -( het_rates(k,25) ) + mat(k,172) = -( het_rates(k,26) ) + mat(k,245) = -( rxt(k,29) + het_rates(k,27) ) + mat(k,205) = -( het_rates(k,28) ) + mat(k,841) = -( het_rates(k,29) ) + mat(k,1125) = .700_r8*rxt(k,55) + mat(k,314) = -( rxt(k,30) + het_rates(k,30) ) + mat(k,55) = -( het_rates(k,31) ) + mat(k,176) = -( rxt(k,31) + het_rates(k,32) ) + mat(k,1917) = -( rxt(k,32) + rxt(k,33) + het_rates(k,42) ) + mat(k,542) = .100_r8*rxt(k,19) + mat(k,531) = .100_r8*rxt(k,20) + mat(k,324) = rxt(k,38) + mat(k,869) = rxt(k,43) + mat(k,909) = .330_r8*rxt(k,45) + mat(k,920) = rxt(k,47) + mat(k,558) = .690_r8*rxt(k,49) + mat(k,1069) = 1.340_r8*rxt(k,50) + mat(k,737) = rxt(k,57) + mat(k,441) = rxt(k,62) + mat(k,306) = rxt(k,63) + mat(k,491) = .375_r8*rxt(k,65) + mat(k,373) = .400_r8*rxt(k,67) + mat(k,893) = .680_r8*rxt(k,69) + mat(k,344) = rxt(k,269) + mat(k,183) = 2.000_r8*rxt(k,299) + mat(k,1482) = rxt(k,272)*y(k,54) + rxt(k,273)*y(k,54) + mat(k,996) = -( rxt(k,34) + het_rates(k,45) ) + mat(k,537) = .400_r8*rxt(k,19) + mat(k,527) = .400_r8*rxt(k,20) + mat(k,247) = rxt(k,29) + mat(k,902) = .330_r8*rxt(k,45) + mat(k,221) = rxt(k,53) + mat(k,438) = rxt(k,62) + mat(k,52) = -( het_rates(k,47) ) + mat(k,819) = -( rxt(k,35) + het_rates(k,48) ) + mat(k,536) = .250_r8*rxt(k,19) + mat(k,526) = .250_r8*rxt(k,20) + mat(k,316) = .820_r8*rxt(k,30) + mat(k,896) = .170_r8*rxt(k,45) + mat(k,484) = .300_r8*rxt(k,65) + mat(k,368) = .050_r8*rxt(k,67) + mat(k,885) = .500_r8*rxt(k,69) + mat(k,1072) = -( rxt(k,36) + het_rates(k,49) ) + mat(k,293) = .180_r8*rxt(k,23) + mat(k,226) = rxt(k,27) + mat(k,500) = .400_r8*rxt(k,70) + mat(k,570) = .540_r8*rxt(k,72) + mat(k,329) = .510_r8*rxt(k,73) + mat(k,431) = -( het_rates(k,50) ) + mat(k,391) = -( rxt(k,37) + het_rates(k,51) ) + mat(k,661) = -( het_rates(k,52) ) + mat(k,320) = -( rxt(k,38) + het_rates(k,53) ) + mat(k,1734) = -( rxt(k,175)*y(k,54) + rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & + + rxt(k,242)*y(k,46) + rxt(k,244)*y(k,55) + het_rates(k,56) ) + mat(k,163) = rxt(k,74) + mat(k,75) = 2.000_r8*rxt(k,91) + mat(k,48) = 2.000_r8*rxt(k,92) + mat(k,1700) = rxt(k,93) + mat(k,833) = rxt(k,94) + mat(k,103) = rxt(k,97) + mat(k,1303) = rxt(k,103) + mat(k,681) = rxt(k,106) + mat(k,1477) = 4.000_r8*rxt(k,199)*y(k,33) + rxt(k,200)*y(k,34) & + + 2.000_r8*rxt(k,201)*y(k,36) + 2.000_r8*rxt(k,202)*y(k,37) & + + 2.000_r8*rxt(k,203)*y(k,38) + rxt(k,204)*y(k,39) & + + 2.000_r8*rxt(k,205)*y(k,40) + rxt(k,251)*y(k,82) & + + rxt(k,252)*y(k,83) + rxt(k,253)*y(k,84) + mat(k,1624) = 3.000_r8*rxt(k,241)*y(k,44) + rxt(k,243)*y(k,46) & + + rxt(k,246)*y(k,82) + rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) + mat(k,74) = -( rxt(k,91) + het_rates(k,57) ) + mat(k,46) = -( rxt(k,92) + rxt(k,209) + het_rates(k,58) ) + mat(k,1699) = -( rxt(k,93) + het_rates(k,59) ) + mat(k,832) = rxt(k,95) + mat(k,232) = rxt(k,107) + mat(k,47) = 2.000_r8*rxt(k,209) + mat(k,827) = -( rxt(k,94) + rxt(k,95) + rxt(k,512) + rxt(k,517) + rxt(k,523) & + + het_rates(k,60) ) + mat(k,911) = -( het_rates(k,62) ) + mat(k,89) = 1.500_r8*rxt(k,22) + mat(k,292) = .450_r8*rxt(k,23) + mat(k,505) = .600_r8*rxt(k,26) + mat(k,225) = rxt(k,27) + mat(k,1900) = rxt(k,32) + rxt(k,33) + mat(k,995) = rxt(k,34) + mat(k,1071) = rxt(k,36) + mat(k,866) = rxt(k,43) + mat(k,740) = 2.000_r8*rxt(k,44) + mat(k,899) = .330_r8*rxt(k,45) + mat(k,1059) = 1.340_r8*rxt(k,51) + mat(k,1126) = .700_r8*rxt(k,55) + mat(k,122) = 1.500_r8*rxt(k,64) + mat(k,487) = .250_r8*rxt(k,65) + mat(k,858) = rxt(k,68) + mat(k,887) = 1.700_r8*rxt(k,69) + mat(k,253) = rxt(k,110) + mat(k,1720) = rxt(k,242)*y(k,46) + mat(k,59) = -( rxt(k,96) + het_rates(k,64) ) + mat(k,1461) = rxt(k,200)*y(k,34) + rxt(k,202)*y(k,37) & + + 2.000_r8*rxt(k,203)*y(k,38) + 2.000_r8*rxt(k,204)*y(k,39) & + + rxt(k,205)*y(k,40) + rxt(k,226)*y(k,35) & + + 2.000_r8*rxt(k,228)*y(k,78) + rxt(k,252)*y(k,83) & + + rxt(k,253)*y(k,84) + mat(k,1495) = rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) + mat(k,100) = -( rxt(k,97) + het_rates(k,65) ) + mat(k,1463) = rxt(k,201)*y(k,36) + rxt(k,202)*y(k,37) + rxt(k,251)*y(k,82) + mat(k,1501) = rxt(k,246)*y(k,82) + mat(k,116) = -( het_rates(k,66) ) + mat(k,193) = -( het_rates(k,67) ) + mat(k,3) = -( het_rates(k,68) ) + mat(k,4) = -( het_rates(k,69) ) + mat(k,5) = -( het_rates(k,70) ) + mat(k,62) = -( rxt(k,42) + het_rates(k,72) ) + mat(k,649) = -( rxt(k,231)*y(k,54) + het_rates(k,73) ) + mat(k,60) = 2.000_r8*rxt(k,96) + mat(k,101) = rxt(k,97) + mat(k,148) = rxt(k,104) + mat(k,1464) = rxt(k,204)*y(k,39) + rxt(k,226)*y(k,35) + mat(k,865) = -( rxt(k,43) + het_rates(k,74) ) + mat(k,897) = .330_r8*rxt(k,45) + mat(k,485) = .250_r8*rxt(k,65) + mat(k,181) = rxt(k,300) + mat(k,739) = -( rxt(k,44) + rxt(k,480) + het_rates(k,75) ) + mat(k,287) = rxt(k,21) + mat(k,291) = .130_r8*rxt(k,23) + mat(k,236) = .700_r8*rxt(k,61) + mat(k,499) = .600_r8*rxt(k,70) + mat(k,567) = .340_r8*rxt(k,72) + mat(k,328) = .170_r8*rxt(k,73) + mat(k,1276) = -( rxt(k,137) + het_rates(k,76) ) + mat(k,2007) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,1904) = 2.000_r8*rxt(k,32) + mat(k,321) = rxt(k,38) + mat(k,697) = rxt(k,99) + mat(k,1295) = rxt(k,103) + mat(k,149) = rxt(k,104) + mat(k,1469) = rxt(k,272)*y(k,54) + mat(k,1007) = -( het_rates(k,77) ) + mat(k,2003) = rxt(k,1) + mat(k,1901) = rxt(k,33) + mat(k,1466) = rxt(k,273)*y(k,54) + mat(k,476) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,1339) = .500_r8*rxt(k,481) + mat(k,65) = -( rxt(k,109) + het_rates(k,80) ) + mat(k,695) = -( rxt(k,99) + het_rates(k,81) ) + mat(k,1296) = -( rxt(k,103) + het_rates(k,85) ) + mat(k,1727) = rxt(k,175)*y(k,54) + rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & + + 2.000_r8*rxt(k,242)*y(k,46) + rxt(k,244)*y(k,55) + mat(k,96) = -( het_rates(k,86) ) + mat(k,657) = -( het_rates(k,87) ) + mat(k,147) = -( rxt(k,104) + het_rates(k,88) ) + mat(k,648) = rxt(k,231)*y(k,54) + mat(k,1263) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,904) = rxt(k,482) + mat(k,471) = rxt(k,483) + mat(k,428) = rxt(k,484) + mat(k,185) = 2.000_r8*rxt(k,485) + 2.000_r8*rxt(k,508) + 2.000_r8*rxt(k,511) & + + 2.000_r8*rxt(k,522) + mat(k,281) = rxt(k,486) + mat(k,878) = rxt(k,487) + mat(k,1766) = .500_r8*rxt(k,489) + mat(k,1444) = rxt(k,490) + mat(k,299) = rxt(k,491) + mat(k,156) = rxt(k,492) + mat(k,509) = rxt(k,493) + mat(k,446) = rxt(k,510) + rxt(k,513) + rxt(k,518) + mat(k,828) = rxt(k,512) + rxt(k,517) + rxt(k,523) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,272) = -( rxt(k,10) + rxt(k,11) + rxt(k,172) + het_rates(k,90) ) + mat(k,640) = -( rxt(k,105) + het_rates(k,91) ) + mat(k,444) = rxt(k,510) + rxt(k,513) + rxt(k,518) + mat(k,677) = -( rxt(k,106) + het_rates(k,92) ) + mat(k,826) = rxt(k,512) + rxt(k,517) + rxt(k,523) + mat(k,898) = -( rxt(k,45) + rxt(k,482) + het_rates(k,93) ) + mat(k,150) = -( rxt(k,46) + het_rates(k,94) ) + mat(k,1166) = rxt(k,373) + mat(k,915) = -( rxt(k,47) + het_rates(k,95) ) + mat(k,900) = .170_r8*rxt(k,45) + mat(k,211) = -( het_rates(k,96) ) + mat(k,68) = -( het_rates(k,97) ) + mat(k,709) = -( het_rates(k,98) ) + mat(k,467) = -( rxt(k,483) + het_rates(k,99) ) + mat(k,423) = -( rxt(k,484) + het_rates(k,100) ) + mat(k,1044) = -( het_rates(k,101) ) + mat(k,308) = -( rxt(k,48) + het_rates(k,102) ) + mat(k,552) = -( rxt(k,49) + het_rates(k,103) ) + mat(k,309) = rxt(k,48) + mat(k,39) = -( het_rates(k,104) ) + mat(k,1060) = -( rxt(k,50) + rxt(k,51) + het_rates(k,105) ) + mat(k,554) = .288_r8*rxt(k,49) + mat(k,214) = -( het_rates(k,106) ) + mat(k,403) = -( rxt(k,52) + het_rates(k,107) ) + mat(k,532) = .800_r8*rxt(k,19) + mat(k,521) = .800_r8*rxt(k,20) + mat(k,219) = -( rxt(k,53) + het_rates(k,108) ) + mat(k,415) = -( rxt(k,54) + rxt(k,355) + het_rates(k,109) ) + mat(k,787) = -( het_rates(k,110) ) + mat(k,1130) = -( rxt(k,55) + het_rates(k,111) ) + mat(k,555) = .402_r8*rxt(k,49) + mat(k,266) = -( rxt(k,154) + het_rates(k,112) ) + mat(k,1926) = rxt(k,15) + mat(k,184) = -( rxt(k,13) + rxt(k,14) + rxt(k,173) + rxt(k,485) + rxt(k,508) & + + rxt(k,511) + rxt(k,522) + het_rates(k,114) ) + mat(k,278) = -( rxt(k,486) + het_rates(k,115) ) + mat(k,874) = -( rxt(k,56) + rxt(k,487) + het_rates(k,116) ) + mat(k,6) = -( het_rates(k,117) ) + mat(k,7) = -( het_rates(k,118) ) + mat(k,8) = -( het_rates(k,119) ) + mat(k,49) = -( het_rates(k,120) ) + mat(k,9) = -( rxt(k,488) + het_rates(k,121) ) + mat(k,1996) = -( rxt(k,15) + het_rates(k,124) ) + mat(k,189) = rxt(k,14) + mat(k,1781) = rxt(k,16) + .500_r8*rxt(k,489) + mat(k,1459) = rxt(k,17) + mat(k,271) = rxt(k,154) + mat(k,1483) = 2.000_r8*rxt(k,166)*y(k,113) + mat(k,1776) = -( rxt(k,16) + rxt(k,489) + het_rates(k,125) ) + mat(k,1271) = rxt(k,9) + mat(k,276) = rxt(k,11) + rxt(k,172) + mat(k,187) = rxt(k,13) + rxt(k,173) + mat(k,1454) = rxt(k,18) + mat(k,541) = rxt(k,19) + mat(k,908) = rxt(k,45) + mat(k,313) = rxt(k,48) + mat(k,421) = rxt(k,54) + rxt(k,355) + mat(k,882) = rxt(k,56) + mat(k,736) = rxt(k,57) + mat(k,301) = rxt(k,58) + mat(k,157) = rxt(k,59) + mat(k,361) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,512) = rxt(k,66) + mat(k,448) = rxt(k,76) + mat(k,834) = rxt(k,95) + mat(k,73) = rxt(k,430) + mat(k,1448) = -( rxt(k,17) + rxt(k,18) + rxt(k,490) + het_rates(k,126) ) + mat(k,274) = rxt(k,10) + mat(k,186) = rxt(k,13) + rxt(k,14) + rxt(k,173) + mat(k,358) = .400_r8*rxt(k,60) + mat(k,447) = rxt(k,77) + mat(k,830) = rxt(k,94) + mat(k,732) = -( rxt(k,57) + het_rates(k,127) ) + mat(k,296) = -( rxt(k,58) + rxt(k,491) + het_rates(k,128) ) + mat(k,10) = -( het_rates(k,129) ) + mat(k,11) = -( het_rates(k,130) ) + mat(k,12) = -( het_rates(k,131) ) + mat(k,13) = -( het_rates(k,132) ) + mat(k,1893) = -( rxt(k,131) + het_rates(k,133) ) + mat(k,2019) = rxt(k,3) + mat(k,1839) = rxt(k,8) + mat(k,188) = rxt(k,14) + mat(k,1994) = rxt(k,15) + mat(k,1779) = rxt(k,16) + mat(k,1457) = rxt(k,18) + mat(k,1863) = rxt(k,75) + mat(k,1704) = rxt(k,93) + mat(k,233) = rxt(k,107) + mat(k,1093) = rxt(k,111) + rxt(k,470) + mat(k,730) = rxt(k,112) + mat(k,170) = rxt(k,113) + mat(k,1481) = rxt(k,126) + rxt(k,127) + mat(k,270) = rxt(k,154) + mat(k,402) = rxt(k,464) + mat(k,1837) = -( rxt(k,7) + rxt(k,8) + het_rates(k,134) ) + mat(k,1891) = rxt(k,131) + mat(k,229) = -( rxt(k,107) + het_rates(k,135) ) + mat(k,250) = -( rxt(k,110) + het_rates(k,136) ) + mat(k,155) = -( rxt(k,59) + rxt(k,492) + het_rates(k,137) ) + mat(k,356) = -( rxt(k,60) + rxt(k,306) + het_rates(k,138) ) + mat(k,71) = -( rxt(k,430) + het_rates(k,139) ) + mat(k,363) = -( het_rates(k,140) ) + mat(k,177) = rxt(k,31) + mat(k,91) = -( het_rates(k,141) ) + mat(k,234) = -( rxt(k,61) + het_rates(k,142) ) + mat(k,14) = -( het_rates(k,143) ) + mat(k,15) = -( het_rates(k,144) ) + mat(k,435) = -( rxt(k,62) + het_rates(k,145) ) + mat(k,302) = -( rxt(k,63) + het_rates(k,146) ) + mat(k,397) = -( rxt(k,464) + het_rates(k,147) ) + mat(k,251) = rxt(k,110) + mat(k,1081) = rxt(k,111) + mat(k,1083) = -( rxt(k,111) + rxt(k,470) + het_rates(k,149) ) + mat(k,727) = rxt(k,112) + mat(k,398) = rxt(k,464) + mat(k,726) = -( rxt(k,112) + het_rates(k,150) ) + mat(k,169) = rxt(k,113) + mat(k,1082) = rxt(k,470) + mat(k,168) = -( rxt(k,113) + het_rates(k,151) ) + mat(k,66) = rxt(k,109) + mat(k,16) = -( het_rates(k,152) ) + mat(k,17) = -( het_rates(k,153) ) + mat(k,18) = -( het_rates(k,154) ) + mat(k,19) = -( rxt(k,114) + het_rates(k,155) ) + mat(k,20) = -( rxt(k,115) + het_rates(k,156) ) + mat(k,21) = -( rxt(k,116) + het_rates(k,157) ) + mat(k,22) = -( rxt(k,117) + het_rates(k,158) ) + mat(k,23) = -( rxt(k,118) + het_rates(k,159) ) + mat(k,24) = -( rxt(k,119) + het_rates(k,160) ) + mat(k,25) = -( rxt(k,120) + het_rates(k,161) ) + mat(k,26) = -( rxt(k,121) + het_rates(k,162) ) + mat(k,27) = -( rxt(k,122) + het_rates(k,163) ) + mat(k,28) = -( rxt(k,123) + het_rates(k,164) ) + mat(k,29) = -( het_rates(k,165) ) + mat(k,738) = rxt(k,480) + mat(k,30) = -( het_rates(k,166) ) + mat(k,31) = -( het_rates(k,167) ) + mat(k,32) = -( het_rates(k,168) ) + mat(k,33) = -( het_rates(k,169) ) + mat(k,45) = -( het_rates(k,171) ) + mat(k,121) = -( rxt(k,64) + het_rates(k,172) ) + mat(k,483) = -( rxt(k,65) + het_rates(k,173) ) + mat(k,507) = -( rxt(k,66) + rxt(k,493) + het_rates(k,174) ) + mat(k,367) = -( rxt(k,67) + het_rates(k,175) ) + mat(k,856) = -( rxt(k,68) + het_rates(k,176) ) + mat(k,297) = rxt(k,58) + mat(k,508) = rxt(k,66) + mat(k,369) = rxt(k,67) + mat(k,886) = -( rxt(k,69) + het_rates(k,177) ) + mat(k,486) = rxt(k,65) + mat(k,857) = rxt(k,68) + mat(k,494) = -( rxt(k,70) + het_rates(k,178) ) + mat(k,109) = -( het_rates(k,179) ) + mat(k,125) = -( rxt(k,71) + het_rates(k,180) ) + mat(k,134) = -( het_rates(k,181) ) + mat(k,563) = -( rxt(k,72) + het_rates(k,182) ) + mat(k,142) = -( het_rates(k,183) ) + mat(k,326) = -( rxt(k,73) + het_rates(k,184) ) + mat(k,409) = -( het_rates(k,187) ) + mat(k,72) = rxt(k,430) + mat(k,809) = -( het_rates(k,188) ) + mat(k,376) = -( het_rates(k,189) ) + mat(k,334) = -( het_rates(k,190) ) + mat(k,687) = -( het_rates(k,191) ) + mat(k,405) = rxt(k,52) + mat(k,666) = -( het_rates(k,192) ) + mat(k,515) = -( het_rates(k,193) ) + mat(k,1236) = -( het_rates(k,194) ) + mat(k,294) = .130_r8*rxt(k,23) + mat(k,227) = rxt(k,27) + mat(k,821) = rxt(k,35) + mat(k,1073) = rxt(k,36) + mat(k,903) = .330_r8*rxt(k,45) + mat(k,917) = rxt(k,47) + mat(k,1064) = 1.340_r8*rxt(k,50) + mat(k,406) = rxt(k,52) + mat(k,222) = rxt(k,53) + mat(k,1132) = .300_r8*rxt(k,55) + mat(k,734) = rxt(k,57) + mat(k,357) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,304) = rxt(k,63) + mat(k,123) = .500_r8*rxt(k,64) + mat(k,889) = .650_r8*rxt(k,69) + mat(k,1672) = -( het_rates(k,195) ) + mat(k,1003) = rxt(k,34) + mat(k,823) = rxt(k,35) + mat(k,394) = rxt(k,37) + mat(k,1138) = .300_r8*rxt(k,55) + mat(k,360) = .400_r8*rxt(k,60) + mat(k,1732) = rxt(k,175)*y(k,54) + mat(k,655) = rxt(k,231)*y(k,54) + mat(k,1622) = rxt(k,264)*y(k,54) + mat(k,1475) = rxt(k,271)*y(k,54) + mat(k,621) = -( het_rates(k,196) ) + mat(k,191) = .600_r8*rxt(k,25) + mat(k,459) = -( het_rates(k,197) ) + mat(k,180) = -( rxt(k,299) + rxt(k,300) + het_rates(k,198) ) + mat(k,63) = rxt(k,42) + mat(k,576) = -( het_rates(k,199) ) + mat(k,1390) = -( rxt(k,481) + het_rates(k,200) ) + mat(k,273) = rxt(k,11) + rxt(k,172) + mat(k,539) = rxt(k,19) + mat(k,529) = .900_r8*rxt(k,20) + mat(k,288) = rxt(k,21) + mat(k,90) = 1.500_r8*rxt(k,22) + mat(k,295) = .560_r8*rxt(k,23) + mat(k,355) = rxt(k,24) + mat(k,192) = .600_r8*rxt(k,25) + mat(k,506) = .600_r8*rxt(k,26) + mat(k,228) = rxt(k,27) + mat(k,243) = rxt(k,28) + mat(k,248) = rxt(k,29) + mat(k,317) = rxt(k,30) + mat(k,1000) = rxt(k,34) + mat(k,1076) = rxt(k,36) + mat(k,867) = 2.000_r8*rxt(k,43) + mat(k,741) = 2.000_r8*rxt(k,44) + mat(k,905) = .670_r8*rxt(k,45) + mat(k,153) = rxt(k,46) + mat(k,918) = rxt(k,47) + mat(k,311) = rxt(k,48) + mat(k,556) = rxt(k,49) + mat(k,1066) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) + mat(k,879) = rxt(k,56) + mat(k,237) = rxt(k,61) + mat(k,439) = rxt(k,62) + mat(k,124) = rxt(k,64) + mat(k,489) = rxt(k,65) + mat(k,510) = rxt(k,66) + mat(k,371) = rxt(k,67) + mat(k,861) = rxt(k,68) + mat(k,890) = 1.200_r8*rxt(k,69) + mat(k,501) = rxt(k,70) + mat(k,572) = rxt(k,72) + mat(k,330) = rxt(k,73) + mat(k,1278) = rxt(k,137) + mat(k,342) = rxt(k,269) + mat(k,182) = rxt(k,299) + rxt(k,300) + mat(k,1191) = rxt(k,373) + mat(k,1728) = rxt(k,239)*y(k,43) + rxt(k,242)*y(k,46) + mat(k,1618) = rxt(k,240)*y(k,43) + rxt(k,243)*y(k,46) + mat(k,1471) = rxt(k,272)*y(k,54) + end do + end subroutine linmat02 + subroutine linmat03( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,340) = -( rxt(k,269) + het_rates(k,201) ) + mat(k,1108) = -( het_rates(k,202) ) + mat(k,1186) = -( rxt(k,373) + het_rates(k,203) ) + mat(k,1153) = -( het_rates(k,204) ) + mat(k,583) = -( het_rates(k,205) ) + mat(k,354) = .600_r8*rxt(k,24) + mat(k,1205) = -( het_rates(k,206) ) + mat(k,1063) = .660_r8*rxt(k,50) + mat(k,417) = rxt(k,54) + rxt(k,355) + mat(k,744) = -( het_rates(k,207) ) + mat(k,504) = .600_r8*rxt(k,26) + mat(k,544) = -( het_rates(k,208) ) + mat(k,969) = -( het_rates(k,209) ) + mat(k,1473) = -( rxt(k,126) + rxt(k,127) + rxt(k,166)*y(k,113) & + + rxt(k,167)*y(k,113) + rxt(k,199)*y(k,33) + rxt(k,200)*y(k,34) & + + rxt(k,201)*y(k,36) + rxt(k,202)*y(k,37) + rxt(k,203)*y(k,38) & + + rxt(k,204)*y(k,39) + rxt(k,205)*y(k,40) + rxt(k,226)*y(k,35) & + + rxt(k,227)*y(k,55) + rxt(k,228)*y(k,78) + rxt(k,249)*y(k,41) & + + rxt(k,250)*y(k,43) + rxt(k,251)*y(k,82) + rxt(k,252)*y(k,83) & + + rxt(k,253)*y(k,84) + rxt(k,271)*y(k,54) + rxt(k,272)*y(k,54) & + + rxt(k,273)*y(k,54) + het_rates(k,210) ) + mat(k,2011) = rxt(k,1) + mat(k,1831) = rxt(k,7) + mat(k,1621) = -( rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,241)*y(k,44) & + + rxt(k,243)*y(k,46) + rxt(k,245)*y(k,55) + rxt(k,246)*y(k,82) & + + rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) + rxt(k,264)*y(k,54) & + + het_rates(k,211) ) + mat(k,2012) = rxt(k,2) + mat(k,479) = 2.000_r8*rxt(k,4) + mat(k,1268) = rxt(k,9) + mat(k,275) = rxt(k,10) + mat(k,530) = rxt(k,20) + mat(k,289) = rxt(k,21) + mat(k,244) = rxt(k,28) + mat(k,249) = rxt(k,29) + mat(k,318) = rxt(k,30) + mat(k,179) = rxt(k,31) + mat(k,393) = rxt(k,37) + mat(k,322) = rxt(k,38) + mat(k,64) = rxt(k,42) + mat(k,154) = rxt(k,46) + mat(k,223) = rxt(k,53) + mat(k,300) = rxt(k,58) + mat(k,238) = rxt(k,61) + mat(k,440) = rxt(k,62) + mat(k,305) = rxt(k,63) + mat(k,490) = rxt(k,65) + mat(k,372) = rxt(k,67) + mat(k,502) = rxt(k,70) + mat(k,127) = rxt(k,71) + mat(k,573) = rxt(k,72) + mat(k,331) = rxt(k,73) + mat(k,643) = rxt(k,105) + mat(k,679) = rxt(k,106) + mat(k,1772) = .500_r8*rxt(k,489) + mat(k,1474) = rxt(k,271)*y(k,54) + mat(k,347) = -( het_rates(k,212) ) + mat(k,630) = -( het_rates(k,213) ) + mat(k,985) = -( het_rates(k,214) ) + mat(k,888) = .150_r8*rxt(k,69) + mat(k,950) = -( het_rates(k,215) ) + mat(k,928) = -( het_rates(k,216) ) + mat(k,594) = -( het_rates(k,217) ) + mat(k,1024) = -( het_rates(k,218) ) + mat(k,610) = -( het_rates(k,219) ) + mat(k,384) = -( het_rates(k,220) ) + mat(k,2022) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,221) ) + mat(k,67) = rxt(k,109) + mat(k,1631) = rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,241)*y(k,44) & + + rxt(k,243)*y(k,46) + rxt(k,248)*y(k,84) + rxt(k,264)*y(k,54) + end do + end subroutine linmat03 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 new file mode 100644 index 0000000000..2999e5250b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 @@ -0,0 +1,7314 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = 1._r8 / lu(k,3) + lu(k,4) = 1._r8 / lu(k,4) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = 1._r8 / lu(k,6) + lu(k,7) = 1._r8 / lu(k,7) + lu(k,8) = 1._r8 / lu(k,8) + lu(k,9) = 1._r8 / lu(k,9) + lu(k,10) = 1._r8 / lu(k,10) + lu(k,11) = 1._r8 / lu(k,11) + lu(k,12) = 1._r8 / lu(k,12) + lu(k,13) = 1._r8 / lu(k,13) + lu(k,14) = 1._r8 / lu(k,14) + lu(k,15) = 1._r8 / lu(k,15) + lu(k,16) = 1._r8 / lu(k,16) + lu(k,17) = 1._r8 / lu(k,17) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,19) = 1._r8 / lu(k,19) + lu(k,20) = 1._r8 / lu(k,20) + lu(k,21) = 1._r8 / lu(k,21) + lu(k,22) = 1._r8 / lu(k,22) + lu(k,23) = 1._r8 / lu(k,23) + lu(k,24) = 1._r8 / lu(k,24) + lu(k,25) = 1._r8 / lu(k,25) + lu(k,26) = 1._r8 / lu(k,26) + lu(k,27) = 1._r8 / lu(k,27) + lu(k,28) = 1._r8 / lu(k,28) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = 1._r8 / lu(k,30) + lu(k,31) = 1._r8 / lu(k,31) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = 1._r8 / lu(k,33) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = lu(k,47) * lu(k,46) + lu(k,48) = lu(k,48) * lu(k,46) + lu(k,1699) = lu(k,1699) - lu(k,47) * lu(k,1682) + lu(k,1700) = lu(k,1700) - lu(k,48) * lu(k,1682) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,50) = lu(k,50) * lu(k,49) + lu(k,51) = lu(k,51) * lu(k,49) + lu(k,1621) = lu(k,1621) - lu(k,50) * lu(k,1492) + lu(k,1631) = lu(k,1631) - lu(k,51) * lu(k,1492) + lu(k,52) = 1._r8 / lu(k,52) + lu(k,53) = lu(k,53) * lu(k,52) + lu(k,54) = lu(k,54) * lu(k,52) + lu(k,1618) = lu(k,1618) - lu(k,53) * lu(k,1493) + lu(k,1621) = lu(k,1621) - lu(k,54) * lu(k,1493) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = lu(k,56) * lu(k,55) + lu(k,57) = lu(k,57) * lu(k,55) + lu(k,58) = lu(k,58) * lu(k,55) + lu(k,1575) = lu(k,1575) - lu(k,56) * lu(k,1494) + lu(k,1621) = lu(k,1621) - lu(k,57) * lu(k,1494) + lu(k,1631) = lu(k,1631) - lu(k,58) * lu(k,1494) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = lu(k,60) * lu(k,59) + lu(k,61) = lu(k,61) * lu(k,59) + lu(k,1464) = lu(k,1464) - lu(k,60) * lu(k,1461) + lu(k,1473) = lu(k,1473) - lu(k,61) * lu(k,1461) + lu(k,1572) = - lu(k,60) * lu(k,1495) + lu(k,1620) = - lu(k,61) * lu(k,1495) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,62) = 1._r8 / lu(k,62) + lu(k,63) = lu(k,63) * lu(k,62) + lu(k,64) = lu(k,64) * lu(k,62) + lu(k,575) = lu(k,575) - lu(k,63) * lu(k,574) + lu(k,579) = - lu(k,64) * lu(k,574) + lu(k,1313) = - lu(k,63) * lu(k,1310) + lu(k,1393) = lu(k,1393) - lu(k,64) * lu(k,1310) + lu(k,65) = 1._r8 / lu(k,65) + lu(k,66) = lu(k,66) * lu(k,65) + lu(k,67) = lu(k,67) * lu(k,65) + lu(k,168) = lu(k,168) - lu(k,66) * lu(k,167) + lu(k,171) = lu(k,171) - lu(k,67) * lu(k,167) + lu(k,2000) = lu(k,2000) - lu(k,66) * lu(k,1998) + lu(k,2022) = lu(k,2022) - lu(k,67) * lu(k,1998) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,69) = lu(k,69) * lu(k,68) + lu(k,70) = lu(k,70) * lu(k,68) + lu(k,553) = lu(k,553) - lu(k,69) * lu(k,551) + lu(k,557) = lu(k,557) - lu(k,70) * lu(k,551) + lu(k,1603) = lu(k,1603) - lu(k,69) * lu(k,1496) + lu(k,1621) = lu(k,1621) - lu(k,70) * lu(k,1496) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,72) = lu(k,72) * lu(k,71) + lu(k,73) = lu(k,73) * lu(k,71) + lu(k,409) = lu(k,409) - lu(k,72) * lu(k,408) + lu(k,413) = lu(k,413) - lu(k,73) * lu(k,408) + lu(k,1748) = lu(k,1748) - lu(k,72) * lu(k,1742) + lu(k,1776) = lu(k,1776) - lu(k,73) * lu(k,1742) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,75) = lu(k,75) * lu(k,74) + lu(k,681) = lu(k,681) - lu(k,75) * lu(k,676) + lu(k,833) = lu(k,833) - lu(k,75) * lu(k,825) + lu(k,1303) = lu(k,1303) - lu(k,75) * lu(k,1288) + lu(k,1700) = lu(k,1700) - lu(k,75) * lu(k,1683) + lu(k,1734) = lu(k,1734) - lu(k,75) * lu(k,1708) + lu(k,81) = 1._r8 / lu(k,81) + lu(k,82) = lu(k,82) * lu(k,81) + lu(k,83) = lu(k,83) * lu(k,81) + lu(k,84) = lu(k,84) * lu(k,81) + lu(k,85) = lu(k,85) * lu(k,81) + lu(k,86) = lu(k,86) * lu(k,81) + lu(k,1498) = lu(k,1498) - lu(k,82) * lu(k,1497) + lu(k,1499) = lu(k,1499) - lu(k,83) * lu(k,1497) + lu(k,1542) = lu(k,1542) - lu(k,84) * lu(k,1497) + lu(k,1618) = lu(k,1618) - lu(k,85) * lu(k,1497) + lu(k,1621) = lu(k,1621) - lu(k,86) * lu(k,1497) + lu(k,87) = 1._r8 / lu(k,87) + lu(k,88) = lu(k,88) * lu(k,87) + lu(k,89) = lu(k,89) * lu(k,87) + lu(k,90) = lu(k,90) * lu(k,87) + lu(k,1538) = - lu(k,88) * lu(k,1498) + lu(k,1595) = lu(k,1595) - lu(k,89) * lu(k,1498) + lu(k,1618) = lu(k,1618) - lu(k,90) * lu(k,1498) + lu(k,91) = 1._r8 / lu(k,91) + lu(k,92) = lu(k,92) * lu(k,91) + lu(k,93) = lu(k,93) * lu(k,91) + lu(k,94) = lu(k,94) * lu(k,91) + lu(k,95) = lu(k,95) * lu(k,91) + lu(k,1537) = lu(k,1537) - lu(k,92) * lu(k,1499) + lu(k,1540) = lu(k,1540) - lu(k,93) * lu(k,1499) + lu(k,1618) = lu(k,1618) - lu(k,94) * lu(k,1499) + lu(k,1621) = lu(k,1621) - lu(k,95) * lu(k,1499) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = lu(k,97) * lu(k,96) + lu(k,98) = lu(k,98) * lu(k,96) + lu(k,99) = lu(k,99) * lu(k,96) + lu(k,1471) = lu(k,1471) - lu(k,97) * lu(k,1462) + lu(k,1473) = lu(k,1473) - lu(k,98) * lu(k,1462) + lu(k,1474) = lu(k,1474) - lu(k,99) * lu(k,1462) + lu(k,1618) = lu(k,1618) - lu(k,97) * lu(k,1500) + lu(k,1620) = lu(k,1620) - lu(k,98) * lu(k,1500) + lu(k,1621) = lu(k,1621) - lu(k,99) * lu(k,1500) + lu(k,100) = 1._r8 / lu(k,100) + lu(k,101) = lu(k,101) * lu(k,100) + lu(k,102) = lu(k,102) * lu(k,100) + lu(k,103) = lu(k,103) * lu(k,100) + lu(k,1464) = lu(k,1464) - lu(k,101) * lu(k,1463) + lu(k,1473) = lu(k,1473) - lu(k,102) * lu(k,1463) + lu(k,1477) = lu(k,1477) - lu(k,103) * lu(k,1463) + lu(k,1572) = lu(k,1572) - lu(k,101) * lu(k,1501) + lu(k,1620) = lu(k,1620) - lu(k,102) * lu(k,1501) + lu(k,1624) = lu(k,1624) - lu(k,103) * lu(k,1501) + lu(k,109) = 1._r8 / lu(k,109) + lu(k,110) = lu(k,110) * lu(k,109) + lu(k,111) = lu(k,111) * lu(k,109) + lu(k,112) = lu(k,112) * lu(k,109) + lu(k,113) = lu(k,113) * lu(k,109) + lu(k,114) = lu(k,114) * lu(k,109) + lu(k,115) = lu(k,115) * lu(k,109) + lu(k,1503) = lu(k,1503) - lu(k,110) * lu(k,1502) + lu(k,1504) = lu(k,1504) - lu(k,111) * lu(k,1502) + lu(k,1536) = lu(k,1536) - lu(k,112) * lu(k,1502) + lu(k,1568) = lu(k,1568) - lu(k,113) * lu(k,1502) + lu(k,1618) = lu(k,1618) - lu(k,114) * lu(k,1502) + lu(k,1621) = lu(k,1621) - lu(k,115) * lu(k,1502) + lu(k,116) = 1._r8 / lu(k,116) + lu(k,117) = lu(k,117) * lu(k,116) + lu(k,118) = lu(k,118) * lu(k,116) + lu(k,119) = lu(k,119) * lu(k,116) + lu(k,120) = lu(k,120) * lu(k,116) + lu(k,1537) = lu(k,1537) - lu(k,117) * lu(k,1503) + lu(k,1540) = lu(k,1540) - lu(k,118) * lu(k,1503) + lu(k,1618) = lu(k,1618) - lu(k,119) * lu(k,1503) + lu(k,1621) = lu(k,1621) - lu(k,120) * lu(k,1503) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,121) = 1._r8 / lu(k,121) + lu(k,122) = lu(k,122) * lu(k,121) + lu(k,123) = lu(k,123) * lu(k,121) + lu(k,124) = lu(k,124) * lu(k,121) + lu(k,138) = - lu(k,122) * lu(k,133) + lu(k,139) = - lu(k,123) * lu(k,133) + lu(k,140) = lu(k,140) - lu(k,124) * lu(k,133) + lu(k,1595) = lu(k,1595) - lu(k,122) * lu(k,1504) + lu(k,1613) = lu(k,1613) - lu(k,123) * lu(k,1504) + lu(k,1618) = lu(k,1618) - lu(k,124) * lu(k,1504) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,1024) = lu(k,1024) - lu(k,126) * lu(k,1018) + lu(k,1030) = - lu(k,127) * lu(k,1018) + lu(k,1376) = lu(k,1376) - lu(k,126) * lu(k,1311) + lu(k,1393) = lu(k,1393) - lu(k,127) * lu(k,1311) + lu(k,1603) = lu(k,1603) - lu(k,126) * lu(k,1505) + lu(k,1621) = lu(k,1621) - lu(k,127) * lu(k,1505) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,137) = lu(k,137) * lu(k,134) + lu(k,138) = lu(k,138) * lu(k,134) + lu(k,139) = lu(k,139) * lu(k,134) + lu(k,140) = lu(k,140) * lu(k,134) + lu(k,141) = lu(k,141) * lu(k,134) + lu(k,1507) = lu(k,1507) - lu(k,135) * lu(k,1506) + lu(k,1536) = lu(k,1536) - lu(k,136) * lu(k,1506) + lu(k,1569) = lu(k,1569) - lu(k,137) * lu(k,1506) + lu(k,1595) = lu(k,1595) - lu(k,138) * lu(k,1506) + lu(k,1613) = lu(k,1613) - lu(k,139) * lu(k,1506) + lu(k,1618) = lu(k,1618) - lu(k,140) * lu(k,1506) + lu(k,1621) = lu(k,1621) - lu(k,141) * lu(k,1506) + lu(k,142) = 1._r8 / lu(k,142) + lu(k,143) = lu(k,143) * lu(k,142) + lu(k,144) = lu(k,144) * lu(k,142) + lu(k,145) = lu(k,145) * lu(k,142) + lu(k,146) = lu(k,146) * lu(k,142) + lu(k,1540) = lu(k,1540) - lu(k,143) * lu(k,1507) + lu(k,1543) = lu(k,1543) - lu(k,144) * lu(k,1507) + lu(k,1618) = lu(k,1618) - lu(k,145) * lu(k,1507) + lu(k,1621) = lu(k,1621) - lu(k,146) * lu(k,1507) + lu(k,147) = 1._r8 / lu(k,147) + lu(k,148) = lu(k,148) * lu(k,147) + lu(k,149) = lu(k,149) * lu(k,147) + lu(k,649) = lu(k,649) - lu(k,148) * lu(k,648) + lu(k,652) = lu(k,652) - lu(k,149) * lu(k,648) + lu(k,1006) = lu(k,1006) - lu(k,148) * lu(k,1005) + lu(k,1009) = lu(k,1009) - lu(k,149) * lu(k,1005) + lu(k,1261) = lu(k,1261) - lu(k,148) * lu(k,1260) + lu(k,1264) = - lu(k,149) * lu(k,1260) + lu(k,2001) = lu(k,2001) - lu(k,148) * lu(k,1999) + lu(k,2007) = lu(k,2007) - lu(k,149) * lu(k,1999) + lu(k,150) = 1._r8 / lu(k,150) + lu(k,151) = lu(k,151) * lu(k,150) + lu(k,152) = lu(k,152) * lu(k,150) + lu(k,153) = lu(k,153) * lu(k,150) + lu(k,154) = lu(k,154) * lu(k,150) + lu(k,1169) = - lu(k,151) * lu(k,1166) + lu(k,1181) = - lu(k,152) * lu(k,1166) + lu(k,1191) = lu(k,1191) - lu(k,153) * lu(k,1166) + lu(k,1193) = - lu(k,154) * lu(k,1166) + lu(k,1558) = - lu(k,151) * lu(k,1508) + lu(k,1603) = lu(k,1603) - lu(k,152) * lu(k,1508) + lu(k,1618) = lu(k,1618) - lu(k,153) * lu(k,1508) + lu(k,1621) = lu(k,1621) - lu(k,154) * lu(k,1508) + lu(k,155) = 1._r8 / lu(k,155) + lu(k,156) = lu(k,156) * lu(k,155) + lu(k,157) = lu(k,157) * lu(k,155) + lu(k,904) = lu(k,904) - lu(k,156) * lu(k,895) + lu(k,908) = lu(k,908) - lu(k,157) * lu(k,895) + lu(k,953) = - lu(k,156) * lu(k,943) + lu(k,958) = lu(k,958) - lu(k,157) * lu(k,943) + lu(k,1615) = lu(k,1615) - lu(k,156) * lu(k,1509) + lu(k,1625) = lu(k,1625) - lu(k,157) * lu(k,1509) + lu(k,1981) = - lu(k,156) * lu(k,1920) + lu(k,1991) = lu(k,1991) - lu(k,157) * lu(k,1920) + lu(k,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,762) = - lu(k,159) * lu(k,757) + lu(k,774) = lu(k,774) - lu(k,160) * lu(k,757) + lu(k,788) = - lu(k,159) * lu(k,783) + lu(k,800) = lu(k,800) - lu(k,160) * lu(k,783) + lu(k,1586) = lu(k,1586) - lu(k,159) * lu(k,1510) + lu(k,1621) = lu(k,1621) - lu(k,160) * lu(k,1510) + lu(k,1802) = - lu(k,159) * lu(k,1788) + lu(k,1832) = lu(k,1832) - lu(k,160) * lu(k,1788) + lu(k,161) = 1._r8 / lu(k,161) + lu(k,162) = lu(k,162) * lu(k,161) + lu(k,163) = lu(k,163) * lu(k,161) + lu(k,641) = lu(k,641) - lu(k,162) * lu(k,639) + lu(k,644) = - lu(k,163) * lu(k,639) + lu(k,1293) = - lu(k,162) * lu(k,1289) + lu(k,1303) = lu(k,1303) - lu(k,163) * lu(k,1289) + lu(k,1690) = lu(k,1690) - lu(k,162) * lu(k,1684) + lu(k,1700) = lu(k,1700) - lu(k,163) * lu(k,1684) + lu(k,1849) = lu(k,1849) - lu(k,162) * lu(k,1843) + lu(k,1859) = lu(k,1859) - lu(k,163) * lu(k,1843) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,242) = - lu(k,165) * lu(k,239) + lu(k,244) = lu(k,244) - lu(k,166) * lu(k,239) + lu(k,335) = - lu(k,165) * lu(k,332) + lu(k,337) = - lu(k,166) * lu(k,332) + lu(k,1547) = lu(k,1547) - lu(k,165) * lu(k,1511) + lu(k,1621) = lu(k,1621) - lu(k,166) * lu(k,1511) + lu(k,1935) = lu(k,1935) - lu(k,165) * lu(k,1921) + lu(k,1987) = lu(k,1987) - lu(k,166) * lu(k,1921) + lu(k,168) = 1._r8 / lu(k,168) + lu(k,169) = lu(k,169) * lu(k,168) + lu(k,170) = lu(k,170) * lu(k,168) + lu(k,171) = lu(k,171) * lu(k,168) + lu(k,726) = lu(k,726) - lu(k,169) * lu(k,725) + lu(k,730) = lu(k,730) - lu(k,170) * lu(k,725) + lu(k,731) = - lu(k,171) * lu(k,725) + lu(k,1580) = lu(k,1580) - lu(k,169) * lu(k,1512) + lu(k,1628) = lu(k,1628) - lu(k,170) * lu(k,1512) + lu(k,1631) = lu(k,1631) - lu(k,171) * lu(k,1512) + lu(k,2002) = - lu(k,169) * lu(k,2000) + lu(k,2019) = lu(k,2019) - lu(k,170) * lu(k,2000) + lu(k,2022) = lu(k,2022) - lu(k,171) * lu(k,2000) + lu(k,172) = 1._r8 / lu(k,172) + lu(k,173) = lu(k,173) * lu(k,172) + lu(k,174) = lu(k,174) * lu(k,172) + lu(k,175) = lu(k,175) * lu(k,172) + lu(k,688) = lu(k,688) - lu(k,173) * lu(k,684) + lu(k,689) = lu(k,689) - lu(k,174) * lu(k,684) + lu(k,690) = - lu(k,175) * lu(k,684) + lu(k,1601) = lu(k,1601) - lu(k,173) * lu(k,1513) + lu(k,1618) = lu(k,1618) - lu(k,174) * lu(k,1513) + lu(k,1621) = lu(k,1621) - lu(k,175) * lu(k,1513) + lu(k,1654) = lu(k,1654) - lu(k,173) * lu(k,1632) + lu(k,1668) = lu(k,1668) - lu(k,174) * lu(k,1632) + lu(k,1671) = - lu(k,175) * lu(k,1632) + lu(k,176) = 1._r8 / lu(k,176) + lu(k,177) = lu(k,177) * lu(k,176) + lu(k,178) = lu(k,178) * lu(k,176) + lu(k,179) = lu(k,179) * lu(k,176) + lu(k,514) = lu(k,514) - lu(k,177) * lu(k,513) + lu(k,515) = lu(k,515) - lu(k,178) * lu(k,513) + lu(k,517) = - lu(k,179) * lu(k,513) + lu(k,1331) = - lu(k,177) * lu(k,1312) + lu(k,1343) = lu(k,1343) - lu(k,178) * lu(k,1312) + lu(k,1393) = lu(k,1393) - lu(k,179) * lu(k,1312) + lu(k,1540) = lu(k,1540) - lu(k,177) * lu(k,1514) + lu(k,1560) = lu(k,1560) - lu(k,178) * lu(k,1514) + lu(k,1621) = lu(k,1621) - lu(k,179) * lu(k,1514) + lu(k,180) = 1._r8 / lu(k,180) + lu(k,181) = lu(k,181) * lu(k,180) + lu(k,182) = lu(k,182) * lu(k,180) + lu(k,183) = lu(k,183) * lu(k,180) + lu(k,577) = - lu(k,181) * lu(k,575) + lu(k,578) = lu(k,578) - lu(k,182) * lu(k,575) + lu(k,581) = lu(k,581) - lu(k,183) * lu(k,575) + lu(k,1366) = - lu(k,181) * lu(k,1313) + lu(k,1390) = lu(k,1390) - lu(k,182) * lu(k,1313) + lu(k,1401) = lu(k,1401) - lu(k,183) * lu(k,1313) + lu(k,1959) = lu(k,1959) - lu(k,181) * lu(k,1922) + lu(k,1984) = lu(k,1984) - lu(k,182) * lu(k,1922) + lu(k,1995) = lu(k,1995) - lu(k,183) * lu(k,1922) + lu(k,184) = 1._r8 / lu(k,184) + lu(k,185) = lu(k,185) * lu(k,184) + lu(k,186) = lu(k,186) * lu(k,184) + lu(k,187) = lu(k,187) * lu(k,184) + lu(k,188) = lu(k,188) * lu(k,184) + lu(k,189) = lu(k,189) * lu(k,184) + lu(k,1444) = lu(k,1444) - lu(k,185) * lu(k,1406) + lu(k,1448) = lu(k,1448) - lu(k,186) * lu(k,1406) + lu(k,1454) = lu(k,1454) - lu(k,187) * lu(k,1406) + lu(k,1457) = lu(k,1457) - lu(k,188) * lu(k,1406) + lu(k,1459) = lu(k,1459) - lu(k,189) * lu(k,1406) + lu(k,1766) = lu(k,1766) - lu(k,185) * lu(k,1743) + lu(k,1770) = lu(k,1770) - lu(k,186) * lu(k,1743) + lu(k,1776) = lu(k,1776) - lu(k,187) * lu(k,1743) + lu(k,1779) = lu(k,1779) - lu(k,188) * lu(k,1743) + lu(k,1781) = lu(k,1781) - lu(k,189) * lu(k,1743) + lu(k,190) = 1._r8 / lu(k,190) + lu(k,191) = lu(k,191) * lu(k,190) + lu(k,192) = lu(k,192) * lu(k,190) + lu(k,498) = - lu(k,191) * lu(k,492) + lu(k,501) = lu(k,501) - lu(k,192) * lu(k,492) + lu(k,566) = - lu(k,191) * lu(k,559) + lu(k,572) = lu(k,572) - lu(k,192) * lu(k,559) + lu(k,595) = - lu(k,191) * lu(k,589) + lu(k,600) = lu(k,600) - lu(k,192) * lu(k,589) + lu(k,611) = - lu(k,191) * lu(k,604) + lu(k,617) = lu(k,617) - lu(k,192) * lu(k,604) + lu(k,1948) = lu(k,1948) - lu(k,191) * lu(k,1923) + lu(k,1984) = lu(k,1984) - lu(k,192) * lu(k,1923) + lu(k,193) = 1._r8 / lu(k,193) + lu(k,194) = lu(k,194) * lu(k,193) + lu(k,195) = lu(k,195) * lu(k,193) + lu(k,196) = lu(k,196) * lu(k,193) + lu(k,197) = lu(k,197) * lu(k,193) + lu(k,198) = lu(k,198) * lu(k,193) + lu(k,1412) = lu(k,1412) - lu(k,194) * lu(k,1407) + lu(k,1444) = lu(k,1444) - lu(k,195) * lu(k,1407) + lu(k,1447) = lu(k,1447) - lu(k,196) * lu(k,1407) + lu(k,1448) = lu(k,1448) - lu(k,197) * lu(k,1407) + lu(k,1450) = lu(k,1450) - lu(k,198) * lu(k,1407) + lu(k,1580) = lu(k,1580) - lu(k,194) * lu(k,1515) + lu(k,1615) = lu(k,1615) - lu(k,195) * lu(k,1515) + lu(k,1618) = lu(k,1618) - lu(k,196) * lu(k,1515) + lu(k,1619) = lu(k,1619) - lu(k,197) * lu(k,1515) + lu(k,1621) = lu(k,1621) - lu(k,198) * lu(k,1515) + lu(k,199) = 1._r8 / lu(k,199) + lu(k,200) = lu(k,200) * lu(k,199) + lu(k,201) = lu(k,201) * lu(k,199) + lu(k,202) = lu(k,202) * lu(k,199) + lu(k,203) = lu(k,203) * lu(k,199) + lu(k,204) = lu(k,204) * lu(k,199) + lu(k,1573) = lu(k,1573) - lu(k,200) * lu(k,1516) + lu(k,1582) = lu(k,1582) - lu(k,201) * lu(k,1516) + lu(k,1595) = lu(k,1595) - lu(k,202) * lu(k,1516) + lu(k,1618) = lu(k,1618) - lu(k,203) * lu(k,1516) + lu(k,1621) = lu(k,1621) - lu(k,204) * lu(k,1516) + lu(k,1714) = - lu(k,200) * lu(k,1709) + lu(k,1717) = - lu(k,201) * lu(k,1709) + lu(k,1720) = lu(k,1720) - lu(k,202) * lu(k,1709) + lu(k,1728) = lu(k,1728) - lu(k,203) * lu(k,1709) + lu(k,1731) = lu(k,1731) - lu(k,204) * lu(k,1709) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,205) = 1._r8 / lu(k,205) + lu(k,206) = lu(k,206) * lu(k,205) + lu(k,207) = lu(k,207) * lu(k,205) + lu(k,208) = lu(k,208) * lu(k,205) + lu(k,209) = lu(k,209) * lu(k,205) + lu(k,210) = lu(k,210) * lu(k,205) + lu(k,1577) = lu(k,1577) - lu(k,206) * lu(k,1517) + lu(k,1617) = lu(k,1617) - lu(k,207) * lu(k,1517) + lu(k,1621) = lu(k,1621) - lu(k,208) * lu(k,1517) + lu(k,1624) = lu(k,1624) - lu(k,209) * lu(k,1517) + lu(k,1631) = lu(k,1631) - lu(k,210) * lu(k,1517) + lu(k,1716) = lu(k,1716) - lu(k,206) * lu(k,1710) + lu(k,1727) = lu(k,1727) - lu(k,207) * lu(k,1710) + lu(k,1731) = lu(k,1731) - lu(k,208) * lu(k,1710) + lu(k,1734) = lu(k,1734) - lu(k,209) * lu(k,1710) + lu(k,1741) = - lu(k,210) * lu(k,1710) + lu(k,211) = 1._r8 / lu(k,211) + lu(k,212) = lu(k,212) * lu(k,211) + lu(k,213) = lu(k,213) * lu(k,211) + lu(k,1181) = lu(k,1181) - lu(k,212) * lu(k,1167) + lu(k,1193) = lu(k,1193) - lu(k,213) * lu(k,1167) + lu(k,1227) = lu(k,1227) - lu(k,212) * lu(k,1218) + lu(k,1241) = lu(k,1241) - lu(k,213) * lu(k,1218) + lu(k,1432) = lu(k,1432) - lu(k,212) * lu(k,1408) + lu(k,1450) = lu(k,1450) - lu(k,213) * lu(k,1408) + lu(k,1603) = lu(k,1603) - lu(k,212) * lu(k,1518) + lu(k,1621) = lu(k,1621) - lu(k,213) * lu(k,1518) + lu(k,1655) = lu(k,1655) - lu(k,212) * lu(k,1633) + lu(k,1671) = lu(k,1671) - lu(k,213) * lu(k,1633) + lu(k,1970) = lu(k,1970) - lu(k,212) * lu(k,1924) + lu(k,1987) = lu(k,1987) - lu(k,213) * lu(k,1924) + lu(k,214) = 1._r8 / lu(k,214) + lu(k,215) = lu(k,215) * lu(k,214) + lu(k,216) = lu(k,216) * lu(k,214) + lu(k,217) = lu(k,217) * lu(k,214) + lu(k,218) = lu(k,218) * lu(k,214) + lu(k,1153) = lu(k,1153) - lu(k,215) * lu(k,1144) + lu(k,1154) = - lu(k,216) * lu(k,1144) + lu(k,1158) = lu(k,1158) - lu(k,217) * lu(k,1144) + lu(k,1160) = - lu(k,218) * lu(k,1144) + lu(k,1382) = lu(k,1382) - lu(k,215) * lu(k,1314) + lu(k,1384) = lu(k,1384) - lu(k,216) * lu(k,1314) + lu(k,1390) = lu(k,1390) - lu(k,217) * lu(k,1314) + lu(k,1393) = lu(k,1393) - lu(k,218) * lu(k,1314) + lu(k,1610) = lu(k,1610) - lu(k,215) * lu(k,1519) + lu(k,1612) = lu(k,1612) - lu(k,216) * lu(k,1519) + lu(k,1618) = lu(k,1618) - lu(k,217) * lu(k,1519) + lu(k,1621) = lu(k,1621) - lu(k,218) * lu(k,1519) + lu(k,219) = 1._r8 / lu(k,219) + lu(k,220) = lu(k,220) * lu(k,219) + lu(k,221) = lu(k,221) * lu(k,219) + lu(k,222) = lu(k,222) * lu(k,219) + lu(k,223) = lu(k,223) * lu(k,219) + lu(k,544) = lu(k,544) - lu(k,220) * lu(k,543) + lu(k,545) = lu(k,545) - lu(k,221) * lu(k,543) + lu(k,546) = lu(k,546) - lu(k,222) * lu(k,543) + lu(k,548) = lu(k,548) - lu(k,223) * lu(k,543) + lu(k,1345) = lu(k,1345) - lu(k,220) * lu(k,1315) + lu(k,1374) = lu(k,1374) - lu(k,221) * lu(k,1315) + lu(k,1385) = lu(k,1385) - lu(k,222) * lu(k,1315) + lu(k,1393) = lu(k,1393) - lu(k,223) * lu(k,1315) + lu(k,1563) = lu(k,1563) - lu(k,220) * lu(k,1520) + lu(k,1601) = lu(k,1601) - lu(k,221) * lu(k,1520) + lu(k,1613) = lu(k,1613) - lu(k,222) * lu(k,1520) + lu(k,1621) = lu(k,1621) - lu(k,223) * lu(k,1520) + lu(k,224) = 1._r8 / lu(k,224) + lu(k,225) = lu(k,225) * lu(k,224) + lu(k,226) = lu(k,226) * lu(k,224) + lu(k,227) = lu(k,227) * lu(k,224) + lu(k,228) = lu(k,228) * lu(k,224) + lu(k,569) = - lu(k,225) * lu(k,560) + lu(k,570) = lu(k,570) - lu(k,226) * lu(k,560) + lu(k,571) = - lu(k,227) * lu(k,560) + lu(k,572) = lu(k,572) - lu(k,228) * lu(k,560) + lu(k,614) = - lu(k,225) * lu(k,605) + lu(k,615) = lu(k,615) - lu(k,226) * lu(k,605) + lu(k,616) = - lu(k,227) * lu(k,605) + lu(k,617) = lu(k,617) - lu(k,228) * lu(k,605) + lu(k,1963) = lu(k,1963) - lu(k,225) * lu(k,1925) + lu(k,1973) = lu(k,1973) - lu(k,226) * lu(k,1925) + lu(k,1979) = lu(k,1979) - lu(k,227) * lu(k,1925) + lu(k,1984) = lu(k,1984) - lu(k,228) * lu(k,1925) + lu(k,229) = 1._r8 / lu(k,229) + lu(k,230) = lu(k,230) * lu(k,229) + lu(k,231) = lu(k,231) * lu(k,229) + lu(k,232) = lu(k,232) * lu(k,229) + lu(k,233) = lu(k,233) * lu(k,229) + lu(k,1082) = lu(k,1082) - lu(k,230) * lu(k,1080) + lu(k,1083) = lu(k,1083) - lu(k,231) * lu(k,1080) + lu(k,1088) = lu(k,1088) - lu(k,232) * lu(k,1080) + lu(k,1093) = lu(k,1093) - lu(k,233) * lu(k,1080) + lu(k,1687) = lu(k,1687) - lu(k,230) * lu(k,1685) + lu(k,1689) = lu(k,1689) - lu(k,231) * lu(k,1685) + lu(k,1699) = lu(k,1699) - lu(k,232) * lu(k,1685) + lu(k,1704) = lu(k,1704) - lu(k,233) * lu(k,1685) + lu(k,1847) = lu(k,1847) - lu(k,230) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,231) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,232) * lu(k,1844) + lu(k,1863) = lu(k,1863) - lu(k,233) * lu(k,1844) + lu(k,234) = 1._r8 / lu(k,234) + lu(k,235) = lu(k,235) * lu(k,234) + lu(k,236) = lu(k,236) * lu(k,234) + lu(k,237) = lu(k,237) * lu(k,234) + lu(k,238) = lu(k,238) * lu(k,234) + lu(k,347) = lu(k,347) - lu(k,235) * lu(k,346) + lu(k,348) = lu(k,348) - lu(k,236) * lu(k,346) + lu(k,349) = lu(k,349) - lu(k,237) * lu(k,346) + lu(k,350) = - lu(k,238) * lu(k,346) + lu(k,1329) = lu(k,1329) - lu(k,235) * lu(k,1316) + lu(k,1361) = lu(k,1361) - lu(k,236) * lu(k,1316) + lu(k,1390) = lu(k,1390) - lu(k,237) * lu(k,1316) + lu(k,1393) = lu(k,1393) - lu(k,238) * lu(k,1316) + lu(k,1537) = lu(k,1537) - lu(k,235) * lu(k,1521) + lu(k,1582) = lu(k,1582) - lu(k,236) * lu(k,1521) + lu(k,1618) = lu(k,1618) - lu(k,237) * lu(k,1521) + lu(k,1621) = lu(k,1621) - lu(k,238) * lu(k,1521) + lu(k,240) = 1._r8 / lu(k,240) + lu(k,241) = lu(k,241) * lu(k,240) + lu(k,242) = lu(k,242) * lu(k,240) + lu(k,243) = lu(k,243) * lu(k,240) + lu(k,244) = lu(k,244) * lu(k,240) + lu(k,334) = lu(k,334) - lu(k,241) * lu(k,333) + lu(k,335) = lu(k,335) - lu(k,242) * lu(k,333) + lu(k,336) = lu(k,336) - lu(k,243) * lu(k,333) + lu(k,337) = lu(k,337) - lu(k,244) * lu(k,333) + lu(k,1327) = lu(k,1327) - lu(k,241) * lu(k,1317) + lu(k,1336) = lu(k,1336) - lu(k,242) * lu(k,1317) + lu(k,1390) = lu(k,1390) - lu(k,243) * lu(k,1317) + lu(k,1393) = lu(k,1393) - lu(k,244) * lu(k,1317) + lu(k,1536) = lu(k,1536) - lu(k,241) * lu(k,1522) + lu(k,1547) = lu(k,1547) - lu(k,242) * lu(k,1522) + lu(k,1618) = lu(k,1618) - lu(k,243) * lu(k,1522) + lu(k,1621) = lu(k,1621) - lu(k,244) * lu(k,1522) + lu(k,245) = 1._r8 / lu(k,245) + lu(k,246) = lu(k,246) * lu(k,245) + lu(k,247) = lu(k,247) * lu(k,245) + lu(k,248) = lu(k,248) * lu(k,245) + lu(k,249) = lu(k,249) * lu(k,245) + lu(k,687) = lu(k,687) - lu(k,246) * lu(k,685) + lu(k,688) = lu(k,688) - lu(k,247) * lu(k,685) + lu(k,689) = lu(k,689) - lu(k,248) * lu(k,685) + lu(k,690) = lu(k,690) - lu(k,249) * lu(k,685) + lu(k,1358) = lu(k,1358) - lu(k,246) * lu(k,1318) + lu(k,1374) = lu(k,1374) - lu(k,247) * lu(k,1318) + lu(k,1390) = lu(k,1390) - lu(k,248) * lu(k,1318) + lu(k,1393) = lu(k,1393) - lu(k,249) * lu(k,1318) + lu(k,1577) = lu(k,1577) - lu(k,246) * lu(k,1523) + lu(k,1601) = lu(k,1601) - lu(k,247) * lu(k,1523) + lu(k,1618) = lu(k,1618) - lu(k,248) * lu(k,1523) + lu(k,1621) = lu(k,1621) - lu(k,249) * lu(k,1523) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,250) = 1._r8 / lu(k,250) + lu(k,251) = lu(k,251) * lu(k,250) + lu(k,252) = lu(k,252) * lu(k,250) + lu(k,253) = lu(k,253) * lu(k,250) + lu(k,254) = lu(k,254) * lu(k,250) + lu(k,255) = lu(k,255) * lu(k,250) + lu(k,256) = lu(k,256) * lu(k,250) + lu(k,257) = lu(k,257) * lu(k,250) + lu(k,1545) = lu(k,1545) - lu(k,251) * lu(k,1524) + lu(k,1580) = lu(k,1580) - lu(k,252) * lu(k,1524) + lu(k,1595) = lu(k,1595) - lu(k,253) * lu(k,1524) + lu(k,1607) = lu(k,1607) - lu(k,254) * lu(k,1524) + lu(k,1616) = lu(k,1616) - lu(k,255) * lu(k,1524) + lu(k,1621) = lu(k,1621) - lu(k,256) * lu(k,1524) + lu(k,1628) = lu(k,1628) - lu(k,257) * lu(k,1524) + lu(k,1868) = - lu(k,251) * lu(k,1867) + lu(k,1874) = - lu(k,252) * lu(k,1867) + lu(k,1876) = lu(k,1876) - lu(k,253) * lu(k,1867) + lu(k,1878) = lu(k,1878) - lu(k,254) * lu(k,1867) + lu(k,1881) = lu(k,1881) - lu(k,255) * lu(k,1867) + lu(k,1886) = lu(k,1886) - lu(k,256) * lu(k,1867) + lu(k,1893) = lu(k,1893) - lu(k,257) * lu(k,1867) + lu(k,258) = 1._r8 / lu(k,258) + lu(k,259) = lu(k,259) * lu(k,258) + lu(k,260) = lu(k,260) * lu(k,258) + lu(k,261) = lu(k,261) * lu(k,258) + lu(k,262) = lu(k,262) * lu(k,258) + lu(k,263) = lu(k,263) * lu(k,258) + lu(k,264) = lu(k,264) * lu(k,258) + lu(k,265) = lu(k,265) * lu(k,258) + lu(k,1410) = - lu(k,259) * lu(k,1409) + lu(k,1418) = lu(k,1418) - lu(k,260) * lu(k,1409) + lu(k,1431) = lu(k,1431) - lu(k,261) * lu(k,1409) + lu(k,1448) = lu(k,1448) - lu(k,262) * lu(k,1409) + lu(k,1450) = lu(k,1450) - lu(k,263) * lu(k,1409) + lu(k,1454) = lu(k,1454) - lu(k,264) * lu(k,1409) + lu(k,1458) = lu(k,1458) - lu(k,265) * lu(k,1409) + lu(k,1553) = lu(k,1553) - lu(k,259) * lu(k,1525) + lu(k,1587) = lu(k,1587) - lu(k,260) * lu(k,1525) + lu(k,1601) = lu(k,1601) - lu(k,261) * lu(k,1525) + lu(k,1619) = lu(k,1619) - lu(k,262) * lu(k,1525) + lu(k,1621) = lu(k,1621) - lu(k,263) * lu(k,1525) + lu(k,1625) = lu(k,1625) - lu(k,264) * lu(k,1525) + lu(k,1629) = lu(k,1629) - lu(k,265) * lu(k,1525) + lu(k,266) = 1._r8 / lu(k,266) + lu(k,267) = lu(k,267) * lu(k,266) + lu(k,268) = lu(k,268) * lu(k,266) + lu(k,269) = lu(k,269) * lu(k,266) + lu(k,270) = lu(k,270) * lu(k,266) + lu(k,271) = lu(k,271) * lu(k,266) + lu(k,1616) = lu(k,1616) - lu(k,267) * lu(k,1526) + lu(k,1621) = lu(k,1621) - lu(k,268) * lu(k,1526) + lu(k,1625) = lu(k,1625) - lu(k,269) * lu(k,1526) + lu(k,1628) = lu(k,1628) - lu(k,270) * lu(k,1526) + lu(k,1630) = lu(k,1630) - lu(k,271) * lu(k,1526) + lu(k,1767) = - lu(k,267) * lu(k,1744) + lu(k,1772) = lu(k,1772) - lu(k,268) * lu(k,1744) + lu(k,1776) = lu(k,1776) - lu(k,269) * lu(k,1744) + lu(k,1779) = lu(k,1779) - lu(k,270) * lu(k,1744) + lu(k,1781) = lu(k,1781) - lu(k,271) * lu(k,1744) + lu(k,1982) = - lu(k,267) * lu(k,1926) + lu(k,1987) = lu(k,1987) - lu(k,268) * lu(k,1926) + lu(k,1991) = lu(k,1991) - lu(k,269) * lu(k,1926) + lu(k,1994) = lu(k,1994) - lu(k,270) * lu(k,1926) + lu(k,1996) = lu(k,1996) - lu(k,271) * lu(k,1926) + lu(k,272) = 1._r8 / lu(k,272) + lu(k,273) = lu(k,273) * lu(k,272) + lu(k,274) = lu(k,274) * lu(k,272) + lu(k,275) = lu(k,275) * lu(k,272) + lu(k,276) = lu(k,276) * lu(k,272) + lu(k,277) = lu(k,277) * lu(k,272) + lu(k,1390) = lu(k,1390) - lu(k,273) * lu(k,1319) + lu(k,1391) = lu(k,1391) - lu(k,274) * lu(k,1319) + lu(k,1393) = lu(k,1393) - lu(k,275) * lu(k,1319) + lu(k,1397) = lu(k,1397) - lu(k,276) * lu(k,1319) + lu(k,1403) = lu(k,1403) - lu(k,277) * lu(k,1319) + lu(k,1618) = lu(k,1618) - lu(k,273) * lu(k,1527) + lu(k,1619) = lu(k,1619) - lu(k,274) * lu(k,1527) + lu(k,1621) = lu(k,1621) - lu(k,275) * lu(k,1527) + lu(k,1625) = lu(k,1625) - lu(k,276) * lu(k,1527) + lu(k,1631) = lu(k,1631) - lu(k,277) * lu(k,1527) + lu(k,1769) = lu(k,1769) - lu(k,273) * lu(k,1745) + lu(k,1770) = lu(k,1770) - lu(k,274) * lu(k,1745) + lu(k,1772) = lu(k,1772) - lu(k,275) * lu(k,1745) + lu(k,1776) = lu(k,1776) - lu(k,276) * lu(k,1745) + lu(k,1782) = - lu(k,277) * lu(k,1745) + lu(k,278) = 1._r8 / lu(k,278) + lu(k,279) = lu(k,279) * lu(k,278) + lu(k,280) = lu(k,280) * lu(k,278) + lu(k,281) = lu(k,281) * lu(k,278) + lu(k,282) = lu(k,282) * lu(k,278) + lu(k,283) = lu(k,283) * lu(k,278) + lu(k,1039) = - lu(k,279) * lu(k,1035) + lu(k,1040) = - lu(k,280) * lu(k,1035) + lu(k,1049) = - lu(k,281) * lu(k,1035) + lu(k,1051) = lu(k,1051) - lu(k,282) * lu(k,1035) + lu(k,1053) = - lu(k,283) * lu(k,1035) + lu(k,1581) = lu(k,1581) - lu(k,279) * lu(k,1528) + lu(k,1591) = lu(k,1591) - lu(k,280) * lu(k,1528) + lu(k,1615) = lu(k,1615) - lu(k,281) * lu(k,1528) + lu(k,1618) = lu(k,1618) - lu(k,282) * lu(k,1528) + lu(k,1621) = lu(k,1621) - lu(k,283) * lu(k,1528) + lu(k,1641) = - lu(k,279) * lu(k,1634) + lu(k,1645) = lu(k,1645) - lu(k,280) * lu(k,1634) + lu(k,1665) = - lu(k,281) * lu(k,1634) + lu(k,1668) = lu(k,1668) - lu(k,282) * lu(k,1634) + lu(k,1671) = lu(k,1671) - lu(k,283) * lu(k,1634) + lu(k,284) = 1._r8 / lu(k,284) + lu(k,285) = lu(k,285) * lu(k,284) + lu(k,286) = lu(k,286) * lu(k,284) + lu(k,287) = lu(k,287) * lu(k,284) + lu(k,288) = lu(k,288) * lu(k,284) + lu(k,289) = lu(k,289) * lu(k,284) + lu(k,375) = lu(k,375) - lu(k,285) * lu(k,374) + lu(k,376) = lu(k,376) - lu(k,286) * lu(k,374) + lu(k,378) = lu(k,378) - lu(k,287) * lu(k,374) + lu(k,379) = lu(k,379) - lu(k,288) * lu(k,374) + lu(k,380) = - lu(k,289) * lu(k,374) + lu(k,1330) = - lu(k,285) * lu(k,1320) + lu(k,1333) = lu(k,1333) - lu(k,286) * lu(k,1320) + lu(k,1361) = lu(k,1361) - lu(k,287) * lu(k,1320) + lu(k,1390) = lu(k,1390) - lu(k,288) * lu(k,1320) + lu(k,1393) = lu(k,1393) - lu(k,289) * lu(k,1320) + lu(k,1538) = lu(k,1538) - lu(k,285) * lu(k,1529) + lu(k,1542) = lu(k,1542) - lu(k,286) * lu(k,1529) + lu(k,1582) = lu(k,1582) - lu(k,287) * lu(k,1529) + lu(k,1618) = lu(k,1618) - lu(k,288) * lu(k,1529) + lu(k,1621) = lu(k,1621) - lu(k,289) * lu(k,1529) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,293) = lu(k,293) * lu(k,290) + lu(k,294) = lu(k,294) * lu(k,290) + lu(k,295) = lu(k,295) * lu(k,290) + lu(k,760) = - lu(k,291) * lu(k,758) + lu(k,766) = lu(k,766) - lu(k,292) * lu(k,758) + lu(k,770) = - lu(k,293) * lu(k,758) + lu(k,771) = lu(k,771) - lu(k,294) * lu(k,758) + lu(k,772) = lu(k,772) - lu(k,295) * lu(k,758) + lu(k,786) = - lu(k,291) * lu(k,784) + lu(k,792) = lu(k,792) - lu(k,292) * lu(k,784) + lu(k,796) = - lu(k,293) * lu(k,784) + lu(k,797) = lu(k,797) - lu(k,294) * lu(k,784) + lu(k,798) = lu(k,798) - lu(k,295) * lu(k,784) + lu(k,1799) = - lu(k,291) * lu(k,1789) + lu(k,1808) = lu(k,1808) - lu(k,292) * lu(k,1789) + lu(k,1817) = lu(k,1817) - lu(k,293) * lu(k,1789) + lu(k,1824) = lu(k,1824) - lu(k,294) * lu(k,1789) + lu(k,1829) = lu(k,1829) - lu(k,295) * lu(k,1789) + lu(k,296) = 1._r8 / lu(k,296) + lu(k,297) = lu(k,297) * lu(k,296) + lu(k,298) = lu(k,298) * lu(k,296) + lu(k,299) = lu(k,299) * lu(k,296) + lu(k,300) = lu(k,300) * lu(k,296) + lu(k,301) = lu(k,301) * lu(k,296) + lu(k,965) = lu(k,965) - lu(k,297) * lu(k,962) + lu(k,969) = lu(k,969) - lu(k,298) * lu(k,962) + lu(k,972) = - lu(k,299) * lu(k,962) + lu(k,976) = - lu(k,300) * lu(k,962) + lu(k,978) = lu(k,978) - lu(k,301) * lu(k,962) + lu(k,1365) = - lu(k,297) * lu(k,1321) + lu(k,1372) = lu(k,1372) - lu(k,298) * lu(k,1321) + lu(k,1387) = - lu(k,299) * lu(k,1321) + lu(k,1393) = lu(k,1393) - lu(k,300) * lu(k,1321) + lu(k,1397) = lu(k,1397) - lu(k,301) * lu(k,1321) + lu(k,1590) = lu(k,1590) - lu(k,297) * lu(k,1530) + lu(k,1599) = lu(k,1599) - lu(k,298) * lu(k,1530) + lu(k,1615) = lu(k,1615) - lu(k,299) * lu(k,1530) + lu(k,1621) = lu(k,1621) - lu(k,300) * lu(k,1530) + lu(k,1625) = lu(k,1625) - lu(k,301) * lu(k,1530) + lu(k,302) = 1._r8 / lu(k,302) + lu(k,303) = lu(k,303) * lu(k,302) + lu(k,304) = lu(k,304) * lu(k,302) + lu(k,305) = lu(k,305) * lu(k,302) + lu(k,306) = lu(k,306) * lu(k,302) + lu(k,307) = lu(k,307) * lu(k,302) + lu(k,985) = lu(k,985) - lu(k,303) * lu(k,982) + lu(k,987) = lu(k,987) - lu(k,304) * lu(k,982) + lu(k,989) = lu(k,989) - lu(k,305) * lu(k,982) + lu(k,992) = lu(k,992) - lu(k,306) * lu(k,982) + lu(k,994) = - lu(k,307) * lu(k,982) + lu(k,1373) = lu(k,1373) - lu(k,303) * lu(k,1322) + lu(k,1385) = lu(k,1385) - lu(k,304) * lu(k,1322) + lu(k,1393) = lu(k,1393) - lu(k,305) * lu(k,1322) + lu(k,1401) = lu(k,1401) - lu(k,306) * lu(k,1322) + lu(k,1403) = lu(k,1403) - lu(k,307) * lu(k,1322) + lu(k,1600) = lu(k,1600) - lu(k,303) * lu(k,1531) + lu(k,1613) = lu(k,1613) - lu(k,304) * lu(k,1531) + lu(k,1621) = lu(k,1621) - lu(k,305) * lu(k,1531) + lu(k,1629) = lu(k,1629) - lu(k,306) * lu(k,1531) + lu(k,1631) = lu(k,1631) - lu(k,307) * lu(k,1531) + lu(k,308) = 1._r8 / lu(k,308) + lu(k,309) = lu(k,309) * lu(k,308) + lu(k,310) = lu(k,310) * lu(k,308) + lu(k,311) = lu(k,311) * lu(k,308) + lu(k,312) = lu(k,312) * lu(k,308) + lu(k,313) = lu(k,313) * lu(k,308) + lu(k,1037) = - lu(k,309) * lu(k,1036) + lu(k,1039) = lu(k,1039) - lu(k,310) * lu(k,1036) + lu(k,1051) = lu(k,1051) - lu(k,311) * lu(k,1036) + lu(k,1053) = lu(k,1053) - lu(k,312) * lu(k,1036) + lu(k,1055) = lu(k,1055) - lu(k,313) * lu(k,1036) + lu(k,1346) = lu(k,1346) - lu(k,309) * lu(k,1323) + lu(k,1360) = - lu(k,310) * lu(k,1323) + lu(k,1390) = lu(k,1390) - lu(k,311) * lu(k,1323) + lu(k,1393) = lu(k,1393) - lu(k,312) * lu(k,1323) + lu(k,1397) = lu(k,1397) - lu(k,313) * lu(k,1323) + lu(k,1564) = lu(k,1564) - lu(k,309) * lu(k,1532) + lu(k,1581) = lu(k,1581) - lu(k,310) * lu(k,1532) + lu(k,1618) = lu(k,1618) - lu(k,311) * lu(k,1532) + lu(k,1621) = lu(k,1621) - lu(k,312) * lu(k,1532) + lu(k,1625) = lu(k,1625) - lu(k,313) * lu(k,1532) + lu(k,314) = 1._r8 / lu(k,314) + lu(k,315) = lu(k,315) * lu(k,314) + lu(k,316) = lu(k,316) * lu(k,314) + lu(k,317) = lu(k,317) * lu(k,314) + lu(k,318) = lu(k,318) * lu(k,314) + lu(k,319) = lu(k,319) * lu(k,314) + lu(k,666) = lu(k,666) - lu(k,315) * lu(k,665) + lu(k,667) = lu(k,667) - lu(k,316) * lu(k,665) + lu(k,669) = lu(k,669) - lu(k,317) * lu(k,665) + lu(k,670) = - lu(k,318) * lu(k,665) + lu(k,675) = - lu(k,319) * lu(k,665) + lu(k,1356) = lu(k,1356) - lu(k,315) * lu(k,1324) + lu(k,1364) = - lu(k,316) * lu(k,1324) + lu(k,1390) = lu(k,1390) - lu(k,317) * lu(k,1324) + lu(k,1393) = lu(k,1393) - lu(k,318) * lu(k,1324) + lu(k,1403) = lu(k,1403) - lu(k,319) * lu(k,1324) + lu(k,1575) = lu(k,1575) - lu(k,315) * lu(k,1533) + lu(k,1587) = lu(k,1587) - lu(k,316) * lu(k,1533) + lu(k,1618) = lu(k,1618) - lu(k,317) * lu(k,1533) + lu(k,1621) = lu(k,1621) - lu(k,318) * lu(k,1533) + lu(k,1631) = lu(k,1631) - lu(k,319) * lu(k,1533) + lu(k,320) = 1._r8 / lu(k,320) + lu(k,321) = lu(k,321) * lu(k,320) + lu(k,322) = lu(k,322) * lu(k,320) + lu(k,323) = lu(k,323) * lu(k,320) + lu(k,324) = lu(k,324) * lu(k,320) + lu(k,325) = lu(k,325) * lu(k,320) + lu(k,1388) = lu(k,1388) - lu(k,321) * lu(k,1325) + lu(k,1393) = lu(k,1393) - lu(k,322) * lu(k,1325) + lu(k,1394) = lu(k,1394) - lu(k,323) * lu(k,1325) + lu(k,1401) = lu(k,1401) - lu(k,324) * lu(k,1325) + lu(k,1403) = lu(k,1403) - lu(k,325) * lu(k,1325) + lu(k,1616) = lu(k,1616) - lu(k,321) * lu(k,1534) + lu(k,1621) = lu(k,1621) - lu(k,322) * lu(k,1534) + lu(k,1622) = lu(k,1622) - lu(k,323) * lu(k,1534) + lu(k,1629) = lu(k,1629) - lu(k,324) * lu(k,1534) + lu(k,1631) = lu(k,1631) - lu(k,325) * lu(k,1534) + lu(k,1666) = - lu(k,321) * lu(k,1635) + lu(k,1671) = lu(k,1671) - lu(k,322) * lu(k,1635) + lu(k,1672) = lu(k,1672) - lu(k,323) * lu(k,1635) + lu(k,1679) = lu(k,1679) - lu(k,324) * lu(k,1635) + lu(k,1681) = - lu(k,325) * lu(k,1635) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,326) = 1._r8 / lu(k,326) + lu(k,327) = lu(k,327) * lu(k,326) + lu(k,328) = lu(k,328) * lu(k,326) + lu(k,329) = lu(k,329) * lu(k,326) + lu(k,330) = lu(k,330) * lu(k,326) + lu(k,331) = lu(k,331) * lu(k,326) + lu(k,384) = lu(k,384) - lu(k,327) * lu(k,383) + lu(k,385) = lu(k,385) - lu(k,328) * lu(k,383) + lu(k,386) = lu(k,386) - lu(k,329) * lu(k,383) + lu(k,387) = lu(k,387) - lu(k,330) * lu(k,383) + lu(k,388) = - lu(k,331) * lu(k,383) + lu(k,1334) = lu(k,1334) - lu(k,327) * lu(k,1326) + lu(k,1361) = lu(k,1361) - lu(k,328) * lu(k,1326) + lu(k,1379) = lu(k,1379) - lu(k,329) * lu(k,1326) + lu(k,1390) = lu(k,1390) - lu(k,330) * lu(k,1326) + lu(k,1393) = lu(k,1393) - lu(k,331) * lu(k,1326) + lu(k,1543) = lu(k,1543) - lu(k,327) * lu(k,1535) + lu(k,1582) = lu(k,1582) - lu(k,328) * lu(k,1535) + lu(k,1606) = lu(k,1606) - lu(k,329) * lu(k,1535) + lu(k,1618) = lu(k,1618) - lu(k,330) * lu(k,1535) + lu(k,1621) = lu(k,1621) - lu(k,331) * lu(k,1535) + lu(k,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,339) = lu(k,339) * lu(k,334) + lu(k,1336) = lu(k,1336) - lu(k,335) * lu(k,1327) + lu(k,1390) = lu(k,1390) - lu(k,336) * lu(k,1327) + lu(k,1393) = lu(k,1393) - lu(k,337) * lu(k,1327) + lu(k,1397) = lu(k,1397) - lu(k,338) * lu(k,1327) + lu(k,1402) = lu(k,1402) - lu(k,339) * lu(k,1327) + lu(k,1547) = lu(k,1547) - lu(k,335) * lu(k,1536) + lu(k,1618) = lu(k,1618) - lu(k,336) * lu(k,1536) + lu(k,1621) = lu(k,1621) - lu(k,337) * lu(k,1536) + lu(k,1625) = lu(k,1625) - lu(k,338) * lu(k,1536) + lu(k,1630) = lu(k,1630) - lu(k,339) * lu(k,1536) + lu(k,1935) = lu(k,1935) - lu(k,335) * lu(k,1927) + lu(k,1984) = lu(k,1984) - lu(k,336) * lu(k,1927) + lu(k,1987) = lu(k,1987) - lu(k,337) * lu(k,1927) + lu(k,1991) = lu(k,1991) - lu(k,338) * lu(k,1927) + lu(k,1996) = lu(k,1996) - lu(k,339) * lu(k,1927) + lu(k,340) = 1._r8 / lu(k,340) + lu(k,341) = lu(k,341) * lu(k,340) + lu(k,342) = lu(k,342) * lu(k,340) + lu(k,343) = lu(k,343) * lu(k,340) + lu(k,344) = lu(k,344) * lu(k,340) + lu(k,345) = lu(k,345) * lu(k,340) + lu(k,1355) = lu(k,1355) - lu(k,341) * lu(k,1328) + lu(k,1390) = lu(k,1390) - lu(k,342) * lu(k,1328) + lu(k,1397) = lu(k,1397) - lu(k,343) * lu(k,1328) + lu(k,1401) = lu(k,1401) - lu(k,344) * lu(k,1328) + lu(k,1402) = lu(k,1402) - lu(k,345) * lu(k,1328) + lu(k,1898) = - lu(k,341) * lu(k,1897) + lu(k,1906) = lu(k,1906) - lu(k,342) * lu(k,1897) + lu(k,1913) = - lu(k,343) * lu(k,1897) + lu(k,1917) = lu(k,1917) - lu(k,344) * lu(k,1897) + lu(k,1918) = - lu(k,345) * lu(k,1897) + lu(k,1950) = lu(k,1950) - lu(k,341) * lu(k,1928) + lu(k,1984) = lu(k,1984) - lu(k,342) * lu(k,1928) + lu(k,1991) = lu(k,1991) - lu(k,343) * lu(k,1928) + lu(k,1995) = lu(k,1995) - lu(k,344) * lu(k,1928) + lu(k,1996) = lu(k,1996) - lu(k,345) * lu(k,1928) + lu(k,347) = 1._r8 / lu(k,347) + lu(k,348) = lu(k,348) * lu(k,347) + lu(k,349) = lu(k,349) * lu(k,347) + lu(k,350) = lu(k,350) * lu(k,347) + lu(k,351) = lu(k,351) * lu(k,347) + lu(k,352) = lu(k,352) * lu(k,347) + lu(k,1361) = lu(k,1361) - lu(k,348) * lu(k,1329) + lu(k,1390) = lu(k,1390) - lu(k,349) * lu(k,1329) + lu(k,1393) = lu(k,1393) - lu(k,350) * lu(k,1329) + lu(k,1397) = lu(k,1397) - lu(k,351) * lu(k,1329) + lu(k,1402) = lu(k,1402) - lu(k,352) * lu(k,1329) + lu(k,1582) = lu(k,1582) - lu(k,348) * lu(k,1537) + lu(k,1618) = lu(k,1618) - lu(k,349) * lu(k,1537) + lu(k,1621) = lu(k,1621) - lu(k,350) * lu(k,1537) + lu(k,1625) = lu(k,1625) - lu(k,351) * lu(k,1537) + lu(k,1630) = lu(k,1630) - lu(k,352) * lu(k,1537) + lu(k,1954) = lu(k,1954) - lu(k,348) * lu(k,1929) + lu(k,1984) = lu(k,1984) - lu(k,349) * lu(k,1929) + lu(k,1987) = lu(k,1987) - lu(k,350) * lu(k,1929) + lu(k,1991) = lu(k,1991) - lu(k,351) * lu(k,1929) + lu(k,1996) = lu(k,1996) - lu(k,352) * lu(k,1929) + lu(k,353) = 1._r8 / lu(k,353) + lu(k,354) = lu(k,354) * lu(k,353) + lu(k,355) = lu(k,355) * lu(k,353) + lu(k,377) = - lu(k,354) * lu(k,375) + lu(k,379) = lu(k,379) - lu(k,355) * lu(k,375) + lu(k,496) = - lu(k,354) * lu(k,493) + lu(k,501) = lu(k,501) - lu(k,355) * lu(k,493) + lu(k,564) = - lu(k,354) * lu(k,561) + lu(k,572) = lu(k,572) - lu(k,355) * lu(k,561) + lu(k,593) = - lu(k,354) * lu(k,590) + lu(k,600) = lu(k,600) - lu(k,355) * lu(k,590) + lu(k,609) = - lu(k,354) * lu(k,606) + lu(k,617) = lu(k,617) - lu(k,355) * lu(k,606) + lu(k,1349) = lu(k,1349) - lu(k,354) * lu(k,1330) + lu(k,1390) = lu(k,1390) - lu(k,355) * lu(k,1330) + lu(k,1567) = - lu(k,354) * lu(k,1538) + lu(k,1618) = lu(k,1618) - lu(k,355) * lu(k,1538) + lu(k,1945) = lu(k,1945) - lu(k,354) * lu(k,1930) + lu(k,1984) = lu(k,1984) - lu(k,355) * lu(k,1930) + lu(k,356) = 1._r8 / lu(k,356) + lu(k,357) = lu(k,357) * lu(k,356) + lu(k,358) = lu(k,358) * lu(k,356) + lu(k,359) = lu(k,359) * lu(k,356) + lu(k,360) = lu(k,360) * lu(k,356) + lu(k,361) = lu(k,361) * lu(k,356) + lu(k,362) = lu(k,362) * lu(k,356) + lu(k,1236) = lu(k,1236) - lu(k,357) * lu(k,1219) + lu(k,1240) = - lu(k,358) * lu(k,1219) + lu(k,1241) = lu(k,1241) - lu(k,359) * lu(k,1219) + lu(k,1242) = lu(k,1242) - lu(k,360) * lu(k,1219) + lu(k,1243) = lu(k,1243) - lu(k,361) * lu(k,1219) + lu(k,1245) = lu(k,1245) - lu(k,362) * lu(k,1219) + lu(k,1613) = lu(k,1613) - lu(k,357) * lu(k,1539) + lu(k,1619) = lu(k,1619) - lu(k,358) * lu(k,1539) + lu(k,1621) = lu(k,1621) - lu(k,359) * lu(k,1539) + lu(k,1622) = lu(k,1622) - lu(k,360) * lu(k,1539) + lu(k,1625) = lu(k,1625) - lu(k,361) * lu(k,1539) + lu(k,1629) = lu(k,1629) - lu(k,362) * lu(k,1539) + lu(k,1764) = lu(k,1764) - lu(k,357) * lu(k,1746) + lu(k,1770) = lu(k,1770) - lu(k,358) * lu(k,1746) + lu(k,1772) = lu(k,1772) - lu(k,359) * lu(k,1746) + lu(k,1773) = - lu(k,360) * lu(k,1746) + lu(k,1776) = lu(k,1776) - lu(k,361) * lu(k,1746) + lu(k,1780) = - lu(k,362) * lu(k,1746) + lu(k,363) = 1._r8 / lu(k,363) + lu(k,364) = lu(k,364) * lu(k,363) + lu(k,365) = lu(k,365) * lu(k,363) + lu(k,366) = lu(k,366) * lu(k,363) + lu(k,515) = lu(k,515) - lu(k,364) * lu(k,514) + lu(k,518) = lu(k,518) - lu(k,365) * lu(k,514) + lu(k,519) = - lu(k,366) * lu(k,514) + lu(k,1343) = lu(k,1343) - lu(k,364) * lu(k,1331) + lu(k,1397) = lu(k,1397) - lu(k,365) * lu(k,1331) + lu(k,1398) = lu(k,1398) - lu(k,366) * lu(k,1331) + lu(k,1560) = lu(k,1560) - lu(k,364) * lu(k,1540) + lu(k,1625) = lu(k,1625) - lu(k,365) * lu(k,1540) + lu(k,1626) = lu(k,1626) - lu(k,366) * lu(k,1540) + lu(k,1751) = - lu(k,364) * lu(k,1747) + lu(k,1776) = lu(k,1776) - lu(k,365) * lu(k,1747) + lu(k,1777) = lu(k,1777) - lu(k,366) * lu(k,1747) + lu(k,1794) = lu(k,1794) - lu(k,364) * lu(k,1790) + lu(k,1836) = lu(k,1836) - lu(k,365) * lu(k,1790) + lu(k,1837) = lu(k,1837) - lu(k,366) * lu(k,1790) + lu(k,1941) = lu(k,1941) - lu(k,364) * lu(k,1931) + lu(k,1991) = lu(k,1991) - lu(k,365) * lu(k,1931) + lu(k,1992) = lu(k,1992) - lu(k,366) * lu(k,1931) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,367) = 1._r8 / lu(k,367) + lu(k,368) = lu(k,368) * lu(k,367) + lu(k,369) = lu(k,369) * lu(k,367) + lu(k,370) = lu(k,370) * lu(k,367) + lu(k,371) = lu(k,371) * lu(k,367) + lu(k,372) = lu(k,372) * lu(k,367) + lu(k,373) = lu(k,373) * lu(k,367) + lu(k,924) = lu(k,924) - lu(k,368) * lu(k,921) + lu(k,925) = lu(k,925) - lu(k,369) * lu(k,921) + lu(k,928) = lu(k,928) - lu(k,370) * lu(k,921) + lu(k,935) = lu(k,935) - lu(k,371) * lu(k,921) + lu(k,937) = - lu(k,372) * lu(k,921) + lu(k,940) = lu(k,940) - lu(k,373) * lu(k,921) + lu(k,1364) = lu(k,1364) - lu(k,368) * lu(k,1332) + lu(k,1365) = lu(k,1365) - lu(k,369) * lu(k,1332) + lu(k,1370) = lu(k,1370) - lu(k,370) * lu(k,1332) + lu(k,1390) = lu(k,1390) - lu(k,371) * lu(k,1332) + lu(k,1393) = lu(k,1393) - lu(k,372) * lu(k,1332) + lu(k,1401) = lu(k,1401) - lu(k,373) * lu(k,1332) + lu(k,1587) = lu(k,1587) - lu(k,368) * lu(k,1541) + lu(k,1590) = lu(k,1590) - lu(k,369) * lu(k,1541) + lu(k,1597) = lu(k,1597) - lu(k,370) * lu(k,1541) + lu(k,1618) = lu(k,1618) - lu(k,371) * lu(k,1541) + lu(k,1621) = lu(k,1621) - lu(k,372) * lu(k,1541) + lu(k,1629) = lu(k,1629) - lu(k,373) * lu(k,1541) + lu(k,376) = 1._r8 / lu(k,376) + lu(k,377) = lu(k,377) * lu(k,376) + lu(k,378) = lu(k,378) * lu(k,376) + lu(k,379) = lu(k,379) * lu(k,376) + lu(k,380) = lu(k,380) * lu(k,376) + lu(k,381) = lu(k,381) * lu(k,376) + lu(k,382) = lu(k,382) * lu(k,376) + lu(k,1349) = lu(k,1349) - lu(k,377) * lu(k,1333) + lu(k,1361) = lu(k,1361) - lu(k,378) * lu(k,1333) + lu(k,1390) = lu(k,1390) - lu(k,379) * lu(k,1333) + lu(k,1393) = lu(k,1393) - lu(k,380) * lu(k,1333) + lu(k,1397) = lu(k,1397) - lu(k,381) * lu(k,1333) + lu(k,1402) = lu(k,1402) - lu(k,382) * lu(k,1333) + lu(k,1567) = lu(k,1567) - lu(k,377) * lu(k,1542) + lu(k,1582) = lu(k,1582) - lu(k,378) * lu(k,1542) + lu(k,1618) = lu(k,1618) - lu(k,379) * lu(k,1542) + lu(k,1621) = lu(k,1621) - lu(k,380) * lu(k,1542) + lu(k,1625) = lu(k,1625) - lu(k,381) * lu(k,1542) + lu(k,1630) = lu(k,1630) - lu(k,382) * lu(k,1542) + lu(k,1945) = lu(k,1945) - lu(k,377) * lu(k,1932) + lu(k,1954) = lu(k,1954) - lu(k,378) * lu(k,1932) + lu(k,1984) = lu(k,1984) - lu(k,379) * lu(k,1932) + lu(k,1987) = lu(k,1987) - lu(k,380) * lu(k,1932) + lu(k,1991) = lu(k,1991) - lu(k,381) * lu(k,1932) + lu(k,1996) = lu(k,1996) - lu(k,382) * lu(k,1932) + lu(k,384) = 1._r8 / lu(k,384) + lu(k,385) = lu(k,385) * lu(k,384) + lu(k,386) = lu(k,386) * lu(k,384) + lu(k,387) = lu(k,387) * lu(k,384) + lu(k,388) = lu(k,388) * lu(k,384) + lu(k,389) = lu(k,389) * lu(k,384) + lu(k,390) = lu(k,390) * lu(k,384) + lu(k,1361) = lu(k,1361) - lu(k,385) * lu(k,1334) + lu(k,1379) = lu(k,1379) - lu(k,386) * lu(k,1334) + lu(k,1390) = lu(k,1390) - lu(k,387) * lu(k,1334) + lu(k,1393) = lu(k,1393) - lu(k,388) * lu(k,1334) + lu(k,1397) = lu(k,1397) - lu(k,389) * lu(k,1334) + lu(k,1402) = lu(k,1402) - lu(k,390) * lu(k,1334) + lu(k,1582) = lu(k,1582) - lu(k,385) * lu(k,1543) + lu(k,1606) = lu(k,1606) - lu(k,386) * lu(k,1543) + lu(k,1618) = lu(k,1618) - lu(k,387) * lu(k,1543) + lu(k,1621) = lu(k,1621) - lu(k,388) * lu(k,1543) + lu(k,1625) = lu(k,1625) - lu(k,389) * lu(k,1543) + lu(k,1630) = lu(k,1630) - lu(k,390) * lu(k,1543) + lu(k,1954) = lu(k,1954) - lu(k,385) * lu(k,1933) + lu(k,1973) = lu(k,1973) - lu(k,386) * lu(k,1933) + lu(k,1984) = lu(k,1984) - lu(k,387) * lu(k,1933) + lu(k,1987) = lu(k,1987) - lu(k,388) * lu(k,1933) + lu(k,1991) = lu(k,1991) - lu(k,389) * lu(k,1933) + lu(k,1996) = lu(k,1996) - lu(k,390) * lu(k,1933) + lu(k,391) = 1._r8 / lu(k,391) + lu(k,392) = lu(k,392) * lu(k,391) + lu(k,393) = lu(k,393) * lu(k,391) + lu(k,394) = lu(k,394) * lu(k,391) + lu(k,395) = lu(k,395) * lu(k,391) + lu(k,396) = lu(k,396) * lu(k,391) + lu(k,1206) = lu(k,1206) - lu(k,392) * lu(k,1200) + lu(k,1211) = lu(k,1211) - lu(k,393) * lu(k,1200) + lu(k,1212) = lu(k,1212) - lu(k,394) * lu(k,1200) + lu(k,1215) = lu(k,1215) - lu(k,395) * lu(k,1200) + lu(k,1217) = - lu(k,396) * lu(k,1200) + lu(k,1236) = lu(k,1236) - lu(k,392) * lu(k,1220) + lu(k,1241) = lu(k,1241) - lu(k,393) * lu(k,1220) + lu(k,1242) = lu(k,1242) - lu(k,394) * lu(k,1220) + lu(k,1245) = lu(k,1245) - lu(k,395) * lu(k,1220) + lu(k,1247) = - lu(k,396) * lu(k,1220) + lu(k,1385) = lu(k,1385) - lu(k,392) * lu(k,1335) + lu(k,1393) = lu(k,1393) - lu(k,393) * lu(k,1335) + lu(k,1394) = lu(k,1394) - lu(k,394) * lu(k,1335) + lu(k,1401) = lu(k,1401) - lu(k,395) * lu(k,1335) + lu(k,1403) = lu(k,1403) - lu(k,396) * lu(k,1335) + lu(k,1613) = lu(k,1613) - lu(k,392) * lu(k,1544) + lu(k,1621) = lu(k,1621) - lu(k,393) * lu(k,1544) + lu(k,1622) = lu(k,1622) - lu(k,394) * lu(k,1544) + lu(k,1629) = lu(k,1629) - lu(k,395) * lu(k,1544) + lu(k,1631) = lu(k,1631) - lu(k,396) * lu(k,1544) + lu(k,397) = 1._r8 / lu(k,397) + lu(k,398) = lu(k,398) * lu(k,397) + lu(k,399) = lu(k,399) * lu(k,397) + lu(k,400) = lu(k,400) * lu(k,397) + lu(k,401) = lu(k,401) * lu(k,397) + lu(k,402) = lu(k,402) * lu(k,397) + lu(k,1083) = lu(k,1083) - lu(k,398) * lu(k,1081) + lu(k,1085) = lu(k,1085) - lu(k,399) * lu(k,1081) + lu(k,1087) = lu(k,1087) - lu(k,400) * lu(k,1081) + lu(k,1091) = lu(k,1091) - lu(k,401) * lu(k,1081) + lu(k,1093) = lu(k,1093) - lu(k,402) * lu(k,1081) + lu(k,1607) = lu(k,1607) - lu(k,398) * lu(k,1545) + lu(k,1616) = lu(k,1616) - lu(k,399) * lu(k,1545) + lu(k,1621) = lu(k,1621) - lu(k,400) * lu(k,1545) + lu(k,1626) = lu(k,1626) - lu(k,401) * lu(k,1545) + lu(k,1628) = lu(k,1628) - lu(k,402) * lu(k,1545) + lu(k,1818) = lu(k,1818) - lu(k,398) * lu(k,1791) + lu(k,1827) = lu(k,1827) - lu(k,399) * lu(k,1791) + lu(k,1832) = lu(k,1832) - lu(k,400) * lu(k,1791) + lu(k,1837) = lu(k,1837) - lu(k,401) * lu(k,1791) + lu(k,1839) = lu(k,1839) - lu(k,402) * lu(k,1791) + lu(k,1878) = lu(k,1878) - lu(k,398) * lu(k,1868) + lu(k,1881) = lu(k,1881) - lu(k,399) * lu(k,1868) + lu(k,1886) = lu(k,1886) - lu(k,400) * lu(k,1868) + lu(k,1891) = lu(k,1891) - lu(k,401) * lu(k,1868) + lu(k,1893) = lu(k,1893) - lu(k,402) * lu(k,1868) + lu(k,403) = 1._r8 / lu(k,403) + lu(k,404) = lu(k,404) * lu(k,403) + lu(k,405) = lu(k,405) * lu(k,403) + lu(k,406) = lu(k,406) * lu(k,403) + lu(k,407) = lu(k,407) * lu(k,403) + lu(k,523) = - lu(k,404) * lu(k,521) + lu(k,524) = - lu(k,405) * lu(k,521) + lu(k,528) = - lu(k,406) * lu(k,521) + lu(k,530) = lu(k,530) - lu(k,407) * lu(k,521) + lu(k,534) = - lu(k,404) * lu(k,532) + lu(k,535) = - lu(k,405) * lu(k,532) + lu(k,538) = - lu(k,406) * lu(k,532) + lu(k,540) = lu(k,540) - lu(k,407) * lu(k,532) + lu(k,807) = - lu(k,404) * lu(k,804) + lu(k,808) = - lu(k,405) * lu(k,804) + lu(k,812) = - lu(k,406) * lu(k,804) + lu(k,814) = - lu(k,407) * lu(k,804) + lu(k,1563) = lu(k,1563) - lu(k,404) * lu(k,1546) + lu(k,1577) = lu(k,1577) - lu(k,405) * lu(k,1546) + lu(k,1613) = lu(k,1613) - lu(k,406) * lu(k,1546) + lu(k,1621) = lu(k,1621) - lu(k,407) * lu(k,1546) + lu(k,1943) = lu(k,1943) - lu(k,404) * lu(k,1934) + lu(k,1952) = lu(k,1952) - lu(k,405) * lu(k,1934) + lu(k,1979) = lu(k,1979) - lu(k,406) * lu(k,1934) + lu(k,1987) = lu(k,1987) - lu(k,407) * lu(k,1934) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,409) = 1._r8 / lu(k,409) + lu(k,410) = lu(k,410) * lu(k,409) + lu(k,411) = lu(k,411) * lu(k,409) + lu(k,412) = lu(k,412) * lu(k,409) + lu(k,413) = lu(k,413) * lu(k,409) + lu(k,414) = lu(k,414) * lu(k,409) + lu(k,1343) = lu(k,1343) - lu(k,410) * lu(k,1336) + lu(k,1390) = lu(k,1390) - lu(k,411) * lu(k,1336) + lu(k,1393) = lu(k,1393) - lu(k,412) * lu(k,1336) + lu(k,1397) = lu(k,1397) - lu(k,413) * lu(k,1336) + lu(k,1402) = lu(k,1402) - lu(k,414) * lu(k,1336) + lu(k,1560) = lu(k,1560) - lu(k,410) * lu(k,1547) + lu(k,1618) = lu(k,1618) - lu(k,411) * lu(k,1547) + lu(k,1621) = lu(k,1621) - lu(k,412) * lu(k,1547) + lu(k,1625) = lu(k,1625) - lu(k,413) * lu(k,1547) + lu(k,1630) = lu(k,1630) - lu(k,414) * lu(k,1547) + lu(k,1751) = lu(k,1751) - lu(k,410) * lu(k,1748) + lu(k,1769) = lu(k,1769) - lu(k,411) * lu(k,1748) + lu(k,1772) = lu(k,1772) - lu(k,412) * lu(k,1748) + lu(k,1776) = lu(k,1776) - lu(k,413) * lu(k,1748) + lu(k,1781) = lu(k,1781) - lu(k,414) * lu(k,1748) + lu(k,1941) = lu(k,1941) - lu(k,410) * lu(k,1935) + lu(k,1984) = lu(k,1984) - lu(k,411) * lu(k,1935) + lu(k,1987) = lu(k,1987) - lu(k,412) * lu(k,1935) + lu(k,1991) = lu(k,1991) - lu(k,413) * lu(k,1935) + lu(k,1996) = lu(k,1996) - lu(k,414) * lu(k,1935) + lu(k,415) = 1._r8 / lu(k,415) + lu(k,416) = lu(k,416) * lu(k,415) + lu(k,417) = lu(k,417) * lu(k,415) + lu(k,418) = lu(k,418) * lu(k,415) + lu(k,419) = lu(k,419) * lu(k,415) + lu(k,420) = lu(k,420) * lu(k,415) + lu(k,421) = lu(k,421) * lu(k,415) + lu(k,422) = lu(k,422) * lu(k,415) + lu(k,1203) = - lu(k,416) * lu(k,1201) + lu(k,1205) = lu(k,1205) - lu(k,417) * lu(k,1201) + lu(k,1209) = lu(k,1209) - lu(k,418) * lu(k,1201) + lu(k,1210) = lu(k,1210) - lu(k,419) * lu(k,1201) + lu(k,1211) = lu(k,1211) - lu(k,420) * lu(k,1201) + lu(k,1213) = lu(k,1213) - lu(k,421) * lu(k,1201) + lu(k,1215) = lu(k,1215) - lu(k,422) * lu(k,1201) + lu(k,1596) = lu(k,1596) - lu(k,416) * lu(k,1548) + lu(k,1612) = lu(k,1612) - lu(k,417) * lu(k,1548) + lu(k,1618) = lu(k,1618) - lu(k,418) * lu(k,1548) + lu(k,1619) = lu(k,1619) - lu(k,419) * lu(k,1548) + lu(k,1621) = lu(k,1621) - lu(k,420) * lu(k,1548) + lu(k,1625) = lu(k,1625) - lu(k,421) * lu(k,1548) + lu(k,1629) = lu(k,1629) - lu(k,422) * lu(k,1548) + lu(k,1760) = - lu(k,416) * lu(k,1749) + lu(k,1763) = lu(k,1763) - lu(k,417) * lu(k,1749) + lu(k,1769) = lu(k,1769) - lu(k,418) * lu(k,1749) + lu(k,1770) = lu(k,1770) - lu(k,419) * lu(k,1749) + lu(k,1772) = lu(k,1772) - lu(k,420) * lu(k,1749) + lu(k,1776) = lu(k,1776) - lu(k,421) * lu(k,1749) + lu(k,1780) = lu(k,1780) - lu(k,422) * lu(k,1749) + lu(k,423) = 1._r8 / lu(k,423) + lu(k,424) = lu(k,424) * lu(k,423) + lu(k,425) = lu(k,425) * lu(k,423) + lu(k,426) = lu(k,426) * lu(k,423) + lu(k,427) = lu(k,427) * lu(k,423) + lu(k,428) = lu(k,428) * lu(k,423) + lu(k,429) = lu(k,429) * lu(k,423) + lu(k,430) = lu(k,430) * lu(k,423) + lu(k,1172) = - lu(k,424) * lu(k,1168) + lu(k,1175) = lu(k,1175) - lu(k,425) * lu(k,1168) + lu(k,1176) = - lu(k,426) * lu(k,1168) + lu(k,1178) = lu(k,1178) - lu(k,427) * lu(k,1168) + lu(k,1189) = - lu(k,428) * lu(k,1168) + lu(k,1191) = lu(k,1191) - lu(k,429) * lu(k,1168) + lu(k,1193) = lu(k,1193) - lu(k,430) * lu(k,1168) + lu(k,1581) = lu(k,1581) - lu(k,424) * lu(k,1549) + lu(k,1591) = lu(k,1591) - lu(k,425) * lu(k,1549) + lu(k,1594) = lu(k,1594) - lu(k,426) * lu(k,1549) + lu(k,1596) = lu(k,1596) - lu(k,427) * lu(k,1549) + lu(k,1615) = lu(k,1615) - lu(k,428) * lu(k,1549) + lu(k,1618) = lu(k,1618) - lu(k,429) * lu(k,1549) + lu(k,1621) = lu(k,1621) - lu(k,430) * lu(k,1549) + lu(k,1953) = - lu(k,424) * lu(k,1936) + lu(k,1959) = lu(k,1959) - lu(k,425) * lu(k,1936) + lu(k,1962) = lu(k,1962) - lu(k,426) * lu(k,1936) + lu(k,1964) = lu(k,1964) - lu(k,427) * lu(k,1936) + lu(k,1981) = lu(k,1981) - lu(k,428) * lu(k,1936) + lu(k,1984) = lu(k,1984) - lu(k,429) * lu(k,1936) + lu(k,1987) = lu(k,1987) - lu(k,430) * lu(k,1936) + lu(k,431) = 1._r8 / lu(k,431) + lu(k,432) = lu(k,432) * lu(k,431) + lu(k,433) = lu(k,433) * lu(k,431) + lu(k,434) = lu(k,434) * lu(k,431) + lu(k,849) = lu(k,849) - lu(k,432) * lu(k,837) + lu(k,850) = lu(k,850) - lu(k,433) * lu(k,837) + lu(k,855) = - lu(k,434) * lu(k,837) + lu(k,1211) = lu(k,1211) - lu(k,432) * lu(k,1202) + lu(k,1212) = lu(k,1212) - lu(k,433) * lu(k,1202) + lu(k,1217) = lu(k,1217) - lu(k,434) * lu(k,1202) + lu(k,1241) = lu(k,1241) - lu(k,432) * lu(k,1221) + lu(k,1242) = lu(k,1242) - lu(k,433) * lu(k,1221) + lu(k,1247) = lu(k,1247) - lu(k,434) * lu(k,1221) + lu(k,1393) = lu(k,1393) - lu(k,432) * lu(k,1337) + lu(k,1394) = lu(k,1394) - lu(k,433) * lu(k,1337) + lu(k,1403) = lu(k,1403) - lu(k,434) * lu(k,1337) + lu(k,1621) = lu(k,1621) - lu(k,432) * lu(k,1550) + lu(k,1622) = lu(k,1622) - lu(k,433) * lu(k,1550) + lu(k,1631) = lu(k,1631) - lu(k,434) * lu(k,1550) + lu(k,1671) = lu(k,1671) - lu(k,432) * lu(k,1636) + lu(k,1672) = lu(k,1672) - lu(k,433) * lu(k,1636) + lu(k,1681) = lu(k,1681) - lu(k,434) * lu(k,1636) + lu(k,1832) = lu(k,1832) - lu(k,432) * lu(k,1792) + lu(k,1833) = lu(k,1833) - lu(k,433) * lu(k,1792) + lu(k,1842) = - lu(k,434) * lu(k,1792) + lu(k,435) = 1._r8 / lu(k,435) + lu(k,436) = lu(k,436) * lu(k,435) + lu(k,437) = lu(k,437) * lu(k,435) + lu(k,438) = lu(k,438) * lu(k,435) + lu(k,439) = lu(k,439) * lu(k,435) + lu(k,440) = lu(k,440) * lu(k,435) + lu(k,441) = lu(k,441) * lu(k,435) + lu(k,442) = lu(k,442) * lu(k,435) + lu(k,630) = lu(k,630) - lu(k,436) * lu(k,629) + lu(k,631) = - lu(k,437) * lu(k,629) + lu(k,632) = lu(k,632) - lu(k,438) * lu(k,629) + lu(k,633) = lu(k,633) - lu(k,439) * lu(k,629) + lu(k,634) = - lu(k,440) * lu(k,629) + lu(k,636) = lu(k,636) - lu(k,441) * lu(k,629) + lu(k,638) = - lu(k,442) * lu(k,629) + lu(k,1353) = lu(k,1353) - lu(k,436) * lu(k,1338) + lu(k,1369) = - lu(k,437) * lu(k,1338) + lu(k,1374) = lu(k,1374) - lu(k,438) * lu(k,1338) + lu(k,1390) = lu(k,1390) - lu(k,439) * lu(k,1338) + lu(k,1393) = lu(k,1393) - lu(k,440) * lu(k,1338) + lu(k,1401) = lu(k,1401) - lu(k,441) * lu(k,1338) + lu(k,1403) = lu(k,1403) - lu(k,442) * lu(k,1338) + lu(k,1571) = lu(k,1571) - lu(k,436) * lu(k,1551) + lu(k,1596) = lu(k,1596) - lu(k,437) * lu(k,1551) + lu(k,1601) = lu(k,1601) - lu(k,438) * lu(k,1551) + lu(k,1618) = lu(k,1618) - lu(k,439) * lu(k,1551) + lu(k,1621) = lu(k,1621) - lu(k,440) * lu(k,1551) + lu(k,1629) = lu(k,1629) - lu(k,441) * lu(k,1551) + lu(k,1631) = lu(k,1631) - lu(k,442) * lu(k,1551) + lu(k,443) = 1._r8 / lu(k,443) + lu(k,444) = lu(k,444) * lu(k,443) + lu(k,445) = lu(k,445) * lu(k,443) + lu(k,446) = lu(k,446) * lu(k,443) + lu(k,447) = lu(k,447) * lu(k,443) + lu(k,448) = lu(k,448) * lu(k,443) + lu(k,449) = lu(k,449) * lu(k,443) + lu(k,450) = lu(k,450) * lu(k,443) + lu(k,1754) = - lu(k,444) * lu(k,1750) + lu(k,1765) = - lu(k,445) * lu(k,1750) + lu(k,1766) = lu(k,1766) - lu(k,446) * lu(k,1750) + lu(k,1770) = lu(k,1770) - lu(k,447) * lu(k,1750) + lu(k,1776) = lu(k,1776) - lu(k,448) * lu(k,1750) + lu(k,1778) = lu(k,1778) - lu(k,449) * lu(k,1750) + lu(k,1779) = lu(k,1779) - lu(k,450) * lu(k,1750) + lu(k,1846) = lu(k,1846) - lu(k,444) * lu(k,1845) + lu(k,1849) = lu(k,1849) - lu(k,445) * lu(k,1845) + lu(k,1850) = - lu(k,446) * lu(k,1845) + lu(k,1854) = - lu(k,447) * lu(k,1845) + lu(k,1860) = lu(k,1860) - lu(k,448) * lu(k,1845) + lu(k,1862) = lu(k,1862) - lu(k,449) * lu(k,1845) + lu(k,1863) = lu(k,1863) - lu(k,450) * lu(k,1845) + lu(k,1871) = lu(k,1871) - lu(k,444) * lu(k,1869) + lu(k,1879) = lu(k,1879) - lu(k,445) * lu(k,1869) + lu(k,1880) = - lu(k,446) * lu(k,1869) + lu(k,1884) = lu(k,1884) - lu(k,447) * lu(k,1869) + lu(k,1890) = lu(k,1890) - lu(k,448) * lu(k,1869) + lu(k,1892) = lu(k,1892) - lu(k,449) * lu(k,1869) + lu(k,1893) = lu(k,1893) - lu(k,450) * lu(k,1869) + end do + end subroutine lu_fac10 + subroutine lu_fac11( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,451) = 1._r8 / lu(k,451) + lu(k,452) = lu(k,452) * lu(k,451) + lu(k,453) = lu(k,453) * lu(k,451) + lu(k,454) = lu(k,454) * lu(k,451) + lu(k,455) = lu(k,455) * lu(k,451) + lu(k,456) = lu(k,456) * lu(k,451) + lu(k,457) = lu(k,457) * lu(k,451) + lu(k,458) = lu(k,458) * lu(k,451) + lu(k,1566) = lu(k,1566) - lu(k,452) * lu(k,1552) + lu(k,1573) = lu(k,1573) - lu(k,453) * lu(k,1552) + lu(k,1595) = lu(k,1595) - lu(k,454) * lu(k,1552) + lu(k,1618) = lu(k,1618) - lu(k,455) * lu(k,1552) + lu(k,1621) = lu(k,1621) - lu(k,456) * lu(k,1552) + lu(k,1626) = lu(k,1626) - lu(k,457) * lu(k,1552) + lu(k,1629) = lu(k,1629) - lu(k,458) * lu(k,1552) + lu(k,1713) = - lu(k,452) * lu(k,1711) + lu(k,1714) = lu(k,1714) - lu(k,453) * lu(k,1711) + lu(k,1720) = lu(k,1720) - lu(k,454) * lu(k,1711) + lu(k,1728) = lu(k,1728) - lu(k,455) * lu(k,1711) + lu(k,1731) = lu(k,1731) - lu(k,456) * lu(k,1711) + lu(k,1736) = lu(k,1736) - lu(k,457) * lu(k,1711) + lu(k,1739) = lu(k,1739) - lu(k,458) * lu(k,1711) + lu(k,1795) = - lu(k,452) * lu(k,1793) + lu(k,1796) = lu(k,1796) - lu(k,453) * lu(k,1793) + lu(k,1808) = lu(k,1808) - lu(k,454) * lu(k,1793) + lu(k,1829) = lu(k,1829) - lu(k,455) * lu(k,1793) + lu(k,1832) = lu(k,1832) - lu(k,456) * lu(k,1793) + lu(k,1837) = lu(k,1837) - lu(k,457) * lu(k,1793) + lu(k,1840) = lu(k,1840) - lu(k,458) * lu(k,1793) + lu(k,459) = 1._r8 / lu(k,459) + lu(k,460) = lu(k,460) * lu(k,459) + lu(k,461) = lu(k,461) * lu(k,459) + lu(k,462) = lu(k,462) * lu(k,459) + lu(k,463) = lu(k,463) * lu(k,459) + lu(k,464) = lu(k,464) * lu(k,459) + lu(k,465) = lu(k,465) * lu(k,459) + lu(k,466) = lu(k,466) * lu(k,459) + lu(k,1418) = lu(k,1418) - lu(k,460) * lu(k,1410) + lu(k,1424) = - lu(k,461) * lu(k,1410) + lu(k,1431) = lu(k,1431) - lu(k,462) * lu(k,1410) + lu(k,1447) = lu(k,1447) - lu(k,463) * lu(k,1410) + lu(k,1454) = lu(k,1454) - lu(k,464) * lu(k,1410) + lu(k,1458) = lu(k,1458) - lu(k,465) * lu(k,1410) + lu(k,1459) = lu(k,1459) - lu(k,466) * lu(k,1410) + lu(k,1587) = lu(k,1587) - lu(k,460) * lu(k,1553) + lu(k,1594) = lu(k,1594) - lu(k,461) * lu(k,1553) + lu(k,1601) = lu(k,1601) - lu(k,462) * lu(k,1553) + lu(k,1618) = lu(k,1618) - lu(k,463) * lu(k,1553) + lu(k,1625) = lu(k,1625) - lu(k,464) * lu(k,1553) + lu(k,1629) = lu(k,1629) - lu(k,465) * lu(k,1553) + lu(k,1630) = lu(k,1630) - lu(k,466) * lu(k,1553) + lu(k,1957) = lu(k,1957) - lu(k,460) * lu(k,1937) + lu(k,1962) = lu(k,1962) - lu(k,461) * lu(k,1937) + lu(k,1969) = lu(k,1969) - lu(k,462) * lu(k,1937) + lu(k,1984) = lu(k,1984) - lu(k,463) * lu(k,1937) + lu(k,1991) = lu(k,1991) - lu(k,464) * lu(k,1937) + lu(k,1995) = lu(k,1995) - lu(k,465) * lu(k,1937) + lu(k,1996) = lu(k,1996) - lu(k,466) * lu(k,1937) + lu(k,467) = 1._r8 / lu(k,467) + lu(k,468) = lu(k,468) * lu(k,467) + lu(k,469) = lu(k,469) * lu(k,467) + lu(k,470) = lu(k,470) * lu(k,467) + lu(k,471) = lu(k,471) * lu(k,467) + lu(k,472) = lu(k,472) * lu(k,467) + lu(k,473) = lu(k,473) * lu(k,467) + lu(k,474) = lu(k,474) * lu(k,467) + lu(k,475) = lu(k,475) * lu(k,467) + lu(k,1099) = - lu(k,468) * lu(k,1096) + lu(k,1100) = - lu(k,469) * lu(k,1096) + lu(k,1102) = - lu(k,470) * lu(k,1096) + lu(k,1113) = - lu(k,471) * lu(k,1096) + lu(k,1115) = lu(k,1115) - lu(k,472) * lu(k,1096) + lu(k,1117) = - lu(k,473) * lu(k,1096) + lu(k,1119) = lu(k,1119) - lu(k,474) * lu(k,1096) + lu(k,1121) = lu(k,1121) - lu(k,475) * lu(k,1096) + lu(k,1591) = lu(k,1591) - lu(k,468) * lu(k,1554) + lu(k,1594) = lu(k,1594) - lu(k,469) * lu(k,1554) + lu(k,1596) = lu(k,1596) - lu(k,470) * lu(k,1554) + lu(k,1615) = lu(k,1615) - lu(k,471) * lu(k,1554) + lu(k,1618) = lu(k,1618) - lu(k,472) * lu(k,1554) + lu(k,1621) = lu(k,1621) - lu(k,473) * lu(k,1554) + lu(k,1625) = lu(k,1625) - lu(k,474) * lu(k,1554) + lu(k,1629) = lu(k,1629) - lu(k,475) * lu(k,1554) + lu(k,1959) = lu(k,1959) - lu(k,468) * lu(k,1938) + lu(k,1962) = lu(k,1962) - lu(k,469) * lu(k,1938) + lu(k,1964) = lu(k,1964) - lu(k,470) * lu(k,1938) + lu(k,1981) = lu(k,1981) - lu(k,471) * lu(k,1938) + lu(k,1984) = lu(k,1984) - lu(k,472) * lu(k,1938) + lu(k,1987) = lu(k,1987) - lu(k,473) * lu(k,1938) + lu(k,1991) = lu(k,1991) - lu(k,474) * lu(k,1938) + lu(k,1995) = lu(k,1995) - lu(k,475) * lu(k,1938) + lu(k,476) = 1._r8 / lu(k,476) + lu(k,477) = lu(k,477) * lu(k,476) + lu(k,478) = lu(k,478) * lu(k,476) + lu(k,479) = lu(k,479) * lu(k,476) + lu(k,480) = lu(k,480) * lu(k,476) + lu(k,481) = lu(k,481) * lu(k,476) + lu(k,482) = lu(k,482) * lu(k,476) + lu(k,1389) = lu(k,1389) - lu(k,477) * lu(k,1339) + lu(k,1390) = lu(k,1390) - lu(k,478) * lu(k,1339) + lu(k,1393) = lu(k,1393) - lu(k,479) * lu(k,1339) + lu(k,1396) = lu(k,1396) - lu(k,480) * lu(k,1339) + lu(k,1400) = lu(k,1400) - lu(k,481) * lu(k,1339) + lu(k,1403) = lu(k,1403) - lu(k,482) * lu(k,1339) + lu(k,1617) = lu(k,1617) - lu(k,477) * lu(k,1555) + lu(k,1618) = lu(k,1618) - lu(k,478) * lu(k,1555) + lu(k,1621) = lu(k,1621) - lu(k,479) * lu(k,1555) + lu(k,1624) = lu(k,1624) - lu(k,480) * lu(k,1555) + lu(k,1628) = lu(k,1628) - lu(k,481) * lu(k,1555) + lu(k,1631) = lu(k,1631) - lu(k,482) * lu(k,1555) + lu(k,1727) = lu(k,1727) - lu(k,477) * lu(k,1712) + lu(k,1728) = lu(k,1728) - lu(k,478) * lu(k,1712) + lu(k,1731) = lu(k,1731) - lu(k,479) * lu(k,1712) + lu(k,1734) = lu(k,1734) - lu(k,480) * lu(k,1712) + lu(k,1738) = - lu(k,481) * lu(k,1712) + lu(k,1741) = lu(k,1741) - lu(k,482) * lu(k,1712) + lu(k,1882) = lu(k,1882) - lu(k,477) * lu(k,1870) + lu(k,1883) = lu(k,1883) - lu(k,478) * lu(k,1870) + lu(k,1886) = lu(k,1886) - lu(k,479) * lu(k,1870) + lu(k,1889) = lu(k,1889) - lu(k,480) * lu(k,1870) + lu(k,1893) = lu(k,1893) - lu(k,481) * lu(k,1870) + lu(k,1896) = - lu(k,482) * lu(k,1870) + lu(k,483) = 1._r8 / lu(k,483) + lu(k,484) = lu(k,484) * lu(k,483) + lu(k,485) = lu(k,485) * lu(k,483) + lu(k,486) = lu(k,486) * lu(k,483) + lu(k,487) = lu(k,487) * lu(k,483) + lu(k,488) = lu(k,488) * lu(k,483) + lu(k,489) = lu(k,489) * lu(k,483) + lu(k,490) = lu(k,490) * lu(k,483) + lu(k,491) = lu(k,491) * lu(k,483) + lu(k,946) = lu(k,946) - lu(k,484) * lu(k,944) + lu(k,947) = lu(k,947) - lu(k,485) * lu(k,944) + lu(k,948) = lu(k,948) - lu(k,486) * lu(k,944) + lu(k,949) = lu(k,949) - lu(k,487) * lu(k,944) + lu(k,950) = lu(k,950) - lu(k,488) * lu(k,944) + lu(k,955) = lu(k,955) - lu(k,489) * lu(k,944) + lu(k,956) = - lu(k,490) * lu(k,944) + lu(k,959) = lu(k,959) - lu(k,491) * lu(k,944) + lu(k,1364) = lu(k,1364) - lu(k,484) * lu(k,1340) + lu(k,1366) = lu(k,1366) - lu(k,485) * lu(k,1340) + lu(k,1367) = - lu(k,486) * lu(k,1340) + lu(k,1368) = lu(k,1368) - lu(k,487) * lu(k,1340) + lu(k,1371) = lu(k,1371) - lu(k,488) * lu(k,1340) + lu(k,1390) = lu(k,1390) - lu(k,489) * lu(k,1340) + lu(k,1393) = lu(k,1393) - lu(k,490) * lu(k,1340) + lu(k,1401) = lu(k,1401) - lu(k,491) * lu(k,1340) + lu(k,1587) = lu(k,1587) - lu(k,484) * lu(k,1556) + lu(k,1591) = lu(k,1591) - lu(k,485) * lu(k,1556) + lu(k,1593) = lu(k,1593) - lu(k,486) * lu(k,1556) + lu(k,1595) = lu(k,1595) - lu(k,487) * lu(k,1556) + lu(k,1598) = lu(k,1598) - lu(k,488) * lu(k,1556) + lu(k,1618) = lu(k,1618) - lu(k,489) * lu(k,1556) + lu(k,1621) = lu(k,1621) - lu(k,490) * lu(k,1556) + lu(k,1629) = lu(k,1629) - lu(k,491) * lu(k,1556) + end do + end subroutine lu_fac11 + subroutine lu_fac12( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,494) = 1._r8 / lu(k,494) + lu(k,495) = lu(k,495) * lu(k,494) + lu(k,496) = lu(k,496) * lu(k,494) + lu(k,497) = lu(k,497) * lu(k,494) + lu(k,498) = lu(k,498) * lu(k,494) + lu(k,499) = lu(k,499) * lu(k,494) + lu(k,500) = lu(k,500) * lu(k,494) + lu(k,501) = lu(k,501) * lu(k,494) + lu(k,502) = lu(k,502) * lu(k,494) + lu(k,592) = lu(k,592) - lu(k,495) * lu(k,591) + lu(k,593) = lu(k,593) - lu(k,496) * lu(k,591) + lu(k,594) = lu(k,594) - lu(k,497) * lu(k,591) + lu(k,595) = lu(k,595) - lu(k,498) * lu(k,591) + lu(k,596) = lu(k,596) - lu(k,499) * lu(k,591) + lu(k,599) = lu(k,599) - lu(k,500) * lu(k,591) + lu(k,600) = lu(k,600) - lu(k,501) * lu(k,591) + lu(k,601) = - lu(k,502) * lu(k,591) + lu(k,1342) = - lu(k,495) * lu(k,1341) + lu(k,1349) = lu(k,1349) - lu(k,496) * lu(k,1341) + lu(k,1350) = lu(k,1350) - lu(k,497) * lu(k,1341) + lu(k,1352) = lu(k,1352) - lu(k,498) * lu(k,1341) + lu(k,1361) = lu(k,1361) - lu(k,499) * lu(k,1341) + lu(k,1379) = lu(k,1379) - lu(k,500) * lu(k,1341) + lu(k,1390) = lu(k,1390) - lu(k,501) * lu(k,1341) + lu(k,1393) = lu(k,1393) - lu(k,502) * lu(k,1341) + lu(k,1558) = lu(k,1558) - lu(k,495) * lu(k,1557) + lu(k,1567) = lu(k,1567) - lu(k,496) * lu(k,1557) + lu(k,1568) = lu(k,1568) - lu(k,497) * lu(k,1557) + lu(k,1570) = - lu(k,498) * lu(k,1557) + lu(k,1582) = lu(k,1582) - lu(k,499) * lu(k,1557) + lu(k,1606) = lu(k,1606) - lu(k,500) * lu(k,1557) + lu(k,1618) = lu(k,1618) - lu(k,501) * lu(k,1557) + lu(k,1621) = lu(k,1621) - lu(k,502) * lu(k,1557) + lu(k,503) = 1._r8 / lu(k,503) + lu(k,504) = lu(k,504) * lu(k,503) + lu(k,505) = lu(k,505) * lu(k,503) + lu(k,506) = lu(k,506) * lu(k,503) + lu(k,568) = - lu(k,504) * lu(k,562) + lu(k,569) = lu(k,569) - lu(k,505) * lu(k,562) + lu(k,572) = lu(k,572) - lu(k,506) * lu(k,562) + lu(k,597) = - lu(k,504) * lu(k,592) + lu(k,598) = - lu(k,505) * lu(k,592) + lu(k,600) = lu(k,600) - lu(k,506) * lu(k,592) + lu(k,613) = - lu(k,504) * lu(k,607) + lu(k,614) = lu(k,614) - lu(k,505) * lu(k,607) + lu(k,617) = lu(k,617) - lu(k,506) * lu(k,607) + lu(k,873) = - lu(k,504) * lu(k,870) + lu(k,875) = - lu(k,505) * lu(k,870) + lu(k,879) = lu(k,879) - lu(k,506) * lu(k,870) + lu(k,1174) = - lu(k,504) * lu(k,1169) + lu(k,1177) = - lu(k,505) * lu(k,1169) + lu(k,1191) = lu(k,1191) - lu(k,506) * lu(k,1169) + lu(k,1362) = lu(k,1362) - lu(k,504) * lu(k,1342) + lu(k,1368) = lu(k,1368) - lu(k,505) * lu(k,1342) + lu(k,1390) = lu(k,1390) - lu(k,506) * lu(k,1342) + lu(k,1583) = - lu(k,504) * lu(k,1558) + lu(k,1595) = lu(k,1595) - lu(k,505) * lu(k,1558) + lu(k,1618) = lu(k,1618) - lu(k,506) * lu(k,1558) + lu(k,1955) = lu(k,1955) - lu(k,504) * lu(k,1939) + lu(k,1963) = lu(k,1963) - lu(k,505) * lu(k,1939) + lu(k,1984) = lu(k,1984) - lu(k,506) * lu(k,1939) + lu(k,507) = 1._r8 / lu(k,507) + lu(k,508) = lu(k,508) * lu(k,507) + lu(k,509) = lu(k,509) * lu(k,507) + lu(k,510) = lu(k,510) * lu(k,507) + lu(k,511) = lu(k,511) * lu(k,507) + lu(k,512) = lu(k,512) * lu(k,507) + lu(k,925) = lu(k,925) - lu(k,508) * lu(k,922) + lu(k,933) = - lu(k,509) * lu(k,922) + lu(k,935) = lu(k,935) - lu(k,510) * lu(k,922) + lu(k,937) = lu(k,937) - lu(k,511) * lu(k,922) + lu(k,939) = lu(k,939) - lu(k,512) * lu(k,922) + lu(k,965) = lu(k,965) - lu(k,508) * lu(k,963) + lu(k,972) = lu(k,972) - lu(k,509) * lu(k,963) + lu(k,974) = lu(k,974) - lu(k,510) * lu(k,963) + lu(k,976) = lu(k,976) - lu(k,511) * lu(k,963) + lu(k,978) = lu(k,978) - lu(k,512) * lu(k,963) + lu(k,1590) = lu(k,1590) - lu(k,508) * lu(k,1559) + lu(k,1615) = lu(k,1615) - lu(k,509) * lu(k,1559) + lu(k,1618) = lu(k,1618) - lu(k,510) * lu(k,1559) + lu(k,1621) = lu(k,1621) - lu(k,511) * lu(k,1559) + lu(k,1625) = lu(k,1625) - lu(k,512) * lu(k,1559) + lu(k,1644) = lu(k,1644) - lu(k,508) * lu(k,1637) + lu(k,1665) = lu(k,1665) - lu(k,509) * lu(k,1637) + lu(k,1668) = lu(k,1668) - lu(k,510) * lu(k,1637) + lu(k,1671) = lu(k,1671) - lu(k,511) * lu(k,1637) + lu(k,1675) = lu(k,1675) - lu(k,512) * lu(k,1637) + lu(k,1958) = lu(k,1958) - lu(k,508) * lu(k,1940) + lu(k,1981) = lu(k,1981) - lu(k,509) * lu(k,1940) + lu(k,1984) = lu(k,1984) - lu(k,510) * lu(k,1940) + lu(k,1987) = lu(k,1987) - lu(k,511) * lu(k,1940) + lu(k,1991) = lu(k,1991) - lu(k,512) * lu(k,1940) + lu(k,515) = 1._r8 / lu(k,515) + lu(k,516) = lu(k,516) * lu(k,515) + lu(k,517) = lu(k,517) * lu(k,515) + lu(k,518) = lu(k,518) * lu(k,515) + lu(k,519) = lu(k,519) * lu(k,515) + lu(k,520) = lu(k,520) * lu(k,515) + lu(k,1390) = lu(k,1390) - lu(k,516) * lu(k,1343) + lu(k,1393) = lu(k,1393) - lu(k,517) * lu(k,1343) + lu(k,1397) = lu(k,1397) - lu(k,518) * lu(k,1343) + lu(k,1398) = lu(k,1398) - lu(k,519) * lu(k,1343) + lu(k,1402) = lu(k,1402) - lu(k,520) * lu(k,1343) + lu(k,1618) = lu(k,1618) - lu(k,516) * lu(k,1560) + lu(k,1621) = lu(k,1621) - lu(k,517) * lu(k,1560) + lu(k,1625) = lu(k,1625) - lu(k,518) * lu(k,1560) + lu(k,1626) = lu(k,1626) - lu(k,519) * lu(k,1560) + lu(k,1630) = lu(k,1630) - lu(k,520) * lu(k,1560) + lu(k,1769) = lu(k,1769) - lu(k,516) * lu(k,1751) + lu(k,1772) = lu(k,1772) - lu(k,517) * lu(k,1751) + lu(k,1776) = lu(k,1776) - lu(k,518) * lu(k,1751) + lu(k,1777) = lu(k,1777) - lu(k,519) * lu(k,1751) + lu(k,1781) = lu(k,1781) - lu(k,520) * lu(k,1751) + lu(k,1829) = lu(k,1829) - lu(k,516) * lu(k,1794) + lu(k,1832) = lu(k,1832) - lu(k,517) * lu(k,1794) + lu(k,1836) = lu(k,1836) - lu(k,518) * lu(k,1794) + lu(k,1837) = lu(k,1837) - lu(k,519) * lu(k,1794) + lu(k,1841) = lu(k,1841) - lu(k,520) * lu(k,1794) + lu(k,1984) = lu(k,1984) - lu(k,516) * lu(k,1941) + lu(k,1987) = lu(k,1987) - lu(k,517) * lu(k,1941) + lu(k,1991) = lu(k,1991) - lu(k,518) * lu(k,1941) + lu(k,1992) = lu(k,1992) - lu(k,519) * lu(k,1941) + lu(k,1996) = lu(k,1996) - lu(k,520) * lu(k,1941) + lu(k,522) = 1._r8 / lu(k,522) + lu(k,523) = lu(k,523) * lu(k,522) + lu(k,524) = lu(k,524) * lu(k,522) + lu(k,525) = lu(k,525) * lu(k,522) + lu(k,526) = lu(k,526) * lu(k,522) + lu(k,527) = lu(k,527) * lu(k,522) + lu(k,528) = lu(k,528) * lu(k,522) + lu(k,529) = lu(k,529) * lu(k,522) + lu(k,530) = lu(k,530) * lu(k,522) + lu(k,531) = lu(k,531) * lu(k,522) + lu(k,807) = lu(k,807) - lu(k,523) * lu(k,805) + lu(k,808) = lu(k,808) - lu(k,524) * lu(k,805) + lu(k,809) = lu(k,809) - lu(k,525) * lu(k,805) + lu(k,810) = lu(k,810) - lu(k,526) * lu(k,805) + lu(k,811) = lu(k,811) - lu(k,527) * lu(k,805) + lu(k,812) = lu(k,812) - lu(k,528) * lu(k,805) + lu(k,813) = lu(k,813) - lu(k,529) * lu(k,805) + lu(k,814) = lu(k,814) - lu(k,530) * lu(k,805) + lu(k,817) = lu(k,817) - lu(k,531) * lu(k,805) + lu(k,1345) = lu(k,1345) - lu(k,523) * lu(k,1344) + lu(k,1358) = lu(k,1358) - lu(k,524) * lu(k,1344) + lu(k,1363) = lu(k,1363) - lu(k,525) * lu(k,1344) + lu(k,1364) = lu(k,1364) - lu(k,526) * lu(k,1344) + lu(k,1374) = lu(k,1374) - lu(k,527) * lu(k,1344) + lu(k,1385) = lu(k,1385) - lu(k,528) * lu(k,1344) + lu(k,1390) = lu(k,1390) - lu(k,529) * lu(k,1344) + lu(k,1393) = lu(k,1393) - lu(k,530) * lu(k,1344) + lu(k,1401) = lu(k,1401) - lu(k,531) * lu(k,1344) + lu(k,1563) = lu(k,1563) - lu(k,523) * lu(k,1561) + lu(k,1577) = lu(k,1577) - lu(k,524) * lu(k,1561) + lu(k,1586) = lu(k,1586) - lu(k,525) * lu(k,1561) + lu(k,1587) = lu(k,1587) - lu(k,526) * lu(k,1561) + lu(k,1601) = lu(k,1601) - lu(k,527) * lu(k,1561) + lu(k,1613) = lu(k,1613) - lu(k,528) * lu(k,1561) + lu(k,1618) = lu(k,1618) - lu(k,529) * lu(k,1561) + lu(k,1621) = lu(k,1621) - lu(k,530) * lu(k,1561) + lu(k,1629) = lu(k,1629) - lu(k,531) * lu(k,1561) + lu(k,533) = 1._r8 / lu(k,533) + lu(k,534) = lu(k,534) * lu(k,533) + lu(k,535) = lu(k,535) * lu(k,533) + lu(k,536) = lu(k,536) * lu(k,533) + lu(k,537) = lu(k,537) * lu(k,533) + lu(k,538) = lu(k,538) * lu(k,533) + lu(k,539) = lu(k,539) * lu(k,533) + lu(k,540) = lu(k,540) * lu(k,533) + lu(k,541) = lu(k,541) * lu(k,533) + lu(k,542) = lu(k,542) * lu(k,533) + lu(k,807) = lu(k,807) - lu(k,534) * lu(k,806) + lu(k,808) = lu(k,808) - lu(k,535) * lu(k,806) + lu(k,810) = lu(k,810) - lu(k,536) * lu(k,806) + lu(k,811) = lu(k,811) - lu(k,537) * lu(k,806) + lu(k,812) = lu(k,812) - lu(k,538) * lu(k,806) + lu(k,813) = lu(k,813) - lu(k,539) * lu(k,806) + lu(k,814) = lu(k,814) - lu(k,540) * lu(k,806) + lu(k,816) = lu(k,816) - lu(k,541) * lu(k,806) + lu(k,817) = lu(k,817) - lu(k,542) * lu(k,806) + lu(k,1563) = lu(k,1563) - lu(k,534) * lu(k,1562) + lu(k,1577) = lu(k,1577) - lu(k,535) * lu(k,1562) + lu(k,1587) = lu(k,1587) - lu(k,536) * lu(k,1562) + lu(k,1601) = lu(k,1601) - lu(k,537) * lu(k,1562) + lu(k,1613) = lu(k,1613) - lu(k,538) * lu(k,1562) + lu(k,1618) = lu(k,1618) - lu(k,539) * lu(k,1562) + lu(k,1621) = lu(k,1621) - lu(k,540) * lu(k,1562) + lu(k,1625) = lu(k,1625) - lu(k,541) * lu(k,1562) + lu(k,1629) = lu(k,1629) - lu(k,542) * lu(k,1562) + lu(k,1943) = lu(k,1943) - lu(k,534) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,535) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,536) * lu(k,1942) + lu(k,1969) = lu(k,1969) - lu(k,537) * lu(k,1942) + lu(k,1979) = lu(k,1979) - lu(k,538) * lu(k,1942) + lu(k,1984) = lu(k,1984) - lu(k,539) * lu(k,1942) + lu(k,1987) = lu(k,1987) - lu(k,540) * lu(k,1942) + lu(k,1991) = lu(k,1991) - lu(k,541) * lu(k,1942) + lu(k,1995) = lu(k,1995) - lu(k,542) * lu(k,1942) + end do + end subroutine lu_fac12 + subroutine lu_fac13( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,544) = 1._r8 / lu(k,544) + lu(k,545) = lu(k,545) * lu(k,544) + lu(k,546) = lu(k,546) * lu(k,544) + lu(k,547) = lu(k,547) * lu(k,544) + lu(k,548) = lu(k,548) * lu(k,544) + lu(k,549) = lu(k,549) * lu(k,544) + lu(k,550) = lu(k,550) * lu(k,544) + lu(k,811) = lu(k,811) - lu(k,545) * lu(k,807) + lu(k,812) = lu(k,812) - lu(k,546) * lu(k,807) + lu(k,813) = lu(k,813) - lu(k,547) * lu(k,807) + lu(k,814) = lu(k,814) - lu(k,548) * lu(k,807) + lu(k,816) = lu(k,816) - lu(k,549) * lu(k,807) + lu(k,818) = lu(k,818) - lu(k,550) * lu(k,807) + lu(k,1374) = lu(k,1374) - lu(k,545) * lu(k,1345) + lu(k,1385) = lu(k,1385) - lu(k,546) * lu(k,1345) + lu(k,1390) = lu(k,1390) - lu(k,547) * lu(k,1345) + lu(k,1393) = lu(k,1393) - lu(k,548) * lu(k,1345) + lu(k,1397) = lu(k,1397) - lu(k,549) * lu(k,1345) + lu(k,1402) = lu(k,1402) - lu(k,550) * lu(k,1345) + lu(k,1601) = lu(k,1601) - lu(k,545) * lu(k,1563) + lu(k,1613) = lu(k,1613) - lu(k,546) * lu(k,1563) + lu(k,1618) = lu(k,1618) - lu(k,547) * lu(k,1563) + lu(k,1621) = lu(k,1621) - lu(k,548) * lu(k,1563) + lu(k,1625) = lu(k,1625) - lu(k,549) * lu(k,1563) + lu(k,1630) = lu(k,1630) - lu(k,550) * lu(k,1563) + lu(k,1969) = lu(k,1969) - lu(k,545) * lu(k,1943) + lu(k,1979) = lu(k,1979) - lu(k,546) * lu(k,1943) + lu(k,1984) = lu(k,1984) - lu(k,547) * lu(k,1943) + lu(k,1987) = lu(k,1987) - lu(k,548) * lu(k,1943) + lu(k,1991) = lu(k,1991) - lu(k,549) * lu(k,1943) + lu(k,1996) = lu(k,1996) - lu(k,550) * lu(k,1943) + lu(k,552) = 1._r8 / lu(k,552) + lu(k,553) = lu(k,553) * lu(k,552) + lu(k,554) = lu(k,554) * lu(k,552) + lu(k,555) = lu(k,555) * lu(k,552) + lu(k,556) = lu(k,556) * lu(k,552) + lu(k,557) = lu(k,557) * lu(k,552) + lu(k,558) = lu(k,558) * lu(k,552) + lu(k,1043) = - lu(k,553) * lu(k,1037) + lu(k,1045) = - lu(k,554) * lu(k,1037) + lu(k,1047) = - lu(k,555) * lu(k,1037) + lu(k,1051) = lu(k,1051) - lu(k,556) * lu(k,1037) + lu(k,1053) = lu(k,1053) - lu(k,557) * lu(k,1037) + lu(k,1056) = lu(k,1056) - lu(k,558) * lu(k,1037) + lu(k,1105) = - lu(k,553) * lu(k,1097) + lu(k,1106) = lu(k,1106) - lu(k,554) * lu(k,1097) + lu(k,1109) = lu(k,1109) - lu(k,555) * lu(k,1097) + lu(k,1115) = lu(k,1115) - lu(k,556) * lu(k,1097) + lu(k,1117) = lu(k,1117) - lu(k,557) * lu(k,1097) + lu(k,1121) = lu(k,1121) - lu(k,558) * lu(k,1097) + lu(k,1181) = lu(k,1181) - lu(k,553) * lu(k,1170) + lu(k,1182) = - lu(k,554) * lu(k,1170) + lu(k,1184) = - lu(k,555) * lu(k,1170) + lu(k,1191) = lu(k,1191) - lu(k,556) * lu(k,1170) + lu(k,1193) = lu(k,1193) - lu(k,557) * lu(k,1170) + lu(k,1197) = lu(k,1197) - lu(k,558) * lu(k,1170) + lu(k,1376) = lu(k,1376) - lu(k,553) * lu(k,1346) + lu(k,1378) = - lu(k,554) * lu(k,1346) + lu(k,1381) = - lu(k,555) * lu(k,1346) + lu(k,1390) = lu(k,1390) - lu(k,556) * lu(k,1346) + lu(k,1393) = lu(k,1393) - lu(k,557) * lu(k,1346) + lu(k,1401) = lu(k,1401) - lu(k,558) * lu(k,1346) + lu(k,1603) = lu(k,1603) - lu(k,553) * lu(k,1564) + lu(k,1605) = lu(k,1605) - lu(k,554) * lu(k,1564) + lu(k,1609) = lu(k,1609) - lu(k,555) * lu(k,1564) + lu(k,1618) = lu(k,1618) - lu(k,556) * lu(k,1564) + lu(k,1621) = lu(k,1621) - lu(k,557) * lu(k,1564) + lu(k,1629) = lu(k,1629) - lu(k,558) * lu(k,1564) + lu(k,563) = 1._r8 / lu(k,563) + lu(k,564) = lu(k,564) * lu(k,563) + lu(k,565) = lu(k,565) * lu(k,563) + lu(k,566) = lu(k,566) * lu(k,563) + lu(k,567) = lu(k,567) * lu(k,563) + lu(k,568) = lu(k,568) * lu(k,563) + lu(k,569) = lu(k,569) * lu(k,563) + lu(k,570) = lu(k,570) * lu(k,563) + lu(k,571) = lu(k,571) * lu(k,563) + lu(k,572) = lu(k,572) * lu(k,563) + lu(k,573) = lu(k,573) * lu(k,563) + lu(k,609) = lu(k,609) - lu(k,564) * lu(k,608) + lu(k,610) = lu(k,610) - lu(k,565) * lu(k,608) + lu(k,611) = lu(k,611) - lu(k,566) * lu(k,608) + lu(k,612) = lu(k,612) - lu(k,567) * lu(k,608) + lu(k,613) = lu(k,613) - lu(k,568) * lu(k,608) + lu(k,614) = lu(k,614) - lu(k,569) * lu(k,608) + lu(k,615) = lu(k,615) - lu(k,570) * lu(k,608) + lu(k,616) = lu(k,616) - lu(k,571) * lu(k,608) + lu(k,617) = lu(k,617) - lu(k,572) * lu(k,608) + lu(k,618) = - lu(k,573) * lu(k,608) + lu(k,1349) = lu(k,1349) - lu(k,564) * lu(k,1347) + lu(k,1351) = lu(k,1351) - lu(k,565) * lu(k,1347) + lu(k,1352) = lu(k,1352) - lu(k,566) * lu(k,1347) + lu(k,1361) = lu(k,1361) - lu(k,567) * lu(k,1347) + lu(k,1362) = lu(k,1362) - lu(k,568) * lu(k,1347) + lu(k,1368) = lu(k,1368) - lu(k,569) * lu(k,1347) + lu(k,1379) = lu(k,1379) - lu(k,570) * lu(k,1347) + lu(k,1385) = lu(k,1385) - lu(k,571) * lu(k,1347) + lu(k,1390) = lu(k,1390) - lu(k,572) * lu(k,1347) + lu(k,1393) = lu(k,1393) - lu(k,573) * lu(k,1347) + lu(k,1567) = lu(k,1567) - lu(k,564) * lu(k,1565) + lu(k,1569) = lu(k,1569) - lu(k,565) * lu(k,1565) + lu(k,1570) = lu(k,1570) - lu(k,566) * lu(k,1565) + lu(k,1582) = lu(k,1582) - lu(k,567) * lu(k,1565) + lu(k,1583) = lu(k,1583) - lu(k,568) * lu(k,1565) + lu(k,1595) = lu(k,1595) - lu(k,569) * lu(k,1565) + lu(k,1606) = lu(k,1606) - lu(k,570) * lu(k,1565) + lu(k,1613) = lu(k,1613) - lu(k,571) * lu(k,1565) + lu(k,1618) = lu(k,1618) - lu(k,572) * lu(k,1565) + lu(k,1621) = lu(k,1621) - lu(k,573) * lu(k,1565) + lu(k,576) = 1._r8 / lu(k,576) + lu(k,577) = lu(k,577) * lu(k,576) + lu(k,578) = lu(k,578) * lu(k,576) + lu(k,579) = lu(k,579) * lu(k,576) + lu(k,580) = lu(k,580) * lu(k,576) + lu(k,581) = lu(k,581) * lu(k,576) + lu(k,582) = lu(k,582) * lu(k,576) + lu(k,1366) = lu(k,1366) - lu(k,577) * lu(k,1348) + lu(k,1390) = lu(k,1390) - lu(k,578) * lu(k,1348) + lu(k,1393) = lu(k,1393) - lu(k,579) * lu(k,1348) + lu(k,1397) = lu(k,1397) - lu(k,580) * lu(k,1348) + lu(k,1401) = lu(k,1401) - lu(k,581) * lu(k,1348) + lu(k,1402) = lu(k,1402) - lu(k,582) * lu(k,1348) + lu(k,1591) = lu(k,1591) - lu(k,577) * lu(k,1566) + lu(k,1618) = lu(k,1618) - lu(k,578) * lu(k,1566) + lu(k,1621) = lu(k,1621) - lu(k,579) * lu(k,1566) + lu(k,1625) = lu(k,1625) - lu(k,580) * lu(k,1566) + lu(k,1629) = lu(k,1629) - lu(k,581) * lu(k,1566) + lu(k,1630) = lu(k,1630) - lu(k,582) * lu(k,1566) + lu(k,1719) = - lu(k,577) * lu(k,1713) + lu(k,1728) = lu(k,1728) - lu(k,578) * lu(k,1713) + lu(k,1731) = lu(k,1731) - lu(k,579) * lu(k,1713) + lu(k,1735) = - lu(k,580) * lu(k,1713) + lu(k,1739) = lu(k,1739) - lu(k,581) * lu(k,1713) + lu(k,1740) = - lu(k,582) * lu(k,1713) + lu(k,1806) = - lu(k,577) * lu(k,1795) + lu(k,1829) = lu(k,1829) - lu(k,578) * lu(k,1795) + lu(k,1832) = lu(k,1832) - lu(k,579) * lu(k,1795) + lu(k,1836) = lu(k,1836) - lu(k,580) * lu(k,1795) + lu(k,1840) = lu(k,1840) - lu(k,581) * lu(k,1795) + lu(k,1841) = lu(k,1841) - lu(k,582) * lu(k,1795) + lu(k,1959) = lu(k,1959) - lu(k,577) * lu(k,1944) + lu(k,1984) = lu(k,1984) - lu(k,578) * lu(k,1944) + lu(k,1987) = lu(k,1987) - lu(k,579) * lu(k,1944) + lu(k,1991) = lu(k,1991) - lu(k,580) * lu(k,1944) + lu(k,1995) = lu(k,1995) - lu(k,581) * lu(k,1944) + lu(k,1996) = lu(k,1996) - lu(k,582) * lu(k,1944) + lu(k,583) = 1._r8 / lu(k,583) + lu(k,584) = lu(k,584) * lu(k,583) + lu(k,585) = lu(k,585) * lu(k,583) + lu(k,586) = lu(k,586) * lu(k,583) + lu(k,587) = lu(k,587) * lu(k,583) + lu(k,588) = lu(k,588) * lu(k,583) + lu(k,596) = lu(k,596) - lu(k,584) * lu(k,593) + lu(k,598) = lu(k,598) - lu(k,585) * lu(k,593) + lu(k,600) = lu(k,600) - lu(k,586) * lu(k,593) + lu(k,602) = lu(k,602) - lu(k,587) * lu(k,593) + lu(k,603) = lu(k,603) - lu(k,588) * lu(k,593) + lu(k,612) = lu(k,612) - lu(k,584) * lu(k,609) + lu(k,614) = lu(k,614) - lu(k,585) * lu(k,609) + lu(k,617) = lu(k,617) - lu(k,586) * lu(k,609) + lu(k,619) = lu(k,619) - lu(k,587) * lu(k,609) + lu(k,620) = lu(k,620) - lu(k,588) * lu(k,609) + lu(k,1361) = lu(k,1361) - lu(k,584) * lu(k,1349) + lu(k,1368) = lu(k,1368) - lu(k,585) * lu(k,1349) + lu(k,1390) = lu(k,1390) - lu(k,586) * lu(k,1349) + lu(k,1397) = lu(k,1397) - lu(k,587) * lu(k,1349) + lu(k,1402) = lu(k,1402) - lu(k,588) * lu(k,1349) + lu(k,1582) = lu(k,1582) - lu(k,584) * lu(k,1567) + lu(k,1595) = lu(k,1595) - lu(k,585) * lu(k,1567) + lu(k,1618) = lu(k,1618) - lu(k,586) * lu(k,1567) + lu(k,1625) = lu(k,1625) - lu(k,587) * lu(k,1567) + lu(k,1630) = lu(k,1630) - lu(k,588) * lu(k,1567) + lu(k,1756) = - lu(k,584) * lu(k,1752) + lu(k,1759) = - lu(k,585) * lu(k,1752) + lu(k,1769) = lu(k,1769) - lu(k,586) * lu(k,1752) + lu(k,1776) = lu(k,1776) - lu(k,587) * lu(k,1752) + lu(k,1781) = lu(k,1781) - lu(k,588) * lu(k,1752) + lu(k,1954) = lu(k,1954) - lu(k,584) * lu(k,1945) + lu(k,1963) = lu(k,1963) - lu(k,585) * lu(k,1945) + lu(k,1984) = lu(k,1984) - lu(k,586) * lu(k,1945) + lu(k,1991) = lu(k,1991) - lu(k,587) * lu(k,1945) + lu(k,1996) = lu(k,1996) - lu(k,588) * lu(k,1945) + end do + end subroutine lu_fac13 + subroutine lu_fac14( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,594) = 1._r8 / lu(k,594) + lu(k,595) = lu(k,595) * lu(k,594) + lu(k,596) = lu(k,596) * lu(k,594) + lu(k,597) = lu(k,597) * lu(k,594) + lu(k,598) = lu(k,598) * lu(k,594) + lu(k,599) = lu(k,599) * lu(k,594) + lu(k,600) = lu(k,600) * lu(k,594) + lu(k,601) = lu(k,601) * lu(k,594) + lu(k,602) = lu(k,602) * lu(k,594) + lu(k,603) = lu(k,603) * lu(k,594) + lu(k,1352) = lu(k,1352) - lu(k,595) * lu(k,1350) + lu(k,1361) = lu(k,1361) - lu(k,596) * lu(k,1350) + lu(k,1362) = lu(k,1362) - lu(k,597) * lu(k,1350) + lu(k,1368) = lu(k,1368) - lu(k,598) * lu(k,1350) + lu(k,1379) = lu(k,1379) - lu(k,599) * lu(k,1350) + lu(k,1390) = lu(k,1390) - lu(k,600) * lu(k,1350) + lu(k,1393) = lu(k,1393) - lu(k,601) * lu(k,1350) + lu(k,1397) = lu(k,1397) - lu(k,602) * lu(k,1350) + lu(k,1402) = lu(k,1402) - lu(k,603) * lu(k,1350) + lu(k,1570) = lu(k,1570) - lu(k,595) * lu(k,1568) + lu(k,1582) = lu(k,1582) - lu(k,596) * lu(k,1568) + lu(k,1583) = lu(k,1583) - lu(k,597) * lu(k,1568) + lu(k,1595) = lu(k,1595) - lu(k,598) * lu(k,1568) + lu(k,1606) = lu(k,1606) - lu(k,599) * lu(k,1568) + lu(k,1618) = lu(k,1618) - lu(k,600) * lu(k,1568) + lu(k,1621) = lu(k,1621) - lu(k,601) * lu(k,1568) + lu(k,1625) = lu(k,1625) - lu(k,602) * lu(k,1568) + lu(k,1630) = lu(k,1630) - lu(k,603) * lu(k,1568) + lu(k,1948) = lu(k,1948) - lu(k,595) * lu(k,1946) + lu(k,1954) = lu(k,1954) - lu(k,596) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,597) * lu(k,1946) + lu(k,1963) = lu(k,1963) - lu(k,598) * lu(k,1946) + lu(k,1973) = lu(k,1973) - lu(k,599) * lu(k,1946) + lu(k,1984) = lu(k,1984) - lu(k,600) * lu(k,1946) + lu(k,1987) = lu(k,1987) - lu(k,601) * lu(k,1946) + lu(k,1991) = lu(k,1991) - lu(k,602) * lu(k,1946) + lu(k,1996) = lu(k,1996) - lu(k,603) * lu(k,1946) + lu(k,610) = 1._r8 / lu(k,610) + lu(k,611) = lu(k,611) * lu(k,610) + lu(k,612) = lu(k,612) * lu(k,610) + lu(k,613) = lu(k,613) * lu(k,610) + lu(k,614) = lu(k,614) * lu(k,610) + lu(k,615) = lu(k,615) * lu(k,610) + lu(k,616) = lu(k,616) * lu(k,610) + lu(k,617) = lu(k,617) * lu(k,610) + lu(k,618) = lu(k,618) * lu(k,610) + lu(k,619) = lu(k,619) * lu(k,610) + lu(k,620) = lu(k,620) * lu(k,610) + lu(k,1352) = lu(k,1352) - lu(k,611) * lu(k,1351) + lu(k,1361) = lu(k,1361) - lu(k,612) * lu(k,1351) + lu(k,1362) = lu(k,1362) - lu(k,613) * lu(k,1351) + lu(k,1368) = lu(k,1368) - lu(k,614) * lu(k,1351) + lu(k,1379) = lu(k,1379) - lu(k,615) * lu(k,1351) + lu(k,1385) = lu(k,1385) - lu(k,616) * lu(k,1351) + lu(k,1390) = lu(k,1390) - lu(k,617) * lu(k,1351) + lu(k,1393) = lu(k,1393) - lu(k,618) * lu(k,1351) + lu(k,1397) = lu(k,1397) - lu(k,619) * lu(k,1351) + lu(k,1402) = lu(k,1402) - lu(k,620) * lu(k,1351) + lu(k,1570) = lu(k,1570) - lu(k,611) * lu(k,1569) + lu(k,1582) = lu(k,1582) - lu(k,612) * lu(k,1569) + lu(k,1583) = lu(k,1583) - lu(k,613) * lu(k,1569) + lu(k,1595) = lu(k,1595) - lu(k,614) * lu(k,1569) + lu(k,1606) = lu(k,1606) - lu(k,615) * lu(k,1569) + lu(k,1613) = lu(k,1613) - lu(k,616) * lu(k,1569) + lu(k,1618) = lu(k,1618) - lu(k,617) * lu(k,1569) + lu(k,1621) = lu(k,1621) - lu(k,618) * lu(k,1569) + lu(k,1625) = lu(k,1625) - lu(k,619) * lu(k,1569) + lu(k,1630) = lu(k,1630) - lu(k,620) * lu(k,1569) + lu(k,1948) = lu(k,1948) - lu(k,611) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,612) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,613) * lu(k,1947) + lu(k,1963) = lu(k,1963) - lu(k,614) * lu(k,1947) + lu(k,1973) = lu(k,1973) - lu(k,615) * lu(k,1947) + lu(k,1979) = lu(k,1979) - lu(k,616) * lu(k,1947) + lu(k,1984) = lu(k,1984) - lu(k,617) * lu(k,1947) + lu(k,1987) = lu(k,1987) - lu(k,618) * lu(k,1947) + lu(k,1991) = lu(k,1991) - lu(k,619) * lu(k,1947) + lu(k,1996) = lu(k,1996) - lu(k,620) * lu(k,1947) + lu(k,621) = 1._r8 / lu(k,621) + lu(k,622) = lu(k,622) * lu(k,621) + lu(k,623) = lu(k,623) * lu(k,621) + lu(k,624) = lu(k,624) * lu(k,621) + lu(k,625) = lu(k,625) * lu(k,621) + lu(k,626) = lu(k,626) * lu(k,621) + lu(k,627) = lu(k,627) * lu(k,621) + lu(k,628) = lu(k,628) * lu(k,621) + lu(k,1368) = lu(k,1368) - lu(k,622) * lu(k,1352) + lu(k,1379) = lu(k,1379) - lu(k,623) * lu(k,1352) + lu(k,1390) = lu(k,1390) - lu(k,624) * lu(k,1352) + lu(k,1393) = lu(k,1393) - lu(k,625) * lu(k,1352) + lu(k,1394) = lu(k,1394) - lu(k,626) * lu(k,1352) + lu(k,1397) = lu(k,1397) - lu(k,627) * lu(k,1352) + lu(k,1402) = lu(k,1402) - lu(k,628) * lu(k,1352) + lu(k,1595) = lu(k,1595) - lu(k,622) * lu(k,1570) + lu(k,1606) = lu(k,1606) - lu(k,623) * lu(k,1570) + lu(k,1618) = lu(k,1618) - lu(k,624) * lu(k,1570) + lu(k,1621) = lu(k,1621) - lu(k,625) * lu(k,1570) + lu(k,1622) = lu(k,1622) - lu(k,626) * lu(k,1570) + lu(k,1625) = lu(k,1625) - lu(k,627) * lu(k,1570) + lu(k,1630) = lu(k,1630) - lu(k,628) * lu(k,1570) + lu(k,1759) = lu(k,1759) - lu(k,622) * lu(k,1753) + lu(k,1761) = - lu(k,623) * lu(k,1753) + lu(k,1769) = lu(k,1769) - lu(k,624) * lu(k,1753) + lu(k,1772) = lu(k,1772) - lu(k,625) * lu(k,1753) + lu(k,1773) = lu(k,1773) - lu(k,626) * lu(k,1753) + lu(k,1776) = lu(k,1776) - lu(k,627) * lu(k,1753) + lu(k,1781) = lu(k,1781) - lu(k,628) * lu(k,1753) + lu(k,1963) = lu(k,1963) - lu(k,622) * lu(k,1948) + lu(k,1973) = lu(k,1973) - lu(k,623) * lu(k,1948) + lu(k,1984) = lu(k,1984) - lu(k,624) * lu(k,1948) + lu(k,1987) = lu(k,1987) - lu(k,625) * lu(k,1948) + lu(k,1988) = lu(k,1988) - lu(k,626) * lu(k,1948) + lu(k,1991) = lu(k,1991) - lu(k,627) * lu(k,1948) + lu(k,1996) = lu(k,1996) - lu(k,628) * lu(k,1948) + lu(k,630) = 1._r8 / lu(k,630) + lu(k,631) = lu(k,631) * lu(k,630) + lu(k,632) = lu(k,632) * lu(k,630) + lu(k,633) = lu(k,633) * lu(k,630) + lu(k,634) = lu(k,634) * lu(k,630) + lu(k,635) = lu(k,635) * lu(k,630) + lu(k,636) = lu(k,636) * lu(k,630) + lu(k,637) = lu(k,637) * lu(k,630) + lu(k,638) = lu(k,638) * lu(k,630) + lu(k,843) = - lu(k,631) * lu(k,838) + lu(k,844) = lu(k,844) - lu(k,632) * lu(k,838) + lu(k,847) = lu(k,847) - lu(k,633) * lu(k,838) + lu(k,849) = lu(k,849) - lu(k,634) * lu(k,838) + lu(k,851) = - lu(k,635) * lu(k,838) + lu(k,853) = lu(k,853) - lu(k,636) * lu(k,838) + lu(k,854) = - lu(k,637) * lu(k,838) + lu(k,855) = lu(k,855) - lu(k,638) * lu(k,838) + lu(k,1369) = lu(k,1369) - lu(k,631) * lu(k,1353) + lu(k,1374) = lu(k,1374) - lu(k,632) * lu(k,1353) + lu(k,1390) = lu(k,1390) - lu(k,633) * lu(k,1353) + lu(k,1393) = lu(k,1393) - lu(k,634) * lu(k,1353) + lu(k,1397) = lu(k,1397) - lu(k,635) * lu(k,1353) + lu(k,1401) = lu(k,1401) - lu(k,636) * lu(k,1353) + lu(k,1402) = lu(k,1402) - lu(k,637) * lu(k,1353) + lu(k,1403) = lu(k,1403) - lu(k,638) * lu(k,1353) + lu(k,1596) = lu(k,1596) - lu(k,631) * lu(k,1571) + lu(k,1601) = lu(k,1601) - lu(k,632) * lu(k,1571) + lu(k,1618) = lu(k,1618) - lu(k,633) * lu(k,1571) + lu(k,1621) = lu(k,1621) - lu(k,634) * lu(k,1571) + lu(k,1625) = lu(k,1625) - lu(k,635) * lu(k,1571) + lu(k,1629) = lu(k,1629) - lu(k,636) * lu(k,1571) + lu(k,1630) = lu(k,1630) - lu(k,637) * lu(k,1571) + lu(k,1631) = lu(k,1631) - lu(k,638) * lu(k,1571) + lu(k,1964) = lu(k,1964) - lu(k,631) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,632) * lu(k,1949) + lu(k,1984) = lu(k,1984) - lu(k,633) * lu(k,1949) + lu(k,1987) = lu(k,1987) - lu(k,634) * lu(k,1949) + lu(k,1991) = lu(k,1991) - lu(k,635) * lu(k,1949) + lu(k,1995) = lu(k,1995) - lu(k,636) * lu(k,1949) + lu(k,1996) = lu(k,1996) - lu(k,637) * lu(k,1949) + lu(k,1997) = - lu(k,638) * lu(k,1949) + lu(k,640) = 1._r8 / lu(k,640) + lu(k,641) = lu(k,641) * lu(k,640) + lu(k,642) = lu(k,642) * lu(k,640) + lu(k,643) = lu(k,643) * lu(k,640) + lu(k,644) = lu(k,644) * lu(k,640) + lu(k,645) = lu(k,645) * lu(k,640) + lu(k,646) = lu(k,646) * lu(k,640) + lu(k,647) = lu(k,647) * lu(k,640) + lu(k,1293) = lu(k,1293) - lu(k,641) * lu(k,1290) + lu(k,1296) = lu(k,1296) - lu(k,642) * lu(k,1290) + lu(k,1300) = lu(k,1300) - lu(k,643) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,644) * lu(k,1290) + lu(k,1306) = - lu(k,645) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,646) * lu(k,1290) + lu(k,1309) = lu(k,1309) - lu(k,647) * lu(k,1290) + lu(k,1386) = lu(k,1386) - lu(k,641) * lu(k,1354) + lu(k,1389) = lu(k,1389) - lu(k,642) * lu(k,1354) + lu(k,1393) = lu(k,1393) - lu(k,643) * lu(k,1354) + lu(k,1396) = lu(k,1396) - lu(k,644) * lu(k,1354) + lu(k,1399) = lu(k,1399) - lu(k,645) * lu(k,1354) + lu(k,1400) = lu(k,1400) - lu(k,646) * lu(k,1354) + lu(k,1403) = lu(k,1403) - lu(k,647) * lu(k,1354) + lu(k,1765) = lu(k,1765) - lu(k,641) * lu(k,1754) + lu(k,1768) = - lu(k,642) * lu(k,1754) + lu(k,1772) = lu(k,1772) - lu(k,643) * lu(k,1754) + lu(k,1775) = - lu(k,644) * lu(k,1754) + lu(k,1778) = lu(k,1778) - lu(k,645) * lu(k,1754) + lu(k,1779) = lu(k,1779) - lu(k,646) * lu(k,1754) + lu(k,1782) = lu(k,1782) - lu(k,647) * lu(k,1754) + lu(k,1849) = lu(k,1849) - lu(k,641) * lu(k,1846) + lu(k,1852) = - lu(k,642) * lu(k,1846) + lu(k,1856) = lu(k,1856) - lu(k,643) * lu(k,1846) + lu(k,1859) = lu(k,1859) - lu(k,644) * lu(k,1846) + lu(k,1862) = lu(k,1862) - lu(k,645) * lu(k,1846) + lu(k,1863) = lu(k,1863) - lu(k,646) * lu(k,1846) + lu(k,1866) = - lu(k,647) * lu(k,1846) + lu(k,1879) = lu(k,1879) - lu(k,641) * lu(k,1871) + lu(k,1882) = lu(k,1882) - lu(k,642) * lu(k,1871) + lu(k,1886) = lu(k,1886) - lu(k,643) * lu(k,1871) + lu(k,1889) = lu(k,1889) - lu(k,644) * lu(k,1871) + lu(k,1892) = lu(k,1892) - lu(k,645) * lu(k,1871) + lu(k,1893) = lu(k,1893) - lu(k,646) * lu(k,1871) + lu(k,1896) = lu(k,1896) - lu(k,647) * lu(k,1871) + end do + end subroutine lu_fac14 + subroutine lu_fac15( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,649) = 1._r8 / lu(k,649) + lu(k,650) = lu(k,650) * lu(k,649) + lu(k,651) = lu(k,651) * lu(k,649) + lu(k,652) = lu(k,652) * lu(k,649) + lu(k,653) = lu(k,653) * lu(k,649) + lu(k,654) = lu(k,654) * lu(k,649) + lu(k,655) = lu(k,655) * lu(k,649) + lu(k,656) = lu(k,656) * lu(k,649) + lu(k,1007) = lu(k,1007) - lu(k,650) * lu(k,1006) + lu(k,1008) = - lu(k,651) * lu(k,1006) + lu(k,1009) = lu(k,1009) - lu(k,652) * lu(k,1006) + lu(k,1011) = - lu(k,653) * lu(k,1006) + lu(k,1013) = lu(k,1013) - lu(k,654) * lu(k,1006) + lu(k,1014) = - lu(k,655) * lu(k,1006) + lu(k,1017) = lu(k,1017) - lu(k,656) * lu(k,1006) + lu(k,1262) = - lu(k,650) * lu(k,1261) + lu(k,1263) = lu(k,1263) - lu(k,651) * lu(k,1261) + lu(k,1264) = lu(k,1264) - lu(k,652) * lu(k,1261) + lu(k,1266) = lu(k,1266) - lu(k,653) * lu(k,1261) + lu(k,1268) = lu(k,1268) - lu(k,654) * lu(k,1261) + lu(k,1269) = - lu(k,655) * lu(k,1261) + lu(k,1273) = lu(k,1273) - lu(k,656) * lu(k,1261) + lu(k,1466) = lu(k,1466) - lu(k,650) * lu(k,1464) + lu(k,1468) = - lu(k,651) * lu(k,1464) + lu(k,1469) = lu(k,1469) - lu(k,652) * lu(k,1464) + lu(k,1472) = - lu(k,653) * lu(k,1464) + lu(k,1474) = lu(k,1474) - lu(k,654) * lu(k,1464) + lu(k,1475) = lu(k,1475) - lu(k,655) * lu(k,1464) + lu(k,1484) = lu(k,1484) - lu(k,656) * lu(k,1464) + lu(k,1602) = lu(k,1602) - lu(k,650) * lu(k,1572) + lu(k,1615) = lu(k,1615) - lu(k,651) * lu(k,1572) + lu(k,1616) = lu(k,1616) - lu(k,652) * lu(k,1572) + lu(k,1619) = lu(k,1619) - lu(k,653) * lu(k,1572) + lu(k,1621) = lu(k,1621) - lu(k,654) * lu(k,1572) + lu(k,1622) = lu(k,1622) - lu(k,655) * lu(k,1572) + lu(k,1631) = lu(k,1631) - lu(k,656) * lu(k,1572) + lu(k,2003) = lu(k,2003) - lu(k,650) * lu(k,2001) + lu(k,2006) = - lu(k,651) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,652) * lu(k,2001) + lu(k,2010) = - lu(k,653) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,654) * lu(k,2001) + lu(k,2013) = - lu(k,655) * lu(k,2001) + lu(k,2022) = lu(k,2022) - lu(k,656) * lu(k,2001) + lu(k,657) = 1._r8 / lu(k,657) + lu(k,658) = lu(k,658) * lu(k,657) + lu(k,659) = lu(k,659) * lu(k,657) + lu(k,660) = lu(k,660) * lu(k,657) + lu(k,718) = lu(k,718) - lu(k,658) * lu(k,708) + lu(k,720) = lu(k,720) - lu(k,659) * lu(k,708) + lu(k,724) = - lu(k,660) * lu(k,708) + lu(k,772) = lu(k,772) - lu(k,658) * lu(k,759) + lu(k,774) = lu(k,774) - lu(k,659) * lu(k,759) + lu(k,777) = - lu(k,660) * lu(k,759) + lu(k,798) = lu(k,798) - lu(k,658) * lu(k,785) + lu(k,800) = lu(k,800) - lu(k,659) * lu(k,785) + lu(k,803) = - lu(k,660) * lu(k,785) + lu(k,847) = lu(k,847) - lu(k,658) * lu(k,839) + lu(k,849) = lu(k,849) - lu(k,659) * lu(k,839) + lu(k,855) = lu(k,855) - lu(k,660) * lu(k,839) + lu(k,1066) = lu(k,1066) - lu(k,658) * lu(k,1058) + lu(k,1067) = lu(k,1067) - lu(k,659) * lu(k,1058) + lu(k,1070) = lu(k,1070) - lu(k,660) * lu(k,1058) + lu(k,1135) = lu(k,1135) - lu(k,658) * lu(k,1124) + lu(k,1137) = lu(k,1137) - lu(k,659) * lu(k,1124) + lu(k,1143) = - lu(k,660) * lu(k,1124) + lu(k,1390) = lu(k,1390) - lu(k,658) * lu(k,1355) + lu(k,1393) = lu(k,1393) - lu(k,659) * lu(k,1355) + lu(k,1403) = lu(k,1403) - lu(k,660) * lu(k,1355) + lu(k,1618) = lu(k,1618) - lu(k,658) * lu(k,1573) + lu(k,1621) = lu(k,1621) - lu(k,659) * lu(k,1573) + lu(k,1631) = lu(k,1631) - lu(k,660) * lu(k,1573) + lu(k,1728) = lu(k,1728) - lu(k,658) * lu(k,1714) + lu(k,1731) = lu(k,1731) - lu(k,659) * lu(k,1714) + lu(k,1741) = lu(k,1741) - lu(k,660) * lu(k,1714) + lu(k,1829) = lu(k,1829) - lu(k,658) * lu(k,1796) + lu(k,1832) = lu(k,1832) - lu(k,659) * lu(k,1796) + lu(k,1842) = lu(k,1842) - lu(k,660) * lu(k,1796) + lu(k,1906) = lu(k,1906) - lu(k,658) * lu(k,1898) + lu(k,1909) = lu(k,1909) - lu(k,659) * lu(k,1898) + lu(k,1919) = lu(k,1919) - lu(k,660) * lu(k,1898) + lu(k,1984) = lu(k,1984) - lu(k,658) * lu(k,1950) + lu(k,1987) = lu(k,1987) - lu(k,659) * lu(k,1950) + lu(k,1997) = lu(k,1997) - lu(k,660) * lu(k,1950) + lu(k,661) = 1._r8 / lu(k,661) + lu(k,662) = lu(k,662) * lu(k,661) + lu(k,663) = lu(k,663) * lu(k,661) + lu(k,664) = lu(k,664) * lu(k,661) + lu(k,689) = lu(k,689) - lu(k,662) * lu(k,686) + lu(k,690) = lu(k,690) - lu(k,663) * lu(k,686) + lu(k,693) = lu(k,693) - lu(k,664) * lu(k,686) + lu(k,935) = lu(k,935) - lu(k,662) * lu(k,923) + lu(k,937) = lu(k,937) - lu(k,663) * lu(k,923) + lu(k,940) = lu(k,940) - lu(k,664) * lu(k,923) + lu(k,955) = lu(k,955) - lu(k,662) * lu(k,945) + lu(k,956) = lu(k,956) - lu(k,663) * lu(k,945) + lu(k,959) = lu(k,959) - lu(k,664) * lu(k,945) + lu(k,974) = lu(k,974) - lu(k,662) * lu(k,964) + lu(k,976) = lu(k,976) - lu(k,663) * lu(k,964) + lu(k,979) = lu(k,979) - lu(k,664) * lu(k,964) + lu(k,988) = lu(k,988) - lu(k,662) * lu(k,983) + lu(k,989) = lu(k,989) - lu(k,663) * lu(k,983) + lu(k,992) = lu(k,992) - lu(k,664) * lu(k,983) + lu(k,1028) = lu(k,1028) - lu(k,662) * lu(k,1019) + lu(k,1030) = lu(k,1030) - lu(k,663) * lu(k,1019) + lu(k,1033) = lu(k,1033) - lu(k,664) * lu(k,1019) + lu(k,1051) = lu(k,1051) - lu(k,662) * lu(k,1038) + lu(k,1053) = lu(k,1053) - lu(k,663) * lu(k,1038) + lu(k,1056) = lu(k,1056) - lu(k,664) * lu(k,1038) + lu(k,1115) = lu(k,1115) - lu(k,662) * lu(k,1098) + lu(k,1117) = lu(k,1117) - lu(k,663) * lu(k,1098) + lu(k,1121) = lu(k,1121) - lu(k,664) * lu(k,1098) + lu(k,1158) = lu(k,1158) - lu(k,662) * lu(k,1145) + lu(k,1160) = lu(k,1160) - lu(k,663) * lu(k,1145) + lu(k,1163) = lu(k,1163) - lu(k,664) * lu(k,1145) + lu(k,1191) = lu(k,1191) - lu(k,662) * lu(k,1171) + lu(k,1193) = lu(k,1193) - lu(k,663) * lu(k,1171) + lu(k,1197) = lu(k,1197) - lu(k,664) * lu(k,1171) + lu(k,1618) = lu(k,1618) - lu(k,662) * lu(k,1574) + lu(k,1621) = lu(k,1621) - lu(k,663) * lu(k,1574) + lu(k,1629) = lu(k,1629) - lu(k,664) * lu(k,1574) + lu(k,1668) = lu(k,1668) - lu(k,662) * lu(k,1638) + lu(k,1671) = lu(k,1671) - lu(k,663) * lu(k,1638) + lu(k,1679) = lu(k,1679) - lu(k,664) * lu(k,1638) + lu(k,666) = 1._r8 / lu(k,666) + lu(k,667) = lu(k,667) * lu(k,666) + lu(k,668) = lu(k,668) * lu(k,666) + lu(k,669) = lu(k,669) * lu(k,666) + lu(k,670) = lu(k,670) * lu(k,666) + lu(k,671) = lu(k,671) * lu(k,666) + lu(k,672) = lu(k,672) * lu(k,666) + lu(k,673) = lu(k,673) * lu(k,666) + lu(k,674) = lu(k,674) * lu(k,666) + lu(k,675) = lu(k,675) * lu(k,666) + lu(k,1364) = lu(k,1364) - lu(k,667) * lu(k,1356) + lu(k,1374) = lu(k,1374) - lu(k,668) * lu(k,1356) + lu(k,1390) = lu(k,1390) - lu(k,669) * lu(k,1356) + lu(k,1393) = lu(k,1393) - lu(k,670) * lu(k,1356) + lu(k,1394) = lu(k,1394) - lu(k,671) * lu(k,1356) + lu(k,1397) = lu(k,1397) - lu(k,672) * lu(k,1356) + lu(k,1401) = lu(k,1401) - lu(k,673) * lu(k,1356) + lu(k,1402) = lu(k,1402) - lu(k,674) * lu(k,1356) + lu(k,1403) = lu(k,1403) - lu(k,675) * lu(k,1356) + lu(k,1587) = lu(k,1587) - lu(k,667) * lu(k,1575) + lu(k,1601) = lu(k,1601) - lu(k,668) * lu(k,1575) + lu(k,1618) = lu(k,1618) - lu(k,669) * lu(k,1575) + lu(k,1621) = lu(k,1621) - lu(k,670) * lu(k,1575) + lu(k,1622) = lu(k,1622) - lu(k,671) * lu(k,1575) + lu(k,1625) = lu(k,1625) - lu(k,672) * lu(k,1575) + lu(k,1629) = lu(k,1629) - lu(k,673) * lu(k,1575) + lu(k,1630) = lu(k,1630) - lu(k,674) * lu(k,1575) + lu(k,1631) = lu(k,1631) - lu(k,675) * lu(k,1575) + lu(k,1643) = lu(k,1643) - lu(k,667) * lu(k,1639) + lu(k,1654) = lu(k,1654) - lu(k,668) * lu(k,1639) + lu(k,1668) = lu(k,1668) - lu(k,669) * lu(k,1639) + lu(k,1671) = lu(k,1671) - lu(k,670) * lu(k,1639) + lu(k,1672) = lu(k,1672) - lu(k,671) * lu(k,1639) + lu(k,1675) = lu(k,1675) - lu(k,672) * lu(k,1639) + lu(k,1679) = lu(k,1679) - lu(k,673) * lu(k,1639) + lu(k,1680) = lu(k,1680) - lu(k,674) * lu(k,1639) + lu(k,1681) = lu(k,1681) - lu(k,675) * lu(k,1639) + lu(k,1957) = lu(k,1957) - lu(k,667) * lu(k,1951) + lu(k,1969) = lu(k,1969) - lu(k,668) * lu(k,1951) + lu(k,1984) = lu(k,1984) - lu(k,669) * lu(k,1951) + lu(k,1987) = lu(k,1987) - lu(k,670) * lu(k,1951) + lu(k,1988) = lu(k,1988) - lu(k,671) * lu(k,1951) + lu(k,1991) = lu(k,1991) - lu(k,672) * lu(k,1951) + lu(k,1995) = lu(k,1995) - lu(k,673) * lu(k,1951) + lu(k,1996) = lu(k,1996) - lu(k,674) * lu(k,1951) + lu(k,1997) = lu(k,1997) - lu(k,675) * lu(k,1951) + lu(k,677) = 1._r8 / lu(k,677) + lu(k,678) = lu(k,678) * lu(k,677) + lu(k,679) = lu(k,679) * lu(k,677) + lu(k,680) = lu(k,680) * lu(k,677) + lu(k,681) = lu(k,681) * lu(k,677) + lu(k,682) = lu(k,682) * lu(k,677) + lu(k,683) = lu(k,683) * lu(k,677) + lu(k,829) = lu(k,829) - lu(k,678) * lu(k,826) + lu(k,831) = lu(k,831) - lu(k,679) * lu(k,826) + lu(k,832) = lu(k,832) - lu(k,680) * lu(k,826) + lu(k,833) = lu(k,833) - lu(k,681) * lu(k,826) + lu(k,835) = lu(k,835) - lu(k,682) * lu(k,826) + lu(k,836) = - lu(k,683) * lu(k,826) + lu(k,1296) = lu(k,1296) - lu(k,678) * lu(k,1291) + lu(k,1300) = lu(k,1300) - lu(k,679) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,680) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,681) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,682) * lu(k,1291) + lu(k,1309) = lu(k,1309) - lu(k,683) * lu(k,1291) + lu(k,1389) = lu(k,1389) - lu(k,678) * lu(k,1357) + lu(k,1393) = lu(k,1393) - lu(k,679) * lu(k,1357) + lu(k,1395) = lu(k,1395) - lu(k,680) * lu(k,1357) + lu(k,1396) = lu(k,1396) - lu(k,681) * lu(k,1357) + lu(k,1400) = lu(k,1400) - lu(k,682) * lu(k,1357) + lu(k,1403) = lu(k,1403) - lu(k,683) * lu(k,1357) + lu(k,1617) = lu(k,1617) - lu(k,678) * lu(k,1576) + lu(k,1621) = lu(k,1621) - lu(k,679) * lu(k,1576) + lu(k,1623) = lu(k,1623) - lu(k,680) * lu(k,1576) + lu(k,1624) = lu(k,1624) - lu(k,681) * lu(k,1576) + lu(k,1628) = lu(k,1628) - lu(k,682) * lu(k,1576) + lu(k,1631) = lu(k,1631) - lu(k,683) * lu(k,1576) + lu(k,1693) = lu(k,1693) - lu(k,678) * lu(k,1686) + lu(k,1697) = lu(k,1697) - lu(k,679) * lu(k,1686) + lu(k,1699) = lu(k,1699) - lu(k,680) * lu(k,1686) + lu(k,1700) = lu(k,1700) - lu(k,681) * lu(k,1686) + lu(k,1704) = lu(k,1704) - lu(k,682) * lu(k,1686) + lu(k,1707) = - lu(k,683) * lu(k,1686) + lu(k,1727) = lu(k,1727) - lu(k,678) * lu(k,1715) + lu(k,1731) = lu(k,1731) - lu(k,679) * lu(k,1715) + lu(k,1733) = lu(k,1733) - lu(k,680) * lu(k,1715) + lu(k,1734) = lu(k,1734) - lu(k,681) * lu(k,1715) + lu(k,1738) = lu(k,1738) - lu(k,682) * lu(k,1715) + lu(k,1741) = lu(k,1741) - lu(k,683) * lu(k,1715) + lu(k,1882) = lu(k,1882) - lu(k,678) * lu(k,1872) + lu(k,1886) = lu(k,1886) - lu(k,679) * lu(k,1872) + lu(k,1888) = lu(k,1888) - lu(k,680) * lu(k,1872) + lu(k,1889) = lu(k,1889) - lu(k,681) * lu(k,1872) + lu(k,1893) = lu(k,1893) - lu(k,682) * lu(k,1872) + lu(k,1896) = lu(k,1896) - lu(k,683) * lu(k,1872) + lu(k,687) = 1._r8 / lu(k,687) + lu(k,688) = lu(k,688) * lu(k,687) + lu(k,689) = lu(k,689) * lu(k,687) + lu(k,690) = lu(k,690) * lu(k,687) + lu(k,691) = lu(k,691) * lu(k,687) + lu(k,692) = lu(k,692) * lu(k,687) + lu(k,693) = lu(k,693) * lu(k,687) + lu(k,694) = lu(k,694) * lu(k,687) + lu(k,811) = lu(k,811) - lu(k,688) * lu(k,808) + lu(k,813) = lu(k,813) - lu(k,689) * lu(k,808) + lu(k,814) = lu(k,814) - lu(k,690) * lu(k,808) + lu(k,815) = - lu(k,691) * lu(k,808) + lu(k,816) = lu(k,816) - lu(k,692) * lu(k,808) + lu(k,817) = lu(k,817) - lu(k,693) * lu(k,808) + lu(k,818) = lu(k,818) - lu(k,694) * lu(k,808) + lu(k,1374) = lu(k,1374) - lu(k,688) * lu(k,1358) + lu(k,1390) = lu(k,1390) - lu(k,689) * lu(k,1358) + lu(k,1393) = lu(k,1393) - lu(k,690) * lu(k,1358) + lu(k,1394) = lu(k,1394) - lu(k,691) * lu(k,1358) + lu(k,1397) = lu(k,1397) - lu(k,692) * lu(k,1358) + lu(k,1401) = lu(k,1401) - lu(k,693) * lu(k,1358) + lu(k,1402) = lu(k,1402) - lu(k,694) * lu(k,1358) + lu(k,1601) = lu(k,1601) - lu(k,688) * lu(k,1577) + lu(k,1618) = lu(k,1618) - lu(k,689) * lu(k,1577) + lu(k,1621) = lu(k,1621) - lu(k,690) * lu(k,1577) + lu(k,1622) = lu(k,1622) - lu(k,691) * lu(k,1577) + lu(k,1625) = lu(k,1625) - lu(k,692) * lu(k,1577) + lu(k,1629) = lu(k,1629) - lu(k,693) * lu(k,1577) + lu(k,1630) = lu(k,1630) - lu(k,694) * lu(k,1577) + lu(k,1654) = lu(k,1654) - lu(k,688) * lu(k,1640) + lu(k,1668) = lu(k,1668) - lu(k,689) * lu(k,1640) + lu(k,1671) = lu(k,1671) - lu(k,690) * lu(k,1640) + lu(k,1672) = lu(k,1672) - lu(k,691) * lu(k,1640) + lu(k,1675) = lu(k,1675) - lu(k,692) * lu(k,1640) + lu(k,1679) = lu(k,1679) - lu(k,693) * lu(k,1640) + lu(k,1680) = lu(k,1680) - lu(k,694) * lu(k,1640) + lu(k,1721) = - lu(k,688) * lu(k,1716) + lu(k,1728) = lu(k,1728) - lu(k,689) * lu(k,1716) + lu(k,1731) = lu(k,1731) - lu(k,690) * lu(k,1716) + lu(k,1732) = lu(k,1732) - lu(k,691) * lu(k,1716) + lu(k,1735) = lu(k,1735) - lu(k,692) * lu(k,1716) + lu(k,1739) = lu(k,1739) - lu(k,693) * lu(k,1716) + lu(k,1740) = lu(k,1740) - lu(k,694) * lu(k,1716) + lu(k,1969) = lu(k,1969) - lu(k,688) * lu(k,1952) + lu(k,1984) = lu(k,1984) - lu(k,689) * lu(k,1952) + lu(k,1987) = lu(k,1987) - lu(k,690) * lu(k,1952) + lu(k,1988) = lu(k,1988) - lu(k,691) * lu(k,1952) + lu(k,1991) = lu(k,1991) - lu(k,692) * lu(k,1952) + lu(k,1995) = lu(k,1995) - lu(k,693) * lu(k,1952) + lu(k,1996) = lu(k,1996) - lu(k,694) * lu(k,1952) + end do + end subroutine lu_fac15 + subroutine lu_fac16( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,695) = 1._r8 / lu(k,695) + lu(k,696) = lu(k,696) * lu(k,695) + lu(k,697) = lu(k,697) * lu(k,695) + lu(k,698) = lu(k,698) * lu(k,695) + lu(k,699) = lu(k,699) * lu(k,695) + lu(k,700) = lu(k,700) * lu(k,695) + lu(k,701) = lu(k,701) * lu(k,695) + lu(k,702) = lu(k,702) * lu(k,695) + lu(k,1250) = lu(k,1250) - lu(k,696) * lu(k,1248) + lu(k,1251) = - lu(k,697) * lu(k,1248) + lu(k,1253) = - lu(k,698) * lu(k,1248) + lu(k,1254) = - lu(k,699) * lu(k,1248) + lu(k,1256) = lu(k,1256) - lu(k,700) * lu(k,1248) + lu(k,1257) = - lu(k,701) * lu(k,1248) + lu(k,1259) = - lu(k,702) * lu(k,1248) + lu(k,1386) = lu(k,1386) - lu(k,696) * lu(k,1359) + lu(k,1388) = lu(k,1388) - lu(k,697) * lu(k,1359) + lu(k,1392) = - lu(k,698) * lu(k,1359) + lu(k,1393) = lu(k,1393) - lu(k,699) * lu(k,1359) + lu(k,1399) = lu(k,1399) - lu(k,700) * lu(k,1359) + lu(k,1400) = lu(k,1400) - lu(k,701) * lu(k,1359) + lu(k,1403) = lu(k,1403) - lu(k,702) * lu(k,1359) + lu(k,1467) = lu(k,1467) - lu(k,696) * lu(k,1465) + lu(k,1469) = lu(k,1469) - lu(k,697) * lu(k,1465) + lu(k,1473) = lu(k,1473) - lu(k,698) * lu(k,1465) + lu(k,1474) = lu(k,1474) - lu(k,699) * lu(k,1465) + lu(k,1480) = lu(k,1480) - lu(k,700) * lu(k,1465) + lu(k,1481) = lu(k,1481) - lu(k,701) * lu(k,1465) + lu(k,1484) = lu(k,1484) - lu(k,702) * lu(k,1465) + lu(k,1614) = lu(k,1614) - lu(k,696) * lu(k,1578) + lu(k,1616) = lu(k,1616) - lu(k,697) * lu(k,1578) + lu(k,1620) = lu(k,1620) - lu(k,698) * lu(k,1578) + lu(k,1621) = lu(k,1621) - lu(k,699) * lu(k,1578) + lu(k,1627) = lu(k,1627) - lu(k,700) * lu(k,1578) + lu(k,1628) = lu(k,1628) - lu(k,701) * lu(k,1578) + lu(k,1631) = lu(k,1631) - lu(k,702) * lu(k,1578) + lu(k,1879) = lu(k,1879) - lu(k,696) * lu(k,1873) + lu(k,1881) = lu(k,1881) - lu(k,697) * lu(k,1873) + lu(k,1885) = - lu(k,698) * lu(k,1873) + lu(k,1886) = lu(k,1886) - lu(k,699) * lu(k,1873) + lu(k,1892) = lu(k,1892) - lu(k,700) * lu(k,1873) + lu(k,1893) = lu(k,1893) - lu(k,701) * lu(k,1873) + lu(k,1896) = lu(k,1896) - lu(k,702) * lu(k,1873) + lu(k,1902) = lu(k,1902) - lu(k,696) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,697) * lu(k,1899) + lu(k,1908) = - lu(k,698) * lu(k,1899) + lu(k,1909) = lu(k,1909) - lu(k,699) * lu(k,1899) + lu(k,1915) = - lu(k,700) * lu(k,1899) + lu(k,1916) = lu(k,1916) - lu(k,701) * lu(k,1899) + lu(k,1919) = lu(k,1919) - lu(k,702) * lu(k,1899) + lu(k,709) = 1._r8 / lu(k,709) + lu(k,710) = lu(k,710) * lu(k,709) + lu(k,711) = lu(k,711) * lu(k,709) + lu(k,712) = lu(k,712) * lu(k,709) + lu(k,713) = lu(k,713) * lu(k,709) + lu(k,714) = lu(k,714) * lu(k,709) + lu(k,715) = lu(k,715) * lu(k,709) + lu(k,716) = lu(k,716) * lu(k,709) + lu(k,717) = lu(k,717) * lu(k,709) + lu(k,718) = lu(k,718) * lu(k,709) + lu(k,719) = lu(k,719) * lu(k,709) + lu(k,720) = lu(k,720) * lu(k,709) + lu(k,721) = lu(k,721) * lu(k,709) + lu(k,722) = lu(k,722) * lu(k,709) + lu(k,723) = lu(k,723) * lu(k,709) + lu(k,724) = lu(k,724) * lu(k,709) + lu(k,1419) = lu(k,1419) - lu(k,710) * lu(k,1411) + lu(k,1425) = lu(k,1425) - lu(k,711) * lu(k,1411) + lu(k,1433) = lu(k,1433) - lu(k,712) * lu(k,1411) + lu(k,1434) = lu(k,1434) - lu(k,713) * lu(k,1411) + lu(k,1437) = lu(k,1437) - lu(k,714) * lu(k,1411) + lu(k,1438) = lu(k,1438) - lu(k,715) * lu(k,1411) + lu(k,1440) = lu(k,1440) - lu(k,716) * lu(k,1411) + lu(k,1442) = lu(k,1442) - lu(k,717) * lu(k,1411) + lu(k,1447) = lu(k,1447) - lu(k,718) * lu(k,1411) + lu(k,1448) = lu(k,1448) - lu(k,719) * lu(k,1411) + lu(k,1450) = lu(k,1450) - lu(k,720) * lu(k,1411) + lu(k,1451) = - lu(k,721) * lu(k,1411) + lu(k,1455) = - lu(k,722) * lu(k,1411) + lu(k,1458) = lu(k,1458) - lu(k,723) * lu(k,1411) + lu(k,1460) = - lu(k,724) * lu(k,1411) + lu(k,1589) = lu(k,1589) - lu(k,710) * lu(k,1579) + lu(k,1595) = lu(k,1595) - lu(k,711) * lu(k,1579) + lu(k,1604) = - lu(k,712) * lu(k,1579) + lu(k,1605) = lu(k,1605) - lu(k,713) * lu(k,1579) + lu(k,1608) = lu(k,1608) - lu(k,714) * lu(k,1579) + lu(k,1609) = lu(k,1609) - lu(k,715) * lu(k,1579) + lu(k,1611) = lu(k,1611) - lu(k,716) * lu(k,1579) + lu(k,1613) = lu(k,1613) - lu(k,717) * lu(k,1579) + lu(k,1618) = lu(k,1618) - lu(k,718) * lu(k,1579) + lu(k,1619) = lu(k,1619) - lu(k,719) * lu(k,1579) + lu(k,1621) = lu(k,1621) - lu(k,720) * lu(k,1579) + lu(k,1622) = lu(k,1622) - lu(k,721) * lu(k,1579) + lu(k,1626) = lu(k,1626) - lu(k,722) * lu(k,1579) + lu(k,1629) = lu(k,1629) - lu(k,723) * lu(k,1579) + lu(k,1631) = lu(k,1631) - lu(k,724) * lu(k,1579) + lu(k,1804) = lu(k,1804) - lu(k,710) * lu(k,1797) + lu(k,1808) = lu(k,1808) - lu(k,711) * lu(k,1797) + lu(k,1815) = - lu(k,712) * lu(k,1797) + lu(k,1816) = lu(k,1816) - lu(k,713) * lu(k,1797) + lu(k,1819) = - lu(k,714) * lu(k,1797) + lu(k,1820) = lu(k,1820) - lu(k,715) * lu(k,1797) + lu(k,1822) = - lu(k,716) * lu(k,1797) + lu(k,1824) = lu(k,1824) - lu(k,717) * lu(k,1797) + lu(k,1829) = lu(k,1829) - lu(k,718) * lu(k,1797) + lu(k,1830) = lu(k,1830) - lu(k,719) * lu(k,1797) + lu(k,1832) = lu(k,1832) - lu(k,720) * lu(k,1797) + lu(k,1833) = lu(k,1833) - lu(k,721) * lu(k,1797) + lu(k,1837) = lu(k,1837) - lu(k,722) * lu(k,1797) + lu(k,1840) = lu(k,1840) - lu(k,723) * lu(k,1797) + lu(k,1842) = lu(k,1842) - lu(k,724) * lu(k,1797) + lu(k,726) = 1._r8 / lu(k,726) + lu(k,727) = lu(k,727) * lu(k,726) + lu(k,728) = lu(k,728) * lu(k,726) + lu(k,729) = lu(k,729) * lu(k,726) + lu(k,730) = lu(k,730) * lu(k,726) + lu(k,731) = lu(k,731) * lu(k,726) + lu(k,1083) = lu(k,1083) - lu(k,727) * lu(k,1082) + lu(k,1086) = - lu(k,728) * lu(k,1082) + lu(k,1087) = lu(k,1087) - lu(k,729) * lu(k,1082) + lu(k,1093) = lu(k,1093) - lu(k,730) * lu(k,1082) + lu(k,1095) = - lu(k,731) * lu(k,1082) + lu(k,1436) = - lu(k,727) * lu(k,1412) + lu(k,1447) = lu(k,1447) - lu(k,728) * lu(k,1412) + lu(k,1450) = lu(k,1450) - lu(k,729) * lu(k,1412) + lu(k,1457) = lu(k,1457) - lu(k,730) * lu(k,1412) + lu(k,1460) = lu(k,1460) - lu(k,731) * lu(k,1412) + lu(k,1607) = lu(k,1607) - lu(k,727) * lu(k,1580) + lu(k,1618) = lu(k,1618) - lu(k,728) * lu(k,1580) + lu(k,1621) = lu(k,1621) - lu(k,729) * lu(k,1580) + lu(k,1628) = lu(k,1628) - lu(k,730) * lu(k,1580) + lu(k,1631) = lu(k,1631) - lu(k,731) * lu(k,1580) + lu(k,1689) = lu(k,1689) - lu(k,727) * lu(k,1687) + lu(k,1694) = lu(k,1694) - lu(k,728) * lu(k,1687) + lu(k,1697) = lu(k,1697) - lu(k,729) * lu(k,1687) + lu(k,1704) = lu(k,1704) - lu(k,730) * lu(k,1687) + lu(k,1707) = lu(k,1707) - lu(k,731) * lu(k,1687) + lu(k,1762) = lu(k,1762) - lu(k,727) * lu(k,1755) + lu(k,1769) = lu(k,1769) - lu(k,728) * lu(k,1755) + lu(k,1772) = lu(k,1772) - lu(k,729) * lu(k,1755) + lu(k,1779) = lu(k,1779) - lu(k,730) * lu(k,1755) + lu(k,1782) = lu(k,1782) - lu(k,731) * lu(k,1755) + lu(k,1818) = lu(k,1818) - lu(k,727) * lu(k,1798) + lu(k,1829) = lu(k,1829) - lu(k,728) * lu(k,1798) + lu(k,1832) = lu(k,1832) - lu(k,729) * lu(k,1798) + lu(k,1839) = lu(k,1839) - lu(k,730) * lu(k,1798) + lu(k,1842) = lu(k,1842) - lu(k,731) * lu(k,1798) + lu(k,1848) = lu(k,1848) - lu(k,727) * lu(k,1847) + lu(k,1853) = lu(k,1853) - lu(k,728) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,729) * lu(k,1847) + lu(k,1863) = lu(k,1863) - lu(k,730) * lu(k,1847) + lu(k,1866) = lu(k,1866) - lu(k,731) * lu(k,1847) + lu(k,1878) = lu(k,1878) - lu(k,727) * lu(k,1874) + lu(k,1883) = lu(k,1883) - lu(k,728) * lu(k,1874) + lu(k,1886) = lu(k,1886) - lu(k,729) * lu(k,1874) + lu(k,1893) = lu(k,1893) - lu(k,730) * lu(k,1874) + lu(k,1896) = lu(k,1896) - lu(k,731) * lu(k,1874) + lu(k,2004) = - lu(k,727) * lu(k,2002) + lu(k,2009) = - lu(k,728) * lu(k,2002) + lu(k,2012) = lu(k,2012) - lu(k,729) * lu(k,2002) + lu(k,2019) = lu(k,2019) - lu(k,730) * lu(k,2002) + lu(k,2022) = lu(k,2022) - lu(k,731) * lu(k,2002) + end do + end subroutine lu_fac16 + subroutine lu_fac17( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,732) = 1._r8 / lu(k,732) + lu(k,733) = lu(k,733) * lu(k,732) + lu(k,734) = lu(k,734) * lu(k,732) + lu(k,735) = lu(k,735) * lu(k,732) + lu(k,736) = lu(k,736) * lu(k,732) + lu(k,737) = lu(k,737) * lu(k,732) + lu(k,845) = - lu(k,733) * lu(k,840) + lu(k,846) = - lu(k,734) * lu(k,840) + lu(k,849) = lu(k,849) - lu(k,735) * lu(k,840) + lu(k,851) = lu(k,851) - lu(k,736) * lu(k,840) + lu(k,853) = lu(k,853) - lu(k,737) * lu(k,840) + lu(k,876) = - lu(k,733) * lu(k,871) + lu(k,877) = - lu(k,734) * lu(k,871) + lu(k,880) = lu(k,880) - lu(k,735) * lu(k,871) + lu(k,882) = lu(k,882) - lu(k,736) * lu(k,871) + lu(k,883) = - lu(k,737) * lu(k,871) + lu(k,1046) = - lu(k,733) * lu(k,1039) + lu(k,1048) = lu(k,1048) - lu(k,734) * lu(k,1039) + lu(k,1053) = lu(k,1053) - lu(k,735) * lu(k,1039) + lu(k,1055) = lu(k,1055) - lu(k,736) * lu(k,1039) + lu(k,1056) = lu(k,1056) - lu(k,737) * lu(k,1039) + lu(k,1183) = lu(k,1183) - lu(k,733) * lu(k,1172) + lu(k,1188) = lu(k,1188) - lu(k,734) * lu(k,1172) + lu(k,1193) = lu(k,1193) - lu(k,735) * lu(k,1172) + lu(k,1195) = lu(k,1195) - lu(k,736) * lu(k,1172) + lu(k,1197) = lu(k,1197) - lu(k,737) * lu(k,1172) + lu(k,1379) = lu(k,1379) - lu(k,733) * lu(k,1360) + lu(k,1385) = lu(k,1385) - lu(k,734) * lu(k,1360) + lu(k,1393) = lu(k,1393) - lu(k,735) * lu(k,1360) + lu(k,1397) = lu(k,1397) - lu(k,736) * lu(k,1360) + lu(k,1401) = lu(k,1401) - lu(k,737) * lu(k,1360) + lu(k,1435) = lu(k,1435) - lu(k,733) * lu(k,1413) + lu(k,1442) = lu(k,1442) - lu(k,734) * lu(k,1413) + lu(k,1450) = lu(k,1450) - lu(k,735) * lu(k,1413) + lu(k,1454) = lu(k,1454) - lu(k,736) * lu(k,1413) + lu(k,1458) = lu(k,1458) - lu(k,737) * lu(k,1413) + lu(k,1606) = lu(k,1606) - lu(k,733) * lu(k,1581) + lu(k,1613) = lu(k,1613) - lu(k,734) * lu(k,1581) + lu(k,1621) = lu(k,1621) - lu(k,735) * lu(k,1581) + lu(k,1625) = lu(k,1625) - lu(k,736) * lu(k,1581) + lu(k,1629) = lu(k,1629) - lu(k,737) * lu(k,1581) + lu(k,1658) = lu(k,1658) - lu(k,733) * lu(k,1641) + lu(k,1664) = lu(k,1664) - lu(k,734) * lu(k,1641) + lu(k,1671) = lu(k,1671) - lu(k,735) * lu(k,1641) + lu(k,1675) = lu(k,1675) - lu(k,736) * lu(k,1641) + lu(k,1679) = lu(k,1679) - lu(k,737) * lu(k,1641) + lu(k,1973) = lu(k,1973) - lu(k,733) * lu(k,1953) + lu(k,1979) = lu(k,1979) - lu(k,734) * lu(k,1953) + lu(k,1987) = lu(k,1987) - lu(k,735) * lu(k,1953) + lu(k,1991) = lu(k,1991) - lu(k,736) * lu(k,1953) + lu(k,1995) = lu(k,1995) - lu(k,737) * lu(k,1953) + lu(k,739) = 1._r8 / lu(k,739) + lu(k,740) = lu(k,740) * lu(k,739) + lu(k,741) = lu(k,741) * lu(k,739) + lu(k,742) = lu(k,742) * lu(k,739) + lu(k,745) = lu(k,745) - lu(k,740) * lu(k,743) + lu(k,747) = lu(k,747) - lu(k,741) * lu(k,743) + lu(k,748) = lu(k,748) - lu(k,742) * lu(k,743) + lu(k,766) = lu(k,766) - lu(k,740) * lu(k,760) + lu(k,772) = lu(k,772) - lu(k,741) * lu(k,760) + lu(k,774) = lu(k,774) - lu(k,742) * lu(k,760) + lu(k,792) = lu(k,792) - lu(k,740) * lu(k,786) + lu(k,798) = lu(k,798) - lu(k,741) * lu(k,786) + lu(k,800) = lu(k,800) - lu(k,742) * lu(k,786) + lu(k,866) = lu(k,866) - lu(k,740) * lu(k,864) + lu(k,867) = lu(k,867) - lu(k,741) * lu(k,864) + lu(k,868) = lu(k,868) - lu(k,742) * lu(k,864) + lu(k,875) = lu(k,875) - lu(k,740) * lu(k,872) + lu(k,879) = lu(k,879) - lu(k,741) * lu(k,872) + lu(k,880) = lu(k,880) - lu(k,742) * lu(k,872) + lu(k,1022) = lu(k,1022) - lu(k,740) * lu(k,1020) + lu(k,1028) = lu(k,1028) - lu(k,741) * lu(k,1020) + lu(k,1030) = lu(k,1030) - lu(k,742) * lu(k,1020) + lu(k,1177) = lu(k,1177) - lu(k,740) * lu(k,1173) + lu(k,1191) = lu(k,1191) - lu(k,741) * lu(k,1173) + lu(k,1193) = lu(k,1193) - lu(k,742) * lu(k,1173) + lu(k,1225) = lu(k,1225) - lu(k,740) * lu(k,1222) + lu(k,1239) = lu(k,1239) - lu(k,741) * lu(k,1222) + lu(k,1241) = lu(k,1241) - lu(k,742) * lu(k,1222) + lu(k,1368) = lu(k,1368) - lu(k,740) * lu(k,1361) + lu(k,1390) = lu(k,1390) - lu(k,741) * lu(k,1361) + lu(k,1393) = lu(k,1393) - lu(k,742) * lu(k,1361) + lu(k,1425) = lu(k,1425) - lu(k,740) * lu(k,1414) + lu(k,1447) = lu(k,1447) - lu(k,741) * lu(k,1414) + lu(k,1450) = lu(k,1450) - lu(k,742) * lu(k,1414) + lu(k,1595) = lu(k,1595) - lu(k,740) * lu(k,1582) + lu(k,1618) = lu(k,1618) - lu(k,741) * lu(k,1582) + lu(k,1621) = lu(k,1621) - lu(k,742) * lu(k,1582) + lu(k,1648) = lu(k,1648) - lu(k,740) * lu(k,1642) + lu(k,1668) = lu(k,1668) - lu(k,741) * lu(k,1642) + lu(k,1671) = lu(k,1671) - lu(k,742) * lu(k,1642) + lu(k,1720) = lu(k,1720) - lu(k,740) * lu(k,1717) + lu(k,1728) = lu(k,1728) - lu(k,741) * lu(k,1717) + lu(k,1731) = lu(k,1731) - lu(k,742) * lu(k,1717) + lu(k,1759) = lu(k,1759) - lu(k,740) * lu(k,1756) + lu(k,1769) = lu(k,1769) - lu(k,741) * lu(k,1756) + lu(k,1772) = lu(k,1772) - lu(k,742) * lu(k,1756) + lu(k,1808) = lu(k,1808) - lu(k,740) * lu(k,1799) + lu(k,1829) = lu(k,1829) - lu(k,741) * lu(k,1799) + lu(k,1832) = lu(k,1832) - lu(k,742) * lu(k,1799) + lu(k,1963) = lu(k,1963) - lu(k,740) * lu(k,1954) + lu(k,1984) = lu(k,1984) - lu(k,741) * lu(k,1954) + lu(k,1987) = lu(k,1987) - lu(k,742) * lu(k,1954) + lu(k,744) = 1._r8 / lu(k,744) + lu(k,745) = lu(k,745) * lu(k,744) + lu(k,746) = lu(k,746) * lu(k,744) + lu(k,747) = lu(k,747) * lu(k,744) + lu(k,748) = lu(k,748) * lu(k,744) + lu(k,749) = lu(k,749) * lu(k,744) + lu(k,750) = lu(k,750) * lu(k,744) + lu(k,751) = lu(k,751) * lu(k,744) + lu(k,875) = lu(k,875) - lu(k,745) * lu(k,873) + lu(k,876) = lu(k,876) - lu(k,746) * lu(k,873) + lu(k,879) = lu(k,879) - lu(k,747) * lu(k,873) + lu(k,880) = lu(k,880) - lu(k,748) * lu(k,873) + lu(k,881) = - lu(k,749) * lu(k,873) + lu(k,882) = lu(k,882) - lu(k,750) * lu(k,873) + lu(k,884) = - lu(k,751) * lu(k,873) + lu(k,1177) = lu(k,1177) - lu(k,745) * lu(k,1174) + lu(k,1183) = lu(k,1183) - lu(k,746) * lu(k,1174) + lu(k,1191) = lu(k,1191) - lu(k,747) * lu(k,1174) + lu(k,1193) = lu(k,1193) - lu(k,748) * lu(k,1174) + lu(k,1194) = lu(k,1194) - lu(k,749) * lu(k,1174) + lu(k,1195) = lu(k,1195) - lu(k,750) * lu(k,1174) + lu(k,1198) = lu(k,1198) - lu(k,751) * lu(k,1174) + lu(k,1368) = lu(k,1368) - lu(k,745) * lu(k,1362) + lu(k,1379) = lu(k,1379) - lu(k,746) * lu(k,1362) + lu(k,1390) = lu(k,1390) - lu(k,747) * lu(k,1362) + lu(k,1393) = lu(k,1393) - lu(k,748) * lu(k,1362) + lu(k,1394) = lu(k,1394) - lu(k,749) * lu(k,1362) + lu(k,1397) = lu(k,1397) - lu(k,750) * lu(k,1362) + lu(k,1402) = lu(k,1402) - lu(k,751) * lu(k,1362) + lu(k,1595) = lu(k,1595) - lu(k,745) * lu(k,1583) + lu(k,1606) = lu(k,1606) - lu(k,746) * lu(k,1583) + lu(k,1618) = lu(k,1618) - lu(k,747) * lu(k,1583) + lu(k,1621) = lu(k,1621) - lu(k,748) * lu(k,1583) + lu(k,1622) = lu(k,1622) - lu(k,749) * lu(k,1583) + lu(k,1625) = lu(k,1625) - lu(k,750) * lu(k,1583) + lu(k,1630) = lu(k,1630) - lu(k,751) * lu(k,1583) + lu(k,1759) = lu(k,1759) - lu(k,745) * lu(k,1757) + lu(k,1761) = lu(k,1761) - lu(k,746) * lu(k,1757) + lu(k,1769) = lu(k,1769) - lu(k,747) * lu(k,1757) + lu(k,1772) = lu(k,1772) - lu(k,748) * lu(k,1757) + lu(k,1773) = lu(k,1773) - lu(k,749) * lu(k,1757) + lu(k,1776) = lu(k,1776) - lu(k,750) * lu(k,1757) + lu(k,1781) = lu(k,1781) - lu(k,751) * lu(k,1757) + lu(k,1963) = lu(k,1963) - lu(k,745) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,746) * lu(k,1955) + lu(k,1984) = lu(k,1984) - lu(k,747) * lu(k,1955) + lu(k,1987) = lu(k,1987) - lu(k,748) * lu(k,1955) + lu(k,1988) = lu(k,1988) - lu(k,749) * lu(k,1955) + lu(k,1991) = lu(k,1991) - lu(k,750) * lu(k,1955) + lu(k,1996) = lu(k,1996) - lu(k,751) * lu(k,1955) + lu(k,761) = 1._r8 / lu(k,761) + lu(k,762) = lu(k,762) * lu(k,761) + lu(k,763) = lu(k,763) * lu(k,761) + lu(k,764) = lu(k,764) * lu(k,761) + lu(k,765) = lu(k,765) * lu(k,761) + lu(k,766) = lu(k,766) * lu(k,761) + lu(k,767) = lu(k,767) * lu(k,761) + lu(k,768) = lu(k,768) * lu(k,761) + lu(k,769) = lu(k,769) * lu(k,761) + lu(k,770) = lu(k,770) * lu(k,761) + lu(k,771) = lu(k,771) * lu(k,761) + lu(k,772) = lu(k,772) * lu(k,761) + lu(k,773) = lu(k,773) * lu(k,761) + lu(k,774) = lu(k,774) * lu(k,761) + lu(k,775) = lu(k,775) * lu(k,761) + lu(k,776) = lu(k,776) * lu(k,761) + lu(k,777) = lu(k,777) * lu(k,761) + lu(k,1417) = - lu(k,762) * lu(k,1415) + lu(k,1418) = lu(k,1418) - lu(k,763) * lu(k,1415) + lu(k,1420) = lu(k,1420) - lu(k,764) * lu(k,1415) + lu(k,1423) = - lu(k,765) * lu(k,1415) + lu(k,1425) = lu(k,1425) - lu(k,766) * lu(k,1415) + lu(k,1427) = - lu(k,767) * lu(k,1415) + lu(k,1429) = lu(k,1429) - lu(k,768) * lu(k,1415) + lu(k,1430) = - lu(k,769) * lu(k,1415) + lu(k,1435) = lu(k,1435) - lu(k,770) * lu(k,1415) + lu(k,1442) = lu(k,1442) - lu(k,771) * lu(k,1415) + lu(k,1447) = lu(k,1447) - lu(k,772) * lu(k,1415) + lu(k,1448) = lu(k,1448) - lu(k,773) * lu(k,1415) + lu(k,1450) = lu(k,1450) - lu(k,774) * lu(k,1415) + lu(k,1455) = lu(k,1455) - lu(k,775) * lu(k,1415) + lu(k,1458) = lu(k,1458) - lu(k,776) * lu(k,1415) + lu(k,1460) = lu(k,1460) - lu(k,777) * lu(k,1415) + lu(k,1586) = lu(k,1586) - lu(k,762) * lu(k,1584) + lu(k,1587) = lu(k,1587) - lu(k,763) * lu(k,1584) + lu(k,1590) = lu(k,1590) - lu(k,764) * lu(k,1584) + lu(k,1593) = lu(k,1593) - lu(k,765) * lu(k,1584) + lu(k,1595) = lu(k,1595) - lu(k,766) * lu(k,1584) + lu(k,1597) = lu(k,1597) - lu(k,767) * lu(k,1584) + lu(k,1599) = lu(k,1599) - lu(k,768) * lu(k,1584) + lu(k,1600) = lu(k,1600) - lu(k,769) * lu(k,1584) + lu(k,1606) = lu(k,1606) - lu(k,770) * lu(k,1584) + lu(k,1613) = lu(k,1613) - lu(k,771) * lu(k,1584) + lu(k,1618) = lu(k,1618) - lu(k,772) * lu(k,1584) + lu(k,1619) = lu(k,1619) - lu(k,773) * lu(k,1584) + lu(k,1621) = lu(k,1621) - lu(k,774) * lu(k,1584) + lu(k,1626) = lu(k,1626) - lu(k,775) * lu(k,1584) + lu(k,1629) = lu(k,1629) - lu(k,776) * lu(k,1584) + lu(k,1631) = lu(k,1631) - lu(k,777) * lu(k,1584) + lu(k,1802) = lu(k,1802) - lu(k,762) * lu(k,1800) + lu(k,1803) = lu(k,1803) - lu(k,763) * lu(k,1800) + lu(k,1805) = lu(k,1805) - lu(k,764) * lu(k,1800) + lu(k,1807) = lu(k,1807) - lu(k,765) * lu(k,1800) + lu(k,1808) = lu(k,1808) - lu(k,766) * lu(k,1800) + lu(k,1810) = - lu(k,767) * lu(k,1800) + lu(k,1812) = - lu(k,768) * lu(k,1800) + lu(k,1813) = lu(k,1813) - lu(k,769) * lu(k,1800) + lu(k,1817) = lu(k,1817) - lu(k,770) * lu(k,1800) + lu(k,1824) = lu(k,1824) - lu(k,771) * lu(k,1800) + lu(k,1829) = lu(k,1829) - lu(k,772) * lu(k,1800) + lu(k,1830) = lu(k,1830) - lu(k,773) * lu(k,1800) + lu(k,1832) = lu(k,1832) - lu(k,774) * lu(k,1800) + lu(k,1837) = lu(k,1837) - lu(k,775) * lu(k,1800) + lu(k,1840) = lu(k,1840) - lu(k,776) * lu(k,1800) + lu(k,1842) = lu(k,1842) - lu(k,777) * lu(k,1800) + lu(k,787) = 1._r8 / lu(k,787) + lu(k,788) = lu(k,788) * lu(k,787) + lu(k,789) = lu(k,789) * lu(k,787) + lu(k,790) = lu(k,790) * lu(k,787) + lu(k,791) = lu(k,791) * lu(k,787) + lu(k,792) = lu(k,792) * lu(k,787) + lu(k,793) = lu(k,793) * lu(k,787) + lu(k,794) = lu(k,794) * lu(k,787) + lu(k,795) = lu(k,795) * lu(k,787) + lu(k,796) = lu(k,796) * lu(k,787) + lu(k,797) = lu(k,797) * lu(k,787) + lu(k,798) = lu(k,798) * lu(k,787) + lu(k,799) = lu(k,799) * lu(k,787) + lu(k,800) = lu(k,800) * lu(k,787) + lu(k,801) = lu(k,801) * lu(k,787) + lu(k,802) = lu(k,802) * lu(k,787) + lu(k,803) = lu(k,803) * lu(k,787) + lu(k,1417) = lu(k,1417) - lu(k,788) * lu(k,1416) + lu(k,1418) = lu(k,1418) - lu(k,789) * lu(k,1416) + lu(k,1420) = lu(k,1420) - lu(k,790) * lu(k,1416) + lu(k,1423) = lu(k,1423) - lu(k,791) * lu(k,1416) + lu(k,1425) = lu(k,1425) - lu(k,792) * lu(k,1416) + lu(k,1427) = lu(k,1427) - lu(k,793) * lu(k,1416) + lu(k,1429) = lu(k,1429) - lu(k,794) * lu(k,1416) + lu(k,1430) = lu(k,1430) - lu(k,795) * lu(k,1416) + lu(k,1435) = lu(k,1435) - lu(k,796) * lu(k,1416) + lu(k,1442) = lu(k,1442) - lu(k,797) * lu(k,1416) + lu(k,1447) = lu(k,1447) - lu(k,798) * lu(k,1416) + lu(k,1448) = lu(k,1448) - lu(k,799) * lu(k,1416) + lu(k,1450) = lu(k,1450) - lu(k,800) * lu(k,1416) + lu(k,1455) = lu(k,1455) - lu(k,801) * lu(k,1416) + lu(k,1458) = lu(k,1458) - lu(k,802) * lu(k,1416) + lu(k,1460) = lu(k,1460) - lu(k,803) * lu(k,1416) + lu(k,1586) = lu(k,1586) - lu(k,788) * lu(k,1585) + lu(k,1587) = lu(k,1587) - lu(k,789) * lu(k,1585) + lu(k,1590) = lu(k,1590) - lu(k,790) * lu(k,1585) + lu(k,1593) = lu(k,1593) - lu(k,791) * lu(k,1585) + lu(k,1595) = lu(k,1595) - lu(k,792) * lu(k,1585) + lu(k,1597) = lu(k,1597) - lu(k,793) * lu(k,1585) + lu(k,1599) = lu(k,1599) - lu(k,794) * lu(k,1585) + lu(k,1600) = lu(k,1600) - lu(k,795) * lu(k,1585) + lu(k,1606) = lu(k,1606) - lu(k,796) * lu(k,1585) + lu(k,1613) = lu(k,1613) - lu(k,797) * lu(k,1585) + lu(k,1618) = lu(k,1618) - lu(k,798) * lu(k,1585) + lu(k,1619) = lu(k,1619) - lu(k,799) * lu(k,1585) + lu(k,1621) = lu(k,1621) - lu(k,800) * lu(k,1585) + lu(k,1626) = lu(k,1626) - lu(k,801) * lu(k,1585) + lu(k,1629) = lu(k,1629) - lu(k,802) * lu(k,1585) + lu(k,1631) = lu(k,1631) - lu(k,803) * lu(k,1585) + lu(k,1802) = lu(k,1802) - lu(k,788) * lu(k,1801) + lu(k,1803) = lu(k,1803) - lu(k,789) * lu(k,1801) + lu(k,1805) = lu(k,1805) - lu(k,790) * lu(k,1801) + lu(k,1807) = lu(k,1807) - lu(k,791) * lu(k,1801) + lu(k,1808) = lu(k,1808) - lu(k,792) * lu(k,1801) + lu(k,1810) = lu(k,1810) - lu(k,793) * lu(k,1801) + lu(k,1812) = lu(k,1812) - lu(k,794) * lu(k,1801) + lu(k,1813) = lu(k,1813) - lu(k,795) * lu(k,1801) + lu(k,1817) = lu(k,1817) - lu(k,796) * lu(k,1801) + lu(k,1824) = lu(k,1824) - lu(k,797) * lu(k,1801) + lu(k,1829) = lu(k,1829) - lu(k,798) * lu(k,1801) + lu(k,1830) = lu(k,1830) - lu(k,799) * lu(k,1801) + lu(k,1832) = lu(k,1832) - lu(k,800) * lu(k,1801) + lu(k,1837) = lu(k,1837) - lu(k,801) * lu(k,1801) + lu(k,1840) = lu(k,1840) - lu(k,802) * lu(k,1801) + lu(k,1842) = lu(k,1842) - lu(k,803) * lu(k,1801) + end do + end subroutine lu_fac17 + subroutine lu_fac18( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,809) = 1._r8 / lu(k,809) + lu(k,810) = lu(k,810) * lu(k,809) + lu(k,811) = lu(k,811) * lu(k,809) + lu(k,812) = lu(k,812) * lu(k,809) + lu(k,813) = lu(k,813) * lu(k,809) + lu(k,814) = lu(k,814) * lu(k,809) + lu(k,815) = lu(k,815) * lu(k,809) + lu(k,816) = lu(k,816) * lu(k,809) + lu(k,817) = lu(k,817) * lu(k,809) + lu(k,818) = lu(k,818) * lu(k,809) + lu(k,1364) = lu(k,1364) - lu(k,810) * lu(k,1363) + lu(k,1374) = lu(k,1374) - lu(k,811) * lu(k,1363) + lu(k,1385) = lu(k,1385) - lu(k,812) * lu(k,1363) + lu(k,1390) = lu(k,1390) - lu(k,813) * lu(k,1363) + lu(k,1393) = lu(k,1393) - lu(k,814) * lu(k,1363) + lu(k,1394) = lu(k,1394) - lu(k,815) * lu(k,1363) + lu(k,1397) = lu(k,1397) - lu(k,816) * lu(k,1363) + lu(k,1401) = lu(k,1401) - lu(k,817) * lu(k,1363) + lu(k,1402) = lu(k,1402) - lu(k,818) * lu(k,1363) + lu(k,1418) = lu(k,1418) - lu(k,810) * lu(k,1417) + lu(k,1431) = lu(k,1431) - lu(k,811) * lu(k,1417) + lu(k,1442) = lu(k,1442) - lu(k,812) * lu(k,1417) + lu(k,1447) = lu(k,1447) - lu(k,813) * lu(k,1417) + lu(k,1450) = lu(k,1450) - lu(k,814) * lu(k,1417) + lu(k,1451) = lu(k,1451) - lu(k,815) * lu(k,1417) + lu(k,1454) = lu(k,1454) - lu(k,816) * lu(k,1417) + lu(k,1458) = lu(k,1458) - lu(k,817) * lu(k,1417) + lu(k,1459) = lu(k,1459) - lu(k,818) * lu(k,1417) + lu(k,1587) = lu(k,1587) - lu(k,810) * lu(k,1586) + lu(k,1601) = lu(k,1601) - lu(k,811) * lu(k,1586) + lu(k,1613) = lu(k,1613) - lu(k,812) * lu(k,1586) + lu(k,1618) = lu(k,1618) - lu(k,813) * lu(k,1586) + lu(k,1621) = lu(k,1621) - lu(k,814) * lu(k,1586) + lu(k,1622) = lu(k,1622) - lu(k,815) * lu(k,1586) + lu(k,1625) = lu(k,1625) - lu(k,816) * lu(k,1586) + lu(k,1629) = lu(k,1629) - lu(k,817) * lu(k,1586) + lu(k,1630) = lu(k,1630) - lu(k,818) * lu(k,1586) + lu(k,1803) = lu(k,1803) - lu(k,810) * lu(k,1802) + lu(k,1814) = lu(k,1814) - lu(k,811) * lu(k,1802) + lu(k,1824) = lu(k,1824) - lu(k,812) * lu(k,1802) + lu(k,1829) = lu(k,1829) - lu(k,813) * lu(k,1802) + lu(k,1832) = lu(k,1832) - lu(k,814) * lu(k,1802) + lu(k,1833) = lu(k,1833) - lu(k,815) * lu(k,1802) + lu(k,1836) = lu(k,1836) - lu(k,816) * lu(k,1802) + lu(k,1840) = lu(k,1840) - lu(k,817) * lu(k,1802) + lu(k,1841) = lu(k,1841) - lu(k,818) * lu(k,1802) + lu(k,1957) = lu(k,1957) - lu(k,810) * lu(k,1956) + lu(k,1969) = lu(k,1969) - lu(k,811) * lu(k,1956) + lu(k,1979) = lu(k,1979) - lu(k,812) * lu(k,1956) + lu(k,1984) = lu(k,1984) - lu(k,813) * lu(k,1956) + lu(k,1987) = lu(k,1987) - lu(k,814) * lu(k,1956) + lu(k,1988) = lu(k,1988) - lu(k,815) * lu(k,1956) + lu(k,1991) = lu(k,1991) - lu(k,816) * lu(k,1956) + lu(k,1995) = lu(k,1995) - lu(k,817) * lu(k,1956) + lu(k,1996) = lu(k,1996) - lu(k,818) * lu(k,1956) + lu(k,819) = 1._r8 / lu(k,819) + lu(k,820) = lu(k,820) * lu(k,819) + lu(k,821) = lu(k,821) * lu(k,819) + lu(k,822) = lu(k,822) * lu(k,819) + lu(k,823) = lu(k,823) * lu(k,819) + lu(k,824) = lu(k,824) * lu(k,819) + lu(k,888) = lu(k,888) - lu(k,820) * lu(k,885) + lu(k,889) = lu(k,889) - lu(k,821) * lu(k,885) + lu(k,891) = lu(k,891) - lu(k,822) * lu(k,885) + lu(k,892) = - lu(k,823) * lu(k,885) + lu(k,894) = - lu(k,824) * lu(k,885) + lu(k,901) = - lu(k,820) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,821) * lu(k,896) + lu(k,906) = lu(k,906) - lu(k,822) * lu(k,896) + lu(k,907) = - lu(k,823) * lu(k,896) + lu(k,910) = - lu(k,824) * lu(k,896) + lu(k,931) = - lu(k,820) * lu(k,924) + lu(k,932) = - lu(k,821) * lu(k,924) + lu(k,937) = lu(k,937) - lu(k,822) * lu(k,924) + lu(k,938) = lu(k,938) - lu(k,823) * lu(k,924) + lu(k,942) = - lu(k,824) * lu(k,924) + lu(k,951) = - lu(k,820) * lu(k,946) + lu(k,952) = - lu(k,821) * lu(k,946) + lu(k,956) = lu(k,956) - lu(k,822) * lu(k,946) + lu(k,957) = lu(k,957) - lu(k,823) * lu(k,946) + lu(k,961) = - lu(k,824) * lu(k,946) + lu(k,1373) = lu(k,1373) - lu(k,820) * lu(k,1364) + lu(k,1385) = lu(k,1385) - lu(k,821) * lu(k,1364) + lu(k,1393) = lu(k,1393) - lu(k,822) * lu(k,1364) + lu(k,1394) = lu(k,1394) - lu(k,823) * lu(k,1364) + lu(k,1403) = lu(k,1403) - lu(k,824) * lu(k,1364) + lu(k,1430) = lu(k,1430) - lu(k,820) * lu(k,1418) + lu(k,1442) = lu(k,1442) - lu(k,821) * lu(k,1418) + lu(k,1450) = lu(k,1450) - lu(k,822) * lu(k,1418) + lu(k,1451) = lu(k,1451) - lu(k,823) * lu(k,1418) + lu(k,1460) = lu(k,1460) - lu(k,824) * lu(k,1418) + lu(k,1600) = lu(k,1600) - lu(k,820) * lu(k,1587) + lu(k,1613) = lu(k,1613) - lu(k,821) * lu(k,1587) + lu(k,1621) = lu(k,1621) - lu(k,822) * lu(k,1587) + lu(k,1622) = lu(k,1622) - lu(k,823) * lu(k,1587) + lu(k,1631) = lu(k,1631) - lu(k,824) * lu(k,1587) + lu(k,1653) = lu(k,1653) - lu(k,820) * lu(k,1643) + lu(k,1664) = lu(k,1664) - lu(k,821) * lu(k,1643) + lu(k,1671) = lu(k,1671) - lu(k,822) * lu(k,1643) + lu(k,1672) = lu(k,1672) - lu(k,823) * lu(k,1643) + lu(k,1681) = lu(k,1681) - lu(k,824) * lu(k,1643) + lu(k,1813) = lu(k,1813) - lu(k,820) * lu(k,1803) + lu(k,1824) = lu(k,1824) - lu(k,821) * lu(k,1803) + lu(k,1832) = lu(k,1832) - lu(k,822) * lu(k,1803) + lu(k,1833) = lu(k,1833) - lu(k,823) * lu(k,1803) + lu(k,1842) = lu(k,1842) - lu(k,824) * lu(k,1803) + lu(k,1968) = lu(k,1968) - lu(k,820) * lu(k,1957) + lu(k,1979) = lu(k,1979) - lu(k,821) * lu(k,1957) + lu(k,1987) = lu(k,1987) - lu(k,822) * lu(k,1957) + lu(k,1988) = lu(k,1988) - lu(k,823) * lu(k,1957) + lu(k,1997) = lu(k,1997) - lu(k,824) * lu(k,1957) + lu(k,827) = 1._r8 / lu(k,827) + lu(k,828) = lu(k,828) * lu(k,827) + lu(k,829) = lu(k,829) * lu(k,827) + lu(k,830) = lu(k,830) * lu(k,827) + lu(k,831) = lu(k,831) * lu(k,827) + lu(k,832) = lu(k,832) * lu(k,827) + lu(k,833) = lu(k,833) * lu(k,827) + lu(k,834) = lu(k,834) * lu(k,827) + lu(k,835) = lu(k,835) * lu(k,827) + lu(k,836) = lu(k,836) * lu(k,827) + lu(k,1294) = lu(k,1294) - lu(k,828) * lu(k,1292) + lu(k,1296) = lu(k,1296) - lu(k,829) * lu(k,1292) + lu(k,1298) = - lu(k,830) * lu(k,1292) + lu(k,1300) = lu(k,1300) - lu(k,831) * lu(k,1292) + lu(k,1302) = lu(k,1302) - lu(k,832) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,833) * lu(k,1292) + lu(k,1304) = - lu(k,834) * lu(k,1292) + lu(k,1307) = lu(k,1307) - lu(k,835) * lu(k,1292) + lu(k,1309) = lu(k,1309) - lu(k,836) * lu(k,1292) + lu(k,1615) = lu(k,1615) - lu(k,828) * lu(k,1588) + lu(k,1617) = lu(k,1617) - lu(k,829) * lu(k,1588) + lu(k,1619) = lu(k,1619) - lu(k,830) * lu(k,1588) + lu(k,1621) = lu(k,1621) - lu(k,831) * lu(k,1588) + lu(k,1623) = lu(k,1623) - lu(k,832) * lu(k,1588) + lu(k,1624) = lu(k,1624) - lu(k,833) * lu(k,1588) + lu(k,1625) = lu(k,1625) - lu(k,834) * lu(k,1588) + lu(k,1628) = lu(k,1628) - lu(k,835) * lu(k,1588) + lu(k,1631) = lu(k,1631) - lu(k,836) * lu(k,1588) + lu(k,1691) = - lu(k,828) * lu(k,1688) + lu(k,1693) = lu(k,1693) - lu(k,829) * lu(k,1688) + lu(k,1695) = - lu(k,830) * lu(k,1688) + lu(k,1697) = lu(k,1697) - lu(k,831) * lu(k,1688) + lu(k,1699) = lu(k,1699) - lu(k,832) * lu(k,1688) + lu(k,1700) = lu(k,1700) - lu(k,833) * lu(k,1688) + lu(k,1701) = lu(k,1701) - lu(k,834) * lu(k,1688) + lu(k,1704) = lu(k,1704) - lu(k,835) * lu(k,1688) + lu(k,1707) = lu(k,1707) - lu(k,836) * lu(k,1688) + lu(k,1725) = - lu(k,828) * lu(k,1718) + lu(k,1727) = lu(k,1727) - lu(k,829) * lu(k,1718) + lu(k,1729) = lu(k,1729) - lu(k,830) * lu(k,1718) + lu(k,1731) = lu(k,1731) - lu(k,831) * lu(k,1718) + lu(k,1733) = lu(k,1733) - lu(k,832) * lu(k,1718) + lu(k,1734) = lu(k,1734) - lu(k,833) * lu(k,1718) + lu(k,1735) = lu(k,1735) - lu(k,834) * lu(k,1718) + lu(k,1738) = lu(k,1738) - lu(k,835) * lu(k,1718) + lu(k,1741) = lu(k,1741) - lu(k,836) * lu(k,1718) + lu(k,1766) = lu(k,1766) - lu(k,828) * lu(k,1758) + lu(k,1768) = lu(k,1768) - lu(k,829) * lu(k,1758) + lu(k,1770) = lu(k,1770) - lu(k,830) * lu(k,1758) + lu(k,1772) = lu(k,1772) - lu(k,831) * lu(k,1758) + lu(k,1774) = lu(k,1774) - lu(k,832) * lu(k,1758) + lu(k,1775) = lu(k,1775) - lu(k,833) * lu(k,1758) + lu(k,1776) = lu(k,1776) - lu(k,834) * lu(k,1758) + lu(k,1779) = lu(k,1779) - lu(k,835) * lu(k,1758) + lu(k,1782) = lu(k,1782) - lu(k,836) * lu(k,1758) + lu(k,1880) = lu(k,1880) - lu(k,828) * lu(k,1875) + lu(k,1882) = lu(k,1882) - lu(k,829) * lu(k,1875) + lu(k,1884) = lu(k,1884) - lu(k,830) * lu(k,1875) + lu(k,1886) = lu(k,1886) - lu(k,831) * lu(k,1875) + lu(k,1888) = lu(k,1888) - lu(k,832) * lu(k,1875) + lu(k,1889) = lu(k,1889) - lu(k,833) * lu(k,1875) + lu(k,1890) = lu(k,1890) - lu(k,834) * lu(k,1875) + lu(k,1893) = lu(k,1893) - lu(k,835) * lu(k,1875) + lu(k,1896) = lu(k,1896) - lu(k,836) * lu(k,1875) + lu(k,841) = 1._r8 / lu(k,841) + lu(k,842) = lu(k,842) * lu(k,841) + lu(k,843) = lu(k,843) * lu(k,841) + lu(k,844) = lu(k,844) * lu(k,841) + lu(k,845) = lu(k,845) * lu(k,841) + lu(k,846) = lu(k,846) * lu(k,841) + lu(k,847) = lu(k,847) * lu(k,841) + lu(k,848) = lu(k,848) * lu(k,841) + lu(k,849) = lu(k,849) * lu(k,841) + lu(k,850) = lu(k,850) * lu(k,841) + lu(k,851) = lu(k,851) * lu(k,841) + lu(k,852) = lu(k,852) * lu(k,841) + lu(k,853) = lu(k,853) * lu(k,841) + lu(k,854) = lu(k,854) * lu(k,841) + lu(k,855) = lu(k,855) * lu(k,841) + lu(k,1126) = lu(k,1126) - lu(k,842) * lu(k,1125) + lu(k,1127) = - lu(k,843) * lu(k,1125) + lu(k,1128) = lu(k,1128) - lu(k,844) * lu(k,1125) + lu(k,1129) = lu(k,1129) - lu(k,845) * lu(k,1125) + lu(k,1132) = lu(k,1132) - lu(k,846) * lu(k,1125) + lu(k,1135) = lu(k,1135) - lu(k,847) * lu(k,1125) + lu(k,1136) = - lu(k,848) * lu(k,1125) + lu(k,1137) = lu(k,1137) - lu(k,849) * lu(k,1125) + lu(k,1138) = lu(k,1138) - lu(k,850) * lu(k,1125) + lu(k,1139) = - lu(k,851) * lu(k,1125) + lu(k,1140) = lu(k,1140) - lu(k,852) * lu(k,1125) + lu(k,1141) = lu(k,1141) - lu(k,853) * lu(k,1125) + lu(k,1142) = - lu(k,854) * lu(k,1125) + lu(k,1143) = lu(k,1143) - lu(k,855) * lu(k,1125) + lu(k,1425) = lu(k,1425) - lu(k,842) * lu(k,1419) + lu(k,1426) = lu(k,1426) - lu(k,843) * lu(k,1419) + lu(k,1431) = lu(k,1431) - lu(k,844) * lu(k,1419) + lu(k,1435) = lu(k,1435) - lu(k,845) * lu(k,1419) + lu(k,1442) = lu(k,1442) - lu(k,846) * lu(k,1419) + lu(k,1447) = lu(k,1447) - lu(k,847) * lu(k,1419) + lu(k,1448) = lu(k,1448) - lu(k,848) * lu(k,1419) + lu(k,1450) = lu(k,1450) - lu(k,849) * lu(k,1419) + lu(k,1451) = lu(k,1451) - lu(k,850) * lu(k,1419) + lu(k,1454) = lu(k,1454) - lu(k,851) * lu(k,1419) + lu(k,1455) = lu(k,1455) - lu(k,852) * lu(k,1419) + lu(k,1458) = lu(k,1458) - lu(k,853) * lu(k,1419) + lu(k,1459) = lu(k,1459) - lu(k,854) * lu(k,1419) + lu(k,1460) = lu(k,1460) - lu(k,855) * lu(k,1419) + lu(k,1595) = lu(k,1595) - lu(k,842) * lu(k,1589) + lu(k,1596) = lu(k,1596) - lu(k,843) * lu(k,1589) + lu(k,1601) = lu(k,1601) - lu(k,844) * lu(k,1589) + lu(k,1606) = lu(k,1606) - lu(k,845) * lu(k,1589) + lu(k,1613) = lu(k,1613) - lu(k,846) * lu(k,1589) + lu(k,1618) = lu(k,1618) - lu(k,847) * lu(k,1589) + lu(k,1619) = lu(k,1619) - lu(k,848) * lu(k,1589) + lu(k,1621) = lu(k,1621) - lu(k,849) * lu(k,1589) + lu(k,1622) = lu(k,1622) - lu(k,850) * lu(k,1589) + lu(k,1625) = lu(k,1625) - lu(k,851) * lu(k,1589) + lu(k,1626) = lu(k,1626) - lu(k,852) * lu(k,1589) + lu(k,1629) = lu(k,1629) - lu(k,853) * lu(k,1589) + lu(k,1630) = lu(k,1630) - lu(k,854) * lu(k,1589) + lu(k,1631) = lu(k,1631) - lu(k,855) * lu(k,1589) + lu(k,1808) = lu(k,1808) - lu(k,842) * lu(k,1804) + lu(k,1809) = - lu(k,843) * lu(k,1804) + lu(k,1814) = lu(k,1814) - lu(k,844) * lu(k,1804) + lu(k,1817) = lu(k,1817) - lu(k,845) * lu(k,1804) + lu(k,1824) = lu(k,1824) - lu(k,846) * lu(k,1804) + lu(k,1829) = lu(k,1829) - lu(k,847) * lu(k,1804) + lu(k,1830) = lu(k,1830) - lu(k,848) * lu(k,1804) + lu(k,1832) = lu(k,1832) - lu(k,849) * lu(k,1804) + lu(k,1833) = lu(k,1833) - lu(k,850) * lu(k,1804) + lu(k,1836) = lu(k,1836) - lu(k,851) * lu(k,1804) + lu(k,1837) = lu(k,1837) - lu(k,852) * lu(k,1804) + lu(k,1840) = lu(k,1840) - lu(k,853) * lu(k,1804) + lu(k,1841) = lu(k,1841) - lu(k,854) * lu(k,1804) + lu(k,1842) = lu(k,1842) - lu(k,855) * lu(k,1804) + end do + end subroutine lu_fac18 + subroutine lu_fac19( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,856) = 1._r8 / lu(k,856) + lu(k,857) = lu(k,857) * lu(k,856) + lu(k,858) = lu(k,858) * lu(k,856) + lu(k,859) = lu(k,859) * lu(k,856) + lu(k,860) = lu(k,860) * lu(k,856) + lu(k,861) = lu(k,861) * lu(k,856) + lu(k,862) = lu(k,862) * lu(k,856) + lu(k,863) = lu(k,863) * lu(k,856) + lu(k,926) = - lu(k,857) * lu(k,925) + lu(k,927) = - lu(k,858) * lu(k,925) + lu(k,929) = - lu(k,859) * lu(k,925) + lu(k,930) = - lu(k,860) * lu(k,925) + lu(k,935) = lu(k,935) - lu(k,861) * lu(k,925) + lu(k,936) = - lu(k,862) * lu(k,925) + lu(k,937) = lu(k,937) - lu(k,863) * lu(k,925) + lu(k,966) = - lu(k,857) * lu(k,965) + lu(k,967) = - lu(k,858) * lu(k,965) + lu(k,968) = - lu(k,859) * lu(k,965) + lu(k,969) = lu(k,969) - lu(k,860) * lu(k,965) + lu(k,974) = lu(k,974) - lu(k,861) * lu(k,965) + lu(k,975) = lu(k,975) - lu(k,862) * lu(k,965) + lu(k,976) = lu(k,976) - lu(k,863) * lu(k,965) + lu(k,1367) = lu(k,1367) - lu(k,857) * lu(k,1365) + lu(k,1368) = lu(k,1368) - lu(k,858) * lu(k,1365) + lu(k,1371) = lu(k,1371) - lu(k,859) * lu(k,1365) + lu(k,1372) = lu(k,1372) - lu(k,860) * lu(k,1365) + lu(k,1390) = lu(k,1390) - lu(k,861) * lu(k,1365) + lu(k,1391) = lu(k,1391) - lu(k,862) * lu(k,1365) + lu(k,1393) = lu(k,1393) - lu(k,863) * lu(k,1365) + lu(k,1423) = lu(k,1423) - lu(k,857) * lu(k,1420) + lu(k,1425) = lu(k,1425) - lu(k,858) * lu(k,1420) + lu(k,1428) = lu(k,1428) - lu(k,859) * lu(k,1420) + lu(k,1429) = lu(k,1429) - lu(k,860) * lu(k,1420) + lu(k,1447) = lu(k,1447) - lu(k,861) * lu(k,1420) + lu(k,1448) = lu(k,1448) - lu(k,862) * lu(k,1420) + lu(k,1450) = lu(k,1450) - lu(k,863) * lu(k,1420) + lu(k,1593) = lu(k,1593) - lu(k,857) * lu(k,1590) + lu(k,1595) = lu(k,1595) - lu(k,858) * lu(k,1590) + lu(k,1598) = lu(k,1598) - lu(k,859) * lu(k,1590) + lu(k,1599) = lu(k,1599) - lu(k,860) * lu(k,1590) + lu(k,1618) = lu(k,1618) - lu(k,861) * lu(k,1590) + lu(k,1619) = lu(k,1619) - lu(k,862) * lu(k,1590) + lu(k,1621) = lu(k,1621) - lu(k,863) * lu(k,1590) + lu(k,1647) = lu(k,1647) - lu(k,857) * lu(k,1644) + lu(k,1648) = lu(k,1648) - lu(k,858) * lu(k,1644) + lu(k,1651) = lu(k,1651) - lu(k,859) * lu(k,1644) + lu(k,1652) = lu(k,1652) - lu(k,860) * lu(k,1644) + lu(k,1668) = lu(k,1668) - lu(k,861) * lu(k,1644) + lu(k,1669) = - lu(k,862) * lu(k,1644) + lu(k,1671) = lu(k,1671) - lu(k,863) * lu(k,1644) + lu(k,1807) = lu(k,1807) - lu(k,857) * lu(k,1805) + lu(k,1808) = lu(k,1808) - lu(k,858) * lu(k,1805) + lu(k,1811) = - lu(k,859) * lu(k,1805) + lu(k,1812) = lu(k,1812) - lu(k,860) * lu(k,1805) + lu(k,1829) = lu(k,1829) - lu(k,861) * lu(k,1805) + lu(k,1830) = lu(k,1830) - lu(k,862) * lu(k,1805) + lu(k,1832) = lu(k,1832) - lu(k,863) * lu(k,1805) + lu(k,1961) = lu(k,1961) - lu(k,857) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,858) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,859) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,860) * lu(k,1958) + lu(k,1984) = lu(k,1984) - lu(k,861) * lu(k,1958) + lu(k,1985) = lu(k,1985) - lu(k,862) * lu(k,1958) + lu(k,1987) = lu(k,1987) - lu(k,863) * lu(k,1958) + lu(k,865) = 1._r8 / lu(k,865) + lu(k,866) = lu(k,866) * lu(k,865) + lu(k,867) = lu(k,867) * lu(k,865) + lu(k,868) = lu(k,868) * lu(k,865) + lu(k,869) = lu(k,869) * lu(k,865) + lu(k,899) = lu(k,899) - lu(k,866) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,867) * lu(k,897) + lu(k,906) = lu(k,906) - lu(k,868) * lu(k,897) + lu(k,909) = lu(k,909) - lu(k,869) * lu(k,897) + lu(k,949) = lu(k,949) - lu(k,866) * lu(k,947) + lu(k,955) = lu(k,955) - lu(k,867) * lu(k,947) + lu(k,956) = lu(k,956) - lu(k,868) * lu(k,947) + lu(k,959) = lu(k,959) - lu(k,869) * lu(k,947) + lu(k,1022) = lu(k,1022) - lu(k,866) * lu(k,1021) + lu(k,1028) = lu(k,1028) - lu(k,867) * lu(k,1021) + lu(k,1030) = lu(k,1030) - lu(k,868) * lu(k,1021) + lu(k,1033) = lu(k,1033) - lu(k,869) * lu(k,1021) + lu(k,1042) = - lu(k,866) * lu(k,1040) + lu(k,1051) = lu(k,1051) - lu(k,867) * lu(k,1040) + lu(k,1053) = lu(k,1053) - lu(k,868) * lu(k,1040) + lu(k,1056) = lu(k,1056) - lu(k,869) * lu(k,1040) + lu(k,1101) = - lu(k,866) * lu(k,1099) + lu(k,1115) = lu(k,1115) - lu(k,867) * lu(k,1099) + lu(k,1117) = lu(k,1117) - lu(k,868) * lu(k,1099) + lu(k,1121) = lu(k,1121) - lu(k,869) * lu(k,1099) + lu(k,1148) = lu(k,1148) - lu(k,866) * lu(k,1146) + lu(k,1158) = lu(k,1158) - lu(k,867) * lu(k,1146) + lu(k,1160) = lu(k,1160) - lu(k,868) * lu(k,1146) + lu(k,1163) = lu(k,1163) - lu(k,869) * lu(k,1146) + lu(k,1177) = lu(k,1177) - lu(k,866) * lu(k,1175) + lu(k,1191) = lu(k,1191) - lu(k,867) * lu(k,1175) + lu(k,1193) = lu(k,1193) - lu(k,868) * lu(k,1175) + lu(k,1197) = lu(k,1197) - lu(k,869) * lu(k,1175) + lu(k,1225) = lu(k,1225) - lu(k,866) * lu(k,1223) + lu(k,1239) = lu(k,1239) - lu(k,867) * lu(k,1223) + lu(k,1241) = lu(k,1241) - lu(k,868) * lu(k,1223) + lu(k,1245) = lu(k,1245) - lu(k,869) * lu(k,1223) + lu(k,1368) = lu(k,1368) - lu(k,866) * lu(k,1366) + lu(k,1390) = lu(k,1390) - lu(k,867) * lu(k,1366) + lu(k,1393) = lu(k,1393) - lu(k,868) * lu(k,1366) + lu(k,1401) = lu(k,1401) - lu(k,869) * lu(k,1366) + lu(k,1425) = lu(k,1425) - lu(k,866) * lu(k,1421) + lu(k,1447) = lu(k,1447) - lu(k,867) * lu(k,1421) + lu(k,1450) = lu(k,1450) - lu(k,868) * lu(k,1421) + lu(k,1458) = lu(k,1458) - lu(k,869) * lu(k,1421) + lu(k,1595) = lu(k,1595) - lu(k,866) * lu(k,1591) + lu(k,1618) = lu(k,1618) - lu(k,867) * lu(k,1591) + lu(k,1621) = lu(k,1621) - lu(k,868) * lu(k,1591) + lu(k,1629) = lu(k,1629) - lu(k,869) * lu(k,1591) + lu(k,1648) = lu(k,1648) - lu(k,866) * lu(k,1645) + lu(k,1668) = lu(k,1668) - lu(k,867) * lu(k,1645) + lu(k,1671) = lu(k,1671) - lu(k,868) * lu(k,1645) + lu(k,1679) = lu(k,1679) - lu(k,869) * lu(k,1645) + lu(k,1720) = lu(k,1720) - lu(k,866) * lu(k,1719) + lu(k,1728) = lu(k,1728) - lu(k,867) * lu(k,1719) + lu(k,1731) = lu(k,1731) - lu(k,868) * lu(k,1719) + lu(k,1739) = lu(k,1739) - lu(k,869) * lu(k,1719) + lu(k,1808) = lu(k,1808) - lu(k,866) * lu(k,1806) + lu(k,1829) = lu(k,1829) - lu(k,867) * lu(k,1806) + lu(k,1832) = lu(k,1832) - lu(k,868) * lu(k,1806) + lu(k,1840) = lu(k,1840) - lu(k,869) * lu(k,1806) + lu(k,1963) = lu(k,1963) - lu(k,866) * lu(k,1959) + lu(k,1984) = lu(k,1984) - lu(k,867) * lu(k,1959) + lu(k,1987) = lu(k,1987) - lu(k,868) * lu(k,1959) + lu(k,1995) = lu(k,1995) - lu(k,869) * lu(k,1959) + lu(k,874) = 1._r8 / lu(k,874) + lu(k,875) = lu(k,875) * lu(k,874) + lu(k,876) = lu(k,876) * lu(k,874) + lu(k,877) = lu(k,877) * lu(k,874) + lu(k,878) = lu(k,878) * lu(k,874) + lu(k,879) = lu(k,879) * lu(k,874) + lu(k,880) = lu(k,880) * lu(k,874) + lu(k,881) = lu(k,881) * lu(k,874) + lu(k,882) = lu(k,882) * lu(k,874) + lu(k,883) = lu(k,883) * lu(k,874) + lu(k,884) = lu(k,884) * lu(k,874) + lu(k,1042) = lu(k,1042) - lu(k,875) * lu(k,1041) + lu(k,1046) = lu(k,1046) - lu(k,876) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,877) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,878) * lu(k,1041) + lu(k,1051) = lu(k,1051) - lu(k,879) * lu(k,1041) + lu(k,1053) = lu(k,1053) - lu(k,880) * lu(k,1041) + lu(k,1054) = lu(k,1054) - lu(k,881) * lu(k,1041) + lu(k,1055) = lu(k,1055) - lu(k,882) * lu(k,1041) + lu(k,1056) = lu(k,1056) - lu(k,883) * lu(k,1041) + lu(k,1057) = lu(k,1057) - lu(k,884) * lu(k,1041) + lu(k,1225) = lu(k,1225) - lu(k,875) * lu(k,1224) + lu(k,1230) = lu(k,1230) - lu(k,876) * lu(k,1224) + lu(k,1236) = lu(k,1236) - lu(k,877) * lu(k,1224) + lu(k,1237) = - lu(k,878) * lu(k,1224) + lu(k,1239) = lu(k,1239) - lu(k,879) * lu(k,1224) + lu(k,1241) = lu(k,1241) - lu(k,880) * lu(k,1224) + lu(k,1242) = lu(k,1242) - lu(k,881) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,882) * lu(k,1224) + lu(k,1245) = lu(k,1245) - lu(k,883) * lu(k,1224) + lu(k,1246) = lu(k,1246) - lu(k,884) * lu(k,1224) + lu(k,1425) = lu(k,1425) - lu(k,875) * lu(k,1422) + lu(k,1435) = lu(k,1435) - lu(k,876) * lu(k,1422) + lu(k,1442) = lu(k,1442) - lu(k,877) * lu(k,1422) + lu(k,1444) = lu(k,1444) - lu(k,878) * lu(k,1422) + lu(k,1447) = lu(k,1447) - lu(k,879) * lu(k,1422) + lu(k,1450) = lu(k,1450) - lu(k,880) * lu(k,1422) + lu(k,1451) = lu(k,1451) - lu(k,881) * lu(k,1422) + lu(k,1454) = lu(k,1454) - lu(k,882) * lu(k,1422) + lu(k,1458) = lu(k,1458) - lu(k,883) * lu(k,1422) + lu(k,1459) = lu(k,1459) - lu(k,884) * lu(k,1422) + lu(k,1595) = lu(k,1595) - lu(k,875) * lu(k,1592) + lu(k,1606) = lu(k,1606) - lu(k,876) * lu(k,1592) + lu(k,1613) = lu(k,1613) - lu(k,877) * lu(k,1592) + lu(k,1615) = lu(k,1615) - lu(k,878) * lu(k,1592) + lu(k,1618) = lu(k,1618) - lu(k,879) * lu(k,1592) + lu(k,1621) = lu(k,1621) - lu(k,880) * lu(k,1592) + lu(k,1622) = lu(k,1622) - lu(k,881) * lu(k,1592) + lu(k,1625) = lu(k,1625) - lu(k,882) * lu(k,1592) + lu(k,1629) = lu(k,1629) - lu(k,883) * lu(k,1592) + lu(k,1630) = lu(k,1630) - lu(k,884) * lu(k,1592) + lu(k,1648) = lu(k,1648) - lu(k,875) * lu(k,1646) + lu(k,1658) = lu(k,1658) - lu(k,876) * lu(k,1646) + lu(k,1664) = lu(k,1664) - lu(k,877) * lu(k,1646) + lu(k,1665) = lu(k,1665) - lu(k,878) * lu(k,1646) + lu(k,1668) = lu(k,1668) - lu(k,879) * lu(k,1646) + lu(k,1671) = lu(k,1671) - lu(k,880) * lu(k,1646) + lu(k,1672) = lu(k,1672) - lu(k,881) * lu(k,1646) + lu(k,1675) = lu(k,1675) - lu(k,882) * lu(k,1646) + lu(k,1679) = lu(k,1679) - lu(k,883) * lu(k,1646) + lu(k,1680) = lu(k,1680) - lu(k,884) * lu(k,1646) + lu(k,1963) = lu(k,1963) - lu(k,875) * lu(k,1960) + lu(k,1973) = lu(k,1973) - lu(k,876) * lu(k,1960) + lu(k,1979) = lu(k,1979) - lu(k,877) * lu(k,1960) + lu(k,1981) = lu(k,1981) - lu(k,878) * lu(k,1960) + lu(k,1984) = lu(k,1984) - lu(k,879) * lu(k,1960) + lu(k,1987) = lu(k,1987) - lu(k,880) * lu(k,1960) + lu(k,1988) = lu(k,1988) - lu(k,881) * lu(k,1960) + lu(k,1991) = lu(k,1991) - lu(k,882) * lu(k,1960) + lu(k,1995) = lu(k,1995) - lu(k,883) * lu(k,1960) + lu(k,1996) = lu(k,1996) - lu(k,884) * lu(k,1960) + lu(k,886) = 1._r8 / lu(k,886) + lu(k,887) = lu(k,887) * lu(k,886) + lu(k,888) = lu(k,888) * lu(k,886) + lu(k,889) = lu(k,889) * lu(k,886) + lu(k,890) = lu(k,890) * lu(k,886) + lu(k,891) = lu(k,891) * lu(k,886) + lu(k,892) = lu(k,892) * lu(k,886) + lu(k,893) = lu(k,893) * lu(k,886) + lu(k,894) = lu(k,894) * lu(k,886) + lu(k,927) = lu(k,927) - lu(k,887) * lu(k,926) + lu(k,931) = lu(k,931) - lu(k,888) * lu(k,926) + lu(k,932) = lu(k,932) - lu(k,889) * lu(k,926) + lu(k,935) = lu(k,935) - lu(k,890) * lu(k,926) + lu(k,937) = lu(k,937) - lu(k,891) * lu(k,926) + lu(k,938) = lu(k,938) - lu(k,892) * lu(k,926) + lu(k,940) = lu(k,940) - lu(k,893) * lu(k,926) + lu(k,942) = lu(k,942) - lu(k,894) * lu(k,926) + lu(k,949) = lu(k,949) - lu(k,887) * lu(k,948) + lu(k,951) = lu(k,951) - lu(k,888) * lu(k,948) + lu(k,952) = lu(k,952) - lu(k,889) * lu(k,948) + lu(k,955) = lu(k,955) - lu(k,890) * lu(k,948) + lu(k,956) = lu(k,956) - lu(k,891) * lu(k,948) + lu(k,957) = lu(k,957) - lu(k,892) * lu(k,948) + lu(k,959) = lu(k,959) - lu(k,893) * lu(k,948) + lu(k,961) = lu(k,961) - lu(k,894) * lu(k,948) + lu(k,967) = lu(k,967) - lu(k,887) * lu(k,966) + lu(k,970) = - lu(k,888) * lu(k,966) + lu(k,971) = - lu(k,889) * lu(k,966) + lu(k,974) = lu(k,974) - lu(k,890) * lu(k,966) + lu(k,976) = lu(k,976) - lu(k,891) * lu(k,966) + lu(k,977) = lu(k,977) - lu(k,892) * lu(k,966) + lu(k,979) = lu(k,979) - lu(k,893) * lu(k,966) + lu(k,981) = - lu(k,894) * lu(k,966) + lu(k,1368) = lu(k,1368) - lu(k,887) * lu(k,1367) + lu(k,1373) = lu(k,1373) - lu(k,888) * lu(k,1367) + lu(k,1385) = lu(k,1385) - lu(k,889) * lu(k,1367) + lu(k,1390) = lu(k,1390) - lu(k,890) * lu(k,1367) + lu(k,1393) = lu(k,1393) - lu(k,891) * lu(k,1367) + lu(k,1394) = lu(k,1394) - lu(k,892) * lu(k,1367) + lu(k,1401) = lu(k,1401) - lu(k,893) * lu(k,1367) + lu(k,1403) = lu(k,1403) - lu(k,894) * lu(k,1367) + lu(k,1425) = lu(k,1425) - lu(k,887) * lu(k,1423) + lu(k,1430) = lu(k,1430) - lu(k,888) * lu(k,1423) + lu(k,1442) = lu(k,1442) - lu(k,889) * lu(k,1423) + lu(k,1447) = lu(k,1447) - lu(k,890) * lu(k,1423) + lu(k,1450) = lu(k,1450) - lu(k,891) * lu(k,1423) + lu(k,1451) = lu(k,1451) - lu(k,892) * lu(k,1423) + lu(k,1458) = lu(k,1458) - lu(k,893) * lu(k,1423) + lu(k,1460) = lu(k,1460) - lu(k,894) * lu(k,1423) + lu(k,1595) = lu(k,1595) - lu(k,887) * lu(k,1593) + lu(k,1600) = lu(k,1600) - lu(k,888) * lu(k,1593) + lu(k,1613) = lu(k,1613) - lu(k,889) * lu(k,1593) + lu(k,1618) = lu(k,1618) - lu(k,890) * lu(k,1593) + lu(k,1621) = lu(k,1621) - lu(k,891) * lu(k,1593) + lu(k,1622) = lu(k,1622) - lu(k,892) * lu(k,1593) + lu(k,1629) = lu(k,1629) - lu(k,893) * lu(k,1593) + lu(k,1631) = lu(k,1631) - lu(k,894) * lu(k,1593) + lu(k,1648) = lu(k,1648) - lu(k,887) * lu(k,1647) + lu(k,1653) = lu(k,1653) - lu(k,888) * lu(k,1647) + lu(k,1664) = lu(k,1664) - lu(k,889) * lu(k,1647) + lu(k,1668) = lu(k,1668) - lu(k,890) * lu(k,1647) + lu(k,1671) = lu(k,1671) - lu(k,891) * lu(k,1647) + lu(k,1672) = lu(k,1672) - lu(k,892) * lu(k,1647) + lu(k,1679) = lu(k,1679) - lu(k,893) * lu(k,1647) + lu(k,1681) = lu(k,1681) - lu(k,894) * lu(k,1647) + lu(k,1808) = lu(k,1808) - lu(k,887) * lu(k,1807) + lu(k,1813) = lu(k,1813) - lu(k,888) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,889) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,890) * lu(k,1807) + lu(k,1832) = lu(k,1832) - lu(k,891) * lu(k,1807) + lu(k,1833) = lu(k,1833) - lu(k,892) * lu(k,1807) + lu(k,1840) = lu(k,1840) - lu(k,893) * lu(k,1807) + lu(k,1842) = lu(k,1842) - lu(k,894) * lu(k,1807) + lu(k,1963) = lu(k,1963) - lu(k,887) * lu(k,1961) + lu(k,1968) = lu(k,1968) - lu(k,888) * lu(k,1961) + lu(k,1979) = lu(k,1979) - lu(k,889) * lu(k,1961) + lu(k,1984) = lu(k,1984) - lu(k,890) * lu(k,1961) + lu(k,1987) = lu(k,1987) - lu(k,891) * lu(k,1961) + lu(k,1988) = lu(k,1988) - lu(k,892) * lu(k,1961) + lu(k,1995) = lu(k,1995) - lu(k,893) * lu(k,1961) + lu(k,1997) = lu(k,1997) - lu(k,894) * lu(k,1961) + lu(k,898) = 1._r8 / lu(k,898) + lu(k,899) = lu(k,899) * lu(k,898) + lu(k,900) = lu(k,900) * lu(k,898) + lu(k,901) = lu(k,901) * lu(k,898) + lu(k,902) = lu(k,902) * lu(k,898) + lu(k,903) = lu(k,903) * lu(k,898) + lu(k,904) = lu(k,904) * lu(k,898) + lu(k,905) = lu(k,905) * lu(k,898) + lu(k,906) = lu(k,906) * lu(k,898) + lu(k,907) = lu(k,907) * lu(k,898) + lu(k,908) = lu(k,908) * lu(k,898) + lu(k,909) = lu(k,909) * lu(k,898) + lu(k,910) = lu(k,910) * lu(k,898) + lu(k,1101) = lu(k,1101) - lu(k,899) * lu(k,1100) + lu(k,1102) = lu(k,1102) - lu(k,900) * lu(k,1100) + lu(k,1103) = - lu(k,901) * lu(k,1100) + lu(k,1104) = - lu(k,902) * lu(k,1100) + lu(k,1112) = lu(k,1112) - lu(k,903) * lu(k,1100) + lu(k,1113) = lu(k,1113) - lu(k,904) * lu(k,1100) + lu(k,1115) = lu(k,1115) - lu(k,905) * lu(k,1100) + lu(k,1117) = lu(k,1117) - lu(k,906) * lu(k,1100) + lu(k,1118) = lu(k,1118) - lu(k,907) * lu(k,1100) + lu(k,1119) = lu(k,1119) - lu(k,908) * lu(k,1100) + lu(k,1121) = lu(k,1121) - lu(k,909) * lu(k,1100) + lu(k,1123) = - lu(k,910) * lu(k,1100) + lu(k,1148) = lu(k,1148) - lu(k,899) * lu(k,1147) + lu(k,1149) = lu(k,1149) - lu(k,900) * lu(k,1147) + lu(k,1150) = - lu(k,901) * lu(k,1147) + lu(k,1151) = - lu(k,902) * lu(k,1147) + lu(k,1155) = lu(k,1155) - lu(k,903) * lu(k,1147) + lu(k,1156) = - lu(k,904) * lu(k,1147) + lu(k,1158) = lu(k,1158) - lu(k,905) * lu(k,1147) + lu(k,1160) = lu(k,1160) - lu(k,906) * lu(k,1147) + lu(k,1161) = lu(k,1161) - lu(k,907) * lu(k,1147) + lu(k,1162) = lu(k,1162) - lu(k,908) * lu(k,1147) + lu(k,1163) = lu(k,1163) - lu(k,909) * lu(k,1147) + lu(k,1165) = - lu(k,910) * lu(k,1147) + lu(k,1177) = lu(k,1177) - lu(k,899) * lu(k,1176) + lu(k,1178) = lu(k,1178) - lu(k,900) * lu(k,1176) + lu(k,1179) = - lu(k,901) * lu(k,1176) + lu(k,1180) = - lu(k,902) * lu(k,1176) + lu(k,1188) = lu(k,1188) - lu(k,903) * lu(k,1176) + lu(k,1189) = lu(k,1189) - lu(k,904) * lu(k,1176) + lu(k,1191) = lu(k,1191) - lu(k,905) * lu(k,1176) + lu(k,1193) = lu(k,1193) - lu(k,906) * lu(k,1176) + lu(k,1194) = lu(k,1194) - lu(k,907) * lu(k,1176) + lu(k,1195) = lu(k,1195) - lu(k,908) * lu(k,1176) + lu(k,1197) = lu(k,1197) - lu(k,909) * lu(k,1176) + lu(k,1199) = - lu(k,910) * lu(k,1176) + lu(k,1425) = lu(k,1425) - lu(k,899) * lu(k,1424) + lu(k,1426) = lu(k,1426) - lu(k,900) * lu(k,1424) + lu(k,1430) = lu(k,1430) - lu(k,901) * lu(k,1424) + lu(k,1431) = lu(k,1431) - lu(k,902) * lu(k,1424) + lu(k,1442) = lu(k,1442) - lu(k,903) * lu(k,1424) + lu(k,1444) = lu(k,1444) - lu(k,904) * lu(k,1424) + lu(k,1447) = lu(k,1447) - lu(k,905) * lu(k,1424) + lu(k,1450) = lu(k,1450) - lu(k,906) * lu(k,1424) + lu(k,1451) = lu(k,1451) - lu(k,907) * lu(k,1424) + lu(k,1454) = lu(k,1454) - lu(k,908) * lu(k,1424) + lu(k,1458) = lu(k,1458) - lu(k,909) * lu(k,1424) + lu(k,1460) = lu(k,1460) - lu(k,910) * lu(k,1424) + lu(k,1595) = lu(k,1595) - lu(k,899) * lu(k,1594) + lu(k,1596) = lu(k,1596) - lu(k,900) * lu(k,1594) + lu(k,1600) = lu(k,1600) - lu(k,901) * lu(k,1594) + lu(k,1601) = lu(k,1601) - lu(k,902) * lu(k,1594) + lu(k,1613) = lu(k,1613) - lu(k,903) * lu(k,1594) + lu(k,1615) = lu(k,1615) - lu(k,904) * lu(k,1594) + lu(k,1618) = lu(k,1618) - lu(k,905) * lu(k,1594) + lu(k,1621) = lu(k,1621) - lu(k,906) * lu(k,1594) + lu(k,1622) = lu(k,1622) - lu(k,907) * lu(k,1594) + lu(k,1625) = lu(k,1625) - lu(k,908) * lu(k,1594) + lu(k,1629) = lu(k,1629) - lu(k,909) * lu(k,1594) + lu(k,1631) = lu(k,1631) - lu(k,910) * lu(k,1594) + lu(k,1963) = lu(k,1963) - lu(k,899) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,900) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,901) * lu(k,1962) + lu(k,1969) = lu(k,1969) - lu(k,902) * lu(k,1962) + lu(k,1979) = lu(k,1979) - lu(k,903) * lu(k,1962) + lu(k,1981) = lu(k,1981) - lu(k,904) * lu(k,1962) + lu(k,1984) = lu(k,1984) - lu(k,905) * lu(k,1962) + lu(k,1987) = lu(k,1987) - lu(k,906) * lu(k,1962) + lu(k,1988) = lu(k,1988) - lu(k,907) * lu(k,1962) + lu(k,1991) = lu(k,1991) - lu(k,908) * lu(k,1962) + lu(k,1995) = lu(k,1995) - lu(k,909) * lu(k,1962) + lu(k,1997) = lu(k,1997) - lu(k,910) * lu(k,1962) + end do + end subroutine lu_fac19 + subroutine lu_fac20( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,911) = 1._r8 / lu(k,911) + lu(k,912) = lu(k,912) * lu(k,911) + lu(k,913) = lu(k,913) * lu(k,911) + lu(k,914) = lu(k,914) * lu(k,911) + lu(k,934) = - lu(k,912) * lu(k,927) + lu(k,935) = lu(k,935) - lu(k,913) * lu(k,927) + lu(k,937) = lu(k,937) - lu(k,914) * lu(k,927) + lu(k,954) = - lu(k,912) * lu(k,949) + lu(k,955) = lu(k,955) - lu(k,913) * lu(k,949) + lu(k,956) = lu(k,956) - lu(k,914) * lu(k,949) + lu(k,973) = - lu(k,912) * lu(k,967) + lu(k,974) = lu(k,974) - lu(k,913) * lu(k,967) + lu(k,976) = lu(k,976) - lu(k,914) * lu(k,967) + lu(k,999) = - lu(k,912) * lu(k,995) + lu(k,1000) = lu(k,1000) - lu(k,913) * lu(k,995) + lu(k,1002) = lu(k,1002) - lu(k,914) * lu(k,995) + lu(k,1027) = - lu(k,912) * lu(k,1022) + lu(k,1028) = lu(k,1028) - lu(k,913) * lu(k,1022) + lu(k,1030) = lu(k,1030) - lu(k,914) * lu(k,1022) + lu(k,1050) = - lu(k,912) * lu(k,1042) + lu(k,1051) = lu(k,1051) - lu(k,913) * lu(k,1042) + lu(k,1053) = lu(k,1053) - lu(k,914) * lu(k,1042) + lu(k,1065) = - lu(k,912) * lu(k,1059) + lu(k,1066) = lu(k,1066) - lu(k,913) * lu(k,1059) + lu(k,1067) = lu(k,1067) - lu(k,914) * lu(k,1059) + lu(k,1075) = - lu(k,912) * lu(k,1071) + lu(k,1076) = lu(k,1076) - lu(k,913) * lu(k,1071) + lu(k,1078) = lu(k,1078) - lu(k,914) * lu(k,1071) + lu(k,1114) = - lu(k,912) * lu(k,1101) + lu(k,1115) = lu(k,1115) - lu(k,913) * lu(k,1101) + lu(k,1117) = lu(k,1117) - lu(k,914) * lu(k,1101) + lu(k,1134) = - lu(k,912) * lu(k,1126) + lu(k,1135) = lu(k,1135) - lu(k,913) * lu(k,1126) + lu(k,1137) = lu(k,1137) - lu(k,914) * lu(k,1126) + lu(k,1157) = - lu(k,912) * lu(k,1148) + lu(k,1158) = lu(k,1158) - lu(k,913) * lu(k,1148) + lu(k,1160) = lu(k,1160) - lu(k,914) * lu(k,1148) + lu(k,1190) = - lu(k,912) * lu(k,1177) + lu(k,1191) = lu(k,1191) - lu(k,913) * lu(k,1177) + lu(k,1193) = lu(k,1193) - lu(k,914) * lu(k,1177) + lu(k,1238) = - lu(k,912) * lu(k,1225) + lu(k,1239) = lu(k,1239) - lu(k,913) * lu(k,1225) + lu(k,1241) = lu(k,1241) - lu(k,914) * lu(k,1225) + lu(k,1251) = lu(k,1251) - lu(k,912) * lu(k,1249) + lu(k,1252) = lu(k,1252) - lu(k,913) * lu(k,1249) + lu(k,1254) = lu(k,1254) - lu(k,914) * lu(k,1249) + lu(k,1388) = lu(k,1388) - lu(k,912) * lu(k,1368) + lu(k,1390) = lu(k,1390) - lu(k,913) * lu(k,1368) + lu(k,1393) = lu(k,1393) - lu(k,914) * lu(k,1368) + lu(k,1445) = - lu(k,912) * lu(k,1425) + lu(k,1447) = lu(k,1447) - lu(k,913) * lu(k,1425) + lu(k,1450) = lu(k,1450) - lu(k,914) * lu(k,1425) + lu(k,1616) = lu(k,1616) - lu(k,912) * lu(k,1595) + lu(k,1618) = lu(k,1618) - lu(k,913) * lu(k,1595) + lu(k,1621) = lu(k,1621) - lu(k,914) * lu(k,1595) + lu(k,1666) = lu(k,1666) - lu(k,912) * lu(k,1648) + lu(k,1668) = lu(k,1668) - lu(k,913) * lu(k,1648) + lu(k,1671) = lu(k,1671) - lu(k,914) * lu(k,1648) + lu(k,1726) = lu(k,1726) - lu(k,912) * lu(k,1720) + lu(k,1728) = lu(k,1728) - lu(k,913) * lu(k,1720) + lu(k,1731) = lu(k,1731) - lu(k,914) * lu(k,1720) + lu(k,1767) = lu(k,1767) - lu(k,912) * lu(k,1759) + lu(k,1769) = lu(k,1769) - lu(k,913) * lu(k,1759) + lu(k,1772) = lu(k,1772) - lu(k,914) * lu(k,1759) + lu(k,1827) = lu(k,1827) - lu(k,912) * lu(k,1808) + lu(k,1829) = lu(k,1829) - lu(k,913) * lu(k,1808) + lu(k,1832) = lu(k,1832) - lu(k,914) * lu(k,1808) + lu(k,1881) = lu(k,1881) - lu(k,912) * lu(k,1876) + lu(k,1883) = lu(k,1883) - lu(k,913) * lu(k,1876) + lu(k,1886) = lu(k,1886) - lu(k,914) * lu(k,1876) + lu(k,1904) = lu(k,1904) - lu(k,912) * lu(k,1900) + lu(k,1906) = lu(k,1906) - lu(k,913) * lu(k,1900) + lu(k,1909) = lu(k,1909) - lu(k,914) * lu(k,1900) + lu(k,1982) = lu(k,1982) - lu(k,912) * lu(k,1963) + lu(k,1984) = lu(k,1984) - lu(k,913) * lu(k,1963) + lu(k,1987) = lu(k,1987) - lu(k,914) * lu(k,1963) + lu(k,915) = 1._r8 / lu(k,915) + lu(k,916) = lu(k,916) * lu(k,915) + lu(k,917) = lu(k,917) * lu(k,915) + lu(k,918) = lu(k,918) * lu(k,915) + lu(k,919) = lu(k,919) * lu(k,915) + lu(k,920) = lu(k,920) * lu(k,915) + lu(k,986) = lu(k,986) - lu(k,916) * lu(k,984) + lu(k,987) = lu(k,987) - lu(k,917) * lu(k,984) + lu(k,988) = lu(k,988) - lu(k,918) * lu(k,984) + lu(k,989) = lu(k,989) - lu(k,919) * lu(k,984) + lu(k,992) = lu(k,992) - lu(k,920) * lu(k,984) + lu(k,1025) = lu(k,1025) - lu(k,916) * lu(k,1023) + lu(k,1026) = lu(k,1026) - lu(k,917) * lu(k,1023) + lu(k,1028) = lu(k,1028) - lu(k,918) * lu(k,1023) + lu(k,1030) = lu(k,1030) - lu(k,919) * lu(k,1023) + lu(k,1033) = lu(k,1033) - lu(k,920) * lu(k,1023) + lu(k,1107) = - lu(k,916) * lu(k,1102) + lu(k,1112) = lu(k,1112) - lu(k,917) * lu(k,1102) + lu(k,1115) = lu(k,1115) - lu(k,918) * lu(k,1102) + lu(k,1117) = lu(k,1117) - lu(k,919) * lu(k,1102) + lu(k,1121) = lu(k,1121) - lu(k,920) * lu(k,1102) + lu(k,1129) = lu(k,1129) - lu(k,916) * lu(k,1127) + lu(k,1132) = lu(k,1132) - lu(k,917) * lu(k,1127) + lu(k,1135) = lu(k,1135) - lu(k,918) * lu(k,1127) + lu(k,1137) = lu(k,1137) - lu(k,919) * lu(k,1127) + lu(k,1141) = lu(k,1141) - lu(k,920) * lu(k,1127) + lu(k,1152) = lu(k,1152) - lu(k,916) * lu(k,1149) + lu(k,1155) = lu(k,1155) - lu(k,917) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,918) * lu(k,1149) + lu(k,1160) = lu(k,1160) - lu(k,919) * lu(k,1149) + lu(k,1163) = lu(k,1163) - lu(k,920) * lu(k,1149) + lu(k,1183) = lu(k,1183) - lu(k,916) * lu(k,1178) + lu(k,1188) = lu(k,1188) - lu(k,917) * lu(k,1178) + lu(k,1191) = lu(k,1191) - lu(k,918) * lu(k,1178) + lu(k,1193) = lu(k,1193) - lu(k,919) * lu(k,1178) + lu(k,1197) = lu(k,1197) - lu(k,920) * lu(k,1178) + lu(k,1204) = - lu(k,916) * lu(k,1203) + lu(k,1206) = lu(k,1206) - lu(k,917) * lu(k,1203) + lu(k,1209) = lu(k,1209) - lu(k,918) * lu(k,1203) + lu(k,1211) = lu(k,1211) - lu(k,919) * lu(k,1203) + lu(k,1215) = lu(k,1215) - lu(k,920) * lu(k,1203) + lu(k,1230) = lu(k,1230) - lu(k,916) * lu(k,1226) + lu(k,1236) = lu(k,1236) - lu(k,917) * lu(k,1226) + lu(k,1239) = lu(k,1239) - lu(k,918) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,919) * lu(k,1226) + lu(k,1245) = lu(k,1245) - lu(k,920) * lu(k,1226) + lu(k,1379) = lu(k,1379) - lu(k,916) * lu(k,1369) + lu(k,1385) = lu(k,1385) - lu(k,917) * lu(k,1369) + lu(k,1390) = lu(k,1390) - lu(k,918) * lu(k,1369) + lu(k,1393) = lu(k,1393) - lu(k,919) * lu(k,1369) + lu(k,1401) = lu(k,1401) - lu(k,920) * lu(k,1369) + lu(k,1435) = lu(k,1435) - lu(k,916) * lu(k,1426) + lu(k,1442) = lu(k,1442) - lu(k,917) * lu(k,1426) + lu(k,1447) = lu(k,1447) - lu(k,918) * lu(k,1426) + lu(k,1450) = lu(k,1450) - lu(k,919) * lu(k,1426) + lu(k,1458) = lu(k,1458) - lu(k,920) * lu(k,1426) + lu(k,1606) = lu(k,1606) - lu(k,916) * lu(k,1596) + lu(k,1613) = lu(k,1613) - lu(k,917) * lu(k,1596) + lu(k,1618) = lu(k,1618) - lu(k,918) * lu(k,1596) + lu(k,1621) = lu(k,1621) - lu(k,919) * lu(k,1596) + lu(k,1629) = lu(k,1629) - lu(k,920) * lu(k,1596) + lu(k,1658) = lu(k,1658) - lu(k,916) * lu(k,1649) + lu(k,1664) = lu(k,1664) - lu(k,917) * lu(k,1649) + lu(k,1668) = lu(k,1668) - lu(k,918) * lu(k,1649) + lu(k,1671) = lu(k,1671) - lu(k,919) * lu(k,1649) + lu(k,1679) = lu(k,1679) - lu(k,920) * lu(k,1649) + lu(k,1761) = lu(k,1761) - lu(k,916) * lu(k,1760) + lu(k,1764) = lu(k,1764) - lu(k,917) * lu(k,1760) + lu(k,1769) = lu(k,1769) - lu(k,918) * lu(k,1760) + lu(k,1772) = lu(k,1772) - lu(k,919) * lu(k,1760) + lu(k,1780) = lu(k,1780) - lu(k,920) * lu(k,1760) + lu(k,1817) = lu(k,1817) - lu(k,916) * lu(k,1809) + lu(k,1824) = lu(k,1824) - lu(k,917) * lu(k,1809) + lu(k,1829) = lu(k,1829) - lu(k,918) * lu(k,1809) + lu(k,1832) = lu(k,1832) - lu(k,919) * lu(k,1809) + lu(k,1840) = lu(k,1840) - lu(k,920) * lu(k,1809) + lu(k,1973) = lu(k,1973) - lu(k,916) * lu(k,1964) + lu(k,1979) = lu(k,1979) - lu(k,917) * lu(k,1964) + lu(k,1984) = lu(k,1984) - lu(k,918) * lu(k,1964) + lu(k,1987) = lu(k,1987) - lu(k,919) * lu(k,1964) + lu(k,1995) = lu(k,1995) - lu(k,920) * lu(k,1964) + lu(k,928) = 1._r8 / lu(k,928) + lu(k,929) = lu(k,929) * lu(k,928) + lu(k,930) = lu(k,930) * lu(k,928) + lu(k,931) = lu(k,931) * lu(k,928) + lu(k,932) = lu(k,932) * lu(k,928) + lu(k,933) = lu(k,933) * lu(k,928) + lu(k,934) = lu(k,934) * lu(k,928) + lu(k,935) = lu(k,935) * lu(k,928) + lu(k,936) = lu(k,936) * lu(k,928) + lu(k,937) = lu(k,937) * lu(k,928) + lu(k,938) = lu(k,938) * lu(k,928) + lu(k,939) = lu(k,939) * lu(k,928) + lu(k,940) = lu(k,940) * lu(k,928) + lu(k,941) = lu(k,941) * lu(k,928) + lu(k,942) = lu(k,942) * lu(k,928) + lu(k,1371) = lu(k,1371) - lu(k,929) * lu(k,1370) + lu(k,1372) = lu(k,1372) - lu(k,930) * lu(k,1370) + lu(k,1373) = lu(k,1373) - lu(k,931) * lu(k,1370) + lu(k,1385) = lu(k,1385) - lu(k,932) * lu(k,1370) + lu(k,1387) = lu(k,1387) - lu(k,933) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,934) * lu(k,1370) + lu(k,1390) = lu(k,1390) - lu(k,935) * lu(k,1370) + lu(k,1391) = lu(k,1391) - lu(k,936) * lu(k,1370) + lu(k,1393) = lu(k,1393) - lu(k,937) * lu(k,1370) + lu(k,1394) = lu(k,1394) - lu(k,938) * lu(k,1370) + lu(k,1397) = lu(k,1397) - lu(k,939) * lu(k,1370) + lu(k,1401) = lu(k,1401) - lu(k,940) * lu(k,1370) + lu(k,1402) = lu(k,1402) - lu(k,941) * lu(k,1370) + lu(k,1403) = lu(k,1403) - lu(k,942) * lu(k,1370) + lu(k,1428) = lu(k,1428) - lu(k,929) * lu(k,1427) + lu(k,1429) = lu(k,1429) - lu(k,930) * lu(k,1427) + lu(k,1430) = lu(k,1430) - lu(k,931) * lu(k,1427) + lu(k,1442) = lu(k,1442) - lu(k,932) * lu(k,1427) + lu(k,1444) = lu(k,1444) - lu(k,933) * lu(k,1427) + lu(k,1445) = lu(k,1445) - lu(k,934) * lu(k,1427) + lu(k,1447) = lu(k,1447) - lu(k,935) * lu(k,1427) + lu(k,1448) = lu(k,1448) - lu(k,936) * lu(k,1427) + lu(k,1450) = lu(k,1450) - lu(k,937) * lu(k,1427) + lu(k,1451) = lu(k,1451) - lu(k,938) * lu(k,1427) + lu(k,1454) = lu(k,1454) - lu(k,939) * lu(k,1427) + lu(k,1458) = lu(k,1458) - lu(k,940) * lu(k,1427) + lu(k,1459) = lu(k,1459) - lu(k,941) * lu(k,1427) + lu(k,1460) = lu(k,1460) - lu(k,942) * lu(k,1427) + lu(k,1598) = lu(k,1598) - lu(k,929) * lu(k,1597) + lu(k,1599) = lu(k,1599) - lu(k,930) * lu(k,1597) + lu(k,1600) = lu(k,1600) - lu(k,931) * lu(k,1597) + lu(k,1613) = lu(k,1613) - lu(k,932) * lu(k,1597) + lu(k,1615) = lu(k,1615) - lu(k,933) * lu(k,1597) + lu(k,1616) = lu(k,1616) - lu(k,934) * lu(k,1597) + lu(k,1618) = lu(k,1618) - lu(k,935) * lu(k,1597) + lu(k,1619) = lu(k,1619) - lu(k,936) * lu(k,1597) + lu(k,1621) = lu(k,1621) - lu(k,937) * lu(k,1597) + lu(k,1622) = lu(k,1622) - lu(k,938) * lu(k,1597) + lu(k,1625) = lu(k,1625) - lu(k,939) * lu(k,1597) + lu(k,1629) = lu(k,1629) - lu(k,940) * lu(k,1597) + lu(k,1630) = lu(k,1630) - lu(k,941) * lu(k,1597) + lu(k,1631) = lu(k,1631) - lu(k,942) * lu(k,1597) + lu(k,1651) = lu(k,1651) - lu(k,929) * lu(k,1650) + lu(k,1652) = lu(k,1652) - lu(k,930) * lu(k,1650) + lu(k,1653) = lu(k,1653) - lu(k,931) * lu(k,1650) + lu(k,1664) = lu(k,1664) - lu(k,932) * lu(k,1650) + lu(k,1665) = lu(k,1665) - lu(k,933) * lu(k,1650) + lu(k,1666) = lu(k,1666) - lu(k,934) * lu(k,1650) + lu(k,1668) = lu(k,1668) - lu(k,935) * lu(k,1650) + lu(k,1669) = lu(k,1669) - lu(k,936) * lu(k,1650) + lu(k,1671) = lu(k,1671) - lu(k,937) * lu(k,1650) + lu(k,1672) = lu(k,1672) - lu(k,938) * lu(k,1650) + lu(k,1675) = lu(k,1675) - lu(k,939) * lu(k,1650) + lu(k,1679) = lu(k,1679) - lu(k,940) * lu(k,1650) + lu(k,1680) = lu(k,1680) - lu(k,941) * lu(k,1650) + lu(k,1681) = lu(k,1681) - lu(k,942) * lu(k,1650) + lu(k,1811) = lu(k,1811) - lu(k,929) * lu(k,1810) + lu(k,1812) = lu(k,1812) - lu(k,930) * lu(k,1810) + lu(k,1813) = lu(k,1813) - lu(k,931) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,932) * lu(k,1810) + lu(k,1826) = - lu(k,933) * lu(k,1810) + lu(k,1827) = lu(k,1827) - lu(k,934) * lu(k,1810) + lu(k,1829) = lu(k,1829) - lu(k,935) * lu(k,1810) + lu(k,1830) = lu(k,1830) - lu(k,936) * lu(k,1810) + lu(k,1832) = lu(k,1832) - lu(k,937) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,938) * lu(k,1810) + lu(k,1836) = lu(k,1836) - lu(k,939) * lu(k,1810) + lu(k,1840) = lu(k,1840) - lu(k,940) * lu(k,1810) + lu(k,1841) = lu(k,1841) - lu(k,941) * lu(k,1810) + lu(k,1842) = lu(k,1842) - lu(k,942) * lu(k,1810) + lu(k,1966) = lu(k,1966) - lu(k,929) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,930) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,931) * lu(k,1965) + lu(k,1979) = lu(k,1979) - lu(k,932) * lu(k,1965) + lu(k,1981) = lu(k,1981) - lu(k,933) * lu(k,1965) + lu(k,1982) = lu(k,1982) - lu(k,934) * lu(k,1965) + lu(k,1984) = lu(k,1984) - lu(k,935) * lu(k,1965) + lu(k,1985) = lu(k,1985) - lu(k,936) * lu(k,1965) + lu(k,1987) = lu(k,1987) - lu(k,937) * lu(k,1965) + lu(k,1988) = lu(k,1988) - lu(k,938) * lu(k,1965) + lu(k,1991) = lu(k,1991) - lu(k,939) * lu(k,1965) + lu(k,1995) = lu(k,1995) - lu(k,940) * lu(k,1965) + lu(k,1996) = lu(k,1996) - lu(k,941) * lu(k,1965) + lu(k,1997) = lu(k,1997) - lu(k,942) * lu(k,1965) + lu(k,950) = 1._r8 / lu(k,950) + lu(k,951) = lu(k,951) * lu(k,950) + lu(k,952) = lu(k,952) * lu(k,950) + lu(k,953) = lu(k,953) * lu(k,950) + lu(k,954) = lu(k,954) * lu(k,950) + lu(k,955) = lu(k,955) * lu(k,950) + lu(k,956) = lu(k,956) * lu(k,950) + lu(k,957) = lu(k,957) * lu(k,950) + lu(k,958) = lu(k,958) * lu(k,950) + lu(k,959) = lu(k,959) * lu(k,950) + lu(k,960) = lu(k,960) * lu(k,950) + lu(k,961) = lu(k,961) * lu(k,950) + lu(k,970) = lu(k,970) - lu(k,951) * lu(k,968) + lu(k,971) = lu(k,971) - lu(k,952) * lu(k,968) + lu(k,972) = lu(k,972) - lu(k,953) * lu(k,968) + lu(k,973) = lu(k,973) - lu(k,954) * lu(k,968) + lu(k,974) = lu(k,974) - lu(k,955) * lu(k,968) + lu(k,976) = lu(k,976) - lu(k,956) * lu(k,968) + lu(k,977) = lu(k,977) - lu(k,957) * lu(k,968) + lu(k,978) = lu(k,978) - lu(k,958) * lu(k,968) + lu(k,979) = lu(k,979) - lu(k,959) * lu(k,968) + lu(k,980) = lu(k,980) - lu(k,960) * lu(k,968) + lu(k,981) = lu(k,981) - lu(k,961) * lu(k,968) + lu(k,1373) = lu(k,1373) - lu(k,951) * lu(k,1371) + lu(k,1385) = lu(k,1385) - lu(k,952) * lu(k,1371) + lu(k,1387) = lu(k,1387) - lu(k,953) * lu(k,1371) + lu(k,1388) = lu(k,1388) - lu(k,954) * lu(k,1371) + lu(k,1390) = lu(k,1390) - lu(k,955) * lu(k,1371) + lu(k,1393) = lu(k,1393) - lu(k,956) * lu(k,1371) + lu(k,1394) = lu(k,1394) - lu(k,957) * lu(k,1371) + lu(k,1397) = lu(k,1397) - lu(k,958) * lu(k,1371) + lu(k,1401) = lu(k,1401) - lu(k,959) * lu(k,1371) + lu(k,1402) = lu(k,1402) - lu(k,960) * lu(k,1371) + lu(k,1403) = lu(k,1403) - lu(k,961) * lu(k,1371) + lu(k,1430) = lu(k,1430) - lu(k,951) * lu(k,1428) + lu(k,1442) = lu(k,1442) - lu(k,952) * lu(k,1428) + lu(k,1444) = lu(k,1444) - lu(k,953) * lu(k,1428) + lu(k,1445) = lu(k,1445) - lu(k,954) * lu(k,1428) + lu(k,1447) = lu(k,1447) - lu(k,955) * lu(k,1428) + lu(k,1450) = lu(k,1450) - lu(k,956) * lu(k,1428) + lu(k,1451) = lu(k,1451) - lu(k,957) * lu(k,1428) + lu(k,1454) = lu(k,1454) - lu(k,958) * lu(k,1428) + lu(k,1458) = lu(k,1458) - lu(k,959) * lu(k,1428) + lu(k,1459) = lu(k,1459) - lu(k,960) * lu(k,1428) + lu(k,1460) = lu(k,1460) - lu(k,961) * lu(k,1428) + lu(k,1600) = lu(k,1600) - lu(k,951) * lu(k,1598) + lu(k,1613) = lu(k,1613) - lu(k,952) * lu(k,1598) + lu(k,1615) = lu(k,1615) - lu(k,953) * lu(k,1598) + lu(k,1616) = lu(k,1616) - lu(k,954) * lu(k,1598) + lu(k,1618) = lu(k,1618) - lu(k,955) * lu(k,1598) + lu(k,1621) = lu(k,1621) - lu(k,956) * lu(k,1598) + lu(k,1622) = lu(k,1622) - lu(k,957) * lu(k,1598) + lu(k,1625) = lu(k,1625) - lu(k,958) * lu(k,1598) + lu(k,1629) = lu(k,1629) - lu(k,959) * lu(k,1598) + lu(k,1630) = lu(k,1630) - lu(k,960) * lu(k,1598) + lu(k,1631) = lu(k,1631) - lu(k,961) * lu(k,1598) + lu(k,1653) = lu(k,1653) - lu(k,951) * lu(k,1651) + lu(k,1664) = lu(k,1664) - lu(k,952) * lu(k,1651) + lu(k,1665) = lu(k,1665) - lu(k,953) * lu(k,1651) + lu(k,1666) = lu(k,1666) - lu(k,954) * lu(k,1651) + lu(k,1668) = lu(k,1668) - lu(k,955) * lu(k,1651) + lu(k,1671) = lu(k,1671) - lu(k,956) * lu(k,1651) + lu(k,1672) = lu(k,1672) - lu(k,957) * lu(k,1651) + lu(k,1675) = lu(k,1675) - lu(k,958) * lu(k,1651) + lu(k,1679) = lu(k,1679) - lu(k,959) * lu(k,1651) + lu(k,1680) = lu(k,1680) - lu(k,960) * lu(k,1651) + lu(k,1681) = lu(k,1681) - lu(k,961) * lu(k,1651) + lu(k,1813) = lu(k,1813) - lu(k,951) * lu(k,1811) + lu(k,1824) = lu(k,1824) - lu(k,952) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,953) * lu(k,1811) + lu(k,1827) = lu(k,1827) - lu(k,954) * lu(k,1811) + lu(k,1829) = lu(k,1829) - lu(k,955) * lu(k,1811) + lu(k,1832) = lu(k,1832) - lu(k,956) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,957) * lu(k,1811) + lu(k,1836) = lu(k,1836) - lu(k,958) * lu(k,1811) + lu(k,1840) = lu(k,1840) - lu(k,959) * lu(k,1811) + lu(k,1841) = lu(k,1841) - lu(k,960) * lu(k,1811) + lu(k,1842) = lu(k,1842) - lu(k,961) * lu(k,1811) + lu(k,1968) = lu(k,1968) - lu(k,951) * lu(k,1966) + lu(k,1979) = lu(k,1979) - lu(k,952) * lu(k,1966) + lu(k,1981) = lu(k,1981) - lu(k,953) * lu(k,1966) + lu(k,1982) = lu(k,1982) - lu(k,954) * lu(k,1966) + lu(k,1984) = lu(k,1984) - lu(k,955) * lu(k,1966) + lu(k,1987) = lu(k,1987) - lu(k,956) * lu(k,1966) + lu(k,1988) = lu(k,1988) - lu(k,957) * lu(k,1966) + lu(k,1991) = lu(k,1991) - lu(k,958) * lu(k,1966) + lu(k,1995) = lu(k,1995) - lu(k,959) * lu(k,1966) + lu(k,1996) = lu(k,1996) - lu(k,960) * lu(k,1966) + lu(k,1997) = lu(k,1997) - lu(k,961) * lu(k,1966) + end do + end subroutine lu_fac20 + subroutine lu_fac21( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,969) = 1._r8 / lu(k,969) + lu(k,970) = lu(k,970) * lu(k,969) + lu(k,971) = lu(k,971) * lu(k,969) + lu(k,972) = lu(k,972) * lu(k,969) + lu(k,973) = lu(k,973) * lu(k,969) + lu(k,974) = lu(k,974) * lu(k,969) + lu(k,975) = lu(k,975) * lu(k,969) + lu(k,976) = lu(k,976) * lu(k,969) + lu(k,977) = lu(k,977) * lu(k,969) + lu(k,978) = lu(k,978) * lu(k,969) + lu(k,979) = lu(k,979) * lu(k,969) + lu(k,980) = lu(k,980) * lu(k,969) + lu(k,981) = lu(k,981) * lu(k,969) + lu(k,1373) = lu(k,1373) - lu(k,970) * lu(k,1372) + lu(k,1385) = lu(k,1385) - lu(k,971) * lu(k,1372) + lu(k,1387) = lu(k,1387) - lu(k,972) * lu(k,1372) + lu(k,1388) = lu(k,1388) - lu(k,973) * lu(k,1372) + lu(k,1390) = lu(k,1390) - lu(k,974) * lu(k,1372) + lu(k,1391) = lu(k,1391) - lu(k,975) * lu(k,1372) + lu(k,1393) = lu(k,1393) - lu(k,976) * lu(k,1372) + lu(k,1394) = lu(k,1394) - lu(k,977) * lu(k,1372) + lu(k,1397) = lu(k,1397) - lu(k,978) * lu(k,1372) + lu(k,1401) = lu(k,1401) - lu(k,979) * lu(k,1372) + lu(k,1402) = lu(k,1402) - lu(k,980) * lu(k,1372) + lu(k,1403) = lu(k,1403) - lu(k,981) * lu(k,1372) + lu(k,1430) = lu(k,1430) - lu(k,970) * lu(k,1429) + lu(k,1442) = lu(k,1442) - lu(k,971) * lu(k,1429) + lu(k,1444) = lu(k,1444) - lu(k,972) * lu(k,1429) + lu(k,1445) = lu(k,1445) - lu(k,973) * lu(k,1429) + lu(k,1447) = lu(k,1447) - lu(k,974) * lu(k,1429) + lu(k,1448) = lu(k,1448) - lu(k,975) * lu(k,1429) + lu(k,1450) = lu(k,1450) - lu(k,976) * lu(k,1429) + lu(k,1451) = lu(k,1451) - lu(k,977) * lu(k,1429) + lu(k,1454) = lu(k,1454) - lu(k,978) * lu(k,1429) + lu(k,1458) = lu(k,1458) - lu(k,979) * lu(k,1429) + lu(k,1459) = lu(k,1459) - lu(k,980) * lu(k,1429) + lu(k,1460) = lu(k,1460) - lu(k,981) * lu(k,1429) + lu(k,1600) = lu(k,1600) - lu(k,970) * lu(k,1599) + lu(k,1613) = lu(k,1613) - lu(k,971) * lu(k,1599) + lu(k,1615) = lu(k,1615) - lu(k,972) * lu(k,1599) + lu(k,1616) = lu(k,1616) - lu(k,973) * lu(k,1599) + lu(k,1618) = lu(k,1618) - lu(k,974) * lu(k,1599) + lu(k,1619) = lu(k,1619) - lu(k,975) * lu(k,1599) + lu(k,1621) = lu(k,1621) - lu(k,976) * lu(k,1599) + lu(k,1622) = lu(k,1622) - lu(k,977) * lu(k,1599) + lu(k,1625) = lu(k,1625) - lu(k,978) * lu(k,1599) + lu(k,1629) = lu(k,1629) - lu(k,979) * lu(k,1599) + lu(k,1630) = lu(k,1630) - lu(k,980) * lu(k,1599) + lu(k,1631) = lu(k,1631) - lu(k,981) * lu(k,1599) + lu(k,1653) = lu(k,1653) - lu(k,970) * lu(k,1652) + lu(k,1664) = lu(k,1664) - lu(k,971) * lu(k,1652) + lu(k,1665) = lu(k,1665) - lu(k,972) * lu(k,1652) + lu(k,1666) = lu(k,1666) - lu(k,973) * lu(k,1652) + lu(k,1668) = lu(k,1668) - lu(k,974) * lu(k,1652) + lu(k,1669) = lu(k,1669) - lu(k,975) * lu(k,1652) + lu(k,1671) = lu(k,1671) - lu(k,976) * lu(k,1652) + lu(k,1672) = lu(k,1672) - lu(k,977) * lu(k,1652) + lu(k,1675) = lu(k,1675) - lu(k,978) * lu(k,1652) + lu(k,1679) = lu(k,1679) - lu(k,979) * lu(k,1652) + lu(k,1680) = lu(k,1680) - lu(k,980) * lu(k,1652) + lu(k,1681) = lu(k,1681) - lu(k,981) * lu(k,1652) + lu(k,1813) = lu(k,1813) - lu(k,970) * lu(k,1812) + lu(k,1824) = lu(k,1824) - lu(k,971) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,972) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,973) * lu(k,1812) + lu(k,1829) = lu(k,1829) - lu(k,974) * lu(k,1812) + lu(k,1830) = lu(k,1830) - lu(k,975) * lu(k,1812) + lu(k,1832) = lu(k,1832) - lu(k,976) * lu(k,1812) + lu(k,1833) = lu(k,1833) - lu(k,977) * lu(k,1812) + lu(k,1836) = lu(k,1836) - lu(k,978) * lu(k,1812) + lu(k,1840) = lu(k,1840) - lu(k,979) * lu(k,1812) + lu(k,1841) = lu(k,1841) - lu(k,980) * lu(k,1812) + lu(k,1842) = lu(k,1842) - lu(k,981) * lu(k,1812) + lu(k,1968) = lu(k,1968) - lu(k,970) * lu(k,1967) + lu(k,1979) = lu(k,1979) - lu(k,971) * lu(k,1967) + lu(k,1981) = lu(k,1981) - lu(k,972) * lu(k,1967) + lu(k,1982) = lu(k,1982) - lu(k,973) * lu(k,1967) + lu(k,1984) = lu(k,1984) - lu(k,974) * lu(k,1967) + lu(k,1985) = lu(k,1985) - lu(k,975) * lu(k,1967) + lu(k,1987) = lu(k,1987) - lu(k,976) * lu(k,1967) + lu(k,1988) = lu(k,1988) - lu(k,977) * lu(k,1967) + lu(k,1991) = lu(k,1991) - lu(k,978) * lu(k,1967) + lu(k,1995) = lu(k,1995) - lu(k,979) * lu(k,1967) + lu(k,1996) = lu(k,1996) - lu(k,980) * lu(k,1967) + lu(k,1997) = lu(k,1997) - lu(k,981) * lu(k,1967) + lu(k,985) = 1._r8 / lu(k,985) + lu(k,986) = lu(k,986) * lu(k,985) + lu(k,987) = lu(k,987) * lu(k,985) + lu(k,988) = lu(k,988) * lu(k,985) + lu(k,989) = lu(k,989) * lu(k,985) + lu(k,990) = lu(k,990) * lu(k,985) + lu(k,991) = lu(k,991) * lu(k,985) + lu(k,992) = lu(k,992) * lu(k,985) + lu(k,993) = lu(k,993) * lu(k,985) + lu(k,994) = lu(k,994) * lu(k,985) + lu(k,1107) = lu(k,1107) - lu(k,986) * lu(k,1103) + lu(k,1112) = lu(k,1112) - lu(k,987) * lu(k,1103) + lu(k,1115) = lu(k,1115) - lu(k,988) * lu(k,1103) + lu(k,1117) = lu(k,1117) - lu(k,989) * lu(k,1103) + lu(k,1118) = lu(k,1118) - lu(k,990) * lu(k,1103) + lu(k,1119) = lu(k,1119) - lu(k,991) * lu(k,1103) + lu(k,1121) = lu(k,1121) - lu(k,992) * lu(k,1103) + lu(k,1122) = lu(k,1122) - lu(k,993) * lu(k,1103) + lu(k,1123) = lu(k,1123) - lu(k,994) * lu(k,1103) + lu(k,1152) = lu(k,1152) - lu(k,986) * lu(k,1150) + lu(k,1155) = lu(k,1155) - lu(k,987) * lu(k,1150) + lu(k,1158) = lu(k,1158) - lu(k,988) * lu(k,1150) + lu(k,1160) = lu(k,1160) - lu(k,989) * lu(k,1150) + lu(k,1161) = lu(k,1161) - lu(k,990) * lu(k,1150) + lu(k,1162) = lu(k,1162) - lu(k,991) * lu(k,1150) + lu(k,1163) = lu(k,1163) - lu(k,992) * lu(k,1150) + lu(k,1164) = lu(k,1164) - lu(k,993) * lu(k,1150) + lu(k,1165) = lu(k,1165) - lu(k,994) * lu(k,1150) + lu(k,1183) = lu(k,1183) - lu(k,986) * lu(k,1179) + lu(k,1188) = lu(k,1188) - lu(k,987) * lu(k,1179) + lu(k,1191) = lu(k,1191) - lu(k,988) * lu(k,1179) + lu(k,1193) = lu(k,1193) - lu(k,989) * lu(k,1179) + lu(k,1194) = lu(k,1194) - lu(k,990) * lu(k,1179) + lu(k,1195) = lu(k,1195) - lu(k,991) * lu(k,1179) + lu(k,1197) = lu(k,1197) - lu(k,992) * lu(k,1179) + lu(k,1198) = lu(k,1198) - lu(k,993) * lu(k,1179) + lu(k,1199) = lu(k,1199) - lu(k,994) * lu(k,1179) + lu(k,1379) = lu(k,1379) - lu(k,986) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,987) * lu(k,1373) + lu(k,1390) = lu(k,1390) - lu(k,988) * lu(k,1373) + lu(k,1393) = lu(k,1393) - lu(k,989) * lu(k,1373) + lu(k,1394) = lu(k,1394) - lu(k,990) * lu(k,1373) + lu(k,1397) = lu(k,1397) - lu(k,991) * lu(k,1373) + lu(k,1401) = lu(k,1401) - lu(k,992) * lu(k,1373) + lu(k,1402) = lu(k,1402) - lu(k,993) * lu(k,1373) + lu(k,1403) = lu(k,1403) - lu(k,994) * lu(k,1373) + lu(k,1435) = lu(k,1435) - lu(k,986) * lu(k,1430) + lu(k,1442) = lu(k,1442) - lu(k,987) * lu(k,1430) + lu(k,1447) = lu(k,1447) - lu(k,988) * lu(k,1430) + lu(k,1450) = lu(k,1450) - lu(k,989) * lu(k,1430) + lu(k,1451) = lu(k,1451) - lu(k,990) * lu(k,1430) + lu(k,1454) = lu(k,1454) - lu(k,991) * lu(k,1430) + lu(k,1458) = lu(k,1458) - lu(k,992) * lu(k,1430) + lu(k,1459) = lu(k,1459) - lu(k,993) * lu(k,1430) + lu(k,1460) = lu(k,1460) - lu(k,994) * lu(k,1430) + lu(k,1606) = lu(k,1606) - lu(k,986) * lu(k,1600) + lu(k,1613) = lu(k,1613) - lu(k,987) * lu(k,1600) + lu(k,1618) = lu(k,1618) - lu(k,988) * lu(k,1600) + lu(k,1621) = lu(k,1621) - lu(k,989) * lu(k,1600) + lu(k,1622) = lu(k,1622) - lu(k,990) * lu(k,1600) + lu(k,1625) = lu(k,1625) - lu(k,991) * lu(k,1600) + lu(k,1629) = lu(k,1629) - lu(k,992) * lu(k,1600) + lu(k,1630) = lu(k,1630) - lu(k,993) * lu(k,1600) + lu(k,1631) = lu(k,1631) - lu(k,994) * lu(k,1600) + lu(k,1658) = lu(k,1658) - lu(k,986) * lu(k,1653) + lu(k,1664) = lu(k,1664) - lu(k,987) * lu(k,1653) + lu(k,1668) = lu(k,1668) - lu(k,988) * lu(k,1653) + lu(k,1671) = lu(k,1671) - lu(k,989) * lu(k,1653) + lu(k,1672) = lu(k,1672) - lu(k,990) * lu(k,1653) + lu(k,1675) = lu(k,1675) - lu(k,991) * lu(k,1653) + lu(k,1679) = lu(k,1679) - lu(k,992) * lu(k,1653) + lu(k,1680) = lu(k,1680) - lu(k,993) * lu(k,1653) + lu(k,1681) = lu(k,1681) - lu(k,994) * lu(k,1653) + lu(k,1817) = lu(k,1817) - lu(k,986) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,987) * lu(k,1813) + lu(k,1829) = lu(k,1829) - lu(k,988) * lu(k,1813) + lu(k,1832) = lu(k,1832) - lu(k,989) * lu(k,1813) + lu(k,1833) = lu(k,1833) - lu(k,990) * lu(k,1813) + lu(k,1836) = lu(k,1836) - lu(k,991) * lu(k,1813) + lu(k,1840) = lu(k,1840) - lu(k,992) * lu(k,1813) + lu(k,1841) = lu(k,1841) - lu(k,993) * lu(k,1813) + lu(k,1842) = lu(k,1842) - lu(k,994) * lu(k,1813) + lu(k,1973) = lu(k,1973) - lu(k,986) * lu(k,1968) + lu(k,1979) = lu(k,1979) - lu(k,987) * lu(k,1968) + lu(k,1984) = lu(k,1984) - lu(k,988) * lu(k,1968) + lu(k,1987) = lu(k,1987) - lu(k,989) * lu(k,1968) + lu(k,1988) = lu(k,1988) - lu(k,990) * lu(k,1968) + lu(k,1991) = lu(k,1991) - lu(k,991) * lu(k,1968) + lu(k,1995) = lu(k,1995) - lu(k,992) * lu(k,1968) + lu(k,1996) = lu(k,1996) - lu(k,993) * lu(k,1968) + lu(k,1997) = lu(k,1997) - lu(k,994) * lu(k,1968) + lu(k,996) = 1._r8 / lu(k,996) + lu(k,997) = lu(k,997) * lu(k,996) + lu(k,998) = lu(k,998) * lu(k,996) + lu(k,999) = lu(k,999) * lu(k,996) + lu(k,1000) = lu(k,1000) * lu(k,996) + lu(k,1001) = lu(k,1001) * lu(k,996) + lu(k,1002) = lu(k,1002) * lu(k,996) + lu(k,1003) = lu(k,1003) * lu(k,996) + lu(k,1004) = lu(k,1004) * lu(k,996) + lu(k,1112) = lu(k,1112) - lu(k,997) * lu(k,1104) + lu(k,1113) = lu(k,1113) - lu(k,998) * lu(k,1104) + lu(k,1114) = lu(k,1114) - lu(k,999) * lu(k,1104) + lu(k,1115) = lu(k,1115) - lu(k,1000) * lu(k,1104) + lu(k,1116) = lu(k,1116) - lu(k,1001) * lu(k,1104) + lu(k,1117) = lu(k,1117) - lu(k,1002) * lu(k,1104) + lu(k,1118) = lu(k,1118) - lu(k,1003) * lu(k,1104) + lu(k,1123) = lu(k,1123) - lu(k,1004) * lu(k,1104) + lu(k,1132) = lu(k,1132) - lu(k,997) * lu(k,1128) + lu(k,1133) = - lu(k,998) * lu(k,1128) + lu(k,1134) = lu(k,1134) - lu(k,999) * lu(k,1128) + lu(k,1135) = lu(k,1135) - lu(k,1000) * lu(k,1128) + lu(k,1136) = lu(k,1136) - lu(k,1001) * lu(k,1128) + lu(k,1137) = lu(k,1137) - lu(k,1002) * lu(k,1128) + lu(k,1138) = lu(k,1138) - lu(k,1003) * lu(k,1128) + lu(k,1143) = lu(k,1143) - lu(k,1004) * lu(k,1128) + lu(k,1155) = lu(k,1155) - lu(k,997) * lu(k,1151) + lu(k,1156) = lu(k,1156) - lu(k,998) * lu(k,1151) + lu(k,1157) = lu(k,1157) - lu(k,999) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,1000) * lu(k,1151) + lu(k,1159) = lu(k,1159) - lu(k,1001) * lu(k,1151) + lu(k,1160) = lu(k,1160) - lu(k,1002) * lu(k,1151) + lu(k,1161) = lu(k,1161) - lu(k,1003) * lu(k,1151) + lu(k,1165) = lu(k,1165) - lu(k,1004) * lu(k,1151) + lu(k,1188) = lu(k,1188) - lu(k,997) * lu(k,1180) + lu(k,1189) = lu(k,1189) - lu(k,998) * lu(k,1180) + lu(k,1190) = lu(k,1190) - lu(k,999) * lu(k,1180) + lu(k,1191) = lu(k,1191) - lu(k,1000) * lu(k,1180) + lu(k,1192) = lu(k,1192) - lu(k,1001) * lu(k,1180) + lu(k,1193) = lu(k,1193) - lu(k,1002) * lu(k,1180) + lu(k,1194) = lu(k,1194) - lu(k,1003) * lu(k,1180) + lu(k,1199) = lu(k,1199) - lu(k,1004) * lu(k,1180) + lu(k,1385) = lu(k,1385) - lu(k,997) * lu(k,1374) + lu(k,1387) = lu(k,1387) - lu(k,998) * lu(k,1374) + lu(k,1388) = lu(k,1388) - lu(k,999) * lu(k,1374) + lu(k,1390) = lu(k,1390) - lu(k,1000) * lu(k,1374) + lu(k,1391) = lu(k,1391) - lu(k,1001) * lu(k,1374) + lu(k,1393) = lu(k,1393) - lu(k,1002) * lu(k,1374) + lu(k,1394) = lu(k,1394) - lu(k,1003) * lu(k,1374) + lu(k,1403) = lu(k,1403) - lu(k,1004) * lu(k,1374) + lu(k,1442) = lu(k,1442) - lu(k,997) * lu(k,1431) + lu(k,1444) = lu(k,1444) - lu(k,998) * lu(k,1431) + lu(k,1445) = lu(k,1445) - lu(k,999) * lu(k,1431) + lu(k,1447) = lu(k,1447) - lu(k,1000) * lu(k,1431) + lu(k,1448) = lu(k,1448) - lu(k,1001) * lu(k,1431) + lu(k,1450) = lu(k,1450) - lu(k,1002) * lu(k,1431) + lu(k,1451) = lu(k,1451) - lu(k,1003) * lu(k,1431) + lu(k,1460) = lu(k,1460) - lu(k,1004) * lu(k,1431) + lu(k,1613) = lu(k,1613) - lu(k,997) * lu(k,1601) + lu(k,1615) = lu(k,1615) - lu(k,998) * lu(k,1601) + lu(k,1616) = lu(k,1616) - lu(k,999) * lu(k,1601) + lu(k,1618) = lu(k,1618) - lu(k,1000) * lu(k,1601) + lu(k,1619) = lu(k,1619) - lu(k,1001) * lu(k,1601) + lu(k,1621) = lu(k,1621) - lu(k,1002) * lu(k,1601) + lu(k,1622) = lu(k,1622) - lu(k,1003) * lu(k,1601) + lu(k,1631) = lu(k,1631) - lu(k,1004) * lu(k,1601) + lu(k,1664) = lu(k,1664) - lu(k,997) * lu(k,1654) + lu(k,1665) = lu(k,1665) - lu(k,998) * lu(k,1654) + lu(k,1666) = lu(k,1666) - lu(k,999) * lu(k,1654) + lu(k,1668) = lu(k,1668) - lu(k,1000) * lu(k,1654) + lu(k,1669) = lu(k,1669) - lu(k,1001) * lu(k,1654) + lu(k,1671) = lu(k,1671) - lu(k,1002) * lu(k,1654) + lu(k,1672) = lu(k,1672) - lu(k,1003) * lu(k,1654) + lu(k,1681) = lu(k,1681) - lu(k,1004) * lu(k,1654) + lu(k,1723) = - lu(k,997) * lu(k,1721) + lu(k,1725) = lu(k,1725) - lu(k,998) * lu(k,1721) + lu(k,1726) = lu(k,1726) - lu(k,999) * lu(k,1721) + lu(k,1728) = lu(k,1728) - lu(k,1000) * lu(k,1721) + lu(k,1729) = lu(k,1729) - lu(k,1001) * lu(k,1721) + lu(k,1731) = lu(k,1731) - lu(k,1002) * lu(k,1721) + lu(k,1732) = lu(k,1732) - lu(k,1003) * lu(k,1721) + lu(k,1741) = lu(k,1741) - lu(k,1004) * lu(k,1721) + lu(k,1824) = lu(k,1824) - lu(k,997) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,998) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,999) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1000) * lu(k,1814) + lu(k,1830) = lu(k,1830) - lu(k,1001) * lu(k,1814) + lu(k,1832) = lu(k,1832) - lu(k,1002) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1003) * lu(k,1814) + lu(k,1842) = lu(k,1842) - lu(k,1004) * lu(k,1814) + lu(k,1979) = lu(k,1979) - lu(k,997) * lu(k,1969) + lu(k,1981) = lu(k,1981) - lu(k,998) * lu(k,1969) + lu(k,1982) = lu(k,1982) - lu(k,999) * lu(k,1969) + lu(k,1984) = lu(k,1984) - lu(k,1000) * lu(k,1969) + lu(k,1985) = lu(k,1985) - lu(k,1001) * lu(k,1969) + lu(k,1987) = lu(k,1987) - lu(k,1002) * lu(k,1969) + lu(k,1988) = lu(k,1988) - lu(k,1003) * lu(k,1969) + lu(k,1997) = lu(k,1997) - lu(k,1004) * lu(k,1969) + lu(k,1007) = 1._r8 / lu(k,1007) + lu(k,1008) = lu(k,1008) * lu(k,1007) + lu(k,1009) = lu(k,1009) * lu(k,1007) + lu(k,1010) = lu(k,1010) * lu(k,1007) + lu(k,1011) = lu(k,1011) * lu(k,1007) + lu(k,1012) = lu(k,1012) * lu(k,1007) + lu(k,1013) = lu(k,1013) * lu(k,1007) + lu(k,1014) = lu(k,1014) * lu(k,1007) + lu(k,1015) = lu(k,1015) * lu(k,1007) + lu(k,1016) = lu(k,1016) * lu(k,1007) + lu(k,1017) = lu(k,1017) * lu(k,1007) + lu(k,1263) = lu(k,1263) - lu(k,1008) * lu(k,1262) + lu(k,1264) = lu(k,1264) - lu(k,1009) * lu(k,1262) + lu(k,1265) = - lu(k,1010) * lu(k,1262) + lu(k,1266) = lu(k,1266) - lu(k,1011) * lu(k,1262) + lu(k,1267) = - lu(k,1012) * lu(k,1262) + lu(k,1268) = lu(k,1268) - lu(k,1013) * lu(k,1262) + lu(k,1269) = lu(k,1269) - lu(k,1014) * lu(k,1262) + lu(k,1270) = - lu(k,1015) * lu(k,1262) + lu(k,1272) = - lu(k,1016) * lu(k,1262) + lu(k,1273) = lu(k,1273) - lu(k,1017) * lu(k,1262) + lu(k,1275) = - lu(k,1008) * lu(k,1274) + lu(k,1276) = lu(k,1276) - lu(k,1009) * lu(k,1274) + lu(k,1277) = - lu(k,1010) * lu(k,1274) + lu(k,1279) = - lu(k,1011) * lu(k,1274) + lu(k,1280) = - lu(k,1012) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,1013) * lu(k,1274) + lu(k,1282) = - lu(k,1014) * lu(k,1274) + lu(k,1283) = - lu(k,1015) * lu(k,1274) + lu(k,1286) = lu(k,1286) - lu(k,1016) * lu(k,1274) + lu(k,1287) = lu(k,1287) - lu(k,1017) * lu(k,1274) + lu(k,1387) = lu(k,1387) - lu(k,1008) * lu(k,1375) + lu(k,1388) = lu(k,1388) - lu(k,1009) * lu(k,1375) + lu(k,1389) = lu(k,1389) - lu(k,1010) * lu(k,1375) + lu(k,1391) = lu(k,1391) - lu(k,1011) * lu(k,1375) + lu(k,1392) = lu(k,1392) - lu(k,1012) * lu(k,1375) + lu(k,1393) = lu(k,1393) - lu(k,1013) * lu(k,1375) + lu(k,1394) = lu(k,1394) - lu(k,1014) * lu(k,1375) + lu(k,1396) = lu(k,1396) - lu(k,1015) * lu(k,1375) + lu(k,1400) = lu(k,1400) - lu(k,1016) * lu(k,1375) + lu(k,1403) = lu(k,1403) - lu(k,1017) * lu(k,1375) + lu(k,1468) = lu(k,1468) - lu(k,1008) * lu(k,1466) + lu(k,1469) = lu(k,1469) - lu(k,1009) * lu(k,1466) + lu(k,1470) = lu(k,1470) - lu(k,1010) * lu(k,1466) + lu(k,1472) = lu(k,1472) - lu(k,1011) * lu(k,1466) + lu(k,1473) = lu(k,1473) - lu(k,1012) * lu(k,1466) + lu(k,1474) = lu(k,1474) - lu(k,1013) * lu(k,1466) + lu(k,1475) = lu(k,1475) - lu(k,1014) * lu(k,1466) + lu(k,1477) = lu(k,1477) - lu(k,1015) * lu(k,1466) + lu(k,1481) = lu(k,1481) - lu(k,1016) * lu(k,1466) + lu(k,1484) = lu(k,1484) - lu(k,1017) * lu(k,1466) + lu(k,1615) = lu(k,1615) - lu(k,1008) * lu(k,1602) + lu(k,1616) = lu(k,1616) - lu(k,1009) * lu(k,1602) + lu(k,1617) = lu(k,1617) - lu(k,1010) * lu(k,1602) + lu(k,1619) = lu(k,1619) - lu(k,1011) * lu(k,1602) + lu(k,1620) = lu(k,1620) - lu(k,1012) * lu(k,1602) + lu(k,1621) = lu(k,1621) - lu(k,1013) * lu(k,1602) + lu(k,1622) = lu(k,1622) - lu(k,1014) * lu(k,1602) + lu(k,1624) = lu(k,1624) - lu(k,1015) * lu(k,1602) + lu(k,1628) = lu(k,1628) - lu(k,1016) * lu(k,1602) + lu(k,1631) = lu(k,1631) - lu(k,1017) * lu(k,1602) + lu(k,1725) = lu(k,1725) - lu(k,1008) * lu(k,1722) + lu(k,1726) = lu(k,1726) - lu(k,1009) * lu(k,1722) + lu(k,1727) = lu(k,1727) - lu(k,1010) * lu(k,1722) + lu(k,1729) = lu(k,1729) - lu(k,1011) * lu(k,1722) + lu(k,1730) = - lu(k,1012) * lu(k,1722) + lu(k,1731) = lu(k,1731) - lu(k,1013) * lu(k,1722) + lu(k,1732) = lu(k,1732) - lu(k,1014) * lu(k,1722) + lu(k,1734) = lu(k,1734) - lu(k,1015) * lu(k,1722) + lu(k,1738) = lu(k,1738) - lu(k,1016) * lu(k,1722) + lu(k,1741) = lu(k,1741) - lu(k,1017) * lu(k,1722) + lu(k,1880) = lu(k,1880) - lu(k,1008) * lu(k,1877) + lu(k,1881) = lu(k,1881) - lu(k,1009) * lu(k,1877) + lu(k,1882) = lu(k,1882) - lu(k,1010) * lu(k,1877) + lu(k,1884) = lu(k,1884) - lu(k,1011) * lu(k,1877) + lu(k,1885) = lu(k,1885) - lu(k,1012) * lu(k,1877) + lu(k,1886) = lu(k,1886) - lu(k,1013) * lu(k,1877) + lu(k,1887) = - lu(k,1014) * lu(k,1877) + lu(k,1889) = lu(k,1889) - lu(k,1015) * lu(k,1877) + lu(k,1893) = lu(k,1893) - lu(k,1016) * lu(k,1877) + lu(k,1896) = lu(k,1896) - lu(k,1017) * lu(k,1877) + lu(k,1903) = lu(k,1903) - lu(k,1008) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1009) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1010) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1011) * lu(k,1901) + lu(k,1908) = lu(k,1908) - lu(k,1012) * lu(k,1901) + lu(k,1909) = lu(k,1909) - lu(k,1013) * lu(k,1901) + lu(k,1910) = - lu(k,1014) * lu(k,1901) + lu(k,1912) = lu(k,1912) - lu(k,1015) * lu(k,1901) + lu(k,1916) = lu(k,1916) - lu(k,1016) * lu(k,1901) + lu(k,1919) = lu(k,1919) - lu(k,1017) * lu(k,1901) + lu(k,2006) = lu(k,2006) - lu(k,1008) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1009) * lu(k,2003) + lu(k,2008) = - lu(k,1010) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1011) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1012) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,1013) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,1014) * lu(k,2003) + lu(k,2015) = - lu(k,1015) * lu(k,2003) + lu(k,2019) = lu(k,2019) - lu(k,1016) * lu(k,2003) + lu(k,2022) = lu(k,2022) - lu(k,1017) * lu(k,2003) + end do + end subroutine lu_fac21 + subroutine lu_fac22( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1024) = 1._r8 / lu(k,1024) + lu(k,1025) = lu(k,1025) * lu(k,1024) + lu(k,1026) = lu(k,1026) * lu(k,1024) + lu(k,1027) = lu(k,1027) * lu(k,1024) + lu(k,1028) = lu(k,1028) * lu(k,1024) + lu(k,1029) = lu(k,1029) * lu(k,1024) + lu(k,1030) = lu(k,1030) * lu(k,1024) + lu(k,1031) = lu(k,1031) * lu(k,1024) + lu(k,1032) = lu(k,1032) * lu(k,1024) + lu(k,1033) = lu(k,1033) * lu(k,1024) + lu(k,1034) = lu(k,1034) * lu(k,1024) + lu(k,1046) = lu(k,1046) - lu(k,1025) * lu(k,1043) + lu(k,1048) = lu(k,1048) - lu(k,1026) * lu(k,1043) + lu(k,1050) = lu(k,1050) - lu(k,1027) * lu(k,1043) + lu(k,1051) = lu(k,1051) - lu(k,1028) * lu(k,1043) + lu(k,1052) = lu(k,1052) - lu(k,1029) * lu(k,1043) + lu(k,1053) = lu(k,1053) - lu(k,1030) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,1031) * lu(k,1043) + lu(k,1055) = lu(k,1055) - lu(k,1032) * lu(k,1043) + lu(k,1056) = lu(k,1056) - lu(k,1033) * lu(k,1043) + lu(k,1057) = lu(k,1057) - lu(k,1034) * lu(k,1043) + lu(k,1107) = lu(k,1107) - lu(k,1025) * lu(k,1105) + lu(k,1112) = lu(k,1112) - lu(k,1026) * lu(k,1105) + lu(k,1114) = lu(k,1114) - lu(k,1027) * lu(k,1105) + lu(k,1115) = lu(k,1115) - lu(k,1028) * lu(k,1105) + lu(k,1116) = lu(k,1116) - lu(k,1029) * lu(k,1105) + lu(k,1117) = lu(k,1117) - lu(k,1030) * lu(k,1105) + lu(k,1118) = lu(k,1118) - lu(k,1031) * lu(k,1105) + lu(k,1119) = lu(k,1119) - lu(k,1032) * lu(k,1105) + lu(k,1121) = lu(k,1121) - lu(k,1033) * lu(k,1105) + lu(k,1122) = lu(k,1122) - lu(k,1034) * lu(k,1105) + lu(k,1183) = lu(k,1183) - lu(k,1025) * lu(k,1181) + lu(k,1188) = lu(k,1188) - lu(k,1026) * lu(k,1181) + lu(k,1190) = lu(k,1190) - lu(k,1027) * lu(k,1181) + lu(k,1191) = lu(k,1191) - lu(k,1028) * lu(k,1181) + lu(k,1192) = lu(k,1192) - lu(k,1029) * lu(k,1181) + lu(k,1193) = lu(k,1193) - lu(k,1030) * lu(k,1181) + lu(k,1194) = lu(k,1194) - lu(k,1031) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,1032) * lu(k,1181) + lu(k,1197) = lu(k,1197) - lu(k,1033) * lu(k,1181) + lu(k,1198) = lu(k,1198) - lu(k,1034) * lu(k,1181) + lu(k,1230) = lu(k,1230) - lu(k,1025) * lu(k,1227) + lu(k,1236) = lu(k,1236) - lu(k,1026) * lu(k,1227) + lu(k,1238) = lu(k,1238) - lu(k,1027) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,1028) * lu(k,1227) + lu(k,1240) = lu(k,1240) - lu(k,1029) * lu(k,1227) + lu(k,1241) = lu(k,1241) - lu(k,1030) * lu(k,1227) + lu(k,1242) = lu(k,1242) - lu(k,1031) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,1032) * lu(k,1227) + lu(k,1245) = lu(k,1245) - lu(k,1033) * lu(k,1227) + lu(k,1246) = lu(k,1246) - lu(k,1034) * lu(k,1227) + lu(k,1379) = lu(k,1379) - lu(k,1025) * lu(k,1376) + lu(k,1385) = lu(k,1385) - lu(k,1026) * lu(k,1376) + lu(k,1388) = lu(k,1388) - lu(k,1027) * lu(k,1376) + lu(k,1390) = lu(k,1390) - lu(k,1028) * lu(k,1376) + lu(k,1391) = lu(k,1391) - lu(k,1029) * lu(k,1376) + lu(k,1393) = lu(k,1393) - lu(k,1030) * lu(k,1376) + lu(k,1394) = lu(k,1394) - lu(k,1031) * lu(k,1376) + lu(k,1397) = lu(k,1397) - lu(k,1032) * lu(k,1376) + lu(k,1401) = lu(k,1401) - lu(k,1033) * lu(k,1376) + lu(k,1402) = lu(k,1402) - lu(k,1034) * lu(k,1376) + lu(k,1435) = lu(k,1435) - lu(k,1025) * lu(k,1432) + lu(k,1442) = lu(k,1442) - lu(k,1026) * lu(k,1432) + lu(k,1445) = lu(k,1445) - lu(k,1027) * lu(k,1432) + lu(k,1447) = lu(k,1447) - lu(k,1028) * lu(k,1432) + lu(k,1448) = lu(k,1448) - lu(k,1029) * lu(k,1432) + lu(k,1450) = lu(k,1450) - lu(k,1030) * lu(k,1432) + lu(k,1451) = lu(k,1451) - lu(k,1031) * lu(k,1432) + lu(k,1454) = lu(k,1454) - lu(k,1032) * lu(k,1432) + lu(k,1458) = lu(k,1458) - lu(k,1033) * lu(k,1432) + lu(k,1459) = lu(k,1459) - lu(k,1034) * lu(k,1432) + lu(k,1606) = lu(k,1606) - lu(k,1025) * lu(k,1603) + lu(k,1613) = lu(k,1613) - lu(k,1026) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,1027) * lu(k,1603) + lu(k,1618) = lu(k,1618) - lu(k,1028) * lu(k,1603) + lu(k,1619) = lu(k,1619) - lu(k,1029) * lu(k,1603) + lu(k,1621) = lu(k,1621) - lu(k,1030) * lu(k,1603) + lu(k,1622) = lu(k,1622) - lu(k,1031) * lu(k,1603) + lu(k,1625) = lu(k,1625) - lu(k,1032) * lu(k,1603) + lu(k,1629) = lu(k,1629) - lu(k,1033) * lu(k,1603) + lu(k,1630) = lu(k,1630) - lu(k,1034) * lu(k,1603) + lu(k,1658) = lu(k,1658) - lu(k,1025) * lu(k,1655) + lu(k,1664) = lu(k,1664) - lu(k,1026) * lu(k,1655) + lu(k,1666) = lu(k,1666) - lu(k,1027) * lu(k,1655) + lu(k,1668) = lu(k,1668) - lu(k,1028) * lu(k,1655) + lu(k,1669) = lu(k,1669) - lu(k,1029) * lu(k,1655) + lu(k,1671) = lu(k,1671) - lu(k,1030) * lu(k,1655) + lu(k,1672) = lu(k,1672) - lu(k,1031) * lu(k,1655) + lu(k,1675) = lu(k,1675) - lu(k,1032) * lu(k,1655) + lu(k,1679) = lu(k,1679) - lu(k,1033) * lu(k,1655) + lu(k,1680) = lu(k,1680) - lu(k,1034) * lu(k,1655) + lu(k,1973) = lu(k,1973) - lu(k,1025) * lu(k,1970) + lu(k,1979) = lu(k,1979) - lu(k,1026) * lu(k,1970) + lu(k,1982) = lu(k,1982) - lu(k,1027) * lu(k,1970) + lu(k,1984) = lu(k,1984) - lu(k,1028) * lu(k,1970) + lu(k,1985) = lu(k,1985) - lu(k,1029) * lu(k,1970) + lu(k,1987) = lu(k,1987) - lu(k,1030) * lu(k,1970) + lu(k,1988) = lu(k,1988) - lu(k,1031) * lu(k,1970) + lu(k,1991) = lu(k,1991) - lu(k,1032) * lu(k,1970) + lu(k,1995) = lu(k,1995) - lu(k,1033) * lu(k,1970) + lu(k,1996) = lu(k,1996) - lu(k,1034) * lu(k,1970) + lu(k,1044) = 1._r8 / lu(k,1044) + lu(k,1045) = lu(k,1045) * lu(k,1044) + lu(k,1046) = lu(k,1046) * lu(k,1044) + lu(k,1047) = lu(k,1047) * lu(k,1044) + lu(k,1048) = lu(k,1048) * lu(k,1044) + lu(k,1049) = lu(k,1049) * lu(k,1044) + lu(k,1050) = lu(k,1050) * lu(k,1044) + lu(k,1051) = lu(k,1051) * lu(k,1044) + lu(k,1052) = lu(k,1052) * lu(k,1044) + lu(k,1053) = lu(k,1053) * lu(k,1044) + lu(k,1054) = lu(k,1054) * lu(k,1044) + lu(k,1055) = lu(k,1055) * lu(k,1044) + lu(k,1056) = lu(k,1056) * lu(k,1044) + lu(k,1057) = lu(k,1057) * lu(k,1044) + lu(k,1229) = lu(k,1229) - lu(k,1045) * lu(k,1228) + lu(k,1230) = lu(k,1230) - lu(k,1046) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,1047) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,1048) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,1049) * lu(k,1228) + lu(k,1238) = lu(k,1238) - lu(k,1050) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,1051) * lu(k,1228) + lu(k,1240) = lu(k,1240) - lu(k,1052) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,1053) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,1054) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,1055) * lu(k,1228) + lu(k,1245) = lu(k,1245) - lu(k,1056) * lu(k,1228) + lu(k,1246) = lu(k,1246) - lu(k,1057) * lu(k,1228) + lu(k,1378) = lu(k,1378) - lu(k,1045) * lu(k,1377) + lu(k,1379) = lu(k,1379) - lu(k,1046) * lu(k,1377) + lu(k,1381) = lu(k,1381) - lu(k,1047) * lu(k,1377) + lu(k,1385) = lu(k,1385) - lu(k,1048) * lu(k,1377) + lu(k,1387) = lu(k,1387) - lu(k,1049) * lu(k,1377) + lu(k,1388) = lu(k,1388) - lu(k,1050) * lu(k,1377) + lu(k,1390) = lu(k,1390) - lu(k,1051) * lu(k,1377) + lu(k,1391) = lu(k,1391) - lu(k,1052) * lu(k,1377) + lu(k,1393) = lu(k,1393) - lu(k,1053) * lu(k,1377) + lu(k,1394) = lu(k,1394) - lu(k,1054) * lu(k,1377) + lu(k,1397) = lu(k,1397) - lu(k,1055) * lu(k,1377) + lu(k,1401) = lu(k,1401) - lu(k,1056) * lu(k,1377) + lu(k,1402) = lu(k,1402) - lu(k,1057) * lu(k,1377) + lu(k,1434) = lu(k,1434) - lu(k,1045) * lu(k,1433) + lu(k,1435) = lu(k,1435) - lu(k,1046) * lu(k,1433) + lu(k,1438) = lu(k,1438) - lu(k,1047) * lu(k,1433) + lu(k,1442) = lu(k,1442) - lu(k,1048) * lu(k,1433) + lu(k,1444) = lu(k,1444) - lu(k,1049) * lu(k,1433) + lu(k,1445) = lu(k,1445) - lu(k,1050) * lu(k,1433) + lu(k,1447) = lu(k,1447) - lu(k,1051) * lu(k,1433) + lu(k,1448) = lu(k,1448) - lu(k,1052) * lu(k,1433) + lu(k,1450) = lu(k,1450) - lu(k,1053) * lu(k,1433) + lu(k,1451) = lu(k,1451) - lu(k,1054) * lu(k,1433) + lu(k,1454) = lu(k,1454) - lu(k,1055) * lu(k,1433) + lu(k,1458) = lu(k,1458) - lu(k,1056) * lu(k,1433) + lu(k,1459) = lu(k,1459) - lu(k,1057) * lu(k,1433) + lu(k,1605) = lu(k,1605) - lu(k,1045) * lu(k,1604) + lu(k,1606) = lu(k,1606) - lu(k,1046) * lu(k,1604) + lu(k,1609) = lu(k,1609) - lu(k,1047) * lu(k,1604) + lu(k,1613) = lu(k,1613) - lu(k,1048) * lu(k,1604) + lu(k,1615) = lu(k,1615) - lu(k,1049) * lu(k,1604) + lu(k,1616) = lu(k,1616) - lu(k,1050) * lu(k,1604) + lu(k,1618) = lu(k,1618) - lu(k,1051) * lu(k,1604) + lu(k,1619) = lu(k,1619) - lu(k,1052) * lu(k,1604) + lu(k,1621) = lu(k,1621) - lu(k,1053) * lu(k,1604) + lu(k,1622) = lu(k,1622) - lu(k,1054) * lu(k,1604) + lu(k,1625) = lu(k,1625) - lu(k,1055) * lu(k,1604) + lu(k,1629) = lu(k,1629) - lu(k,1056) * lu(k,1604) + lu(k,1630) = lu(k,1630) - lu(k,1057) * lu(k,1604) + lu(k,1657) = lu(k,1657) - lu(k,1045) * lu(k,1656) + lu(k,1658) = lu(k,1658) - lu(k,1046) * lu(k,1656) + lu(k,1660) = lu(k,1660) - lu(k,1047) * lu(k,1656) + lu(k,1664) = lu(k,1664) - lu(k,1048) * lu(k,1656) + lu(k,1665) = lu(k,1665) - lu(k,1049) * lu(k,1656) + lu(k,1666) = lu(k,1666) - lu(k,1050) * lu(k,1656) + lu(k,1668) = lu(k,1668) - lu(k,1051) * lu(k,1656) + lu(k,1669) = lu(k,1669) - lu(k,1052) * lu(k,1656) + lu(k,1671) = lu(k,1671) - lu(k,1053) * lu(k,1656) + lu(k,1672) = lu(k,1672) - lu(k,1054) * lu(k,1656) + lu(k,1675) = lu(k,1675) - lu(k,1055) * lu(k,1656) + lu(k,1679) = lu(k,1679) - lu(k,1056) * lu(k,1656) + lu(k,1680) = lu(k,1680) - lu(k,1057) * lu(k,1656) + lu(k,1816) = lu(k,1816) - lu(k,1045) * lu(k,1815) + lu(k,1817) = lu(k,1817) - lu(k,1046) * lu(k,1815) + lu(k,1820) = lu(k,1820) - lu(k,1047) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1048) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1049) * lu(k,1815) + lu(k,1827) = lu(k,1827) - lu(k,1050) * lu(k,1815) + lu(k,1829) = lu(k,1829) - lu(k,1051) * lu(k,1815) + lu(k,1830) = lu(k,1830) - lu(k,1052) * lu(k,1815) + lu(k,1832) = lu(k,1832) - lu(k,1053) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1054) * lu(k,1815) + lu(k,1836) = lu(k,1836) - lu(k,1055) * lu(k,1815) + lu(k,1840) = lu(k,1840) - lu(k,1056) * lu(k,1815) + lu(k,1841) = lu(k,1841) - lu(k,1057) * lu(k,1815) + lu(k,1972) = lu(k,1972) - lu(k,1045) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1046) * lu(k,1971) + lu(k,1975) = lu(k,1975) - lu(k,1047) * lu(k,1971) + lu(k,1979) = lu(k,1979) - lu(k,1048) * lu(k,1971) + lu(k,1981) = lu(k,1981) - lu(k,1049) * lu(k,1971) + lu(k,1982) = lu(k,1982) - lu(k,1050) * lu(k,1971) + lu(k,1984) = lu(k,1984) - lu(k,1051) * lu(k,1971) + lu(k,1985) = lu(k,1985) - lu(k,1052) * lu(k,1971) + lu(k,1987) = lu(k,1987) - lu(k,1053) * lu(k,1971) + lu(k,1988) = lu(k,1988) - lu(k,1054) * lu(k,1971) + lu(k,1991) = lu(k,1991) - lu(k,1055) * lu(k,1971) + lu(k,1995) = lu(k,1995) - lu(k,1056) * lu(k,1971) + lu(k,1996) = lu(k,1996) - lu(k,1057) * lu(k,1971) + lu(k,1060) = 1._r8 / lu(k,1060) + lu(k,1061) = lu(k,1061) * lu(k,1060) + lu(k,1062) = lu(k,1062) * lu(k,1060) + lu(k,1063) = lu(k,1063) * lu(k,1060) + lu(k,1064) = lu(k,1064) * lu(k,1060) + lu(k,1065) = lu(k,1065) * lu(k,1060) + lu(k,1066) = lu(k,1066) * lu(k,1060) + lu(k,1067) = lu(k,1067) * lu(k,1060) + lu(k,1068) = lu(k,1068) * lu(k,1060) + lu(k,1069) = lu(k,1069) * lu(k,1060) + lu(k,1070) = lu(k,1070) * lu(k,1060) + lu(k,1107) = lu(k,1107) - lu(k,1061) * lu(k,1106) + lu(k,1110) = - lu(k,1062) * lu(k,1106) + lu(k,1111) = - lu(k,1063) * lu(k,1106) + lu(k,1112) = lu(k,1112) - lu(k,1064) * lu(k,1106) + lu(k,1114) = lu(k,1114) - lu(k,1065) * lu(k,1106) + lu(k,1115) = lu(k,1115) - lu(k,1066) * lu(k,1106) + lu(k,1117) = lu(k,1117) - lu(k,1067) * lu(k,1106) + lu(k,1120) = - lu(k,1068) * lu(k,1106) + lu(k,1121) = lu(k,1121) - lu(k,1069) * lu(k,1106) + lu(k,1123) = lu(k,1123) - lu(k,1070) * lu(k,1106) + lu(k,1183) = lu(k,1183) - lu(k,1061) * lu(k,1182) + lu(k,1185) = - lu(k,1062) * lu(k,1182) + lu(k,1187) = - lu(k,1063) * lu(k,1182) + lu(k,1188) = lu(k,1188) - lu(k,1064) * lu(k,1182) + lu(k,1190) = lu(k,1190) - lu(k,1065) * lu(k,1182) + lu(k,1191) = lu(k,1191) - lu(k,1066) * lu(k,1182) + lu(k,1193) = lu(k,1193) - lu(k,1067) * lu(k,1182) + lu(k,1196) = - lu(k,1068) * lu(k,1182) + lu(k,1197) = lu(k,1197) - lu(k,1069) * lu(k,1182) + lu(k,1199) = lu(k,1199) - lu(k,1070) * lu(k,1182) + lu(k,1230) = lu(k,1230) - lu(k,1061) * lu(k,1229) + lu(k,1233) = lu(k,1233) - lu(k,1062) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,1063) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,1064) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1065) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1066) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,1067) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,1068) * lu(k,1229) + lu(k,1245) = lu(k,1245) - lu(k,1069) * lu(k,1229) + lu(k,1247) = lu(k,1247) - lu(k,1070) * lu(k,1229) + lu(k,1379) = lu(k,1379) - lu(k,1061) * lu(k,1378) + lu(k,1382) = lu(k,1382) - lu(k,1062) * lu(k,1378) + lu(k,1384) = lu(k,1384) - lu(k,1063) * lu(k,1378) + lu(k,1385) = lu(k,1385) - lu(k,1064) * lu(k,1378) + lu(k,1388) = lu(k,1388) - lu(k,1065) * lu(k,1378) + lu(k,1390) = lu(k,1390) - lu(k,1066) * lu(k,1378) + lu(k,1393) = lu(k,1393) - lu(k,1067) * lu(k,1378) + lu(k,1398) = lu(k,1398) - lu(k,1068) * lu(k,1378) + lu(k,1401) = lu(k,1401) - lu(k,1069) * lu(k,1378) + lu(k,1403) = lu(k,1403) - lu(k,1070) * lu(k,1378) + lu(k,1435) = lu(k,1435) - lu(k,1061) * lu(k,1434) + lu(k,1439) = lu(k,1439) - lu(k,1062) * lu(k,1434) + lu(k,1441) = lu(k,1441) - lu(k,1063) * lu(k,1434) + lu(k,1442) = lu(k,1442) - lu(k,1064) * lu(k,1434) + lu(k,1445) = lu(k,1445) - lu(k,1065) * lu(k,1434) + lu(k,1447) = lu(k,1447) - lu(k,1066) * lu(k,1434) + lu(k,1450) = lu(k,1450) - lu(k,1067) * lu(k,1434) + lu(k,1455) = lu(k,1455) - lu(k,1068) * lu(k,1434) + lu(k,1458) = lu(k,1458) - lu(k,1069) * lu(k,1434) + lu(k,1460) = lu(k,1460) - lu(k,1070) * lu(k,1434) + lu(k,1606) = lu(k,1606) - lu(k,1061) * lu(k,1605) + lu(k,1610) = lu(k,1610) - lu(k,1062) * lu(k,1605) + lu(k,1612) = lu(k,1612) - lu(k,1063) * lu(k,1605) + lu(k,1613) = lu(k,1613) - lu(k,1064) * lu(k,1605) + lu(k,1616) = lu(k,1616) - lu(k,1065) * lu(k,1605) + lu(k,1618) = lu(k,1618) - lu(k,1066) * lu(k,1605) + lu(k,1621) = lu(k,1621) - lu(k,1067) * lu(k,1605) + lu(k,1626) = lu(k,1626) - lu(k,1068) * lu(k,1605) + lu(k,1629) = lu(k,1629) - lu(k,1069) * lu(k,1605) + lu(k,1631) = lu(k,1631) - lu(k,1070) * lu(k,1605) + lu(k,1658) = lu(k,1658) - lu(k,1061) * lu(k,1657) + lu(k,1661) = lu(k,1661) - lu(k,1062) * lu(k,1657) + lu(k,1663) = lu(k,1663) - lu(k,1063) * lu(k,1657) + lu(k,1664) = lu(k,1664) - lu(k,1064) * lu(k,1657) + lu(k,1666) = lu(k,1666) - lu(k,1065) * lu(k,1657) + lu(k,1668) = lu(k,1668) - lu(k,1066) * lu(k,1657) + lu(k,1671) = lu(k,1671) - lu(k,1067) * lu(k,1657) + lu(k,1676) = - lu(k,1068) * lu(k,1657) + lu(k,1679) = lu(k,1679) - lu(k,1069) * lu(k,1657) + lu(k,1681) = lu(k,1681) - lu(k,1070) * lu(k,1657) + lu(k,1817) = lu(k,1817) - lu(k,1061) * lu(k,1816) + lu(k,1821) = - lu(k,1062) * lu(k,1816) + lu(k,1823) = - lu(k,1063) * lu(k,1816) + lu(k,1824) = lu(k,1824) - lu(k,1064) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1065) * lu(k,1816) + lu(k,1829) = lu(k,1829) - lu(k,1066) * lu(k,1816) + lu(k,1832) = lu(k,1832) - lu(k,1067) * lu(k,1816) + lu(k,1837) = lu(k,1837) - lu(k,1068) * lu(k,1816) + lu(k,1840) = lu(k,1840) - lu(k,1069) * lu(k,1816) + lu(k,1842) = lu(k,1842) - lu(k,1070) * lu(k,1816) + lu(k,1973) = lu(k,1973) - lu(k,1061) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1062) * lu(k,1972) + lu(k,1978) = lu(k,1978) - lu(k,1063) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1064) * lu(k,1972) + lu(k,1982) = lu(k,1982) - lu(k,1065) * lu(k,1972) + lu(k,1984) = lu(k,1984) - lu(k,1066) * lu(k,1972) + lu(k,1987) = lu(k,1987) - lu(k,1067) * lu(k,1972) + lu(k,1992) = lu(k,1992) - lu(k,1068) * lu(k,1972) + lu(k,1995) = lu(k,1995) - lu(k,1069) * lu(k,1972) + lu(k,1997) = lu(k,1997) - lu(k,1070) * lu(k,1972) + lu(k,1072) = 1._r8 / lu(k,1072) + lu(k,1073) = lu(k,1073) * lu(k,1072) + lu(k,1074) = lu(k,1074) * lu(k,1072) + lu(k,1075) = lu(k,1075) * lu(k,1072) + lu(k,1076) = lu(k,1076) * lu(k,1072) + lu(k,1077) = lu(k,1077) * lu(k,1072) + lu(k,1078) = lu(k,1078) * lu(k,1072) + lu(k,1079) = lu(k,1079) * lu(k,1072) + lu(k,1112) = lu(k,1112) - lu(k,1073) * lu(k,1107) + lu(k,1113) = lu(k,1113) - lu(k,1074) * lu(k,1107) + lu(k,1114) = lu(k,1114) - lu(k,1075) * lu(k,1107) + lu(k,1115) = lu(k,1115) - lu(k,1076) * lu(k,1107) + lu(k,1116) = lu(k,1116) - lu(k,1077) * lu(k,1107) + lu(k,1117) = lu(k,1117) - lu(k,1078) * lu(k,1107) + lu(k,1123) = lu(k,1123) - lu(k,1079) * lu(k,1107) + lu(k,1132) = lu(k,1132) - lu(k,1073) * lu(k,1129) + lu(k,1133) = lu(k,1133) - lu(k,1074) * lu(k,1129) + lu(k,1134) = lu(k,1134) - lu(k,1075) * lu(k,1129) + lu(k,1135) = lu(k,1135) - lu(k,1076) * lu(k,1129) + lu(k,1136) = lu(k,1136) - lu(k,1077) * lu(k,1129) + lu(k,1137) = lu(k,1137) - lu(k,1078) * lu(k,1129) + lu(k,1143) = lu(k,1143) - lu(k,1079) * lu(k,1129) + lu(k,1155) = lu(k,1155) - lu(k,1073) * lu(k,1152) + lu(k,1156) = lu(k,1156) - lu(k,1074) * lu(k,1152) + lu(k,1157) = lu(k,1157) - lu(k,1075) * lu(k,1152) + lu(k,1158) = lu(k,1158) - lu(k,1076) * lu(k,1152) + lu(k,1159) = lu(k,1159) - lu(k,1077) * lu(k,1152) + lu(k,1160) = lu(k,1160) - lu(k,1078) * lu(k,1152) + lu(k,1165) = lu(k,1165) - lu(k,1079) * lu(k,1152) + lu(k,1188) = lu(k,1188) - lu(k,1073) * lu(k,1183) + lu(k,1189) = lu(k,1189) - lu(k,1074) * lu(k,1183) + lu(k,1190) = lu(k,1190) - lu(k,1075) * lu(k,1183) + lu(k,1191) = lu(k,1191) - lu(k,1076) * lu(k,1183) + lu(k,1192) = lu(k,1192) - lu(k,1077) * lu(k,1183) + lu(k,1193) = lu(k,1193) - lu(k,1078) * lu(k,1183) + lu(k,1199) = lu(k,1199) - lu(k,1079) * lu(k,1183) + lu(k,1206) = lu(k,1206) - lu(k,1073) * lu(k,1204) + lu(k,1207) = - lu(k,1074) * lu(k,1204) + lu(k,1208) = - lu(k,1075) * lu(k,1204) + lu(k,1209) = lu(k,1209) - lu(k,1076) * lu(k,1204) + lu(k,1210) = lu(k,1210) - lu(k,1077) * lu(k,1204) + lu(k,1211) = lu(k,1211) - lu(k,1078) * lu(k,1204) + lu(k,1217) = lu(k,1217) - lu(k,1079) * lu(k,1204) + lu(k,1236) = lu(k,1236) - lu(k,1073) * lu(k,1230) + lu(k,1237) = lu(k,1237) - lu(k,1074) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,1075) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,1076) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,1077) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,1078) * lu(k,1230) + lu(k,1247) = lu(k,1247) - lu(k,1079) * lu(k,1230) + lu(k,1385) = lu(k,1385) - lu(k,1073) * lu(k,1379) + lu(k,1387) = lu(k,1387) - lu(k,1074) * lu(k,1379) + lu(k,1388) = lu(k,1388) - lu(k,1075) * lu(k,1379) + lu(k,1390) = lu(k,1390) - lu(k,1076) * lu(k,1379) + lu(k,1391) = lu(k,1391) - lu(k,1077) * lu(k,1379) + lu(k,1393) = lu(k,1393) - lu(k,1078) * lu(k,1379) + lu(k,1403) = lu(k,1403) - lu(k,1079) * lu(k,1379) + lu(k,1442) = lu(k,1442) - lu(k,1073) * lu(k,1435) + lu(k,1444) = lu(k,1444) - lu(k,1074) * lu(k,1435) + lu(k,1445) = lu(k,1445) - lu(k,1075) * lu(k,1435) + lu(k,1447) = lu(k,1447) - lu(k,1076) * lu(k,1435) + lu(k,1448) = lu(k,1448) - lu(k,1077) * lu(k,1435) + lu(k,1450) = lu(k,1450) - lu(k,1078) * lu(k,1435) + lu(k,1460) = lu(k,1460) - lu(k,1079) * lu(k,1435) + lu(k,1613) = lu(k,1613) - lu(k,1073) * lu(k,1606) + lu(k,1615) = lu(k,1615) - lu(k,1074) * lu(k,1606) + lu(k,1616) = lu(k,1616) - lu(k,1075) * lu(k,1606) + lu(k,1618) = lu(k,1618) - lu(k,1076) * lu(k,1606) + lu(k,1619) = lu(k,1619) - lu(k,1077) * lu(k,1606) + lu(k,1621) = lu(k,1621) - lu(k,1078) * lu(k,1606) + lu(k,1631) = lu(k,1631) - lu(k,1079) * lu(k,1606) + lu(k,1664) = lu(k,1664) - lu(k,1073) * lu(k,1658) + lu(k,1665) = lu(k,1665) - lu(k,1074) * lu(k,1658) + lu(k,1666) = lu(k,1666) - lu(k,1075) * lu(k,1658) + lu(k,1668) = lu(k,1668) - lu(k,1076) * lu(k,1658) + lu(k,1669) = lu(k,1669) - lu(k,1077) * lu(k,1658) + lu(k,1671) = lu(k,1671) - lu(k,1078) * lu(k,1658) + lu(k,1681) = lu(k,1681) - lu(k,1079) * lu(k,1658) + lu(k,1764) = lu(k,1764) - lu(k,1073) * lu(k,1761) + lu(k,1766) = lu(k,1766) - lu(k,1074) * lu(k,1761) + lu(k,1767) = lu(k,1767) - lu(k,1075) * lu(k,1761) + lu(k,1769) = lu(k,1769) - lu(k,1076) * lu(k,1761) + lu(k,1770) = lu(k,1770) - lu(k,1077) * lu(k,1761) + lu(k,1772) = lu(k,1772) - lu(k,1078) * lu(k,1761) + lu(k,1782) = lu(k,1782) - lu(k,1079) * lu(k,1761) + lu(k,1824) = lu(k,1824) - lu(k,1073) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1074) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1075) * lu(k,1817) + lu(k,1829) = lu(k,1829) - lu(k,1076) * lu(k,1817) + lu(k,1830) = lu(k,1830) - lu(k,1077) * lu(k,1817) + lu(k,1832) = lu(k,1832) - lu(k,1078) * lu(k,1817) + lu(k,1842) = lu(k,1842) - lu(k,1079) * lu(k,1817) + lu(k,1979) = lu(k,1979) - lu(k,1073) * lu(k,1973) + lu(k,1981) = lu(k,1981) - lu(k,1074) * lu(k,1973) + lu(k,1982) = lu(k,1982) - lu(k,1075) * lu(k,1973) + lu(k,1984) = lu(k,1984) - lu(k,1076) * lu(k,1973) + lu(k,1985) = lu(k,1985) - lu(k,1077) * lu(k,1973) + lu(k,1987) = lu(k,1987) - lu(k,1078) * lu(k,1973) + lu(k,1997) = lu(k,1997) - lu(k,1079) * lu(k,1973) + end do + end subroutine lu_fac22 + subroutine lu_fac23( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1083) = 1._r8 / lu(k,1083) + lu(k,1084) = lu(k,1084) * lu(k,1083) + lu(k,1085) = lu(k,1085) * lu(k,1083) + lu(k,1086) = lu(k,1086) * lu(k,1083) + lu(k,1087) = lu(k,1087) * lu(k,1083) + lu(k,1088) = lu(k,1088) * lu(k,1083) + lu(k,1089) = lu(k,1089) * lu(k,1083) + lu(k,1090) = lu(k,1090) * lu(k,1083) + lu(k,1091) = lu(k,1091) * lu(k,1083) + lu(k,1092) = lu(k,1092) * lu(k,1083) + lu(k,1093) = lu(k,1093) * lu(k,1083) + lu(k,1094) = lu(k,1094) * lu(k,1083) + lu(k,1095) = lu(k,1095) * lu(k,1083) + lu(k,1443) = - lu(k,1084) * lu(k,1436) + lu(k,1445) = lu(k,1445) - lu(k,1085) * lu(k,1436) + lu(k,1447) = lu(k,1447) - lu(k,1086) * lu(k,1436) + lu(k,1450) = lu(k,1450) - lu(k,1087) * lu(k,1436) + lu(k,1452) = - lu(k,1088) * lu(k,1436) + lu(k,1453) = - lu(k,1089) * lu(k,1436) + lu(k,1454) = lu(k,1454) - lu(k,1090) * lu(k,1436) + lu(k,1455) = lu(k,1455) - lu(k,1091) * lu(k,1436) + lu(k,1456) = - lu(k,1092) * lu(k,1436) + lu(k,1457) = lu(k,1457) - lu(k,1093) * lu(k,1436) + lu(k,1459) = lu(k,1459) - lu(k,1094) * lu(k,1436) + lu(k,1460) = lu(k,1460) - lu(k,1095) * lu(k,1436) + lu(k,1614) = lu(k,1614) - lu(k,1084) * lu(k,1607) + lu(k,1616) = lu(k,1616) - lu(k,1085) * lu(k,1607) + lu(k,1618) = lu(k,1618) - lu(k,1086) * lu(k,1607) + lu(k,1621) = lu(k,1621) - lu(k,1087) * lu(k,1607) + lu(k,1623) = lu(k,1623) - lu(k,1088) * lu(k,1607) + lu(k,1624) = lu(k,1624) - lu(k,1089) * lu(k,1607) + lu(k,1625) = lu(k,1625) - lu(k,1090) * lu(k,1607) + lu(k,1626) = lu(k,1626) - lu(k,1091) * lu(k,1607) + lu(k,1627) = lu(k,1627) - lu(k,1092) * lu(k,1607) + lu(k,1628) = lu(k,1628) - lu(k,1093) * lu(k,1607) + lu(k,1630) = lu(k,1630) - lu(k,1094) * lu(k,1607) + lu(k,1631) = lu(k,1631) - lu(k,1095) * lu(k,1607) + lu(k,1690) = lu(k,1690) - lu(k,1084) * lu(k,1689) + lu(k,1692) = - lu(k,1085) * lu(k,1689) + lu(k,1694) = lu(k,1694) - lu(k,1086) * lu(k,1689) + lu(k,1697) = lu(k,1697) - lu(k,1087) * lu(k,1689) + lu(k,1699) = lu(k,1699) - lu(k,1088) * lu(k,1689) + lu(k,1700) = lu(k,1700) - lu(k,1089) * lu(k,1689) + lu(k,1701) = lu(k,1701) - lu(k,1090) * lu(k,1689) + lu(k,1702) = - lu(k,1091) * lu(k,1689) + lu(k,1703) = lu(k,1703) - lu(k,1092) * lu(k,1689) + lu(k,1704) = lu(k,1704) - lu(k,1093) * lu(k,1689) + lu(k,1706) = lu(k,1706) - lu(k,1094) * lu(k,1689) + lu(k,1707) = lu(k,1707) - lu(k,1095) * lu(k,1689) + lu(k,1765) = lu(k,1765) - lu(k,1084) * lu(k,1762) + lu(k,1767) = lu(k,1767) - lu(k,1085) * lu(k,1762) + lu(k,1769) = lu(k,1769) - lu(k,1086) * lu(k,1762) + lu(k,1772) = lu(k,1772) - lu(k,1087) * lu(k,1762) + lu(k,1774) = lu(k,1774) - lu(k,1088) * lu(k,1762) + lu(k,1775) = lu(k,1775) - lu(k,1089) * lu(k,1762) + lu(k,1776) = lu(k,1776) - lu(k,1090) * lu(k,1762) + lu(k,1777) = lu(k,1777) - lu(k,1091) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,1092) * lu(k,1762) + lu(k,1779) = lu(k,1779) - lu(k,1093) * lu(k,1762) + lu(k,1781) = lu(k,1781) - lu(k,1094) * lu(k,1762) + lu(k,1782) = lu(k,1782) - lu(k,1095) * lu(k,1762) + lu(k,1825) = lu(k,1825) - lu(k,1084) * lu(k,1818) + lu(k,1827) = lu(k,1827) - lu(k,1085) * lu(k,1818) + lu(k,1829) = lu(k,1829) - lu(k,1086) * lu(k,1818) + lu(k,1832) = lu(k,1832) - lu(k,1087) * lu(k,1818) + lu(k,1834) = lu(k,1834) - lu(k,1088) * lu(k,1818) + lu(k,1835) = lu(k,1835) - lu(k,1089) * lu(k,1818) + lu(k,1836) = lu(k,1836) - lu(k,1090) * lu(k,1818) + lu(k,1837) = lu(k,1837) - lu(k,1091) * lu(k,1818) + lu(k,1838) = lu(k,1838) - lu(k,1092) * lu(k,1818) + lu(k,1839) = lu(k,1839) - lu(k,1093) * lu(k,1818) + lu(k,1841) = lu(k,1841) - lu(k,1094) * lu(k,1818) + lu(k,1842) = lu(k,1842) - lu(k,1095) * lu(k,1818) + lu(k,1849) = lu(k,1849) - lu(k,1084) * lu(k,1848) + lu(k,1851) = - lu(k,1085) * lu(k,1848) + lu(k,1853) = lu(k,1853) - lu(k,1086) * lu(k,1848) + lu(k,1856) = lu(k,1856) - lu(k,1087) * lu(k,1848) + lu(k,1858) = lu(k,1858) - lu(k,1088) * lu(k,1848) + lu(k,1859) = lu(k,1859) - lu(k,1089) * lu(k,1848) + lu(k,1860) = lu(k,1860) - lu(k,1090) * lu(k,1848) + lu(k,1861) = - lu(k,1091) * lu(k,1848) + lu(k,1862) = lu(k,1862) - lu(k,1092) * lu(k,1848) + lu(k,1863) = lu(k,1863) - lu(k,1093) * lu(k,1848) + lu(k,1865) = lu(k,1865) - lu(k,1094) * lu(k,1848) + lu(k,1866) = lu(k,1866) - lu(k,1095) * lu(k,1848) + lu(k,1879) = lu(k,1879) - lu(k,1084) * lu(k,1878) + lu(k,1881) = lu(k,1881) - lu(k,1085) * lu(k,1878) + lu(k,1883) = lu(k,1883) - lu(k,1086) * lu(k,1878) + lu(k,1886) = lu(k,1886) - lu(k,1087) * lu(k,1878) + lu(k,1888) = lu(k,1888) - lu(k,1088) * lu(k,1878) + lu(k,1889) = lu(k,1889) - lu(k,1089) * lu(k,1878) + lu(k,1890) = lu(k,1890) - lu(k,1090) * lu(k,1878) + lu(k,1891) = lu(k,1891) - lu(k,1091) * lu(k,1878) + lu(k,1892) = lu(k,1892) - lu(k,1092) * lu(k,1878) + lu(k,1893) = lu(k,1893) - lu(k,1093) * lu(k,1878) + lu(k,1895) = lu(k,1895) - lu(k,1094) * lu(k,1878) + lu(k,1896) = lu(k,1896) - lu(k,1095) * lu(k,1878) + lu(k,2005) = - lu(k,1084) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1085) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1086) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1087) * lu(k,2004) + lu(k,2014) = - lu(k,1088) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1089) * lu(k,2004) + lu(k,2016) = - lu(k,1090) * lu(k,2004) + lu(k,2017) = - lu(k,1091) * lu(k,2004) + lu(k,2018) = - lu(k,1092) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,1093) * lu(k,2004) + lu(k,2021) = - lu(k,1094) * lu(k,2004) + lu(k,2022) = lu(k,2022) - lu(k,1095) * lu(k,2004) + lu(k,1108) = 1._r8 / lu(k,1108) + lu(k,1109) = lu(k,1109) * lu(k,1108) + lu(k,1110) = lu(k,1110) * lu(k,1108) + lu(k,1111) = lu(k,1111) * lu(k,1108) + lu(k,1112) = lu(k,1112) * lu(k,1108) + lu(k,1113) = lu(k,1113) * lu(k,1108) + lu(k,1114) = lu(k,1114) * lu(k,1108) + lu(k,1115) = lu(k,1115) * lu(k,1108) + lu(k,1116) = lu(k,1116) * lu(k,1108) + lu(k,1117) = lu(k,1117) * lu(k,1108) + lu(k,1118) = lu(k,1118) * lu(k,1108) + lu(k,1119) = lu(k,1119) * lu(k,1108) + lu(k,1120) = lu(k,1120) * lu(k,1108) + lu(k,1121) = lu(k,1121) * lu(k,1108) + lu(k,1122) = lu(k,1122) * lu(k,1108) + lu(k,1123) = lu(k,1123) * lu(k,1108) + lu(k,1232) = lu(k,1232) - lu(k,1109) * lu(k,1231) + lu(k,1233) = lu(k,1233) - lu(k,1110) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,1111) * lu(k,1231) + lu(k,1236) = lu(k,1236) - lu(k,1112) * lu(k,1231) + lu(k,1237) = lu(k,1237) - lu(k,1113) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,1114) * lu(k,1231) + lu(k,1239) = lu(k,1239) - lu(k,1115) * lu(k,1231) + lu(k,1240) = lu(k,1240) - lu(k,1116) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,1117) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,1118) * lu(k,1231) + lu(k,1243) = lu(k,1243) - lu(k,1119) * lu(k,1231) + lu(k,1244) = lu(k,1244) - lu(k,1120) * lu(k,1231) + lu(k,1245) = lu(k,1245) - lu(k,1121) * lu(k,1231) + lu(k,1246) = lu(k,1246) - lu(k,1122) * lu(k,1231) + lu(k,1247) = lu(k,1247) - lu(k,1123) * lu(k,1231) + lu(k,1381) = lu(k,1381) - lu(k,1109) * lu(k,1380) + lu(k,1382) = lu(k,1382) - lu(k,1110) * lu(k,1380) + lu(k,1384) = lu(k,1384) - lu(k,1111) * lu(k,1380) + lu(k,1385) = lu(k,1385) - lu(k,1112) * lu(k,1380) + lu(k,1387) = lu(k,1387) - lu(k,1113) * lu(k,1380) + lu(k,1388) = lu(k,1388) - lu(k,1114) * lu(k,1380) + lu(k,1390) = lu(k,1390) - lu(k,1115) * lu(k,1380) + lu(k,1391) = lu(k,1391) - lu(k,1116) * lu(k,1380) + lu(k,1393) = lu(k,1393) - lu(k,1117) * lu(k,1380) + lu(k,1394) = lu(k,1394) - lu(k,1118) * lu(k,1380) + lu(k,1397) = lu(k,1397) - lu(k,1119) * lu(k,1380) + lu(k,1398) = lu(k,1398) - lu(k,1120) * lu(k,1380) + lu(k,1401) = lu(k,1401) - lu(k,1121) * lu(k,1380) + lu(k,1402) = lu(k,1402) - lu(k,1122) * lu(k,1380) + lu(k,1403) = lu(k,1403) - lu(k,1123) * lu(k,1380) + lu(k,1438) = lu(k,1438) - lu(k,1109) * lu(k,1437) + lu(k,1439) = lu(k,1439) - lu(k,1110) * lu(k,1437) + lu(k,1441) = lu(k,1441) - lu(k,1111) * lu(k,1437) + lu(k,1442) = lu(k,1442) - lu(k,1112) * lu(k,1437) + lu(k,1444) = lu(k,1444) - lu(k,1113) * lu(k,1437) + lu(k,1445) = lu(k,1445) - lu(k,1114) * lu(k,1437) + lu(k,1447) = lu(k,1447) - lu(k,1115) * lu(k,1437) + lu(k,1448) = lu(k,1448) - lu(k,1116) * lu(k,1437) + lu(k,1450) = lu(k,1450) - lu(k,1117) * lu(k,1437) + lu(k,1451) = lu(k,1451) - lu(k,1118) * lu(k,1437) + lu(k,1454) = lu(k,1454) - lu(k,1119) * lu(k,1437) + lu(k,1455) = lu(k,1455) - lu(k,1120) * lu(k,1437) + lu(k,1458) = lu(k,1458) - lu(k,1121) * lu(k,1437) + lu(k,1459) = lu(k,1459) - lu(k,1122) * lu(k,1437) + lu(k,1460) = lu(k,1460) - lu(k,1123) * lu(k,1437) + lu(k,1609) = lu(k,1609) - lu(k,1109) * lu(k,1608) + lu(k,1610) = lu(k,1610) - lu(k,1110) * lu(k,1608) + lu(k,1612) = lu(k,1612) - lu(k,1111) * lu(k,1608) + lu(k,1613) = lu(k,1613) - lu(k,1112) * lu(k,1608) + lu(k,1615) = lu(k,1615) - lu(k,1113) * lu(k,1608) + lu(k,1616) = lu(k,1616) - lu(k,1114) * lu(k,1608) + lu(k,1618) = lu(k,1618) - lu(k,1115) * lu(k,1608) + lu(k,1619) = lu(k,1619) - lu(k,1116) * lu(k,1608) + lu(k,1621) = lu(k,1621) - lu(k,1117) * lu(k,1608) + lu(k,1622) = lu(k,1622) - lu(k,1118) * lu(k,1608) + lu(k,1625) = lu(k,1625) - lu(k,1119) * lu(k,1608) + lu(k,1626) = lu(k,1626) - lu(k,1120) * lu(k,1608) + lu(k,1629) = lu(k,1629) - lu(k,1121) * lu(k,1608) + lu(k,1630) = lu(k,1630) - lu(k,1122) * lu(k,1608) + lu(k,1631) = lu(k,1631) - lu(k,1123) * lu(k,1608) + lu(k,1660) = lu(k,1660) - lu(k,1109) * lu(k,1659) + lu(k,1661) = lu(k,1661) - lu(k,1110) * lu(k,1659) + lu(k,1663) = lu(k,1663) - lu(k,1111) * lu(k,1659) + lu(k,1664) = lu(k,1664) - lu(k,1112) * lu(k,1659) + lu(k,1665) = lu(k,1665) - lu(k,1113) * lu(k,1659) + lu(k,1666) = lu(k,1666) - lu(k,1114) * lu(k,1659) + lu(k,1668) = lu(k,1668) - lu(k,1115) * lu(k,1659) + lu(k,1669) = lu(k,1669) - lu(k,1116) * lu(k,1659) + lu(k,1671) = lu(k,1671) - lu(k,1117) * lu(k,1659) + lu(k,1672) = lu(k,1672) - lu(k,1118) * lu(k,1659) + lu(k,1675) = lu(k,1675) - lu(k,1119) * lu(k,1659) + lu(k,1676) = lu(k,1676) - lu(k,1120) * lu(k,1659) + lu(k,1679) = lu(k,1679) - lu(k,1121) * lu(k,1659) + lu(k,1680) = lu(k,1680) - lu(k,1122) * lu(k,1659) + lu(k,1681) = lu(k,1681) - lu(k,1123) * lu(k,1659) + lu(k,1820) = lu(k,1820) - lu(k,1109) * lu(k,1819) + lu(k,1821) = lu(k,1821) - lu(k,1110) * lu(k,1819) + lu(k,1823) = lu(k,1823) - lu(k,1111) * lu(k,1819) + lu(k,1824) = lu(k,1824) - lu(k,1112) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1113) * lu(k,1819) + lu(k,1827) = lu(k,1827) - lu(k,1114) * lu(k,1819) + lu(k,1829) = lu(k,1829) - lu(k,1115) * lu(k,1819) + lu(k,1830) = lu(k,1830) - lu(k,1116) * lu(k,1819) + lu(k,1832) = lu(k,1832) - lu(k,1117) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,1118) * lu(k,1819) + lu(k,1836) = lu(k,1836) - lu(k,1119) * lu(k,1819) + lu(k,1837) = lu(k,1837) - lu(k,1120) * lu(k,1819) + lu(k,1840) = lu(k,1840) - lu(k,1121) * lu(k,1819) + lu(k,1841) = lu(k,1841) - lu(k,1122) * lu(k,1819) + lu(k,1842) = lu(k,1842) - lu(k,1123) * lu(k,1819) + lu(k,1975) = lu(k,1975) - lu(k,1109) * lu(k,1974) + lu(k,1976) = lu(k,1976) - lu(k,1110) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,1111) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1112) * lu(k,1974) + lu(k,1981) = lu(k,1981) - lu(k,1113) * lu(k,1974) + lu(k,1982) = lu(k,1982) - lu(k,1114) * lu(k,1974) + lu(k,1984) = lu(k,1984) - lu(k,1115) * lu(k,1974) + lu(k,1985) = lu(k,1985) - lu(k,1116) * lu(k,1974) + lu(k,1987) = lu(k,1987) - lu(k,1117) * lu(k,1974) + lu(k,1988) = lu(k,1988) - lu(k,1118) * lu(k,1974) + lu(k,1991) = lu(k,1991) - lu(k,1119) * lu(k,1974) + lu(k,1992) = lu(k,1992) - lu(k,1120) * lu(k,1974) + lu(k,1995) = lu(k,1995) - lu(k,1121) * lu(k,1974) + lu(k,1996) = lu(k,1996) - lu(k,1122) * lu(k,1974) + lu(k,1997) = lu(k,1997) - lu(k,1123) * lu(k,1974) + lu(k,1130) = 1._r8 / lu(k,1130) + lu(k,1131) = lu(k,1131) * lu(k,1130) + lu(k,1132) = lu(k,1132) * lu(k,1130) + lu(k,1133) = lu(k,1133) * lu(k,1130) + lu(k,1134) = lu(k,1134) * lu(k,1130) + lu(k,1135) = lu(k,1135) * lu(k,1130) + lu(k,1136) = lu(k,1136) * lu(k,1130) + lu(k,1137) = lu(k,1137) * lu(k,1130) + lu(k,1138) = lu(k,1138) * lu(k,1130) + lu(k,1139) = lu(k,1139) * lu(k,1130) + lu(k,1140) = lu(k,1140) * lu(k,1130) + lu(k,1141) = lu(k,1141) * lu(k,1130) + lu(k,1142) = lu(k,1142) * lu(k,1130) + lu(k,1143) = lu(k,1143) * lu(k,1130) + lu(k,1185) = lu(k,1185) - lu(k,1131) * lu(k,1184) + lu(k,1188) = lu(k,1188) - lu(k,1132) * lu(k,1184) + lu(k,1189) = lu(k,1189) - lu(k,1133) * lu(k,1184) + lu(k,1190) = lu(k,1190) - lu(k,1134) * lu(k,1184) + lu(k,1191) = lu(k,1191) - lu(k,1135) * lu(k,1184) + lu(k,1192) = lu(k,1192) - lu(k,1136) * lu(k,1184) + lu(k,1193) = lu(k,1193) - lu(k,1137) * lu(k,1184) + lu(k,1194) = lu(k,1194) - lu(k,1138) * lu(k,1184) + lu(k,1195) = lu(k,1195) - lu(k,1139) * lu(k,1184) + lu(k,1196) = lu(k,1196) - lu(k,1140) * lu(k,1184) + lu(k,1197) = lu(k,1197) - lu(k,1141) * lu(k,1184) + lu(k,1198) = lu(k,1198) - lu(k,1142) * lu(k,1184) + lu(k,1199) = lu(k,1199) - lu(k,1143) * lu(k,1184) + lu(k,1233) = lu(k,1233) - lu(k,1131) * lu(k,1232) + lu(k,1236) = lu(k,1236) - lu(k,1132) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,1133) * lu(k,1232) + lu(k,1238) = lu(k,1238) - lu(k,1134) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,1135) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,1136) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,1137) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,1138) * lu(k,1232) + lu(k,1243) = lu(k,1243) - lu(k,1139) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,1140) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,1141) * lu(k,1232) + lu(k,1246) = lu(k,1246) - lu(k,1142) * lu(k,1232) + lu(k,1247) = lu(k,1247) - lu(k,1143) * lu(k,1232) + lu(k,1382) = lu(k,1382) - lu(k,1131) * lu(k,1381) + lu(k,1385) = lu(k,1385) - lu(k,1132) * lu(k,1381) + lu(k,1387) = lu(k,1387) - lu(k,1133) * lu(k,1381) + lu(k,1388) = lu(k,1388) - lu(k,1134) * lu(k,1381) + lu(k,1390) = lu(k,1390) - lu(k,1135) * lu(k,1381) + lu(k,1391) = lu(k,1391) - lu(k,1136) * lu(k,1381) + lu(k,1393) = lu(k,1393) - lu(k,1137) * lu(k,1381) + lu(k,1394) = lu(k,1394) - lu(k,1138) * lu(k,1381) + lu(k,1397) = lu(k,1397) - lu(k,1139) * lu(k,1381) + lu(k,1398) = lu(k,1398) - lu(k,1140) * lu(k,1381) + lu(k,1401) = lu(k,1401) - lu(k,1141) * lu(k,1381) + lu(k,1402) = lu(k,1402) - lu(k,1142) * lu(k,1381) + lu(k,1403) = lu(k,1403) - lu(k,1143) * lu(k,1381) + lu(k,1439) = lu(k,1439) - lu(k,1131) * lu(k,1438) + lu(k,1442) = lu(k,1442) - lu(k,1132) * lu(k,1438) + lu(k,1444) = lu(k,1444) - lu(k,1133) * lu(k,1438) + lu(k,1445) = lu(k,1445) - lu(k,1134) * lu(k,1438) + lu(k,1447) = lu(k,1447) - lu(k,1135) * lu(k,1438) + lu(k,1448) = lu(k,1448) - lu(k,1136) * lu(k,1438) + lu(k,1450) = lu(k,1450) - lu(k,1137) * lu(k,1438) + lu(k,1451) = lu(k,1451) - lu(k,1138) * lu(k,1438) + lu(k,1454) = lu(k,1454) - lu(k,1139) * lu(k,1438) + lu(k,1455) = lu(k,1455) - lu(k,1140) * lu(k,1438) + lu(k,1458) = lu(k,1458) - lu(k,1141) * lu(k,1438) + lu(k,1459) = lu(k,1459) - lu(k,1142) * lu(k,1438) + lu(k,1460) = lu(k,1460) - lu(k,1143) * lu(k,1438) + lu(k,1610) = lu(k,1610) - lu(k,1131) * lu(k,1609) + lu(k,1613) = lu(k,1613) - lu(k,1132) * lu(k,1609) + lu(k,1615) = lu(k,1615) - lu(k,1133) * lu(k,1609) + lu(k,1616) = lu(k,1616) - lu(k,1134) * lu(k,1609) + lu(k,1618) = lu(k,1618) - lu(k,1135) * lu(k,1609) + lu(k,1619) = lu(k,1619) - lu(k,1136) * lu(k,1609) + lu(k,1621) = lu(k,1621) - lu(k,1137) * lu(k,1609) + lu(k,1622) = lu(k,1622) - lu(k,1138) * lu(k,1609) + lu(k,1625) = lu(k,1625) - lu(k,1139) * lu(k,1609) + lu(k,1626) = lu(k,1626) - lu(k,1140) * lu(k,1609) + lu(k,1629) = lu(k,1629) - lu(k,1141) * lu(k,1609) + lu(k,1630) = lu(k,1630) - lu(k,1142) * lu(k,1609) + lu(k,1631) = lu(k,1631) - lu(k,1143) * lu(k,1609) + lu(k,1661) = lu(k,1661) - lu(k,1131) * lu(k,1660) + lu(k,1664) = lu(k,1664) - lu(k,1132) * lu(k,1660) + lu(k,1665) = lu(k,1665) - lu(k,1133) * lu(k,1660) + lu(k,1666) = lu(k,1666) - lu(k,1134) * lu(k,1660) + lu(k,1668) = lu(k,1668) - lu(k,1135) * lu(k,1660) + lu(k,1669) = lu(k,1669) - lu(k,1136) * lu(k,1660) + lu(k,1671) = lu(k,1671) - lu(k,1137) * lu(k,1660) + lu(k,1672) = lu(k,1672) - lu(k,1138) * lu(k,1660) + lu(k,1675) = lu(k,1675) - lu(k,1139) * lu(k,1660) + lu(k,1676) = lu(k,1676) - lu(k,1140) * lu(k,1660) + lu(k,1679) = lu(k,1679) - lu(k,1141) * lu(k,1660) + lu(k,1680) = lu(k,1680) - lu(k,1142) * lu(k,1660) + lu(k,1681) = lu(k,1681) - lu(k,1143) * lu(k,1660) + lu(k,1821) = lu(k,1821) - lu(k,1131) * lu(k,1820) + lu(k,1824) = lu(k,1824) - lu(k,1132) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1133) * lu(k,1820) + lu(k,1827) = lu(k,1827) - lu(k,1134) * lu(k,1820) + lu(k,1829) = lu(k,1829) - lu(k,1135) * lu(k,1820) + lu(k,1830) = lu(k,1830) - lu(k,1136) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,1137) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1138) * lu(k,1820) + lu(k,1836) = lu(k,1836) - lu(k,1139) * lu(k,1820) + lu(k,1837) = lu(k,1837) - lu(k,1140) * lu(k,1820) + lu(k,1840) = lu(k,1840) - lu(k,1141) * lu(k,1820) + lu(k,1841) = lu(k,1841) - lu(k,1142) * lu(k,1820) + lu(k,1842) = lu(k,1842) - lu(k,1143) * lu(k,1820) + lu(k,1976) = lu(k,1976) - lu(k,1131) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1132) * lu(k,1975) + lu(k,1981) = lu(k,1981) - lu(k,1133) * lu(k,1975) + lu(k,1982) = lu(k,1982) - lu(k,1134) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1135) * lu(k,1975) + lu(k,1985) = lu(k,1985) - lu(k,1136) * lu(k,1975) + lu(k,1987) = lu(k,1987) - lu(k,1137) * lu(k,1975) + lu(k,1988) = lu(k,1988) - lu(k,1138) * lu(k,1975) + lu(k,1991) = lu(k,1991) - lu(k,1139) * lu(k,1975) + lu(k,1992) = lu(k,1992) - lu(k,1140) * lu(k,1975) + lu(k,1995) = lu(k,1995) - lu(k,1141) * lu(k,1975) + lu(k,1996) = lu(k,1996) - lu(k,1142) * lu(k,1975) + lu(k,1997) = lu(k,1997) - lu(k,1143) * lu(k,1975) + end do + end subroutine lu_fac23 + subroutine lu_fac24( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1153) = 1._r8 / lu(k,1153) + lu(k,1154) = lu(k,1154) * lu(k,1153) + lu(k,1155) = lu(k,1155) * lu(k,1153) + lu(k,1156) = lu(k,1156) * lu(k,1153) + lu(k,1157) = lu(k,1157) * lu(k,1153) + lu(k,1158) = lu(k,1158) * lu(k,1153) + lu(k,1159) = lu(k,1159) * lu(k,1153) + lu(k,1160) = lu(k,1160) * lu(k,1153) + lu(k,1161) = lu(k,1161) * lu(k,1153) + lu(k,1162) = lu(k,1162) * lu(k,1153) + lu(k,1163) = lu(k,1163) * lu(k,1153) + lu(k,1164) = lu(k,1164) * lu(k,1153) + lu(k,1165) = lu(k,1165) * lu(k,1153) + lu(k,1187) = lu(k,1187) - lu(k,1154) * lu(k,1185) + lu(k,1188) = lu(k,1188) - lu(k,1155) * lu(k,1185) + lu(k,1189) = lu(k,1189) - lu(k,1156) * lu(k,1185) + lu(k,1190) = lu(k,1190) - lu(k,1157) * lu(k,1185) + lu(k,1191) = lu(k,1191) - lu(k,1158) * lu(k,1185) + lu(k,1192) = lu(k,1192) - lu(k,1159) * lu(k,1185) + lu(k,1193) = lu(k,1193) - lu(k,1160) * lu(k,1185) + lu(k,1194) = lu(k,1194) - lu(k,1161) * lu(k,1185) + lu(k,1195) = lu(k,1195) - lu(k,1162) * lu(k,1185) + lu(k,1197) = lu(k,1197) - lu(k,1163) * lu(k,1185) + lu(k,1198) = lu(k,1198) - lu(k,1164) * lu(k,1185) + lu(k,1199) = lu(k,1199) - lu(k,1165) * lu(k,1185) + lu(k,1235) = lu(k,1235) - lu(k,1154) * lu(k,1233) + lu(k,1236) = lu(k,1236) - lu(k,1155) * lu(k,1233) + lu(k,1237) = lu(k,1237) - lu(k,1156) * lu(k,1233) + lu(k,1238) = lu(k,1238) - lu(k,1157) * lu(k,1233) + lu(k,1239) = lu(k,1239) - lu(k,1158) * lu(k,1233) + lu(k,1240) = lu(k,1240) - lu(k,1159) * lu(k,1233) + lu(k,1241) = lu(k,1241) - lu(k,1160) * lu(k,1233) + lu(k,1242) = lu(k,1242) - lu(k,1161) * lu(k,1233) + lu(k,1243) = lu(k,1243) - lu(k,1162) * lu(k,1233) + lu(k,1245) = lu(k,1245) - lu(k,1163) * lu(k,1233) + lu(k,1246) = lu(k,1246) - lu(k,1164) * lu(k,1233) + lu(k,1247) = lu(k,1247) - lu(k,1165) * lu(k,1233) + lu(k,1384) = lu(k,1384) - lu(k,1154) * lu(k,1382) + lu(k,1385) = lu(k,1385) - lu(k,1155) * lu(k,1382) + lu(k,1387) = lu(k,1387) - lu(k,1156) * lu(k,1382) + lu(k,1388) = lu(k,1388) - lu(k,1157) * lu(k,1382) + lu(k,1390) = lu(k,1390) - lu(k,1158) * lu(k,1382) + lu(k,1391) = lu(k,1391) - lu(k,1159) * lu(k,1382) + lu(k,1393) = lu(k,1393) - lu(k,1160) * lu(k,1382) + lu(k,1394) = lu(k,1394) - lu(k,1161) * lu(k,1382) + lu(k,1397) = lu(k,1397) - lu(k,1162) * lu(k,1382) + lu(k,1401) = lu(k,1401) - lu(k,1163) * lu(k,1382) + lu(k,1402) = lu(k,1402) - lu(k,1164) * lu(k,1382) + lu(k,1403) = lu(k,1403) - lu(k,1165) * lu(k,1382) + lu(k,1441) = lu(k,1441) - lu(k,1154) * lu(k,1439) + lu(k,1442) = lu(k,1442) - lu(k,1155) * lu(k,1439) + lu(k,1444) = lu(k,1444) - lu(k,1156) * lu(k,1439) + lu(k,1445) = lu(k,1445) - lu(k,1157) * lu(k,1439) + lu(k,1447) = lu(k,1447) - lu(k,1158) * lu(k,1439) + lu(k,1448) = lu(k,1448) - lu(k,1159) * lu(k,1439) + lu(k,1450) = lu(k,1450) - lu(k,1160) * lu(k,1439) + lu(k,1451) = lu(k,1451) - lu(k,1161) * lu(k,1439) + lu(k,1454) = lu(k,1454) - lu(k,1162) * lu(k,1439) + lu(k,1458) = lu(k,1458) - lu(k,1163) * lu(k,1439) + lu(k,1459) = lu(k,1459) - lu(k,1164) * lu(k,1439) + lu(k,1460) = lu(k,1460) - lu(k,1165) * lu(k,1439) + lu(k,1612) = lu(k,1612) - lu(k,1154) * lu(k,1610) + lu(k,1613) = lu(k,1613) - lu(k,1155) * lu(k,1610) + lu(k,1615) = lu(k,1615) - lu(k,1156) * lu(k,1610) + lu(k,1616) = lu(k,1616) - lu(k,1157) * lu(k,1610) + lu(k,1618) = lu(k,1618) - lu(k,1158) * lu(k,1610) + lu(k,1619) = lu(k,1619) - lu(k,1159) * lu(k,1610) + lu(k,1621) = lu(k,1621) - lu(k,1160) * lu(k,1610) + lu(k,1622) = lu(k,1622) - lu(k,1161) * lu(k,1610) + lu(k,1625) = lu(k,1625) - lu(k,1162) * lu(k,1610) + lu(k,1629) = lu(k,1629) - lu(k,1163) * lu(k,1610) + lu(k,1630) = lu(k,1630) - lu(k,1164) * lu(k,1610) + lu(k,1631) = lu(k,1631) - lu(k,1165) * lu(k,1610) + lu(k,1663) = lu(k,1663) - lu(k,1154) * lu(k,1661) + lu(k,1664) = lu(k,1664) - lu(k,1155) * lu(k,1661) + lu(k,1665) = lu(k,1665) - lu(k,1156) * lu(k,1661) + lu(k,1666) = lu(k,1666) - lu(k,1157) * lu(k,1661) + lu(k,1668) = lu(k,1668) - lu(k,1158) * lu(k,1661) + lu(k,1669) = lu(k,1669) - lu(k,1159) * lu(k,1661) + lu(k,1671) = lu(k,1671) - lu(k,1160) * lu(k,1661) + lu(k,1672) = lu(k,1672) - lu(k,1161) * lu(k,1661) + lu(k,1675) = lu(k,1675) - lu(k,1162) * lu(k,1661) + lu(k,1679) = lu(k,1679) - lu(k,1163) * lu(k,1661) + lu(k,1680) = lu(k,1680) - lu(k,1164) * lu(k,1661) + lu(k,1681) = lu(k,1681) - lu(k,1165) * lu(k,1661) + lu(k,1823) = lu(k,1823) - lu(k,1154) * lu(k,1821) + lu(k,1824) = lu(k,1824) - lu(k,1155) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,1156) * lu(k,1821) + lu(k,1827) = lu(k,1827) - lu(k,1157) * lu(k,1821) + lu(k,1829) = lu(k,1829) - lu(k,1158) * lu(k,1821) + lu(k,1830) = lu(k,1830) - lu(k,1159) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,1160) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1161) * lu(k,1821) + lu(k,1836) = lu(k,1836) - lu(k,1162) * lu(k,1821) + lu(k,1840) = lu(k,1840) - lu(k,1163) * lu(k,1821) + lu(k,1841) = lu(k,1841) - lu(k,1164) * lu(k,1821) + lu(k,1842) = lu(k,1842) - lu(k,1165) * lu(k,1821) + lu(k,1978) = lu(k,1978) - lu(k,1154) * lu(k,1976) + lu(k,1979) = lu(k,1979) - lu(k,1155) * lu(k,1976) + lu(k,1981) = lu(k,1981) - lu(k,1156) * lu(k,1976) + lu(k,1982) = lu(k,1982) - lu(k,1157) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1158) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,1159) * lu(k,1976) + lu(k,1987) = lu(k,1987) - lu(k,1160) * lu(k,1976) + lu(k,1988) = lu(k,1988) - lu(k,1161) * lu(k,1976) + lu(k,1991) = lu(k,1991) - lu(k,1162) * lu(k,1976) + lu(k,1995) = lu(k,1995) - lu(k,1163) * lu(k,1976) + lu(k,1996) = lu(k,1996) - lu(k,1164) * lu(k,1976) + lu(k,1997) = lu(k,1997) - lu(k,1165) * lu(k,1976) + lu(k,1186) = 1._r8 / lu(k,1186) + lu(k,1187) = lu(k,1187) * lu(k,1186) + lu(k,1188) = lu(k,1188) * lu(k,1186) + lu(k,1189) = lu(k,1189) * lu(k,1186) + lu(k,1190) = lu(k,1190) * lu(k,1186) + lu(k,1191) = lu(k,1191) * lu(k,1186) + lu(k,1192) = lu(k,1192) * lu(k,1186) + lu(k,1193) = lu(k,1193) * lu(k,1186) + lu(k,1194) = lu(k,1194) * lu(k,1186) + lu(k,1195) = lu(k,1195) * lu(k,1186) + lu(k,1196) = lu(k,1196) * lu(k,1186) + lu(k,1197) = lu(k,1197) * lu(k,1186) + lu(k,1198) = lu(k,1198) * lu(k,1186) + lu(k,1199) = lu(k,1199) * lu(k,1186) + lu(k,1235) = lu(k,1235) - lu(k,1187) * lu(k,1234) + lu(k,1236) = lu(k,1236) - lu(k,1188) * lu(k,1234) + lu(k,1237) = lu(k,1237) - lu(k,1189) * lu(k,1234) + lu(k,1238) = lu(k,1238) - lu(k,1190) * lu(k,1234) + lu(k,1239) = lu(k,1239) - lu(k,1191) * lu(k,1234) + lu(k,1240) = lu(k,1240) - lu(k,1192) * lu(k,1234) + lu(k,1241) = lu(k,1241) - lu(k,1193) * lu(k,1234) + lu(k,1242) = lu(k,1242) - lu(k,1194) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,1195) * lu(k,1234) + lu(k,1244) = lu(k,1244) - lu(k,1196) * lu(k,1234) + lu(k,1245) = lu(k,1245) - lu(k,1197) * lu(k,1234) + lu(k,1246) = lu(k,1246) - lu(k,1198) * lu(k,1234) + lu(k,1247) = lu(k,1247) - lu(k,1199) * lu(k,1234) + lu(k,1384) = lu(k,1384) - lu(k,1187) * lu(k,1383) + lu(k,1385) = lu(k,1385) - lu(k,1188) * lu(k,1383) + lu(k,1387) = lu(k,1387) - lu(k,1189) * lu(k,1383) + lu(k,1388) = lu(k,1388) - lu(k,1190) * lu(k,1383) + lu(k,1390) = lu(k,1390) - lu(k,1191) * lu(k,1383) + lu(k,1391) = lu(k,1391) - lu(k,1192) * lu(k,1383) + lu(k,1393) = lu(k,1393) - lu(k,1193) * lu(k,1383) + lu(k,1394) = lu(k,1394) - lu(k,1194) * lu(k,1383) + lu(k,1397) = lu(k,1397) - lu(k,1195) * lu(k,1383) + lu(k,1398) = lu(k,1398) - lu(k,1196) * lu(k,1383) + lu(k,1401) = lu(k,1401) - lu(k,1197) * lu(k,1383) + lu(k,1402) = lu(k,1402) - lu(k,1198) * lu(k,1383) + lu(k,1403) = lu(k,1403) - lu(k,1199) * lu(k,1383) + lu(k,1441) = lu(k,1441) - lu(k,1187) * lu(k,1440) + lu(k,1442) = lu(k,1442) - lu(k,1188) * lu(k,1440) + lu(k,1444) = lu(k,1444) - lu(k,1189) * lu(k,1440) + lu(k,1445) = lu(k,1445) - lu(k,1190) * lu(k,1440) + lu(k,1447) = lu(k,1447) - lu(k,1191) * lu(k,1440) + lu(k,1448) = lu(k,1448) - lu(k,1192) * lu(k,1440) + lu(k,1450) = lu(k,1450) - lu(k,1193) * lu(k,1440) + lu(k,1451) = lu(k,1451) - lu(k,1194) * lu(k,1440) + lu(k,1454) = lu(k,1454) - lu(k,1195) * lu(k,1440) + lu(k,1455) = lu(k,1455) - lu(k,1196) * lu(k,1440) + lu(k,1458) = lu(k,1458) - lu(k,1197) * lu(k,1440) + lu(k,1459) = lu(k,1459) - lu(k,1198) * lu(k,1440) + lu(k,1460) = lu(k,1460) - lu(k,1199) * lu(k,1440) + lu(k,1612) = lu(k,1612) - lu(k,1187) * lu(k,1611) + lu(k,1613) = lu(k,1613) - lu(k,1188) * lu(k,1611) + lu(k,1615) = lu(k,1615) - lu(k,1189) * lu(k,1611) + lu(k,1616) = lu(k,1616) - lu(k,1190) * lu(k,1611) + lu(k,1618) = lu(k,1618) - lu(k,1191) * lu(k,1611) + lu(k,1619) = lu(k,1619) - lu(k,1192) * lu(k,1611) + lu(k,1621) = lu(k,1621) - lu(k,1193) * lu(k,1611) + lu(k,1622) = lu(k,1622) - lu(k,1194) * lu(k,1611) + lu(k,1625) = lu(k,1625) - lu(k,1195) * lu(k,1611) + lu(k,1626) = lu(k,1626) - lu(k,1196) * lu(k,1611) + lu(k,1629) = lu(k,1629) - lu(k,1197) * lu(k,1611) + lu(k,1630) = lu(k,1630) - lu(k,1198) * lu(k,1611) + lu(k,1631) = lu(k,1631) - lu(k,1199) * lu(k,1611) + lu(k,1663) = lu(k,1663) - lu(k,1187) * lu(k,1662) + lu(k,1664) = lu(k,1664) - lu(k,1188) * lu(k,1662) + lu(k,1665) = lu(k,1665) - lu(k,1189) * lu(k,1662) + lu(k,1666) = lu(k,1666) - lu(k,1190) * lu(k,1662) + lu(k,1668) = lu(k,1668) - lu(k,1191) * lu(k,1662) + lu(k,1669) = lu(k,1669) - lu(k,1192) * lu(k,1662) + lu(k,1671) = lu(k,1671) - lu(k,1193) * lu(k,1662) + lu(k,1672) = lu(k,1672) - lu(k,1194) * lu(k,1662) + lu(k,1675) = lu(k,1675) - lu(k,1195) * lu(k,1662) + lu(k,1676) = lu(k,1676) - lu(k,1196) * lu(k,1662) + lu(k,1679) = lu(k,1679) - lu(k,1197) * lu(k,1662) + lu(k,1680) = lu(k,1680) - lu(k,1198) * lu(k,1662) + lu(k,1681) = lu(k,1681) - lu(k,1199) * lu(k,1662) + lu(k,1823) = lu(k,1823) - lu(k,1187) * lu(k,1822) + lu(k,1824) = lu(k,1824) - lu(k,1188) * lu(k,1822) + lu(k,1826) = lu(k,1826) - lu(k,1189) * lu(k,1822) + lu(k,1827) = lu(k,1827) - lu(k,1190) * lu(k,1822) + lu(k,1829) = lu(k,1829) - lu(k,1191) * lu(k,1822) + lu(k,1830) = lu(k,1830) - lu(k,1192) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,1193) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1194) * lu(k,1822) + lu(k,1836) = lu(k,1836) - lu(k,1195) * lu(k,1822) + lu(k,1837) = lu(k,1837) - lu(k,1196) * lu(k,1822) + lu(k,1840) = lu(k,1840) - lu(k,1197) * lu(k,1822) + lu(k,1841) = lu(k,1841) - lu(k,1198) * lu(k,1822) + lu(k,1842) = lu(k,1842) - lu(k,1199) * lu(k,1822) + lu(k,1978) = lu(k,1978) - lu(k,1187) * lu(k,1977) + lu(k,1979) = lu(k,1979) - lu(k,1188) * lu(k,1977) + lu(k,1981) = lu(k,1981) - lu(k,1189) * lu(k,1977) + lu(k,1982) = lu(k,1982) - lu(k,1190) * lu(k,1977) + lu(k,1984) = lu(k,1984) - lu(k,1191) * lu(k,1977) + lu(k,1985) = lu(k,1985) - lu(k,1192) * lu(k,1977) + lu(k,1987) = lu(k,1987) - lu(k,1193) * lu(k,1977) + lu(k,1988) = lu(k,1988) - lu(k,1194) * lu(k,1977) + lu(k,1991) = lu(k,1991) - lu(k,1195) * lu(k,1977) + lu(k,1992) = lu(k,1992) - lu(k,1196) * lu(k,1977) + lu(k,1995) = lu(k,1995) - lu(k,1197) * lu(k,1977) + lu(k,1996) = lu(k,1996) - lu(k,1198) * lu(k,1977) + lu(k,1997) = lu(k,1997) - lu(k,1199) * lu(k,1977) + lu(k,1205) = 1._r8 / lu(k,1205) + lu(k,1206) = lu(k,1206) * lu(k,1205) + lu(k,1207) = lu(k,1207) * lu(k,1205) + lu(k,1208) = lu(k,1208) * lu(k,1205) + lu(k,1209) = lu(k,1209) * lu(k,1205) + lu(k,1210) = lu(k,1210) * lu(k,1205) + lu(k,1211) = lu(k,1211) * lu(k,1205) + lu(k,1212) = lu(k,1212) * lu(k,1205) + lu(k,1213) = lu(k,1213) * lu(k,1205) + lu(k,1214) = lu(k,1214) * lu(k,1205) + lu(k,1215) = lu(k,1215) * lu(k,1205) + lu(k,1216) = lu(k,1216) * lu(k,1205) + lu(k,1217) = lu(k,1217) * lu(k,1205) + lu(k,1236) = lu(k,1236) - lu(k,1206) * lu(k,1235) + lu(k,1237) = lu(k,1237) - lu(k,1207) * lu(k,1235) + lu(k,1238) = lu(k,1238) - lu(k,1208) * lu(k,1235) + lu(k,1239) = lu(k,1239) - lu(k,1209) * lu(k,1235) + lu(k,1240) = lu(k,1240) - lu(k,1210) * lu(k,1235) + lu(k,1241) = lu(k,1241) - lu(k,1211) * lu(k,1235) + lu(k,1242) = lu(k,1242) - lu(k,1212) * lu(k,1235) + lu(k,1243) = lu(k,1243) - lu(k,1213) * lu(k,1235) + lu(k,1244) = lu(k,1244) - lu(k,1214) * lu(k,1235) + lu(k,1245) = lu(k,1245) - lu(k,1215) * lu(k,1235) + lu(k,1246) = lu(k,1246) - lu(k,1216) * lu(k,1235) + lu(k,1247) = lu(k,1247) - lu(k,1217) * lu(k,1235) + lu(k,1385) = lu(k,1385) - lu(k,1206) * lu(k,1384) + lu(k,1387) = lu(k,1387) - lu(k,1207) * lu(k,1384) + lu(k,1388) = lu(k,1388) - lu(k,1208) * lu(k,1384) + lu(k,1390) = lu(k,1390) - lu(k,1209) * lu(k,1384) + lu(k,1391) = lu(k,1391) - lu(k,1210) * lu(k,1384) + lu(k,1393) = lu(k,1393) - lu(k,1211) * lu(k,1384) + lu(k,1394) = lu(k,1394) - lu(k,1212) * lu(k,1384) + lu(k,1397) = lu(k,1397) - lu(k,1213) * lu(k,1384) + lu(k,1398) = lu(k,1398) - lu(k,1214) * lu(k,1384) + lu(k,1401) = lu(k,1401) - lu(k,1215) * lu(k,1384) + lu(k,1402) = lu(k,1402) - lu(k,1216) * lu(k,1384) + lu(k,1403) = lu(k,1403) - lu(k,1217) * lu(k,1384) + lu(k,1442) = lu(k,1442) - lu(k,1206) * lu(k,1441) + lu(k,1444) = lu(k,1444) - lu(k,1207) * lu(k,1441) + lu(k,1445) = lu(k,1445) - lu(k,1208) * lu(k,1441) + lu(k,1447) = lu(k,1447) - lu(k,1209) * lu(k,1441) + lu(k,1448) = lu(k,1448) - lu(k,1210) * lu(k,1441) + lu(k,1450) = lu(k,1450) - lu(k,1211) * lu(k,1441) + lu(k,1451) = lu(k,1451) - lu(k,1212) * lu(k,1441) + lu(k,1454) = lu(k,1454) - lu(k,1213) * lu(k,1441) + lu(k,1455) = lu(k,1455) - lu(k,1214) * lu(k,1441) + lu(k,1458) = lu(k,1458) - lu(k,1215) * lu(k,1441) + lu(k,1459) = lu(k,1459) - lu(k,1216) * lu(k,1441) + lu(k,1460) = lu(k,1460) - lu(k,1217) * lu(k,1441) + lu(k,1613) = lu(k,1613) - lu(k,1206) * lu(k,1612) + lu(k,1615) = lu(k,1615) - lu(k,1207) * lu(k,1612) + lu(k,1616) = lu(k,1616) - lu(k,1208) * lu(k,1612) + lu(k,1618) = lu(k,1618) - lu(k,1209) * lu(k,1612) + lu(k,1619) = lu(k,1619) - lu(k,1210) * lu(k,1612) + lu(k,1621) = lu(k,1621) - lu(k,1211) * lu(k,1612) + lu(k,1622) = lu(k,1622) - lu(k,1212) * lu(k,1612) + lu(k,1625) = lu(k,1625) - lu(k,1213) * lu(k,1612) + lu(k,1626) = lu(k,1626) - lu(k,1214) * lu(k,1612) + lu(k,1629) = lu(k,1629) - lu(k,1215) * lu(k,1612) + lu(k,1630) = lu(k,1630) - lu(k,1216) * lu(k,1612) + lu(k,1631) = lu(k,1631) - lu(k,1217) * lu(k,1612) + lu(k,1664) = lu(k,1664) - lu(k,1206) * lu(k,1663) + lu(k,1665) = lu(k,1665) - lu(k,1207) * lu(k,1663) + lu(k,1666) = lu(k,1666) - lu(k,1208) * lu(k,1663) + lu(k,1668) = lu(k,1668) - lu(k,1209) * lu(k,1663) + lu(k,1669) = lu(k,1669) - lu(k,1210) * lu(k,1663) + lu(k,1671) = lu(k,1671) - lu(k,1211) * lu(k,1663) + lu(k,1672) = lu(k,1672) - lu(k,1212) * lu(k,1663) + lu(k,1675) = lu(k,1675) - lu(k,1213) * lu(k,1663) + lu(k,1676) = lu(k,1676) - lu(k,1214) * lu(k,1663) + lu(k,1679) = lu(k,1679) - lu(k,1215) * lu(k,1663) + lu(k,1680) = lu(k,1680) - lu(k,1216) * lu(k,1663) + lu(k,1681) = lu(k,1681) - lu(k,1217) * lu(k,1663) + lu(k,1764) = lu(k,1764) - lu(k,1206) * lu(k,1763) + lu(k,1766) = lu(k,1766) - lu(k,1207) * lu(k,1763) + lu(k,1767) = lu(k,1767) - lu(k,1208) * lu(k,1763) + lu(k,1769) = lu(k,1769) - lu(k,1209) * lu(k,1763) + lu(k,1770) = lu(k,1770) - lu(k,1210) * lu(k,1763) + lu(k,1772) = lu(k,1772) - lu(k,1211) * lu(k,1763) + lu(k,1773) = lu(k,1773) - lu(k,1212) * lu(k,1763) + lu(k,1776) = lu(k,1776) - lu(k,1213) * lu(k,1763) + lu(k,1777) = lu(k,1777) - lu(k,1214) * lu(k,1763) + lu(k,1780) = lu(k,1780) - lu(k,1215) * lu(k,1763) + lu(k,1781) = lu(k,1781) - lu(k,1216) * lu(k,1763) + lu(k,1782) = lu(k,1782) - lu(k,1217) * lu(k,1763) + lu(k,1824) = lu(k,1824) - lu(k,1206) * lu(k,1823) + lu(k,1826) = lu(k,1826) - lu(k,1207) * lu(k,1823) + lu(k,1827) = lu(k,1827) - lu(k,1208) * lu(k,1823) + lu(k,1829) = lu(k,1829) - lu(k,1209) * lu(k,1823) + lu(k,1830) = lu(k,1830) - lu(k,1210) * lu(k,1823) + lu(k,1832) = lu(k,1832) - lu(k,1211) * lu(k,1823) + lu(k,1833) = lu(k,1833) - lu(k,1212) * lu(k,1823) + lu(k,1836) = lu(k,1836) - lu(k,1213) * lu(k,1823) + lu(k,1837) = lu(k,1837) - lu(k,1214) * lu(k,1823) + lu(k,1840) = lu(k,1840) - lu(k,1215) * lu(k,1823) + lu(k,1841) = lu(k,1841) - lu(k,1216) * lu(k,1823) + lu(k,1842) = lu(k,1842) - lu(k,1217) * lu(k,1823) + lu(k,1979) = lu(k,1979) - lu(k,1206) * lu(k,1978) + lu(k,1981) = lu(k,1981) - lu(k,1207) * lu(k,1978) + lu(k,1982) = lu(k,1982) - lu(k,1208) * lu(k,1978) + lu(k,1984) = lu(k,1984) - lu(k,1209) * lu(k,1978) + lu(k,1985) = lu(k,1985) - lu(k,1210) * lu(k,1978) + lu(k,1987) = lu(k,1987) - lu(k,1211) * lu(k,1978) + lu(k,1988) = lu(k,1988) - lu(k,1212) * lu(k,1978) + lu(k,1991) = lu(k,1991) - lu(k,1213) * lu(k,1978) + lu(k,1992) = lu(k,1992) - lu(k,1214) * lu(k,1978) + lu(k,1995) = lu(k,1995) - lu(k,1215) * lu(k,1978) + lu(k,1996) = lu(k,1996) - lu(k,1216) * lu(k,1978) + lu(k,1997) = lu(k,1997) - lu(k,1217) * lu(k,1978) + lu(k,1236) = 1._r8 / lu(k,1236) + lu(k,1237) = lu(k,1237) * lu(k,1236) + lu(k,1238) = lu(k,1238) * lu(k,1236) + lu(k,1239) = lu(k,1239) * lu(k,1236) + lu(k,1240) = lu(k,1240) * lu(k,1236) + lu(k,1241) = lu(k,1241) * lu(k,1236) + lu(k,1242) = lu(k,1242) * lu(k,1236) + lu(k,1243) = lu(k,1243) * lu(k,1236) + lu(k,1244) = lu(k,1244) * lu(k,1236) + lu(k,1245) = lu(k,1245) * lu(k,1236) + lu(k,1246) = lu(k,1246) * lu(k,1236) + lu(k,1247) = lu(k,1247) * lu(k,1236) + lu(k,1387) = lu(k,1387) - lu(k,1237) * lu(k,1385) + lu(k,1388) = lu(k,1388) - lu(k,1238) * lu(k,1385) + lu(k,1390) = lu(k,1390) - lu(k,1239) * lu(k,1385) + lu(k,1391) = lu(k,1391) - lu(k,1240) * lu(k,1385) + lu(k,1393) = lu(k,1393) - lu(k,1241) * lu(k,1385) + lu(k,1394) = lu(k,1394) - lu(k,1242) * lu(k,1385) + lu(k,1397) = lu(k,1397) - lu(k,1243) * lu(k,1385) + lu(k,1398) = lu(k,1398) - lu(k,1244) * lu(k,1385) + lu(k,1401) = lu(k,1401) - lu(k,1245) * lu(k,1385) + lu(k,1402) = lu(k,1402) - lu(k,1246) * lu(k,1385) + lu(k,1403) = lu(k,1403) - lu(k,1247) * lu(k,1385) + lu(k,1444) = lu(k,1444) - lu(k,1237) * lu(k,1442) + lu(k,1445) = lu(k,1445) - lu(k,1238) * lu(k,1442) + lu(k,1447) = lu(k,1447) - lu(k,1239) * lu(k,1442) + lu(k,1448) = lu(k,1448) - lu(k,1240) * lu(k,1442) + lu(k,1450) = lu(k,1450) - lu(k,1241) * lu(k,1442) + lu(k,1451) = lu(k,1451) - lu(k,1242) * lu(k,1442) + lu(k,1454) = lu(k,1454) - lu(k,1243) * lu(k,1442) + lu(k,1455) = lu(k,1455) - lu(k,1244) * lu(k,1442) + lu(k,1458) = lu(k,1458) - lu(k,1245) * lu(k,1442) + lu(k,1459) = lu(k,1459) - lu(k,1246) * lu(k,1442) + lu(k,1460) = lu(k,1460) - lu(k,1247) * lu(k,1442) + lu(k,1615) = lu(k,1615) - lu(k,1237) * lu(k,1613) + lu(k,1616) = lu(k,1616) - lu(k,1238) * lu(k,1613) + lu(k,1618) = lu(k,1618) - lu(k,1239) * lu(k,1613) + lu(k,1619) = lu(k,1619) - lu(k,1240) * lu(k,1613) + lu(k,1621) = lu(k,1621) - lu(k,1241) * lu(k,1613) + lu(k,1622) = lu(k,1622) - lu(k,1242) * lu(k,1613) + lu(k,1625) = lu(k,1625) - lu(k,1243) * lu(k,1613) + lu(k,1626) = lu(k,1626) - lu(k,1244) * lu(k,1613) + lu(k,1629) = lu(k,1629) - lu(k,1245) * lu(k,1613) + lu(k,1630) = lu(k,1630) - lu(k,1246) * lu(k,1613) + lu(k,1631) = lu(k,1631) - lu(k,1247) * lu(k,1613) + lu(k,1665) = lu(k,1665) - lu(k,1237) * lu(k,1664) + lu(k,1666) = lu(k,1666) - lu(k,1238) * lu(k,1664) + lu(k,1668) = lu(k,1668) - lu(k,1239) * lu(k,1664) + lu(k,1669) = lu(k,1669) - lu(k,1240) * lu(k,1664) + lu(k,1671) = lu(k,1671) - lu(k,1241) * lu(k,1664) + lu(k,1672) = lu(k,1672) - lu(k,1242) * lu(k,1664) + lu(k,1675) = lu(k,1675) - lu(k,1243) * lu(k,1664) + lu(k,1676) = lu(k,1676) - lu(k,1244) * lu(k,1664) + lu(k,1679) = lu(k,1679) - lu(k,1245) * lu(k,1664) + lu(k,1680) = lu(k,1680) - lu(k,1246) * lu(k,1664) + lu(k,1681) = lu(k,1681) - lu(k,1247) * lu(k,1664) + lu(k,1725) = lu(k,1725) - lu(k,1237) * lu(k,1723) + lu(k,1726) = lu(k,1726) - lu(k,1238) * lu(k,1723) + lu(k,1728) = lu(k,1728) - lu(k,1239) * lu(k,1723) + lu(k,1729) = lu(k,1729) - lu(k,1240) * lu(k,1723) + lu(k,1731) = lu(k,1731) - lu(k,1241) * lu(k,1723) + lu(k,1732) = lu(k,1732) - lu(k,1242) * lu(k,1723) + lu(k,1735) = lu(k,1735) - lu(k,1243) * lu(k,1723) + lu(k,1736) = lu(k,1736) - lu(k,1244) * lu(k,1723) + lu(k,1739) = lu(k,1739) - lu(k,1245) * lu(k,1723) + lu(k,1740) = lu(k,1740) - lu(k,1246) * lu(k,1723) + lu(k,1741) = lu(k,1741) - lu(k,1247) * lu(k,1723) + lu(k,1766) = lu(k,1766) - lu(k,1237) * lu(k,1764) + lu(k,1767) = lu(k,1767) - lu(k,1238) * lu(k,1764) + lu(k,1769) = lu(k,1769) - lu(k,1239) * lu(k,1764) + lu(k,1770) = lu(k,1770) - lu(k,1240) * lu(k,1764) + lu(k,1772) = lu(k,1772) - lu(k,1241) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1242) * lu(k,1764) + lu(k,1776) = lu(k,1776) - lu(k,1243) * lu(k,1764) + lu(k,1777) = lu(k,1777) - lu(k,1244) * lu(k,1764) + lu(k,1780) = lu(k,1780) - lu(k,1245) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1246) * lu(k,1764) + lu(k,1782) = lu(k,1782) - lu(k,1247) * lu(k,1764) + lu(k,1826) = lu(k,1826) - lu(k,1237) * lu(k,1824) + lu(k,1827) = lu(k,1827) - lu(k,1238) * lu(k,1824) + lu(k,1829) = lu(k,1829) - lu(k,1239) * lu(k,1824) + lu(k,1830) = lu(k,1830) - lu(k,1240) * lu(k,1824) + lu(k,1832) = lu(k,1832) - lu(k,1241) * lu(k,1824) + lu(k,1833) = lu(k,1833) - lu(k,1242) * lu(k,1824) + lu(k,1836) = lu(k,1836) - lu(k,1243) * lu(k,1824) + lu(k,1837) = lu(k,1837) - lu(k,1244) * lu(k,1824) + lu(k,1840) = lu(k,1840) - lu(k,1245) * lu(k,1824) + lu(k,1841) = lu(k,1841) - lu(k,1246) * lu(k,1824) + lu(k,1842) = lu(k,1842) - lu(k,1247) * lu(k,1824) + lu(k,1981) = lu(k,1981) - lu(k,1237) * lu(k,1979) + lu(k,1982) = lu(k,1982) - lu(k,1238) * lu(k,1979) + lu(k,1984) = lu(k,1984) - lu(k,1239) * lu(k,1979) + lu(k,1985) = lu(k,1985) - lu(k,1240) * lu(k,1979) + lu(k,1987) = lu(k,1987) - lu(k,1241) * lu(k,1979) + lu(k,1988) = lu(k,1988) - lu(k,1242) * lu(k,1979) + lu(k,1991) = lu(k,1991) - lu(k,1243) * lu(k,1979) + lu(k,1992) = lu(k,1992) - lu(k,1244) * lu(k,1979) + lu(k,1995) = lu(k,1995) - lu(k,1245) * lu(k,1979) + lu(k,1996) = lu(k,1996) - lu(k,1246) * lu(k,1979) + lu(k,1997) = lu(k,1997) - lu(k,1247) * lu(k,1979) + end do + end subroutine lu_fac24 + subroutine lu_fac25( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1250) = 1._r8 / lu(k,1250) + lu(k,1251) = lu(k,1251) * lu(k,1250) + lu(k,1252) = lu(k,1252) * lu(k,1250) + lu(k,1253) = lu(k,1253) * lu(k,1250) + lu(k,1254) = lu(k,1254) * lu(k,1250) + lu(k,1255) = lu(k,1255) * lu(k,1250) + lu(k,1256) = lu(k,1256) * lu(k,1250) + lu(k,1257) = lu(k,1257) * lu(k,1250) + lu(k,1258) = lu(k,1258) * lu(k,1250) + lu(k,1259) = lu(k,1259) * lu(k,1250) + lu(k,1295) = lu(k,1295) - lu(k,1251) * lu(k,1293) + lu(k,1297) = - lu(k,1252) * lu(k,1293) + lu(k,1299) = lu(k,1299) - lu(k,1253) * lu(k,1293) + lu(k,1300) = lu(k,1300) - lu(k,1254) * lu(k,1293) + lu(k,1305) = - lu(k,1255) * lu(k,1293) + lu(k,1306) = lu(k,1306) - lu(k,1256) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1257) * lu(k,1293) + lu(k,1308) = - lu(k,1258) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1259) * lu(k,1293) + lu(k,1388) = lu(k,1388) - lu(k,1251) * lu(k,1386) + lu(k,1390) = lu(k,1390) - lu(k,1252) * lu(k,1386) + lu(k,1392) = lu(k,1392) - lu(k,1253) * lu(k,1386) + lu(k,1393) = lu(k,1393) - lu(k,1254) * lu(k,1386) + lu(k,1398) = lu(k,1398) - lu(k,1255) * lu(k,1386) + lu(k,1399) = lu(k,1399) - lu(k,1256) * lu(k,1386) + lu(k,1400) = lu(k,1400) - lu(k,1257) * lu(k,1386) + lu(k,1401) = lu(k,1401) - lu(k,1258) * lu(k,1386) + lu(k,1403) = lu(k,1403) - lu(k,1259) * lu(k,1386) + lu(k,1445) = lu(k,1445) - lu(k,1251) * lu(k,1443) + lu(k,1447) = lu(k,1447) - lu(k,1252) * lu(k,1443) + lu(k,1449) = - lu(k,1253) * lu(k,1443) + lu(k,1450) = lu(k,1450) - lu(k,1254) * lu(k,1443) + lu(k,1455) = lu(k,1455) - lu(k,1255) * lu(k,1443) + lu(k,1456) = lu(k,1456) - lu(k,1256) * lu(k,1443) + lu(k,1457) = lu(k,1457) - lu(k,1257) * lu(k,1443) + lu(k,1458) = lu(k,1458) - lu(k,1258) * lu(k,1443) + lu(k,1460) = lu(k,1460) - lu(k,1259) * lu(k,1443) + lu(k,1469) = lu(k,1469) - lu(k,1251) * lu(k,1467) + lu(k,1471) = lu(k,1471) - lu(k,1252) * lu(k,1467) + lu(k,1473) = lu(k,1473) - lu(k,1253) * lu(k,1467) + lu(k,1474) = lu(k,1474) - lu(k,1254) * lu(k,1467) + lu(k,1479) = lu(k,1479) - lu(k,1255) * lu(k,1467) + lu(k,1480) = lu(k,1480) - lu(k,1256) * lu(k,1467) + lu(k,1481) = lu(k,1481) - lu(k,1257) * lu(k,1467) + lu(k,1482) = lu(k,1482) - lu(k,1258) * lu(k,1467) + lu(k,1484) = lu(k,1484) - lu(k,1259) * lu(k,1467) + lu(k,1616) = lu(k,1616) - lu(k,1251) * lu(k,1614) + lu(k,1618) = lu(k,1618) - lu(k,1252) * lu(k,1614) + lu(k,1620) = lu(k,1620) - lu(k,1253) * lu(k,1614) + lu(k,1621) = lu(k,1621) - lu(k,1254) * lu(k,1614) + lu(k,1626) = lu(k,1626) - lu(k,1255) * lu(k,1614) + lu(k,1627) = lu(k,1627) - lu(k,1256) * lu(k,1614) + lu(k,1628) = lu(k,1628) - lu(k,1257) * lu(k,1614) + lu(k,1629) = lu(k,1629) - lu(k,1258) * lu(k,1614) + lu(k,1631) = lu(k,1631) - lu(k,1259) * lu(k,1614) + lu(k,1692) = lu(k,1692) - lu(k,1251) * lu(k,1690) + lu(k,1694) = lu(k,1694) - lu(k,1252) * lu(k,1690) + lu(k,1696) = - lu(k,1253) * lu(k,1690) + lu(k,1697) = lu(k,1697) - lu(k,1254) * lu(k,1690) + lu(k,1702) = lu(k,1702) - lu(k,1255) * lu(k,1690) + lu(k,1703) = lu(k,1703) - lu(k,1256) * lu(k,1690) + lu(k,1704) = lu(k,1704) - lu(k,1257) * lu(k,1690) + lu(k,1705) = lu(k,1705) - lu(k,1258) * lu(k,1690) + lu(k,1707) = lu(k,1707) - lu(k,1259) * lu(k,1690) + lu(k,1726) = lu(k,1726) - lu(k,1251) * lu(k,1724) + lu(k,1728) = lu(k,1728) - lu(k,1252) * lu(k,1724) + lu(k,1730) = lu(k,1730) - lu(k,1253) * lu(k,1724) + lu(k,1731) = lu(k,1731) - lu(k,1254) * lu(k,1724) + lu(k,1736) = lu(k,1736) - lu(k,1255) * lu(k,1724) + lu(k,1737) = - lu(k,1256) * lu(k,1724) + lu(k,1738) = lu(k,1738) - lu(k,1257) * lu(k,1724) + lu(k,1739) = lu(k,1739) - lu(k,1258) * lu(k,1724) + lu(k,1741) = lu(k,1741) - lu(k,1259) * lu(k,1724) + lu(k,1767) = lu(k,1767) - lu(k,1251) * lu(k,1765) + lu(k,1769) = lu(k,1769) - lu(k,1252) * lu(k,1765) + lu(k,1771) = - lu(k,1253) * lu(k,1765) + lu(k,1772) = lu(k,1772) - lu(k,1254) * lu(k,1765) + lu(k,1777) = lu(k,1777) - lu(k,1255) * lu(k,1765) + lu(k,1778) = lu(k,1778) - lu(k,1256) * lu(k,1765) + lu(k,1779) = lu(k,1779) - lu(k,1257) * lu(k,1765) + lu(k,1780) = lu(k,1780) - lu(k,1258) * lu(k,1765) + lu(k,1782) = lu(k,1782) - lu(k,1259) * lu(k,1765) + lu(k,1827) = lu(k,1827) - lu(k,1251) * lu(k,1825) + lu(k,1829) = lu(k,1829) - lu(k,1252) * lu(k,1825) + lu(k,1831) = lu(k,1831) - lu(k,1253) * lu(k,1825) + lu(k,1832) = lu(k,1832) - lu(k,1254) * lu(k,1825) + lu(k,1837) = lu(k,1837) - lu(k,1255) * lu(k,1825) + lu(k,1838) = lu(k,1838) - lu(k,1256) * lu(k,1825) + lu(k,1839) = lu(k,1839) - lu(k,1257) * lu(k,1825) + lu(k,1840) = lu(k,1840) - lu(k,1258) * lu(k,1825) + lu(k,1842) = lu(k,1842) - lu(k,1259) * lu(k,1825) + lu(k,1851) = lu(k,1851) - lu(k,1251) * lu(k,1849) + lu(k,1853) = lu(k,1853) - lu(k,1252) * lu(k,1849) + lu(k,1855) = - lu(k,1253) * lu(k,1849) + lu(k,1856) = lu(k,1856) - lu(k,1254) * lu(k,1849) + lu(k,1861) = lu(k,1861) - lu(k,1255) * lu(k,1849) + lu(k,1862) = lu(k,1862) - lu(k,1256) * lu(k,1849) + lu(k,1863) = lu(k,1863) - lu(k,1257) * lu(k,1849) + lu(k,1864) = - lu(k,1258) * lu(k,1849) + lu(k,1866) = lu(k,1866) - lu(k,1259) * lu(k,1849) + lu(k,1881) = lu(k,1881) - lu(k,1251) * lu(k,1879) + lu(k,1883) = lu(k,1883) - lu(k,1252) * lu(k,1879) + lu(k,1885) = lu(k,1885) - lu(k,1253) * lu(k,1879) + lu(k,1886) = lu(k,1886) - lu(k,1254) * lu(k,1879) + lu(k,1891) = lu(k,1891) - lu(k,1255) * lu(k,1879) + lu(k,1892) = lu(k,1892) - lu(k,1256) * lu(k,1879) + lu(k,1893) = lu(k,1893) - lu(k,1257) * lu(k,1879) + lu(k,1894) = lu(k,1894) - lu(k,1258) * lu(k,1879) + lu(k,1896) = lu(k,1896) - lu(k,1259) * lu(k,1879) + lu(k,1904) = lu(k,1904) - lu(k,1251) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1252) * lu(k,1902) + lu(k,1908) = lu(k,1908) - lu(k,1253) * lu(k,1902) + lu(k,1909) = lu(k,1909) - lu(k,1254) * lu(k,1902) + lu(k,1914) = - lu(k,1255) * lu(k,1902) + lu(k,1915) = lu(k,1915) - lu(k,1256) * lu(k,1902) + lu(k,1916) = lu(k,1916) - lu(k,1257) * lu(k,1902) + lu(k,1917) = lu(k,1917) - lu(k,1258) * lu(k,1902) + lu(k,1919) = lu(k,1919) - lu(k,1259) * lu(k,1902) + lu(k,1982) = lu(k,1982) - lu(k,1251) * lu(k,1980) + lu(k,1984) = lu(k,1984) - lu(k,1252) * lu(k,1980) + lu(k,1986) = - lu(k,1253) * lu(k,1980) + lu(k,1987) = lu(k,1987) - lu(k,1254) * lu(k,1980) + lu(k,1992) = lu(k,1992) - lu(k,1255) * lu(k,1980) + lu(k,1993) = lu(k,1993) - lu(k,1256) * lu(k,1980) + lu(k,1994) = lu(k,1994) - lu(k,1257) * lu(k,1980) + lu(k,1995) = lu(k,1995) - lu(k,1258) * lu(k,1980) + lu(k,1997) = lu(k,1997) - lu(k,1259) * lu(k,1980) + lu(k,2007) = lu(k,2007) - lu(k,1251) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1252) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1253) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,1254) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1255) * lu(k,2005) + lu(k,2018) = lu(k,2018) - lu(k,1256) * lu(k,2005) + lu(k,2019) = lu(k,2019) - lu(k,1257) * lu(k,2005) + lu(k,2020) = - lu(k,1258) * lu(k,2005) + lu(k,2022) = lu(k,2022) - lu(k,1259) * lu(k,2005) + lu(k,1263) = 1._r8 / lu(k,1263) + lu(k,1264) = lu(k,1264) * lu(k,1263) + lu(k,1265) = lu(k,1265) * lu(k,1263) + lu(k,1266) = lu(k,1266) * lu(k,1263) + lu(k,1267) = lu(k,1267) * lu(k,1263) + lu(k,1268) = lu(k,1268) * lu(k,1263) + lu(k,1269) = lu(k,1269) * lu(k,1263) + lu(k,1270) = lu(k,1270) * lu(k,1263) + lu(k,1271) = lu(k,1271) * lu(k,1263) + lu(k,1272) = lu(k,1272) * lu(k,1263) + lu(k,1273) = lu(k,1273) * lu(k,1263) + lu(k,1276) = lu(k,1276) - lu(k,1264) * lu(k,1275) + lu(k,1277) = lu(k,1277) - lu(k,1265) * lu(k,1275) + lu(k,1279) = lu(k,1279) - lu(k,1266) * lu(k,1275) + lu(k,1280) = lu(k,1280) - lu(k,1267) * lu(k,1275) + lu(k,1281) = lu(k,1281) - lu(k,1268) * lu(k,1275) + lu(k,1282) = lu(k,1282) - lu(k,1269) * lu(k,1275) + lu(k,1283) = lu(k,1283) - lu(k,1270) * lu(k,1275) + lu(k,1284) = - lu(k,1271) * lu(k,1275) + lu(k,1286) = lu(k,1286) - lu(k,1272) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,1273) * lu(k,1275) + lu(k,1295) = lu(k,1295) - lu(k,1264) * lu(k,1294) + lu(k,1296) = lu(k,1296) - lu(k,1265) * lu(k,1294) + lu(k,1298) = lu(k,1298) - lu(k,1266) * lu(k,1294) + lu(k,1299) = lu(k,1299) - lu(k,1267) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,1268) * lu(k,1294) + lu(k,1301) = - lu(k,1269) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,1270) * lu(k,1294) + lu(k,1304) = lu(k,1304) - lu(k,1271) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,1272) * lu(k,1294) + lu(k,1309) = lu(k,1309) - lu(k,1273) * lu(k,1294) + lu(k,1388) = lu(k,1388) - lu(k,1264) * lu(k,1387) + lu(k,1389) = lu(k,1389) - lu(k,1265) * lu(k,1387) + lu(k,1391) = lu(k,1391) - lu(k,1266) * lu(k,1387) + lu(k,1392) = lu(k,1392) - lu(k,1267) * lu(k,1387) + lu(k,1393) = lu(k,1393) - lu(k,1268) * lu(k,1387) + lu(k,1394) = lu(k,1394) - lu(k,1269) * lu(k,1387) + lu(k,1396) = lu(k,1396) - lu(k,1270) * lu(k,1387) + lu(k,1397) = lu(k,1397) - lu(k,1271) * lu(k,1387) + lu(k,1400) = lu(k,1400) - lu(k,1272) * lu(k,1387) + lu(k,1403) = lu(k,1403) - lu(k,1273) * lu(k,1387) + lu(k,1445) = lu(k,1445) - lu(k,1264) * lu(k,1444) + lu(k,1446) = - lu(k,1265) * lu(k,1444) + lu(k,1448) = lu(k,1448) - lu(k,1266) * lu(k,1444) + lu(k,1449) = lu(k,1449) - lu(k,1267) * lu(k,1444) + lu(k,1450) = lu(k,1450) - lu(k,1268) * lu(k,1444) + lu(k,1451) = lu(k,1451) - lu(k,1269) * lu(k,1444) + lu(k,1453) = lu(k,1453) - lu(k,1270) * lu(k,1444) + lu(k,1454) = lu(k,1454) - lu(k,1271) * lu(k,1444) + lu(k,1457) = lu(k,1457) - lu(k,1272) * lu(k,1444) + lu(k,1460) = lu(k,1460) - lu(k,1273) * lu(k,1444) + lu(k,1469) = lu(k,1469) - lu(k,1264) * lu(k,1468) + lu(k,1470) = lu(k,1470) - lu(k,1265) * lu(k,1468) + lu(k,1472) = lu(k,1472) - lu(k,1266) * lu(k,1468) + lu(k,1473) = lu(k,1473) - lu(k,1267) * lu(k,1468) + lu(k,1474) = lu(k,1474) - lu(k,1268) * lu(k,1468) + lu(k,1475) = lu(k,1475) - lu(k,1269) * lu(k,1468) + lu(k,1477) = lu(k,1477) - lu(k,1270) * lu(k,1468) + lu(k,1478) = - lu(k,1271) * lu(k,1468) + lu(k,1481) = lu(k,1481) - lu(k,1272) * lu(k,1468) + lu(k,1484) = lu(k,1484) - lu(k,1273) * lu(k,1468) + lu(k,1616) = lu(k,1616) - lu(k,1264) * lu(k,1615) + lu(k,1617) = lu(k,1617) - lu(k,1265) * lu(k,1615) + lu(k,1619) = lu(k,1619) - lu(k,1266) * lu(k,1615) + lu(k,1620) = lu(k,1620) - lu(k,1267) * lu(k,1615) + lu(k,1621) = lu(k,1621) - lu(k,1268) * lu(k,1615) + lu(k,1622) = lu(k,1622) - lu(k,1269) * lu(k,1615) + lu(k,1624) = lu(k,1624) - lu(k,1270) * lu(k,1615) + lu(k,1625) = lu(k,1625) - lu(k,1271) * lu(k,1615) + lu(k,1628) = lu(k,1628) - lu(k,1272) * lu(k,1615) + lu(k,1631) = lu(k,1631) - lu(k,1273) * lu(k,1615) + lu(k,1666) = lu(k,1666) - lu(k,1264) * lu(k,1665) + lu(k,1667) = - lu(k,1265) * lu(k,1665) + lu(k,1669) = lu(k,1669) - lu(k,1266) * lu(k,1665) + lu(k,1670) = - lu(k,1267) * lu(k,1665) + lu(k,1671) = lu(k,1671) - lu(k,1268) * lu(k,1665) + lu(k,1672) = lu(k,1672) - lu(k,1269) * lu(k,1665) + lu(k,1674) = lu(k,1674) - lu(k,1270) * lu(k,1665) + lu(k,1675) = lu(k,1675) - lu(k,1271) * lu(k,1665) + lu(k,1678) = - lu(k,1272) * lu(k,1665) + lu(k,1681) = lu(k,1681) - lu(k,1273) * lu(k,1665) + lu(k,1692) = lu(k,1692) - lu(k,1264) * lu(k,1691) + lu(k,1693) = lu(k,1693) - lu(k,1265) * lu(k,1691) + lu(k,1695) = lu(k,1695) - lu(k,1266) * lu(k,1691) + lu(k,1696) = lu(k,1696) - lu(k,1267) * lu(k,1691) + lu(k,1697) = lu(k,1697) - lu(k,1268) * lu(k,1691) + lu(k,1698) = lu(k,1698) - lu(k,1269) * lu(k,1691) + lu(k,1700) = lu(k,1700) - lu(k,1270) * lu(k,1691) + lu(k,1701) = lu(k,1701) - lu(k,1271) * lu(k,1691) + lu(k,1704) = lu(k,1704) - lu(k,1272) * lu(k,1691) + lu(k,1707) = lu(k,1707) - lu(k,1273) * lu(k,1691) + lu(k,1726) = lu(k,1726) - lu(k,1264) * lu(k,1725) + lu(k,1727) = lu(k,1727) - lu(k,1265) * lu(k,1725) + lu(k,1729) = lu(k,1729) - lu(k,1266) * lu(k,1725) + lu(k,1730) = lu(k,1730) - lu(k,1267) * lu(k,1725) + lu(k,1731) = lu(k,1731) - lu(k,1268) * lu(k,1725) + lu(k,1732) = lu(k,1732) - lu(k,1269) * lu(k,1725) + lu(k,1734) = lu(k,1734) - lu(k,1270) * lu(k,1725) + lu(k,1735) = lu(k,1735) - lu(k,1271) * lu(k,1725) + lu(k,1738) = lu(k,1738) - lu(k,1272) * lu(k,1725) + lu(k,1741) = lu(k,1741) - lu(k,1273) * lu(k,1725) + lu(k,1767) = lu(k,1767) - lu(k,1264) * lu(k,1766) + lu(k,1768) = lu(k,1768) - lu(k,1265) * lu(k,1766) + lu(k,1770) = lu(k,1770) - lu(k,1266) * lu(k,1766) + lu(k,1771) = lu(k,1771) - lu(k,1267) * lu(k,1766) + lu(k,1772) = lu(k,1772) - lu(k,1268) * lu(k,1766) + lu(k,1773) = lu(k,1773) - lu(k,1269) * lu(k,1766) + lu(k,1775) = lu(k,1775) - lu(k,1270) * lu(k,1766) + lu(k,1776) = lu(k,1776) - lu(k,1271) * lu(k,1766) + lu(k,1779) = lu(k,1779) - lu(k,1272) * lu(k,1766) + lu(k,1782) = lu(k,1782) - lu(k,1273) * lu(k,1766) + lu(k,1827) = lu(k,1827) - lu(k,1264) * lu(k,1826) + lu(k,1828) = - lu(k,1265) * lu(k,1826) + lu(k,1830) = lu(k,1830) - lu(k,1266) * lu(k,1826) + lu(k,1831) = lu(k,1831) - lu(k,1267) * lu(k,1826) + lu(k,1832) = lu(k,1832) - lu(k,1268) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,1269) * lu(k,1826) + lu(k,1835) = lu(k,1835) - lu(k,1270) * lu(k,1826) + lu(k,1836) = lu(k,1836) - lu(k,1271) * lu(k,1826) + lu(k,1839) = lu(k,1839) - lu(k,1272) * lu(k,1826) + lu(k,1842) = lu(k,1842) - lu(k,1273) * lu(k,1826) + lu(k,1851) = lu(k,1851) - lu(k,1264) * lu(k,1850) + lu(k,1852) = lu(k,1852) - lu(k,1265) * lu(k,1850) + lu(k,1854) = lu(k,1854) - lu(k,1266) * lu(k,1850) + lu(k,1855) = lu(k,1855) - lu(k,1267) * lu(k,1850) + lu(k,1856) = lu(k,1856) - lu(k,1268) * lu(k,1850) + lu(k,1857) = - lu(k,1269) * lu(k,1850) + lu(k,1859) = lu(k,1859) - lu(k,1270) * lu(k,1850) + lu(k,1860) = lu(k,1860) - lu(k,1271) * lu(k,1850) + lu(k,1863) = lu(k,1863) - lu(k,1272) * lu(k,1850) + lu(k,1866) = lu(k,1866) - lu(k,1273) * lu(k,1850) + lu(k,1881) = lu(k,1881) - lu(k,1264) * lu(k,1880) + lu(k,1882) = lu(k,1882) - lu(k,1265) * lu(k,1880) + lu(k,1884) = lu(k,1884) - lu(k,1266) * lu(k,1880) + lu(k,1885) = lu(k,1885) - lu(k,1267) * lu(k,1880) + lu(k,1886) = lu(k,1886) - lu(k,1268) * lu(k,1880) + lu(k,1887) = lu(k,1887) - lu(k,1269) * lu(k,1880) + lu(k,1889) = lu(k,1889) - lu(k,1270) * lu(k,1880) + lu(k,1890) = lu(k,1890) - lu(k,1271) * lu(k,1880) + lu(k,1893) = lu(k,1893) - lu(k,1272) * lu(k,1880) + lu(k,1896) = lu(k,1896) - lu(k,1273) * lu(k,1880) + lu(k,1904) = lu(k,1904) - lu(k,1264) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1265) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1266) * lu(k,1903) + lu(k,1908) = lu(k,1908) - lu(k,1267) * lu(k,1903) + lu(k,1909) = lu(k,1909) - lu(k,1268) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,1269) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,1270) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1271) * lu(k,1903) + lu(k,1916) = lu(k,1916) - lu(k,1272) * lu(k,1903) + lu(k,1919) = lu(k,1919) - lu(k,1273) * lu(k,1903) + lu(k,1982) = lu(k,1982) - lu(k,1264) * lu(k,1981) + lu(k,1983) = - lu(k,1265) * lu(k,1981) + lu(k,1985) = lu(k,1985) - lu(k,1266) * lu(k,1981) + lu(k,1986) = lu(k,1986) - lu(k,1267) * lu(k,1981) + lu(k,1987) = lu(k,1987) - lu(k,1268) * lu(k,1981) + lu(k,1988) = lu(k,1988) - lu(k,1269) * lu(k,1981) + lu(k,1990) = lu(k,1990) - lu(k,1270) * lu(k,1981) + lu(k,1991) = lu(k,1991) - lu(k,1271) * lu(k,1981) + lu(k,1994) = lu(k,1994) - lu(k,1272) * lu(k,1981) + lu(k,1997) = lu(k,1997) - lu(k,1273) * lu(k,1981) + lu(k,2007) = lu(k,2007) - lu(k,1264) * lu(k,2006) + lu(k,2008) = lu(k,2008) - lu(k,1265) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1266) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1267) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1268) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1269) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1270) * lu(k,2006) + lu(k,2016) = lu(k,2016) - lu(k,1271) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1272) * lu(k,2006) + lu(k,2022) = lu(k,2022) - lu(k,1273) * lu(k,2006) + lu(k,1276) = 1._r8 / lu(k,1276) + lu(k,1277) = lu(k,1277) * lu(k,1276) + lu(k,1278) = lu(k,1278) * lu(k,1276) + lu(k,1279) = lu(k,1279) * lu(k,1276) + lu(k,1280) = lu(k,1280) * lu(k,1276) + lu(k,1281) = lu(k,1281) * lu(k,1276) + lu(k,1282) = lu(k,1282) * lu(k,1276) + lu(k,1283) = lu(k,1283) * lu(k,1276) + lu(k,1284) = lu(k,1284) * lu(k,1276) + lu(k,1285) = lu(k,1285) * lu(k,1276) + lu(k,1286) = lu(k,1286) * lu(k,1276) + lu(k,1287) = lu(k,1287) * lu(k,1276) + lu(k,1296) = lu(k,1296) - lu(k,1277) * lu(k,1295) + lu(k,1297) = lu(k,1297) - lu(k,1278) * lu(k,1295) + lu(k,1298) = lu(k,1298) - lu(k,1279) * lu(k,1295) + lu(k,1299) = lu(k,1299) - lu(k,1280) * lu(k,1295) + lu(k,1300) = lu(k,1300) - lu(k,1281) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,1282) * lu(k,1295) + lu(k,1303) = lu(k,1303) - lu(k,1283) * lu(k,1295) + lu(k,1304) = lu(k,1304) - lu(k,1284) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,1285) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,1286) * lu(k,1295) + lu(k,1309) = lu(k,1309) - lu(k,1287) * lu(k,1295) + lu(k,1389) = lu(k,1389) - lu(k,1277) * lu(k,1388) + lu(k,1390) = lu(k,1390) - lu(k,1278) * lu(k,1388) + lu(k,1391) = lu(k,1391) - lu(k,1279) * lu(k,1388) + lu(k,1392) = lu(k,1392) - lu(k,1280) * lu(k,1388) + lu(k,1393) = lu(k,1393) - lu(k,1281) * lu(k,1388) + lu(k,1394) = lu(k,1394) - lu(k,1282) * lu(k,1388) + lu(k,1396) = lu(k,1396) - lu(k,1283) * lu(k,1388) + lu(k,1397) = lu(k,1397) - lu(k,1284) * lu(k,1388) + lu(k,1398) = lu(k,1398) - lu(k,1285) * lu(k,1388) + lu(k,1400) = lu(k,1400) - lu(k,1286) * lu(k,1388) + lu(k,1403) = lu(k,1403) - lu(k,1287) * lu(k,1388) + lu(k,1446) = lu(k,1446) - lu(k,1277) * lu(k,1445) + lu(k,1447) = lu(k,1447) - lu(k,1278) * lu(k,1445) + lu(k,1448) = lu(k,1448) - lu(k,1279) * lu(k,1445) + lu(k,1449) = lu(k,1449) - lu(k,1280) * lu(k,1445) + lu(k,1450) = lu(k,1450) - lu(k,1281) * lu(k,1445) + lu(k,1451) = lu(k,1451) - lu(k,1282) * lu(k,1445) + lu(k,1453) = lu(k,1453) - lu(k,1283) * lu(k,1445) + lu(k,1454) = lu(k,1454) - lu(k,1284) * lu(k,1445) + lu(k,1455) = lu(k,1455) - lu(k,1285) * lu(k,1445) + lu(k,1457) = lu(k,1457) - lu(k,1286) * lu(k,1445) + lu(k,1460) = lu(k,1460) - lu(k,1287) * lu(k,1445) + lu(k,1470) = lu(k,1470) - lu(k,1277) * lu(k,1469) + lu(k,1471) = lu(k,1471) - lu(k,1278) * lu(k,1469) + lu(k,1472) = lu(k,1472) - lu(k,1279) * lu(k,1469) + lu(k,1473) = lu(k,1473) - lu(k,1280) * lu(k,1469) + lu(k,1474) = lu(k,1474) - lu(k,1281) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,1282) * lu(k,1469) + lu(k,1477) = lu(k,1477) - lu(k,1283) * lu(k,1469) + lu(k,1478) = lu(k,1478) - lu(k,1284) * lu(k,1469) + lu(k,1479) = lu(k,1479) - lu(k,1285) * lu(k,1469) + lu(k,1481) = lu(k,1481) - lu(k,1286) * lu(k,1469) + lu(k,1484) = lu(k,1484) - lu(k,1287) * lu(k,1469) + lu(k,1617) = lu(k,1617) - lu(k,1277) * lu(k,1616) + lu(k,1618) = lu(k,1618) - lu(k,1278) * lu(k,1616) + lu(k,1619) = lu(k,1619) - lu(k,1279) * lu(k,1616) + lu(k,1620) = lu(k,1620) - lu(k,1280) * lu(k,1616) + lu(k,1621) = lu(k,1621) - lu(k,1281) * lu(k,1616) + lu(k,1622) = lu(k,1622) - lu(k,1282) * lu(k,1616) + lu(k,1624) = lu(k,1624) - lu(k,1283) * lu(k,1616) + lu(k,1625) = lu(k,1625) - lu(k,1284) * lu(k,1616) + lu(k,1626) = lu(k,1626) - lu(k,1285) * lu(k,1616) + lu(k,1628) = lu(k,1628) - lu(k,1286) * lu(k,1616) + lu(k,1631) = lu(k,1631) - lu(k,1287) * lu(k,1616) + lu(k,1667) = lu(k,1667) - lu(k,1277) * lu(k,1666) + lu(k,1668) = lu(k,1668) - lu(k,1278) * lu(k,1666) + lu(k,1669) = lu(k,1669) - lu(k,1279) * lu(k,1666) + lu(k,1670) = lu(k,1670) - lu(k,1280) * lu(k,1666) + lu(k,1671) = lu(k,1671) - lu(k,1281) * lu(k,1666) + lu(k,1672) = lu(k,1672) - lu(k,1282) * lu(k,1666) + lu(k,1674) = lu(k,1674) - lu(k,1283) * lu(k,1666) + lu(k,1675) = lu(k,1675) - lu(k,1284) * lu(k,1666) + lu(k,1676) = lu(k,1676) - lu(k,1285) * lu(k,1666) + lu(k,1678) = lu(k,1678) - lu(k,1286) * lu(k,1666) + lu(k,1681) = lu(k,1681) - lu(k,1287) * lu(k,1666) + lu(k,1693) = lu(k,1693) - lu(k,1277) * lu(k,1692) + lu(k,1694) = lu(k,1694) - lu(k,1278) * lu(k,1692) + lu(k,1695) = lu(k,1695) - lu(k,1279) * lu(k,1692) + lu(k,1696) = lu(k,1696) - lu(k,1280) * lu(k,1692) + lu(k,1697) = lu(k,1697) - lu(k,1281) * lu(k,1692) + lu(k,1698) = lu(k,1698) - lu(k,1282) * lu(k,1692) + lu(k,1700) = lu(k,1700) - lu(k,1283) * lu(k,1692) + lu(k,1701) = lu(k,1701) - lu(k,1284) * lu(k,1692) + lu(k,1702) = lu(k,1702) - lu(k,1285) * lu(k,1692) + lu(k,1704) = lu(k,1704) - lu(k,1286) * lu(k,1692) + lu(k,1707) = lu(k,1707) - lu(k,1287) * lu(k,1692) + lu(k,1727) = lu(k,1727) - lu(k,1277) * lu(k,1726) + lu(k,1728) = lu(k,1728) - lu(k,1278) * lu(k,1726) + lu(k,1729) = lu(k,1729) - lu(k,1279) * lu(k,1726) + lu(k,1730) = lu(k,1730) - lu(k,1280) * lu(k,1726) + lu(k,1731) = lu(k,1731) - lu(k,1281) * lu(k,1726) + lu(k,1732) = lu(k,1732) - lu(k,1282) * lu(k,1726) + lu(k,1734) = lu(k,1734) - lu(k,1283) * lu(k,1726) + lu(k,1735) = lu(k,1735) - lu(k,1284) * lu(k,1726) + lu(k,1736) = lu(k,1736) - lu(k,1285) * lu(k,1726) + lu(k,1738) = lu(k,1738) - lu(k,1286) * lu(k,1726) + lu(k,1741) = lu(k,1741) - lu(k,1287) * lu(k,1726) + lu(k,1768) = lu(k,1768) - lu(k,1277) * lu(k,1767) + lu(k,1769) = lu(k,1769) - lu(k,1278) * lu(k,1767) + lu(k,1770) = lu(k,1770) - lu(k,1279) * lu(k,1767) + lu(k,1771) = lu(k,1771) - lu(k,1280) * lu(k,1767) + lu(k,1772) = lu(k,1772) - lu(k,1281) * lu(k,1767) + lu(k,1773) = lu(k,1773) - lu(k,1282) * lu(k,1767) + lu(k,1775) = lu(k,1775) - lu(k,1283) * lu(k,1767) + lu(k,1776) = lu(k,1776) - lu(k,1284) * lu(k,1767) + lu(k,1777) = lu(k,1777) - lu(k,1285) * lu(k,1767) + lu(k,1779) = lu(k,1779) - lu(k,1286) * lu(k,1767) + lu(k,1782) = lu(k,1782) - lu(k,1287) * lu(k,1767) + lu(k,1828) = lu(k,1828) - lu(k,1277) * lu(k,1827) + lu(k,1829) = lu(k,1829) - lu(k,1278) * lu(k,1827) + lu(k,1830) = lu(k,1830) - lu(k,1279) * lu(k,1827) + lu(k,1831) = lu(k,1831) - lu(k,1280) * lu(k,1827) + lu(k,1832) = lu(k,1832) - lu(k,1281) * lu(k,1827) + lu(k,1833) = lu(k,1833) - lu(k,1282) * lu(k,1827) + lu(k,1835) = lu(k,1835) - lu(k,1283) * lu(k,1827) + lu(k,1836) = lu(k,1836) - lu(k,1284) * lu(k,1827) + lu(k,1837) = lu(k,1837) - lu(k,1285) * lu(k,1827) + lu(k,1839) = lu(k,1839) - lu(k,1286) * lu(k,1827) + lu(k,1842) = lu(k,1842) - lu(k,1287) * lu(k,1827) + lu(k,1852) = lu(k,1852) - lu(k,1277) * lu(k,1851) + lu(k,1853) = lu(k,1853) - lu(k,1278) * lu(k,1851) + lu(k,1854) = lu(k,1854) - lu(k,1279) * lu(k,1851) + lu(k,1855) = lu(k,1855) - lu(k,1280) * lu(k,1851) + lu(k,1856) = lu(k,1856) - lu(k,1281) * lu(k,1851) + lu(k,1857) = lu(k,1857) - lu(k,1282) * lu(k,1851) + lu(k,1859) = lu(k,1859) - lu(k,1283) * lu(k,1851) + lu(k,1860) = lu(k,1860) - lu(k,1284) * lu(k,1851) + lu(k,1861) = lu(k,1861) - lu(k,1285) * lu(k,1851) + lu(k,1863) = lu(k,1863) - lu(k,1286) * lu(k,1851) + lu(k,1866) = lu(k,1866) - lu(k,1287) * lu(k,1851) + lu(k,1882) = lu(k,1882) - lu(k,1277) * lu(k,1881) + lu(k,1883) = lu(k,1883) - lu(k,1278) * lu(k,1881) + lu(k,1884) = lu(k,1884) - lu(k,1279) * lu(k,1881) + lu(k,1885) = lu(k,1885) - lu(k,1280) * lu(k,1881) + lu(k,1886) = lu(k,1886) - lu(k,1281) * lu(k,1881) + lu(k,1887) = lu(k,1887) - lu(k,1282) * lu(k,1881) + lu(k,1889) = lu(k,1889) - lu(k,1283) * lu(k,1881) + lu(k,1890) = lu(k,1890) - lu(k,1284) * lu(k,1881) + lu(k,1891) = lu(k,1891) - lu(k,1285) * lu(k,1881) + lu(k,1893) = lu(k,1893) - lu(k,1286) * lu(k,1881) + lu(k,1896) = lu(k,1896) - lu(k,1287) * lu(k,1881) + lu(k,1905) = lu(k,1905) - lu(k,1277) * lu(k,1904) + lu(k,1906) = lu(k,1906) - lu(k,1278) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1279) * lu(k,1904) + lu(k,1908) = lu(k,1908) - lu(k,1280) * lu(k,1904) + lu(k,1909) = lu(k,1909) - lu(k,1281) * lu(k,1904) + lu(k,1910) = lu(k,1910) - lu(k,1282) * lu(k,1904) + lu(k,1912) = lu(k,1912) - lu(k,1283) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1284) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,1285) * lu(k,1904) + lu(k,1916) = lu(k,1916) - lu(k,1286) * lu(k,1904) + lu(k,1919) = lu(k,1919) - lu(k,1287) * lu(k,1904) + lu(k,1983) = lu(k,1983) - lu(k,1277) * lu(k,1982) + lu(k,1984) = lu(k,1984) - lu(k,1278) * lu(k,1982) + lu(k,1985) = lu(k,1985) - lu(k,1279) * lu(k,1982) + lu(k,1986) = lu(k,1986) - lu(k,1280) * lu(k,1982) + lu(k,1987) = lu(k,1987) - lu(k,1281) * lu(k,1982) + lu(k,1988) = lu(k,1988) - lu(k,1282) * lu(k,1982) + lu(k,1990) = lu(k,1990) - lu(k,1283) * lu(k,1982) + lu(k,1991) = lu(k,1991) - lu(k,1284) * lu(k,1982) + lu(k,1992) = lu(k,1992) - lu(k,1285) * lu(k,1982) + lu(k,1994) = lu(k,1994) - lu(k,1286) * lu(k,1982) + lu(k,1997) = lu(k,1997) - lu(k,1287) * lu(k,1982) + lu(k,2008) = lu(k,2008) - lu(k,1277) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1278) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1279) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1280) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1281) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1282) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1283) * lu(k,2007) + lu(k,2016) = lu(k,2016) - lu(k,1284) * lu(k,2007) + lu(k,2017) = lu(k,2017) - lu(k,1285) * lu(k,2007) + lu(k,2019) = lu(k,2019) - lu(k,1286) * lu(k,2007) + lu(k,2022) = lu(k,2022) - lu(k,1287) * lu(k,2007) + end do + end subroutine lu_fac25 + subroutine lu_fac26( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1296) = 1._r8 / lu(k,1296) + lu(k,1297) = lu(k,1297) * lu(k,1296) + lu(k,1298) = lu(k,1298) * lu(k,1296) + lu(k,1299) = lu(k,1299) * lu(k,1296) + lu(k,1300) = lu(k,1300) * lu(k,1296) + lu(k,1301) = lu(k,1301) * lu(k,1296) + lu(k,1302) = lu(k,1302) * lu(k,1296) + lu(k,1303) = lu(k,1303) * lu(k,1296) + lu(k,1304) = lu(k,1304) * lu(k,1296) + lu(k,1305) = lu(k,1305) * lu(k,1296) + lu(k,1306) = lu(k,1306) * lu(k,1296) + lu(k,1307) = lu(k,1307) * lu(k,1296) + lu(k,1308) = lu(k,1308) * lu(k,1296) + lu(k,1309) = lu(k,1309) * lu(k,1296) + lu(k,1390) = lu(k,1390) - lu(k,1297) * lu(k,1389) + lu(k,1391) = lu(k,1391) - lu(k,1298) * lu(k,1389) + lu(k,1392) = lu(k,1392) - lu(k,1299) * lu(k,1389) + lu(k,1393) = lu(k,1393) - lu(k,1300) * lu(k,1389) + lu(k,1394) = lu(k,1394) - lu(k,1301) * lu(k,1389) + lu(k,1395) = lu(k,1395) - lu(k,1302) * lu(k,1389) + lu(k,1396) = lu(k,1396) - lu(k,1303) * lu(k,1389) + lu(k,1397) = lu(k,1397) - lu(k,1304) * lu(k,1389) + lu(k,1398) = lu(k,1398) - lu(k,1305) * lu(k,1389) + lu(k,1399) = lu(k,1399) - lu(k,1306) * lu(k,1389) + lu(k,1400) = lu(k,1400) - lu(k,1307) * lu(k,1389) + lu(k,1401) = lu(k,1401) - lu(k,1308) * lu(k,1389) + lu(k,1403) = lu(k,1403) - lu(k,1309) * lu(k,1389) + lu(k,1447) = lu(k,1447) - lu(k,1297) * lu(k,1446) + lu(k,1448) = lu(k,1448) - lu(k,1298) * lu(k,1446) + lu(k,1449) = lu(k,1449) - lu(k,1299) * lu(k,1446) + lu(k,1450) = lu(k,1450) - lu(k,1300) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,1301) * lu(k,1446) + lu(k,1452) = lu(k,1452) - lu(k,1302) * lu(k,1446) + lu(k,1453) = lu(k,1453) - lu(k,1303) * lu(k,1446) + lu(k,1454) = lu(k,1454) - lu(k,1304) * lu(k,1446) + lu(k,1455) = lu(k,1455) - lu(k,1305) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,1306) * lu(k,1446) + lu(k,1457) = lu(k,1457) - lu(k,1307) * lu(k,1446) + lu(k,1458) = lu(k,1458) - lu(k,1308) * lu(k,1446) + lu(k,1460) = lu(k,1460) - lu(k,1309) * lu(k,1446) + lu(k,1471) = lu(k,1471) - lu(k,1297) * lu(k,1470) + lu(k,1472) = lu(k,1472) - lu(k,1298) * lu(k,1470) + lu(k,1473) = lu(k,1473) - lu(k,1299) * lu(k,1470) + lu(k,1474) = lu(k,1474) - lu(k,1300) * lu(k,1470) + lu(k,1475) = lu(k,1475) - lu(k,1301) * lu(k,1470) + lu(k,1476) = lu(k,1476) - lu(k,1302) * lu(k,1470) + lu(k,1477) = lu(k,1477) - lu(k,1303) * lu(k,1470) + lu(k,1478) = lu(k,1478) - lu(k,1304) * lu(k,1470) + lu(k,1479) = lu(k,1479) - lu(k,1305) * lu(k,1470) + lu(k,1480) = lu(k,1480) - lu(k,1306) * lu(k,1470) + lu(k,1481) = lu(k,1481) - lu(k,1307) * lu(k,1470) + lu(k,1482) = lu(k,1482) - lu(k,1308) * lu(k,1470) + lu(k,1484) = lu(k,1484) - lu(k,1309) * lu(k,1470) + lu(k,1618) = lu(k,1618) - lu(k,1297) * lu(k,1617) + lu(k,1619) = lu(k,1619) - lu(k,1298) * lu(k,1617) + lu(k,1620) = lu(k,1620) - lu(k,1299) * lu(k,1617) + lu(k,1621) = lu(k,1621) - lu(k,1300) * lu(k,1617) + lu(k,1622) = lu(k,1622) - lu(k,1301) * lu(k,1617) + lu(k,1623) = lu(k,1623) - lu(k,1302) * lu(k,1617) + lu(k,1624) = lu(k,1624) - lu(k,1303) * lu(k,1617) + lu(k,1625) = lu(k,1625) - lu(k,1304) * lu(k,1617) + lu(k,1626) = lu(k,1626) - lu(k,1305) * lu(k,1617) + lu(k,1627) = lu(k,1627) - lu(k,1306) * lu(k,1617) + lu(k,1628) = lu(k,1628) - lu(k,1307) * lu(k,1617) + lu(k,1629) = lu(k,1629) - lu(k,1308) * lu(k,1617) + lu(k,1631) = lu(k,1631) - lu(k,1309) * lu(k,1617) + lu(k,1668) = lu(k,1668) - lu(k,1297) * lu(k,1667) + lu(k,1669) = lu(k,1669) - lu(k,1298) * lu(k,1667) + lu(k,1670) = lu(k,1670) - lu(k,1299) * lu(k,1667) + lu(k,1671) = lu(k,1671) - lu(k,1300) * lu(k,1667) + lu(k,1672) = lu(k,1672) - lu(k,1301) * lu(k,1667) + lu(k,1673) = lu(k,1673) - lu(k,1302) * lu(k,1667) + lu(k,1674) = lu(k,1674) - lu(k,1303) * lu(k,1667) + lu(k,1675) = lu(k,1675) - lu(k,1304) * lu(k,1667) + lu(k,1676) = lu(k,1676) - lu(k,1305) * lu(k,1667) + lu(k,1677) = - lu(k,1306) * lu(k,1667) + lu(k,1678) = lu(k,1678) - lu(k,1307) * lu(k,1667) + lu(k,1679) = lu(k,1679) - lu(k,1308) * lu(k,1667) + lu(k,1681) = lu(k,1681) - lu(k,1309) * lu(k,1667) + lu(k,1694) = lu(k,1694) - lu(k,1297) * lu(k,1693) + lu(k,1695) = lu(k,1695) - lu(k,1298) * lu(k,1693) + lu(k,1696) = lu(k,1696) - lu(k,1299) * lu(k,1693) + lu(k,1697) = lu(k,1697) - lu(k,1300) * lu(k,1693) + lu(k,1698) = lu(k,1698) - lu(k,1301) * lu(k,1693) + lu(k,1699) = lu(k,1699) - lu(k,1302) * lu(k,1693) + lu(k,1700) = lu(k,1700) - lu(k,1303) * lu(k,1693) + lu(k,1701) = lu(k,1701) - lu(k,1304) * lu(k,1693) + lu(k,1702) = lu(k,1702) - lu(k,1305) * lu(k,1693) + lu(k,1703) = lu(k,1703) - lu(k,1306) * lu(k,1693) + lu(k,1704) = lu(k,1704) - lu(k,1307) * lu(k,1693) + lu(k,1705) = lu(k,1705) - lu(k,1308) * lu(k,1693) + lu(k,1707) = lu(k,1707) - lu(k,1309) * lu(k,1693) + lu(k,1728) = lu(k,1728) - lu(k,1297) * lu(k,1727) + lu(k,1729) = lu(k,1729) - lu(k,1298) * lu(k,1727) + lu(k,1730) = lu(k,1730) - lu(k,1299) * lu(k,1727) + lu(k,1731) = lu(k,1731) - lu(k,1300) * lu(k,1727) + lu(k,1732) = lu(k,1732) - lu(k,1301) * lu(k,1727) + lu(k,1733) = lu(k,1733) - lu(k,1302) * lu(k,1727) + lu(k,1734) = lu(k,1734) - lu(k,1303) * lu(k,1727) + lu(k,1735) = lu(k,1735) - lu(k,1304) * lu(k,1727) + lu(k,1736) = lu(k,1736) - lu(k,1305) * lu(k,1727) + lu(k,1737) = lu(k,1737) - lu(k,1306) * lu(k,1727) + lu(k,1738) = lu(k,1738) - lu(k,1307) * lu(k,1727) + lu(k,1739) = lu(k,1739) - lu(k,1308) * lu(k,1727) + lu(k,1741) = lu(k,1741) - lu(k,1309) * lu(k,1727) + lu(k,1769) = lu(k,1769) - lu(k,1297) * lu(k,1768) + lu(k,1770) = lu(k,1770) - lu(k,1298) * lu(k,1768) + lu(k,1771) = lu(k,1771) - lu(k,1299) * lu(k,1768) + lu(k,1772) = lu(k,1772) - lu(k,1300) * lu(k,1768) + lu(k,1773) = lu(k,1773) - lu(k,1301) * lu(k,1768) + lu(k,1774) = lu(k,1774) - lu(k,1302) * lu(k,1768) + lu(k,1775) = lu(k,1775) - lu(k,1303) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1304) * lu(k,1768) + lu(k,1777) = lu(k,1777) - lu(k,1305) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1306) * lu(k,1768) + lu(k,1779) = lu(k,1779) - lu(k,1307) * lu(k,1768) + lu(k,1780) = lu(k,1780) - lu(k,1308) * lu(k,1768) + lu(k,1782) = lu(k,1782) - lu(k,1309) * lu(k,1768) + lu(k,1829) = lu(k,1829) - lu(k,1297) * lu(k,1828) + lu(k,1830) = lu(k,1830) - lu(k,1298) * lu(k,1828) + lu(k,1831) = lu(k,1831) - lu(k,1299) * lu(k,1828) + lu(k,1832) = lu(k,1832) - lu(k,1300) * lu(k,1828) + lu(k,1833) = lu(k,1833) - lu(k,1301) * lu(k,1828) + lu(k,1834) = lu(k,1834) - lu(k,1302) * lu(k,1828) + lu(k,1835) = lu(k,1835) - lu(k,1303) * lu(k,1828) + lu(k,1836) = lu(k,1836) - lu(k,1304) * lu(k,1828) + lu(k,1837) = lu(k,1837) - lu(k,1305) * lu(k,1828) + lu(k,1838) = lu(k,1838) - lu(k,1306) * lu(k,1828) + lu(k,1839) = lu(k,1839) - lu(k,1307) * lu(k,1828) + lu(k,1840) = lu(k,1840) - lu(k,1308) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,1309) * lu(k,1828) + lu(k,1853) = lu(k,1853) - lu(k,1297) * lu(k,1852) + lu(k,1854) = lu(k,1854) - lu(k,1298) * lu(k,1852) + lu(k,1855) = lu(k,1855) - lu(k,1299) * lu(k,1852) + lu(k,1856) = lu(k,1856) - lu(k,1300) * lu(k,1852) + lu(k,1857) = lu(k,1857) - lu(k,1301) * lu(k,1852) + lu(k,1858) = lu(k,1858) - lu(k,1302) * lu(k,1852) + lu(k,1859) = lu(k,1859) - lu(k,1303) * lu(k,1852) + lu(k,1860) = lu(k,1860) - lu(k,1304) * lu(k,1852) + lu(k,1861) = lu(k,1861) - lu(k,1305) * lu(k,1852) + lu(k,1862) = lu(k,1862) - lu(k,1306) * lu(k,1852) + lu(k,1863) = lu(k,1863) - lu(k,1307) * lu(k,1852) + lu(k,1864) = lu(k,1864) - lu(k,1308) * lu(k,1852) + lu(k,1866) = lu(k,1866) - lu(k,1309) * lu(k,1852) + lu(k,1883) = lu(k,1883) - lu(k,1297) * lu(k,1882) + lu(k,1884) = lu(k,1884) - lu(k,1298) * lu(k,1882) + lu(k,1885) = lu(k,1885) - lu(k,1299) * lu(k,1882) + lu(k,1886) = lu(k,1886) - lu(k,1300) * lu(k,1882) + lu(k,1887) = lu(k,1887) - lu(k,1301) * lu(k,1882) + lu(k,1888) = lu(k,1888) - lu(k,1302) * lu(k,1882) + lu(k,1889) = lu(k,1889) - lu(k,1303) * lu(k,1882) + lu(k,1890) = lu(k,1890) - lu(k,1304) * lu(k,1882) + lu(k,1891) = lu(k,1891) - lu(k,1305) * lu(k,1882) + lu(k,1892) = lu(k,1892) - lu(k,1306) * lu(k,1882) + lu(k,1893) = lu(k,1893) - lu(k,1307) * lu(k,1882) + lu(k,1894) = lu(k,1894) - lu(k,1308) * lu(k,1882) + lu(k,1896) = lu(k,1896) - lu(k,1309) * lu(k,1882) + lu(k,1906) = lu(k,1906) - lu(k,1297) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1298) * lu(k,1905) + lu(k,1908) = lu(k,1908) - lu(k,1299) * lu(k,1905) + lu(k,1909) = lu(k,1909) - lu(k,1300) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,1301) * lu(k,1905) + lu(k,1911) = - lu(k,1302) * lu(k,1905) + lu(k,1912) = lu(k,1912) - lu(k,1303) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1304) * lu(k,1905) + lu(k,1914) = lu(k,1914) - lu(k,1305) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,1306) * lu(k,1905) + lu(k,1916) = lu(k,1916) - lu(k,1307) * lu(k,1905) + lu(k,1917) = lu(k,1917) - lu(k,1308) * lu(k,1905) + lu(k,1919) = lu(k,1919) - lu(k,1309) * lu(k,1905) + lu(k,1984) = lu(k,1984) - lu(k,1297) * lu(k,1983) + lu(k,1985) = lu(k,1985) - lu(k,1298) * lu(k,1983) + lu(k,1986) = lu(k,1986) - lu(k,1299) * lu(k,1983) + lu(k,1987) = lu(k,1987) - lu(k,1300) * lu(k,1983) + lu(k,1988) = lu(k,1988) - lu(k,1301) * lu(k,1983) + lu(k,1989) = lu(k,1989) - lu(k,1302) * lu(k,1983) + lu(k,1990) = lu(k,1990) - lu(k,1303) * lu(k,1983) + lu(k,1991) = lu(k,1991) - lu(k,1304) * lu(k,1983) + lu(k,1992) = lu(k,1992) - lu(k,1305) * lu(k,1983) + lu(k,1993) = lu(k,1993) - lu(k,1306) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1307) * lu(k,1983) + lu(k,1995) = lu(k,1995) - lu(k,1308) * lu(k,1983) + lu(k,1997) = lu(k,1997) - lu(k,1309) * lu(k,1983) + lu(k,2009) = lu(k,2009) - lu(k,1297) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1298) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1299) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1300) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1301) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1302) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1303) * lu(k,2008) + lu(k,2016) = lu(k,2016) - lu(k,1304) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1305) * lu(k,2008) + lu(k,2018) = lu(k,2018) - lu(k,1306) * lu(k,2008) + lu(k,2019) = lu(k,2019) - lu(k,1307) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1308) * lu(k,2008) + lu(k,2022) = lu(k,2022) - lu(k,1309) * lu(k,2008) + lu(k,1390) = 1._r8 / lu(k,1390) + lu(k,1391) = lu(k,1391) * lu(k,1390) + lu(k,1392) = lu(k,1392) * lu(k,1390) + lu(k,1393) = lu(k,1393) * lu(k,1390) + lu(k,1394) = lu(k,1394) * lu(k,1390) + lu(k,1395) = lu(k,1395) * lu(k,1390) + lu(k,1396) = lu(k,1396) * lu(k,1390) + lu(k,1397) = lu(k,1397) * lu(k,1390) + lu(k,1398) = lu(k,1398) * lu(k,1390) + lu(k,1399) = lu(k,1399) * lu(k,1390) + lu(k,1400) = lu(k,1400) * lu(k,1390) + lu(k,1401) = lu(k,1401) * lu(k,1390) + lu(k,1402) = lu(k,1402) * lu(k,1390) + lu(k,1403) = lu(k,1403) * lu(k,1390) + lu(k,1448) = lu(k,1448) - lu(k,1391) * lu(k,1447) + lu(k,1449) = lu(k,1449) - lu(k,1392) * lu(k,1447) + lu(k,1450) = lu(k,1450) - lu(k,1393) * lu(k,1447) + lu(k,1451) = lu(k,1451) - lu(k,1394) * lu(k,1447) + lu(k,1452) = lu(k,1452) - lu(k,1395) * lu(k,1447) + lu(k,1453) = lu(k,1453) - lu(k,1396) * lu(k,1447) + lu(k,1454) = lu(k,1454) - lu(k,1397) * lu(k,1447) + lu(k,1455) = lu(k,1455) - lu(k,1398) * lu(k,1447) + lu(k,1456) = lu(k,1456) - lu(k,1399) * lu(k,1447) + lu(k,1457) = lu(k,1457) - lu(k,1400) * lu(k,1447) + lu(k,1458) = lu(k,1458) - lu(k,1401) * lu(k,1447) + lu(k,1459) = lu(k,1459) - lu(k,1402) * lu(k,1447) + lu(k,1460) = lu(k,1460) - lu(k,1403) * lu(k,1447) + lu(k,1472) = lu(k,1472) - lu(k,1391) * lu(k,1471) + lu(k,1473) = lu(k,1473) - lu(k,1392) * lu(k,1471) + lu(k,1474) = lu(k,1474) - lu(k,1393) * lu(k,1471) + lu(k,1475) = lu(k,1475) - lu(k,1394) * lu(k,1471) + lu(k,1476) = lu(k,1476) - lu(k,1395) * lu(k,1471) + lu(k,1477) = lu(k,1477) - lu(k,1396) * lu(k,1471) + lu(k,1478) = lu(k,1478) - lu(k,1397) * lu(k,1471) + lu(k,1479) = lu(k,1479) - lu(k,1398) * lu(k,1471) + lu(k,1480) = lu(k,1480) - lu(k,1399) * lu(k,1471) + lu(k,1481) = lu(k,1481) - lu(k,1400) * lu(k,1471) + lu(k,1482) = lu(k,1482) - lu(k,1401) * lu(k,1471) + lu(k,1483) = lu(k,1483) - lu(k,1402) * lu(k,1471) + lu(k,1484) = lu(k,1484) - lu(k,1403) * lu(k,1471) + lu(k,1619) = lu(k,1619) - lu(k,1391) * lu(k,1618) + lu(k,1620) = lu(k,1620) - lu(k,1392) * lu(k,1618) + lu(k,1621) = lu(k,1621) - lu(k,1393) * lu(k,1618) + lu(k,1622) = lu(k,1622) - lu(k,1394) * lu(k,1618) + lu(k,1623) = lu(k,1623) - lu(k,1395) * lu(k,1618) + lu(k,1624) = lu(k,1624) - lu(k,1396) * lu(k,1618) + lu(k,1625) = lu(k,1625) - lu(k,1397) * lu(k,1618) + lu(k,1626) = lu(k,1626) - lu(k,1398) * lu(k,1618) + lu(k,1627) = lu(k,1627) - lu(k,1399) * lu(k,1618) + lu(k,1628) = lu(k,1628) - lu(k,1400) * lu(k,1618) + lu(k,1629) = lu(k,1629) - lu(k,1401) * lu(k,1618) + lu(k,1630) = lu(k,1630) - lu(k,1402) * lu(k,1618) + lu(k,1631) = lu(k,1631) - lu(k,1403) * lu(k,1618) + lu(k,1669) = lu(k,1669) - lu(k,1391) * lu(k,1668) + lu(k,1670) = lu(k,1670) - lu(k,1392) * lu(k,1668) + lu(k,1671) = lu(k,1671) - lu(k,1393) * lu(k,1668) + lu(k,1672) = lu(k,1672) - lu(k,1394) * lu(k,1668) + lu(k,1673) = lu(k,1673) - lu(k,1395) * lu(k,1668) + lu(k,1674) = lu(k,1674) - lu(k,1396) * lu(k,1668) + lu(k,1675) = lu(k,1675) - lu(k,1397) * lu(k,1668) + lu(k,1676) = lu(k,1676) - lu(k,1398) * lu(k,1668) + lu(k,1677) = lu(k,1677) - lu(k,1399) * lu(k,1668) + lu(k,1678) = lu(k,1678) - lu(k,1400) * lu(k,1668) + lu(k,1679) = lu(k,1679) - lu(k,1401) * lu(k,1668) + lu(k,1680) = lu(k,1680) - lu(k,1402) * lu(k,1668) + lu(k,1681) = lu(k,1681) - lu(k,1403) * lu(k,1668) + lu(k,1695) = lu(k,1695) - lu(k,1391) * lu(k,1694) + lu(k,1696) = lu(k,1696) - lu(k,1392) * lu(k,1694) + lu(k,1697) = lu(k,1697) - lu(k,1393) * lu(k,1694) + lu(k,1698) = lu(k,1698) - lu(k,1394) * lu(k,1694) + lu(k,1699) = lu(k,1699) - lu(k,1395) * lu(k,1694) + lu(k,1700) = lu(k,1700) - lu(k,1396) * lu(k,1694) + lu(k,1701) = lu(k,1701) - lu(k,1397) * lu(k,1694) + lu(k,1702) = lu(k,1702) - lu(k,1398) * lu(k,1694) + lu(k,1703) = lu(k,1703) - lu(k,1399) * lu(k,1694) + lu(k,1704) = lu(k,1704) - lu(k,1400) * lu(k,1694) + lu(k,1705) = lu(k,1705) - lu(k,1401) * lu(k,1694) + lu(k,1706) = lu(k,1706) - lu(k,1402) * lu(k,1694) + lu(k,1707) = lu(k,1707) - lu(k,1403) * lu(k,1694) + lu(k,1729) = lu(k,1729) - lu(k,1391) * lu(k,1728) + lu(k,1730) = lu(k,1730) - lu(k,1392) * lu(k,1728) + lu(k,1731) = lu(k,1731) - lu(k,1393) * lu(k,1728) + lu(k,1732) = lu(k,1732) - lu(k,1394) * lu(k,1728) + lu(k,1733) = lu(k,1733) - lu(k,1395) * lu(k,1728) + lu(k,1734) = lu(k,1734) - lu(k,1396) * lu(k,1728) + lu(k,1735) = lu(k,1735) - lu(k,1397) * lu(k,1728) + lu(k,1736) = lu(k,1736) - lu(k,1398) * lu(k,1728) + lu(k,1737) = lu(k,1737) - lu(k,1399) * lu(k,1728) + lu(k,1738) = lu(k,1738) - lu(k,1400) * lu(k,1728) + lu(k,1739) = lu(k,1739) - lu(k,1401) * lu(k,1728) + lu(k,1740) = lu(k,1740) - lu(k,1402) * lu(k,1728) + lu(k,1741) = lu(k,1741) - lu(k,1403) * lu(k,1728) + lu(k,1770) = lu(k,1770) - lu(k,1391) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,1392) * lu(k,1769) + lu(k,1772) = lu(k,1772) - lu(k,1393) * lu(k,1769) + lu(k,1773) = lu(k,1773) - lu(k,1394) * lu(k,1769) + lu(k,1774) = lu(k,1774) - lu(k,1395) * lu(k,1769) + lu(k,1775) = lu(k,1775) - lu(k,1396) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1397) * lu(k,1769) + lu(k,1777) = lu(k,1777) - lu(k,1398) * lu(k,1769) + lu(k,1778) = lu(k,1778) - lu(k,1399) * lu(k,1769) + lu(k,1779) = lu(k,1779) - lu(k,1400) * lu(k,1769) + lu(k,1780) = lu(k,1780) - lu(k,1401) * lu(k,1769) + lu(k,1781) = lu(k,1781) - lu(k,1402) * lu(k,1769) + lu(k,1782) = lu(k,1782) - lu(k,1403) * lu(k,1769) + lu(k,1830) = lu(k,1830) - lu(k,1391) * lu(k,1829) + lu(k,1831) = lu(k,1831) - lu(k,1392) * lu(k,1829) + lu(k,1832) = lu(k,1832) - lu(k,1393) * lu(k,1829) + lu(k,1833) = lu(k,1833) - lu(k,1394) * lu(k,1829) + lu(k,1834) = lu(k,1834) - lu(k,1395) * lu(k,1829) + lu(k,1835) = lu(k,1835) - lu(k,1396) * lu(k,1829) + lu(k,1836) = lu(k,1836) - lu(k,1397) * lu(k,1829) + lu(k,1837) = lu(k,1837) - lu(k,1398) * lu(k,1829) + lu(k,1838) = lu(k,1838) - lu(k,1399) * lu(k,1829) + lu(k,1839) = lu(k,1839) - lu(k,1400) * lu(k,1829) + lu(k,1840) = lu(k,1840) - lu(k,1401) * lu(k,1829) + lu(k,1841) = lu(k,1841) - lu(k,1402) * lu(k,1829) + lu(k,1842) = lu(k,1842) - lu(k,1403) * lu(k,1829) + lu(k,1854) = lu(k,1854) - lu(k,1391) * lu(k,1853) + lu(k,1855) = lu(k,1855) - lu(k,1392) * lu(k,1853) + lu(k,1856) = lu(k,1856) - lu(k,1393) * lu(k,1853) + lu(k,1857) = lu(k,1857) - lu(k,1394) * lu(k,1853) + lu(k,1858) = lu(k,1858) - lu(k,1395) * lu(k,1853) + lu(k,1859) = lu(k,1859) - lu(k,1396) * lu(k,1853) + lu(k,1860) = lu(k,1860) - lu(k,1397) * lu(k,1853) + lu(k,1861) = lu(k,1861) - lu(k,1398) * lu(k,1853) + lu(k,1862) = lu(k,1862) - lu(k,1399) * lu(k,1853) + lu(k,1863) = lu(k,1863) - lu(k,1400) * lu(k,1853) + lu(k,1864) = lu(k,1864) - lu(k,1401) * lu(k,1853) + lu(k,1865) = lu(k,1865) - lu(k,1402) * lu(k,1853) + lu(k,1866) = lu(k,1866) - lu(k,1403) * lu(k,1853) + lu(k,1884) = lu(k,1884) - lu(k,1391) * lu(k,1883) + lu(k,1885) = lu(k,1885) - lu(k,1392) * lu(k,1883) + lu(k,1886) = lu(k,1886) - lu(k,1393) * lu(k,1883) + lu(k,1887) = lu(k,1887) - lu(k,1394) * lu(k,1883) + lu(k,1888) = lu(k,1888) - lu(k,1395) * lu(k,1883) + lu(k,1889) = lu(k,1889) - lu(k,1396) * lu(k,1883) + lu(k,1890) = lu(k,1890) - lu(k,1397) * lu(k,1883) + lu(k,1891) = lu(k,1891) - lu(k,1398) * lu(k,1883) + lu(k,1892) = lu(k,1892) - lu(k,1399) * lu(k,1883) + lu(k,1893) = lu(k,1893) - lu(k,1400) * lu(k,1883) + lu(k,1894) = lu(k,1894) - lu(k,1401) * lu(k,1883) + lu(k,1895) = lu(k,1895) - lu(k,1402) * lu(k,1883) + lu(k,1896) = lu(k,1896) - lu(k,1403) * lu(k,1883) + lu(k,1907) = lu(k,1907) - lu(k,1391) * lu(k,1906) + lu(k,1908) = lu(k,1908) - lu(k,1392) * lu(k,1906) + lu(k,1909) = lu(k,1909) - lu(k,1393) * lu(k,1906) + lu(k,1910) = lu(k,1910) - lu(k,1394) * lu(k,1906) + lu(k,1911) = lu(k,1911) - lu(k,1395) * lu(k,1906) + lu(k,1912) = lu(k,1912) - lu(k,1396) * lu(k,1906) + lu(k,1913) = lu(k,1913) - lu(k,1397) * lu(k,1906) + lu(k,1914) = lu(k,1914) - lu(k,1398) * lu(k,1906) + lu(k,1915) = lu(k,1915) - lu(k,1399) * lu(k,1906) + lu(k,1916) = lu(k,1916) - lu(k,1400) * lu(k,1906) + lu(k,1917) = lu(k,1917) - lu(k,1401) * lu(k,1906) + lu(k,1918) = lu(k,1918) - lu(k,1402) * lu(k,1906) + lu(k,1919) = lu(k,1919) - lu(k,1403) * lu(k,1906) + lu(k,1985) = lu(k,1985) - lu(k,1391) * lu(k,1984) + lu(k,1986) = lu(k,1986) - lu(k,1392) * lu(k,1984) + lu(k,1987) = lu(k,1987) - lu(k,1393) * lu(k,1984) + lu(k,1988) = lu(k,1988) - lu(k,1394) * lu(k,1984) + lu(k,1989) = lu(k,1989) - lu(k,1395) * lu(k,1984) + lu(k,1990) = lu(k,1990) - lu(k,1396) * lu(k,1984) + lu(k,1991) = lu(k,1991) - lu(k,1397) * lu(k,1984) + lu(k,1992) = lu(k,1992) - lu(k,1398) * lu(k,1984) + lu(k,1993) = lu(k,1993) - lu(k,1399) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1400) * lu(k,1984) + lu(k,1995) = lu(k,1995) - lu(k,1401) * lu(k,1984) + lu(k,1996) = lu(k,1996) - lu(k,1402) * lu(k,1984) + lu(k,1997) = lu(k,1997) - lu(k,1403) * lu(k,1984) + lu(k,2010) = lu(k,2010) - lu(k,1391) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1392) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1393) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1394) * lu(k,2009) + lu(k,2014) = lu(k,2014) - lu(k,1395) * lu(k,2009) + lu(k,2015) = lu(k,2015) - lu(k,1396) * lu(k,2009) + lu(k,2016) = lu(k,2016) - lu(k,1397) * lu(k,2009) + lu(k,2017) = lu(k,2017) - lu(k,1398) * lu(k,2009) + lu(k,2018) = lu(k,2018) - lu(k,1399) * lu(k,2009) + lu(k,2019) = lu(k,2019) - lu(k,1400) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1401) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1402) * lu(k,2009) + lu(k,2022) = lu(k,2022) - lu(k,1403) * lu(k,2009) + lu(k,1448) = 1._r8 / lu(k,1448) + lu(k,1449) = lu(k,1449) * lu(k,1448) + lu(k,1450) = lu(k,1450) * lu(k,1448) + lu(k,1451) = lu(k,1451) * lu(k,1448) + lu(k,1452) = lu(k,1452) * lu(k,1448) + lu(k,1453) = lu(k,1453) * lu(k,1448) + lu(k,1454) = lu(k,1454) * lu(k,1448) + lu(k,1455) = lu(k,1455) * lu(k,1448) + lu(k,1456) = lu(k,1456) * lu(k,1448) + lu(k,1457) = lu(k,1457) * lu(k,1448) + lu(k,1458) = lu(k,1458) * lu(k,1448) + lu(k,1459) = lu(k,1459) * lu(k,1448) + lu(k,1460) = lu(k,1460) * lu(k,1448) + lu(k,1473) = lu(k,1473) - lu(k,1449) * lu(k,1472) + lu(k,1474) = lu(k,1474) - lu(k,1450) * lu(k,1472) + lu(k,1475) = lu(k,1475) - lu(k,1451) * lu(k,1472) + lu(k,1476) = lu(k,1476) - lu(k,1452) * lu(k,1472) + lu(k,1477) = lu(k,1477) - lu(k,1453) * lu(k,1472) + lu(k,1478) = lu(k,1478) - lu(k,1454) * lu(k,1472) + lu(k,1479) = lu(k,1479) - lu(k,1455) * lu(k,1472) + lu(k,1480) = lu(k,1480) - lu(k,1456) * lu(k,1472) + lu(k,1481) = lu(k,1481) - lu(k,1457) * lu(k,1472) + lu(k,1482) = lu(k,1482) - lu(k,1458) * lu(k,1472) + lu(k,1483) = lu(k,1483) - lu(k,1459) * lu(k,1472) + lu(k,1484) = lu(k,1484) - lu(k,1460) * lu(k,1472) + lu(k,1620) = lu(k,1620) - lu(k,1449) * lu(k,1619) + lu(k,1621) = lu(k,1621) - lu(k,1450) * lu(k,1619) + lu(k,1622) = lu(k,1622) - lu(k,1451) * lu(k,1619) + lu(k,1623) = lu(k,1623) - lu(k,1452) * lu(k,1619) + lu(k,1624) = lu(k,1624) - lu(k,1453) * lu(k,1619) + lu(k,1625) = lu(k,1625) - lu(k,1454) * lu(k,1619) + lu(k,1626) = lu(k,1626) - lu(k,1455) * lu(k,1619) + lu(k,1627) = lu(k,1627) - lu(k,1456) * lu(k,1619) + lu(k,1628) = lu(k,1628) - lu(k,1457) * lu(k,1619) + lu(k,1629) = lu(k,1629) - lu(k,1458) * lu(k,1619) + lu(k,1630) = lu(k,1630) - lu(k,1459) * lu(k,1619) + lu(k,1631) = lu(k,1631) - lu(k,1460) * lu(k,1619) + lu(k,1670) = lu(k,1670) - lu(k,1449) * lu(k,1669) + lu(k,1671) = lu(k,1671) - lu(k,1450) * lu(k,1669) + lu(k,1672) = lu(k,1672) - lu(k,1451) * lu(k,1669) + lu(k,1673) = lu(k,1673) - lu(k,1452) * lu(k,1669) + lu(k,1674) = lu(k,1674) - lu(k,1453) * lu(k,1669) + lu(k,1675) = lu(k,1675) - lu(k,1454) * lu(k,1669) + lu(k,1676) = lu(k,1676) - lu(k,1455) * lu(k,1669) + lu(k,1677) = lu(k,1677) - lu(k,1456) * lu(k,1669) + lu(k,1678) = lu(k,1678) - lu(k,1457) * lu(k,1669) + lu(k,1679) = lu(k,1679) - lu(k,1458) * lu(k,1669) + lu(k,1680) = lu(k,1680) - lu(k,1459) * lu(k,1669) + lu(k,1681) = lu(k,1681) - lu(k,1460) * lu(k,1669) + lu(k,1696) = lu(k,1696) - lu(k,1449) * lu(k,1695) + lu(k,1697) = lu(k,1697) - lu(k,1450) * lu(k,1695) + lu(k,1698) = lu(k,1698) - lu(k,1451) * lu(k,1695) + lu(k,1699) = lu(k,1699) - lu(k,1452) * lu(k,1695) + lu(k,1700) = lu(k,1700) - lu(k,1453) * lu(k,1695) + lu(k,1701) = lu(k,1701) - lu(k,1454) * lu(k,1695) + lu(k,1702) = lu(k,1702) - lu(k,1455) * lu(k,1695) + lu(k,1703) = lu(k,1703) - lu(k,1456) * lu(k,1695) + lu(k,1704) = lu(k,1704) - lu(k,1457) * lu(k,1695) + lu(k,1705) = lu(k,1705) - lu(k,1458) * lu(k,1695) + lu(k,1706) = lu(k,1706) - lu(k,1459) * lu(k,1695) + lu(k,1707) = lu(k,1707) - lu(k,1460) * lu(k,1695) + lu(k,1730) = lu(k,1730) - lu(k,1449) * lu(k,1729) + lu(k,1731) = lu(k,1731) - lu(k,1450) * lu(k,1729) + lu(k,1732) = lu(k,1732) - lu(k,1451) * lu(k,1729) + lu(k,1733) = lu(k,1733) - lu(k,1452) * lu(k,1729) + lu(k,1734) = lu(k,1734) - lu(k,1453) * lu(k,1729) + lu(k,1735) = lu(k,1735) - lu(k,1454) * lu(k,1729) + lu(k,1736) = lu(k,1736) - lu(k,1455) * lu(k,1729) + lu(k,1737) = lu(k,1737) - lu(k,1456) * lu(k,1729) + lu(k,1738) = lu(k,1738) - lu(k,1457) * lu(k,1729) + lu(k,1739) = lu(k,1739) - lu(k,1458) * lu(k,1729) + lu(k,1740) = lu(k,1740) - lu(k,1459) * lu(k,1729) + lu(k,1741) = lu(k,1741) - lu(k,1460) * lu(k,1729) + lu(k,1771) = lu(k,1771) - lu(k,1449) * lu(k,1770) + lu(k,1772) = lu(k,1772) - lu(k,1450) * lu(k,1770) + lu(k,1773) = lu(k,1773) - lu(k,1451) * lu(k,1770) + lu(k,1774) = lu(k,1774) - lu(k,1452) * lu(k,1770) + lu(k,1775) = lu(k,1775) - lu(k,1453) * lu(k,1770) + lu(k,1776) = lu(k,1776) - lu(k,1454) * lu(k,1770) + lu(k,1777) = lu(k,1777) - lu(k,1455) * lu(k,1770) + lu(k,1778) = lu(k,1778) - lu(k,1456) * lu(k,1770) + lu(k,1779) = lu(k,1779) - lu(k,1457) * lu(k,1770) + lu(k,1780) = lu(k,1780) - lu(k,1458) * lu(k,1770) + lu(k,1781) = lu(k,1781) - lu(k,1459) * lu(k,1770) + lu(k,1782) = lu(k,1782) - lu(k,1460) * lu(k,1770) + lu(k,1831) = lu(k,1831) - lu(k,1449) * lu(k,1830) + lu(k,1832) = lu(k,1832) - lu(k,1450) * lu(k,1830) + lu(k,1833) = lu(k,1833) - lu(k,1451) * lu(k,1830) + lu(k,1834) = lu(k,1834) - lu(k,1452) * lu(k,1830) + lu(k,1835) = lu(k,1835) - lu(k,1453) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,1454) * lu(k,1830) + lu(k,1837) = lu(k,1837) - lu(k,1455) * lu(k,1830) + lu(k,1838) = lu(k,1838) - lu(k,1456) * lu(k,1830) + lu(k,1839) = lu(k,1839) - lu(k,1457) * lu(k,1830) + lu(k,1840) = lu(k,1840) - lu(k,1458) * lu(k,1830) + lu(k,1841) = lu(k,1841) - lu(k,1459) * lu(k,1830) + lu(k,1842) = lu(k,1842) - lu(k,1460) * lu(k,1830) + lu(k,1855) = lu(k,1855) - lu(k,1449) * lu(k,1854) + lu(k,1856) = lu(k,1856) - lu(k,1450) * lu(k,1854) + lu(k,1857) = lu(k,1857) - lu(k,1451) * lu(k,1854) + lu(k,1858) = lu(k,1858) - lu(k,1452) * lu(k,1854) + lu(k,1859) = lu(k,1859) - lu(k,1453) * lu(k,1854) + lu(k,1860) = lu(k,1860) - lu(k,1454) * lu(k,1854) + lu(k,1861) = lu(k,1861) - lu(k,1455) * lu(k,1854) + lu(k,1862) = lu(k,1862) - lu(k,1456) * lu(k,1854) + lu(k,1863) = lu(k,1863) - lu(k,1457) * lu(k,1854) + lu(k,1864) = lu(k,1864) - lu(k,1458) * lu(k,1854) + lu(k,1865) = lu(k,1865) - lu(k,1459) * lu(k,1854) + lu(k,1866) = lu(k,1866) - lu(k,1460) * lu(k,1854) + lu(k,1885) = lu(k,1885) - lu(k,1449) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1450) * lu(k,1884) + lu(k,1887) = lu(k,1887) - lu(k,1451) * lu(k,1884) + lu(k,1888) = lu(k,1888) - lu(k,1452) * lu(k,1884) + lu(k,1889) = lu(k,1889) - lu(k,1453) * lu(k,1884) + lu(k,1890) = lu(k,1890) - lu(k,1454) * lu(k,1884) + lu(k,1891) = lu(k,1891) - lu(k,1455) * lu(k,1884) + lu(k,1892) = lu(k,1892) - lu(k,1456) * lu(k,1884) + lu(k,1893) = lu(k,1893) - lu(k,1457) * lu(k,1884) + lu(k,1894) = lu(k,1894) - lu(k,1458) * lu(k,1884) + lu(k,1895) = lu(k,1895) - lu(k,1459) * lu(k,1884) + lu(k,1896) = lu(k,1896) - lu(k,1460) * lu(k,1884) + lu(k,1908) = lu(k,1908) - lu(k,1449) * lu(k,1907) + lu(k,1909) = lu(k,1909) - lu(k,1450) * lu(k,1907) + lu(k,1910) = lu(k,1910) - lu(k,1451) * lu(k,1907) + lu(k,1911) = lu(k,1911) - lu(k,1452) * lu(k,1907) + lu(k,1912) = lu(k,1912) - lu(k,1453) * lu(k,1907) + lu(k,1913) = lu(k,1913) - lu(k,1454) * lu(k,1907) + lu(k,1914) = lu(k,1914) - lu(k,1455) * lu(k,1907) + lu(k,1915) = lu(k,1915) - lu(k,1456) * lu(k,1907) + lu(k,1916) = lu(k,1916) - lu(k,1457) * lu(k,1907) + lu(k,1917) = lu(k,1917) - lu(k,1458) * lu(k,1907) + lu(k,1918) = lu(k,1918) - lu(k,1459) * lu(k,1907) + lu(k,1919) = lu(k,1919) - lu(k,1460) * lu(k,1907) + lu(k,1986) = lu(k,1986) - lu(k,1449) * lu(k,1985) + lu(k,1987) = lu(k,1987) - lu(k,1450) * lu(k,1985) + lu(k,1988) = lu(k,1988) - lu(k,1451) * lu(k,1985) + lu(k,1989) = lu(k,1989) - lu(k,1452) * lu(k,1985) + lu(k,1990) = lu(k,1990) - lu(k,1453) * lu(k,1985) + lu(k,1991) = lu(k,1991) - lu(k,1454) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,1455) * lu(k,1985) + lu(k,1993) = lu(k,1993) - lu(k,1456) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1457) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1458) * lu(k,1985) + lu(k,1996) = lu(k,1996) - lu(k,1459) * lu(k,1985) + lu(k,1997) = lu(k,1997) - lu(k,1460) * lu(k,1985) + lu(k,2011) = lu(k,2011) - lu(k,1449) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1450) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1451) * lu(k,2010) + lu(k,2014) = lu(k,2014) - lu(k,1452) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1453) * lu(k,2010) + lu(k,2016) = lu(k,2016) - lu(k,1454) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1455) * lu(k,2010) + lu(k,2018) = lu(k,2018) - lu(k,1456) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1457) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1458) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1459) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1460) * lu(k,2010) + lu(k,1473) = 1._r8 / lu(k,1473) + lu(k,1474) = lu(k,1474) * lu(k,1473) + lu(k,1475) = lu(k,1475) * lu(k,1473) + lu(k,1476) = lu(k,1476) * lu(k,1473) + lu(k,1477) = lu(k,1477) * lu(k,1473) + lu(k,1478) = lu(k,1478) * lu(k,1473) + lu(k,1479) = lu(k,1479) * lu(k,1473) + lu(k,1480) = lu(k,1480) * lu(k,1473) + lu(k,1481) = lu(k,1481) * lu(k,1473) + lu(k,1482) = lu(k,1482) * lu(k,1473) + lu(k,1483) = lu(k,1483) * lu(k,1473) + lu(k,1484) = lu(k,1484) * lu(k,1473) + lu(k,1621) = lu(k,1621) - lu(k,1474) * lu(k,1620) + lu(k,1622) = lu(k,1622) - lu(k,1475) * lu(k,1620) + lu(k,1623) = lu(k,1623) - lu(k,1476) * lu(k,1620) + lu(k,1624) = lu(k,1624) - lu(k,1477) * lu(k,1620) + lu(k,1625) = lu(k,1625) - lu(k,1478) * lu(k,1620) + lu(k,1626) = lu(k,1626) - lu(k,1479) * lu(k,1620) + lu(k,1627) = lu(k,1627) - lu(k,1480) * lu(k,1620) + lu(k,1628) = lu(k,1628) - lu(k,1481) * lu(k,1620) + lu(k,1629) = lu(k,1629) - lu(k,1482) * lu(k,1620) + lu(k,1630) = lu(k,1630) - lu(k,1483) * lu(k,1620) + lu(k,1631) = lu(k,1631) - lu(k,1484) * lu(k,1620) + lu(k,1671) = lu(k,1671) - lu(k,1474) * lu(k,1670) + lu(k,1672) = lu(k,1672) - lu(k,1475) * lu(k,1670) + lu(k,1673) = lu(k,1673) - lu(k,1476) * lu(k,1670) + lu(k,1674) = lu(k,1674) - lu(k,1477) * lu(k,1670) + lu(k,1675) = lu(k,1675) - lu(k,1478) * lu(k,1670) + lu(k,1676) = lu(k,1676) - lu(k,1479) * lu(k,1670) + lu(k,1677) = lu(k,1677) - lu(k,1480) * lu(k,1670) + lu(k,1678) = lu(k,1678) - lu(k,1481) * lu(k,1670) + lu(k,1679) = lu(k,1679) - lu(k,1482) * lu(k,1670) + lu(k,1680) = lu(k,1680) - lu(k,1483) * lu(k,1670) + lu(k,1681) = lu(k,1681) - lu(k,1484) * lu(k,1670) + lu(k,1697) = lu(k,1697) - lu(k,1474) * lu(k,1696) + lu(k,1698) = lu(k,1698) - lu(k,1475) * lu(k,1696) + lu(k,1699) = lu(k,1699) - lu(k,1476) * lu(k,1696) + lu(k,1700) = lu(k,1700) - lu(k,1477) * lu(k,1696) + lu(k,1701) = lu(k,1701) - lu(k,1478) * lu(k,1696) + lu(k,1702) = lu(k,1702) - lu(k,1479) * lu(k,1696) + lu(k,1703) = lu(k,1703) - lu(k,1480) * lu(k,1696) + lu(k,1704) = lu(k,1704) - lu(k,1481) * lu(k,1696) + lu(k,1705) = lu(k,1705) - lu(k,1482) * lu(k,1696) + lu(k,1706) = lu(k,1706) - lu(k,1483) * lu(k,1696) + lu(k,1707) = lu(k,1707) - lu(k,1484) * lu(k,1696) + lu(k,1731) = lu(k,1731) - lu(k,1474) * lu(k,1730) + lu(k,1732) = lu(k,1732) - lu(k,1475) * lu(k,1730) + lu(k,1733) = lu(k,1733) - lu(k,1476) * lu(k,1730) + lu(k,1734) = lu(k,1734) - lu(k,1477) * lu(k,1730) + lu(k,1735) = lu(k,1735) - lu(k,1478) * lu(k,1730) + lu(k,1736) = lu(k,1736) - lu(k,1479) * lu(k,1730) + lu(k,1737) = lu(k,1737) - lu(k,1480) * lu(k,1730) + lu(k,1738) = lu(k,1738) - lu(k,1481) * lu(k,1730) + lu(k,1739) = lu(k,1739) - lu(k,1482) * lu(k,1730) + lu(k,1740) = lu(k,1740) - lu(k,1483) * lu(k,1730) + lu(k,1741) = lu(k,1741) - lu(k,1484) * lu(k,1730) + lu(k,1772) = lu(k,1772) - lu(k,1474) * lu(k,1771) + lu(k,1773) = lu(k,1773) - lu(k,1475) * lu(k,1771) + lu(k,1774) = lu(k,1774) - lu(k,1476) * lu(k,1771) + lu(k,1775) = lu(k,1775) - lu(k,1477) * lu(k,1771) + lu(k,1776) = lu(k,1776) - lu(k,1478) * lu(k,1771) + lu(k,1777) = lu(k,1777) - lu(k,1479) * lu(k,1771) + lu(k,1778) = lu(k,1778) - lu(k,1480) * lu(k,1771) + lu(k,1779) = lu(k,1779) - lu(k,1481) * lu(k,1771) + lu(k,1780) = lu(k,1780) - lu(k,1482) * lu(k,1771) + lu(k,1781) = lu(k,1781) - lu(k,1483) * lu(k,1771) + lu(k,1782) = lu(k,1782) - lu(k,1484) * lu(k,1771) + lu(k,1832) = lu(k,1832) - lu(k,1474) * lu(k,1831) + lu(k,1833) = lu(k,1833) - lu(k,1475) * lu(k,1831) + lu(k,1834) = lu(k,1834) - lu(k,1476) * lu(k,1831) + lu(k,1835) = lu(k,1835) - lu(k,1477) * lu(k,1831) + lu(k,1836) = lu(k,1836) - lu(k,1478) * lu(k,1831) + lu(k,1837) = lu(k,1837) - lu(k,1479) * lu(k,1831) + lu(k,1838) = lu(k,1838) - lu(k,1480) * lu(k,1831) + lu(k,1839) = lu(k,1839) - lu(k,1481) * lu(k,1831) + lu(k,1840) = lu(k,1840) - lu(k,1482) * lu(k,1831) + lu(k,1841) = lu(k,1841) - lu(k,1483) * lu(k,1831) + lu(k,1842) = lu(k,1842) - lu(k,1484) * lu(k,1831) + lu(k,1856) = lu(k,1856) - lu(k,1474) * lu(k,1855) + lu(k,1857) = lu(k,1857) - lu(k,1475) * lu(k,1855) + lu(k,1858) = lu(k,1858) - lu(k,1476) * lu(k,1855) + lu(k,1859) = lu(k,1859) - lu(k,1477) * lu(k,1855) + lu(k,1860) = lu(k,1860) - lu(k,1478) * lu(k,1855) + lu(k,1861) = lu(k,1861) - lu(k,1479) * lu(k,1855) + lu(k,1862) = lu(k,1862) - lu(k,1480) * lu(k,1855) + lu(k,1863) = lu(k,1863) - lu(k,1481) * lu(k,1855) + lu(k,1864) = lu(k,1864) - lu(k,1482) * lu(k,1855) + lu(k,1865) = lu(k,1865) - lu(k,1483) * lu(k,1855) + lu(k,1866) = lu(k,1866) - lu(k,1484) * lu(k,1855) + lu(k,1886) = lu(k,1886) - lu(k,1474) * lu(k,1885) + lu(k,1887) = lu(k,1887) - lu(k,1475) * lu(k,1885) + lu(k,1888) = lu(k,1888) - lu(k,1476) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1477) * lu(k,1885) + lu(k,1890) = lu(k,1890) - lu(k,1478) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1479) * lu(k,1885) + lu(k,1892) = lu(k,1892) - lu(k,1480) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1481) * lu(k,1885) + lu(k,1894) = lu(k,1894) - lu(k,1482) * lu(k,1885) + lu(k,1895) = lu(k,1895) - lu(k,1483) * lu(k,1885) + lu(k,1896) = lu(k,1896) - lu(k,1484) * lu(k,1885) + lu(k,1909) = lu(k,1909) - lu(k,1474) * lu(k,1908) + lu(k,1910) = lu(k,1910) - lu(k,1475) * lu(k,1908) + lu(k,1911) = lu(k,1911) - lu(k,1476) * lu(k,1908) + lu(k,1912) = lu(k,1912) - lu(k,1477) * lu(k,1908) + lu(k,1913) = lu(k,1913) - lu(k,1478) * lu(k,1908) + lu(k,1914) = lu(k,1914) - lu(k,1479) * lu(k,1908) + lu(k,1915) = lu(k,1915) - lu(k,1480) * lu(k,1908) + lu(k,1916) = lu(k,1916) - lu(k,1481) * lu(k,1908) + lu(k,1917) = lu(k,1917) - lu(k,1482) * lu(k,1908) + lu(k,1918) = lu(k,1918) - lu(k,1483) * lu(k,1908) + lu(k,1919) = lu(k,1919) - lu(k,1484) * lu(k,1908) + lu(k,1987) = lu(k,1987) - lu(k,1474) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1475) * lu(k,1986) + lu(k,1989) = lu(k,1989) - lu(k,1476) * lu(k,1986) + lu(k,1990) = lu(k,1990) - lu(k,1477) * lu(k,1986) + lu(k,1991) = lu(k,1991) - lu(k,1478) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1479) * lu(k,1986) + lu(k,1993) = lu(k,1993) - lu(k,1480) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1481) * lu(k,1986) + lu(k,1995) = lu(k,1995) - lu(k,1482) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1483) * lu(k,1986) + lu(k,1997) = lu(k,1997) - lu(k,1484) * lu(k,1986) + lu(k,2012) = lu(k,2012) - lu(k,1474) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1475) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1476) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1477) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1478) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1479) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1480) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1481) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1482) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1483) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1484) * lu(k,2011) + end do + end subroutine lu_fac26 + subroutine lu_fac27( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1621) = 1._r8 / lu(k,1621) + lu(k,1622) = lu(k,1622) * lu(k,1621) + lu(k,1623) = lu(k,1623) * lu(k,1621) + lu(k,1624) = lu(k,1624) * lu(k,1621) + lu(k,1625) = lu(k,1625) * lu(k,1621) + lu(k,1626) = lu(k,1626) * lu(k,1621) + lu(k,1627) = lu(k,1627) * lu(k,1621) + lu(k,1628) = lu(k,1628) * lu(k,1621) + lu(k,1629) = lu(k,1629) * lu(k,1621) + lu(k,1630) = lu(k,1630) * lu(k,1621) + lu(k,1631) = lu(k,1631) * lu(k,1621) + lu(k,1672) = lu(k,1672) - lu(k,1622) * lu(k,1671) + lu(k,1673) = lu(k,1673) - lu(k,1623) * lu(k,1671) + lu(k,1674) = lu(k,1674) - lu(k,1624) * lu(k,1671) + lu(k,1675) = lu(k,1675) - lu(k,1625) * lu(k,1671) + lu(k,1676) = lu(k,1676) - lu(k,1626) * lu(k,1671) + lu(k,1677) = lu(k,1677) - lu(k,1627) * lu(k,1671) + lu(k,1678) = lu(k,1678) - lu(k,1628) * lu(k,1671) + lu(k,1679) = lu(k,1679) - lu(k,1629) * lu(k,1671) + lu(k,1680) = lu(k,1680) - lu(k,1630) * lu(k,1671) + lu(k,1681) = lu(k,1681) - lu(k,1631) * lu(k,1671) + lu(k,1698) = lu(k,1698) - lu(k,1622) * lu(k,1697) + lu(k,1699) = lu(k,1699) - lu(k,1623) * lu(k,1697) + lu(k,1700) = lu(k,1700) - lu(k,1624) * lu(k,1697) + lu(k,1701) = lu(k,1701) - lu(k,1625) * lu(k,1697) + lu(k,1702) = lu(k,1702) - lu(k,1626) * lu(k,1697) + lu(k,1703) = lu(k,1703) - lu(k,1627) * lu(k,1697) + lu(k,1704) = lu(k,1704) - lu(k,1628) * lu(k,1697) + lu(k,1705) = lu(k,1705) - lu(k,1629) * lu(k,1697) + lu(k,1706) = lu(k,1706) - lu(k,1630) * lu(k,1697) + lu(k,1707) = lu(k,1707) - lu(k,1631) * lu(k,1697) + lu(k,1732) = lu(k,1732) - lu(k,1622) * lu(k,1731) + lu(k,1733) = lu(k,1733) - lu(k,1623) * lu(k,1731) + lu(k,1734) = lu(k,1734) - lu(k,1624) * lu(k,1731) + lu(k,1735) = lu(k,1735) - lu(k,1625) * lu(k,1731) + lu(k,1736) = lu(k,1736) - lu(k,1626) * lu(k,1731) + lu(k,1737) = lu(k,1737) - lu(k,1627) * lu(k,1731) + lu(k,1738) = lu(k,1738) - lu(k,1628) * lu(k,1731) + lu(k,1739) = lu(k,1739) - lu(k,1629) * lu(k,1731) + lu(k,1740) = lu(k,1740) - lu(k,1630) * lu(k,1731) + lu(k,1741) = lu(k,1741) - lu(k,1631) * lu(k,1731) + lu(k,1773) = lu(k,1773) - lu(k,1622) * lu(k,1772) + lu(k,1774) = lu(k,1774) - lu(k,1623) * lu(k,1772) + lu(k,1775) = lu(k,1775) - lu(k,1624) * lu(k,1772) + lu(k,1776) = lu(k,1776) - lu(k,1625) * lu(k,1772) + lu(k,1777) = lu(k,1777) - lu(k,1626) * lu(k,1772) + lu(k,1778) = lu(k,1778) - lu(k,1627) * lu(k,1772) + lu(k,1779) = lu(k,1779) - lu(k,1628) * lu(k,1772) + lu(k,1780) = lu(k,1780) - lu(k,1629) * lu(k,1772) + lu(k,1781) = lu(k,1781) - lu(k,1630) * lu(k,1772) + lu(k,1782) = lu(k,1782) - lu(k,1631) * lu(k,1772) + lu(k,1833) = lu(k,1833) - lu(k,1622) * lu(k,1832) + lu(k,1834) = lu(k,1834) - lu(k,1623) * lu(k,1832) + lu(k,1835) = lu(k,1835) - lu(k,1624) * lu(k,1832) + lu(k,1836) = lu(k,1836) - lu(k,1625) * lu(k,1832) + lu(k,1837) = lu(k,1837) - lu(k,1626) * lu(k,1832) + lu(k,1838) = lu(k,1838) - lu(k,1627) * lu(k,1832) + lu(k,1839) = lu(k,1839) - lu(k,1628) * lu(k,1832) + lu(k,1840) = lu(k,1840) - lu(k,1629) * lu(k,1832) + lu(k,1841) = lu(k,1841) - lu(k,1630) * lu(k,1832) + lu(k,1842) = lu(k,1842) - lu(k,1631) * lu(k,1832) + lu(k,1857) = lu(k,1857) - lu(k,1622) * lu(k,1856) + lu(k,1858) = lu(k,1858) - lu(k,1623) * lu(k,1856) + lu(k,1859) = lu(k,1859) - lu(k,1624) * lu(k,1856) + lu(k,1860) = lu(k,1860) - lu(k,1625) * lu(k,1856) + lu(k,1861) = lu(k,1861) - lu(k,1626) * lu(k,1856) + lu(k,1862) = lu(k,1862) - lu(k,1627) * lu(k,1856) + lu(k,1863) = lu(k,1863) - lu(k,1628) * lu(k,1856) + lu(k,1864) = lu(k,1864) - lu(k,1629) * lu(k,1856) + lu(k,1865) = lu(k,1865) - lu(k,1630) * lu(k,1856) + lu(k,1866) = lu(k,1866) - lu(k,1631) * lu(k,1856) + lu(k,1887) = lu(k,1887) - lu(k,1622) * lu(k,1886) + lu(k,1888) = lu(k,1888) - lu(k,1623) * lu(k,1886) + lu(k,1889) = lu(k,1889) - lu(k,1624) * lu(k,1886) + lu(k,1890) = lu(k,1890) - lu(k,1625) * lu(k,1886) + lu(k,1891) = lu(k,1891) - lu(k,1626) * lu(k,1886) + lu(k,1892) = lu(k,1892) - lu(k,1627) * lu(k,1886) + lu(k,1893) = lu(k,1893) - lu(k,1628) * lu(k,1886) + lu(k,1894) = lu(k,1894) - lu(k,1629) * lu(k,1886) + lu(k,1895) = lu(k,1895) - lu(k,1630) * lu(k,1886) + lu(k,1896) = lu(k,1896) - lu(k,1631) * lu(k,1886) + lu(k,1910) = lu(k,1910) - lu(k,1622) * lu(k,1909) + lu(k,1911) = lu(k,1911) - lu(k,1623) * lu(k,1909) + lu(k,1912) = lu(k,1912) - lu(k,1624) * lu(k,1909) + lu(k,1913) = lu(k,1913) - lu(k,1625) * lu(k,1909) + lu(k,1914) = lu(k,1914) - lu(k,1626) * lu(k,1909) + lu(k,1915) = lu(k,1915) - lu(k,1627) * lu(k,1909) + lu(k,1916) = lu(k,1916) - lu(k,1628) * lu(k,1909) + lu(k,1917) = lu(k,1917) - lu(k,1629) * lu(k,1909) + lu(k,1918) = lu(k,1918) - lu(k,1630) * lu(k,1909) + lu(k,1919) = lu(k,1919) - lu(k,1631) * lu(k,1909) + lu(k,1988) = lu(k,1988) - lu(k,1622) * lu(k,1987) + lu(k,1989) = lu(k,1989) - lu(k,1623) * lu(k,1987) + lu(k,1990) = lu(k,1990) - lu(k,1624) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1625) * lu(k,1987) + lu(k,1992) = lu(k,1992) - lu(k,1626) * lu(k,1987) + lu(k,1993) = lu(k,1993) - lu(k,1627) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1628) * lu(k,1987) + lu(k,1995) = lu(k,1995) - lu(k,1629) * lu(k,1987) + lu(k,1996) = lu(k,1996) - lu(k,1630) * lu(k,1987) + lu(k,1997) = lu(k,1997) - lu(k,1631) * lu(k,1987) + lu(k,2013) = lu(k,2013) - lu(k,1622) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1623) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1624) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1625) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1626) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1627) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1628) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1629) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1630) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1631) * lu(k,2012) + lu(k,1672) = 1._r8 / lu(k,1672) + lu(k,1673) = lu(k,1673) * lu(k,1672) + lu(k,1674) = lu(k,1674) * lu(k,1672) + lu(k,1675) = lu(k,1675) * lu(k,1672) + lu(k,1676) = lu(k,1676) * lu(k,1672) + lu(k,1677) = lu(k,1677) * lu(k,1672) + lu(k,1678) = lu(k,1678) * lu(k,1672) + lu(k,1679) = lu(k,1679) * lu(k,1672) + lu(k,1680) = lu(k,1680) * lu(k,1672) + lu(k,1681) = lu(k,1681) * lu(k,1672) + lu(k,1699) = lu(k,1699) - lu(k,1673) * lu(k,1698) + lu(k,1700) = lu(k,1700) - lu(k,1674) * lu(k,1698) + lu(k,1701) = lu(k,1701) - lu(k,1675) * lu(k,1698) + lu(k,1702) = lu(k,1702) - lu(k,1676) * lu(k,1698) + lu(k,1703) = lu(k,1703) - lu(k,1677) * lu(k,1698) + lu(k,1704) = lu(k,1704) - lu(k,1678) * lu(k,1698) + lu(k,1705) = lu(k,1705) - lu(k,1679) * lu(k,1698) + lu(k,1706) = lu(k,1706) - lu(k,1680) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,1681) * lu(k,1698) + lu(k,1733) = lu(k,1733) - lu(k,1673) * lu(k,1732) + lu(k,1734) = lu(k,1734) - lu(k,1674) * lu(k,1732) + lu(k,1735) = lu(k,1735) - lu(k,1675) * lu(k,1732) + lu(k,1736) = lu(k,1736) - lu(k,1676) * lu(k,1732) + lu(k,1737) = lu(k,1737) - lu(k,1677) * lu(k,1732) + lu(k,1738) = lu(k,1738) - lu(k,1678) * lu(k,1732) + lu(k,1739) = lu(k,1739) - lu(k,1679) * lu(k,1732) + lu(k,1740) = lu(k,1740) - lu(k,1680) * lu(k,1732) + lu(k,1741) = lu(k,1741) - lu(k,1681) * lu(k,1732) + lu(k,1774) = lu(k,1774) - lu(k,1673) * lu(k,1773) + lu(k,1775) = lu(k,1775) - lu(k,1674) * lu(k,1773) + lu(k,1776) = lu(k,1776) - lu(k,1675) * lu(k,1773) + lu(k,1777) = lu(k,1777) - lu(k,1676) * lu(k,1773) + lu(k,1778) = lu(k,1778) - lu(k,1677) * lu(k,1773) + lu(k,1779) = lu(k,1779) - lu(k,1678) * lu(k,1773) + lu(k,1780) = lu(k,1780) - lu(k,1679) * lu(k,1773) + lu(k,1781) = lu(k,1781) - lu(k,1680) * lu(k,1773) + lu(k,1782) = lu(k,1782) - lu(k,1681) * lu(k,1773) + lu(k,1834) = lu(k,1834) - lu(k,1673) * lu(k,1833) + lu(k,1835) = lu(k,1835) - lu(k,1674) * lu(k,1833) + lu(k,1836) = lu(k,1836) - lu(k,1675) * lu(k,1833) + lu(k,1837) = lu(k,1837) - lu(k,1676) * lu(k,1833) + lu(k,1838) = lu(k,1838) - lu(k,1677) * lu(k,1833) + lu(k,1839) = lu(k,1839) - lu(k,1678) * lu(k,1833) + lu(k,1840) = lu(k,1840) - lu(k,1679) * lu(k,1833) + lu(k,1841) = lu(k,1841) - lu(k,1680) * lu(k,1833) + lu(k,1842) = lu(k,1842) - lu(k,1681) * lu(k,1833) + lu(k,1858) = lu(k,1858) - lu(k,1673) * lu(k,1857) + lu(k,1859) = lu(k,1859) - lu(k,1674) * lu(k,1857) + lu(k,1860) = lu(k,1860) - lu(k,1675) * lu(k,1857) + lu(k,1861) = lu(k,1861) - lu(k,1676) * lu(k,1857) + lu(k,1862) = lu(k,1862) - lu(k,1677) * lu(k,1857) + lu(k,1863) = lu(k,1863) - lu(k,1678) * lu(k,1857) + lu(k,1864) = lu(k,1864) - lu(k,1679) * lu(k,1857) + lu(k,1865) = lu(k,1865) - lu(k,1680) * lu(k,1857) + lu(k,1866) = lu(k,1866) - lu(k,1681) * lu(k,1857) + lu(k,1888) = lu(k,1888) - lu(k,1673) * lu(k,1887) + lu(k,1889) = lu(k,1889) - lu(k,1674) * lu(k,1887) + lu(k,1890) = lu(k,1890) - lu(k,1675) * lu(k,1887) + lu(k,1891) = lu(k,1891) - lu(k,1676) * lu(k,1887) + lu(k,1892) = lu(k,1892) - lu(k,1677) * lu(k,1887) + lu(k,1893) = lu(k,1893) - lu(k,1678) * lu(k,1887) + lu(k,1894) = lu(k,1894) - lu(k,1679) * lu(k,1887) + lu(k,1895) = lu(k,1895) - lu(k,1680) * lu(k,1887) + lu(k,1896) = lu(k,1896) - lu(k,1681) * lu(k,1887) + lu(k,1911) = lu(k,1911) - lu(k,1673) * lu(k,1910) + lu(k,1912) = lu(k,1912) - lu(k,1674) * lu(k,1910) + lu(k,1913) = lu(k,1913) - lu(k,1675) * lu(k,1910) + lu(k,1914) = lu(k,1914) - lu(k,1676) * lu(k,1910) + lu(k,1915) = lu(k,1915) - lu(k,1677) * lu(k,1910) + lu(k,1916) = lu(k,1916) - lu(k,1678) * lu(k,1910) + lu(k,1917) = lu(k,1917) - lu(k,1679) * lu(k,1910) + lu(k,1918) = lu(k,1918) - lu(k,1680) * lu(k,1910) + lu(k,1919) = lu(k,1919) - lu(k,1681) * lu(k,1910) + lu(k,1989) = lu(k,1989) - lu(k,1673) * lu(k,1988) + lu(k,1990) = lu(k,1990) - lu(k,1674) * lu(k,1988) + lu(k,1991) = lu(k,1991) - lu(k,1675) * lu(k,1988) + lu(k,1992) = lu(k,1992) - lu(k,1676) * lu(k,1988) + lu(k,1993) = lu(k,1993) - lu(k,1677) * lu(k,1988) + lu(k,1994) = lu(k,1994) - lu(k,1678) * lu(k,1988) + lu(k,1995) = lu(k,1995) - lu(k,1679) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,1680) * lu(k,1988) + lu(k,1997) = lu(k,1997) - lu(k,1681) * lu(k,1988) + lu(k,2014) = lu(k,2014) - lu(k,1673) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1674) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1675) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1676) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1677) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1678) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1679) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1680) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1681) * lu(k,2013) + lu(k,1699) = 1._r8 / lu(k,1699) + lu(k,1700) = lu(k,1700) * lu(k,1699) + lu(k,1701) = lu(k,1701) * lu(k,1699) + lu(k,1702) = lu(k,1702) * lu(k,1699) + lu(k,1703) = lu(k,1703) * lu(k,1699) + lu(k,1704) = lu(k,1704) * lu(k,1699) + lu(k,1705) = lu(k,1705) * lu(k,1699) + lu(k,1706) = lu(k,1706) * lu(k,1699) + lu(k,1707) = lu(k,1707) * lu(k,1699) + lu(k,1734) = lu(k,1734) - lu(k,1700) * lu(k,1733) + lu(k,1735) = lu(k,1735) - lu(k,1701) * lu(k,1733) + lu(k,1736) = lu(k,1736) - lu(k,1702) * lu(k,1733) + lu(k,1737) = lu(k,1737) - lu(k,1703) * lu(k,1733) + lu(k,1738) = lu(k,1738) - lu(k,1704) * lu(k,1733) + lu(k,1739) = lu(k,1739) - lu(k,1705) * lu(k,1733) + lu(k,1740) = lu(k,1740) - lu(k,1706) * lu(k,1733) + lu(k,1741) = lu(k,1741) - lu(k,1707) * lu(k,1733) + lu(k,1775) = lu(k,1775) - lu(k,1700) * lu(k,1774) + lu(k,1776) = lu(k,1776) - lu(k,1701) * lu(k,1774) + lu(k,1777) = lu(k,1777) - lu(k,1702) * lu(k,1774) + lu(k,1778) = lu(k,1778) - lu(k,1703) * lu(k,1774) + lu(k,1779) = lu(k,1779) - lu(k,1704) * lu(k,1774) + lu(k,1780) = lu(k,1780) - lu(k,1705) * lu(k,1774) + lu(k,1781) = lu(k,1781) - lu(k,1706) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,1707) * lu(k,1774) + lu(k,1835) = lu(k,1835) - lu(k,1700) * lu(k,1834) + lu(k,1836) = lu(k,1836) - lu(k,1701) * lu(k,1834) + lu(k,1837) = lu(k,1837) - lu(k,1702) * lu(k,1834) + lu(k,1838) = lu(k,1838) - lu(k,1703) * lu(k,1834) + lu(k,1839) = lu(k,1839) - lu(k,1704) * lu(k,1834) + lu(k,1840) = lu(k,1840) - lu(k,1705) * lu(k,1834) + lu(k,1841) = lu(k,1841) - lu(k,1706) * lu(k,1834) + lu(k,1842) = lu(k,1842) - lu(k,1707) * lu(k,1834) + lu(k,1859) = lu(k,1859) - lu(k,1700) * lu(k,1858) + lu(k,1860) = lu(k,1860) - lu(k,1701) * lu(k,1858) + lu(k,1861) = lu(k,1861) - lu(k,1702) * lu(k,1858) + lu(k,1862) = lu(k,1862) - lu(k,1703) * lu(k,1858) + lu(k,1863) = lu(k,1863) - lu(k,1704) * lu(k,1858) + lu(k,1864) = lu(k,1864) - lu(k,1705) * lu(k,1858) + lu(k,1865) = lu(k,1865) - lu(k,1706) * lu(k,1858) + lu(k,1866) = lu(k,1866) - lu(k,1707) * lu(k,1858) + lu(k,1889) = lu(k,1889) - lu(k,1700) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1701) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1702) * lu(k,1888) + lu(k,1892) = lu(k,1892) - lu(k,1703) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1704) * lu(k,1888) + lu(k,1894) = lu(k,1894) - lu(k,1705) * lu(k,1888) + lu(k,1895) = lu(k,1895) - lu(k,1706) * lu(k,1888) + lu(k,1896) = lu(k,1896) - lu(k,1707) * lu(k,1888) + lu(k,1912) = lu(k,1912) - lu(k,1700) * lu(k,1911) + lu(k,1913) = lu(k,1913) - lu(k,1701) * lu(k,1911) + lu(k,1914) = lu(k,1914) - lu(k,1702) * lu(k,1911) + lu(k,1915) = lu(k,1915) - lu(k,1703) * lu(k,1911) + lu(k,1916) = lu(k,1916) - lu(k,1704) * lu(k,1911) + lu(k,1917) = lu(k,1917) - lu(k,1705) * lu(k,1911) + lu(k,1918) = lu(k,1918) - lu(k,1706) * lu(k,1911) + lu(k,1919) = lu(k,1919) - lu(k,1707) * lu(k,1911) + lu(k,1990) = lu(k,1990) - lu(k,1700) * lu(k,1989) + lu(k,1991) = lu(k,1991) - lu(k,1701) * lu(k,1989) + lu(k,1992) = lu(k,1992) - lu(k,1702) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1703) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1704) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1705) * lu(k,1989) + lu(k,1996) = lu(k,1996) - lu(k,1706) * lu(k,1989) + lu(k,1997) = lu(k,1997) - lu(k,1707) * lu(k,1989) + lu(k,2015) = lu(k,2015) - lu(k,1700) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1701) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1702) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1703) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1704) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1705) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1706) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1707) * lu(k,2014) + lu(k,1734) = 1._r8 / lu(k,1734) + lu(k,1735) = lu(k,1735) * lu(k,1734) + lu(k,1736) = lu(k,1736) * lu(k,1734) + lu(k,1737) = lu(k,1737) * lu(k,1734) + lu(k,1738) = lu(k,1738) * lu(k,1734) + lu(k,1739) = lu(k,1739) * lu(k,1734) + lu(k,1740) = lu(k,1740) * lu(k,1734) + lu(k,1741) = lu(k,1741) * lu(k,1734) + lu(k,1776) = lu(k,1776) - lu(k,1735) * lu(k,1775) + lu(k,1777) = lu(k,1777) - lu(k,1736) * lu(k,1775) + lu(k,1778) = lu(k,1778) - lu(k,1737) * lu(k,1775) + lu(k,1779) = lu(k,1779) - lu(k,1738) * lu(k,1775) + lu(k,1780) = lu(k,1780) - lu(k,1739) * lu(k,1775) + lu(k,1781) = lu(k,1781) - lu(k,1740) * lu(k,1775) + lu(k,1782) = lu(k,1782) - lu(k,1741) * lu(k,1775) + lu(k,1836) = lu(k,1836) - lu(k,1735) * lu(k,1835) + lu(k,1837) = lu(k,1837) - lu(k,1736) * lu(k,1835) + lu(k,1838) = lu(k,1838) - lu(k,1737) * lu(k,1835) + lu(k,1839) = lu(k,1839) - lu(k,1738) * lu(k,1835) + lu(k,1840) = lu(k,1840) - lu(k,1739) * lu(k,1835) + lu(k,1841) = lu(k,1841) - lu(k,1740) * lu(k,1835) + lu(k,1842) = lu(k,1842) - lu(k,1741) * lu(k,1835) + lu(k,1860) = lu(k,1860) - lu(k,1735) * lu(k,1859) + lu(k,1861) = lu(k,1861) - lu(k,1736) * lu(k,1859) + lu(k,1862) = lu(k,1862) - lu(k,1737) * lu(k,1859) + lu(k,1863) = lu(k,1863) - lu(k,1738) * lu(k,1859) + lu(k,1864) = lu(k,1864) - lu(k,1739) * lu(k,1859) + lu(k,1865) = lu(k,1865) - lu(k,1740) * lu(k,1859) + lu(k,1866) = lu(k,1866) - lu(k,1741) * lu(k,1859) + lu(k,1890) = lu(k,1890) - lu(k,1735) * lu(k,1889) + lu(k,1891) = lu(k,1891) - lu(k,1736) * lu(k,1889) + lu(k,1892) = lu(k,1892) - lu(k,1737) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,1738) * lu(k,1889) + lu(k,1894) = lu(k,1894) - lu(k,1739) * lu(k,1889) + lu(k,1895) = lu(k,1895) - lu(k,1740) * lu(k,1889) + lu(k,1896) = lu(k,1896) - lu(k,1741) * lu(k,1889) + lu(k,1913) = lu(k,1913) - lu(k,1735) * lu(k,1912) + lu(k,1914) = lu(k,1914) - lu(k,1736) * lu(k,1912) + lu(k,1915) = lu(k,1915) - lu(k,1737) * lu(k,1912) + lu(k,1916) = lu(k,1916) - lu(k,1738) * lu(k,1912) + lu(k,1917) = lu(k,1917) - lu(k,1739) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,1740) * lu(k,1912) + lu(k,1919) = lu(k,1919) - lu(k,1741) * lu(k,1912) + lu(k,1991) = lu(k,1991) - lu(k,1735) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1736) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1737) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1738) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,1739) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,1740) * lu(k,1990) + lu(k,1997) = lu(k,1997) - lu(k,1741) * lu(k,1990) + lu(k,2016) = lu(k,2016) - lu(k,1735) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1736) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1737) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1738) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1739) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1740) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1741) * lu(k,2015) + lu(k,1776) = 1._r8 / lu(k,1776) + lu(k,1777) = lu(k,1777) * lu(k,1776) + lu(k,1778) = lu(k,1778) * lu(k,1776) + lu(k,1779) = lu(k,1779) * lu(k,1776) + lu(k,1780) = lu(k,1780) * lu(k,1776) + lu(k,1781) = lu(k,1781) * lu(k,1776) + lu(k,1782) = lu(k,1782) * lu(k,1776) + lu(k,1837) = lu(k,1837) - lu(k,1777) * lu(k,1836) + lu(k,1838) = lu(k,1838) - lu(k,1778) * lu(k,1836) + lu(k,1839) = lu(k,1839) - lu(k,1779) * lu(k,1836) + lu(k,1840) = lu(k,1840) - lu(k,1780) * lu(k,1836) + lu(k,1841) = lu(k,1841) - lu(k,1781) * lu(k,1836) + lu(k,1842) = lu(k,1842) - lu(k,1782) * lu(k,1836) + lu(k,1861) = lu(k,1861) - lu(k,1777) * lu(k,1860) + lu(k,1862) = lu(k,1862) - lu(k,1778) * lu(k,1860) + lu(k,1863) = lu(k,1863) - lu(k,1779) * lu(k,1860) + lu(k,1864) = lu(k,1864) - lu(k,1780) * lu(k,1860) + lu(k,1865) = lu(k,1865) - lu(k,1781) * lu(k,1860) + lu(k,1866) = lu(k,1866) - lu(k,1782) * lu(k,1860) + lu(k,1891) = lu(k,1891) - lu(k,1777) * lu(k,1890) + lu(k,1892) = lu(k,1892) - lu(k,1778) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1779) * lu(k,1890) + lu(k,1894) = lu(k,1894) - lu(k,1780) * lu(k,1890) + lu(k,1895) = lu(k,1895) - lu(k,1781) * lu(k,1890) + lu(k,1896) = lu(k,1896) - lu(k,1782) * lu(k,1890) + lu(k,1914) = lu(k,1914) - lu(k,1777) * lu(k,1913) + lu(k,1915) = lu(k,1915) - lu(k,1778) * lu(k,1913) + lu(k,1916) = lu(k,1916) - lu(k,1779) * lu(k,1913) + lu(k,1917) = lu(k,1917) - lu(k,1780) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,1781) * lu(k,1913) + lu(k,1919) = lu(k,1919) - lu(k,1782) * lu(k,1913) + lu(k,1992) = lu(k,1992) - lu(k,1777) * lu(k,1991) + lu(k,1993) = lu(k,1993) - lu(k,1778) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1779) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1780) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,1781) * lu(k,1991) + lu(k,1997) = lu(k,1997) - lu(k,1782) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,1777) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1778) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1779) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1780) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1781) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1782) * lu(k,2016) + lu(k,1837) = 1._r8 / lu(k,1837) + lu(k,1838) = lu(k,1838) * lu(k,1837) + lu(k,1839) = lu(k,1839) * lu(k,1837) + lu(k,1840) = lu(k,1840) * lu(k,1837) + lu(k,1841) = lu(k,1841) * lu(k,1837) + lu(k,1842) = lu(k,1842) * lu(k,1837) + lu(k,1862) = lu(k,1862) - lu(k,1838) * lu(k,1861) + lu(k,1863) = lu(k,1863) - lu(k,1839) * lu(k,1861) + lu(k,1864) = lu(k,1864) - lu(k,1840) * lu(k,1861) + lu(k,1865) = lu(k,1865) - lu(k,1841) * lu(k,1861) + lu(k,1866) = lu(k,1866) - lu(k,1842) * lu(k,1861) + lu(k,1892) = lu(k,1892) - lu(k,1838) * lu(k,1891) + lu(k,1893) = lu(k,1893) - lu(k,1839) * lu(k,1891) + lu(k,1894) = lu(k,1894) - lu(k,1840) * lu(k,1891) + lu(k,1895) = lu(k,1895) - lu(k,1841) * lu(k,1891) + lu(k,1896) = lu(k,1896) - lu(k,1842) * lu(k,1891) + lu(k,1915) = lu(k,1915) - lu(k,1838) * lu(k,1914) + lu(k,1916) = lu(k,1916) - lu(k,1839) * lu(k,1914) + lu(k,1917) = lu(k,1917) - lu(k,1840) * lu(k,1914) + lu(k,1918) = lu(k,1918) - lu(k,1841) * lu(k,1914) + lu(k,1919) = lu(k,1919) - lu(k,1842) * lu(k,1914) + lu(k,1993) = lu(k,1993) - lu(k,1838) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1839) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1840) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,1841) * lu(k,1992) + lu(k,1997) = lu(k,1997) - lu(k,1842) * lu(k,1992) + lu(k,2018) = lu(k,2018) - lu(k,1838) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1839) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1840) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1841) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1842) * lu(k,2017) + end do + end subroutine lu_fac27 + subroutine lu_fac28( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1862) = 1._r8 / lu(k,1862) + lu(k,1863) = lu(k,1863) * lu(k,1862) + lu(k,1864) = lu(k,1864) * lu(k,1862) + lu(k,1865) = lu(k,1865) * lu(k,1862) + lu(k,1866) = lu(k,1866) * lu(k,1862) + lu(k,1893) = lu(k,1893) - lu(k,1863) * lu(k,1892) + lu(k,1894) = lu(k,1894) - lu(k,1864) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,1865) * lu(k,1892) + lu(k,1896) = lu(k,1896) - lu(k,1866) * lu(k,1892) + lu(k,1916) = lu(k,1916) - lu(k,1863) * lu(k,1915) + lu(k,1917) = lu(k,1917) - lu(k,1864) * lu(k,1915) + lu(k,1918) = lu(k,1918) - lu(k,1865) * lu(k,1915) + lu(k,1919) = lu(k,1919) - lu(k,1866) * lu(k,1915) + lu(k,1994) = lu(k,1994) - lu(k,1863) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,1864) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,1865) * lu(k,1993) + lu(k,1997) = lu(k,1997) - lu(k,1866) * lu(k,1993) + lu(k,2019) = lu(k,2019) - lu(k,1863) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1864) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1865) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1866) * lu(k,2018) + lu(k,1893) = 1._r8 / lu(k,1893) + lu(k,1894) = lu(k,1894) * lu(k,1893) + lu(k,1895) = lu(k,1895) * lu(k,1893) + lu(k,1896) = lu(k,1896) * lu(k,1893) + lu(k,1917) = lu(k,1917) - lu(k,1894) * lu(k,1916) + lu(k,1918) = lu(k,1918) - lu(k,1895) * lu(k,1916) + lu(k,1919) = lu(k,1919) - lu(k,1896) * lu(k,1916) + lu(k,1995) = lu(k,1995) - lu(k,1894) * lu(k,1994) + lu(k,1996) = lu(k,1996) - lu(k,1895) * lu(k,1994) + lu(k,1997) = lu(k,1997) - lu(k,1896) * lu(k,1994) + lu(k,2020) = lu(k,2020) - lu(k,1894) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1895) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1896) * lu(k,2019) + lu(k,1917) = 1._r8 / lu(k,1917) + lu(k,1918) = lu(k,1918) * lu(k,1917) + lu(k,1919) = lu(k,1919) * lu(k,1917) + lu(k,1996) = lu(k,1996) - lu(k,1918) * lu(k,1995) + lu(k,1997) = lu(k,1997) - lu(k,1919) * lu(k,1995) + lu(k,2021) = lu(k,2021) - lu(k,1918) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1919) * lu(k,2020) + lu(k,1996) = 1._r8 / lu(k,1996) + lu(k,1997) = lu(k,1997) * lu(k,1996) + lu(k,2022) = lu(k,2022) - lu(k,1997) * lu(k,2021) + lu(k,2022) = 1._r8 / lu(k,2022) + end do + end subroutine lu_fac28 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + call lu_fac11( avec_len, lu ) + call lu_fac12( avec_len, lu ) + call lu_fac13( avec_len, lu ) + call lu_fac14( avec_len, lu ) + call lu_fac15( avec_len, lu ) + call lu_fac16( avec_len, lu ) + call lu_fac17( avec_len, lu ) + call lu_fac18( avec_len, lu ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 new file mode 100644 index 0000000000..faf652842c --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 @@ -0,0 +1,2252 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,183) = b(k,183) - lu(k,47) * b(k,36) + b(k,184) = b(k,184) - lu(k,48) * b(k,36) + b(k,181) = b(k,181) - lu(k,50) * b(k,37) + b(k,191) = b(k,191) - lu(k,51) * b(k,37) + b(k,178) = b(k,178) - lu(k,53) * b(k,38) + b(k,181) = b(k,181) - lu(k,54) * b(k,38) + b(k,135) = b(k,135) - lu(k,56) * b(k,39) + b(k,181) = b(k,181) - lu(k,57) * b(k,39) + b(k,191) = b(k,191) - lu(k,58) * b(k,39) + b(k,132) = b(k,132) - lu(k,60) * b(k,40) + b(k,180) = b(k,180) - lu(k,61) * b(k,40) + b(k,66) = b(k,66) - lu(k,63) * b(k,41) + b(k,181) = b(k,181) - lu(k,64) * b(k,41) + b(k,63) = b(k,63) - lu(k,66) * b(k,42) + b(k,191) = b(k,191) - lu(k,67) * b(k,42) + b(k,163) = b(k,163) - lu(k,69) * b(k,43) + b(k,181) = b(k,181) - lu(k,70) * b(k,43) + b(k,105) = b(k,105) - lu(k,72) * b(k,44) + b(k,185) = b(k,185) - lu(k,73) * b(k,44) + b(k,184) = b(k,184) - lu(k,75) * b(k,45) + b(k,47) = b(k,47) - lu(k,82) * b(k,46) + b(k,48) = b(k,48) - lu(k,83) * b(k,46) + b(k,100) = b(k,100) - lu(k,84) * b(k,46) + b(k,178) = b(k,178) - lu(k,85) * b(k,46) + b(k,181) = b(k,181) - lu(k,86) * b(k,46) + b(k,96) = b(k,96) - lu(k,88) * b(k,47) + b(k,155) = b(k,155) - lu(k,89) * b(k,47) + b(k,178) = b(k,178) - lu(k,90) * b(k,47) + b(k,95) = b(k,95) - lu(k,92) * b(k,48) + b(k,98) = b(k,98) - lu(k,93) * b(k,48) + b(k,178) = b(k,178) - lu(k,94) * b(k,48) + b(k,181) = b(k,181) - lu(k,95) * b(k,48) + b(k,178) = b(k,178) - lu(k,97) * b(k,49) + b(k,180) = b(k,180) - lu(k,98) * b(k,49) + b(k,181) = b(k,181) - lu(k,99) * b(k,49) + b(k,132) = b(k,132) - lu(k,101) * b(k,50) + b(k,180) = b(k,180) - lu(k,102) * b(k,50) + b(k,184) = b(k,184) - lu(k,103) * b(k,50) + b(k,52) = b(k,52) - lu(k,110) * b(k,51) + b(k,53) = b(k,53) - lu(k,111) * b(k,51) + b(k,93) = b(k,93) - lu(k,112) * b(k,51) + b(k,127) = b(k,127) - lu(k,113) * b(k,51) + b(k,178) = b(k,178) - lu(k,114) * b(k,51) + b(k,181) = b(k,181) - lu(k,115) * b(k,51) + b(k,95) = b(k,95) - lu(k,117) * b(k,52) + b(k,98) = b(k,98) - lu(k,118) * b(k,52) + b(k,178) = b(k,178) - lu(k,119) * b(k,52) + b(k,181) = b(k,181) - lu(k,120) * b(k,52) + b(k,155) = b(k,155) - lu(k,122) * b(k,53) + b(k,173) = b(k,173) - lu(k,123) * b(k,53) + b(k,178) = b(k,178) - lu(k,124) * b(k,53) + b(k,163) = b(k,163) - lu(k,126) * b(k,54) + b(k,181) = b(k,181) - lu(k,127) * b(k,54) + b(k,56) = b(k,56) - lu(k,135) * b(k,55) + b(k,93) = b(k,93) - lu(k,136) * b(k,55) + b(k,128) = b(k,128) - lu(k,137) * b(k,55) + b(k,155) = b(k,155) - lu(k,138) * b(k,55) + b(k,173) = b(k,173) - lu(k,139) * b(k,55) + b(k,178) = b(k,178) - lu(k,140) * b(k,55) + b(k,181) = b(k,181) - lu(k,141) * b(k,55) + b(k,98) = b(k,98) - lu(k,143) * b(k,56) + b(k,101) = b(k,101) - lu(k,144) * b(k,56) + b(k,178) = b(k,178) - lu(k,145) * b(k,56) + b(k,181) = b(k,181) - lu(k,146) * b(k,56) + b(k,132) = b(k,132) - lu(k,148) * b(k,57) + b(k,176) = b(k,176) - lu(k,149) * b(k,57) + b(k,117) = b(k,117) - lu(k,151) * b(k,58) + b(k,163) = b(k,163) - lu(k,152) * b(k,58) + b(k,178) = b(k,178) - lu(k,153) * b(k,58) + b(k,181) = b(k,181) - lu(k,154) * b(k,58) + b(k,175) = b(k,175) - lu(k,156) * b(k,59) + b(k,185) = b(k,185) - lu(k,157) * b(k,59) + b(k,146) = b(k,146) - lu(k,159) * b(k,60) + b(k,181) = b(k,181) - lu(k,160) * b(k,60) + b(k,174) = b(k,174) - lu(k,162) * b(k,61) + b(k,184) = b(k,184) - lu(k,163) * b(k,61) + b(k,105) = b(k,105) - lu(k,165) * b(k,62) + b(k,181) = b(k,181) - lu(k,166) * b(k,62) + b(k,140) = b(k,140) - lu(k,169) * b(k,63) + b(k,188) = b(k,188) - lu(k,170) * b(k,63) + b(k,191) = b(k,191) - lu(k,171) * b(k,63) + b(k,161) = b(k,161) - lu(k,173) * b(k,64) + b(k,178) = b(k,178) - lu(k,174) * b(k,64) + b(k,181) = b(k,181) - lu(k,175) * b(k,64) + b(k,98) = b(k,98) - lu(k,177) * b(k,65) + b(k,119) = b(k,119) - lu(k,178) * b(k,65) + b(k,181) = b(k,181) - lu(k,179) * b(k,65) + b(k,151) = b(k,151) - lu(k,181) * b(k,66) + b(k,178) = b(k,178) - lu(k,182) * b(k,66) + b(k,189) = b(k,189) - lu(k,183) * b(k,66) + b(k,175) = b(k,175) - lu(k,185) * b(k,67) + b(k,179) = b(k,179) - lu(k,186) * b(k,67) + b(k,185) = b(k,185) - lu(k,187) * b(k,67) + b(k,188) = b(k,188) - lu(k,188) * b(k,67) + b(k,190) = b(k,190) - lu(k,189) * b(k,67) + b(k,129) = b(k,129) - lu(k,191) * b(k,68) + b(k,178) = b(k,178) - lu(k,192) * b(k,68) + b(k,140) = b(k,140) - lu(k,194) * b(k,69) + b(k,175) = b(k,175) - lu(k,195) * b(k,69) + b(k,178) = b(k,178) - lu(k,196) * b(k,69) + b(k,179) = b(k,179) - lu(k,197) * b(k,69) + b(k,181) = b(k,181) - lu(k,198) * b(k,69) + b(k,133) = b(k,133) - lu(k,200) * b(k,70) + b(k,142) = b(k,142) - lu(k,201) * b(k,70) + b(k,155) = b(k,155) - lu(k,202) * b(k,70) + b(k,178) = b(k,178) - lu(k,203) * b(k,70) + b(k,181) = b(k,181) - lu(k,204) * b(k,70) + b(k,137) = b(k,137) - lu(k,206) * b(k,71) + b(k,177) = b(k,177) - lu(k,207) * b(k,71) + b(k,181) = b(k,181) - lu(k,208) * b(k,71) + b(k,184) = b(k,184) - lu(k,209) * b(k,71) + b(k,191) = b(k,191) - lu(k,210) * b(k,71) + b(k,163) = b(k,163) - lu(k,212) * b(k,72) + b(k,181) = b(k,181) - lu(k,213) * b(k,72) + b(k,170) = b(k,170) - lu(k,215) * b(k,73) + b(k,172) = b(k,172) - lu(k,216) * b(k,73) + b(k,178) = b(k,178) - lu(k,217) * b(k,73) + b(k,181) = b(k,181) - lu(k,218) * b(k,73) + b(k,122) = b(k,122) - lu(k,220) * b(k,74) + b(k,161) = b(k,161) - lu(k,221) * b(k,74) + b(k,173) = b(k,173) - lu(k,222) * b(k,74) + b(k,181) = b(k,181) - lu(k,223) * b(k,74) + b(k,155) = b(k,155) - lu(k,225) * b(k,75) + b(k,166) = b(k,166) - lu(k,226) * b(k,75) + b(k,173) = b(k,173) - lu(k,227) * b(k,75) + b(k,178) = b(k,178) - lu(k,228) * b(k,75) + b(k,140) = b(k,140) - lu(k,230) * b(k,76) + b(k,167) = b(k,167) - lu(k,231) * b(k,76) + b(k,183) = b(k,183) - lu(k,232) * b(k,76) + b(k,188) = b(k,188) - lu(k,233) * b(k,76) + b(k,95) = b(k,95) - lu(k,235) * b(k,77) + b(k,142) = b(k,142) - lu(k,236) * b(k,77) + b(k,178) = b(k,178) - lu(k,237) * b(k,77) + b(k,181) = b(k,181) - lu(k,238) * b(k,77) + b(k,93) = b(k,93) - lu(k,241) * b(k,78) + b(k,105) = b(k,105) - lu(k,242) * b(k,78) + b(k,178) = b(k,178) - lu(k,243) * b(k,78) + b(k,181) = b(k,181) - lu(k,244) * b(k,78) + b(k,137) = b(k,137) - lu(k,246) * b(k,79) + b(k,161) = b(k,161) - lu(k,247) * b(k,79) + b(k,178) = b(k,178) - lu(k,248) * b(k,79) + b(k,181) = b(k,181) - lu(k,249) * b(k,79) + b(k,103) = b(k,103) - lu(k,251) * b(k,80) + b(k,140) = b(k,140) - lu(k,252) * b(k,80) + b(k,155) = b(k,155) - lu(k,253) * b(k,80) + b(k,167) = b(k,167) - lu(k,254) * b(k,80) + b(k,176) = b(k,176) - lu(k,255) * b(k,80) + b(k,181) = b(k,181) - lu(k,256) * b(k,80) + b(k,188) = b(k,188) - lu(k,257) * b(k,80) + b(k,112) = b(k,112) - lu(k,259) * b(k,81) + b(k,147) = b(k,147) - lu(k,260) * b(k,81) + b(k,161) = b(k,161) - lu(k,261) * b(k,81) + b(k,179) = b(k,179) - lu(k,262) * b(k,81) + b(k,181) = b(k,181) - lu(k,263) * b(k,81) + b(k,185) = b(k,185) - lu(k,264) * b(k,81) + b(k,189) = b(k,189) - lu(k,265) * b(k,81) + b(k,176) = b(k,176) - lu(k,267) * b(k,82) + b(k,181) = b(k,181) - lu(k,268) * b(k,82) + b(k,185) = b(k,185) - lu(k,269) * b(k,82) + b(k,188) = b(k,188) - lu(k,270) * b(k,82) + b(k,190) = b(k,190) - lu(k,271) * b(k,82) + b(k,178) = b(k,178) - lu(k,273) * b(k,83) + b(k,179) = b(k,179) - lu(k,274) * b(k,83) + b(k,181) = b(k,181) - lu(k,275) * b(k,83) + b(k,185) = b(k,185) - lu(k,276) * b(k,83) + b(k,191) = b(k,191) - lu(k,277) * b(k,83) + b(k,141) = b(k,141) - lu(k,279) * b(k,84) + b(k,151) = b(k,151) - lu(k,280) * b(k,84) + b(k,175) = b(k,175) - lu(k,281) * b(k,84) + b(k,178) = b(k,178) - lu(k,282) * b(k,84) + b(k,181) = b(k,181) - lu(k,283) * b(k,84) + b(k,96) = b(k,96) - lu(k,285) * b(k,85) + b(k,100) = b(k,100) - lu(k,286) * b(k,85) + b(k,142) = b(k,142) - lu(k,287) * b(k,85) + b(k,178) = b(k,178) - lu(k,288) * b(k,85) + b(k,181) = b(k,181) - lu(k,289) * b(k,85) + b(k,142) = b(k,142) - lu(k,291) * b(k,86) + b(k,155) = b(k,155) - lu(k,292) * b(k,86) + b(k,166) = b(k,166) - lu(k,293) * b(k,86) + b(k,173) = b(k,173) - lu(k,294) * b(k,86) + b(k,178) = b(k,178) - lu(k,295) * b(k,86) + b(k,150) = b(k,150) - lu(k,297) * b(k,87) + b(k,159) = b(k,159) - lu(k,298) * b(k,87) + b(k,175) = b(k,175) - lu(k,299) * b(k,87) + b(k,181) = b(k,181) - lu(k,300) * b(k,87) + b(k,185) = b(k,185) - lu(k,301) * b(k,87) + b(k,160) = b(k,160) - lu(k,303) * b(k,88) + b(k,173) = b(k,173) - lu(k,304) * b(k,88) + b(k,181) = b(k,181) - lu(k,305) * b(k,88) + b(k,189) = b(k,189) - lu(k,306) * b(k,88) + b(k,191) = b(k,191) - lu(k,307) * b(k,88) + b(k,123) = b(k,123) - lu(k,309) * b(k,89) + b(k,141) = b(k,141) - lu(k,310) * b(k,89) + b(k,178) = b(k,178) - lu(k,311) * b(k,89) + b(k,181) = b(k,181) - lu(k,312) * b(k,89) + b(k,185) = b(k,185) - lu(k,313) * b(k,89) + b(k,135) = b(k,135) - lu(k,315) * b(k,90) + b(k,147) = b(k,147) - lu(k,316) * b(k,90) + b(k,178) = b(k,178) - lu(k,317) * b(k,90) + b(k,181) = b(k,181) - lu(k,318) * b(k,90) + b(k,191) = b(k,191) - lu(k,319) * b(k,90) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,176) = b(k,176) - lu(k,321) * b(k,91) + b(k,181) = b(k,181) - lu(k,322) * b(k,91) + b(k,182) = b(k,182) - lu(k,323) * b(k,91) + b(k,189) = b(k,189) - lu(k,324) * b(k,91) + b(k,191) = b(k,191) - lu(k,325) * b(k,91) + b(k,101) = b(k,101) - lu(k,327) * b(k,92) + b(k,142) = b(k,142) - lu(k,328) * b(k,92) + b(k,166) = b(k,166) - lu(k,329) * b(k,92) + b(k,178) = b(k,178) - lu(k,330) * b(k,92) + b(k,181) = b(k,181) - lu(k,331) * b(k,92) + b(k,105) = b(k,105) - lu(k,335) * b(k,93) + b(k,178) = b(k,178) - lu(k,336) * b(k,93) + b(k,181) = b(k,181) - lu(k,337) * b(k,93) + b(k,185) = b(k,185) - lu(k,338) * b(k,93) + b(k,190) = b(k,190) - lu(k,339) * b(k,93) + b(k,133) = b(k,133) - lu(k,341) * b(k,94) + b(k,178) = b(k,178) - lu(k,342) * b(k,94) + b(k,185) = b(k,185) - lu(k,343) * b(k,94) + b(k,189) = b(k,189) - lu(k,344) * b(k,94) + b(k,190) = b(k,190) - lu(k,345) * b(k,94) + b(k,142) = b(k,142) - lu(k,348) * b(k,95) + b(k,178) = b(k,178) - lu(k,349) * b(k,95) + b(k,181) = b(k,181) - lu(k,350) * b(k,95) + b(k,185) = b(k,185) - lu(k,351) * b(k,95) + b(k,190) = b(k,190) - lu(k,352) * b(k,95) + b(k,126) = b(k,126) - lu(k,354) * b(k,96) + b(k,178) = b(k,178) - lu(k,355) * b(k,96) + b(k,173) = b(k,173) - lu(k,357) * b(k,97) + b(k,179) = b(k,179) - lu(k,358) * b(k,97) + b(k,181) = b(k,181) - lu(k,359) * b(k,97) + b(k,182) = b(k,182) - lu(k,360) * b(k,97) + b(k,185) = b(k,185) - lu(k,361) * b(k,97) + b(k,189) = b(k,189) - lu(k,362) * b(k,97) + b(k,119) = b(k,119) - lu(k,364) * b(k,98) + b(k,185) = b(k,185) - lu(k,365) * b(k,98) + b(k,186) = b(k,186) - lu(k,366) * b(k,98) + b(k,147) = b(k,147) - lu(k,368) * b(k,99) + b(k,150) = b(k,150) - lu(k,369) * b(k,99) + b(k,157) = b(k,157) - lu(k,370) * b(k,99) + b(k,178) = b(k,178) - lu(k,371) * b(k,99) + b(k,181) = b(k,181) - lu(k,372) * b(k,99) + b(k,189) = b(k,189) - lu(k,373) * b(k,99) + b(k,126) = b(k,126) - lu(k,377) * b(k,100) + b(k,142) = b(k,142) - lu(k,378) * b(k,100) + b(k,178) = b(k,178) - lu(k,379) * b(k,100) + b(k,181) = b(k,181) - lu(k,380) * b(k,100) + b(k,185) = b(k,185) - lu(k,381) * b(k,100) + b(k,190) = b(k,190) - lu(k,382) * b(k,100) + b(k,142) = b(k,142) - lu(k,385) * b(k,101) + b(k,166) = b(k,166) - lu(k,386) * b(k,101) + b(k,178) = b(k,178) - lu(k,387) * b(k,101) + b(k,181) = b(k,181) - lu(k,388) * b(k,101) + b(k,185) = b(k,185) - lu(k,389) * b(k,101) + b(k,190) = b(k,190) - lu(k,390) * b(k,101) + b(k,173) = b(k,173) - lu(k,392) * b(k,102) + b(k,181) = b(k,181) - lu(k,393) * b(k,102) + b(k,182) = b(k,182) - lu(k,394) * b(k,102) + b(k,189) = b(k,189) - lu(k,395) * b(k,102) + b(k,191) = b(k,191) - lu(k,396) * b(k,102) + b(k,167) = b(k,167) - lu(k,398) * b(k,103) + b(k,176) = b(k,176) - lu(k,399) * b(k,103) + b(k,181) = b(k,181) - lu(k,400) * b(k,103) + b(k,186) = b(k,186) - lu(k,401) * b(k,103) + b(k,188) = b(k,188) - lu(k,402) * b(k,103) + b(k,122) = b(k,122) - lu(k,404) * b(k,104) + b(k,137) = b(k,137) - lu(k,405) * b(k,104) + b(k,173) = b(k,173) - lu(k,406) * b(k,104) + b(k,181) = b(k,181) - lu(k,407) * b(k,104) + b(k,119) = b(k,119) - lu(k,410) * b(k,105) + b(k,178) = b(k,178) - lu(k,411) * b(k,105) + b(k,181) = b(k,181) - lu(k,412) * b(k,105) + b(k,185) = b(k,185) - lu(k,413) * b(k,105) + b(k,190) = b(k,190) - lu(k,414) * b(k,105) + b(k,156) = b(k,156) - lu(k,416) * b(k,106) + b(k,172) = b(k,172) - lu(k,417) * b(k,106) + b(k,178) = b(k,178) - lu(k,418) * b(k,106) + b(k,179) = b(k,179) - lu(k,419) * b(k,106) + b(k,181) = b(k,181) - lu(k,420) * b(k,106) + b(k,185) = b(k,185) - lu(k,421) * b(k,106) + b(k,189) = b(k,189) - lu(k,422) * b(k,106) + b(k,141) = b(k,141) - lu(k,424) * b(k,107) + b(k,151) = b(k,151) - lu(k,425) * b(k,107) + b(k,154) = b(k,154) - lu(k,426) * b(k,107) + b(k,156) = b(k,156) - lu(k,427) * b(k,107) + b(k,175) = b(k,175) - lu(k,428) * b(k,107) + b(k,178) = b(k,178) - lu(k,429) * b(k,107) + b(k,181) = b(k,181) - lu(k,430) * b(k,107) + b(k,181) = b(k,181) - lu(k,432) * b(k,108) + b(k,182) = b(k,182) - lu(k,433) * b(k,108) + b(k,191) = b(k,191) - lu(k,434) * b(k,108) + b(k,130) = b(k,130) - lu(k,436) * b(k,109) + b(k,156) = b(k,156) - lu(k,437) * b(k,109) + b(k,161) = b(k,161) - lu(k,438) * b(k,109) + b(k,178) = b(k,178) - lu(k,439) * b(k,109) + b(k,181) = b(k,181) - lu(k,440) * b(k,109) + b(k,189) = b(k,189) - lu(k,441) * b(k,109) + b(k,191) = b(k,191) - lu(k,442) * b(k,109) + b(k,131) = b(k,131) - lu(k,444) * b(k,110) + b(k,174) = b(k,174) - lu(k,445) * b(k,110) + b(k,175) = b(k,175) - lu(k,446) * b(k,110) + b(k,179) = b(k,179) - lu(k,447) * b(k,110) + b(k,185) = b(k,185) - lu(k,448) * b(k,110) + b(k,187) = b(k,187) - lu(k,449) * b(k,110) + b(k,188) = b(k,188) - lu(k,450) * b(k,110) + b(k,125) = b(k,125) - lu(k,452) * b(k,111) + b(k,133) = b(k,133) - lu(k,453) * b(k,111) + b(k,155) = b(k,155) - lu(k,454) * b(k,111) + b(k,178) = b(k,178) - lu(k,455) * b(k,111) + b(k,181) = b(k,181) - lu(k,456) * b(k,111) + b(k,186) = b(k,186) - lu(k,457) * b(k,111) + b(k,189) = b(k,189) - lu(k,458) * b(k,111) + b(k,147) = b(k,147) - lu(k,460) * b(k,112) + b(k,154) = b(k,154) - lu(k,461) * b(k,112) + b(k,161) = b(k,161) - lu(k,462) * b(k,112) + b(k,178) = b(k,178) - lu(k,463) * b(k,112) + b(k,185) = b(k,185) - lu(k,464) * b(k,112) + b(k,189) = b(k,189) - lu(k,465) * b(k,112) + b(k,190) = b(k,190) - lu(k,466) * b(k,112) + b(k,151) = b(k,151) - lu(k,468) * b(k,113) + b(k,154) = b(k,154) - lu(k,469) * b(k,113) + b(k,156) = b(k,156) - lu(k,470) * b(k,113) + b(k,175) = b(k,175) - lu(k,471) * b(k,113) + b(k,178) = b(k,178) - lu(k,472) * b(k,113) + b(k,181) = b(k,181) - lu(k,473) * b(k,113) + b(k,185) = b(k,185) - lu(k,474) * b(k,113) + b(k,189) = b(k,189) - lu(k,475) * b(k,113) + b(k,177) = b(k,177) - lu(k,477) * b(k,114) + b(k,178) = b(k,178) - lu(k,478) * b(k,114) + b(k,181) = b(k,181) - lu(k,479) * b(k,114) + b(k,184) = b(k,184) - lu(k,480) * b(k,114) + b(k,188) = b(k,188) - lu(k,481) * b(k,114) + b(k,191) = b(k,191) - lu(k,482) * b(k,114) + b(k,147) = b(k,147) - lu(k,484) * b(k,115) + b(k,151) = b(k,151) - lu(k,485) * b(k,115) + b(k,153) = b(k,153) - lu(k,486) * b(k,115) + b(k,155) = b(k,155) - lu(k,487) * b(k,115) + b(k,158) = b(k,158) - lu(k,488) * b(k,115) + b(k,178) = b(k,178) - lu(k,489) * b(k,115) + b(k,181) = b(k,181) - lu(k,490) * b(k,115) + b(k,189) = b(k,189) - lu(k,491) * b(k,115) + b(k,117) = b(k,117) - lu(k,495) * b(k,116) + b(k,126) = b(k,126) - lu(k,496) * b(k,116) + b(k,127) = b(k,127) - lu(k,497) * b(k,116) + b(k,129) = b(k,129) - lu(k,498) * b(k,116) + b(k,142) = b(k,142) - lu(k,499) * b(k,116) + b(k,166) = b(k,166) - lu(k,500) * b(k,116) + b(k,178) = b(k,178) - lu(k,501) * b(k,116) + b(k,181) = b(k,181) - lu(k,502) * b(k,116) + b(k,143) = b(k,143) - lu(k,504) * b(k,117) + b(k,155) = b(k,155) - lu(k,505) * b(k,117) + b(k,178) = b(k,178) - lu(k,506) * b(k,117) + b(k,150) = b(k,150) - lu(k,508) * b(k,118) + b(k,175) = b(k,175) - lu(k,509) * b(k,118) + b(k,178) = b(k,178) - lu(k,510) * b(k,118) + b(k,181) = b(k,181) - lu(k,511) * b(k,118) + b(k,185) = b(k,185) - lu(k,512) * b(k,118) + b(k,178) = b(k,178) - lu(k,516) * b(k,119) + b(k,181) = b(k,181) - lu(k,517) * b(k,119) + b(k,185) = b(k,185) - lu(k,518) * b(k,119) + b(k,186) = b(k,186) - lu(k,519) * b(k,119) + b(k,190) = b(k,190) - lu(k,520) * b(k,119) + b(k,122) = b(k,122) - lu(k,523) * b(k,120) + b(k,137) = b(k,137) - lu(k,524) * b(k,120) + b(k,146) = b(k,146) - lu(k,525) * b(k,120) + b(k,147) = b(k,147) - lu(k,526) * b(k,120) + b(k,161) = b(k,161) - lu(k,527) * b(k,120) + b(k,173) = b(k,173) - lu(k,528) * b(k,120) + b(k,178) = b(k,178) - lu(k,529) * b(k,120) + b(k,181) = b(k,181) - lu(k,530) * b(k,120) + b(k,189) = b(k,189) - lu(k,531) * b(k,120) + b(k,122) = b(k,122) - lu(k,534) * b(k,121) + b(k,137) = b(k,137) - lu(k,535) * b(k,121) + b(k,147) = b(k,147) - lu(k,536) * b(k,121) + b(k,161) = b(k,161) - lu(k,537) * b(k,121) + b(k,173) = b(k,173) - lu(k,538) * b(k,121) + b(k,178) = b(k,178) - lu(k,539) * b(k,121) + b(k,181) = b(k,181) - lu(k,540) * b(k,121) + b(k,185) = b(k,185) - lu(k,541) * b(k,121) + b(k,189) = b(k,189) - lu(k,542) * b(k,121) + b(k,161) = b(k,161) - lu(k,545) * b(k,122) + b(k,173) = b(k,173) - lu(k,546) * b(k,122) + b(k,178) = b(k,178) - lu(k,547) * b(k,122) + b(k,181) = b(k,181) - lu(k,548) * b(k,122) + b(k,185) = b(k,185) - lu(k,549) * b(k,122) + b(k,190) = b(k,190) - lu(k,550) * b(k,122) + b(k,163) = b(k,163) - lu(k,553) * b(k,123) + b(k,165) = b(k,165) - lu(k,554) * b(k,123) + b(k,169) = b(k,169) - lu(k,555) * b(k,123) + b(k,178) = b(k,178) - lu(k,556) * b(k,123) + b(k,181) = b(k,181) - lu(k,557) * b(k,123) + b(k,189) = b(k,189) - lu(k,558) * b(k,123) + b(k,126) = b(k,126) - lu(k,564) * b(k,124) + b(k,128) = b(k,128) - lu(k,565) * b(k,124) + b(k,129) = b(k,129) - lu(k,566) * b(k,124) + b(k,142) = b(k,142) - lu(k,567) * b(k,124) + b(k,143) = b(k,143) - lu(k,568) * b(k,124) + b(k,155) = b(k,155) - lu(k,569) * b(k,124) + b(k,166) = b(k,166) - lu(k,570) * b(k,124) + b(k,173) = b(k,173) - lu(k,571) * b(k,124) + b(k,178) = b(k,178) - lu(k,572) * b(k,124) + b(k,181) = b(k,181) - lu(k,573) * b(k,124) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,151) = b(k,151) - lu(k,577) * b(k,125) + b(k,178) = b(k,178) - lu(k,578) * b(k,125) + b(k,181) = b(k,181) - lu(k,579) * b(k,125) + b(k,185) = b(k,185) - lu(k,580) * b(k,125) + b(k,189) = b(k,189) - lu(k,581) * b(k,125) + b(k,190) = b(k,190) - lu(k,582) * b(k,125) + b(k,142) = b(k,142) - lu(k,584) * b(k,126) + b(k,155) = b(k,155) - lu(k,585) * b(k,126) + b(k,178) = b(k,178) - lu(k,586) * b(k,126) + b(k,185) = b(k,185) - lu(k,587) * b(k,126) + b(k,190) = b(k,190) - lu(k,588) * b(k,126) + b(k,129) = b(k,129) - lu(k,595) * b(k,127) + b(k,142) = b(k,142) - lu(k,596) * b(k,127) + b(k,143) = b(k,143) - lu(k,597) * b(k,127) + b(k,155) = b(k,155) - lu(k,598) * b(k,127) + b(k,166) = b(k,166) - lu(k,599) * b(k,127) + b(k,178) = b(k,178) - lu(k,600) * b(k,127) + b(k,181) = b(k,181) - lu(k,601) * b(k,127) + b(k,185) = b(k,185) - lu(k,602) * b(k,127) + b(k,190) = b(k,190) - lu(k,603) * b(k,127) + b(k,129) = b(k,129) - lu(k,611) * b(k,128) + b(k,142) = b(k,142) - lu(k,612) * b(k,128) + b(k,143) = b(k,143) - lu(k,613) * b(k,128) + b(k,155) = b(k,155) - lu(k,614) * b(k,128) + b(k,166) = b(k,166) - lu(k,615) * b(k,128) + b(k,173) = b(k,173) - lu(k,616) * b(k,128) + b(k,178) = b(k,178) - lu(k,617) * b(k,128) + b(k,181) = b(k,181) - lu(k,618) * b(k,128) + b(k,185) = b(k,185) - lu(k,619) * b(k,128) + b(k,190) = b(k,190) - lu(k,620) * b(k,128) + b(k,155) = b(k,155) - lu(k,622) * b(k,129) + b(k,166) = b(k,166) - lu(k,623) * b(k,129) + b(k,178) = b(k,178) - lu(k,624) * b(k,129) + b(k,181) = b(k,181) - lu(k,625) * b(k,129) + b(k,182) = b(k,182) - lu(k,626) * b(k,129) + b(k,185) = b(k,185) - lu(k,627) * b(k,129) + b(k,190) = b(k,190) - lu(k,628) * b(k,129) + b(k,156) = b(k,156) - lu(k,631) * b(k,130) + b(k,161) = b(k,161) - lu(k,632) * b(k,130) + b(k,178) = b(k,178) - lu(k,633) * b(k,130) + b(k,181) = b(k,181) - lu(k,634) * b(k,130) + b(k,185) = b(k,185) - lu(k,635) * b(k,130) + b(k,189) = b(k,189) - lu(k,636) * b(k,130) + b(k,190) = b(k,190) - lu(k,637) * b(k,130) + b(k,191) = b(k,191) - lu(k,638) * b(k,130) + b(k,174) = b(k,174) - lu(k,641) * b(k,131) + b(k,177) = b(k,177) - lu(k,642) * b(k,131) + b(k,181) = b(k,181) - lu(k,643) * b(k,131) + b(k,184) = b(k,184) - lu(k,644) * b(k,131) + b(k,187) = b(k,187) - lu(k,645) * b(k,131) + b(k,188) = b(k,188) - lu(k,646) * b(k,131) + b(k,191) = b(k,191) - lu(k,647) * b(k,131) + b(k,162) = b(k,162) - lu(k,650) * b(k,132) + b(k,175) = b(k,175) - lu(k,651) * b(k,132) + b(k,176) = b(k,176) - lu(k,652) * b(k,132) + b(k,179) = b(k,179) - lu(k,653) * b(k,132) + b(k,181) = b(k,181) - lu(k,654) * b(k,132) + b(k,182) = b(k,182) - lu(k,655) * b(k,132) + b(k,191) = b(k,191) - lu(k,656) * b(k,132) + b(k,178) = b(k,178) - lu(k,658) * b(k,133) + b(k,181) = b(k,181) - lu(k,659) * b(k,133) + b(k,191) = b(k,191) - lu(k,660) * b(k,133) + b(k,178) = b(k,178) - lu(k,662) * b(k,134) + b(k,181) = b(k,181) - lu(k,663) * b(k,134) + b(k,189) = b(k,189) - lu(k,664) * b(k,134) + b(k,147) = b(k,147) - lu(k,667) * b(k,135) + b(k,161) = b(k,161) - lu(k,668) * b(k,135) + b(k,178) = b(k,178) - lu(k,669) * b(k,135) + b(k,181) = b(k,181) - lu(k,670) * b(k,135) + b(k,182) = b(k,182) - lu(k,671) * b(k,135) + b(k,185) = b(k,185) - lu(k,672) * b(k,135) + b(k,189) = b(k,189) - lu(k,673) * b(k,135) + b(k,190) = b(k,190) - lu(k,674) * b(k,135) + b(k,191) = b(k,191) - lu(k,675) * b(k,135) + b(k,177) = b(k,177) - lu(k,678) * b(k,136) + b(k,181) = b(k,181) - lu(k,679) * b(k,136) + b(k,183) = b(k,183) - lu(k,680) * b(k,136) + b(k,184) = b(k,184) - lu(k,681) * b(k,136) + b(k,188) = b(k,188) - lu(k,682) * b(k,136) + b(k,191) = b(k,191) - lu(k,683) * b(k,136) + b(k,161) = b(k,161) - lu(k,688) * b(k,137) + b(k,178) = b(k,178) - lu(k,689) * b(k,137) + b(k,181) = b(k,181) - lu(k,690) * b(k,137) + b(k,182) = b(k,182) - lu(k,691) * b(k,137) + b(k,185) = b(k,185) - lu(k,692) * b(k,137) + b(k,189) = b(k,189) - lu(k,693) * b(k,137) + b(k,190) = b(k,190) - lu(k,694) * b(k,137) + b(k,174) = b(k,174) - lu(k,696) * b(k,138) + b(k,176) = b(k,176) - lu(k,697) * b(k,138) + b(k,180) = b(k,180) - lu(k,698) * b(k,138) + b(k,181) = b(k,181) - lu(k,699) * b(k,138) + b(k,187) = b(k,187) - lu(k,700) * b(k,138) + b(k,188) = b(k,188) - lu(k,701) * b(k,138) + b(k,191) = b(k,191) - lu(k,702) * b(k,138) + b(k,149) = b(k,149) - lu(k,710) * b(k,139) + b(k,155) = b(k,155) - lu(k,711) * b(k,139) + b(k,164) = b(k,164) - lu(k,712) * b(k,139) + b(k,165) = b(k,165) - lu(k,713) * b(k,139) + b(k,168) = b(k,168) - lu(k,714) * b(k,139) + b(k,169) = b(k,169) - lu(k,715) * b(k,139) + b(k,171) = b(k,171) - lu(k,716) * b(k,139) + b(k,173) = b(k,173) - lu(k,717) * b(k,139) + b(k,178) = b(k,178) - lu(k,718) * b(k,139) + b(k,179) = b(k,179) - lu(k,719) * b(k,139) + b(k,181) = b(k,181) - lu(k,720) * b(k,139) + b(k,182) = b(k,182) - lu(k,721) * b(k,139) + b(k,186) = b(k,186) - lu(k,722) * b(k,139) + b(k,189) = b(k,189) - lu(k,723) * b(k,139) + b(k,191) = b(k,191) - lu(k,724) * b(k,139) + b(k,167) = b(k,167) - lu(k,727) * b(k,140) + b(k,178) = b(k,178) - lu(k,728) * b(k,140) + b(k,181) = b(k,181) - lu(k,729) * b(k,140) + b(k,188) = b(k,188) - lu(k,730) * b(k,140) + b(k,191) = b(k,191) - lu(k,731) * b(k,140) + b(k,166) = b(k,166) - lu(k,733) * b(k,141) + b(k,173) = b(k,173) - lu(k,734) * b(k,141) + b(k,181) = b(k,181) - lu(k,735) * b(k,141) + b(k,185) = b(k,185) - lu(k,736) * b(k,141) + b(k,189) = b(k,189) - lu(k,737) * b(k,141) + b(k,155) = b(k,155) - lu(k,740) * b(k,142) + b(k,178) = b(k,178) - lu(k,741) * b(k,142) + b(k,181) = b(k,181) - lu(k,742) * b(k,142) + b(k,155) = b(k,155) - lu(k,745) * b(k,143) + b(k,166) = b(k,166) - lu(k,746) * b(k,143) + b(k,178) = b(k,178) - lu(k,747) * b(k,143) + b(k,181) = b(k,181) - lu(k,748) * b(k,143) + b(k,182) = b(k,182) - lu(k,749) * b(k,143) + b(k,185) = b(k,185) - lu(k,750) * b(k,143) + b(k,190) = b(k,190) - lu(k,751) * b(k,143) + b(k,146) = b(k,146) - lu(k,762) * b(k,144) + b(k,147) = b(k,147) - lu(k,763) * b(k,144) + b(k,150) = b(k,150) - lu(k,764) * b(k,144) + b(k,153) = b(k,153) - lu(k,765) * b(k,144) + b(k,155) = b(k,155) - lu(k,766) * b(k,144) + b(k,157) = b(k,157) - lu(k,767) * b(k,144) + b(k,159) = b(k,159) - lu(k,768) * b(k,144) + b(k,160) = b(k,160) - lu(k,769) * b(k,144) + b(k,166) = b(k,166) - lu(k,770) * b(k,144) + b(k,173) = b(k,173) - lu(k,771) * b(k,144) + b(k,178) = b(k,178) - lu(k,772) * b(k,144) + b(k,179) = b(k,179) - lu(k,773) * b(k,144) + b(k,181) = b(k,181) - lu(k,774) * b(k,144) + b(k,186) = b(k,186) - lu(k,775) * b(k,144) + b(k,189) = b(k,189) - lu(k,776) * b(k,144) + b(k,191) = b(k,191) - lu(k,777) * b(k,144) + b(k,146) = b(k,146) - lu(k,788) * b(k,145) + b(k,147) = b(k,147) - lu(k,789) * b(k,145) + b(k,150) = b(k,150) - lu(k,790) * b(k,145) + b(k,153) = b(k,153) - lu(k,791) * b(k,145) + b(k,155) = b(k,155) - lu(k,792) * b(k,145) + b(k,157) = b(k,157) - lu(k,793) * b(k,145) + b(k,159) = b(k,159) - lu(k,794) * b(k,145) + b(k,160) = b(k,160) - lu(k,795) * b(k,145) + b(k,166) = b(k,166) - lu(k,796) * b(k,145) + b(k,173) = b(k,173) - lu(k,797) * b(k,145) + b(k,178) = b(k,178) - lu(k,798) * b(k,145) + b(k,179) = b(k,179) - lu(k,799) * b(k,145) + b(k,181) = b(k,181) - lu(k,800) * b(k,145) + b(k,186) = b(k,186) - lu(k,801) * b(k,145) + b(k,189) = b(k,189) - lu(k,802) * b(k,145) + b(k,191) = b(k,191) - lu(k,803) * b(k,145) + b(k,147) = b(k,147) - lu(k,810) * b(k,146) + b(k,161) = b(k,161) - lu(k,811) * b(k,146) + b(k,173) = b(k,173) - lu(k,812) * b(k,146) + b(k,178) = b(k,178) - lu(k,813) * b(k,146) + b(k,181) = b(k,181) - lu(k,814) * b(k,146) + b(k,182) = b(k,182) - lu(k,815) * b(k,146) + b(k,185) = b(k,185) - lu(k,816) * b(k,146) + b(k,189) = b(k,189) - lu(k,817) * b(k,146) + b(k,190) = b(k,190) - lu(k,818) * b(k,146) + b(k,160) = b(k,160) - lu(k,820) * b(k,147) + b(k,173) = b(k,173) - lu(k,821) * b(k,147) + b(k,181) = b(k,181) - lu(k,822) * b(k,147) + b(k,182) = b(k,182) - lu(k,823) * b(k,147) + b(k,191) = b(k,191) - lu(k,824) * b(k,147) + b(k,175) = b(k,175) - lu(k,828) * b(k,148) + b(k,177) = b(k,177) - lu(k,829) * b(k,148) + b(k,179) = b(k,179) - lu(k,830) * b(k,148) + b(k,181) = b(k,181) - lu(k,831) * b(k,148) + b(k,183) = b(k,183) - lu(k,832) * b(k,148) + b(k,184) = b(k,184) - lu(k,833) * b(k,148) + b(k,185) = b(k,185) - lu(k,834) * b(k,148) + b(k,188) = b(k,188) - lu(k,835) * b(k,148) + b(k,191) = b(k,191) - lu(k,836) * b(k,148) + b(k,155) = b(k,155) - lu(k,842) * b(k,149) + b(k,156) = b(k,156) - lu(k,843) * b(k,149) + b(k,161) = b(k,161) - lu(k,844) * b(k,149) + b(k,166) = b(k,166) - lu(k,845) * b(k,149) + b(k,173) = b(k,173) - lu(k,846) * b(k,149) + b(k,178) = b(k,178) - lu(k,847) * b(k,149) + b(k,179) = b(k,179) - lu(k,848) * b(k,149) + b(k,181) = b(k,181) - lu(k,849) * b(k,149) + b(k,182) = b(k,182) - lu(k,850) * b(k,149) + b(k,185) = b(k,185) - lu(k,851) * b(k,149) + b(k,186) = b(k,186) - lu(k,852) * b(k,149) + b(k,189) = b(k,189) - lu(k,853) * b(k,149) + b(k,190) = b(k,190) - lu(k,854) * b(k,149) + b(k,191) = b(k,191) - lu(k,855) * b(k,149) + b(k,153) = b(k,153) - lu(k,857) * b(k,150) + b(k,155) = b(k,155) - lu(k,858) * b(k,150) + b(k,158) = b(k,158) - lu(k,859) * b(k,150) + b(k,159) = b(k,159) - lu(k,860) * b(k,150) + b(k,178) = b(k,178) - lu(k,861) * b(k,150) + b(k,179) = b(k,179) - lu(k,862) * b(k,150) + b(k,181) = b(k,181) - lu(k,863) * b(k,150) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,155) = b(k,155) - lu(k,866) * b(k,151) + b(k,178) = b(k,178) - lu(k,867) * b(k,151) + b(k,181) = b(k,181) - lu(k,868) * b(k,151) + b(k,189) = b(k,189) - lu(k,869) * b(k,151) + b(k,155) = b(k,155) - lu(k,875) * b(k,152) + b(k,166) = b(k,166) - lu(k,876) * b(k,152) + b(k,173) = b(k,173) - lu(k,877) * b(k,152) + b(k,175) = b(k,175) - lu(k,878) * b(k,152) + b(k,178) = b(k,178) - lu(k,879) * b(k,152) + b(k,181) = b(k,181) - lu(k,880) * b(k,152) + b(k,182) = b(k,182) - lu(k,881) * b(k,152) + b(k,185) = b(k,185) - lu(k,882) * b(k,152) + b(k,189) = b(k,189) - lu(k,883) * b(k,152) + b(k,190) = b(k,190) - lu(k,884) * b(k,152) + b(k,155) = b(k,155) - lu(k,887) * b(k,153) + b(k,160) = b(k,160) - lu(k,888) * b(k,153) + b(k,173) = b(k,173) - lu(k,889) * b(k,153) + b(k,178) = b(k,178) - lu(k,890) * b(k,153) + b(k,181) = b(k,181) - lu(k,891) * b(k,153) + b(k,182) = b(k,182) - lu(k,892) * b(k,153) + b(k,189) = b(k,189) - lu(k,893) * b(k,153) + b(k,191) = b(k,191) - lu(k,894) * b(k,153) + b(k,155) = b(k,155) - lu(k,899) * b(k,154) + b(k,156) = b(k,156) - lu(k,900) * b(k,154) + b(k,160) = b(k,160) - lu(k,901) * b(k,154) + b(k,161) = b(k,161) - lu(k,902) * b(k,154) + b(k,173) = b(k,173) - lu(k,903) * b(k,154) + b(k,175) = b(k,175) - lu(k,904) * b(k,154) + b(k,178) = b(k,178) - lu(k,905) * b(k,154) + b(k,181) = b(k,181) - lu(k,906) * b(k,154) + b(k,182) = b(k,182) - lu(k,907) * b(k,154) + b(k,185) = b(k,185) - lu(k,908) * b(k,154) + b(k,189) = b(k,189) - lu(k,909) * b(k,154) + b(k,191) = b(k,191) - lu(k,910) * b(k,154) + b(k,176) = b(k,176) - lu(k,912) * b(k,155) + b(k,178) = b(k,178) - lu(k,913) * b(k,155) + b(k,181) = b(k,181) - lu(k,914) * b(k,155) + b(k,166) = b(k,166) - lu(k,916) * b(k,156) + b(k,173) = b(k,173) - lu(k,917) * b(k,156) + b(k,178) = b(k,178) - lu(k,918) * b(k,156) + b(k,181) = b(k,181) - lu(k,919) * b(k,156) + b(k,189) = b(k,189) - lu(k,920) * b(k,156) + b(k,158) = b(k,158) - lu(k,929) * b(k,157) + b(k,159) = b(k,159) - lu(k,930) * b(k,157) + b(k,160) = b(k,160) - lu(k,931) * b(k,157) + b(k,173) = b(k,173) - lu(k,932) * b(k,157) + b(k,175) = b(k,175) - lu(k,933) * b(k,157) + b(k,176) = b(k,176) - lu(k,934) * b(k,157) + b(k,178) = b(k,178) - lu(k,935) * b(k,157) + b(k,179) = b(k,179) - lu(k,936) * b(k,157) + b(k,181) = b(k,181) - lu(k,937) * b(k,157) + b(k,182) = b(k,182) - lu(k,938) * b(k,157) + b(k,185) = b(k,185) - lu(k,939) * b(k,157) + b(k,189) = b(k,189) - lu(k,940) * b(k,157) + b(k,190) = b(k,190) - lu(k,941) * b(k,157) + b(k,191) = b(k,191) - lu(k,942) * b(k,157) + b(k,160) = b(k,160) - lu(k,951) * b(k,158) + b(k,173) = b(k,173) - lu(k,952) * b(k,158) + b(k,175) = b(k,175) - lu(k,953) * b(k,158) + b(k,176) = b(k,176) - lu(k,954) * b(k,158) + b(k,178) = b(k,178) - lu(k,955) * b(k,158) + b(k,181) = b(k,181) - lu(k,956) * b(k,158) + b(k,182) = b(k,182) - lu(k,957) * b(k,158) + b(k,185) = b(k,185) - lu(k,958) * b(k,158) + b(k,189) = b(k,189) - lu(k,959) * b(k,158) + b(k,190) = b(k,190) - lu(k,960) * b(k,158) + b(k,191) = b(k,191) - lu(k,961) * b(k,158) + b(k,160) = b(k,160) - lu(k,970) * b(k,159) + b(k,173) = b(k,173) - lu(k,971) * b(k,159) + b(k,175) = b(k,175) - lu(k,972) * b(k,159) + b(k,176) = b(k,176) - lu(k,973) * b(k,159) + b(k,178) = b(k,178) - lu(k,974) * b(k,159) + b(k,179) = b(k,179) - lu(k,975) * b(k,159) + b(k,181) = b(k,181) - lu(k,976) * b(k,159) + b(k,182) = b(k,182) - lu(k,977) * b(k,159) + b(k,185) = b(k,185) - lu(k,978) * b(k,159) + b(k,189) = b(k,189) - lu(k,979) * b(k,159) + b(k,190) = b(k,190) - lu(k,980) * b(k,159) + b(k,191) = b(k,191) - lu(k,981) * b(k,159) + b(k,166) = b(k,166) - lu(k,986) * b(k,160) + b(k,173) = b(k,173) - lu(k,987) * b(k,160) + b(k,178) = b(k,178) - lu(k,988) * b(k,160) + b(k,181) = b(k,181) - lu(k,989) * b(k,160) + b(k,182) = b(k,182) - lu(k,990) * b(k,160) + b(k,185) = b(k,185) - lu(k,991) * b(k,160) + b(k,189) = b(k,189) - lu(k,992) * b(k,160) + b(k,190) = b(k,190) - lu(k,993) * b(k,160) + b(k,191) = b(k,191) - lu(k,994) * b(k,160) + b(k,173) = b(k,173) - lu(k,997) * b(k,161) + b(k,175) = b(k,175) - lu(k,998) * b(k,161) + b(k,176) = b(k,176) - lu(k,999) * b(k,161) + b(k,178) = b(k,178) - lu(k,1000) * b(k,161) + b(k,179) = b(k,179) - lu(k,1001) * b(k,161) + b(k,181) = b(k,181) - lu(k,1002) * b(k,161) + b(k,182) = b(k,182) - lu(k,1003) * b(k,161) + b(k,191) = b(k,191) - lu(k,1004) * b(k,161) + b(k,175) = b(k,175) - lu(k,1008) * b(k,162) + b(k,176) = b(k,176) - lu(k,1009) * b(k,162) + b(k,177) = b(k,177) - lu(k,1010) * b(k,162) + b(k,179) = b(k,179) - lu(k,1011) * b(k,162) + b(k,180) = b(k,180) - lu(k,1012) * b(k,162) + b(k,181) = b(k,181) - lu(k,1013) * b(k,162) + b(k,182) = b(k,182) - lu(k,1014) * b(k,162) + b(k,184) = b(k,184) - lu(k,1015) * b(k,162) + b(k,188) = b(k,188) - lu(k,1016) * b(k,162) + b(k,191) = b(k,191) - lu(k,1017) * b(k,162) + b(k,166) = b(k,166) - lu(k,1025) * b(k,163) + b(k,173) = b(k,173) - lu(k,1026) * b(k,163) + b(k,176) = b(k,176) - lu(k,1027) * b(k,163) + b(k,178) = b(k,178) - lu(k,1028) * b(k,163) + b(k,179) = b(k,179) - lu(k,1029) * b(k,163) + b(k,181) = b(k,181) - lu(k,1030) * b(k,163) + b(k,182) = b(k,182) - lu(k,1031) * b(k,163) + b(k,185) = b(k,185) - lu(k,1032) * b(k,163) + b(k,189) = b(k,189) - lu(k,1033) * b(k,163) + b(k,190) = b(k,190) - lu(k,1034) * b(k,163) + b(k,165) = b(k,165) - lu(k,1045) * b(k,164) + b(k,166) = b(k,166) - lu(k,1046) * b(k,164) + b(k,169) = b(k,169) - lu(k,1047) * b(k,164) + b(k,173) = b(k,173) - lu(k,1048) * b(k,164) + b(k,175) = b(k,175) - lu(k,1049) * b(k,164) + b(k,176) = b(k,176) - lu(k,1050) * b(k,164) + b(k,178) = b(k,178) - lu(k,1051) * b(k,164) + b(k,179) = b(k,179) - lu(k,1052) * b(k,164) + b(k,181) = b(k,181) - lu(k,1053) * b(k,164) + b(k,182) = b(k,182) - lu(k,1054) * b(k,164) + b(k,185) = b(k,185) - lu(k,1055) * b(k,164) + b(k,189) = b(k,189) - lu(k,1056) * b(k,164) + b(k,190) = b(k,190) - lu(k,1057) * b(k,164) + b(k,166) = b(k,166) - lu(k,1061) * b(k,165) + b(k,170) = b(k,170) - lu(k,1062) * b(k,165) + b(k,172) = b(k,172) - lu(k,1063) * b(k,165) + b(k,173) = b(k,173) - lu(k,1064) * b(k,165) + b(k,176) = b(k,176) - lu(k,1065) * b(k,165) + b(k,178) = b(k,178) - lu(k,1066) * b(k,165) + b(k,181) = b(k,181) - lu(k,1067) * b(k,165) + b(k,186) = b(k,186) - lu(k,1068) * b(k,165) + b(k,189) = b(k,189) - lu(k,1069) * b(k,165) + b(k,191) = b(k,191) - lu(k,1070) * b(k,165) + b(k,173) = b(k,173) - lu(k,1073) * b(k,166) + b(k,175) = b(k,175) - lu(k,1074) * b(k,166) + b(k,176) = b(k,176) - lu(k,1075) * b(k,166) + b(k,178) = b(k,178) - lu(k,1076) * b(k,166) + b(k,179) = b(k,179) - lu(k,1077) * b(k,166) + b(k,181) = b(k,181) - lu(k,1078) * b(k,166) + b(k,191) = b(k,191) - lu(k,1079) * b(k,166) + b(k,174) = b(k,174) - lu(k,1084) * b(k,167) + b(k,176) = b(k,176) - lu(k,1085) * b(k,167) + b(k,178) = b(k,178) - lu(k,1086) * b(k,167) + b(k,181) = b(k,181) - lu(k,1087) * b(k,167) + b(k,183) = b(k,183) - lu(k,1088) * b(k,167) + b(k,184) = b(k,184) - lu(k,1089) * b(k,167) + b(k,185) = b(k,185) - lu(k,1090) * b(k,167) + b(k,186) = b(k,186) - lu(k,1091) * b(k,167) + b(k,187) = b(k,187) - lu(k,1092) * b(k,167) + b(k,188) = b(k,188) - lu(k,1093) * b(k,167) + b(k,190) = b(k,190) - lu(k,1094) * b(k,167) + b(k,191) = b(k,191) - lu(k,1095) * b(k,167) + b(k,169) = b(k,169) - lu(k,1109) * b(k,168) + b(k,170) = b(k,170) - lu(k,1110) * b(k,168) + b(k,172) = b(k,172) - lu(k,1111) * b(k,168) + b(k,173) = b(k,173) - lu(k,1112) * b(k,168) + b(k,175) = b(k,175) - lu(k,1113) * b(k,168) + b(k,176) = b(k,176) - lu(k,1114) * b(k,168) + b(k,178) = b(k,178) - lu(k,1115) * b(k,168) + b(k,179) = b(k,179) - lu(k,1116) * b(k,168) + b(k,181) = b(k,181) - lu(k,1117) * b(k,168) + b(k,182) = b(k,182) - lu(k,1118) * b(k,168) + b(k,185) = b(k,185) - lu(k,1119) * b(k,168) + b(k,186) = b(k,186) - lu(k,1120) * b(k,168) + b(k,189) = b(k,189) - lu(k,1121) * b(k,168) + b(k,190) = b(k,190) - lu(k,1122) * b(k,168) + b(k,191) = b(k,191) - lu(k,1123) * b(k,168) + b(k,170) = b(k,170) - lu(k,1131) * b(k,169) + b(k,173) = b(k,173) - lu(k,1132) * b(k,169) + b(k,175) = b(k,175) - lu(k,1133) * b(k,169) + b(k,176) = b(k,176) - lu(k,1134) * b(k,169) + b(k,178) = b(k,178) - lu(k,1135) * b(k,169) + b(k,179) = b(k,179) - lu(k,1136) * b(k,169) + b(k,181) = b(k,181) - lu(k,1137) * b(k,169) + b(k,182) = b(k,182) - lu(k,1138) * b(k,169) + b(k,185) = b(k,185) - lu(k,1139) * b(k,169) + b(k,186) = b(k,186) - lu(k,1140) * b(k,169) + b(k,189) = b(k,189) - lu(k,1141) * b(k,169) + b(k,190) = b(k,190) - lu(k,1142) * b(k,169) + b(k,191) = b(k,191) - lu(k,1143) * b(k,169) + b(k,172) = b(k,172) - lu(k,1154) * b(k,170) + b(k,173) = b(k,173) - lu(k,1155) * b(k,170) + b(k,175) = b(k,175) - lu(k,1156) * b(k,170) + b(k,176) = b(k,176) - lu(k,1157) * b(k,170) + b(k,178) = b(k,178) - lu(k,1158) * b(k,170) + b(k,179) = b(k,179) - lu(k,1159) * b(k,170) + b(k,181) = b(k,181) - lu(k,1160) * b(k,170) + b(k,182) = b(k,182) - lu(k,1161) * b(k,170) + b(k,185) = b(k,185) - lu(k,1162) * b(k,170) + b(k,189) = b(k,189) - lu(k,1163) * b(k,170) + b(k,190) = b(k,190) - lu(k,1164) * b(k,170) + b(k,191) = b(k,191) - lu(k,1165) * b(k,170) + b(k,172) = b(k,172) - lu(k,1187) * b(k,171) + b(k,173) = b(k,173) - lu(k,1188) * b(k,171) + b(k,175) = b(k,175) - lu(k,1189) * b(k,171) + b(k,176) = b(k,176) - lu(k,1190) * b(k,171) + b(k,178) = b(k,178) - lu(k,1191) * b(k,171) + b(k,179) = b(k,179) - lu(k,1192) * b(k,171) + b(k,181) = b(k,181) - lu(k,1193) * b(k,171) + b(k,182) = b(k,182) - lu(k,1194) * b(k,171) + b(k,185) = b(k,185) - lu(k,1195) * b(k,171) + b(k,186) = b(k,186) - lu(k,1196) * b(k,171) + b(k,189) = b(k,189) - lu(k,1197) * b(k,171) + b(k,190) = b(k,190) - lu(k,1198) * b(k,171) + b(k,191) = b(k,191) - lu(k,1199) * b(k,171) + end do + end subroutine lu_slv04 + subroutine lu_slv05( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,173) = b(k,173) - lu(k,1206) * b(k,172) + b(k,175) = b(k,175) - lu(k,1207) * b(k,172) + b(k,176) = b(k,176) - lu(k,1208) * b(k,172) + b(k,178) = b(k,178) - lu(k,1209) * b(k,172) + b(k,179) = b(k,179) - lu(k,1210) * b(k,172) + b(k,181) = b(k,181) - lu(k,1211) * b(k,172) + b(k,182) = b(k,182) - lu(k,1212) * b(k,172) + b(k,185) = b(k,185) - lu(k,1213) * b(k,172) + b(k,186) = b(k,186) - lu(k,1214) * b(k,172) + b(k,189) = b(k,189) - lu(k,1215) * b(k,172) + b(k,190) = b(k,190) - lu(k,1216) * b(k,172) + b(k,191) = b(k,191) - lu(k,1217) * b(k,172) + b(k,175) = b(k,175) - lu(k,1237) * b(k,173) + b(k,176) = b(k,176) - lu(k,1238) * b(k,173) + b(k,178) = b(k,178) - lu(k,1239) * b(k,173) + b(k,179) = b(k,179) - lu(k,1240) * b(k,173) + b(k,181) = b(k,181) - lu(k,1241) * b(k,173) + b(k,182) = b(k,182) - lu(k,1242) * b(k,173) + b(k,185) = b(k,185) - lu(k,1243) * b(k,173) + b(k,186) = b(k,186) - lu(k,1244) * b(k,173) + b(k,189) = b(k,189) - lu(k,1245) * b(k,173) + b(k,190) = b(k,190) - lu(k,1246) * b(k,173) + b(k,191) = b(k,191) - lu(k,1247) * b(k,173) + b(k,176) = b(k,176) - lu(k,1251) * b(k,174) + b(k,178) = b(k,178) - lu(k,1252) * b(k,174) + b(k,180) = b(k,180) - lu(k,1253) * b(k,174) + b(k,181) = b(k,181) - lu(k,1254) * b(k,174) + b(k,186) = b(k,186) - lu(k,1255) * b(k,174) + b(k,187) = b(k,187) - lu(k,1256) * b(k,174) + b(k,188) = b(k,188) - lu(k,1257) * b(k,174) + b(k,189) = b(k,189) - lu(k,1258) * b(k,174) + b(k,191) = b(k,191) - lu(k,1259) * b(k,174) + b(k,176) = b(k,176) - lu(k,1264) * b(k,175) + b(k,177) = b(k,177) - lu(k,1265) * b(k,175) + b(k,179) = b(k,179) - lu(k,1266) * b(k,175) + b(k,180) = b(k,180) - lu(k,1267) * b(k,175) + b(k,181) = b(k,181) - lu(k,1268) * b(k,175) + b(k,182) = b(k,182) - lu(k,1269) * b(k,175) + b(k,184) = b(k,184) - lu(k,1270) * b(k,175) + b(k,185) = b(k,185) - lu(k,1271) * b(k,175) + b(k,188) = b(k,188) - lu(k,1272) * b(k,175) + b(k,191) = b(k,191) - lu(k,1273) * b(k,175) + b(k,177) = b(k,177) - lu(k,1277) * b(k,176) + b(k,178) = b(k,178) - lu(k,1278) * b(k,176) + b(k,179) = b(k,179) - lu(k,1279) * b(k,176) + b(k,180) = b(k,180) - lu(k,1280) * b(k,176) + b(k,181) = b(k,181) - lu(k,1281) * b(k,176) + b(k,182) = b(k,182) - lu(k,1282) * b(k,176) + b(k,184) = b(k,184) - lu(k,1283) * b(k,176) + b(k,185) = b(k,185) - lu(k,1284) * b(k,176) + b(k,186) = b(k,186) - lu(k,1285) * b(k,176) + b(k,188) = b(k,188) - lu(k,1286) * b(k,176) + b(k,191) = b(k,191) - lu(k,1287) * b(k,176) + b(k,178) = b(k,178) - lu(k,1297) * b(k,177) + b(k,179) = b(k,179) - lu(k,1298) * b(k,177) + b(k,180) = b(k,180) - lu(k,1299) * b(k,177) + b(k,181) = b(k,181) - lu(k,1300) * b(k,177) + b(k,182) = b(k,182) - lu(k,1301) * b(k,177) + b(k,183) = b(k,183) - lu(k,1302) * b(k,177) + b(k,184) = b(k,184) - lu(k,1303) * b(k,177) + b(k,185) = b(k,185) - lu(k,1304) * b(k,177) + b(k,186) = b(k,186) - lu(k,1305) * b(k,177) + b(k,187) = b(k,187) - lu(k,1306) * b(k,177) + b(k,188) = b(k,188) - lu(k,1307) * b(k,177) + b(k,189) = b(k,189) - lu(k,1308) * b(k,177) + b(k,191) = b(k,191) - lu(k,1309) * b(k,177) + b(k,179) = b(k,179) - lu(k,1391) * b(k,178) + b(k,180) = b(k,180) - lu(k,1392) * b(k,178) + b(k,181) = b(k,181) - lu(k,1393) * b(k,178) + b(k,182) = b(k,182) - lu(k,1394) * b(k,178) + b(k,183) = b(k,183) - lu(k,1395) * b(k,178) + b(k,184) = b(k,184) - lu(k,1396) * b(k,178) + b(k,185) = b(k,185) - lu(k,1397) * b(k,178) + b(k,186) = b(k,186) - lu(k,1398) * b(k,178) + b(k,187) = b(k,187) - lu(k,1399) * b(k,178) + b(k,188) = b(k,188) - lu(k,1400) * b(k,178) + b(k,189) = b(k,189) - lu(k,1401) * b(k,178) + b(k,190) = b(k,190) - lu(k,1402) * b(k,178) + b(k,191) = b(k,191) - lu(k,1403) * b(k,178) + b(k,180) = b(k,180) - lu(k,1449) * b(k,179) + b(k,181) = b(k,181) - lu(k,1450) * b(k,179) + b(k,182) = b(k,182) - lu(k,1451) * b(k,179) + b(k,183) = b(k,183) - lu(k,1452) * b(k,179) + b(k,184) = b(k,184) - lu(k,1453) * b(k,179) + b(k,185) = b(k,185) - lu(k,1454) * b(k,179) + b(k,186) = b(k,186) - lu(k,1455) * b(k,179) + b(k,187) = b(k,187) - lu(k,1456) * b(k,179) + b(k,188) = b(k,188) - lu(k,1457) * b(k,179) + b(k,189) = b(k,189) - lu(k,1458) * b(k,179) + b(k,190) = b(k,190) - lu(k,1459) * b(k,179) + b(k,191) = b(k,191) - lu(k,1460) * b(k,179) + b(k,181) = b(k,181) - lu(k,1474) * b(k,180) + b(k,182) = b(k,182) - lu(k,1475) * b(k,180) + b(k,183) = b(k,183) - lu(k,1476) * b(k,180) + b(k,184) = b(k,184) - lu(k,1477) * b(k,180) + b(k,185) = b(k,185) - lu(k,1478) * b(k,180) + b(k,186) = b(k,186) - lu(k,1479) * b(k,180) + b(k,187) = b(k,187) - lu(k,1480) * b(k,180) + b(k,188) = b(k,188) - lu(k,1481) * b(k,180) + b(k,189) = b(k,189) - lu(k,1482) * b(k,180) + b(k,190) = b(k,190) - lu(k,1483) * b(k,180) + b(k,191) = b(k,191) - lu(k,1484) * b(k,180) + b(k,182) = b(k,182) - lu(k,1622) * b(k,181) + b(k,183) = b(k,183) - lu(k,1623) * b(k,181) + b(k,184) = b(k,184) - lu(k,1624) * b(k,181) + b(k,185) = b(k,185) - lu(k,1625) * b(k,181) + b(k,186) = b(k,186) - lu(k,1626) * b(k,181) + b(k,187) = b(k,187) - lu(k,1627) * b(k,181) + b(k,188) = b(k,188) - lu(k,1628) * b(k,181) + b(k,189) = b(k,189) - lu(k,1629) * b(k,181) + b(k,190) = b(k,190) - lu(k,1630) * b(k,181) + b(k,191) = b(k,191) - lu(k,1631) * b(k,181) + b(k,183) = b(k,183) - lu(k,1673) * b(k,182) + b(k,184) = b(k,184) - lu(k,1674) * b(k,182) + b(k,185) = b(k,185) - lu(k,1675) * b(k,182) + b(k,186) = b(k,186) - lu(k,1676) * b(k,182) + b(k,187) = b(k,187) - lu(k,1677) * b(k,182) + b(k,188) = b(k,188) - lu(k,1678) * b(k,182) + b(k,189) = b(k,189) - lu(k,1679) * b(k,182) + b(k,190) = b(k,190) - lu(k,1680) * b(k,182) + b(k,191) = b(k,191) - lu(k,1681) * b(k,182) + b(k,184) = b(k,184) - lu(k,1700) * b(k,183) + b(k,185) = b(k,185) - lu(k,1701) * b(k,183) + b(k,186) = b(k,186) - lu(k,1702) * b(k,183) + b(k,187) = b(k,187) - lu(k,1703) * b(k,183) + b(k,188) = b(k,188) - lu(k,1704) * b(k,183) + b(k,189) = b(k,189) - lu(k,1705) * b(k,183) + b(k,190) = b(k,190) - lu(k,1706) * b(k,183) + b(k,191) = b(k,191) - lu(k,1707) * b(k,183) + b(k,185) = b(k,185) - lu(k,1735) * b(k,184) + b(k,186) = b(k,186) - lu(k,1736) * b(k,184) + b(k,187) = b(k,187) - lu(k,1737) * b(k,184) + b(k,188) = b(k,188) - lu(k,1738) * b(k,184) + b(k,189) = b(k,189) - lu(k,1739) * b(k,184) + b(k,190) = b(k,190) - lu(k,1740) * b(k,184) + b(k,191) = b(k,191) - lu(k,1741) * b(k,184) + b(k,186) = b(k,186) - lu(k,1777) * b(k,185) + b(k,187) = b(k,187) - lu(k,1778) * b(k,185) + b(k,188) = b(k,188) - lu(k,1779) * b(k,185) + b(k,189) = b(k,189) - lu(k,1780) * b(k,185) + b(k,190) = b(k,190) - lu(k,1781) * b(k,185) + b(k,191) = b(k,191) - lu(k,1782) * b(k,185) + b(k,187) = b(k,187) - lu(k,1838) * b(k,186) + b(k,188) = b(k,188) - lu(k,1839) * b(k,186) + b(k,189) = b(k,189) - lu(k,1840) * b(k,186) + b(k,190) = b(k,190) - lu(k,1841) * b(k,186) + b(k,191) = b(k,191) - lu(k,1842) * b(k,186) + b(k,188) = b(k,188) - lu(k,1863) * b(k,187) + b(k,189) = b(k,189) - lu(k,1864) * b(k,187) + b(k,190) = b(k,190) - lu(k,1865) * b(k,187) + b(k,191) = b(k,191) - lu(k,1866) * b(k,187) + b(k,189) = b(k,189) - lu(k,1894) * b(k,188) + b(k,190) = b(k,190) - lu(k,1895) * b(k,188) + b(k,191) = b(k,191) - lu(k,1896) * b(k,188) + b(k,190) = b(k,190) - lu(k,1918) * b(k,189) + b(k,191) = b(k,191) - lu(k,1919) * b(k,189) + b(k,191) = b(k,191) - lu(k,1997) * b(k,190) + end do + end subroutine lu_slv05 + subroutine lu_slv06( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,191) = b(k,191) * lu(k,2022) + b(k,190) = b(k,190) - lu(k,2021) * b(k,191) + b(k,189) = b(k,189) - lu(k,2020) * b(k,191) + b(k,188) = b(k,188) - lu(k,2019) * b(k,191) + b(k,187) = b(k,187) - lu(k,2018) * b(k,191) + b(k,186) = b(k,186) - lu(k,2017) * b(k,191) + b(k,185) = b(k,185) - lu(k,2016) * b(k,191) + b(k,184) = b(k,184) - lu(k,2015) * b(k,191) + b(k,183) = b(k,183) - lu(k,2014) * b(k,191) + b(k,182) = b(k,182) - lu(k,2013) * b(k,191) + b(k,181) = b(k,181) - lu(k,2012) * b(k,191) + b(k,180) = b(k,180) - lu(k,2011) * b(k,191) + b(k,179) = b(k,179) - lu(k,2010) * b(k,191) + b(k,178) = b(k,178) - lu(k,2009) * b(k,191) + b(k,177) = b(k,177) - lu(k,2008) * b(k,191) + b(k,176) = b(k,176) - lu(k,2007) * b(k,191) + b(k,175) = b(k,175) - lu(k,2006) * b(k,191) + b(k,174) = b(k,174) - lu(k,2005) * b(k,191) + b(k,167) = b(k,167) - lu(k,2004) * b(k,191) + b(k,162) = b(k,162) - lu(k,2003) * b(k,191) + b(k,140) = b(k,140) - lu(k,2002) * b(k,191) + b(k,132) = b(k,132) - lu(k,2001) * b(k,191) + b(k,63) = b(k,63) - lu(k,2000) * b(k,191) + b(k,57) = b(k,57) - lu(k,1999) * b(k,191) + b(k,42) = b(k,42) - lu(k,1998) * b(k,191) + b(k,190) = b(k,190) * lu(k,1996) + b(k,189) = b(k,189) - lu(k,1995) * b(k,190) + b(k,188) = b(k,188) - lu(k,1994) * b(k,190) + b(k,187) = b(k,187) - lu(k,1993) * b(k,190) + b(k,186) = b(k,186) - lu(k,1992) * b(k,190) + b(k,185) = b(k,185) - lu(k,1991) * b(k,190) + b(k,184) = b(k,184) - lu(k,1990) * b(k,190) + b(k,183) = b(k,183) - lu(k,1989) * b(k,190) + b(k,182) = b(k,182) - lu(k,1988) * b(k,190) + b(k,181) = b(k,181) - lu(k,1987) * b(k,190) + b(k,180) = b(k,180) - lu(k,1986) * b(k,190) + b(k,179) = b(k,179) - lu(k,1985) * b(k,190) + b(k,178) = b(k,178) - lu(k,1984) * b(k,190) + b(k,177) = b(k,177) - lu(k,1983) * b(k,190) + b(k,176) = b(k,176) - lu(k,1982) * b(k,190) + b(k,175) = b(k,175) - lu(k,1981) * b(k,190) + b(k,174) = b(k,174) - lu(k,1980) * b(k,190) + b(k,173) = b(k,173) - lu(k,1979) * b(k,190) + b(k,172) = b(k,172) - lu(k,1978) * b(k,190) + b(k,171) = b(k,171) - lu(k,1977) * b(k,190) + b(k,170) = b(k,170) - lu(k,1976) * b(k,190) + b(k,169) = b(k,169) - lu(k,1975) * b(k,190) + b(k,168) = b(k,168) - lu(k,1974) * b(k,190) + b(k,166) = b(k,166) - lu(k,1973) * b(k,190) + b(k,165) = b(k,165) - lu(k,1972) * b(k,190) + b(k,164) = b(k,164) - lu(k,1971) * b(k,190) + b(k,163) = b(k,163) - lu(k,1970) * b(k,190) + b(k,161) = b(k,161) - lu(k,1969) * b(k,190) + b(k,160) = b(k,160) - lu(k,1968) * b(k,190) + b(k,159) = b(k,159) - lu(k,1967) * b(k,190) + b(k,158) = b(k,158) - lu(k,1966) * b(k,190) + b(k,157) = b(k,157) - lu(k,1965) * b(k,190) + b(k,156) = b(k,156) - lu(k,1964) * b(k,190) + b(k,155) = b(k,155) - lu(k,1963) * b(k,190) + b(k,154) = b(k,154) - lu(k,1962) * b(k,190) + b(k,153) = b(k,153) - lu(k,1961) * b(k,190) + b(k,152) = b(k,152) - lu(k,1960) * b(k,190) + b(k,151) = b(k,151) - lu(k,1959) * b(k,190) + b(k,150) = b(k,150) - lu(k,1958) * b(k,190) + b(k,147) = b(k,147) - lu(k,1957) * b(k,190) + b(k,146) = b(k,146) - lu(k,1956) * b(k,190) + b(k,143) = b(k,143) - lu(k,1955) * b(k,190) + b(k,142) = b(k,142) - lu(k,1954) * b(k,190) + b(k,141) = b(k,141) - lu(k,1953) * b(k,190) + b(k,137) = b(k,137) - lu(k,1952) * b(k,190) + b(k,135) = b(k,135) - lu(k,1951) * b(k,190) + b(k,133) = b(k,133) - lu(k,1950) * b(k,190) + b(k,130) = b(k,130) - lu(k,1949) * b(k,190) + b(k,129) = b(k,129) - lu(k,1948) * b(k,190) + b(k,128) = b(k,128) - lu(k,1947) * b(k,190) + b(k,127) = b(k,127) - lu(k,1946) * b(k,190) + b(k,126) = b(k,126) - lu(k,1945) * b(k,190) + b(k,125) = b(k,125) - lu(k,1944) * b(k,190) + b(k,122) = b(k,122) - lu(k,1943) * b(k,190) + b(k,121) = b(k,121) - lu(k,1942) * b(k,190) + b(k,119) = b(k,119) - lu(k,1941) * b(k,190) + b(k,118) = b(k,118) - lu(k,1940) * b(k,190) + b(k,117) = b(k,117) - lu(k,1939) * b(k,190) + b(k,113) = b(k,113) - lu(k,1938) * b(k,190) + b(k,112) = b(k,112) - lu(k,1937) * b(k,190) + b(k,107) = b(k,107) - lu(k,1936) * b(k,190) + b(k,105) = b(k,105) - lu(k,1935) * b(k,190) + b(k,104) = b(k,104) - lu(k,1934) * b(k,190) + b(k,101) = b(k,101) - lu(k,1933) * b(k,190) + b(k,100) = b(k,100) - lu(k,1932) * b(k,190) + b(k,98) = b(k,98) - lu(k,1931) * b(k,190) + b(k,96) = b(k,96) - lu(k,1930) * b(k,190) + b(k,95) = b(k,95) - lu(k,1929) * b(k,190) + b(k,94) = b(k,94) - lu(k,1928) * b(k,190) + b(k,93) = b(k,93) - lu(k,1927) * b(k,190) + b(k,82) = b(k,82) - lu(k,1926) * b(k,190) + b(k,75) = b(k,75) - lu(k,1925) * b(k,190) + b(k,72) = b(k,72) - lu(k,1924) * b(k,190) + b(k,68) = b(k,68) - lu(k,1923) * b(k,190) + b(k,66) = b(k,66) - lu(k,1922) * b(k,190) + b(k,62) = b(k,62) - lu(k,1921) * b(k,190) + b(k,59) = b(k,59) - lu(k,1920) * b(k,190) + b(k,189) = b(k,189) * lu(k,1917) + b(k,188) = b(k,188) - lu(k,1916) * b(k,189) + b(k,187) = b(k,187) - lu(k,1915) * b(k,189) + b(k,186) = b(k,186) - lu(k,1914) * b(k,189) + b(k,185) = b(k,185) - lu(k,1913) * b(k,189) + b(k,184) = b(k,184) - lu(k,1912) * b(k,189) + b(k,183) = b(k,183) - lu(k,1911) * b(k,189) + b(k,182) = b(k,182) - lu(k,1910) * b(k,189) + b(k,181) = b(k,181) - lu(k,1909) * b(k,189) + b(k,180) = b(k,180) - lu(k,1908) * b(k,189) + b(k,179) = b(k,179) - lu(k,1907) * b(k,189) + b(k,178) = b(k,178) - lu(k,1906) * b(k,189) + b(k,177) = b(k,177) - lu(k,1905) * b(k,189) + b(k,176) = b(k,176) - lu(k,1904) * b(k,189) + b(k,175) = b(k,175) - lu(k,1903) * b(k,189) + b(k,174) = b(k,174) - lu(k,1902) * b(k,189) + b(k,162) = b(k,162) - lu(k,1901) * b(k,189) + b(k,155) = b(k,155) - lu(k,1900) * b(k,189) + b(k,138) = b(k,138) - lu(k,1899) * b(k,189) + b(k,133) = b(k,133) - lu(k,1898) * b(k,189) + b(k,94) = b(k,94) - lu(k,1897) * b(k,189) + b(k,188) = b(k,188) * lu(k,1893) + b(k,187) = b(k,187) - lu(k,1892) * b(k,188) + b(k,186) = b(k,186) - lu(k,1891) * b(k,188) + b(k,185) = b(k,185) - lu(k,1890) * b(k,188) + b(k,184) = b(k,184) - lu(k,1889) * b(k,188) + b(k,183) = b(k,183) - lu(k,1888) * b(k,188) + b(k,182) = b(k,182) - lu(k,1887) * b(k,188) + b(k,181) = b(k,181) - lu(k,1886) * b(k,188) + b(k,180) = b(k,180) - lu(k,1885) * b(k,188) + b(k,179) = b(k,179) - lu(k,1884) * b(k,188) + b(k,178) = b(k,178) - lu(k,1883) * b(k,188) + b(k,177) = b(k,177) - lu(k,1882) * b(k,188) + b(k,176) = b(k,176) - lu(k,1881) * b(k,188) + b(k,175) = b(k,175) - lu(k,1880) * b(k,188) + b(k,174) = b(k,174) - lu(k,1879) * b(k,188) + b(k,167) = b(k,167) - lu(k,1878) * b(k,188) + b(k,162) = b(k,162) - lu(k,1877) * b(k,188) + b(k,155) = b(k,155) - lu(k,1876) * b(k,188) + b(k,148) = b(k,148) - lu(k,1875) * b(k,188) + b(k,140) = b(k,140) - lu(k,1874) * b(k,188) + b(k,138) = b(k,138) - lu(k,1873) * b(k,188) + b(k,136) = b(k,136) - lu(k,1872) * b(k,188) + b(k,131) = b(k,131) - lu(k,1871) * b(k,188) + b(k,114) = b(k,114) - lu(k,1870) * b(k,188) + b(k,110) = b(k,110) - lu(k,1869) * b(k,188) + b(k,103) = b(k,103) - lu(k,1868) * b(k,188) + b(k,80) = b(k,80) - lu(k,1867) * b(k,188) + b(k,187) = b(k,187) * lu(k,1862) + b(k,186) = b(k,186) - lu(k,1861) * b(k,187) + b(k,185) = b(k,185) - lu(k,1860) * b(k,187) + b(k,184) = b(k,184) - lu(k,1859) * b(k,187) + b(k,183) = b(k,183) - lu(k,1858) * b(k,187) + b(k,182) = b(k,182) - lu(k,1857) * b(k,187) + b(k,181) = b(k,181) - lu(k,1856) * b(k,187) + b(k,180) = b(k,180) - lu(k,1855) * b(k,187) + b(k,179) = b(k,179) - lu(k,1854) * b(k,187) + b(k,178) = b(k,178) - lu(k,1853) * b(k,187) + b(k,177) = b(k,177) - lu(k,1852) * b(k,187) + b(k,176) = b(k,176) - lu(k,1851) * b(k,187) + b(k,175) = b(k,175) - lu(k,1850) * b(k,187) + b(k,174) = b(k,174) - lu(k,1849) * b(k,187) + b(k,167) = b(k,167) - lu(k,1848) * b(k,187) + b(k,140) = b(k,140) - lu(k,1847) * b(k,187) + b(k,131) = b(k,131) - lu(k,1846) * b(k,187) + b(k,110) = b(k,110) - lu(k,1845) * b(k,187) + b(k,76) = b(k,76) - lu(k,1844) * b(k,187) + b(k,61) = b(k,61) - lu(k,1843) * b(k,187) + b(k,186) = b(k,186) * lu(k,1837) + b(k,185) = b(k,185) - lu(k,1836) * b(k,186) + b(k,184) = b(k,184) - lu(k,1835) * b(k,186) + b(k,183) = b(k,183) - lu(k,1834) * b(k,186) + b(k,182) = b(k,182) - lu(k,1833) * b(k,186) + b(k,181) = b(k,181) - lu(k,1832) * b(k,186) + b(k,180) = b(k,180) - lu(k,1831) * b(k,186) + b(k,179) = b(k,179) - lu(k,1830) * b(k,186) + b(k,178) = b(k,178) - lu(k,1829) * b(k,186) + b(k,177) = b(k,177) - lu(k,1828) * b(k,186) + b(k,176) = b(k,176) - lu(k,1827) * b(k,186) + b(k,175) = b(k,175) - lu(k,1826) * b(k,186) + b(k,174) = b(k,174) - lu(k,1825) * b(k,186) + b(k,173) = b(k,173) - lu(k,1824) * b(k,186) + b(k,172) = b(k,172) - lu(k,1823) * b(k,186) + b(k,171) = b(k,171) - lu(k,1822) * b(k,186) + b(k,170) = b(k,170) - lu(k,1821) * b(k,186) + b(k,169) = b(k,169) - lu(k,1820) * b(k,186) + b(k,168) = b(k,168) - lu(k,1819) * b(k,186) + b(k,167) = b(k,167) - lu(k,1818) * b(k,186) + b(k,166) = b(k,166) - lu(k,1817) * b(k,186) + b(k,165) = b(k,165) - lu(k,1816) * b(k,186) + b(k,164) = b(k,164) - lu(k,1815) * b(k,186) + b(k,161) = b(k,161) - lu(k,1814) * b(k,186) + b(k,160) = b(k,160) - lu(k,1813) * b(k,186) + b(k,159) = b(k,159) - lu(k,1812) * b(k,186) + b(k,158) = b(k,158) - lu(k,1811) * b(k,186) + b(k,157) = b(k,157) - lu(k,1810) * b(k,186) + b(k,156) = b(k,156) - lu(k,1809) * b(k,186) + b(k,155) = b(k,155) - lu(k,1808) * b(k,186) + b(k,153) = b(k,153) - lu(k,1807) * b(k,186) + b(k,151) = b(k,151) - lu(k,1806) * b(k,186) + b(k,150) = b(k,150) - lu(k,1805) * b(k,186) + b(k,149) = b(k,149) - lu(k,1804) * b(k,186) + b(k,147) = b(k,147) - lu(k,1803) * b(k,186) + b(k,146) = b(k,146) - lu(k,1802) * b(k,186) + b(k,145) = b(k,145) - lu(k,1801) * b(k,186) + b(k,144) = b(k,144) - lu(k,1800) * b(k,186) + b(k,142) = b(k,142) - lu(k,1799) * b(k,186) + b(k,140) = b(k,140) - lu(k,1798) * b(k,186) + b(k,139) = b(k,139) - lu(k,1797) * b(k,186) + b(k,133) = b(k,133) - lu(k,1796) * b(k,186) + b(k,125) = b(k,125) - lu(k,1795) * b(k,186) + b(k,119) = b(k,119) - lu(k,1794) * b(k,186) + b(k,111) = b(k,111) - lu(k,1793) * b(k,186) + b(k,108) = b(k,108) - lu(k,1792) * b(k,186) + b(k,103) = b(k,103) - lu(k,1791) * b(k,186) + b(k,98) = b(k,98) - lu(k,1790) * b(k,186) + b(k,86) = b(k,86) - lu(k,1789) * b(k,186) + b(k,60) = b(k,60) - lu(k,1788) * b(k,186) + b(k,33) = b(k,33) - lu(k,1787) * b(k,186) + b(k,32) = b(k,32) - lu(k,1786) * b(k,186) + b(k,31) = b(k,31) - lu(k,1785) * b(k,186) + b(k,30) = b(k,30) - lu(k,1784) * b(k,186) + b(k,29) = b(k,29) - lu(k,1783) * b(k,186) + end do + end subroutine lu_slv06 + subroutine lu_slv07( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,185) = b(k,185) * lu(k,1776) + b(k,184) = b(k,184) - lu(k,1775) * b(k,185) + b(k,183) = b(k,183) - lu(k,1774) * b(k,185) + b(k,182) = b(k,182) - lu(k,1773) * b(k,185) + b(k,181) = b(k,181) - lu(k,1772) * b(k,185) + b(k,180) = b(k,180) - lu(k,1771) * b(k,185) + b(k,179) = b(k,179) - lu(k,1770) * b(k,185) + b(k,178) = b(k,178) - lu(k,1769) * b(k,185) + b(k,177) = b(k,177) - lu(k,1768) * b(k,185) + b(k,176) = b(k,176) - lu(k,1767) * b(k,185) + b(k,175) = b(k,175) - lu(k,1766) * b(k,185) + b(k,174) = b(k,174) - lu(k,1765) * b(k,185) + b(k,173) = b(k,173) - lu(k,1764) * b(k,185) + b(k,172) = b(k,172) - lu(k,1763) * b(k,185) + b(k,167) = b(k,167) - lu(k,1762) * b(k,185) + b(k,166) = b(k,166) - lu(k,1761) * b(k,185) + b(k,156) = b(k,156) - lu(k,1760) * b(k,185) + b(k,155) = b(k,155) - lu(k,1759) * b(k,185) + b(k,148) = b(k,148) - lu(k,1758) * b(k,185) + b(k,143) = b(k,143) - lu(k,1757) * b(k,185) + b(k,142) = b(k,142) - lu(k,1756) * b(k,185) + b(k,140) = b(k,140) - lu(k,1755) * b(k,185) + b(k,131) = b(k,131) - lu(k,1754) * b(k,185) + b(k,129) = b(k,129) - lu(k,1753) * b(k,185) + b(k,126) = b(k,126) - lu(k,1752) * b(k,185) + b(k,119) = b(k,119) - lu(k,1751) * b(k,185) + b(k,110) = b(k,110) - lu(k,1750) * b(k,185) + b(k,106) = b(k,106) - lu(k,1749) * b(k,185) + b(k,105) = b(k,105) - lu(k,1748) * b(k,185) + b(k,98) = b(k,98) - lu(k,1747) * b(k,185) + b(k,97) = b(k,97) - lu(k,1746) * b(k,185) + b(k,83) = b(k,83) - lu(k,1745) * b(k,185) + b(k,82) = b(k,82) - lu(k,1744) * b(k,185) + b(k,67) = b(k,67) - lu(k,1743) * b(k,185) + b(k,44) = b(k,44) - lu(k,1742) * b(k,185) + b(k,184) = b(k,184) * lu(k,1734) + b(k,183) = b(k,183) - lu(k,1733) * b(k,184) + b(k,182) = b(k,182) - lu(k,1732) * b(k,184) + b(k,181) = b(k,181) - lu(k,1731) * b(k,184) + b(k,180) = b(k,180) - lu(k,1730) * b(k,184) + b(k,179) = b(k,179) - lu(k,1729) * b(k,184) + b(k,178) = b(k,178) - lu(k,1728) * b(k,184) + b(k,177) = b(k,177) - lu(k,1727) * b(k,184) + b(k,176) = b(k,176) - lu(k,1726) * b(k,184) + b(k,175) = b(k,175) - lu(k,1725) * b(k,184) + b(k,174) = b(k,174) - lu(k,1724) * b(k,184) + b(k,173) = b(k,173) - lu(k,1723) * b(k,184) + b(k,162) = b(k,162) - lu(k,1722) * b(k,184) + b(k,161) = b(k,161) - lu(k,1721) * b(k,184) + b(k,155) = b(k,155) - lu(k,1720) * b(k,184) + b(k,151) = b(k,151) - lu(k,1719) * b(k,184) + b(k,148) = b(k,148) - lu(k,1718) * b(k,184) + b(k,142) = b(k,142) - lu(k,1717) * b(k,184) + b(k,137) = b(k,137) - lu(k,1716) * b(k,184) + b(k,136) = b(k,136) - lu(k,1715) * b(k,184) + b(k,133) = b(k,133) - lu(k,1714) * b(k,184) + b(k,125) = b(k,125) - lu(k,1713) * b(k,184) + b(k,114) = b(k,114) - lu(k,1712) * b(k,184) + b(k,111) = b(k,111) - lu(k,1711) * b(k,184) + b(k,71) = b(k,71) - lu(k,1710) * b(k,184) + b(k,70) = b(k,70) - lu(k,1709) * b(k,184) + b(k,45) = b(k,45) - lu(k,1708) * b(k,184) + b(k,183) = b(k,183) * lu(k,1699) + b(k,182) = b(k,182) - lu(k,1698) * b(k,183) + b(k,181) = b(k,181) - lu(k,1697) * b(k,183) + b(k,180) = b(k,180) - lu(k,1696) * b(k,183) + b(k,179) = b(k,179) - lu(k,1695) * b(k,183) + b(k,178) = b(k,178) - lu(k,1694) * b(k,183) + b(k,177) = b(k,177) - lu(k,1693) * b(k,183) + b(k,176) = b(k,176) - lu(k,1692) * b(k,183) + b(k,175) = b(k,175) - lu(k,1691) * b(k,183) + b(k,174) = b(k,174) - lu(k,1690) * b(k,183) + b(k,167) = b(k,167) - lu(k,1689) * b(k,183) + b(k,148) = b(k,148) - lu(k,1688) * b(k,183) + b(k,140) = b(k,140) - lu(k,1687) * b(k,183) + b(k,136) = b(k,136) - lu(k,1686) * b(k,183) + b(k,76) = b(k,76) - lu(k,1685) * b(k,183) + b(k,61) = b(k,61) - lu(k,1684) * b(k,183) + b(k,45) = b(k,45) - lu(k,1683) * b(k,183) + b(k,36) = b(k,36) - lu(k,1682) * b(k,183) + b(k,182) = b(k,182) * lu(k,1672) + b(k,181) = b(k,181) - lu(k,1671) * b(k,182) + b(k,180) = b(k,180) - lu(k,1670) * b(k,182) + b(k,179) = b(k,179) - lu(k,1669) * b(k,182) + b(k,178) = b(k,178) - lu(k,1668) * b(k,182) + b(k,177) = b(k,177) - lu(k,1667) * b(k,182) + b(k,176) = b(k,176) - lu(k,1666) * b(k,182) + b(k,175) = b(k,175) - lu(k,1665) * b(k,182) + b(k,173) = b(k,173) - lu(k,1664) * b(k,182) + b(k,172) = b(k,172) - lu(k,1663) * b(k,182) + b(k,171) = b(k,171) - lu(k,1662) * b(k,182) + b(k,170) = b(k,170) - lu(k,1661) * b(k,182) + b(k,169) = b(k,169) - lu(k,1660) * b(k,182) + b(k,168) = b(k,168) - lu(k,1659) * b(k,182) + b(k,166) = b(k,166) - lu(k,1658) * b(k,182) + b(k,165) = b(k,165) - lu(k,1657) * b(k,182) + b(k,164) = b(k,164) - lu(k,1656) * b(k,182) + b(k,163) = b(k,163) - lu(k,1655) * b(k,182) + b(k,161) = b(k,161) - lu(k,1654) * b(k,182) + b(k,160) = b(k,160) - lu(k,1653) * b(k,182) + b(k,159) = b(k,159) - lu(k,1652) * b(k,182) + b(k,158) = b(k,158) - lu(k,1651) * b(k,182) + b(k,157) = b(k,157) - lu(k,1650) * b(k,182) + b(k,156) = b(k,156) - lu(k,1649) * b(k,182) + b(k,155) = b(k,155) - lu(k,1648) * b(k,182) + b(k,153) = b(k,153) - lu(k,1647) * b(k,182) + b(k,152) = b(k,152) - lu(k,1646) * b(k,182) + b(k,151) = b(k,151) - lu(k,1645) * b(k,182) + b(k,150) = b(k,150) - lu(k,1644) * b(k,182) + b(k,147) = b(k,147) - lu(k,1643) * b(k,182) + b(k,142) = b(k,142) - lu(k,1642) * b(k,182) + b(k,141) = b(k,141) - lu(k,1641) * b(k,182) + b(k,137) = b(k,137) - lu(k,1640) * b(k,182) + b(k,135) = b(k,135) - lu(k,1639) * b(k,182) + b(k,134) = b(k,134) - lu(k,1638) * b(k,182) + b(k,118) = b(k,118) - lu(k,1637) * b(k,182) + b(k,108) = b(k,108) - lu(k,1636) * b(k,182) + b(k,91) = b(k,91) - lu(k,1635) * b(k,182) + b(k,84) = b(k,84) - lu(k,1634) * b(k,182) + b(k,72) = b(k,72) - lu(k,1633) * b(k,182) + b(k,64) = b(k,64) - lu(k,1632) * b(k,182) + b(k,181) = b(k,181) * lu(k,1621) + b(k,180) = b(k,180) - lu(k,1620) * b(k,181) + b(k,179) = b(k,179) - lu(k,1619) * b(k,181) + b(k,178) = b(k,178) - lu(k,1618) * b(k,181) + b(k,177) = b(k,177) - lu(k,1617) * b(k,181) + b(k,176) = b(k,176) - lu(k,1616) * b(k,181) + b(k,175) = b(k,175) - lu(k,1615) * b(k,181) + b(k,174) = b(k,174) - lu(k,1614) * b(k,181) + b(k,173) = b(k,173) - lu(k,1613) * b(k,181) + b(k,172) = b(k,172) - lu(k,1612) * b(k,181) + b(k,171) = b(k,171) - lu(k,1611) * b(k,181) + b(k,170) = b(k,170) - lu(k,1610) * b(k,181) + b(k,169) = b(k,169) - lu(k,1609) * b(k,181) + b(k,168) = b(k,168) - lu(k,1608) * b(k,181) + b(k,167) = b(k,167) - lu(k,1607) * b(k,181) + b(k,166) = b(k,166) - lu(k,1606) * b(k,181) + b(k,165) = b(k,165) - lu(k,1605) * b(k,181) + b(k,164) = b(k,164) - lu(k,1604) * b(k,181) + b(k,163) = b(k,163) - lu(k,1603) * b(k,181) + b(k,162) = b(k,162) - lu(k,1602) * b(k,181) + b(k,161) = b(k,161) - lu(k,1601) * b(k,181) + b(k,160) = b(k,160) - lu(k,1600) * b(k,181) + b(k,159) = b(k,159) - lu(k,1599) * b(k,181) + b(k,158) = b(k,158) - lu(k,1598) * b(k,181) + b(k,157) = b(k,157) - lu(k,1597) * b(k,181) + b(k,156) = b(k,156) - lu(k,1596) * b(k,181) + b(k,155) = b(k,155) - lu(k,1595) * b(k,181) + b(k,154) = b(k,154) - lu(k,1594) * b(k,181) + b(k,153) = b(k,153) - lu(k,1593) * b(k,181) + b(k,152) = b(k,152) - lu(k,1592) * b(k,181) + b(k,151) = b(k,151) - lu(k,1591) * b(k,181) + b(k,150) = b(k,150) - lu(k,1590) * b(k,181) + b(k,149) = b(k,149) - lu(k,1589) * b(k,181) + b(k,148) = b(k,148) - lu(k,1588) * b(k,181) + b(k,147) = b(k,147) - lu(k,1587) * b(k,181) + b(k,146) = b(k,146) - lu(k,1586) * b(k,181) + b(k,145) = b(k,145) - lu(k,1585) * b(k,181) + b(k,144) = b(k,144) - lu(k,1584) * b(k,181) + b(k,143) = b(k,143) - lu(k,1583) * b(k,181) + b(k,142) = b(k,142) - lu(k,1582) * b(k,181) + b(k,141) = b(k,141) - lu(k,1581) * b(k,181) + b(k,140) = b(k,140) - lu(k,1580) * b(k,181) + b(k,139) = b(k,139) - lu(k,1579) * b(k,181) + b(k,138) = b(k,138) - lu(k,1578) * b(k,181) + b(k,137) = b(k,137) - lu(k,1577) * b(k,181) + b(k,136) = b(k,136) - lu(k,1576) * b(k,181) + b(k,135) = b(k,135) - lu(k,1575) * b(k,181) + b(k,134) = b(k,134) - lu(k,1574) * b(k,181) + b(k,133) = b(k,133) - lu(k,1573) * b(k,181) + b(k,132) = b(k,132) - lu(k,1572) * b(k,181) + b(k,130) = b(k,130) - lu(k,1571) * b(k,181) + b(k,129) = b(k,129) - lu(k,1570) * b(k,181) + b(k,128) = b(k,128) - lu(k,1569) * b(k,181) + b(k,127) = b(k,127) - lu(k,1568) * b(k,181) + b(k,126) = b(k,126) - lu(k,1567) * b(k,181) + b(k,125) = b(k,125) - lu(k,1566) * b(k,181) + b(k,124) = b(k,124) - lu(k,1565) * b(k,181) + b(k,123) = b(k,123) - lu(k,1564) * b(k,181) + b(k,122) = b(k,122) - lu(k,1563) * b(k,181) + b(k,121) = b(k,121) - lu(k,1562) * b(k,181) + b(k,120) = b(k,120) - lu(k,1561) * b(k,181) + b(k,119) = b(k,119) - lu(k,1560) * b(k,181) + b(k,118) = b(k,118) - lu(k,1559) * b(k,181) + b(k,117) = b(k,117) - lu(k,1558) * b(k,181) + b(k,116) = b(k,116) - lu(k,1557) * b(k,181) + b(k,115) = b(k,115) - lu(k,1556) * b(k,181) + b(k,114) = b(k,114) - lu(k,1555) * b(k,181) + b(k,113) = b(k,113) - lu(k,1554) * b(k,181) + b(k,112) = b(k,112) - lu(k,1553) * b(k,181) + b(k,111) = b(k,111) - lu(k,1552) * b(k,181) + b(k,109) = b(k,109) - lu(k,1551) * b(k,181) + b(k,108) = b(k,108) - lu(k,1550) * b(k,181) + b(k,107) = b(k,107) - lu(k,1549) * b(k,181) + b(k,106) = b(k,106) - lu(k,1548) * b(k,181) + b(k,105) = b(k,105) - lu(k,1547) * b(k,181) + b(k,104) = b(k,104) - lu(k,1546) * b(k,181) + b(k,103) = b(k,103) - lu(k,1545) * b(k,181) + b(k,102) = b(k,102) - lu(k,1544) * b(k,181) + b(k,101) = b(k,101) - lu(k,1543) * b(k,181) + b(k,100) = b(k,100) - lu(k,1542) * b(k,181) + b(k,99) = b(k,99) - lu(k,1541) * b(k,181) + b(k,98) = b(k,98) - lu(k,1540) * b(k,181) + b(k,97) = b(k,97) - lu(k,1539) * b(k,181) + b(k,96) = b(k,96) - lu(k,1538) * b(k,181) + b(k,95) = b(k,95) - lu(k,1537) * b(k,181) + b(k,93) = b(k,93) - lu(k,1536) * b(k,181) + b(k,92) = b(k,92) - lu(k,1535) * b(k,181) + b(k,91) = b(k,91) - lu(k,1534) * b(k,181) + b(k,90) = b(k,90) - lu(k,1533) * b(k,181) + b(k,89) = b(k,89) - lu(k,1532) * b(k,181) + b(k,88) = b(k,88) - lu(k,1531) * b(k,181) + b(k,87) = b(k,87) - lu(k,1530) * b(k,181) + b(k,85) = b(k,85) - lu(k,1529) * b(k,181) + b(k,84) = b(k,84) - lu(k,1528) * b(k,181) + b(k,83) = b(k,83) - lu(k,1527) * b(k,181) + b(k,82) = b(k,82) - lu(k,1526) * b(k,181) + b(k,81) = b(k,81) - lu(k,1525) * b(k,181) + b(k,80) = b(k,80) - lu(k,1524) * b(k,181) + b(k,79) = b(k,79) - lu(k,1523) * b(k,181) + b(k,78) = b(k,78) - lu(k,1522) * b(k,181) + b(k,77) = b(k,77) - lu(k,1521) * b(k,181) + b(k,74) = b(k,74) - lu(k,1520) * b(k,181) + b(k,73) = b(k,73) - lu(k,1519) * b(k,181) + b(k,72) = b(k,72) - lu(k,1518) * b(k,181) + b(k,71) = b(k,71) - lu(k,1517) * b(k,181) + b(k,70) = b(k,70) - lu(k,1516) * b(k,181) + b(k,69) = b(k,69) - lu(k,1515) * b(k,181) + b(k,65) = b(k,65) - lu(k,1514) * b(k,181) + b(k,64) = b(k,64) - lu(k,1513) * b(k,181) + b(k,63) = b(k,63) - lu(k,1512) * b(k,181) + b(k,62) = b(k,62) - lu(k,1511) * b(k,181) + b(k,60) = b(k,60) - lu(k,1510) * b(k,181) + b(k,59) = b(k,59) - lu(k,1509) * b(k,181) + b(k,58) = b(k,58) - lu(k,1508) * b(k,181) + b(k,56) = b(k,56) - lu(k,1507) * b(k,181) + b(k,55) = b(k,55) - lu(k,1506) * b(k,181) + b(k,54) = b(k,54) - lu(k,1505) * b(k,181) + b(k,53) = b(k,53) - lu(k,1504) * b(k,181) + b(k,52) = b(k,52) - lu(k,1503) * b(k,181) + b(k,51) = b(k,51) - lu(k,1502) * b(k,181) + b(k,50) = b(k,50) - lu(k,1501) * b(k,181) + b(k,49) = b(k,49) - lu(k,1500) * b(k,181) + b(k,48) = b(k,48) - lu(k,1499) * b(k,181) + b(k,47) = b(k,47) - lu(k,1498) * b(k,181) + b(k,46) = b(k,46) - lu(k,1497) * b(k,181) + b(k,43) = b(k,43) - lu(k,1496) * b(k,181) + b(k,40) = b(k,40) - lu(k,1495) * b(k,181) + b(k,39) = b(k,39) - lu(k,1494) * b(k,181) + b(k,38) = b(k,38) - lu(k,1493) * b(k,181) + b(k,37) = b(k,37) - lu(k,1492) * b(k,181) + b(k,35) = b(k,35) - lu(k,1491) * b(k,181) + b(k,34) = b(k,34) - lu(k,1490) * b(k,181) + b(k,33) = b(k,33) - lu(k,1489) * b(k,181) + b(k,32) = b(k,32) - lu(k,1488) * b(k,181) + b(k,31) = b(k,31) - lu(k,1487) * b(k,181) + b(k,30) = b(k,30) - lu(k,1486) * b(k,181) + b(k,29) = b(k,29) - lu(k,1485) * b(k,181) + end do + end subroutine lu_slv07 + subroutine lu_slv08( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,180) = b(k,180) * lu(k,1473) + b(k,179) = b(k,179) - lu(k,1472) * b(k,180) + b(k,178) = b(k,178) - lu(k,1471) * b(k,180) + b(k,177) = b(k,177) - lu(k,1470) * b(k,180) + b(k,176) = b(k,176) - lu(k,1469) * b(k,180) + b(k,175) = b(k,175) - lu(k,1468) * b(k,180) + b(k,174) = b(k,174) - lu(k,1467) * b(k,180) + b(k,162) = b(k,162) - lu(k,1466) * b(k,180) + b(k,138) = b(k,138) - lu(k,1465) * b(k,180) + b(k,132) = b(k,132) - lu(k,1464) * b(k,180) + b(k,50) = b(k,50) - lu(k,1463) * b(k,180) + b(k,49) = b(k,49) - lu(k,1462) * b(k,180) + b(k,40) = b(k,40) - lu(k,1461) * b(k,180) + b(k,179) = b(k,179) * lu(k,1448) + b(k,178) = b(k,178) - lu(k,1447) * b(k,179) + b(k,177) = b(k,177) - lu(k,1446) * b(k,179) + b(k,176) = b(k,176) - lu(k,1445) * b(k,179) + b(k,175) = b(k,175) - lu(k,1444) * b(k,179) + b(k,174) = b(k,174) - lu(k,1443) * b(k,179) + b(k,173) = b(k,173) - lu(k,1442) * b(k,179) + b(k,172) = b(k,172) - lu(k,1441) * b(k,179) + b(k,171) = b(k,171) - lu(k,1440) * b(k,179) + b(k,170) = b(k,170) - lu(k,1439) * b(k,179) + b(k,169) = b(k,169) - lu(k,1438) * b(k,179) + b(k,168) = b(k,168) - lu(k,1437) * b(k,179) + b(k,167) = b(k,167) - lu(k,1436) * b(k,179) + b(k,166) = b(k,166) - lu(k,1435) * b(k,179) + b(k,165) = b(k,165) - lu(k,1434) * b(k,179) + b(k,164) = b(k,164) - lu(k,1433) * b(k,179) + b(k,163) = b(k,163) - lu(k,1432) * b(k,179) + b(k,161) = b(k,161) - lu(k,1431) * b(k,179) + b(k,160) = b(k,160) - lu(k,1430) * b(k,179) + b(k,159) = b(k,159) - lu(k,1429) * b(k,179) + b(k,158) = b(k,158) - lu(k,1428) * b(k,179) + b(k,157) = b(k,157) - lu(k,1427) * b(k,179) + b(k,156) = b(k,156) - lu(k,1426) * b(k,179) + b(k,155) = b(k,155) - lu(k,1425) * b(k,179) + b(k,154) = b(k,154) - lu(k,1424) * b(k,179) + b(k,153) = b(k,153) - lu(k,1423) * b(k,179) + b(k,152) = b(k,152) - lu(k,1422) * b(k,179) + b(k,151) = b(k,151) - lu(k,1421) * b(k,179) + b(k,150) = b(k,150) - lu(k,1420) * b(k,179) + b(k,149) = b(k,149) - lu(k,1419) * b(k,179) + b(k,147) = b(k,147) - lu(k,1418) * b(k,179) + b(k,146) = b(k,146) - lu(k,1417) * b(k,179) + b(k,145) = b(k,145) - lu(k,1416) * b(k,179) + b(k,144) = b(k,144) - lu(k,1415) * b(k,179) + b(k,142) = b(k,142) - lu(k,1414) * b(k,179) + b(k,141) = b(k,141) - lu(k,1413) * b(k,179) + b(k,140) = b(k,140) - lu(k,1412) * b(k,179) + b(k,139) = b(k,139) - lu(k,1411) * b(k,179) + b(k,112) = b(k,112) - lu(k,1410) * b(k,179) + b(k,81) = b(k,81) - lu(k,1409) * b(k,179) + b(k,72) = b(k,72) - lu(k,1408) * b(k,179) + b(k,69) = b(k,69) - lu(k,1407) * b(k,179) + b(k,67) = b(k,67) - lu(k,1406) * b(k,179) + b(k,33) = b(k,33) - lu(k,1405) * b(k,179) + b(k,32) = b(k,32) - lu(k,1404) * b(k,179) + b(k,178) = b(k,178) * lu(k,1390) + b(k,177) = b(k,177) - lu(k,1389) * b(k,178) + b(k,176) = b(k,176) - lu(k,1388) * b(k,178) + b(k,175) = b(k,175) - lu(k,1387) * b(k,178) + b(k,174) = b(k,174) - lu(k,1386) * b(k,178) + b(k,173) = b(k,173) - lu(k,1385) * b(k,178) + b(k,172) = b(k,172) - lu(k,1384) * b(k,178) + b(k,171) = b(k,171) - lu(k,1383) * b(k,178) + b(k,170) = b(k,170) - lu(k,1382) * b(k,178) + b(k,169) = b(k,169) - lu(k,1381) * b(k,178) + b(k,168) = b(k,168) - lu(k,1380) * b(k,178) + b(k,166) = b(k,166) - lu(k,1379) * b(k,178) + b(k,165) = b(k,165) - lu(k,1378) * b(k,178) + b(k,164) = b(k,164) - lu(k,1377) * b(k,178) + b(k,163) = b(k,163) - lu(k,1376) * b(k,178) + b(k,162) = b(k,162) - lu(k,1375) * b(k,178) + b(k,161) = b(k,161) - lu(k,1374) * b(k,178) + b(k,160) = b(k,160) - lu(k,1373) * b(k,178) + b(k,159) = b(k,159) - lu(k,1372) * b(k,178) + b(k,158) = b(k,158) - lu(k,1371) * b(k,178) + b(k,157) = b(k,157) - lu(k,1370) * b(k,178) + b(k,156) = b(k,156) - lu(k,1369) * b(k,178) + b(k,155) = b(k,155) - lu(k,1368) * b(k,178) + b(k,153) = b(k,153) - lu(k,1367) * b(k,178) + b(k,151) = b(k,151) - lu(k,1366) * b(k,178) + b(k,150) = b(k,150) - lu(k,1365) * b(k,178) + b(k,147) = b(k,147) - lu(k,1364) * b(k,178) + b(k,146) = b(k,146) - lu(k,1363) * b(k,178) + b(k,143) = b(k,143) - lu(k,1362) * b(k,178) + b(k,142) = b(k,142) - lu(k,1361) * b(k,178) + b(k,141) = b(k,141) - lu(k,1360) * b(k,178) + b(k,138) = b(k,138) - lu(k,1359) * b(k,178) + b(k,137) = b(k,137) - lu(k,1358) * b(k,178) + b(k,136) = b(k,136) - lu(k,1357) * b(k,178) + b(k,135) = b(k,135) - lu(k,1356) * b(k,178) + b(k,133) = b(k,133) - lu(k,1355) * b(k,178) + b(k,131) = b(k,131) - lu(k,1354) * b(k,178) + b(k,130) = b(k,130) - lu(k,1353) * b(k,178) + b(k,129) = b(k,129) - lu(k,1352) * b(k,178) + b(k,128) = b(k,128) - lu(k,1351) * b(k,178) + b(k,127) = b(k,127) - lu(k,1350) * b(k,178) + b(k,126) = b(k,126) - lu(k,1349) * b(k,178) + b(k,125) = b(k,125) - lu(k,1348) * b(k,178) + b(k,124) = b(k,124) - lu(k,1347) * b(k,178) + b(k,123) = b(k,123) - lu(k,1346) * b(k,178) + b(k,122) = b(k,122) - lu(k,1345) * b(k,178) + b(k,120) = b(k,120) - lu(k,1344) * b(k,178) + b(k,119) = b(k,119) - lu(k,1343) * b(k,178) + b(k,117) = b(k,117) - lu(k,1342) * b(k,178) + b(k,116) = b(k,116) - lu(k,1341) * b(k,178) + b(k,115) = b(k,115) - lu(k,1340) * b(k,178) + b(k,114) = b(k,114) - lu(k,1339) * b(k,178) + b(k,109) = b(k,109) - lu(k,1338) * b(k,178) + b(k,108) = b(k,108) - lu(k,1337) * b(k,178) + b(k,105) = b(k,105) - lu(k,1336) * b(k,178) + b(k,102) = b(k,102) - lu(k,1335) * b(k,178) + b(k,101) = b(k,101) - lu(k,1334) * b(k,178) + b(k,100) = b(k,100) - lu(k,1333) * b(k,178) + b(k,99) = b(k,99) - lu(k,1332) * b(k,178) + b(k,98) = b(k,98) - lu(k,1331) * b(k,178) + b(k,96) = b(k,96) - lu(k,1330) * b(k,178) + b(k,95) = b(k,95) - lu(k,1329) * b(k,178) + b(k,94) = b(k,94) - lu(k,1328) * b(k,178) + b(k,93) = b(k,93) - lu(k,1327) * b(k,178) + b(k,92) = b(k,92) - lu(k,1326) * b(k,178) + b(k,91) = b(k,91) - lu(k,1325) * b(k,178) + b(k,90) = b(k,90) - lu(k,1324) * b(k,178) + b(k,89) = b(k,89) - lu(k,1323) * b(k,178) + b(k,88) = b(k,88) - lu(k,1322) * b(k,178) + b(k,87) = b(k,87) - lu(k,1321) * b(k,178) + b(k,85) = b(k,85) - lu(k,1320) * b(k,178) + b(k,83) = b(k,83) - lu(k,1319) * b(k,178) + b(k,79) = b(k,79) - lu(k,1318) * b(k,178) + b(k,78) = b(k,78) - lu(k,1317) * b(k,178) + b(k,77) = b(k,77) - lu(k,1316) * b(k,178) + b(k,74) = b(k,74) - lu(k,1315) * b(k,178) + b(k,73) = b(k,73) - lu(k,1314) * b(k,178) + b(k,66) = b(k,66) - lu(k,1313) * b(k,178) + b(k,65) = b(k,65) - lu(k,1312) * b(k,178) + b(k,54) = b(k,54) - lu(k,1311) * b(k,178) + b(k,41) = b(k,41) - lu(k,1310) * b(k,178) + b(k,177) = b(k,177) * lu(k,1296) + b(k,176) = b(k,176) - lu(k,1295) * b(k,177) + b(k,175) = b(k,175) - lu(k,1294) * b(k,177) + b(k,174) = b(k,174) - lu(k,1293) * b(k,177) + b(k,148) = b(k,148) - lu(k,1292) * b(k,177) + b(k,136) = b(k,136) - lu(k,1291) * b(k,177) + b(k,131) = b(k,131) - lu(k,1290) * b(k,177) + b(k,61) = b(k,61) - lu(k,1289) * b(k,177) + b(k,45) = b(k,45) - lu(k,1288) * b(k,177) + b(k,176) = b(k,176) * lu(k,1276) + b(k,175) = b(k,175) - lu(k,1275) * b(k,176) + b(k,162) = b(k,162) - lu(k,1274) * b(k,176) + b(k,175) = b(k,175) * lu(k,1263) + b(k,162) = b(k,162) - lu(k,1262) * b(k,175) + b(k,132) = b(k,132) - lu(k,1261) * b(k,175) + b(k,57) = b(k,57) - lu(k,1260) * b(k,175) + b(k,174) = b(k,174) * lu(k,1250) + b(k,155) = b(k,155) - lu(k,1249) * b(k,174) + b(k,138) = b(k,138) - lu(k,1248) * b(k,174) + b(k,173) = b(k,173) * lu(k,1236) + b(k,172) = b(k,172) - lu(k,1235) * b(k,173) + b(k,171) = b(k,171) - lu(k,1234) * b(k,173) + b(k,170) = b(k,170) - lu(k,1233) * b(k,173) + b(k,169) = b(k,169) - lu(k,1232) * b(k,173) + b(k,168) = b(k,168) - lu(k,1231) * b(k,173) + b(k,166) = b(k,166) - lu(k,1230) * b(k,173) + b(k,165) = b(k,165) - lu(k,1229) * b(k,173) + b(k,164) = b(k,164) - lu(k,1228) * b(k,173) + b(k,163) = b(k,163) - lu(k,1227) * b(k,173) + b(k,156) = b(k,156) - lu(k,1226) * b(k,173) + b(k,155) = b(k,155) - lu(k,1225) * b(k,173) + b(k,152) = b(k,152) - lu(k,1224) * b(k,173) + b(k,151) = b(k,151) - lu(k,1223) * b(k,173) + b(k,142) = b(k,142) - lu(k,1222) * b(k,173) + b(k,108) = b(k,108) - lu(k,1221) * b(k,173) + b(k,102) = b(k,102) - lu(k,1220) * b(k,173) + b(k,97) = b(k,97) - lu(k,1219) * b(k,173) + b(k,72) = b(k,72) - lu(k,1218) * b(k,173) + b(k,172) = b(k,172) * lu(k,1205) + b(k,166) = b(k,166) - lu(k,1204) * b(k,172) + b(k,156) = b(k,156) - lu(k,1203) * b(k,172) + b(k,108) = b(k,108) - lu(k,1202) * b(k,172) + b(k,106) = b(k,106) - lu(k,1201) * b(k,172) + b(k,102) = b(k,102) - lu(k,1200) * b(k,172) + b(k,171) = b(k,171) * lu(k,1186) + b(k,170) = b(k,170) - lu(k,1185) * b(k,171) + b(k,169) = b(k,169) - lu(k,1184) * b(k,171) + b(k,166) = b(k,166) - lu(k,1183) * b(k,171) + b(k,165) = b(k,165) - lu(k,1182) * b(k,171) + b(k,163) = b(k,163) - lu(k,1181) * b(k,171) + b(k,161) = b(k,161) - lu(k,1180) * b(k,171) + b(k,160) = b(k,160) - lu(k,1179) * b(k,171) + b(k,156) = b(k,156) - lu(k,1178) * b(k,171) + b(k,155) = b(k,155) - lu(k,1177) * b(k,171) + b(k,154) = b(k,154) - lu(k,1176) * b(k,171) + b(k,151) = b(k,151) - lu(k,1175) * b(k,171) + b(k,143) = b(k,143) - lu(k,1174) * b(k,171) + b(k,142) = b(k,142) - lu(k,1173) * b(k,171) + b(k,141) = b(k,141) - lu(k,1172) * b(k,171) + b(k,134) = b(k,134) - lu(k,1171) * b(k,171) + b(k,123) = b(k,123) - lu(k,1170) * b(k,171) + b(k,117) = b(k,117) - lu(k,1169) * b(k,171) + b(k,107) = b(k,107) - lu(k,1168) * b(k,171) + b(k,72) = b(k,72) - lu(k,1167) * b(k,171) + b(k,58) = b(k,58) - lu(k,1166) * b(k,171) + end do + end subroutine lu_slv08 + subroutine lu_slv09( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,170) = b(k,170) * lu(k,1153) + b(k,166) = b(k,166) - lu(k,1152) * b(k,170) + b(k,161) = b(k,161) - lu(k,1151) * b(k,170) + b(k,160) = b(k,160) - lu(k,1150) * b(k,170) + b(k,156) = b(k,156) - lu(k,1149) * b(k,170) + b(k,155) = b(k,155) - lu(k,1148) * b(k,170) + b(k,154) = b(k,154) - lu(k,1147) * b(k,170) + b(k,151) = b(k,151) - lu(k,1146) * b(k,170) + b(k,134) = b(k,134) - lu(k,1145) * b(k,170) + b(k,73) = b(k,73) - lu(k,1144) * b(k,170) + b(k,169) = b(k,169) * lu(k,1130) + b(k,166) = b(k,166) - lu(k,1129) * b(k,169) + b(k,161) = b(k,161) - lu(k,1128) * b(k,169) + b(k,156) = b(k,156) - lu(k,1127) * b(k,169) + b(k,155) = b(k,155) - lu(k,1126) * b(k,169) + b(k,149) = b(k,149) - lu(k,1125) * b(k,169) + b(k,133) = b(k,133) - lu(k,1124) * b(k,169) + b(k,168) = b(k,168) * lu(k,1108) + b(k,166) = b(k,166) - lu(k,1107) * b(k,168) + b(k,165) = b(k,165) - lu(k,1106) * b(k,168) + b(k,163) = b(k,163) - lu(k,1105) * b(k,168) + b(k,161) = b(k,161) - lu(k,1104) * b(k,168) + b(k,160) = b(k,160) - lu(k,1103) * b(k,168) + b(k,156) = b(k,156) - lu(k,1102) * b(k,168) + b(k,155) = b(k,155) - lu(k,1101) * b(k,168) + b(k,154) = b(k,154) - lu(k,1100) * b(k,168) + b(k,151) = b(k,151) - lu(k,1099) * b(k,168) + b(k,134) = b(k,134) - lu(k,1098) * b(k,168) + b(k,123) = b(k,123) - lu(k,1097) * b(k,168) + b(k,113) = b(k,113) - lu(k,1096) * b(k,168) + b(k,167) = b(k,167) * lu(k,1083) + b(k,140) = b(k,140) - lu(k,1082) * b(k,167) + b(k,103) = b(k,103) - lu(k,1081) * b(k,167) + b(k,76) = b(k,76) - lu(k,1080) * b(k,167) + b(k,166) = b(k,166) * lu(k,1072) + b(k,155) = b(k,155) - lu(k,1071) * b(k,166) + b(k,165) = b(k,165) * lu(k,1060) + b(k,155) = b(k,155) - lu(k,1059) * b(k,165) + b(k,133) = b(k,133) - lu(k,1058) * b(k,165) + b(k,164) = b(k,164) * lu(k,1044) + b(k,163) = b(k,163) - lu(k,1043) * b(k,164) + b(k,155) = b(k,155) - lu(k,1042) * b(k,164) + b(k,152) = b(k,152) - lu(k,1041) * b(k,164) + b(k,151) = b(k,151) - lu(k,1040) * b(k,164) + b(k,141) = b(k,141) - lu(k,1039) * b(k,164) + b(k,134) = b(k,134) - lu(k,1038) * b(k,164) + b(k,123) = b(k,123) - lu(k,1037) * b(k,164) + b(k,89) = b(k,89) - lu(k,1036) * b(k,164) + b(k,84) = b(k,84) - lu(k,1035) * b(k,164) + b(k,163) = b(k,163) * lu(k,1024) + b(k,156) = b(k,156) - lu(k,1023) * b(k,163) + b(k,155) = b(k,155) - lu(k,1022) * b(k,163) + b(k,151) = b(k,151) - lu(k,1021) * b(k,163) + b(k,142) = b(k,142) - lu(k,1020) * b(k,163) + b(k,134) = b(k,134) - lu(k,1019) * b(k,163) + b(k,54) = b(k,54) - lu(k,1018) * b(k,163) + b(k,162) = b(k,162) * lu(k,1007) + b(k,132) = b(k,132) - lu(k,1006) * b(k,162) + b(k,57) = b(k,57) - lu(k,1005) * b(k,162) + b(k,161) = b(k,161) * lu(k,996) + b(k,155) = b(k,155) - lu(k,995) * b(k,161) + b(k,160) = b(k,160) * lu(k,985) + b(k,156) = b(k,156) - lu(k,984) * b(k,160) + b(k,134) = b(k,134) - lu(k,983) * b(k,160) + b(k,88) = b(k,88) - lu(k,982) * b(k,160) + b(k,159) = b(k,159) * lu(k,969) + b(k,158) = b(k,158) - lu(k,968) * b(k,159) + b(k,155) = b(k,155) - lu(k,967) * b(k,159) + b(k,153) = b(k,153) - lu(k,966) * b(k,159) + b(k,150) = b(k,150) - lu(k,965) * b(k,159) + b(k,134) = b(k,134) - lu(k,964) * b(k,159) + b(k,118) = b(k,118) - lu(k,963) * b(k,159) + b(k,87) = b(k,87) - lu(k,962) * b(k,159) + b(k,158) = b(k,158) * lu(k,950) + b(k,155) = b(k,155) - lu(k,949) * b(k,158) + b(k,153) = b(k,153) - lu(k,948) * b(k,158) + b(k,151) = b(k,151) - lu(k,947) * b(k,158) + b(k,147) = b(k,147) - lu(k,946) * b(k,158) + b(k,134) = b(k,134) - lu(k,945) * b(k,158) + b(k,115) = b(k,115) - lu(k,944) * b(k,158) + b(k,59) = b(k,59) - lu(k,943) * b(k,158) + b(k,157) = b(k,157) * lu(k,928) + b(k,155) = b(k,155) - lu(k,927) * b(k,157) + b(k,153) = b(k,153) - lu(k,926) * b(k,157) + b(k,150) = b(k,150) - lu(k,925) * b(k,157) + b(k,147) = b(k,147) - lu(k,924) * b(k,157) + b(k,134) = b(k,134) - lu(k,923) * b(k,157) + b(k,118) = b(k,118) - lu(k,922) * b(k,157) + b(k,99) = b(k,99) - lu(k,921) * b(k,157) + b(k,156) = b(k,156) * lu(k,915) + b(k,155) = b(k,155) * lu(k,911) + b(k,154) = b(k,154) * lu(k,898) + b(k,151) = b(k,151) - lu(k,897) * b(k,154) + b(k,147) = b(k,147) - lu(k,896) * b(k,154) + b(k,59) = b(k,59) - lu(k,895) * b(k,154) + b(k,153) = b(k,153) * lu(k,886) + b(k,147) = b(k,147) - lu(k,885) * b(k,153) + b(k,152) = b(k,152) * lu(k,874) + b(k,143) = b(k,143) - lu(k,873) * b(k,152) + b(k,142) = b(k,142) - lu(k,872) * b(k,152) + b(k,141) = b(k,141) - lu(k,871) * b(k,152) + b(k,117) = b(k,117) - lu(k,870) * b(k,152) + b(k,151) = b(k,151) * lu(k,865) + b(k,142) = b(k,142) - lu(k,864) * b(k,151) + b(k,150) = b(k,150) * lu(k,856) + b(k,149) = b(k,149) * lu(k,841) + b(k,141) = b(k,141) - lu(k,840) * b(k,149) + b(k,133) = b(k,133) - lu(k,839) * b(k,149) + b(k,130) = b(k,130) - lu(k,838) * b(k,149) + b(k,108) = b(k,108) - lu(k,837) * b(k,149) + b(k,148) = b(k,148) * lu(k,827) + b(k,136) = b(k,136) - lu(k,826) * b(k,148) + b(k,45) = b(k,45) - lu(k,825) * b(k,148) + b(k,147) = b(k,147) * lu(k,819) + b(k,146) = b(k,146) * lu(k,809) + b(k,137) = b(k,137) - lu(k,808) * b(k,146) + b(k,122) = b(k,122) - lu(k,807) * b(k,146) + b(k,121) = b(k,121) - lu(k,806) * b(k,146) + b(k,120) = b(k,120) - lu(k,805) * b(k,146) + b(k,104) = b(k,104) - lu(k,804) * b(k,146) + b(k,145) = b(k,145) * lu(k,787) + b(k,142) = b(k,142) - lu(k,786) * b(k,145) + b(k,133) = b(k,133) - lu(k,785) * b(k,145) + b(k,86) = b(k,86) - lu(k,784) * b(k,145) + b(k,60) = b(k,60) - lu(k,783) * b(k,145) + b(k,33) = b(k,33) - lu(k,782) * b(k,145) + b(k,32) = b(k,32) - lu(k,781) * b(k,145) + b(k,31) = b(k,31) - lu(k,780) * b(k,145) + b(k,30) = b(k,30) - lu(k,779) * b(k,145) + b(k,29) = b(k,29) - lu(k,778) * b(k,145) + b(k,144) = b(k,144) * lu(k,761) + b(k,142) = b(k,142) - lu(k,760) * b(k,144) + b(k,133) = b(k,133) - lu(k,759) * b(k,144) + b(k,86) = b(k,86) - lu(k,758) * b(k,144) + b(k,60) = b(k,60) - lu(k,757) * b(k,144) + b(k,33) = b(k,33) - lu(k,756) * b(k,144) + b(k,32) = b(k,32) - lu(k,755) * b(k,144) + b(k,31) = b(k,31) - lu(k,754) * b(k,144) + b(k,30) = b(k,30) - lu(k,753) * b(k,144) + b(k,29) = b(k,29) - lu(k,752) * b(k,144) + b(k,143) = b(k,143) * lu(k,744) + b(k,142) = b(k,142) - lu(k,743) * b(k,143) + b(k,142) = b(k,142) * lu(k,739) + b(k,29) = b(k,29) - lu(k,738) * b(k,142) + b(k,141) = b(k,141) * lu(k,732) + b(k,140) = b(k,140) * lu(k,726) + b(k,63) = b(k,63) - lu(k,725) * b(k,140) + b(k,139) = b(k,139) * lu(k,709) + b(k,133) = b(k,133) - lu(k,708) * b(k,139) + b(k,33) = b(k,33) - lu(k,707) * b(k,139) + b(k,32) = b(k,32) - lu(k,706) * b(k,139) + b(k,31) = b(k,31) - lu(k,705) * b(k,139) + b(k,30) = b(k,30) - lu(k,704) * b(k,139) + b(k,29) = b(k,29) - lu(k,703) * b(k,139) + b(k,138) = b(k,138) * lu(k,695) + b(k,137) = b(k,137) * lu(k,687) + b(k,134) = b(k,134) - lu(k,686) * b(k,137) + b(k,79) = b(k,79) - lu(k,685) * b(k,137) + b(k,64) = b(k,64) - lu(k,684) * b(k,137) + b(k,136) = b(k,136) * lu(k,677) + b(k,45) = b(k,45) - lu(k,676) * b(k,136) + b(k,135) = b(k,135) * lu(k,666) + b(k,90) = b(k,90) - lu(k,665) * b(k,135) + b(k,134) = b(k,134) * lu(k,661) + b(k,133) = b(k,133) * lu(k,657) + b(k,132) = b(k,132) * lu(k,649) + b(k,57) = b(k,57) - lu(k,648) * b(k,132) + b(k,131) = b(k,131) * lu(k,640) + b(k,61) = b(k,61) - lu(k,639) * b(k,131) + b(k,130) = b(k,130) * lu(k,630) + b(k,109) = b(k,109) - lu(k,629) * b(k,130) + b(k,129) = b(k,129) * lu(k,621) + b(k,128) = b(k,128) * lu(k,610) + b(k,126) = b(k,126) - lu(k,609) * b(k,128) + b(k,124) = b(k,124) - lu(k,608) * b(k,128) + b(k,117) = b(k,117) - lu(k,607) * b(k,128) + b(k,96) = b(k,96) - lu(k,606) * b(k,128) + b(k,75) = b(k,75) - lu(k,605) * b(k,128) + b(k,68) = b(k,68) - lu(k,604) * b(k,128) + b(k,127) = b(k,127) * lu(k,594) + b(k,126) = b(k,126) - lu(k,593) * b(k,127) + b(k,117) = b(k,117) - lu(k,592) * b(k,127) + b(k,116) = b(k,116) - lu(k,591) * b(k,127) + b(k,96) = b(k,96) - lu(k,590) * b(k,127) + b(k,68) = b(k,68) - lu(k,589) * b(k,127) + b(k,126) = b(k,126) * lu(k,583) + b(k,125) = b(k,125) * lu(k,576) + b(k,66) = b(k,66) - lu(k,575) * b(k,125) + b(k,41) = b(k,41) - lu(k,574) * b(k,125) + b(k,124) = b(k,124) * lu(k,563) + b(k,117) = b(k,117) - lu(k,562) * b(k,124) + b(k,96) = b(k,96) - lu(k,561) * b(k,124) + b(k,75) = b(k,75) - lu(k,560) * b(k,124) + b(k,68) = b(k,68) - lu(k,559) * b(k,124) + b(k,123) = b(k,123) * lu(k,552) + b(k,43) = b(k,43) - lu(k,551) * b(k,123) + b(k,122) = b(k,122) * lu(k,544) + b(k,74) = b(k,74) - lu(k,543) * b(k,122) + b(k,121) = b(k,121) * lu(k,533) + b(k,104) = b(k,104) - lu(k,532) * b(k,121) + b(k,120) = b(k,120) * lu(k,522) + b(k,104) = b(k,104) - lu(k,521) * b(k,120) + end do + end subroutine lu_slv09 + subroutine lu_slv10( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,119) = b(k,119) * lu(k,515) + b(k,98) = b(k,98) - lu(k,514) * b(k,119) + b(k,65) = b(k,65) - lu(k,513) * b(k,119) + b(k,118) = b(k,118) * lu(k,507) + b(k,117) = b(k,117) * lu(k,503) + b(k,116) = b(k,116) * lu(k,494) + b(k,96) = b(k,96) - lu(k,493) * b(k,116) + b(k,68) = b(k,68) - lu(k,492) * b(k,116) + b(k,115) = b(k,115) * lu(k,483) + b(k,114) = b(k,114) * lu(k,476) + b(k,113) = b(k,113) * lu(k,467) + b(k,112) = b(k,112) * lu(k,459) + b(k,111) = b(k,111) * lu(k,451) + b(k,110) = b(k,110) * lu(k,443) + b(k,109) = b(k,109) * lu(k,435) + b(k,108) = b(k,108) * lu(k,431) + b(k,107) = b(k,107) * lu(k,423) + b(k,106) = b(k,106) * lu(k,415) + b(k,105) = b(k,105) * lu(k,409) + b(k,44) = b(k,44) - lu(k,408) * b(k,105) + b(k,104) = b(k,104) * lu(k,403) + b(k,103) = b(k,103) * lu(k,397) + b(k,102) = b(k,102) * lu(k,391) + b(k,101) = b(k,101) * lu(k,384) + b(k,92) = b(k,92) - lu(k,383) * b(k,101) + b(k,100) = b(k,100) * lu(k,376) + b(k,96) = b(k,96) - lu(k,375) * b(k,100) + b(k,85) = b(k,85) - lu(k,374) * b(k,100) + b(k,99) = b(k,99) * lu(k,367) + b(k,98) = b(k,98) * lu(k,363) + b(k,97) = b(k,97) * lu(k,356) + b(k,96) = b(k,96) * lu(k,353) + b(k,95) = b(k,95) * lu(k,347) + b(k,77) = b(k,77) - lu(k,346) * b(k,95) + b(k,94) = b(k,94) * lu(k,340) + b(k,93) = b(k,93) * lu(k,334) + b(k,78) = b(k,78) - lu(k,333) * b(k,93) + b(k,62) = b(k,62) - lu(k,332) * b(k,93) + b(k,92) = b(k,92) * lu(k,326) + b(k,91) = b(k,91) * lu(k,320) + b(k,90) = b(k,90) * lu(k,314) + b(k,89) = b(k,89) * lu(k,308) + b(k,88) = b(k,88) * lu(k,302) + b(k,87) = b(k,87) * lu(k,296) + b(k,86) = b(k,86) * lu(k,290) + b(k,85) = b(k,85) * lu(k,284) + b(k,84) = b(k,84) * lu(k,278) + b(k,83) = b(k,83) * lu(k,272) + b(k,82) = b(k,82) * lu(k,266) + b(k,81) = b(k,81) * lu(k,258) + b(k,80) = b(k,80) * lu(k,250) + b(k,79) = b(k,79) * lu(k,245) + b(k,78) = b(k,78) * lu(k,240) + b(k,62) = b(k,62) - lu(k,239) * b(k,78) + b(k,77) = b(k,77) * lu(k,234) + b(k,76) = b(k,76) * lu(k,229) + b(k,75) = b(k,75) * lu(k,224) + b(k,74) = b(k,74) * lu(k,219) + b(k,73) = b(k,73) * lu(k,214) + b(k,72) = b(k,72) * lu(k,211) + b(k,71) = b(k,71) * lu(k,205) + b(k,70) = b(k,70) * lu(k,199) + b(k,69) = b(k,69) * lu(k,193) + b(k,68) = b(k,68) * lu(k,190) + b(k,67) = b(k,67) * lu(k,184) + b(k,66) = b(k,66) * lu(k,180) + b(k,65) = b(k,65) * lu(k,176) + b(k,64) = b(k,64) * lu(k,172) + b(k,63) = b(k,63) * lu(k,168) + b(k,42) = b(k,42) - lu(k,167) * b(k,63) + b(k,62) = b(k,62) * lu(k,164) + b(k,61) = b(k,61) * lu(k,161) + b(k,60) = b(k,60) * lu(k,158) + b(k,59) = b(k,59) * lu(k,155) + b(k,58) = b(k,58) * lu(k,150) + b(k,57) = b(k,57) * lu(k,147) + b(k,56) = b(k,56) * lu(k,142) + b(k,55) = b(k,55) * lu(k,134) + b(k,53) = b(k,53) - lu(k,133) * b(k,55) + b(k,33) = b(k,33) - lu(k,132) * b(k,55) + b(k,32) = b(k,32) - lu(k,131) * b(k,55) + b(k,31) = b(k,31) - lu(k,130) * b(k,55) + b(k,30) = b(k,30) - lu(k,129) * b(k,55) + b(k,29) = b(k,29) - lu(k,128) * b(k,55) + b(k,54) = b(k,54) * lu(k,125) + b(k,53) = b(k,53) * lu(k,121) + b(k,52) = b(k,52) * lu(k,116) + b(k,51) = b(k,51) * lu(k,109) + b(k,33) = b(k,33) - lu(k,108) * b(k,51) + b(k,32) = b(k,32) - lu(k,107) * b(k,51) + b(k,31) = b(k,31) - lu(k,106) * b(k,51) + b(k,30) = b(k,30) - lu(k,105) * b(k,51) + b(k,29) = b(k,29) - lu(k,104) * b(k,51) + b(k,50) = b(k,50) * lu(k,100) + b(k,49) = b(k,49) * lu(k,96) + b(k,48) = b(k,48) * lu(k,91) + b(k,47) = b(k,47) * lu(k,87) + b(k,46) = b(k,46) * lu(k,81) + b(k,33) = b(k,33) - lu(k,80) * b(k,46) + b(k,32) = b(k,32) - lu(k,79) * b(k,46) + b(k,31) = b(k,31) - lu(k,78) * b(k,46) + b(k,30) = b(k,30) - lu(k,77) * b(k,46) + b(k,29) = b(k,29) - lu(k,76) * b(k,46) + b(k,45) = b(k,45) * lu(k,74) + b(k,44) = b(k,44) * lu(k,71) + b(k,43) = b(k,43) * lu(k,68) + b(k,42) = b(k,42) * lu(k,65) + b(k,41) = b(k,41) * lu(k,62) + b(k,40) = b(k,40) * lu(k,59) + b(k,39) = b(k,39) * lu(k,55) + b(k,38) = b(k,38) * lu(k,52) + b(k,37) = b(k,37) * lu(k,49) + b(k,36) = b(k,36) * lu(k,46) + b(k,35) = b(k,35) * lu(k,45) + b(k,33) = b(k,33) - lu(k,44) * b(k,35) + b(k,32) = b(k,32) - lu(k,43) * b(k,35) + b(k,31) = b(k,31) - lu(k,42) * b(k,35) + b(k,30) = b(k,30) - lu(k,41) * b(k,35) + b(k,29) = b(k,29) - lu(k,40) * b(k,35) + b(k,34) = b(k,34) * lu(k,39) + b(k,33) = b(k,33) - lu(k,38) * b(k,34) + b(k,32) = b(k,32) - lu(k,37) * b(k,34) + b(k,31) = b(k,31) - lu(k,36) * b(k,34) + b(k,30) = b(k,30) - lu(k,35) * b(k,34) + b(k,29) = b(k,29) - lu(k,34) * b(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + b(k,9) = b(k,9) * lu(k,9) + b(k,8) = b(k,8) * lu(k,8) + b(k,7) = b(k,7) * lu(k,7) + b(k,6) = b(k,6) * lu(k,6) + b(k,5) = b(k,5) * lu(k,5) + b(k,4) = b(k,4) * lu(k,4) + b(k,3) = b(k,3) * lu(k,3) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv10 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + call lu_slv05( avec_len, lu, b ) + call lu_slv06( avec_len, lu, b ) + call lu_slv07( avec_len, lu, b ) + call lu_slv08( avec_len, lu, b ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 new file mode 100644 index 0000000000..f8e96ac1b8 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 @@ -0,0 +1,3256 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,533) = -(rxt(k,356)*y(k,211)) + mat(k,1562) = -rxt(k,356)*y(k,1) + mat(k,1942) = rxt(k,359)*y(k,188) + mat(k,806) = rxt(k,359)*y(k,124) + mat(k,522) = -(rxt(k,360)*y(k,211)) + mat(k,1561) = -rxt(k,360)*y(k,2) + mat(k,805) = rxt(k,357)*y(k,200) + mat(k,1344) = rxt(k,357)*y(k,188) + mat(k,761) = -(rxt(k,439)*y(k,126) + rxt(k,440)*y(k,134) + rxt(k,441) & + *y(k,211)) + mat(k,1415) = -rxt(k,439)*y(k,6) + mat(k,1800) = -rxt(k,440)*y(k,6) + mat(k,1584) = -rxt(k,441)*y(k,6) + mat(k,81) = -(rxt(k,398)*y(k,211)) + mat(k,1497) = -rxt(k,398)*y(k,7) + mat(k,284) = -(rxt(k,401)*y(k,211)) + mat(k,1529) = -rxt(k,401)*y(k,8) + mat(k,374) = rxt(k,399)*y(k,200) + mat(k,1320) = rxt(k,399)*y(k,189) + mat(k,82) = .120_r8*rxt(k,398)*y(k,211) + mat(k,1498) = .120_r8*rxt(k,398)*y(k,7) + mat(k,758) = .100_r8*rxt(k,440)*y(k,134) + mat(k,784) = .100_r8*rxt(k,443)*y(k,134) + mat(k,1789) = .100_r8*rxt(k,440)*y(k,6) + .100_r8*rxt(k,443)*y(k,110) + mat(k,1930) = .500_r8*rxt(k,400)*y(k,189) + .200_r8*rxt(k,427)*y(k,217) & + + .060_r8*rxt(k,433)*y(k,219) + mat(k,375) = .500_r8*rxt(k,400)*y(k,124) + mat(k,590) = .200_r8*rxt(k,427)*y(k,124) + mat(k,606) = .060_r8*rxt(k,433)*y(k,124) + mat(k,1923) = .200_r8*rxt(k,427)*y(k,217) + .200_r8*rxt(k,433)*y(k,219) + mat(k,589) = .200_r8*rxt(k,427)*y(k,124) + mat(k,604) = .200_r8*rxt(k,433)*y(k,124) + mat(k,1939) = .200_r8*rxt(k,427)*y(k,217) + .150_r8*rxt(k,433)*y(k,219) + mat(k,592) = .200_r8*rxt(k,427)*y(k,124) + mat(k,607) = .150_r8*rxt(k,433)*y(k,124) + mat(k,1925) = .210_r8*rxt(k,433)*y(k,219) + mat(k,605) = .210_r8*rxt(k,433)*y(k,124) + mat(k,158) = -(rxt(k,361)*y(k,211)) + mat(k,1510) = -rxt(k,361)*y(k,15) + mat(k,757) = .050_r8*rxt(k,440)*y(k,134) + mat(k,783) = .050_r8*rxt(k,443)*y(k,134) + mat(k,1788) = .050_r8*rxt(k,440)*y(k,6) + .050_r8*rxt(k,443)*y(k,110) + mat(k,258) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,211)) + mat(k,1409) = -rxt(k,327)*y(k,16) + mat(k,1525) = -rxt(k,328)*y(k,16) + mat(k,1250) = -(rxt(k,210)*y(k,42) + rxt(k,211)*y(k,200) + rxt(k,212) & + *y(k,134)) + mat(k,1902) = -rxt(k,210)*y(k,17) + mat(k,1386) = -rxt(k,211)*y(k,17) + mat(k,1825) = -rxt(k,212)*y(k,17) + mat(k,1849) = 4.000_r8*rxt(k,213)*y(k,19) + (rxt(k,214)+rxt(k,215))*y(k,59) & + + rxt(k,218)*y(k,124) + rxt(k,221)*y(k,133) + rxt(k,466) & + *y(k,149) + rxt(k,222)*y(k,211) + mat(k,1690) = (rxt(k,214)+rxt(k,215))*y(k,19) + mat(k,696) = rxt(k,223)*y(k,133) + rxt(k,229)*y(k,210) + rxt(k,224)*y(k,211) + mat(k,1980) = rxt(k,218)*y(k,19) + mat(k,1879) = rxt(k,221)*y(k,19) + rxt(k,223)*y(k,81) + mat(k,1084) = rxt(k,466)*y(k,19) + mat(k,1467) = rxt(k,229)*y(k,81) + mat(k,1614) = rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) + mat(k,1843) = rxt(k,216)*y(k,59) + mat(k,1684) = rxt(k,216)*y(k,19) + mat(k,1289) = (rxt(k,516)+rxt(k,521))*y(k,91) + mat(k,639) = (rxt(k,516)+rxt(k,521))*y(k,85) + mat(k,1862) = -(4._r8*rxt(k,213)*y(k,19) + (rxt(k,214) + rxt(k,215) + rxt(k,216) & + ) * y(k,59) + rxt(k,217)*y(k,200) + rxt(k,218)*y(k,124) & + + rxt(k,219)*y(k,125) + rxt(k,221)*y(k,133) + rxt(k,222) & + *y(k,211) + rxt(k,466)*y(k,149)) + mat(k,1703) = -(rxt(k,214) + rxt(k,215) + rxt(k,216)) * y(k,19) + mat(k,1399) = -rxt(k,217)*y(k,19) + mat(k,1993) = -rxt(k,218)*y(k,19) + mat(k,1778) = -rxt(k,219)*y(k,19) + mat(k,1892) = -rxt(k,221)*y(k,19) + mat(k,1627) = -rxt(k,222)*y(k,19) + mat(k,1092) = -rxt(k,466)*y(k,19) + mat(k,1256) = rxt(k,212)*y(k,134) + mat(k,449) = rxt(k,220)*y(k,133) + mat(k,700) = rxt(k,230)*y(k,210) + mat(k,645) = rxt(k,225)*y(k,133) + mat(k,1892) = mat(k,1892) + rxt(k,220)*y(k,20) + rxt(k,225)*y(k,91) + mat(k,1838) = rxt(k,212)*y(k,17) + mat(k,1480) = rxt(k,230)*y(k,81) + mat(k,443) = -(rxt(k,220)*y(k,133)) + mat(k,1869) = -rxt(k,220)*y(k,20) + mat(k,1845) = rxt(k,219)*y(k,125) + mat(k,1750) = rxt(k,219)*y(k,19) + mat(k,164) = -(rxt(k,402)*y(k,211)) + mat(k,1511) = -rxt(k,402)*y(k,22) + mat(k,1921) = rxt(k,405)*y(k,190) + mat(k,332) = rxt(k,405)*y(k,124) + mat(k,240) = -(rxt(k,404)*y(k,211)) + mat(k,1522) = -rxt(k,404)*y(k,23) + mat(k,333) = rxt(k,403)*y(k,200) + mat(k,1317) = rxt(k,403)*y(k,190) + mat(k,199) = -(rxt(k,276)*y(k,56) + rxt(k,277)*y(k,211)) + mat(k,1709) = -rxt(k,276)*y(k,24) + mat(k,1516) = -rxt(k,277)*y(k,24) + mat(k,451) = -(rxt(k,278)*y(k,56) + rxt(k,279)*y(k,134) + rxt(k,304)*y(k,211)) + mat(k,1711) = -rxt(k,278)*y(k,25) + mat(k,1793) = -rxt(k,279)*y(k,25) + mat(k,1552) = -rxt(k,304)*y(k,25) + mat(k,172) = -(rxt(k,284)*y(k,211)) + mat(k,1513) = -rxt(k,284)*y(k,26) + mat(k,684) = .800_r8*rxt(k,280)*y(k,191) + .200_r8*rxt(k,281)*y(k,195) + mat(k,1632) = .200_r8*rxt(k,281)*y(k,191) + mat(k,245) = -(rxt(k,285)*y(k,211)) + mat(k,1523) = -rxt(k,285)*y(k,27) + mat(k,685) = rxt(k,282)*y(k,200) + mat(k,1318) = rxt(k,282)*y(k,191) + mat(k,205) = -(rxt(k,286)*y(k,56) + rxt(k,287)*y(k,211)) + mat(k,1710) = -rxt(k,286)*y(k,28) + mat(k,1517) = -rxt(k,287)*y(k,28) + mat(k,841) = -(rxt(k,307)*y(k,126) + rxt(k,308)*y(k,134) + rxt(k,325) & + *y(k,211)) + mat(k,1419) = -rxt(k,307)*y(k,29) + mat(k,1804) = -rxt(k,308)*y(k,29) + mat(k,1589) = -rxt(k,325)*y(k,29) + mat(k,710) = .130_r8*rxt(k,385)*y(k,134) + mat(k,1804) = mat(k,1804) + .130_r8*rxt(k,385)*y(k,98) + mat(k,314) = -(rxt(k,312)*y(k,211)) + mat(k,1533) = -rxt(k,312)*y(k,30) + mat(k,665) = rxt(k,310)*y(k,200) + mat(k,1324) = rxt(k,310)*y(k,192) + mat(k,55) = -(rxt(k,313)*y(k,211)) + mat(k,1494) = -rxt(k,313)*y(k,31) + mat(k,176) = -(rxt(k,408)*y(k,211)) + mat(k,1514) = -rxt(k,408)*y(k,32) + mat(k,513) = rxt(k,406)*y(k,200) + mat(k,1312) = rxt(k,406)*y(k,193) + mat(k,1917) = -(rxt(k,174)*y(k,56) + rxt(k,210)*y(k,17) + rxt(k,254)*y(k,200) & + + rxt(k,255)*y(k,126) + rxt(k,256)*y(k,133) + rxt(k,257) & + *y(k,211)) + mat(k,1739) = -rxt(k,174)*y(k,42) + mat(k,1258) = -rxt(k,210)*y(k,42) + mat(k,1401) = -rxt(k,254)*y(k,42) + mat(k,1458) = -rxt(k,255)*y(k,42) + mat(k,1894) = -rxt(k,256)*y(k,42) + mat(k,1629) = -rxt(k,257)*y(k,42) + mat(k,542) = .400_r8*rxt(k,356)*y(k,211) + mat(k,776) = .340_r8*rxt(k,440)*y(k,134) + mat(k,265) = .500_r8*rxt(k,327)*y(k,126) + mat(k,458) = rxt(k,279)*y(k,134) + mat(k,853) = .500_r8*rxt(k,308)*y(k,134) + mat(k,395) = .500_r8*rxt(k,296)*y(k,211) + mat(k,664) = rxt(k,262)*y(k,211) + mat(k,324) = .300_r8*rxt(k,263)*y(k,211) + mat(k,1705) = rxt(k,181)*y(k,195) + mat(k,869) = .800_r8*rxt(k,301)*y(k,211) + mat(k,723) = .910_r8*rxt(k,385)*y(k,134) + mat(k,475) = .300_r8*rxt(k,376)*y(k,211) + mat(k,1056) = .800_r8*rxt(k,380)*y(k,195) + mat(k,1069) = .120_r8*rxt(k,338)*y(k,134) + mat(k,422) = .500_r8*rxt(k,351)*y(k,211) + mat(k,802) = .340_r8*rxt(k,443)*y(k,134) + mat(k,1141) = .600_r8*rxt(k,352)*y(k,134) + mat(k,1995) = .100_r8*rxt(k,358)*y(k,188) + rxt(k,261)*y(k,195) & + + .500_r8*rxt(k,329)*y(k,197) + .500_r8*rxt(k,298)*y(k,199) & + + .920_r8*rxt(k,368)*y(k,202) + .250_r8*rxt(k,336)*y(k,204) & + + rxt(k,345)*y(k,206) + rxt(k,319)*y(k,213) + rxt(k,323) & + *y(k,214) + .340_r8*rxt(k,452)*y(k,215) + .320_r8*rxt(k,457) & + *y(k,216) + .250_r8*rxt(k,393)*y(k,218) + mat(k,1458) = mat(k,1458) + .500_r8*rxt(k,327)*y(k,16) + rxt(k,369)*y(k,202) & + + .250_r8*rxt(k,335)*y(k,204) + rxt(k,346)*y(k,206) + mat(k,1840) = .340_r8*rxt(k,440)*y(k,6) + rxt(k,279)*y(k,25) & + + .500_r8*rxt(k,308)*y(k,29) + .910_r8*rxt(k,385)*y(k,98) & + + .120_r8*rxt(k,338)*y(k,105) + .340_r8*rxt(k,443)*y(k,110) & + + .600_r8*rxt(k,352)*y(k,111) + mat(k,362) = rxt(k,303)*y(k,211) + mat(k,893) = .680_r8*rxt(k,461)*y(k,211) + mat(k,817) = .100_r8*rxt(k,358)*y(k,124) + mat(k,693) = .700_r8*rxt(k,281)*y(k,195) + mat(k,673) = rxt(k,309)*y(k,195) + mat(k,1245) = rxt(k,292)*y(k,195) + rxt(k,365)*y(k,202) + .250_r8*rxt(k,332) & + *y(k,204) + rxt(k,341)*y(k,206) + .250_r8*rxt(k,390)*y(k,218) + mat(k,1679) = rxt(k,181)*y(k,59) + .800_r8*rxt(k,380)*y(k,101) + rxt(k,261) & + *y(k,124) + .700_r8*rxt(k,281)*y(k,191) + rxt(k,309)*y(k,192) & + + rxt(k,292)*y(k,194) + (4.000_r8*rxt(k,258)+2.000_r8*rxt(k,259)) & + *y(k,195) + 1.500_r8*rxt(k,366)*y(k,202) + .750_r8*rxt(k,371) & + *y(k,203) + .880_r8*rxt(k,333)*y(k,204) + 2.000_r8*rxt(k,342) & + *y(k,206) + .750_r8*rxt(k,445)*y(k,209) + .800_r8*rxt(k,321) & + *y(k,214) + .930_r8*rxt(k,450)*y(k,215) + .950_r8*rxt(k,455) & + *y(k,216) + .800_r8*rxt(k,391)*y(k,218) + mat(k,465) = .500_r8*rxt(k,329)*y(k,124) + mat(k,581) = .500_r8*rxt(k,298)*y(k,124) + mat(k,1401) = mat(k,1401) + .450_r8*rxt(k,343)*y(k,206) + .150_r8*rxt(k,322) & + *y(k,214) + mat(k,1121) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + rxt(k,365) & + *y(k,194) + 1.500_r8*rxt(k,366)*y(k,195) + mat(k,1197) = .750_r8*rxt(k,371)*y(k,195) + mat(k,1163) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + + .250_r8*rxt(k,332)*y(k,194) + .880_r8*rxt(k,333)*y(k,195) + mat(k,1215) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,341)*y(k,194) & + + 2.000_r8*rxt(k,342)*y(k,195) + .450_r8*rxt(k,343)*y(k,200) & + + 4.000_r8*rxt(k,344)*y(k,206) + mat(k,979) = .750_r8*rxt(k,445)*y(k,195) + mat(k,1629) = mat(k,1629) + .400_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,296) & + *y(k,51) + rxt(k,262)*y(k,52) + .300_r8*rxt(k,263)*y(k,53) & + + .800_r8*rxt(k,301)*y(k,74) + .300_r8*rxt(k,376)*y(k,99) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,138) & + + .680_r8*rxt(k,461)*y(k,177) + mat(k,636) = rxt(k,319)*y(k,124) + mat(k,992) = rxt(k,323)*y(k,124) + .800_r8*rxt(k,321)*y(k,195) & + + .150_r8*rxt(k,322)*y(k,200) + mat(k,959) = .340_r8*rxt(k,452)*y(k,124) + .930_r8*rxt(k,450)*y(k,195) + mat(k,940) = .320_r8*rxt(k,457)*y(k,124) + .950_r8*rxt(k,455)*y(k,195) + mat(k,1033) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,390)*y(k,194) & + + .800_r8*rxt(k,391)*y(k,195) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,996) = -(rxt(k,288)*y(k,126) + rxt(k,289)*y(k,211)) + mat(k,1431) = -rxt(k,288)*y(k,45) + mat(k,1601) = -rxt(k,289)*y(k,45) + mat(k,537) = .800_r8*rxt(k,356)*y(k,211) + mat(k,261) = rxt(k,327)*y(k,126) + mat(k,173) = rxt(k,284)*y(k,211) + mat(k,247) = .500_r8*rxt(k,285)*y(k,211) + mat(k,844) = .500_r8*rxt(k,308)*y(k,134) + mat(k,1128) = .100_r8*rxt(k,352)*y(k,134) + mat(k,1969) = .400_r8*rxt(k,358)*y(k,188) + rxt(k,283)*y(k,191) & + + .270_r8*rxt(k,311)*y(k,192) + rxt(k,329)*y(k,197) + rxt(k,348) & + *y(k,208) + rxt(k,319)*y(k,213) + mat(k,1431) = mat(k,1431) + rxt(k,327)*y(k,16) + mat(k,1814) = .500_r8*rxt(k,308)*y(k,29) + .100_r8*rxt(k,352)*y(k,111) + mat(k,811) = .400_r8*rxt(k,358)*y(k,124) + mat(k,688) = rxt(k,283)*y(k,124) + 3.200_r8*rxt(k,280)*y(k,191) & + + .800_r8*rxt(k,281)*y(k,195) + mat(k,668) = .270_r8*rxt(k,311)*y(k,124) + mat(k,1654) = .800_r8*rxt(k,281)*y(k,191) + mat(k,462) = rxt(k,329)*y(k,124) + mat(k,1374) = .200_r8*rxt(k,347)*y(k,208) + mat(k,545) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,200) + mat(k,1601) = mat(k,1601) + .800_r8*rxt(k,356)*y(k,1) + rxt(k,284)*y(k,26) & + + .500_r8*rxt(k,285)*y(k,27) + mat(k,632) = rxt(k,319)*y(k,124) + mat(k,52) = -(rxt(k,290)*y(k,211)) + mat(k,1493) = -rxt(k,290)*y(k,47) + mat(k,819) = -(rxt(k,326)*y(k,211)) + mat(k,1587) = -rxt(k,326)*y(k,48) + mat(k,536) = .800_r8*rxt(k,356)*y(k,211) + mat(k,763) = .520_r8*rxt(k,440)*y(k,134) + mat(k,260) = .500_r8*rxt(k,327)*y(k,126) + mat(k,789) = .520_r8*rxt(k,443)*y(k,134) + mat(k,1957) = .250_r8*rxt(k,358)*y(k,188) + .820_r8*rxt(k,311)*y(k,192) & + + .500_r8*rxt(k,329)*y(k,197) + .270_r8*rxt(k,452)*y(k,215) & + + .040_r8*rxt(k,457)*y(k,216) + mat(k,1418) = .500_r8*rxt(k,327)*y(k,16) + mat(k,1803) = .520_r8*rxt(k,440)*y(k,6) + .520_r8*rxt(k,443)*y(k,110) + mat(k,885) = .500_r8*rxt(k,461)*y(k,211) + mat(k,810) = .250_r8*rxt(k,358)*y(k,124) + mat(k,667) = .820_r8*rxt(k,311)*y(k,124) + .820_r8*rxt(k,309)*y(k,195) + mat(k,1643) = .820_r8*rxt(k,309)*y(k,192) + .150_r8*rxt(k,450)*y(k,215) & + + .025_r8*rxt(k,455)*y(k,216) + mat(k,460) = .500_r8*rxt(k,329)*y(k,124) + mat(k,1587) = mat(k,1587) + .800_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,461) & + *y(k,177) + mat(k,946) = .270_r8*rxt(k,452)*y(k,124) + .150_r8*rxt(k,450)*y(k,195) + mat(k,924) = .040_r8*rxt(k,457)*y(k,124) + .025_r8*rxt(k,455)*y(k,195) + mat(k,1072) = -(rxt(k,314)*y(k,126) + rxt(k,315)*y(k,211)) + mat(k,1435) = -rxt(k,314)*y(k,49) + mat(k,1606) = -rxt(k,315)*y(k,49) + mat(k,916) = rxt(k,316)*y(k,211) + mat(k,1061) = .880_r8*rxt(k,338)*y(k,134) + mat(k,1129) = .500_r8*rxt(k,352)*y(k,134) + mat(k,1973) = .170_r8*rxt(k,411)*y(k,196) + .050_r8*rxt(k,374)*y(k,203) & + + .250_r8*rxt(k,336)*y(k,204) + .170_r8*rxt(k,417)*y(k,207) & + + .400_r8*rxt(k,427)*y(k,217) + .250_r8*rxt(k,393)*y(k,218) & + + .540_r8*rxt(k,433)*y(k,219) + .510_r8*rxt(k,436)*y(k,220) + mat(k,1435) = mat(k,1435) + .050_r8*rxt(k,375)*y(k,203) + .250_r8*rxt(k,335) & + *y(k,204) + .250_r8*rxt(k,394)*y(k,218) + mat(k,733) = rxt(k,317)*y(k,211) + mat(k,1817) = .880_r8*rxt(k,338)*y(k,105) + .500_r8*rxt(k,352)*y(k,111) + mat(k,1230) = .250_r8*rxt(k,332)*y(k,204) + .250_r8*rxt(k,390)*y(k,218) + mat(k,1658) = .240_r8*rxt(k,333)*y(k,204) + .500_r8*rxt(k,321)*y(k,214) & + + .100_r8*rxt(k,391)*y(k,218) + mat(k,623) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,200) + mat(k,1379) = .070_r8*rxt(k,410)*y(k,196) + .070_r8*rxt(k,416)*y(k,207) + mat(k,1183) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1152) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + + .250_r8*rxt(k,332)*y(k,194) + .240_r8*rxt(k,333)*y(k,195) + mat(k,746) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,200) + mat(k,1606) = mat(k,1606) + rxt(k,316)*y(k,95) + rxt(k,317)*y(k,127) + mat(k,986) = .500_r8*rxt(k,321)*y(k,195) + mat(k,599) = .400_r8*rxt(k,427)*y(k,124) + mat(k,1025) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,194) + .100_r8*rxt(k,391)*y(k,195) + mat(k,615) = .540_r8*rxt(k,433)*y(k,124) + mat(k,386) = .510_r8*rxt(k,436)*y(k,124) + mat(k,431) = -(rxt(k,295)*y(k,211)) + mat(k,1550) = -rxt(k,295)*y(k,50) + mat(k,837) = .120_r8*rxt(k,308)*y(k,134) + mat(k,1792) = .120_r8*rxt(k,308)*y(k,29) + mat(k,1221) = .100_r8*rxt(k,292)*y(k,195) + .150_r8*rxt(k,293)*y(k,200) + mat(k,1636) = .100_r8*rxt(k,292)*y(k,194) + mat(k,1337) = .150_r8*rxt(k,293)*y(k,194) + .150_r8*rxt(k,343)*y(k,206) + mat(k,1202) = .150_r8*rxt(k,343)*y(k,200) + mat(k,391) = -(rxt(k,296)*y(k,211)) + mat(k,1544) = -rxt(k,296)*y(k,51) + mat(k,1220) = .400_r8*rxt(k,293)*y(k,200) + mat(k,1335) = .400_r8*rxt(k,293)*y(k,194) + .400_r8*rxt(k,343)*y(k,206) + mat(k,1200) = .400_r8*rxt(k,343)*y(k,200) + mat(k,661) = -(rxt(k,262)*y(k,211)) + mat(k,1574) = -rxt(k,262)*y(k,52) + mat(k,1038) = .200_r8*rxt(k,380)*y(k,195) + mat(k,686) = .300_r8*rxt(k,281)*y(k,195) + mat(k,1638) = .200_r8*rxt(k,380)*y(k,101) + .300_r8*rxt(k,281)*y(k,191) & + + 2.000_r8*rxt(k,259)*y(k,195) + .250_r8*rxt(k,366)*y(k,202) & + + .250_r8*rxt(k,371)*y(k,203) + .250_r8*rxt(k,333)*y(k,204) & + + .250_r8*rxt(k,445)*y(k,209) + .500_r8*rxt(k,321)*y(k,214) & + + .250_r8*rxt(k,450)*y(k,215) + .250_r8*rxt(k,455)*y(k,216) & + + .300_r8*rxt(k,391)*y(k,218) + mat(k,1098) = .250_r8*rxt(k,366)*y(k,195) + mat(k,1171) = .250_r8*rxt(k,371)*y(k,195) + mat(k,1145) = .250_r8*rxt(k,333)*y(k,195) + mat(k,964) = .250_r8*rxt(k,445)*y(k,195) + mat(k,983) = .500_r8*rxt(k,321)*y(k,195) + mat(k,945) = .250_r8*rxt(k,450)*y(k,195) + mat(k,923) = .250_r8*rxt(k,455)*y(k,195) + mat(k,1019) = .300_r8*rxt(k,391)*y(k,195) + mat(k,320) = -(rxt(k,263)*y(k,211)) + mat(k,1534) = -rxt(k,263)*y(k,53) + mat(k,1635) = rxt(k,260)*y(k,200) + mat(k,1325) = rxt(k,260)*y(k,195) + mat(k,1734) = -(rxt(k,174)*y(k,42) + rxt(k,176)*y(k,77) + rxt(k,177)*y(k,79) & + + (rxt(k,178) + rxt(k,179)) * y(k,200) + rxt(k,180)*y(k,134) & + + rxt(k,187)*y(k,60) + rxt(k,196)*y(k,92) + rxt(k,286)*y(k,28)) + mat(k,1912) = -rxt(k,174)*y(k,56) + mat(k,1015) = -rxt(k,176)*y(k,56) + mat(k,480) = -rxt(k,177)*y(k,56) + mat(k,1396) = -(rxt(k,178) + rxt(k,179)) * y(k,56) + mat(k,1835) = -rxt(k,180)*y(k,56) + mat(k,833) = -rxt(k,187)*y(k,56) + mat(k,681) = -rxt(k,196)*y(k,56) + mat(k,209) = -rxt(k,286)*y(k,56) + mat(k,1859) = rxt(k,215)*y(k,59) + mat(k,1700) = rxt(k,215)*y(k,19) + (4.000_r8*rxt(k,182)+2.000_r8*rxt(k,184)) & + *y(k,59) + rxt(k,186)*y(k,124) + rxt(k,191)*y(k,133) & + + rxt(k,467)*y(k,149) + rxt(k,181)*y(k,195) + rxt(k,192) & + *y(k,211) + mat(k,103) = rxt(k,236)*y(k,210) + mat(k,1303) = rxt(k,194)*y(k,133) + rxt(k,206)*y(k,210) + rxt(k,195)*y(k,211) + mat(k,1990) = rxt(k,186)*y(k,59) + mat(k,1889) = rxt(k,191)*y(k,59) + rxt(k,194)*y(k,85) + mat(k,1089) = rxt(k,467)*y(k,59) + mat(k,1674) = rxt(k,181)*y(k,59) + mat(k,1477) = rxt(k,236)*y(k,65) + rxt(k,206)*y(k,85) + mat(k,1624) = rxt(k,192)*y(k,59) + rxt(k,195)*y(k,85) + mat(k,1708) = rxt(k,187)*y(k,60) + mat(k,1683) = 2.000_r8*rxt(k,183)*y(k,59) + mat(k,825) = rxt(k,187)*y(k,56) + (rxt(k,514)+rxt(k,519)+rxt(k,524))*y(k,85) + mat(k,1288) = (rxt(k,514)+rxt(k,519)+rxt(k,524))*y(k,60) + (rxt(k,509) & + +rxt(k,515)+rxt(k,520))*y(k,92) + mat(k,676) = (rxt(k,509)+rxt(k,515)+rxt(k,520))*y(k,85) + mat(k,1682) = 2.000_r8*rxt(k,208)*y(k,59) + mat(k,1699) = -(rxt(k,181)*y(k,195) + (4._r8*rxt(k,182) + 4._r8*rxt(k,183) & + + 4._r8*rxt(k,184) + 4._r8*rxt(k,208)) * y(k,59) + rxt(k,185) & + *y(k,200) + rxt(k,186)*y(k,124) + rxt(k,188)*y(k,125) + rxt(k,191) & + *y(k,133) + (rxt(k,192) + rxt(k,193)) * y(k,211) + (rxt(k,214) & + + rxt(k,215) + rxt(k,216)) * y(k,19) + rxt(k,467)*y(k,149)) + mat(k,1673) = -rxt(k,181)*y(k,59) + mat(k,1395) = -rxt(k,185)*y(k,59) + mat(k,1989) = -rxt(k,186)*y(k,59) + mat(k,1774) = -rxt(k,188)*y(k,59) + mat(k,1888) = -rxt(k,191)*y(k,59) + mat(k,1623) = -(rxt(k,192) + rxt(k,193)) * y(k,59) + mat(k,1858) = -(rxt(k,214) + rxt(k,215) + rxt(k,216)) * y(k,59) + mat(k,1088) = -rxt(k,467)*y(k,59) + mat(k,1733) = rxt(k,196)*y(k,92) + rxt(k,180)*y(k,134) + rxt(k,179)*y(k,200) + mat(k,832) = rxt(k,189)*y(k,133) + mat(k,1302) = rxt(k,207)*y(k,210) + mat(k,680) = rxt(k,196)*y(k,56) + rxt(k,197)*y(k,133) + rxt(k,198)*y(k,211) + mat(k,1888) = mat(k,1888) + rxt(k,189)*y(k,60) + rxt(k,197)*y(k,92) + mat(k,1834) = rxt(k,180)*y(k,56) + mat(k,232) = rxt(k,472)*y(k,149) + mat(k,1088) = mat(k,1088) + rxt(k,472)*y(k,135) + mat(k,1395) = mat(k,1395) + rxt(k,179)*y(k,56) + mat(k,1476) = rxt(k,207)*y(k,85) + mat(k,1623) = mat(k,1623) + rxt(k,198)*y(k,92) + mat(k,827) = -(rxt(k,187)*y(k,56) + rxt(k,189)*y(k,133) + rxt(k,190)*y(k,211) & + + (rxt(k,514) + rxt(k,519) + rxt(k,524)) * y(k,85)) + mat(k,1718) = -rxt(k,187)*y(k,60) + mat(k,1875) = -rxt(k,189)*y(k,60) + mat(k,1588) = -rxt(k,190)*y(k,60) + mat(k,1292) = -(rxt(k,514) + rxt(k,519) + rxt(k,524)) * y(k,60) + mat(k,1688) = rxt(k,188)*y(k,125) + mat(k,1758) = rxt(k,188)*y(k,59) + mat(k,911) = -((rxt(k,265) + rxt(k,275)) * y(k,211)) + mat(k,1595) = -(rxt(k,265) + rxt(k,275)) * y(k,62) + mat(k,766) = .230_r8*rxt(k,440)*y(k,134) + mat(k,1249) = rxt(k,210)*y(k,42) + mat(k,202) = .350_r8*rxt(k,277)*y(k,211) + mat(k,454) = .630_r8*rxt(k,279)*y(k,134) + mat(k,842) = .560_r8*rxt(k,308)*y(k,134) + mat(k,1900) = rxt(k,210)*y(k,17) + rxt(k,174)*y(k,56) + rxt(k,255)*y(k,126) & + + rxt(k,256)*y(k,133) + rxt(k,257)*y(k,211) + mat(k,1071) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,211) + mat(k,1720) = rxt(k,174)*y(k,42) + mat(k,740) = rxt(k,302)*y(k,211) + mat(k,711) = .620_r8*rxt(k,385)*y(k,134) + mat(k,1059) = .650_r8*rxt(k,338)*y(k,134) + mat(k,792) = .230_r8*rxt(k,443)*y(k,134) + mat(k,1126) = .560_r8*rxt(k,352)*y(k,134) + mat(k,1963) = .170_r8*rxt(k,411)*y(k,196) + .220_r8*rxt(k,336)*y(k,204) & + + .400_r8*rxt(k,414)*y(k,205) + .350_r8*rxt(k,417)*y(k,207) & + + .225_r8*rxt(k,452)*y(k,215) + .250_r8*rxt(k,393)*y(k,218) + mat(k,1425) = rxt(k,255)*y(k,42) + rxt(k,314)*y(k,49) + .220_r8*rxt(k,335) & + *y(k,204) + .500_r8*rxt(k,394)*y(k,218) + mat(k,1876) = rxt(k,256)*y(k,42) + rxt(k,462)*y(k,136) + mat(k,1808) = .230_r8*rxt(k,440)*y(k,6) + .630_r8*rxt(k,279)*y(k,25) & + + .560_r8*rxt(k,308)*y(k,29) + .620_r8*rxt(k,385)*y(k,98) & + + .650_r8*rxt(k,338)*y(k,105) + .230_r8*rxt(k,443)*y(k,110) & + + .560_r8*rxt(k,352)*y(k,111) + mat(k,253) = rxt(k,462)*y(k,133) + rxt(k,463)*y(k,211) + mat(k,887) = .700_r8*rxt(k,461)*y(k,211) + mat(k,1225) = .220_r8*rxt(k,332)*y(k,204) + .250_r8*rxt(k,390)*y(k,218) + mat(k,1648) = .110_r8*rxt(k,333)*y(k,204) + .125_r8*rxt(k,450)*y(k,215) & + + .200_r8*rxt(k,391)*y(k,218) + mat(k,622) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,200) + mat(k,1368) = .070_r8*rxt(k,410)*y(k,196) + .160_r8*rxt(k,413)*y(k,205) & + + .140_r8*rxt(k,416)*y(k,207) + mat(k,1148) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + + .220_r8*rxt(k,332)*y(k,194) + .110_r8*rxt(k,333)*y(k,195) + mat(k,585) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,200) + mat(k,745) = .350_r8*rxt(k,417)*y(k,124) + .140_r8*rxt(k,416)*y(k,200) + mat(k,1595) = mat(k,1595) + .350_r8*rxt(k,277)*y(k,24) + rxt(k,257)*y(k,42) & + + rxt(k,315)*y(k,49) + rxt(k,302)*y(k,75) + rxt(k,463)*y(k,136) & + + .700_r8*rxt(k,461)*y(k,177) + mat(k,949) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,195) + mat(k,1022) = .250_r8*rxt(k,393)*y(k,124) + .500_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,194) + .200_r8*rxt(k,391)*y(k,195) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,59) = -(rxt(k,235)*y(k,210)) + mat(k,1461) = -rxt(k,235)*y(k,64) + mat(k,100) = -(rxt(k,236)*y(k,210)) + mat(k,1463) = -rxt(k,236)*y(k,65) + mat(k,116) = -(rxt(k,409)*y(k,211)) + mat(k,1503) = -rxt(k,409)*y(k,66) + mat(k,110) = .180_r8*rxt(k,429)*y(k,211) + mat(k,1503) = mat(k,1503) + .180_r8*rxt(k,429)*y(k,179) + mat(k,193) = -(rxt(k,476)*y(k,126) + (rxt(k,477) + rxt(k,479)) * y(k,211)) + mat(k,1407) = -rxt(k,476)*y(k,67) + mat(k,1515) = -(rxt(k,477) + rxt(k,479)) * y(k,67) + mat(k,574) = rxt(k,297)*y(k,200) + mat(k,1310) = rxt(k,297)*y(k,199) + mat(k,649) = -(rxt(k,232)*y(k,77) + rxt(k,233)*y(k,221) + rxt(k,234)*y(k,89)) + mat(k,1006) = -rxt(k,232)*y(k,73) + mat(k,2001) = -rxt(k,233)*y(k,73) + mat(k,1261) = -rxt(k,234)*y(k,73) + mat(k,60) = 2.000_r8*rxt(k,235)*y(k,210) + mat(k,101) = rxt(k,236)*y(k,210) + mat(k,1464) = 2.000_r8*rxt(k,235)*y(k,64) + rxt(k,236)*y(k,65) + mat(k,865) = -(rxt(k,301)*y(k,211)) + mat(k,1591) = -rxt(k,301)*y(k,74) + mat(k,468) = .700_r8*rxt(k,376)*y(k,211) + mat(k,425) = .500_r8*rxt(k,377)*y(k,211) + mat(k,280) = rxt(k,388)*y(k,211) + mat(k,1959) = .050_r8*rxt(k,374)*y(k,203) + .530_r8*rxt(k,336)*y(k,204) & + + .225_r8*rxt(k,452)*y(k,215) + .250_r8*rxt(k,393)*y(k,218) + mat(k,1421) = .050_r8*rxt(k,375)*y(k,203) + .530_r8*rxt(k,335)*y(k,204) & + + .250_r8*rxt(k,394)*y(k,218) + mat(k,1223) = .530_r8*rxt(k,332)*y(k,204) + .250_r8*rxt(k,390)*y(k,218) + mat(k,1645) = .260_r8*rxt(k,333)*y(k,204) + .125_r8*rxt(k,450)*y(k,215) & + + .100_r8*rxt(k,391)*y(k,218) + mat(k,1175) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1146) = .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335)*y(k,126) & + + .530_r8*rxt(k,332)*y(k,194) + .260_r8*rxt(k,333)*y(k,195) + mat(k,1591) = mat(k,1591) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + rxt(k,388)*y(k,115) + mat(k,947) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,195) + mat(k,1021) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,194) + .100_r8*rxt(k,391)*y(k,195) + mat(k,739) = -(rxt(k,302)*y(k,211)) + mat(k,1582) = -rxt(k,302)*y(k,75) + mat(k,201) = .650_r8*rxt(k,277)*y(k,211) + mat(k,864) = .200_r8*rxt(k,301)*y(k,211) + mat(k,872) = rxt(k,389)*y(k,211) + mat(k,1954) = rxt(k,400)*y(k,189) + .050_r8*rxt(k,374)*y(k,203) & + + .400_r8*rxt(k,414)*y(k,205) + .170_r8*rxt(k,417)*y(k,207) & + + .700_r8*rxt(k,420)*y(k,212) + .600_r8*rxt(k,427)*y(k,217) & + + .250_r8*rxt(k,393)*y(k,218) + .340_r8*rxt(k,433)*y(k,219) & + + .170_r8*rxt(k,436)*y(k,220) + mat(k,1414) = .050_r8*rxt(k,375)*y(k,203) + .250_r8*rxt(k,394)*y(k,218) + mat(k,378) = rxt(k,400)*y(k,124) + mat(k,1222) = .250_r8*rxt(k,390)*y(k,218) + mat(k,1642) = .100_r8*rxt(k,391)*y(k,218) + mat(k,1361) = .160_r8*rxt(k,413)*y(k,205) + .070_r8*rxt(k,416)*y(k,207) + mat(k,1173) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,584) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,200) + mat(k,743) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,200) + mat(k,1582) = mat(k,1582) + .650_r8*rxt(k,277)*y(k,24) + .200_r8*rxt(k,301) & + *y(k,74) + rxt(k,389)*y(k,116) + mat(k,348) = .700_r8*rxt(k,420)*y(k,124) + mat(k,596) = .600_r8*rxt(k,427)*y(k,124) + mat(k,1020) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,194) + .100_r8*rxt(k,391)*y(k,195) + mat(k,612) = .340_r8*rxt(k,433)*y(k,124) + mat(k,385) = .170_r8*rxt(k,436)*y(k,124) + mat(k,1276) = -((rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,200) + rxt(k,140) & + *y(k,134)) + mat(k,1388) = -(rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,76) + mat(k,1827) = -rxt(k,140)*y(k,76) + mat(k,1904) = rxt(k,257)*y(k,211) + mat(k,1726) = rxt(k,176)*y(k,77) + mat(k,912) = rxt(k,275)*y(k,211) + mat(k,652) = rxt(k,232)*y(k,77) + mat(k,1009) = rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,132)*y(k,133) & + + rxt(k,124)*y(k,210) + rxt(k,141)*y(k,211) + mat(k,697) = rxt(k,230)*y(k,210) + mat(k,1295) = rxt(k,207)*y(k,210) + mat(k,267) = rxt(k,162)*y(k,211) + mat(k,1881) = rxt(k,132)*y(k,77) + rxt(k,144)*y(k,211) + mat(k,255) = rxt(k,463)*y(k,211) + mat(k,399) = rxt(k,468)*y(k,211) + mat(k,1085) = rxt(k,473)*y(k,211) + mat(k,1469) = rxt(k,124)*y(k,77) + rxt(k,230)*y(k,81) + rxt(k,207)*y(k,85) + mat(k,1616) = rxt(k,257)*y(k,42) + rxt(k,275)*y(k,62) + rxt(k,141)*y(k,77) & + + rxt(k,162)*y(k,112) + rxt(k,144)*y(k,133) + rxt(k,463) & + *y(k,136) + rxt(k,468)*y(k,147) + rxt(k,473)*y(k,149) + mat(k,1007) = -(rxt(k,124)*y(k,210) + rxt(k,132)*y(k,133) + rxt(k,141) & + *y(k,211) + rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73)) + mat(k,1466) = -rxt(k,124)*y(k,77) + mat(k,1877) = -rxt(k,132)*y(k,77) + mat(k,1602) = -rxt(k,141)*y(k,77) + mat(k,1722) = -rxt(k,176)*y(k,77) + mat(k,650) = -rxt(k,232)*y(k,77) + mat(k,1274) = rxt(k,134)*y(k,200) + mat(k,1375) = rxt(k,134)*y(k,76) + mat(k,476) = -(rxt(k,133)*y(k,133) + rxt(k,142)*y(k,211) + rxt(k,177)*y(k,56)) + mat(k,1870) = -rxt(k,133)*y(k,79) + mat(k,1555) = -rxt(k,142)*y(k,79) + mat(k,1712) = -rxt(k,177)*y(k,79) + mat(k,1339) = 2.000_r8*rxt(k,148)*y(k,200) + mat(k,1555) = mat(k,1555) + 2.000_r8*rxt(k,147)*y(k,211) + mat(k,167) = rxt(k,475)*y(k,221) + mat(k,1998) = rxt(k,475)*y(k,151) + mat(k,695) = -(rxt(k,223)*y(k,133) + rxt(k,224)*y(k,211) + (rxt(k,229) & + + rxt(k,230)) * y(k,210)) + mat(k,1873) = -rxt(k,223)*y(k,81) + mat(k,1578) = -rxt(k,224)*y(k,81) + mat(k,1465) = -(rxt(k,229) + rxt(k,230)) * y(k,81) + mat(k,1248) = rxt(k,210)*y(k,42) + rxt(k,211)*y(k,200) + mat(k,1899) = rxt(k,210)*y(k,17) + mat(k,1359) = rxt(k,211)*y(k,17) + mat(k,1296) = -(rxt(k,194)*y(k,133) + rxt(k,195)*y(k,211) + (rxt(k,206) & + + rxt(k,207)) * y(k,210) + (rxt(k,509) + rxt(k,515) + rxt(k,520) & + ) * y(k,92) + (rxt(k,514) + rxt(k,519) + rxt(k,524)) * y(k,60) & + + (rxt(k,516) + rxt(k,521)) * y(k,91)) + mat(k,1882) = -rxt(k,194)*y(k,85) + mat(k,1617) = -rxt(k,195)*y(k,85) + mat(k,1470) = -(rxt(k,206) + rxt(k,207)) * y(k,85) + mat(k,678) = -(rxt(k,509) + rxt(k,515) + rxt(k,520)) * y(k,85) + mat(k,829) = -(rxt(k,514) + rxt(k,519) + rxt(k,524)) * y(k,85) + mat(k,642) = -(rxt(k,516) + rxt(k,521)) * y(k,85) + mat(k,207) = rxt(k,286)*y(k,56) + mat(k,1905) = rxt(k,174)*y(k,56) + mat(k,1727) = rxt(k,286)*y(k,28) + rxt(k,174)*y(k,42) + rxt(k,176)*y(k,77) & + + rxt(k,177)*y(k,79) + rxt(k,196)*y(k,92) + rxt(k,178)*y(k,200) + mat(k,1693) = rxt(k,193)*y(k,211) + mat(k,1010) = rxt(k,176)*y(k,56) + mat(k,477) = rxt(k,177)*y(k,56) + mat(k,678) = mat(k,678) + rxt(k,196)*y(k,56) + mat(k,1389) = rxt(k,178)*y(k,56) + mat(k,1617) = mat(k,1617) + rxt(k,193)*y(k,59) + mat(k,96) = -(rxt(k,266)*y(k,211) + rxt(k,274)*y(k,210)) + mat(k,1500) = -rxt(k,266)*y(k,86) + mat(k,1462) = -rxt(k,274)*y(k,86) + mat(k,657) = -(rxt(k,267)*y(k,211)) + mat(k,1573) = -rxt(k,267)*y(k,87) + mat(k,759) = .050_r8*rxt(k,440)*y(k,134) + mat(k,200) = .350_r8*rxt(k,277)*y(k,211) + mat(k,453) = .370_r8*rxt(k,279)*y(k,134) + mat(k,839) = .120_r8*rxt(k,308)*y(k,134) + mat(k,708) = .110_r8*rxt(k,385)*y(k,134) + mat(k,1058) = .330_r8*rxt(k,338)*y(k,134) + mat(k,785) = .050_r8*rxt(k,443)*y(k,134) + mat(k,1124) = .120_r8*rxt(k,352)*y(k,134) + mat(k,1950) = rxt(k,270)*y(k,201) + mat(k,1796) = .050_r8*rxt(k,440)*y(k,6) + .370_r8*rxt(k,279)*y(k,25) & + + .120_r8*rxt(k,308)*y(k,29) + .110_r8*rxt(k,385)*y(k,98) & + + .330_r8*rxt(k,338)*y(k,105) + .050_r8*rxt(k,443)*y(k,110) & + + .120_r8*rxt(k,352)*y(k,111) + mat(k,1355) = rxt(k,268)*y(k,201) + mat(k,341) = rxt(k,270)*y(k,124) + rxt(k,268)*y(k,200) + mat(k,1573) = mat(k,1573) + .350_r8*rxt(k,277)*y(k,24) + mat(k,648) = rxt(k,232)*y(k,77) + rxt(k,234)*y(k,89) + rxt(k,233)*y(k,221) + mat(k,1005) = rxt(k,232)*y(k,73) + mat(k,1260) = rxt(k,234)*y(k,73) + mat(k,1999) = rxt(k,233)*y(k,73) + mat(k,1263) = -(rxt(k,171)*y(k,211) + rxt(k,234)*y(k,73)) + mat(k,1615) = -rxt(k,171)*y(k,89) + mat(k,651) = -rxt(k,234)*y(k,89) + mat(k,1903) = rxt(k,255)*y(k,126) + mat(k,998) = rxt(k,288)*y(k,126) + mat(k,1074) = rxt(k,314)*y(k,126) + mat(k,828) = (rxt(k,514)+rxt(k,519)+rxt(k,524))*y(k,85) + mat(k,195) = rxt(k,476)*y(k,126) + mat(k,1294) = (rxt(k,514)+rxt(k,519)+rxt(k,524))*y(k,60) + mat(k,1766) = rxt(k,170)*y(k,211) + mat(k,1444) = rxt(k,255)*y(k,42) + rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) & + + rxt(k,476)*y(k,67) + mat(k,1615) = mat(k,1615) + rxt(k,170)*y(k,125) + mat(k,272) = -(rxt(k,149)*y(k,211)) + mat(k,1527) = -rxt(k,149)*y(k,90) + mat(k,1745) = rxt(k,168)*y(k,200) + mat(k,1319) = rxt(k,168)*y(k,125) + mat(k,640) = -(rxt(k,225)*y(k,133) + (rxt(k,516) + rxt(k,521)) * y(k,85)) + mat(k,1871) = -rxt(k,225)*y(k,91) + mat(k,1290) = -(rxt(k,516) + rxt(k,521)) * y(k,91) + mat(k,1846) = rxt(k,217)*y(k,200) + mat(k,1354) = rxt(k,217)*y(k,19) + mat(k,677) = -(rxt(k,196)*y(k,56) + rxt(k,197)*y(k,133) + rxt(k,198)*y(k,211) & + + (rxt(k,509) + rxt(k,515) + rxt(k,520)) * y(k,85)) + mat(k,1715) = -rxt(k,196)*y(k,92) + mat(k,1872) = -rxt(k,197)*y(k,92) + mat(k,1576) = -rxt(k,198)*y(k,92) + mat(k,1291) = -(rxt(k,509) + rxt(k,515) + rxt(k,520)) * y(k,92) + mat(k,1686) = rxt(k,185)*y(k,200) + mat(k,826) = rxt(k,190)*y(k,211) + mat(k,1357) = rxt(k,185)*y(k,59) + mat(k,1576) = mat(k,1576) + rxt(k,190)*y(k,60) + mat(k,898) = -(rxt(k,331)*y(k,211)) + mat(k,1594) = -rxt(k,331)*y(k,93) + mat(k,469) = .300_r8*rxt(k,376)*y(k,211) + mat(k,426) = .500_r8*rxt(k,377)*y(k,211) + mat(k,1962) = rxt(k,330)*y(k,197) + rxt(k,337)*y(k,204) + mat(k,461) = rxt(k,330)*y(k,124) + mat(k,1147) = rxt(k,337)*y(k,124) + mat(k,1594) = mat(k,1594) + .300_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + mat(k,150) = -(rxt(k,362)*y(k,211)) + mat(k,1508) = -rxt(k,362)*y(k,94) + mat(k,915) = -(rxt(k,316)*y(k,211)) + mat(k,1596) = -rxt(k,316)*y(k,95) + mat(k,470) = .700_r8*rxt(k,376)*y(k,211) + mat(k,427) = .500_r8*rxt(k,377)*y(k,211) + mat(k,416) = .500_r8*rxt(k,351)*y(k,211) + mat(k,1964) = .050_r8*rxt(k,374)*y(k,203) + .220_r8*rxt(k,336)*y(k,204) & + + .250_r8*rxt(k,393)*y(k,218) + mat(k,1426) = .050_r8*rxt(k,375)*y(k,203) + .220_r8*rxt(k,335)*y(k,204) & + + .250_r8*rxt(k,394)*y(k,218) + mat(k,437) = .500_r8*rxt(k,320)*y(k,211) + mat(k,1226) = .220_r8*rxt(k,332)*y(k,204) + .250_r8*rxt(k,390)*y(k,218) + mat(k,1649) = .230_r8*rxt(k,333)*y(k,204) + .200_r8*rxt(k,321)*y(k,214) & + + .100_r8*rxt(k,391)*y(k,218) + mat(k,1178) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1149) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + + .220_r8*rxt(k,332)*y(k,194) + .230_r8*rxt(k,333)*y(k,195) + mat(k,1596) = mat(k,1596) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + .500_r8*rxt(k,351)*y(k,109) + .500_r8*rxt(k,320) & + *y(k,145) + mat(k,984) = .200_r8*rxt(k,321)*y(k,195) + mat(k,1023) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,194) + .100_r8*rxt(k,391)*y(k,195) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,211) = -(rxt(k,363)*y(k,211)) + mat(k,1518) = -rxt(k,363)*y(k,96) + mat(k,1924) = .870_r8*rxt(k,374)*y(k,203) + mat(k,1408) = .950_r8*rxt(k,375)*y(k,203) + mat(k,1218) = rxt(k,370)*y(k,203) + mat(k,1633) = .750_r8*rxt(k,371)*y(k,203) + mat(k,1167) = .870_r8*rxt(k,374)*y(k,124) + .950_r8*rxt(k,375)*y(k,126) & + + rxt(k,370)*y(k,194) + .750_r8*rxt(k,371)*y(k,195) + mat(k,68) = -(rxt(k,364)*y(k,211)) + mat(k,1496) = -rxt(k,364)*y(k,97) + mat(k,551) = .600_r8*rxt(k,387)*y(k,211) + mat(k,1496) = mat(k,1496) + .600_r8*rxt(k,387)*y(k,103) + mat(k,709) = -(rxt(k,378)*y(k,126) + rxt(k,385)*y(k,134) + rxt(k,386) & + *y(k,211)) + mat(k,1411) = -rxt(k,378)*y(k,98) + mat(k,1797) = -rxt(k,385)*y(k,98) + mat(k,1579) = -rxt(k,386)*y(k,98) + mat(k,467) = -(rxt(k,376)*y(k,211)) + mat(k,1554) = -rxt(k,376)*y(k,99) + mat(k,1938) = .080_r8*rxt(k,368)*y(k,202) + mat(k,1096) = .080_r8*rxt(k,368)*y(k,124) + mat(k,423) = -(rxt(k,377)*y(k,211)) + mat(k,1549) = -rxt(k,377)*y(k,100) + mat(k,1936) = .080_r8*rxt(k,374)*y(k,203) + mat(k,1168) = .080_r8*rxt(k,374)*y(k,124) + mat(k,1044) = -(rxt(k,379)*y(k,194) + rxt(k,380)*y(k,195) + rxt(k,381) & + *y(k,200) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126)) + mat(k,1228) = -rxt(k,379)*y(k,101) + mat(k,1656) = -rxt(k,380)*y(k,101) + mat(k,1377) = -rxt(k,381)*y(k,101) + mat(k,1971) = -rxt(k,382)*y(k,101) + mat(k,1433) = -rxt(k,383)*y(k,101) + mat(k,712) = rxt(k,378)*y(k,126) + mat(k,1433) = mat(k,1433) + rxt(k,378)*y(k,98) + mat(k,308) = -(rxt(k,384)*y(k,211)) + mat(k,1532) = -rxt(k,384)*y(k,102) + mat(k,1036) = rxt(k,381)*y(k,200) + mat(k,1323) = rxt(k,381)*y(k,101) + mat(k,552) = -(rxt(k,387)*y(k,211)) + mat(k,1564) = -rxt(k,387)*y(k,103) + mat(k,1346) = rxt(k,367)*y(k,202) + rxt(k,372)*y(k,203) + mat(k,1097) = rxt(k,367)*y(k,200) + mat(k,1170) = rxt(k,372)*y(k,200) + mat(k,39) = -(rxt(k,501)*y(k,211)) + mat(k,1490) = -rxt(k,501)*y(k,104) + mat(k,1060) = -(rxt(k,338)*y(k,134) + rxt(k,339)*y(k,211)) + mat(k,1816) = -rxt(k,338)*y(k,105) + mat(k,1605) = -rxt(k,339)*y(k,105) + mat(k,713) = .300_r8*rxt(k,385)*y(k,134) + mat(k,1972) = .360_r8*rxt(k,368)*y(k,202) + mat(k,1434) = .400_r8*rxt(k,369)*y(k,202) + mat(k,1816) = mat(k,1816) + .300_r8*rxt(k,385)*y(k,98) + mat(k,1229) = .390_r8*rxt(k,365)*y(k,202) + mat(k,1657) = .310_r8*rxt(k,366)*y(k,202) + mat(k,1106) = .360_r8*rxt(k,368)*y(k,124) + .400_r8*rxt(k,369)*y(k,126) & + + .390_r8*rxt(k,365)*y(k,194) + .310_r8*rxt(k,366)*y(k,195) + mat(k,214) = -(rxt(k,340)*y(k,211)) + mat(k,1519) = -rxt(k,340)*y(k,106) + mat(k,1314) = rxt(k,334)*y(k,204) + mat(k,1144) = rxt(k,334)*y(k,200) + mat(k,403) = -(rxt(k,349)*y(k,211)) + mat(k,1546) = -rxt(k,349)*y(k,107) + mat(k,1934) = .800_r8*rxt(k,358)*y(k,188) + mat(k,804) = .800_r8*rxt(k,358)*y(k,124) + mat(k,219) = -(rxt(k,350)*y(k,211)) + mat(k,1520) = -rxt(k,350)*y(k,108) + mat(k,1315) = .800_r8*rxt(k,347)*y(k,208) + mat(k,543) = .800_r8*rxt(k,347)*y(k,200) + mat(k,415) = -(rxt(k,351)*y(k,211)) + mat(k,1548) = -rxt(k,351)*y(k,109) + mat(k,1749) = rxt(k,354)*y(k,206) + mat(k,1201) = rxt(k,354)*y(k,125) + mat(k,787) = -(rxt(k,442)*y(k,126) + rxt(k,443)*y(k,134) + rxt(k,444) & + *y(k,211)) + mat(k,1416) = -rxt(k,442)*y(k,110) + mat(k,1801) = -rxt(k,443)*y(k,110) + mat(k,1585) = -rxt(k,444)*y(k,110) + mat(k,1130) = -(rxt(k,352)*y(k,134) + rxt(k,353)*y(k,211)) + mat(k,1820) = -rxt(k,352)*y(k,111) + mat(k,1609) = -rxt(k,353)*y(k,111) + mat(k,715) = .200_r8*rxt(k,385)*y(k,134) + mat(k,1975) = .560_r8*rxt(k,368)*y(k,202) + mat(k,1438) = .600_r8*rxt(k,369)*y(k,202) + mat(k,1820) = mat(k,1820) + .200_r8*rxt(k,385)*y(k,98) + mat(k,1232) = .610_r8*rxt(k,365)*y(k,202) + mat(k,1660) = .440_r8*rxt(k,366)*y(k,202) + mat(k,1109) = .560_r8*rxt(k,368)*y(k,124) + .600_r8*rxt(k,369)*y(k,126) & + + .610_r8*rxt(k,365)*y(k,194) + .440_r8*rxt(k,366)*y(k,195) + mat(k,266) = -(rxt(k,150)*y(k,124) + (rxt(k,151) + rxt(k,152) + rxt(k,153) & + ) * y(k,125) + rxt(k,162)*y(k,211)) + mat(k,1926) = -rxt(k,150)*y(k,112) + mat(k,1744) = -(rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,112) + mat(k,1526) = -rxt(k,162)*y(k,112) + mat(k,1743) = rxt(k,169)*y(k,126) + mat(k,1406) = rxt(k,169)*y(k,125) + mat(k,278) = -(rxt(k,388)*y(k,211)) + mat(k,1528) = -rxt(k,388)*y(k,115) + mat(k,1035) = .200_r8*rxt(k,380)*y(k,195) + mat(k,1634) = .200_r8*rxt(k,380)*y(k,101) + mat(k,874) = -(rxt(k,389)*y(k,211)) + mat(k,1592) = -rxt(k,389)*y(k,116) + mat(k,1041) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + rxt(k,379)*y(k,194) & + + .800_r8*rxt(k,380)*y(k,195) + mat(k,1960) = rxt(k,382)*y(k,101) + mat(k,1422) = rxt(k,383)*y(k,101) + mat(k,1224) = rxt(k,379)*y(k,101) + mat(k,1646) = .800_r8*rxt(k,380)*y(k,101) + mat(k,49) = -(rxt(k,478)*y(k,211)) + mat(k,1492) = -rxt(k,478)*y(k,120) + mat(k,1996) = -(rxt(k,150)*y(k,112) + rxt(k,159)*y(k,126) + rxt(k,163) & + *y(k,200) + rxt(k,164)*y(k,134) + rxt(k,165)*y(k,133) + rxt(k,186) & + *y(k,59) + rxt(k,218)*y(k,19) + rxt(k,261)*y(k,195) + rxt(k,270) & + *y(k,201) + rxt(k,283)*y(k,191) + rxt(k,294)*y(k,194) + rxt(k,298) & + *y(k,199) + rxt(k,311)*y(k,192) + rxt(k,319)*y(k,213) + rxt(k,323) & + *y(k,214) + (rxt(k,329) + rxt(k,330)) * y(k,197) + (rxt(k,336) & + + rxt(k,337)) * y(k,204) + rxt(k,345)*y(k,206) + rxt(k,348) & + *y(k,208) + (rxt(k,358) + rxt(k,359)) * y(k,188) + rxt(k,368) & + *y(k,202) + rxt(k,374)*y(k,203) + rxt(k,382)*y(k,101) + rxt(k,393) & + *y(k,218) + rxt(k,397)*y(k,187) + rxt(k,400)*y(k,189) + rxt(k,405) & + *y(k,190) + rxt(k,407)*y(k,193) + rxt(k,411)*y(k,196) + rxt(k,414) & + *y(k,205) + rxt(k,417)*y(k,207) + rxt(k,420)*y(k,212) + rxt(k,427) & + *y(k,217) + rxt(k,433)*y(k,219) + rxt(k,436)*y(k,220) + rxt(k,447) & + *y(k,209) + rxt(k,452)*y(k,215) + rxt(k,457)*y(k,216)) + mat(k,271) = -rxt(k,150)*y(k,124) + mat(k,1459) = -rxt(k,159)*y(k,124) + mat(k,1402) = -rxt(k,163)*y(k,124) + mat(k,1841) = -rxt(k,164)*y(k,124) + mat(k,1895) = -rxt(k,165)*y(k,124) + mat(k,1706) = -rxt(k,186)*y(k,124) + mat(k,1865) = -rxt(k,218)*y(k,124) + mat(k,1680) = -rxt(k,261)*y(k,124) + mat(k,345) = -rxt(k,270)*y(k,124) + mat(k,694) = -rxt(k,283)*y(k,124) + mat(k,1246) = -rxt(k,294)*y(k,124) + mat(k,582) = -rxt(k,298)*y(k,124) + mat(k,674) = -rxt(k,311)*y(k,124) + mat(k,637) = -rxt(k,319)*y(k,124) + mat(k,993) = -rxt(k,323)*y(k,124) + mat(k,466) = -(rxt(k,329) + rxt(k,330)) * y(k,124) + mat(k,1164) = -(rxt(k,336) + rxt(k,337)) * y(k,124) + mat(k,1216) = -rxt(k,345)*y(k,124) + mat(k,550) = -rxt(k,348)*y(k,124) + mat(k,818) = -(rxt(k,358) + rxt(k,359)) * y(k,124) + mat(k,1122) = -rxt(k,368)*y(k,124) + mat(k,1198) = -rxt(k,374)*y(k,124) + mat(k,1057) = -rxt(k,382)*y(k,124) + mat(k,1034) = -rxt(k,393)*y(k,124) + mat(k,414) = -rxt(k,397)*y(k,124) + mat(k,382) = -rxt(k,400)*y(k,124) + mat(k,339) = -rxt(k,405)*y(k,124) + mat(k,520) = -rxt(k,407)*y(k,124) + mat(k,628) = -rxt(k,411)*y(k,124) + mat(k,588) = -rxt(k,414)*y(k,124) + mat(k,751) = -rxt(k,417)*y(k,124) + mat(k,352) = -rxt(k,420)*y(k,124) + mat(k,603) = -rxt(k,427)*y(k,124) + mat(k,620) = -rxt(k,433)*y(k,124) + mat(k,390) = -rxt(k,436)*y(k,124) + mat(k,980) = -rxt(k,447)*y(k,124) + mat(k,960) = -rxt(k,452)*y(k,124) + mat(k,941) = -rxt(k,457)*y(k,124) + mat(k,271) = mat(k,271) + 2.000_r8*rxt(k,152)*y(k,125) + rxt(k,162)*y(k,211) + mat(k,1781) = 2.000_r8*rxt(k,152)*y(k,112) + rxt(k,155)*y(k,133) + rxt(k,469) & + *y(k,149) + mat(k,1895) = mat(k,1895) + rxt(k,155)*y(k,125) + mat(k,1094) = rxt(k,469)*y(k,125) + mat(k,1630) = rxt(k,162)*y(k,112) + mat(k,1776) = -((rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,112) + (rxt(k,155) & + + rxt(k,157)) * y(k,133) + rxt(k,156)*y(k,134) + rxt(k,168) & + *y(k,200) + rxt(k,169)*y(k,126) + rxt(k,170)*y(k,211) + rxt(k,188) & + *y(k,59) + rxt(k,219)*y(k,19) + rxt(k,305)*y(k,194) + rxt(k,354) & + *y(k,206) + rxt(k,412)*y(k,196) + rxt(k,415)*y(k,205) + rxt(k,418) & + *y(k,207) + rxt(k,422)*y(k,140) + rxt(k,425)*y(k,187) + rxt(k,469) & + *y(k,149)) + mat(k,269) = -(rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,125) + mat(k,1890) = -(rxt(k,155) + rxt(k,157)) * y(k,125) + mat(k,1836) = -rxt(k,156)*y(k,125) + mat(k,1397) = -rxt(k,168)*y(k,125) + mat(k,1454) = -rxt(k,169)*y(k,125) + mat(k,1625) = -rxt(k,170)*y(k,125) + mat(k,1701) = -rxt(k,188)*y(k,125) + mat(k,1860) = -rxt(k,219)*y(k,125) + mat(k,1243) = -rxt(k,305)*y(k,125) + mat(k,1213) = -rxt(k,354)*y(k,125) + mat(k,627) = -rxt(k,412)*y(k,125) + mat(k,587) = -rxt(k,415)*y(k,125) + mat(k,750) = -rxt(k,418)*y(k,125) + mat(k,365) = -rxt(k,422)*y(k,125) + mat(k,413) = -rxt(k,425)*y(k,125) + mat(k,1090) = -rxt(k,469)*y(k,125) + mat(k,541) = rxt(k,356)*y(k,211) + mat(k,264) = rxt(k,327)*y(k,126) + mat(k,1860) = mat(k,1860) + rxt(k,218)*y(k,124) + mat(k,1701) = mat(k,1701) + rxt(k,186)*y(k,124) + mat(k,276) = rxt(k,149)*y(k,211) + mat(k,474) = .700_r8*rxt(k,376)*y(k,211) + mat(k,1055) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + mat(k,1991) = rxt(k,218)*y(k,19) + rxt(k,186)*y(k,59) + rxt(k,382)*y(k,101) & + + 2.000_r8*rxt(k,159)*y(k,126) + rxt(k,165)*y(k,133) & + + rxt(k,164)*y(k,134) + rxt(k,397)*y(k,187) + rxt(k,358) & + *y(k,188) + rxt(k,400)*y(k,189) + rxt(k,405)*y(k,190) & + + rxt(k,283)*y(k,191) + rxt(k,311)*y(k,192) + rxt(k,407) & + *y(k,193) + rxt(k,294)*y(k,194) + rxt(k,261)*y(k,195) & + + rxt(k,411)*y(k,196) + rxt(k,329)*y(k,197) + rxt(k,298) & + *y(k,199) + rxt(k,163)*y(k,200) + rxt(k,270)*y(k,201) & + + .920_r8*rxt(k,368)*y(k,202) + .920_r8*rxt(k,374)*y(k,203) & + + rxt(k,336)*y(k,204) + rxt(k,414)*y(k,205) + rxt(k,345) & + *y(k,206) + rxt(k,417)*y(k,207) + rxt(k,348)*y(k,208) & + + 1.600_r8*rxt(k,447)*y(k,209) + rxt(k,420)*y(k,212) & + + rxt(k,319)*y(k,213) + rxt(k,323)*y(k,214) + .900_r8*rxt(k,452) & + *y(k,215) + .800_r8*rxt(k,457)*y(k,216) + rxt(k,427)*y(k,217) & + + rxt(k,393)*y(k,218) + rxt(k,433)*y(k,219) + rxt(k,436) & + *y(k,220) + mat(k,1454) = mat(k,1454) + rxt(k,327)*y(k,16) + rxt(k,383)*y(k,101) & + + 2.000_r8*rxt(k,159)*y(k,124) + rxt(k,160)*y(k,133) & + + rxt(k,158)*y(k,200) + rxt(k,369)*y(k,202) + rxt(k,375) & + *y(k,203) + rxt(k,335)*y(k,204) + rxt(k,346)*y(k,206) & + + 2.000_r8*rxt(k,448)*y(k,209) + rxt(k,161)*y(k,211) & + + rxt(k,394)*y(k,218) + mat(k,736) = rxt(k,317)*y(k,211) + mat(k,1890) = mat(k,1890) + rxt(k,165)*y(k,124) + rxt(k,160)*y(k,126) + mat(k,1836) = mat(k,1836) + rxt(k,164)*y(k,124) + mat(k,512) = rxt(k,454)*y(k,211) + mat(k,413) = mat(k,413) + rxt(k,397)*y(k,124) + mat(k,816) = rxt(k,358)*y(k,124) + mat(k,381) = rxt(k,400)*y(k,124) + mat(k,338) = rxt(k,405)*y(k,124) + mat(k,692) = rxt(k,283)*y(k,124) + mat(k,672) = rxt(k,311)*y(k,124) + mat(k,518) = rxt(k,407)*y(k,124) + mat(k,1243) = mat(k,1243) + rxt(k,294)*y(k,124) + mat(k,1675) = rxt(k,261)*y(k,124) + .500_r8*rxt(k,445)*y(k,209) + mat(k,627) = mat(k,627) + rxt(k,411)*y(k,124) + mat(k,464) = rxt(k,329)*y(k,124) + mat(k,580) = rxt(k,298)*y(k,124) + mat(k,1397) = mat(k,1397) + rxt(k,163)*y(k,124) + rxt(k,158)*y(k,126) + mat(k,343) = rxt(k,270)*y(k,124) + mat(k,1119) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + mat(k,1195) = .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,1162) = rxt(k,336)*y(k,124) + rxt(k,335)*y(k,126) + mat(k,587) = mat(k,587) + rxt(k,414)*y(k,124) + mat(k,1213) = mat(k,1213) + rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + mat(k,750) = mat(k,750) + rxt(k,417)*y(k,124) + mat(k,549) = rxt(k,348)*y(k,124) + mat(k,978) = 1.600_r8*rxt(k,447)*y(k,124) + 2.000_r8*rxt(k,448)*y(k,126) & + + .500_r8*rxt(k,445)*y(k,195) + mat(k,1625) = mat(k,1625) + rxt(k,356)*y(k,1) + rxt(k,149)*y(k,90) & + + .700_r8*rxt(k,376)*y(k,99) + rxt(k,161)*y(k,126) + rxt(k,317) & + *y(k,127) + rxt(k,454)*y(k,174) + mat(k,351) = rxt(k,420)*y(k,124) + mat(k,635) = rxt(k,319)*y(k,124) + mat(k,991) = rxt(k,323)*y(k,124) + mat(k,958) = .900_r8*rxt(k,452)*y(k,124) + mat(k,939) = .800_r8*rxt(k,457)*y(k,124) + mat(k,602) = rxt(k,427)*y(k,124) + mat(k,1032) = rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) + mat(k,619) = rxt(k,433)*y(k,124) + mat(k,389) = rxt(k,436)*y(k,124) + end do + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1448) = -(rxt(k,158)*y(k,200) + rxt(k,159)*y(k,124) + rxt(k,160) & + *y(k,133) + rxt(k,161)*y(k,211) + rxt(k,169)*y(k,125) + rxt(k,255) & + *y(k,42) + rxt(k,288)*y(k,45) + rxt(k,307)*y(k,29) + rxt(k,314) & + *y(k,49) + rxt(k,327)*y(k,16) + rxt(k,335)*y(k,204) + rxt(k,346) & + *y(k,206) + rxt(k,369)*y(k,202) + rxt(k,375)*y(k,203) + rxt(k,378) & + *y(k,98) + rxt(k,383)*y(k,101) + rxt(k,394)*y(k,218) + rxt(k,439) & + *y(k,6) + rxt(k,442)*y(k,110) + rxt(k,448)*y(k,209) + rxt(k,459) & + *y(k,176) + rxt(k,476)*y(k,67)) + mat(k,1391) = -rxt(k,158)*y(k,126) + mat(k,1985) = -rxt(k,159)*y(k,126) + mat(k,1884) = -rxt(k,160)*y(k,126) + mat(k,1619) = -rxt(k,161)*y(k,126) + mat(k,1770) = -rxt(k,169)*y(k,126) + mat(k,1907) = -rxt(k,255)*y(k,126) + mat(k,1001) = -rxt(k,288)*y(k,126) + mat(k,848) = -rxt(k,307)*y(k,126) + mat(k,1077) = -rxt(k,314)*y(k,126) + mat(k,262) = -rxt(k,327)*y(k,126) + mat(k,1159) = -rxt(k,335)*y(k,126) + mat(k,1210) = -rxt(k,346)*y(k,126) + mat(k,1116) = -rxt(k,369)*y(k,126) + mat(k,1192) = -rxt(k,375)*y(k,126) + mat(k,719) = -rxt(k,378)*y(k,126) + mat(k,1052) = -rxt(k,383)*y(k,126) + mat(k,1029) = -rxt(k,394)*y(k,126) + mat(k,773) = -rxt(k,439)*y(k,126) + mat(k,799) = -rxt(k,442)*y(k,126) + mat(k,975) = -rxt(k,448)*y(k,126) + mat(k,862) = -rxt(k,459)*y(k,126) + mat(k,197) = -rxt(k,476)*y(k,126) + mat(k,447) = rxt(k,220)*y(k,133) + mat(k,1729) = rxt(k,187)*y(k,60) + mat(k,830) = rxt(k,187)*y(k,56) + rxt(k,189)*y(k,133) + rxt(k,190)*y(k,211) + mat(k,653) = rxt(k,234)*y(k,89) + mat(k,1266) = rxt(k,234)*y(k,73) + rxt(k,171)*y(k,211) + mat(k,419) = .500_r8*rxt(k,351)*y(k,211) + mat(k,1770) = mat(k,1770) + rxt(k,157)*y(k,133) + rxt(k,156)*y(k,134) + mat(k,1884) = mat(k,1884) + rxt(k,220)*y(k,20) + rxt(k,189)*y(k,60) & + + rxt(k,157)*y(k,125) + mat(k,1830) = rxt(k,156)*y(k,125) + mat(k,358) = rxt(k,303)*y(k,211) + mat(k,1619) = mat(k,1619) + rxt(k,190)*y(k,60) + rxt(k,171)*y(k,89) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,138) + mat(k,732) = -(rxt(k,317)*y(k,211)) + mat(k,1581) = -rxt(k,317)*y(k,127) + mat(k,840) = rxt(k,307)*y(k,126) + mat(k,424) = .500_r8*rxt(k,377)*y(k,211) + mat(k,310) = rxt(k,384)*y(k,211) + mat(k,279) = rxt(k,388)*y(k,211) + mat(k,871) = rxt(k,389)*y(k,211) + mat(k,1413) = rxt(k,307)*y(k,29) + mat(k,1581) = mat(k,1581) + .500_r8*rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) & + + rxt(k,388)*y(k,115) + rxt(k,389)*y(k,116) + mat(k,296) = -(rxt(k,449)*y(k,211)) + mat(k,1530) = -rxt(k,449)*y(k,128) + mat(k,1321) = rxt(k,446)*y(k,209) + mat(k,962) = rxt(k,446)*y(k,200) + mat(k,1893) = -(rxt(k,129)*y(k,134) + 4._r8*rxt(k,130)*y(k,133) + rxt(k,132) & + *y(k,77) + rxt(k,133)*y(k,79) + rxt(k,138)*y(k,200) + rxt(k,144) & + *y(k,211) + (rxt(k,155) + rxt(k,157)) * y(k,125) + rxt(k,160) & + *y(k,126) + rxt(k,165)*y(k,124) + rxt(k,189)*y(k,60) + rxt(k,191) & + *y(k,59) + rxt(k,194)*y(k,85) + rxt(k,197)*y(k,92) + rxt(k,220) & + *y(k,20) + rxt(k,221)*y(k,19) + rxt(k,223)*y(k,81) + rxt(k,225) & + *y(k,91) + rxt(k,256)*y(k,42) + rxt(k,462)*y(k,136)) + mat(k,1839) = -rxt(k,129)*y(k,133) + mat(k,1016) = -rxt(k,132)*y(k,133) + mat(k,481) = -rxt(k,133)*y(k,133) + mat(k,1400) = -rxt(k,138)*y(k,133) + mat(k,1628) = -rxt(k,144)*y(k,133) + mat(k,1779) = -(rxt(k,155) + rxt(k,157)) * y(k,133) + mat(k,1457) = -rxt(k,160)*y(k,133) + mat(k,1994) = -rxt(k,165)*y(k,133) + mat(k,835) = -rxt(k,189)*y(k,133) + mat(k,1704) = -rxt(k,191)*y(k,133) + mat(k,1307) = -rxt(k,194)*y(k,133) + mat(k,682) = -rxt(k,197)*y(k,133) + mat(k,450) = -rxt(k,220)*y(k,133) + mat(k,1863) = -rxt(k,221)*y(k,133) + mat(k,701) = -rxt(k,223)*y(k,133) + mat(k,646) = -rxt(k,225)*y(k,133) + mat(k,1916) = -rxt(k,256)*y(k,133) + mat(k,257) = -rxt(k,462)*y(k,133) + mat(k,1286) = rxt(k,136)*y(k,200) + mat(k,270) = rxt(k,150)*y(k,124) + rxt(k,151)*y(k,125) + mat(k,1994) = mat(k,1994) + rxt(k,150)*y(k,112) + mat(k,1779) = mat(k,1779) + rxt(k,151)*y(k,112) + mat(k,1400) = mat(k,1400) + rxt(k,136)*y(k,76) + mat(k,1628) = mat(k,1628) + 2.000_r8*rxt(k,146)*y(k,211) + mat(k,1837) = -(rxt(k,128)*y(k,210) + rxt(k,129)*y(k,133) + rxt(k,139) & + *y(k,200) + rxt(k,140)*y(k,76) + rxt(k,145)*y(k,211) + rxt(k,156) & + *y(k,125) + rxt(k,164)*y(k,124) + rxt(k,180)*y(k,56) + rxt(k,212) & + *y(k,17) + rxt(k,279)*y(k,25) + rxt(k,308)*y(k,29) + rxt(k,338) & + *y(k,105) + rxt(k,352)*y(k,111) + rxt(k,385)*y(k,98) + rxt(k,423) & + *y(k,140) + rxt(k,440)*y(k,6) + rxt(k,443)*y(k,110) + rxt(k,465) & + *y(k,147) + rxt(k,471)*y(k,149)) + mat(k,1479) = -rxt(k,128)*y(k,134) + mat(k,1891) = -rxt(k,129)*y(k,134) + mat(k,1398) = -rxt(k,139)*y(k,134) + mat(k,1285) = -rxt(k,140)*y(k,134) + mat(k,1626) = -rxt(k,145)*y(k,134) + mat(k,1777) = -rxt(k,156)*y(k,134) + mat(k,1992) = -rxt(k,164)*y(k,134) + mat(k,1736) = -rxt(k,180)*y(k,134) + mat(k,1255) = -rxt(k,212)*y(k,134) + mat(k,457) = -rxt(k,279)*y(k,134) + mat(k,852) = -rxt(k,308)*y(k,134) + mat(k,1068) = -rxt(k,338)*y(k,134) + mat(k,1140) = -rxt(k,352)*y(k,134) + mat(k,722) = -rxt(k,385)*y(k,134) + mat(k,366) = -rxt(k,423)*y(k,134) + mat(k,775) = -rxt(k,440)*y(k,134) + mat(k,801) = -rxt(k,443)*y(k,134) + mat(k,401) = -rxt(k,465)*y(k,134) + mat(k,1091) = -rxt(k,471)*y(k,134) + mat(k,1244) = .150_r8*rxt(k,293)*y(k,200) + mat(k,1398) = mat(k,1398) + .150_r8*rxt(k,293)*y(k,194) + .150_r8*rxt(k,343) & + *y(k,206) + mat(k,1214) = .150_r8*rxt(k,343)*y(k,200) + mat(k,229) = -(rxt(k,472)*y(k,149)) + mat(k,1080) = -rxt(k,472)*y(k,135) + mat(k,1844) = rxt(k,214)*y(k,59) + mat(k,1685) = rxt(k,214)*y(k,19) + 2.000_r8*rxt(k,184)*y(k,59) + mat(k,250) = -(rxt(k,462)*y(k,133) + rxt(k,463)*y(k,211)) + mat(k,1867) = -rxt(k,462)*y(k,136) + mat(k,1524) = -rxt(k,463)*y(k,136) + mat(k,895) = rxt(k,331)*y(k,211) + mat(k,1920) = .100_r8*rxt(k,452)*y(k,215) + mat(k,1509) = rxt(k,331)*y(k,93) + mat(k,943) = .100_r8*rxt(k,452)*y(k,124) + mat(k,356) = -(rxt(k,303)*y(k,211)) + mat(k,1539) = -rxt(k,303)*y(k,138) + mat(k,1746) = rxt(k,305)*y(k,194) + mat(k,1219) = rxt(k,305)*y(k,125) + mat(k,1742) = rxt(k,425)*y(k,187) + mat(k,408) = rxt(k,425)*y(k,125) + mat(k,363) = -(rxt(k,422)*y(k,125) + rxt(k,423)*y(k,134)) + mat(k,1747) = -rxt(k,422)*y(k,140) + mat(k,1790) = -rxt(k,423)*y(k,140) + mat(k,118) = .070_r8*rxt(k,409)*y(k,211) + mat(k,1931) = rxt(k,407)*y(k,193) + mat(k,93) = .060_r8*rxt(k,421)*y(k,211) + mat(k,143) = .070_r8*rxt(k,437)*y(k,211) + mat(k,514) = rxt(k,407)*y(k,124) + mat(k,1540) = .070_r8*rxt(k,409)*y(k,66) + .060_r8*rxt(k,421)*y(k,141) & + + .070_r8*rxt(k,437)*y(k,183) + mat(k,91) = -(rxt(k,421)*y(k,211)) + mat(k,1499) = -rxt(k,421)*y(k,141) + mat(k,83) = .530_r8*rxt(k,398)*y(k,211) + mat(k,1499) = mat(k,1499) + .530_r8*rxt(k,398)*y(k,7) + mat(k,234) = -(rxt(k,424)*y(k,211)) + mat(k,1521) = -rxt(k,424)*y(k,142) + mat(k,1316) = rxt(k,419)*y(k,212) + mat(k,346) = rxt(k,419)*y(k,200) + mat(k,435) = -(rxt(k,320)*y(k,211)) + mat(k,1551) = -rxt(k,320)*y(k,145) + mat(k,1338) = rxt(k,318)*y(k,213) + mat(k,629) = rxt(k,318)*y(k,200) + mat(k,302) = -(rxt(k,324)*y(k,211)) + mat(k,1531) = -rxt(k,324)*y(k,146) + mat(k,1322) = .850_r8*rxt(k,322)*y(k,214) + mat(k,982) = .850_r8*rxt(k,322)*y(k,200) + mat(k,397) = -(rxt(k,465)*y(k,134) + rxt(k,468)*y(k,211)) + mat(k,1791) = -rxt(k,465)*y(k,147) + mat(k,1545) = -rxt(k,468)*y(k,147) + mat(k,1083) = -(rxt(k,466)*y(k,19) + rxt(k,467)*y(k,59) + rxt(k,469)*y(k,125) & + + rxt(k,471)*y(k,134) + rxt(k,472)*y(k,135) + rxt(k,473) & + *y(k,211)) + mat(k,1848) = -rxt(k,466)*y(k,149) + mat(k,1689) = -rxt(k,467)*y(k,149) + mat(k,1762) = -rxt(k,469)*y(k,149) + mat(k,1818) = -rxt(k,471)*y(k,149) + mat(k,231) = -rxt(k,472)*y(k,149) + mat(k,1607) = -rxt(k,473)*y(k,149) + mat(k,1878) = rxt(k,462)*y(k,136) + mat(k,1818) = mat(k,1818) + rxt(k,465)*y(k,147) + mat(k,254) = rxt(k,462)*y(k,133) + mat(k,398) = rxt(k,465)*y(k,134) + rxt(k,468)*y(k,211) + mat(k,1607) = mat(k,1607) + rxt(k,468)*y(k,147) + mat(k,726) = -(rxt(k,474)*y(k,211)) + mat(k,1580) = -rxt(k,474)*y(k,150) + mat(k,1847) = rxt(k,466)*y(k,149) + mat(k,1687) = rxt(k,467)*y(k,149) + mat(k,194) = rxt(k,476)*y(k,126) + (rxt(k,477)+.500_r8*rxt(k,479))*y(k,211) + mat(k,1755) = rxt(k,469)*y(k,149) + mat(k,1412) = rxt(k,476)*y(k,67) + mat(k,1798) = rxt(k,471)*y(k,149) + mat(k,230) = rxt(k,472)*y(k,149) + mat(k,252) = rxt(k,463)*y(k,211) + mat(k,1082) = rxt(k,466)*y(k,19) + rxt(k,467)*y(k,59) + rxt(k,469)*y(k,125) & + + rxt(k,471)*y(k,134) + rxt(k,472)*y(k,135) + rxt(k,473) & + *y(k,211) + mat(k,1580) = mat(k,1580) + (rxt(k,477)+.500_r8*rxt(k,479))*y(k,67) & + + rxt(k,463)*y(k,136) + rxt(k,473)*y(k,149) + mat(k,168) = -(rxt(k,475)*y(k,221)) + mat(k,2000) = -rxt(k,475)*y(k,151) + mat(k,725) = rxt(k,474)*y(k,211) + mat(k,1512) = rxt(k,474)*y(k,150) + mat(k,752) = .2202005_r8*rxt(k,495)*y(k,134) + .2202005_r8*rxt(k,496) & + *y(k,211) + mat(k,76) = .0023005_r8*rxt(k,497)*y(k,211) + mat(k,703) = .0031005_r8*rxt(k,500)*y(k,211) + mat(k,34) = .2381005_r8*rxt(k,501)*y(k,211) + mat(k,778) = .0508005_r8*rxt(k,503)*y(k,134) + .0508005_r8*rxt(k,504) & + *y(k,211) + mat(k,1783) = .2202005_r8*rxt(k,495)*y(k,6) + .0508005_r8*rxt(k,503)*y(k,110) + mat(k,40) = .5931005_r8*rxt(k,505)*y(k,211) + mat(k,104) = .1364005_r8*rxt(k,506)*y(k,211) + mat(k,128) = .1677005_r8*rxt(k,507)*y(k,211) + mat(k,1485) = .2202005_r8*rxt(k,496)*y(k,6) + .0023005_r8*rxt(k,497)*y(k,7) & + + .0031005_r8*rxt(k,500)*y(k,98) + .2381005_r8*rxt(k,501) & + *y(k,104) + .0508005_r8*rxt(k,504)*y(k,110) & + + .5931005_r8*rxt(k,505)*y(k,171) + .1364005_r8*rxt(k,506) & + *y(k,179) + .1677005_r8*rxt(k,507)*y(k,181) + end do + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,753) = .2067005_r8*rxt(k,495)*y(k,134) + .2067005_r8*rxt(k,496) & + *y(k,211) + mat(k,77) = .0008005_r8*rxt(k,497)*y(k,211) + mat(k,704) = .0035005_r8*rxt(k,500)*y(k,211) + mat(k,35) = .1308005_r8*rxt(k,501)*y(k,211) + mat(k,779) = .1149005_r8*rxt(k,503)*y(k,134) + .1149005_r8*rxt(k,504) & + *y(k,211) + mat(k,1784) = .2067005_r8*rxt(k,495)*y(k,6) + .1149005_r8*rxt(k,503)*y(k,110) + mat(k,41) = .1534005_r8*rxt(k,505)*y(k,211) + mat(k,105) = .0101005_r8*rxt(k,506)*y(k,211) + mat(k,129) = .0174005_r8*rxt(k,507)*y(k,211) + mat(k,1486) = .2067005_r8*rxt(k,496)*y(k,6) + .0008005_r8*rxt(k,497)*y(k,7) & + + .0035005_r8*rxt(k,500)*y(k,98) + .1308005_r8*rxt(k,501) & + *y(k,104) + .1149005_r8*rxt(k,504)*y(k,110) & + + .1534005_r8*rxt(k,505)*y(k,171) + .0101005_r8*rxt(k,506) & + *y(k,179) + .0174005_r8*rxt(k,507)*y(k,181) + mat(k,754) = .0653005_r8*rxt(k,495)*y(k,134) + .0653005_r8*rxt(k,496) & + *y(k,211) + mat(k,78) = .0843005_r8*rxt(k,497)*y(k,211) + mat(k,705) = .0003005_r8*rxt(k,500)*y(k,211) + mat(k,36) = .0348005_r8*rxt(k,501)*y(k,211) + mat(k,780) = .0348005_r8*rxt(k,503)*y(k,134) + .0348005_r8*rxt(k,504) & + *y(k,211) + mat(k,1785) = .0653005_r8*rxt(k,495)*y(k,6) + .0348005_r8*rxt(k,503)*y(k,110) + mat(k,42) = .0459005_r8*rxt(k,505)*y(k,211) + mat(k,106) = .0763005_r8*rxt(k,506)*y(k,211) + mat(k,130) = .086_r8*rxt(k,507)*y(k,211) + mat(k,1487) = .0653005_r8*rxt(k,496)*y(k,6) + .0843005_r8*rxt(k,497)*y(k,7) & + + .0003005_r8*rxt(k,500)*y(k,98) + .0348005_r8*rxt(k,501) & + *y(k,104) + .0348005_r8*rxt(k,504)*y(k,110) & + + .0459005_r8*rxt(k,505)*y(k,171) + .0763005_r8*rxt(k,506) & + *y(k,179) + .086_r8*rxt(k,507)*y(k,181) + mat(k,755) = .1749305_r8*rxt(k,494)*y(k,126) + .1284005_r8*rxt(k,495) & + *y(k,134) + .1284005_r8*rxt(k,496)*y(k,211) + mat(k,79) = .0443005_r8*rxt(k,497)*y(k,211) + mat(k,706) = .0590245_r8*rxt(k,498)*y(k,126) + .0033005_r8*rxt(k,499) & + *y(k,134) + .0271005_r8*rxt(k,500)*y(k,211) + mat(k,37) = .0076005_r8*rxt(k,501)*y(k,211) + mat(k,781) = .1749305_r8*rxt(k,502)*y(k,126) + .0554005_r8*rxt(k,503) & + *y(k,134) + .0554005_r8*rxt(k,504)*y(k,211) + mat(k,1404) = .1749305_r8*rxt(k,494)*y(k,6) + .0590245_r8*rxt(k,498)*y(k,98) & + + .1749305_r8*rxt(k,502)*y(k,110) + mat(k,1786) = .1284005_r8*rxt(k,495)*y(k,6) + .0033005_r8*rxt(k,499)*y(k,98) & + + .0554005_r8*rxt(k,503)*y(k,110) + mat(k,43) = .0085005_r8*rxt(k,505)*y(k,211) + mat(k,107) = .2157005_r8*rxt(k,506)*y(k,211) + mat(k,131) = .0512005_r8*rxt(k,507)*y(k,211) + mat(k,1488) = .1284005_r8*rxt(k,496)*y(k,6) + .0443005_r8*rxt(k,497)*y(k,7) & + + .0271005_r8*rxt(k,500)*y(k,98) + .0076005_r8*rxt(k,501) & + *y(k,104) + .0554005_r8*rxt(k,504)*y(k,110) & + + .0085005_r8*rxt(k,505)*y(k,171) + .2157005_r8*rxt(k,506) & + *y(k,179) + .0512005_r8*rxt(k,507)*y(k,181) + mat(k,756) = .5901905_r8*rxt(k,494)*y(k,126) + .114_r8*rxt(k,495)*y(k,134) & + + .114_r8*rxt(k,496)*y(k,211) + mat(k,80) = .1621005_r8*rxt(k,497)*y(k,211) + mat(k,707) = .0250245_r8*rxt(k,498)*y(k,126) + .0474005_r8*rxt(k,500) & + *y(k,211) + mat(k,38) = .0113005_r8*rxt(k,501)*y(k,211) + mat(k,782) = .5901905_r8*rxt(k,502)*y(k,126) + .1278005_r8*rxt(k,503) & + *y(k,134) + .1278005_r8*rxt(k,504)*y(k,211) + mat(k,1405) = .5901905_r8*rxt(k,494)*y(k,6) + .0250245_r8*rxt(k,498)*y(k,98) & + + .5901905_r8*rxt(k,502)*y(k,110) + mat(k,1787) = .114_r8*rxt(k,495)*y(k,6) + .1278005_r8*rxt(k,503)*y(k,110) + mat(k,44) = .0128005_r8*rxt(k,505)*y(k,211) + mat(k,108) = .0232005_r8*rxt(k,506)*y(k,211) + mat(k,132) = .1598005_r8*rxt(k,507)*y(k,211) + mat(k,1489) = .114_r8*rxt(k,496)*y(k,6) + .1621005_r8*rxt(k,497)*y(k,7) & + + .0474005_r8*rxt(k,500)*y(k,98) + .0113005_r8*rxt(k,501) & + *y(k,104) + .1278005_r8*rxt(k,504)*y(k,110) & + + .0128005_r8*rxt(k,505)*y(k,171) + .0232005_r8*rxt(k,506) & + *y(k,179) + .1598005_r8*rxt(k,507)*y(k,181) + mat(k,45) = -(rxt(k,505)*y(k,211)) + mat(k,1491) = -rxt(k,505)*y(k,171) + mat(k,111) = .100_r8*rxt(k,429)*y(k,211) + mat(k,133) = .230_r8*rxt(k,431)*y(k,211) + mat(k,1504) = .100_r8*rxt(k,429)*y(k,179) + .230_r8*rxt(k,431)*y(k,181) + mat(k,483) = -(rxt(k,453)*y(k,211)) + mat(k,1556) = -rxt(k,453)*y(k,173) + mat(k,1340) = rxt(k,451)*y(k,215) + mat(k,944) = rxt(k,451)*y(k,200) + mat(k,507) = -(rxt(k,454)*y(k,211)) + mat(k,1559) = -rxt(k,454)*y(k,174) + mat(k,1940) = .200_r8*rxt(k,447)*y(k,209) + .200_r8*rxt(k,457)*y(k,216) + mat(k,1637) = .500_r8*rxt(k,445)*y(k,209) + mat(k,963) = .200_r8*rxt(k,447)*y(k,124) + .500_r8*rxt(k,445)*y(k,195) + mat(k,922) = .200_r8*rxt(k,457)*y(k,124) + mat(k,367) = -(rxt(k,458)*y(k,211)) + mat(k,1541) = -rxt(k,458)*y(k,175) + mat(k,1332) = rxt(k,456)*y(k,216) + mat(k,921) = rxt(k,456)*y(k,200) + mat(k,856) = -(rxt(k,459)*y(k,126) + rxt(k,460)*y(k,211)) + mat(k,1420) = -rxt(k,459)*y(k,176) + mat(k,1590) = -rxt(k,460)*y(k,176) + mat(k,764) = .330_r8*rxt(k,440)*y(k,134) + mat(k,790) = .330_r8*rxt(k,443)*y(k,134) + mat(k,1958) = .800_r8*rxt(k,447)*y(k,209) + .800_r8*rxt(k,457)*y(k,216) + mat(k,1420) = mat(k,1420) + rxt(k,448)*y(k,209) + mat(k,1805) = .330_r8*rxt(k,440)*y(k,6) + .330_r8*rxt(k,443)*y(k,110) + mat(k,508) = rxt(k,454)*y(k,211) + mat(k,1644) = .500_r8*rxt(k,445)*y(k,209) + rxt(k,455)*y(k,216) + mat(k,965) = .800_r8*rxt(k,447)*y(k,124) + rxt(k,448)*y(k,126) & + + .500_r8*rxt(k,445)*y(k,195) + mat(k,1590) = mat(k,1590) + rxt(k,454)*y(k,174) + mat(k,925) = .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,195) + mat(k,886) = -(rxt(k,461)*y(k,211)) + mat(k,1593) = -rxt(k,461)*y(k,177) + mat(k,765) = .300_r8*rxt(k,440)*y(k,134) + mat(k,791) = .300_r8*rxt(k,443)*y(k,134) + mat(k,1961) = .900_r8*rxt(k,452)*y(k,215) + mat(k,1807) = .300_r8*rxt(k,440)*y(k,6) + .300_r8*rxt(k,443)*y(k,110) + mat(k,1647) = rxt(k,450)*y(k,215) + mat(k,948) = .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,195) + mat(k,494) = -(rxt(k,428)*y(k,211)) + mat(k,1557) = -rxt(k,428)*y(k,178) + mat(k,1341) = rxt(k,426)*y(k,217) + mat(k,591) = rxt(k,426)*y(k,200) + mat(k,109) = -(rxt(k,429)*y(k,211)) + mat(k,1502) = -rxt(k,429)*y(k,179) + mat(k,125) = -(rxt(k,395)*y(k,211)) + mat(k,1505) = -rxt(k,395)*y(k,180) + mat(k,1311) = rxt(k,392)*y(k,218) + mat(k,1018) = rxt(k,392)*y(k,200) + mat(k,134) = -(rxt(k,431)*y(k,211)) + mat(k,1506) = -rxt(k,431)*y(k,181) + mat(k,563) = -(rxt(k,434)*y(k,211)) + mat(k,1565) = -rxt(k,434)*y(k,182) + mat(k,1347) = rxt(k,432)*y(k,219) + mat(k,608) = rxt(k,432)*y(k,200) + mat(k,142) = -(rxt(k,437)*y(k,211)) + mat(k,1507) = -rxt(k,437)*y(k,183) + mat(k,135) = .150_r8*rxt(k,431)*y(k,211) + mat(k,1507) = mat(k,1507) + .150_r8*rxt(k,431)*y(k,181) + mat(k,326) = -(rxt(k,438)*y(k,211)) + mat(k,1535) = -rxt(k,438)*y(k,184) + mat(k,1326) = rxt(k,435)*y(k,220) + mat(k,383) = rxt(k,435)*y(k,200) + mat(k,409) = -(rxt(k,396)*y(k,200) + rxt(k,397)*y(k,124) + rxt(k,425) & + *y(k,125)) + mat(k,1336) = -rxt(k,396)*y(k,187) + mat(k,1935) = -rxt(k,397)*y(k,187) + mat(k,1748) = -rxt(k,425)*y(k,187) + mat(k,165) = rxt(k,402)*y(k,211) + mat(k,1547) = rxt(k,402)*y(k,22) + mat(k,809) = -(rxt(k,357)*y(k,200) + (rxt(k,358) + rxt(k,359)) * y(k,124)) + mat(k,1363) = -rxt(k,357)*y(k,188) + mat(k,1956) = -(rxt(k,358) + rxt(k,359)) * y(k,188) + mat(k,525) = rxt(k,360)*y(k,211) + mat(k,159) = rxt(k,361)*y(k,211) + mat(k,1586) = rxt(k,360)*y(k,2) + rxt(k,361)*y(k,15) + mat(k,376) = -(rxt(k,399)*y(k,200) + rxt(k,400)*y(k,124)) + mat(k,1333) = -rxt(k,399)*y(k,189) + mat(k,1932) = -rxt(k,400)*y(k,189) + mat(k,84) = .350_r8*rxt(k,398)*y(k,211) + mat(k,286) = rxt(k,401)*y(k,211) + mat(k,1542) = .350_r8*rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) + mat(k,334) = -(rxt(k,403)*y(k,200) + rxt(k,405)*y(k,124)) + mat(k,1327) = -rxt(k,403)*y(k,190) + mat(k,1927) = -rxt(k,405)*y(k,190) + mat(k,241) = rxt(k,404)*y(k,211) + mat(k,112) = .070_r8*rxt(k,429)*y(k,211) + mat(k,136) = .060_r8*rxt(k,431)*y(k,211) + mat(k,1536) = rxt(k,404)*y(k,23) + .070_r8*rxt(k,429)*y(k,179) & + + .060_r8*rxt(k,431)*y(k,181) + mat(k,687) = -(4._r8*rxt(k,280)*y(k,191) + rxt(k,281)*y(k,195) + rxt(k,282) & + *y(k,200) + rxt(k,283)*y(k,124)) + mat(k,1640) = -rxt(k,281)*y(k,191) + mat(k,1358) = -rxt(k,282)*y(k,191) + mat(k,1952) = -rxt(k,283)*y(k,191) + mat(k,246) = .500_r8*rxt(k,285)*y(k,211) + mat(k,206) = rxt(k,286)*y(k,56) + rxt(k,287)*y(k,211) + mat(k,1716) = rxt(k,286)*y(k,28) + mat(k,1577) = .500_r8*rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) + mat(k,666) = -(rxt(k,309)*y(k,195) + rxt(k,310)*y(k,200) + rxt(k,311) & + *y(k,124)) + mat(k,1639) = -rxt(k,309)*y(k,192) + mat(k,1356) = -rxt(k,310)*y(k,192) + mat(k,1951) = -rxt(k,311)*y(k,192) + mat(k,315) = rxt(k,312)*y(k,211) + mat(k,56) = rxt(k,313)*y(k,211) + mat(k,1575) = rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) + mat(k,515) = -(rxt(k,406)*y(k,200) + rxt(k,407)*y(k,124)) + mat(k,1343) = -rxt(k,406)*y(k,193) + mat(k,1941) = -rxt(k,407)*y(k,193) + mat(k,178) = rxt(k,408)*y(k,211) + mat(k,1941) = mat(k,1941) + rxt(k,397)*y(k,187) + mat(k,1794) = rxt(k,423)*y(k,140) + mat(k,364) = rxt(k,423)*y(k,134) + mat(k,410) = rxt(k,397)*y(k,124) + .400_r8*rxt(k,396)*y(k,200) + mat(k,1343) = mat(k,1343) + .400_r8*rxt(k,396)*y(k,187) + mat(k,1560) = rxt(k,408)*y(k,32) + mat(k,1236) = -(4._r8*rxt(k,291)*y(k,194) + rxt(k,292)*y(k,195) + rxt(k,293) & + *y(k,200) + rxt(k,294)*y(k,124) + rxt(k,305)*y(k,125) + rxt(k,332) & + *y(k,204) + rxt(k,365)*y(k,202) + rxt(k,370)*y(k,203) + rxt(k,379) & + *y(k,101) + rxt(k,390)*y(k,218)) + mat(k,1664) = -rxt(k,292)*y(k,194) + mat(k,1385) = -rxt(k,293)*y(k,194) + mat(k,1979) = -rxt(k,294)*y(k,194) + mat(k,1764) = -rxt(k,305)*y(k,194) + mat(k,1155) = -rxt(k,332)*y(k,194) + mat(k,1112) = -rxt(k,365)*y(k,194) + mat(k,1188) = -rxt(k,370)*y(k,194) + mat(k,1048) = -rxt(k,379)*y(k,194) + mat(k,1026) = -rxt(k,390)*y(k,194) + mat(k,771) = .060_r8*rxt(k,440)*y(k,134) + mat(k,997) = rxt(k,288)*y(k,126) + rxt(k,289)*y(k,211) + mat(k,1073) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,211) + mat(k,392) = .500_r8*rxt(k,296)*y(k,211) + mat(k,717) = .080_r8*rxt(k,385)*y(k,134) + mat(k,1064) = .100_r8*rxt(k,338)*y(k,134) + mat(k,797) = .060_r8*rxt(k,443)*y(k,134) + mat(k,1132) = .280_r8*rxt(k,352)*y(k,134) + mat(k,1979) = mat(k,1979) + .530_r8*rxt(k,336)*y(k,204) + rxt(k,345)*y(k,206) & + + rxt(k,348)*y(k,208) + rxt(k,323)*y(k,214) + mat(k,1442) = rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) + .530_r8*rxt(k,335) & + *y(k,204) + rxt(k,346)*y(k,206) + mat(k,1824) = .060_r8*rxt(k,440)*y(k,6) + .080_r8*rxt(k,385)*y(k,98) & + + .100_r8*rxt(k,338)*y(k,105) + .060_r8*rxt(k,443)*y(k,110) & + + .280_r8*rxt(k,352)*y(k,111) + mat(k,889) = .650_r8*rxt(k,461)*y(k,211) + mat(k,1236) = mat(k,1236) + .530_r8*rxt(k,332)*y(k,204) + mat(k,1664) = mat(k,1664) + .260_r8*rxt(k,333)*y(k,204) + rxt(k,342)*y(k,206) & + + .300_r8*rxt(k,321)*y(k,214) + mat(k,1385) = mat(k,1385) + .450_r8*rxt(k,343)*y(k,206) + .200_r8*rxt(k,347) & + *y(k,208) + .150_r8*rxt(k,322)*y(k,214) + mat(k,1155) = mat(k,1155) + .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335) & + *y(k,126) + .530_r8*rxt(k,332)*y(k,194) + .260_r8*rxt(k,333) & + *y(k,195) + mat(k,1206) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,342)*y(k,195) & + + .450_r8*rxt(k,343)*y(k,200) + 4.000_r8*rxt(k,344)*y(k,206) + mat(k,546) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,200) + mat(k,1613) = rxt(k,289)*y(k,45) + rxt(k,315)*y(k,49) + .500_r8*rxt(k,296) & + *y(k,51) + .650_r8*rxt(k,461)*y(k,177) + mat(k,987) = rxt(k,323)*y(k,124) + .300_r8*rxt(k,321)*y(k,195) & + + .150_r8*rxt(k,322)*y(k,200) + end do + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1672) = -(rxt(k,181)*y(k,59) + (4._r8*rxt(k,258) + 4._r8*rxt(k,259) & + ) * y(k,195) + rxt(k,260)*y(k,200) + rxt(k,261)*y(k,124) & + + rxt(k,281)*y(k,191) + rxt(k,292)*y(k,194) + rxt(k,309) & + *y(k,192) + rxt(k,321)*y(k,214) + rxt(k,333)*y(k,204) + rxt(k,342) & + *y(k,206) + rxt(k,366)*y(k,202) + rxt(k,371)*y(k,203) + rxt(k,380) & + *y(k,101) + rxt(k,391)*y(k,218) + rxt(k,445)*y(k,209) + rxt(k,450) & + *y(k,215) + rxt(k,455)*y(k,216)) + mat(k,1698) = -rxt(k,181)*y(k,195) + mat(k,1394) = -rxt(k,260)*y(k,195) + mat(k,1988) = -rxt(k,261)*y(k,195) + mat(k,691) = -rxt(k,281)*y(k,195) + mat(k,1242) = -rxt(k,292)*y(k,195) + mat(k,671) = -rxt(k,309)*y(k,195) + mat(k,990) = -rxt(k,321)*y(k,195) + mat(k,1161) = -rxt(k,333)*y(k,195) + mat(k,1212) = -rxt(k,342)*y(k,195) + mat(k,1118) = -rxt(k,366)*y(k,195) + mat(k,1194) = -rxt(k,371)*y(k,195) + mat(k,1054) = -rxt(k,380)*y(k,195) + mat(k,1031) = -rxt(k,391)*y(k,195) + mat(k,977) = -rxt(k,445)*y(k,195) + mat(k,957) = -rxt(k,450)*y(k,195) + mat(k,938) = -rxt(k,455)*y(k,195) + mat(k,850) = .280_r8*rxt(k,308)*y(k,134) + mat(k,433) = rxt(k,295)*y(k,211) + mat(k,323) = .700_r8*rxt(k,263)*y(k,211) + mat(k,721) = .050_r8*rxt(k,385)*y(k,134) + mat(k,1054) = mat(k,1054) + rxt(k,379)*y(k,194) + mat(k,1988) = mat(k,1988) + rxt(k,294)*y(k,194) + .830_r8*rxt(k,411)*y(k,196) & + + .170_r8*rxt(k,417)*y(k,207) + mat(k,1833) = .280_r8*rxt(k,308)*y(k,29) + .050_r8*rxt(k,385)*y(k,98) + mat(k,1242) = mat(k,1242) + rxt(k,379)*y(k,101) + rxt(k,294)*y(k,124) & + + 4.000_r8*rxt(k,291)*y(k,194) + .900_r8*rxt(k,292)*y(k,195) & + + .450_r8*rxt(k,293)*y(k,200) + rxt(k,365)*y(k,202) + rxt(k,370) & + *y(k,203) + rxt(k,332)*y(k,204) + rxt(k,341)*y(k,206) & + + rxt(k,390)*y(k,218) + mat(k,1672) = mat(k,1672) + .900_r8*rxt(k,292)*y(k,194) + mat(k,626) = .830_r8*rxt(k,411)*y(k,124) + .330_r8*rxt(k,410)*y(k,200) + mat(k,1394) = mat(k,1394) + .450_r8*rxt(k,293)*y(k,194) + .330_r8*rxt(k,410) & + *y(k,196) + .070_r8*rxt(k,416)*y(k,207) + mat(k,1118) = mat(k,1118) + rxt(k,365)*y(k,194) + mat(k,1194) = mat(k,1194) + rxt(k,370)*y(k,194) + mat(k,1161) = mat(k,1161) + rxt(k,332)*y(k,194) + mat(k,1212) = mat(k,1212) + rxt(k,341)*y(k,194) + mat(k,749) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,200) + mat(k,1622) = rxt(k,295)*y(k,50) + .700_r8*rxt(k,263)*y(k,53) + mat(k,1031) = mat(k,1031) + rxt(k,390)*y(k,194) + mat(k,621) = -(rxt(k,410)*y(k,200) + rxt(k,411)*y(k,124) + rxt(k,412) & + *y(k,125)) + mat(k,1352) = -rxt(k,410)*y(k,196) + mat(k,1948) = -rxt(k,411)*y(k,196) + mat(k,1753) = -rxt(k,412)*y(k,196) + mat(k,459) = -((rxt(k,329) + rxt(k,330)) * y(k,124)) + mat(k,1937) = -(rxt(k,329) + rxt(k,330)) * y(k,197) + mat(k,259) = rxt(k,328)*y(k,211) + mat(k,1553) = rxt(k,328)*y(k,16) + mat(k,1922) = .750_r8*rxt(k,298)*y(k,199) + mat(k,575) = .750_r8*rxt(k,298)*y(k,124) + mat(k,576) = -(rxt(k,297)*y(k,200) + rxt(k,298)*y(k,124)) + mat(k,1348) = -rxt(k,297)*y(k,199) + mat(k,1944) = -rxt(k,298)*y(k,199) + mat(k,452) = rxt(k,304)*y(k,211) + mat(k,1566) = rxt(k,304)*y(k,25) + mat(k,1390) = -((rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,76) + rxt(k,138) & + *y(k,133) + rxt(k,139)*y(k,134) + rxt(k,143)*y(k,211) & + + 4._r8*rxt(k,148)*y(k,200) + rxt(k,158)*y(k,126) + rxt(k,163) & + *y(k,124) + rxt(k,168)*y(k,125) + (rxt(k,178) + rxt(k,179) & + ) * y(k,56) + rxt(k,185)*y(k,59) + rxt(k,211)*y(k,17) + rxt(k,217) & + *y(k,19) + rxt(k,254)*y(k,42) + rxt(k,260)*y(k,195) + rxt(k,268) & + *y(k,201) + rxt(k,282)*y(k,191) + rxt(k,293)*y(k,194) + rxt(k,297) & + *y(k,199) + rxt(k,310)*y(k,192) + rxt(k,318)*y(k,213) + rxt(k,322) & + *y(k,214) + rxt(k,334)*y(k,204) + rxt(k,343)*y(k,206) + rxt(k,347) & + *y(k,208) + rxt(k,357)*y(k,188) + rxt(k,367)*y(k,202) + rxt(k,372) & + *y(k,203) + rxt(k,381)*y(k,101) + rxt(k,392)*y(k,218) + rxt(k,396) & + *y(k,187) + rxt(k,399)*y(k,189) + rxt(k,403)*y(k,190) + rxt(k,406) & + *y(k,193) + rxt(k,410)*y(k,196) + rxt(k,413)*y(k,205) + rxt(k,416) & + *y(k,207) + rxt(k,419)*y(k,212) + rxt(k,426)*y(k,217) + rxt(k,432) & + *y(k,219) + rxt(k,435)*y(k,220) + rxt(k,446)*y(k,209) + rxt(k,451) & + *y(k,215) + rxt(k,456)*y(k,216)) + mat(k,1278) = -(rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,200) + mat(k,1883) = -rxt(k,138)*y(k,200) + mat(k,1829) = -rxt(k,139)*y(k,200) + mat(k,1618) = -rxt(k,143)*y(k,200) + mat(k,1447) = -rxt(k,158)*y(k,200) + mat(k,1984) = -rxt(k,163)*y(k,200) + mat(k,1769) = -rxt(k,168)*y(k,200) + mat(k,1728) = -(rxt(k,178) + rxt(k,179)) * y(k,200) + mat(k,1694) = -rxt(k,185)*y(k,200) + mat(k,1252) = -rxt(k,211)*y(k,200) + mat(k,1853) = -rxt(k,217)*y(k,200) + mat(k,1906) = -rxt(k,254)*y(k,200) + mat(k,1668) = -rxt(k,260)*y(k,200) + mat(k,342) = -rxt(k,268)*y(k,200) + mat(k,689) = -rxt(k,282)*y(k,200) + mat(k,1239) = -rxt(k,293)*y(k,200) + mat(k,578) = -rxt(k,297)*y(k,200) + mat(k,669) = -rxt(k,310)*y(k,200) + mat(k,633) = -rxt(k,318)*y(k,200) + mat(k,988) = -rxt(k,322)*y(k,200) + mat(k,1158) = -rxt(k,334)*y(k,200) + mat(k,1209) = -rxt(k,343)*y(k,200) + mat(k,547) = -rxt(k,347)*y(k,200) + mat(k,813) = -rxt(k,357)*y(k,200) + mat(k,1115) = -rxt(k,367)*y(k,200) + mat(k,1191) = -rxt(k,372)*y(k,200) + mat(k,1051) = -rxt(k,381)*y(k,200) + mat(k,1028) = -rxt(k,392)*y(k,200) + mat(k,411) = -rxt(k,396)*y(k,200) + mat(k,379) = -rxt(k,399)*y(k,200) + mat(k,336) = -rxt(k,403)*y(k,200) + mat(k,516) = -rxt(k,406)*y(k,200) + mat(k,624) = -rxt(k,410)*y(k,200) + mat(k,586) = -rxt(k,413)*y(k,200) + mat(k,747) = -rxt(k,416)*y(k,200) + mat(k,349) = -rxt(k,419)*y(k,200) + mat(k,600) = -rxt(k,426)*y(k,200) + mat(k,617) = -rxt(k,432)*y(k,200) + mat(k,387) = -rxt(k,435)*y(k,200) + mat(k,974) = -rxt(k,446)*y(k,200) + mat(k,955) = -rxt(k,451)*y(k,200) + mat(k,935) = -rxt(k,456)*y(k,200) + mat(k,772) = .570_r8*rxt(k,440)*y(k,134) + mat(k,85) = .650_r8*rxt(k,398)*y(k,211) + mat(k,1252) = mat(k,1252) + rxt(k,210)*y(k,42) + mat(k,1853) = mat(k,1853) + rxt(k,222)*y(k,211) + mat(k,203) = .350_r8*rxt(k,277)*y(k,211) + mat(k,455) = .130_r8*rxt(k,279)*y(k,134) + mat(k,174) = rxt(k,284)*y(k,211) + mat(k,847) = .280_r8*rxt(k,308)*y(k,134) + mat(k,1906) = mat(k,1906) + rxt(k,210)*y(k,17) + rxt(k,174)*y(k,56) & + + rxt(k,255)*y(k,126) + rxt(k,256)*y(k,133) + mat(k,53) = rxt(k,290)*y(k,211) + mat(k,662) = rxt(k,262)*y(k,211) + mat(k,1728) = mat(k,1728) + rxt(k,174)*y(k,42) + rxt(k,177)*y(k,79) + mat(k,1694) = mat(k,1694) + rxt(k,181)*y(k,195) + rxt(k,192)*y(k,211) + mat(k,913) = rxt(k,265)*y(k,211) + mat(k,119) = .730_r8*rxt(k,409)*y(k,211) + mat(k,196) = .500_r8*rxt(k,479)*y(k,211) + mat(k,867) = rxt(k,301)*y(k,211) + mat(k,741) = rxt(k,302)*y(k,211) + mat(k,478) = rxt(k,177)*y(k,56) + rxt(k,133)*y(k,133) + rxt(k,142)*y(k,211) + mat(k,97) = rxt(k,266)*y(k,211) + mat(k,658) = rxt(k,267)*y(k,211) + mat(k,905) = rxt(k,331)*y(k,211) + mat(k,918) = rxt(k,316)*y(k,211) + mat(k,718) = .370_r8*rxt(k,385)*y(k,134) + mat(k,472) = .300_r8*rxt(k,376)*y(k,211) + mat(k,429) = rxt(k,377)*y(k,211) + mat(k,1051) = mat(k,1051) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) & + + rxt(k,379)*y(k,194) + 1.200_r8*rxt(k,380)*y(k,195) + mat(k,311) = rxt(k,384)*y(k,211) + mat(k,1066) = .140_r8*rxt(k,338)*y(k,134) + mat(k,217) = .200_r8*rxt(k,340)*y(k,211) + mat(k,418) = .500_r8*rxt(k,351)*y(k,211) + mat(k,798) = .570_r8*rxt(k,443)*y(k,134) + mat(k,1135) = .280_r8*rxt(k,352)*y(k,134) + mat(k,282) = rxt(k,388)*y(k,211) + mat(k,879) = rxt(k,389)*y(k,211) + mat(k,1984) = mat(k,1984) + rxt(k,382)*y(k,101) + rxt(k,358)*y(k,188) & + + rxt(k,400)*y(k,189) + rxt(k,405)*y(k,190) + rxt(k,283) & + *y(k,191) + rxt(k,311)*y(k,192) + rxt(k,261)*y(k,195) & + + .170_r8*rxt(k,411)*y(k,196) + rxt(k,329)*y(k,197) & + + .250_r8*rxt(k,298)*y(k,199) + rxt(k,270)*y(k,201) & + + .920_r8*rxt(k,368)*y(k,202) + .920_r8*rxt(k,374)*y(k,203) & + + .470_r8*rxt(k,336)*y(k,204) + .400_r8*rxt(k,414)*y(k,205) & + + .830_r8*rxt(k,417)*y(k,207) + rxt(k,420)*y(k,212) + rxt(k,319) & + *y(k,213) + .900_r8*rxt(k,452)*y(k,215) + .800_r8*rxt(k,457) & + *y(k,216) + rxt(k,427)*y(k,217) + rxt(k,393)*y(k,218) & + + rxt(k,433)*y(k,219) + rxt(k,436)*y(k,220) + mat(k,1447) = mat(k,1447) + rxt(k,255)*y(k,42) + rxt(k,383)*y(k,101) & + + rxt(k,369)*y(k,202) + rxt(k,375)*y(k,203) + .470_r8*rxt(k,335) & + *y(k,204) + rxt(k,161)*y(k,211) + rxt(k,394)*y(k,218) + mat(k,1883) = mat(k,1883) + rxt(k,256)*y(k,42) + rxt(k,133)*y(k,79) + mat(k,1829) = mat(k,1829) + .570_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,25) + .280_r8*rxt(k,308)*y(k,29) + .370_r8*rxt(k,385) & + *y(k,98) + .140_r8*rxt(k,338)*y(k,105) + .570_r8*rxt(k,443) & + *y(k,110) + .280_r8*rxt(k,352)*y(k,111) + rxt(k,145)*y(k,211) + mat(k,94) = .800_r8*rxt(k,421)*y(k,211) + mat(k,728) = rxt(k,474)*y(k,211) + mat(k,890) = .200_r8*rxt(k,461)*y(k,211) + mat(k,114) = .280_r8*rxt(k,429)*y(k,211) + mat(k,140) = .380_r8*rxt(k,431)*y(k,211) + mat(k,145) = .630_r8*rxt(k,437)*y(k,211) + mat(k,813) = mat(k,813) + rxt(k,358)*y(k,124) + mat(k,379) = mat(k,379) + rxt(k,400)*y(k,124) + mat(k,336) = mat(k,336) + rxt(k,405)*y(k,124) + mat(k,689) = mat(k,689) + rxt(k,283)*y(k,124) + 2.400_r8*rxt(k,280)*y(k,191) & + + rxt(k,281)*y(k,195) + mat(k,669) = mat(k,669) + rxt(k,311)*y(k,124) + rxt(k,309)*y(k,195) + mat(k,1239) = mat(k,1239) + rxt(k,379)*y(k,101) + .900_r8*rxt(k,292)*y(k,195) & + + rxt(k,365)*y(k,202) + rxt(k,370)*y(k,203) + .470_r8*rxt(k,332) & + *y(k,204) + rxt(k,390)*y(k,218) + mat(k,1668) = mat(k,1668) + rxt(k,181)*y(k,59) + 1.200_r8*rxt(k,380)*y(k,101) & + + rxt(k,261)*y(k,124) + rxt(k,281)*y(k,191) + rxt(k,309) & + *y(k,192) + .900_r8*rxt(k,292)*y(k,194) + 4.000_r8*rxt(k,258) & + *y(k,195) + rxt(k,366)*y(k,202) + rxt(k,371)*y(k,203) & + + .730_r8*rxt(k,333)*y(k,204) + rxt(k,342)*y(k,206) & + + .500_r8*rxt(k,445)*y(k,209) + .300_r8*rxt(k,321)*y(k,214) & + + rxt(k,450)*y(k,215) + rxt(k,455)*y(k,216) + .800_r8*rxt(k,391) & + *y(k,218) + mat(k,624) = mat(k,624) + .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410) & + *y(k,200) + mat(k,463) = rxt(k,329)*y(k,124) + mat(k,578) = mat(k,578) + .250_r8*rxt(k,298)*y(k,124) + mat(k,1390) = mat(k,1390) + .070_r8*rxt(k,410)*y(k,196) + .160_r8*rxt(k,413) & + *y(k,205) + .330_r8*rxt(k,416)*y(k,207) + mat(k,342) = mat(k,342) + rxt(k,270)*y(k,124) + mat(k,1115) = mat(k,1115) + .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) & + + rxt(k,365)*y(k,194) + rxt(k,366)*y(k,195) + mat(k,1191) = mat(k,1191) + .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) & + + rxt(k,370)*y(k,194) + rxt(k,371)*y(k,195) + mat(k,1158) = mat(k,1158) + .470_r8*rxt(k,336)*y(k,124) + .470_r8*rxt(k,335) & + *y(k,126) + .470_r8*rxt(k,332)*y(k,194) + .730_r8*rxt(k,333) & + *y(k,195) + mat(k,586) = mat(k,586) + .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413) & + *y(k,200) + mat(k,1209) = mat(k,1209) + rxt(k,342)*y(k,195) + mat(k,747) = mat(k,747) + .830_r8*rxt(k,417)*y(k,124) + .330_r8*rxt(k,416) & + *y(k,200) + mat(k,974) = mat(k,974) + .500_r8*rxt(k,445)*y(k,195) + mat(k,1618) = mat(k,1618) + .650_r8*rxt(k,398)*y(k,7) + rxt(k,222)*y(k,19) & + + .350_r8*rxt(k,277)*y(k,24) + rxt(k,284)*y(k,26) + rxt(k,290) & + *y(k,47) + rxt(k,262)*y(k,52) + rxt(k,192)*y(k,59) + rxt(k,265) & + *y(k,62) + .730_r8*rxt(k,409)*y(k,66) + .500_r8*rxt(k,479) & + *y(k,67) + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,142) & + *y(k,79) + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,331) & + *y(k,93) + rxt(k,316)*y(k,95) + .300_r8*rxt(k,376)*y(k,99) & + + rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) + .200_r8*rxt(k,340) & + *y(k,106) + .500_r8*rxt(k,351)*y(k,109) + rxt(k,388)*y(k,115) & + + rxt(k,389)*y(k,116) + rxt(k,161)*y(k,126) + rxt(k,145) & + *y(k,134) + .800_r8*rxt(k,421)*y(k,141) + rxt(k,474)*y(k,150) & + + .200_r8*rxt(k,461)*y(k,177) + .280_r8*rxt(k,429)*y(k,179) & + + .380_r8*rxt(k,431)*y(k,181) + .630_r8*rxt(k,437)*y(k,183) + mat(k,349) = mat(k,349) + rxt(k,420)*y(k,124) + mat(k,633) = mat(k,633) + rxt(k,319)*y(k,124) + mat(k,988) = mat(k,988) + .300_r8*rxt(k,321)*y(k,195) + mat(k,955) = mat(k,955) + .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,195) + mat(k,935) = mat(k,935) + .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,195) + mat(k,600) = mat(k,600) + rxt(k,427)*y(k,124) + mat(k,1028) = mat(k,1028) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) & + + rxt(k,390)*y(k,194) + .800_r8*rxt(k,391)*y(k,195) + mat(k,617) = mat(k,617) + rxt(k,433)*y(k,124) + mat(k,387) = mat(k,387) + rxt(k,436)*y(k,124) + end do + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,340) = -(rxt(k,268)*y(k,200) + rxt(k,270)*y(k,124)) + mat(k,1328) = -rxt(k,268)*y(k,201) + mat(k,1928) = -rxt(k,270)*y(k,201) + mat(k,1897) = rxt(k,254)*y(k,200) + mat(k,1328) = mat(k,1328) + rxt(k,254)*y(k,42) + mat(k,1108) = -(rxt(k,365)*y(k,194) + rxt(k,366)*y(k,195) + rxt(k,367) & + *y(k,200) + rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126)) + mat(k,1231) = -rxt(k,365)*y(k,202) + mat(k,1659) = -rxt(k,366)*y(k,202) + mat(k,1380) = -rxt(k,367)*y(k,202) + mat(k,1974) = -rxt(k,368)*y(k,202) + mat(k,1437) = -rxt(k,369)*y(k,202) + mat(k,714) = .600_r8*rxt(k,386)*y(k,211) + mat(k,1608) = .600_r8*rxt(k,386)*y(k,98) + mat(k,1186) = -(rxt(k,370)*y(k,194) + rxt(k,371)*y(k,195) + rxt(k,372) & + *y(k,200) + rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126)) + mat(k,1234) = -rxt(k,370)*y(k,203) + mat(k,1662) = -rxt(k,371)*y(k,203) + mat(k,1383) = -rxt(k,372)*y(k,203) + mat(k,1977) = -rxt(k,374)*y(k,203) + mat(k,1440) = -rxt(k,375)*y(k,203) + mat(k,716) = .400_r8*rxt(k,386)*y(k,211) + mat(k,1611) = .400_r8*rxt(k,386)*y(k,98) + mat(k,1153) = -(rxt(k,332)*y(k,194) + rxt(k,333)*y(k,195) + rxt(k,334) & + *y(k,200) + rxt(k,335)*y(k,126) + (rxt(k,336) + rxt(k,337) & + ) * y(k,124)) + mat(k,1233) = -rxt(k,332)*y(k,204) + mat(k,1661) = -rxt(k,333)*y(k,204) + mat(k,1382) = -rxt(k,334)*y(k,204) + mat(k,1439) = -rxt(k,335)*y(k,204) + mat(k,1976) = -(rxt(k,336) + rxt(k,337)) * y(k,204) + mat(k,1062) = .500_r8*rxt(k,339)*y(k,211) + mat(k,215) = .200_r8*rxt(k,340)*y(k,211) + mat(k,1131) = rxt(k,353)*y(k,211) + mat(k,1610) = .500_r8*rxt(k,339)*y(k,105) + .200_r8*rxt(k,340)*y(k,106) & + + rxt(k,353)*y(k,111) + mat(k,583) = -(rxt(k,413)*y(k,200) + rxt(k,414)*y(k,124) + rxt(k,415) & + *y(k,125)) + mat(k,1349) = -rxt(k,413)*y(k,205) + mat(k,1945) = -rxt(k,414)*y(k,205) + mat(k,1752) = -rxt(k,415)*y(k,205) + mat(k,1205) = -(rxt(k,341)*y(k,194) + rxt(k,342)*y(k,195) + rxt(k,343) & + *y(k,200) + 4._r8*rxt(k,344)*y(k,206) + rxt(k,345)*y(k,124) & + + rxt(k,346)*y(k,126) + rxt(k,354)*y(k,125)) + mat(k,1235) = -rxt(k,341)*y(k,206) + mat(k,1663) = -rxt(k,342)*y(k,206) + mat(k,1384) = -rxt(k,343)*y(k,206) + mat(k,1978) = -rxt(k,345)*y(k,206) + mat(k,1441) = -rxt(k,346)*y(k,206) + mat(k,1763) = -rxt(k,354)*y(k,206) + mat(k,1063) = .500_r8*rxt(k,339)*y(k,211) + mat(k,216) = .500_r8*rxt(k,340)*y(k,211) + mat(k,1612) = .500_r8*rxt(k,339)*y(k,105) + .500_r8*rxt(k,340)*y(k,106) + mat(k,744) = -(rxt(k,416)*y(k,200) + rxt(k,417)*y(k,124) + rxt(k,418) & + *y(k,125)) + mat(k,1362) = -rxt(k,416)*y(k,207) + mat(k,1955) = -rxt(k,417)*y(k,207) + mat(k,1757) = -rxt(k,418)*y(k,207) + mat(k,544) = -(rxt(k,347)*y(k,200) + rxt(k,348)*y(k,124)) + mat(k,1345) = -rxt(k,347)*y(k,208) + mat(k,1943) = -rxt(k,348)*y(k,208) + mat(k,404) = rxt(k,349)*y(k,211) + mat(k,220) = rxt(k,350)*y(k,211) + mat(k,1563) = rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) + mat(k,969) = -(rxt(k,445)*y(k,195) + rxt(k,446)*y(k,200) + rxt(k,447) & + *y(k,124) + rxt(k,448)*y(k,126)) + mat(k,1652) = -rxt(k,445)*y(k,209) + mat(k,1372) = -rxt(k,446)*y(k,209) + mat(k,1967) = -rxt(k,447)*y(k,209) + mat(k,1429) = -rxt(k,448)*y(k,209) + mat(k,768) = rxt(k,439)*y(k,126) + mat(k,794) = rxt(k,442)*y(k,126) + mat(k,1429) = mat(k,1429) + rxt(k,439)*y(k,6) + rxt(k,442)*y(k,110) & + + .500_r8*rxt(k,459)*y(k,176) + mat(k,298) = rxt(k,449)*y(k,211) + mat(k,860) = .500_r8*rxt(k,459)*y(k,126) + mat(k,1599) = rxt(k,449)*y(k,128) + mat(k,1473) = -(rxt(k,124)*y(k,77) + rxt(k,125)*y(k,221) + rxt(k,128) & + *y(k,134) + (rxt(k,206) + rxt(k,207)) * y(k,85) + (rxt(k,229) & + + rxt(k,230)) * y(k,81) + rxt(k,235)*y(k,64) + rxt(k,236) & + *y(k,65) + rxt(k,274)*y(k,86)) + mat(k,1012) = -rxt(k,124)*y(k,210) + mat(k,2011) = -rxt(k,125)*y(k,210) + mat(k,1831) = -rxt(k,128)*y(k,210) + mat(k,1299) = -(rxt(k,206) + rxt(k,207)) * y(k,210) + mat(k,698) = -(rxt(k,229) + rxt(k,230)) * y(k,210) + mat(k,61) = -rxt(k,235)*y(k,210) + mat(k,102) = -rxt(k,236)*y(k,210) + mat(k,98) = -rxt(k,274)*y(k,210) + mat(k,1621) = -(rxt(k,141)*y(k,77) + rxt(k,142)*y(k,79) + rxt(k,143)*y(k,200) & + + rxt(k,144)*y(k,133) + rxt(k,145)*y(k,134) + (4._r8*rxt(k,146) & + + 4._r8*rxt(k,147)) * y(k,211) + rxt(k,149)*y(k,90) + rxt(k,161) & + *y(k,126) + rxt(k,162)*y(k,112) + rxt(k,170)*y(k,125) + rxt(k,171) & + *y(k,89) + rxt(k,190)*y(k,60) + (rxt(k,192) + rxt(k,193) & + ) * y(k,59) + rxt(k,195)*y(k,85) + rxt(k,198)*y(k,92) + rxt(k,222) & + *y(k,19) + rxt(k,224)*y(k,81) + rxt(k,257)*y(k,42) + rxt(k,262) & + *y(k,52) + rxt(k,263)*y(k,53) + (rxt(k,265) + rxt(k,275) & + ) * y(k,62) + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,277) & + *y(k,24) + rxt(k,284)*y(k,26) + rxt(k,285)*y(k,27) + rxt(k,287) & + *y(k,28) + rxt(k,289)*y(k,45) + rxt(k,290)*y(k,47) + rxt(k,295) & + *y(k,50) + rxt(k,296)*y(k,51) + rxt(k,301)*y(k,74) + rxt(k,302) & + *y(k,75) + rxt(k,303)*y(k,138) + rxt(k,304)*y(k,25) + rxt(k,312) & + *y(k,30) + rxt(k,313)*y(k,31) + rxt(k,315)*y(k,49) + rxt(k,316) & + *y(k,95) + rxt(k,317)*y(k,127) + rxt(k,320)*y(k,145) + rxt(k,324) & + *y(k,146) + rxt(k,325)*y(k,29) + rxt(k,326)*y(k,48) + rxt(k,328) & + *y(k,16) + rxt(k,331)*y(k,93) + rxt(k,339)*y(k,105) + rxt(k,340) & + *y(k,106) + rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) + rxt(k,351) & + *y(k,109) + rxt(k,353)*y(k,111) + rxt(k,356)*y(k,1) + rxt(k,360) & + *y(k,2) + rxt(k,361)*y(k,15) + rxt(k,362)*y(k,94) + rxt(k,363) & + *y(k,96) + rxt(k,364)*y(k,97) + rxt(k,376)*y(k,99) + rxt(k,377) & + *y(k,100) + rxt(k,384)*y(k,102) + rxt(k,386)*y(k,98) + rxt(k,387) & + *y(k,103) + rxt(k,388)*y(k,115) + rxt(k,389)*y(k,116) + rxt(k,395) & + *y(k,180) + rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) + rxt(k,402) & + *y(k,22) + rxt(k,404)*y(k,23) + rxt(k,408)*y(k,32) + rxt(k,409) & + *y(k,66) + rxt(k,421)*y(k,141) + rxt(k,424)*y(k,142) + rxt(k,428) & + *y(k,178) + rxt(k,429)*y(k,179) + rxt(k,431)*y(k,181) + rxt(k,434) & + *y(k,182) + rxt(k,437)*y(k,183) + rxt(k,438)*y(k,184) + rxt(k,441) & + *y(k,6) + rxt(k,444)*y(k,110) + rxt(k,449)*y(k,128) + rxt(k,453) & + *y(k,173) + rxt(k,454)*y(k,174) + rxt(k,458)*y(k,175) + rxt(k,460) & + *y(k,176) + rxt(k,461)*y(k,177) + rxt(k,463)*y(k,136) + rxt(k,468) & + *y(k,147) + rxt(k,473)*y(k,149) + rxt(k,474)*y(k,150) + (rxt(k,477) & + + rxt(k,479)) * y(k,67) + rxt(k,478)*y(k,120)) + mat(k,1013) = -rxt(k,141)*y(k,211) + mat(k,479) = -rxt(k,142)*y(k,211) + mat(k,1393) = -rxt(k,143)*y(k,211) + mat(k,1886) = -rxt(k,144)*y(k,211) + mat(k,1832) = -rxt(k,145)*y(k,211) + mat(k,275) = -rxt(k,149)*y(k,211) + mat(k,1450) = -rxt(k,161)*y(k,211) + mat(k,268) = -rxt(k,162)*y(k,211) + mat(k,1772) = -rxt(k,170)*y(k,211) + mat(k,1268) = -rxt(k,171)*y(k,211) + mat(k,831) = -rxt(k,190)*y(k,211) + mat(k,1697) = -(rxt(k,192) + rxt(k,193)) * y(k,211) + mat(k,1300) = -rxt(k,195)*y(k,211) + mat(k,679) = -rxt(k,198)*y(k,211) + mat(k,1856) = -rxt(k,222)*y(k,211) + mat(k,699) = -rxt(k,224)*y(k,211) + mat(k,1909) = -rxt(k,257)*y(k,211) + mat(k,663) = -rxt(k,262)*y(k,211) + mat(k,322) = -rxt(k,263)*y(k,211) + mat(k,914) = -(rxt(k,265) + rxt(k,275)) * y(k,211) + mat(k,99) = -rxt(k,266)*y(k,211) + mat(k,659) = -rxt(k,267)*y(k,211) + mat(k,204) = -rxt(k,277)*y(k,211) + mat(k,175) = -rxt(k,284)*y(k,211) + mat(k,249) = -rxt(k,285)*y(k,211) + mat(k,208) = -rxt(k,287)*y(k,211) + mat(k,1002) = -rxt(k,289)*y(k,211) + mat(k,54) = -rxt(k,290)*y(k,211) + mat(k,432) = -rxt(k,295)*y(k,211) + mat(k,393) = -rxt(k,296)*y(k,211) + mat(k,868) = -rxt(k,301)*y(k,211) + mat(k,742) = -rxt(k,302)*y(k,211) + mat(k,359) = -rxt(k,303)*y(k,211) + mat(k,456) = -rxt(k,304)*y(k,211) + mat(k,318) = -rxt(k,312)*y(k,211) + mat(k,57) = -rxt(k,313)*y(k,211) + mat(k,1078) = -rxt(k,315)*y(k,211) + mat(k,919) = -rxt(k,316)*y(k,211) + mat(k,735) = -rxt(k,317)*y(k,211) + mat(k,440) = -rxt(k,320)*y(k,211) + mat(k,305) = -rxt(k,324)*y(k,211) + mat(k,849) = -rxt(k,325)*y(k,211) + mat(k,822) = -rxt(k,326)*y(k,211) + mat(k,263) = -rxt(k,328)*y(k,211) + mat(k,906) = -rxt(k,331)*y(k,211) + mat(k,1067) = -rxt(k,339)*y(k,211) + mat(k,218) = -rxt(k,340)*y(k,211) + mat(k,407) = -rxt(k,349)*y(k,211) + mat(k,223) = -rxt(k,350)*y(k,211) + mat(k,420) = -rxt(k,351)*y(k,211) + mat(k,1137) = -rxt(k,353)*y(k,211) + mat(k,540) = -rxt(k,356)*y(k,211) + mat(k,530) = -rxt(k,360)*y(k,211) + mat(k,160) = -rxt(k,361)*y(k,211) + mat(k,154) = -rxt(k,362)*y(k,211) + mat(k,213) = -rxt(k,363)*y(k,211) + mat(k,70) = -rxt(k,364)*y(k,211) + mat(k,473) = -rxt(k,376)*y(k,211) + mat(k,430) = -rxt(k,377)*y(k,211) + mat(k,312) = -rxt(k,384)*y(k,211) + mat(k,720) = -rxt(k,386)*y(k,211) + mat(k,557) = -rxt(k,387)*y(k,211) + mat(k,283) = -rxt(k,388)*y(k,211) + mat(k,880) = -rxt(k,389)*y(k,211) + mat(k,127) = -rxt(k,395)*y(k,211) + mat(k,86) = -rxt(k,398)*y(k,211) + mat(k,289) = -rxt(k,401)*y(k,211) + mat(k,166) = -rxt(k,402)*y(k,211) + mat(k,244) = -rxt(k,404)*y(k,211) + mat(k,179) = -rxt(k,408)*y(k,211) + mat(k,120) = -rxt(k,409)*y(k,211) + mat(k,95) = -rxt(k,421)*y(k,211) + mat(k,238) = -rxt(k,424)*y(k,211) + mat(k,502) = -rxt(k,428)*y(k,211) + mat(k,115) = -rxt(k,429)*y(k,211) + mat(k,141) = -rxt(k,431)*y(k,211) + mat(k,573) = -rxt(k,434)*y(k,211) + mat(k,146) = -rxt(k,437)*y(k,211) + mat(k,331) = -rxt(k,438)*y(k,211) + mat(k,774) = -rxt(k,441)*y(k,211) + mat(k,800) = -rxt(k,444)*y(k,211) + mat(k,300) = -rxt(k,449)*y(k,211) + mat(k,490) = -rxt(k,453)*y(k,211) + mat(k,511) = -rxt(k,454)*y(k,211) + mat(k,372) = -rxt(k,458)*y(k,211) + mat(k,863) = -rxt(k,460)*y(k,211) + mat(k,891) = -rxt(k,461)*y(k,211) + mat(k,256) = -rxt(k,463)*y(k,211) + mat(k,400) = -rxt(k,468)*y(k,211) + mat(k,1087) = -rxt(k,473)*y(k,211) + mat(k,729) = -rxt(k,474)*y(k,211) + mat(k,198) = -(rxt(k,477) + rxt(k,479)) * y(k,211) + mat(k,50) = -rxt(k,478)*y(k,211) + mat(k,774) = mat(k,774) + .630_r8*rxt(k,440)*y(k,134) + mat(k,204) = mat(k,204) + .650_r8*rxt(k,277)*y(k,211) + mat(k,456) = mat(k,456) + .130_r8*rxt(k,279)*y(k,134) + mat(k,249) = mat(k,249) + .500_r8*rxt(k,285)*y(k,211) + mat(k,849) = mat(k,849) + .360_r8*rxt(k,308)*y(k,134) + mat(k,1909) = mat(k,1909) + rxt(k,256)*y(k,133) + mat(k,322) = mat(k,322) + .300_r8*rxt(k,263)*y(k,211) + mat(k,1731) = rxt(k,179)*y(k,200) + mat(k,654) = rxt(k,233)*y(k,221) + mat(k,1281) = rxt(k,140)*y(k,134) + 2.000_r8*rxt(k,135)*y(k,200) + mat(k,1013) = mat(k,1013) + rxt(k,132)*y(k,133) + rxt(k,124)*y(k,210) + mat(k,479) = mat(k,479) + rxt(k,133)*y(k,133) + mat(k,699) = mat(k,699) + rxt(k,223)*y(k,133) + rxt(k,229)*y(k,210) + mat(k,1300) = mat(k,1300) + rxt(k,194)*y(k,133) + rxt(k,206)*y(k,210) + mat(k,99) = mat(k,99) + rxt(k,274)*y(k,210) + mat(k,643) = rxt(k,225)*y(k,133) + mat(k,679) = mat(k,679) + rxt(k,197)*y(k,133) + mat(k,720) = mat(k,720) + .320_r8*rxt(k,385)*y(k,134) + mat(k,557) = mat(k,557) + .600_r8*rxt(k,387)*y(k,211) + mat(k,1067) = mat(k,1067) + .240_r8*rxt(k,338)*y(k,134) + mat(k,218) = mat(k,218) + .100_r8*rxt(k,340)*y(k,211) + mat(k,800) = mat(k,800) + .630_r8*rxt(k,443)*y(k,134) + mat(k,1137) = mat(k,1137) + .360_r8*rxt(k,352)*y(k,134) + mat(k,1987) = rxt(k,163)*y(k,200) + mat(k,1450) = mat(k,1450) + rxt(k,158)*y(k,200) + mat(k,1886) = mat(k,1886) + rxt(k,256)*y(k,42) + rxt(k,132)*y(k,77) & + + rxt(k,133)*y(k,79) + rxt(k,223)*y(k,81) + rxt(k,194)*y(k,85) & + + rxt(k,225)*y(k,91) + rxt(k,197)*y(k,92) + rxt(k,138)*y(k,200) + mat(k,1832) = mat(k,1832) + .630_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,25) + .360_r8*rxt(k,308)*y(k,29) + rxt(k,140)*y(k,76) & + + .320_r8*rxt(k,385)*y(k,98) + .240_r8*rxt(k,338)*y(k,105) & + + .630_r8*rxt(k,443)*y(k,110) + .360_r8*rxt(k,352)*y(k,111) & + + rxt(k,139)*y(k,200) + mat(k,440) = mat(k,440) + .500_r8*rxt(k,320)*y(k,211) + mat(k,127) = mat(k,127) + .500_r8*rxt(k,395)*y(k,211) + mat(k,412) = .400_r8*rxt(k,396)*y(k,200) + mat(k,1241) = .450_r8*rxt(k,293)*y(k,200) + mat(k,625) = .400_r8*rxt(k,410)*y(k,200) + mat(k,1393) = mat(k,1393) + rxt(k,179)*y(k,56) + 2.000_r8*rxt(k,135)*y(k,76) & + + rxt(k,163)*y(k,124) + rxt(k,158)*y(k,126) + rxt(k,138) & + *y(k,133) + rxt(k,139)*y(k,134) + .400_r8*rxt(k,396)*y(k,187) & + + .450_r8*rxt(k,293)*y(k,194) + .400_r8*rxt(k,410)*y(k,196) & + + .450_r8*rxt(k,343)*y(k,206) + .400_r8*rxt(k,416)*y(k,207) & + + .200_r8*rxt(k,347)*y(k,208) + .150_r8*rxt(k,322)*y(k,214) + mat(k,1211) = .450_r8*rxt(k,343)*y(k,200) + mat(k,748) = .400_r8*rxt(k,416)*y(k,200) + mat(k,548) = .200_r8*rxt(k,347)*y(k,200) + mat(k,1474) = rxt(k,124)*y(k,77) + rxt(k,229)*y(k,81) + rxt(k,206)*y(k,85) & + + rxt(k,274)*y(k,86) + 2.000_r8*rxt(k,125)*y(k,221) + mat(k,1621) = mat(k,1621) + .650_r8*rxt(k,277)*y(k,24) + .500_r8*rxt(k,285) & + *y(k,27) + .300_r8*rxt(k,263)*y(k,53) + .600_r8*rxt(k,387) & + *y(k,103) + .100_r8*rxt(k,340)*y(k,106) + .500_r8*rxt(k,320) & + *y(k,145) + .500_r8*rxt(k,395)*y(k,180) + mat(k,989) = .150_r8*rxt(k,322)*y(k,200) + mat(k,2012) = rxt(k,233)*y(k,73) + 2.000_r8*rxt(k,125)*y(k,210) + end do + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,347) = -(rxt(k,419)*y(k,200) + rxt(k,420)*y(k,124)) + mat(k,1329) = -rxt(k,419)*y(k,212) + mat(k,1929) = -rxt(k,420)*y(k,212) + mat(k,117) = .200_r8*rxt(k,409)*y(k,211) + mat(k,92) = .140_r8*rxt(k,421)*y(k,211) + mat(k,235) = rxt(k,424)*y(k,211) + mat(k,1537) = .200_r8*rxt(k,409)*y(k,66) + .140_r8*rxt(k,421)*y(k,141) & + + rxt(k,424)*y(k,142) + mat(k,630) = -(rxt(k,318)*y(k,200) + rxt(k,319)*y(k,124)) + mat(k,1353) = -rxt(k,318)*y(k,213) + mat(k,1949) = -rxt(k,319)*y(k,213) + mat(k,838) = rxt(k,325)*y(k,211) + mat(k,436) = .500_r8*rxt(k,320)*y(k,211) + mat(k,1571) = rxt(k,325)*y(k,29) + .500_r8*rxt(k,320)*y(k,145) + mat(k,985) = -(rxt(k,321)*y(k,195) + rxt(k,322)*y(k,200) + rxt(k,323) & + *y(k,124)) + mat(k,1653) = -rxt(k,321)*y(k,214) + mat(k,1373) = -rxt(k,322)*y(k,214) + mat(k,1968) = -rxt(k,323)*y(k,214) + mat(k,769) = .060_r8*rxt(k,440)*y(k,134) + mat(k,820) = rxt(k,326)*y(k,211) + mat(k,795) = .060_r8*rxt(k,443)*y(k,134) + mat(k,1813) = .060_r8*rxt(k,440)*y(k,6) + .060_r8*rxt(k,443)*y(k,110) + mat(k,303) = rxt(k,324)*y(k,211) + mat(k,888) = .150_r8*rxt(k,461)*y(k,211) + mat(k,1600) = rxt(k,326)*y(k,48) + rxt(k,324)*y(k,146) + .150_r8*rxt(k,461) & + *y(k,177) + mat(k,950) = -(rxt(k,450)*y(k,195) + rxt(k,451)*y(k,200) + rxt(k,452) & + *y(k,124)) + mat(k,1651) = -rxt(k,450)*y(k,215) + mat(k,1371) = -rxt(k,451)*y(k,215) + mat(k,1966) = -rxt(k,452)*y(k,215) + mat(k,1428) = .500_r8*rxt(k,459)*y(k,176) + mat(k,488) = rxt(k,453)*y(k,211) + mat(k,859) = .500_r8*rxt(k,459)*y(k,126) + rxt(k,460)*y(k,211) + mat(k,1598) = rxt(k,453)*y(k,173) + rxt(k,460)*y(k,176) + mat(k,928) = -(rxt(k,455)*y(k,195) + rxt(k,456)*y(k,200) + rxt(k,457) & + *y(k,124)) + mat(k,1650) = -rxt(k,455)*y(k,216) + mat(k,1370) = -rxt(k,456)*y(k,216) + mat(k,1965) = -rxt(k,457)*y(k,216) + mat(k,767) = rxt(k,441)*y(k,211) + mat(k,793) = rxt(k,444)*y(k,211) + mat(k,370) = rxt(k,458)*y(k,211) + mat(k,1597) = rxt(k,441)*y(k,6) + rxt(k,444)*y(k,110) + rxt(k,458)*y(k,175) + mat(k,594) = -(rxt(k,426)*y(k,200) + rxt(k,427)*y(k,124)) + mat(k,1350) = -rxt(k,426)*y(k,217) + mat(k,1946) = -rxt(k,427)*y(k,217) + mat(k,497) = rxt(k,428)*y(k,211) + mat(k,113) = .650_r8*rxt(k,429)*y(k,211) + mat(k,1568) = rxt(k,428)*y(k,178) + .650_r8*rxt(k,429)*y(k,179) + mat(k,1024) = -(rxt(k,390)*y(k,194) + rxt(k,391)*y(k,195) + rxt(k,392) & + *y(k,200) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126)) + mat(k,1227) = -rxt(k,390)*y(k,218) + mat(k,1655) = -rxt(k,391)*y(k,218) + mat(k,1376) = -rxt(k,392)*y(k,218) + mat(k,1970) = -rxt(k,393)*y(k,218) + mat(k,1432) = -rxt(k,394)*y(k,218) + mat(k,152) = rxt(k,362)*y(k,211) + mat(k,212) = rxt(k,363)*y(k,211) + mat(k,69) = rxt(k,364)*y(k,211) + mat(k,553) = .400_r8*rxt(k,387)*y(k,211) + mat(k,126) = .500_r8*rxt(k,395)*y(k,211) + mat(k,1603) = rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364)*y(k,97) & + + .400_r8*rxt(k,387)*y(k,103) + .500_r8*rxt(k,395)*y(k,180) + mat(k,610) = -(rxt(k,432)*y(k,200) + rxt(k,433)*y(k,124)) + mat(k,1351) = -rxt(k,432)*y(k,219) + mat(k,1947) = -rxt(k,433)*y(k,219) + mat(k,137) = .560_r8*rxt(k,431)*y(k,211) + mat(k,565) = rxt(k,434)*y(k,211) + mat(k,1569) = .560_r8*rxt(k,431)*y(k,181) + rxt(k,434)*y(k,182) + mat(k,384) = -(rxt(k,435)*y(k,200) + rxt(k,436)*y(k,124)) + mat(k,1334) = -rxt(k,435)*y(k,220) + mat(k,1933) = -rxt(k,436)*y(k,220) + mat(k,144) = .300_r8*rxt(k,437)*y(k,211) + mat(k,327) = rxt(k,438)*y(k,211) + mat(k,1543) = .300_r8*rxt(k,437)*y(k,183) + rxt(k,438)*y(k,184) + mat(k,2022) = -(rxt(k,125)*y(k,210) + rxt(k,233)*y(k,73) + rxt(k,475) & + *y(k,151)) + mat(k,1484) = -rxt(k,125)*y(k,221) + mat(k,656) = -rxt(k,233)*y(k,221) + mat(k,171) = -rxt(k,475)*y(k,221) + mat(k,210) = rxt(k,287)*y(k,211) + mat(k,319) = rxt(k,312)*y(k,211) + mat(k,58) = rxt(k,313)*y(k,211) + mat(k,1919) = rxt(k,257)*y(k,211) + mat(k,1004) = rxt(k,289)*y(k,211) + mat(k,824) = rxt(k,326)*y(k,211) + mat(k,1079) = rxt(k,315)*y(k,211) + mat(k,434) = rxt(k,295)*y(k,211) + mat(k,396) = rxt(k,296)*y(k,211) + mat(k,325) = rxt(k,263)*y(k,211) + mat(k,1287) = rxt(k,136)*y(k,200) + mat(k,1017) = rxt(k,141)*y(k,211) + mat(k,482) = rxt(k,142)*y(k,211) + mat(k,702) = rxt(k,224)*y(k,211) + mat(k,1309) = (rxt(k,516)+rxt(k,521))*y(k,91) + (rxt(k,509)+rxt(k,515) & + +rxt(k,520))*y(k,92) + rxt(k,195)*y(k,211) + mat(k,660) = rxt(k,267)*y(k,211) + mat(k,1273) = rxt(k,171)*y(k,211) + mat(k,277) = rxt(k,149)*y(k,211) + mat(k,647) = (rxt(k,516)+rxt(k,521))*y(k,85) + mat(k,683) = (rxt(k,509)+rxt(k,515)+rxt(k,520))*y(k,85) + rxt(k,198)*y(k,211) + mat(k,1070) = .500_r8*rxt(k,339)*y(k,211) + mat(k,51) = rxt(k,478)*y(k,211) + mat(k,442) = rxt(k,320)*y(k,211) + mat(k,307) = rxt(k,324)*y(k,211) + mat(k,1403) = rxt(k,136)*y(k,76) + rxt(k,143)*y(k,211) + mat(k,1631) = rxt(k,287)*y(k,28) + rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) & + + rxt(k,257)*y(k,42) + rxt(k,289)*y(k,45) + rxt(k,326)*y(k,48) & + + rxt(k,315)*y(k,49) + rxt(k,295)*y(k,50) + rxt(k,296)*y(k,51) & + + rxt(k,263)*y(k,53) + rxt(k,141)*y(k,77) + rxt(k,142)*y(k,79) & + + rxt(k,224)*y(k,81) + rxt(k,195)*y(k,85) + rxt(k,267)*y(k,87) & + + rxt(k,171)*y(k,89) + rxt(k,149)*y(k,90) + rxt(k,198)*y(k,92) & + + .500_r8*rxt(k,339)*y(k,105) + rxt(k,478)*y(k,120) + rxt(k,320) & + *y(k,145) + rxt(k,324)*y(k,146) + rxt(k,143)*y(k,200) & + + 2.000_r8*rxt(k,146)*y(k,211) + end do + end subroutine nlnmat09 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = lmat(k, 5) + mat(k, 6) = lmat(k, 6) + mat(k, 7) = lmat(k, 7) + mat(k, 8) = lmat(k, 8) + mat(k, 9) = lmat(k, 9) + mat(k, 10) = lmat(k, 10) + mat(k, 11) = lmat(k, 11) + mat(k, 12) = lmat(k, 12) + mat(k, 13) = lmat(k, 13) + mat(k, 14) = lmat(k, 14) + mat(k, 15) = lmat(k, 15) + mat(k, 16) = lmat(k, 16) + mat(k, 17) = lmat(k, 17) + mat(k, 18) = lmat(k, 18) + mat(k, 19) = lmat(k, 19) + mat(k, 20) = lmat(k, 20) + mat(k, 21) = lmat(k, 21) + mat(k, 22) = lmat(k, 22) + mat(k, 23) = lmat(k, 23) + mat(k, 24) = lmat(k, 24) + mat(k, 25) = lmat(k, 25) + mat(k, 26) = lmat(k, 26) + mat(k, 27) = lmat(k, 27) + mat(k, 28) = lmat(k, 28) + mat(k, 29) = lmat(k, 29) + mat(k, 30) = lmat(k, 30) + mat(k, 31) = lmat(k, 31) + mat(k, 32) = lmat(k, 32) + mat(k, 33) = lmat(k, 33) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 46) = lmat(k, 46) + mat(k, 47) = lmat(k, 47) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 52) = mat(k, 52) + lmat(k, 52) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 59) = mat(k, 59) + lmat(k, 59) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 64) = lmat(k, 64) + mat(k, 65) = lmat(k, 65) + mat(k, 66) = lmat(k, 66) + mat(k, 67) = lmat(k, 67) + mat(k, 68) = mat(k, 68) + lmat(k, 68) + mat(k, 71) = lmat(k, 71) + mat(k, 72) = lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 81) = mat(k, 81) + lmat(k, 81) + mat(k, 87) = lmat(k, 87) + mat(k, 88) = lmat(k, 88) + mat(k, 89) = lmat(k, 89) + mat(k, 90) = lmat(k, 90) + mat(k, 91) = mat(k, 91) + lmat(k, 91) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 100) = mat(k, 100) + lmat(k, 100) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 109) = mat(k, 109) + lmat(k, 109) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 121) = lmat(k, 121) + mat(k, 122) = lmat(k, 122) + mat(k, 123) = lmat(k, 123) + mat(k, 124) = lmat(k, 124) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 127) = mat(k, 127) + lmat(k, 127) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 147) = lmat(k, 147) + mat(k, 148) = lmat(k, 148) + mat(k, 149) = lmat(k, 149) + mat(k, 150) = mat(k, 150) + lmat(k, 150) + mat(k, 151) = lmat(k, 151) + mat(k, 153) = lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 155) = lmat(k, 155) + mat(k, 156) = lmat(k, 156) + mat(k, 157) = lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 161) = lmat(k, 161) + mat(k, 162) = lmat(k, 162) + mat(k, 163) = lmat(k, 163) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 168) = mat(k, 168) + lmat(k, 168) + mat(k, 169) = lmat(k, 169) + mat(k, 170) = lmat(k, 170) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 176) = mat(k, 176) + lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 179) = mat(k, 179) + lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = lmat(k, 181) + mat(k, 182) = lmat(k, 182) + mat(k, 183) = lmat(k, 183) + mat(k, 184) = lmat(k, 184) + mat(k, 185) = lmat(k, 185) + mat(k, 186) = lmat(k, 186) + mat(k, 187) = lmat(k, 187) + mat(k, 188) = lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 190) = lmat(k, 190) + mat(k, 191) = lmat(k, 191) + mat(k, 192) = lmat(k, 192) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 199) = mat(k, 199) + lmat(k, 199) + mat(k, 205) = mat(k, 205) + lmat(k, 205) + mat(k, 211) = mat(k, 211) + lmat(k, 211) + mat(k, 214) = mat(k, 214) + lmat(k, 214) + mat(k, 219) = mat(k, 219) + lmat(k, 219) + mat(k, 221) = lmat(k, 221) + mat(k, 222) = lmat(k, 222) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 224) = lmat(k, 224) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = lmat(k, 226) + mat(k, 227) = lmat(k, 227) + mat(k, 228) = lmat(k, 228) + mat(k, 229) = mat(k, 229) + lmat(k, 229) + mat(k, 232) = mat(k, 232) + lmat(k, 232) + mat(k, 233) = lmat(k, 233) + mat(k, 234) = mat(k, 234) + lmat(k, 234) + mat(k, 236) = lmat(k, 236) + mat(k, 237) = lmat(k, 237) + mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 239) = lmat(k, 239) + mat(k, 240) = mat(k, 240) + lmat(k, 240) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 245) = mat(k, 245) + lmat(k, 245) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 248) = lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 250) = mat(k, 250) + lmat(k, 250) + mat(k, 251) = lmat(k, 251) + mat(k, 253) = mat(k, 253) + lmat(k, 253) + mat(k, 258) = mat(k, 258) + lmat(k, 258) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 272) = mat(k, 272) + lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = mat(k, 275) + lmat(k, 275) + mat(k, 276) = mat(k, 276) + lmat(k, 276) + mat(k, 278) = mat(k, 278) + lmat(k, 278) + mat(k, 281) = lmat(k, 281) + mat(k, 284) = mat(k, 284) + lmat(k, 284) + mat(k, 285) = lmat(k, 285) + mat(k, 287) = lmat(k, 287) + mat(k, 288) = lmat(k, 288) + mat(k, 289) = mat(k, 289) + lmat(k, 289) + mat(k, 290) = lmat(k, 290) + mat(k, 291) = lmat(k, 291) + mat(k, 292) = lmat(k, 292) + mat(k, 293) = lmat(k, 293) + mat(k, 294) = lmat(k, 294) + mat(k, 295) = lmat(k, 295) + mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 297) = lmat(k, 297) + mat(k, 299) = lmat(k, 299) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 301) = lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 304) = lmat(k, 304) + mat(k, 305) = mat(k, 305) + lmat(k, 305) + mat(k, 306) = lmat(k, 306) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 309) = lmat(k, 309) + mat(k, 311) = mat(k, 311) + lmat(k, 311) + mat(k, 313) = lmat(k, 313) + mat(k, 314) = mat(k, 314) + lmat(k, 314) + mat(k, 316) = lmat(k, 316) + mat(k, 317) = lmat(k, 317) + mat(k, 318) = mat(k, 318) + lmat(k, 318) + mat(k, 320) = mat(k, 320) + lmat(k, 320) + mat(k, 321) = lmat(k, 321) + mat(k, 322) = mat(k, 322) + lmat(k, 322) + mat(k, 324) = mat(k, 324) + lmat(k, 324) + mat(k, 326) = mat(k, 326) + lmat(k, 326) + mat(k, 328) = lmat(k, 328) + mat(k, 329) = lmat(k, 329) + mat(k, 330) = lmat(k, 330) + mat(k, 331) = mat(k, 331) + lmat(k, 331) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 340) = mat(k, 340) + lmat(k, 340) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 344) = lmat(k, 344) + mat(k, 347) = mat(k, 347) + lmat(k, 347) + mat(k, 353) = lmat(k, 353) + mat(k, 354) = lmat(k, 354) + mat(k, 355) = lmat(k, 355) + mat(k, 356) = mat(k, 356) + lmat(k, 356) + mat(k, 357) = lmat(k, 357) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 360) = lmat(k, 360) + mat(k, 361) = lmat(k, 361) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 367) = mat(k, 367) + lmat(k, 367) + mat(k, 368) = lmat(k, 368) + mat(k, 369) = lmat(k, 369) + mat(k, 371) = lmat(k, 371) + mat(k, 372) = mat(k, 372) + lmat(k, 372) + mat(k, 373) = lmat(k, 373) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 384) = mat(k, 384) + lmat(k, 384) + mat(k, 391) = mat(k, 391) + lmat(k, 391) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 394) = lmat(k, 394) + mat(k, 397) = mat(k, 397) + lmat(k, 397) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 402) = lmat(k, 402) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 405) = lmat(k, 405) + mat(k, 406) = lmat(k, 406) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 417) = lmat(k, 417) + mat(k, 421) = lmat(k, 421) + mat(k, 423) = mat(k, 423) + lmat(k, 423) + mat(k, 428) = lmat(k, 428) + mat(k, 431) = mat(k, 431) + lmat(k, 431) + mat(k, 435) = mat(k, 435) + lmat(k, 435) + mat(k, 438) = lmat(k, 438) + mat(k, 439) = lmat(k, 439) + mat(k, 440) = mat(k, 440) + lmat(k, 440) + mat(k, 441) = lmat(k, 441) + mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 444) = lmat(k, 444) + mat(k, 445) = lmat(k, 445) + mat(k, 446) = lmat(k, 446) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 448) = lmat(k, 448) + mat(k, 449) = mat(k, 449) + lmat(k, 449) + mat(k, 451) = mat(k, 451) + lmat(k, 451) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 471) = lmat(k, 471) + mat(k, 476) = mat(k, 476) + lmat(k, 476) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 483) = mat(k, 483) + lmat(k, 483) + mat(k, 484) = lmat(k, 484) + mat(k, 485) = lmat(k, 485) + mat(k, 486) = lmat(k, 486) + mat(k, 487) = lmat(k, 487) + mat(k, 489) = lmat(k, 489) + mat(k, 490) = mat(k, 490) + lmat(k, 490) + mat(k, 491) = lmat(k, 491) + mat(k, 492) = lmat(k, 492) + mat(k, 493) = lmat(k, 493) + mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 495) = lmat(k, 495) + mat(k, 499) = lmat(k, 499) + mat(k, 500) = lmat(k, 500) + mat(k, 501) = lmat(k, 501) + mat(k, 502) = mat(k, 502) + lmat(k, 502) + mat(k, 503) = lmat(k, 503) + mat(k, 504) = lmat(k, 504) + mat(k, 505) = lmat(k, 505) + mat(k, 506) = lmat(k, 506) + mat(k, 507) = mat(k, 507) + lmat(k, 507) + mat(k, 508) = mat(k, 508) + lmat(k, 508) + mat(k, 509) = lmat(k, 509) + mat(k, 510) = lmat(k, 510) + mat(k, 512) = mat(k, 512) + lmat(k, 512) + mat(k, 515) = mat(k, 515) + lmat(k, 515) + mat(k, 521) = lmat(k, 521) + mat(k, 522) = mat(k, 522) + lmat(k, 522) + mat(k, 526) = lmat(k, 526) + mat(k, 527) = lmat(k, 527) + mat(k, 529) = lmat(k, 529) + mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 531) = lmat(k, 531) + mat(k, 532) = lmat(k, 532) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 536) = mat(k, 536) + lmat(k, 536) + mat(k, 537) = mat(k, 537) + lmat(k, 537) + mat(k, 539) = lmat(k, 539) + mat(k, 541) = mat(k, 541) + lmat(k, 541) + mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 544) = mat(k, 544) + lmat(k, 544) + mat(k, 552) = mat(k, 552) + lmat(k, 552) + mat(k, 554) = lmat(k, 554) + mat(k, 555) = lmat(k, 555) + mat(k, 556) = lmat(k, 556) + mat(k, 558) = lmat(k, 558) + mat(k, 559) = lmat(k, 559) + mat(k, 560) = lmat(k, 560) + mat(k, 561) = lmat(k, 561) + mat(k, 562) = lmat(k, 562) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 567) = lmat(k, 567) + mat(k, 570) = lmat(k, 570) + mat(k, 572) = lmat(k, 572) + mat(k, 573) = mat(k, 573) + lmat(k, 573) + mat(k, 576) = mat(k, 576) + lmat(k, 576) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 594) = mat(k, 594) + lmat(k, 594) + mat(k, 610) = mat(k, 610) + lmat(k, 610) + mat(k, 621) = mat(k, 621) + lmat(k, 621) + mat(k, 630) = mat(k, 630) + lmat(k, 630) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 641) = lmat(k, 641) + mat(k, 643) = mat(k, 643) + lmat(k, 643) + mat(k, 648) = mat(k, 648) + lmat(k, 648) + mat(k, 649) = mat(k, 649) + lmat(k, 649) + mat(k, 655) = lmat(k, 655) + mat(k, 657) = mat(k, 657) + lmat(k, 657) + mat(k, 661) = mat(k, 661) + lmat(k, 661) + mat(k, 666) = mat(k, 666) + lmat(k, 666) + mat(k, 677) = mat(k, 677) + lmat(k, 677) + mat(k, 679) = mat(k, 679) + lmat(k, 679) + mat(k, 681) = mat(k, 681) + lmat(k, 681) + mat(k, 687) = mat(k, 687) + lmat(k, 687) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 696) = mat(k, 696) + lmat(k, 696) + mat(k, 697) = mat(k, 697) + lmat(k, 697) + mat(k, 709) = mat(k, 709) + lmat(k, 709) + mat(k, 726) = mat(k, 726) + lmat(k, 726) + mat(k, 727) = lmat(k, 727) + mat(k, 730) = lmat(k, 730) + mat(k, 732) = mat(k, 732) + lmat(k, 732) + mat(k, 734) = lmat(k, 734) + mat(k, 736) = mat(k, 736) + lmat(k, 736) + mat(k, 737) = lmat(k, 737) + mat(k, 738) = lmat(k, 738) + mat(k, 739) = mat(k, 739) + lmat(k, 739) + mat(k, 740) = mat(k, 740) + lmat(k, 740) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 744) = mat(k, 744) + lmat(k, 744) + mat(k, 761) = mat(k, 761) + lmat(k, 761) + mat(k, 787) = mat(k, 787) + lmat(k, 787) + mat(k, 809) = mat(k, 809) + lmat(k, 809) + mat(k, 819) = mat(k, 819) + lmat(k, 819) + mat(k, 821) = lmat(k, 821) + mat(k, 823) = lmat(k, 823) + mat(k, 826) = mat(k, 826) + lmat(k, 826) + mat(k, 827) = mat(k, 827) + lmat(k, 827) + mat(k, 828) = mat(k, 828) + lmat(k, 828) + mat(k, 830) = mat(k, 830) + lmat(k, 830) + mat(k, 832) = mat(k, 832) + lmat(k, 832) + mat(k, 833) = mat(k, 833) + lmat(k, 833) + mat(k, 834) = lmat(k, 834) + mat(k, 841) = mat(k, 841) + lmat(k, 841) + mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 857) = lmat(k, 857) + mat(k, 858) = lmat(k, 858) + mat(k, 861) = lmat(k, 861) + mat(k, 865) = mat(k, 865) + lmat(k, 865) + mat(k, 866) = lmat(k, 866) + mat(k, 867) = mat(k, 867) + lmat(k, 867) + mat(k, 869) = mat(k, 869) + lmat(k, 869) + mat(k, 870) = lmat(k, 870) + mat(k, 874) = mat(k, 874) + lmat(k, 874) + mat(k, 878) = lmat(k, 878) + mat(k, 879) = mat(k, 879) + lmat(k, 879) + mat(k, 882) = lmat(k, 882) + mat(k, 885) = mat(k, 885) + lmat(k, 885) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 887) = mat(k, 887) + lmat(k, 887) + mat(k, 888) = mat(k, 888) + lmat(k, 888) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 890) = mat(k, 890) + lmat(k, 890) + mat(k, 893) = mat(k, 893) + lmat(k, 893) + mat(k, 896) = lmat(k, 896) + mat(k, 897) = lmat(k, 897) + mat(k, 898) = mat(k, 898) + lmat(k, 898) + mat(k, 899) = lmat(k, 899) + mat(k, 900) = lmat(k, 900) + mat(k, 902) = lmat(k, 902) + mat(k, 903) = lmat(k, 903) + mat(k, 904) = lmat(k, 904) + mat(k, 905) = mat(k, 905) + lmat(k, 905) + mat(k, 908) = lmat(k, 908) + mat(k, 909) = lmat(k, 909) + mat(k, 911) = mat(k, 911) + lmat(k, 911) + mat(k, 915) = mat(k, 915) + lmat(k, 915) + mat(k, 917) = lmat(k, 917) + mat(k, 918) = mat(k, 918) + lmat(k, 918) + mat(k, 920) = lmat(k, 920) + mat(k, 928) = mat(k, 928) + lmat(k, 928) + mat(k, 950) = mat(k, 950) + lmat(k, 950) + mat(k, 969) = mat(k, 969) + lmat(k, 969) + mat(k, 985) = mat(k, 985) + lmat(k, 985) + mat(k, 995) = lmat(k, 995) + mat(k, 996) = mat(k, 996) + lmat(k, 996) + mat(k,1000) = lmat(k,1000) + mat(k,1003) = lmat(k,1003) + mat(k,1007) = mat(k,1007) + lmat(k,1007) + mat(k,1024) = mat(k,1024) + lmat(k,1024) + mat(k,1044) = mat(k,1044) + lmat(k,1044) + mat(k,1059) = mat(k,1059) + lmat(k,1059) + mat(k,1060) = mat(k,1060) + lmat(k,1060) + mat(k,1063) = mat(k,1063) + lmat(k,1063) + mat(k,1064) = mat(k,1064) + lmat(k,1064) + mat(k,1066) = mat(k,1066) + lmat(k,1066) + mat(k,1069) = mat(k,1069) + lmat(k,1069) + mat(k,1071) = mat(k,1071) + lmat(k,1071) + mat(k,1072) = mat(k,1072) + lmat(k,1072) + mat(k,1073) = mat(k,1073) + lmat(k,1073) + mat(k,1076) = lmat(k,1076) + mat(k,1081) = lmat(k,1081) + mat(k,1082) = mat(k,1082) + lmat(k,1082) + mat(k,1083) = mat(k,1083) + lmat(k,1083) + mat(k,1093) = lmat(k,1093) + mat(k,1108) = mat(k,1108) + lmat(k,1108) + mat(k,1125) = lmat(k,1125) + mat(k,1126) = mat(k,1126) + lmat(k,1126) + mat(k,1130) = mat(k,1130) + lmat(k,1130) + mat(k,1132) = mat(k,1132) + lmat(k,1132) + mat(k,1138) = lmat(k,1138) + mat(k,1153) = mat(k,1153) + lmat(k,1153) + mat(k,1166) = lmat(k,1166) + mat(k,1186) = mat(k,1186) + lmat(k,1186) + mat(k,1191) = mat(k,1191) + lmat(k,1191) + mat(k,1205) = mat(k,1205) + lmat(k,1205) + mat(k,1236) = mat(k,1236) + lmat(k,1236) + mat(k,1250) = mat(k,1250) + lmat(k,1250) + mat(k,1263) = mat(k,1263) + lmat(k,1263) + mat(k,1268) = mat(k,1268) + lmat(k,1268) + mat(k,1271) = lmat(k,1271) + mat(k,1276) = mat(k,1276) + lmat(k,1276) + mat(k,1278) = mat(k,1278) + lmat(k,1278) + mat(k,1295) = mat(k,1295) + lmat(k,1295) + mat(k,1296) = mat(k,1296) + lmat(k,1296) + mat(k,1303) = mat(k,1303) + lmat(k,1303) + mat(k,1339) = mat(k,1339) + lmat(k,1339) + mat(k,1390) = mat(k,1390) + lmat(k,1390) + mat(k,1444) = mat(k,1444) + lmat(k,1444) + mat(k,1448) = mat(k,1448) + lmat(k,1448) + mat(k,1454) = mat(k,1454) + lmat(k,1454) + mat(k,1457) = mat(k,1457) + lmat(k,1457) + mat(k,1459) = mat(k,1459) + lmat(k,1459) + mat(k,1461) = mat(k,1461) + lmat(k,1461) + mat(k,1463) = mat(k,1463) + lmat(k,1463) + mat(k,1464) = mat(k,1464) + lmat(k,1464) + mat(k,1466) = mat(k,1466) + lmat(k,1466) + mat(k,1467) = mat(k,1467) + lmat(k,1467) + mat(k,1469) = mat(k,1469) + lmat(k,1469) + mat(k,1471) = lmat(k,1471) + mat(k,1473) = mat(k,1473) + lmat(k,1473) + mat(k,1474) = mat(k,1474) + lmat(k,1474) + mat(k,1475) = lmat(k,1475) + mat(k,1477) = mat(k,1477) + lmat(k,1477) + mat(k,1481) = lmat(k,1481) + mat(k,1482) = lmat(k,1482) + mat(k,1483) = lmat(k,1483) + mat(k,1495) = lmat(k,1495) + mat(k,1501) = lmat(k,1501) + mat(k,1614) = mat(k,1614) + lmat(k,1614) + mat(k,1618) = mat(k,1618) + lmat(k,1618) + mat(k,1621) = mat(k,1621) + lmat(k,1621) + mat(k,1622) = mat(k,1622) + lmat(k,1622) + mat(k,1624) = mat(k,1624) + lmat(k,1624) + mat(k,1631) = mat(k,1631) + lmat(k,1631) + mat(k,1672) = mat(k,1672) + lmat(k,1672) + mat(k,1699) = mat(k,1699) + lmat(k,1699) + mat(k,1700) = mat(k,1700) + lmat(k,1700) + mat(k,1704) = mat(k,1704) + lmat(k,1704) + mat(k,1720) = mat(k,1720) + lmat(k,1720) + mat(k,1724) = lmat(k,1724) + mat(k,1727) = mat(k,1727) + lmat(k,1727) + mat(k,1728) = mat(k,1728) + lmat(k,1728) + mat(k,1732) = lmat(k,1732) + mat(k,1734) = mat(k,1734) + lmat(k,1734) + mat(k,1766) = mat(k,1766) + lmat(k,1766) + mat(k,1772) = mat(k,1772) + lmat(k,1772) + mat(k,1776) = mat(k,1776) + lmat(k,1776) + mat(k,1779) = mat(k,1779) + lmat(k,1779) + mat(k,1781) = mat(k,1781) + lmat(k,1781) + mat(k,1831) = mat(k,1831) + lmat(k,1831) + mat(k,1837) = mat(k,1837) + lmat(k,1837) + mat(k,1839) = mat(k,1839) + lmat(k,1839) + mat(k,1849) = mat(k,1849) + lmat(k,1849) + mat(k,1862) = mat(k,1862) + lmat(k,1862) + mat(k,1863) = mat(k,1863) + lmat(k,1863) + mat(k,1891) = mat(k,1891) + lmat(k,1891) + mat(k,1893) = mat(k,1893) + lmat(k,1893) + mat(k,1900) = mat(k,1900) + lmat(k,1900) + mat(k,1901) = lmat(k,1901) + mat(k,1904) = mat(k,1904) + lmat(k,1904) + mat(k,1917) = mat(k,1917) + lmat(k,1917) + mat(k,1926) = mat(k,1926) + lmat(k,1926) + mat(k,1994) = mat(k,1994) + lmat(k,1994) + mat(k,1996) = mat(k,1996) + lmat(k,1996) + mat(k,2003) = lmat(k,2003) + mat(k,2007) = lmat(k,2007) + mat(k,2011) = mat(k,2011) + lmat(k,2011) + mat(k,2012) = mat(k,2012) + lmat(k,2012) + mat(k,2019) = lmat(k,2019) + mat(k,2022) = mat(k,2022) + lmat(k,2022) + mat(k, 138) = 0._r8 + mat(k, 139) = 0._r8 + mat(k, 242) = 0._r8 + mat(k, 335) = 0._r8 + mat(k, 337) = 0._r8 + mat(k, 350) = 0._r8 + mat(k, 377) = 0._r8 + mat(k, 380) = 0._r8 + mat(k, 388) = 0._r8 + mat(k, 496) = 0._r8 + mat(k, 498) = 0._r8 + mat(k, 517) = 0._r8 + mat(k, 519) = 0._r8 + mat(k, 523) = 0._r8 + mat(k, 524) = 0._r8 + mat(k, 528) = 0._r8 + mat(k, 534) = 0._r8 + mat(k, 535) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 564) = 0._r8 + mat(k, 566) = 0._r8 + mat(k, 568) = 0._r8 + mat(k, 569) = 0._r8 + mat(k, 571) = 0._r8 + mat(k, 577) = 0._r8 + mat(k, 579) = 0._r8 + mat(k, 593) = 0._r8 + mat(k, 595) = 0._r8 + mat(k, 597) = 0._r8 + mat(k, 598) = 0._r8 + mat(k, 601) = 0._r8 + mat(k, 609) = 0._r8 + mat(k, 611) = 0._r8 + mat(k, 613) = 0._r8 + mat(k, 614) = 0._r8 + mat(k, 616) = 0._r8 + mat(k, 618) = 0._r8 + mat(k, 631) = 0._r8 + mat(k, 634) = 0._r8 + mat(k, 638) = 0._r8 + mat(k, 644) = 0._r8 + mat(k, 670) = 0._r8 + mat(k, 675) = 0._r8 + mat(k, 690) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 731) = 0._r8 + mat(k, 760) = 0._r8 + mat(k, 762) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 777) = 0._r8 + mat(k, 786) = 0._r8 + mat(k, 788) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 807) = 0._r8 + mat(k, 808) = 0._r8 + mat(k, 812) = 0._r8 + mat(k, 814) = 0._r8 + mat(k, 815) = 0._r8 + mat(k, 836) = 0._r8 + mat(k, 843) = 0._r8 + mat(k, 845) = 0._r8 + mat(k, 846) = 0._r8 + mat(k, 851) = 0._r8 + mat(k, 854) = 0._r8 + mat(k, 855) = 0._r8 + mat(k, 873) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 876) = 0._r8 + mat(k, 877) = 0._r8 + mat(k, 881) = 0._r8 + mat(k, 883) = 0._r8 + mat(k, 884) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 901) = 0._r8 + mat(k, 907) = 0._r8 + mat(k, 910) = 0._r8 + mat(k, 926) = 0._r8 + mat(k, 927) = 0._r8 + mat(k, 929) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 931) = 0._r8 + mat(k, 932) = 0._r8 + mat(k, 933) = 0._r8 + mat(k, 934) = 0._r8 + mat(k, 936) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 942) = 0._r8 + mat(k, 951) = 0._r8 + mat(k, 952) = 0._r8 + mat(k, 953) = 0._r8 + mat(k, 954) = 0._r8 + mat(k, 956) = 0._r8 + mat(k, 961) = 0._r8 + mat(k, 966) = 0._r8 + mat(k, 967) = 0._r8 + mat(k, 968) = 0._r8 + mat(k, 970) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 972) = 0._r8 + mat(k, 973) = 0._r8 + mat(k, 976) = 0._r8 + mat(k, 981) = 0._r8 + mat(k, 994) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1008) = 0._r8 + mat(k,1011) = 0._r8 + mat(k,1014) = 0._r8 + mat(k,1027) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1045) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1053) = 0._r8 + mat(k,1065) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1086) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1099) = 0._r8 + mat(k,1100) = 0._r8 + mat(k,1101) = 0._r8 + mat(k,1102) = 0._r8 + mat(k,1103) = 0._r8 + mat(k,1104) = 0._r8 + mat(k,1105) = 0._r8 + mat(k,1107) = 0._r8 + mat(k,1110) = 0._r8 + mat(k,1111) = 0._r8 + mat(k,1113) = 0._r8 + mat(k,1114) = 0._r8 + mat(k,1117) = 0._r8 + mat(k,1120) = 0._r8 + mat(k,1123) = 0._r8 + mat(k,1127) = 0._r8 + mat(k,1133) = 0._r8 + mat(k,1134) = 0._r8 + mat(k,1136) = 0._r8 + mat(k,1139) = 0._r8 + mat(k,1142) = 0._r8 + mat(k,1143) = 0._r8 + mat(k,1150) = 0._r8 + mat(k,1151) = 0._r8 + mat(k,1154) = 0._r8 + mat(k,1156) = 0._r8 + mat(k,1157) = 0._r8 + mat(k,1160) = 0._r8 + mat(k,1165) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1172) = 0._r8 + mat(k,1174) = 0._r8 + mat(k,1176) = 0._r8 + mat(k,1177) = 0._r8 + mat(k,1179) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1181) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1184) = 0._r8 + mat(k,1185) = 0._r8 + mat(k,1187) = 0._r8 + mat(k,1189) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1193) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1199) = 0._r8 + mat(k,1203) = 0._r8 + mat(k,1204) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1217) = 0._r8 + mat(k,1237) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1247) = 0._r8 + mat(k,1251) = 0._r8 + mat(k,1253) = 0._r8 + mat(k,1254) = 0._r8 + mat(k,1257) = 0._r8 + mat(k,1259) = 0._r8 + mat(k,1262) = 0._r8 + mat(k,1264) = 0._r8 + mat(k,1265) = 0._r8 + mat(k,1267) = 0._r8 + mat(k,1269) = 0._r8 + mat(k,1270) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1277) = 0._r8 + mat(k,1279) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1284) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1297) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1305) = 0._r8 + mat(k,1306) = 0._r8 + mat(k,1308) = 0._r8 + mat(k,1313) = 0._r8 + mat(k,1330) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1342) = 0._r8 + mat(k,1360) = 0._r8 + mat(k,1364) = 0._r8 + mat(k,1365) = 0._r8 + mat(k,1366) = 0._r8 + mat(k,1367) = 0._r8 + mat(k,1369) = 0._r8 + mat(k,1378) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1387) = 0._r8 + mat(k,1392) = 0._r8 + mat(k,1410) = 0._r8 + mat(k,1417) = 0._r8 + mat(k,1423) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1427) = 0._r8 + mat(k,1430) = 0._r8 + mat(k,1436) = 0._r8 + mat(k,1443) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1446) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1451) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1455) = 0._r8 + mat(k,1456) = 0._r8 + mat(k,1460) = 0._r8 + mat(k,1468) = 0._r8 + mat(k,1472) = 0._r8 + mat(k,1478) = 0._r8 + mat(k,1538) = 0._r8 + mat(k,1558) = 0._r8 + mat(k,1567) = 0._r8 + mat(k,1570) = 0._r8 + mat(k,1572) = 0._r8 + mat(k,1583) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1620) = 0._r8 + mat(k,1641) = 0._r8 + mat(k,1665) = 0._r8 + mat(k,1666) = 0._r8 + mat(k,1667) = 0._r8 + mat(k,1669) = 0._r8 + mat(k,1670) = 0._r8 + mat(k,1671) = 0._r8 + mat(k,1676) = 0._r8 + mat(k,1677) = 0._r8 + mat(k,1678) = 0._r8 + mat(k,1681) = 0._r8 + mat(k,1691) = 0._r8 + mat(k,1692) = 0._r8 + mat(k,1695) = 0._r8 + mat(k,1696) = 0._r8 + mat(k,1702) = 0._r8 + mat(k,1707) = 0._r8 + mat(k,1713) = 0._r8 + mat(k,1714) = 0._r8 + mat(k,1717) = 0._r8 + mat(k,1719) = 0._r8 + mat(k,1721) = 0._r8 + mat(k,1723) = 0._r8 + mat(k,1725) = 0._r8 + mat(k,1730) = 0._r8 + mat(k,1735) = 0._r8 + mat(k,1737) = 0._r8 + mat(k,1738) = 0._r8 + mat(k,1740) = 0._r8 + mat(k,1741) = 0._r8 + mat(k,1751) = 0._r8 + mat(k,1754) = 0._r8 + mat(k,1756) = 0._r8 + mat(k,1759) = 0._r8 + mat(k,1760) = 0._r8 + mat(k,1761) = 0._r8 + mat(k,1765) = 0._r8 + mat(k,1767) = 0._r8 + mat(k,1768) = 0._r8 + mat(k,1771) = 0._r8 + mat(k,1773) = 0._r8 + mat(k,1775) = 0._r8 + mat(k,1780) = 0._r8 + mat(k,1782) = 0._r8 + mat(k,1795) = 0._r8 + mat(k,1799) = 0._r8 + mat(k,1802) = 0._r8 + mat(k,1806) = 0._r8 + mat(k,1809) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1811) = 0._r8 + mat(k,1812) = 0._r8 + mat(k,1815) = 0._r8 + mat(k,1819) = 0._r8 + mat(k,1821) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1823) = 0._r8 + mat(k,1826) = 0._r8 + mat(k,1828) = 0._r8 + mat(k,1842) = 0._r8 + mat(k,1850) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1852) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1855) = 0._r8 + mat(k,1857) = 0._r8 + mat(k,1861) = 0._r8 + mat(k,1864) = 0._r8 + mat(k,1866) = 0._r8 + mat(k,1868) = 0._r8 + mat(k,1874) = 0._r8 + mat(k,1880) = 0._r8 + mat(k,1885) = 0._r8 + mat(k,1887) = 0._r8 + mat(k,1896) = 0._r8 + mat(k,1898) = 0._r8 + mat(k,1908) = 0._r8 + mat(k,1910) = 0._r8 + mat(k,1911) = 0._r8 + mat(k,1913) = 0._r8 + mat(k,1914) = 0._r8 + mat(k,1915) = 0._r8 + mat(k,1918) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1981) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1983) = 0._r8 + mat(k,1986) = 0._r8 + mat(k,1997) = 0._r8 + mat(k,2002) = 0._r8 + mat(k,2004) = 0._r8 + mat(k,2005) = 0._r8 + mat(k,2006) = 0._r8 + mat(k,2008) = 0._r8 + mat(k,2009) = 0._r8 + mat(k,2010) = 0._r8 + mat(k,2013) = 0._r8 + mat(k,2014) = 0._r8 + mat(k,2015) = 0._r8 + mat(k,2016) = 0._r8 + mat(k,2017) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2020) = 0._r8 + mat(k,2021) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 3) = mat(k, 3) - dti(k) + mat(k, 4) = mat(k, 4) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 6) = mat(k, 6) - dti(k) + mat(k, 7) = mat(k, 7) - dti(k) + mat(k, 8) = mat(k, 8) - dti(k) + mat(k, 9) = mat(k, 9) - dti(k) + mat(k, 10) = mat(k, 10) - dti(k) + mat(k, 11) = mat(k, 11) - dti(k) + mat(k, 12) = mat(k, 12) - dti(k) + mat(k, 13) = mat(k, 13) - dti(k) + mat(k, 14) = mat(k, 14) - dti(k) + mat(k, 15) = mat(k, 15) - dti(k) + mat(k, 16) = mat(k, 16) - dti(k) + mat(k, 17) = mat(k, 17) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 19) = mat(k, 19) - dti(k) + mat(k, 20) = mat(k, 20) - dti(k) + mat(k, 21) = mat(k, 21) - dti(k) + mat(k, 22) = mat(k, 22) - dti(k) + mat(k, 23) = mat(k, 23) - dti(k) + mat(k, 24) = mat(k, 24) - dti(k) + mat(k, 25) = mat(k, 25) - dti(k) + mat(k, 26) = mat(k, 26) - dti(k) + mat(k, 27) = mat(k, 27) - dti(k) + mat(k, 28) = mat(k, 28) - dti(k) + mat(k, 29) = mat(k, 29) - dti(k) + mat(k, 30) = mat(k, 30) - dti(k) + mat(k, 31) = mat(k, 31) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 33) = mat(k, 33) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 65) = mat(k, 65) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 81) = mat(k, 81) - dti(k) + mat(k, 87) = mat(k, 87) - dti(k) + mat(k, 91) = mat(k, 91) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 109) = mat(k, 109) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 121) = mat(k, 121) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 150) = mat(k, 150) - dti(k) + mat(k, 155) = mat(k, 155) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 161) = mat(k, 161) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 168) = mat(k, 168) - dti(k) + mat(k, 172) = mat(k, 172) - dti(k) + mat(k, 176) = mat(k, 176) - dti(k) + mat(k, 180) = mat(k, 180) - dti(k) + mat(k, 184) = mat(k, 184) - dti(k) + mat(k, 190) = mat(k, 190) - dti(k) + mat(k, 193) = mat(k, 193) - dti(k) + mat(k, 199) = mat(k, 199) - dti(k) + mat(k, 205) = mat(k, 205) - dti(k) + mat(k, 211) = mat(k, 211) - dti(k) + mat(k, 214) = mat(k, 214) - dti(k) + mat(k, 219) = mat(k, 219) - dti(k) + mat(k, 224) = mat(k, 224) - dti(k) + mat(k, 229) = mat(k, 229) - dti(k) + mat(k, 234) = mat(k, 234) - dti(k) + mat(k, 240) = mat(k, 240) - dti(k) + mat(k, 245) = mat(k, 245) - dti(k) + mat(k, 250) = mat(k, 250) - dti(k) + mat(k, 258) = mat(k, 258) - dti(k) + mat(k, 266) = mat(k, 266) - dti(k) + mat(k, 272) = mat(k, 272) - dti(k) + mat(k, 278) = mat(k, 278) - dti(k) + mat(k, 284) = mat(k, 284) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 296) = mat(k, 296) - dti(k) + mat(k, 302) = mat(k, 302) - dti(k) + mat(k, 308) = mat(k, 308) - dti(k) + mat(k, 314) = mat(k, 314) - dti(k) + mat(k, 320) = mat(k, 320) - dti(k) + mat(k, 326) = mat(k, 326) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 340) = mat(k, 340) - dti(k) + mat(k, 347) = mat(k, 347) - dti(k) + mat(k, 353) = mat(k, 353) - dti(k) + mat(k, 356) = mat(k, 356) - dti(k) + mat(k, 363) = mat(k, 363) - dti(k) + mat(k, 367) = mat(k, 367) - dti(k) + mat(k, 376) = mat(k, 376) - dti(k) + mat(k, 384) = mat(k, 384) - dti(k) + mat(k, 391) = mat(k, 391) - dti(k) + mat(k, 397) = mat(k, 397) - dti(k) + mat(k, 403) = mat(k, 403) - dti(k) + mat(k, 409) = mat(k, 409) - dti(k) + mat(k, 415) = mat(k, 415) - dti(k) + mat(k, 423) = mat(k, 423) - dti(k) + mat(k, 431) = mat(k, 431) - dti(k) + mat(k, 435) = mat(k, 435) - dti(k) + mat(k, 443) = mat(k, 443) - dti(k) + mat(k, 451) = mat(k, 451) - dti(k) + mat(k, 459) = mat(k, 459) - dti(k) + mat(k, 467) = mat(k, 467) - dti(k) + mat(k, 476) = mat(k, 476) - dti(k) + mat(k, 483) = mat(k, 483) - dti(k) + mat(k, 494) = mat(k, 494) - dti(k) + mat(k, 503) = mat(k, 503) - dti(k) + mat(k, 507) = mat(k, 507) - dti(k) + mat(k, 515) = mat(k, 515) - dti(k) + mat(k, 522) = mat(k, 522) - dti(k) + mat(k, 533) = mat(k, 533) - dti(k) + mat(k, 544) = mat(k, 544) - dti(k) + mat(k, 552) = mat(k, 552) - dti(k) + mat(k, 563) = mat(k, 563) - dti(k) + mat(k, 576) = mat(k, 576) - dti(k) + mat(k, 583) = mat(k, 583) - dti(k) + mat(k, 594) = mat(k, 594) - dti(k) + mat(k, 610) = mat(k, 610) - dti(k) + mat(k, 621) = mat(k, 621) - dti(k) + mat(k, 630) = mat(k, 630) - dti(k) + mat(k, 640) = mat(k, 640) - dti(k) + mat(k, 649) = mat(k, 649) - dti(k) + mat(k, 657) = mat(k, 657) - dti(k) + mat(k, 661) = mat(k, 661) - dti(k) + mat(k, 666) = mat(k, 666) - dti(k) + mat(k, 677) = mat(k, 677) - dti(k) + mat(k, 687) = mat(k, 687) - dti(k) + mat(k, 695) = mat(k, 695) - dti(k) + mat(k, 709) = mat(k, 709) - dti(k) + mat(k, 726) = mat(k, 726) - dti(k) + mat(k, 732) = mat(k, 732) - dti(k) + mat(k, 739) = mat(k, 739) - dti(k) + mat(k, 744) = mat(k, 744) - dti(k) + mat(k, 761) = mat(k, 761) - dti(k) + mat(k, 787) = mat(k, 787) - dti(k) + mat(k, 809) = mat(k, 809) - dti(k) + mat(k, 819) = mat(k, 819) - dti(k) + mat(k, 827) = mat(k, 827) - dti(k) + mat(k, 841) = mat(k, 841) - dti(k) + mat(k, 856) = mat(k, 856) - dti(k) + mat(k, 865) = mat(k, 865) - dti(k) + mat(k, 874) = mat(k, 874) - dti(k) + mat(k, 886) = mat(k, 886) - dti(k) + mat(k, 898) = mat(k, 898) - dti(k) + mat(k, 911) = mat(k, 911) - dti(k) + mat(k, 915) = mat(k, 915) - dti(k) + mat(k, 928) = mat(k, 928) - dti(k) + mat(k, 950) = mat(k, 950) - dti(k) + mat(k, 969) = mat(k, 969) - dti(k) + mat(k, 985) = mat(k, 985) - dti(k) + mat(k, 996) = mat(k, 996) - dti(k) + mat(k,1007) = mat(k,1007) - dti(k) + mat(k,1024) = mat(k,1024) - dti(k) + mat(k,1044) = mat(k,1044) - dti(k) + mat(k,1060) = mat(k,1060) - dti(k) + mat(k,1072) = mat(k,1072) - dti(k) + mat(k,1083) = mat(k,1083) - dti(k) + mat(k,1108) = mat(k,1108) - dti(k) + mat(k,1130) = mat(k,1130) - dti(k) + mat(k,1153) = mat(k,1153) - dti(k) + mat(k,1186) = mat(k,1186) - dti(k) + mat(k,1205) = mat(k,1205) - dti(k) + mat(k,1236) = mat(k,1236) - dti(k) + mat(k,1250) = mat(k,1250) - dti(k) + mat(k,1263) = mat(k,1263) - dti(k) + mat(k,1276) = mat(k,1276) - dti(k) + mat(k,1296) = mat(k,1296) - dti(k) + mat(k,1390) = mat(k,1390) - dti(k) + mat(k,1448) = mat(k,1448) - dti(k) + mat(k,1473) = mat(k,1473) - dti(k) + mat(k,1621) = mat(k,1621) - dti(k) + mat(k,1672) = mat(k,1672) - dti(k) + mat(k,1699) = mat(k,1699) - dti(k) + mat(k,1734) = mat(k,1734) - dti(k) + mat(k,1776) = mat(k,1776) - dti(k) + mat(k,1837) = mat(k,1837) - dti(k) + mat(k,1862) = mat(k,1862) - dti(k) + mat(k,1893) = mat(k,1893) - dti(k) + mat(k,1917) = mat(k,1917) - dti(k) + mat(k,1996) = mat(k,1996) - dti(k) + mat(k,2022) = mat(k,2022) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat05( avec_len, mat, y, rxt ) + call nlnmat06( avec_len, mat, y, rxt ) + call nlnmat07( avec_len, mat, y, rxt ) + call nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 new file mode 100644 index 0000000000..5bec416298 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_phtadj.F90 @@ -0,0 +1,27 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 5) = p_rate(:,k, 5) * inv(:,k, 3) * im(:,k) + p_rate(:,k, 6) = p_rate(:,k, 6) * inv(:,k, 3) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 new file mode 100644 index 0000000000..fbfd2e434f --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 @@ -0,0 +1,1170 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,21))* y(k,21) + prod(k,2) = 0._r8 + loss(k,3) = (rxt(k,199)* y(k,210) + rxt(k,78) + het_rates(k,33))* y(k,33) + prod(k,3) = 0._r8 + loss(k,4) = (rxt(k,200)* y(k,210) + rxt(k,79) + het_rates(k,34))* y(k,34) + prod(k,4) = 0._r8 + loss(k,5) = (rxt(k,226)* y(k,210) + rxt(k,80) + het_rates(k,35))* y(k,35) + prod(k,5) = 0._r8 + loss(k,6) = (rxt(k,201)* y(k,210) + rxt(k,81) + het_rates(k,36))* y(k,36) + prod(k,6) = 0._r8 + loss(k,7) = (rxt(k,202)* y(k,210) + rxt(k,82) + het_rates(k,37))* y(k,37) + prod(k,7) = 0._r8 + loss(k,8) = (rxt(k,203)* y(k,210) + rxt(k,83) + het_rates(k,38))* y(k,38) + prod(k,8) = 0._r8 + loss(k,9) = (rxt(k,204)* y(k,210) + rxt(k,84) + het_rates(k,39))* y(k,39) + prod(k,9) = 0._r8 + loss(k,10) = (rxt(k,205)* y(k,210) + rxt(k,85) + het_rates(k,40))* y(k,40) + prod(k,10) = 0._r8 + loss(k,11) = (rxt(k,237)* y(k,56) +rxt(k,249)* y(k,210) +rxt(k,238)* y(k,211) & + + rxt(k,86) + het_rates(k,41))* y(k,41) + prod(k,11) = 0._r8 + loss(k,12) = (rxt(k,239)* y(k,56) +rxt(k,250)* y(k,210) +rxt(k,240)* y(k,211) & + + rxt(k,87) + het_rates(k,43))* y(k,43) + prod(k,12) = 0._r8 + loss(k,13) = (rxt(k,241)* y(k,211) + rxt(k,88) + het_rates(k,44))* y(k,44) + prod(k,13) = 0._r8 + loss(k,14) = (rxt(k,242)* y(k,56) +rxt(k,243)* y(k,211) + rxt(k,89) & + + het_rates(k,46))* y(k,46) + prod(k,14) = 0._r8 + loss(k,15) = (rxt(k,175)* y(k,56) +rxt(k,231)* y(k,73) + (rxt(k,271) + & + rxt(k,272) +rxt(k,273))* y(k,210) +rxt(k,264)* y(k,211) + rxt(k,39) & + + rxt(k,40) + het_rates(k,54))* y(k,54) + prod(k,15) = 0._r8 + loss(k,16) = (rxt(k,244)* y(k,56) +rxt(k,227)* y(k,210) +rxt(k,245)* y(k,211) & + + rxt(k,90) + het_rates(k,55))* y(k,55) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,61))* y(k,61) + prod(k,17) = 0._r8 + loss(k,18) = ( + rxt(k,41) + het_rates(k,63))* y(k,63) + prod(k,18) =.440_r8*rxt(k,40)*y(k,54) + loss(k,19) = ( + rxt(k,525) + het_rates(k,71))* y(k,71) + prod(k,19) = 0._r8 + loss(k,20) = (rxt(k,228)* y(k,210) + rxt(k,98) + het_rates(k,78))* y(k,78) + prod(k,20) = 0._r8 + loss(k,21) = (rxt(k,251)* y(k,210) +rxt(k,246)* y(k,211) + rxt(k,100) & + + het_rates(k,82))* y(k,82) + prod(k,21) = 0._r8 + loss(k,22) = (rxt(k,252)* y(k,210) +rxt(k,247)* y(k,211) + rxt(k,101) & + + het_rates(k,83))* y(k,83) + prod(k,22) = 0._r8 + loss(k,23) = (rxt(k,253)* y(k,210) +rxt(k,248)* y(k,211) + rxt(k,102) & + + het_rates(k,84))* y(k,84) + prod(k,23) = 0._r8 + loss(k,24) = ((rxt(k,166) +rxt(k,167))* y(k,210) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,24) = 0._r8 + loss(k,25) = ( + rxt(k,527) + het_rates(k,122))* y(k,122) + prod(k,25) = 0._r8 + loss(k,26) = ( + rxt(k,526) + het_rates(k,123))* y(k,123) + prod(k,26) = 0._r8 + loss(k,27) = ( + rxt(k,108) + het_rates(k,148))* y(k,148) + prod(k,27) = 0._r8 + loss(k,28) = ( + rxt(k,528) + het_rates(k,170))* y(k,170) + prod(k,28) = 0._r8 + loss(k,29) = ( + het_rates(k,185))* y(k,185) + prod(k,29) = 0._r8 + loss(k,30) = ( + het_rates(k,186))* y(k,186) + prod(k,30) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,121) = (rxt(k,356)* y(k,211) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,121) =rxt(k,359)*y(k,188)*y(k,124) + loss(k,120) = (rxt(k,360)* y(k,211) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,120) =rxt(k,357)*y(k,200)*y(k,188) + loss(k,1) = ( + het_rates(k,4))* y(k,4) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,5))* y(k,5) + prod(k,2) = 0._r8 + loss(k,144) = (rxt(k,439)* y(k,126) +rxt(k,440)* y(k,134) +rxt(k,441) & + * y(k,211) + het_rates(k,6))* y(k,6) + prod(k,144) = 0._r8 + loss(k,46) = (rxt(k,398)* y(k,211) + het_rates(k,7))* y(k,7) + prod(k,46) = 0._r8 + loss(k,85) = (rxt(k,401)* y(k,211) + rxt(k,21) + het_rates(k,8))* y(k,8) + prod(k,85) =rxt(k,399)*y(k,200)*y(k,189) + loss(k,47) = ( + rxt(k,22) + het_rates(k,9))* y(k,9) + prod(k,47) =.120_r8*rxt(k,398)*y(k,211)*y(k,7) + loss(k,86) = ( + rxt(k,23) + het_rates(k,10))* y(k,10) + prod(k,86) = (.100_r8*rxt(k,440)*y(k,6) +.100_r8*rxt(k,443)*y(k,110)) & + *y(k,134) + loss(k,96) = ( + rxt(k,24) + het_rates(k,11))* y(k,11) + prod(k,96) = (.500_r8*rxt(k,400)*y(k,189) +.200_r8*rxt(k,427)*y(k,217) + & + .060_r8*rxt(k,433)*y(k,219))*y(k,124) +.500_r8*rxt(k,21)*y(k,8) & + +rxt(k,22)*y(k,9) +.200_r8*rxt(k,70)*y(k,178) +.060_r8*rxt(k,72) & + *y(k,182) + loss(k,68) = ( + rxt(k,25) + het_rates(k,12))* y(k,12) + prod(k,68) = (.200_r8*rxt(k,427)*y(k,217) +.200_r8*rxt(k,433)*y(k,219)) & + *y(k,124) +.200_r8*rxt(k,70)*y(k,178) +.200_r8*rxt(k,72)*y(k,182) + loss(k,117) = ( + rxt(k,26) + het_rates(k,13))* y(k,13) + prod(k,117) = (.200_r8*rxt(k,427)*y(k,217) +.150_r8*rxt(k,433)*y(k,219)) & + *y(k,124) +rxt(k,46)*y(k,94) +rxt(k,56)*y(k,116) +.200_r8*rxt(k,70) & + *y(k,178) +.150_r8*rxt(k,72)*y(k,182) + loss(k,75) = ( + rxt(k,27) + het_rates(k,14))* y(k,14) + prod(k,75) =.210_r8*rxt(k,433)*y(k,219)*y(k,124) +.210_r8*rxt(k,72)*y(k,182) + loss(k,60) = (rxt(k,361)* y(k,211) + het_rates(k,15))* y(k,15) + prod(k,60) = (.050_r8*rxt(k,440)*y(k,6) +.050_r8*rxt(k,443)*y(k,110)) & + *y(k,134) + loss(k,81) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,211) + het_rates(k,16)) & + * y(k,16) + prod(k,81) = 0._r8 + loss(k,174) = (rxt(k,210)* y(k,42) +rxt(k,212)* y(k,134) +rxt(k,211) & + * y(k,200) + het_rates(k,17))* y(k,17) + prod(k,174) = (rxt(k,75) +2.000_r8*rxt(k,213)*y(k,19) +rxt(k,214)*y(k,59) + & + rxt(k,215)*y(k,59) +rxt(k,218)*y(k,124) +rxt(k,221)*y(k,133) + & + rxt(k,222)*y(k,211) +rxt(k,466)*y(k,149))*y(k,19) & + + (rxt(k,200)*y(k,34) +rxt(k,226)*y(k,35) + & + 3.000_r8*rxt(k,227)*y(k,55) +2.000_r8*rxt(k,228)*y(k,78) + & + 2.000_r8*rxt(k,249)*y(k,41) +rxt(k,250)*y(k,43) +rxt(k,229)*y(k,81)) & + *y(k,210) + (2.000_r8*rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) + & + 3.000_r8*rxt(k,245)*y(k,55) +rxt(k,224)*y(k,81))*y(k,211) & + + (2.000_r8*rxt(k,237)*y(k,41) +rxt(k,239)*y(k,43) + & + 3.000_r8*rxt(k,244)*y(k,55))*y(k,56) + (rxt(k,99) + & + rxt(k,223)*y(k,133))*y(k,81) +rxt(k,74)*y(k,18) +rxt(k,77)*y(k,20) & + +rxt(k,105)*y(k,91) + loss(k,61) = ( + rxt(k,74) + het_rates(k,18))* y(k,18) + prod(k,61) = (rxt(k,516)*y(k,91) +rxt(k,521)*y(k,91))*y(k,85) & + +rxt(k,216)*y(k,59)*y(k,19) + loss(k,187) = (2._r8*rxt(k,213)* y(k,19) + (rxt(k,214) +rxt(k,215) + & + rxt(k,216))* y(k,59) +rxt(k,218)* y(k,124) +rxt(k,219)* y(k,125) & + +rxt(k,221)* y(k,133) +rxt(k,466)* y(k,149) +rxt(k,217)* y(k,200) & + +rxt(k,222)* y(k,211) + rxt(k,75) + het_rates(k,19))* y(k,19) + prod(k,187) = (rxt(k,76) +rxt(k,220)*y(k,133))*y(k,20) +rxt(k,212)*y(k,134) & + *y(k,17) +rxt(k,230)*y(k,210)*y(k,81) +rxt(k,225)*y(k,133)*y(k,91) + loss(k,110) = (rxt(k,220)* y(k,133) + rxt(k,76) + rxt(k,77) + rxt(k,510) & + + rxt(k,513) + rxt(k,518) + het_rates(k,20))* y(k,20) + prod(k,110) =rxt(k,219)*y(k,125)*y(k,19) + loss(k,62) = (rxt(k,402)* y(k,211) + het_rates(k,22))* y(k,22) + prod(k,62) =rxt(k,28)*y(k,23) +rxt(k,405)*y(k,190)*y(k,124) + loss(k,78) = (rxt(k,404)* y(k,211) + rxt(k,28) + het_rates(k,23))* y(k,23) + prod(k,78) =rxt(k,403)*y(k,200)*y(k,190) + loss(k,70) = (rxt(k,276)* y(k,56) +rxt(k,277)* y(k,211) + het_rates(k,24)) & + * y(k,24) + prod(k,70) = 0._r8 + loss(k,111) = (rxt(k,278)* y(k,56) +rxt(k,279)* y(k,134) +rxt(k,304) & + * y(k,211) + het_rates(k,25))* y(k,25) + prod(k,111) = 0._r8 + loss(k,64) = (rxt(k,284)* y(k,211) + het_rates(k,26))* y(k,26) + prod(k,64) = (.400_r8*rxt(k,280)*y(k,191) +.200_r8*rxt(k,281)*y(k,195)) & + *y(k,191) + loss(k,79) = (rxt(k,285)* y(k,211) + rxt(k,29) + het_rates(k,27))* y(k,27) + prod(k,79) =rxt(k,282)*y(k,200)*y(k,191) + loss(k,71) = (rxt(k,286)* y(k,56) +rxt(k,287)* y(k,211) + het_rates(k,28)) & + * y(k,28) + prod(k,71) = 0._r8 + loss(k,149) = (rxt(k,307)* y(k,126) +rxt(k,308)* y(k,134) +rxt(k,325) & + * y(k,211) + het_rates(k,29))* y(k,29) + prod(k,149) =.130_r8*rxt(k,385)*y(k,134)*y(k,98) +.700_r8*rxt(k,55)*y(k,111) + loss(k,90) = (rxt(k,312)* y(k,211) + rxt(k,30) + het_rates(k,30))* y(k,30) + prod(k,90) =rxt(k,310)*y(k,200)*y(k,192) + loss(k,39) = (rxt(k,313)* y(k,211) + het_rates(k,31))* y(k,31) + prod(k,39) = 0._r8 + loss(k,65) = (rxt(k,408)* y(k,211) + rxt(k,31) + het_rates(k,32))* y(k,32) + prod(k,65) =rxt(k,406)*y(k,200)*y(k,193) + loss(k,189) = (rxt(k,210)* y(k,17) +rxt(k,174)* y(k,56) +rxt(k,255)* y(k,126) & + +rxt(k,256)* y(k,133) +rxt(k,254)* y(k,200) +rxt(k,257)* y(k,211) & + + rxt(k,32) + rxt(k,33) + het_rates(k,42))* y(k,42) + prod(k,189) = (rxt(k,181)*y(k,59) +2.000_r8*rxt(k,258)*y(k,195) + & + rxt(k,259)*y(k,195) +rxt(k,261)*y(k,124) + & + .700_r8*rxt(k,281)*y(k,191) +rxt(k,292)*y(k,194) + & + rxt(k,309)*y(k,192) +.800_r8*rxt(k,321)*y(k,214) + & + .880_r8*rxt(k,333)*y(k,204) +2.000_r8*rxt(k,342)*y(k,206) + & + 1.500_r8*rxt(k,366)*y(k,202) +.750_r8*rxt(k,371)*y(k,203) + & + .800_r8*rxt(k,380)*y(k,101) +.800_r8*rxt(k,391)*y(k,218) + & + .750_r8*rxt(k,445)*y(k,209) +.930_r8*rxt(k,450)*y(k,215) + & + .950_r8*rxt(k,455)*y(k,216))*y(k,195) & + + (.500_r8*rxt(k,298)*y(k,199) +rxt(k,319)*y(k,213) + & + rxt(k,323)*y(k,214) +.500_r8*rxt(k,329)*y(k,197) + & + .250_r8*rxt(k,336)*y(k,204) +rxt(k,345)*y(k,206) + & + .100_r8*rxt(k,358)*y(k,188) +.920_r8*rxt(k,368)*y(k,202) + & + .250_r8*rxt(k,393)*y(k,218) +.340_r8*rxt(k,452)*y(k,215) + & + .320_r8*rxt(k,457)*y(k,216))*y(k,124) + (rxt(k,262)*y(k,52) + & + .300_r8*rxt(k,263)*y(k,53) +.500_r8*rxt(k,296)*y(k,51) + & + .800_r8*rxt(k,301)*y(k,74) +rxt(k,303)*y(k,138) + & + .500_r8*rxt(k,351)*y(k,109) +.400_r8*rxt(k,356)*y(k,1) + & + .300_r8*rxt(k,376)*y(k,99) +.680_r8*rxt(k,461)*y(k,177))*y(k,211) & + + (rxt(k,279)*y(k,25) +.500_r8*rxt(k,308)*y(k,29) + & + .120_r8*rxt(k,338)*y(k,105) +.600_r8*rxt(k,352)*y(k,111) + & + .910_r8*rxt(k,385)*y(k,98) +.340_r8*rxt(k,440)*y(k,6) + & + .340_r8*rxt(k,443)*y(k,110))*y(k,134) + (.500_r8*rxt(k,327)*y(k,16) + & + .250_r8*rxt(k,335)*y(k,204) +rxt(k,346)*y(k,206) + & + rxt(k,369)*y(k,202))*y(k,126) + (.250_r8*rxt(k,332)*y(k,204) + & + rxt(k,341)*y(k,206) +rxt(k,365)*y(k,202) + & + .250_r8*rxt(k,390)*y(k,218))*y(k,194) + (rxt(k,272)*y(k,210) + & + rxt(k,273)*y(k,210))*y(k,54) + (.150_r8*rxt(k,322)*y(k,214) + & + .450_r8*rxt(k,343)*y(k,206))*y(k,200) +.100_r8*rxt(k,19)*y(k,1) & + +.100_r8*rxt(k,20)*y(k,2) +rxt(k,38)*y(k,53) +rxt(k,43)*y(k,74) & + +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47)*y(k,95) +.690_r8*rxt(k,49) & + *y(k,103) +1.340_r8*rxt(k,50)*y(k,105) +rxt(k,57)*y(k,127) +rxt(k,62) & + *y(k,145) +rxt(k,63)*y(k,146) +.375_r8*rxt(k,65)*y(k,173) & + +.400_r8*rxt(k,67)*y(k,175) +.680_r8*rxt(k,69)*y(k,177) & + +2.000_r8*rxt(k,299)*y(k,198) +rxt(k,269)*y(k,201) & + +2.000_r8*rxt(k,344)*y(k,206)*y(k,206) + loss(k,161) = (rxt(k,288)* y(k,126) +rxt(k,289)* y(k,211) + rxt(k,34) & + + het_rates(k,45))* y(k,45) + prod(k,161) = (rxt(k,283)*y(k,191) +.270_r8*rxt(k,311)*y(k,192) + & + rxt(k,319)*y(k,213) +rxt(k,329)*y(k,197) +rxt(k,348)*y(k,208) + & + .400_r8*rxt(k,358)*y(k,188))*y(k,124) + (rxt(k,284)*y(k,26) + & + .500_r8*rxt(k,285)*y(k,27) +.800_r8*rxt(k,356)*y(k,1))*y(k,211) & + + (.500_r8*rxt(k,308)*y(k,29) +.100_r8*rxt(k,352)*y(k,111))*y(k,134) & + + (1.600_r8*rxt(k,280)*y(k,191) +.800_r8*rxt(k,281)*y(k,195)) & + *y(k,191) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,327)*y(k,126)*y(k,16) +rxt(k,29)*y(k,27) +.330_r8*rxt(k,45) & + *y(k,93) +rxt(k,53)*y(k,108) +rxt(k,62)*y(k,145) & + +.200_r8*rxt(k,347)*y(k,208)*y(k,200) + loss(k,38) = (rxt(k,290)* y(k,211) + het_rates(k,47))* y(k,47) + prod(k,38) = 0._r8 + loss(k,147) = (rxt(k,326)* y(k,211) + rxt(k,35) + het_rates(k,48))* y(k,48) + prod(k,147) = (.820_r8*rxt(k,311)*y(k,192) +.500_r8*rxt(k,329)*y(k,197) + & + .250_r8*rxt(k,358)*y(k,188) +.270_r8*rxt(k,452)*y(k,215) + & + .040_r8*rxt(k,457)*y(k,216))*y(k,124) & + + (.820_r8*rxt(k,309)*y(k,192) +.150_r8*rxt(k,450)*y(k,215) + & + .025_r8*rxt(k,455)*y(k,216))*y(k,195) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,356)*y(k,211))*y(k,1) + (.520_r8*rxt(k,440)*y(k,6) + & + .520_r8*rxt(k,443)*y(k,110))*y(k,134) + (.500_r8*rxt(k,69) + & + .500_r8*rxt(k,461)*y(k,211))*y(k,177) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,327)*y(k,126)*y(k,16) +.820_r8*rxt(k,30)*y(k,30) & + +.170_r8*rxt(k,45)*y(k,93) +.300_r8*rxt(k,65)*y(k,173) & + +.050_r8*rxt(k,67)*y(k,175) + loss(k,166) = (rxt(k,314)* y(k,126) +rxt(k,315)* y(k,211) + rxt(k,36) & + + het_rates(k,49))* y(k,49) + prod(k,166) = (.250_r8*rxt(k,336)*y(k,204) +.050_r8*rxt(k,374)*y(k,203) + & + .250_r8*rxt(k,393)*y(k,218) +.170_r8*rxt(k,411)*y(k,196) + & + .170_r8*rxt(k,417)*y(k,207) +.400_r8*rxt(k,427)*y(k,217) + & + .540_r8*rxt(k,433)*y(k,219) +.510_r8*rxt(k,436)*y(k,220))*y(k,124) & + + (.250_r8*rxt(k,335)*y(k,204) +.050_r8*rxt(k,375)*y(k,203) + & + .250_r8*rxt(k,394)*y(k,218))*y(k,126) & + + (.500_r8*rxt(k,321)*y(k,214) +.240_r8*rxt(k,333)*y(k,204) + & + .100_r8*rxt(k,391)*y(k,218))*y(k,195) & + + (.880_r8*rxt(k,338)*y(k,105) +.500_r8*rxt(k,352)*y(k,111)) & + *y(k,134) + (.250_r8*rxt(k,332)*y(k,204) + & + .250_r8*rxt(k,390)*y(k,218))*y(k,194) & + + (.070_r8*rxt(k,410)*y(k,196) +.070_r8*rxt(k,416)*y(k,207)) & + *y(k,200) + (rxt(k,316)*y(k,95) +rxt(k,317)*y(k,127))*y(k,211) & + +.180_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +.400_r8*rxt(k,70) & + *y(k,178) +.540_r8*rxt(k,72)*y(k,182) +.510_r8*rxt(k,73)*y(k,184) + loss(k,108) = (rxt(k,295)* y(k,211) + het_rates(k,50))* y(k,50) + prod(k,108) = (.100_r8*rxt(k,292)*y(k,195) +.150_r8*rxt(k,293)*y(k,200)) & + *y(k,194) +.120_r8*rxt(k,308)*y(k,134)*y(k,29) & + +.150_r8*rxt(k,343)*y(k,206)*y(k,200) + loss(k,102) = (rxt(k,296)* y(k,211) + rxt(k,37) + het_rates(k,51))* y(k,51) + prod(k,102) = (.400_r8*rxt(k,293)*y(k,194) +.400_r8*rxt(k,343)*y(k,206)) & + *y(k,200) + loss(k,134) = (rxt(k,262)* y(k,211) + het_rates(k,52))* y(k,52) + prod(k,134) = (rxt(k,259)*y(k,195) +.300_r8*rxt(k,281)*y(k,191) + & + .500_r8*rxt(k,321)*y(k,214) +.250_r8*rxt(k,333)*y(k,204) + & + .250_r8*rxt(k,366)*y(k,202) +.250_r8*rxt(k,371)*y(k,203) + & + .200_r8*rxt(k,380)*y(k,101) +.300_r8*rxt(k,391)*y(k,218) + & + .250_r8*rxt(k,445)*y(k,209) +.250_r8*rxt(k,450)*y(k,215) + & + .250_r8*rxt(k,455)*y(k,216))*y(k,195) + loss(k,91) = (rxt(k,263)* y(k,211) + rxt(k,38) + het_rates(k,53))* y(k,53) + prod(k,91) =rxt(k,260)*y(k,200)*y(k,195) + loss(k,184) = (rxt(k,286)* y(k,28) +rxt(k,237)* y(k,41) +rxt(k,174)* y(k,42) & + +rxt(k,239)* y(k,43) +rxt(k,242)* y(k,46) +rxt(k,175)* y(k,54) & + +rxt(k,244)* y(k,55) +rxt(k,187)* y(k,60) +rxt(k,176)* y(k,77) & + +rxt(k,177)* y(k,79) +rxt(k,196)* y(k,92) +rxt(k,180)* y(k,134) & + + (rxt(k,178) +rxt(k,179))* y(k,200) + het_rates(k,56))* y(k,56) + prod(k,184) = (4.000_r8*rxt(k,199)*y(k,33) +rxt(k,200)*y(k,34) + & + 2.000_r8*rxt(k,201)*y(k,36) +2.000_r8*rxt(k,202)*y(k,37) + & + 2.000_r8*rxt(k,203)*y(k,38) +rxt(k,204)*y(k,39) + & + 2.000_r8*rxt(k,205)*y(k,40) +rxt(k,251)*y(k,82) +rxt(k,252)*y(k,83) + & + rxt(k,253)*y(k,84) +rxt(k,206)*y(k,85) +rxt(k,236)*y(k,65))*y(k,210) & + + (rxt(k,93) +rxt(k,181)*y(k,195) +2.000_r8*rxt(k,182)*y(k,59) + & + rxt(k,184)*y(k,59) +rxt(k,186)*y(k,124) +rxt(k,191)*y(k,133) + & + rxt(k,192)*y(k,211) +rxt(k,215)*y(k,19) +rxt(k,467)*y(k,149))*y(k,59) & + + (3.000_r8*rxt(k,241)*y(k,44) +rxt(k,243)*y(k,46) + & + rxt(k,246)*y(k,82) +rxt(k,247)*y(k,83) +rxt(k,248)*y(k,84) + & + rxt(k,195)*y(k,85))*y(k,211) + (rxt(k,103) +rxt(k,194)*y(k,133)) & + *y(k,85) +rxt(k,74)*y(k,18) +2.000_r8*rxt(k,91)*y(k,57) & + +2.000_r8*rxt(k,92)*y(k,58) +rxt(k,94)*y(k,60) +rxt(k,97)*y(k,65) & + +rxt(k,106)*y(k,92) + loss(k,45) = ( + rxt(k,91) + het_rates(k,57))* y(k,57) + prod(k,45) = (rxt(k,509)*y(k,92) +rxt(k,514)*y(k,60) +rxt(k,515)*y(k,92) + & + rxt(k,519)*y(k,60) +rxt(k,520)*y(k,92) +rxt(k,524)*y(k,60))*y(k,85) & + +rxt(k,187)*y(k,60)*y(k,56) +rxt(k,183)*y(k,59)*y(k,59) + loss(k,36) = ( + rxt(k,92) + rxt(k,209) + het_rates(k,58))* y(k,58) + prod(k,36) =rxt(k,208)*y(k,59)*y(k,59) + loss(k,183) = ((rxt(k,214) +rxt(k,215) +rxt(k,216))* y(k,19) & + + 2._r8*(rxt(k,182) +rxt(k,183) +rxt(k,184) +rxt(k,208))* y(k,59) & + +rxt(k,186)* y(k,124) +rxt(k,188)* y(k,125) +rxt(k,191)* y(k,133) & + +rxt(k,467)* y(k,149) +rxt(k,181)* y(k,195) +rxt(k,185)* y(k,200) & + + (rxt(k,192) +rxt(k,193))* y(k,211) + rxt(k,93) + het_rates(k,59)) & + * y(k,59) + prod(k,183) = (rxt(k,179)*y(k,200) +rxt(k,180)*y(k,134) +rxt(k,196)*y(k,92)) & + *y(k,56) + (rxt(k,95) +rxt(k,189)*y(k,133))*y(k,60) & + + (rxt(k,197)*y(k,133) +rxt(k,198)*y(k,211))*y(k,92) + (rxt(k,107) + & + rxt(k,472)*y(k,149))*y(k,135) +2.000_r8*rxt(k,209)*y(k,58) & + +rxt(k,207)*y(k,210)*y(k,85) + loss(k,148) = (rxt(k,187)* y(k,56) + (rxt(k,514) +rxt(k,519) +rxt(k,524)) & + * y(k,85) +rxt(k,189)* y(k,133) +rxt(k,190)* y(k,211) + rxt(k,94) & + + rxt(k,95) + rxt(k,512) + rxt(k,517) + rxt(k,523) & + + het_rates(k,60))* y(k,60) + prod(k,148) =rxt(k,188)*y(k,125)*y(k,59) + loss(k,155) = ((rxt(k,265) +rxt(k,275))* y(k,211) + het_rates(k,62))* y(k,62) + prod(k,155) = (rxt(k,32) +rxt(k,33) +rxt(k,174)*y(k,56) +rxt(k,210)*y(k,17) + & + rxt(k,255)*y(k,126) +rxt(k,256)*y(k,133) +rxt(k,257)*y(k,211)) & + *y(k,42) + (.630_r8*rxt(k,279)*y(k,25) +.560_r8*rxt(k,308)*y(k,29) + & + .650_r8*rxt(k,338)*y(k,105) +.560_r8*rxt(k,352)*y(k,111) + & + .620_r8*rxt(k,385)*y(k,98) +.230_r8*rxt(k,440)*y(k,6) + & + .230_r8*rxt(k,443)*y(k,110))*y(k,134) & + + (.220_r8*rxt(k,336)*y(k,204) +.250_r8*rxt(k,393)*y(k,218) + & + .170_r8*rxt(k,411)*y(k,196) +.400_r8*rxt(k,414)*y(k,205) + & + .350_r8*rxt(k,417)*y(k,207) +.225_r8*rxt(k,452)*y(k,215))*y(k,124) & + + (.350_r8*rxt(k,277)*y(k,24) +rxt(k,302)*y(k,75) + & + rxt(k,315)*y(k,49) +.700_r8*rxt(k,461)*y(k,177) +rxt(k,463)*y(k,136)) & + *y(k,211) + (rxt(k,314)*y(k,49) +.220_r8*rxt(k,335)*y(k,204) + & + .500_r8*rxt(k,394)*y(k,218))*y(k,126) & + + (.110_r8*rxt(k,333)*y(k,204) +.200_r8*rxt(k,391)*y(k,218) + & + .125_r8*rxt(k,450)*y(k,215))*y(k,195) & + + (.070_r8*rxt(k,410)*y(k,196) +.160_r8*rxt(k,413)*y(k,205) + & + .140_r8*rxt(k,416)*y(k,207))*y(k,200) + (rxt(k,110) + & + rxt(k,462)*y(k,133))*y(k,136) + (.220_r8*rxt(k,332)*y(k,204) + & + .250_r8*rxt(k,390)*y(k,218))*y(k,194) +1.500_r8*rxt(k,22)*y(k,9) & + +.450_r8*rxt(k,23)*y(k,10) +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27) & + *y(k,14) +rxt(k,34)*y(k,45) +rxt(k,242)*y(k,56)*y(k,46) +rxt(k,36) & + *y(k,49) +rxt(k,43)*y(k,74) +2.000_r8*rxt(k,44)*y(k,75) & + +.330_r8*rxt(k,45)*y(k,93) +1.340_r8*rxt(k,51)*y(k,105) & + +.700_r8*rxt(k,55)*y(k,111) +1.500_r8*rxt(k,64)*y(k,172) & + +.250_r8*rxt(k,65)*y(k,173) +rxt(k,68)*y(k,176) +1.700_r8*rxt(k,69) & + *y(k,177) + loss(k,40) = (rxt(k,235)* y(k,210) + rxt(k,96) + het_rates(k,64))* y(k,64) + prod(k,40) = (rxt(k,200)*y(k,34) +rxt(k,202)*y(k,37) + & + 2.000_r8*rxt(k,203)*y(k,38) +2.000_r8*rxt(k,204)*y(k,39) + & + rxt(k,205)*y(k,40) +rxt(k,226)*y(k,35) +2.000_r8*rxt(k,228)*y(k,78) + & + rxt(k,252)*y(k,83) +rxt(k,253)*y(k,84))*y(k,210) & + + (rxt(k,247)*y(k,83) +rxt(k,248)*y(k,84))*y(k,211) + loss(k,50) = (rxt(k,236)* y(k,210) + rxt(k,97) + het_rates(k,65))* y(k,65) + prod(k,50) = (rxt(k,201)*y(k,36) +rxt(k,202)*y(k,37) +rxt(k,251)*y(k,82)) & + *y(k,210) +rxt(k,246)*y(k,211)*y(k,82) + loss(k,52) = (rxt(k,409)* y(k,211) + het_rates(k,66))* y(k,66) + prod(k,52) =.180_r8*rxt(k,429)*y(k,211)*y(k,179) + loss(k,69) = (rxt(k,476)* y(k,126) + (rxt(k,477) +rxt(k,479))* y(k,211) & + + het_rates(k,67))* y(k,67) + prod(k,69) = 0._r8 + loss(k,3) = ( + het_rates(k,68))* y(k,68) + prod(k,3) = 0._r8 + loss(k,4) = ( + het_rates(k,69))* y(k,69) + prod(k,4) = 0._r8 + loss(k,5) = ( + het_rates(k,70))* y(k,70) + prod(k,5) = 0._r8 + loss(k,41) = ( + rxt(k,42) + het_rates(k,72))* y(k,72) + prod(k,41) =rxt(k,297)*y(k,200)*y(k,199) + loss(k,132) = (rxt(k,231)* y(k,54) +rxt(k,232)* y(k,77) +rxt(k,234)* y(k,89) & + +rxt(k,233)* y(k,221) + het_rates(k,73))* y(k,73) + prod(k,132) = (rxt(k,204)*y(k,39) +rxt(k,226)*y(k,35) + & + 2.000_r8*rxt(k,235)*y(k,64) +rxt(k,236)*y(k,65))*y(k,210) & + +2.000_r8*rxt(k,96)*y(k,64) +rxt(k,97)*y(k,65) +rxt(k,104)*y(k,88) + loss(k,151) = (rxt(k,301)* y(k,211) + rxt(k,43) + het_rates(k,74))* y(k,74) + prod(k,151) = (.530_r8*rxt(k,336)*y(k,204) +.050_r8*rxt(k,374)*y(k,203) + & + .250_r8*rxt(k,393)*y(k,218) +.225_r8*rxt(k,452)*y(k,215))*y(k,124) & + + (.530_r8*rxt(k,335)*y(k,204) +.050_r8*rxt(k,375)*y(k,203) + & + .250_r8*rxt(k,394)*y(k,218))*y(k,126) & + + (.260_r8*rxt(k,333)*y(k,204) +.100_r8*rxt(k,391)*y(k,218) + & + .125_r8*rxt(k,450)*y(k,215))*y(k,195) + (.700_r8*rxt(k,376)*y(k,99) + & + .500_r8*rxt(k,377)*y(k,100) +rxt(k,388)*y(k,115))*y(k,211) & + + (.530_r8*rxt(k,332)*y(k,204) +.250_r8*rxt(k,390)*y(k,218)) & + *y(k,194) +.330_r8*rxt(k,45)*y(k,93) +.250_r8*rxt(k,65)*y(k,173) & + +rxt(k,300)*y(k,198) + loss(k,142) = (rxt(k,302)* y(k,211) + rxt(k,44) + rxt(k,480) & + + het_rates(k,75))* y(k,75) + prod(k,142) = (.050_r8*rxt(k,374)*y(k,203) +.250_r8*rxt(k,393)*y(k,218) + & + rxt(k,400)*y(k,189) +.400_r8*rxt(k,414)*y(k,205) + & + .170_r8*rxt(k,417)*y(k,207) +.700_r8*rxt(k,420)*y(k,212) + & + .600_r8*rxt(k,427)*y(k,217) +.340_r8*rxt(k,433)*y(k,219) + & + .170_r8*rxt(k,436)*y(k,220))*y(k,124) + (.650_r8*rxt(k,277)*y(k,24) + & + .200_r8*rxt(k,301)*y(k,74) +rxt(k,389)*y(k,116))*y(k,211) & + + (.250_r8*rxt(k,390)*y(k,194) +.100_r8*rxt(k,391)*y(k,195) + & + .250_r8*rxt(k,394)*y(k,126))*y(k,218) & + + (.160_r8*rxt(k,413)*y(k,205) +.070_r8*rxt(k,416)*y(k,207)) & + *y(k,200) +rxt(k,21)*y(k,8) +.130_r8*rxt(k,23)*y(k,10) & + +.050_r8*rxt(k,375)*y(k,203)*y(k,126) +.700_r8*rxt(k,61)*y(k,142) & + +.600_r8*rxt(k,70)*y(k,178) +.340_r8*rxt(k,72)*y(k,182) & + +.170_r8*rxt(k,73)*y(k,184) + loss(k,176) = (rxt(k,140)* y(k,134) + (rxt(k,134) +rxt(k,135) +rxt(k,136)) & + * y(k,200) + rxt(k,137) + het_rates(k,76))* y(k,76) + prod(k,176) = (rxt(k,141)*y(k,77) +rxt(k,144)*y(k,133) +rxt(k,162)*y(k,112) + & + rxt(k,257)*y(k,42) +rxt(k,275)*y(k,62) +rxt(k,463)*y(k,136) + & + rxt(k,468)*y(k,147) +rxt(k,473)*y(k,149))*y(k,211) & + + (rxt(k,124)*y(k,210) +rxt(k,132)*y(k,133) +rxt(k,176)*y(k,56) + & + rxt(k,232)*y(k,73))*y(k,77) + (rxt(k,272)*y(k,54) + & + rxt(k,207)*y(k,85) +rxt(k,230)*y(k,81))*y(k,210) + (rxt(k,2) + & + 2.000_r8*rxt(k,3))*y(k,221) +2.000_r8*rxt(k,32)*y(k,42) +rxt(k,38) & + *y(k,53) +rxt(k,99)*y(k,81) +rxt(k,103)*y(k,85) +rxt(k,104)*y(k,88) + loss(k,162) = (rxt(k,176)* y(k,56) +rxt(k,232)* y(k,73) +rxt(k,132)* y(k,133) & + +rxt(k,124)* y(k,210) +rxt(k,141)* y(k,211) + het_rates(k,77)) & + * y(k,77) + prod(k,162) =rxt(k,33)*y(k,42) +rxt(k,273)*y(k,210)*y(k,54) & + +rxt(k,134)*y(k,200)*y(k,76) +rxt(k,1)*y(k,221) + loss(k,114) = (rxt(k,177)* y(k,56) +rxt(k,133)* y(k,133) +rxt(k,142) & + * y(k,211) + rxt(k,4) + het_rates(k,79))* y(k,79) + prod(k,114) = (.500_r8*rxt(k,481) +rxt(k,148)*y(k,200))*y(k,200) & + +rxt(k,147)*y(k,211)*y(k,211) + loss(k,42) = ( + rxt(k,109) + het_rates(k,80))* y(k,80) + prod(k,42) =rxt(k,475)*y(k,221)*y(k,151) + loss(k,138) = (rxt(k,223)* y(k,133) + (rxt(k,229) +rxt(k,230))* y(k,210) & + +rxt(k,224)* y(k,211) + rxt(k,99) + het_rates(k,81))* y(k,81) + prod(k,138) = (rxt(k,210)*y(k,42) +rxt(k,211)*y(k,200))*y(k,17) + loss(k,177) = ((rxt(k,514) +rxt(k,519) +rxt(k,524))* y(k,60) + (rxt(k,516) + & + rxt(k,521))* y(k,91) + (rxt(k,509) +rxt(k,515) +rxt(k,520))* y(k,92) & + +rxt(k,194)* y(k,133) + (rxt(k,206) +rxt(k,207))* y(k,210) & + +rxt(k,195)* y(k,211) + rxt(k,103) + het_rates(k,85))* y(k,85) + prod(k,177) = (rxt(k,175)*y(k,54) +rxt(k,237)*y(k,41) +rxt(k,239)*y(k,43) + & + 2.000_r8*rxt(k,242)*y(k,46) +rxt(k,244)*y(k,55) +rxt(k,174)*y(k,42) + & + rxt(k,176)*y(k,77) +rxt(k,177)*y(k,79) +rxt(k,178)*y(k,200) + & + rxt(k,196)*y(k,92) +rxt(k,286)*y(k,28))*y(k,56) +rxt(k,193)*y(k,211) & + *y(k,59) + loss(k,49) = (rxt(k,274)* y(k,210) +rxt(k,266)* y(k,211) + het_rates(k,86)) & + * y(k,86) + prod(k,49) = 0._r8 + loss(k,133) = (rxt(k,267)* y(k,211) + het_rates(k,87))* y(k,87) + prod(k,133) = (.370_r8*rxt(k,279)*y(k,25) +.120_r8*rxt(k,308)*y(k,29) + & + .330_r8*rxt(k,338)*y(k,105) +.120_r8*rxt(k,352)*y(k,111) + & + .110_r8*rxt(k,385)*y(k,98) +.050_r8*rxt(k,440)*y(k,6) + & + .050_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,268)*y(k,200) + & + rxt(k,270)*y(k,124))*y(k,201) +.350_r8*rxt(k,277)*y(k,211)*y(k,24) + loss(k,57) = ( + rxt(k,104) + het_rates(k,88))* y(k,88) + prod(k,57) = (rxt(k,231)*y(k,54) +rxt(k,232)*y(k,77) +rxt(k,233)*y(k,221) + & + rxt(k,234)*y(k,89))*y(k,73) + loss(k,175) = (rxt(k,234)* y(k,73) +rxt(k,171)* y(k,211) + rxt(k,9) & + + het_rates(k,89))* y(k,89) + prod(k,175) = (rxt(k,512) +rxt(k,517) +rxt(k,523) +rxt(k,514)*y(k,85) + & + rxt(k,519)*y(k,85) +rxt(k,524)*y(k,85))*y(k,60) + (rxt(k,490) + & + rxt(k,255)*y(k,42) +rxt(k,288)*y(k,45) +rxt(k,314)*y(k,49) + & + rxt(k,476)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,485) + & + 2.000_r8*rxt(k,508) +2.000_r8*rxt(k,511) +2.000_r8*rxt(k,522)) & + *y(k,114) + (rxt(k,510) +rxt(k,513) +rxt(k,518))*y(k,20) & + + (.500_r8*rxt(k,489) +rxt(k,170)*y(k,211))*y(k,125) +rxt(k,482) & + *y(k,93) +rxt(k,483)*y(k,99) +rxt(k,484)*y(k,100) +rxt(k,486) & + *y(k,115) +rxt(k,487)*y(k,116) +rxt(k,491)*y(k,128) +rxt(k,492) & + *y(k,137) +rxt(k,493)*y(k,174) + loss(k,83) = (rxt(k,149)* y(k,211) + rxt(k,10) + rxt(k,11) + rxt(k,172) & + + het_rates(k,90))* y(k,90) + prod(k,83) =rxt(k,168)*y(k,200)*y(k,125) + loss(k,131) = ((rxt(k,516) +rxt(k,521))* y(k,85) +rxt(k,225)* y(k,133) & + + rxt(k,105) + het_rates(k,91))* y(k,91) + prod(k,131) = (rxt(k,510) +rxt(k,513) +rxt(k,518))*y(k,20) & + +rxt(k,217)*y(k,200)*y(k,19) + loss(k,136) = (rxt(k,196)* y(k,56) + (rxt(k,509) +rxt(k,515) +rxt(k,520)) & + * y(k,85) +rxt(k,197)* y(k,133) +rxt(k,198)* y(k,211) + rxt(k,106) & + + het_rates(k,92))* y(k,92) + prod(k,136) = (rxt(k,512) +rxt(k,517) +rxt(k,523) +rxt(k,190)*y(k,211)) & + *y(k,60) +rxt(k,185)*y(k,200)*y(k,59) + loss(k,154) = (rxt(k,331)* y(k,211) + rxt(k,45) + rxt(k,482) & + + het_rates(k,93))* y(k,93) + prod(k,154) = (rxt(k,330)*y(k,197) +rxt(k,337)*y(k,204))*y(k,124) & + + (.300_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,211) + loss(k,58) = (rxt(k,362)* y(k,211) + rxt(k,46) + het_rates(k,94))* y(k,94) + prod(k,58) =rxt(k,373)*y(k,203) + loss(k,156) = (rxt(k,316)* y(k,211) + rxt(k,47) + het_rates(k,95))* y(k,95) + prod(k,156) = (.220_r8*rxt(k,332)*y(k,194) +.230_r8*rxt(k,333)*y(k,195) + & + .220_r8*rxt(k,335)*y(k,126) +.220_r8*rxt(k,336)*y(k,124))*y(k,204) & + + (.500_r8*rxt(k,320)*y(k,145) +.500_r8*rxt(k,351)*y(k,109) + & + .700_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,211) & + + (.250_r8*rxt(k,390)*y(k,194) +.100_r8*rxt(k,391)*y(k,195) + & + .250_r8*rxt(k,393)*y(k,124) +.250_r8*rxt(k,394)*y(k,126))*y(k,218) & + + (.050_r8*rxt(k,374)*y(k,124) +.050_r8*rxt(k,375)*y(k,126)) & + *y(k,203) +.170_r8*rxt(k,45)*y(k,93) +.200_r8*rxt(k,321)*y(k,214) & + *y(k,195) + loss(k,72) = (rxt(k,363)* y(k,211) + het_rates(k,96))* y(k,96) + prod(k,72) = (rxt(k,370)*y(k,194) +.750_r8*rxt(k,371)*y(k,195) + & + .870_r8*rxt(k,374)*y(k,124) +.950_r8*rxt(k,375)*y(k,126))*y(k,203) + loss(k,43) = (rxt(k,364)* y(k,211) + het_rates(k,97))* y(k,97) + prod(k,43) =.600_r8*rxt(k,387)*y(k,211)*y(k,103) + loss(k,139) = (rxt(k,378)* y(k,126) +rxt(k,385)* y(k,134) +rxt(k,386) & + * y(k,211) + het_rates(k,98))* y(k,98) + prod(k,139) = 0._r8 + loss(k,113) = (rxt(k,376)* y(k,211) + rxt(k,483) + het_rates(k,99))* y(k,99) + prod(k,113) =.080_r8*rxt(k,368)*y(k,202)*y(k,124) + loss(k,107) = (rxt(k,377)* y(k,211) + rxt(k,484) + het_rates(k,100)) & + * y(k,100) + prod(k,107) =.080_r8*rxt(k,374)*y(k,203)*y(k,124) + loss(k,164) = (rxt(k,382)* y(k,124) +rxt(k,383)* y(k,126) +rxt(k,379) & + * y(k,194) +rxt(k,380)* y(k,195) +rxt(k,381)* y(k,200) & + + het_rates(k,101))* y(k,101) + prod(k,164) =rxt(k,378)*y(k,126)*y(k,98) + loss(k,89) = (rxt(k,384)* y(k,211) + rxt(k,48) + het_rates(k,102))* y(k,102) + prod(k,89) =rxt(k,381)*y(k,200)*y(k,101) + loss(k,123) = (rxt(k,387)* y(k,211) + rxt(k,49) + het_rates(k,103))* y(k,103) + prod(k,123) = (rxt(k,367)*y(k,202) +rxt(k,372)*y(k,203))*y(k,200) +rxt(k,48) & + *y(k,102) + loss(k,34) = (rxt(k,501)* y(k,211) + het_rates(k,104))* y(k,104) + prod(k,34) = 0._r8 + loss(k,165) = (rxt(k,338)* y(k,134) +rxt(k,339)* y(k,211) + rxt(k,50) & + + rxt(k,51) + het_rates(k,105))* y(k,105) + prod(k,165) = (.390_r8*rxt(k,365)*y(k,194) +.310_r8*rxt(k,366)*y(k,195) + & + .360_r8*rxt(k,368)*y(k,124) +.400_r8*rxt(k,369)*y(k,126))*y(k,202) & + +.300_r8*rxt(k,385)*y(k,134)*y(k,98) +.288_r8*rxt(k,49)*y(k,103) + loss(k,73) = (rxt(k,340)* y(k,211) + het_rates(k,106))* y(k,106) + prod(k,73) =rxt(k,334)*y(k,204)*y(k,200) + loss(k,104) = (rxt(k,349)* y(k,211) + rxt(k,52) + het_rates(k,107))* y(k,107) + prod(k,104) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,358)*y(k,188)*y(k,124) + loss(k,74) = (rxt(k,350)* y(k,211) + rxt(k,53) + het_rates(k,108))* y(k,108) + prod(k,74) =.800_r8*rxt(k,347)*y(k,208)*y(k,200) + loss(k,106) = (rxt(k,351)* y(k,211) + rxt(k,54) + rxt(k,355) & + + het_rates(k,109))* y(k,109) + prod(k,106) =rxt(k,354)*y(k,206)*y(k,125) + loss(k,145) = (rxt(k,442)* y(k,126) +rxt(k,443)* y(k,134) +rxt(k,444) & + * y(k,211) + het_rates(k,110))* y(k,110) + prod(k,145) = 0._r8 + loss(k,169) = (rxt(k,352)* y(k,134) +rxt(k,353)* y(k,211) + rxt(k,55) & + + het_rates(k,111))* y(k,111) + prod(k,169) = (.610_r8*rxt(k,365)*y(k,194) +.440_r8*rxt(k,366)*y(k,195) + & + .560_r8*rxt(k,368)*y(k,124) +.600_r8*rxt(k,369)*y(k,126))*y(k,202) & + +.200_r8*rxt(k,385)*y(k,134)*y(k,98) +.402_r8*rxt(k,49)*y(k,103) + loss(k,82) = (rxt(k,150)* y(k,124) + (rxt(k,151) +rxt(k,152) +rxt(k,153)) & + * y(k,125) +rxt(k,162)* y(k,211) + rxt(k,154) + het_rates(k,112)) & + * y(k,112) + prod(k,82) =rxt(k,15)*y(k,124) + loss(k,67) = ( + rxt(k,13) + rxt(k,14) + rxt(k,173) + rxt(k,485) + rxt(k,508) & + + rxt(k,511) + rxt(k,522) + het_rates(k,114))* y(k,114) + prod(k,67) =rxt(k,169)*y(k,126)*y(k,125) + loss(k,84) = (rxt(k,388)* y(k,211) + rxt(k,486) + het_rates(k,115))* y(k,115) + prod(k,84) =.200_r8*rxt(k,380)*y(k,195)*y(k,101) + loss(k,152) = (rxt(k,389)* y(k,211) + rxt(k,56) + rxt(k,487) & + + het_rates(k,116))* y(k,116) + prod(k,152) = (rxt(k,379)*y(k,194) +.800_r8*rxt(k,380)*y(k,195) + & + rxt(k,382)*y(k,124) +rxt(k,383)*y(k,126))*y(k,101) + loss(k,6) = ( + het_rates(k,117))* y(k,117) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,118))* y(k,118) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,119))* y(k,119) + prod(k,8) = 0._r8 + loss(k,37) = (rxt(k,478)* y(k,211) + het_rates(k,120))* y(k,120) + prod(k,37) = 0._r8 + loss(k,9) = ( + rxt(k,488) + het_rates(k,121))* y(k,121) + prod(k,9) = 0._r8 + loss(k,190) = (rxt(k,218)* y(k,19) +rxt(k,186)* y(k,59) +rxt(k,382)* y(k,101) & + +rxt(k,150)* y(k,112) +rxt(k,159)* y(k,126) +rxt(k,165)* y(k,133) & + +rxt(k,164)* y(k,134) +rxt(k,397)* y(k,187) + (rxt(k,358) + & + rxt(k,359))* y(k,188) +rxt(k,400)* y(k,189) +rxt(k,405)* y(k,190) & + +rxt(k,283)* y(k,191) +rxt(k,311)* y(k,192) +rxt(k,407)* y(k,193) & + +rxt(k,294)* y(k,194) +rxt(k,261)* y(k,195) +rxt(k,411)* y(k,196) & + + (rxt(k,329) +rxt(k,330))* y(k,197) +rxt(k,298)* y(k,199) & + +rxt(k,163)* y(k,200) +rxt(k,270)* y(k,201) +rxt(k,368)* y(k,202) & + +rxt(k,374)* y(k,203) + (rxt(k,336) +rxt(k,337))* y(k,204) & + +rxt(k,414)* y(k,205) +rxt(k,345)* y(k,206) +rxt(k,417)* y(k,207) & + +rxt(k,348)* y(k,208) +rxt(k,447)* y(k,209) +rxt(k,420)* y(k,212) & + +rxt(k,319)* y(k,213) +rxt(k,323)* y(k,214) +rxt(k,452)* y(k,215) & + +rxt(k,457)* y(k,216) +rxt(k,427)* y(k,217) +rxt(k,393)* y(k,218) & + +rxt(k,433)* y(k,219) +rxt(k,436)* y(k,220) + rxt(k,15) & + + het_rates(k,124))* y(k,124) + prod(k,190) = (rxt(k,16) +.500_r8*rxt(k,489) +2.000_r8*rxt(k,152)*y(k,112) + & + rxt(k,155)*y(k,133) +rxt(k,469)*y(k,149))*y(k,125) + (rxt(k,154) + & + rxt(k,162)*y(k,211))*y(k,112) +2.000_r8*rxt(k,166)*y(k,210)*y(k,113) & + +rxt(k,14)*y(k,114) +rxt(k,17)*y(k,126) + loss(k,185) = (rxt(k,219)* y(k,19) +rxt(k,188)* y(k,59) + (rxt(k,151) + & + rxt(k,152) +rxt(k,153))* y(k,112) +rxt(k,169)* y(k,126) & + + (rxt(k,155) +rxt(k,157))* y(k,133) +rxt(k,156)* y(k,134) & + +rxt(k,422)* y(k,140) +rxt(k,469)* y(k,149) +rxt(k,425)* y(k,187) & + +rxt(k,305)* y(k,194) +rxt(k,412)* y(k,196) +rxt(k,168)* y(k,200) & + +rxt(k,415)* y(k,205) +rxt(k,354)* y(k,206) +rxt(k,418)* y(k,207) & + +rxt(k,170)* y(k,211) + rxt(k,16) + rxt(k,489) + het_rates(k,125)) & + * y(k,125) + prod(k,185) = (2.000_r8*rxt(k,159)*y(k,126) +rxt(k,163)*y(k,200) + & + rxt(k,164)*y(k,134) +rxt(k,165)*y(k,133) +rxt(k,186)*y(k,59) + & + rxt(k,218)*y(k,19) +rxt(k,261)*y(k,195) +rxt(k,270)*y(k,201) + & + rxt(k,283)*y(k,191) +rxt(k,294)*y(k,194) +rxt(k,298)*y(k,199) + & + rxt(k,311)*y(k,192) +rxt(k,319)*y(k,213) +rxt(k,323)*y(k,214) + & + rxt(k,329)*y(k,197) +rxt(k,336)*y(k,204) +rxt(k,345)*y(k,206) + & + rxt(k,348)*y(k,208) +rxt(k,358)*y(k,188) + & + .920_r8*rxt(k,368)*y(k,202) +.920_r8*rxt(k,374)*y(k,203) + & + rxt(k,382)*y(k,101) +rxt(k,393)*y(k,218) +rxt(k,397)*y(k,187) + & + rxt(k,400)*y(k,189) +rxt(k,405)*y(k,190) +rxt(k,407)*y(k,193) + & + rxt(k,411)*y(k,196) +rxt(k,414)*y(k,205) +rxt(k,417)*y(k,207) + & + rxt(k,420)*y(k,212) +rxt(k,427)*y(k,217) +rxt(k,433)*y(k,219) + & + rxt(k,436)*y(k,220) +1.600_r8*rxt(k,447)*y(k,209) + & + .900_r8*rxt(k,452)*y(k,215) +.800_r8*rxt(k,457)*y(k,216))*y(k,124) & + + (rxt(k,18) +rxt(k,158)*y(k,200) +rxt(k,160)*y(k,133) + & + rxt(k,161)*y(k,211) +rxt(k,327)*y(k,16) +rxt(k,335)*y(k,204) + & + rxt(k,346)*y(k,206) +rxt(k,369)*y(k,202) +rxt(k,375)*y(k,203) + & + rxt(k,383)*y(k,101) +rxt(k,394)*y(k,218) + & + 2.000_r8*rxt(k,448)*y(k,209))*y(k,126) + (rxt(k,149)*y(k,90) + & + rxt(k,317)*y(k,127) +rxt(k,356)*y(k,1) +.700_r8*rxt(k,376)*y(k,99) + & + rxt(k,454)*y(k,174))*y(k,211) + (rxt(k,11) +rxt(k,172))*y(k,90) & + + (rxt(k,54) +rxt(k,355))*y(k,109) + (rxt(k,13) +rxt(k,173)) & + *y(k,114) + (.600_r8*rxt(k,60) +rxt(k,306))*y(k,138) +rxt(k,19) & + *y(k,1) +rxt(k,76)*y(k,20) +rxt(k,95)*y(k,60) +rxt(k,9)*y(k,89) & + +rxt(k,45)*y(k,93) +rxt(k,48)*y(k,102) +rxt(k,56)*y(k,116) & + +rxt(k,57)*y(k,127) +rxt(k,58)*y(k,128) +rxt(k,59)*y(k,137) & + +rxt(k,430)*y(k,139) +rxt(k,66)*y(k,174) & + +.500_r8*rxt(k,445)*y(k,209)*y(k,195) + loss(k,179) = (rxt(k,439)* y(k,6) +rxt(k,327)* y(k,16) +rxt(k,307)* y(k,29) & + +rxt(k,255)* y(k,42) +rxt(k,288)* y(k,45) +rxt(k,314)* y(k,49) & + +rxt(k,476)* y(k,67) +rxt(k,378)* y(k,98) +rxt(k,383)* y(k,101) & + +rxt(k,442)* y(k,110) +rxt(k,159)* y(k,124) +rxt(k,169)* y(k,125) & + +rxt(k,160)* y(k,133) +rxt(k,459)* y(k,176) +rxt(k,158)* y(k,200) & + +rxt(k,369)* y(k,202) +rxt(k,375)* y(k,203) +rxt(k,335)* y(k,204) & + +rxt(k,346)* y(k,206) +rxt(k,448)* y(k,209) +rxt(k,161)* y(k,211) & + +rxt(k,394)* y(k,218) + rxt(k,17) + rxt(k,18) + rxt(k,490) & + + het_rates(k,126))* y(k,126) + prod(k,179) = (rxt(k,94) +rxt(k,187)*y(k,56) +rxt(k,189)*y(k,133) + & + rxt(k,190)*y(k,211))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,173)) & + *y(k,114) + (rxt(k,171)*y(k,89) +rxt(k,303)*y(k,138) + & + .500_r8*rxt(k,351)*y(k,109))*y(k,211) + (rxt(k,77) + & + rxt(k,220)*y(k,133))*y(k,20) + (rxt(k,156)*y(k,134) + & + rxt(k,157)*y(k,133))*y(k,125) +rxt(k,234)*y(k,89)*y(k,73) +rxt(k,10) & + *y(k,90) +.400_r8*rxt(k,60)*y(k,138) + loss(k,141) = (rxt(k,317)* y(k,211) + rxt(k,57) + het_rates(k,127))* y(k,127) + prod(k,141) = (.500_r8*rxt(k,377)*y(k,100) +rxt(k,384)*y(k,102) + & + rxt(k,388)*y(k,115) +rxt(k,389)*y(k,116))*y(k,211) & + +rxt(k,307)*y(k,126)*y(k,29) + loss(k,87) = (rxt(k,449)* y(k,211) + rxt(k,58) + rxt(k,491) & + + het_rates(k,128))* y(k,128) + prod(k,87) =rxt(k,446)*y(k,209)*y(k,200) + loss(k,10) = ( + het_rates(k,129))* y(k,129) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,130))* y(k,130) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,131))* y(k,131) + prod(k,12) = 0._r8 + loss(k,13) = ( + het_rates(k,132))* y(k,132) + prod(k,13) = 0._r8 + loss(k,188) = (rxt(k,221)* y(k,19) +rxt(k,220)* y(k,20) +rxt(k,256)* y(k,42) & + +rxt(k,191)* y(k,59) +rxt(k,189)* y(k,60) +rxt(k,132)* y(k,77) & + +rxt(k,133)* y(k,79) +rxt(k,223)* y(k,81) +rxt(k,194)* y(k,85) & + +rxt(k,225)* y(k,91) +rxt(k,197)* y(k,92) +rxt(k,165)* y(k,124) & + + (rxt(k,155) +rxt(k,157))* y(k,125) +rxt(k,160)* y(k,126) & + + 2._r8*rxt(k,130)* y(k,133) +rxt(k,129)* y(k,134) +rxt(k,462) & + * y(k,136) +rxt(k,138)* y(k,200) +rxt(k,144)* y(k,211) + rxt(k,131) & + + het_rates(k,133))* y(k,133) + prod(k,188) = (rxt(k,154) +rxt(k,150)*y(k,124) +rxt(k,151)*y(k,125))*y(k,112) & + + (rxt(k,111) +rxt(k,470))*y(k,149) + (rxt(k,126) +rxt(k,127)) & + *y(k,210) +rxt(k,75)*y(k,19) +rxt(k,93)*y(k,59) +rxt(k,136)*y(k,200) & + *y(k,76) +rxt(k,14)*y(k,114) +rxt(k,15)*y(k,124) +rxt(k,16)*y(k,125) & + +rxt(k,18)*y(k,126) +rxt(k,8)*y(k,134) +rxt(k,107)*y(k,135) & + +rxt(k,464)*y(k,147) +rxt(k,112)*y(k,150) +rxt(k,113)*y(k,151) & + +rxt(k,146)*y(k,211)*y(k,211) +rxt(k,3)*y(k,221) + loss(k,186) = (rxt(k,440)* y(k,6) +rxt(k,212)* y(k,17) +rxt(k,279)* y(k,25) & + +rxt(k,308)* y(k,29) +rxt(k,180)* y(k,56) +rxt(k,140)* y(k,76) & + +rxt(k,385)* y(k,98) +rxt(k,338)* y(k,105) +rxt(k,443)* y(k,110) & + +rxt(k,352)* y(k,111) +rxt(k,164)* y(k,124) +rxt(k,156)* y(k,125) & + +rxt(k,129)* y(k,133) +rxt(k,423)* y(k,140) +rxt(k,465)* y(k,147) & + +rxt(k,471)* y(k,149) +rxt(k,139)* y(k,200) +rxt(k,128)* y(k,210) & + +rxt(k,145)* y(k,211) + rxt(k,7) + rxt(k,8) + het_rates(k,134)) & + * y(k,134) + prod(k,186) = (.150_r8*rxt(k,293)*y(k,194) +.150_r8*rxt(k,343)*y(k,206)) & + *y(k,200) +rxt(k,131)*y(k,133) + loss(k,76) = (rxt(k,472)* y(k,149) + rxt(k,107) + het_rates(k,135))* y(k,135) + prod(k,76) = (rxt(k,184)*y(k,59) +rxt(k,214)*y(k,19))*y(k,59) + loss(k,80) = (rxt(k,462)* y(k,133) +rxt(k,463)* y(k,211) + rxt(k,110) & + + het_rates(k,136))* y(k,136) + prod(k,80) = 0._r8 + loss(k,59) = ( + rxt(k,59) + rxt(k,492) + het_rates(k,137))* y(k,137) + prod(k,59) =rxt(k,331)*y(k,211)*y(k,93) +.100_r8*rxt(k,452)*y(k,215)*y(k,124) + loss(k,97) = (rxt(k,303)* y(k,211) + rxt(k,60) + rxt(k,306) & + + het_rates(k,138))* y(k,138) + prod(k,97) =rxt(k,305)*y(k,194)*y(k,125) + loss(k,44) = ( + rxt(k,430) + het_rates(k,139))* y(k,139) + prod(k,44) =rxt(k,425)*y(k,187)*y(k,125) + loss(k,98) = (rxt(k,422)* y(k,125) +rxt(k,423)* y(k,134) + het_rates(k,140)) & + * y(k,140) + prod(k,98) = (.070_r8*rxt(k,409)*y(k,66) +.060_r8*rxt(k,421)*y(k,141) + & + .070_r8*rxt(k,437)*y(k,183))*y(k,211) +rxt(k,31)*y(k,32) & + +rxt(k,407)*y(k,193)*y(k,124) + loss(k,48) = (rxt(k,421)* y(k,211) + het_rates(k,141))* y(k,141) + prod(k,48) =.530_r8*rxt(k,398)*y(k,211)*y(k,7) + loss(k,77) = (rxt(k,424)* y(k,211) + rxt(k,61) + het_rates(k,142))* y(k,142) + prod(k,77) =rxt(k,419)*y(k,212)*y(k,200) + loss(k,14) = ( + het_rates(k,143))* y(k,143) + prod(k,14) = 0._r8 + loss(k,15) = ( + het_rates(k,144))* y(k,144) + prod(k,15) = 0._r8 + loss(k,109) = (rxt(k,320)* y(k,211) + rxt(k,62) + het_rates(k,145))* y(k,145) + prod(k,109) =rxt(k,318)*y(k,213)*y(k,200) + loss(k,88) = (rxt(k,324)* y(k,211) + rxt(k,63) + het_rates(k,146))* y(k,146) + prod(k,88) =.850_r8*rxt(k,322)*y(k,214)*y(k,200) + loss(k,103) = (rxt(k,465)* y(k,134) +rxt(k,468)* y(k,211) + rxt(k,464) & + + het_rates(k,147))* y(k,147) + prod(k,103) =rxt(k,110)*y(k,136) +rxt(k,111)*y(k,149) + loss(k,167) = (rxt(k,466)* y(k,19) +rxt(k,467)* y(k,59) +rxt(k,469)* y(k,125) & + +rxt(k,471)* y(k,134) +rxt(k,472)* y(k,135) +rxt(k,473)* y(k,211) & + + rxt(k,111) + rxt(k,470) + het_rates(k,149))* y(k,149) + prod(k,167) = (rxt(k,464) +rxt(k,465)*y(k,134) +rxt(k,468)*y(k,211))*y(k,147) & + +rxt(k,462)*y(k,136)*y(k,133) +rxt(k,112)*y(k,150) + loss(k,140) = (rxt(k,474)* y(k,211) + rxt(k,112) + het_rates(k,150)) & + * y(k,150) + prod(k,140) = (rxt(k,470) +rxt(k,466)*y(k,19) +rxt(k,467)*y(k,59) + & + rxt(k,469)*y(k,125) +rxt(k,471)*y(k,134) +rxt(k,472)*y(k,135) + & + rxt(k,473)*y(k,211))*y(k,149) + (rxt(k,476)*y(k,126) + & + rxt(k,477)*y(k,211) +.500_r8*rxt(k,479)*y(k,211))*y(k,67) & + +rxt(k,463)*y(k,211)*y(k,136) +rxt(k,113)*y(k,151) + loss(k,63) = (rxt(k,475)* y(k,221) + rxt(k,113) + het_rates(k,151))* y(k,151) + prod(k,63) =rxt(k,109)*y(k,80) +rxt(k,474)*y(k,211)*y(k,150) + loss(k,16) = ( + het_rates(k,152))* y(k,152) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,153))* y(k,153) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,154))* y(k,154) + prod(k,18) = 0._r8 + loss(k,19) = ( + rxt(k,114) + het_rates(k,155))* y(k,155) + prod(k,19) = 0._r8 + loss(k,20) = ( + rxt(k,115) + het_rates(k,156))* y(k,156) + prod(k,20) = 0._r8 + loss(k,21) = ( + rxt(k,116) + het_rates(k,157))* y(k,157) + prod(k,21) = 0._r8 + loss(k,22) = ( + rxt(k,117) + het_rates(k,158))* y(k,158) + prod(k,22) = 0._r8 + loss(k,23) = ( + rxt(k,118) + het_rates(k,159))* y(k,159) + prod(k,23) = 0._r8 + loss(k,24) = ( + rxt(k,119) + het_rates(k,160))* y(k,160) + prod(k,24) = 0._r8 + loss(k,25) = ( + rxt(k,120) + het_rates(k,161))* y(k,161) + prod(k,25) = 0._r8 + loss(k,26) = ( + rxt(k,121) + het_rates(k,162))* y(k,162) + prod(k,26) = 0._r8 + loss(k,27) = ( + rxt(k,122) + het_rates(k,163))* y(k,163) + prod(k,27) = 0._r8 + loss(k,28) = ( + rxt(k,123) + het_rates(k,164))* y(k,164) + prod(k,28) = 0._r8 + loss(k,29) = ( + het_rates(k,165))* y(k,165) + prod(k,29) = (.2202005_r8*rxt(k,496)*y(k,6) +.0023005_r8*rxt(k,497)*y(k,7) + & + .0031005_r8*rxt(k,500)*y(k,98) +.2381005_r8*rxt(k,501)*y(k,104) + & + .0508005_r8*rxt(k,504)*y(k,110) +.5931005_r8*rxt(k,505)*y(k,171) + & + .1364005_r8*rxt(k,506)*y(k,179) +.1677005_r8*rxt(k,507)*y(k,181)) & + *y(k,211) + (.2202005_r8*rxt(k,495)*y(k,6) + & + .0508005_r8*rxt(k,503)*y(k,110))*y(k,134) +rxt(k,480)*y(k,75) + loss(k,30) = ( + het_rates(k,166))* y(k,166) + prod(k,30) = (.2067005_r8*rxt(k,496)*y(k,6) +.0008005_r8*rxt(k,497)*y(k,7) + & + .0035005_r8*rxt(k,500)*y(k,98) +.1308005_r8*rxt(k,501)*y(k,104) + & + .1149005_r8*rxt(k,504)*y(k,110) +.1534005_r8*rxt(k,505)*y(k,171) + & + .0101005_r8*rxt(k,506)*y(k,179) +.0174005_r8*rxt(k,507)*y(k,181)) & + *y(k,211) + (.2067005_r8*rxt(k,495)*y(k,6) + & + .1149005_r8*rxt(k,503)*y(k,110))*y(k,134) + loss(k,31) = ( + het_rates(k,167))* y(k,167) + prod(k,31) = (.0653005_r8*rxt(k,496)*y(k,6) +.0843005_r8*rxt(k,497)*y(k,7) + & + .0003005_r8*rxt(k,500)*y(k,98) +.0348005_r8*rxt(k,501)*y(k,104) + & + .0348005_r8*rxt(k,504)*y(k,110) +.0459005_r8*rxt(k,505)*y(k,171) + & + .0763005_r8*rxt(k,506)*y(k,179) +.086_r8*rxt(k,507)*y(k,181)) & + *y(k,211) + (.0653005_r8*rxt(k,495)*y(k,6) + & + .0348005_r8*rxt(k,503)*y(k,110))*y(k,134) + loss(k,32) = ( + het_rates(k,168))* y(k,168) + prod(k,32) = (.1284005_r8*rxt(k,496)*y(k,6) +.0443005_r8*rxt(k,497)*y(k,7) + & + .0271005_r8*rxt(k,500)*y(k,98) +.0076005_r8*rxt(k,501)*y(k,104) + & + .0554005_r8*rxt(k,504)*y(k,110) +.0085005_r8*rxt(k,505)*y(k,171) + & + .2157005_r8*rxt(k,506)*y(k,179) +.0512005_r8*rxt(k,507)*y(k,181)) & + *y(k,211) + (.1749305_r8*rxt(k,494)*y(k,6) + & + .0590245_r8*rxt(k,498)*y(k,98) +.1749305_r8*rxt(k,502)*y(k,110)) & + *y(k,126) + (.1284005_r8*rxt(k,495)*y(k,6) + & + .0033005_r8*rxt(k,499)*y(k,98) +.0554005_r8*rxt(k,503)*y(k,110)) & + *y(k,134) + loss(k,33) = ( + het_rates(k,169))* y(k,169) + prod(k,33) = (.114_r8*rxt(k,496)*y(k,6) +.1621005_r8*rxt(k,497)*y(k,7) + & + .0474005_r8*rxt(k,500)*y(k,98) +.0113005_r8*rxt(k,501)*y(k,104) + & + .1278005_r8*rxt(k,504)*y(k,110) +.0128005_r8*rxt(k,505)*y(k,171) + & + .0232005_r8*rxt(k,506)*y(k,179) +.1598005_r8*rxt(k,507)*y(k,181)) & + *y(k,211) + (.5901905_r8*rxt(k,494)*y(k,6) + & + .0250245_r8*rxt(k,498)*y(k,98) +.5901905_r8*rxt(k,502)*y(k,110)) & + *y(k,126) + (.114_r8*rxt(k,495)*y(k,6) + & + .1278005_r8*rxt(k,503)*y(k,110))*y(k,134) + loss(k,35) = (rxt(k,505)* y(k,211) + het_rates(k,171))* y(k,171) + prod(k,35) = 0._r8 + loss(k,53) = ( + rxt(k,64) + het_rates(k,172))* y(k,172) + prod(k,53) = (.100_r8*rxt(k,429)*y(k,179) +.230_r8*rxt(k,431)*y(k,181)) & + *y(k,211) + loss(k,115) = (rxt(k,453)* y(k,211) + rxt(k,65) + het_rates(k,173))* y(k,173) + prod(k,115) =rxt(k,451)*y(k,215)*y(k,200) + loss(k,118) = (rxt(k,454)* y(k,211) + rxt(k,66) + rxt(k,493) & + + het_rates(k,174))* y(k,174) + prod(k,118) = (.200_r8*rxt(k,447)*y(k,209) +.200_r8*rxt(k,457)*y(k,216)) & + *y(k,124) +.500_r8*rxt(k,445)*y(k,209)*y(k,195) + loss(k,99) = (rxt(k,458)* y(k,211) + rxt(k,67) + het_rates(k,175))* y(k,175) + prod(k,99) =rxt(k,456)*y(k,216)*y(k,200) + loss(k,150) = (rxt(k,459)* y(k,126) +rxt(k,460)* y(k,211) + rxt(k,68) & + + het_rates(k,176))* y(k,176) + prod(k,150) = (.500_r8*rxt(k,445)*y(k,195) +.800_r8*rxt(k,447)*y(k,124) + & + rxt(k,448)*y(k,126))*y(k,209) + (.330_r8*rxt(k,440)*y(k,6) + & + .330_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,66) + & + rxt(k,454)*y(k,211))*y(k,174) + (rxt(k,455)*y(k,195) + & + .800_r8*rxt(k,457)*y(k,124))*y(k,216) +rxt(k,58)*y(k,128) +rxt(k,67) & + *y(k,175) + loss(k,153) = (rxt(k,461)* y(k,211) + rxt(k,69) + het_rates(k,177))* y(k,177) + prod(k,153) = (.300_r8*rxt(k,440)*y(k,6) +.300_r8*rxt(k,443)*y(k,110)) & + *y(k,134) + (rxt(k,450)*y(k,195) +.900_r8*rxt(k,452)*y(k,124)) & + *y(k,215) +rxt(k,65)*y(k,173) +rxt(k,68)*y(k,176) + loss(k,116) = (rxt(k,428)* y(k,211) + rxt(k,70) + het_rates(k,178))* y(k,178) + prod(k,116) =rxt(k,426)*y(k,217)*y(k,200) + loss(k,51) = (rxt(k,429)* y(k,211) + het_rates(k,179))* y(k,179) + prod(k,51) = 0._r8 + loss(k,54) = (rxt(k,395)* y(k,211) + rxt(k,71) + het_rates(k,180))* y(k,180) + prod(k,54) =rxt(k,392)*y(k,218)*y(k,200) + loss(k,55) = (rxt(k,431)* y(k,211) + het_rates(k,181))* y(k,181) + prod(k,55) = 0._r8 + loss(k,124) = (rxt(k,434)* y(k,211) + rxt(k,72) + het_rates(k,182))* y(k,182) + prod(k,124) =rxt(k,432)*y(k,219)*y(k,200) + loss(k,56) = (rxt(k,437)* y(k,211) + het_rates(k,183))* y(k,183) + prod(k,56) =.150_r8*rxt(k,431)*y(k,211)*y(k,181) + loss(k,92) = (rxt(k,438)* y(k,211) + rxt(k,73) + het_rates(k,184))* y(k,184) + prod(k,92) =rxt(k,435)*y(k,220)*y(k,200) + loss(k,105) = (rxt(k,397)* y(k,124) +rxt(k,425)* y(k,125) +rxt(k,396) & + * y(k,200) + het_rates(k,187))* y(k,187) + prod(k,105) =rxt(k,402)*y(k,211)*y(k,22) +rxt(k,430)*y(k,139) + loss(k,146) = ((rxt(k,358) +rxt(k,359))* y(k,124) +rxt(k,357)* y(k,200) & + + het_rates(k,188))* y(k,188) + prod(k,146) = (rxt(k,360)*y(k,2) +rxt(k,361)*y(k,15))*y(k,211) + loss(k,100) = (rxt(k,400)* y(k,124) +rxt(k,399)* y(k,200) + het_rates(k,189)) & + * y(k,189) + prod(k,100) = (.350_r8*rxt(k,398)*y(k,7) +rxt(k,401)*y(k,8))*y(k,211) + loss(k,93) = (rxt(k,405)* y(k,124) +rxt(k,403)* y(k,200) + het_rates(k,190)) & + * y(k,190) + prod(k,93) = (rxt(k,404)*y(k,23) +.070_r8*rxt(k,429)*y(k,179) + & + .060_r8*rxt(k,431)*y(k,181))*y(k,211) + loss(k,137) = (rxt(k,283)* y(k,124) + 2._r8*rxt(k,280)* y(k,191) +rxt(k,281) & + * y(k,195) +rxt(k,282)* y(k,200) + het_rates(k,191))* y(k,191) + prod(k,137) = (rxt(k,286)*y(k,56) +rxt(k,287)*y(k,211))*y(k,28) & + +.500_r8*rxt(k,285)*y(k,211)*y(k,27) +rxt(k,52)*y(k,107) + loss(k,135) = (rxt(k,311)* y(k,124) +rxt(k,309)* y(k,195) +rxt(k,310) & + * y(k,200) + het_rates(k,192))* y(k,192) + prod(k,135) = (rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31))*y(k,211) + loss(k,119) = (rxt(k,407)* y(k,124) +rxt(k,406)* y(k,200) + het_rates(k,193)) & + * y(k,193) + prod(k,119) = (.400_r8*rxt(k,396)*y(k,200) +rxt(k,397)*y(k,124))*y(k,187) & + +rxt(k,408)*y(k,211)*y(k,32) +rxt(k,423)*y(k,140)*y(k,134) + loss(k,173) = (rxt(k,379)* y(k,101) +rxt(k,294)* y(k,124) +rxt(k,305) & + * y(k,125) + 2._r8*rxt(k,291)* y(k,194) +rxt(k,292)* y(k,195) & + +rxt(k,293)* y(k,200) +rxt(k,365)* y(k,202) +rxt(k,370)* y(k,203) & + +rxt(k,332)* y(k,204) +rxt(k,390)* y(k,218) + het_rates(k,194)) & + * y(k,194) + prod(k,173) = (.100_r8*rxt(k,338)*y(k,105) +.280_r8*rxt(k,352)*y(k,111) + & + .080_r8*rxt(k,385)*y(k,98) +.060_r8*rxt(k,440)*y(k,6) + & + .060_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,342)*y(k,195) + & + .450_r8*rxt(k,343)*y(k,200) +2.000_r8*rxt(k,344)*y(k,206) + & + rxt(k,345)*y(k,124) +rxt(k,346)*y(k,126))*y(k,206) & + + (.530_r8*rxt(k,332)*y(k,194) +.260_r8*rxt(k,333)*y(k,195) + & + .530_r8*rxt(k,335)*y(k,126) +.530_r8*rxt(k,336)*y(k,124))*y(k,204) & + + (rxt(k,289)*y(k,45) +.500_r8*rxt(k,296)*y(k,51) + & + rxt(k,315)*y(k,49) +.650_r8*rxt(k,461)*y(k,177))*y(k,211) & + + (.300_r8*rxt(k,321)*y(k,195) +.150_r8*rxt(k,322)*y(k,200) + & + rxt(k,323)*y(k,124))*y(k,214) + (rxt(k,36) +rxt(k,314)*y(k,126)) & + *y(k,49) + (.600_r8*rxt(k,60) +rxt(k,306))*y(k,138) & + + (.200_r8*rxt(k,347)*y(k,200) +rxt(k,348)*y(k,124))*y(k,208) & + +.130_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +rxt(k,288)*y(k,126) & + *y(k,45) +rxt(k,35)*y(k,48) +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47) & + *y(k,95) +1.340_r8*rxt(k,50)*y(k,105) +rxt(k,52)*y(k,107) +rxt(k,53) & + *y(k,108) +.300_r8*rxt(k,55)*y(k,111) +rxt(k,57)*y(k,127) +rxt(k,63) & + *y(k,146) +.500_r8*rxt(k,64)*y(k,172) +.650_r8*rxt(k,69)*y(k,177) + loss(k,182) = (rxt(k,181)* y(k,59) +rxt(k,380)* y(k,101) +rxt(k,261) & + * y(k,124) +rxt(k,281)* y(k,191) +rxt(k,309)* y(k,192) +rxt(k,292) & + * y(k,194) + 2._r8*(rxt(k,258) +rxt(k,259))* y(k,195) +rxt(k,260) & + * y(k,200) +rxt(k,366)* y(k,202) +rxt(k,371)* y(k,203) +rxt(k,333) & + * y(k,204) +rxt(k,342)* y(k,206) +rxt(k,445)* y(k,209) +rxt(k,321) & + * y(k,214) +rxt(k,450)* y(k,215) +rxt(k,455)* y(k,216) +rxt(k,391) & + * y(k,218) + het_rates(k,195))* y(k,195) + prod(k,182) = (2.000_r8*rxt(k,291)*y(k,194) +.900_r8*rxt(k,292)*y(k,195) + & + .450_r8*rxt(k,293)*y(k,200) +rxt(k,294)*y(k,124) + & + rxt(k,332)*y(k,204) +rxt(k,341)*y(k,206) +rxt(k,365)*y(k,202) + & + rxt(k,370)*y(k,203) +rxt(k,379)*y(k,101) +rxt(k,390)*y(k,218)) & + *y(k,194) + (rxt(k,175)*y(k,56) +rxt(k,231)*y(k,73) + & + rxt(k,264)*y(k,211) +rxt(k,271)*y(k,210))*y(k,54) & + + (.830_r8*rxt(k,411)*y(k,196) +.170_r8*rxt(k,417)*y(k,207)) & + *y(k,124) + (.280_r8*rxt(k,308)*y(k,29) +.050_r8*rxt(k,385)*y(k,98)) & + *y(k,134) + (.330_r8*rxt(k,410)*y(k,196) + & + .070_r8*rxt(k,416)*y(k,207))*y(k,200) + (.700_r8*rxt(k,263)*y(k,53) + & + rxt(k,295)*y(k,50))*y(k,211) +rxt(k,34)*y(k,45) +rxt(k,35)*y(k,48) & + +rxt(k,37)*y(k,51) +.300_r8*rxt(k,55)*y(k,111) +.400_r8*rxt(k,60) & + *y(k,138) + loss(k,129) = (rxt(k,411)* y(k,124) +rxt(k,412)* y(k,125) +rxt(k,410) & + * y(k,200) + het_rates(k,196))* y(k,196) + prod(k,129) =.600_r8*rxt(k,25)*y(k,12) + loss(k,112) = ((rxt(k,329) +rxt(k,330))* y(k,124) + het_rates(k,197)) & + * y(k,197) + prod(k,112) =rxt(k,328)*y(k,211)*y(k,16) + loss(k,66) = ( + rxt(k,299) + rxt(k,300) + het_rates(k,198))* y(k,198) + prod(k,66) =rxt(k,42)*y(k,72) +.750_r8*rxt(k,298)*y(k,199)*y(k,124) + loss(k,125) = (rxt(k,298)* y(k,124) +rxt(k,297)* y(k,200) + het_rates(k,199)) & + * y(k,199) + prod(k,125) =rxt(k,304)*y(k,211)*y(k,25) + loss(k,178) = (rxt(k,211)* y(k,17) +rxt(k,217)* y(k,19) +rxt(k,254)* y(k,42) & + + (rxt(k,178) +rxt(k,179))* y(k,56) +rxt(k,185)* y(k,59) & + + (rxt(k,134) +rxt(k,135) +rxt(k,136))* y(k,76) +rxt(k,381) & + * y(k,101) +rxt(k,163)* y(k,124) +rxt(k,168)* y(k,125) +rxt(k,158) & + * y(k,126) +rxt(k,138)* y(k,133) +rxt(k,139)* y(k,134) +rxt(k,396) & + * y(k,187) +rxt(k,357)* y(k,188) +rxt(k,399)* y(k,189) +rxt(k,403) & + * y(k,190) +rxt(k,282)* y(k,191) +rxt(k,310)* y(k,192) +rxt(k,406) & + * y(k,193) +rxt(k,293)* y(k,194) +rxt(k,260)* y(k,195) +rxt(k,410) & + * y(k,196) +rxt(k,297)* y(k,199) + 2._r8*rxt(k,148)* y(k,200) & + +rxt(k,268)* y(k,201) +rxt(k,367)* y(k,202) +rxt(k,372)* y(k,203) & + +rxt(k,334)* y(k,204) +rxt(k,413)* y(k,205) +rxt(k,343)* y(k,206) & + +rxt(k,416)* y(k,207) +rxt(k,347)* y(k,208) +rxt(k,446)* y(k,209) & + +rxt(k,143)* y(k,211) +rxt(k,419)* y(k,212) +rxt(k,318)* y(k,213) & + +rxt(k,322)* y(k,214) +rxt(k,451)* y(k,215) +rxt(k,456)* y(k,216) & + +rxt(k,426)* y(k,217) +rxt(k,392)* y(k,218) +rxt(k,432)* y(k,219) & + +rxt(k,435)* y(k,220) + rxt(k,481) + het_rates(k,200))* y(k,200) + prod(k,178) = (rxt(k,240)*y(k,43) +rxt(k,243)*y(k,46) +rxt(k,142)*y(k,79) + & + rxt(k,145)*y(k,134) +rxt(k,161)*y(k,126) +rxt(k,192)*y(k,59) + & + rxt(k,222)*y(k,19) +rxt(k,262)*y(k,52) +rxt(k,265)*y(k,62) + & + rxt(k,266)*y(k,86) +rxt(k,267)*y(k,87) +.350_r8*rxt(k,277)*y(k,24) + & + rxt(k,284)*y(k,26) +rxt(k,290)*y(k,47) +rxt(k,301)*y(k,74) + & + rxt(k,302)*y(k,75) +rxt(k,316)*y(k,95) +rxt(k,331)*y(k,93) + & + .200_r8*rxt(k,340)*y(k,106) +.500_r8*rxt(k,351)*y(k,109) + & + .300_r8*rxt(k,376)*y(k,99) +rxt(k,377)*y(k,100) + & + rxt(k,384)*y(k,102) +rxt(k,388)*y(k,115) +rxt(k,389)*y(k,116) + & + .650_r8*rxt(k,398)*y(k,7) +.730_r8*rxt(k,409)*y(k,66) + & + .800_r8*rxt(k,421)*y(k,141) +.280_r8*rxt(k,429)*y(k,179) + & + .380_r8*rxt(k,431)*y(k,181) +.630_r8*rxt(k,437)*y(k,183) + & + .200_r8*rxt(k,461)*y(k,177) +rxt(k,474)*y(k,150) + & + .500_r8*rxt(k,479)*y(k,67))*y(k,211) + (rxt(k,261)*y(k,195) + & + rxt(k,270)*y(k,201) +rxt(k,283)*y(k,191) + & + .250_r8*rxt(k,298)*y(k,199) +rxt(k,311)*y(k,192) + & + rxt(k,319)*y(k,213) +rxt(k,329)*y(k,197) + & + .470_r8*rxt(k,336)*y(k,204) +rxt(k,358)*y(k,188) + & + .920_r8*rxt(k,368)*y(k,202) +.920_r8*rxt(k,374)*y(k,203) + & + rxt(k,382)*y(k,101) +rxt(k,393)*y(k,218) +rxt(k,400)*y(k,189) + & + rxt(k,405)*y(k,190) +.170_r8*rxt(k,411)*y(k,196) + & + .400_r8*rxt(k,414)*y(k,205) +.830_r8*rxt(k,417)*y(k,207) + & + rxt(k,420)*y(k,212) +rxt(k,427)*y(k,217) +rxt(k,433)*y(k,219) + & + rxt(k,436)*y(k,220) +.900_r8*rxt(k,452)*y(k,215) + & + .800_r8*rxt(k,457)*y(k,216))*y(k,124) + (rxt(k,181)*y(k,59) + & + 2.000_r8*rxt(k,258)*y(k,195) +rxt(k,281)*y(k,191) + & + .900_r8*rxt(k,292)*y(k,194) +rxt(k,309)*y(k,192) + & + .300_r8*rxt(k,321)*y(k,214) +.730_r8*rxt(k,333)*y(k,204) + & + rxt(k,342)*y(k,206) +rxt(k,366)*y(k,202) +rxt(k,371)*y(k,203) + & + 1.200_r8*rxt(k,380)*y(k,101) +.800_r8*rxt(k,391)*y(k,218) + & + .500_r8*rxt(k,445)*y(k,209) +rxt(k,450)*y(k,215) + & + rxt(k,455)*y(k,216))*y(k,195) + (.130_r8*rxt(k,279)*y(k,25) + & + .280_r8*rxt(k,308)*y(k,29) +.140_r8*rxt(k,338)*y(k,105) + & + .280_r8*rxt(k,352)*y(k,111) +.370_r8*rxt(k,385)*y(k,98) + & + .570_r8*rxt(k,440)*y(k,6) +.570_r8*rxt(k,443)*y(k,110))*y(k,134) & + + (rxt(k,255)*y(k,42) +.470_r8*rxt(k,335)*y(k,204) + & + rxt(k,369)*y(k,202) +rxt(k,375)*y(k,203) +rxt(k,383)*y(k,101) + & + rxt(k,394)*y(k,218))*y(k,126) + (.470_r8*rxt(k,332)*y(k,204) + & + rxt(k,365)*y(k,202) +rxt(k,370)*y(k,203) +rxt(k,379)*y(k,101) + & + rxt(k,390)*y(k,218))*y(k,194) + (rxt(k,239)*y(k,43) + & + rxt(k,242)*y(k,46) +rxt(k,174)*y(k,42) +rxt(k,177)*y(k,79))*y(k,56) & + + (.070_r8*rxt(k,410)*y(k,196) +.160_r8*rxt(k,413)*y(k,205) + & + .330_r8*rxt(k,416)*y(k,207))*y(k,200) + (rxt(k,210)*y(k,17) + & + rxt(k,256)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,172))*y(k,90) & + + (1.340_r8*rxt(k,50) +.660_r8*rxt(k,51))*y(k,105) + (rxt(k,299) + & + rxt(k,300))*y(k,198) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & + +rxt(k,21)*y(k,8) +1.500_r8*rxt(k,22)*y(k,9) +.560_r8*rxt(k,23) & + *y(k,10) +rxt(k,24)*y(k,11) +.600_r8*rxt(k,25)*y(k,12) & + +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27)*y(k,14) +rxt(k,28)*y(k,23) & + +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,34)*y(k,45) +rxt(k,36) & + *y(k,49) +rxt(k,272)*y(k,210)*y(k,54) +2.000_r8*rxt(k,43)*y(k,74) & + +2.000_r8*rxt(k,44)*y(k,75) +rxt(k,137)*y(k,76) +rxt(k,133)*y(k,133) & + *y(k,79) +.670_r8*rxt(k,45)*y(k,93) +rxt(k,46)*y(k,94) +rxt(k,47) & + *y(k,95) +rxt(k,48)*y(k,102) +rxt(k,49)*y(k,103) +rxt(k,56)*y(k,116) & + +rxt(k,61)*y(k,142) +rxt(k,62)*y(k,145) +rxt(k,64)*y(k,172) & + +rxt(k,65)*y(k,173) +rxt(k,66)*y(k,174) +rxt(k,67)*y(k,175) & + +rxt(k,68)*y(k,176) +1.200_r8*rxt(k,69)*y(k,177) +rxt(k,70)*y(k,178) & + +rxt(k,72)*y(k,182) +rxt(k,73)*y(k,184) & + +1.200_r8*rxt(k,280)*y(k,191)*y(k,191) +rxt(k,269)*y(k,201) & + +rxt(k,373)*y(k,203) + loss(k,94) = (rxt(k,270)* y(k,124) +rxt(k,268)* y(k,200) + rxt(k,269) & + + het_rates(k,201))* y(k,201) + prod(k,94) =rxt(k,254)*y(k,200)*y(k,42) + loss(k,168) = (rxt(k,368)* y(k,124) +rxt(k,369)* y(k,126) +rxt(k,365) & + * y(k,194) +rxt(k,366)* y(k,195) +rxt(k,367)* y(k,200) & + + het_rates(k,202))* y(k,202) + prod(k,168) =.600_r8*rxt(k,386)*y(k,211)*y(k,98) + loss(k,171) = (rxt(k,374)* y(k,124) +rxt(k,375)* y(k,126) +rxt(k,370) & + * y(k,194) +rxt(k,371)* y(k,195) +rxt(k,372)* y(k,200) + rxt(k,373) & + + het_rates(k,203))* y(k,203) + prod(k,171) =.400_r8*rxt(k,386)*y(k,211)*y(k,98) + loss(k,170) = ((rxt(k,336) +rxt(k,337))* y(k,124) +rxt(k,335)* y(k,126) & + +rxt(k,332)* y(k,194) +rxt(k,333)* y(k,195) +rxt(k,334)* y(k,200) & + + het_rates(k,204))* y(k,204) + prod(k,170) = (.500_r8*rxt(k,339)*y(k,105) +.200_r8*rxt(k,340)*y(k,106) + & + rxt(k,353)*y(k,111))*y(k,211) + loss(k,126) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,125) +rxt(k,413) & + * y(k,200) + het_rates(k,205))* y(k,205) + prod(k,126) =.600_r8*rxt(k,24)*y(k,11) + loss(k,172) = (rxt(k,345)* y(k,124) +rxt(k,354)* y(k,125) +rxt(k,346) & + * y(k,126) +rxt(k,341)* y(k,194) +rxt(k,342)* y(k,195) +rxt(k,343) & + * y(k,200) + 2._r8*rxt(k,344)* y(k,206) + het_rates(k,206))* y(k,206) + prod(k,172) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,339)*y(k,211))*y(k,105) & + + (rxt(k,54) +rxt(k,355))*y(k,109) +.500_r8*rxt(k,340)*y(k,211) & + *y(k,106) + loss(k,143) = (rxt(k,417)* y(k,124) +rxt(k,418)* y(k,125) +rxt(k,416) & + * y(k,200) + het_rates(k,207))* y(k,207) + prod(k,143) =.600_r8*rxt(k,26)*y(k,13) + loss(k,122) = (rxt(k,348)* y(k,124) +rxt(k,347)* y(k,200) + het_rates(k,208)) & + * y(k,208) + prod(k,122) = (rxt(k,349)*y(k,107) +rxt(k,350)*y(k,108))*y(k,211) + loss(k,159) = (rxt(k,447)* y(k,124) +rxt(k,448)* y(k,126) +rxt(k,445) & + * y(k,195) +rxt(k,446)* y(k,200) + het_rates(k,209))* y(k,209) + prod(k,159) = (rxt(k,439)*y(k,6) +rxt(k,442)*y(k,110) + & + .500_r8*rxt(k,459)*y(k,176))*y(k,126) +rxt(k,449)*y(k,211)*y(k,128) + loss(k,180) = (rxt(k,199)* y(k,33) +rxt(k,200)* y(k,34) +rxt(k,226)* y(k,35) & + +rxt(k,201)* y(k,36) +rxt(k,202)* y(k,37) +rxt(k,203)* y(k,38) & + +rxt(k,204)* y(k,39) +rxt(k,205)* y(k,40) +rxt(k,249)* y(k,41) & + +rxt(k,250)* y(k,43) + (rxt(k,271) +rxt(k,272) +rxt(k,273))* y(k,54) & + +rxt(k,227)* y(k,55) +rxt(k,235)* y(k,64) +rxt(k,236)* y(k,65) & + +rxt(k,124)* y(k,77) +rxt(k,228)* y(k,78) + (rxt(k,229) +rxt(k,230)) & + * y(k,81) +rxt(k,251)* y(k,82) +rxt(k,252)* y(k,83) +rxt(k,253) & + * y(k,84) + (rxt(k,206) +rxt(k,207))* y(k,85) +rxt(k,274)* y(k,86) & + + (rxt(k,166) +rxt(k,167))* y(k,113) +rxt(k,128)* y(k,134) & + +rxt(k,125)* y(k,221) + rxt(k,126) + rxt(k,127) + het_rates(k,210)) & + * y(k,210) + prod(k,180) =rxt(k,7)*y(k,134) +rxt(k,1)*y(k,221) + loss(k,181) = (rxt(k,356)* y(k,1) +rxt(k,360)* y(k,2) +rxt(k,441)* y(k,6) & + +rxt(k,398)* y(k,7) +rxt(k,401)* y(k,8) +rxt(k,361)* y(k,15) & + +rxt(k,328)* y(k,16) +rxt(k,222)* y(k,19) +rxt(k,402)* y(k,22) & + +rxt(k,404)* y(k,23) +rxt(k,277)* y(k,24) +rxt(k,304)* y(k,25) & + +rxt(k,284)* y(k,26) +rxt(k,285)* y(k,27) +rxt(k,287)* y(k,28) & + +rxt(k,325)* y(k,29) +rxt(k,312)* y(k,30) +rxt(k,313)* y(k,31) & + +rxt(k,408)* y(k,32) +rxt(k,238)* y(k,41) +rxt(k,257)* y(k,42) & + +rxt(k,240)* y(k,43) +rxt(k,241)* y(k,44) +rxt(k,289)* y(k,45) & + +rxt(k,243)* y(k,46) +rxt(k,290)* y(k,47) +rxt(k,326)* y(k,48) & + +rxt(k,315)* y(k,49) +rxt(k,295)* y(k,50) +rxt(k,296)* y(k,51) & + +rxt(k,262)* y(k,52) +rxt(k,263)* y(k,53) +rxt(k,264)* y(k,54) & + +rxt(k,245)* y(k,55) + (rxt(k,192) +rxt(k,193))* y(k,59) +rxt(k,190) & + * y(k,60) + (rxt(k,265) +rxt(k,275))* y(k,62) +rxt(k,409)* y(k,66) & + + (rxt(k,477) +rxt(k,479))* y(k,67) +rxt(k,301)* y(k,74) +rxt(k,302) & + * y(k,75) +rxt(k,141)* y(k,77) +rxt(k,142)* y(k,79) +rxt(k,224) & + * y(k,81) +rxt(k,246)* y(k,82) +rxt(k,247)* y(k,83) +rxt(k,248) & + * y(k,84) +rxt(k,195)* y(k,85) +rxt(k,266)* y(k,86) +rxt(k,267) & + * y(k,87) +rxt(k,171)* y(k,89) +rxt(k,149)* y(k,90) +rxt(k,198) & + * y(k,92) +rxt(k,331)* y(k,93) +rxt(k,362)* y(k,94) +rxt(k,316) & + * y(k,95) +rxt(k,363)* y(k,96) +rxt(k,364)* y(k,97) +rxt(k,386) & + * y(k,98) +rxt(k,376)* y(k,99) +rxt(k,377)* y(k,100) +rxt(k,384) & + * y(k,102) +rxt(k,387)* y(k,103) +rxt(k,339)* y(k,105) +rxt(k,340) & + * y(k,106) +rxt(k,349)* y(k,107) +rxt(k,350)* y(k,108) +rxt(k,351) & + * y(k,109) +rxt(k,444)* y(k,110) +rxt(k,353)* y(k,111) +rxt(k,162) & + * y(k,112) +rxt(k,388)* y(k,115) +rxt(k,389)* y(k,116) +rxt(k,478) & + * y(k,120) +rxt(k,170)* y(k,125) +rxt(k,161)* y(k,126) +rxt(k,317) & + * y(k,127) +rxt(k,449)* y(k,128) +rxt(k,144)* y(k,133) +rxt(k,145) & + * y(k,134) +rxt(k,463)* y(k,136) +rxt(k,303)* y(k,138) +rxt(k,421) & + * y(k,141) +rxt(k,424)* y(k,142) +rxt(k,320)* y(k,145) +rxt(k,324) & + * y(k,146) +rxt(k,468)* y(k,147) +rxt(k,473)* y(k,149) +rxt(k,474) & + * y(k,150) +rxt(k,453)* y(k,173) +rxt(k,454)* y(k,174) +rxt(k,458) & + * y(k,175) +rxt(k,460)* y(k,176) +rxt(k,461)* y(k,177) +rxt(k,428) & + * y(k,178) +rxt(k,429)* y(k,179) +rxt(k,395)* y(k,180) +rxt(k,431) & + * y(k,181) +rxt(k,434)* y(k,182) +rxt(k,437)* y(k,183) +rxt(k,438) & + * y(k,184) +rxt(k,143)* y(k,200) + 2._r8*(rxt(k,146) +rxt(k,147)) & + * y(k,211) + het_rates(k,211))* y(k,211) + prod(k,181) = (2.000_r8*rxt(k,135)*y(k,76) +rxt(k,138)*y(k,133) + & + rxt(k,139)*y(k,134) +rxt(k,158)*y(k,126) +rxt(k,163)*y(k,124) + & + rxt(k,179)*y(k,56) +.450_r8*rxt(k,293)*y(k,194) + & + .150_r8*rxt(k,322)*y(k,214) +.450_r8*rxt(k,343)*y(k,206) + & + .200_r8*rxt(k,347)*y(k,208) +.400_r8*rxt(k,396)*y(k,187) + & + .400_r8*rxt(k,410)*y(k,196) +.400_r8*rxt(k,416)*y(k,207))*y(k,200) & + + (rxt(k,140)*y(k,76) +.130_r8*rxt(k,279)*y(k,25) + & + .360_r8*rxt(k,308)*y(k,29) +.240_r8*rxt(k,338)*y(k,105) + & + .360_r8*rxt(k,352)*y(k,111) +.320_r8*rxt(k,385)*y(k,98) + & + .630_r8*rxt(k,440)*y(k,6) +.630_r8*rxt(k,443)*y(k,110))*y(k,134) & + + (rxt(k,132)*y(k,77) +rxt(k,133)*y(k,79) +rxt(k,194)*y(k,85) + & + rxt(k,197)*y(k,92) +rxt(k,223)*y(k,81) +rxt(k,225)*y(k,91) + & + rxt(k,256)*y(k,42))*y(k,133) + (.300_r8*rxt(k,263)*y(k,53) + & + .650_r8*rxt(k,277)*y(k,24) +.500_r8*rxt(k,285)*y(k,27) + & + .500_r8*rxt(k,320)*y(k,145) +.100_r8*rxt(k,340)*y(k,106) + & + .600_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,180))*y(k,211) & + + (rxt(k,271)*y(k,54) +rxt(k,124)*y(k,77) + & + 2.000_r8*rxt(k,125)*y(k,221) +rxt(k,206)*y(k,85) + & + rxt(k,229)*y(k,81) +rxt(k,274)*y(k,86))*y(k,210) + (rxt(k,2) + & + rxt(k,233)*y(k,73))*y(k,221) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,8) & + +rxt(k,28)*y(k,23) +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,31) & + *y(k,32) +rxt(k,37)*y(k,51) +rxt(k,38)*y(k,53) +rxt(k,42)*y(k,72) & + +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10)*y(k,90) & + +rxt(k,105)*y(k,91) +rxt(k,106)*y(k,92) +rxt(k,46)*y(k,94) & + +rxt(k,53)*y(k,108) +.500_r8*rxt(k,489)*y(k,125) +rxt(k,58)*y(k,128) & + +rxt(k,61)*y(k,142) +rxt(k,62)*y(k,145) +rxt(k,63)*y(k,146) & + +rxt(k,65)*y(k,173) +rxt(k,67)*y(k,175) +rxt(k,70)*y(k,178) & + +rxt(k,71)*y(k,180) +rxt(k,72)*y(k,182) +rxt(k,73)*y(k,184) + loss(k,95) = (rxt(k,420)* y(k,124) +rxt(k,419)* y(k,200) + het_rates(k,212)) & + * y(k,212) + prod(k,95) = (.200_r8*rxt(k,409)*y(k,66) +.140_r8*rxt(k,421)*y(k,141) + & + rxt(k,424)*y(k,142))*y(k,211) + loss(k,130) = (rxt(k,319)* y(k,124) +rxt(k,318)* y(k,200) + het_rates(k,213)) & + * y(k,213) + prod(k,130) = (.500_r8*rxt(k,320)*y(k,145) +rxt(k,325)*y(k,29))*y(k,211) + loss(k,160) = (rxt(k,323)* y(k,124) +rxt(k,321)* y(k,195) +rxt(k,322) & + * y(k,200) + het_rates(k,214))* y(k,214) + prod(k,160) = (rxt(k,324)*y(k,146) +rxt(k,326)*y(k,48) + & + .150_r8*rxt(k,461)*y(k,177))*y(k,211) + (.060_r8*rxt(k,440)*y(k,6) + & + .060_r8*rxt(k,443)*y(k,110))*y(k,134) +.150_r8*rxt(k,69)*y(k,177) + loss(k,158) = (rxt(k,452)* y(k,124) +rxt(k,450)* y(k,195) +rxt(k,451) & + * y(k,200) + het_rates(k,215))* y(k,215) + prod(k,158) = (.500_r8*rxt(k,459)*y(k,126) +rxt(k,460)*y(k,211))*y(k,176) & + +rxt(k,453)*y(k,211)*y(k,173) + loss(k,157) = (rxt(k,457)* y(k,124) +rxt(k,455)* y(k,195) +rxt(k,456) & + * y(k,200) + het_rates(k,216))* y(k,216) + prod(k,157) = (rxt(k,441)*y(k,6) +rxt(k,444)*y(k,110) +rxt(k,458)*y(k,175)) & + *y(k,211) + loss(k,127) = (rxt(k,427)* y(k,124) +rxt(k,426)* y(k,200) + het_rates(k,217)) & + * y(k,217) + prod(k,127) = (rxt(k,428)*y(k,178) +.650_r8*rxt(k,429)*y(k,179))*y(k,211) + loss(k,163) = (rxt(k,393)* y(k,124) +rxt(k,394)* y(k,126) +rxt(k,390) & + * y(k,194) +rxt(k,391)* y(k,195) +rxt(k,392)* y(k,200) & + + het_rates(k,218))* y(k,218) + prod(k,163) = (rxt(k,362)*y(k,94) +rxt(k,363)*y(k,96) +rxt(k,364)*y(k,97) + & + .400_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,180))*y(k,211) + loss(k,128) = (rxt(k,433)* y(k,124) +rxt(k,432)* y(k,200) + het_rates(k,219)) & + * y(k,219) + prod(k,128) = (.560_r8*rxt(k,431)*y(k,181) +rxt(k,434)*y(k,182))*y(k,211) + loss(k,101) = (rxt(k,436)* y(k,124) +rxt(k,435)* y(k,200) + het_rates(k,220)) & + * y(k,220) + prod(k,101) = (.300_r8*rxt(k,437)*y(k,183) +rxt(k,438)*y(k,184))*y(k,211) + loss(k,191) = (rxt(k,233)* y(k,73) +rxt(k,475)* y(k,151) +rxt(k,125) & + * y(k,210) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,221)) & + * y(k,221) + prod(k,191) = (rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) +rxt(k,241)*y(k,44) + & + rxt(k,243)*y(k,46) +rxt(k,248)*y(k,84) +rxt(k,264)*y(k,54) + & + rxt(k,141)*y(k,77) +rxt(k,142)*y(k,79) +rxt(k,143)*y(k,200) + & + rxt(k,146)*y(k,211) +rxt(k,149)*y(k,90) +rxt(k,171)*y(k,89) + & + rxt(k,195)*y(k,85) +rxt(k,198)*y(k,92) +rxt(k,224)*y(k,81) + & + rxt(k,257)*y(k,42) +rxt(k,263)*y(k,53) +rxt(k,267)*y(k,87) + & + rxt(k,287)*y(k,28) +rxt(k,289)*y(k,45) +rxt(k,295)*y(k,50) + & + rxt(k,296)*y(k,51) +rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31) + & + rxt(k,315)*y(k,49) +rxt(k,320)*y(k,145) +rxt(k,324)*y(k,146) + & + rxt(k,326)*y(k,48) +.500_r8*rxt(k,339)*y(k,105) +rxt(k,478)*y(k,120)) & + *y(k,211) + (rxt(k,509)*y(k,92) +rxt(k,515)*y(k,92) + & + rxt(k,516)*y(k,91) +rxt(k,520)*y(k,92) +rxt(k,521)*y(k,91))*y(k,85) & + +rxt(k,136)*y(k,200)*y(k,76) +rxt(k,109)*y(k,80) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..0939746796 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 @@ -0,0 +1,540 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 221) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 221) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 221) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 134) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 134) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 113) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 8) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 9) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 10) ! rate_const*BIGALD + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 11) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 12) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 13) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 14) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 23) ! rate_const*BZOOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 32) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 45) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 48) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 49) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 51) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 53) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 72) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 74) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 94) ! rate_const*HPALD + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 95) ! rate_const*HYAC + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 103) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 107) ! rate_const*MEK + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 108) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 109) ! rate_const*MPAN + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 111) ! rate_const*MVK + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 127) ! rate_const*NOA + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 137) ! rate_const*ONITR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 138) ! rate_const*PAN + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 142) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 145) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 146) ! rate_const*ROOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 172) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 173) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 174) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 175) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 176) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 177) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 178) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 180) ! rate_const*XOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 182) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 184) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 18) ! rate_const*BRCL + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 19) ! rate_const*BRO + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 33) ! rate_const*CCL4 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 34) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 35) ! rate_const*CF3BR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 36) ! rate_const*CFC11 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 37) ! rate_const*CFC113 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 38) ! rate_const*CFC114 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 39) ! rate_const*CFC115 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 40) ! rate_const*CFC12 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 41) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 43) ! rate_const*CH3BR + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 44) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 46) ! rate_const*CH3CL + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 55) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 57) ! rate_const*CL2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 58) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 59) ! rate_const*CLO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 64) ! rate_const*COF2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 65) ! rate_const*COFCL + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 78) ! rate_const*H2402 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 81) ! rate_const*HBR + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 82) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 83) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 84) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 85) ! rate_const*HCL + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 88) ! rate_const*HF + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 91) ! rate_const*HOBR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 92) ! rate_const*HOCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 135) ! rate_const*OCLO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 148) ! rate_const*SF6 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 80) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 136) ! rate_const*OCS + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 149) ! rate_const*SO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 150) ! rate_const*SO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 151) ! rate_const*SO3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 155) ! rate_const*soa1_a1 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 156) ! rate_const*soa1_a2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 157) ! rate_const*soa2_a1 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 158) ! rate_const*soa2_a2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 159) ! rate_const*soa3_a1 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 160) ! rate_const*soa3_a2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 161) ! rate_const*soa4_a1 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 162) ! rate_const*soa4_a2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 163) ! rate_const*soa5_a1 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 164) ! rate_const*soa5_a2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 210)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 210)*sol(:ncol,:, 221) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 210) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 210) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 210)*sol(:ncol,:, 134) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*O*O3 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*O*O + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 133) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 77)*sol(:ncol,:, 133) ! rate_const*H2*O + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 79)*sol(:ncol,:, 133) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 76)*sol(:ncol,:, 200) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 76)*sol(:ncol,:, 200) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 76)*sol(:ncol,:, 200) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 76) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 200)*sol(:ncol,:, 133) ! rate_const*HO2*O + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 200)*sol(:ncol,:, 134) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 76)*sol(:ncol,:, 134) ! rate_const*H*O3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 211)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 211)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 211)*sol(:ncol,:, 200) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 211)*sol(:ncol,:, 133) ! rate_const*OH*O + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 211)*sol(:ncol,:, 134) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 211)*sol(:ncol,:, 211) ! rate_const*OH*OH + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 211)*sol(:ncol,:, 211) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 200)*sol(:ncol,:, 200) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 90)*sol(:ncol,:, 211) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 112) ! rate_const*O2*N + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*NO2*O + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 126)*sol(:ncol,:, 200) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 126)*sol(:ncol,:, 133) ! rate_const*NO3*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 126)*sol(:ncol,:, 211) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 112)*sol(:ncol,:, 211) ! rate_const*N*OH + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 124)*sol(:ncol,:, 200) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 210)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 210)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 125)*sol(:ncol,:, 200) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 125)*sol(:ncol,:, 211) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 89)*sol(:ncol,:, 211) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 114) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 56)*sol(:ncol,:, 200) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 56)*sol(:ncol,:, 200) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 56)*sol(:ncol,:, 134) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 59)*sol(:ncol,:, 195) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 59)*sol(:ncol,:, 200) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 60)*sol(:ncol,:, 211) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 59)*sol(:ncol,:, 133) ! rate_const*CLO*O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 59)*sol(:ncol,:, 211) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 59)*sol(:ncol,:, 211) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 85)*sol(:ncol,:, 133) ! rate_const*HCL*O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 85)*sol(:ncol,:, 211) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 92)*sol(:ncol,:, 211) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 210)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 210)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 210)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 210)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 210)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 210)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 210)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 210)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 210)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 17)*sol(:ncol,:, 200) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 17)*sol(:ncol,:, 134) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 19)*sol(:ncol,:, 200) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*BRO*O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 211) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*HBR*O + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 81)*sol(:ncol,:, 211) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 210)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 210)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 210)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 210)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 210)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 73)*sol(:ncol,:, 221) ! rate_const*F*H2O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 210)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 210)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 41)*sol(:ncol,:, 211) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 43)*sol(:ncol,:, 211) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 44)*sol(:ncol,:, 211) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 46)*sol(:ncol,:, 211) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 55)*sol(:ncol,:, 211) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 82)*sol(:ncol,:, 211) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 83)*sol(:ncol,:, 211) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 84)*sol(:ncol,:, 211) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 210)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 210)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 210)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 210)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 210)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 42)*sol(:ncol,:, 200) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 42)*sol(:ncol,:, 133) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 42)*sol(:ncol,:, 211) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 195)*sol(:ncol,:, 195) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 195)*sol(:ncol,:, 195) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 195)*sol(:ncol,:, 200) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 52)*sol(:ncol,:, 211) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 53)*sol(:ncol,:, 211) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 54)*sol(:ncol,:, 211) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 62)*sol(:ncol,:, 211) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 86)*sol(:ncol,:, 211) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 87)*sol(:ncol,:, 211) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 201)*sol(:ncol,:, 200) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 201) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 201)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 210)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 210)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 210)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 210)*sol(:ncol,:, 86) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 62)*sol(:ncol,:, 211) ! rate_const*CO*OH + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 24)*sol(:ncol,:, 211) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 25)*sol(:ncol,:, 134) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 191)*sol(:ncol,:, 191) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 191)*sol(:ncol,:, 195) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 191)*sol(:ncol,:, 200) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 26)*sol(:ncol,:, 211) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 27)*sol(:ncol,:, 211) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 28)*sol(:ncol,:, 211) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 45)*sol(:ncol,:, 211) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 47)*sol(:ncol,:, 211) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 194)*sol(:ncol,:, 194) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 194)*sol(:ncol,:, 195) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 194)*sol(:ncol,:, 200) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 50)*sol(:ncol,:, 211) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 51)*sol(:ncol,:, 211) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 199)*sol(:ncol,:, 200) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 198) ! rate_const*EO + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 198) ! rate_const*O2*EO + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 74)*sol(:ncol,:, 211) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 75)*sol(:ncol,:, 211) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 138)*sol(:ncol,:, 211) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 25)*sol(:ncol,:, 211) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 194)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 138) ! rate_const*M*PAN + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 29)*sol(:ncol,:, 134) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 192)*sol(:ncol,:, 195) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 192)*sol(:ncol,:, 200) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 30)*sol(:ncol,:, 211) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 31)*sol(:ncol,:, 211) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 49)*sol(:ncol,:, 211) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 95)*sol(:ncol,:, 211) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 127)*sol(:ncol,:, 211) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 213)*sol(:ncol,:, 200) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 213)*sol(:ncol,:, 124) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 145)*sol(:ncol,:, 211) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 214)*sol(:ncol,:, 195) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 214)*sol(:ncol,:, 200) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 214)*sol(:ncol,:, 124) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 146)*sol(:ncol,:, 211) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 29)*sol(:ncol,:, 211) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 48)*sol(:ncol,:, 211) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 16)*sol(:ncol,:, 126) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 16)*sol(:ncol,:, 211) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 93)*sol(:ncol,:, 211) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 204)*sol(:ncol,:, 194) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 204)*sol(:ncol,:, 195) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 204)*sol(:ncol,:, 200) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 204)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 105)*sol(:ncol,:, 134) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 105)*sol(:ncol,:, 211) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 106)*sol(:ncol,:, 211) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 206)*sol(:ncol,:, 194) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 206)*sol(:ncol,:, 195) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 206)*sol(:ncol,:, 200) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 206)*sol(:ncol,:, 206) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 206)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 208)*sol(:ncol,:, 200) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 107)*sol(:ncol,:, 211) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 108)*sol(:ncol,:, 211) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 109)*sol(:ncol,:, 211) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 111)*sol(:ncol,:, 134) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 111)*sol(:ncol,:, 211) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 206)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 109) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 1)*sol(:ncol,:, 211) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 188)*sol(:ncol,:, 200) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 188)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 188)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 2)*sol(:ncol,:, 211) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 15)*sol(:ncol,:, 211) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 94)*sol(:ncol,:, 211) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 96)*sol(:ncol,:, 211) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 97)*sol(:ncol,:, 211) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 202)*sol(:ncol,:, 194) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 202)*sol(:ncol,:, 195) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 202)*sol(:ncol,:, 200) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 202)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 203)*sol(:ncol,:, 194) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 203)*sol(:ncol,:, 195) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 203)*sol(:ncol,:, 200) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 203) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 203)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 203)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 99)*sol(:ncol,:, 211) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 100)*sol(:ncol,:, 211) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 101)*sol(:ncol,:, 194) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 101)*sol(:ncol,:, 195) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 101)*sol(:ncol,:, 200) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 101)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 101)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 102)*sol(:ncol,:, 211) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 98)*sol(:ncol,:, 134) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 98)*sol(:ncol,:, 211) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 103)*sol(:ncol,:, 211) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 115)*sol(:ncol,:, 211) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 116)*sol(:ncol,:, 211) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 218)*sol(:ncol,:, 194) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 218)*sol(:ncol,:, 195) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 218)*sol(:ncol,:, 200) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 218)*sol(:ncol,:, 124) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 218)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 180)*sol(:ncol,:, 211) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 187)*sol(:ncol,:, 200) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 187)*sol(:ncol,:, 124) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 7)*sol(:ncol,:, 211) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 189)*sol(:ncol,:, 200) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 189)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 8)*sol(:ncol,:, 211) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 22)*sol(:ncol,:, 211) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 190)*sol(:ncol,:, 200) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 23)*sol(:ncol,:, 211) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 190)*sol(:ncol,:, 124) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 193)*sol(:ncol,:, 200) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 32)*sol(:ncol,:, 211) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 66)*sol(:ncol,:, 211) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 196)*sol(:ncol,:, 200) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 196)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 205)*sol(:ncol,:, 200) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 205)*sol(:ncol,:, 124) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 205)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 207)*sol(:ncol,:, 200) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 207)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 212)*sol(:ncol,:, 200) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 212)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 141)*sol(:ncol,:, 211) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 140)*sol(:ncol,:, 125) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 140)*sol(:ncol,:, 134) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 142)*sol(:ncol,:, 211) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 187)*sol(:ncol,:, 125) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 217)*sol(:ncol,:, 200) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 217)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 178)*sol(:ncol,:, 211) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 179)*sol(:ncol,:, 211) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 139) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 181)*sol(:ncol,:, 211) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 219)*sol(:ncol,:, 200) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 219)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 182)*sol(:ncol,:, 211) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 220)*sol(:ncol,:, 200) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 220)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 183)*sol(:ncol,:, 211) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 184)*sol(:ncol,:, 211) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 6)*sol(:ncol,:, 134) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 6)*sol(:ncol,:, 211) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 110)*sol(:ncol,:, 134) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 110)*sol(:ncol,:, 211) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 209)*sol(:ncol,:, 195) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 209)*sol(:ncol,:, 200) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 209)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 128)*sol(:ncol,:, 211) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 215)*sol(:ncol,:, 195) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 215)*sol(:ncol,:, 200) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 215)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 173)*sol(:ncol,:, 211) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 174)*sol(:ncol,:, 211) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 216)*sol(:ncol,:, 195) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 216)*sol(:ncol,:, 200) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 216)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 175)*sol(:ncol,:, 211) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 176)*sol(:ncol,:, 126) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 176)*sol(:ncol,:, 211) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 177)*sol(:ncol,:, 211) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 136)*sol(:ncol,:, 133) ! rate_const*OCS*O + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 136)*sol(:ncol,:, 211) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 147) ! rate_const*O2*S + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 147)*sol(:ncol,:, 134) ! rate_const*S*O3 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 149)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 149)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 147)*sol(:ncol,:, 211) ! rate_const*S*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 149)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 149) ! rate_const*O2*SO + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 149)*sol(:ncol,:, 134) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 149)*sol(:ncol,:, 135) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 149)*sol(:ncol,:, 211) ! rate_const*SO*OH + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 150)*sol(:ncol,:, 211) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 151)*sol(:ncol,:, 221) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 67)*sol(:ncol,:, 126) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 67)*sol(:ncol,:, 211) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 120)*sol(:ncol,:, 211) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 67)*sol(:ncol,:, 211) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 200) ! rate_const*HO2 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 99) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 100) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 115) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 121) ! rate_const*NH4 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 137) ! rate_const*ONITR + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 174) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 6)*sol(:ncol,:, 134) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 6)*sol(:ncol,:, 211) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 7)*sol(:ncol,:, 211) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 98)*sol(:ncol,:, 134) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 98)*sol(:ncol,:, 211) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 104)*sol(:ncol,:, 211) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 110)*sol(:ncol,:, 134) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 110)*sol(:ncol,:, 211) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 171)*sol(:ncol,:, 211) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 179)*sol(:ncol,:, 211) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 181)*sol(:ncol,:, 211) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 170) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 new file mode 100644 index 0000000000..3655f4176a --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 @@ -0,0 +1,680 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,124) = 1.2e-10_r8 + rate(:,128) = 1.2e-10_r8 + rate(:,134) = 6.9e-12_r8 + rate(:,135) = 7.2e-11_r8 + rate(:,136) = 1.6e-12_r8 + rate(:,142) = 1.8e-12_r8 + rate(:,146) = 1.8e-12_r8 + rate(:,158) = 3.5e-12_r8 + rate(:,160) = 1e-11_r8 + rate(:,161) = 2.2e-11_r8 + rate(:,162) = 5e-11_r8 + rate(:,197) = 1.7e-13_r8 + rate(:,199) = 2.607e-10_r8 + rate(:,200) = 9.75e-11_r8 + rate(:,201) = 2.07e-10_r8 + rate(:,202) = 2.088e-10_r8 + rate(:,203) = 1.17e-10_r8 + rate(:,204) = 4.644e-11_r8 + rate(:,205) = 1.204e-10_r8 + rate(:,206) = 9.9e-11_r8 + rate(:,207) = 3.3e-12_r8 + rate(:,226) = 4.5e-11_r8 + rate(:,227) = 4.62e-10_r8 + rate(:,228) = 1.2e-10_r8 + rate(:,229) = 9e-11_r8 + rate(:,230) = 3e-11_r8 + rate(:,235) = 2.14e-11_r8 + rate(:,236) = 1.9e-10_r8 + rate(:,249) = 2.57e-10_r8 + rate(:,250) = 1.8e-10_r8 + rate(:,251) = 1.794e-10_r8 + rate(:,252) = 1.3e-10_r8 + rate(:,253) = 7.65e-11_r8 + rate(:,267) = 4e-13_r8 + rate(:,271) = 1.31e-10_r8 + rate(:,272) = 3.5e-11_r8 + rate(:,273) = 9e-12_r8 + rate(:,280) = 6.8e-14_r8 + rate(:,281) = 2e-13_r8 + rate(:,295) = 7e-13_r8 + rate(:,296) = 1e-12_r8 + rate(:,300) = 1e-14_r8 + rate(:,301) = 1e-11_r8 + rate(:,302) = 1.15e-11_r8 + rate(:,303) = 4e-14_r8 + rate(:,316) = 3e-12_r8 + rate(:,317) = 6.7e-13_r8 + rate(:,327) = 3.5e-13_r8 + rate(:,328) = 5.4e-11_r8 + rate(:,331) = 2e-12_r8 + rate(:,332) = 1.4e-11_r8 + rate(:,335) = 2.4e-12_r8 + rate(:,346) = 5e-12_r8 + rate(:,356) = 1.6e-12_r8 + rate(:,358) = 6.7e-12_r8 + rate(:,361) = 3.5e-12_r8 + rate(:,364) = 1.3e-11_r8 + rate(:,365) = 1.4e-11_r8 + rate(:,369) = 2.4e-12_r8 + rate(:,370) = 1.4e-11_r8 + rate(:,375) = 2.4e-12_r8 + rate(:,376) = 4e-11_r8 + rate(:,377) = 4e-11_r8 + rate(:,379) = 1.4e-11_r8 + rate(:,383) = 2.4e-12_r8 + rate(:,384) = 4e-11_r8 + rate(:,388) = 7e-11_r8 + rate(:,389) = 1e-10_r8 + rate(:,394) = 2.4e-12_r8 + rate(:,409) = 4.7e-11_r8 + rate(:,422) = 2.1e-12_r8 + rate(:,423) = 2.8e-13_r8 + rate(:,431) = 1.7e-11_r8 + rate(:,437) = 8.4e-11_r8 + rate(:,439) = 1.9e-11_r8 + rate(:,440) = 1.2e-14_r8 + rate(:,441) = 2e-10_r8 + rate(:,448) = 2.4e-12_r8 + rate(:,449) = 2e-11_r8 + rate(:,453) = 2.3e-11_r8 + rate(:,454) = 2e-11_r8 + rate(:,458) = 3.3e-11_r8 + rate(:,459) = 1e-12_r8 + rate(:,460) = 5.7e-11_r8 + rate(:,461) = 3.4e-11_r8 + rate(:,464) = 2.3e-12_r8 + rate(:,465) = 1.2e-11_r8 + rate(:,466) = 5.7e-11_r8 + rate(:,467) = 2.8e-11_r8 + rate(:,468) = 6.6e-11_r8 + rate(:,469) = 1.4e-11_r8 + rate(:,472) = 1.9e-12_r8 + rate(:,488) = 6.34e-08_r8 + rate(:,494) = 1.9e-11_r8 + rate(:,495) = 1.2e-14_r8 + rate(:,496) = 2e-10_r8 + rate(:,501) = 1.34e-11_r8 + rate(:,505) = 1.34e-11_r8 + rate(:,507) = 1.7e-11_r8 + rate(:,525) = 1.29e-07_r8 + rate(:,526) = 2.31e-07_r8 + rate(:,527) = 2.31e-06_r8 + rate(:,528) = 4.63e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,125) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,126) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,127) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,129) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,132) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,133) = 1.4e-12_r8 * exp_fac(:) + rate(:,385) = 1.05e-14_r8 * exp_fac(:) + rate(:,499) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,138) = 3e-11_r8 * exp_fac(:) + rate(:,224) = 5.5e-12_r8 * exp_fac(:) + rate(:,263) = 3.8e-12_r8 * exp_fac(:) + rate(:,285) = 3.8e-12_r8 * exp_fac(:) + rate(:,312) = 3.8e-12_r8 * exp_fac(:) + rate(:,320) = 3.8e-12_r8 * exp_fac(:) + rate(:,324) = 3.8e-12_r8 * exp_fac(:) + rate(:,340) = 2.3e-11_r8 * exp_fac(:) + rate(:,350) = 3.8e-12_r8 * exp_fac(:) + rate(:,360) = 3.8e-12_r8 * exp_fac(:) + rate(:,387) = 1.52e-11_r8 * exp_fac(:) + rate(:,395) = 1.52e-12_r8 * exp_fac(:) + rate(:,401) = 3.8e-12_r8 * exp_fac(:) + rate(:,404) = 3.8e-12_r8 * exp_fac(:) + rate(:,408) = 3.8e-12_r8 * exp_fac(:) + rate(:,424) = 3.8e-12_r8 * exp_fac(:) + rate(:,428) = 3.8e-12_r8 * exp_fac(:) + rate(:,434) = 3.8e-12_r8 * exp_fac(:) + rate(:,438) = 3.8e-12_r8 * exp_fac(:) + rate(:,139) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,140) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,141) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,143) = 4.8e-11_r8 * exp_fac(:) + rate(:,222) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,144) = 1.8e-11_r8 * exp_fac(:) + rate(:,298) = 4.2e-12_r8 * exp_fac(:) + rate(:,311) = 4.2e-12_r8 * exp_fac(:) + rate(:,319) = 4.2e-12_r8 * exp_fac(:) + rate(:,348) = 4.2e-12_r8 * exp_fac(:) + rate(:,368) = 4.4e-12_r8 * exp_fac(:) + rate(:,374) = 4.4e-12_r8 * exp_fac(:) + rate(:,447) = 4.2e-12_r8 * exp_fac(:) + rate(:,452) = 4.2e-12_r8 * exp_fac(:) + rate(:,457) = 4.2e-12_r8 * exp_fac(:) + rate(:,145) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,149) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,150) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,151) = 2.9e-12_r8 * exp_fac(:) + rate(:,152) = 1.45e-12_r8 * exp_fac(:) + rate(:,153) = 1.45e-12_r8 * exp_fac(:) + rate(:,154) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,155) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,156) = 1.2e-13_r8 * exp_fac(:) + rate(:,182) = 3e-11_r8 * exp_fac(:) + rate(:,159) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,163) = 3.3e-12_r8 * exp_fac(:) + rate(:,178) = 1.4e-11_r8 * exp_fac(:) + rate(:,192) = 7.4e-12_r8 * exp_fac(:) + rate(:,294) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,164) = 3e-12_r8 * exp_fac(:) + rate(:,223) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,166) = 7.26e-11_r8 * exp_fac(:) + rate(:,167) = 4.64e-11_r8 * exp_fac(:) + rate(:,174) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,175) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,176) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,177) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + rate(:,179) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,180) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,181) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,183) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,184) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,185) = 2.6e-12_r8 * exp_fac(:) + rate(:,186) = 6.4e-12_r8 * exp_fac(:) + rate(:,216) = 4.1e-13_r8 * exp_fac(:) + rate(:,397) = 7.5e-12_r8 * exp_fac(:) + rate(:,411) = 7.5e-12_r8 * exp_fac(:) + rate(:,414) = 7.5e-12_r8 * exp_fac(:) + rate(:,417) = 7.5e-12_r8 * exp_fac(:) + rate(:,187) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,189) = 3.6e-12_r8 * exp_fac(:) + rate(:,238) = 2e-12_r8 * exp_fac(:) + rate(:,190) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,191) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,193) = 6e-13_r8 * exp_fac(:) + rate(:,213) = 1.5e-12_r8 * exp_fac(:) + rate(:,221) = 1.9e-11_r8 * exp_fac(:) + rate(:,194) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,195) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,196) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,198) = 3e-12_r8 * exp_fac(:) + rate(:,232) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,210) = 1.7e-11_r8 * exp_fac(:) + rate(:,237) = 6.3e-12_r8 * exp_fac(:) + rate(:,211) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,212) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,214) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,215) = 2.3e-12_r8 * exp_fac(:) + rate(:,218) = 8.8e-12_r8 * exp_fac(:) + rate(:,217) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,220) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,225) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,231) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,233) = 1.4e-11_r8 * exp_fac(:) + rate(:,235) = 2.14e-11_r8 * exp_fac(:) + rate(:,236) = 1.9e-10_r8 * exp_fac(:) + rate(:,249) = 2.57e-10_r8 * exp_fac(:) + rate(:,250) = 1.8e-10_r8 * exp_fac(:) + rate(:,251) = 1.794e-10_r8 * exp_fac(:) + rate(:,252) = 1.3e-10_r8 * exp_fac(:) + rate(:,253) = 7.65e-11_r8 * exp_fac(:) + rate(:,267) = 4e-13_r8 * exp_fac(:) + rate(:,271) = 1.31e-10_r8 * exp_fac(:) + rate(:,272) = 3.5e-11_r8 * exp_fac(:) + rate(:,273) = 9e-12_r8 * exp_fac(:) + rate(:,280) = 6.8e-14_r8 * exp_fac(:) + rate(:,281) = 2e-13_r8 * exp_fac(:) + rate(:,295) = 7e-13_r8 * exp_fac(:) + rate(:,296) = 1e-12_r8 * exp_fac(:) + rate(:,300) = 1e-14_r8 * exp_fac(:) + rate(:,301) = 1e-11_r8 * exp_fac(:) + rate(:,302) = 1.15e-11_r8 * exp_fac(:) + rate(:,303) = 4e-14_r8 * exp_fac(:) + rate(:,316) = 3e-12_r8 * exp_fac(:) + rate(:,317) = 6.7e-13_r8 * exp_fac(:) + rate(:,327) = 3.5e-13_r8 * exp_fac(:) + rate(:,328) = 5.4e-11_r8 * exp_fac(:) + rate(:,331) = 2e-12_r8 * exp_fac(:) + rate(:,332) = 1.4e-11_r8 * exp_fac(:) + rate(:,335) = 2.4e-12_r8 * exp_fac(:) + rate(:,346) = 5e-12_r8 * exp_fac(:) + rate(:,356) = 1.6e-12_r8 * exp_fac(:) + rate(:,358) = 6.7e-12_r8 * exp_fac(:) + rate(:,361) = 3.5e-12_r8 * exp_fac(:) + rate(:,364) = 1.3e-11_r8 * exp_fac(:) + rate(:,365) = 1.4e-11_r8 * exp_fac(:) + rate(:,369) = 2.4e-12_r8 * exp_fac(:) + rate(:,370) = 1.4e-11_r8 * exp_fac(:) + rate(:,375) = 2.4e-12_r8 * exp_fac(:) + rate(:,376) = 4e-11_r8 * exp_fac(:) + rate(:,377) = 4e-11_r8 * exp_fac(:) + rate(:,379) = 1.4e-11_r8 * exp_fac(:) + rate(:,383) = 2.4e-12_r8 * exp_fac(:) + rate(:,384) = 4e-11_r8 * exp_fac(:) + rate(:,388) = 7e-11_r8 * exp_fac(:) + rate(:,389) = 1e-10_r8 * exp_fac(:) + rate(:,394) = 2.4e-12_r8 * exp_fac(:) + rate(:,409) = 4.7e-11_r8 * exp_fac(:) + rate(:,422) = 2.1e-12_r8 * exp_fac(:) + rate(:,423) = 2.8e-13_r8 * exp_fac(:) + rate(:,431) = 1.7e-11_r8 * exp_fac(:) + rate(:,437) = 8.4e-11_r8 * exp_fac(:) + rate(:,439) = 1.9e-11_r8 * exp_fac(:) + rate(:,440) = 1.2e-14_r8 * exp_fac(:) + rate(:,441) = 2e-10_r8 * exp_fac(:) + rate(:,448) = 2.4e-12_r8 * exp_fac(:) + rate(:,449) = 2e-11_r8 * exp_fac(:) + rate(:,453) = 2.3e-11_r8 * exp_fac(:) + rate(:,454) = 2e-11_r8 * exp_fac(:) + rate(:,458) = 3.3e-11_r8 * exp_fac(:) + rate(:,459) = 1e-12_r8 * exp_fac(:) + rate(:,460) = 5.7e-11_r8 * exp_fac(:) + rate(:,461) = 3.4e-11_r8 * exp_fac(:) + rate(:,464) = 2.3e-12_r8 * exp_fac(:) + rate(:,465) = 1.2e-11_r8 * exp_fac(:) + rate(:,466) = 5.7e-11_r8 * exp_fac(:) + rate(:,467) = 2.8e-11_r8 * exp_fac(:) + rate(:,468) = 6.6e-11_r8 * exp_fac(:) + rate(:,469) = 1.4e-11_r8 * exp_fac(:) + rate(:,472) = 1.9e-12_r8 * exp_fac(:) + rate(:,488) = 6.34e-08_r8 * exp_fac(:) + rate(:,494) = 1.9e-11_r8 * exp_fac(:) + rate(:,495) = 1.2e-14_r8 * exp_fac(:) + rate(:,496) = 2e-10_r8 * exp_fac(:) + rate(:,501) = 1.34e-11_r8 * exp_fac(:) + rate(:,505) = 1.34e-11_r8 * exp_fac(:) + rate(:,507) = 1.7e-11_r8 * exp_fac(:) + rate(:,525) = 1.29e-07_r8 * exp_fac(:) + rate(:,526) = 2.31e-07_r8 * exp_fac(:) + rate(:,527) = 2.31e-06_r8 * exp_fac(:) + rate(:,528) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,234) = 6e-12_r8 * exp_fac(:) + rate(:,333) = 5e-13_r8 * exp_fac(:) + rate(:,366) = 5e-13_r8 * exp_fac(:) + rate(:,371) = 5e-13_r8 * exp_fac(:) + rate(:,380) = 5e-13_r8 * exp_fac(:) + rate(:,391) = 5e-13_r8 * exp_fac(:) + rate(:,239) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,240) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,241) = 1.64e-12_r8 * exp_fac(:) + rate(:,352) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,242) = 2.03e-11_r8 * exp_fac(:) + rate(:,471) = 3.4e-12_r8 * exp_fac(:) + rate(:,243) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,244) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,245) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,246) = 1.25e-12_r8 * exp_fac(:) + rate(:,256) = 3.4e-11_r8 * exp_fac(:) + rate(:,247) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,248) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,254) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,255) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,257) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) + rate(:,258) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,259) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,260) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,261) = 2.8e-12_r8 * exp_fac(:) + rate(:,323) = 2.9e-12_r8 * exp_fac(:) + rate(:,262) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,264) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,268) = 7.5e-13_r8 * exp_fac(:) + rate(:,282) = 7.5e-13_r8 * exp_fac(:) + rate(:,297) = 7.5e-13_r8 * exp_fac(:) + rate(:,310) = 7.5e-13_r8 * exp_fac(:) + rate(:,318) = 7.5e-13_r8 * exp_fac(:) + rate(:,322) = 8.6e-13_r8 * exp_fac(:) + rate(:,334) = 8e-13_r8 * exp_fac(:) + rate(:,347) = 7.5e-13_r8 * exp_fac(:) + rate(:,357) = 7.5e-13_r8 * exp_fac(:) + rate(:,367) = 8e-13_r8 * exp_fac(:) + rate(:,372) = 8e-13_r8 * exp_fac(:) + rate(:,381) = 8e-13_r8 * exp_fac(:) + rate(:,392) = 8e-13_r8 * exp_fac(:) + rate(:,399) = 7.5e-13_r8 * exp_fac(:) + rate(:,403) = 7.5e-13_r8 * exp_fac(:) + rate(:,406) = 7.5e-13_r8 * exp_fac(:) + rate(:,419) = 7.5e-13_r8 * exp_fac(:) + rate(:,426) = 7.5e-13_r8 * exp_fac(:) + rate(:,432) = 7.5e-13_r8 * exp_fac(:) + rate(:,435) = 7.5e-13_r8 * exp_fac(:) + rate(:,446) = 7.5e-13_r8 * exp_fac(:) + rate(:,451) = 7.5e-13_r8 * exp_fac(:) + rate(:,456) = 7.5e-13_r8 * exp_fac(:) + rate(:,269) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,270) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,274) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,279) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,283) = 2.6e-12_r8 * exp_fac(:) + rate(:,400) = 2.6e-12_r8 * exp_fac(:) + rate(:,405) = 2.6e-12_r8 * exp_fac(:) + rate(:,407) = 2.6e-12_r8 * exp_fac(:) + rate(:,420) = 2.6e-12_r8 * exp_fac(:) + rate(:,427) = 2.6e-12_r8 * exp_fac(:) + rate(:,433) = 2.6e-12_r8 * exp_fac(:) + rate(:,436) = 2.6e-12_r8 * exp_fac(:) + rate(:,284) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,286) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,287) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,288) = 1.4e-12_r8 * exp_fac(:) + rate(:,308) = 6.5e-15_r8 * exp_fac(:) + rate(:,289) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + rate(:,290) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,291) = 2.9e-12_r8 * exp_fac(:) + rate(:,292) = 2e-12_r8 * exp_fac(:) + rate(:,321) = 7.1e-13_r8 * exp_fac(:) + rate(:,342) = 2e-12_r8 * exp_fac(:) + rate(:,445) = 2e-12_r8 * exp_fac(:) + rate(:,450) = 2e-12_r8 * exp_fac(:) + rate(:,455) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,293) = 4.3e-13_r8 * exp_fac(:) + rate(:,343) = 4.3e-13_r8 * exp_fac(:) + rate(:,396) = 4.3e-13_r8 * exp_fac(:) + rate(:,410) = 4.3e-13_r8 * exp_fac(:) + rate(:,413) = 4.3e-13_r8 * exp_fac(:) + rate(:,416) = 4.3e-13_r8 * exp_fac(:) + rate(:,299) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,307) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,309) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,313) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) + rate(:,314) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,315) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,329) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,330) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,336) = 2.7e-12_r8 * exp_fac(:) + rate(:,337) = 1.3e-13_r8 * exp_fac(:) + rate(:,339) = 9.6e-12_r8 * exp_fac(:) + rate(:,345) = 5.3e-12_r8 * exp_fac(:) + rate(:,382) = 2.7e-12_r8 * exp_fac(:) + rate(:,393) = 2.7e-12_r8 * exp_fac(:) + rate(:,338) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,341) = 4.6e-12_r8 * exp_fac(:) + rate(:,344) = 2.3e-12_r8 * exp_fac(:) + rate(:,349) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,353) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,359) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,362) = 1.86e-11_r8 * exp_fac(:) + rate(:,363) = 1.86e-11_r8 * exp_fac(:) + rate(:,373) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,378) = 3.03e-12_r8 * exp_fac(:) + rate(:,498) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,386) = 2.54e-11_r8 * exp_fac(:) + rate(:,500) = 2.54e-11_r8 * exp_fac(:) + rate(:,390) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,398) = 2.3e-12_r8 * exp_fac(:) + rate(:,497) = 2.3e-12_r8 * exp_fac(:) + rate(:,402) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,421) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,429) = 1.7e-12_r8 * exp_fac(:) + rate(:,506) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,442) = 1.2e-12_r8 * exp_fac(:) + rate(:,502) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,443) = 6.3e-16_r8 * exp_fac(:) + rate(:,503) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,444) = 1.2e-11_r8 * exp_fac(:) + rate(:,504) = 1.2e-11_r8 * exp_fac(:) + rate(:,462) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,463) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,470) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,473) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + rate(:,476) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,477) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,478) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,137), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,147), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,157), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,165), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,168), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,169), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,170), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,188), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,208), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,219), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 + kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) + call jpl( rate(:,265), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 4.28e-33_r8 + kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) + call jpl( rate(:,266), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,276), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,277), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.6e-29_r8 * itemp(:)**3.3_r8 + kinf(:) = 3.1e-10_r8 * itemp(:) + call jpl( rate(:,278), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8.6e-29_r8 * itemp(:)**3.1_r8 + kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 + call jpl( rate(:,304), m, 0.48_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,305), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,325), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,351), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,412), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,415), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,418), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,425), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,134) = 6.9e-12_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,126) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,129) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,138) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,139) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,140) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,143) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,144) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,145) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,150) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,154) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,155) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,163) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,164) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,137) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 new file mode 100644 index 0000000000..b4acb1295a --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 @@ -0,0 +1,793 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 30, 0, 0, 191, 0 /) + + cls_rxt_cnt(:,1) = (/ 37, 61, 0, 30 /) + cls_rxt_cnt(:,4) = (/ 23, 174, 326, 191 /) + + solsym(:221) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & + 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & + 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & + 'BRY ','BZALD ','BZOOH ','C2H2 ','C2H4 ', & + 'C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ', & + 'C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CHO ', & + 'CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ','CH3COOH ', & + 'CH3COOOH ','CH3OH ','CH3OOH ','CH4 ','CHBR3 ', & + 'CL ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & + 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & + 'CRESOL ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & + 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & + 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & + 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & + 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & + 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & + 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & + 'NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ', & + 'NH4 ','NH_5 ','NH_50 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','O ','O3 ','OCLO ', & + 'OCS ','ONITR ','PAN ','PBZNIT ','PHENO ', & + 'PHENOL ','PHENOOH ','pom_a1 ','pom_a4 ','POOH ', & + 'ROOH ','S ','SF6 ','SO ','SO2 ', & + 'SO3 ','so4_a1 ','so4_a2 ','so4_a3 ','soa1_a1 ', & + 'soa1_a2 ','soa2_a1 ','soa2_a2 ','soa3_a1 ','soa3_a2 ', & + 'soa4_a1 ','soa4_a2 ','soa5_a1 ','soa5_a2 ','SOAG0 ', & + 'SOAG1 ','SOAG2 ','SOAG3 ','SOAG4 ','ST80_25 ', & + 'SVOC ','TEPOMUC ','TERP2OOH ','TERPNIT ','TERPOOH ', & + 'TERPROD1 ','TERPROD2 ','TOLOOH ','TOLUENE ','XOOH ', & + 'XYLENES ','XYLENOOH ','XYLOL ','XYLOLOOH ','NHDEP ', & + 'NDEP ','ACBZO2 ','ALKO2 ','BENZO2 ','BZOO ', & + 'C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ','CH3O2 ', & + 'DICARBO2 ','ENEO2 ','EO ','EO2 ','HO2 ', & + 'HOCH2OO ','ISOPAO2 ','ISOPBO2 ','MACRO2 ','MALO2 ', & + 'MCO3 ','MDIALO2 ','MEKO2 ','NTERPO2 ','O1D ', & + 'OH ','PHENO2 ','PO2 ','RO2 ','TERP2O2 ', & + 'TERPO2 ','TOLO2 ','XO2 ','XYLENO2 ','XYLOLO2 ', & + 'H2O ' /) + + adv_mass(:221) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & + 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & + 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & + 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, 28.051600_r8, & + 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, & + 44.092200_r8, 110.109200_r8, 153.821800_r8, 165.364506_r8, 148.910210_r8, & + 137.367503_r8, 187.375310_r8, 170.921013_r8, 154.466716_r8, 120.913206_r8, & + 173.833800_r8, 30.025200_r8, 94.937200_r8, 133.402300_r8, 44.051000_r8, & + 50.485900_r8, 41.050940_r8, 58.076800_r8, 72.061400_r8, 60.050400_r8, & + 76.049800_r8, 32.040000_r8, 48.039400_r8, 16.040600_r8, 252.730400_r8, & + 35.452700_r8, 70.905400_r8, 102.904200_r8, 51.452100_r8, 97.457640_r8, & + 100.916850_r8, 28.010400_r8, 44.009800_r8, 66.007206_r8, 82.461503_r8, & + 108.135600_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 28.010400_r8, 78.064600_r8, 18.998403_r8, 60.050400_r8, 58.035600_r8, & + 1.007400_r8, 2.014800_r8, 259.823613_r8, 34.013600_r8, 98.078400_r8, & + 80.911400_r8, 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & + 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & + 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & + 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & + 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & + 145.111140_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 17.028940_r8, & + 18.036340_r8, 28.010400_r8, 28.010400_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 119.074340_r8, 231.239540_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 15.999400_r8, 47.998200_r8, 67.451500_r8, & + 60.076400_r8, 133.100140_r8, 121.047940_r8, 183.117740_r8, 93.102400_r8, & + 94.109800_r8, 176.121600_r8, 12.011000_r8, 12.011000_r8, 92.090400_r8, & + 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, 64.064800_r8, & + 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 28.010400_r8, & + 310.582400_r8, 140.134400_r8, 186.241400_r8, 215.240140_r8, 186.241400_r8, & + 168.227200_r8, 154.201400_r8, 174.148000_r8, 92.136200_r8, 150.126000_r8, & + 106.162000_r8, 188.173800_r8, 122.161400_r8, 204.173200_r8, 14.006740_r8, & + 14.006740_r8, 137.112200_r8, 103.135200_r8, 159.114800_r8, 123.127600_r8, & + 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, 47.032000_r8, & + 129.089600_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, 33.006200_r8, & + 63.031400_r8, 117.119800_r8, 117.119800_r8, 119.093400_r8, 115.063800_r8, & + 101.079200_r8, 117.078600_r8, 103.094000_r8, 230.232140_r8, 15.999400_r8, & + 17.006800_r8, 175.114200_r8, 91.083000_r8, 89.068200_r8, 199.218600_r8, & + 185.234000_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 72.066000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, & + 12.011000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_r8, 24.022000_r8, 24.022000_r8, & + 0.000000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + 60.055000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 36.033000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 48.044000_r8, 24.022000_r8, 84.077000_r8, 72.066000_r8, & + 72.066000_r8, 72.066000_r8, 12.011000_r8, 12.011000_r8, 36.033000_r8, & + 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 12.011000_r8, & + 264.242000_r8, 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 120.110000_r8, 108.099000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 60.055000_r8, 72.066000_r8, 84.077000_r8, & + 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, & + 60.055000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, & + 12.011000_r8, 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, 0.000000_r8, & + 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, & + 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8 /) + + clsmap(: 30,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & + 82, 83, 84, 113, 122, 123, 148, 170, 185, 186 /) + clsmap(:191,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & + 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & + 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & + 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & + 81, 85, 86, 87, 88, 89, 90, 91, 92, 93, & + 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, & + 104, 105, 106, 107, 108, 109, 110, 111, 112, 114, & + 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & + 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, & + 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, & + 147, 149, 150, 151, 152, 153, 154, 155, 156, 157, & + 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, & + 168, 169, 171, 172, 173, 174, 175, 176, 177, 178, & + 179, 180, 181, 182, 183, 184, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221 /) + + permute(:191,4) = (/ 121, 120, 1, 2, 144, 46, 85, 47, 86, 96, & + 68, 117, 75, 60, 81, 174, 61, 187, 110, 62, & + 78, 70, 111, 64, 79, 71, 149, 90, 39, 65, & + 189, 161, 38, 147, 166, 108, 102, 134, 91, 184, & + 45, 36, 183, 148, 155, 40, 50, 52, 69, 3, & + 4, 5, 41, 132, 151, 142, 176, 162, 114, 42, & + 138, 177, 49, 133, 57, 175, 83, 131, 136, 154, & + 58, 156, 72, 43, 139, 113, 107, 164, 89, 123, & + 34, 165, 73, 104, 74, 106, 145, 169, 82, 67, & + 84, 152, 6, 7, 8, 37, 9, 190, 185, 179, & + 141, 87, 10, 11, 12, 13, 188, 186, 76, 80, & + 59, 97, 44, 98, 48, 77, 14, 15, 109, 88, & + 103, 167, 140, 63, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 33, 35, 53, 115, 118, 99, 150, 153, 116, & + 51, 54, 55, 124, 56, 92, 105, 146, 100, 93, & + 137, 135, 119, 173, 182, 129, 112, 66, 125, 178, & + 94, 168, 171, 170, 126, 172, 143, 122, 159, 180, & + 181, 95, 130, 160, 158, 157, 127, 163, 128, 101, & + 191 /) + + diag_map(:191) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 39, 45, 46, 49, 52, 55, 59, & + 62, 65, 68, 71, 74, 81, 87, 91, 96, 100, & + 109, 116, 121, 125, 134, 142, 147, 150, 155, 158, & + 161, 164, 168, 172, 176, 180, 184, 190, 193, 199, & + 205, 211, 214, 219, 224, 229, 234, 240, 245, 250, & + 258, 266, 272, 278, 284, 290, 296, 302, 308, 314, & + 320, 326, 334, 340, 347, 353, 356, 363, 367, 376, & + 384, 391, 397, 403, 409, 415, 423, 431, 435, 443, & + 451, 459, 467, 476, 483, 494, 503, 507, 515, 522, & + 533, 544, 552, 563, 576, 583, 594, 610, 621, 630, & + 640, 649, 657, 661, 666, 677, 687, 695, 709, 726, & + 732, 739, 744, 761, 787, 809, 819, 827, 841, 856, & + 865, 874, 886, 898, 911, 915, 928, 950, 969, 985, & + 996,1007,1024,1044,1060,1072,1083,1108,1130,1153, & + 1186,1205,1236,1250,1263,1276,1296,1390,1448,1473, & + 1621,1672,1699,1734,1776,1837,1862,1893,1917,1996, & + 2022 /) + + extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & + 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & + 'N ','AOA_NH ' /) + + frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false. /) + + inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) + + slvd_lst(: 34) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & + 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + 'MDIALO2 ', 'MEKO2 ', 'NTERPO2 ', 'O1D ', 'OH ', & + 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + 'TOLO2 ', 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_a ', & + 'jh2o_c ', 'jh2o2 ', & + 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno2 ', & + 'jno3_b ', 'jno3_a ', & + 'jalknit ', 'jalkooh ', & + 'jbenzooh ', 'jbepomuc ', & + 'jbigald ', 'jbigald1 ', & + 'jbigald2 ', 'jbigald3 ', & + 'jbigald4 ', 'jbzooh ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jc6h5ooh ', 'jch2o_a ', & + 'jch2o_b ', 'jch3cho ', & + 'jacet ', 'jmgly ', & + 'jch3co3h ', 'jch3ooh ', & + 'jch4_a ', 'jch4_b ', & + 'jco2 ', 'jeooh ', & + 'jglyald ', 'jglyoxal ', & + 'jhonitr ', 'jhpald ', & + 'jhyac ', 'jisopnooh ', & + 'jisopooh ', 'jmacr_a ', & + 'jmacr_b ', 'jmek ', & + 'jmekooh ', 'jmpan ', & + 'jmvk ', 'jnc4cho ', & + 'jnoa ', 'jnterpooh ', & + 'jonitr ', 'jpan ', & + 'jphenooh ', 'jpooh ', & + 'jrooh ', 'jtepomuc ', & + 'jterp2ooh ', 'jterpnit ', & + 'jterpooh ', 'jterprd1 ', & + 'jterprd2 ', 'jtolooh ', & + 'jxooh ', 'jxylenooh ', & + 'jxylolooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoa1_a1 ', & + 'jsoa1_a2 ', 'jsoa2_a1 ', & + 'jsoa2_a2 ', 'jsoa3_a1 ', & + 'jsoa3_a2 ', 'jsoa4_a1 ', & + 'jsoa4_a2 ', 'jsoa5_a1 ', & + 'jsoa5_a2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + 'O_O3 ', 'usr_O_O ', & + 'usr_O_O2 ', 'H2_O ', & + 'H2O2_O ', 'H_HO2 ', & + 'H_HO2a ', 'H_HO2b ', & + 'H_O2 ', 'HO2_O ', & + 'HO2_O3 ', 'H_O3 ', & + 'OH_H2 ', 'OH_H2O2 ', & + 'OH_HO2 ', 'OH_O ', & + 'OH_O3 ', 'OH_OH ', & + 'OH_OH_M ', 'usr_HO2_HO2 ', & + 'HO2NO2_OH ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'N_O2 ', & + 'NO2_O ', 'NO2_O3 ', & + 'NO2_O_M ', 'NO3_HO2 ', & + 'NO3_NO ', 'NO3_O ', & + 'NO3_OH ', 'N_OH ', & + 'NO_HO2 ', 'NO_O3 ', & + 'NO_O_M ', 'O1D_N2Oa ', & + 'O1D_N2Ob ', 'tag_NO2_HO2 ', & + 'tag_NO2_NO3 ', 'tag_NO2_OH ', & + 'usr_HNO3_OH ', 'usr_HO2NO2_M ', & + 'usr_N2O5_M ', 'CL_CH2O ', & + 'CL_CH4 ', 'CL_H2 ', & + 'CL_H2O2 ', 'CL_HO2a ', & + 'CL_HO2b ', 'CL_O3 ', & + 'CLO_CH3O2 ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'CLO_HO2 ', 'CLO_NO ', & + 'CLONO2_CL ', 'CLO_NO2_M ', & + 'CLONO2_O ', 'CLONO2_OH ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'HCL_O ', & + 'HCL_OH ', 'HOCL_CL ', & + 'HOCL_O ', 'HOCL_OH ', & + 'O1D_CCL4 ', 'O1D_CF2CLBR ' /) + rxt_tag_lst( 201: 400) = (/ 'O1D_CFC11 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_CFC12 ', 'O1D_HCLa ', & + 'O1D_HCLb ', 'tag_CLO_CLO_M ', & + 'usr_CL2O2_M ', 'BR_CH2O ', & + 'BR_HO2 ', 'BR_O3 ', & + 'BRO_BRO ', 'BRO_CLOa ', & + 'BRO_CLOb ', 'BRO_CLOc ', & + 'BRO_HO2 ', 'BRO_NO ', & + 'BRO_NO2_M ', 'BRONO2_O ', & + 'BRO_O ', 'BRO_OH ', & + 'HBR_O ', 'HBR_OH ', & + 'HOBR_O ', 'O1D_CF3BR ', & + 'O1D_CHBR3 ', 'O1D_H2402 ', & + 'O1D_HBRa ', 'O1D_HBRb ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'CO_OH_M ', 'HCN_OH ', & + 'HCOOH_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH_b ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', 'C2H4_CL_M ', & + 'C2H4_O3 ', 'C2H5O2_C2H5O2 ', & + 'C2H5O2_CH3O2 ', 'C2H5O2_HO2 ', & + 'C2H5O2_NO ', 'C2H5OH_OH ', & + 'C2H5OOH_OH ', 'C2H6_CL ', & + 'C2H6_OH ', 'CH3CHO_NO3 ', & + 'CH3CHO_OH ', 'CH3CN_OH ', & + 'CH3CO3_CH3CO3 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_NO ', & + 'CH3COOH_OH ', 'CH3COOOH_OH ', & + 'EO2_HO2 ', 'EO2_NO ', & + 'EO_M ', 'EO_O2 ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'PAN_OH ', 'tag_C2H4_OH ', & + 'tag_CH3CO3_NO2 ', 'usr_PAN_M ', & + 'C3H6_NO3 ', 'C3H6_O3 ', & + 'C3H7O2_CH3O2 ', 'C3H7O2_HO2 ', & + 'C3H7O2_NO ', 'C3H7OOH_OH ', & + 'C3H8_OH ', 'CH3COCHO_NO3 ', & + 'CH3COCHO_OH ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRO2_CH3CO3 ', & + 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & + 'MACRO2_NO3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACR_O3 ', & + 'MACR_OH ', 'MACROOH_OH ', & + 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & + 'MCO3_HO2 ', 'MCO3_MCO3 ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'usr_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ' /) + rxt_tag_lst( 401: 528) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_OH ', 'OCS_O ', & + 'OCS_OH ', 'S_O2 ', & + 'S_O3 ', 'SO_BRO ', & + 'SO_CLO ', 'S_OH ', & + 'SO_NO2 ', 'SO_O2 ', & + 'SO_O3 ', 'SO_OCLO ', & + 'SO_OH ', 'usr_SO2_OH ', & + 'usr_SO3_H2O ', 'DMS_NO3 ', & + 'DMS_OHa ', 'NH3_OH ', & + 'usr_DMS_OH ', 'usr_GLYOXAL_aer ', & + 'usr_HO2_aer ', 'usr_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOC_OH ', 'MTERP_NO3_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'XYLENES_OH_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'E90_tau ', 'NH_50_tau ', & + 'NH_5_tau ', 'ST80_25_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', ' ', & + ' ', ' ', ' ', ' ', & + 'jh2o2 ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', ' ', 'jmgly ', & + 'jch2o_a ', 'jno2 ', ' ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jch3ooh ', 'jpan ', ' ', 'jch2o_a ', & + 'jch2o_a ', 'jch3ooh ', 'jch3cho ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3cho ', & + 'jch3cho ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, .10_r8, 0.2_r8, .14_r8, .20_r8, & + .20_r8, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 0.28_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + .006_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .10_r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 126, 129, 130, 131, 134, & + 137, 138, 139, 140, 143, & + 144, 145, 148, 150, 154, & + 155, 163, 164 /) + cph_enthalpy(:) = (/ 189.810000_r8, 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, & + 203.400000_r8, 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, & + 67.670000_r8, 165.300000_r8, 165.510000_r8, 313.750000_r8, 133.750000_r8, & + 193.020000_r8, 34.470000_r8, 199.170000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 3, 3, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 3, 3, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 3, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, & + 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 2, 3, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 1, 2, 1, 1, 1, 1, & + 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, & + 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma/chem_mech.doc b/src/chemistry/pp_waccm_ma/chem_mech.doc new file mode 100644 index 0000000000..dddd48dc34 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/chem_mech.doc @@ -0,0 +1,714 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O1D (O) + ( 4) O2 + ( 5) O2_1S (O2) + ( 6) O2_1D (O2) + ( 7) N2O + ( 8) N + ( 9) NO + ( 10) NO2 + ( 11) NO3 + ( 12) HNO3 + ( 13) HO2NO2 + ( 14) N2O5 + ( 15) CH4 + ( 16) CH3O2 + ( 17) CH3OOH + ( 18) CH2O + ( 19) CO + ( 20) H2 + ( 21) H + ( 22) OH + ( 23) HO2 + ( 24) H2O2 + ( 25) CLY + ( 26) BRY + ( 27) SF6 + ( 28) CL (Cl) + ( 29) CL2 (Cl2) + ( 30) CLO (ClO) + ( 31) OCLO (OClO) + ( 32) CL2O2 (Cl2O2) + ( 33) HCL (HCl) + ( 34) HOCL (HOCl) + ( 35) CLONO2 (ClONO2) + ( 36) BRCL (BrCl) + ( 37) BR (Br) + ( 38) BRO (BrO) + ( 39) HBR (HBr) + ( 40) HOBR (HOBr) + ( 41) BRONO2 (BrONO2) + ( 42) CH3CL (CH3Cl) + ( 43) CH3BR (CH3Br) + ( 44) CFC11 (CFCl3) + ( 45) CFC12 (CF2Cl2) + ( 46) CFC113 (CCl2FCClF2) + ( 47) HCFC22 (CHF2Cl) + ( 48) CCL4 (CCl4) + ( 49) CH3CCL3 (CH3CCl3) + ( 50) CF3BR (CF3Br) + ( 51) CF2CLBR (CF2ClBr) + ( 52) HCFC141B (CH3CCl2F) + ( 53) HCFC142B (CH3CClF2) + ( 54) CFC114 (CClF2CClF2) + ( 55) CFC115 (CClF2CF3) + ( 56) H1202 (CBr2F2) + ( 57) H2402 (CBrF2CBrF2) + ( 58) CHBR3 (CHBr3) + ( 59) CH2BR2 (CH2Br2) + ( 60) COF2 + ( 61) COFCL (COFCl) + ( 62) HF + ( 63) F + ( 64) CO2 + ( 65) N2p (N2) + ( 66) O2p (O2) + ( 67) Np (N) + ( 68) Op (O) + ( 69) NOp (NO) + ( 70) e (E) + ( 71) N2D (N) + ( 72) Op2P (O) + ( 73) Op2D (O) + ( 74) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CH3CL + ( 4) CH3BR + ( 5) CFC11 + ( 6) CFC12 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) HCFC22 + ( 11) HCFC141B + ( 12) HCFC142B + ( 13) CCL4 + ( 14) CH3CCL3 + ( 15) CF3BR + ( 16) CF2CLBR + ( 17) H1202 + ( 18) H2402 + ( 19) CHBR3 + ( 20) CH2BR2 + ( 21) CO2 + ( 22) CLY + ( 23) BRY + ( 24) SF6 + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) H2 + ( 8) CO + ( 9) N + ( 10) NO + ( 11) NO2 + ( 12) OH + ( 13) NO3 + ( 14) HNO3 + ( 15) HO2NO2 + ( 16) N2O5 + ( 17) CH3O2 + ( 18) CH3OOH + ( 19) CH2O + ( 20) H + ( 21) HO2 + ( 22) H2O2 + ( 23) H2O + ( 24) CL + ( 25) CL2 + ( 26) CLO + ( 27) OCLO + ( 28) CL2O2 + ( 29) HCL + ( 30) HOCL + ( 31) CLONO2 + ( 32) BRCL + ( 33) BR + ( 34) BRO + ( 35) HBR + ( 36) HOBR + ( 37) BRONO2 + ( 38) N2p + ( 39) O2p + ( 40) Np + ( 41) Op + ( 42) NOp + ( 43) N2D + ( 44) e + ( 45) Op2P + ( 46) Op2D + ( 47) COF2 + ( 48) COFCL + ( 49) HF + ( 50) F + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> CL + O rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jhbr ( 34) HBR + hv -> BR + H rate = ** User defined ** ( 34) + jbrono2_a ( 35) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 35) + jbrono2_b ( 36) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 36) + jch3cl ( 37) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 37) + jccl4 ( 38) CCL4 + hv -> 4*CL rate = ** User defined ** ( 38) + jch3ccl3 ( 39) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 39) + jcfcl3 ( 40) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 40) + jcf2cl2 ( 41) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 41) + jcfc113 ( 42) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 42) + jcfc114 ( 43) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 43) + jcfc115 ( 44) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 44) + jhcfc22 ( 45) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 45) + jhcfc141b ( 46) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 46) + jhcfc142b ( 47) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 47) + jch3br ( 48) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 48) + jcf3br ( 49) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 49) + jcf2clbr ( 50) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 50) + jchbr3 ( 51) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 51) + jch2br2 ( 52) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 52) + jh1202 ( 53) H1202 + hv -> 2*BR + COF2 rate = ** User defined ** ( 53) + jh2402 ( 54) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 54) + jcof2 ( 55) COF2 + hv -> 2*F rate = ** User defined ** ( 55) + jcofcl ( 56) COFCL + hv -> F + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jco2 ( 58) CO2 + hv -> CO + O rate = ** User defined ** ( 58) + jch4_a ( 59) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 59) + jch4_b ( 60) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 60) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jsf6 ( 61) SF6 + hv -> {sink} rate = ** User defined ** ( 61) + jeuv_1 ( 62) O + hv -> Op + e rate = ** User defined ** ( 62) + jeuv_2 ( 63) O + hv -> Op2D + e rate = ** User defined ** ( 63) + jeuv_3 ( 64) O + hv -> Op2P + e rate = ** User defined ** ( 64) + jeuv_4 ( 65) N + hv -> Np + e rate = ** User defined ** ( 65) + jeuv_5 ( 66) O2 + hv -> O2p + e rate = ** User defined ** ( 66) + jeuv_6 ( 67) N2 + hv -> N2p + e rate = ** User defined ** ( 67) + jeuv_7 ( 68) O2 + hv -> O + Op + e rate = ** User defined ** ( 68) + jeuv_8 ( 69) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 69) + jeuv_9 ( 70) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 70) + jeuv_10 ( 71) N2 + hv -> N + Np + e rate = ** User defined ** ( 71) + jeuv_11 ( 72) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 72) + jeuv_12 ( 73) O2 + hv -> 2*O rate = ** User defined ** ( 73) + jeuv_13 ( 74) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 74) + jeuv_14 ( 75) O + hv -> Op + e rate = ** User defined ** ( 75) + jeuv_15 ( 76) O + hv -> Op2D + e rate = ** User defined ** ( 76) + jeuv_16 ( 77) O + hv -> Op2P + e rate = ** User defined ** ( 77) + jeuv_17 ( 78) O2 + hv -> O2p + e rate = ** User defined ** ( 78) + jeuv_18 ( 79) N2 + hv -> N2p + e rate = ** User defined ** ( 79) + jeuv_19 ( 80) O2 + hv -> O + Op + e rate = ** User defined ** ( 80) + jeuv_20 ( 81) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 81) + jeuv_21 ( 82) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 82) + jeuv_22 ( 83) N2 + hv -> N + Np + e rate = ** User defined ** ( 83) + jeuv_23 ( 84) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 84) + jeuv_24 ( 85) O2 + hv -> 2*O rate = ** User defined ** ( 85) + jeuv_25 ( 86) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 86) + jeuv_26 ( 87) CO2 + hv -> CO + O rate = ** User defined ** ( 87) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** ( 88) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 89) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** ( 90) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 ( 91) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 ( 92) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) ( 93) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) ( 94) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 ( 95) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 ( 96) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 ( 97) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) ( 98) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 ( 99) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 (100) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (101) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) (102) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) (103) + O1D_H2O ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (104) + O1D_N2Oa ( 18) O1D + N2O -> 2*NO rate = 7.25E-11*exp( 20./t) (105) + O1D_N2Ob ( 19) O1D + N2O -> N2 + O2 rate = 4.63E-11*exp( 20./t) (106) + O1D_O3 ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 (107) + O1D_CFC11 ( 21) O1D + CFC11 -> 2*CL + COFCL rate = 2.02E-10 (108) + O1D_CFC12 ( 22) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (109) + O1D_CFC113 ( 23) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 1.50E-10 (110) + O1D_CFC114 ( 24) O1D + CFC114 -> 2*CL + 2*COF2 rate = 9.75E-11 (111) + O1D_CFC115 ( 25) O1D + CFC115 -> CL + F + 2*COF2 rate = 1.50E-11 (112) + O1D_HCFC22 ( 26) O1D + HCFC22 -> CL + COF2 rate = 7.20E-11 (113) + O1D_HCFC141B ( 27) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (114) + O1D_HCFC142B ( 28) O1D + HCFC142B -> CL + COF2 rate = 1.63E-10 (115) + O1D_CCL4 ( 29) O1D + CCL4 -> 4*CL rate = 2.84E-10 (116) + O1D_CH3BR ( 30) O1D + CH3BR -> BR rate = 1.67E-10 (117) + O1D_CF2CLBR ( 31) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.60E-11 (118) + O1D_CF3BR ( 32) O1D + CF3BR -> BR + F + COF2 rate = 4.10E-11 (119) + O1D_H1202 ( 33) O1D + H1202 -> 2*BR + COF2 rate = 1.01E-10 (120) + O1D_H2402 ( 34) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (121) + O1D_CHBR3 ( 35) O1D + CHBR3 -> 3*BR rate = 4.49E-10 (122) + O1D_CH2BR2 ( 36) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (123) + O1D_COF2 ( 37) O1D + COF2 -> 2*F rate = 2.14E-11 (124) + O1D_COFCL ( 38) O1D + COFCL -> F + CL rate = 1.90E-10 (125) + O1D_CH4a ( 39) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (126) + O1D_CH4b ( 40) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (127) + O1D_CH4c ( 41) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (128) + O1D_H2 ( 42) O1D + H2 -> H + OH rate = 1.20E-10 (129) + O1D_HCL ( 43) O1D + HCL -> CL + OH rate = 1.50E-10 (130) + O1D_HBR ( 44) O1D + HBR -> BR + OH rate = 1.20E-10 (131) + H_O2 ( 45) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (132) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + H_O3 ( 46) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (133) + H_HO2a ( 47) H + HO2 -> 2*OH rate = 7.20E-11 (134) + H_HO2 ( 48) H + HO2 -> H2 + O2 rate = 6.90E-12 (135) + H_HO2b ( 49) H + HO2 -> H2O + O rate = 1.60E-12 (136) + OH_O ( 50) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (137) + OH_O3 ( 51) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (138) + OH_HO2 ( 52) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (139) + OH_OH ( 53) OH + OH -> H2O + O rate = 1.80E-12 (140) + OH_OH_M ( 54) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (141) + ki=2.60E-11 + f=0.60 + OH_H2 ( 55) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (142) + OH_H2O2 ( 56) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (143) + H2_O ( 57) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (144) + HO2_O ( 58) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (145) + HO2_O3 ( 59) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (146) + usr_HO2_HO2 ( 60) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (147) + H2O2_O ( 61) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (148) + N2D_O2 ( 62) N2D + O2 -> NO + O1D rate = 5.00E-12 (149) + N2D_O ( 63) N2D + O -> N + O rate = 7.00E-13 (150) + N_OH ( 64) N + OH -> NO + H rate = 5.00E-11 (151) + N_O2 ( 65) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (152) + N_NO ( 66) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (153) + N_NO2a ( 67) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (154) + N_NO2b ( 68) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (155) + N_NO2c ( 69) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (156) + NO_O ( 70) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (157) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 71) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (158) + NO_O3 ( 72) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (159) + NO2_O ( 73) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (160) + NO2_O_M ( 74) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (161) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO2_O3 ( 75) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (162) + tag_NO2_NO3 ( 76) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (163) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 77) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (164) + tag_NO2_OH ( 78) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (165) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 79) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (166) + NO3_NO ( 80) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (167) + NO3_O ( 81) NO3 + O -> NO2 + O2 rate = 1.00E-11 (168) + NO3_OH ( 82) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (169) + NO3_HO2 ( 83) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (170) + tag_NO2_HO2 ( 84) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (171) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + HO2NO2_OH ( 85) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (172) + usr_HO2NO2_M ( 86) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (173) + CL_O3 ( 87) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (174) + CL_H2 ( 88) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (175) + CL_H2O2 ( 89) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (176) + CL_HO2a ( 90) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (177) + CL_HO2b ( 91) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (178) + CL_CH2O ( 92) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (179) + CL_CH4 ( 93) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (180) + CLO_O ( 94) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (181) + CLO_OHa ( 95) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (182) + CLO_OHb ( 96) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (183) + CLO_HO2 ( 97) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (184) + CLO_CH3O2 ( 98) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (185) + CLO_NO ( 99) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (186) + CLO_NO2_M (100) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (187) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLO_CLOa (101) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (188) + CLO_CLOb (102) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (189) + CLO_CLOc (103) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (190) + tag_CLO_CLO_M (104) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (191) + ki=3.00E-12*(300/t)**2.00 + f=0.60 + usr_CL2O2_M (105) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (192) + HCL_OH (106) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (193) + HCL_O (107) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (194) + HOCL_O (108) HOCL + O -> CLO + OH rate = 1.70E-13 (195) + HOCL_CL (109) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (196) + HOCL_OH (110) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (197) + CLONO2_O (111) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (198) + CLONO2_OH (112) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (199) + CLONO2_CL (113) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (200) + BR_O3 (114) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (201) + BR_HO2 (115) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (202) + BR_CH2O (116) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (203) + BRO_O (117) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (204) + BRO_OH (118) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (205) + BRO_HO2 (119) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (206) + BRO_NO (120) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (207) + BRO_NO2_M (121) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (208) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRO_CLOa (122) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (209) + BRO_CLOb (123) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (210) + BRO_CLOc (124) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (211) + BRO_BRO (125) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (212) + HBR_OH (126) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (213) + HBR_O (127) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (214) + HOBR_O (128) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (215) + BRONO2_O (129) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (216) + F_H2O (130) F + H2O -> HF + OH rate = 1.40E-11 (217) + F_H2 (131) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (218) + F_CH4 (132) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (219) + F_HNO3 (133) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (220) + CH3CL_CL (134) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (221) + CH3CL_OH (135) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (222) + CH3CCL3_OH (136) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (223) + HCFC22_OH (137) HCFC22 + OH -> H2O + CL + COF2 rate = 1.05E-12*exp( -1600./t) (224) + CH3BR_OH (138) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (225) + CH3BR_CL (139) CH3BR + CL -> HCL + HO2 + BR rate = 1.40E-11*exp( -1030./t) (226) + HCFC141B_OH (140) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (227) + HCFC142B_OH (141) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (228) + CH2BR2_OH (142) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (229) + CHBR3_OH (143) CHBR3 + OH -> 3*BR rate = 1.35E-12*exp( -600./t) (230) + CH2BR2_CL (144) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (231) + CHBR3_CL (145) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (232) + CH4_OH (146) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (233) + usr_CO_OH_b (147) CO + OH -> CO2 + H rate = ** User defined ** (234) + CO_OH_M (148) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (235) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + CH2O_NO3 (149) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (236) + CH2O_OH (150) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (237) + CH2O_O (151) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (238) + CH3O2_NO (152) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (239) + CH3O2_HO2 (153) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (240) + CH3OOH_OH (154) CH3OOH + OH -> CH3O2 + H2O rate = 3.80E-12*exp( 200./t) (241) + usr_N2O5_aer (155) N2O5 -> 2*HNO3 rate = ** User defined ** (242) + usr_NO3_aer (156) NO3 -> HNO3 rate = ** User defined ** (243) + usr_NO2_aer (157) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (244) + usr_HO2_aer (158) HO2 -> 0.5*H2O2 rate = ** User defined ** (245) + het1 (159) N2O5 -> 2*HNO3 rate = ** User defined ** (246) + het2 (160) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (247) + het3 (161) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (248) + het4 (162) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (249) + het5 (163) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (250) + het6 (164) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (251) + het7 (165) N2O5 -> 2*HNO3 rate = ** User defined ** (252) + het8 (166) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (253) + het9 (167) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (254) + het10 (168) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (255) + het11 (169) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (256) + het12 (170) N2O5 -> 2*HNO3 rate = ** User defined ** (257) + het13 (171) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (258) + het14 (172) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (259) + het15 (173) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (260) + het16 (174) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (261) + het17 (175) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (262) + ion_Op_O2 (176) Op + O2 -> O2p + O rate = ** User defined ** (263) + ion_Op_N2 (177) Op + N2 -> NOp + N rate = ** User defined ** (264) + ion_N2p_Oa (178) N2p + O -> NOp + N2D rate = ** User defined ** (265) + ion_N2p_Ob (179) N2p + O -> Op + N2 rate = ** User defined ** (266) + ion_Op_CO2 (180) Op + CO2 -> O2p + CO rate = 9.00E-10 (267) + ion_O2p_N (181) O2p + N -> NOp + O rate = 1.00E-10 (268) + ion_O2p_NO (182) O2p + NO -> NOp + O2 rate = 4.40E-10 (269) + ion_Np_O2a (183) Np + O2 -> O2p + N rate = 4.00E-10 (270) + ion_Np_O2b (184) Np + O2 -> NOp + O rate = 2.00E-10 (271) + ion_Np_O (185) Np + O -> Op + N rate = 1.00E-12 (272) + ion_N2p_O2 (186) N2p + O2 -> O2p + N2 rate = 6.00E-11 (273) + ion_O2p_N2 (187) O2p + N2 -> NOp + NO rate = 5.00E-16 (274) + elec1 (188) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (275) + elec2 (189) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (276) + elec3 (190) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (277) + Op2P_N2a (191) Op2P + N2 -> N2p + O rate = 4.80E-10 (278) + Op2P_N2b (192) Op2P + N2 -> Np + NO rate = 1.00E-10 (279) + Op2P_O (193) Op2P + O -> Op + O rate = 4.00E-10 (280) + Op2P_ea (194) Op2P + e -> Op2D + e rate = ** User defined ** (281) + Op2P_eb (195) Op2P + e -> Op + e rate = ** User defined ** (282) + Op2D_O (196) Op2D + O -> Op + O rate = 5.00E-12 (283) + Op2D_O2 (197) Op2D + O2 -> O2p + O rate = 7.00E-10 (284) + Op2D_N2 (198) Op2D + N2 -> N2p + O rate = 8.00E-10 (285) + Op2D_e (199) Op2D + e -> Op + e rate = ** User defined ** (286) + ag247nm (200) Op2P -> Op rate = 4.70E-02 (287) + ag732nm (201) Op2P -> Op2D rate = 1.71E-01 (288) + ag373nm (202) Op2D -> Op rate = 7.70E-05 (289) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) Op + ( 5) O2p + ( 6) Np + ( 7) N2p + ( 8) N2D + ( 9) N + (10) e + (11) OH + + + Equation Report + + d(O3)/dt = r1*M*O*O2 + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r46*H*O3 - r51*OH*O3 - r59*HO2*O3 - r72*NO*O3 + - r75*NO2*O3 - r87*CL*O3 - r114*BR*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j58*CO2 + .18*j60*CH4 + j68*O2 + j69*O2 + j70*O2 + 2*j73*O2 + j80*O2 + j81*O2 + + j82*O2 + 2*j85*O2 + j87*CO2 + r14*N2*O1D + r191*N2*Op2P + r198*N2*Op2D + r15*O1D*O2 + + r16*O1D*O2 + r49*H*HO2 + r53*OH*OH + r65*N*O2 + r66*N*NO + r67*N*NO2 + r176*Op*O2 + r181*O2p*N + + r184*Np*O2 + r188*NOp*e + 1.15*r189*O2p*e + r197*Op2D*O2 + - j62*O - j63*O - j64*O - j75*O - j76*O - j77*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O - r50*OH*O + - r57*H2*O - r58*HO2*O - r61*H2O2*O - r70*M*NO*O - r73*NO2*O - r74*M*NO2*O - r81*NO3*O + - r94*CLO*O - r107*HCL*O - r108*HOCL*O - r111*CLONO2*O - r117*BRO*O - r127*HBR*O - r128*HOBR*O + - r129*BRONO2*O - r151*CH2O*O - r178*N2p*O - r179*N2p*O - r185*Np*O + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r62*N2D*O2 + .85*r189*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*CFC114*O1D - r25*CFC115*O1D + - r26*HCFC22*O1D - r27*HCFC141B*O1D - r28*HCFC142B*O1D - r29*CCL4*O1D - r30*CH3BR*O1D + - r31*CF2CLBR*O1D - r32*CF3BR*O1D - r33*H1202*O1D - r34*H2402*O1D - r35*CHBR3*O1D + - r36*CH2BR2*O1D - r37*COF2*O1D - r38*COFCL*O1D - r39*CH4*O1D - r40*CH4*O1D - r41*CH4*O1D + - r42*H2*O1D - r43*HCL*O1D - r44*HBR*O1D + d(O2)/dt = j4*O3 + j13*NO3 + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + r20*O1D*O3 + r46*H*O3 + r48*H*HO2 + r50*OH*O + + r51*OH*O3 + r52*OH*HO2 + r58*HO2*O + 2*r59*HO2*O3 + r60*HO2*HO2 + r69*N*NO2 + r72*NO*O3 + + r73*NO2*O + r75*NO2*O3 + r81*NO3*O + r83*NO3*HO2 + r85*HO2NO2*OH + r87*CL*O3 + r90*CL*HO2 + + r94*CLO*O + r96*CLO*OH + r97*CLO*HO2 + r101*CLO*CLO + r102*CLO*CLO + r114*BR*O3 + r115*BR*HO2 + + r117*BRO*O + r119*BRO*HO2 + r123*BRO*CLO + r124*BRO*CLO + r125*BRO*BRO + r153*CH3O2*HO2 + + r182*O2p*NO + - j1*O2 - j2*O2 - j66*O2 - j68*O2 - j69*O2 - j70*O2 - j73*O2 - j78*O2 - j80*O2 - j81*O2 + - j82*O2 - j85*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r45*M*H*O2 - r62*N2D*O2 - r65*N*O2 + - r176*Op*O2 - r183*Np*O2 - r184*Np*O2 - r186*N2p*O2 - r197*Op2D*O2 + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(N2O)/dt = r67*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j71*N2 + .8*j74*N2 + j83*N2 + .8*j86*N2 + j6*NO + r177*N2*Op + r63*N2D*O + r183*Np*O2 + + r185*Np*O + .2*r188*NOp*e + 1.1*r190*N2p*e + - j65*N - r64*OH*N - r65*O2*N - r66*NO*N - r67*NO2*N - r68*NO2*N - r69*NO2*N - r181*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + .5*r157*NO2 + r187*N2*O2p + r192*N2*Op2P + 2*r18*O1D*N2O + + r62*N2D*O2 + r64*N*OH + r65*N*O2 + 2*r68*N*NO2 + r73*NO2*O + - j6*NO - j7*NO - r66*N*NO - r70*M*O*NO - r71*HO2*NO - r72*O3*NO - r80*NO3*NO - r99*CLO*NO + - r120*BRO*NO - r152*CH3O2*NO - r182*O2p*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j36*BRONO2 + r77*M*N2O5 + r86*M*HO2NO2 + + r70*M*NO*O + r71*NO*HO2 + r72*NO*O3 + 2*r80*NO3*NO + r81*NO3*O + r82*NO3*OH + r83*NO3*HO2 + + r85*HO2NO2*OH + r99*CLO*NO + r120*BRO*NO + r152*CH3O2*NO + - j8*NO2 - r157*NO2 - r67*N*NO2 - r68*N*NO2 - r69*N*NO2 - r73*O*NO2 - r74*M*O*NO2 - r75*O3*NO2 + - r76*M*NO3*NO2 - r78*M*OH*NO2 - r84*M*HO2*NO2 - r100*M*CLO*NO2 - r121*M*BRO*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j35*BRONO2 + r77*M*N2O5 + r74*M*NO2*O + + r75*NO2*O3 + r79*HNO3*OH + r111*CLONO2*O + r112*CLONO2*OH + r113*CLONO2*CL + r129*BRONO2*O + + r133*F*HNO3 + - j12*NO3 - j13*NO3 - r156*NO3 - r76*M*NO2*NO3 - r80*NO*NO3 - r81*O*NO3 - r82*OH*NO3 + - r83*HO2*NO3 - r149*CH2O*NO3 + d(HNO3)/dt = 2*r155*N2O5 + r156*NO3 + .5*r157*NO2 + 2*r159*N2O5 + r160*CLONO2 + r161*BRONO2 + 2*r165*N2O5 + + r166*CLONO2 + r169*BRONO2 + 2*r170*N2O5 + r171*CLONO2 + r172*BRONO2 + r78*M*NO2*OH + + r149*CH2O*NO3 + r162*CLONO2*HCL + r167*CLONO2*HCL + r173*CLONO2*HCL + - j11*HNO3 - r79*OH*HNO3 - r133*F*HNO3 + d(HO2NO2)/dt = r84*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r86*M*HO2NO2 - r85*OH*HO2NO2 + d(N2O5)/dt = r76*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r77*M*N2O5 - r155*N2O5 - r159*N2O5 - r165*N2O5 - r170*N2O5 + d(CH4)/dt = - j59*CH4 - j60*CH4 - r39*O1D*CH4 - r40*O1D*CH4 - r41*O1D*CH4 - r93*CL*CH4 - r132*F*CH4 + - r146*OH*CH4 + d(CH3O2)/dt = j37*CH3CL + j48*CH3BR + j59*CH4 + r39*O1D*CH4 + r93*CL*CH4 + r132*F*CH4 + r146*CH4*OH + + r154*CH3OOH*OH + - r98*CLO*CH3O2 - r152*NO*CH3O2 - r153*HO2*CH3O2 + d(CH3OOH)/dt = r153*CH3O2*HO2 + - j16*CH3OOH - r154*OH*CH3OOH + d(CH2O)/dt = j16*CH3OOH + .18*j60*CH4 + r40*O1D*CH4 + r41*O1D*CH4 + r98*CLO*CH3O2 + r152*CH3O2*NO + - j17*CH2O - j18*CH2O - r92*CL*CH2O - r116*BR*CH2O - r149*NO3*CH2O - r150*OH*CH2O + - r151*O*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j58*CO2 + .38*j60*CH4 + j87*CO2 + r92*CL*CH2O + r116*BR*CH2O + + r134*CH3CL*CL + r149*CH2O*NO3 + r150*CH2O*OH + r151*CH2O*O + r180*Op*CO2 + - r147*OH*CO - r148*M*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j60*CH4 + r41*O1D*CH4 + r48*H*HO2 + - r42*O1D*H2 - r55*OH*H2 - r57*O*H2 - r88*CL*H2 - r131*F*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j34*HBR + j57*HF + j59*CH4 + + .33*j60*CH4 + r40*O1D*CH4 + r42*O1D*H2 + r50*OH*O + r55*OH*H2 + r57*H2*O + r64*N*OH + + r88*CL*H2 + r131*F*H2 + r147*CO*OH + r150*CH2O*OH + - r45*M*O2*H - r46*O3*H - r47*HO2*H - r48*HO2*H - r49*HO2*H + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .33*j60*CH4 + + .5*r157*NO2 + 2*r17*O1D*H2O + r39*O1D*CH4 + r42*O1D*H2 + r43*O1D*HCL + r44*O1D*HBR + r46*H*O3 + + 2*r47*H*HO2 + r57*H2*O + r58*HO2*O + r59*HO2*O3 + r61*H2O2*O + r71*NO*HO2 + r83*NO3*HO2 + + r91*CL*HO2 + r107*HCL*O + r108*HOCL*O + r127*HBR*O + r128*HOBR*O + r130*F*H2O + r151*CH2O*O + - r50*O*OH - r51*O3*OH - r52*HO2*OH - 2*r53*OH*OH - 2*r54*M*OH*OH - r55*H2*OH - r56*H2O2*OH + - r64*N*OH - r78*M*NO2*OH - r79*HNO3*OH - r82*NO3*OH - r85*HO2NO2*OH - r95*CLO*OH - r96*CLO*OH + - r106*HCL*OH - r110*HOCL*OH - r112*CLONO2*OH - r118*BRO*OH - r126*HBR*OH - r135*CH3CL*OH + - r136*CH3CCL3*OH - r137*HCFC22*OH - r138*CH3BR*OH - r140*HCFC141B*OH - r141*HCFC142B*OH + - r142*CH2BR2*OH - r143*CHBR3*OH - r146*CH4*OH - r147*CO*OH - r148*M*CO*OH - r150*CH2O*OH + - r154*CH3OOH*OH + d(HO2)/dt = j15*HO2NO2 + r86*M*HO2NO2 + r40*O1D*CH4 + r45*M*H*O2 + r51*OH*O3 + r56*OH*H2O2 + r61*H2O2*O + + r82*NO3*OH + r89*CL*H2O2 + r92*CL*CH2O + r95*CLO*OH + r98*CLO*CH3O2 + r116*BR*CH2O + + r118*BRO*OH + r134*CH3CL*CL + r135*CH3CL*OH + r138*CH3BR*OH + r139*CH3BR*CL + r148*M*CO*OH + + r149*CH2O*NO3 + r151*CH2O*O + r152*CH3O2*NO + - r158*HO2 - r47*H*HO2 - r48*H*HO2 - r49*H*HO2 - r52*OH*HO2 - r58*O*HO2 - r59*O3*HO2 + - 2*r60*HO2*HO2 - r71*NO*HO2 - r83*NO3*HO2 - r84*M*NO2*HO2 - r90*CL*HO2 - r91*CL*HO2 + - r97*CLO*HO2 - r115*BR*HO2 - r119*BRO*HO2 - r153*CH3O2*HO2 + d(H2O2)/dt = .5*r158*HO2 + r54*M*OH*OH + r60*HO2*HO2 + - j22*H2O2 - r56*OH*H2O2 - r61*O*H2O2 - r89*CL*H2O2 + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(SF6)/dt = - j61*SF6 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j37*CH3CL + + 4*j38*CCL4 + 3*j39*CH3CCL3 + 2*j40*CFC11 + 2*j41*CFC12 + 2*j42*CFC113 + 2*j43*CFC114 + + j44*CFC115 + j45*HCFC22 + j46*HCFC141B + j47*HCFC142B + j50*CF2CLBR + j56*COFCL + + 2*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 2*r23*O1D*CFC113 + 2*r24*O1D*CFC114 + r25*O1D*CFC115 + + r26*O1D*HCFC22 + r27*O1D*HCFC141B + r28*O1D*HCFC142B + 4*r29*O1D*CCL4 + r31*O1D*CF2CLBR + + r38*O1D*COFCL + r43*O1D*HCL + r94*CLO*O + r95*CLO*OH + r98*CLO*CH3O2 + r99*CLO*NO + + 2*r101*CLO*CLO + r103*CLO*CLO + r106*HCL*OH + r107*HCL*O + r123*BRO*CLO + r135*CH3CL*OH + + 3*r136*CH3CCL3*OH + r137*HCFC22*OH + r140*HCFC141B*OH + r141*HCFC142B*OH + - r87*O3*CL - r88*H2*CL - r89*H2O2*CL - r90*HO2*CL - r91*HO2*CL - r92*CH2O*CL - r93*CH4*CL + - r109*HOCL*CL - r113*CLONO2*CL - r134*CH3CL*CL - r139*CH3BR*CL - r144*CH2BR2*CL - r145*CHBR3*CL + d(CL2)/dt = r102*CLO*CLO + r113*CLONO2*CL + r162*CLONO2*HCL + r163*HOCL*HCL + r167*CLONO2*HCL + r168*HOCL*HCL + + r173*CLONO2*HCL + r174*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r105*M*CL2O2 + r105*M*CL2O2 + r87*CL*O3 + r91*CL*HO2 + r108*HOCL*O + + r109*HOCL*CL + r110*HOCL*OH + r111*CLONO2*O + - j24*CLO - r94*O*CLO - r95*OH*CLO - r96*OH*CLO - r97*HO2*CLO - r98*CH3O2*CLO - r99*NO*CLO + - r100*M*NO2*CLO - 2*r101*CLO*CLO - 2*r102*CLO*CLO - 2*r103*CLO*CLO - 2*r104*M*CLO*CLO + - r122*BRO*CLO - r123*BRO*CLO - r124*BRO*CLO + d(OCLO)/dt = r103*CLO*CLO + r122*BRO*CLO + - j25*OCLO + d(CL2O2)/dt = r104*M*CLO*CLO + - j26*CL2O2 - r105*M*CL2O2 + d(HCL)/dt = r88*CL*H2 + r89*CL*H2O2 + r90*CL*HO2 + r92*CL*CH2O + r93*CL*CH4 + r96*CLO*OH + r109*HOCL*CL + + 2*r134*CH3CL*CL + r139*CH3BR*CL + r144*CH2BR2*CL + r145*CHBR3*CL + - j28*HCL - r43*O1D*HCL - r106*OH*HCL - r107*O*HCL - r162*CLONO2*HCL - r163*HOCL*HCL + - r164*HOBR*HCL - r167*CLONO2*HCL - r168*HOCL*HCL - r173*CLONO2*HCL - r174*HOCL*HCL + - r175*HOBR*HCL + d(HOCL)/dt = r160*CLONO2 + r166*CLONO2 + r171*CLONO2 + r97*CLO*HO2 + r112*CLONO2*OH + - j27*HOCL - r108*O*HOCL - r109*CL*HOCL - r110*OH*HOCL - r163*HCL*HOCL - r168*HCL*HOCL + - r174*HCL*HOCL + d(CLONO2)/dt = r100*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r160*CLONO2 - r166*CLONO2 - r171*CLONO2 - r111*O*CLONO2 + - r112*OH*CLONO2 - r113*CL*CLONO2 - r162*HCL*CLONO2 - r167*HCL*CLONO2 - r173*HCL*CLONO2 + d(BRCL)/dt = r124*BRO*CLO + r164*HOBR*HCL + r175*HOBR*HCL + - j31*BRCL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*HBR + j35*BRONO2 + j48*CH3BR + j49*CF3BR + j50*CF2CLBR + + 3*j51*CHBR3 + 2*j52*CH2BR2 + 2*j53*H1202 + 2*j54*H2402 + r30*O1D*CH3BR + r31*O1D*CF2CLBR + + r32*O1D*CF3BR + 2*r33*O1D*H1202 + 2*r34*O1D*H2402 + 3*r35*O1D*CHBR3 + 2*r36*O1D*CH2BR2 + + r44*O1D*HBR + r117*BRO*O + r118*BRO*OH + r120*BRO*NO + r122*BRO*CLO + r123*BRO*CLO + + 2*r125*BRO*BRO + r126*HBR*OH + r127*HBR*O + r138*CH3BR*OH + r139*CH3BR*CL + 2*r142*CH2BR2*OH + + 3*r143*CHBR3*OH + 2*r144*CH2BR2*CL + 3*r145*CHBR3*CL + - r114*O3*BR - r115*HO2*BR - r116*CH2O*BR + d(BRO)/dt = j36*BRONO2 + r114*BR*O3 + r128*HOBR*O + r129*BRONO2*O + - j32*BRO - r117*O*BRO - r118*OH*BRO - r119*HO2*BRO - r120*NO*BRO - r121*M*NO2*BRO + - r122*CLO*BRO - r123*CLO*BRO - r124*CLO*BRO - 2*r125*BRO*BRO + d(HBR)/dt = r115*BR*HO2 + r116*BR*CH2O + - j34*HBR - r44*O1D*HBR - r126*OH*HBR - r127*O*HBR + d(HOBR)/dt = r161*BRONO2 + r169*BRONO2 + r172*BRONO2 + r119*BRO*HO2 + - j33*HOBR - r128*O*HOBR - r164*HCL*HOBR - r175*HCL*HOBR + d(BRONO2)/dt = r121*M*BRO*NO2 + - j35*BRONO2 - j36*BRONO2 - r161*BRONO2 - r169*BRONO2 - r172*BRONO2 - r129*O*BRONO2 + d(CH3CL)/dt = - j37*CH3CL - r134*CL*CH3CL - r135*OH*CH3CL + d(CH3BR)/dt = - j48*CH3BR - r30*O1D*CH3BR - r138*OH*CH3BR - r139*CL*CH3BR + d(CFC11)/dt = - j40*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j41*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j42*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j45*HCFC22 - r26*O1D*HCFC22 - r137*OH*HCFC22 + d(CCL4)/dt = - j38*CCL4 - r29*O1D*CCL4 + d(CH3CCL3)/dt = - j39*CH3CCL3 - r136*OH*CH3CCL3 + d(CF3BR)/dt = - j49*CF3BR - r32*O1D*CF3BR + d(CF2CLBR)/dt = - j50*CF2CLBR - r31*O1D*CF2CLBR + d(HCFC141B)/dt = - j46*HCFC141B - r27*O1D*HCFC141B - r140*OH*HCFC141B + d(HCFC142B)/dt = - j47*HCFC142B - r28*O1D*HCFC142B - r141*OH*HCFC142B + d(CFC114)/dt = - j43*CFC114 - r24*O1D*CFC114 + d(CFC115)/dt = - j44*CFC115 - r25*O1D*CFC115 + d(H1202)/dt = - j53*H1202 - r33*O1D*H1202 + d(H2402)/dt = - j54*H2402 - r34*O1D*H2402 + d(CHBR3)/dt = - j51*CHBR3 - r35*O1D*CHBR3 - r143*OH*CHBR3 - r145*CL*CHBR3 + d(CH2BR2)/dt = - j52*CH2BR2 - r36*O1D*CH2BR2 - r142*OH*CH2BR2 - r144*CL*CH2BR2 + d(COF2)/dt = j41*CFC12 + j42*CFC113 + 2*j43*CFC114 + 2*j44*CFC115 + j45*HCFC22 + j47*HCFC142B + j49*CF3BR + + j50*CF2CLBR + j53*H1202 + 2*j54*H2402 + r22*O1D*CFC12 + r23*O1D*CFC113 + 2*r24*O1D*CFC114 + + 2*r25*O1D*CFC115 + r26*O1D*HCFC22 + r28*O1D*HCFC142B + r31*O1D*CF2CLBR + r32*O1D*CF3BR + + r33*O1D*H1202 + 2*r34*O1D*H2402 + r137*HCFC22*OH + r141*HCFC142B*OH + - j55*COF2 - r37*O1D*COF2 + d(COFCL)/dt = j40*CFC11 + j42*CFC113 + j46*HCFC141B + r21*O1D*CFC11 + r23*O1D*CFC113 + r27*O1D*HCFC141B + + r140*HCFC141B*OH + - j56*COFCL - r38*O1D*COFCL + d(HF)/dt = r130*F*H2O + r131*F*H2 + r132*F*CH4 + r133*F*HNO3 + - j57*HF + d(F)/dt = j44*CFC115 + j49*CF3BR + 2*j55*COF2 + j56*COFCL + j57*HF + r25*O1D*CFC115 + r32*O1D*CF3BR + + 2*r37*O1D*COF2 + r38*O1D*COFCL + - r130*H2O*F - r131*H2*F - r132*CH4*F - r133*HNO3*F + d(CO2)/dt = .44*j60*CH4 + r147*CO*OH + r148*M*CO*OH + - j58*CO2 - j87*CO2 - r180*Op*CO2 + d(N2p)/dt = j67*N2 + j79*N2 + r191*N2*Op2P + r198*N2*Op2D + - r178*O*N2p - r179*O*N2p - r186*O2*N2p - r190*e*N2p + d(O2p)/dt = j66*O2 + j78*O2 + r176*Op*O2 + r180*Op*CO2 + r183*Np*O2 + r186*N2p*O2 + r197*Op2D*O2 + - r187*N2*O2p - r181*N*O2p - r182*NO*O2p - r189*e*O2p + d(Np)/dt = j71*N2 + j72*N2 + j83*N2 + j84*N2 + j65*N + r192*N2*Op2P + - r183*O2*Np - r184*O2*Np - r185*O*Np + d(Op)/dt = j62*O + j68*O2 + j75*O + j80*O2 + r200*Op2P + r202*Op2D + r179*N2p*O + r185*Np*O + r193*Op2P*O + + r195*Op2P*e + r196*Op2D*O + r199*Op2D*e + - r177*N2*Op - r176*O2*Op - r180*CO2*Op + d(NOp)/dt = j7*NO + r177*N2*Op + r187*N2*O2p + r178*N2p*O + r181*O2p*N + r182*O2p*NO + r184*Np*O2 + - r188*e*NOp + d(e)/dt = j67*N2 + j71*N2 + j72*N2 + j79*N2 + j83*N2 + j84*N2 + j7*NO + j62*O + j63*O + j64*O + j65*N + + j66*O2 + j68*O2 + j69*O2 + j70*O2 + j75*O + j76*O + j77*O + j78*O2 + j80*O2 + j81*O2 + + j82*O2 + - r188*NOp*e - r189*O2p*e - r190*N2p*e + d(N2D)/dt = j72*N2 + 1.2*j74*N2 + j84*N2 + 1.2*j86*N2 + r178*N2p*O + .8*r188*NOp*e + .9*r190*N2p*e + - r62*O2*N2D - r63*O*N2D + d(Op2P)/dt = j64*O + j70*O2 + j77*O + j82*O2 + - r191*N2*Op2P - r192*N2*Op2P - r200*Op2P - r201*Op2P - r193*O*Op2P - r194*e*Op2P + - r195*e*Op2P + d(Op2D)/dt = j63*O + j69*O2 + j76*O + j81*O2 + r201*Op2P + r194*Op2P*e + - r198*N2*Op2D - r202*Op2D - r196*O*Op2D - r197*O2*Op2D - r199*e*Op2D + d(H2O)/dt = .05*j60*CH4 + r49*H*HO2 + r52*OH*HO2 + r53*OH*OH + r55*OH*H2 + r56*OH*H2O2 + r79*HNO3*OH + + r85*HO2NO2*OH + r106*HCL*OH + r110*HOCL*OH + r126*HBR*OH + r135*CH3CL*OH + r136*CH3CCL3*OH + + r137*HCFC22*OH + r138*CH3BR*OH + r142*CH2BR2*OH + r146*CH4*OH + r150*CH2O*OH + r154*CH3OOH*OH + + r163*HOCL*HCL + r164*HOBR*HCL + r168*HOCL*HCL + r174*HOCL*HCL + r175*HOBR*HCL + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r130*F*H2O diff --git a/src/chemistry/pp_waccm_ma/chem_mech.in b/src/chemistry/pp_waccm_ma/chem_mech.in new file mode 100644 index 0000000000..1bfbca2bd8 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/chem_mech.in @@ -0,0 +1,438 @@ + SPECIES + + Solution + O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH2O, CO + H2, H, OH, HO2, H2O2 + CLY, BRY + SF6 + CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3 + CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl + CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 + CFC114 -> CClF2CClF2, CFC115 -> CClF2CF3, H1202 -> CBr2F2 + H2402 ->CBrF2CBrF2, CHBR3 -> CHBr3, CH2BR2 -> CH2Br2 + COF2, COFCL -> COFCl, HF, F + CO2, N2p -> N2, O2p -> O2 + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N, Op2P -> O, Op2D -> O + H2O + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + CL, BR, OH, HO2, + Op, O2p, NOp, Np, N2p, e, O2_1S, O2_1D, N2D, O1D, Op2P, Op2D + End Not-Transported + + END Species + + Solution classes + Explicit + CH4, N2O, CH3CL, CH3BR, CFC11, CFC12, CFC113 + CFC114, CFC115, HCFC22, HCFC141B, HCFC142B, CCL4 + CH3CCL3, CF3BR, CF2CLBR, H1202, H2402, CHBR3, CH2BR2 + CO2, CLY, BRY, SF6 + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D, H2, CO + N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e + Op2P, Op2D + COF2, COFCL, HF, F + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> CL + O + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jhbr] HBR + hv -> BR + H + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 2*CL + COFCL + [jcf2cl2] CFC12 + hv -> 2*CL + COF2 + [jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 + [jcfc114] CFC114 + hv -> 2*CL + 2*COF2 + [jcfc115] CFC115 + hv -> CL + F + 2*COF2 + [jhcfc22] HCFC22 + hv -> CL + COF2 + [jhcfc141b] HCFC141B + hv -> CL + COFCL + [jhcfc142b] HCFC142B + hv -> CL + COF2 + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + F + COF2 + [jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 + [jchbr3] CHBR3 + hv -> 3*BR + [jch2br2] CH2BR2 + hv -> 2*BR + [jh1202] H1202 + hv -> 2*BR + COF2 + [jh2402] H2402 + hv -> 2*BR + 2*COF2 + [jcof2] COF2 + hv -> 2*F + [jcofcl] COFCL + hv -> F + CL + [jhf] HF + hv -> H + F + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O + [jsf6] SF6 + hv -> sink + +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op2D + e + [jeuv_3=userdefined,userdefined] O + hv -> Op2P + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op2D + e + [jeuv_16=userdefined,userdefined] O + hv -> Op2P + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 + +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.91] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + [O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60. + [O1D_N2Oa] O1D + N2O -> 2*NO ; 7.25e-11, 20. + [O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.63e-11, 20. + [O1D_O3] O1D + O3 -> O2 + O2 ; 1.20e-10 + [O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.02e-10 + [O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 + [O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 1.50e-10 + [O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 9.75e-11 + [O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 1.50e-11 + [O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.20e-11 + [O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 + [O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.628e-10 + [O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.84e-10 + [O1D_CH3BR] O1D + CH3BR -> BR ; 1.674e-10 + [O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.60e-11 + [O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.10e-11 + [O1D_H1202] O1D + H1202 -> 2*BR + COF2 ; 1.012e-10 + [O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.20e-10 + [O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.49e-10 + [O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 + [O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 + [O1D_COFCL] O1D + COFCL -> F + CL ; 1.90e-10 + [O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 + [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.50e-11 + [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9.00e-12 + [O1D_H2] O1D + H2 -> H + OH ; 1.20e-10 + [O1D_HCL] O1D + HCL -> CL + OH ; 1.50e-10 + [O1D_HBR] O1D + HBR -> BR + OH ; 1.20e-10 + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 7.5e-11, -0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [H_HO2a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [H_HO2b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 1.80e-11, 180. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + [OH_OH] OH + OH -> H2O + O ; 1.80e-12 + [OH_OH_M] OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6 + [OH_H2] OH + H2 -> H2O + H ; 2.80e-12, -1800. + [OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [H2_O] H2 + O -> OH + H ; 1.60e-11, -4570. + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_OH] N + OH -> NO + H ; 5.00e-11 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + [N_NO2a] N + NO2 -> N2O + O ; 2.90e-12, 220. + [N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220. + [N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220. + [NO_O] NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.30e-12, 270. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.10e-12, 210. + [NO2_O_M] NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + [NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + [NO3_NO] NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + [NO3_O] NO3 + O -> NO2 + O2 ; 1.00e-11 + [NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.20e-11 + [NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + [HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + [CL_O3] CL + O3 -> CLO + O2 ; 2.30e-11, -200. + [CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270. + [CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + [CL_HO2a] CL + HO2 -> HCL + O2 ; 1.40e-11, 270. + [CL_HO2b] CL + HO2 -> OH + CLO ; 3.60e-11, -375. + [CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + [CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + [CLO_O] CLO + O -> CL + O2 ; 2.80e-11, 85. + [CLO_OHa] CLO + OH -> CL + HO2 ; 7.40e-12, 270. + [CLO_OHb] CLO + OH -> HCL + O2 ; 6.00e-13, 230. + [CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.60e-12, 290. + [CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115. + [CLO_NO] CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + [CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + [CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + [CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + [CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 3.0e-12, 2.0, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + [HCL_OH] HCL + OH -> H2O + CL ; 1.80e-12, -250. + [HCL_O] HCL + O -> CL + OH ; 1.00e-11, -3300. + [HOCL_O] HOCL + O -> CLO + OH ; 1.70e-13 + [HOCL_CL] HOCL + CL -> HCL + CLO ; 3.40e-12, -130. + [HOCL_OH] HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + [CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.60e-12, -840. + [CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + [CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + [BR_O3] BR + O3 -> BRO + O2 ; 1.60e-11, -780. + [BR_HO2] BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + [BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + [BRO_O] BRO + O -> BR + O2 ; 1.90e-11, 230. + [BRO_OH] BRO + OH -> BR + HO2 ; 1.70e-11, 250. + [BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + [BRO_NO] BRO + NO -> BR + NO2 ; 8.80e-12, 260. + [BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + [BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + [BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + [BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + [BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + [HBR_OH] HBR + OH -> BR + H2O ; 5.50e-12, 200. + [HBR_O] HBR + O -> BR + OH ; 5.80e-12, -1500. + [HOBR_O] HOBR + O -> BRO + OH ; 1.20e-10, -430. + [BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Odd Flourine Reactions +* -------------------------------------------------------------- + [F_H2O] F + H2O -> HF + OH ; 1.40e-11, 0. + [F_H2] F + H2 -> HF + H ; 1.40e-10, -500. + [F_CH4] F + CH4 -> HF + CH3O2 ; 1.60e-10, -260. + [F_HNO3] F + HNO3 -> HF + NO3 ; 6.00e-12, 400. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + [CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + [CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + [CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + [HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 1.05e-12, -1600. + [CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + [CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.40e-11, -1030. + [HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600. + [HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.30e-12, -1770. + [CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2.00e-12, -840. + [CHBR3_OH] CHBR3 + OH -> 3*BR ; 1.35e-12, -600. + [CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.30e-12, -800. + [CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850. + +* -------------------------------------------------------------- +* C-1 Degradation (Methane, CO, CH2O and derivatives) +* -------------------------------------------------------------- + [CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + [usr_CO_OH_b] CO + OH -> CO2 + H + [CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058. + [CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + [CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + [CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + [CH3OOH_OH] CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200. + + +* -------------------------------------------------------------- +* Tropospheric Heterogeneous Reactions +* -------------------------------------------------------------- + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + [usr_HO2_aer] HO2 -> 0.5*H2O2 + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 + +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + [ion_N2p_Ob] N2p + O -> Op + N2 + [ion_Op_CO2] Op + CO2 -> O2p + CO ; 9.0e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + [ion_O2p_N2] O2p + N2 -> NOp + NO ; 5.0e-16 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + [Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 + [Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1.0e-10 + [Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4.0e-10 + [Op2P_ea,cph=163.06] Op2P + e -> Op2D + e + [Op2P_eb,cph=482.43] Op2P + e -> Op + e + [Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5.0e-12 + [Op2D_O2,cph=469.40] Op2D + O2 -> O2p + O ; 7.0e-10 + [Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8.0e-10 + [Op2D_e,cph=319.37] Op2D + e -> Op + e + [ag247nm,cph=483.39] Op2P -> Op ; 4.7e-2 + [ag732nm,cph=163.06] Op2P -> Op2D ; 1.71e-1 + [ag373nm,cph=321.30] Op2D -> Op ; 7.7e-5 + + End Reactions + + Ext Forcing + NO <-dataset + NO2 <-dataset + CO <-dataset + Op, O2p, Np, N2p, N2D, N, e, OH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_ma/chem_mods.F90 b/src/chemistry/pp_waccm_ma/chem_mods.F90 new file mode 100644 index 0000000000..e6c0a78fe4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 87, & ! number of photolysis reactions + rxntot = 289, & ! number of total reactions + gascnt = 202, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 74, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 630, & ! number of non-zero matrix entries + extcnt = 11, & ! number of species with external forcing + clscnt1 = 24, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 50, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 289, & + enthalpy_cnt = 53, & + nslvd = 16 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_ma/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma/m_rxt_id.F90 new file mode 100644 index 0000000000..eb691d7366 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/m_rxt_id.F90 @@ -0,0 +1,292 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jhbr = 34 + integer, parameter :: rid_jbrono2_a = 35 + integer, parameter :: rid_jbrono2_b = 36 + integer, parameter :: rid_jch3cl = 37 + integer, parameter :: rid_jccl4 = 38 + integer, parameter :: rid_jch3ccl3 = 39 + integer, parameter :: rid_jcfcl3 = 40 + integer, parameter :: rid_jcf2cl2 = 41 + integer, parameter :: rid_jcfc113 = 42 + integer, parameter :: rid_jcfc114 = 43 + integer, parameter :: rid_jcfc115 = 44 + integer, parameter :: rid_jhcfc22 = 45 + integer, parameter :: rid_jhcfc141b = 46 + integer, parameter :: rid_jhcfc142b = 47 + integer, parameter :: rid_jch3br = 48 + integer, parameter :: rid_jcf3br = 49 + integer, parameter :: rid_jcf2clbr = 50 + integer, parameter :: rid_jchbr3 = 51 + integer, parameter :: rid_jch2br2 = 52 + integer, parameter :: rid_jh1202 = 53 + integer, parameter :: rid_jh2402 = 54 + integer, parameter :: rid_jcof2 = 55 + integer, parameter :: rid_jcofcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jco2 = 58 + integer, parameter :: rid_jch4_a = 59 + integer, parameter :: rid_jch4_b = 60 + integer, parameter :: rid_jsf6 = 61 + integer, parameter :: rid_jeuv_1 = 62 + integer, parameter :: rid_jeuv_2 = 63 + integer, parameter :: rid_jeuv_3 = 64 + integer, parameter :: rid_jeuv_4 = 65 + integer, parameter :: rid_jeuv_5 = 66 + integer, parameter :: rid_jeuv_6 = 67 + integer, parameter :: rid_jeuv_7 = 68 + integer, parameter :: rid_jeuv_8 = 69 + integer, parameter :: rid_jeuv_9 = 70 + integer, parameter :: rid_jeuv_10 = 71 + integer, parameter :: rid_jeuv_11 = 72 + integer, parameter :: rid_jeuv_12 = 73 + integer, parameter :: rid_jeuv_13 = 74 + integer, parameter :: rid_jeuv_14 = 75 + integer, parameter :: rid_jeuv_15 = 76 + integer, parameter :: rid_jeuv_16 = 77 + integer, parameter :: rid_jeuv_17 = 78 + integer, parameter :: rid_jeuv_18 = 79 + integer, parameter :: rid_jeuv_19 = 80 + integer, parameter :: rid_jeuv_20 = 81 + integer, parameter :: rid_jeuv_21 = 82 + integer, parameter :: rid_jeuv_22 = 83 + integer, parameter :: rid_jeuv_23 = 84 + integer, parameter :: rid_jeuv_24 = 85 + integer, parameter :: rid_jeuv_25 = 86 + integer, parameter :: rid_jeuv_26 = 87 + integer, parameter :: rid_usr_O_O2 = 88 + integer, parameter :: rid_O_O3 = 89 + integer, parameter :: rid_usr_O_O = 90 + integer, parameter :: rid_O2_1S_O = 91 + integer, parameter :: rid_O2_1S_O2 = 92 + integer, parameter :: rid_O2_1S_N2 = 93 + integer, parameter :: rid_O2_1S_O3 = 94 + integer, parameter :: rid_O2_1S_CO2 = 95 + integer, parameter :: rid_ag2 = 96 + integer, parameter :: rid_O2_1D_O = 97 + integer, parameter :: rid_O2_1D_O2 = 98 + integer, parameter :: rid_O2_1D_N2 = 99 + integer, parameter :: rid_ag1 = 100 + integer, parameter :: rid_O1D_N2 = 101 + integer, parameter :: rid_O1D_O2 = 102 + integer, parameter :: rid_O1D_O2b = 103 + integer, parameter :: rid_O1D_H2O = 104 + integer, parameter :: rid_O1D_N2Oa = 105 + integer, parameter :: rid_O1D_N2Ob = 106 + integer, parameter :: rid_O1D_O3 = 107 + integer, parameter :: rid_O1D_CFC11 = 108 + integer, parameter :: rid_O1D_CFC12 = 109 + integer, parameter :: rid_O1D_CFC113 = 110 + integer, parameter :: rid_O1D_CFC114 = 111 + integer, parameter :: rid_O1D_CFC115 = 112 + integer, parameter :: rid_O1D_HCFC22 = 113 + integer, parameter :: rid_O1D_HCFC141B = 114 + integer, parameter :: rid_O1D_HCFC142B = 115 + integer, parameter :: rid_O1D_CCL4 = 116 + integer, parameter :: rid_O1D_CH3BR = 117 + integer, parameter :: rid_O1D_CF2CLBR = 118 + integer, parameter :: rid_O1D_CF3BR = 119 + integer, parameter :: rid_O1D_H1202 = 120 + integer, parameter :: rid_O1D_H2402 = 121 + integer, parameter :: rid_O1D_CHBR3 = 122 + integer, parameter :: rid_O1D_CH2BR2 = 123 + integer, parameter :: rid_O1D_COF2 = 124 + integer, parameter :: rid_O1D_COFCL = 125 + integer, parameter :: rid_O1D_CH4a = 126 + integer, parameter :: rid_O1D_CH4b = 127 + integer, parameter :: rid_O1D_CH4c = 128 + integer, parameter :: rid_O1D_H2 = 129 + integer, parameter :: rid_O1D_HCL = 130 + integer, parameter :: rid_O1D_HBR = 131 + integer, parameter :: rid_H_O2 = 132 + integer, parameter :: rid_H_O3 = 133 + integer, parameter :: rid_H_HO2a = 134 + integer, parameter :: rid_H_HO2 = 135 + integer, parameter :: rid_H_HO2b = 136 + integer, parameter :: rid_OH_O = 137 + integer, parameter :: rid_OH_O3 = 138 + integer, parameter :: rid_OH_HO2 = 139 + integer, parameter :: rid_OH_OH = 140 + integer, parameter :: rid_OH_OH_M = 141 + integer, parameter :: rid_OH_H2 = 142 + integer, parameter :: rid_OH_H2O2 = 143 + integer, parameter :: rid_H2_O = 144 + integer, parameter :: rid_HO2_O = 145 + integer, parameter :: rid_HO2_O3 = 146 + integer, parameter :: rid_usr_HO2_HO2 = 147 + integer, parameter :: rid_H2O2_O = 148 + integer, parameter :: rid_N2D_O2 = 149 + integer, parameter :: rid_N2D_O = 150 + integer, parameter :: rid_N_OH = 151 + integer, parameter :: rid_N_O2 = 152 + integer, parameter :: rid_N_NO = 153 + integer, parameter :: rid_N_NO2a = 154 + integer, parameter :: rid_N_NO2b = 155 + integer, parameter :: rid_N_NO2c = 156 + integer, parameter :: rid_NO_O = 157 + integer, parameter :: rid_NO_HO2 = 158 + integer, parameter :: rid_NO_O3 = 159 + integer, parameter :: rid_NO2_O = 160 + integer, parameter :: rid_NO2_O_M = 161 + integer, parameter :: rid_NO2_O3 = 162 + integer, parameter :: rid_tag_NO2_NO3 = 163 + integer, parameter :: rid_usr_N2O5_M = 164 + integer, parameter :: rid_tag_NO2_OH = 165 + integer, parameter :: rid_usr_HNO3_OH = 166 + integer, parameter :: rid_NO3_NO = 167 + integer, parameter :: rid_NO3_O = 168 + integer, parameter :: rid_NO3_OH = 169 + integer, parameter :: rid_NO3_HO2 = 170 + integer, parameter :: rid_tag_NO2_HO2 = 171 + integer, parameter :: rid_HO2NO2_OH = 172 + integer, parameter :: rid_usr_HO2NO2_M = 173 + integer, parameter :: rid_CL_O3 = 174 + integer, parameter :: rid_CL_H2 = 175 + integer, parameter :: rid_CL_H2O2 = 176 + integer, parameter :: rid_CL_HO2a = 177 + integer, parameter :: rid_CL_HO2b = 178 + integer, parameter :: rid_CL_CH2O = 179 + integer, parameter :: rid_CL_CH4 = 180 + integer, parameter :: rid_CLO_O = 181 + integer, parameter :: rid_CLO_OHa = 182 + integer, parameter :: rid_CLO_OHb = 183 + integer, parameter :: rid_CLO_HO2 = 184 + integer, parameter :: rid_CLO_CH3O2 = 185 + integer, parameter :: rid_CLO_NO = 186 + integer, parameter :: rid_CLO_NO2_M = 187 + integer, parameter :: rid_CLO_CLOa = 188 + integer, parameter :: rid_CLO_CLOb = 189 + integer, parameter :: rid_CLO_CLOc = 190 + integer, parameter :: rid_tag_CLO_CLO_M = 191 + integer, parameter :: rid_usr_CL2O2_M = 192 + integer, parameter :: rid_HCL_OH = 193 + integer, parameter :: rid_HCL_O = 194 + integer, parameter :: rid_HOCL_O = 195 + integer, parameter :: rid_HOCL_CL = 196 + integer, parameter :: rid_HOCL_OH = 197 + integer, parameter :: rid_CLONO2_O = 198 + integer, parameter :: rid_CLONO2_OH = 199 + integer, parameter :: rid_CLONO2_CL = 200 + integer, parameter :: rid_BR_O3 = 201 + integer, parameter :: rid_BR_HO2 = 202 + integer, parameter :: rid_BR_CH2O = 203 + integer, parameter :: rid_BRO_O = 204 + integer, parameter :: rid_BRO_OH = 205 + integer, parameter :: rid_BRO_HO2 = 206 + integer, parameter :: rid_BRO_NO = 207 + integer, parameter :: rid_BRO_NO2_M = 208 + integer, parameter :: rid_BRO_CLOa = 209 + integer, parameter :: rid_BRO_CLOb = 210 + integer, parameter :: rid_BRO_CLOc = 211 + integer, parameter :: rid_BRO_BRO = 212 + integer, parameter :: rid_HBR_OH = 213 + integer, parameter :: rid_HBR_O = 214 + integer, parameter :: rid_HOBR_O = 215 + integer, parameter :: rid_BRONO2_O = 216 + integer, parameter :: rid_F_H2O = 217 + integer, parameter :: rid_F_H2 = 218 + integer, parameter :: rid_F_CH4 = 219 + integer, parameter :: rid_F_HNO3 = 220 + integer, parameter :: rid_CH3CL_CL = 221 + integer, parameter :: rid_CH3CL_OH = 222 + integer, parameter :: rid_CH3CCL3_OH = 223 + integer, parameter :: rid_HCFC22_OH = 224 + integer, parameter :: rid_CH3BR_OH = 225 + integer, parameter :: rid_CH3BR_CL = 226 + integer, parameter :: rid_HCFC141B_OH = 227 + integer, parameter :: rid_HCFC142B_OH = 228 + integer, parameter :: rid_CH2BR2_OH = 229 + integer, parameter :: rid_CHBR3_OH = 230 + integer, parameter :: rid_CH2BR2_CL = 231 + integer, parameter :: rid_CHBR3_CL = 232 + integer, parameter :: rid_CH4_OH = 233 + integer, parameter :: rid_usr_CO_OH_b = 234 + integer, parameter :: rid_CO_OH_M = 235 + integer, parameter :: rid_CH2O_NO3 = 236 + integer, parameter :: rid_CH2O_OH = 237 + integer, parameter :: rid_CH2O_O = 238 + integer, parameter :: rid_CH3O2_NO = 239 + integer, parameter :: rid_CH3O2_HO2 = 240 + integer, parameter :: rid_CH3OOH_OH = 241 + integer, parameter :: rid_usr_N2O5_aer = 242 + integer, parameter :: rid_usr_NO3_aer = 243 + integer, parameter :: rid_usr_NO2_aer = 244 + integer, parameter :: rid_usr_HO2_aer = 245 + integer, parameter :: rid_het1 = 246 + integer, parameter :: rid_het2 = 247 + integer, parameter :: rid_het3 = 248 + integer, parameter :: rid_het4 = 249 + integer, parameter :: rid_het5 = 250 + integer, parameter :: rid_het6 = 251 + integer, parameter :: rid_het7 = 252 + integer, parameter :: rid_het8 = 253 + integer, parameter :: rid_het9 = 254 + integer, parameter :: rid_het10 = 255 + integer, parameter :: rid_het11 = 256 + integer, parameter :: rid_het12 = 257 + integer, parameter :: rid_het13 = 258 + integer, parameter :: rid_het14 = 259 + integer, parameter :: rid_het15 = 260 + integer, parameter :: rid_het16 = 261 + integer, parameter :: rid_het17 = 262 + integer, parameter :: rid_ion_Op_O2 = 263 + integer, parameter :: rid_ion_Op_N2 = 264 + integer, parameter :: rid_ion_N2p_Oa = 265 + integer, parameter :: rid_ion_N2p_Ob = 266 + integer, parameter :: rid_ion_Op_CO2 = 267 + integer, parameter :: rid_ion_O2p_N = 268 + integer, parameter :: rid_ion_O2p_NO = 269 + integer, parameter :: rid_ion_Np_O2a = 270 + integer, parameter :: rid_ion_Np_O2b = 271 + integer, parameter :: rid_ion_Np_O = 272 + integer, parameter :: rid_ion_N2p_O2 = 273 + integer, parameter :: rid_ion_O2p_N2 = 274 + integer, parameter :: rid_elec1 = 275 + integer, parameter :: rid_elec2 = 276 + integer, parameter :: rid_elec3 = 277 + integer, parameter :: rid_Op2P_N2a = 278 + integer, parameter :: rid_Op2P_N2b = 279 + integer, parameter :: rid_Op2P_O = 280 + integer, parameter :: rid_Op2P_ea = 281 + integer, parameter :: rid_Op2P_eb = 282 + integer, parameter :: rid_Op2D_O = 283 + integer, parameter :: rid_Op2D_O2 = 284 + integer, parameter :: rid_Op2D_N2 = 285 + integer, parameter :: rid_Op2D_e = 286 + integer, parameter :: rid_ag247nm = 287 + integer, parameter :: rid_ag732nm = 288 + integer, parameter :: rid_ag373nm = 289 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma/m_spc_id.F90 b/src/chemistry/pp_waccm_ma/m_spc_id.F90 new file mode 100644 index 0000000000..c6eb02f9a3 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/m_spc_id.F90 @@ -0,0 +1,77 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O1D = 3 + integer, parameter :: id_O2 = 4 + integer, parameter :: id_O2_1S = 5 + integer, parameter :: id_O2_1D = 6 + integer, parameter :: id_N2O = 7 + integer, parameter :: id_N = 8 + integer, parameter :: id_NO = 9 + integer, parameter :: id_NO2 = 10 + integer, parameter :: id_NO3 = 11 + integer, parameter :: id_HNO3 = 12 + integer, parameter :: id_HO2NO2 = 13 + integer, parameter :: id_N2O5 = 14 + integer, parameter :: id_CH4 = 15 + integer, parameter :: id_CH3O2 = 16 + integer, parameter :: id_CH3OOH = 17 + integer, parameter :: id_CH2O = 18 + integer, parameter :: id_CO = 19 + integer, parameter :: id_H2 = 20 + integer, parameter :: id_H = 21 + integer, parameter :: id_OH = 22 + integer, parameter :: id_HO2 = 23 + integer, parameter :: id_H2O2 = 24 + integer, parameter :: id_CLY = 25 + integer, parameter :: id_BRY = 26 + integer, parameter :: id_SF6 = 27 + integer, parameter :: id_CL = 28 + integer, parameter :: id_CL2 = 29 + integer, parameter :: id_CLO = 30 + integer, parameter :: id_OCLO = 31 + integer, parameter :: id_CL2O2 = 32 + integer, parameter :: id_HCL = 33 + integer, parameter :: id_HOCL = 34 + integer, parameter :: id_CLONO2 = 35 + integer, parameter :: id_BRCL = 36 + integer, parameter :: id_BR = 37 + integer, parameter :: id_BRO = 38 + integer, parameter :: id_HBR = 39 + integer, parameter :: id_HOBR = 40 + integer, parameter :: id_BRONO2 = 41 + integer, parameter :: id_CH3CL = 42 + integer, parameter :: id_CH3BR = 43 + integer, parameter :: id_CFC11 = 44 + integer, parameter :: id_CFC12 = 45 + integer, parameter :: id_CFC113 = 46 + integer, parameter :: id_HCFC22 = 47 + integer, parameter :: id_CCL4 = 48 + integer, parameter :: id_CH3CCL3 = 49 + integer, parameter :: id_CF3BR = 50 + integer, parameter :: id_CF2CLBR = 51 + integer, parameter :: id_HCFC141B = 52 + integer, parameter :: id_HCFC142B = 53 + integer, parameter :: id_CFC114 = 54 + integer, parameter :: id_CFC115 = 55 + integer, parameter :: id_H1202 = 56 + integer, parameter :: id_H2402 = 57 + integer, parameter :: id_CHBR3 = 58 + integer, parameter :: id_CH2BR2 = 59 + integer, parameter :: id_COF2 = 60 + integer, parameter :: id_COFCL = 61 + integer, parameter :: id_HF = 62 + integer, parameter :: id_F = 63 + integer, parameter :: id_CO2 = 64 + integer, parameter :: id_N2p = 65 + integer, parameter :: id_O2p = 66 + integer, parameter :: id_Np = 67 + integer, parameter :: id_Op = 68 + integer, parameter :: id_NOp = 69 + integer, parameter :: id_e = 70 + integer, parameter :: id_N2D = 71 + integer, parameter :: id_Op2P = 72 + integer, parameter :: id_Op2D = 73 + integer, parameter :: id_H2O = 74 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 new file mode 100644 index 0000000000..068e135772 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 @@ -0,0 +1,214 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 88) = rate(:,:, 88) * inv(:,:, 1) + rate(:,:, 90) = rate(:,:, 90) * inv(:,:, 1) + rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 2) + rate(:,:, 99) = rate(:,:, 99) * inv(:,:, 2) + rate(:,:,101) = rate(:,:,101) * inv(:,:, 2) + rate(:,:,132) = rate(:,:,132) * inv(:,:, 1) + rate(:,:,141) = rate(:,:,141) * inv(:,:, 1) + rate(:,:,157) = rate(:,:,157) * inv(:,:, 1) + rate(:,:,161) = rate(:,:,161) * inv(:,:, 1) + rate(:,:,163) = rate(:,:,163) * inv(:,:, 1) + rate(:,:,164) = rate(:,:,164) * inv(:,:, 1) + rate(:,:,165) = rate(:,:,165) * inv(:,:, 1) + rate(:,:,171) = rate(:,:,171) * inv(:,:, 1) + rate(:,:,173) = rate(:,:,173) * inv(:,:, 1) + rate(:,:,187) = rate(:,:,187) * inv(:,:, 1) + rate(:,:,191) = rate(:,:,191) * inv(:,:, 1) + rate(:,:,192) = rate(:,:,192) * inv(:,:, 1) + rate(:,:,208) = rate(:,:,208) * inv(:,:, 1) + rate(:,:,235) = rate(:,:,235) * inv(:,:, 1) + rate(:,:,264) = rate(:,:,264) * inv(:,:, 2) + rate(:,:,274) = rate(:,:,274) * inv(:,:, 2) + rate(:,:,278) = rate(:,:,278) * inv(:,:, 2) + rate(:,:,279) = rate(:,:,279) * inv(:,:, 2) + rate(:,:,285) = rate(:,:,285) * inv(:,:, 2) + rate(:,:, 88) = rate(:,:, 88) * m(:,:) + rate(:,:, 89) = rate(:,:, 89) * m(:,:) + rate(:,:, 90) = rate(:,:, 90) * m(:,:) + rate(:,:, 91) = rate(:,:, 91) * m(:,:) + rate(:,:, 92) = rate(:,:, 92) * m(:,:) + rate(:,:, 94) = rate(:,:, 94) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:,102) = rate(:,:,102) * m(:,:) + rate(:,:,103) = rate(:,:,103) * m(:,:) + rate(:,:,104) = rate(:,:,104) * m(:,:) + rate(:,:,105) = rate(:,:,105) * m(:,:) + rate(:,:,106) = rate(:,:,106) * m(:,:) + rate(:,:,107) = rate(:,:,107) * m(:,:) + rate(:,:,108) = rate(:,:,108) * m(:,:) + rate(:,:,109) = rate(:,:,109) * m(:,:) + rate(:,:,110) = rate(:,:,110) * m(:,:) + rate(:,:,111) = rate(:,:,111) * m(:,:) + rate(:,:,112) = rate(:,:,112) * m(:,:) + rate(:,:,113) = rate(:,:,113) * m(:,:) + rate(:,:,114) = rate(:,:,114) * m(:,:) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,116) = rate(:,:,116) * m(:,:) + rate(:,:,117) = rate(:,:,117) * m(:,:) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,123) = rate(:,:,123) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,126) = rate(:,:,126) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,269) = rate(:,:,269) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,277) = rate(:,:,277) * m(:,:) + rate(:,:,280) = rate(:,:,280) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma/mo_exp_sol.F90 b/src/chemistry/pp_waccm_ma/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_ma/mo_imp_sol.F90 b/src/chemistry/pp_waccm_ma/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_ma/mo_indprd.F90 b/src/chemistry/pp_waccm_ma/mo_indprd.F90 new file mode 100644 index 0000000000..7bad630c1b --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_indprd.F90 @@ -0,0 +1,123 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) =rxt(:,:,154)*y(:,:,10)*y(:,:,8) + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = (rxt(:,:,234)*y(:,:,22) +rxt(:,:,235)*y(:,:,22))*y(:,:,19) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,49) = 0._r8 + prod(:,:,44) = (rxt(:,:,58) +rxt(:,:,87))*y(:,:,64) +.180_r8*rxt(:,:,60) & + *y(:,:,15) + prod(:,:,47) =rxt(:,:,5)*y(:,:,7) + prod(:,:,32) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,35) =1.440_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,16) = (rxt(:,:,58) +rxt(:,:,87))*y(:,:,64) +.380_r8*rxt(:,:,60) & + *y(:,:,15) + extfrc(:,:,3) + prod(:,:,28) = (rxt(:,:,71) +.800_r8*rxt(:,:,74) +rxt(:,:,83) + & + .800_r8*rxt(:,:,86)) + extfrc(:,:,9) + prod(:,:,48) = + extfrc(:,:,1) + prod(:,:,40) = + extfrc(:,:,2) + prod(:,:,43) =.330_r8*rxt(:,:,60)*y(:,:,15) + extfrc(:,:,11) + prod(:,:,45) = 0._r8 + prod(:,:,31) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,50) =rxt(:,:,59)*y(:,:,15) +rxt(:,:,37)*y(:,:,42) +rxt(:,:,48) & + *y(:,:,43) + prod(:,:,11) = 0._r8 + prod(:,:,34) =.180_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,38) = (rxt(:,:,59) +.330_r8*rxt(:,:,60))*y(:,:,15) + prod(:,:,41) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,33) =.050_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,42) =rxt(:,:,37)*y(:,:,42) +2.000_r8*rxt(:,:,40)*y(:,:,44) & + +2.000_r8*rxt(:,:,41)*y(:,:,45) +2.000_r8*rxt(:,:,42)*y(:,:,46) & + +rxt(:,:,45)*y(:,:,47) +4.000_r8*rxt(:,:,38)*y(:,:,48) & + +3.000_r8*rxt(:,:,39)*y(:,:,49) +rxt(:,:,50)*y(:,:,51) +rxt(:,:,46) & + *y(:,:,52) +rxt(:,:,47)*y(:,:,53) +2.000_r8*rxt(:,:,43)*y(:,:,54) & + +rxt(:,:,44)*y(:,:,55) + prod(:,:,6) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,46) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,39) =rxt(:,:,48)*y(:,:,43) +rxt(:,:,49)*y(:,:,50) +rxt(:,:,50) & + *y(:,:,51) +2.000_r8*rxt(:,:,53)*y(:,:,56) +2.000_r8*rxt(:,:,54) & + *y(:,:,57) +3.000_r8*rxt(:,:,51)*y(:,:,58) +2.000_r8*rxt(:,:,52) & + *y(:,:,59) + prod(:,:,36) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,22) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,20) = (rxt(:,:,67) +rxt(:,:,79)) + extfrc(:,:,7) + prod(:,:,23) = + extfrc(:,:,5) + prod(:,:,19) = (rxt(:,:,71) +rxt(:,:,72) +rxt(:,:,83) +rxt(:,:,84)) & + + extfrc(:,:,6) + prod(:,:,21) = + extfrc(:,:,4) + prod(:,:,24) = 0._r8 + prod(:,:,15) = (rxt(:,:,72) +1.200_r8*rxt(:,:,74) +rxt(:,:,84) + & + 1.200_r8*rxt(:,:,86)) + extfrc(:,:,8) + prod(:,:,25) = (rxt(:,:,67) +rxt(:,:,71) +rxt(:,:,72) +rxt(:,:,79) + & + rxt(:,:,83) +rxt(:,:,84)) + extfrc(:,:,10) + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,5) =rxt(:,:,41)*y(:,:,45) +rxt(:,:,42)*y(:,:,46) +rxt(:,:,45) & + *y(:,:,47) +rxt(:,:,49)*y(:,:,50) +rxt(:,:,50)*y(:,:,51) +rxt(:,:,47) & + *y(:,:,53) +2.000_r8*rxt(:,:,43)*y(:,:,54) +2.000_r8*rxt(:,:,44) & + *y(:,:,55) +rxt(:,:,53)*y(:,:,56) +2.000_r8*rxt(:,:,54)*y(:,:,57) + prod(:,:,7) =rxt(:,:,40)*y(:,:,44) +rxt(:,:,42)*y(:,:,46) +rxt(:,:,46) & + *y(:,:,52) + prod(:,:,9) = 0._r8 + prod(:,:,26) =rxt(:,:,49)*y(:,:,50) +rxt(:,:,44)*y(:,:,55) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 new file mode 100644 index 0000000000..25b0e8c9b2 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 @@ -0,0 +1,265 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(610) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(499) = -( rxt(62) + rxt(63) + rxt(64) + rxt(75) + rxt(76) + rxt(77) & + + het_rates(2) ) + mat(230) = rxt(1) + 2.000_r8*rxt(2) + rxt(68) + rxt(69) + rxt(70) & + + 2.000_r8*rxt(73) + rxt(80) + rxt(81) + rxt(82) + 2.000_r8*rxt(85) + mat(605) = rxt(4) + mat(587) = rxt(6) + mat(380) = rxt(8) + mat(30) = rxt(10) + mat(519) = rxt(12) + mat(242) = rxt(21) + mat(319) = rxt(24) + mat(11) = rxt(25) + mat(293) = rxt(32) + mat(565) = rxt(101) + mat(51) = rxt(278) + mat(58) = rxt(285) + mat(568) = -( rxt(101) + rxt(105)*y(7) + rxt(106)*y(7) + rxt(108)*y(44) & + + rxt(109)*y(45) + rxt(110)*y(46) + rxt(111)*y(54) + rxt(112)*y(55) & + + rxt(113)*y(47) + rxt(114)*y(52) + rxt(115)*y(53) + rxt(116)*y(48) & + + rxt(117)*y(43) + rxt(118)*y(51) + rxt(119)*y(50) + rxt(120)*y(56) & + + rxt(121)*y(57) + rxt(122)*y(58) + rxt(123)*y(59) + rxt(126)*y(15) & + + rxt(127)*y(15) + rxt(128)*y(15) + het_rates(3) ) + mat(231) = rxt(1) + mat(608) = rxt(3) + mat(244) = rxt(20) + mat(225) = -( rxt(1) + rxt(2) + rxt(66) + rxt(68) + rxt(69) + rxt(70) + rxt(73) & + + rxt(78) + rxt(80) + rxt(81) + rxt(82) + rxt(85) + het_rates(4) ) + mat(596) = rxt(4) + mat(509) = rxt(13) + mat(8) = rxt(96) + mat(5) = rxt(99) + rxt(100) + mat(555) = rxt(106)*y(7) + mat(7) = -( rxt(93) + rxt(96) + rxt(95)*y(64) + het_rates(5) ) + mat(4) = -( rxt(99) + rxt(100) + het_rates(6) ) + mat(594) = rxt(3) + mat(6) = rxt(93) + rxt(95)*y(64) + mat(267) = -( het_rates(20) ) + mat(251) = rxt(18) + mat(238) = rxt(20) + mat(558) = rxt(128)*y(15) + mat(64) = -( het_rates(19) ) + mat(246) = rxt(17) + rxt(18) + mat(413) = rxt(221)*y(42) + mat(101) = rxt(267)*y(64) + mat(174) = -( rxt(65) + het_rates(8) ) + mat(575) = rxt(6) + mat(105) = rxt(264) + mat(591) = -( rxt(6) + rxt(7) + het_rates(9) ) + mat(384) = rxt(8) + .500_r8*rxt(244) + mat(32) = rxt(10) + mat(523) = rxt(13) + mat(127) = rxt(274) + mat(52) = rxt(279) + mat(569) = 2.000_r8*rxt(105)*y(7) + mat(376) = -( rxt(8) + rxt(244) + het_rates(10) ) + mat(29) = rxt(9) + rxt(164) + mat(209) = rxt(11) + mat(515) = rxt(12) + mat(42) = rxt(15) + rxt(173) + mat(197) = rxt(30) + mat(73) = rxt(36) + mat(459) = -( rxt(222)*y(42) + rxt(223)*y(49) + rxt(224)*y(47) + rxt(225)*y(43) & + + rxt(227)*y(52) + rxt(228)*y(53) + rxt(229)*y(59) + rxt(230)*y(58) & + + rxt(233)*y(15) + het_rates(22) ) + mat(210) = rxt(11) + mat(44) = rxt(14) + mat(37) = rxt(16) + mat(241) = rxt(19) + mat(80) = 2.000_r8*rxt(22) + mat(188) = rxt(27) + mat(117) = rxt(33) + mat(379) = .500_r8*rxt(244) + mat(564) = rxt(126)*y(15) + mat(520) = -( rxt(12) + rxt(13) + rxt(243) + het_rates(11) ) + mat(31) = rxt(9) + rxt(10) + rxt(164) + mat(45) = rxt(14) + mat(201) = rxt(29) + mat(75) = rxt(35) + mat(205) = -( rxt(11) + het_rates(12) ) + mat(28) = 2.000_r8*rxt(242) + 2.000_r8*rxt(246) + 2.000_r8*rxt(252) & + + 2.000_r8*rxt(257) + mat(508) = rxt(243) + mat(368) = .500_r8*rxt(244) + mat(194) = rxt(247) + rxt(253) + rxt(258) + mat(70) = rxt(248) + rxt(256) + rxt(259) + mat(39) = -( rxt(14) + rxt(15) + rxt(173) + het_rates(13) ) + mat(27) = -( rxt(9) + rxt(10) + rxt(164) + rxt(242) + rxt(246) + rxt(252) & + + rxt(257) + het_rates(14) ) + mat(630) = -( het_rates(16) ) + mat(571) = rxt(126)*y(15) + mat(435) = rxt(180)*y(15) + mat(161) = rxt(219)*y(15) + mat(466) = rxt(233)*y(15) + mat(33) = -( rxt(16) + het_rates(17) ) + mat(250) = -( rxt(17) + rxt(18) + het_rates(18) ) + mat(35) = rxt(16) + mat(557) = rxt(127)*y(15) + rxt(128)*y(15) + mat(329) = -( het_rates(21) ) + mat(36) = rxt(16) + mat(252) = 2.000_r8*rxt(17) + mat(239) = rxt(19) + 2.000_r8*rxt(21) + mat(536) = rxt(28) + mat(164) = rxt(34) + mat(26) = rxt(57) + mat(559) = rxt(127)*y(15) + mat(402) = -( rxt(245) + het_rates(23) ) + mat(43) = rxt(15) + rxt(173) + mat(562) = rxt(127)*y(15) + mat(426) = rxt(221)*y(42) + rxt(226)*y(43) + mat(457) = rxt(222)*y(42) + rxt(225)*y(43) + mat(76) = -( rxt(22) + het_rates(24) ) + mat(389) = .500_r8*rxt(245) + mat(237) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(74) ) + mat(449) = rxt(222)*y(42) + rxt(223)*y(49) + rxt(224)*y(47) + rxt(225)*y(43) & + + rxt(229)*y(59) + rxt(233)*y(15) + mat(427) = -( rxt(180)*y(15) + rxt(221)*y(42) + rxt(226)*y(43) + rxt(231)*y(59) & + + rxt(232)*y(58) + het_rates(28) ) + mat(16) = 2.000_r8*rxt(23) + mat(317) = rxt(24) + mat(3) = 2.000_r8*rxt(26) + mat(187) = rxt(27) + mat(540) = rxt(28) + mat(198) = rxt(29) + mat(23) = rxt(31) + mat(19) = rxt(56) + mat(563) = 2.000_r8*rxt(108)*y(44) + 2.000_r8*rxt(109)*y(45) & + + 2.000_r8*rxt(110)*y(46) + 2.000_r8*rxt(111)*y(54) + rxt(112)*y(55) & + + rxt(113)*y(47) + rxt(114)*y(52) + rxt(115)*y(53) & + + 4.000_r8*rxt(116)*y(48) + rxt(118)*y(51) + mat(458) = rxt(222)*y(42) + 3.000_r8*rxt(223)*y(49) + rxt(224)*y(47) & + + rxt(227)*y(52) + rxt(228)*y(53) + mat(15) = -( rxt(23) + het_rates(29) ) + mat(312) = -( rxt(24) + het_rates(30) ) + mat(10) = rxt(25) + mat(196) = rxt(30) + mat(2) = 2.000_r8*rxt(192) + mat(9) = -( rxt(25) + het_rates(31) ) + mat(1) = -( rxt(26) + rxt(192) + het_rates(32) ) + mat(544) = -( rxt(28) + het_rates(33) ) + mat(431) = rxt(180)*y(15) + 2.000_r8*rxt(221)*y(42) + rxt(226)*y(43) & + + rxt(231)*y(59) + rxt(232)*y(58) + mat(184) = -( rxt(27) + het_rates(34) ) + mat(192) = rxt(247) + rxt(253) + rxt(258) + mat(193) = -( rxt(29) + rxt(30) + rxt(247) + rxt(253) + rxt(258) + het_rates(35) & + ) + mat(21) = -( rxt(31) + het_rates(36) ) + mat(350) = -( het_rates(37) ) + mat(22) = rxt(31) + mat(288) = rxt(32) + mat(115) = rxt(33) + mat(165) = rxt(34) + mat(72) = rxt(35) + mat(560) = rxt(117)*y(43) + rxt(118)*y(51) + rxt(119)*y(50) & + + 2.000_r8*rxt(120)*y(56) + 2.000_r8*rxt(121)*y(57) & + + 3.000_r8*rxt(122)*y(58) + 2.000_r8*rxt(123)*y(59) + mat(455) = rxt(225)*y(43) + 2.000_r8*rxt(229)*y(59) + 3.000_r8*rxt(230)*y(58) + mat(424) = rxt(226)*y(43) + 2.000_r8*rxt(231)*y(59) + 3.000_r8*rxt(232)*y(58) + mat(285) = -( rxt(32) + het_rates(38) ) + mat(71) = rxt(36) + mat(162) = -( rxt(34) + het_rates(39) ) + mat(112) = -( rxt(33) + het_rates(40) ) + mat(69) = rxt(248) + rxt(256) + rxt(259) + mat(68) = -( rxt(35) + rxt(36) + rxt(248) + rxt(256) + rxt(259) + het_rates(41) & + ) + mat(91) = -( het_rates(65) ) + mat(49) = rxt(278) + mat(54) = rxt(285) + mat(120) = -( rxt(274) + het_rates(66) ) + mat(221) = rxt(66) + rxt(78) + mat(103) = rxt(267)*y(64) + mat(83) = -( het_rates(67) ) + mat(169) = rxt(65) + mat(48) = rxt(279) + mat(102) = -( rxt(264) + rxt(267)*y(64) + het_rates(68) ) + mat(477) = rxt(62) + rxt(75) + mat(220) = rxt(68) + rxt(80) + mat(50) = rxt(287) + mat(55) = rxt(289) + mat(129) = -( het_rates(69) ) + mat(573) = rxt(7) + mat(104) = rxt(264) + mat(121) = rxt(274) + mat(59) = -( het_rates(71) ) + mat(144) = -( het_rates(70) ) + mat(574) = rxt(7) + mat(481) = rxt(62) + rxt(63) + rxt(64) + rxt(75) + rxt(76) + rxt(77) + mat(173) = rxt(65) + mat(223) = rxt(66) + rxt(68) + rxt(69) + rxt(70) + rxt(78) + rxt(80) + rxt(81) & + + rxt(82) + mat(46) = -( rxt(278) + rxt(279) + rxt(287) + rxt(288) + het_rates(72) ) + mat(469) = rxt(64) + rxt(77) + mat(215) = rxt(70) + rxt(82) + mat(53) = -( rxt(285) + rxt(289) + het_rates(73) ) + mat(470) = rxt(63) + rxt(76) + mat(216) = rxt(69) + rxt(81) + mat(47) = rxt(288) + mat(12) = -( rxt(55) + het_rates(60) ) + mat(550) = rxt(109)*y(45) + rxt(110)*y(46) + 2.000_r8*rxt(111)*y(54) & + + 2.000_r8*rxt(112)*y(55) + rxt(113)*y(47) + rxt(115)*y(53) & + + rxt(118)*y(51) + rxt(119)*y(50) + rxt(120)*y(56) & + + 2.000_r8*rxt(121)*y(57) + mat(436) = rxt(224)*y(47) + rxt(228)*y(53) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(17) = -( rxt(56) + het_rates(61) ) + mat(551) = rxt(108)*y(44) + rxt(110)*y(46) + rxt(114)*y(52) + mat(437) = rxt(227)*y(52) + mat(24) = -( rxt(57) + het_rates(62) ) + mat(153) = rxt(219)*y(15) + mat(154) = -( rxt(219)*y(15) + het_rates(63) ) + mat(13) = 2.000_r8*rxt(55) + mat(18) = rxt(56) + mat(25) = rxt(57) + mat(552) = rxt(112)*y(55) + rxt(119)*y(50) + end subroutine linmat02 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 new file mode 100644 index 0000000000..b88be87b19 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 @@ -0,0 +1,2527 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = lu(3) * lu(1) + lu(312) = lu(312) - lu(2) * lu(300) + lu(317) = lu(317) - lu(3) * lu(300) + lu(4) = 1._r8 / lu(4) + lu(5) = lu(5) * lu(4) + lu(8) = lu(8) - lu(5) * lu(6) + lu(225) = lu(225) - lu(5) * lu(213) + lu(487) = lu(487) - lu(5) * lu(467) + lu(596) = lu(596) - lu(5) * lu(594) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(225) = lu(225) - lu(8) * lu(214) + lu(487) = lu(487) - lu(8) * lu(468) + lu(555) = lu(555) - lu(8) * lu(549) + lu(596) = lu(596) - lu(8) * lu(595) + lu(9) = 1._r8 / lu(9) + lu(10) = lu(10) * lu(9) + lu(11) = lu(11) * lu(9) + lu(286) = lu(286) - lu(10) * lu(277) + lu(293) = lu(293) - lu(11) * lu(277) + lu(312) = lu(312) - lu(10) * lu(301) + lu(319) = lu(319) - lu(11) * lu(301) + lu(12) = 1._r8 / lu(12) + lu(13) = lu(13) * lu(12) + lu(14) = lu(14) * lu(12) + lu(442) = - lu(13) * lu(436) + lu(463) = - lu(14) * lu(436) + lu(552) = lu(552) - lu(13) * lu(550) + lu(568) = lu(568) - lu(14) * lu(550) + lu(15) = 1._r8 / lu(15) + lu(16) = lu(16) * lu(15) + lu(187) = lu(187) - lu(16) * lu(183) + lu(198) = lu(198) - lu(16) * lu(191) + lu(317) = lu(317) - lu(16) * lu(302) + lu(427) = lu(427) - lu(16) * lu(412) + lu(540) = lu(540) - lu(16) * lu(526) + lu(17) = 1._r8 / lu(17) + lu(18) = lu(18) * lu(17) + lu(19) = lu(19) * lu(17) + lu(20) = lu(20) * lu(17) + lu(442) = lu(442) - lu(18) * lu(437) + lu(458) = lu(458) - lu(19) * lu(437) + lu(463) = lu(463) - lu(20) * lu(437) + lu(552) = lu(552) - lu(18) * lu(551) + lu(563) = lu(563) - lu(19) * lu(551) + lu(568) = lu(568) - lu(20) * lu(551) + lu(21) = 1._r8 / lu(21) + lu(22) = lu(22) * lu(21) + lu(23) = lu(23) * lu(21) + lu(115) = lu(115) - lu(22) * lu(111) + lu(116) = - lu(23) * lu(111) + lu(288) = lu(288) - lu(22) * lu(278) + lu(291) = lu(291) - lu(23) * lu(278) + lu(314) = lu(314) - lu(22) * lu(303) + lu(317) = lu(317) - lu(23) * lu(303) + lu(537) = - lu(22) * lu(527) + lu(540) = lu(540) - lu(23) * lu(527) + lu(24) = 1._r8 / lu(24) + lu(25) = lu(25) * lu(24) + lu(26) = lu(26) * lu(24) + lu(154) = lu(154) - lu(25) * lu(153) + lu(158) = lu(158) - lu(26) * lu(153) + lu(204) = lu(204) - lu(25) * lu(203) + lu(208) = - lu(26) * lu(203) + lu(235) = lu(235) - lu(25) * lu(234) + lu(239) = lu(239) - lu(26) * lu(234) + lu(264) = lu(264) - lu(25) * lu(263) + lu(268) = lu(268) - lu(26) * lu(263) + lu(27) = 1._r8 / lu(27) + lu(28) = lu(28) * lu(27) + lu(29) = lu(29) * lu(27) + lu(30) = lu(30) * lu(27) + lu(31) = lu(31) * lu(27) + lu(32) = lu(32) * lu(27) + lu(368) = lu(368) - lu(28) * lu(362) + lu(376) = lu(376) - lu(29) * lu(362) + lu(380) = lu(380) - lu(30) * lu(362) + lu(381) = lu(381) - lu(31) * lu(362) + lu(384) = lu(384) - lu(32) * lu(362) + lu(508) = lu(508) - lu(28) * lu(506) + lu(515) = lu(515) - lu(29) * lu(506) + lu(519) = lu(519) - lu(30) * lu(506) + lu(520) = lu(520) - lu(31) * lu(506) + lu(523) = lu(523) - lu(32) * lu(506) + lu(33) = 1._r8 / lu(33) + lu(34) = lu(34) * lu(33) + lu(35) = lu(35) * lu(33) + lu(36) = lu(36) * lu(33) + lu(37) = lu(37) * lu(33) + lu(38) = lu(38) * lu(33) + lu(394) = lu(394) - lu(34) * lu(387) + lu(395) = - lu(35) * lu(387) + lu(399) = lu(399) - lu(36) * lu(387) + lu(404) = lu(404) - lu(37) * lu(387) + lu(411) = lu(411) - lu(38) * lu(387) + lu(449) = lu(449) - lu(34) * lu(438) + lu(450) = lu(450) - lu(35) * lu(438) + lu(454) = lu(454) - lu(36) * lu(438) + lu(459) = lu(459) - lu(37) * lu(438) + lu(466) = lu(466) - lu(38) * lu(438) + lu(614) = - lu(34) * lu(612) + lu(615) = lu(615) - lu(35) * lu(612) + lu(618) = - lu(36) * lu(612) + lu(623) = - lu(37) * lu(612) + lu(630) = lu(630) - lu(38) * lu(612) + lu(39) = 1._r8 / lu(39) + lu(40) = lu(40) * lu(39) + lu(41) = lu(41) * lu(39) + lu(42) = lu(42) * lu(39) + lu(43) = lu(43) * lu(39) + lu(44) = lu(44) * lu(39) + lu(45) = lu(45) * lu(39) + lu(369) = lu(369) - lu(40) * lu(363) + lu(370) = - lu(41) * lu(363) + lu(376) = lu(376) - lu(42) * lu(363) + lu(377) = lu(377) - lu(43) * lu(363) + lu(379) = lu(379) - lu(44) * lu(363) + lu(381) = lu(381) - lu(45) * lu(363) + lu(393) = lu(393) - lu(40) * lu(388) + lu(394) = lu(394) - lu(41) * lu(388) + lu(401) = lu(401) - lu(42) * lu(388) + lu(402) = lu(402) - lu(43) * lu(388) + lu(404) = lu(404) - lu(44) * lu(388) + lu(406) = lu(406) - lu(45) * lu(388) + lu(448) = lu(448) - lu(40) * lu(439) + lu(449) = lu(449) - lu(41) * lu(439) + lu(456) = lu(456) - lu(42) * lu(439) + lu(457) = lu(457) - lu(43) * lu(439) + lu(459) = lu(459) - lu(44) * lu(439) + lu(461) = lu(461) - lu(45) * lu(439) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(46) = 1._r8 / lu(46) + lu(47) = lu(47) * lu(46) + lu(48) = lu(48) * lu(46) + lu(49) = lu(49) * lu(46) + lu(50) = lu(50) * lu(46) + lu(51) = lu(51) * lu(46) + lu(52) = lu(52) * lu(46) + lu(137) = lu(137) - lu(47) * lu(136) + lu(139) = - lu(48) * lu(136) + lu(140) = lu(140) - lu(49) * lu(136) + lu(141) = lu(141) - lu(50) * lu(136) + lu(150) = lu(150) - lu(51) * lu(136) + lu(152) = - lu(52) * lu(136) + lu(216) = lu(216) - lu(47) * lu(215) + lu(218) = lu(218) - lu(48) * lu(215) + lu(219) = lu(219) - lu(49) * lu(215) + lu(220) = lu(220) - lu(50) * lu(215) + lu(230) = lu(230) - lu(51) * lu(215) + lu(232) = lu(232) - lu(52) * lu(215) + lu(470) = lu(470) - lu(47) * lu(469) + lu(475) = lu(475) - lu(48) * lu(469) + lu(476) = lu(476) - lu(49) * lu(469) + lu(477) = lu(477) - lu(50) * lu(469) + lu(499) = lu(499) - lu(51) * lu(469) + lu(503) = lu(503) - lu(52) * lu(469) + lu(53) = 1._r8 / lu(53) + lu(54) = lu(54) * lu(53) + lu(55) = lu(55) * lu(53) + lu(56) = lu(56) * lu(53) + lu(57) = lu(57) * lu(53) + lu(58) = lu(58) * lu(53) + lu(140) = lu(140) - lu(54) * lu(137) + lu(141) = lu(141) - lu(55) * lu(137) + lu(142) = lu(142) - lu(56) * lu(137) + lu(146) = - lu(57) * lu(137) + lu(150) = lu(150) - lu(58) * lu(137) + lu(219) = lu(219) - lu(54) * lu(216) + lu(220) = lu(220) - lu(55) * lu(216) + lu(221) = lu(221) - lu(56) * lu(216) + lu(225) = lu(225) - lu(57) * lu(216) + lu(230) = lu(230) - lu(58) * lu(216) + lu(476) = lu(476) - lu(54) * lu(470) + lu(477) = lu(477) - lu(55) * lu(470) + lu(479) = - lu(56) * lu(470) + lu(487) = lu(487) - lu(57) * lu(470) + lu(499) = lu(499) - lu(58) * lu(470) + lu(59) = 1._r8 / lu(59) + lu(60) = lu(60) * lu(59) + lu(61) = lu(61) * lu(59) + lu(62) = lu(62) * lu(59) + lu(63) = lu(63) * lu(59) + lu(96) = lu(96) - lu(60) * lu(90) + lu(97) = lu(97) - lu(61) * lu(90) + lu(99) = - lu(62) * lu(90) + lu(100) = - lu(63) * lu(90) + lu(131) = lu(131) - lu(60) * lu(128) + lu(132) = - lu(61) * lu(128) + lu(134) = - lu(62) * lu(128) + lu(135) = - lu(63) * lu(128) + lu(145) = lu(145) - lu(60) * lu(138) + lu(146) = lu(146) - lu(61) * lu(138) + lu(151) = lu(151) - lu(62) * lu(138) + lu(152) = lu(152) - lu(63) * lu(138) + lu(224) = lu(224) - lu(60) * lu(217) + lu(225) = lu(225) - lu(61) * lu(217) + lu(231) = lu(231) - lu(62) * lu(217) + lu(232) = lu(232) - lu(63) * lu(217) + lu(483) = lu(483) - lu(60) * lu(471) + lu(487) = lu(487) - lu(61) * lu(471) + lu(502) = - lu(62) * lu(471) + lu(503) = lu(503) - lu(63) * lu(471) + lu(64) = 1._r8 / lu(64) + lu(65) = lu(65) * lu(64) + lu(66) = lu(66) * lu(64) + lu(67) = lu(67) * lu(64) + lu(107) = - lu(65) * lu(101) + lu(108) = - lu(66) * lu(101) + lu(109) = - lu(67) * lu(101) + lu(252) = lu(252) - lu(65) * lu(246) + lu(255) = lu(255) - lu(66) * lu(246) + lu(257) = lu(257) - lu(67) * lu(246) + lu(349) = - lu(65) * lu(341) + lu(352) = lu(352) - lu(66) * lu(341) + lu(354) = - lu(67) * lu(341) + lu(423) = lu(423) - lu(65) * lu(413) + lu(426) = lu(426) - lu(66) * lu(413) + lu(428) = lu(428) - lu(67) * lu(413) + lu(454) = lu(454) - lu(65) * lu(440) + lu(457) = lu(457) - lu(66) * lu(440) + lu(459) = lu(459) - lu(67) * lu(440) + lu(493) = lu(493) - lu(65) * lu(472) + lu(496) = lu(496) - lu(66) * lu(472) + lu(498) = lu(498) - lu(67) * lu(472) + lu(513) = - lu(65) * lu(507) + lu(516) = lu(516) - lu(66) * lu(507) + lu(518) = lu(518) - lu(67) * lu(507) + lu(68) = 1._r8 / lu(68) + lu(69) = lu(69) * lu(68) + lu(70) = lu(70) * lu(68) + lu(71) = lu(71) * lu(68) + lu(72) = lu(72) * lu(68) + lu(73) = lu(73) * lu(68) + lu(74) = lu(74) * lu(68) + lu(75) = lu(75) * lu(68) + lu(280) = lu(280) - lu(69) * lu(279) + lu(281) = - lu(70) * lu(279) + lu(285) = lu(285) - lu(71) * lu(279) + lu(288) = lu(288) - lu(72) * lu(279) + lu(289) = lu(289) - lu(73) * lu(279) + lu(293) = lu(293) - lu(74) * lu(279) + lu(294) = - lu(75) * lu(279) + lu(365) = - lu(69) * lu(364) + lu(368) = lu(368) - lu(70) * lu(364) + lu(372) = lu(372) - lu(71) * lu(364) + lu(375) = - lu(72) * lu(364) + lu(376) = lu(376) - lu(73) * lu(364) + lu(380) = lu(380) - lu(74) * lu(364) + lu(381) = lu(381) - lu(75) * lu(364) + lu(478) = lu(478) - lu(69) * lu(473) + lu(486) = - lu(70) * lu(473) + lu(491) = lu(491) - lu(71) * lu(473) + lu(494) = lu(494) - lu(72) * lu(473) + lu(495) = lu(495) - lu(73) * lu(473) + lu(499) = lu(499) - lu(74) * lu(473) + lu(500) = lu(500) - lu(75) * lu(473) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(76) = 1._r8 / lu(76) + lu(77) = lu(77) * lu(76) + lu(78) = lu(78) * lu(76) + lu(79) = lu(79) * lu(76) + lu(80) = lu(80) * lu(76) + lu(81) = lu(81) * lu(76) + lu(82) = lu(82) * lu(76) + lu(394) = lu(394) - lu(77) * lu(389) + lu(402) = lu(402) - lu(78) * lu(389) + lu(403) = lu(403) - lu(79) * lu(389) + lu(404) = lu(404) - lu(80) * lu(389) + lu(405) = lu(405) - lu(81) * lu(389) + lu(407) = lu(407) - lu(82) * lu(389) + lu(419) = - lu(77) * lu(414) + lu(426) = lu(426) - lu(78) * lu(414) + lu(427) = lu(427) - lu(79) * lu(414) + lu(428) = lu(428) - lu(80) * lu(414) + lu(429) = - lu(81) * lu(414) + lu(431) = lu(431) - lu(82) * lu(414) + lu(449) = lu(449) - lu(77) * lu(441) + lu(457) = lu(457) - lu(78) * lu(441) + lu(458) = lu(458) - lu(79) * lu(441) + lu(459) = lu(459) - lu(80) * lu(441) + lu(460) = lu(460) - lu(81) * lu(441) + lu(462) = lu(462) - lu(82) * lu(441) + lu(488) = - lu(77) * lu(474) + lu(496) = lu(496) - lu(78) * lu(474) + lu(497) = lu(497) - lu(79) * lu(474) + lu(498) = lu(498) - lu(80) * lu(474) + lu(499) = lu(499) - lu(81) * lu(474) + lu(501) = lu(501) - lu(82) * lu(474) + lu(83) = 1._r8 / lu(83) + lu(84) = lu(84) * lu(83) + lu(85) = lu(85) * lu(83) + lu(86) = lu(86) * lu(83) + lu(87) = lu(87) * lu(83) + lu(88) = lu(88) * lu(83) + lu(89) = lu(89) * lu(83) + lu(141) = lu(141) - lu(84) * lu(139) + lu(142) = lu(142) - lu(85) * lu(139) + lu(143) = lu(143) - lu(86) * lu(139) + lu(145) = lu(145) - lu(87) * lu(139) + lu(146) = lu(146) - lu(88) * lu(139) + lu(150) = lu(150) - lu(89) * lu(139) + lu(170) = - lu(84) * lu(169) + lu(171) = lu(171) - lu(85) * lu(169) + lu(172) = lu(172) - lu(86) * lu(169) + lu(174) = lu(174) - lu(87) * lu(169) + lu(175) = lu(175) - lu(88) * lu(169) + lu(180) = lu(180) - lu(89) * lu(169) + lu(220) = lu(220) - lu(84) * lu(218) + lu(221) = lu(221) - lu(85) * lu(218) + lu(222) = lu(222) - lu(86) * lu(218) + lu(224) = lu(224) - lu(87) * lu(218) + lu(225) = lu(225) - lu(88) * lu(218) + lu(230) = lu(230) - lu(89) * lu(218) + lu(477) = lu(477) - lu(84) * lu(475) + lu(479) = lu(479) - lu(85) * lu(475) + lu(480) = lu(480) - lu(86) * lu(475) + lu(483) = lu(483) - lu(87) * lu(475) + lu(487) = lu(487) - lu(88) * lu(475) + lu(499) = lu(499) - lu(89) * lu(475) + lu(91) = 1._r8 / lu(91) + lu(92) = lu(92) * lu(91) + lu(93) = lu(93) * lu(91) + lu(94) = lu(94) * lu(91) + lu(95) = lu(95) * lu(91) + lu(96) = lu(96) * lu(91) + lu(97) = lu(97) * lu(91) + lu(98) = lu(98) * lu(91) + lu(99) = lu(99) * lu(91) + lu(100) = lu(100) * lu(91) + lu(141) = lu(141) - lu(92) * lu(140) + lu(142) = lu(142) - lu(93) * lu(140) + lu(143) = lu(143) - lu(94) * lu(140) + lu(144) = lu(144) - lu(95) * lu(140) + lu(145) = lu(145) - lu(96) * lu(140) + lu(146) = lu(146) - lu(97) * lu(140) + lu(150) = lu(150) - lu(98) * lu(140) + lu(151) = lu(151) - lu(99) * lu(140) + lu(152) = lu(152) - lu(100) * lu(140) + lu(220) = lu(220) - lu(92) * lu(219) + lu(221) = lu(221) - lu(93) * lu(219) + lu(222) = lu(222) - lu(94) * lu(219) + lu(223) = lu(223) - lu(95) * lu(219) + lu(224) = lu(224) - lu(96) * lu(219) + lu(225) = lu(225) - lu(97) * lu(219) + lu(230) = lu(230) - lu(98) * lu(219) + lu(231) = lu(231) - lu(99) * lu(219) + lu(232) = lu(232) - lu(100) * lu(219) + lu(477) = lu(477) - lu(92) * lu(476) + lu(479) = lu(479) - lu(93) * lu(476) + lu(480) = lu(480) - lu(94) * lu(476) + lu(481) = lu(481) - lu(95) * lu(476) + lu(483) = lu(483) - lu(96) * lu(476) + lu(487) = lu(487) - lu(97) * lu(476) + lu(499) = lu(499) - lu(98) * lu(476) + lu(502) = lu(502) - lu(99) * lu(476) + lu(503) = lu(503) - lu(100) * lu(476) + lu(102) = 1._r8 / lu(102) + lu(103) = lu(103) * lu(102) + lu(104) = lu(104) * lu(102) + lu(105) = lu(105) * lu(102) + lu(106) = lu(106) * lu(102) + lu(107) = lu(107) * lu(102) + lu(108) = lu(108) * lu(102) + lu(109) = lu(109) * lu(102) + lu(110) = lu(110) * lu(102) + lu(142) = lu(142) - lu(103) * lu(141) + lu(143) = lu(143) - lu(104) * lu(141) + lu(145) = lu(145) - lu(105) * lu(141) + lu(146) = lu(146) - lu(106) * lu(141) + lu(147) = - lu(107) * lu(141) + lu(148) = - lu(108) * lu(141) + lu(149) = - lu(109) * lu(141) + lu(150) = lu(150) - lu(110) * lu(141) + lu(171) = lu(171) - lu(103) * lu(170) + lu(172) = lu(172) - lu(104) * lu(170) + lu(174) = lu(174) - lu(105) * lu(170) + lu(175) = lu(175) - lu(106) * lu(170) + lu(176) = lu(176) - lu(107) * lu(170) + lu(178) = - lu(108) * lu(170) + lu(179) = lu(179) - lu(109) * lu(170) + lu(180) = lu(180) - lu(110) * lu(170) + lu(221) = lu(221) - lu(103) * lu(220) + lu(222) = lu(222) - lu(104) * lu(220) + lu(224) = lu(224) - lu(105) * lu(220) + lu(225) = lu(225) - lu(106) * lu(220) + lu(226) = lu(226) - lu(107) * lu(220) + lu(228) = lu(228) - lu(108) * lu(220) + lu(229) = - lu(109) * lu(220) + lu(230) = lu(230) - lu(110) * lu(220) + lu(479) = lu(479) - lu(103) * lu(477) + lu(480) = lu(480) - lu(104) * lu(477) + lu(483) = lu(483) - lu(105) * lu(477) + lu(487) = lu(487) - lu(106) * lu(477) + lu(493) = lu(493) - lu(107) * lu(477) + lu(496) = lu(496) - lu(108) * lu(477) + lu(498) = lu(498) - lu(109) * lu(477) + lu(499) = lu(499) - lu(110) * lu(477) + lu(112) = 1._r8 / lu(112) + lu(113) = lu(113) * lu(112) + lu(114) = lu(114) * lu(112) + lu(115) = lu(115) * lu(112) + lu(116) = lu(116) * lu(112) + lu(117) = lu(117) * lu(112) + lu(118) = lu(118) * lu(112) + lu(119) = lu(119) * lu(112) + lu(283) = - lu(113) * lu(280) + lu(285) = lu(285) - lu(114) * lu(280) + lu(288) = lu(288) - lu(115) * lu(280) + lu(291) = lu(291) - lu(116) * lu(280) + lu(292) = lu(292) - lu(117) * lu(280) + lu(293) = lu(293) - lu(118) * lu(280) + lu(295) = - lu(119) * lu(280) + lu(370) = lu(370) - lu(113) * lu(365) + lu(372) = lu(372) - lu(114) * lu(365) + lu(375) = lu(375) - lu(115) * lu(365) + lu(378) = - lu(116) * lu(365) + lu(379) = lu(379) - lu(117) * lu(365) + lu(380) = lu(380) - lu(118) * lu(365) + lu(382) = - lu(119) * lu(365) + lu(394) = lu(394) - lu(113) * lu(390) + lu(397) = lu(397) - lu(114) * lu(390) + lu(400) = lu(400) - lu(115) * lu(390) + lu(403) = lu(403) - lu(116) * lu(390) + lu(404) = lu(404) - lu(117) * lu(390) + lu(405) = lu(405) - lu(118) * lu(390) + lu(407) = lu(407) - lu(119) * lu(390) + lu(488) = lu(488) - lu(113) * lu(478) + lu(491) = lu(491) - lu(114) * lu(478) + lu(494) = lu(494) - lu(115) * lu(478) + lu(497) = lu(497) - lu(116) * lu(478) + lu(498) = lu(498) - lu(117) * lu(478) + lu(499) = lu(499) - lu(118) * lu(478) + lu(501) = lu(501) - lu(119) * lu(478) + lu(532) = lu(532) - lu(113) * lu(528) + lu(534) = - lu(114) * lu(528) + lu(537) = lu(537) - lu(115) * lu(528) + lu(540) = lu(540) - lu(116) * lu(528) + lu(541) = lu(541) - lu(117) * lu(528) + lu(542) = lu(542) - lu(118) * lu(528) + lu(544) = lu(544) - lu(119) * lu(528) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(120) = 1._r8 / lu(120) + lu(121) = lu(121) * lu(120) + lu(122) = lu(122) * lu(120) + lu(123) = lu(123) * lu(120) + lu(124) = lu(124) * lu(120) + lu(125) = lu(125) * lu(120) + lu(126) = lu(126) * lu(120) + lu(127) = lu(127) * lu(120) + lu(143) = lu(143) - lu(121) * lu(142) + lu(144) = lu(144) - lu(122) * lu(142) + lu(145) = lu(145) - lu(123) * lu(142) + lu(146) = lu(146) - lu(124) * lu(142) + lu(150) = lu(150) - lu(125) * lu(142) + lu(151) = lu(151) - lu(126) * lu(142) + lu(152) = lu(152) - lu(127) * lu(142) + lu(172) = lu(172) - lu(121) * lu(171) + lu(173) = lu(173) - lu(122) * lu(171) + lu(174) = lu(174) - lu(123) * lu(171) + lu(175) = lu(175) - lu(124) * lu(171) + lu(180) = lu(180) - lu(125) * lu(171) + lu(181) = - lu(126) * lu(171) + lu(182) = lu(182) - lu(127) * lu(171) + lu(222) = lu(222) - lu(121) * lu(221) + lu(223) = lu(223) - lu(122) * lu(221) + lu(224) = lu(224) - lu(123) * lu(221) + lu(225) = lu(225) - lu(124) * lu(221) + lu(230) = lu(230) - lu(125) * lu(221) + lu(231) = lu(231) - lu(126) * lu(221) + lu(232) = lu(232) - lu(127) * lu(221) + lu(480) = lu(480) - lu(121) * lu(479) + lu(481) = lu(481) - lu(122) * lu(479) + lu(483) = lu(483) - lu(123) * lu(479) + lu(487) = lu(487) - lu(124) * lu(479) + lu(499) = lu(499) - lu(125) * lu(479) + lu(502) = lu(502) - lu(126) * lu(479) + lu(503) = lu(503) - lu(127) * lu(479) + lu(573) = lu(573) - lu(121) * lu(572) + lu(574) = lu(574) - lu(122) * lu(572) + lu(575) = lu(575) - lu(123) * lu(572) + lu(576) = lu(576) - lu(124) * lu(572) + lu(587) = lu(587) - lu(125) * lu(572) + lu(590) = - lu(126) * lu(572) + lu(591) = lu(591) - lu(127) * lu(572) + lu(129) = 1._r8 / lu(129) + lu(130) = lu(130) * lu(129) + lu(131) = lu(131) * lu(129) + lu(132) = lu(132) * lu(129) + lu(133) = lu(133) * lu(129) + lu(134) = lu(134) * lu(129) + lu(135) = lu(135) * lu(129) + lu(144) = lu(144) - lu(130) * lu(143) + lu(145) = lu(145) - lu(131) * lu(143) + lu(146) = lu(146) - lu(132) * lu(143) + lu(150) = lu(150) - lu(133) * lu(143) + lu(151) = lu(151) - lu(134) * lu(143) + lu(152) = lu(152) - lu(135) * lu(143) + lu(173) = lu(173) - lu(130) * lu(172) + lu(174) = lu(174) - lu(131) * lu(172) + lu(175) = lu(175) - lu(132) * lu(172) + lu(180) = lu(180) - lu(133) * lu(172) + lu(181) = lu(181) - lu(134) * lu(172) + lu(182) = lu(182) - lu(135) * lu(172) + lu(223) = lu(223) - lu(130) * lu(222) + lu(224) = lu(224) - lu(131) * lu(222) + lu(225) = lu(225) - lu(132) * lu(222) + lu(230) = lu(230) - lu(133) * lu(222) + lu(231) = lu(231) - lu(134) * lu(222) + lu(232) = lu(232) - lu(135) * lu(222) + lu(481) = lu(481) - lu(130) * lu(480) + lu(483) = lu(483) - lu(131) * lu(480) + lu(487) = lu(487) - lu(132) * lu(480) + lu(499) = lu(499) - lu(133) * lu(480) + lu(502) = lu(502) - lu(134) * lu(480) + lu(503) = lu(503) - lu(135) * lu(480) + lu(574) = lu(574) - lu(130) * lu(573) + lu(575) = lu(575) - lu(131) * lu(573) + lu(576) = lu(576) - lu(132) * lu(573) + lu(587) = lu(587) - lu(133) * lu(573) + lu(590) = lu(590) - lu(134) * lu(573) + lu(591) = lu(591) - lu(135) * lu(573) + lu(144) = 1._r8 / lu(144) + lu(145) = lu(145) * lu(144) + lu(146) = lu(146) * lu(144) + lu(147) = lu(147) * lu(144) + lu(148) = lu(148) * lu(144) + lu(149) = lu(149) * lu(144) + lu(150) = lu(150) * lu(144) + lu(151) = lu(151) * lu(144) + lu(152) = lu(152) * lu(144) + lu(174) = lu(174) - lu(145) * lu(173) + lu(175) = lu(175) - lu(146) * lu(173) + lu(176) = lu(176) - lu(147) * lu(173) + lu(178) = lu(178) - lu(148) * lu(173) + lu(179) = lu(179) - lu(149) * lu(173) + lu(180) = lu(180) - lu(150) * lu(173) + lu(181) = lu(181) - lu(151) * lu(173) + lu(182) = lu(182) - lu(152) * lu(173) + lu(224) = lu(224) - lu(145) * lu(223) + lu(225) = lu(225) - lu(146) * lu(223) + lu(226) = lu(226) - lu(147) * lu(223) + lu(228) = lu(228) - lu(148) * lu(223) + lu(229) = lu(229) - lu(149) * lu(223) + lu(230) = lu(230) - lu(150) * lu(223) + lu(231) = lu(231) - lu(151) * lu(223) + lu(232) = lu(232) - lu(152) * lu(223) + lu(483) = lu(483) - lu(145) * lu(481) + lu(487) = lu(487) - lu(146) * lu(481) + lu(493) = lu(493) - lu(147) * lu(481) + lu(496) = lu(496) - lu(148) * lu(481) + lu(498) = lu(498) - lu(149) * lu(481) + lu(499) = lu(499) - lu(150) * lu(481) + lu(502) = lu(502) - lu(151) * lu(481) + lu(503) = lu(503) - lu(152) * lu(481) + lu(575) = lu(575) - lu(145) * lu(574) + lu(576) = lu(576) - lu(146) * lu(574) + lu(581) = - lu(147) * lu(574) + lu(584) = lu(584) - lu(148) * lu(574) + lu(586) = lu(586) - lu(149) * lu(574) + lu(587) = lu(587) - lu(150) * lu(574) + lu(590) = lu(590) - lu(151) * lu(574) + lu(591) = lu(591) - lu(152) * lu(574) + lu(154) = 1._r8 / lu(154) + lu(155) = lu(155) * lu(154) + lu(156) = lu(156) * lu(154) + lu(157) = lu(157) * lu(154) + lu(158) = lu(158) * lu(154) + lu(159) = lu(159) * lu(154) + lu(160) = lu(160) * lu(154) + lu(161) = lu(161) * lu(154) + lu(205) = lu(205) - lu(155) * lu(204) + lu(206) = lu(206) - lu(156) * lu(204) + lu(207) = - lu(157) * lu(204) + lu(208) = lu(208) - lu(158) * lu(204) + lu(210) = lu(210) - lu(159) * lu(204) + lu(211) = lu(211) - lu(160) * lu(204) + lu(212) = - lu(161) * lu(204) + lu(236) = - lu(155) * lu(235) + lu(237) = lu(237) - lu(156) * lu(235) + lu(238) = lu(238) - lu(157) * lu(235) + lu(239) = lu(239) - lu(158) * lu(235) + lu(241) = lu(241) - lu(159) * lu(235) + lu(243) = - lu(160) * lu(235) + lu(245) = - lu(161) * lu(235) + lu(265) = - lu(155) * lu(264) + lu(266) = lu(266) - lu(156) * lu(264) + lu(267) = lu(267) - lu(157) * lu(264) + lu(268) = lu(268) - lu(158) * lu(264) + lu(271) = lu(271) - lu(159) * lu(264) + lu(273) = - lu(160) * lu(264) + lu(276) = - lu(161) * lu(264) + lu(447) = lu(447) - lu(155) * lu(442) + lu(449) = lu(449) - lu(156) * lu(442) + lu(451) = lu(451) - lu(157) * lu(442) + lu(454) = lu(454) - lu(158) * lu(442) + lu(459) = lu(459) - lu(159) * lu(442) + lu(461) = lu(461) - lu(160) * lu(442) + lu(466) = lu(466) - lu(161) * lu(442) + lu(554) = - lu(155) * lu(552) + lu(556) = lu(556) - lu(156) * lu(552) + lu(558) = lu(558) - lu(157) * lu(552) + lu(559) = lu(559) - lu(158) * lu(552) + lu(564) = lu(564) - lu(159) * lu(552) + lu(566) = - lu(160) * lu(552) + lu(571) = lu(571) - lu(161) * lu(552) + lu(162) = 1._r8 / lu(162) + lu(163) = lu(163) * lu(162) + lu(164) = lu(164) * lu(162) + lu(165) = lu(165) * lu(162) + lu(166) = lu(166) * lu(162) + lu(167) = lu(167) * lu(162) + lu(168) = lu(168) * lu(162) + lu(249) = lu(249) - lu(163) * lu(247) + lu(252) = lu(252) - lu(164) * lu(247) + lu(253) = lu(253) - lu(165) * lu(247) + lu(257) = lu(257) - lu(166) * lu(247) + lu(258) = lu(258) - lu(167) * lu(247) + lu(261) = - lu(168) * lu(247) + lu(344) = - lu(163) * lu(342) + lu(349) = lu(349) - lu(164) * lu(342) + lu(350) = lu(350) - lu(165) * lu(342) + lu(354) = lu(354) - lu(166) * lu(342) + lu(355) = - lu(167) * lu(342) + lu(358) = - lu(168) * lu(342) + lu(394) = lu(394) - lu(163) * lu(391) + lu(399) = lu(399) - lu(164) * lu(391) + lu(400) = lu(400) - lu(165) * lu(391) + lu(404) = lu(404) - lu(166) * lu(391) + lu(405) = lu(405) - lu(167) * lu(391) + lu(408) = - lu(168) * lu(391) + lu(449) = lu(449) - lu(163) * lu(443) + lu(454) = lu(454) - lu(164) * lu(443) + lu(455) = lu(455) - lu(165) * lu(443) + lu(459) = lu(459) - lu(166) * lu(443) + lu(460) = lu(460) - lu(167) * lu(443) + lu(463) = lu(463) - lu(168) * lu(443) + lu(488) = lu(488) - lu(163) * lu(482) + lu(493) = lu(493) - lu(164) * lu(482) + lu(494) = lu(494) - lu(165) * lu(482) + lu(498) = lu(498) - lu(166) * lu(482) + lu(499) = lu(499) - lu(167) * lu(482) + lu(502) = lu(502) - lu(168) * lu(482) + lu(556) = lu(556) - lu(163) * lu(553) + lu(559) = lu(559) - lu(164) * lu(553) + lu(560) = lu(560) - lu(165) * lu(553) + lu(564) = lu(564) - lu(166) * lu(553) + lu(565) = lu(565) - lu(167) * lu(553) + lu(568) = lu(568) - lu(168) * lu(553) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(174) = 1._r8 / lu(174) + lu(175) = lu(175) * lu(174) + lu(176) = lu(176) * lu(174) + lu(177) = lu(177) * lu(174) + lu(178) = lu(178) * lu(174) + lu(179) = lu(179) * lu(174) + lu(180) = lu(180) * lu(174) + lu(181) = lu(181) * lu(174) + lu(182) = lu(182) * lu(174) + lu(225) = lu(225) - lu(175) * lu(224) + lu(226) = lu(226) - lu(176) * lu(224) + lu(227) = - lu(177) * lu(224) + lu(228) = lu(228) - lu(178) * lu(224) + lu(229) = lu(229) - lu(179) * lu(224) + lu(230) = lu(230) - lu(180) * lu(224) + lu(231) = lu(231) - lu(181) * lu(224) + lu(232) = lu(232) - lu(182) * lu(224) + lu(369) = lu(369) - lu(175) * lu(366) + lu(374) = - lu(176) * lu(366) + lu(376) = lu(376) - lu(177) * lu(366) + lu(377) = lu(377) - lu(178) * lu(366) + lu(379) = lu(379) - lu(179) * lu(366) + lu(380) = lu(380) - lu(180) * lu(366) + lu(383) = - lu(181) * lu(366) + lu(384) = lu(384) - lu(182) * lu(366) + lu(448) = lu(448) - lu(175) * lu(444) + lu(454) = lu(454) - lu(176) * lu(444) + lu(456) = lu(456) - lu(177) * lu(444) + lu(457) = lu(457) - lu(178) * lu(444) + lu(459) = lu(459) - lu(179) * lu(444) + lu(460) = lu(460) - lu(180) * lu(444) + lu(463) = lu(463) - lu(181) * lu(444) + lu(464) = lu(464) - lu(182) * lu(444) + lu(487) = lu(487) - lu(175) * lu(483) + lu(493) = lu(493) - lu(176) * lu(483) + lu(495) = lu(495) - lu(177) * lu(483) + lu(496) = lu(496) - lu(178) * lu(483) + lu(498) = lu(498) - lu(179) * lu(483) + lu(499) = lu(499) - lu(180) * lu(483) + lu(502) = lu(502) - lu(181) * lu(483) + lu(503) = lu(503) - lu(182) * lu(483) + lu(576) = lu(576) - lu(175) * lu(575) + lu(581) = lu(581) - lu(176) * lu(575) + lu(583) = lu(583) - lu(177) * lu(575) + lu(584) = lu(584) - lu(178) * lu(575) + lu(586) = lu(586) - lu(179) * lu(575) + lu(587) = lu(587) - lu(180) * lu(575) + lu(590) = lu(590) - lu(181) * lu(575) + lu(591) = lu(591) - lu(182) * lu(575) + lu(184) = 1._r8 / lu(184) + lu(185) = lu(185) * lu(184) + lu(186) = lu(186) * lu(184) + lu(187) = lu(187) * lu(184) + lu(188) = lu(188) * lu(184) + lu(189) = lu(189) * lu(184) + lu(190) = lu(190) * lu(184) + lu(195) = - lu(185) * lu(192) + lu(196) = lu(196) - lu(186) * lu(192) + lu(198) = lu(198) - lu(187) * lu(192) + lu(199) = lu(199) - lu(188) * lu(192) + lu(200) = lu(200) - lu(189) * lu(192) + lu(202) = lu(202) - lu(190) * lu(192) + lu(308) = - lu(185) * lu(304) + lu(312) = lu(312) - lu(186) * lu(304) + lu(317) = lu(317) - lu(187) * lu(304) + lu(318) = lu(318) - lu(188) * lu(304) + lu(319) = lu(319) - lu(189) * lu(304) + lu(321) = lu(321) - lu(190) * lu(304) + lu(394) = lu(394) - lu(185) * lu(392) + lu(398) = lu(398) - lu(186) * lu(392) + lu(403) = lu(403) - lu(187) * lu(392) + lu(404) = lu(404) - lu(188) * lu(392) + lu(405) = lu(405) - lu(189) * lu(392) + lu(407) = lu(407) - lu(190) * lu(392) + lu(419) = lu(419) - lu(185) * lu(415) + lu(422) = lu(422) - lu(186) * lu(415) + lu(427) = lu(427) - lu(187) * lu(415) + lu(428) = lu(428) - lu(188) * lu(415) + lu(429) = lu(429) - lu(189) * lu(415) + lu(431) = lu(431) - lu(190) * lu(415) + lu(449) = lu(449) - lu(185) * lu(445) + lu(453) = lu(453) - lu(186) * lu(445) + lu(458) = lu(458) - lu(187) * lu(445) + lu(459) = lu(459) - lu(188) * lu(445) + lu(460) = lu(460) - lu(189) * lu(445) + lu(462) = lu(462) - lu(190) * lu(445) + lu(488) = lu(488) - lu(185) * lu(484) + lu(492) = lu(492) - lu(186) * lu(484) + lu(497) = lu(497) - lu(187) * lu(484) + lu(498) = lu(498) - lu(188) * lu(484) + lu(499) = lu(499) - lu(189) * lu(484) + lu(501) = lu(501) - lu(190) * lu(484) + lu(532) = lu(532) - lu(185) * lu(529) + lu(535) = - lu(186) * lu(529) + lu(540) = lu(540) - lu(187) * lu(529) + lu(541) = lu(541) - lu(188) * lu(529) + lu(542) = lu(542) - lu(189) * lu(529) + lu(544) = lu(544) - lu(190) * lu(529) + lu(193) = 1._r8 / lu(193) + lu(194) = lu(194) * lu(193) + lu(195) = lu(195) * lu(193) + lu(196) = lu(196) * lu(193) + lu(197) = lu(197) * lu(193) + lu(198) = lu(198) * lu(193) + lu(199) = lu(199) * lu(193) + lu(200) = lu(200) * lu(193) + lu(201) = lu(201) * lu(193) + lu(202) = lu(202) * lu(193) + lu(306) = - lu(194) * lu(305) + lu(308) = lu(308) - lu(195) * lu(305) + lu(312) = lu(312) - lu(196) * lu(305) + lu(315) = lu(315) - lu(197) * lu(305) + lu(317) = lu(317) - lu(198) * lu(305) + lu(318) = lu(318) - lu(199) * lu(305) + lu(319) = lu(319) - lu(200) * lu(305) + lu(320) = - lu(201) * lu(305) + lu(321) = lu(321) - lu(202) * lu(305) + lu(368) = lu(368) - lu(194) * lu(367) + lu(370) = lu(370) - lu(195) * lu(367) + lu(373) = lu(373) - lu(196) * lu(367) + lu(376) = lu(376) - lu(197) * lu(367) + lu(378) = lu(378) - lu(198) * lu(367) + lu(379) = lu(379) - lu(199) * lu(367) + lu(380) = lu(380) - lu(200) * lu(367) + lu(381) = lu(381) - lu(201) * lu(367) + lu(382) = lu(382) - lu(202) * lu(367) + lu(417) = - lu(194) * lu(416) + lu(419) = lu(419) - lu(195) * lu(416) + lu(422) = lu(422) - lu(196) * lu(416) + lu(425) = - lu(197) * lu(416) + lu(427) = lu(427) - lu(198) * lu(416) + lu(428) = lu(428) - lu(199) * lu(416) + lu(429) = lu(429) - lu(200) * lu(416) + lu(430) = lu(430) - lu(201) * lu(416) + lu(431) = lu(431) - lu(202) * lu(416) + lu(447) = lu(447) - lu(194) * lu(446) + lu(449) = lu(449) - lu(195) * lu(446) + lu(453) = lu(453) - lu(196) * lu(446) + lu(456) = lu(456) - lu(197) * lu(446) + lu(458) = lu(458) - lu(198) * lu(446) + lu(459) = lu(459) - lu(199) * lu(446) + lu(460) = lu(460) - lu(200) * lu(446) + lu(461) = lu(461) - lu(201) * lu(446) + lu(462) = lu(462) - lu(202) * lu(446) + lu(486) = lu(486) - lu(194) * lu(485) + lu(488) = lu(488) - lu(195) * lu(485) + lu(492) = lu(492) - lu(196) * lu(485) + lu(495) = lu(495) - lu(197) * lu(485) + lu(497) = lu(497) - lu(198) * lu(485) + lu(498) = lu(498) - lu(199) * lu(485) + lu(499) = lu(499) - lu(200) * lu(485) + lu(500) = lu(500) - lu(201) * lu(485) + lu(501) = lu(501) - lu(202) * lu(485) + lu(531) = lu(531) - lu(194) * lu(530) + lu(532) = lu(532) - lu(195) * lu(530) + lu(535) = lu(535) - lu(196) * lu(530) + lu(538) = - lu(197) * lu(530) + lu(540) = lu(540) - lu(198) * lu(530) + lu(541) = lu(541) - lu(199) * lu(530) + lu(542) = lu(542) - lu(200) * lu(530) + lu(543) = - lu(201) * lu(530) + lu(544) = lu(544) - lu(202) * lu(530) + lu(205) = 1._r8 / lu(205) + lu(206) = lu(206) * lu(205) + lu(207) = lu(207) * lu(205) + lu(208) = lu(208) * lu(205) + lu(209) = lu(209) * lu(205) + lu(210) = lu(210) * lu(205) + lu(211) = lu(211) * lu(205) + lu(212) = lu(212) * lu(205) + lu(237) = lu(237) - lu(206) * lu(236) + lu(238) = lu(238) - lu(207) * lu(236) + lu(239) = lu(239) - lu(208) * lu(236) + lu(240) = - lu(209) * lu(236) + lu(241) = lu(241) - lu(210) * lu(236) + lu(243) = lu(243) - lu(211) * lu(236) + lu(245) = lu(245) - lu(212) * lu(236) + lu(249) = lu(249) - lu(206) * lu(248) + lu(251) = lu(251) - lu(207) * lu(248) + lu(252) = lu(252) - lu(208) * lu(248) + lu(254) = - lu(209) * lu(248) + lu(257) = lu(257) - lu(210) * lu(248) + lu(259) = lu(259) - lu(211) * lu(248) + lu(262) = - lu(212) * lu(248) + lu(266) = lu(266) - lu(206) * lu(265) + lu(267) = lu(267) - lu(207) * lu(265) + lu(268) = lu(268) - lu(208) * lu(265) + lu(269) = - lu(209) * lu(265) + lu(271) = lu(271) - lu(210) * lu(265) + lu(273) = lu(273) - lu(211) * lu(265) + lu(276) = lu(276) - lu(212) * lu(265) + lu(283) = lu(283) - lu(206) * lu(281) + lu(284) = - lu(207) * lu(281) + lu(287) = - lu(208) * lu(281) + lu(289) = lu(289) - lu(209) * lu(281) + lu(292) = lu(292) - lu(210) * lu(281) + lu(294) = lu(294) - lu(211) * lu(281) + lu(299) = - lu(212) * lu(281) + lu(308) = lu(308) - lu(206) * lu(306) + lu(310) = - lu(207) * lu(306) + lu(313) = - lu(208) * lu(306) + lu(315) = lu(315) - lu(209) * lu(306) + lu(318) = lu(318) - lu(210) * lu(306) + lu(320) = lu(320) - lu(211) * lu(306) + lu(325) = lu(325) - lu(212) * lu(306) + lu(370) = lu(370) - lu(206) * lu(368) + lu(371) = - lu(207) * lu(368) + lu(374) = lu(374) - lu(208) * lu(368) + lu(376) = lu(376) - lu(209) * lu(368) + lu(379) = lu(379) - lu(210) * lu(368) + lu(381) = lu(381) - lu(211) * lu(368) + lu(386) = - lu(212) * lu(368) + lu(419) = lu(419) - lu(206) * lu(417) + lu(421) = lu(421) - lu(207) * lu(417) + lu(423) = lu(423) - lu(208) * lu(417) + lu(425) = lu(425) - lu(209) * lu(417) + lu(428) = lu(428) - lu(210) * lu(417) + lu(430) = lu(430) - lu(211) * lu(417) + lu(435) = lu(435) - lu(212) * lu(417) + lu(449) = lu(449) - lu(206) * lu(447) + lu(451) = lu(451) - lu(207) * lu(447) + lu(454) = lu(454) - lu(208) * lu(447) + lu(456) = lu(456) - lu(209) * lu(447) + lu(459) = lu(459) - lu(210) * lu(447) + lu(461) = lu(461) - lu(211) * lu(447) + lu(466) = lu(466) - lu(212) * lu(447) + lu(488) = lu(488) - lu(206) * lu(486) + lu(490) = lu(490) - lu(207) * lu(486) + lu(493) = lu(493) - lu(208) * lu(486) + lu(495) = lu(495) - lu(209) * lu(486) + lu(498) = lu(498) - lu(210) * lu(486) + lu(500) = lu(500) - lu(211) * lu(486) + lu(505) = - lu(212) * lu(486) + lu(510) = - lu(206) * lu(508) + lu(512) = - lu(207) * lu(508) + lu(513) = lu(513) - lu(208) * lu(508) + lu(515) = lu(515) - lu(209) * lu(508) + lu(518) = lu(518) - lu(210) * lu(508) + lu(520) = lu(520) - lu(211) * lu(508) + lu(525) = - lu(212) * lu(508) + lu(532) = lu(532) - lu(206) * lu(531) + lu(533) = - lu(207) * lu(531) + lu(536) = lu(536) - lu(208) * lu(531) + lu(538) = lu(538) - lu(209) * lu(531) + lu(541) = lu(541) - lu(210) * lu(531) + lu(543) = lu(543) - lu(211) * lu(531) + lu(548) = - lu(212) * lu(531) + lu(556) = lu(556) - lu(206) * lu(554) + lu(558) = lu(558) - lu(207) * lu(554) + lu(559) = lu(559) - lu(208) * lu(554) + lu(561) = - lu(209) * lu(554) + lu(564) = lu(564) - lu(210) * lu(554) + lu(566) = lu(566) - lu(211) * lu(554) + lu(571) = lu(571) - lu(212) * lu(554) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(225) = 1._r8 / lu(225) + lu(226) = lu(226) * lu(225) + lu(227) = lu(227) * lu(225) + lu(228) = lu(228) * lu(225) + lu(229) = lu(229) * lu(225) + lu(230) = lu(230) * lu(225) + lu(231) = lu(231) * lu(225) + lu(232) = lu(232) * lu(225) + lu(233) = lu(233) * lu(225) + lu(287) = lu(287) - lu(226) * lu(282) + lu(289) = lu(289) - lu(227) * lu(282) + lu(290) = lu(290) - lu(228) * lu(282) + lu(292) = lu(292) - lu(229) * lu(282) + lu(293) = lu(293) - lu(230) * lu(282) + lu(296) = - lu(231) * lu(282) + lu(297) = lu(297) - lu(232) * lu(282) + lu(298) = - lu(233) * lu(282) + lu(313) = lu(313) - lu(226) * lu(307) + lu(315) = lu(315) - lu(227) * lu(307) + lu(316) = lu(316) - lu(228) * lu(307) + lu(318) = lu(318) - lu(229) * lu(307) + lu(319) = lu(319) - lu(230) * lu(307) + lu(322) = - lu(231) * lu(307) + lu(323) = lu(323) - lu(232) * lu(307) + lu(324) = - lu(233) * lu(307) + lu(329) = lu(329) - lu(226) * lu(326) + lu(330) = - lu(227) * lu(326) + lu(331) = lu(331) - lu(228) * lu(326) + lu(333) = lu(333) - lu(229) * lu(326) + lu(334) = lu(334) - lu(230) * lu(326) + lu(337) = - lu(231) * lu(326) + lu(338) = - lu(232) * lu(326) + lu(339) = lu(339) - lu(233) * lu(326) + lu(349) = lu(349) - lu(226) * lu(343) + lu(351) = - lu(227) * lu(343) + lu(352) = lu(352) - lu(228) * lu(343) + lu(354) = lu(354) - lu(229) * lu(343) + lu(355) = lu(355) - lu(230) * lu(343) + lu(358) = lu(358) - lu(231) * lu(343) + lu(359) = - lu(232) * lu(343) + lu(360) = lu(360) - lu(233) * lu(343) + lu(374) = lu(374) - lu(226) * lu(369) + lu(376) = lu(376) - lu(227) * lu(369) + lu(377) = lu(377) - lu(228) * lu(369) + lu(379) = lu(379) - lu(229) * lu(369) + lu(380) = lu(380) - lu(230) * lu(369) + lu(383) = lu(383) - lu(231) * lu(369) + lu(384) = lu(384) - lu(232) * lu(369) + lu(385) = lu(385) - lu(233) * lu(369) + lu(399) = lu(399) - lu(226) * lu(393) + lu(401) = lu(401) - lu(227) * lu(393) + lu(402) = lu(402) - lu(228) * lu(393) + lu(404) = lu(404) - lu(229) * lu(393) + lu(405) = lu(405) - lu(230) * lu(393) + lu(408) = lu(408) - lu(231) * lu(393) + lu(409) = lu(409) - lu(232) * lu(393) + lu(410) = lu(410) - lu(233) * lu(393) + lu(423) = lu(423) - lu(226) * lu(418) + lu(425) = lu(425) - lu(227) * lu(418) + lu(426) = lu(426) - lu(228) * lu(418) + lu(428) = lu(428) - lu(229) * lu(418) + lu(429) = lu(429) - lu(230) * lu(418) + lu(432) = - lu(231) * lu(418) + lu(433) = - lu(232) * lu(418) + lu(434) = lu(434) - lu(233) * lu(418) + lu(454) = lu(454) - lu(226) * lu(448) + lu(456) = lu(456) - lu(227) * lu(448) + lu(457) = lu(457) - lu(228) * lu(448) + lu(459) = lu(459) - lu(229) * lu(448) + lu(460) = lu(460) - lu(230) * lu(448) + lu(463) = lu(463) - lu(231) * lu(448) + lu(464) = lu(464) - lu(232) * lu(448) + lu(465) = lu(465) - lu(233) * lu(448) + lu(493) = lu(493) - lu(226) * lu(487) + lu(495) = lu(495) - lu(227) * lu(487) + lu(496) = lu(496) - lu(228) * lu(487) + lu(498) = lu(498) - lu(229) * lu(487) + lu(499) = lu(499) - lu(230) * lu(487) + lu(502) = lu(502) - lu(231) * lu(487) + lu(503) = lu(503) - lu(232) * lu(487) + lu(504) = lu(504) - lu(233) * lu(487) + lu(513) = lu(513) - lu(226) * lu(509) + lu(515) = lu(515) - lu(227) * lu(509) + lu(516) = lu(516) - lu(228) * lu(509) + lu(518) = lu(518) - lu(229) * lu(509) + lu(519) = lu(519) - lu(230) * lu(509) + lu(522) = - lu(231) * lu(509) + lu(523) = lu(523) - lu(232) * lu(509) + lu(524) = - lu(233) * lu(509) + lu(559) = lu(559) - lu(226) * lu(555) + lu(561) = lu(561) - lu(227) * lu(555) + lu(562) = lu(562) - lu(228) * lu(555) + lu(564) = lu(564) - lu(229) * lu(555) + lu(565) = lu(565) - lu(230) * lu(555) + lu(568) = lu(568) - lu(231) * lu(555) + lu(569) = lu(569) - lu(232) * lu(555) + lu(570) = lu(570) - lu(233) * lu(555) + lu(581) = lu(581) - lu(226) * lu(576) + lu(583) = lu(583) - lu(227) * lu(576) + lu(584) = lu(584) - lu(228) * lu(576) + lu(586) = lu(586) - lu(229) * lu(576) + lu(587) = lu(587) - lu(230) * lu(576) + lu(590) = lu(590) - lu(231) * lu(576) + lu(591) = lu(591) - lu(232) * lu(576) + lu(592) = lu(592) - lu(233) * lu(576) + lu(599) = lu(599) - lu(226) * lu(596) + lu(601) = lu(601) - lu(227) * lu(596) + lu(602) = lu(602) - lu(228) * lu(596) + lu(604) = lu(604) - lu(229) * lu(596) + lu(605) = lu(605) - lu(230) * lu(596) + lu(608) = lu(608) - lu(231) * lu(596) + lu(609) = lu(609) - lu(232) * lu(596) + lu(610) = lu(610) - lu(233) * lu(596) + lu(618) = lu(618) - lu(226) * lu(613) + lu(620) = lu(620) - lu(227) * lu(613) + lu(621) = lu(621) - lu(228) * lu(613) + lu(623) = lu(623) - lu(229) * lu(613) + lu(624) = - lu(230) * lu(613) + lu(627) = - lu(231) * lu(613) + lu(628) = lu(628) - lu(232) * lu(613) + lu(629) = - lu(233) * lu(613) + lu(237) = 1._r8 / lu(237) + lu(238) = lu(238) * lu(237) + lu(239) = lu(239) * lu(237) + lu(240) = lu(240) * lu(237) + lu(241) = lu(241) * lu(237) + lu(242) = lu(242) * lu(237) + lu(243) = lu(243) * lu(237) + lu(244) = lu(244) * lu(237) + lu(245) = lu(245) * lu(237) + lu(251) = lu(251) - lu(238) * lu(249) + lu(252) = lu(252) - lu(239) * lu(249) + lu(254) = lu(254) - lu(240) * lu(249) + lu(257) = lu(257) - lu(241) * lu(249) + lu(258) = lu(258) - lu(242) * lu(249) + lu(259) = lu(259) - lu(243) * lu(249) + lu(261) = lu(261) - lu(244) * lu(249) + lu(262) = lu(262) - lu(245) * lu(249) + lu(267) = lu(267) - lu(238) * lu(266) + lu(268) = lu(268) - lu(239) * lu(266) + lu(269) = lu(269) - lu(240) * lu(266) + lu(271) = lu(271) - lu(241) * lu(266) + lu(272) = lu(272) - lu(242) * lu(266) + lu(273) = lu(273) - lu(243) * lu(266) + lu(275) = lu(275) - lu(244) * lu(266) + lu(276) = lu(276) - lu(245) * lu(266) + lu(284) = lu(284) - lu(238) * lu(283) + lu(287) = lu(287) - lu(239) * lu(283) + lu(289) = lu(289) - lu(240) * lu(283) + lu(292) = lu(292) - lu(241) * lu(283) + lu(293) = lu(293) - lu(242) * lu(283) + lu(294) = lu(294) - lu(243) * lu(283) + lu(296) = lu(296) - lu(244) * lu(283) + lu(299) = lu(299) - lu(245) * lu(283) + lu(310) = lu(310) - lu(238) * lu(308) + lu(313) = lu(313) - lu(239) * lu(308) + lu(315) = lu(315) - lu(240) * lu(308) + lu(318) = lu(318) - lu(241) * lu(308) + lu(319) = lu(319) - lu(242) * lu(308) + lu(320) = lu(320) - lu(243) * lu(308) + lu(322) = lu(322) - lu(244) * lu(308) + lu(325) = lu(325) - lu(245) * lu(308) + lu(328) = lu(328) - lu(238) * lu(327) + lu(329) = lu(329) - lu(239) * lu(327) + lu(330) = lu(330) - lu(240) * lu(327) + lu(333) = lu(333) - lu(241) * lu(327) + lu(334) = lu(334) - lu(242) * lu(327) + lu(335) = - lu(243) * lu(327) + lu(337) = lu(337) - lu(244) * lu(327) + lu(340) = - lu(245) * lu(327) + lu(346) = - lu(238) * lu(344) + lu(349) = lu(349) - lu(239) * lu(344) + lu(351) = lu(351) - lu(240) * lu(344) + lu(354) = lu(354) - lu(241) * lu(344) + lu(355) = lu(355) - lu(242) * lu(344) + lu(356) = - lu(243) * lu(344) + lu(358) = lu(358) - lu(244) * lu(344) + lu(361) = - lu(245) * lu(344) + lu(371) = lu(371) - lu(238) * lu(370) + lu(374) = lu(374) - lu(239) * lu(370) + lu(376) = lu(376) - lu(240) * lu(370) + lu(379) = lu(379) - lu(241) * lu(370) + lu(380) = lu(380) - lu(242) * lu(370) + lu(381) = lu(381) - lu(243) * lu(370) + lu(383) = lu(383) - lu(244) * lu(370) + lu(386) = lu(386) - lu(245) * lu(370) + lu(396) = lu(396) - lu(238) * lu(394) + lu(399) = lu(399) - lu(239) * lu(394) + lu(401) = lu(401) - lu(240) * lu(394) + lu(404) = lu(404) - lu(241) * lu(394) + lu(405) = lu(405) - lu(242) * lu(394) + lu(406) = lu(406) - lu(243) * lu(394) + lu(408) = lu(408) - lu(244) * lu(394) + lu(411) = lu(411) - lu(245) * lu(394) + lu(421) = lu(421) - lu(238) * lu(419) + lu(423) = lu(423) - lu(239) * lu(419) + lu(425) = lu(425) - lu(240) * lu(419) + lu(428) = lu(428) - lu(241) * lu(419) + lu(429) = lu(429) - lu(242) * lu(419) + lu(430) = lu(430) - lu(243) * lu(419) + lu(432) = lu(432) - lu(244) * lu(419) + lu(435) = lu(435) - lu(245) * lu(419) + lu(451) = lu(451) - lu(238) * lu(449) + lu(454) = lu(454) - lu(239) * lu(449) + lu(456) = lu(456) - lu(240) * lu(449) + lu(459) = lu(459) - lu(241) * lu(449) + lu(460) = lu(460) - lu(242) * lu(449) + lu(461) = lu(461) - lu(243) * lu(449) + lu(463) = lu(463) - lu(244) * lu(449) + lu(466) = lu(466) - lu(245) * lu(449) + lu(490) = lu(490) - lu(238) * lu(488) + lu(493) = lu(493) - lu(239) * lu(488) + lu(495) = lu(495) - lu(240) * lu(488) + lu(498) = lu(498) - lu(241) * lu(488) + lu(499) = lu(499) - lu(242) * lu(488) + lu(500) = lu(500) - lu(243) * lu(488) + lu(502) = lu(502) - lu(244) * lu(488) + lu(505) = lu(505) - lu(245) * lu(488) + lu(512) = lu(512) - lu(238) * lu(510) + lu(513) = lu(513) - lu(239) * lu(510) + lu(515) = lu(515) - lu(240) * lu(510) + lu(518) = lu(518) - lu(241) * lu(510) + lu(519) = lu(519) - lu(242) * lu(510) + lu(520) = lu(520) - lu(243) * lu(510) + lu(522) = lu(522) - lu(244) * lu(510) + lu(525) = lu(525) - lu(245) * lu(510) + lu(533) = lu(533) - lu(238) * lu(532) + lu(536) = lu(536) - lu(239) * lu(532) + lu(538) = lu(538) - lu(240) * lu(532) + lu(541) = lu(541) - lu(241) * lu(532) + lu(542) = lu(542) - lu(242) * lu(532) + lu(543) = lu(543) - lu(243) * lu(532) + lu(545) = lu(545) - lu(244) * lu(532) + lu(548) = lu(548) - lu(245) * lu(532) + lu(558) = lu(558) - lu(238) * lu(556) + lu(559) = lu(559) - lu(239) * lu(556) + lu(561) = lu(561) - lu(240) * lu(556) + lu(564) = lu(564) - lu(241) * lu(556) + lu(565) = lu(565) - lu(242) * lu(556) + lu(566) = lu(566) - lu(243) * lu(556) + lu(568) = lu(568) - lu(244) * lu(556) + lu(571) = lu(571) - lu(245) * lu(556) + lu(616) = - lu(238) * lu(614) + lu(618) = lu(618) - lu(239) * lu(614) + lu(620) = lu(620) - lu(240) * lu(614) + lu(623) = lu(623) - lu(241) * lu(614) + lu(624) = lu(624) - lu(242) * lu(614) + lu(625) = - lu(243) * lu(614) + lu(627) = lu(627) - lu(244) * lu(614) + lu(630) = lu(630) - lu(245) * lu(614) + lu(250) = 1._r8 / lu(250) + lu(251) = lu(251) * lu(250) + lu(252) = lu(252) * lu(250) + lu(253) = lu(253) * lu(250) + lu(254) = lu(254) * lu(250) + lu(255) = lu(255) * lu(250) + lu(256) = lu(256) * lu(250) + lu(257) = lu(257) * lu(250) + lu(258) = lu(258) * lu(250) + lu(259) = lu(259) * lu(250) + lu(260) = lu(260) * lu(250) + lu(261) = lu(261) * lu(250) + lu(262) = lu(262) * lu(250) + lu(310) = lu(310) - lu(251) * lu(309) + lu(313) = lu(313) - lu(252) * lu(309) + lu(314) = lu(314) - lu(253) * lu(309) + lu(315) = lu(315) - lu(254) * lu(309) + lu(316) = lu(316) - lu(255) * lu(309) + lu(317) = lu(317) - lu(256) * lu(309) + lu(318) = lu(318) - lu(257) * lu(309) + lu(319) = lu(319) - lu(258) * lu(309) + lu(320) = lu(320) - lu(259) * lu(309) + lu(321) = lu(321) - lu(260) * lu(309) + lu(322) = lu(322) - lu(261) * lu(309) + lu(325) = lu(325) - lu(262) * lu(309) + lu(346) = lu(346) - lu(251) * lu(345) + lu(349) = lu(349) - lu(252) * lu(345) + lu(350) = lu(350) - lu(253) * lu(345) + lu(351) = lu(351) - lu(254) * lu(345) + lu(352) = lu(352) - lu(255) * lu(345) + lu(353) = - lu(256) * lu(345) + lu(354) = lu(354) - lu(257) * lu(345) + lu(355) = lu(355) - lu(258) * lu(345) + lu(356) = lu(356) - lu(259) * lu(345) + lu(357) = - lu(260) * lu(345) + lu(358) = lu(358) - lu(261) * lu(345) + lu(361) = lu(361) - lu(262) * lu(345) + lu(396) = lu(396) - lu(251) * lu(395) + lu(399) = lu(399) - lu(252) * lu(395) + lu(400) = lu(400) - lu(253) * lu(395) + lu(401) = lu(401) - lu(254) * lu(395) + lu(402) = lu(402) - lu(255) * lu(395) + lu(403) = lu(403) - lu(256) * lu(395) + lu(404) = lu(404) - lu(257) * lu(395) + lu(405) = lu(405) - lu(258) * lu(395) + lu(406) = lu(406) - lu(259) * lu(395) + lu(407) = lu(407) - lu(260) * lu(395) + lu(408) = lu(408) - lu(261) * lu(395) + lu(411) = lu(411) - lu(262) * lu(395) + lu(421) = lu(421) - lu(251) * lu(420) + lu(423) = lu(423) - lu(252) * lu(420) + lu(424) = lu(424) - lu(253) * lu(420) + lu(425) = lu(425) - lu(254) * lu(420) + lu(426) = lu(426) - lu(255) * lu(420) + lu(427) = lu(427) - lu(256) * lu(420) + lu(428) = lu(428) - lu(257) * lu(420) + lu(429) = lu(429) - lu(258) * lu(420) + lu(430) = lu(430) - lu(259) * lu(420) + lu(431) = lu(431) - lu(260) * lu(420) + lu(432) = lu(432) - lu(261) * lu(420) + lu(435) = lu(435) - lu(262) * lu(420) + lu(451) = lu(451) - lu(251) * lu(450) + lu(454) = lu(454) - lu(252) * lu(450) + lu(455) = lu(455) - lu(253) * lu(450) + lu(456) = lu(456) - lu(254) * lu(450) + lu(457) = lu(457) - lu(255) * lu(450) + lu(458) = lu(458) - lu(256) * lu(450) + lu(459) = lu(459) - lu(257) * lu(450) + lu(460) = lu(460) - lu(258) * lu(450) + lu(461) = lu(461) - lu(259) * lu(450) + lu(462) = lu(462) - lu(260) * lu(450) + lu(463) = lu(463) - lu(261) * lu(450) + lu(466) = lu(466) - lu(262) * lu(450) + lu(490) = lu(490) - lu(251) * lu(489) + lu(493) = lu(493) - lu(252) * lu(489) + lu(494) = lu(494) - lu(253) * lu(489) + lu(495) = lu(495) - lu(254) * lu(489) + lu(496) = lu(496) - lu(255) * lu(489) + lu(497) = lu(497) - lu(256) * lu(489) + lu(498) = lu(498) - lu(257) * lu(489) + lu(499) = lu(499) - lu(258) * lu(489) + lu(500) = lu(500) - lu(259) * lu(489) + lu(501) = lu(501) - lu(260) * lu(489) + lu(502) = lu(502) - lu(261) * lu(489) + lu(505) = lu(505) - lu(262) * lu(489) + lu(512) = lu(512) - lu(251) * lu(511) + lu(513) = lu(513) - lu(252) * lu(511) + lu(514) = - lu(253) * lu(511) + lu(515) = lu(515) - lu(254) * lu(511) + lu(516) = lu(516) - lu(255) * lu(511) + lu(517) = - lu(256) * lu(511) + lu(518) = lu(518) - lu(257) * lu(511) + lu(519) = lu(519) - lu(258) * lu(511) + lu(520) = lu(520) - lu(259) * lu(511) + lu(521) = - lu(260) * lu(511) + lu(522) = lu(522) - lu(261) * lu(511) + lu(525) = lu(525) - lu(262) * lu(511) + lu(558) = lu(558) - lu(251) * lu(557) + lu(559) = lu(559) - lu(252) * lu(557) + lu(560) = lu(560) - lu(253) * lu(557) + lu(561) = lu(561) - lu(254) * lu(557) + lu(562) = lu(562) - lu(255) * lu(557) + lu(563) = lu(563) - lu(256) * lu(557) + lu(564) = lu(564) - lu(257) * lu(557) + lu(565) = lu(565) - lu(258) * lu(557) + lu(566) = lu(566) - lu(259) * lu(557) + lu(567) = lu(567) - lu(260) * lu(557) + lu(568) = lu(568) - lu(261) * lu(557) + lu(571) = lu(571) - lu(262) * lu(557) + lu(578) = - lu(251) * lu(577) + lu(581) = lu(581) - lu(252) * lu(577) + lu(582) = lu(582) - lu(253) * lu(577) + lu(583) = lu(583) - lu(254) * lu(577) + lu(584) = lu(584) - lu(255) * lu(577) + lu(585) = lu(585) - lu(256) * lu(577) + lu(586) = lu(586) - lu(257) * lu(577) + lu(587) = lu(587) - lu(258) * lu(577) + lu(588) = lu(588) - lu(259) * lu(577) + lu(589) = - lu(260) * lu(577) + lu(590) = lu(590) - lu(261) * lu(577) + lu(593) = lu(593) - lu(262) * lu(577) + lu(616) = lu(616) - lu(251) * lu(615) + lu(618) = lu(618) - lu(252) * lu(615) + lu(619) = - lu(253) * lu(615) + lu(620) = lu(620) - lu(254) * lu(615) + lu(621) = lu(621) - lu(255) * lu(615) + lu(622) = lu(622) - lu(256) * lu(615) + lu(623) = lu(623) - lu(257) * lu(615) + lu(624) = lu(624) - lu(258) * lu(615) + lu(625) = lu(625) - lu(259) * lu(615) + lu(626) = - lu(260) * lu(615) + lu(627) = lu(627) - lu(261) * lu(615) + lu(630) = lu(630) - lu(262) * lu(615) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(267) = 1._r8 / lu(267) + lu(268) = lu(268) * lu(267) + lu(269) = lu(269) * lu(267) + lu(270) = lu(270) * lu(267) + lu(271) = lu(271) * lu(267) + lu(272) = lu(272) * lu(267) + lu(273) = lu(273) * lu(267) + lu(274) = lu(274) * lu(267) + lu(275) = lu(275) * lu(267) + lu(276) = lu(276) * lu(267) + lu(287) = lu(287) - lu(268) * lu(284) + lu(289) = lu(289) - lu(269) * lu(284) + lu(291) = lu(291) - lu(270) * lu(284) + lu(292) = lu(292) - lu(271) * lu(284) + lu(293) = lu(293) - lu(272) * lu(284) + lu(294) = lu(294) - lu(273) * lu(284) + lu(295) = lu(295) - lu(274) * lu(284) + lu(296) = lu(296) - lu(275) * lu(284) + lu(299) = lu(299) - lu(276) * lu(284) + lu(313) = lu(313) - lu(268) * lu(310) + lu(315) = lu(315) - lu(269) * lu(310) + lu(317) = lu(317) - lu(270) * lu(310) + lu(318) = lu(318) - lu(271) * lu(310) + lu(319) = lu(319) - lu(272) * lu(310) + lu(320) = lu(320) - lu(273) * lu(310) + lu(321) = lu(321) - lu(274) * lu(310) + lu(322) = lu(322) - lu(275) * lu(310) + lu(325) = lu(325) - lu(276) * lu(310) + lu(329) = lu(329) - lu(268) * lu(328) + lu(330) = lu(330) - lu(269) * lu(328) + lu(332) = - lu(270) * lu(328) + lu(333) = lu(333) - lu(271) * lu(328) + lu(334) = lu(334) - lu(272) * lu(328) + lu(335) = lu(335) - lu(273) * lu(328) + lu(336) = - lu(274) * lu(328) + lu(337) = lu(337) - lu(275) * lu(328) + lu(340) = lu(340) - lu(276) * lu(328) + lu(349) = lu(349) - lu(268) * lu(346) + lu(351) = lu(351) - lu(269) * lu(346) + lu(353) = lu(353) - lu(270) * lu(346) + lu(354) = lu(354) - lu(271) * lu(346) + lu(355) = lu(355) - lu(272) * lu(346) + lu(356) = lu(356) - lu(273) * lu(346) + lu(357) = lu(357) - lu(274) * lu(346) + lu(358) = lu(358) - lu(275) * lu(346) + lu(361) = lu(361) - lu(276) * lu(346) + lu(374) = lu(374) - lu(268) * lu(371) + lu(376) = lu(376) - lu(269) * lu(371) + lu(378) = lu(378) - lu(270) * lu(371) + lu(379) = lu(379) - lu(271) * lu(371) + lu(380) = lu(380) - lu(272) * lu(371) + lu(381) = lu(381) - lu(273) * lu(371) + lu(382) = lu(382) - lu(274) * lu(371) + lu(383) = lu(383) - lu(275) * lu(371) + lu(386) = lu(386) - lu(276) * lu(371) + lu(399) = lu(399) - lu(268) * lu(396) + lu(401) = lu(401) - lu(269) * lu(396) + lu(403) = lu(403) - lu(270) * lu(396) + lu(404) = lu(404) - lu(271) * lu(396) + lu(405) = lu(405) - lu(272) * lu(396) + lu(406) = lu(406) - lu(273) * lu(396) + lu(407) = lu(407) - lu(274) * lu(396) + lu(408) = lu(408) - lu(275) * lu(396) + lu(411) = lu(411) - lu(276) * lu(396) + lu(423) = lu(423) - lu(268) * lu(421) + lu(425) = lu(425) - lu(269) * lu(421) + lu(427) = lu(427) - lu(270) * lu(421) + lu(428) = lu(428) - lu(271) * lu(421) + lu(429) = lu(429) - lu(272) * lu(421) + lu(430) = lu(430) - lu(273) * lu(421) + lu(431) = lu(431) - lu(274) * lu(421) + lu(432) = lu(432) - lu(275) * lu(421) + lu(435) = lu(435) - lu(276) * lu(421) + lu(454) = lu(454) - lu(268) * lu(451) + lu(456) = lu(456) - lu(269) * lu(451) + lu(458) = lu(458) - lu(270) * lu(451) + lu(459) = lu(459) - lu(271) * lu(451) + lu(460) = lu(460) - lu(272) * lu(451) + lu(461) = lu(461) - lu(273) * lu(451) + lu(462) = lu(462) - lu(274) * lu(451) + lu(463) = lu(463) - lu(275) * lu(451) + lu(466) = lu(466) - lu(276) * lu(451) + lu(493) = lu(493) - lu(268) * lu(490) + lu(495) = lu(495) - lu(269) * lu(490) + lu(497) = lu(497) - lu(270) * lu(490) + lu(498) = lu(498) - lu(271) * lu(490) + lu(499) = lu(499) - lu(272) * lu(490) + lu(500) = lu(500) - lu(273) * lu(490) + lu(501) = lu(501) - lu(274) * lu(490) + lu(502) = lu(502) - lu(275) * lu(490) + lu(505) = lu(505) - lu(276) * lu(490) + lu(513) = lu(513) - lu(268) * lu(512) + lu(515) = lu(515) - lu(269) * lu(512) + lu(517) = lu(517) - lu(270) * lu(512) + lu(518) = lu(518) - lu(271) * lu(512) + lu(519) = lu(519) - lu(272) * lu(512) + lu(520) = lu(520) - lu(273) * lu(512) + lu(521) = lu(521) - lu(274) * lu(512) + lu(522) = lu(522) - lu(275) * lu(512) + lu(525) = lu(525) - lu(276) * lu(512) + lu(536) = lu(536) - lu(268) * lu(533) + lu(538) = lu(538) - lu(269) * lu(533) + lu(540) = lu(540) - lu(270) * lu(533) + lu(541) = lu(541) - lu(271) * lu(533) + lu(542) = lu(542) - lu(272) * lu(533) + lu(543) = lu(543) - lu(273) * lu(533) + lu(544) = lu(544) - lu(274) * lu(533) + lu(545) = lu(545) - lu(275) * lu(533) + lu(548) = lu(548) - lu(276) * lu(533) + lu(559) = lu(559) - lu(268) * lu(558) + lu(561) = lu(561) - lu(269) * lu(558) + lu(563) = lu(563) - lu(270) * lu(558) + lu(564) = lu(564) - lu(271) * lu(558) + lu(565) = lu(565) - lu(272) * lu(558) + lu(566) = lu(566) - lu(273) * lu(558) + lu(567) = lu(567) - lu(274) * lu(558) + lu(568) = lu(568) - lu(275) * lu(558) + lu(571) = lu(571) - lu(276) * lu(558) + lu(581) = lu(581) - lu(268) * lu(578) + lu(583) = lu(583) - lu(269) * lu(578) + lu(585) = lu(585) - lu(270) * lu(578) + lu(586) = lu(586) - lu(271) * lu(578) + lu(587) = lu(587) - lu(272) * lu(578) + lu(588) = lu(588) - lu(273) * lu(578) + lu(589) = lu(589) - lu(274) * lu(578) + lu(590) = lu(590) - lu(275) * lu(578) + lu(593) = lu(593) - lu(276) * lu(578) + lu(618) = lu(618) - lu(268) * lu(616) + lu(620) = lu(620) - lu(269) * lu(616) + lu(622) = lu(622) - lu(270) * lu(616) + lu(623) = lu(623) - lu(271) * lu(616) + lu(624) = lu(624) - lu(272) * lu(616) + lu(625) = lu(625) - lu(273) * lu(616) + lu(626) = lu(626) - lu(274) * lu(616) + lu(627) = lu(627) - lu(275) * lu(616) + lu(630) = lu(630) - lu(276) * lu(616) + lu(285) = 1._r8 / lu(285) + lu(286) = lu(286) * lu(285) + lu(287) = lu(287) * lu(285) + lu(288) = lu(288) * lu(285) + lu(289) = lu(289) * lu(285) + lu(290) = lu(290) * lu(285) + lu(291) = lu(291) * lu(285) + lu(292) = lu(292) * lu(285) + lu(293) = lu(293) * lu(285) + lu(294) = lu(294) * lu(285) + lu(295) = lu(295) * lu(285) + lu(296) = lu(296) * lu(285) + lu(297) = lu(297) * lu(285) + lu(298) = lu(298) * lu(285) + lu(299) = lu(299) * lu(285) + lu(312) = lu(312) - lu(286) * lu(311) + lu(313) = lu(313) - lu(287) * lu(311) + lu(314) = lu(314) - lu(288) * lu(311) + lu(315) = lu(315) - lu(289) * lu(311) + lu(316) = lu(316) - lu(290) * lu(311) + lu(317) = lu(317) - lu(291) * lu(311) + lu(318) = lu(318) - lu(292) * lu(311) + lu(319) = lu(319) - lu(293) * lu(311) + lu(320) = lu(320) - lu(294) * lu(311) + lu(321) = lu(321) - lu(295) * lu(311) + lu(322) = lu(322) - lu(296) * lu(311) + lu(323) = lu(323) - lu(297) * lu(311) + lu(324) = lu(324) - lu(298) * lu(311) + lu(325) = lu(325) - lu(299) * lu(311) + lu(348) = - lu(286) * lu(347) + lu(349) = lu(349) - lu(287) * lu(347) + lu(350) = lu(350) - lu(288) * lu(347) + lu(351) = lu(351) - lu(289) * lu(347) + lu(352) = lu(352) - lu(290) * lu(347) + lu(353) = lu(353) - lu(291) * lu(347) + lu(354) = lu(354) - lu(292) * lu(347) + lu(355) = lu(355) - lu(293) * lu(347) + lu(356) = lu(356) - lu(294) * lu(347) + lu(357) = lu(357) - lu(295) * lu(347) + lu(358) = lu(358) - lu(296) * lu(347) + lu(359) = lu(359) - lu(297) * lu(347) + lu(360) = lu(360) - lu(298) * lu(347) + lu(361) = lu(361) - lu(299) * lu(347) + lu(373) = lu(373) - lu(286) * lu(372) + lu(374) = lu(374) - lu(287) * lu(372) + lu(375) = lu(375) - lu(288) * lu(372) + lu(376) = lu(376) - lu(289) * lu(372) + lu(377) = lu(377) - lu(290) * lu(372) + lu(378) = lu(378) - lu(291) * lu(372) + lu(379) = lu(379) - lu(292) * lu(372) + lu(380) = lu(380) - lu(293) * lu(372) + lu(381) = lu(381) - lu(294) * lu(372) + lu(382) = lu(382) - lu(295) * lu(372) + lu(383) = lu(383) - lu(296) * lu(372) + lu(384) = lu(384) - lu(297) * lu(372) + lu(385) = lu(385) - lu(298) * lu(372) + lu(386) = lu(386) - lu(299) * lu(372) + lu(398) = lu(398) - lu(286) * lu(397) + lu(399) = lu(399) - lu(287) * lu(397) + lu(400) = lu(400) - lu(288) * lu(397) + lu(401) = lu(401) - lu(289) * lu(397) + lu(402) = lu(402) - lu(290) * lu(397) + lu(403) = lu(403) - lu(291) * lu(397) + lu(404) = lu(404) - lu(292) * lu(397) + lu(405) = lu(405) - lu(293) * lu(397) + lu(406) = lu(406) - lu(294) * lu(397) + lu(407) = lu(407) - lu(295) * lu(397) + lu(408) = lu(408) - lu(296) * lu(397) + lu(409) = lu(409) - lu(297) * lu(397) + lu(410) = lu(410) - lu(298) * lu(397) + lu(411) = lu(411) - lu(299) * lu(397) + lu(453) = lu(453) - lu(286) * lu(452) + lu(454) = lu(454) - lu(287) * lu(452) + lu(455) = lu(455) - lu(288) * lu(452) + lu(456) = lu(456) - lu(289) * lu(452) + lu(457) = lu(457) - lu(290) * lu(452) + lu(458) = lu(458) - lu(291) * lu(452) + lu(459) = lu(459) - lu(292) * lu(452) + lu(460) = lu(460) - lu(293) * lu(452) + lu(461) = lu(461) - lu(294) * lu(452) + lu(462) = lu(462) - lu(295) * lu(452) + lu(463) = lu(463) - lu(296) * lu(452) + lu(464) = lu(464) - lu(297) * lu(452) + lu(465) = lu(465) - lu(298) * lu(452) + lu(466) = lu(466) - lu(299) * lu(452) + lu(492) = lu(492) - lu(286) * lu(491) + lu(493) = lu(493) - lu(287) * lu(491) + lu(494) = lu(494) - lu(288) * lu(491) + lu(495) = lu(495) - lu(289) * lu(491) + lu(496) = lu(496) - lu(290) * lu(491) + lu(497) = lu(497) - lu(291) * lu(491) + lu(498) = lu(498) - lu(292) * lu(491) + lu(499) = lu(499) - lu(293) * lu(491) + lu(500) = lu(500) - lu(294) * lu(491) + lu(501) = lu(501) - lu(295) * lu(491) + lu(502) = lu(502) - lu(296) * lu(491) + lu(503) = lu(503) - lu(297) * lu(491) + lu(504) = lu(504) - lu(298) * lu(491) + lu(505) = lu(505) - lu(299) * lu(491) + lu(535) = lu(535) - lu(286) * lu(534) + lu(536) = lu(536) - lu(287) * lu(534) + lu(537) = lu(537) - lu(288) * lu(534) + lu(538) = lu(538) - lu(289) * lu(534) + lu(539) = - lu(290) * lu(534) + lu(540) = lu(540) - lu(291) * lu(534) + lu(541) = lu(541) - lu(292) * lu(534) + lu(542) = lu(542) - lu(293) * lu(534) + lu(543) = lu(543) - lu(294) * lu(534) + lu(544) = lu(544) - lu(295) * lu(534) + lu(545) = lu(545) - lu(296) * lu(534) + lu(546) = - lu(297) * lu(534) + lu(547) = - lu(298) * lu(534) + lu(548) = lu(548) - lu(299) * lu(534) + lu(580) = lu(580) - lu(286) * lu(579) + lu(581) = lu(581) - lu(287) * lu(579) + lu(582) = lu(582) - lu(288) * lu(579) + lu(583) = lu(583) - lu(289) * lu(579) + lu(584) = lu(584) - lu(290) * lu(579) + lu(585) = lu(585) - lu(291) * lu(579) + lu(586) = lu(586) - lu(292) * lu(579) + lu(587) = lu(587) - lu(293) * lu(579) + lu(588) = lu(588) - lu(294) * lu(579) + lu(589) = lu(589) - lu(295) * lu(579) + lu(590) = lu(590) - lu(296) * lu(579) + lu(591) = lu(591) - lu(297) * lu(579) + lu(592) = lu(592) - lu(298) * lu(579) + lu(593) = lu(593) - lu(299) * lu(579) + lu(598) = lu(598) - lu(286) * lu(597) + lu(599) = lu(599) - lu(287) * lu(597) + lu(600) = lu(600) - lu(288) * lu(597) + lu(601) = lu(601) - lu(289) * lu(597) + lu(602) = lu(602) - lu(290) * lu(597) + lu(603) = lu(603) - lu(291) * lu(597) + lu(604) = lu(604) - lu(292) * lu(597) + lu(605) = lu(605) - lu(293) * lu(597) + lu(606) = lu(606) - lu(294) * lu(597) + lu(607) = - lu(295) * lu(597) + lu(608) = lu(608) - lu(296) * lu(597) + lu(609) = lu(609) - lu(297) * lu(597) + lu(610) = lu(610) - lu(298) * lu(597) + lu(611) = - lu(299) * lu(597) + lu(312) = 1._r8 / lu(312) + lu(313) = lu(313) * lu(312) + lu(314) = lu(314) * lu(312) + lu(315) = lu(315) * lu(312) + lu(316) = lu(316) * lu(312) + lu(317) = lu(317) * lu(312) + lu(318) = lu(318) * lu(312) + lu(319) = lu(319) * lu(312) + lu(320) = lu(320) * lu(312) + lu(321) = lu(321) * lu(312) + lu(322) = lu(322) * lu(312) + lu(323) = lu(323) * lu(312) + lu(324) = lu(324) * lu(312) + lu(325) = lu(325) * lu(312) + lu(349) = lu(349) - lu(313) * lu(348) + lu(350) = lu(350) - lu(314) * lu(348) + lu(351) = lu(351) - lu(315) * lu(348) + lu(352) = lu(352) - lu(316) * lu(348) + lu(353) = lu(353) - lu(317) * lu(348) + lu(354) = lu(354) - lu(318) * lu(348) + lu(355) = lu(355) - lu(319) * lu(348) + lu(356) = lu(356) - lu(320) * lu(348) + lu(357) = lu(357) - lu(321) * lu(348) + lu(358) = lu(358) - lu(322) * lu(348) + lu(359) = lu(359) - lu(323) * lu(348) + lu(360) = lu(360) - lu(324) * lu(348) + lu(361) = lu(361) - lu(325) * lu(348) + lu(374) = lu(374) - lu(313) * lu(373) + lu(375) = lu(375) - lu(314) * lu(373) + lu(376) = lu(376) - lu(315) * lu(373) + lu(377) = lu(377) - lu(316) * lu(373) + lu(378) = lu(378) - lu(317) * lu(373) + lu(379) = lu(379) - lu(318) * lu(373) + lu(380) = lu(380) - lu(319) * lu(373) + lu(381) = lu(381) - lu(320) * lu(373) + lu(382) = lu(382) - lu(321) * lu(373) + lu(383) = lu(383) - lu(322) * lu(373) + lu(384) = lu(384) - lu(323) * lu(373) + lu(385) = lu(385) - lu(324) * lu(373) + lu(386) = lu(386) - lu(325) * lu(373) + lu(399) = lu(399) - lu(313) * lu(398) + lu(400) = lu(400) - lu(314) * lu(398) + lu(401) = lu(401) - lu(315) * lu(398) + lu(402) = lu(402) - lu(316) * lu(398) + lu(403) = lu(403) - lu(317) * lu(398) + lu(404) = lu(404) - lu(318) * lu(398) + lu(405) = lu(405) - lu(319) * lu(398) + lu(406) = lu(406) - lu(320) * lu(398) + lu(407) = lu(407) - lu(321) * lu(398) + lu(408) = lu(408) - lu(322) * lu(398) + lu(409) = lu(409) - lu(323) * lu(398) + lu(410) = lu(410) - lu(324) * lu(398) + lu(411) = lu(411) - lu(325) * lu(398) + lu(423) = lu(423) - lu(313) * lu(422) + lu(424) = lu(424) - lu(314) * lu(422) + lu(425) = lu(425) - lu(315) * lu(422) + lu(426) = lu(426) - lu(316) * lu(422) + lu(427) = lu(427) - lu(317) * lu(422) + lu(428) = lu(428) - lu(318) * lu(422) + lu(429) = lu(429) - lu(319) * lu(422) + lu(430) = lu(430) - lu(320) * lu(422) + lu(431) = lu(431) - lu(321) * lu(422) + lu(432) = lu(432) - lu(322) * lu(422) + lu(433) = lu(433) - lu(323) * lu(422) + lu(434) = lu(434) - lu(324) * lu(422) + lu(435) = lu(435) - lu(325) * lu(422) + lu(454) = lu(454) - lu(313) * lu(453) + lu(455) = lu(455) - lu(314) * lu(453) + lu(456) = lu(456) - lu(315) * lu(453) + lu(457) = lu(457) - lu(316) * lu(453) + lu(458) = lu(458) - lu(317) * lu(453) + lu(459) = lu(459) - lu(318) * lu(453) + lu(460) = lu(460) - lu(319) * lu(453) + lu(461) = lu(461) - lu(320) * lu(453) + lu(462) = lu(462) - lu(321) * lu(453) + lu(463) = lu(463) - lu(322) * lu(453) + lu(464) = lu(464) - lu(323) * lu(453) + lu(465) = lu(465) - lu(324) * lu(453) + lu(466) = lu(466) - lu(325) * lu(453) + lu(493) = lu(493) - lu(313) * lu(492) + lu(494) = lu(494) - lu(314) * lu(492) + lu(495) = lu(495) - lu(315) * lu(492) + lu(496) = lu(496) - lu(316) * lu(492) + lu(497) = lu(497) - lu(317) * lu(492) + lu(498) = lu(498) - lu(318) * lu(492) + lu(499) = lu(499) - lu(319) * lu(492) + lu(500) = lu(500) - lu(320) * lu(492) + lu(501) = lu(501) - lu(321) * lu(492) + lu(502) = lu(502) - lu(322) * lu(492) + lu(503) = lu(503) - lu(323) * lu(492) + lu(504) = lu(504) - lu(324) * lu(492) + lu(505) = lu(505) - lu(325) * lu(492) + lu(536) = lu(536) - lu(313) * lu(535) + lu(537) = lu(537) - lu(314) * lu(535) + lu(538) = lu(538) - lu(315) * lu(535) + lu(539) = lu(539) - lu(316) * lu(535) + lu(540) = lu(540) - lu(317) * lu(535) + lu(541) = lu(541) - lu(318) * lu(535) + lu(542) = lu(542) - lu(319) * lu(535) + lu(543) = lu(543) - lu(320) * lu(535) + lu(544) = lu(544) - lu(321) * lu(535) + lu(545) = lu(545) - lu(322) * lu(535) + lu(546) = lu(546) - lu(323) * lu(535) + lu(547) = lu(547) - lu(324) * lu(535) + lu(548) = lu(548) - lu(325) * lu(535) + lu(581) = lu(581) - lu(313) * lu(580) + lu(582) = lu(582) - lu(314) * lu(580) + lu(583) = lu(583) - lu(315) * lu(580) + lu(584) = lu(584) - lu(316) * lu(580) + lu(585) = lu(585) - lu(317) * lu(580) + lu(586) = lu(586) - lu(318) * lu(580) + lu(587) = lu(587) - lu(319) * lu(580) + lu(588) = lu(588) - lu(320) * lu(580) + lu(589) = lu(589) - lu(321) * lu(580) + lu(590) = lu(590) - lu(322) * lu(580) + lu(591) = lu(591) - lu(323) * lu(580) + lu(592) = lu(592) - lu(324) * lu(580) + lu(593) = lu(593) - lu(325) * lu(580) + lu(599) = lu(599) - lu(313) * lu(598) + lu(600) = lu(600) - lu(314) * lu(598) + lu(601) = lu(601) - lu(315) * lu(598) + lu(602) = lu(602) - lu(316) * lu(598) + lu(603) = lu(603) - lu(317) * lu(598) + lu(604) = lu(604) - lu(318) * lu(598) + lu(605) = lu(605) - lu(319) * lu(598) + lu(606) = lu(606) - lu(320) * lu(598) + lu(607) = lu(607) - lu(321) * lu(598) + lu(608) = lu(608) - lu(322) * lu(598) + lu(609) = lu(609) - lu(323) * lu(598) + lu(610) = lu(610) - lu(324) * lu(598) + lu(611) = lu(611) - lu(325) * lu(598) + lu(618) = lu(618) - lu(313) * lu(617) + lu(619) = lu(619) - lu(314) * lu(617) + lu(620) = lu(620) - lu(315) * lu(617) + lu(621) = lu(621) - lu(316) * lu(617) + lu(622) = lu(622) - lu(317) * lu(617) + lu(623) = lu(623) - lu(318) * lu(617) + lu(624) = lu(624) - lu(319) * lu(617) + lu(625) = lu(625) - lu(320) * lu(617) + lu(626) = lu(626) - lu(321) * lu(617) + lu(627) = lu(627) - lu(322) * lu(617) + lu(628) = lu(628) - lu(323) * lu(617) + lu(629) = lu(629) - lu(324) * lu(617) + lu(630) = lu(630) - lu(325) * lu(617) + lu(329) = 1._r8 / lu(329) + lu(330) = lu(330) * lu(329) + lu(331) = lu(331) * lu(329) + lu(332) = lu(332) * lu(329) + lu(333) = lu(333) * lu(329) + lu(334) = lu(334) * lu(329) + lu(335) = lu(335) * lu(329) + lu(336) = lu(336) * lu(329) + lu(337) = lu(337) * lu(329) + lu(338) = lu(338) * lu(329) + lu(339) = lu(339) * lu(329) + lu(340) = lu(340) * lu(329) + lu(351) = lu(351) - lu(330) * lu(349) + lu(352) = lu(352) - lu(331) * lu(349) + lu(353) = lu(353) - lu(332) * lu(349) + lu(354) = lu(354) - lu(333) * lu(349) + lu(355) = lu(355) - lu(334) * lu(349) + lu(356) = lu(356) - lu(335) * lu(349) + lu(357) = lu(357) - lu(336) * lu(349) + lu(358) = lu(358) - lu(337) * lu(349) + lu(359) = lu(359) - lu(338) * lu(349) + lu(360) = lu(360) - lu(339) * lu(349) + lu(361) = lu(361) - lu(340) * lu(349) + lu(376) = lu(376) - lu(330) * lu(374) + lu(377) = lu(377) - lu(331) * lu(374) + lu(378) = lu(378) - lu(332) * lu(374) + lu(379) = lu(379) - lu(333) * lu(374) + lu(380) = lu(380) - lu(334) * lu(374) + lu(381) = lu(381) - lu(335) * lu(374) + lu(382) = lu(382) - lu(336) * lu(374) + lu(383) = lu(383) - lu(337) * lu(374) + lu(384) = lu(384) - lu(338) * lu(374) + lu(385) = lu(385) - lu(339) * lu(374) + lu(386) = lu(386) - lu(340) * lu(374) + lu(401) = lu(401) - lu(330) * lu(399) + lu(402) = lu(402) - lu(331) * lu(399) + lu(403) = lu(403) - lu(332) * lu(399) + lu(404) = lu(404) - lu(333) * lu(399) + lu(405) = lu(405) - lu(334) * lu(399) + lu(406) = lu(406) - lu(335) * lu(399) + lu(407) = lu(407) - lu(336) * lu(399) + lu(408) = lu(408) - lu(337) * lu(399) + lu(409) = lu(409) - lu(338) * lu(399) + lu(410) = lu(410) - lu(339) * lu(399) + lu(411) = lu(411) - lu(340) * lu(399) + lu(425) = lu(425) - lu(330) * lu(423) + lu(426) = lu(426) - lu(331) * lu(423) + lu(427) = lu(427) - lu(332) * lu(423) + lu(428) = lu(428) - lu(333) * lu(423) + lu(429) = lu(429) - lu(334) * lu(423) + lu(430) = lu(430) - lu(335) * lu(423) + lu(431) = lu(431) - lu(336) * lu(423) + lu(432) = lu(432) - lu(337) * lu(423) + lu(433) = lu(433) - lu(338) * lu(423) + lu(434) = lu(434) - lu(339) * lu(423) + lu(435) = lu(435) - lu(340) * lu(423) + lu(456) = lu(456) - lu(330) * lu(454) + lu(457) = lu(457) - lu(331) * lu(454) + lu(458) = lu(458) - lu(332) * lu(454) + lu(459) = lu(459) - lu(333) * lu(454) + lu(460) = lu(460) - lu(334) * lu(454) + lu(461) = lu(461) - lu(335) * lu(454) + lu(462) = lu(462) - lu(336) * lu(454) + lu(463) = lu(463) - lu(337) * lu(454) + lu(464) = lu(464) - lu(338) * lu(454) + lu(465) = lu(465) - lu(339) * lu(454) + lu(466) = lu(466) - lu(340) * lu(454) + lu(495) = lu(495) - lu(330) * lu(493) + lu(496) = lu(496) - lu(331) * lu(493) + lu(497) = lu(497) - lu(332) * lu(493) + lu(498) = lu(498) - lu(333) * lu(493) + lu(499) = lu(499) - lu(334) * lu(493) + lu(500) = lu(500) - lu(335) * lu(493) + lu(501) = lu(501) - lu(336) * lu(493) + lu(502) = lu(502) - lu(337) * lu(493) + lu(503) = lu(503) - lu(338) * lu(493) + lu(504) = lu(504) - lu(339) * lu(493) + lu(505) = lu(505) - lu(340) * lu(493) + lu(515) = lu(515) - lu(330) * lu(513) + lu(516) = lu(516) - lu(331) * lu(513) + lu(517) = lu(517) - lu(332) * lu(513) + lu(518) = lu(518) - lu(333) * lu(513) + lu(519) = lu(519) - lu(334) * lu(513) + lu(520) = lu(520) - lu(335) * lu(513) + lu(521) = lu(521) - lu(336) * lu(513) + lu(522) = lu(522) - lu(337) * lu(513) + lu(523) = lu(523) - lu(338) * lu(513) + lu(524) = lu(524) - lu(339) * lu(513) + lu(525) = lu(525) - lu(340) * lu(513) + lu(538) = lu(538) - lu(330) * lu(536) + lu(539) = lu(539) - lu(331) * lu(536) + lu(540) = lu(540) - lu(332) * lu(536) + lu(541) = lu(541) - lu(333) * lu(536) + lu(542) = lu(542) - lu(334) * lu(536) + lu(543) = lu(543) - lu(335) * lu(536) + lu(544) = lu(544) - lu(336) * lu(536) + lu(545) = lu(545) - lu(337) * lu(536) + lu(546) = lu(546) - lu(338) * lu(536) + lu(547) = lu(547) - lu(339) * lu(536) + lu(548) = lu(548) - lu(340) * lu(536) + lu(561) = lu(561) - lu(330) * lu(559) + lu(562) = lu(562) - lu(331) * lu(559) + lu(563) = lu(563) - lu(332) * lu(559) + lu(564) = lu(564) - lu(333) * lu(559) + lu(565) = lu(565) - lu(334) * lu(559) + lu(566) = lu(566) - lu(335) * lu(559) + lu(567) = lu(567) - lu(336) * lu(559) + lu(568) = lu(568) - lu(337) * lu(559) + lu(569) = lu(569) - lu(338) * lu(559) + lu(570) = lu(570) - lu(339) * lu(559) + lu(571) = lu(571) - lu(340) * lu(559) + lu(583) = lu(583) - lu(330) * lu(581) + lu(584) = lu(584) - lu(331) * lu(581) + lu(585) = lu(585) - lu(332) * lu(581) + lu(586) = lu(586) - lu(333) * lu(581) + lu(587) = lu(587) - lu(334) * lu(581) + lu(588) = lu(588) - lu(335) * lu(581) + lu(589) = lu(589) - lu(336) * lu(581) + lu(590) = lu(590) - lu(337) * lu(581) + lu(591) = lu(591) - lu(338) * lu(581) + lu(592) = lu(592) - lu(339) * lu(581) + lu(593) = lu(593) - lu(340) * lu(581) + lu(601) = lu(601) - lu(330) * lu(599) + lu(602) = lu(602) - lu(331) * lu(599) + lu(603) = lu(603) - lu(332) * lu(599) + lu(604) = lu(604) - lu(333) * lu(599) + lu(605) = lu(605) - lu(334) * lu(599) + lu(606) = lu(606) - lu(335) * lu(599) + lu(607) = lu(607) - lu(336) * lu(599) + lu(608) = lu(608) - lu(337) * lu(599) + lu(609) = lu(609) - lu(338) * lu(599) + lu(610) = lu(610) - lu(339) * lu(599) + lu(611) = lu(611) - lu(340) * lu(599) + lu(620) = lu(620) - lu(330) * lu(618) + lu(621) = lu(621) - lu(331) * lu(618) + lu(622) = lu(622) - lu(332) * lu(618) + lu(623) = lu(623) - lu(333) * lu(618) + lu(624) = lu(624) - lu(334) * lu(618) + lu(625) = lu(625) - lu(335) * lu(618) + lu(626) = lu(626) - lu(336) * lu(618) + lu(627) = lu(627) - lu(337) * lu(618) + lu(628) = lu(628) - lu(338) * lu(618) + lu(629) = lu(629) - lu(339) * lu(618) + lu(630) = lu(630) - lu(340) * lu(618) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(350) = 1._r8 / lu(350) + lu(351) = lu(351) * lu(350) + lu(352) = lu(352) * lu(350) + lu(353) = lu(353) * lu(350) + lu(354) = lu(354) * lu(350) + lu(355) = lu(355) * lu(350) + lu(356) = lu(356) * lu(350) + lu(357) = lu(357) * lu(350) + lu(358) = lu(358) * lu(350) + lu(359) = lu(359) * lu(350) + lu(360) = lu(360) * lu(350) + lu(361) = lu(361) * lu(350) + lu(376) = lu(376) - lu(351) * lu(375) + lu(377) = lu(377) - lu(352) * lu(375) + lu(378) = lu(378) - lu(353) * lu(375) + lu(379) = lu(379) - lu(354) * lu(375) + lu(380) = lu(380) - lu(355) * lu(375) + lu(381) = lu(381) - lu(356) * lu(375) + lu(382) = lu(382) - lu(357) * lu(375) + lu(383) = lu(383) - lu(358) * lu(375) + lu(384) = lu(384) - lu(359) * lu(375) + lu(385) = lu(385) - lu(360) * lu(375) + lu(386) = lu(386) - lu(361) * lu(375) + lu(401) = lu(401) - lu(351) * lu(400) + lu(402) = lu(402) - lu(352) * lu(400) + lu(403) = lu(403) - lu(353) * lu(400) + lu(404) = lu(404) - lu(354) * lu(400) + lu(405) = lu(405) - lu(355) * lu(400) + lu(406) = lu(406) - lu(356) * lu(400) + lu(407) = lu(407) - lu(357) * lu(400) + lu(408) = lu(408) - lu(358) * lu(400) + lu(409) = lu(409) - lu(359) * lu(400) + lu(410) = lu(410) - lu(360) * lu(400) + lu(411) = lu(411) - lu(361) * lu(400) + lu(425) = lu(425) - lu(351) * lu(424) + lu(426) = lu(426) - lu(352) * lu(424) + lu(427) = lu(427) - lu(353) * lu(424) + lu(428) = lu(428) - lu(354) * lu(424) + lu(429) = lu(429) - lu(355) * lu(424) + lu(430) = lu(430) - lu(356) * lu(424) + lu(431) = lu(431) - lu(357) * lu(424) + lu(432) = lu(432) - lu(358) * lu(424) + lu(433) = lu(433) - lu(359) * lu(424) + lu(434) = lu(434) - lu(360) * lu(424) + lu(435) = lu(435) - lu(361) * lu(424) + lu(456) = lu(456) - lu(351) * lu(455) + lu(457) = lu(457) - lu(352) * lu(455) + lu(458) = lu(458) - lu(353) * lu(455) + lu(459) = lu(459) - lu(354) * lu(455) + lu(460) = lu(460) - lu(355) * lu(455) + lu(461) = lu(461) - lu(356) * lu(455) + lu(462) = lu(462) - lu(357) * lu(455) + lu(463) = lu(463) - lu(358) * lu(455) + lu(464) = lu(464) - lu(359) * lu(455) + lu(465) = lu(465) - lu(360) * lu(455) + lu(466) = lu(466) - lu(361) * lu(455) + lu(495) = lu(495) - lu(351) * lu(494) + lu(496) = lu(496) - lu(352) * lu(494) + lu(497) = lu(497) - lu(353) * lu(494) + lu(498) = lu(498) - lu(354) * lu(494) + lu(499) = lu(499) - lu(355) * lu(494) + lu(500) = lu(500) - lu(356) * lu(494) + lu(501) = lu(501) - lu(357) * lu(494) + lu(502) = lu(502) - lu(358) * lu(494) + lu(503) = lu(503) - lu(359) * lu(494) + lu(504) = lu(504) - lu(360) * lu(494) + lu(505) = lu(505) - lu(361) * lu(494) + lu(515) = lu(515) - lu(351) * lu(514) + lu(516) = lu(516) - lu(352) * lu(514) + lu(517) = lu(517) - lu(353) * lu(514) + lu(518) = lu(518) - lu(354) * lu(514) + lu(519) = lu(519) - lu(355) * lu(514) + lu(520) = lu(520) - lu(356) * lu(514) + lu(521) = lu(521) - lu(357) * lu(514) + lu(522) = lu(522) - lu(358) * lu(514) + lu(523) = lu(523) - lu(359) * lu(514) + lu(524) = lu(524) - lu(360) * lu(514) + lu(525) = lu(525) - lu(361) * lu(514) + lu(538) = lu(538) - lu(351) * lu(537) + lu(539) = lu(539) - lu(352) * lu(537) + lu(540) = lu(540) - lu(353) * lu(537) + lu(541) = lu(541) - lu(354) * lu(537) + lu(542) = lu(542) - lu(355) * lu(537) + lu(543) = lu(543) - lu(356) * lu(537) + lu(544) = lu(544) - lu(357) * lu(537) + lu(545) = lu(545) - lu(358) * lu(537) + lu(546) = lu(546) - lu(359) * lu(537) + lu(547) = lu(547) - lu(360) * lu(537) + lu(548) = lu(548) - lu(361) * lu(537) + lu(561) = lu(561) - lu(351) * lu(560) + lu(562) = lu(562) - lu(352) * lu(560) + lu(563) = lu(563) - lu(353) * lu(560) + lu(564) = lu(564) - lu(354) * lu(560) + lu(565) = lu(565) - lu(355) * lu(560) + lu(566) = lu(566) - lu(356) * lu(560) + lu(567) = lu(567) - lu(357) * lu(560) + lu(568) = lu(568) - lu(358) * lu(560) + lu(569) = lu(569) - lu(359) * lu(560) + lu(570) = lu(570) - lu(360) * lu(560) + lu(571) = lu(571) - lu(361) * lu(560) + lu(583) = lu(583) - lu(351) * lu(582) + lu(584) = lu(584) - lu(352) * lu(582) + lu(585) = lu(585) - lu(353) * lu(582) + lu(586) = lu(586) - lu(354) * lu(582) + lu(587) = lu(587) - lu(355) * lu(582) + lu(588) = lu(588) - lu(356) * lu(582) + lu(589) = lu(589) - lu(357) * lu(582) + lu(590) = lu(590) - lu(358) * lu(582) + lu(591) = lu(591) - lu(359) * lu(582) + lu(592) = lu(592) - lu(360) * lu(582) + lu(593) = lu(593) - lu(361) * lu(582) + lu(601) = lu(601) - lu(351) * lu(600) + lu(602) = lu(602) - lu(352) * lu(600) + lu(603) = lu(603) - lu(353) * lu(600) + lu(604) = lu(604) - lu(354) * lu(600) + lu(605) = lu(605) - lu(355) * lu(600) + lu(606) = lu(606) - lu(356) * lu(600) + lu(607) = lu(607) - lu(357) * lu(600) + lu(608) = lu(608) - lu(358) * lu(600) + lu(609) = lu(609) - lu(359) * lu(600) + lu(610) = lu(610) - lu(360) * lu(600) + lu(611) = lu(611) - lu(361) * lu(600) + lu(620) = lu(620) - lu(351) * lu(619) + lu(621) = lu(621) - lu(352) * lu(619) + lu(622) = lu(622) - lu(353) * lu(619) + lu(623) = lu(623) - lu(354) * lu(619) + lu(624) = lu(624) - lu(355) * lu(619) + lu(625) = lu(625) - lu(356) * lu(619) + lu(626) = lu(626) - lu(357) * lu(619) + lu(627) = lu(627) - lu(358) * lu(619) + lu(628) = lu(628) - lu(359) * lu(619) + lu(629) = lu(629) - lu(360) * lu(619) + lu(630) = lu(630) - lu(361) * lu(619) + lu(376) = 1._r8 / lu(376) + lu(377) = lu(377) * lu(376) + lu(378) = lu(378) * lu(376) + lu(379) = lu(379) * lu(376) + lu(380) = lu(380) * lu(376) + lu(381) = lu(381) * lu(376) + lu(382) = lu(382) * lu(376) + lu(383) = lu(383) * lu(376) + lu(384) = lu(384) * lu(376) + lu(385) = lu(385) * lu(376) + lu(386) = lu(386) * lu(376) + lu(402) = lu(402) - lu(377) * lu(401) + lu(403) = lu(403) - lu(378) * lu(401) + lu(404) = lu(404) - lu(379) * lu(401) + lu(405) = lu(405) - lu(380) * lu(401) + lu(406) = lu(406) - lu(381) * lu(401) + lu(407) = lu(407) - lu(382) * lu(401) + lu(408) = lu(408) - lu(383) * lu(401) + lu(409) = lu(409) - lu(384) * lu(401) + lu(410) = lu(410) - lu(385) * lu(401) + lu(411) = lu(411) - lu(386) * lu(401) + lu(426) = lu(426) - lu(377) * lu(425) + lu(427) = lu(427) - lu(378) * lu(425) + lu(428) = lu(428) - lu(379) * lu(425) + lu(429) = lu(429) - lu(380) * lu(425) + lu(430) = lu(430) - lu(381) * lu(425) + lu(431) = lu(431) - lu(382) * lu(425) + lu(432) = lu(432) - lu(383) * lu(425) + lu(433) = lu(433) - lu(384) * lu(425) + lu(434) = lu(434) - lu(385) * lu(425) + lu(435) = lu(435) - lu(386) * lu(425) + lu(457) = lu(457) - lu(377) * lu(456) + lu(458) = lu(458) - lu(378) * lu(456) + lu(459) = lu(459) - lu(379) * lu(456) + lu(460) = lu(460) - lu(380) * lu(456) + lu(461) = lu(461) - lu(381) * lu(456) + lu(462) = lu(462) - lu(382) * lu(456) + lu(463) = lu(463) - lu(383) * lu(456) + lu(464) = lu(464) - lu(384) * lu(456) + lu(465) = lu(465) - lu(385) * lu(456) + lu(466) = lu(466) - lu(386) * lu(456) + lu(496) = lu(496) - lu(377) * lu(495) + lu(497) = lu(497) - lu(378) * lu(495) + lu(498) = lu(498) - lu(379) * lu(495) + lu(499) = lu(499) - lu(380) * lu(495) + lu(500) = lu(500) - lu(381) * lu(495) + lu(501) = lu(501) - lu(382) * lu(495) + lu(502) = lu(502) - lu(383) * lu(495) + lu(503) = lu(503) - lu(384) * lu(495) + lu(504) = lu(504) - lu(385) * lu(495) + lu(505) = lu(505) - lu(386) * lu(495) + lu(516) = lu(516) - lu(377) * lu(515) + lu(517) = lu(517) - lu(378) * lu(515) + lu(518) = lu(518) - lu(379) * lu(515) + lu(519) = lu(519) - lu(380) * lu(515) + lu(520) = lu(520) - lu(381) * lu(515) + lu(521) = lu(521) - lu(382) * lu(515) + lu(522) = lu(522) - lu(383) * lu(515) + lu(523) = lu(523) - lu(384) * lu(515) + lu(524) = lu(524) - lu(385) * lu(515) + lu(525) = lu(525) - lu(386) * lu(515) + lu(539) = lu(539) - lu(377) * lu(538) + lu(540) = lu(540) - lu(378) * lu(538) + lu(541) = lu(541) - lu(379) * lu(538) + lu(542) = lu(542) - lu(380) * lu(538) + lu(543) = lu(543) - lu(381) * lu(538) + lu(544) = lu(544) - lu(382) * lu(538) + lu(545) = lu(545) - lu(383) * lu(538) + lu(546) = lu(546) - lu(384) * lu(538) + lu(547) = lu(547) - lu(385) * lu(538) + lu(548) = lu(548) - lu(386) * lu(538) + lu(562) = lu(562) - lu(377) * lu(561) + lu(563) = lu(563) - lu(378) * lu(561) + lu(564) = lu(564) - lu(379) * lu(561) + lu(565) = lu(565) - lu(380) * lu(561) + lu(566) = lu(566) - lu(381) * lu(561) + lu(567) = lu(567) - lu(382) * lu(561) + lu(568) = lu(568) - lu(383) * lu(561) + lu(569) = lu(569) - lu(384) * lu(561) + lu(570) = lu(570) - lu(385) * lu(561) + lu(571) = lu(571) - lu(386) * lu(561) + lu(584) = lu(584) - lu(377) * lu(583) + lu(585) = lu(585) - lu(378) * lu(583) + lu(586) = lu(586) - lu(379) * lu(583) + lu(587) = lu(587) - lu(380) * lu(583) + lu(588) = lu(588) - lu(381) * lu(583) + lu(589) = lu(589) - lu(382) * lu(583) + lu(590) = lu(590) - lu(383) * lu(583) + lu(591) = lu(591) - lu(384) * lu(583) + lu(592) = lu(592) - lu(385) * lu(583) + lu(593) = lu(593) - lu(386) * lu(583) + lu(602) = lu(602) - lu(377) * lu(601) + lu(603) = lu(603) - lu(378) * lu(601) + lu(604) = lu(604) - lu(379) * lu(601) + lu(605) = lu(605) - lu(380) * lu(601) + lu(606) = lu(606) - lu(381) * lu(601) + lu(607) = lu(607) - lu(382) * lu(601) + lu(608) = lu(608) - lu(383) * lu(601) + lu(609) = lu(609) - lu(384) * lu(601) + lu(610) = lu(610) - lu(385) * lu(601) + lu(611) = lu(611) - lu(386) * lu(601) + lu(621) = lu(621) - lu(377) * lu(620) + lu(622) = lu(622) - lu(378) * lu(620) + lu(623) = lu(623) - lu(379) * lu(620) + lu(624) = lu(624) - lu(380) * lu(620) + lu(625) = lu(625) - lu(381) * lu(620) + lu(626) = lu(626) - lu(382) * lu(620) + lu(627) = lu(627) - lu(383) * lu(620) + lu(628) = lu(628) - lu(384) * lu(620) + lu(629) = lu(629) - lu(385) * lu(620) + lu(630) = lu(630) - lu(386) * lu(620) + lu(402) = 1._r8 / lu(402) + lu(403) = lu(403) * lu(402) + lu(404) = lu(404) * lu(402) + lu(405) = lu(405) * lu(402) + lu(406) = lu(406) * lu(402) + lu(407) = lu(407) * lu(402) + lu(408) = lu(408) * lu(402) + lu(409) = lu(409) * lu(402) + lu(410) = lu(410) * lu(402) + lu(411) = lu(411) * lu(402) + lu(427) = lu(427) - lu(403) * lu(426) + lu(428) = lu(428) - lu(404) * lu(426) + lu(429) = lu(429) - lu(405) * lu(426) + lu(430) = lu(430) - lu(406) * lu(426) + lu(431) = lu(431) - lu(407) * lu(426) + lu(432) = lu(432) - lu(408) * lu(426) + lu(433) = lu(433) - lu(409) * lu(426) + lu(434) = lu(434) - lu(410) * lu(426) + lu(435) = lu(435) - lu(411) * lu(426) + lu(458) = lu(458) - lu(403) * lu(457) + lu(459) = lu(459) - lu(404) * lu(457) + lu(460) = lu(460) - lu(405) * lu(457) + lu(461) = lu(461) - lu(406) * lu(457) + lu(462) = lu(462) - lu(407) * lu(457) + lu(463) = lu(463) - lu(408) * lu(457) + lu(464) = lu(464) - lu(409) * lu(457) + lu(465) = lu(465) - lu(410) * lu(457) + lu(466) = lu(466) - lu(411) * lu(457) + lu(497) = lu(497) - lu(403) * lu(496) + lu(498) = lu(498) - lu(404) * lu(496) + lu(499) = lu(499) - lu(405) * lu(496) + lu(500) = lu(500) - lu(406) * lu(496) + lu(501) = lu(501) - lu(407) * lu(496) + lu(502) = lu(502) - lu(408) * lu(496) + lu(503) = lu(503) - lu(409) * lu(496) + lu(504) = lu(504) - lu(410) * lu(496) + lu(505) = lu(505) - lu(411) * lu(496) + lu(517) = lu(517) - lu(403) * lu(516) + lu(518) = lu(518) - lu(404) * lu(516) + lu(519) = lu(519) - lu(405) * lu(516) + lu(520) = lu(520) - lu(406) * lu(516) + lu(521) = lu(521) - lu(407) * lu(516) + lu(522) = lu(522) - lu(408) * lu(516) + lu(523) = lu(523) - lu(409) * lu(516) + lu(524) = lu(524) - lu(410) * lu(516) + lu(525) = lu(525) - lu(411) * lu(516) + lu(540) = lu(540) - lu(403) * lu(539) + lu(541) = lu(541) - lu(404) * lu(539) + lu(542) = lu(542) - lu(405) * lu(539) + lu(543) = lu(543) - lu(406) * lu(539) + lu(544) = lu(544) - lu(407) * lu(539) + lu(545) = lu(545) - lu(408) * lu(539) + lu(546) = lu(546) - lu(409) * lu(539) + lu(547) = lu(547) - lu(410) * lu(539) + lu(548) = lu(548) - lu(411) * lu(539) + lu(563) = lu(563) - lu(403) * lu(562) + lu(564) = lu(564) - lu(404) * lu(562) + lu(565) = lu(565) - lu(405) * lu(562) + lu(566) = lu(566) - lu(406) * lu(562) + lu(567) = lu(567) - lu(407) * lu(562) + lu(568) = lu(568) - lu(408) * lu(562) + lu(569) = lu(569) - lu(409) * lu(562) + lu(570) = lu(570) - lu(410) * lu(562) + lu(571) = lu(571) - lu(411) * lu(562) + lu(585) = lu(585) - lu(403) * lu(584) + lu(586) = lu(586) - lu(404) * lu(584) + lu(587) = lu(587) - lu(405) * lu(584) + lu(588) = lu(588) - lu(406) * lu(584) + lu(589) = lu(589) - lu(407) * lu(584) + lu(590) = lu(590) - lu(408) * lu(584) + lu(591) = lu(591) - lu(409) * lu(584) + lu(592) = lu(592) - lu(410) * lu(584) + lu(593) = lu(593) - lu(411) * lu(584) + lu(603) = lu(603) - lu(403) * lu(602) + lu(604) = lu(604) - lu(404) * lu(602) + lu(605) = lu(605) - lu(405) * lu(602) + lu(606) = lu(606) - lu(406) * lu(602) + lu(607) = lu(607) - lu(407) * lu(602) + lu(608) = lu(608) - lu(408) * lu(602) + lu(609) = lu(609) - lu(409) * lu(602) + lu(610) = lu(610) - lu(410) * lu(602) + lu(611) = lu(611) - lu(411) * lu(602) + lu(622) = lu(622) - lu(403) * lu(621) + lu(623) = lu(623) - lu(404) * lu(621) + lu(624) = lu(624) - lu(405) * lu(621) + lu(625) = lu(625) - lu(406) * lu(621) + lu(626) = lu(626) - lu(407) * lu(621) + lu(627) = lu(627) - lu(408) * lu(621) + lu(628) = lu(628) - lu(409) * lu(621) + lu(629) = lu(629) - lu(410) * lu(621) + lu(630) = lu(630) - lu(411) * lu(621) + lu(427) = 1._r8 / lu(427) + lu(428) = lu(428) * lu(427) + lu(429) = lu(429) * lu(427) + lu(430) = lu(430) * lu(427) + lu(431) = lu(431) * lu(427) + lu(432) = lu(432) * lu(427) + lu(433) = lu(433) * lu(427) + lu(434) = lu(434) * lu(427) + lu(435) = lu(435) * lu(427) + lu(459) = lu(459) - lu(428) * lu(458) + lu(460) = lu(460) - lu(429) * lu(458) + lu(461) = lu(461) - lu(430) * lu(458) + lu(462) = lu(462) - lu(431) * lu(458) + lu(463) = lu(463) - lu(432) * lu(458) + lu(464) = lu(464) - lu(433) * lu(458) + lu(465) = lu(465) - lu(434) * lu(458) + lu(466) = lu(466) - lu(435) * lu(458) + lu(498) = lu(498) - lu(428) * lu(497) + lu(499) = lu(499) - lu(429) * lu(497) + lu(500) = lu(500) - lu(430) * lu(497) + lu(501) = lu(501) - lu(431) * lu(497) + lu(502) = lu(502) - lu(432) * lu(497) + lu(503) = lu(503) - lu(433) * lu(497) + lu(504) = lu(504) - lu(434) * lu(497) + lu(505) = lu(505) - lu(435) * lu(497) + lu(518) = lu(518) - lu(428) * lu(517) + lu(519) = lu(519) - lu(429) * lu(517) + lu(520) = lu(520) - lu(430) * lu(517) + lu(521) = lu(521) - lu(431) * lu(517) + lu(522) = lu(522) - lu(432) * lu(517) + lu(523) = lu(523) - lu(433) * lu(517) + lu(524) = lu(524) - lu(434) * lu(517) + lu(525) = lu(525) - lu(435) * lu(517) + lu(541) = lu(541) - lu(428) * lu(540) + lu(542) = lu(542) - lu(429) * lu(540) + lu(543) = lu(543) - lu(430) * lu(540) + lu(544) = lu(544) - lu(431) * lu(540) + lu(545) = lu(545) - lu(432) * lu(540) + lu(546) = lu(546) - lu(433) * lu(540) + lu(547) = lu(547) - lu(434) * lu(540) + lu(548) = lu(548) - lu(435) * lu(540) + lu(564) = lu(564) - lu(428) * lu(563) + lu(565) = lu(565) - lu(429) * lu(563) + lu(566) = lu(566) - lu(430) * lu(563) + lu(567) = lu(567) - lu(431) * lu(563) + lu(568) = lu(568) - lu(432) * lu(563) + lu(569) = lu(569) - lu(433) * lu(563) + lu(570) = lu(570) - lu(434) * lu(563) + lu(571) = lu(571) - lu(435) * lu(563) + lu(586) = lu(586) - lu(428) * lu(585) + lu(587) = lu(587) - lu(429) * lu(585) + lu(588) = lu(588) - lu(430) * lu(585) + lu(589) = lu(589) - lu(431) * lu(585) + lu(590) = lu(590) - lu(432) * lu(585) + lu(591) = lu(591) - lu(433) * lu(585) + lu(592) = lu(592) - lu(434) * lu(585) + lu(593) = lu(593) - lu(435) * lu(585) + lu(604) = lu(604) - lu(428) * lu(603) + lu(605) = lu(605) - lu(429) * lu(603) + lu(606) = lu(606) - lu(430) * lu(603) + lu(607) = lu(607) - lu(431) * lu(603) + lu(608) = lu(608) - lu(432) * lu(603) + lu(609) = lu(609) - lu(433) * lu(603) + lu(610) = lu(610) - lu(434) * lu(603) + lu(611) = lu(611) - lu(435) * lu(603) + lu(623) = lu(623) - lu(428) * lu(622) + lu(624) = lu(624) - lu(429) * lu(622) + lu(625) = lu(625) - lu(430) * lu(622) + lu(626) = lu(626) - lu(431) * lu(622) + lu(627) = lu(627) - lu(432) * lu(622) + lu(628) = lu(628) - lu(433) * lu(622) + lu(629) = lu(629) - lu(434) * lu(622) + lu(630) = lu(630) - lu(435) * lu(622) + lu(459) = 1._r8 / lu(459) + lu(460) = lu(460) * lu(459) + lu(461) = lu(461) * lu(459) + lu(462) = lu(462) * lu(459) + lu(463) = lu(463) * lu(459) + lu(464) = lu(464) * lu(459) + lu(465) = lu(465) * lu(459) + lu(466) = lu(466) * lu(459) + lu(499) = lu(499) - lu(460) * lu(498) + lu(500) = lu(500) - lu(461) * lu(498) + lu(501) = lu(501) - lu(462) * lu(498) + lu(502) = lu(502) - lu(463) * lu(498) + lu(503) = lu(503) - lu(464) * lu(498) + lu(504) = lu(504) - lu(465) * lu(498) + lu(505) = lu(505) - lu(466) * lu(498) + lu(519) = lu(519) - lu(460) * lu(518) + lu(520) = lu(520) - lu(461) * lu(518) + lu(521) = lu(521) - lu(462) * lu(518) + lu(522) = lu(522) - lu(463) * lu(518) + lu(523) = lu(523) - lu(464) * lu(518) + lu(524) = lu(524) - lu(465) * lu(518) + lu(525) = lu(525) - lu(466) * lu(518) + lu(542) = lu(542) - lu(460) * lu(541) + lu(543) = lu(543) - lu(461) * lu(541) + lu(544) = lu(544) - lu(462) * lu(541) + lu(545) = lu(545) - lu(463) * lu(541) + lu(546) = lu(546) - lu(464) * lu(541) + lu(547) = lu(547) - lu(465) * lu(541) + lu(548) = lu(548) - lu(466) * lu(541) + lu(565) = lu(565) - lu(460) * lu(564) + lu(566) = lu(566) - lu(461) * lu(564) + lu(567) = lu(567) - lu(462) * lu(564) + lu(568) = lu(568) - lu(463) * lu(564) + lu(569) = lu(569) - lu(464) * lu(564) + lu(570) = lu(570) - lu(465) * lu(564) + lu(571) = lu(571) - lu(466) * lu(564) + lu(587) = lu(587) - lu(460) * lu(586) + lu(588) = lu(588) - lu(461) * lu(586) + lu(589) = lu(589) - lu(462) * lu(586) + lu(590) = lu(590) - lu(463) * lu(586) + lu(591) = lu(591) - lu(464) * lu(586) + lu(592) = lu(592) - lu(465) * lu(586) + lu(593) = lu(593) - lu(466) * lu(586) + lu(605) = lu(605) - lu(460) * lu(604) + lu(606) = lu(606) - lu(461) * lu(604) + lu(607) = lu(607) - lu(462) * lu(604) + lu(608) = lu(608) - lu(463) * lu(604) + lu(609) = lu(609) - lu(464) * lu(604) + lu(610) = lu(610) - lu(465) * lu(604) + lu(611) = lu(611) - lu(466) * lu(604) + lu(624) = lu(624) - lu(460) * lu(623) + lu(625) = lu(625) - lu(461) * lu(623) + lu(626) = lu(626) - lu(462) * lu(623) + lu(627) = lu(627) - lu(463) * lu(623) + lu(628) = lu(628) - lu(464) * lu(623) + lu(629) = lu(629) - lu(465) * lu(623) + lu(630) = lu(630) - lu(466) * lu(623) + lu(499) = 1._r8 / lu(499) + lu(500) = lu(500) * lu(499) + lu(501) = lu(501) * lu(499) + lu(502) = lu(502) * lu(499) + lu(503) = lu(503) * lu(499) + lu(504) = lu(504) * lu(499) + lu(505) = lu(505) * lu(499) + lu(520) = lu(520) - lu(500) * lu(519) + lu(521) = lu(521) - lu(501) * lu(519) + lu(522) = lu(522) - lu(502) * lu(519) + lu(523) = lu(523) - lu(503) * lu(519) + lu(524) = lu(524) - lu(504) * lu(519) + lu(525) = lu(525) - lu(505) * lu(519) + lu(543) = lu(543) - lu(500) * lu(542) + lu(544) = lu(544) - lu(501) * lu(542) + lu(545) = lu(545) - lu(502) * lu(542) + lu(546) = lu(546) - lu(503) * lu(542) + lu(547) = lu(547) - lu(504) * lu(542) + lu(548) = lu(548) - lu(505) * lu(542) + lu(566) = lu(566) - lu(500) * lu(565) + lu(567) = lu(567) - lu(501) * lu(565) + lu(568) = lu(568) - lu(502) * lu(565) + lu(569) = lu(569) - lu(503) * lu(565) + lu(570) = lu(570) - lu(504) * lu(565) + lu(571) = lu(571) - lu(505) * lu(565) + lu(588) = lu(588) - lu(500) * lu(587) + lu(589) = lu(589) - lu(501) * lu(587) + lu(590) = lu(590) - lu(502) * lu(587) + lu(591) = lu(591) - lu(503) * lu(587) + lu(592) = lu(592) - lu(504) * lu(587) + lu(593) = lu(593) - lu(505) * lu(587) + lu(606) = lu(606) - lu(500) * lu(605) + lu(607) = lu(607) - lu(501) * lu(605) + lu(608) = lu(608) - lu(502) * lu(605) + lu(609) = lu(609) - lu(503) * lu(605) + lu(610) = lu(610) - lu(504) * lu(605) + lu(611) = lu(611) - lu(505) * lu(605) + lu(625) = lu(625) - lu(500) * lu(624) + lu(626) = lu(626) - lu(501) * lu(624) + lu(627) = lu(627) - lu(502) * lu(624) + lu(628) = lu(628) - lu(503) * lu(624) + lu(629) = lu(629) - lu(504) * lu(624) + lu(630) = lu(630) - lu(505) * lu(624) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(520) = 1._r8 / lu(520) + lu(521) = lu(521) * lu(520) + lu(522) = lu(522) * lu(520) + lu(523) = lu(523) * lu(520) + lu(524) = lu(524) * lu(520) + lu(525) = lu(525) * lu(520) + lu(544) = lu(544) - lu(521) * lu(543) + lu(545) = lu(545) - lu(522) * lu(543) + lu(546) = lu(546) - lu(523) * lu(543) + lu(547) = lu(547) - lu(524) * lu(543) + lu(548) = lu(548) - lu(525) * lu(543) + lu(567) = lu(567) - lu(521) * lu(566) + lu(568) = lu(568) - lu(522) * lu(566) + lu(569) = lu(569) - lu(523) * lu(566) + lu(570) = lu(570) - lu(524) * lu(566) + lu(571) = lu(571) - lu(525) * lu(566) + lu(589) = lu(589) - lu(521) * lu(588) + lu(590) = lu(590) - lu(522) * lu(588) + lu(591) = lu(591) - lu(523) * lu(588) + lu(592) = lu(592) - lu(524) * lu(588) + lu(593) = lu(593) - lu(525) * lu(588) + lu(607) = lu(607) - lu(521) * lu(606) + lu(608) = lu(608) - lu(522) * lu(606) + lu(609) = lu(609) - lu(523) * lu(606) + lu(610) = lu(610) - lu(524) * lu(606) + lu(611) = lu(611) - lu(525) * lu(606) + lu(626) = lu(626) - lu(521) * lu(625) + lu(627) = lu(627) - lu(522) * lu(625) + lu(628) = lu(628) - lu(523) * lu(625) + lu(629) = lu(629) - lu(524) * lu(625) + lu(630) = lu(630) - lu(525) * lu(625) + lu(544) = 1._r8 / lu(544) + lu(545) = lu(545) * lu(544) + lu(546) = lu(546) * lu(544) + lu(547) = lu(547) * lu(544) + lu(548) = lu(548) * lu(544) + lu(568) = lu(568) - lu(545) * lu(567) + lu(569) = lu(569) - lu(546) * lu(567) + lu(570) = lu(570) - lu(547) * lu(567) + lu(571) = lu(571) - lu(548) * lu(567) + lu(590) = lu(590) - lu(545) * lu(589) + lu(591) = lu(591) - lu(546) * lu(589) + lu(592) = lu(592) - lu(547) * lu(589) + lu(593) = lu(593) - lu(548) * lu(589) + lu(608) = lu(608) - lu(545) * lu(607) + lu(609) = lu(609) - lu(546) * lu(607) + lu(610) = lu(610) - lu(547) * lu(607) + lu(611) = lu(611) - lu(548) * lu(607) + lu(627) = lu(627) - lu(545) * lu(626) + lu(628) = lu(628) - lu(546) * lu(626) + lu(629) = lu(629) - lu(547) * lu(626) + lu(630) = lu(630) - lu(548) * lu(626) + lu(568) = 1._r8 / lu(568) + lu(569) = lu(569) * lu(568) + lu(570) = lu(570) * lu(568) + lu(571) = lu(571) * lu(568) + lu(591) = lu(591) - lu(569) * lu(590) + lu(592) = lu(592) - lu(570) * lu(590) + lu(593) = lu(593) - lu(571) * lu(590) + lu(609) = lu(609) - lu(569) * lu(608) + lu(610) = lu(610) - lu(570) * lu(608) + lu(611) = lu(611) - lu(571) * lu(608) + lu(628) = lu(628) - lu(569) * lu(627) + lu(629) = lu(629) - lu(570) * lu(627) + lu(630) = lu(630) - lu(571) * lu(627) + lu(591) = 1._r8 / lu(591) + lu(592) = lu(592) * lu(591) + lu(593) = lu(593) * lu(591) + lu(610) = lu(610) - lu(592) * lu(609) + lu(611) = lu(611) - lu(593) * lu(609) + lu(629) = lu(629) - lu(592) * lu(628) + lu(630) = lu(630) - lu(593) * lu(628) + lu(610) = 1._r8 / lu(610) + lu(611) = lu(611) * lu(610) + lu(630) = lu(630) - lu(611) * lu(629) + lu(630) = 1._r8 / lu(630) + end subroutine lu_fac09 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 new file mode 100644 index 0000000000..782aaec22d --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 @@ -0,0 +1,716 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(37) = b(37) - lu(2) * b(1) + b(42) = b(42) - lu(3) * b(1) + b(32) = b(32) - lu(5) * b(2) + b(32) = b(32) - lu(8) * b(3) + b(37) = b(37) - lu(10) * b(4) + b(44) = b(44) - lu(11) * b(4) + b(26) = b(26) - lu(13) * b(5) + b(47) = b(47) - lu(14) * b(5) + b(42) = b(42) - lu(16) * b(6) + b(26) = b(26) - lu(18) * b(7) + b(42) = b(42) - lu(19) * b(7) + b(47) = b(47) - lu(20) * b(7) + b(39) = b(39) - lu(22) * b(8) + b(42) = b(42) - lu(23) * b(8) + b(26) = b(26) - lu(25) * b(9) + b(38) = b(38) - lu(26) * b(9) + b(31) = b(31) - lu(28) * b(10) + b(40) = b(40) - lu(29) * b(10) + b(44) = b(44) - lu(30) * b(10) + b(45) = b(45) - lu(31) * b(10) + b(48) = b(48) - lu(32) * b(10) + b(33) = b(33) - lu(34) * b(11) + b(34) = b(34) - lu(35) * b(11) + b(38) = b(38) - lu(36) * b(11) + b(43) = b(43) - lu(37) * b(11) + b(50) = b(50) - lu(38) * b(11) + b(32) = b(32) - lu(40) * b(12) + b(33) = b(33) - lu(41) * b(12) + b(40) = b(40) - lu(42) * b(12) + b(41) = b(41) - lu(43) * b(12) + b(43) = b(43) - lu(44) * b(12) + b(45) = b(45) - lu(45) * b(12) + b(14) = b(14) - lu(47) * b(13) + b(19) = b(19) - lu(48) * b(13) + b(20) = b(20) - lu(49) * b(13) + b(21) = b(21) - lu(50) * b(13) + b(44) = b(44) - lu(51) * b(13) + b(48) = b(48) - lu(52) * b(13) + b(20) = b(20) - lu(54) * b(14) + b(21) = b(21) - lu(55) * b(14) + b(23) = b(23) - lu(56) * b(14) + b(32) = b(32) - lu(57) * b(14) + b(44) = b(44) - lu(58) * b(14) + b(28) = b(28) - lu(60) * b(15) + b(32) = b(32) - lu(61) * b(15) + b(47) = b(47) - lu(62) * b(15) + b(48) = b(48) - lu(63) * b(15) + b(38) = b(38) - lu(65) * b(16) + b(41) = b(41) - lu(66) * b(16) + b(43) = b(43) - lu(67) * b(16) + b(22) = b(22) - lu(69) * b(17) + b(31) = b(31) - lu(70) * b(17) + b(36) = b(36) - lu(71) * b(17) + b(39) = b(39) - lu(72) * b(17) + b(40) = b(40) - lu(73) * b(17) + b(44) = b(44) - lu(74) * b(17) + b(45) = b(45) - lu(75) * b(17) + b(33) = b(33) - lu(77) * b(18) + b(41) = b(41) - lu(78) * b(18) + b(42) = b(42) - lu(79) * b(18) + b(43) = b(43) - lu(80) * b(18) + b(44) = b(44) - lu(81) * b(18) + b(46) = b(46) - lu(82) * b(18) + b(21) = b(21) - lu(84) * b(19) + b(23) = b(23) - lu(85) * b(19) + b(24) = b(24) - lu(86) * b(19) + b(28) = b(28) - lu(87) * b(19) + b(32) = b(32) - lu(88) * b(19) + b(44) = b(44) - lu(89) * b(19) + b(21) = b(21) - lu(92) * b(20) + b(23) = b(23) - lu(93) * b(20) + b(24) = b(24) - lu(94) * b(20) + b(25) = b(25) - lu(95) * b(20) + b(28) = b(28) - lu(96) * b(20) + b(32) = b(32) - lu(97) * b(20) + b(44) = b(44) - lu(98) * b(20) + b(47) = b(47) - lu(99) * b(20) + b(48) = b(48) - lu(100) * b(20) + b(23) = b(23) - lu(103) * b(21) + b(24) = b(24) - lu(104) * b(21) + b(28) = b(28) - lu(105) * b(21) + b(32) = b(32) - lu(106) * b(21) + b(38) = b(38) - lu(107) * b(21) + b(41) = b(41) - lu(108) * b(21) + b(43) = b(43) - lu(109) * b(21) + b(44) = b(44) - lu(110) * b(21) + b(33) = b(33) - lu(113) * b(22) + b(36) = b(36) - lu(114) * b(22) + b(39) = b(39) - lu(115) * b(22) + b(42) = b(42) - lu(116) * b(22) + b(43) = b(43) - lu(117) * b(22) + b(44) = b(44) - lu(118) * b(22) + b(46) = b(46) - lu(119) * b(22) + b(24) = b(24) - lu(121) * b(23) + b(25) = b(25) - lu(122) * b(23) + b(28) = b(28) - lu(123) * b(23) + b(32) = b(32) - lu(124) * b(23) + b(44) = b(44) - lu(125) * b(23) + b(47) = b(47) - lu(126) * b(23) + b(48) = b(48) - lu(127) * b(23) + b(25) = b(25) - lu(130) * b(24) + b(28) = b(28) - lu(131) * b(24) + b(32) = b(32) - lu(132) * b(24) + b(44) = b(44) - lu(133) * b(24) + b(47) = b(47) - lu(134) * b(24) + b(48) = b(48) - lu(135) * b(24) + b(28) = b(28) - lu(145) * b(25) + b(32) = b(32) - lu(146) * b(25) + b(38) = b(38) - lu(147) * b(25) + b(41) = b(41) - lu(148) * b(25) + b(43) = b(43) - lu(149) * b(25) + b(44) = b(44) - lu(150) * b(25) + b(47) = b(47) - lu(151) * b(25) + b(48) = b(48) - lu(152) * b(25) + b(31) = b(31) - lu(155) * b(26) + b(33) = b(33) - lu(156) * b(26) + b(35) = b(35) - lu(157) * b(26) + b(38) = b(38) - lu(158) * b(26) + b(43) = b(43) - lu(159) * b(26) + b(45) = b(45) - lu(160) * b(26) + b(50) = b(50) - lu(161) * b(26) + b(33) = b(33) - lu(163) * b(27) + b(38) = b(38) - lu(164) * b(27) + b(39) = b(39) - lu(165) * b(27) + b(43) = b(43) - lu(166) * b(27) + b(44) = b(44) - lu(167) * b(27) + b(47) = b(47) - lu(168) * b(27) + b(32) = b(32) - lu(175) * b(28) + b(38) = b(38) - lu(176) * b(28) + b(40) = b(40) - lu(177) * b(28) + b(41) = b(41) - lu(178) * b(28) + b(43) = b(43) - lu(179) * b(28) + b(44) = b(44) - lu(180) * b(28) + b(47) = b(47) - lu(181) * b(28) + b(48) = b(48) - lu(182) * b(28) + b(33) = b(33) - lu(185) * b(29) + b(37) = b(37) - lu(186) * b(29) + b(42) = b(42) - lu(187) * b(29) + b(43) = b(43) - lu(188) * b(29) + b(44) = b(44) - lu(189) * b(29) + b(46) = b(46) - lu(190) * b(29) + b(31) = b(31) - lu(194) * b(30) + b(33) = b(33) - lu(195) * b(30) + b(37) = b(37) - lu(196) * b(30) + b(40) = b(40) - lu(197) * b(30) + b(42) = b(42) - lu(198) * b(30) + b(43) = b(43) - lu(199) * b(30) + b(44) = b(44) - lu(200) * b(30) + b(45) = b(45) - lu(201) * b(30) + b(46) = b(46) - lu(202) * b(30) + b(33) = b(33) - lu(206) * b(31) + b(35) = b(35) - lu(207) * b(31) + b(38) = b(38) - lu(208) * b(31) + b(40) = b(40) - lu(209) * b(31) + b(43) = b(43) - lu(210) * b(31) + b(45) = b(45) - lu(211) * b(31) + b(50) = b(50) - lu(212) * b(31) + b(38) = b(38) - lu(226) * b(32) + b(40) = b(40) - lu(227) * b(32) + b(41) = b(41) - lu(228) * b(32) + b(43) = b(43) - lu(229) * b(32) + b(44) = b(44) - lu(230) * b(32) + b(47) = b(47) - lu(231) * b(32) + b(48) = b(48) - lu(232) * b(32) + b(49) = b(49) - lu(233) * b(32) + b(35) = b(35) - lu(238) * b(33) + b(38) = b(38) - lu(239) * b(33) + b(40) = b(40) - lu(240) * b(33) + b(43) = b(43) - lu(241) * b(33) + b(44) = b(44) - lu(242) * b(33) + b(45) = b(45) - lu(243) * b(33) + b(47) = b(47) - lu(244) * b(33) + b(50) = b(50) - lu(245) * b(33) + b(35) = b(35) - lu(251) * b(34) + b(38) = b(38) - lu(252) * b(34) + b(39) = b(39) - lu(253) * b(34) + b(40) = b(40) - lu(254) * b(34) + b(41) = b(41) - lu(255) * b(34) + b(42) = b(42) - lu(256) * b(34) + b(43) = b(43) - lu(257) * b(34) + b(44) = b(44) - lu(258) * b(34) + b(45) = b(45) - lu(259) * b(34) + b(46) = b(46) - lu(260) * b(34) + b(47) = b(47) - lu(261) * b(34) + b(50) = b(50) - lu(262) * b(34) + b(38) = b(38) - lu(268) * b(35) + b(40) = b(40) - lu(269) * b(35) + b(42) = b(42) - lu(270) * b(35) + b(43) = b(43) - lu(271) * b(35) + b(44) = b(44) - lu(272) * b(35) + b(45) = b(45) - lu(273) * b(35) + b(46) = b(46) - lu(274) * b(35) + b(47) = b(47) - lu(275) * b(35) + b(50) = b(50) - lu(276) * b(35) + b(37) = b(37) - lu(286) * b(36) + b(38) = b(38) - lu(287) * b(36) + b(39) = b(39) - lu(288) * b(36) + b(40) = b(40) - lu(289) * b(36) + b(41) = b(41) - lu(290) * b(36) + b(42) = b(42) - lu(291) * b(36) + b(43) = b(43) - lu(292) * b(36) + b(44) = b(44) - lu(293) * b(36) + b(45) = b(45) - lu(294) * b(36) + b(46) = b(46) - lu(295) * b(36) + b(47) = b(47) - lu(296) * b(36) + b(48) = b(48) - lu(297) * b(36) + b(49) = b(49) - lu(298) * b(36) + b(50) = b(50) - lu(299) * b(36) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(38) = b(38) - lu(313) * b(37) + b(39) = b(39) - lu(314) * b(37) + b(40) = b(40) - lu(315) * b(37) + b(41) = b(41) - lu(316) * b(37) + b(42) = b(42) - lu(317) * b(37) + b(43) = b(43) - lu(318) * b(37) + b(44) = b(44) - lu(319) * b(37) + b(45) = b(45) - lu(320) * b(37) + b(46) = b(46) - lu(321) * b(37) + b(47) = b(47) - lu(322) * b(37) + b(48) = b(48) - lu(323) * b(37) + b(49) = b(49) - lu(324) * b(37) + b(50) = b(50) - lu(325) * b(37) + b(40) = b(40) - lu(330) * b(38) + b(41) = b(41) - lu(331) * b(38) + b(42) = b(42) - lu(332) * b(38) + b(43) = b(43) - lu(333) * b(38) + b(44) = b(44) - lu(334) * b(38) + b(45) = b(45) - lu(335) * b(38) + b(46) = b(46) - lu(336) * b(38) + b(47) = b(47) - lu(337) * b(38) + b(48) = b(48) - lu(338) * b(38) + b(49) = b(49) - lu(339) * b(38) + b(50) = b(50) - lu(340) * b(38) + b(40) = b(40) - lu(351) * b(39) + b(41) = b(41) - lu(352) * b(39) + b(42) = b(42) - lu(353) * b(39) + b(43) = b(43) - lu(354) * b(39) + b(44) = b(44) - lu(355) * b(39) + b(45) = b(45) - lu(356) * b(39) + b(46) = b(46) - lu(357) * b(39) + b(47) = b(47) - lu(358) * b(39) + b(48) = b(48) - lu(359) * b(39) + b(49) = b(49) - lu(360) * b(39) + b(50) = b(50) - lu(361) * b(39) + b(41) = b(41) - lu(377) * b(40) + b(42) = b(42) - lu(378) * b(40) + b(43) = b(43) - lu(379) * b(40) + b(44) = b(44) - lu(380) * b(40) + b(45) = b(45) - lu(381) * b(40) + b(46) = b(46) - lu(382) * b(40) + b(47) = b(47) - lu(383) * b(40) + b(48) = b(48) - lu(384) * b(40) + b(49) = b(49) - lu(385) * b(40) + b(50) = b(50) - lu(386) * b(40) + b(42) = b(42) - lu(403) * b(41) + b(43) = b(43) - lu(404) * b(41) + b(44) = b(44) - lu(405) * b(41) + b(45) = b(45) - lu(406) * b(41) + b(46) = b(46) - lu(407) * b(41) + b(47) = b(47) - lu(408) * b(41) + b(48) = b(48) - lu(409) * b(41) + b(49) = b(49) - lu(410) * b(41) + b(50) = b(50) - lu(411) * b(41) + b(43) = b(43) - lu(428) * b(42) + b(44) = b(44) - lu(429) * b(42) + b(45) = b(45) - lu(430) * b(42) + b(46) = b(46) - lu(431) * b(42) + b(47) = b(47) - lu(432) * b(42) + b(48) = b(48) - lu(433) * b(42) + b(49) = b(49) - lu(434) * b(42) + b(50) = b(50) - lu(435) * b(42) + b(44) = b(44) - lu(460) * b(43) + b(45) = b(45) - lu(461) * b(43) + b(46) = b(46) - lu(462) * b(43) + b(47) = b(47) - lu(463) * b(43) + b(48) = b(48) - lu(464) * b(43) + b(49) = b(49) - lu(465) * b(43) + b(50) = b(50) - lu(466) * b(43) + b(45) = b(45) - lu(500) * b(44) + b(46) = b(46) - lu(501) * b(44) + b(47) = b(47) - lu(502) * b(44) + b(48) = b(48) - lu(503) * b(44) + b(49) = b(49) - lu(504) * b(44) + b(50) = b(50) - lu(505) * b(44) + b(46) = b(46) - lu(521) * b(45) + b(47) = b(47) - lu(522) * b(45) + b(48) = b(48) - lu(523) * b(45) + b(49) = b(49) - lu(524) * b(45) + b(50) = b(50) - lu(525) * b(45) + b(47) = b(47) - lu(545) * b(46) + b(48) = b(48) - lu(546) * b(46) + b(49) = b(49) - lu(547) * b(46) + b(50) = b(50) - lu(548) * b(46) + b(48) = b(48) - lu(569) * b(47) + b(49) = b(49) - lu(570) * b(47) + b(50) = b(50) - lu(571) * b(47) + b(49) = b(49) - lu(592) * b(48) + b(50) = b(50) - lu(593) * b(48) + b(50) = b(50) - lu(611) * b(49) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(50) = b(50) * lu(630) + b(49) = b(49) - lu(629) * b(50) + b(48) = b(48) - lu(628) * b(50) + b(47) = b(47) - lu(627) * b(50) + b(46) = b(46) - lu(626) * b(50) + b(45) = b(45) - lu(625) * b(50) + b(44) = b(44) - lu(624) * b(50) + b(43) = b(43) - lu(623) * b(50) + b(42) = b(42) - lu(622) * b(50) + b(41) = b(41) - lu(621) * b(50) + b(40) = b(40) - lu(620) * b(50) + b(39) = b(39) - lu(619) * b(50) + b(38) = b(38) - lu(618) * b(50) + b(37) = b(37) - lu(617) * b(50) + b(35) = b(35) - lu(616) * b(50) + b(34) = b(34) - lu(615) * b(50) + b(33) = b(33) - lu(614) * b(50) + b(32) = b(32) - lu(613) * b(50) + b(11) = b(11) - lu(612) * b(50) + b(49) = b(49) * lu(610) + b(48) = b(48) - lu(609) * b(49) + b(47) = b(47) - lu(608) * b(49) + b(46) = b(46) - lu(607) * b(49) + b(45) = b(45) - lu(606) * b(49) + b(44) = b(44) - lu(605) * b(49) + b(43) = b(43) - lu(604) * b(49) + b(42) = b(42) - lu(603) * b(49) + b(41) = b(41) - lu(602) * b(49) + b(40) = b(40) - lu(601) * b(49) + b(39) = b(39) - lu(600) * b(49) + b(38) = b(38) - lu(599) * b(49) + b(37) = b(37) - lu(598) * b(49) + b(36) = b(36) - lu(597) * b(49) + b(32) = b(32) - lu(596) * b(49) + b(3) = b(3) - lu(595) * b(49) + b(2) = b(2) - lu(594) * b(49) + b(48) = b(48) * lu(591) + b(47) = b(47) - lu(590) * b(48) + b(46) = b(46) - lu(589) * b(48) + b(45) = b(45) - lu(588) * b(48) + b(44) = b(44) - lu(587) * b(48) + b(43) = b(43) - lu(586) * b(48) + b(42) = b(42) - lu(585) * b(48) + b(41) = b(41) - lu(584) * b(48) + b(40) = b(40) - lu(583) * b(48) + b(39) = b(39) - lu(582) * b(48) + b(38) = b(38) - lu(581) * b(48) + b(37) = b(37) - lu(580) * b(48) + b(36) = b(36) - lu(579) * b(48) + b(35) = b(35) - lu(578) * b(48) + b(34) = b(34) - lu(577) * b(48) + b(32) = b(32) - lu(576) * b(48) + b(28) = b(28) - lu(575) * b(48) + b(25) = b(25) - lu(574) * b(48) + b(24) = b(24) - lu(573) * b(48) + b(23) = b(23) - lu(572) * b(48) + b(47) = b(47) * lu(568) + b(46) = b(46) - lu(567) * b(47) + b(45) = b(45) - lu(566) * b(47) + b(44) = b(44) - lu(565) * b(47) + b(43) = b(43) - lu(564) * b(47) + b(42) = b(42) - lu(563) * b(47) + b(41) = b(41) - lu(562) * b(47) + b(40) = b(40) - lu(561) * b(47) + b(39) = b(39) - lu(560) * b(47) + b(38) = b(38) - lu(559) * b(47) + b(35) = b(35) - lu(558) * b(47) + b(34) = b(34) - lu(557) * b(47) + b(33) = b(33) - lu(556) * b(47) + b(32) = b(32) - lu(555) * b(47) + b(31) = b(31) - lu(554) * b(47) + b(27) = b(27) - lu(553) * b(47) + b(26) = b(26) - lu(552) * b(47) + b(7) = b(7) - lu(551) * b(47) + b(5) = b(5) - lu(550) * b(47) + b(3) = b(3) - lu(549) * b(47) + b(46) = b(46) * lu(544) + b(45) = b(45) - lu(543) * b(46) + b(44) = b(44) - lu(542) * b(46) + b(43) = b(43) - lu(541) * b(46) + b(42) = b(42) - lu(540) * b(46) + b(41) = b(41) - lu(539) * b(46) + b(40) = b(40) - lu(538) * b(46) + b(39) = b(39) - lu(537) * b(46) + b(38) = b(38) - lu(536) * b(46) + b(37) = b(37) - lu(535) * b(46) + b(36) = b(36) - lu(534) * b(46) + b(35) = b(35) - lu(533) * b(46) + b(33) = b(33) - lu(532) * b(46) + b(31) = b(31) - lu(531) * b(46) + b(30) = b(30) - lu(530) * b(46) + b(29) = b(29) - lu(529) * b(46) + b(22) = b(22) - lu(528) * b(46) + b(8) = b(8) - lu(527) * b(46) + b(6) = b(6) - lu(526) * b(46) + b(45) = b(45) * lu(520) + b(44) = b(44) - lu(519) * b(45) + b(43) = b(43) - lu(518) * b(45) + b(42) = b(42) - lu(517) * b(45) + b(41) = b(41) - lu(516) * b(45) + b(40) = b(40) - lu(515) * b(45) + b(39) = b(39) - lu(514) * b(45) + b(38) = b(38) - lu(513) * b(45) + b(35) = b(35) - lu(512) * b(45) + b(34) = b(34) - lu(511) * b(45) + b(33) = b(33) - lu(510) * b(45) + b(32) = b(32) - lu(509) * b(45) + b(31) = b(31) - lu(508) * b(45) + b(16) = b(16) - lu(507) * b(45) + b(10) = b(10) - lu(506) * b(45) + b(44) = b(44) * lu(499) + b(43) = b(43) - lu(498) * b(44) + b(42) = b(42) - lu(497) * b(44) + b(41) = b(41) - lu(496) * b(44) + b(40) = b(40) - lu(495) * b(44) + b(39) = b(39) - lu(494) * b(44) + b(38) = b(38) - lu(493) * b(44) + b(37) = b(37) - lu(492) * b(44) + b(36) = b(36) - lu(491) * b(44) + b(35) = b(35) - lu(490) * b(44) + b(34) = b(34) - lu(489) * b(44) + b(33) = b(33) - lu(488) * b(44) + b(32) = b(32) - lu(487) * b(44) + b(31) = b(31) - lu(486) * b(44) + b(30) = b(30) - lu(485) * b(44) + b(29) = b(29) - lu(484) * b(44) + b(28) = b(28) - lu(483) * b(44) + b(27) = b(27) - lu(482) * b(44) + b(25) = b(25) - lu(481) * b(44) + b(24) = b(24) - lu(480) * b(44) + b(23) = b(23) - lu(479) * b(44) + b(22) = b(22) - lu(478) * b(44) + b(21) = b(21) - lu(477) * b(44) + b(20) = b(20) - lu(476) * b(44) + b(19) = b(19) - lu(475) * b(44) + b(18) = b(18) - lu(474) * b(44) + b(17) = b(17) - lu(473) * b(44) + b(16) = b(16) - lu(472) * b(44) + b(15) = b(15) - lu(471) * b(44) + b(14) = b(14) - lu(470) * b(44) + b(13) = b(13) - lu(469) * b(44) + b(3) = b(3) - lu(468) * b(44) + b(2) = b(2) - lu(467) * b(44) + b(43) = b(43) * lu(459) + b(42) = b(42) - lu(458) * b(43) + b(41) = b(41) - lu(457) * b(43) + b(40) = b(40) - lu(456) * b(43) + b(39) = b(39) - lu(455) * b(43) + b(38) = b(38) - lu(454) * b(43) + b(37) = b(37) - lu(453) * b(43) + b(36) = b(36) - lu(452) * b(43) + b(35) = b(35) - lu(451) * b(43) + b(34) = b(34) - lu(450) * b(43) + b(33) = b(33) - lu(449) * b(43) + b(32) = b(32) - lu(448) * b(43) + b(31) = b(31) - lu(447) * b(43) + b(30) = b(30) - lu(446) * b(43) + b(29) = b(29) - lu(445) * b(43) + b(28) = b(28) - lu(444) * b(43) + b(27) = b(27) - lu(443) * b(43) + b(26) = b(26) - lu(442) * b(43) + b(18) = b(18) - lu(441) * b(43) + b(16) = b(16) - lu(440) * b(43) + b(12) = b(12) - lu(439) * b(43) + b(11) = b(11) - lu(438) * b(43) + b(7) = b(7) - lu(437) * b(43) + b(5) = b(5) - lu(436) * b(43) + b(42) = b(42) * lu(427) + b(41) = b(41) - lu(426) * b(42) + b(40) = b(40) - lu(425) * b(42) + b(39) = b(39) - lu(424) * b(42) + b(38) = b(38) - lu(423) * b(42) + b(37) = b(37) - lu(422) * b(42) + b(35) = b(35) - lu(421) * b(42) + b(34) = b(34) - lu(420) * b(42) + b(33) = b(33) - lu(419) * b(42) + b(32) = b(32) - lu(418) * b(42) + b(31) = b(31) - lu(417) * b(42) + b(30) = b(30) - lu(416) * b(42) + b(29) = b(29) - lu(415) * b(42) + b(18) = b(18) - lu(414) * b(42) + b(16) = b(16) - lu(413) * b(42) + b(6) = b(6) - lu(412) * b(42) + b(41) = b(41) * lu(402) + b(40) = b(40) - lu(401) * b(41) + b(39) = b(39) - lu(400) * b(41) + b(38) = b(38) - lu(399) * b(41) + b(37) = b(37) - lu(398) * b(41) + b(36) = b(36) - lu(397) * b(41) + b(35) = b(35) - lu(396) * b(41) + b(34) = b(34) - lu(395) * b(41) + b(33) = b(33) - lu(394) * b(41) + b(32) = b(32) - lu(393) * b(41) + b(29) = b(29) - lu(392) * b(41) + b(27) = b(27) - lu(391) * b(41) + b(22) = b(22) - lu(390) * b(41) + b(18) = b(18) - lu(389) * b(41) + b(12) = b(12) - lu(388) * b(41) + b(11) = b(11) - lu(387) * b(41) + b(40) = b(40) * lu(376) + b(39) = b(39) - lu(375) * b(40) + b(38) = b(38) - lu(374) * b(40) + b(37) = b(37) - lu(373) * b(40) + b(36) = b(36) - lu(372) * b(40) + b(35) = b(35) - lu(371) * b(40) + b(33) = b(33) - lu(370) * b(40) + b(32) = b(32) - lu(369) * b(40) + b(31) = b(31) - lu(368) * b(40) + b(30) = b(30) - lu(367) * b(40) + b(28) = b(28) - lu(366) * b(40) + b(22) = b(22) - lu(365) * b(40) + b(17) = b(17) - lu(364) * b(40) + b(12) = b(12) - lu(363) * b(40) + b(10) = b(10) - lu(362) * b(40) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(39) = b(39) * lu(350) + b(38) = b(38) - lu(349) * b(39) + b(37) = b(37) - lu(348) * b(39) + b(36) = b(36) - lu(347) * b(39) + b(35) = b(35) - lu(346) * b(39) + b(34) = b(34) - lu(345) * b(39) + b(33) = b(33) - lu(344) * b(39) + b(32) = b(32) - lu(343) * b(39) + b(27) = b(27) - lu(342) * b(39) + b(16) = b(16) - lu(341) * b(39) + b(38) = b(38) * lu(329) + b(35) = b(35) - lu(328) * b(38) + b(33) = b(33) - lu(327) * b(38) + b(32) = b(32) - lu(326) * b(38) + b(37) = b(37) * lu(312) + b(36) = b(36) - lu(311) * b(37) + b(35) = b(35) - lu(310) * b(37) + b(34) = b(34) - lu(309) * b(37) + b(33) = b(33) - lu(308) * b(37) + b(32) = b(32) - lu(307) * b(37) + b(31) = b(31) - lu(306) * b(37) + b(30) = b(30) - lu(305) * b(37) + b(29) = b(29) - lu(304) * b(37) + b(8) = b(8) - lu(303) * b(37) + b(6) = b(6) - lu(302) * b(37) + b(4) = b(4) - lu(301) * b(37) + b(1) = b(1) - lu(300) * b(37) + b(36) = b(36) * lu(285) + b(35) = b(35) - lu(284) * b(36) + b(33) = b(33) - lu(283) * b(36) + b(32) = b(32) - lu(282) * b(36) + b(31) = b(31) - lu(281) * b(36) + b(22) = b(22) - lu(280) * b(36) + b(17) = b(17) - lu(279) * b(36) + b(8) = b(8) - lu(278) * b(36) + b(4) = b(4) - lu(277) * b(36) + b(35) = b(35) * lu(267) + b(33) = b(33) - lu(266) * b(35) + b(31) = b(31) - lu(265) * b(35) + b(26) = b(26) - lu(264) * b(35) + b(9) = b(9) - lu(263) * b(35) + b(34) = b(34) * lu(250) + b(33) = b(33) - lu(249) * b(34) + b(31) = b(31) - lu(248) * b(34) + b(27) = b(27) - lu(247) * b(34) + b(16) = b(16) - lu(246) * b(34) + b(33) = b(33) * lu(237) + b(31) = b(31) - lu(236) * b(33) + b(26) = b(26) - lu(235) * b(33) + b(9) = b(9) - lu(234) * b(33) + b(32) = b(32) * lu(225) + b(28) = b(28) - lu(224) * b(32) + b(25) = b(25) - lu(223) * b(32) + b(24) = b(24) - lu(222) * b(32) + b(23) = b(23) - lu(221) * b(32) + b(21) = b(21) - lu(220) * b(32) + b(20) = b(20) - lu(219) * b(32) + b(19) = b(19) - lu(218) * b(32) + b(15) = b(15) - lu(217) * b(32) + b(14) = b(14) - lu(216) * b(32) + b(13) = b(13) - lu(215) * b(32) + b(3) = b(3) - lu(214) * b(32) + b(2) = b(2) - lu(213) * b(32) + b(31) = b(31) * lu(205) + b(26) = b(26) - lu(204) * b(31) + b(9) = b(9) - lu(203) * b(31) + b(30) = b(30) * lu(193) + b(29) = b(29) - lu(192) * b(30) + b(6) = b(6) - lu(191) * b(30) + b(29) = b(29) * lu(184) + b(6) = b(6) - lu(183) * b(29) + b(28) = b(28) * lu(174) + b(25) = b(25) - lu(173) * b(28) + b(24) = b(24) - lu(172) * b(28) + b(23) = b(23) - lu(171) * b(28) + b(21) = b(21) - lu(170) * b(28) + b(19) = b(19) - lu(169) * b(28) + b(27) = b(27) * lu(162) + b(26) = b(26) * lu(154) + b(9) = b(9) - lu(153) * b(26) + b(25) = b(25) * lu(144) + b(24) = b(24) - lu(143) * b(25) + b(23) = b(23) - lu(142) * b(25) + b(21) = b(21) - lu(141) * b(25) + b(20) = b(20) - lu(140) * b(25) + b(19) = b(19) - lu(139) * b(25) + b(15) = b(15) - lu(138) * b(25) + b(14) = b(14) - lu(137) * b(25) + b(13) = b(13) - lu(136) * b(25) + b(24) = b(24) * lu(129) + b(15) = b(15) - lu(128) * b(24) + b(23) = b(23) * lu(120) + b(22) = b(22) * lu(112) + b(8) = b(8) - lu(111) * b(22) + b(21) = b(21) * lu(102) + b(16) = b(16) - lu(101) * b(21) + b(20) = b(20) * lu(91) + b(15) = b(15) - lu(90) * b(20) + b(19) = b(19) * lu(83) + b(18) = b(18) * lu(76) + b(17) = b(17) * lu(68) + b(16) = b(16) * lu(64) + b(15) = b(15) * lu(59) + b(14) = b(14) * lu(53) + b(13) = b(13) * lu(46) + b(12) = b(12) * lu(39) + b(11) = b(11) * lu(33) + b(10) = b(10) * lu(27) + b(9) = b(9) * lu(24) + b(8) = b(8) * lu(21) + b(7) = b(7) * lu(17) + b(6) = b(6) * lu(15) + b(5) = b(5) * lu(12) + b(4) = b(4) * lu(9) + b(3) = b(3) * lu(7) + b(2) = b(2) - lu(6) * b(3) + b(2) = b(2) * lu(4) + b(1) = b(1) * lu(1) + end subroutine lu_slv04 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 new file mode 100644 index 0000000000..39f52cfe02 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 @@ -0,0 +1,1027 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(610) = -(rxt(89)*y(2) + rxt(107)*y(3) + rxt(133)*y(21) + rxt(138)*y(22) & + + rxt(146)*y(23) + rxt(159)*y(9) + rxt(162)*y(10) + rxt(174) & + *y(28) + rxt(201)*y(37)) + mat(504) = -rxt(89)*y(1) + mat(570) = -rxt(107)*y(1) + mat(339) = -rxt(133)*y(1) + mat(465) = -rxt(138)*y(1) + mat(410) = -rxt(146)*y(1) + mat(592) = -rxt(159)*y(1) + mat(385) = -rxt(162)*y(1) + mat(434) = -rxt(174)*y(1) + mat(360) = -rxt(201)*y(1) + mat(504) = mat(504) + rxt(88)*y(4) + mat(233) = rxt(88)*y(2) + mat(499) = -(rxt(88)*y(4) + rxt(89)*y(1) + 4._r8*rxt(90)*y(2) + rxt(137) & + *y(22) + rxt(144)*y(20) + rxt(145)*y(23) + rxt(148)*y(24) & + + rxt(157)*y(9) + (rxt(160) + rxt(161)) * y(10) + rxt(168)*y(11) & + + rxt(181)*y(30) + rxt(194)*y(33) + rxt(195)*y(34) + rxt(198) & + *y(35) + rxt(204)*y(38) + rxt(214)*y(39) + rxt(215)*y(40) & + + rxt(216)*y(41) + rxt(238)*y(18) + (rxt(265) + rxt(266) & + ) * y(65) + rxt(272)*y(67)) + mat(230) = -rxt(88)*y(2) + mat(605) = -rxt(89)*y(2) + mat(460) = -rxt(137)*y(2) + mat(272) = -rxt(144)*y(2) + mat(405) = -rxt(145)*y(2) + mat(81) = -rxt(148)*y(2) + mat(587) = -rxt(157)*y(2) + mat(380) = -(rxt(160) + rxt(161)) * y(2) + mat(519) = -rxt(168)*y(2) + mat(319) = -rxt(181)*y(2) + mat(542) = -rxt(194)*y(2) + mat(189) = -rxt(195)*y(2) + mat(200) = -rxt(198)*y(2) + mat(293) = -rxt(204)*y(2) + mat(167) = -rxt(214)*y(2) + mat(118) = -rxt(215)*y(2) + mat(74) = -rxt(216)*y(2) + mat(258) = -rxt(238)*y(2) + mat(98) = -(rxt(265) + rxt(266)) * y(2) + mat(89) = -rxt(272)*y(2) + mat(565) = (rxt(102)+rxt(103))*y(4) + mat(230) = mat(230) + (rxt(102)+rxt(103))*y(3) + rxt(152)*y(8) + rxt(271) & + *y(67) + rxt(263)*y(68) + rxt(284)*y(73) + mat(180) = rxt(152)*y(4) + rxt(153)*y(9) + rxt(154)*y(10) + rxt(268)*y(66) + mat(587) = mat(587) + rxt(153)*y(8) + mat(380) = mat(380) + rxt(154)*y(8) + mat(460) = mat(460) + 2.000_r8*rxt(140)*y(22) + mat(334) = rxt(136)*y(23) + mat(405) = mat(405) + rxt(136)*y(21) + mat(125) = rxt(268)*y(8) + 1.150_r8*rxt(276)*y(70) + mat(89) = mat(89) + rxt(271)*y(4) + mat(110) = rxt(263)*y(4) + mat(133) = rxt(275)*y(70) + mat(150) = 1.150_r8*rxt(276)*y(66) + rxt(275)*y(69) + mat(58) = rxt(284)*y(4) + mat(568) = -((rxt(102) + rxt(103)) * y(4) + rxt(104)*y(74) + rxt(107)*y(1) & + + rxt(124)*y(60) + rxt(125)*y(61) + rxt(129)*y(20) + rxt(130) & + *y(33) + rxt(131)*y(39)) + mat(231) = -(rxt(102) + rxt(103)) * y(3) + mat(244) = -rxt(104)*y(3) + mat(608) = -rxt(107)*y(3) + mat(14) = -rxt(124)*y(3) + mat(20) = -rxt(125)*y(3) + mat(275) = -rxt(129)*y(3) + mat(545) = -rxt(130)*y(3) + mat(168) = -rxt(131)*y(3) + mat(231) = mat(231) + rxt(149)*y(71) + mat(126) = .850_r8*rxt(276)*y(70) + mat(62) = rxt(149)*y(4) + mat(151) = .850_r8*rxt(276)*y(66) + mat(225) = -(rxt(88)*y(2) + rxt(98)*y(6) + rxt(102)*y(3) + rxt(132)*y(21) & + + rxt(149)*y(71) + rxt(152)*y(8) + rxt(263)*y(68) + (rxt(270) & + + rxt(271)) * y(67) + rxt(273)*y(65) + rxt(284)*y(73)) + mat(487) = -rxt(88)*y(4) + mat(5) = -rxt(98)*y(4) + mat(555) = -rxt(102)*y(4) + mat(326) = -rxt(132)*y(4) + mat(61) = -rxt(149)*y(4) + mat(175) = -rxt(152)*y(4) + mat(106) = -rxt(263)*y(4) + mat(88) = -(rxt(270) + rxt(271)) * y(4) + mat(97) = -rxt(273)*y(4) + mat(57) = -rxt(284)*y(4) + mat(596) = 2.000_r8*rxt(89)*y(2) + 2.000_r8*rxt(107)*y(3) + rxt(159)*y(9) & + + rxt(162)*y(10) + rxt(138)*y(22) + rxt(133)*y(21) & + + 2.000_r8*rxt(146)*y(23) + rxt(174)*y(28) + rxt(201)*y(37) + mat(487) = mat(487) + 2.000_r8*rxt(89)*y(1) + 2.000_r8*rxt(90)*y(2) + rxt(97) & + *y(6) + rxt(160)*y(10) + rxt(137)*y(22) + rxt(168)*y(11) & + + rxt(145)*y(23) + rxt(181)*y(30) + rxt(204)*y(38) + mat(555) = mat(555) + 2.000_r8*rxt(107)*y(1) + mat(225) = mat(225) + 2.000_r8*rxt(98)*y(6) + mat(5) = mat(5) + rxt(97)*y(2) + 2.000_r8*rxt(98)*y(4) + mat(175) = mat(175) + rxt(156)*y(10) + mat(576) = rxt(159)*y(1) + rxt(269)*y(66) + mat(369) = rxt(162)*y(1) + rxt(160)*y(2) + rxt(156)*y(8) + mat(448) = rxt(138)*y(1) + rxt(137)*y(2) + rxt(172)*y(13) + rxt(139)*y(23) & + + rxt(183)*y(30) + mat(509) = rxt(168)*y(2) + rxt(170)*y(23) + mat(40) = rxt(172)*y(22) + mat(613) = rxt(240)*y(23) + mat(326) = mat(326) + rxt(133)*y(1) + rxt(135)*y(23) + mat(393) = 2.000_r8*rxt(146)*y(1) + rxt(145)*y(2) + rxt(139)*y(22) + rxt(170) & + *y(11) + rxt(240)*y(16) + rxt(135)*y(21) + 2.000_r8*rxt(147) & + *y(23) + rxt(177)*y(28) + rxt(184)*y(30) + rxt(202)*y(37) & + + rxt(206)*y(38) + mat(418) = rxt(174)*y(1) + rxt(177)*y(23) + mat(307) = rxt(181)*y(2) + rxt(183)*y(22) + rxt(184)*y(23) + ( & + + 2.000_r8*rxt(188)+2.000_r8*rxt(189))*y(30) + (rxt(210) & + +rxt(211))*y(38) + mat(343) = rxt(201)*y(1) + rxt(202)*y(23) + mat(282) = rxt(204)*y(2) + rxt(206)*y(23) + (rxt(210)+rxt(211))*y(30) & + + 2.000_r8*rxt(212)*y(38) + mat(124) = rxt(269)*y(9) + mat(7) = -(rxt(91)*y(2) + rxt(92)*y(4) + rxt(94)*y(1)) + mat(468) = -rxt(91)*y(5) + mat(214) = -rxt(92)*y(5) + mat(595) = -rxt(94)*y(5) + mat(549) = rxt(102)*y(4) + mat(214) = mat(214) + rxt(102)*y(3) + mat(4) = -(rxt(97)*y(2) + rxt(98)*y(4)) + mat(467) = -rxt(97)*y(6) + mat(213) = -rxt(98)*y(6) + mat(594) = rxt(94)*y(5) + mat(467) = mat(467) + rxt(91)*y(5) + mat(213) = mat(213) + rxt(92)*y(5) + mat(6) = rxt(94)*y(1) + rxt(91)*y(2) + rxt(92)*y(4) + mat(267) = -(rxt(129)*y(3) + rxt(142)*y(22) + rxt(144)*y(2) + rxt(175)*y(28) & + + rxt(218)*y(63)) + mat(558) = -rxt(129)*y(20) + mat(451) = -rxt(142)*y(20) + mat(490) = -rxt(144)*y(20) + mat(421) = -rxt(175)*y(20) + mat(157) = -rxt(218)*y(20) + mat(328) = rxt(135)*y(23) + mat(396) = rxt(135)*y(21) + mat(64) = -((rxt(234) + rxt(235)) * y(22)) + mat(440) = -(rxt(234) + rxt(235)) * y(19) + mat(472) = rxt(238)*y(18) + mat(440) = mat(440) + rxt(237)*y(18) + mat(507) = rxt(236)*y(18) + mat(246) = rxt(238)*y(2) + rxt(237)*y(22) + rxt(236)*y(11) + rxt(179)*y(28) & + + rxt(203)*y(37) + mat(413) = rxt(179)*y(18) + mat(341) = rxt(203)*y(18) + mat(174) = -(rxt(151)*y(22) + rxt(152)*y(4) + rxt(153)*y(9) + (rxt(154) & + + rxt(155) + rxt(156)) * y(10) + rxt(268)*y(66)) + mat(444) = -rxt(151)*y(8) + mat(224) = -rxt(152)*y(8) + mat(575) = -rxt(153)*y(8) + mat(366) = -(rxt(154) + rxt(155) + rxt(156)) * y(8) + mat(123) = -rxt(268)*y(8) + mat(483) = rxt(272)*y(67) + rxt(150)*y(71) + mat(224) = mat(224) + rxt(270)*y(67) + mat(96) = 1.100_r8*rxt(277)*y(70) + mat(87) = rxt(272)*y(2) + rxt(270)*y(4) + mat(131) = .200_r8*rxt(275)*y(70) + mat(60) = rxt(150)*y(2) + mat(145) = 1.100_r8*rxt(277)*y(65) + .200_r8*rxt(275)*y(69) + mat(591) = -(rxt(153)*y(8) + rxt(157)*y(2) + rxt(158)*y(23) + rxt(159)*y(1) & + + rxt(167)*y(11) + rxt(186)*y(30) + rxt(207)*y(38) + rxt(239) & + *y(16) + rxt(269)*y(66)) + mat(182) = -rxt(153)*y(9) + mat(503) = -rxt(157)*y(9) + mat(409) = -rxt(158)*y(9) + mat(609) = -rxt(159)*y(9) + mat(523) = -rxt(167)*y(9) + mat(323) = -rxt(186)*y(9) + mat(297) = -rxt(207)*y(9) + mat(628) = -rxt(239)*y(9) + mat(127) = -rxt(269)*y(9) + mat(503) = mat(503) + rxt(160)*y(10) + mat(232) = rxt(152)*y(8) + rxt(149)*y(71) + mat(182) = mat(182) + rxt(152)*y(4) + 2.000_r8*rxt(155)*y(10) + rxt(151) & + *y(22) + mat(384) = rxt(160)*y(2) + 2.000_r8*rxt(155)*y(8) + mat(464) = rxt(151)*y(8) + mat(63) = rxt(149)*y(4) + mat(376) = -((rxt(154) + rxt(155) + rxt(156)) * y(8) + (rxt(160) + rxt(161) & + ) * y(2) + rxt(162)*y(1) + rxt(163)*y(11) + rxt(165)*y(22) & + + rxt(171)*y(23) + rxt(187)*y(30) + rxt(208)*y(38)) + mat(177) = -(rxt(154) + rxt(155) + rxt(156)) * y(10) + mat(495) = -(rxt(160) + rxt(161)) * y(10) + mat(601) = -rxt(162)*y(10) + mat(515) = -rxt(163)*y(10) + mat(456) = -rxt(165)*y(10) + mat(401) = -rxt(171)*y(10) + mat(315) = -rxt(187)*y(10) + mat(289) = -rxt(208)*y(10) + mat(601) = mat(601) + rxt(159)*y(9) + mat(495) = mat(495) + rxt(157)*y(9) + rxt(168)*y(11) + mat(583) = rxt(159)*y(1) + rxt(157)*y(2) + 2.000_r8*rxt(167)*y(11) + rxt(239) & + *y(16) + rxt(158)*y(23) + rxt(186)*y(30) + rxt(207)*y(38) + mat(456) = mat(456) + rxt(169)*y(11) + rxt(172)*y(13) + mat(515) = mat(515) + rxt(168)*y(2) + 2.000_r8*rxt(167)*y(9) + rxt(169)*y(22) & + + rxt(170)*y(23) + mat(42) = rxt(172)*y(22) + mat(620) = rxt(239)*y(9) + mat(401) = mat(401) + rxt(158)*y(9) + rxt(170)*y(11) + mat(315) = mat(315) + rxt(186)*y(9) + mat(289) = mat(289) + rxt(207)*y(9) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(459) = -(rxt(137)*y(2) + rxt(138)*y(1) + rxt(139)*y(23) + (4._r8*rxt(140) & + + 4._r8*rxt(141)) * y(22) + rxt(142)*y(20) + rxt(143)*y(24) & + + rxt(151)*y(8) + rxt(165)*y(10) + rxt(166)*y(12) + rxt(169) & + *y(11) + rxt(172)*y(13) + (rxt(182) + rxt(183)) * y(30) + rxt(193) & + *y(33) + rxt(197)*y(34) + rxt(199)*y(35) + rxt(205)*y(38) & + + rxt(213)*y(39) + (rxt(234) + rxt(235)) * y(19) + rxt(237) & + *y(18) + rxt(241)*y(17)) + mat(498) = -rxt(137)*y(22) + mat(604) = -rxt(138)*y(22) + mat(404) = -rxt(139)*y(22) + mat(271) = -rxt(142)*y(22) + mat(80) = -rxt(143)*y(22) + mat(179) = -rxt(151)*y(22) + mat(379) = -rxt(165)*y(22) + mat(210) = -rxt(166)*y(22) + mat(518) = -rxt(169)*y(22) + mat(44) = -rxt(172)*y(22) + mat(318) = -(rxt(182) + rxt(183)) * y(22) + mat(541) = -rxt(193)*y(22) + mat(188) = -rxt(197)*y(22) + mat(199) = -rxt(199)*y(22) + mat(292) = -rxt(205)*y(22) + mat(166) = -rxt(213)*y(22) + mat(67) = -(rxt(234) + rxt(235)) * y(22) + mat(257) = -rxt(237)*y(22) + mat(37) = -rxt(241)*y(22) + mat(604) = mat(604) + rxt(133)*y(21) + rxt(146)*y(23) + mat(498) = mat(498) + rxt(144)*y(20) + rxt(238)*y(18) + rxt(145)*y(23) & + + rxt(148)*y(24) + rxt(194)*y(33) + rxt(195)*y(34) + rxt(214) & + *y(39) + rxt(215)*y(40) + mat(564) = rxt(129)*y(20) + 2.000_r8*rxt(104)*y(74) + rxt(130)*y(33) & + + rxt(131)*y(39) + mat(271) = mat(271) + rxt(144)*y(2) + rxt(129)*y(3) + mat(586) = rxt(158)*y(23) + mat(518) = mat(518) + rxt(170)*y(23) + mat(257) = mat(257) + rxt(238)*y(2) + mat(333) = rxt(133)*y(1) + 2.000_r8*rxt(134)*y(23) + mat(404) = mat(404) + rxt(146)*y(1) + rxt(145)*y(2) + rxt(158)*y(9) & + + rxt(170)*y(11) + 2.000_r8*rxt(134)*y(21) + rxt(178)*y(28) + mat(80) = mat(80) + rxt(148)*y(2) + mat(241) = 2.000_r8*rxt(104)*y(3) + rxt(217)*y(63) + mat(428) = rxt(178)*y(23) + mat(541) = mat(541) + rxt(194)*y(2) + rxt(130)*y(3) + mat(188) = mat(188) + rxt(195)*y(2) + mat(166) = mat(166) + rxt(214)*y(2) + rxt(131)*y(3) + mat(117) = rxt(215)*y(2) + mat(159) = rxt(217)*y(74) + mat(520) = -(rxt(163)*y(10) + rxt(167)*y(9) + rxt(168)*y(2) + rxt(169)*y(22) & + + rxt(170)*y(23) + rxt(236)*y(18)) + mat(381) = -rxt(163)*y(11) + mat(588) = -rxt(167)*y(11) + mat(500) = -rxt(168)*y(11) + mat(461) = -rxt(169)*y(11) + mat(406) = -rxt(170)*y(11) + mat(259) = -rxt(236)*y(11) + mat(606) = rxt(162)*y(10) + mat(500) = mat(500) + rxt(161)*y(10) + rxt(198)*y(35) + rxt(216)*y(41) + mat(381) = mat(381) + rxt(162)*y(1) + rxt(161)*y(2) + mat(461) = mat(461) + rxt(166)*y(12) + rxt(199)*y(35) + mat(211) = rxt(166)*y(22) + rxt(220)*y(63) + mat(430) = rxt(200)*y(35) + mat(201) = rxt(198)*y(2) + rxt(199)*y(22) + rxt(200)*y(28) + mat(75) = rxt(216)*y(2) + mat(160) = rxt(220)*y(12) + mat(205) = -(rxt(166)*y(22) + rxt(220)*y(63)) + mat(447) = -rxt(166)*y(12) + mat(155) = -rxt(220)*y(12) + mat(368) = rxt(165)*y(22) + mat(447) = mat(447) + rxt(165)*y(10) + mat(508) = rxt(236)*y(18) + mat(248) = rxt(236)*y(11) + mat(531) = (rxt(249)+rxt(254)+rxt(260))*y(35) + mat(194) = (rxt(249)+rxt(254)+rxt(260))*y(33) + mat(39) = -(rxt(172)*y(22)) + mat(439) = -rxt(172)*y(13) + mat(363) = rxt(171)*y(23) + mat(388) = rxt(171)*y(10) + mat(362) = rxt(163)*y(11) + mat(506) = rxt(163)*y(10) + mat(630) = -(rxt(185)*y(30) + rxt(239)*y(9) + rxt(240)*y(23)) + mat(325) = -rxt(185)*y(16) + mat(593) = -rxt(239)*y(16) + mat(411) = -rxt(240)*y(16) + mat(466) = rxt(241)*y(17) + mat(38) = rxt(241)*y(22) + mat(33) = -(rxt(241)*y(22)) + mat(438) = -rxt(241)*y(17) + mat(612) = rxt(240)*y(23) + mat(387) = rxt(240)*y(16) + mat(250) = -(rxt(179)*y(28) + rxt(203)*y(37) + rxt(236)*y(11) + rxt(237) & + *y(22) + rxt(238)*y(2)) + mat(420) = -rxt(179)*y(18) + mat(345) = -rxt(203)*y(18) + mat(511) = -rxt(236)*y(18) + mat(450) = -rxt(237)*y(18) + mat(489) = -rxt(238)*y(18) + mat(577) = rxt(239)*y(16) + mat(615) = rxt(239)*y(9) + rxt(185)*y(30) + mat(309) = rxt(185)*y(16) + mat(329) = -(rxt(132)*y(4) + rxt(133)*y(1) + (rxt(134) + rxt(135) + rxt(136) & + ) * y(23)) + mat(226) = -rxt(132)*y(21) + mat(599) = -rxt(133)*y(21) + mat(399) = -(rxt(134) + rxt(135) + rxt(136)) * y(21) + mat(493) = rxt(144)*y(20) + rxt(137)*y(22) + mat(559) = rxt(129)*y(20) + mat(268) = rxt(144)*y(2) + rxt(129)*y(3) + rxt(142)*y(22) + rxt(175)*y(28) & + + rxt(218)*y(63) + mat(65) = rxt(234)*y(22) + mat(176) = rxt(151)*y(22) + mat(454) = rxt(137)*y(2) + rxt(142)*y(20) + rxt(234)*y(19) + rxt(151)*y(8) & + + rxt(237)*y(18) + mat(252) = rxt(237)*y(22) + mat(423) = rxt(175)*y(20) + mat(158) = rxt(218)*y(20) + mat(402) = -((rxt(134) + rxt(135) + rxt(136)) * y(21) + rxt(139)*y(22) & + + rxt(145)*y(2) + rxt(146)*y(1) + 4._r8*rxt(147)*y(23) + rxt(158) & + *y(9) + rxt(170)*y(11) + rxt(171)*y(10) + (rxt(177) + rxt(178) & + ) * y(28) + rxt(184)*y(30) + rxt(202)*y(37) + rxt(206)*y(38) & + + rxt(240)*y(16)) + mat(331) = -(rxt(134) + rxt(135) + rxt(136)) * y(23) + mat(457) = -rxt(139)*y(23) + mat(496) = -rxt(145)*y(23) + mat(602) = -rxt(146)*y(23) + mat(584) = -rxt(158)*y(23) + mat(516) = -rxt(170)*y(23) + mat(377) = -rxt(171)*y(23) + mat(426) = -(rxt(177) + rxt(178)) * y(23) + mat(316) = -rxt(184)*y(23) + mat(352) = -rxt(202)*y(23) + mat(290) = -rxt(206)*y(23) + mat(621) = -rxt(240)*y(23) + mat(602) = mat(602) + rxt(138)*y(22) + mat(496) = mat(496) + rxt(238)*y(18) + rxt(148)*y(24) + mat(228) = rxt(132)*y(21) + mat(66) = rxt(235)*y(22) + mat(584) = mat(584) + rxt(239)*y(16) + mat(457) = mat(457) + rxt(138)*y(1) + rxt(235)*y(19) + rxt(169)*y(11) & + + rxt(143)*y(24) + rxt(182)*y(30) + rxt(205)*y(38) + mat(516) = mat(516) + rxt(169)*y(22) + rxt(236)*y(18) + mat(621) = mat(621) + rxt(239)*y(9) + rxt(185)*y(30) + mat(255) = rxt(238)*y(2) + rxt(236)*y(11) + rxt(179)*y(28) + rxt(203)*y(37) + mat(331) = mat(331) + rxt(132)*y(4) + mat(78) = rxt(148)*y(2) + rxt(143)*y(22) + rxt(176)*y(28) + mat(426) = mat(426) + rxt(179)*y(18) + rxt(176)*y(24) + mat(316) = mat(316) + rxt(182)*y(22) + rxt(185)*y(16) + mat(352) = mat(352) + rxt(203)*y(18) + mat(290) = mat(290) + rxt(205)*y(22) + mat(76) = -(rxt(143)*y(22) + rxt(148)*y(2) + rxt(176)*y(28)) + mat(441) = -rxt(143)*y(24) + mat(474) = -rxt(148)*y(24) + mat(414) = -rxt(176)*y(24) + mat(441) = mat(441) + 2.000_r8*rxt(141)*y(22) + mat(389) = 2.000_r8*rxt(147)*y(23) + mat(237) = -(rxt(104)*y(3) + rxt(217)*y(63)) + mat(556) = -rxt(104)*y(74) + mat(156) = -rxt(217)*y(74) + mat(266) = rxt(142)*y(22) + mat(449) = rxt(142)*y(20) + 2.000_r8*rxt(140)*y(22) + rxt(166)*y(12) & + + rxt(172)*y(13) + rxt(241)*y(17) + rxt(237)*y(18) + rxt(139) & + *y(23) + rxt(143)*y(24) + rxt(193)*y(33) + rxt(197)*y(34) & + + rxt(213)*y(39) + mat(206) = rxt(166)*y(22) + mat(41) = rxt(172)*y(22) + mat(34) = rxt(241)*y(22) + mat(249) = rxt(237)*y(22) + mat(327) = rxt(136)*y(23) + mat(394) = rxt(139)*y(22) + rxt(136)*y(21) + mat(77) = rxt(143)*y(22) + mat(532) = rxt(193)*y(22) + (rxt(250)+rxt(255)+rxt(261))*y(34) + (rxt(251) & + +rxt(262))*y(40) + mat(185) = rxt(197)*y(22) + (rxt(250)+rxt(255)+rxt(261))*y(33) + mat(163) = rxt(213)*y(22) + mat(113) = (rxt(251)+rxt(262))*y(33) + mat(427) = -(rxt(174)*y(1) + rxt(175)*y(20) + rxt(176)*y(24) + (rxt(177) & + + rxt(178)) * y(23) + rxt(179)*y(18) + rxt(196)*y(34) + rxt(200) & + *y(35)) + mat(603) = -rxt(174)*y(28) + mat(270) = -rxt(175)*y(28) + mat(79) = -rxt(176)*y(28) + mat(403) = -(rxt(177) + rxt(178)) * y(28) + mat(256) = -rxt(179)*y(28) + mat(187) = -rxt(196)*y(28) + mat(198) = -rxt(200)*y(28) + mat(497) = rxt(181)*y(30) + rxt(194)*y(33) + mat(563) = rxt(130)*y(33) + rxt(125)*y(61) + mat(585) = rxt(186)*y(30) + mat(458) = rxt(182)*y(30) + rxt(193)*y(33) + mat(622) = rxt(185)*y(30) + mat(317) = rxt(181)*y(2) + rxt(186)*y(9) + rxt(182)*y(22) + rxt(185)*y(16) + ( & + + 4.000_r8*rxt(188)+2.000_r8*rxt(190))*y(30) + rxt(210)*y(38) + mat(540) = rxt(194)*y(2) + rxt(130)*y(3) + rxt(193)*y(22) + mat(291) = rxt(210)*y(30) + mat(19) = rxt(125)*y(3) + mat(412) = rxt(200)*y(35) + mat(302) = 2.000_r8*rxt(189)*y(30) + mat(526) = (rxt(250)+rxt(255)+rxt(261))*y(34) + (rxt(249)+rxt(254)+rxt(260)) & + *y(35) + mat(183) = (rxt(250)+rxt(255)+rxt(261))*y(33) + mat(191) = rxt(200)*y(28) + (rxt(249)+rxt(254)+rxt(260))*y(33) + mat(312) = -(rxt(181)*y(2) + (rxt(182) + rxt(183)) * y(22) + rxt(184)*y(23) & + + rxt(185)*y(16) + rxt(186)*y(9) + rxt(187)*y(10) + (4._r8*rxt(188) & + + 4._r8*rxt(189) + 4._r8*rxt(190) + 4._r8*rxt(191)) * y(30) & + + (rxt(209) + rxt(210) + rxt(211)) * y(38)) + mat(492) = -rxt(181)*y(30) + mat(453) = -(rxt(182) + rxt(183)) * y(30) + mat(398) = -rxt(184)*y(30) + mat(617) = -rxt(185)*y(30) + mat(580) = -rxt(186)*y(30) + mat(373) = -rxt(187)*y(30) + mat(286) = -(rxt(209) + rxt(210) + rxt(211)) * y(30) + mat(598) = rxt(174)*y(28) + mat(492) = mat(492) + rxt(195)*y(34) + rxt(198)*y(35) + mat(453) = mat(453) + rxt(197)*y(34) + mat(398) = mat(398) + rxt(178)*y(28) + mat(422) = rxt(174)*y(1) + rxt(178)*y(23) + rxt(196)*y(34) + mat(186) = rxt(195)*y(2) + rxt(197)*y(22) + rxt(196)*y(28) + mat(196) = rxt(198)*y(2) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(301) = 2.000_r8*rxt(190)*y(30) + rxt(209)*y(38) + mat(277) = rxt(209)*y(30) + mat(300) = 2.000_r8*rxt(191)*y(30) + mat(544) = -(rxt(130)*y(3) + rxt(193)*y(22) + rxt(194)*y(2) + (rxt(249) & + + rxt(254) + rxt(260)) * y(35) + (rxt(250) + rxt(255) + rxt(261) & + ) * y(34) + (rxt(251) + rxt(262)) * y(40)) + mat(567) = -rxt(130)*y(33) + mat(462) = -rxt(193)*y(33) + mat(501) = -rxt(194)*y(33) + mat(202) = -(rxt(249) + rxt(254) + rxt(260)) * y(33) + mat(190) = -(rxt(250) + rxt(255) + rxt(261)) * y(33) + mat(119) = -(rxt(251) + rxt(262)) * y(33) + mat(274) = rxt(175)*y(28) + mat(462) = mat(462) + rxt(183)*y(30) + mat(260) = rxt(179)*y(28) + mat(407) = rxt(177)*y(28) + mat(82) = rxt(176)*y(28) + mat(431) = rxt(175)*y(20) + rxt(179)*y(18) + rxt(177)*y(23) + rxt(176)*y(24) & + + rxt(196)*y(34) + mat(321) = rxt(183)*y(22) + mat(190) = mat(190) + rxt(196)*y(28) + mat(184) = -(rxt(195)*y(2) + rxt(196)*y(28) + rxt(197)*y(22) + (rxt(250) & + + rxt(255) + rxt(261)) * y(33)) + mat(484) = -rxt(195)*y(34) + mat(415) = -rxt(196)*y(34) + mat(445) = -rxt(197)*y(34) + mat(529) = -(rxt(250) + rxt(255) + rxt(261)) * y(34) + mat(445) = mat(445) + rxt(199)*y(35) + mat(392) = rxt(184)*y(30) + mat(304) = rxt(184)*y(23) + mat(192) = rxt(199)*y(22) + mat(193) = -(rxt(198)*y(2) + rxt(199)*y(22) + rxt(200)*y(28) + (rxt(249) & + + rxt(254) + rxt(260)) * y(33)) + mat(485) = -rxt(198)*y(35) + mat(446) = -rxt(199)*y(35) + mat(416) = -rxt(200)*y(35) + mat(530) = -(rxt(249) + rxt(254) + rxt(260)) * y(35) + mat(367) = rxt(187)*y(30) + mat(305) = rxt(187)*y(10) + mat(303) = rxt(211)*y(38) + mat(527) = (rxt(251)+rxt(262))*y(40) + mat(278) = rxt(211)*y(30) + mat(111) = (rxt(251)+rxt(262))*y(33) + mat(350) = -(rxt(201)*y(1) + rxt(202)*y(23) + rxt(203)*y(18)) + mat(600) = -rxt(201)*y(37) + mat(400) = -rxt(202)*y(37) + mat(253) = -rxt(203)*y(37) + mat(494) = rxt(204)*y(38) + rxt(214)*y(39) + mat(560) = rxt(131)*y(39) + mat(582) = rxt(207)*y(38) + mat(455) = rxt(205)*y(38) + rxt(213)*y(39) + mat(314) = (rxt(209)+rxt(210))*y(38) + mat(288) = rxt(204)*y(2) + rxt(207)*y(9) + rxt(205)*y(22) + (rxt(209) & + +rxt(210))*y(30) + 4.000_r8*rxt(212)*y(38) + mat(165) = rxt(214)*y(2) + rxt(131)*y(3) + rxt(213)*y(22) + mat(285) = -(rxt(204)*y(2) + rxt(205)*y(22) + rxt(206)*y(23) + rxt(207)*y(9) & + + rxt(208)*y(10) + (rxt(209) + rxt(210) + rxt(211)) * y(30) & + + 4._r8*rxt(212)*y(38)) + mat(491) = -rxt(204)*y(38) + mat(452) = -rxt(205)*y(38) + mat(397) = -rxt(206)*y(38) + mat(579) = -rxt(207)*y(38) + mat(372) = -rxt(208)*y(38) + mat(311) = -(rxt(209) + rxt(210) + rxt(211)) * y(38) + mat(597) = rxt(201)*y(37) + mat(491) = mat(491) + rxt(215)*y(40) + rxt(216)*y(41) + mat(347) = rxt(201)*y(1) + mat(114) = rxt(215)*y(2) + mat(71) = rxt(216)*y(2) + mat(162) = -(rxt(131)*y(3) + rxt(213)*y(22) + rxt(214)*y(2)) + mat(553) = -rxt(131)*y(39) + mat(443) = -rxt(213)*y(39) + mat(482) = -rxt(214)*y(39) + mat(247) = rxt(203)*y(37) + mat(391) = rxt(202)*y(37) + mat(342) = rxt(203)*y(18) + rxt(202)*y(23) + mat(112) = -(rxt(215)*y(2) + (rxt(251) + rxt(262)) * y(33)) + mat(478) = -rxt(215)*y(40) + mat(528) = -(rxt(251) + rxt(262)) * y(40) + mat(390) = rxt(206)*y(38) + mat(280) = rxt(206)*y(23) + mat(68) = -(rxt(216)*y(2)) + mat(473) = -rxt(216)*y(41) + mat(364) = rxt(208)*y(38) + mat(279) = rxt(208)*y(10) + mat(91) = -((rxt(265) + rxt(266)) * y(2) + rxt(273)*y(4) + rxt(277)*y(70)) + mat(476) = -(rxt(265) + rxt(266)) * y(65) + mat(219) = -rxt(273)*y(65) + mat(140) = -rxt(277)*y(65) + mat(120) = -(rxt(268)*y(8) + rxt(269)*y(9) + rxt(276)*y(70)) + mat(171) = -rxt(268)*y(66) + mat(572) = -rxt(269)*y(66) + mat(142) = -rxt(276)*y(66) + mat(221) = rxt(273)*y(65) + rxt(270)*y(67) + rxt(263)*y(68) + rxt(284)*y(73) + mat(93) = rxt(273)*y(4) + mat(85) = rxt(270)*y(4) + mat(103) = rxt(263)*y(4) + mat(56) = rxt(284)*y(4) + mat(83) = -((rxt(270) + rxt(271)) * y(4) + rxt(272)*y(2)) + mat(218) = -(rxt(270) + rxt(271)) * y(67) + mat(475) = -rxt(272)*y(67) + mat(102) = -(rxt(263)*y(4)) + mat(220) = -rxt(263)*y(68) + mat(477) = rxt(266)*y(65) + rxt(272)*y(67) + rxt(280)*y(72) + rxt(283)*y(73) + mat(92) = rxt(266)*y(2) + mat(84) = rxt(272)*y(2) + mat(141) = rxt(282)*y(72) + rxt(286)*y(73) + mat(50) = rxt(280)*y(2) + rxt(282)*y(70) + mat(55) = rxt(283)*y(2) + rxt(286)*y(70) + mat(129) = -(rxt(275)*y(70)) + mat(143) = -rxt(275)*y(69) + mat(480) = rxt(265)*y(65) + mat(222) = rxt(271)*y(67) + mat(172) = rxt(268)*y(66) + mat(573) = rxt(269)*y(66) + mat(94) = rxt(265)*y(2) + mat(121) = rxt(268)*y(8) + rxt(269)*y(9) + mat(86) = rxt(271)*y(4) + mat(59) = -(rxt(149)*y(4) + rxt(150)*y(2)) + mat(217) = -rxt(149)*y(71) + mat(471) = -rxt(150)*y(71) + mat(471) = mat(471) + rxt(265)*y(65) + mat(90) = rxt(265)*y(2) + .900_r8*rxt(277)*y(70) + mat(128) = .800_r8*rxt(275)*y(70) + mat(138) = .900_r8*rxt(277)*y(65) + .800_r8*rxt(275)*y(69) + mat(144) = -(rxt(275)*y(69) + rxt(276)*y(66) + rxt(277)*y(65)) + mat(130) = -rxt(275)*y(70) + mat(122) = -rxt(276)*y(70) + mat(95) = -rxt(277)*y(70) + mat(46) = -(rxt(280)*y(2) + (rxt(281) + rxt(282)) * y(70)) + mat(469) = -rxt(280)*y(72) + mat(136) = -(rxt(281) + rxt(282)) * y(72) + mat(53) = -(rxt(283)*y(2) + rxt(284)*y(4) + rxt(286)*y(70)) + mat(470) = -rxt(283)*y(73) + mat(216) = -rxt(284)*y(73) + mat(137) = -rxt(286)*y(73) + mat(137) = mat(137) + rxt(281)*y(72) + mat(47) = rxt(281)*y(70) + mat(12) = -(rxt(124)*y(3)) + mat(550) = -rxt(124)*y(60) + mat(17) = -(rxt(125)*y(3)) + mat(551) = -rxt(125)*y(61) + mat(263) = rxt(218)*y(63) + mat(203) = rxt(220)*y(63) + mat(234) = rxt(217)*y(63) + mat(153) = rxt(218)*y(20) + rxt(220)*y(12) + rxt(217)*y(74) + mat(154) = -(rxt(217)*y(74) + rxt(218)*y(20) + rxt(220)*y(12)) + mat(235) = -rxt(217)*y(63) + mat(264) = -rxt(218)*y(63) + mat(204) = -rxt(220)*y(63) + mat(552) = 2.000_r8*rxt(124)*y(60) + rxt(125)*y(61) + mat(13) = 2.000_r8*rxt(124)*y(3) + mat(18) = rxt(125)*y(3) + end subroutine nlnmat03 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = mat( 4) + lmat( 4) + mat( 5) = mat( 5) + lmat( 5) + mat( 6) = mat( 6) + lmat( 6) + mat( 7) = mat( 7) + lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = mat( 12) + lmat( 12) + mat( 13) = mat( 13) + lmat( 13) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = mat( 17) + lmat( 17) + mat( 18) = mat( 18) + lmat( 18) + mat( 19) = mat( 19) + lmat( 19) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = mat( 33) + lmat( 33) + mat( 35) = lmat( 35) + mat( 36) = lmat( 36) + mat( 37) = mat( 37) + lmat( 37) + mat( 39) = mat( 39) + lmat( 39) + mat( 42) = mat( 42) + lmat( 42) + mat( 43) = lmat( 43) + mat( 44) = mat( 44) + lmat( 44) + mat( 45) = lmat( 45) + mat( 46) = mat( 46) + lmat( 46) + mat( 47) = mat( 47) + lmat( 47) + mat( 48) = lmat( 48) + mat( 49) = lmat( 49) + mat( 50) = mat( 50) + lmat( 50) + mat( 51) = lmat( 51) + mat( 52) = lmat( 52) + mat( 53) = mat( 53) + lmat( 53) + mat( 54) = lmat( 54) + mat( 55) = mat( 55) + lmat( 55) + mat( 58) = mat( 58) + lmat( 58) + mat( 59) = mat( 59) + lmat( 59) + mat( 64) = mat( 64) + lmat( 64) + mat( 68) = mat( 68) + lmat( 68) + mat( 69) = lmat( 69) + mat( 70) = lmat( 70) + mat( 71) = mat( 71) + lmat( 71) + mat( 72) = lmat( 72) + mat( 73) = lmat( 73) + mat( 75) = mat( 75) + lmat( 75) + mat( 76) = mat( 76) + lmat( 76) + mat( 80) = mat( 80) + lmat( 80) + mat( 83) = mat( 83) + lmat( 83) + mat( 91) = mat( 91) + lmat( 91) + mat( 101) = lmat( 101) + mat( 102) = mat( 102) + lmat( 102) + mat( 103) = mat( 103) + lmat( 103) + mat( 104) = lmat( 104) + mat( 105) = lmat( 105) + mat( 112) = mat( 112) + lmat( 112) + mat( 115) = lmat( 115) + mat( 117) = mat( 117) + lmat( 117) + mat( 120) = mat( 120) + lmat( 120) + mat( 121) = mat( 121) + lmat( 121) + mat( 127) = mat( 127) + lmat( 127) + mat( 129) = mat( 129) + lmat( 129) + mat( 144) = mat( 144) + lmat( 144) + mat( 153) = mat( 153) + lmat( 153) + mat( 154) = mat( 154) + lmat( 154) + mat( 161) = lmat( 161) + mat( 162) = mat( 162) + lmat( 162) + mat( 164) = lmat( 164) + mat( 165) = mat( 165) + lmat( 165) + mat( 169) = lmat( 169) + mat( 173) = lmat( 173) + mat( 174) = mat( 174) + lmat( 174) + mat( 184) = mat( 184) + lmat( 184) + mat( 187) = mat( 187) + lmat( 187) + mat( 188) = mat( 188) + lmat( 188) + mat( 192) = mat( 192) + lmat( 192) + mat( 193) = mat( 193) + lmat( 193) + mat( 194) = mat( 194) + lmat( 194) + mat( 196) = mat( 196) + lmat( 196) + mat( 197) = lmat( 197) + mat( 198) = mat( 198) + lmat( 198) + mat( 201) = mat( 201) + lmat( 201) + mat( 205) = mat( 205) + lmat( 205) + mat( 209) = lmat( 209) + mat( 210) = mat( 210) + lmat( 210) + mat( 215) = lmat( 215) + mat( 216) = mat( 216) + lmat( 216) + mat( 220) = mat( 220) + lmat( 220) + mat( 221) = mat( 221) + lmat( 221) + mat( 223) = lmat( 223) + mat( 225) = mat( 225) + lmat( 225) + mat( 230) = mat( 230) + lmat( 230) + mat( 231) = mat( 231) + lmat( 231) + mat( 237) = mat( 237) + lmat( 237) + mat( 238) = lmat( 238) + mat( 239) = lmat( 239) + mat( 241) = mat( 241) + lmat( 241) + mat( 242) = lmat( 242) + mat( 244) = mat( 244) + lmat( 244) + mat( 246) = mat( 246) + lmat( 246) + mat( 250) = mat( 250) + lmat( 250) + mat( 251) = lmat( 251) + mat( 252) = mat( 252) + lmat( 252) + mat( 267) = mat( 267) + lmat( 267) + mat( 285) = mat( 285) + lmat( 285) + mat( 288) = mat( 288) + lmat( 288) + mat( 293) = mat( 293) + lmat( 293) + mat( 312) = mat( 312) + lmat( 312) + mat( 317) = mat( 317) + lmat( 317) + mat( 319) = mat( 319) + lmat( 319) + mat( 329) = mat( 329) + lmat( 329) + mat( 350) = mat( 350) + lmat( 350) + mat( 368) = mat( 368) + lmat( 368) + mat( 376) = mat( 376) + lmat( 376) + mat( 379) = mat( 379) + lmat( 379) + mat( 380) = mat( 380) + lmat( 380) + mat( 384) = mat( 384) + lmat( 384) + mat( 389) = mat( 389) + lmat( 389) + mat( 402) = mat( 402) + lmat( 402) + mat( 413) = mat( 413) + lmat( 413) + mat( 424) = lmat( 424) + mat( 426) = mat( 426) + lmat( 426) + mat( 427) = mat( 427) + lmat( 427) + mat( 431) = mat( 431) + lmat( 431) + mat( 435) = lmat( 435) + mat( 436) = lmat( 436) + mat( 437) = lmat( 437) + mat( 449) = mat( 449) + lmat( 449) + mat( 455) = mat( 455) + lmat( 455) + mat( 457) = mat( 457) + lmat( 457) + mat( 458) = mat( 458) + lmat( 458) + mat( 459) = mat( 459) + lmat( 459) + mat( 466) = mat( 466) + lmat( 466) + mat( 469) = mat( 469) + lmat( 469) + mat( 470) = mat( 470) + lmat( 470) + mat( 477) = mat( 477) + lmat( 477) + mat( 481) = lmat( 481) + mat( 499) = mat( 499) + lmat( 499) + mat( 508) = mat( 508) + lmat( 508) + mat( 509) = mat( 509) + lmat( 509) + mat( 515) = mat( 515) + lmat( 515) + mat( 519) = mat( 519) + lmat( 519) + mat( 520) = mat( 520) + lmat( 520) + mat( 523) = mat( 523) + lmat( 523) + mat( 536) = lmat( 536) + mat( 540) = mat( 540) + lmat( 540) + mat( 544) = mat( 544) + lmat( 544) + mat( 550) = mat( 550) + lmat( 550) + mat( 551) = mat( 551) + lmat( 551) + mat( 552) = mat( 552) + lmat( 552) + mat( 555) = mat( 555) + lmat( 555) + mat( 557) = lmat( 557) + mat( 558) = mat( 558) + lmat( 558) + mat( 559) = mat( 559) + lmat( 559) + mat( 560) = mat( 560) + lmat( 560) + mat( 562) = lmat( 562) + mat( 563) = mat( 563) + lmat( 563) + mat( 564) = mat( 564) + lmat( 564) + mat( 565) = mat( 565) + lmat( 565) + mat( 568) = mat( 568) + lmat( 568) + mat( 569) = lmat( 569) + mat( 571) = lmat( 571) + mat( 573) = mat( 573) + lmat( 573) + mat( 574) = lmat( 574) + mat( 575) = mat( 575) + lmat( 575) + mat( 587) = mat( 587) + lmat( 587) + mat( 591) = mat( 591) + lmat( 591) + mat( 594) = mat( 594) + lmat( 594) + mat( 596) = mat( 596) + lmat( 596) + mat( 605) = mat( 605) + lmat( 605) + mat( 608) = mat( 608) + lmat( 608) + mat( 610) = mat( 610) + lmat( 610) + mat( 630) = mat( 630) + lmat( 630) + mat( 99) = 0._r8 + mat( 100) = 0._r8 + mat( 107) = 0._r8 + mat( 108) = 0._r8 + mat( 109) = 0._r8 + mat( 116) = 0._r8 + mat( 132) = 0._r8 + mat( 134) = 0._r8 + mat( 135) = 0._r8 + mat( 139) = 0._r8 + mat( 146) = 0._r8 + mat( 147) = 0._r8 + mat( 148) = 0._r8 + mat( 149) = 0._r8 + mat( 152) = 0._r8 + mat( 170) = 0._r8 + mat( 178) = 0._r8 + mat( 181) = 0._r8 + mat( 195) = 0._r8 + mat( 207) = 0._r8 + mat( 208) = 0._r8 + mat( 212) = 0._r8 + mat( 227) = 0._r8 + mat( 229) = 0._r8 + mat( 236) = 0._r8 + mat( 240) = 0._r8 + mat( 243) = 0._r8 + mat( 245) = 0._r8 + mat( 254) = 0._r8 + mat( 261) = 0._r8 + mat( 262) = 0._r8 + mat( 265) = 0._r8 + mat( 269) = 0._r8 + mat( 273) = 0._r8 + mat( 276) = 0._r8 + mat( 281) = 0._r8 + mat( 283) = 0._r8 + mat( 284) = 0._r8 + mat( 287) = 0._r8 + mat( 294) = 0._r8 + mat( 295) = 0._r8 + mat( 296) = 0._r8 + mat( 298) = 0._r8 + mat( 299) = 0._r8 + mat( 306) = 0._r8 + mat( 308) = 0._r8 + mat( 310) = 0._r8 + mat( 313) = 0._r8 + mat( 320) = 0._r8 + mat( 322) = 0._r8 + mat( 324) = 0._r8 + mat( 330) = 0._r8 + mat( 332) = 0._r8 + mat( 335) = 0._r8 + mat( 336) = 0._r8 + mat( 337) = 0._r8 + mat( 338) = 0._r8 + mat( 340) = 0._r8 + mat( 344) = 0._r8 + mat( 346) = 0._r8 + mat( 348) = 0._r8 + mat( 349) = 0._r8 + mat( 351) = 0._r8 + mat( 353) = 0._r8 + mat( 354) = 0._r8 + mat( 355) = 0._r8 + mat( 356) = 0._r8 + mat( 357) = 0._r8 + mat( 358) = 0._r8 + mat( 359) = 0._r8 + mat( 361) = 0._r8 + mat( 365) = 0._r8 + mat( 370) = 0._r8 + mat( 371) = 0._r8 + mat( 374) = 0._r8 + mat( 375) = 0._r8 + mat( 378) = 0._r8 + mat( 382) = 0._r8 + mat( 383) = 0._r8 + mat( 386) = 0._r8 + mat( 395) = 0._r8 + mat( 408) = 0._r8 + mat( 417) = 0._r8 + mat( 419) = 0._r8 + mat( 425) = 0._r8 + mat( 429) = 0._r8 + mat( 432) = 0._r8 + mat( 433) = 0._r8 + mat( 442) = 0._r8 + mat( 463) = 0._r8 + mat( 479) = 0._r8 + mat( 486) = 0._r8 + mat( 488) = 0._r8 + mat( 502) = 0._r8 + mat( 505) = 0._r8 + mat( 510) = 0._r8 + mat( 512) = 0._r8 + mat( 513) = 0._r8 + mat( 514) = 0._r8 + mat( 517) = 0._r8 + mat( 521) = 0._r8 + mat( 522) = 0._r8 + mat( 524) = 0._r8 + mat( 525) = 0._r8 + mat( 533) = 0._r8 + mat( 534) = 0._r8 + mat( 535) = 0._r8 + mat( 537) = 0._r8 + mat( 538) = 0._r8 + mat( 539) = 0._r8 + mat( 543) = 0._r8 + mat( 546) = 0._r8 + mat( 547) = 0._r8 + mat( 548) = 0._r8 + mat( 554) = 0._r8 + mat( 561) = 0._r8 + mat( 566) = 0._r8 + mat( 578) = 0._r8 + mat( 581) = 0._r8 + mat( 589) = 0._r8 + mat( 590) = 0._r8 + mat( 607) = 0._r8 + mat( 611) = 0._r8 + mat( 614) = 0._r8 + mat( 616) = 0._r8 + mat( 618) = 0._r8 + mat( 619) = 0._r8 + mat( 623) = 0._r8 + mat( 624) = 0._r8 + mat( 625) = 0._r8 + mat( 626) = 0._r8 + mat( 627) = 0._r8 + mat( 629) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 4) = mat( 4) - dti + mat( 7) = mat( 7) - dti + mat( 9) = mat( 9) - dti + mat( 12) = mat( 12) - dti + mat( 15) = mat( 15) - dti + mat( 17) = mat( 17) - dti + mat( 21) = mat( 21) - dti + mat( 24) = mat( 24) - dti + mat( 27) = mat( 27) - dti + mat( 33) = mat( 33) - dti + mat( 39) = mat( 39) - dti + mat( 46) = mat( 46) - dti + mat( 53) = mat( 53) - dti + mat( 59) = mat( 59) - dti + mat( 64) = mat( 64) - dti + mat( 68) = mat( 68) - dti + mat( 76) = mat( 76) - dti + mat( 83) = mat( 83) - dti + mat( 91) = mat( 91) - dti + mat( 102) = mat( 102) - dti + mat( 112) = mat( 112) - dti + mat( 120) = mat( 120) - dti + mat( 129) = mat( 129) - dti + mat( 144) = mat( 144) - dti + mat( 154) = mat( 154) - dti + mat( 162) = mat( 162) - dti + mat( 174) = mat( 174) - dti + mat( 184) = mat( 184) - dti + mat( 193) = mat( 193) - dti + mat( 205) = mat( 205) - dti + mat( 225) = mat( 225) - dti + mat( 237) = mat( 237) - dti + mat( 250) = mat( 250) - dti + mat( 267) = mat( 267) - dti + mat( 285) = mat( 285) - dti + mat( 312) = mat( 312) - dti + mat( 329) = mat( 329) - dti + mat( 350) = mat( 350) - dti + mat( 376) = mat( 376) - dti + mat( 402) = mat( 402) - dti + mat( 427) = mat( 427) - dti + mat( 459) = mat( 459) - dti + mat( 499) = mat( 499) - dti + mat( 520) = mat( 520) - dti + mat( 544) = mat( 544) - dti + mat( 568) = mat( 568) - dti + mat( 591) = mat( 591) - dti + mat( 610) = mat( 610) - dti + mat( 630) = mat( 630) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma/mo_phtadj.F90 b/src/chemistry/pp_waccm_ma/mo_phtadj.F90 new file mode 100644 index 0000000000..813a06b868 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 67) = p_rate(:,k, 67) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 71) = p_rate(:,k, 71) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 72) = p_rate(:,k, 72) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 74) = p_rate(:,k, 74) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 79) = p_rate(:,k, 79) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 83) = p_rate(:,k, 83) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 84) = p_rate(:,k, 84) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 86) = p_rate(:,k, 86) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 new file mode 100644 index 0000000000..3f401ae800 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 @@ -0,0 +1,397 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = ((rxt(:,:,126) +rxt(:,:,127) +rxt(:,:,128))* y(:,:,3) & + +rxt(:,:,233)* y(:,:,22) +rxt(:,:,180)* y(:,:,28) +rxt(:,:,219) & + * y(:,:,63) + rxt(:,:,59) + rxt(:,:,60) + het_rates(:,:,15)) & + * y(:,:,15) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,105) +rxt(:,:,106))* y(:,:,3) + rxt(:,:,5) & + + het_rates(:,:,7))* y(:,:,7) + prod(:,:,2) = 0._r8 + loss(:,:,3) = (rxt(:,:,222)* y(:,:,22) +rxt(:,:,221)* y(:,:,28) + rxt(:,:,37) & + + het_rates(:,:,42))* y(:,:,42) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,117)* y(:,:,3) +rxt(:,:,225)* y(:,:,22) +rxt(:,:,226) & + * y(:,:,28) + rxt(:,:,48) + het_rates(:,:,43))* y(:,:,43) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,108)* y(:,:,3) + rxt(:,:,40) + het_rates(:,:,44)) & + * y(:,:,44) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,109)* y(:,:,3) + rxt(:,:,41) + het_rates(:,:,45)) & + * y(:,:,45) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,110)* y(:,:,3) + rxt(:,:,42) + het_rates(:,:,46)) & + * y(:,:,46) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,111)* y(:,:,3) + rxt(:,:,43) + het_rates(:,:,54)) & + * y(:,:,54) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,112)* y(:,:,3) + rxt(:,:,44) + het_rates(:,:,55)) & + * y(:,:,55) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,113)* y(:,:,3) +rxt(:,:,224)* y(:,:,22) + rxt(:,:,45) & + + het_rates(:,:,47))* y(:,:,47) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,114)* y(:,:,3) +rxt(:,:,227)* y(:,:,22) + rxt(:,:,46) & + + het_rates(:,:,52))* y(:,:,52) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,115)* y(:,:,3) +rxt(:,:,228)* y(:,:,22) + rxt(:,:,47) & + + het_rates(:,:,53))* y(:,:,53) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,116)* y(:,:,3) + rxt(:,:,38) + het_rates(:,:,48)) & + * y(:,:,48) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,223)* y(:,:,22) + rxt(:,:,39) + het_rates(:,:,49)) & + * y(:,:,49) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,119)* y(:,:,3) + rxt(:,:,49) + het_rates(:,:,50)) & + * y(:,:,50) + prod(:,:,15) = 0._r8 + loss(:,:,16) = (rxt(:,:,118)* y(:,:,3) + rxt(:,:,50) + het_rates(:,:,51)) & + * y(:,:,51) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,120)* y(:,:,3) + rxt(:,:,53) + het_rates(:,:,56)) & + * y(:,:,56) + prod(:,:,17) = 0._r8 + loss(:,:,18) = (rxt(:,:,121)* y(:,:,3) + rxt(:,:,54) + het_rates(:,:,57)) & + * y(:,:,57) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,122)* y(:,:,3) +rxt(:,:,230)* y(:,:,22) +rxt(:,:,232) & + * y(:,:,28) + rxt(:,:,51) + het_rates(:,:,58))* y(:,:,58) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,123)* y(:,:,3) +rxt(:,:,229)* y(:,:,22) +rxt(:,:,231) & + * y(:,:,28) + rxt(:,:,52) + het_rates(:,:,59))* y(:,:,59) + prod(:,:,20) = 0._r8 + loss(:,:,21) = (rxt(:,:,267)* y(:,:,68) + rxt(:,:,58) + rxt(:,:,87) & + + het_rates(:,:,64))* y(:,:,64) + prod(:,:,21) =.440_r8*rxt(:,:,60)*y(:,:,15) + loss(:,:,22) = ( + het_rates(:,:,25))* y(:,:,25) + prod(:,:,22) = 0._r8 + loss(:,:,23) = ( + het_rates(:,:,26))* y(:,:,26) + prod(:,:,23) = 0._r8 + loss(:,:,24) = ( + rxt(:,:,61) + het_rates(:,:,27))* y(:,:,27) + prod(:,:,24) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(49) = (rxt(89)* y(2) +rxt(107)* y(3) +rxt(159)* y(9) +rxt(162)* y(10) & + +rxt(133)* y(21) +rxt(138)* y(22) +rxt(146)* y(23) +rxt(174)* y(28) & + +rxt(201)* y(37) + rxt(3) + rxt(4) + het_rates(1))* y(1) + prod(49) =rxt(88)*y(4)*y(2) + loss(44) = (rxt(89)* y(1) + 2._r8*rxt(90)* y(2) +rxt(88)* y(4) +rxt(157) & + * y(9) + (rxt(160) +rxt(161))* y(10) +rxt(168)* y(11) +rxt(238) & + * y(18) +rxt(144)* y(20) +rxt(137)* y(22) +rxt(145)* y(23) +rxt(148) & + * y(24) +rxt(181)* y(30) +rxt(194)* y(33) +rxt(195)* y(34) +rxt(198) & + * y(35) +rxt(204)* y(38) +rxt(214)* y(39) +rxt(215)* y(40) +rxt(216) & + * y(41) + (rxt(265) +rxt(266))* y(65) +rxt(272)* y(67) + rxt(62) & + + rxt(63) + rxt(64) + rxt(75) + rxt(76) + rxt(77) + het_rates(2)) & + * y(2) + prod(44) = (rxt(1) +2.000_r8*rxt(2) +rxt(68) +rxt(69) +rxt(70) + & + 2.000_r8*rxt(73) +rxt(80) +rxt(81) +rxt(82) +2.000_r8*rxt(85) + & + rxt(102)*y(3) +rxt(103)*y(3) +rxt(152)*y(8) +rxt(263)*y(68) + & + rxt(271)*y(67) +rxt(284)*y(73))*y(4) + (rxt(153)*y(9) + & + rxt(154)*y(10) +rxt(268)*y(66))*y(8) + (rxt(275)*y(69) + & + 1.150_r8*rxt(276)*y(66))*y(70) +rxt(4)*y(1) +rxt(101)*y(3) +rxt(6) & + *y(9) +rxt(8)*y(10) +rxt(12)*y(11) +rxt(10)*y(14) +rxt(136)*y(23) & + *y(21) +rxt(140)*y(22)*y(22) +rxt(24)*y(30) +rxt(25)*y(31) +rxt(32) & + *y(38) +rxt(278)*y(72) +rxt(285)*y(73) +rxt(21)*y(74) + loss(47) = (rxt(107)* y(1) + (rxt(102) +rxt(103))* y(4) + (rxt(105) + & + rxt(106))* y(7) + (rxt(126) +rxt(127) +rxt(128))* y(15) +rxt(129) & + * y(20) +rxt(130)* y(33) +rxt(131)* y(39) +rxt(117)* y(43) +rxt(108) & + * y(44) +rxt(109)* y(45) +rxt(110)* y(46) +rxt(113)* y(47) +rxt(116) & + * y(48) +rxt(119)* y(50) +rxt(118)* y(51) +rxt(114)* y(52) +rxt(115) & + * y(53) +rxt(111)* y(54) +rxt(112)* y(55) +rxt(120)* y(56) +rxt(121) & + * y(57) +rxt(122)* y(58) +rxt(123)* y(59) +rxt(124)* y(60) +rxt(125) & + * y(61) +rxt(104)* y(74) + rxt(101) + het_rates(3))* y(3) + prod(47) = (rxt(1) +rxt(149)*y(71))*y(4) +rxt(3)*y(1) +.850_r8*rxt(276)*y(70) & + *y(66) +rxt(20)*y(74) + loss(32) = (rxt(88)* y(2) +rxt(102)* y(3) +rxt(98)* y(6) +rxt(152)* y(8) & + +rxt(132)* y(21) +rxt(273)* y(65) + (rxt(270) +rxt(271))* y(67) & + +rxt(263)* y(68) +rxt(149)* y(71) +rxt(284)* y(73) + rxt(1) + rxt(2) & + + rxt(66) + rxt(68) + rxt(69) + rxt(70) + rxt(73) + rxt(78) & + + rxt(80) + rxt(81) + rxt(82) + rxt(85) + het_rates(4))* y(4) + prod(32) = (rxt(135)*y(21) +rxt(139)*y(22) +rxt(145)*y(2) + & + 2.000_r8*rxt(146)*y(1) +rxt(147)*y(23) +rxt(170)*y(11) + & + rxt(177)*y(28) +rxt(184)*y(30) +rxt(202)*y(37) +rxt(206)*y(38) + & + rxt(240)*y(16))*y(23) + (rxt(4) +2.000_r8*rxt(89)*y(2) + & + 2.000_r8*rxt(107)*y(3) +rxt(133)*y(21) +rxt(138)*y(22) + & + rxt(159)*y(9) +rxt(162)*y(10) +rxt(174)*y(28) +rxt(201)*y(37))*y(1) & + + (rxt(90)*y(2) +rxt(97)*y(6) +rxt(137)*y(22) +rxt(160)*y(10) + & + rxt(168)*y(11) +rxt(181)*y(30) +rxt(204)*y(38))*y(2) & + + (rxt(183)*y(22) +rxt(188)*y(30) +rxt(189)*y(30) +rxt(210)*y(38) + & + rxt(211)*y(38))*y(30) + (rxt(99) +rxt(100) +2.000_r8*rxt(98)*y(4)) & + *y(6) +rxt(106)*y(7)*y(3) +rxt(96)*y(5) +rxt(156)*y(10)*y(8) & + +rxt(269)*y(66)*y(9) +rxt(13)*y(11) +rxt(172)*y(22)*y(13) & + +rxt(212)*y(38)*y(38) + loss(3) = (rxt(94)* y(1) +rxt(91)* y(2) +rxt(92)* y(4) +rxt(95)* y(64) & + + rxt(93) + rxt(96) + het_rates(5))* y(5) + prod(3) =rxt(102)*y(4)*y(3) + loss(2) = (rxt(97)* y(2) +rxt(98)* y(4) + rxt(99) + rxt(100) + het_rates(6)) & + * y(6) + prod(2) = (rxt(93) +rxt(95)*y(64) +rxt(91)*y(2) +rxt(92)*y(4) +rxt(94)*y(1)) & + *y(5) +rxt(3)*y(1) + loss(35) = (rxt(144)* y(2) +rxt(129)* y(3) +rxt(142)* y(22) +rxt(175)* y(28) & + +rxt(218)* y(63) + het_rates(20))* y(20) + prod(35) =rxt(128)*y(15)*y(3) +rxt(18)*y(18) +rxt(135)*y(23)*y(21) +rxt(20) & + *y(74) + loss(16) = ((rxt(234) +rxt(235))* y(22) + het_rates(19))* y(19) + prod(16) = (rxt(17) +rxt(18) +rxt(179)*y(28) +rxt(203)*y(37) + & + rxt(236)*y(11) +rxt(237)*y(22) +rxt(238)*y(2))*y(18) +rxt(221)*y(42) & + *y(28) +rxt(267)*y(68)*y(64) + loss(28) = (rxt(152)* y(4) +rxt(153)* y(9) + (rxt(154) +rxt(155) +rxt(156)) & + * y(10) +rxt(151)* y(22) +rxt(268)* y(66) + rxt(65) + het_rates(8)) & + * y(8) + prod(28) = (rxt(150)*y(71) +rxt(272)*y(67))*y(2) + (.200_r8*rxt(275)*y(69) + & + 1.100_r8*rxt(277)*y(65))*y(70) +rxt(270)*y(67)*y(4) +rxt(6)*y(9) & + +rxt(264)*y(68) + loss(48) = (rxt(159)* y(1) +rxt(157)* y(2) +rxt(153)* y(8) +rxt(167)* y(11) & + +rxt(239)* y(16) +rxt(158)* y(23) +rxt(186)* y(30) +rxt(207)* y(38) & + +rxt(269)* y(66) + rxt(6) + rxt(7) + het_rates(9))* y(9) + prod(48) = (rxt(8) +.500_r8*rxt(244) +2.000_r8*rxt(155)*y(8) +rxt(160)*y(2)) & + *y(10) + (rxt(149)*y(71) +rxt(152)*y(8))*y(4) +2.000_r8*rxt(105)*y(7) & + *y(3) +rxt(151)*y(22)*y(8) +rxt(13)*y(11) +rxt(10)*y(14) +rxt(274) & + *y(66) +rxt(279)*y(72) + loss(40) = (rxt(162)* y(1) + (rxt(160) +rxt(161))* y(2) + (rxt(154) + & + rxt(155) +rxt(156))* y(8) +rxt(163)* y(11) +rxt(165)* y(22) +rxt(171) & + * y(23) +rxt(187)* y(30) +rxt(208)* y(38) + rxt(8) + rxt(244) & + + het_rates(10))* y(10) + prod(40) = (rxt(157)*y(2) +rxt(158)*y(23) +rxt(159)*y(1) + & + 2.000_r8*rxt(167)*y(11) +rxt(186)*y(30) +rxt(207)*y(38) + & + rxt(239)*y(16))*y(9) + (rxt(12) +rxt(168)*y(2) +rxt(169)*y(22) + & + rxt(170)*y(23))*y(11) + (rxt(15) +rxt(173) +rxt(172)*y(22))*y(13) & + + (rxt(9) +rxt(164))*y(14) +rxt(11)*y(12) +rxt(30)*y(35) +rxt(36) & + *y(41) + loss(43) = (rxt(138)* y(1) +rxt(137)* y(2) +rxt(151)* y(8) +rxt(165)* y(10) & + +rxt(169)* y(11) +rxt(166)* y(12) +rxt(172)* y(13) +rxt(233)* y(15) & + +rxt(241)* y(17) +rxt(237)* y(18) + (rxt(234) +rxt(235))* y(19) & + +rxt(142)* y(20) + 2._r8*(rxt(140) +rxt(141))* y(22) +rxt(139) & + * y(23) +rxt(143)* y(24) + (rxt(182) +rxt(183))* y(30) +rxt(193) & + * y(33) +rxt(197)* y(34) +rxt(199)* y(35) +rxt(205)* y(38) +rxt(213) & + * y(39) +rxt(222)* y(42) +rxt(225)* y(43) +rxt(224)* y(47) +rxt(223) & + * y(49) +rxt(227)* y(52) +rxt(228)* y(53) +rxt(230)* y(58) +rxt(229) & + * y(59) + het_rates(22))* y(22) + prod(43) = (rxt(144)*y(20) +rxt(145)*y(23) +rxt(148)*y(24) +rxt(194)*y(33) + & + rxt(195)*y(34) +rxt(214)*y(39) +rxt(215)*y(40) +rxt(238)*y(18))*y(2) & + + (rxt(126)*y(15) +2.000_r8*rxt(104)*y(74) +rxt(129)*y(20) + & + rxt(130)*y(33) +rxt(131)*y(39))*y(3) + (2.000_r8*rxt(134)*y(21) + & + rxt(146)*y(1) +rxt(158)*y(9) +rxt(170)*y(11) +rxt(178)*y(28))*y(23) & + + (rxt(19) +rxt(217)*y(63))*y(74) +rxt(133)*y(21)*y(1) & + +.500_r8*rxt(244)*y(10) +rxt(11)*y(12) +rxt(14)*y(13) +rxt(16)*y(17) & + +2.000_r8*rxt(22)*y(24) +rxt(27)*y(34) +rxt(33)*y(40) + loss(45) = (rxt(168)* y(2) +rxt(167)* y(9) +rxt(163)* y(10) +rxt(236)* y(18) & + +rxt(169)* y(22) +rxt(170)* y(23) + rxt(12) + rxt(13) + rxt(243) & + + het_rates(11))* y(11) + prod(45) = (rxt(29) +rxt(198)*y(2) +rxt(199)*y(22) +rxt(200)*y(28))*y(35) & + + (rxt(9) +rxt(10) +rxt(164))*y(14) + (rxt(161)*y(10) + & + rxt(216)*y(41))*y(2) + (rxt(166)*y(22) +rxt(220)*y(63))*y(12) & + +rxt(162)*y(10)*y(1) +rxt(14)*y(13) +rxt(35)*y(41) + loss(31) = (rxt(166)* y(22) +rxt(220)* y(63) + rxt(11) + het_rates(12)) & + * y(12) + prod(31) = (rxt(247) +rxt(253) +rxt(258) +rxt(249)*y(33) +rxt(254)*y(33) + & + rxt(260)*y(33))*y(35) + (2.000_r8*rxt(242) +2.000_r8*rxt(246) + & + 2.000_r8*rxt(252) +2.000_r8*rxt(257))*y(14) + (rxt(248) +rxt(256) + & + rxt(259))*y(41) + (.500_r8*rxt(244) +rxt(165)*y(22))*y(10) & + + (rxt(243) +rxt(236)*y(18))*y(11) + loss(12) = (rxt(172)* y(22) + rxt(14) + rxt(15) + rxt(173) + het_rates(13)) & + * y(13) + prod(12) =rxt(171)*y(23)*y(10) + loss(10) = ( + rxt(9) + rxt(10) + rxt(164) + rxt(242) + rxt(246) + rxt(252) & + + rxt(257) + het_rates(14))* y(14) + prod(10) =rxt(163)*y(11)*y(10) + loss(50) = (rxt(239)* y(9) +rxt(240)* y(23) +rxt(185)* y(30) + het_rates(16)) & + * y(16) + prod(50) = (rxt(126)*y(3) +rxt(180)*y(28) +rxt(219)*y(63) +rxt(233)*y(22)) & + *y(15) +rxt(241)*y(22)*y(17) + loss(11) = (rxt(241)* y(22) + rxt(16) + het_rates(17))* y(17) + prod(11) =rxt(240)*y(23)*y(16) + loss(34) = (rxt(238)* y(2) +rxt(236)* y(11) +rxt(237)* y(22) +rxt(179)* y(28) & + +rxt(203)* y(37) + rxt(17) + rxt(18) + het_rates(18))* y(18) + prod(34) = (rxt(127)*y(15) +rxt(128)*y(15))*y(3) + (rxt(185)*y(30) + & + rxt(239)*y(9))*y(16) +rxt(16)*y(17) + loss(38) = (rxt(133)* y(1) +rxt(132)* y(4) + (rxt(134) +rxt(135) +rxt(136)) & + * y(23) + het_rates(21))* y(21) + prod(38) = (rxt(129)*y(3) +rxt(142)*y(22) +rxt(144)*y(2) +rxt(175)*y(28) + & + rxt(218)*y(63))*y(20) + (rxt(137)*y(2) +rxt(151)*y(8) + & + rxt(234)*y(19) +rxt(237)*y(18))*y(22) + (rxt(19) +2.000_r8*rxt(21)) & + *y(74) +rxt(127)*y(15)*y(3) +rxt(16)*y(17) +2.000_r8*rxt(17)*y(18) & + +rxt(28)*y(33) +rxt(34)*y(39) +rxt(57)*y(62) + loss(41) = (rxt(146)* y(1) +rxt(145)* y(2) +rxt(158)* y(9) +rxt(171)* y(10) & + +rxt(170)* y(11) +rxt(240)* y(16) + (rxt(134) +rxt(135) +rxt(136)) & + * y(21) +rxt(139)* y(22) + 2._r8*rxt(147)* y(23) + (rxt(177) + & + rxt(178))* y(28) +rxt(184)* y(30) +rxt(202)* y(37) +rxt(206)* y(38) & + + rxt(245) + het_rates(23))* y(23) + prod(41) = (rxt(222)*y(42) +rxt(225)*y(43) +rxt(138)*y(1) +rxt(143)*y(24) + & + rxt(169)*y(11) +rxt(182)*y(30) +rxt(205)*y(38) +rxt(235)*y(19))*y(22) & + + (rxt(179)*y(28) +rxt(203)*y(37) +rxt(236)*y(11) +rxt(238)*y(2)) & + *y(18) + (rxt(221)*y(42) +rxt(226)*y(43) +rxt(176)*y(24))*y(28) & + + (rxt(15) +rxt(173))*y(13) + (rxt(185)*y(30) +rxt(239)*y(9))*y(16) & + +rxt(148)*y(24)*y(2) +rxt(127)*y(15)*y(3) +rxt(132)*y(21)*y(4) + loss(18) = (rxt(148)* y(2) +rxt(143)* y(22) +rxt(176)* y(28) + rxt(22) & + + het_rates(24))* y(24) + prod(18) = (.500_r8*rxt(245) +rxt(147)*y(23))*y(23) +rxt(141)*y(22)*y(22) + loss(33) = (rxt(104)* y(3) +rxt(217)* y(63) + rxt(19) + rxt(20) + rxt(21) & + + het_rates(74))* y(74) + prod(33) = (rxt(222)*y(42) +rxt(223)*y(49) +rxt(224)*y(47) +rxt(225)*y(43) + & + rxt(229)*y(59) +rxt(233)*y(15) +rxt(139)*y(23) +rxt(140)*y(22) + & + rxt(142)*y(20) +rxt(143)*y(24) +rxt(166)*y(12) +rxt(172)*y(13) + & + rxt(193)*y(33) +rxt(197)*y(34) +rxt(213)*y(39) +rxt(237)*y(18) + & + rxt(241)*y(17))*y(22) + (rxt(250)*y(34) +rxt(251)*y(40) + & + rxt(255)*y(34) +rxt(261)*y(34) +rxt(262)*y(40))*y(33) +rxt(136)*y(23) & + *y(21) + loss(42) = (rxt(174)* y(1) +rxt(180)* y(15) +rxt(179)* y(18) +rxt(175)* y(20) & + + (rxt(177) +rxt(178))* y(23) +rxt(176)* y(24) +rxt(196)* y(34) & + +rxt(200)* y(35) +rxt(221)* y(42) +rxt(226)* y(43) +rxt(232)* y(58) & + +rxt(231)* y(59) + het_rates(28))* y(28) + prod(42) = (2.000_r8*rxt(108)*y(44) +2.000_r8*rxt(109)*y(45) + & + 2.000_r8*rxt(110)*y(46) +2.000_r8*rxt(111)*y(54) +rxt(112)*y(55) + & + rxt(113)*y(47) +rxt(114)*y(52) +rxt(115)*y(53) + & + 4.000_r8*rxt(116)*y(48) +rxt(118)*y(51) +rxt(125)*y(61) + & + rxt(130)*y(33))*y(3) + (rxt(24) +rxt(181)*y(2) +rxt(182)*y(22) + & + rxt(185)*y(16) +rxt(186)*y(9) +2.000_r8*rxt(188)*y(30) + & + rxt(190)*y(30) +rxt(210)*y(38))*y(30) + (rxt(222)*y(42) + & + 3.000_r8*rxt(223)*y(49) +rxt(224)*y(47) +rxt(227)*y(52) + & + rxt(228)*y(53) +rxt(193)*y(33))*y(22) + (rxt(28) +rxt(194)*y(2)) & + *y(33) +2.000_r8*rxt(23)*y(29) +2.000_r8*rxt(26)*y(32) +rxt(27)*y(34) & + +rxt(29)*y(35) +rxt(31)*y(36) +rxt(56)*y(61) + loss(6) = ( + rxt(23) + het_rates(29))* y(29) + prod(6) = (rxt(249)*y(35) +rxt(250)*y(34) +rxt(254)*y(35) +rxt(255)*y(34) + & + rxt(260)*y(35) +rxt(261)*y(34))*y(33) +rxt(200)*y(35)*y(28) & + +rxt(189)*y(30)*y(30) + loss(37) = (rxt(181)* y(2) +rxt(186)* y(9) +rxt(187)* y(10) +rxt(185)* y(16) & + + (rxt(182) +rxt(183))* y(22) +rxt(184)* y(23) + 2._r8*(rxt(188) + & + rxt(189) +rxt(190) +rxt(191))* y(30) + (rxt(209) +rxt(210) +rxt(211)) & + * y(38) + rxt(24) + het_rates(30))* y(30) + prod(37) = (rxt(174)*y(1) +rxt(178)*y(23) +rxt(196)*y(34))*y(28) & + + (rxt(195)*y(34) +rxt(198)*y(35))*y(2) +rxt(197)*y(34)*y(22) & + +rxt(25)*y(31) +2.000_r8*rxt(192)*y(32) +rxt(30)*y(35) + loss(4) = ( + rxt(25) + het_rates(31))* y(31) + prod(4) = (rxt(190)*y(30) +rxt(209)*y(38))*y(30) + loss(1) = ( + rxt(26) + rxt(192) + het_rates(32))* y(32) + prod(1) =rxt(191)*y(30)*y(30) + loss(46) = (rxt(194)* y(2) +rxt(130)* y(3) +rxt(193)* y(22) + (rxt(250) + & + rxt(255) +rxt(261))* y(34) + (rxt(249) +rxt(254) +rxt(260))* y(35) & + + (rxt(251) +rxt(262))* y(40) + rxt(28) + het_rates(33))* y(33) + prod(46) = (rxt(180)*y(15) +2.000_r8*rxt(221)*y(42) +rxt(226)*y(43) + & + rxt(231)*y(59) +rxt(232)*y(58) +rxt(175)*y(20) +rxt(176)*y(24) + & + rxt(177)*y(23) +rxt(179)*y(18) +rxt(196)*y(34))*y(28) +rxt(183)*y(30) & + *y(22) + loss(29) = (rxt(195)* y(2) +rxt(197)* y(22) +rxt(196)* y(28) + (rxt(250) + & + rxt(255) +rxt(261))* y(33) + rxt(27) + het_rates(34))* y(34) + prod(29) = (rxt(247) +rxt(253) +rxt(258) +rxt(199)*y(22))*y(35) & + +rxt(184)*y(30)*y(23) + loss(30) = (rxt(198)* y(2) +rxt(199)* y(22) +rxt(200)* y(28) + (rxt(249) + & + rxt(254) +rxt(260))* y(33) + rxt(29) + rxt(30) + rxt(247) + rxt(253) & + + rxt(258) + het_rates(35))* y(35) + prod(30) =rxt(187)*y(30)*y(10) + loss(8) = ( + rxt(31) + het_rates(36))* y(36) + prod(8) = (rxt(251)*y(40) +rxt(262)*y(40))*y(33) +rxt(211)*y(38)*y(30) + loss(39) = (rxt(201)* y(1) +rxt(203)* y(18) +rxt(202)* y(23) + het_rates(37)) & + * y(37) + prod(39) = (rxt(117)*y(43) +rxt(118)*y(51) +rxt(119)*y(50) + & + 2.000_r8*rxt(120)*y(56) +2.000_r8*rxt(121)*y(57) + & + 3.000_r8*rxt(122)*y(58) +2.000_r8*rxt(123)*y(59) +rxt(131)*y(39)) & + *y(3) + (rxt(32) +rxt(204)*y(2) +rxt(205)*y(22) +rxt(207)*y(9) + & + rxt(209)*y(30) +rxt(210)*y(30) +2.000_r8*rxt(212)*y(38))*y(38) & + + (rxt(225)*y(43) +2.000_r8*rxt(229)*y(59) + & + 3.000_r8*rxt(230)*y(58) +rxt(213)*y(39))*y(22) + (rxt(226)*y(43) + & + 2.000_r8*rxt(231)*y(59) +3.000_r8*rxt(232)*y(58))*y(28) + (rxt(34) + & + rxt(214)*y(2))*y(39) +rxt(31)*y(36) +rxt(33)*y(40) +rxt(35)*y(41) + loss(36) = (rxt(204)* y(2) +rxt(207)* y(9) +rxt(208)* y(10) +rxt(205)* y(22) & + +rxt(206)* y(23) + (rxt(209) +rxt(210) +rxt(211))* y(30) & + + 2._r8*rxt(212)* y(38) + rxt(32) + het_rates(38))* y(38) + prod(36) = (rxt(215)*y(40) +rxt(216)*y(41))*y(2) +rxt(201)*y(37)*y(1) & + +rxt(36)*y(41) + loss(27) = (rxt(214)* y(2) +rxt(131)* y(3) +rxt(213)* y(22) + rxt(34) & + + het_rates(39))* y(39) + prod(27) = (rxt(202)*y(23) +rxt(203)*y(18))*y(37) + loss(22) = (rxt(215)* y(2) + (rxt(251) +rxt(262))* y(33) + rxt(33) & + + het_rates(40))* y(40) + prod(22) = (rxt(248) +rxt(256) +rxt(259))*y(41) +rxt(206)*y(38)*y(23) + loss(17) = (rxt(216)* y(2) + rxt(35) + rxt(36) + rxt(248) + rxt(256) & + + rxt(259) + het_rates(41))* y(41) + prod(17) =rxt(208)*y(38)*y(10) + loss(20) = ((rxt(265) +rxt(266))* y(2) +rxt(273)* y(4) +rxt(277)* y(70) & + + het_rates(65))* y(65) + prod(20) =rxt(278)*y(72) +rxt(285)*y(73) + loss(23) = (rxt(268)* y(8) +rxt(269)* y(9) +rxt(276)* y(70) + rxt(274) & + + het_rates(66))* y(66) + prod(23) = (rxt(66) +rxt(78) +rxt(263)*y(68) +rxt(270)*y(67) + & + rxt(273)*y(65) +rxt(284)*y(73))*y(4) +rxt(267)*y(68)*y(64) + loss(19) = (rxt(272)* y(2) + (rxt(270) +rxt(271))* y(4) + het_rates(67)) & + * y(67) + prod(19) =rxt(65)*y(8) +rxt(279)*y(72) + loss(21) = (rxt(263)* y(4) +rxt(267)* y(64) + rxt(264) + het_rates(68)) & + * y(68) + prod(21) = (rxt(62) +rxt(75) +rxt(266)*y(65) +rxt(272)*y(67) + & + rxt(280)*y(72) +rxt(283)*y(73))*y(2) + (rxt(68) +rxt(80))*y(4) & + + (rxt(282)*y(72) +rxt(286)*y(73))*y(70) +rxt(287)*y(72) +rxt(289) & + *y(73) + loss(24) = (rxt(275)* y(70) + het_rates(69))* y(69) + prod(24) = (rxt(274) +rxt(268)*y(8) +rxt(269)*y(9))*y(66) +rxt(265)*y(65) & + *y(2) +rxt(271)*y(67)*y(4) +rxt(7)*y(9) +rxt(264)*y(68) + loss(15) = (rxt(150)* y(2) +rxt(149)* y(4) + het_rates(71))* y(71) + prod(15) = (rxt(265)*y(2) +.900_r8*rxt(277)*y(70))*y(65) & + +.800_r8*rxt(275)*y(70)*y(69) + loss(25) = (rxt(277)* y(65) +rxt(276)* y(66) +rxt(275)* y(69) & + + het_rates(70))* y(70) + prod(25) = (rxt(66) +rxt(68) +rxt(69) +rxt(70) +rxt(78) +rxt(80) +rxt(81) + & + rxt(82))*y(4) + (rxt(62) +rxt(63) +rxt(64) +rxt(75) +rxt(76) + & + rxt(77))*y(2) +rxt(65)*y(8) +rxt(7)*y(9) + loss(13) = (rxt(280)* y(2) + (rxt(281) +rxt(282))* y(70) + rxt(278) & + + rxt(279) + rxt(287) + rxt(288) + het_rates(72))* y(72) + prod(13) = (rxt(64) +rxt(77))*y(2) + (rxt(70) +rxt(82))*y(4) + loss(14) = (rxt(283)* y(2) +rxt(284)* y(4) +rxt(286)* y(70) + rxt(285) & + + rxt(289) + het_rates(73))* y(73) + prod(14) = (rxt(63) +rxt(76))*y(2) + (rxt(69) +rxt(81))*y(4) + (rxt(288) + & + rxt(281)*y(70))*y(72) + loss(5) = (rxt(124)* y(3) + rxt(55) + het_rates(60))* y(60) + prod(5) = (rxt(109)*y(45) +rxt(110)*y(46) +2.000_r8*rxt(111)*y(54) + & + 2.000_r8*rxt(112)*y(55) +rxt(113)*y(47) +rxt(115)*y(53) + & + rxt(118)*y(51) +rxt(119)*y(50) +rxt(120)*y(56) + & + 2.000_r8*rxt(121)*y(57))*y(3) + (rxt(224)*y(47) +rxt(228)*y(53)) & + *y(22) + loss(7) = (rxt(125)* y(3) + rxt(56) + het_rates(61))* y(61) + prod(7) = (rxt(108)*y(44) +rxt(110)*y(46) +rxt(114)*y(52))*y(3) & + +rxt(227)*y(52)*y(22) + loss(9) = ( + rxt(57) + het_rates(62))* y(62) + prod(9) = (rxt(219)*y(15) +rxt(217)*y(74) +rxt(218)*y(20) +rxt(220)*y(12)) & + *y(63) + loss(26) = (rxt(220)* y(12) +rxt(219)* y(15) +rxt(218)* y(20) +rxt(217) & + * y(74) + het_rates(63))* y(63) + prod(26) = (rxt(112)*y(55) +rxt(119)*y(50) +2.000_r8*rxt(124)*y(60) + & + rxt(125)*y(61))*y(3) +2.000_r8*rxt(55)*y(60) +rxt(56)*y(61) +rxt(57) & + *y(62) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..9438eb4958 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 @@ -0,0 +1,301 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 12) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 17) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 18) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 18) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 74) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 74) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 74) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 29) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 30) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 31) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 32) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 34) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 33) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 36) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 38) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 40) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 39) ! rate_const*HBR + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 42) ! rate_const*CH3CL + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 48) ! rate_const*CCL4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 49) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 44) ! rate_const*CFC11 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 45) ! rate_const*CFC12 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 46) ! rate_const*CFC113 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 54) ! rate_const*CFC114 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 55) ! rate_const*CFC115 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 47) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 52) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 53) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 43) ! rate_const*CH3BR + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 50) ! rate_const*CF3BR + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 51) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 58) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 59) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 56) ! rate_const*H1202 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 57) ! rate_const*H2402 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 60) ! rate_const*COF2 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 61) ! rate_const*COFCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 62) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 64) ! rate_const*CO2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 27) ! rate_const*SF6 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 8) ! rate_const*N + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 64) ! rate_const*CO2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 5)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 5) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 5)*sol(:ncol,:, 64) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 5) ! rate_const*O2_1S + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 6) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 6) ! rate_const*O2_1D + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 3) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 3)*sol(:ncol,:, 74) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 3)*sol(:ncol,:, 44) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 3)*sol(:ncol,:, 45) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 3)*sol(:ncol,:, 46) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 3)*sol(:ncol,:, 54) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 3)*sol(:ncol,:, 55) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 3)*sol(:ncol,:, 47) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 3)*sol(:ncol,:, 52) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 3)*sol(:ncol,:, 53) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 3)*sol(:ncol,:, 48) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 3)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 3)*sol(:ncol,:, 51) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 3)*sol(:ncol,:, 50) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 3)*sol(:ncol,:, 56) ! rate_const*O1D*H1202 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 3)*sol(:ncol,:, 57) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 3)*sol(:ncol,:, 58) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 3)*sol(:ncol,:, 59) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 3)*sol(:ncol,:, 60) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 3)*sol(:ncol,:, 61) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 3)*sol(:ncol,:, 20) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 3)*sol(:ncol,:, 33) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 3)*sol(:ncol,:, 39) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 21)*sol(:ncol,:, 4) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 21)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 22)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 22)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 22)*sol(:ncol,:, 23) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*OH*OH + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 22)*sol(:ncol,:, 20) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*H2*O + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 23)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 23)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 24)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 71)*sol(:ncol,:, 4) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 71)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 8)*sol(:ncol,:, 22) ! rate_const*N*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 8)*sol(:ncol,:, 4) ! rate_const*N*O2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 8)*sol(:ncol,:, 9) ! rate_const*N*NO + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 9)*sol(:ncol,:, 23) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 9)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 10)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 14) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 10)*sol(:ncol,:, 22) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 12)*sol(:ncol,:, 22) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 11)*sol(:ncol,:, 22) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 11)*sol(:ncol,:, 23) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 10)*sol(:ncol,:, 23) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 13)*sol(:ncol,:, 22) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 13) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 28)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 28)*sol(:ncol,:, 20) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 28)*sol(:ncol,:, 24) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 28)*sol(:ncol,:, 23) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 28)*sol(:ncol,:, 23) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 28)*sol(:ncol,:, 18) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 28)*sol(:ncol,:, 15) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 30)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 30)*sol(:ncol,:, 22) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 30)*sol(:ncol,:, 22) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 30)*sol(:ncol,:, 16) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 30)*sol(:ncol,:, 9) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 30)*sol(:ncol,:, 10) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 32) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 33)*sol(:ncol,:, 22) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 34)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 34)*sol(:ncol,:, 28) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 34)*sol(:ncol,:, 22) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 35)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 35)*sol(:ncol,:, 22) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 35)*sol(:ncol,:, 28) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 37)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 37)*sol(:ncol,:, 23) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 37)*sol(:ncol,:, 18) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 38)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 38)*sol(:ncol,:, 22) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 38)*sol(:ncol,:, 23) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 38)*sol(:ncol,:, 9) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 38)*sol(:ncol,:, 10) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 38)*sol(:ncol,:, 38) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 39)*sol(:ncol,:, 22) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 39)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 40)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 41)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 63)*sol(:ncol,:, 74) ! rate_const*F*H2O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 63)*sol(:ncol,:, 20) ! rate_const*F*H2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 63)*sol(:ncol,:, 15) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 63)*sol(:ncol,:, 12) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 42)*sol(:ncol,:, 28) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 42)*sol(:ncol,:, 22) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 49)*sol(:ncol,:, 22) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 47)*sol(:ncol,:, 22) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 43)*sol(:ncol,:, 22) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 43)*sol(:ncol,:, 28) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 52)*sol(:ncol,:, 22) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 53)*sol(:ncol,:, 22) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 59)*sol(:ncol,:, 22) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 58)*sol(:ncol,:, 22) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 59)*sol(:ncol,:, 28) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 58)*sol(:ncol,:, 28) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 15)*sol(:ncol,:, 22) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 19)*sol(:ncol,:, 22) ! rate_const*CO*OH + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 19)*sol(:ncol,:, 22) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 18)*sol(:ncol,:, 11) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 18)*sol(:ncol,:, 22) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 18)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 16)*sol(:ncol,:, 9) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 16)*sol(:ncol,:, 23) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 17)*sol(:ncol,:, 22) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 23) ! rate_const*HO2 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 68)*sol(:ncol,:, 4) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 68) ! rate_const*N2*Op + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 65)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 65)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 68)*sol(:ncol,:, 64) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 66)*sol(:ncol,:, 8) ! rate_const*O2p*N + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 66)*sol(:ncol,:, 9) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 67)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 67)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 67)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 65)*sol(:ncol,:, 4) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 66) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 69)*sol(:ncol,:, 70) ! rate_const*NOp*e + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 66)*sol(:ncol,:, 70) ! rate_const*O2p*e + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 65)*sol(:ncol,:, 70) ! rate_const*N2p*e + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 72) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 72) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 72)*sol(:ncol,:, 2) ! rate_const*Op2P*O + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 72)*sol(:ncol,:, 70) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 72)*sol(:ncol,:, 70) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 73)*sol(:ncol,:, 2) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 73)*sol(:ncol,:, 4) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 73) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 73)*sol(:ncol,:, 70) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 72) ! rate_const*Op2P + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 72) ! rate_const*Op2P + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 73) ! rate_const*Op2D + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma/mo_setrxt.F90 new file mode 100644 index 0000000000..c09c128c6e --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_setrxt.F90 @@ -0,0 +1,366 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,91) = 8.00e-14_r8 + rate(:,:,92) = 3.90e-17_r8 + rate(:,:,95) = 4.20e-13_r8 + rate(:,:,96) = 8.50e-2_r8 + rate(:,:,97) = 1.30e-16_r8 + rate(:,:,99) = 1.00e-20_r8 + rate(:,:,100) = 2.58e-04_r8 + rate(:,:,107) = 1.20e-10_r8 + rate(:,:,108) = 2.02e-10_r8 + rate(:,:,109) = 1.204e-10_r8 + rate(:,:,110) = 1.50e-10_r8 + rate(:,:,111) = 9.75e-11_r8 + rate(:,:,112) = 1.50e-11_r8 + rate(:,:,113) = 7.20e-11_r8 + rate(:,:,114) = 1.794e-10_r8 + rate(:,:,115) = 1.628e-10_r8 + rate(:,:,116) = 2.84e-10_r8 + rate(:,:,117) = 1.674e-10_r8 + rate(:,:,118) = 9.60e-11_r8 + rate(:,:,119) = 4.10e-11_r8 + rate(:,:,120) = 1.012e-10_r8 + rate(:,:,121) = 1.20e-10_r8 + rate(:,:,122) = 4.49e-10_r8 + rate(:,:,123) = 2.57e-10_r8 + rate(:,:,124) = 2.14e-11_r8 + rate(:,:,125) = 1.90e-10_r8 + rate(:,:,126) = 1.31e-10_r8 + rate(:,:,127) = 3.50e-11_r8 + rate(:,:,128) = 9.00e-12_r8 + rate(:,:,129) = 1.20e-10_r8 + rate(:,:,130) = 1.50e-10_r8 + rate(:,:,131) = 1.20e-10_r8 + rate(:,:,134) = 7.20e-11_r8 + rate(:,:,135) = 6.90e-12_r8 + rate(:,:,136) = 1.60e-12_r8 + rate(:,:,140) = 1.80e-12_r8 + rate(:,:,143) = 1.80e-12_r8 + rate(:,:,149) = 5.00e-12_r8 + rate(:,:,150) = 7.00e-13_r8 + rate(:,:,151) = 5.00e-11_r8 + rate(:,:,168) = 1.00e-11_r8 + rate(:,:,169) = 2.20e-11_r8 + rate(:,:,170) = 3.50e-12_r8 + rate(:,:,195) = 1.70e-13_r8 + rate(:,:,267) = 9.0e-10_r8 + rate(:,:,268) = 1.0e-10_r8 + rate(:,:,269) = 4.4e-10_r8 + rate(:,:,270) = 4.0e-10_r8 + rate(:,:,271) = 2.0e-10_r8 + rate(:,:,272) = 1.0e-12_r8 + rate(:,:,273) = 6.0e-11_r8 + rate(:,:,274) = 5.0e-16_r8 + rate(:,:,278) = 4.8e-10_r8 + rate(:,:,279) = 1.0e-10_r8 + rate(:,:,280) = 4.0e-10_r8 + rate(:,:,283) = 5.0e-12_r8 + rate(:,:,284) = 7.0e-10_r8 + rate(:,:,285) = 8.0e-10_r8 + rate(:,:,287) = 4.7e-2_r8 + rate(:,:,288) = 1.71e-1_r8 + rate(:,:,289) = 7.7e-5_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,89) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,93) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,94) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,98) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,101) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,102) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,103) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,104) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,105) = 7.25e-11_r8 * exp_fac(:,:) + rate(:,:,106) = 4.63e-11_r8 * exp_fac(:,:) + rate(:,:,133) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:,137) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:,138) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,139) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,205) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,142) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,144) = 1.60e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,145) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,213) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,241) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,146) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,148) = 1.40e-12_r8 * exp( -2000._r8 * itemp(:,:) ) + rate(:,:,152) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:,153) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,154) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,155) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,156) = 1.45e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,158) = 3.30e-12_r8 * exp_fac(:,:) + rate(:,:,177) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,182) = 7.40e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,159) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,214) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,160) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,162) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,188) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,167) = 1.50e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,172) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,174) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,175) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,176) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,178) = 3.60e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,179) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,180) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,181) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,183) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,204) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,212) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,184) = 2.60e-12_r8 * exp_fac(:,:) + rate(:,:,186) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,211) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,185) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,189) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,190) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,193) = 1.80e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,194) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,196) = 3.40e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,197) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,218) = 1.40e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,198) = 3.60e-12_r8 * exp_fac(:,:) + rate(:,:,229) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,199) = 1.20e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,200) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,201) = 1.60e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,202) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,203) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,231) = 6.30e-12_r8 * exp_fac(:,:) + rate(:,:,206) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,207) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,210) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,209) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,215) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,216) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,217) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,267) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,268) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,269) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,270) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,271) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,272) = 1.0e-12_r8 * exp_fac(:,:) + rate(:,:,273) = 6.0e-11_r8 * exp_fac(:,:) + rate(:,:,274) = 5.0e-16_r8 * exp_fac(:,:) + rate(:,:,278) = 4.8e-10_r8 * exp_fac(:,:) + rate(:,:,279) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,280) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,283) = 5.0e-12_r8 * exp_fac(:,:) + rate(:,:,284) = 7.0e-10_r8 * exp_fac(:,:) + rate(:,:,285) = 8.0e-10_r8 * exp_fac(:,:) + rate(:,:,287) = 4.7e-2_r8 * exp_fac(:,:) + rate(:,:,288) = 1.71e-1_r8 * exp_fac(:,:) + rate(:,:,289) = 7.7e-5_r8 * exp_fac(:,:) + rate(:,:,219) = 1.60e-10_r8 * exp( -260._r8 * itemp(:,:) ) + rate(:,:,220) = 6.00e-12_r8 * exp( 400._r8 * itemp(:,:) ) + rate(:,:,221) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,222) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,223) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,224) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,227) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,238) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,225) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,226) = 1.40e-11_r8 * exp( -1030._r8 * itemp(:,:) ) + rate(:,:,228) = 1.30e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,230) = 1.35e-12_r8 * exp( -600._r8 * itemp(:,:) ) + rate(:,:,232) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,233) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,236) = 6.00e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,237) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,239) = 2.80e-12_r8 * exp( 300._r8 * itemp(:,:) ) + rate(:,:,240) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,132), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.60e-11_r8 + call jpl( rate(1,1,141), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,157), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,161), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,163), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,165), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,171), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,187), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 3.0e-12_r8 * itemp(:,:)**2.0_r8 + call jpl( rate(1,1,191), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,208), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,235), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,91) = 8.00e-14_r8 + rate(:,:kbot,92) = 3.90e-17_r8 + rate(:,:kbot,97) = 1.30e-16_r8 + rate(:,:kbot,99) = 1.00e-20_r8 + rate(:,:kbot,135) = 6.90e-12_r8 + rate(:,:kbot,149) = 5.00e-12_r8 + rate(:,:kbot,150) = 7.00e-13_r8 + rate(:,:kbot,268) = 1.0e-10_r8 + rate(:,:kbot,269) = 4.4e-10_r8 + rate(:,:kbot,270) = 4.0e-10_r8 + rate(:,:kbot,271) = 2.0e-10_r8 + rate(:,:kbot,272) = 1.0e-12_r8 + rate(:,:kbot,273) = 6.0e-11_r8 + rate(:,:kbot,278) = 4.8e-10_r8 + rate(:,:kbot,279) = 1.0e-10_r8 + rate(:,:kbot,280) = 4.0e-10_r8 + rate(:,:kbot,283) = 5.0e-12_r8 + rate(:,:kbot,284) = 7.0e-10_r8 + rate(:,:kbot,285) = 8.0e-10_r8 + rate(:,:kbot,287) = 4.7e-2_r8 + rate(:,:kbot,288) = 1.71e-1_r8 + rate(:,:kbot,289) = 7.7e-5_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,89) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,93) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,94) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,98) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,101) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,102) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,103) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,133) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,137) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,138) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,139) = 4.80e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,145) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,146) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,152) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,153) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,158) = 3.30e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,159) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,160) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,132) = wrk(:,:) + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 new file mode 100644 index 0000000000..d260daa393 --- /dev/null +++ b/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 @@ -0,0 +1,472 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 24, 0, 0, 50, 0 /) + + cls_rxt_cnt(:,1) = (/ 3, 61, 0, 24 /) + cls_rxt_cnt(:,4) = (/ 31, 122, 135, 50 /) + + solsym(: 74) = (/ 'O3 ','O ','O1D ','O2 ','O2_1S ', & + 'O2_1D ','N2O ','N ','NO ','NO2 ', & + 'NO3 ','HNO3 ','HO2NO2 ','N2O5 ','CH4 ', & + 'CH3O2 ','CH3OOH ','CH2O ','CO ','H2 ', & + 'H ','OH ','HO2 ','H2O2 ','CLY ', & + 'BRY ','SF6 ','CL ','CL2 ','CLO ', & + 'OCLO ','CL2O2 ','HCL ','HOCL ','CLONO2 ', & + 'BRCL ','BR ','BRO ','HBR ','HOBR ', & + 'BRONO2 ','CH3CL ','CH3BR ','CFC11 ','CFC12 ', & + 'CFC113 ','HCFC22 ','CCL4 ','CH3CCL3 ','CF3BR ', & + 'CF2CLBR ','HCFC141B ','HCFC142B ','CFC114 ','CFC115 ', & + 'H1202 ','H2402 ','CHBR3 ','CH2BR2 ','COF2 ', & + 'COFCL ','HF ','F ','CO2 ','N2p ', & + 'O2p ','Np ','Op ','NOp ','e ', & + 'N2D ','Op2P ','Op2D ','H2O ' /) + + adv_mass(: 74) = (/ 47.998200_r8, 15.999400_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, & + 31.998800_r8, 44.012880_r8, 14.006740_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 63.012340_r8, 79.011740_r8, 108.010480_r8, 16.040600_r8, & + 47.032000_r8, 48.039400_r8, 30.025200_r8, 28.010400_r8, 2.014800_r8, & + 1.007400_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, 100.916850_r8, & + 99.716850_r8, 146.056419_r8, 35.452700_r8, 70.905400_r8, 51.452100_r8, & + 67.451500_r8, 102.904200_r8, 36.460100_r8, 52.459500_r8, 97.457640_r8, & + 115.356700_r8, 79.904000_r8, 95.903400_r8, 80.911400_r8, 96.910800_r8, & + 141.908940_r8, 50.485900_r8, 94.937200_r8, 137.367503_r8, 120.913206_r8, & + 187.375310_r8, 86.467906_r8, 153.821800_r8, 133.402300_r8, 148.910210_r8, & + 165.364506_r8, 116.948003_r8, 100.493706_r8, 170.921013_r8, 154.466716_r8, & + 209.815806_r8, 259.823613_r8, 252.730400_r8, 173.833800_r8, 66.007206_r8, & + 82.461503_r8, 20.005803_r8, 18.998403_r8, 44.009800_r8, 28.013480_r8, & + 31.998800_r8, 14.006740_r8, 15.999400_r8, 30.006140_r8, 0.548567E-03_r8, & + 14.006740_r8, 15.999400_r8, 15.999400_r8, 18.014200_r8 /) + + crb_mass(: 74) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 24,1) = (/ 15, 7, 42, 43, 44, 45, 46, 54, 55, 47, & + 52, 53, 48, 49, 50, 51, 56, 57, 58, 59, & + 64, 25, 26, 27 /) + clsmap(: 50,4) = (/ 1, 2, 3, 4, 5, 6, 20, 19, 8, 9, & + 10, 22, 11, 12, 13, 14, 16, 17, 18, 21, & + 23, 24, 74, 28, 29, 30, 31, 32, 33, 34, & + 35, 36, 37, 38, 39, 40, 41, 65, 66, 67, & + 68, 69, 71, 70, 72, 73, 60, 61, 62, 63 /) + + permute(: 50,4) = (/ 49, 44, 47, 32, 3, 2, 35, 16, 28, 48, & + 40, 43, 45, 31, 12, 10, 50, 11, 34, 38, & + 41, 18, 33, 42, 6, 37, 4, 1, 46, 29, & + 30, 8, 39, 36, 27, 22, 17, 20, 23, 19, & + 21, 24, 15, 25, 13, 14, 5, 7, 9, 26 /) + + diag_map(: 50) = (/ 1, 4, 7, 9, 12, 15, 17, 21, 24, 27, & + 33, 39, 46, 53, 59, 64, 68, 76, 83, 91, & + 102, 112, 120, 129, 144, 154, 162, 174, 184, 193, & + 205, 225, 237, 250, 267, 285, 312, 329, 350, 376, & + 402, 427, 459, 499, 520, 544, 568, 591, 610, 630 /) + + extfrc_lst(: 11) = (/ 'NO ','NO2 ','CO ','Op ','O2p ', & + 'Np ','N2p ','N2D ','N ','e ', & + 'OH ' /) + + frc_from_dataset(: 11) = (/ .true., .true., .true., .false., .false., & + .false., .false., .false., .false., .false., & + .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 16) = (/ 'CL ', 'BR ', 'OH ', 'HO2 ', 'Op ', & + 'O2p ', 'NOp ', 'Np ', 'N2p ', 'e ', & + 'O2_1S ', 'O2_1D ', 'N2D ', 'O1D ', 'Op2P ', & + 'Op2D ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jhbr ', & + 'jbrono2_a ', 'jbrono2_b ', & + 'jch3cl ', 'jccl4 ', & + 'jch3ccl3 ', 'jcfcl3 ', & + 'jcf2cl2 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jhcfc22 ', 'jhcfc141b ', & + 'jhcfc142b ', 'jch3br ', & + 'jcf3br ', 'jcf2clbr ', & + 'jchbr3 ', 'jch2br2 ', & + 'jh1202 ', 'jh2402 ', & + 'jcof2 ', 'jcofcl ', & + 'jhf ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jsf6 ', 'jeuv_1 ', & + 'jeuv_2 ', 'jeuv_3 ', & + 'jeuv_4 ', 'jeuv_5 ', & + 'jeuv_6 ', 'jeuv_7 ', & + 'jeuv_8 ', 'jeuv_9 ', & + 'jeuv_10 ', 'jeuv_11 ', & + 'jeuv_12 ', 'jeuv_13 ', & + 'jeuv_14 ', 'jeuv_15 ', & + 'jeuv_16 ', 'jeuv_17 ', & + 'jeuv_18 ', 'jeuv_19 ', & + 'jeuv_20 ', 'jeuv_21 ', & + 'jeuv_22 ', 'jeuv_23 ', & + 'jeuv_24 ', 'jeuv_25 ', & + 'jeuv_26 ', 'usr_O_O2 ', & + 'O_O3 ', 'usr_O_O ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_N2 ', 'O2_1S_O3 ', & + 'O2_1S_CO2 ', 'ag2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1D_N2 ', 'ag1 ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_H2O ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'O1D_O3 ', 'O1D_CFC11 ', & + 'O1D_CFC12 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_HCFC22 ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_CCL4 ', & + 'O1D_CH3BR ', 'O1D_CF2CLBR ', & + 'O1D_CF3BR ', 'O1D_H1202 ', & + 'O1D_H2402 ', 'O1D_CHBR3 ', & + 'O1D_CH2BR2 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_H2 ', 'O1D_HCL ', & + 'O1D_HBR ', 'H_O2 ', & + 'H_O3 ', 'H_HO2a ', & + 'H_HO2 ', 'H_HO2b ', & + 'OH_O ', 'OH_O3 ', & + 'OH_HO2 ', 'OH_OH ', & + 'OH_OH_M ', 'OH_H2 ', & + 'OH_H2O2 ', 'H2_O ', & + 'HO2_O ', 'HO2_O3 ', & + 'usr_HO2_HO2 ', 'H2O2_O ', & + 'N2D_O2 ', 'N2D_O ', & + 'N_OH ', 'N_O2 ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'NO_O ', 'NO_HO2 ', & + 'NO_O3 ', 'NO2_O ', & + 'NO2_O_M ', 'NO2_O3 ', & + 'tag_NO2_NO3 ', 'usr_N2O5_M ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'NO3_NO ', 'NO3_O ', & + 'NO3_OH ', 'NO3_HO2 ', & + 'tag_NO2_HO2 ', 'HO2NO2_OH ', & + 'usr_HO2NO2_M ', 'CL_O3 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'CLO_HO2 ', & + 'CLO_CH3O2 ', 'CLO_NO ', & + 'CLO_NO2_M ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'HCL_OH ', 'HCL_O ', & + 'HOCL_O ', 'HOCL_CL ', & + 'HOCL_OH ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLONO2_CL ' /) + rxt_tag_lst( 201: 289) = (/ 'BR_O3 ', 'BR_HO2 ', & + 'BR_CH2O ', 'BRO_O ', & + 'BRO_OH ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_BRO ', & + 'HBR_OH ', 'HBR_O ', & + 'HOBR_O ', 'BRONO2_O ', & + 'F_H2O ', 'F_H2 ', & + 'F_CH4 ', 'F_HNO3 ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CH3CCL3_OH ', 'HCFC22_OH ', & + 'CH3BR_OH ', 'CH3BR_CL ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'CH2BR2_OH ', 'CHBR3_OH ', & + 'CH2BR2_CL ', 'CHBR3_CL ', & + 'CH4_OH ', 'usr_CO_OH_b ', & + 'CO_OH_M ', 'CH2O_NO3 ', & + 'CH2O_OH ', 'CH2O_O ', & + 'CH3O2_NO ', 'CH3O2_HO2 ', & + 'CH3OOH_OH ', 'usr_N2O5_aer ', & + 'usr_NO3_aer ', 'usr_NO2_aer ', & + 'usr_HO2_aer ', 'het1 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'ion_Op_O2 ', 'ion_Op_N2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Op_CO2 ', 'ion_O2p_N ', & + 'ion_O2p_NO ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_Np_O ', & + 'ion_N2p_O2 ', 'ion_O2p_N2 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'Op2P_N2a ', & + 'Op2P_N2b ', 'Op2P_O ', & + 'Op2P_ea ', 'Op2P_eb ', & + 'Op2D_O ', 'Op2D_O2 ', & + 'Op2D_N2 ', 'Op2D_e ', & + 'ag247nm ', 'ag732nm ', & + 'ag373nm ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 88, 89, 90, 91, 92, & + 93, 94, 97, 98, 99, & + 101, 102, 103, 132, 133, & + 135, 137, 138, 139, 145, & + 146, 147, 149, 150, 152, & + 153, 158, 159, 160, 263, & + 264, 265, 268, 269, 270, & + 271, 272, 273, 275, 276, & + 277, 278, 279, 280, 281, & + 282, 283, 284, 285, 286, & + 287, 288, 289 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.910000_r8, 32.910000_r8, 189.810000_r8, 203.400000_r8, 194.710000_r8, & + 232.590000_r8, 67.670000_r8, 165.300000_r8, 293.620000_r8, 226.580000_r8, & + 120.100000_r8, 165.510000_r8, 177.510000_r8, 229.610000_r8, 133.750000_r8, & + 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8, 291.380000_r8, 67.540000_r8, 501.720000_r8, 163.060000_r8, & + 482.430000_r8, 319.360000_r8, 469.400000_r8, 128.320000_r8, 319.370000_r8, & + 483.390000_r8, 163.060000_r8, 321.300000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 2, 3, 2, 3, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 1, 1, & + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc b/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc new file mode 100644 index 0000000000..fecd6e44e1 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc @@ -0,0 +1,812 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O2 + ( 4) N2O + ( 5) N + ( 6) NO + ( 7) NO2 + ( 8) NO3 + ( 9) HNO3 + ( 10) HO2NO2 + ( 11) N2O5 + ( 12) CH4 + ( 13) CH3O2 + ( 14) CH3OOH + ( 15) CH2O + ( 16) CO + ( 17) H2 + ( 18) H + ( 19) H2O2 + ( 20) CLY + ( 21) BRY + ( 22) CL2 (Cl2) + ( 23) CLO (ClO) + ( 24) OCLO (OClO) + ( 25) CL2O2 (Cl2O2) + ( 26) HCL (HCl) + ( 27) HOCL (HOCl) + ( 28) CLONO2 (ClONO2) + ( 29) BRCL (BrCl) + ( 30) BRO (BrO) + ( 31) HBR (HBr) + ( 32) HOBR (HOBr) + ( 33) BRONO2 (BrONO2) + ( 34) CH3CL (CH3Cl) + ( 35) CH3BR (CH3Br) + ( 36) CFC11 (CFCl3) + ( 37) CFC12 (CF2Cl2) + ( 38) CFC113 (CCl2FCClF2) + ( 39) HCFC22 (CHF2Cl) + ( 40) CCL4 (CCl4) + ( 41) CH3CCL3 (CH3CCl3) + ( 42) CF3BR (CF3Br) + ( 43) CF2CLBR (CF2ClBr) + ( 44) HCFC141B (CH3CCl2F) + ( 45) HCFC142B (CH3CClF2) + ( 46) CFC114 (CClF2CClF2) + ( 47) CFC115 (CClF2CF3) + ( 48) H1202 (CBr2F2) + ( 49) H2402 (CBrF2CBrF2) + ( 50) CHBR3 (CHBr3) + ( 51) CH2BR2 (CH2Br2) + ( 52) COF2 + ( 53) COFCL (COFCl) + ( 54) HF + ( 55) F + ( 56) CO2 + ( 57) OCS + ( 58) S + ( 59) SO + ( 60) SO2 + ( 61) SO3 + ( 62) H2SO4 + ( 63) DMS (CH3SCH3) + ( 64) SOAG (C) + ( 65) so4_a1 (NH4HSO4) + ( 66) pom_a1 (C) + ( 67) soa_a1 (C) + ( 68) bc_a1 (C) + ( 69) dst_a1 (AlSiO5) + ( 70) ncl_a1 (NaCl) + ( 71) num_a1 (H) + ( 72) so4_a2 (NH4HSO4) + ( 73) soa_a2 (C) + ( 74) ncl_a2 (NaCl) + ( 75) num_a2 (H) + ( 76) dst_a2 (AlSiO5) + ( 77) dst_a3 (AlSiO5) + ( 78) ncl_a3 (NaCl) + ( 79) so4_a3 (NH4HSO4) + ( 80) num_a3 (H) + ( 81) pom_a4 (C) + ( 82) bc_a4 (C) + ( 83) num_a4 (H) + ( 84) CL (Cl) + ( 85) BR (Br) + ( 86) OH + ( 87) HO2 + ( 88) N2p (N2) + ( 89) O2p (O2) + ( 90) Np (N) + ( 91) Op (O) + ( 92) NOp (NO) + ( 93) e (E) + ( 94) N2D (N) + ( 95) O2_1S (O2) + ( 96) O2_1D (O2) + ( 97) O1D (O) + ( 98) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CH3CL + ( 4) CH3BR + ( 5) CFC11 + ( 6) CFC12 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) HCFC22 + ( 11) HCFC141B + ( 12) HCFC142B + ( 13) CCL4 + ( 14) CH3CCL3 + ( 15) CF3BR + ( 16) CF2CLBR + ( 17) H1202 + ( 18) H2402 + ( 19) CHBR3 + ( 20) CH2BR2 + ( 21) CO2 + ( 22) CLY + ( 23) BRY + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) H2 + ( 8) CO + ( 9) N + ( 10) NO + ( 11) NO2 + ( 12) OH + ( 13) NO3 + ( 14) HNO3 + ( 15) HO2NO2 + ( 16) N2O5 + ( 17) CH3O2 + ( 18) CH3OOH + ( 19) CH2O + ( 20) H + ( 21) HO2 + ( 22) H2O2 + ( 23) H2O + ( 24) CL + ( 25) CL2 + ( 26) CLO + ( 27) OCLO + ( 28) CL2O2 + ( 29) HCL + ( 30) HOCL + ( 31) CLONO2 + ( 32) BRCL + ( 33) BR + ( 34) BRO + ( 35) HBR + ( 36) HOBR + ( 37) BRONO2 + ( 38) N2p + ( 39) O2p + ( 40) Np + ( 41) Op + ( 42) NOp + ( 43) N2D + ( 44) e + ( 45) COF2 + ( 46) COFCL + ( 47) HF + ( 48) F + ( 49) OCS + ( 50) S + ( 51) SO + ( 52) SO2 + ( 53) SO3 + ( 54) H2SO4 + ( 55) DMS + ( 56) SOAG + ( 57) so4_a1 + ( 58) pom_a1 + ( 59) soa_a1 + ( 60) bc_a1 + ( 61) dst_a1 + ( 62) ncl_a1 + ( 63) num_a1 + ( 64) so4_a2 + ( 65) soa_a2 + ( 66) ncl_a2 + ( 67) num_a2 + ( 68) dst_a2 + ( 69) dst_a3 + ( 70) ncl_a3 + ( 71) so4_a3 + ( 72) num_a3 + ( 73) pom_a4 + ( 74) bc_a4 + ( 75) num_a4 + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> CL + O rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jhbr ( 34) HBR + hv -> BR + H rate = ** User defined ** ( 34) + jbrono2_a ( 35) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 35) + jbrono2_b ( 36) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 36) + jch3cl ( 37) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 37) + jccl4 ( 38) CCL4 + hv -> 4*CL rate = ** User defined ** ( 38) + jch3ccl3 ( 39) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 39) + jcfcl3 ( 40) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 40) + jcf2cl2 ( 41) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 41) + jcfc113 ( 42) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 42) + jcfc114 ( 43) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 43) + jcfc115 ( 44) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 44) + jhcfc22 ( 45) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 45) + jhcfc141b ( 46) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 46) + jhcfc142b ( 47) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 47) + jch3br ( 48) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 48) + jcf3br ( 49) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 49) + jcf2clbr ( 50) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 50) + jchbr3 ( 51) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 51) + jch2br2 ( 52) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 52) + jh1202 ( 53) H1202 + hv -> 2*BR + COF2 rate = ** User defined ** ( 53) + jh2402 ( 54) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 54) + jcof2 ( 55) COF2 + hv -> 2*F rate = ** User defined ** ( 55) + jcofcl ( 56) COFCL + hv -> F + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jco2 ( 58) CO2 + hv -> CO + O rate = ** User defined ** ( 58) + jch4_a ( 59) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 59) + jch4_b ( 60) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 60) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jh2so4 ( 61) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 61) + jso2 ( 62) SO2 + hv -> SO + O rate = ** User defined ** ( 62) + jso3 ( 63) SO3 + hv -> SO2 + O rate = ** User defined ** ( 63) + jocs ( 64) OCS + hv -> S + CO rate = ** User defined ** ( 64) + jso ( 65) SO + hv -> S + O rate = ** User defined ** ( 65) + jeuv_1 ( 66) O + hv -> Op + e rate = ** User defined ** ( 66) + jeuv_2 ( 67) O + hv -> Op + e rate = ** User defined ** ( 67) + jeuv_3 ( 68) O + hv -> Op + e rate = ** User defined ** ( 68) + jeuv_4 ( 69) N + hv -> Np + e rate = ** User defined ** ( 69) + jeuv_5 ( 70) O2 + hv -> O2p + e rate = ** User defined ** ( 70) + jeuv_6 ( 71) N2 + hv -> N2p + e rate = ** User defined ** ( 71) + jeuv_7 ( 72) O2 + hv -> O + Op + e rate = ** User defined ** ( 72) + jeuv_8 ( 73) O2 + hv -> O + Op + e rate = ** User defined ** ( 73) + jeuv_9 ( 74) O2 + hv -> O + Op + e rate = ** User defined ** ( 74) + jeuv_10 ( 75) N2 + hv -> N + Np + e rate = ** User defined ** ( 75) + jeuv_11 ( 76) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 76) + jeuv_12 ( 77) O2 + hv -> 2*O rate = ** User defined ** ( 77) + jeuv_13 ( 78) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 78) + jeuv_14 ( 79) O + hv -> Op + e rate = ** User defined ** ( 79) + jeuv_15 ( 80) O + hv -> Op + e rate = ** User defined ** ( 80) + jeuv_16 ( 81) O + hv -> Op + e rate = ** User defined ** ( 81) + jeuv_17 ( 82) O2 + hv -> O2p + e rate = ** User defined ** ( 82) + jeuv_18 ( 83) N2 + hv -> N2p + e rate = ** User defined ** ( 83) + jeuv_19 ( 84) O2 + hv -> O + Op + e rate = ** User defined ** ( 84) + jeuv_20 ( 85) O2 + hv -> O + Op + e rate = ** User defined ** ( 85) + jeuv_21 ( 86) O2 + hv -> O + Op + e rate = ** User defined ** ( 86) + jeuv_22 ( 87) N2 + hv -> N + Np + e rate = ** User defined ** ( 87) + jeuv_23 ( 88) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 88) + jeuv_24 ( 89) O2 + hv -> 2*O rate = ** User defined ** ( 89) + jeuv_25 ( 90) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 90) + jeuv_26 ( 91) CO2 + hv -> CO + O rate = ** User defined ** ( 91) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** ( 92) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 93) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** ( 94) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 ( 95) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 ( 96) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) ( 97) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) ( 98) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 ( 99) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 (100) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (101) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (102) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (103) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 (104) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (105) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) (106) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) (107) + O1D_H2O ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (108) + O1D_N2Oa ( 18) O1D + N2O -> 2*NO rate = 7.25E-11*exp( 20./t) (109) + O1D_N2Ob ( 19) O1D + N2O -> N2 + O2 rate = 4.63E-11*exp( 20./t) (110) + O1D_O3 ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 (111) + O1D_CFC11 ( 21) O1D + CFC11 -> 2*CL + COFCL rate = 2.02E-10 (112) + O1D_CFC12 ( 22) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (113) + O1D_CFC113 ( 23) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 1.50E-10 (114) + O1D_CFC114 ( 24) O1D + CFC114 -> 2*CL + 2*COF2 rate = 9.75E-11 (115) + O1D_CFC115 ( 25) O1D + CFC115 -> CL + F + 2*COF2 rate = 1.50E-11 (116) + O1D_HCFC22 ( 26) O1D + HCFC22 -> CL + COF2 rate = 7.20E-11 (117) + O1D_HCFC141B ( 27) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (118) + O1D_HCFC142B ( 28) O1D + HCFC142B -> CL + COF2 rate = 1.63E-10 (119) + O1D_CCL4 ( 29) O1D + CCL4 -> 4*CL rate = 2.84E-10 (120) + O1D_CH3BR ( 30) O1D + CH3BR -> BR rate = 1.67E-10 (121) + O1D_CF2CLBR ( 31) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.60E-11 (122) + O1D_CF3BR ( 32) O1D + CF3BR -> BR + F + COF2 rate = 4.10E-11 (123) + O1D_H1202 ( 33) O1D + H1202 -> 2*BR + COF2 rate = 1.01E-10 (124) + O1D_H2402 ( 34) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (125) + O1D_CHBR3 ( 35) O1D + CHBR3 -> 3*BR rate = 4.49E-10 (126) + O1D_CH2BR2 ( 36) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (127) + O1D_COF2 ( 37) O1D + COF2 -> 2*F rate = 2.14E-11 (128) + O1D_COFCL ( 38) O1D + COFCL -> F + CL rate = 1.90E-10 (129) + O1D_CH4a ( 39) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (130) + O1D_CH4b ( 40) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (131) + O1D_CH4c ( 41) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (132) + O1D_H2 ( 42) O1D + H2 -> H + OH rate = 1.20E-10 (133) + O1D_HCL ( 43) O1D + HCL -> CL + OH rate = 1.50E-10 (134) + O1D_HBR ( 44) O1D + HBR -> BR + OH rate = 1.20E-10 (135) + H_O2 ( 45) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (136) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + H_O3 ( 46) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (137) + H_HO2a ( 47) H + HO2 -> 2*OH rate = 7.20E-11 (138) + H_HO2 ( 48) H + HO2 -> H2 + O2 rate = 6.90E-12 (139) + H_HO2b ( 49) H + HO2 -> H2O + O rate = 1.60E-12 (140) + OH_O ( 50) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (141) + OH_O3 ( 51) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (142) + OH_HO2 ( 52) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (143) + OH_OH ( 53) OH + OH -> H2O + O rate = 1.80E-12 (144) + OH_OH_M ( 54) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (145) + ki=2.60E-11 + f=0.60 + OH_H2 ( 55) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (146) + OH_H2O2 ( 56) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (147) + H2_O ( 57) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (148) + HO2_O ( 58) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (149) + HO2_O3 ( 59) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (150) + usr_HO2_HO2 ( 60) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (151) + H2O2_O ( 61) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (152) + N2D_O2 ( 62) N2D + O2 -> NO + O1D rate = 5.00E-12 (153) + N2D_O ( 63) N2D + O -> N + O rate = 7.00E-13 (154) + N_OH ( 64) N + OH -> NO + H rate = 5.00E-11 (155) + N_O2 ( 65) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (156) + N_NO ( 66) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (157) + N_NO2a ( 67) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (158) + N_NO2b ( 68) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (159) + N_NO2c ( 69) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (160) + NO_O ( 70) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (161) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 71) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (162) + NO_O3 ( 72) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (163) + NO2_O ( 73) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (164) + NO2_O_M ( 74) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (165) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO2_O3 ( 75) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (166) + tag_NO2_NO3 ( 76) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (167) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 77) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (168) + tag_NO2_OH ( 78) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (169) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 79) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (170) + NO3_NO ( 80) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (171) + NO3_O ( 81) NO3 + O -> NO2 + O2 rate = 1.00E-11 (172) + NO3_OH ( 82) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (173) + NO3_HO2 ( 83) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (174) + tag_NO2_HO2 ( 84) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (175) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + HO2NO2_OH ( 85) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (176) + usr_HO2NO2_M ( 86) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (177) + CL_O3 ( 87) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (178) + CL_H2 ( 88) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (179) + CL_H2O2 ( 89) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (180) + CL_HO2a ( 90) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (181) + CL_HO2b ( 91) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (182) + CL_CH2O ( 92) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (183) + CL_CH4 ( 93) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (184) + CLO_O ( 94) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (185) + CLO_OHa ( 95) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (186) + CLO_OHb ( 96) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (187) + CLO_HO2 ( 97) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (188) + CLO_CH3O2 ( 98) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (189) + CLO_NO ( 99) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (190) + CLO_NO2_M (100) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (191) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLO_CLOa (101) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (192) + CLO_CLOb (102) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (193) + CLO_CLOc (103) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (194) + tag_CLO_CLO_M (104) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (195) + ki=3.00E-12*(300/t)**2.00 + f=0.60 + usr_CL2O2_M (105) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (196) + HCL_OH (106) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (197) + HCL_O (107) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (198) + HOCL_O (108) HOCL + O -> CLO + OH rate = 1.70E-13 (199) + HOCL_CL (109) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (200) + HOCL_OH (110) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (201) + CLONO2_O (111) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (202) + CLONO2_OH (112) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (203) + CLONO2_CL (113) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (204) + BR_O3 (114) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (205) + BR_HO2 (115) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (206) + BR_CH2O (116) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (207) + BRO_O (117) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (208) + BRO_OH (118) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (209) + BRO_HO2 (119) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (210) + BRO_NO (120) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (211) + BRO_NO2_M (121) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (212) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRO_CLOa (122) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (213) + BRO_CLOb (123) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (214) + BRO_CLOc (124) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (215) + BRO_BRO (125) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (216) + HBR_OH (126) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (217) + HBR_O (127) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (218) + HOBR_O (128) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (219) + BRONO2_O (129) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (220) + F_H2O (130) F + H2O -> HF + OH rate = 1.40E-11 (221) + F_H2 (131) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (222) + F_CH4 (132) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (223) + F_HNO3 (133) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (224) + CH3CL_CL (134) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (225) + CH3CL_OH (135) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (226) + CH3CCL3_OH (136) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (227) + HCFC22_OH (137) HCFC22 + OH -> H2O + CL + COF2 rate = 1.05E-12*exp( -1600./t) (228) + CH3BR_OH (138) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (229) + CH3BR_CL (139) CH3BR + CL -> HCL + HO2 + BR rate = 1.40E-11*exp( -1030./t) (230) + HCFC141B_OH (140) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (231) + HCFC142B_OH (141) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (232) + CH2BR2_OH (142) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (233) + CHBR3_OH (143) CHBR3 + OH -> 3*BR rate = 1.35E-12*exp( -600./t) (234) + CH2BR2_CL (144) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (235) + CHBR3_CL (145) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (236) + CH4_OH (146) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (237) + usr_CO_OH_b (147) CO + OH -> CO2 + H rate = ** User defined ** (238) + CO_OH_M (148) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (239) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + CH2O_NO3 (149) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (240) + CH2O_OH (150) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (241) + CH2O_O (151) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (242) + CH3O2_NO (152) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (243) + CH3O2_HO2 (153) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (244) + CH3OOH_OH (154) CH3OOH + OH -> CH3O2 + H2O rate = 3.80E-12*exp( 200./t) (245) + usr_N2O5_aer (155) N2O5 -> 2*HNO3 rate = ** User defined ** (246) + usr_NO3_aer (156) NO3 -> HNO3 rate = ** User defined ** (247) + usr_NO2_aer (157) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (248) + usr_HO2_aer (158) HO2 -> 0.5*H2O2 rate = ** User defined ** (249) + OCS_O (159) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (250) + OCS_OH (160) OCS + OH -> SO2 + CO + H rate = 1.10E-13*exp( -1200./t) (251) + S_OH (161) S + OH -> SO + H rate = 6.60E-11 (252) + S_O2 (162) S + O2 -> SO + O rate = 2.30E-12 (253) + S_O3 (163) S + O3 -> SO + O2 rate = 1.20E-11 (254) + SO_OH (164) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (255) + SO_O2 (165) SO + O2 -> SO2 + O rate = 1.25E-13*exp( -2190./t) (256) + SO_O3 (166) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (257) + SO_NO2 (167) SO + NO2 -> SO2 + NO rate = 1.40E-11 (258) + SO_CLO (168) SO + CLO -> SO2 + CL rate = 2.80E-11 (259) + SO_BRO (169) SO + BRO -> SO2 + BR rate = 5.70E-11 (260) + SO_OCLO (170) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (261) + usr_SO2_OH (171) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (262) + usr_SO3_H2O (172) SO3 + H2O -> H2SO4 rate = ** User defined ** (263) + usr_DMS_OH (173) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** (264) + DMS_OHb (174) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (265) + DMS_NO3 (175) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (266) + het1 (176) N2O5 -> 2*HNO3 rate = ** User defined ** (267) + het2 (177) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (268) + het3 (178) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (269) + het4 (179) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (270) + het5 (180) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (271) + het6 (181) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (272) + het7 (182) N2O5 -> 2*HNO3 rate = ** User defined ** (273) + het8 (183) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (274) + het9 (184) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (275) + het10 (185) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (276) + het11 (186) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (277) + het12 (187) N2O5 -> 2*HNO3 rate = ** User defined ** (278) + het13 (188) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (279) + het14 (189) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (280) + het15 (190) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (281) + het16 (191) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (282) + het17 (192) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (283) + ion_Op_O2 (193) Op + O2 -> O2p + O rate = ** User defined ** (284) + ion_Op_N2 (194) Op + N2 -> NOp + N rate = ** User defined ** (285) + ion_N2p_Oa (195) N2p + O -> NOp + N2D rate = ** User defined ** (286) + ion_N2p_Ob (196) N2p + O -> Op + N2 rate = ** User defined ** (287) + ion_Op_CO2 (197) Op + CO2 -> O2p + CO rate = 9.00E-10 (288) + ion_O2p_N (198) O2p + N -> NOp + O rate = 1.00E-10 (289) + ion_O2p_NO (199) O2p + NO -> NOp + O2 rate = 4.40E-10 (290) + ion_Np_O2a (200) Np + O2 -> O2p + N rate = 4.00E-10 (291) + ion_Np_O2b (201) Np + O2 -> NOp + O rate = 2.00E-10 (292) + ion_Np_O (202) Np + O -> Op + N rate = 1.00E-12 (293) + ion_N2p_O2 (203) N2p + O2 -> O2p + N2 rate = 6.00E-11 (294) + ion_O2p_N2 (204) O2p + N2 -> NOp + NO rate = 5.00E-16 (295) + elec1 (205) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (296) + elec2 (206) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (297) + elec3 (207) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (298) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) DMS (dataset) + ( 6) so4_a1 (dataset) + ( 7) so4_a2 (dataset) + ( 8) pom_a1 (dataset) + ( 9) pom_a4 (dataset) + (10) bc_a1 (dataset) + (11) bc_a4 (dataset) + (12) num_a1 (dataset) + (13) num_a2 (dataset) + (14) num_a4 (dataset) + (15) Op + (16) O2p + (17) Np + (18) N2p + (19) N2D + (20) N + (21) e + (22) OH + + + Equation Report + + d(O3)/dt = r1*M*O*O2 + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r46*H*O3 - r51*OH*O3 - r59*HO2*O3 - r72*NO*O3 + - r75*NO2*O3 - r87*CL*O3 - r114*BR*O3 - r163*S*O3 - r166*SO*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j58*CO2 + .18*j60*CH4 + j62*SO2 + j63*SO3 + j65*SO + j72*O2 + j73*O2 + j74*O2 + + 2*j77*O2 + j84*O2 + j85*O2 + j86*O2 + 2*j89*O2 + j91*CO2 + r14*N2*O1D + r15*O1D*O2 + + r16*O1D*O2 + r49*H*HO2 + r53*OH*OH + r65*N*O2 + r66*N*NO + r67*N*NO2 + r162*S*O2 + r165*SO*O2 + + r193*Op*O2 + r198*O2p*N + r201*Np*O2 + r205*NOp*e + 1.15*r206*O2p*e + - j66*O - j67*O - j68*O - j79*O - j80*O - j81*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O - r50*OH*O + - r57*H2*O - r58*HO2*O - r61*H2O2*O - r70*M*NO*O - r73*NO2*O - r74*M*NO2*O - r81*NO3*O + - r94*CLO*O - r107*HCL*O - r108*HOCL*O - r111*CLONO2*O - r117*BRO*O - r127*HBR*O - r128*HOBR*O + - r129*BRONO2*O - r151*CH2O*O - r159*OCS*O - r195*N2p*O - r196*N2p*O - r202*Np*O + d(O2)/dt = j4*O3 + j13*NO3 + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + r20*O1D*O3 + r46*H*O3 + r48*H*HO2 + r50*OH*O + + r51*OH*O3 + r52*OH*HO2 + r58*HO2*O + 2*r59*HO2*O3 + r60*HO2*HO2 + r69*N*NO2 + r72*NO*O3 + + r73*NO2*O + r75*NO2*O3 + r81*NO3*O + r83*NO3*HO2 + r85*HO2NO2*OH + r87*CL*O3 + r90*CL*HO2 + + r94*CLO*O + r96*CLO*OH + r97*CLO*HO2 + r101*CLO*CLO + r102*CLO*CLO + r114*BR*O3 + r115*BR*HO2 + + r117*BRO*O + r119*BRO*HO2 + r123*BRO*CLO + r124*BRO*CLO + r125*BRO*BRO + r153*CH3O2*HO2 + + r163*S*O3 + r166*SO*O3 + r199*O2p*NO + - j1*O2 - j2*O2 - j70*O2 - j72*O2 - j73*O2 - j74*O2 - j77*O2 - j82*O2 - j84*O2 - j85*O2 + - j86*O2 - j89*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r45*M*H*O2 - r62*N2D*O2 - r65*N*O2 + - r162*S*O2 - r165*SO*O2 - r193*Op*O2 - r200*Np*O2 - r201*Np*O2 - r203*N2p*O2 + d(N2O)/dt = r67*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j75*N2 + .8*j78*N2 + j87*N2 + .8*j90*N2 + j6*NO + r194*N2*Op + r63*N2D*O + r200*Np*O2 + + r202*Np*O + .2*r205*NOp*e + 1.1*r207*N2p*e + - j69*N - r64*OH*N - r65*O2*N - r66*NO*N - r67*NO2*N - r68*NO2*N - r69*NO2*N - r198*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + .5*r157*NO2 + r204*N2*O2p + 2*r18*O1D*N2O + r62*N2D*O2 + r64*N*OH + + r65*N*O2 + 2*r68*N*NO2 + r73*NO2*O + r167*SO*NO2 + - j6*NO - j7*NO - r66*N*NO - r70*M*O*NO - r71*HO2*NO - r72*O3*NO - r80*NO3*NO - r99*CLO*NO + - r120*BRO*NO - r152*CH3O2*NO - r199*O2p*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j36*BRONO2 + r77*M*N2O5 + r86*M*HO2NO2 + + r70*M*NO*O + r71*NO*HO2 + r72*NO*O3 + 2*r80*NO3*NO + r81*NO3*O + r82*NO3*OH + r83*NO3*HO2 + + r85*HO2NO2*OH + r99*CLO*NO + r120*BRO*NO + r152*CH3O2*NO + - j8*NO2 - r157*NO2 - r67*N*NO2 - r68*N*NO2 - r69*N*NO2 - r73*O*NO2 - r74*M*O*NO2 - r75*O3*NO2 + - r76*M*NO3*NO2 - r78*M*OH*NO2 - r84*M*HO2*NO2 - r100*M*CLO*NO2 - r121*M*BRO*NO2 - r167*SO*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j35*BRONO2 + r77*M*N2O5 + r74*M*NO2*O + + r75*NO2*O3 + r79*HNO3*OH + r111*CLONO2*O + r112*CLONO2*OH + r113*CLONO2*CL + r129*BRONO2*O + + r133*F*HNO3 + - j12*NO3 - j13*NO3 - r156*NO3 - r76*M*NO2*NO3 - r80*NO*NO3 - r81*O*NO3 - r82*OH*NO3 + - r83*HO2*NO3 - r149*CH2O*NO3 - r175*DMS*NO3 + d(HNO3)/dt = 2*r155*N2O5 + r156*NO3 + .5*r157*NO2 + 2*r176*N2O5 + r177*CLONO2 + r178*BRONO2 + 2*r182*N2O5 + + r183*CLONO2 + r186*BRONO2 + 2*r187*N2O5 + r188*CLONO2 + r189*BRONO2 + r78*M*NO2*OH + + r149*CH2O*NO3 + r175*DMS*NO3 + r179*CLONO2*HCL + r184*CLONO2*HCL + r190*CLONO2*HCL + - j11*HNO3 - r79*OH*HNO3 - r133*F*HNO3 + d(HO2NO2)/dt = r84*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r86*M*HO2NO2 - r85*OH*HO2NO2 + d(N2O5)/dt = r76*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r77*M*N2O5 - r155*N2O5 - r176*N2O5 - r182*N2O5 - r187*N2O5 + d(CH4)/dt = - j59*CH4 - j60*CH4 - r39*O1D*CH4 - r40*O1D*CH4 - r41*O1D*CH4 - r93*CL*CH4 - r132*F*CH4 + - r146*OH*CH4 + d(CH3O2)/dt = j37*CH3CL + j48*CH3BR + j59*CH4 + r39*O1D*CH4 + r93*CL*CH4 + r132*F*CH4 + r146*CH4*OH + + r154*CH3OOH*OH + - r98*CLO*CH3O2 - r152*NO*CH3O2 - r153*HO2*CH3O2 + d(CH3OOH)/dt = r153*CH3O2*HO2 + - j16*CH3OOH - r154*OH*CH3OOH + d(CH2O)/dt = j16*CH3OOH + .18*j60*CH4 + r40*O1D*CH4 + r41*O1D*CH4 + r98*CLO*CH3O2 + r152*CH3O2*NO + - j17*CH2O - j18*CH2O - r92*CL*CH2O - r116*BR*CH2O - r149*NO3*CH2O - r150*OH*CH2O + - r151*O*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j58*CO2 + .38*j60*CH4 + j64*OCS + j91*CO2 + r92*CL*CH2O + r116*BR*CH2O + + r134*CH3CL*CL + r149*CH2O*NO3 + r150*CH2O*OH + r151*CH2O*O + r159*OCS*O + r160*OCS*OH + + r197*Op*CO2 + - r147*OH*CO - r148*M*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j60*CH4 + r41*O1D*CH4 + r48*H*HO2 + - r42*O1D*H2 - r55*OH*H2 - r57*O*H2 - r88*CL*H2 - r131*F*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j34*HBR + j57*HF + j59*CH4 + + .33*j60*CH4 + r40*O1D*CH4 + r42*O1D*H2 + r50*OH*O + r55*OH*H2 + r57*H2*O + r64*N*OH + + r88*CL*H2 + r131*F*H2 + r147*CO*OH + r150*CH2O*OH + r160*OCS*OH + r161*S*OH + r164*SO*OH + - r45*M*O2*H - r46*O3*H - r47*HO2*H - r48*HO2*H - r49*HO2*H + d(H2O2)/dt = .5*r158*HO2 + r54*M*OH*OH + r60*HO2*HO2 + - j22*H2O2 - r56*OH*H2O2 - r61*O*H2O2 - r89*CL*H2O2 + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(CL2)/dt = r102*CLO*CLO + r113*CLONO2*CL + r179*CLONO2*HCL + r180*HOCL*HCL + r184*CLONO2*HCL + r185*HOCL*HCL + + r190*CLONO2*HCL + r191*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r105*M*CL2O2 + r105*M*CL2O2 + r87*CL*O3 + r91*CL*HO2 + r108*HOCL*O + + r109*HOCL*CL + r110*HOCL*OH + r111*CLONO2*O + r170*SO*OCLO + - j24*CLO - r94*O*CLO - r95*OH*CLO - r96*OH*CLO - r97*HO2*CLO - r98*CH3O2*CLO - r99*NO*CLO + - r100*M*NO2*CLO - 2*r101*CLO*CLO - 2*r102*CLO*CLO - 2*r103*CLO*CLO - 2*r104*M*CLO*CLO + - r122*BRO*CLO - r123*BRO*CLO - r124*BRO*CLO - r168*SO*CLO + d(OCLO)/dt = r103*CLO*CLO + r122*BRO*CLO + - j25*OCLO - r170*SO*OCLO + d(CL2O2)/dt = r104*M*CLO*CLO + - j26*CL2O2 - r105*M*CL2O2 + d(HCL)/dt = r88*CL*H2 + r89*CL*H2O2 + r90*CL*HO2 + r92*CL*CH2O + r93*CL*CH4 + r96*CLO*OH + r109*HOCL*CL + + 2*r134*CH3CL*CL + r139*CH3BR*CL + r144*CH2BR2*CL + r145*CHBR3*CL + - j28*HCL - r43*O1D*HCL - r106*OH*HCL - r107*O*HCL - r179*CLONO2*HCL - r180*HOCL*HCL + - r181*HOBR*HCL - r184*CLONO2*HCL - r185*HOCL*HCL - r190*CLONO2*HCL - r191*HOCL*HCL + - r192*HOBR*HCL + d(HOCL)/dt = r177*CLONO2 + r183*CLONO2 + r188*CLONO2 + r97*CLO*HO2 + r112*CLONO2*OH + - j27*HOCL - r108*O*HOCL - r109*CL*HOCL - r110*OH*HOCL - r180*HCL*HOCL - r185*HCL*HOCL + - r191*HCL*HOCL + d(CLONO2)/dt = r100*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r177*CLONO2 - r183*CLONO2 - r188*CLONO2 - r111*O*CLONO2 + - r112*OH*CLONO2 - r113*CL*CLONO2 - r179*HCL*CLONO2 - r184*HCL*CLONO2 - r190*HCL*CLONO2 + d(BRCL)/dt = r124*BRO*CLO + r181*HOBR*HCL + r192*HOBR*HCL + - j31*BRCL + d(BRO)/dt = j36*BRONO2 + r114*BR*O3 + r128*HOBR*O + r129*BRONO2*O + - j32*BRO - r117*O*BRO - r118*OH*BRO - r119*HO2*BRO - r120*NO*BRO - r121*M*NO2*BRO + - r122*CLO*BRO - r123*CLO*BRO - r124*CLO*BRO - 2*r125*BRO*BRO - r169*SO*BRO + d(HBR)/dt = r115*BR*HO2 + r116*BR*CH2O + - j34*HBR - r44*O1D*HBR - r126*OH*HBR - r127*O*HBR + d(HOBR)/dt = r178*BRONO2 + r186*BRONO2 + r189*BRONO2 + r119*BRO*HO2 + - j33*HOBR - r128*O*HOBR - r181*HCL*HOBR - r192*HCL*HOBR + d(BRONO2)/dt = r121*M*BRO*NO2 + - j35*BRONO2 - j36*BRONO2 - r178*BRONO2 - r186*BRONO2 - r189*BRONO2 - r129*O*BRONO2 + d(CH3CL)/dt = - j37*CH3CL - r134*CL*CH3CL - r135*OH*CH3CL + d(CH3BR)/dt = - j48*CH3BR - r30*O1D*CH3BR - r138*OH*CH3BR - r139*CL*CH3BR + d(CFC11)/dt = - j40*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j41*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j42*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j45*HCFC22 - r26*O1D*HCFC22 - r137*OH*HCFC22 + d(CCL4)/dt = - j38*CCL4 - r29*O1D*CCL4 + d(CH3CCL3)/dt = - j39*CH3CCL3 - r136*OH*CH3CCL3 + d(CF3BR)/dt = - j49*CF3BR - r32*O1D*CF3BR + d(CF2CLBR)/dt = - j50*CF2CLBR - r31*O1D*CF2CLBR + d(HCFC141B)/dt = - j46*HCFC141B - r27*O1D*HCFC141B - r140*OH*HCFC141B + d(HCFC142B)/dt = - j47*HCFC142B - r28*O1D*HCFC142B - r141*OH*HCFC142B + d(CFC114)/dt = - j43*CFC114 - r24*O1D*CFC114 + d(CFC115)/dt = - j44*CFC115 - r25*O1D*CFC115 + d(H1202)/dt = - j53*H1202 - r33*O1D*H1202 + d(H2402)/dt = - j54*H2402 - r34*O1D*H2402 + d(CHBR3)/dt = - j51*CHBR3 - r35*O1D*CHBR3 - r143*OH*CHBR3 - r145*CL*CHBR3 + d(CH2BR2)/dt = - j52*CH2BR2 - r36*O1D*CH2BR2 - r142*OH*CH2BR2 - r144*CL*CH2BR2 + d(COF2)/dt = j41*CFC12 + j42*CFC113 + 2*j43*CFC114 + 2*j44*CFC115 + j45*HCFC22 + j47*HCFC142B + j49*CF3BR + + j50*CF2CLBR + j53*H1202 + 2*j54*H2402 + r22*O1D*CFC12 + r23*O1D*CFC113 + 2*r24*O1D*CFC114 + + 2*r25*O1D*CFC115 + r26*O1D*HCFC22 + r28*O1D*HCFC142B + r31*O1D*CF2CLBR + r32*O1D*CF3BR + + r33*O1D*H1202 + 2*r34*O1D*H2402 + r137*HCFC22*OH + r141*HCFC142B*OH + - j55*COF2 - r37*O1D*COF2 + d(COFCL)/dt = j40*CFC11 + j42*CFC113 + j46*HCFC141B + r21*O1D*CFC11 + r23*O1D*CFC113 + r27*O1D*HCFC141B + + r140*HCFC141B*OH + - j56*COFCL - r38*O1D*COFCL + d(HF)/dt = r130*F*H2O + r131*F*H2 + r132*F*CH4 + r133*F*HNO3 + - j57*HF + d(F)/dt = j44*CFC115 + j49*CF3BR + 2*j55*COF2 + j56*COFCL + j57*HF + r25*O1D*CFC115 + r32*O1D*CF3BR + + 2*r37*O1D*COF2 + r38*O1D*COFCL + - r130*H2O*F - r131*H2*F - r132*CH4*F - r133*HNO3*F + d(CO2)/dt = .44*j60*CH4 + r147*CO*OH + r148*M*CO*OH + - j58*CO2 - j91*CO2 - r197*Op*CO2 + d(OCS)/dt = - j64*OCS - r159*O*OCS - r160*OH*OCS + d(S)/dt = j64*OCS + j65*SO + - r161*OH*S - r162*O2*S - r163*O3*S + d(SO)/dt = j62*SO2 + r159*OCS*O + r161*S*OH + r162*S*O2 + r163*S*O3 + - j65*SO - r164*OH*SO - r165*O2*SO - r166*O3*SO - r167*NO2*SO - r168*CLO*SO - r169*BRO*SO + - r170*OCLO*SO + d(SO2)/dt = j63*SO3 + r160*OCS*OH + r164*SO*OH + r165*SO*O2 + r166*SO*O3 + r167*SO*NO2 + r168*SO*CLO + + r169*SO*BRO + r170*SO*OCLO + .5*r173*DMS*OH + r174*DMS*OH + r175*DMS*NO3 + - j62*SO2 - r171*OH*SO2 + d(SO3)/dt = j61*H2SO4 + r171*SO2*OH + - j63*SO3 - r172*H2O*SO3 + d(H2SO4)/dt = r172*SO3*H2O + - j61*H2SO4 + d(DMS)/dt = - r173*OH*DMS - r174*OH*DMS - r175*NO3*DMS + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 + d(pom_a4)/dt = 0 + d(bc_a4)/dt = 0 + d(num_a4)/dt = 0 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j37*CH3CL + + 4*j38*CCL4 + 3*j39*CH3CCL3 + 2*j40*CFC11 + 2*j41*CFC12 + 2*j42*CFC113 + 2*j43*CFC114 + + j44*CFC115 + j45*HCFC22 + j46*HCFC141B + j47*HCFC142B + j50*CF2CLBR + j56*COFCL + + 2*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 2*r23*O1D*CFC113 + 2*r24*O1D*CFC114 + r25*O1D*CFC115 + + r26*O1D*HCFC22 + r27*O1D*HCFC141B + r28*O1D*HCFC142B + 4*r29*O1D*CCL4 + r31*O1D*CF2CLBR + + r38*O1D*COFCL + r43*O1D*HCL + r94*CLO*O + r95*CLO*OH + r98*CLO*CH3O2 + r99*CLO*NO + + 2*r101*CLO*CLO + r103*CLO*CLO + r106*HCL*OH + r107*HCL*O + r123*BRO*CLO + r135*CH3CL*OH + + 3*r136*CH3CCL3*OH + r137*HCFC22*OH + r140*HCFC141B*OH + r141*HCFC142B*OH + r168*SO*CLO + - r87*O3*CL - r88*H2*CL - r89*H2O2*CL - r90*HO2*CL - r91*HO2*CL - r92*CH2O*CL - r93*CH4*CL + - r109*HOCL*CL - r113*CLONO2*CL - r134*CH3CL*CL - r139*CH3BR*CL - r144*CH2BR2*CL - r145*CHBR3*CL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*HBR + j35*BRONO2 + j48*CH3BR + j49*CF3BR + j50*CF2CLBR + + 3*j51*CHBR3 + 2*j52*CH2BR2 + 2*j53*H1202 + 2*j54*H2402 + r30*O1D*CH3BR + r31*O1D*CF2CLBR + + r32*O1D*CF3BR + 2*r33*O1D*H1202 + 2*r34*O1D*H2402 + 3*r35*O1D*CHBR3 + 2*r36*O1D*CH2BR2 + + r44*O1D*HBR + r117*BRO*O + r118*BRO*OH + r120*BRO*NO + r122*BRO*CLO + r123*BRO*CLO + + 2*r125*BRO*BRO + r126*HBR*OH + r127*HBR*O + r138*CH3BR*OH + r139*CH3BR*CL + 2*r142*CH2BR2*OH + + 3*r143*CHBR3*OH + 2*r144*CH2BR2*CL + 3*r145*CHBR3*CL + r169*SO*BRO + - r114*O3*BR - r115*HO2*BR - r116*CH2O*BR + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .33*j60*CH4 + + .5*r157*NO2 + 2*r17*O1D*H2O + r39*O1D*CH4 + r42*O1D*H2 + r43*O1D*HCL + r44*O1D*HBR + r46*H*O3 + + 2*r47*H*HO2 + r57*H2*O + r58*HO2*O + r59*HO2*O3 + r61*H2O2*O + r71*NO*HO2 + r83*NO3*HO2 + + r91*CL*HO2 + r107*HCL*O + r108*HOCL*O + r127*HBR*O + r128*HOBR*O + r130*F*H2O + r151*CH2O*O + - r50*O*OH - r51*O3*OH - r52*HO2*OH - 2*r53*OH*OH - 2*r54*M*OH*OH - r55*H2*OH - r56*H2O2*OH + - r64*N*OH - r78*M*NO2*OH - r79*HNO3*OH - r82*NO3*OH - r85*HO2NO2*OH - r95*CLO*OH - r96*CLO*OH + - r106*HCL*OH - r110*HOCL*OH - r112*CLONO2*OH - r118*BRO*OH - r126*HBR*OH - r135*CH3CL*OH + - r136*CH3CCL3*OH - r137*HCFC22*OH - r138*CH3BR*OH - r140*HCFC141B*OH - r141*HCFC142B*OH + - r142*CH2BR2*OH - r143*CHBR3*OH - r146*CH4*OH - r147*CO*OH - r148*M*CO*OH - r150*CH2O*OH + - r154*CH3OOH*OH - r160*OCS*OH - r161*S*OH - r164*SO*OH - r171*SO2*OH - r173*DMS*OH + - r174*DMS*OH + d(HO2)/dt = j15*HO2NO2 + r86*M*HO2NO2 + r40*O1D*CH4 + r45*M*H*O2 + r51*OH*O3 + r56*OH*H2O2 + r61*H2O2*O + + r82*NO3*OH + r89*CL*H2O2 + r92*CL*CH2O + r95*CLO*OH + r98*CLO*CH3O2 + r116*BR*CH2O + + r118*BRO*OH + r134*CH3CL*CL + r135*CH3CL*OH + r138*CH3BR*OH + r139*CH3BR*CL + r148*M*CO*OH + + r149*CH2O*NO3 + r151*CH2O*O + r152*CH3O2*NO + r171*SO2*OH + .5*r173*DMS*OH + - r158*HO2 - r47*H*HO2 - r48*H*HO2 - r49*H*HO2 - r52*OH*HO2 - r58*O*HO2 - r59*O3*HO2 + - 2*r60*HO2*HO2 - r71*NO*HO2 - r83*NO3*HO2 - r84*M*NO2*HO2 - r90*CL*HO2 - r91*CL*HO2 + - r97*CLO*HO2 - r115*BR*HO2 - r119*BRO*HO2 - r153*CH3O2*HO2 + d(N2p)/dt = j71*N2 + j83*N2 + - r195*O*N2p - r196*O*N2p - r203*O2*N2p - r207*e*N2p + d(O2p)/dt = j70*O2 + j82*O2 + r193*Op*O2 + r197*Op*CO2 + r200*Np*O2 + r203*N2p*O2 + - r204*N2*O2p - r198*N*O2p - r199*NO*O2p - r206*e*O2p + d(Np)/dt = j75*N2 + j76*N2 + j87*N2 + j88*N2 + j69*N + - r200*O2*Np - r201*O2*Np - r202*O*Np + d(Op)/dt = j66*O + j67*O + j68*O + j72*O2 + j73*O2 + j74*O2 + j79*O + j80*O + j81*O + j84*O2 + j85*O2 + + j86*O2 + r196*N2p*O + r202*Np*O + - r194*N2*Op - r193*O2*Op - r197*CO2*Op + d(NOp)/dt = j7*NO + r194*N2*Op + r204*N2*O2p + r195*N2p*O + r198*O2p*N + r199*O2p*NO + r201*Np*O2 + - r205*e*NOp + d(e)/dt = j71*N2 + j75*N2 + j76*N2 + j83*N2 + j87*N2 + j88*N2 + j7*NO + j66*O + j67*O + j68*O + j69*N + + j70*O2 + j72*O2 + j73*O2 + j74*O2 + j79*O + j80*O + j81*O + j82*O2 + j84*O2 + j85*O2 + + j86*O2 + - r205*NOp*e - r206*O2p*e - r207*N2p*e + d(N2D)/dt = j76*N2 + 1.2*j78*N2 + j88*N2 + 1.2*j90*N2 + r195*N2p*O + .8*r205*NOp*e + .9*r207*N2p*e + - r62*O2*N2D - r63*O*N2D + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r62*N2D*O2 + .85*r206*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*CFC114*O1D - r25*CFC115*O1D + - r26*HCFC22*O1D - r27*HCFC141B*O1D - r28*HCFC142B*O1D - r29*CCL4*O1D - r30*CH3BR*O1D + - r31*CF2CLBR*O1D - r32*CF3BR*O1D - r33*H1202*O1D - r34*H2402*O1D - r35*CHBR3*O1D + - r36*CH2BR2*O1D - r37*COF2*O1D - r38*COFCL*O1D - r39*CH4*O1D - r40*CH4*O1D - r41*CH4*O1D + - r42*H2*O1D - r43*HCL*O1D - r44*HBR*O1D + d(H2O)/dt = .05*j60*CH4 + j61*H2SO4 + r49*H*HO2 + r52*OH*HO2 + r53*OH*OH + r55*OH*H2 + r56*OH*H2O2 + + r79*HNO3*OH + r85*HO2NO2*OH + r106*HCL*OH + r110*HOCL*OH + r126*HBR*OH + r135*CH3CL*OH + + r136*CH3CCL3*OH + r137*HCFC22*OH + r138*CH3BR*OH + r142*CH2BR2*OH + r146*CH4*OH + r150*CH2O*OH + + r154*CH3OOH*OH + r180*HOCL*HCL + r181*HOBR*HCL + r185*HOCL*HCL + r191*HOCL*HCL + r192*HOBR*HCL + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r130*F*H2O - r172*SO3*H2O diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mech.in b/src/chemistry/pp_waccm_ma_mam4/chem_mech.in new file mode 100644 index 0000000000..87ea4c5ad4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mech.in @@ -0,0 +1,493 @@ + SPECIES + + Solution + O3, O, O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH2O, CO + H2, H, H2O2 + CLY, BRY + CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3 + CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl + CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 + CFC114 -> CClF2CClF2, CFC115 -> CClF2CF3, H1202 -> CBr2F2 + H2402 ->CBrF2CBrF2, CHBR3 -> CHBr3, CH2BR2 -> CH2Br2 + COF2, COFCL -> COFCl, HF, F + CO2 + OCS, S, SO, SO2, SO3, H2SO4, DMS -> CH3SCH3, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a2 -> AlSiO5 + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + pom_a4 -> C, bc_a4 -> C + num_a4 -> H + CL -> Cl, BR -> Br, OH, HO2 + N2p -> N2, O2p -> O2 + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N + O2_1S -> O2, O2_1D -> O2, O1D -> O + H2O + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + CL, BR, OH, HO2 + Op, O2p, NOp, Np, N2p, e, O2_1S, O2_1D, N2D, O1D + End Not-Transported + + END Species + + Solution classes + Explicit + CH4, N2O, CH3CL, CH3BR, CFC11, CFC12, CFC113 + CFC114, CFC115, HCFC22, HCFC141B, HCFC142B, CCL4 + CH3CCL3, CF3BR, CF2CLBR, H1202, H2402, CHBR3, CH2BR2 + CO2, CLY, BRY + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D, H2, CO + N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e + COF2, COFCL, HF, F + OCS, S, SO, SO2, SO3, H2SO4, DMS, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, num_a2 + dst_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + pom_a4, bc_a4, num_a4 + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> CL + O + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jhbr] HBR + hv -> BR + H + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 2*CL + COFCL + [jcf2cl2] CFC12 + hv -> 2*CL + COF2 + [jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 + [jcfc114] CFC114 + hv -> 2*CL + 2*COF2 + [jcfc115] CFC115 + hv -> CL + F + 2*COF2 + [jhcfc22] HCFC22 + hv -> CL + COF2 + [jhcfc141b] HCFC141B + hv -> CL + COFCL + [jhcfc142b] HCFC142B + hv -> CL + COF2 + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + F + COF2 + [jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 + [jchbr3] CHBR3 + hv -> 3*BR + [jch2br2] CH2BR2 + hv -> 2*BR + [jh1202] H1202 + hv -> 2*BR + COF2 + [jh2402] H2402 + hv -> 2*BR + 2*COF2 + [jcof2] COF2 + hv -> 2*F + [jcofcl] COFCL + hv -> F + CL + [jhf] HF + hv -> H + F + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O + [jh2so4] H2SO4 + hv -> SO3 + H2O + [jso2] SO2 + hv -> SO + O + [jso3] SO3 + hv -> SO2 + O + [jocs] OCS + hv -> S + CO + [jso] SO + hv -> S + O + +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op + e + [jeuv_3=userdefined,userdefined] O + hv -> Op + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op + e + [jeuv_16=userdefined,userdefined] O + hv -> Op + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 + +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.91] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + [O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60. + [O1D_N2Oa] O1D + N2O -> 2*NO ; 7.25e-11, 20. + [O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.63e-11, 20. + [O1D_O3] O1D + O3 -> O2 + O2 ; 1.20e-10 + [O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.02e-10 + [O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 + [O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 1.50e-10 + [O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 9.75e-11 + [O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 1.50e-11 + [O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.20e-11 + [O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 + [O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.628e-10 + [O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.84e-10 + [O1D_CH3BR] O1D + CH3BR -> BR ; 1.674e-10 + [O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.60e-11 + [O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.10e-11 + [O1D_H1202] O1D + H1202 -> 2*BR + COF2 ; 1.012e-10 + [O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.20e-10 + [O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.49e-10 + [O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 + [O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 + [O1D_COFCL] O1D + COFCL -> F + CL ; 1.90e-10 + [O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 + [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.50e-11 + [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9.00e-12 + [O1D_H2] O1D + H2 -> H + OH ; 1.20e-10 + [O1D_HCL] O1D + HCL -> CL + OH ; 1.50e-10 + [O1D_HBR] O1D + HBR -> BR + OH ; 1.20e-10 + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 7.5e-11, -0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [H_HO2a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [H_HO2b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 1.80e-11, 180. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + [OH_OH] OH + OH -> H2O + O ; 1.80e-12 + [OH_OH_M] OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6 + [OH_H2] OH + H2 -> H2O + H ; 2.80e-12, -1800. + [OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [H2_O] H2 + O -> OH + H ; 1.60e-11, -4570. + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_OH] N + OH -> NO + H ; 5.00e-11 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + [N_NO2a] N + NO2 -> N2O + O ; 2.90e-12, 220. + [N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220. + [N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220. + [NO_O] NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.30e-12, 270. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.10e-12, 210. + [NO2_O_M] NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + [NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + [NO3_NO] NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + [NO3_O] NO3 + O -> NO2 + O2 ; 1.00e-11 + [NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.20e-11 + [NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + [HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + [CL_O3] CL + O3 -> CLO + O2 ; 2.30e-11, -200. + [CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270. + [CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + [CL_HO2a] CL + HO2 -> HCL + O2 ; 1.40e-11, 270. + [CL_HO2b] CL + HO2 -> OH + CLO ; 3.60e-11, -375. + [CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + [CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + [CLO_O] CLO + O -> CL + O2 ; 2.80e-11, 85. + [CLO_OHa] CLO + OH -> CL + HO2 ; 7.40e-12, 270. + [CLO_OHb] CLO + OH -> HCL + O2 ; 6.00e-13, 230. + [CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.60e-12, 290. + [CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115. + [CLO_NO] CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + [CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + [CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + [CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + [CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 3.0e-12, 2.0, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + [HCL_OH] HCL + OH -> H2O + CL ; 1.80e-12, -250. + [HCL_O] HCL + O -> CL + OH ; 1.00e-11, -3300. + [HOCL_O] HOCL + O -> CLO + OH ; 1.70e-13 + [HOCL_CL] HOCL + CL -> HCL + CLO ; 3.40e-12, -130. + [HOCL_OH] HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + [CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.60e-12, -840. + [CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + [CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + [BR_O3] BR + O3 -> BRO + O2 ; 1.60e-11, -780. + [BR_HO2] BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + [BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + [BRO_O] BRO + O -> BR + O2 ; 1.90e-11, 230. + [BRO_OH] BRO + OH -> BR + HO2 ; 1.70e-11, 250. + [BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + [BRO_NO] BRO + NO -> BR + NO2 ; 8.80e-12, 260. + [BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + [BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + [BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + [BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + [BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + [HBR_OH] HBR + OH -> BR + H2O ; 5.50e-12, 200. + [HBR_O] HBR + O -> BR + OH ; 5.80e-12, -1500. + [HOBR_O] HOBR + O -> BRO + OH ; 1.20e-10, -430. + [BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Odd Flourine Reactions +* -------------------------------------------------------------- + [F_H2O] F + H2O -> HF + OH ; 1.40e-11, 0. + [F_H2] F + H2 -> HF + H ; 1.40e-10, -500. + [F_CH4] F + CH4 -> HF + CH3O2 ; 1.60e-10, -260. + [F_HNO3] F + HNO3 -> HF + NO3 ; 6.00e-12, 400. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + [CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + [CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + [CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + [HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 1.05e-12, -1600. + [CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + [CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.40e-11, -1030. + [HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600. + [HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.30e-12, -1770. + [CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2.00e-12, -840. + [CHBR3_OH] CHBR3 + OH -> 3*BR ; 1.35e-12, -600. + [CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.30e-12, -800. + [CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850. + +* -------------------------------------------------------------- +* C-1 Degradation (Methane, CO, CH2O and derivatives) +* -------------------------------------------------------------- + [CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + [usr_CO_OH_b] CO + OH -> CO2 + H + [CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058. + [CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + [CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + [CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + [CH3OOH_OH] CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200. + + +* -------------------------------------------------------------- +* Tropospheric Heterogeneous Reactions +* -------------------------------------------------------------- + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + [usr_HO2_aer] HO2 -> 0.5*H2O2 + +* -------------------------------------------------------------- +* Sulfur Reactions +* -------------------------------------------------------------- + [OCS_O] OCS + O -> SO + CO ; 2.10E-11, -2200.0 + [OCS_OH] OCS + OH -> SO2 + CO + H ; 1.10E-13, -1200.0 + [S_OH] S + OH -> SO + H ; 6.60E-11 + [S_O2] S + O2 -> SO + O ; 2.30E-12 + [S_O3] S + O3 -> SO + O2 ; 1.20E-11 + [SO_OH] SO + OH -> SO2 + H ; 2.70E-11, 335 + [SO_O2] SO + O2 -> SO2 + O ; 1.25E-13, -2190.0 + [SO_O3] SO + O3 -> SO2 + O2 ; 3.40E-12, -1100.0 + [SO_NO2] SO + NO2 -> SO2 + NO ; 1.40E-11 + [SO_CLO] SO + CLO -> SO2 + CL ; 2.80E-11 + [SO_BRO] SO + BRO -> SO2 + BR ; 5.70E-11 + [SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.90E-12 + [usr_SO2_OH] SO2 + OH -> SO3 + HO2 + [usr_SO3_H2O] SO3 + H2O -> H2SO4 + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + [DMS_OHb] DMS + OH -> SO2 ; 9.60e-12, -234. + [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.90e-13, 520. + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 + +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + [ion_N2p_Ob] N2p + O -> Op + N2 + [ion_Op_CO2] Op + CO2 -> O2p + CO ; 9.0e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + [ion_O2p_N2] O2p + N2 -> NOp + NO ; 5.0e-16 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + + + End Reactions + + Ext Forcing + NO <-dataset + NO2 <-dataset + CO <-dataset + SO2 <- dataset + DMS <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + Op + O2p + Np + N2p + N2D + N + e + OH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 new file mode 100644 index 0000000000..7c5965bf6b --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 91, & ! number of photolysis reactions + rxntot = 298, & ! number of total reactions + gascnt = 207, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 98, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 735, & ! number of non-zero matrix entries + extcnt = 22, & ! number of species with external forcing + clscnt1 = 23, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 75, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 298, & + enthalpy_cnt = 41, & + nslvd = 14 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..9ac2611f17 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 @@ -0,0 +1,301 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jhbr = 34 + integer, parameter :: rid_jbrono2_a = 35 + integer, parameter :: rid_jbrono2_b = 36 + integer, parameter :: rid_jch3cl = 37 + integer, parameter :: rid_jccl4 = 38 + integer, parameter :: rid_jch3ccl3 = 39 + integer, parameter :: rid_jcfcl3 = 40 + integer, parameter :: rid_jcf2cl2 = 41 + integer, parameter :: rid_jcfc113 = 42 + integer, parameter :: rid_jcfc114 = 43 + integer, parameter :: rid_jcfc115 = 44 + integer, parameter :: rid_jhcfc22 = 45 + integer, parameter :: rid_jhcfc141b = 46 + integer, parameter :: rid_jhcfc142b = 47 + integer, parameter :: rid_jch3br = 48 + integer, parameter :: rid_jcf3br = 49 + integer, parameter :: rid_jcf2clbr = 50 + integer, parameter :: rid_jchbr3 = 51 + integer, parameter :: rid_jch2br2 = 52 + integer, parameter :: rid_jh1202 = 53 + integer, parameter :: rid_jh2402 = 54 + integer, parameter :: rid_jcof2 = 55 + integer, parameter :: rid_jcofcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jco2 = 58 + integer, parameter :: rid_jch4_a = 59 + integer, parameter :: rid_jch4_b = 60 + integer, parameter :: rid_jh2so4 = 61 + integer, parameter :: rid_jso2 = 62 + integer, parameter :: rid_jso3 = 63 + integer, parameter :: rid_jocs = 64 + integer, parameter :: rid_jso = 65 + integer, parameter :: rid_jeuv_1 = 66 + integer, parameter :: rid_jeuv_2 = 67 + integer, parameter :: rid_jeuv_3 = 68 + integer, parameter :: rid_jeuv_4 = 69 + integer, parameter :: rid_jeuv_5 = 70 + integer, parameter :: rid_jeuv_6 = 71 + integer, parameter :: rid_jeuv_7 = 72 + integer, parameter :: rid_jeuv_8 = 73 + integer, parameter :: rid_jeuv_9 = 74 + integer, parameter :: rid_jeuv_10 = 75 + integer, parameter :: rid_jeuv_11 = 76 + integer, parameter :: rid_jeuv_12 = 77 + integer, parameter :: rid_jeuv_13 = 78 + integer, parameter :: rid_jeuv_14 = 79 + integer, parameter :: rid_jeuv_15 = 80 + integer, parameter :: rid_jeuv_16 = 81 + integer, parameter :: rid_jeuv_17 = 82 + integer, parameter :: rid_jeuv_18 = 83 + integer, parameter :: rid_jeuv_19 = 84 + integer, parameter :: rid_jeuv_20 = 85 + integer, parameter :: rid_jeuv_21 = 86 + integer, parameter :: rid_jeuv_22 = 87 + integer, parameter :: rid_jeuv_23 = 88 + integer, parameter :: rid_jeuv_24 = 89 + integer, parameter :: rid_jeuv_25 = 90 + integer, parameter :: rid_jeuv_26 = 91 + integer, parameter :: rid_usr_O_O2 = 92 + integer, parameter :: rid_O_O3 = 93 + integer, parameter :: rid_usr_O_O = 94 + integer, parameter :: rid_O2_1S_O = 95 + integer, parameter :: rid_O2_1S_O2 = 96 + integer, parameter :: rid_O2_1S_N2 = 97 + integer, parameter :: rid_O2_1S_O3 = 98 + integer, parameter :: rid_O2_1S_CO2 = 99 + integer, parameter :: rid_ag2 = 100 + integer, parameter :: rid_O2_1D_O = 101 + integer, parameter :: rid_O2_1D_O2 = 102 + integer, parameter :: rid_O2_1D_N2 = 103 + integer, parameter :: rid_ag1 = 104 + integer, parameter :: rid_O1D_N2 = 105 + integer, parameter :: rid_O1D_O2 = 106 + integer, parameter :: rid_O1D_O2b = 107 + integer, parameter :: rid_O1D_H2O = 108 + integer, parameter :: rid_O1D_N2Oa = 109 + integer, parameter :: rid_O1D_N2Ob = 110 + integer, parameter :: rid_O1D_O3 = 111 + integer, parameter :: rid_O1D_CFC11 = 112 + integer, parameter :: rid_O1D_CFC12 = 113 + integer, parameter :: rid_O1D_CFC113 = 114 + integer, parameter :: rid_O1D_CFC114 = 115 + integer, parameter :: rid_O1D_CFC115 = 116 + integer, parameter :: rid_O1D_HCFC22 = 117 + integer, parameter :: rid_O1D_HCFC141B = 118 + integer, parameter :: rid_O1D_HCFC142B = 119 + integer, parameter :: rid_O1D_CCL4 = 120 + integer, parameter :: rid_O1D_CH3BR = 121 + integer, parameter :: rid_O1D_CF2CLBR = 122 + integer, parameter :: rid_O1D_CF3BR = 123 + integer, parameter :: rid_O1D_H1202 = 124 + integer, parameter :: rid_O1D_H2402 = 125 + integer, parameter :: rid_O1D_CHBR3 = 126 + integer, parameter :: rid_O1D_CH2BR2 = 127 + integer, parameter :: rid_O1D_COF2 = 128 + integer, parameter :: rid_O1D_COFCL = 129 + integer, parameter :: rid_O1D_CH4a = 130 + integer, parameter :: rid_O1D_CH4b = 131 + integer, parameter :: rid_O1D_CH4c = 132 + integer, parameter :: rid_O1D_H2 = 133 + integer, parameter :: rid_O1D_HCL = 134 + integer, parameter :: rid_O1D_HBR = 135 + integer, parameter :: rid_H_O2 = 136 + integer, parameter :: rid_H_O3 = 137 + integer, parameter :: rid_H_HO2a = 138 + integer, parameter :: rid_H_HO2 = 139 + integer, parameter :: rid_H_HO2b = 140 + integer, parameter :: rid_OH_O = 141 + integer, parameter :: rid_OH_O3 = 142 + integer, parameter :: rid_OH_HO2 = 143 + integer, parameter :: rid_OH_OH = 144 + integer, parameter :: rid_OH_OH_M = 145 + integer, parameter :: rid_OH_H2 = 146 + integer, parameter :: rid_OH_H2O2 = 147 + integer, parameter :: rid_H2_O = 148 + integer, parameter :: rid_HO2_O = 149 + integer, parameter :: rid_HO2_O3 = 150 + integer, parameter :: rid_usr_HO2_HO2 = 151 + integer, parameter :: rid_H2O2_O = 152 + integer, parameter :: rid_N2D_O2 = 153 + integer, parameter :: rid_N2D_O = 154 + integer, parameter :: rid_N_OH = 155 + integer, parameter :: rid_N_O2 = 156 + integer, parameter :: rid_N_NO = 157 + integer, parameter :: rid_N_NO2a = 158 + integer, parameter :: rid_N_NO2b = 159 + integer, parameter :: rid_N_NO2c = 160 + integer, parameter :: rid_NO_O = 161 + integer, parameter :: rid_NO_HO2 = 162 + integer, parameter :: rid_NO_O3 = 163 + integer, parameter :: rid_NO2_O = 164 + integer, parameter :: rid_NO2_O_M = 165 + integer, parameter :: rid_NO2_O3 = 166 + integer, parameter :: rid_tag_NO2_NO3 = 167 + integer, parameter :: rid_usr_N2O5_M = 168 + integer, parameter :: rid_tag_NO2_OH = 169 + integer, parameter :: rid_usr_HNO3_OH = 170 + integer, parameter :: rid_NO3_NO = 171 + integer, parameter :: rid_NO3_O = 172 + integer, parameter :: rid_NO3_OH = 173 + integer, parameter :: rid_NO3_HO2 = 174 + integer, parameter :: rid_tag_NO2_HO2 = 175 + integer, parameter :: rid_HO2NO2_OH = 176 + integer, parameter :: rid_usr_HO2NO2_M = 177 + integer, parameter :: rid_CL_O3 = 178 + integer, parameter :: rid_CL_H2 = 179 + integer, parameter :: rid_CL_H2O2 = 180 + integer, parameter :: rid_CL_HO2a = 181 + integer, parameter :: rid_CL_HO2b = 182 + integer, parameter :: rid_CL_CH2O = 183 + integer, parameter :: rid_CL_CH4 = 184 + integer, parameter :: rid_CLO_O = 185 + integer, parameter :: rid_CLO_OHa = 186 + integer, parameter :: rid_CLO_OHb = 187 + integer, parameter :: rid_CLO_HO2 = 188 + integer, parameter :: rid_CLO_CH3O2 = 189 + integer, parameter :: rid_CLO_NO = 190 + integer, parameter :: rid_CLO_NO2_M = 191 + integer, parameter :: rid_CLO_CLOa = 192 + integer, parameter :: rid_CLO_CLOb = 193 + integer, parameter :: rid_CLO_CLOc = 194 + integer, parameter :: rid_tag_CLO_CLO_M = 195 + integer, parameter :: rid_usr_CL2O2_M = 196 + integer, parameter :: rid_HCL_OH = 197 + integer, parameter :: rid_HCL_O = 198 + integer, parameter :: rid_HOCL_O = 199 + integer, parameter :: rid_HOCL_CL = 200 + integer, parameter :: rid_HOCL_OH = 201 + integer, parameter :: rid_CLONO2_O = 202 + integer, parameter :: rid_CLONO2_OH = 203 + integer, parameter :: rid_CLONO2_CL = 204 + integer, parameter :: rid_BR_O3 = 205 + integer, parameter :: rid_BR_HO2 = 206 + integer, parameter :: rid_BR_CH2O = 207 + integer, parameter :: rid_BRO_O = 208 + integer, parameter :: rid_BRO_OH = 209 + integer, parameter :: rid_BRO_HO2 = 210 + integer, parameter :: rid_BRO_NO = 211 + integer, parameter :: rid_BRO_NO2_M = 212 + integer, parameter :: rid_BRO_CLOa = 213 + integer, parameter :: rid_BRO_CLOb = 214 + integer, parameter :: rid_BRO_CLOc = 215 + integer, parameter :: rid_BRO_BRO = 216 + integer, parameter :: rid_HBR_OH = 217 + integer, parameter :: rid_HBR_O = 218 + integer, parameter :: rid_HOBR_O = 219 + integer, parameter :: rid_BRONO2_O = 220 + integer, parameter :: rid_F_H2O = 221 + integer, parameter :: rid_F_H2 = 222 + integer, parameter :: rid_F_CH4 = 223 + integer, parameter :: rid_F_HNO3 = 224 + integer, parameter :: rid_CH3CL_CL = 225 + integer, parameter :: rid_CH3CL_OH = 226 + integer, parameter :: rid_CH3CCL3_OH = 227 + integer, parameter :: rid_HCFC22_OH = 228 + integer, parameter :: rid_CH3BR_OH = 229 + integer, parameter :: rid_CH3BR_CL = 230 + integer, parameter :: rid_HCFC141B_OH = 231 + integer, parameter :: rid_HCFC142B_OH = 232 + integer, parameter :: rid_CH2BR2_OH = 233 + integer, parameter :: rid_CHBR3_OH = 234 + integer, parameter :: rid_CH2BR2_CL = 235 + integer, parameter :: rid_CHBR3_CL = 236 + integer, parameter :: rid_CH4_OH = 237 + integer, parameter :: rid_usr_CO_OH_b = 238 + integer, parameter :: rid_CO_OH_M = 239 + integer, parameter :: rid_CH2O_NO3 = 240 + integer, parameter :: rid_CH2O_OH = 241 + integer, parameter :: rid_CH2O_O = 242 + integer, parameter :: rid_CH3O2_NO = 243 + integer, parameter :: rid_CH3O2_HO2 = 244 + integer, parameter :: rid_CH3OOH_OH = 245 + integer, parameter :: rid_usr_N2O5_aer = 246 + integer, parameter :: rid_usr_NO3_aer = 247 + integer, parameter :: rid_usr_NO2_aer = 248 + integer, parameter :: rid_usr_HO2_aer = 249 + integer, parameter :: rid_OCS_O = 250 + integer, parameter :: rid_OCS_OH = 251 + integer, parameter :: rid_S_OH = 252 + integer, parameter :: rid_S_O2 = 253 + integer, parameter :: rid_S_O3 = 254 + integer, parameter :: rid_SO_OH = 255 + integer, parameter :: rid_SO_O2 = 256 + integer, parameter :: rid_SO_O3 = 257 + integer, parameter :: rid_SO_NO2 = 258 + integer, parameter :: rid_SO_CLO = 259 + integer, parameter :: rid_SO_BRO = 260 + integer, parameter :: rid_SO_OCLO = 261 + integer, parameter :: rid_usr_SO2_OH = 262 + integer, parameter :: rid_usr_SO3_H2O = 263 + integer, parameter :: rid_usr_DMS_OH = 264 + integer, parameter :: rid_DMS_OHb = 265 + integer, parameter :: rid_DMS_NO3 = 266 + integer, parameter :: rid_het1 = 267 + integer, parameter :: rid_het2 = 268 + integer, parameter :: rid_het3 = 269 + integer, parameter :: rid_het4 = 270 + integer, parameter :: rid_het5 = 271 + integer, parameter :: rid_het6 = 272 + integer, parameter :: rid_het7 = 273 + integer, parameter :: rid_het8 = 274 + integer, parameter :: rid_het9 = 275 + integer, parameter :: rid_het10 = 276 + integer, parameter :: rid_het11 = 277 + integer, parameter :: rid_het12 = 278 + integer, parameter :: rid_het13 = 279 + integer, parameter :: rid_het14 = 280 + integer, parameter :: rid_het15 = 281 + integer, parameter :: rid_het16 = 282 + integer, parameter :: rid_het17 = 283 + integer, parameter :: rid_ion_Op_O2 = 284 + integer, parameter :: rid_ion_Op_N2 = 285 + integer, parameter :: rid_ion_N2p_Oa = 286 + integer, parameter :: rid_ion_N2p_Ob = 287 + integer, parameter :: rid_ion_Op_CO2 = 288 + integer, parameter :: rid_ion_O2p_N = 289 + integer, parameter :: rid_ion_O2p_NO = 290 + integer, parameter :: rid_ion_Np_O2a = 291 + integer, parameter :: rid_ion_Np_O2b = 292 + integer, parameter :: rid_ion_Np_O = 293 + integer, parameter :: rid_ion_N2p_O2 = 294 + integer, parameter :: rid_ion_O2p_N2 = 295 + integer, parameter :: rid_elec1 = 296 + integer, parameter :: rid_elec2 = 297 + integer, parameter :: rid_elec3 = 298 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..3c17693593 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 @@ -0,0 +1,101 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O2 = 3 + integer, parameter :: id_N2O = 4 + integer, parameter :: id_N = 5 + integer, parameter :: id_NO = 6 + integer, parameter :: id_NO2 = 7 + integer, parameter :: id_NO3 = 8 + integer, parameter :: id_HNO3 = 9 + integer, parameter :: id_HO2NO2 = 10 + integer, parameter :: id_N2O5 = 11 + integer, parameter :: id_CH4 = 12 + integer, parameter :: id_CH3O2 = 13 + integer, parameter :: id_CH3OOH = 14 + integer, parameter :: id_CH2O = 15 + integer, parameter :: id_CO = 16 + integer, parameter :: id_H2 = 17 + integer, parameter :: id_H = 18 + integer, parameter :: id_H2O2 = 19 + integer, parameter :: id_CLY = 20 + integer, parameter :: id_BRY = 21 + integer, parameter :: id_CL2 = 22 + integer, parameter :: id_CLO = 23 + integer, parameter :: id_OCLO = 24 + integer, parameter :: id_CL2O2 = 25 + integer, parameter :: id_HCL = 26 + integer, parameter :: id_HOCL = 27 + integer, parameter :: id_CLONO2 = 28 + integer, parameter :: id_BRCL = 29 + integer, parameter :: id_BRO = 30 + integer, parameter :: id_HBR = 31 + integer, parameter :: id_HOBR = 32 + integer, parameter :: id_BRONO2 = 33 + integer, parameter :: id_CH3CL = 34 + integer, parameter :: id_CH3BR = 35 + integer, parameter :: id_CFC11 = 36 + integer, parameter :: id_CFC12 = 37 + integer, parameter :: id_CFC113 = 38 + integer, parameter :: id_HCFC22 = 39 + integer, parameter :: id_CCL4 = 40 + integer, parameter :: id_CH3CCL3 = 41 + integer, parameter :: id_CF3BR = 42 + integer, parameter :: id_CF2CLBR = 43 + integer, parameter :: id_HCFC141B = 44 + integer, parameter :: id_HCFC142B = 45 + integer, parameter :: id_CFC114 = 46 + integer, parameter :: id_CFC115 = 47 + integer, parameter :: id_H1202 = 48 + integer, parameter :: id_H2402 = 49 + integer, parameter :: id_CHBR3 = 50 + integer, parameter :: id_CH2BR2 = 51 + integer, parameter :: id_COF2 = 52 + integer, parameter :: id_COFCL = 53 + integer, parameter :: id_HF = 54 + integer, parameter :: id_F = 55 + integer, parameter :: id_CO2 = 56 + integer, parameter :: id_OCS = 57 + integer, parameter :: id_S = 58 + integer, parameter :: id_SO = 59 + integer, parameter :: id_SO2 = 60 + integer, parameter :: id_SO3 = 61 + integer, parameter :: id_H2SO4 = 62 + integer, parameter :: id_DMS = 63 + integer, parameter :: id_SOAG = 64 + integer, parameter :: id_so4_a1 = 65 + integer, parameter :: id_pom_a1 = 66 + integer, parameter :: id_soa_a1 = 67 + integer, parameter :: id_bc_a1 = 68 + integer, parameter :: id_dst_a1 = 69 + integer, parameter :: id_ncl_a1 = 70 + integer, parameter :: id_num_a1 = 71 + integer, parameter :: id_so4_a2 = 72 + integer, parameter :: id_soa_a2 = 73 + integer, parameter :: id_ncl_a2 = 74 + integer, parameter :: id_num_a2 = 75 + integer, parameter :: id_dst_a2 = 76 + integer, parameter :: id_dst_a3 = 77 + integer, parameter :: id_ncl_a3 = 78 + integer, parameter :: id_so4_a3 = 79 + integer, parameter :: id_num_a3 = 80 + integer, parameter :: id_pom_a4 = 81 + integer, parameter :: id_bc_a4 = 82 + integer, parameter :: id_num_a4 = 83 + integer, parameter :: id_CL = 84 + integer, parameter :: id_BR = 85 + integer, parameter :: id_OH = 86 + integer, parameter :: id_HO2 = 87 + integer, parameter :: id_N2p = 88 + integer, parameter :: id_O2p = 89 + integer, parameter :: id_Np = 90 + integer, parameter :: id_Op = 91 + integer, parameter :: id_NOp = 92 + integer, parameter :: id_e = 93 + integer, parameter :: id_N2D = 94 + integer, parameter :: id_O2_1S = 95 + integer, parameter :: id_O2_1D = 96 + integer, parameter :: id_O1D = 97 + integer, parameter :: id_H2O = 98 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..20692dc695 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 @@ -0,0 +1,222 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 92) = rate(:,:, 92) * inv(:,:, 1) + rate(:,:, 94) = rate(:,:, 94) * inv(:,:, 1) + rate(:,:, 97) = rate(:,:, 97) * inv(:,:, 2) + rate(:,:,103) = rate(:,:,103) * inv(:,:, 2) + rate(:,:,105) = rate(:,:,105) * inv(:,:, 2) + rate(:,:,136) = rate(:,:,136) * inv(:,:, 1) + rate(:,:,145) = rate(:,:,145) * inv(:,:, 1) + rate(:,:,161) = rate(:,:,161) * inv(:,:, 1) + rate(:,:,165) = rate(:,:,165) * inv(:,:, 1) + rate(:,:,167) = rate(:,:,167) * inv(:,:, 1) + rate(:,:,168) = rate(:,:,168) * inv(:,:, 1) + rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) + rate(:,:,175) = rate(:,:,175) * inv(:,:, 1) + rate(:,:,177) = rate(:,:,177) * inv(:,:, 1) + rate(:,:,191) = rate(:,:,191) * inv(:,:, 1) + rate(:,:,195) = rate(:,:,195) * inv(:,:, 1) + rate(:,:,196) = rate(:,:,196) * inv(:,:, 1) + rate(:,:,212) = rate(:,:,212) * inv(:,:, 1) + rate(:,:,239) = rate(:,:,239) * inv(:,:, 1) + rate(:,:,285) = rate(:,:,285) * inv(:,:, 2) + rate(:,:,295) = rate(:,:,295) * inv(:,:, 2) + rate(:,:, 92) = rate(:,:, 92) * m(:,:) + rate(:,:, 93) = rate(:,:, 93) * m(:,:) + rate(:,:, 94) = rate(:,:, 94) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 96) = rate(:,:, 96) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:,101) = rate(:,:,101) * m(:,:) + rate(:,:,102) = rate(:,:,102) * m(:,:) + rate(:,:,106) = rate(:,:,106) * m(:,:) + rate(:,:,107) = rate(:,:,107) * m(:,:) + rate(:,:,108) = rate(:,:,108) * m(:,:) + rate(:,:,109) = rate(:,:,109) * m(:,:) + rate(:,:,110) = rate(:,:,110) * m(:,:) + rate(:,:,111) = rate(:,:,111) * m(:,:) + rate(:,:,112) = rate(:,:,112) * m(:,:) + rate(:,:,113) = rate(:,:,113) * m(:,:) + rate(:,:,114) = rate(:,:,114) * m(:,:) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,116) = rate(:,:,116) * m(:,:) + rate(:,:,117) = rate(:,:,117) * m(:,:) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,123) = rate(:,:,123) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,126) = rate(:,:,126) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,264) = rate(:,:,264) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,288) = rate(:,:,288) * m(:,:) + rate(:,:,289) = rate(:,:,289) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,292) = rate(:,:,292) * m(:,:) + rate(:,:,293) = rate(:,:,293) * m(:,:) + rate(:,:,294) = rate(:,:,294) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..d60102ae86 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 @@ -0,0 +1,147 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) =rxt(:,:,158)*y(:,:,7)*y(:,:,5) + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = (rxt(:,:,238)*y(:,:,86) +rxt(:,:,239)*y(:,:,86))*y(:,:,16) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,64) = 0._r8 + prod(:,:,75) = (rxt(:,:,58) +rxt(:,:,91))*y(:,:,56) +.180_r8*rxt(:,:,60) & + *y(:,:,12) + prod(:,:,74) =rxt(:,:,5)*y(:,:,4) + prod(:,:,70) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,60) =1.440_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,39) = (rxt(:,:,58) +rxt(:,:,91))*y(:,:,56) +.380_r8*rxt(:,:,60) & + *y(:,:,12) + extfrc(:,:,3) + prod(:,:,51) = (rxt(:,:,75) +.800_r8*rxt(:,:,78) +rxt(:,:,87) + & + .800_r8*rxt(:,:,90)) + extfrc(:,:,20) + prod(:,:,65) = + extfrc(:,:,1) + prod(:,:,66) = + extfrc(:,:,2) + prod(:,:,67) =.330_r8*rxt(:,:,60)*y(:,:,12) + extfrc(:,:,22) + prod(:,:,68) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,72) =rxt(:,:,59)*y(:,:,12) +rxt(:,:,37)*y(:,:,34) +rxt(:,:,48) & + *y(:,:,35) + prod(:,:,35) = 0._r8 + prod(:,:,58) =.180_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,57) = (rxt(:,:,59) +.330_r8*rxt(:,:,60))*y(:,:,12) + prod(:,:,71) = 0._r8 + prod(:,:,41) = 0._r8 + prod(:,:,69) =.050_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,61) =rxt(:,:,37)*y(:,:,34) +2.000_r8*rxt(:,:,40)*y(:,:,36) & + +2.000_r8*rxt(:,:,41)*y(:,:,37) +2.000_r8*rxt(:,:,42)*y(:,:,38) & + +rxt(:,:,45)*y(:,:,39) +4.000_r8*rxt(:,:,38)*y(:,:,40) & + +3.000_r8*rxt(:,:,39)*y(:,:,41) +rxt(:,:,50)*y(:,:,43) +rxt(:,:,46) & + *y(:,:,44) +rxt(:,:,47)*y(:,:,45) +2.000_r8*rxt(:,:,43)*y(:,:,46) & + +rxt(:,:,44)*y(:,:,47) + prod(:,:,26) = 0._r8 + prod(:,:,62) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,73) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,54) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,63) =rxt(:,:,48)*y(:,:,35) +rxt(:,:,49)*y(:,:,42) +rxt(:,:,50) & + *y(:,:,43) +2.000_r8*rxt(:,:,53)*y(:,:,48) +2.000_r8*rxt(:,:,54) & + *y(:,:,49) +3.000_r8*rxt(:,:,51)*y(:,:,50) +2.000_r8*rxt(:,:,52) & + *y(:,:,51) + prod(:,:,59) = 0._r8 + prod(:,:,50) = 0._r8 + prod(:,:,49) = 0._r8 + prod(:,:,40) = 0._r8 + prod(:,:,42) = (rxt(:,:,71) +rxt(:,:,83)) + extfrc(:,:,18) + prod(:,:,46) = + extfrc(:,:,16) + prod(:,:,36) = (rxt(:,:,75) +rxt(:,:,76) +rxt(:,:,87) +rxt(:,:,88)) & + + extfrc(:,:,17) + prod(:,:,44) = + extfrc(:,:,15) + prod(:,:,47) = 0._r8 + prod(:,:,38) = (rxt(:,:,76) +1.200_r8*rxt(:,:,78) +rxt(:,:,88) + & + 1.200_r8*rxt(:,:,90)) + extfrc(:,:,19) + prod(:,:,48) = (rxt(:,:,71) +rxt(:,:,75) +rxt(:,:,76) +rxt(:,:,83) + & + rxt(:,:,87) +rxt(:,:,88)) + extfrc(:,:,21) + prod(:,:,22) =rxt(:,:,41)*y(:,:,37) +rxt(:,:,42)*y(:,:,38) +rxt(:,:,45) & + *y(:,:,39) +rxt(:,:,49)*y(:,:,42) +rxt(:,:,50)*y(:,:,43) +rxt(:,:,47) & + *y(:,:,45) +2.000_r8*rxt(:,:,43)*y(:,:,46) +2.000_r8*rxt(:,:,44) & + *y(:,:,47) +rxt(:,:,53)*y(:,:,48) +2.000_r8*rxt(:,:,54)*y(:,:,49) + prod(:,:,27) =rxt(:,:,40)*y(:,:,36) +rxt(:,:,42)*y(:,:,38) +rxt(:,:,46) & + *y(:,:,44) + prod(:,:,29) = 0._r8 + prod(:,:,45) =rxt(:,:,49)*y(:,:,42) +rxt(:,:,44)*y(:,:,47) + prod(:,:,34) = 0._r8 + prod(:,:,43) = 0._r8 + prod(:,:,56) = 0._r8 + prod(:,:,53) = + extfrc(:,:,4) + prod(:,:,30) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,31) = + extfrc(:,:,5) + prod(:,:,1) = 0._r8 + prod(:,:,2) = + extfrc(:,:,6) + prod(:,:,3) = + extfrc(:,:,8) + prod(:,:,4) = 0._r8 + prod(:,:,5) = + extfrc(:,:,10) + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = + extfrc(:,:,12) + prod(:,:,9) = + extfrc(:,:,7) + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = + extfrc(:,:,13) + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = + extfrc(:,:,9) + prod(:,:,19) = + extfrc(:,:,11) + prod(:,:,20) = + extfrc(:,:,14) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..23ac2eee53 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 @@ -0,0 +1,287 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(423) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(735) = -( rxt(66) + rxt(67) + rxt(68) + rxt(79) + rxt(80) + rxt(81) & + + het_rates(2) ) + mat(602) = rxt(1) + 2.000_r8*rxt(2) + rxt(72) + rxt(73) + rxt(74) & + + 2.000_r8*rxt(77) + rxt(84) + rxt(85) + rxt(86) + 2.000_r8*rxt(89) + mat(434) = rxt(4) + mat(457) = rxt(6) + mat(484) = rxt(8) + mat(63) = rxt(10) + mat(546) = rxt(12) + mat(571) = rxt(21) + mat(390) = rxt(24) + mat(68) = rxt(25) + mat(322) = rxt(32) + mat(232) = rxt(62) + mat(51) = rxt(63) + mat(271) = rxt(65) + mat(694) = rxt(105) + mat(693) = -( rxt(105) + rxt(109)*y(4) + rxt(110)*y(4) + rxt(112)*y(36) & + + rxt(113)*y(37) + rxt(114)*y(38) + rxt(115)*y(46) + rxt(116)*y(47) & + + rxt(117)*y(39) + rxt(118)*y(44) + rxt(119)*y(45) + rxt(120)*y(40) & + + rxt(121)*y(35) + rxt(122)*y(43) + rxt(123)*y(42) + rxt(124)*y(48) & + + rxt(125)*y(49) + rxt(126)*y(50) + rxt(127)*y(51) + rxt(130)*y(12) & + + rxt(131)*y(12) + rxt(132)*y(12) + het_rates(97) ) + mat(601) = rxt(1) + mat(433) = rxt(3) + mat(570) = rxt(20) + mat(597) = -( rxt(1) + rxt(2) + rxt(70) + rxt(72) + rxt(73) + rxt(74) + rxt(77) & + + rxt(82) + rxt(84) + rxt(85) + rxt(86) + rxt(89) + het_rates(3) ) + mat(429) = rxt(4) + mat(541) = rxt(13) + mat(34) = rxt(100) + mat(31) = rxt(103) + rxt(104) + mat(689) = rxt(110)*y(4) + mat(33) = -( rxt(97) + rxt(100) + rxt(99)*y(56) + het_rates(95) ) + mat(30) = -( rxt(103) + rxt(104) + het_rates(96) ) + mat(412) = rxt(3) + mat(32) = rxt(97) + rxt(99)*y(56) + mat(327) = -( het_rates(17) ) + mat(285) = rxt(18) + mat(556) = rxt(20) + mat(679) = rxt(132)*y(12) + mat(102) = -( het_rates(16) ) + mat(280) = rxt(17) + rxt(18) + mat(70) = rxt(64) + mat(341) = rxt(225)*y(34) + mat(139) = rxt(288)*y(56) + mat(209) = -( rxt(69) + het_rates(5) ) + mat(438) = rxt(6) + mat(143) = rxt(285) + mat(447) = -( rxt(6) + rxt(7) + het_rates(6) ) + mat(474) = rxt(8) + .500_r8*rxt(248) + mat(60) = rxt(10) + mat(536) = rxt(13) + mat(162) = rxt(295) + mat(684) = 2.000_r8*rxt(109)*y(4) + mat(475) = -( rxt(8) + rxt(248) + het_rates(7) ) + mat(61) = rxt(9) + rxt(168) + mat(250) = rxt(11) + mat(537) = rxt(12) + mat(91) = rxt(15) + rxt(177) + mat(239) = rxt(30) + mat(111) = rxt(36) + mat(513) = -( rxt(226)*y(34) + rxt(227)*y(41) + rxt(228)*y(39) + rxt(229)*y(35) & + + rxt(231)*y(44) + rxt(232)*y(45) + rxt(233)*y(51) + rxt(234)*y(50) & + + rxt(237)*y(12) + het_rates(86) ) + mat(251) = rxt(11) + mat(92) = rxt(14) + mat(80) = rxt(16) + mat(563) = rxt(19) + mat(116) = 2.000_r8*rxt(22) + mat(222) = rxt(27) + mat(193) = rxt(33) + mat(476) = .500_r8*rxt(248) + mat(686) = rxt(130)*y(12) + mat(539) = -( rxt(12) + rxt(13) + rxt(247) + het_rates(8) ) + mat(62) = rxt(9) + rxt(10) + rxt(168) + mat(93) = rxt(14) + mat(241) = rxt(29) + mat(112) = rxt(35) + mat(247) = -( rxt(11) + het_rates(9) ) + mat(59) = 2.000_r8*rxt(246) + 2.000_r8*rxt(267) + 2.000_r8*rxt(273) & + + 2.000_r8*rxt(278) + mat(526) = rxt(247) + mat(465) = .500_r8*rxt(248) + mat(236) = rxt(268) + rxt(274) + rxt(279) + mat(108) = rxt(269) + rxt(277) + rxt(280) + mat(90) = -( rxt(14) + rxt(15) + rxt(177) + het_rates(10) ) + mat(58) = -( rxt(9) + rxt(10) + rxt(168) + rxt(246) + rxt(267) + rxt(273) & + + rxt(278) + het_rates(11) ) + mat(643) = -( het_rates(13) ) + mat(691) = rxt(130)*y(12) + mat(359) = rxt(184)*y(12) + mat(157) = rxt(223)*y(12) + mat(518) = rxt(237)*y(12) + mat(77) = -( rxt(16) + het_rates(14) ) + mat(284) = -( rxt(17) + rxt(18) + het_rates(15) ) + mat(79) = rxt(16) + mat(678) = rxt(131)*y(12) + rxt(132)*y(12) + mat(272) = -( het_rates(18) ) + mat(78) = rxt(16) + mat(283) = 2.000_r8*rxt(17) + mat(554) = rxt(19) + 2.000_r8*rxt(21) + mat(653) = rxt(28) + mat(198) = rxt(34) + mat(46) = rxt(57) + mat(677) = rxt(131)*y(12) + mat(623) = -( rxt(249) + het_rates(87) ) + mat(96) = rxt(15) + rxt(177) + mat(690) = rxt(131)*y(12) + mat(358) = rxt(225)*y(34) + rxt(230)*y(35) + mat(517) = rxt(226)*y(34) + rxt(229)*y(35) + mat(114) = -( rxt(22) + het_rates(19) ) + mat(605) = .500_r8*rxt(249) + mat(565) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(98) ) + mat(29) = rxt(61) + mat(515) = rxt(226)*y(34) + rxt(227)*y(41) + rxt(228)*y(39) + rxt(229)*y(35) & + + rxt(233)*y(51) + rxt(237)*y(12) + mat(349) = -( rxt(184)*y(12) + rxt(225)*y(34) + rxt(230)*y(35) + rxt(235)*y(51) & + + rxt(236)*y(50) + het_rates(84) ) + mat(36) = 2.000_r8*rxt(23) + mat(376) = rxt(24) + mat(22) = 2.000_r8*rxt(26) + mat(220) = rxt(27) + mat(656) = rxt(28) + mat(237) = rxt(29) + mat(42) = rxt(31) + mat(39) = rxt(56) + mat(680) = 2.000_r8*rxt(112)*y(36) + 2.000_r8*rxt(113)*y(37) & + + 2.000_r8*rxt(114)*y(38) + 2.000_r8*rxt(115)*y(46) + rxt(116)*y(47) & + + rxt(117)*y(39) + rxt(118)*y(44) + rxt(119)*y(45) & + + 4.000_r8*rxt(120)*y(40) + rxt(122)*y(43) + mat(507) = rxt(226)*y(34) + 3.000_r8*rxt(227)*y(41) + rxt(228)*y(39) & + + rxt(231)*y(44) + rxt(232)*y(45) + mat(35) = -( rxt(23) + het_rates(22) ) + mat(377) = -( rxt(24) + het_rates(23) ) + mat(67) = rxt(25) + mat(238) = rxt(30) + mat(23) = 2.000_r8*rxt(196) + mat(64) = -( rxt(25) + het_rates(24) ) + mat(21) = -( rxt(26) + rxt(196) + het_rates(25) ) + mat(668) = -( rxt(28) + het_rates(26) ) + mat(360) = rxt(184)*y(12) + 2.000_r8*rxt(225)*y(34) + rxt(230)*y(35) & + + rxt(235)*y(51) + rxt(236)*y(50) + mat(219) = -( rxt(27) + het_rates(27) ) + mat(234) = rxt(268) + rxt(274) + rxt(279) + mat(235) = -( rxt(29) + rxt(30) + rxt(268) + rxt(274) + rxt(279) + het_rates(28) & + ) + mat(41) = -( rxt(31) + het_rates(29) ) + mat(399) = -( het_rates(85) ) + mat(43) = rxt(31) + mat(311) = rxt(32) + mat(192) = rxt(33) + mat(199) = rxt(34) + mat(110) = rxt(35) + mat(682) = rxt(121)*y(35) + rxt(122)*y(43) + rxt(123)*y(42) & + + 2.000_r8*rxt(124)*y(48) + 2.000_r8*rxt(125)*y(49) & + + 3.000_r8*rxt(126)*y(50) + 2.000_r8*rxt(127)*y(51) + mat(509) = rxt(229)*y(35) + 2.000_r8*rxt(233)*y(51) + 3.000_r8*rxt(234)*y(50) + mat(351) = rxt(230)*y(35) + 2.000_r8*rxt(235)*y(51) + 3.000_r8*rxt(236)*y(50) + mat(307) = -( rxt(32) + het_rates(30) ) + mat(109) = rxt(36) + mat(197) = -( rxt(34) + het_rates(31) ) + mat(189) = -( rxt(33) + het_rates(32) ) + mat(107) = rxt(269) + rxt(277) + rxt(280) + mat(106) = -( rxt(35) + rxt(36) + rxt(269) + rxt(277) + rxt(280) + het_rates(33) & + ) + mat(122) = -( het_rates(88) ) + mat(158) = -( rxt(295) + het_rates(89) ) + mat(579) = rxt(70) + rxt(82) + mat(141) = rxt(288)*y(56) + mat(83) = -( het_rates(90) ) + mat(204) = rxt(69) + mat(140) = -( rxt(285) + rxt(288)*y(56) + het_rates(91) ) + mat(705) = rxt(66) + rxt(67) + rxt(68) + rxt(79) + rxt(80) + rxt(81) + mat(578) = rxt(72) + rxt(73) + rxt(74) + rxt(84) + rxt(85) + rxt(86) + mat(167) = -( het_rates(92) ) + mat(436) = rxt(7) + mat(142) = rxt(285) + mat(159) = rxt(295) + mat(97) = -( het_rates(94) ) + mat(179) = -( het_rates(93) ) + mat(437) = rxt(7) + mat(708) = rxt(66) + rxt(67) + rxt(68) + rxt(79) + rxt(80) + rxt(81) + mat(208) = rxt(69) + mat(581) = rxt(70) + rxt(72) + rxt(73) + rxt(74) + rxt(82) + rxt(84) + rxt(85) & + + rxt(86) + mat(24) = -( rxt(55) + het_rates(52) ) + mat(671) = rxt(113)*y(37) + rxt(114)*y(38) + 2.000_r8*rxt(115)*y(46) & + + 2.000_r8*rxt(116)*y(47) + rxt(117)*y(39) + rxt(119)*y(45) & + + rxt(122)*y(43) + rxt(123)*y(42) + rxt(124)*y(48) & + + 2.000_r8*rxt(125)*y(49) + mat(485) = rxt(228)*y(39) + rxt(232)*y(45) + mat(37) = -( rxt(56) + het_rates(53) ) + mat(673) = rxt(112)*y(36) + rxt(114)*y(38) + rxt(118)*y(44) + mat(486) = rxt(231)*y(44) + mat(44) = -( rxt(57) + het_rates(54) ) + mat(149) = rxt(223)*y(12) + mat(150) = -( rxt(223)*y(12) + het_rates(55) ) + mat(25) = 2.000_r8*rxt(55) + mat(38) = rxt(56) + mat(45) = rxt(57) + mat(674) = rxt(116)*y(47) + rxt(123)*y(42) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(69) = -( rxt(64) + het_rates(57) ) + mat(132) = -( het_rates(58) ) + mat(71) = rxt(64) + mat(256) = rxt(65) + mat(258) = -( rxt(65) + het_rates(59) ) + mat(228) = rxt(62) + mat(227) = -( rxt(62) + het_rates(60) ) + mat(49) = rxt(63) + mat(48) = -( rxt(63) + het_rates(61) ) + mat(28) = rxt(61) + mat(27) = -( rxt(61) + het_rates(62) ) + mat(52) = -( het_rates(63) ) + mat(1) = -( het_rates(64) ) + mat(2) = -( het_rates(65) ) + mat(3) = -( het_rates(66) ) + mat(4) = -( het_rates(67) ) + mat(5) = -( het_rates(68) ) + mat(6) = -( het_rates(69) ) + mat(7) = -( het_rates(70) ) + mat(8) = -( het_rates(71) ) + mat(9) = -( het_rates(72) ) + mat(10) = -( het_rates(73) ) + mat(11) = -( het_rates(74) ) + mat(12) = -( het_rates(75) ) + mat(13) = -( het_rates(76) ) + mat(14) = -( het_rates(77) ) + mat(15) = -( het_rates(78) ) + mat(16) = -( het_rates(79) ) + mat(17) = -( het_rates(80) ) + mat(18) = -( het_rates(81) ) + mat(19) = -( het_rates(82) ) + mat(20) = -( het_rates(83) ) + end subroutine linmat02 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..a1a8cf5c53 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 @@ -0,0 +1,3071 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = lu(22) * lu(21) + lu(23) = lu(23) * lu(21) + lu(376) = lu(376) - lu(22) * lu(363) + lu(377) = lu(377) - lu(23) * lu(363) + lu(24) = 1._r8 / lu(24) + lu(25) = lu(25) * lu(24) + lu(26) = lu(26) * lu(24) + lu(495) = - lu(25) * lu(485) + lu(520) = - lu(26) * lu(485) + lu(674) = lu(674) - lu(25) * lu(671) + lu(693) = lu(693) - lu(26) * lu(671) + lu(27) = 1._r8 / lu(27) + lu(28) = lu(28) * lu(27) + lu(29) = lu(29) * lu(27) + lu(48) = lu(48) - lu(28) * lu(47) + lu(50) = lu(50) - lu(29) * lu(47) + lu(549) = lu(549) - lu(28) * lu(547) + lu(565) = lu(565) - lu(29) * lu(547) + lu(30) = 1._r8 / lu(30) + lu(31) = lu(31) * lu(30) + lu(34) = lu(34) - lu(31) * lu(32) + lu(429) = lu(429) - lu(31) * lu(412) + lu(597) = lu(597) - lu(31) * lu(572) + lu(730) = lu(730) - lu(31) * lu(695) + lu(33) = 1._r8 / lu(33) + lu(34) = lu(34) * lu(33) + lu(429) = lu(429) - lu(34) * lu(413) + lu(597) = lu(597) - lu(34) * lu(573) + lu(689) = lu(689) - lu(34) * lu(672) + lu(730) = lu(730) - lu(34) * lu(696) + lu(35) = 1._r8 / lu(35) + lu(36) = lu(36) * lu(35) + lu(220) = lu(220) - lu(36) * lu(218) + lu(237) = lu(237) - lu(36) * lu(233) + lu(349) = lu(349) - lu(36) * lu(340) + lu(376) = lu(376) - lu(36) * lu(364) + lu(656) = lu(656) - lu(36) * lu(647) + lu(37) = 1._r8 / lu(37) + lu(38) = lu(38) * lu(37) + lu(39) = lu(39) * lu(37) + lu(40) = lu(40) * lu(37) + lu(495) = lu(495) - lu(38) * lu(486) + lu(507) = lu(507) - lu(39) * lu(486) + lu(520) = lu(520) - lu(40) * lu(486) + lu(674) = lu(674) - lu(38) * lu(673) + lu(680) = lu(680) - lu(39) * lu(673) + lu(693) = lu(693) - lu(40) * lu(673) + lu(41) = 1._r8 / lu(41) + lu(42) = lu(42) * lu(41) + lu(43) = lu(43) * lu(41) + lu(191) = - lu(42) * lu(188) + lu(192) = lu(192) - lu(43) * lu(188) + lu(309) = lu(309) - lu(42) * lu(299) + lu(311) = lu(311) - lu(43) * lu(299) + lu(376) = lu(376) - lu(42) * lu(365) + lu(378) = lu(378) - lu(43) * lu(365) + lu(656) = lu(656) - lu(42) * lu(648) + lu(658) = - lu(43) * lu(648) + lu(44) = 1._r8 / lu(44) + lu(45) = lu(45) * lu(44) + lu(46) = lu(46) * lu(44) + lu(150) = lu(150) - lu(45) * lu(149) + lu(152) = lu(152) - lu(46) * lu(149) + lu(246) = lu(246) - lu(45) * lu(245) + lu(248) = - lu(46) * lu(245) + lu(324) = lu(324) - lu(45) * lu(323) + lu(326) = lu(326) - lu(46) * lu(323) + lu(550) = lu(550) - lu(45) * lu(548) + lu(554) = lu(554) - lu(46) * lu(548) + lu(48) = 1._r8 / lu(48) + lu(49) = lu(49) * lu(48) + lu(50) = lu(50) * lu(48) + lu(51) = lu(51) * lu(48) + lu(227) = lu(227) - lu(49) * lu(226) + lu(230) = - lu(50) * lu(226) + lu(232) = lu(232) - lu(51) * lu(226) + lu(499) = lu(499) - lu(49) * lu(487) + lu(515) = lu(515) - lu(50) * lu(487) + lu(521) = lu(521) - lu(51) * lu(487) + lu(551) = - lu(49) * lu(549) + lu(565) = lu(565) - lu(50) * lu(549) + lu(571) = lu(571) - lu(51) * lu(549) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(52) = 1._r8 / lu(52) + lu(53) = lu(53) * lu(52) + lu(54) = lu(54) * lu(52) + lu(55) = lu(55) * lu(52) + lu(56) = lu(56) * lu(52) + lu(57) = lu(57) * lu(52) + lu(499) = lu(499) - lu(53) * lu(488) + lu(501) = lu(501) - lu(54) * lu(488) + lu(513) = lu(513) - lu(55) * lu(488) + lu(514) = lu(514) - lu(56) * lu(488) + lu(517) = lu(517) - lu(57) * lu(488) + lu(525) = lu(525) - lu(53) * lu(522) + lu(526) = lu(526) - lu(54) * lu(522) + lu(538) = lu(538) - lu(55) * lu(522) + lu(539) = lu(539) - lu(56) * lu(522) + lu(542) = lu(542) - lu(57) * lu(522) + lu(58) = 1._r8 / lu(58) + lu(59) = lu(59) * lu(58) + lu(60) = lu(60) * lu(58) + lu(61) = lu(61) * lu(58) + lu(62) = lu(62) * lu(58) + lu(63) = lu(63) * lu(58) + lu(465) = lu(465) - lu(59) * lu(458) + lu(474) = lu(474) - lu(60) * lu(458) + lu(475) = lu(475) - lu(61) * lu(458) + lu(477) = lu(477) - lu(62) * lu(458) + lu(484) = lu(484) - lu(63) * lu(458) + lu(526) = lu(526) - lu(59) * lu(523) + lu(536) = lu(536) - lu(60) * lu(523) + lu(537) = lu(537) - lu(61) * lu(523) + lu(539) = lu(539) - lu(62) * lu(523) + lu(546) = lu(546) - lu(63) * lu(523) + lu(64) = 1._r8 / lu(64) + lu(65) = lu(65) * lu(64) + lu(66) = lu(66) * lu(64) + lu(67) = lu(67) * lu(64) + lu(68) = lu(68) * lu(64) + lu(257) = lu(257) - lu(65) * lu(255) + lu(258) = lu(258) - lu(66) * lu(255) + lu(262) = lu(262) - lu(67) * lu(255) + lu(271) = lu(271) - lu(68) * lu(255) + lu(303) = lu(303) - lu(65) * lu(300) + lu(305) = lu(305) - lu(66) * lu(300) + lu(310) = lu(310) - lu(67) * lu(300) + lu(322) = lu(322) - lu(68) * lu(300) + lu(368) = lu(368) - lu(65) * lu(366) + lu(371) = lu(371) - lu(66) * lu(366) + lu(377) = lu(377) - lu(67) * lu(366) + lu(390) = lu(390) - lu(68) * lu(366) + lu(69) = 1._r8 / lu(69) + lu(70) = lu(70) * lu(69) + lu(71) = lu(71) * lu(69) + lu(72) = lu(72) * lu(69) + lu(73) = lu(73) * lu(69) + lu(74) = lu(74) * lu(69) + lu(75) = lu(75) * lu(69) + lu(76) = lu(76) * lu(69) + lu(492) = lu(492) - lu(70) * lu(489) + lu(494) = lu(494) - lu(71) * lu(489) + lu(499) = lu(499) - lu(72) * lu(489) + lu(502) = lu(502) - lu(73) * lu(489) + lu(503) = lu(503) - lu(74) * lu(489) + lu(513) = lu(513) - lu(75) * lu(489) + lu(521) = lu(521) - lu(76) * lu(489) + lu(700) = lu(700) - lu(70) * lu(697) + lu(704) = - lu(71) * lu(697) + lu(713) = - lu(72) * lu(697) + lu(716) = lu(716) - lu(73) * lu(697) + lu(717) = lu(717) - lu(74) * lu(697) + lu(727) = lu(727) - lu(75) * lu(697) + lu(735) = lu(735) - lu(76) * lu(697) + lu(77) = 1._r8 / lu(77) + lu(78) = lu(78) * lu(77) + lu(79) = lu(79) * lu(77) + lu(80) = lu(80) * lu(77) + lu(81) = lu(81) * lu(77) + lu(82) = lu(82) * lu(77) + lu(503) = lu(503) - lu(78) * lu(490) + lu(504) = lu(504) - lu(79) * lu(490) + lu(513) = lu(513) - lu(80) * lu(490) + lu(515) = lu(515) - lu(81) * lu(490) + lu(518) = lu(518) - lu(82) * lu(490) + lu(609) = lu(609) - lu(78) * lu(603) + lu(610) = - lu(79) * lu(603) + lu(619) = lu(619) - lu(80) * lu(603) + lu(621) = lu(621) - lu(81) * lu(603) + lu(624) = lu(624) - lu(82) * lu(603) + lu(629) = - lu(78) * lu(628) + lu(630) = lu(630) - lu(79) * lu(628) + lu(638) = - lu(80) * lu(628) + lu(640) = - lu(81) * lu(628) + lu(643) = lu(643) - lu(82) * lu(628) + lu(83) = 1._r8 / lu(83) + lu(84) = lu(84) * lu(83) + lu(85) = lu(85) * lu(83) + lu(86) = lu(86) * lu(83) + lu(87) = lu(87) * lu(83) + lu(88) = lu(88) * lu(83) + lu(89) = lu(89) * lu(83) + lu(205) = - lu(84) * lu(204) + lu(206) = lu(206) - lu(85) * lu(204) + lu(207) = lu(207) - lu(86) * lu(204) + lu(209) = lu(209) - lu(87) * lu(204) + lu(214) = lu(214) - lu(88) * lu(204) + lu(217) = lu(217) - lu(89) * lu(204) + lu(578) = lu(578) - lu(84) * lu(574) + lu(579) = lu(579) - lu(85) * lu(574) + lu(580) = lu(580) - lu(86) * lu(574) + lu(582) = lu(582) - lu(87) * lu(574) + lu(597) = lu(597) - lu(88) * lu(574) + lu(602) = lu(602) - lu(89) * lu(574) + lu(705) = lu(705) - lu(84) * lu(698) + lu(706) = - lu(85) * lu(698) + lu(707) = lu(707) - lu(86) * lu(698) + lu(711) = lu(711) - lu(87) * lu(698) + lu(730) = lu(730) - lu(88) * lu(698) + lu(735) = lu(735) - lu(89) * lu(698) + lu(90) = 1._r8 / lu(90) + lu(91) = lu(91) * lu(90) + lu(92) = lu(92) * lu(90) + lu(93) = lu(93) * lu(90) + lu(94) = lu(94) * lu(90) + lu(95) = lu(95) * lu(90) + lu(96) = lu(96) * lu(90) + lu(475) = lu(475) - lu(91) * lu(459) + lu(476) = lu(476) - lu(92) * lu(459) + lu(477) = lu(477) - lu(93) * lu(459) + lu(478) = - lu(94) * lu(459) + lu(479) = lu(479) - lu(95) * lu(459) + lu(480) = lu(480) - lu(96) * lu(459) + lu(512) = lu(512) - lu(91) * lu(491) + lu(513) = lu(513) - lu(92) * lu(491) + lu(514) = lu(514) - lu(93) * lu(491) + lu(515) = lu(515) - lu(94) * lu(491) + lu(516) = lu(516) - lu(95) * lu(491) + lu(517) = lu(517) - lu(96) * lu(491) + lu(618) = lu(618) - lu(91) * lu(604) + lu(619) = lu(619) - lu(92) * lu(604) + lu(620) = lu(620) - lu(93) * lu(604) + lu(621) = lu(621) - lu(94) * lu(604) + lu(622) = lu(622) - lu(95) * lu(604) + lu(623) = lu(623) - lu(96) * lu(604) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(97) = 1._r8 / lu(97) + lu(98) = lu(98) * lu(97) + lu(99) = lu(99) * lu(97) + lu(100) = lu(100) * lu(97) + lu(101) = lu(101) * lu(97) + lu(127) = lu(127) - lu(98) * lu(121) + lu(128) = - lu(99) * lu(121) + lu(129) = lu(129) - lu(100) * lu(121) + lu(130) = - lu(101) * lu(121) + lu(169) = lu(169) - lu(98) * lu(166) + lu(170) = - lu(99) * lu(166) + lu(171) = - lu(100) * lu(166) + lu(172) = - lu(101) * lu(166) + lu(180) = lu(180) - lu(98) * lu(174) + lu(182) = - lu(99) * lu(174) + lu(184) = - lu(100) * lu(174) + lu(186) = lu(186) - lu(101) * lu(174) + lu(582) = lu(582) - lu(98) * lu(575) + lu(592) = lu(592) - lu(99) * lu(575) + lu(597) = lu(597) - lu(100) * lu(575) + lu(601) = lu(601) - lu(101) * lu(575) + lu(711) = lu(711) - lu(98) * lu(699) + lu(725) = lu(725) - lu(99) * lu(699) + lu(730) = lu(730) - lu(100) * lu(699) + lu(734) = - lu(101) * lu(699) + lu(102) = 1._r8 / lu(102) + lu(103) = lu(103) * lu(102) + lu(104) = lu(104) * lu(102) + lu(105) = lu(105) * lu(102) + lu(144) = - lu(103) * lu(139) + lu(145) = - lu(104) * lu(139) + lu(147) = - lu(105) * lu(139) + lu(283) = lu(283) - lu(103) * lu(280) + lu(290) = lu(290) - lu(104) * lu(280) + lu(294) = lu(294) - lu(105) * lu(280) + lu(346) = lu(346) - lu(103) * lu(341) + lu(354) = lu(354) - lu(104) * lu(341) + lu(358) = lu(358) - lu(105) * lu(341) + lu(393) = - lu(103) * lu(391) + lu(403) = - lu(104) * lu(391) + lu(407) = lu(407) - lu(105) * lu(391) + lu(503) = lu(503) - lu(103) * lu(492) + lu(513) = lu(513) - lu(104) * lu(492) + lu(517) = lu(517) - lu(105) * lu(492) + lu(528) = - lu(103) * lu(524) + lu(538) = lu(538) - lu(104) * lu(524) + lu(542) = lu(542) - lu(105) * lu(524) + lu(717) = lu(717) - lu(103) * lu(700) + lu(727) = lu(727) - lu(104) * lu(700) + lu(731) = lu(731) - lu(105) * lu(700) + lu(106) = 1._r8 / lu(106) + lu(107) = lu(107) * lu(106) + lu(108) = lu(108) * lu(106) + lu(109) = lu(109) * lu(106) + lu(110) = lu(110) * lu(106) + lu(111) = lu(111) * lu(106) + lu(112) = lu(112) * lu(106) + lu(113) = lu(113) * lu(106) + lu(302) = lu(302) - lu(107) * lu(301) + lu(304) = - lu(108) * lu(301) + lu(307) = lu(307) - lu(109) * lu(301) + lu(311) = lu(311) - lu(110) * lu(301) + lu(314) = lu(314) - lu(111) * lu(301) + lu(316) = - lu(112) * lu(301) + lu(322) = lu(322) - lu(113) * lu(301) + lu(461) = - lu(107) * lu(460) + lu(465) = lu(465) - lu(108) * lu(460) + lu(468) = lu(468) - lu(109) * lu(460) + lu(472) = - lu(110) * lu(460) + lu(475) = lu(475) - lu(111) * lu(460) + lu(477) = lu(477) - lu(112) * lu(460) + lu(484) = lu(484) - lu(113) * lu(460) + lu(709) = lu(709) - lu(107) * lu(701) + lu(715) = - lu(108) * lu(701) + lu(719) = lu(719) - lu(109) * lu(701) + lu(723) = lu(723) - lu(110) * lu(701) + lu(726) = lu(726) - lu(111) * lu(701) + lu(728) = lu(728) - lu(112) * lu(701) + lu(735) = lu(735) - lu(113) * lu(701) + lu(114) = 1._r8 / lu(114) + lu(115) = lu(115) * lu(114) + lu(116) = lu(116) * lu(114) + lu(117) = lu(117) * lu(114) + lu(118) = lu(118) * lu(114) + lu(119) = lu(119) * lu(114) + lu(120) = lu(120) * lu(114) + lu(349) = lu(349) - lu(115) * lu(342) + lu(354) = lu(354) - lu(116) * lu(342) + lu(356) = - lu(117) * lu(342) + lu(358) = lu(358) - lu(118) * lu(342) + lu(360) = lu(360) - lu(119) * lu(342) + lu(362) = - lu(120) * lu(342) + lu(507) = lu(507) - lu(115) * lu(493) + lu(513) = lu(513) - lu(116) * lu(493) + lu(515) = lu(515) - lu(117) * lu(493) + lu(517) = lu(517) - lu(118) * lu(493) + lu(519) = lu(519) - lu(119) * lu(493) + lu(521) = lu(521) - lu(120) * lu(493) + lu(613) = lu(613) - lu(115) * lu(605) + lu(619) = lu(619) - lu(116) * lu(605) + lu(621) = lu(621) - lu(117) * lu(605) + lu(623) = lu(623) - lu(118) * lu(605) + lu(625) = lu(625) - lu(119) * lu(605) + lu(627) = lu(627) - lu(120) * lu(605) + lu(721) = lu(721) - lu(115) * lu(702) + lu(727) = lu(727) - lu(116) * lu(702) + lu(729) = - lu(117) * lu(702) + lu(731) = lu(731) - lu(118) * lu(702) + lu(733) = lu(733) - lu(119) * lu(702) + lu(735) = lu(735) - lu(120) * lu(702) + lu(122) = 1._r8 / lu(122) + lu(123) = lu(123) * lu(122) + lu(124) = lu(124) * lu(122) + lu(125) = lu(125) * lu(122) + lu(126) = lu(126) * lu(122) + lu(127) = lu(127) * lu(122) + lu(128) = lu(128) * lu(122) + lu(129) = lu(129) * lu(122) + lu(130) = lu(130) * lu(122) + lu(131) = lu(131) * lu(122) + lu(176) = - lu(123) * lu(175) + lu(177) = lu(177) - lu(124) * lu(175) + lu(178) = lu(178) - lu(125) * lu(175) + lu(179) = lu(179) - lu(126) * lu(175) + lu(180) = lu(180) - lu(127) * lu(175) + lu(182) = lu(182) - lu(128) * lu(175) + lu(184) = lu(184) - lu(129) * lu(175) + lu(186) = lu(186) - lu(130) * lu(175) + lu(187) = lu(187) - lu(131) * lu(175) + lu(578) = lu(578) - lu(123) * lu(576) + lu(579) = lu(579) - lu(124) * lu(576) + lu(580) = lu(580) - lu(125) * lu(576) + lu(581) = lu(581) - lu(126) * lu(576) + lu(582) = lu(582) - lu(127) * lu(576) + lu(592) = lu(592) - lu(128) * lu(576) + lu(597) = lu(597) - lu(129) * lu(576) + lu(601) = lu(601) - lu(130) * lu(576) + lu(602) = lu(602) - lu(131) * lu(576) + lu(705) = lu(705) - lu(123) * lu(703) + lu(706) = lu(706) - lu(124) * lu(703) + lu(707) = lu(707) - lu(125) * lu(703) + lu(708) = lu(708) - lu(126) * lu(703) + lu(711) = lu(711) - lu(127) * lu(703) + lu(725) = lu(725) - lu(128) * lu(703) + lu(730) = lu(730) - lu(129) * lu(703) + lu(734) = lu(734) - lu(130) * lu(703) + lu(735) = lu(735) - lu(131) * lu(703) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(132) = 1._r8 / lu(132) + lu(133) = lu(133) * lu(132) + lu(134) = lu(134) * lu(132) + lu(135) = lu(135) * lu(132) + lu(136) = lu(136) * lu(132) + lu(137) = lu(137) * lu(132) + lu(138) = lu(138) * lu(132) + lu(258) = lu(258) - lu(133) * lu(256) + lu(259) = lu(259) - lu(134) * lu(256) + lu(264) = lu(264) - lu(135) * lu(256) + lu(267) = lu(267) - lu(136) * lu(256) + lu(269) = lu(269) - lu(137) * lu(256) + lu(271) = lu(271) - lu(138) * lu(256) + lu(416) = lu(416) - lu(133) * lu(414) + lu(417) = lu(417) - lu(134) * lu(414) + lu(423) = lu(423) - lu(135) * lu(414) + lu(426) = lu(426) - lu(136) * lu(414) + lu(429) = lu(429) - lu(137) * lu(414) + lu(434) = lu(434) - lu(138) * lu(414) + lu(502) = lu(502) - lu(133) * lu(494) + lu(503) = lu(503) - lu(134) * lu(494) + lu(510) = lu(510) - lu(135) * lu(494) + lu(513) = lu(513) - lu(136) * lu(494) + lu(516) = lu(516) - lu(137) * lu(494) + lu(521) = lu(521) - lu(138) * lu(494) + lu(584) = lu(584) - lu(133) * lu(577) + lu(585) = lu(585) - lu(134) * lu(577) + lu(591) = lu(591) - lu(135) * lu(577) + lu(594) = - lu(136) * lu(577) + lu(597) = lu(597) - lu(137) * lu(577) + lu(602) = lu(602) - lu(138) * lu(577) + lu(716) = lu(716) - lu(133) * lu(704) + lu(717) = lu(717) - lu(134) * lu(704) + lu(724) = lu(724) - lu(135) * lu(704) + lu(727) = lu(727) - lu(136) * lu(704) + lu(730) = lu(730) - lu(137) * lu(704) + lu(735) = lu(735) - lu(138) * lu(704) + lu(140) = 1._r8 / lu(140) + lu(141) = lu(141) * lu(140) + lu(142) = lu(142) * lu(140) + lu(143) = lu(143) * lu(140) + lu(144) = lu(144) * lu(140) + lu(145) = lu(145) * lu(140) + lu(146) = lu(146) * lu(140) + lu(147) = lu(147) * lu(140) + lu(148) = lu(148) * lu(140) + lu(177) = lu(177) - lu(141) * lu(176) + lu(178) = lu(178) - lu(142) * lu(176) + lu(180) = lu(180) - lu(143) * lu(176) + lu(181) = - lu(144) * lu(176) + lu(183) = - lu(145) * lu(176) + lu(184) = lu(184) - lu(146) * lu(176) + lu(185) = - lu(147) * lu(176) + lu(187) = lu(187) - lu(148) * lu(176) + lu(206) = lu(206) - lu(141) * lu(205) + lu(207) = lu(207) - lu(142) * lu(205) + lu(209) = lu(209) - lu(143) * lu(205) + lu(210) = lu(210) - lu(144) * lu(205) + lu(213) = lu(213) - lu(145) * lu(205) + lu(214) = lu(214) - lu(146) * lu(205) + lu(215) = - lu(147) * lu(205) + lu(217) = lu(217) - lu(148) * lu(205) + lu(579) = lu(579) - lu(141) * lu(578) + lu(580) = lu(580) - lu(142) * lu(578) + lu(582) = lu(582) - lu(143) * lu(578) + lu(585) = lu(585) - lu(144) * lu(578) + lu(594) = lu(594) - lu(145) * lu(578) + lu(597) = lu(597) - lu(146) * lu(578) + lu(598) = lu(598) - lu(147) * lu(578) + lu(602) = lu(602) - lu(148) * lu(578) + lu(706) = lu(706) - lu(141) * lu(705) + lu(707) = lu(707) - lu(142) * lu(705) + lu(711) = lu(711) - lu(143) * lu(705) + lu(717) = lu(717) - lu(144) * lu(705) + lu(727) = lu(727) - lu(145) * lu(705) + lu(730) = lu(730) - lu(146) * lu(705) + lu(731) = lu(731) - lu(147) * lu(705) + lu(735) = lu(735) - lu(148) * lu(705) + lu(150) = 1._r8 / lu(150) + lu(151) = lu(151) * lu(150) + lu(152) = lu(152) * lu(150) + lu(153) = lu(153) * lu(150) + lu(154) = lu(154) * lu(150) + lu(155) = lu(155) * lu(150) + lu(156) = lu(156) * lu(150) + lu(157) = lu(157) * lu(150) + lu(247) = lu(247) - lu(151) * lu(246) + lu(248) = lu(248) - lu(152) * lu(246) + lu(249) = - lu(153) * lu(246) + lu(251) = lu(251) - lu(154) * lu(246) + lu(252) = lu(252) - lu(155) * lu(246) + lu(253) = lu(253) - lu(156) * lu(246) + lu(254) = - lu(157) * lu(246) + lu(325) = - lu(151) * lu(324) + lu(326) = lu(326) - lu(152) * lu(324) + lu(327) = lu(327) - lu(153) * lu(324) + lu(331) = lu(331) - lu(154) * lu(324) + lu(332) = - lu(155) * lu(324) + lu(333) = lu(333) - lu(156) * lu(324) + lu(336) = - lu(157) * lu(324) + lu(501) = lu(501) - lu(151) * lu(495) + lu(503) = lu(503) - lu(152) * lu(495) + lu(506) = lu(506) - lu(153) * lu(495) + lu(513) = lu(513) - lu(154) * lu(495) + lu(514) = lu(514) - lu(155) * lu(495) + lu(515) = lu(515) - lu(156) * lu(495) + lu(518) = lu(518) - lu(157) * lu(495) + lu(552) = - lu(151) * lu(550) + lu(554) = lu(554) - lu(152) * lu(550) + lu(556) = lu(556) - lu(153) * lu(550) + lu(563) = lu(563) - lu(154) * lu(550) + lu(564) = - lu(155) * lu(550) + lu(565) = lu(565) - lu(156) * lu(550) + lu(568) = - lu(157) * lu(550) + lu(676) = - lu(151) * lu(674) + lu(677) = lu(677) - lu(152) * lu(674) + lu(679) = lu(679) - lu(153) * lu(674) + lu(686) = lu(686) - lu(154) * lu(674) + lu(687) = - lu(155) * lu(674) + lu(688) = lu(688) - lu(156) * lu(674) + lu(691) = lu(691) - lu(157) * lu(674) + lu(158) = 1._r8 / lu(158) + lu(159) = lu(159) * lu(158) + lu(160) = lu(160) * lu(158) + lu(161) = lu(161) * lu(158) + lu(162) = lu(162) * lu(158) + lu(163) = lu(163) * lu(158) + lu(164) = lu(164) * lu(158) + lu(165) = lu(165) * lu(158) + lu(178) = lu(178) - lu(159) * lu(177) + lu(179) = lu(179) - lu(160) * lu(177) + lu(180) = lu(180) - lu(161) * lu(177) + lu(182) = lu(182) - lu(162) * lu(177) + lu(184) = lu(184) - lu(163) * lu(177) + lu(186) = lu(186) - lu(164) * lu(177) + lu(187) = lu(187) - lu(165) * lu(177) + lu(207) = lu(207) - lu(159) * lu(206) + lu(208) = lu(208) - lu(160) * lu(206) + lu(209) = lu(209) - lu(161) * lu(206) + lu(211) = lu(211) - lu(162) * lu(206) + lu(214) = lu(214) - lu(163) * lu(206) + lu(216) = - lu(164) * lu(206) + lu(217) = lu(217) - lu(165) * lu(206) + lu(436) = lu(436) - lu(159) * lu(435) + lu(437) = lu(437) - lu(160) * lu(435) + lu(438) = lu(438) - lu(161) * lu(435) + lu(447) = lu(447) - lu(162) * lu(435) + lu(452) = lu(452) - lu(163) * lu(435) + lu(456) = - lu(164) * lu(435) + lu(457) = lu(457) - lu(165) * lu(435) + lu(580) = lu(580) - lu(159) * lu(579) + lu(581) = lu(581) - lu(160) * lu(579) + lu(582) = lu(582) - lu(161) * lu(579) + lu(592) = lu(592) - lu(162) * lu(579) + lu(597) = lu(597) - lu(163) * lu(579) + lu(601) = lu(601) - lu(164) * lu(579) + lu(602) = lu(602) - lu(165) * lu(579) + lu(707) = lu(707) - lu(159) * lu(706) + lu(708) = lu(708) - lu(160) * lu(706) + lu(711) = lu(711) - lu(161) * lu(706) + lu(725) = lu(725) - lu(162) * lu(706) + lu(730) = lu(730) - lu(163) * lu(706) + lu(734) = lu(734) - lu(164) * lu(706) + lu(735) = lu(735) - lu(165) * lu(706) + lu(167) = 1._r8 / lu(167) + lu(168) = lu(168) * lu(167) + lu(169) = lu(169) * lu(167) + lu(170) = lu(170) * lu(167) + lu(171) = lu(171) * lu(167) + lu(172) = lu(172) * lu(167) + lu(173) = lu(173) * lu(167) + lu(179) = lu(179) - lu(168) * lu(178) + lu(180) = lu(180) - lu(169) * lu(178) + lu(182) = lu(182) - lu(170) * lu(178) + lu(184) = lu(184) - lu(171) * lu(178) + lu(186) = lu(186) - lu(172) * lu(178) + lu(187) = lu(187) - lu(173) * lu(178) + lu(208) = lu(208) - lu(168) * lu(207) + lu(209) = lu(209) - lu(169) * lu(207) + lu(211) = lu(211) - lu(170) * lu(207) + lu(214) = lu(214) - lu(171) * lu(207) + lu(216) = lu(216) - lu(172) * lu(207) + lu(217) = lu(217) - lu(173) * lu(207) + lu(437) = lu(437) - lu(168) * lu(436) + lu(438) = lu(438) - lu(169) * lu(436) + lu(447) = lu(447) - lu(170) * lu(436) + lu(452) = lu(452) - lu(171) * lu(436) + lu(456) = lu(456) - lu(172) * lu(436) + lu(457) = lu(457) - lu(173) * lu(436) + lu(581) = lu(581) - lu(168) * lu(580) + lu(582) = lu(582) - lu(169) * lu(580) + lu(592) = lu(592) - lu(170) * lu(580) + lu(597) = lu(597) - lu(171) * lu(580) + lu(601) = lu(601) - lu(172) * lu(580) + lu(602) = lu(602) - lu(173) * lu(580) + lu(708) = lu(708) - lu(168) * lu(707) + lu(711) = lu(711) - lu(169) * lu(707) + lu(725) = lu(725) - lu(170) * lu(707) + lu(730) = lu(730) - lu(171) * lu(707) + lu(734) = lu(734) - lu(172) * lu(707) + lu(735) = lu(735) - lu(173) * lu(707) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(179) = 1._r8 / lu(179) + lu(180) = lu(180) * lu(179) + lu(181) = lu(181) * lu(179) + lu(182) = lu(182) * lu(179) + lu(183) = lu(183) * lu(179) + lu(184) = lu(184) * lu(179) + lu(185) = lu(185) * lu(179) + lu(186) = lu(186) * lu(179) + lu(187) = lu(187) * lu(179) + lu(209) = lu(209) - lu(180) * lu(208) + lu(210) = lu(210) - lu(181) * lu(208) + lu(211) = lu(211) - lu(182) * lu(208) + lu(213) = lu(213) - lu(183) * lu(208) + lu(214) = lu(214) - lu(184) * lu(208) + lu(215) = lu(215) - lu(185) * lu(208) + lu(216) = lu(216) - lu(186) * lu(208) + lu(217) = lu(217) - lu(187) * lu(208) + lu(438) = lu(438) - lu(180) * lu(437) + lu(439) = - lu(181) * lu(437) + lu(447) = lu(447) - lu(182) * lu(437) + lu(449) = lu(449) - lu(183) * lu(437) + lu(452) = lu(452) - lu(184) * lu(437) + lu(453) = lu(453) - lu(185) * lu(437) + lu(456) = lu(456) - lu(186) * lu(437) + lu(457) = lu(457) - lu(187) * lu(437) + lu(582) = lu(582) - lu(180) * lu(581) + lu(585) = lu(585) - lu(181) * lu(581) + lu(592) = lu(592) - lu(182) * lu(581) + lu(594) = lu(594) - lu(183) * lu(581) + lu(597) = lu(597) - lu(184) * lu(581) + lu(598) = lu(598) - lu(185) * lu(581) + lu(601) = lu(601) - lu(186) * lu(581) + lu(602) = lu(602) - lu(187) * lu(581) + lu(711) = lu(711) - lu(180) * lu(708) + lu(717) = lu(717) - lu(181) * lu(708) + lu(725) = lu(725) - lu(182) * lu(708) + lu(727) = lu(727) - lu(183) * lu(708) + lu(730) = lu(730) - lu(184) * lu(708) + lu(731) = lu(731) - lu(185) * lu(708) + lu(734) = lu(734) - lu(186) * lu(708) + lu(735) = lu(735) - lu(187) * lu(708) + lu(189) = 1._r8 / lu(189) + lu(190) = lu(190) * lu(189) + lu(191) = lu(191) * lu(189) + lu(192) = lu(192) * lu(189) + lu(193) = lu(193) * lu(189) + lu(194) = lu(194) * lu(189) + lu(195) = lu(195) * lu(189) + lu(196) = lu(196) * lu(189) + lu(307) = lu(307) - lu(190) * lu(302) + lu(309) = lu(309) - lu(191) * lu(302) + lu(311) = lu(311) - lu(192) * lu(302) + lu(315) = lu(315) - lu(193) * lu(302) + lu(317) = - lu(194) * lu(302) + lu(321) = - lu(195) * lu(302) + lu(322) = lu(322) - lu(196) * lu(302) + lu(468) = lu(468) - lu(190) * lu(461) + lu(470) = - lu(191) * lu(461) + lu(472) = lu(472) - lu(192) * lu(461) + lu(476) = lu(476) - lu(193) * lu(461) + lu(478) = lu(478) - lu(194) * lu(461) + lu(482) = - lu(195) * lu(461) + lu(484) = lu(484) - lu(196) * lu(461) + lu(611) = lu(611) - lu(190) * lu(606) + lu(613) = lu(613) - lu(191) * lu(606) + lu(615) = lu(615) - lu(192) * lu(606) + lu(619) = lu(619) - lu(193) * lu(606) + lu(621) = lu(621) - lu(194) * lu(606) + lu(625) = lu(625) - lu(195) * lu(606) + lu(627) = lu(627) - lu(196) * lu(606) + lu(654) = - lu(190) * lu(649) + lu(656) = lu(656) - lu(191) * lu(649) + lu(658) = lu(658) - lu(192) * lu(649) + lu(662) = lu(662) - lu(193) * lu(649) + lu(664) = lu(664) - lu(194) * lu(649) + lu(668) = lu(668) - lu(195) * lu(649) + lu(670) = lu(670) - lu(196) * lu(649) + lu(719) = lu(719) - lu(190) * lu(709) + lu(721) = lu(721) - lu(191) * lu(709) + lu(723) = lu(723) - lu(192) * lu(709) + lu(727) = lu(727) - lu(193) * lu(709) + lu(729) = lu(729) - lu(194) * lu(709) + lu(733) = lu(733) - lu(195) * lu(709) + lu(735) = lu(735) - lu(196) * lu(709) + lu(197) = 1._r8 / lu(197) + lu(198) = lu(198) * lu(197) + lu(199) = lu(199) * lu(197) + lu(200) = lu(200) * lu(197) + lu(201) = lu(201) * lu(197) + lu(202) = lu(202) * lu(197) + lu(203) = lu(203) * lu(197) + lu(283) = lu(283) - lu(198) * lu(281) + lu(287) = lu(287) - lu(199) * lu(281) + lu(290) = lu(290) - lu(200) * lu(281) + lu(292) = lu(292) - lu(201) * lu(281) + lu(297) = - lu(202) * lu(281) + lu(298) = lu(298) - lu(203) * lu(281) + lu(393) = lu(393) - lu(198) * lu(392) + lu(399) = lu(399) - lu(199) * lu(392) + lu(403) = lu(403) - lu(200) * lu(392) + lu(405) = - lu(201) * lu(392) + lu(410) = - lu(202) * lu(392) + lu(411) = - lu(203) * lu(392) + lu(503) = lu(503) - lu(198) * lu(496) + lu(509) = lu(509) - lu(199) * lu(496) + lu(513) = lu(513) - lu(200) * lu(496) + lu(515) = lu(515) - lu(201) * lu(496) + lu(520) = lu(520) - lu(202) * lu(496) + lu(521) = lu(521) - lu(203) * lu(496) + lu(609) = lu(609) - lu(198) * lu(607) + lu(615) = lu(615) - lu(199) * lu(607) + lu(619) = lu(619) - lu(200) * lu(607) + lu(621) = lu(621) - lu(201) * lu(607) + lu(626) = - lu(202) * lu(607) + lu(627) = lu(627) - lu(203) * lu(607) + lu(677) = lu(677) - lu(198) * lu(675) + lu(682) = lu(682) - lu(199) * lu(675) + lu(686) = lu(686) - lu(200) * lu(675) + lu(688) = lu(688) - lu(201) * lu(675) + lu(693) = lu(693) - lu(202) * lu(675) + lu(694) = lu(694) - lu(203) * lu(675) + lu(717) = lu(717) - lu(198) * lu(710) + lu(723) = lu(723) - lu(199) * lu(710) + lu(727) = lu(727) - lu(200) * lu(710) + lu(729) = lu(729) - lu(201) * lu(710) + lu(734) = lu(734) - lu(202) * lu(710) + lu(735) = lu(735) - lu(203) * lu(710) + lu(209) = 1._r8 / lu(209) + lu(210) = lu(210) * lu(209) + lu(211) = lu(211) * lu(209) + lu(212) = lu(212) * lu(209) + lu(213) = lu(213) * lu(209) + lu(214) = lu(214) * lu(209) + lu(215) = lu(215) * lu(209) + lu(216) = lu(216) * lu(209) + lu(217) = lu(217) * lu(209) + lu(439) = lu(439) - lu(210) * lu(438) + lu(447) = lu(447) - lu(211) * lu(438) + lu(448) = lu(448) - lu(212) * lu(438) + lu(449) = lu(449) - lu(213) * lu(438) + lu(452) = lu(452) - lu(214) * lu(438) + lu(453) = lu(453) - lu(215) * lu(438) + lu(456) = lu(456) - lu(216) * lu(438) + lu(457) = lu(457) - lu(217) * lu(438) + lu(467) = - lu(210) * lu(462) + lu(474) = lu(474) - lu(211) * lu(462) + lu(475) = lu(475) - lu(212) * lu(462) + lu(476) = lu(476) - lu(213) * lu(462) + lu(479) = lu(479) - lu(214) * lu(462) + lu(480) = lu(480) - lu(215) * lu(462) + lu(483) = - lu(216) * lu(462) + lu(484) = lu(484) - lu(217) * lu(462) + lu(503) = lu(503) - lu(210) * lu(497) + lu(511) = lu(511) - lu(211) * lu(497) + lu(512) = lu(512) - lu(212) * lu(497) + lu(513) = lu(513) - lu(213) * lu(497) + lu(516) = lu(516) - lu(214) * lu(497) + lu(517) = lu(517) - lu(215) * lu(497) + lu(520) = lu(520) - lu(216) * lu(497) + lu(521) = lu(521) - lu(217) * lu(497) + lu(585) = lu(585) - lu(210) * lu(582) + lu(592) = lu(592) - lu(211) * lu(582) + lu(593) = - lu(212) * lu(582) + lu(594) = lu(594) - lu(213) * lu(582) + lu(597) = lu(597) - lu(214) * lu(582) + lu(598) = lu(598) - lu(215) * lu(582) + lu(601) = lu(601) - lu(216) * lu(582) + lu(602) = lu(602) - lu(217) * lu(582) + lu(717) = lu(717) - lu(210) * lu(711) + lu(725) = lu(725) - lu(211) * lu(711) + lu(726) = lu(726) - lu(212) * lu(711) + lu(727) = lu(727) - lu(213) * lu(711) + lu(730) = lu(730) - lu(214) * lu(711) + lu(731) = lu(731) - lu(215) * lu(711) + lu(734) = lu(734) - lu(216) * lu(711) + lu(735) = lu(735) - lu(217) * lu(711) + lu(219) = 1._r8 / lu(219) + lu(220) = lu(220) * lu(219) + lu(221) = lu(221) * lu(219) + lu(222) = lu(222) * lu(219) + lu(223) = lu(223) * lu(219) + lu(224) = lu(224) * lu(219) + lu(225) = lu(225) * lu(219) + lu(237) = lu(237) - lu(220) * lu(234) + lu(238) = lu(238) - lu(221) * lu(234) + lu(240) = lu(240) - lu(222) * lu(234) + lu(242) = - lu(223) * lu(234) + lu(243) = lu(243) - lu(224) * lu(234) + lu(244) = lu(244) - lu(225) * lu(234) + lu(349) = lu(349) - lu(220) * lu(343) + lu(350) = lu(350) - lu(221) * lu(343) + lu(354) = lu(354) - lu(222) * lu(343) + lu(356) = lu(356) - lu(223) * lu(343) + lu(360) = lu(360) - lu(224) * lu(343) + lu(362) = lu(362) - lu(225) * lu(343) + lu(376) = lu(376) - lu(220) * lu(367) + lu(377) = lu(377) - lu(221) * lu(367) + lu(382) = lu(382) - lu(222) * lu(367) + lu(384) = - lu(223) * lu(367) + lu(388) = lu(388) - lu(224) * lu(367) + lu(390) = lu(390) - lu(225) * lu(367) + lu(507) = lu(507) - lu(220) * lu(498) + lu(508) = lu(508) - lu(221) * lu(498) + lu(513) = lu(513) - lu(222) * lu(498) + lu(515) = lu(515) - lu(223) * lu(498) + lu(519) = lu(519) - lu(224) * lu(498) + lu(521) = lu(521) - lu(225) * lu(498) + lu(613) = lu(613) - lu(220) * lu(608) + lu(614) = lu(614) - lu(221) * lu(608) + lu(619) = lu(619) - lu(222) * lu(608) + lu(621) = lu(621) - lu(223) * lu(608) + lu(625) = lu(625) - lu(224) * lu(608) + lu(627) = lu(627) - lu(225) * lu(608) + lu(656) = lu(656) - lu(220) * lu(650) + lu(657) = - lu(221) * lu(650) + lu(662) = lu(662) - lu(222) * lu(650) + lu(664) = lu(664) - lu(223) * lu(650) + lu(668) = lu(668) - lu(224) * lu(650) + lu(670) = lu(670) - lu(225) * lu(650) + lu(721) = lu(721) - lu(220) * lu(712) + lu(722) = lu(722) - lu(221) * lu(712) + lu(727) = lu(727) - lu(222) * lu(712) + lu(729) = lu(729) - lu(223) * lu(712) + lu(733) = lu(733) - lu(224) * lu(712) + lu(735) = lu(735) - lu(225) * lu(712) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(227) = 1._r8 / lu(227) + lu(228) = lu(228) * lu(227) + lu(229) = lu(229) * lu(227) + lu(230) = lu(230) * lu(227) + lu(231) = lu(231) * lu(227) + lu(232) = lu(232) * lu(227) + lu(258) = lu(258) - lu(228) * lu(257) + lu(267) = lu(267) - lu(229) * lu(257) + lu(268) = - lu(230) * lu(257) + lu(270) = - lu(231) * lu(257) + lu(271) = lu(271) - lu(232) * lu(257) + lu(305) = lu(305) - lu(228) * lu(303) + lu(315) = lu(315) - lu(229) * lu(303) + lu(317) = lu(317) - lu(230) * lu(303) + lu(319) = lu(319) - lu(231) * lu(303) + lu(322) = lu(322) - lu(232) * lu(303) + lu(371) = lu(371) - lu(228) * lu(368) + lu(382) = lu(382) - lu(229) * lu(368) + lu(384) = lu(384) - lu(230) * lu(368) + lu(386) = lu(386) - lu(231) * lu(368) + lu(390) = lu(390) - lu(232) * lu(368) + lu(416) = lu(416) - lu(228) * lu(415) + lu(426) = lu(426) - lu(229) * lu(415) + lu(428) = - lu(230) * lu(415) + lu(430) = lu(430) - lu(231) * lu(415) + lu(434) = lu(434) - lu(232) * lu(415) + lu(466) = lu(466) - lu(228) * lu(463) + lu(476) = lu(476) - lu(229) * lu(463) + lu(478) = lu(478) - lu(230) * lu(463) + lu(480) = lu(480) - lu(231) * lu(463) + lu(484) = lu(484) - lu(232) * lu(463) + lu(502) = lu(502) - lu(228) * lu(499) + lu(513) = lu(513) - lu(229) * lu(499) + lu(515) = lu(515) - lu(230) * lu(499) + lu(517) = lu(517) - lu(231) * lu(499) + lu(521) = lu(521) - lu(232) * lu(499) + lu(527) = - lu(228) * lu(525) + lu(538) = lu(538) - lu(229) * lu(525) + lu(540) = - lu(230) * lu(525) + lu(542) = lu(542) - lu(231) * lu(525) + lu(546) = lu(546) - lu(232) * lu(525) + lu(553) = - lu(228) * lu(551) + lu(563) = lu(563) - lu(229) * lu(551) + lu(565) = lu(565) - lu(230) * lu(551) + lu(567) = - lu(231) * lu(551) + lu(571) = lu(571) - lu(232) * lu(551) + lu(584) = lu(584) - lu(228) * lu(583) + lu(594) = lu(594) - lu(229) * lu(583) + lu(596) = - lu(230) * lu(583) + lu(598) = lu(598) - lu(231) * lu(583) + lu(602) = lu(602) - lu(232) * lu(583) + lu(716) = lu(716) - lu(228) * lu(713) + lu(727) = lu(727) - lu(229) * lu(713) + lu(729) = lu(729) - lu(230) * lu(713) + lu(731) = lu(731) - lu(231) * lu(713) + lu(735) = lu(735) - lu(232) * lu(713) + lu(235) = 1._r8 / lu(235) + lu(236) = lu(236) * lu(235) + lu(237) = lu(237) * lu(235) + lu(238) = lu(238) * lu(235) + lu(239) = lu(239) * lu(235) + lu(240) = lu(240) * lu(235) + lu(241) = lu(241) * lu(235) + lu(242) = lu(242) * lu(235) + lu(243) = lu(243) * lu(235) + lu(244) = lu(244) * lu(235) + lu(345) = - lu(236) * lu(344) + lu(349) = lu(349) - lu(237) * lu(344) + lu(350) = lu(350) - lu(238) * lu(344) + lu(353) = - lu(239) * lu(344) + lu(354) = lu(354) - lu(240) * lu(344) + lu(355) = lu(355) - lu(241) * lu(344) + lu(356) = lu(356) - lu(242) * lu(344) + lu(360) = lu(360) - lu(243) * lu(344) + lu(362) = lu(362) - lu(244) * lu(344) + lu(370) = - lu(236) * lu(369) + lu(376) = lu(376) - lu(237) * lu(369) + lu(377) = lu(377) - lu(238) * lu(369) + lu(381) = lu(381) - lu(239) * lu(369) + lu(382) = lu(382) - lu(240) * lu(369) + lu(383) = - lu(241) * lu(369) + lu(384) = lu(384) - lu(242) * lu(369) + lu(388) = lu(388) - lu(243) * lu(369) + lu(390) = lu(390) - lu(244) * lu(369) + lu(465) = lu(465) - lu(236) * lu(464) + lu(470) = lu(470) - lu(237) * lu(464) + lu(471) = lu(471) - lu(238) * lu(464) + lu(475) = lu(475) - lu(239) * lu(464) + lu(476) = lu(476) - lu(240) * lu(464) + lu(477) = lu(477) - lu(241) * lu(464) + lu(478) = lu(478) - lu(242) * lu(464) + lu(482) = lu(482) - lu(243) * lu(464) + lu(484) = lu(484) - lu(244) * lu(464) + lu(501) = lu(501) - lu(236) * lu(500) + lu(507) = lu(507) - lu(237) * lu(500) + lu(508) = lu(508) - lu(238) * lu(500) + lu(512) = lu(512) - lu(239) * lu(500) + lu(513) = lu(513) - lu(240) * lu(500) + lu(514) = lu(514) - lu(241) * lu(500) + lu(515) = lu(515) - lu(242) * lu(500) + lu(519) = lu(519) - lu(243) * lu(500) + lu(521) = lu(521) - lu(244) * lu(500) + lu(652) = lu(652) - lu(236) * lu(651) + lu(656) = lu(656) - lu(237) * lu(651) + lu(657) = lu(657) - lu(238) * lu(651) + lu(661) = - lu(239) * lu(651) + lu(662) = lu(662) - lu(240) * lu(651) + lu(663) = - lu(241) * lu(651) + lu(664) = lu(664) - lu(242) * lu(651) + lu(668) = lu(668) - lu(243) * lu(651) + lu(670) = lu(670) - lu(244) * lu(651) + lu(715) = lu(715) - lu(236) * lu(714) + lu(721) = lu(721) - lu(237) * lu(714) + lu(722) = lu(722) - lu(238) * lu(714) + lu(726) = lu(726) - lu(239) * lu(714) + lu(727) = lu(727) - lu(240) * lu(714) + lu(728) = lu(728) - lu(241) * lu(714) + lu(729) = lu(729) - lu(242) * lu(714) + lu(733) = lu(733) - lu(243) * lu(714) + lu(735) = lu(735) - lu(244) * lu(714) + lu(247) = 1._r8 / lu(247) + lu(248) = lu(248) * lu(247) + lu(249) = lu(249) * lu(247) + lu(250) = lu(250) * lu(247) + lu(251) = lu(251) * lu(247) + lu(252) = lu(252) * lu(247) + lu(253) = lu(253) * lu(247) + lu(254) = lu(254) * lu(247) + lu(283) = lu(283) - lu(248) * lu(282) + lu(285) = lu(285) - lu(249) * lu(282) + lu(289) = - lu(250) * lu(282) + lu(290) = lu(290) - lu(251) * lu(282) + lu(291) = lu(291) - lu(252) * lu(282) + lu(292) = lu(292) - lu(253) * lu(282) + lu(295) = - lu(254) * lu(282) + lu(306) = - lu(248) * lu(304) + lu(308) = - lu(249) * lu(304) + lu(314) = lu(314) - lu(250) * lu(304) + lu(315) = lu(315) - lu(251) * lu(304) + lu(316) = lu(316) - lu(252) * lu(304) + lu(317) = lu(317) - lu(253) * lu(304) + lu(320) = - lu(254) * lu(304) + lu(326) = lu(326) - lu(248) * lu(325) + lu(327) = lu(327) - lu(249) * lu(325) + lu(330) = - lu(250) * lu(325) + lu(331) = lu(331) - lu(251) * lu(325) + lu(332) = lu(332) - lu(252) * lu(325) + lu(333) = lu(333) - lu(253) * lu(325) + lu(336) = lu(336) - lu(254) * lu(325) + lu(346) = lu(346) - lu(248) * lu(345) + lu(348) = lu(348) - lu(249) * lu(345) + lu(353) = lu(353) - lu(250) * lu(345) + lu(354) = lu(354) - lu(251) * lu(345) + lu(355) = lu(355) - lu(252) * lu(345) + lu(356) = lu(356) - lu(253) * lu(345) + lu(359) = lu(359) - lu(254) * lu(345) + lu(372) = - lu(248) * lu(370) + lu(375) = - lu(249) * lu(370) + lu(381) = lu(381) - lu(250) * lu(370) + lu(382) = lu(382) - lu(251) * lu(370) + lu(383) = lu(383) - lu(252) * lu(370) + lu(384) = lu(384) - lu(253) * lu(370) + lu(387) = lu(387) - lu(254) * lu(370) + lu(467) = lu(467) - lu(248) * lu(465) + lu(469) = - lu(249) * lu(465) + lu(475) = lu(475) - lu(250) * lu(465) + lu(476) = lu(476) - lu(251) * lu(465) + lu(477) = lu(477) - lu(252) * lu(465) + lu(478) = lu(478) - lu(253) * lu(465) + lu(481) = - lu(254) * lu(465) + lu(503) = lu(503) - lu(248) * lu(501) + lu(506) = lu(506) - lu(249) * lu(501) + lu(512) = lu(512) - lu(250) * lu(501) + lu(513) = lu(513) - lu(251) * lu(501) + lu(514) = lu(514) - lu(252) * lu(501) + lu(515) = lu(515) - lu(253) * lu(501) + lu(518) = lu(518) - lu(254) * lu(501) + lu(528) = lu(528) - lu(248) * lu(526) + lu(531) = - lu(249) * lu(526) + lu(537) = lu(537) - lu(250) * lu(526) + lu(538) = lu(538) - lu(251) * lu(526) + lu(539) = lu(539) - lu(252) * lu(526) + lu(540) = lu(540) - lu(253) * lu(526) + lu(543) = - lu(254) * lu(526) + lu(554) = lu(554) - lu(248) * lu(552) + lu(556) = lu(556) - lu(249) * lu(552) + lu(562) = - lu(250) * lu(552) + lu(563) = lu(563) - lu(251) * lu(552) + lu(564) = lu(564) - lu(252) * lu(552) + lu(565) = lu(565) - lu(253) * lu(552) + lu(568) = lu(568) - lu(254) * lu(552) + lu(653) = lu(653) - lu(248) * lu(652) + lu(655) = - lu(249) * lu(652) + lu(661) = lu(661) - lu(250) * lu(652) + lu(662) = lu(662) - lu(251) * lu(652) + lu(663) = lu(663) - lu(252) * lu(652) + lu(664) = lu(664) - lu(253) * lu(652) + lu(667) = - lu(254) * lu(652) + lu(677) = lu(677) - lu(248) * lu(676) + lu(679) = lu(679) - lu(249) * lu(676) + lu(685) = - lu(250) * lu(676) + lu(686) = lu(686) - lu(251) * lu(676) + lu(687) = lu(687) - lu(252) * lu(676) + lu(688) = lu(688) - lu(253) * lu(676) + lu(691) = lu(691) - lu(254) * lu(676) + lu(717) = lu(717) - lu(248) * lu(715) + lu(720) = lu(720) - lu(249) * lu(715) + lu(726) = lu(726) - lu(250) * lu(715) + lu(727) = lu(727) - lu(251) * lu(715) + lu(728) = lu(728) - lu(252) * lu(715) + lu(729) = lu(729) - lu(253) * lu(715) + lu(732) = - lu(254) * lu(715) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(258) = 1._r8 / lu(258) + lu(259) = lu(259) * lu(258) + lu(260) = lu(260) * lu(258) + lu(261) = lu(261) * lu(258) + lu(262) = lu(262) * lu(258) + lu(263) = lu(263) * lu(258) + lu(264) = lu(264) * lu(258) + lu(265) = lu(265) * lu(258) + lu(266) = lu(266) * lu(258) + lu(267) = lu(267) * lu(258) + lu(268) = lu(268) * lu(258) + lu(269) = lu(269) * lu(258) + lu(270) = lu(270) * lu(258) + lu(271) = lu(271) * lu(258) + lu(306) = lu(306) - lu(259) * lu(305) + lu(307) = lu(307) - lu(260) * lu(305) + lu(309) = lu(309) - lu(261) * lu(305) + lu(310) = lu(310) - lu(262) * lu(305) + lu(311) = lu(311) - lu(263) * lu(305) + lu(312) = - lu(264) * lu(305) + lu(313) = lu(313) - lu(265) * lu(305) + lu(314) = lu(314) - lu(266) * lu(305) + lu(315) = lu(315) - lu(267) * lu(305) + lu(317) = lu(317) - lu(268) * lu(305) + lu(318) = lu(318) - lu(269) * lu(305) + lu(319) = lu(319) - lu(270) * lu(305) + lu(322) = lu(322) - lu(271) * lu(305) + lu(372) = lu(372) - lu(259) * lu(371) + lu(374) = lu(374) - lu(260) * lu(371) + lu(376) = lu(376) - lu(261) * lu(371) + lu(377) = lu(377) - lu(262) * lu(371) + lu(378) = lu(378) - lu(263) * lu(371) + lu(379) = - lu(264) * lu(371) + lu(380) = lu(380) - lu(265) * lu(371) + lu(381) = lu(381) - lu(266) * lu(371) + lu(382) = lu(382) - lu(267) * lu(371) + lu(384) = lu(384) - lu(268) * lu(371) + lu(385) = lu(385) - lu(269) * lu(371) + lu(386) = lu(386) - lu(270) * lu(371) + lu(390) = lu(390) - lu(271) * lu(371) + lu(417) = lu(417) - lu(259) * lu(416) + lu(418) = lu(418) - lu(260) * lu(416) + lu(420) = lu(420) - lu(261) * lu(416) + lu(421) = lu(421) - lu(262) * lu(416) + lu(422) = lu(422) - lu(263) * lu(416) + lu(423) = lu(423) - lu(264) * lu(416) + lu(424) = lu(424) - lu(265) * lu(416) + lu(425) = lu(425) - lu(266) * lu(416) + lu(426) = lu(426) - lu(267) * lu(416) + lu(428) = lu(428) - lu(268) * lu(416) + lu(429) = lu(429) - lu(269) * lu(416) + lu(430) = lu(430) - lu(270) * lu(416) + lu(434) = lu(434) - lu(271) * lu(416) + lu(467) = lu(467) - lu(259) * lu(466) + lu(468) = lu(468) - lu(260) * lu(466) + lu(470) = lu(470) - lu(261) * lu(466) + lu(471) = lu(471) - lu(262) * lu(466) + lu(472) = lu(472) - lu(263) * lu(466) + lu(473) = lu(473) - lu(264) * lu(466) + lu(474) = lu(474) - lu(265) * lu(466) + lu(475) = lu(475) - lu(266) * lu(466) + lu(476) = lu(476) - lu(267) * lu(466) + lu(478) = lu(478) - lu(268) * lu(466) + lu(479) = lu(479) - lu(269) * lu(466) + lu(480) = lu(480) - lu(270) * lu(466) + lu(484) = lu(484) - lu(271) * lu(466) + lu(503) = lu(503) - lu(259) * lu(502) + lu(505) = lu(505) - lu(260) * lu(502) + lu(507) = lu(507) - lu(261) * lu(502) + lu(508) = lu(508) - lu(262) * lu(502) + lu(509) = lu(509) - lu(263) * lu(502) + lu(510) = lu(510) - lu(264) * lu(502) + lu(511) = lu(511) - lu(265) * lu(502) + lu(512) = lu(512) - lu(266) * lu(502) + lu(513) = lu(513) - lu(267) * lu(502) + lu(515) = lu(515) - lu(268) * lu(502) + lu(516) = lu(516) - lu(269) * lu(502) + lu(517) = lu(517) - lu(270) * lu(502) + lu(521) = lu(521) - lu(271) * lu(502) + lu(528) = lu(528) - lu(259) * lu(527) + lu(530) = - lu(260) * lu(527) + lu(532) = - lu(261) * lu(527) + lu(533) = - lu(262) * lu(527) + lu(534) = - lu(263) * lu(527) + lu(535) = - lu(264) * lu(527) + lu(536) = lu(536) - lu(265) * lu(527) + lu(537) = lu(537) - lu(266) * lu(527) + lu(538) = lu(538) - lu(267) * lu(527) + lu(540) = lu(540) - lu(268) * lu(527) + lu(541) = lu(541) - lu(269) * lu(527) + lu(542) = lu(542) - lu(270) * lu(527) + lu(546) = lu(546) - lu(271) * lu(527) + lu(554) = lu(554) - lu(259) * lu(553) + lu(555) = - lu(260) * lu(553) + lu(557) = - lu(261) * lu(553) + lu(558) = - lu(262) * lu(553) + lu(559) = - lu(263) * lu(553) + lu(560) = - lu(264) * lu(553) + lu(561) = - lu(265) * lu(553) + lu(562) = lu(562) - lu(266) * lu(553) + lu(563) = lu(563) - lu(267) * lu(553) + lu(565) = lu(565) - lu(268) * lu(553) + lu(566) = - lu(269) * lu(553) + lu(567) = lu(567) - lu(270) * lu(553) + lu(571) = lu(571) - lu(271) * lu(553) + lu(585) = lu(585) - lu(259) * lu(584) + lu(586) = - lu(260) * lu(584) + lu(588) = - lu(261) * lu(584) + lu(589) = - lu(262) * lu(584) + lu(590) = - lu(263) * lu(584) + lu(591) = lu(591) - lu(264) * lu(584) + lu(592) = lu(592) - lu(265) * lu(584) + lu(593) = lu(593) - lu(266) * lu(584) + lu(594) = lu(594) - lu(267) * lu(584) + lu(596) = lu(596) - lu(268) * lu(584) + lu(597) = lu(597) - lu(269) * lu(584) + lu(598) = lu(598) - lu(270) * lu(584) + lu(602) = lu(602) - lu(271) * lu(584) + lu(717) = lu(717) - lu(259) * lu(716) + lu(719) = lu(719) - lu(260) * lu(716) + lu(721) = lu(721) - lu(261) * lu(716) + lu(722) = lu(722) - lu(262) * lu(716) + lu(723) = lu(723) - lu(263) * lu(716) + lu(724) = lu(724) - lu(264) * lu(716) + lu(725) = lu(725) - lu(265) * lu(716) + lu(726) = lu(726) - lu(266) * lu(716) + lu(727) = lu(727) - lu(267) * lu(716) + lu(729) = lu(729) - lu(268) * lu(716) + lu(730) = lu(730) - lu(269) * lu(716) + lu(731) = lu(731) - lu(270) * lu(716) + lu(735) = lu(735) - lu(271) * lu(716) + lu(272) = 1._r8 / lu(272) + lu(273) = lu(273) * lu(272) + lu(274) = lu(274) * lu(272) + lu(275) = lu(275) * lu(272) + lu(276) = lu(276) * lu(272) + lu(277) = lu(277) * lu(272) + lu(278) = lu(278) * lu(272) + lu(279) = lu(279) * lu(272) + lu(285) = lu(285) - lu(273) * lu(283) + lu(288) = - lu(274) * lu(283) + lu(290) = lu(290) - lu(275) * lu(283) + lu(292) = lu(292) - lu(276) * lu(283) + lu(293) = - lu(277) * lu(283) + lu(294) = lu(294) - lu(278) * lu(283) + lu(298) = lu(298) - lu(279) * lu(283) + lu(308) = lu(308) - lu(273) * lu(306) + lu(312) = lu(312) - lu(274) * lu(306) + lu(315) = lu(315) - lu(275) * lu(306) + lu(317) = lu(317) - lu(276) * lu(306) + lu(318) = lu(318) - lu(277) * lu(306) + lu(319) = lu(319) - lu(278) * lu(306) + lu(322) = lu(322) - lu(279) * lu(306) + lu(327) = lu(327) - lu(273) * lu(326) + lu(329) = - lu(274) * lu(326) + lu(331) = lu(331) - lu(275) * lu(326) + lu(333) = lu(333) - lu(276) * lu(326) + lu(334) = - lu(277) * lu(326) + lu(335) = - lu(278) * lu(326) + lu(339) = lu(339) - lu(279) * lu(326) + lu(348) = lu(348) - lu(273) * lu(346) + lu(352) = lu(352) - lu(274) * lu(346) + lu(354) = lu(354) - lu(275) * lu(346) + lu(356) = lu(356) - lu(276) * lu(346) + lu(357) = lu(357) - lu(277) * lu(346) + lu(358) = lu(358) - lu(278) * lu(346) + lu(362) = lu(362) - lu(279) * lu(346) + lu(375) = lu(375) - lu(273) * lu(372) + lu(379) = lu(379) - lu(274) * lu(372) + lu(382) = lu(382) - lu(275) * lu(372) + lu(384) = lu(384) - lu(276) * lu(372) + lu(385) = lu(385) - lu(277) * lu(372) + lu(386) = lu(386) - lu(278) * lu(372) + lu(390) = lu(390) - lu(279) * lu(372) + lu(396) = - lu(273) * lu(393) + lu(400) = lu(400) - lu(274) * lu(393) + lu(403) = lu(403) - lu(275) * lu(393) + lu(405) = lu(405) - lu(276) * lu(393) + lu(406) = lu(406) - lu(277) * lu(393) + lu(407) = lu(407) - lu(278) * lu(393) + lu(411) = lu(411) - lu(279) * lu(393) + lu(419) = - lu(273) * lu(417) + lu(423) = lu(423) - lu(274) * lu(417) + lu(426) = lu(426) - lu(275) * lu(417) + lu(428) = lu(428) - lu(276) * lu(417) + lu(429) = lu(429) - lu(277) * lu(417) + lu(430) = lu(430) - lu(278) * lu(417) + lu(434) = lu(434) - lu(279) * lu(417) + lu(442) = - lu(273) * lu(439) + lu(446) = lu(446) - lu(274) * lu(439) + lu(449) = lu(449) - lu(275) * lu(439) + lu(451) = - lu(276) * lu(439) + lu(452) = lu(452) - lu(277) * lu(439) + lu(453) = lu(453) - lu(278) * lu(439) + lu(457) = lu(457) - lu(279) * lu(439) + lu(469) = lu(469) - lu(273) * lu(467) + lu(473) = lu(473) - lu(274) * lu(467) + lu(476) = lu(476) - lu(275) * lu(467) + lu(478) = lu(478) - lu(276) * lu(467) + lu(479) = lu(479) - lu(277) * lu(467) + lu(480) = lu(480) - lu(278) * lu(467) + lu(484) = lu(484) - lu(279) * lu(467) + lu(506) = lu(506) - lu(273) * lu(503) + lu(510) = lu(510) - lu(274) * lu(503) + lu(513) = lu(513) - lu(275) * lu(503) + lu(515) = lu(515) - lu(276) * lu(503) + lu(516) = lu(516) - lu(277) * lu(503) + lu(517) = lu(517) - lu(278) * lu(503) + lu(521) = lu(521) - lu(279) * lu(503) + lu(531) = lu(531) - lu(273) * lu(528) + lu(535) = lu(535) - lu(274) * lu(528) + lu(538) = lu(538) - lu(275) * lu(528) + lu(540) = lu(540) - lu(276) * lu(528) + lu(541) = lu(541) - lu(277) * lu(528) + lu(542) = lu(542) - lu(278) * lu(528) + lu(546) = lu(546) - lu(279) * lu(528) + lu(556) = lu(556) - lu(273) * lu(554) + lu(560) = lu(560) - lu(274) * lu(554) + lu(563) = lu(563) - lu(275) * lu(554) + lu(565) = lu(565) - lu(276) * lu(554) + lu(566) = lu(566) - lu(277) * lu(554) + lu(567) = lu(567) - lu(278) * lu(554) + lu(571) = lu(571) - lu(279) * lu(554) + lu(587) = - lu(273) * lu(585) + lu(591) = lu(591) - lu(274) * lu(585) + lu(594) = lu(594) - lu(275) * lu(585) + lu(596) = lu(596) - lu(276) * lu(585) + lu(597) = lu(597) - lu(277) * lu(585) + lu(598) = lu(598) - lu(278) * lu(585) + lu(602) = lu(602) - lu(279) * lu(585) + lu(612) = lu(612) - lu(273) * lu(609) + lu(616) = lu(616) - lu(274) * lu(609) + lu(619) = lu(619) - lu(275) * lu(609) + lu(621) = lu(621) - lu(276) * lu(609) + lu(622) = lu(622) - lu(277) * lu(609) + lu(623) = lu(623) - lu(278) * lu(609) + lu(627) = lu(627) - lu(279) * lu(609) + lu(631) = - lu(273) * lu(629) + lu(635) = - lu(274) * lu(629) + lu(638) = lu(638) - lu(275) * lu(629) + lu(640) = lu(640) - lu(276) * lu(629) + lu(641) = lu(641) - lu(277) * lu(629) + lu(642) = lu(642) - lu(278) * lu(629) + lu(646) = - lu(279) * lu(629) + lu(655) = lu(655) - lu(273) * lu(653) + lu(659) = - lu(274) * lu(653) + lu(662) = lu(662) - lu(275) * lu(653) + lu(664) = lu(664) - lu(276) * lu(653) + lu(665) = - lu(277) * lu(653) + lu(666) = - lu(278) * lu(653) + lu(670) = lu(670) - lu(279) * lu(653) + lu(679) = lu(679) - lu(273) * lu(677) + lu(683) = lu(683) - lu(274) * lu(677) + lu(686) = lu(686) - lu(275) * lu(677) + lu(688) = lu(688) - lu(276) * lu(677) + lu(689) = lu(689) - lu(277) * lu(677) + lu(690) = lu(690) - lu(278) * lu(677) + lu(694) = lu(694) - lu(279) * lu(677) + lu(720) = lu(720) - lu(273) * lu(717) + lu(724) = lu(724) - lu(274) * lu(717) + lu(727) = lu(727) - lu(275) * lu(717) + lu(729) = lu(729) - lu(276) * lu(717) + lu(730) = lu(730) - lu(277) * lu(717) + lu(731) = lu(731) - lu(278) * lu(717) + lu(735) = lu(735) - lu(279) * lu(717) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(284) = 1._r8 / lu(284) + lu(285) = lu(285) * lu(284) + lu(286) = lu(286) * lu(284) + lu(287) = lu(287) * lu(284) + lu(288) = lu(288) * lu(284) + lu(289) = lu(289) * lu(284) + lu(290) = lu(290) * lu(284) + lu(291) = lu(291) * lu(284) + lu(292) = lu(292) * lu(284) + lu(293) = lu(293) * lu(284) + lu(294) = lu(294) * lu(284) + lu(295) = lu(295) * lu(284) + lu(296) = lu(296) * lu(284) + lu(297) = lu(297) * lu(284) + lu(298) = lu(298) * lu(284) + lu(348) = lu(348) - lu(285) * lu(347) + lu(349) = lu(349) - lu(286) * lu(347) + lu(351) = lu(351) - lu(287) * lu(347) + lu(352) = lu(352) - lu(288) * lu(347) + lu(353) = lu(353) - lu(289) * lu(347) + lu(354) = lu(354) - lu(290) * lu(347) + lu(355) = lu(355) - lu(291) * lu(347) + lu(356) = lu(356) - lu(292) * lu(347) + lu(357) = lu(357) - lu(293) * lu(347) + lu(358) = lu(358) - lu(294) * lu(347) + lu(359) = lu(359) - lu(295) * lu(347) + lu(360) = lu(360) - lu(296) * lu(347) + lu(361) = - lu(297) * lu(347) + lu(362) = lu(362) - lu(298) * lu(347) + lu(375) = lu(375) - lu(285) * lu(373) + lu(376) = lu(376) - lu(286) * lu(373) + lu(378) = lu(378) - lu(287) * lu(373) + lu(379) = lu(379) - lu(288) * lu(373) + lu(381) = lu(381) - lu(289) * lu(373) + lu(382) = lu(382) - lu(290) * lu(373) + lu(383) = lu(383) - lu(291) * lu(373) + lu(384) = lu(384) - lu(292) * lu(373) + lu(385) = lu(385) - lu(293) * lu(373) + lu(386) = lu(386) - lu(294) * lu(373) + lu(387) = lu(387) - lu(295) * lu(373) + lu(388) = lu(388) - lu(296) * lu(373) + lu(389) = - lu(297) * lu(373) + lu(390) = lu(390) - lu(298) * lu(373) + lu(396) = lu(396) - lu(285) * lu(394) + lu(397) = - lu(286) * lu(394) + lu(399) = lu(399) - lu(287) * lu(394) + lu(400) = lu(400) - lu(288) * lu(394) + lu(402) = - lu(289) * lu(394) + lu(403) = lu(403) - lu(290) * lu(394) + lu(404) = - lu(291) * lu(394) + lu(405) = lu(405) - lu(292) * lu(394) + lu(406) = lu(406) - lu(293) * lu(394) + lu(407) = lu(407) - lu(294) * lu(394) + lu(408) = - lu(295) * lu(394) + lu(409) = - lu(296) * lu(394) + lu(410) = lu(410) - lu(297) * lu(394) + lu(411) = lu(411) - lu(298) * lu(394) + lu(442) = lu(442) - lu(285) * lu(440) + lu(443) = lu(443) - lu(286) * lu(440) + lu(445) = lu(445) - lu(287) * lu(440) + lu(446) = lu(446) - lu(288) * lu(440) + lu(448) = lu(448) - lu(289) * lu(440) + lu(449) = lu(449) - lu(290) * lu(440) + lu(450) = lu(450) - lu(291) * lu(440) + lu(451) = lu(451) - lu(292) * lu(440) + lu(452) = lu(452) - lu(293) * lu(440) + lu(453) = lu(453) - lu(294) * lu(440) + lu(454) = lu(454) - lu(295) * lu(440) + lu(455) = - lu(296) * lu(440) + lu(456) = lu(456) - lu(297) * lu(440) + lu(457) = lu(457) - lu(298) * lu(440) + lu(506) = lu(506) - lu(285) * lu(504) + lu(507) = lu(507) - lu(286) * lu(504) + lu(509) = lu(509) - lu(287) * lu(504) + lu(510) = lu(510) - lu(288) * lu(504) + lu(512) = lu(512) - lu(289) * lu(504) + lu(513) = lu(513) - lu(290) * lu(504) + lu(514) = lu(514) - lu(291) * lu(504) + lu(515) = lu(515) - lu(292) * lu(504) + lu(516) = lu(516) - lu(293) * lu(504) + lu(517) = lu(517) - lu(294) * lu(504) + lu(518) = lu(518) - lu(295) * lu(504) + lu(519) = lu(519) - lu(296) * lu(504) + lu(520) = lu(520) - lu(297) * lu(504) + lu(521) = lu(521) - lu(298) * lu(504) + lu(531) = lu(531) - lu(285) * lu(529) + lu(532) = lu(532) - lu(286) * lu(529) + lu(534) = lu(534) - lu(287) * lu(529) + lu(535) = lu(535) - lu(288) * lu(529) + lu(537) = lu(537) - lu(289) * lu(529) + lu(538) = lu(538) - lu(290) * lu(529) + lu(539) = lu(539) - lu(291) * lu(529) + lu(540) = lu(540) - lu(292) * lu(529) + lu(541) = lu(541) - lu(293) * lu(529) + lu(542) = lu(542) - lu(294) * lu(529) + lu(543) = lu(543) - lu(295) * lu(529) + lu(544) = - lu(296) * lu(529) + lu(545) = - lu(297) * lu(529) + lu(546) = lu(546) - lu(298) * lu(529) + lu(612) = lu(612) - lu(285) * lu(610) + lu(613) = lu(613) - lu(286) * lu(610) + lu(615) = lu(615) - lu(287) * lu(610) + lu(616) = lu(616) - lu(288) * lu(610) + lu(618) = lu(618) - lu(289) * lu(610) + lu(619) = lu(619) - lu(290) * lu(610) + lu(620) = lu(620) - lu(291) * lu(610) + lu(621) = lu(621) - lu(292) * lu(610) + lu(622) = lu(622) - lu(293) * lu(610) + lu(623) = lu(623) - lu(294) * lu(610) + lu(624) = lu(624) - lu(295) * lu(610) + lu(625) = lu(625) - lu(296) * lu(610) + lu(626) = lu(626) - lu(297) * lu(610) + lu(627) = lu(627) - lu(298) * lu(610) + lu(631) = lu(631) - lu(285) * lu(630) + lu(632) = lu(632) - lu(286) * lu(630) + lu(634) = - lu(287) * lu(630) + lu(635) = lu(635) - lu(288) * lu(630) + lu(637) = lu(637) - lu(289) * lu(630) + lu(638) = lu(638) - lu(290) * lu(630) + lu(639) = - lu(291) * lu(630) + lu(640) = lu(640) - lu(292) * lu(630) + lu(641) = lu(641) - lu(293) * lu(630) + lu(642) = lu(642) - lu(294) * lu(630) + lu(643) = lu(643) - lu(295) * lu(630) + lu(644) = - lu(296) * lu(630) + lu(645) = - lu(297) * lu(630) + lu(646) = lu(646) - lu(298) * lu(630) + lu(679) = lu(679) - lu(285) * lu(678) + lu(680) = lu(680) - lu(286) * lu(678) + lu(682) = lu(682) - lu(287) * lu(678) + lu(683) = lu(683) - lu(288) * lu(678) + lu(685) = lu(685) - lu(289) * lu(678) + lu(686) = lu(686) - lu(290) * lu(678) + lu(687) = lu(687) - lu(291) * lu(678) + lu(688) = lu(688) - lu(292) * lu(678) + lu(689) = lu(689) - lu(293) * lu(678) + lu(690) = lu(690) - lu(294) * lu(678) + lu(691) = lu(691) - lu(295) * lu(678) + lu(692) = lu(692) - lu(296) * lu(678) + lu(693) = lu(693) - lu(297) * lu(678) + lu(694) = lu(694) - lu(298) * lu(678) + lu(720) = lu(720) - lu(285) * lu(718) + lu(721) = lu(721) - lu(286) * lu(718) + lu(723) = lu(723) - lu(287) * lu(718) + lu(724) = lu(724) - lu(288) * lu(718) + lu(726) = lu(726) - lu(289) * lu(718) + lu(727) = lu(727) - lu(290) * lu(718) + lu(728) = lu(728) - lu(291) * lu(718) + lu(729) = lu(729) - lu(292) * lu(718) + lu(730) = lu(730) - lu(293) * lu(718) + lu(731) = lu(731) - lu(294) * lu(718) + lu(732) = lu(732) - lu(295) * lu(718) + lu(733) = lu(733) - lu(296) * lu(718) + lu(734) = lu(734) - lu(297) * lu(718) + lu(735) = lu(735) - lu(298) * lu(718) + lu(307) = 1._r8 / lu(307) + lu(308) = lu(308) * lu(307) + lu(309) = lu(309) * lu(307) + lu(310) = lu(310) * lu(307) + lu(311) = lu(311) * lu(307) + lu(312) = lu(312) * lu(307) + lu(313) = lu(313) * lu(307) + lu(314) = lu(314) * lu(307) + lu(315) = lu(315) * lu(307) + lu(316) = lu(316) * lu(307) + lu(317) = lu(317) * lu(307) + lu(318) = lu(318) * lu(307) + lu(319) = lu(319) * lu(307) + lu(320) = lu(320) * lu(307) + lu(321) = lu(321) * lu(307) + lu(322) = lu(322) * lu(307) + lu(375) = lu(375) - lu(308) * lu(374) + lu(376) = lu(376) - lu(309) * lu(374) + lu(377) = lu(377) - lu(310) * lu(374) + lu(378) = lu(378) - lu(311) * lu(374) + lu(379) = lu(379) - lu(312) * lu(374) + lu(380) = lu(380) - lu(313) * lu(374) + lu(381) = lu(381) - lu(314) * lu(374) + lu(382) = lu(382) - lu(315) * lu(374) + lu(383) = lu(383) - lu(316) * lu(374) + lu(384) = lu(384) - lu(317) * lu(374) + lu(385) = lu(385) - lu(318) * lu(374) + lu(386) = lu(386) - lu(319) * lu(374) + lu(387) = lu(387) - lu(320) * lu(374) + lu(388) = lu(388) - lu(321) * lu(374) + lu(390) = lu(390) - lu(322) * lu(374) + lu(396) = lu(396) - lu(308) * lu(395) + lu(397) = lu(397) - lu(309) * lu(395) + lu(398) = - lu(310) * lu(395) + lu(399) = lu(399) - lu(311) * lu(395) + lu(400) = lu(400) - lu(312) * lu(395) + lu(401) = - lu(313) * lu(395) + lu(402) = lu(402) - lu(314) * lu(395) + lu(403) = lu(403) - lu(315) * lu(395) + lu(404) = lu(404) - lu(316) * lu(395) + lu(405) = lu(405) - lu(317) * lu(395) + lu(406) = lu(406) - lu(318) * lu(395) + lu(407) = lu(407) - lu(319) * lu(395) + lu(408) = lu(408) - lu(320) * lu(395) + lu(409) = lu(409) - lu(321) * lu(395) + lu(411) = lu(411) - lu(322) * lu(395) + lu(419) = lu(419) - lu(308) * lu(418) + lu(420) = lu(420) - lu(309) * lu(418) + lu(421) = lu(421) - lu(310) * lu(418) + lu(422) = lu(422) - lu(311) * lu(418) + lu(423) = lu(423) - lu(312) * lu(418) + lu(424) = lu(424) - lu(313) * lu(418) + lu(425) = lu(425) - lu(314) * lu(418) + lu(426) = lu(426) - lu(315) * lu(418) + lu(427) = lu(427) - lu(316) * lu(418) + lu(428) = lu(428) - lu(317) * lu(418) + lu(429) = lu(429) - lu(318) * lu(418) + lu(430) = lu(430) - lu(319) * lu(418) + lu(431) = - lu(320) * lu(418) + lu(432) = - lu(321) * lu(418) + lu(434) = lu(434) - lu(322) * lu(418) + lu(442) = lu(442) - lu(308) * lu(441) + lu(443) = lu(443) - lu(309) * lu(441) + lu(444) = lu(444) - lu(310) * lu(441) + lu(445) = lu(445) - lu(311) * lu(441) + lu(446) = lu(446) - lu(312) * lu(441) + lu(447) = lu(447) - lu(313) * lu(441) + lu(448) = lu(448) - lu(314) * lu(441) + lu(449) = lu(449) - lu(315) * lu(441) + lu(450) = lu(450) - lu(316) * lu(441) + lu(451) = lu(451) - lu(317) * lu(441) + lu(452) = lu(452) - lu(318) * lu(441) + lu(453) = lu(453) - lu(319) * lu(441) + lu(454) = lu(454) - lu(320) * lu(441) + lu(455) = lu(455) - lu(321) * lu(441) + lu(457) = lu(457) - lu(322) * lu(441) + lu(469) = lu(469) - lu(308) * lu(468) + lu(470) = lu(470) - lu(309) * lu(468) + lu(471) = lu(471) - lu(310) * lu(468) + lu(472) = lu(472) - lu(311) * lu(468) + lu(473) = lu(473) - lu(312) * lu(468) + lu(474) = lu(474) - lu(313) * lu(468) + lu(475) = lu(475) - lu(314) * lu(468) + lu(476) = lu(476) - lu(315) * lu(468) + lu(477) = lu(477) - lu(316) * lu(468) + lu(478) = lu(478) - lu(317) * lu(468) + lu(479) = lu(479) - lu(318) * lu(468) + lu(480) = lu(480) - lu(319) * lu(468) + lu(481) = lu(481) - lu(320) * lu(468) + lu(482) = lu(482) - lu(321) * lu(468) + lu(484) = lu(484) - lu(322) * lu(468) + lu(506) = lu(506) - lu(308) * lu(505) + lu(507) = lu(507) - lu(309) * lu(505) + lu(508) = lu(508) - lu(310) * lu(505) + lu(509) = lu(509) - lu(311) * lu(505) + lu(510) = lu(510) - lu(312) * lu(505) + lu(511) = lu(511) - lu(313) * lu(505) + lu(512) = lu(512) - lu(314) * lu(505) + lu(513) = lu(513) - lu(315) * lu(505) + lu(514) = lu(514) - lu(316) * lu(505) + lu(515) = lu(515) - lu(317) * lu(505) + lu(516) = lu(516) - lu(318) * lu(505) + lu(517) = lu(517) - lu(319) * lu(505) + lu(518) = lu(518) - lu(320) * lu(505) + lu(519) = lu(519) - lu(321) * lu(505) + lu(521) = lu(521) - lu(322) * lu(505) + lu(531) = lu(531) - lu(308) * lu(530) + lu(532) = lu(532) - lu(309) * lu(530) + lu(533) = lu(533) - lu(310) * lu(530) + lu(534) = lu(534) - lu(311) * lu(530) + lu(535) = lu(535) - lu(312) * lu(530) + lu(536) = lu(536) - lu(313) * lu(530) + lu(537) = lu(537) - lu(314) * lu(530) + lu(538) = lu(538) - lu(315) * lu(530) + lu(539) = lu(539) - lu(316) * lu(530) + lu(540) = lu(540) - lu(317) * lu(530) + lu(541) = lu(541) - lu(318) * lu(530) + lu(542) = lu(542) - lu(319) * lu(530) + lu(543) = lu(543) - lu(320) * lu(530) + lu(544) = lu(544) - lu(321) * lu(530) + lu(546) = lu(546) - lu(322) * lu(530) + lu(556) = lu(556) - lu(308) * lu(555) + lu(557) = lu(557) - lu(309) * lu(555) + lu(558) = lu(558) - lu(310) * lu(555) + lu(559) = lu(559) - lu(311) * lu(555) + lu(560) = lu(560) - lu(312) * lu(555) + lu(561) = lu(561) - lu(313) * lu(555) + lu(562) = lu(562) - lu(314) * lu(555) + lu(563) = lu(563) - lu(315) * lu(555) + lu(564) = lu(564) - lu(316) * lu(555) + lu(565) = lu(565) - lu(317) * lu(555) + lu(566) = lu(566) - lu(318) * lu(555) + lu(567) = lu(567) - lu(319) * lu(555) + lu(568) = lu(568) - lu(320) * lu(555) + lu(569) = - lu(321) * lu(555) + lu(571) = lu(571) - lu(322) * lu(555) + lu(587) = lu(587) - lu(308) * lu(586) + lu(588) = lu(588) - lu(309) * lu(586) + lu(589) = lu(589) - lu(310) * lu(586) + lu(590) = lu(590) - lu(311) * lu(586) + lu(591) = lu(591) - lu(312) * lu(586) + lu(592) = lu(592) - lu(313) * lu(586) + lu(593) = lu(593) - lu(314) * lu(586) + lu(594) = lu(594) - lu(315) * lu(586) + lu(595) = - lu(316) * lu(586) + lu(596) = lu(596) - lu(317) * lu(586) + lu(597) = lu(597) - lu(318) * lu(586) + lu(598) = lu(598) - lu(319) * lu(586) + lu(599) = - lu(320) * lu(586) + lu(600) = - lu(321) * lu(586) + lu(602) = lu(602) - lu(322) * lu(586) + lu(612) = lu(612) - lu(308) * lu(611) + lu(613) = lu(613) - lu(309) * lu(611) + lu(614) = lu(614) - lu(310) * lu(611) + lu(615) = lu(615) - lu(311) * lu(611) + lu(616) = lu(616) - lu(312) * lu(611) + lu(617) = lu(617) - lu(313) * lu(611) + lu(618) = lu(618) - lu(314) * lu(611) + lu(619) = lu(619) - lu(315) * lu(611) + lu(620) = lu(620) - lu(316) * lu(611) + lu(621) = lu(621) - lu(317) * lu(611) + lu(622) = lu(622) - lu(318) * lu(611) + lu(623) = lu(623) - lu(319) * lu(611) + lu(624) = lu(624) - lu(320) * lu(611) + lu(625) = lu(625) - lu(321) * lu(611) + lu(627) = lu(627) - lu(322) * lu(611) + lu(655) = lu(655) - lu(308) * lu(654) + lu(656) = lu(656) - lu(309) * lu(654) + lu(657) = lu(657) - lu(310) * lu(654) + lu(658) = lu(658) - lu(311) * lu(654) + lu(659) = lu(659) - lu(312) * lu(654) + lu(660) = - lu(313) * lu(654) + lu(661) = lu(661) - lu(314) * lu(654) + lu(662) = lu(662) - lu(315) * lu(654) + lu(663) = lu(663) - lu(316) * lu(654) + lu(664) = lu(664) - lu(317) * lu(654) + lu(665) = lu(665) - lu(318) * lu(654) + lu(666) = lu(666) - lu(319) * lu(654) + lu(667) = lu(667) - lu(320) * lu(654) + lu(668) = lu(668) - lu(321) * lu(654) + lu(670) = lu(670) - lu(322) * lu(654) + lu(720) = lu(720) - lu(308) * lu(719) + lu(721) = lu(721) - lu(309) * lu(719) + lu(722) = lu(722) - lu(310) * lu(719) + lu(723) = lu(723) - lu(311) * lu(719) + lu(724) = lu(724) - lu(312) * lu(719) + lu(725) = lu(725) - lu(313) * lu(719) + lu(726) = lu(726) - lu(314) * lu(719) + lu(727) = lu(727) - lu(315) * lu(719) + lu(728) = lu(728) - lu(316) * lu(719) + lu(729) = lu(729) - lu(317) * lu(719) + lu(730) = lu(730) - lu(318) * lu(719) + lu(731) = lu(731) - lu(319) * lu(719) + lu(732) = lu(732) - lu(320) * lu(719) + lu(733) = lu(733) - lu(321) * lu(719) + lu(735) = lu(735) - lu(322) * lu(719) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(327) = 1._r8 / lu(327) + lu(328) = lu(328) * lu(327) + lu(329) = lu(329) * lu(327) + lu(330) = lu(330) * lu(327) + lu(331) = lu(331) * lu(327) + lu(332) = lu(332) * lu(327) + lu(333) = lu(333) * lu(327) + lu(334) = lu(334) * lu(327) + lu(335) = lu(335) * lu(327) + lu(336) = lu(336) * lu(327) + lu(337) = lu(337) * lu(327) + lu(338) = lu(338) * lu(327) + lu(339) = lu(339) * lu(327) + lu(349) = lu(349) - lu(328) * lu(348) + lu(352) = lu(352) - lu(329) * lu(348) + lu(353) = lu(353) - lu(330) * lu(348) + lu(354) = lu(354) - lu(331) * lu(348) + lu(355) = lu(355) - lu(332) * lu(348) + lu(356) = lu(356) - lu(333) * lu(348) + lu(357) = lu(357) - lu(334) * lu(348) + lu(358) = lu(358) - lu(335) * lu(348) + lu(359) = lu(359) - lu(336) * lu(348) + lu(360) = lu(360) - lu(337) * lu(348) + lu(361) = lu(361) - lu(338) * lu(348) + lu(362) = lu(362) - lu(339) * lu(348) + lu(376) = lu(376) - lu(328) * lu(375) + lu(379) = lu(379) - lu(329) * lu(375) + lu(381) = lu(381) - lu(330) * lu(375) + lu(382) = lu(382) - lu(331) * lu(375) + lu(383) = lu(383) - lu(332) * lu(375) + lu(384) = lu(384) - lu(333) * lu(375) + lu(385) = lu(385) - lu(334) * lu(375) + lu(386) = lu(386) - lu(335) * lu(375) + lu(387) = lu(387) - lu(336) * lu(375) + lu(388) = lu(388) - lu(337) * lu(375) + lu(389) = lu(389) - lu(338) * lu(375) + lu(390) = lu(390) - lu(339) * lu(375) + lu(397) = lu(397) - lu(328) * lu(396) + lu(400) = lu(400) - lu(329) * lu(396) + lu(402) = lu(402) - lu(330) * lu(396) + lu(403) = lu(403) - lu(331) * lu(396) + lu(404) = lu(404) - lu(332) * lu(396) + lu(405) = lu(405) - lu(333) * lu(396) + lu(406) = lu(406) - lu(334) * lu(396) + lu(407) = lu(407) - lu(335) * lu(396) + lu(408) = lu(408) - lu(336) * lu(396) + lu(409) = lu(409) - lu(337) * lu(396) + lu(410) = lu(410) - lu(338) * lu(396) + lu(411) = lu(411) - lu(339) * lu(396) + lu(420) = lu(420) - lu(328) * lu(419) + lu(423) = lu(423) - lu(329) * lu(419) + lu(425) = lu(425) - lu(330) * lu(419) + lu(426) = lu(426) - lu(331) * lu(419) + lu(427) = lu(427) - lu(332) * lu(419) + lu(428) = lu(428) - lu(333) * lu(419) + lu(429) = lu(429) - lu(334) * lu(419) + lu(430) = lu(430) - lu(335) * lu(419) + lu(431) = lu(431) - lu(336) * lu(419) + lu(432) = lu(432) - lu(337) * lu(419) + lu(433) = lu(433) - lu(338) * lu(419) + lu(434) = lu(434) - lu(339) * lu(419) + lu(443) = lu(443) - lu(328) * lu(442) + lu(446) = lu(446) - lu(329) * lu(442) + lu(448) = lu(448) - lu(330) * lu(442) + lu(449) = lu(449) - lu(331) * lu(442) + lu(450) = lu(450) - lu(332) * lu(442) + lu(451) = lu(451) - lu(333) * lu(442) + lu(452) = lu(452) - lu(334) * lu(442) + lu(453) = lu(453) - lu(335) * lu(442) + lu(454) = lu(454) - lu(336) * lu(442) + lu(455) = lu(455) - lu(337) * lu(442) + lu(456) = lu(456) - lu(338) * lu(442) + lu(457) = lu(457) - lu(339) * lu(442) + lu(470) = lu(470) - lu(328) * lu(469) + lu(473) = lu(473) - lu(329) * lu(469) + lu(475) = lu(475) - lu(330) * lu(469) + lu(476) = lu(476) - lu(331) * lu(469) + lu(477) = lu(477) - lu(332) * lu(469) + lu(478) = lu(478) - lu(333) * lu(469) + lu(479) = lu(479) - lu(334) * lu(469) + lu(480) = lu(480) - lu(335) * lu(469) + lu(481) = lu(481) - lu(336) * lu(469) + lu(482) = lu(482) - lu(337) * lu(469) + lu(483) = lu(483) - lu(338) * lu(469) + lu(484) = lu(484) - lu(339) * lu(469) + lu(507) = lu(507) - lu(328) * lu(506) + lu(510) = lu(510) - lu(329) * lu(506) + lu(512) = lu(512) - lu(330) * lu(506) + lu(513) = lu(513) - lu(331) * lu(506) + lu(514) = lu(514) - lu(332) * lu(506) + lu(515) = lu(515) - lu(333) * lu(506) + lu(516) = lu(516) - lu(334) * lu(506) + lu(517) = lu(517) - lu(335) * lu(506) + lu(518) = lu(518) - lu(336) * lu(506) + lu(519) = lu(519) - lu(337) * lu(506) + lu(520) = lu(520) - lu(338) * lu(506) + lu(521) = lu(521) - lu(339) * lu(506) + lu(532) = lu(532) - lu(328) * lu(531) + lu(535) = lu(535) - lu(329) * lu(531) + lu(537) = lu(537) - lu(330) * lu(531) + lu(538) = lu(538) - lu(331) * lu(531) + lu(539) = lu(539) - lu(332) * lu(531) + lu(540) = lu(540) - lu(333) * lu(531) + lu(541) = lu(541) - lu(334) * lu(531) + lu(542) = lu(542) - lu(335) * lu(531) + lu(543) = lu(543) - lu(336) * lu(531) + lu(544) = lu(544) - lu(337) * lu(531) + lu(545) = lu(545) - lu(338) * lu(531) + lu(546) = lu(546) - lu(339) * lu(531) + lu(557) = lu(557) - lu(328) * lu(556) + lu(560) = lu(560) - lu(329) * lu(556) + lu(562) = lu(562) - lu(330) * lu(556) + lu(563) = lu(563) - lu(331) * lu(556) + lu(564) = lu(564) - lu(332) * lu(556) + lu(565) = lu(565) - lu(333) * lu(556) + lu(566) = lu(566) - lu(334) * lu(556) + lu(567) = lu(567) - lu(335) * lu(556) + lu(568) = lu(568) - lu(336) * lu(556) + lu(569) = lu(569) - lu(337) * lu(556) + lu(570) = lu(570) - lu(338) * lu(556) + lu(571) = lu(571) - lu(339) * lu(556) + lu(588) = lu(588) - lu(328) * lu(587) + lu(591) = lu(591) - lu(329) * lu(587) + lu(593) = lu(593) - lu(330) * lu(587) + lu(594) = lu(594) - lu(331) * lu(587) + lu(595) = lu(595) - lu(332) * lu(587) + lu(596) = lu(596) - lu(333) * lu(587) + lu(597) = lu(597) - lu(334) * lu(587) + lu(598) = lu(598) - lu(335) * lu(587) + lu(599) = lu(599) - lu(336) * lu(587) + lu(600) = lu(600) - lu(337) * lu(587) + lu(601) = lu(601) - lu(338) * lu(587) + lu(602) = lu(602) - lu(339) * lu(587) + lu(613) = lu(613) - lu(328) * lu(612) + lu(616) = lu(616) - lu(329) * lu(612) + lu(618) = lu(618) - lu(330) * lu(612) + lu(619) = lu(619) - lu(331) * lu(612) + lu(620) = lu(620) - lu(332) * lu(612) + lu(621) = lu(621) - lu(333) * lu(612) + lu(622) = lu(622) - lu(334) * lu(612) + lu(623) = lu(623) - lu(335) * lu(612) + lu(624) = lu(624) - lu(336) * lu(612) + lu(625) = lu(625) - lu(337) * lu(612) + lu(626) = lu(626) - lu(338) * lu(612) + lu(627) = lu(627) - lu(339) * lu(612) + lu(632) = lu(632) - lu(328) * lu(631) + lu(635) = lu(635) - lu(329) * lu(631) + lu(637) = lu(637) - lu(330) * lu(631) + lu(638) = lu(638) - lu(331) * lu(631) + lu(639) = lu(639) - lu(332) * lu(631) + lu(640) = lu(640) - lu(333) * lu(631) + lu(641) = lu(641) - lu(334) * lu(631) + lu(642) = lu(642) - lu(335) * lu(631) + lu(643) = lu(643) - lu(336) * lu(631) + lu(644) = lu(644) - lu(337) * lu(631) + lu(645) = lu(645) - lu(338) * lu(631) + lu(646) = lu(646) - lu(339) * lu(631) + lu(656) = lu(656) - lu(328) * lu(655) + lu(659) = lu(659) - lu(329) * lu(655) + lu(661) = lu(661) - lu(330) * lu(655) + lu(662) = lu(662) - lu(331) * lu(655) + lu(663) = lu(663) - lu(332) * lu(655) + lu(664) = lu(664) - lu(333) * lu(655) + lu(665) = lu(665) - lu(334) * lu(655) + lu(666) = lu(666) - lu(335) * lu(655) + lu(667) = lu(667) - lu(336) * lu(655) + lu(668) = lu(668) - lu(337) * lu(655) + lu(669) = lu(669) - lu(338) * lu(655) + lu(670) = lu(670) - lu(339) * lu(655) + lu(680) = lu(680) - lu(328) * lu(679) + lu(683) = lu(683) - lu(329) * lu(679) + lu(685) = lu(685) - lu(330) * lu(679) + lu(686) = lu(686) - lu(331) * lu(679) + lu(687) = lu(687) - lu(332) * lu(679) + lu(688) = lu(688) - lu(333) * lu(679) + lu(689) = lu(689) - lu(334) * lu(679) + lu(690) = lu(690) - lu(335) * lu(679) + lu(691) = lu(691) - lu(336) * lu(679) + lu(692) = lu(692) - lu(337) * lu(679) + lu(693) = lu(693) - lu(338) * lu(679) + lu(694) = lu(694) - lu(339) * lu(679) + lu(721) = lu(721) - lu(328) * lu(720) + lu(724) = lu(724) - lu(329) * lu(720) + lu(726) = lu(726) - lu(330) * lu(720) + lu(727) = lu(727) - lu(331) * lu(720) + lu(728) = lu(728) - lu(332) * lu(720) + lu(729) = lu(729) - lu(333) * lu(720) + lu(730) = lu(730) - lu(334) * lu(720) + lu(731) = lu(731) - lu(335) * lu(720) + lu(732) = lu(732) - lu(336) * lu(720) + lu(733) = lu(733) - lu(337) * lu(720) + lu(734) = lu(734) - lu(338) * lu(720) + lu(735) = lu(735) - lu(339) * lu(720) + lu(349) = 1._r8 / lu(349) + lu(350) = lu(350) * lu(349) + lu(351) = lu(351) * lu(349) + lu(352) = lu(352) * lu(349) + lu(353) = lu(353) * lu(349) + lu(354) = lu(354) * lu(349) + lu(355) = lu(355) * lu(349) + lu(356) = lu(356) * lu(349) + lu(357) = lu(357) * lu(349) + lu(358) = lu(358) * lu(349) + lu(359) = lu(359) * lu(349) + lu(360) = lu(360) * lu(349) + lu(361) = lu(361) * lu(349) + lu(362) = lu(362) * lu(349) + lu(377) = lu(377) - lu(350) * lu(376) + lu(378) = lu(378) - lu(351) * lu(376) + lu(379) = lu(379) - lu(352) * lu(376) + lu(381) = lu(381) - lu(353) * lu(376) + lu(382) = lu(382) - lu(354) * lu(376) + lu(383) = lu(383) - lu(355) * lu(376) + lu(384) = lu(384) - lu(356) * lu(376) + lu(385) = lu(385) - lu(357) * lu(376) + lu(386) = lu(386) - lu(358) * lu(376) + lu(387) = lu(387) - lu(359) * lu(376) + lu(388) = lu(388) - lu(360) * lu(376) + lu(389) = lu(389) - lu(361) * lu(376) + lu(390) = lu(390) - lu(362) * lu(376) + lu(398) = lu(398) - lu(350) * lu(397) + lu(399) = lu(399) - lu(351) * lu(397) + lu(400) = lu(400) - lu(352) * lu(397) + lu(402) = lu(402) - lu(353) * lu(397) + lu(403) = lu(403) - lu(354) * lu(397) + lu(404) = lu(404) - lu(355) * lu(397) + lu(405) = lu(405) - lu(356) * lu(397) + lu(406) = lu(406) - lu(357) * lu(397) + lu(407) = lu(407) - lu(358) * lu(397) + lu(408) = lu(408) - lu(359) * lu(397) + lu(409) = lu(409) - lu(360) * lu(397) + lu(410) = lu(410) - lu(361) * lu(397) + lu(411) = lu(411) - lu(362) * lu(397) + lu(421) = lu(421) - lu(350) * lu(420) + lu(422) = lu(422) - lu(351) * lu(420) + lu(423) = lu(423) - lu(352) * lu(420) + lu(425) = lu(425) - lu(353) * lu(420) + lu(426) = lu(426) - lu(354) * lu(420) + lu(427) = lu(427) - lu(355) * lu(420) + lu(428) = lu(428) - lu(356) * lu(420) + lu(429) = lu(429) - lu(357) * lu(420) + lu(430) = lu(430) - lu(358) * lu(420) + lu(431) = lu(431) - lu(359) * lu(420) + lu(432) = lu(432) - lu(360) * lu(420) + lu(433) = lu(433) - lu(361) * lu(420) + lu(434) = lu(434) - lu(362) * lu(420) + lu(444) = lu(444) - lu(350) * lu(443) + lu(445) = lu(445) - lu(351) * lu(443) + lu(446) = lu(446) - lu(352) * lu(443) + lu(448) = lu(448) - lu(353) * lu(443) + lu(449) = lu(449) - lu(354) * lu(443) + lu(450) = lu(450) - lu(355) * lu(443) + lu(451) = lu(451) - lu(356) * lu(443) + lu(452) = lu(452) - lu(357) * lu(443) + lu(453) = lu(453) - lu(358) * lu(443) + lu(454) = lu(454) - lu(359) * lu(443) + lu(455) = lu(455) - lu(360) * lu(443) + lu(456) = lu(456) - lu(361) * lu(443) + lu(457) = lu(457) - lu(362) * lu(443) + lu(471) = lu(471) - lu(350) * lu(470) + lu(472) = lu(472) - lu(351) * lu(470) + lu(473) = lu(473) - lu(352) * lu(470) + lu(475) = lu(475) - lu(353) * lu(470) + lu(476) = lu(476) - lu(354) * lu(470) + lu(477) = lu(477) - lu(355) * lu(470) + lu(478) = lu(478) - lu(356) * lu(470) + lu(479) = lu(479) - lu(357) * lu(470) + lu(480) = lu(480) - lu(358) * lu(470) + lu(481) = lu(481) - lu(359) * lu(470) + lu(482) = lu(482) - lu(360) * lu(470) + lu(483) = lu(483) - lu(361) * lu(470) + lu(484) = lu(484) - lu(362) * lu(470) + lu(508) = lu(508) - lu(350) * lu(507) + lu(509) = lu(509) - lu(351) * lu(507) + lu(510) = lu(510) - lu(352) * lu(507) + lu(512) = lu(512) - lu(353) * lu(507) + lu(513) = lu(513) - lu(354) * lu(507) + lu(514) = lu(514) - lu(355) * lu(507) + lu(515) = lu(515) - lu(356) * lu(507) + lu(516) = lu(516) - lu(357) * lu(507) + lu(517) = lu(517) - lu(358) * lu(507) + lu(518) = lu(518) - lu(359) * lu(507) + lu(519) = lu(519) - lu(360) * lu(507) + lu(520) = lu(520) - lu(361) * lu(507) + lu(521) = lu(521) - lu(362) * lu(507) + lu(533) = lu(533) - lu(350) * lu(532) + lu(534) = lu(534) - lu(351) * lu(532) + lu(535) = lu(535) - lu(352) * lu(532) + lu(537) = lu(537) - lu(353) * lu(532) + lu(538) = lu(538) - lu(354) * lu(532) + lu(539) = lu(539) - lu(355) * lu(532) + lu(540) = lu(540) - lu(356) * lu(532) + lu(541) = lu(541) - lu(357) * lu(532) + lu(542) = lu(542) - lu(358) * lu(532) + lu(543) = lu(543) - lu(359) * lu(532) + lu(544) = lu(544) - lu(360) * lu(532) + lu(545) = lu(545) - lu(361) * lu(532) + lu(546) = lu(546) - lu(362) * lu(532) + lu(558) = lu(558) - lu(350) * lu(557) + lu(559) = lu(559) - lu(351) * lu(557) + lu(560) = lu(560) - lu(352) * lu(557) + lu(562) = lu(562) - lu(353) * lu(557) + lu(563) = lu(563) - lu(354) * lu(557) + lu(564) = lu(564) - lu(355) * lu(557) + lu(565) = lu(565) - lu(356) * lu(557) + lu(566) = lu(566) - lu(357) * lu(557) + lu(567) = lu(567) - lu(358) * lu(557) + lu(568) = lu(568) - lu(359) * lu(557) + lu(569) = lu(569) - lu(360) * lu(557) + lu(570) = lu(570) - lu(361) * lu(557) + lu(571) = lu(571) - lu(362) * lu(557) + lu(589) = lu(589) - lu(350) * lu(588) + lu(590) = lu(590) - lu(351) * lu(588) + lu(591) = lu(591) - lu(352) * lu(588) + lu(593) = lu(593) - lu(353) * lu(588) + lu(594) = lu(594) - lu(354) * lu(588) + lu(595) = lu(595) - lu(355) * lu(588) + lu(596) = lu(596) - lu(356) * lu(588) + lu(597) = lu(597) - lu(357) * lu(588) + lu(598) = lu(598) - lu(358) * lu(588) + lu(599) = lu(599) - lu(359) * lu(588) + lu(600) = lu(600) - lu(360) * lu(588) + lu(601) = lu(601) - lu(361) * lu(588) + lu(602) = lu(602) - lu(362) * lu(588) + lu(614) = lu(614) - lu(350) * lu(613) + lu(615) = lu(615) - lu(351) * lu(613) + lu(616) = lu(616) - lu(352) * lu(613) + lu(618) = lu(618) - lu(353) * lu(613) + lu(619) = lu(619) - lu(354) * lu(613) + lu(620) = lu(620) - lu(355) * lu(613) + lu(621) = lu(621) - lu(356) * lu(613) + lu(622) = lu(622) - lu(357) * lu(613) + lu(623) = lu(623) - lu(358) * lu(613) + lu(624) = lu(624) - lu(359) * lu(613) + lu(625) = lu(625) - lu(360) * lu(613) + lu(626) = lu(626) - lu(361) * lu(613) + lu(627) = lu(627) - lu(362) * lu(613) + lu(633) = lu(633) - lu(350) * lu(632) + lu(634) = lu(634) - lu(351) * lu(632) + lu(635) = lu(635) - lu(352) * lu(632) + lu(637) = lu(637) - lu(353) * lu(632) + lu(638) = lu(638) - lu(354) * lu(632) + lu(639) = lu(639) - lu(355) * lu(632) + lu(640) = lu(640) - lu(356) * lu(632) + lu(641) = lu(641) - lu(357) * lu(632) + lu(642) = lu(642) - lu(358) * lu(632) + lu(643) = lu(643) - lu(359) * lu(632) + lu(644) = lu(644) - lu(360) * lu(632) + lu(645) = lu(645) - lu(361) * lu(632) + lu(646) = lu(646) - lu(362) * lu(632) + lu(657) = lu(657) - lu(350) * lu(656) + lu(658) = lu(658) - lu(351) * lu(656) + lu(659) = lu(659) - lu(352) * lu(656) + lu(661) = lu(661) - lu(353) * lu(656) + lu(662) = lu(662) - lu(354) * lu(656) + lu(663) = lu(663) - lu(355) * lu(656) + lu(664) = lu(664) - lu(356) * lu(656) + lu(665) = lu(665) - lu(357) * lu(656) + lu(666) = lu(666) - lu(358) * lu(656) + lu(667) = lu(667) - lu(359) * lu(656) + lu(668) = lu(668) - lu(360) * lu(656) + lu(669) = lu(669) - lu(361) * lu(656) + lu(670) = lu(670) - lu(362) * lu(656) + lu(681) = - lu(350) * lu(680) + lu(682) = lu(682) - lu(351) * lu(680) + lu(683) = lu(683) - lu(352) * lu(680) + lu(685) = lu(685) - lu(353) * lu(680) + lu(686) = lu(686) - lu(354) * lu(680) + lu(687) = lu(687) - lu(355) * lu(680) + lu(688) = lu(688) - lu(356) * lu(680) + lu(689) = lu(689) - lu(357) * lu(680) + lu(690) = lu(690) - lu(358) * lu(680) + lu(691) = lu(691) - lu(359) * lu(680) + lu(692) = lu(692) - lu(360) * lu(680) + lu(693) = lu(693) - lu(361) * lu(680) + lu(694) = lu(694) - lu(362) * lu(680) + lu(722) = lu(722) - lu(350) * lu(721) + lu(723) = lu(723) - lu(351) * lu(721) + lu(724) = lu(724) - lu(352) * lu(721) + lu(726) = lu(726) - lu(353) * lu(721) + lu(727) = lu(727) - lu(354) * lu(721) + lu(728) = lu(728) - lu(355) * lu(721) + lu(729) = lu(729) - lu(356) * lu(721) + lu(730) = lu(730) - lu(357) * lu(721) + lu(731) = lu(731) - lu(358) * lu(721) + lu(732) = lu(732) - lu(359) * lu(721) + lu(733) = lu(733) - lu(360) * lu(721) + lu(734) = lu(734) - lu(361) * lu(721) + lu(735) = lu(735) - lu(362) * lu(721) + lu(377) = 1._r8 / lu(377) + lu(378) = lu(378) * lu(377) + lu(379) = lu(379) * lu(377) + lu(380) = lu(380) * lu(377) + lu(381) = lu(381) * lu(377) + lu(382) = lu(382) * lu(377) + lu(383) = lu(383) * lu(377) + lu(384) = lu(384) * lu(377) + lu(385) = lu(385) * lu(377) + lu(386) = lu(386) * lu(377) + lu(387) = lu(387) * lu(377) + lu(388) = lu(388) * lu(377) + lu(389) = lu(389) * lu(377) + lu(390) = lu(390) * lu(377) + lu(399) = lu(399) - lu(378) * lu(398) + lu(400) = lu(400) - lu(379) * lu(398) + lu(401) = lu(401) - lu(380) * lu(398) + lu(402) = lu(402) - lu(381) * lu(398) + lu(403) = lu(403) - lu(382) * lu(398) + lu(404) = lu(404) - lu(383) * lu(398) + lu(405) = lu(405) - lu(384) * lu(398) + lu(406) = lu(406) - lu(385) * lu(398) + lu(407) = lu(407) - lu(386) * lu(398) + lu(408) = lu(408) - lu(387) * lu(398) + lu(409) = lu(409) - lu(388) * lu(398) + lu(410) = lu(410) - lu(389) * lu(398) + lu(411) = lu(411) - lu(390) * lu(398) + lu(422) = lu(422) - lu(378) * lu(421) + lu(423) = lu(423) - lu(379) * lu(421) + lu(424) = lu(424) - lu(380) * lu(421) + lu(425) = lu(425) - lu(381) * lu(421) + lu(426) = lu(426) - lu(382) * lu(421) + lu(427) = lu(427) - lu(383) * lu(421) + lu(428) = lu(428) - lu(384) * lu(421) + lu(429) = lu(429) - lu(385) * lu(421) + lu(430) = lu(430) - lu(386) * lu(421) + lu(431) = lu(431) - lu(387) * lu(421) + lu(432) = lu(432) - lu(388) * lu(421) + lu(433) = lu(433) - lu(389) * lu(421) + lu(434) = lu(434) - lu(390) * lu(421) + lu(445) = lu(445) - lu(378) * lu(444) + lu(446) = lu(446) - lu(379) * lu(444) + lu(447) = lu(447) - lu(380) * lu(444) + lu(448) = lu(448) - lu(381) * lu(444) + lu(449) = lu(449) - lu(382) * lu(444) + lu(450) = lu(450) - lu(383) * lu(444) + lu(451) = lu(451) - lu(384) * lu(444) + lu(452) = lu(452) - lu(385) * lu(444) + lu(453) = lu(453) - lu(386) * lu(444) + lu(454) = lu(454) - lu(387) * lu(444) + lu(455) = lu(455) - lu(388) * lu(444) + lu(456) = lu(456) - lu(389) * lu(444) + lu(457) = lu(457) - lu(390) * lu(444) + lu(472) = lu(472) - lu(378) * lu(471) + lu(473) = lu(473) - lu(379) * lu(471) + lu(474) = lu(474) - lu(380) * lu(471) + lu(475) = lu(475) - lu(381) * lu(471) + lu(476) = lu(476) - lu(382) * lu(471) + lu(477) = lu(477) - lu(383) * lu(471) + lu(478) = lu(478) - lu(384) * lu(471) + lu(479) = lu(479) - lu(385) * lu(471) + lu(480) = lu(480) - lu(386) * lu(471) + lu(481) = lu(481) - lu(387) * lu(471) + lu(482) = lu(482) - lu(388) * lu(471) + lu(483) = lu(483) - lu(389) * lu(471) + lu(484) = lu(484) - lu(390) * lu(471) + lu(509) = lu(509) - lu(378) * lu(508) + lu(510) = lu(510) - lu(379) * lu(508) + lu(511) = lu(511) - lu(380) * lu(508) + lu(512) = lu(512) - lu(381) * lu(508) + lu(513) = lu(513) - lu(382) * lu(508) + lu(514) = lu(514) - lu(383) * lu(508) + lu(515) = lu(515) - lu(384) * lu(508) + lu(516) = lu(516) - lu(385) * lu(508) + lu(517) = lu(517) - lu(386) * lu(508) + lu(518) = lu(518) - lu(387) * lu(508) + lu(519) = lu(519) - lu(388) * lu(508) + lu(520) = lu(520) - lu(389) * lu(508) + lu(521) = lu(521) - lu(390) * lu(508) + lu(534) = lu(534) - lu(378) * lu(533) + lu(535) = lu(535) - lu(379) * lu(533) + lu(536) = lu(536) - lu(380) * lu(533) + lu(537) = lu(537) - lu(381) * lu(533) + lu(538) = lu(538) - lu(382) * lu(533) + lu(539) = lu(539) - lu(383) * lu(533) + lu(540) = lu(540) - lu(384) * lu(533) + lu(541) = lu(541) - lu(385) * lu(533) + lu(542) = lu(542) - lu(386) * lu(533) + lu(543) = lu(543) - lu(387) * lu(533) + lu(544) = lu(544) - lu(388) * lu(533) + lu(545) = lu(545) - lu(389) * lu(533) + lu(546) = lu(546) - lu(390) * lu(533) + lu(559) = lu(559) - lu(378) * lu(558) + lu(560) = lu(560) - lu(379) * lu(558) + lu(561) = lu(561) - lu(380) * lu(558) + lu(562) = lu(562) - lu(381) * lu(558) + lu(563) = lu(563) - lu(382) * lu(558) + lu(564) = lu(564) - lu(383) * lu(558) + lu(565) = lu(565) - lu(384) * lu(558) + lu(566) = lu(566) - lu(385) * lu(558) + lu(567) = lu(567) - lu(386) * lu(558) + lu(568) = lu(568) - lu(387) * lu(558) + lu(569) = lu(569) - lu(388) * lu(558) + lu(570) = lu(570) - lu(389) * lu(558) + lu(571) = lu(571) - lu(390) * lu(558) + lu(590) = lu(590) - lu(378) * lu(589) + lu(591) = lu(591) - lu(379) * lu(589) + lu(592) = lu(592) - lu(380) * lu(589) + lu(593) = lu(593) - lu(381) * lu(589) + lu(594) = lu(594) - lu(382) * lu(589) + lu(595) = lu(595) - lu(383) * lu(589) + lu(596) = lu(596) - lu(384) * lu(589) + lu(597) = lu(597) - lu(385) * lu(589) + lu(598) = lu(598) - lu(386) * lu(589) + lu(599) = lu(599) - lu(387) * lu(589) + lu(600) = lu(600) - lu(388) * lu(589) + lu(601) = lu(601) - lu(389) * lu(589) + lu(602) = lu(602) - lu(390) * lu(589) + lu(615) = lu(615) - lu(378) * lu(614) + lu(616) = lu(616) - lu(379) * lu(614) + lu(617) = lu(617) - lu(380) * lu(614) + lu(618) = lu(618) - lu(381) * lu(614) + lu(619) = lu(619) - lu(382) * lu(614) + lu(620) = lu(620) - lu(383) * lu(614) + lu(621) = lu(621) - lu(384) * lu(614) + lu(622) = lu(622) - lu(385) * lu(614) + lu(623) = lu(623) - lu(386) * lu(614) + lu(624) = lu(624) - lu(387) * lu(614) + lu(625) = lu(625) - lu(388) * lu(614) + lu(626) = lu(626) - lu(389) * lu(614) + lu(627) = lu(627) - lu(390) * lu(614) + lu(634) = lu(634) - lu(378) * lu(633) + lu(635) = lu(635) - lu(379) * lu(633) + lu(636) = lu(636) - lu(380) * lu(633) + lu(637) = lu(637) - lu(381) * lu(633) + lu(638) = lu(638) - lu(382) * lu(633) + lu(639) = lu(639) - lu(383) * lu(633) + lu(640) = lu(640) - lu(384) * lu(633) + lu(641) = lu(641) - lu(385) * lu(633) + lu(642) = lu(642) - lu(386) * lu(633) + lu(643) = lu(643) - lu(387) * lu(633) + lu(644) = lu(644) - lu(388) * lu(633) + lu(645) = lu(645) - lu(389) * lu(633) + lu(646) = lu(646) - lu(390) * lu(633) + lu(658) = lu(658) - lu(378) * lu(657) + lu(659) = lu(659) - lu(379) * lu(657) + lu(660) = lu(660) - lu(380) * lu(657) + lu(661) = lu(661) - lu(381) * lu(657) + lu(662) = lu(662) - lu(382) * lu(657) + lu(663) = lu(663) - lu(383) * lu(657) + lu(664) = lu(664) - lu(384) * lu(657) + lu(665) = lu(665) - lu(385) * lu(657) + lu(666) = lu(666) - lu(386) * lu(657) + lu(667) = lu(667) - lu(387) * lu(657) + lu(668) = lu(668) - lu(388) * lu(657) + lu(669) = lu(669) - lu(389) * lu(657) + lu(670) = lu(670) - lu(390) * lu(657) + lu(682) = lu(682) - lu(378) * lu(681) + lu(683) = lu(683) - lu(379) * lu(681) + lu(684) = lu(684) - lu(380) * lu(681) + lu(685) = lu(685) - lu(381) * lu(681) + lu(686) = lu(686) - lu(382) * lu(681) + lu(687) = lu(687) - lu(383) * lu(681) + lu(688) = lu(688) - lu(384) * lu(681) + lu(689) = lu(689) - lu(385) * lu(681) + lu(690) = lu(690) - lu(386) * lu(681) + lu(691) = lu(691) - lu(387) * lu(681) + lu(692) = lu(692) - lu(388) * lu(681) + lu(693) = lu(693) - lu(389) * lu(681) + lu(694) = lu(694) - lu(390) * lu(681) + lu(723) = lu(723) - lu(378) * lu(722) + lu(724) = lu(724) - lu(379) * lu(722) + lu(725) = lu(725) - lu(380) * lu(722) + lu(726) = lu(726) - lu(381) * lu(722) + lu(727) = lu(727) - lu(382) * lu(722) + lu(728) = lu(728) - lu(383) * lu(722) + lu(729) = lu(729) - lu(384) * lu(722) + lu(730) = lu(730) - lu(385) * lu(722) + lu(731) = lu(731) - lu(386) * lu(722) + lu(732) = lu(732) - lu(387) * lu(722) + lu(733) = lu(733) - lu(388) * lu(722) + lu(734) = lu(734) - lu(389) * lu(722) + lu(735) = lu(735) - lu(390) * lu(722) + lu(399) = 1._r8 / lu(399) + lu(400) = lu(400) * lu(399) + lu(401) = lu(401) * lu(399) + lu(402) = lu(402) * lu(399) + lu(403) = lu(403) * lu(399) + lu(404) = lu(404) * lu(399) + lu(405) = lu(405) * lu(399) + lu(406) = lu(406) * lu(399) + lu(407) = lu(407) * lu(399) + lu(408) = lu(408) * lu(399) + lu(409) = lu(409) * lu(399) + lu(410) = lu(410) * lu(399) + lu(411) = lu(411) * lu(399) + lu(423) = lu(423) - lu(400) * lu(422) + lu(424) = lu(424) - lu(401) * lu(422) + lu(425) = lu(425) - lu(402) * lu(422) + lu(426) = lu(426) - lu(403) * lu(422) + lu(427) = lu(427) - lu(404) * lu(422) + lu(428) = lu(428) - lu(405) * lu(422) + lu(429) = lu(429) - lu(406) * lu(422) + lu(430) = lu(430) - lu(407) * lu(422) + lu(431) = lu(431) - lu(408) * lu(422) + lu(432) = lu(432) - lu(409) * lu(422) + lu(433) = lu(433) - lu(410) * lu(422) + lu(434) = lu(434) - lu(411) * lu(422) + lu(446) = lu(446) - lu(400) * lu(445) + lu(447) = lu(447) - lu(401) * lu(445) + lu(448) = lu(448) - lu(402) * lu(445) + lu(449) = lu(449) - lu(403) * lu(445) + lu(450) = lu(450) - lu(404) * lu(445) + lu(451) = lu(451) - lu(405) * lu(445) + lu(452) = lu(452) - lu(406) * lu(445) + lu(453) = lu(453) - lu(407) * lu(445) + lu(454) = lu(454) - lu(408) * lu(445) + lu(455) = lu(455) - lu(409) * lu(445) + lu(456) = lu(456) - lu(410) * lu(445) + lu(457) = lu(457) - lu(411) * lu(445) + lu(473) = lu(473) - lu(400) * lu(472) + lu(474) = lu(474) - lu(401) * lu(472) + lu(475) = lu(475) - lu(402) * lu(472) + lu(476) = lu(476) - lu(403) * lu(472) + lu(477) = lu(477) - lu(404) * lu(472) + lu(478) = lu(478) - lu(405) * lu(472) + lu(479) = lu(479) - lu(406) * lu(472) + lu(480) = lu(480) - lu(407) * lu(472) + lu(481) = lu(481) - lu(408) * lu(472) + lu(482) = lu(482) - lu(409) * lu(472) + lu(483) = lu(483) - lu(410) * lu(472) + lu(484) = lu(484) - lu(411) * lu(472) + lu(510) = lu(510) - lu(400) * lu(509) + lu(511) = lu(511) - lu(401) * lu(509) + lu(512) = lu(512) - lu(402) * lu(509) + lu(513) = lu(513) - lu(403) * lu(509) + lu(514) = lu(514) - lu(404) * lu(509) + lu(515) = lu(515) - lu(405) * lu(509) + lu(516) = lu(516) - lu(406) * lu(509) + lu(517) = lu(517) - lu(407) * lu(509) + lu(518) = lu(518) - lu(408) * lu(509) + lu(519) = lu(519) - lu(409) * lu(509) + lu(520) = lu(520) - lu(410) * lu(509) + lu(521) = lu(521) - lu(411) * lu(509) + lu(535) = lu(535) - lu(400) * lu(534) + lu(536) = lu(536) - lu(401) * lu(534) + lu(537) = lu(537) - lu(402) * lu(534) + lu(538) = lu(538) - lu(403) * lu(534) + lu(539) = lu(539) - lu(404) * lu(534) + lu(540) = lu(540) - lu(405) * lu(534) + lu(541) = lu(541) - lu(406) * lu(534) + lu(542) = lu(542) - lu(407) * lu(534) + lu(543) = lu(543) - lu(408) * lu(534) + lu(544) = lu(544) - lu(409) * lu(534) + lu(545) = lu(545) - lu(410) * lu(534) + lu(546) = lu(546) - lu(411) * lu(534) + lu(560) = lu(560) - lu(400) * lu(559) + lu(561) = lu(561) - lu(401) * lu(559) + lu(562) = lu(562) - lu(402) * lu(559) + lu(563) = lu(563) - lu(403) * lu(559) + lu(564) = lu(564) - lu(404) * lu(559) + lu(565) = lu(565) - lu(405) * lu(559) + lu(566) = lu(566) - lu(406) * lu(559) + lu(567) = lu(567) - lu(407) * lu(559) + lu(568) = lu(568) - lu(408) * lu(559) + lu(569) = lu(569) - lu(409) * lu(559) + lu(570) = lu(570) - lu(410) * lu(559) + lu(571) = lu(571) - lu(411) * lu(559) + lu(591) = lu(591) - lu(400) * lu(590) + lu(592) = lu(592) - lu(401) * lu(590) + lu(593) = lu(593) - lu(402) * lu(590) + lu(594) = lu(594) - lu(403) * lu(590) + lu(595) = lu(595) - lu(404) * lu(590) + lu(596) = lu(596) - lu(405) * lu(590) + lu(597) = lu(597) - lu(406) * lu(590) + lu(598) = lu(598) - lu(407) * lu(590) + lu(599) = lu(599) - lu(408) * lu(590) + lu(600) = lu(600) - lu(409) * lu(590) + lu(601) = lu(601) - lu(410) * lu(590) + lu(602) = lu(602) - lu(411) * lu(590) + lu(616) = lu(616) - lu(400) * lu(615) + lu(617) = lu(617) - lu(401) * lu(615) + lu(618) = lu(618) - lu(402) * lu(615) + lu(619) = lu(619) - lu(403) * lu(615) + lu(620) = lu(620) - lu(404) * lu(615) + lu(621) = lu(621) - lu(405) * lu(615) + lu(622) = lu(622) - lu(406) * lu(615) + lu(623) = lu(623) - lu(407) * lu(615) + lu(624) = lu(624) - lu(408) * lu(615) + lu(625) = lu(625) - lu(409) * lu(615) + lu(626) = lu(626) - lu(410) * lu(615) + lu(627) = lu(627) - lu(411) * lu(615) + lu(635) = lu(635) - lu(400) * lu(634) + lu(636) = lu(636) - lu(401) * lu(634) + lu(637) = lu(637) - lu(402) * lu(634) + lu(638) = lu(638) - lu(403) * lu(634) + lu(639) = lu(639) - lu(404) * lu(634) + lu(640) = lu(640) - lu(405) * lu(634) + lu(641) = lu(641) - lu(406) * lu(634) + lu(642) = lu(642) - lu(407) * lu(634) + lu(643) = lu(643) - lu(408) * lu(634) + lu(644) = lu(644) - lu(409) * lu(634) + lu(645) = lu(645) - lu(410) * lu(634) + lu(646) = lu(646) - lu(411) * lu(634) + lu(659) = lu(659) - lu(400) * lu(658) + lu(660) = lu(660) - lu(401) * lu(658) + lu(661) = lu(661) - lu(402) * lu(658) + lu(662) = lu(662) - lu(403) * lu(658) + lu(663) = lu(663) - lu(404) * lu(658) + lu(664) = lu(664) - lu(405) * lu(658) + lu(665) = lu(665) - lu(406) * lu(658) + lu(666) = lu(666) - lu(407) * lu(658) + lu(667) = lu(667) - lu(408) * lu(658) + lu(668) = lu(668) - lu(409) * lu(658) + lu(669) = lu(669) - lu(410) * lu(658) + lu(670) = lu(670) - lu(411) * lu(658) + lu(683) = lu(683) - lu(400) * lu(682) + lu(684) = lu(684) - lu(401) * lu(682) + lu(685) = lu(685) - lu(402) * lu(682) + lu(686) = lu(686) - lu(403) * lu(682) + lu(687) = lu(687) - lu(404) * lu(682) + lu(688) = lu(688) - lu(405) * lu(682) + lu(689) = lu(689) - lu(406) * lu(682) + lu(690) = lu(690) - lu(407) * lu(682) + lu(691) = lu(691) - lu(408) * lu(682) + lu(692) = lu(692) - lu(409) * lu(682) + lu(693) = lu(693) - lu(410) * lu(682) + lu(694) = lu(694) - lu(411) * lu(682) + lu(724) = lu(724) - lu(400) * lu(723) + lu(725) = lu(725) - lu(401) * lu(723) + lu(726) = lu(726) - lu(402) * lu(723) + lu(727) = lu(727) - lu(403) * lu(723) + lu(728) = lu(728) - lu(404) * lu(723) + lu(729) = lu(729) - lu(405) * lu(723) + lu(730) = lu(730) - lu(406) * lu(723) + lu(731) = lu(731) - lu(407) * lu(723) + lu(732) = lu(732) - lu(408) * lu(723) + lu(733) = lu(733) - lu(409) * lu(723) + lu(734) = lu(734) - lu(410) * lu(723) + lu(735) = lu(735) - lu(411) * lu(723) + end subroutine lu_fac09 + subroutine lu_fac10( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(423) = 1._r8 / lu(423) + lu(424) = lu(424) * lu(423) + lu(425) = lu(425) * lu(423) + lu(426) = lu(426) * lu(423) + lu(427) = lu(427) * lu(423) + lu(428) = lu(428) * lu(423) + lu(429) = lu(429) * lu(423) + lu(430) = lu(430) * lu(423) + lu(431) = lu(431) * lu(423) + lu(432) = lu(432) * lu(423) + lu(433) = lu(433) * lu(423) + lu(434) = lu(434) * lu(423) + lu(447) = lu(447) - lu(424) * lu(446) + lu(448) = lu(448) - lu(425) * lu(446) + lu(449) = lu(449) - lu(426) * lu(446) + lu(450) = lu(450) - lu(427) * lu(446) + lu(451) = lu(451) - lu(428) * lu(446) + lu(452) = lu(452) - lu(429) * lu(446) + lu(453) = lu(453) - lu(430) * lu(446) + lu(454) = lu(454) - lu(431) * lu(446) + lu(455) = lu(455) - lu(432) * lu(446) + lu(456) = lu(456) - lu(433) * lu(446) + lu(457) = lu(457) - lu(434) * lu(446) + lu(474) = lu(474) - lu(424) * lu(473) + lu(475) = lu(475) - lu(425) * lu(473) + lu(476) = lu(476) - lu(426) * lu(473) + lu(477) = lu(477) - lu(427) * lu(473) + lu(478) = lu(478) - lu(428) * lu(473) + lu(479) = lu(479) - lu(429) * lu(473) + lu(480) = lu(480) - lu(430) * lu(473) + lu(481) = lu(481) - lu(431) * lu(473) + lu(482) = lu(482) - lu(432) * lu(473) + lu(483) = lu(483) - lu(433) * lu(473) + lu(484) = lu(484) - lu(434) * lu(473) + lu(511) = lu(511) - lu(424) * lu(510) + lu(512) = lu(512) - lu(425) * lu(510) + lu(513) = lu(513) - lu(426) * lu(510) + lu(514) = lu(514) - lu(427) * lu(510) + lu(515) = lu(515) - lu(428) * lu(510) + lu(516) = lu(516) - lu(429) * lu(510) + lu(517) = lu(517) - lu(430) * lu(510) + lu(518) = lu(518) - lu(431) * lu(510) + lu(519) = lu(519) - lu(432) * lu(510) + lu(520) = lu(520) - lu(433) * lu(510) + lu(521) = lu(521) - lu(434) * lu(510) + lu(536) = lu(536) - lu(424) * lu(535) + lu(537) = lu(537) - lu(425) * lu(535) + lu(538) = lu(538) - lu(426) * lu(535) + lu(539) = lu(539) - lu(427) * lu(535) + lu(540) = lu(540) - lu(428) * lu(535) + lu(541) = lu(541) - lu(429) * lu(535) + lu(542) = lu(542) - lu(430) * lu(535) + lu(543) = lu(543) - lu(431) * lu(535) + lu(544) = lu(544) - lu(432) * lu(535) + lu(545) = lu(545) - lu(433) * lu(535) + lu(546) = lu(546) - lu(434) * lu(535) + lu(561) = lu(561) - lu(424) * lu(560) + lu(562) = lu(562) - lu(425) * lu(560) + lu(563) = lu(563) - lu(426) * lu(560) + lu(564) = lu(564) - lu(427) * lu(560) + lu(565) = lu(565) - lu(428) * lu(560) + lu(566) = lu(566) - lu(429) * lu(560) + lu(567) = lu(567) - lu(430) * lu(560) + lu(568) = lu(568) - lu(431) * lu(560) + lu(569) = lu(569) - lu(432) * lu(560) + lu(570) = lu(570) - lu(433) * lu(560) + lu(571) = lu(571) - lu(434) * lu(560) + lu(592) = lu(592) - lu(424) * lu(591) + lu(593) = lu(593) - lu(425) * lu(591) + lu(594) = lu(594) - lu(426) * lu(591) + lu(595) = lu(595) - lu(427) * lu(591) + lu(596) = lu(596) - lu(428) * lu(591) + lu(597) = lu(597) - lu(429) * lu(591) + lu(598) = lu(598) - lu(430) * lu(591) + lu(599) = lu(599) - lu(431) * lu(591) + lu(600) = lu(600) - lu(432) * lu(591) + lu(601) = lu(601) - lu(433) * lu(591) + lu(602) = lu(602) - lu(434) * lu(591) + lu(617) = lu(617) - lu(424) * lu(616) + lu(618) = lu(618) - lu(425) * lu(616) + lu(619) = lu(619) - lu(426) * lu(616) + lu(620) = lu(620) - lu(427) * lu(616) + lu(621) = lu(621) - lu(428) * lu(616) + lu(622) = lu(622) - lu(429) * lu(616) + lu(623) = lu(623) - lu(430) * lu(616) + lu(624) = lu(624) - lu(431) * lu(616) + lu(625) = lu(625) - lu(432) * lu(616) + lu(626) = lu(626) - lu(433) * lu(616) + lu(627) = lu(627) - lu(434) * lu(616) + lu(636) = lu(636) - lu(424) * lu(635) + lu(637) = lu(637) - lu(425) * lu(635) + lu(638) = lu(638) - lu(426) * lu(635) + lu(639) = lu(639) - lu(427) * lu(635) + lu(640) = lu(640) - lu(428) * lu(635) + lu(641) = lu(641) - lu(429) * lu(635) + lu(642) = lu(642) - lu(430) * lu(635) + lu(643) = lu(643) - lu(431) * lu(635) + lu(644) = lu(644) - lu(432) * lu(635) + lu(645) = lu(645) - lu(433) * lu(635) + lu(646) = lu(646) - lu(434) * lu(635) + lu(660) = lu(660) - lu(424) * lu(659) + lu(661) = lu(661) - lu(425) * lu(659) + lu(662) = lu(662) - lu(426) * lu(659) + lu(663) = lu(663) - lu(427) * lu(659) + lu(664) = lu(664) - lu(428) * lu(659) + lu(665) = lu(665) - lu(429) * lu(659) + lu(666) = lu(666) - lu(430) * lu(659) + lu(667) = lu(667) - lu(431) * lu(659) + lu(668) = lu(668) - lu(432) * lu(659) + lu(669) = lu(669) - lu(433) * lu(659) + lu(670) = lu(670) - lu(434) * lu(659) + lu(684) = lu(684) - lu(424) * lu(683) + lu(685) = lu(685) - lu(425) * lu(683) + lu(686) = lu(686) - lu(426) * lu(683) + lu(687) = lu(687) - lu(427) * lu(683) + lu(688) = lu(688) - lu(428) * lu(683) + lu(689) = lu(689) - lu(429) * lu(683) + lu(690) = lu(690) - lu(430) * lu(683) + lu(691) = lu(691) - lu(431) * lu(683) + lu(692) = lu(692) - lu(432) * lu(683) + lu(693) = lu(693) - lu(433) * lu(683) + lu(694) = lu(694) - lu(434) * lu(683) + lu(725) = lu(725) - lu(424) * lu(724) + lu(726) = lu(726) - lu(425) * lu(724) + lu(727) = lu(727) - lu(426) * lu(724) + lu(728) = lu(728) - lu(427) * lu(724) + lu(729) = lu(729) - lu(428) * lu(724) + lu(730) = lu(730) - lu(429) * lu(724) + lu(731) = lu(731) - lu(430) * lu(724) + lu(732) = lu(732) - lu(431) * lu(724) + lu(733) = lu(733) - lu(432) * lu(724) + lu(734) = lu(734) - lu(433) * lu(724) + lu(735) = lu(735) - lu(434) * lu(724) + lu(447) = 1._r8 / lu(447) + lu(448) = lu(448) * lu(447) + lu(449) = lu(449) * lu(447) + lu(450) = lu(450) * lu(447) + lu(451) = lu(451) * lu(447) + lu(452) = lu(452) * lu(447) + lu(453) = lu(453) * lu(447) + lu(454) = lu(454) * lu(447) + lu(455) = lu(455) * lu(447) + lu(456) = lu(456) * lu(447) + lu(457) = lu(457) * lu(447) + lu(475) = lu(475) - lu(448) * lu(474) + lu(476) = lu(476) - lu(449) * lu(474) + lu(477) = lu(477) - lu(450) * lu(474) + lu(478) = lu(478) - lu(451) * lu(474) + lu(479) = lu(479) - lu(452) * lu(474) + lu(480) = lu(480) - lu(453) * lu(474) + lu(481) = lu(481) - lu(454) * lu(474) + lu(482) = lu(482) - lu(455) * lu(474) + lu(483) = lu(483) - lu(456) * lu(474) + lu(484) = lu(484) - lu(457) * lu(474) + lu(512) = lu(512) - lu(448) * lu(511) + lu(513) = lu(513) - lu(449) * lu(511) + lu(514) = lu(514) - lu(450) * lu(511) + lu(515) = lu(515) - lu(451) * lu(511) + lu(516) = lu(516) - lu(452) * lu(511) + lu(517) = lu(517) - lu(453) * lu(511) + lu(518) = lu(518) - lu(454) * lu(511) + lu(519) = lu(519) - lu(455) * lu(511) + lu(520) = lu(520) - lu(456) * lu(511) + lu(521) = lu(521) - lu(457) * lu(511) + lu(537) = lu(537) - lu(448) * lu(536) + lu(538) = lu(538) - lu(449) * lu(536) + lu(539) = lu(539) - lu(450) * lu(536) + lu(540) = lu(540) - lu(451) * lu(536) + lu(541) = lu(541) - lu(452) * lu(536) + lu(542) = lu(542) - lu(453) * lu(536) + lu(543) = lu(543) - lu(454) * lu(536) + lu(544) = lu(544) - lu(455) * lu(536) + lu(545) = lu(545) - lu(456) * lu(536) + lu(546) = lu(546) - lu(457) * lu(536) + lu(562) = lu(562) - lu(448) * lu(561) + lu(563) = lu(563) - lu(449) * lu(561) + lu(564) = lu(564) - lu(450) * lu(561) + lu(565) = lu(565) - lu(451) * lu(561) + lu(566) = lu(566) - lu(452) * lu(561) + lu(567) = lu(567) - lu(453) * lu(561) + lu(568) = lu(568) - lu(454) * lu(561) + lu(569) = lu(569) - lu(455) * lu(561) + lu(570) = lu(570) - lu(456) * lu(561) + lu(571) = lu(571) - lu(457) * lu(561) + lu(593) = lu(593) - lu(448) * lu(592) + lu(594) = lu(594) - lu(449) * lu(592) + lu(595) = lu(595) - lu(450) * lu(592) + lu(596) = lu(596) - lu(451) * lu(592) + lu(597) = lu(597) - lu(452) * lu(592) + lu(598) = lu(598) - lu(453) * lu(592) + lu(599) = lu(599) - lu(454) * lu(592) + lu(600) = lu(600) - lu(455) * lu(592) + lu(601) = lu(601) - lu(456) * lu(592) + lu(602) = lu(602) - lu(457) * lu(592) + lu(618) = lu(618) - lu(448) * lu(617) + lu(619) = lu(619) - lu(449) * lu(617) + lu(620) = lu(620) - lu(450) * lu(617) + lu(621) = lu(621) - lu(451) * lu(617) + lu(622) = lu(622) - lu(452) * lu(617) + lu(623) = lu(623) - lu(453) * lu(617) + lu(624) = lu(624) - lu(454) * lu(617) + lu(625) = lu(625) - lu(455) * lu(617) + lu(626) = lu(626) - lu(456) * lu(617) + lu(627) = lu(627) - lu(457) * lu(617) + lu(637) = lu(637) - lu(448) * lu(636) + lu(638) = lu(638) - lu(449) * lu(636) + lu(639) = lu(639) - lu(450) * lu(636) + lu(640) = lu(640) - lu(451) * lu(636) + lu(641) = lu(641) - lu(452) * lu(636) + lu(642) = lu(642) - lu(453) * lu(636) + lu(643) = lu(643) - lu(454) * lu(636) + lu(644) = lu(644) - lu(455) * lu(636) + lu(645) = lu(645) - lu(456) * lu(636) + lu(646) = lu(646) - lu(457) * lu(636) + lu(661) = lu(661) - lu(448) * lu(660) + lu(662) = lu(662) - lu(449) * lu(660) + lu(663) = lu(663) - lu(450) * lu(660) + lu(664) = lu(664) - lu(451) * lu(660) + lu(665) = lu(665) - lu(452) * lu(660) + lu(666) = lu(666) - lu(453) * lu(660) + lu(667) = lu(667) - lu(454) * lu(660) + lu(668) = lu(668) - lu(455) * lu(660) + lu(669) = lu(669) - lu(456) * lu(660) + lu(670) = lu(670) - lu(457) * lu(660) + lu(685) = lu(685) - lu(448) * lu(684) + lu(686) = lu(686) - lu(449) * lu(684) + lu(687) = lu(687) - lu(450) * lu(684) + lu(688) = lu(688) - lu(451) * lu(684) + lu(689) = lu(689) - lu(452) * lu(684) + lu(690) = lu(690) - lu(453) * lu(684) + lu(691) = lu(691) - lu(454) * lu(684) + lu(692) = lu(692) - lu(455) * lu(684) + lu(693) = lu(693) - lu(456) * lu(684) + lu(694) = lu(694) - lu(457) * lu(684) + lu(726) = lu(726) - lu(448) * lu(725) + lu(727) = lu(727) - lu(449) * lu(725) + lu(728) = lu(728) - lu(450) * lu(725) + lu(729) = lu(729) - lu(451) * lu(725) + lu(730) = lu(730) - lu(452) * lu(725) + lu(731) = lu(731) - lu(453) * lu(725) + lu(732) = lu(732) - lu(454) * lu(725) + lu(733) = lu(733) - lu(455) * lu(725) + lu(734) = lu(734) - lu(456) * lu(725) + lu(735) = lu(735) - lu(457) * lu(725) + lu(475) = 1._r8 / lu(475) + lu(476) = lu(476) * lu(475) + lu(477) = lu(477) * lu(475) + lu(478) = lu(478) * lu(475) + lu(479) = lu(479) * lu(475) + lu(480) = lu(480) * lu(475) + lu(481) = lu(481) * lu(475) + lu(482) = lu(482) * lu(475) + lu(483) = lu(483) * lu(475) + lu(484) = lu(484) * lu(475) + lu(513) = lu(513) - lu(476) * lu(512) + lu(514) = lu(514) - lu(477) * lu(512) + lu(515) = lu(515) - lu(478) * lu(512) + lu(516) = lu(516) - lu(479) * lu(512) + lu(517) = lu(517) - lu(480) * lu(512) + lu(518) = lu(518) - lu(481) * lu(512) + lu(519) = lu(519) - lu(482) * lu(512) + lu(520) = lu(520) - lu(483) * lu(512) + lu(521) = lu(521) - lu(484) * lu(512) + lu(538) = lu(538) - lu(476) * lu(537) + lu(539) = lu(539) - lu(477) * lu(537) + lu(540) = lu(540) - lu(478) * lu(537) + lu(541) = lu(541) - lu(479) * lu(537) + lu(542) = lu(542) - lu(480) * lu(537) + lu(543) = lu(543) - lu(481) * lu(537) + lu(544) = lu(544) - lu(482) * lu(537) + lu(545) = lu(545) - lu(483) * lu(537) + lu(546) = lu(546) - lu(484) * lu(537) + lu(563) = lu(563) - lu(476) * lu(562) + lu(564) = lu(564) - lu(477) * lu(562) + lu(565) = lu(565) - lu(478) * lu(562) + lu(566) = lu(566) - lu(479) * lu(562) + lu(567) = lu(567) - lu(480) * lu(562) + lu(568) = lu(568) - lu(481) * lu(562) + lu(569) = lu(569) - lu(482) * lu(562) + lu(570) = lu(570) - lu(483) * lu(562) + lu(571) = lu(571) - lu(484) * lu(562) + lu(594) = lu(594) - lu(476) * lu(593) + lu(595) = lu(595) - lu(477) * lu(593) + lu(596) = lu(596) - lu(478) * lu(593) + lu(597) = lu(597) - lu(479) * lu(593) + lu(598) = lu(598) - lu(480) * lu(593) + lu(599) = lu(599) - lu(481) * lu(593) + lu(600) = lu(600) - lu(482) * lu(593) + lu(601) = lu(601) - lu(483) * lu(593) + lu(602) = lu(602) - lu(484) * lu(593) + lu(619) = lu(619) - lu(476) * lu(618) + lu(620) = lu(620) - lu(477) * lu(618) + lu(621) = lu(621) - lu(478) * lu(618) + lu(622) = lu(622) - lu(479) * lu(618) + lu(623) = lu(623) - lu(480) * lu(618) + lu(624) = lu(624) - lu(481) * lu(618) + lu(625) = lu(625) - lu(482) * lu(618) + lu(626) = lu(626) - lu(483) * lu(618) + lu(627) = lu(627) - lu(484) * lu(618) + lu(638) = lu(638) - lu(476) * lu(637) + lu(639) = lu(639) - lu(477) * lu(637) + lu(640) = lu(640) - lu(478) * lu(637) + lu(641) = lu(641) - lu(479) * lu(637) + lu(642) = lu(642) - lu(480) * lu(637) + lu(643) = lu(643) - lu(481) * lu(637) + lu(644) = lu(644) - lu(482) * lu(637) + lu(645) = lu(645) - lu(483) * lu(637) + lu(646) = lu(646) - lu(484) * lu(637) + lu(662) = lu(662) - lu(476) * lu(661) + lu(663) = lu(663) - lu(477) * lu(661) + lu(664) = lu(664) - lu(478) * lu(661) + lu(665) = lu(665) - lu(479) * lu(661) + lu(666) = lu(666) - lu(480) * lu(661) + lu(667) = lu(667) - lu(481) * lu(661) + lu(668) = lu(668) - lu(482) * lu(661) + lu(669) = lu(669) - lu(483) * lu(661) + lu(670) = lu(670) - lu(484) * lu(661) + lu(686) = lu(686) - lu(476) * lu(685) + lu(687) = lu(687) - lu(477) * lu(685) + lu(688) = lu(688) - lu(478) * lu(685) + lu(689) = lu(689) - lu(479) * lu(685) + lu(690) = lu(690) - lu(480) * lu(685) + lu(691) = lu(691) - lu(481) * lu(685) + lu(692) = lu(692) - lu(482) * lu(685) + lu(693) = lu(693) - lu(483) * lu(685) + lu(694) = lu(694) - lu(484) * lu(685) + lu(727) = lu(727) - lu(476) * lu(726) + lu(728) = lu(728) - lu(477) * lu(726) + lu(729) = lu(729) - lu(478) * lu(726) + lu(730) = lu(730) - lu(479) * lu(726) + lu(731) = lu(731) - lu(480) * lu(726) + lu(732) = lu(732) - lu(481) * lu(726) + lu(733) = lu(733) - lu(482) * lu(726) + lu(734) = lu(734) - lu(483) * lu(726) + lu(735) = lu(735) - lu(484) * lu(726) + lu(513) = 1._r8 / lu(513) + lu(514) = lu(514) * lu(513) + lu(515) = lu(515) * lu(513) + lu(516) = lu(516) * lu(513) + lu(517) = lu(517) * lu(513) + lu(518) = lu(518) * lu(513) + lu(519) = lu(519) * lu(513) + lu(520) = lu(520) * lu(513) + lu(521) = lu(521) * lu(513) + lu(539) = lu(539) - lu(514) * lu(538) + lu(540) = lu(540) - lu(515) * lu(538) + lu(541) = lu(541) - lu(516) * lu(538) + lu(542) = lu(542) - lu(517) * lu(538) + lu(543) = lu(543) - lu(518) * lu(538) + lu(544) = lu(544) - lu(519) * lu(538) + lu(545) = lu(545) - lu(520) * lu(538) + lu(546) = lu(546) - lu(521) * lu(538) + lu(564) = lu(564) - lu(514) * lu(563) + lu(565) = lu(565) - lu(515) * lu(563) + lu(566) = lu(566) - lu(516) * lu(563) + lu(567) = lu(567) - lu(517) * lu(563) + lu(568) = lu(568) - lu(518) * lu(563) + lu(569) = lu(569) - lu(519) * lu(563) + lu(570) = lu(570) - lu(520) * lu(563) + lu(571) = lu(571) - lu(521) * lu(563) + lu(595) = lu(595) - lu(514) * lu(594) + lu(596) = lu(596) - lu(515) * lu(594) + lu(597) = lu(597) - lu(516) * lu(594) + lu(598) = lu(598) - lu(517) * lu(594) + lu(599) = lu(599) - lu(518) * lu(594) + lu(600) = lu(600) - lu(519) * lu(594) + lu(601) = lu(601) - lu(520) * lu(594) + lu(602) = lu(602) - lu(521) * lu(594) + lu(620) = lu(620) - lu(514) * lu(619) + lu(621) = lu(621) - lu(515) * lu(619) + lu(622) = lu(622) - lu(516) * lu(619) + lu(623) = lu(623) - lu(517) * lu(619) + lu(624) = lu(624) - lu(518) * lu(619) + lu(625) = lu(625) - lu(519) * lu(619) + lu(626) = lu(626) - lu(520) * lu(619) + lu(627) = lu(627) - lu(521) * lu(619) + lu(639) = lu(639) - lu(514) * lu(638) + lu(640) = lu(640) - lu(515) * lu(638) + lu(641) = lu(641) - lu(516) * lu(638) + lu(642) = lu(642) - lu(517) * lu(638) + lu(643) = lu(643) - lu(518) * lu(638) + lu(644) = lu(644) - lu(519) * lu(638) + lu(645) = lu(645) - lu(520) * lu(638) + lu(646) = lu(646) - lu(521) * lu(638) + lu(663) = lu(663) - lu(514) * lu(662) + lu(664) = lu(664) - lu(515) * lu(662) + lu(665) = lu(665) - lu(516) * lu(662) + lu(666) = lu(666) - lu(517) * lu(662) + lu(667) = lu(667) - lu(518) * lu(662) + lu(668) = lu(668) - lu(519) * lu(662) + lu(669) = lu(669) - lu(520) * lu(662) + lu(670) = lu(670) - lu(521) * lu(662) + lu(687) = lu(687) - lu(514) * lu(686) + lu(688) = lu(688) - lu(515) * lu(686) + lu(689) = lu(689) - lu(516) * lu(686) + lu(690) = lu(690) - lu(517) * lu(686) + lu(691) = lu(691) - lu(518) * lu(686) + lu(692) = lu(692) - lu(519) * lu(686) + lu(693) = lu(693) - lu(520) * lu(686) + lu(694) = lu(694) - lu(521) * lu(686) + lu(728) = lu(728) - lu(514) * lu(727) + lu(729) = lu(729) - lu(515) * lu(727) + lu(730) = lu(730) - lu(516) * lu(727) + lu(731) = lu(731) - lu(517) * lu(727) + lu(732) = lu(732) - lu(518) * lu(727) + lu(733) = lu(733) - lu(519) * lu(727) + lu(734) = lu(734) - lu(520) * lu(727) + lu(735) = lu(735) - lu(521) * lu(727) + lu(539) = 1._r8 / lu(539) + lu(540) = lu(540) * lu(539) + lu(541) = lu(541) * lu(539) + lu(542) = lu(542) * lu(539) + lu(543) = lu(543) * lu(539) + lu(544) = lu(544) * lu(539) + lu(545) = lu(545) * lu(539) + lu(546) = lu(546) * lu(539) + lu(565) = lu(565) - lu(540) * lu(564) + lu(566) = lu(566) - lu(541) * lu(564) + lu(567) = lu(567) - lu(542) * lu(564) + lu(568) = lu(568) - lu(543) * lu(564) + lu(569) = lu(569) - lu(544) * lu(564) + lu(570) = lu(570) - lu(545) * lu(564) + lu(571) = lu(571) - lu(546) * lu(564) + lu(596) = lu(596) - lu(540) * lu(595) + lu(597) = lu(597) - lu(541) * lu(595) + lu(598) = lu(598) - lu(542) * lu(595) + lu(599) = lu(599) - lu(543) * lu(595) + lu(600) = lu(600) - lu(544) * lu(595) + lu(601) = lu(601) - lu(545) * lu(595) + lu(602) = lu(602) - lu(546) * lu(595) + lu(621) = lu(621) - lu(540) * lu(620) + lu(622) = lu(622) - lu(541) * lu(620) + lu(623) = lu(623) - lu(542) * lu(620) + lu(624) = lu(624) - lu(543) * lu(620) + lu(625) = lu(625) - lu(544) * lu(620) + lu(626) = lu(626) - lu(545) * lu(620) + lu(627) = lu(627) - lu(546) * lu(620) + lu(640) = lu(640) - lu(540) * lu(639) + lu(641) = lu(641) - lu(541) * lu(639) + lu(642) = lu(642) - lu(542) * lu(639) + lu(643) = lu(643) - lu(543) * lu(639) + lu(644) = lu(644) - lu(544) * lu(639) + lu(645) = lu(645) - lu(545) * lu(639) + lu(646) = lu(646) - lu(546) * lu(639) + lu(664) = lu(664) - lu(540) * lu(663) + lu(665) = lu(665) - lu(541) * lu(663) + lu(666) = lu(666) - lu(542) * lu(663) + lu(667) = lu(667) - lu(543) * lu(663) + lu(668) = lu(668) - lu(544) * lu(663) + lu(669) = lu(669) - lu(545) * lu(663) + lu(670) = lu(670) - lu(546) * lu(663) + lu(688) = lu(688) - lu(540) * lu(687) + lu(689) = lu(689) - lu(541) * lu(687) + lu(690) = lu(690) - lu(542) * lu(687) + lu(691) = lu(691) - lu(543) * lu(687) + lu(692) = lu(692) - lu(544) * lu(687) + lu(693) = lu(693) - lu(545) * lu(687) + lu(694) = lu(694) - lu(546) * lu(687) + lu(729) = lu(729) - lu(540) * lu(728) + lu(730) = lu(730) - lu(541) * lu(728) + lu(731) = lu(731) - lu(542) * lu(728) + lu(732) = lu(732) - lu(543) * lu(728) + lu(733) = lu(733) - lu(544) * lu(728) + lu(734) = lu(734) - lu(545) * lu(728) + lu(735) = lu(735) - lu(546) * lu(728) + lu(565) = 1._r8 / lu(565) + lu(566) = lu(566) * lu(565) + lu(567) = lu(567) * lu(565) + lu(568) = lu(568) * lu(565) + lu(569) = lu(569) * lu(565) + lu(570) = lu(570) * lu(565) + lu(571) = lu(571) * lu(565) + lu(597) = lu(597) - lu(566) * lu(596) + lu(598) = lu(598) - lu(567) * lu(596) + lu(599) = lu(599) - lu(568) * lu(596) + lu(600) = lu(600) - lu(569) * lu(596) + lu(601) = lu(601) - lu(570) * lu(596) + lu(602) = lu(602) - lu(571) * lu(596) + lu(622) = lu(622) - lu(566) * lu(621) + lu(623) = lu(623) - lu(567) * lu(621) + lu(624) = lu(624) - lu(568) * lu(621) + lu(625) = lu(625) - lu(569) * lu(621) + lu(626) = lu(626) - lu(570) * lu(621) + lu(627) = lu(627) - lu(571) * lu(621) + lu(641) = lu(641) - lu(566) * lu(640) + lu(642) = lu(642) - lu(567) * lu(640) + lu(643) = lu(643) - lu(568) * lu(640) + lu(644) = lu(644) - lu(569) * lu(640) + lu(645) = lu(645) - lu(570) * lu(640) + lu(646) = lu(646) - lu(571) * lu(640) + lu(665) = lu(665) - lu(566) * lu(664) + lu(666) = lu(666) - lu(567) * lu(664) + lu(667) = lu(667) - lu(568) * lu(664) + lu(668) = lu(668) - lu(569) * lu(664) + lu(669) = lu(669) - lu(570) * lu(664) + lu(670) = lu(670) - lu(571) * lu(664) + lu(689) = lu(689) - lu(566) * lu(688) + lu(690) = lu(690) - lu(567) * lu(688) + lu(691) = lu(691) - lu(568) * lu(688) + lu(692) = lu(692) - lu(569) * lu(688) + lu(693) = lu(693) - lu(570) * lu(688) + lu(694) = lu(694) - lu(571) * lu(688) + lu(730) = lu(730) - lu(566) * lu(729) + lu(731) = lu(731) - lu(567) * lu(729) + lu(732) = lu(732) - lu(568) * lu(729) + lu(733) = lu(733) - lu(569) * lu(729) + lu(734) = lu(734) - lu(570) * lu(729) + lu(735) = lu(735) - lu(571) * lu(729) + end subroutine lu_fac10 + subroutine lu_fac11( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(597) = 1._r8 / lu(597) + lu(598) = lu(598) * lu(597) + lu(599) = lu(599) * lu(597) + lu(600) = lu(600) * lu(597) + lu(601) = lu(601) * lu(597) + lu(602) = lu(602) * lu(597) + lu(623) = lu(623) - lu(598) * lu(622) + lu(624) = lu(624) - lu(599) * lu(622) + lu(625) = lu(625) - lu(600) * lu(622) + lu(626) = lu(626) - lu(601) * lu(622) + lu(627) = lu(627) - lu(602) * lu(622) + lu(642) = lu(642) - lu(598) * lu(641) + lu(643) = lu(643) - lu(599) * lu(641) + lu(644) = lu(644) - lu(600) * lu(641) + lu(645) = lu(645) - lu(601) * lu(641) + lu(646) = lu(646) - lu(602) * lu(641) + lu(666) = lu(666) - lu(598) * lu(665) + lu(667) = lu(667) - lu(599) * lu(665) + lu(668) = lu(668) - lu(600) * lu(665) + lu(669) = lu(669) - lu(601) * lu(665) + lu(670) = lu(670) - lu(602) * lu(665) + lu(690) = lu(690) - lu(598) * lu(689) + lu(691) = lu(691) - lu(599) * lu(689) + lu(692) = lu(692) - lu(600) * lu(689) + lu(693) = lu(693) - lu(601) * lu(689) + lu(694) = lu(694) - lu(602) * lu(689) + lu(731) = lu(731) - lu(598) * lu(730) + lu(732) = lu(732) - lu(599) * lu(730) + lu(733) = lu(733) - lu(600) * lu(730) + lu(734) = lu(734) - lu(601) * lu(730) + lu(735) = lu(735) - lu(602) * lu(730) + lu(623) = 1._r8 / lu(623) + lu(624) = lu(624) * lu(623) + lu(625) = lu(625) * lu(623) + lu(626) = lu(626) * lu(623) + lu(627) = lu(627) * lu(623) + lu(643) = lu(643) - lu(624) * lu(642) + lu(644) = lu(644) - lu(625) * lu(642) + lu(645) = lu(645) - lu(626) * lu(642) + lu(646) = lu(646) - lu(627) * lu(642) + lu(667) = lu(667) - lu(624) * lu(666) + lu(668) = lu(668) - lu(625) * lu(666) + lu(669) = lu(669) - lu(626) * lu(666) + lu(670) = lu(670) - lu(627) * lu(666) + lu(691) = lu(691) - lu(624) * lu(690) + lu(692) = lu(692) - lu(625) * lu(690) + lu(693) = lu(693) - lu(626) * lu(690) + lu(694) = lu(694) - lu(627) * lu(690) + lu(732) = lu(732) - lu(624) * lu(731) + lu(733) = lu(733) - lu(625) * lu(731) + lu(734) = lu(734) - lu(626) * lu(731) + lu(735) = lu(735) - lu(627) * lu(731) + lu(643) = 1._r8 / lu(643) + lu(644) = lu(644) * lu(643) + lu(645) = lu(645) * lu(643) + lu(646) = lu(646) * lu(643) + lu(668) = lu(668) - lu(644) * lu(667) + lu(669) = lu(669) - lu(645) * lu(667) + lu(670) = lu(670) - lu(646) * lu(667) + lu(692) = lu(692) - lu(644) * lu(691) + lu(693) = lu(693) - lu(645) * lu(691) + lu(694) = lu(694) - lu(646) * lu(691) + lu(733) = lu(733) - lu(644) * lu(732) + lu(734) = lu(734) - lu(645) * lu(732) + lu(735) = lu(735) - lu(646) * lu(732) + lu(668) = 1._r8 / lu(668) + lu(669) = lu(669) * lu(668) + lu(670) = lu(670) * lu(668) + lu(693) = lu(693) - lu(669) * lu(692) + lu(694) = lu(694) - lu(670) * lu(692) + lu(734) = lu(734) - lu(669) * lu(733) + lu(735) = lu(735) - lu(670) * lu(733) + lu(693) = 1._r8 / lu(693) + lu(694) = lu(694) * lu(693) + lu(735) = lu(735) - lu(694) * lu(734) + lu(735) = 1._r8 / lu(735) + end subroutine lu_fac11 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..0279155536 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 @@ -0,0 +1,821 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(61) = b(61) - lu(22) * b(21) + b(62) = b(62) - lu(23) * b(21) + b(45) = b(45) - lu(25) * b(22) + b(74) = b(74) - lu(26) * b(22) + b(30) = b(30) - lu(28) * b(23) + b(69) = b(69) - lu(29) * b(23) + b(70) = b(70) - lu(31) * b(24) + b(70) = b(70) - lu(34) * b(25) + b(61) = b(61) - lu(36) * b(26) + b(45) = b(45) - lu(38) * b(27) + b(61) = b(61) - lu(39) * b(27) + b(74) = b(74) - lu(40) * b(27) + b(61) = b(61) - lu(42) * b(28) + b(63) = b(63) - lu(43) * b(28) + b(45) = b(45) - lu(45) * b(29) + b(57) = b(57) - lu(46) * b(29) + b(53) = b(53) - lu(49) * b(30) + b(69) = b(69) - lu(50) * b(30) + b(75) = b(75) - lu(51) * b(30) + b(53) = b(53) - lu(53) * b(31) + b(55) = b(55) - lu(54) * b(31) + b(67) = b(67) - lu(55) * b(31) + b(68) = b(68) - lu(56) * b(31) + b(71) = b(71) - lu(57) * b(31) + b(55) = b(55) - lu(59) * b(32) + b(65) = b(65) - lu(60) * b(32) + b(66) = b(66) - lu(61) * b(32) + b(68) = b(68) - lu(62) * b(32) + b(75) = b(75) - lu(63) * b(32) + b(53) = b(53) - lu(65) * b(33) + b(56) = b(56) - lu(66) * b(33) + b(62) = b(62) - lu(67) * b(33) + b(75) = b(75) - lu(68) * b(33) + b(39) = b(39) - lu(70) * b(34) + b(43) = b(43) - lu(71) * b(34) + b(53) = b(53) - lu(72) * b(34) + b(56) = b(56) - lu(73) * b(34) + b(57) = b(57) - lu(74) * b(34) + b(67) = b(67) - lu(75) * b(34) + b(75) = b(75) - lu(76) * b(34) + b(57) = b(57) - lu(78) * b(35) + b(58) = b(58) - lu(79) * b(35) + b(67) = b(67) - lu(80) * b(35) + b(69) = b(69) - lu(81) * b(35) + b(72) = b(72) - lu(82) * b(35) + b(44) = b(44) - lu(84) * b(36) + b(46) = b(46) - lu(85) * b(36) + b(47) = b(47) - lu(86) * b(36) + b(51) = b(51) - lu(87) * b(36) + b(70) = b(70) - lu(88) * b(36) + b(75) = b(75) - lu(89) * b(36) + b(66) = b(66) - lu(91) * b(37) + b(67) = b(67) - lu(92) * b(37) + b(68) = b(68) - lu(93) * b(37) + b(69) = b(69) - lu(94) * b(37) + b(70) = b(70) - lu(95) * b(37) + b(71) = b(71) - lu(96) * b(37) + b(51) = b(51) - lu(98) * b(38) + b(65) = b(65) - lu(99) * b(38) + b(70) = b(70) - lu(100) * b(38) + b(74) = b(74) - lu(101) * b(38) + b(57) = b(57) - lu(103) * b(39) + b(67) = b(67) - lu(104) * b(39) + b(71) = b(71) - lu(105) * b(39) + b(49) = b(49) - lu(107) * b(40) + b(55) = b(55) - lu(108) * b(40) + b(59) = b(59) - lu(109) * b(40) + b(63) = b(63) - lu(110) * b(40) + b(66) = b(66) - lu(111) * b(40) + b(68) = b(68) - lu(112) * b(40) + b(75) = b(75) - lu(113) * b(40) + b(61) = b(61) - lu(115) * b(41) + b(67) = b(67) - lu(116) * b(41) + b(69) = b(69) - lu(117) * b(41) + b(71) = b(71) - lu(118) * b(41) + b(73) = b(73) - lu(119) * b(41) + b(75) = b(75) - lu(120) * b(41) + b(44) = b(44) - lu(123) * b(42) + b(46) = b(46) - lu(124) * b(42) + b(47) = b(47) - lu(125) * b(42) + b(48) = b(48) - lu(126) * b(42) + b(51) = b(51) - lu(127) * b(42) + b(65) = b(65) - lu(128) * b(42) + b(70) = b(70) - lu(129) * b(42) + b(74) = b(74) - lu(130) * b(42) + b(75) = b(75) - lu(131) * b(42) + b(56) = b(56) - lu(133) * b(43) + b(57) = b(57) - lu(134) * b(43) + b(64) = b(64) - lu(135) * b(43) + b(67) = b(67) - lu(136) * b(43) + b(70) = b(70) - lu(137) * b(43) + b(75) = b(75) - lu(138) * b(43) + b(46) = b(46) - lu(141) * b(44) + b(47) = b(47) - lu(142) * b(44) + b(51) = b(51) - lu(143) * b(44) + b(57) = b(57) - lu(144) * b(44) + b(67) = b(67) - lu(145) * b(44) + b(70) = b(70) - lu(146) * b(44) + b(71) = b(71) - lu(147) * b(44) + b(75) = b(75) - lu(148) * b(44) + b(55) = b(55) - lu(151) * b(45) + b(57) = b(57) - lu(152) * b(45) + b(60) = b(60) - lu(153) * b(45) + b(67) = b(67) - lu(154) * b(45) + b(68) = b(68) - lu(155) * b(45) + b(69) = b(69) - lu(156) * b(45) + b(72) = b(72) - lu(157) * b(45) + b(47) = b(47) - lu(159) * b(46) + b(48) = b(48) - lu(160) * b(46) + b(51) = b(51) - lu(161) * b(46) + b(65) = b(65) - lu(162) * b(46) + b(70) = b(70) - lu(163) * b(46) + b(74) = b(74) - lu(164) * b(46) + b(75) = b(75) - lu(165) * b(46) + b(48) = b(48) - lu(168) * b(47) + b(51) = b(51) - lu(169) * b(47) + b(65) = b(65) - lu(170) * b(47) + b(70) = b(70) - lu(171) * b(47) + b(74) = b(74) - lu(172) * b(47) + b(75) = b(75) - lu(173) * b(47) + b(51) = b(51) - lu(180) * b(48) + b(57) = b(57) - lu(181) * b(48) + b(65) = b(65) - lu(182) * b(48) + b(67) = b(67) - lu(183) * b(48) + b(70) = b(70) - lu(184) * b(48) + b(71) = b(71) - lu(185) * b(48) + b(74) = b(74) - lu(186) * b(48) + b(75) = b(75) - lu(187) * b(48) + b(59) = b(59) - lu(190) * b(49) + b(61) = b(61) - lu(191) * b(49) + b(63) = b(63) - lu(192) * b(49) + b(67) = b(67) - lu(193) * b(49) + b(69) = b(69) - lu(194) * b(49) + b(73) = b(73) - lu(195) * b(49) + b(75) = b(75) - lu(196) * b(49) + b(57) = b(57) - lu(198) * b(50) + b(63) = b(63) - lu(199) * b(50) + b(67) = b(67) - lu(200) * b(50) + b(69) = b(69) - lu(201) * b(50) + b(74) = b(74) - lu(202) * b(50) + b(75) = b(75) - lu(203) * b(50) + b(57) = b(57) - lu(210) * b(51) + b(65) = b(65) - lu(211) * b(51) + b(66) = b(66) - lu(212) * b(51) + b(67) = b(67) - lu(213) * b(51) + b(70) = b(70) - lu(214) * b(51) + b(71) = b(71) - lu(215) * b(51) + b(74) = b(74) - lu(216) * b(51) + b(75) = b(75) - lu(217) * b(51) + b(61) = b(61) - lu(220) * b(52) + b(62) = b(62) - lu(221) * b(52) + b(67) = b(67) - lu(222) * b(52) + b(69) = b(69) - lu(223) * b(52) + b(73) = b(73) - lu(224) * b(52) + b(75) = b(75) - lu(225) * b(52) + b(56) = b(56) - lu(228) * b(53) + b(67) = b(67) - lu(229) * b(53) + b(69) = b(69) - lu(230) * b(53) + b(71) = b(71) - lu(231) * b(53) + b(75) = b(75) - lu(232) * b(53) + b(55) = b(55) - lu(236) * b(54) + b(61) = b(61) - lu(237) * b(54) + b(62) = b(62) - lu(238) * b(54) + b(66) = b(66) - lu(239) * b(54) + b(67) = b(67) - lu(240) * b(54) + b(68) = b(68) - lu(241) * b(54) + b(69) = b(69) - lu(242) * b(54) + b(73) = b(73) - lu(243) * b(54) + b(75) = b(75) - lu(244) * b(54) + b(57) = b(57) - lu(248) * b(55) + b(60) = b(60) - lu(249) * b(55) + b(66) = b(66) - lu(250) * b(55) + b(67) = b(67) - lu(251) * b(55) + b(68) = b(68) - lu(252) * b(55) + b(69) = b(69) - lu(253) * b(55) + b(72) = b(72) - lu(254) * b(55) + b(57) = b(57) - lu(259) * b(56) + b(59) = b(59) - lu(260) * b(56) + b(61) = b(61) - lu(261) * b(56) + b(62) = b(62) - lu(262) * b(56) + b(63) = b(63) - lu(263) * b(56) + b(64) = b(64) - lu(264) * b(56) + b(65) = b(65) - lu(265) * b(56) + b(66) = b(66) - lu(266) * b(56) + b(67) = b(67) - lu(267) * b(56) + b(69) = b(69) - lu(268) * b(56) + b(70) = b(70) - lu(269) * b(56) + b(71) = b(71) - lu(270) * b(56) + b(75) = b(75) - lu(271) * b(56) + b(60) = b(60) - lu(273) * b(57) + b(64) = b(64) - lu(274) * b(57) + b(67) = b(67) - lu(275) * b(57) + b(69) = b(69) - lu(276) * b(57) + b(70) = b(70) - lu(277) * b(57) + b(71) = b(71) - lu(278) * b(57) + b(75) = b(75) - lu(279) * b(57) + b(60) = b(60) - lu(285) * b(58) + b(61) = b(61) - lu(286) * b(58) + b(63) = b(63) - lu(287) * b(58) + b(64) = b(64) - lu(288) * b(58) + b(66) = b(66) - lu(289) * b(58) + b(67) = b(67) - lu(290) * b(58) + b(68) = b(68) - lu(291) * b(58) + b(69) = b(69) - lu(292) * b(58) + b(70) = b(70) - lu(293) * b(58) + b(71) = b(71) - lu(294) * b(58) + b(72) = b(72) - lu(295) * b(58) + b(73) = b(73) - lu(296) * b(58) + b(74) = b(74) - lu(297) * b(58) + b(75) = b(75) - lu(298) * b(58) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(60) = b(60) - lu(308) * b(59) + b(61) = b(61) - lu(309) * b(59) + b(62) = b(62) - lu(310) * b(59) + b(63) = b(63) - lu(311) * b(59) + b(64) = b(64) - lu(312) * b(59) + b(65) = b(65) - lu(313) * b(59) + b(66) = b(66) - lu(314) * b(59) + b(67) = b(67) - lu(315) * b(59) + b(68) = b(68) - lu(316) * b(59) + b(69) = b(69) - lu(317) * b(59) + b(70) = b(70) - lu(318) * b(59) + b(71) = b(71) - lu(319) * b(59) + b(72) = b(72) - lu(320) * b(59) + b(73) = b(73) - lu(321) * b(59) + b(75) = b(75) - lu(322) * b(59) + b(61) = b(61) - lu(328) * b(60) + b(64) = b(64) - lu(329) * b(60) + b(66) = b(66) - lu(330) * b(60) + b(67) = b(67) - lu(331) * b(60) + b(68) = b(68) - lu(332) * b(60) + b(69) = b(69) - lu(333) * b(60) + b(70) = b(70) - lu(334) * b(60) + b(71) = b(71) - lu(335) * b(60) + b(72) = b(72) - lu(336) * b(60) + b(73) = b(73) - lu(337) * b(60) + b(74) = b(74) - lu(338) * b(60) + b(75) = b(75) - lu(339) * b(60) + b(62) = b(62) - lu(350) * b(61) + b(63) = b(63) - lu(351) * b(61) + b(64) = b(64) - lu(352) * b(61) + b(66) = b(66) - lu(353) * b(61) + b(67) = b(67) - lu(354) * b(61) + b(68) = b(68) - lu(355) * b(61) + b(69) = b(69) - lu(356) * b(61) + b(70) = b(70) - lu(357) * b(61) + b(71) = b(71) - lu(358) * b(61) + b(72) = b(72) - lu(359) * b(61) + b(73) = b(73) - lu(360) * b(61) + b(74) = b(74) - lu(361) * b(61) + b(75) = b(75) - lu(362) * b(61) + b(63) = b(63) - lu(378) * b(62) + b(64) = b(64) - lu(379) * b(62) + b(65) = b(65) - lu(380) * b(62) + b(66) = b(66) - lu(381) * b(62) + b(67) = b(67) - lu(382) * b(62) + b(68) = b(68) - lu(383) * b(62) + b(69) = b(69) - lu(384) * b(62) + b(70) = b(70) - lu(385) * b(62) + b(71) = b(71) - lu(386) * b(62) + b(72) = b(72) - lu(387) * b(62) + b(73) = b(73) - lu(388) * b(62) + b(74) = b(74) - lu(389) * b(62) + b(75) = b(75) - lu(390) * b(62) + b(64) = b(64) - lu(400) * b(63) + b(65) = b(65) - lu(401) * b(63) + b(66) = b(66) - lu(402) * b(63) + b(67) = b(67) - lu(403) * b(63) + b(68) = b(68) - lu(404) * b(63) + b(69) = b(69) - lu(405) * b(63) + b(70) = b(70) - lu(406) * b(63) + b(71) = b(71) - lu(407) * b(63) + b(72) = b(72) - lu(408) * b(63) + b(73) = b(73) - lu(409) * b(63) + b(74) = b(74) - lu(410) * b(63) + b(75) = b(75) - lu(411) * b(63) + b(65) = b(65) - lu(424) * b(64) + b(66) = b(66) - lu(425) * b(64) + b(67) = b(67) - lu(426) * b(64) + b(68) = b(68) - lu(427) * b(64) + b(69) = b(69) - lu(428) * b(64) + b(70) = b(70) - lu(429) * b(64) + b(71) = b(71) - lu(430) * b(64) + b(72) = b(72) - lu(431) * b(64) + b(73) = b(73) - lu(432) * b(64) + b(74) = b(74) - lu(433) * b(64) + b(75) = b(75) - lu(434) * b(64) + b(66) = b(66) - lu(448) * b(65) + b(67) = b(67) - lu(449) * b(65) + b(68) = b(68) - lu(450) * b(65) + b(69) = b(69) - lu(451) * b(65) + b(70) = b(70) - lu(452) * b(65) + b(71) = b(71) - lu(453) * b(65) + b(72) = b(72) - lu(454) * b(65) + b(73) = b(73) - lu(455) * b(65) + b(74) = b(74) - lu(456) * b(65) + b(75) = b(75) - lu(457) * b(65) + b(67) = b(67) - lu(476) * b(66) + b(68) = b(68) - lu(477) * b(66) + b(69) = b(69) - lu(478) * b(66) + b(70) = b(70) - lu(479) * b(66) + b(71) = b(71) - lu(480) * b(66) + b(72) = b(72) - lu(481) * b(66) + b(73) = b(73) - lu(482) * b(66) + b(74) = b(74) - lu(483) * b(66) + b(75) = b(75) - lu(484) * b(66) + b(68) = b(68) - lu(514) * b(67) + b(69) = b(69) - lu(515) * b(67) + b(70) = b(70) - lu(516) * b(67) + b(71) = b(71) - lu(517) * b(67) + b(72) = b(72) - lu(518) * b(67) + b(73) = b(73) - lu(519) * b(67) + b(74) = b(74) - lu(520) * b(67) + b(75) = b(75) - lu(521) * b(67) + b(69) = b(69) - lu(540) * b(68) + b(70) = b(70) - lu(541) * b(68) + b(71) = b(71) - lu(542) * b(68) + b(72) = b(72) - lu(543) * b(68) + b(73) = b(73) - lu(544) * b(68) + b(74) = b(74) - lu(545) * b(68) + b(75) = b(75) - lu(546) * b(68) + b(70) = b(70) - lu(566) * b(69) + b(71) = b(71) - lu(567) * b(69) + b(72) = b(72) - lu(568) * b(69) + b(73) = b(73) - lu(569) * b(69) + b(74) = b(74) - lu(570) * b(69) + b(75) = b(75) - lu(571) * b(69) + b(71) = b(71) - lu(598) * b(70) + b(72) = b(72) - lu(599) * b(70) + b(73) = b(73) - lu(600) * b(70) + b(74) = b(74) - lu(601) * b(70) + b(75) = b(75) - lu(602) * b(70) + b(72) = b(72) - lu(624) * b(71) + b(73) = b(73) - lu(625) * b(71) + b(74) = b(74) - lu(626) * b(71) + b(75) = b(75) - lu(627) * b(71) + b(73) = b(73) - lu(644) * b(72) + b(74) = b(74) - lu(645) * b(72) + b(75) = b(75) - lu(646) * b(72) + b(74) = b(74) - lu(669) * b(73) + b(75) = b(75) - lu(670) * b(73) + b(75) = b(75) - lu(694) * b(74) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(75) = b(75) * lu(735) + b(74) = b(74) - lu(734) * b(75) + b(73) = b(73) - lu(733) * b(75) + b(72) = b(72) - lu(732) * b(75) + b(71) = b(71) - lu(731) * b(75) + b(70) = b(70) - lu(730) * b(75) + b(69) = b(69) - lu(729) * b(75) + b(68) = b(68) - lu(728) * b(75) + b(67) = b(67) - lu(727) * b(75) + b(66) = b(66) - lu(726) * b(75) + b(65) = b(65) - lu(725) * b(75) + b(64) = b(64) - lu(724) * b(75) + b(63) = b(63) - lu(723) * b(75) + b(62) = b(62) - lu(722) * b(75) + b(61) = b(61) - lu(721) * b(75) + b(60) = b(60) - lu(720) * b(75) + b(59) = b(59) - lu(719) * b(75) + b(58) = b(58) - lu(718) * b(75) + b(57) = b(57) - lu(717) * b(75) + b(56) = b(56) - lu(716) * b(75) + b(55) = b(55) - lu(715) * b(75) + b(54) = b(54) - lu(714) * b(75) + b(53) = b(53) - lu(713) * b(75) + b(52) = b(52) - lu(712) * b(75) + b(51) = b(51) - lu(711) * b(75) + b(50) = b(50) - lu(710) * b(75) + b(49) = b(49) - lu(709) * b(75) + b(48) = b(48) - lu(708) * b(75) + b(47) = b(47) - lu(707) * b(75) + b(46) = b(46) - lu(706) * b(75) + b(44) = b(44) - lu(705) * b(75) + b(43) = b(43) - lu(704) * b(75) + b(42) = b(42) - lu(703) * b(75) + b(41) = b(41) - lu(702) * b(75) + b(40) = b(40) - lu(701) * b(75) + b(39) = b(39) - lu(700) * b(75) + b(38) = b(38) - lu(699) * b(75) + b(36) = b(36) - lu(698) * b(75) + b(34) = b(34) - lu(697) * b(75) + b(25) = b(25) - lu(696) * b(75) + b(24) = b(24) - lu(695) * b(75) + b(74) = b(74) * lu(693) + b(73) = b(73) - lu(692) * b(74) + b(72) = b(72) - lu(691) * b(74) + b(71) = b(71) - lu(690) * b(74) + b(70) = b(70) - lu(689) * b(74) + b(69) = b(69) - lu(688) * b(74) + b(68) = b(68) - lu(687) * b(74) + b(67) = b(67) - lu(686) * b(74) + b(66) = b(66) - lu(685) * b(74) + b(65) = b(65) - lu(684) * b(74) + b(64) = b(64) - lu(683) * b(74) + b(63) = b(63) - lu(682) * b(74) + b(62) = b(62) - lu(681) * b(74) + b(61) = b(61) - lu(680) * b(74) + b(60) = b(60) - lu(679) * b(74) + b(58) = b(58) - lu(678) * b(74) + b(57) = b(57) - lu(677) * b(74) + b(55) = b(55) - lu(676) * b(74) + b(50) = b(50) - lu(675) * b(74) + b(45) = b(45) - lu(674) * b(74) + b(27) = b(27) - lu(673) * b(74) + b(25) = b(25) - lu(672) * b(74) + b(22) = b(22) - lu(671) * b(74) + b(73) = b(73) * lu(668) + b(72) = b(72) - lu(667) * b(73) + b(71) = b(71) - lu(666) * b(73) + b(70) = b(70) - lu(665) * b(73) + b(69) = b(69) - lu(664) * b(73) + b(68) = b(68) - lu(663) * b(73) + b(67) = b(67) - lu(662) * b(73) + b(66) = b(66) - lu(661) * b(73) + b(65) = b(65) - lu(660) * b(73) + b(64) = b(64) - lu(659) * b(73) + b(63) = b(63) - lu(658) * b(73) + b(62) = b(62) - lu(657) * b(73) + b(61) = b(61) - lu(656) * b(73) + b(60) = b(60) - lu(655) * b(73) + b(59) = b(59) - lu(654) * b(73) + b(57) = b(57) - lu(653) * b(73) + b(55) = b(55) - lu(652) * b(73) + b(54) = b(54) - lu(651) * b(73) + b(52) = b(52) - lu(650) * b(73) + b(49) = b(49) - lu(649) * b(73) + b(28) = b(28) - lu(648) * b(73) + b(26) = b(26) - lu(647) * b(73) + b(72) = b(72) * lu(643) + b(71) = b(71) - lu(642) * b(72) + b(70) = b(70) - lu(641) * b(72) + b(69) = b(69) - lu(640) * b(72) + b(68) = b(68) - lu(639) * b(72) + b(67) = b(67) - lu(638) * b(72) + b(66) = b(66) - lu(637) * b(72) + b(65) = b(65) - lu(636) * b(72) + b(64) = b(64) - lu(635) * b(72) + b(63) = b(63) - lu(634) * b(72) + b(62) = b(62) - lu(633) * b(72) + b(61) = b(61) - lu(632) * b(72) + b(60) = b(60) - lu(631) * b(72) + b(58) = b(58) - lu(630) * b(72) + b(57) = b(57) - lu(629) * b(72) + b(35) = b(35) - lu(628) * b(72) + b(71) = b(71) * lu(623) + b(70) = b(70) - lu(622) * b(71) + b(69) = b(69) - lu(621) * b(71) + b(68) = b(68) - lu(620) * b(71) + b(67) = b(67) - lu(619) * b(71) + b(66) = b(66) - lu(618) * b(71) + b(65) = b(65) - lu(617) * b(71) + b(64) = b(64) - lu(616) * b(71) + b(63) = b(63) - lu(615) * b(71) + b(62) = b(62) - lu(614) * b(71) + b(61) = b(61) - lu(613) * b(71) + b(60) = b(60) - lu(612) * b(71) + b(59) = b(59) - lu(611) * b(71) + b(58) = b(58) - lu(610) * b(71) + b(57) = b(57) - lu(609) * b(71) + b(52) = b(52) - lu(608) * b(71) + b(50) = b(50) - lu(607) * b(71) + b(49) = b(49) - lu(606) * b(71) + b(41) = b(41) - lu(605) * b(71) + b(37) = b(37) - lu(604) * b(71) + b(35) = b(35) - lu(603) * b(71) + b(70) = b(70) * lu(597) + b(69) = b(69) - lu(596) * b(70) + b(68) = b(68) - lu(595) * b(70) + b(67) = b(67) - lu(594) * b(70) + b(66) = b(66) - lu(593) * b(70) + b(65) = b(65) - lu(592) * b(70) + b(64) = b(64) - lu(591) * b(70) + b(63) = b(63) - lu(590) * b(70) + b(62) = b(62) - lu(589) * b(70) + b(61) = b(61) - lu(588) * b(70) + b(60) = b(60) - lu(587) * b(70) + b(59) = b(59) - lu(586) * b(70) + b(57) = b(57) - lu(585) * b(70) + b(56) = b(56) - lu(584) * b(70) + b(53) = b(53) - lu(583) * b(70) + b(51) = b(51) - lu(582) * b(70) + b(48) = b(48) - lu(581) * b(70) + b(47) = b(47) - lu(580) * b(70) + b(46) = b(46) - lu(579) * b(70) + b(44) = b(44) - lu(578) * b(70) + b(43) = b(43) - lu(577) * b(70) + b(42) = b(42) - lu(576) * b(70) + b(38) = b(38) - lu(575) * b(70) + b(36) = b(36) - lu(574) * b(70) + b(25) = b(25) - lu(573) * b(70) + b(24) = b(24) - lu(572) * b(70) + b(69) = b(69) * lu(565) + b(68) = b(68) - lu(564) * b(69) + b(67) = b(67) - lu(563) * b(69) + b(66) = b(66) - lu(562) * b(69) + b(65) = b(65) - lu(561) * b(69) + b(64) = b(64) - lu(560) * b(69) + b(63) = b(63) - lu(559) * b(69) + b(62) = b(62) - lu(558) * b(69) + b(61) = b(61) - lu(557) * b(69) + b(60) = b(60) - lu(556) * b(69) + b(59) = b(59) - lu(555) * b(69) + b(57) = b(57) - lu(554) * b(69) + b(56) = b(56) - lu(553) * b(69) + b(55) = b(55) - lu(552) * b(69) + b(53) = b(53) - lu(551) * b(69) + b(45) = b(45) - lu(550) * b(69) + b(30) = b(30) - lu(549) * b(69) + b(29) = b(29) - lu(548) * b(69) + b(23) = b(23) - lu(547) * b(69) + b(68) = b(68) * lu(539) + b(67) = b(67) - lu(538) * b(68) + b(66) = b(66) - lu(537) * b(68) + b(65) = b(65) - lu(536) * b(68) + b(64) = b(64) - lu(535) * b(68) + b(63) = b(63) - lu(534) * b(68) + b(62) = b(62) - lu(533) * b(68) + b(61) = b(61) - lu(532) * b(68) + b(60) = b(60) - lu(531) * b(68) + b(59) = b(59) - lu(530) * b(68) + b(58) = b(58) - lu(529) * b(68) + b(57) = b(57) - lu(528) * b(68) + b(56) = b(56) - lu(527) * b(68) + b(55) = b(55) - lu(526) * b(68) + b(53) = b(53) - lu(525) * b(68) + b(39) = b(39) - lu(524) * b(68) + b(32) = b(32) - lu(523) * b(68) + b(31) = b(31) - lu(522) * b(68) + b(67) = b(67) * lu(513) + b(66) = b(66) - lu(512) * b(67) + b(65) = b(65) - lu(511) * b(67) + b(64) = b(64) - lu(510) * b(67) + b(63) = b(63) - lu(509) * b(67) + b(62) = b(62) - lu(508) * b(67) + b(61) = b(61) - lu(507) * b(67) + b(60) = b(60) - lu(506) * b(67) + b(59) = b(59) - lu(505) * b(67) + b(58) = b(58) - lu(504) * b(67) + b(57) = b(57) - lu(503) * b(67) + b(56) = b(56) - lu(502) * b(67) + b(55) = b(55) - lu(501) * b(67) + b(54) = b(54) - lu(500) * b(67) + b(53) = b(53) - lu(499) * b(67) + b(52) = b(52) - lu(498) * b(67) + b(51) = b(51) - lu(497) * b(67) + b(50) = b(50) - lu(496) * b(67) + b(45) = b(45) - lu(495) * b(67) + b(43) = b(43) - lu(494) * b(67) + b(41) = b(41) - lu(493) * b(67) + b(39) = b(39) - lu(492) * b(67) + b(37) = b(37) - lu(491) * b(67) + b(35) = b(35) - lu(490) * b(67) + b(34) = b(34) - lu(489) * b(67) + b(31) = b(31) - lu(488) * b(67) + b(30) = b(30) - lu(487) * b(67) + b(27) = b(27) - lu(486) * b(67) + b(22) = b(22) - lu(485) * b(67) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(66) = b(66) * lu(475) + b(65) = b(65) - lu(474) * b(66) + b(64) = b(64) - lu(473) * b(66) + b(63) = b(63) - lu(472) * b(66) + b(62) = b(62) - lu(471) * b(66) + b(61) = b(61) - lu(470) * b(66) + b(60) = b(60) - lu(469) * b(66) + b(59) = b(59) - lu(468) * b(66) + b(57) = b(57) - lu(467) * b(66) + b(56) = b(56) - lu(466) * b(66) + b(55) = b(55) - lu(465) * b(66) + b(54) = b(54) - lu(464) * b(66) + b(53) = b(53) - lu(463) * b(66) + b(51) = b(51) - lu(462) * b(66) + b(49) = b(49) - lu(461) * b(66) + b(40) = b(40) - lu(460) * b(66) + b(37) = b(37) - lu(459) * b(66) + b(32) = b(32) - lu(458) * b(66) + b(65) = b(65) * lu(447) + b(64) = b(64) - lu(446) * b(65) + b(63) = b(63) - lu(445) * b(65) + b(62) = b(62) - lu(444) * b(65) + b(61) = b(61) - lu(443) * b(65) + b(60) = b(60) - lu(442) * b(65) + b(59) = b(59) - lu(441) * b(65) + b(58) = b(58) - lu(440) * b(65) + b(57) = b(57) - lu(439) * b(65) + b(51) = b(51) - lu(438) * b(65) + b(48) = b(48) - lu(437) * b(65) + b(47) = b(47) - lu(436) * b(65) + b(46) = b(46) - lu(435) * b(65) + b(64) = b(64) * lu(423) + b(63) = b(63) - lu(422) * b(64) + b(62) = b(62) - lu(421) * b(64) + b(61) = b(61) - lu(420) * b(64) + b(60) = b(60) - lu(419) * b(64) + b(59) = b(59) - lu(418) * b(64) + b(57) = b(57) - lu(417) * b(64) + b(56) = b(56) - lu(416) * b(64) + b(53) = b(53) - lu(415) * b(64) + b(43) = b(43) - lu(414) * b(64) + b(25) = b(25) - lu(413) * b(64) + b(24) = b(24) - lu(412) * b(64) + b(63) = b(63) * lu(399) + b(62) = b(62) - lu(398) * b(63) + b(61) = b(61) - lu(397) * b(63) + b(60) = b(60) - lu(396) * b(63) + b(59) = b(59) - lu(395) * b(63) + b(58) = b(58) - lu(394) * b(63) + b(57) = b(57) - lu(393) * b(63) + b(50) = b(50) - lu(392) * b(63) + b(39) = b(39) - lu(391) * b(63) + b(62) = b(62) * lu(377) + b(61) = b(61) - lu(376) * b(62) + b(60) = b(60) - lu(375) * b(62) + b(59) = b(59) - lu(374) * b(62) + b(58) = b(58) - lu(373) * b(62) + b(57) = b(57) - lu(372) * b(62) + b(56) = b(56) - lu(371) * b(62) + b(55) = b(55) - lu(370) * b(62) + b(54) = b(54) - lu(369) * b(62) + b(53) = b(53) - lu(368) * b(62) + b(52) = b(52) - lu(367) * b(62) + b(33) = b(33) - lu(366) * b(62) + b(28) = b(28) - lu(365) * b(62) + b(26) = b(26) - lu(364) * b(62) + b(21) = b(21) - lu(363) * b(62) + b(61) = b(61) * lu(349) + b(60) = b(60) - lu(348) * b(61) + b(58) = b(58) - lu(347) * b(61) + b(57) = b(57) - lu(346) * b(61) + b(55) = b(55) - lu(345) * b(61) + b(54) = b(54) - lu(344) * b(61) + b(52) = b(52) - lu(343) * b(61) + b(41) = b(41) - lu(342) * b(61) + b(39) = b(39) - lu(341) * b(61) + b(26) = b(26) - lu(340) * b(61) + b(60) = b(60) * lu(327) + b(57) = b(57) - lu(326) * b(60) + b(55) = b(55) - lu(325) * b(60) + b(45) = b(45) - lu(324) * b(60) + b(29) = b(29) - lu(323) * b(60) + b(59) = b(59) * lu(307) + b(57) = b(57) - lu(306) * b(59) + b(56) = b(56) - lu(305) * b(59) + b(55) = b(55) - lu(304) * b(59) + b(53) = b(53) - lu(303) * b(59) + b(49) = b(49) - lu(302) * b(59) + b(40) = b(40) - lu(301) * b(59) + b(33) = b(33) - lu(300) * b(59) + b(28) = b(28) - lu(299) * b(59) + b(58) = b(58) * lu(284) + b(57) = b(57) - lu(283) * b(58) + b(55) = b(55) - lu(282) * b(58) + b(50) = b(50) - lu(281) * b(58) + b(39) = b(39) - lu(280) * b(58) + b(57) = b(57) * lu(272) + b(56) = b(56) * lu(258) + b(53) = b(53) - lu(257) * b(56) + b(43) = b(43) - lu(256) * b(56) + b(33) = b(33) - lu(255) * b(56) + b(55) = b(55) * lu(247) + b(45) = b(45) - lu(246) * b(55) + b(29) = b(29) - lu(245) * b(55) + b(54) = b(54) * lu(235) + b(52) = b(52) - lu(234) * b(54) + b(26) = b(26) - lu(233) * b(54) + b(53) = b(53) * lu(227) + b(30) = b(30) - lu(226) * b(53) + b(52) = b(52) * lu(219) + b(26) = b(26) - lu(218) * b(52) + b(51) = b(51) * lu(209) + b(48) = b(48) - lu(208) * b(51) + b(47) = b(47) - lu(207) * b(51) + b(46) = b(46) - lu(206) * b(51) + b(44) = b(44) - lu(205) * b(51) + b(36) = b(36) - lu(204) * b(51) + b(50) = b(50) * lu(197) + b(49) = b(49) * lu(189) + b(28) = b(28) - lu(188) * b(49) + b(48) = b(48) * lu(179) + b(47) = b(47) - lu(178) * b(48) + b(46) = b(46) - lu(177) * b(48) + b(44) = b(44) - lu(176) * b(48) + b(42) = b(42) - lu(175) * b(48) + b(38) = b(38) - lu(174) * b(48) + b(47) = b(47) * lu(167) + b(38) = b(38) - lu(166) * b(47) + b(46) = b(46) * lu(158) + b(45) = b(45) * lu(150) + b(29) = b(29) - lu(149) * b(45) + b(44) = b(44) * lu(140) + b(39) = b(39) - lu(139) * b(44) + b(43) = b(43) * lu(132) + b(42) = b(42) * lu(122) + b(38) = b(38) - lu(121) * b(42) + b(41) = b(41) * lu(114) + b(40) = b(40) * lu(106) + b(39) = b(39) * lu(102) + b(38) = b(38) * lu(97) + b(37) = b(37) * lu(90) + b(36) = b(36) * lu(83) + b(35) = b(35) * lu(77) + b(34) = b(34) * lu(69) + b(33) = b(33) * lu(64) + b(32) = b(32) * lu(58) + b(31) = b(31) * lu(52) + b(30) = b(30) * lu(48) + b(23) = b(23) - lu(47) * b(30) + b(29) = b(29) * lu(44) + b(28) = b(28) * lu(41) + b(27) = b(27) * lu(37) + b(26) = b(26) * lu(35) + b(25) = b(25) * lu(33) + b(24) = b(24) - lu(32) * b(25) + b(24) = b(24) * lu(30) + b(23) = b(23) * lu(27) + b(22) = b(22) * lu(24) + b(21) = b(21) * lu(21) + b(20) = b(20) * lu(20) + b(19) = b(19) * lu(19) + b(18) = b(18) * lu(18) + b(17) = b(17) * lu(17) + b(16) = b(16) * lu(16) + b(15) = b(15) * lu(15) + b(14) = b(14) * lu(14) + b(13) = b(13) * lu(13) + b(12) = b(12) * lu(12) + b(11) = b(11) * lu(11) + b(10) = b(10) * lu(10) + b(9) = b(9) * lu(9) + b(8) = b(8) * lu(8) + b(7) = b(7) * lu(7) + b(6) = b(6) * lu(6) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv04 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..dfc4690043 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 @@ -0,0 +1,1191 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(423) = -(rxt(93)*y(2) + rxt(111)*y(97) + rxt(137)*y(18) + rxt(142)*y(86) & + + rxt(150)*y(87) + rxt(163)*y(6) + rxt(166)*y(7) + rxt(178) & + *y(84) + rxt(205)*y(85) + rxt(254)*y(58) + rxt(257)*y(59)) + mat(724) = -rxt(93)*y(1) + mat(683) = -rxt(111)*y(1) + mat(274) = -rxt(137)*y(1) + mat(510) = -rxt(142)*y(1) + mat(616) = -rxt(150)*y(1) + mat(446) = -rxt(163)*y(1) + mat(473) = -rxt(166)*y(1) + mat(352) = -rxt(178)*y(1) + mat(400) = -rxt(205)*y(1) + mat(135) = -rxt(254)*y(1) + mat(264) = -rxt(257)*y(1) + mat(724) = mat(724) + rxt(92)*y(3) + mat(591) = rxt(92)*y(2) + mat(735) = -(rxt(92)*y(3) + rxt(93)*y(1) + 4._r8*rxt(94)*y(2) + rxt(141) & + *y(86) + rxt(148)*y(17) + rxt(149)*y(87) + rxt(152)*y(19) & + + rxt(161)*y(6) + (rxt(164) + rxt(165)) * y(7) + rxt(172)*y(8) & + + rxt(185)*y(23) + rxt(198)*y(26) + rxt(199)*y(27) + rxt(202) & + *y(28) + rxt(208)*y(30) + rxt(218)*y(31) + rxt(219)*y(32) & + + rxt(220)*y(33) + rxt(242)*y(15) + rxt(250)*y(57) + (rxt(286) & + + rxt(287)) * y(88) + rxt(293)*y(90)) + mat(602) = -rxt(92)*y(2) + mat(434) = -rxt(93)*y(2) + mat(521) = -rxt(141)*y(2) + mat(339) = -rxt(148)*y(2) + mat(627) = -rxt(149)*y(2) + mat(120) = -rxt(152)*y(2) + mat(457) = -rxt(161)*y(2) + mat(484) = -(rxt(164) + rxt(165)) * y(2) + mat(546) = -rxt(172)*y(2) + mat(390) = -rxt(185)*y(2) + mat(670) = -rxt(198)*y(2) + mat(225) = -rxt(199)*y(2) + mat(244) = -rxt(202)*y(2) + mat(322) = -rxt(208)*y(2) + mat(203) = -rxt(218)*y(2) + mat(196) = -rxt(219)*y(2) + mat(113) = -rxt(220)*y(2) + mat(298) = -rxt(242)*y(2) + mat(76) = -rxt(250)*y(2) + mat(131) = -(rxt(286) + rxt(287)) * y(2) + mat(89) = -rxt(293)*y(2) + mat(694) = (rxt(106)+rxt(107))*y(3) + mat(602) = mat(602) + (rxt(106)+rxt(107))*y(97) + rxt(156)*y(5) + rxt(292) & + *y(90) + rxt(284)*y(91) + rxt(253)*y(58) + rxt(256)*y(59) + mat(217) = rxt(156)*y(3) + rxt(157)*y(6) + rxt(158)*y(7) + rxt(289)*y(89) + mat(457) = mat(457) + rxt(157)*y(5) + mat(484) = mat(484) + rxt(158)*y(5) + mat(521) = mat(521) + 2.000_r8*rxt(144)*y(86) + mat(279) = rxt(140)*y(87) + mat(627) = mat(627) + rxt(140)*y(18) + mat(165) = rxt(289)*y(5) + 1.150_r8*rxt(297)*y(93) + mat(89) = mat(89) + rxt(292)*y(3) + mat(148) = rxt(284)*y(3) + mat(173) = rxt(296)*y(93) + mat(187) = 1.150_r8*rxt(297)*y(89) + rxt(296)*y(92) + mat(138) = rxt(253)*y(3) + mat(271) = rxt(256)*y(3) + mat(693) = -((rxt(106) + rxt(107)) * y(3) + rxt(108)*y(98) + rxt(111)*y(1) & + + rxt(128)*y(52) + rxt(129)*y(53) + rxt(133)*y(17) + rxt(134) & + *y(26) + rxt(135)*y(31)) + mat(601) = -(rxt(106) + rxt(107)) * y(97) + mat(570) = -rxt(108)*y(97) + mat(433) = -rxt(111)*y(97) + mat(26) = -rxt(128)*y(97) + mat(40) = -rxt(129)*y(97) + mat(338) = -rxt(133)*y(97) + mat(669) = -rxt(134)*y(97) + mat(202) = -rxt(135)*y(97) + mat(601) = mat(601) + rxt(153)*y(94) + mat(164) = .850_r8*rxt(297)*y(93) + mat(101) = rxt(153)*y(3) + mat(186) = .850_r8*rxt(297)*y(89) + mat(597) = -(rxt(92)*y(2) + rxt(102)*y(96) + rxt(106)*y(97) + rxt(136)*y(18) & + + rxt(153)*y(94) + rxt(156)*y(5) + rxt(253)*y(58) + rxt(256) & + *y(59) + rxt(284)*y(91) + (rxt(291) + rxt(292)) * y(90) + rxt(294) & + *y(88)) + mat(730) = -rxt(92)*y(3) + mat(31) = -rxt(102)*y(3) + mat(689) = -rxt(106)*y(3) + mat(277) = -rxt(136)*y(3) + mat(100) = -rxt(153)*y(3) + mat(214) = -rxt(156)*y(3) + mat(137) = -rxt(253)*y(3) + mat(269) = -rxt(256)*y(3) + mat(146) = -rxt(284)*y(3) + mat(88) = -(rxt(291) + rxt(292)) * y(3) + mat(129) = -rxt(294)*y(3) + mat(429) = 2.000_r8*rxt(93)*y(2) + 2.000_r8*rxt(111)*y(97) + rxt(163)*y(6) & + + rxt(166)*y(7) + rxt(142)*y(86) + rxt(137)*y(18) & + + 2.000_r8*rxt(150)*y(87) + rxt(178)*y(84) + rxt(205)*y(85) & + + rxt(254)*y(58) + rxt(257)*y(59) + mat(730) = mat(730) + 2.000_r8*rxt(93)*y(1) + 2.000_r8*rxt(94)*y(2) & + + rxt(101)*y(96) + rxt(164)*y(7) + rxt(141)*y(86) + rxt(172) & + *y(8) + rxt(149)*y(87) + rxt(185)*y(23) + rxt(208)*y(30) + mat(689) = mat(689) + 2.000_r8*rxt(111)*y(1) + mat(597) = mat(597) + 2.000_r8*rxt(102)*y(96) + mat(31) = mat(31) + rxt(101)*y(2) + 2.000_r8*rxt(102)*y(3) + mat(214) = mat(214) + rxt(160)*y(7) + mat(452) = rxt(163)*y(1) + rxt(290)*y(89) + mat(479) = rxt(166)*y(1) + rxt(164)*y(2) + rxt(160)*y(5) + mat(516) = rxt(142)*y(1) + rxt(141)*y(2) + rxt(176)*y(10) + rxt(143)*y(87) & + + rxt(187)*y(23) + mat(541) = rxt(172)*y(2) + rxt(174)*y(87) + mat(95) = rxt(176)*y(86) + mat(641) = rxt(244)*y(87) + mat(277) = mat(277) + rxt(137)*y(1) + rxt(139)*y(87) + mat(622) = 2.000_r8*rxt(150)*y(1) + rxt(149)*y(2) + rxt(143)*y(86) + rxt(174) & + *y(8) + rxt(244)*y(13) + rxt(139)*y(18) + 2.000_r8*rxt(151) & + *y(87) + rxt(181)*y(84) + rxt(188)*y(23) + rxt(206)*y(85) & + + rxt(210)*y(30) + mat(357) = rxt(178)*y(1) + rxt(181)*y(87) + mat(385) = rxt(185)*y(2) + rxt(187)*y(86) + rxt(188)*y(87) + ( & + + 2.000_r8*rxt(192)+2.000_r8*rxt(193))*y(23) + (rxt(214) & + +rxt(215))*y(30) + mat(406) = rxt(205)*y(1) + rxt(206)*y(87) + mat(318) = rxt(208)*y(2) + rxt(210)*y(87) + (rxt(214)+rxt(215))*y(23) & + + 2.000_r8*rxt(216)*y(30) + mat(163) = rxt(290)*y(6) + mat(137) = mat(137) + rxt(254)*y(1) + mat(269) = mat(269) + rxt(257)*y(1) + mat(33) = -(rxt(95)*y(2) + rxt(96)*y(3) + rxt(98)*y(1)) + mat(696) = -rxt(95)*y(95) + mat(573) = -rxt(96)*y(95) + mat(413) = -rxt(98)*y(95) + mat(672) = rxt(106)*y(3) + mat(573) = mat(573) + rxt(106)*y(97) + mat(30) = -(rxt(101)*y(2) + rxt(102)*y(3)) + mat(695) = -rxt(101)*y(96) + mat(572) = -rxt(102)*y(96) + mat(412) = rxt(98)*y(95) + mat(695) = mat(695) + rxt(95)*y(95) + mat(572) = mat(572) + rxt(96)*y(95) + mat(32) = rxt(98)*y(1) + rxt(95)*y(2) + rxt(96)*y(3) + mat(327) = -(rxt(133)*y(97) + rxt(146)*y(86) + rxt(148)*y(2) + rxt(179)*y(84) & + + rxt(222)*y(55)) + mat(679) = -rxt(133)*y(17) + mat(506) = -rxt(146)*y(17) + mat(720) = -rxt(148)*y(17) + mat(348) = -rxt(179)*y(17) + mat(153) = -rxt(222)*y(17) + mat(273) = rxt(139)*y(87) + mat(612) = rxt(139)*y(18) + mat(102) = -((rxt(238) + rxt(239)) * y(86)) + mat(492) = -(rxt(238) + rxt(239)) * y(16) + mat(700) = rxt(242)*y(15) + rxt(250)*y(57) + mat(492) = mat(492) + rxt(241)*y(15) + rxt(251)*y(57) + mat(524) = rxt(240)*y(15) + mat(280) = rxt(242)*y(2) + rxt(241)*y(86) + rxt(240)*y(8) + rxt(183)*y(84) & + + rxt(207)*y(85) + mat(341) = rxt(183)*y(15) + mat(391) = rxt(207)*y(15) + mat(70) = rxt(250)*y(2) + rxt(251)*y(86) + mat(209) = -(rxt(155)*y(86) + rxt(156)*y(3) + rxt(157)*y(6) + (rxt(158) & + + rxt(159) + rxt(160)) * y(7) + rxt(289)*y(89)) + mat(497) = -rxt(155)*y(5) + mat(582) = -rxt(156)*y(5) + mat(438) = -rxt(157)*y(5) + mat(462) = -(rxt(158) + rxt(159) + rxt(160)) * y(5) + mat(161) = -rxt(289)*y(5) + mat(711) = rxt(293)*y(90) + rxt(154)*y(94) + mat(582) = mat(582) + rxt(291)*y(90) + mat(127) = 1.100_r8*rxt(298)*y(93) + mat(87) = rxt(293)*y(2) + rxt(291)*y(3) + mat(169) = .200_r8*rxt(296)*y(93) + mat(98) = rxt(154)*y(2) + mat(180) = 1.100_r8*rxt(298)*y(88) + .200_r8*rxt(296)*y(92) + mat(447) = -(rxt(157)*y(5) + rxt(161)*y(2) + rxt(162)*y(87) + rxt(163)*y(1) & + + rxt(171)*y(8) + rxt(190)*y(23) + rxt(211)*y(30) + rxt(243) & + *y(13) + rxt(290)*y(89)) + mat(211) = -rxt(157)*y(6) + mat(725) = -rxt(161)*y(6) + mat(617) = -rxt(162)*y(6) + mat(424) = -rxt(163)*y(6) + mat(536) = -rxt(171)*y(6) + mat(380) = -rxt(190)*y(6) + mat(313) = -rxt(211)*y(6) + mat(636) = -rxt(243)*y(6) + mat(162) = -rxt(290)*y(6) + mat(725) = mat(725) + rxt(164)*y(7) + mat(592) = rxt(156)*y(5) + rxt(153)*y(94) + mat(211) = mat(211) + rxt(156)*y(3) + 2.000_r8*rxt(159)*y(7) + rxt(155)*y(86) + mat(474) = rxt(164)*y(2) + 2.000_r8*rxt(159)*y(5) + rxt(258)*y(59) + mat(511) = rxt(155)*y(5) + mat(99) = rxt(153)*y(3) + mat(265) = rxt(258)*y(7) + mat(475) = -((rxt(158) + rxt(159) + rxt(160)) * y(5) + (rxt(164) + rxt(165) & + ) * y(2) + rxt(166)*y(1) + rxt(167)*y(8) + rxt(169)*y(86) & + + rxt(175)*y(87) + rxt(191)*y(23) + rxt(212)*y(30) + rxt(258) & + *y(59)) + mat(212) = -(rxt(158) + rxt(159) + rxt(160)) * y(7) + mat(726) = -(rxt(164) + rxt(165)) * y(7) + mat(425) = -rxt(166)*y(7) + mat(537) = -rxt(167)*y(7) + mat(512) = -rxt(169)*y(7) + mat(618) = -rxt(175)*y(7) + mat(381) = -rxt(191)*y(7) + mat(314) = -rxt(212)*y(7) + mat(266) = -rxt(258)*y(7) + mat(425) = mat(425) + rxt(163)*y(6) + mat(726) = mat(726) + rxt(161)*y(6) + rxt(172)*y(8) + mat(448) = rxt(163)*y(1) + rxt(161)*y(2) + 2.000_r8*rxt(171)*y(8) + rxt(243) & + *y(13) + rxt(162)*y(87) + rxt(190)*y(23) + rxt(211)*y(30) + mat(512) = mat(512) + rxt(173)*y(8) + rxt(176)*y(10) + mat(537) = mat(537) + rxt(172)*y(2) + 2.000_r8*rxt(171)*y(6) + rxt(173)*y(86) & + + rxt(174)*y(87) + mat(91) = rxt(176)*y(86) + mat(637) = rxt(243)*y(6) + mat(618) = mat(618) + rxt(162)*y(6) + rxt(174)*y(8) + mat(381) = mat(381) + rxt(190)*y(6) + mat(314) = mat(314) + rxt(211)*y(6) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(513) = -(rxt(141)*y(2) + rxt(142)*y(1) + rxt(143)*y(87) + (4._r8*rxt(144) & + + 4._r8*rxt(145)) * y(86) + rxt(146)*y(17) + rxt(147)*y(19) & + + rxt(155)*y(5) + rxt(169)*y(7) + rxt(170)*y(9) + rxt(173)*y(8) & + + rxt(176)*y(10) + (rxt(186) + rxt(187)) * y(23) + rxt(197) & + *y(26) + rxt(201)*y(27) + rxt(203)*y(28) + rxt(209)*y(30) & + + rxt(217)*y(31) + (rxt(238) + rxt(239)) * y(16) + rxt(241) & + *y(15) + rxt(245)*y(14) + rxt(251)*y(57) + rxt(252)*y(58) & + + rxt(255)*y(59) + rxt(262)*y(60) + (rxt(264) + rxt(265) & + ) * y(63)) + mat(727) = -rxt(141)*y(86) + mat(426) = -rxt(142)*y(86) + mat(619) = -rxt(143)*y(86) + mat(331) = -rxt(146)*y(86) + mat(116) = -rxt(147)*y(86) + mat(213) = -rxt(155)*y(86) + mat(476) = -rxt(169)*y(86) + mat(251) = -rxt(170)*y(86) + mat(538) = -rxt(173)*y(86) + mat(92) = -rxt(176)*y(86) + mat(382) = -(rxt(186) + rxt(187)) * y(86) + mat(662) = -rxt(197)*y(86) + mat(222) = -rxt(201)*y(86) + mat(240) = -rxt(203)*y(86) + mat(315) = -rxt(209)*y(86) + mat(200) = -rxt(217)*y(86) + mat(104) = -(rxt(238) + rxt(239)) * y(86) + mat(290) = -rxt(241)*y(86) + mat(80) = -rxt(245)*y(86) + mat(75) = -rxt(251)*y(86) + mat(136) = -rxt(252)*y(86) + mat(267) = -rxt(255)*y(86) + mat(229) = -rxt(262)*y(86) + mat(55) = -(rxt(264) + rxt(265)) * y(86) + mat(426) = mat(426) + rxt(137)*y(18) + rxt(150)*y(87) + mat(727) = mat(727) + rxt(148)*y(17) + rxt(242)*y(15) + rxt(149)*y(87) & + + rxt(152)*y(19) + rxt(198)*y(26) + rxt(199)*y(27) + rxt(218) & + *y(31) + rxt(219)*y(32) + mat(686) = rxt(133)*y(17) + 2.000_r8*rxt(108)*y(98) + rxt(134)*y(26) & + + rxt(135)*y(31) + mat(331) = mat(331) + rxt(148)*y(2) + rxt(133)*y(97) + mat(449) = rxt(162)*y(87) + mat(538) = mat(538) + rxt(174)*y(87) + mat(290) = mat(290) + rxt(242)*y(2) + mat(275) = rxt(137)*y(1) + 2.000_r8*rxt(138)*y(87) + mat(619) = mat(619) + rxt(150)*y(1) + rxt(149)*y(2) + rxt(162)*y(6) & + + rxt(174)*y(8) + 2.000_r8*rxt(138)*y(18) + rxt(182)*y(84) + mat(116) = mat(116) + rxt(152)*y(2) + mat(563) = 2.000_r8*rxt(108)*y(97) + rxt(221)*y(55) + mat(354) = rxt(182)*y(87) + mat(662) = mat(662) + rxt(198)*y(2) + rxt(134)*y(97) + mat(222) = mat(222) + rxt(199)*y(2) + mat(200) = mat(200) + rxt(218)*y(2) + rxt(135)*y(97) + mat(193) = rxt(219)*y(2) + mat(154) = rxt(221)*y(98) + mat(539) = -(rxt(167)*y(7) + rxt(171)*y(6) + rxt(172)*y(2) + rxt(173)*y(86) & + + rxt(174)*y(87) + rxt(240)*y(15) + rxt(266)*y(63)) + mat(477) = -rxt(167)*y(8) + mat(450) = -rxt(171)*y(8) + mat(728) = -rxt(172)*y(8) + mat(514) = -rxt(173)*y(8) + mat(620) = -rxt(174)*y(8) + mat(291) = -rxt(240)*y(8) + mat(56) = -rxt(266)*y(8) + mat(427) = rxt(166)*y(7) + mat(728) = mat(728) + rxt(165)*y(7) + rxt(202)*y(28) + rxt(220)*y(33) + mat(477) = mat(477) + rxt(166)*y(1) + rxt(165)*y(2) + mat(514) = mat(514) + rxt(170)*y(9) + rxt(203)*y(28) + mat(252) = rxt(170)*y(86) + rxt(224)*y(55) + mat(355) = rxt(204)*y(28) + mat(241) = rxt(202)*y(2) + rxt(203)*y(86) + rxt(204)*y(84) + mat(112) = rxt(220)*y(2) + mat(155) = rxt(224)*y(9) + mat(247) = -(rxt(170)*y(86) + rxt(224)*y(55)) + mat(501) = -rxt(170)*y(9) + mat(151) = -rxt(224)*y(9) + mat(465) = rxt(169)*y(86) + mat(501) = mat(501) + rxt(169)*y(7) + mat(526) = rxt(240)*y(15) + rxt(266)*y(63) + mat(282) = rxt(240)*y(8) + mat(652) = (rxt(270)+rxt(275)+rxt(281))*y(28) + mat(236) = (rxt(270)+rxt(275)+rxt(281))*y(26) + mat(54) = rxt(266)*y(8) + mat(90) = -(rxt(176)*y(86)) + mat(491) = -rxt(176)*y(10) + mat(459) = rxt(175)*y(87) + mat(604) = rxt(175)*y(7) + mat(458) = rxt(167)*y(8) + mat(523) = rxt(167)*y(7) + mat(643) = -(rxt(189)*y(23) + rxt(243)*y(6) + rxt(244)*y(87)) + mat(387) = -rxt(189)*y(13) + mat(454) = -rxt(243)*y(13) + mat(624) = -rxt(244)*y(13) + mat(518) = rxt(245)*y(14) + mat(82) = rxt(245)*y(86) + mat(77) = -(rxt(245)*y(86)) + mat(490) = -rxt(245)*y(14) + mat(628) = rxt(244)*y(87) + mat(603) = rxt(244)*y(13) + mat(284) = -(rxt(183)*y(84) + rxt(207)*y(85) + rxt(240)*y(8) + rxt(241)*y(86) & + + rxt(242)*y(2)) + mat(347) = -rxt(183)*y(15) + mat(394) = -rxt(207)*y(15) + mat(529) = -rxt(240)*y(15) + mat(504) = -rxt(241)*y(15) + mat(718) = -rxt(242)*y(15) + mat(440) = rxt(243)*y(13) + mat(630) = rxt(243)*y(6) + rxt(189)*y(23) + mat(373) = rxt(189)*y(13) + mat(272) = -(rxt(136)*y(3) + rxt(137)*y(1) + (rxt(138) + rxt(139) + rxt(140) & + ) * y(87)) + mat(585) = -rxt(136)*y(18) + mat(417) = -rxt(137)*y(18) + mat(609) = -(rxt(138) + rxt(139) + rxt(140)) * y(18) + mat(717) = rxt(148)*y(17) + rxt(141)*y(86) + mat(677) = rxt(133)*y(17) + mat(326) = rxt(148)*y(2) + rxt(133)*y(97) + rxt(146)*y(86) + rxt(179)*y(84) & + + rxt(222)*y(55) + mat(103) = rxt(238)*y(86) + mat(210) = rxt(155)*y(86) + mat(503) = rxt(141)*y(2) + rxt(146)*y(17) + rxt(238)*y(16) + rxt(155)*y(5) & + + rxt(241)*y(15) + rxt(251)*y(57) + rxt(252)*y(58) + rxt(255) & + *y(59) + mat(283) = rxt(241)*y(86) + mat(346) = rxt(179)*y(17) + mat(152) = rxt(222)*y(17) + mat(74) = rxt(251)*y(86) + mat(134) = rxt(252)*y(86) + mat(259) = rxt(255)*y(86) + mat(623) = -((rxt(138) + rxt(139) + rxt(140)) * y(18) + rxt(143)*y(86) & + + rxt(149)*y(2) + rxt(150)*y(1) + 4._r8*rxt(151)*y(87) + rxt(162) & + *y(6) + rxt(174)*y(8) + rxt(175)*y(7) + (rxt(181) + rxt(182) & + ) * y(84) + rxt(188)*y(23) + rxt(206)*y(85) + rxt(210)*y(30) & + + rxt(244)*y(13)) + mat(278) = -(rxt(138) + rxt(139) + rxt(140)) * y(87) + mat(517) = -rxt(143)*y(87) + mat(731) = -rxt(149)*y(87) + mat(430) = -rxt(150)*y(87) + mat(453) = -rxt(162)*y(87) + mat(542) = -rxt(174)*y(87) + mat(480) = -rxt(175)*y(87) + mat(358) = -(rxt(181) + rxt(182)) * y(87) + mat(386) = -rxt(188)*y(87) + mat(407) = -rxt(206)*y(87) + mat(319) = -rxt(210)*y(87) + mat(642) = -rxt(244)*y(87) + mat(430) = mat(430) + rxt(142)*y(86) + mat(731) = mat(731) + rxt(242)*y(15) + rxt(152)*y(19) + mat(598) = rxt(136)*y(18) + mat(105) = rxt(239)*y(86) + mat(453) = mat(453) + rxt(243)*y(13) + mat(517) = mat(517) + rxt(142)*y(1) + rxt(239)*y(16) + rxt(173)*y(8) & + + rxt(147)*y(19) + rxt(186)*y(23) + rxt(209)*y(30) + rxt(262) & + *y(60) + .500_r8*rxt(264)*y(63) + mat(542) = mat(542) + rxt(173)*y(86) + rxt(240)*y(15) + mat(642) = mat(642) + rxt(243)*y(6) + rxt(189)*y(23) + mat(294) = rxt(242)*y(2) + rxt(240)*y(8) + rxt(183)*y(84) + rxt(207)*y(85) + mat(278) = mat(278) + rxt(136)*y(3) + mat(118) = rxt(152)*y(2) + rxt(147)*y(86) + rxt(180)*y(84) + mat(358) = mat(358) + rxt(183)*y(15) + rxt(180)*y(19) + mat(386) = mat(386) + rxt(186)*y(86) + rxt(189)*y(13) + mat(407) = mat(407) + rxt(207)*y(15) + mat(319) = mat(319) + rxt(209)*y(86) + mat(231) = rxt(262)*y(86) + mat(57) = .500_r8*rxt(264)*y(86) + mat(114) = -(rxt(147)*y(86) + rxt(152)*y(2) + rxt(180)*y(84)) + mat(493) = -rxt(147)*y(19) + mat(702) = -rxt(152)*y(19) + mat(342) = -rxt(180)*y(19) + mat(493) = mat(493) + 2.000_r8*rxt(145)*y(86) + mat(605) = 2.000_r8*rxt(151)*y(87) + mat(565) = -(rxt(108)*y(97) + rxt(221)*y(55) + rxt(263)*y(61)) + mat(688) = -rxt(108)*y(98) + mat(156) = -rxt(221)*y(98) + mat(50) = -rxt(263)*y(98) + mat(333) = rxt(146)*y(86) + mat(515) = rxt(146)*y(17) + 2.000_r8*rxt(144)*y(86) + rxt(170)*y(9) & + + rxt(176)*y(10) + rxt(245)*y(14) + rxt(241)*y(15) + rxt(143) & + *y(87) + rxt(147)*y(19) + rxt(197)*y(26) + rxt(201)*y(27) & + + rxt(217)*y(31) + mat(253) = rxt(170)*y(86) + mat(94) = rxt(176)*y(86) + mat(81) = rxt(245)*y(86) + mat(292) = rxt(241)*y(86) + mat(276) = rxt(140)*y(87) + mat(621) = rxt(143)*y(86) + rxt(140)*y(18) + mat(117) = rxt(147)*y(86) + mat(664) = rxt(197)*y(86) + (rxt(271)+rxt(276)+rxt(282))*y(27) + (rxt(272) & + +rxt(283))*y(32) + mat(223) = rxt(201)*y(86) + (rxt(271)+rxt(276)+rxt(282))*y(26) + mat(201) = rxt(217)*y(86) + mat(194) = (rxt(272)+rxt(283))*y(26) + mat(349) = -(rxt(178)*y(1) + rxt(179)*y(17) + rxt(180)*y(19) + (rxt(181) & + + rxt(182)) * y(87) + rxt(183)*y(15) + rxt(200)*y(27) + rxt(204) & + *y(28)) + mat(420) = -rxt(178)*y(84) + mat(328) = -rxt(179)*y(84) + mat(115) = -rxt(180)*y(84) + mat(613) = -(rxt(181) + rxt(182)) * y(84) + mat(286) = -rxt(183)*y(84) + mat(220) = -rxt(200)*y(84) + mat(237) = -rxt(204)*y(84) + mat(721) = rxt(185)*y(23) + rxt(198)*y(26) + mat(680) = rxt(134)*y(26) + rxt(129)*y(53) + mat(443) = rxt(190)*y(23) + mat(507) = rxt(186)*y(23) + rxt(197)*y(26) + mat(632) = rxt(189)*y(23) + mat(376) = rxt(185)*y(2) + rxt(190)*y(6) + rxt(186)*y(86) + rxt(189)*y(13) + ( & + + 4.000_r8*rxt(192)+2.000_r8*rxt(194))*y(23) + rxt(214)*y(30) & + + rxt(259)*y(59) + mat(656) = rxt(198)*y(2) + rxt(134)*y(97) + rxt(197)*y(86) + mat(309) = rxt(214)*y(23) + mat(39) = rxt(129)*y(97) + mat(261) = rxt(259)*y(23) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(340) = rxt(204)*y(28) + mat(364) = 2.000_r8*rxt(193)*y(23) + mat(647) = (rxt(271)+rxt(276)+rxt(282))*y(27) + (rxt(270)+rxt(275)+rxt(281)) & + *y(28) + mat(218) = (rxt(271)+rxt(276)+rxt(282))*y(26) + mat(233) = rxt(204)*y(84) + (rxt(270)+rxt(275)+rxt(281))*y(26) + mat(377) = -(rxt(185)*y(2) + (rxt(186) + rxt(187)) * y(86) + rxt(188)*y(87) & + + rxt(189)*y(13) + rxt(190)*y(6) + rxt(191)*y(7) + (4._r8*rxt(192) & + + 4._r8*rxt(193) + 4._r8*rxt(194) + 4._r8*rxt(195)) * y(23) & + + (rxt(213) + rxt(214) + rxt(215)) * y(30) + rxt(259)*y(59)) + mat(722) = -rxt(185)*y(23) + mat(508) = -(rxt(186) + rxt(187)) * y(23) + mat(614) = -rxt(188)*y(23) + mat(633) = -rxt(189)*y(23) + mat(444) = -rxt(190)*y(23) + mat(471) = -rxt(191)*y(23) + mat(310) = -(rxt(213) + rxt(214) + rxt(215)) * y(23) + mat(262) = -rxt(259)*y(23) + mat(421) = rxt(178)*y(84) + mat(722) = mat(722) + rxt(199)*y(27) + rxt(202)*y(28) + mat(508) = mat(508) + rxt(201)*y(27) + mat(614) = mat(614) + rxt(182)*y(84) + mat(350) = rxt(178)*y(1) + rxt(182)*y(87) + rxt(200)*y(27) + mat(67) = rxt(261)*y(59) + mat(221) = rxt(199)*y(2) + rxt(201)*y(86) + rxt(200)*y(84) + mat(238) = rxt(202)*y(2) + mat(262) = mat(262) + rxt(261)*y(24) + mat(64) = -(rxt(261)*y(59)) + mat(255) = -rxt(261)*y(24) + mat(366) = 2.000_r8*rxt(194)*y(23) + rxt(213)*y(30) + mat(300) = rxt(213)*y(23) + mat(363) = 2.000_r8*rxt(195)*y(23) + mat(668) = -(rxt(134)*y(97) + rxt(197)*y(86) + rxt(198)*y(2) + (rxt(270) & + + rxt(275) + rxt(281)) * y(28) + (rxt(271) + rxt(276) + rxt(282) & + ) * y(27) + (rxt(272) + rxt(283)) * y(32)) + mat(692) = -rxt(134)*y(26) + mat(519) = -rxt(197)*y(26) + mat(733) = -rxt(198)*y(26) + mat(243) = -(rxt(270) + rxt(275) + rxt(281)) * y(26) + mat(224) = -(rxt(271) + rxt(276) + rxt(282)) * y(26) + mat(195) = -(rxt(272) + rxt(283)) * y(26) + mat(337) = rxt(179)*y(84) + mat(519) = mat(519) + rxt(187)*y(23) + mat(296) = rxt(183)*y(84) + mat(625) = rxt(181)*y(84) + mat(119) = rxt(180)*y(84) + mat(360) = rxt(179)*y(17) + rxt(183)*y(15) + rxt(181)*y(87) + rxt(180)*y(19) & + + rxt(200)*y(27) + mat(388) = rxt(187)*y(86) + mat(224) = mat(224) + rxt(200)*y(84) + mat(219) = -(rxt(199)*y(2) + rxt(200)*y(84) + rxt(201)*y(86) + (rxt(271) & + + rxt(276) + rxt(282)) * y(26)) + mat(712) = -rxt(199)*y(27) + mat(343) = -rxt(200)*y(27) + mat(498) = -rxt(201)*y(27) + mat(650) = -(rxt(271) + rxt(276) + rxt(282)) * y(27) + mat(498) = mat(498) + rxt(203)*y(28) + mat(608) = rxt(188)*y(23) + mat(367) = rxt(188)*y(87) + mat(234) = rxt(203)*y(86) + mat(235) = -(rxt(202)*y(2) + rxt(203)*y(86) + rxt(204)*y(84) + (rxt(270) & + + rxt(275) + rxt(281)) * y(26)) + mat(714) = -rxt(202)*y(28) + mat(500) = -rxt(203)*y(28) + mat(344) = -rxt(204)*y(28) + mat(651) = -(rxt(270) + rxt(275) + rxt(281)) * y(28) + mat(464) = rxt(191)*y(23) + mat(369) = rxt(191)*y(7) + mat(365) = rxt(215)*y(30) + mat(648) = (rxt(272)+rxt(283))*y(32) + mat(299) = rxt(215)*y(23) + mat(188) = (rxt(272)+rxt(283))*y(26) + mat(399) = -(rxt(205)*y(1) + rxt(206)*y(87) + rxt(207)*y(15)) + mat(422) = -rxt(205)*y(85) + mat(615) = -rxt(206)*y(85) + mat(287) = -rxt(207)*y(85) + mat(723) = rxt(208)*y(30) + rxt(218)*y(31) + mat(682) = rxt(135)*y(31) + mat(445) = rxt(211)*y(30) + mat(509) = rxt(209)*y(30) + rxt(217)*y(31) + mat(378) = (rxt(213)+rxt(214))*y(30) + mat(311) = rxt(208)*y(2) + rxt(211)*y(6) + rxt(209)*y(86) + (rxt(213) & + +rxt(214))*y(23) + 4.000_r8*rxt(216)*y(30) + rxt(260)*y(59) + mat(199) = rxt(218)*y(2) + rxt(135)*y(97) + rxt(217)*y(86) + mat(263) = rxt(260)*y(30) + mat(307) = -(rxt(208)*y(2) + rxt(209)*y(86) + rxt(210)*y(87) + rxt(211)*y(6) & + + rxt(212)*y(7) + (rxt(213) + rxt(214) + rxt(215)) * y(23) & + + 4._r8*rxt(216)*y(30) + rxt(260)*y(59)) + mat(719) = -rxt(208)*y(30) + mat(505) = -rxt(209)*y(30) + mat(611) = -rxt(210)*y(30) + mat(441) = -rxt(211)*y(30) + mat(468) = -rxt(212)*y(30) + mat(374) = -(rxt(213) + rxt(214) + rxt(215)) * y(30) + mat(260) = -rxt(260)*y(30) + mat(418) = rxt(205)*y(85) + mat(719) = mat(719) + rxt(219)*y(32) + rxt(220)*y(33) + mat(395) = rxt(205)*y(1) + mat(190) = rxt(219)*y(2) + mat(109) = rxt(220)*y(2) + mat(197) = -(rxt(135)*y(97) + rxt(217)*y(86) + rxt(218)*y(2)) + mat(675) = -rxt(135)*y(31) + mat(496) = -rxt(217)*y(31) + mat(710) = -rxt(218)*y(31) + mat(281) = rxt(207)*y(85) + mat(607) = rxt(206)*y(85) + mat(392) = rxt(207)*y(15) + rxt(206)*y(87) + mat(189) = -(rxt(219)*y(2) + (rxt(272) + rxt(283)) * y(26)) + mat(709) = -rxt(219)*y(32) + mat(649) = -(rxt(272) + rxt(283)) * y(32) + mat(606) = rxt(210)*y(30) + mat(302) = rxt(210)*y(87) + mat(106) = -(rxt(220)*y(2)) + mat(701) = -rxt(220)*y(33) + mat(460) = rxt(212)*y(30) + mat(301) = rxt(212)*y(7) + mat(122) = -((rxt(286) + rxt(287)) * y(2) + rxt(294)*y(3) + rxt(298)*y(93)) + mat(703) = -(rxt(286) + rxt(287)) * y(88) + mat(576) = -rxt(294)*y(88) + mat(175) = -rxt(298)*y(88) + mat(158) = -(rxt(289)*y(5) + rxt(290)*y(6) + rxt(297)*y(93)) + mat(206) = -rxt(289)*y(89) + mat(435) = -rxt(290)*y(89) + mat(177) = -rxt(297)*y(89) + mat(579) = rxt(294)*y(88) + rxt(291)*y(90) + rxt(284)*y(91) + mat(124) = rxt(294)*y(3) + mat(85) = rxt(291)*y(3) + mat(141) = rxt(284)*y(3) + mat(83) = -((rxt(291) + rxt(292)) * y(3) + rxt(293)*y(2)) + mat(574) = -(rxt(291) + rxt(292)) * y(90) + mat(698) = -rxt(293)*y(90) + mat(140) = -(rxt(284)*y(3)) + mat(578) = -rxt(284)*y(91) + mat(705) = rxt(287)*y(88) + rxt(293)*y(90) + mat(123) = rxt(287)*y(2) + mat(84) = rxt(293)*y(2) + mat(167) = -(rxt(296)*y(93)) + mat(178) = -rxt(296)*y(92) + mat(707) = rxt(286)*y(88) + mat(580) = rxt(292)*y(90) + mat(207) = rxt(289)*y(89) + mat(436) = rxt(290)*y(89) + mat(125) = rxt(286)*y(2) + mat(159) = rxt(289)*y(5) + rxt(290)*y(6) + mat(86) = rxt(292)*y(3) + mat(97) = -(rxt(153)*y(3) + rxt(154)*y(2)) + mat(575) = -rxt(153)*y(94) + mat(699) = -rxt(154)*y(94) + mat(699) = mat(699) + rxt(286)*y(88) + mat(121) = rxt(286)*y(2) + .900_r8*rxt(298)*y(93) + mat(166) = .800_r8*rxt(296)*y(93) + mat(174) = .900_r8*rxt(298)*y(88) + .800_r8*rxt(296)*y(92) + mat(179) = -(rxt(296)*y(92) + rxt(297)*y(89) + rxt(298)*y(88)) + mat(168) = -rxt(296)*y(93) + mat(160) = -rxt(297)*y(93) + mat(126) = -rxt(298)*y(93) + mat(24) = -(rxt(128)*y(97)) + mat(671) = -rxt(128)*y(52) + mat(37) = -(rxt(129)*y(97)) + mat(673) = -rxt(129)*y(53) + mat(323) = rxt(222)*y(55) + mat(245) = rxt(224)*y(55) + mat(548) = rxt(221)*y(55) + mat(149) = rxt(222)*y(17) + rxt(224)*y(9) + rxt(221)*y(98) + mat(150) = -(rxt(221)*y(98) + rxt(222)*y(17) + rxt(224)*y(9)) + mat(550) = -rxt(221)*y(55) + mat(324) = -rxt(222)*y(55) + mat(246) = -rxt(224)*y(55) + mat(674) = 2.000_r8*rxt(128)*y(52) + rxt(129)*y(53) + mat(25) = 2.000_r8*rxt(128)*y(97) + mat(38) = rxt(129)*y(97) + mat(69) = -(rxt(250)*y(2) + rxt(251)*y(86)) + mat(697) = -rxt(250)*y(57) + mat(489) = -rxt(251)*y(57) + mat(132) = -(rxt(252)*y(86) + rxt(253)*y(3) + rxt(254)*y(1)) + mat(494) = -rxt(252)*y(58) + mat(577) = -rxt(253)*y(58) + mat(414) = -rxt(254)*y(58) + mat(258) = -(rxt(255)*y(86) + rxt(256)*y(3) + rxt(257)*y(1) + rxt(258)*y(7) & + + rxt(259)*y(23) + rxt(260)*y(30) + rxt(261)*y(24)) + mat(502) = -rxt(255)*y(59) + mat(584) = -rxt(256)*y(59) + mat(416) = -rxt(257)*y(59) + mat(466) = -rxt(258)*y(59) + mat(371) = -rxt(259)*y(59) + mat(305) = -rxt(260)*y(59) + mat(66) = -rxt(261)*y(59) + mat(416) = mat(416) + rxt(254)*y(58) + mat(716) = rxt(250)*y(57) + mat(584) = mat(584) + rxt(253)*y(58) + mat(502) = mat(502) + rxt(252)*y(58) + mat(73) = rxt(250)*y(2) + mat(133) = rxt(254)*y(1) + rxt(253)*y(3) + rxt(252)*y(86) + mat(227) = -(rxt(262)*y(86)) + mat(499) = -rxt(262)*y(60) + mat(415) = rxt(257)*y(59) + mat(583) = rxt(256)*y(59) + mat(463) = rxt(258)*y(59) + mat(499) = mat(499) + rxt(251)*y(57) + rxt(255)*y(59) + (.500_r8*rxt(264) & + +rxt(265))*y(63) + mat(525) = rxt(266)*y(63) + mat(368) = rxt(259)*y(59) + mat(65) = rxt(261)*y(59) + mat(303) = rxt(260)*y(59) + mat(72) = rxt(251)*y(86) + mat(257) = rxt(257)*y(1) + rxt(256)*y(3) + rxt(258)*y(7) + rxt(255)*y(86) & + + rxt(259)*y(23) + rxt(261)*y(24) + rxt(260)*y(30) + mat(53) = (.500_r8*rxt(264)+rxt(265))*y(86) + rxt(266)*y(8) + end subroutine nlnmat03 + subroutine nlnmat04( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(48) = -(rxt(263)*y(98)) + mat(549) = -rxt(263)*y(61) + mat(487) = rxt(262)*y(60) + mat(226) = rxt(262)*y(86) + mat(547) = rxt(263)*y(61) + mat(47) = rxt(263)*y(98) + mat(52) = -((rxt(264) + rxt(265)) * y(86) + rxt(266)*y(8)) + mat(488) = -(rxt(264) + rxt(265)) * y(63) + mat(522) = -rxt(266)*y(63) + end subroutine nlnmat04 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = mat( 24) + lmat( 24) + mat( 25) = mat( 25) + lmat( 25) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = mat( 30) + lmat( 30) + mat( 31) = mat( 31) + lmat( 31) + mat( 32) = mat( 32) + lmat( 32) + mat( 33) = mat( 33) + lmat( 33) + mat( 34) = lmat( 34) + mat( 35) = lmat( 35) + mat( 36) = lmat( 36) + mat( 37) = mat( 37) + lmat( 37) + mat( 38) = mat( 38) + lmat( 38) + mat( 39) = mat( 39) + lmat( 39) + mat( 41) = lmat( 41) + mat( 42) = lmat( 42) + mat( 43) = lmat( 43) + mat( 44) = lmat( 44) + mat( 45) = lmat( 45) + mat( 46) = lmat( 46) + mat( 48) = mat( 48) + lmat( 48) + mat( 49) = lmat( 49) + mat( 51) = lmat( 51) + mat( 52) = mat( 52) + lmat( 52) + mat( 58) = lmat( 58) + mat( 59) = lmat( 59) + mat( 60) = lmat( 60) + mat( 61) = lmat( 61) + mat( 62) = lmat( 62) + mat( 63) = lmat( 63) + mat( 64) = mat( 64) + lmat( 64) + mat( 67) = mat( 67) + lmat( 67) + mat( 68) = lmat( 68) + mat( 69) = mat( 69) + lmat( 69) + mat( 70) = mat( 70) + lmat( 70) + mat( 71) = lmat( 71) + mat( 77) = mat( 77) + lmat( 77) + mat( 78) = lmat( 78) + mat( 79) = lmat( 79) + mat( 80) = mat( 80) + lmat( 80) + mat( 83) = mat( 83) + lmat( 83) + mat( 90) = mat( 90) + lmat( 90) + mat( 91) = mat( 91) + lmat( 91) + mat( 92) = mat( 92) + lmat( 92) + mat( 93) = lmat( 93) + mat( 96) = lmat( 96) + mat( 97) = mat( 97) + lmat( 97) + mat( 102) = mat( 102) + lmat( 102) + mat( 106) = mat( 106) + lmat( 106) + mat( 107) = lmat( 107) + mat( 108) = lmat( 108) + mat( 109) = mat( 109) + lmat( 109) + mat( 110) = lmat( 110) + mat( 111) = lmat( 111) + mat( 112) = mat( 112) + lmat( 112) + mat( 114) = mat( 114) + lmat( 114) + mat( 116) = mat( 116) + lmat( 116) + mat( 122) = mat( 122) + lmat( 122) + mat( 132) = mat( 132) + lmat( 132) + mat( 139) = lmat( 139) + mat( 140) = mat( 140) + lmat( 140) + mat( 141) = mat( 141) + lmat( 141) + mat( 142) = lmat( 142) + mat( 143) = lmat( 143) + mat( 149) = mat( 149) + lmat( 149) + mat( 150) = mat( 150) + lmat( 150) + mat( 157) = lmat( 157) + mat( 158) = mat( 158) + lmat( 158) + mat( 159) = mat( 159) + lmat( 159) + mat( 162) = mat( 162) + lmat( 162) + mat( 167) = mat( 167) + lmat( 167) + mat( 179) = mat( 179) + lmat( 179) + mat( 189) = mat( 189) + lmat( 189) + mat( 192) = lmat( 192) + mat( 193) = mat( 193) + lmat( 193) + mat( 197) = mat( 197) + lmat( 197) + mat( 198) = lmat( 198) + mat( 199) = mat( 199) + lmat( 199) + mat( 204) = lmat( 204) + mat( 208) = lmat( 208) + mat( 209) = mat( 209) + lmat( 209) + mat( 219) = mat( 219) + lmat( 219) + mat( 220) = mat( 220) + lmat( 220) + mat( 222) = mat( 222) + lmat( 222) + mat( 227) = mat( 227) + lmat( 227) + mat( 228) = lmat( 228) + mat( 232) = lmat( 232) + mat( 234) = mat( 234) + lmat( 234) + mat( 235) = mat( 235) + lmat( 235) + mat( 236) = mat( 236) + lmat( 236) + mat( 237) = mat( 237) + lmat( 237) + mat( 238) = mat( 238) + lmat( 238) + mat( 239) = lmat( 239) + mat( 241) = mat( 241) + lmat( 241) + mat( 247) = mat( 247) + lmat( 247) + mat( 250) = lmat( 250) + mat( 251) = mat( 251) + lmat( 251) + mat( 256) = lmat( 256) + mat( 258) = mat( 258) + lmat( 258) + mat( 271) = mat( 271) + lmat( 271) + mat( 272) = mat( 272) + lmat( 272) + mat( 280) = mat( 280) + lmat( 280) + mat( 283) = mat( 283) + lmat( 283) + mat( 284) = mat( 284) + lmat( 284) + mat( 285) = lmat( 285) + mat( 307) = mat( 307) + lmat( 307) + mat( 311) = mat( 311) + lmat( 311) + mat( 322) = mat( 322) + lmat( 322) + mat( 327) = mat( 327) + lmat( 327) + mat( 341) = mat( 341) + lmat( 341) + mat( 349) = mat( 349) + lmat( 349) + mat( 351) = lmat( 351) + mat( 358) = mat( 358) + lmat( 358) + mat( 359) = lmat( 359) + mat( 360) = mat( 360) + lmat( 360) + mat( 376) = mat( 376) + lmat( 376) + mat( 377) = mat( 377) + lmat( 377) + mat( 390) = mat( 390) + lmat( 390) + mat( 399) = mat( 399) + lmat( 399) + mat( 412) = mat( 412) + lmat( 412) + mat( 423) = mat( 423) + lmat( 423) + mat( 429) = mat( 429) + lmat( 429) + mat( 433) = mat( 433) + lmat( 433) + mat( 434) = mat( 434) + lmat( 434) + mat( 436) = mat( 436) + lmat( 436) + mat( 437) = lmat( 437) + mat( 438) = mat( 438) + lmat( 438) + mat( 447) = mat( 447) + lmat( 447) + mat( 457) = mat( 457) + lmat( 457) + mat( 465) = mat( 465) + lmat( 465) + mat( 474) = mat( 474) + lmat( 474) + mat( 475) = mat( 475) + lmat( 475) + mat( 476) = mat( 476) + lmat( 476) + mat( 484) = mat( 484) + lmat( 484) + mat( 485) = lmat( 485) + mat( 486) = lmat( 486) + mat( 507) = mat( 507) + lmat( 507) + mat( 509) = mat( 509) + lmat( 509) + mat( 513) = mat( 513) + lmat( 513) + mat( 515) = mat( 515) + lmat( 515) + mat( 517) = mat( 517) + lmat( 517) + mat( 518) = mat( 518) + lmat( 518) + mat( 526) = mat( 526) + lmat( 526) + mat( 536) = mat( 536) + lmat( 536) + mat( 537) = mat( 537) + lmat( 537) + mat( 539) = mat( 539) + lmat( 539) + mat( 541) = mat( 541) + lmat( 541) + mat( 546) = mat( 546) + lmat( 546) + mat( 554) = lmat( 554) + mat( 556) = lmat( 556) + mat( 563) = mat( 563) + lmat( 563) + mat( 565) = mat( 565) + lmat( 565) + mat( 570) = mat( 570) + lmat( 570) + mat( 571) = lmat( 571) + mat( 578) = mat( 578) + lmat( 578) + mat( 579) = mat( 579) + lmat( 579) + mat( 581) = lmat( 581) + mat( 597) = mat( 597) + lmat( 597) + mat( 601) = mat( 601) + lmat( 601) + mat( 602) = mat( 602) + lmat( 602) + mat( 605) = mat( 605) + lmat( 605) + mat( 623) = mat( 623) + lmat( 623) + mat( 643) = mat( 643) + lmat( 643) + mat( 653) = lmat( 653) + mat( 656) = mat( 656) + lmat( 656) + mat( 668) = mat( 668) + lmat( 668) + mat( 671) = mat( 671) + lmat( 671) + mat( 673) = mat( 673) + lmat( 673) + mat( 674) = mat( 674) + lmat( 674) + mat( 677) = mat( 677) + lmat( 677) + mat( 678) = lmat( 678) + mat( 679) = mat( 679) + lmat( 679) + mat( 680) = mat( 680) + lmat( 680) + mat( 682) = mat( 682) + lmat( 682) + mat( 684) = lmat( 684) + mat( 686) = mat( 686) + lmat( 686) + mat( 689) = mat( 689) + lmat( 689) + mat( 690) = lmat( 690) + mat( 691) = lmat( 691) + mat( 693) = mat( 693) + lmat( 693) + mat( 694) = mat( 694) + lmat( 694) + mat( 705) = mat( 705) + lmat( 705) + mat( 708) = lmat( 708) + mat( 735) = mat( 735) + lmat( 735) + mat( 128) = 0._r8 + mat( 130) = 0._r8 + mat( 144) = 0._r8 + mat( 145) = 0._r8 + mat( 147) = 0._r8 + mat( 170) = 0._r8 + mat( 171) = 0._r8 + mat( 172) = 0._r8 + mat( 176) = 0._r8 + mat( 181) = 0._r8 + mat( 182) = 0._r8 + mat( 183) = 0._r8 + mat( 184) = 0._r8 + mat( 185) = 0._r8 + mat( 191) = 0._r8 + mat( 205) = 0._r8 + mat( 215) = 0._r8 + mat( 216) = 0._r8 + mat( 230) = 0._r8 + mat( 242) = 0._r8 + mat( 248) = 0._r8 + mat( 249) = 0._r8 + mat( 254) = 0._r8 + mat( 268) = 0._r8 + mat( 270) = 0._r8 + mat( 288) = 0._r8 + mat( 289) = 0._r8 + mat( 293) = 0._r8 + mat( 295) = 0._r8 + mat( 297) = 0._r8 + mat( 304) = 0._r8 + mat( 306) = 0._r8 + mat( 308) = 0._r8 + mat( 312) = 0._r8 + mat( 316) = 0._r8 + mat( 317) = 0._r8 + mat( 320) = 0._r8 + mat( 321) = 0._r8 + mat( 325) = 0._r8 + mat( 329) = 0._r8 + mat( 330) = 0._r8 + mat( 332) = 0._r8 + mat( 334) = 0._r8 + mat( 335) = 0._r8 + mat( 336) = 0._r8 + mat( 345) = 0._r8 + mat( 353) = 0._r8 + mat( 356) = 0._r8 + mat( 361) = 0._r8 + mat( 362) = 0._r8 + mat( 370) = 0._r8 + mat( 372) = 0._r8 + mat( 375) = 0._r8 + mat( 379) = 0._r8 + mat( 383) = 0._r8 + mat( 384) = 0._r8 + mat( 389) = 0._r8 + mat( 393) = 0._r8 + mat( 396) = 0._r8 + mat( 397) = 0._r8 + mat( 398) = 0._r8 + mat( 401) = 0._r8 + mat( 402) = 0._r8 + mat( 403) = 0._r8 + mat( 404) = 0._r8 + mat( 405) = 0._r8 + mat( 408) = 0._r8 + mat( 409) = 0._r8 + mat( 410) = 0._r8 + mat( 411) = 0._r8 + mat( 419) = 0._r8 + mat( 428) = 0._r8 + mat( 431) = 0._r8 + mat( 432) = 0._r8 + mat( 439) = 0._r8 + mat( 442) = 0._r8 + mat( 451) = 0._r8 + mat( 455) = 0._r8 + mat( 456) = 0._r8 + mat( 461) = 0._r8 + mat( 467) = 0._r8 + mat( 469) = 0._r8 + mat( 470) = 0._r8 + mat( 472) = 0._r8 + mat( 478) = 0._r8 + mat( 481) = 0._r8 + mat( 482) = 0._r8 + mat( 483) = 0._r8 + mat( 495) = 0._r8 + mat( 520) = 0._r8 + mat( 527) = 0._r8 + mat( 528) = 0._r8 + mat( 530) = 0._r8 + mat( 531) = 0._r8 + mat( 532) = 0._r8 + mat( 533) = 0._r8 + mat( 534) = 0._r8 + mat( 535) = 0._r8 + mat( 540) = 0._r8 + mat( 543) = 0._r8 + mat( 544) = 0._r8 + mat( 545) = 0._r8 + mat( 551) = 0._r8 + mat( 552) = 0._r8 + mat( 553) = 0._r8 + mat( 555) = 0._r8 + mat( 557) = 0._r8 + mat( 558) = 0._r8 + mat( 559) = 0._r8 + mat( 560) = 0._r8 + mat( 561) = 0._r8 + mat( 562) = 0._r8 + mat( 564) = 0._r8 + mat( 566) = 0._r8 + mat( 567) = 0._r8 + mat( 568) = 0._r8 + mat( 569) = 0._r8 + mat( 586) = 0._r8 + mat( 587) = 0._r8 + mat( 588) = 0._r8 + mat( 589) = 0._r8 + mat( 590) = 0._r8 + mat( 593) = 0._r8 + mat( 594) = 0._r8 + mat( 595) = 0._r8 + mat( 596) = 0._r8 + mat( 599) = 0._r8 + mat( 600) = 0._r8 + mat( 610) = 0._r8 + mat( 626) = 0._r8 + mat( 629) = 0._r8 + mat( 631) = 0._r8 + mat( 634) = 0._r8 + mat( 635) = 0._r8 + mat( 638) = 0._r8 + mat( 639) = 0._r8 + mat( 640) = 0._r8 + mat( 644) = 0._r8 + mat( 645) = 0._r8 + mat( 646) = 0._r8 + mat( 654) = 0._r8 + mat( 655) = 0._r8 + mat( 657) = 0._r8 + mat( 658) = 0._r8 + mat( 659) = 0._r8 + mat( 660) = 0._r8 + mat( 661) = 0._r8 + mat( 663) = 0._r8 + mat( 665) = 0._r8 + mat( 666) = 0._r8 + mat( 667) = 0._r8 + mat( 676) = 0._r8 + mat( 681) = 0._r8 + mat( 685) = 0._r8 + mat( 687) = 0._r8 + mat( 704) = 0._r8 + mat( 706) = 0._r8 + mat( 713) = 0._r8 + mat( 715) = 0._r8 + mat( 729) = 0._r8 + mat( 732) = 0._r8 + mat( 734) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 24) = mat( 24) - dti + mat( 27) = mat( 27) - dti + mat( 30) = mat( 30) - dti + mat( 33) = mat( 33) - dti + mat( 35) = mat( 35) - dti + mat( 37) = mat( 37) - dti + mat( 41) = mat( 41) - dti + mat( 44) = mat( 44) - dti + mat( 48) = mat( 48) - dti + mat( 52) = mat( 52) - dti + mat( 58) = mat( 58) - dti + mat( 64) = mat( 64) - dti + mat( 69) = mat( 69) - dti + mat( 77) = mat( 77) - dti + mat( 83) = mat( 83) - dti + mat( 90) = mat( 90) - dti + mat( 97) = mat( 97) - dti + mat( 102) = mat( 102) - dti + mat( 106) = mat( 106) - dti + mat( 114) = mat( 114) - dti + mat( 122) = mat( 122) - dti + mat( 132) = mat( 132) - dti + mat( 140) = mat( 140) - dti + mat( 150) = mat( 150) - dti + mat( 158) = mat( 158) - dti + mat( 167) = mat( 167) - dti + mat( 179) = mat( 179) - dti + mat( 189) = mat( 189) - dti + mat( 197) = mat( 197) - dti + mat( 209) = mat( 209) - dti + mat( 219) = mat( 219) - dti + mat( 227) = mat( 227) - dti + mat( 235) = mat( 235) - dti + mat( 247) = mat( 247) - dti + mat( 258) = mat( 258) - dti + mat( 272) = mat( 272) - dti + mat( 284) = mat( 284) - dti + mat( 307) = mat( 307) - dti + mat( 327) = mat( 327) - dti + mat( 349) = mat( 349) - dti + mat( 377) = mat( 377) - dti + mat( 399) = mat( 399) - dti + mat( 423) = mat( 423) - dti + mat( 447) = mat( 447) - dti + mat( 475) = mat( 475) - dti + mat( 513) = mat( 513) - dti + mat( 539) = mat( 539) - dti + mat( 565) = mat( 565) - dti + mat( 597) = mat( 597) - dti + mat( 623) = mat( 623) - dti + mat( 643) = mat( 643) - dti + mat( 668) = mat( 668) - dti + mat( 693) = mat( 693) - dti + mat( 735) = mat( 735) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..35a88bf5f2 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 71) = p_rate(:,k, 71) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 75) = p_rate(:,k, 75) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 76) = p_rate(:,k, 76) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 78) = p_rate(:,k, 78) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 83) = p_rate(:,k, 83) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 87) = p_rate(:,k, 87) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 88) = p_rate(:,k, 88) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 90) = p_rate(:,k, 90) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..ffd6499993 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 @@ -0,0 +1,458 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = (rxt(:,:,223)* y(:,:,55) +rxt(:,:,184)* y(:,:,84) +rxt(:,:,237) & + * y(:,:,86) + (rxt(:,:,130) +rxt(:,:,131) +rxt(:,:,132))* y(:,:,97) & + + rxt(:,:,59) + rxt(:,:,60) + het_rates(:,:,12))* y(:,:,12) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,109) +rxt(:,:,110))* y(:,:,97) + rxt(:,:,5) & + + het_rates(:,:,4))* y(:,:,4) + prod(:,:,2) = 0._r8 + loss(:,:,3) = (rxt(:,:,225)* y(:,:,84) +rxt(:,:,226)* y(:,:,86) + rxt(:,:,37) & + + het_rates(:,:,34))* y(:,:,34) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,230)* y(:,:,84) +rxt(:,:,229)* y(:,:,86) +rxt(:,:,121) & + * y(:,:,97) + rxt(:,:,48) + het_rates(:,:,35))* y(:,:,35) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,112)* y(:,:,97) + rxt(:,:,40) + het_rates(:,:,36)) & + * y(:,:,36) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,113)* y(:,:,97) + rxt(:,:,41) + het_rates(:,:,37)) & + * y(:,:,37) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,114)* y(:,:,97) + rxt(:,:,42) + het_rates(:,:,38)) & + * y(:,:,38) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,115)* y(:,:,97) + rxt(:,:,43) + het_rates(:,:,46)) & + * y(:,:,46) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,116)* y(:,:,97) + rxt(:,:,44) + het_rates(:,:,47)) & + * y(:,:,47) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,228)* y(:,:,86) +rxt(:,:,117)* y(:,:,97) & + + rxt(:,:,45) + het_rates(:,:,39))* y(:,:,39) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,231)* y(:,:,86) +rxt(:,:,118)* y(:,:,97) & + + rxt(:,:,46) + het_rates(:,:,44))* y(:,:,44) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,232)* y(:,:,86) +rxt(:,:,119)* y(:,:,97) & + + rxt(:,:,47) + het_rates(:,:,45))* y(:,:,45) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,120)* y(:,:,97) + rxt(:,:,38) + het_rates(:,:,40)) & + * y(:,:,40) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,227)* y(:,:,86) + rxt(:,:,39) + het_rates(:,:,41)) & + * y(:,:,41) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,123)* y(:,:,97) + rxt(:,:,49) + het_rates(:,:,42)) & + * y(:,:,42) + prod(:,:,15) = 0._r8 + loss(:,:,16) = (rxt(:,:,122)* y(:,:,97) + rxt(:,:,50) + het_rates(:,:,43)) & + * y(:,:,43) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,124)* y(:,:,97) + rxt(:,:,53) + het_rates(:,:,48)) & + * y(:,:,48) + prod(:,:,17) = 0._r8 + loss(:,:,18) = (rxt(:,:,125)* y(:,:,97) + rxt(:,:,54) + het_rates(:,:,49)) & + * y(:,:,49) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,236)* y(:,:,84) +rxt(:,:,234)* y(:,:,86) & + +rxt(:,:,126)* y(:,:,97) + rxt(:,:,51) + het_rates(:,:,50)) & + * y(:,:,50) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,235)* y(:,:,84) +rxt(:,:,233)* y(:,:,86) & + +rxt(:,:,127)* y(:,:,97) + rxt(:,:,52) + het_rates(:,:,51)) & + * y(:,:,51) + prod(:,:,20) = 0._r8 + loss(:,:,21) = (rxt(:,:,288)* y(:,:,91) + rxt(:,:,58) + rxt(:,:,91) & + + het_rates(:,:,56))* y(:,:,56) + prod(:,:,21) =.440_r8*rxt(:,:,60)*y(:,:,12) + loss(:,:,22) = ( + het_rates(:,:,20))* y(:,:,20) + prod(:,:,22) = 0._r8 + loss(:,:,23) = ( + het_rates(:,:,21))* y(:,:,21) + prod(:,:,23) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(64) = (rxt(93)* y(2) +rxt(163)* y(6) +rxt(166)* y(7) +rxt(137)* y(18) & + +rxt(254)* y(58) +rxt(257)* y(59) +rxt(178)* y(84) +rxt(205)* y(85) & + +rxt(142)* y(86) +rxt(150)* y(87) +rxt(111)* y(97) + rxt(3) + rxt(4) & + + het_rates(1))* y(1) + prod(64) =rxt(92)*y(3)*y(2) + loss(75) = (rxt(93)* y(1) + 2._r8*rxt(94)* y(2) +rxt(92)* y(3) +rxt(161) & + * y(6) + (rxt(164) +rxt(165))* y(7) +rxt(172)* y(8) +rxt(242)* y(15) & + +rxt(148)* y(17) +rxt(152)* y(19) +rxt(185)* y(23) +rxt(198)* y(26) & + +rxt(199)* y(27) +rxt(202)* y(28) +rxt(208)* y(30) +rxt(218)* y(31) & + +rxt(219)* y(32) +rxt(220)* y(33) +rxt(250)* y(57) +rxt(141)* y(86) & + +rxt(149)* y(87) + (rxt(286) +rxt(287))* y(88) +rxt(293)* y(90) & + + rxt(66) + rxt(67) + rxt(68) + rxt(79) + rxt(80) + rxt(81) & + + het_rates(2))* y(2) + prod(75) = (rxt(1) +2.000_r8*rxt(2) +rxt(72) +rxt(73) +rxt(74) + & + 2.000_r8*rxt(77) +rxt(84) +rxt(85) +rxt(86) +2.000_r8*rxt(89) + & + rxt(106)*y(97) +rxt(107)*y(97) +rxt(156)*y(5) +rxt(253)*y(58) + & + rxt(256)*y(59) +rxt(284)*y(91) +rxt(292)*y(90))*y(3) & + + (rxt(157)*y(6) +rxt(158)*y(7) +rxt(289)*y(89))*y(5) & + + (rxt(296)*y(92) +1.150_r8*rxt(297)*y(89))*y(93) +rxt(4)*y(1) & + +rxt(6)*y(6) +rxt(8)*y(7) +rxt(12)*y(8) +rxt(10)*y(11) & + +rxt(140)*y(87)*y(18) +rxt(24)*y(23) +rxt(25)*y(24) +rxt(32)*y(30) & + +rxt(65)*y(59) +rxt(62)*y(60) +rxt(63)*y(61) +rxt(144)*y(86)*y(86) & + +rxt(105)*y(97) +rxt(21)*y(98) + loss(74) = (rxt(111)* y(1) + (rxt(106) +rxt(107))* y(3) + (rxt(109) + & + rxt(110))* y(4) + (rxt(130) +rxt(131) +rxt(132))* y(12) +rxt(133) & + * y(17) +rxt(134)* y(26) +rxt(135)* y(31) +rxt(121)* y(35) +rxt(112) & + * y(36) +rxt(113)* y(37) +rxt(114)* y(38) +rxt(117)* y(39) +rxt(120) & + * y(40) +rxt(123)* y(42) +rxt(122)* y(43) +rxt(118)* y(44) +rxt(119) & + * y(45) +rxt(115)* y(46) +rxt(116)* y(47) +rxt(124)* y(48) +rxt(125) & + * y(49) +rxt(126)* y(50) +rxt(127)* y(51) +rxt(128)* y(52) +rxt(129) & + * y(53) +rxt(108)* y(98) + rxt(105) + het_rates(97))* y(97) + prod(74) = (rxt(1) +rxt(153)*y(94))*y(3) +rxt(3)*y(1) +.850_r8*rxt(297)*y(93) & + *y(89) +rxt(20)*y(98) + loss(70) = (rxt(92)* y(2) +rxt(156)* y(5) +rxt(136)* y(18) +rxt(253)* y(58) & + +rxt(256)* y(59) +rxt(294)* y(88) + (rxt(291) +rxt(292))* y(90) & + +rxt(284)* y(91) +rxt(153)* y(94) +rxt(102)* y(96) +rxt(106)* y(97) & + + rxt(1) + rxt(2) + rxt(70) + rxt(72) + rxt(73) + rxt(74) + rxt(77) & + + rxt(82) + rxt(84) + rxt(85) + rxt(86) + rxt(89) + het_rates(3)) & + * y(3) + prod(70) = (rxt(4) +2.000_r8*rxt(93)*y(2) +2.000_r8*rxt(111)*y(97) + & + rxt(137)*y(18) +rxt(142)*y(86) +2.000_r8*rxt(150)*y(87) + & + rxt(163)*y(6) +rxt(166)*y(7) +rxt(178)*y(84) +rxt(205)*y(85) + & + rxt(254)*y(58) +rxt(257)*y(59))*y(1) + (rxt(139)*y(18) + & + rxt(143)*y(86) +rxt(149)*y(2) +rxt(151)*y(87) +rxt(174)*y(8) + & + rxt(181)*y(84) +rxt(188)*y(23) +rxt(206)*y(85) +rxt(210)*y(30) + & + rxt(244)*y(13))*y(87) + (rxt(94)*y(2) +rxt(101)*y(96) + & + rxt(141)*y(86) +rxt(164)*y(7) +rxt(172)*y(8) +rxt(185)*y(23) + & + rxt(208)*y(30))*y(2) + (rxt(187)*y(86) +rxt(192)*y(23) + & + rxt(193)*y(23) +rxt(214)*y(30) +rxt(215)*y(30))*y(23) + (rxt(103) + & + rxt(104) +2.000_r8*rxt(102)*y(3))*y(96) +rxt(110)*y(97)*y(4) & + +rxt(160)*y(7)*y(5) +rxt(290)*y(89)*y(6) +rxt(13)*y(8) & + +rxt(176)*y(86)*y(10) +rxt(216)*y(30)*y(30) +rxt(100)*y(95) + loss(25) = (rxt(98)* y(1) +rxt(95)* y(2) +rxt(96)* y(3) +rxt(99)* y(56) & + + rxt(97) + rxt(100) + het_rates(95))* y(95) + prod(25) =rxt(106)*y(97)*y(3) + loss(24) = (rxt(101)* y(2) +rxt(102)* y(3) + rxt(103) + rxt(104) & + + het_rates(96))* y(96) + prod(24) = (rxt(97) +rxt(99)*y(56) +rxt(95)*y(2) +rxt(96)*y(3) +rxt(98)*y(1)) & + *y(95) +rxt(3)*y(1) + loss(60) = (rxt(148)* y(2) +rxt(222)* y(55) +rxt(179)* y(84) +rxt(146)* y(86) & + +rxt(133)* y(97) + het_rates(17))* y(17) + prod(60) =rxt(132)*y(97)*y(12) +rxt(18)*y(15) +rxt(139)*y(87)*y(18) +rxt(20) & + *y(98) + loss(39) = ((rxt(238) +rxt(239))* y(86) + het_rates(16))* y(16) + prod(39) = (rxt(17) +rxt(18) +rxt(183)*y(84) +rxt(207)*y(85) +rxt(240)*y(8) + & + rxt(241)*y(86) +rxt(242)*y(2))*y(15) + (rxt(64) +rxt(250)*y(2) + & + rxt(251)*y(86))*y(57) +rxt(225)*y(84)*y(34) +rxt(288)*y(91)*y(56) + loss(51) = (rxt(156)* y(3) +rxt(157)* y(6) + (rxt(158) +rxt(159) +rxt(160)) & + * y(7) +rxt(155)* y(86) +rxt(289)* y(89) + rxt(69) + het_rates(5)) & + * y(5) + prod(51) = (rxt(154)*y(94) +rxt(293)*y(90))*y(2) + (.200_r8*rxt(296)*y(92) + & + 1.100_r8*rxt(298)*y(88))*y(93) +rxt(291)*y(90)*y(3) +rxt(6)*y(6) & + +rxt(285)*y(91) + loss(65) = (rxt(163)* y(1) +rxt(161)* y(2) +rxt(157)* y(5) +rxt(171)* y(8) & + +rxt(243)* y(13) +rxt(190)* y(23) +rxt(211)* y(30) +rxt(162)* y(87) & + +rxt(290)* y(89) + rxt(6) + rxt(7) + het_rates(6))* y(6) + prod(65) = (rxt(8) +.500_r8*rxt(248) +2.000_r8*rxt(159)*y(5) +rxt(164)*y(2) + & + rxt(258)*y(59))*y(7) + (rxt(153)*y(94) +rxt(156)*y(5))*y(3) & + +2.000_r8*rxt(109)*y(97)*y(4) +rxt(155)*y(86)*y(5) +rxt(13)*y(8) & + +rxt(10)*y(11) +rxt(295)*y(89) + loss(66) = (rxt(166)* y(1) + (rxt(164) +rxt(165))* y(2) + (rxt(158) + & + rxt(159) +rxt(160))* y(5) +rxt(167)* y(8) +rxt(191)* y(23) +rxt(212) & + * y(30) +rxt(258)* y(59) +rxt(169)* y(86) +rxt(175)* y(87) + rxt(8) & + + rxt(248) + het_rates(7))* y(7) + prod(66) = (rxt(161)*y(2) +rxt(162)*y(87) +rxt(163)*y(1) + & + 2.000_r8*rxt(171)*y(8) +rxt(190)*y(23) +rxt(211)*y(30) + & + rxt(243)*y(13))*y(6) + (rxt(12) +rxt(172)*y(2) +rxt(173)*y(86) + & + rxt(174)*y(87))*y(8) + (rxt(15) +rxt(177) +rxt(176)*y(86))*y(10) & + + (rxt(9) +rxt(168))*y(11) +rxt(11)*y(9) +rxt(30)*y(28) +rxt(36) & + *y(33) + loss(67) = (rxt(142)* y(1) +rxt(141)* y(2) +rxt(155)* y(5) +rxt(169)* y(7) & + +rxt(173)* y(8) +rxt(170)* y(9) +rxt(176)* y(10) +rxt(237)* y(12) & + +rxt(245)* y(14) +rxt(241)* y(15) + (rxt(238) +rxt(239))* y(16) & + +rxt(146)* y(17) +rxt(147)* y(19) + (rxt(186) +rxt(187))* y(23) & + +rxt(197)* y(26) +rxt(201)* y(27) +rxt(203)* y(28) +rxt(209)* y(30) & + +rxt(217)* y(31) +rxt(226)* y(34) +rxt(229)* y(35) +rxt(228)* y(39) & + +rxt(227)* y(41) +rxt(231)* y(44) +rxt(232)* y(45) +rxt(234)* y(50) & + +rxt(233)* y(51) +rxt(251)* y(57) +rxt(252)* y(58) +rxt(255)* y(59) & + +rxt(262)* y(60) + (rxt(264) +rxt(265))* y(63) + 2._r8*(rxt(144) + & + rxt(145))* y(86) +rxt(143)* y(87) + het_rates(86))* y(86) + prod(67) = (rxt(148)*y(17) +rxt(149)*y(87) +rxt(152)*y(19) +rxt(198)*y(26) + & + rxt(199)*y(27) +rxt(218)*y(31) +rxt(219)*y(32) +rxt(242)*y(15))*y(2) & + + (2.000_r8*rxt(138)*y(18) +rxt(150)*y(1) +rxt(162)*y(6) + & + rxt(174)*y(8) +rxt(182)*y(84))*y(87) + (rxt(130)*y(12) + & + 2.000_r8*rxt(108)*y(98) +rxt(133)*y(17) +rxt(134)*y(26) + & + rxt(135)*y(31))*y(97) + (rxt(19) +rxt(221)*y(55))*y(98) & + +rxt(137)*y(18)*y(1) +.500_r8*rxt(248)*y(7) +rxt(11)*y(9) +rxt(14) & + *y(10) +rxt(16)*y(14) +2.000_r8*rxt(22)*y(19) +rxt(27)*y(27) +rxt(33) & + *y(32) + loss(68) = (rxt(172)* y(2) +rxt(171)* y(6) +rxt(167)* y(7) +rxt(240)* y(15) & + +rxt(266)* y(63) +rxt(173)* y(86) +rxt(174)* y(87) + rxt(12) & + + rxt(13) + rxt(247) + het_rates(8))* y(8) + prod(68) = (rxt(29) +rxt(202)*y(2) +rxt(203)*y(86) +rxt(204)*y(84))*y(28) & + + (rxt(9) +rxt(10) +rxt(168))*y(11) + (rxt(165)*y(7) + & + rxt(220)*y(33))*y(2) + (rxt(170)*y(86) +rxt(224)*y(55))*y(9) & + +rxt(166)*y(7)*y(1) +rxt(14)*y(10) +rxt(35)*y(33) + loss(55) = (rxt(224)* y(55) +rxt(170)* y(86) + rxt(11) + het_rates(9))* y(9) + prod(55) = (rxt(268) +rxt(274) +rxt(279) +rxt(270)*y(26) +rxt(275)*y(26) + & + rxt(281)*y(26))*y(28) + (2.000_r8*rxt(246) +2.000_r8*rxt(267) + & + 2.000_r8*rxt(273) +2.000_r8*rxt(278))*y(11) + (rxt(247) + & + rxt(240)*y(15) +rxt(266)*y(63))*y(8) + (rxt(269) +rxt(277) +rxt(280)) & + *y(33) + (.500_r8*rxt(248) +rxt(169)*y(86))*y(7) + loss(37) = (rxt(176)* y(86) + rxt(14) + rxt(15) + rxt(177) + het_rates(10)) & + * y(10) + prod(37) =rxt(175)*y(87)*y(7) + loss(32) = ( + rxt(9) + rxt(10) + rxt(168) + rxt(246) + rxt(267) + rxt(273) & + + rxt(278) + het_rates(11))* y(11) + prod(32) =rxt(167)*y(8)*y(7) + loss(72) = (rxt(243)* y(6) +rxt(189)* y(23) +rxt(244)* y(87) + het_rates(13)) & + * y(13) + prod(72) = (rxt(130)*y(97) +rxt(184)*y(84) +rxt(223)*y(55) +rxt(237)*y(86)) & + *y(12) +rxt(245)*y(86)*y(14) + loss(35) = (rxt(245)* y(86) + rxt(16) + het_rates(14))* y(14) + prod(35) =rxt(244)*y(87)*y(13) + loss(58) = (rxt(242)* y(2) +rxt(240)* y(8) +rxt(183)* y(84) +rxt(207)* y(85) & + +rxt(241)* y(86) + rxt(17) + rxt(18) + het_rates(15))* y(15) + prod(58) = (rxt(131)*y(97) +rxt(132)*y(97))*y(12) + (rxt(189)*y(23) + & + rxt(243)*y(6))*y(13) +rxt(16)*y(14) + loss(57) = (rxt(137)* y(1) +rxt(136)* y(3) + (rxt(138) +rxt(139) +rxt(140)) & + * y(87) + het_rates(18))* y(18) + prod(57) = (rxt(141)*y(2) +rxt(146)*y(17) +rxt(155)*y(5) +rxt(238)*y(16) + & + rxt(241)*y(15) +rxt(251)*y(57) +rxt(252)*y(58) +rxt(255)*y(59))*y(86) & + + (rxt(133)*y(97) +rxt(148)*y(2) +rxt(179)*y(84) +rxt(222)*y(55)) & + *y(17) + (rxt(19) +2.000_r8*rxt(21))*y(98) +rxt(131)*y(97)*y(12) & + +rxt(16)*y(14) +2.000_r8*rxt(17)*y(15) +rxt(28)*y(26) +rxt(34)*y(31) & + +rxt(57)*y(54) + loss(71) = (rxt(150)* y(1) +rxt(149)* y(2) +rxt(162)* y(6) +rxt(175)* y(7) & + +rxt(174)* y(8) +rxt(244)* y(13) + (rxt(138) +rxt(139) +rxt(140)) & + * y(18) +rxt(188)* y(23) +rxt(210)* y(30) + (rxt(181) +rxt(182)) & + * y(84) +rxt(206)* y(85) +rxt(143)* y(86) + 2._r8*rxt(151)* y(87) & + + rxt(249) + het_rates(87))* y(87) + prod(71) = (rxt(226)*y(34) +rxt(229)*y(35) +rxt(142)*y(1) +rxt(147)*y(19) + & + rxt(173)*y(8) +rxt(186)*y(23) +rxt(209)*y(30) +rxt(239)*y(16) + & + rxt(262)*y(60) +.500_r8*rxt(264)*y(63))*y(86) + (rxt(183)*y(84) + & + rxt(207)*y(85) +rxt(240)*y(8) +rxt(242)*y(2))*y(15) & + + (rxt(225)*y(34) +rxt(230)*y(35) +rxt(180)*y(19))*y(84) & + + (rxt(15) +rxt(177))*y(10) + (rxt(189)*y(23) +rxt(243)*y(6))*y(13) & + +rxt(152)*y(19)*y(2) +rxt(136)*y(18)*y(3) +rxt(131)*y(97)*y(12) + loss(41) = (rxt(152)* y(2) +rxt(180)* y(84) +rxt(147)* y(86) + rxt(22) & + + het_rates(19))* y(19) + prod(41) = (.500_r8*rxt(249) +rxt(151)*y(87))*y(87) +rxt(145)*y(86)*y(86) + loss(69) = (rxt(221)* y(55) +rxt(263)* y(61) +rxt(108)* y(97) + rxt(19) & + + rxt(20) + rxt(21) + het_rates(98))* y(98) + prod(69) = (rxt(226)*y(34) +rxt(227)*y(41) +rxt(228)*y(39) +rxt(229)*y(35) + & + rxt(233)*y(51) +rxt(237)*y(12) +rxt(143)*y(87) +rxt(144)*y(86) + & + rxt(146)*y(17) +rxt(147)*y(19) +rxt(170)*y(9) +rxt(176)*y(10) + & + rxt(197)*y(26) +rxt(201)*y(27) +rxt(217)*y(31) +rxt(241)*y(15) + & + rxt(245)*y(14))*y(86) + (rxt(271)*y(27) +rxt(272)*y(32) + & + rxt(276)*y(27) +rxt(282)*y(27) +rxt(283)*y(32))*y(26) +rxt(140)*y(87) & + *y(18) +rxt(61)*y(62) + loss(61) = (rxt(178)* y(1) +rxt(184)* y(12) +rxt(183)* y(15) +rxt(179)* y(17) & + +rxt(180)* y(19) +rxt(200)* y(27) +rxt(204)* y(28) +rxt(225)* y(34) & + +rxt(230)* y(35) +rxt(236)* y(50) +rxt(235)* y(51) + (rxt(181) + & + rxt(182))* y(87) + het_rates(84))* y(84) + prod(61) = (2.000_r8*rxt(112)*y(36) +2.000_r8*rxt(113)*y(37) + & + 2.000_r8*rxt(114)*y(38) +2.000_r8*rxt(115)*y(46) +rxt(116)*y(47) + & + rxt(117)*y(39) +rxt(118)*y(44) +rxt(119)*y(45) + & + 4.000_r8*rxt(120)*y(40) +rxt(122)*y(43) +rxt(129)*y(53) + & + rxt(134)*y(26))*y(97) + (rxt(24) +rxt(185)*y(2) +rxt(186)*y(86) + & + rxt(189)*y(13) +rxt(190)*y(6) +2.000_r8*rxt(192)*y(23) + & + rxt(194)*y(23) +rxt(214)*y(30) +rxt(259)*y(59))*y(23) & + + (rxt(226)*y(34) +3.000_r8*rxt(227)*y(41) +rxt(228)*y(39) + & + rxt(231)*y(44) +rxt(232)*y(45) +rxt(197)*y(26))*y(86) + (rxt(28) + & + rxt(198)*y(2))*y(26) +2.000_r8*rxt(23)*y(22) +2.000_r8*rxt(26)*y(25) & + +rxt(27)*y(27) +rxt(29)*y(28) +rxt(31)*y(29) +rxt(56)*y(53) + loss(26) = ( + rxt(23) + het_rates(22))* y(22) + prod(26) = (rxt(270)*y(28) +rxt(271)*y(27) +rxt(275)*y(28) +rxt(276)*y(27) + & + rxt(281)*y(28) +rxt(282)*y(27))*y(26) +rxt(193)*y(23)*y(23) & + +rxt(204)*y(84)*y(28) + loss(62) = (rxt(185)* y(2) +rxt(190)* y(6) +rxt(191)* y(7) +rxt(189)* y(13) & + + 2._r8*(rxt(192) +rxt(193) +rxt(194) +rxt(195))* y(23) & + + (rxt(213) +rxt(214) +rxt(215))* y(30) +rxt(259)* y(59) & + + (rxt(186) +rxt(187))* y(86) +rxt(188)* y(87) + rxt(24) & + + het_rates(23))* y(23) + prod(62) = (rxt(199)*y(2) +rxt(200)*y(84) +rxt(201)*y(86))*y(27) + (rxt(25) + & + rxt(261)*y(59))*y(24) + (rxt(30) +rxt(202)*y(2))*y(28) & + + (rxt(178)*y(1) +rxt(182)*y(87))*y(84) +2.000_r8*rxt(196)*y(25) + loss(33) = (rxt(261)* y(59) + rxt(25) + het_rates(24))* y(24) + prod(33) = (rxt(194)*y(23) +rxt(213)*y(30))*y(23) + loss(21) = ( + rxt(26) + rxt(196) + het_rates(25))* y(25) + prod(21) =rxt(195)*y(23)*y(23) + loss(73) = (rxt(198)* y(2) + (rxt(271) +rxt(276) +rxt(282))* y(27) & + + (rxt(270) +rxt(275) +rxt(281))* y(28) + (rxt(272) +rxt(283)) & + * y(32) +rxt(197)* y(86) +rxt(134)* y(97) + rxt(28) + het_rates(26)) & + * y(26) + prod(73) = (rxt(184)*y(12) +2.000_r8*rxt(225)*y(34) +rxt(230)*y(35) + & + rxt(235)*y(51) +rxt(236)*y(50) +rxt(179)*y(17) +rxt(180)*y(19) + & + rxt(181)*y(87) +rxt(183)*y(15) +rxt(200)*y(27))*y(84) +rxt(187)*y(86) & + *y(23) + loss(52) = (rxt(199)* y(2) + (rxt(271) +rxt(276) +rxt(282))* y(26) +rxt(200) & + * y(84) +rxt(201)* y(86) + rxt(27) + het_rates(27))* y(27) + prod(52) = (rxt(268) +rxt(274) +rxt(279) +rxt(203)*y(86))*y(28) & + +rxt(188)*y(87)*y(23) + loss(54) = (rxt(202)* y(2) + (rxt(270) +rxt(275) +rxt(281))* y(26) +rxt(204) & + * y(84) +rxt(203)* y(86) + rxt(29) + rxt(30) + rxt(268) + rxt(274) & + + rxt(279) + het_rates(28))* y(28) + prod(54) =rxt(191)*y(23)*y(7) + loss(28) = ( + rxt(31) + het_rates(29))* y(29) + prod(28) = (rxt(272)*y(32) +rxt(283)*y(32))*y(26) +rxt(215)*y(30)*y(23) + loss(63) = (rxt(205)* y(1) +rxt(207)* y(15) +rxt(206)* y(87) + het_rates(85)) & + * y(85) + prod(63) = (rxt(32) +rxt(208)*y(2) +rxt(209)*y(86) +rxt(211)*y(6) + & + rxt(213)*y(23) +rxt(214)*y(23) +2.000_r8*rxt(216)*y(30) + & + rxt(260)*y(59))*y(30) + (rxt(121)*y(35) +rxt(122)*y(43) + & + rxt(123)*y(42) +2.000_r8*rxt(124)*y(48) +2.000_r8*rxt(125)*y(49) + & + 3.000_r8*rxt(126)*y(50) +2.000_r8*rxt(127)*y(51) +rxt(135)*y(31)) & + *y(97) + (rxt(229)*y(35) +2.000_r8*rxt(233)*y(51) + & + 3.000_r8*rxt(234)*y(50) +rxt(217)*y(31))*y(86) + (rxt(230)*y(35) + & + 2.000_r8*rxt(235)*y(51) +3.000_r8*rxt(236)*y(50))*y(84) + (rxt(34) + & + rxt(218)*y(2))*y(31) +rxt(31)*y(29) +rxt(33)*y(32) +rxt(35)*y(33) + loss(59) = (rxt(208)* y(2) +rxt(211)* y(6) +rxt(212)* y(7) + (rxt(213) + & + rxt(214) +rxt(215))* y(23) + 2._r8*rxt(216)* y(30) +rxt(260)* y(59) & + +rxt(209)* y(86) +rxt(210)* y(87) + rxt(32) + het_rates(30))* y(30) + prod(59) = (rxt(219)*y(32) +rxt(220)*y(33))*y(2) +rxt(205)*y(85)*y(1) & + +rxt(36)*y(33) + loss(50) = (rxt(218)* y(2) +rxt(217)* y(86) +rxt(135)* y(97) + rxt(34) & + + het_rates(31))* y(31) + prod(50) = (rxt(206)*y(87) +rxt(207)*y(15))*y(85) + loss(49) = (rxt(219)* y(2) + (rxt(272) +rxt(283))* y(26) + rxt(33) & + + het_rates(32))* y(32) + prod(49) = (rxt(269) +rxt(277) +rxt(280))*y(33) +rxt(210)*y(87)*y(30) + loss(40) = (rxt(220)* y(2) + rxt(35) + rxt(36) + rxt(269) + rxt(277) & + + rxt(280) + het_rates(33))* y(33) + prod(40) =rxt(212)*y(30)*y(7) + loss(42) = ((rxt(286) +rxt(287))* y(2) +rxt(294)* y(3) +rxt(298)* y(93) & + + het_rates(88))* y(88) + prod(42) = 0._r8 + loss(46) = (rxt(289)* y(5) +rxt(290)* y(6) +rxt(297)* y(93) + rxt(295) & + + het_rates(89))* y(89) + prod(46) = (rxt(70) +rxt(82) +rxt(284)*y(91) +rxt(291)*y(90) +rxt(294)*y(88)) & + *y(3) +rxt(288)*y(91)*y(56) + loss(36) = (rxt(293)* y(2) + (rxt(291) +rxt(292))* y(3) + het_rates(90)) & + * y(90) + prod(36) =rxt(69)*y(5) + loss(44) = (rxt(284)* y(3) +rxt(288)* y(56) + rxt(285) + het_rates(91)) & + * y(91) + prod(44) = (rxt(66) +rxt(67) +rxt(68) +rxt(79) +rxt(80) +rxt(81) + & + rxt(287)*y(88) +rxt(293)*y(90))*y(2) + (rxt(72) +rxt(73) +rxt(74) + & + rxt(84) +rxt(85) +rxt(86))*y(3) + loss(47) = (rxt(296)* y(93) + het_rates(92))* y(92) + prod(47) = (rxt(295) +rxt(289)*y(5) +rxt(290)*y(6))*y(89) +rxt(286)*y(88) & + *y(2) +rxt(292)*y(90)*y(3) +rxt(7)*y(6) +rxt(285)*y(91) + loss(38) = (rxt(154)* y(2) +rxt(153)* y(3) + het_rates(94))* y(94) + prod(38) = (rxt(286)*y(2) +.900_r8*rxt(298)*y(93))*y(88) & + +.800_r8*rxt(296)*y(93)*y(92) + loss(48) = (rxt(298)* y(88) +rxt(297)* y(89) +rxt(296)* y(92) & + + het_rates(93))* y(93) + prod(48) = (rxt(70) +rxt(72) +rxt(73) +rxt(74) +rxt(82) +rxt(84) +rxt(85) + & + rxt(86))*y(3) + (rxt(66) +rxt(67) +rxt(68) +rxt(79) +rxt(80) + & + rxt(81))*y(2) +rxt(69)*y(5) +rxt(7)*y(6) + loss(22) = (rxt(128)* y(97) + rxt(55) + het_rates(52))* y(52) + prod(22) = (rxt(113)*y(37) +rxt(114)*y(38) +2.000_r8*rxt(115)*y(46) + & + 2.000_r8*rxt(116)*y(47) +rxt(117)*y(39) +rxt(119)*y(45) + & + rxt(122)*y(43) +rxt(123)*y(42) +rxt(124)*y(48) + & + 2.000_r8*rxt(125)*y(49))*y(97) + (rxt(228)*y(39) +rxt(232)*y(45)) & + *y(86) + loss(27) = (rxt(129)* y(97) + rxt(56) + het_rates(53))* y(53) + prod(27) = (rxt(112)*y(36) +rxt(114)*y(38) +rxt(118)*y(44))*y(97) & + +rxt(231)*y(86)*y(44) + loss(29) = ( + rxt(57) + het_rates(54))* y(54) + prod(29) = (rxt(223)*y(12) +rxt(221)*y(98) +rxt(222)*y(17) +rxt(224)*y(9)) & + *y(55) + loss(45) = (rxt(224)* y(9) +rxt(223)* y(12) +rxt(222)* y(17) +rxt(221)* y(98) & + + het_rates(55))* y(55) + prod(45) = (rxt(116)*y(47) +rxt(123)*y(42) +2.000_r8*rxt(128)*y(52) + & + rxt(129)*y(53))*y(97) +2.000_r8*rxt(55)*y(52) +rxt(56)*y(53) +rxt(57) & + *y(54) + loss(34) = (rxt(250)* y(2) +rxt(251)* y(86) + rxt(64) + het_rates(57))* y(57) + prod(34) = 0._r8 + loss(43) = (rxt(254)* y(1) +rxt(253)* y(3) +rxt(252)* y(86) + het_rates(58)) & + * y(58) + prod(43) =rxt(64)*y(57) +rxt(65)*y(59) + loss(56) = (rxt(257)* y(1) +rxt(256)* y(3) +rxt(258)* y(7) +rxt(259)* y(23) & + +rxt(261)* y(24) +rxt(260)* y(30) +rxt(255)* y(86) + rxt(65) & + + het_rates(59))* y(59) + prod(56) = (rxt(252)*y(86) +rxt(253)*y(3) +rxt(254)*y(1))*y(58) & + +rxt(250)*y(57)*y(2) +rxt(62)*y(60) + loss(53) = (rxt(262)* y(86) + rxt(62) + het_rates(60))* y(60) + prod(53) = (rxt(255)*y(86) +rxt(256)*y(3) +rxt(257)*y(1) +rxt(258)*y(7) + & + rxt(259)*y(23) +rxt(260)*y(30) +rxt(261)*y(24))*y(59) & + + (.500_r8*rxt(264)*y(86) +rxt(265)*y(86) +rxt(266)*y(8))*y(63) & + +rxt(251)*y(86)*y(57) +rxt(63)*y(61) + loss(30) = (rxt(263)* y(98) + rxt(63) + het_rates(61))* y(61) + prod(30) =rxt(262)*y(86)*y(60) +rxt(61)*y(62) + loss(23) = ( + rxt(61) + het_rates(62))* y(62) + prod(23) =rxt(263)*y(98)*y(61) + loss(31) = (rxt(266)* y(8) + (rxt(264) +rxt(265))* y(86) + het_rates(63)) & + * y(63) + prod(31) = 0._r8 + loss(1) = ( + het_rates(64))* y(64) + prod(1) = 0._r8 + loss(2) = ( + het_rates(65))* y(65) + prod(2) = 0._r8 + loss(3) = ( + het_rates(66))* y(66) + prod(3) = 0._r8 + loss(4) = ( + het_rates(67))* y(67) + prod(4) = 0._r8 + loss(5) = ( + het_rates(68))* y(68) + prod(5) = 0._r8 + loss(6) = ( + het_rates(69))* y(69) + prod(6) = 0._r8 + loss(7) = ( + het_rates(70))* y(70) + prod(7) = 0._r8 + loss(8) = ( + het_rates(71))* y(71) + prod(8) = 0._r8 + loss(9) = ( + het_rates(72))* y(72) + prod(9) = 0._r8 + loss(10) = ( + het_rates(73))* y(73) + prod(10) = 0._r8 + loss(11) = ( + het_rates(74))* y(74) + prod(11) = 0._r8 + loss(12) = ( + het_rates(75))* y(75) + prod(12) = 0._r8 + loss(13) = ( + het_rates(76))* y(76) + prod(13) = 0._r8 + loss(14) = ( + het_rates(77))* y(77) + prod(14) = 0._r8 + loss(15) = ( + het_rates(78))* y(78) + prod(15) = 0._r8 + loss(16) = ( + het_rates(79))* y(79) + prod(16) = 0._r8 + loss(17) = ( + het_rates(80))* y(80) + prod(17) = 0._r8 + loss(18) = ( + het_rates(81))* y(81) + prod(18) = 0._r8 + loss(19) = ( + het_rates(82))* y(82) + prod(19) = 0._r8 + loss(20) = ( + het_rates(83))* y(83) + prod(20) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..bd554bd2ce --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,310 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 6) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 6) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 7) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 10) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 10) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 14) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 98) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 98) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 98) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 19) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 22) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 23) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 24) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 25) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 27) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 26) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 28) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 28) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 29) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 30) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 32) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 31) ! rate_const*HBR + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 33) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 34) ! rate_const*CH3CL + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 40) ! rate_const*CCL4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 41) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 36) ! rate_const*CFC11 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 37) ! rate_const*CFC12 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 38) ! rate_const*CFC113 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 46) ! rate_const*CFC114 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 47) ! rate_const*CFC115 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 39) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 44) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 45) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 35) ! rate_const*CH3BR + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 42) ! rate_const*CF3BR + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 43) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 50) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 51) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 48) ! rate_const*H1202 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*H2402 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 52) ! rate_const*COF2 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 53) ! rate_const*COFCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 54) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 56) ! rate_const*CO2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 12) ! rate_const*CH4 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 12) ! rate_const*CH4 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 62) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 60) ! rate_const*SO2 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 61) ! rate_const*SO3 + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 57) ! rate_const*OCS + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 59) ! rate_const*SO + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 5) ! rate_const*N + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 56) ! rate_const*CO2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 2)*sol(:ncol,:, 3) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 95)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 95)*sol(:ncol,:, 3) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 95) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 95)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 95) ! rate_const*O2_1S + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 96)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 96)*sol(:ncol,:, 3) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 96) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 96) ! rate_const*O2_1D + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 97) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 97)*sol(:ncol,:, 3) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 97)*sol(:ncol,:, 3) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 97)*sol(:ncol,:, 98) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 97)*sol(:ncol,:, 4) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 97)*sol(:ncol,:, 4) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 97)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 97)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 97)*sol(:ncol,:, 37) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 97)*sol(:ncol,:, 38) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 97)*sol(:ncol,:, 46) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 97)*sol(:ncol,:, 47) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 97)*sol(:ncol,:, 39) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 97)*sol(:ncol,:, 44) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 97)*sol(:ncol,:, 45) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 97)*sol(:ncol,:, 40) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 97)*sol(:ncol,:, 35) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 97)*sol(:ncol,:, 43) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 97)*sol(:ncol,:, 42) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 97)*sol(:ncol,:, 48) ! rate_const*O1D*H1202 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 97)*sol(:ncol,:, 49) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 97)*sol(:ncol,:, 50) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 97)*sol(:ncol,:, 51) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 97)*sol(:ncol,:, 52) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 97)*sol(:ncol,:, 53) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 97)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 97)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 97)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 97)*sol(:ncol,:, 17) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 97)*sol(:ncol,:, 26) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 97)*sol(:ncol,:, 31) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 18)*sol(:ncol,:, 3) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 18)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 18)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 18)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 18)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 86)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 86)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 86)*sol(:ncol,:, 87) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 86)*sol(:ncol,:, 86) ! rate_const*OH*OH + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 86)*sol(:ncol,:, 86) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 86)*sol(:ncol,:, 17) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 86)*sol(:ncol,:, 19) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 17)*sol(:ncol,:, 2) ! rate_const*H2*O + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 87)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 87)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 87)*sol(:ncol,:, 87) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 19)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 94)*sol(:ncol,:, 3) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 94)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 5)*sol(:ncol,:, 86) ! rate_const*N*OH + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 5)*sol(:ncol,:, 3) ! rate_const*N*O2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 5)*sol(:ncol,:, 6) ! rate_const*N*NO + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 6)*sol(:ncol,:, 87) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 6)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 7)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 7)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 7)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 7)*sol(:ncol,:, 8) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 11) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 7)*sol(:ncol,:, 86) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 9)*sol(:ncol,:, 86) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 8)*sol(:ncol,:, 6) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 8)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 8)*sol(:ncol,:, 86) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 8)*sol(:ncol,:, 87) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 7)*sol(:ncol,:, 87) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 10)*sol(:ncol,:, 86) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 10) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 84)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 84)*sol(:ncol,:, 17) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 84)*sol(:ncol,:, 19) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 84)*sol(:ncol,:, 87) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 84)*sol(:ncol,:, 87) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 84)*sol(:ncol,:, 15) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 84)*sol(:ncol,:, 12) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 23)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 23)*sol(:ncol,:, 86) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 23)*sol(:ncol,:, 86) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 23)*sol(:ncol,:, 87) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 23)*sol(:ncol,:, 13) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 23)*sol(:ncol,:, 6) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 23)*sol(:ncol,:, 7) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 26)*sol(:ncol,:, 86) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 26)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 27)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 27)*sol(:ncol,:, 84) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 27)*sol(:ncol,:, 86) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 28)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 28)*sol(:ncol,:, 86) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 28)*sol(:ncol,:, 84) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 85)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 85)*sol(:ncol,:, 87) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 85)*sol(:ncol,:, 15) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 30)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 30)*sol(:ncol,:, 86) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 30)*sol(:ncol,:, 87) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 30)*sol(:ncol,:, 6) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 30)*sol(:ncol,:, 7) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 31)*sol(:ncol,:, 86) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 31)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 32)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 55)*sol(:ncol,:, 98) ! rate_const*F*H2O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 55)*sol(:ncol,:, 17) ! rate_const*F*H2 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 55)*sol(:ncol,:, 12) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 55)*sol(:ncol,:, 9) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 34)*sol(:ncol,:, 84) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 34)*sol(:ncol,:, 86) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 41)*sol(:ncol,:, 86) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 39)*sol(:ncol,:, 86) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 35)*sol(:ncol,:, 86) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 35)*sol(:ncol,:, 84) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 44)*sol(:ncol,:, 86) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 45)*sol(:ncol,:, 86) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 51)*sol(:ncol,:, 86) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 50)*sol(:ncol,:, 86) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 51)*sol(:ncol,:, 84) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 50)*sol(:ncol,:, 84) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 12)*sol(:ncol,:, 86) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 16)*sol(:ncol,:, 86) ! rate_const*CO*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 16)*sol(:ncol,:, 86) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 15)*sol(:ncol,:, 8) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 15)*sol(:ncol,:, 86) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 15)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 13)*sol(:ncol,:, 6) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 13)*sol(:ncol,:, 87) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 14)*sol(:ncol,:, 86) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 7) ! rate_const*NO2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 87) ! rate_const*HO2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 57)*sol(:ncol,:, 2) ! rate_const*OCS*O + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 57)*sol(:ncol,:, 86) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 58)*sol(:ncol,:, 86) ! rate_const*S*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 58)*sol(:ncol,:, 3) ! rate_const*S*O2 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 58)*sol(:ncol,:, 1) ! rate_const*S*O3 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 59)*sol(:ncol,:, 86) ! rate_const*SO*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 59)*sol(:ncol,:, 3) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 59)*sol(:ncol,:, 1) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 59)*sol(:ncol,:, 7) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 59)*sol(:ncol,:, 23) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 59)*sol(:ncol,:, 30) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 59)*sol(:ncol,:, 24) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 60)*sol(:ncol,:, 86) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 61)*sol(:ncol,:, 98) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 63)*sol(:ncol,:, 86) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 63)*sol(:ncol,:, 86) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 63)*sol(:ncol,:, 8) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 28) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 33) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 28)*sol(:ncol,:, 26) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 27)*sol(:ncol,:, 26) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 32)*sol(:ncol,:, 26) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 28) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 28)*sol(:ncol,:, 26) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 27)*sol(:ncol,:, 26) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 33) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 28) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 33) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 28)*sol(:ncol,:, 26) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 27)*sol(:ncol,:, 26) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 32)*sol(:ncol,:, 26) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 91)*sol(:ncol,:, 3) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 91) ! rate_const*N2*Op + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 88)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 88)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 91)*sol(:ncol,:, 56) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 89)*sol(:ncol,:, 5) ! rate_const*O2p*N + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 89)*sol(:ncol,:, 6) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 90)*sol(:ncol,:, 3) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 90)*sol(:ncol,:, 3) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 90)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 88)*sol(:ncol,:, 3) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 89) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 92)*sol(:ncol,:, 93) ! rate_const*NOp*e + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 89)*sol(:ncol,:, 93) ! rate_const*O2p*e + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 88)*sol(:ncol,:, 93) ! rate_const*N2p*e + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..9b697f9a0f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 @@ -0,0 +1,360 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,95) = 8.00e-14_r8 + rate(:,:,96) = 3.90e-17_r8 + rate(:,:,99) = 4.20e-13_r8 + rate(:,:,100) = 8.50e-2_r8 + rate(:,:,101) = 1.30e-16_r8 + rate(:,:,103) = 1.00e-20_r8 + rate(:,:,104) = 2.58e-04_r8 + rate(:,:,111) = 1.20e-10_r8 + rate(:,:,112) = 2.02e-10_r8 + rate(:,:,113) = 1.204e-10_r8 + rate(:,:,114) = 1.50e-10_r8 + rate(:,:,115) = 9.75e-11_r8 + rate(:,:,116) = 1.50e-11_r8 + rate(:,:,117) = 7.20e-11_r8 + rate(:,:,118) = 1.794e-10_r8 + rate(:,:,119) = 1.628e-10_r8 + rate(:,:,120) = 2.84e-10_r8 + rate(:,:,121) = 1.674e-10_r8 + rate(:,:,122) = 9.60e-11_r8 + rate(:,:,123) = 4.10e-11_r8 + rate(:,:,124) = 1.012e-10_r8 + rate(:,:,125) = 1.20e-10_r8 + rate(:,:,126) = 4.49e-10_r8 + rate(:,:,127) = 2.57e-10_r8 + rate(:,:,128) = 2.14e-11_r8 + rate(:,:,129) = 1.90e-10_r8 + rate(:,:,130) = 1.31e-10_r8 + rate(:,:,131) = 3.50e-11_r8 + rate(:,:,132) = 9.00e-12_r8 + rate(:,:,133) = 1.20e-10_r8 + rate(:,:,134) = 1.50e-10_r8 + rate(:,:,135) = 1.20e-10_r8 + rate(:,:,138) = 7.20e-11_r8 + rate(:,:,139) = 6.90e-12_r8 + rate(:,:,140) = 1.60e-12_r8 + rate(:,:,144) = 1.80e-12_r8 + rate(:,:,147) = 1.80e-12_r8 + rate(:,:,153) = 5.00e-12_r8 + rate(:,:,154) = 7.00e-13_r8 + rate(:,:,155) = 5.00e-11_r8 + rate(:,:,172) = 1.00e-11_r8 + rate(:,:,173) = 2.20e-11_r8 + rate(:,:,174) = 3.50e-12_r8 + rate(:,:,199) = 1.70e-13_r8 + rate(:,:,252) = 6.60E-11_r8 + rate(:,:,253) = 2.30E-12_r8 + rate(:,:,254) = 1.20E-11_r8 + rate(:,:,258) = 1.40E-11_r8 + rate(:,:,259) = 2.80E-11_r8 + rate(:,:,260) = 5.70E-11_r8 + rate(:,:,261) = 1.90E-12_r8 + rate(:,:,288) = 9.0e-10_r8 + rate(:,:,289) = 1.0e-10_r8 + rate(:,:,290) = 4.4e-10_r8 + rate(:,:,291) = 4.0e-10_r8 + rate(:,:,292) = 2.0e-10_r8 + rate(:,:,293) = 1.0e-12_r8 + rate(:,:,294) = 6.0e-11_r8 + rate(:,:,295) = 5.0e-16_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,93) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,97) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,98) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,102) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,105) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,106) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,107) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,108) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,109) = 7.25e-11_r8 * exp_fac(:,:) + rate(:,:,110) = 4.63e-11_r8 * exp_fac(:,:) + rate(:,:,137) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:,141) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:,142) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,143) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,209) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,146) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,148) = 1.60e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,149) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,217) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,245) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,150) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,152) = 1.40e-12_r8 * exp( -2000._r8 * itemp(:,:) ) + rate(:,:,156) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:,157) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,158) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,159) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,160) = 1.45e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,162) = 3.30e-12_r8 * exp_fac(:,:) + rate(:,:,181) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,186) = 7.40e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,163) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,218) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,164) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,166) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,192) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,171) = 1.50e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,176) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,178) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,179) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,180) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,182) = 3.60e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,183) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,184) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,185) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,187) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,208) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,216) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,188) = 2.60e-12_r8 * exp_fac(:,:) + rate(:,:,190) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,215) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,189) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,193) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,194) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,197) = 1.80e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,198) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,200) = 3.40e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,201) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,222) = 1.40e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,202) = 3.60e-12_r8 * exp_fac(:,:) + rate(:,:,233) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,203) = 1.20e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,204) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,205) = 1.60e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,206) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,207) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,235) = 6.30e-12_r8 * exp_fac(:,:) + rate(:,:,210) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,211) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,214) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,213) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,219) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,220) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,221) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,252) = 6.60E-11_r8 * exp_fac(:,:) + rate(:,:,253) = 2.30E-12_r8 * exp_fac(:,:) + rate(:,:,254) = 1.20E-11_r8 * exp_fac(:,:) + rate(:,:,258) = 1.40E-11_r8 * exp_fac(:,:) + rate(:,:,259) = 2.80E-11_r8 * exp_fac(:,:) + rate(:,:,260) = 5.70E-11_r8 * exp_fac(:,:) + rate(:,:,261) = 1.90E-12_r8 * exp_fac(:,:) + rate(:,:,288) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,289) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,290) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,291) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,292) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,293) = 1.0e-12_r8 * exp_fac(:,:) + rate(:,:,294) = 6.0e-11_r8 * exp_fac(:,:) + rate(:,:,295) = 5.0e-16_r8 * exp_fac(:,:) + rate(:,:,223) = 1.60e-10_r8 * exp( -260._r8 * itemp(:,:) ) + rate(:,:,224) = 6.00e-12_r8 * exp( 400._r8 * itemp(:,:) ) + rate(:,:,225) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,226) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,227) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,228) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,231) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,242) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,229) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,230) = 1.40e-11_r8 * exp( -1030._r8 * itemp(:,:) ) + rate(:,:,232) = 1.30e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,234) = 1.35e-12_r8 * exp( -600._r8 * itemp(:,:) ) + rate(:,:,236) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,237) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,240) = 6.00e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,241) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,243) = 2.80e-12_r8 * exp( 300._r8 * itemp(:,:) ) + rate(:,:,244) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,250) = 2.10E-11_r8 * exp( -2200.0_r8 * itemp(:,:) ) + rate(:,:,251) = 1.10E-13_r8 * exp( -1200.0_r8 * itemp(:,:) ) + rate(:,:,255) = 2.70E-11_r8 * exp( 335._r8 * itemp(:,:) ) + rate(:,:,256) = 1.25E-13_r8 * exp( -2190.0_r8 * itemp(:,:) ) + rate(:,:,257) = 3.40E-12_r8 * exp( -1100.0_r8 * itemp(:,:) ) + rate(:,:,265) = 9.60e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,266) = 1.90e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,136), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.60e-11_r8 + call jpl( rate(1,1,145), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,161), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,165), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,167), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,169), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,175), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,191), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 3.0e-12_r8 * itemp(:,:)**2.0_r8 + call jpl( rate(1,1,195), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,212), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,239), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,95) = 8.00e-14_r8 + rate(:,:kbot,96) = 3.90e-17_r8 + rate(:,:kbot,101) = 1.30e-16_r8 + rate(:,:kbot,103) = 1.00e-20_r8 + rate(:,:kbot,139) = 6.90e-12_r8 + rate(:,:kbot,153) = 5.00e-12_r8 + rate(:,:kbot,154) = 7.00e-13_r8 + rate(:,:kbot,289) = 1.0e-10_r8 + rate(:,:kbot,290) = 4.4e-10_r8 + rate(:,:kbot,291) = 4.0e-10_r8 + rate(:,:kbot,292) = 2.0e-10_r8 + rate(:,:kbot,293) = 1.0e-12_r8 + rate(:,:kbot,294) = 6.0e-11_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,93) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,97) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,98) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,102) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,105) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,106) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,107) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,137) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,141) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,142) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,143) = 4.80e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,149) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,150) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,156) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,157) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,162) = 3.30e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,163) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,164) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,136) = wrk(:,:) + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..3a32ef57ac --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 @@ -0,0 +1,504 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 23, 0, 0, 75, 0 /) + + cls_rxt_cnt(:,1) = (/ 3, 60, 0, 23 /) + cls_rxt_cnt(:,4) = (/ 31, 121, 146, 75 /) + + solsym(: 98) = (/ 'O3 ','O ','O2 ','N2O ','N ', & + 'NO ','NO2 ','NO3 ','HNO3 ','HO2NO2 ', & + 'N2O5 ','CH4 ','CH3O2 ','CH3OOH ','CH2O ', & + 'CO ','H2 ','H ','H2O2 ','CLY ', & + 'BRY ','CL2 ','CLO ','OCLO ','CL2O2 ', & + 'HCL ','HOCL ','CLONO2 ','BRCL ','BRO ', & + 'HBR ','HOBR ','BRONO2 ','CH3CL ','CH3BR ', & + 'CFC11 ','CFC12 ','CFC113 ','HCFC22 ','CCL4 ', & + 'CH3CCL3 ','CF3BR ','CF2CLBR ','HCFC141B ','HCFC142B ', & + 'CFC114 ','CFC115 ','H1202 ','H2402 ','CHBR3 ', & + 'CH2BR2 ','COF2 ','COFCL ','HF ','F ', & + 'CO2 ','OCS ','S ','SO ','SO2 ', & + 'SO3 ','H2SO4 ','DMS ','SOAG ','so4_a1 ', & + 'pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ','ncl_a1 ', & + 'num_a1 ','so4_a2 ','soa_a2 ','ncl_a2 ','num_a2 ', & + 'dst_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ','num_a3 ', & + 'pom_a4 ','bc_a4 ','num_a4 ','CL ','BR ', & + 'OH ','HO2 ','N2p ','O2p ','Np ', & + 'Op ','NOp ','e ','N2D ','O2_1S ', & + 'O2_1D ','O1D ','H2O ' /) + + adv_mass(: 98) = (/ 47.998200_r8, 15.999400_r8, 31.998800_r8, 44.012880_r8, 14.006740_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 63.012340_r8, 79.011740_r8, & + 108.010480_r8, 16.040600_r8, 47.032000_r8, 48.039400_r8, 30.025200_r8, & + 28.010400_r8, 2.014800_r8, 1.007400_r8, 34.013600_r8, 100.916850_r8, & + 99.716850_r8, 70.905400_r8, 51.452100_r8, 67.451500_r8, 102.904200_r8, & + 36.460100_r8, 52.459500_r8, 97.457640_r8, 115.356700_r8, 95.903400_r8, & + 80.911400_r8, 96.910800_r8, 141.908940_r8, 50.485900_r8, 94.937200_r8, & + 137.367503_r8, 120.913206_r8, 187.375310_r8, 86.467906_r8, 153.821800_r8, & + 133.402300_r8, 148.910210_r8, 165.364506_r8, 116.948003_r8, 100.493706_r8, & + 170.921013_r8, 154.466716_r8, 209.815806_r8, 259.823613_r8, 252.730400_r8, & + 173.833800_r8, 66.007206_r8, 82.461503_r8, 20.005803_r8, 18.998403_r8, & + 44.009800_r8, 60.076400_r8, 32.066000_r8, 48.065400_r8, 64.064800_r8, & + 80.064200_r8, 98.078400_r8, 62.132400_r8, 12.011000_r8, 115.107340_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, 58.442468_r8, & + 1.007400_r8, 115.107340_r8, 12.011000_r8, 58.442468_r8, 1.007400_r8, & + 135.064039_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 1.007400_r8, 35.452700_r8, 79.904000_r8, & + 17.006800_r8, 33.006200_r8, 28.013480_r8, 31.998800_r8, 14.006740_r8, & + 15.999400_r8, 30.006140_r8, 0.548567E-03_r8, 14.006740_r8, 31.998800_r8, & + 31.998800_r8, 15.999400_r8, 18.014200_r8 /) + + crb_mass(: 98) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 23,1) = (/ 12, 4, 34, 35, 36, 37, 38, 46, 47, 39, & + 44, 45, 40, 41, 42, 43, 48, 49, 50, 51, & + 56, 20, 21 /) + clsmap(: 75,4) = (/ 1, 2, 97, 3, 95, 96, 17, 16, 5, 6, & + 7, 86, 8, 9, 10, 11, 13, 14, 15, 18, & + 87, 19, 98, 84, 22, 23, 24, 25, 26, 27, & + 28, 29, 85, 30, 31, 32, 33, 88, 89, 90, & + 91, 92, 94, 93, 52, 53, 54, 55, 57, 58, & + 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, & + 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, & + 79, 80, 81, 82, 83 /) + + permute(: 75,4) = (/ 64, 75, 74, 70, 25, 24, 60, 39, 51, 65, & + 66, 67, 68, 55, 37, 32, 72, 35, 58, 57, & + 71, 41, 69, 61, 26, 62, 33, 21, 73, 52, & + 54, 28, 63, 59, 50, 49, 40, 42, 46, 36, & + 44, 47, 38, 48, 22, 27, 29, 45, 34, 43, & + 56, 53, 30, 23, 31, 1, 2, 3, 4, 5, & + 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, & + 16, 17, 18, 19, 20 /) + + diag_map(: 75) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 24, 27, 30, 33, 35, 37, 41, 44, 48, & + 52, 58, 64, 69, 77, 83, 90, 97, 102, 106, & + 114, 122, 132, 140, 150, 158, 167, 179, 189, 197, & + 209, 219, 227, 235, 247, 258, 272, 284, 307, 327, & + 349, 377, 399, 423, 447, 475, 513, 539, 565, 597, & + 623, 643, 668, 693, 735 /) + + extfrc_lst(: 22) = (/ 'NO ','NO2 ','CO ','SO2 ','DMS ', & + 'so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ','bc_a1 ', & + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','Op ', & + 'O2p ','Np ','N2p ','N2D ','N ', & + 'e ','OH ' /) + + frc_from_dataset(: 22) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 14) = (/ 'CL ', 'BR ', 'OH ', 'HO2 ', 'Op ', & + 'O2p ', 'NOp ', 'Np ', 'N2p ', 'e ', & + 'O2_1S ', 'O2_1D ', 'N2D ', 'O1D ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jhbr ', & + 'jbrono2_a ', 'jbrono2_b ', & + 'jch3cl ', 'jccl4 ', & + 'jch3ccl3 ', 'jcfcl3 ', & + 'jcf2cl2 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jhcfc22 ', 'jhcfc141b ', & + 'jhcfc142b ', 'jch3br ', & + 'jcf3br ', 'jcf2clbr ', & + 'jchbr3 ', 'jch2br2 ', & + 'jh1202 ', 'jh2402 ', & + 'jcof2 ', 'jcofcl ', & + 'jhf ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jh2so4 ', 'jso2 ', & + 'jso3 ', 'jocs ', & + 'jso ', 'jeuv_1 ', & + 'jeuv_2 ', 'jeuv_3 ', & + 'jeuv_4 ', 'jeuv_5 ', & + 'jeuv_6 ', 'jeuv_7 ', & + 'jeuv_8 ', 'jeuv_9 ', & + 'jeuv_10 ', 'jeuv_11 ', & + 'jeuv_12 ', 'jeuv_13 ', & + 'jeuv_14 ', 'jeuv_15 ', & + 'jeuv_16 ', 'jeuv_17 ', & + 'jeuv_18 ', 'jeuv_19 ', & + 'jeuv_20 ', 'jeuv_21 ', & + 'jeuv_22 ', 'jeuv_23 ', & + 'jeuv_24 ', 'jeuv_25 ', & + 'jeuv_26 ', 'usr_O_O2 ', & + 'O_O3 ', 'usr_O_O ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_N2 ', 'O2_1S_O3 ', & + 'O2_1S_CO2 ', 'ag2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1D_N2 ', 'ag1 ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_H2O ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'O1D_O3 ', 'O1D_CFC11 ', & + 'O1D_CFC12 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_HCFC22 ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_CCL4 ', & + 'O1D_CH3BR ', 'O1D_CF2CLBR ', & + 'O1D_CF3BR ', 'O1D_H1202 ', & + 'O1D_H2402 ', 'O1D_CHBR3 ', & + 'O1D_CH2BR2 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_H2 ', 'O1D_HCL ', & + 'O1D_HBR ', 'H_O2 ', & + 'H_O3 ', 'H_HO2a ', & + 'H_HO2 ', 'H_HO2b ', & + 'OH_O ', 'OH_O3 ', & + 'OH_HO2 ', 'OH_OH ', & + 'OH_OH_M ', 'OH_H2 ', & + 'OH_H2O2 ', 'H2_O ', & + 'HO2_O ', 'HO2_O3 ', & + 'usr_HO2_HO2 ', 'H2O2_O ', & + 'N2D_O2 ', 'N2D_O ', & + 'N_OH ', 'N_O2 ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'NO_O ', 'NO_HO2 ', & + 'NO_O3 ', 'NO2_O ', & + 'NO2_O_M ', 'NO2_O3 ', & + 'tag_NO2_NO3 ', 'usr_N2O5_M ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'NO3_NO ', 'NO3_O ', & + 'NO3_OH ', 'NO3_HO2 ', & + 'tag_NO2_HO2 ', 'HO2NO2_OH ', & + 'usr_HO2NO2_M ', 'CL_O3 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'CLO_HO2 ', & + 'CLO_CH3O2 ', 'CLO_NO ', & + 'CLO_NO2_M ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'HCL_OH ', 'HCL_O ', & + 'HOCL_O ', 'HOCL_CL ' /) + rxt_tag_lst( 201: 298) = (/ 'HOCL_OH ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLONO2_CL ', & + 'BR_O3 ', 'BR_HO2 ', & + 'BR_CH2O ', 'BRO_O ', & + 'BRO_OH ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_BRO ', & + 'HBR_OH ', 'HBR_O ', & + 'HOBR_O ', 'BRONO2_O ', & + 'F_H2O ', 'F_H2 ', & + 'F_CH4 ', 'F_HNO3 ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CH3CCL3_OH ', 'HCFC22_OH ', & + 'CH3BR_OH ', 'CH3BR_CL ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'CH2BR2_OH ', 'CHBR3_OH ', & + 'CH2BR2_CL ', 'CHBR3_CL ', & + 'CH4_OH ', 'usr_CO_OH_b ', & + 'CO_OH_M ', 'CH2O_NO3 ', & + 'CH2O_OH ', 'CH2O_O ', & + 'CH3O2_NO ', 'CH3O2_HO2 ', & + 'CH3OOH_OH ', 'usr_N2O5_aer ', & + 'usr_NO3_aer ', 'usr_NO2_aer ', & + 'usr_HO2_aer ', 'OCS_O ', & + 'OCS_OH ', 'S_OH ', & + 'S_O2 ', 'S_O3 ', & + 'SO_OH ', 'SO_O2 ', & + 'SO_O3 ', 'SO_NO2 ', & + 'SO_CLO ', 'SO_BRO ', & + 'SO_OCLO ', 'usr_SO2_OH ', & + 'usr_SO3_H2O ', 'usr_DMS_OH ', & + 'DMS_OHb ', 'DMS_NO3 ', & + 'het1 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'ion_Op_O2 ', & + 'ion_Op_N2 ', 'ion_N2p_Oa ', & + 'ion_N2p_Ob ', 'ion_Op_CO2 ', & + 'ion_O2p_N ', 'ion_O2p_NO ', & + 'ion_Np_O2a ', 'ion_Np_O2b ', & + 'ion_Np_O ', 'ion_N2p_O2 ', & + 'ion_O2p_N2 ', 'elec1 ', & + 'elec2 ', 'elec3 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 92, 93, 94, 95, 96, & + 97, 98, 101, 102, 103, & + 105, 106, 107, 136, 137, & + 139, 141, 142, 143, 149, & + 150, 151, 153, 154, 156, & + 157, 162, 163, 164, 284, & + 285, 286, 289, 290, 291, & + 292, 293, 294, 296, 297, & + 298 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.910000_r8, 32.910000_r8, 189.810000_r8, 203.400000_r8, 194.710000_r8, & + 232.590000_r8, 67.670000_r8, 165.300000_r8, 293.620000_r8, 226.580000_r8, & + 120.100000_r8, 165.510000_r8, 177.510000_r8, 229.610000_r8, 133.750000_r8, & + 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 2, 3, 2, 3, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 1, 1, 2, 2, & + 2, 1, 1, 2, 2, 1, 1, 1, 1, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma_sulfur/chem_mech.doc b/src/chemistry/pp_waccm_ma_sulfur/chem_mech.doc new file mode 100644 index 0000000000..e280b088e9 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/chem_mech.doc @@ -0,0 +1,644 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O1D (O) + ( 4) O2 + ( 5) O2_1S (O2) + ( 6) O2_1D (O2) + ( 7) N2O + ( 8) N + ( 9) NO + ( 10) NO2 + ( 11) NO3 + ( 12) HNO3 + ( 13) HO2NO2 + ( 14) N2O5 + ( 15) CH4 + ( 16) CH3O2 + ( 17) CH3OOH + ( 18) CH2O + ( 19) CO + ( 20) H2 + ( 21) H + ( 22) OH + ( 23) HO2 + ( 24) H2O2 + ( 25) CLY + ( 26) BRY + ( 27) CL (Cl) + ( 28) CL2 (Cl2) + ( 29) CLO (ClO) + ( 30) OCLO (OClO) + ( 31) CL2O2 (Cl2O2) + ( 32) HCL (HCl) + ( 33) HOCL (HOCl) + ( 34) CLONO2 (ClONO2) + ( 35) BRCL (BrCl) + ( 36) BR (Br) + ( 37) BRO (BrO) + ( 38) HBR (HBr) + ( 39) HOBR (HOBr) + ( 40) BRONO2 (BrONO2) + ( 41) CH3CL (CH3Cl) + ( 42) CH3BR (CH3Br) + ( 43) CFC11 (CFCl3) + ( 44) CFC12 (CF2Cl2) + ( 45) CFC113 (CCl2FCClF2) + ( 46) HCFC22 (CHF2Cl) + ( 47) CCL4 (CCl4) + ( 48) CH3CCL3 (CH3CCl3) + ( 49) CF3BR (CF3Br) + ( 50) CF2CLBR (CF2ClBr) + ( 51) CO2 + ( 52) N2p (N2) + ( 53) O2p (O2) + ( 54) Np (N) + ( 55) Op (O) + ( 56) NOp (NO) + ( 57) e (E) + ( 58) N2D (N) + ( 59) OCS + ( 60) S + ( 61) SO + ( 62) SO2 + ( 63) SO3 + ( 64) HSO3 + ( 65) H2SO4 + ( 66) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CO + ( 4) H2 + ( 5) CH3CL + ( 6) CH3BR + ( 7) CFC11 + ( 8) CFC12 + ( 9) CFC113 + ( 10) HCFC22 + ( 11) CCL4 + ( 12) CH3CCL3 + ( 13) CF3BR + ( 14) CF2CLBR + ( 15) CO2 + ( 16) CLY + ( 17) BRY + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) N + ( 8) NO + ( 9) NO2 + ( 10) OH + ( 11) NO3 + ( 12) HNO3 + ( 13) HO2NO2 + ( 14) N2O5 + ( 15) CH3O2 + ( 16) CH3OOH + ( 17) CH2O + ( 18) H + ( 19) HO2 + ( 20) H2O2 + ( 21) H2O + ( 22) CL + ( 23) CL2 + ( 24) CLO + ( 25) OCLO + ( 26) CL2O2 + ( 27) HCL + ( 28) HOCL + ( 29) CLONO2 + ( 30) BRCL + ( 31) BR + ( 32) BRO + ( 33) HBR + ( 34) HOBR + ( 35) BRONO2 + ( 36) N2p + ( 37) O2p + ( 38) Np + ( 39) Op + ( 40) NOp + ( 41) N2D + ( 42) e + ( 43) OCS + ( 44) S + ( 45) SO + ( 46) SO2 + ( 47) SO3 + ( 48) HSO3 + ( 49) H2SO4 + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> O + CL rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jbrono2_a ( 34) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 34) + jbrono2_b ( 35) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 35) + jch3cl ( 36) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 36) + jccl4 ( 37) CCL4 + hv -> 4*CL rate = ** User defined ** ( 37) + jch3ccl3 ( 38) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 38) + jcfcl3 ( 39) CFC11 + hv -> 3*CL rate = ** User defined ** ( 39) + jcf2cl2 ( 40) CFC12 + hv -> 2*CL rate = ** User defined ** ( 40) + jcfc113 ( 41) CFC113 + hv -> 3*CL rate = ** User defined ** ( 41) + jhcfc22 ( 42) HCFC22 + hv -> CL rate = ** User defined ** ( 42) + jch3br ( 43) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 43) + jcf3br ( 44) CF3BR + hv -> BR rate = ** User defined ** ( 44) + jcf2clbr ( 45) CF2CLBR + hv -> BR + CL rate = ** User defined ** ( 45) + jco2 ( 46) CO2 + hv -> CO + O rate = ** User defined ** ( 46) + jch4_a ( 47) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 47) + jch4_b ( 48) CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO rate = ** User defined ** ( 48) + + .05*H2O + jh2so4 ( 49) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 49) + jso2 ( 50) SO2 + hv -> SO + O rate = ** User defined ** ( 50) + jso3 ( 51) SO3 + hv -> SO2 + O rate = ** User defined ** ( 51) + jocs ( 52) OCS + hv -> S + CO rate = ** User defined ** ( 52) + jso ( 53) SO + hv -> S + O rate = ** User defined ** ( 53) + jeuv_1 ( 54) O + hv -> Op + e rate = ** User defined ** ( 54) + jeuv_2 ( 55) O + hv -> Op + e rate = ** User defined ** ( 55) + jeuv_3 ( 56) O + hv -> Op + e rate = ** User defined ** ( 56) + jeuv_4 ( 57) N + hv -> Np + e rate = ** User defined ** ( 57) + jeuv_5 ( 58) O2 + hv -> O2p + e rate = ** User defined ** ( 58) + jeuv_6 ( 59) N2 + hv -> N2p + e rate = ** User defined ** ( 59) + jeuv_7 ( 60) O2 + hv -> O + Op + e rate = ** User defined ** ( 60) + jeuv_8 ( 61) O2 + hv -> O + Op + e rate = ** User defined ** ( 61) + jeuv_9 ( 62) O2 + hv -> O + Op + e rate = ** User defined ** ( 62) + jeuv_10 ( 63) N2 + hv -> N + Np + e rate = ** User defined ** ( 63) + jeuv_11 ( 64) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 64) + jeuv_12 ( 65) O2 + hv -> 2*O rate = ** User defined ** ( 65) + jeuv_13 ( 66) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 66) + jeuv_14 ( 67) O + hv -> Op + e rate = ** User defined ** ( 67) + jeuv_15 ( 68) O + hv -> Op + e rate = ** User defined ** ( 68) + jeuv_16 ( 69) O + hv -> Op + e rate = ** User defined ** ( 69) + jeuv_17 ( 70) O2 + hv -> O2p + e rate = ** User defined ** ( 70) + jeuv_18 ( 71) N2 + hv -> N2p + e rate = ** User defined ** ( 71) + jeuv_19 ( 72) O2 + hv -> O + Op + e rate = ** User defined ** ( 72) + jeuv_20 ( 73) O2 + hv -> O + Op + e rate = ** User defined ** ( 73) + jeuv_21 ( 74) O2 + hv -> O + Op + e rate = ** User defined ** ( 74) + jeuv_22 ( 75) N2 + hv -> N + Np + e rate = ** User defined ** ( 75) + jeuv_23 ( 76) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 76) + jeuv_24 ( 77) O2 + hv -> 2*O rate = ** User defined ** ( 77) + jeuv_25 ( 78) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 78) + jeuv_26 ( 79) CO2 + hv -> CO + O rate = ** User defined ** ( 79) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** ( 80) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 81) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** ( 82) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 ( 83) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 ( 84) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) ( 85) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) ( 86) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 ( 87) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 ( 88) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 ( 89) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) ( 90) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 ( 91) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 ( 92) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) ( 93) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) ( 94) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) ( 95) + ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) ( 96) + ( 18) O1D + N2O -> 2*NO rate = 6.70E-11*exp( 20./t) ( 97) + ( 19) O1D + N2O -> N2 + O2 rate = 4.70E-11*exp( 20./t) ( 98) + ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 ( 99) + ( 21) O1D + CFC11 -> 3*CL rate = 1.70E-10 (100) + ( 22) O1D + CFC12 -> 2*CL rate = 1.20E-10 (101) + ( 23) O1D + CFC113 -> 3*CL rate = 1.50E-10 (102) + ( 24) O1D + HCFC22 -> CL rate = 7.20E-11 (103) + ( 25) O1D + CCL4 -> 4*CL rate = 2.84E-10 (104) + ( 26) O1D + CH3BR -> BR rate = 1.80E-10 (105) + ( 27) O1D + CF2CLBR -> BR rate = 9.60E-11 (106) + ( 28) O1D + CF3BR -> BR rate = 4.10E-11 (107) + ( 29) O1D + CH4 -> CH3O2 + OH rate = 1.13E-10 (108) + ( 30) O1D + CH4 -> CH2O + H + HO2 rate = 3.00E-11 (109) + ( 31) O1D + CH4 -> CH2O + H2 rate = 7.50E-12 (110) + ( 32) O1D + H2 -> H + OH rate = 1.10E-10 (111) + ( 33) O1D + HCL -> CL + OH rate = 1.50E-10 (112) + ( 34) O1D + HBR -> BR + OH rate = 1.50E-10 (113) + N2D_O2 ( 35) N2D + O2 -> NO + O1D rate = 5.00E-12 (114) + N2D_O ( 36) N2D + O -> N + O rate = 7.00E-13 (115) + N_O2 ( 37) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (116) + N_NO ( 38) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (117) + ( 39) N + NO2 -> N2O + O rate = 5.80E-12*exp( 220./t) (118) + ( 40) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (119) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 41) NO + HO2 -> NO2 + OH rate = 3.50E-12*exp( 250./t) (120) + NO_O3 ( 42) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (121) + NO2_O ( 43) NO2 + O -> NO + O2 rate = 5.20E-12*exp( 210./t) (122) + ( 44) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (123) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + ( 45) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (124) + tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (125) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 47) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (126) + tag_NO2_OH ( 48) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (127) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 49) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (128) + ( 50) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (129) + ( 51) NO3 + O -> NO2 + O2 rate = 1.00E-11 (130) + ( 52) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (131) + ( 53) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (132) + tag_NO2_HO2 ( 54) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (133) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + ( 55) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (134) + usr_HO2NO2_M ( 56) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (135) + ( 57) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (136) + ( 58) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (137) + ( 59) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (138) + ( 60) CH3OOH + OH -> CH3O2 + H2O rate = 3.80E-12*exp( 200./t) (139) + ( 61) CH2O + NO3 -> CO + HO2 + HNO3 rate = 5.80E-16 (140) + ( 62) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (141) + ( 63) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (142) + ( 64) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (143) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + usr_CO_OH_b ( 65) CO + OH -> CO2 + H rate = ** User defined ** (144) + H_O2 ( 66) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (145) + ki=4.70E-11*(300/t)**0.20 + f=0.60 + H_O3 ( 67) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (146) + tag_H_HO2_a ( 68) H + HO2 -> 2*OH rate = 7.20E-11 (147) + H_HO2 ( 69) H + HO2 -> H2 + O2 rate = 6.90E-12 (148) + tag_H_HO2_b ( 70) H + HO2 -> H2O + O rate = 1.60E-12 (149) + OH_O ( 71) OH + O -> H + O2 rate = 2.20E-11*exp( 120./t) (150) + OH_O3 ( 72) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (151) + OH_HO2 ( 73) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (152) + ( 74) OH + OH -> H2O + O rate = 1.80E-12 (153) + ( 75) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (154) + ki=2.60E-11 + f=0.60 + ( 76) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (155) + tag_OH_H2O2 ( 77) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (156) + HO2_O ( 78) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (157) + HO2_O3 ( 79) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (158) + usr_HO2_HO2 ( 80) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (159) + tag_H2O2_O ( 81) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (160) + ( 82) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (161) + ( 83) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (162) + ( 84) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (163) + ( 85) CL + HO2 -> HCL + O2 rate = 1.80E-11*exp( 170./t) (164) + ( 86) CL + HO2 -> OH + CLO rate = 4.10E-11*exp( -450./t) (165) + ( 87) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (166) + ( 88) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (167) + ( 89) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (168) + ( 90) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (169) + ( 91) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (170) + ( 92) CLO + HO2 -> O2 + HOCL rate = 2.70E-12*exp( 220./t) (171) + ( 93) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (172) + ( 94) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (173) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + ( 95) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (174) + ( 96) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (175) + ( 97) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (176) + tag_CLO_CLO ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (177) + ki=2.00E-12*(300/t)**2.40 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (178) + (100) HCL + OH -> H2O + CL rate = 2.60E-12*exp( -350./t) (179) + (101) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (180) + (102) HOCL + O -> CLO + OH rate = 1.70E-13 (181) + (103) HOCL + CL -> HCL + CLO rate = 2.50E-12*exp( -130./t) (182) + (104) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (183) + (105) CLONO2 + O -> CLO + NO3 rate = 2.90E-12*exp( -800./t) (184) + (106) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (185) + (107) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (186) + (108) BR + O3 -> BRO + O2 rate = 1.70E-11*exp( -800./t) (187) + (109) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (188) + (110) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (189) + (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (190) + (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (191) + (113) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (192) + (114) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (193) + (115) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (194) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + (116) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (195) + (117) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (196) + (118) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (197) + (119) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (198) + (120) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (199) + (121) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (200) + (122) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (201) + (123) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (202) + (124) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (203) + (125) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (204) + (126) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (205) + (127) HCFC22 + OH -> CL + H2O + {CF2O} rate = 1.05E-12*exp( -1600./t) (206) + (128) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (207) + (129) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (208) + (130) OCS + OH -> SO2 + CO + H rate = 1.10E-13*exp( -1200./t) (209) + (131) S + OH -> SO + H rate = 6.60E-11 (210) + (132) S + O2 -> SO + O rate = 2.30E-12 (211) + (133) S + O3 -> SO + O2 rate = 1.20E-11 (212) + (134) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (213) + (135) SO + O2 -> SO2 + O rate = 1.25E-13*exp( -2190./t) (214) + (136) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (215) + (137) SO + NO2 -> SO2 + NO rate = 1.40E-11 (216) + (138) SO + CLO -> SO2 + CL rate = 2.80E-11 (217) + (139) SO + BRO -> SO2 + BR rate = 5.70E-11 (218) + (140) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (219) + (141) SO2 + OH + M -> HSO3 + M troe : ko=3.30E-31*(300/t)**4.30 (220) + ki=1.60E-12 + f=0.60 + (142) HSO3 + O2 -> SO3 + HO2 rate = 1.30E-12*exp( -330./t) (221) + usr_SO3_H2O (143) SO3 + H2O -> H2SO4 rate = ** User defined ** (222) + het1 (144) N2O5 -> 2*HNO3 rate = ** User defined ** (223) + het2 (145) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (224) + het3 (146) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (225) + het4 (147) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (226) + het5 (148) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (227) + het6 (149) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (228) + het7 (150) N2O5 -> 2*HNO3 rate = ** User defined ** (229) + het8 (151) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (230) + het9 (152) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (231) + het10 (153) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (232) + het11 (154) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (233) + het12 (155) N2O5 -> 2*HNO3 rate = ** User defined ** (234) + het13 (156) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (235) + het14 (157) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (236) + het15 (158) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (237) + het16 (159) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (238) + het17 (160) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (239) + ion_Op_O2 (161) Op + O2 -> O2p + O rate = ** User defined ** (240) + ion_Op_N2 (162) Op + N2 -> NOp + N rate = ** User defined ** (241) + ion_N2p_Oa (163) N2p + O -> NOp + N2D rate = ** User defined ** (242) + (164) Op + CO2 -> O2p + CO rate = 9.00E-10 (243) + ion_O2p_N (165) O2p + N -> NOp + O rate = 1.00E-10 (244) + ion_O2p_NO (166) O2p + NO -> NOp + O2 rate = 4.40E-10 (245) + ion_Np_O2a (167) Np + O2 -> O2p + N rate = 4.00E-10 (246) + ion_Np_O2b (168) Np + O2 -> NOp + O rate = 2.00E-10 (247) + ion_Np_O (169) Np + O -> Op + N rate = 1.00E-12 (248) + ion_N2p_O2 (170) N2p + O2 -> O2p + N2 rate = 6.00E-11 (249) + (171) O2p + N2 -> NOp + NO rate = 5.00E-16 (250) + ion_N2p_Ob (172) N2p + O -> Op + N2 rate = ** User defined ** (251) + elec1 (173) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (252) + elec2 (174) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (253) + elec3 (175) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (254) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) Op + ( 6) O2p + ( 7) Np + ( 8) N2p + ( 9) N2D + (10) N + (11) e + (12) OH + + + Equation Report + + d(O3)/dt = r1*M*O*O2 + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r42*NO*O3 - r45*NO2*O3 - r67*H*O3 - r72*OH*O3 + - r79*HO2*O3 - r82*CL*O3 - r108*BR*O3 - r133*S*O3 - r136*SO*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j46*CO2 + .18*j48*CH4 + j50*SO2 + j51*SO3 + j53*SO + j60*O2 + j61*O2 + j62*O2 + + 2*j65*O2 + j72*O2 + j73*O2 + j74*O2 + 2*j77*O2 + j79*CO2 + r14*N2*O1D + r15*O1D*O2 + + r16*O1D*O2 + r37*N*O2 + r38*N*NO + r39*N*NO2 + r70*H*HO2 + r74*OH*OH + r132*S*O2 + r135*SO*O2 + + r161*Op*O2 + r165*O2p*N + r168*Np*O2 + r173*NOp*e + 1.15*r174*O2p*e + - j54*O - j55*O - j56*O - j67*O - j68*O - j69*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O + - r40*M*NO*O - r43*NO2*O - r44*M*NO2*O - r51*NO3*O - r63*CH2O*O - r71*OH*O - r78*HO2*O + - r81*H2O2*O - r89*CLO*O - r101*HCL*O - r102*HOCL*O - r105*CLONO2*O - r111*BRO*O - r121*HBR*O + - r122*HOBR*O - r123*BRONO2*O - r129*OCS*O - r163*N2p*O - r169*Np*O - r172*N2p*O + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r35*N2D*O2 + .85*r174*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*HCFC22*O1D - r25*CCL4*O1D - r26*CH3BR*O1D + - r27*CF2CLBR*O1D - r28*CF3BR*O1D - r29*CH4*O1D - r30*CH4*O1D - r31*CH4*O1D - r32*H2*O1D + - r33*HCL*O1D - r34*HBR*O1D + d(O2)/dt = j4*O3 + j13*NO3 + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + r20*O1D*O3 + r42*NO*O3 + r43*NO2*O + r45*NO2*O3 + + r51*NO3*O + r53*NO3*HO2 + r55*HO2NO2*OH + r59*CH3O2*HO2 + r67*H*O3 + r69*H*HO2 + r71*OH*O + + r72*OH*O3 + r73*OH*HO2 + r78*HO2*O + 2*r79*HO2*O3 + r80*HO2*HO2 + r82*CL*O3 + r85*CL*HO2 + + r89*CLO*O + r91*CLO*OH + r92*CLO*HO2 + r95*CLO*CLO + r96*CLO*CLO + r108*BR*O3 + r109*BR*HO2 + + r111*BRO*O + r113*BRO*HO2 + r117*BRO*CLO + r118*BRO*CLO + r119*BRO*BRO + r133*S*O3 + + r136*SO*O3 + r166*O2p*NO + - j1*O2 - j2*O2 - j58*O2 - j60*O2 - j61*O2 - j62*O2 - j65*O2 - j70*O2 - j72*O2 - j73*O2 + - j74*O2 - j77*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r35*N2D*O2 - r37*N*O2 - r66*M*H*O2 + - r132*S*O2 - r135*SO*O2 - r142*HSO3*O2 - r161*Op*O2 - r167*Np*O2 - r168*Np*O2 - r170*N2p*O2 + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(N2O)/dt = r39*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j63*N2 + .8*j66*N2 + j75*N2 + .8*j78*N2 + j6*NO + r162*N2*Op + r36*N2D*O + r167*Np*O2 + + r169*Np*O + .2*r173*NOp*e + 1.1*r175*N2p*e + - j57*N - r37*O2*N - r38*NO*N - r39*NO2*N - r165*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + r171*N2*O2p + 2*r18*O1D*N2O + r35*N2D*O2 + r37*N*O2 + r43*NO2*O + + r137*SO*NO2 + - j6*NO - j7*NO - r38*N*NO - r40*M*O*NO - r41*HO2*NO - r42*O3*NO - r50*NO3*NO - r58*CH3O2*NO + - r93*CLO*NO - r114*BRO*NO - r166*O2p*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j35*BRONO2 + r47*M*N2O5 + r56*M*HO2NO2 + + r40*M*NO*O + r41*NO*HO2 + r42*NO*O3 + 2*r50*NO3*NO + r51*NO3*O + r52*NO3*OH + r53*NO3*HO2 + + r55*HO2NO2*OH + r58*CH3O2*NO + r93*CLO*NO + r114*BRO*NO + - j8*NO2 - r39*N*NO2 - r43*O*NO2 - r44*M*O*NO2 - r45*O3*NO2 - r46*M*NO3*NO2 - r48*M*OH*NO2 + - r54*M*HO2*NO2 - r94*M*CLO*NO2 - r115*M*BRO*NO2 - r137*SO*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j34*BRONO2 + r47*M*N2O5 + r44*M*NO2*O + + r45*NO2*O3 + r49*HNO3*OH + r105*CLONO2*O + r106*CLONO2*OH + r107*CLONO2*CL + r123*BRONO2*O + - j12*NO3 - j13*NO3 - r46*M*NO2*NO3 - r50*NO*NO3 - r51*O*NO3 - r52*OH*NO3 - r53*HO2*NO3 + - r61*CH2O*NO3 + d(HNO3)/dt = 2*r144*N2O5 + r145*CLONO2 + r146*BRONO2 + 2*r150*N2O5 + r151*CLONO2 + r154*BRONO2 + 2*r155*N2O5 + + r156*CLONO2 + r157*BRONO2 + r48*M*NO2*OH + r61*CH2O*NO3 + r147*CLONO2*HCL + r152*CLONO2*HCL + + r158*CLONO2*HCL + - j11*HNO3 - r49*OH*HNO3 + d(HO2NO2)/dt = r54*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r56*M*HO2NO2 - r55*OH*HO2NO2 + d(N2O5)/dt = r46*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r47*M*N2O5 - r144*N2O5 - r150*N2O5 - r155*N2O5 + d(CH4)/dt = - j47*CH4 - j48*CH4 - r29*O1D*CH4 - r30*O1D*CH4 - r31*O1D*CH4 - r57*OH*CH4 - r88*CL*CH4 + d(CH3O2)/dt = j36*CH3CL + j43*CH3BR + j47*CH4 + r29*O1D*CH4 + r57*CH4*OH + r60*CH3OOH*OH + r88*CL*CH4 + - r58*NO*CH3O2 - r59*HO2*CH3O2 + d(CH3OOH)/dt = r59*CH3O2*HO2 + - j16*CH3OOH - r60*OH*CH3OOH + d(CH2O)/dt = j16*CH3OOH + .18*j48*CH4 + r30*O1D*CH4 + r31*O1D*CH4 + r58*CH3O2*NO + - j17*CH2O - j18*CH2O - r61*NO3*CH2O - r62*OH*CH2O - r63*O*CH2O - r87*CL*CH2O - r110*BR*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j46*CO2 + .38*j48*CH4 + j52*OCS + j79*CO2 + r61*CH2O*NO3 + r62*CH2O*OH + + r63*CH2O*O + r87*CL*CH2O + r110*BR*CH2O + r124*CH3CL*CL + r129*OCS*O + r130*OCS*OH + + r164*Op*CO2 + - r64*M*OH*CO - r65*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j48*CH4 + r31*O1D*CH4 + r69*H*HO2 + - r32*O1D*H2 - r76*OH*H2 - r83*CL*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j47*CH4 + r30*O1D*CH4 + r32*O1D*H2 + + r62*CH2O*OH + r65*CO*OH + r71*OH*O + r76*OH*H2 + r83*CL*H2 + r130*OCS*OH + r131*S*OH + + r134*SO*OH + - r66*M*O2*H - r67*O3*H - r68*HO2*H - r69*HO2*H - r70*HO2*H + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .66*j48*CH4 + + 2*r17*O1D*H2O + r29*O1D*CH4 + r32*O1D*H2 + r33*O1D*HCL + r34*O1D*HBR + r41*NO*HO2 + + r53*NO3*HO2 + r63*CH2O*O + r67*H*O3 + 2*r68*H*HO2 + r78*HO2*O + r79*HO2*O3 + r81*H2O2*O + + r86*CL*HO2 + r101*HCL*O + r102*HOCL*O + r121*HBR*O + r122*HOBR*O + - r48*M*NO2*OH - r49*HNO3*OH - r52*NO3*OH - r55*HO2NO2*OH - r57*CH4*OH - r60*CH3OOH*OH + - r62*CH2O*OH - r64*M*CO*OH - r65*CO*OH - r71*O*OH - r72*O3*OH - r73*HO2*OH - 2*r74*OH*OH + - 2*r75*M*OH*OH - r76*H2*OH - r77*H2O2*OH - r90*CLO*OH - r91*CLO*OH - r100*HCL*OH - r104*HOCL*OH + - r106*CLONO2*OH - r112*BRO*OH - r120*HBR*OH - r125*CH3CL*OH - r126*CH3CCL3*OH - r127*HCFC22*OH + - r128*CH3BR*OH - r130*OCS*OH - r131*S*OH - r134*SO*OH - r141*M*SO2*OH + d(HO2)/dt = j15*HO2NO2 + r56*M*HO2NO2 + r30*O1D*CH4 + r52*NO3*OH + r58*CH3O2*NO + r61*CH2O*NO3 + r63*CH2O*O + + r64*M*CO*OH + r66*M*H*O2 + r72*OH*O3 + r77*OH*H2O2 + r81*H2O2*O + r84*CL*H2O2 + r87*CL*CH2O + + r90*CLO*OH + r110*BR*CH2O + r112*BRO*OH + r124*CH3CL*CL + r125*CH3CL*OH + r128*CH3BR*OH + + r142*HSO3*O2 + - r41*NO*HO2 - r53*NO3*HO2 - r54*M*NO2*HO2 - r59*CH3O2*HO2 - r68*H*HO2 - r69*H*HO2 - r70*H*HO2 + - r73*OH*HO2 - r78*O*HO2 - r79*O3*HO2 - 2*r80*HO2*HO2 - r85*CL*HO2 - r86*CL*HO2 - r92*CLO*HO2 + - r109*BR*HO2 - r113*BRO*HO2 + d(H2O2)/dt = r75*M*OH*OH + r80*HO2*HO2 + - j22*H2O2 - r77*OH*H2O2 - r81*O*H2O2 - r84*CL*H2O2 + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j36*CH3CL + + 4*j37*CCL4 + 3*j38*CH3CCL3 + 3*j39*CFC11 + 2*j40*CFC12 + 3*j41*CFC113 + j42*HCFC22 + + j45*CF2CLBR + 3*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 3*r23*O1D*CFC113 + r24*O1D*HCFC22 + + 4*r25*O1D*CCL4 + r33*O1D*HCL + r89*CLO*O + r90*CLO*OH + r93*CLO*NO + 2*r95*CLO*CLO + + r97*CLO*CLO + r100*HCL*OH + r101*HCL*O + r117*BRO*CLO + r125*CH3CL*OH + 3*r126*CH3CCL3*OH + + r127*HCFC22*OH + r138*SO*CLO + - r82*O3*CL - r83*H2*CL - r84*H2O2*CL - r85*HO2*CL - r86*HO2*CL - r87*CH2O*CL - r88*CH4*CL + - r103*HOCL*CL - r107*CLONO2*CL - r124*CH3CL*CL + d(CL2)/dt = r96*CLO*CLO + r107*CLONO2*CL + r147*CLONO2*HCL + r148*HOCL*HCL + r152*CLONO2*HCL + r153*HOCL*HCL + + r158*CLONO2*HCL + r159*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r99*M*CL2O2 + r99*M*CL2O2 + r82*CL*O3 + r86*CL*HO2 + r102*HOCL*O + + r103*HOCL*CL + r104*HOCL*OH + r105*CLONO2*O + r140*SO*OCLO + - j24*CLO - r89*O*CLO - r90*OH*CLO - r91*OH*CLO - r92*HO2*CLO - r93*NO*CLO - r94*M*NO2*CLO + - 2*r95*CLO*CLO - 2*r96*CLO*CLO - 2*r97*CLO*CLO - 2*r98*M*CLO*CLO - r116*BRO*CLO - r117*BRO*CLO + - r118*BRO*CLO - r138*SO*CLO + d(OCLO)/dt = r97*CLO*CLO + r116*BRO*CLO + - j25*OCLO - r140*SO*OCLO + d(CL2O2)/dt = r98*M*CLO*CLO + - j26*CL2O2 - r99*M*CL2O2 + d(HCL)/dt = r83*CL*H2 + r84*CL*H2O2 + r85*CL*HO2 + r87*CL*CH2O + r88*CL*CH4 + r91*CLO*OH + r103*HOCL*CL + + 2*r124*CH3CL*CL + - j28*HCL - r33*O1D*HCL - r100*OH*HCL - r101*O*HCL - r147*CLONO2*HCL - r148*HOCL*HCL + - r149*HOBR*HCL - r152*CLONO2*HCL - r153*HOCL*HCL - r158*CLONO2*HCL - r159*HOCL*HCL + - r160*HOBR*HCL + d(HOCL)/dt = r145*CLONO2 + r151*CLONO2 + r156*CLONO2 + r92*CLO*HO2 + r106*CLONO2*OH + - j27*HOCL - r102*O*HOCL - r103*CL*HOCL - r104*OH*HOCL - r148*HCL*HOCL - r153*HCL*HOCL + - r159*HCL*HOCL + d(CLONO2)/dt = r94*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r145*CLONO2 - r151*CLONO2 - r156*CLONO2 - r105*O*CLONO2 + - r106*OH*CLONO2 - r107*CL*CLONO2 - r147*HCL*CLONO2 - r152*HCL*CLONO2 - r158*HCL*CLONO2 + d(BRCL)/dt = r118*BRO*CLO + r149*HOBR*HCL + r160*HOBR*HCL + - j31*BRCL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*BRONO2 + j43*CH3BR + j44*CF3BR + j45*CF2CLBR + r26*O1D*CH3BR + + r27*O1D*CF2CLBR + r28*O1D*CF3BR + r34*O1D*HBR + r111*BRO*O + r112*BRO*OH + r114*BRO*NO + + r116*BRO*CLO + r117*BRO*CLO + 2*r119*BRO*BRO + r120*HBR*OH + r121*HBR*O + r128*CH3BR*OH + + r139*SO*BRO + - r108*O3*BR - r109*HO2*BR - r110*CH2O*BR + d(BRO)/dt = j35*BRONO2 + r108*BR*O3 + r122*HOBR*O + r123*BRONO2*O + - j32*BRO - r111*O*BRO - r112*OH*BRO - r113*HO2*BRO - r114*NO*BRO - r115*M*NO2*BRO + - r116*CLO*BRO - r117*CLO*BRO - r118*CLO*BRO - 2*r119*BRO*BRO - r139*SO*BRO + d(HBR)/dt = r109*BR*HO2 + r110*BR*CH2O + - r34*O1D*HBR - r120*OH*HBR - r121*O*HBR + d(HOBR)/dt = r146*BRONO2 + r154*BRONO2 + r157*BRONO2 + r113*BRO*HO2 + - j33*HOBR - r122*O*HOBR - r149*HCL*HOBR - r160*HCL*HOBR + d(BRONO2)/dt = r115*M*BRO*NO2 + - j34*BRONO2 - j35*BRONO2 - r146*BRONO2 - r154*BRONO2 - r157*BRONO2 - r123*O*BRONO2 + d(CH3CL)/dt = - j36*CH3CL - r124*CL*CH3CL - r125*OH*CH3CL + d(CH3BR)/dt = - j43*CH3BR - r26*O1D*CH3BR - r128*OH*CH3BR + d(CFC11)/dt = - j39*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j40*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j41*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j42*HCFC22 - r24*O1D*HCFC22 - r127*OH*HCFC22 + d(CCL4)/dt = - j37*CCL4 - r25*O1D*CCL4 + d(CH3CCL3)/dt = - j38*CH3CCL3 - r126*OH*CH3CCL3 + d(CF3BR)/dt = - j44*CF3BR - r28*O1D*CF3BR + d(CF2CLBR)/dt = - j45*CF2CLBR - r27*O1D*CF2CLBR + d(CO2)/dt = .44*j48*CH4 + r64*M*CO*OH + r65*CO*OH + - j46*CO2 - j79*CO2 - r164*Op*CO2 + d(N2p)/dt = j59*N2 + j71*N2 + - r163*O*N2p - r170*O2*N2p - r172*O*N2p - r175*e*N2p + d(O2p)/dt = j58*O2 + j70*O2 + r161*Op*O2 + r164*Op*CO2 + r167*Np*O2 + r170*N2p*O2 + - r171*N2*O2p - r165*N*O2p - r166*NO*O2p - r174*e*O2p + d(Np)/dt = j63*N2 + j64*N2 + j75*N2 + j76*N2 + j57*N + - r167*O2*Np - r168*O2*Np - r169*O*Np + d(Op)/dt = j54*O + j55*O + j56*O + j60*O2 + j61*O2 + j62*O2 + j67*O + j68*O + j69*O + j72*O2 + j73*O2 + + j74*O2 + r169*Np*O + r172*N2p*O + - r162*N2*Op - r161*O2*Op - r164*CO2*Op + d(NOp)/dt = j7*NO + r162*N2*Op + r171*N2*O2p + r163*N2p*O + r165*O2p*N + r166*O2p*NO + r168*Np*O2 + - r173*e*NOp + d(e)/dt = j59*N2 + j63*N2 + j64*N2 + j71*N2 + j75*N2 + j76*N2 + j7*NO + j54*O + j55*O + j56*O + j57*N + + j58*O2 + j60*O2 + j61*O2 + j62*O2 + j67*O + j68*O + j69*O + j70*O2 + j72*O2 + j73*O2 + + j74*O2 + - r173*NOp*e - r174*O2p*e - r175*N2p*e + d(N2D)/dt = j64*N2 + 1.2*j66*N2 + j76*N2 + 1.2*j78*N2 + r163*N2p*O + .8*r173*NOp*e + .9*r175*N2p*e + - r35*O2*N2D - r36*O*N2D + d(OCS)/dt = - j52*OCS - r129*O*OCS - r130*OH*OCS + d(S)/dt = j52*OCS + j53*SO + - r131*OH*S - r132*O2*S - r133*O3*S + d(SO)/dt = j50*SO2 + r129*OCS*O + r131*S*OH + r132*S*O2 + r133*S*O3 + - j53*SO - r134*OH*SO - r135*O2*SO - r136*O3*SO - r137*NO2*SO - r138*CLO*SO - r139*BRO*SO + - r140*OCLO*SO + d(SO2)/dt = j51*SO3 + r130*OCS*OH + r134*SO*OH + r135*SO*O2 + r136*SO*O3 + r137*SO*NO2 + r138*SO*CLO + + r139*SO*BRO + r140*SO*OCLO + - j50*SO2 - r141*M*OH*SO2 + d(SO3)/dt = j49*H2SO4 + r142*HSO3*O2 + - j51*SO3 - r143*H2O*SO3 + d(HSO3)/dt = r141*M*SO2*OH + - r142*O2*HSO3 + d(H2SO4)/dt = r143*SO3*H2O + - j49*H2SO4 + d(H2O)/dt = .05*j48*CH4 + j49*H2SO4 + r49*HNO3*OH + r55*HO2NO2*OH + r57*CH4*OH + r60*CH3OOH*OH + r62*CH2O*OH + + r70*H*HO2 + r73*OH*HO2 + r74*OH*OH + r76*OH*H2 + r77*OH*H2O2 + r100*HCL*OH + r104*HOCL*OH + + r120*HBR*OH + r125*CH3CL*OH + r126*CH3CCL3*OH + r127*HCFC22*OH + r128*CH3BR*OH + r148*HOCL*HCL + + r149*HOBR*HCL + r153*HOCL*HCL + r159*HOCL*HCL + r160*HOBR*HCL + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r143*SO3*H2O diff --git a/src/chemistry/pp_waccm_ma_sulfur/chem_mech.in b/src/chemistry/pp_waccm_ma_sulfur/chem_mech.in new file mode 100644 index 0000000000..9b92329004 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/chem_mech.in @@ -0,0 +1,378 @@ +* 27 May 2011: corrected O1D + CCL4 -> 4*CL reaction for CESM1.0.3 release + + SPECIES + + Solution + O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH2O, CO + H2, H, OH, HO2, H2O2 + CLY, BRY + CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2 + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N + OCS, S, SO, SO2, SO3, HSO3, H2SO4 + H2O + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + END Species + + Solution classes + Explicit + CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113 + HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY, BRY + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D + N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e + OCS, S, SO, SO2, SO3, HSO3, H2SO4 + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> O + CL + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 3*CL + [jcf2cl2] CFC12 + hv -> 2*CL + [jcfc113] CFC113 + hv -> 3*CL + [jhcfc22] HCFC22 + hv -> CL + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + [jcf2clbr] CF2CLBR + hv -> BR + CL + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O + [jh2so4] H2SO4 + hv -> SO3 + H2O + [jso2] SO2 + hv -> SO + O + [jso3] SO3 + hv -> SO2 + O + [jocs] OCS + hv -> S + CO + [jso] SO + hv -> S + O +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op + e + [jeuv_3=userdefined,userdefined] O + hv -> Op + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op + e + [jeuv_16=userdefined,userdefined] O + hv -> Op + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.91] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + O1D + H2O -> 2*OH ; 1.63e-10, 60. + O1D + N2O -> 2*NO ; 6.70e-11, 20. + O1D + N2O -> N2 + O2 ; 4.70e-11, 20. + O1D + O3 -> O2 + O2 ; 1.20e-10 + O1D + CFC11 -> 3*CL ; 1.70e-10 + O1D + CFC12 -> 2*CL ; 1.20e-10 + O1D + CFC113 -> 3*CL ; 1.50e-10 + O1D + HCFC22 -> CL ; 7.20e-11 + O1D + CCL4 -> 4*CL ; 2.84e-10 + O1D + CH3BR -> BR ; 1.80e-10 + O1D + CF2CLBR -> BR ; 9.60e-11 + O1D + CF3BR -> BR ; 4.10e-11 + O1D + CH4 -> CH3O2 + OH ; 1.125e-10 + O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11 + O1D + CH4 -> CH2O + H2 ; 7.50e-12 + O1D + H2 -> H + OH ; 1.10e-10 + O1D + HCL -> CL + OH ; 1.50e-10 + O1D + HBR -> BR + OH ; 1.50e-10 +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + N + NO2 -> N2O + O ; 5.80e-12, 220. + NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.50e-12, 250. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.20e-12, 210. + NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + NO3 + O -> NO2 + O2 ; 1.00e-11 + NO3 + OH -> HO2 + NO2 ; 2.20e-11 + NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Methane, CO, CH2O and derivatives +* -------------------------------------------------------------- + CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200. + CH2O + NO3 -> CO + HO2 + HNO3 ; 5.80e-16 + CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [usr_CO_OH_b] CO + OH -> CO2 + H + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.7e-11, 0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [tag_H_HO2_a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [tag_H_HO2_b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 2.20e-11, 120. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + OH + OH -> H2O + O ; 1.80e-12 + OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.6e-11, 0.0, 0.6 + OH + H2 -> H2O + H ; 2.80e-12, -1800. + [tag_OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [tag_H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + CL + O3 -> CLO + O2 ; 2.30e-11, -200. + CL + H2 -> HCL + H ; 3.05e-11, -2270. + CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + CL + HO2 -> HCL + O2 ; 1.80e-11, 170. + CL + HO2 -> OH + CLO ; 4.10e-11, -450. + CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + CLO + O -> CL + O2 ; 2.80e-11, 85. + CLO + OH -> CL + HO2 ; 7.40e-12, 270. + CLO + OH -> HCL + O2 ; 6.00e-13, 230. + CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220. + CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + HCL + OH -> H2O + CL ; 2.60e-12, -350. + HCL + O -> CL + OH ; 1.00e-11, -3300. + HOCL + O -> CLO + OH ; 1.70e-13 + HOCL + CL -> HCL + CLO ; 2.50e-12, -130. + HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800. + CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + BR + O3 -> BRO + O2 ; 1.70e-11, -800. + BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + BRO + O -> BR + O2 ; 1.90e-11, 230. + BRO + OH -> BR + HO2 ; 1.70e-11, 250. + BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + BRO + NO -> BR + NO2 ; 8.80e-12, 260. + BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + HBR + OH -> BR + H2O ; 5.50e-12, 200. + HBR + O -> BR + OH ; 5.80e-12, -1500. + HOBR + O -> BRO + OH ; 1.20e-10, -430. + BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600. + CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + +* -------------------------------------------------------------- +* Sulfur Reactions +* -------------------------------------------------------------- + OCS + O -> SO + CO ; 2.10E-11, -2200.0 + OCS + OH -> SO2 + CO + H ; 1.10E-13, -1200.0 + S + OH -> SO + H ; 6.60E-11 + S + O2 -> SO + O ; 2.30E-12 + S + O3 -> SO + O2 ; 1.20E-11 + SO + OH -> SO2 + H ; 2.70E-11, 335 + SO + O2 -> SO2 + O ; 1.25E-13, -2190.0 + SO + O3 -> SO2 + O2 ; 3.40E-12, -1100.0 + SO + NO2 -> SO2 + NO ; 1.40E-11 + SO + CLO -> SO2 + CL ; 2.80E-11 + SO + BRO -> SO2 + BR ; 5.70E-11 + SO + OCLO -> SO2 + CLO ; 1.90E-12 + SO2 + OH + M -> HSO3 + M ; 3.3E-31,4.3, 1.60E-12,0.0, 0.6 + HSO3 + O2 -> SO3 + HO2 ; 1.30E-12, -330.0 + [usr_SO3_H2O] SO3 + H2O -> H2SO4 + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + Op + CO2 -> O2p + CO ; 9.e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + O2p + N2 -> NOp + NO ; 5.e-16 + [ion_N2p_Ob] N2p + O -> Op + N2 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + End Reactions + + Ext Forcing + NO<-dataset, NO2<-dataset, CO<-dataset, SO2<-dataset, Op, O2p, Np, N2p, N2D, N, e, OH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 new file mode 100644 index 0000000000..2dfcf62986 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 79, & ! number of photolysis reactions + rxntot = 254, & ! number of total reactions + gascnt = 175, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 66, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 588, & ! number of non-zero matrix entries + extcnt = 12, & ! number of species with external forcing + clscnt1 = 17, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 49, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 155, & + enthalpy_cnt = 41, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 new file mode 100644 index 0000000000..0b9a077bbe --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/m_rxt_id.F90 @@ -0,0 +1,257 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jbrono2_a = 34 + integer, parameter :: rid_jbrono2_b = 35 + integer, parameter :: rid_jch3cl = 36 + integer, parameter :: rid_jccl4 = 37 + integer, parameter :: rid_jch3ccl3 = 38 + integer, parameter :: rid_jcfcl3 = 39 + integer, parameter :: rid_jcf2cl2 = 40 + integer, parameter :: rid_jcfc113 = 41 + integer, parameter :: rid_jhcfc22 = 42 + integer, parameter :: rid_jch3br = 43 + integer, parameter :: rid_jcf3br = 44 + integer, parameter :: rid_jcf2clbr = 45 + integer, parameter :: rid_jco2 = 46 + integer, parameter :: rid_jch4_a = 47 + integer, parameter :: rid_jch4_b = 48 + integer, parameter :: rid_jh2so4 = 49 + integer, parameter :: rid_jso2 = 50 + integer, parameter :: rid_jso3 = 51 + integer, parameter :: rid_jocs = 52 + integer, parameter :: rid_jso = 53 + integer, parameter :: rid_jeuv_1 = 54 + integer, parameter :: rid_jeuv_2 = 55 + integer, parameter :: rid_jeuv_3 = 56 + integer, parameter :: rid_jeuv_4 = 57 + integer, parameter :: rid_jeuv_5 = 58 + integer, parameter :: rid_jeuv_6 = 59 + integer, parameter :: rid_jeuv_7 = 60 + integer, parameter :: rid_jeuv_8 = 61 + integer, parameter :: rid_jeuv_9 = 62 + integer, parameter :: rid_jeuv_10 = 63 + integer, parameter :: rid_jeuv_11 = 64 + integer, parameter :: rid_jeuv_12 = 65 + integer, parameter :: rid_jeuv_13 = 66 + integer, parameter :: rid_jeuv_14 = 67 + integer, parameter :: rid_jeuv_15 = 68 + integer, parameter :: rid_jeuv_16 = 69 + integer, parameter :: rid_jeuv_17 = 70 + integer, parameter :: rid_jeuv_18 = 71 + integer, parameter :: rid_jeuv_19 = 72 + integer, parameter :: rid_jeuv_20 = 73 + integer, parameter :: rid_jeuv_21 = 74 + integer, parameter :: rid_jeuv_22 = 75 + integer, parameter :: rid_jeuv_23 = 76 + integer, parameter :: rid_jeuv_24 = 77 + integer, parameter :: rid_jeuv_25 = 78 + integer, parameter :: rid_jeuv_26 = 79 + integer, parameter :: rid_usr_O_O2 = 80 + integer, parameter :: rid_O_O3 = 81 + integer, parameter :: rid_usr_O_O = 82 + integer, parameter :: rid_O2_1S_O = 83 + integer, parameter :: rid_O2_1S_O2 = 84 + integer, parameter :: rid_O2_1S_N2 = 85 + integer, parameter :: rid_O2_1S_O3 = 86 + integer, parameter :: rid_O2_1S_CO2 = 87 + integer, parameter :: rid_ag2 = 88 + integer, parameter :: rid_O2_1D_O = 89 + integer, parameter :: rid_O2_1D_O2 = 90 + integer, parameter :: rid_O2_1D_N2 = 91 + integer, parameter :: rid_ag1 = 92 + integer, parameter :: rid_O1D_N2 = 93 + integer, parameter :: rid_O1D_O2 = 94 + integer, parameter :: rid_O1D_O2b = 95 + integer, parameter :: rid_N2D_O2 = 114 + integer, parameter :: rid_N2D_O = 115 + integer, parameter :: rid_N_O2 = 116 + integer, parameter :: rid_N_NO = 117 + integer, parameter :: rid_NO_HO2 = 120 + integer, parameter :: rid_NO_O3 = 121 + integer, parameter :: rid_NO2_O = 122 + integer, parameter :: rid_tag_NO2_NO3 = 125 + integer, parameter :: rid_usr_N2O5_M = 126 + integer, parameter :: rid_tag_NO2_OH = 127 + integer, parameter :: rid_usr_HNO3_OH = 128 + integer, parameter :: rid_tag_NO2_HO2 = 133 + integer, parameter :: rid_usr_HO2NO2_M = 135 + integer, parameter :: rid_usr_CO_OH_b = 144 + integer, parameter :: rid_H_O2 = 145 + integer, parameter :: rid_H_O3 = 146 + integer, parameter :: rid_tag_H_HO2_a = 147 + integer, parameter :: rid_H_HO2 = 148 + integer, parameter :: rid_tag_H_HO2_b = 149 + integer, parameter :: rid_OH_O = 150 + integer, parameter :: rid_OH_O3 = 151 + integer, parameter :: rid_OH_HO2 = 152 + integer, parameter :: rid_tag_OH_H2O2 = 156 + integer, parameter :: rid_HO2_O = 157 + integer, parameter :: rid_HO2_O3 = 158 + integer, parameter :: rid_usr_HO2_HO2 = 159 + integer, parameter :: rid_tag_H2O2_O = 160 + integer, parameter :: rid_tag_CLO_CLO = 177 + integer, parameter :: rid_usr_CL2O2_M = 178 + integer, parameter :: rid_usr_SO3_H2O = 222 + integer, parameter :: rid_het1 = 223 + integer, parameter :: rid_het2 = 224 + integer, parameter :: rid_het3 = 225 + integer, parameter :: rid_het4 = 226 + integer, parameter :: rid_het5 = 227 + integer, parameter :: rid_het6 = 228 + integer, parameter :: rid_het7 = 229 + integer, parameter :: rid_het8 = 230 + integer, parameter :: rid_het9 = 231 + integer, parameter :: rid_het10 = 232 + integer, parameter :: rid_het11 = 233 + integer, parameter :: rid_het12 = 234 + integer, parameter :: rid_het13 = 235 + integer, parameter :: rid_het14 = 236 + integer, parameter :: rid_het15 = 237 + integer, parameter :: rid_het16 = 238 + integer, parameter :: rid_het17 = 239 + integer, parameter :: rid_ion_Op_O2 = 240 + integer, parameter :: rid_ion_Op_N2 = 241 + integer, parameter :: rid_ion_N2p_Oa = 242 + integer, parameter :: rid_ion_O2p_N = 244 + integer, parameter :: rid_ion_O2p_NO = 245 + integer, parameter :: rid_ion_Np_O2a = 246 + integer, parameter :: rid_ion_Np_O2b = 247 + integer, parameter :: rid_ion_Np_O = 248 + integer, parameter :: rid_ion_N2p_O2 = 249 + integer, parameter :: rid_ion_N2p_Ob = 251 + integer, parameter :: rid_elec1 = 252 + integer, parameter :: rid_elec2 = 253 + integer, parameter :: rid_elec3 = 254 + integer, parameter :: rid_r0096 = 96 + integer, parameter :: rid_r0097 = 97 + integer, parameter :: rid_r0098 = 98 + integer, parameter :: rid_r0099 = 99 + integer, parameter :: rid_r0100 = 100 + integer, parameter :: rid_r0101 = 101 + integer, parameter :: rid_r0102 = 102 + integer, parameter :: rid_r0103 = 103 + integer, parameter :: rid_r0104 = 104 + integer, parameter :: rid_r0105 = 105 + integer, parameter :: rid_r0106 = 106 + integer, parameter :: rid_r0107 = 107 + integer, parameter :: rid_r0108 = 108 + integer, parameter :: rid_r0109 = 109 + integer, parameter :: rid_r0110 = 110 + integer, parameter :: rid_r0111 = 111 + integer, parameter :: rid_r0112 = 112 + integer, parameter :: rid_r0113 = 113 + integer, parameter :: rid_r0118 = 118 + integer, parameter :: rid_r0119 = 119 + integer, parameter :: rid_r0123 = 123 + integer, parameter :: rid_r0124 = 124 + integer, parameter :: rid_r0129 = 129 + integer, parameter :: rid_r0130 = 130 + integer, parameter :: rid_r0131 = 131 + integer, parameter :: rid_r0132 = 132 + integer, parameter :: rid_r0134 = 134 + integer, parameter :: rid_r0136 = 136 + integer, parameter :: rid_r0137 = 137 + integer, parameter :: rid_r0138 = 138 + integer, parameter :: rid_r0139 = 139 + integer, parameter :: rid_r0140 = 140 + integer, parameter :: rid_r0141 = 141 + integer, parameter :: rid_r0142 = 142 + integer, parameter :: rid_r0143 = 143 + integer, parameter :: rid_r0153 = 153 + integer, parameter :: rid_r0154 = 154 + integer, parameter :: rid_r0155 = 155 + integer, parameter :: rid_r0161 = 161 + integer, parameter :: rid_r0162 = 162 + integer, parameter :: rid_r0163 = 163 + integer, parameter :: rid_r0164 = 164 + integer, parameter :: rid_r0165 = 165 + integer, parameter :: rid_r0166 = 166 + integer, parameter :: rid_r0167 = 167 + integer, parameter :: rid_r0168 = 168 + integer, parameter :: rid_r0169 = 169 + integer, parameter :: rid_r0170 = 170 + integer, parameter :: rid_r0171 = 171 + integer, parameter :: rid_r0172 = 172 + integer, parameter :: rid_r0173 = 173 + integer, parameter :: rid_r0174 = 174 + integer, parameter :: rid_r0175 = 175 + integer, parameter :: rid_r0176 = 176 + integer, parameter :: rid_r0179 = 179 + integer, parameter :: rid_r0180 = 180 + integer, parameter :: rid_r0181 = 181 + integer, parameter :: rid_r0182 = 182 + integer, parameter :: rid_r0183 = 183 + integer, parameter :: rid_r0184 = 184 + integer, parameter :: rid_r0185 = 185 + integer, parameter :: rid_r0186 = 186 + integer, parameter :: rid_r0187 = 187 + integer, parameter :: rid_r0188 = 188 + integer, parameter :: rid_r0189 = 189 + integer, parameter :: rid_r0190 = 190 + integer, parameter :: rid_r0191 = 191 + integer, parameter :: rid_r0192 = 192 + integer, parameter :: rid_r0193 = 193 + integer, parameter :: rid_r0194 = 194 + integer, parameter :: rid_r0195 = 195 + integer, parameter :: rid_r0196 = 196 + integer, parameter :: rid_r0197 = 197 + integer, parameter :: rid_r0198 = 198 + integer, parameter :: rid_r0199 = 199 + integer, parameter :: rid_r0200 = 200 + integer, parameter :: rid_r0201 = 201 + integer, parameter :: rid_r0202 = 202 + integer, parameter :: rid_r0203 = 203 + integer, parameter :: rid_r0204 = 204 + integer, parameter :: rid_r0205 = 205 + integer, parameter :: rid_r0206 = 206 + integer, parameter :: rid_r0207 = 207 + integer, parameter :: rid_r0208 = 208 + integer, parameter :: rid_r0209 = 209 + integer, parameter :: rid_r0210 = 210 + integer, parameter :: rid_r0211 = 211 + integer, parameter :: rid_r0212 = 212 + integer, parameter :: rid_r0213 = 213 + integer, parameter :: rid_r0214 = 214 + integer, parameter :: rid_r0215 = 215 + integer, parameter :: rid_r0216 = 216 + integer, parameter :: rid_r0217 = 217 + integer, parameter :: rid_r0218 = 218 + integer, parameter :: rid_r0219 = 219 + integer, parameter :: rid_r0220 = 220 + integer, parameter :: rid_r0221 = 221 + integer, parameter :: rid_r0243 = 243 + integer, parameter :: rid_r0250 = 250 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 b/src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 new file mode 100644 index 0000000000..7184d1d777 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/m_spc_id.F90 @@ -0,0 +1,69 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O1D = 3 + integer, parameter :: id_O2 = 4 + integer, parameter :: id_O2_1S = 5 + integer, parameter :: id_O2_1D = 6 + integer, parameter :: id_N2O = 7 + integer, parameter :: id_N = 8 + integer, parameter :: id_NO = 9 + integer, parameter :: id_NO2 = 10 + integer, parameter :: id_NO3 = 11 + integer, parameter :: id_HNO3 = 12 + integer, parameter :: id_HO2NO2 = 13 + integer, parameter :: id_N2O5 = 14 + integer, parameter :: id_CH4 = 15 + integer, parameter :: id_CH3O2 = 16 + integer, parameter :: id_CH3OOH = 17 + integer, parameter :: id_CH2O = 18 + integer, parameter :: id_CO = 19 + integer, parameter :: id_H2 = 20 + integer, parameter :: id_H = 21 + integer, parameter :: id_OH = 22 + integer, parameter :: id_HO2 = 23 + integer, parameter :: id_H2O2 = 24 + integer, parameter :: id_CLY = 25 + integer, parameter :: id_BRY = 26 + integer, parameter :: id_CL = 27 + integer, parameter :: id_CL2 = 28 + integer, parameter :: id_CLO = 29 + integer, parameter :: id_OCLO = 30 + integer, parameter :: id_CL2O2 = 31 + integer, parameter :: id_HCL = 32 + integer, parameter :: id_HOCL = 33 + integer, parameter :: id_CLONO2 = 34 + integer, parameter :: id_BRCL = 35 + integer, parameter :: id_BR = 36 + integer, parameter :: id_BRO = 37 + integer, parameter :: id_HBR = 38 + integer, parameter :: id_HOBR = 39 + integer, parameter :: id_BRONO2 = 40 + integer, parameter :: id_CH3CL = 41 + integer, parameter :: id_CH3BR = 42 + integer, parameter :: id_CFC11 = 43 + integer, parameter :: id_CFC12 = 44 + integer, parameter :: id_CFC113 = 45 + integer, parameter :: id_HCFC22 = 46 + integer, parameter :: id_CCL4 = 47 + integer, parameter :: id_CH3CCL3 = 48 + integer, parameter :: id_CF3BR = 49 + integer, parameter :: id_CF2CLBR = 50 + integer, parameter :: id_CO2 = 51 + integer, parameter :: id_N2p = 52 + integer, parameter :: id_O2p = 53 + integer, parameter :: id_Np = 54 + integer, parameter :: id_Op = 55 + integer, parameter :: id_NOp = 56 + integer, parameter :: id_e = 57 + integer, parameter :: id_N2D = 58 + integer, parameter :: id_OCS = 59 + integer, parameter :: id_S = 60 + integer, parameter :: id_SO = 61 + integer, parameter :: id_SO2 = 62 + integer, parameter :: id_SO3 = 63 + integer, parameter :: id_HSO3 = 64 + integer, parameter :: id_H2SO4 = 65 + integer, parameter :: id_H2O = 66 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 new file mode 100644 index 0000000000..88641a5330 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 @@ -0,0 +1,195 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 80) = rate(:,:, 80) * inv(:,:, 1) + rate(:,:, 82) = rate(:,:, 82) * inv(:,:, 1) + rate(:,:, 85) = rate(:,:, 85) * inv(:,:, 2) + rate(:,:, 91) = rate(:,:, 91) * inv(:,:, 2) + rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 2) + rate(:,:,119) = rate(:,:,119) * inv(:,:, 1) + rate(:,:,123) = rate(:,:,123) * inv(:,:, 1) + rate(:,:,125) = rate(:,:,125) * inv(:,:, 1) + rate(:,:,126) = rate(:,:,126) * inv(:,:, 1) + rate(:,:,127) = rate(:,:,127) * inv(:,:, 1) + rate(:,:,133) = rate(:,:,133) * inv(:,:, 1) + rate(:,:,135) = rate(:,:,135) * inv(:,:, 1) + rate(:,:,143) = rate(:,:,143) * inv(:,:, 1) + rate(:,:,145) = rate(:,:,145) * inv(:,:, 1) + rate(:,:,154) = rate(:,:,154) * inv(:,:, 1) + rate(:,:,173) = rate(:,:,173) * inv(:,:, 1) + rate(:,:,177) = rate(:,:,177) * inv(:,:, 1) + rate(:,:,178) = rate(:,:,178) * inv(:,:, 1) + rate(:,:,194) = rate(:,:,194) * inv(:,:, 1) + rate(:,:,220) = rate(:,:,220) * inv(:,:, 1) + rate(:,:,241) = rate(:,:,241) * inv(:,:, 2) + rate(:,:,250) = rate(:,:,250) * inv(:,:, 2) + rate(:,:, 80) = rate(:,:, 80) * m(:,:) + rate(:,:, 81) = rate(:,:, 81) * m(:,:) + rate(:,:, 82) = rate(:,:, 82) * m(:,:) + rate(:,:, 83) = rate(:,:, 83) * m(:,:) + rate(:,:, 84) = rate(:,:, 84) * m(:,:) + rate(:,:, 86) = rate(:,:, 86) * m(:,:) + rate(:,:, 87) = rate(:,:, 87) * m(:,:) + rate(:,:, 89) = rate(:,:, 89) * m(:,:) + rate(:,:, 90) = rate(:,:, 90) * m(:,:) + rate(:,:, 94) = rate(:,:, 94) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 96) = rate(:,:, 96) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:,100) = rate(:,:,100) * m(:,:) + rate(:,:,101) = rate(:,:,101) * m(:,:) + rate(:,:,102) = rate(:,:,102) * m(:,:) + rate(:,:,103) = rate(:,:,103) * m(:,:) + rate(:,:,104) = rate(:,:,104) * m(:,:) + rate(:,:,105) = rate(:,:,105) * m(:,:) + rate(:,:,106) = rate(:,:,106) * m(:,:) + rate(:,:,107) = rate(:,:,107) * m(:,:) + rate(:,:,108) = rate(:,:,108) * m(:,:) + rate(:,:,109) = rate(:,:,109) * m(:,:) + rate(:,:,110) = rate(:,:,110) * m(:,:) + rate(:,:,111) = rate(:,:,111) * m(:,:) + rate(:,:,112) = rate(:,:,112) * m(:,:) + rate(:,:,113) = rate(:,:,113) * m(:,:) + rate(:,:,114) = rate(:,:,114) * m(:,:) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,116) = rate(:,:,116) * m(:,:) + rate(:,:,117) = rate(:,:,117) * m(:,:) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,123) = rate(:,:,123) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_exp_sol.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_imp_sol.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_indprd.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_indprd.F90 new file mode 100644 index 0000000000..e3719dd93d --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_indprd.F90 @@ -0,0 +1,111 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) =rxt(:,:,118)*y(:,:,10)*y(:,:,8) + prod(:,:,3) = (rxt(:,:,17) +rxt(:,:,18) +rxt(:,:,140)*y(:,:,11) + & + rxt(:,:,141)*y(:,:,22) +rxt(:,:,142)*y(:,:,2) + & + rxt(:,:,166)*y(:,:,27) +rxt(:,:,189)*y(:,:,36))*y(:,:,18) & + + (rxt(:,:,52) +rxt(:,:,208)*y(:,:,2) +rxt(:,:,209)*y(:,:,22)) & + *y(:,:,59) + extfrc(:,:,3) + prod(:,:,4) =rxt(:,:,18)*y(:,:,18) +rxt(:,:,148)*y(:,:,23)*y(:,:,21) & + +rxt(:,:,20)*y(:,:,66) + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,42) = 0._r8 + prod(:,:,39) = (rxt(:,:,46) +rxt(:,:,79))*y(:,:,51) +.180_r8*rxt(:,:,48) & + *y(:,:,15) + prod(:,:,45) =rxt(:,:,5)*y(:,:,7) + prod(:,:,49) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,27) = (rxt(:,:,63) +.800_r8*rxt(:,:,66) +rxt(:,:,75) + & + .800_r8*rxt(:,:,78)) + extfrc(:,:,10) + prod(:,:,38) = + extfrc(:,:,1) + prod(:,:,40) = + extfrc(:,:,2) + prod(:,:,43) =.660_r8*rxt(:,:,48)*y(:,:,15) + extfrc(:,:,12) + prod(:,:,33) = 0._r8 + prod(:,:,22) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,28) =rxt(:,:,47)*y(:,:,15) +rxt(:,:,36)*y(:,:,41) +rxt(:,:,43) & + *y(:,:,42) + prod(:,:,11) = 0._r8 + prod(:,:,46) =.180_r8*rxt(:,:,48)*y(:,:,15) + prod(:,:,32) =rxt(:,:,47)*y(:,:,15) + prod(:,:,47) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,44) =.050_r8*rxt(:,:,48)*y(:,:,15) + prod(:,:,48) =rxt(:,:,36)*y(:,:,41) +3.000_r8*rxt(:,:,39)*y(:,:,43) & + +2.000_r8*rxt(:,:,40)*y(:,:,44) +3.000_r8*rxt(:,:,41)*y(:,:,45) & + +rxt(:,:,42)*y(:,:,46) +4.000_r8*rxt(:,:,37)*y(:,:,47) & + +3.000_r8*rxt(:,:,38)*y(:,:,48) +rxt(:,:,45)*y(:,:,50) + prod(:,:,5) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,35) =rxt(:,:,43)*y(:,:,42) +rxt(:,:,44)*y(:,:,49) +rxt(:,:,45) & + *y(:,:,50) + prod(:,:,41) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,19) = (rxt(:,:,59) +rxt(:,:,71)) + extfrc(:,:,8) + prod(:,:,24) = + extfrc(:,:,6) + prod(:,:,14) = (rxt(:,:,63) +rxt(:,:,64) +rxt(:,:,75) +rxt(:,:,76)) & + + extfrc(:,:,7) + prod(:,:,15) = + extfrc(:,:,5) + prod(:,:,25) = 0._r8 + prod(:,:,16) = (rxt(:,:,64) +1.200_r8*rxt(:,:,66) +rxt(:,:,76) + & + 1.200_r8*rxt(:,:,78)) + extfrc(:,:,9) + prod(:,:,26) = (rxt(:,:,59) +rxt(:,:,63) +rxt(:,:,64) +rxt(:,:,71) + & + rxt(:,:,75) +rxt(:,:,76)) + extfrc(:,:,11) + prod(:,:,10) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,31) = + extfrc(:,:,4) + prod(:,:,7) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,4) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_lin_matrix.F90 new file mode 100644 index 0000000000..a9ad7ea3b9 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_lin_matrix.F90 @@ -0,0 +1,208 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(419) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(347) = -( rxt(54) + rxt(55) + rxt(56) + rxt(67) + rxt(68) + rxt(69) & + + het_rates(2) ) + mat(578) = rxt(1) + 2.000_r8*rxt(2) + rxt(60) + rxt(61) + rxt(62) & + + 2.000_r8*rxt(65) + rxt(72) + rxt(73) + rxt(74) + 2.000_r8*rxt(77) + mat(416) = rxt(4) + mat(309) = rxt(6) + mat(372) = rxt(8) + mat(26) = rxt(10) + mat(217) = rxt(12) + mat(465) = rxt(21) + mat(288) = rxt(24) + mat(32) = rxt(25) + mat(395) = rxt(32) + mat(201) = rxt(50) + mat(20) = rxt(51) + mat(232) = rxt(53) + mat(484) = rxt(93) + mat(490) = -( rxt(93) + rxt(97)*y(7) + rxt(98)*y(7) + rxt(100)*y(43) & + + rxt(101)*y(44) + rxt(102)*y(45) + rxt(103)*y(46) + rxt(104)*y(47) & + + rxt(105)*y(42) + rxt(106)*y(50) + rxt(107)*y(49) + rxt(108)*y(15) & + + rxt(109)*y(15) + rxt(110)*y(15) + rxt(111)*y(20) + het_rates(3) ) + mat(584) = rxt(1) + mat(422) = rxt(3) + mat(471) = rxt(20) + mat(588) = -( rxt(1) + rxt(2) + rxt(58) + rxt(60) + rxt(61) + rxt(62) + rxt(65) & + + rxt(70) + rxt(72) + rxt(73) + rxt(74) + rxt(77) + het_rates(4) ) + mat(426) = rxt(4) + mat(223) = rxt(13) + mat(8) = rxt(88) + mat(5) = rxt(91) + rxt(92) + mat(494) = rxt(98)*y(7) + mat(7) = -( rxt(85) + rxt(88) + rxt(87)*y(51) + het_rates(5) ) + mat(4) = -( rxt(91) + rxt(92) + het_rates(6) ) + mat(406) = rxt(3) + mat(6) = rxt(85) + rxt(87)*y(51) + mat(162) = -( rxt(57) + het_rates(8) ) + mat(302) = rxt(6) + mat(70) = rxt(241) + mat(308) = -( rxt(6) + rxt(7) + het_rates(9) ) + mat(371) = rxt(8) + mat(25) = rxt(10) + mat(216) = rxt(13) + mat(135) = rxt(250) + mat(483) = 2.000_r8*rxt(97)*y(7) + mat(373) = -( rxt(8) + het_rates(10) ) + mat(27) = rxt(9) + rxt(126) + mat(119) = rxt(11) + mat(218) = rxt(12) + mat(55) = rxt(15) + rxt(135) + mat(194) = rxt(30) + mat(84) = rxt(35) + mat(450) = -( rxt(136)*y(15) + rxt(143)*y(19) + rxt(144)*y(19) + rxt(155)*y(20) & + + rxt(204)*y(41) + rxt(205)*y(48) + rxt(206)*y(46) + rxt(207)*y(42) & + + het_rates(22) ) + mat(120) = rxt(11) + mat(56) = rxt(14) + mat(43) = rxt(16) + mat(469) = rxt(19) + mat(89) = 2.000_r8*rxt(22) + mat(183) = rxt(27) + mat(128) = rxt(33) + mat(488) = rxt(108)*y(15) + rxt(111)*y(20) + mat(215) = -( rxt(12) + rxt(13) + het_rates(11) ) + mat(24) = rxt(9) + rxt(10) + rxt(126) + mat(54) = rxt(14) + mat(190) = rxt(29) + mat(81) = rxt(34) + mat(117) = -( rxt(11) + het_rates(12) ) + mat(23) = 2.000_r8*rxt(223) + 2.000_r8*rxt(229) + 2.000_r8*rxt(234) + mat(187) = rxt(224) + rxt(230) + rxt(235) + mat(79) = rxt(225) + rxt(233) + rxt(236) + mat(53) = -( rxt(14) + rxt(15) + rxt(135) + het_rates(13) ) + mat(22) = -( rxt(9) + rxt(10) + rxt(126) + rxt(223) + rxt(229) + rxt(234) & + + het_rates(14) ) + mat(169) = -( het_rates(16) ) + mat(478) = rxt(108)*y(15) + mat(435) = rxt(136)*y(15) + mat(540) = rxt(167)*y(15) + mat(40) = -( rxt(16) + het_rates(17) ) + mat(510) = -( rxt(17) + rxt(18) + het_rates(18) ) + mat(45) = rxt(16) + mat(491) = rxt(109)*y(15) + rxt(110)*y(15) + mat(206) = -( het_rates(21) ) + mat(42) = rxt(16) + mat(497) = 2.000_r8*rxt(17) + mat(460) = rxt(19) + 2.000_r8*rxt(21) + mat(258) = rxt(28) + mat(479) = rxt(109)*y(15) + rxt(111)*y(20) + mat(439) = rxt(144)*y(19) + rxt(155)*y(20) + mat(543) = rxt(162)*y(20) + mat(535) = -( het_rates(23) ) + mat(58) = rxt(15) + rxt(135) + mat(492) = rxt(109)*y(15) + mat(454) = rxt(143)*y(19) + rxt(204)*y(41) + rxt(207)*y(42) + mat(556) = rxt(203)*y(41) + mat(86) = -( rxt(22) + het_rates(24) ) + mat(470) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(66) ) + mat(11) = rxt(49) + mat(451) = rxt(136)*y(15) + rxt(155)*y(20) + rxt(204)*y(41) + rxt(205)*y(48) & + + rxt(206)*y(46) + rxt(207)*y(42) + mat(557) = -( rxt(162)*y(20) + rxt(167)*y(15) + rxt(203)*y(41) + het_rates(27) ) + mat(13) = 2.000_r8*rxt(23) + mat(297) = rxt(24) + mat(3) = 2.000_r8*rxt(26) + mat(185) = rxt(27) + mat(273) = rxt(28) + mat(197) = rxt(29) + mat(16) = rxt(31) + mat(493) = 3.000_r8*rxt(100)*y(43) + 2.000_r8*rxt(101)*y(44) & + + 3.000_r8*rxt(102)*y(45) + rxt(103)*y(46) + 4.000_r8*rxt(104)*y(47) + mat(455) = rxt(204)*y(41) + 3.000_r8*rxt(205)*y(48) + rxt(206)*y(46) + mat(12) = -( rxt(23) + het_rates(28) ) + mat(286) = -( rxt(24) + het_rates(29) ) + mat(31) = rxt(25) + mat(192) = rxt(30) + mat(2) = 2.000_r8*rxt(178) + mat(28) = -( rxt(25) + het_rates(30) ) + mat(1) = -( rxt(26) + rxt(178) + het_rates(31) ) + mat(261) = -( rxt(28) + het_rates(32) ) + mat(545) = rxt(162)*y(20) + rxt(167)*y(15) + 2.000_r8*rxt(203)*y(41) + mat(179) = -( rxt(27) + het_rates(33) ) + mat(188) = rxt(224) + rxt(230) + rxt(235) + mat(189) = -( rxt(29) + rxt(30) + rxt(224) + rxt(230) + rxt(235) + het_rates(34) & + ) + mat(14) = -( rxt(31) + het_rates(35) ) + mat(242) = -( het_rates(36) ) + mat(15) = rxt(31) + mat(391) = rxt(32) + mat(124) = rxt(33) + mat(82) = rxt(34) + mat(480) = rxt(105)*y(42) + rxt(106)*y(50) + rxt(107)*y(49) + mat(442) = rxt(207)*y(42) + mat(397) = -( rxt(32) + het_rates(37) ) + mat(85) = rxt(35) + mat(104) = -( het_rates(38) ) + mat(123) = -( rxt(33) + het_rates(39) ) + mat(80) = rxt(225) + rxt(233) + rxt(236) + mat(78) = -( rxt(34) + rxt(35) + rxt(225) + rxt(233) + rxt(236) + het_rates(40) & + ) + mat(95) = -( het_rates(52) ) + mat(131) = -( rxt(250) + het_rates(53) ) + mat(568) = rxt(58) + rxt(70) + mat(68) = rxt(243)*y(51) + mat(60) = -( het_rates(54) ) + mat(157) = rxt(57) + mat(67) = -( rxt(241) + rxt(243)*y(51) + het_rates(55) ) + mat(324) = rxt(54) + rxt(55) + rxt(56) + rxt(67) + rxt(68) + rxt(69) + mat(564) = rxt(60) + rxt(61) + rxt(62) + rxt(72) + rxt(73) + rxt(74) + mat(140) = -( het_rates(56) ) + mat(300) = rxt(7) + mat(69) = rxt(241) + mat(132) = rxt(250) + mat(73) = -( het_rates(58) ) + mat(151) = -( het_rates(57) ) + mat(301) = rxt(7) + mat(335) = rxt(54) + rxt(55) + rxt(56) + rxt(67) + rxt(68) + rxt(69) + mat(161) = rxt(57) + mat(570) = rxt(58) + rxt(60) + rxt(61) + rxt(62) + rxt(70) + rxt(72) + rxt(73) & + + rxt(74) + mat(33) = -( rxt(52) + het_rates(59) ) + mat(110) = -( het_rates(60) ) + mat(34) = rxt(52) + mat(225) = rxt(53) + mat(228) = -( rxt(53) + het_rates(61) ) + mat(200) = rxt(50) + mat(199) = -( rxt(50) + het_rates(62) ) + mat(19) = rxt(51) + mat(18) = -( rxt(51) + het_rates(63) ) + mat(10) = rxt(49) + mat(47) = -( het_rates(64) ) + mat(9) = -( rxt(49) + het_rates(65) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_lu_factor.F90 new file mode 100644 index 0000000000..6afa24eebf --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_lu_factor.F90 @@ -0,0 +1,2213 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = lu(3) * lu(1) + lu(286) = lu(286) - lu(2) * lu(275) + lu(297) = lu(297) - lu(3) * lu(275) + lu(4) = 1._r8 / lu(4) + lu(5) = lu(5) * lu(4) + lu(8) = lu(8) - lu(5) * lu(6) + lu(357) = lu(357) - lu(5) * lu(320) + lu(426) = lu(426) - lu(5) * lu(406) + lu(588) = lu(588) - lu(5) * lu(559) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(357) = lu(357) - lu(8) * lu(321) + lu(426) = lu(426) - lu(8) * lu(407) + lu(494) = lu(494) - lu(8) * lu(476) + lu(588) = lu(588) - lu(8) * lu(560) + lu(9) = 1._r8 / lu(9) + lu(10) = lu(10) * lu(9) + lu(11) = lu(11) * lu(9) + lu(18) = lu(18) - lu(10) * lu(17) + lu(21) = lu(21) - lu(11) * lu(17) + lu(458) = lu(458) - lu(10) * lu(457) + lu(470) = lu(470) - lu(11) * lu(457) + lu(12) = 1._r8 / lu(12) + lu(13) = lu(13) * lu(12) + lu(185) = lu(185) - lu(13) * lu(178) + lu(197) = lu(197) - lu(13) * lu(186) + lu(273) = lu(273) - lu(13) * lu(252) + lu(297) = lu(297) - lu(13) * lu(276) + lu(557) = lu(557) - lu(13) * lu(538) + lu(14) = 1._r8 / lu(14) + lu(15) = lu(15) * lu(14) + lu(16) = lu(16) * lu(14) + lu(124) = lu(124) - lu(15) * lu(122) + lu(130) = - lu(16) * lu(122) + lu(260) = - lu(15) * lu(253) + lu(273) = lu(273) - lu(16) * lu(253) + lu(284) = lu(284) - lu(15) * lu(277) + lu(297) = lu(297) - lu(16) * lu(277) + lu(391) = lu(391) - lu(15) * lu(383) + lu(404) = lu(404) - lu(16) * lu(383) + lu(18) = 1._r8 / lu(18) + lu(19) = lu(19) * lu(18) + lu(20) = lu(20) * lu(18) + lu(21) = lu(21) * lu(18) + lu(48) = - lu(19) * lu(46) + lu(49) = - lu(20) * lu(46) + lu(50) = - lu(21) * lu(46) + lu(459) = - lu(19) * lu(458) + lu(465) = lu(465) - lu(20) * lu(458) + lu(470) = lu(470) - lu(21) * lu(458) + lu(572) = lu(572) - lu(19) * lu(561) + lu(578) = lu(578) - lu(20) * lu(561) + lu(583) = - lu(21) * lu(561) + lu(22) = 1._r8 / lu(22) + lu(23) = lu(23) * lu(22) + lu(24) = lu(24) * lu(22) + lu(25) = lu(25) * lu(22) + lu(26) = lu(26) * lu(22) + lu(27) = lu(27) * lu(22) + lu(214) = lu(214) - lu(23) * lu(213) + lu(215) = lu(215) - lu(24) * lu(213) + lu(216) = lu(216) - lu(25) * lu(213) + lu(217) = lu(217) - lu(26) * lu(213) + lu(218) = lu(218) - lu(27) * lu(213) + lu(361) = lu(361) - lu(23) * lu(358) + lu(366) = lu(366) - lu(24) * lu(358) + lu(371) = lu(371) - lu(25) * lu(358) + lu(372) = lu(372) - lu(26) * lu(358) + lu(373) = lu(373) - lu(27) * lu(358) + lu(28) = 1._r8 / lu(28) + lu(29) = lu(29) * lu(28) + lu(30) = lu(30) * lu(28) + lu(31) = lu(31) * lu(28) + lu(32) = lu(32) * lu(28) + lu(226) = lu(226) - lu(29) * lu(224) + lu(228) = lu(228) - lu(30) * lu(224) + lu(230) = lu(230) - lu(31) * lu(224) + lu(232) = lu(232) - lu(32) * lu(224) + lu(281) = lu(281) - lu(29) * lu(278) + lu(283) = lu(283) - lu(30) * lu(278) + lu(286) = lu(286) - lu(31) * lu(278) + lu(288) = lu(288) - lu(32) * lu(278) + lu(388) = lu(388) - lu(29) * lu(384) + lu(390) = lu(390) - lu(30) * lu(384) + lu(393) = lu(393) - lu(31) * lu(384) + lu(395) = lu(395) - lu(32) * lu(384) + lu(33) = 1._r8 / lu(33) + lu(34) = lu(34) * lu(33) + lu(35) = lu(35) * lu(33) + lu(36) = lu(36) * lu(33) + lu(37) = lu(37) * lu(33) + lu(38) = lu(38) * lu(33) + lu(39) = lu(39) * lu(33) + lu(330) = - lu(34) * lu(322) + lu(339) = - lu(35) * lu(322) + lu(340) = lu(340) - lu(36) * lu(322) + lu(342) = lu(342) - lu(37) * lu(322) + lu(347) = lu(347) - lu(38) * lu(322) + lu(351) = lu(351) - lu(39) * lu(322) + lu(433) = lu(433) - lu(34) * lu(427) + lu(438) = lu(438) - lu(35) * lu(427) + lu(439) = lu(439) - lu(36) * lu(427) + lu(441) = lu(441) - lu(37) * lu(427) + lu(446) = lu(446) - lu(38) * lu(427) + lu(450) = lu(450) - lu(39) * lu(427) + lu(40) = 1._r8 / lu(40) + lu(41) = lu(41) * lu(40) + lu(42) = lu(42) * lu(40) + lu(43) = lu(43) * lu(40) + lu(44) = lu(44) * lu(40) + lu(45) = lu(45) * lu(40) + lu(169) = lu(169) - lu(41) * lu(168) + lu(170) = - lu(42) * lu(168) + lu(173) = - lu(43) * lu(168) + lu(174) = - lu(44) * lu(168) + lu(175) = lu(175) - lu(45) * lu(168) + lu(435) = lu(435) - lu(41) * lu(428) + lu(439) = lu(439) - lu(42) * lu(428) + lu(450) = lu(450) - lu(43) * lu(428) + lu(451) = lu(451) - lu(44) * lu(428) + lu(453) = lu(453) - lu(45) * lu(428) + lu(519) = lu(519) - lu(41) * lu(514) + lu(521) = lu(521) - lu(42) * lu(514) + lu(531) = lu(531) - lu(43) * lu(514) + lu(532) = lu(532) - lu(44) * lu(514) + lu(534) = - lu(45) * lu(514) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(47) = 1._r8 / lu(47) + lu(48) = lu(48) * lu(47) + lu(49) = lu(49) * lu(47) + lu(50) = lu(50) * lu(47) + lu(51) = lu(51) * lu(47) + lu(52) = lu(52) * lu(47) + lu(199) = lu(199) - lu(48) * lu(198) + lu(201) = lu(201) - lu(49) * lu(198) + lu(203) = - lu(50) * lu(198) + lu(204) = - lu(51) * lu(198) + lu(205) = - lu(52) * lu(198) + lu(438) = lu(438) - lu(48) * lu(429) + lu(446) = lu(446) - lu(49) * lu(429) + lu(451) = lu(451) - lu(50) * lu(429) + lu(454) = lu(454) - lu(51) * lu(429) + lu(456) = lu(456) - lu(52) * lu(429) + lu(572) = lu(572) - lu(48) * lu(562) + lu(578) = lu(578) - lu(49) * lu(562) + lu(583) = lu(583) - lu(50) * lu(562) + lu(586) = lu(586) - lu(51) * lu(562) + lu(588) = lu(588) - lu(52) * lu(562) + lu(53) = 1._r8 / lu(53) + lu(54) = lu(54) * lu(53) + lu(55) = lu(55) * lu(53) + lu(56) = lu(56) * lu(53) + lu(57) = lu(57) * lu(53) + lu(58) = lu(58) * lu(53) + lu(59) = lu(59) * lu(53) + lu(366) = lu(366) - lu(54) * lu(359) + lu(373) = lu(373) - lu(55) * lu(359) + lu(376) = lu(376) - lu(56) * lu(359) + lu(377) = - lu(57) * lu(359) + lu(380) = lu(380) - lu(58) * lu(359) + lu(382) = lu(382) - lu(59) * lu(359) + lu(440) = lu(440) - lu(54) * lu(430) + lu(447) = lu(447) - lu(55) * lu(430) + lu(450) = lu(450) - lu(56) * lu(430) + lu(451) = lu(451) - lu(57) * lu(430) + lu(454) = lu(454) - lu(58) * lu(430) + lu(456) = lu(456) - lu(59) * lu(430) + lu(522) = lu(522) - lu(54) * lu(515) + lu(528) = lu(528) - lu(55) * lu(515) + lu(531) = lu(531) - lu(56) * lu(515) + lu(532) = lu(532) - lu(57) * lu(515) + lu(535) = lu(535) - lu(58) * lu(515) + lu(537) = lu(537) - lu(59) * lu(515) + lu(60) = 1._r8 / lu(60) + lu(61) = lu(61) * lu(60) + lu(62) = lu(62) * lu(60) + lu(63) = lu(63) * lu(60) + lu(64) = lu(64) * lu(60) + lu(65) = lu(65) * lu(60) + lu(66) = lu(66) * lu(60) + lu(158) = - lu(61) * lu(157) + lu(159) = lu(159) - lu(62) * lu(157) + lu(160) = lu(160) - lu(63) * lu(157) + lu(162) = lu(162) - lu(64) * lu(157) + lu(164) = lu(164) - lu(65) * lu(157) + lu(167) = lu(167) - lu(66) * lu(157) + lu(324) = lu(324) - lu(61) * lu(323) + lu(333) = - lu(62) * lu(323) + lu(334) = lu(334) - lu(63) * lu(323) + lu(336) = lu(336) - lu(64) * lu(323) + lu(347) = lu(347) - lu(65) * lu(323) + lu(357) = lu(357) - lu(66) * lu(323) + lu(564) = lu(564) - lu(61) * lu(563) + lu(568) = lu(568) - lu(62) * lu(563) + lu(569) = lu(569) - lu(63) * lu(563) + lu(571) = lu(571) - lu(64) * lu(563) + lu(578) = lu(578) - lu(65) * lu(563) + lu(588) = lu(588) - lu(66) * lu(563) + lu(67) = 1._r8 / lu(67) + lu(68) = lu(68) * lu(67) + lu(69) = lu(69) * lu(67) + lu(70) = lu(70) * lu(67) + lu(71) = lu(71) * lu(67) + lu(72) = lu(72) * lu(67) + lu(96) = lu(96) - lu(68) * lu(93) + lu(97) = lu(97) - lu(69) * lu(93) + lu(99) = lu(99) - lu(70) * lu(93) + lu(101) = lu(101) - lu(71) * lu(93) + lu(103) = lu(103) - lu(72) * lu(93) + lu(159) = lu(159) - lu(68) * lu(158) + lu(160) = lu(160) - lu(69) * lu(158) + lu(162) = lu(162) - lu(70) * lu(158) + lu(164) = lu(164) - lu(71) * lu(158) + lu(167) = lu(167) - lu(72) * lu(158) + lu(333) = lu(333) - lu(68) * lu(324) + lu(334) = lu(334) - lu(69) * lu(324) + lu(336) = lu(336) - lu(70) * lu(324) + lu(347) = lu(347) - lu(71) * lu(324) + lu(357) = lu(357) - lu(72) * lu(324) + lu(568) = lu(568) - lu(68) * lu(564) + lu(569) = lu(569) - lu(69) * lu(564) + lu(571) = lu(571) - lu(70) * lu(564) + lu(578) = lu(578) - lu(71) * lu(564) + lu(588) = lu(588) - lu(72) * lu(564) + lu(73) = 1._r8 / lu(73) + lu(74) = lu(74) * lu(73) + lu(75) = lu(75) * lu(73) + lu(76) = lu(76) * lu(73) + lu(77) = lu(77) * lu(73) + lu(99) = lu(99) - lu(74) * lu(94) + lu(100) = - lu(75) * lu(94) + lu(102) = - lu(76) * lu(94) + lu(103) = lu(103) - lu(77) * lu(94) + lu(142) = lu(142) - lu(74) * lu(139) + lu(143) = - lu(75) * lu(139) + lu(145) = - lu(76) * lu(139) + lu(146) = - lu(77) * lu(139) + lu(152) = lu(152) - lu(74) * lu(147) + lu(153) = - lu(75) * lu(147) + lu(155) = lu(155) - lu(76) * lu(147) + lu(156) = - lu(77) * lu(147) + lu(336) = lu(336) - lu(74) * lu(325) + lu(346) = lu(346) - lu(75) * lu(325) + lu(353) = - lu(76) * lu(325) + lu(357) = lu(357) - lu(77) * lu(325) + lu(571) = lu(571) - lu(74) * lu(565) + lu(577) = lu(577) - lu(75) * lu(565) + lu(584) = lu(584) - lu(76) * lu(565) + lu(588) = lu(588) - lu(77) * lu(565) + lu(78) = 1._r8 / lu(78) + lu(79) = lu(79) * lu(78) + lu(80) = lu(80) * lu(78) + lu(81) = lu(81) * lu(78) + lu(82) = lu(82) * lu(78) + lu(83) = lu(83) * lu(78) + lu(84) = lu(84) * lu(78) + lu(85) = lu(85) * lu(78) + lu(331) = - lu(79) * lu(326) + lu(332) = lu(332) - lu(80) * lu(326) + lu(341) = lu(341) - lu(81) * lu(326) + lu(343) = lu(343) - lu(82) * lu(326) + lu(347) = lu(347) - lu(83) * lu(326) + lu(348) = lu(348) - lu(84) * lu(326) + lu(349) = lu(349) - lu(85) * lu(326) + lu(361) = lu(361) - lu(79) * lu(360) + lu(362) = - lu(80) * lu(360) + lu(366) = lu(366) - lu(81) * lu(360) + lu(368) = - lu(82) * lu(360) + lu(372) = lu(372) - lu(83) * lu(360) + lu(373) = lu(373) - lu(84) * lu(360) + lu(374) = lu(374) - lu(85) * lu(360) + lu(386) = - lu(79) * lu(385) + lu(387) = lu(387) - lu(80) * lu(385) + lu(389) = - lu(81) * lu(385) + lu(391) = lu(391) - lu(82) * lu(385) + lu(395) = lu(395) - lu(83) * lu(385) + lu(396) = lu(396) - lu(84) * lu(385) + lu(397) = lu(397) - lu(85) * lu(385) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(86) = 1._r8 / lu(86) + lu(87) = lu(87) * lu(86) + lu(88) = lu(88) * lu(86) + lu(89) = lu(89) * lu(86) + lu(90) = lu(90) * lu(86) + lu(91) = lu(91) * lu(86) + lu(92) = lu(92) * lu(86) + lu(344) = lu(344) - lu(87) * lu(327) + lu(347) = lu(347) - lu(88) * lu(327) + lu(351) = lu(351) - lu(89) * lu(327) + lu(352) = - lu(90) * lu(327) + lu(355) = lu(355) - lu(91) * lu(327) + lu(356) = lu(356) - lu(92) * lu(327) + lu(443) = lu(443) - lu(87) * lu(431) + lu(446) = lu(446) - lu(88) * lu(431) + lu(450) = lu(450) - lu(89) * lu(431) + lu(451) = lu(451) - lu(90) * lu(431) + lu(454) = lu(454) - lu(91) * lu(431) + lu(455) = lu(455) - lu(92) * lu(431) + lu(524) = lu(524) - lu(87) * lu(516) + lu(527) = lu(527) - lu(88) * lu(516) + lu(531) = lu(531) - lu(89) * lu(516) + lu(532) = lu(532) - lu(90) * lu(516) + lu(535) = lu(535) - lu(91) * lu(516) + lu(536) = lu(536) - lu(92) * lu(516) + lu(545) = lu(545) - lu(87) * lu(539) + lu(548) = - lu(88) * lu(539) + lu(552) = lu(552) - lu(89) * lu(539) + lu(553) = - lu(90) * lu(539) + lu(556) = lu(556) - lu(91) * lu(539) + lu(557) = lu(557) - lu(92) * lu(539) + lu(95) = 1._r8 / lu(95) + lu(96) = lu(96) * lu(95) + lu(97) = lu(97) * lu(95) + lu(98) = lu(98) * lu(95) + lu(99) = lu(99) * lu(95) + lu(100) = lu(100) * lu(95) + lu(101) = lu(101) * lu(95) + lu(102) = lu(102) * lu(95) + lu(103) = lu(103) * lu(95) + lu(149) = lu(149) - lu(96) * lu(148) + lu(150) = lu(150) - lu(97) * lu(148) + lu(151) = lu(151) - lu(98) * lu(148) + lu(152) = lu(152) - lu(99) * lu(148) + lu(153) = lu(153) - lu(100) * lu(148) + lu(154) = lu(154) - lu(101) * lu(148) + lu(155) = lu(155) - lu(102) * lu(148) + lu(156) = lu(156) - lu(103) * lu(148) + lu(333) = lu(333) - lu(96) * lu(328) + lu(334) = lu(334) - lu(97) * lu(328) + lu(335) = lu(335) - lu(98) * lu(328) + lu(336) = lu(336) - lu(99) * lu(328) + lu(346) = lu(346) - lu(100) * lu(328) + lu(347) = lu(347) - lu(101) * lu(328) + lu(353) = lu(353) - lu(102) * lu(328) + lu(357) = lu(357) - lu(103) * lu(328) + lu(568) = lu(568) - lu(96) * lu(566) + lu(569) = lu(569) - lu(97) * lu(566) + lu(570) = lu(570) - lu(98) * lu(566) + lu(571) = lu(571) - lu(99) * lu(566) + lu(577) = lu(577) - lu(100) * lu(566) + lu(578) = lu(578) - lu(101) * lu(566) + lu(584) = lu(584) - lu(102) * lu(566) + lu(588) = lu(588) - lu(103) * lu(566) + lu(104) = 1._r8 / lu(104) + lu(105) = lu(105) * lu(104) + lu(106) = lu(106) * lu(104) + lu(107) = lu(107) * lu(104) + lu(108) = lu(108) * lu(104) + lu(109) = lu(109) * lu(104) + lu(242) = lu(242) - lu(105) * lu(241) + lu(243) = - lu(106) * lu(241) + lu(246) = - lu(107) * lu(241) + lu(247) = - lu(108) * lu(241) + lu(248) = - lu(109) * lu(241) + lu(343) = lu(343) - lu(105) * lu(329) + lu(347) = lu(347) - lu(106) * lu(329) + lu(351) = lu(351) - lu(107) * lu(329) + lu(352) = lu(352) - lu(108) * lu(329) + lu(353) = lu(353) - lu(109) * lu(329) + lu(442) = lu(442) - lu(105) * lu(432) + lu(446) = lu(446) - lu(106) * lu(432) + lu(450) = lu(450) - lu(107) * lu(432) + lu(451) = lu(451) - lu(108) * lu(432) + lu(452) = - lu(109) * lu(432) + lu(480) = lu(480) - lu(105) * lu(477) + lu(484) = lu(484) - lu(106) * lu(477) + lu(488) = lu(488) - lu(107) * lu(477) + lu(489) = lu(489) - lu(108) * lu(477) + lu(490) = lu(490) - lu(109) * lu(477) + lu(499) = lu(499) - lu(105) * lu(495) + lu(503) = lu(503) - lu(106) * lu(495) + lu(507) = lu(507) - lu(107) * lu(495) + lu(508) = lu(508) - lu(108) * lu(495) + lu(509) = - lu(109) * lu(495) + lu(523) = lu(523) - lu(105) * lu(517) + lu(527) = lu(527) - lu(106) * lu(517) + lu(531) = lu(531) - lu(107) * lu(517) + lu(532) = lu(532) - lu(108) * lu(517) + lu(533) = - lu(109) * lu(517) + lu(110) = 1._r8 / lu(110) + lu(111) = lu(111) * lu(110) + lu(112) = lu(112) * lu(110) + lu(113) = lu(113) * lu(110) + lu(114) = lu(114) * lu(110) + lu(115) = lu(115) * lu(110) + lu(116) = lu(116) * lu(110) + lu(227) = lu(227) - lu(111) * lu(225) + lu(228) = lu(228) - lu(112) * lu(225) + lu(232) = lu(232) - lu(113) * lu(225) + lu(235) = lu(235) - lu(114) * lu(225) + lu(236) = lu(236) - lu(115) * lu(225) + lu(240) = lu(240) - lu(116) * lu(225) + lu(340) = lu(340) - lu(111) * lu(330) + lu(342) = lu(342) - lu(112) * lu(330) + lu(347) = lu(347) - lu(113) * lu(330) + lu(350) = lu(350) - lu(114) * lu(330) + lu(351) = lu(351) - lu(115) * lu(330) + lu(357) = lu(357) - lu(116) * lu(330) + lu(410) = lu(410) - lu(111) * lu(408) + lu(412) = lu(412) - lu(112) * lu(408) + lu(416) = lu(416) - lu(113) * lu(408) + lu(419) = lu(419) - lu(114) * lu(408) + lu(420) = lu(420) - lu(115) * lu(408) + lu(426) = lu(426) - lu(116) * lu(408) + lu(439) = lu(439) - lu(111) * lu(433) + lu(441) = lu(441) - lu(112) * lu(433) + lu(446) = lu(446) - lu(113) * lu(433) + lu(449) = lu(449) - lu(114) * lu(433) + lu(450) = lu(450) - lu(115) * lu(433) + lu(456) = lu(456) - lu(116) * lu(433) + lu(573) = lu(573) - lu(111) * lu(567) + lu(574) = lu(574) - lu(112) * lu(567) + lu(578) = lu(578) - lu(113) * lu(567) + lu(581) = lu(581) - lu(114) * lu(567) + lu(582) = - lu(115) * lu(567) + lu(588) = lu(588) - lu(116) * lu(567) + lu(117) = 1._r8 / lu(117) + lu(118) = lu(118) * lu(117) + lu(119) = lu(119) * lu(117) + lu(120) = lu(120) * lu(117) + lu(121) = lu(121) * lu(117) + lu(190) = lu(190) - lu(118) * lu(187) + lu(194) = lu(194) - lu(119) * lu(187) + lu(195) = lu(195) - lu(120) * lu(187) + lu(196) = - lu(121) * lu(187) + lu(215) = lu(215) - lu(118) * lu(214) + lu(218) = lu(218) - lu(119) * lu(214) + lu(219) = lu(219) - lu(120) * lu(214) + lu(220) = - lu(121) * lu(214) + lu(259) = - lu(118) * lu(254) + lu(265) = - lu(119) * lu(254) + lu(268) = lu(268) - lu(120) * lu(254) + lu(269) = lu(269) - lu(121) * lu(254) + lu(341) = lu(341) - lu(118) * lu(331) + lu(348) = lu(348) - lu(119) * lu(331) + lu(351) = lu(351) - lu(120) * lu(331) + lu(352) = lu(352) - lu(121) * lu(331) + lu(366) = lu(366) - lu(118) * lu(361) + lu(373) = lu(373) - lu(119) * lu(361) + lu(376) = lu(376) - lu(120) * lu(361) + lu(377) = lu(377) - lu(121) * lu(361) + lu(389) = lu(389) - lu(118) * lu(386) + lu(396) = lu(396) - lu(119) * lu(386) + lu(399) = lu(399) - lu(120) * lu(386) + lu(400) = - lu(121) * lu(386) + lu(440) = lu(440) - lu(118) * lu(434) + lu(447) = lu(447) - lu(119) * lu(434) + lu(450) = lu(450) - lu(120) * lu(434) + lu(451) = lu(451) - lu(121) * lu(434) + lu(498) = lu(498) - lu(118) * lu(496) + lu(504) = - lu(119) * lu(496) + lu(507) = lu(507) - lu(120) * lu(496) + lu(508) = lu(508) - lu(121) * lu(496) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(123) = 1._r8 / lu(123) + lu(124) = lu(124) * lu(123) + lu(125) = lu(125) * lu(123) + lu(126) = lu(126) * lu(123) + lu(127) = lu(127) * lu(123) + lu(128) = lu(128) * lu(123) + lu(129) = lu(129) * lu(123) + lu(130) = lu(130) * lu(123) + lu(260) = lu(260) - lu(124) * lu(255) + lu(261) = lu(261) - lu(125) * lu(255) + lu(264) = lu(264) - lu(126) * lu(255) + lu(266) = - lu(127) * lu(255) + lu(268) = lu(268) - lu(128) * lu(255) + lu(269) = lu(269) - lu(129) * lu(255) + lu(273) = lu(273) - lu(130) * lu(255) + lu(343) = lu(343) - lu(124) * lu(332) + lu(344) = lu(344) - lu(125) * lu(332) + lu(347) = lu(347) - lu(126) * lu(332) + lu(349) = lu(349) - lu(127) * lu(332) + lu(351) = lu(351) - lu(128) * lu(332) + lu(352) = lu(352) - lu(129) * lu(332) + lu(356) = lu(356) - lu(130) * lu(332) + lu(368) = lu(368) - lu(124) * lu(362) + lu(369) = - lu(125) * lu(362) + lu(372) = lu(372) - lu(126) * lu(362) + lu(374) = lu(374) - lu(127) * lu(362) + lu(376) = lu(376) - lu(128) * lu(362) + lu(377) = lu(377) - lu(129) * lu(362) + lu(381) = - lu(130) * lu(362) + lu(391) = lu(391) - lu(124) * lu(387) + lu(392) = - lu(125) * lu(387) + lu(395) = lu(395) - lu(126) * lu(387) + lu(397) = lu(397) - lu(127) * lu(387) + lu(399) = lu(399) - lu(128) * lu(387) + lu(400) = lu(400) - lu(129) * lu(387) + lu(404) = lu(404) - lu(130) * lu(387) + lu(523) = lu(523) - lu(124) * lu(518) + lu(524) = lu(524) - lu(125) * lu(518) + lu(527) = lu(527) - lu(126) * lu(518) + lu(529) = lu(529) - lu(127) * lu(518) + lu(531) = lu(531) - lu(128) * lu(518) + lu(532) = lu(532) - lu(129) * lu(518) + lu(536) = lu(536) - lu(130) * lu(518) + lu(131) = 1._r8 / lu(131) + lu(132) = lu(132) * lu(131) + lu(133) = lu(133) * lu(131) + lu(134) = lu(134) * lu(131) + lu(135) = lu(135) * lu(131) + lu(136) = lu(136) * lu(131) + lu(137) = lu(137) * lu(131) + lu(138) = lu(138) * lu(131) + lu(150) = lu(150) - lu(132) * lu(149) + lu(151) = lu(151) - lu(133) * lu(149) + lu(152) = lu(152) - lu(134) * lu(149) + lu(153) = lu(153) - lu(135) * lu(149) + lu(154) = lu(154) - lu(136) * lu(149) + lu(155) = lu(155) - lu(137) * lu(149) + lu(156) = lu(156) - lu(138) * lu(149) + lu(160) = lu(160) - lu(132) * lu(159) + lu(161) = lu(161) - lu(133) * lu(159) + lu(162) = lu(162) - lu(134) * lu(159) + lu(163) = lu(163) - lu(135) * lu(159) + lu(164) = lu(164) - lu(136) * lu(159) + lu(166) = - lu(137) * lu(159) + lu(167) = lu(167) - lu(138) * lu(159) + lu(300) = lu(300) - lu(132) * lu(299) + lu(301) = lu(301) - lu(133) * lu(299) + lu(302) = lu(302) - lu(134) * lu(299) + lu(308) = lu(308) - lu(135) * lu(299) + lu(309) = lu(309) - lu(136) * lu(299) + lu(315) = - lu(137) * lu(299) + lu(319) = lu(319) - lu(138) * lu(299) + lu(334) = lu(334) - lu(132) * lu(333) + lu(335) = lu(335) - lu(133) * lu(333) + lu(336) = lu(336) - lu(134) * lu(333) + lu(346) = lu(346) - lu(135) * lu(333) + lu(347) = lu(347) - lu(136) * lu(333) + lu(353) = lu(353) - lu(137) * lu(333) + lu(357) = lu(357) - lu(138) * lu(333) + lu(569) = lu(569) - lu(132) * lu(568) + lu(570) = lu(570) - lu(133) * lu(568) + lu(571) = lu(571) - lu(134) * lu(568) + lu(577) = lu(577) - lu(135) * lu(568) + lu(578) = lu(578) - lu(136) * lu(568) + lu(584) = lu(584) - lu(137) * lu(568) + lu(588) = lu(588) - lu(138) * lu(568) + lu(140) = 1._r8 / lu(140) + lu(141) = lu(141) * lu(140) + lu(142) = lu(142) * lu(140) + lu(143) = lu(143) * lu(140) + lu(144) = lu(144) * lu(140) + lu(145) = lu(145) * lu(140) + lu(146) = lu(146) * lu(140) + lu(151) = lu(151) - lu(141) * lu(150) + lu(152) = lu(152) - lu(142) * lu(150) + lu(153) = lu(153) - lu(143) * lu(150) + lu(154) = lu(154) - lu(144) * lu(150) + lu(155) = lu(155) - lu(145) * lu(150) + lu(156) = lu(156) - lu(146) * lu(150) + lu(161) = lu(161) - lu(141) * lu(160) + lu(162) = lu(162) - lu(142) * lu(160) + lu(163) = lu(163) - lu(143) * lu(160) + lu(164) = lu(164) - lu(144) * lu(160) + lu(166) = lu(166) - lu(145) * lu(160) + lu(167) = lu(167) - lu(146) * lu(160) + lu(301) = lu(301) - lu(141) * lu(300) + lu(302) = lu(302) - lu(142) * lu(300) + lu(308) = lu(308) - lu(143) * lu(300) + lu(309) = lu(309) - lu(144) * lu(300) + lu(315) = lu(315) - lu(145) * lu(300) + lu(319) = lu(319) - lu(146) * lu(300) + lu(335) = lu(335) - lu(141) * lu(334) + lu(336) = lu(336) - lu(142) * lu(334) + lu(346) = lu(346) - lu(143) * lu(334) + lu(347) = lu(347) - lu(144) * lu(334) + lu(353) = lu(353) - lu(145) * lu(334) + lu(357) = lu(357) - lu(146) * lu(334) + lu(570) = lu(570) - lu(141) * lu(569) + lu(571) = lu(571) - lu(142) * lu(569) + lu(577) = lu(577) - lu(143) * lu(569) + lu(578) = lu(578) - lu(144) * lu(569) + lu(584) = lu(584) - lu(145) * lu(569) + lu(588) = lu(588) - lu(146) * lu(569) + lu(151) = 1._r8 / lu(151) + lu(152) = lu(152) * lu(151) + lu(153) = lu(153) * lu(151) + lu(154) = lu(154) * lu(151) + lu(155) = lu(155) * lu(151) + lu(156) = lu(156) * lu(151) + lu(162) = lu(162) - lu(152) * lu(161) + lu(163) = lu(163) - lu(153) * lu(161) + lu(164) = lu(164) - lu(154) * lu(161) + lu(166) = lu(166) - lu(155) * lu(161) + lu(167) = lu(167) - lu(156) * lu(161) + lu(302) = lu(302) - lu(152) * lu(301) + lu(308) = lu(308) - lu(153) * lu(301) + lu(309) = lu(309) - lu(154) * lu(301) + lu(315) = lu(315) - lu(155) * lu(301) + lu(319) = lu(319) - lu(156) * lu(301) + lu(336) = lu(336) - lu(152) * lu(335) + lu(346) = lu(346) - lu(153) * lu(335) + lu(347) = lu(347) - lu(154) * lu(335) + lu(353) = lu(353) - lu(155) * lu(335) + lu(357) = lu(357) - lu(156) * lu(335) + lu(571) = lu(571) - lu(152) * lu(570) + lu(577) = lu(577) - lu(153) * lu(570) + lu(578) = lu(578) - lu(154) * lu(570) + lu(584) = lu(584) - lu(155) * lu(570) + lu(588) = lu(588) - lu(156) * lu(570) + lu(162) = 1._r8 / lu(162) + lu(163) = lu(163) * lu(162) + lu(164) = lu(164) * lu(162) + lu(165) = lu(165) * lu(162) + lu(166) = lu(166) * lu(162) + lu(167) = lu(167) * lu(162) + lu(308) = lu(308) - lu(163) * lu(302) + lu(309) = lu(309) - lu(164) * lu(302) + lu(310) = lu(310) - lu(165) * lu(302) + lu(315) = lu(315) - lu(166) * lu(302) + lu(319) = lu(319) - lu(167) * lu(302) + lu(346) = lu(346) - lu(163) * lu(336) + lu(347) = lu(347) - lu(164) * lu(336) + lu(348) = lu(348) - lu(165) * lu(336) + lu(353) = lu(353) - lu(166) * lu(336) + lu(357) = lu(357) - lu(167) * lu(336) + lu(371) = lu(371) - lu(163) * lu(363) + lu(372) = lu(372) - lu(164) * lu(363) + lu(373) = lu(373) - lu(165) * lu(363) + lu(378) = - lu(166) * lu(363) + lu(382) = lu(382) - lu(167) * lu(363) + lu(577) = lu(577) - lu(163) * lu(571) + lu(578) = lu(578) - lu(164) * lu(571) + lu(579) = - lu(165) * lu(571) + lu(584) = lu(584) - lu(166) * lu(571) + lu(588) = lu(588) - lu(167) * lu(571) + lu(169) = 1._r8 / lu(169) + lu(170) = lu(170) * lu(169) + lu(171) = lu(171) * lu(169) + lu(172) = lu(172) * lu(169) + lu(173) = lu(173) * lu(169) + lu(174) = lu(174) * lu(169) + lu(175) = lu(175) * lu(169) + lu(176) = lu(176) * lu(169) + lu(177) = lu(177) * lu(169) + lu(304) = - lu(170) * lu(303) + lu(308) = lu(308) - lu(171) * lu(303) + lu(310) = lu(310) - lu(172) * lu(303) + lu(313) = lu(313) - lu(173) * lu(303) + lu(314) = - lu(174) * lu(303) + lu(316) = lu(316) - lu(175) * lu(303) + lu(317) = lu(317) - lu(176) * lu(303) + lu(319) = lu(319) - lu(177) * lu(303) + lu(439) = lu(439) - lu(170) * lu(435) + lu(445) = - lu(171) * lu(435) + lu(447) = lu(447) - lu(172) * lu(435) + lu(450) = lu(450) - lu(173) * lu(435) + lu(451) = lu(451) - lu(174) * lu(435) + lu(453) = lu(453) - lu(175) * lu(435) + lu(454) = lu(454) - lu(176) * lu(435) + lu(456) = lu(456) - lu(177) * lu(435) + lu(479) = lu(479) - lu(170) * lu(478) + lu(483) = lu(483) - lu(171) * lu(478) + lu(485) = - lu(172) * lu(478) + lu(488) = lu(488) - lu(173) * lu(478) + lu(489) = lu(489) - lu(174) * lu(478) + lu(491) = lu(491) - lu(175) * lu(478) + lu(492) = lu(492) - lu(176) * lu(478) + lu(494) = lu(494) - lu(177) * lu(478) + lu(521) = lu(521) - lu(170) * lu(519) + lu(526) = lu(526) - lu(171) * lu(519) + lu(528) = lu(528) - lu(172) * lu(519) + lu(531) = lu(531) - lu(173) * lu(519) + lu(532) = lu(532) - lu(174) * lu(519) + lu(534) = lu(534) - lu(175) * lu(519) + lu(535) = lu(535) - lu(176) * lu(519) + lu(537) = lu(537) - lu(177) * lu(519) + lu(543) = lu(543) - lu(170) * lu(540) + lu(547) = - lu(171) * lu(540) + lu(549) = - lu(172) * lu(540) + lu(552) = lu(552) - lu(173) * lu(540) + lu(553) = lu(553) - lu(174) * lu(540) + lu(555) = lu(555) - lu(175) * lu(540) + lu(556) = lu(556) - lu(176) * lu(540) + lu(558) = lu(558) - lu(177) * lu(540) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(179) = 1._r8 / lu(179) + lu(180) = lu(180) * lu(179) + lu(181) = lu(181) * lu(179) + lu(182) = lu(182) * lu(179) + lu(183) = lu(183) * lu(179) + lu(184) = lu(184) * lu(179) + lu(185) = lu(185) * lu(179) + lu(191) = lu(191) - lu(180) * lu(188) + lu(192) = lu(192) - lu(181) * lu(188) + lu(193) = lu(193) - lu(182) * lu(188) + lu(195) = lu(195) - lu(183) * lu(188) + lu(196) = lu(196) - lu(184) * lu(188) + lu(197) = lu(197) - lu(185) * lu(188) + lu(261) = lu(261) - lu(180) * lu(256) + lu(262) = - lu(181) * lu(256) + lu(264) = lu(264) - lu(182) * lu(256) + lu(268) = lu(268) - lu(183) * lu(256) + lu(269) = lu(269) - lu(184) * lu(256) + lu(273) = lu(273) - lu(185) * lu(256) + lu(285) = lu(285) - lu(180) * lu(279) + lu(286) = lu(286) - lu(181) * lu(279) + lu(288) = lu(288) - lu(182) * lu(279) + lu(292) = lu(292) - lu(183) * lu(279) + lu(293) = - lu(184) * lu(279) + lu(297) = lu(297) - lu(185) * lu(279) + lu(344) = lu(344) - lu(180) * lu(337) + lu(345) = lu(345) - lu(181) * lu(337) + lu(347) = lu(347) - lu(182) * lu(337) + lu(351) = lu(351) - lu(183) * lu(337) + lu(352) = lu(352) - lu(184) * lu(337) + lu(356) = lu(356) - lu(185) * lu(337) + lu(443) = lu(443) - lu(180) * lu(436) + lu(444) = lu(444) - lu(181) * lu(436) + lu(446) = lu(446) - lu(182) * lu(436) + lu(450) = lu(450) - lu(183) * lu(436) + lu(451) = lu(451) - lu(184) * lu(436) + lu(455) = lu(455) - lu(185) * lu(436) + lu(524) = lu(524) - lu(180) * lu(520) + lu(525) = lu(525) - lu(181) * lu(520) + lu(527) = lu(527) - lu(182) * lu(520) + lu(531) = lu(531) - lu(183) * lu(520) + lu(532) = lu(532) - lu(184) * lu(520) + lu(536) = lu(536) - lu(185) * lu(520) + lu(545) = lu(545) - lu(180) * lu(541) + lu(546) = lu(546) - lu(181) * lu(541) + lu(548) = lu(548) - lu(182) * lu(541) + lu(552) = lu(552) - lu(183) * lu(541) + lu(553) = lu(553) - lu(184) * lu(541) + lu(557) = lu(557) - lu(185) * lu(541) + lu(189) = 1._r8 / lu(189) + lu(190) = lu(190) * lu(189) + lu(191) = lu(191) * lu(189) + lu(192) = lu(192) * lu(189) + lu(193) = lu(193) * lu(189) + lu(194) = lu(194) * lu(189) + lu(195) = lu(195) * lu(189) + lu(196) = lu(196) * lu(189) + lu(197) = lu(197) * lu(189) + lu(259) = lu(259) - lu(190) * lu(257) + lu(261) = lu(261) - lu(191) * lu(257) + lu(262) = lu(262) - lu(192) * lu(257) + lu(264) = lu(264) - lu(193) * lu(257) + lu(265) = lu(265) - lu(194) * lu(257) + lu(268) = lu(268) - lu(195) * lu(257) + lu(269) = lu(269) - lu(196) * lu(257) + lu(273) = lu(273) - lu(197) * lu(257) + lu(282) = - lu(190) * lu(280) + lu(285) = lu(285) - lu(191) * lu(280) + lu(286) = lu(286) - lu(192) * lu(280) + lu(288) = lu(288) - lu(193) * lu(280) + lu(289) = lu(289) - lu(194) * lu(280) + lu(292) = lu(292) - lu(195) * lu(280) + lu(293) = lu(293) - lu(196) * lu(280) + lu(297) = lu(297) - lu(197) * lu(280) + lu(341) = lu(341) - lu(190) * lu(338) + lu(344) = lu(344) - lu(191) * lu(338) + lu(345) = lu(345) - lu(192) * lu(338) + lu(347) = lu(347) - lu(193) * lu(338) + lu(348) = lu(348) - lu(194) * lu(338) + lu(351) = lu(351) - lu(195) * lu(338) + lu(352) = lu(352) - lu(196) * lu(338) + lu(356) = lu(356) - lu(197) * lu(338) + lu(366) = lu(366) - lu(190) * lu(364) + lu(369) = lu(369) - lu(191) * lu(364) + lu(370) = lu(370) - lu(192) * lu(364) + lu(372) = lu(372) - lu(193) * lu(364) + lu(373) = lu(373) - lu(194) * lu(364) + lu(376) = lu(376) - lu(195) * lu(364) + lu(377) = lu(377) - lu(196) * lu(364) + lu(381) = lu(381) - lu(197) * lu(364) + lu(440) = lu(440) - lu(190) * lu(437) + lu(443) = lu(443) - lu(191) * lu(437) + lu(444) = lu(444) - lu(192) * lu(437) + lu(446) = lu(446) - lu(193) * lu(437) + lu(447) = lu(447) - lu(194) * lu(437) + lu(450) = lu(450) - lu(195) * lu(437) + lu(451) = lu(451) - lu(196) * lu(437) + lu(455) = lu(455) - lu(197) * lu(437) + lu(544) = lu(544) - lu(190) * lu(542) + lu(545) = lu(545) - lu(191) * lu(542) + lu(546) = lu(546) - lu(192) * lu(542) + lu(548) = lu(548) - lu(193) * lu(542) + lu(549) = lu(549) - lu(194) * lu(542) + lu(552) = lu(552) - lu(195) * lu(542) + lu(553) = lu(553) - lu(196) * lu(542) + lu(557) = lu(557) - lu(197) * lu(542) + lu(199) = 1._r8 / lu(199) + lu(200) = lu(200) * lu(199) + lu(201) = lu(201) * lu(199) + lu(202) = lu(202) * lu(199) + lu(203) = lu(203) * lu(199) + lu(204) = lu(204) * lu(199) + lu(205) = lu(205) * lu(199) + lu(228) = lu(228) - lu(200) * lu(226) + lu(232) = lu(232) - lu(201) * lu(226) + lu(236) = lu(236) - lu(202) * lu(226) + lu(237) = - lu(203) * lu(226) + lu(238) = - lu(204) * lu(226) + lu(240) = lu(240) - lu(205) * lu(226) + lu(283) = lu(283) - lu(200) * lu(281) + lu(288) = lu(288) - lu(201) * lu(281) + lu(292) = lu(292) - lu(202) * lu(281) + lu(293) = lu(293) - lu(203) * lu(281) + lu(296) = lu(296) - lu(204) * lu(281) + lu(298) = lu(298) - lu(205) * lu(281) + lu(342) = lu(342) - lu(200) * lu(339) + lu(347) = lu(347) - lu(201) * lu(339) + lu(351) = lu(351) - lu(202) * lu(339) + lu(352) = lu(352) - lu(203) * lu(339) + lu(355) = lu(355) - lu(204) * lu(339) + lu(357) = lu(357) - lu(205) * lu(339) + lu(367) = lu(367) - lu(200) * lu(365) + lu(372) = lu(372) - lu(201) * lu(365) + lu(376) = lu(376) - lu(202) * lu(365) + lu(377) = lu(377) - lu(203) * lu(365) + lu(380) = lu(380) - lu(204) * lu(365) + lu(382) = lu(382) - lu(205) * lu(365) + lu(390) = lu(390) - lu(200) * lu(388) + lu(395) = lu(395) - lu(201) * lu(388) + lu(399) = lu(399) - lu(202) * lu(388) + lu(400) = lu(400) - lu(203) * lu(388) + lu(403) = lu(403) - lu(204) * lu(388) + lu(405) = lu(405) - lu(205) * lu(388) + lu(412) = lu(412) - lu(200) * lu(409) + lu(416) = lu(416) - lu(201) * lu(409) + lu(420) = lu(420) - lu(202) * lu(409) + lu(421) = - lu(203) * lu(409) + lu(424) = lu(424) - lu(204) * lu(409) + lu(426) = lu(426) - lu(205) * lu(409) + lu(441) = lu(441) - lu(200) * lu(438) + lu(446) = lu(446) - lu(201) * lu(438) + lu(450) = lu(450) - lu(202) * lu(438) + lu(451) = lu(451) - lu(203) * lu(438) + lu(454) = lu(454) - lu(204) * lu(438) + lu(456) = lu(456) - lu(205) * lu(438) + lu(461) = - lu(200) * lu(459) + lu(465) = lu(465) - lu(201) * lu(459) + lu(469) = lu(469) - lu(202) * lu(459) + lu(470) = lu(470) - lu(203) * lu(459) + lu(473) = - lu(204) * lu(459) + lu(475) = - lu(205) * lu(459) + lu(574) = lu(574) - lu(200) * lu(572) + lu(578) = lu(578) - lu(201) * lu(572) + lu(582) = lu(582) - lu(202) * lu(572) + lu(583) = lu(583) - lu(203) * lu(572) + lu(586) = lu(586) - lu(204) * lu(572) + lu(588) = lu(588) - lu(205) * lu(572) + lu(206) = 1._r8 / lu(206) + lu(207) = lu(207) * lu(206) + lu(208) = lu(208) * lu(206) + lu(209) = lu(209) * lu(206) + lu(210) = lu(210) * lu(206) + lu(211) = lu(211) * lu(206) + lu(212) = lu(212) * lu(206) + lu(232) = lu(232) - lu(207) * lu(227) + lu(235) = lu(235) - lu(208) * lu(227) + lu(236) = lu(236) - lu(209) * lu(227) + lu(237) = lu(237) - lu(210) * lu(227) + lu(238) = lu(238) - lu(211) * lu(227) + lu(240) = lu(240) - lu(212) * lu(227) + lu(264) = lu(264) - lu(207) * lu(258) + lu(267) = - lu(208) * lu(258) + lu(268) = lu(268) - lu(209) * lu(258) + lu(269) = lu(269) - lu(210) * lu(258) + lu(272) = - lu(211) * lu(258) + lu(274) = - lu(212) * lu(258) + lu(309) = lu(309) - lu(207) * lu(304) + lu(312) = lu(312) - lu(208) * lu(304) + lu(313) = lu(313) - lu(209) * lu(304) + lu(314) = lu(314) - lu(210) * lu(304) + lu(317) = lu(317) - lu(211) * lu(304) + lu(319) = lu(319) - lu(212) * lu(304) + lu(347) = lu(347) - lu(207) * lu(340) + lu(350) = lu(350) - lu(208) * lu(340) + lu(351) = lu(351) - lu(209) * lu(340) + lu(352) = lu(352) - lu(210) * lu(340) + lu(355) = lu(355) - lu(211) * lu(340) + lu(357) = lu(357) - lu(212) * lu(340) + lu(416) = lu(416) - lu(207) * lu(410) + lu(419) = lu(419) - lu(208) * lu(410) + lu(420) = lu(420) - lu(209) * lu(410) + lu(421) = lu(421) - lu(210) * lu(410) + lu(424) = lu(424) - lu(211) * lu(410) + lu(426) = lu(426) - lu(212) * lu(410) + lu(446) = lu(446) - lu(207) * lu(439) + lu(449) = lu(449) - lu(208) * lu(439) + lu(450) = lu(450) - lu(209) * lu(439) + lu(451) = lu(451) - lu(210) * lu(439) + lu(454) = lu(454) - lu(211) * lu(439) + lu(456) = lu(456) - lu(212) * lu(439) + lu(465) = lu(465) - lu(207) * lu(460) + lu(468) = - lu(208) * lu(460) + lu(469) = lu(469) - lu(209) * lu(460) + lu(470) = lu(470) - lu(210) * lu(460) + lu(473) = lu(473) - lu(211) * lu(460) + lu(475) = lu(475) - lu(212) * lu(460) + lu(484) = lu(484) - lu(207) * lu(479) + lu(487) = lu(487) - lu(208) * lu(479) + lu(488) = lu(488) - lu(209) * lu(479) + lu(489) = lu(489) - lu(210) * lu(479) + lu(492) = lu(492) - lu(211) * lu(479) + lu(494) = lu(494) - lu(212) * lu(479) + lu(503) = lu(503) - lu(207) * lu(497) + lu(506) = - lu(208) * lu(497) + lu(507) = lu(507) - lu(209) * lu(497) + lu(508) = lu(508) - lu(210) * lu(497) + lu(511) = lu(511) - lu(211) * lu(497) + lu(513) = - lu(212) * lu(497) + lu(527) = lu(527) - lu(207) * lu(521) + lu(530) = lu(530) - lu(208) * lu(521) + lu(531) = lu(531) - lu(209) * lu(521) + lu(532) = lu(532) - lu(210) * lu(521) + lu(535) = lu(535) - lu(211) * lu(521) + lu(537) = lu(537) - lu(212) * lu(521) + lu(548) = lu(548) - lu(207) * lu(543) + lu(551) = lu(551) - lu(208) * lu(543) + lu(552) = lu(552) - lu(209) * lu(543) + lu(553) = lu(553) - lu(210) * lu(543) + lu(556) = lu(556) - lu(211) * lu(543) + lu(558) = lu(558) - lu(212) * lu(543) + lu(578) = lu(578) - lu(207) * lu(573) + lu(581) = lu(581) - lu(208) * lu(573) + lu(582) = lu(582) - lu(209) * lu(573) + lu(583) = lu(583) - lu(210) * lu(573) + lu(586) = lu(586) - lu(211) * lu(573) + lu(588) = lu(588) - lu(212) * lu(573) + lu(215) = 1._r8 / lu(215) + lu(216) = lu(216) * lu(215) + lu(217) = lu(217) * lu(215) + lu(218) = lu(218) * lu(215) + lu(219) = lu(219) * lu(215) + lu(220) = lu(220) * lu(215) + lu(221) = lu(221) * lu(215) + lu(222) = lu(222) * lu(215) + lu(223) = lu(223) * lu(215) + lu(263) = - lu(216) * lu(259) + lu(264) = lu(264) - lu(217) * lu(259) + lu(265) = lu(265) - lu(218) * lu(259) + lu(268) = lu(268) - lu(219) * lu(259) + lu(269) = lu(269) - lu(220) * lu(259) + lu(271) = - lu(221) * lu(259) + lu(272) = lu(272) - lu(222) * lu(259) + lu(274) = lu(274) - lu(223) * lu(259) + lu(287) = lu(287) - lu(216) * lu(282) + lu(288) = lu(288) - lu(217) * lu(282) + lu(289) = lu(289) - lu(218) * lu(282) + lu(292) = lu(292) - lu(219) * lu(282) + lu(293) = lu(293) - lu(220) * lu(282) + lu(295) = - lu(221) * lu(282) + lu(296) = lu(296) - lu(222) * lu(282) + lu(298) = lu(298) - lu(223) * lu(282) + lu(308) = lu(308) - lu(216) * lu(305) + lu(309) = lu(309) - lu(217) * lu(305) + lu(310) = lu(310) - lu(218) * lu(305) + lu(313) = lu(313) - lu(219) * lu(305) + lu(314) = lu(314) - lu(220) * lu(305) + lu(316) = lu(316) - lu(221) * lu(305) + lu(317) = lu(317) - lu(222) * lu(305) + lu(319) = lu(319) - lu(223) * lu(305) + lu(346) = lu(346) - lu(216) * lu(341) + lu(347) = lu(347) - lu(217) * lu(341) + lu(348) = lu(348) - lu(218) * lu(341) + lu(351) = lu(351) - lu(219) * lu(341) + lu(352) = lu(352) - lu(220) * lu(341) + lu(354) = lu(354) - lu(221) * lu(341) + lu(355) = lu(355) - lu(222) * lu(341) + lu(357) = lu(357) - lu(223) * lu(341) + lu(371) = lu(371) - lu(216) * lu(366) + lu(372) = lu(372) - lu(217) * lu(366) + lu(373) = lu(373) - lu(218) * lu(366) + lu(376) = lu(376) - lu(219) * lu(366) + lu(377) = lu(377) - lu(220) * lu(366) + lu(379) = - lu(221) * lu(366) + lu(380) = lu(380) - lu(222) * lu(366) + lu(382) = lu(382) - lu(223) * lu(366) + lu(394) = lu(394) - lu(216) * lu(389) + lu(395) = lu(395) - lu(217) * lu(389) + lu(396) = lu(396) - lu(218) * lu(389) + lu(399) = lu(399) - lu(219) * lu(389) + lu(400) = lu(400) - lu(220) * lu(389) + lu(402) = - lu(221) * lu(389) + lu(403) = lu(403) - lu(222) * lu(389) + lu(405) = lu(405) - lu(223) * lu(389) + lu(415) = lu(415) - lu(216) * lu(411) + lu(416) = lu(416) - lu(217) * lu(411) + lu(417) = lu(417) - lu(218) * lu(411) + lu(420) = lu(420) - lu(219) * lu(411) + lu(421) = lu(421) - lu(220) * lu(411) + lu(423) = - lu(221) * lu(411) + lu(424) = lu(424) - lu(222) * lu(411) + lu(426) = lu(426) - lu(223) * lu(411) + lu(445) = lu(445) - lu(216) * lu(440) + lu(446) = lu(446) - lu(217) * lu(440) + lu(447) = lu(447) - lu(218) * lu(440) + lu(450) = lu(450) - lu(219) * lu(440) + lu(451) = lu(451) - lu(220) * lu(440) + lu(453) = lu(453) - lu(221) * lu(440) + lu(454) = lu(454) - lu(222) * lu(440) + lu(456) = lu(456) - lu(223) * lu(440) + lu(502) = - lu(216) * lu(498) + lu(503) = lu(503) - lu(217) * lu(498) + lu(504) = lu(504) - lu(218) * lu(498) + lu(507) = lu(507) - lu(219) * lu(498) + lu(508) = lu(508) - lu(220) * lu(498) + lu(510) = lu(510) - lu(221) * lu(498) + lu(511) = lu(511) - lu(222) * lu(498) + lu(513) = lu(513) - lu(223) * lu(498) + lu(526) = lu(526) - lu(216) * lu(522) + lu(527) = lu(527) - lu(217) * lu(522) + lu(528) = lu(528) - lu(218) * lu(522) + lu(531) = lu(531) - lu(219) * lu(522) + lu(532) = lu(532) - lu(220) * lu(522) + lu(534) = lu(534) - lu(221) * lu(522) + lu(535) = lu(535) - lu(222) * lu(522) + lu(537) = lu(537) - lu(223) * lu(522) + lu(547) = lu(547) - lu(216) * lu(544) + lu(548) = lu(548) - lu(217) * lu(544) + lu(549) = lu(549) - lu(218) * lu(544) + lu(552) = lu(552) - lu(219) * lu(544) + lu(553) = lu(553) - lu(220) * lu(544) + lu(555) = lu(555) - lu(221) * lu(544) + lu(556) = lu(556) - lu(222) * lu(544) + lu(558) = lu(558) - lu(223) * lu(544) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(228) = 1._r8 / lu(228) + lu(229) = lu(229) * lu(228) + lu(230) = lu(230) * lu(228) + lu(231) = lu(231) * lu(228) + lu(232) = lu(232) * lu(228) + lu(233) = lu(233) * lu(228) + lu(234) = lu(234) * lu(228) + lu(235) = lu(235) * lu(228) + lu(236) = lu(236) * lu(228) + lu(237) = lu(237) * lu(228) + lu(238) = lu(238) * lu(228) + lu(239) = lu(239) * lu(228) + lu(240) = lu(240) * lu(228) + lu(284) = lu(284) - lu(229) * lu(283) + lu(286) = lu(286) - lu(230) * lu(283) + lu(287) = lu(287) - lu(231) * lu(283) + lu(288) = lu(288) - lu(232) * lu(283) + lu(289) = lu(289) - lu(233) * lu(283) + lu(290) = lu(290) - lu(234) * lu(283) + lu(291) = - lu(235) * lu(283) + lu(292) = lu(292) - lu(236) * lu(283) + lu(293) = lu(293) - lu(237) * lu(283) + lu(296) = lu(296) - lu(238) * lu(283) + lu(297) = lu(297) - lu(239) * lu(283) + lu(298) = lu(298) - lu(240) * lu(283) + lu(343) = lu(343) - lu(229) * lu(342) + lu(345) = lu(345) - lu(230) * lu(342) + lu(346) = lu(346) - lu(231) * lu(342) + lu(347) = lu(347) - lu(232) * lu(342) + lu(348) = lu(348) - lu(233) * lu(342) + lu(349) = lu(349) - lu(234) * lu(342) + lu(350) = lu(350) - lu(235) * lu(342) + lu(351) = lu(351) - lu(236) * lu(342) + lu(352) = lu(352) - lu(237) * lu(342) + lu(355) = lu(355) - lu(238) * lu(342) + lu(356) = lu(356) - lu(239) * lu(342) + lu(357) = lu(357) - lu(240) * lu(342) + lu(368) = lu(368) - lu(229) * lu(367) + lu(370) = lu(370) - lu(230) * lu(367) + lu(371) = lu(371) - lu(231) * lu(367) + lu(372) = lu(372) - lu(232) * lu(367) + lu(373) = lu(373) - lu(233) * lu(367) + lu(374) = lu(374) - lu(234) * lu(367) + lu(375) = lu(375) - lu(235) * lu(367) + lu(376) = lu(376) - lu(236) * lu(367) + lu(377) = lu(377) - lu(237) * lu(367) + lu(380) = lu(380) - lu(238) * lu(367) + lu(381) = lu(381) - lu(239) * lu(367) + lu(382) = lu(382) - lu(240) * lu(367) + lu(391) = lu(391) - lu(229) * lu(390) + lu(393) = lu(393) - lu(230) * lu(390) + lu(394) = lu(394) - lu(231) * lu(390) + lu(395) = lu(395) - lu(232) * lu(390) + lu(396) = lu(396) - lu(233) * lu(390) + lu(397) = lu(397) - lu(234) * lu(390) + lu(398) = - lu(235) * lu(390) + lu(399) = lu(399) - lu(236) * lu(390) + lu(400) = lu(400) - lu(237) * lu(390) + lu(403) = lu(403) - lu(238) * lu(390) + lu(404) = lu(404) - lu(239) * lu(390) + lu(405) = lu(405) - lu(240) * lu(390) + lu(413) = lu(413) - lu(229) * lu(412) + lu(414) = lu(414) - lu(230) * lu(412) + lu(415) = lu(415) - lu(231) * lu(412) + lu(416) = lu(416) - lu(232) * lu(412) + lu(417) = lu(417) - lu(233) * lu(412) + lu(418) = lu(418) - lu(234) * lu(412) + lu(419) = lu(419) - lu(235) * lu(412) + lu(420) = lu(420) - lu(236) * lu(412) + lu(421) = lu(421) - lu(237) * lu(412) + lu(424) = lu(424) - lu(238) * lu(412) + lu(425) = lu(425) - lu(239) * lu(412) + lu(426) = lu(426) - lu(240) * lu(412) + lu(442) = lu(442) - lu(229) * lu(441) + lu(444) = lu(444) - lu(230) * lu(441) + lu(445) = lu(445) - lu(231) * lu(441) + lu(446) = lu(446) - lu(232) * lu(441) + lu(447) = lu(447) - lu(233) * lu(441) + lu(448) = lu(448) - lu(234) * lu(441) + lu(449) = lu(449) - lu(235) * lu(441) + lu(450) = lu(450) - lu(236) * lu(441) + lu(451) = lu(451) - lu(237) * lu(441) + lu(454) = lu(454) - lu(238) * lu(441) + lu(455) = lu(455) - lu(239) * lu(441) + lu(456) = lu(456) - lu(240) * lu(441) + lu(462) = - lu(229) * lu(461) + lu(463) = - lu(230) * lu(461) + lu(464) = - lu(231) * lu(461) + lu(465) = lu(465) - lu(232) * lu(461) + lu(466) = - lu(233) * lu(461) + lu(467) = - lu(234) * lu(461) + lu(468) = lu(468) - lu(235) * lu(461) + lu(469) = lu(469) - lu(236) * lu(461) + lu(470) = lu(470) - lu(237) * lu(461) + lu(473) = lu(473) - lu(238) * lu(461) + lu(474) = - lu(239) * lu(461) + lu(475) = lu(475) - lu(240) * lu(461) + lu(575) = - lu(229) * lu(574) + lu(576) = - lu(230) * lu(574) + lu(577) = lu(577) - lu(231) * lu(574) + lu(578) = lu(578) - lu(232) * lu(574) + lu(579) = lu(579) - lu(233) * lu(574) + lu(580) = - lu(234) * lu(574) + lu(581) = lu(581) - lu(235) * lu(574) + lu(582) = lu(582) - lu(236) * lu(574) + lu(583) = lu(583) - lu(237) * lu(574) + lu(586) = lu(586) - lu(238) * lu(574) + lu(587) = - lu(239) * lu(574) + lu(588) = lu(588) - lu(240) * lu(574) + lu(242) = 1._r8 / lu(242) + lu(243) = lu(243) * lu(242) + lu(244) = lu(244) * lu(242) + lu(245) = lu(245) * lu(242) + lu(246) = lu(246) * lu(242) + lu(247) = lu(247) * lu(242) + lu(248) = lu(248) * lu(242) + lu(249) = lu(249) * lu(242) + lu(250) = lu(250) * lu(242) + lu(251) = lu(251) * lu(242) + lu(264) = lu(264) - lu(243) * lu(260) + lu(266) = lu(266) - lu(244) * lu(260) + lu(267) = lu(267) - lu(245) * lu(260) + lu(268) = lu(268) - lu(246) * lu(260) + lu(269) = lu(269) - lu(247) * lu(260) + lu(270) = lu(270) - lu(248) * lu(260) + lu(271) = lu(271) - lu(249) * lu(260) + lu(272) = lu(272) - lu(250) * lu(260) + lu(274) = lu(274) - lu(251) * lu(260) + lu(288) = lu(288) - lu(243) * lu(284) + lu(290) = lu(290) - lu(244) * lu(284) + lu(291) = lu(291) - lu(245) * lu(284) + lu(292) = lu(292) - lu(246) * lu(284) + lu(293) = lu(293) - lu(247) * lu(284) + lu(294) = - lu(248) * lu(284) + lu(295) = lu(295) - lu(249) * lu(284) + lu(296) = lu(296) - lu(250) * lu(284) + lu(298) = lu(298) - lu(251) * lu(284) + lu(309) = lu(309) - lu(243) * lu(306) + lu(311) = lu(311) - lu(244) * lu(306) + lu(312) = lu(312) - lu(245) * lu(306) + lu(313) = lu(313) - lu(246) * lu(306) + lu(314) = lu(314) - lu(247) * lu(306) + lu(315) = lu(315) - lu(248) * lu(306) + lu(316) = lu(316) - lu(249) * lu(306) + lu(317) = lu(317) - lu(250) * lu(306) + lu(319) = lu(319) - lu(251) * lu(306) + lu(347) = lu(347) - lu(243) * lu(343) + lu(349) = lu(349) - lu(244) * lu(343) + lu(350) = lu(350) - lu(245) * lu(343) + lu(351) = lu(351) - lu(246) * lu(343) + lu(352) = lu(352) - lu(247) * lu(343) + lu(353) = lu(353) - lu(248) * lu(343) + lu(354) = lu(354) - lu(249) * lu(343) + lu(355) = lu(355) - lu(250) * lu(343) + lu(357) = lu(357) - lu(251) * lu(343) + lu(372) = lu(372) - lu(243) * lu(368) + lu(374) = lu(374) - lu(244) * lu(368) + lu(375) = lu(375) - lu(245) * lu(368) + lu(376) = lu(376) - lu(246) * lu(368) + lu(377) = lu(377) - lu(247) * lu(368) + lu(378) = lu(378) - lu(248) * lu(368) + lu(379) = lu(379) - lu(249) * lu(368) + lu(380) = lu(380) - lu(250) * lu(368) + lu(382) = lu(382) - lu(251) * lu(368) + lu(395) = lu(395) - lu(243) * lu(391) + lu(397) = lu(397) - lu(244) * lu(391) + lu(398) = lu(398) - lu(245) * lu(391) + lu(399) = lu(399) - lu(246) * lu(391) + lu(400) = lu(400) - lu(247) * lu(391) + lu(401) = - lu(248) * lu(391) + lu(402) = lu(402) - lu(249) * lu(391) + lu(403) = lu(403) - lu(250) * lu(391) + lu(405) = lu(405) - lu(251) * lu(391) + lu(416) = lu(416) - lu(243) * lu(413) + lu(418) = lu(418) - lu(244) * lu(413) + lu(419) = lu(419) - lu(245) * lu(413) + lu(420) = lu(420) - lu(246) * lu(413) + lu(421) = lu(421) - lu(247) * lu(413) + lu(422) = lu(422) - lu(248) * lu(413) + lu(423) = lu(423) - lu(249) * lu(413) + lu(424) = lu(424) - lu(250) * lu(413) + lu(426) = lu(426) - lu(251) * lu(413) + lu(446) = lu(446) - lu(243) * lu(442) + lu(448) = lu(448) - lu(244) * lu(442) + lu(449) = lu(449) - lu(245) * lu(442) + lu(450) = lu(450) - lu(246) * lu(442) + lu(451) = lu(451) - lu(247) * lu(442) + lu(452) = lu(452) - lu(248) * lu(442) + lu(453) = lu(453) - lu(249) * lu(442) + lu(454) = lu(454) - lu(250) * lu(442) + lu(456) = lu(456) - lu(251) * lu(442) + lu(465) = lu(465) - lu(243) * lu(462) + lu(467) = lu(467) - lu(244) * lu(462) + lu(468) = lu(468) - lu(245) * lu(462) + lu(469) = lu(469) - lu(246) * lu(462) + lu(470) = lu(470) - lu(247) * lu(462) + lu(471) = lu(471) - lu(248) * lu(462) + lu(472) = - lu(249) * lu(462) + lu(473) = lu(473) - lu(250) * lu(462) + lu(475) = lu(475) - lu(251) * lu(462) + lu(484) = lu(484) - lu(243) * lu(480) + lu(486) = - lu(244) * lu(480) + lu(487) = lu(487) - lu(245) * lu(480) + lu(488) = lu(488) - lu(246) * lu(480) + lu(489) = lu(489) - lu(247) * lu(480) + lu(490) = lu(490) - lu(248) * lu(480) + lu(491) = lu(491) - lu(249) * lu(480) + lu(492) = lu(492) - lu(250) * lu(480) + lu(494) = lu(494) - lu(251) * lu(480) + lu(503) = lu(503) - lu(243) * lu(499) + lu(505) = - lu(244) * lu(499) + lu(506) = lu(506) - lu(245) * lu(499) + lu(507) = lu(507) - lu(246) * lu(499) + lu(508) = lu(508) - lu(247) * lu(499) + lu(509) = lu(509) - lu(248) * lu(499) + lu(510) = lu(510) - lu(249) * lu(499) + lu(511) = lu(511) - lu(250) * lu(499) + lu(513) = lu(513) - lu(251) * lu(499) + lu(527) = lu(527) - lu(243) * lu(523) + lu(529) = lu(529) - lu(244) * lu(523) + lu(530) = lu(530) - lu(245) * lu(523) + lu(531) = lu(531) - lu(246) * lu(523) + lu(532) = lu(532) - lu(247) * lu(523) + lu(533) = lu(533) - lu(248) * lu(523) + lu(534) = lu(534) - lu(249) * lu(523) + lu(535) = lu(535) - lu(250) * lu(523) + lu(537) = lu(537) - lu(251) * lu(523) + lu(578) = lu(578) - lu(243) * lu(575) + lu(580) = lu(580) - lu(244) * lu(575) + lu(581) = lu(581) - lu(245) * lu(575) + lu(582) = lu(582) - lu(246) * lu(575) + lu(583) = lu(583) - lu(247) * lu(575) + lu(584) = lu(584) - lu(248) * lu(575) + lu(585) = - lu(249) * lu(575) + lu(586) = lu(586) - lu(250) * lu(575) + lu(588) = lu(588) - lu(251) * lu(575) + lu(261) = 1._r8 / lu(261) + lu(262) = lu(262) * lu(261) + lu(263) = lu(263) * lu(261) + lu(264) = lu(264) * lu(261) + lu(265) = lu(265) * lu(261) + lu(266) = lu(266) * lu(261) + lu(267) = lu(267) * lu(261) + lu(268) = lu(268) * lu(261) + lu(269) = lu(269) * lu(261) + lu(270) = lu(270) * lu(261) + lu(271) = lu(271) * lu(261) + lu(272) = lu(272) * lu(261) + lu(273) = lu(273) * lu(261) + lu(274) = lu(274) * lu(261) + lu(286) = lu(286) - lu(262) * lu(285) + lu(287) = lu(287) - lu(263) * lu(285) + lu(288) = lu(288) - lu(264) * lu(285) + lu(289) = lu(289) - lu(265) * lu(285) + lu(290) = lu(290) - lu(266) * lu(285) + lu(291) = lu(291) - lu(267) * lu(285) + lu(292) = lu(292) - lu(268) * lu(285) + lu(293) = lu(293) - lu(269) * lu(285) + lu(294) = lu(294) - lu(270) * lu(285) + lu(295) = lu(295) - lu(271) * lu(285) + lu(296) = lu(296) - lu(272) * lu(285) + lu(297) = lu(297) - lu(273) * lu(285) + lu(298) = lu(298) - lu(274) * lu(285) + lu(345) = lu(345) - lu(262) * lu(344) + lu(346) = lu(346) - lu(263) * lu(344) + lu(347) = lu(347) - lu(264) * lu(344) + lu(348) = lu(348) - lu(265) * lu(344) + lu(349) = lu(349) - lu(266) * lu(344) + lu(350) = lu(350) - lu(267) * lu(344) + lu(351) = lu(351) - lu(268) * lu(344) + lu(352) = lu(352) - lu(269) * lu(344) + lu(353) = lu(353) - lu(270) * lu(344) + lu(354) = lu(354) - lu(271) * lu(344) + lu(355) = lu(355) - lu(272) * lu(344) + lu(356) = lu(356) - lu(273) * lu(344) + lu(357) = lu(357) - lu(274) * lu(344) + lu(370) = lu(370) - lu(262) * lu(369) + lu(371) = lu(371) - lu(263) * lu(369) + lu(372) = lu(372) - lu(264) * lu(369) + lu(373) = lu(373) - lu(265) * lu(369) + lu(374) = lu(374) - lu(266) * lu(369) + lu(375) = lu(375) - lu(267) * lu(369) + lu(376) = lu(376) - lu(268) * lu(369) + lu(377) = lu(377) - lu(269) * lu(369) + lu(378) = lu(378) - lu(270) * lu(369) + lu(379) = lu(379) - lu(271) * lu(369) + lu(380) = lu(380) - lu(272) * lu(369) + lu(381) = lu(381) - lu(273) * lu(369) + lu(382) = lu(382) - lu(274) * lu(369) + lu(393) = lu(393) - lu(262) * lu(392) + lu(394) = lu(394) - lu(263) * lu(392) + lu(395) = lu(395) - lu(264) * lu(392) + lu(396) = lu(396) - lu(265) * lu(392) + lu(397) = lu(397) - lu(266) * lu(392) + lu(398) = lu(398) - lu(267) * lu(392) + lu(399) = lu(399) - lu(268) * lu(392) + lu(400) = lu(400) - lu(269) * lu(392) + lu(401) = lu(401) - lu(270) * lu(392) + lu(402) = lu(402) - lu(271) * lu(392) + lu(403) = lu(403) - lu(272) * lu(392) + lu(404) = lu(404) - lu(273) * lu(392) + lu(405) = lu(405) - lu(274) * lu(392) + lu(444) = lu(444) - lu(262) * lu(443) + lu(445) = lu(445) - lu(263) * lu(443) + lu(446) = lu(446) - lu(264) * lu(443) + lu(447) = lu(447) - lu(265) * lu(443) + lu(448) = lu(448) - lu(266) * lu(443) + lu(449) = lu(449) - lu(267) * lu(443) + lu(450) = lu(450) - lu(268) * lu(443) + lu(451) = lu(451) - lu(269) * lu(443) + lu(452) = lu(452) - lu(270) * lu(443) + lu(453) = lu(453) - lu(271) * lu(443) + lu(454) = lu(454) - lu(272) * lu(443) + lu(455) = lu(455) - lu(273) * lu(443) + lu(456) = lu(456) - lu(274) * lu(443) + lu(482) = - lu(262) * lu(481) + lu(483) = lu(483) - lu(263) * lu(481) + lu(484) = lu(484) - lu(264) * lu(481) + lu(485) = lu(485) - lu(265) * lu(481) + lu(486) = lu(486) - lu(266) * lu(481) + lu(487) = lu(487) - lu(267) * lu(481) + lu(488) = lu(488) - lu(268) * lu(481) + lu(489) = lu(489) - lu(269) * lu(481) + lu(490) = lu(490) - lu(270) * lu(481) + lu(491) = lu(491) - lu(271) * lu(481) + lu(492) = lu(492) - lu(272) * lu(481) + lu(493) = lu(493) - lu(273) * lu(481) + lu(494) = lu(494) - lu(274) * lu(481) + lu(501) = - lu(262) * lu(500) + lu(502) = lu(502) - lu(263) * lu(500) + lu(503) = lu(503) - lu(264) * lu(500) + lu(504) = lu(504) - lu(265) * lu(500) + lu(505) = lu(505) - lu(266) * lu(500) + lu(506) = lu(506) - lu(267) * lu(500) + lu(507) = lu(507) - lu(268) * lu(500) + lu(508) = lu(508) - lu(269) * lu(500) + lu(509) = lu(509) - lu(270) * lu(500) + lu(510) = lu(510) - lu(271) * lu(500) + lu(511) = lu(511) - lu(272) * lu(500) + lu(512) = lu(512) - lu(273) * lu(500) + lu(513) = lu(513) - lu(274) * lu(500) + lu(525) = lu(525) - lu(262) * lu(524) + lu(526) = lu(526) - lu(263) * lu(524) + lu(527) = lu(527) - lu(264) * lu(524) + lu(528) = lu(528) - lu(265) * lu(524) + lu(529) = lu(529) - lu(266) * lu(524) + lu(530) = lu(530) - lu(267) * lu(524) + lu(531) = lu(531) - lu(268) * lu(524) + lu(532) = lu(532) - lu(269) * lu(524) + lu(533) = lu(533) - lu(270) * lu(524) + lu(534) = lu(534) - lu(271) * lu(524) + lu(535) = lu(535) - lu(272) * lu(524) + lu(536) = lu(536) - lu(273) * lu(524) + lu(537) = lu(537) - lu(274) * lu(524) + lu(546) = lu(546) - lu(262) * lu(545) + lu(547) = lu(547) - lu(263) * lu(545) + lu(548) = lu(548) - lu(264) * lu(545) + lu(549) = lu(549) - lu(265) * lu(545) + lu(550) = - lu(266) * lu(545) + lu(551) = lu(551) - lu(267) * lu(545) + lu(552) = lu(552) - lu(268) * lu(545) + lu(553) = lu(553) - lu(269) * lu(545) + lu(554) = - lu(270) * lu(545) + lu(555) = lu(555) - lu(271) * lu(545) + lu(556) = lu(556) - lu(272) * lu(545) + lu(557) = lu(557) - lu(273) * lu(545) + lu(558) = lu(558) - lu(274) * lu(545) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(286) = 1._r8 / lu(286) + lu(287) = lu(287) * lu(286) + lu(288) = lu(288) * lu(286) + lu(289) = lu(289) * lu(286) + lu(290) = lu(290) * lu(286) + lu(291) = lu(291) * lu(286) + lu(292) = lu(292) * lu(286) + lu(293) = lu(293) * lu(286) + lu(294) = lu(294) * lu(286) + lu(295) = lu(295) * lu(286) + lu(296) = lu(296) * lu(286) + lu(297) = lu(297) * lu(286) + lu(298) = lu(298) * lu(286) + lu(308) = lu(308) - lu(287) * lu(307) + lu(309) = lu(309) - lu(288) * lu(307) + lu(310) = lu(310) - lu(289) * lu(307) + lu(311) = lu(311) - lu(290) * lu(307) + lu(312) = lu(312) - lu(291) * lu(307) + lu(313) = lu(313) - lu(292) * lu(307) + lu(314) = lu(314) - lu(293) * lu(307) + lu(315) = lu(315) - lu(294) * lu(307) + lu(316) = lu(316) - lu(295) * lu(307) + lu(317) = lu(317) - lu(296) * lu(307) + lu(318) = lu(318) - lu(297) * lu(307) + lu(319) = lu(319) - lu(298) * lu(307) + lu(346) = lu(346) - lu(287) * lu(345) + lu(347) = lu(347) - lu(288) * lu(345) + lu(348) = lu(348) - lu(289) * lu(345) + lu(349) = lu(349) - lu(290) * lu(345) + lu(350) = lu(350) - lu(291) * lu(345) + lu(351) = lu(351) - lu(292) * lu(345) + lu(352) = lu(352) - lu(293) * lu(345) + lu(353) = lu(353) - lu(294) * lu(345) + lu(354) = lu(354) - lu(295) * lu(345) + lu(355) = lu(355) - lu(296) * lu(345) + lu(356) = lu(356) - lu(297) * lu(345) + lu(357) = lu(357) - lu(298) * lu(345) + lu(371) = lu(371) - lu(287) * lu(370) + lu(372) = lu(372) - lu(288) * lu(370) + lu(373) = lu(373) - lu(289) * lu(370) + lu(374) = lu(374) - lu(290) * lu(370) + lu(375) = lu(375) - lu(291) * lu(370) + lu(376) = lu(376) - lu(292) * lu(370) + lu(377) = lu(377) - lu(293) * lu(370) + lu(378) = lu(378) - lu(294) * lu(370) + lu(379) = lu(379) - lu(295) * lu(370) + lu(380) = lu(380) - lu(296) * lu(370) + lu(381) = lu(381) - lu(297) * lu(370) + lu(382) = lu(382) - lu(298) * lu(370) + lu(394) = lu(394) - lu(287) * lu(393) + lu(395) = lu(395) - lu(288) * lu(393) + lu(396) = lu(396) - lu(289) * lu(393) + lu(397) = lu(397) - lu(290) * lu(393) + lu(398) = lu(398) - lu(291) * lu(393) + lu(399) = lu(399) - lu(292) * lu(393) + lu(400) = lu(400) - lu(293) * lu(393) + lu(401) = lu(401) - lu(294) * lu(393) + lu(402) = lu(402) - lu(295) * lu(393) + lu(403) = lu(403) - lu(296) * lu(393) + lu(404) = lu(404) - lu(297) * lu(393) + lu(405) = lu(405) - lu(298) * lu(393) + lu(415) = lu(415) - lu(287) * lu(414) + lu(416) = lu(416) - lu(288) * lu(414) + lu(417) = lu(417) - lu(289) * lu(414) + lu(418) = lu(418) - lu(290) * lu(414) + lu(419) = lu(419) - lu(291) * lu(414) + lu(420) = lu(420) - lu(292) * lu(414) + lu(421) = lu(421) - lu(293) * lu(414) + lu(422) = lu(422) - lu(294) * lu(414) + lu(423) = lu(423) - lu(295) * lu(414) + lu(424) = lu(424) - lu(296) * lu(414) + lu(425) = lu(425) - lu(297) * lu(414) + lu(426) = lu(426) - lu(298) * lu(414) + lu(445) = lu(445) - lu(287) * lu(444) + lu(446) = lu(446) - lu(288) * lu(444) + lu(447) = lu(447) - lu(289) * lu(444) + lu(448) = lu(448) - lu(290) * lu(444) + lu(449) = lu(449) - lu(291) * lu(444) + lu(450) = lu(450) - lu(292) * lu(444) + lu(451) = lu(451) - lu(293) * lu(444) + lu(452) = lu(452) - lu(294) * lu(444) + lu(453) = lu(453) - lu(295) * lu(444) + lu(454) = lu(454) - lu(296) * lu(444) + lu(455) = lu(455) - lu(297) * lu(444) + lu(456) = lu(456) - lu(298) * lu(444) + lu(464) = lu(464) - lu(287) * lu(463) + lu(465) = lu(465) - lu(288) * lu(463) + lu(466) = lu(466) - lu(289) * lu(463) + lu(467) = lu(467) - lu(290) * lu(463) + lu(468) = lu(468) - lu(291) * lu(463) + lu(469) = lu(469) - lu(292) * lu(463) + lu(470) = lu(470) - lu(293) * lu(463) + lu(471) = lu(471) - lu(294) * lu(463) + lu(472) = lu(472) - lu(295) * lu(463) + lu(473) = lu(473) - lu(296) * lu(463) + lu(474) = lu(474) - lu(297) * lu(463) + lu(475) = lu(475) - lu(298) * lu(463) + lu(483) = lu(483) - lu(287) * lu(482) + lu(484) = lu(484) - lu(288) * lu(482) + lu(485) = lu(485) - lu(289) * lu(482) + lu(486) = lu(486) - lu(290) * lu(482) + lu(487) = lu(487) - lu(291) * lu(482) + lu(488) = lu(488) - lu(292) * lu(482) + lu(489) = lu(489) - lu(293) * lu(482) + lu(490) = lu(490) - lu(294) * lu(482) + lu(491) = lu(491) - lu(295) * lu(482) + lu(492) = lu(492) - lu(296) * lu(482) + lu(493) = lu(493) - lu(297) * lu(482) + lu(494) = lu(494) - lu(298) * lu(482) + lu(502) = lu(502) - lu(287) * lu(501) + lu(503) = lu(503) - lu(288) * lu(501) + lu(504) = lu(504) - lu(289) * lu(501) + lu(505) = lu(505) - lu(290) * lu(501) + lu(506) = lu(506) - lu(291) * lu(501) + lu(507) = lu(507) - lu(292) * lu(501) + lu(508) = lu(508) - lu(293) * lu(501) + lu(509) = lu(509) - lu(294) * lu(501) + lu(510) = lu(510) - lu(295) * lu(501) + lu(511) = lu(511) - lu(296) * lu(501) + lu(512) = lu(512) - lu(297) * lu(501) + lu(513) = lu(513) - lu(298) * lu(501) + lu(526) = lu(526) - lu(287) * lu(525) + lu(527) = lu(527) - lu(288) * lu(525) + lu(528) = lu(528) - lu(289) * lu(525) + lu(529) = lu(529) - lu(290) * lu(525) + lu(530) = lu(530) - lu(291) * lu(525) + lu(531) = lu(531) - lu(292) * lu(525) + lu(532) = lu(532) - lu(293) * lu(525) + lu(533) = lu(533) - lu(294) * lu(525) + lu(534) = lu(534) - lu(295) * lu(525) + lu(535) = lu(535) - lu(296) * lu(525) + lu(536) = lu(536) - lu(297) * lu(525) + lu(537) = lu(537) - lu(298) * lu(525) + lu(547) = lu(547) - lu(287) * lu(546) + lu(548) = lu(548) - lu(288) * lu(546) + lu(549) = lu(549) - lu(289) * lu(546) + lu(550) = lu(550) - lu(290) * lu(546) + lu(551) = lu(551) - lu(291) * lu(546) + lu(552) = lu(552) - lu(292) * lu(546) + lu(553) = lu(553) - lu(293) * lu(546) + lu(554) = lu(554) - lu(294) * lu(546) + lu(555) = lu(555) - lu(295) * lu(546) + lu(556) = lu(556) - lu(296) * lu(546) + lu(557) = lu(557) - lu(297) * lu(546) + lu(558) = lu(558) - lu(298) * lu(546) + lu(577) = lu(577) - lu(287) * lu(576) + lu(578) = lu(578) - lu(288) * lu(576) + lu(579) = lu(579) - lu(289) * lu(576) + lu(580) = lu(580) - lu(290) * lu(576) + lu(581) = lu(581) - lu(291) * lu(576) + lu(582) = lu(582) - lu(292) * lu(576) + lu(583) = lu(583) - lu(293) * lu(576) + lu(584) = lu(584) - lu(294) * lu(576) + lu(585) = lu(585) - lu(295) * lu(576) + lu(586) = lu(586) - lu(296) * lu(576) + lu(587) = lu(587) - lu(297) * lu(576) + lu(588) = lu(588) - lu(298) * lu(576) + lu(308) = 1._r8 / lu(308) + lu(309) = lu(309) * lu(308) + lu(310) = lu(310) * lu(308) + lu(311) = lu(311) * lu(308) + lu(312) = lu(312) * lu(308) + lu(313) = lu(313) * lu(308) + lu(314) = lu(314) * lu(308) + lu(315) = lu(315) * lu(308) + lu(316) = lu(316) * lu(308) + lu(317) = lu(317) * lu(308) + lu(318) = lu(318) * lu(308) + lu(319) = lu(319) * lu(308) + lu(347) = lu(347) - lu(309) * lu(346) + lu(348) = lu(348) - lu(310) * lu(346) + lu(349) = lu(349) - lu(311) * lu(346) + lu(350) = lu(350) - lu(312) * lu(346) + lu(351) = lu(351) - lu(313) * lu(346) + lu(352) = lu(352) - lu(314) * lu(346) + lu(353) = lu(353) - lu(315) * lu(346) + lu(354) = lu(354) - lu(316) * lu(346) + lu(355) = lu(355) - lu(317) * lu(346) + lu(356) = lu(356) - lu(318) * lu(346) + lu(357) = lu(357) - lu(319) * lu(346) + lu(372) = lu(372) - lu(309) * lu(371) + lu(373) = lu(373) - lu(310) * lu(371) + lu(374) = lu(374) - lu(311) * lu(371) + lu(375) = lu(375) - lu(312) * lu(371) + lu(376) = lu(376) - lu(313) * lu(371) + lu(377) = lu(377) - lu(314) * lu(371) + lu(378) = lu(378) - lu(315) * lu(371) + lu(379) = lu(379) - lu(316) * lu(371) + lu(380) = lu(380) - lu(317) * lu(371) + lu(381) = lu(381) - lu(318) * lu(371) + lu(382) = lu(382) - lu(319) * lu(371) + lu(395) = lu(395) - lu(309) * lu(394) + lu(396) = lu(396) - lu(310) * lu(394) + lu(397) = lu(397) - lu(311) * lu(394) + lu(398) = lu(398) - lu(312) * lu(394) + lu(399) = lu(399) - lu(313) * lu(394) + lu(400) = lu(400) - lu(314) * lu(394) + lu(401) = lu(401) - lu(315) * lu(394) + lu(402) = lu(402) - lu(316) * lu(394) + lu(403) = lu(403) - lu(317) * lu(394) + lu(404) = lu(404) - lu(318) * lu(394) + lu(405) = lu(405) - lu(319) * lu(394) + lu(416) = lu(416) - lu(309) * lu(415) + lu(417) = lu(417) - lu(310) * lu(415) + lu(418) = lu(418) - lu(311) * lu(415) + lu(419) = lu(419) - lu(312) * lu(415) + lu(420) = lu(420) - lu(313) * lu(415) + lu(421) = lu(421) - lu(314) * lu(415) + lu(422) = lu(422) - lu(315) * lu(415) + lu(423) = lu(423) - lu(316) * lu(415) + lu(424) = lu(424) - lu(317) * lu(415) + lu(425) = lu(425) - lu(318) * lu(415) + lu(426) = lu(426) - lu(319) * lu(415) + lu(446) = lu(446) - lu(309) * lu(445) + lu(447) = lu(447) - lu(310) * lu(445) + lu(448) = lu(448) - lu(311) * lu(445) + lu(449) = lu(449) - lu(312) * lu(445) + lu(450) = lu(450) - lu(313) * lu(445) + lu(451) = lu(451) - lu(314) * lu(445) + lu(452) = lu(452) - lu(315) * lu(445) + lu(453) = lu(453) - lu(316) * lu(445) + lu(454) = lu(454) - lu(317) * lu(445) + lu(455) = lu(455) - lu(318) * lu(445) + lu(456) = lu(456) - lu(319) * lu(445) + lu(465) = lu(465) - lu(309) * lu(464) + lu(466) = lu(466) - lu(310) * lu(464) + lu(467) = lu(467) - lu(311) * lu(464) + lu(468) = lu(468) - lu(312) * lu(464) + lu(469) = lu(469) - lu(313) * lu(464) + lu(470) = lu(470) - lu(314) * lu(464) + lu(471) = lu(471) - lu(315) * lu(464) + lu(472) = lu(472) - lu(316) * lu(464) + lu(473) = lu(473) - lu(317) * lu(464) + lu(474) = lu(474) - lu(318) * lu(464) + lu(475) = lu(475) - lu(319) * lu(464) + lu(484) = lu(484) - lu(309) * lu(483) + lu(485) = lu(485) - lu(310) * lu(483) + lu(486) = lu(486) - lu(311) * lu(483) + lu(487) = lu(487) - lu(312) * lu(483) + lu(488) = lu(488) - lu(313) * lu(483) + lu(489) = lu(489) - lu(314) * lu(483) + lu(490) = lu(490) - lu(315) * lu(483) + lu(491) = lu(491) - lu(316) * lu(483) + lu(492) = lu(492) - lu(317) * lu(483) + lu(493) = lu(493) - lu(318) * lu(483) + lu(494) = lu(494) - lu(319) * lu(483) + lu(503) = lu(503) - lu(309) * lu(502) + lu(504) = lu(504) - lu(310) * lu(502) + lu(505) = lu(505) - lu(311) * lu(502) + lu(506) = lu(506) - lu(312) * lu(502) + lu(507) = lu(507) - lu(313) * lu(502) + lu(508) = lu(508) - lu(314) * lu(502) + lu(509) = lu(509) - lu(315) * lu(502) + lu(510) = lu(510) - lu(316) * lu(502) + lu(511) = lu(511) - lu(317) * lu(502) + lu(512) = lu(512) - lu(318) * lu(502) + lu(513) = lu(513) - lu(319) * lu(502) + lu(527) = lu(527) - lu(309) * lu(526) + lu(528) = lu(528) - lu(310) * lu(526) + lu(529) = lu(529) - lu(311) * lu(526) + lu(530) = lu(530) - lu(312) * lu(526) + lu(531) = lu(531) - lu(313) * lu(526) + lu(532) = lu(532) - lu(314) * lu(526) + lu(533) = lu(533) - lu(315) * lu(526) + lu(534) = lu(534) - lu(316) * lu(526) + lu(535) = lu(535) - lu(317) * lu(526) + lu(536) = lu(536) - lu(318) * lu(526) + lu(537) = lu(537) - lu(319) * lu(526) + lu(548) = lu(548) - lu(309) * lu(547) + lu(549) = lu(549) - lu(310) * lu(547) + lu(550) = lu(550) - lu(311) * lu(547) + lu(551) = lu(551) - lu(312) * lu(547) + lu(552) = lu(552) - lu(313) * lu(547) + lu(553) = lu(553) - lu(314) * lu(547) + lu(554) = lu(554) - lu(315) * lu(547) + lu(555) = lu(555) - lu(316) * lu(547) + lu(556) = lu(556) - lu(317) * lu(547) + lu(557) = lu(557) - lu(318) * lu(547) + lu(558) = lu(558) - lu(319) * lu(547) + lu(578) = lu(578) - lu(309) * lu(577) + lu(579) = lu(579) - lu(310) * lu(577) + lu(580) = lu(580) - lu(311) * lu(577) + lu(581) = lu(581) - lu(312) * lu(577) + lu(582) = lu(582) - lu(313) * lu(577) + lu(583) = lu(583) - lu(314) * lu(577) + lu(584) = lu(584) - lu(315) * lu(577) + lu(585) = lu(585) - lu(316) * lu(577) + lu(586) = lu(586) - lu(317) * lu(577) + lu(587) = lu(587) - lu(318) * lu(577) + lu(588) = lu(588) - lu(319) * lu(577) + lu(347) = 1._r8 / lu(347) + lu(348) = lu(348) * lu(347) + lu(349) = lu(349) * lu(347) + lu(350) = lu(350) * lu(347) + lu(351) = lu(351) * lu(347) + lu(352) = lu(352) * lu(347) + lu(353) = lu(353) * lu(347) + lu(354) = lu(354) * lu(347) + lu(355) = lu(355) * lu(347) + lu(356) = lu(356) * lu(347) + lu(357) = lu(357) * lu(347) + lu(373) = lu(373) - lu(348) * lu(372) + lu(374) = lu(374) - lu(349) * lu(372) + lu(375) = lu(375) - lu(350) * lu(372) + lu(376) = lu(376) - lu(351) * lu(372) + lu(377) = lu(377) - lu(352) * lu(372) + lu(378) = lu(378) - lu(353) * lu(372) + lu(379) = lu(379) - lu(354) * lu(372) + lu(380) = lu(380) - lu(355) * lu(372) + lu(381) = lu(381) - lu(356) * lu(372) + lu(382) = lu(382) - lu(357) * lu(372) + lu(396) = lu(396) - lu(348) * lu(395) + lu(397) = lu(397) - lu(349) * lu(395) + lu(398) = lu(398) - lu(350) * lu(395) + lu(399) = lu(399) - lu(351) * lu(395) + lu(400) = lu(400) - lu(352) * lu(395) + lu(401) = lu(401) - lu(353) * lu(395) + lu(402) = lu(402) - lu(354) * lu(395) + lu(403) = lu(403) - lu(355) * lu(395) + lu(404) = lu(404) - lu(356) * lu(395) + lu(405) = lu(405) - lu(357) * lu(395) + lu(417) = lu(417) - lu(348) * lu(416) + lu(418) = lu(418) - lu(349) * lu(416) + lu(419) = lu(419) - lu(350) * lu(416) + lu(420) = lu(420) - lu(351) * lu(416) + lu(421) = lu(421) - lu(352) * lu(416) + lu(422) = lu(422) - lu(353) * lu(416) + lu(423) = lu(423) - lu(354) * lu(416) + lu(424) = lu(424) - lu(355) * lu(416) + lu(425) = lu(425) - lu(356) * lu(416) + lu(426) = lu(426) - lu(357) * lu(416) + lu(447) = lu(447) - lu(348) * lu(446) + lu(448) = lu(448) - lu(349) * lu(446) + lu(449) = lu(449) - lu(350) * lu(446) + lu(450) = lu(450) - lu(351) * lu(446) + lu(451) = lu(451) - lu(352) * lu(446) + lu(452) = lu(452) - lu(353) * lu(446) + lu(453) = lu(453) - lu(354) * lu(446) + lu(454) = lu(454) - lu(355) * lu(446) + lu(455) = lu(455) - lu(356) * lu(446) + lu(456) = lu(456) - lu(357) * lu(446) + lu(466) = lu(466) - lu(348) * lu(465) + lu(467) = lu(467) - lu(349) * lu(465) + lu(468) = lu(468) - lu(350) * lu(465) + lu(469) = lu(469) - lu(351) * lu(465) + lu(470) = lu(470) - lu(352) * lu(465) + lu(471) = lu(471) - lu(353) * lu(465) + lu(472) = lu(472) - lu(354) * lu(465) + lu(473) = lu(473) - lu(355) * lu(465) + lu(474) = lu(474) - lu(356) * lu(465) + lu(475) = lu(475) - lu(357) * lu(465) + lu(485) = lu(485) - lu(348) * lu(484) + lu(486) = lu(486) - lu(349) * lu(484) + lu(487) = lu(487) - lu(350) * lu(484) + lu(488) = lu(488) - lu(351) * lu(484) + lu(489) = lu(489) - lu(352) * lu(484) + lu(490) = lu(490) - lu(353) * lu(484) + lu(491) = lu(491) - lu(354) * lu(484) + lu(492) = lu(492) - lu(355) * lu(484) + lu(493) = lu(493) - lu(356) * lu(484) + lu(494) = lu(494) - lu(357) * lu(484) + lu(504) = lu(504) - lu(348) * lu(503) + lu(505) = lu(505) - lu(349) * lu(503) + lu(506) = lu(506) - lu(350) * lu(503) + lu(507) = lu(507) - lu(351) * lu(503) + lu(508) = lu(508) - lu(352) * lu(503) + lu(509) = lu(509) - lu(353) * lu(503) + lu(510) = lu(510) - lu(354) * lu(503) + lu(511) = lu(511) - lu(355) * lu(503) + lu(512) = lu(512) - lu(356) * lu(503) + lu(513) = lu(513) - lu(357) * lu(503) + lu(528) = lu(528) - lu(348) * lu(527) + lu(529) = lu(529) - lu(349) * lu(527) + lu(530) = lu(530) - lu(350) * lu(527) + lu(531) = lu(531) - lu(351) * lu(527) + lu(532) = lu(532) - lu(352) * lu(527) + lu(533) = lu(533) - lu(353) * lu(527) + lu(534) = lu(534) - lu(354) * lu(527) + lu(535) = lu(535) - lu(355) * lu(527) + lu(536) = lu(536) - lu(356) * lu(527) + lu(537) = lu(537) - lu(357) * lu(527) + lu(549) = lu(549) - lu(348) * lu(548) + lu(550) = lu(550) - lu(349) * lu(548) + lu(551) = lu(551) - lu(350) * lu(548) + lu(552) = lu(552) - lu(351) * lu(548) + lu(553) = lu(553) - lu(352) * lu(548) + lu(554) = lu(554) - lu(353) * lu(548) + lu(555) = lu(555) - lu(354) * lu(548) + lu(556) = lu(556) - lu(355) * lu(548) + lu(557) = lu(557) - lu(356) * lu(548) + lu(558) = lu(558) - lu(357) * lu(548) + lu(579) = lu(579) - lu(348) * lu(578) + lu(580) = lu(580) - lu(349) * lu(578) + lu(581) = lu(581) - lu(350) * lu(578) + lu(582) = lu(582) - lu(351) * lu(578) + lu(583) = lu(583) - lu(352) * lu(578) + lu(584) = lu(584) - lu(353) * lu(578) + lu(585) = lu(585) - lu(354) * lu(578) + lu(586) = lu(586) - lu(355) * lu(578) + lu(587) = lu(587) - lu(356) * lu(578) + lu(588) = lu(588) - lu(357) * lu(578) + lu(373) = 1._r8 / lu(373) + lu(374) = lu(374) * lu(373) + lu(375) = lu(375) * lu(373) + lu(376) = lu(376) * lu(373) + lu(377) = lu(377) * lu(373) + lu(378) = lu(378) * lu(373) + lu(379) = lu(379) * lu(373) + lu(380) = lu(380) * lu(373) + lu(381) = lu(381) * lu(373) + lu(382) = lu(382) * lu(373) + lu(397) = lu(397) - lu(374) * lu(396) + lu(398) = lu(398) - lu(375) * lu(396) + lu(399) = lu(399) - lu(376) * lu(396) + lu(400) = lu(400) - lu(377) * lu(396) + lu(401) = lu(401) - lu(378) * lu(396) + lu(402) = lu(402) - lu(379) * lu(396) + lu(403) = lu(403) - lu(380) * lu(396) + lu(404) = lu(404) - lu(381) * lu(396) + lu(405) = lu(405) - lu(382) * lu(396) + lu(418) = lu(418) - lu(374) * lu(417) + lu(419) = lu(419) - lu(375) * lu(417) + lu(420) = lu(420) - lu(376) * lu(417) + lu(421) = lu(421) - lu(377) * lu(417) + lu(422) = lu(422) - lu(378) * lu(417) + lu(423) = lu(423) - lu(379) * lu(417) + lu(424) = lu(424) - lu(380) * lu(417) + lu(425) = lu(425) - lu(381) * lu(417) + lu(426) = lu(426) - lu(382) * lu(417) + lu(448) = lu(448) - lu(374) * lu(447) + lu(449) = lu(449) - lu(375) * lu(447) + lu(450) = lu(450) - lu(376) * lu(447) + lu(451) = lu(451) - lu(377) * lu(447) + lu(452) = lu(452) - lu(378) * lu(447) + lu(453) = lu(453) - lu(379) * lu(447) + lu(454) = lu(454) - lu(380) * lu(447) + lu(455) = lu(455) - lu(381) * lu(447) + lu(456) = lu(456) - lu(382) * lu(447) + lu(467) = lu(467) - lu(374) * lu(466) + lu(468) = lu(468) - lu(375) * lu(466) + lu(469) = lu(469) - lu(376) * lu(466) + lu(470) = lu(470) - lu(377) * lu(466) + lu(471) = lu(471) - lu(378) * lu(466) + lu(472) = lu(472) - lu(379) * lu(466) + lu(473) = lu(473) - lu(380) * lu(466) + lu(474) = lu(474) - lu(381) * lu(466) + lu(475) = lu(475) - lu(382) * lu(466) + lu(486) = lu(486) - lu(374) * lu(485) + lu(487) = lu(487) - lu(375) * lu(485) + lu(488) = lu(488) - lu(376) * lu(485) + lu(489) = lu(489) - lu(377) * lu(485) + lu(490) = lu(490) - lu(378) * lu(485) + lu(491) = lu(491) - lu(379) * lu(485) + lu(492) = lu(492) - lu(380) * lu(485) + lu(493) = lu(493) - lu(381) * lu(485) + lu(494) = lu(494) - lu(382) * lu(485) + lu(505) = lu(505) - lu(374) * lu(504) + lu(506) = lu(506) - lu(375) * lu(504) + lu(507) = lu(507) - lu(376) * lu(504) + lu(508) = lu(508) - lu(377) * lu(504) + lu(509) = lu(509) - lu(378) * lu(504) + lu(510) = lu(510) - lu(379) * lu(504) + lu(511) = lu(511) - lu(380) * lu(504) + lu(512) = lu(512) - lu(381) * lu(504) + lu(513) = lu(513) - lu(382) * lu(504) + lu(529) = lu(529) - lu(374) * lu(528) + lu(530) = lu(530) - lu(375) * lu(528) + lu(531) = lu(531) - lu(376) * lu(528) + lu(532) = lu(532) - lu(377) * lu(528) + lu(533) = lu(533) - lu(378) * lu(528) + lu(534) = lu(534) - lu(379) * lu(528) + lu(535) = lu(535) - lu(380) * lu(528) + lu(536) = lu(536) - lu(381) * lu(528) + lu(537) = lu(537) - lu(382) * lu(528) + lu(550) = lu(550) - lu(374) * lu(549) + lu(551) = lu(551) - lu(375) * lu(549) + lu(552) = lu(552) - lu(376) * lu(549) + lu(553) = lu(553) - lu(377) * lu(549) + lu(554) = lu(554) - lu(378) * lu(549) + lu(555) = lu(555) - lu(379) * lu(549) + lu(556) = lu(556) - lu(380) * lu(549) + lu(557) = lu(557) - lu(381) * lu(549) + lu(558) = lu(558) - lu(382) * lu(549) + lu(580) = lu(580) - lu(374) * lu(579) + lu(581) = lu(581) - lu(375) * lu(579) + lu(582) = lu(582) - lu(376) * lu(579) + lu(583) = lu(583) - lu(377) * lu(579) + lu(584) = lu(584) - lu(378) * lu(579) + lu(585) = lu(585) - lu(379) * lu(579) + lu(586) = lu(586) - lu(380) * lu(579) + lu(587) = lu(587) - lu(381) * lu(579) + lu(588) = lu(588) - lu(382) * lu(579) + lu(397) = 1._r8 / lu(397) + lu(398) = lu(398) * lu(397) + lu(399) = lu(399) * lu(397) + lu(400) = lu(400) * lu(397) + lu(401) = lu(401) * lu(397) + lu(402) = lu(402) * lu(397) + lu(403) = lu(403) * lu(397) + lu(404) = lu(404) * lu(397) + lu(405) = lu(405) * lu(397) + lu(419) = lu(419) - lu(398) * lu(418) + lu(420) = lu(420) - lu(399) * lu(418) + lu(421) = lu(421) - lu(400) * lu(418) + lu(422) = lu(422) - lu(401) * lu(418) + lu(423) = lu(423) - lu(402) * lu(418) + lu(424) = lu(424) - lu(403) * lu(418) + lu(425) = lu(425) - lu(404) * lu(418) + lu(426) = lu(426) - lu(405) * lu(418) + lu(449) = lu(449) - lu(398) * lu(448) + lu(450) = lu(450) - lu(399) * lu(448) + lu(451) = lu(451) - lu(400) * lu(448) + lu(452) = lu(452) - lu(401) * lu(448) + lu(453) = lu(453) - lu(402) * lu(448) + lu(454) = lu(454) - lu(403) * lu(448) + lu(455) = lu(455) - lu(404) * lu(448) + lu(456) = lu(456) - lu(405) * lu(448) + lu(468) = lu(468) - lu(398) * lu(467) + lu(469) = lu(469) - lu(399) * lu(467) + lu(470) = lu(470) - lu(400) * lu(467) + lu(471) = lu(471) - lu(401) * lu(467) + lu(472) = lu(472) - lu(402) * lu(467) + lu(473) = lu(473) - lu(403) * lu(467) + lu(474) = lu(474) - lu(404) * lu(467) + lu(475) = lu(475) - lu(405) * lu(467) + lu(487) = lu(487) - lu(398) * lu(486) + lu(488) = lu(488) - lu(399) * lu(486) + lu(489) = lu(489) - lu(400) * lu(486) + lu(490) = lu(490) - lu(401) * lu(486) + lu(491) = lu(491) - lu(402) * lu(486) + lu(492) = lu(492) - lu(403) * lu(486) + lu(493) = lu(493) - lu(404) * lu(486) + lu(494) = lu(494) - lu(405) * lu(486) + lu(506) = lu(506) - lu(398) * lu(505) + lu(507) = lu(507) - lu(399) * lu(505) + lu(508) = lu(508) - lu(400) * lu(505) + lu(509) = lu(509) - lu(401) * lu(505) + lu(510) = lu(510) - lu(402) * lu(505) + lu(511) = lu(511) - lu(403) * lu(505) + lu(512) = lu(512) - lu(404) * lu(505) + lu(513) = lu(513) - lu(405) * lu(505) + lu(530) = lu(530) - lu(398) * lu(529) + lu(531) = lu(531) - lu(399) * lu(529) + lu(532) = lu(532) - lu(400) * lu(529) + lu(533) = lu(533) - lu(401) * lu(529) + lu(534) = lu(534) - lu(402) * lu(529) + lu(535) = lu(535) - lu(403) * lu(529) + lu(536) = lu(536) - lu(404) * lu(529) + lu(537) = lu(537) - lu(405) * lu(529) + lu(551) = lu(551) - lu(398) * lu(550) + lu(552) = lu(552) - lu(399) * lu(550) + lu(553) = lu(553) - lu(400) * lu(550) + lu(554) = lu(554) - lu(401) * lu(550) + lu(555) = lu(555) - lu(402) * lu(550) + lu(556) = lu(556) - lu(403) * lu(550) + lu(557) = lu(557) - lu(404) * lu(550) + lu(558) = lu(558) - lu(405) * lu(550) + lu(581) = lu(581) - lu(398) * lu(580) + lu(582) = lu(582) - lu(399) * lu(580) + lu(583) = lu(583) - lu(400) * lu(580) + lu(584) = lu(584) - lu(401) * lu(580) + lu(585) = lu(585) - lu(402) * lu(580) + lu(586) = lu(586) - lu(403) * lu(580) + lu(587) = lu(587) - lu(404) * lu(580) + lu(588) = lu(588) - lu(405) * lu(580) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(419) = 1._r8 / lu(419) + lu(420) = lu(420) * lu(419) + lu(421) = lu(421) * lu(419) + lu(422) = lu(422) * lu(419) + lu(423) = lu(423) * lu(419) + lu(424) = lu(424) * lu(419) + lu(425) = lu(425) * lu(419) + lu(426) = lu(426) * lu(419) + lu(450) = lu(450) - lu(420) * lu(449) + lu(451) = lu(451) - lu(421) * lu(449) + lu(452) = lu(452) - lu(422) * lu(449) + lu(453) = lu(453) - lu(423) * lu(449) + lu(454) = lu(454) - lu(424) * lu(449) + lu(455) = lu(455) - lu(425) * lu(449) + lu(456) = lu(456) - lu(426) * lu(449) + lu(469) = lu(469) - lu(420) * lu(468) + lu(470) = lu(470) - lu(421) * lu(468) + lu(471) = lu(471) - lu(422) * lu(468) + lu(472) = lu(472) - lu(423) * lu(468) + lu(473) = lu(473) - lu(424) * lu(468) + lu(474) = lu(474) - lu(425) * lu(468) + lu(475) = lu(475) - lu(426) * lu(468) + lu(488) = lu(488) - lu(420) * lu(487) + lu(489) = lu(489) - lu(421) * lu(487) + lu(490) = lu(490) - lu(422) * lu(487) + lu(491) = lu(491) - lu(423) * lu(487) + lu(492) = lu(492) - lu(424) * lu(487) + lu(493) = lu(493) - lu(425) * lu(487) + lu(494) = lu(494) - lu(426) * lu(487) + lu(507) = lu(507) - lu(420) * lu(506) + lu(508) = lu(508) - lu(421) * lu(506) + lu(509) = lu(509) - lu(422) * lu(506) + lu(510) = lu(510) - lu(423) * lu(506) + lu(511) = lu(511) - lu(424) * lu(506) + lu(512) = lu(512) - lu(425) * lu(506) + lu(513) = lu(513) - lu(426) * lu(506) + lu(531) = lu(531) - lu(420) * lu(530) + lu(532) = lu(532) - lu(421) * lu(530) + lu(533) = lu(533) - lu(422) * lu(530) + lu(534) = lu(534) - lu(423) * lu(530) + lu(535) = lu(535) - lu(424) * lu(530) + lu(536) = lu(536) - lu(425) * lu(530) + lu(537) = lu(537) - lu(426) * lu(530) + lu(552) = lu(552) - lu(420) * lu(551) + lu(553) = lu(553) - lu(421) * lu(551) + lu(554) = lu(554) - lu(422) * lu(551) + lu(555) = lu(555) - lu(423) * lu(551) + lu(556) = lu(556) - lu(424) * lu(551) + lu(557) = lu(557) - lu(425) * lu(551) + lu(558) = lu(558) - lu(426) * lu(551) + lu(582) = lu(582) - lu(420) * lu(581) + lu(583) = lu(583) - lu(421) * lu(581) + lu(584) = lu(584) - lu(422) * lu(581) + lu(585) = lu(585) - lu(423) * lu(581) + lu(586) = lu(586) - lu(424) * lu(581) + lu(587) = lu(587) - lu(425) * lu(581) + lu(588) = lu(588) - lu(426) * lu(581) + lu(450) = 1._r8 / lu(450) + lu(451) = lu(451) * lu(450) + lu(452) = lu(452) * lu(450) + lu(453) = lu(453) * lu(450) + lu(454) = lu(454) * lu(450) + lu(455) = lu(455) * lu(450) + lu(456) = lu(456) * lu(450) + lu(470) = lu(470) - lu(451) * lu(469) + lu(471) = lu(471) - lu(452) * lu(469) + lu(472) = lu(472) - lu(453) * lu(469) + lu(473) = lu(473) - lu(454) * lu(469) + lu(474) = lu(474) - lu(455) * lu(469) + lu(475) = lu(475) - lu(456) * lu(469) + lu(489) = lu(489) - lu(451) * lu(488) + lu(490) = lu(490) - lu(452) * lu(488) + lu(491) = lu(491) - lu(453) * lu(488) + lu(492) = lu(492) - lu(454) * lu(488) + lu(493) = lu(493) - lu(455) * lu(488) + lu(494) = lu(494) - lu(456) * lu(488) + lu(508) = lu(508) - lu(451) * lu(507) + lu(509) = lu(509) - lu(452) * lu(507) + lu(510) = lu(510) - lu(453) * lu(507) + lu(511) = lu(511) - lu(454) * lu(507) + lu(512) = lu(512) - lu(455) * lu(507) + lu(513) = lu(513) - lu(456) * lu(507) + lu(532) = lu(532) - lu(451) * lu(531) + lu(533) = lu(533) - lu(452) * lu(531) + lu(534) = lu(534) - lu(453) * lu(531) + lu(535) = lu(535) - lu(454) * lu(531) + lu(536) = lu(536) - lu(455) * lu(531) + lu(537) = lu(537) - lu(456) * lu(531) + lu(553) = lu(553) - lu(451) * lu(552) + lu(554) = lu(554) - lu(452) * lu(552) + lu(555) = lu(555) - lu(453) * lu(552) + lu(556) = lu(556) - lu(454) * lu(552) + lu(557) = lu(557) - lu(455) * lu(552) + lu(558) = lu(558) - lu(456) * lu(552) + lu(583) = lu(583) - lu(451) * lu(582) + lu(584) = lu(584) - lu(452) * lu(582) + lu(585) = lu(585) - lu(453) * lu(582) + lu(586) = lu(586) - lu(454) * lu(582) + lu(587) = lu(587) - lu(455) * lu(582) + lu(588) = lu(588) - lu(456) * lu(582) + lu(470) = 1._r8 / lu(470) + lu(471) = lu(471) * lu(470) + lu(472) = lu(472) * lu(470) + lu(473) = lu(473) * lu(470) + lu(474) = lu(474) * lu(470) + lu(475) = lu(475) * lu(470) + lu(490) = lu(490) - lu(471) * lu(489) + lu(491) = lu(491) - lu(472) * lu(489) + lu(492) = lu(492) - lu(473) * lu(489) + lu(493) = lu(493) - lu(474) * lu(489) + lu(494) = lu(494) - lu(475) * lu(489) + lu(509) = lu(509) - lu(471) * lu(508) + lu(510) = lu(510) - lu(472) * lu(508) + lu(511) = lu(511) - lu(473) * lu(508) + lu(512) = lu(512) - lu(474) * lu(508) + lu(513) = lu(513) - lu(475) * lu(508) + lu(533) = lu(533) - lu(471) * lu(532) + lu(534) = lu(534) - lu(472) * lu(532) + lu(535) = lu(535) - lu(473) * lu(532) + lu(536) = lu(536) - lu(474) * lu(532) + lu(537) = lu(537) - lu(475) * lu(532) + lu(554) = lu(554) - lu(471) * lu(553) + lu(555) = lu(555) - lu(472) * lu(553) + lu(556) = lu(556) - lu(473) * lu(553) + lu(557) = lu(557) - lu(474) * lu(553) + lu(558) = lu(558) - lu(475) * lu(553) + lu(584) = lu(584) - lu(471) * lu(583) + lu(585) = lu(585) - lu(472) * lu(583) + lu(586) = lu(586) - lu(473) * lu(583) + lu(587) = lu(587) - lu(474) * lu(583) + lu(588) = lu(588) - lu(475) * lu(583) + lu(490) = 1._r8 / lu(490) + lu(491) = lu(491) * lu(490) + lu(492) = lu(492) * lu(490) + lu(493) = lu(493) * lu(490) + lu(494) = lu(494) * lu(490) + lu(510) = lu(510) - lu(491) * lu(509) + lu(511) = lu(511) - lu(492) * lu(509) + lu(512) = lu(512) - lu(493) * lu(509) + lu(513) = lu(513) - lu(494) * lu(509) + lu(534) = lu(534) - lu(491) * lu(533) + lu(535) = lu(535) - lu(492) * lu(533) + lu(536) = lu(536) - lu(493) * lu(533) + lu(537) = lu(537) - lu(494) * lu(533) + lu(555) = lu(555) - lu(491) * lu(554) + lu(556) = lu(556) - lu(492) * lu(554) + lu(557) = lu(557) - lu(493) * lu(554) + lu(558) = lu(558) - lu(494) * lu(554) + lu(585) = lu(585) - lu(491) * lu(584) + lu(586) = lu(586) - lu(492) * lu(584) + lu(587) = lu(587) - lu(493) * lu(584) + lu(588) = lu(588) - lu(494) * lu(584) + lu(510) = 1._r8 / lu(510) + lu(511) = lu(511) * lu(510) + lu(512) = lu(512) * lu(510) + lu(513) = lu(513) * lu(510) + lu(535) = lu(535) - lu(511) * lu(534) + lu(536) = lu(536) - lu(512) * lu(534) + lu(537) = lu(537) - lu(513) * lu(534) + lu(556) = lu(556) - lu(511) * lu(555) + lu(557) = lu(557) - lu(512) * lu(555) + lu(558) = lu(558) - lu(513) * lu(555) + lu(586) = lu(586) - lu(511) * lu(585) + lu(587) = lu(587) - lu(512) * lu(585) + lu(588) = lu(588) - lu(513) * lu(585) + lu(535) = 1._r8 / lu(535) + lu(536) = lu(536) * lu(535) + lu(537) = lu(537) * lu(535) + lu(557) = lu(557) - lu(536) * lu(556) + lu(558) = lu(558) - lu(537) * lu(556) + lu(587) = lu(587) - lu(536) * lu(586) + lu(588) = lu(588) - lu(537) * lu(586) + lu(557) = 1._r8 / lu(557) + lu(558) = lu(558) * lu(557) + lu(588) = lu(588) - lu(558) * lu(587) + lu(588) = 1._r8 / lu(588) + end subroutine lu_fac08 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_lu_solve.F90 new file mode 100644 index 0000000000..89816e71cf --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_lu_solve.F90 @@ -0,0 +1,674 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(37) = b(37) - lu(2) * b(1) + b(48) = b(48) - lu(3) * b(1) + b(49) = b(49) - lu(5) * b(2) + b(49) = b(49) - lu(8) * b(3) + b(7) = b(7) - lu(10) * b(4) + b(44) = b(44) - lu(11) * b(4) + b(48) = b(48) - lu(13) * b(5) + b(35) = b(35) - lu(15) * b(6) + b(48) = b(48) - lu(16) * b(6) + b(31) = b(31) - lu(19) * b(7) + b(39) = b(39) - lu(20) * b(7) + b(44) = b(44) - lu(21) * b(7) + b(22) = b(22) - lu(23) * b(8) + b(33) = b(33) - lu(24) * b(8) + b(38) = b(38) - lu(25) * b(8) + b(39) = b(39) - lu(26) * b(8) + b(40) = b(40) - lu(27) * b(8) + b(31) = b(31) - lu(29) * b(9) + b(34) = b(34) - lu(30) * b(9) + b(37) = b(37) - lu(31) * b(9) + b(39) = b(39) - lu(32) * b(9) + b(21) = b(21) - lu(34) * b(10) + b(31) = b(31) - lu(35) * b(10) + b(32) = b(32) - lu(36) * b(10) + b(34) = b(34) - lu(37) * b(10) + b(39) = b(39) - lu(38) * b(10) + b(43) = b(43) - lu(39) * b(10) + b(28) = b(28) - lu(41) * b(11) + b(32) = b(32) - lu(42) * b(11) + b(43) = b(43) - lu(43) * b(11) + b(44) = b(44) - lu(44) * b(11) + b(46) = b(46) - lu(45) * b(11) + b(31) = b(31) - lu(48) * b(12) + b(39) = b(39) - lu(49) * b(12) + b(44) = b(44) - lu(50) * b(12) + b(47) = b(47) - lu(51) * b(12) + b(49) = b(49) - lu(52) * b(12) + b(33) = b(33) - lu(54) * b(13) + b(40) = b(40) - lu(55) * b(13) + b(43) = b(43) - lu(56) * b(13) + b(44) = b(44) - lu(57) * b(13) + b(47) = b(47) - lu(58) * b(13) + b(49) = b(49) - lu(59) * b(13) + b(15) = b(15) - lu(61) * b(14) + b(24) = b(24) - lu(62) * b(14) + b(25) = b(25) - lu(63) * b(14) + b(27) = b(27) - lu(64) * b(14) + b(39) = b(39) - lu(65) * b(14) + b(49) = b(49) - lu(66) * b(14) + b(24) = b(24) - lu(68) * b(15) + b(25) = b(25) - lu(69) * b(15) + b(27) = b(27) - lu(70) * b(15) + b(39) = b(39) - lu(71) * b(15) + b(49) = b(49) - lu(72) * b(15) + b(27) = b(27) - lu(74) * b(16) + b(38) = b(38) - lu(75) * b(16) + b(45) = b(45) - lu(76) * b(16) + b(49) = b(49) - lu(77) * b(16) + b(22) = b(22) - lu(79) * b(17) + b(23) = b(23) - lu(80) * b(17) + b(33) = b(33) - lu(81) * b(17) + b(35) = b(35) - lu(82) * b(17) + b(39) = b(39) - lu(83) * b(17) + b(40) = b(40) - lu(84) * b(17) + b(41) = b(41) - lu(85) * b(17) + b(36) = b(36) - lu(87) * b(18) + b(39) = b(39) - lu(88) * b(18) + b(43) = b(43) - lu(89) * b(18) + b(44) = b(44) - lu(90) * b(18) + b(47) = b(47) - lu(91) * b(18) + b(48) = b(48) - lu(92) * b(18) + b(24) = b(24) - lu(96) * b(19) + b(25) = b(25) - lu(97) * b(19) + b(26) = b(26) - lu(98) * b(19) + b(27) = b(27) - lu(99) * b(19) + b(38) = b(38) - lu(100) * b(19) + b(39) = b(39) - lu(101) * b(19) + b(45) = b(45) - lu(102) * b(19) + b(49) = b(49) - lu(103) * b(19) + b(35) = b(35) - lu(105) * b(20) + b(39) = b(39) - lu(106) * b(20) + b(43) = b(43) - lu(107) * b(20) + b(44) = b(44) - lu(108) * b(20) + b(45) = b(45) - lu(109) * b(20) + b(32) = b(32) - lu(111) * b(21) + b(34) = b(34) - lu(112) * b(21) + b(39) = b(39) - lu(113) * b(21) + b(42) = b(42) - lu(114) * b(21) + b(43) = b(43) - lu(115) * b(21) + b(49) = b(49) - lu(116) * b(21) + b(33) = b(33) - lu(118) * b(22) + b(40) = b(40) - lu(119) * b(22) + b(43) = b(43) - lu(120) * b(22) + b(44) = b(44) - lu(121) * b(22) + b(35) = b(35) - lu(124) * b(23) + b(36) = b(36) - lu(125) * b(23) + b(39) = b(39) - lu(126) * b(23) + b(41) = b(41) - lu(127) * b(23) + b(43) = b(43) - lu(128) * b(23) + b(44) = b(44) - lu(129) * b(23) + b(48) = b(48) - lu(130) * b(23) + b(25) = b(25) - lu(132) * b(24) + b(26) = b(26) - lu(133) * b(24) + b(27) = b(27) - lu(134) * b(24) + b(38) = b(38) - lu(135) * b(24) + b(39) = b(39) - lu(136) * b(24) + b(45) = b(45) - lu(137) * b(24) + b(49) = b(49) - lu(138) * b(24) + b(26) = b(26) - lu(141) * b(25) + b(27) = b(27) - lu(142) * b(25) + b(38) = b(38) - lu(143) * b(25) + b(39) = b(39) - lu(144) * b(25) + b(45) = b(45) - lu(145) * b(25) + b(49) = b(49) - lu(146) * b(25) + b(27) = b(27) - lu(152) * b(26) + b(38) = b(38) - lu(153) * b(26) + b(39) = b(39) - lu(154) * b(26) + b(45) = b(45) - lu(155) * b(26) + b(49) = b(49) - lu(156) * b(26) + b(38) = b(38) - lu(163) * b(27) + b(39) = b(39) - lu(164) * b(27) + b(40) = b(40) - lu(165) * b(27) + b(45) = b(45) - lu(166) * b(27) + b(49) = b(49) - lu(167) * b(27) + b(32) = b(32) - lu(170) * b(28) + b(38) = b(38) - lu(171) * b(28) + b(40) = b(40) - lu(172) * b(28) + b(43) = b(43) - lu(173) * b(28) + b(44) = b(44) - lu(174) * b(28) + b(46) = b(46) - lu(175) * b(28) + b(47) = b(47) - lu(176) * b(28) + b(49) = b(49) - lu(177) * b(28) + b(36) = b(36) - lu(180) * b(29) + b(37) = b(37) - lu(181) * b(29) + b(39) = b(39) - lu(182) * b(29) + b(43) = b(43) - lu(183) * b(29) + b(44) = b(44) - lu(184) * b(29) + b(48) = b(48) - lu(185) * b(29) + b(33) = b(33) - lu(190) * b(30) + b(36) = b(36) - lu(191) * b(30) + b(37) = b(37) - lu(192) * b(30) + b(39) = b(39) - lu(193) * b(30) + b(40) = b(40) - lu(194) * b(30) + b(43) = b(43) - lu(195) * b(30) + b(44) = b(44) - lu(196) * b(30) + b(48) = b(48) - lu(197) * b(30) + b(34) = b(34) - lu(200) * b(31) + b(39) = b(39) - lu(201) * b(31) + b(43) = b(43) - lu(202) * b(31) + b(44) = b(44) - lu(203) * b(31) + b(47) = b(47) - lu(204) * b(31) + b(49) = b(49) - lu(205) * b(31) + b(39) = b(39) - lu(207) * b(32) + b(42) = b(42) - lu(208) * b(32) + b(43) = b(43) - lu(209) * b(32) + b(44) = b(44) - lu(210) * b(32) + b(47) = b(47) - lu(211) * b(32) + b(49) = b(49) - lu(212) * b(32) + b(38) = b(38) - lu(216) * b(33) + b(39) = b(39) - lu(217) * b(33) + b(40) = b(40) - lu(218) * b(33) + b(43) = b(43) - lu(219) * b(33) + b(44) = b(44) - lu(220) * b(33) + b(46) = b(46) - lu(221) * b(33) + b(47) = b(47) - lu(222) * b(33) + b(49) = b(49) - lu(223) * b(33) + b(35) = b(35) - lu(229) * b(34) + b(37) = b(37) - lu(230) * b(34) + b(38) = b(38) - lu(231) * b(34) + b(39) = b(39) - lu(232) * b(34) + b(40) = b(40) - lu(233) * b(34) + b(41) = b(41) - lu(234) * b(34) + b(42) = b(42) - lu(235) * b(34) + b(43) = b(43) - lu(236) * b(34) + b(44) = b(44) - lu(237) * b(34) + b(47) = b(47) - lu(238) * b(34) + b(48) = b(48) - lu(239) * b(34) + b(49) = b(49) - lu(240) * b(34) + b(39) = b(39) - lu(243) * b(35) + b(41) = b(41) - lu(244) * b(35) + b(42) = b(42) - lu(245) * b(35) + b(43) = b(43) - lu(246) * b(35) + b(44) = b(44) - lu(247) * b(35) + b(45) = b(45) - lu(248) * b(35) + b(46) = b(46) - lu(249) * b(35) + b(47) = b(47) - lu(250) * b(35) + b(49) = b(49) - lu(251) * b(35) + b(37) = b(37) - lu(262) * b(36) + b(38) = b(38) - lu(263) * b(36) + b(39) = b(39) - lu(264) * b(36) + b(40) = b(40) - lu(265) * b(36) + b(41) = b(41) - lu(266) * b(36) + b(42) = b(42) - lu(267) * b(36) + b(43) = b(43) - lu(268) * b(36) + b(44) = b(44) - lu(269) * b(36) + b(45) = b(45) - lu(270) * b(36) + b(46) = b(46) - lu(271) * b(36) + b(47) = b(47) - lu(272) * b(36) + b(48) = b(48) - lu(273) * b(36) + b(49) = b(49) - lu(274) * b(36) + b(38) = b(38) - lu(287) * b(37) + b(39) = b(39) - lu(288) * b(37) + b(40) = b(40) - lu(289) * b(37) + b(41) = b(41) - lu(290) * b(37) + b(42) = b(42) - lu(291) * b(37) + b(43) = b(43) - lu(292) * b(37) + b(44) = b(44) - lu(293) * b(37) + b(45) = b(45) - lu(294) * b(37) + b(46) = b(46) - lu(295) * b(37) + b(47) = b(47) - lu(296) * b(37) + b(48) = b(48) - lu(297) * b(37) + b(49) = b(49) - lu(298) * b(37) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(39) = b(39) - lu(309) * b(38) + b(40) = b(40) - lu(310) * b(38) + b(41) = b(41) - lu(311) * b(38) + b(42) = b(42) - lu(312) * b(38) + b(43) = b(43) - lu(313) * b(38) + b(44) = b(44) - lu(314) * b(38) + b(45) = b(45) - lu(315) * b(38) + b(46) = b(46) - lu(316) * b(38) + b(47) = b(47) - lu(317) * b(38) + b(48) = b(48) - lu(318) * b(38) + b(49) = b(49) - lu(319) * b(38) + b(40) = b(40) - lu(348) * b(39) + b(41) = b(41) - lu(349) * b(39) + b(42) = b(42) - lu(350) * b(39) + b(43) = b(43) - lu(351) * b(39) + b(44) = b(44) - lu(352) * b(39) + b(45) = b(45) - lu(353) * b(39) + b(46) = b(46) - lu(354) * b(39) + b(47) = b(47) - lu(355) * b(39) + b(48) = b(48) - lu(356) * b(39) + b(49) = b(49) - lu(357) * b(39) + b(41) = b(41) - lu(374) * b(40) + b(42) = b(42) - lu(375) * b(40) + b(43) = b(43) - lu(376) * b(40) + b(44) = b(44) - lu(377) * b(40) + b(45) = b(45) - lu(378) * b(40) + b(46) = b(46) - lu(379) * b(40) + b(47) = b(47) - lu(380) * b(40) + b(48) = b(48) - lu(381) * b(40) + b(49) = b(49) - lu(382) * b(40) + b(42) = b(42) - lu(398) * b(41) + b(43) = b(43) - lu(399) * b(41) + b(44) = b(44) - lu(400) * b(41) + b(45) = b(45) - lu(401) * b(41) + b(46) = b(46) - lu(402) * b(41) + b(47) = b(47) - lu(403) * b(41) + b(48) = b(48) - lu(404) * b(41) + b(49) = b(49) - lu(405) * b(41) + b(43) = b(43) - lu(420) * b(42) + b(44) = b(44) - lu(421) * b(42) + b(45) = b(45) - lu(422) * b(42) + b(46) = b(46) - lu(423) * b(42) + b(47) = b(47) - lu(424) * b(42) + b(48) = b(48) - lu(425) * b(42) + b(49) = b(49) - lu(426) * b(42) + b(44) = b(44) - lu(451) * b(43) + b(45) = b(45) - lu(452) * b(43) + b(46) = b(46) - lu(453) * b(43) + b(47) = b(47) - lu(454) * b(43) + b(48) = b(48) - lu(455) * b(43) + b(49) = b(49) - lu(456) * b(43) + b(45) = b(45) - lu(471) * b(44) + b(46) = b(46) - lu(472) * b(44) + b(47) = b(47) - lu(473) * b(44) + b(48) = b(48) - lu(474) * b(44) + b(49) = b(49) - lu(475) * b(44) + b(46) = b(46) - lu(491) * b(45) + b(47) = b(47) - lu(492) * b(45) + b(48) = b(48) - lu(493) * b(45) + b(49) = b(49) - lu(494) * b(45) + b(47) = b(47) - lu(511) * b(46) + b(48) = b(48) - lu(512) * b(46) + b(49) = b(49) - lu(513) * b(46) + b(48) = b(48) - lu(536) * b(47) + b(49) = b(49) - lu(537) * b(47) + b(49) = b(49) - lu(558) * b(48) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(49) = b(49) * lu(588) + b(48) = b(48) - lu(587) * b(49) + b(47) = b(47) - lu(586) * b(49) + b(46) = b(46) - lu(585) * b(49) + b(45) = b(45) - lu(584) * b(49) + b(44) = b(44) - lu(583) * b(49) + b(43) = b(43) - lu(582) * b(49) + b(42) = b(42) - lu(581) * b(49) + b(41) = b(41) - lu(580) * b(49) + b(40) = b(40) - lu(579) * b(49) + b(39) = b(39) - lu(578) * b(49) + b(38) = b(38) - lu(577) * b(49) + b(37) = b(37) - lu(576) * b(49) + b(35) = b(35) - lu(575) * b(49) + b(34) = b(34) - lu(574) * b(49) + b(32) = b(32) - lu(573) * b(49) + b(31) = b(31) - lu(572) * b(49) + b(27) = b(27) - lu(571) * b(49) + b(26) = b(26) - lu(570) * b(49) + b(25) = b(25) - lu(569) * b(49) + b(24) = b(24) - lu(568) * b(49) + b(21) = b(21) - lu(567) * b(49) + b(19) = b(19) - lu(566) * b(49) + b(16) = b(16) - lu(565) * b(49) + b(15) = b(15) - lu(564) * b(49) + b(14) = b(14) - lu(563) * b(49) + b(12) = b(12) - lu(562) * b(49) + b(7) = b(7) - lu(561) * b(49) + b(3) = b(3) - lu(560) * b(49) + b(2) = b(2) - lu(559) * b(49) + b(48) = b(48) * lu(557) + b(47) = b(47) - lu(556) * b(48) + b(46) = b(46) - lu(555) * b(48) + b(45) = b(45) - lu(554) * b(48) + b(44) = b(44) - lu(553) * b(48) + b(43) = b(43) - lu(552) * b(48) + b(42) = b(42) - lu(551) * b(48) + b(41) = b(41) - lu(550) * b(48) + b(40) = b(40) - lu(549) * b(48) + b(39) = b(39) - lu(548) * b(48) + b(38) = b(38) - lu(547) * b(48) + b(37) = b(37) - lu(546) * b(48) + b(36) = b(36) - lu(545) * b(48) + b(33) = b(33) - lu(544) * b(48) + b(32) = b(32) - lu(543) * b(48) + b(30) = b(30) - lu(542) * b(48) + b(29) = b(29) - lu(541) * b(48) + b(28) = b(28) - lu(540) * b(48) + b(18) = b(18) - lu(539) * b(48) + b(5) = b(5) - lu(538) * b(48) + b(47) = b(47) * lu(535) + b(46) = b(46) - lu(534) * b(47) + b(45) = b(45) - lu(533) * b(47) + b(44) = b(44) - lu(532) * b(47) + b(43) = b(43) - lu(531) * b(47) + b(42) = b(42) - lu(530) * b(47) + b(41) = b(41) - lu(529) * b(47) + b(40) = b(40) - lu(528) * b(47) + b(39) = b(39) - lu(527) * b(47) + b(38) = b(38) - lu(526) * b(47) + b(37) = b(37) - lu(525) * b(47) + b(36) = b(36) - lu(524) * b(47) + b(35) = b(35) - lu(523) * b(47) + b(33) = b(33) - lu(522) * b(47) + b(32) = b(32) - lu(521) * b(47) + b(29) = b(29) - lu(520) * b(47) + b(28) = b(28) - lu(519) * b(47) + b(23) = b(23) - lu(518) * b(47) + b(20) = b(20) - lu(517) * b(47) + b(18) = b(18) - lu(516) * b(47) + b(13) = b(13) - lu(515) * b(47) + b(11) = b(11) - lu(514) * b(47) + b(46) = b(46) * lu(510) + b(45) = b(45) - lu(509) * b(46) + b(44) = b(44) - lu(508) * b(46) + b(43) = b(43) - lu(507) * b(46) + b(42) = b(42) - lu(506) * b(46) + b(41) = b(41) - lu(505) * b(46) + b(40) = b(40) - lu(504) * b(46) + b(39) = b(39) - lu(503) * b(46) + b(38) = b(38) - lu(502) * b(46) + b(37) = b(37) - lu(501) * b(46) + b(36) = b(36) - lu(500) * b(46) + b(35) = b(35) - lu(499) * b(46) + b(33) = b(33) - lu(498) * b(46) + b(32) = b(32) - lu(497) * b(46) + b(22) = b(22) - lu(496) * b(46) + b(20) = b(20) - lu(495) * b(46) + b(45) = b(45) * lu(490) + b(44) = b(44) - lu(489) * b(45) + b(43) = b(43) - lu(488) * b(45) + b(42) = b(42) - lu(487) * b(45) + b(41) = b(41) - lu(486) * b(45) + b(40) = b(40) - lu(485) * b(45) + b(39) = b(39) - lu(484) * b(45) + b(38) = b(38) - lu(483) * b(45) + b(37) = b(37) - lu(482) * b(45) + b(36) = b(36) - lu(481) * b(45) + b(35) = b(35) - lu(480) * b(45) + b(32) = b(32) - lu(479) * b(45) + b(28) = b(28) - lu(478) * b(45) + b(20) = b(20) - lu(477) * b(45) + b(3) = b(3) - lu(476) * b(45) + b(44) = b(44) * lu(470) + b(43) = b(43) - lu(469) * b(44) + b(42) = b(42) - lu(468) * b(44) + b(41) = b(41) - lu(467) * b(44) + b(40) = b(40) - lu(466) * b(44) + b(39) = b(39) - lu(465) * b(44) + b(38) = b(38) - lu(464) * b(44) + b(37) = b(37) - lu(463) * b(44) + b(35) = b(35) - lu(462) * b(44) + b(34) = b(34) - lu(461) * b(44) + b(32) = b(32) - lu(460) * b(44) + b(31) = b(31) - lu(459) * b(44) + b(7) = b(7) - lu(458) * b(44) + b(4) = b(4) - lu(457) * b(44) + b(43) = b(43) * lu(450) + b(42) = b(42) - lu(449) * b(43) + b(41) = b(41) - lu(448) * b(43) + b(40) = b(40) - lu(447) * b(43) + b(39) = b(39) - lu(446) * b(43) + b(38) = b(38) - lu(445) * b(43) + b(37) = b(37) - lu(444) * b(43) + b(36) = b(36) - lu(443) * b(43) + b(35) = b(35) - lu(442) * b(43) + b(34) = b(34) - lu(441) * b(43) + b(33) = b(33) - lu(440) * b(43) + b(32) = b(32) - lu(439) * b(43) + b(31) = b(31) - lu(438) * b(43) + b(30) = b(30) - lu(437) * b(43) + b(29) = b(29) - lu(436) * b(43) + b(28) = b(28) - lu(435) * b(43) + b(22) = b(22) - lu(434) * b(43) + b(21) = b(21) - lu(433) * b(43) + b(20) = b(20) - lu(432) * b(43) + b(18) = b(18) - lu(431) * b(43) + b(13) = b(13) - lu(430) * b(43) + b(12) = b(12) - lu(429) * b(43) + b(11) = b(11) - lu(428) * b(43) + b(10) = b(10) - lu(427) * b(43) + b(42) = b(42) * lu(419) + b(41) = b(41) - lu(418) * b(42) + b(40) = b(40) - lu(417) * b(42) + b(39) = b(39) - lu(416) * b(42) + b(38) = b(38) - lu(415) * b(42) + b(37) = b(37) - lu(414) * b(42) + b(35) = b(35) - lu(413) * b(42) + b(34) = b(34) - lu(412) * b(42) + b(33) = b(33) - lu(411) * b(42) + b(32) = b(32) - lu(410) * b(42) + b(31) = b(31) - lu(409) * b(42) + b(21) = b(21) - lu(408) * b(42) + b(3) = b(3) - lu(407) * b(42) + b(2) = b(2) - lu(406) * b(42) + b(41) = b(41) * lu(397) + b(40) = b(40) - lu(396) * b(41) + b(39) = b(39) - lu(395) * b(41) + b(38) = b(38) - lu(394) * b(41) + b(37) = b(37) - lu(393) * b(41) + b(36) = b(36) - lu(392) * b(41) + b(35) = b(35) - lu(391) * b(41) + b(34) = b(34) - lu(390) * b(41) + b(33) = b(33) - lu(389) * b(41) + b(31) = b(31) - lu(388) * b(41) + b(23) = b(23) - lu(387) * b(41) + b(22) = b(22) - lu(386) * b(41) + b(17) = b(17) - lu(385) * b(41) + b(9) = b(9) - lu(384) * b(41) + b(6) = b(6) - lu(383) * b(41) + b(40) = b(40) * lu(373) + b(39) = b(39) - lu(372) * b(40) + b(38) = b(38) - lu(371) * b(40) + b(37) = b(37) - lu(370) * b(40) + b(36) = b(36) - lu(369) * b(40) + b(35) = b(35) - lu(368) * b(40) + b(34) = b(34) - lu(367) * b(40) + b(33) = b(33) - lu(366) * b(40) + b(31) = b(31) - lu(365) * b(40) + b(30) = b(30) - lu(364) * b(40) + b(27) = b(27) - lu(363) * b(40) + b(23) = b(23) - lu(362) * b(40) + b(22) = b(22) - lu(361) * b(40) + b(17) = b(17) - lu(360) * b(40) + b(13) = b(13) - lu(359) * b(40) + b(8) = b(8) - lu(358) * b(40) + b(39) = b(39) * lu(347) + b(38) = b(38) - lu(346) * b(39) + b(37) = b(37) - lu(345) * b(39) + b(36) = b(36) - lu(344) * b(39) + b(35) = b(35) - lu(343) * b(39) + b(34) = b(34) - lu(342) * b(39) + b(33) = b(33) - lu(341) * b(39) + b(32) = b(32) - lu(340) * b(39) + b(31) = b(31) - lu(339) * b(39) + b(30) = b(30) - lu(338) * b(39) + b(29) = b(29) - lu(337) * b(39) + b(27) = b(27) - lu(336) * b(39) + b(26) = b(26) - lu(335) * b(39) + b(25) = b(25) - lu(334) * b(39) + b(24) = b(24) - lu(333) * b(39) + b(23) = b(23) - lu(332) * b(39) + b(22) = b(22) - lu(331) * b(39) + b(21) = b(21) - lu(330) * b(39) + b(20) = b(20) - lu(329) * b(39) + b(19) = b(19) - lu(328) * b(39) + b(18) = b(18) - lu(327) * b(39) + b(17) = b(17) - lu(326) * b(39) + b(16) = b(16) - lu(325) * b(39) + b(15) = b(15) - lu(324) * b(39) + b(14) = b(14) - lu(323) * b(39) + b(10) = b(10) - lu(322) * b(39) + b(3) = b(3) - lu(321) * b(39) + b(2) = b(2) - lu(320) * b(39) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(38) = b(38) * lu(308) + b(37) = b(37) - lu(307) * b(38) + b(35) = b(35) - lu(306) * b(38) + b(33) = b(33) - lu(305) * b(38) + b(32) = b(32) - lu(304) * b(38) + b(28) = b(28) - lu(303) * b(38) + b(27) = b(27) - lu(302) * b(38) + b(26) = b(26) - lu(301) * b(38) + b(25) = b(25) - lu(300) * b(38) + b(24) = b(24) - lu(299) * b(38) + b(37) = b(37) * lu(286) + b(36) = b(36) - lu(285) * b(37) + b(35) = b(35) - lu(284) * b(37) + b(34) = b(34) - lu(283) * b(37) + b(33) = b(33) - lu(282) * b(37) + b(31) = b(31) - lu(281) * b(37) + b(30) = b(30) - lu(280) * b(37) + b(29) = b(29) - lu(279) * b(37) + b(9) = b(9) - lu(278) * b(37) + b(6) = b(6) - lu(277) * b(37) + b(5) = b(5) - lu(276) * b(37) + b(1) = b(1) - lu(275) * b(37) + b(36) = b(36) * lu(261) + b(35) = b(35) - lu(260) * b(36) + b(33) = b(33) - lu(259) * b(36) + b(32) = b(32) - lu(258) * b(36) + b(30) = b(30) - lu(257) * b(36) + b(29) = b(29) - lu(256) * b(36) + b(23) = b(23) - lu(255) * b(36) + b(22) = b(22) - lu(254) * b(36) + b(6) = b(6) - lu(253) * b(36) + b(5) = b(5) - lu(252) * b(36) + b(35) = b(35) * lu(242) + b(20) = b(20) - lu(241) * b(35) + b(34) = b(34) * lu(228) + b(32) = b(32) - lu(227) * b(34) + b(31) = b(31) - lu(226) * b(34) + b(21) = b(21) - lu(225) * b(34) + b(9) = b(9) - lu(224) * b(34) + b(33) = b(33) * lu(215) + b(22) = b(22) - lu(214) * b(33) + b(8) = b(8) - lu(213) * b(33) + b(32) = b(32) * lu(206) + b(31) = b(31) * lu(199) + b(12) = b(12) - lu(198) * b(31) + b(30) = b(30) * lu(189) + b(29) = b(29) - lu(188) * b(30) + b(22) = b(22) - lu(187) * b(30) + b(5) = b(5) - lu(186) * b(30) + b(29) = b(29) * lu(179) + b(5) = b(5) - lu(178) * b(29) + b(28) = b(28) * lu(169) + b(11) = b(11) - lu(168) * b(28) + b(27) = b(27) * lu(162) + b(26) = b(26) - lu(161) * b(27) + b(25) = b(25) - lu(160) * b(27) + b(24) = b(24) - lu(159) * b(27) + b(15) = b(15) - lu(158) * b(27) + b(14) = b(14) - lu(157) * b(27) + b(26) = b(26) * lu(151) + b(25) = b(25) - lu(150) * b(26) + b(24) = b(24) - lu(149) * b(26) + b(19) = b(19) - lu(148) * b(26) + b(16) = b(16) - lu(147) * b(26) + b(25) = b(25) * lu(140) + b(16) = b(16) - lu(139) * b(25) + b(24) = b(24) * lu(131) + b(23) = b(23) * lu(123) + b(6) = b(6) - lu(122) * b(23) + b(22) = b(22) * lu(117) + b(21) = b(21) * lu(110) + b(20) = b(20) * lu(104) + b(19) = b(19) * lu(95) + b(16) = b(16) - lu(94) * b(19) + b(15) = b(15) - lu(93) * b(19) + b(18) = b(18) * lu(86) + b(17) = b(17) * lu(78) + b(16) = b(16) * lu(73) + b(15) = b(15) * lu(67) + b(14) = b(14) * lu(60) + b(13) = b(13) * lu(53) + b(12) = b(12) * lu(47) + b(7) = b(7) - lu(46) * b(12) + b(11) = b(11) * lu(40) + b(10) = b(10) * lu(33) + b(9) = b(9) * lu(28) + b(8) = b(8) * lu(22) + b(7) = b(7) * lu(18) + b(4) = b(4) - lu(17) * b(7) + b(6) = b(6) * lu(14) + b(5) = b(5) * lu(12) + b(4) = b(4) * lu(9) + b(3) = b(3) * lu(7) + b(2) = b(2) - lu(6) * b(3) + b(2) = b(2) * lu(4) + b(1) = b(1) * lu(1) + end subroutine lu_slv04 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_nln_matrix.F90 new file mode 100644 index 0000000000..ec855caca8 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_nln_matrix.F90 @@ -0,0 +1,962 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(419) = -(rxt(81)*y(2) + rxt(99)*y(3) + rxt(121)*y(9) + rxt(124)*y(10) & + + rxt(146)*y(21) + rxt(151)*y(22) + rxt(158)*y(23) + rxt(161) & + *y(27) + rxt(187)*y(36) + rxt(212)*y(60) + rxt(215)*y(61)) + mat(350) = -rxt(81)*y(1) + mat(487) = -rxt(99)*y(1) + mat(312) = -rxt(121)*y(1) + mat(375) = -rxt(124)*y(1) + mat(208) = -rxt(146)*y(1) + mat(449) = -rxt(151)*y(1) + mat(530) = -rxt(158)*y(1) + mat(551) = -rxt(161)*y(1) + mat(245) = -rxt(187)*y(1) + mat(114) = -rxt(212)*y(1) + mat(235) = -rxt(215)*y(1) + mat(350) = mat(350) + rxt(80)*y(4) + mat(581) = rxt(80)*y(2) + mat(347) = -(rxt(80)*y(4) + rxt(81)*y(1) + 4._r8*rxt(82)*y(2) + rxt(119)*y(9) & + + (rxt(122) + rxt(123)) * y(10) + rxt(130)*y(11) + rxt(142) & + *y(18) + rxt(150)*y(22) + rxt(157)*y(23) + rxt(160)*y(24) & + + rxt(168)*y(29) + rxt(180)*y(32) + rxt(181)*y(33) + rxt(184) & + *y(34) + rxt(190)*y(37) + rxt(200)*y(38) + rxt(201)*y(39) & + + rxt(202)*y(40) + rxt(208)*y(59) + (rxt(242) + rxt(251) & + ) * y(52) + rxt(248)*y(54)) + mat(578) = -rxt(80)*y(2) + mat(416) = -rxt(81)*y(2) + mat(309) = -rxt(119)*y(2) + mat(372) = -(rxt(122) + rxt(123)) * y(2) + mat(217) = -rxt(130)*y(2) + mat(503) = -rxt(142)*y(2) + mat(446) = -rxt(150)*y(2) + mat(527) = -rxt(157)*y(2) + mat(88) = -rxt(160)*y(2) + mat(288) = -rxt(168)*y(2) + mat(264) = -rxt(180)*y(2) + mat(182) = -rxt(181)*y(2) + mat(193) = -rxt(184)*y(2) + mat(395) = -rxt(190)*y(2) + mat(106) = -rxt(200)*y(2) + mat(126) = -rxt(201)*y(2) + mat(83) = -rxt(202)*y(2) + mat(38) = -rxt(208)*y(2) + mat(101) = -(rxt(242) + rxt(251)) * y(2) + mat(65) = -rxt(248)*y(2) + mat(484) = (rxt(94)+rxt(95))*y(4) + mat(578) = mat(578) + (rxt(94)+rxt(95))*y(3) + rxt(116)*y(8) + rxt(247)*y(54) & + + rxt(240)*y(55) + rxt(211)*y(60) + rxt(214)*y(61) + mat(164) = rxt(116)*y(4) + rxt(117)*y(9) + rxt(118)*y(10) + rxt(244)*y(53) + mat(309) = mat(309) + rxt(117)*y(8) + mat(372) = mat(372) + rxt(118)*y(8) + mat(446) = mat(446) + 2.000_r8*rxt(153)*y(22) + mat(207) = rxt(149)*y(23) + mat(527) = mat(527) + rxt(149)*y(21) + mat(136) = rxt(244)*y(8) + 1.150_r8*rxt(253)*y(57) + mat(65) = mat(65) + rxt(247)*y(4) + mat(71) = rxt(240)*y(4) + mat(144) = rxt(252)*y(57) + mat(154) = 1.150_r8*rxt(253)*y(53) + rxt(252)*y(56) + mat(113) = rxt(211)*y(4) + mat(232) = rxt(214)*y(4) + mat(490) = -((rxt(94) + rxt(95)) * y(4) + rxt(96)*y(66) + rxt(99)*y(1) & + + rxt(112)*y(32) + rxt(113)*y(38)) + mat(584) = -(rxt(94) + rxt(95)) * y(3) + mat(471) = -rxt(96)*y(3) + mat(422) = -rxt(99)*y(3) + mat(270) = -rxt(112)*y(3) + mat(109) = -rxt(113)*y(3) + mat(584) = mat(584) + rxt(114)*y(58) + mat(137) = .850_r8*rxt(253)*y(57) + mat(76) = rxt(114)*y(4) + mat(155) = .850_r8*rxt(253)*y(53) + mat(588) = -(rxt(80)*y(2) + rxt(90)*y(6) + rxt(94)*y(3) + rxt(114)*y(58) & + + rxt(116)*y(8) + rxt(145)*y(21) + rxt(211)*y(60) + rxt(214) & + *y(61) + rxt(221)*y(64) + rxt(240)*y(55) + (rxt(246) + rxt(247) & + ) * y(54) + rxt(249)*y(52)) + mat(357) = -rxt(80)*y(4) + mat(5) = -rxt(90)*y(4) + mat(494) = -rxt(94)*y(4) + mat(77) = -rxt(114)*y(4) + mat(167) = -rxt(116)*y(4) + mat(212) = -rxt(145)*y(4) + mat(116) = -rxt(211)*y(4) + mat(240) = -rxt(214)*y(4) + mat(52) = -rxt(221)*y(4) + mat(72) = -rxt(240)*y(4) + mat(66) = -(rxt(246) + rxt(247)) * y(4) + mat(103) = -rxt(249)*y(4) + mat(426) = 2.000_r8*rxt(81)*y(2) + 2.000_r8*rxt(99)*y(3) + rxt(121)*y(9) & + + rxt(124)*y(10) + rxt(151)*y(22) + rxt(146)*y(21) & + + 2.000_r8*rxt(158)*y(23) + rxt(161)*y(27) + rxt(187)*y(36) & + + rxt(212)*y(60) + rxt(215)*y(61) + mat(357) = mat(357) + 2.000_r8*rxt(81)*y(1) + 2.000_r8*rxt(82)*y(2) + rxt(89) & + *y(6) + rxt(122)*y(10) + rxt(150)*y(22) + rxt(130)*y(11) & + + rxt(157)*y(23) + rxt(168)*y(29) + rxt(190)*y(37) + mat(494) = mat(494) + 2.000_r8*rxt(99)*y(1) + mat(588) = mat(588) + 2.000_r8*rxt(90)*y(6) + mat(5) = mat(5) + rxt(89)*y(2) + 2.000_r8*rxt(90)*y(4) + mat(319) = rxt(121)*y(1) + rxt(245)*y(53) + mat(382) = rxt(124)*y(1) + rxt(122)*y(2) + mat(456) = rxt(151)*y(1) + rxt(150)*y(2) + rxt(134)*y(13) + rxt(152)*y(23) & + + rxt(170)*y(29) + mat(223) = rxt(130)*y(2) + rxt(132)*y(23) + mat(59) = rxt(134)*y(22) + mat(177) = rxt(138)*y(23) + mat(212) = mat(212) + rxt(146)*y(1) + rxt(148)*y(23) + mat(537) = 2.000_r8*rxt(158)*y(1) + rxt(157)*y(2) + rxt(152)*y(22) + rxt(132) & + *y(11) + rxt(138)*y(16) + rxt(148)*y(21) + 2.000_r8*rxt(159) & + *y(23) + rxt(164)*y(27) + rxt(171)*y(29) + rxt(188)*y(36) & + + rxt(192)*y(37) + mat(558) = rxt(161)*y(1) + rxt(164)*y(23) + mat(298) = rxt(168)*y(2) + rxt(170)*y(22) + rxt(171)*y(23) + ( & + + 2.000_r8*rxt(174)+2.000_r8*rxt(175))*y(29) + (rxt(196) & + +rxt(197))*y(37) + mat(251) = rxt(187)*y(1) + rxt(188)*y(23) + mat(405) = rxt(190)*y(2) + rxt(192)*y(23) + (rxt(196)+rxt(197))*y(29) & + + 2.000_r8*rxt(198)*y(37) + mat(138) = rxt(245)*y(9) + mat(116) = mat(116) + rxt(212)*y(1) + mat(240) = mat(240) + rxt(215)*y(1) + mat(7) = -(rxt(83)*y(2) + rxt(84)*y(4) + rxt(86)*y(1)) + mat(321) = -rxt(83)*y(5) + mat(560) = -rxt(84)*y(5) + mat(407) = -rxt(86)*y(5) + mat(476) = rxt(94)*y(4) + mat(560) = mat(560) + rxt(94)*y(3) + mat(4) = -(rxt(89)*y(2) + rxt(90)*y(4)) + mat(320) = -rxt(89)*y(6) + mat(559) = -rxt(90)*y(6) + mat(406) = rxt(86)*y(5) + mat(320) = mat(320) + rxt(83)*y(5) + mat(559) = mat(559) + rxt(84)*y(5) + mat(6) = rxt(86)*y(1) + rxt(83)*y(2) + rxt(84)*y(4) + mat(162) = -(rxt(116)*y(4) + rxt(117)*y(9) + rxt(118)*y(10) + rxt(244)*y(53)) + mat(571) = -rxt(116)*y(8) + mat(302) = -rxt(117)*y(8) + mat(363) = -rxt(118)*y(8) + mat(134) = -rxt(244)*y(8) + mat(336) = rxt(248)*y(54) + rxt(115)*y(58) + mat(571) = mat(571) + rxt(246)*y(54) + mat(99) = 1.100_r8*rxt(254)*y(57) + mat(64) = rxt(248)*y(2) + rxt(246)*y(4) + mat(142) = .200_r8*rxt(252)*y(57) + mat(74) = rxt(115)*y(2) + mat(152) = 1.100_r8*rxt(254)*y(52) + .200_r8*rxt(252)*y(56) + mat(308) = -(rxt(117)*y(8) + rxt(119)*y(2) + rxt(120)*y(23) + rxt(121)*y(1) & + + rxt(129)*y(11) + rxt(137)*y(16) + rxt(172)*y(29) + rxt(193) & + *y(37) + rxt(245)*y(53)) + mat(163) = -rxt(117)*y(9) + mat(346) = -rxt(119)*y(9) + mat(526) = -rxt(120)*y(9) + mat(415) = -rxt(121)*y(9) + mat(216) = -rxt(129)*y(9) + mat(171) = -rxt(137)*y(9) + mat(287) = -rxt(172)*y(9) + mat(394) = -rxt(193)*y(9) + mat(135) = -rxt(245)*y(9) + mat(346) = mat(346) + rxt(122)*y(10) + mat(577) = rxt(116)*y(8) + rxt(114)*y(58) + mat(163) = mat(163) + rxt(116)*y(4) + mat(371) = rxt(122)*y(2) + rxt(216)*y(61) + mat(75) = rxt(114)*y(4) + mat(231) = rxt(216)*y(10) + mat(373) = -(rxt(118)*y(8) + (rxt(122) + rxt(123)) * y(2) + rxt(124)*y(1) & + + rxt(125)*y(11) + rxt(127)*y(22) + rxt(133)*y(23) + rxt(173) & + *y(29) + rxt(194)*y(37) + rxt(216)*y(61)) + mat(165) = -rxt(118)*y(10) + mat(348) = -(rxt(122) + rxt(123)) * y(10) + mat(417) = -rxt(124)*y(10) + mat(218) = -rxt(125)*y(10) + mat(447) = -rxt(127)*y(10) + mat(528) = -rxt(133)*y(10) + mat(289) = -rxt(173)*y(10) + mat(396) = -rxt(194)*y(10) + mat(233) = -rxt(216)*y(10) + mat(417) = mat(417) + rxt(121)*y(9) + mat(348) = mat(348) + rxt(119)*y(9) + rxt(130)*y(11) + mat(310) = rxt(121)*y(1) + rxt(119)*y(2) + 2.000_r8*rxt(129)*y(11) + rxt(137) & + *y(16) + rxt(120)*y(23) + rxt(172)*y(29) + rxt(193)*y(37) + mat(447) = mat(447) + rxt(131)*y(11) + rxt(134)*y(13) + mat(218) = mat(218) + rxt(130)*y(2) + 2.000_r8*rxt(129)*y(9) + rxt(131)*y(22) & + + rxt(132)*y(23) + mat(55) = rxt(134)*y(22) + mat(172) = rxt(137)*y(9) + mat(528) = mat(528) + rxt(120)*y(9) + rxt(132)*y(11) + mat(289) = mat(289) + rxt(172)*y(9) + mat(396) = mat(396) + rxt(193)*y(9) + mat(450) = -(rxt(127)*y(10) + rxt(128)*y(12) + rxt(131)*y(11) + rxt(134) & + *y(13) + rxt(139)*y(17) + rxt(141)*y(18) + rxt(150)*y(2) + rxt(151) & + *y(1) + rxt(152)*y(23) + (4._r8*rxt(153) + 4._r8*rxt(154) & + ) * y(22) + rxt(156)*y(24) + (rxt(169) + rxt(170)) * y(29) & + + rxt(179)*y(32) + rxt(183)*y(33) + rxt(185)*y(34) + rxt(191) & + *y(37) + rxt(199)*y(38) + rxt(209)*y(59) + rxt(210)*y(60) & + + rxt(213)*y(61) + rxt(220)*y(62)) + mat(376) = -rxt(127)*y(22) + mat(120) = -rxt(128)*y(22) + mat(219) = -rxt(131)*y(22) + mat(56) = -rxt(134)*y(22) + mat(43) = -rxt(139)*y(22) + mat(507) = -rxt(141)*y(22) + mat(351) = -rxt(150)*y(22) + mat(420) = -rxt(151)*y(22) + mat(531) = -rxt(152)*y(22) + mat(89) = -rxt(156)*y(22) + mat(292) = -(rxt(169) + rxt(170)) * y(22) + mat(268) = -rxt(179)*y(22) + mat(183) = -rxt(183)*y(22) + mat(195) = -rxt(185)*y(22) + mat(399) = -rxt(191)*y(22) + mat(107) = -rxt(199)*y(22) + mat(39) = -rxt(209)*y(22) + mat(115) = -rxt(210)*y(22) + mat(236) = -rxt(213)*y(22) + mat(202) = -rxt(220)*y(22) + mat(420) = mat(420) + rxt(146)*y(21) + rxt(158)*y(23) + mat(351) = mat(351) + rxt(142)*y(18) + rxt(157)*y(23) + rxt(160)*y(24) & + + rxt(180)*y(32) + rxt(181)*y(33) + rxt(200)*y(38) + rxt(201) & + *y(39) + mat(488) = 2.000_r8*rxt(96)*y(66) + rxt(112)*y(32) + rxt(113)*y(38) + mat(313) = rxt(120)*y(23) + mat(219) = mat(219) + rxt(132)*y(23) + mat(507) = mat(507) + rxt(142)*y(2) + mat(209) = rxt(146)*y(1) + 2.000_r8*rxt(147)*y(23) + mat(531) = mat(531) + rxt(158)*y(1) + rxt(157)*y(2) + rxt(120)*y(9) & + + rxt(132)*y(11) + 2.000_r8*rxt(147)*y(21) + rxt(165)*y(27) + mat(89) = mat(89) + rxt(160)*y(2) + mat(469) = 2.000_r8*rxt(96)*y(3) + mat(552) = rxt(165)*y(23) + mat(268) = mat(268) + rxt(180)*y(2) + rxt(112)*y(3) + mat(183) = mat(183) + rxt(181)*y(2) + mat(107) = mat(107) + rxt(200)*y(2) + rxt(113)*y(3) + mat(128) = rxt(201)*y(2) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(215) = -(rxt(125)*y(10) + rxt(129)*y(9) + rxt(130)*y(2) + rxt(131)*y(22) & + + rxt(132)*y(23) + rxt(140)*y(18)) + mat(366) = -rxt(125)*y(11) + mat(305) = -rxt(129)*y(11) + mat(341) = -rxt(130)*y(11) + mat(440) = -rxt(131)*y(11) + mat(522) = -rxt(132)*y(11) + mat(498) = -rxt(140)*y(11) + mat(411) = rxt(124)*y(10) + mat(341) = mat(341) + rxt(123)*y(10) + rxt(184)*y(34) + rxt(202)*y(40) + mat(366) = mat(366) + rxt(124)*y(1) + rxt(123)*y(2) + mat(440) = mat(440) + rxt(128)*y(12) + rxt(185)*y(34) + mat(118) = rxt(128)*y(22) + mat(544) = rxt(186)*y(34) + mat(190) = rxt(184)*y(2) + rxt(185)*y(22) + rxt(186)*y(27) + mat(81) = rxt(202)*y(2) + mat(117) = -(rxt(128)*y(22)) + mat(434) = -rxt(128)*y(12) + mat(361) = rxt(127)*y(22) + mat(434) = mat(434) + rxt(127)*y(10) + mat(214) = rxt(140)*y(18) + mat(496) = rxt(140)*y(11) + mat(254) = (rxt(226)+rxt(231)+rxt(237))*y(34) + mat(187) = (rxt(226)+rxt(231)+rxt(237))*y(32) + mat(53) = -(rxt(134)*y(22)) + mat(430) = -rxt(134)*y(13) + mat(359) = rxt(133)*y(23) + mat(515) = rxt(133)*y(10) + mat(358) = rxt(125)*y(11) + mat(213) = rxt(125)*y(10) + mat(169) = -(rxt(137)*y(9) + rxt(138)*y(23)) + mat(303) = -rxt(137)*y(16) + mat(519) = -rxt(138)*y(16) + mat(435) = rxt(139)*y(17) + mat(41) = rxt(139)*y(22) + mat(40) = -(rxt(139)*y(22)) + mat(428) = -rxt(139)*y(17) + mat(168) = rxt(138)*y(23) + mat(514) = rxt(138)*y(16) + mat(510) = -(rxt(140)*y(11) + rxt(141)*y(22) + rxt(142)*y(2) + rxt(166)*y(27) & + + rxt(189)*y(36)) + mat(221) = -rxt(140)*y(18) + mat(453) = -rxt(141)*y(18) + mat(354) = -rxt(142)*y(18) + mat(555) = -rxt(166)*y(18) + mat(249) = -rxt(189)*y(18) + mat(316) = rxt(137)*y(16) + mat(175) = rxt(137)*y(9) + mat(206) = -(rxt(145)*y(4) + rxt(146)*y(1) + (rxt(147) + rxt(148) + rxt(149) & + ) * y(23)) + mat(573) = -rxt(145)*y(21) + mat(410) = -rxt(146)*y(21) + mat(521) = -(rxt(147) + rxt(148) + rxt(149)) * y(21) + mat(340) = rxt(150)*y(22) + mat(439) = rxt(150)*y(2) + rxt(141)*y(18) + rxt(209)*y(59) + rxt(210)*y(60) & + + rxt(213)*y(61) + mat(497) = rxt(141)*y(22) + mat(36) = rxt(209)*y(22) + mat(111) = rxt(210)*y(22) + mat(227) = rxt(213)*y(22) + mat(535) = -(rxt(120)*y(9) + rxt(132)*y(11) + rxt(133)*y(10) + rxt(138)*y(16) & + + (rxt(147) + rxt(148) + rxt(149)) * y(21) + rxt(152)*y(22) & + + rxt(157)*y(2) + rxt(158)*y(1) + 4._r8*rxt(159)*y(23) + (rxt(164) & + + rxt(165)) * y(27) + rxt(171)*y(29) + rxt(188)*y(36) + rxt(192) & + *y(37)) + mat(317) = -rxt(120)*y(23) + mat(222) = -rxt(132)*y(23) + mat(380) = -rxt(133)*y(23) + mat(176) = -rxt(138)*y(23) + mat(211) = -(rxt(147) + rxt(148) + rxt(149)) * y(23) + mat(454) = -rxt(152)*y(23) + mat(355) = -rxt(157)*y(23) + mat(424) = -rxt(158)*y(23) + mat(556) = -(rxt(164) + rxt(165)) * y(23) + mat(296) = -rxt(171)*y(23) + mat(250) = -rxt(188)*y(23) + mat(403) = -rxt(192)*y(23) + mat(424) = mat(424) + rxt(151)*y(22) + mat(355) = mat(355) + rxt(142)*y(18) + rxt(160)*y(24) + mat(586) = rxt(145)*y(21) + rxt(221)*y(64) + mat(317) = mat(317) + rxt(137)*y(16) + mat(454) = mat(454) + rxt(151)*y(1) + rxt(131)*y(11) + rxt(156)*y(24) & + + rxt(169)*y(29) + rxt(191)*y(37) + mat(222) = mat(222) + rxt(131)*y(22) + rxt(140)*y(18) + mat(176) = mat(176) + rxt(137)*y(9) + mat(511) = rxt(142)*y(2) + rxt(140)*y(11) + rxt(166)*y(27) + rxt(189)*y(36) + mat(211) = mat(211) + rxt(145)*y(4) + mat(91) = rxt(160)*y(2) + rxt(156)*y(22) + rxt(163)*y(27) + mat(556) = mat(556) + rxt(166)*y(18) + rxt(163)*y(24) + mat(296) = mat(296) + rxt(169)*y(22) + mat(250) = mat(250) + rxt(189)*y(18) + mat(403) = mat(403) + rxt(191)*y(22) + mat(51) = rxt(221)*y(4) + mat(86) = -(rxt(156)*y(22) + rxt(160)*y(2) + rxt(163)*y(27)) + mat(431) = -rxt(156)*y(24) + mat(327) = -rxt(160)*y(24) + mat(539) = -rxt(163)*y(24) + mat(431) = mat(431) + 2.000_r8*rxt(154)*y(22) + mat(516) = 2.000_r8*rxt(159)*y(23) + mat(470) = -(rxt(96)*y(3) + rxt(222)*y(63)) + mat(489) = -rxt(96)*y(66) + mat(21) = -rxt(222)*y(66) + mat(451) = 2.000_r8*rxt(153)*y(22) + rxt(128)*y(12) + rxt(134)*y(13) & + + rxt(139)*y(17) + rxt(141)*y(18) + rxt(152)*y(23) + rxt(156) & + *y(24) + rxt(179)*y(32) + rxt(183)*y(33) + rxt(199)*y(38) + mat(121) = rxt(128)*y(22) + mat(57) = rxt(134)*y(22) + mat(44) = rxt(139)*y(22) + mat(508) = rxt(141)*y(22) + mat(210) = rxt(149)*y(23) + mat(532) = rxt(152)*y(22) + rxt(149)*y(21) + mat(90) = rxt(156)*y(22) + mat(269) = rxt(179)*y(22) + (rxt(227)+rxt(232)+rxt(238))*y(33) + (rxt(228) & + +rxt(239))*y(39) + mat(184) = rxt(183)*y(22) + (rxt(227)+rxt(232)+rxt(238))*y(32) + mat(108) = rxt(199)*y(22) + mat(129) = (rxt(228)+rxt(239))*y(32) + mat(557) = -(rxt(161)*y(1) + rxt(163)*y(24) + (rxt(164) + rxt(165)) * y(23) & + + rxt(166)*y(18) + rxt(182)*y(33) + rxt(186)*y(34)) + mat(425) = -rxt(161)*y(27) + mat(92) = -rxt(163)*y(27) + mat(536) = -(rxt(164) + rxt(165)) * y(27) + mat(512) = -rxt(166)*y(27) + mat(185) = -rxt(182)*y(27) + mat(197) = -rxt(186)*y(27) + mat(356) = rxt(168)*y(29) + rxt(180)*y(32) + mat(493) = rxt(112)*y(32) + mat(318) = rxt(172)*y(29) + mat(455) = rxt(169)*y(29) + rxt(179)*y(32) + mat(297) = rxt(168)*y(2) + rxt(172)*y(9) + rxt(169)*y(22) + ( & + + 4.000_r8*rxt(174)+2.000_r8*rxt(176))*y(29) + rxt(196)*y(37) & + + rxt(217)*y(61) + mat(273) = rxt(180)*y(2) + rxt(112)*y(3) + rxt(179)*y(22) + mat(404) = rxt(196)*y(29) + mat(239) = rxt(217)*y(29) + mat(538) = rxt(186)*y(34) + mat(276) = 2.000_r8*rxt(175)*y(29) + mat(252) = (rxt(227)+rxt(232)+rxt(238))*y(33) + (rxt(226)+rxt(231)+rxt(237)) & + *y(34) + mat(178) = (rxt(227)+rxt(232)+rxt(238))*y(32) + mat(186) = rxt(186)*y(27) + (rxt(226)+rxt(231)+rxt(237))*y(32) + mat(286) = -(rxt(168)*y(2) + (rxt(169) + rxt(170)) * y(22) + rxt(171)*y(23) & + + rxt(172)*y(9) + rxt(173)*y(10) + (4._r8*rxt(174) + 4._r8*rxt(175) & + + 4._r8*rxt(176) + 4._r8*rxt(177)) * y(29) + (rxt(195) + rxt(196) & + + rxt(197)) * y(37) + rxt(217)*y(61)) + mat(345) = -rxt(168)*y(29) + mat(444) = -(rxt(169) + rxt(170)) * y(29) + mat(525) = -rxt(171)*y(29) + mat(307) = -rxt(172)*y(29) + mat(370) = -rxt(173)*y(29) + mat(393) = -(rxt(195) + rxt(196) + rxt(197)) * y(29) + mat(230) = -rxt(217)*y(29) + mat(414) = rxt(161)*y(27) + mat(345) = mat(345) + rxt(181)*y(33) + rxt(184)*y(34) + mat(444) = mat(444) + rxt(183)*y(33) + mat(525) = mat(525) + rxt(165)*y(27) + mat(546) = rxt(161)*y(1) + rxt(165)*y(23) + rxt(182)*y(33) + mat(31) = rxt(219)*y(61) + mat(181) = rxt(181)*y(2) + rxt(183)*y(22) + rxt(182)*y(27) + mat(192) = rxt(184)*y(2) + mat(230) = mat(230) + rxt(219)*y(30) + mat(28) = -(rxt(219)*y(61)) + mat(224) = -rxt(219)*y(30) + mat(278) = 2.000_r8*rxt(176)*y(29) + rxt(195)*y(37) + mat(384) = rxt(195)*y(29) + mat(275) = 2.000_r8*rxt(177)*y(29) + mat(261) = -(rxt(112)*y(3) + rxt(179)*y(22) + rxt(180)*y(2) + (rxt(226) & + + rxt(231) + rxt(237)) * y(34) + (rxt(227) + rxt(232) + rxt(238) & + ) * y(33) + (rxt(228) + rxt(239)) * y(39)) + mat(481) = -rxt(112)*y(32) + mat(443) = -rxt(179)*y(32) + mat(344) = -rxt(180)*y(32) + mat(191) = -(rxt(226) + rxt(231) + rxt(237)) * y(32) + mat(180) = -(rxt(227) + rxt(232) + rxt(238)) * y(32) + mat(125) = -(rxt(228) + rxt(239)) * y(32) + mat(443) = mat(443) + rxt(170)*y(29) + mat(500) = rxt(166)*y(27) + mat(524) = rxt(164)*y(27) + mat(87) = rxt(163)*y(27) + mat(545) = rxt(166)*y(18) + rxt(164)*y(23) + rxt(163)*y(24) + rxt(182)*y(33) + mat(285) = rxt(170)*y(22) + mat(180) = mat(180) + rxt(182)*y(27) + mat(179) = -(rxt(181)*y(2) + rxt(182)*y(27) + rxt(183)*y(22) + (rxt(227) & + + rxt(232) + rxt(238)) * y(32)) + mat(337) = -rxt(181)*y(33) + mat(541) = -rxt(182)*y(33) + mat(436) = -rxt(183)*y(33) + mat(256) = -(rxt(227) + rxt(232) + rxt(238)) * y(33) + mat(436) = mat(436) + rxt(185)*y(34) + mat(520) = rxt(171)*y(29) + mat(279) = rxt(171)*y(23) + mat(188) = rxt(185)*y(22) + mat(189) = -(rxt(184)*y(2) + rxt(185)*y(22) + rxt(186)*y(27) + (rxt(226) & + + rxt(231) + rxt(237)) * y(32)) + mat(338) = -rxt(184)*y(34) + mat(437) = -rxt(185)*y(34) + mat(542) = -rxt(186)*y(34) + mat(257) = -(rxt(226) + rxt(231) + rxt(237)) * y(34) + mat(364) = rxt(173)*y(29) + mat(280) = rxt(173)*y(10) + mat(277) = rxt(197)*y(37) + mat(253) = (rxt(228)+rxt(239))*y(39) + mat(383) = rxt(197)*y(29) + mat(122) = (rxt(228)+rxt(239))*y(32) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(242) = -(rxt(187)*y(1) + rxt(188)*y(23) + rxt(189)*y(18)) + mat(413) = -rxt(187)*y(36) + mat(523) = -rxt(188)*y(36) + mat(499) = -rxt(189)*y(36) + mat(343) = rxt(190)*y(37) + rxt(200)*y(38) + mat(480) = rxt(113)*y(38) + mat(306) = rxt(193)*y(37) + mat(442) = rxt(191)*y(37) + rxt(199)*y(38) + mat(284) = (rxt(195)+rxt(196))*y(37) + mat(391) = rxt(190)*y(2) + rxt(193)*y(9) + rxt(191)*y(22) + (rxt(195) & + +rxt(196))*y(29) + 4.000_r8*rxt(198)*y(37) + rxt(218)*y(61) + mat(105) = rxt(200)*y(2) + rxt(113)*y(3) + rxt(199)*y(22) + mat(229) = rxt(218)*y(37) + mat(397) = -(rxt(190)*y(2) + rxt(191)*y(22) + rxt(192)*y(23) + rxt(193)*y(9) & + + rxt(194)*y(10) + (rxt(195) + rxt(196) + rxt(197)) * y(29) & + + 4._r8*rxt(198)*y(37) + rxt(218)*y(61)) + mat(349) = -rxt(190)*y(37) + mat(448) = -rxt(191)*y(37) + mat(529) = -rxt(192)*y(37) + mat(311) = -rxt(193)*y(37) + mat(374) = -rxt(194)*y(37) + mat(290) = -(rxt(195) + rxt(196) + rxt(197)) * y(37) + mat(234) = -rxt(218)*y(37) + mat(418) = rxt(187)*y(36) + mat(349) = mat(349) + rxt(201)*y(39) + rxt(202)*y(40) + mat(244) = rxt(187)*y(1) + mat(127) = rxt(201)*y(2) + mat(85) = rxt(202)*y(2) + mat(104) = -(rxt(113)*y(3) + rxt(199)*y(22) + rxt(200)*y(2)) + mat(477) = -rxt(113)*y(38) + mat(432) = -rxt(199)*y(38) + mat(329) = -rxt(200)*y(38) + mat(495) = rxt(189)*y(36) + mat(517) = rxt(188)*y(36) + mat(241) = rxt(189)*y(18) + rxt(188)*y(23) + mat(123) = -(rxt(201)*y(2) + (rxt(228) + rxt(239)) * y(32)) + mat(332) = -rxt(201)*y(39) + mat(255) = -(rxt(228) + rxt(239)) * y(39) + mat(518) = rxt(192)*y(37) + mat(387) = rxt(192)*y(23) + mat(78) = -(rxt(202)*y(2)) + mat(326) = -rxt(202)*y(40) + mat(360) = rxt(194)*y(37) + mat(385) = rxt(194)*y(10) + mat(95) = -((rxt(242) + rxt(251)) * y(2) + rxt(249)*y(4) + rxt(254)*y(57)) + mat(328) = -(rxt(242) + rxt(251)) * y(52) + mat(566) = -rxt(249)*y(52) + mat(148) = -rxt(254)*y(52) + mat(131) = -(rxt(244)*y(8) + rxt(245)*y(9) + rxt(253)*y(57)) + mat(159) = -rxt(244)*y(53) + mat(299) = -rxt(245)*y(53) + mat(149) = -rxt(253)*y(53) + mat(568) = rxt(249)*y(52) + rxt(246)*y(54) + rxt(240)*y(55) + mat(96) = rxt(249)*y(4) + mat(62) = rxt(246)*y(4) + mat(68) = rxt(240)*y(4) + mat(60) = -((rxt(246) + rxt(247)) * y(4) + rxt(248)*y(2)) + mat(563) = -(rxt(246) + rxt(247)) * y(54) + mat(323) = -rxt(248)*y(54) + mat(67) = -(rxt(240)*y(4)) + mat(564) = -rxt(240)*y(55) + mat(324) = rxt(251)*y(52) + rxt(248)*y(54) + mat(93) = rxt(251)*y(2) + mat(61) = rxt(248)*y(2) + mat(140) = -(rxt(252)*y(57)) + mat(150) = -rxt(252)*y(56) + mat(334) = rxt(242)*y(52) + mat(569) = rxt(247)*y(54) + mat(160) = rxt(244)*y(53) + mat(300) = rxt(245)*y(53) + mat(97) = rxt(242)*y(2) + mat(132) = rxt(244)*y(8) + rxt(245)*y(9) + mat(63) = rxt(247)*y(4) + mat(73) = -(rxt(114)*y(4) + rxt(115)*y(2)) + mat(565) = -rxt(114)*y(58) + mat(325) = -rxt(115)*y(58) + mat(325) = mat(325) + rxt(242)*y(52) + mat(94) = rxt(242)*y(2) + .900_r8*rxt(254)*y(57) + mat(139) = .800_r8*rxt(252)*y(57) + mat(147) = .900_r8*rxt(254)*y(52) + .800_r8*rxt(252)*y(56) + mat(151) = -(rxt(252)*y(56) + rxt(253)*y(53) + rxt(254)*y(52)) + mat(141) = -rxt(252)*y(57) + mat(133) = -rxt(253)*y(57) + mat(98) = -rxt(254)*y(57) + mat(33) = -(rxt(208)*y(2) + rxt(209)*y(22)) + mat(322) = -rxt(208)*y(59) + mat(427) = -rxt(209)*y(59) + mat(110) = -(rxt(210)*y(22) + rxt(211)*y(4) + rxt(212)*y(1)) + mat(433) = -rxt(210)*y(60) + mat(567) = -rxt(211)*y(60) + mat(408) = -rxt(212)*y(60) + mat(228) = -(rxt(213)*y(22) + rxt(214)*y(4) + rxt(215)*y(1) + rxt(216)*y(10) & + + rxt(217)*y(29) + rxt(218)*y(37) + rxt(219)*y(30)) + mat(441) = -rxt(213)*y(61) + mat(574) = -rxt(214)*y(61) + mat(412) = -rxt(215)*y(61) + mat(367) = -rxt(216)*y(61) + mat(283) = -rxt(217)*y(61) + mat(390) = -rxt(218)*y(61) + mat(30) = -rxt(219)*y(61) + mat(412) = mat(412) + rxt(212)*y(60) + mat(342) = rxt(208)*y(59) + mat(574) = mat(574) + rxt(211)*y(60) + mat(441) = mat(441) + rxt(210)*y(60) + mat(37) = rxt(208)*y(2) + mat(112) = rxt(212)*y(1) + rxt(211)*y(4) + rxt(210)*y(22) + mat(199) = -(rxt(220)*y(22)) + mat(438) = -rxt(220)*y(62) + mat(409) = rxt(215)*y(61) + mat(572) = rxt(214)*y(61) + mat(365) = rxt(216)*y(61) + mat(438) = mat(438) + rxt(209)*y(59) + rxt(213)*y(61) + mat(281) = rxt(217)*y(61) + mat(29) = rxt(219)*y(61) + mat(388) = rxt(218)*y(61) + mat(35) = rxt(209)*y(22) + mat(226) = rxt(215)*y(1) + rxt(214)*y(4) + rxt(216)*y(10) + rxt(213)*y(22) & + + rxt(217)*y(29) + rxt(219)*y(30) + rxt(218)*y(37) + mat(18) = -(rxt(222)*y(66)) + mat(458) = -rxt(222)*y(63) + mat(561) = rxt(221)*y(64) + mat(46) = rxt(221)*y(4) + mat(47) = -(rxt(221)*y(4)) + mat(562) = -rxt(221)*y(64) + mat(429) = rxt(220)*y(62) + mat(198) = rxt(220)*y(22) + mat(457) = rxt(222)*y(63) + mat(17) = rxt(222)*y(66) + end subroutine nlnmat03 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = mat( 4) + lmat( 4) + mat( 5) = mat( 5) + lmat( 5) + mat( 6) = mat( 6) + lmat( 6) + mat( 7) = mat( 7) + lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 18) = mat( 18) + lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = mat( 28) + lmat( 28) + mat( 31) = mat( 31) + lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = mat( 33) + lmat( 33) + mat( 34) = lmat( 34) + mat( 40) = mat( 40) + lmat( 40) + mat( 42) = lmat( 42) + mat( 43) = mat( 43) + lmat( 43) + mat( 45) = lmat( 45) + mat( 47) = mat( 47) + lmat( 47) + mat( 53) = mat( 53) + lmat( 53) + mat( 54) = lmat( 54) + mat( 55) = mat( 55) + lmat( 55) + mat( 56) = mat( 56) + lmat( 56) + mat( 58) = lmat( 58) + mat( 60) = mat( 60) + lmat( 60) + mat( 67) = mat( 67) + lmat( 67) + mat( 68) = mat( 68) + lmat( 68) + mat( 69) = lmat( 69) + mat( 70) = lmat( 70) + mat( 73) = mat( 73) + lmat( 73) + mat( 78) = mat( 78) + lmat( 78) + mat( 79) = lmat( 79) + mat( 80) = lmat( 80) + mat( 81) = mat( 81) + lmat( 81) + mat( 82) = lmat( 82) + mat( 84) = lmat( 84) + mat( 85) = mat( 85) + lmat( 85) + mat( 86) = mat( 86) + lmat( 86) + mat( 89) = mat( 89) + lmat( 89) + mat( 95) = mat( 95) + lmat( 95) + mat( 104) = mat( 104) + lmat( 104) + mat( 110) = mat( 110) + lmat( 110) + mat( 117) = mat( 117) + lmat( 117) + mat( 119) = lmat( 119) + mat( 120) = mat( 120) + lmat( 120) + mat( 123) = mat( 123) + lmat( 123) + mat( 124) = lmat( 124) + mat( 128) = mat( 128) + lmat( 128) + mat( 131) = mat( 131) + lmat( 131) + mat( 132) = mat( 132) + lmat( 132) + mat( 135) = mat( 135) + lmat( 135) + mat( 140) = mat( 140) + lmat( 140) + mat( 151) = mat( 151) + lmat( 151) + mat( 157) = lmat( 157) + mat( 161) = lmat( 161) + mat( 162) = mat( 162) + lmat( 162) + mat( 169) = mat( 169) + lmat( 169) + mat( 179) = mat( 179) + lmat( 179) + mat( 183) = mat( 183) + lmat( 183) + mat( 185) = mat( 185) + lmat( 185) + mat( 187) = mat( 187) + lmat( 187) + mat( 188) = mat( 188) + lmat( 188) + mat( 189) = mat( 189) + lmat( 189) + mat( 190) = mat( 190) + lmat( 190) + mat( 192) = mat( 192) + lmat( 192) + mat( 194) = lmat( 194) + mat( 197) = mat( 197) + lmat( 197) + mat( 199) = mat( 199) + lmat( 199) + mat( 200) = lmat( 200) + mat( 201) = lmat( 201) + mat( 206) = mat( 206) + lmat( 206) + mat( 215) = mat( 215) + lmat( 215) + mat( 216) = mat( 216) + lmat( 216) + mat( 217) = mat( 217) + lmat( 217) + mat( 218) = mat( 218) + lmat( 218) + mat( 223) = mat( 223) + lmat( 223) + mat( 225) = lmat( 225) + mat( 228) = mat( 228) + lmat( 228) + mat( 232) = mat( 232) + lmat( 232) + mat( 242) = mat( 242) + lmat( 242) + mat( 258) = lmat( 258) + mat( 261) = mat( 261) + lmat( 261) + mat( 273) = mat( 273) + lmat( 273) + mat( 286) = mat( 286) + lmat( 286) + mat( 288) = mat( 288) + lmat( 288) + mat( 297) = mat( 297) + lmat( 297) + mat( 300) = mat( 300) + lmat( 300) + mat( 301) = lmat( 301) + mat( 302) = mat( 302) + lmat( 302) + mat( 308) = mat( 308) + lmat( 308) + mat( 309) = mat( 309) + lmat( 309) + mat( 324) = mat( 324) + lmat( 324) + mat( 335) = lmat( 335) + mat( 347) = mat( 347) + lmat( 347) + mat( 371) = mat( 371) + lmat( 371) + mat( 372) = mat( 372) + lmat( 372) + mat( 373) = mat( 373) + lmat( 373) + mat( 391) = mat( 391) + lmat( 391) + mat( 395) = mat( 395) + lmat( 395) + mat( 397) = mat( 397) + lmat( 397) + mat( 406) = mat( 406) + lmat( 406) + mat( 416) = mat( 416) + lmat( 416) + mat( 419) = mat( 419) + lmat( 419) + mat( 422) = mat( 422) + lmat( 422) + mat( 426) = mat( 426) + lmat( 426) + mat( 435) = mat( 435) + lmat( 435) + mat( 439) = mat( 439) + lmat( 439) + mat( 442) = mat( 442) + lmat( 442) + mat( 450) = mat( 450) + lmat( 450) + mat( 451) = mat( 451) + lmat( 451) + mat( 454) = mat( 454) + lmat( 454) + mat( 455) = mat( 455) + lmat( 455) + mat( 460) = lmat( 460) + mat( 465) = lmat( 465) + mat( 469) = mat( 469) + lmat( 469) + mat( 470) = mat( 470) + lmat( 470) + mat( 471) = mat( 471) + lmat( 471) + mat( 478) = lmat( 478) + mat( 479) = lmat( 479) + mat( 480) = mat( 480) + lmat( 480) + mat( 483) = lmat( 483) + mat( 484) = mat( 484) + lmat( 484) + mat( 488) = mat( 488) + lmat( 488) + mat( 490) = mat( 490) + lmat( 490) + mat( 491) = lmat( 491) + mat( 492) = lmat( 492) + mat( 493) = mat( 493) + lmat( 493) + mat( 494) = mat( 494) + lmat( 494) + mat( 497) = mat( 497) + lmat( 497) + mat( 510) = mat( 510) + lmat( 510) + mat( 535) = mat( 535) + lmat( 535) + mat( 540) = lmat( 540) + mat( 543) = lmat( 543) + mat( 545) = mat( 545) + lmat( 545) + mat( 556) = mat( 556) + lmat( 556) + mat( 557) = mat( 557) + lmat( 557) + mat( 564) = mat( 564) + lmat( 564) + mat( 568) = mat( 568) + lmat( 568) + mat( 570) = lmat( 570) + mat( 578) = mat( 578) + lmat( 578) + mat( 584) = mat( 584) + lmat( 584) + mat( 588) = mat( 588) + lmat( 588) + mat( 48) = 0._r8 + mat( 49) = 0._r8 + mat( 50) = 0._r8 + mat( 100) = 0._r8 + mat( 102) = 0._r8 + mat( 130) = 0._r8 + mat( 143) = 0._r8 + mat( 145) = 0._r8 + mat( 146) = 0._r8 + mat( 153) = 0._r8 + mat( 156) = 0._r8 + mat( 158) = 0._r8 + mat( 166) = 0._r8 + mat( 170) = 0._r8 + mat( 173) = 0._r8 + mat( 174) = 0._r8 + mat( 196) = 0._r8 + mat( 203) = 0._r8 + mat( 204) = 0._r8 + mat( 205) = 0._r8 + mat( 220) = 0._r8 + mat( 237) = 0._r8 + mat( 238) = 0._r8 + mat( 243) = 0._r8 + mat( 246) = 0._r8 + mat( 247) = 0._r8 + mat( 248) = 0._r8 + mat( 259) = 0._r8 + mat( 260) = 0._r8 + mat( 262) = 0._r8 + mat( 263) = 0._r8 + mat( 265) = 0._r8 + mat( 266) = 0._r8 + mat( 267) = 0._r8 + mat( 271) = 0._r8 + mat( 272) = 0._r8 + mat( 274) = 0._r8 + mat( 282) = 0._r8 + mat( 291) = 0._r8 + mat( 293) = 0._r8 + mat( 294) = 0._r8 + mat( 295) = 0._r8 + mat( 304) = 0._r8 + mat( 314) = 0._r8 + mat( 315) = 0._r8 + mat( 330) = 0._r8 + mat( 331) = 0._r8 + mat( 333) = 0._r8 + mat( 339) = 0._r8 + mat( 352) = 0._r8 + mat( 353) = 0._r8 + mat( 362) = 0._r8 + mat( 368) = 0._r8 + mat( 369) = 0._r8 + mat( 377) = 0._r8 + mat( 378) = 0._r8 + mat( 379) = 0._r8 + mat( 381) = 0._r8 + mat( 386) = 0._r8 + mat( 389) = 0._r8 + mat( 392) = 0._r8 + mat( 398) = 0._r8 + mat( 400) = 0._r8 + mat( 401) = 0._r8 + mat( 402) = 0._r8 + mat( 421) = 0._r8 + mat( 423) = 0._r8 + mat( 445) = 0._r8 + mat( 452) = 0._r8 + mat( 459) = 0._r8 + mat( 461) = 0._r8 + mat( 462) = 0._r8 + mat( 463) = 0._r8 + mat( 464) = 0._r8 + mat( 466) = 0._r8 + mat( 467) = 0._r8 + mat( 468) = 0._r8 + mat( 472) = 0._r8 + mat( 473) = 0._r8 + mat( 474) = 0._r8 + mat( 475) = 0._r8 + mat( 482) = 0._r8 + mat( 485) = 0._r8 + mat( 486) = 0._r8 + mat( 501) = 0._r8 + mat( 502) = 0._r8 + mat( 504) = 0._r8 + mat( 505) = 0._r8 + mat( 506) = 0._r8 + mat( 509) = 0._r8 + mat( 513) = 0._r8 + mat( 533) = 0._r8 + mat( 534) = 0._r8 + mat( 547) = 0._r8 + mat( 548) = 0._r8 + mat( 549) = 0._r8 + mat( 550) = 0._r8 + mat( 553) = 0._r8 + mat( 554) = 0._r8 + mat( 575) = 0._r8 + mat( 576) = 0._r8 + mat( 579) = 0._r8 + mat( 580) = 0._r8 + mat( 582) = 0._r8 + mat( 583) = 0._r8 + mat( 585) = 0._r8 + mat( 587) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 4) = mat( 4) - dti + mat( 7) = mat( 7) - dti + mat( 9) = mat( 9) - dti + mat( 12) = mat( 12) - dti + mat( 14) = mat( 14) - dti + mat( 18) = mat( 18) - dti + mat( 22) = mat( 22) - dti + mat( 28) = mat( 28) - dti + mat( 33) = mat( 33) - dti + mat( 40) = mat( 40) - dti + mat( 47) = mat( 47) - dti + mat( 53) = mat( 53) - dti + mat( 60) = mat( 60) - dti + mat( 67) = mat( 67) - dti + mat( 73) = mat( 73) - dti + mat( 78) = mat( 78) - dti + mat( 86) = mat( 86) - dti + mat( 95) = mat( 95) - dti + mat( 104) = mat( 104) - dti + mat( 110) = mat( 110) - dti + mat( 117) = mat( 117) - dti + mat( 123) = mat( 123) - dti + mat( 131) = mat( 131) - dti + mat( 140) = mat( 140) - dti + mat( 151) = mat( 151) - dti + mat( 162) = mat( 162) - dti + mat( 169) = mat( 169) - dti + mat( 179) = mat( 179) - dti + mat( 189) = mat( 189) - dti + mat( 199) = mat( 199) - dti + mat( 206) = mat( 206) - dti + mat( 215) = mat( 215) - dti + mat( 228) = mat( 228) - dti + mat( 242) = mat( 242) - dti + mat( 261) = mat( 261) - dti + mat( 286) = mat( 286) - dti + mat( 308) = mat( 308) - dti + mat( 347) = mat( 347) - dti + mat( 373) = mat( 373) - dti + mat( 397) = mat( 397) - dti + mat( 419) = mat( 419) - dti + mat( 450) = mat( 450) - dti + mat( 470) = mat( 470) - dti + mat( 490) = mat( 490) - dti + mat( 510) = mat( 510) - dti + mat( 535) = mat( 535) - dti + mat( 557) = mat( 557) - dti + mat( 588) = mat( 588) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_phtadj.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_phtadj.F90 new file mode 100644 index 0000000000..925064e658 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 59) = p_rate(:,k, 59) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 63) = p_rate(:,k, 63) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 64) = p_rate(:,k, 64) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 66) = p_rate(:,k, 66) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 71) = p_rate(:,k, 71) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 75) = p_rate(:,k, 75) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 76) = p_rate(:,k, 76) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 78) = p_rate(:,k, 78) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_prod_loss.F90 new file mode 100644 index 0000000000..990aaa3b9e --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_prod_loss.F90 @@ -0,0 +1,351 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = ((rxt(:,:,108) +rxt(:,:,109) +rxt(:,:,110))* y(:,:,3) & + +rxt(:,:,136)* y(:,:,22) +rxt(:,:,167)* y(:,:,27) + rxt(:,:,47) & + + rxt(:,:,48) + het_rates(:,:,15))* y(:,:,15) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,97) +rxt(:,:,98))* y(:,:,3) + rxt(:,:,5) & + + het_rates(:,:,7))* y(:,:,7) + prod(:,:,2) = 0._r8 + loss(:,:,3) = ((rxt(:,:,143) +rxt(:,:,144))* y(:,:,22) + het_rates(:,:,19)) & + * y(:,:,19) + prod(:,:,3) = (rxt(:,:,46) +rxt(:,:,79) +rxt(:,:,243)*y(:,:,55))*y(:,:,51) & + +.380_r8*rxt(:,:,48)*y(:,:,15) +rxt(:,:,203)*y(:,:,41)*y(:,:,27) + loss(:,:,4) = (rxt(:,:,111)* y(:,:,3) +rxt(:,:,155)* y(:,:,22) +rxt(:,:,162) & + * y(:,:,27) + het_rates(:,:,20))* y(:,:,20) + prod(:,:,4) = (1.440_r8*rxt(:,:,48) +rxt(:,:,110)*y(:,:,3))*y(:,:,15) + loss(:,:,5) = (rxt(:,:,204)* y(:,:,22) +rxt(:,:,203)* y(:,:,27) + rxt(:,:,36) & + + het_rates(:,:,41))* y(:,:,41) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,105)* y(:,:,3) +rxt(:,:,207)* y(:,:,22) + rxt(:,:,43) & + + het_rates(:,:,42))* y(:,:,42) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,100)* y(:,:,3) + rxt(:,:,39) + het_rates(:,:,43)) & + * y(:,:,43) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,101)* y(:,:,3) + rxt(:,:,40) + het_rates(:,:,44)) & + * y(:,:,44) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,102)* y(:,:,3) + rxt(:,:,41) + het_rates(:,:,45)) & + * y(:,:,45) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,103)* y(:,:,3) +rxt(:,:,206)* y(:,:,22) + rxt(:,:,42) & + + het_rates(:,:,46))* y(:,:,46) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,104)* y(:,:,3) + rxt(:,:,37) + het_rates(:,:,47)) & + * y(:,:,47) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,205)* y(:,:,22) + rxt(:,:,38) + het_rates(:,:,48)) & + * y(:,:,48) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,107)* y(:,:,3) + rxt(:,:,44) + het_rates(:,:,49)) & + * y(:,:,49) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,106)* y(:,:,3) + rxt(:,:,45) + het_rates(:,:,50)) & + * y(:,:,50) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,243)* y(:,:,55) + rxt(:,:,46) + rxt(:,:,79) & + + het_rates(:,:,51))* y(:,:,51) + prod(:,:,15) = (rxt(:,:,143)*y(:,:,22) +rxt(:,:,144)*y(:,:,22))*y(:,:,19) & + +.440_r8*rxt(:,:,48)*y(:,:,15) + loss(:,:,16) = ( + het_rates(:,:,25))* y(:,:,25) + prod(:,:,16) = 0._r8 + loss(:,:,17) = ( + het_rates(:,:,26))* y(:,:,26) + prod(:,:,17) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(42) = (rxt(81)* y(2) +rxt(99)* y(3) +rxt(121)* y(9) +rxt(124)* y(10) & + +rxt(146)* y(21) +rxt(151)* y(22) +rxt(158)* y(23) +rxt(161)* y(27) & + +rxt(187)* y(36) +rxt(212)* y(60) +rxt(215)* y(61) + rxt(3) + rxt(4) & + + het_rates(1))* y(1) + prod(42) =rxt(80)*y(4)*y(2) + loss(39) = (rxt(81)* y(1) + 2._r8*rxt(82)* y(2) +rxt(80)* y(4) +rxt(119) & + * y(9) + (rxt(122) +rxt(123))* y(10) +rxt(130)* y(11) +rxt(142) & + * y(18) +rxt(150)* y(22) +rxt(157)* y(23) +rxt(160)* y(24) +rxt(168) & + * y(29) +rxt(180)* y(32) +rxt(181)* y(33) +rxt(184)* y(34) +rxt(190) & + * y(37) +rxt(200)* y(38) +rxt(201)* y(39) +rxt(202)* y(40) & + + (rxt(242) +rxt(251))* y(52) +rxt(248)* y(54) +rxt(208)* y(59) & + + rxt(54) + rxt(55) + rxt(56) + rxt(67) + rxt(68) + rxt(69) & + + het_rates(2))* y(2) + prod(39) = (rxt(1) +2.000_r8*rxt(2) +rxt(60) +rxt(61) +rxt(62) + & + 2.000_r8*rxt(65) +rxt(72) +rxt(73) +rxt(74) +2.000_r8*rxt(77) + & + rxt(94)*y(3) +rxt(95)*y(3) +rxt(116)*y(8) +rxt(211)*y(60) + & + rxt(214)*y(61) +rxt(240)*y(55) +rxt(247)*y(54))*y(4) & + + (rxt(117)*y(9) +rxt(118)*y(10) +rxt(244)*y(53))*y(8) & + + (rxt(252)*y(56) +1.150_r8*rxt(253)*y(53))*y(57) +rxt(4)*y(1) & + +rxt(93)*y(3) +rxt(6)*y(9) +rxt(8)*y(10) +rxt(12)*y(11) +rxt(10) & + *y(14) +rxt(149)*y(23)*y(21) +rxt(153)*y(22)*y(22) +rxt(24)*y(29) & + +rxt(25)*y(30) +rxt(32)*y(37) +rxt(53)*y(61) +rxt(50)*y(62) +rxt(51) & + *y(63) +rxt(21)*y(66) + loss(45) = (rxt(99)* y(1) + (rxt(94) +rxt(95))* y(4) + (rxt(97) +rxt(98)) & + * y(7) + (rxt(108) +rxt(109) +rxt(110))* y(15) +rxt(111)* y(20) & + +rxt(112)* y(32) +rxt(113)* y(38) +rxt(105)* y(42) +rxt(100)* y(43) & + +rxt(101)* y(44) +rxt(102)* y(45) +rxt(103)* y(46) +rxt(104)* y(47) & + +rxt(107)* y(49) +rxt(106)* y(50) +rxt(96)* y(66) + rxt(93) & + + het_rates(3))* y(3) + prod(45) = (rxt(1) +rxt(114)*y(58))*y(4) +rxt(3)*y(1) +.850_r8*rxt(253)*y(57) & + *y(53) +rxt(20)*y(66) + loss(49) = (rxt(80)* y(2) +rxt(94)* y(3) +rxt(90)* y(6) +rxt(116)* y(8) & + +rxt(145)* y(21) +rxt(249)* y(52) + (rxt(246) +rxt(247))* y(54) & + +rxt(240)* y(55) +rxt(114)* y(58) +rxt(211)* y(60) +rxt(214)* y(61) & + +rxt(221)* y(64) + rxt(1) + rxt(2) + rxt(58) + rxt(60) + rxt(61) & + + rxt(62) + rxt(65) + rxt(70) + rxt(72) + rxt(73) + rxt(74) & + + rxt(77) + het_rates(4))* y(4) + prod(49) = (rxt(4) +2.000_r8*rxt(81)*y(2) +2.000_r8*rxt(99)*y(3) + & + rxt(121)*y(9) +rxt(124)*y(10) +rxt(146)*y(21) +rxt(151)*y(22) + & + 2.000_r8*rxt(158)*y(23) +rxt(161)*y(27) +rxt(187)*y(36) + & + rxt(212)*y(60) +rxt(215)*y(61))*y(1) + (rxt(132)*y(11) + & + rxt(138)*y(16) +rxt(148)*y(21) +rxt(152)*y(22) +rxt(157)*y(2) + & + rxt(159)*y(23) +rxt(164)*y(27) +rxt(171)*y(29) +rxt(188)*y(36) + & + rxt(192)*y(37))*y(23) + (rxt(82)*y(2) +rxt(89)*y(6) +rxt(122)*y(10) + & + rxt(130)*y(11) +rxt(150)*y(22) +rxt(168)*y(29) +rxt(190)*y(37))*y(2) & + + (rxt(170)*y(22) +rxt(174)*y(29) +rxt(175)*y(29) +rxt(196)*y(37) + & + rxt(197)*y(37))*y(29) + (rxt(91) +rxt(92) +2.000_r8*rxt(90)*y(4)) & + *y(6) +rxt(98)*y(7)*y(3) +rxt(88)*y(5) +rxt(245)*y(53)*y(9) +rxt(13) & + *y(11) +rxt(134)*y(22)*y(13) +rxt(198)*y(37)*y(37) + loss(3) = (rxt(86)* y(1) +rxt(83)* y(2) +rxt(84)* y(4) +rxt(87)* y(51) & + + rxt(85) + rxt(88) + het_rates(5))* y(5) + prod(3) =rxt(94)*y(4)*y(3) + loss(2) = (rxt(89)* y(2) +rxt(90)* y(4) + rxt(91) + rxt(92) + het_rates(6)) & + * y(6) + prod(2) = (rxt(85) +rxt(87)*y(51) +rxt(83)*y(2) +rxt(84)*y(4) +rxt(86)*y(1)) & + *y(5) +rxt(3)*y(1) + loss(27) = (rxt(116)* y(4) +rxt(117)* y(9) +rxt(118)* y(10) +rxt(244)* y(53) & + + rxt(57) + het_rates(8))* y(8) + prod(27) = (rxt(115)*y(58) +rxt(248)*y(54))*y(2) + (.200_r8*rxt(252)*y(56) + & + 1.100_r8*rxt(254)*y(52))*y(57) +rxt(246)*y(54)*y(4) +rxt(6)*y(9) & + +rxt(241)*y(55) + loss(38) = (rxt(121)* y(1) +rxt(119)* y(2) +rxt(117)* y(8) +rxt(129)* y(11) & + +rxt(137)* y(16) +rxt(120)* y(23) +rxt(172)* y(29) +rxt(193)* y(37) & + +rxt(245)* y(53) + rxt(6) + rxt(7) + het_rates(9))* y(9) + prod(38) = (rxt(8) +rxt(122)*y(2) +rxt(216)*y(61))*y(10) + (rxt(114)*y(58) + & + rxt(116)*y(8))*y(4) +2.000_r8*rxt(97)*y(7)*y(3) +rxt(13)*y(11) & + +rxt(10)*y(14) +rxt(250)*y(53) + loss(40) = (rxt(124)* y(1) + (rxt(122) +rxt(123))* y(2) +rxt(118)* y(8) & + +rxt(125)* y(11) +rxt(127)* y(22) +rxt(133)* y(23) +rxt(173)* y(29) & + +rxt(194)* y(37) +rxt(216)* y(61) + rxt(8) + het_rates(10))* y(10) + prod(40) = (rxt(119)*y(2) +rxt(120)*y(23) +rxt(121)*y(1) + & + 2.000_r8*rxt(129)*y(11) +rxt(137)*y(16) +rxt(172)*y(29) + & + rxt(193)*y(37))*y(9) + (rxt(12) +rxt(130)*y(2) +rxt(131)*y(22) + & + rxt(132)*y(23))*y(11) + (rxt(15) +rxt(135) +rxt(134)*y(22))*y(13) & + + (rxt(9) +rxt(126))*y(14) +rxt(11)*y(12) +rxt(30)*y(34) +rxt(35) & + *y(40) + loss(43) = (rxt(151)* y(1) +rxt(150)* y(2) +rxt(127)* y(10) +rxt(131)* y(11) & + +rxt(128)* y(12) +rxt(134)* y(13) +rxt(136)* y(15) +rxt(139)* y(17) & + +rxt(141)* y(18) + (rxt(143) +rxt(144))* y(19) +rxt(155)* y(20) & + + 2._r8*(rxt(153) +rxt(154))* y(22) +rxt(152)* y(23) +rxt(156) & + * y(24) + (rxt(169) +rxt(170))* y(29) +rxt(179)* y(32) +rxt(183) & + * y(33) +rxt(185)* y(34) +rxt(191)* y(37) +rxt(199)* y(38) +rxt(204) & + * y(41) +rxt(207)* y(42) +rxt(206)* y(46) +rxt(205)* y(48) +rxt(209) & + * y(59) +rxt(210)* y(60) +rxt(213)* y(61) +rxt(220)* y(62) & + + het_rates(22))* y(22) + prod(43) = (rxt(142)*y(18) +rxt(157)*y(23) +rxt(160)*y(24) +rxt(180)*y(32) + & + rxt(181)*y(33) +rxt(200)*y(38) +rxt(201)*y(39))*y(2) & + + (rxt(108)*y(15) +rxt(111)*y(20) +2.000_r8*rxt(96)*y(66) + & + rxt(112)*y(32) +rxt(113)*y(38))*y(3) + (rxt(120)*y(9) + & + rxt(132)*y(11) +2.000_r8*rxt(147)*y(21) +rxt(158)*y(1) + & + rxt(165)*y(27))*y(23) +rxt(146)*y(21)*y(1) +rxt(11)*y(12) +rxt(14) & + *y(13) +rxt(16)*y(17) +2.000_r8*rxt(22)*y(24) +rxt(27)*y(33) +rxt(33) & + *y(39) +rxt(19)*y(66) + loss(33) = (rxt(130)* y(2) +rxt(129)* y(9) +rxt(125)* y(10) +rxt(140)* y(18) & + +rxt(131)* y(22) +rxt(132)* y(23) + rxt(12) + rxt(13) & + + het_rates(11))* y(11) + prod(33) = (rxt(29) +rxt(184)*y(2) +rxt(185)*y(22) +rxt(186)*y(27))*y(34) & + + (rxt(9) +rxt(10) +rxt(126))*y(14) + (rxt(123)*y(10) + & + rxt(202)*y(40))*y(2) +rxt(124)*y(10)*y(1) +rxt(128)*y(22)*y(12) & + +rxt(14)*y(13) +rxt(34)*y(40) + loss(22) = (rxt(128)* y(22) + rxt(11) + het_rates(12))* y(12) + prod(22) = (rxt(224) +rxt(230) +rxt(235) +rxt(226)*y(32) +rxt(231)*y(32) + & + rxt(237)*y(32))*y(34) + (2.000_r8*rxt(223) +2.000_r8*rxt(229) + & + 2.000_r8*rxt(234))*y(14) + (rxt(225) +rxt(233) +rxt(236))*y(40) & + +rxt(127)*y(22)*y(10) +rxt(140)*y(18)*y(11) + loss(13) = (rxt(134)* y(22) + rxt(14) + rxt(15) + rxt(135) + het_rates(13)) & + * y(13) + prod(13) =rxt(133)*y(23)*y(10) + loss(8) = ( + rxt(9) + rxt(10) + rxt(126) + rxt(223) + rxt(229) + rxt(234) & + + het_rates(14))* y(14) + prod(8) =rxt(125)*y(11)*y(10) + loss(28) = (rxt(137)* y(9) +rxt(138)* y(23) + het_rates(16))* y(16) + prod(28) = (rxt(108)*y(3) +rxt(136)*y(22) +rxt(167)*y(27))*y(15) & + +rxt(139)*y(22)*y(17) + loss(11) = (rxt(139)* y(22) + rxt(16) + het_rates(17))* y(17) + prod(11) =rxt(138)*y(23)*y(16) + loss(46) = (rxt(142)* y(2) +rxt(140)* y(11) +rxt(141)* y(22) +rxt(166)* y(27) & + +rxt(189)* y(36) + rxt(17) + rxt(18) + het_rates(18))* y(18) + prod(46) = (rxt(109)*y(15) +rxt(110)*y(15))*y(3) +rxt(137)*y(16)*y(9) & + +rxt(16)*y(17) + loss(32) = (rxt(146)* y(1) +rxt(145)* y(4) + (rxt(147) +rxt(148) +rxt(149)) & + * y(23) + het_rates(21))* y(21) + prod(32) = (rxt(144)*y(19) +rxt(155)*y(20) +rxt(141)*y(18) +rxt(150)*y(2) + & + rxt(209)*y(59) +rxt(210)*y(60) +rxt(213)*y(61))*y(22) & + + (rxt(109)*y(15) +rxt(111)*y(20))*y(3) + (rxt(19) + & + 2.000_r8*rxt(21))*y(66) +rxt(16)*y(17) +2.000_r8*rxt(17)*y(18) & + +rxt(162)*y(27)*y(20) +rxt(28)*y(32) + loss(47) = (rxt(158)* y(1) +rxt(157)* y(2) +rxt(120)* y(9) +rxt(133)* y(10) & + +rxt(132)* y(11) +rxt(138)* y(16) + (rxt(147) +rxt(148) +rxt(149)) & + * y(21) +rxt(152)* y(22) + 2._r8*rxt(159)* y(23) + (rxt(164) + & + rxt(165))* y(27) +rxt(171)* y(29) +rxt(188)* y(36) +rxt(192)* y(37) & + + het_rates(23))* y(23) + prod(47) = (rxt(143)*y(19) +rxt(204)*y(41) +rxt(207)*y(42) +rxt(131)*y(11) + & + rxt(151)*y(1) +rxt(156)*y(24) +rxt(169)*y(29) +rxt(191)*y(37))*y(22) & + + (rxt(140)*y(11) +rxt(142)*y(2) +rxt(166)*y(27) +rxt(189)*y(36)) & + *y(18) + (rxt(145)*y(21) +rxt(221)*y(64))*y(4) + (rxt(15) +rxt(135)) & + *y(13) + (rxt(160)*y(2) +rxt(163)*y(27))*y(24) +rxt(109)*y(15)*y(3) & + +rxt(137)*y(16)*y(9) +rxt(203)*y(41)*y(27) + loss(18) = (rxt(160)* y(2) +rxt(156)* y(22) +rxt(163)* y(27) + rxt(22) & + + het_rates(24))* y(24) + prod(18) =rxt(154)*y(22)*y(22) +rxt(159)*y(23)*y(23) + loss(44) = (rxt(96)* y(3) +rxt(222)* y(63) + rxt(19) + rxt(20) + rxt(21) & + + het_rates(66))* y(66) + prod(44) = (rxt(136)*y(15) +rxt(155)*y(20) +rxt(204)*y(41) +rxt(205)*y(48) + & + rxt(206)*y(46) +rxt(207)*y(42) +rxt(128)*y(12) +rxt(134)*y(13) + & + rxt(139)*y(17) +rxt(141)*y(18) +rxt(152)*y(23) +rxt(153)*y(22) + & + rxt(156)*y(24) +rxt(179)*y(32) +rxt(183)*y(33) +rxt(199)*y(38))*y(22) & + + (rxt(227)*y(33) +rxt(228)*y(39) +rxt(232)*y(33) +rxt(238)*y(33) + & + rxt(239)*y(39))*y(32) +rxt(149)*y(23)*y(21) +rxt(49)*y(65) + loss(48) = (rxt(161)* y(1) +rxt(167)* y(15) +rxt(166)* y(18) +rxt(162)* y(20) & + + (rxt(164) +rxt(165))* y(23) +rxt(163)* y(24) +rxt(182)* y(33) & + +rxt(186)* y(34) +rxt(203)* y(41) + het_rates(27))* y(27) + prod(48) = (rxt(24) +rxt(168)*y(2) +rxt(169)*y(22) +rxt(172)*y(9) + & + 2.000_r8*rxt(174)*y(29) +rxt(176)*y(29) +rxt(196)*y(37) + & + rxt(217)*y(61))*y(29) + (3.000_r8*rxt(100)*y(43) + & + 2.000_r8*rxt(101)*y(44) +3.000_r8*rxt(102)*y(45) +rxt(103)*y(46) + & + 4.000_r8*rxt(104)*y(47) +rxt(112)*y(32))*y(3) + (rxt(204)*y(41) + & + 3.000_r8*rxt(205)*y(48) +rxt(206)*y(46) +rxt(179)*y(32))*y(22) & + + (rxt(28) +rxt(180)*y(2))*y(32) +2.000_r8*rxt(23)*y(28) & + +2.000_r8*rxt(26)*y(31) +rxt(27)*y(33) +rxt(29)*y(34) +rxt(31)*y(35) + loss(5) = ( + rxt(23) + het_rates(28))* y(28) + prod(5) = (rxt(226)*y(34) +rxt(227)*y(33) +rxt(231)*y(34) +rxt(232)*y(33) + & + rxt(237)*y(34) +rxt(238)*y(33))*y(32) +rxt(186)*y(34)*y(27) & + +rxt(175)*y(29)*y(29) + loss(37) = (rxt(168)* y(2) +rxt(172)* y(9) +rxt(173)* y(10) + (rxt(169) + & + rxt(170))* y(22) +rxt(171)* y(23) + 2._r8*(rxt(174) +rxt(175) + & + rxt(176) +rxt(177))* y(29) + (rxt(195) +rxt(196) +rxt(197))* y(37) & + +rxt(217)* y(61) + rxt(24) + het_rates(29))* y(29) + prod(37) = (rxt(161)*y(1) +rxt(165)*y(23) +rxt(182)*y(33))*y(27) & + + (rxt(181)*y(33) +rxt(184)*y(34))*y(2) + (rxt(25) +rxt(219)*y(61)) & + *y(30) +rxt(183)*y(33)*y(22) +2.000_r8*rxt(178)*y(31) +rxt(30)*y(34) + loss(9) = (rxt(219)* y(61) + rxt(25) + het_rates(30))* y(30) + prod(9) = (rxt(176)*y(29) +rxt(195)*y(37))*y(29) + loss(1) = ( + rxt(26) + rxt(178) + het_rates(31))* y(31) + prod(1) =rxt(177)*y(29)*y(29) + loss(36) = (rxt(180)* y(2) +rxt(112)* y(3) +rxt(179)* y(22) + (rxt(227) + & + rxt(232) +rxt(238))* y(33) + (rxt(226) +rxt(231) +rxt(237))* y(34) & + + (rxt(228) +rxt(239))* y(39) + rxt(28) + het_rates(32))* y(32) + prod(36) = (rxt(162)*y(20) +rxt(167)*y(15) +2.000_r8*rxt(203)*y(41) + & + rxt(163)*y(24) +rxt(164)*y(23) +rxt(166)*y(18) +rxt(182)*y(33))*y(27) & + +rxt(170)*y(29)*y(22) + loss(29) = (rxt(181)* y(2) +rxt(183)* y(22) +rxt(182)* y(27) + (rxt(227) + & + rxt(232) +rxt(238))* y(32) + rxt(27) + het_rates(33))* y(33) + prod(29) = (rxt(224) +rxt(230) +rxt(235) +rxt(185)*y(22))*y(34) & + +rxt(171)*y(29)*y(23) + loss(30) = (rxt(184)* y(2) +rxt(185)* y(22) +rxt(186)* y(27) + (rxt(226) + & + rxt(231) +rxt(237))* y(32) + rxt(29) + rxt(30) + rxt(224) + rxt(230) & + + rxt(235) + het_rates(34))* y(34) + prod(30) =rxt(173)*y(29)*y(10) + loss(6) = ( + rxt(31) + het_rates(35))* y(35) + prod(6) = (rxt(228)*y(39) +rxt(239)*y(39))*y(32) +rxt(197)*y(37)*y(29) + loss(35) = (rxt(187)* y(1) +rxt(189)* y(18) +rxt(188)* y(23) + het_rates(36)) & + * y(36) + prod(35) = (rxt(32) +rxt(190)*y(2) +rxt(191)*y(22) +rxt(193)*y(9) + & + rxt(195)*y(29) +rxt(196)*y(29) +2.000_r8*rxt(198)*y(37) + & + rxt(218)*y(61))*y(37) + (rxt(105)*y(42) +rxt(106)*y(50) + & + rxt(107)*y(49) +rxt(113)*y(38))*y(3) + (rxt(207)*y(42) + & + rxt(199)*y(38))*y(22) +rxt(200)*y(38)*y(2) +rxt(31)*y(35) +rxt(33) & + *y(39) +rxt(34)*y(40) + loss(41) = (rxt(190)* y(2) +rxt(193)* y(9) +rxt(194)* y(10) +rxt(191)* y(22) & + +rxt(192)* y(23) + (rxt(195) +rxt(196) +rxt(197))* y(29) & + + 2._r8*rxt(198)* y(37) +rxt(218)* y(61) + rxt(32) + het_rates(37)) & + * y(37) + prod(41) = (rxt(201)*y(39) +rxt(202)*y(40))*y(2) +rxt(187)*y(36)*y(1) & + +rxt(35)*y(40) + loss(20) = (rxt(200)* y(2) +rxt(113)* y(3) +rxt(199)* y(22) + het_rates(38)) & + * y(38) + prod(20) = (rxt(188)*y(23) +rxt(189)*y(18))*y(36) + loss(23) = (rxt(201)* y(2) + (rxt(228) +rxt(239))* y(32) + rxt(33) & + + het_rates(39))* y(39) + prod(23) = (rxt(225) +rxt(233) +rxt(236))*y(40) +rxt(192)*y(37)*y(23) + loss(17) = (rxt(202)* y(2) + rxt(34) + rxt(35) + rxt(225) + rxt(233) & + + rxt(236) + het_rates(40))* y(40) + prod(17) =rxt(194)*y(37)*y(10) + loss(19) = ((rxt(242) +rxt(251))* y(2) +rxt(249)* y(4) +rxt(254)* y(57) & + + het_rates(52))* y(52) + prod(19) = 0._r8 + loss(24) = (rxt(244)* y(8) +rxt(245)* y(9) +rxt(253)* y(57) + rxt(250) & + + het_rates(53))* y(53) + prod(24) = (rxt(58) +rxt(70) +rxt(240)*y(55) +rxt(246)*y(54) +rxt(249)*y(52)) & + *y(4) +rxt(243)*y(55)*y(51) + loss(14) = (rxt(248)* y(2) + (rxt(246) +rxt(247))* y(4) + het_rates(54)) & + * y(54) + prod(14) =rxt(57)*y(8) + loss(15) = (rxt(240)* y(4) +rxt(243)* y(51) + rxt(241) + het_rates(55)) & + * y(55) + prod(15) = (rxt(54) +rxt(55) +rxt(56) +rxt(67) +rxt(68) +rxt(69) + & + rxt(248)*y(54) +rxt(251)*y(52))*y(2) + (rxt(60) +rxt(61) +rxt(62) + & + rxt(72) +rxt(73) +rxt(74))*y(4) + loss(25) = (rxt(252)* y(57) + het_rates(56))* y(56) + prod(25) = (rxt(250) +rxt(244)*y(8) +rxt(245)*y(9))*y(53) +rxt(242)*y(52) & + *y(2) +rxt(247)*y(54)*y(4) +rxt(7)*y(9) +rxt(241)*y(55) + loss(16) = (rxt(115)* y(2) +rxt(114)* y(4) + het_rates(58))* y(58) + prod(16) = (rxt(242)*y(2) +.900_r8*rxt(254)*y(57))*y(52) & + +.800_r8*rxt(252)*y(57)*y(56) + loss(26) = (rxt(254)* y(52) +rxt(253)* y(53) +rxt(252)* y(56) & + + het_rates(57))* y(57) + prod(26) = (rxt(58) +rxt(60) +rxt(61) +rxt(62) +rxt(70) +rxt(72) +rxt(73) + & + rxt(74))*y(4) + (rxt(54) +rxt(55) +rxt(56) +rxt(67) +rxt(68) + & + rxt(69))*y(2) +rxt(57)*y(8) +rxt(7)*y(9) + loss(10) = (rxt(208)* y(2) +rxt(209)* y(22) + rxt(52) + het_rates(59))* y(59) + prod(10) = 0._r8 + loss(21) = (rxt(212)* y(1) +rxt(211)* y(4) +rxt(210)* y(22) + het_rates(60)) & + * y(60) + prod(21) =rxt(52)*y(59) +rxt(53)*y(61) + loss(34) = (rxt(215)* y(1) +rxt(214)* y(4) +rxt(216)* y(10) +rxt(213)* y(22) & + +rxt(217)* y(29) +rxt(219)* y(30) +rxt(218)* y(37) + rxt(53) & + + het_rates(61))* y(61) + prod(34) = (rxt(210)*y(22) +rxt(211)*y(4) +rxt(212)*y(1))*y(60) & + +rxt(208)*y(59)*y(2) +rxt(50)*y(62) + loss(31) = (rxt(220)* y(22) + rxt(50) + het_rates(62))* y(62) + prod(31) = (rxt(213)*y(22) +rxt(214)*y(4) +rxt(215)*y(1) +rxt(216)*y(10) + & + rxt(217)*y(29) +rxt(218)*y(37) +rxt(219)*y(30))*y(61) +rxt(209)*y(59) & + *y(22) +rxt(51)*y(63) + loss(7) = (rxt(222)* y(66) + rxt(51) + het_rates(63))* y(63) + prod(7) =rxt(221)*y(64)*y(4) +rxt(49)*y(65) + loss(12) = (rxt(221)* y(4) + het_rates(64))* y(64) + prod(12) =rxt(220)*y(62)*y(22) + loss(4) = ( + rxt(49) + het_rates(65))* y(65) + prod(4) =rxt(222)*y(66)*y(63) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..d7a0ee88e6 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_rxt_rates_conv.F90 @@ -0,0 +1,266 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 12) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 17) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 18) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 18) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 66) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 66) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 66) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 28) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 29) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 30) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 31) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 33) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 32) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 34) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 34) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 35) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 37) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 39) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 40) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 40) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 41) ! rate_const*CH3CL + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 47) ! rate_const*CCL4 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 48) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 43) ! rate_const*CFC11 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 44) ! rate_const*CFC12 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 45) ! rate_const*CFC113 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 46) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 42) ! rate_const*CH3BR + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 49) ! rate_const*CF3BR + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 50) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 51) ! rate_const*CO2 + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 65) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 62) ! rate_const*SO2 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 63) ! rate_const*SO3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 59) ! rate_const*OCS + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 61) ! rate_const*SO + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 8) ! rate_const*N + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 51) ! rate_const*CO2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 5)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 5) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 5)*sol(:ncol,:, 51) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 5) ! rate_const*O2_1S + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 6) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 6) ! rate_const*O2_1D + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 3) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 3)*sol(:ncol,:, 66) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 3)*sol(:ncol,:, 43) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 3)*sol(:ncol,:, 44) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 3)*sol(:ncol,:, 45) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 3)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 3)*sol(:ncol,:, 47) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 3)*sol(:ncol,:, 42) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 3)*sol(:ncol,:, 50) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 3)*sol(:ncol,:, 49) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 3)*sol(:ncol,:, 20) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 3)*sol(:ncol,:, 32) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 3)*sol(:ncol,:, 38) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 58)*sol(:ncol,:, 4) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 58)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 8)*sol(:ncol,:, 4) ! rate_const*N*O2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 8)*sol(:ncol,:, 9) ! rate_const*N*NO + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 9)*sol(:ncol,:, 23) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 9)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 10)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 14) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 10)*sol(:ncol,:, 22) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 12)*sol(:ncol,:, 22) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 11)*sol(:ncol,:, 22) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 11)*sol(:ncol,:, 23) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 10)*sol(:ncol,:, 23) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 13)*sol(:ncol,:, 22) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 13) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 15)*sol(:ncol,:, 22) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 16)*sol(:ncol,:, 9) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 16)*sol(:ncol,:, 23) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 17)*sol(:ncol,:, 22) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 18)*sol(:ncol,:, 11) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 18)*sol(:ncol,:, 22) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 18)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 19)*sol(:ncol,:, 22) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 19)*sol(:ncol,:, 22) ! rate_const*CO*OH + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 21)*sol(:ncol,:, 4) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 21)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 21)*sol(:ncol,:, 23) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 22)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 22)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 22)*sol(:ncol,:, 23) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*OH*OH + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 22)*sol(:ncol,:, 20) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 23)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 23)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 24)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 27)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 27)*sol(:ncol,:, 20) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 27)*sol(:ncol,:, 24) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 27)*sol(:ncol,:, 23) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 27)*sol(:ncol,:, 23) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 27)*sol(:ncol,:, 18) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 27)*sol(:ncol,:, 15) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 29)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 29)*sol(:ncol,:, 22) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 29)*sol(:ncol,:, 22) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 29)*sol(:ncol,:, 23) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 29)*sol(:ncol,:, 9) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 29)*sol(:ncol,:, 10) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 31) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 32)*sol(:ncol,:, 22) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 32)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 33)*sol(:ncol,:, 27) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 33)*sol(:ncol,:, 22) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 34)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 34)*sol(:ncol,:, 22) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 34)*sol(:ncol,:, 27) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 36)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 36)*sol(:ncol,:, 23) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 36)*sol(:ncol,:, 18) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 37)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 37)*sol(:ncol,:, 22) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 37)*sol(:ncol,:, 23) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 37)*sol(:ncol,:, 9) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 37)*sol(:ncol,:, 10) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 37)*sol(:ncol,:, 29) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 37)*sol(:ncol,:, 29) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 37)*sol(:ncol,:, 29) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 37)*sol(:ncol,:, 37) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 38)*sol(:ncol,:, 22) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 38)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 39)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 40)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 41)*sol(:ncol,:, 27) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 41)*sol(:ncol,:, 22) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 48)*sol(:ncol,:, 22) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 46)*sol(:ncol,:, 22) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 42)*sol(:ncol,:, 22) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 59)*sol(:ncol,:, 2) ! rate_const*OCS*O + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 59)*sol(:ncol,:, 22) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 60)*sol(:ncol,:, 22) ! rate_const*S*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 60)*sol(:ncol,:, 4) ! rate_const*S*O2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 60)*sol(:ncol,:, 1) ! rate_const*S*O3 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 61)*sol(:ncol,:, 22) ! rate_const*SO*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 61)*sol(:ncol,:, 4) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 61)*sol(:ncol,:, 1) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 61)*sol(:ncol,:, 10) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 61)*sol(:ncol,:, 29) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 61)*sol(:ncol,:, 37) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 61)*sol(:ncol,:, 30) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 62)*sol(:ncol,:, 22) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 64)*sol(:ncol,:, 4) ! rate_const*HSO3*O2 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 63)*sol(:ncol,:, 66) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 34) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 40) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 34)*sol(:ncol,:, 32) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 33)*sol(:ncol,:, 32) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 39)*sol(:ncol,:, 32) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 34) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 34)*sol(:ncol,:, 32) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 33)*sol(:ncol,:, 32) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 40) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 34) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 40) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 34)*sol(:ncol,:, 32) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 33)*sol(:ncol,:, 32) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 39)*sol(:ncol,:, 32) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 55)*sol(:ncol,:, 4) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 55) ! rate_const*N2*Op + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 52)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 55)*sol(:ncol,:, 51) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 53)*sol(:ncol,:, 8) ! rate_const*O2p*N + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 53)*sol(:ncol,:, 9) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 54)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 54)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 54)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 52)*sol(:ncol,:, 4) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 53) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 52)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 56)*sol(:ncol,:, 57) ! rate_const*NOp*e + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 53)*sol(:ncol,:, 57) ! rate_const*O2p*e + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 52)*sol(:ncol,:, 57) ! rate_const*N2p*e + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_setrxt.F90 new file mode 100644 index 0000000000..bcbf3260e3 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_setrxt.F90 @@ -0,0 +1,322 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,83) = 8.00e-14_r8 + rate(:,:,84) = 3.90e-17_r8 + rate(:,:,87) = 4.20e-13_r8 + rate(:,:,88) = 8.50e-2_r8 + rate(:,:,89) = 1.30e-16_r8 + rate(:,:,91) = 1.00e-20_r8 + rate(:,:,92) = 2.58e-04_r8 + rate(:,:,99) = 1.20e-10_r8 + rate(:,:,100) = 1.70e-10_r8 + rate(:,:,101) = 1.20e-10_r8 + rate(:,:,102) = 1.50e-10_r8 + rate(:,:,103) = 7.20e-11_r8 + rate(:,:,104) = 2.84e-10_r8 + rate(:,:,105) = 1.80e-10_r8 + rate(:,:,106) = 9.60e-11_r8 + rate(:,:,107) = 4.10e-11_r8 + rate(:,:,108) = 1.125e-10_r8 + rate(:,:,109) = 3.00e-11_r8 + rate(:,:,110) = 7.50e-12_r8 + rate(:,:,111) = 1.10e-10_r8 + rate(:,:,112) = 1.50e-10_r8 + rate(:,:,113) = 1.50e-10_r8 + rate(:,:,114) = 5.00e-12_r8 + rate(:,:,115) = 7.00e-13_r8 + rate(:,:,130) = 1.00e-11_r8 + rate(:,:,131) = 2.20e-11_r8 + rate(:,:,132) = 3.50e-12_r8 + rate(:,:,140) = 5.80e-16_r8 + rate(:,:,147) = 7.20e-11_r8 + rate(:,:,148) = 6.90e-12_r8 + rate(:,:,149) = 1.60e-12_r8 + rate(:,:,153) = 1.80e-12_r8 + rate(:,:,156) = 1.80e-12_r8 + rate(:,:,181) = 1.70e-13_r8 + rate(:,:,210) = 6.60E-11_r8 + rate(:,:,211) = 2.30E-12_r8 + rate(:,:,212) = 1.20E-11_r8 + rate(:,:,216) = 1.40E-11_r8 + rate(:,:,217) = 2.80E-11_r8 + rate(:,:,218) = 5.70E-11_r8 + rate(:,:,219) = 1.90E-12_r8 + rate(:,:,243) = 9.e-10_r8 + rate(:,:,244) = 1.0e-10_r8 + rate(:,:,245) = 4.4e-10_r8 + rate(:,:,246) = 4.0e-10_r8 + rate(:,:,247) = 2.0e-10_r8 + rate(:,:,248) = 1.0e-12_r8 + rate(:,:,249) = 6.0e-11_r8 + rate(:,:,250) = 5.e-16_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,81) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,85) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,86) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,90) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,93) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,94) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,95) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,96) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,97) = 6.70e-11_r8 * exp_fac(:,:) + rate(:,:,98) = 4.70e-11_r8 * exp_fac(:,:) + rate(:,:,116) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:,117) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,118) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,171) = 2.70e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,120) = 3.50e-12_r8 * exp_fac(:,:) + rate(:,:,152) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,191) = 1.70e-11_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,121) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,200) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,122) = 5.20e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,124) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,174) = 3.00e-11_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 170._r8 * itemp(:,:) ) + rate(:,:,129) = 1.50e-11_r8 * exp_fac(:,:) + rate(:,:,164) = 1.80e-11_r8 * exp_fac(:,:) + rate(:,:,134) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,136) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,137) = 2.80e-12_r8 * exp( 300._r8 * itemp(:,:) ) + rate(:,:,138) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,139) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,157) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,199) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,141) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,142) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,206) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,146) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:,150) = 2.20e-11_r8 * exp( 120._r8 * itemp(:,:) ) + rate(:,:,151) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:,155) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,158) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,160) = 1.40e-12_r8 * exp( -2000._r8 * itemp(:,:) ) + rate(:,:,161) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,162) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,163) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,165) = 4.10e-11_r8 * exp( -450._r8 * itemp(:,:) ) + rate(:,:,166) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,167) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,168) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + rate(:,:,169) = 7.40e-12_r8 * exp( 270._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,170) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,190) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,198) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,172) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,197) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,175) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,176) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,179) = 2.60e-12_r8 * exp( -350._r8 * itemp(:,:) ) + rate(:,:,180) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,182) = 2.50e-12_r8 * exp( -130._r8 * itemp(:,:) ) + rate(:,:,183) = 3.00e-12_r8 * exp( -500._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,184) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,187) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,189) = 1.70e-11_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -330._r8 * itemp(:,:) ) + rate(:,:,185) = 1.20e-12_r8 * exp_fac(:,:) + rate(:,:,221) = 1.30E-12_r8 * exp_fac(:,:) + rate(:,:,186) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,188) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + rate(:,:,192) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,193) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,196) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,195) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,201) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,202) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + rate(:,:,203) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,204) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,205) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + rate(:,:,207) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,208) = 2.10E-11_r8 * exp( -2200.0_r8 * itemp(:,:) ) + rate(:,:,209) = 1.10E-13_r8 * exp( -1200.0_r8 * itemp(:,:) ) + rate(:,:,213) = 2.70E-11_r8 * exp( 335._r8 * itemp(:,:) ) + rate(:,:,214) = 1.25E-13_r8 * exp( -2190.0_r8 * itemp(:,:) ) + rate(:,:,215) = 3.40E-12_r8 * exp( -1100.0_r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,119), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,123), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,125), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,127), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,133), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,143), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 4.7e-11_r8 * itemp(:,:)**0.2_r8 + call jpl( rate(1,1,145), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.6e-11_r8 + call jpl( rate(1,1,154), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,173), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 2.0e-12_r8 * itemp(:,:)**2.4_r8 + call jpl( rate(1,1,177), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,194), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 3.3E-31_r8 * itemp(:,:)**4.3_r8 + kinf(:,:) = 1.60E-12_r8 + call jpl( rate(1,1,220), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,83) = 8.00e-14_r8 + rate(:,:kbot,84) = 3.90e-17_r8 + rate(:,:kbot,89) = 1.30e-16_r8 + rate(:,:kbot,91) = 1.00e-20_r8 + rate(:,:kbot,114) = 5.00e-12_r8 + rate(:,:kbot,115) = 7.00e-13_r8 + rate(:,:kbot,148) = 6.90e-12_r8 + rate(:,:kbot,244) = 1.0e-10_r8 + rate(:,:kbot,245) = 4.4e-10_r8 + rate(:,:kbot,246) = 4.0e-10_r8 + rate(:,:kbot,247) = 2.0e-10_r8 + rate(:,:kbot,248) = 1.0e-12_r8 + rate(:,:kbot,249) = 6.0e-11_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,81) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,85) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,86) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,90) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,93) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,94) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,95) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,116) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,117) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,120) = 3.50e-12_r8 * exp_fac(:,:) + rate(:,:kbot,152) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:kbot,121) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,122) = 5.20e-12_r8 * exp( 210._r8 * itemp(:,:) ) + rate(:,:kbot,146) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,150) = 2.20e-11_r8 * exp( 120._r8 * itemp(:,:) ) + rate(:,:kbot,151) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,157) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,158) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + + + + + + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 4.7e-11_r8 * itemp(:,:)**0.2_r8 + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,145) = wrk(:,:) + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 new file mode 100644 index 0000000000..bd55d82e05 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_sim_dat.F90 @@ -0,0 +1,368 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 17, 0, 0, 49, 0 /) + + cls_rxt_cnt(:,1) = (/ 13, 41, 0, 17 /) + cls_rxt_cnt(:,4) = (/ 23, 102, 129, 49 /) + + solsym(: 66) = (/ 'O3 ','O ','O1D ','O2 ','O2_1S ', & + 'O2_1D ','N2O ','N ','NO ','NO2 ', & + 'NO3 ','HNO3 ','HO2NO2 ','N2O5 ','CH4 ', & + 'CH3O2 ','CH3OOH ','CH2O ','CO ','H2 ', & + 'H ','OH ','HO2 ','H2O2 ','CLY ', & + 'BRY ','CL ','CL2 ','CLO ','OCLO ', & + 'CL2O2 ','HCL ','HOCL ','CLONO2 ','BRCL ', & + 'BR ','BRO ','HBR ','HOBR ','BRONO2 ', & + 'CH3CL ','CH3BR ','CFC11 ','CFC12 ','CFC113 ', & + 'HCFC22 ','CCL4 ','CH3CCL3 ','CF3BR ','CF2CLBR ', & + 'CO2 ','N2p ','O2p ','Np ','Op ', & + 'NOp ','e ','N2D ','OCS ','S ', & + 'SO ','SO2 ','SO3 ','HSO3 ','H2SO4 ', & + 'H2O ' /) + + adv_mass(: 66) = (/ 47.998200_r8, 15.999400_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, & + 31.998800_r8, 44.012880_r8, 14.006740_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 63.012340_r8, 79.011740_r8, 108.010480_r8, 16.040600_r8, & + 47.032000_r8, 48.039400_r8, 30.025200_r8, 28.010400_r8, 2.014800_r8, & + 1.007400_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, 100.916850_r8, & + 99.716850_r8, 35.452700_r8, 70.905400_r8, 51.452100_r8, 67.451500_r8, & + 102.904200_r8, 36.460100_r8, 52.459500_r8, 97.457640_r8, 115.356700_r8, & + 79.904000_r8, 95.903400_r8, 80.911400_r8, 96.910800_r8, 141.908940_r8, & + 50.485900_r8, 94.937200_r8, 137.367503_r8, 120.913206_r8, 187.375310_r8, & + 86.467906_r8, 153.821800_r8, 133.402300_r8, 148.910210_r8, 165.364506_r8, & + 44.009800_r8, 28.013480_r8, 31.998800_r8, 14.006740_r8, 15.999400_r8, & + 30.006140_r8, 0.548567E-03_r8, 14.006740_r8, 60.076400_r8, 32.066000_r8, & + 48.065400_r8, 64.064800_r8, 80.064200_r8, 81.071600_r8, 98.078400_r8, & + 18.014200_r8 /) + + crb_mass(: 66) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 17,1) = (/ 15, 7, 19, 20, 41, 42, 43, 44, 45, 46, & + 47, 48, 49, 50, 51, 25, 26 /) + clsmap(: 49,4) = (/ 1, 2, 3, 4, 5, 6, 8, 9, 10, 22, & + 11, 12, 13, 14, 16, 17, 18, 21, 23, 24, & + 66, 27, 28, 29, 30, 31, 32, 33, 34, 35, & + 36, 37, 38, 39, 40, 52, 53, 54, 55, 56, & + 58, 57, 59, 60, 61, 62, 63, 64, 65 /) + + permute(: 49,4) = (/ 42, 39, 45, 49, 3, 2, 27, 38, 40, 43, & + 33, 22, 13, 8, 28, 11, 46, 32, 47, 18, & + 44, 48, 5, 37, 9, 1, 36, 29, 30, 6, & + 35, 41, 20, 23, 17, 19, 24, 14, 15, 25, & + 16, 26, 10, 21, 34, 31, 7, 12, 4 /) + + diag_map(: 49) = (/ 1, 4, 7, 9, 12, 14, 18, 22, 28, 33, & + 40, 47, 53, 60, 67, 73, 78, 86, 95, 104, & + 110, 117, 123, 131, 140, 151, 162, 169, 179, 189, & + 199, 206, 215, 228, 242, 261, 286, 308, 347, 373, & + 397, 419, 450, 470, 490, 510, 535, 557, 588 /) + + extfrc_lst(: 12) = (/ 'NO ','NO2 ','CO ','SO2 ','Op ', & + 'O2p ','Np ','N2p ','N2D ','N ', & + 'e ','OH ' /) + + frc_from_dataset(: 12) = (/ .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 155) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jbrono2_a ', & + 'jbrono2_b ', 'jch3cl ', & + 'jccl4 ', 'jch3ccl3 ', & + 'jcfcl3 ', 'jcf2cl2 ', & + 'jcfc113 ', 'jhcfc22 ', & + 'jch3br ', 'jcf3br ', & + 'jcf2clbr ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jh2so4 ', 'jso2 ', & + 'jso3 ', 'jocs ', & + 'jso ', 'jeuv_1 ', & + 'jeuv_2 ', 'jeuv_3 ', & + 'jeuv_4 ', 'jeuv_5 ', & + 'jeuv_6 ', 'jeuv_7 ', & + 'jeuv_8 ', 'jeuv_9 ', & + 'jeuv_10 ', 'jeuv_11 ', & + 'jeuv_12 ', 'jeuv_13 ', & + 'jeuv_14 ', 'jeuv_15 ', & + 'jeuv_16 ', 'jeuv_17 ', & + 'jeuv_18 ', 'jeuv_19 ', & + 'jeuv_20 ', 'jeuv_21 ', & + 'jeuv_22 ', 'jeuv_23 ', & + 'jeuv_24 ', 'jeuv_25 ', & + 'jeuv_26 ', 'usr_O_O2 ', & + 'O_O3 ', 'usr_O_O ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_N2 ', 'O2_1S_O3 ', & + 'O2_1S_CO2 ', 'ag2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1D_N2 ', 'ag1 ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'N2D_O2 ', & + 'N2D_O ', 'N_O2 ', & + 'N_NO ', 'NO_HO2 ', & + 'NO_O3 ', 'NO2_O ', & + 'tag_NO2_NO3 ', 'usr_N2O5_M ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'tag_NO2_HO2 ', 'usr_HO2NO2_M ', & + 'usr_CO_OH_b ', 'H_O2 ', & + 'H_O3 ', 'tag_H_HO2_a ', & + 'H_HO2 ', 'tag_H_HO2_b ', & + 'OH_O ', 'OH_O3 ', & + 'OH_HO2 ', 'tag_OH_H2O2 ', & + 'HO2_O ', 'HO2_O3 ', & + 'usr_HO2_HO2 ', 'tag_H2O2_O ', & + 'tag_CLO_CLO ', 'usr_CL2O2_M ', & + 'usr_SO3_H2O ', 'het1 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'ion_Op_O2 ', 'ion_Op_N2 ', & + 'ion_N2p_Oa ', 'ion_O2p_N ', & + 'ion_O2p_NO ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_Np_O ', & + 'ion_N2p_O2 ', 'ion_N2p_Ob ', & + 'elec1 ', 'elec2 ', & + 'elec3 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 114, 115, 116, 117, 120, & + 121, 122, 125, 126, 127, 128, 133, 135, 144, 145, & + 146, 147, 148, 149, 150, 151, 152, 156, 157, 158, & + 159, 160, 177, 178, 222, 223, 224, 225, 226, 227, & + 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, & + 238, 239, 240, 241, 242, 244, 245, 246, 247, 248, & + 249, 251, 252, 253, 254 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 80, 81, 82, 83, 84, & + 85, 86, 89, 90, 91, & + 93, 94, 95, 114, 115, & + 116, 117, 120, 121, 122, & + 145, 146, 148, 150, 151, & + 152, 157, 158, 159, 240, & + 241, 242, 244, 245, 246, & + 247, 248, 249, 252, 253, & + 254 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.910000_r8, 32.910000_r8, 189.810000_r8, 177.510000_r8, 229.610000_r8, & + 133.750000_r8, 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, & + 203.400000_r8, 194.710000_r8, 232.590000_r8, 67.670000_r8, 165.300000_r8, & + 293.620000_r8, 226.580000_r8, 120.100000_r8, 165.510000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 2, 3, 2, 3, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 1, 1, 1, 2, 2, 2, 1, & + 1, 2, 2, 1, 1, 1, 1, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc b/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc new file mode 100644 index 0000000000..8940fcefd2 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc @@ -0,0 +1,1491 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O2 + ( 4) N2O + ( 5) N + ( 6) NO + ( 7) NO2 + ( 8) NO3 + ( 9) HNO3 + ( 10) HO2NO2 + ( 11) N2O5 + ( 12) CH4 + ( 13) CH3O2 + ( 14) CH3OOH + ( 15) CH2O + ( 16) CO + ( 17) H2 + ( 18) H + ( 19) H2O2 + ( 20) HONO + ( 21) CLY + ( 22) BRY + ( 23) CL2 (Cl2) + ( 24) CLO (ClO) + ( 25) OCLO (OClO) + ( 26) CL2O2 (Cl2O2) + ( 27) HCL (HCl) + ( 28) HOCL (HOCl) + ( 29) CLONO2 (ClONO2) + ( 30) BRCL (BrCl) + ( 31) BRO (BrO) + ( 32) HBR (HBr) + ( 33) HOBR (HOBr) + ( 34) BRONO2 (BrONO2) + ( 35) CH3CL (CH3Cl) + ( 36) CH3BR (CH3Br) + ( 37) CFC11 (CFCl3) + ( 38) CFC12 (CF2Cl2) + ( 39) CFC113 (CCl2FCClF2) + ( 40) HCFC22 (CHF2Cl) + ( 41) CCL4 (CCl4) + ( 42) CH3CCL3 (CH3CCl3) + ( 43) CF3BR (CF3Br) + ( 44) CF2CLBR (CF2ClBr) + ( 45) HCFC141B (CH3CCl2F) + ( 46) HCFC142B (CH3CClF2) + ( 47) CFC114 (CClF2CClF2) + ( 48) CFC115 (CClF2CF3) + ( 49) H1202 (CBr2F2) + ( 50) H2402 (CBrF2CBrF2) + ( 51) CHBR3 (CHBr3) + ( 52) CH2BR2 (CH2Br2) + ( 53) COF2 + ( 54) COFCL (COFCl) + ( 55) HF + ( 56) F + ( 57) CO2 + ( 58) OCS + ( 59) S + ( 60) SO + ( 61) SO2 + ( 62) SO3 + ( 63) H2SO4 + ( 64) DMS (CH3SCH3) + ( 65) SOAG (C) + ( 66) so4_a1 (NH4HSO4) + ( 67) pom_a1 (C) + ( 68) soa_a1 (C) + ( 69) bc_a1 (C) + ( 70) dst_a1 (AlSiO5) + ( 71) ncl_a1 (NaCl) + ( 72) num_a1 (H) + ( 73) so4_a2 (NH4HSO4) + ( 74) soa_a2 (C) + ( 75) ncl_a2 (NaCl) + ( 76) num_a2 (H) + ( 77) dst_a2 (AlSiO5) + ( 78) dst_a3 (AlSiO5) + ( 79) ncl_a3 (NaCl) + ( 80) so4_a3 (NH4HSO4) + ( 81) num_a3 (H) + ( 82) pom_a4 (C) + ( 83) bc_a4 (C) + ( 84) num_a4 (H) + ( 85) CL (Cl) + ( 86) BR (Br) + ( 87) OH + ( 88) HO2 + ( 89) N2p (N2) + ( 90) O2p (O2) + ( 91) O4p (O4) + ( 92) O2p_H2O (H2O3) + ( 93) Hp_H2O (H3O) + ( 94) Hp_2H2O (H5O2) + ( 95) Hp_3H2O (H7O3) + ( 96) Hp_4H2O (H9O4) + ( 97) Hp_5H2O (H11O5) + ( 98) H3Op_OH (H4O2) + ( 99) Hp_3N1 (H8NO6) + (100) Hp_4N1 (H10NO7) + (101) NOp_H2O (H2NO2) + (102) NOp_2H2O (H4NO3) + (103) NOp_3H2O (H6NO3) + (104) NOp_CO2 (NCO3) + (105) NOp_N2 (N3O) + (106) Om (O) + (107) O2m (O2) + (108) O3m (O3) + (109) O4m (O4) + (110) OHm (OH) + (111) CO3m (CO3) + (112) CO4m (CO4) + (113) NO2m (NO2) + (114) NO3m (NO3) + (115) CO3m_H2O (H2CO4) + (116) CO3m2H2O (H4CO5) + (117) NO2m_H2O (H2NO3) + (118) NO3m_H2O (H2NO4) + (119) NO3m2H2O (H4NO5) + (120) NO3mHNO3 (HN2O6) + (121) NO3m_HCL (NO3HCl) + (122) HCO3m (HCO3) + (123) CLm (Cl) + (124) CLOm (ClO) + (125) CLm_H2O (ClH2O) + (126) CLm_HCL (Cl2H) + (127) Np (N) + (128) Op (O) + (129) NOp (NO) + (130) e (E) + (131) N2D (N) + (132) O2_1S (O2) + (133) O2_1D (O2) + (134) O1D (O) + (135) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CH3CL + ( 4) CH3BR + ( 5) CFC11 + ( 6) CFC12 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) HCFC22 + ( 11) HCFC141B + ( 12) HCFC142B + ( 13) CCL4 + ( 14) CH3CCL3 + ( 15) CF3BR + ( 16) CF2CLBR + ( 17) H1202 + ( 18) H2402 + ( 19) CHBR3 + ( 20) CH2BR2 + ( 21) CLY + ( 22) BRY + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) H2 + ( 8) CO + ( 9) CO2 + ( 10) N + ( 11) NO + ( 12) NO2 + ( 13) OH + ( 14) NO3 + ( 15) HONO + ( 16) HNO3 + ( 17) HO2NO2 + ( 18) N2O5 + ( 19) CH3O2 + ( 20) CH3OOH + ( 21) CH2O + ( 22) H + ( 23) HO2 + ( 24) H2O2 + ( 25) H2O + ( 26) CL + ( 27) CL2 + ( 28) CLO + ( 29) OCLO + ( 30) CL2O2 + ( 31) HCL + ( 32) HOCL + ( 33) CLONO2 + ( 34) BRCL + ( 35) BR + ( 36) BRO + ( 37) HBR + ( 38) HOBR + ( 39) BRONO2 + ( 40) N2p + ( 41) O2p + ( 42) Np + ( 43) Op + ( 44) NOp + ( 45) N2D + ( 46) O4p + ( 47) O2p_H2O + ( 48) Hp_H2O + ( 49) Hp_2H2O + ( 50) Hp_3H2O + ( 51) Hp_4H2O + ( 52) Hp_5H2O + ( 53) H3Op_OH + ( 54) Hp_3N1 + ( 55) Hp_4N1 + ( 56) NOp_H2O + ( 57) NOp_2H2O + ( 58) NOp_3H2O + ( 59) NOp_CO2 + ( 60) NOp_N2 + ( 61) Om + ( 62) O2m + ( 63) O3m + ( 64) O4m + ( 65) CO3m + ( 66) CO4m + ( 67) NO2m + ( 68) NO3m + ( 69) OHm + ( 70) HCO3m + ( 71) CO3m_H2O + ( 72) CO3m2H2O + ( 73) NO2m_H2O + ( 74) NO3m_H2O + ( 75) NO3m2H2O + ( 76) NO3mHNO3 + ( 77) NO3m_HCL + ( 78) CLm + ( 79) CLOm + ( 80) CLm_H2O + ( 81) CLm_HCL + ( 82) e + ( 83) COF2 + ( 84) COFCL + ( 85) HF + ( 86) F + ( 87) OCS + ( 88) S + ( 89) SO + ( 90) SO2 + ( 91) SO3 + ( 92) H2SO4 + ( 93) DMS + ( 94) SOAG + ( 95) so4_a1 + ( 96) pom_a1 + ( 97) soa_a1 + ( 98) bc_a1 + ( 99) dst_a1 + (100) ncl_a1 + (101) num_a1 + (102) so4_a2 + (103) soa_a2 + (104) ncl_a2 + (105) num_a2 + (106) dst_a2 + (107) dst_a3 + (108) ncl_a3 + (109) so4_a3 + (110) num_a3 + (111) pom_a4 + (112) bc_a4 + (113) num_a4 + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> CL + O rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jhbr ( 34) HBR + hv -> BR + H rate = ** User defined ** ( 34) + jbrono2_a ( 35) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 35) + jbrono2_b ( 36) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 36) + jch3cl ( 37) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 37) + jccl4 ( 38) CCL4 + hv -> 4*CL rate = ** User defined ** ( 38) + jch3ccl3 ( 39) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 39) + jcfcl3 ( 40) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 40) + jcf2cl2 ( 41) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 41) + jcfc113 ( 42) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 42) + jcfc114 ( 43) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 43) + jcfc115 ( 44) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 44) + jhcfc22 ( 45) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 45) + jhcfc141b ( 46) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 46) + jhcfc142b ( 47) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 47) + jch3br ( 48) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 48) + jcf3br ( 49) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 49) + jcf2clbr ( 50) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 50) + jchbr3 ( 51) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 51) + jch2br2 ( 52) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 52) + jh1202 ( 53) H1202 + hv -> 2*BR + COF2 rate = ** User defined ** ( 53) + jh2402 ( 54) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 54) + jcof2 ( 55) COF2 + hv -> 2*F rate = ** User defined ** ( 55) + jcofcl ( 56) COFCL + hv -> F + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jco2 ( 58) CO2 + hv -> CO + O rate = ** User defined ** ( 58) + jch4_a ( 59) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 59) + jch4_b ( 60) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 60) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jh2so4 ( 61) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 61) + jso2 ( 62) SO2 + hv -> SO + O rate = ** User defined ** ( 62) + jso3 ( 63) SO3 + hv -> SO2 + O rate = ** User defined ** ( 63) + jocs ( 64) OCS + hv -> S + CO rate = ** User defined ** ( 64) + jso ( 65) SO + hv -> S + O rate = ** User defined ** ( 65) + jhono ( 66) HONO + hv -> OH + NO rate = ** User defined ** ( 66) + jeuv_1 ( 67) O + hv -> Op + e rate = ** User defined ** ( 67) + jeuv_2 ( 68) O + hv -> Op + e rate = ** User defined ** ( 68) + jeuv_3 ( 69) O + hv -> Op + e rate = ** User defined ** ( 69) + jeuv_4 ( 70) N + hv -> Np + e rate = ** User defined ** ( 70) + jeuv_5 ( 71) O2 + hv -> O2p + e rate = ** User defined ** ( 71) + jeuv_6 ( 72) N2 + hv -> N2p + e rate = ** User defined ** ( 72) + jeuv_7 ( 73) O2 + hv -> O + Op + e rate = ** User defined ** ( 73) + jeuv_8 ( 74) O2 + hv -> O + Op + e rate = ** User defined ** ( 74) + jeuv_9 ( 75) O2 + hv -> O + Op + e rate = ** User defined ** ( 75) + jeuv_10 ( 76) N2 + hv -> N + Np + e rate = ** User defined ** ( 76) + jeuv_11 ( 77) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 77) + jeuv_12 ( 78) O2 + hv -> 2*O rate = ** User defined ** ( 78) + jeuv_13 ( 79) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 79) + jeuv_14 ( 80) O + hv -> Op + e rate = ** User defined ** ( 80) + jeuv_15 ( 81) O + hv -> Op + e rate = ** User defined ** ( 81) + jeuv_16 ( 82) O + hv -> Op + e rate = ** User defined ** ( 82) + jeuv_17 ( 83) O2 + hv -> O2p + e rate = ** User defined ** ( 83) + jeuv_18 ( 84) N2 + hv -> N2p + e rate = ** User defined ** ( 84) + jeuv_19 ( 85) O2 + hv -> O + Op + e rate = ** User defined ** ( 85) + jeuv_20 ( 86) O2 + hv -> O + Op + e rate = ** User defined ** ( 86) + jeuv_21 ( 87) O2 + hv -> O + Op + e rate = ** User defined ** ( 87) + jeuv_22 ( 88) N2 + hv -> N + Np + e rate = ** User defined ** ( 88) + jeuv_23 ( 89) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 89) + jeuv_24 ( 90) O2 + hv -> 2*O rate = ** User defined ** ( 90) + jeuv_25 ( 91) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** ( 91) + jeuv_26 ( 92) CO2 + hv -> CO + O rate = ** User defined ** ( 92) + jppi ( 93) O2p_H2O + hv -> O2p + H2O rate = ** User defined ** ( 93) + jepn1 ( 94) Om + hv -> O + e rate = ** User defined ** ( 94) + jepn2 ( 95) O2m + hv -> O2 + e rate = ** User defined ** ( 95) + jepn3 ( 96) O3m + hv -> O3 + e rate = ** User defined ** ( 96) + jepn4 ( 97) OHm + hv -> OH + e rate = ** User defined ** ( 97) + jepn6 ( 98) NO2m + hv -> NO2 + e rate = ** User defined ** ( 98) + jepn7 ( 99) NO3m + hv -> NO3 + e rate = ** User defined ** ( 99) + jpni1 (100) O3m + hv -> Om + O2 rate = ** User defined ** (100) + jpni2 (101) O4m + hv -> O2m + O2 rate = ** User defined ** (101) + jpni3 (102) CO3m + hv -> Om + CO2 rate = ** User defined ** (102) + jpni4 (103) CO4m + hv -> O2m + CO2 rate = ** User defined ** (103) + jpni5 (104) CO3m_H2O + hv -> CO3m + H2O rate = ** User defined ** (104) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** (105) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (106) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** (107) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 (108) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (109) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (110) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (111) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (112) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 (113) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (114) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (115) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (116) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 (117) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (118) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) (119) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) (120) + O1D_H2O ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (121) + O1D_N2Oa ( 18) O1D + N2O -> 2*NO rate = 7.25E-11*exp( 20./t) (122) + O1D_N2Ob ( 19) O1D + N2O -> N2 + O2 rate = 4.63E-11*exp( 20./t) (123) + O1D_O3 ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 (124) + O1D_CFC11 ( 21) O1D + CFC11 -> 2*CL + COFCL rate = 2.02E-10 (125) + O1D_CFC12 ( 22) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (126) + O1D_CFC113 ( 23) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 1.50E-10 (127) + O1D_CFC114 ( 24) O1D + CFC114 -> 2*CL + 2*COF2 rate = 9.75E-11 (128) + O1D_CFC115 ( 25) O1D + CFC115 -> CL + F + 2*COF2 rate = 1.50E-11 (129) + O1D_HCFC22 ( 26) O1D + HCFC22 -> CL + COF2 rate = 7.20E-11 (130) + O1D_HCFC141B ( 27) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (131) + O1D_HCFC142B ( 28) O1D + HCFC142B -> CL + COF2 rate = 1.63E-10 (132) + O1D_CCL4 ( 29) O1D + CCL4 -> 4*CL rate = 2.84E-10 (133) + O1D_CH3BR ( 30) O1D + CH3BR -> BR rate = 1.67E-10 (134) + O1D_CF2CLBR ( 31) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.60E-11 (135) + O1D_CF3BR ( 32) O1D + CF3BR -> BR + F + COF2 rate = 4.10E-11 (136) + O1D_H1202 ( 33) O1D + H1202 -> 2*BR + COF2 rate = 1.01E-10 (137) + O1D_H2402 ( 34) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (138) + O1D_CHBR3 ( 35) O1D + CHBR3 -> 3*BR rate = 4.49E-10 (139) + O1D_CH2BR2 ( 36) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (140) + O1D_COF2 ( 37) O1D + COF2 -> 2*F rate = 2.14E-11 (141) + O1D_COFCL ( 38) O1D + COFCL -> F + CL rate = 1.90E-10 (142) + O1D_CH4a ( 39) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (143) + O1D_CH4b ( 40) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (144) + O1D_CH4c ( 41) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (145) + O1D_H2 ( 42) O1D + H2 -> H + OH rate = 1.20E-10 (146) + O1D_HCL ( 43) O1D + HCL -> CL + OH rate = 1.50E-10 (147) + O1D_HBR ( 44) O1D + HBR -> BR + OH rate = 1.20E-10 (148) + H_O2 ( 45) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (149) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + H_O3 ( 46) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (150) + H_HO2a ( 47) H + HO2 -> 2*OH rate = 7.20E-11 (151) + H_HO2 ( 48) H + HO2 -> H2 + O2 rate = 6.90E-12 (152) + H_HO2b ( 49) H + HO2 -> H2O + O rate = 1.60E-12 (153) + OH_O ( 50) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (154) + OH_O3 ( 51) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (155) + OH_HO2 ( 52) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (156) + OH_OH ( 53) OH + OH -> H2O + O rate = 1.80E-12 (157) + OH_OH_M ( 54) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (158) + ki=2.60E-11 + f=0.60 + OH_H2 ( 55) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (159) + OH_H2O2 ( 56) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (160) + H2_O ( 57) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (161) + HO2_O ( 58) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (162) + HO2_O3 ( 59) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (163) + usr_HO2_HO2 ( 60) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (164) + H2O2_O ( 61) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (165) + HONO1 ( 62) H + NO + M -> HONO + M troe : ko=7.00E-31*(300/t)**2.60 (166) + ki=3.60E-11*(300/t)**0.10 + f=0.60 + HONO2 ( 63) OH + HONO -> H2O + NO2 rate = 1.80E-11*exp( 390./t) (167) + N2D_O2 ( 64) N2D + O2 -> NO + O1D rate = 5.00E-12 (168) + N2D_O ( 65) N2D + O -> N + O rate = 7.00E-13 (169) + N_OH ( 66) N + OH -> NO + H rate = 5.00E-11 (170) + N_O2 ( 67) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (171) + N_NO ( 68) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (172) + N_NO2a ( 69) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (173) + N_NO2b ( 70) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (174) + N_NO2c ( 71) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (175) + NO_O ( 72) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (176) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 73) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (177) + NO_O3 ( 74) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (178) + NO2_O ( 75) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (179) + NO2_O_M ( 76) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (180) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO2_O3 ( 77) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (181) + tag_NO2_NO3 ( 78) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (182) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 79) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (183) + tag_NO2_OH ( 80) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (184) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 81) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (185) + NO3_NO ( 82) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (186) + NO3_O ( 83) NO3 + O -> NO2 + O2 rate = 1.00E-11 (187) + NO3_OH ( 84) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (188) + NO3_HO2 ( 85) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (189) + tag_NO2_HO2 ( 86) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (190) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + HO2NO2_OH ( 87) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (191) + usr_HO2NO2_M ( 88) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (192) + CL_O3 ( 89) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (193) + CL_H2 ( 90) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (194) + CL_H2O2 ( 91) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (195) + CL_HO2a ( 92) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (196) + CL_HO2b ( 93) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (197) + CL_CH2O ( 94) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (198) + CL_CH4 ( 95) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (199) + CLO_O ( 96) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (200) + CLO_OHa ( 97) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (201) + CLO_OHb ( 98) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (202) + CLO_HO2 ( 99) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (203) + CLO_CH3O2 (100) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (204) + CLO_NO (101) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (205) + CLO_NO2_M (102) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (206) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLO_CLOa (103) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (207) + CLO_CLOb (104) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (208) + CLO_CLOc (105) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (209) + tag_CLO_CLO_M (106) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (210) + ki=3.00E-12*(300/t)**2.00 + f=0.60 + usr_CL2O2_M (107) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (211) + HCL_OH (108) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (212) + HCL_O (109) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (213) + HOCL_O (110) HOCL + O -> CLO + OH rate = 1.70E-13 (214) + HOCL_CL (111) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (215) + HOCL_OH (112) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (216) + CLONO2_O (113) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (217) + CLONO2_OH (114) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (218) + CLONO2_CL (115) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (219) + BR_O3 (116) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (220) + BR_HO2 (117) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (221) + BR_CH2O (118) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (222) + BRO_O (119) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (223) + BRO_OH (120) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (224) + BRO_HO2 (121) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (225) + BRO_NO (122) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (226) + BRO_NO2_M (123) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (227) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRO_CLOa (124) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (228) + BRO_CLOb (125) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (229) + BRO_CLOc (126) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (230) + BRO_BRO (127) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (231) + HBR_OH (128) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (232) + HBR_O (129) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (233) + HOBR_O (130) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (234) + BRONO2_O (131) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (235) + F_H2O (132) F + H2O -> HF + OH rate = 1.40E-11 (236) + F_H2 (133) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (237) + F_CH4 (134) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (238) + F_HNO3 (135) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (239) + CH3CL_CL (136) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (240) + CH3CL_OH (137) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (241) + CH3CCL3_OH (138) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (242) + HCFC22_OH (139) HCFC22 + OH -> H2O + CL + COF2 rate = 1.05E-12*exp( -1600./t) (243) + CH3BR_OH (140) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (244) + CH3BR_CL (141) CH3BR + CL -> HCL + HO2 + BR rate = 1.40E-11*exp( -1030./t) (245) + HCFC141B_OH (142) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (246) + HCFC142B_OH (143) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (247) + CH2BR2_OH (144) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (248) + CHBR3_OH (145) CHBR3 + OH -> 3*BR rate = 1.35E-12*exp( -600./t) (249) + CH2BR2_CL (146) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (250) + CHBR3_CL (147) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (251) + CH4_OH (148) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (252) + usr_CO_OH_b (149) CO + OH -> CO2 + H rate = ** User defined ** (253) + CO_OH_M (150) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (254) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + CH2O_NO3 (151) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (255) + CH2O_OH (152) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (256) + CH2O_O (153) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (257) + CH3O2_NO (154) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (258) + CH3O2_HO2 (155) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (259) + CH3OOH_OH (156) CH3OOH + OH -> CH3O2 + H2O rate = 3.80E-12*exp( 200./t) (260) + usr_N2O5_aer (157) N2O5 -> 2*HNO3 rate = ** User defined ** (261) + usr_NO3_aer (158) NO3 -> HNO3 rate = ** User defined ** (262) + usr_NO2_aer (159) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (263) + usr_HO2_aer (160) HO2 -> 0.5*H2O2 rate = ** User defined ** (264) + OCS_O (161) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (265) + OCS_OH (162) OCS + OH -> SO2 + CO + H rate = 1.10E-13*exp( -1200./t) (266) + S_OH (163) S + OH -> SO + H rate = 6.60E-11 (267) + S_O2 (164) S + O2 -> SO + O rate = 2.30E-12 (268) + S_O3 (165) S + O3 -> SO + O2 rate = 1.20E-11 (269) + SO_OH (166) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (270) + SO_O2 (167) SO + O2 -> SO2 + O rate = 1.25E-13*exp( -2190./t) (271) + SO_O3 (168) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (272) + SO_NO2 (169) SO + NO2 -> SO2 + NO rate = 1.40E-11 (273) + SO_CLO (170) SO + CLO -> SO2 + CL rate = 2.80E-11 (274) + SO_BRO (171) SO + BRO -> SO2 + BR rate = 5.70E-11 (275) + SO_OCLO (172) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (276) + usr_SO2_OH (173) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (277) + usr_SO3_H2O (174) SO3 + H2O -> H2SO4 rate = ** User defined ** (278) + usr_DMS_OH (175) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** (279) + DMS_OHb (176) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (280) + DMS_NO3 (177) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (281) + het1 (178) N2O5 -> 2*HNO3 rate = ** User defined ** (282) + het2 (179) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (283) + het3 (180) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (284) + het4 (181) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (285) + het5 (182) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (286) + het6 (183) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (287) + het7 (184) N2O5 -> 2*HNO3 rate = ** User defined ** (288) + het8 (185) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (289) + het9 (186) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (290) + het10 (187) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (291) + het11 (188) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (292) + het12 (189) N2O5 -> 2*HNO3 rate = ** User defined ** (293) + het13 (190) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (294) + het14 (191) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (295) + het15 (192) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (296) + het16 (193) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (297) + het17 (194) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (298) + ion_Op_O2 (195) Op + O2 -> O2p + O rate = ** User defined ** (299) + ion_Op_N2 (196) Op + N2 -> NOp + N rate = ** User defined ** (300) + ion_N2p_Oa (197) N2p + O -> NOp + N2D rate = ** User defined ** (301) + ion_N2p_Ob (198) N2p + O -> Op + N2 rate = ** User defined ** (302) + ion_Op_CO2 (199) Op + CO2 -> O2p + CO rate = 9.00E-10 (303) + ion_O2p_N (200) O2p + N -> NOp + O rate = 1.00E-10 (304) + ion_O2p_NO (201) O2p + NO -> NOp + O2 rate = 4.40E-10 (305) + ion_Np_O2a (202) Np + O2 -> O2p + N rate = 4.00E-10 (306) + ion_Np_O2b (203) Np + O2 -> NOp + O rate = 2.00E-10 (307) + ion_Np_O (204) Np + O -> Op + N rate = 1.00E-12 (308) + ion_N2p_O2 (205) N2p + O2 -> O2p + N2 rate = 6.00E-11 (309) + ion_O2p_N2 (206) O2p + N2 -> NOp + NO rate = 5.00E-16 (310) + elec1 (207) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (311) + elec2 (208) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (312) + elec3 (209) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (313) + ean1 (210) O2 + N2 + e -> O2m + N2 rate = ** User defined ** (314) + ean2 (211) O3 + e -> Om + O2 rate = ** User defined ** (315) + ean3 (212) O2 + e + M -> O2m + M rate = ** User defined ** (316) + rpe1 (213) O4p + e -> 2*O2 rate = ** User defined ** (317) + (214) NOp_CO2 + e -> NO + CO2 rate = 1.50E-06 (318) + (215) NOp_H2O + e -> NO + H2O rate = 1.50E-06 (319) + (216) NOp_2H2O + e -> NO + 2*H2O rate = 2.00E-06 (320) + (217) NOp_3H2O + e -> NO + 3*H2O rate = 2.00E-06 (321) + (218) O2p_H2O + e -> O2 + H2O rate = 2.00E-06 (322) + (219) H3Op_OH + e -> OH + H + H2O rate = 1.50E-06 (323) + rpe2 (220) Hp_H2O + e -> H + H2O rate = ** User defined ** (324) + rpe3 (221) Hp_2H2O + e -> H + 2*H2O rate = ** User defined ** (325) + rpe4 (222) Hp_3H2O + e -> H + 3*H2O rate = ** User defined ** (326) + (223) Hp_4H2O + e -> H + 4*H2O rate = 3.60E-06 (327) + (224) Hp_5H2O + e -> H + 5*H2O rate = 5.00E-06 (328) + rpe5 (225) NOp_N2 + e -> NO + N2 rate = ** User defined ** (329) + (226) NOp_N2 + CO2 -> NOp_CO2 + N2 rate = 1.00E-09 (330) + (227) NOp_N2 + H2O -> NOp_H2O + N2 rate = 1.00E-09 (331) + pir1 (228) O2p + O2 + M -> O4p + M rate = ** User defined ** (332) + (229) O2p + H2O + M -> O2p_H2O + M rate = 2.80E-28 (333) + (230) O4p + H2O -> O2p_H2O + O2 rate = 1.70E-09 (334) + (231) O4p + O2_1D -> O2p + 2*O2 rate = 1.50E-10 (335) + (232) O4p + O -> O2p + O3 rate = 3.00E-10 (336) + (233) O2p_H2O + H2O -> H3Op_OH + O2 rate = 9.00E-10 (337) + (234) O2p_H2O + H2O -> Hp_H2O + OH + O2 rate = 2.40E-10 (338) + (235) H3Op_OH + H2O -> Hp_2H2O + OH rate = 2.00E-09 (339) + pir2 (236) Hp_H2O + H2O + M -> Hp_2H2O + M rate = ** User defined ** (340) + pir3 (237) Hp_2H2O + M -> Hp_H2O + H2O + M rate = ** User defined ** (341) + pir4 (238) Hp_2H2O + H2O + M -> Hp_3H2O + M rate = ** User defined ** (342) + pir5 (239) Hp_3H2O + M -> Hp_2H2O + H2O + M rate = ** User defined ** (343) + pir6 (240) Hp_3H2O + H2O + M -> Hp_4H2O + M rate = ** User defined ** (344) + pir7 (241) Hp_4H2O + M -> Hp_3H2O + H2O + M rate = ** User defined ** (345) + pir8 (242) Hp_4H2O + H2O + M -> Hp_5H2O + M rate = ** User defined ** (346) + pir9 (243) Hp_5H2O + M -> Hp_4H2O + H2O + M rate = ** User defined ** (347) + (244) Hp_4H2O + N2O5 -> Hp_3N1 + HNO3 rate = 4.00E-12 (348) + (245) Hp_5H2O + N2O5 -> Hp_4N1 + HNO3 rate = 7.00E-12 (349) + (246) Hp_3N1 + H2O -> Hp_4H2O + HNO3 rate = 1.00E-09 (350) + (247) Hp_4N1 + H2O -> Hp_5H2O + HNO3 rate = 1.00E-09 (351) + pir10 (248) NOp + H2O + M -> NOp_H2O + M rate = ** User defined ** (352) + pir11 (249) NOp_H2O + H2O + M -> NOp_2H2O + M rate = ** User defined ** (353) + (250) NOp_H2O + HO2 -> Hp_H2O + NO3 rate = 5.00E-10 (354) + (251) NOp_H2O + OH -> Hp_H2O + NO2 rate = 1.00E-10 (355) + (252) NOp_H2O + H -> Hp_H2O + NO rate = 7.00E-12 (356) + pir12 (253) NOp_2H2O + H2O + M -> NOp_3H2O + M rate = ** User defined ** (357) + (254) NOp_3H2O + H2O -> Hp_3H2O + HONO rate = 7.00E-11 (358) + (255) NOp_CO2 + H2O -> NOp_H2O + CO2 rate = 1.00E-09 (359) + pir13 (256) NOp + CO2 + M -> NOp_CO2 + M rate = ** User defined ** (360) + pir14 (257) NOp_CO2 + M -> NOp + CO2 + M rate = ** User defined ** (361) + pir15 (258) NOp + N2 + M -> NOp_N2 + M rate = ** User defined ** (362) + pir16 (259) NOp_N2 + M -> NOp + N2 + M rate = ** User defined ** (363) + (260) Om + O -> O2 + e rate = 1.90E-10 (364) + edn1 (261) Om + NO -> NO2 + e rate = ** User defined ** (365) + (262) Om + O2_1D -> O3 + e rate = 3.00E-10 (366) + (263) Om + M -> O + M + e rate = 5.00E-13 (367) + (264) Om + H2 -> H2O + e rate = 5.80E-10 (368) + (265) O2m + O -> O3 + e rate = 1.50E-10 (369) + (266) O2m + O2_1D -> 2*O2 + e rate = 2.00E-10 (370) + edn2 (267) O2m + N2 -> N2 + O2 + e rate = ** User defined ** (371) + (268) O2m + H -> HO2 + e rate = 1.40E-09 (372) + (269) O3m + O -> 2*O2 + e rate = 1.00E-10 (373) + (270) O3m + O3 -> 3*O2 + e rate = 1.00E-10 (374) + (271) OHm + O -> HO2 + e rate = 2.00E-10 (375) + (272) OHm + H -> H2O + e rate = 1.40E-09 (376) + (273) Om + O3 -> O3m + O rate = 8.00E-10 (377) + (274) Om + O2 + M -> O3m + M rate = 2.90E-31 (378) + (275) Om + H2O -> OHm + OH rate = 6.00E-13 (379) + (276) Om + NO2 -> NO2m + O rate = 1.00E-09 (380) + (277) Om + CO2 + M -> CO3m + M rate = 2.00E-28 (381) + (278) Om + H2 -> OHm + H rate = 3.20E-11 (382) + (279) Om + HNO3 -> NO3m + OH rate = 3.60E-09 (383) + (280) Om + HCL -> CLm + OH rate = 2.00E-09 (384) + (281) Om + CL -> CLm + O rate = 1.00E-10 (385) + (282) Om + CLO -> CLm + O2 rate = 1.00E-10 (386) + (283) O2m + O -> Om + O2 rate = 1.50E-10 (387) + (284) O2m + O3 -> O3m + O2 rate = 7.80E-10 (388) + (285) O2m + CO2 + M -> CO4m + M rate = 9.90E-30 (389) + (286) O2m + NO2 -> NO2m + O2 rate = 7.00E-10 (390) + (287) O2m + O2 + M -> O4m + M rate = 3.40E-31 (391) + (288) O2m + HNO3 -> NO3m + HO2 rate = 2.90E-09 (392) + (289) O2m + HCL -> CLm + HO2 rate = 1.60E-09 (393) + (290) O2m + CLO -> CLOm + O2 rate = 1.00E-10 (394) + (291) O2m + CL -> CLm + O2 rate = 1.00E-10 (395) + (292) O3m + O -> O2m + O2 rate = 2.50E-10 (396) + (293) O3m + H -> OHm + O2 rate = 8.40E-10 (397) + (294) O3m + CO2 -> CO3m + O2 rate = 5.50E-10 (398) + nir1 (295) O3m + NO -> NO3m + O rate = ** User defined ** (399) + nir2 (296) O3m + NO2 -> NO3m + O2 rate = ** User defined ** (400) + nir3 (297) O3m + NO2 -> NO2m + O rate = ** User defined ** (401) + nir4 (298) O3m + NO -> NO2m + O2 rate = ** User defined ** (402) + (299) O4m + O -> O3m + O2 rate = 4.00E-10 (403) + (300) O4m + CO2 -> CO4m + O2 rate = 4.30E-10 (404) + (301) OHm + O3 -> O3m + OH rate = 9.00E-10 (405) + (302) OHm + NO2 -> NO2m + OH rate = 1.10E-09 (406) + (303) OHm + CO2 + M -> HCO3m + M rate = 7.60E-28 (407) + (304) OHm + HCL -> CLm + H2O rate = 1.00E-09 (408) + (305) OHm + CL -> CLm + OH rate = 1.00E-10 (409) + (306) OHm + CLO -> CLOm + OH rate = 1.00E-10 (410) + (307) CO3m + O -> O2m + CO2 rate = 1.10E-10 (411) + (308) CO3m + O2 -> O3m + CO2 rate = 6.00E-15 (412) + (309) CO3m + H -> OHm + CO2 rate = 1.70E-10 (413) + nir5 (310) CO3m + NO -> NO2m + CO2 rate = ** User defined ** (414) + nir6 (311) CO3m + NO2 -> NO3m + CO2 rate = ** User defined ** (415) + (312) CO3m + HNO3 -> NO3m + CO2 + OH rate = 3.51E-10 (416) + (313) CO3m + CL -> CLm + CO2 + O rate = 1.00E-10 (417) + (314) CO3m + CL -> CLOm + CO2 rate = 1.00E-10 (418) + (315) CO3m + CLO -> CLm + CO2 + O2 rate = 1.00E-11 (419) + (316) CO4m + O3 -> O3m + O2 + CO2 rate = 1.30E-10 (420) + (317) CO4m + H -> CO3m + OH rate = 2.20E-10 (421) + (318) CO4m + O -> CO3m + O2 rate = 1.40E-10 (422) + (319) CO4m + HCL -> CLm + HO2 + CO2 rate = 1.20E-09 (423) + (320) CO4m + CL -> CLm + O2 + CO2 rate = 1.00E-10 (424) + (321) CO4m + CLO -> CLOm + O2 + CO2 rate = 1.00E-10 (425) + (322) NO2m + H -> OHm + NO rate = 3.00E-10 (426) + (323) NO2m + NO2 -> NO3m + NO rate = 2.00E-13 (427) + (324) NO2m + O3 -> NO3m + O2 rate = 1.20E-10 (428) + (325) NO2m + HNO3 -> NO3m + {HNO2} rate = 1.60E-09 (429) + (326) NO2m + HCL -> CLm + HONO rate = 1.40E-09 (430) + (327) NO2m + CL -> CLm + NO2 rate = 1.00E-10 (431) + (328) NO2m + CLO -> CLm + NO3 rate = 1.00E-10 (432) + (329) NO3m + O -> NO2m + O2 rate = 5.00E-12 (433) + (330) NO3m + O3 -> NO2m + 2*O2 rate = 1.00E-13 (434) + (331) NO3m + HCL -> CLm + HNO3 rate = 1.00E-12 (435) + (332) CLm + H -> HCL + e rate = 9.60E-10 (436) + (333) CLm + NO2 -> NO2m + CL rate = 6.00E-12 (437) + (334) CLm + HNO3 -> NO3m + HCL rate = 1.60E-09 (438) + (335) CLm + H2O + M -> CLm_H2O + M rate = 2.00E-29 (439) + (336) CLm + HCL + M -> CLm_HCL + M rate = 1.00E-27 (440) + (337) CLOm + NO -> CL + NO2m rate = 2.90E-12 (441) + (338) CLOm + NO -> CLm + NO2 rate = 2.90E-11 (442) + (339) CLOm + O -> CLm + O2 rate = 2.00E-10 (443) + (340) CLm_H2O + HCL -> CLm_HCL + H2O rate = 1.30E-09 (444) + usr_CLm_H2O_M (341) CLm_H2O + M -> CLm + H2O + M rate = ** User defined ** (445) + usr_CLm_HCL_M (342) CLm_HCL + M -> CLm + HCL + M rate = ** User defined ** (446) + (343) CO3m + H2O + M -> CO3m_H2O + M rate = 1.00E-28 (447) + (344) NO3m + H2O + M -> NO3m_H2O + M rate = 1.60E-28 (448) + nir7 (345) NO3m_H2O + M -> NO3m + H2O + M rate = ** User defined ** (449) + (346) CO3m_H2O + NO -> NO2m + H2O + CO2 rate = 3.50E-12 (450) + (347) CO3m_H2O + NO2 -> NO3m + H2O + CO2 rate = 4.00E-11 (451) + nir8 (348) CO3m_H2O + M -> CO3m + H2O + M rate = ** User defined ** (452) + (349) CO3m_H2O + NO2 -> NO3m_H2O + CO2 rate = 4.00E-11 (453) + (350) CO3m_H2O + H2O + M -> CO3m2H2O + M rate = 1.00E-28 (454) + nir9 (351) CO3m2H2O + M -> CO3m_H2O + H2O + M rate = ** User defined ** (455) + (352) CO3m_H2O + NO -> NO2m_H2O + CO2 rate = 3.50E-12 (456) + nir10 (353) NO2m_H2O + M -> NO2m + H2O + M rate = ** User defined ** (457) + (354) NO2m + H2O + M -> NO2m_H2O + M rate = 1.60E-28 (458) + (355) NO3m_H2O + H2O + M -> NO3m2H2O + M rate = 1.60E-28 (459) + nir11 (356) NO3m2H2O + M -> NO3m_H2O + H2O + M rate = ** User defined ** (460) + (357) NO3m2H2O + N2O5 -> NO3mHNO3 + HNO3 + H2O rate = 7.00E-10 (461) + nir12 (358) NO3mHNO3 + M -> NO3m + HNO3 + M rate = ** User defined ** (462) + (359) NO3m + HNO3 + M -> NO3mHNO3 + M rate = 1.45E-26 (463) + (360) NO3m_HCL + HNO3 -> NO3mHNO3 + HCL rate = 7.60E-10 (464) + nir13 (361) NO3m + HCL + M -> NO3m_HCL + M rate = ** User defined ** (465) + (362) NO3m_H2O + N2O5 -> NO3mHNO3 + HNO3 rate = 7.00E-10 (466) + (363) NO3m_H2O + HNO3 -> NO3mHNO3 + H2O rate = 1.60E-09 (467) + iira1 (364) Hp_4H2O + NO3mHNO3 -> 2*HNO3 + 4*H2O rate = ** User defined ** (468) + iira2 (365) Hp_4H2O + CO3m -> H + 4*H2O + O + CO2 rate = ** User defined ** (469) + iira3 (366) Hp_4H2O + CLm_HCL -> H + 4*H2O + CL + HCL rate = ** User defined ** (470) + iira4 (367) Hp_4H2O + NO3m -> HNO3 + 4*H2O rate = ** User defined ** (471) + iira5 (368) Hp_4H2O + HCO3m -> H + 4*H2O + OH + CO2 rate = ** User defined ** (472) + iira6 (369) Hp_4H2O + O2m -> H + 4*H2O + O2 rate = ** User defined ** (473) + iira7 (370) Hp_4H2O + CO4m -> H + 4*H2O + O2 + CO2 rate = ** User defined ** (474) + iira8 (371) Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 rate = ** User defined ** (475) + iira9 (372) Hp_4H2O + CO3m2H2O -> H + 6*H2O + O + CO2 rate = ** User defined ** (476) + iira10 (373) Hp_4H2O + CLm -> H + 4*H2O + CL rate = ** User defined ** (477) + iira11 (374) Hp_4H2O + CO3m_H2O -> H + 5*H2O + O + CO2 rate = ** User defined ** (478) + iira12 (375) Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 rate = ** User defined ** (479) + iira13 (376) Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL rate = ** User defined ** (480) + iira14 (377) Hp_4H2O + CLm_H2O -> H + 5*H2O + CL rate = ** User defined ** (481) + iira15 (378) Hp_4H2O + NO3m2H2O -> H + 6*H2O + NO3 rate = ** User defined ** (482) + iira16 (379) Hp_4H2O + NO2m -> H + 4*H2O + NO2 rate = ** User defined ** (483) + iira17 (380) Hp_5H2O + NO3mHNO3 -> 2*HNO3 + 5*H2O rate = ** User defined ** (484) + iira18 (381) Hp_5H2O + CO3m -> H + 5*H2O + O + CO2 rate = ** User defined ** (485) + iira19 (382) Hp_5H2O + CLm_HCL -> H + 5*H2O + CL + HCL rate = ** User defined ** (486) + iira20 (383) Hp_5H2O + NO3m -> HNO3 + 5*H2O rate = ** User defined ** (487) + iira21 (384) Hp_5H2O + HCO3m -> H + 5*H2O + OH + CO2 rate = ** User defined ** (488) + iira22 (385) Hp_5H2O + O2m -> H + 5*H2O + O2 rate = ** User defined ** (489) + iira23 (386) Hp_5H2O + CO4m -> H + 5*H2O + O2 + CO2 rate = ** User defined ** (490) + iira24 (387) Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 rate = ** User defined ** (491) + iira25 (388) Hp_5H2O + CO3m2H2O -> H + 7*H2O + O + CO2 rate = ** User defined ** (492) + iira26 (389) Hp_5H2O + CLm -> H + 5*H2O + CL rate = ** User defined ** (493) + iira27 (390) Hp_5H2O + CO3m_H2O -> H + 6*H2O + O + CO2 rate = ** User defined ** (494) + iira28 (391) Hp_5H2O + NO2m_H2O -> H + 6*H2O + NO2 rate = ** User defined ** (495) + iira29 (392) Hp_5H2O + NO3m_HCL -> H + 5*H2O + NO3 + HCL rate = ** User defined ** (496) + iira30 (393) Hp_5H2O + CLm_H2O -> H + 6*H2O + CL rate = ** User defined ** (497) + iira31 (394) Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 rate = ** User defined ** (498) + iira32 (395) Hp_5H2O + NO2m -> H + 5*H2O + NO2 rate = ** User defined ** (499) + iira33 (396) Hp_3H2O + NO3mHNO3 -> 2*HNO3 + 3*H2O rate = ** User defined ** (500) + iira34 (397) Hp_3H2O + CO3m -> H + 3*H2O + O + CO2 rate = ** User defined ** (501) + iira35 (398) Hp_3H2O + CLm_HCL -> H + 3*H2O + CL + HCL rate = ** User defined ** (502) + iira36 (399) Hp_3H2O + NO3m -> HNO3 + 3*H2O rate = ** User defined ** (503) + iira37 (400) Hp_3H2O + HCO3m -> H + 3*H2O + OH + CO2 rate = ** User defined ** (504) + iira38 (401) Hp_3H2O + O2m -> H + 3*H2O + O2 rate = ** User defined ** (505) + iira39 (402) Hp_3H2O + CO4m -> H + 3*H2O + O2 + CO2 rate = ** User defined ** (506) + iira40 (403) Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 rate = ** User defined ** (507) + iira41 (404) Hp_3H2O + CO3m2H2O -> H + 5*H2O + O + CO2 rate = ** User defined ** (508) + iira42 (405) Hp_3H2O + CLm -> H + 3*H2O + CL rate = ** User defined ** (509) + iira43 (406) Hp_3H2O + CO3m_H2O -> H + 4*H2O + O + CO2 rate = ** User defined ** (510) + iira44 (407) Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 rate = ** User defined ** (511) + iira45 (408) Hp_3H2O + NO3m_HCL -> H + 3*H2O + NO3 + HCL rate = ** User defined ** (512) + iira46 (409) Hp_3H2O + CLm_H2O -> H + 4*H2O + CL rate = ** User defined ** (513) + iira47 (410) Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 rate = ** User defined ** (514) + iira48 (411) Hp_3H2O + NO2m -> H + 3*H2O + NO2 rate = ** User defined ** (515) + iira49 (412) NOp_H2O + NO3mHNO3 -> NO + H2O + NO3 + HNO3 rate = ** User defined ** (516) + iira50 (413) NOp_H2O + CO3m -> NO + H2O + O + CO2 rate = ** User defined ** (517) + iira51 (414) NOp_H2O + CLm_HCL -> NO + H2O + CL + HCL rate = ** User defined ** (518) + iira52 (415) NOp_H2O + NO3m -> NO + H2O + NO3 rate = ** User defined ** (519) + iira53 (416) NOp_H2O + HCO3m -> NO + H2O + OH + CO2 rate = ** User defined ** (520) + iira54 (417) NOp_H2O + O2m -> NO + H2O + O2 rate = ** User defined ** (521) + iira55 (418) NOp_H2O + CO4m -> NO + H2O + O2 + CO2 rate = ** User defined ** (522) + iira56 (419) NOp_H2O + NO3m_H2O -> NO + 2*H2O + NO3 rate = ** User defined ** (523) + iira57 (420) NOp_H2O + CO3m2H2O -> NO + 3*H2O + O + CO2 rate = ** User defined ** (524) + iira58 (421) NOp_H2O + CLm -> NO + H2O + CL rate = ** User defined ** (525) + iira59 (422) NOp_H2O + CO3m_H2O -> NO + 2*H2O + O + CO2 rate = ** User defined ** (526) + iira60 (423) NOp_H2O + NO2m_H2O -> NO + 2*H2O + NO2 rate = ** User defined ** (527) + iira61 (424) NOp_H2O + NO3m_HCL -> NO + H2O + NO3 + HCL rate = ** User defined ** (528) + iira62 (425) NOp_H2O + CLm_H2O -> NO + 2*H2O + CL rate = ** User defined ** (529) + iira63 (426) NOp_H2O + NO3m2H2O -> NO + 3*H2O + NO3 rate = ** User defined ** (530) + iira64 (427) NOp_H2O + NO2m -> NO + H2O + NO2 rate = ** User defined ** (531) + iira65 (428) NOp_2H2O + NO3mHNO3 -> NO + 2*H2O + NO3 + HNO3 rate = ** User defined ** (532) + iira66 (429) NOp_2H2O + CO3m -> NO + 2*H2O + O + CO2 rate = ** User defined ** (533) + iira67 (430) NOp_2H2O + CLm_HCL -> NO + 2*H2O + CL + HCL rate = ** User defined ** (534) + iira68 (431) NOp_2H2O + NO3m -> NO + 2*H2O + NO3 rate = ** User defined ** (535) + iira69 (432) NOp_2H2O + HCO3m -> NO + 2*H2O + OH + CO2 rate = ** User defined ** (536) + iira70 (433) NOp_2H2O + O2m -> NO + 2*H2O + O2 rate = ** User defined ** (537) + iira71 (434) NOp_2H2O + CO4m -> NO + 2*H2O + O2 + CO2 rate = ** User defined ** (538) + iira72 (435) NOp_2H2O + NO3m_H2O -> NO + 3*H2O + NO3 rate = ** User defined ** (539) + iira73 (436) NOp_2H2O + CO3m2H2O -> NO + 4*H2O + O + CO2 rate = ** User defined ** (540) + iira74 (437) NOp_2H2O + CLm -> NO + 2*H2O + CL rate = ** User defined ** (541) + iira75 (438) NOp_2H2O + CO3m_H2O -> NO + 3*H2O + O + CO2 rate = ** User defined ** (542) + iira76 (439) NOp_2H2O + NO2m_H2O -> NO + 3*H2O + NO2 rate = ** User defined ** (543) + iira77 (440) NOp_2H2O + NO3m_HCL -> NO + 2*H2O + NO3 + HCL rate = ** User defined ** (544) + iira78 (441) NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL rate = ** User defined ** (545) + iira79 (442) NOp_2H2O + NO3m2H2O -> NO + 4*H2O + NO3 rate = ** User defined ** (546) + iira80 (443) NOp_2H2O + NO2m -> NO + 2*H2O + NO2 rate = ** User defined ** (547) + iira81 (444) NOp + NO3mHNO3 -> NO + NO3 + HNO3 rate = ** User defined ** (548) + iira82 (445) NOp + CO3m -> NO + O + CO2 rate = ** User defined ** (549) + iira83 (446) NOp + CLm_HCL -> NO + CL + HCL rate = ** User defined ** (550) + iira84 (447) NOp + NO3m -> NO + NO3 rate = ** User defined ** (551) + iira85 (448) NOp + HCO3m -> NO + OH + CO2 rate = ** User defined ** (552) + iira86 (449) NOp + O2m -> NO + O2 rate = ** User defined ** (553) + iira87 (450) NOp + CO4m -> NO + O2 + CO2 rate = ** User defined ** (554) + iira88 (451) NOp + NO3m_H2O -> NO + NO3 + H2O rate = ** User defined ** (555) + iira89 (452) NOp + CO3m2H2O -> NO + O + 2*H2O + CO2 rate = ** User defined ** (556) + iira90 (453) NOp + CLm -> NO + CL rate = ** User defined ** (557) + iira91 (454) NOp + CO3m_H2O -> NO + O + H2O + CO2 rate = ** User defined ** (558) + iira92 (455) NOp + NO2m_H2O -> NO + NO2 + H2O rate = ** User defined ** (559) + iira93 (456) NOp + NO3m_HCL -> NO + NO3 + HCL rate = ** User defined ** (560) + iira94 (457) NOp + CLm_H2O -> NO + CL + H2O rate = ** User defined ** (561) + iira95 (458) NOp + NO3m2H2O -> NO + NO3 + 2*H2O rate = ** User defined ** (562) + iira96 (459) NOp + NO2m -> NO + NO2 rate = ** User defined ** (563) + iira97 (460) O2p + NO3mHNO3 -> O2 + NO3 + HNO3 rate = ** User defined ** (564) + iira98 (461) O2p + CO3m -> O2 + O + CO2 rate = ** User defined ** (565) + iira99 (462) O2p + CLm_HCL -> O2 + CL + HCL rate = ** User defined ** (566) + iira100 (463) O2p + NO3m -> O2 + NO3 rate = ** User defined ** (567) + iira101 (464) O2p + HCO3m -> O2 + OH + CO2 rate = ** User defined ** (568) + iira102 (465) O2p + O2m -> 2*O2p rate = ** User defined ** (569) + iira103 (466) O2p + CO4m -> O2 + O2 + CO2 rate = ** User defined ** (570) + iira104 (467) O2p + NO3m_H2O -> O2 + NO3 + H2O rate = ** User defined ** (571) + iira105 (468) O2p + CO3m2H2O -> O2 + O + 2*H2O + CO2 rate = ** User defined ** (572) + iira106 (469) O2p + CLm -> O2 + CL rate = ** User defined ** (573) + iira107 (470) O2p + CO3m_H2O -> O2 + O + H2O + CO2 rate = ** User defined ** (574) + iira108 (471) O2p + NO2m_H2O -> O2 + NO2 + H2O rate = ** User defined ** (575) + iira109 (472) O2p + NO3m_HCL -> O2 + NO3 + HCL rate = ** User defined ** (576) + iira110 (473) O2p + CLm_H2O -> O2 + CL + H2O rate = ** User defined ** (577) + iira111 (474) O2p + NO3m2H2O -> O2 + NO3 + 2*H2O rate = ** User defined ** (578) + iira112 (475) O2p + NO2m -> O2 + NO2 rate = ** User defined ** (579) + iirb1 (476) Hp_4H2O + CO3m + M -> H + 4*H2O + O + CO2 + M rate = ** User defined ** (580) + iirb2 (477) Hp_4H2O + NO3m + M -> HNO3 + 4*H2O + M rate = ** User defined ** (581) + iirb3 (478) Hp_5H2O + CO3m + M -> H + 5*H2O + O + CO2 + M rate = ** User defined ** (582) + iirb4 (479) Hp_5H2O + NO3m + M -> HNO3 + 5*H2O + M rate = ** User defined ** (583) + iirb5 (480) Hp_4H2O + CLm_HCL + M -> 2*HCL + 4*H2O + M rate = ** User defined ** (584) + iirb6 (481) Hp_5H2O + CLm_HCL + M -> 2*HCL + 5*H2O + M rate = ** User defined ** (585) + iirb7 (482) Hp_4H2O + NO3mHNO3 + M -> 2*HNO3 + 4*H2O + M rate = ** User defined ** (586) + iirb8 (483) Hp_5H2O + NO3mHNO3 + M -> 2*HNO3 + 5*H2O + M rate = ** User defined ** (587) + iirb9 (484) Hp_4H2O + CO3m2H2O + M -> H + 6*H2O + O + CO2 + M rate = ** User defined ** (588) + iirb10 (485) Hp_5H2O + CO3m2H2O + M -> H + 7*H2O + O + CO2 + M rate = ** User defined ** (589) + iirb11 (486) Hp_4H2O + CO3m_H2O + M -> H + 5*H2O + O + CO2 + M rate = ** User defined ** (590) + iirb12 (487) Hp_5H2O + CO3m_H2O + M -> H + 6*H2O + O + CO2 + M rate = ** User defined ** (591) + iirb13 (488) Hp_4H2O + NO3m_H2O + M -> H + 5*H2O + NO3 + M rate = ** User defined ** (592) + iirb14 (489) Hp_5H2O + NO3m_H2O + M -> H + 6*H2O + NO3 + M rate = ** User defined ** (593) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) DMS (dataset) + ( 6) so4_a1 (dataset) + ( 7) so4_a2 (dataset) + ( 8) pom_a1 (dataset) + ( 9) pom_a4 (dataset) + (10) bc_a1 (dataset) + (11) bc_a4 (dataset) + (12) num_a1 (dataset) + (13) num_a2 (dataset) + (14) num_a4 (dataset) + (15) Op + (16) O2p + (17) Np + (18) N2p + (19) N2D + (20) O + (21) N + (22) e + (23) OH + + + Equation Report + + d(O3)/dt = j96*O3m + r1*M*O*O2 + r232*O4p*O + r262*Om*O2_1D + r265*O2m*O + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r46*H*O3 - r51*OH*O3 - r59*HO2*O3 - r74*NO*O3 + - r77*NO2*O3 - r89*CL*O3 - r116*BR*O3 - r165*S*O3 - r168*SO*O3 - r211*e*O3 - r270*O3m*O3 + - r273*Om*O3 - r284*O2m*O3 - r301*OHm*O3 - r316*CO4m*O3 - r324*NO2m*O3 - r330*NO3m*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j58*CO2 + .18*j60*CH4 + j62*SO2 + j63*SO3 + j65*SO + j73*O2 + j74*O2 + j75*O2 + + 2*j78*O2 + j85*O2 + j86*O2 + j87*O2 + 2*j90*O2 + j92*CO2 + j94*Om + r14*N2*O1D + r263*M*Om + + r15*O1D*O2 + r16*O1D*O2 + r49*H*HO2 + r53*OH*OH + r67*N*O2 + r68*N*NO + r69*N*NO2 + r164*S*O2 + + r167*SO*O2 + r195*Op*O2 + r200*O2p*N + r203*Np*O2 + r207*NOp*e + 1.15*r208*O2p*e + r273*Om*O3 + + r276*Om*NO2 + r281*Om*CL + r295*O3m*NO + r297*O3m*NO2 + r313*CO3m*CL + r365*Hp_4H2O*CO3m + + r372*Hp_4H2O*CO3m2H2O + r374*Hp_4H2O*CO3m_H2O + r381*Hp_5H2O*CO3m + r388*Hp_5H2O*CO3m2H2O + + r390*Hp_5H2O*CO3m_H2O + r397*Hp_3H2O*CO3m + r404*Hp_3H2O*CO3m2H2O + r406*Hp_3H2O*CO3m_H2O + + r413*NOp_H2O*CO3m + r420*NOp_H2O*CO3m2H2O + r422*NOp_H2O*CO3m_H2O + r429*NOp_2H2O*CO3m + + r436*NOp_2H2O*CO3m2H2O + r438*NOp_2H2O*CO3m_H2O + r445*NOp*CO3m + r452*NOp*CO3m2H2O + + r454*NOp*CO3m_H2O + r461*O2p*CO3m + r468*O2p*CO3m2H2O + r470*O2p*CO3m_H2O + r476*M*Hp_4H2O*CO3m + + r478*M*Hp_5H2O*CO3m + r484*M*Hp_4H2O*CO3m2H2O + r485*M*Hp_5H2O*CO3m2H2O + r486*M*Hp_4H2O*CO3m_H2O + + r487*M*Hp_5H2O*CO3m_H2O + - j67*O - j68*O - j69*O - j80*O - j81*O - j82*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O - r50*OH*O + - r57*H2*O - r58*HO2*O - r61*H2O2*O - r72*M*NO*O - r75*NO2*O - r76*M*NO2*O - r83*NO3*O + - r96*CLO*O - r109*HCL*O - r110*HOCL*O - r113*CLONO2*O - r119*BRO*O - r129*HBR*O - r130*HOBR*O + - r131*BRONO2*O - r153*CH2O*O - r161*OCS*O - r197*N2p*O - r198*N2p*O - r204*Np*O - r232*O4p*O + - r260*Om*O - r265*O2m*O - r269*O3m*O - r271*OHm*O - r283*O2m*O - r292*O3m*O - r299*O4m*O + - r307*CO3m*O - r318*CO4m*O - r329*NO3m*O - r339*CLOm*O + d(O2)/dt = j4*O3 + j13*NO3 + j95*O2m + j100*O3m + j101*O4m + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + + r267*N2*O2m + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + + r20*O1D*O3 + r46*H*O3 + r48*H*HO2 + r50*OH*O + r51*OH*O3 + r52*OH*HO2 + r58*HO2*O + + 2*r59*HO2*O3 + r60*HO2*HO2 + r71*N*NO2 + r74*NO*O3 + r75*NO2*O + r77*NO2*O3 + r83*NO3*O + + r85*NO3*HO2 + r87*HO2NO2*OH + r89*CL*O3 + r92*CL*HO2 + r96*CLO*O + r98*CLO*OH + r99*CLO*HO2 + + r103*CLO*CLO + r104*CLO*CLO + r116*BR*O3 + r117*BR*HO2 + r119*BRO*O + r121*BRO*HO2 + + r125*BRO*CLO + r126*BRO*CLO + r127*BRO*BRO + r155*CH3O2*HO2 + r165*S*O3 + r168*SO*O3 + + r201*O2p*NO + r211*O3*e + 2*r213*O4p*e + r218*O2p_H2O*e + r230*O4p*H2O + 2*r231*O4p*O2_1D + + r233*O2p_H2O*H2O + r234*O2p_H2O*H2O + r260*Om*O + 2*r266*O2m*O2_1D + 2*r269*O3m*O + + 3*r270*O3m*O3 + r282*Om*CLO + r283*O2m*O + r284*O2m*O3 + r286*O2m*NO2 + r290*O2m*CLO + + r291*O2m*CL + r292*O3m*O + r293*O3m*H + r294*O3m*CO2 + r296*O3m*NO2 + r298*O3m*NO + r299*O4m*O + + r300*O4m*CO2 + r315*CO3m*CLO + r316*CO4m*O3 + r318*CO4m*O + r320*CO4m*CL + r321*CO4m*CLO + + r324*NO2m*O3 + r329*NO3m*O + 2*r330*NO3m*O3 + r339*CLOm*O + r369*Hp_4H2O*O2m + + r370*Hp_4H2O*CO4m + r385*Hp_5H2O*O2m + r386*Hp_5H2O*CO4m + r401*Hp_3H2O*O2m + r402*Hp_3H2O*CO4m + + r417*NOp_H2O*O2m + r418*NOp_H2O*CO4m + r433*NOp_2H2O*O2m + r434*NOp_2H2O*CO4m + r449*NOp*O2m + + r450*NOp*CO4m + r460*O2p*NO3mHNO3 + r461*O2p*CO3m + r462*O2p*CLm_HCL + r463*O2p*NO3m + + r464*O2p*HCO3m + r466*O2p*CO4m + r466*O2p*CO4m + r467*O2p*NO3m_H2O + r468*O2p*CO3m2H2O + + r469*O2p*CLm + r470*O2p*CO3m_H2O + r471*O2p*NO2m_H2O + r472*O2p*NO3m_HCL + r473*O2p*CLm_H2O + + r474*O2p*NO3m2H2O + r475*O2p*NO2m + - j1*O2 - j2*O2 - j71*O2 - j73*O2 - j74*O2 - j75*O2 - j78*O2 - j83*O2 - j85*O2 - j86*O2 + - j87*O2 - j90*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r45*M*H*O2 - r64*N2D*O2 - r67*N*O2 + - r164*S*O2 - r167*SO*O2 - r195*Op*O2 - r202*Np*O2 - r203*Np*O2 - r205*N2p*O2 - r210*N2*e*O2 + - r212*M*e*O2 - r228*M*O2p*O2 - r274*M*Om*O2 - r287*M*O2m*O2 - r308*CO3m*O2 + d(N2O)/dt = r69*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j76*N2 + .8*j79*N2 + j88*N2 + .8*j91*N2 + j6*NO + r196*N2*Op + r65*N2D*O + r202*Np*O2 + + r204*Np*O + .2*r207*NOp*e + 1.1*r209*N2p*e + - j70*N - r66*OH*N - r67*O2*N - r68*NO*N - r69*NO2*N - r70*NO2*N - r71*NO2*N - r200*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + j66*HONO + .5*r159*NO2 + r206*N2*O2p + 2*r18*O1D*N2O + r64*N2D*O2 + + r66*N*OH + r67*N*O2 + 2*r70*N*NO2 + r75*NO2*O + r169*SO*NO2 + r214*NOp_CO2*e + r215*NOp_H2O*e + + r216*NOp_2H2O*e + r217*NOp_3H2O*e + r225*NOp_N2*e + r252*NOp_H2O*H + r322*NO2m*H + + r323*NO2m*NO2 + r412*NOp_H2O*NO3mHNO3 + r413*NOp_H2O*CO3m + r414*NOp_H2O*CLm_HCL + + r415*NOp_H2O*NO3m + r416*NOp_H2O*HCO3m + r417*NOp_H2O*O2m + r418*NOp_H2O*CO4m + + r419*NOp_H2O*NO3m_H2O + r420*NOp_H2O*CO3m2H2O + r421*NOp_H2O*CLm + r422*NOp_H2O*CO3m_H2O + + r423*NOp_H2O*NO2m_H2O + r424*NOp_H2O*NO3m_HCL + r425*NOp_H2O*CLm_H2O + r426*NOp_H2O*NO3m2H2O + + r427*NOp_H2O*NO2m + r428*NOp_2H2O*NO3mHNO3 + r429*NOp_2H2O*CO3m + r430*NOp_2H2O*CLm_HCL + + r431*NOp_2H2O*NO3m + r432*NOp_2H2O*HCO3m + r433*NOp_2H2O*O2m + r434*NOp_2H2O*CO4m + + r435*NOp_2H2O*NO3m_H2O + r436*NOp_2H2O*CO3m2H2O + r437*NOp_2H2O*CLm + r438*NOp_2H2O*CO3m_H2O + + r439*NOp_2H2O*NO2m_H2O + r440*NOp_2H2O*NO3m_HCL + r441*NOp_2H2O*CLm_H2O + r442*NOp_2H2O*NO3m2H2O + + r443*NOp_2H2O*NO2m + r444*NOp*NO3mHNO3 + r445*NOp*CO3m + r446*NOp*CLm_HCL + r447*NOp*NO3m + + r448*NOp*HCO3m + r449*NOp*O2m + r450*NOp*CO4m + r451*NOp*NO3m_H2O + r452*NOp*CO3m2H2O + + r453*NOp*CLm + r454*NOp*CO3m_H2O + r455*NOp*NO2m_H2O + r456*NOp*NO3m_HCL + r457*NOp*CLm_H2O + + r458*NOp*NO3m2H2O + r459*NOp*NO2m + - j6*NO - j7*NO - r62*M*H*NO - r68*N*NO - r72*M*O*NO - r73*HO2*NO - r74*O3*NO - r82*NO3*NO + - r101*CLO*NO - r122*BRO*NO - r154*CH3O2*NO - r201*O2p*NO - r261*Om*NO - r295*O3m*NO + - r298*O3m*NO - r310*CO3m*NO - r337*CLOm*NO - r338*CLOm*NO - r346*CO3m_H2O*NO - r352*CO3m_H2O*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j36*BRONO2 + j98*NO2m + r79*M*N2O5 + + r88*M*HO2NO2 + r63*OH*HONO + r72*M*NO*O + r73*NO*HO2 + r74*NO*O3 + 2*r82*NO3*NO + r83*NO3*O + + r84*NO3*OH + r85*NO3*HO2 + r87*HO2NO2*OH + r101*CLO*NO + r122*BRO*NO + r154*CH3O2*NO + + r251*NOp_H2O*OH + r261*Om*NO + r327*NO2m*CL + r338*CLOm*NO + r375*Hp_4H2O*NO2m_H2O + + r379*Hp_4H2O*NO2m + r391*Hp_5H2O*NO2m_H2O + r395*Hp_5H2O*NO2m + r407*Hp_3H2O*NO2m_H2O + + r411*Hp_3H2O*NO2m + r423*NOp_H2O*NO2m_H2O + r427*NOp_H2O*NO2m + r439*NOp_2H2O*NO2m_H2O + + r443*NOp_2H2O*NO2m + r455*NOp*NO2m_H2O + r459*NOp*NO2m + r471*O2p*NO2m_H2O + r475*O2p*NO2m + - j8*NO2 - r159*NO2 - r69*N*NO2 - r70*N*NO2 - r71*N*NO2 - r75*O*NO2 - r76*M*O*NO2 - r77*O3*NO2 + - r78*M*NO3*NO2 - r80*M*OH*NO2 - r86*M*HO2*NO2 - r102*M*CLO*NO2 - r123*M*BRO*NO2 - r169*SO*NO2 + - r276*Om*NO2 - r286*O2m*NO2 - r296*O3m*NO2 - r297*O3m*NO2 - r302*OHm*NO2 - r311*CO3m*NO2 + - r323*NO2m*NO2 - r333*CLm*NO2 - r347*CO3m_H2O*NO2 - r349*CO3m_H2O*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j35*BRONO2 + j99*NO3m + r79*M*N2O5 + r76*M*NO2*O + + r77*NO2*O3 + r81*HNO3*OH + r113*CLONO2*O + r114*CLONO2*OH + r115*CLONO2*CL + r131*BRONO2*O + + r135*F*HNO3 + r250*NOp_H2O*HO2 + r328*NO2m*CLO + r371*Hp_4H2O*NO3m_H2O + r376*Hp_4H2O*NO3m_HCL + + r378*Hp_4H2O*NO3m2H2O + r387*Hp_5H2O*NO3m_H2O + r392*Hp_5H2O*NO3m_HCL + r394*Hp_5H2O*NO3m2H2O + + r403*Hp_3H2O*NO3m_H2O + r408*Hp_3H2O*NO3m_HCL + r410*Hp_3H2O*NO3m2H2O + r412*NOp_H2O*NO3mHNO3 + + r415*NOp_H2O*NO3m + r419*NOp_H2O*NO3m_H2O + r424*NOp_H2O*NO3m_HCL + r426*NOp_H2O*NO3m2H2O + + r428*NOp_2H2O*NO3mHNO3 + r431*NOp_2H2O*NO3m + r435*NOp_2H2O*NO3m_H2O + r440*NOp_2H2O*NO3m_HCL + + r442*NOp_2H2O*NO3m2H2O + r444*NOp*NO3mHNO3 + r447*NOp*NO3m + r451*NOp*NO3m_H2O + + r456*NOp*NO3m_HCL + r458*NOp*NO3m2H2O + r460*O2p*NO3mHNO3 + r463*O2p*NO3m + r467*O2p*NO3m_H2O + + r472*O2p*NO3m_HCL + r474*O2p*NO3m2H2O + r488*M*Hp_4H2O*NO3m_H2O + r489*M*Hp_5H2O*NO3m_H2O + - j12*NO3 - j13*NO3 - r158*NO3 - r78*M*NO2*NO3 - r82*NO*NO3 - r83*O*NO3 - r84*OH*NO3 + - r85*HO2*NO3 - r151*CH2O*NO3 - r177*DMS*NO3 + d(HNO3)/dt = 2*r157*N2O5 + r158*NO3 + .5*r159*NO2 + 2*r178*N2O5 + r179*CLONO2 + r180*BRONO2 + 2*r184*N2O5 + + r185*CLONO2 + r188*BRONO2 + 2*r189*N2O5 + r190*CLONO2 + r191*BRONO2 + r358*M*NO3mHNO3 + + r80*M*NO2*OH + r151*CH2O*NO3 + r177*DMS*NO3 + r181*CLONO2*HCL + r186*CLONO2*HCL + + r192*CLONO2*HCL + r244*Hp_4H2O*N2O5 + r245*Hp_5H2O*N2O5 + r246*Hp_3N1*H2O + r247*Hp_4N1*H2O + + r331*NO3m*HCL + r357*NO3m2H2O*N2O5 + r362*NO3m_H2O*N2O5 + 2*r364*Hp_4H2O*NO3mHNO3 + + r367*Hp_4H2O*NO3m + 2*r380*Hp_5H2O*NO3mHNO3 + r383*Hp_5H2O*NO3m + 2*r396*Hp_3H2O*NO3mHNO3 + + r399*Hp_3H2O*NO3m + r412*NOp_H2O*NO3mHNO3 + r428*NOp_2H2O*NO3mHNO3 + r444*NOp*NO3mHNO3 + + r460*O2p*NO3mHNO3 + r477*M*Hp_4H2O*NO3m + r479*M*Hp_5H2O*NO3m + 2*r482*M*Hp_4H2O*NO3mHNO3 + + 2*r483*M*Hp_5H2O*NO3mHNO3 + - j11*HNO3 - r81*OH*HNO3 - r135*F*HNO3 - r279*Om*HNO3 - r288*O2m*HNO3 - r312*CO3m*HNO3 + - r325*NO2m*HNO3 - r334*CLm*HNO3 - r359*M*NO3m*HNO3 - r360*NO3m_HCL*HNO3 - r363*NO3m_H2O*HNO3 + d(HO2NO2)/dt = r86*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r88*M*HO2NO2 - r87*OH*HO2NO2 + d(N2O5)/dt = r78*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r79*M*N2O5 - r157*N2O5 - r178*N2O5 - r184*N2O5 - r189*N2O5 + - r244*Hp_4H2O*N2O5 - r245*Hp_5H2O*N2O5 - r357*NO3m2H2O*N2O5 - r362*NO3m_H2O*N2O5 + d(CH4)/dt = - j59*CH4 - j60*CH4 - r39*O1D*CH4 - r40*O1D*CH4 - r41*O1D*CH4 - r95*CL*CH4 - r134*F*CH4 + - r148*OH*CH4 + d(CH3O2)/dt = j37*CH3CL + j48*CH3BR + j59*CH4 + r39*O1D*CH4 + r95*CL*CH4 + r134*F*CH4 + r148*CH4*OH + + r156*CH3OOH*OH + - r100*CLO*CH3O2 - r154*NO*CH3O2 - r155*HO2*CH3O2 + d(CH3OOH)/dt = r155*CH3O2*HO2 + - j16*CH3OOH - r156*OH*CH3OOH + d(CH2O)/dt = j16*CH3OOH + .18*j60*CH4 + r40*O1D*CH4 + r41*O1D*CH4 + r100*CLO*CH3O2 + r154*CH3O2*NO + - j17*CH2O - j18*CH2O - r94*CL*CH2O - r118*BR*CH2O - r151*NO3*CH2O - r152*OH*CH2O + - r153*O*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j58*CO2 + .38*j60*CH4 + j64*OCS + j92*CO2 + r94*CL*CH2O + r118*BR*CH2O + + r136*CH3CL*CL + r151*CH2O*NO3 + r152*CH2O*OH + r153*CH2O*O + r161*OCS*O + r162*OCS*OH + + r199*Op*CO2 + - r149*OH*CO - r150*M*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j60*CH4 + r41*O1D*CH4 + r48*H*HO2 + - r42*O1D*H2 - r55*OH*H2 - r57*O*H2 - r90*CL*H2 - r133*F*H2 - r264*Om*H2 - r278*Om*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j34*HBR + j57*HF + j59*CH4 + + .33*j60*CH4 + r40*O1D*CH4 + r42*O1D*H2 + r50*OH*O + r55*OH*H2 + r57*H2*O + r66*N*OH + + r90*CL*H2 + r133*F*H2 + r149*CO*OH + r152*CH2O*OH + r162*OCS*OH + r163*S*OH + r166*SO*OH + + r219*H3Op_OH*e + r220*Hp_H2O*e + r221*Hp_2H2O*e + r222*Hp_3H2O*e + r223*Hp_4H2O*e + + r224*Hp_5H2O*e + r278*Om*H2 + r365*Hp_4H2O*CO3m + r366*Hp_4H2O*CLm_HCL + r368*Hp_4H2O*HCO3m + + r369*Hp_4H2O*O2m + r370*Hp_4H2O*CO4m + r371*Hp_4H2O*NO3m_H2O + r372*Hp_4H2O*CO3m2H2O + + r373*Hp_4H2O*CLm + r374*Hp_4H2O*CO3m_H2O + r375*Hp_4H2O*NO2m_H2O + r376*Hp_4H2O*NO3m_HCL + + r377*Hp_4H2O*CLm_H2O + r378*Hp_4H2O*NO3m2H2O + r379*Hp_4H2O*NO2m + r381*Hp_5H2O*CO3m + + r382*Hp_5H2O*CLm_HCL + r384*Hp_5H2O*HCO3m + r385*Hp_5H2O*O2m + r386*Hp_5H2O*CO4m + + r387*Hp_5H2O*NO3m_H2O + r388*Hp_5H2O*CO3m2H2O + r389*Hp_5H2O*CLm + r390*Hp_5H2O*CO3m_H2O + + r391*Hp_5H2O*NO2m_H2O + r392*Hp_5H2O*NO3m_HCL + r393*Hp_5H2O*CLm_H2O + r394*Hp_5H2O*NO3m2H2O + + r395*Hp_5H2O*NO2m + r397*Hp_3H2O*CO3m + r398*Hp_3H2O*CLm_HCL + r400*Hp_3H2O*HCO3m + + r401*Hp_3H2O*O2m + r402*Hp_3H2O*CO4m + r403*Hp_3H2O*NO3m_H2O + r404*Hp_3H2O*CO3m2H2O + + r405*Hp_3H2O*CLm + r406*Hp_3H2O*CO3m_H2O + r407*Hp_3H2O*NO2m_H2O + r408*Hp_3H2O*NO3m_HCL + + r409*Hp_3H2O*CLm_H2O + r410*Hp_3H2O*NO3m2H2O + r411*Hp_3H2O*NO2m + r476*M*Hp_4H2O*CO3m + + r478*M*Hp_5H2O*CO3m + r484*M*Hp_4H2O*CO3m2H2O + r485*M*Hp_5H2O*CO3m2H2O + r486*M*Hp_4H2O*CO3m_H2O + + r487*M*Hp_5H2O*CO3m_H2O + r488*M*Hp_4H2O*NO3m_H2O + r489*M*Hp_5H2O*NO3m_H2O + - r45*M*O2*H - r46*O3*H - r47*HO2*H - r48*HO2*H - r49*HO2*H - r62*M*NO*H - r252*NOp_H2O*H + - r268*O2m*H - r272*OHm*H - r293*O3m*H - r309*CO3m*H - r317*CO4m*H - r322*NO2m*H - r332*CLm*H + d(H2O2)/dt = .5*r160*HO2 + r54*M*OH*OH + r60*HO2*HO2 + - j22*H2O2 - r56*OH*H2O2 - r61*O*H2O2 - r91*CL*H2O2 + d(HONO)/dt = r62*M*H*NO + r254*NOp_3H2O*H2O + r326*NO2m*HCL + - j66*HONO - r63*OH*HONO + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(CL2)/dt = r104*CLO*CLO + r115*CLONO2*CL + r181*CLONO2*HCL + r182*HOCL*HCL + r186*CLONO2*HCL + r187*HOCL*HCL + + r192*CLONO2*HCL + r193*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r107*M*CL2O2 + r107*M*CL2O2 + r89*CL*O3 + r93*CL*HO2 + r110*HOCL*O + + r111*HOCL*CL + r112*HOCL*OH + r113*CLONO2*O + r172*SO*OCLO + - j24*CLO - r96*O*CLO - r97*OH*CLO - r98*OH*CLO - r99*HO2*CLO - r100*CH3O2*CLO - r101*NO*CLO + - r102*M*NO2*CLO - 2*r103*CLO*CLO - 2*r104*CLO*CLO - 2*r105*CLO*CLO - 2*r106*M*CLO*CLO + - r124*BRO*CLO - r125*BRO*CLO - r126*BRO*CLO - r170*SO*CLO - r282*Om*CLO - r290*O2m*CLO + - r306*OHm*CLO - r315*CO3m*CLO - r321*CO4m*CLO - r328*NO2m*CLO + d(OCLO)/dt = r105*CLO*CLO + r124*BRO*CLO + - j25*OCLO - r172*SO*OCLO + d(CL2O2)/dt = r106*M*CLO*CLO + - j26*CL2O2 - r107*M*CL2O2 + d(HCL)/dt = r342*M*CLm_HCL + r90*CL*H2 + r91*CL*H2O2 + r92*CL*HO2 + r94*CL*CH2O + r95*CL*CH4 + r98*CLO*OH + + r111*HOCL*CL + 2*r136*CH3CL*CL + r141*CH3BR*CL + r146*CH2BR2*CL + r147*CHBR3*CL + r332*CLm*H + + r334*CLm*HNO3 + r360*NO3m_HCL*HNO3 + r366*Hp_4H2O*CLm_HCL + r376*Hp_4H2O*NO3m_HCL + + r382*Hp_5H2O*CLm_HCL + r392*Hp_5H2O*NO3m_HCL + r398*Hp_3H2O*CLm_HCL + r408*Hp_3H2O*NO3m_HCL + + r414*NOp_H2O*CLm_HCL + r424*NOp_H2O*NO3m_HCL + r430*NOp_2H2O*CLm_HCL + r440*NOp_2H2O*NO3m_HCL + + r446*NOp*CLm_HCL + r456*NOp*NO3m_HCL + r462*O2p*CLm_HCL + r472*O2p*NO3m_HCL + + 2*r480*M*Hp_4H2O*CLm_HCL + 2*r481*M*Hp_5H2O*CLm_HCL + - j28*HCL - r43*O1D*HCL - r108*OH*HCL - r109*O*HCL - r181*CLONO2*HCL - r182*HOCL*HCL + - r183*HOBR*HCL - r186*CLONO2*HCL - r187*HOCL*HCL - r192*CLONO2*HCL - r193*HOCL*HCL + - r194*HOBR*HCL - r280*Om*HCL - r289*O2m*HCL - r304*OHm*HCL - r319*CO4m*HCL - r326*NO2m*HCL + - r331*NO3m*HCL - r336*M*CLm*HCL - r340*CLm_H2O*HCL - r361*M*NO3m*HCL + d(HOCL)/dt = r179*CLONO2 + r185*CLONO2 + r190*CLONO2 + r99*CLO*HO2 + r114*CLONO2*OH + - j27*HOCL - r110*O*HOCL - r111*CL*HOCL - r112*OH*HOCL - r182*HCL*HOCL - r187*HCL*HOCL + - r193*HCL*HOCL + d(CLONO2)/dt = r102*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r179*CLONO2 - r185*CLONO2 - r190*CLONO2 - r113*O*CLONO2 + - r114*OH*CLONO2 - r115*CL*CLONO2 - r181*HCL*CLONO2 - r186*HCL*CLONO2 - r192*HCL*CLONO2 + d(BRCL)/dt = r126*BRO*CLO + r183*HOBR*HCL + r194*HOBR*HCL + - j31*BRCL + d(BRO)/dt = j36*BRONO2 + r116*BR*O3 + r130*HOBR*O + r131*BRONO2*O + - j32*BRO - r119*O*BRO - r120*OH*BRO - r121*HO2*BRO - r122*NO*BRO - r123*M*NO2*BRO + - r124*CLO*BRO - r125*CLO*BRO - r126*CLO*BRO - 2*r127*BRO*BRO - r171*SO*BRO + d(HBR)/dt = r117*BR*HO2 + r118*BR*CH2O + - j34*HBR - r44*O1D*HBR - r128*OH*HBR - r129*O*HBR + d(HOBR)/dt = r180*BRONO2 + r188*BRONO2 + r191*BRONO2 + r121*BRO*HO2 + - j33*HOBR - r130*O*HOBR - r183*HCL*HOBR - r194*HCL*HOBR + d(BRONO2)/dt = r123*M*BRO*NO2 + - j35*BRONO2 - j36*BRONO2 - r180*BRONO2 - r188*BRONO2 - r191*BRONO2 - r131*O*BRONO2 + d(CH3CL)/dt = - j37*CH3CL - r136*CL*CH3CL - r137*OH*CH3CL + d(CH3BR)/dt = - j48*CH3BR - r30*O1D*CH3BR - r140*OH*CH3BR - r141*CL*CH3BR + d(CFC11)/dt = - j40*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j41*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j42*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j45*HCFC22 - r26*O1D*HCFC22 - r139*OH*HCFC22 + d(CCL4)/dt = - j38*CCL4 - r29*O1D*CCL4 + d(CH3CCL3)/dt = - j39*CH3CCL3 - r138*OH*CH3CCL3 + d(CF3BR)/dt = - j49*CF3BR - r32*O1D*CF3BR + d(CF2CLBR)/dt = - j50*CF2CLBR - r31*O1D*CF2CLBR + d(HCFC141B)/dt = - j46*HCFC141B - r27*O1D*HCFC141B - r142*OH*HCFC141B + d(HCFC142B)/dt = - j47*HCFC142B - r28*O1D*HCFC142B - r143*OH*HCFC142B + d(CFC114)/dt = - j43*CFC114 - r24*O1D*CFC114 + d(CFC115)/dt = - j44*CFC115 - r25*O1D*CFC115 + d(H1202)/dt = - j53*H1202 - r33*O1D*H1202 + d(H2402)/dt = - j54*H2402 - r34*O1D*H2402 + d(CHBR3)/dt = - j51*CHBR3 - r35*O1D*CHBR3 - r145*OH*CHBR3 - r147*CL*CHBR3 + d(CH2BR2)/dt = - j52*CH2BR2 - r36*O1D*CH2BR2 - r144*OH*CH2BR2 - r146*CL*CH2BR2 + d(COF2)/dt = j41*CFC12 + j42*CFC113 + 2*j43*CFC114 + 2*j44*CFC115 + j45*HCFC22 + j47*HCFC142B + j49*CF3BR + + j50*CF2CLBR + j53*H1202 + 2*j54*H2402 + r22*O1D*CFC12 + r23*O1D*CFC113 + 2*r24*O1D*CFC114 + + 2*r25*O1D*CFC115 + r26*O1D*HCFC22 + r28*O1D*HCFC142B + r31*O1D*CF2CLBR + r32*O1D*CF3BR + + r33*O1D*H1202 + 2*r34*O1D*H2402 + r139*HCFC22*OH + r143*HCFC142B*OH + - j55*COF2 - r37*O1D*COF2 + d(COFCL)/dt = j40*CFC11 + j42*CFC113 + j46*HCFC141B + r21*O1D*CFC11 + r23*O1D*CFC113 + r27*O1D*HCFC141B + + r142*HCFC141B*OH + - j56*COFCL - r38*O1D*COFCL + d(HF)/dt = r132*F*H2O + r133*F*H2 + r134*F*CH4 + r135*F*HNO3 + - j57*HF + d(F)/dt = j44*CFC115 + j49*CF3BR + 2*j55*COF2 + j56*COFCL + j57*HF + r25*O1D*CFC115 + r32*O1D*CF3BR + + 2*r37*O1D*COF2 + r38*O1D*COFCL + - r132*H2O*F - r133*H2*F - r134*CH4*F - r135*HNO3*F + d(CO2)/dt = .44*j60*CH4 + j102*CO3m + j103*CO4m + r257*M*NOp_CO2 + r149*CO*OH + r150*M*CO*OH + + r214*NOp_CO2*e + r255*NOp_CO2*H2O + r307*CO3m*O + r308*CO3m*O2 + r309*CO3m*H + r310*CO3m*NO + + r311*CO3m*NO2 + r312*CO3m*HNO3 + r313*CO3m*CL + r314*CO3m*CL + r315*CO3m*CLO + r316*CO4m*O3 + + r319*CO4m*HCL + r320*CO4m*CL + r321*CO4m*CLO + r346*CO3m_H2O*NO + r347*CO3m_H2O*NO2 + + r349*CO3m_H2O*NO2 + r352*CO3m_H2O*NO + r365*Hp_4H2O*CO3m + r368*Hp_4H2O*HCO3m + + r370*Hp_4H2O*CO4m + r372*Hp_4H2O*CO3m2H2O + r374*Hp_4H2O*CO3m_H2O + r381*Hp_5H2O*CO3m + + r384*Hp_5H2O*HCO3m + r386*Hp_5H2O*CO4m + r388*Hp_5H2O*CO3m2H2O + r390*Hp_5H2O*CO3m_H2O + + r397*Hp_3H2O*CO3m + r400*Hp_3H2O*HCO3m + r402*Hp_3H2O*CO4m + r404*Hp_3H2O*CO3m2H2O + + r406*Hp_3H2O*CO3m_H2O + r413*NOp_H2O*CO3m + r416*NOp_H2O*HCO3m + r418*NOp_H2O*CO4m + + r420*NOp_H2O*CO3m2H2O + r422*NOp_H2O*CO3m_H2O + r429*NOp_2H2O*CO3m + r432*NOp_2H2O*HCO3m + + r434*NOp_2H2O*CO4m + r436*NOp_2H2O*CO3m2H2O + r438*NOp_2H2O*CO3m_H2O + r445*NOp*CO3m + + r448*NOp*HCO3m + r450*NOp*CO4m + r452*NOp*CO3m2H2O + r454*NOp*CO3m_H2O + r461*O2p*CO3m + + r464*O2p*HCO3m + r466*O2p*CO4m + r468*O2p*CO3m2H2O + r470*O2p*CO3m_H2O + r476*M*Hp_4H2O*CO3m + + r478*M*Hp_5H2O*CO3m + r484*M*Hp_4H2O*CO3m2H2O + r485*M*Hp_5H2O*CO3m2H2O + + r486*M*Hp_4H2O*CO3m_H2O + r487*M*Hp_5H2O*CO3m_H2O + - j58*CO2 - j92*CO2 - r199*Op*CO2 - r226*NOp_N2*CO2 - r256*M*NOp*CO2 - r277*M*Om*CO2 + - r285*M*O2m*CO2 - r294*O3m*CO2 - r300*O4m*CO2 - r303*M*OHm*CO2 + d(OCS)/dt = - j64*OCS - r161*O*OCS - r162*OH*OCS + d(S)/dt = j64*OCS + j65*SO + - r163*OH*S - r164*O2*S - r165*O3*S + d(SO)/dt = j62*SO2 + r161*OCS*O + r163*S*OH + r164*S*O2 + r165*S*O3 + - j65*SO - r166*OH*SO - r167*O2*SO - r168*O3*SO - r169*NO2*SO - r170*CLO*SO - r171*BRO*SO + - r172*OCLO*SO + d(SO2)/dt = j63*SO3 + r162*OCS*OH + r166*SO*OH + r167*SO*O2 + r168*SO*O3 + r169*SO*NO2 + r170*SO*CLO + + r171*SO*BRO + r172*SO*OCLO + .5*r175*DMS*OH + r176*DMS*OH + r177*DMS*NO3 + - j62*SO2 - r173*OH*SO2 + d(SO3)/dt = j61*H2SO4 + r173*SO2*OH + - j63*SO3 - r174*H2O*SO3 + d(H2SO4)/dt = r174*SO3*H2O + - j61*H2SO4 + d(DMS)/dt = - r175*OH*DMS - r176*OH*DMS - r177*NO3*DMS + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 + d(pom_a4)/dt = 0 + d(bc_a4)/dt = 0 + d(num_a4)/dt = 0 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j37*CH3CL + + 4*j38*CCL4 + 3*j39*CH3CCL3 + 2*j40*CFC11 + 2*j41*CFC12 + 2*j42*CFC113 + 2*j43*CFC114 + + j44*CFC115 + j45*HCFC22 + j46*HCFC141B + j47*HCFC142B + j50*CF2CLBR + j56*COFCL + + 2*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 2*r23*O1D*CFC113 + 2*r24*O1D*CFC114 + r25*O1D*CFC115 + + r26*O1D*HCFC22 + r27*O1D*HCFC141B + r28*O1D*HCFC142B + 4*r29*O1D*CCL4 + r31*O1D*CF2CLBR + + r38*O1D*COFCL + r43*O1D*HCL + r96*CLO*O + r97*CLO*OH + r100*CLO*CH3O2 + r101*CLO*NO + + 2*r103*CLO*CLO + r105*CLO*CLO + r108*HCL*OH + r109*HCL*O + r125*BRO*CLO + r137*CH3CL*OH + + 3*r138*CH3CCL3*OH + r139*HCFC22*OH + r142*HCFC141B*OH + r143*HCFC142B*OH + r170*SO*CLO + + r333*CLm*NO2 + r337*CLOm*NO + r366*Hp_4H2O*CLm_HCL + r373*Hp_4H2O*CLm + r377*Hp_4H2O*CLm_H2O + + r382*Hp_5H2O*CLm_HCL + r389*Hp_5H2O*CLm + r393*Hp_5H2O*CLm_H2O + r398*Hp_3H2O*CLm_HCL + + r405*Hp_3H2O*CLm + r409*Hp_3H2O*CLm_H2O + r414*NOp_H2O*CLm_HCL + r421*NOp_H2O*CLm + + r425*NOp_H2O*CLm_H2O + r430*NOp_2H2O*CLm_HCL + r437*NOp_2H2O*CLm + r441*NOp_2H2O*CLm_H2O + + r446*NOp*CLm_HCL + r453*NOp*CLm + r457*NOp*CLm_H2O + r462*O2p*CLm_HCL + r469*O2p*CLm + + r473*O2p*CLm_H2O + - r89*O3*CL - r90*H2*CL - r91*H2O2*CL - r92*HO2*CL - r93*HO2*CL - r94*CH2O*CL - r95*CH4*CL + - r111*HOCL*CL - r115*CLONO2*CL - r136*CH3CL*CL - r141*CH3BR*CL - r146*CH2BR2*CL - r147*CHBR3*CL + - r281*Om*CL - r291*O2m*CL - r305*OHm*CL - r313*CO3m*CL - r314*CO3m*CL - r320*CO4m*CL + - r327*NO2m*CL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*HBR + j35*BRONO2 + j48*CH3BR + j49*CF3BR + j50*CF2CLBR + + 3*j51*CHBR3 + 2*j52*CH2BR2 + 2*j53*H1202 + 2*j54*H2402 + r30*O1D*CH3BR + r31*O1D*CF2CLBR + + r32*O1D*CF3BR + 2*r33*O1D*H1202 + 2*r34*O1D*H2402 + 3*r35*O1D*CHBR3 + 2*r36*O1D*CH2BR2 + + r44*O1D*HBR + r119*BRO*O + r120*BRO*OH + r122*BRO*NO + r124*BRO*CLO + r125*BRO*CLO + + 2*r127*BRO*BRO + r128*HBR*OH + r129*HBR*O + r140*CH3BR*OH + r141*CH3BR*CL + 2*r144*CH2BR2*OH + + 3*r145*CHBR3*OH + 2*r146*CH2BR2*CL + 3*r147*CHBR3*CL + r171*SO*BRO + - r116*O3*BR - r117*HO2*BR - r118*CH2O*BR + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .33*j60*CH4 + + j66*HONO + j97*OHm + .5*r159*NO2 + 2*r17*O1D*H2O + r39*O1D*CH4 + r42*O1D*H2 + r43*O1D*HCL + + r44*O1D*HBR + r46*H*O3 + 2*r47*H*HO2 + r57*H2*O + r58*HO2*O + r59*HO2*O3 + r61*H2O2*O + + r73*NO*HO2 + r85*NO3*HO2 + r93*CL*HO2 + r109*HCL*O + r110*HOCL*O + r129*HBR*O + r130*HOBR*O + + r132*F*H2O + r153*CH2O*O + r219*H3Op_OH*e + r234*O2p_H2O*H2O + r235*H3Op_OH*H2O + r275*Om*H2O + + r279*Om*HNO3 + r280*Om*HCL + r301*OHm*O3 + r302*OHm*NO2 + r305*OHm*CL + r306*OHm*CLO + + r312*CO3m*HNO3 + r317*CO4m*H + r368*Hp_4H2O*HCO3m + r384*Hp_5H2O*HCO3m + r400*Hp_3H2O*HCO3m + + r416*NOp_H2O*HCO3m + r432*NOp_2H2O*HCO3m + r448*NOp*HCO3m + r464*O2p*HCO3m + - r50*O*OH - r51*O3*OH - r52*HO2*OH - 2*r53*OH*OH - 2*r54*M*OH*OH - r55*H2*OH - r56*H2O2*OH + - r63*HONO*OH - r66*N*OH - r80*M*NO2*OH - r81*HNO3*OH - r84*NO3*OH - r87*HO2NO2*OH - r97*CLO*OH + - r98*CLO*OH - r108*HCL*OH - r112*HOCL*OH - r114*CLONO2*OH - r120*BRO*OH - r128*HBR*OH + - r137*CH3CL*OH - r138*CH3CCL3*OH - r139*HCFC22*OH - r140*CH3BR*OH - r142*HCFC141B*OH + - r143*HCFC142B*OH - r144*CH2BR2*OH - r145*CHBR3*OH - r148*CH4*OH - r149*CO*OH - r150*M*CO*OH + - r152*CH2O*OH - r156*CH3OOH*OH - r162*OCS*OH - r163*S*OH - r166*SO*OH - r173*SO2*OH + - r175*DMS*OH - r176*DMS*OH - r251*NOp_H2O*OH + d(HO2)/dt = j15*HO2NO2 + r88*M*HO2NO2 + r40*O1D*CH4 + r45*M*H*O2 + r51*OH*O3 + r56*OH*H2O2 + r61*H2O2*O + + r84*NO3*OH + r91*CL*H2O2 + r94*CL*CH2O + r97*CLO*OH + r100*CLO*CH3O2 + r118*BR*CH2O + + r120*BRO*OH + r136*CH3CL*CL + r137*CH3CL*OH + r140*CH3BR*OH + r141*CH3BR*CL + r150*M*CO*OH + + r151*CH2O*NO3 + r153*CH2O*O + r154*CH3O2*NO + r173*SO2*OH + .5*r175*DMS*OH + r268*O2m*H + + r271*OHm*O + r288*O2m*HNO3 + r289*O2m*HCL + r319*CO4m*HCL + - r160*HO2 - r47*H*HO2 - r48*H*HO2 - r49*H*HO2 - r52*OH*HO2 - r58*O*HO2 - r59*O3*HO2 + - 2*r60*HO2*HO2 - r73*NO*HO2 - r85*NO3*HO2 - r86*M*NO2*HO2 - r92*CL*HO2 - r93*CL*HO2 + - r99*CLO*HO2 - r117*BR*HO2 - r121*BRO*HO2 - r155*CH3O2*HO2 - r250*NOp_H2O*HO2 + d(N2p)/dt = j72*N2 + j84*N2 + - r197*O*N2p - r198*O*N2p - r205*O2*N2p - r209*e*N2p + d(O2p)/dt = j71*O2 + j83*O2 + j93*O2p_H2O + r195*Op*O2 + r199*Op*CO2 + r202*Np*O2 + r205*N2p*O2 + + r231*O4p*O2_1D + r232*O4p*O + 2*r465*O2p*O2m + - r206*N2*O2p - r200*N*O2p - r201*NO*O2p - r208*e*O2p - r228*M*O2*O2p - r229*M*H2O*O2p + - r460*NO3mHNO3*O2p - r461*CO3m*O2p - r462*CLm_HCL*O2p - r463*NO3m*O2p - r464*HCO3m*O2p + - r465*O2m*O2p - r466*CO4m*O2p - r467*NO3m_H2O*O2p - r468*CO3m2H2O*O2p - r469*CLm*O2p + - r470*CO3m_H2O*O2p - r471*NO2m_H2O*O2p - r472*NO3m_HCL*O2p - r473*CLm_H2O*O2p + - r474*NO3m2H2O*O2p - r475*NO2m*O2p + d(O4p)/dt = r228*M*O2p*O2 + - r213*e*O4p - r230*H2O*O4p - r231*O2_1D*O4p - r232*O*O4p + d(O2p_H2O)/dt = r229*M*O2p*H2O + r230*O4p*H2O + - j93*O2p_H2O - r218*e*O2p_H2O - r233*H2O*O2p_H2O - r234*H2O*O2p_H2O + d(Hp_H2O)/dt = r237*M*Hp_2H2O + r234*O2p_H2O*H2O + r250*NOp_H2O*HO2 + r251*NOp_H2O*OH + r252*NOp_H2O*H + - r220*e*Hp_H2O - r236*M*H2O*Hp_H2O + d(Hp_2H2O)/dt = r239*M*Hp_3H2O + r235*H3Op_OH*H2O + r236*M*Hp_H2O*H2O + - r237*M*Hp_2H2O - r221*e*Hp_2H2O - r238*M*H2O*Hp_2H2O + d(Hp_3H2O)/dt = r241*M*Hp_4H2O + r238*M*Hp_2H2O*H2O + r254*NOp_3H2O*H2O + - r239*M*Hp_3H2O - r222*e*Hp_3H2O - r240*M*H2O*Hp_3H2O - r396*NO3mHNO3*Hp_3H2O + - r397*CO3m*Hp_3H2O - r398*CLm_HCL*Hp_3H2O - r399*NO3m*Hp_3H2O - r400*HCO3m*Hp_3H2O + - r401*O2m*Hp_3H2O - r402*CO4m*Hp_3H2O - r403*NO3m_H2O*Hp_3H2O - r404*CO3m2H2O*Hp_3H2O + - r405*CLm*Hp_3H2O - r406*CO3m_H2O*Hp_3H2O - r407*NO2m_H2O*Hp_3H2O - r408*NO3m_HCL*Hp_3H2O + - r409*CLm_H2O*Hp_3H2O - r410*NO3m2H2O*Hp_3H2O - r411*NO2m*Hp_3H2O + d(Hp_4H2O)/dt = r243*M*Hp_5H2O + r240*M*Hp_3H2O*H2O + r246*Hp_3N1*H2O + - r241*M*Hp_4H2O - r223*e*Hp_4H2O - r242*M*H2O*Hp_4H2O - r244*N2O5*Hp_4H2O + - r364*NO3mHNO3*Hp_4H2O - r365*CO3m*Hp_4H2O - r366*CLm_HCL*Hp_4H2O - r367*NO3m*Hp_4H2O + - r368*HCO3m*Hp_4H2O - r369*O2m*Hp_4H2O - r370*CO4m*Hp_4H2O - r371*NO3m_H2O*Hp_4H2O + - r372*CO3m2H2O*Hp_4H2O - r373*CLm*Hp_4H2O - r374*CO3m_H2O*Hp_4H2O - r375*NO2m_H2O*Hp_4H2O + - r376*NO3m_HCL*Hp_4H2O - r377*CLm_H2O*Hp_4H2O - r378*NO3m2H2O*Hp_4H2O - r379*NO2m*Hp_4H2O + - r476*M*CO3m*Hp_4H2O - r477*M*NO3m*Hp_4H2O - r480*M*CLm_HCL*Hp_4H2O - r482*M*NO3mHNO3*Hp_4H2O + - r484*M*CO3m2H2O*Hp_4H2O - r486*M*CO3m_H2O*Hp_4H2O - r488*M*NO3m_H2O*Hp_4H2O + d(Hp_5H2O)/dt = r242*M*Hp_4H2O*H2O + r247*Hp_4N1*H2O + - r243*M*Hp_5H2O - r224*e*Hp_5H2O - r245*N2O5*Hp_5H2O - r380*NO3mHNO3*Hp_5H2O + - r381*CO3m*Hp_5H2O - r382*CLm_HCL*Hp_5H2O - r383*NO3m*Hp_5H2O - r384*HCO3m*Hp_5H2O + - r385*O2m*Hp_5H2O - r386*CO4m*Hp_5H2O - r387*NO3m_H2O*Hp_5H2O - r388*CO3m2H2O*Hp_5H2O + - r389*CLm*Hp_5H2O - r390*CO3m_H2O*Hp_5H2O - r391*NO2m_H2O*Hp_5H2O - r392*NO3m_HCL*Hp_5H2O + - r393*CLm_H2O*Hp_5H2O - r394*NO3m2H2O*Hp_5H2O - r395*NO2m*Hp_5H2O - r478*M*CO3m*Hp_5H2O + - r479*M*NO3m*Hp_5H2O - r481*M*CLm_HCL*Hp_5H2O - r483*M*NO3mHNO3*Hp_5H2O + - r485*M*CO3m2H2O*Hp_5H2O - r487*M*CO3m_H2O*Hp_5H2O - r489*M*NO3m_H2O*Hp_5H2O + d(H3Op_OH)/dt = r233*O2p_H2O*H2O + - r219*e*H3Op_OH - r235*H2O*H3Op_OH + d(Hp_3N1)/dt = r244*Hp_4H2O*N2O5 + - r246*H2O*Hp_3N1 + d(Hp_4N1)/dt = r245*Hp_5H2O*N2O5 + - r247*H2O*Hp_4N1 + d(NOp_H2O)/dt = r227*NOp_N2*H2O + r248*M*NOp*H2O + r255*NOp_CO2*H2O + - r215*e*NOp_H2O - r249*M*H2O*NOp_H2O - r250*HO2*NOp_H2O - r251*OH*NOp_H2O - r252*H*NOp_H2O + - r412*NO3mHNO3*NOp_H2O - r413*CO3m*NOp_H2O - r414*CLm_HCL*NOp_H2O - r415*NO3m*NOp_H2O + - r416*HCO3m*NOp_H2O - r417*O2m*NOp_H2O - r418*CO4m*NOp_H2O - r419*NO3m_H2O*NOp_H2O + - r420*CO3m2H2O*NOp_H2O - r421*CLm*NOp_H2O - r422*CO3m_H2O*NOp_H2O - r423*NO2m_H2O*NOp_H2O + - r424*NO3m_HCL*NOp_H2O - r425*CLm_H2O*NOp_H2O - r426*NO3m2H2O*NOp_H2O - r427*NO2m*NOp_H2O + d(NOp_2H2O)/dt = r249*M*NOp_H2O*H2O + - r216*e*NOp_2H2O - r253*M*H2O*NOp_2H2O - r428*NO3mHNO3*NOp_2H2O - r429*CO3m*NOp_2H2O + - r430*CLm_HCL*NOp_2H2O - r431*NO3m*NOp_2H2O - r432*HCO3m*NOp_2H2O - r433*O2m*NOp_2H2O + - r434*CO4m*NOp_2H2O - r435*NO3m_H2O*NOp_2H2O - r436*CO3m2H2O*NOp_2H2O - r437*CLm*NOp_2H2O + - r438*CO3m_H2O*NOp_2H2O - r439*NO2m_H2O*NOp_2H2O - r440*NO3m_HCL*NOp_2H2O + - r441*CLm_H2O*NOp_2H2O - r442*NO3m2H2O*NOp_2H2O - r443*NO2m*NOp_2H2O + d(NOp_3H2O)/dt = r253*M*NOp_2H2O*H2O + - r217*e*NOp_3H2O - r254*H2O*NOp_3H2O + d(NOp_CO2)/dt = r226*NOp_N2*CO2 + r256*M*NOp*CO2 + - r257*M*NOp_CO2 - r214*e*NOp_CO2 - r255*H2O*NOp_CO2 + d(NOp_N2)/dt = r258*N2*M*NOp + - r259*M*NOp_N2 - r225*e*NOp_N2 - r226*CO2*NOp_N2 - r227*H2O*NOp_N2 + d(Om)/dt = j100*O3m + j102*CO3m + r211*O3*e + r283*O2m*O + - j94*Om - r263*M*Om - r260*O*Om - r261*NO*Om - r262*O2_1D*Om - r264*H2*Om - r273*O3*Om + - r274*M*O2*Om - r275*H2O*Om - r276*NO2*Om - r277*M*CO2*Om - r278*H2*Om - r279*HNO3*Om + - r280*HCL*Om - r281*CL*Om - r282*CLO*Om + d(O2m)/dt = j101*O4m + j103*CO4m + r210*N2*O2*e + r212*M*O2*e + r292*O3m*O + r307*CO3m*O + - j95*O2m - r267*N2*O2m - r265*O*O2m - r266*O2_1D*O2m - r268*H*O2m - r283*O*O2m - r284*O3*O2m + - r285*M*CO2*O2m - r286*NO2*O2m - r287*M*O2*O2m - r288*HNO3*O2m - r289*HCL*O2m - r290*CLO*O2m + - r291*CL*O2m - r369*Hp_4H2O*O2m - r385*Hp_5H2O*O2m - r401*Hp_3H2O*O2m - r417*NOp_H2O*O2m + - r433*NOp_2H2O*O2m - r449*NOp*O2m - r465*O2p*O2m + d(O3m)/dt = r273*Om*O3 + r274*M*Om*O2 + r284*O2m*O3 + r299*O4m*O + r301*OHm*O3 + r308*CO3m*O2 + r316*CO4m*O3 + - j96*O3m - j100*O3m - r269*O*O3m - r270*O3*O3m - r292*O*O3m - r293*H*O3m - r294*CO2*O3m + - r295*NO*O3m - r296*NO2*O3m - r297*NO2*O3m - r298*NO*O3m + d(O4m)/dt = r287*M*O2m*O2 + - j101*O4m - r299*O*O4m - r300*CO2*O4m + d(OHm)/dt = r275*Om*H2O + r278*Om*H2 + r293*O3m*H + r309*CO3m*H + r322*NO2m*H + - j97*OHm - r271*O*OHm - r272*H*OHm - r301*O3*OHm - r302*NO2*OHm - r303*M*CO2*OHm + - r304*HCL*OHm - r305*CL*OHm - r306*CLO*OHm + d(CO3m)/dt = j104*CO3m_H2O + r348*M*CO3m_H2O + r277*M*Om*CO2 + r294*O3m*CO2 + r317*CO4m*H + r318*CO4m*O + - j102*CO3m - r307*O*CO3m - r308*O2*CO3m - r309*H*CO3m - r310*NO*CO3m - r311*NO2*CO3m + - r312*HNO3*CO3m - r313*CL*CO3m - r314*CL*CO3m - r315*CLO*CO3m - r343*M*H2O*CO3m + - r365*Hp_4H2O*CO3m - r381*Hp_5H2O*CO3m - r397*Hp_3H2O*CO3m - r413*NOp_H2O*CO3m + - r429*NOp_2H2O*CO3m - r445*NOp*CO3m - r461*O2p*CO3m - r476*M*Hp_4H2O*CO3m - r478*M*Hp_5H2O*CO3m + d(CO4m)/dt = r285*M*O2m*CO2 + r300*O4m*CO2 + - j103*CO4m - r316*O3*CO4m - r317*H*CO4m - r318*O*CO4m - r319*HCL*CO4m - r320*CL*CO4m + - r321*CLO*CO4m - r370*Hp_4H2O*CO4m - r386*Hp_5H2O*CO4m - r402*Hp_3H2O*CO4m - r418*NOp_H2O*CO4m + - r434*NOp_2H2O*CO4m - r450*NOp*CO4m - r466*O2p*CO4m + d(NO2m)/dt = r353*M*NO2m_H2O + r276*Om*NO2 + r286*O2m*NO2 + r297*O3m*NO2 + r298*O3m*NO + r302*OHm*NO2 + + r310*CO3m*NO + r329*NO3m*O + r330*NO3m*O3 + r333*CLm*NO2 + r337*CLOm*NO + r346*CO3m_H2O*NO + - j98*NO2m - r322*H*NO2m - r323*NO2*NO2m - r324*O3*NO2m - r325*HNO3*NO2m - r326*HCL*NO2m + - r327*CL*NO2m - r328*CLO*NO2m - r354*M*H2O*NO2m - r379*Hp_4H2O*NO2m - r395*Hp_5H2O*NO2m + - r411*Hp_3H2O*NO2m - r427*NOp_H2O*NO2m - r443*NOp_2H2O*NO2m - r459*NOp*NO2m - r475*O2p*NO2m + d(NO3m)/dt = r345*M*NO3m_H2O + r358*M*NO3mHNO3 + r279*Om*HNO3 + r288*O2m*HNO3 + r295*O3m*NO + r296*O3m*NO2 + + r311*CO3m*NO2 + r312*CO3m*HNO3 + r323*NO2m*NO2 + r324*NO2m*O3 + r325*NO2m*HNO3 + + r334*CLm*HNO3 + r347*CO3m_H2O*NO2 + - j99*NO3m - r329*O*NO3m - r330*O3*NO3m - r331*HCL*NO3m - r344*M*H2O*NO3m - r359*M*HNO3*NO3m + - r361*M*HCL*NO3m - r367*Hp_4H2O*NO3m - r383*Hp_5H2O*NO3m - r399*Hp_3H2O*NO3m + - r415*NOp_H2O*NO3m - r431*NOp_2H2O*NO3m - r447*NOp*NO3m - r463*O2p*NO3m - r477*M*Hp_4H2O*NO3m + - r479*M*Hp_5H2O*NO3m + d(CO3m_H2O)/dt = r351*M*CO3m2H2O + r343*M*CO3m*H2O + - j104*CO3m_H2O - r348*M*CO3m_H2O - r346*NO*CO3m_H2O - r347*NO2*CO3m_H2O - r349*NO2*CO3m_H2O + - r350*M*H2O*CO3m_H2O - r352*NO*CO3m_H2O - r374*Hp_4H2O*CO3m_H2O - r390*Hp_5H2O*CO3m_H2O + - r406*Hp_3H2O*CO3m_H2O - r422*NOp_H2O*CO3m_H2O - r438*NOp_2H2O*CO3m_H2O - r454*NOp*CO3m_H2O + - r470*O2p*CO3m_H2O - r486*M*Hp_4H2O*CO3m_H2O - r487*M*Hp_5H2O*CO3m_H2O + d(CO3m2H2O)/dt = r350*M*CO3m_H2O*H2O + - r351*M*CO3m2H2O - r372*Hp_4H2O*CO3m2H2O - r388*Hp_5H2O*CO3m2H2O - r404*Hp_3H2O*CO3m2H2O + - r420*NOp_H2O*CO3m2H2O - r436*NOp_2H2O*CO3m2H2O - r452*NOp*CO3m2H2O - r468*O2p*CO3m2H2O + - r484*M*Hp_4H2O*CO3m2H2O - r485*M*Hp_5H2O*CO3m2H2O + d(NO2m_H2O)/dt = r352*CO3m_H2O*NO + r354*M*NO2m*H2O + - r353*M*NO2m_H2O - r375*Hp_4H2O*NO2m_H2O - r391*Hp_5H2O*NO2m_H2O - r407*Hp_3H2O*NO2m_H2O + - r423*NOp_H2O*NO2m_H2O - r439*NOp_2H2O*NO2m_H2O - r455*NOp*NO2m_H2O - r471*O2p*NO2m_H2O + d(NO3m_H2O)/dt = r356*M*NO3m2H2O + r344*M*NO3m*H2O + r349*CO3m_H2O*NO2 + - r345*M*NO3m_H2O - r355*M*H2O*NO3m_H2O - r362*N2O5*NO3m_H2O - r363*HNO3*NO3m_H2O + - r371*Hp_4H2O*NO3m_H2O - r387*Hp_5H2O*NO3m_H2O - r403*Hp_3H2O*NO3m_H2O + - r419*NOp_H2O*NO3m_H2O - r435*NOp_2H2O*NO3m_H2O - r451*NOp*NO3m_H2O - r467*O2p*NO3m_H2O + - r488*M*Hp_4H2O*NO3m_H2O - r489*M*Hp_5H2O*NO3m_H2O + d(NO3m2H2O)/dt = r355*M*NO3m_H2O*H2O + - r356*M*NO3m2H2O - r357*N2O5*NO3m2H2O - r378*Hp_4H2O*NO3m2H2O - r394*Hp_5H2O*NO3m2H2O + - r410*Hp_3H2O*NO3m2H2O - r426*NOp_H2O*NO3m2H2O - r442*NOp_2H2O*NO3m2H2O - r458*NOp*NO3m2H2O + - r474*O2p*NO3m2H2O + d(NO3mHNO3)/dt = r357*NO3m2H2O*N2O5 + r359*M*NO3m*HNO3 + r360*NO3m_HCL*HNO3 + r362*NO3m_H2O*N2O5 + + r363*NO3m_H2O*HNO3 + - r358*M*NO3mHNO3 - r364*Hp_4H2O*NO3mHNO3 - r380*Hp_5H2O*NO3mHNO3 - r396*Hp_3H2O*NO3mHNO3 + - r412*NOp_H2O*NO3mHNO3 - r428*NOp_2H2O*NO3mHNO3 - r444*NOp*NO3mHNO3 - r460*O2p*NO3mHNO3 + - r482*M*Hp_4H2O*NO3mHNO3 - r483*M*Hp_5H2O*NO3mHNO3 + d(NO3m_HCL)/dt = r361*M*NO3m*HCL + - r360*HNO3*NO3m_HCL - r376*Hp_4H2O*NO3m_HCL - r392*Hp_5H2O*NO3m_HCL - r408*Hp_3H2O*NO3m_HCL + - r424*NOp_H2O*NO3m_HCL - r440*NOp_2H2O*NO3m_HCL - r456*NOp*NO3m_HCL - r472*O2p*NO3m_HCL + d(HCO3m)/dt = r303*M*OHm*CO2 + - r368*Hp_4H2O*HCO3m - r384*Hp_5H2O*HCO3m - r400*Hp_3H2O*HCO3m - r416*NOp_H2O*HCO3m + - r432*NOp_2H2O*HCO3m - r448*NOp*HCO3m - r464*O2p*HCO3m + d(CLm)/dt = r341*M*CLm_H2O + r342*M*CLm_HCL + r280*Om*HCL + r281*Om*CL + r282*Om*CLO + r289*O2m*HCL + + r291*O2m*CL + r304*OHm*HCL + r305*OHm*CL + r313*CO3m*CL + r315*CO3m*CLO + r319*CO4m*HCL + + r320*CO4m*CL + r326*NO2m*HCL + r327*NO2m*CL + r328*NO2m*CLO + r331*NO3m*HCL + r338*CLOm*NO + + r339*CLOm*O + - r332*H*CLm - r333*NO2*CLm - r334*HNO3*CLm - r335*M*H2O*CLm - r336*M*HCL*CLm - r373*Hp_4H2O*CLm + - r389*Hp_5H2O*CLm - r405*Hp_3H2O*CLm - r421*NOp_H2O*CLm - r437*NOp_2H2O*CLm - r453*NOp*CLm + - r469*O2p*CLm + d(CLOm)/dt = r290*O2m*CLO + r306*OHm*CLO + r314*CO3m*CL + r321*CO4m*CLO + - r337*NO*CLOm - r338*NO*CLOm - r339*O*CLOm + d(CLm_H2O)/dt = r335*M*CLm*H2O + - r341*M*CLm_H2O - r340*HCL*CLm_H2O - r377*Hp_4H2O*CLm_H2O - r393*Hp_5H2O*CLm_H2O + - r409*Hp_3H2O*CLm_H2O - r425*NOp_H2O*CLm_H2O - r441*NOp_2H2O*CLm_H2O - r457*NOp*CLm_H2O + - r473*O2p*CLm_H2O + d(CLm_HCL)/dt = r336*M*CLm*HCL + r340*CLm_H2O*HCL + - r342*M*CLm_HCL - r366*Hp_4H2O*CLm_HCL - r382*Hp_5H2O*CLm_HCL - r398*Hp_3H2O*CLm_HCL + - r414*NOp_H2O*CLm_HCL - r430*NOp_2H2O*CLm_HCL - r446*NOp*CLm_HCL - r462*O2p*CLm_HCL + - r480*M*Hp_4H2O*CLm_HCL - r481*M*Hp_5H2O*CLm_HCL + d(Np)/dt = j76*N2 + j77*N2 + j88*N2 + j89*N2 + j70*N + - r202*O2*Np - r203*O2*Np - r204*O*Np + d(Op)/dt = j67*O + j68*O + j69*O + j73*O2 + j74*O2 + j75*O2 + j80*O + j81*O + j82*O + j85*O2 + j86*O2 + + j87*O2 + r198*N2p*O + r204*Np*O + - r196*N2*Op - r195*O2*Op - r199*CO2*Op + d(NOp)/dt = j7*NO + r196*N2*Op + r206*N2*O2p + r257*M*NOp_CO2 + r259*M*NOp_N2 + r197*N2p*O + r200*O2p*N + + r201*O2p*NO + r203*Np*O2 + - r258*N2*M*NOp - r207*e*NOp - r248*M*H2O*NOp - r256*M*CO2*NOp - r444*NO3mHNO3*NOp + - r445*CO3m*NOp - r446*CLm_HCL*NOp - r447*NO3m*NOp - r448*HCO3m*NOp - r449*O2m*NOp + - r450*CO4m*NOp - r451*NO3m_H2O*NOp - r452*CO3m2H2O*NOp - r453*CLm*NOp - r454*CO3m_H2O*NOp + - r455*NO2m_H2O*NOp - r456*NO3m_HCL*NOp - r457*CLm_H2O*NOp - r458*NO3m2H2O*NOp - r459*NO2m*NOp + d(e)/dt = j72*N2 + j76*N2 + j77*N2 + j84*N2 + j88*N2 + j89*N2 + j7*NO + j67*O + j68*O + j69*O + j70*N + + j71*O2 + j73*O2 + j74*O2 + j75*O2 + j80*O + j81*O + j82*O + j83*O2 + j85*O2 + j86*O2 + + j87*O2 + j94*Om + j95*O2m + j96*O3m + j97*OHm + j98*NO2m + j99*NO3m + r263*M*Om + r267*N2*O2m + + r260*Om*O + r261*Om*NO + r262*Om*O2_1D + r264*Om*H2 + r265*O2m*O + r266*O2m*O2_1D + r268*O2m*H + + r269*O3m*O + r270*O3m*O3 + r271*OHm*O + r272*OHm*H + r332*CLm*H + - r207*NOp*e - r208*O2p*e - r209*N2p*e - r210*N2*O2*e - r211*O3*e - r212*M*O2*e - r213*O4p*e + - r214*NOp_CO2*e - r215*NOp_H2O*e - r216*NOp_2H2O*e - r217*NOp_3H2O*e - r218*O2p_H2O*e + - r219*H3Op_OH*e - r220*Hp_H2O*e - r221*Hp_2H2O*e - r222*Hp_3H2O*e - r223*Hp_4H2O*e + - r224*Hp_5H2O*e - r225*NOp_N2*e + d(N2D)/dt = j77*N2 + 1.2*j79*N2 + j89*N2 + 1.2*j91*N2 + r197*N2p*O + .8*r207*NOp*e + .9*r209*N2p*e + - r64*O2*N2D - r65*O*N2D + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D - r231*O4p*O2_1D - r262*Om*O2_1D + - r266*O2m*O2_1D + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r64*N2D*O2 + .85*r208*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*CFC114*O1D - r25*CFC115*O1D + - r26*HCFC22*O1D - r27*HCFC141B*O1D - r28*HCFC142B*O1D - r29*CCL4*O1D - r30*CH3BR*O1D + - r31*CF2CLBR*O1D - r32*CF3BR*O1D - r33*H1202*O1D - r34*H2402*O1D - r35*CHBR3*O1D + - r36*CH2BR2*O1D - r37*COF2*O1D - r38*COFCL*O1D - r39*CH4*O1D - r40*CH4*O1D - r41*CH4*O1D + - r42*H2*O1D - r43*HCL*O1D - r44*HBR*O1D + d(H2O)/dt = .05*j60*CH4 + j61*H2SO4 + j93*O2p_H2O + j104*CO3m_H2O + r237*M*Hp_2H2O + r239*M*Hp_3H2O + + r241*M*Hp_4H2O + r243*M*Hp_5H2O + r341*M*CLm_H2O + r345*M*NO3m_H2O + r348*M*CO3m_H2O + + r351*M*CO3m2H2O + r353*M*NO2m_H2O + r356*M*NO3m2H2O + r49*H*HO2 + r52*OH*HO2 + r53*OH*OH + + r55*OH*H2 + r56*OH*H2O2 + r63*OH*HONO + r81*HNO3*OH + r87*HO2NO2*OH + r108*HCL*OH + + r112*HOCL*OH + r128*HBR*OH + r137*CH3CL*OH + r138*CH3CCL3*OH + r139*HCFC22*OH + r140*CH3BR*OH + + r144*CH2BR2*OH + r148*CH4*OH + r152*CH2O*OH + r156*CH3OOH*OH + r182*HOCL*HCL + r183*HOBR*HCL + + r187*HOCL*HCL + r193*HOCL*HCL + r194*HOBR*HCL + r215*NOp_H2O*e + 2*r216*NOp_2H2O*e + + 3*r217*NOp_3H2O*e + r218*O2p_H2O*e + r219*H3Op_OH*e + r220*Hp_H2O*e + 2*r221*Hp_2H2O*e + + 3*r222*Hp_3H2O*e + 4*r223*Hp_4H2O*e + 5*r224*Hp_5H2O*e + r264*Om*H2 + r272*OHm*H + + r304*OHm*HCL + r340*CLm_H2O*HCL + r346*CO3m_H2O*NO + r347*CO3m_H2O*NO2 + r357*NO3m2H2O*N2O5 + + r363*NO3m_H2O*HNO3 + 4*r364*Hp_4H2O*NO3mHNO3 + 4*r365*Hp_4H2O*CO3m + 4*r366*Hp_4H2O*CLm_HCL + + 4*r367*Hp_4H2O*NO3m + 4*r368*Hp_4H2O*HCO3m + 4*r369*Hp_4H2O*O2m + 4*r370*Hp_4H2O*CO4m + + 5*r371*Hp_4H2O*NO3m_H2O + 6*r372*Hp_4H2O*CO3m2H2O + 4*r373*Hp_4H2O*CLm + 5*r374*Hp_4H2O*CO3m_H2O + + 5*r375*Hp_4H2O*NO2m_H2O + 4*r376*Hp_4H2O*NO3m_HCL + 5*r377*Hp_4H2O*CLm_H2O + + 6*r378*Hp_4H2O*NO3m2H2O + 4*r379*Hp_4H2O*NO2m + 5*r380*Hp_5H2O*NO3mHNO3 + 5*r381*Hp_5H2O*CO3m + + 5*r382*Hp_5H2O*CLm_HCL + 5*r383*Hp_5H2O*NO3m + 5*r384*Hp_5H2O*HCO3m + 5*r385*Hp_5H2O*O2m + + 5*r386*Hp_5H2O*CO4m + 6*r387*Hp_5H2O*NO3m_H2O + 7*r388*Hp_5H2O*CO3m2H2O + 5*r389*Hp_5H2O*CLm + + 6*r390*Hp_5H2O*CO3m_H2O + 6*r391*Hp_5H2O*NO2m_H2O + 5*r392*Hp_5H2O*NO3m_HCL + + 6*r393*Hp_5H2O*CLm_H2O + 7*r394*Hp_5H2O*NO3m2H2O + 5*r395*Hp_5H2O*NO2m + 3*r396*Hp_3H2O*NO3mHNO3 + + 3*r397*Hp_3H2O*CO3m + 3*r398*Hp_3H2O*CLm_HCL + 3*r399*Hp_3H2O*NO3m + 3*r400*Hp_3H2O*HCO3m + + 3*r401*Hp_3H2O*O2m + 3*r402*Hp_3H2O*CO4m + 4*r403*Hp_3H2O*NO3m_H2O + 5*r404*Hp_3H2O*CO3m2H2O + + 3*r405*Hp_3H2O*CLm + 4*r406*Hp_3H2O*CO3m_H2O + 4*r407*Hp_3H2O*NO2m_H2O + 3*r408*Hp_3H2O*NO3m_HCL + + 4*r409*Hp_3H2O*CLm_H2O + 5*r410*Hp_3H2O*NO3m2H2O + 3*r411*Hp_3H2O*NO2m + r412*NOp_H2O*NO3mHNO3 + + r413*NOp_H2O*CO3m + r414*NOp_H2O*CLm_HCL + r415*NOp_H2O*NO3m + r416*NOp_H2O*HCO3m + + r417*NOp_H2O*O2m + r418*NOp_H2O*CO4m + 2*r419*NOp_H2O*NO3m_H2O + 3*r420*NOp_H2O*CO3m2H2O + + r421*NOp_H2O*CLm + 2*r422*NOp_H2O*CO3m_H2O + 2*r423*NOp_H2O*NO2m_H2O + r424*NOp_H2O*NO3m_HCL + + 2*r425*NOp_H2O*CLm_H2O + 3*r426*NOp_H2O*NO3m2H2O + r427*NOp_H2O*NO2m + 2*r428*NOp_2H2O*NO3mHNO3 + + 2*r429*NOp_2H2O*CO3m + 2*r430*NOp_2H2O*CLm_HCL + 2*r431*NOp_2H2O*NO3m + 2*r432*NOp_2H2O*HCO3m + + 2*r433*NOp_2H2O*O2m + 2*r434*NOp_2H2O*CO4m + 3*r435*NOp_2H2O*NO3m_H2O + 4*r436*NOp_2H2O*CO3m2H2O + + 2*r437*NOp_2H2O*CLm + 3*r438*NOp_2H2O*CO3m_H2O + 3*r439*NOp_2H2O*NO2m_H2O + + 2*r440*NOp_2H2O*NO3m_HCL + 3*r441*NOp_2H2O*CLm_H2O + 4*r442*NOp_2H2O*NO3m2H2O + + 2*r443*NOp_2H2O*NO2m + r451*NOp*NO3m_H2O + 2*r452*NOp*CO3m2H2O + r454*NOp*CO3m_H2O + + r455*NOp*NO2m_H2O + r457*NOp*CLm_H2O + 2*r458*NOp*NO3m2H2O + r467*O2p*NO3m_H2O + + 2*r468*O2p*CO3m2H2O + r470*O2p*CO3m_H2O + r471*O2p*NO2m_H2O + r473*O2p*CLm_H2O + + 2*r474*O2p*NO3m2H2O + 4*r476*M*Hp_4H2O*CO3m + 4*r477*M*Hp_4H2O*NO3m + 5*r478*M*Hp_5H2O*CO3m + + 5*r479*M*Hp_5H2O*NO3m + 4*r480*M*Hp_4H2O*CLm_HCL + 5*r481*M*Hp_5H2O*CLm_HCL + + 4*r482*M*Hp_4H2O*NO3mHNO3 + 5*r483*M*Hp_5H2O*NO3mHNO3 + 6*r484*M*Hp_4H2O*CO3m2H2O + + 7*r485*M*Hp_5H2O*CO3m2H2O + 5*r486*M*Hp_4H2O*CO3m_H2O + 6*r487*M*Hp_5H2O*CO3m_H2O + + 5*r488*M*Hp_4H2O*NO3m_H2O + 6*r489*M*Hp_5H2O*NO3m_H2O + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r132*F*H2O - r174*SO3*H2O - r227*NOp_N2*H2O + - r229*M*O2p*H2O - r230*O4p*H2O - r233*O2p_H2O*H2O - r234*O2p_H2O*H2O - r235*H3Op_OH*H2O + - r236*M*Hp_H2O*H2O - r238*M*Hp_2H2O*H2O - r240*M*Hp_3H2O*H2O - r242*M*Hp_4H2O*H2O + - r246*Hp_3N1*H2O - r247*Hp_4N1*H2O - r248*M*NOp*H2O - r249*M*NOp_H2O*H2O - r253*M*NOp_2H2O*H2O + - r254*NOp_3H2O*H2O - r255*NOp_CO2*H2O - r275*Om*H2O - r335*M*CLm*H2O - r343*M*CO3m*H2O + - r344*M*NO3m*H2O - r350*M*CO3m_H2O*H2O - r354*M*NO2m*H2O - r355*M*NO3m_H2O*H2O diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mech.in b/src/chemistry/pp_waccm_mad_mam4/chem_mech.in new file mode 100644 index 0000000000..e8ec7724b1 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mech.in @@ -0,0 +1,825 @@ + SPECIES + + Solution + O3, O, O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH2O, CO + H2, H, H2O2, HONO + CLY, BRY + CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3 + CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl + CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 + CFC114 -> CClF2CClF2, CFC115 -> CClF2CF3, H1202 -> CBr2F2 + H2402 ->CBrF2CBrF2, CHBR3 -> CHBr3, CH2BR2 -> CH2Br2 + COF2, COFCL -> COFCl, HF, F + CO2 + OCS, S, SO, SO2, SO3, H2SO4, DMS -> CH3SCH3, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a2 -> AlSiO5 + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + pom_a4 -> C, bc_a4 -> C + num_a4 -> H + CL -> Cl, BR -> Br, OH, HO2 + N2p -> N2, O2p -> O2 + O4p -> O4, O2p_H2O -> H2O3 + Hp_H2O -> H3O, Hp_2H2O -> H5O2, Hp_3H2O -> H7O3 + Hp_4H2O -> H9O4, Hp_5H2O -> H11O5 + H3Op_OH -> H4O2 + Hp_3N1 -> H8NO6, Hp_4N1 -> H10NO7 + NOp_H2O -> H2NO2, NOp_2H2O -> H4NO3, NOp_3H2O -> H6NO3 + NOp_CO2 -> NCO3, NOp_N2 -> N3O + Om -> O, O2m -> O2, O3m -> O3, O4m-> O4 + OHm -> OH + CO3m -> CO3, CO4m -> CO4 + NO2m -> NO2, NO3m -> NO3 + CO3m_H2O -> H2CO4, CO3m2H2O -> H4CO5, NO2m_H2O -> H2NO3, NO3m_H2O -> H2NO4 + NO3m2H2O -> H4NO5, NO3mHNO3 -> HN2O6, NO3m_HCL -> NO3HCl + HCO3m -> HCO3, CLm -> Cl, CLOm -> ClO, CLm_H2O -> ClH2O + CLm_HCL -> Cl2H + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N + O2_1S -> O2, O2_1D -> O2, O1D -> O + H2O + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + CL, BR, OH, HO2 + Op, O2p, NOp, Np, N2p, e, O2_1S, O2_1D, N2D, O1D + O4p, O2p_H2O + Hp_H2O, Hp_2H2O, Hp_3H2O, Hp_4H2O, Hp_5H2O + H3Op_OH, Hp_3N1, Hp_4N1 + NOp_H2O, NOp_2H2O, NOp_3H2O, NOp_CO2, NOp_N2 + Om, O2m, O3m, O4m, CO3m, CO4m, NO2m, NO3m, OHm, HCO3m + CO3m_H2O, CO3m2H2O, NO2m_H2O, NO3m_H2O, NO3m2H2O + NO3mHNO3, NO3m_HCL + CLm, CLOm, CLm_H2O, CLm_HCL + End Not-Transported + + END Species + + Solution classes + Explicit + CH4, N2O, CH3CL, CH3BR, CFC11, CFC12, CFC113 + CFC114, CFC115, HCFC22, HCFC141B, HCFC142B, CCL4 + CH3CCL3, CF3BR, CF2CLBR, H1202, H2402, CHBR3, CH2BR2 + CLY, BRY + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D, H2, CO, CO2 + N, NO, NO2, OH, NO3, HONO, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D + O4p, O2p_H2O + Hp_H2O, Hp_2H2O, Hp_3H2O, Hp_4H2O, Hp_5H2O + H3Op_OH, Hp_3N1, Hp_4N1 + NOp_H2O, NOp_2H2O, NOp_3H2O, NOp_CO2, NOp_N2 + Om, O2m, O3m, O4m, CO3m, CO4m, NO2m, NO3m, OHm, HCO3m + CO3m_H2O, CO3m2H2O, NO2m_H2O, NO3m_H2O, NO3m2H2O + NO3mHNO3, NO3m_HCL + CLm, CLOm, CLm_H2O, CLm_HCL, e + COF2, COFCL, HF, F + OCS, S, SO, SO2, SO3, H2SO4, DMS, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, num_a2 + dst_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + pom_a4, bc_a4, num_a4 + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> CL + O + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jhbr] HBR + hv -> BR + H + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 2*CL + COFCL + [jcf2cl2] CFC12 + hv -> 2*CL + COF2 + [jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 + [jcfc114] CFC114 + hv -> 2*CL + 2*COF2 + [jcfc115] CFC115 + hv -> CL + F + 2*COF2 + [jhcfc22] HCFC22 + hv -> CL + COF2 + [jhcfc141b] HCFC141B + hv -> CL + COFCL + [jhcfc142b] HCFC142B + hv -> CL + COF2 + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + F + COF2 + [jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 + [jchbr3] CHBR3 + hv -> 3*BR + [jch2br2] CH2BR2 + hv -> 2*BR + [jh1202] H1202 + hv -> 2*BR + COF2 + [jh2402] H2402 + hv -> 2*BR + 2*COF2 + [jcof2] COF2 + hv -> 2*F + [jcofcl] COFCL + hv -> F + CL + [jhf] HF + hv -> H + F + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O + [jh2so4] H2SO4 + hv -> SO3 + H2O + [jso2] SO2 + hv -> SO + O + [jso3] SO3 + hv -> SO2 + O + [jocs] OCS + hv -> S + CO + [jso] SO + hv -> S + O + [jhono] HONO + hv -> OH + NO +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op + e + [jeuv_3=userdefined,userdefined] O + hv -> Op + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op + e + [jeuv_16=userdefined,userdefined] O + hv -> Op + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + + [jppi=userdefined] O2p_H2O + hv -> O2p + H2O + [jepn1=userdefined] Om + hv -> O + e + [jepn2=userdefined] O2m + hv -> O2 + e + [jepn3=userdefined] O3m + hv -> O3 + e + [jepn4=userdefined] OHm + hv -> OH + e + [jepn6=userdefined] NO2m + hv -> NO2 + e + [jepn7=userdefined] NO3m + hv -> NO3 + e + [jpni1=userdefined] O3m + hv -> Om + O2 + [jpni2=userdefined] O4m + hv -> O2m + O2 + [jpni3=userdefined] CO3m + hv -> Om + CO2 + [jpni4=userdefined] CO4m + hv -> O2m + CO2 + [jpni5=userdefined] CO3m_H2O + hv -> CO3m + H2O + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 + +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.91] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + [O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60. + [O1D_N2Oa] O1D + N2O -> 2*NO ; 7.25e-11, 20. + [O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.63e-11, 20. + [O1D_O3] O1D + O3 -> O2 + O2 ; 1.20e-10 + [O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.02e-10 + [O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 + [O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 1.50e-10 + [O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 9.75e-11 + [O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 1.50e-11 + [O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.20e-11 + [O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 + [O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.628e-10 + [O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.84e-10 + [O1D_CH3BR] O1D + CH3BR -> BR ; 1.674e-10 + [O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.60e-11 + [O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.10e-11 + [O1D_H1202] O1D + H1202 -> 2*BR + COF2 ; 1.012e-10 + [O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.20e-10 + [O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.49e-10 + [O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 + [O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 + [O1D_COFCL] O1D + COFCL -> F + CL ; 1.90e-10 + [O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 + [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.50e-11 + [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9.00e-12 + [O1D_H2] O1D + H2 -> H + OH ; 1.20e-10 + [O1D_HCL] O1D + HCL -> CL + OH ; 1.50e-10 + [O1D_HBR] O1D + HBR -> BR + OH ; 1.20e-10 + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 7.5e-11, -0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [H_HO2a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [H_HO2b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 1.80e-11, 180. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + [OH_OH] OH + OH -> H2O + O ; 1.80e-12 + [OH_OH_M] OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6 + [OH_H2] OH + H2 -> H2O + H ; 2.80e-12, -1800. + [OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [H2_O] H2 + O -> OH + H ; 1.60e-11, -4570. + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + [HONO1] H + NO + M -> HONO + M ; 7e-31, 2.6, 3.6e-11, 0.1, 0.6 + [HONO2] OH + HONO -> H2O + NO2 ; 1.8e-11, 390 +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_OH] N + OH -> NO + H ; 5.00e-11 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + [N_NO2a] N + NO2 -> N2O + O ; 2.90e-12, 220. + [N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220. + [N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220. + [NO_O] NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.30e-12, 270. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.10e-12, 210. + [NO2_O_M] NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + [NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + [NO3_NO] NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + [NO3_O] NO3 + O -> NO2 + O2 ; 1.00e-11 + [NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.20e-11 + [NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + [HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + [CL_O3] CL + O3 -> CLO + O2 ; 2.30e-11, -200. + [CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270. + [CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + [CL_HO2a] CL + HO2 -> HCL + O2 ; 1.40e-11, 270. + [CL_HO2b] CL + HO2 -> OH + CLO ; 3.60e-11, -375. + [CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + [CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + [CLO_O] CLO + O -> CL + O2 ; 2.80e-11, 85. + [CLO_OHa] CLO + OH -> CL + HO2 ; 7.40e-12, 270. + [CLO_OHb] CLO + OH -> HCL + O2 ; 6.00e-13, 230. + [CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.60e-12, 290. + [CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115. + [CLO_NO] CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + [CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + [CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + [CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + [CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 3.0e-12, 2.0, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + [HCL_OH] HCL + OH -> H2O + CL ; 1.80e-12, -250. + [HCL_O] HCL + O -> CL + OH ; 1.00e-11, -3300. + [HOCL_O] HOCL + O -> CLO + OH ; 1.70e-13 + [HOCL_CL] HOCL + CL -> HCL + CLO ; 3.40e-12, -130. + [HOCL_OH] HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + [CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.60e-12, -840. + [CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + [CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + [BR_O3] BR + O3 -> BRO + O2 ; 1.60e-11, -780. + [BR_HO2] BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + [BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + [BRO_O] BRO + O -> BR + O2 ; 1.90e-11, 230. + [BRO_OH] BRO + OH -> BR + HO2 ; 1.70e-11, 250. + [BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + [BRO_NO] BRO + NO -> BR + NO2 ; 8.80e-12, 260. + [BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + [BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + [BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + [BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + [BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + [HBR_OH] HBR + OH -> BR + H2O ; 5.50e-12, 200. + [HBR_O] HBR + O -> BR + OH ; 5.80e-12, -1500. + [HOBR_O] HOBR + O -> BRO + OH ; 1.20e-10, -430. + [BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Odd Flourine Reactions +* -------------------------------------------------------------- + [F_H2O] F + H2O -> HF + OH ; 1.40e-11, 0. + [F_H2] F + H2 -> HF + H ; 1.40e-10, -500. + [F_CH4] F + CH4 -> HF + CH3O2 ; 1.60e-10, -260. + [F_HNO3] F + HNO3 -> HF + NO3 ; 6.00e-12, 400. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + [CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + [CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + [CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + [HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 1.05e-12, -1600. + [CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + [CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.40e-11, -1030. + [HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600. + [HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.30e-12, -1770. + [CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2.00e-12, -840. + [CHBR3_OH] CHBR3 + OH -> 3*BR ; 1.35e-12, -600. + [CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.30e-12, -800. + [CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850. + +* -------------------------------------------------------------- +* C-1 Degradation (Methane, CO, CH2O and derivatives) +* -------------------------------------------------------------- + [CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + [usr_CO_OH_b] CO + OH -> CO2 + H + [CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058. + [CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + [CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + [CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + [CH3OOH_OH] CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200. + + +* -------------------------------------------------------------- +* Tropospheric Heterogeneous Reactions +* -------------------------------------------------------------- + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + [usr_HO2_aer] HO2 -> 0.5*H2O2 + +* -------------------------------------------------------------- +* Sulfur Reactions +* -------------------------------------------------------------- + [OCS_O] OCS + O -> SO + CO ; 2.10E-11, -2200.0 + [OCS_OH] OCS + OH -> SO2 + CO + H ; 1.10E-13, -1200.0 + [S_OH] S + OH -> SO + H ; 6.60E-11 + [S_O2] S + O2 -> SO + O ; 2.30E-12 + [S_O3] S + O3 -> SO + O2 ; 1.20E-11 + [SO_OH] SO + OH -> SO2 + H ; 2.70E-11, 335 + [SO_O2] SO + O2 -> SO2 + O ; 1.25E-13, -2190.0 + [SO_O3] SO + O3 -> SO2 + O2 ; 3.40E-12, -1100.0 + [SO_NO2] SO + NO2 -> SO2 + NO ; 1.40E-11 + [SO_CLO] SO + CLO -> SO2 + CL ; 2.80E-11 + [SO_BRO] SO + BRO -> SO2 + BR ; 5.70E-11 + [SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.90E-12 + [usr_SO2_OH] SO2 + OH -> SO3 + HO2 + [usr_SO3_H2O] SO3 + H2O -> H2SO4 + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + [DMS_OHb] DMS + OH -> SO2 ; 9.60e-12, -234. + [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.90e-13, 520. + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 + +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + [ion_N2p_Ob] N2p + O -> Op + N2 + [ion_Op_CO2] Op + CO2 -> O2p + CO ; 9.0e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + [ion_O2p_N2] O2p + N2 -> NOp + NO ; 5.0e-16 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + [ean1] O2 + N2 + e -> O2m + N2 + [ean2] O3 + e -> Om + O2 + [ean3] O2 + e + M -> O2m + M + + [rpe1] O4p + e -> 2*O2 + NOp_CO2 + e -> NO + CO2 ; 1.5e-6 + NOp_H2O + e -> NO + H2O ; 1.5e-6 + NOp_2H2O + e -> NO + 2*H2O ; 2.0e-6 + NOp_3H2O + e -> NO + 3*H2O ; 2.0e-6 + O2p_H2O + e -> O2 + H2O ; 2.0e-6 + H3Op_OH + e -> OH + H + H2O ; 1.5e-6 + [rpe2] Hp_H2O + e -> H + H2O + [rpe3] Hp_2H2O + e -> H + 2*H2O + [rpe4] Hp_3H2O + e -> H + 3*H2O + Hp_4H2O + e -> H + 4*H2O ; 3.6e-6 + Hp_5H2O + e -> H + 5*H2O ; 5.0e-6 + [rpe5] NOp_N2 + e -> NO + N2 + NOp_N2 + CO2 -> NOp_CO2 + N2 ; 1e-9 + NOp_N2 + H2O -> NOp_H2O + N2 ; 1e-9 + + [pir1] O2p + O2 + M -> O4p + M + O2p + H2O + M -> O2p_H2O + M ; 2.8e-28 + O4p + H2O -> O2p_H2O + O2 ; 1.7e-9 + O4p + O2_1D -> O2p + 2*O2 ; 1.5e-10 + O4p + O -> O2p + O3 ; 3.e-10 + O2p_H2O + H2O -> H3Op_OH + O2 ; 9.0e-10 + O2p_H2O + H2O -> Hp_H2O + OH + O2 ; 2.4e-10 + H3Op_OH + H2O -> Hp_2H2O + OH ; 2.0e-9 + [pir2] Hp_H2O + H2O + M -> Hp_2H2O + M + [pir3] Hp_2H2O + M -> Hp_H2O + H2O + M + [pir4] Hp_2H2O + H2O + M -> Hp_3H2O + M + [pir5] Hp_3H2O + M -> Hp_2H2O + H2O + M + [pir6] Hp_3H2O + H2O + M -> Hp_4H2O + M + [pir7] Hp_4H2O + M -> Hp_3H2O + H2O + M + [pir8] Hp_4H2O + H2O + M -> Hp_5H2O + M + [pir9] Hp_5H2O + M -> Hp_4H2O + H2O + M + Hp_4H2O + N2O5 -> Hp_3N1 + HNO3 ; 4.0e-12 + Hp_5H2O + N2O5 -> Hp_4N1 + HNO3 ; 7.0e-12 + Hp_3N1 + H2O -> Hp_4H2O + HNO3 ; 1.0e-9 + Hp_4N1 + H2O -> Hp_5H2O + HNO3 ; 1.0e-9 + [pir10] NOp + H2O + M -> NOp_H2O + M + [pir11] NOp_H2O + H2O + M -> NOp_2H2O + M + NOp_H2O + HO2 -> Hp_H2O + NO3 ; 0.5e-9 + NOp_H2O + OH -> Hp_H2O + NO2 ; 1.e-10 + NOp_H2O + H -> Hp_H2O + NO ; 7.e-12 + [pir12] NOp_2H2O + H2O + M -> NOp_3H2O + M + NOp_3H2O + H2O -> Hp_3H2O + HONO ; 7e-11 + NOp_CO2 + H2O -> NOp_H2O + CO2 ; 1.e-9 + [pir13] NOp + CO2 + M -> NOp_CO2 + M + [pir14] NOp_CO2 + M -> NOp + CO2 + M + [pir15] NOp + N2 + M -> NOp_N2 + M + [pir16] NOp_N2 + M -> NOp + N2 + M + + Om + O -> O2 + e ; 1.9e-10 + [edn1] Om + NO -> NO2 + e + Om + O2_1D -> O3 + e ; 3.e-10 + Om + M -> O + M + e ; 0.5e-12 + Om + H2 -> H2O + e ; 5.8e-10 + O2m + O -> O3 + e ; 1.5e-10 + O2m + O2_1D -> 2*O2 + e ; 2.e-10 + [edn2] O2m + N2 -> N2 + O2 + e + O2m + H -> HO2 + e ; 1.4e-9 + O3m + O -> 2*O2 + e ; 1.e-10 + O3m + O3 -> 3*O2 + e ; 1.e-10 + OHm + O -> HO2 + e ; 2.e-10 + OHm + H -> H2O + e ; 1.4e-9 + Om + O3 -> O3m + O ; 8.0e-10 + Om + O2 + M -> O3m + M ; 2.9e-31 + Om + H2O -> OHm + OH ; 6.0e-13 + Om + NO2 -> NO2m + O ; 1.0e-9 + Om + CO2 + M -> CO3m + M ; 2.0e-28 + Om + H2 -> OHm + H ; 3.2e-11 + Om + HNO3 -> NO3m + OH ; 3.6e-9 + Om + HCL -> CLm + OH ; 2.e-9 + Om + CL -> CLm + O ; 1.e-10 + Om + CLO -> CLm + O2 ; 1.e-10 + O2m + O -> Om + O2 ; 1.5e-10 + O2m + O3 -> O3m + O2 ; 7.8e-10 + O2m + CO2 + M -> CO4m + M ; 9.9e-30 + O2m + NO2 -> NO2m + O2 ; 7.e-10 + O2m + O2 + M -> O4m + M ; 3.4e-31 + O2m + HNO3 -> NO3m + HO2 ; 2.9e-9 + O2m + HCL -> CLm + HO2 ; 1.6e-9 + O2m + CLO -> CLOm + O2 ; 1.e-10 + O2m + CL -> CLm + O2 ; 1.e-10 + O3m + O -> O2m + O2 ; 2.5e-10 + O3m + H -> OHm + O2 ; 8.4e-10 + O3m + CO2 -> CO3m + O2 ; 5.5e-10 + [nir1] O3m + NO -> NO3m + O + [nir2] O3m + NO2 -> NO3m + O2 + [nir3] O3m + NO2 -> NO2m + O + [nir4] O3m + NO -> NO2m + O2 + O4m + O -> O3m + O2 ; 4.e-10 + O4m + CO2 -> CO4m + O2 ; 4.3e-10 + OHm + O3 -> O3m + OH ; 9.e-10 + OHm + NO2 -> NO2m + OH ; 1.1e-9 + OHm + CO2 + M -> HCO3m + M ; 7.6e-28 + OHm + HCL -> CLm + H2O ; 1.e-9 + OHm + CL -> CLm + OH ; 1.e-10 + OHm + CLO -> CLOm + OH ; 1.e-10 + CO3m + O -> O2m + CO2 ; 1.1e-10 + CO3m + O2 -> O3m + CO2 ; 6.0e-15 + CO3m + H -> OHm + CO2 ; 1.7e-10 + [nir5] CO3m + NO -> NO2m + CO2 + [nir6] CO3m + NO2 -> NO3m + CO2 + CO3m + HNO3 -> NO3m + CO2 + OH ; 3.51e-10 + CO3m + CL -> CLm + CO2 + O ; 1.e-10 + CO3m + CL -> CLOm + CO2 ; 1.e-10 + CO3m + CLO -> CLm + CO2 + O2 ; 1.e-11 + CO4m + O3 -> O3m + O2 + CO2 ; 1.3e-10 + CO4m + H -> CO3m + OH ; 2.2e-10 + CO4m + O -> CO3m + O2 ; 1.4e-10 + CO4m + HCL -> CLm + HO2 + CO2 ; 1.2e-9 + CO4m + CL -> CLm + O2 + CO2 ; 1.e-10 + CO4m + CLO -> CLOm + O2 + CO2 ; 1.0e-10 + NO2m + H -> OHm + NO ; 3.e-10 + NO2m + NO2 -> NO3m + NO ; 2.e-13 + NO2m + O3 -> NO3m + O2 ; 1.2e-10 + NO2m + HNO3 -> NO3m + HNO2 ; 1.6e-9 + NO2m + HCL -> CLm + HONO ; 1.4e-9 + NO2m + CL -> CLm + NO2 ; 1.0e-10 + NO2m + CLO -> CLm + NO3 ; 1.0e-10 + NO3m + O -> NO2m + O2 ; 0.5e-11 + NO3m + O3 -> NO2m + 2*O2 ; 1.e-13 + NO3m + HCL -> CLm + HNO3 ; 1.e-12 + CLm + H -> HCL + e ; 9.6e-10 + CLm + NO2 -> NO2m + CL ; 6.0e-12 + CLm + HNO3 -> NO3m + HCL ; 1.6e-9 + CLm + H2O + M -> CLm_H2O + M ; 2.e-29 + CLm + HCL + M -> CLm_HCL + M ; 1.0e-27 + CLOm + NO -> CL + NO2m ; 2.9e-12 + CLOm + NO -> CLm + NO2 ; 2.9e-11 + CLOm + O -> CLm + O2 ; 2.0e-10 + + CLm_H2O + HCL -> CLm_HCL + H2O ; 1.3e-9 + + [usr_CLm_H2O_M] CLm_H2O + M -> CLm + H2O + M + [usr_CLm_HCL_M] CLm_HCL + M -> CLm + HCL + M + + CO3m + H2O + M -> CO3m_H2O + M ; 1.0e-28 + NO3m + H2O + M -> NO3m_H2O + M ; 1.6e-28 + [nir7] NO3m_H2O + M -> NO3m + H2O + M + CO3m_H2O + NO -> NO2m + H2O + CO2 ; 3.5e-12 + CO3m_H2O + NO2 -> NO3m + H2O + CO2 ; 4.0e-11 + [nir8] CO3m_H2O + M -> CO3m + H2O + M + CO3m_H2O + NO2 -> NO3m_H2O + CO2 ; 4.0e-11 + CO3m_H2O + H2O + M -> CO3m2H2O + M ; 1.0e-28 + [nir9]CO3m2H2O + M -> CO3m_H2O + H2O + M + CO3m_H2O + NO -> NO2m_H2O + CO2 ; 3.5e-12 + [nir10] NO2m_H2O + M -> NO2m + H2O + M + NO2m + H2O + M -> NO2m_H2O + M ; 1.6e-28 + NO3m_H2O + H2O + M -> NO3m2H2O + M ; 1.6e-28 + [nir11] NO3m2H2O + M -> NO3m_H2O + H2O + M + NO3m2H2O + N2O5 -> NO3mHNO3 + HNO3 + H2O ; 7.0e-10 + [nir12] NO3mHNO3 + M -> NO3m + HNO3 + M + NO3m + HNO3 + M -> NO3mHNO3 + M ; 1.45e-26 + NO3m_HCL + HNO3 -> NO3mHNO3 + HCL ; 7.6e-10 + [nir13] NO3m + HCL + M -> NO3m_HCL + M + NO3m_H2O + N2O5 -> NO3mHNO3 + HNO3 ; 7.0e-10 + NO3m_H2O + HNO3 -> NO3mHNO3 + H2O ; 1.6e-9 + + [iira1] Hp_4H2O + NO3mHNO3 -> 2*HNO3 + 4*H2O + [iira2] Hp_4H2O + CO3m -> H + 4*H2O + O + CO2 + [iira3] Hp_4H2O + CLm_HCL -> H + 4*H2O + CL + HCL + [iira4] Hp_4H2O + NO3m -> HNO3 + 4*H2O + [iira5] Hp_4H2O + HCO3m -> H + 4*H2O + OH + CO2 + [iira6] Hp_4H2O + O2m -> H + 4*H2O + O2 + [iira7] Hp_4H2O + CO4m -> H + 4*H2O + O2 + CO2 + [iira8] Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 + [iira9] Hp_4H2O + CO3m2H2O -> H + 6*H2O + O + CO2 + [iira10] Hp_4H2O + CLm -> H + 4*H2O + CL + [iira11] Hp_4H2O + CO3m_H2O -> H + 5*H2O + O + CO2 + [iira12] Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 + [iira13] Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL + [iira14] Hp_4H2O + CLm_H2O -> H + 5*H2O + CL + [iira15] Hp_4H2O + NO3m2H2O -> H + 6*H2O + NO3 + [iira16] Hp_4H2O + NO2m -> H + 4*H2O + NO2 + [iira17] Hp_5H2O + NO3mHNO3 -> 2*HNO3 + 5*H2O + [iira18] Hp_5H2O + CO3m -> H + 5*H2O + O + CO2 + [iira19] Hp_5H2O + CLm_HCL -> H + 5*H2O + CL + HCL + [iira20] Hp_5H2O + NO3m -> HNO3 + 5*H2O + [iira21] Hp_5H2O + HCO3m -> H + 5*H2O + OH + CO2 + [iira22] Hp_5H2O + O2m -> H + 5*H2O + O2 + [iira23] Hp_5H2O + CO4m -> H + 5*H2O + O2 + CO2 + [iira24] Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 + [iira25] Hp_5H2O + CO3m2H2O -> H + 7*H2O + O + CO2 + [iira26] Hp_5H2O + CLm -> H + 5*H2O + CL + [iira27] Hp_5H2O + CO3m_H2O -> H + 6*H2O + O + CO2 + [iira28] Hp_5H2O + NO2m_H2O -> H + 6*H2O + NO2 + [iira29] Hp_5H2O + NO3m_HCL -> H + 5*H2O + NO3 + HCL + [iira30] Hp_5H2O + CLm_H2O -> H + 6*H2O + CL + [iira31] Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 + [iira32] Hp_5H2O + NO2m -> H + 5*H2O + NO2 + [iira33] Hp_3H2O + NO3mHNO3 -> 2*HNO3 + 3*H2O + [iira34] Hp_3H2O + CO3m -> H + 3*H2O + O + CO2 + [iira35] Hp_3H2O + CLm_HCL -> H + 3*H2O + CL + HCL + [iira36] Hp_3H2O + NO3m -> HNO3 + 3*H2O + [iira37] Hp_3H2O + HCO3m -> H + 3*H2O + OH + CO2 + [iira38] Hp_3H2O + O2m -> H + 3*H2O + O2 + [iira39] Hp_3H2O + CO4m -> H + 3*H2O + O2 + CO2 + [iira40] Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 + [iira41] Hp_3H2O + CO3m2H2O -> H + 5*H2O + O + CO2 + [iira42] Hp_3H2O + CLm -> H + 3*H2O + CL + [iira43] Hp_3H2O + CO3m_H2O -> H + 4*H2O + O + CO2 + [iira44] Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 + [iira45] Hp_3H2O + NO3m_HCL -> H + 3*H2O + NO3 + HCL + [iira46] Hp_3H2O + CLm_H2O -> H + 4*H2O + CL + [iira47] Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 + [iira48] Hp_3H2O + NO2m -> H + 3*H2O + NO2 + [iira49] NOp_H2O + NO3mHNO3 -> NO + H2O + NO3 + HNO3 + [iira50] NOp_H2O + CO3m -> NO + H2O + O + CO2 + [iira51] NOp_H2O + CLm_HCL -> NO + H2O + CL + HCL + [iira52] NOp_H2O + NO3m -> NO + H2O + NO3 + [iira53] NOp_H2O + HCO3m -> NO + H2O + OH + CO2 + [iira54] NOp_H2O + O2m -> NO + H2O + O2 + [iira55] NOp_H2O + CO4m -> NO + H2O + O2 + CO2 + [iira56] NOp_H2O + NO3m_H2O -> NO + 2*H2O + NO3 + [iira57] NOp_H2O + CO3m2H2O -> NO + 3*H2O + O + CO2 + [iira58] NOp_H2O + CLm -> NO + H2O + CL + [iira59] NOp_H2O + CO3m_H2O -> NO + 2*H2O + O + CO2 + [iira60] NOp_H2O + NO2m_H2O -> NO + 2*H2O + NO2 + [iira61] NOp_H2O + NO3m_HCL -> NO + H2O + NO3 + HCL + [iira62] NOp_H2O + CLm_H2O -> NO + 2*H2O + CL + [iira63] NOp_H2O + NO3m2H2O -> NO + 3*H2O + NO3 + [iira64] NOp_H2O + NO2m -> NO + H2O + NO2 + [iira65] NOp_2H2O + NO3mHNO3 -> NO + 2*H2O + NO3 + HNO3 + [iira66] NOp_2H2O + CO3m -> NO + 2*H2O + O + CO2 + [iira67] NOp_2H2O + CLm_HCL -> NO + 2*H2O + CL + HCL + [iira68] NOp_2H2O + NO3m -> NO + 2*H2O + NO3 + [iira69] NOp_2H2O + HCO3m -> NO + 2*H2O + OH + CO2 + [iira70] NOp_2H2O + O2m -> NO + 2*H2O + O2 + [iira71] NOp_2H2O + CO4m -> NO + 2*H2O + O2 + CO2 + [iira72] NOp_2H2O + NO3m_H2O -> NO + 3*H2O + NO3 + [iira73] NOp_2H2O + CO3m2H2O -> NO + 4*H2O + O + CO2 + [iira74] NOp_2H2O + CLm -> NO + 2*H2O + CL + [iira75] NOp_2H2O + CO3m_H2O -> NO + 3*H2O + O + CO2 + [iira76] NOp_2H2O + NO2m_H2O -> NO + 3*H2O + NO2 + [iira77] NOp_2H2O + NO3m_HCL -> NO + 2*H2O + NO3 + HCL + [iira78] NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL + [iira79] NOp_2H2O + NO3m2H2O -> NO + 4*H2O + NO3 + [iira80] NOp_2H2O + NO2m -> NO + 2*H2O + NO2 + [iira81] NOp + NO3mHNO3 -> NO + NO3 + HNO3 + [iira82] NOp + CO3m -> NO + O + CO2 + [iira83] NOp + CLm_HCL -> NO + CL + HCL + [iira84] NOp + NO3m -> NO + NO3 + [iira85] NOp + HCO3m -> NO + OH + CO2 + [iira86] NOp + O2m -> NO + O2 + [iira87] NOp + CO4m -> NO + O2 + CO2 + [iira88] NOp + NO3m_H2O -> NO + NO3 + H2O + [iira89] NOp + CO3m2H2O -> NO + O + 2*H2O + CO2 + [iira90] NOp + CLm -> NO + CL + [iira91] NOp + CO3m_H2O -> NO + O + H2O + CO2 + [iira92] NOp + NO2m_H2O -> NO + NO2 + H2O + [iira93] NOp + NO3m_HCL -> NO + NO3 + HCL + [iira94] NOp + CLm_H2O -> NO + CL + H2O + [iira95] NOp + NO3m2H2O -> NO + NO3 + 2*H2O + [iira96] NOp + NO2m -> NO + NO2 + [iira97] O2p + NO3mHNO3 -> O2 + NO3 + HNO3 + [iira98] O2p + CO3m -> O2 + O + CO2 + [iira99] O2p + CLm_HCL -> O2 + CL + HCL + [iira100] O2p + NO3m -> O2 + NO3 + [iira101] O2p + HCO3m -> O2 + OH + CO2 + [iira102] O2p + O2m -> 2*O2p + [iira103] O2p + CO4m -> O2 + O2 + CO2 + [iira104] O2p + NO3m_H2O -> O2 + NO3 + H2O + [iira105] O2p + CO3m2H2O -> O2 + O + 2*H2O + CO2 + [iira106] O2p + CLm -> O2 + CL + [iira107] O2p + CO3m_H2O -> O2 + O + H2O + CO2 + [iira108] O2p + NO2m_H2O -> O2 + NO2 + H2O + [iira109] O2p + NO3m_HCL -> O2 + NO3 + HCL + [iira110] O2p + CLm_H2O -> O2 + CL + H2O + [iira111] O2p + NO3m2H2O -> O2 + NO3 + 2*H2O + [iira112] O2p + NO2m -> O2 + NO2 + + [iirb1] Hp_4H2O + CO3m + M -> H + 4*H2O + O + CO2 + M + [iirb2] Hp_4H2O + NO3m + M -> HNO3 + 4*H2O + M + [iirb3] Hp_5H2O + CO3m + M -> H + 5*H2O + O + CO2 + M + [iirb4] Hp_5H2O + NO3m + M -> HNO3 + 5*H2O + M + [iirb5] Hp_4H2O + CLm_HCL + M -> 2*HCL + 4*H2O + M + [iirb6] Hp_5H2O + CLm_HCL + M -> 2*HCL + 5*H2O + M + [iirb7] Hp_4H2O + NO3mHNO3 + M -> 2*HNO3 + 4*H2O + M + [iirb8] Hp_5H2O + NO3mHNO3 + M -> 2*HNO3 + 5*H2O + M + [iirb9] Hp_4H2O + CO3m2H2O + M -> H + 6*H2O + O + CO2 + M + [iirb10] Hp_5H2O + CO3m2H2O + M -> H + 7*H2O + O + CO2 + M + [iirb11] Hp_4H2O + CO3m_H2O + M -> H + 5*H2O + O + CO2 + M + [iirb12] Hp_5H2O + CO3m_H2O + M -> H + 6*H2O + O + CO2 + M + [iirb13] Hp_4H2O + NO3m_H2O + M -> H + 5*H2O + NO3 + M + [iirb14] Hp_5H2O + NO3m_H2O + M -> H + 6*H2O + NO3 + M + End Reactions + + Ext Forcing + NO <-dataset + NO2 <-dataset + CO <-dataset + SO2 <- dataset + DMS <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + Op + O2p + Np + N2p + N2D + O + N + e + OH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 new file mode 100644 index 0000000000..3b4293848e --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 104, & ! number of photolysis reactions + rxntot = 593, & ! number of total reactions + gascnt = 489, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 135, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 1907, & ! number of non-zero matrix entries + extcnt = 23, & ! number of species with external forcing + clscnt1 = 22, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 113, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 480, & + enthalpy_cnt = 41, & + nslvd = 50 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..42ddcd27ca --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 @@ -0,0 +1,596 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jhbr = 34 + integer, parameter :: rid_jbrono2_a = 35 + integer, parameter :: rid_jbrono2_b = 36 + integer, parameter :: rid_jch3cl = 37 + integer, parameter :: rid_jccl4 = 38 + integer, parameter :: rid_jch3ccl3 = 39 + integer, parameter :: rid_jcfcl3 = 40 + integer, parameter :: rid_jcf2cl2 = 41 + integer, parameter :: rid_jcfc113 = 42 + integer, parameter :: rid_jcfc114 = 43 + integer, parameter :: rid_jcfc115 = 44 + integer, parameter :: rid_jhcfc22 = 45 + integer, parameter :: rid_jhcfc141b = 46 + integer, parameter :: rid_jhcfc142b = 47 + integer, parameter :: rid_jch3br = 48 + integer, parameter :: rid_jcf3br = 49 + integer, parameter :: rid_jcf2clbr = 50 + integer, parameter :: rid_jchbr3 = 51 + integer, parameter :: rid_jch2br2 = 52 + integer, parameter :: rid_jh1202 = 53 + integer, parameter :: rid_jh2402 = 54 + integer, parameter :: rid_jcof2 = 55 + integer, parameter :: rid_jcofcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jco2 = 58 + integer, parameter :: rid_jch4_a = 59 + integer, parameter :: rid_jch4_b = 60 + integer, parameter :: rid_jh2so4 = 61 + integer, parameter :: rid_jso2 = 62 + integer, parameter :: rid_jso3 = 63 + integer, parameter :: rid_jocs = 64 + integer, parameter :: rid_jso = 65 + integer, parameter :: rid_jhono = 66 + integer, parameter :: rid_jeuv_1 = 67 + integer, parameter :: rid_jeuv_2 = 68 + integer, parameter :: rid_jeuv_3 = 69 + integer, parameter :: rid_jeuv_4 = 70 + integer, parameter :: rid_jeuv_5 = 71 + integer, parameter :: rid_jeuv_6 = 72 + integer, parameter :: rid_jeuv_7 = 73 + integer, parameter :: rid_jeuv_8 = 74 + integer, parameter :: rid_jeuv_9 = 75 + integer, parameter :: rid_jeuv_10 = 76 + integer, parameter :: rid_jeuv_11 = 77 + integer, parameter :: rid_jeuv_12 = 78 + integer, parameter :: rid_jeuv_13 = 79 + integer, parameter :: rid_jeuv_14 = 80 + integer, parameter :: rid_jeuv_15 = 81 + integer, parameter :: rid_jeuv_16 = 82 + integer, parameter :: rid_jeuv_17 = 83 + integer, parameter :: rid_jeuv_18 = 84 + integer, parameter :: rid_jeuv_19 = 85 + integer, parameter :: rid_jeuv_20 = 86 + integer, parameter :: rid_jeuv_21 = 87 + integer, parameter :: rid_jeuv_22 = 88 + integer, parameter :: rid_jeuv_23 = 89 + integer, parameter :: rid_jeuv_24 = 90 + integer, parameter :: rid_jeuv_25 = 91 + integer, parameter :: rid_jeuv_26 = 92 + integer, parameter :: rid_jppi = 93 + integer, parameter :: rid_jepn1 = 94 + integer, parameter :: rid_jepn2 = 95 + integer, parameter :: rid_jepn3 = 96 + integer, parameter :: rid_jepn4 = 97 + integer, parameter :: rid_jepn6 = 98 + integer, parameter :: rid_jepn7 = 99 + integer, parameter :: rid_jpni1 = 100 + integer, parameter :: rid_jpni2 = 101 + integer, parameter :: rid_jpni3 = 102 + integer, parameter :: rid_jpni4 = 103 + integer, parameter :: rid_jpni5 = 104 + integer, parameter :: rid_usr_O_O2 = 105 + integer, parameter :: rid_O_O3 = 106 + integer, parameter :: rid_usr_O_O = 107 + integer, parameter :: rid_O2_1S_O = 108 + integer, parameter :: rid_O2_1S_O2 = 109 + integer, parameter :: rid_O2_1S_N2 = 110 + integer, parameter :: rid_O2_1S_O3 = 111 + integer, parameter :: rid_O2_1S_CO2 = 112 + integer, parameter :: rid_ag2 = 113 + integer, parameter :: rid_O2_1D_O = 114 + integer, parameter :: rid_O2_1D_O2 = 115 + integer, parameter :: rid_O2_1D_N2 = 116 + integer, parameter :: rid_ag1 = 117 + integer, parameter :: rid_O1D_N2 = 118 + integer, parameter :: rid_O1D_O2 = 119 + integer, parameter :: rid_O1D_O2b = 120 + integer, parameter :: rid_O1D_H2O = 121 + integer, parameter :: rid_O1D_N2Oa = 122 + integer, parameter :: rid_O1D_N2Ob = 123 + integer, parameter :: rid_O1D_O3 = 124 + integer, parameter :: rid_O1D_CFC11 = 125 + integer, parameter :: rid_O1D_CFC12 = 126 + integer, parameter :: rid_O1D_CFC113 = 127 + integer, parameter :: rid_O1D_CFC114 = 128 + integer, parameter :: rid_O1D_CFC115 = 129 + integer, parameter :: rid_O1D_HCFC22 = 130 + integer, parameter :: rid_O1D_HCFC141B = 131 + integer, parameter :: rid_O1D_HCFC142B = 132 + integer, parameter :: rid_O1D_CCL4 = 133 + integer, parameter :: rid_O1D_CH3BR = 134 + integer, parameter :: rid_O1D_CF2CLBR = 135 + integer, parameter :: rid_O1D_CF3BR = 136 + integer, parameter :: rid_O1D_H1202 = 137 + integer, parameter :: rid_O1D_H2402 = 138 + integer, parameter :: rid_O1D_CHBR3 = 139 + integer, parameter :: rid_O1D_CH2BR2 = 140 + integer, parameter :: rid_O1D_COF2 = 141 + integer, parameter :: rid_O1D_COFCL = 142 + integer, parameter :: rid_O1D_CH4a = 143 + integer, parameter :: rid_O1D_CH4b = 144 + integer, parameter :: rid_O1D_CH4c = 145 + integer, parameter :: rid_O1D_H2 = 146 + integer, parameter :: rid_O1D_HCL = 147 + integer, parameter :: rid_O1D_HBR = 148 + integer, parameter :: rid_H_O2 = 149 + integer, parameter :: rid_H_O3 = 150 + integer, parameter :: rid_H_HO2a = 151 + integer, parameter :: rid_H_HO2 = 152 + integer, parameter :: rid_H_HO2b = 153 + integer, parameter :: rid_OH_O = 154 + integer, parameter :: rid_OH_O3 = 155 + integer, parameter :: rid_OH_HO2 = 156 + integer, parameter :: rid_OH_OH = 157 + integer, parameter :: rid_OH_OH_M = 158 + integer, parameter :: rid_OH_H2 = 159 + integer, parameter :: rid_OH_H2O2 = 160 + integer, parameter :: rid_H2_O = 161 + integer, parameter :: rid_HO2_O = 162 + integer, parameter :: rid_HO2_O3 = 163 + integer, parameter :: rid_usr_HO2_HO2 = 164 + integer, parameter :: rid_H2O2_O = 165 + integer, parameter :: rid_HONO1 = 166 + integer, parameter :: rid_HONO2 = 167 + integer, parameter :: rid_N2D_O2 = 168 + integer, parameter :: rid_N2D_O = 169 + integer, parameter :: rid_N_OH = 170 + integer, parameter :: rid_N_O2 = 171 + integer, parameter :: rid_N_NO = 172 + integer, parameter :: rid_N_NO2a = 173 + integer, parameter :: rid_N_NO2b = 174 + integer, parameter :: rid_N_NO2c = 175 + integer, parameter :: rid_NO_O = 176 + integer, parameter :: rid_NO_HO2 = 177 + integer, parameter :: rid_NO_O3 = 178 + integer, parameter :: rid_NO2_O = 179 + integer, parameter :: rid_NO2_O_M = 180 + integer, parameter :: rid_NO2_O3 = 181 + integer, parameter :: rid_tag_NO2_NO3 = 182 + integer, parameter :: rid_usr_N2O5_M = 183 + integer, parameter :: rid_tag_NO2_OH = 184 + integer, parameter :: rid_usr_HNO3_OH = 185 + integer, parameter :: rid_NO3_NO = 186 + integer, parameter :: rid_NO3_O = 187 + integer, parameter :: rid_NO3_OH = 188 + integer, parameter :: rid_NO3_HO2 = 189 + integer, parameter :: rid_tag_NO2_HO2 = 190 + integer, parameter :: rid_HO2NO2_OH = 191 + integer, parameter :: rid_usr_HO2NO2_M = 192 + integer, parameter :: rid_CL_O3 = 193 + integer, parameter :: rid_CL_H2 = 194 + integer, parameter :: rid_CL_H2O2 = 195 + integer, parameter :: rid_CL_HO2a = 196 + integer, parameter :: rid_CL_HO2b = 197 + integer, parameter :: rid_CL_CH2O = 198 + integer, parameter :: rid_CL_CH4 = 199 + integer, parameter :: rid_CLO_O = 200 + integer, parameter :: rid_CLO_OHa = 201 + integer, parameter :: rid_CLO_OHb = 202 + integer, parameter :: rid_CLO_HO2 = 203 + integer, parameter :: rid_CLO_CH3O2 = 204 + integer, parameter :: rid_CLO_NO = 205 + integer, parameter :: rid_CLO_NO2_M = 206 + integer, parameter :: rid_CLO_CLOa = 207 + integer, parameter :: rid_CLO_CLOb = 208 + integer, parameter :: rid_CLO_CLOc = 209 + integer, parameter :: rid_tag_CLO_CLO_M = 210 + integer, parameter :: rid_usr_CL2O2_M = 211 + integer, parameter :: rid_HCL_OH = 212 + integer, parameter :: rid_HCL_O = 213 + integer, parameter :: rid_HOCL_O = 214 + integer, parameter :: rid_HOCL_CL = 215 + integer, parameter :: rid_HOCL_OH = 216 + integer, parameter :: rid_CLONO2_O = 217 + integer, parameter :: rid_CLONO2_OH = 218 + integer, parameter :: rid_CLONO2_CL = 219 + integer, parameter :: rid_BR_O3 = 220 + integer, parameter :: rid_BR_HO2 = 221 + integer, parameter :: rid_BR_CH2O = 222 + integer, parameter :: rid_BRO_O = 223 + integer, parameter :: rid_BRO_OH = 224 + integer, parameter :: rid_BRO_HO2 = 225 + integer, parameter :: rid_BRO_NO = 226 + integer, parameter :: rid_BRO_NO2_M = 227 + integer, parameter :: rid_BRO_CLOa = 228 + integer, parameter :: rid_BRO_CLOb = 229 + integer, parameter :: rid_BRO_CLOc = 230 + integer, parameter :: rid_BRO_BRO = 231 + integer, parameter :: rid_HBR_OH = 232 + integer, parameter :: rid_HBR_O = 233 + integer, parameter :: rid_HOBR_O = 234 + integer, parameter :: rid_BRONO2_O = 235 + integer, parameter :: rid_F_H2O = 236 + integer, parameter :: rid_F_H2 = 237 + integer, parameter :: rid_F_CH4 = 238 + integer, parameter :: rid_F_HNO3 = 239 + integer, parameter :: rid_CH3CL_CL = 240 + integer, parameter :: rid_CH3CL_OH = 241 + integer, parameter :: rid_CH3CCL3_OH = 242 + integer, parameter :: rid_HCFC22_OH = 243 + integer, parameter :: rid_CH3BR_OH = 244 + integer, parameter :: rid_CH3BR_CL = 245 + integer, parameter :: rid_HCFC141B_OH = 246 + integer, parameter :: rid_HCFC142B_OH = 247 + integer, parameter :: rid_CH2BR2_OH = 248 + integer, parameter :: rid_CHBR3_OH = 249 + integer, parameter :: rid_CH2BR2_CL = 250 + integer, parameter :: rid_CHBR3_CL = 251 + integer, parameter :: rid_CH4_OH = 252 + integer, parameter :: rid_usr_CO_OH_b = 253 + integer, parameter :: rid_CO_OH_M = 254 + integer, parameter :: rid_CH2O_NO3 = 255 + integer, parameter :: rid_CH2O_OH = 256 + integer, parameter :: rid_CH2O_O = 257 + integer, parameter :: rid_CH3O2_NO = 258 + integer, parameter :: rid_CH3O2_HO2 = 259 + integer, parameter :: rid_CH3OOH_OH = 260 + integer, parameter :: rid_usr_N2O5_aer = 261 + integer, parameter :: rid_usr_NO3_aer = 262 + integer, parameter :: rid_usr_NO2_aer = 263 + integer, parameter :: rid_usr_HO2_aer = 264 + integer, parameter :: rid_OCS_O = 265 + integer, parameter :: rid_OCS_OH = 266 + integer, parameter :: rid_S_OH = 267 + integer, parameter :: rid_S_O2 = 268 + integer, parameter :: rid_S_O3 = 269 + integer, parameter :: rid_SO_OH = 270 + integer, parameter :: rid_SO_O2 = 271 + integer, parameter :: rid_SO_O3 = 272 + integer, parameter :: rid_SO_NO2 = 273 + integer, parameter :: rid_SO_CLO = 274 + integer, parameter :: rid_SO_BRO = 275 + integer, parameter :: rid_SO_OCLO = 276 + integer, parameter :: rid_usr_SO2_OH = 277 + integer, parameter :: rid_usr_SO3_H2O = 278 + integer, parameter :: rid_usr_DMS_OH = 279 + integer, parameter :: rid_DMS_OHb = 280 + integer, parameter :: rid_DMS_NO3 = 281 + integer, parameter :: rid_het1 = 282 + integer, parameter :: rid_het2 = 283 + integer, parameter :: rid_het3 = 284 + integer, parameter :: rid_het4 = 285 + integer, parameter :: rid_het5 = 286 + integer, parameter :: rid_het6 = 287 + integer, parameter :: rid_het7 = 288 + integer, parameter :: rid_het8 = 289 + integer, parameter :: rid_het9 = 290 + integer, parameter :: rid_het10 = 291 + integer, parameter :: rid_het11 = 292 + integer, parameter :: rid_het12 = 293 + integer, parameter :: rid_het13 = 294 + integer, parameter :: rid_het14 = 295 + integer, parameter :: rid_het15 = 296 + integer, parameter :: rid_het16 = 297 + integer, parameter :: rid_het17 = 298 + integer, parameter :: rid_ion_Op_O2 = 299 + integer, parameter :: rid_ion_Op_N2 = 300 + integer, parameter :: rid_ion_N2p_Oa = 301 + integer, parameter :: rid_ion_N2p_Ob = 302 + integer, parameter :: rid_ion_Op_CO2 = 303 + integer, parameter :: rid_ion_O2p_N = 304 + integer, parameter :: rid_ion_O2p_NO = 305 + integer, parameter :: rid_ion_Np_O2a = 306 + integer, parameter :: rid_ion_Np_O2b = 307 + integer, parameter :: rid_ion_Np_O = 308 + integer, parameter :: rid_ion_N2p_O2 = 309 + integer, parameter :: rid_ion_O2p_N2 = 310 + integer, parameter :: rid_elec1 = 311 + integer, parameter :: rid_elec2 = 312 + integer, parameter :: rid_elec3 = 313 + integer, parameter :: rid_ean1 = 314 + integer, parameter :: rid_ean2 = 315 + integer, parameter :: rid_ean3 = 316 + integer, parameter :: rid_rpe1 = 317 + integer, parameter :: rid_rpe2 = 324 + integer, parameter :: rid_rpe3 = 325 + integer, parameter :: rid_rpe4 = 326 + integer, parameter :: rid_rpe5 = 329 + integer, parameter :: rid_pir1 = 332 + integer, parameter :: rid_pir2 = 340 + integer, parameter :: rid_pir3 = 341 + integer, parameter :: rid_pir4 = 342 + integer, parameter :: rid_pir5 = 343 + integer, parameter :: rid_pir6 = 344 + integer, parameter :: rid_pir7 = 345 + integer, parameter :: rid_pir8 = 346 + integer, parameter :: rid_pir9 = 347 + integer, parameter :: rid_pir10 = 352 + integer, parameter :: rid_pir11 = 353 + integer, parameter :: rid_pir12 = 357 + integer, parameter :: rid_pir13 = 360 + integer, parameter :: rid_pir14 = 361 + integer, parameter :: rid_pir15 = 362 + integer, parameter :: rid_pir16 = 363 + integer, parameter :: rid_edn1 = 365 + integer, parameter :: rid_edn2 = 371 + integer, parameter :: rid_nir1 = 399 + integer, parameter :: rid_nir2 = 400 + integer, parameter :: rid_nir3 = 401 + integer, parameter :: rid_nir4 = 402 + integer, parameter :: rid_nir5 = 414 + integer, parameter :: rid_nir6 = 415 + integer, parameter :: rid_usr_CLm_H2O_M = 445 + integer, parameter :: rid_usr_CLm_HCL_M = 446 + integer, parameter :: rid_nir7 = 449 + integer, parameter :: rid_nir8 = 452 + integer, parameter :: rid_nir9 = 455 + integer, parameter :: rid_nir10 = 457 + integer, parameter :: rid_nir11 = 460 + integer, parameter :: rid_nir12 = 462 + integer, parameter :: rid_nir13 = 465 + integer, parameter :: rid_iira1 = 468 + integer, parameter :: rid_iira2 = 469 + integer, parameter :: rid_iira3 = 470 + integer, parameter :: rid_iira4 = 471 + integer, parameter :: rid_iira5 = 472 + integer, parameter :: rid_iira6 = 473 + integer, parameter :: rid_iira7 = 474 + integer, parameter :: rid_iira8 = 475 + integer, parameter :: rid_iira9 = 476 + integer, parameter :: rid_iira10 = 477 + integer, parameter :: rid_iira11 = 478 + integer, parameter :: rid_iira12 = 479 + integer, parameter :: rid_iira13 = 480 + integer, parameter :: rid_iira14 = 481 + integer, parameter :: rid_iira15 = 482 + integer, parameter :: rid_iira16 = 483 + integer, parameter :: rid_iira17 = 484 + integer, parameter :: rid_iira18 = 485 + integer, parameter :: rid_iira19 = 486 + integer, parameter :: rid_iira20 = 487 + integer, parameter :: rid_iira21 = 488 + integer, parameter :: rid_iira22 = 489 + integer, parameter :: rid_iira23 = 490 + integer, parameter :: rid_iira24 = 491 + integer, parameter :: rid_iira25 = 492 + integer, parameter :: rid_iira26 = 493 + integer, parameter :: rid_iira27 = 494 + integer, parameter :: rid_iira28 = 495 + integer, parameter :: rid_iira29 = 496 + integer, parameter :: rid_iira30 = 497 + integer, parameter :: rid_iira31 = 498 + integer, parameter :: rid_iira32 = 499 + integer, parameter :: rid_iira33 = 500 + integer, parameter :: rid_iira34 = 501 + integer, parameter :: rid_iira35 = 502 + integer, parameter :: rid_iira36 = 503 + integer, parameter :: rid_iira37 = 504 + integer, parameter :: rid_iira38 = 505 + integer, parameter :: rid_iira39 = 506 + integer, parameter :: rid_iira40 = 507 + integer, parameter :: rid_iira41 = 508 + integer, parameter :: rid_iira42 = 509 + integer, parameter :: rid_iira43 = 510 + integer, parameter :: rid_iira44 = 511 + integer, parameter :: rid_iira45 = 512 + integer, parameter :: rid_iira46 = 513 + integer, parameter :: rid_iira47 = 514 + integer, parameter :: rid_iira48 = 515 + integer, parameter :: rid_iira49 = 516 + integer, parameter :: rid_iira50 = 517 + integer, parameter :: rid_iira51 = 518 + integer, parameter :: rid_iira52 = 519 + integer, parameter :: rid_iira53 = 520 + integer, parameter :: rid_iira54 = 521 + integer, parameter :: rid_iira55 = 522 + integer, parameter :: rid_iira56 = 523 + integer, parameter :: rid_iira57 = 524 + integer, parameter :: rid_iira58 = 525 + integer, parameter :: rid_iira59 = 526 + integer, parameter :: rid_iira60 = 527 + integer, parameter :: rid_iira61 = 528 + integer, parameter :: rid_iira62 = 529 + integer, parameter :: rid_iira63 = 530 + integer, parameter :: rid_iira64 = 531 + integer, parameter :: rid_iira65 = 532 + integer, parameter :: rid_iira66 = 533 + integer, parameter :: rid_iira67 = 534 + integer, parameter :: rid_iira68 = 535 + integer, parameter :: rid_iira69 = 536 + integer, parameter :: rid_iira70 = 537 + integer, parameter :: rid_iira71 = 538 + integer, parameter :: rid_iira72 = 539 + integer, parameter :: rid_iira73 = 540 + integer, parameter :: rid_iira74 = 541 + integer, parameter :: rid_iira75 = 542 + integer, parameter :: rid_iira76 = 543 + integer, parameter :: rid_iira77 = 544 + integer, parameter :: rid_iira78 = 545 + integer, parameter :: rid_iira79 = 546 + integer, parameter :: rid_iira80 = 547 + integer, parameter :: rid_iira81 = 548 + integer, parameter :: rid_iira82 = 549 + integer, parameter :: rid_iira83 = 550 + integer, parameter :: rid_iira84 = 551 + integer, parameter :: rid_iira85 = 552 + integer, parameter :: rid_iira86 = 553 + integer, parameter :: rid_iira87 = 554 + integer, parameter :: rid_iira88 = 555 + integer, parameter :: rid_iira89 = 556 + integer, parameter :: rid_iira90 = 557 + integer, parameter :: rid_iira91 = 558 + integer, parameter :: rid_iira92 = 559 + integer, parameter :: rid_iira93 = 560 + integer, parameter :: rid_iira94 = 561 + integer, parameter :: rid_iira95 = 562 + integer, parameter :: rid_iira96 = 563 + integer, parameter :: rid_iira97 = 564 + integer, parameter :: rid_iira98 = 565 + integer, parameter :: rid_iira99 = 566 + integer, parameter :: rid_iira100 = 567 + integer, parameter :: rid_iira101 = 568 + integer, parameter :: rid_iira102 = 569 + integer, parameter :: rid_iira103 = 570 + integer, parameter :: rid_iira104 = 571 + integer, parameter :: rid_iira105 = 572 + integer, parameter :: rid_iira106 = 573 + integer, parameter :: rid_iira107 = 574 + integer, parameter :: rid_iira108 = 575 + integer, parameter :: rid_iira109 = 576 + integer, parameter :: rid_iira110 = 577 + integer, parameter :: rid_iira111 = 578 + integer, parameter :: rid_iira112 = 579 + integer, parameter :: rid_iirb1 = 580 + integer, parameter :: rid_iirb2 = 581 + integer, parameter :: rid_iirb3 = 582 + integer, parameter :: rid_iirb4 = 583 + integer, parameter :: rid_iirb5 = 584 + integer, parameter :: rid_iirb6 = 585 + integer, parameter :: rid_iirb7 = 586 + integer, parameter :: rid_iirb8 = 587 + integer, parameter :: rid_iirb9 = 588 + integer, parameter :: rid_iirb10 = 589 + integer, parameter :: rid_iirb11 = 590 + integer, parameter :: rid_iirb12 = 591 + integer, parameter :: rid_iirb13 = 592 + integer, parameter :: rid_iirb14 = 593 + integer, parameter :: rid_r0318 = 318 + integer, parameter :: rid_r0319 = 319 + integer, parameter :: rid_r0320 = 320 + integer, parameter :: rid_r0321 = 321 + integer, parameter :: rid_r0322 = 322 + integer, parameter :: rid_r0323 = 323 + integer, parameter :: rid_r0327 = 327 + integer, parameter :: rid_r0328 = 328 + integer, parameter :: rid_r0330 = 330 + integer, parameter :: rid_r0331 = 331 + integer, parameter :: rid_r0333 = 333 + integer, parameter :: rid_r0334 = 334 + integer, parameter :: rid_r0335 = 335 + integer, parameter :: rid_r0336 = 336 + integer, parameter :: rid_r0337 = 337 + integer, parameter :: rid_r0338 = 338 + integer, parameter :: rid_r0339 = 339 + integer, parameter :: rid_r0348 = 348 + integer, parameter :: rid_r0349 = 349 + integer, parameter :: rid_r0350 = 350 + integer, parameter :: rid_r0351 = 351 + integer, parameter :: rid_r0354 = 354 + integer, parameter :: rid_r0355 = 355 + integer, parameter :: rid_r0356 = 356 + integer, parameter :: rid_r0358 = 358 + integer, parameter :: rid_r0359 = 359 + integer, parameter :: rid_r0364 = 364 + integer, parameter :: rid_r0366 = 366 + integer, parameter :: rid_r0367 = 367 + integer, parameter :: rid_r0368 = 368 + integer, parameter :: rid_r0369 = 369 + integer, parameter :: rid_r0370 = 370 + integer, parameter :: rid_r0372 = 372 + integer, parameter :: rid_r0373 = 373 + integer, parameter :: rid_r0374 = 374 + integer, parameter :: rid_r0375 = 375 + integer, parameter :: rid_r0376 = 376 + integer, parameter :: rid_r0377 = 377 + integer, parameter :: rid_r0378 = 378 + integer, parameter :: rid_r0379 = 379 + integer, parameter :: rid_r0380 = 380 + integer, parameter :: rid_r0381 = 381 + integer, parameter :: rid_r0382 = 382 + integer, parameter :: rid_r0383 = 383 + integer, parameter :: rid_r0384 = 384 + integer, parameter :: rid_r0385 = 385 + integer, parameter :: rid_r0386 = 386 + integer, parameter :: rid_r0387 = 387 + integer, parameter :: rid_r0388 = 388 + integer, parameter :: rid_r0389 = 389 + integer, parameter :: rid_r0390 = 390 + integer, parameter :: rid_r0391 = 391 + integer, parameter :: rid_r0392 = 392 + integer, parameter :: rid_r0393 = 393 + integer, parameter :: rid_r0394 = 394 + integer, parameter :: rid_r0395 = 395 + integer, parameter :: rid_r0396 = 396 + integer, parameter :: rid_r0397 = 397 + integer, parameter :: rid_r0398 = 398 + integer, parameter :: rid_r0403 = 403 + integer, parameter :: rid_r0404 = 404 + integer, parameter :: rid_r0405 = 405 + integer, parameter :: rid_r0406 = 406 + integer, parameter :: rid_r0407 = 407 + integer, parameter :: rid_r0408 = 408 + integer, parameter :: rid_r0409 = 409 + integer, parameter :: rid_r0410 = 410 + integer, parameter :: rid_r0411 = 411 + integer, parameter :: rid_r0412 = 412 + integer, parameter :: rid_r0413 = 413 + integer, parameter :: rid_r0416 = 416 + integer, parameter :: rid_r0417 = 417 + integer, parameter :: rid_r0418 = 418 + integer, parameter :: rid_r0419 = 419 + integer, parameter :: rid_r0420 = 420 + integer, parameter :: rid_r0421 = 421 + integer, parameter :: rid_r0422 = 422 + integer, parameter :: rid_r0423 = 423 + integer, parameter :: rid_r0424 = 424 + integer, parameter :: rid_r0425 = 425 + integer, parameter :: rid_r0426 = 426 + integer, parameter :: rid_r0427 = 427 + integer, parameter :: rid_r0428 = 428 + integer, parameter :: rid_r0429 = 429 + integer, parameter :: rid_r0430 = 430 + integer, parameter :: rid_r0431 = 431 + integer, parameter :: rid_r0432 = 432 + integer, parameter :: rid_r0433 = 433 + integer, parameter :: rid_r0434 = 434 + integer, parameter :: rid_r0435 = 435 + integer, parameter :: rid_r0436 = 436 + integer, parameter :: rid_r0437 = 437 + integer, parameter :: rid_r0438 = 438 + integer, parameter :: rid_r0439 = 439 + integer, parameter :: rid_r0440 = 440 + integer, parameter :: rid_r0441 = 441 + integer, parameter :: rid_r0442 = 442 + integer, parameter :: rid_r0443 = 443 + integer, parameter :: rid_r0444 = 444 + integer, parameter :: rid_r0447 = 447 + integer, parameter :: rid_r0448 = 448 + integer, parameter :: rid_r0450 = 450 + integer, parameter :: rid_r0451 = 451 + integer, parameter :: rid_r0453 = 453 + integer, parameter :: rid_r0454 = 454 + integer, parameter :: rid_r0456 = 456 + integer, parameter :: rid_r0458 = 458 + integer, parameter :: rid_r0459 = 459 + integer, parameter :: rid_r0461 = 461 + integer, parameter :: rid_r0463 = 463 + integer, parameter :: rid_r0464 = 464 + integer, parameter :: rid_r0466 = 466 + integer, parameter :: rid_r0467 = 467 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..14c36440aa --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 @@ -0,0 +1,138 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O2 = 3 + integer, parameter :: id_N2O = 4 + integer, parameter :: id_N = 5 + integer, parameter :: id_NO = 6 + integer, parameter :: id_NO2 = 7 + integer, parameter :: id_NO3 = 8 + integer, parameter :: id_HNO3 = 9 + integer, parameter :: id_HO2NO2 = 10 + integer, parameter :: id_N2O5 = 11 + integer, parameter :: id_CH4 = 12 + integer, parameter :: id_CH3O2 = 13 + integer, parameter :: id_CH3OOH = 14 + integer, parameter :: id_CH2O = 15 + integer, parameter :: id_CO = 16 + integer, parameter :: id_H2 = 17 + integer, parameter :: id_H = 18 + integer, parameter :: id_H2O2 = 19 + integer, parameter :: id_HONO = 20 + integer, parameter :: id_CLY = 21 + integer, parameter :: id_BRY = 22 + integer, parameter :: id_CL2 = 23 + integer, parameter :: id_CLO = 24 + integer, parameter :: id_OCLO = 25 + integer, parameter :: id_CL2O2 = 26 + integer, parameter :: id_HCL = 27 + integer, parameter :: id_HOCL = 28 + integer, parameter :: id_CLONO2 = 29 + integer, parameter :: id_BRCL = 30 + integer, parameter :: id_BRO = 31 + integer, parameter :: id_HBR = 32 + integer, parameter :: id_HOBR = 33 + integer, parameter :: id_BRONO2 = 34 + integer, parameter :: id_CH3CL = 35 + integer, parameter :: id_CH3BR = 36 + integer, parameter :: id_CFC11 = 37 + integer, parameter :: id_CFC12 = 38 + integer, parameter :: id_CFC113 = 39 + integer, parameter :: id_HCFC22 = 40 + integer, parameter :: id_CCL4 = 41 + integer, parameter :: id_CH3CCL3 = 42 + integer, parameter :: id_CF3BR = 43 + integer, parameter :: id_CF2CLBR = 44 + integer, parameter :: id_HCFC141B = 45 + integer, parameter :: id_HCFC142B = 46 + integer, parameter :: id_CFC114 = 47 + integer, parameter :: id_CFC115 = 48 + integer, parameter :: id_H1202 = 49 + integer, parameter :: id_H2402 = 50 + integer, parameter :: id_CHBR3 = 51 + integer, parameter :: id_CH2BR2 = 52 + integer, parameter :: id_COF2 = 53 + integer, parameter :: id_COFCL = 54 + integer, parameter :: id_HF = 55 + integer, parameter :: id_F = 56 + integer, parameter :: id_CO2 = 57 + integer, parameter :: id_OCS = 58 + integer, parameter :: id_S = 59 + integer, parameter :: id_SO = 60 + integer, parameter :: id_SO2 = 61 + integer, parameter :: id_SO3 = 62 + integer, parameter :: id_H2SO4 = 63 + integer, parameter :: id_DMS = 64 + integer, parameter :: id_SOAG = 65 + integer, parameter :: id_so4_a1 = 66 + integer, parameter :: id_pom_a1 = 67 + integer, parameter :: id_soa_a1 = 68 + integer, parameter :: id_bc_a1 = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_ncl_a1 = 71 + integer, parameter :: id_num_a1 = 72 + integer, parameter :: id_so4_a2 = 73 + integer, parameter :: id_soa_a2 = 74 + integer, parameter :: id_ncl_a2 = 75 + integer, parameter :: id_num_a2 = 76 + integer, parameter :: id_dst_a2 = 77 + integer, parameter :: id_dst_a3 = 78 + integer, parameter :: id_ncl_a3 = 79 + integer, parameter :: id_so4_a3 = 80 + integer, parameter :: id_num_a3 = 81 + integer, parameter :: id_pom_a4 = 82 + integer, parameter :: id_bc_a4 = 83 + integer, parameter :: id_num_a4 = 84 + integer, parameter :: id_CL = 85 + integer, parameter :: id_BR = 86 + integer, parameter :: id_OH = 87 + integer, parameter :: id_HO2 = 88 + integer, parameter :: id_N2p = 89 + integer, parameter :: id_O2p = 90 + integer, parameter :: id_O4p = 91 + integer, parameter :: id_O2p_H2O = 92 + integer, parameter :: id_Hp_H2O = 93 + integer, parameter :: id_Hp_2H2O = 94 + integer, parameter :: id_Hp_3H2O = 95 + integer, parameter :: id_Hp_4H2O = 96 + integer, parameter :: id_Hp_5H2O = 97 + integer, parameter :: id_H3Op_OH = 98 + integer, parameter :: id_Hp_3N1 = 99 + integer, parameter :: id_Hp_4N1 = 100 + integer, parameter :: id_NOp_H2O = 101 + integer, parameter :: id_NOp_2H2O = 102 + integer, parameter :: id_NOp_3H2O = 103 + integer, parameter :: id_NOp_CO2 = 104 + integer, parameter :: id_NOp_N2 = 105 + integer, parameter :: id_Om = 106 + integer, parameter :: id_O2m = 107 + integer, parameter :: id_O3m = 108 + integer, parameter :: id_O4m = 109 + integer, parameter :: id_OHm = 110 + integer, parameter :: id_CO3m = 111 + integer, parameter :: id_CO4m = 112 + integer, parameter :: id_NO2m = 113 + integer, parameter :: id_NO3m = 114 + integer, parameter :: id_CO3m_H2O = 115 + integer, parameter :: id_CO3m2H2O = 116 + integer, parameter :: id_NO2m_H2O = 117 + integer, parameter :: id_NO3m_H2O = 118 + integer, parameter :: id_NO3m2H2O = 119 + integer, parameter :: id_NO3mHNO3 = 120 + integer, parameter :: id_NO3m_HCL = 121 + integer, parameter :: id_HCO3m = 122 + integer, parameter :: id_CLm = 123 + integer, parameter :: id_CLOm = 124 + integer, parameter :: id_CLm_H2O = 125 + integer, parameter :: id_CLm_HCL = 126 + integer, parameter :: id_Np = 127 + integer, parameter :: id_Op = 128 + integer, parameter :: id_NOp = 129 + integer, parameter :: id_e = 130 + integer, parameter :: id_N2D = 131 + integer, parameter :: id_O2_1S = 132 + integer, parameter :: id_O2_1D = 133 + integer, parameter :: id_O1D = 134 + integer, parameter :: id_H2O = 135 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..954b2ff0e6 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 @@ -0,0 +1,545 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:,105) = rate(:,:,105) * inv(:,:, 1) + rate(:,:,107) = rate(:,:,107) * inv(:,:, 1) + rate(:,:,110) = rate(:,:,110) * inv(:,:, 2) + rate(:,:,116) = rate(:,:,116) * inv(:,:, 2) + rate(:,:,118) = rate(:,:,118) * inv(:,:, 2) + rate(:,:,149) = rate(:,:,149) * inv(:,:, 1) + rate(:,:,158) = rate(:,:,158) * inv(:,:, 1) + rate(:,:,166) = rate(:,:,166) * inv(:,:, 1) + rate(:,:,176) = rate(:,:,176) * inv(:,:, 1) + rate(:,:,180) = rate(:,:,180) * inv(:,:, 1) + rate(:,:,182) = rate(:,:,182) * inv(:,:, 1) + rate(:,:,183) = rate(:,:,183) * inv(:,:, 1) + rate(:,:,184) = rate(:,:,184) * inv(:,:, 1) + rate(:,:,190) = rate(:,:,190) * inv(:,:, 1) + rate(:,:,192) = rate(:,:,192) * inv(:,:, 1) + rate(:,:,206) = rate(:,:,206) * inv(:,:, 1) + rate(:,:,210) = rate(:,:,210) * inv(:,:, 1) + rate(:,:,211) = rate(:,:,211) * inv(:,:, 1) + rate(:,:,227) = rate(:,:,227) * inv(:,:, 1) + rate(:,:,254) = rate(:,:,254) * inv(:,:, 1) + rate(:,:,300) = rate(:,:,300) * inv(:,:, 2) + rate(:,:,310) = rate(:,:,310) * inv(:,:, 2) + rate(:,:,314) = rate(:,:,314) * inv(:,:, 2) + rate(:,:,316) = rate(:,:,316) * inv(:,:, 1) + rate(:,:,332) = rate(:,:,332) * inv(:,:, 1) + rate(:,:,333) = rate(:,:,333) * inv(:,:, 1) + rate(:,:,340) = rate(:,:,340) * inv(:,:, 1) + rate(:,:,341) = rate(:,:,341) * inv(:,:, 1) + rate(:,:,342) = rate(:,:,342) * inv(:,:, 1) + rate(:,:,343) = rate(:,:,343) * inv(:,:, 1) + rate(:,:,344) = rate(:,:,344) * inv(:,:, 1) + rate(:,:,345) = rate(:,:,345) * inv(:,:, 1) + rate(:,:,346) = rate(:,:,346) * inv(:,:, 1) + rate(:,:,347) = rate(:,:,347) * inv(:,:, 1) + rate(:,:,352) = rate(:,:,352) * inv(:,:, 1) + rate(:,:,353) = rate(:,:,353) * inv(:,:, 1) + rate(:,:,357) = rate(:,:,357) * inv(:,:, 1) + rate(:,:,360) = rate(:,:,360) * inv(:,:, 1) + rate(:,:,361) = rate(:,:,361) * inv(:,:, 1) + rate(:,:,363) = rate(:,:,363) * inv(:,:, 1) + rate(:,:,367) = rate(:,:,367) * inv(:,:, 1) + rate(:,:,371) = rate(:,:,371) * inv(:,:, 2) + rate(:,:,378) = rate(:,:,378) * inv(:,:, 1) + rate(:,:,381) = rate(:,:,381) * inv(:,:, 1) + rate(:,:,389) = rate(:,:,389) * inv(:,:, 1) + rate(:,:,391) = rate(:,:,391) * inv(:,:, 1) + rate(:,:,407) = rate(:,:,407) * inv(:,:, 1) + rate(:,:,439) = rate(:,:,439) * inv(:,:, 1) + rate(:,:,440) = rate(:,:,440) * inv(:,:, 1) + rate(:,:,445) = rate(:,:,445) * inv(:,:, 1) + rate(:,:,446) = rate(:,:,446) * inv(:,:, 1) + rate(:,:,447) = rate(:,:,447) * inv(:,:, 1) + rate(:,:,448) = rate(:,:,448) * inv(:,:, 1) + rate(:,:,449) = rate(:,:,449) * inv(:,:, 1) + rate(:,:,452) = rate(:,:,452) * inv(:,:, 1) + rate(:,:,454) = rate(:,:,454) * inv(:,:, 1) + rate(:,:,455) = rate(:,:,455) * inv(:,:, 1) + rate(:,:,457) = rate(:,:,457) * inv(:,:, 1) + rate(:,:,458) = rate(:,:,458) * inv(:,:, 1) + rate(:,:,459) = rate(:,:,459) * inv(:,:, 1) + rate(:,:,460) = rate(:,:,460) * inv(:,:, 1) + rate(:,:,462) = rate(:,:,462) * inv(:,:, 1) + rate(:,:,463) = rate(:,:,463) * inv(:,:, 1) + rate(:,:,465) = rate(:,:,465) * inv(:,:, 1) + rate(:,:,580) = rate(:,:,580) * inv(:,:, 1) + rate(:,:,581) = rate(:,:,581) * inv(:,:, 1) + rate(:,:,582) = rate(:,:,582) * inv(:,:, 1) + rate(:,:,583) = rate(:,:,583) * inv(:,:, 1) + rate(:,:,584) = rate(:,:,584) * inv(:,:, 1) + rate(:,:,585) = rate(:,:,585) * inv(:,:, 1) + rate(:,:,586) = rate(:,:,586) * inv(:,:, 1) + rate(:,:,587) = rate(:,:,587) * inv(:,:, 1) + rate(:,:,588) = rate(:,:,588) * inv(:,:, 1) + rate(:,:,589) = rate(:,:,589) * inv(:,:, 1) + rate(:,:,590) = rate(:,:,590) * inv(:,:, 1) + rate(:,:,591) = rate(:,:,591) * inv(:,:, 1) + rate(:,:,592) = rate(:,:,592) * inv(:,:, 1) + rate(:,:,593) = rate(:,:,593) * inv(:,:, 1) + rate(:,:,362) = rate(:,:,362) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:,105) = rate(:,:,105) * m(:,:) + rate(:,:,106) = rate(:,:,106) * m(:,:) + rate(:,:,107) = rate(:,:,107) * m(:,:) + rate(:,:,108) = rate(:,:,108) * m(:,:) + rate(:,:,109) = rate(:,:,109) * m(:,:) + rate(:,:,111) = rate(:,:,111) * m(:,:) + rate(:,:,112) = rate(:,:,112) * m(:,:) + rate(:,:,114) = rate(:,:,114) * m(:,:) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,123) = rate(:,:,123) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,126) = rate(:,:,126) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,269) = rate(:,:,269) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,274) = rate(:,:,274) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,277) = rate(:,:,277) * m(:,:) + rate(:,:,278) = rate(:,:,278) * m(:,:) + rate(:,:,279) = rate(:,:,279) * m(:,:) + rate(:,:,280) = rate(:,:,280) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,285) = rate(:,:,285) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + rate(:,:,299) = rate(:,:,299) * m(:,:) + rate(:,:,301) = rate(:,:,301) * m(:,:) + rate(:,:,302) = rate(:,:,302) * m(:,:) + rate(:,:,303) = rate(:,:,303) * m(:,:) + rate(:,:,304) = rate(:,:,304) * m(:,:) + rate(:,:,305) = rate(:,:,305) * m(:,:) + rate(:,:,306) = rate(:,:,306) * m(:,:) + rate(:,:,307) = rate(:,:,307) * m(:,:) + rate(:,:,308) = rate(:,:,308) * m(:,:) + rate(:,:,309) = rate(:,:,309) * m(:,:) + rate(:,:,311) = rate(:,:,311) * m(:,:) + rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:,313) = rate(:,:,313) * m(:,:) + rate(:,:,314) = rate(:,:,314) * m(:,:) + rate(:,:,315) = rate(:,:,315) * m(:,:) + rate(:,:,316) = rate(:,:,316) * m(:,:) + rate(:,:,317) = rate(:,:,317) * m(:,:) + rate(:,:,318) = rate(:,:,318) * m(:,:) + rate(:,:,319) = rate(:,:,319) * m(:,:) + rate(:,:,320) = rate(:,:,320) * m(:,:) + rate(:,:,321) = rate(:,:,321) * m(:,:) + rate(:,:,322) = rate(:,:,322) * m(:,:) + rate(:,:,323) = rate(:,:,323) * m(:,:) + rate(:,:,324) = rate(:,:,324) * m(:,:) + rate(:,:,325) = rate(:,:,325) * m(:,:) + rate(:,:,326) = rate(:,:,326) * m(:,:) + rate(:,:,327) = rate(:,:,327) * m(:,:) + rate(:,:,328) = rate(:,:,328) * m(:,:) + rate(:,:,329) = rate(:,:,329) * m(:,:) + rate(:,:,330) = rate(:,:,330) * m(:,:) + rate(:,:,331) = rate(:,:,331) * m(:,:) + rate(:,:,332) = rate(:,:,332) * m(:,:) + rate(:,:,333) = rate(:,:,333) * m(:,:) + rate(:,:,334) = rate(:,:,334) * m(:,:) + rate(:,:,335) = rate(:,:,335) * m(:,:) + rate(:,:,336) = rate(:,:,336) * m(:,:) + rate(:,:,337) = rate(:,:,337) * m(:,:) + rate(:,:,338) = rate(:,:,338) * m(:,:) + rate(:,:,339) = rate(:,:,339) * m(:,:) + rate(:,:,340) = rate(:,:,340) * m(:,:) + rate(:,:,342) = rate(:,:,342) * m(:,:) + rate(:,:,344) = rate(:,:,344) * m(:,:) + rate(:,:,346) = rate(:,:,346) * m(:,:) + rate(:,:,348) = rate(:,:,348) * m(:,:) + rate(:,:,349) = rate(:,:,349) * m(:,:) + rate(:,:,350) = rate(:,:,350) * m(:,:) + rate(:,:,351) = rate(:,:,351) * m(:,:) + rate(:,:,352) = rate(:,:,352) * m(:,:) + rate(:,:,353) = rate(:,:,353) * m(:,:) + rate(:,:,354) = rate(:,:,354) * m(:,:) + rate(:,:,355) = rate(:,:,355) * m(:,:) + rate(:,:,356) = rate(:,:,356) * m(:,:) + rate(:,:,357) = rate(:,:,357) * m(:,:) + rate(:,:,358) = rate(:,:,358) * m(:,:) + rate(:,:,359) = rate(:,:,359) * m(:,:) + rate(:,:,360) = rate(:,:,360) * m(:,:) + rate(:,:,364) = rate(:,:,364) * m(:,:) + rate(:,:,365) = rate(:,:,365) * m(:,:) + rate(:,:,366) = rate(:,:,366) * m(:,:) + rate(:,:,368) = rate(:,:,368) * m(:,:) + rate(:,:,369) = rate(:,:,369) * m(:,:) + rate(:,:,370) = rate(:,:,370) * m(:,:) + rate(:,:,372) = rate(:,:,372) * m(:,:) + rate(:,:,373) = rate(:,:,373) * m(:,:) + rate(:,:,374) = rate(:,:,374) * m(:,:) + rate(:,:,375) = rate(:,:,375) * m(:,:) + rate(:,:,376) = rate(:,:,376) * m(:,:) + rate(:,:,377) = rate(:,:,377) * m(:,:) + rate(:,:,378) = rate(:,:,378) * m(:,:) + rate(:,:,379) = rate(:,:,379) * m(:,:) + rate(:,:,380) = rate(:,:,380) * m(:,:) + rate(:,:,381) = rate(:,:,381) * m(:,:) + rate(:,:,382) = rate(:,:,382) * m(:,:) + rate(:,:,383) = rate(:,:,383) * m(:,:) + rate(:,:,384) = rate(:,:,384) * m(:,:) + rate(:,:,385) = rate(:,:,385) * m(:,:) + rate(:,:,386) = rate(:,:,386) * m(:,:) + rate(:,:,387) = rate(:,:,387) * m(:,:) + rate(:,:,388) = rate(:,:,388) * m(:,:) + rate(:,:,389) = rate(:,:,389) * m(:,:) + rate(:,:,390) = rate(:,:,390) * m(:,:) + rate(:,:,391) = rate(:,:,391) * m(:,:) + rate(:,:,392) = rate(:,:,392) * m(:,:) + rate(:,:,393) = rate(:,:,393) * m(:,:) + rate(:,:,394) = rate(:,:,394) * m(:,:) + rate(:,:,395) = rate(:,:,395) * m(:,:) + rate(:,:,396) = rate(:,:,396) * m(:,:) + rate(:,:,397) = rate(:,:,397) * m(:,:) + rate(:,:,398) = rate(:,:,398) * m(:,:) + rate(:,:,399) = rate(:,:,399) * m(:,:) + rate(:,:,400) = rate(:,:,400) * m(:,:) + rate(:,:,401) = rate(:,:,401) * m(:,:) + rate(:,:,402) = rate(:,:,402) * m(:,:) + rate(:,:,403) = rate(:,:,403) * m(:,:) + rate(:,:,404) = rate(:,:,404) * m(:,:) + rate(:,:,405) = rate(:,:,405) * m(:,:) + rate(:,:,406) = rate(:,:,406) * m(:,:) + rate(:,:,407) = rate(:,:,407) * m(:,:) + rate(:,:,408) = rate(:,:,408) * m(:,:) + rate(:,:,409) = rate(:,:,409) * m(:,:) + rate(:,:,410) = rate(:,:,410) * m(:,:) + rate(:,:,411) = rate(:,:,411) * m(:,:) + rate(:,:,412) = rate(:,:,412) * m(:,:) + rate(:,:,413) = rate(:,:,413) * m(:,:) + rate(:,:,414) = rate(:,:,414) * m(:,:) + rate(:,:,415) = rate(:,:,415) * m(:,:) + rate(:,:,416) = rate(:,:,416) * m(:,:) + rate(:,:,417) = rate(:,:,417) * m(:,:) + rate(:,:,418) = rate(:,:,418) * m(:,:) + rate(:,:,419) = rate(:,:,419) * m(:,:) + rate(:,:,420) = rate(:,:,420) * m(:,:) + rate(:,:,421) = rate(:,:,421) * m(:,:) + rate(:,:,422) = rate(:,:,422) * m(:,:) + rate(:,:,423) = rate(:,:,423) * m(:,:) + rate(:,:,424) = rate(:,:,424) * m(:,:) + rate(:,:,425) = rate(:,:,425) * m(:,:) + rate(:,:,426) = rate(:,:,426) * m(:,:) + rate(:,:,427) = rate(:,:,427) * m(:,:) + rate(:,:,428) = rate(:,:,428) * m(:,:) + rate(:,:,429) = rate(:,:,429) * m(:,:) + rate(:,:,430) = rate(:,:,430) * m(:,:) + rate(:,:,431) = rate(:,:,431) * m(:,:) + rate(:,:,432) = rate(:,:,432) * m(:,:) + rate(:,:,433) = rate(:,:,433) * m(:,:) + rate(:,:,434) = rate(:,:,434) * m(:,:) + rate(:,:,435) = rate(:,:,435) * m(:,:) + rate(:,:,436) = rate(:,:,436) * m(:,:) + rate(:,:,437) = rate(:,:,437) * m(:,:) + rate(:,:,438) = rate(:,:,438) * m(:,:) + rate(:,:,439) = rate(:,:,439) * m(:,:) + rate(:,:,440) = rate(:,:,440) * m(:,:) + rate(:,:,441) = rate(:,:,441) * m(:,:) + rate(:,:,442) = rate(:,:,442) * m(:,:) + rate(:,:,443) = rate(:,:,443) * m(:,:) + rate(:,:,444) = rate(:,:,444) * m(:,:) + rate(:,:,447) = rate(:,:,447) * m(:,:) + rate(:,:,448) = rate(:,:,448) * m(:,:) + rate(:,:,450) = rate(:,:,450) * m(:,:) + rate(:,:,451) = rate(:,:,451) * m(:,:) + rate(:,:,453) = rate(:,:,453) * m(:,:) + rate(:,:,454) = rate(:,:,454) * m(:,:) + rate(:,:,456) = rate(:,:,456) * m(:,:) + rate(:,:,458) = rate(:,:,458) * m(:,:) + rate(:,:,459) = rate(:,:,459) * m(:,:) + rate(:,:,461) = rate(:,:,461) * m(:,:) + rate(:,:,463) = rate(:,:,463) * m(:,:) + rate(:,:,464) = rate(:,:,464) * m(:,:) + rate(:,:,465) = rate(:,:,465) * m(:,:) + rate(:,:,466) = rate(:,:,466) * m(:,:) + rate(:,:,467) = rate(:,:,467) * m(:,:) + rate(:,:,468) = rate(:,:,468) * m(:,:) + rate(:,:,469) = rate(:,:,469) * m(:,:) + rate(:,:,470) = rate(:,:,470) * m(:,:) + rate(:,:,471) = rate(:,:,471) * m(:,:) + rate(:,:,472) = rate(:,:,472) * m(:,:) + rate(:,:,473) = rate(:,:,473) * m(:,:) + rate(:,:,474) = rate(:,:,474) * m(:,:) + rate(:,:,475) = rate(:,:,475) * m(:,:) + rate(:,:,476) = rate(:,:,476) * m(:,:) + rate(:,:,477) = rate(:,:,477) * m(:,:) + rate(:,:,478) = rate(:,:,478) * m(:,:) + rate(:,:,479) = rate(:,:,479) * m(:,:) + rate(:,:,480) = rate(:,:,480) * m(:,:) + rate(:,:,481) = rate(:,:,481) * m(:,:) + rate(:,:,482) = rate(:,:,482) * m(:,:) + rate(:,:,483) = rate(:,:,483) * m(:,:) + rate(:,:,484) = rate(:,:,484) * m(:,:) + rate(:,:,485) = rate(:,:,485) * m(:,:) + rate(:,:,486) = rate(:,:,486) * m(:,:) + rate(:,:,487) = rate(:,:,487) * m(:,:) + rate(:,:,488) = rate(:,:,488) * m(:,:) + rate(:,:,489) = rate(:,:,489) * m(:,:) + rate(:,:,490) = rate(:,:,490) * m(:,:) + rate(:,:,491) = rate(:,:,491) * m(:,:) + rate(:,:,492) = rate(:,:,492) * m(:,:) + rate(:,:,493) = rate(:,:,493) * m(:,:) + rate(:,:,494) = rate(:,:,494) * m(:,:) + rate(:,:,495) = rate(:,:,495) * m(:,:) + rate(:,:,496) = rate(:,:,496) * m(:,:) + rate(:,:,497) = rate(:,:,497) * m(:,:) + rate(:,:,498) = rate(:,:,498) * m(:,:) + rate(:,:,499) = rate(:,:,499) * m(:,:) + rate(:,:,500) = rate(:,:,500) * m(:,:) + rate(:,:,501) = rate(:,:,501) * m(:,:) + rate(:,:,502) = rate(:,:,502) * m(:,:) + rate(:,:,503) = rate(:,:,503) * m(:,:) + rate(:,:,504) = rate(:,:,504) * m(:,:) + rate(:,:,505) = rate(:,:,505) * m(:,:) + rate(:,:,506) = rate(:,:,506) * m(:,:) + rate(:,:,507) = rate(:,:,507) * m(:,:) + rate(:,:,508) = rate(:,:,508) * m(:,:) + rate(:,:,509) = rate(:,:,509) * m(:,:) + rate(:,:,510) = rate(:,:,510) * m(:,:) + rate(:,:,511) = rate(:,:,511) * m(:,:) + rate(:,:,512) = rate(:,:,512) * m(:,:) + rate(:,:,513) = rate(:,:,513) * m(:,:) + rate(:,:,514) = rate(:,:,514) * m(:,:) + rate(:,:,515) = rate(:,:,515) * m(:,:) + rate(:,:,516) = rate(:,:,516) * m(:,:) + rate(:,:,517) = rate(:,:,517) * m(:,:) + rate(:,:,518) = rate(:,:,518) * m(:,:) + rate(:,:,519) = rate(:,:,519) * m(:,:) + rate(:,:,520) = rate(:,:,520) * m(:,:) + rate(:,:,521) = rate(:,:,521) * m(:,:) + rate(:,:,522) = rate(:,:,522) * m(:,:) + rate(:,:,523) = rate(:,:,523) * m(:,:) + rate(:,:,524) = rate(:,:,524) * m(:,:) + rate(:,:,525) = rate(:,:,525) * m(:,:) + rate(:,:,526) = rate(:,:,526) * m(:,:) + rate(:,:,527) = rate(:,:,527) * m(:,:) + rate(:,:,528) = rate(:,:,528) * m(:,:) + rate(:,:,529) = rate(:,:,529) * m(:,:) + rate(:,:,530) = rate(:,:,530) * m(:,:) + rate(:,:,531) = rate(:,:,531) * m(:,:) + rate(:,:,532) = rate(:,:,532) * m(:,:) + rate(:,:,533) = rate(:,:,533) * m(:,:) + rate(:,:,534) = rate(:,:,534) * m(:,:) + rate(:,:,535) = rate(:,:,535) * m(:,:) + rate(:,:,536) = rate(:,:,536) * m(:,:) + rate(:,:,537) = rate(:,:,537) * m(:,:) + rate(:,:,538) = rate(:,:,538) * m(:,:) + rate(:,:,539) = rate(:,:,539) * m(:,:) + rate(:,:,540) = rate(:,:,540) * m(:,:) + rate(:,:,541) = rate(:,:,541) * m(:,:) + rate(:,:,542) = rate(:,:,542) * m(:,:) + rate(:,:,543) = rate(:,:,543) * m(:,:) + rate(:,:,544) = rate(:,:,544) * m(:,:) + rate(:,:,545) = rate(:,:,545) * m(:,:) + rate(:,:,546) = rate(:,:,546) * m(:,:) + rate(:,:,547) = rate(:,:,547) * m(:,:) + rate(:,:,548) = rate(:,:,548) * m(:,:) + rate(:,:,549) = rate(:,:,549) * m(:,:) + rate(:,:,550) = rate(:,:,550) * m(:,:) + rate(:,:,551) = rate(:,:,551) * m(:,:) + rate(:,:,552) = rate(:,:,552) * m(:,:) + rate(:,:,553) = rate(:,:,553) * m(:,:) + rate(:,:,554) = rate(:,:,554) * m(:,:) + rate(:,:,555) = rate(:,:,555) * m(:,:) + rate(:,:,556) = rate(:,:,556) * m(:,:) + rate(:,:,557) = rate(:,:,557) * m(:,:) + rate(:,:,558) = rate(:,:,558) * m(:,:) + rate(:,:,559) = rate(:,:,559) * m(:,:) + rate(:,:,560) = rate(:,:,560) * m(:,:) + rate(:,:,561) = rate(:,:,561) * m(:,:) + rate(:,:,562) = rate(:,:,562) * m(:,:) + rate(:,:,563) = rate(:,:,563) * m(:,:) + rate(:,:,564) = rate(:,:,564) * m(:,:) + rate(:,:,565) = rate(:,:,565) * m(:,:) + rate(:,:,566) = rate(:,:,566) * m(:,:) + rate(:,:,567) = rate(:,:,567) * m(:,:) + rate(:,:,568) = rate(:,:,568) * m(:,:) + rate(:,:,569) = rate(:,:,569) * m(:,:) + rate(:,:,570) = rate(:,:,570) * m(:,:) + rate(:,:,571) = rate(:,:,571) * m(:,:) + rate(:,:,572) = rate(:,:,572) * m(:,:) + rate(:,:,573) = rate(:,:,573) * m(:,:) + rate(:,:,574) = rate(:,:,574) * m(:,:) + rate(:,:,575) = rate(:,:,575) * m(:,:) + rate(:,:,576) = rate(:,:,576) * m(:,:) + rate(:,:,577) = rate(:,:,577) * m(:,:) + rate(:,:,578) = rate(:,:,578) * m(:,:) + rate(:,:,579) = rate(:,:,579) * m(:,:) + rate(:,:,580) = rate(:,:,580) * m(:,:) + rate(:,:,581) = rate(:,:,581) * m(:,:) + rate(:,:,582) = rate(:,:,582) * m(:,:) + rate(:,:,583) = rate(:,:,583) * m(:,:) + rate(:,:,584) = rate(:,:,584) * m(:,:) + rate(:,:,585) = rate(:,:,585) * m(:,:) + rate(:,:,586) = rate(:,:,586) * m(:,:) + rate(:,:,587) = rate(:,:,587) * m(:,:) + rate(:,:,588) = rate(:,:,588) * m(:,:) + rate(:,:,589) = rate(:,:,589) * m(:,:) + rate(:,:,590) = rate(:,:,590) * m(:,:) + rate(:,:,591) = rate(:,:,591) * m(:,:) + rate(:,:,592) = rate(:,:,592) * m(:,:) + rate(:,:,593) = rate(:,:,593) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..50b06e0c03 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 @@ -0,0 +1,182 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) =rxt(:,:,173)*y(:,:,7)*y(:,:,5) + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,94) = 0._r8 + prod(:,:,95) =.180_r8*rxt(:,:,60)*y(:,:,12) + extfrc(:,:,20) + prod(:,:,82) =rxt(:,:,5)*y(:,:,4) + prod(:,:,97) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,61) = 0._r8 + prod(:,:,80) =1.440_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,50) =.380_r8*rxt(:,:,60)*y(:,:,12) + extfrc(:,:,3) + prod(:,:,102) =.440_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,64) = (rxt(:,:,76) +.800_r8*rxt(:,:,79) +rxt(:,:,88) + & + .800_r8*rxt(:,:,91)) + extfrc(:,:,21) + prod(:,:,104) = + extfrc(:,:,1) + prod(:,:,105) = + extfrc(:,:,2) + prod(:,:,88) =.330_r8*rxt(:,:,60)*y(:,:,12) + extfrc(:,:,23) + prod(:,:,107) = 0._r8 + prod(:,:,51) = 0._r8 + prod(:,:,109) = 0._r8 + prod(:,:,39) = 0._r8 + prod(:,:,62) = 0._r8 + prod(:,:,63) =rxt(:,:,59)*y(:,:,12) +rxt(:,:,37)*y(:,:,35) +rxt(:,:,48) & + *y(:,:,36) + prod(:,:,37) = 0._r8 + prod(:,:,73) =.180_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,91) = (rxt(:,:,59) +.330_r8*rxt(:,:,60))*y(:,:,12) + prod(:,:,86) = 0._r8 + prod(:,:,43) = 0._r8 + prod(:,:,100) =.050_r8*rxt(:,:,60)*y(:,:,12) + prod(:,:,112) =rxt(:,:,37)*y(:,:,35) +2.000_r8*rxt(:,:,40)*y(:,:,37) & + +2.000_r8*rxt(:,:,41)*y(:,:,38) +2.000_r8*rxt(:,:,42)*y(:,:,39) & + +rxt(:,:,45)*y(:,:,40) +4.000_r8*rxt(:,:,38)*y(:,:,41) & + +3.000_r8*rxt(:,:,39)*y(:,:,42) +rxt(:,:,50)*y(:,:,44) +rxt(:,:,46) & + *y(:,:,45) +rxt(:,:,47)*y(:,:,46) +2.000_r8*rxt(:,:,43)*y(:,:,47) & + +rxt(:,:,44)*y(:,:,48) + prod(:,:,24) = 0._r8 + prod(:,:,106) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,93) = 0._r8 + prod(:,:,56) = 0._r8 + prod(:,:,59) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,81) =rxt(:,:,48)*y(:,:,36) +rxt(:,:,49)*y(:,:,43) +rxt(:,:,50) & + *y(:,:,44) +2.000_r8*rxt(:,:,53)*y(:,:,49) +2.000_r8*rxt(:,:,54) & + *y(:,:,50) +3.000_r8*rxt(:,:,51)*y(:,:,51) +2.000_r8*rxt(:,:,52) & + *y(:,:,52) + prod(:,:,75) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,41) = 0._r8 + prod(:,:,45) = (rxt(:,:,72) +rxt(:,:,84)) + extfrc(:,:,18) + prod(:,:,110) = + extfrc(:,:,16) + prod(:,:,38) = (rxt(:,:,76) +rxt(:,:,77) +rxt(:,:,88) +rxt(:,:,89)) & + + extfrc(:,:,17) + prod(:,:,57) = + extfrc(:,:,15) + prod(:,:,113) = 0._r8 + prod(:,:,40) = (rxt(:,:,77) +1.200_r8*rxt(:,:,79) +rxt(:,:,89) + & + 1.200_r8*rxt(:,:,91)) + extfrc(:,:,19) + prod(:,:,65) = 0._r8 + prod(:,:,49) = 0._r8 + prod(:,:,54) = 0._r8 + prod(:,:,44) = 0._r8 + prod(:,:,101) = 0._r8 + prod(:,:,108) = 0._r8 + prod(:,:,103) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,98) = 0._r8 + prod(:,:,90) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,47) = 0._r8 + prod(:,:,46) = 0._r8 + prod(:,:,99) = 0._r8 + prod(:,:,111) = 0._r8 + prod(:,:,74) = 0._r8 + prod(:,:,42) = 0._r8 + prod(:,:,89) = 0._r8 + prod(:,:,84) = 0._r8 + prod(:,:,87) = 0._r8 + prod(:,:,85) = 0._r8 + prod(:,:,92) = 0._r8 + prod(:,:,66) = 0._r8 + prod(:,:,78) = 0._r8 + prod(:,:,68) = 0._r8 + prod(:,:,71) = 0._r8 + prod(:,:,79) = 0._r8 + prod(:,:,77) = 0._r8 + prod(:,:,76) = 0._r8 + prod(:,:,72) = 0._r8 + prod(:,:,83) = 0._r8 + prod(:,:,60) = 0._r8 + prod(:,:,70) = 0._r8 + prod(:,:,69) = 0._r8 + prod(:,:,96) = (rxt(:,:,72) +rxt(:,:,76) +rxt(:,:,77) +rxt(:,:,84) + & + rxt(:,:,88) +rxt(:,:,89)) + extfrc(:,:,22) + prod(:,:,22) =rxt(:,:,41)*y(:,:,38) +rxt(:,:,42)*y(:,:,39) +rxt(:,:,45) & + *y(:,:,40) +rxt(:,:,49)*y(:,:,43) +rxt(:,:,50)*y(:,:,44) +rxt(:,:,47) & + *y(:,:,46) +2.000_r8*rxt(:,:,43)*y(:,:,47) +2.000_r8*rxt(:,:,44) & + *y(:,:,48) +rxt(:,:,53)*y(:,:,49) +2.000_r8*rxt(:,:,54)*y(:,:,50) + prod(:,:,25) =rxt(:,:,40)*y(:,:,37) +rxt(:,:,42)*y(:,:,39) +rxt(:,:,46) & + *y(:,:,45) + prod(:,:,27) = 0._r8 + prod(:,:,53) =rxt(:,:,49)*y(:,:,43) +rxt(:,:,44)*y(:,:,48) + prod(:,:,34) = 0._r8 + prod(:,:,48) = 0._r8 + prod(:,:,67) = 0._r8 + prod(:,:,58) = + extfrc(:,:,4) + prod(:,:,30) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,31) = + extfrc(:,:,5) + prod(:,:,1) = 0._r8 + prod(:,:,2) = + extfrc(:,:,6) + prod(:,:,3) = + extfrc(:,:,8) + prod(:,:,4) = 0._r8 + prod(:,:,5) = + extfrc(:,:,10) + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = + extfrc(:,:,12) + prod(:,:,9) = + extfrc(:,:,7) + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = + extfrc(:,:,13) + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = + extfrc(:,:,9) + prod(:,:,19) = + extfrc(:,:,11) + prod(:,:,20) = + extfrc(:,:,14) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..dafcb462c9 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 @@ -0,0 +1,377 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1051) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(465) = rxt(96) + mat(1110) = -( rxt(67) + rxt(68) + rxt(69) + rxt(80) + rxt(81) + rxt(82) & + + het_rates(2) ) + mat(1196) = rxt(1) + 2.000_r8*rxt(2) + rxt(73) + rxt(74) + rxt(75) & + + 2.000_r8*rxt(78) + rxt(85) + rxt(86) + rxt(87) + 2.000_r8*rxt(90) + mat(1052) = rxt(4) + mat(1503) = rxt(6) + mat(1549) = rxt(8) + mat(287) = rxt(10) + mat(1636) = rxt(12) + mat(1333) = rxt(21) + mat(1595) = rxt(24) + mat(67) = rxt(25) + mat(487) = rxt(32) + mat(1417) = rxt(58) + rxt(92) + mat(251) = rxt(62) + mat(53) = rxt(63) + mat(360) = rxt(65) + mat(1274) = rxt(94) + rxt(367) + mat(638) = rxt(118) + mat(631) = -( rxt(118) + rxt(122)*y(4) + rxt(123)*y(4) + rxt(125)*y(37) & + + rxt(126)*y(38) + rxt(127)*y(39) + rxt(128)*y(47) + rxt(129)*y(48) & + + rxt(130)*y(40) + rxt(131)*y(45) + rxt(132)*y(46) + rxt(133)*y(41) & + + rxt(134)*y(36) + rxt(135)*y(44) + rxt(136)*y(43) + rxt(137)*y(49) & + + rxt(138)*y(50) + rxt(139)*y(51) + rxt(140)*y(52) + rxt(143)*y(12) & + + rxt(144)*y(12) + rxt(145)*y(12) + het_rates(134) ) + mat(1184) = rxt(1) + mat(1040) = rxt(3) + mat(1321) = rxt(20) + mat(1198) = -( rxt(1) + rxt(2) + rxt(71) + rxt(73) + rxt(74) + rxt(75) + rxt(78) & + + rxt(83) + rxt(85) + rxt(86) + rxt(87) + rxt(90) + het_rates(3) ) + mat(1054) = rxt(4) + mat(1638) = rxt(13) + mat(1803) = rxt(95) + rxt(371) + mat(468) = rxt(100) + mat(126) = rxt(101) + mat(63) = rxt(113) + mat(277) = rxt(116) + rxt(117) + mat(640) = rxt(123)*y(4) + mat(61) = -( rxt(110) + rxt(113) + het_rates(132) ) + mat(273) = -( rxt(116) + rxt(117) + het_rates(133) ) + mat(1034) = rxt(3) + mat(62) = rxt(110) + mat(575) = -( het_rates(17) ) + mat(446) = rxt(18) + mat(1319) = rxt(20) + mat(629) = rxt(145)*y(12) + mat(186) = -( het_rates(16) ) + mat(443) = rxt(17) + rxt(18) + mat(1399) = rxt(58) + rxt(92) + mat(71) = rxt(64) + mat(1822) = rxt(240)*y(35) + mat(1424) = -( rxt(58) + rxt(92) + het_rates(57) ) + mat(862) = rxt(102) + mat(695) = rxt(103) + mat(165) = rxt(361) + mat(309) = -( rxt(70) + het_rates(5) ) + mat(1482) = rxt(6) + mat(237) = rxt(300) + mat(1512) = -( rxt(6) + rxt(7) + het_rates(6) ) + mat(1558) = rxt(8) + .500_r8*rxt(263) + mat(290) = rxt(10) + mat(1645) = rxt(13) + mat(194) = rxt(66) + mat(1774) = rxt(310) + mat(645) = 2.000_r8*rxt(122)*y(4) + mat(1559) = -( rxt(8) + rxt(263) + het_rates(7) ) + mat(291) = rxt(9) + rxt(183) + mat(1729) = rxt(11) + mat(1646) = rxt(12) + mat(107) = rxt(15) + rxt(192) + mat(260) = rxt(30) + mat(119) = rxt(36) + mat(785) = rxt(98) + mat(819) = -( rxt(241)*y(35) + rxt(242)*y(42) + rxt(243)*y(40) + rxt(244)*y(36) & + + rxt(246)*y(45) + rxt(247)*y(46) + rxt(248)*y(52) + rxt(249)*y(51) & + + rxt(252)*y(12) + het_rates(87) ) + mat(1712) = rxt(11) + mat(104) = rxt(14) + mat(92) = rxt(16) + mat(1326) = rxt(19) + mat(131) = 2.000_r8*rxt(22) + mat(229) = rxt(27) + mat(200) = rxt(33) + mat(192) = rxt(66) + mat(961) = rxt(97) + mat(1542) = .500_r8*rxt(263) + mat(633) = rxt(143)*y(12) + mat(1648) = -( rxt(12) + rxt(13) + rxt(262) + het_rates(8) ) + mat(292) = rxt(9) + rxt(10) + rxt(183) + mat(108) = rxt(14) + mat(262) = rxt(29) + mat(120) = rxt(35) + mat(725) = rxt(99) + mat(191) = -( rxt(66) + het_rates(20) ) + mat(1733) = -( rxt(11) + het_rates(9) ) + mat(294) = 2.000_r8*rxt(261) + 2.000_r8*rxt(282) + 2.000_r8*rxt(288) & + + 2.000_r8*rxt(293) + mat(1650) = rxt(262) + mat(1563) = .500_r8*rxt(263) + mat(263) = rxt(283) + rxt(289) + rxt(294) + mat(121) = rxt(284) + rxt(292) + rxt(295) + mat(507) = rxt(462) + mat(102) = -( rxt(14) + rxt(15) + rxt(192) + het_rates(10) ) + mat(283) = -( rxt(9) + rxt(10) + rxt(183) + rxt(261) + rxt(282) + rxt(288) & + + rxt(293) + het_rates(11) ) + mat(296) = -( het_rates(13) ) + mat(626) = rxt(143)*y(12) + mat(1826) = rxt(199)*y(12) + mat(207) = rxt(238)*y(12) + mat(810) = rxt(252)*y(12) + mat(89) = -( rxt(16) + het_rates(14) ) + mat(445) = -( rxt(17) + rxt(18) + het_rates(15) ) + mat(91) = rxt(16) + mat(628) = rxt(144)*y(12) + rxt(145)*y(12) + mat(931) = -( het_rates(18) ) + mat(93) = rxt(16) + mat(451) = 2.000_r8*rxt(17) + mat(1329) = rxt(19) + 2.000_r8*rxt(21) + mat(1008) = rxt(28) + mat(224) = rxt(34) + mat(41) = rxt(57) + mat(634) = rxt(144)*y(12) + mat(744) = -( rxt(264) + het_rates(88) ) + mat(103) = rxt(15) + rxt(192) + mat(632) = rxt(144)*y(12) + mat(1834) = rxt(240)*y(35) + rxt(245)*y(36) + mat(818) = rxt(241)*y(35) + rxt(244)*y(36) + mat(129) = -( rxt(22) + het_rates(19) ) + mat(733) = .500_r8*rxt(264) + mat(1338) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(135) ) + mat(29) = rxt(61) + mat(183) = rxt(93) + mat(542) = rxt(104) + rxt(452) + mat(140) = rxt(341) + mat(1381) = rxt(343) + mat(1684) = rxt(345) + mat(1465) = rxt(347) + mat(405) = rxt(445) + mat(561) = rxt(449) + mat(374) = rxt(455) + mat(419) = rxt(457) + mat(520) = rxt(460) + mat(829) = rxt(241)*y(35) + rxt(242)*y(42) + rxt(243)*y(40) + rxt(244)*y(36) & + + rxt(248)*y(52) + rxt(252)*y(12) + mat(1860) = -( rxt(199)*y(12) + rxt(240)*y(35) + rxt(245)*y(36) + rxt(250)*y(52) & + + rxt(251)*y(51) + het_rates(85) ) + mat(31) = 2.000_r8*rxt(23) + mat(1612) = rxt(24) + mat(23) = 2.000_r8*rxt(26) + mat(234) = rxt(27) + mat(1029) = rxt(28) + mat(264) = rxt(29) + mat(38) = rxt(31) + mat(35) = rxt(56) + mat(652) = 2.000_r8*rxt(125)*y(37) + 2.000_r8*rxt(126)*y(38) & + + 2.000_r8*rxt(127)*y(39) + 2.000_r8*rxt(128)*y(47) + rxt(129)*y(48) & + + rxt(130)*y(40) + rxt(131)*y(45) + rxt(132)*y(46) & + + 4.000_r8*rxt(133)*y(41) + rxt(135)*y(44) + mat(839) = rxt(241)*y(35) + 3.000_r8*rxt(242)*y(42) + rxt(243)*y(40) & + + rxt(246)*y(45) + rxt(247)*y(46) + mat(30) = -( rxt(23) + het_rates(23) ) + mat(1606) = -( rxt(24) + het_rates(24) ) + mat(68) = rxt(25) + mat(261) = rxt(30) + mat(22) = 2.000_r8*rxt(211) + mat(64) = -( rxt(25) + het_rates(25) ) + mat(21) = -( rxt(26) + rxt(211) + het_rates(26) ) + mat(1010) = -( rxt(28) + het_rates(27) ) + mat(386) = rxt(446) + mat(1841) = rxt(199)*y(12) + 2.000_r8*rxt(240)*y(35) + rxt(245)*y(36) & + + rxt(250)*y(52) + rxt(251)*y(51) + mat(228) = -( rxt(27) + het_rates(28) ) + mat(254) = rxt(283) + rxt(289) + rxt(294) + mat(255) = -( rxt(29) + rxt(30) + rxt(283) + rxt(289) + rxt(294) + het_rates(29) & + ) + mat(36) = -( rxt(31) + het_rates(30) ) + mat(600) = -( het_rates(86) ) + mat(37) = rxt(31) + mat(481) = rxt(32) + mat(199) = rxt(33) + mat(221) = rxt(34) + mat(117) = rxt(35) + mat(630) = rxt(134)*y(36) + rxt(135)*y(44) + rxt(136)*y(43) & + + 2.000_r8*rxt(137)*y(49) + 2.000_r8*rxt(138)*y(50) & + + 3.000_r8*rxt(139)*y(51) + 2.000_r8*rxt(140)*y(52) + mat(816) = rxt(244)*y(36) + 2.000_r8*rxt(248)*y(52) + 3.000_r8*rxt(249)*y(51) + mat(1829) = rxt(245)*y(36) + 2.000_r8*rxt(250)*y(52) + 3.000_r8*rxt(251)*y(51) + mat(480) = -( rxt(32) + het_rates(31) ) + mat(116) = rxt(36) + mat(220) = -( rxt(34) + het_rates(32) ) + mat(197) = -( rxt(33) + het_rates(33) ) + mat(115) = rxt(284) + rxt(292) + rxt(295) + mat(114) = -( rxt(35) + rxt(36) + rxt(284) + rxt(292) + rxt(295) + het_rates(34) & + ) + mat(143) = -( het_rates(89) ) + mat(1780) = -( rxt(310) + het_rates(90) ) + mat(1211) = rxt(71) + rxt(83) + mat(185) = rxt(93) + mat(95) = -( het_rates(127) ) + mat(307) = rxt(70) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(236) = -( rxt(300) + het_rates(128) ) + mat(1084) = rxt(67) + rxt(68) + rxt(69) + rxt(80) + rxt(81) + rxt(82) + mat(1175) = rxt(73) + rxt(74) + rxt(75) + rxt(85) + rxt(86) + rxt(87) + mat(1907) = -( rxt(362) + het_rates(129) ) + mat(1521) = rxt(7) + mat(245) = rxt(300) + mat(1783) = rxt(310) + mat(167) = rxt(361) + mat(160) = rxt(363) + mat(109) = -( het_rates(131) ) + mat(324) = -( het_rates(91) ) + mat(177) = -( rxt(93) + het_rates(92) ) + mat(215) = -( het_rates(93) ) + mat(137) = rxt(341) + mat(136) = -( rxt(341) + het_rates(94) ) + mat(1352) = rxt(343) + mat(1382) = -( rxt(343) + het_rates(95) ) + mat(1685) = rxt(345) + mat(1692) = -( rxt(345) + het_rates(96) ) + mat(1473) = rxt(347) + mat(1468) = -( rxt(347) + het_rates(97) ) + mat(77) = -( het_rates(98) ) + mat(42) = -( het_rates(99) ) + mat(46) = -( het_rates(100) ) + mat(1241) = -( het_rates(101) ) + mat(893) = -( het_rates(102) ) + mat(83) = -( het_rates(103) ) + mat(161) = -( rxt(361) + het_rates(104) ) + mat(153) = -( rxt(363) + het_rates(105) ) + mat(1863) = rxt(362) + mat(1278) = -( rxt(94) + rxt(367) + het_rates(106) ) + mat(469) = rxt(100) + mat(859) = rxt(102) + mat(1817) = -( rxt(95) + rxt(371) + het_rates(107) ) + mat(128) = rxt(101) + mat(703) = rxt(103) + mat(459) = -( rxt(96) + rxt(100) + het_rates(108) ) + mat(122) = -( rxt(101) + het_rates(109) ) + mat(849) = -( rxt(102) + het_rates(111) ) + mat(536) = rxt(104) + rxt(452) + mat(677) = -( rxt(103) + het_rates(112) ) + mat(770) = -( rxt(98) + het_rates(113) ) + mat(414) = rxt(457) + mat(710) = -( rxt(99) + het_rates(114) ) + mat(555) = rxt(449) + mat(497) = rxt(462) + mat(965) = -( rxt(97) + het_rates(110) ) + mat(336) = -( het_rates(122) ) + mat(532) = -( rxt(104) + rxt(452) + het_rates(115) ) + mat(368) = rxt(455) + mat(367) = -( rxt(455) + het_rates(116) ) + mat(413) = -( rxt(457) + het_rates(117) ) + mat(554) = -( rxt(449) + het_rates(118) ) + mat(513) = rxt(460) + mat(512) = -( rxt(460) + het_rates(119) ) + mat(496) = -( rxt(462) + het_rates(120) ) + mat(427) = -( het_rates(121) ) + mat(655) = -( het_rates(123) ) + mat(399) = rxt(445) + mat(383) = rxt(446) + mat(265) = -( het_rates(124) ) + mat(398) = -( rxt(445) + het_rates(125) ) + mat(382) = -( rxt(446) + het_rates(126) ) + mat(1151) = -( het_rates(130) ) + mat(1504) = rxt(7) + mat(1111) = rxt(67) + rxt(68) + rxt(69) + rxt(80) + rxt(81) + rxt(82) + mat(314) = rxt(70) + mat(1197) = rxt(71) + rxt(73) + rxt(74) + rxt(75) + rxt(83) + rxt(85) + rxt(86) & + + rxt(87) + mat(1275) = rxt(94) + rxt(367) + mat(1802) = rxt(95) + rxt(371) + mat(467) = rxt(96) + mat(969) = rxt(97) + mat(778) = rxt(98) + mat(717) = rxt(99) + mat(24) = -( rxt(55) + het_rates(53) ) + mat(620) = rxt(126)*y(38) + rxt(127)*y(39) + 2.000_r8*rxt(128)*y(47) & + + 2.000_r8*rxt(129)*y(48) + rxt(130)*y(40) + rxt(132)*y(46) & + + rxt(135)*y(44) + rxt(136)*y(43) + rxt(137)*y(49) & + + 2.000_r8*rxt(138)*y(50) + mat(793) = rxt(243)*y(40) + rxt(247)*y(46) + mat(32) = -( rxt(56) + het_rates(54) ) + mat(621) = rxt(125)*y(37) + rxt(127)*y(39) + rxt(131)*y(45) + mat(794) = rxt(246)*y(45) + mat(39) = -( rxt(57) + het_rates(55) ) + mat(205) = rxt(238)*y(12) + mat(206) = -( rxt(238)*y(12) + het_rates(56) ) + mat(25) = 2.000_r8*rxt(55) + mat(33) = rxt(56) + mat(40) = rxt(57) + mat(623) = rxt(129)*y(48) + rxt(136)*y(43) + mat(69) = -( rxt(64) + het_rates(58) ) + mat(168) = -( het_rates(59) ) + mat(70) = rxt(64) + mat(351) = rxt(65) + mat(353) = -( rxt(65) + het_rates(60) ) + mat(248) = rxt(62) + mat(247) = -( rxt(62) + het_rates(61) ) + mat(52) = rxt(63) + mat(51) = -( rxt(63) + het_rates(62) ) + mat(28) = rxt(61) + mat(27) = -( rxt(61) + het_rates(63) ) + mat(55) = -( het_rates(64) ) + mat(1) = -( het_rates(65) ) + mat(2) = -( het_rates(66) ) + mat(3) = -( het_rates(67) ) + mat(4) = -( het_rates(68) ) + mat(5) = -( het_rates(69) ) + mat(6) = -( het_rates(70) ) + mat(7) = -( het_rates(71) ) + mat(8) = -( het_rates(72) ) + mat(9) = -( het_rates(73) ) + mat(10) = -( het_rates(74) ) + mat(11) = -( het_rates(75) ) + mat(12) = -( het_rates(76) ) + mat(13) = -( het_rates(77) ) + mat(14) = -( het_rates(78) ) + mat(15) = -( het_rates(79) ) + mat(16) = -( het_rates(80) ) + mat(17) = -( het_rates(81) ) + mat(18) = -( het_rates(82) ) + mat(19) = -( het_rates(83) ) + mat(20) = -( het_rates(84) ) + end subroutine linmat02 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..14d7b95baf --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 @@ -0,0 +1,13543 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = lu(22) * lu(21) + lu(23) = lu(23) * lu(21) + lu(1606) = lu(1606) - lu(22) * lu(1568) + lu(1612) = lu(1612) - lu(23) * lu(1568) + lu(24) = 1._r8 / lu(24) + lu(25) = lu(25) * lu(24) + lu(26) = lu(26) * lu(24) + lu(623) = lu(623) - lu(25) * lu(620) + lu(631) = lu(631) - lu(26) * lu(620) + lu(804) = - lu(25) * lu(793) + lu(817) = - lu(26) * lu(793) + lu(27) = 1._r8 / lu(27) + lu(28) = lu(28) * lu(27) + lu(29) = lu(29) * lu(27) + lu(51) = lu(51) - lu(28) * lu(50) + lu(54) = lu(54) - lu(29) * lu(50) + lu(1297) = lu(1297) - lu(28) * lu(1293) + lu(1338) = lu(1338) - lu(29) * lu(1293) + lu(30) = 1._r8 / lu(30) + lu(31) = lu(31) * lu(30) + lu(234) = lu(234) - lu(31) * lu(227) + lu(264) = lu(264) - lu(31) * lu(253) + lu(1029) = lu(1029) - lu(31) * lu(987) + lu(1612) = lu(1612) - lu(31) * lu(1569) + lu(1860) = lu(1860) - lu(31) * lu(1820) + lu(32) = 1._r8 / lu(32) + lu(33) = lu(33) * lu(32) + lu(34) = lu(34) * lu(32) + lu(35) = lu(35) * lu(32) + lu(623) = lu(623) - lu(33) * lu(621) + lu(631) = lu(631) - lu(34) * lu(621) + lu(652) = lu(652) - lu(35) * lu(621) + lu(804) = lu(804) - lu(33) * lu(794) + lu(817) = lu(817) - lu(34) * lu(794) + lu(839) = lu(839) - lu(35) * lu(794) + lu(36) = 1._r8 / lu(36) + lu(37) = lu(37) * lu(36) + lu(38) = lu(38) * lu(36) + lu(199) = lu(199) - lu(37) * lu(196) + lu(204) = - lu(38) * lu(196) + lu(481) = lu(481) - lu(37) * lu(474) + lu(495) = lu(495) - lu(38) * lu(474) + lu(998) = - lu(37) * lu(988) + lu(1029) = lu(1029) - lu(38) * lu(988) + lu(1581) = lu(1581) - lu(37) * lu(1570) + lu(1612) = lu(1612) - lu(38) * lu(1570) + lu(39) = 1._r8 / lu(39) + lu(40) = lu(40) * lu(39) + lu(41) = lu(41) * lu(39) + lu(206) = lu(206) - lu(40) * lu(205) + lu(210) = lu(210) - lu(41) * lu(205) + lu(572) = lu(572) - lu(40) * lu(571) + lu(580) = lu(580) - lu(41) * lu(571) + lu(1305) = lu(1305) - lu(40) * lu(1294) + lu(1329) = lu(1329) - lu(41) * lu(1294) + lu(1699) = lu(1699) - lu(40) * lu(1698) + lu(1715) = - lu(41) * lu(1698) + lu(42) = 1._r8 / lu(42) + lu(43) = lu(43) * lu(42) + lu(44) = lu(44) * lu(42) + lu(45) = lu(45) * lu(42) + lu(288) = lu(288) - lu(43) * lu(281) + lu(293) = lu(293) - lu(44) * lu(281) + lu(294) = lu(294) - lu(45) * lu(281) + lu(1338) = lu(1338) - lu(43) * lu(1295) + lu(1346) = lu(1346) - lu(44) * lu(1295) + lu(1347) = lu(1347) - lu(45) * lu(1295) + lu(1684) = lu(1684) - lu(43) * lu(1655) + lu(1692) = lu(1692) - lu(44) * lu(1655) + lu(1693) = lu(1693) - lu(45) * lu(1655) + lu(46) = 1._r8 / lu(46) + lu(47) = lu(47) * lu(46) + lu(48) = lu(48) * lu(46) + lu(49) = lu(49) * lu(46) + lu(288) = lu(288) - lu(47) * lu(282) + lu(289) = lu(289) - lu(48) * lu(282) + lu(294) = lu(294) - lu(49) * lu(282) + lu(1338) = lu(1338) - lu(47) * lu(1296) + lu(1341) = lu(1341) - lu(48) * lu(1296) + lu(1347) = lu(1347) - lu(49) * lu(1296) + lu(1465) = lu(1465) - lu(47) * lu(1436) + lu(1468) = lu(1468) - lu(48) * lu(1436) + lu(1474) = lu(1474) - lu(49) * lu(1436) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(51) = 1._r8 / lu(51) + lu(52) = lu(52) * lu(51) + lu(53) = lu(53) * lu(51) + lu(54) = lu(54) * lu(51) + lu(247) = lu(247) - lu(52) * lu(246) + lu(251) = lu(251) - lu(53) * lu(246) + lu(252) = - lu(54) * lu(246) + lu(808) = lu(808) - lu(52) * lu(795) + lu(824) = lu(824) - lu(53) * lu(795) + lu(829) = lu(829) - lu(54) * lu(795) + lu(1307) = - lu(52) * lu(1297) + lu(1333) = lu(1333) - lu(53) * lu(1297) + lu(1338) = lu(1338) - lu(54) * lu(1297) + lu(55) = 1._r8 / lu(55) + lu(56) = lu(56) * lu(55) + lu(57) = lu(57) * lu(55) + lu(58) = lu(58) * lu(55) + lu(59) = lu(59) * lu(55) + lu(60) = lu(60) * lu(55) + lu(808) = lu(808) - lu(56) * lu(796) + lu(818) = lu(818) - lu(57) * lu(796) + lu(819) = lu(819) - lu(58) * lu(796) + lu(835) = lu(835) - lu(59) * lu(796) + lu(836) = lu(836) - lu(60) * lu(796) + lu(1616) = lu(1616) - lu(56) * lu(1614) + lu(1628) = lu(1628) - lu(57) * lu(1614) + lu(1630) = lu(1630) - lu(58) * lu(1614) + lu(1648) = lu(1648) - lu(59) * lu(1614) + lu(1650) = lu(1650) - lu(60) * lu(1614) + lu(61) = 1._r8 / lu(61) + lu(62) = lu(62) * lu(61) + lu(63) = lu(63) * lu(61) + lu(625) = - lu(62) * lu(622) + lu(640) = lu(640) - lu(63) * lu(622) + lu(1034) = lu(1034) - lu(62) * lu(1031) + lu(1054) = lu(1054) - lu(63) * lu(1031) + lu(1088) = lu(1088) - lu(62) * lu(1071) + lu(1112) = lu(1112) - lu(63) * lu(1071) + lu(1177) = lu(1177) - lu(62) * lu(1169) + lu(1198) = lu(1198) - lu(63) * lu(1169) + lu(1401) = lu(1401) - lu(62) * lu(1395) + lu(1419) = lu(1419) - lu(63) * lu(1395) + lu(64) = 1._r8 / lu(64) + lu(65) = lu(65) * lu(64) + lu(66) = lu(66) * lu(64) + lu(67) = lu(67) * lu(64) + lu(68) = lu(68) * lu(64) + lu(352) = lu(352) - lu(65) * lu(350) + lu(353) = lu(353) - lu(66) * lu(350) + lu(360) = lu(360) - lu(67) * lu(350) + lu(365) = lu(365) - lu(68) * lu(350) + lu(478) = lu(478) - lu(65) * lu(475) + lu(479) = lu(479) - lu(66) * lu(475) + lu(487) = lu(487) - lu(67) * lu(475) + lu(492) = lu(492) - lu(68) * lu(475) + lu(1573) = lu(1573) - lu(65) * lu(1571) + lu(1577) = lu(1577) - lu(66) * lu(1571) + lu(1595) = lu(1595) - lu(67) * lu(1571) + lu(1606) = lu(1606) - lu(68) * lu(1571) + lu(69) = 1._r8 / lu(69) + lu(70) = lu(70) * lu(69) + lu(71) = lu(71) * lu(69) + lu(72) = lu(72) * lu(69) + lu(73) = lu(73) * lu(69) + lu(74) = lu(74) * lu(69) + lu(75) = lu(75) * lu(69) + lu(76) = lu(76) * lu(69) + lu(801) = lu(801) - lu(70) * lu(797) + lu(802) = lu(802) - lu(71) * lu(797) + lu(808) = lu(808) - lu(72) * lu(797) + lu(812) = lu(812) - lu(73) * lu(797) + lu(819) = lu(819) - lu(74) * lu(797) + lu(820) = lu(820) - lu(75) * lu(797) + lu(824) = lu(824) - lu(76) * lu(797) + lu(1079) = - lu(70) * lu(1072) + lu(1080) = lu(1080) - lu(71) * lu(1072) + lu(1085) = - lu(72) * lu(1072) + lu(1091) = lu(1091) - lu(73) * lu(1072) + lu(1103) = lu(1103) - lu(74) * lu(1072) + lu(1106) = lu(1106) - lu(75) * lu(1072) + lu(1110) = lu(1110) - lu(76) * lu(1072) + lu(77) = 1._r8 / lu(77) + lu(78) = lu(78) * lu(77) + lu(79) = lu(79) * lu(77) + lu(80) = lu(80) * lu(77) + lu(81) = lu(81) * lu(77) + lu(82) = lu(82) * lu(77) + lu(176) = - lu(78) * lu(175) + lu(179) = lu(179) - lu(79) * lu(175) + lu(180) = - lu(80) * lu(175) + lu(181) = lu(181) - lu(81) * lu(175) + lu(183) = lu(183) - lu(82) * lu(175) + lu(1132) = lu(1132) - lu(78) * lu(1129) + lu(1144) = lu(1144) - lu(79) * lu(1129) + lu(1146) = lu(1146) - lu(80) * lu(1129) + lu(1151) = lu(1151) - lu(81) * lu(1129) + lu(1155) = lu(1155) - lu(82) * lu(1129) + lu(1300) = lu(1300) - lu(78) * lu(1298) + lu(1326) = lu(1326) - lu(79) * lu(1298) + lu(1329) = lu(1329) - lu(80) * lu(1298) + lu(1334) = - lu(81) * lu(1298) + lu(1338) = lu(1338) - lu(82) * lu(1298) + lu(83) = 1._r8 / lu(83) + lu(84) = lu(84) * lu(83) + lu(85) = lu(85) * lu(83) + lu(86) = lu(86) * lu(83) + lu(87) = lu(87) * lu(83) + lu(88) = lu(88) * lu(83) + lu(875) = - lu(84) * lu(874) + lu(899) = lu(899) - lu(85) * lu(874) + lu(903) = lu(903) - lu(86) * lu(874) + lu(904) = - lu(87) * lu(874) + lu(907) = lu(907) - lu(88) * lu(874) + lu(1137) = - lu(84) * lu(1130) + lu(1151) = lu(1151) - lu(85) * lu(1130) + lu(1155) = lu(1155) - lu(86) * lu(1130) + lu(1156) = lu(1156) - lu(87) * lu(1130) + lu(1159) = lu(1159) - lu(88) * lu(1130) + lu(1304) = lu(1304) - lu(84) * lu(1299) + lu(1334) = lu(1334) - lu(85) * lu(1299) + lu(1338) = lu(1338) - lu(86) * lu(1299) + lu(1339) = lu(1339) - lu(87) * lu(1299) + lu(1342) = - lu(88) * lu(1299) + lu(89) = 1._r8 / lu(89) + lu(90) = lu(90) * lu(89) + lu(91) = lu(91) * lu(89) + lu(92) = lu(92) * lu(89) + lu(93) = lu(93) * lu(89) + lu(94) = lu(94) * lu(89) + lu(296) = lu(296) - lu(90) * lu(295) + lu(297) = lu(297) - lu(91) * lu(295) + lu(299) = - lu(92) * lu(295) + lu(300) = - lu(93) * lu(295) + lu(302) = - lu(94) * lu(295) + lu(738) = lu(738) - lu(90) * lu(731) + lu(739) = - lu(91) * lu(731) + lu(745) = lu(745) - lu(92) * lu(731) + lu(746) = lu(746) - lu(93) * lu(731) + lu(755) = lu(755) - lu(94) * lu(731) + lu(810) = lu(810) - lu(90) * lu(798) + lu(813) = lu(813) - lu(91) * lu(798) + lu(819) = lu(819) - lu(92) * lu(798) + lu(820) = lu(820) - lu(93) * lu(798) + lu(829) = lu(829) - lu(94) * lu(798) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(95) = 1._r8 / lu(95) + lu(96) = lu(96) * lu(95) + lu(97) = lu(97) * lu(95) + lu(98) = lu(98) * lu(95) + lu(99) = lu(99) * lu(95) + lu(100) = lu(100) * lu(95) + lu(101) = lu(101) * lu(95) + lu(308) = - lu(96) * lu(307) + lu(309) = lu(309) - lu(97) * lu(307) + lu(313) = lu(313) - lu(98) * lu(307) + lu(315) = lu(315) - lu(99) * lu(307) + lu(319) = lu(319) - lu(100) * lu(307) + lu(320) = lu(320) - lu(101) * lu(307) + lu(1084) = lu(1084) - lu(96) * lu(1073) + lu(1089) = lu(1089) - lu(97) * lu(1073) + lu(1110) = lu(1110) - lu(98) * lu(1073) + lu(1112) = lu(1112) - lu(99) * lu(1073) + lu(1125) = lu(1125) - lu(100) * lu(1073) + lu(1128) = lu(1128) - lu(101) * lu(1073) + lu(1175) = lu(1175) - lu(96) * lu(1170) + lu(1178) = lu(1178) - lu(97) * lu(1170) + lu(1196) = lu(1196) - lu(98) * lu(1170) + lu(1198) = lu(1198) - lu(99) * lu(1170) + lu(1211) = lu(1211) - lu(100) * lu(1170) + lu(1214) = lu(1214) - lu(101) * lu(1170) + lu(102) = 1._r8 / lu(102) + lu(103) = lu(103) * lu(102) + lu(104) = lu(104) * lu(102) + lu(105) = lu(105) * lu(102) + lu(106) = lu(106) * lu(102) + lu(107) = lu(107) * lu(102) + lu(108) = lu(108) * lu(102) + lu(744) = lu(744) - lu(103) * lu(732) + lu(745) = lu(745) - lu(104) * lu(732) + lu(752) = lu(752) - lu(105) * lu(732) + lu(755) = lu(755) - lu(106) * lu(732) + lu(759) = lu(759) - lu(107) * lu(732) + lu(761) = lu(761) - lu(108) * lu(732) + lu(818) = lu(818) - lu(103) * lu(799) + lu(819) = lu(819) - lu(104) * lu(799) + lu(826) = lu(826) - lu(105) * lu(799) + lu(829) = lu(829) - lu(106) * lu(799) + lu(833) = lu(833) - lu(107) * lu(799) + lu(835) = lu(835) - lu(108) * lu(799) + lu(1540) = lu(1540) - lu(103) * lu(1522) + lu(1542) = lu(1542) - lu(104) * lu(1522) + lu(1551) = lu(1551) - lu(105) * lu(1522) + lu(1554) = lu(1554) - lu(106) * lu(1522) + lu(1559) = lu(1559) - lu(107) * lu(1522) + lu(1561) = lu(1561) - lu(108) * lu(1522) + lu(109) = 1._r8 / lu(109) + lu(110) = lu(110) * lu(109) + lu(111) = lu(111) * lu(109) + lu(112) = lu(112) * lu(109) + lu(113) = lu(113) * lu(109) + lu(145) = lu(145) - lu(110) * lu(142) + lu(146) = - lu(111) * lu(142) + lu(149) = lu(149) - lu(112) * lu(142) + lu(150) = - lu(113) * lu(142) + lu(1089) = lu(1089) - lu(110) * lu(1074) + lu(1097) = - lu(111) * lu(1074) + lu(1112) = lu(1112) - lu(112) * lu(1074) + lu(1119) = lu(1119) - lu(113) * lu(1074) + lu(1140) = lu(1140) - lu(110) * lu(1131) + lu(1142) = lu(1142) - lu(111) * lu(1131) + lu(1152) = lu(1152) - lu(112) * lu(1131) + lu(1159) = lu(1159) - lu(113) * lu(1131) + lu(1178) = lu(1178) - lu(110) * lu(1171) + lu(1184) = lu(1184) - lu(111) * lu(1171) + lu(1198) = lu(1198) - lu(112) * lu(1171) + lu(1205) = lu(1205) - lu(113) * lu(1171) + lu(1865) = lu(1865) - lu(110) * lu(1862) + lu(1876) = - lu(111) * lu(1862) + lu(1891) = lu(1891) - lu(112) * lu(1862) + lu(1898) = lu(1898) - lu(113) * lu(1862) + lu(114) = 1._r8 / lu(114) + lu(115) = lu(115) * lu(114) + lu(116) = lu(116) * lu(114) + lu(117) = lu(117) * lu(114) + lu(118) = lu(118) * lu(114) + lu(119) = lu(119) * lu(114) + lu(120) = lu(120) * lu(114) + lu(121) = lu(121) * lu(114) + lu(477) = lu(477) - lu(115) * lu(476) + lu(480) = lu(480) - lu(116) * lu(476) + lu(481) = lu(481) - lu(117) * lu(476) + lu(487) = lu(487) - lu(118) * lu(476) + lu(491) = lu(491) - lu(119) * lu(476) + lu(493) = - lu(120) * lu(476) + lu(494) = - lu(121) * lu(476) + lu(1081) = lu(1081) - lu(115) * lu(1075) + lu(1094) = lu(1094) - lu(116) * lu(1075) + lu(1096) = lu(1096) - lu(117) * lu(1075) + lu(1110) = lu(1110) - lu(118) * lu(1075) + lu(1120) = lu(1120) - lu(119) * lu(1075) + lu(1122) = lu(1122) - lu(120) * lu(1075) + lu(1124) = - lu(121) * lu(1075) + lu(1524) = - lu(115) * lu(1523) + lu(1531) = lu(1531) - lu(116) * lu(1523) + lu(1536) = - lu(117) * lu(1523) + lu(1549) = lu(1549) - lu(118) * lu(1523) + lu(1559) = lu(1559) - lu(119) * lu(1523) + lu(1561) = lu(1561) - lu(120) * lu(1523) + lu(1563) = lu(1563) - lu(121) * lu(1523) + lu(122) = 1._r8 / lu(122) + lu(123) = lu(123) * lu(122) + lu(124) = lu(124) * lu(122) + lu(125) = lu(125) * lu(122) + lu(126) = lu(126) * lu(122) + lu(127) = lu(127) * lu(122) + lu(128) = lu(128) * lu(122) + lu(1093) = lu(1093) - lu(123) * lu(1076) + lu(1099) = lu(1099) - lu(124) * lu(1076) + lu(1110) = lu(1110) - lu(125) * lu(1076) + lu(1112) = lu(1112) - lu(126) * lu(1076) + lu(1117) = lu(1117) - lu(127) * lu(1076) + lu(1126) = lu(1126) - lu(128) * lu(1076) + lu(1181) = lu(1181) - lu(123) * lu(1172) + lu(1185) = - lu(124) * lu(1172) + lu(1196) = lu(1196) - lu(125) * lu(1172) + lu(1198) = lu(1198) - lu(126) * lu(1172) + lu(1203) = lu(1203) - lu(127) * lu(1172) + lu(1212) = lu(1212) - lu(128) * lu(1172) + lu(1405) = lu(1405) - lu(123) * lu(1396) + lu(1406) = lu(1406) - lu(124) * lu(1396) + lu(1417) = lu(1417) - lu(125) * lu(1396) + lu(1419) = lu(1419) - lu(126) * lu(1396) + lu(1424) = lu(1424) - lu(127) * lu(1396) + lu(1433) = lu(1433) - lu(128) * lu(1396) + lu(1788) = lu(1788) - lu(123) * lu(1784) + lu(1790) = lu(1790) - lu(124) * lu(1784) + lu(1801) = lu(1801) - lu(125) * lu(1784) + lu(1803) = lu(1803) - lu(126) * lu(1784) + lu(1808) = lu(1808) - lu(127) * lu(1784) + lu(1817) = lu(1817) - lu(128) * lu(1784) + lu(129) = 1._r8 / lu(129) + lu(130) = lu(130) * lu(129) + lu(131) = lu(131) * lu(129) + lu(132) = lu(132) * lu(129) + lu(133) = lu(133) * lu(129) + lu(134) = lu(134) * lu(129) + lu(135) = lu(135) * lu(129) + lu(744) = lu(744) - lu(130) * lu(733) + lu(745) = lu(745) - lu(131) * lu(733) + lu(748) = lu(748) - lu(132) * lu(733) + lu(750) = lu(750) - lu(133) * lu(733) + lu(755) = lu(755) - lu(134) * lu(733) + lu(765) = lu(765) - lu(135) * lu(733) + lu(818) = lu(818) - lu(130) * lu(800) + lu(819) = lu(819) - lu(131) * lu(800) + lu(822) = lu(822) - lu(132) * lu(800) + lu(824) = lu(824) - lu(133) * lu(800) + lu(829) = lu(829) - lu(134) * lu(800) + lu(839) = lu(839) - lu(135) * lu(800) + lu(1101) = lu(1101) - lu(130) * lu(1077) + lu(1103) = lu(1103) - lu(131) * lu(1077) + lu(1108) = lu(1108) - lu(132) * lu(1077) + lu(1110) = lu(1110) - lu(133) * lu(1077) + lu(1115) = - lu(134) * lu(1077) + lu(1127) = lu(1127) - lu(135) * lu(1077) + lu(1834) = lu(1834) - lu(130) * lu(1821) + lu(1836) = lu(1836) - lu(131) * lu(1821) + lu(1841) = lu(1841) - lu(132) * lu(1821) + lu(1843) = lu(1843) - lu(133) * lu(1821) + lu(1848) = - lu(134) * lu(1821) + lu(1860) = lu(1860) - lu(135) * lu(1821) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(136) = 1._r8 / lu(136) + lu(137) = lu(137) * lu(136) + lu(138) = lu(138) * lu(136) + lu(139) = lu(139) * lu(136) + lu(140) = lu(140) * lu(136) + lu(141) = lu(141) * lu(136) + lu(178) = lu(178) - lu(137) * lu(176) + lu(180) = lu(180) - lu(138) * lu(176) + lu(181) = lu(181) - lu(139) * lu(176) + lu(183) = lu(183) - lu(140) * lu(176) + lu(184) = - lu(141) * lu(176) + lu(215) = lu(215) - lu(137) * lu(214) + lu(216) = lu(216) - lu(138) * lu(214) + lu(217) = lu(217) - lu(139) * lu(214) + lu(218) = lu(218) - lu(140) * lu(214) + lu(219) = - lu(141) * lu(214) + lu(1138) = lu(1138) - lu(137) * lu(1132) + lu(1146) = lu(1146) - lu(138) * lu(1132) + lu(1151) = lu(1151) - lu(139) * lu(1132) + lu(1155) = lu(1155) - lu(140) * lu(1132) + lu(1156) = lu(1156) - lu(141) * lu(1132) + lu(1306) = lu(1306) - lu(137) * lu(1300) + lu(1329) = lu(1329) - lu(138) * lu(1300) + lu(1334) = lu(1334) - lu(139) * lu(1300) + lu(1338) = lu(1338) - lu(140) * lu(1300) + lu(1339) = lu(1339) - lu(141) * lu(1300) + lu(1353) = - lu(137) * lu(1352) + lu(1372) = lu(1372) - lu(138) * lu(1352) + lu(1377) = lu(1377) - lu(139) * lu(1352) + lu(1381) = lu(1381) - lu(140) * lu(1352) + lu(1382) = lu(1382) - lu(141) * lu(1352) + lu(143) = 1._r8 / lu(143) + lu(144) = lu(144) * lu(143) + lu(145) = lu(145) * lu(143) + lu(146) = lu(146) * lu(143) + lu(147) = lu(147) * lu(143) + lu(148) = lu(148) * lu(143) + lu(149) = lu(149) * lu(143) + lu(150) = lu(150) * lu(143) + lu(151) = lu(151) * lu(143) + lu(152) = lu(152) * lu(143) + lu(1084) = lu(1084) - lu(144) * lu(1078) + lu(1089) = lu(1089) - lu(145) * lu(1078) + lu(1097) = lu(1097) - lu(146) * lu(1078) + lu(1110) = lu(1110) - lu(147) * lu(1078) + lu(1111) = lu(1111) - lu(148) * lu(1078) + lu(1112) = lu(1112) - lu(149) * lu(1078) + lu(1119) = lu(1119) - lu(150) * lu(1078) + lu(1125) = lu(1125) - lu(151) * lu(1078) + lu(1128) = lu(1128) - lu(152) * lu(1078) + lu(1139) = - lu(144) * lu(1133) + lu(1140) = lu(1140) - lu(145) * lu(1133) + lu(1142) = lu(1142) - lu(146) * lu(1133) + lu(1150) = lu(1150) - lu(147) * lu(1133) + lu(1151) = lu(1151) - lu(148) * lu(1133) + lu(1152) = lu(1152) - lu(149) * lu(1133) + lu(1159) = lu(1159) - lu(150) * lu(1133) + lu(1165) = lu(1165) - lu(151) * lu(1133) + lu(1168) = lu(1168) - lu(152) * lu(1133) + lu(1175) = lu(1175) - lu(144) * lu(1173) + lu(1178) = lu(1178) - lu(145) * lu(1173) + lu(1184) = lu(1184) - lu(146) * lu(1173) + lu(1196) = lu(1196) - lu(147) * lu(1173) + lu(1197) = lu(1197) - lu(148) * lu(1173) + lu(1198) = lu(1198) - lu(149) * lu(1173) + lu(1205) = lu(1205) - lu(150) * lu(1173) + lu(1211) = lu(1211) - lu(151) * lu(1173) + lu(1214) = lu(1214) - lu(152) * lu(1173) + lu(153) = 1._r8 / lu(153) + lu(154) = lu(154) * lu(153) + lu(155) = lu(155) * lu(153) + lu(156) = lu(156) * lu(153) + lu(157) = lu(157) * lu(153) + lu(158) = lu(158) * lu(153) + lu(159) = lu(159) * lu(153) + lu(160) = lu(160) * lu(153) + lu(1135) = lu(1135) - lu(154) * lu(1134) + lu(1151) = lu(1151) - lu(155) * lu(1134) + lu(1153) = lu(1153) - lu(156) * lu(1134) + lu(1155) = lu(1155) - lu(157) * lu(1134) + lu(1157) = lu(1157) - lu(158) * lu(1134) + lu(1159) = lu(1159) - lu(159) * lu(1134) + lu(1168) = lu(1168) - lu(160) * lu(1134) + lu(1302) = lu(1302) - lu(154) * lu(1301) + lu(1334) = lu(1334) - lu(155) * lu(1301) + lu(1336) = lu(1336) - lu(156) * lu(1301) + lu(1338) = lu(1338) - lu(157) * lu(1301) + lu(1340) = lu(1340) - lu(158) * lu(1301) + lu(1342) = lu(1342) - lu(159) * lu(1301) + lu(1351) = lu(1351) - lu(160) * lu(1301) + lu(1398) = lu(1398) - lu(154) * lu(1397) + lu(1418) = - lu(155) * lu(1397) + lu(1420) = - lu(156) * lu(1397) + lu(1422) = - lu(157) * lu(1397) + lu(1424) = lu(1424) - lu(158) * lu(1397) + lu(1426) = - lu(159) * lu(1397) + lu(1435) = lu(1435) - lu(160) * lu(1397) + lu(1864) = lu(1864) - lu(154) * lu(1863) + lu(1890) = lu(1890) - lu(155) * lu(1863) + lu(1892) = lu(1892) - lu(156) * lu(1863) + lu(1894) = lu(1894) - lu(157) * lu(1863) + lu(1896) = lu(1896) - lu(158) * lu(1863) + lu(1898) = lu(1898) - lu(159) * lu(1863) + lu(1907) = lu(1907) - lu(160) * lu(1863) + lu(161) = 1._r8 / lu(161) + lu(162) = lu(162) * lu(161) + lu(163) = lu(163) * lu(161) + lu(164) = lu(164) * lu(161) + lu(165) = lu(165) * lu(161) + lu(166) = lu(166) * lu(161) + lu(167) = lu(167) * lu(161) + lu(1151) = lu(1151) - lu(162) * lu(1135) + lu(1153) = lu(1153) - lu(163) * lu(1135) + lu(1155) = lu(1155) - lu(164) * lu(1135) + lu(1157) = lu(1157) - lu(165) * lu(1135) + lu(1159) = lu(1159) - lu(166) * lu(1135) + lu(1168) = lu(1168) - lu(167) * lu(1135) + lu(1334) = lu(1334) - lu(162) * lu(1302) + lu(1336) = lu(1336) - lu(163) * lu(1302) + lu(1338) = lu(1338) - lu(164) * lu(1302) + lu(1340) = lu(1340) - lu(165) * lu(1302) + lu(1342) = lu(1342) - lu(166) * lu(1302) + lu(1351) = lu(1351) - lu(167) * lu(1302) + lu(1418) = lu(1418) - lu(162) * lu(1398) + lu(1420) = lu(1420) - lu(163) * lu(1398) + lu(1422) = lu(1422) - lu(164) * lu(1398) + lu(1424) = lu(1424) - lu(165) * lu(1398) + lu(1426) = lu(1426) - lu(166) * lu(1398) + lu(1435) = lu(1435) - lu(167) * lu(1398) + lu(1890) = lu(1890) - lu(162) * lu(1864) + lu(1892) = lu(1892) - lu(163) * lu(1864) + lu(1894) = lu(1894) - lu(164) * lu(1864) + lu(1896) = lu(1896) - lu(165) * lu(1864) + lu(1898) = lu(1898) - lu(166) * lu(1864) + lu(1907) = lu(1907) - lu(167) * lu(1864) + lu(168) = 1._r8 / lu(168) + lu(169) = lu(169) * lu(168) + lu(170) = lu(170) * lu(168) + lu(171) = lu(171) * lu(168) + lu(172) = lu(172) * lu(168) + lu(173) = lu(173) * lu(168) + lu(174) = lu(174) * lu(168) + lu(353) = lu(353) - lu(169) * lu(351) + lu(357) = lu(357) - lu(170) * lu(351) + lu(358) = lu(358) - lu(171) * lu(351) + lu(359) = lu(359) - lu(172) * lu(351) + lu(360) = lu(360) - lu(173) * lu(351) + lu(361) = lu(361) - lu(174) * lu(351) + lu(812) = lu(812) - lu(169) * lu(801) + lu(819) = lu(819) - lu(170) * lu(801) + lu(820) = lu(820) - lu(171) * lu(801) + lu(823) = lu(823) - lu(172) * lu(801) + lu(824) = lu(824) - lu(173) * lu(801) + lu(826) = lu(826) - lu(174) * lu(801) + lu(1036) = lu(1036) - lu(169) * lu(1032) + lu(1045) = lu(1045) - lu(170) * lu(1032) + lu(1048) = lu(1048) - lu(171) * lu(1032) + lu(1051) = lu(1051) - lu(172) * lu(1032) + lu(1052) = lu(1052) - lu(173) * lu(1032) + lu(1054) = lu(1054) - lu(174) * lu(1032) + lu(1091) = lu(1091) - lu(169) * lu(1079) + lu(1103) = lu(1103) - lu(170) * lu(1079) + lu(1106) = lu(1106) - lu(171) * lu(1079) + lu(1109) = lu(1109) - lu(172) * lu(1079) + lu(1110) = lu(1110) - lu(173) * lu(1079) + lu(1112) = lu(1112) - lu(174) * lu(1079) + lu(1180) = lu(1180) - lu(169) * lu(1174) + lu(1189) = - lu(170) * lu(1174) + lu(1192) = lu(1192) - lu(171) * lu(1174) + lu(1195) = lu(1195) - lu(172) * lu(1174) + lu(1196) = lu(1196) - lu(173) * lu(1174) + lu(1198) = lu(1198) - lu(174) * lu(1174) + lu(177) = 1._r8 / lu(177) + lu(178) = lu(178) * lu(177) + lu(179) = lu(179) * lu(177) + lu(180) = lu(180) * lu(177) + lu(181) = lu(181) * lu(177) + lu(182) = lu(182) * lu(177) + lu(183) = lu(183) * lu(177) + lu(184) = lu(184) * lu(177) + lu(185) = lu(185) * lu(177) + lu(322) = - lu(178) * lu(321) + lu(325) = - lu(179) * lu(321) + lu(326) = - lu(180) * lu(321) + lu(329) = lu(329) - lu(181) * lu(321) + lu(330) = lu(330) - lu(182) * lu(321) + lu(332) = lu(332) - lu(183) * lu(321) + lu(333) = - lu(184) * lu(321) + lu(334) = lu(334) - lu(185) * lu(321) + lu(1138) = lu(1138) - lu(178) * lu(1136) + lu(1144) = lu(1144) - lu(179) * lu(1136) + lu(1146) = lu(1146) - lu(180) * lu(1136) + lu(1151) = lu(1151) - lu(181) * lu(1136) + lu(1152) = lu(1152) - lu(182) * lu(1136) + lu(1155) = lu(1155) - lu(183) * lu(1136) + lu(1156) = lu(1156) - lu(184) * lu(1136) + lu(1165) = lu(1165) - lu(185) * lu(1136) + lu(1306) = lu(1306) - lu(178) * lu(1303) + lu(1326) = lu(1326) - lu(179) * lu(1303) + lu(1329) = lu(1329) - lu(180) * lu(1303) + lu(1334) = lu(1334) - lu(181) * lu(1303) + lu(1335) = lu(1335) - lu(182) * lu(1303) + lu(1338) = lu(1338) - lu(183) * lu(1303) + lu(1339) = lu(1339) - lu(184) * lu(1303) + lu(1348) = lu(1348) - lu(185) * lu(1303) + lu(1739) = - lu(178) * lu(1738) + lu(1758) = lu(1758) - lu(179) * lu(1738) + lu(1761) = - lu(180) * lu(1738) + lu(1766) = lu(1766) - lu(181) * lu(1738) + lu(1767) = lu(1767) - lu(182) * lu(1738) + lu(1770) = lu(1770) - lu(183) * lu(1738) + lu(1771) = - lu(184) * lu(1738) + lu(1780) = lu(1780) - lu(185) * lu(1738) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(186) = 1._r8 / lu(186) + lu(187) = lu(187) * lu(186) + lu(188) = lu(188) * lu(186) + lu(189) = lu(189) * lu(186) + lu(190) = lu(190) * lu(186) + lu(238) = - lu(187) * lu(235) + lu(239) = - lu(188) * lu(235) + lu(240) = - lu(189) * lu(235) + lu(243) = lu(243) - lu(190) * lu(235) + lu(449) = lu(449) - lu(187) * lu(443) + lu(450) = lu(450) - lu(188) * lu(443) + lu(451) = lu(451) - lu(189) * lu(443) + lu(455) = - lu(190) * lu(443) + lu(602) = lu(602) - lu(187) * lu(595) + lu(603) = - lu(188) * lu(595) + lu(604) = - lu(189) * lu(595) + lu(613) = - lu(190) * lu(595) + lu(818) = lu(818) - lu(187) * lu(802) + lu(819) = lu(819) - lu(188) * lu(802) + lu(820) = lu(820) - lu(189) * lu(802) + lu(831) = lu(831) - lu(190) * lu(802) + lu(1101) = lu(1101) - lu(187) * lu(1080) + lu(1103) = lu(1103) - lu(188) * lu(1080) + lu(1106) = lu(1106) - lu(189) * lu(1080) + lu(1117) = lu(1117) - lu(190) * lu(1080) + lu(1408) = - lu(187) * lu(1399) + lu(1410) = - lu(188) * lu(1399) + lu(1413) = - lu(189) * lu(1399) + lu(1424) = lu(1424) - lu(190) * lu(1399) + lu(1628) = lu(1628) - lu(187) * lu(1615) + lu(1630) = lu(1630) - lu(188) * lu(1615) + lu(1632) = - lu(189) * lu(1615) + lu(1643) = - lu(190) * lu(1615) + lu(1834) = lu(1834) - lu(187) * lu(1822) + lu(1836) = lu(1836) - lu(188) * lu(1822) + lu(1839) = lu(1839) - lu(189) * lu(1822) + lu(1850) = lu(1850) - lu(190) * lu(1822) + lu(191) = 1._r8 / lu(191) + lu(192) = lu(192) * lu(191) + lu(193) = lu(193) * lu(191) + lu(194) = lu(194) * lu(191) + lu(195) = lu(195) * lu(191) + lu(771) = - lu(192) * lu(766) + lu(781) = lu(781) - lu(193) * lu(766) + lu(784) = lu(784) - lu(194) * lu(766) + lu(785) = lu(785) - lu(195) * lu(766) + lu(819) = lu(819) - lu(192) * lu(803) + lu(829) = lu(829) - lu(193) * lu(803) + lu(832) = lu(832) - lu(194) * lu(803) + lu(833) = lu(833) - lu(195) * lu(803) + lu(891) = lu(891) - lu(192) * lu(875) + lu(903) = lu(903) - lu(193) * lu(875) + lu(907) = lu(907) - lu(194) * lu(875) + lu(908) = lu(908) - lu(195) * lu(875) + lu(928) = lu(928) - lu(192) * lu(917) + lu(940) = lu(940) - lu(193) * lu(917) + lu(944) = lu(944) - lu(194) * lu(917) + lu(945) = - lu(195) * lu(917) + lu(1005) = lu(1005) - lu(192) * lu(989) + lu(1017) = lu(1017) - lu(193) * lu(989) + lu(1021) = - lu(194) * lu(989) + lu(1022) = - lu(195) * lu(989) + lu(1144) = lu(1144) - lu(192) * lu(1137) + lu(1155) = lu(1155) - lu(193) * lu(1137) + lu(1159) = lu(1159) - lu(194) * lu(1137) + lu(1160) = - lu(195) * lu(1137) + lu(1326) = lu(1326) - lu(192) * lu(1304) + lu(1338) = lu(1338) - lu(193) * lu(1304) + lu(1342) = lu(1342) - lu(194) * lu(1304) + lu(1343) = - lu(195) * lu(1304) + lu(1496) = lu(1496) - lu(192) * lu(1479) + lu(1508) = lu(1508) - lu(193) * lu(1479) + lu(1512) = lu(1512) - lu(194) * lu(1479) + lu(1513) = lu(1513) - lu(195) * lu(1479) + lu(197) = 1._r8 / lu(197) + lu(198) = lu(198) * lu(197) + lu(199) = lu(199) * lu(197) + lu(200) = lu(200) * lu(197) + lu(201) = lu(201) * lu(197) + lu(202) = lu(202) * lu(197) + lu(203) = lu(203) * lu(197) + lu(204) = lu(204) * lu(197) + lu(480) = lu(480) - lu(198) * lu(477) + lu(481) = lu(481) - lu(199) * lu(477) + lu(483) = lu(483) - lu(200) * lu(477) + lu(485) = - lu(201) * lu(477) + lu(487) = lu(487) - lu(202) * lu(477) + lu(489) = - lu(203) * lu(477) + lu(495) = lu(495) - lu(204) * lu(477) + lu(740) = lu(740) - lu(198) * lu(734) + lu(742) = lu(742) - lu(199) * lu(734) + lu(745) = lu(745) - lu(200) * lu(734) + lu(748) = lu(748) - lu(201) * lu(734) + lu(750) = lu(750) - lu(202) * lu(734) + lu(755) = lu(755) - lu(203) * lu(734) + lu(765) = lu(765) - lu(204) * lu(734) + lu(996) = - lu(198) * lu(990) + lu(998) = lu(998) - lu(199) * lu(990) + lu(1005) = lu(1005) - lu(200) * lu(990) + lu(1010) = lu(1010) - lu(201) * lu(990) + lu(1012) = lu(1012) - lu(202) * lu(990) + lu(1017) = lu(1017) - lu(203) * lu(990) + lu(1029) = lu(1029) - lu(204) * lu(990) + lu(1094) = lu(1094) - lu(198) * lu(1081) + lu(1096) = lu(1096) - lu(199) * lu(1081) + lu(1103) = lu(1103) - lu(200) * lu(1081) + lu(1108) = lu(1108) - lu(201) * lu(1081) + lu(1110) = lu(1110) - lu(202) * lu(1081) + lu(1115) = lu(1115) - lu(203) * lu(1081) + lu(1127) = lu(1127) - lu(204) * lu(1081) + lu(1531) = lu(1531) - lu(198) * lu(1524) + lu(1536) = lu(1536) - lu(199) * lu(1524) + lu(1542) = lu(1542) - lu(200) * lu(1524) + lu(1547) = - lu(201) * lu(1524) + lu(1549) = lu(1549) - lu(202) * lu(1524) + lu(1554) = lu(1554) - lu(203) * lu(1524) + lu(1566) = lu(1566) - lu(204) * lu(1524) + lu(206) = 1._r8 / lu(206) + lu(207) = lu(207) * lu(206) + lu(208) = lu(208) * lu(206) + lu(209) = lu(209) * lu(206) + lu(210) = lu(210) * lu(206) + lu(211) = lu(211) * lu(206) + lu(212) = lu(212) * lu(206) + lu(213) = lu(213) * lu(206) + lu(573) = - lu(207) * lu(572) + lu(575) = lu(575) - lu(208) * lu(572) + lu(579) = lu(579) - lu(209) * lu(572) + lu(580) = lu(580) - lu(210) * lu(572) + lu(587) = lu(587) - lu(211) * lu(572) + lu(592) = - lu(212) * lu(572) + lu(593) = - lu(213) * lu(572) + lu(626) = lu(626) - lu(207) * lu(623) + lu(629) = lu(629) - lu(208) * lu(623) + lu(633) = lu(633) - lu(209) * lu(623) + lu(634) = lu(634) - lu(210) * lu(623) + lu(642) = lu(642) - lu(211) * lu(623) + lu(648) = - lu(212) * lu(623) + lu(649) = - lu(213) * lu(623) + lu(810) = lu(810) - lu(207) * lu(804) + lu(815) = lu(815) - lu(208) * lu(804) + lu(819) = lu(819) - lu(209) * lu(804) + lu(820) = lu(820) - lu(210) * lu(804) + lu(829) = lu(829) - lu(211) * lu(804) + lu(835) = lu(835) - lu(212) * lu(804) + lu(836) = lu(836) - lu(213) * lu(804) + lu(1308) = - lu(207) * lu(1305) + lu(1319) = lu(1319) - lu(208) * lu(1305) + lu(1326) = lu(1326) - lu(209) * lu(1305) + lu(1329) = lu(1329) - lu(210) * lu(1305) + lu(1338) = lu(1338) - lu(211) * lu(1305) + lu(1345) = - lu(212) * lu(1305) + lu(1347) = lu(1347) - lu(213) * lu(1305) + lu(1700) = - lu(207) * lu(1699) + lu(1705) = - lu(208) * lu(1699) + lu(1712) = lu(1712) - lu(209) * lu(1699) + lu(1715) = lu(1715) - lu(210) * lu(1699) + lu(1724) = lu(1724) - lu(211) * lu(1699) + lu(1731) = lu(1731) - lu(212) * lu(1699) + lu(1733) = lu(1733) - lu(213) * lu(1699) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(215) = 1._r8 / lu(215) + lu(216) = lu(216) * lu(215) + lu(217) = lu(217) * lu(215) + lu(218) = lu(218) * lu(215) + lu(219) = lu(219) * lu(215) + lu(326) = lu(326) - lu(216) * lu(322) + lu(329) = lu(329) - lu(217) * lu(322) + lu(332) = lu(332) - lu(218) * lu(322) + lu(333) = lu(333) - lu(219) * lu(322) + lu(746) = lu(746) - lu(216) * lu(735) + lu(751) = - lu(217) * lu(735) + lu(755) = lu(755) - lu(218) * lu(735) + lu(756) = - lu(219) * lu(735) + lu(820) = lu(820) - lu(216) * lu(805) + lu(825) = - lu(217) * lu(805) + lu(829) = lu(829) - lu(218) * lu(805) + lu(830) = - lu(219) * lu(805) + lu(931) = lu(931) - lu(216) * lu(918) + lu(936) = lu(936) - lu(217) * lu(918) + lu(940) = lu(940) - lu(218) * lu(918) + lu(941) = - lu(219) * lu(918) + lu(1146) = lu(1146) - lu(216) * lu(1138) + lu(1151) = lu(1151) - lu(217) * lu(1138) + lu(1155) = lu(1155) - lu(218) * lu(1138) + lu(1156) = lu(1156) - lu(219) * lu(1138) + lu(1234) = lu(1234) - lu(216) * lu(1215) + lu(1239) = lu(1239) - lu(217) * lu(1215) + lu(1243) = lu(1243) - lu(218) * lu(1215) + lu(1244) = - lu(219) * lu(1215) + lu(1329) = lu(1329) - lu(216) * lu(1306) + lu(1334) = lu(1334) - lu(217) * lu(1306) + lu(1338) = lu(1338) - lu(218) * lu(1306) + lu(1339) = lu(1339) - lu(219) * lu(1306) + lu(1372) = lu(1372) - lu(216) * lu(1353) + lu(1377) = lu(1377) - lu(217) * lu(1353) + lu(1381) = lu(1381) - lu(218) * lu(1353) + lu(1382) = lu(1382) - lu(219) * lu(1353) + lu(1761) = lu(1761) - lu(216) * lu(1739) + lu(1766) = lu(1766) - lu(217) * lu(1739) + lu(1770) = lu(1770) - lu(218) * lu(1739) + lu(1771) = lu(1771) - lu(219) * lu(1739) + lu(220) = 1._r8 / lu(220) + lu(221) = lu(221) * lu(220) + lu(222) = lu(222) * lu(220) + lu(223) = lu(223) * lu(220) + lu(224) = lu(224) * lu(220) + lu(225) = lu(225) * lu(220) + lu(226) = lu(226) * lu(220) + lu(447) = lu(447) - lu(221) * lu(444) + lu(448) = - lu(222) * lu(444) + lu(450) = lu(450) - lu(223) * lu(444) + lu(451) = lu(451) - lu(224) * lu(444) + lu(453) = lu(453) - lu(225) * lu(444) + lu(454) = lu(454) - lu(226) * lu(444) + lu(600) = lu(600) - lu(221) * lu(596) + lu(601) = - lu(222) * lu(596) + lu(603) = lu(603) - lu(223) * lu(596) + lu(604) = lu(604) - lu(224) * lu(596) + lu(608) = - lu(225) * lu(596) + lu(612) = - lu(226) * lu(596) + lu(630) = lu(630) - lu(221) * lu(624) + lu(631) = lu(631) - lu(222) * lu(624) + lu(633) = lu(633) - lu(223) * lu(624) + lu(634) = lu(634) - lu(224) * lu(624) + lu(638) = lu(638) - lu(225) * lu(624) + lu(642) = lu(642) - lu(226) * lu(624) + lu(742) = lu(742) - lu(221) * lu(736) + lu(743) = - lu(222) * lu(736) + lu(745) = lu(745) - lu(223) * lu(736) + lu(746) = lu(746) - lu(224) * lu(736) + lu(750) = lu(750) - lu(225) * lu(736) + lu(755) = lu(755) - lu(226) * lu(736) + lu(816) = lu(816) - lu(221) * lu(806) + lu(817) = lu(817) - lu(222) * lu(806) + lu(819) = lu(819) - lu(223) * lu(806) + lu(820) = lu(820) - lu(224) * lu(806) + lu(824) = lu(824) - lu(225) * lu(806) + lu(829) = lu(829) - lu(226) * lu(806) + lu(1096) = lu(1096) - lu(221) * lu(1082) + lu(1097) = lu(1097) - lu(222) * lu(1082) + lu(1103) = lu(1103) - lu(223) * lu(1082) + lu(1106) = lu(1106) - lu(224) * lu(1082) + lu(1110) = lu(1110) - lu(225) * lu(1082) + lu(1115) = lu(1115) - lu(226) * lu(1082) + lu(228) = 1._r8 / lu(228) + lu(229) = lu(229) * lu(228) + lu(230) = lu(230) * lu(228) + lu(231) = lu(231) * lu(228) + lu(232) = lu(232) * lu(228) + lu(233) = lu(233) * lu(228) + lu(234) = lu(234) * lu(228) + lu(256) = lu(256) - lu(229) * lu(254) + lu(257) = lu(257) - lu(230) * lu(254) + lu(258) = lu(258) - lu(231) * lu(254) + lu(259) = - lu(232) * lu(254) + lu(261) = lu(261) - lu(233) * lu(254) + lu(264) = lu(264) - lu(234) * lu(254) + lu(745) = lu(745) - lu(229) * lu(737) + lu(748) = lu(748) - lu(230) * lu(737) + lu(750) = lu(750) - lu(231) * lu(737) + lu(755) = lu(755) - lu(232) * lu(737) + lu(760) = lu(760) - lu(233) * lu(737) + lu(765) = lu(765) - lu(234) * lu(737) + lu(819) = lu(819) - lu(229) * lu(807) + lu(822) = lu(822) - lu(230) * lu(807) + lu(824) = lu(824) - lu(231) * lu(807) + lu(829) = lu(829) - lu(232) * lu(807) + lu(834) = lu(834) - lu(233) * lu(807) + lu(839) = lu(839) - lu(234) * lu(807) + lu(1005) = lu(1005) - lu(229) * lu(991) + lu(1010) = lu(1010) - lu(230) * lu(991) + lu(1012) = lu(1012) - lu(231) * lu(991) + lu(1017) = lu(1017) - lu(232) * lu(991) + lu(1023) = - lu(233) * lu(991) + lu(1029) = lu(1029) - lu(234) * lu(991) + lu(1103) = lu(1103) - lu(229) * lu(1083) + lu(1108) = lu(1108) - lu(230) * lu(1083) + lu(1110) = lu(1110) - lu(231) * lu(1083) + lu(1115) = lu(1115) - lu(232) * lu(1083) + lu(1121) = lu(1121) - lu(233) * lu(1083) + lu(1127) = lu(1127) - lu(234) * lu(1083) + lu(1588) = lu(1588) - lu(229) * lu(1572) + lu(1593) = lu(1593) - lu(230) * lu(1572) + lu(1595) = lu(1595) - lu(231) * lu(1572) + lu(1600) = - lu(232) * lu(1572) + lu(1606) = lu(1606) - lu(233) * lu(1572) + lu(1612) = lu(1612) - lu(234) * lu(1572) + lu(1836) = lu(1836) - lu(229) * lu(1823) + lu(1841) = lu(1841) - lu(230) * lu(1823) + lu(1843) = lu(1843) - lu(231) * lu(1823) + lu(1848) = lu(1848) - lu(232) * lu(1823) + lu(1854) = lu(1854) - lu(233) * lu(1823) + lu(1860) = lu(1860) - lu(234) * lu(1823) + lu(236) = 1._r8 / lu(236) + lu(237) = lu(237) * lu(236) + lu(238) = lu(238) * lu(236) + lu(239) = lu(239) * lu(236) + lu(240) = lu(240) * lu(236) + lu(241) = lu(241) * lu(236) + lu(242) = lu(242) * lu(236) + lu(243) = lu(243) * lu(236) + lu(244) = lu(244) * lu(236) + lu(245) = lu(245) * lu(236) + lu(309) = lu(309) - lu(237) * lu(308) + lu(310) = - lu(238) * lu(308) + lu(311) = lu(311) - lu(239) * lu(308) + lu(312) = lu(312) - lu(240) * lu(308) + lu(313) = lu(313) - lu(241) * lu(308) + lu(315) = lu(315) - lu(242) * lu(308) + lu(316) = - lu(243) * lu(308) + lu(319) = lu(319) - lu(244) * lu(308) + lu(320) = lu(320) - lu(245) * lu(308) + lu(1089) = lu(1089) - lu(237) * lu(1084) + lu(1101) = lu(1101) - lu(238) * lu(1084) + lu(1103) = lu(1103) - lu(239) * lu(1084) + lu(1106) = lu(1106) - lu(240) * lu(1084) + lu(1110) = lu(1110) - lu(241) * lu(1084) + lu(1112) = lu(1112) - lu(242) * lu(1084) + lu(1117) = lu(1117) - lu(243) * lu(1084) + lu(1125) = lu(1125) - lu(244) * lu(1084) + lu(1128) = lu(1128) - lu(245) * lu(1084) + lu(1140) = lu(1140) - lu(237) * lu(1139) + lu(1143) = - lu(238) * lu(1139) + lu(1144) = lu(1144) - lu(239) * lu(1139) + lu(1146) = lu(1146) - lu(240) * lu(1139) + lu(1150) = lu(1150) - lu(241) * lu(1139) + lu(1152) = lu(1152) - lu(242) * lu(1139) + lu(1157) = lu(1157) - lu(243) * lu(1139) + lu(1165) = lu(1165) - lu(244) * lu(1139) + lu(1168) = lu(1168) - lu(245) * lu(1139) + lu(1178) = lu(1178) - lu(237) * lu(1175) + lu(1187) = lu(1187) - lu(238) * lu(1175) + lu(1189) = lu(1189) - lu(239) * lu(1175) + lu(1192) = lu(1192) - lu(240) * lu(1175) + lu(1196) = lu(1196) - lu(241) * lu(1175) + lu(1198) = lu(1198) - lu(242) * lu(1175) + lu(1203) = lu(1203) - lu(243) * lu(1175) + lu(1211) = lu(1211) - lu(244) * lu(1175) + lu(1214) = lu(1214) - lu(245) * lu(1175) + lu(1402) = - lu(237) * lu(1400) + lu(1408) = lu(1408) - lu(238) * lu(1400) + lu(1410) = lu(1410) - lu(239) * lu(1400) + lu(1413) = lu(1413) - lu(240) * lu(1400) + lu(1417) = lu(1417) - lu(241) * lu(1400) + lu(1419) = lu(1419) - lu(242) * lu(1400) + lu(1424) = lu(1424) - lu(243) * lu(1400) + lu(1432) = lu(1432) - lu(244) * lu(1400) + lu(1435) = lu(1435) - lu(245) * lu(1400) + lu(247) = 1._r8 / lu(247) + lu(248) = lu(248) * lu(247) + lu(249) = lu(249) * lu(247) + lu(250) = lu(250) * lu(247) + lu(251) = lu(251) * lu(247) + lu(252) = lu(252) * lu(247) + lu(353) = lu(353) - lu(248) * lu(352) + lu(356) = - lu(249) * lu(352) + lu(357) = lu(357) - lu(250) * lu(352) + lu(360) = lu(360) - lu(251) * lu(352) + lu(362) = - lu(252) * lu(352) + lu(479) = lu(479) - lu(248) * lu(478) + lu(482) = lu(482) - lu(249) * lu(478) + lu(483) = lu(483) - lu(250) * lu(478) + lu(487) = lu(487) - lu(251) * lu(478) + lu(489) = lu(489) - lu(252) * lu(478) + lu(812) = lu(812) - lu(248) * lu(808) + lu(818) = lu(818) - lu(249) * lu(808) + lu(819) = lu(819) - lu(250) * lu(808) + lu(824) = lu(824) - lu(251) * lu(808) + lu(829) = lu(829) - lu(252) * lu(808) + lu(1036) = lu(1036) - lu(248) * lu(1033) + lu(1043) = lu(1043) - lu(249) * lu(1033) + lu(1045) = lu(1045) - lu(250) * lu(1033) + lu(1052) = lu(1052) - lu(251) * lu(1033) + lu(1057) = - lu(252) * lu(1033) + lu(1091) = lu(1091) - lu(248) * lu(1085) + lu(1101) = lu(1101) - lu(249) * lu(1085) + lu(1103) = lu(1103) - lu(250) * lu(1085) + lu(1110) = lu(1110) - lu(251) * lu(1085) + lu(1115) = lu(1115) - lu(252) * lu(1085) + lu(1180) = lu(1180) - lu(248) * lu(1176) + lu(1187) = lu(1187) - lu(249) * lu(1176) + lu(1189) = lu(1189) - lu(250) * lu(1176) + lu(1196) = lu(1196) - lu(251) * lu(1176) + lu(1201) = - lu(252) * lu(1176) + lu(1310) = - lu(248) * lu(1307) + lu(1324) = - lu(249) * lu(1307) + lu(1326) = lu(1326) - lu(250) * lu(1307) + lu(1333) = lu(1333) - lu(251) * lu(1307) + lu(1338) = lu(1338) - lu(252) * lu(1307) + lu(1529) = lu(1529) - lu(248) * lu(1525) + lu(1540) = lu(1540) - lu(249) * lu(1525) + lu(1542) = lu(1542) - lu(250) * lu(1525) + lu(1549) = lu(1549) - lu(251) * lu(1525) + lu(1554) = lu(1554) - lu(252) * lu(1525) + lu(1577) = lu(1577) - lu(248) * lu(1573) + lu(1586) = lu(1586) - lu(249) * lu(1573) + lu(1588) = lu(1588) - lu(250) * lu(1573) + lu(1595) = lu(1595) - lu(251) * lu(1573) + lu(1600) = lu(1600) - lu(252) * lu(1573) + lu(1618) = - lu(248) * lu(1616) + lu(1628) = lu(1628) - lu(249) * lu(1616) + lu(1630) = lu(1630) - lu(250) * lu(1616) + lu(1636) = lu(1636) - lu(251) * lu(1616) + lu(1641) = - lu(252) * lu(1616) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(255) = 1._r8 / lu(255) + lu(256) = lu(256) * lu(255) + lu(257) = lu(257) * lu(255) + lu(258) = lu(258) * lu(255) + lu(259) = lu(259) * lu(255) + lu(260) = lu(260) * lu(255) + lu(261) = lu(261) * lu(255) + lu(262) = lu(262) * lu(255) + lu(263) = lu(263) * lu(255) + lu(264) = lu(264) * lu(255) + lu(819) = lu(819) - lu(256) * lu(809) + lu(822) = lu(822) - lu(257) * lu(809) + lu(824) = lu(824) - lu(258) * lu(809) + lu(829) = lu(829) - lu(259) * lu(809) + lu(833) = lu(833) - lu(260) * lu(809) + lu(834) = lu(834) - lu(261) * lu(809) + lu(835) = lu(835) - lu(262) * lu(809) + lu(836) = lu(836) - lu(263) * lu(809) + lu(839) = lu(839) - lu(264) * lu(809) + lu(1005) = lu(1005) - lu(256) * lu(992) + lu(1010) = lu(1010) - lu(257) * lu(992) + lu(1012) = lu(1012) - lu(258) * lu(992) + lu(1017) = lu(1017) - lu(259) * lu(992) + lu(1022) = lu(1022) - lu(260) * lu(992) + lu(1023) = lu(1023) - lu(261) * lu(992) + lu(1024) = - lu(262) * lu(992) + lu(1026) = lu(1026) - lu(263) * lu(992) + lu(1029) = lu(1029) - lu(264) * lu(992) + lu(1103) = lu(1103) - lu(256) * lu(1086) + lu(1108) = lu(1108) - lu(257) * lu(1086) + lu(1110) = lu(1110) - lu(258) * lu(1086) + lu(1115) = lu(1115) - lu(259) * lu(1086) + lu(1120) = lu(1120) - lu(260) * lu(1086) + lu(1121) = lu(1121) - lu(261) * lu(1086) + lu(1122) = lu(1122) - lu(262) * lu(1086) + lu(1124) = lu(1124) - lu(263) * lu(1086) + lu(1127) = lu(1127) - lu(264) * lu(1086) + lu(1542) = lu(1542) - lu(256) * lu(1526) + lu(1547) = lu(1547) - lu(257) * lu(1526) + lu(1549) = lu(1549) - lu(258) * lu(1526) + lu(1554) = lu(1554) - lu(259) * lu(1526) + lu(1559) = lu(1559) - lu(260) * lu(1526) + lu(1560) = lu(1560) - lu(261) * lu(1526) + lu(1561) = lu(1561) - lu(262) * lu(1526) + lu(1563) = lu(1563) - lu(263) * lu(1526) + lu(1566) = lu(1566) - lu(264) * lu(1526) + lu(1588) = lu(1588) - lu(256) * lu(1574) + lu(1593) = lu(1593) - lu(257) * lu(1574) + lu(1595) = lu(1595) - lu(258) * lu(1574) + lu(1600) = lu(1600) - lu(259) * lu(1574) + lu(1605) = lu(1605) - lu(260) * lu(1574) + lu(1606) = lu(1606) - lu(261) * lu(1574) + lu(1607) = lu(1607) - lu(262) * lu(1574) + lu(1609) = - lu(263) * lu(1574) + lu(1612) = lu(1612) - lu(264) * lu(1574) + lu(1836) = lu(1836) - lu(256) * lu(1824) + lu(1841) = lu(1841) - lu(257) * lu(1824) + lu(1843) = lu(1843) - lu(258) * lu(1824) + lu(1848) = lu(1848) - lu(259) * lu(1824) + lu(1853) = lu(1853) - lu(260) * lu(1824) + lu(1854) = lu(1854) - lu(261) * lu(1824) + lu(1855) = lu(1855) - lu(262) * lu(1824) + lu(1857) = - lu(263) * lu(1824) + lu(1860) = lu(1860) - lu(264) * lu(1824) + lu(265) = 1._r8 / lu(265) + lu(266) = lu(266) * lu(265) + lu(267) = lu(267) * lu(265) + lu(268) = lu(268) * lu(265) + lu(269) = lu(269) * lu(265) + lu(270) = lu(270) * lu(265) + lu(271) = lu(271) * lu(265) + lu(272) = lu(272) * lu(265) + lu(676) = lu(676) - lu(266) * lu(674) + lu(680) = - lu(267) * lu(674) + lu(688) = lu(688) - lu(268) * lu(674) + lu(690) = lu(690) - lu(269) * lu(674) + lu(697) = lu(697) - lu(270) * lu(674) + lu(698) = - lu(271) * lu(674) + lu(704) = lu(704) - lu(272) * lu(674) + lu(845) = lu(845) - lu(266) * lu(841) + lu(847) = lu(847) - lu(267) * lu(841) + lu(855) = lu(855) - lu(268) * lu(841) + lu(857) = lu(857) - lu(269) * lu(841) + lu(864) = lu(864) - lu(270) * lu(841) + lu(865) = lu(865) - lu(271) * lu(841) + lu(872) = lu(872) - lu(272) * lu(841) + lu(957) = lu(957) - lu(266) * lu(954) + lu(960) = lu(960) - lu(267) * lu(954) + lu(968) = lu(968) - lu(268) * lu(954) + lu(970) = - lu(269) * lu(954) + lu(977) = - lu(270) * lu(954) + lu(978) = lu(978) - lu(271) * lu(954) + lu(985) = lu(985) - lu(272) * lu(954) + lu(1098) = lu(1098) - lu(266) * lu(1087) + lu(1102) = lu(1102) - lu(267) * lu(1087) + lu(1110) = lu(1110) - lu(268) * lu(1087) + lu(1112) = lu(1112) - lu(269) * lu(1087) + lu(1119) = lu(1119) - lu(270) * lu(1087) + lu(1120) = lu(1120) - lu(271) * lu(1087) + lu(1127) = lu(1127) - lu(272) * lu(1087) + lu(1492) = lu(1492) - lu(266) * lu(1480) + lu(1495) = lu(1495) - lu(267) * lu(1480) + lu(1503) = lu(1503) - lu(268) * lu(1480) + lu(1505) = lu(1505) - lu(269) * lu(1480) + lu(1512) = lu(1512) - lu(270) * lu(1480) + lu(1513) = lu(1513) - lu(271) * lu(1480) + lu(1520) = lu(1520) - lu(272) * lu(1480) + lu(1583) = lu(1583) - lu(266) * lu(1575) + lu(1587) = lu(1587) - lu(267) * lu(1575) + lu(1595) = lu(1595) - lu(268) * lu(1575) + lu(1597) = lu(1597) - lu(269) * lu(1575) + lu(1604) = lu(1604) - lu(270) * lu(1575) + lu(1605) = lu(1605) - lu(271) * lu(1575) + lu(1612) = lu(1612) - lu(272) * lu(1575) + lu(1789) = lu(1789) - lu(266) * lu(1785) + lu(1793) = lu(1793) - lu(267) * lu(1785) + lu(1801) = lu(1801) - lu(268) * lu(1785) + lu(1803) = lu(1803) - lu(269) * lu(1785) + lu(1810) = lu(1810) - lu(270) * lu(1785) + lu(1811) = lu(1811) - lu(271) * lu(1785) + lu(1818) = lu(1818) - lu(272) * lu(1785) + lu(1831) = lu(1831) - lu(266) * lu(1825) + lu(1835) = lu(1835) - lu(267) * lu(1825) + lu(1843) = lu(1843) - lu(268) * lu(1825) + lu(1845) = lu(1845) - lu(269) * lu(1825) + lu(1852) = - lu(270) * lu(1825) + lu(1853) = lu(1853) - lu(271) * lu(1825) + lu(1860) = lu(1860) - lu(272) * lu(1825) + lu(273) = 1._r8 / lu(273) + lu(274) = lu(274) * lu(273) + lu(275) = lu(275) * lu(273) + lu(276) = lu(276) * lu(273) + lu(277) = lu(277) * lu(273) + lu(278) = lu(278) * lu(273) + lu(279) = lu(279) * lu(273) + lu(280) = lu(280) * lu(273) + lu(324) = lu(324) - lu(274) * lu(323) + lu(327) = lu(327) - lu(275) * lu(323) + lu(329) = lu(329) - lu(276) * lu(323) + lu(330) = lu(330) - lu(277) * lu(323) + lu(331) = - lu(278) * lu(323) + lu(334) = lu(334) - lu(279) * lu(323) + lu(335) = - lu(280) * lu(323) + lu(627) = - lu(274) * lu(625) + lu(637) = lu(637) - lu(275) * lu(625) + lu(639) = - lu(276) * lu(625) + lu(640) = lu(640) - lu(277) * lu(625) + lu(641) = - lu(278) * lu(625) + lu(650) = - lu(279) * lu(625) + lu(651) = - lu(280) * lu(625) + lu(1035) = - lu(274) * lu(1034) + lu(1051) = lu(1051) - lu(275) * lu(1034) + lu(1053) = lu(1053) - lu(276) * lu(1034) + lu(1054) = lu(1054) - lu(277) * lu(1034) + lu(1056) = lu(1056) - lu(278) * lu(1034) + lu(1067) = - lu(279) * lu(1034) + lu(1068) = lu(1068) - lu(280) * lu(1034) + lu(1090) = lu(1090) - lu(274) * lu(1088) + lu(1109) = lu(1109) - lu(275) * lu(1088) + lu(1111) = lu(1111) - lu(276) * lu(1088) + lu(1112) = lu(1112) - lu(277) * lu(1088) + lu(1114) = lu(1114) - lu(278) * lu(1088) + lu(1125) = lu(1125) - lu(279) * lu(1088) + lu(1126) = lu(1126) - lu(280) * lu(1088) + lu(1179) = lu(1179) - lu(274) * lu(1177) + lu(1195) = lu(1195) - lu(275) * lu(1177) + lu(1197) = lu(1197) - lu(276) * lu(1177) + lu(1198) = lu(1198) - lu(277) * lu(1177) + lu(1200) = lu(1200) - lu(278) * lu(1177) + lu(1211) = lu(1211) - lu(279) * lu(1177) + lu(1212) = lu(1212) - lu(280) * lu(1177) + lu(1258) = - lu(274) * lu(1257) + lu(1273) = lu(1273) - lu(275) * lu(1257) + lu(1275) = lu(1275) - lu(276) * lu(1257) + lu(1276) = lu(1276) - lu(277) * lu(1257) + lu(1278) = lu(1278) - lu(278) * lu(1257) + lu(1289) = - lu(279) * lu(1257) + lu(1290) = - lu(280) * lu(1257) + lu(1403) = - lu(274) * lu(1401) + lu(1416) = - lu(275) * lu(1401) + lu(1418) = lu(1418) - lu(276) * lu(1401) + lu(1419) = lu(1419) - lu(277) * lu(1401) + lu(1421) = lu(1421) - lu(278) * lu(1401) + lu(1432) = lu(1432) - lu(279) * lu(1401) + lu(1433) = lu(1433) - lu(280) * lu(1401) + lu(1787) = - lu(274) * lu(1786) + lu(1800) = lu(1800) - lu(275) * lu(1786) + lu(1802) = lu(1802) - lu(276) * lu(1786) + lu(1803) = lu(1803) - lu(277) * lu(1786) + lu(1805) = lu(1805) - lu(278) * lu(1786) + lu(1816) = lu(1816) - lu(279) * lu(1786) + lu(1817) = lu(1817) - lu(280) * lu(1786) + lu(283) = 1._r8 / lu(283) + lu(284) = lu(284) * lu(283) + lu(285) = lu(285) * lu(283) + lu(286) = lu(286) * lu(283) + lu(287) = lu(287) * lu(283) + lu(288) = lu(288) * lu(283) + lu(289) = lu(289) * lu(283) + lu(290) = lu(290) * lu(283) + lu(291) = lu(291) * lu(283) + lu(292) = lu(292) * lu(283) + lu(293) = lu(293) * lu(283) + lu(294) = lu(294) * lu(283) + lu(511) = lu(511) - lu(284) * lu(510) + lu(512) = lu(512) - lu(285) * lu(510) + lu(513) = lu(513) - lu(286) * lu(510) + lu(517) = - lu(287) * lu(510) + lu(520) = lu(520) - lu(288) * lu(510) + lu(522) = lu(522) - lu(289) * lu(510) + lu(523) = lu(523) - lu(290) * lu(510) + lu(524) = - lu(291) * lu(510) + lu(525) = lu(525) - lu(292) * lu(510) + lu(526) = lu(526) - lu(293) * lu(510) + lu(527) = lu(527) - lu(294) * lu(510) + lu(552) = lu(552) - lu(284) * lu(551) + lu(553) = lu(553) - lu(285) * lu(551) + lu(554) = lu(554) - lu(286) * lu(551) + lu(558) = - lu(287) * lu(551) + lu(561) = lu(561) - lu(288) * lu(551) + lu(563) = lu(563) - lu(289) * lu(551) + lu(564) = lu(564) - lu(290) * lu(551) + lu(565) = - lu(291) * lu(551) + lu(566) = lu(566) - lu(292) * lu(551) + lu(567) = lu(567) - lu(293) * lu(551) + lu(568) = lu(568) - lu(294) * lu(551) + lu(1444) = lu(1444) - lu(284) * lu(1437) + lu(1445) = lu(1445) - lu(285) * lu(1437) + lu(1447) = lu(1447) - lu(286) * lu(1437) + lu(1460) = lu(1460) - lu(287) * lu(1437) + lu(1465) = lu(1465) - lu(288) * lu(1437) + lu(1468) = lu(1468) - lu(289) * lu(1437) + lu(1469) = - lu(290) * lu(1437) + lu(1470) = lu(1470) - lu(291) * lu(1437) + lu(1472) = lu(1472) - lu(292) * lu(1437) + lu(1473) = lu(1473) - lu(293) * lu(1437) + lu(1474) = lu(1474) - lu(294) * lu(1437) + lu(1532) = - lu(284) * lu(1527) + lu(1533) = - lu(285) * lu(1527) + lu(1535) = lu(1535) - lu(286) * lu(1527) + lu(1549) = lu(1549) - lu(287) * lu(1527) + lu(1554) = lu(1554) - lu(288) * lu(1527) + lu(1557) = - lu(289) * lu(1527) + lu(1558) = lu(1558) - lu(290) * lu(1527) + lu(1559) = lu(1559) - lu(291) * lu(1527) + lu(1561) = lu(1561) - lu(292) * lu(1527) + lu(1562) = - lu(293) * lu(1527) + lu(1563) = lu(1563) - lu(294) * lu(1527) + lu(1621) = - lu(284) * lu(1617) + lu(1622) = - lu(285) * lu(1617) + lu(1623) = - lu(286) * lu(1617) + lu(1636) = lu(1636) - lu(287) * lu(1617) + lu(1641) = lu(1641) - lu(288) * lu(1617) + lu(1644) = - lu(289) * lu(1617) + lu(1645) = lu(1645) - lu(290) * lu(1617) + lu(1646) = lu(1646) - lu(291) * lu(1617) + lu(1648) = lu(1648) - lu(292) * lu(1617) + lu(1649) = - lu(293) * lu(1617) + lu(1650) = lu(1650) - lu(294) * lu(1617) + lu(1663) = lu(1663) - lu(284) * lu(1656) + lu(1664) = lu(1664) - lu(285) * lu(1656) + lu(1666) = lu(1666) - lu(286) * lu(1656) + lu(1679) = lu(1679) - lu(287) * lu(1656) + lu(1684) = lu(1684) - lu(288) * lu(1656) + lu(1687) = lu(1687) - lu(289) * lu(1656) + lu(1688) = - lu(290) * lu(1656) + lu(1689) = lu(1689) - lu(291) * lu(1656) + lu(1691) = lu(1691) - lu(292) * lu(1656) + lu(1692) = lu(1692) - lu(293) * lu(1656) + lu(1693) = lu(1693) - lu(294) * lu(1656) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(296) = 1._r8 / lu(296) + lu(297) = lu(297) * lu(296) + lu(298) = lu(298) * lu(296) + lu(299) = lu(299) * lu(296) + lu(300) = lu(300) * lu(296) + lu(301) = lu(301) * lu(296) + lu(302) = lu(302) * lu(296) + lu(303) = lu(303) * lu(296) + lu(304) = lu(304) * lu(296) + lu(305) = lu(305) * lu(296) + lu(306) = lu(306) * lu(296) + lu(574) = - lu(297) * lu(573) + lu(578) = - lu(298) * lu(573) + lu(579) = lu(579) - lu(299) * lu(573) + lu(580) = lu(580) - lu(300) * lu(573) + lu(585) = - lu(301) * lu(573) + lu(587) = lu(587) - lu(302) * lu(573) + lu(589) = - lu(303) * lu(573) + lu(590) = - lu(304) * lu(573) + lu(591) = - lu(305) * lu(573) + lu(594) = lu(594) - lu(306) * lu(573) + lu(628) = lu(628) - lu(297) * lu(626) + lu(632) = lu(632) - lu(298) * lu(626) + lu(633) = lu(633) - lu(299) * lu(626) + lu(634) = lu(634) - lu(300) * lu(626) + lu(640) = lu(640) - lu(301) * lu(626) + lu(642) = lu(642) - lu(302) * lu(626) + lu(645) = lu(645) - lu(303) * lu(626) + lu(646) = - lu(304) * lu(626) + lu(647) = - lu(305) * lu(626) + lu(652) = lu(652) - lu(306) * lu(626) + lu(739) = lu(739) - lu(297) * lu(738) + lu(744) = lu(744) - lu(298) * lu(738) + lu(745) = lu(745) - lu(299) * lu(738) + lu(746) = lu(746) - lu(300) * lu(738) + lu(752) = lu(752) - lu(301) * lu(738) + lu(755) = lu(755) - lu(302) * lu(738) + lu(758) = lu(758) - lu(303) * lu(738) + lu(759) = lu(759) - lu(304) * lu(738) + lu(760) = lu(760) - lu(305) * lu(738) + lu(765) = lu(765) - lu(306) * lu(738) + lu(813) = lu(813) - lu(297) * lu(810) + lu(818) = lu(818) - lu(298) * lu(810) + lu(819) = lu(819) - lu(299) * lu(810) + lu(820) = lu(820) - lu(300) * lu(810) + lu(826) = lu(826) - lu(301) * lu(810) + lu(829) = lu(829) - lu(302) * lu(810) + lu(832) = lu(832) - lu(303) * lu(810) + lu(833) = lu(833) - lu(304) * lu(810) + lu(834) = lu(834) - lu(305) * lu(810) + lu(839) = lu(839) - lu(306) * lu(810) + lu(1314) = - lu(297) * lu(1308) + lu(1324) = lu(1324) - lu(298) * lu(1308) + lu(1326) = lu(1326) - lu(299) * lu(1308) + lu(1329) = lu(1329) - lu(300) * lu(1308) + lu(1335) = lu(1335) - lu(301) * lu(1308) + lu(1338) = lu(1338) - lu(302) * lu(1308) + lu(1342) = lu(1342) - lu(303) * lu(1308) + lu(1343) = lu(1343) - lu(304) * lu(1308) + lu(1344) = - lu(305) * lu(1308) + lu(1350) = - lu(306) * lu(1308) + lu(1484) = lu(1484) - lu(297) * lu(1481) + lu(1494) = lu(1494) - lu(298) * lu(1481) + lu(1496) = lu(1496) - lu(299) * lu(1481) + lu(1499) = lu(1499) - lu(300) * lu(1481) + lu(1505) = lu(1505) - lu(301) * lu(1481) + lu(1508) = lu(1508) - lu(302) * lu(1481) + lu(1512) = lu(1512) - lu(303) * lu(1481) + lu(1513) = lu(1513) - lu(304) * lu(1481) + lu(1514) = lu(1514) - lu(305) * lu(1481) + lu(1520) = lu(1520) - lu(306) * lu(1481) + lu(1578) = lu(1578) - lu(297) * lu(1576) + lu(1586) = lu(1586) - lu(298) * lu(1576) + lu(1588) = lu(1588) - lu(299) * lu(1576) + lu(1591) = - lu(300) * lu(1576) + lu(1597) = lu(1597) - lu(301) * lu(1576) + lu(1600) = lu(1600) - lu(302) * lu(1576) + lu(1604) = lu(1604) - lu(303) * lu(1576) + lu(1605) = lu(1605) - lu(304) * lu(1576) + lu(1606) = lu(1606) - lu(305) * lu(1576) + lu(1612) = lu(1612) - lu(306) * lu(1576) + lu(1702) = - lu(297) * lu(1700) + lu(1710) = lu(1710) - lu(298) * lu(1700) + lu(1712) = lu(1712) - lu(299) * lu(1700) + lu(1715) = lu(1715) - lu(300) * lu(1700) + lu(1721) = - lu(301) * lu(1700) + lu(1724) = lu(1724) - lu(302) * lu(1700) + lu(1728) = - lu(303) * lu(1700) + lu(1729) = lu(1729) - lu(304) * lu(1700) + lu(1730) = - lu(305) * lu(1700) + lu(1736) = - lu(306) * lu(1700) + lu(1827) = lu(1827) - lu(297) * lu(1826) + lu(1834) = lu(1834) - lu(298) * lu(1826) + lu(1836) = lu(1836) - lu(299) * lu(1826) + lu(1839) = lu(1839) - lu(300) * lu(1826) + lu(1845) = lu(1845) - lu(301) * lu(1826) + lu(1848) = lu(1848) - lu(302) * lu(1826) + lu(1852) = lu(1852) - lu(303) * lu(1826) + lu(1853) = lu(1853) - lu(304) * lu(1826) + lu(1854) = lu(1854) - lu(305) * lu(1826) + lu(1860) = lu(1860) - lu(306) * lu(1826) + lu(309) = 1._r8 / lu(309) + lu(310) = lu(310) * lu(309) + lu(311) = lu(311) * lu(309) + lu(312) = lu(312) * lu(309) + lu(313) = lu(313) * lu(309) + lu(314) = lu(314) * lu(309) + lu(315) = lu(315) * lu(309) + lu(316) = lu(316) * lu(309) + lu(317) = lu(317) * lu(309) + lu(318) = lu(318) * lu(309) + lu(319) = lu(319) * lu(309) + lu(320) = lu(320) * lu(309) + lu(818) = lu(818) - lu(310) * lu(811) + lu(819) = lu(819) - lu(311) * lu(811) + lu(820) = lu(820) - lu(312) * lu(811) + lu(824) = lu(824) - lu(313) * lu(811) + lu(825) = lu(825) - lu(314) * lu(811) + lu(826) = lu(826) - lu(315) * lu(811) + lu(831) = lu(831) - lu(316) * lu(811) + lu(832) = lu(832) - lu(317) * lu(811) + lu(833) = lu(833) - lu(318) * lu(811) + lu(837) = - lu(319) * lu(811) + lu(840) = - lu(320) * lu(811) + lu(1101) = lu(1101) - lu(310) * lu(1089) + lu(1103) = lu(1103) - lu(311) * lu(1089) + lu(1106) = lu(1106) - lu(312) * lu(1089) + lu(1110) = lu(1110) - lu(313) * lu(1089) + lu(1111) = lu(1111) - lu(314) * lu(1089) + lu(1112) = lu(1112) - lu(315) * lu(1089) + lu(1117) = lu(1117) - lu(316) * lu(1089) + lu(1119) = lu(1119) - lu(317) * lu(1089) + lu(1120) = lu(1120) - lu(318) * lu(1089) + lu(1125) = lu(1125) - lu(319) * lu(1089) + lu(1128) = lu(1128) - lu(320) * lu(1089) + lu(1143) = lu(1143) - lu(310) * lu(1140) + lu(1144) = lu(1144) - lu(311) * lu(1140) + lu(1146) = lu(1146) - lu(312) * lu(1140) + lu(1150) = lu(1150) - lu(313) * lu(1140) + lu(1151) = lu(1151) - lu(314) * lu(1140) + lu(1152) = lu(1152) - lu(315) * lu(1140) + lu(1157) = lu(1157) - lu(316) * lu(1140) + lu(1159) = lu(1159) - lu(317) * lu(1140) + lu(1160) = lu(1160) - lu(318) * lu(1140) + lu(1165) = lu(1165) - lu(319) * lu(1140) + lu(1168) = lu(1168) - lu(320) * lu(1140) + lu(1187) = lu(1187) - lu(310) * lu(1178) + lu(1189) = lu(1189) - lu(311) * lu(1178) + lu(1192) = lu(1192) - lu(312) * lu(1178) + lu(1196) = lu(1196) - lu(313) * lu(1178) + lu(1197) = lu(1197) - lu(314) * lu(1178) + lu(1198) = lu(1198) - lu(315) * lu(1178) + lu(1203) = lu(1203) - lu(316) * lu(1178) + lu(1205) = lu(1205) - lu(317) * lu(1178) + lu(1206) = - lu(318) * lu(1178) + lu(1211) = lu(1211) - lu(319) * lu(1178) + lu(1214) = lu(1214) - lu(320) * lu(1178) + lu(1408) = lu(1408) - lu(310) * lu(1402) + lu(1410) = lu(1410) - lu(311) * lu(1402) + lu(1413) = lu(1413) - lu(312) * lu(1402) + lu(1417) = lu(1417) - lu(313) * lu(1402) + lu(1418) = lu(1418) - lu(314) * lu(1402) + lu(1419) = lu(1419) - lu(315) * lu(1402) + lu(1424) = lu(1424) - lu(316) * lu(1402) + lu(1426) = lu(1426) - lu(317) * lu(1402) + lu(1427) = - lu(318) * lu(1402) + lu(1432) = lu(1432) - lu(319) * lu(1402) + lu(1435) = lu(1435) - lu(320) * lu(1402) + lu(1494) = lu(1494) - lu(310) * lu(1482) + lu(1496) = lu(1496) - lu(311) * lu(1482) + lu(1499) = lu(1499) - lu(312) * lu(1482) + lu(1503) = lu(1503) - lu(313) * lu(1482) + lu(1504) = lu(1504) - lu(314) * lu(1482) + lu(1505) = lu(1505) - lu(315) * lu(1482) + lu(1510) = lu(1510) - lu(316) * lu(1482) + lu(1512) = lu(1512) - lu(317) * lu(1482) + lu(1513) = lu(1513) - lu(318) * lu(1482) + lu(1518) = lu(1518) - lu(319) * lu(1482) + lu(1521) = lu(1521) - lu(320) * lu(1482) + lu(1540) = lu(1540) - lu(310) * lu(1528) + lu(1542) = lu(1542) - lu(311) * lu(1528) + lu(1545) = - lu(312) * lu(1528) + lu(1549) = lu(1549) - lu(313) * lu(1528) + lu(1550) = - lu(314) * lu(1528) + lu(1551) = lu(1551) - lu(315) * lu(1528) + lu(1556) = lu(1556) - lu(316) * lu(1528) + lu(1558) = lu(1558) - lu(317) * lu(1528) + lu(1559) = lu(1559) - lu(318) * lu(1528) + lu(1564) = - lu(319) * lu(1528) + lu(1567) = - lu(320) * lu(1528) + lu(1756) = - lu(310) * lu(1740) + lu(1758) = lu(1758) - lu(311) * lu(1740) + lu(1761) = lu(1761) - lu(312) * lu(1740) + lu(1765) = lu(1765) - lu(313) * lu(1740) + lu(1766) = lu(1766) - lu(314) * lu(1740) + lu(1767) = lu(1767) - lu(315) * lu(1740) + lu(1772) = lu(1772) - lu(316) * lu(1740) + lu(1774) = lu(1774) - lu(317) * lu(1740) + lu(1775) = lu(1775) - lu(318) * lu(1740) + lu(1780) = lu(1780) - lu(319) * lu(1740) + lu(1783) = lu(1783) - lu(320) * lu(1740) + lu(1880) = - lu(310) * lu(1865) + lu(1882) = lu(1882) - lu(311) * lu(1865) + lu(1885) = - lu(312) * lu(1865) + lu(1889) = lu(1889) - lu(313) * lu(1865) + lu(1890) = lu(1890) - lu(314) * lu(1865) + lu(1891) = lu(1891) - lu(315) * lu(1865) + lu(1896) = lu(1896) - lu(316) * lu(1865) + lu(1898) = lu(1898) - lu(317) * lu(1865) + lu(1899) = lu(1899) - lu(318) * lu(1865) + lu(1904) = - lu(319) * lu(1865) + lu(1907) = lu(1907) - lu(320) * lu(1865) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(324) = 1._r8 / lu(324) + lu(325) = lu(325) * lu(324) + lu(326) = lu(326) * lu(324) + lu(327) = lu(327) * lu(324) + lu(328) = lu(328) * lu(324) + lu(329) = lu(329) * lu(324) + lu(330) = lu(330) * lu(324) + lu(331) = lu(331) * lu(324) + lu(332) = lu(332) * lu(324) + lu(333) = lu(333) * lu(324) + lu(334) = lu(334) * lu(324) + lu(335) = lu(335) * lu(324) + lu(633) = lu(633) - lu(325) * lu(627) + lu(634) = lu(634) - lu(326) * lu(627) + lu(637) = lu(637) - lu(327) * lu(627) + lu(638) = lu(638) - lu(328) * lu(627) + lu(639) = lu(639) - lu(329) * lu(627) + lu(640) = lu(640) - lu(330) * lu(627) + lu(641) = lu(641) - lu(331) * lu(627) + lu(642) = lu(642) - lu(332) * lu(627) + lu(643) = - lu(333) * lu(627) + lu(650) = lu(650) - lu(334) * lu(627) + lu(651) = lu(651) - lu(335) * lu(627) + lu(1045) = lu(1045) - lu(325) * lu(1035) + lu(1048) = lu(1048) - lu(326) * lu(1035) + lu(1051) = lu(1051) - lu(327) * lu(1035) + lu(1052) = lu(1052) - lu(328) * lu(1035) + lu(1053) = lu(1053) - lu(329) * lu(1035) + lu(1054) = lu(1054) - lu(330) * lu(1035) + lu(1056) = lu(1056) - lu(331) * lu(1035) + lu(1057) = lu(1057) - lu(332) * lu(1035) + lu(1058) = - lu(333) * lu(1035) + lu(1067) = lu(1067) - lu(334) * lu(1035) + lu(1068) = lu(1068) - lu(335) * lu(1035) + lu(1103) = lu(1103) - lu(325) * lu(1090) + lu(1106) = lu(1106) - lu(326) * lu(1090) + lu(1109) = lu(1109) - lu(327) * lu(1090) + lu(1110) = lu(1110) - lu(328) * lu(1090) + lu(1111) = lu(1111) - lu(329) * lu(1090) + lu(1112) = lu(1112) - lu(330) * lu(1090) + lu(1114) = lu(1114) - lu(331) * lu(1090) + lu(1115) = lu(1115) - lu(332) * lu(1090) + lu(1116) = - lu(333) * lu(1090) + lu(1125) = lu(1125) - lu(334) * lu(1090) + lu(1126) = lu(1126) - lu(335) * lu(1090) + lu(1144) = lu(1144) - lu(325) * lu(1141) + lu(1146) = lu(1146) - lu(326) * lu(1141) + lu(1149) = lu(1149) - lu(327) * lu(1141) + lu(1150) = lu(1150) - lu(328) * lu(1141) + lu(1151) = lu(1151) - lu(329) * lu(1141) + lu(1152) = lu(1152) - lu(330) * lu(1141) + lu(1154) = lu(1154) - lu(331) * lu(1141) + lu(1155) = lu(1155) - lu(332) * lu(1141) + lu(1156) = lu(1156) - lu(333) * lu(1141) + lu(1165) = lu(1165) - lu(334) * lu(1141) + lu(1166) = lu(1166) - lu(335) * lu(1141) + lu(1189) = lu(1189) - lu(325) * lu(1179) + lu(1192) = lu(1192) - lu(326) * lu(1179) + lu(1195) = lu(1195) - lu(327) * lu(1179) + lu(1196) = lu(1196) - lu(328) * lu(1179) + lu(1197) = lu(1197) - lu(329) * lu(1179) + lu(1198) = lu(1198) - lu(330) * lu(1179) + lu(1200) = lu(1200) - lu(331) * lu(1179) + lu(1201) = lu(1201) - lu(332) * lu(1179) + lu(1202) = - lu(333) * lu(1179) + lu(1211) = lu(1211) - lu(334) * lu(1179) + lu(1212) = lu(1212) - lu(335) * lu(1179) + lu(1267) = lu(1267) - lu(325) * lu(1258) + lu(1270) = lu(1270) - lu(326) * lu(1258) + lu(1273) = lu(1273) - lu(327) * lu(1258) + lu(1274) = lu(1274) - lu(328) * lu(1258) + lu(1275) = lu(1275) - lu(329) * lu(1258) + lu(1276) = lu(1276) - lu(330) * lu(1258) + lu(1278) = lu(1278) - lu(331) * lu(1258) + lu(1279) = lu(1279) - lu(332) * lu(1258) + lu(1280) = - lu(333) * lu(1258) + lu(1289) = lu(1289) - lu(334) * lu(1258) + lu(1290) = lu(1290) - lu(335) * lu(1258) + lu(1326) = lu(1326) - lu(325) * lu(1309) + lu(1329) = lu(1329) - lu(326) * lu(1309) + lu(1332) = - lu(327) * lu(1309) + lu(1333) = lu(1333) - lu(328) * lu(1309) + lu(1334) = lu(1334) - lu(329) * lu(1309) + lu(1335) = lu(1335) - lu(330) * lu(1309) + lu(1337) = lu(1337) - lu(331) * lu(1309) + lu(1338) = lu(1338) - lu(332) * lu(1309) + lu(1339) = lu(1339) - lu(333) * lu(1309) + lu(1348) = lu(1348) - lu(334) * lu(1309) + lu(1349) = - lu(335) * lu(1309) + lu(1410) = lu(1410) - lu(325) * lu(1403) + lu(1413) = lu(1413) - lu(326) * lu(1403) + lu(1416) = lu(1416) - lu(327) * lu(1403) + lu(1417) = lu(1417) - lu(328) * lu(1403) + lu(1418) = lu(1418) - lu(329) * lu(1403) + lu(1419) = lu(1419) - lu(330) * lu(1403) + lu(1421) = lu(1421) - lu(331) * lu(1403) + lu(1422) = lu(1422) - lu(332) * lu(1403) + lu(1423) = - lu(333) * lu(1403) + lu(1432) = lu(1432) - lu(334) * lu(1403) + lu(1433) = lu(1433) - lu(335) * lu(1403) + lu(1758) = lu(1758) - lu(325) * lu(1741) + lu(1761) = lu(1761) - lu(326) * lu(1741) + lu(1764) = - lu(327) * lu(1741) + lu(1765) = lu(1765) - lu(328) * lu(1741) + lu(1766) = lu(1766) - lu(329) * lu(1741) + lu(1767) = lu(1767) - lu(330) * lu(1741) + lu(1769) = - lu(331) * lu(1741) + lu(1770) = lu(1770) - lu(332) * lu(1741) + lu(1771) = lu(1771) - lu(333) * lu(1741) + lu(1780) = lu(1780) - lu(334) * lu(1741) + lu(1781) = lu(1781) - lu(335) * lu(1741) + lu(1794) = - lu(325) * lu(1787) + lu(1797) = lu(1797) - lu(326) * lu(1787) + lu(1800) = lu(1800) - lu(327) * lu(1787) + lu(1801) = lu(1801) - lu(328) * lu(1787) + lu(1802) = lu(1802) - lu(329) * lu(1787) + lu(1803) = lu(1803) - lu(330) * lu(1787) + lu(1805) = lu(1805) - lu(331) * lu(1787) + lu(1806) = lu(1806) - lu(332) * lu(1787) + lu(1807) = lu(1807) - lu(333) * lu(1787) + lu(1816) = lu(1816) - lu(334) * lu(1787) + lu(1817) = lu(1817) - lu(335) * lu(1787) + lu(336) = 1._r8 / lu(336) + lu(337) = lu(337) * lu(336) + lu(338) = lu(338) * lu(336) + lu(339) = lu(339) * lu(336) + lu(340) = lu(340) * lu(336) + lu(341) = lu(341) * lu(336) + lu(342) = lu(342) * lu(336) + lu(343) = lu(343) * lu(336) + lu(344) = lu(344) * lu(336) + lu(345) = lu(345) * lu(336) + lu(346) = lu(346) * lu(336) + lu(347) = lu(347) * lu(336) + lu(348) = lu(348) * lu(336) + lu(349) = lu(349) * lu(336) + lu(891) = lu(891) - lu(337) * lu(876) + lu(893) = lu(893) - lu(338) * lu(876) + lu(894) = - lu(339) * lu(876) + lu(900) = lu(900) - lu(340) * lu(876) + lu(901) = - lu(341) * lu(876) + lu(903) = lu(903) - lu(342) * lu(876) + lu(904) = lu(904) - lu(343) * lu(876) + lu(905) = lu(905) - lu(344) * lu(876) + lu(906) = - lu(345) * lu(876) + lu(907) = lu(907) - lu(346) * lu(876) + lu(911) = - lu(347) * lu(876) + lu(913) = - lu(348) * lu(876) + lu(916) = - lu(349) * lu(876) + lu(961) = lu(961) - lu(337) * lu(955) + lu(963) = - lu(338) * lu(955) + lu(964) = lu(964) - lu(339) * lu(955) + lu(970) = lu(970) - lu(340) * lu(955) + lu(971) = - lu(341) * lu(955) + lu(973) = lu(973) - lu(342) * lu(955) + lu(974) = - lu(343) * lu(955) + lu(975) = lu(975) - lu(344) * lu(955) + lu(976) = - lu(345) * lu(955) + lu(977) = lu(977) - lu(346) * lu(955) + lu(981) = - lu(347) * lu(955) + lu(983) = - lu(348) * lu(955) + lu(986) = - lu(349) * lu(955) + lu(1231) = lu(1231) - lu(337) * lu(1216) + lu(1233) = lu(1233) - lu(338) * lu(1216) + lu(1234) = lu(1234) - lu(339) * lu(1216) + lu(1240) = lu(1240) - lu(340) * lu(1216) + lu(1241) = lu(1241) - lu(341) * lu(1216) + lu(1243) = lu(1243) - lu(342) * lu(1216) + lu(1244) = lu(1244) - lu(343) * lu(1216) + lu(1245) = lu(1245) - lu(344) * lu(1216) + lu(1246) = - lu(345) * lu(1216) + lu(1247) = lu(1247) - lu(346) * lu(1216) + lu(1251) = - lu(347) * lu(1216) + lu(1253) = - lu(348) * lu(1216) + lu(1256) = - lu(349) * lu(1216) + lu(1369) = lu(1369) - lu(337) * lu(1354) + lu(1371) = - lu(338) * lu(1354) + lu(1372) = lu(1372) - lu(339) * lu(1354) + lu(1378) = lu(1378) - lu(340) * lu(1354) + lu(1379) = - lu(341) * lu(1354) + lu(1381) = lu(1381) - lu(342) * lu(1354) + lu(1382) = lu(1382) - lu(343) * lu(1354) + lu(1383) = lu(1383) - lu(344) * lu(1354) + lu(1384) = - lu(345) * lu(1354) + lu(1385) = - lu(346) * lu(1354) + lu(1389) = lu(1389) - lu(347) * lu(1354) + lu(1391) = - lu(348) * lu(1354) + lu(1394) = - lu(349) * lu(1354) + lu(1410) = lu(1410) - lu(337) * lu(1404) + lu(1412) = - lu(338) * lu(1404) + lu(1413) = lu(1413) - lu(339) * lu(1404) + lu(1419) = lu(1419) - lu(340) * lu(1404) + lu(1420) = lu(1420) - lu(341) * lu(1404) + lu(1422) = lu(1422) - lu(342) * lu(1404) + lu(1423) = lu(1423) - lu(343) * lu(1404) + lu(1424) = lu(1424) - lu(344) * lu(1404) + lu(1425) = - lu(345) * lu(1404) + lu(1426) = lu(1426) - lu(346) * lu(1404) + lu(1430) = - lu(347) * lu(1404) + lu(1432) = lu(1432) - lu(348) * lu(1404) + lu(1435) = lu(1435) - lu(349) * lu(1404) + lu(1453) = lu(1453) - lu(337) * lu(1438) + lu(1455) = - lu(338) * lu(1438) + lu(1456) = lu(1456) - lu(339) * lu(1438) + lu(1462) = lu(1462) - lu(340) * lu(1438) + lu(1463) = - lu(341) * lu(1438) + lu(1465) = lu(1465) - lu(342) * lu(1438) + lu(1466) = - lu(343) * lu(1438) + lu(1467) = lu(1467) - lu(344) * lu(1438) + lu(1468) = lu(1468) - lu(345) * lu(1438) + lu(1469) = lu(1469) - lu(346) * lu(1438) + lu(1473) = lu(1473) - lu(347) * lu(1438) + lu(1475) = - lu(348) * lu(1438) + lu(1478) = - lu(349) * lu(1438) + lu(1672) = lu(1672) - lu(337) * lu(1657) + lu(1674) = - lu(338) * lu(1657) + lu(1675) = lu(1675) - lu(339) * lu(1657) + lu(1681) = lu(1681) - lu(340) * lu(1657) + lu(1682) = - lu(341) * lu(1657) + lu(1684) = lu(1684) - lu(342) * lu(1657) + lu(1685) = lu(1685) - lu(343) * lu(1657) + lu(1686) = lu(1686) - lu(344) * lu(1657) + lu(1687) = lu(1687) - lu(345) * lu(1657) + lu(1688) = lu(1688) - lu(346) * lu(1657) + lu(1692) = lu(1692) - lu(347) * lu(1657) + lu(1694) = - lu(348) * lu(1657) + lu(1697) = - lu(349) * lu(1657) + lu(1758) = lu(1758) - lu(337) * lu(1742) + lu(1760) = - lu(338) * lu(1742) + lu(1761) = lu(1761) - lu(339) * lu(1742) + lu(1767) = lu(1767) - lu(340) * lu(1742) + lu(1768) = - lu(341) * lu(1742) + lu(1770) = lu(1770) - lu(342) * lu(1742) + lu(1771) = lu(1771) - lu(343) * lu(1742) + lu(1772) = lu(1772) - lu(344) * lu(1742) + lu(1773) = - lu(345) * lu(1742) + lu(1774) = lu(1774) - lu(346) * lu(1742) + lu(1778) = - lu(347) * lu(1742) + lu(1780) = lu(1780) - lu(348) * lu(1742) + lu(1783) = lu(1783) - lu(349) * lu(1742) + lu(1882) = lu(1882) - lu(337) * lu(1866) + lu(1884) = - lu(338) * lu(1866) + lu(1885) = lu(1885) - lu(339) * lu(1866) + lu(1891) = lu(1891) - lu(340) * lu(1866) + lu(1892) = lu(1892) - lu(341) * lu(1866) + lu(1894) = lu(1894) - lu(342) * lu(1866) + lu(1895) = - lu(343) * lu(1866) + lu(1896) = lu(1896) - lu(344) * lu(1866) + lu(1897) = - lu(345) * lu(1866) + lu(1898) = lu(1898) - lu(346) * lu(1866) + lu(1902) = - lu(347) * lu(1866) + lu(1904) = lu(1904) - lu(348) * lu(1866) + lu(1907) = lu(1907) - lu(349) * lu(1866) + end subroutine lu_fac09 + subroutine lu_fac10( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(353) = 1._r8 / lu(353) + lu(354) = lu(354) * lu(353) + lu(355) = lu(355) * lu(353) + lu(356) = lu(356) * lu(353) + lu(357) = lu(357) * lu(353) + lu(358) = lu(358) * lu(353) + lu(359) = lu(359) * lu(353) + lu(360) = lu(360) * lu(353) + lu(361) = lu(361) * lu(353) + lu(362) = lu(362) * lu(353) + lu(363) = lu(363) * lu(353) + lu(364) = lu(364) * lu(353) + lu(365) = lu(365) * lu(353) + lu(366) = lu(366) * lu(353) + lu(480) = lu(480) - lu(354) * lu(479) + lu(481) = lu(481) - lu(355) * lu(479) + lu(482) = lu(482) - lu(356) * lu(479) + lu(483) = lu(483) - lu(357) * lu(479) + lu(484) = - lu(358) * lu(479) + lu(486) = - lu(359) * lu(479) + lu(487) = lu(487) - lu(360) * lu(479) + lu(488) = lu(488) - lu(361) * lu(479) + lu(489) = lu(489) - lu(362) * lu(479) + lu(490) = lu(490) - lu(363) * lu(479) + lu(491) = lu(491) - lu(364) * lu(479) + lu(492) = lu(492) - lu(365) * lu(479) + lu(495) = lu(495) - lu(366) * lu(479) + lu(814) = lu(814) - lu(354) * lu(812) + lu(816) = lu(816) - lu(355) * lu(812) + lu(818) = lu(818) - lu(356) * lu(812) + lu(819) = lu(819) - lu(357) * lu(812) + lu(820) = lu(820) - lu(358) * lu(812) + lu(823) = lu(823) - lu(359) * lu(812) + lu(824) = lu(824) - lu(360) * lu(812) + lu(826) = lu(826) - lu(361) * lu(812) + lu(829) = lu(829) - lu(362) * lu(812) + lu(832) = lu(832) - lu(363) * lu(812) + lu(833) = lu(833) - lu(364) * lu(812) + lu(834) = lu(834) - lu(365) * lu(812) + lu(839) = lu(839) - lu(366) * lu(812) + lu(1038) = lu(1038) - lu(354) * lu(1036) + lu(1039) = lu(1039) - lu(355) * lu(1036) + lu(1043) = lu(1043) - lu(356) * lu(1036) + lu(1045) = lu(1045) - lu(357) * lu(1036) + lu(1048) = lu(1048) - lu(358) * lu(1036) + lu(1051) = lu(1051) - lu(359) * lu(1036) + lu(1052) = lu(1052) - lu(360) * lu(1036) + lu(1054) = lu(1054) - lu(361) * lu(1036) + lu(1057) = lu(1057) - lu(362) * lu(1036) + lu(1061) = lu(1061) - lu(363) * lu(1036) + lu(1062) = lu(1062) - lu(364) * lu(1036) + lu(1063) = lu(1063) - lu(365) * lu(1036) + lu(1069) = lu(1069) - lu(366) * lu(1036) + lu(1094) = lu(1094) - lu(354) * lu(1091) + lu(1096) = lu(1096) - lu(355) * lu(1091) + lu(1101) = lu(1101) - lu(356) * lu(1091) + lu(1103) = lu(1103) - lu(357) * lu(1091) + lu(1106) = lu(1106) - lu(358) * lu(1091) + lu(1109) = lu(1109) - lu(359) * lu(1091) + lu(1110) = lu(1110) - lu(360) * lu(1091) + lu(1112) = lu(1112) - lu(361) * lu(1091) + lu(1115) = lu(1115) - lu(362) * lu(1091) + lu(1119) = lu(1119) - lu(363) * lu(1091) + lu(1120) = lu(1120) - lu(364) * lu(1091) + lu(1121) = lu(1121) - lu(365) * lu(1091) + lu(1127) = lu(1127) - lu(366) * lu(1091) + lu(1182) = - lu(354) * lu(1180) + lu(1183) = - lu(355) * lu(1180) + lu(1187) = lu(1187) - lu(356) * lu(1180) + lu(1189) = lu(1189) - lu(357) * lu(1180) + lu(1192) = lu(1192) - lu(358) * lu(1180) + lu(1195) = lu(1195) - lu(359) * lu(1180) + lu(1196) = lu(1196) - lu(360) * lu(1180) + lu(1198) = lu(1198) - lu(361) * lu(1180) + lu(1201) = lu(1201) - lu(362) * lu(1180) + lu(1205) = lu(1205) - lu(363) * lu(1180) + lu(1206) = lu(1206) - lu(364) * lu(1180) + lu(1207) = - lu(365) * lu(1180) + lu(1213) = - lu(366) * lu(1180) + lu(1315) = - lu(354) * lu(1310) + lu(1320) = - lu(355) * lu(1310) + lu(1324) = lu(1324) - lu(356) * lu(1310) + lu(1326) = lu(1326) - lu(357) * lu(1310) + lu(1329) = lu(1329) - lu(358) * lu(1310) + lu(1332) = lu(1332) - lu(359) * lu(1310) + lu(1333) = lu(1333) - lu(360) * lu(1310) + lu(1335) = lu(1335) - lu(361) * lu(1310) + lu(1338) = lu(1338) - lu(362) * lu(1310) + lu(1342) = lu(1342) - lu(363) * lu(1310) + lu(1343) = lu(1343) - lu(364) * lu(1310) + lu(1344) = lu(1344) - lu(365) * lu(1310) + lu(1350) = lu(1350) - lu(366) * lu(1310) + lu(1531) = lu(1531) - lu(354) * lu(1529) + lu(1536) = lu(1536) - lu(355) * lu(1529) + lu(1540) = lu(1540) - lu(356) * lu(1529) + lu(1542) = lu(1542) - lu(357) * lu(1529) + lu(1545) = lu(1545) - lu(358) * lu(1529) + lu(1548) = lu(1548) - lu(359) * lu(1529) + lu(1549) = lu(1549) - lu(360) * lu(1529) + lu(1551) = lu(1551) - lu(361) * lu(1529) + lu(1554) = lu(1554) - lu(362) * lu(1529) + lu(1558) = lu(1558) - lu(363) * lu(1529) + lu(1559) = lu(1559) - lu(364) * lu(1529) + lu(1560) = lu(1560) - lu(365) * lu(1529) + lu(1566) = lu(1566) - lu(366) * lu(1529) + lu(1579) = lu(1579) - lu(354) * lu(1577) + lu(1581) = lu(1581) - lu(355) * lu(1577) + lu(1586) = lu(1586) - lu(356) * lu(1577) + lu(1588) = lu(1588) - lu(357) * lu(1577) + lu(1591) = lu(1591) - lu(358) * lu(1577) + lu(1594) = - lu(359) * lu(1577) + lu(1595) = lu(1595) - lu(360) * lu(1577) + lu(1597) = lu(1597) - lu(361) * lu(1577) + lu(1600) = lu(1600) - lu(362) * lu(1577) + lu(1604) = lu(1604) - lu(363) * lu(1577) + lu(1605) = lu(1605) - lu(364) * lu(1577) + lu(1606) = lu(1606) - lu(365) * lu(1577) + lu(1612) = lu(1612) - lu(366) * lu(1577) + lu(1620) = - lu(354) * lu(1618) + lu(1625) = - lu(355) * lu(1618) + lu(1628) = lu(1628) - lu(356) * lu(1618) + lu(1630) = lu(1630) - lu(357) * lu(1618) + lu(1632) = lu(1632) - lu(358) * lu(1618) + lu(1635) = - lu(359) * lu(1618) + lu(1636) = lu(1636) - lu(360) * lu(1618) + lu(1638) = lu(1638) - lu(361) * lu(1618) + lu(1641) = lu(1641) - lu(362) * lu(1618) + lu(1645) = lu(1645) - lu(363) * lu(1618) + lu(1646) = lu(1646) - lu(364) * lu(1618) + lu(1647) = - lu(365) * lu(1618) + lu(1653) = - lu(366) * lu(1618) + lu(367) = 1._r8 / lu(367) + lu(368) = lu(368) * lu(367) + lu(369) = lu(369) * lu(367) + lu(370) = lu(370) * lu(367) + lu(371) = lu(371) * lu(367) + lu(372) = lu(372) * lu(367) + lu(373) = lu(373) * lu(367) + lu(374) = lu(374) * lu(367) + lu(375) = lu(375) * lu(367) + lu(376) = lu(376) * lu(367) + lu(377) = lu(377) * lu(367) + lu(378) = lu(378) * lu(367) + lu(379) = lu(379) * lu(367) + lu(380) = lu(380) * lu(367) + lu(381) = lu(381) * lu(367) + lu(532) = lu(532) - lu(368) * lu(530) + lu(537) = lu(537) - lu(369) * lu(530) + lu(538) = lu(538) - lu(370) * lu(530) + lu(539) = lu(539) - lu(371) * lu(530) + lu(540) = lu(540) - lu(372) * lu(530) + lu(541) = lu(541) - lu(373) * lu(530) + lu(542) = lu(542) - lu(374) * lu(530) + lu(543) = lu(543) - lu(375) * lu(530) + lu(544) = lu(544) - lu(376) * lu(530) + lu(545) = lu(545) - lu(377) * lu(530) + lu(546) = lu(546) - lu(378) * lu(530) + lu(548) = lu(548) - lu(379) * lu(530) + lu(549) = lu(549) - lu(380) * lu(530) + lu(550) = lu(550) - lu(381) * lu(530) + lu(884) = lu(884) - lu(368) * lu(877) + lu(893) = lu(893) - lu(369) * lu(877) + lu(894) = lu(894) - lu(370) * lu(877) + lu(898) = lu(898) - lu(371) * lu(877) + lu(900) = lu(900) - lu(372) * lu(877) + lu(901) = lu(901) - lu(373) * lu(877) + lu(903) = lu(903) - lu(374) * lu(877) + lu(904) = lu(904) - lu(375) * lu(877) + lu(905) = lu(905) - lu(376) * lu(877) + lu(906) = lu(906) - lu(377) * lu(877) + lu(907) = lu(907) - lu(378) * lu(877) + lu(911) = lu(911) - lu(379) * lu(877) + lu(913) = lu(913) - lu(380) * lu(877) + lu(916) = lu(916) - lu(381) * lu(877) + lu(1224) = lu(1224) - lu(368) * lu(1217) + lu(1233) = lu(1233) - lu(369) * lu(1217) + lu(1234) = lu(1234) - lu(370) * lu(1217) + lu(1238) = lu(1238) - lu(371) * lu(1217) + lu(1240) = lu(1240) - lu(372) * lu(1217) + lu(1241) = lu(1241) - lu(373) * lu(1217) + lu(1243) = lu(1243) - lu(374) * lu(1217) + lu(1244) = lu(1244) - lu(375) * lu(1217) + lu(1245) = lu(1245) - lu(376) * lu(1217) + lu(1246) = lu(1246) - lu(377) * lu(1217) + lu(1247) = lu(1247) - lu(378) * lu(1217) + lu(1251) = lu(1251) - lu(379) * lu(1217) + lu(1253) = lu(1253) - lu(380) * lu(1217) + lu(1256) = lu(1256) - lu(381) * lu(1217) + lu(1317) = lu(1317) - lu(368) * lu(1311) + lu(1328) = lu(1328) - lu(369) * lu(1311) + lu(1329) = lu(1329) - lu(370) * lu(1311) + lu(1333) = lu(1333) - lu(371) * lu(1311) + lu(1335) = lu(1335) - lu(372) * lu(1311) + lu(1336) = lu(1336) - lu(373) * lu(1311) + lu(1338) = lu(1338) - lu(374) * lu(1311) + lu(1339) = lu(1339) - lu(375) * lu(1311) + lu(1340) = lu(1340) - lu(376) * lu(1311) + lu(1341) = lu(1341) - lu(377) * lu(1311) + lu(1342) = lu(1342) - lu(378) * lu(1311) + lu(1346) = lu(1346) - lu(379) * lu(1311) + lu(1348) = lu(1348) - lu(380) * lu(1311) + lu(1351) = lu(1351) - lu(381) * lu(1311) + lu(1362) = lu(1362) - lu(368) * lu(1355) + lu(1371) = lu(1371) - lu(369) * lu(1355) + lu(1372) = lu(1372) - lu(370) * lu(1355) + lu(1376) = lu(1376) - lu(371) * lu(1355) + lu(1378) = lu(1378) - lu(372) * lu(1355) + lu(1379) = lu(1379) - lu(373) * lu(1355) + lu(1381) = lu(1381) - lu(374) * lu(1355) + lu(1382) = lu(1382) - lu(375) * lu(1355) + lu(1383) = lu(1383) - lu(376) * lu(1355) + lu(1384) = lu(1384) - lu(377) * lu(1355) + lu(1385) = lu(1385) - lu(378) * lu(1355) + lu(1389) = lu(1389) - lu(379) * lu(1355) + lu(1391) = lu(1391) - lu(380) * lu(1355) + lu(1394) = lu(1394) - lu(381) * lu(1355) + lu(1446) = lu(1446) - lu(368) * lu(1439) + lu(1455) = lu(1455) - lu(369) * lu(1439) + lu(1456) = lu(1456) - lu(370) * lu(1439) + lu(1460) = lu(1460) - lu(371) * lu(1439) + lu(1462) = lu(1462) - lu(372) * lu(1439) + lu(1463) = lu(1463) - lu(373) * lu(1439) + lu(1465) = lu(1465) - lu(374) * lu(1439) + lu(1466) = lu(1466) - lu(375) * lu(1439) + lu(1467) = lu(1467) - lu(376) * lu(1439) + lu(1468) = lu(1468) - lu(377) * lu(1439) + lu(1469) = lu(1469) - lu(378) * lu(1439) + lu(1473) = lu(1473) - lu(379) * lu(1439) + lu(1475) = lu(1475) - lu(380) * lu(1439) + lu(1478) = lu(1478) - lu(381) * lu(1439) + lu(1665) = lu(1665) - lu(368) * lu(1658) + lu(1674) = lu(1674) - lu(369) * lu(1658) + lu(1675) = lu(1675) - lu(370) * lu(1658) + lu(1679) = lu(1679) - lu(371) * lu(1658) + lu(1681) = lu(1681) - lu(372) * lu(1658) + lu(1682) = lu(1682) - lu(373) * lu(1658) + lu(1684) = lu(1684) - lu(374) * lu(1658) + lu(1685) = lu(1685) - lu(375) * lu(1658) + lu(1686) = lu(1686) - lu(376) * lu(1658) + lu(1687) = lu(1687) - lu(377) * lu(1658) + lu(1688) = lu(1688) - lu(378) * lu(1658) + lu(1692) = lu(1692) - lu(379) * lu(1658) + lu(1694) = lu(1694) - lu(380) * lu(1658) + lu(1697) = lu(1697) - lu(381) * lu(1658) + lu(1750) = lu(1750) - lu(368) * lu(1743) + lu(1760) = lu(1760) - lu(369) * lu(1743) + lu(1761) = lu(1761) - lu(370) * lu(1743) + lu(1765) = lu(1765) - lu(371) * lu(1743) + lu(1767) = lu(1767) - lu(372) * lu(1743) + lu(1768) = lu(1768) - lu(373) * lu(1743) + lu(1770) = lu(1770) - lu(374) * lu(1743) + lu(1771) = lu(1771) - lu(375) * lu(1743) + lu(1772) = lu(1772) - lu(376) * lu(1743) + lu(1773) = lu(1773) - lu(377) * lu(1743) + lu(1774) = lu(1774) - lu(378) * lu(1743) + lu(1778) = lu(1778) - lu(379) * lu(1743) + lu(1780) = lu(1780) - lu(380) * lu(1743) + lu(1783) = lu(1783) - lu(381) * lu(1743) + lu(1874) = lu(1874) - lu(368) * lu(1867) + lu(1884) = lu(1884) - lu(369) * lu(1867) + lu(1885) = lu(1885) - lu(370) * lu(1867) + lu(1889) = lu(1889) - lu(371) * lu(1867) + lu(1891) = lu(1891) - lu(372) * lu(1867) + lu(1892) = lu(1892) - lu(373) * lu(1867) + lu(1894) = lu(1894) - lu(374) * lu(1867) + lu(1895) = lu(1895) - lu(375) * lu(1867) + lu(1896) = lu(1896) - lu(376) * lu(1867) + lu(1897) = lu(1897) - lu(377) * lu(1867) + lu(1898) = lu(1898) - lu(378) * lu(1867) + lu(1902) = lu(1902) - lu(379) * lu(1867) + lu(1904) = lu(1904) - lu(380) * lu(1867) + lu(1907) = lu(1907) - lu(381) * lu(1867) + lu(382) = 1._r8 / lu(382) + lu(383) = lu(383) * lu(382) + lu(384) = lu(384) * lu(382) + lu(385) = lu(385) * lu(382) + lu(386) = lu(386) * lu(382) + lu(387) = lu(387) * lu(382) + lu(388) = lu(388) * lu(382) + lu(389) = lu(389) * lu(382) + lu(390) = lu(390) * lu(382) + lu(391) = lu(391) * lu(382) + lu(392) = lu(392) * lu(382) + lu(393) = lu(393) * lu(382) + lu(394) = lu(394) * lu(382) + lu(395) = lu(395) * lu(382) + lu(396) = lu(396) * lu(382) + lu(399) = lu(399) - lu(383) * lu(397) + lu(400) = lu(400) - lu(384) * lu(397) + lu(401) = lu(401) - lu(385) * lu(397) + lu(402) = lu(402) - lu(386) * lu(397) + lu(403) = lu(403) - lu(387) * lu(397) + lu(404) = lu(404) - lu(388) * lu(397) + lu(405) = lu(405) - lu(389) * lu(397) + lu(406) = lu(406) - lu(390) * lu(397) + lu(407) = lu(407) - lu(391) * lu(397) + lu(408) = lu(408) - lu(392) * lu(397) + lu(409) = lu(409) - lu(393) * lu(397) + lu(410) = lu(410) - lu(394) * lu(397) + lu(411) = lu(411) - lu(395) * lu(397) + lu(412) = lu(412) - lu(396) * lu(397) + lu(655) = lu(655) - lu(383) * lu(653) + lu(658) = lu(658) - lu(384) * lu(653) + lu(659) = lu(659) - lu(385) * lu(653) + lu(660) = lu(660) - lu(386) * lu(653) + lu(662) = lu(662) - lu(387) * lu(653) + lu(663) = lu(663) - lu(388) * lu(653) + lu(664) = lu(664) - lu(389) * lu(653) + lu(665) = lu(665) - lu(390) * lu(653) + lu(666) = lu(666) - lu(391) * lu(653) + lu(667) = lu(667) - lu(392) * lu(653) + lu(669) = lu(669) - lu(393) * lu(653) + lu(671) = lu(671) - lu(394) * lu(653) + lu(672) = lu(672) - lu(395) * lu(653) + lu(673) = lu(673) - lu(396) * lu(653) + lu(886) = lu(886) - lu(383) * lu(878) + lu(893) = lu(893) - lu(384) * lu(878) + lu(894) = lu(894) - lu(385) * lu(878) + lu(896) = lu(896) - lu(386) * lu(878) + lu(900) = lu(900) - lu(387) * lu(878) + lu(901) = lu(901) - lu(388) * lu(878) + lu(903) = lu(903) - lu(389) * lu(878) + lu(904) = lu(904) - lu(390) * lu(878) + lu(906) = lu(906) - lu(391) * lu(878) + lu(907) = lu(907) - lu(392) * lu(878) + lu(911) = lu(911) - lu(393) * lu(878) + lu(913) = lu(913) - lu(394) * lu(878) + lu(915) = lu(915) - lu(395) * lu(878) + lu(916) = lu(916) - lu(396) * lu(878) + lu(1000) = lu(1000) - lu(383) * lu(993) + lu(1007) = - lu(384) * lu(993) + lu(1008) = lu(1008) - lu(385) * lu(993) + lu(1010) = lu(1010) - lu(386) * lu(993) + lu(1014) = - lu(387) * lu(993) + lu(1015) = - lu(388) * lu(993) + lu(1017) = lu(1017) - lu(389) * lu(993) + lu(1018) = - lu(390) * lu(993) + lu(1020) = - lu(391) * lu(993) + lu(1021) = lu(1021) - lu(392) * lu(993) + lu(1025) = - lu(393) * lu(993) + lu(1027) = - lu(394) * lu(993) + lu(1029) = lu(1029) - lu(395) * lu(993) + lu(1030) = - lu(396) * lu(993) + lu(1226) = lu(1226) - lu(383) * lu(1218) + lu(1233) = lu(1233) - lu(384) * lu(1218) + lu(1234) = lu(1234) - lu(385) * lu(1218) + lu(1236) = lu(1236) - lu(386) * lu(1218) + lu(1240) = lu(1240) - lu(387) * lu(1218) + lu(1241) = lu(1241) - lu(388) * lu(1218) + lu(1243) = lu(1243) - lu(389) * lu(1218) + lu(1244) = lu(1244) - lu(390) * lu(1218) + lu(1246) = lu(1246) - lu(391) * lu(1218) + lu(1247) = lu(1247) - lu(392) * lu(1218) + lu(1251) = lu(1251) - lu(393) * lu(1218) + lu(1253) = lu(1253) - lu(394) * lu(1218) + lu(1255) = lu(1255) - lu(395) * lu(1218) + lu(1256) = lu(1256) - lu(396) * lu(1218) + lu(1364) = lu(1364) - lu(383) * lu(1356) + lu(1371) = lu(1371) - lu(384) * lu(1356) + lu(1372) = lu(1372) - lu(385) * lu(1356) + lu(1374) = lu(1374) - lu(386) * lu(1356) + lu(1378) = lu(1378) - lu(387) * lu(1356) + lu(1379) = lu(1379) - lu(388) * lu(1356) + lu(1381) = lu(1381) - lu(389) * lu(1356) + lu(1382) = lu(1382) - lu(390) * lu(1356) + lu(1384) = lu(1384) - lu(391) * lu(1356) + lu(1385) = lu(1385) - lu(392) * lu(1356) + lu(1389) = lu(1389) - lu(393) * lu(1356) + lu(1391) = lu(1391) - lu(394) * lu(1356) + lu(1393) = lu(1393) - lu(395) * lu(1356) + lu(1394) = lu(1394) - lu(396) * lu(1356) + lu(1448) = lu(1448) - lu(383) * lu(1440) + lu(1455) = lu(1455) - lu(384) * lu(1440) + lu(1456) = lu(1456) - lu(385) * lu(1440) + lu(1458) = lu(1458) - lu(386) * lu(1440) + lu(1462) = lu(1462) - lu(387) * lu(1440) + lu(1463) = lu(1463) - lu(388) * lu(1440) + lu(1465) = lu(1465) - lu(389) * lu(1440) + lu(1466) = lu(1466) - lu(390) * lu(1440) + lu(1468) = lu(1468) - lu(391) * lu(1440) + lu(1469) = lu(1469) - lu(392) * lu(1440) + lu(1473) = lu(1473) - lu(393) * lu(1440) + lu(1475) = lu(1475) - lu(394) * lu(1440) + lu(1477) = lu(1477) - lu(395) * lu(1440) + lu(1478) = lu(1478) - lu(396) * lu(1440) + lu(1667) = lu(1667) - lu(383) * lu(1659) + lu(1674) = lu(1674) - lu(384) * lu(1659) + lu(1675) = lu(1675) - lu(385) * lu(1659) + lu(1677) = lu(1677) - lu(386) * lu(1659) + lu(1681) = lu(1681) - lu(387) * lu(1659) + lu(1682) = lu(1682) - lu(388) * lu(1659) + lu(1684) = lu(1684) - lu(389) * lu(1659) + lu(1685) = lu(1685) - lu(390) * lu(1659) + lu(1687) = lu(1687) - lu(391) * lu(1659) + lu(1688) = lu(1688) - lu(392) * lu(1659) + lu(1692) = lu(1692) - lu(393) * lu(1659) + lu(1694) = lu(1694) - lu(394) * lu(1659) + lu(1696) = lu(1696) - lu(395) * lu(1659) + lu(1697) = lu(1697) - lu(396) * lu(1659) + lu(1753) = lu(1753) - lu(383) * lu(1744) + lu(1760) = lu(1760) - lu(384) * lu(1744) + lu(1761) = lu(1761) - lu(385) * lu(1744) + lu(1763) = lu(1763) - lu(386) * lu(1744) + lu(1767) = lu(1767) - lu(387) * lu(1744) + lu(1768) = lu(1768) - lu(388) * lu(1744) + lu(1770) = lu(1770) - lu(389) * lu(1744) + lu(1771) = lu(1771) - lu(390) * lu(1744) + lu(1773) = lu(1773) - lu(391) * lu(1744) + lu(1774) = lu(1774) - lu(392) * lu(1744) + lu(1778) = lu(1778) - lu(393) * lu(1744) + lu(1780) = lu(1780) - lu(394) * lu(1744) + lu(1782) = lu(1782) - lu(395) * lu(1744) + lu(1783) = lu(1783) - lu(396) * lu(1744) + lu(1877) = lu(1877) - lu(383) * lu(1868) + lu(1884) = lu(1884) - lu(384) * lu(1868) + lu(1885) = lu(1885) - lu(385) * lu(1868) + lu(1887) = lu(1887) - lu(386) * lu(1868) + lu(1891) = lu(1891) - lu(387) * lu(1868) + lu(1892) = lu(1892) - lu(388) * lu(1868) + lu(1894) = lu(1894) - lu(389) * lu(1868) + lu(1895) = lu(1895) - lu(390) * lu(1868) + lu(1897) = lu(1897) - lu(391) * lu(1868) + lu(1898) = lu(1898) - lu(392) * lu(1868) + lu(1902) = lu(1902) - lu(393) * lu(1868) + lu(1904) = lu(1904) - lu(394) * lu(1868) + lu(1906) = lu(1906) - lu(395) * lu(1868) + lu(1907) = lu(1907) - lu(396) * lu(1868) + end subroutine lu_fac10 + subroutine lu_fac11( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(398) = 1._r8 / lu(398) + lu(399) = lu(399) * lu(398) + lu(400) = lu(400) * lu(398) + lu(401) = lu(401) * lu(398) + lu(402) = lu(402) * lu(398) + lu(403) = lu(403) * lu(398) + lu(404) = lu(404) * lu(398) + lu(405) = lu(405) * lu(398) + lu(406) = lu(406) * lu(398) + lu(407) = lu(407) * lu(398) + lu(408) = lu(408) * lu(398) + lu(409) = lu(409) * lu(398) + lu(410) = lu(410) * lu(398) + lu(411) = lu(411) * lu(398) + lu(412) = lu(412) * lu(398) + lu(655) = lu(655) - lu(399) * lu(654) + lu(658) = lu(658) - lu(400) * lu(654) + lu(659) = lu(659) - lu(401) * lu(654) + lu(660) = lu(660) - lu(402) * lu(654) + lu(662) = lu(662) - lu(403) * lu(654) + lu(663) = lu(663) - lu(404) * lu(654) + lu(664) = lu(664) - lu(405) * lu(654) + lu(665) = lu(665) - lu(406) * lu(654) + lu(666) = lu(666) - lu(407) * lu(654) + lu(667) = lu(667) - lu(408) * lu(654) + lu(669) = lu(669) - lu(409) * lu(654) + lu(671) = lu(671) - lu(410) * lu(654) + lu(672) = lu(672) - lu(411) * lu(654) + lu(673) = lu(673) - lu(412) * lu(654) + lu(886) = lu(886) - lu(399) * lu(879) + lu(893) = lu(893) - lu(400) * lu(879) + lu(894) = lu(894) - lu(401) * lu(879) + lu(896) = lu(896) - lu(402) * lu(879) + lu(900) = lu(900) - lu(403) * lu(879) + lu(901) = lu(901) - lu(404) * lu(879) + lu(903) = lu(903) - lu(405) * lu(879) + lu(904) = lu(904) - lu(406) * lu(879) + lu(906) = lu(906) - lu(407) * lu(879) + lu(907) = lu(907) - lu(408) * lu(879) + lu(911) = lu(911) - lu(409) * lu(879) + lu(913) = lu(913) - lu(410) * lu(879) + lu(915) = lu(915) - lu(411) * lu(879) + lu(916) = lu(916) - lu(412) * lu(879) + lu(1000) = lu(1000) - lu(399) * lu(994) + lu(1007) = lu(1007) - lu(400) * lu(994) + lu(1008) = lu(1008) - lu(401) * lu(994) + lu(1010) = lu(1010) - lu(402) * lu(994) + lu(1014) = lu(1014) - lu(403) * lu(994) + lu(1015) = lu(1015) - lu(404) * lu(994) + lu(1017) = lu(1017) - lu(405) * lu(994) + lu(1018) = lu(1018) - lu(406) * lu(994) + lu(1020) = lu(1020) - lu(407) * lu(994) + lu(1021) = lu(1021) - lu(408) * lu(994) + lu(1025) = lu(1025) - lu(409) * lu(994) + lu(1027) = lu(1027) - lu(410) * lu(994) + lu(1029) = lu(1029) - lu(411) * lu(994) + lu(1030) = lu(1030) - lu(412) * lu(994) + lu(1226) = lu(1226) - lu(399) * lu(1219) + lu(1233) = lu(1233) - lu(400) * lu(1219) + lu(1234) = lu(1234) - lu(401) * lu(1219) + lu(1236) = lu(1236) - lu(402) * lu(1219) + lu(1240) = lu(1240) - lu(403) * lu(1219) + lu(1241) = lu(1241) - lu(404) * lu(1219) + lu(1243) = lu(1243) - lu(405) * lu(1219) + lu(1244) = lu(1244) - lu(406) * lu(1219) + lu(1246) = lu(1246) - lu(407) * lu(1219) + lu(1247) = lu(1247) - lu(408) * lu(1219) + lu(1251) = lu(1251) - lu(409) * lu(1219) + lu(1253) = lu(1253) - lu(410) * lu(1219) + lu(1255) = lu(1255) - lu(411) * lu(1219) + lu(1256) = lu(1256) - lu(412) * lu(1219) + lu(1322) = lu(1322) - lu(399) * lu(1312) + lu(1328) = lu(1328) - lu(400) * lu(1312) + lu(1329) = lu(1329) - lu(401) * lu(1312) + lu(1331) = - lu(402) * lu(1312) + lu(1335) = lu(1335) - lu(403) * lu(1312) + lu(1336) = lu(1336) - lu(404) * lu(1312) + lu(1338) = lu(1338) - lu(405) * lu(1312) + lu(1339) = lu(1339) - lu(406) * lu(1312) + lu(1341) = lu(1341) - lu(407) * lu(1312) + lu(1342) = lu(1342) - lu(408) * lu(1312) + lu(1346) = lu(1346) - lu(409) * lu(1312) + lu(1348) = lu(1348) - lu(410) * lu(1312) + lu(1350) = lu(1350) - lu(411) * lu(1312) + lu(1351) = lu(1351) - lu(412) * lu(1312) + lu(1364) = lu(1364) - lu(399) * lu(1357) + lu(1371) = lu(1371) - lu(400) * lu(1357) + lu(1372) = lu(1372) - lu(401) * lu(1357) + lu(1374) = lu(1374) - lu(402) * lu(1357) + lu(1378) = lu(1378) - lu(403) * lu(1357) + lu(1379) = lu(1379) - lu(404) * lu(1357) + lu(1381) = lu(1381) - lu(405) * lu(1357) + lu(1382) = lu(1382) - lu(406) * lu(1357) + lu(1384) = lu(1384) - lu(407) * lu(1357) + lu(1385) = lu(1385) - lu(408) * lu(1357) + lu(1389) = lu(1389) - lu(409) * lu(1357) + lu(1391) = lu(1391) - lu(410) * lu(1357) + lu(1393) = lu(1393) - lu(411) * lu(1357) + lu(1394) = lu(1394) - lu(412) * lu(1357) + lu(1448) = lu(1448) - lu(399) * lu(1441) + lu(1455) = lu(1455) - lu(400) * lu(1441) + lu(1456) = lu(1456) - lu(401) * lu(1441) + lu(1458) = lu(1458) - lu(402) * lu(1441) + lu(1462) = lu(1462) - lu(403) * lu(1441) + lu(1463) = lu(1463) - lu(404) * lu(1441) + lu(1465) = lu(1465) - lu(405) * lu(1441) + lu(1466) = lu(1466) - lu(406) * lu(1441) + lu(1468) = lu(1468) - lu(407) * lu(1441) + lu(1469) = lu(1469) - lu(408) * lu(1441) + lu(1473) = lu(1473) - lu(409) * lu(1441) + lu(1475) = lu(1475) - lu(410) * lu(1441) + lu(1477) = lu(1477) - lu(411) * lu(1441) + lu(1478) = lu(1478) - lu(412) * lu(1441) + lu(1667) = lu(1667) - lu(399) * lu(1660) + lu(1674) = lu(1674) - lu(400) * lu(1660) + lu(1675) = lu(1675) - lu(401) * lu(1660) + lu(1677) = lu(1677) - lu(402) * lu(1660) + lu(1681) = lu(1681) - lu(403) * lu(1660) + lu(1682) = lu(1682) - lu(404) * lu(1660) + lu(1684) = lu(1684) - lu(405) * lu(1660) + lu(1685) = lu(1685) - lu(406) * lu(1660) + lu(1687) = lu(1687) - lu(407) * lu(1660) + lu(1688) = lu(1688) - lu(408) * lu(1660) + lu(1692) = lu(1692) - lu(409) * lu(1660) + lu(1694) = lu(1694) - lu(410) * lu(1660) + lu(1696) = lu(1696) - lu(411) * lu(1660) + lu(1697) = lu(1697) - lu(412) * lu(1660) + lu(1753) = lu(1753) - lu(399) * lu(1745) + lu(1760) = lu(1760) - lu(400) * lu(1745) + lu(1761) = lu(1761) - lu(401) * lu(1745) + lu(1763) = lu(1763) - lu(402) * lu(1745) + lu(1767) = lu(1767) - lu(403) * lu(1745) + lu(1768) = lu(1768) - lu(404) * lu(1745) + lu(1770) = lu(1770) - lu(405) * lu(1745) + lu(1771) = lu(1771) - lu(406) * lu(1745) + lu(1773) = lu(1773) - lu(407) * lu(1745) + lu(1774) = lu(1774) - lu(408) * lu(1745) + lu(1778) = lu(1778) - lu(409) * lu(1745) + lu(1780) = lu(1780) - lu(410) * lu(1745) + lu(1782) = lu(1782) - lu(411) * lu(1745) + lu(1783) = lu(1783) - lu(412) * lu(1745) + lu(1877) = lu(1877) - lu(399) * lu(1869) + lu(1884) = lu(1884) - lu(400) * lu(1869) + lu(1885) = lu(1885) - lu(401) * lu(1869) + lu(1887) = lu(1887) - lu(402) * lu(1869) + lu(1891) = lu(1891) - lu(403) * lu(1869) + lu(1892) = lu(1892) - lu(404) * lu(1869) + lu(1894) = lu(1894) - lu(405) * lu(1869) + lu(1895) = lu(1895) - lu(406) * lu(1869) + lu(1897) = lu(1897) - lu(407) * lu(1869) + lu(1898) = lu(1898) - lu(408) * lu(1869) + lu(1902) = lu(1902) - lu(409) * lu(1869) + lu(1904) = lu(1904) - lu(410) * lu(1869) + lu(1906) = lu(1906) - lu(411) * lu(1869) + lu(1907) = lu(1907) - lu(412) * lu(1869) + lu(413) = 1._r8 / lu(413) + lu(414) = lu(414) * lu(413) + lu(415) = lu(415) * lu(413) + lu(416) = lu(416) * lu(413) + lu(417) = lu(417) * lu(413) + lu(418) = lu(418) * lu(413) + lu(419) = lu(419) * lu(413) + lu(420) = lu(420) * lu(413) + lu(421) = lu(421) * lu(413) + lu(422) = lu(422) * lu(413) + lu(423) = lu(423) * lu(413) + lu(424) = lu(424) * lu(413) + lu(425) = lu(425) * lu(413) + lu(426) = lu(426) * lu(413) + lu(535) = lu(535) - lu(414) * lu(531) + lu(537) = lu(537) - lu(415) * lu(531) + lu(538) = lu(538) - lu(416) * lu(531) + lu(540) = lu(540) - lu(417) * lu(531) + lu(541) = lu(541) - lu(418) * lu(531) + lu(542) = lu(542) - lu(419) * lu(531) + lu(543) = lu(543) - lu(420) * lu(531) + lu(545) = lu(545) - lu(421) * lu(531) + lu(546) = lu(546) - lu(422) * lu(531) + lu(547) = lu(547) - lu(423) * lu(531) + lu(548) = lu(548) - lu(424) * lu(531) + lu(549) = lu(549) - lu(425) * lu(531) + lu(550) = lu(550) - lu(426) * lu(531) + lu(770) = lu(770) - lu(414) * lu(767) + lu(772) = lu(772) - lu(415) * lu(767) + lu(773) = lu(773) - lu(416) * lu(767) + lu(779) = lu(779) - lu(417) * lu(767) + lu(780) = lu(780) - lu(418) * lu(767) + lu(781) = lu(781) - lu(419) * lu(767) + lu(782) = lu(782) - lu(420) * lu(767) + lu(783) = lu(783) - lu(421) * lu(767) + lu(784) = lu(784) - lu(422) * lu(767) + lu(785) = lu(785) - lu(423) * lu(767) + lu(788) = lu(788) - lu(424) * lu(767) + lu(790) = lu(790) - lu(425) * lu(767) + lu(792) = lu(792) - lu(426) * lu(767) + lu(890) = lu(890) - lu(414) * lu(880) + lu(893) = lu(893) - lu(415) * lu(880) + lu(894) = lu(894) - lu(416) * lu(880) + lu(900) = lu(900) - lu(417) * lu(880) + lu(901) = lu(901) - lu(418) * lu(880) + lu(903) = lu(903) - lu(419) * lu(880) + lu(904) = lu(904) - lu(420) * lu(880) + lu(906) = lu(906) - lu(421) * lu(880) + lu(907) = lu(907) - lu(422) * lu(880) + lu(908) = lu(908) - lu(423) * lu(880) + lu(911) = lu(911) - lu(424) * lu(880) + lu(913) = lu(913) - lu(425) * lu(880) + lu(916) = lu(916) - lu(426) * lu(880) + lu(1230) = lu(1230) - lu(414) * lu(1220) + lu(1233) = lu(1233) - lu(415) * lu(1220) + lu(1234) = lu(1234) - lu(416) * lu(1220) + lu(1240) = lu(1240) - lu(417) * lu(1220) + lu(1241) = lu(1241) - lu(418) * lu(1220) + lu(1243) = lu(1243) - lu(419) * lu(1220) + lu(1244) = lu(1244) - lu(420) * lu(1220) + lu(1246) = lu(1246) - lu(421) * lu(1220) + lu(1247) = lu(1247) - lu(422) * lu(1220) + lu(1248) = lu(1248) - lu(423) * lu(1220) + lu(1251) = lu(1251) - lu(424) * lu(1220) + lu(1253) = lu(1253) - lu(425) * lu(1220) + lu(1256) = lu(1256) - lu(426) * lu(1220) + lu(1325) = lu(1325) - lu(414) * lu(1313) + lu(1328) = lu(1328) - lu(415) * lu(1313) + lu(1329) = lu(1329) - lu(416) * lu(1313) + lu(1335) = lu(1335) - lu(417) * lu(1313) + lu(1336) = lu(1336) - lu(418) * lu(1313) + lu(1338) = lu(1338) - lu(419) * lu(1313) + lu(1339) = lu(1339) - lu(420) * lu(1313) + lu(1341) = lu(1341) - lu(421) * lu(1313) + lu(1342) = lu(1342) - lu(422) * lu(1313) + lu(1343) = lu(1343) - lu(423) * lu(1313) + lu(1346) = lu(1346) - lu(424) * lu(1313) + lu(1348) = lu(1348) - lu(425) * lu(1313) + lu(1351) = lu(1351) - lu(426) * lu(1313) + lu(1368) = lu(1368) - lu(414) * lu(1358) + lu(1371) = lu(1371) - lu(415) * lu(1358) + lu(1372) = lu(1372) - lu(416) * lu(1358) + lu(1378) = lu(1378) - lu(417) * lu(1358) + lu(1379) = lu(1379) - lu(418) * lu(1358) + lu(1381) = lu(1381) - lu(419) * lu(1358) + lu(1382) = lu(1382) - lu(420) * lu(1358) + lu(1384) = lu(1384) - lu(421) * lu(1358) + lu(1385) = lu(1385) - lu(422) * lu(1358) + lu(1386) = lu(1386) - lu(423) * lu(1358) + lu(1389) = lu(1389) - lu(424) * lu(1358) + lu(1391) = lu(1391) - lu(425) * lu(1358) + lu(1394) = lu(1394) - lu(426) * lu(1358) + lu(1452) = lu(1452) - lu(414) * lu(1442) + lu(1455) = lu(1455) - lu(415) * lu(1442) + lu(1456) = lu(1456) - lu(416) * lu(1442) + lu(1462) = lu(1462) - lu(417) * lu(1442) + lu(1463) = lu(1463) - lu(418) * lu(1442) + lu(1465) = lu(1465) - lu(419) * lu(1442) + lu(1466) = lu(1466) - lu(420) * lu(1442) + lu(1468) = lu(1468) - lu(421) * lu(1442) + lu(1469) = lu(1469) - lu(422) * lu(1442) + lu(1470) = lu(1470) - lu(423) * lu(1442) + lu(1473) = lu(1473) - lu(424) * lu(1442) + lu(1475) = lu(1475) - lu(425) * lu(1442) + lu(1478) = lu(1478) - lu(426) * lu(1442) + lu(1495) = lu(1495) - lu(414) * lu(1483) + lu(1498) = - lu(415) * lu(1483) + lu(1499) = lu(1499) - lu(416) * lu(1483) + lu(1505) = lu(1505) - lu(417) * lu(1483) + lu(1506) = - lu(418) * lu(1483) + lu(1508) = lu(1508) - lu(419) * lu(1483) + lu(1509) = - lu(420) * lu(1483) + lu(1511) = - lu(421) * lu(1483) + lu(1512) = lu(1512) - lu(422) * lu(1483) + lu(1513) = lu(1513) - lu(423) * lu(1483) + lu(1516) = - lu(424) * lu(1483) + lu(1518) = lu(1518) - lu(425) * lu(1483) + lu(1521) = lu(1521) - lu(426) * lu(1483) + lu(1671) = lu(1671) - lu(414) * lu(1661) + lu(1674) = lu(1674) - lu(415) * lu(1661) + lu(1675) = lu(1675) - lu(416) * lu(1661) + lu(1681) = lu(1681) - lu(417) * lu(1661) + lu(1682) = lu(1682) - lu(418) * lu(1661) + lu(1684) = lu(1684) - lu(419) * lu(1661) + lu(1685) = lu(1685) - lu(420) * lu(1661) + lu(1687) = lu(1687) - lu(421) * lu(1661) + lu(1688) = lu(1688) - lu(422) * lu(1661) + lu(1689) = lu(1689) - lu(423) * lu(1661) + lu(1692) = lu(1692) - lu(424) * lu(1661) + lu(1694) = lu(1694) - lu(425) * lu(1661) + lu(1697) = lu(1697) - lu(426) * lu(1661) + lu(1757) = lu(1757) - lu(414) * lu(1746) + lu(1760) = lu(1760) - lu(415) * lu(1746) + lu(1761) = lu(1761) - lu(416) * lu(1746) + lu(1767) = lu(1767) - lu(417) * lu(1746) + lu(1768) = lu(1768) - lu(418) * lu(1746) + lu(1770) = lu(1770) - lu(419) * lu(1746) + lu(1771) = lu(1771) - lu(420) * lu(1746) + lu(1773) = lu(1773) - lu(421) * lu(1746) + lu(1774) = lu(1774) - lu(422) * lu(1746) + lu(1775) = lu(1775) - lu(423) * lu(1746) + lu(1778) = lu(1778) - lu(424) * lu(1746) + lu(1780) = lu(1780) - lu(425) * lu(1746) + lu(1783) = lu(1783) - lu(426) * lu(1746) + lu(1881) = lu(1881) - lu(414) * lu(1870) + lu(1884) = lu(1884) - lu(415) * lu(1870) + lu(1885) = lu(1885) - lu(416) * lu(1870) + lu(1891) = lu(1891) - lu(417) * lu(1870) + lu(1892) = lu(1892) - lu(418) * lu(1870) + lu(1894) = lu(1894) - lu(419) * lu(1870) + lu(1895) = lu(1895) - lu(420) * lu(1870) + lu(1897) = lu(1897) - lu(421) * lu(1870) + lu(1898) = lu(1898) - lu(422) * lu(1870) + lu(1899) = lu(1899) - lu(423) * lu(1870) + lu(1902) = lu(1902) - lu(424) * lu(1870) + lu(1904) = lu(1904) - lu(425) * lu(1870) + lu(1907) = lu(1907) - lu(426) * lu(1870) + lu(427) = 1._r8 / lu(427) + lu(428) = lu(428) * lu(427) + lu(429) = lu(429) * lu(427) + lu(430) = lu(430) * lu(427) + lu(431) = lu(431) * lu(427) + lu(432) = lu(432) * lu(427) + lu(433) = lu(433) * lu(427) + lu(434) = lu(434) * lu(427) + lu(435) = lu(435) * lu(427) + lu(436) = lu(436) * lu(427) + lu(437) = lu(437) * lu(427) + lu(438) = lu(438) * lu(427) + lu(439) = lu(439) * lu(427) + lu(440) = lu(440) * lu(427) + lu(441) = lu(441) * lu(427) + lu(442) = lu(442) * lu(427) + lu(707) = lu(707) - lu(428) * lu(706) + lu(712) = lu(712) - lu(429) * lu(706) + lu(713) = - lu(430) * lu(706) + lu(714) = lu(714) - lu(431) * lu(706) + lu(718) = lu(718) - lu(432) * lu(706) + lu(719) = lu(719) - lu(433) * lu(706) + lu(720) = lu(720) - lu(434) * lu(706) + lu(721) = lu(721) - lu(435) * lu(706) + lu(722) = lu(722) - lu(436) * lu(706) + lu(723) = lu(723) - lu(437) * lu(706) + lu(725) = lu(725) - lu(438) * lu(706) + lu(726) = lu(726) - lu(439) * lu(706) + lu(727) = lu(727) - lu(440) * lu(706) + lu(728) = lu(728) - lu(441) * lu(706) + lu(730) = lu(730) - lu(442) * lu(706) + lu(882) = lu(882) - lu(428) * lu(881) + lu(893) = lu(893) - lu(429) * lu(881) + lu(894) = lu(894) - lu(430) * lu(881) + lu(896) = lu(896) - lu(431) * lu(881) + lu(900) = lu(900) - lu(432) * lu(881) + lu(901) = lu(901) - lu(433) * lu(881) + lu(903) = lu(903) - lu(434) * lu(881) + lu(904) = lu(904) - lu(435) * lu(881) + lu(906) = lu(906) - lu(436) * lu(881) + lu(907) = lu(907) - lu(437) * lu(881) + lu(910) = lu(910) - lu(438) * lu(881) + lu(911) = lu(911) - lu(439) * lu(881) + lu(912) = lu(912) - lu(440) * lu(881) + lu(913) = lu(913) - lu(441) * lu(881) + lu(916) = lu(916) - lu(442) * lu(881) + lu(997) = - lu(428) * lu(995) + lu(1007) = lu(1007) - lu(429) * lu(995) + lu(1008) = lu(1008) - lu(430) * lu(995) + lu(1010) = lu(1010) - lu(431) * lu(995) + lu(1014) = lu(1014) - lu(432) * lu(995) + lu(1015) = lu(1015) - lu(433) * lu(995) + lu(1017) = lu(1017) - lu(434) * lu(995) + lu(1018) = lu(1018) - lu(435) * lu(995) + lu(1020) = lu(1020) - lu(436) * lu(995) + lu(1021) = lu(1021) - lu(437) * lu(995) + lu(1024) = lu(1024) - lu(438) * lu(995) + lu(1025) = lu(1025) - lu(439) * lu(995) + lu(1026) = lu(1026) - lu(440) * lu(995) + lu(1027) = lu(1027) - lu(441) * lu(995) + lu(1030) = lu(1030) - lu(442) * lu(995) + lu(1222) = lu(1222) - lu(428) * lu(1221) + lu(1233) = lu(1233) - lu(429) * lu(1221) + lu(1234) = lu(1234) - lu(430) * lu(1221) + lu(1236) = lu(1236) - lu(431) * lu(1221) + lu(1240) = lu(1240) - lu(432) * lu(1221) + lu(1241) = lu(1241) - lu(433) * lu(1221) + lu(1243) = lu(1243) - lu(434) * lu(1221) + lu(1244) = lu(1244) - lu(435) * lu(1221) + lu(1246) = lu(1246) - lu(436) * lu(1221) + lu(1247) = lu(1247) - lu(437) * lu(1221) + lu(1250) = lu(1250) - lu(438) * lu(1221) + lu(1251) = lu(1251) - lu(439) * lu(1221) + lu(1252) = lu(1252) - lu(440) * lu(1221) + lu(1253) = lu(1253) - lu(441) * lu(1221) + lu(1256) = lu(1256) - lu(442) * lu(1221) + lu(1360) = lu(1360) - lu(428) * lu(1359) + lu(1371) = lu(1371) - lu(429) * lu(1359) + lu(1372) = lu(1372) - lu(430) * lu(1359) + lu(1374) = lu(1374) - lu(431) * lu(1359) + lu(1378) = lu(1378) - lu(432) * lu(1359) + lu(1379) = lu(1379) - lu(433) * lu(1359) + lu(1381) = lu(1381) - lu(434) * lu(1359) + lu(1382) = lu(1382) - lu(435) * lu(1359) + lu(1384) = lu(1384) - lu(436) * lu(1359) + lu(1385) = lu(1385) - lu(437) * lu(1359) + lu(1388) = lu(1388) - lu(438) * lu(1359) + lu(1389) = lu(1389) - lu(439) * lu(1359) + lu(1390) = lu(1390) - lu(440) * lu(1359) + lu(1391) = lu(1391) - lu(441) * lu(1359) + lu(1394) = lu(1394) - lu(442) * lu(1359) + lu(1444) = lu(1444) - lu(428) * lu(1443) + lu(1455) = lu(1455) - lu(429) * lu(1443) + lu(1456) = lu(1456) - lu(430) * lu(1443) + lu(1458) = lu(1458) - lu(431) * lu(1443) + lu(1462) = lu(1462) - lu(432) * lu(1443) + lu(1463) = lu(1463) - lu(433) * lu(1443) + lu(1465) = lu(1465) - lu(434) * lu(1443) + lu(1466) = lu(1466) - lu(435) * lu(1443) + lu(1468) = lu(1468) - lu(436) * lu(1443) + lu(1469) = lu(1469) - lu(437) * lu(1443) + lu(1472) = lu(1472) - lu(438) * lu(1443) + lu(1473) = lu(1473) - lu(439) * lu(1443) + lu(1474) = lu(1474) - lu(440) * lu(1443) + lu(1475) = lu(1475) - lu(441) * lu(1443) + lu(1478) = lu(1478) - lu(442) * lu(1443) + lu(1663) = lu(1663) - lu(428) * lu(1662) + lu(1674) = lu(1674) - lu(429) * lu(1662) + lu(1675) = lu(1675) - lu(430) * lu(1662) + lu(1677) = lu(1677) - lu(431) * lu(1662) + lu(1681) = lu(1681) - lu(432) * lu(1662) + lu(1682) = lu(1682) - lu(433) * lu(1662) + lu(1684) = lu(1684) - lu(434) * lu(1662) + lu(1685) = lu(1685) - lu(435) * lu(1662) + lu(1687) = lu(1687) - lu(436) * lu(1662) + lu(1688) = lu(1688) - lu(437) * lu(1662) + lu(1691) = lu(1691) - lu(438) * lu(1662) + lu(1692) = lu(1692) - lu(439) * lu(1662) + lu(1693) = lu(1693) - lu(440) * lu(1662) + lu(1694) = lu(1694) - lu(441) * lu(1662) + lu(1697) = lu(1697) - lu(442) * lu(1662) + lu(1703) = lu(1703) - lu(428) * lu(1701) + lu(1714) = - lu(429) * lu(1701) + lu(1715) = lu(1715) - lu(430) * lu(1701) + lu(1717) = lu(1717) - lu(431) * lu(1701) + lu(1721) = lu(1721) - lu(432) * lu(1701) + lu(1722) = - lu(433) * lu(1701) + lu(1724) = lu(1724) - lu(434) * lu(1701) + lu(1725) = - lu(435) * lu(1701) + lu(1727) = - lu(436) * lu(1701) + lu(1728) = lu(1728) - lu(437) * lu(1701) + lu(1731) = lu(1731) - lu(438) * lu(1701) + lu(1732) = - lu(439) * lu(1701) + lu(1733) = lu(1733) - lu(440) * lu(1701) + lu(1734) = - lu(441) * lu(1701) + lu(1737) = - lu(442) * lu(1701) + lu(1748) = lu(1748) - lu(428) * lu(1747) + lu(1760) = lu(1760) - lu(429) * lu(1747) + lu(1761) = lu(1761) - lu(430) * lu(1747) + lu(1763) = lu(1763) - lu(431) * lu(1747) + lu(1767) = lu(1767) - lu(432) * lu(1747) + lu(1768) = lu(1768) - lu(433) * lu(1747) + lu(1770) = lu(1770) - lu(434) * lu(1747) + lu(1771) = lu(1771) - lu(435) * lu(1747) + lu(1773) = lu(1773) - lu(436) * lu(1747) + lu(1774) = lu(1774) - lu(437) * lu(1747) + lu(1777) = lu(1777) - lu(438) * lu(1747) + lu(1778) = lu(1778) - lu(439) * lu(1747) + lu(1779) = lu(1779) - lu(440) * lu(1747) + lu(1780) = lu(1780) - lu(441) * lu(1747) + lu(1783) = lu(1783) - lu(442) * lu(1747) + lu(1872) = lu(1872) - lu(428) * lu(1871) + lu(1884) = lu(1884) - lu(429) * lu(1871) + lu(1885) = lu(1885) - lu(430) * lu(1871) + lu(1887) = lu(1887) - lu(431) * lu(1871) + lu(1891) = lu(1891) - lu(432) * lu(1871) + lu(1892) = lu(1892) - lu(433) * lu(1871) + lu(1894) = lu(1894) - lu(434) * lu(1871) + lu(1895) = lu(1895) - lu(435) * lu(1871) + lu(1897) = lu(1897) - lu(436) * lu(1871) + lu(1898) = lu(1898) - lu(437) * lu(1871) + lu(1901) = lu(1901) - lu(438) * lu(1871) + lu(1902) = lu(1902) - lu(439) * lu(1871) + lu(1903) = lu(1903) - lu(440) * lu(1871) + lu(1904) = lu(1904) - lu(441) * lu(1871) + lu(1907) = lu(1907) - lu(442) * lu(1871) + end subroutine lu_fac11 + subroutine lu_fac12( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(445) = 1._r8 / lu(445) + lu(446) = lu(446) * lu(445) + lu(447) = lu(447) * lu(445) + lu(448) = lu(448) * lu(445) + lu(449) = lu(449) * lu(445) + lu(450) = lu(450) * lu(445) + lu(451) = lu(451) * lu(445) + lu(452) = lu(452) * lu(445) + lu(453) = lu(453) * lu(445) + lu(454) = lu(454) * lu(445) + lu(455) = lu(455) * lu(445) + lu(456) = lu(456) * lu(445) + lu(457) = lu(457) * lu(445) + lu(458) = lu(458) * lu(445) + lu(575) = lu(575) - lu(446) * lu(574) + lu(576) = - lu(447) * lu(574) + lu(577) = lu(577) - lu(448) * lu(574) + lu(578) = lu(578) - lu(449) * lu(574) + lu(579) = lu(579) - lu(450) * lu(574) + lu(580) = lu(580) - lu(451) * lu(574) + lu(582) = lu(582) - lu(452) * lu(574) + lu(583) = lu(583) - lu(453) * lu(574) + lu(587) = lu(587) - lu(454) * lu(574) + lu(588) = - lu(455) * lu(574) + lu(592) = lu(592) - lu(456) * lu(574) + lu(593) = lu(593) - lu(457) * lu(574) + lu(594) = lu(594) - lu(458) * lu(574) + lu(599) = - lu(446) * lu(597) + lu(600) = lu(600) - lu(447) * lu(597) + lu(601) = lu(601) - lu(448) * lu(597) + lu(602) = lu(602) - lu(449) * lu(597) + lu(603) = lu(603) - lu(450) * lu(597) + lu(604) = lu(604) - lu(451) * lu(597) + lu(606) = - lu(452) * lu(597) + lu(608) = lu(608) - lu(453) * lu(597) + lu(612) = lu(612) - lu(454) * lu(597) + lu(613) = lu(613) - lu(455) * lu(597) + lu(617) = - lu(456) * lu(597) + lu(618) = - lu(457) * lu(597) + lu(619) = - lu(458) * lu(597) + lu(629) = lu(629) - lu(446) * lu(628) + lu(630) = lu(630) - lu(447) * lu(628) + lu(631) = lu(631) - lu(448) * lu(628) + lu(632) = lu(632) - lu(449) * lu(628) + lu(633) = lu(633) - lu(450) * lu(628) + lu(634) = lu(634) - lu(451) * lu(628) + lu(636) = lu(636) - lu(452) * lu(628) + lu(638) = lu(638) - lu(453) * lu(628) + lu(642) = lu(642) - lu(454) * lu(628) + lu(644) = - lu(455) * lu(628) + lu(648) = lu(648) - lu(456) * lu(628) + lu(649) = lu(649) - lu(457) * lu(628) + lu(652) = lu(652) - lu(458) * lu(628) + lu(741) = lu(741) - lu(446) * lu(739) + lu(742) = lu(742) - lu(447) * lu(739) + lu(743) = lu(743) - lu(448) * lu(739) + lu(744) = lu(744) - lu(449) * lu(739) + lu(745) = lu(745) - lu(450) * lu(739) + lu(746) = lu(746) - lu(451) * lu(739) + lu(748) = lu(748) - lu(452) * lu(739) + lu(750) = lu(750) - lu(453) * lu(739) + lu(755) = lu(755) - lu(454) * lu(739) + lu(757) = - lu(455) * lu(739) + lu(761) = lu(761) - lu(456) * lu(739) + lu(762) = - lu(457) * lu(739) + lu(765) = lu(765) - lu(458) * lu(739) + lu(815) = lu(815) - lu(446) * lu(813) + lu(816) = lu(816) - lu(447) * lu(813) + lu(817) = lu(817) - lu(448) * lu(813) + lu(818) = lu(818) - lu(449) * lu(813) + lu(819) = lu(819) - lu(450) * lu(813) + lu(820) = lu(820) - lu(451) * lu(813) + lu(822) = lu(822) - lu(452) * lu(813) + lu(824) = lu(824) - lu(453) * lu(813) + lu(829) = lu(829) - lu(454) * lu(813) + lu(831) = lu(831) - lu(455) * lu(813) + lu(835) = lu(835) - lu(456) * lu(813) + lu(836) = lu(836) - lu(457) * lu(813) + lu(839) = lu(839) - lu(458) * lu(813) + lu(1095) = lu(1095) - lu(446) * lu(1092) + lu(1096) = lu(1096) - lu(447) * lu(1092) + lu(1097) = lu(1097) - lu(448) * lu(1092) + lu(1101) = lu(1101) - lu(449) * lu(1092) + lu(1103) = lu(1103) - lu(450) * lu(1092) + lu(1106) = lu(1106) - lu(451) * lu(1092) + lu(1108) = lu(1108) - lu(452) * lu(1092) + lu(1110) = lu(1110) - lu(453) * lu(1092) + lu(1115) = lu(1115) - lu(454) * lu(1092) + lu(1117) = lu(1117) - lu(455) * lu(1092) + lu(1122) = lu(1122) - lu(456) * lu(1092) + lu(1124) = lu(1124) - lu(457) * lu(1092) + lu(1127) = lu(1127) - lu(458) * lu(1092) + lu(1319) = lu(1319) - lu(446) * lu(1314) + lu(1320) = lu(1320) - lu(447) * lu(1314) + lu(1321) = lu(1321) - lu(448) * lu(1314) + lu(1324) = lu(1324) - lu(449) * lu(1314) + lu(1326) = lu(1326) - lu(450) * lu(1314) + lu(1329) = lu(1329) - lu(451) * lu(1314) + lu(1331) = lu(1331) - lu(452) * lu(1314) + lu(1333) = lu(1333) - lu(453) * lu(1314) + lu(1338) = lu(1338) - lu(454) * lu(1314) + lu(1340) = lu(1340) - lu(455) * lu(1314) + lu(1345) = lu(1345) - lu(456) * lu(1314) + lu(1347) = lu(1347) - lu(457) * lu(1314) + lu(1350) = lu(1350) - lu(458) * lu(1314) + lu(1489) = - lu(446) * lu(1484) + lu(1490) = lu(1490) - lu(447) * lu(1484) + lu(1491) = - lu(448) * lu(1484) + lu(1494) = lu(1494) - lu(449) * lu(1484) + lu(1496) = lu(1496) - lu(450) * lu(1484) + lu(1499) = lu(1499) - lu(451) * lu(1484) + lu(1501) = - lu(452) * lu(1484) + lu(1503) = lu(1503) - lu(453) * lu(1484) + lu(1508) = lu(1508) - lu(454) * lu(1484) + lu(1510) = lu(1510) - lu(455) * lu(1484) + lu(1515) = lu(1515) - lu(456) * lu(1484) + lu(1517) = - lu(457) * lu(1484) + lu(1520) = lu(1520) - lu(458) * lu(1484) + lu(1580) = - lu(446) * lu(1578) + lu(1581) = lu(1581) - lu(447) * lu(1578) + lu(1582) = - lu(448) * lu(1578) + lu(1586) = lu(1586) - lu(449) * lu(1578) + lu(1588) = lu(1588) - lu(450) * lu(1578) + lu(1591) = lu(1591) - lu(451) * lu(1578) + lu(1593) = lu(1593) - lu(452) * lu(1578) + lu(1595) = lu(1595) - lu(453) * lu(1578) + lu(1600) = lu(1600) - lu(454) * lu(1578) + lu(1602) = lu(1602) - lu(455) * lu(1578) + lu(1607) = lu(1607) - lu(456) * lu(1578) + lu(1609) = lu(1609) - lu(457) * lu(1578) + lu(1612) = lu(1612) - lu(458) * lu(1578) + lu(1624) = - lu(446) * lu(1619) + lu(1625) = lu(1625) - lu(447) * lu(1619) + lu(1626) = - lu(448) * lu(1619) + lu(1628) = lu(1628) - lu(449) * lu(1619) + lu(1630) = lu(1630) - lu(450) * lu(1619) + lu(1632) = lu(1632) - lu(451) * lu(1619) + lu(1634) = - lu(452) * lu(1619) + lu(1636) = lu(1636) - lu(453) * lu(1619) + lu(1641) = lu(1641) - lu(454) * lu(1619) + lu(1643) = lu(1643) - lu(455) * lu(1619) + lu(1648) = lu(1648) - lu(456) * lu(1619) + lu(1650) = lu(1650) - lu(457) * lu(1619) + lu(1653) = lu(1653) - lu(458) * lu(1619) + lu(1705) = lu(1705) - lu(446) * lu(1702) + lu(1706) = - lu(447) * lu(1702) + lu(1707) = - lu(448) * lu(1702) + lu(1710) = lu(1710) - lu(449) * lu(1702) + lu(1712) = lu(1712) - lu(450) * lu(1702) + lu(1715) = lu(1715) - lu(451) * lu(1702) + lu(1717) = lu(1717) - lu(452) * lu(1702) + lu(1719) = - lu(453) * lu(1702) + lu(1724) = lu(1724) - lu(454) * lu(1702) + lu(1726) = lu(1726) - lu(455) * lu(1702) + lu(1731) = lu(1731) - lu(456) * lu(1702) + lu(1733) = lu(1733) - lu(457) * lu(1702) + lu(1736) = lu(1736) - lu(458) * lu(1702) + lu(1828) = lu(1828) - lu(446) * lu(1827) + lu(1829) = lu(1829) - lu(447) * lu(1827) + lu(1830) = - lu(448) * lu(1827) + lu(1834) = lu(1834) - lu(449) * lu(1827) + lu(1836) = lu(1836) - lu(450) * lu(1827) + lu(1839) = lu(1839) - lu(451) * lu(1827) + lu(1841) = lu(1841) - lu(452) * lu(1827) + lu(1843) = lu(1843) - lu(453) * lu(1827) + lu(1848) = lu(1848) - lu(454) * lu(1827) + lu(1850) = lu(1850) - lu(455) * lu(1827) + lu(1855) = lu(1855) - lu(456) * lu(1827) + lu(1857) = lu(1857) - lu(457) * lu(1827) + lu(1860) = lu(1860) - lu(458) * lu(1827) + lu(459) = 1._r8 / lu(459) + lu(460) = lu(460) * lu(459) + lu(461) = lu(461) * lu(459) + lu(462) = lu(462) * lu(459) + lu(463) = lu(463) * lu(459) + lu(464) = lu(464) * lu(459) + lu(465) = lu(465) * lu(459) + lu(466) = lu(466) * lu(459) + lu(467) = lu(467) * lu(459) + lu(468) = lu(468) * lu(459) + lu(469) = lu(469) * lu(459) + lu(470) = lu(470) * lu(459) + lu(471) = lu(471) * lu(459) + lu(472) = lu(472) * lu(459) + lu(473) = lu(473) * lu(459) + lu(678) = - lu(460) * lu(675) + lu(680) = lu(680) - lu(461) * lu(675) + lu(682) = lu(682) - lu(462) * lu(675) + lu(684) = lu(684) - lu(463) * lu(675) + lu(685) = - lu(464) * lu(675) + lu(687) = lu(687) - lu(465) * lu(675) + lu(688) = lu(688) - lu(466) * lu(675) + lu(689) = - lu(467) * lu(675) + lu(690) = lu(690) - lu(468) * lu(675) + lu(692) = - lu(469) * lu(675) + lu(695) = lu(695) - lu(470) * lu(675) + lu(697) = lu(697) - lu(471) * lu(675) + lu(698) = lu(698) - lu(472) * lu(675) + lu(703) = lu(703) - lu(473) * lu(675) + lu(846) = lu(846) - lu(460) * lu(842) + lu(847) = lu(847) - lu(461) * lu(842) + lu(849) = lu(849) - lu(462) * lu(842) + lu(851) = lu(851) - lu(463) * lu(842) + lu(852) = lu(852) - lu(464) * lu(842) + lu(854) = - lu(465) * lu(842) + lu(855) = lu(855) - lu(466) * lu(842) + lu(856) = - lu(467) * lu(842) + lu(857) = lu(857) - lu(468) * lu(842) + lu(859) = lu(859) - lu(469) * lu(842) + lu(862) = lu(862) - lu(470) * lu(842) + lu(864) = lu(864) - lu(471) * lu(842) + lu(865) = lu(865) - lu(472) * lu(842) + lu(871) = lu(871) - lu(473) * lu(842) + lu(925) = - lu(460) * lu(919) + lu(927) = lu(927) - lu(461) * lu(919) + lu(929) = lu(929) - lu(462) * lu(919) + lu(931) = lu(931) - lu(463) * lu(919) + lu(932) = lu(932) - lu(464) * lu(919) + lu(934) = lu(934) - lu(465) * lu(919) + lu(935) = lu(935) - lu(466) * lu(919) + lu(936) = lu(936) - lu(467) * lu(919) + lu(937) = lu(937) - lu(468) * lu(919) + lu(939) = - lu(469) * lu(919) + lu(942) = lu(942) - lu(470) * lu(919) + lu(944) = lu(944) - lu(471) * lu(919) + lu(945) = lu(945) - lu(472) * lu(919) + lu(951) = lu(951) - lu(473) * lu(919) + lu(958) = - lu(460) * lu(956) + lu(960) = lu(960) - lu(461) * lu(956) + lu(962) = - lu(462) * lu(956) + lu(964) = lu(964) - lu(463) * lu(956) + lu(965) = lu(965) - lu(464) * lu(956) + lu(967) = lu(967) - lu(465) * lu(956) + lu(968) = lu(968) - lu(466) * lu(956) + lu(969) = lu(969) - lu(467) * lu(956) + lu(970) = lu(970) - lu(468) * lu(956) + lu(972) = - lu(469) * lu(956) + lu(975) = lu(975) - lu(470) * lu(956) + lu(977) = lu(977) - lu(471) * lu(956) + lu(978) = lu(978) - lu(472) * lu(956) + lu(984) = - lu(473) * lu(956) + lu(1042) = lu(1042) - lu(460) * lu(1037) + lu(1044) = lu(1044) - lu(461) * lu(1037) + lu(1046) = - lu(462) * lu(1037) + lu(1048) = lu(1048) - lu(463) * lu(1037) + lu(1049) = lu(1049) - lu(464) * lu(1037) + lu(1051) = lu(1051) - lu(465) * lu(1037) + lu(1052) = lu(1052) - lu(466) * lu(1037) + lu(1053) = lu(1053) - lu(467) * lu(1037) + lu(1054) = lu(1054) - lu(468) * lu(1037) + lu(1056) = lu(1056) - lu(469) * lu(1037) + lu(1059) = lu(1059) - lu(470) * lu(1037) + lu(1061) = lu(1061) - lu(471) * lu(1037) + lu(1062) = lu(1062) - lu(472) * lu(1037) + lu(1068) = lu(1068) - lu(473) * lu(1037) + lu(1100) = lu(1100) - lu(460) * lu(1093) + lu(1102) = lu(1102) - lu(461) * lu(1093) + lu(1104) = lu(1104) - lu(462) * lu(1093) + lu(1106) = lu(1106) - lu(463) * lu(1093) + lu(1107) = lu(1107) - lu(464) * lu(1093) + lu(1109) = lu(1109) - lu(465) * lu(1093) + lu(1110) = lu(1110) - lu(466) * lu(1093) + lu(1111) = lu(1111) - lu(467) * lu(1093) + lu(1112) = lu(1112) - lu(468) * lu(1093) + lu(1114) = lu(1114) - lu(469) * lu(1093) + lu(1117) = lu(1117) - lu(470) * lu(1093) + lu(1119) = lu(1119) - lu(471) * lu(1093) + lu(1120) = lu(1120) - lu(472) * lu(1093) + lu(1126) = lu(1126) - lu(473) * lu(1093) + lu(1186) = - lu(460) * lu(1181) + lu(1188) = - lu(461) * lu(1181) + lu(1190) = lu(1190) - lu(462) * lu(1181) + lu(1192) = lu(1192) - lu(463) * lu(1181) + lu(1193) = - lu(464) * lu(1181) + lu(1195) = lu(1195) - lu(465) * lu(1181) + lu(1196) = lu(1196) - lu(466) * lu(1181) + lu(1197) = lu(1197) - lu(467) * lu(1181) + lu(1198) = lu(1198) - lu(468) * lu(1181) + lu(1200) = lu(1200) - lu(469) * lu(1181) + lu(1203) = lu(1203) - lu(470) * lu(1181) + lu(1205) = lu(1205) - lu(471) * lu(1181) + lu(1206) = lu(1206) - lu(472) * lu(1181) + lu(1212) = lu(1212) - lu(473) * lu(1181) + lu(1264) = lu(1264) - lu(460) * lu(1259) + lu(1266) = lu(1266) - lu(461) * lu(1259) + lu(1268) = lu(1268) - lu(462) * lu(1259) + lu(1270) = lu(1270) - lu(463) * lu(1259) + lu(1271) = lu(1271) - lu(464) * lu(1259) + lu(1273) = lu(1273) - lu(465) * lu(1259) + lu(1274) = lu(1274) - lu(466) * lu(1259) + lu(1275) = lu(1275) - lu(467) * lu(1259) + lu(1276) = lu(1276) - lu(468) * lu(1259) + lu(1278) = lu(1278) - lu(469) * lu(1259) + lu(1281) = lu(1281) - lu(470) * lu(1259) + lu(1283) = lu(1283) - lu(471) * lu(1259) + lu(1284) = lu(1284) - lu(472) * lu(1259) + lu(1290) = lu(1290) - lu(473) * lu(1259) + lu(1407) = - lu(460) * lu(1405) + lu(1409) = - lu(461) * lu(1405) + lu(1411) = lu(1411) - lu(462) * lu(1405) + lu(1413) = lu(1413) - lu(463) * lu(1405) + lu(1414) = lu(1414) - lu(464) * lu(1405) + lu(1416) = lu(1416) - lu(465) * lu(1405) + lu(1417) = lu(1417) - lu(466) * lu(1405) + lu(1418) = lu(1418) - lu(467) * lu(1405) + lu(1419) = lu(1419) - lu(468) * lu(1405) + lu(1421) = lu(1421) - lu(469) * lu(1405) + lu(1424) = lu(1424) - lu(470) * lu(1405) + lu(1426) = lu(1426) - lu(471) * lu(1405) + lu(1427) = lu(1427) - lu(472) * lu(1405) + lu(1433) = lu(1433) - lu(473) * lu(1405) + lu(1493) = lu(1493) - lu(460) * lu(1485) + lu(1495) = lu(1495) - lu(461) * lu(1485) + lu(1497) = lu(1497) - lu(462) * lu(1485) + lu(1499) = lu(1499) - lu(463) * lu(1485) + lu(1500) = - lu(464) * lu(1485) + lu(1502) = lu(1502) - lu(465) * lu(1485) + lu(1503) = lu(1503) - lu(466) * lu(1485) + lu(1504) = lu(1504) - lu(467) * lu(1485) + lu(1505) = lu(1505) - lu(468) * lu(1485) + lu(1507) = lu(1507) - lu(469) * lu(1485) + lu(1510) = lu(1510) - lu(470) * lu(1485) + lu(1512) = lu(1512) - lu(471) * lu(1485) + lu(1513) = lu(1513) - lu(472) * lu(1485) + lu(1519) = - lu(473) * lu(1485) + lu(1539) = lu(1539) - lu(460) * lu(1530) + lu(1541) = lu(1541) - lu(461) * lu(1530) + lu(1543) = lu(1543) - lu(462) * lu(1530) + lu(1545) = lu(1545) - lu(463) * lu(1530) + lu(1546) = lu(1546) - lu(464) * lu(1530) + lu(1548) = lu(1548) - lu(465) * lu(1530) + lu(1549) = lu(1549) - lu(466) * lu(1530) + lu(1550) = lu(1550) - lu(467) * lu(1530) + lu(1551) = lu(1551) - lu(468) * lu(1530) + lu(1553) = lu(1553) - lu(469) * lu(1530) + lu(1556) = lu(1556) - lu(470) * lu(1530) + lu(1558) = lu(1558) - lu(471) * lu(1530) + lu(1559) = lu(1559) - lu(472) * lu(1530) + lu(1565) = lu(1565) - lu(473) * lu(1530) + lu(1791) = lu(1791) - lu(460) * lu(1788) + lu(1793) = lu(1793) - lu(461) * lu(1788) + lu(1795) = - lu(462) * lu(1788) + lu(1797) = lu(1797) - lu(463) * lu(1788) + lu(1798) = - lu(464) * lu(1788) + lu(1800) = lu(1800) - lu(465) * lu(1788) + lu(1801) = lu(1801) - lu(466) * lu(1788) + lu(1802) = lu(1802) - lu(467) * lu(1788) + lu(1803) = lu(1803) - lu(468) * lu(1788) + lu(1805) = lu(1805) - lu(469) * lu(1788) + lu(1808) = lu(1808) - lu(470) * lu(1788) + lu(1810) = lu(1810) - lu(471) * lu(1788) + lu(1811) = lu(1811) - lu(472) * lu(1788) + lu(1817) = lu(1817) - lu(473) * lu(1788) + end subroutine lu_fac12 + subroutine lu_fac13( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(480) = 1._r8 / lu(480) + lu(481) = lu(481) * lu(480) + lu(482) = lu(482) * lu(480) + lu(483) = lu(483) * lu(480) + lu(484) = lu(484) * lu(480) + lu(485) = lu(485) * lu(480) + lu(486) = lu(486) * lu(480) + lu(487) = lu(487) * lu(480) + lu(488) = lu(488) * lu(480) + lu(489) = lu(489) * lu(480) + lu(490) = lu(490) * lu(480) + lu(491) = lu(491) * lu(480) + lu(492) = lu(492) * lu(480) + lu(493) = lu(493) * lu(480) + lu(494) = lu(494) * lu(480) + lu(495) = lu(495) * lu(480) + lu(600) = lu(600) - lu(481) * lu(598) + lu(602) = lu(602) - lu(482) * lu(598) + lu(603) = lu(603) - lu(483) * lu(598) + lu(604) = lu(604) - lu(484) * lu(598) + lu(606) = lu(606) - lu(485) * lu(598) + lu(607) = lu(607) - lu(486) * lu(598) + lu(608) = lu(608) - lu(487) * lu(598) + lu(610) = lu(610) - lu(488) * lu(598) + lu(612) = lu(612) - lu(489) * lu(598) + lu(614) = - lu(490) * lu(598) + lu(615) = - lu(491) * lu(598) + lu(616) = - lu(492) * lu(598) + lu(617) = lu(617) - lu(493) * lu(598) + lu(618) = lu(618) - lu(494) * lu(598) + lu(619) = lu(619) - lu(495) * lu(598) + lu(742) = lu(742) - lu(481) * lu(740) + lu(744) = lu(744) - lu(482) * lu(740) + lu(745) = lu(745) - lu(483) * lu(740) + lu(746) = lu(746) - lu(484) * lu(740) + lu(748) = lu(748) - lu(485) * lu(740) + lu(749) = lu(749) - lu(486) * lu(740) + lu(750) = lu(750) - lu(487) * lu(740) + lu(752) = lu(752) - lu(488) * lu(740) + lu(755) = lu(755) - lu(489) * lu(740) + lu(758) = lu(758) - lu(490) * lu(740) + lu(759) = lu(759) - lu(491) * lu(740) + lu(760) = lu(760) - lu(492) * lu(740) + lu(761) = lu(761) - lu(493) * lu(740) + lu(762) = lu(762) - lu(494) * lu(740) + lu(765) = lu(765) - lu(495) * lu(740) + lu(816) = lu(816) - lu(481) * lu(814) + lu(818) = lu(818) - lu(482) * lu(814) + lu(819) = lu(819) - lu(483) * lu(814) + lu(820) = lu(820) - lu(484) * lu(814) + lu(822) = lu(822) - lu(485) * lu(814) + lu(823) = lu(823) - lu(486) * lu(814) + lu(824) = lu(824) - lu(487) * lu(814) + lu(826) = lu(826) - lu(488) * lu(814) + lu(829) = lu(829) - lu(489) * lu(814) + lu(832) = lu(832) - lu(490) * lu(814) + lu(833) = lu(833) - lu(491) * lu(814) + lu(834) = lu(834) - lu(492) * lu(814) + lu(835) = lu(835) - lu(493) * lu(814) + lu(836) = lu(836) - lu(494) * lu(814) + lu(839) = lu(839) - lu(495) * lu(814) + lu(998) = lu(998) - lu(481) * lu(996) + lu(1003) = lu(1003) - lu(482) * lu(996) + lu(1005) = lu(1005) - lu(483) * lu(996) + lu(1008) = lu(1008) - lu(484) * lu(996) + lu(1010) = lu(1010) - lu(485) * lu(996) + lu(1011) = - lu(486) * lu(996) + lu(1012) = lu(1012) - lu(487) * lu(996) + lu(1014) = lu(1014) - lu(488) * lu(996) + lu(1017) = lu(1017) - lu(489) * lu(996) + lu(1021) = lu(1021) - lu(490) * lu(996) + lu(1022) = lu(1022) - lu(491) * lu(996) + lu(1023) = lu(1023) - lu(492) * lu(996) + lu(1024) = lu(1024) - lu(493) * lu(996) + lu(1026) = lu(1026) - lu(494) * lu(996) + lu(1029) = lu(1029) - lu(495) * lu(996) + lu(1039) = lu(1039) - lu(481) * lu(1038) + lu(1043) = lu(1043) - lu(482) * lu(1038) + lu(1045) = lu(1045) - lu(483) * lu(1038) + lu(1048) = lu(1048) - lu(484) * lu(1038) + lu(1050) = - lu(485) * lu(1038) + lu(1051) = lu(1051) - lu(486) * lu(1038) + lu(1052) = lu(1052) - lu(487) * lu(1038) + lu(1054) = lu(1054) - lu(488) * lu(1038) + lu(1057) = lu(1057) - lu(489) * lu(1038) + lu(1061) = lu(1061) - lu(490) * lu(1038) + lu(1062) = lu(1062) - lu(491) * lu(1038) + lu(1063) = lu(1063) - lu(492) * lu(1038) + lu(1064) = lu(1064) - lu(493) * lu(1038) + lu(1066) = - lu(494) * lu(1038) + lu(1069) = lu(1069) - lu(495) * lu(1038) + lu(1096) = lu(1096) - lu(481) * lu(1094) + lu(1101) = lu(1101) - lu(482) * lu(1094) + lu(1103) = lu(1103) - lu(483) * lu(1094) + lu(1106) = lu(1106) - lu(484) * lu(1094) + lu(1108) = lu(1108) - lu(485) * lu(1094) + lu(1109) = lu(1109) - lu(486) * lu(1094) + lu(1110) = lu(1110) - lu(487) * lu(1094) + lu(1112) = lu(1112) - lu(488) * lu(1094) + lu(1115) = lu(1115) - lu(489) * lu(1094) + lu(1119) = lu(1119) - lu(490) * lu(1094) + lu(1120) = lu(1120) - lu(491) * lu(1094) + lu(1121) = lu(1121) - lu(492) * lu(1094) + lu(1122) = lu(1122) - lu(493) * lu(1094) + lu(1124) = lu(1124) - lu(494) * lu(1094) + lu(1127) = lu(1127) - lu(495) * lu(1094) + lu(1183) = lu(1183) - lu(481) * lu(1182) + lu(1187) = lu(1187) - lu(482) * lu(1182) + lu(1189) = lu(1189) - lu(483) * lu(1182) + lu(1192) = lu(1192) - lu(484) * lu(1182) + lu(1194) = - lu(485) * lu(1182) + lu(1195) = lu(1195) - lu(486) * lu(1182) + lu(1196) = lu(1196) - lu(487) * lu(1182) + lu(1198) = lu(1198) - lu(488) * lu(1182) + lu(1201) = lu(1201) - lu(489) * lu(1182) + lu(1205) = lu(1205) - lu(490) * lu(1182) + lu(1206) = lu(1206) - lu(491) * lu(1182) + lu(1207) = lu(1207) - lu(492) * lu(1182) + lu(1208) = - lu(493) * lu(1182) + lu(1210) = - lu(494) * lu(1182) + lu(1213) = lu(1213) - lu(495) * lu(1182) + lu(1320) = lu(1320) - lu(481) * lu(1315) + lu(1324) = lu(1324) - lu(482) * lu(1315) + lu(1326) = lu(1326) - lu(483) * lu(1315) + lu(1329) = lu(1329) - lu(484) * lu(1315) + lu(1331) = lu(1331) - lu(485) * lu(1315) + lu(1332) = lu(1332) - lu(486) * lu(1315) + lu(1333) = lu(1333) - lu(487) * lu(1315) + lu(1335) = lu(1335) - lu(488) * lu(1315) + lu(1338) = lu(1338) - lu(489) * lu(1315) + lu(1342) = lu(1342) - lu(490) * lu(1315) + lu(1343) = lu(1343) - lu(491) * lu(1315) + lu(1344) = lu(1344) - lu(492) * lu(1315) + lu(1345) = lu(1345) - lu(493) * lu(1315) + lu(1347) = lu(1347) - lu(494) * lu(1315) + lu(1350) = lu(1350) - lu(495) * lu(1315) + lu(1490) = lu(1490) - lu(481) * lu(1486) + lu(1494) = lu(1494) - lu(482) * lu(1486) + lu(1496) = lu(1496) - lu(483) * lu(1486) + lu(1499) = lu(1499) - lu(484) * lu(1486) + lu(1501) = lu(1501) - lu(485) * lu(1486) + lu(1502) = lu(1502) - lu(486) * lu(1486) + lu(1503) = lu(1503) - lu(487) * lu(1486) + lu(1505) = lu(1505) - lu(488) * lu(1486) + lu(1508) = lu(1508) - lu(489) * lu(1486) + lu(1512) = lu(1512) - lu(490) * lu(1486) + lu(1513) = lu(1513) - lu(491) * lu(1486) + lu(1514) = lu(1514) - lu(492) * lu(1486) + lu(1515) = lu(1515) - lu(493) * lu(1486) + lu(1517) = lu(1517) - lu(494) * lu(1486) + lu(1520) = lu(1520) - lu(495) * lu(1486) + lu(1536) = lu(1536) - lu(481) * lu(1531) + lu(1540) = lu(1540) - lu(482) * lu(1531) + lu(1542) = lu(1542) - lu(483) * lu(1531) + lu(1545) = lu(1545) - lu(484) * lu(1531) + lu(1547) = lu(1547) - lu(485) * lu(1531) + lu(1548) = lu(1548) - lu(486) * lu(1531) + lu(1549) = lu(1549) - lu(487) * lu(1531) + lu(1551) = lu(1551) - lu(488) * lu(1531) + lu(1554) = lu(1554) - lu(489) * lu(1531) + lu(1558) = lu(1558) - lu(490) * lu(1531) + lu(1559) = lu(1559) - lu(491) * lu(1531) + lu(1560) = lu(1560) - lu(492) * lu(1531) + lu(1561) = lu(1561) - lu(493) * lu(1531) + lu(1563) = lu(1563) - lu(494) * lu(1531) + lu(1566) = lu(1566) - lu(495) * lu(1531) + lu(1581) = lu(1581) - lu(481) * lu(1579) + lu(1586) = lu(1586) - lu(482) * lu(1579) + lu(1588) = lu(1588) - lu(483) * lu(1579) + lu(1591) = lu(1591) - lu(484) * lu(1579) + lu(1593) = lu(1593) - lu(485) * lu(1579) + lu(1594) = lu(1594) - lu(486) * lu(1579) + lu(1595) = lu(1595) - lu(487) * lu(1579) + lu(1597) = lu(1597) - lu(488) * lu(1579) + lu(1600) = lu(1600) - lu(489) * lu(1579) + lu(1604) = lu(1604) - lu(490) * lu(1579) + lu(1605) = lu(1605) - lu(491) * lu(1579) + lu(1606) = lu(1606) - lu(492) * lu(1579) + lu(1607) = lu(1607) - lu(493) * lu(1579) + lu(1609) = lu(1609) - lu(494) * lu(1579) + lu(1612) = lu(1612) - lu(495) * lu(1579) + lu(1625) = lu(1625) - lu(481) * lu(1620) + lu(1628) = lu(1628) - lu(482) * lu(1620) + lu(1630) = lu(1630) - lu(483) * lu(1620) + lu(1632) = lu(1632) - lu(484) * lu(1620) + lu(1634) = lu(1634) - lu(485) * lu(1620) + lu(1635) = lu(1635) - lu(486) * lu(1620) + lu(1636) = lu(1636) - lu(487) * lu(1620) + lu(1638) = lu(1638) - lu(488) * lu(1620) + lu(1641) = lu(1641) - lu(489) * lu(1620) + lu(1645) = lu(1645) - lu(490) * lu(1620) + lu(1646) = lu(1646) - lu(491) * lu(1620) + lu(1647) = lu(1647) - lu(492) * lu(1620) + lu(1648) = lu(1648) - lu(493) * lu(1620) + lu(1650) = lu(1650) - lu(494) * lu(1620) + lu(1653) = lu(1653) - lu(495) * lu(1620) + lu(496) = 1._r8 / lu(496) + lu(497) = lu(497) * lu(496) + lu(498) = lu(498) * lu(496) + lu(499) = lu(499) * lu(496) + lu(500) = lu(500) * lu(496) + lu(501) = lu(501) * lu(496) + lu(502) = lu(502) * lu(496) + lu(503) = lu(503) * lu(496) + lu(504) = lu(504) * lu(496) + lu(505) = lu(505) * lu(496) + lu(506) = lu(506) * lu(496) + lu(507) = lu(507) * lu(496) + lu(508) = lu(508) * lu(496) + lu(509) = lu(509) * lu(496) + lu(514) = - lu(497) * lu(511) + lu(515) = lu(515) - lu(498) * lu(511) + lu(518) = lu(518) - lu(499) * lu(511) + lu(519) = lu(519) - lu(500) * lu(511) + lu(520) = lu(520) - lu(501) * lu(511) + lu(521) = lu(521) - lu(502) * lu(511) + lu(522) = lu(522) - lu(503) * lu(511) + lu(523) = lu(523) - lu(504) * lu(511) + lu(525) = lu(525) - lu(505) * lu(511) + lu(526) = lu(526) - lu(506) * lu(511) + lu(527) = lu(527) - lu(507) * lu(511) + lu(528) = lu(528) - lu(508) * lu(511) + lu(529) = lu(529) - lu(509) * lu(511) + lu(555) = lu(555) - lu(497) * lu(552) + lu(556) = lu(556) - lu(498) * lu(552) + lu(559) = lu(559) - lu(499) * lu(552) + lu(560) = lu(560) - lu(500) * lu(552) + lu(561) = lu(561) - lu(501) * lu(552) + lu(562) = lu(562) - lu(502) * lu(552) + lu(563) = lu(563) - lu(503) * lu(552) + lu(564) = lu(564) - lu(504) * lu(552) + lu(566) = lu(566) - lu(505) * lu(552) + lu(567) = lu(567) - lu(506) * lu(552) + lu(568) = lu(568) - lu(507) * lu(552) + lu(569) = lu(569) - lu(508) * lu(552) + lu(570) = lu(570) - lu(509) * lu(552) + lu(710) = lu(710) - lu(497) * lu(707) + lu(712) = lu(712) - lu(498) * lu(707) + lu(718) = lu(718) - lu(499) * lu(707) + lu(719) = lu(719) - lu(500) * lu(707) + lu(720) = lu(720) - lu(501) * lu(707) + lu(721) = lu(721) - lu(502) * lu(707) + lu(722) = lu(722) - lu(503) * lu(707) + lu(723) = lu(723) - lu(504) * lu(707) + lu(725) = lu(725) - lu(505) * lu(707) + lu(726) = lu(726) - lu(506) * lu(707) + lu(727) = lu(727) - lu(507) * lu(707) + lu(728) = lu(728) - lu(508) * lu(707) + lu(730) = lu(730) - lu(509) * lu(707) + lu(888) = lu(888) - lu(497) * lu(882) + lu(893) = lu(893) - lu(498) * lu(882) + lu(900) = lu(900) - lu(499) * lu(882) + lu(901) = lu(901) - lu(500) * lu(882) + lu(903) = lu(903) - lu(501) * lu(882) + lu(904) = lu(904) - lu(502) * lu(882) + lu(906) = lu(906) - lu(503) * lu(882) + lu(907) = lu(907) - lu(504) * lu(882) + lu(910) = lu(910) - lu(505) * lu(882) + lu(911) = lu(911) - lu(506) * lu(882) + lu(912) = lu(912) - lu(507) * lu(882) + lu(913) = lu(913) - lu(508) * lu(882) + lu(916) = lu(916) - lu(509) * lu(882) + lu(1002) = lu(1002) - lu(497) * lu(997) + lu(1007) = lu(1007) - lu(498) * lu(997) + lu(1014) = lu(1014) - lu(499) * lu(997) + lu(1015) = lu(1015) - lu(500) * lu(997) + lu(1017) = lu(1017) - lu(501) * lu(997) + lu(1018) = lu(1018) - lu(502) * lu(997) + lu(1020) = lu(1020) - lu(503) * lu(997) + lu(1021) = lu(1021) - lu(504) * lu(997) + lu(1024) = lu(1024) - lu(505) * lu(997) + lu(1025) = lu(1025) - lu(506) * lu(997) + lu(1026) = lu(1026) - lu(507) * lu(997) + lu(1027) = lu(1027) - lu(508) * lu(997) + lu(1030) = lu(1030) - lu(509) * lu(997) + lu(1228) = lu(1228) - lu(497) * lu(1222) + lu(1233) = lu(1233) - lu(498) * lu(1222) + lu(1240) = lu(1240) - lu(499) * lu(1222) + lu(1241) = lu(1241) - lu(500) * lu(1222) + lu(1243) = lu(1243) - lu(501) * lu(1222) + lu(1244) = lu(1244) - lu(502) * lu(1222) + lu(1246) = lu(1246) - lu(503) * lu(1222) + lu(1247) = lu(1247) - lu(504) * lu(1222) + lu(1250) = lu(1250) - lu(505) * lu(1222) + lu(1251) = lu(1251) - lu(506) * lu(1222) + lu(1252) = lu(1252) - lu(507) * lu(1222) + lu(1253) = lu(1253) - lu(508) * lu(1222) + lu(1256) = lu(1256) - lu(509) * lu(1222) + lu(1366) = lu(1366) - lu(497) * lu(1360) + lu(1371) = lu(1371) - lu(498) * lu(1360) + lu(1378) = lu(1378) - lu(499) * lu(1360) + lu(1379) = lu(1379) - lu(500) * lu(1360) + lu(1381) = lu(1381) - lu(501) * lu(1360) + lu(1382) = lu(1382) - lu(502) * lu(1360) + lu(1384) = lu(1384) - lu(503) * lu(1360) + lu(1385) = lu(1385) - lu(504) * lu(1360) + lu(1388) = lu(1388) - lu(505) * lu(1360) + lu(1389) = lu(1389) - lu(506) * lu(1360) + lu(1390) = lu(1390) - lu(507) * lu(1360) + lu(1391) = lu(1391) - lu(508) * lu(1360) + lu(1394) = lu(1394) - lu(509) * lu(1360) + lu(1450) = lu(1450) - lu(497) * lu(1444) + lu(1455) = lu(1455) - lu(498) * lu(1444) + lu(1462) = lu(1462) - lu(499) * lu(1444) + lu(1463) = lu(1463) - lu(500) * lu(1444) + lu(1465) = lu(1465) - lu(501) * lu(1444) + lu(1466) = lu(1466) - lu(502) * lu(1444) + lu(1468) = lu(1468) - lu(503) * lu(1444) + lu(1469) = lu(1469) - lu(504) * lu(1444) + lu(1472) = lu(1472) - lu(505) * lu(1444) + lu(1473) = lu(1473) - lu(506) * lu(1444) + lu(1474) = lu(1474) - lu(507) * lu(1444) + lu(1475) = lu(1475) - lu(508) * lu(1444) + lu(1478) = lu(1478) - lu(509) * lu(1444) + lu(1539) = lu(1539) - lu(497) * lu(1532) + lu(1544) = - lu(498) * lu(1532) + lu(1551) = lu(1551) - lu(499) * lu(1532) + lu(1552) = - lu(500) * lu(1532) + lu(1554) = lu(1554) - lu(501) * lu(1532) + lu(1555) = - lu(502) * lu(1532) + lu(1557) = lu(1557) - lu(503) * lu(1532) + lu(1558) = lu(1558) - lu(504) * lu(1532) + lu(1561) = lu(1561) - lu(505) * lu(1532) + lu(1562) = lu(1562) - lu(506) * lu(1532) + lu(1563) = lu(1563) - lu(507) * lu(1532) + lu(1564) = lu(1564) - lu(508) * lu(1532) + lu(1567) = lu(1567) - lu(509) * lu(1532) + lu(1627) = - lu(497) * lu(1621) + lu(1631) = - lu(498) * lu(1621) + lu(1638) = lu(1638) - lu(499) * lu(1621) + lu(1639) = - lu(500) * lu(1621) + lu(1641) = lu(1641) - lu(501) * lu(1621) + lu(1642) = - lu(502) * lu(1621) + lu(1644) = lu(1644) - lu(503) * lu(1621) + lu(1645) = lu(1645) - lu(504) * lu(1621) + lu(1648) = lu(1648) - lu(505) * lu(1621) + lu(1649) = lu(1649) - lu(506) * lu(1621) + lu(1650) = lu(1650) - lu(507) * lu(1621) + lu(1651) = - lu(508) * lu(1621) + lu(1654) = - lu(509) * lu(1621) + lu(1669) = lu(1669) - lu(497) * lu(1663) + lu(1674) = lu(1674) - lu(498) * lu(1663) + lu(1681) = lu(1681) - lu(499) * lu(1663) + lu(1682) = lu(1682) - lu(500) * lu(1663) + lu(1684) = lu(1684) - lu(501) * lu(1663) + lu(1685) = lu(1685) - lu(502) * lu(1663) + lu(1687) = lu(1687) - lu(503) * lu(1663) + lu(1688) = lu(1688) - lu(504) * lu(1663) + lu(1691) = lu(1691) - lu(505) * lu(1663) + lu(1692) = lu(1692) - lu(506) * lu(1663) + lu(1693) = lu(1693) - lu(507) * lu(1663) + lu(1694) = lu(1694) - lu(508) * lu(1663) + lu(1697) = lu(1697) - lu(509) * lu(1663) + lu(1709) = lu(1709) - lu(497) * lu(1703) + lu(1714) = lu(1714) - lu(498) * lu(1703) + lu(1721) = lu(1721) - lu(499) * lu(1703) + lu(1722) = lu(1722) - lu(500) * lu(1703) + lu(1724) = lu(1724) - lu(501) * lu(1703) + lu(1725) = lu(1725) - lu(502) * lu(1703) + lu(1727) = lu(1727) - lu(503) * lu(1703) + lu(1728) = lu(1728) - lu(504) * lu(1703) + lu(1731) = lu(1731) - lu(505) * lu(1703) + lu(1732) = lu(1732) - lu(506) * lu(1703) + lu(1733) = lu(1733) - lu(507) * lu(1703) + lu(1734) = lu(1734) - lu(508) * lu(1703) + lu(1737) = lu(1737) - lu(509) * lu(1703) + lu(1755) = lu(1755) - lu(497) * lu(1748) + lu(1760) = lu(1760) - lu(498) * lu(1748) + lu(1767) = lu(1767) - lu(499) * lu(1748) + lu(1768) = lu(1768) - lu(500) * lu(1748) + lu(1770) = lu(1770) - lu(501) * lu(1748) + lu(1771) = lu(1771) - lu(502) * lu(1748) + lu(1773) = lu(1773) - lu(503) * lu(1748) + lu(1774) = lu(1774) - lu(504) * lu(1748) + lu(1777) = lu(1777) - lu(505) * lu(1748) + lu(1778) = lu(1778) - lu(506) * lu(1748) + lu(1779) = lu(1779) - lu(507) * lu(1748) + lu(1780) = lu(1780) - lu(508) * lu(1748) + lu(1783) = lu(1783) - lu(509) * lu(1748) + lu(1879) = lu(1879) - lu(497) * lu(1872) + lu(1884) = lu(1884) - lu(498) * lu(1872) + lu(1891) = lu(1891) - lu(499) * lu(1872) + lu(1892) = lu(1892) - lu(500) * lu(1872) + lu(1894) = lu(1894) - lu(501) * lu(1872) + lu(1895) = lu(1895) - lu(502) * lu(1872) + lu(1897) = lu(1897) - lu(503) * lu(1872) + lu(1898) = lu(1898) - lu(504) * lu(1872) + lu(1901) = lu(1901) - lu(505) * lu(1872) + lu(1902) = lu(1902) - lu(506) * lu(1872) + lu(1903) = lu(1903) - lu(507) * lu(1872) + lu(1904) = lu(1904) - lu(508) * lu(1872) + lu(1907) = lu(1907) - lu(509) * lu(1872) + lu(512) = 1._r8 / lu(512) + lu(513) = lu(513) * lu(512) + lu(514) = lu(514) * lu(512) + lu(515) = lu(515) * lu(512) + lu(516) = lu(516) * lu(512) + lu(517) = lu(517) * lu(512) + lu(518) = lu(518) * lu(512) + lu(519) = lu(519) * lu(512) + lu(520) = lu(520) * lu(512) + lu(521) = lu(521) * lu(512) + lu(522) = lu(522) * lu(512) + lu(523) = lu(523) * lu(512) + lu(524) = lu(524) * lu(512) + lu(525) = lu(525) * lu(512) + lu(526) = lu(526) * lu(512) + lu(527) = lu(527) * lu(512) + lu(528) = lu(528) * lu(512) + lu(529) = lu(529) * lu(512) + lu(554) = lu(554) - lu(513) * lu(553) + lu(555) = lu(555) - lu(514) * lu(553) + lu(556) = lu(556) - lu(515) * lu(553) + lu(557) = lu(557) - lu(516) * lu(553) + lu(558) = lu(558) - lu(517) * lu(553) + lu(559) = lu(559) - lu(518) * lu(553) + lu(560) = lu(560) - lu(519) * lu(553) + lu(561) = lu(561) - lu(520) * lu(553) + lu(562) = lu(562) - lu(521) * lu(553) + lu(563) = lu(563) - lu(522) * lu(553) + lu(564) = lu(564) - lu(523) * lu(553) + lu(565) = lu(565) - lu(524) * lu(553) + lu(566) = lu(566) - lu(525) * lu(553) + lu(567) = lu(567) - lu(526) * lu(553) + lu(568) = lu(568) - lu(527) * lu(553) + lu(569) = lu(569) - lu(528) * lu(553) + lu(570) = lu(570) - lu(529) * lu(553) + lu(885) = lu(885) - lu(513) * lu(883) + lu(888) = lu(888) - lu(514) * lu(883) + lu(893) = lu(893) - lu(515) * lu(883) + lu(894) = lu(894) - lu(516) * lu(883) + lu(898) = lu(898) - lu(517) * lu(883) + lu(900) = lu(900) - lu(518) * lu(883) + lu(901) = lu(901) - lu(519) * lu(883) + lu(903) = lu(903) - lu(520) * lu(883) + lu(904) = lu(904) - lu(521) * lu(883) + lu(906) = lu(906) - lu(522) * lu(883) + lu(907) = lu(907) - lu(523) * lu(883) + lu(908) = lu(908) - lu(524) * lu(883) + lu(910) = lu(910) - lu(525) * lu(883) + lu(911) = lu(911) - lu(526) * lu(883) + lu(912) = lu(912) - lu(527) * lu(883) + lu(913) = lu(913) - lu(528) * lu(883) + lu(916) = lu(916) - lu(529) * lu(883) + lu(1225) = lu(1225) - lu(513) * lu(1223) + lu(1228) = lu(1228) - lu(514) * lu(1223) + lu(1233) = lu(1233) - lu(515) * lu(1223) + lu(1234) = lu(1234) - lu(516) * lu(1223) + lu(1238) = lu(1238) - lu(517) * lu(1223) + lu(1240) = lu(1240) - lu(518) * lu(1223) + lu(1241) = lu(1241) - lu(519) * lu(1223) + lu(1243) = lu(1243) - lu(520) * lu(1223) + lu(1244) = lu(1244) - lu(521) * lu(1223) + lu(1246) = lu(1246) - lu(522) * lu(1223) + lu(1247) = lu(1247) - lu(523) * lu(1223) + lu(1248) = lu(1248) - lu(524) * lu(1223) + lu(1250) = lu(1250) - lu(525) * lu(1223) + lu(1251) = lu(1251) - lu(526) * lu(1223) + lu(1252) = lu(1252) - lu(527) * lu(1223) + lu(1253) = lu(1253) - lu(528) * lu(1223) + lu(1256) = lu(1256) - lu(529) * lu(1223) + lu(1318) = lu(1318) - lu(513) * lu(1316) + lu(1323) = lu(1323) - lu(514) * lu(1316) + lu(1328) = lu(1328) - lu(515) * lu(1316) + lu(1329) = lu(1329) - lu(516) * lu(1316) + lu(1333) = lu(1333) - lu(517) * lu(1316) + lu(1335) = lu(1335) - lu(518) * lu(1316) + lu(1336) = lu(1336) - lu(519) * lu(1316) + lu(1338) = lu(1338) - lu(520) * lu(1316) + lu(1339) = lu(1339) - lu(521) * lu(1316) + lu(1341) = lu(1341) - lu(522) * lu(1316) + lu(1342) = lu(1342) - lu(523) * lu(1316) + lu(1343) = lu(1343) - lu(524) * lu(1316) + lu(1345) = lu(1345) - lu(525) * lu(1316) + lu(1346) = lu(1346) - lu(526) * lu(1316) + lu(1347) = lu(1347) - lu(527) * lu(1316) + lu(1348) = lu(1348) - lu(528) * lu(1316) + lu(1351) = lu(1351) - lu(529) * lu(1316) + lu(1363) = lu(1363) - lu(513) * lu(1361) + lu(1366) = lu(1366) - lu(514) * lu(1361) + lu(1371) = lu(1371) - lu(515) * lu(1361) + lu(1372) = lu(1372) - lu(516) * lu(1361) + lu(1376) = lu(1376) - lu(517) * lu(1361) + lu(1378) = lu(1378) - lu(518) * lu(1361) + lu(1379) = lu(1379) - lu(519) * lu(1361) + lu(1381) = lu(1381) - lu(520) * lu(1361) + lu(1382) = lu(1382) - lu(521) * lu(1361) + lu(1384) = lu(1384) - lu(522) * lu(1361) + lu(1385) = lu(1385) - lu(523) * lu(1361) + lu(1386) = lu(1386) - lu(524) * lu(1361) + lu(1388) = lu(1388) - lu(525) * lu(1361) + lu(1389) = lu(1389) - lu(526) * lu(1361) + lu(1390) = lu(1390) - lu(527) * lu(1361) + lu(1391) = lu(1391) - lu(528) * lu(1361) + lu(1394) = lu(1394) - lu(529) * lu(1361) + lu(1447) = lu(1447) - lu(513) * lu(1445) + lu(1450) = lu(1450) - lu(514) * lu(1445) + lu(1455) = lu(1455) - lu(515) * lu(1445) + lu(1456) = lu(1456) - lu(516) * lu(1445) + lu(1460) = lu(1460) - lu(517) * lu(1445) + lu(1462) = lu(1462) - lu(518) * lu(1445) + lu(1463) = lu(1463) - lu(519) * lu(1445) + lu(1465) = lu(1465) - lu(520) * lu(1445) + lu(1466) = lu(1466) - lu(521) * lu(1445) + lu(1468) = lu(1468) - lu(522) * lu(1445) + lu(1469) = lu(1469) - lu(523) * lu(1445) + lu(1470) = lu(1470) - lu(524) * lu(1445) + lu(1472) = lu(1472) - lu(525) * lu(1445) + lu(1473) = lu(1473) - lu(526) * lu(1445) + lu(1474) = lu(1474) - lu(527) * lu(1445) + lu(1475) = lu(1475) - lu(528) * lu(1445) + lu(1478) = lu(1478) - lu(529) * lu(1445) + lu(1535) = lu(1535) - lu(513) * lu(1533) + lu(1539) = lu(1539) - lu(514) * lu(1533) + lu(1544) = lu(1544) - lu(515) * lu(1533) + lu(1545) = lu(1545) - lu(516) * lu(1533) + lu(1549) = lu(1549) - lu(517) * lu(1533) + lu(1551) = lu(1551) - lu(518) * lu(1533) + lu(1552) = lu(1552) - lu(519) * lu(1533) + lu(1554) = lu(1554) - lu(520) * lu(1533) + lu(1555) = lu(1555) - lu(521) * lu(1533) + lu(1557) = lu(1557) - lu(522) * lu(1533) + lu(1558) = lu(1558) - lu(523) * lu(1533) + lu(1559) = lu(1559) - lu(524) * lu(1533) + lu(1561) = lu(1561) - lu(525) * lu(1533) + lu(1562) = lu(1562) - lu(526) * lu(1533) + lu(1563) = lu(1563) - lu(527) * lu(1533) + lu(1564) = lu(1564) - lu(528) * lu(1533) + lu(1567) = lu(1567) - lu(529) * lu(1533) + lu(1623) = lu(1623) - lu(513) * lu(1622) + lu(1627) = lu(1627) - lu(514) * lu(1622) + lu(1631) = lu(1631) - lu(515) * lu(1622) + lu(1632) = lu(1632) - lu(516) * lu(1622) + lu(1636) = lu(1636) - lu(517) * lu(1622) + lu(1638) = lu(1638) - lu(518) * lu(1622) + lu(1639) = lu(1639) - lu(519) * lu(1622) + lu(1641) = lu(1641) - lu(520) * lu(1622) + lu(1642) = lu(1642) - lu(521) * lu(1622) + lu(1644) = lu(1644) - lu(522) * lu(1622) + lu(1645) = lu(1645) - lu(523) * lu(1622) + lu(1646) = lu(1646) - lu(524) * lu(1622) + lu(1648) = lu(1648) - lu(525) * lu(1622) + lu(1649) = lu(1649) - lu(526) * lu(1622) + lu(1650) = lu(1650) - lu(527) * lu(1622) + lu(1651) = lu(1651) - lu(528) * lu(1622) + lu(1654) = lu(1654) - lu(529) * lu(1622) + lu(1666) = lu(1666) - lu(513) * lu(1664) + lu(1669) = lu(1669) - lu(514) * lu(1664) + lu(1674) = lu(1674) - lu(515) * lu(1664) + lu(1675) = lu(1675) - lu(516) * lu(1664) + lu(1679) = lu(1679) - lu(517) * lu(1664) + lu(1681) = lu(1681) - lu(518) * lu(1664) + lu(1682) = lu(1682) - lu(519) * lu(1664) + lu(1684) = lu(1684) - lu(520) * lu(1664) + lu(1685) = lu(1685) - lu(521) * lu(1664) + lu(1687) = lu(1687) - lu(522) * lu(1664) + lu(1688) = lu(1688) - lu(523) * lu(1664) + lu(1689) = lu(1689) - lu(524) * lu(1664) + lu(1691) = lu(1691) - lu(525) * lu(1664) + lu(1692) = lu(1692) - lu(526) * lu(1664) + lu(1693) = lu(1693) - lu(527) * lu(1664) + lu(1694) = lu(1694) - lu(528) * lu(1664) + lu(1697) = lu(1697) - lu(529) * lu(1664) + lu(1751) = lu(1751) - lu(513) * lu(1749) + lu(1755) = lu(1755) - lu(514) * lu(1749) + lu(1760) = lu(1760) - lu(515) * lu(1749) + lu(1761) = lu(1761) - lu(516) * lu(1749) + lu(1765) = lu(1765) - lu(517) * lu(1749) + lu(1767) = lu(1767) - lu(518) * lu(1749) + lu(1768) = lu(1768) - lu(519) * lu(1749) + lu(1770) = lu(1770) - lu(520) * lu(1749) + lu(1771) = lu(1771) - lu(521) * lu(1749) + lu(1773) = lu(1773) - lu(522) * lu(1749) + lu(1774) = lu(1774) - lu(523) * lu(1749) + lu(1775) = lu(1775) - lu(524) * lu(1749) + lu(1777) = lu(1777) - lu(525) * lu(1749) + lu(1778) = lu(1778) - lu(526) * lu(1749) + lu(1779) = lu(1779) - lu(527) * lu(1749) + lu(1780) = lu(1780) - lu(528) * lu(1749) + lu(1783) = lu(1783) - lu(529) * lu(1749) + lu(1875) = lu(1875) - lu(513) * lu(1873) + lu(1879) = lu(1879) - lu(514) * lu(1873) + lu(1884) = lu(1884) - lu(515) * lu(1873) + lu(1885) = lu(1885) - lu(516) * lu(1873) + lu(1889) = lu(1889) - lu(517) * lu(1873) + lu(1891) = lu(1891) - lu(518) * lu(1873) + lu(1892) = lu(1892) - lu(519) * lu(1873) + lu(1894) = lu(1894) - lu(520) * lu(1873) + lu(1895) = lu(1895) - lu(521) * lu(1873) + lu(1897) = lu(1897) - lu(522) * lu(1873) + lu(1898) = lu(1898) - lu(523) * lu(1873) + lu(1899) = lu(1899) - lu(524) * lu(1873) + lu(1901) = lu(1901) - lu(525) * lu(1873) + lu(1902) = lu(1902) - lu(526) * lu(1873) + lu(1903) = lu(1903) - lu(527) * lu(1873) + lu(1904) = lu(1904) - lu(528) * lu(1873) + lu(1907) = lu(1907) - lu(529) * lu(1873) + end subroutine lu_fac13 + subroutine lu_fac14( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(532) = 1._r8 / lu(532) + lu(533) = lu(533) * lu(532) + lu(534) = lu(534) * lu(532) + lu(535) = lu(535) * lu(532) + lu(536) = lu(536) * lu(532) + lu(537) = lu(537) * lu(532) + lu(538) = lu(538) * lu(532) + lu(539) = lu(539) * lu(532) + lu(540) = lu(540) * lu(532) + lu(541) = lu(541) * lu(532) + lu(542) = lu(542) * lu(532) + lu(543) = lu(543) * lu(532) + lu(544) = lu(544) * lu(532) + lu(545) = lu(545) * lu(532) + lu(546) = lu(546) * lu(532) + lu(547) = lu(547) * lu(532) + lu(548) = lu(548) * lu(532) + lu(549) = lu(549) * lu(532) + lu(550) = lu(550) * lu(532) + lu(844) = - lu(533) * lu(843) + lu(846) = lu(846) - lu(534) * lu(843) + lu(847) = lu(847) - lu(535) * lu(843) + lu(849) = lu(849) - lu(536) * lu(843) + lu(850) = lu(850) - lu(537) * lu(843) + lu(851) = lu(851) - lu(538) * lu(843) + lu(855) = lu(855) - lu(539) * lu(843) + lu(857) = lu(857) - lu(540) * lu(843) + lu(858) = lu(858) - lu(541) * lu(843) + lu(860) = lu(860) - lu(542) * lu(843) + lu(861) = lu(861) - lu(543) * lu(843) + lu(862) = lu(862) - lu(544) * lu(843) + lu(863) = lu(863) - lu(545) * lu(843) + lu(864) = lu(864) - lu(546) * lu(843) + lu(865) = lu(865) - lu(547) * lu(843) + lu(868) = lu(868) - lu(548) * lu(843) + lu(870) = lu(870) - lu(549) * lu(843) + lu(873) = lu(873) - lu(550) * lu(843) + lu(885) = lu(885) - lu(533) * lu(884) + lu(888) = lu(888) - lu(534) * lu(884) + lu(890) = lu(890) - lu(535) * lu(884) + lu(892) = lu(892) - lu(536) * lu(884) + lu(893) = lu(893) - lu(537) * lu(884) + lu(894) = lu(894) - lu(538) * lu(884) + lu(898) = lu(898) - lu(539) * lu(884) + lu(900) = lu(900) - lu(540) * lu(884) + lu(901) = lu(901) - lu(541) * lu(884) + lu(903) = lu(903) - lu(542) * lu(884) + lu(904) = lu(904) - lu(543) * lu(884) + lu(905) = lu(905) - lu(544) * lu(884) + lu(906) = lu(906) - lu(545) * lu(884) + lu(907) = lu(907) - lu(546) * lu(884) + lu(908) = lu(908) - lu(547) * lu(884) + lu(911) = lu(911) - lu(548) * lu(884) + lu(913) = lu(913) - lu(549) * lu(884) + lu(916) = lu(916) - lu(550) * lu(884) + lu(1225) = lu(1225) - lu(533) * lu(1224) + lu(1228) = lu(1228) - lu(534) * lu(1224) + lu(1230) = lu(1230) - lu(535) * lu(1224) + lu(1232) = lu(1232) - lu(536) * lu(1224) + lu(1233) = lu(1233) - lu(537) * lu(1224) + lu(1234) = lu(1234) - lu(538) * lu(1224) + lu(1238) = lu(1238) - lu(539) * lu(1224) + lu(1240) = lu(1240) - lu(540) * lu(1224) + lu(1241) = lu(1241) - lu(541) * lu(1224) + lu(1243) = lu(1243) - lu(542) * lu(1224) + lu(1244) = lu(1244) - lu(543) * lu(1224) + lu(1245) = lu(1245) - lu(544) * lu(1224) + lu(1246) = lu(1246) - lu(545) * lu(1224) + lu(1247) = lu(1247) - lu(546) * lu(1224) + lu(1248) = lu(1248) - lu(547) * lu(1224) + lu(1251) = lu(1251) - lu(548) * lu(1224) + lu(1253) = lu(1253) - lu(549) * lu(1224) + lu(1256) = lu(1256) - lu(550) * lu(1224) + lu(1318) = lu(1318) - lu(533) * lu(1317) + lu(1323) = lu(1323) - lu(534) * lu(1317) + lu(1325) = lu(1325) - lu(535) * lu(1317) + lu(1327) = lu(1327) - lu(536) * lu(1317) + lu(1328) = lu(1328) - lu(537) * lu(1317) + lu(1329) = lu(1329) - lu(538) * lu(1317) + lu(1333) = lu(1333) - lu(539) * lu(1317) + lu(1335) = lu(1335) - lu(540) * lu(1317) + lu(1336) = lu(1336) - lu(541) * lu(1317) + lu(1338) = lu(1338) - lu(542) * lu(1317) + lu(1339) = lu(1339) - lu(543) * lu(1317) + lu(1340) = lu(1340) - lu(544) * lu(1317) + lu(1341) = lu(1341) - lu(545) * lu(1317) + lu(1342) = lu(1342) - lu(546) * lu(1317) + lu(1343) = lu(1343) - lu(547) * lu(1317) + lu(1346) = lu(1346) - lu(548) * lu(1317) + lu(1348) = lu(1348) - lu(549) * lu(1317) + lu(1351) = lu(1351) - lu(550) * lu(1317) + lu(1363) = lu(1363) - lu(533) * lu(1362) + lu(1366) = lu(1366) - lu(534) * lu(1362) + lu(1368) = lu(1368) - lu(535) * lu(1362) + lu(1370) = lu(1370) - lu(536) * lu(1362) + lu(1371) = lu(1371) - lu(537) * lu(1362) + lu(1372) = lu(1372) - lu(538) * lu(1362) + lu(1376) = lu(1376) - lu(539) * lu(1362) + lu(1378) = lu(1378) - lu(540) * lu(1362) + lu(1379) = lu(1379) - lu(541) * lu(1362) + lu(1381) = lu(1381) - lu(542) * lu(1362) + lu(1382) = lu(1382) - lu(543) * lu(1362) + lu(1383) = lu(1383) - lu(544) * lu(1362) + lu(1384) = lu(1384) - lu(545) * lu(1362) + lu(1385) = lu(1385) - lu(546) * lu(1362) + lu(1386) = lu(1386) - lu(547) * lu(1362) + lu(1389) = lu(1389) - lu(548) * lu(1362) + lu(1391) = lu(1391) - lu(549) * lu(1362) + lu(1394) = lu(1394) - lu(550) * lu(1362) + lu(1447) = lu(1447) - lu(533) * lu(1446) + lu(1450) = lu(1450) - lu(534) * lu(1446) + lu(1452) = lu(1452) - lu(535) * lu(1446) + lu(1454) = lu(1454) - lu(536) * lu(1446) + lu(1455) = lu(1455) - lu(537) * lu(1446) + lu(1456) = lu(1456) - lu(538) * lu(1446) + lu(1460) = lu(1460) - lu(539) * lu(1446) + lu(1462) = lu(1462) - lu(540) * lu(1446) + lu(1463) = lu(1463) - lu(541) * lu(1446) + lu(1465) = lu(1465) - lu(542) * lu(1446) + lu(1466) = lu(1466) - lu(543) * lu(1446) + lu(1467) = lu(1467) - lu(544) * lu(1446) + lu(1468) = lu(1468) - lu(545) * lu(1446) + lu(1469) = lu(1469) - lu(546) * lu(1446) + lu(1470) = lu(1470) - lu(547) * lu(1446) + lu(1473) = lu(1473) - lu(548) * lu(1446) + lu(1475) = lu(1475) - lu(549) * lu(1446) + lu(1478) = lu(1478) - lu(550) * lu(1446) + lu(1488) = - lu(533) * lu(1487) + lu(1493) = lu(1493) - lu(534) * lu(1487) + lu(1495) = lu(1495) - lu(535) * lu(1487) + lu(1497) = lu(1497) - lu(536) * lu(1487) + lu(1498) = lu(1498) - lu(537) * lu(1487) + lu(1499) = lu(1499) - lu(538) * lu(1487) + lu(1503) = lu(1503) - lu(539) * lu(1487) + lu(1505) = lu(1505) - lu(540) * lu(1487) + lu(1506) = lu(1506) - lu(541) * lu(1487) + lu(1508) = lu(1508) - lu(542) * lu(1487) + lu(1509) = lu(1509) - lu(543) * lu(1487) + lu(1510) = lu(1510) - lu(544) * lu(1487) + lu(1511) = lu(1511) - lu(545) * lu(1487) + lu(1512) = lu(1512) - lu(546) * lu(1487) + lu(1513) = lu(1513) - lu(547) * lu(1487) + lu(1516) = lu(1516) - lu(548) * lu(1487) + lu(1518) = lu(1518) - lu(549) * lu(1487) + lu(1521) = lu(1521) - lu(550) * lu(1487) + lu(1535) = lu(1535) - lu(533) * lu(1534) + lu(1539) = lu(1539) - lu(534) * lu(1534) + lu(1541) = lu(1541) - lu(535) * lu(1534) + lu(1543) = lu(1543) - lu(536) * lu(1534) + lu(1544) = lu(1544) - lu(537) * lu(1534) + lu(1545) = lu(1545) - lu(538) * lu(1534) + lu(1549) = lu(1549) - lu(539) * lu(1534) + lu(1551) = lu(1551) - lu(540) * lu(1534) + lu(1552) = lu(1552) - lu(541) * lu(1534) + lu(1554) = lu(1554) - lu(542) * lu(1534) + lu(1555) = lu(1555) - lu(543) * lu(1534) + lu(1556) = lu(1556) - lu(544) * lu(1534) + lu(1557) = lu(1557) - lu(545) * lu(1534) + lu(1558) = lu(1558) - lu(546) * lu(1534) + lu(1559) = lu(1559) - lu(547) * lu(1534) + lu(1562) = lu(1562) - lu(548) * lu(1534) + lu(1564) = lu(1564) - lu(549) * lu(1534) + lu(1567) = lu(1567) - lu(550) * lu(1534) + lu(1666) = lu(1666) - lu(533) * lu(1665) + lu(1669) = lu(1669) - lu(534) * lu(1665) + lu(1671) = lu(1671) - lu(535) * lu(1665) + lu(1673) = lu(1673) - lu(536) * lu(1665) + lu(1674) = lu(1674) - lu(537) * lu(1665) + lu(1675) = lu(1675) - lu(538) * lu(1665) + lu(1679) = lu(1679) - lu(539) * lu(1665) + lu(1681) = lu(1681) - lu(540) * lu(1665) + lu(1682) = lu(1682) - lu(541) * lu(1665) + lu(1684) = lu(1684) - lu(542) * lu(1665) + lu(1685) = lu(1685) - lu(543) * lu(1665) + lu(1686) = lu(1686) - lu(544) * lu(1665) + lu(1687) = lu(1687) - lu(545) * lu(1665) + lu(1688) = lu(1688) - lu(546) * lu(1665) + lu(1689) = lu(1689) - lu(547) * lu(1665) + lu(1692) = lu(1692) - lu(548) * lu(1665) + lu(1694) = lu(1694) - lu(549) * lu(1665) + lu(1697) = lu(1697) - lu(550) * lu(1665) + lu(1751) = lu(1751) - lu(533) * lu(1750) + lu(1755) = lu(1755) - lu(534) * lu(1750) + lu(1757) = lu(1757) - lu(535) * lu(1750) + lu(1759) = lu(1759) - lu(536) * lu(1750) + lu(1760) = lu(1760) - lu(537) * lu(1750) + lu(1761) = lu(1761) - lu(538) * lu(1750) + lu(1765) = lu(1765) - lu(539) * lu(1750) + lu(1767) = lu(1767) - lu(540) * lu(1750) + lu(1768) = lu(1768) - lu(541) * lu(1750) + lu(1770) = lu(1770) - lu(542) * lu(1750) + lu(1771) = lu(1771) - lu(543) * lu(1750) + lu(1772) = lu(1772) - lu(544) * lu(1750) + lu(1773) = lu(1773) - lu(545) * lu(1750) + lu(1774) = lu(1774) - lu(546) * lu(1750) + lu(1775) = lu(1775) - lu(547) * lu(1750) + lu(1778) = lu(1778) - lu(548) * lu(1750) + lu(1780) = lu(1780) - lu(549) * lu(1750) + lu(1783) = lu(1783) - lu(550) * lu(1750) + lu(1875) = lu(1875) - lu(533) * lu(1874) + lu(1879) = lu(1879) - lu(534) * lu(1874) + lu(1881) = lu(1881) - lu(535) * lu(1874) + lu(1883) = lu(1883) - lu(536) * lu(1874) + lu(1884) = lu(1884) - lu(537) * lu(1874) + lu(1885) = lu(1885) - lu(538) * lu(1874) + lu(1889) = lu(1889) - lu(539) * lu(1874) + lu(1891) = lu(1891) - lu(540) * lu(1874) + lu(1892) = lu(1892) - lu(541) * lu(1874) + lu(1894) = lu(1894) - lu(542) * lu(1874) + lu(1895) = lu(1895) - lu(543) * lu(1874) + lu(1896) = lu(1896) - lu(544) * lu(1874) + lu(1897) = lu(1897) - lu(545) * lu(1874) + lu(1898) = lu(1898) - lu(546) * lu(1874) + lu(1899) = lu(1899) - lu(547) * lu(1874) + lu(1902) = lu(1902) - lu(548) * lu(1874) + lu(1904) = lu(1904) - lu(549) * lu(1874) + lu(1907) = lu(1907) - lu(550) * lu(1874) + lu(554) = 1._r8 / lu(554) + lu(555) = lu(555) * lu(554) + lu(556) = lu(556) * lu(554) + lu(557) = lu(557) * lu(554) + lu(558) = lu(558) * lu(554) + lu(559) = lu(559) * lu(554) + lu(560) = lu(560) * lu(554) + lu(561) = lu(561) * lu(554) + lu(562) = lu(562) * lu(554) + lu(563) = lu(563) * lu(554) + lu(564) = lu(564) * lu(554) + lu(565) = lu(565) * lu(554) + lu(566) = lu(566) * lu(554) + lu(567) = lu(567) * lu(554) + lu(568) = lu(568) * lu(554) + lu(569) = lu(569) * lu(554) + lu(570) = lu(570) * lu(554) + lu(710) = lu(710) - lu(555) * lu(708) + lu(712) = lu(712) - lu(556) * lu(708) + lu(713) = lu(713) - lu(557) * lu(708) + lu(716) = lu(716) - lu(558) * lu(708) + lu(718) = lu(718) - lu(559) * lu(708) + lu(719) = lu(719) - lu(560) * lu(708) + lu(720) = lu(720) - lu(561) * lu(708) + lu(721) = lu(721) - lu(562) * lu(708) + lu(722) = lu(722) - lu(563) * lu(708) + lu(723) = lu(723) - lu(564) * lu(708) + lu(724) = - lu(565) * lu(708) + lu(725) = lu(725) - lu(566) * lu(708) + lu(726) = lu(726) - lu(567) * lu(708) + lu(727) = lu(727) - lu(568) * lu(708) + lu(728) = lu(728) - lu(569) * lu(708) + lu(730) = lu(730) - lu(570) * lu(708) + lu(846) = lu(846) - lu(555) * lu(844) + lu(850) = lu(850) - lu(556) * lu(844) + lu(851) = lu(851) - lu(557) * lu(844) + lu(855) = lu(855) - lu(558) * lu(844) + lu(857) = lu(857) - lu(559) * lu(844) + lu(858) = lu(858) - lu(560) * lu(844) + lu(860) = lu(860) - lu(561) * lu(844) + lu(861) = lu(861) - lu(562) * lu(844) + lu(863) = lu(863) - lu(563) * lu(844) + lu(864) = lu(864) - lu(564) * lu(844) + lu(865) = lu(865) - lu(565) * lu(844) + lu(867) = - lu(566) * lu(844) + lu(868) = lu(868) - lu(567) * lu(844) + lu(869) = lu(869) - lu(568) * lu(844) + lu(870) = lu(870) - lu(569) * lu(844) + lu(873) = lu(873) - lu(570) * lu(844) + lu(888) = lu(888) - lu(555) * lu(885) + lu(893) = lu(893) - lu(556) * lu(885) + lu(894) = lu(894) - lu(557) * lu(885) + lu(898) = lu(898) - lu(558) * lu(885) + lu(900) = lu(900) - lu(559) * lu(885) + lu(901) = lu(901) - lu(560) * lu(885) + lu(903) = lu(903) - lu(561) * lu(885) + lu(904) = lu(904) - lu(562) * lu(885) + lu(906) = lu(906) - lu(563) * lu(885) + lu(907) = lu(907) - lu(564) * lu(885) + lu(908) = lu(908) - lu(565) * lu(885) + lu(910) = lu(910) - lu(566) * lu(885) + lu(911) = lu(911) - lu(567) * lu(885) + lu(912) = lu(912) - lu(568) * lu(885) + lu(913) = lu(913) - lu(569) * lu(885) + lu(916) = lu(916) - lu(570) * lu(885) + lu(1228) = lu(1228) - lu(555) * lu(1225) + lu(1233) = lu(1233) - lu(556) * lu(1225) + lu(1234) = lu(1234) - lu(557) * lu(1225) + lu(1238) = lu(1238) - lu(558) * lu(1225) + lu(1240) = lu(1240) - lu(559) * lu(1225) + lu(1241) = lu(1241) - lu(560) * lu(1225) + lu(1243) = lu(1243) - lu(561) * lu(1225) + lu(1244) = lu(1244) - lu(562) * lu(1225) + lu(1246) = lu(1246) - lu(563) * lu(1225) + lu(1247) = lu(1247) - lu(564) * lu(1225) + lu(1248) = lu(1248) - lu(565) * lu(1225) + lu(1250) = lu(1250) - lu(566) * lu(1225) + lu(1251) = lu(1251) - lu(567) * lu(1225) + lu(1252) = lu(1252) - lu(568) * lu(1225) + lu(1253) = lu(1253) - lu(569) * lu(1225) + lu(1256) = lu(1256) - lu(570) * lu(1225) + lu(1323) = lu(1323) - lu(555) * lu(1318) + lu(1328) = lu(1328) - lu(556) * lu(1318) + lu(1329) = lu(1329) - lu(557) * lu(1318) + lu(1333) = lu(1333) - lu(558) * lu(1318) + lu(1335) = lu(1335) - lu(559) * lu(1318) + lu(1336) = lu(1336) - lu(560) * lu(1318) + lu(1338) = lu(1338) - lu(561) * lu(1318) + lu(1339) = lu(1339) - lu(562) * lu(1318) + lu(1341) = lu(1341) - lu(563) * lu(1318) + lu(1342) = lu(1342) - lu(564) * lu(1318) + lu(1343) = lu(1343) - lu(565) * lu(1318) + lu(1345) = lu(1345) - lu(566) * lu(1318) + lu(1346) = lu(1346) - lu(567) * lu(1318) + lu(1347) = lu(1347) - lu(568) * lu(1318) + lu(1348) = lu(1348) - lu(569) * lu(1318) + lu(1351) = lu(1351) - lu(570) * lu(1318) + lu(1366) = lu(1366) - lu(555) * lu(1363) + lu(1371) = lu(1371) - lu(556) * lu(1363) + lu(1372) = lu(1372) - lu(557) * lu(1363) + lu(1376) = lu(1376) - lu(558) * lu(1363) + lu(1378) = lu(1378) - lu(559) * lu(1363) + lu(1379) = lu(1379) - lu(560) * lu(1363) + lu(1381) = lu(1381) - lu(561) * lu(1363) + lu(1382) = lu(1382) - lu(562) * lu(1363) + lu(1384) = lu(1384) - lu(563) * lu(1363) + lu(1385) = lu(1385) - lu(564) * lu(1363) + lu(1386) = lu(1386) - lu(565) * lu(1363) + lu(1388) = lu(1388) - lu(566) * lu(1363) + lu(1389) = lu(1389) - lu(567) * lu(1363) + lu(1390) = lu(1390) - lu(568) * lu(1363) + lu(1391) = lu(1391) - lu(569) * lu(1363) + lu(1394) = lu(1394) - lu(570) * lu(1363) + lu(1450) = lu(1450) - lu(555) * lu(1447) + lu(1455) = lu(1455) - lu(556) * lu(1447) + lu(1456) = lu(1456) - lu(557) * lu(1447) + lu(1460) = lu(1460) - lu(558) * lu(1447) + lu(1462) = lu(1462) - lu(559) * lu(1447) + lu(1463) = lu(1463) - lu(560) * lu(1447) + lu(1465) = lu(1465) - lu(561) * lu(1447) + lu(1466) = lu(1466) - lu(562) * lu(1447) + lu(1468) = lu(1468) - lu(563) * lu(1447) + lu(1469) = lu(1469) - lu(564) * lu(1447) + lu(1470) = lu(1470) - lu(565) * lu(1447) + lu(1472) = lu(1472) - lu(566) * lu(1447) + lu(1473) = lu(1473) - lu(567) * lu(1447) + lu(1474) = lu(1474) - lu(568) * lu(1447) + lu(1475) = lu(1475) - lu(569) * lu(1447) + lu(1478) = lu(1478) - lu(570) * lu(1447) + lu(1493) = lu(1493) - lu(555) * lu(1488) + lu(1498) = lu(1498) - lu(556) * lu(1488) + lu(1499) = lu(1499) - lu(557) * lu(1488) + lu(1503) = lu(1503) - lu(558) * lu(1488) + lu(1505) = lu(1505) - lu(559) * lu(1488) + lu(1506) = lu(1506) - lu(560) * lu(1488) + lu(1508) = lu(1508) - lu(561) * lu(1488) + lu(1509) = lu(1509) - lu(562) * lu(1488) + lu(1511) = lu(1511) - lu(563) * lu(1488) + lu(1512) = lu(1512) - lu(564) * lu(1488) + lu(1513) = lu(1513) - lu(565) * lu(1488) + lu(1515) = lu(1515) - lu(566) * lu(1488) + lu(1516) = lu(1516) - lu(567) * lu(1488) + lu(1517) = lu(1517) - lu(568) * lu(1488) + lu(1518) = lu(1518) - lu(569) * lu(1488) + lu(1521) = lu(1521) - lu(570) * lu(1488) + lu(1539) = lu(1539) - lu(555) * lu(1535) + lu(1544) = lu(1544) - lu(556) * lu(1535) + lu(1545) = lu(1545) - lu(557) * lu(1535) + lu(1549) = lu(1549) - lu(558) * lu(1535) + lu(1551) = lu(1551) - lu(559) * lu(1535) + lu(1552) = lu(1552) - lu(560) * lu(1535) + lu(1554) = lu(1554) - lu(561) * lu(1535) + lu(1555) = lu(1555) - lu(562) * lu(1535) + lu(1557) = lu(1557) - lu(563) * lu(1535) + lu(1558) = lu(1558) - lu(564) * lu(1535) + lu(1559) = lu(1559) - lu(565) * lu(1535) + lu(1561) = lu(1561) - lu(566) * lu(1535) + lu(1562) = lu(1562) - lu(567) * lu(1535) + lu(1563) = lu(1563) - lu(568) * lu(1535) + lu(1564) = lu(1564) - lu(569) * lu(1535) + lu(1567) = lu(1567) - lu(570) * lu(1535) + lu(1627) = lu(1627) - lu(555) * lu(1623) + lu(1631) = lu(1631) - lu(556) * lu(1623) + lu(1632) = lu(1632) - lu(557) * lu(1623) + lu(1636) = lu(1636) - lu(558) * lu(1623) + lu(1638) = lu(1638) - lu(559) * lu(1623) + lu(1639) = lu(1639) - lu(560) * lu(1623) + lu(1641) = lu(1641) - lu(561) * lu(1623) + lu(1642) = lu(1642) - lu(562) * lu(1623) + lu(1644) = lu(1644) - lu(563) * lu(1623) + lu(1645) = lu(1645) - lu(564) * lu(1623) + lu(1646) = lu(1646) - lu(565) * lu(1623) + lu(1648) = lu(1648) - lu(566) * lu(1623) + lu(1649) = lu(1649) - lu(567) * lu(1623) + lu(1650) = lu(1650) - lu(568) * lu(1623) + lu(1651) = lu(1651) - lu(569) * lu(1623) + lu(1654) = lu(1654) - lu(570) * lu(1623) + lu(1669) = lu(1669) - lu(555) * lu(1666) + lu(1674) = lu(1674) - lu(556) * lu(1666) + lu(1675) = lu(1675) - lu(557) * lu(1666) + lu(1679) = lu(1679) - lu(558) * lu(1666) + lu(1681) = lu(1681) - lu(559) * lu(1666) + lu(1682) = lu(1682) - lu(560) * lu(1666) + lu(1684) = lu(1684) - lu(561) * lu(1666) + lu(1685) = lu(1685) - lu(562) * lu(1666) + lu(1687) = lu(1687) - lu(563) * lu(1666) + lu(1688) = lu(1688) - lu(564) * lu(1666) + lu(1689) = lu(1689) - lu(565) * lu(1666) + lu(1691) = lu(1691) - lu(566) * lu(1666) + lu(1692) = lu(1692) - lu(567) * lu(1666) + lu(1693) = lu(1693) - lu(568) * lu(1666) + lu(1694) = lu(1694) - lu(569) * lu(1666) + lu(1697) = lu(1697) - lu(570) * lu(1666) + lu(1709) = lu(1709) - lu(555) * lu(1704) + lu(1714) = lu(1714) - lu(556) * lu(1704) + lu(1715) = lu(1715) - lu(557) * lu(1704) + lu(1719) = lu(1719) - lu(558) * lu(1704) + lu(1721) = lu(1721) - lu(559) * lu(1704) + lu(1722) = lu(1722) - lu(560) * lu(1704) + lu(1724) = lu(1724) - lu(561) * lu(1704) + lu(1725) = lu(1725) - lu(562) * lu(1704) + lu(1727) = lu(1727) - lu(563) * lu(1704) + lu(1728) = lu(1728) - lu(564) * lu(1704) + lu(1729) = lu(1729) - lu(565) * lu(1704) + lu(1731) = lu(1731) - lu(566) * lu(1704) + lu(1732) = lu(1732) - lu(567) * lu(1704) + lu(1733) = lu(1733) - lu(568) * lu(1704) + lu(1734) = lu(1734) - lu(569) * lu(1704) + lu(1737) = lu(1737) - lu(570) * lu(1704) + lu(1755) = lu(1755) - lu(555) * lu(1751) + lu(1760) = lu(1760) - lu(556) * lu(1751) + lu(1761) = lu(1761) - lu(557) * lu(1751) + lu(1765) = lu(1765) - lu(558) * lu(1751) + lu(1767) = lu(1767) - lu(559) * lu(1751) + lu(1768) = lu(1768) - lu(560) * lu(1751) + lu(1770) = lu(1770) - lu(561) * lu(1751) + lu(1771) = lu(1771) - lu(562) * lu(1751) + lu(1773) = lu(1773) - lu(563) * lu(1751) + lu(1774) = lu(1774) - lu(564) * lu(1751) + lu(1775) = lu(1775) - lu(565) * lu(1751) + lu(1777) = lu(1777) - lu(566) * lu(1751) + lu(1778) = lu(1778) - lu(567) * lu(1751) + lu(1779) = lu(1779) - lu(568) * lu(1751) + lu(1780) = lu(1780) - lu(569) * lu(1751) + lu(1783) = lu(1783) - lu(570) * lu(1751) + lu(1879) = lu(1879) - lu(555) * lu(1875) + lu(1884) = lu(1884) - lu(556) * lu(1875) + lu(1885) = lu(1885) - lu(557) * lu(1875) + lu(1889) = lu(1889) - lu(558) * lu(1875) + lu(1891) = lu(1891) - lu(559) * lu(1875) + lu(1892) = lu(1892) - lu(560) * lu(1875) + lu(1894) = lu(1894) - lu(561) * lu(1875) + lu(1895) = lu(1895) - lu(562) * lu(1875) + lu(1897) = lu(1897) - lu(563) * lu(1875) + lu(1898) = lu(1898) - lu(564) * lu(1875) + lu(1899) = lu(1899) - lu(565) * lu(1875) + lu(1901) = lu(1901) - lu(566) * lu(1875) + lu(1902) = lu(1902) - lu(567) * lu(1875) + lu(1903) = lu(1903) - lu(568) * lu(1875) + lu(1904) = lu(1904) - lu(569) * lu(1875) + lu(1907) = lu(1907) - lu(570) * lu(1875) + lu(575) = 1._r8 / lu(575) + lu(576) = lu(576) * lu(575) + lu(577) = lu(577) * lu(575) + lu(578) = lu(578) * lu(575) + lu(579) = lu(579) * lu(575) + lu(580) = lu(580) * lu(575) + lu(581) = lu(581) * lu(575) + lu(582) = lu(582) * lu(575) + lu(583) = lu(583) * lu(575) + lu(584) = lu(584) * lu(575) + lu(585) = lu(585) * lu(575) + lu(586) = lu(586) * lu(575) + lu(587) = lu(587) * lu(575) + lu(588) = lu(588) * lu(575) + lu(589) = lu(589) * lu(575) + lu(590) = lu(590) * lu(575) + lu(591) = lu(591) * lu(575) + lu(592) = lu(592) * lu(575) + lu(593) = lu(593) * lu(575) + lu(594) = lu(594) * lu(575) + lu(600) = lu(600) - lu(576) * lu(599) + lu(601) = lu(601) - lu(577) * lu(599) + lu(602) = lu(602) - lu(578) * lu(599) + lu(603) = lu(603) - lu(579) * lu(599) + lu(604) = lu(604) - lu(580) * lu(599) + lu(605) = - lu(581) * lu(599) + lu(606) = lu(606) - lu(582) * lu(599) + lu(608) = lu(608) - lu(583) * lu(599) + lu(609) = - lu(584) * lu(599) + lu(610) = lu(610) - lu(585) * lu(599) + lu(611) = - lu(586) * lu(599) + lu(612) = lu(612) - lu(587) * lu(599) + lu(613) = lu(613) - lu(588) * lu(599) + lu(614) = lu(614) - lu(589) * lu(599) + lu(615) = lu(615) - lu(590) * lu(599) + lu(616) = lu(616) - lu(591) * lu(599) + lu(617) = lu(617) - lu(592) * lu(599) + lu(618) = lu(618) - lu(593) * lu(599) + lu(619) = lu(619) - lu(594) * lu(599) + lu(630) = lu(630) - lu(576) * lu(629) + lu(631) = lu(631) - lu(577) * lu(629) + lu(632) = lu(632) - lu(578) * lu(629) + lu(633) = lu(633) - lu(579) * lu(629) + lu(634) = lu(634) - lu(580) * lu(629) + lu(635) = - lu(581) * lu(629) + lu(636) = lu(636) - lu(582) * lu(629) + lu(638) = lu(638) - lu(583) * lu(629) + lu(639) = lu(639) - lu(584) * lu(629) + lu(640) = lu(640) - lu(585) * lu(629) + lu(641) = lu(641) - lu(586) * lu(629) + lu(642) = lu(642) - lu(587) * lu(629) + lu(644) = lu(644) - lu(588) * lu(629) + lu(645) = lu(645) - lu(589) * lu(629) + lu(646) = lu(646) - lu(590) * lu(629) + lu(647) = lu(647) - lu(591) * lu(629) + lu(648) = lu(648) - lu(592) * lu(629) + lu(649) = lu(649) - lu(593) * lu(629) + lu(652) = lu(652) - lu(594) * lu(629) + lu(742) = lu(742) - lu(576) * lu(741) + lu(743) = lu(743) - lu(577) * lu(741) + lu(744) = lu(744) - lu(578) * lu(741) + lu(745) = lu(745) - lu(579) * lu(741) + lu(746) = lu(746) - lu(580) * lu(741) + lu(747) = - lu(581) * lu(741) + lu(748) = lu(748) - lu(582) * lu(741) + lu(750) = lu(750) - lu(583) * lu(741) + lu(751) = lu(751) - lu(584) * lu(741) + lu(752) = lu(752) - lu(585) * lu(741) + lu(754) = - lu(586) * lu(741) + lu(755) = lu(755) - lu(587) * lu(741) + lu(757) = lu(757) - lu(588) * lu(741) + lu(758) = lu(758) - lu(589) * lu(741) + lu(759) = lu(759) - lu(590) * lu(741) + lu(760) = lu(760) - lu(591) * lu(741) + lu(761) = lu(761) - lu(592) * lu(741) + lu(762) = lu(762) - lu(593) * lu(741) + lu(765) = lu(765) - lu(594) * lu(741) + lu(816) = lu(816) - lu(576) * lu(815) + lu(817) = lu(817) - lu(577) * lu(815) + lu(818) = lu(818) - lu(578) * lu(815) + lu(819) = lu(819) - lu(579) * lu(815) + lu(820) = lu(820) - lu(580) * lu(815) + lu(821) = - lu(581) * lu(815) + lu(822) = lu(822) - lu(582) * lu(815) + lu(824) = lu(824) - lu(583) * lu(815) + lu(825) = lu(825) - lu(584) * lu(815) + lu(826) = lu(826) - lu(585) * lu(815) + lu(828) = - lu(586) * lu(815) + lu(829) = lu(829) - lu(587) * lu(815) + lu(831) = lu(831) - lu(588) * lu(815) + lu(832) = lu(832) - lu(589) * lu(815) + lu(833) = lu(833) - lu(590) * lu(815) + lu(834) = lu(834) - lu(591) * lu(815) + lu(835) = lu(835) - lu(592) * lu(815) + lu(836) = lu(836) - lu(593) * lu(815) + lu(839) = lu(839) - lu(594) * lu(815) + lu(921) = - lu(576) * lu(920) + lu(922) = - lu(577) * lu(920) + lu(926) = lu(926) - lu(578) * lu(920) + lu(928) = lu(928) - lu(579) * lu(920) + lu(931) = lu(931) - lu(580) * lu(920) + lu(932) = lu(932) - lu(581) * lu(920) + lu(933) = lu(933) - lu(582) * lu(920) + lu(935) = lu(935) - lu(583) * lu(920) + lu(936) = lu(936) - lu(584) * lu(920) + lu(937) = lu(937) - lu(585) * lu(920) + lu(939) = lu(939) - lu(586) * lu(920) + lu(940) = lu(940) - lu(587) * lu(920) + lu(942) = lu(942) - lu(588) * lu(920) + lu(944) = lu(944) - lu(589) * lu(920) + lu(945) = lu(945) - lu(590) * lu(920) + lu(946) = - lu(591) * lu(920) + lu(947) = - lu(592) * lu(920) + lu(949) = - lu(593) * lu(920) + lu(952) = - lu(594) * lu(920) + lu(1096) = lu(1096) - lu(576) * lu(1095) + lu(1097) = lu(1097) - lu(577) * lu(1095) + lu(1101) = lu(1101) - lu(578) * lu(1095) + lu(1103) = lu(1103) - lu(579) * lu(1095) + lu(1106) = lu(1106) - lu(580) * lu(1095) + lu(1107) = lu(1107) - lu(581) * lu(1095) + lu(1108) = lu(1108) - lu(582) * lu(1095) + lu(1110) = lu(1110) - lu(583) * lu(1095) + lu(1111) = lu(1111) - lu(584) * lu(1095) + lu(1112) = lu(1112) - lu(585) * lu(1095) + lu(1114) = lu(1114) - lu(586) * lu(1095) + lu(1115) = lu(1115) - lu(587) * lu(1095) + lu(1117) = lu(1117) - lu(588) * lu(1095) + lu(1119) = lu(1119) - lu(589) * lu(1095) + lu(1120) = lu(1120) - lu(590) * lu(1095) + lu(1121) = lu(1121) - lu(591) * lu(1095) + lu(1122) = lu(1122) - lu(592) * lu(1095) + lu(1124) = lu(1124) - lu(593) * lu(1095) + lu(1127) = lu(1127) - lu(594) * lu(1095) + lu(1261) = - lu(576) * lu(1260) + lu(1262) = - lu(577) * lu(1260) + lu(1265) = - lu(578) * lu(1260) + lu(1267) = lu(1267) - lu(579) * lu(1260) + lu(1270) = lu(1270) - lu(580) * lu(1260) + lu(1271) = lu(1271) - lu(581) * lu(1260) + lu(1272) = lu(1272) - lu(582) * lu(1260) + lu(1274) = lu(1274) - lu(583) * lu(1260) + lu(1275) = lu(1275) - lu(584) * lu(1260) + lu(1276) = lu(1276) - lu(585) * lu(1260) + lu(1278) = lu(1278) - lu(586) * lu(1260) + lu(1279) = lu(1279) - lu(587) * lu(1260) + lu(1281) = lu(1281) - lu(588) * lu(1260) + lu(1283) = lu(1283) - lu(589) * lu(1260) + lu(1284) = lu(1284) - lu(590) * lu(1260) + lu(1285) = lu(1285) - lu(591) * lu(1260) + lu(1286) = - lu(592) * lu(1260) + lu(1288) = lu(1288) - lu(593) * lu(1260) + lu(1291) = lu(1291) - lu(594) * lu(1260) + lu(1320) = lu(1320) - lu(576) * lu(1319) + lu(1321) = lu(1321) - lu(577) * lu(1319) + lu(1324) = lu(1324) - lu(578) * lu(1319) + lu(1326) = lu(1326) - lu(579) * lu(1319) + lu(1329) = lu(1329) - lu(580) * lu(1319) + lu(1330) = lu(1330) - lu(581) * lu(1319) + lu(1331) = lu(1331) - lu(582) * lu(1319) + lu(1333) = lu(1333) - lu(583) * lu(1319) + lu(1334) = lu(1334) - lu(584) * lu(1319) + lu(1335) = lu(1335) - lu(585) * lu(1319) + lu(1337) = lu(1337) - lu(586) * lu(1319) + lu(1338) = lu(1338) - lu(587) * lu(1319) + lu(1340) = lu(1340) - lu(588) * lu(1319) + lu(1342) = lu(1342) - lu(589) * lu(1319) + lu(1343) = lu(1343) - lu(590) * lu(1319) + lu(1344) = lu(1344) - lu(591) * lu(1319) + lu(1345) = lu(1345) - lu(592) * lu(1319) + lu(1347) = lu(1347) - lu(593) * lu(1319) + lu(1350) = lu(1350) - lu(594) * lu(1319) + lu(1490) = lu(1490) - lu(576) * lu(1489) + lu(1491) = lu(1491) - lu(577) * lu(1489) + lu(1494) = lu(1494) - lu(578) * lu(1489) + lu(1496) = lu(1496) - lu(579) * lu(1489) + lu(1499) = lu(1499) - lu(580) * lu(1489) + lu(1500) = lu(1500) - lu(581) * lu(1489) + lu(1501) = lu(1501) - lu(582) * lu(1489) + lu(1503) = lu(1503) - lu(583) * lu(1489) + lu(1504) = lu(1504) - lu(584) * lu(1489) + lu(1505) = lu(1505) - lu(585) * lu(1489) + lu(1507) = lu(1507) - lu(586) * lu(1489) + lu(1508) = lu(1508) - lu(587) * lu(1489) + lu(1510) = lu(1510) - lu(588) * lu(1489) + lu(1512) = lu(1512) - lu(589) * lu(1489) + lu(1513) = lu(1513) - lu(590) * lu(1489) + lu(1514) = lu(1514) - lu(591) * lu(1489) + lu(1515) = lu(1515) - lu(592) * lu(1489) + lu(1517) = lu(1517) - lu(593) * lu(1489) + lu(1520) = lu(1520) - lu(594) * lu(1489) + lu(1581) = lu(1581) - lu(576) * lu(1580) + lu(1582) = lu(1582) - lu(577) * lu(1580) + lu(1586) = lu(1586) - lu(578) * lu(1580) + lu(1588) = lu(1588) - lu(579) * lu(1580) + lu(1591) = lu(1591) - lu(580) * lu(1580) + lu(1592) = lu(1592) - lu(581) * lu(1580) + lu(1593) = lu(1593) - lu(582) * lu(1580) + lu(1595) = lu(1595) - lu(583) * lu(1580) + lu(1596) = - lu(584) * lu(1580) + lu(1597) = lu(1597) - lu(585) * lu(1580) + lu(1599) = lu(1599) - lu(586) * lu(1580) + lu(1600) = lu(1600) - lu(587) * lu(1580) + lu(1602) = lu(1602) - lu(588) * lu(1580) + lu(1604) = lu(1604) - lu(589) * lu(1580) + lu(1605) = lu(1605) - lu(590) * lu(1580) + lu(1606) = lu(1606) - lu(591) * lu(1580) + lu(1607) = lu(1607) - lu(592) * lu(1580) + lu(1609) = lu(1609) - lu(593) * lu(1580) + lu(1612) = lu(1612) - lu(594) * lu(1580) + lu(1625) = lu(1625) - lu(576) * lu(1624) + lu(1626) = lu(1626) - lu(577) * lu(1624) + lu(1628) = lu(1628) - lu(578) * lu(1624) + lu(1630) = lu(1630) - lu(579) * lu(1624) + lu(1632) = lu(1632) - lu(580) * lu(1624) + lu(1633) = - lu(581) * lu(1624) + lu(1634) = lu(1634) - lu(582) * lu(1624) + lu(1636) = lu(1636) - lu(583) * lu(1624) + lu(1637) = - lu(584) * lu(1624) + lu(1638) = lu(1638) - lu(585) * lu(1624) + lu(1640) = - lu(586) * lu(1624) + lu(1641) = lu(1641) - lu(587) * lu(1624) + lu(1643) = lu(1643) - lu(588) * lu(1624) + lu(1645) = lu(1645) - lu(589) * lu(1624) + lu(1646) = lu(1646) - lu(590) * lu(1624) + lu(1647) = lu(1647) - lu(591) * lu(1624) + lu(1648) = lu(1648) - lu(592) * lu(1624) + lu(1650) = lu(1650) - lu(593) * lu(1624) + lu(1653) = lu(1653) - lu(594) * lu(1624) + lu(1706) = lu(1706) - lu(576) * lu(1705) + lu(1707) = lu(1707) - lu(577) * lu(1705) + lu(1710) = lu(1710) - lu(578) * lu(1705) + lu(1712) = lu(1712) - lu(579) * lu(1705) + lu(1715) = lu(1715) - lu(580) * lu(1705) + lu(1716) = - lu(581) * lu(1705) + lu(1717) = lu(1717) - lu(582) * lu(1705) + lu(1719) = lu(1719) - lu(583) * lu(1705) + lu(1720) = - lu(584) * lu(1705) + lu(1721) = lu(1721) - lu(585) * lu(1705) + lu(1723) = lu(1723) - lu(586) * lu(1705) + lu(1724) = lu(1724) - lu(587) * lu(1705) + lu(1726) = lu(1726) - lu(588) * lu(1705) + lu(1728) = lu(1728) - lu(589) * lu(1705) + lu(1729) = lu(1729) - lu(590) * lu(1705) + lu(1730) = lu(1730) - lu(591) * lu(1705) + lu(1731) = lu(1731) - lu(592) * lu(1705) + lu(1733) = lu(1733) - lu(593) * lu(1705) + lu(1736) = lu(1736) - lu(594) * lu(1705) + lu(1829) = lu(1829) - lu(576) * lu(1828) + lu(1830) = lu(1830) - lu(577) * lu(1828) + lu(1834) = lu(1834) - lu(578) * lu(1828) + lu(1836) = lu(1836) - lu(579) * lu(1828) + lu(1839) = lu(1839) - lu(580) * lu(1828) + lu(1840) = lu(1840) - lu(581) * lu(1828) + lu(1841) = lu(1841) - lu(582) * lu(1828) + lu(1843) = lu(1843) - lu(583) * lu(1828) + lu(1844) = - lu(584) * lu(1828) + lu(1845) = lu(1845) - lu(585) * lu(1828) + lu(1847) = lu(1847) - lu(586) * lu(1828) + lu(1848) = lu(1848) - lu(587) * lu(1828) + lu(1850) = lu(1850) - lu(588) * lu(1828) + lu(1852) = lu(1852) - lu(589) * lu(1828) + lu(1853) = lu(1853) - lu(590) * lu(1828) + lu(1854) = lu(1854) - lu(591) * lu(1828) + lu(1855) = lu(1855) - lu(592) * lu(1828) + lu(1857) = lu(1857) - lu(593) * lu(1828) + lu(1860) = lu(1860) - lu(594) * lu(1828) + end subroutine lu_fac14 + subroutine lu_fac15( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(600) = 1._r8 / lu(600) + lu(601) = lu(601) * lu(600) + lu(602) = lu(602) * lu(600) + lu(603) = lu(603) * lu(600) + lu(604) = lu(604) * lu(600) + lu(605) = lu(605) * lu(600) + lu(606) = lu(606) * lu(600) + lu(607) = lu(607) * lu(600) + lu(608) = lu(608) * lu(600) + lu(609) = lu(609) * lu(600) + lu(610) = lu(610) * lu(600) + lu(611) = lu(611) * lu(600) + lu(612) = lu(612) * lu(600) + lu(613) = lu(613) * lu(600) + lu(614) = lu(614) * lu(600) + lu(615) = lu(615) * lu(600) + lu(616) = lu(616) * lu(600) + lu(617) = lu(617) * lu(600) + lu(618) = lu(618) * lu(600) + lu(619) = lu(619) * lu(600) + lu(631) = lu(631) - lu(601) * lu(630) + lu(632) = lu(632) - lu(602) * lu(630) + lu(633) = lu(633) - lu(603) * lu(630) + lu(634) = lu(634) - lu(604) * lu(630) + lu(635) = lu(635) - lu(605) * lu(630) + lu(636) = lu(636) - lu(606) * lu(630) + lu(637) = lu(637) - lu(607) * lu(630) + lu(638) = lu(638) - lu(608) * lu(630) + lu(639) = lu(639) - lu(609) * lu(630) + lu(640) = lu(640) - lu(610) * lu(630) + lu(641) = lu(641) - lu(611) * lu(630) + lu(642) = lu(642) - lu(612) * lu(630) + lu(644) = lu(644) - lu(613) * lu(630) + lu(645) = lu(645) - lu(614) * lu(630) + lu(646) = lu(646) - lu(615) * lu(630) + lu(647) = lu(647) - lu(616) * lu(630) + lu(648) = lu(648) - lu(617) * lu(630) + lu(649) = lu(649) - lu(618) * lu(630) + lu(652) = lu(652) - lu(619) * lu(630) + lu(743) = lu(743) - lu(601) * lu(742) + lu(744) = lu(744) - lu(602) * lu(742) + lu(745) = lu(745) - lu(603) * lu(742) + lu(746) = lu(746) - lu(604) * lu(742) + lu(747) = lu(747) - lu(605) * lu(742) + lu(748) = lu(748) - lu(606) * lu(742) + lu(749) = lu(749) - lu(607) * lu(742) + lu(750) = lu(750) - lu(608) * lu(742) + lu(751) = lu(751) - lu(609) * lu(742) + lu(752) = lu(752) - lu(610) * lu(742) + lu(754) = lu(754) - lu(611) * lu(742) + lu(755) = lu(755) - lu(612) * lu(742) + lu(757) = lu(757) - lu(613) * lu(742) + lu(758) = lu(758) - lu(614) * lu(742) + lu(759) = lu(759) - lu(615) * lu(742) + lu(760) = lu(760) - lu(616) * lu(742) + lu(761) = lu(761) - lu(617) * lu(742) + lu(762) = lu(762) - lu(618) * lu(742) + lu(765) = lu(765) - lu(619) * lu(742) + lu(817) = lu(817) - lu(601) * lu(816) + lu(818) = lu(818) - lu(602) * lu(816) + lu(819) = lu(819) - lu(603) * lu(816) + lu(820) = lu(820) - lu(604) * lu(816) + lu(821) = lu(821) - lu(605) * lu(816) + lu(822) = lu(822) - lu(606) * lu(816) + lu(823) = lu(823) - lu(607) * lu(816) + lu(824) = lu(824) - lu(608) * lu(816) + lu(825) = lu(825) - lu(609) * lu(816) + lu(826) = lu(826) - lu(610) * lu(816) + lu(828) = lu(828) - lu(611) * lu(816) + lu(829) = lu(829) - lu(612) * lu(816) + lu(831) = lu(831) - lu(613) * lu(816) + lu(832) = lu(832) - lu(614) * lu(816) + lu(833) = lu(833) - lu(615) * lu(816) + lu(834) = lu(834) - lu(616) * lu(816) + lu(835) = lu(835) - lu(617) * lu(816) + lu(836) = lu(836) - lu(618) * lu(816) + lu(839) = lu(839) - lu(619) * lu(816) + lu(922) = lu(922) - lu(601) * lu(921) + lu(926) = lu(926) - lu(602) * lu(921) + lu(928) = lu(928) - lu(603) * lu(921) + lu(931) = lu(931) - lu(604) * lu(921) + lu(932) = lu(932) - lu(605) * lu(921) + lu(933) = lu(933) - lu(606) * lu(921) + lu(934) = lu(934) - lu(607) * lu(921) + lu(935) = lu(935) - lu(608) * lu(921) + lu(936) = lu(936) - lu(609) * lu(921) + lu(937) = lu(937) - lu(610) * lu(921) + lu(939) = lu(939) - lu(611) * lu(921) + lu(940) = lu(940) - lu(612) * lu(921) + lu(942) = lu(942) - lu(613) * lu(921) + lu(944) = lu(944) - lu(614) * lu(921) + lu(945) = lu(945) - lu(615) * lu(921) + lu(946) = lu(946) - lu(616) * lu(921) + lu(947) = lu(947) - lu(617) * lu(921) + lu(949) = lu(949) - lu(618) * lu(921) + lu(952) = lu(952) - lu(619) * lu(921) + lu(999) = lu(999) - lu(601) * lu(998) + lu(1003) = lu(1003) - lu(602) * lu(998) + lu(1005) = lu(1005) - lu(603) * lu(998) + lu(1008) = lu(1008) - lu(604) * lu(998) + lu(1009) = lu(1009) - lu(605) * lu(998) + lu(1010) = lu(1010) - lu(606) * lu(998) + lu(1011) = lu(1011) - lu(607) * lu(998) + lu(1012) = lu(1012) - lu(608) * lu(998) + lu(1013) = - lu(609) * lu(998) + lu(1014) = lu(1014) - lu(610) * lu(998) + lu(1016) = lu(1016) - lu(611) * lu(998) + lu(1017) = lu(1017) - lu(612) * lu(998) + lu(1019) = lu(1019) - lu(613) * lu(998) + lu(1021) = lu(1021) - lu(614) * lu(998) + lu(1022) = lu(1022) - lu(615) * lu(998) + lu(1023) = lu(1023) - lu(616) * lu(998) + lu(1024) = lu(1024) - lu(617) * lu(998) + lu(1026) = lu(1026) - lu(618) * lu(998) + lu(1029) = lu(1029) - lu(619) * lu(998) + lu(1040) = lu(1040) - lu(601) * lu(1039) + lu(1043) = lu(1043) - lu(602) * lu(1039) + lu(1045) = lu(1045) - lu(603) * lu(1039) + lu(1048) = lu(1048) - lu(604) * lu(1039) + lu(1049) = lu(1049) - lu(605) * lu(1039) + lu(1050) = lu(1050) - lu(606) * lu(1039) + lu(1051) = lu(1051) - lu(607) * lu(1039) + lu(1052) = lu(1052) - lu(608) * lu(1039) + lu(1053) = lu(1053) - lu(609) * lu(1039) + lu(1054) = lu(1054) - lu(610) * lu(1039) + lu(1056) = lu(1056) - lu(611) * lu(1039) + lu(1057) = lu(1057) - lu(612) * lu(1039) + lu(1059) = lu(1059) - lu(613) * lu(1039) + lu(1061) = lu(1061) - lu(614) * lu(1039) + lu(1062) = lu(1062) - lu(615) * lu(1039) + lu(1063) = lu(1063) - lu(616) * lu(1039) + lu(1064) = lu(1064) - lu(617) * lu(1039) + lu(1066) = lu(1066) - lu(618) * lu(1039) + lu(1069) = lu(1069) - lu(619) * lu(1039) + lu(1097) = lu(1097) - lu(601) * lu(1096) + lu(1101) = lu(1101) - lu(602) * lu(1096) + lu(1103) = lu(1103) - lu(603) * lu(1096) + lu(1106) = lu(1106) - lu(604) * lu(1096) + lu(1107) = lu(1107) - lu(605) * lu(1096) + lu(1108) = lu(1108) - lu(606) * lu(1096) + lu(1109) = lu(1109) - lu(607) * lu(1096) + lu(1110) = lu(1110) - lu(608) * lu(1096) + lu(1111) = lu(1111) - lu(609) * lu(1096) + lu(1112) = lu(1112) - lu(610) * lu(1096) + lu(1114) = lu(1114) - lu(611) * lu(1096) + lu(1115) = lu(1115) - lu(612) * lu(1096) + lu(1117) = lu(1117) - lu(613) * lu(1096) + lu(1119) = lu(1119) - lu(614) * lu(1096) + lu(1120) = lu(1120) - lu(615) * lu(1096) + lu(1121) = lu(1121) - lu(616) * lu(1096) + lu(1122) = lu(1122) - lu(617) * lu(1096) + lu(1124) = lu(1124) - lu(618) * lu(1096) + lu(1127) = lu(1127) - lu(619) * lu(1096) + lu(1184) = lu(1184) - lu(601) * lu(1183) + lu(1187) = lu(1187) - lu(602) * lu(1183) + lu(1189) = lu(1189) - lu(603) * lu(1183) + lu(1192) = lu(1192) - lu(604) * lu(1183) + lu(1193) = lu(1193) - lu(605) * lu(1183) + lu(1194) = lu(1194) - lu(606) * lu(1183) + lu(1195) = lu(1195) - lu(607) * lu(1183) + lu(1196) = lu(1196) - lu(608) * lu(1183) + lu(1197) = lu(1197) - lu(609) * lu(1183) + lu(1198) = lu(1198) - lu(610) * lu(1183) + lu(1200) = lu(1200) - lu(611) * lu(1183) + lu(1201) = lu(1201) - lu(612) * lu(1183) + lu(1203) = lu(1203) - lu(613) * lu(1183) + lu(1205) = lu(1205) - lu(614) * lu(1183) + lu(1206) = lu(1206) - lu(615) * lu(1183) + lu(1207) = lu(1207) - lu(616) * lu(1183) + lu(1208) = lu(1208) - lu(617) * lu(1183) + lu(1210) = lu(1210) - lu(618) * lu(1183) + lu(1213) = lu(1213) - lu(619) * lu(1183) + lu(1262) = lu(1262) - lu(601) * lu(1261) + lu(1265) = lu(1265) - lu(602) * lu(1261) + lu(1267) = lu(1267) - lu(603) * lu(1261) + lu(1270) = lu(1270) - lu(604) * lu(1261) + lu(1271) = lu(1271) - lu(605) * lu(1261) + lu(1272) = lu(1272) - lu(606) * lu(1261) + lu(1273) = lu(1273) - lu(607) * lu(1261) + lu(1274) = lu(1274) - lu(608) * lu(1261) + lu(1275) = lu(1275) - lu(609) * lu(1261) + lu(1276) = lu(1276) - lu(610) * lu(1261) + lu(1278) = lu(1278) - lu(611) * lu(1261) + lu(1279) = lu(1279) - lu(612) * lu(1261) + lu(1281) = lu(1281) - lu(613) * lu(1261) + lu(1283) = lu(1283) - lu(614) * lu(1261) + lu(1284) = lu(1284) - lu(615) * lu(1261) + lu(1285) = lu(1285) - lu(616) * lu(1261) + lu(1286) = lu(1286) - lu(617) * lu(1261) + lu(1288) = lu(1288) - lu(618) * lu(1261) + lu(1291) = lu(1291) - lu(619) * lu(1261) + lu(1321) = lu(1321) - lu(601) * lu(1320) + lu(1324) = lu(1324) - lu(602) * lu(1320) + lu(1326) = lu(1326) - lu(603) * lu(1320) + lu(1329) = lu(1329) - lu(604) * lu(1320) + lu(1330) = lu(1330) - lu(605) * lu(1320) + lu(1331) = lu(1331) - lu(606) * lu(1320) + lu(1332) = lu(1332) - lu(607) * lu(1320) + lu(1333) = lu(1333) - lu(608) * lu(1320) + lu(1334) = lu(1334) - lu(609) * lu(1320) + lu(1335) = lu(1335) - lu(610) * lu(1320) + lu(1337) = lu(1337) - lu(611) * lu(1320) + lu(1338) = lu(1338) - lu(612) * lu(1320) + lu(1340) = lu(1340) - lu(613) * lu(1320) + lu(1342) = lu(1342) - lu(614) * lu(1320) + lu(1343) = lu(1343) - lu(615) * lu(1320) + lu(1344) = lu(1344) - lu(616) * lu(1320) + lu(1345) = lu(1345) - lu(617) * lu(1320) + lu(1347) = lu(1347) - lu(618) * lu(1320) + lu(1350) = lu(1350) - lu(619) * lu(1320) + lu(1491) = lu(1491) - lu(601) * lu(1490) + lu(1494) = lu(1494) - lu(602) * lu(1490) + lu(1496) = lu(1496) - lu(603) * lu(1490) + lu(1499) = lu(1499) - lu(604) * lu(1490) + lu(1500) = lu(1500) - lu(605) * lu(1490) + lu(1501) = lu(1501) - lu(606) * lu(1490) + lu(1502) = lu(1502) - lu(607) * lu(1490) + lu(1503) = lu(1503) - lu(608) * lu(1490) + lu(1504) = lu(1504) - lu(609) * lu(1490) + lu(1505) = lu(1505) - lu(610) * lu(1490) + lu(1507) = lu(1507) - lu(611) * lu(1490) + lu(1508) = lu(1508) - lu(612) * lu(1490) + lu(1510) = lu(1510) - lu(613) * lu(1490) + lu(1512) = lu(1512) - lu(614) * lu(1490) + lu(1513) = lu(1513) - lu(615) * lu(1490) + lu(1514) = lu(1514) - lu(616) * lu(1490) + lu(1515) = lu(1515) - lu(617) * lu(1490) + lu(1517) = lu(1517) - lu(618) * lu(1490) + lu(1520) = lu(1520) - lu(619) * lu(1490) + lu(1537) = - lu(601) * lu(1536) + lu(1540) = lu(1540) - lu(602) * lu(1536) + lu(1542) = lu(1542) - lu(603) * lu(1536) + lu(1545) = lu(1545) - lu(604) * lu(1536) + lu(1546) = lu(1546) - lu(605) * lu(1536) + lu(1547) = lu(1547) - lu(606) * lu(1536) + lu(1548) = lu(1548) - lu(607) * lu(1536) + lu(1549) = lu(1549) - lu(608) * lu(1536) + lu(1550) = lu(1550) - lu(609) * lu(1536) + lu(1551) = lu(1551) - lu(610) * lu(1536) + lu(1553) = lu(1553) - lu(611) * lu(1536) + lu(1554) = lu(1554) - lu(612) * lu(1536) + lu(1556) = lu(1556) - lu(613) * lu(1536) + lu(1558) = lu(1558) - lu(614) * lu(1536) + lu(1559) = lu(1559) - lu(615) * lu(1536) + lu(1560) = lu(1560) - lu(616) * lu(1536) + lu(1561) = lu(1561) - lu(617) * lu(1536) + lu(1563) = lu(1563) - lu(618) * lu(1536) + lu(1566) = lu(1566) - lu(619) * lu(1536) + lu(1582) = lu(1582) - lu(601) * lu(1581) + lu(1586) = lu(1586) - lu(602) * lu(1581) + lu(1588) = lu(1588) - lu(603) * lu(1581) + lu(1591) = lu(1591) - lu(604) * lu(1581) + lu(1592) = lu(1592) - lu(605) * lu(1581) + lu(1593) = lu(1593) - lu(606) * lu(1581) + lu(1594) = lu(1594) - lu(607) * lu(1581) + lu(1595) = lu(1595) - lu(608) * lu(1581) + lu(1596) = lu(1596) - lu(609) * lu(1581) + lu(1597) = lu(1597) - lu(610) * lu(1581) + lu(1599) = lu(1599) - lu(611) * lu(1581) + lu(1600) = lu(1600) - lu(612) * lu(1581) + lu(1602) = lu(1602) - lu(613) * lu(1581) + lu(1604) = lu(1604) - lu(614) * lu(1581) + lu(1605) = lu(1605) - lu(615) * lu(1581) + lu(1606) = lu(1606) - lu(616) * lu(1581) + lu(1607) = lu(1607) - lu(617) * lu(1581) + lu(1609) = lu(1609) - lu(618) * lu(1581) + lu(1612) = lu(1612) - lu(619) * lu(1581) + lu(1626) = lu(1626) - lu(601) * lu(1625) + lu(1628) = lu(1628) - lu(602) * lu(1625) + lu(1630) = lu(1630) - lu(603) * lu(1625) + lu(1632) = lu(1632) - lu(604) * lu(1625) + lu(1633) = lu(1633) - lu(605) * lu(1625) + lu(1634) = lu(1634) - lu(606) * lu(1625) + lu(1635) = lu(1635) - lu(607) * lu(1625) + lu(1636) = lu(1636) - lu(608) * lu(1625) + lu(1637) = lu(1637) - lu(609) * lu(1625) + lu(1638) = lu(1638) - lu(610) * lu(1625) + lu(1640) = lu(1640) - lu(611) * lu(1625) + lu(1641) = lu(1641) - lu(612) * lu(1625) + lu(1643) = lu(1643) - lu(613) * lu(1625) + lu(1645) = lu(1645) - lu(614) * lu(1625) + lu(1646) = lu(1646) - lu(615) * lu(1625) + lu(1647) = lu(1647) - lu(616) * lu(1625) + lu(1648) = lu(1648) - lu(617) * lu(1625) + lu(1650) = lu(1650) - lu(618) * lu(1625) + lu(1653) = lu(1653) - lu(619) * lu(1625) + lu(1707) = lu(1707) - lu(601) * lu(1706) + lu(1710) = lu(1710) - lu(602) * lu(1706) + lu(1712) = lu(1712) - lu(603) * lu(1706) + lu(1715) = lu(1715) - lu(604) * lu(1706) + lu(1716) = lu(1716) - lu(605) * lu(1706) + lu(1717) = lu(1717) - lu(606) * lu(1706) + lu(1718) = - lu(607) * lu(1706) + lu(1719) = lu(1719) - lu(608) * lu(1706) + lu(1720) = lu(1720) - lu(609) * lu(1706) + lu(1721) = lu(1721) - lu(610) * lu(1706) + lu(1723) = lu(1723) - lu(611) * lu(1706) + lu(1724) = lu(1724) - lu(612) * lu(1706) + lu(1726) = lu(1726) - lu(613) * lu(1706) + lu(1728) = lu(1728) - lu(614) * lu(1706) + lu(1729) = lu(1729) - lu(615) * lu(1706) + lu(1730) = lu(1730) - lu(616) * lu(1706) + lu(1731) = lu(1731) - lu(617) * lu(1706) + lu(1733) = lu(1733) - lu(618) * lu(1706) + lu(1736) = lu(1736) - lu(619) * lu(1706) + lu(1830) = lu(1830) - lu(601) * lu(1829) + lu(1834) = lu(1834) - lu(602) * lu(1829) + lu(1836) = lu(1836) - lu(603) * lu(1829) + lu(1839) = lu(1839) - lu(604) * lu(1829) + lu(1840) = lu(1840) - lu(605) * lu(1829) + lu(1841) = lu(1841) - lu(606) * lu(1829) + lu(1842) = lu(1842) - lu(607) * lu(1829) + lu(1843) = lu(1843) - lu(608) * lu(1829) + lu(1844) = lu(1844) - lu(609) * lu(1829) + lu(1845) = lu(1845) - lu(610) * lu(1829) + lu(1847) = lu(1847) - lu(611) * lu(1829) + lu(1848) = lu(1848) - lu(612) * lu(1829) + lu(1850) = lu(1850) - lu(613) * lu(1829) + lu(1852) = lu(1852) - lu(614) * lu(1829) + lu(1853) = lu(1853) - lu(615) * lu(1829) + lu(1854) = lu(1854) - lu(616) * lu(1829) + lu(1855) = lu(1855) - lu(617) * lu(1829) + lu(1857) = lu(1857) - lu(618) * lu(1829) + lu(1860) = lu(1860) - lu(619) * lu(1829) + lu(631) = 1._r8 / lu(631) + lu(632) = lu(632) * lu(631) + lu(633) = lu(633) * lu(631) + lu(634) = lu(634) * lu(631) + lu(635) = lu(635) * lu(631) + lu(636) = lu(636) * lu(631) + lu(637) = lu(637) * lu(631) + lu(638) = lu(638) * lu(631) + lu(639) = lu(639) * lu(631) + lu(640) = lu(640) * lu(631) + lu(641) = lu(641) * lu(631) + lu(642) = lu(642) * lu(631) + lu(643) = lu(643) * lu(631) + lu(644) = lu(644) * lu(631) + lu(645) = lu(645) * lu(631) + lu(646) = lu(646) * lu(631) + lu(647) = lu(647) * lu(631) + lu(648) = lu(648) * lu(631) + lu(649) = lu(649) * lu(631) + lu(650) = lu(650) * lu(631) + lu(651) = lu(651) * lu(631) + lu(652) = lu(652) * lu(631) + lu(744) = lu(744) - lu(632) * lu(743) + lu(745) = lu(745) - lu(633) * lu(743) + lu(746) = lu(746) - lu(634) * lu(743) + lu(747) = lu(747) - lu(635) * lu(743) + lu(748) = lu(748) - lu(636) * lu(743) + lu(749) = lu(749) - lu(637) * lu(743) + lu(750) = lu(750) - lu(638) * lu(743) + lu(751) = lu(751) - lu(639) * lu(743) + lu(752) = lu(752) - lu(640) * lu(743) + lu(754) = lu(754) - lu(641) * lu(743) + lu(755) = lu(755) - lu(642) * lu(743) + lu(756) = lu(756) - lu(643) * lu(743) + lu(757) = lu(757) - lu(644) * lu(743) + lu(758) = lu(758) - lu(645) * lu(743) + lu(759) = lu(759) - lu(646) * lu(743) + lu(760) = lu(760) - lu(647) * lu(743) + lu(761) = lu(761) - lu(648) * lu(743) + lu(762) = lu(762) - lu(649) * lu(743) + lu(763) = - lu(650) * lu(743) + lu(764) = - lu(651) * lu(743) + lu(765) = lu(765) - lu(652) * lu(743) + lu(818) = lu(818) - lu(632) * lu(817) + lu(819) = lu(819) - lu(633) * lu(817) + lu(820) = lu(820) - lu(634) * lu(817) + lu(821) = lu(821) - lu(635) * lu(817) + lu(822) = lu(822) - lu(636) * lu(817) + lu(823) = lu(823) - lu(637) * lu(817) + lu(824) = lu(824) - lu(638) * lu(817) + lu(825) = lu(825) - lu(639) * lu(817) + lu(826) = lu(826) - lu(640) * lu(817) + lu(828) = lu(828) - lu(641) * lu(817) + lu(829) = lu(829) - lu(642) * lu(817) + lu(830) = lu(830) - lu(643) * lu(817) + lu(831) = lu(831) - lu(644) * lu(817) + lu(832) = lu(832) - lu(645) * lu(817) + lu(833) = lu(833) - lu(646) * lu(817) + lu(834) = lu(834) - lu(647) * lu(817) + lu(835) = lu(835) - lu(648) * lu(817) + lu(836) = lu(836) - lu(649) * lu(817) + lu(837) = lu(837) - lu(650) * lu(817) + lu(838) = - lu(651) * lu(817) + lu(839) = lu(839) - lu(652) * lu(817) + lu(926) = lu(926) - lu(632) * lu(922) + lu(928) = lu(928) - lu(633) * lu(922) + lu(931) = lu(931) - lu(634) * lu(922) + lu(932) = lu(932) - lu(635) * lu(922) + lu(933) = lu(933) - lu(636) * lu(922) + lu(934) = lu(934) - lu(637) * lu(922) + lu(935) = lu(935) - lu(638) * lu(922) + lu(936) = lu(936) - lu(639) * lu(922) + lu(937) = lu(937) - lu(640) * lu(922) + lu(939) = lu(939) - lu(641) * lu(922) + lu(940) = lu(940) - lu(642) * lu(922) + lu(941) = lu(941) - lu(643) * lu(922) + lu(942) = lu(942) - lu(644) * lu(922) + lu(944) = lu(944) - lu(645) * lu(922) + lu(945) = lu(945) - lu(646) * lu(922) + lu(946) = lu(946) - lu(647) * lu(922) + lu(947) = lu(947) - lu(648) * lu(922) + lu(949) = lu(949) - lu(649) * lu(922) + lu(950) = - lu(650) * lu(922) + lu(951) = lu(951) - lu(651) * lu(922) + lu(952) = lu(952) - lu(652) * lu(922) + lu(1003) = lu(1003) - lu(632) * lu(999) + lu(1005) = lu(1005) - lu(633) * lu(999) + lu(1008) = lu(1008) - lu(634) * lu(999) + lu(1009) = lu(1009) - lu(635) * lu(999) + lu(1010) = lu(1010) - lu(636) * lu(999) + lu(1011) = lu(1011) - lu(637) * lu(999) + lu(1012) = lu(1012) - lu(638) * lu(999) + lu(1013) = lu(1013) - lu(639) * lu(999) + lu(1014) = lu(1014) - lu(640) * lu(999) + lu(1016) = lu(1016) - lu(641) * lu(999) + lu(1017) = lu(1017) - lu(642) * lu(999) + lu(1018) = lu(1018) - lu(643) * lu(999) + lu(1019) = lu(1019) - lu(644) * lu(999) + lu(1021) = lu(1021) - lu(645) * lu(999) + lu(1022) = lu(1022) - lu(646) * lu(999) + lu(1023) = lu(1023) - lu(647) * lu(999) + lu(1024) = lu(1024) - lu(648) * lu(999) + lu(1026) = lu(1026) - lu(649) * lu(999) + lu(1027) = lu(1027) - lu(650) * lu(999) + lu(1028) = lu(1028) - lu(651) * lu(999) + lu(1029) = lu(1029) - lu(652) * lu(999) + lu(1043) = lu(1043) - lu(632) * lu(1040) + lu(1045) = lu(1045) - lu(633) * lu(1040) + lu(1048) = lu(1048) - lu(634) * lu(1040) + lu(1049) = lu(1049) - lu(635) * lu(1040) + lu(1050) = lu(1050) - lu(636) * lu(1040) + lu(1051) = lu(1051) - lu(637) * lu(1040) + lu(1052) = lu(1052) - lu(638) * lu(1040) + lu(1053) = lu(1053) - lu(639) * lu(1040) + lu(1054) = lu(1054) - lu(640) * lu(1040) + lu(1056) = lu(1056) - lu(641) * lu(1040) + lu(1057) = lu(1057) - lu(642) * lu(1040) + lu(1058) = lu(1058) - lu(643) * lu(1040) + lu(1059) = lu(1059) - lu(644) * lu(1040) + lu(1061) = lu(1061) - lu(645) * lu(1040) + lu(1062) = lu(1062) - lu(646) * lu(1040) + lu(1063) = lu(1063) - lu(647) * lu(1040) + lu(1064) = lu(1064) - lu(648) * lu(1040) + lu(1066) = lu(1066) - lu(649) * lu(1040) + lu(1067) = lu(1067) - lu(650) * lu(1040) + lu(1068) = lu(1068) - lu(651) * lu(1040) + lu(1069) = lu(1069) - lu(652) * lu(1040) + lu(1101) = lu(1101) - lu(632) * lu(1097) + lu(1103) = lu(1103) - lu(633) * lu(1097) + lu(1106) = lu(1106) - lu(634) * lu(1097) + lu(1107) = lu(1107) - lu(635) * lu(1097) + lu(1108) = lu(1108) - lu(636) * lu(1097) + lu(1109) = lu(1109) - lu(637) * lu(1097) + lu(1110) = lu(1110) - lu(638) * lu(1097) + lu(1111) = lu(1111) - lu(639) * lu(1097) + lu(1112) = lu(1112) - lu(640) * lu(1097) + lu(1114) = lu(1114) - lu(641) * lu(1097) + lu(1115) = lu(1115) - lu(642) * lu(1097) + lu(1116) = lu(1116) - lu(643) * lu(1097) + lu(1117) = lu(1117) - lu(644) * lu(1097) + lu(1119) = lu(1119) - lu(645) * lu(1097) + lu(1120) = lu(1120) - lu(646) * lu(1097) + lu(1121) = lu(1121) - lu(647) * lu(1097) + lu(1122) = lu(1122) - lu(648) * lu(1097) + lu(1124) = lu(1124) - lu(649) * lu(1097) + lu(1125) = lu(1125) - lu(650) * lu(1097) + lu(1126) = lu(1126) - lu(651) * lu(1097) + lu(1127) = lu(1127) - lu(652) * lu(1097) + lu(1143) = lu(1143) - lu(632) * lu(1142) + lu(1144) = lu(1144) - lu(633) * lu(1142) + lu(1146) = lu(1146) - lu(634) * lu(1142) + lu(1147) = - lu(635) * lu(1142) + lu(1148) = - lu(636) * lu(1142) + lu(1149) = lu(1149) - lu(637) * lu(1142) + lu(1150) = lu(1150) - lu(638) * lu(1142) + lu(1151) = lu(1151) - lu(639) * lu(1142) + lu(1152) = lu(1152) - lu(640) * lu(1142) + lu(1154) = lu(1154) - lu(641) * lu(1142) + lu(1155) = lu(1155) - lu(642) * lu(1142) + lu(1156) = lu(1156) - lu(643) * lu(1142) + lu(1157) = lu(1157) - lu(644) * lu(1142) + lu(1159) = lu(1159) - lu(645) * lu(1142) + lu(1160) = lu(1160) - lu(646) * lu(1142) + lu(1161) = - lu(647) * lu(1142) + lu(1162) = - lu(648) * lu(1142) + lu(1164) = - lu(649) * lu(1142) + lu(1165) = lu(1165) - lu(650) * lu(1142) + lu(1166) = lu(1166) - lu(651) * lu(1142) + lu(1167) = - lu(652) * lu(1142) + lu(1187) = lu(1187) - lu(632) * lu(1184) + lu(1189) = lu(1189) - lu(633) * lu(1184) + lu(1192) = lu(1192) - lu(634) * lu(1184) + lu(1193) = lu(1193) - lu(635) * lu(1184) + lu(1194) = lu(1194) - lu(636) * lu(1184) + lu(1195) = lu(1195) - lu(637) * lu(1184) + lu(1196) = lu(1196) - lu(638) * lu(1184) + lu(1197) = lu(1197) - lu(639) * lu(1184) + lu(1198) = lu(1198) - lu(640) * lu(1184) + lu(1200) = lu(1200) - lu(641) * lu(1184) + lu(1201) = lu(1201) - lu(642) * lu(1184) + lu(1202) = lu(1202) - lu(643) * lu(1184) + lu(1203) = lu(1203) - lu(644) * lu(1184) + lu(1205) = lu(1205) - lu(645) * lu(1184) + lu(1206) = lu(1206) - lu(646) * lu(1184) + lu(1207) = lu(1207) - lu(647) * lu(1184) + lu(1208) = lu(1208) - lu(648) * lu(1184) + lu(1210) = lu(1210) - lu(649) * lu(1184) + lu(1211) = lu(1211) - lu(650) * lu(1184) + lu(1212) = lu(1212) - lu(651) * lu(1184) + lu(1213) = lu(1213) - lu(652) * lu(1184) + lu(1265) = lu(1265) - lu(632) * lu(1262) + lu(1267) = lu(1267) - lu(633) * lu(1262) + lu(1270) = lu(1270) - lu(634) * lu(1262) + lu(1271) = lu(1271) - lu(635) * lu(1262) + lu(1272) = lu(1272) - lu(636) * lu(1262) + lu(1273) = lu(1273) - lu(637) * lu(1262) + lu(1274) = lu(1274) - lu(638) * lu(1262) + lu(1275) = lu(1275) - lu(639) * lu(1262) + lu(1276) = lu(1276) - lu(640) * lu(1262) + lu(1278) = lu(1278) - lu(641) * lu(1262) + lu(1279) = lu(1279) - lu(642) * lu(1262) + lu(1280) = lu(1280) - lu(643) * lu(1262) + lu(1281) = lu(1281) - lu(644) * lu(1262) + lu(1283) = lu(1283) - lu(645) * lu(1262) + lu(1284) = lu(1284) - lu(646) * lu(1262) + lu(1285) = lu(1285) - lu(647) * lu(1262) + lu(1286) = lu(1286) - lu(648) * lu(1262) + lu(1288) = lu(1288) - lu(649) * lu(1262) + lu(1289) = lu(1289) - lu(650) * lu(1262) + lu(1290) = lu(1290) - lu(651) * lu(1262) + lu(1291) = lu(1291) - lu(652) * lu(1262) + lu(1324) = lu(1324) - lu(632) * lu(1321) + lu(1326) = lu(1326) - lu(633) * lu(1321) + lu(1329) = lu(1329) - lu(634) * lu(1321) + lu(1330) = lu(1330) - lu(635) * lu(1321) + lu(1331) = lu(1331) - lu(636) * lu(1321) + lu(1332) = lu(1332) - lu(637) * lu(1321) + lu(1333) = lu(1333) - lu(638) * lu(1321) + lu(1334) = lu(1334) - lu(639) * lu(1321) + lu(1335) = lu(1335) - lu(640) * lu(1321) + lu(1337) = lu(1337) - lu(641) * lu(1321) + lu(1338) = lu(1338) - lu(642) * lu(1321) + lu(1339) = lu(1339) - lu(643) * lu(1321) + lu(1340) = lu(1340) - lu(644) * lu(1321) + lu(1342) = lu(1342) - lu(645) * lu(1321) + lu(1343) = lu(1343) - lu(646) * lu(1321) + lu(1344) = lu(1344) - lu(647) * lu(1321) + lu(1345) = lu(1345) - lu(648) * lu(1321) + lu(1347) = lu(1347) - lu(649) * lu(1321) + lu(1348) = lu(1348) - lu(650) * lu(1321) + lu(1349) = lu(1349) - lu(651) * lu(1321) + lu(1350) = lu(1350) - lu(652) * lu(1321) + lu(1494) = lu(1494) - lu(632) * lu(1491) + lu(1496) = lu(1496) - lu(633) * lu(1491) + lu(1499) = lu(1499) - lu(634) * lu(1491) + lu(1500) = lu(1500) - lu(635) * lu(1491) + lu(1501) = lu(1501) - lu(636) * lu(1491) + lu(1502) = lu(1502) - lu(637) * lu(1491) + lu(1503) = lu(1503) - lu(638) * lu(1491) + lu(1504) = lu(1504) - lu(639) * lu(1491) + lu(1505) = lu(1505) - lu(640) * lu(1491) + lu(1507) = lu(1507) - lu(641) * lu(1491) + lu(1508) = lu(1508) - lu(642) * lu(1491) + lu(1509) = lu(1509) - lu(643) * lu(1491) + lu(1510) = lu(1510) - lu(644) * lu(1491) + lu(1512) = lu(1512) - lu(645) * lu(1491) + lu(1513) = lu(1513) - lu(646) * lu(1491) + lu(1514) = lu(1514) - lu(647) * lu(1491) + lu(1515) = lu(1515) - lu(648) * lu(1491) + lu(1517) = lu(1517) - lu(649) * lu(1491) + lu(1518) = lu(1518) - lu(650) * lu(1491) + lu(1519) = lu(1519) - lu(651) * lu(1491) + lu(1520) = lu(1520) - lu(652) * lu(1491) + lu(1540) = lu(1540) - lu(632) * lu(1537) + lu(1542) = lu(1542) - lu(633) * lu(1537) + lu(1545) = lu(1545) - lu(634) * lu(1537) + lu(1546) = lu(1546) - lu(635) * lu(1537) + lu(1547) = lu(1547) - lu(636) * lu(1537) + lu(1548) = lu(1548) - lu(637) * lu(1537) + lu(1549) = lu(1549) - lu(638) * lu(1537) + lu(1550) = lu(1550) - lu(639) * lu(1537) + lu(1551) = lu(1551) - lu(640) * lu(1537) + lu(1553) = lu(1553) - lu(641) * lu(1537) + lu(1554) = lu(1554) - lu(642) * lu(1537) + lu(1555) = lu(1555) - lu(643) * lu(1537) + lu(1556) = lu(1556) - lu(644) * lu(1537) + lu(1558) = lu(1558) - lu(645) * lu(1537) + lu(1559) = lu(1559) - lu(646) * lu(1537) + lu(1560) = lu(1560) - lu(647) * lu(1537) + lu(1561) = lu(1561) - lu(648) * lu(1537) + lu(1563) = lu(1563) - lu(649) * lu(1537) + lu(1564) = lu(1564) - lu(650) * lu(1537) + lu(1565) = lu(1565) - lu(651) * lu(1537) + lu(1566) = lu(1566) - lu(652) * lu(1537) + lu(1586) = lu(1586) - lu(632) * lu(1582) + lu(1588) = lu(1588) - lu(633) * lu(1582) + lu(1591) = lu(1591) - lu(634) * lu(1582) + lu(1592) = lu(1592) - lu(635) * lu(1582) + lu(1593) = lu(1593) - lu(636) * lu(1582) + lu(1594) = lu(1594) - lu(637) * lu(1582) + lu(1595) = lu(1595) - lu(638) * lu(1582) + lu(1596) = lu(1596) - lu(639) * lu(1582) + lu(1597) = lu(1597) - lu(640) * lu(1582) + lu(1599) = lu(1599) - lu(641) * lu(1582) + lu(1600) = lu(1600) - lu(642) * lu(1582) + lu(1601) = - lu(643) * lu(1582) + lu(1602) = lu(1602) - lu(644) * lu(1582) + lu(1604) = lu(1604) - lu(645) * lu(1582) + lu(1605) = lu(1605) - lu(646) * lu(1582) + lu(1606) = lu(1606) - lu(647) * lu(1582) + lu(1607) = lu(1607) - lu(648) * lu(1582) + lu(1609) = lu(1609) - lu(649) * lu(1582) + lu(1610) = - lu(650) * lu(1582) + lu(1611) = lu(1611) - lu(651) * lu(1582) + lu(1612) = lu(1612) - lu(652) * lu(1582) + lu(1628) = lu(1628) - lu(632) * lu(1626) + lu(1630) = lu(1630) - lu(633) * lu(1626) + lu(1632) = lu(1632) - lu(634) * lu(1626) + lu(1633) = lu(1633) - lu(635) * lu(1626) + lu(1634) = lu(1634) - lu(636) * lu(1626) + lu(1635) = lu(1635) - lu(637) * lu(1626) + lu(1636) = lu(1636) - lu(638) * lu(1626) + lu(1637) = lu(1637) - lu(639) * lu(1626) + lu(1638) = lu(1638) - lu(640) * lu(1626) + lu(1640) = lu(1640) - lu(641) * lu(1626) + lu(1641) = lu(1641) - lu(642) * lu(1626) + lu(1642) = lu(1642) - lu(643) * lu(1626) + lu(1643) = lu(1643) - lu(644) * lu(1626) + lu(1645) = lu(1645) - lu(645) * lu(1626) + lu(1646) = lu(1646) - lu(646) * lu(1626) + lu(1647) = lu(1647) - lu(647) * lu(1626) + lu(1648) = lu(1648) - lu(648) * lu(1626) + lu(1650) = lu(1650) - lu(649) * lu(1626) + lu(1651) = lu(1651) - lu(650) * lu(1626) + lu(1652) = - lu(651) * lu(1626) + lu(1653) = lu(1653) - lu(652) * lu(1626) + lu(1710) = lu(1710) - lu(632) * lu(1707) + lu(1712) = lu(1712) - lu(633) * lu(1707) + lu(1715) = lu(1715) - lu(634) * lu(1707) + lu(1716) = lu(1716) - lu(635) * lu(1707) + lu(1717) = lu(1717) - lu(636) * lu(1707) + lu(1718) = lu(1718) - lu(637) * lu(1707) + lu(1719) = lu(1719) - lu(638) * lu(1707) + lu(1720) = lu(1720) - lu(639) * lu(1707) + lu(1721) = lu(1721) - lu(640) * lu(1707) + lu(1723) = lu(1723) - lu(641) * lu(1707) + lu(1724) = lu(1724) - lu(642) * lu(1707) + lu(1725) = lu(1725) - lu(643) * lu(1707) + lu(1726) = lu(1726) - lu(644) * lu(1707) + lu(1728) = lu(1728) - lu(645) * lu(1707) + lu(1729) = lu(1729) - lu(646) * lu(1707) + lu(1730) = lu(1730) - lu(647) * lu(1707) + lu(1731) = lu(1731) - lu(648) * lu(1707) + lu(1733) = lu(1733) - lu(649) * lu(1707) + lu(1734) = lu(1734) - lu(650) * lu(1707) + lu(1735) = lu(1735) - lu(651) * lu(1707) + lu(1736) = lu(1736) - lu(652) * lu(1707) + lu(1756) = lu(1756) - lu(632) * lu(1752) + lu(1758) = lu(1758) - lu(633) * lu(1752) + lu(1761) = lu(1761) - lu(634) * lu(1752) + lu(1762) = - lu(635) * lu(1752) + lu(1763) = lu(1763) - lu(636) * lu(1752) + lu(1764) = lu(1764) - lu(637) * lu(1752) + lu(1765) = lu(1765) - lu(638) * lu(1752) + lu(1766) = lu(1766) - lu(639) * lu(1752) + lu(1767) = lu(1767) - lu(640) * lu(1752) + lu(1769) = lu(1769) - lu(641) * lu(1752) + lu(1770) = lu(1770) - lu(642) * lu(1752) + lu(1771) = lu(1771) - lu(643) * lu(1752) + lu(1772) = lu(1772) - lu(644) * lu(1752) + lu(1774) = lu(1774) - lu(645) * lu(1752) + lu(1775) = lu(1775) - lu(646) * lu(1752) + lu(1776) = - lu(647) * lu(1752) + lu(1777) = lu(1777) - lu(648) * lu(1752) + lu(1779) = lu(1779) - lu(649) * lu(1752) + lu(1780) = lu(1780) - lu(650) * lu(1752) + lu(1781) = lu(1781) - lu(651) * lu(1752) + lu(1782) = lu(1782) - lu(652) * lu(1752) + lu(1834) = lu(1834) - lu(632) * lu(1830) + lu(1836) = lu(1836) - lu(633) * lu(1830) + lu(1839) = lu(1839) - lu(634) * lu(1830) + lu(1840) = lu(1840) - lu(635) * lu(1830) + lu(1841) = lu(1841) - lu(636) * lu(1830) + lu(1842) = lu(1842) - lu(637) * lu(1830) + lu(1843) = lu(1843) - lu(638) * lu(1830) + lu(1844) = lu(1844) - lu(639) * lu(1830) + lu(1845) = lu(1845) - lu(640) * lu(1830) + lu(1847) = lu(1847) - lu(641) * lu(1830) + lu(1848) = lu(1848) - lu(642) * lu(1830) + lu(1849) = - lu(643) * lu(1830) + lu(1850) = lu(1850) - lu(644) * lu(1830) + lu(1852) = lu(1852) - lu(645) * lu(1830) + lu(1853) = lu(1853) - lu(646) * lu(1830) + lu(1854) = lu(1854) - lu(647) * lu(1830) + lu(1855) = lu(1855) - lu(648) * lu(1830) + lu(1857) = lu(1857) - lu(649) * lu(1830) + lu(1858) = - lu(650) * lu(1830) + lu(1859) = lu(1859) - lu(651) * lu(1830) + lu(1860) = lu(1860) - lu(652) * lu(1830) + lu(1880) = lu(1880) - lu(632) * lu(1876) + lu(1882) = lu(1882) - lu(633) * lu(1876) + lu(1885) = lu(1885) - lu(634) * lu(1876) + lu(1886) = - lu(635) * lu(1876) + lu(1887) = lu(1887) - lu(636) * lu(1876) + lu(1888) = - lu(637) * lu(1876) + lu(1889) = lu(1889) - lu(638) * lu(1876) + lu(1890) = lu(1890) - lu(639) * lu(1876) + lu(1891) = lu(1891) - lu(640) * lu(1876) + lu(1893) = - lu(641) * lu(1876) + lu(1894) = lu(1894) - lu(642) * lu(1876) + lu(1895) = lu(1895) - lu(643) * lu(1876) + lu(1896) = lu(1896) - lu(644) * lu(1876) + lu(1898) = lu(1898) - lu(645) * lu(1876) + lu(1899) = lu(1899) - lu(646) * lu(1876) + lu(1900) = - lu(647) * lu(1876) + lu(1901) = lu(1901) - lu(648) * lu(1876) + lu(1903) = lu(1903) - lu(649) * lu(1876) + lu(1904) = lu(1904) - lu(650) * lu(1876) + lu(1905) = lu(1905) - lu(651) * lu(1876) + lu(1906) = lu(1906) - lu(652) * lu(1876) + end subroutine lu_fac15 + subroutine lu_fac16( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(655) = 1._r8 / lu(655) + lu(656) = lu(656) * lu(655) + lu(657) = lu(657) * lu(655) + lu(658) = lu(658) * lu(655) + lu(659) = lu(659) * lu(655) + lu(660) = lu(660) * lu(655) + lu(661) = lu(661) * lu(655) + lu(662) = lu(662) * lu(655) + lu(663) = lu(663) * lu(655) + lu(664) = lu(664) * lu(655) + lu(665) = lu(665) * lu(655) + lu(666) = lu(666) * lu(655) + lu(667) = lu(667) * lu(655) + lu(668) = lu(668) * lu(655) + lu(669) = lu(669) * lu(655) + lu(670) = lu(670) * lu(655) + lu(671) = lu(671) * lu(655) + lu(672) = lu(672) * lu(655) + lu(673) = lu(673) * lu(655) + lu(678) = lu(678) - lu(656) * lu(676) + lu(680) = lu(680) - lu(657) * lu(676) + lu(683) = lu(683) - lu(658) * lu(676) + lu(684) = lu(684) - lu(659) * lu(676) + lu(686) = lu(686) - lu(660) * lu(676) + lu(689) = lu(689) - lu(661) * lu(676) + lu(690) = lu(690) - lu(662) * lu(676) + lu(691) = lu(691) - lu(663) * lu(676) + lu(693) = lu(693) - lu(664) * lu(676) + lu(694) = lu(694) - lu(665) * lu(676) + lu(696) = lu(696) - lu(666) * lu(676) + lu(697) = lu(697) - lu(667) * lu(676) + lu(698) = lu(698) - lu(668) * lu(676) + lu(700) = lu(700) - lu(669) * lu(676) + lu(701) = - lu(670) * lu(676) + lu(702) = lu(702) - lu(671) * lu(676) + lu(704) = lu(704) - lu(672) * lu(676) + lu(705) = lu(705) - lu(673) * lu(676) + lu(710) = lu(710) - lu(656) * lu(709) + lu(711) = lu(711) - lu(657) * lu(709) + lu(712) = lu(712) - lu(658) * lu(709) + lu(713) = lu(713) - lu(659) * lu(709) + lu(714) = lu(714) - lu(660) * lu(709) + lu(717) = lu(717) - lu(661) * lu(709) + lu(718) = lu(718) - lu(662) * lu(709) + lu(719) = lu(719) - lu(663) * lu(709) + lu(720) = lu(720) - lu(664) * lu(709) + lu(721) = lu(721) - lu(665) * lu(709) + lu(722) = lu(722) - lu(666) * lu(709) + lu(723) = lu(723) - lu(667) * lu(709) + lu(724) = lu(724) - lu(668) * lu(709) + lu(726) = lu(726) - lu(669) * lu(709) + lu(727) = lu(727) - lu(670) * lu(709) + lu(728) = lu(728) - lu(671) * lu(709) + lu(729) = - lu(672) * lu(709) + lu(730) = lu(730) - lu(673) * lu(709) + lu(769) = lu(769) - lu(656) * lu(768) + lu(770) = lu(770) - lu(657) * lu(768) + lu(772) = lu(772) - lu(658) * lu(768) + lu(773) = lu(773) - lu(659) * lu(768) + lu(775) = lu(775) - lu(660) * lu(768) + lu(778) = lu(778) - lu(661) * lu(768) + lu(779) = lu(779) - lu(662) * lu(768) + lu(780) = lu(780) - lu(663) * lu(768) + lu(781) = lu(781) - lu(664) * lu(768) + lu(782) = lu(782) - lu(665) * lu(768) + lu(783) = lu(783) - lu(666) * lu(768) + lu(784) = lu(784) - lu(667) * lu(768) + lu(785) = lu(785) - lu(668) * lu(768) + lu(788) = lu(788) - lu(669) * lu(768) + lu(789) = lu(789) - lu(670) * lu(768) + lu(790) = lu(790) - lu(671) * lu(768) + lu(791) = lu(791) - lu(672) * lu(768) + lu(792) = lu(792) - lu(673) * lu(768) + lu(846) = lu(846) - lu(656) * lu(845) + lu(847) = lu(847) - lu(657) * lu(845) + lu(850) = lu(850) - lu(658) * lu(845) + lu(851) = lu(851) - lu(659) * lu(845) + lu(853) = - lu(660) * lu(845) + lu(856) = lu(856) - lu(661) * lu(845) + lu(857) = lu(857) - lu(662) * lu(845) + lu(858) = lu(858) - lu(663) * lu(845) + lu(860) = lu(860) - lu(664) * lu(845) + lu(861) = lu(861) - lu(665) * lu(845) + lu(863) = lu(863) - lu(666) * lu(845) + lu(864) = lu(864) - lu(667) * lu(845) + lu(865) = lu(865) - lu(668) * lu(845) + lu(868) = lu(868) - lu(669) * lu(845) + lu(869) = lu(869) - lu(670) * lu(845) + lu(870) = lu(870) - lu(671) * lu(845) + lu(872) = lu(872) - lu(672) * lu(845) + lu(873) = lu(873) - lu(673) * lu(845) + lu(888) = lu(888) - lu(656) * lu(886) + lu(890) = lu(890) - lu(657) * lu(886) + lu(893) = lu(893) - lu(658) * lu(886) + lu(894) = lu(894) - lu(659) * lu(886) + lu(896) = lu(896) - lu(660) * lu(886) + lu(899) = lu(899) - lu(661) * lu(886) + lu(900) = lu(900) - lu(662) * lu(886) + lu(901) = lu(901) - lu(663) * lu(886) + lu(903) = lu(903) - lu(664) * lu(886) + lu(904) = lu(904) - lu(665) * lu(886) + lu(906) = lu(906) - lu(666) * lu(886) + lu(907) = lu(907) - lu(667) * lu(886) + lu(908) = lu(908) - lu(668) * lu(886) + lu(911) = lu(911) - lu(669) * lu(886) + lu(912) = lu(912) - lu(670) * lu(886) + lu(913) = lu(913) - lu(671) * lu(886) + lu(915) = lu(915) - lu(672) * lu(886) + lu(916) = lu(916) - lu(673) * lu(886) + lu(925) = lu(925) - lu(656) * lu(923) + lu(927) = lu(927) - lu(657) * lu(923) + lu(930) = - lu(658) * lu(923) + lu(931) = lu(931) - lu(659) * lu(923) + lu(933) = lu(933) - lu(660) * lu(923) + lu(936) = lu(936) - lu(661) * lu(923) + lu(937) = lu(937) - lu(662) * lu(923) + lu(938) = lu(938) - lu(663) * lu(923) + lu(940) = lu(940) - lu(664) * lu(923) + lu(941) = lu(941) - lu(665) * lu(923) + lu(943) = - lu(666) * lu(923) + lu(944) = lu(944) - lu(667) * lu(923) + lu(945) = lu(945) - lu(668) * lu(923) + lu(948) = - lu(669) * lu(923) + lu(949) = lu(949) - lu(670) * lu(923) + lu(950) = lu(950) - lu(671) * lu(923) + lu(952) = lu(952) - lu(672) * lu(923) + lu(953) = - lu(673) * lu(923) + lu(958) = lu(958) - lu(656) * lu(957) + lu(960) = lu(960) - lu(657) * lu(957) + lu(963) = lu(963) - lu(658) * lu(957) + lu(964) = lu(964) - lu(659) * lu(957) + lu(966) = lu(966) - lu(660) * lu(957) + lu(969) = lu(969) - lu(661) * lu(957) + lu(970) = lu(970) - lu(662) * lu(957) + lu(971) = lu(971) - lu(663) * lu(957) + lu(973) = lu(973) - lu(664) * lu(957) + lu(974) = lu(974) - lu(665) * lu(957) + lu(976) = lu(976) - lu(666) * lu(957) + lu(977) = lu(977) - lu(667) * lu(957) + lu(978) = lu(978) - lu(668) * lu(957) + lu(981) = lu(981) - lu(669) * lu(957) + lu(982) = - lu(670) * lu(957) + lu(983) = lu(983) - lu(671) * lu(957) + lu(985) = lu(985) - lu(672) * lu(957) + lu(986) = lu(986) - lu(673) * lu(957) + lu(1002) = lu(1002) - lu(656) * lu(1000) + lu(1004) = lu(1004) - lu(657) * lu(1000) + lu(1007) = lu(1007) - lu(658) * lu(1000) + lu(1008) = lu(1008) - lu(659) * lu(1000) + lu(1010) = lu(1010) - lu(660) * lu(1000) + lu(1013) = lu(1013) - lu(661) * lu(1000) + lu(1014) = lu(1014) - lu(662) * lu(1000) + lu(1015) = lu(1015) - lu(663) * lu(1000) + lu(1017) = lu(1017) - lu(664) * lu(1000) + lu(1018) = lu(1018) - lu(665) * lu(1000) + lu(1020) = lu(1020) - lu(666) * lu(1000) + lu(1021) = lu(1021) - lu(667) * lu(1000) + lu(1022) = lu(1022) - lu(668) * lu(1000) + lu(1025) = lu(1025) - lu(669) * lu(1000) + lu(1026) = lu(1026) - lu(670) * lu(1000) + lu(1027) = lu(1027) - lu(671) * lu(1000) + lu(1029) = lu(1029) - lu(672) * lu(1000) + lu(1030) = lu(1030) - lu(673) * lu(1000) + lu(1100) = lu(1100) - lu(656) * lu(1098) + lu(1102) = lu(1102) - lu(657) * lu(1098) + lu(1105) = - lu(658) * lu(1098) + lu(1106) = lu(1106) - lu(659) * lu(1098) + lu(1108) = lu(1108) - lu(660) * lu(1098) + lu(1111) = lu(1111) - lu(661) * lu(1098) + lu(1112) = lu(1112) - lu(662) * lu(1098) + lu(1113) = - lu(663) * lu(1098) + lu(1115) = lu(1115) - lu(664) * lu(1098) + lu(1116) = lu(1116) - lu(665) * lu(1098) + lu(1118) = - lu(666) * lu(1098) + lu(1119) = lu(1119) - lu(667) * lu(1098) + lu(1120) = lu(1120) - lu(668) * lu(1098) + lu(1123) = - lu(669) * lu(1098) + lu(1124) = lu(1124) - lu(670) * lu(1098) + lu(1125) = lu(1125) - lu(671) * lu(1098) + lu(1127) = lu(1127) - lu(672) * lu(1098) + lu(1128) = lu(1128) - lu(673) * lu(1098) + lu(1228) = lu(1228) - lu(656) * lu(1226) + lu(1230) = lu(1230) - lu(657) * lu(1226) + lu(1233) = lu(1233) - lu(658) * lu(1226) + lu(1234) = lu(1234) - lu(659) * lu(1226) + lu(1236) = lu(1236) - lu(660) * lu(1226) + lu(1239) = lu(1239) - lu(661) * lu(1226) + lu(1240) = lu(1240) - lu(662) * lu(1226) + lu(1241) = lu(1241) - lu(663) * lu(1226) + lu(1243) = lu(1243) - lu(664) * lu(1226) + lu(1244) = lu(1244) - lu(665) * lu(1226) + lu(1246) = lu(1246) - lu(666) * lu(1226) + lu(1247) = lu(1247) - lu(667) * lu(1226) + lu(1248) = lu(1248) - lu(668) * lu(1226) + lu(1251) = lu(1251) - lu(669) * lu(1226) + lu(1252) = lu(1252) - lu(670) * lu(1226) + lu(1253) = lu(1253) - lu(671) * lu(1226) + lu(1255) = lu(1255) - lu(672) * lu(1226) + lu(1256) = lu(1256) - lu(673) * lu(1226) + lu(1264) = lu(1264) - lu(656) * lu(1263) + lu(1266) = lu(1266) - lu(657) * lu(1263) + lu(1269) = - lu(658) * lu(1263) + lu(1270) = lu(1270) - lu(659) * lu(1263) + lu(1272) = lu(1272) - lu(660) * lu(1263) + lu(1275) = lu(1275) - lu(661) * lu(1263) + lu(1276) = lu(1276) - lu(662) * lu(1263) + lu(1277) = - lu(663) * lu(1263) + lu(1279) = lu(1279) - lu(664) * lu(1263) + lu(1280) = lu(1280) - lu(665) * lu(1263) + lu(1282) = - lu(666) * lu(1263) + lu(1283) = lu(1283) - lu(667) * lu(1263) + lu(1284) = lu(1284) - lu(668) * lu(1263) + lu(1287) = - lu(669) * lu(1263) + lu(1288) = lu(1288) - lu(670) * lu(1263) + lu(1289) = lu(1289) - lu(671) * lu(1263) + lu(1291) = lu(1291) - lu(672) * lu(1263) + lu(1292) = - lu(673) * lu(1263) + lu(1323) = lu(1323) - lu(656) * lu(1322) + lu(1325) = lu(1325) - lu(657) * lu(1322) + lu(1328) = lu(1328) - lu(658) * lu(1322) + lu(1329) = lu(1329) - lu(659) * lu(1322) + lu(1331) = lu(1331) - lu(660) * lu(1322) + lu(1334) = lu(1334) - lu(661) * lu(1322) + lu(1335) = lu(1335) - lu(662) * lu(1322) + lu(1336) = lu(1336) - lu(663) * lu(1322) + lu(1338) = lu(1338) - lu(664) * lu(1322) + lu(1339) = lu(1339) - lu(665) * lu(1322) + lu(1341) = lu(1341) - lu(666) * lu(1322) + lu(1342) = lu(1342) - lu(667) * lu(1322) + lu(1343) = lu(1343) - lu(668) * lu(1322) + lu(1346) = lu(1346) - lu(669) * lu(1322) + lu(1347) = lu(1347) - lu(670) * lu(1322) + lu(1348) = lu(1348) - lu(671) * lu(1322) + lu(1350) = lu(1350) - lu(672) * lu(1322) + lu(1351) = lu(1351) - lu(673) * lu(1322) + lu(1366) = lu(1366) - lu(656) * lu(1364) + lu(1368) = lu(1368) - lu(657) * lu(1364) + lu(1371) = lu(1371) - lu(658) * lu(1364) + lu(1372) = lu(1372) - lu(659) * lu(1364) + lu(1374) = lu(1374) - lu(660) * lu(1364) + lu(1377) = lu(1377) - lu(661) * lu(1364) + lu(1378) = lu(1378) - lu(662) * lu(1364) + lu(1379) = lu(1379) - lu(663) * lu(1364) + lu(1381) = lu(1381) - lu(664) * lu(1364) + lu(1382) = lu(1382) - lu(665) * lu(1364) + lu(1384) = lu(1384) - lu(666) * lu(1364) + lu(1385) = lu(1385) - lu(667) * lu(1364) + lu(1386) = lu(1386) - lu(668) * lu(1364) + lu(1389) = lu(1389) - lu(669) * lu(1364) + lu(1390) = lu(1390) - lu(670) * lu(1364) + lu(1391) = lu(1391) - lu(671) * lu(1364) + lu(1393) = lu(1393) - lu(672) * lu(1364) + lu(1394) = lu(1394) - lu(673) * lu(1364) + lu(1450) = lu(1450) - lu(656) * lu(1448) + lu(1452) = lu(1452) - lu(657) * lu(1448) + lu(1455) = lu(1455) - lu(658) * lu(1448) + lu(1456) = lu(1456) - lu(659) * lu(1448) + lu(1458) = lu(1458) - lu(660) * lu(1448) + lu(1461) = lu(1461) - lu(661) * lu(1448) + lu(1462) = lu(1462) - lu(662) * lu(1448) + lu(1463) = lu(1463) - lu(663) * lu(1448) + lu(1465) = lu(1465) - lu(664) * lu(1448) + lu(1466) = lu(1466) - lu(665) * lu(1448) + lu(1468) = lu(1468) - lu(666) * lu(1448) + lu(1469) = lu(1469) - lu(667) * lu(1448) + lu(1470) = lu(1470) - lu(668) * lu(1448) + lu(1473) = lu(1473) - lu(669) * lu(1448) + lu(1474) = lu(1474) - lu(670) * lu(1448) + lu(1475) = lu(1475) - lu(671) * lu(1448) + lu(1477) = lu(1477) - lu(672) * lu(1448) + lu(1478) = lu(1478) - lu(673) * lu(1448) + lu(1493) = lu(1493) - lu(656) * lu(1492) + lu(1495) = lu(1495) - lu(657) * lu(1492) + lu(1498) = lu(1498) - lu(658) * lu(1492) + lu(1499) = lu(1499) - lu(659) * lu(1492) + lu(1501) = lu(1501) - lu(660) * lu(1492) + lu(1504) = lu(1504) - lu(661) * lu(1492) + lu(1505) = lu(1505) - lu(662) * lu(1492) + lu(1506) = lu(1506) - lu(663) * lu(1492) + lu(1508) = lu(1508) - lu(664) * lu(1492) + lu(1509) = lu(1509) - lu(665) * lu(1492) + lu(1511) = lu(1511) - lu(666) * lu(1492) + lu(1512) = lu(1512) - lu(667) * lu(1492) + lu(1513) = lu(1513) - lu(668) * lu(1492) + lu(1516) = lu(1516) - lu(669) * lu(1492) + lu(1517) = lu(1517) - lu(670) * lu(1492) + lu(1518) = lu(1518) - lu(671) * lu(1492) + lu(1520) = lu(1520) - lu(672) * lu(1492) + lu(1521) = lu(1521) - lu(673) * lu(1492) + lu(1539) = lu(1539) - lu(656) * lu(1538) + lu(1541) = lu(1541) - lu(657) * lu(1538) + lu(1544) = lu(1544) - lu(658) * lu(1538) + lu(1545) = lu(1545) - lu(659) * lu(1538) + lu(1547) = lu(1547) - lu(660) * lu(1538) + lu(1550) = lu(1550) - lu(661) * lu(1538) + lu(1551) = lu(1551) - lu(662) * lu(1538) + lu(1552) = lu(1552) - lu(663) * lu(1538) + lu(1554) = lu(1554) - lu(664) * lu(1538) + lu(1555) = lu(1555) - lu(665) * lu(1538) + lu(1557) = lu(1557) - lu(666) * lu(1538) + lu(1558) = lu(1558) - lu(667) * lu(1538) + lu(1559) = lu(1559) - lu(668) * lu(1538) + lu(1562) = lu(1562) - lu(669) * lu(1538) + lu(1563) = lu(1563) - lu(670) * lu(1538) + lu(1564) = lu(1564) - lu(671) * lu(1538) + lu(1566) = lu(1566) - lu(672) * lu(1538) + lu(1567) = lu(1567) - lu(673) * lu(1538) + lu(1585) = - lu(656) * lu(1583) + lu(1587) = lu(1587) - lu(657) * lu(1583) + lu(1590) = - lu(658) * lu(1583) + lu(1591) = lu(1591) - lu(659) * lu(1583) + lu(1593) = lu(1593) - lu(660) * lu(1583) + lu(1596) = lu(1596) - lu(661) * lu(1583) + lu(1597) = lu(1597) - lu(662) * lu(1583) + lu(1598) = - lu(663) * lu(1583) + lu(1600) = lu(1600) - lu(664) * lu(1583) + lu(1601) = lu(1601) - lu(665) * lu(1583) + lu(1603) = - lu(666) * lu(1583) + lu(1604) = lu(1604) - lu(667) * lu(1583) + lu(1605) = lu(1605) - lu(668) * lu(1583) + lu(1608) = - lu(669) * lu(1583) + lu(1609) = lu(1609) - lu(670) * lu(1583) + lu(1610) = lu(1610) - lu(671) * lu(1583) + lu(1612) = lu(1612) - lu(672) * lu(1583) + lu(1613) = - lu(673) * lu(1583) + lu(1669) = lu(1669) - lu(656) * lu(1667) + lu(1671) = lu(1671) - lu(657) * lu(1667) + lu(1674) = lu(1674) - lu(658) * lu(1667) + lu(1675) = lu(1675) - lu(659) * lu(1667) + lu(1677) = lu(1677) - lu(660) * lu(1667) + lu(1680) = lu(1680) - lu(661) * lu(1667) + lu(1681) = lu(1681) - lu(662) * lu(1667) + lu(1682) = lu(1682) - lu(663) * lu(1667) + lu(1684) = lu(1684) - lu(664) * lu(1667) + lu(1685) = lu(1685) - lu(665) * lu(1667) + lu(1687) = lu(1687) - lu(666) * lu(1667) + lu(1688) = lu(1688) - lu(667) * lu(1667) + lu(1689) = lu(1689) - lu(668) * lu(1667) + lu(1692) = lu(1692) - lu(669) * lu(1667) + lu(1693) = lu(1693) - lu(670) * lu(1667) + lu(1694) = lu(1694) - lu(671) * lu(1667) + lu(1696) = lu(1696) - lu(672) * lu(1667) + lu(1697) = lu(1697) - lu(673) * lu(1667) + lu(1709) = lu(1709) - lu(656) * lu(1708) + lu(1711) = lu(1711) - lu(657) * lu(1708) + lu(1714) = lu(1714) - lu(658) * lu(1708) + lu(1715) = lu(1715) - lu(659) * lu(1708) + lu(1717) = lu(1717) - lu(660) * lu(1708) + lu(1720) = lu(1720) - lu(661) * lu(1708) + lu(1721) = lu(1721) - lu(662) * lu(1708) + lu(1722) = lu(1722) - lu(663) * lu(1708) + lu(1724) = lu(1724) - lu(664) * lu(1708) + lu(1725) = lu(1725) - lu(665) * lu(1708) + lu(1727) = lu(1727) - lu(666) * lu(1708) + lu(1728) = lu(1728) - lu(667) * lu(1708) + lu(1729) = lu(1729) - lu(668) * lu(1708) + lu(1732) = lu(1732) - lu(669) * lu(1708) + lu(1733) = lu(1733) - lu(670) * lu(1708) + lu(1734) = lu(1734) - lu(671) * lu(1708) + lu(1736) = lu(1736) - lu(672) * lu(1708) + lu(1737) = lu(1737) - lu(673) * lu(1708) + lu(1755) = lu(1755) - lu(656) * lu(1753) + lu(1757) = lu(1757) - lu(657) * lu(1753) + lu(1760) = lu(1760) - lu(658) * lu(1753) + lu(1761) = lu(1761) - lu(659) * lu(1753) + lu(1763) = lu(1763) - lu(660) * lu(1753) + lu(1766) = lu(1766) - lu(661) * lu(1753) + lu(1767) = lu(1767) - lu(662) * lu(1753) + lu(1768) = lu(1768) - lu(663) * lu(1753) + lu(1770) = lu(1770) - lu(664) * lu(1753) + lu(1771) = lu(1771) - lu(665) * lu(1753) + lu(1773) = lu(1773) - lu(666) * lu(1753) + lu(1774) = lu(1774) - lu(667) * lu(1753) + lu(1775) = lu(1775) - lu(668) * lu(1753) + lu(1778) = lu(1778) - lu(669) * lu(1753) + lu(1779) = lu(1779) - lu(670) * lu(1753) + lu(1780) = lu(1780) - lu(671) * lu(1753) + lu(1782) = lu(1782) - lu(672) * lu(1753) + lu(1783) = lu(1783) - lu(673) * lu(1753) + lu(1791) = lu(1791) - lu(656) * lu(1789) + lu(1793) = lu(1793) - lu(657) * lu(1789) + lu(1796) = lu(1796) - lu(658) * lu(1789) + lu(1797) = lu(1797) - lu(659) * lu(1789) + lu(1799) = lu(1799) - lu(660) * lu(1789) + lu(1802) = lu(1802) - lu(661) * lu(1789) + lu(1803) = lu(1803) - lu(662) * lu(1789) + lu(1804) = lu(1804) - lu(663) * lu(1789) + lu(1806) = lu(1806) - lu(664) * lu(1789) + lu(1807) = lu(1807) - lu(665) * lu(1789) + lu(1809) = lu(1809) - lu(666) * lu(1789) + lu(1810) = lu(1810) - lu(667) * lu(1789) + lu(1811) = lu(1811) - lu(668) * lu(1789) + lu(1814) = lu(1814) - lu(669) * lu(1789) + lu(1815) = lu(1815) - lu(670) * lu(1789) + lu(1816) = lu(1816) - lu(671) * lu(1789) + lu(1818) = lu(1818) - lu(672) * lu(1789) + lu(1819) = lu(1819) - lu(673) * lu(1789) + lu(1833) = - lu(656) * lu(1831) + lu(1835) = lu(1835) - lu(657) * lu(1831) + lu(1838) = - lu(658) * lu(1831) + lu(1839) = lu(1839) - lu(659) * lu(1831) + lu(1841) = lu(1841) - lu(660) * lu(1831) + lu(1844) = lu(1844) - lu(661) * lu(1831) + lu(1845) = lu(1845) - lu(662) * lu(1831) + lu(1846) = - lu(663) * lu(1831) + lu(1848) = lu(1848) - lu(664) * lu(1831) + lu(1849) = lu(1849) - lu(665) * lu(1831) + lu(1851) = - lu(666) * lu(1831) + lu(1852) = lu(1852) - lu(667) * lu(1831) + lu(1853) = lu(1853) - lu(668) * lu(1831) + lu(1856) = - lu(669) * lu(1831) + lu(1857) = lu(1857) - lu(670) * lu(1831) + lu(1858) = lu(1858) - lu(671) * lu(1831) + lu(1860) = lu(1860) - lu(672) * lu(1831) + lu(1861) = - lu(673) * lu(1831) + lu(1879) = lu(1879) - lu(656) * lu(1877) + lu(1881) = lu(1881) - lu(657) * lu(1877) + lu(1884) = lu(1884) - lu(658) * lu(1877) + lu(1885) = lu(1885) - lu(659) * lu(1877) + lu(1887) = lu(1887) - lu(660) * lu(1877) + lu(1890) = lu(1890) - lu(661) * lu(1877) + lu(1891) = lu(1891) - lu(662) * lu(1877) + lu(1892) = lu(1892) - lu(663) * lu(1877) + lu(1894) = lu(1894) - lu(664) * lu(1877) + lu(1895) = lu(1895) - lu(665) * lu(1877) + lu(1897) = lu(1897) - lu(666) * lu(1877) + lu(1898) = lu(1898) - lu(667) * lu(1877) + lu(1899) = lu(1899) - lu(668) * lu(1877) + lu(1902) = lu(1902) - lu(669) * lu(1877) + lu(1903) = lu(1903) - lu(670) * lu(1877) + lu(1904) = lu(1904) - lu(671) * lu(1877) + lu(1906) = lu(1906) - lu(672) * lu(1877) + lu(1907) = lu(1907) - lu(673) * lu(1877) + lu(677) = 1._r8 / lu(677) + lu(678) = lu(678) * lu(677) + lu(679) = lu(679) * lu(677) + lu(680) = lu(680) * lu(677) + lu(681) = lu(681) * lu(677) + lu(682) = lu(682) * lu(677) + lu(683) = lu(683) * lu(677) + lu(684) = lu(684) * lu(677) + lu(685) = lu(685) * lu(677) + lu(686) = lu(686) * lu(677) + lu(687) = lu(687) * lu(677) + lu(688) = lu(688) * lu(677) + lu(689) = lu(689) * lu(677) + lu(690) = lu(690) * lu(677) + lu(691) = lu(691) * lu(677) + lu(692) = lu(692) * lu(677) + lu(693) = lu(693) * lu(677) + lu(694) = lu(694) * lu(677) + lu(695) = lu(695) * lu(677) + lu(696) = lu(696) * lu(677) + lu(697) = lu(697) * lu(677) + lu(698) = lu(698) * lu(677) + lu(699) = lu(699) * lu(677) + lu(700) = lu(700) * lu(677) + lu(701) = lu(701) * lu(677) + lu(702) = lu(702) * lu(677) + lu(703) = lu(703) * lu(677) + lu(704) = lu(704) * lu(677) + lu(705) = lu(705) * lu(677) + lu(888) = lu(888) - lu(678) * lu(887) + lu(889) = - lu(679) * lu(887) + lu(890) = lu(890) - lu(680) * lu(887) + lu(891) = lu(891) - lu(681) * lu(887) + lu(892) = lu(892) - lu(682) * lu(887) + lu(893) = lu(893) - lu(683) * lu(887) + lu(894) = lu(894) - lu(684) * lu(887) + lu(895) = - lu(685) * lu(887) + lu(896) = lu(896) - lu(686) * lu(887) + lu(897) = - lu(687) * lu(887) + lu(898) = lu(898) - lu(688) * lu(887) + lu(899) = lu(899) - lu(689) * lu(887) + lu(900) = lu(900) - lu(690) * lu(887) + lu(901) = lu(901) - lu(691) * lu(887) + lu(902) = - lu(692) * lu(887) + lu(903) = lu(903) - lu(693) * lu(887) + lu(904) = lu(904) - lu(694) * lu(887) + lu(905) = lu(905) - lu(695) * lu(887) + lu(906) = lu(906) - lu(696) * lu(887) + lu(907) = lu(907) - lu(697) * lu(887) + lu(908) = lu(908) - lu(698) * lu(887) + lu(909) = - lu(699) * lu(887) + lu(911) = lu(911) - lu(700) * lu(887) + lu(912) = lu(912) - lu(701) * lu(887) + lu(913) = lu(913) - lu(702) * lu(887) + lu(914) = lu(914) - lu(703) * lu(887) + lu(915) = lu(915) - lu(704) * lu(887) + lu(916) = lu(916) - lu(705) * lu(887) + lu(925) = lu(925) - lu(678) * lu(924) + lu(926) = lu(926) - lu(679) * lu(924) + lu(927) = lu(927) - lu(680) * lu(924) + lu(928) = lu(928) - lu(681) * lu(924) + lu(929) = lu(929) - lu(682) * lu(924) + lu(930) = lu(930) - lu(683) * lu(924) + lu(931) = lu(931) - lu(684) * lu(924) + lu(932) = lu(932) - lu(685) * lu(924) + lu(933) = lu(933) - lu(686) * lu(924) + lu(934) = lu(934) - lu(687) * lu(924) + lu(935) = lu(935) - lu(688) * lu(924) + lu(936) = lu(936) - lu(689) * lu(924) + lu(937) = lu(937) - lu(690) * lu(924) + lu(938) = lu(938) - lu(691) * lu(924) + lu(939) = lu(939) - lu(692) * lu(924) + lu(940) = lu(940) - lu(693) * lu(924) + lu(941) = lu(941) - lu(694) * lu(924) + lu(942) = lu(942) - lu(695) * lu(924) + lu(943) = lu(943) - lu(696) * lu(924) + lu(944) = lu(944) - lu(697) * lu(924) + lu(945) = lu(945) - lu(698) * lu(924) + lu(946) = lu(946) - lu(699) * lu(924) + lu(948) = lu(948) - lu(700) * lu(924) + lu(949) = lu(949) - lu(701) * lu(924) + lu(950) = lu(950) - lu(702) * lu(924) + lu(951) = lu(951) - lu(703) * lu(924) + lu(952) = lu(952) - lu(704) * lu(924) + lu(953) = lu(953) - lu(705) * lu(924) + lu(1002) = lu(1002) - lu(678) * lu(1001) + lu(1003) = lu(1003) - lu(679) * lu(1001) + lu(1004) = lu(1004) - lu(680) * lu(1001) + lu(1005) = lu(1005) - lu(681) * lu(1001) + lu(1006) = - lu(682) * lu(1001) + lu(1007) = lu(1007) - lu(683) * lu(1001) + lu(1008) = lu(1008) - lu(684) * lu(1001) + lu(1009) = lu(1009) - lu(685) * lu(1001) + lu(1010) = lu(1010) - lu(686) * lu(1001) + lu(1011) = lu(1011) - lu(687) * lu(1001) + lu(1012) = lu(1012) - lu(688) * lu(1001) + lu(1013) = lu(1013) - lu(689) * lu(1001) + lu(1014) = lu(1014) - lu(690) * lu(1001) + lu(1015) = lu(1015) - lu(691) * lu(1001) + lu(1016) = lu(1016) - lu(692) * lu(1001) + lu(1017) = lu(1017) - lu(693) * lu(1001) + lu(1018) = lu(1018) - lu(694) * lu(1001) + lu(1019) = lu(1019) - lu(695) * lu(1001) + lu(1020) = lu(1020) - lu(696) * lu(1001) + lu(1021) = lu(1021) - lu(697) * lu(1001) + lu(1022) = lu(1022) - lu(698) * lu(1001) + lu(1023) = lu(1023) - lu(699) * lu(1001) + lu(1025) = lu(1025) - lu(700) * lu(1001) + lu(1026) = lu(1026) - lu(701) * lu(1001) + lu(1027) = lu(1027) - lu(702) * lu(1001) + lu(1028) = lu(1028) - lu(703) * lu(1001) + lu(1029) = lu(1029) - lu(704) * lu(1001) + lu(1030) = lu(1030) - lu(705) * lu(1001) + lu(1042) = lu(1042) - lu(678) * lu(1041) + lu(1043) = lu(1043) - lu(679) * lu(1041) + lu(1044) = lu(1044) - lu(680) * lu(1041) + lu(1045) = lu(1045) - lu(681) * lu(1041) + lu(1046) = lu(1046) - lu(682) * lu(1041) + lu(1047) = - lu(683) * lu(1041) + lu(1048) = lu(1048) - lu(684) * lu(1041) + lu(1049) = lu(1049) - lu(685) * lu(1041) + lu(1050) = lu(1050) - lu(686) * lu(1041) + lu(1051) = lu(1051) - lu(687) * lu(1041) + lu(1052) = lu(1052) - lu(688) * lu(1041) + lu(1053) = lu(1053) - lu(689) * lu(1041) + lu(1054) = lu(1054) - lu(690) * lu(1041) + lu(1055) = - lu(691) * lu(1041) + lu(1056) = lu(1056) - lu(692) * lu(1041) + lu(1057) = lu(1057) - lu(693) * lu(1041) + lu(1058) = lu(1058) - lu(694) * lu(1041) + lu(1059) = lu(1059) - lu(695) * lu(1041) + lu(1060) = - lu(696) * lu(1041) + lu(1061) = lu(1061) - lu(697) * lu(1041) + lu(1062) = lu(1062) - lu(698) * lu(1041) + lu(1063) = lu(1063) - lu(699) * lu(1041) + lu(1065) = - lu(700) * lu(1041) + lu(1066) = lu(1066) - lu(701) * lu(1041) + lu(1067) = lu(1067) - lu(702) * lu(1041) + lu(1068) = lu(1068) - lu(703) * lu(1041) + lu(1069) = lu(1069) - lu(704) * lu(1041) + lu(1070) = - lu(705) * lu(1041) + lu(1100) = lu(1100) - lu(678) * lu(1099) + lu(1101) = lu(1101) - lu(679) * lu(1099) + lu(1102) = lu(1102) - lu(680) * lu(1099) + lu(1103) = lu(1103) - lu(681) * lu(1099) + lu(1104) = lu(1104) - lu(682) * lu(1099) + lu(1105) = lu(1105) - lu(683) * lu(1099) + lu(1106) = lu(1106) - lu(684) * lu(1099) + lu(1107) = lu(1107) - lu(685) * lu(1099) + lu(1108) = lu(1108) - lu(686) * lu(1099) + lu(1109) = lu(1109) - lu(687) * lu(1099) + lu(1110) = lu(1110) - lu(688) * lu(1099) + lu(1111) = lu(1111) - lu(689) * lu(1099) + lu(1112) = lu(1112) - lu(690) * lu(1099) + lu(1113) = lu(1113) - lu(691) * lu(1099) + lu(1114) = lu(1114) - lu(692) * lu(1099) + lu(1115) = lu(1115) - lu(693) * lu(1099) + lu(1116) = lu(1116) - lu(694) * lu(1099) + lu(1117) = lu(1117) - lu(695) * lu(1099) + lu(1118) = lu(1118) - lu(696) * lu(1099) + lu(1119) = lu(1119) - lu(697) * lu(1099) + lu(1120) = lu(1120) - lu(698) * lu(1099) + lu(1121) = lu(1121) - lu(699) * lu(1099) + lu(1123) = lu(1123) - lu(700) * lu(1099) + lu(1124) = lu(1124) - lu(701) * lu(1099) + lu(1125) = lu(1125) - lu(702) * lu(1099) + lu(1126) = lu(1126) - lu(703) * lu(1099) + lu(1127) = lu(1127) - lu(704) * lu(1099) + lu(1128) = lu(1128) - lu(705) * lu(1099) + lu(1186) = lu(1186) - lu(678) * lu(1185) + lu(1187) = lu(1187) - lu(679) * lu(1185) + lu(1188) = lu(1188) - lu(680) * lu(1185) + lu(1189) = lu(1189) - lu(681) * lu(1185) + lu(1190) = lu(1190) - lu(682) * lu(1185) + lu(1191) = - lu(683) * lu(1185) + lu(1192) = lu(1192) - lu(684) * lu(1185) + lu(1193) = lu(1193) - lu(685) * lu(1185) + lu(1194) = lu(1194) - lu(686) * lu(1185) + lu(1195) = lu(1195) - lu(687) * lu(1185) + lu(1196) = lu(1196) - lu(688) * lu(1185) + lu(1197) = lu(1197) - lu(689) * lu(1185) + lu(1198) = lu(1198) - lu(690) * lu(1185) + lu(1199) = - lu(691) * lu(1185) + lu(1200) = lu(1200) - lu(692) * lu(1185) + lu(1201) = lu(1201) - lu(693) * lu(1185) + lu(1202) = lu(1202) - lu(694) * lu(1185) + lu(1203) = lu(1203) - lu(695) * lu(1185) + lu(1204) = - lu(696) * lu(1185) + lu(1205) = lu(1205) - lu(697) * lu(1185) + lu(1206) = lu(1206) - lu(698) * lu(1185) + lu(1207) = lu(1207) - lu(699) * lu(1185) + lu(1209) = - lu(700) * lu(1185) + lu(1210) = lu(1210) - lu(701) * lu(1185) + lu(1211) = lu(1211) - lu(702) * lu(1185) + lu(1212) = lu(1212) - lu(703) * lu(1185) + lu(1213) = lu(1213) - lu(704) * lu(1185) + lu(1214) = lu(1214) - lu(705) * lu(1185) + lu(1228) = lu(1228) - lu(678) * lu(1227) + lu(1229) = lu(1229) - lu(679) * lu(1227) + lu(1230) = lu(1230) - lu(680) * lu(1227) + lu(1231) = lu(1231) - lu(681) * lu(1227) + lu(1232) = lu(1232) - lu(682) * lu(1227) + lu(1233) = lu(1233) - lu(683) * lu(1227) + lu(1234) = lu(1234) - lu(684) * lu(1227) + lu(1235) = - lu(685) * lu(1227) + lu(1236) = lu(1236) - lu(686) * lu(1227) + lu(1237) = - lu(687) * lu(1227) + lu(1238) = lu(1238) - lu(688) * lu(1227) + lu(1239) = lu(1239) - lu(689) * lu(1227) + lu(1240) = lu(1240) - lu(690) * lu(1227) + lu(1241) = lu(1241) - lu(691) * lu(1227) + lu(1242) = - lu(692) * lu(1227) + lu(1243) = lu(1243) - lu(693) * lu(1227) + lu(1244) = lu(1244) - lu(694) * lu(1227) + lu(1245) = lu(1245) - lu(695) * lu(1227) + lu(1246) = lu(1246) - lu(696) * lu(1227) + lu(1247) = lu(1247) - lu(697) * lu(1227) + lu(1248) = lu(1248) - lu(698) * lu(1227) + lu(1249) = - lu(699) * lu(1227) + lu(1251) = lu(1251) - lu(700) * lu(1227) + lu(1252) = lu(1252) - lu(701) * lu(1227) + lu(1253) = lu(1253) - lu(702) * lu(1227) + lu(1254) = lu(1254) - lu(703) * lu(1227) + lu(1255) = lu(1255) - lu(704) * lu(1227) + lu(1256) = lu(1256) - lu(705) * lu(1227) + lu(1366) = lu(1366) - lu(678) * lu(1365) + lu(1367) = - lu(679) * lu(1365) + lu(1368) = lu(1368) - lu(680) * lu(1365) + lu(1369) = lu(1369) - lu(681) * lu(1365) + lu(1370) = lu(1370) - lu(682) * lu(1365) + lu(1371) = lu(1371) - lu(683) * lu(1365) + lu(1372) = lu(1372) - lu(684) * lu(1365) + lu(1373) = - lu(685) * lu(1365) + lu(1374) = lu(1374) - lu(686) * lu(1365) + lu(1375) = - lu(687) * lu(1365) + lu(1376) = lu(1376) - lu(688) * lu(1365) + lu(1377) = lu(1377) - lu(689) * lu(1365) + lu(1378) = lu(1378) - lu(690) * lu(1365) + lu(1379) = lu(1379) - lu(691) * lu(1365) + lu(1380) = - lu(692) * lu(1365) + lu(1381) = lu(1381) - lu(693) * lu(1365) + lu(1382) = lu(1382) - lu(694) * lu(1365) + lu(1383) = lu(1383) - lu(695) * lu(1365) + lu(1384) = lu(1384) - lu(696) * lu(1365) + lu(1385) = lu(1385) - lu(697) * lu(1365) + lu(1386) = lu(1386) - lu(698) * lu(1365) + lu(1387) = - lu(699) * lu(1365) + lu(1389) = lu(1389) - lu(700) * lu(1365) + lu(1390) = lu(1390) - lu(701) * lu(1365) + lu(1391) = lu(1391) - lu(702) * lu(1365) + lu(1392) = lu(1392) - lu(703) * lu(1365) + lu(1393) = lu(1393) - lu(704) * lu(1365) + lu(1394) = lu(1394) - lu(705) * lu(1365) + lu(1407) = lu(1407) - lu(678) * lu(1406) + lu(1408) = lu(1408) - lu(679) * lu(1406) + lu(1409) = lu(1409) - lu(680) * lu(1406) + lu(1410) = lu(1410) - lu(681) * lu(1406) + lu(1411) = lu(1411) - lu(682) * lu(1406) + lu(1412) = lu(1412) - lu(683) * lu(1406) + lu(1413) = lu(1413) - lu(684) * lu(1406) + lu(1414) = lu(1414) - lu(685) * lu(1406) + lu(1415) = - lu(686) * lu(1406) + lu(1416) = lu(1416) - lu(687) * lu(1406) + lu(1417) = lu(1417) - lu(688) * lu(1406) + lu(1418) = lu(1418) - lu(689) * lu(1406) + lu(1419) = lu(1419) - lu(690) * lu(1406) + lu(1420) = lu(1420) - lu(691) * lu(1406) + lu(1421) = lu(1421) - lu(692) * lu(1406) + lu(1422) = lu(1422) - lu(693) * lu(1406) + lu(1423) = lu(1423) - lu(694) * lu(1406) + lu(1424) = lu(1424) - lu(695) * lu(1406) + lu(1425) = lu(1425) - lu(696) * lu(1406) + lu(1426) = lu(1426) - lu(697) * lu(1406) + lu(1427) = lu(1427) - lu(698) * lu(1406) + lu(1428) = - lu(699) * lu(1406) + lu(1430) = lu(1430) - lu(700) * lu(1406) + lu(1431) = - lu(701) * lu(1406) + lu(1432) = lu(1432) - lu(702) * lu(1406) + lu(1433) = lu(1433) - lu(703) * lu(1406) + lu(1434) = - lu(704) * lu(1406) + lu(1435) = lu(1435) - lu(705) * lu(1406) + lu(1450) = lu(1450) - lu(678) * lu(1449) + lu(1451) = - lu(679) * lu(1449) + lu(1452) = lu(1452) - lu(680) * lu(1449) + lu(1453) = lu(1453) - lu(681) * lu(1449) + lu(1454) = lu(1454) - lu(682) * lu(1449) + lu(1455) = lu(1455) - lu(683) * lu(1449) + lu(1456) = lu(1456) - lu(684) * lu(1449) + lu(1457) = - lu(685) * lu(1449) + lu(1458) = lu(1458) - lu(686) * lu(1449) + lu(1459) = - lu(687) * lu(1449) + lu(1460) = lu(1460) - lu(688) * lu(1449) + lu(1461) = lu(1461) - lu(689) * lu(1449) + lu(1462) = lu(1462) - lu(690) * lu(1449) + lu(1463) = lu(1463) - lu(691) * lu(1449) + lu(1464) = - lu(692) * lu(1449) + lu(1465) = lu(1465) - lu(693) * lu(1449) + lu(1466) = lu(1466) - lu(694) * lu(1449) + lu(1467) = lu(1467) - lu(695) * lu(1449) + lu(1468) = lu(1468) - lu(696) * lu(1449) + lu(1469) = lu(1469) - lu(697) * lu(1449) + lu(1470) = lu(1470) - lu(698) * lu(1449) + lu(1471) = - lu(699) * lu(1449) + lu(1473) = lu(1473) - lu(700) * lu(1449) + lu(1474) = lu(1474) - lu(701) * lu(1449) + lu(1475) = lu(1475) - lu(702) * lu(1449) + lu(1476) = lu(1476) - lu(703) * lu(1449) + lu(1477) = lu(1477) - lu(704) * lu(1449) + lu(1478) = lu(1478) - lu(705) * lu(1449) + lu(1585) = lu(1585) - lu(678) * lu(1584) + lu(1586) = lu(1586) - lu(679) * lu(1584) + lu(1587) = lu(1587) - lu(680) * lu(1584) + lu(1588) = lu(1588) - lu(681) * lu(1584) + lu(1589) = lu(1589) - lu(682) * lu(1584) + lu(1590) = lu(1590) - lu(683) * lu(1584) + lu(1591) = lu(1591) - lu(684) * lu(1584) + lu(1592) = lu(1592) - lu(685) * lu(1584) + lu(1593) = lu(1593) - lu(686) * lu(1584) + lu(1594) = lu(1594) - lu(687) * lu(1584) + lu(1595) = lu(1595) - lu(688) * lu(1584) + lu(1596) = lu(1596) - lu(689) * lu(1584) + lu(1597) = lu(1597) - lu(690) * lu(1584) + lu(1598) = lu(1598) - lu(691) * lu(1584) + lu(1599) = lu(1599) - lu(692) * lu(1584) + lu(1600) = lu(1600) - lu(693) * lu(1584) + lu(1601) = lu(1601) - lu(694) * lu(1584) + lu(1602) = lu(1602) - lu(695) * lu(1584) + lu(1603) = lu(1603) - lu(696) * lu(1584) + lu(1604) = lu(1604) - lu(697) * lu(1584) + lu(1605) = lu(1605) - lu(698) * lu(1584) + lu(1606) = lu(1606) - lu(699) * lu(1584) + lu(1608) = lu(1608) - lu(700) * lu(1584) + lu(1609) = lu(1609) - lu(701) * lu(1584) + lu(1610) = lu(1610) - lu(702) * lu(1584) + lu(1611) = lu(1611) - lu(703) * lu(1584) + lu(1612) = lu(1612) - lu(704) * lu(1584) + lu(1613) = lu(1613) - lu(705) * lu(1584) + lu(1669) = lu(1669) - lu(678) * lu(1668) + lu(1670) = - lu(679) * lu(1668) + lu(1671) = lu(1671) - lu(680) * lu(1668) + lu(1672) = lu(1672) - lu(681) * lu(1668) + lu(1673) = lu(1673) - lu(682) * lu(1668) + lu(1674) = lu(1674) - lu(683) * lu(1668) + lu(1675) = lu(1675) - lu(684) * lu(1668) + lu(1676) = - lu(685) * lu(1668) + lu(1677) = lu(1677) - lu(686) * lu(1668) + lu(1678) = - lu(687) * lu(1668) + lu(1679) = lu(1679) - lu(688) * lu(1668) + lu(1680) = lu(1680) - lu(689) * lu(1668) + lu(1681) = lu(1681) - lu(690) * lu(1668) + lu(1682) = lu(1682) - lu(691) * lu(1668) + lu(1683) = - lu(692) * lu(1668) + lu(1684) = lu(1684) - lu(693) * lu(1668) + lu(1685) = lu(1685) - lu(694) * lu(1668) + lu(1686) = lu(1686) - lu(695) * lu(1668) + lu(1687) = lu(1687) - lu(696) * lu(1668) + lu(1688) = lu(1688) - lu(697) * lu(1668) + lu(1689) = lu(1689) - lu(698) * lu(1668) + lu(1690) = - lu(699) * lu(1668) + lu(1692) = lu(1692) - lu(700) * lu(1668) + lu(1693) = lu(1693) - lu(701) * lu(1668) + lu(1694) = lu(1694) - lu(702) * lu(1668) + lu(1695) = lu(1695) - lu(703) * lu(1668) + lu(1696) = lu(1696) - lu(704) * lu(1668) + lu(1697) = lu(1697) - lu(705) * lu(1668) + lu(1755) = lu(1755) - lu(678) * lu(1754) + lu(1756) = lu(1756) - lu(679) * lu(1754) + lu(1757) = lu(1757) - lu(680) * lu(1754) + lu(1758) = lu(1758) - lu(681) * lu(1754) + lu(1759) = lu(1759) - lu(682) * lu(1754) + lu(1760) = lu(1760) - lu(683) * lu(1754) + lu(1761) = lu(1761) - lu(684) * lu(1754) + lu(1762) = lu(1762) - lu(685) * lu(1754) + lu(1763) = lu(1763) - lu(686) * lu(1754) + lu(1764) = lu(1764) - lu(687) * lu(1754) + lu(1765) = lu(1765) - lu(688) * lu(1754) + lu(1766) = lu(1766) - lu(689) * lu(1754) + lu(1767) = lu(1767) - lu(690) * lu(1754) + lu(1768) = lu(1768) - lu(691) * lu(1754) + lu(1769) = lu(1769) - lu(692) * lu(1754) + lu(1770) = lu(1770) - lu(693) * lu(1754) + lu(1771) = lu(1771) - lu(694) * lu(1754) + lu(1772) = lu(1772) - lu(695) * lu(1754) + lu(1773) = lu(1773) - lu(696) * lu(1754) + lu(1774) = lu(1774) - lu(697) * lu(1754) + lu(1775) = lu(1775) - lu(698) * lu(1754) + lu(1776) = lu(1776) - lu(699) * lu(1754) + lu(1778) = lu(1778) - lu(700) * lu(1754) + lu(1779) = lu(1779) - lu(701) * lu(1754) + lu(1780) = lu(1780) - lu(702) * lu(1754) + lu(1781) = lu(1781) - lu(703) * lu(1754) + lu(1782) = lu(1782) - lu(704) * lu(1754) + lu(1783) = lu(1783) - lu(705) * lu(1754) + lu(1791) = lu(1791) - lu(678) * lu(1790) + lu(1792) = lu(1792) - lu(679) * lu(1790) + lu(1793) = lu(1793) - lu(680) * lu(1790) + lu(1794) = lu(1794) - lu(681) * lu(1790) + lu(1795) = lu(1795) - lu(682) * lu(1790) + lu(1796) = lu(1796) - lu(683) * lu(1790) + lu(1797) = lu(1797) - lu(684) * lu(1790) + lu(1798) = lu(1798) - lu(685) * lu(1790) + lu(1799) = lu(1799) - lu(686) * lu(1790) + lu(1800) = lu(1800) - lu(687) * lu(1790) + lu(1801) = lu(1801) - lu(688) * lu(1790) + lu(1802) = lu(1802) - lu(689) * lu(1790) + lu(1803) = lu(1803) - lu(690) * lu(1790) + lu(1804) = lu(1804) - lu(691) * lu(1790) + lu(1805) = lu(1805) - lu(692) * lu(1790) + lu(1806) = lu(1806) - lu(693) * lu(1790) + lu(1807) = lu(1807) - lu(694) * lu(1790) + lu(1808) = lu(1808) - lu(695) * lu(1790) + lu(1809) = lu(1809) - lu(696) * lu(1790) + lu(1810) = lu(1810) - lu(697) * lu(1790) + lu(1811) = lu(1811) - lu(698) * lu(1790) + lu(1812) = lu(1812) - lu(699) * lu(1790) + lu(1814) = lu(1814) - lu(700) * lu(1790) + lu(1815) = lu(1815) - lu(701) * lu(1790) + lu(1816) = lu(1816) - lu(702) * lu(1790) + lu(1817) = lu(1817) - lu(703) * lu(1790) + lu(1818) = lu(1818) - lu(704) * lu(1790) + lu(1819) = lu(1819) - lu(705) * lu(1790) + lu(1833) = lu(1833) - lu(678) * lu(1832) + lu(1834) = lu(1834) - lu(679) * lu(1832) + lu(1835) = lu(1835) - lu(680) * lu(1832) + lu(1836) = lu(1836) - lu(681) * lu(1832) + lu(1837) = lu(1837) - lu(682) * lu(1832) + lu(1838) = lu(1838) - lu(683) * lu(1832) + lu(1839) = lu(1839) - lu(684) * lu(1832) + lu(1840) = lu(1840) - lu(685) * lu(1832) + lu(1841) = lu(1841) - lu(686) * lu(1832) + lu(1842) = lu(1842) - lu(687) * lu(1832) + lu(1843) = lu(1843) - lu(688) * lu(1832) + lu(1844) = lu(1844) - lu(689) * lu(1832) + lu(1845) = lu(1845) - lu(690) * lu(1832) + lu(1846) = lu(1846) - lu(691) * lu(1832) + lu(1847) = lu(1847) - lu(692) * lu(1832) + lu(1848) = lu(1848) - lu(693) * lu(1832) + lu(1849) = lu(1849) - lu(694) * lu(1832) + lu(1850) = lu(1850) - lu(695) * lu(1832) + lu(1851) = lu(1851) - lu(696) * lu(1832) + lu(1852) = lu(1852) - lu(697) * lu(1832) + lu(1853) = lu(1853) - lu(698) * lu(1832) + lu(1854) = lu(1854) - lu(699) * lu(1832) + lu(1856) = lu(1856) - lu(700) * lu(1832) + lu(1857) = lu(1857) - lu(701) * lu(1832) + lu(1858) = lu(1858) - lu(702) * lu(1832) + lu(1859) = lu(1859) - lu(703) * lu(1832) + lu(1860) = lu(1860) - lu(704) * lu(1832) + lu(1861) = lu(1861) - lu(705) * lu(1832) + lu(1879) = lu(1879) - lu(678) * lu(1878) + lu(1880) = lu(1880) - lu(679) * lu(1878) + lu(1881) = lu(1881) - lu(680) * lu(1878) + lu(1882) = lu(1882) - lu(681) * lu(1878) + lu(1883) = lu(1883) - lu(682) * lu(1878) + lu(1884) = lu(1884) - lu(683) * lu(1878) + lu(1885) = lu(1885) - lu(684) * lu(1878) + lu(1886) = lu(1886) - lu(685) * lu(1878) + lu(1887) = lu(1887) - lu(686) * lu(1878) + lu(1888) = lu(1888) - lu(687) * lu(1878) + lu(1889) = lu(1889) - lu(688) * lu(1878) + lu(1890) = lu(1890) - lu(689) * lu(1878) + lu(1891) = lu(1891) - lu(690) * lu(1878) + lu(1892) = lu(1892) - lu(691) * lu(1878) + lu(1893) = lu(1893) - lu(692) * lu(1878) + lu(1894) = lu(1894) - lu(693) * lu(1878) + lu(1895) = lu(1895) - lu(694) * lu(1878) + lu(1896) = lu(1896) - lu(695) * lu(1878) + lu(1897) = lu(1897) - lu(696) * lu(1878) + lu(1898) = lu(1898) - lu(697) * lu(1878) + lu(1899) = lu(1899) - lu(698) * lu(1878) + lu(1900) = lu(1900) - lu(699) * lu(1878) + lu(1902) = lu(1902) - lu(700) * lu(1878) + lu(1903) = lu(1903) - lu(701) * lu(1878) + lu(1904) = lu(1904) - lu(702) * lu(1878) + lu(1905) = lu(1905) - lu(703) * lu(1878) + lu(1906) = lu(1906) - lu(704) * lu(1878) + lu(1907) = lu(1907) - lu(705) * lu(1878) + end subroutine lu_fac16 + subroutine lu_fac17( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(710) = 1._r8 / lu(710) + lu(711) = lu(711) * lu(710) + lu(712) = lu(712) * lu(710) + lu(713) = lu(713) * lu(710) + lu(714) = lu(714) * lu(710) + lu(715) = lu(715) * lu(710) + lu(716) = lu(716) * lu(710) + lu(717) = lu(717) * lu(710) + lu(718) = lu(718) * lu(710) + lu(719) = lu(719) * lu(710) + lu(720) = lu(720) * lu(710) + lu(721) = lu(721) * lu(710) + lu(722) = lu(722) * lu(710) + lu(723) = lu(723) * lu(710) + lu(724) = lu(724) * lu(710) + lu(725) = lu(725) * lu(710) + lu(726) = lu(726) * lu(710) + lu(727) = lu(727) * lu(710) + lu(728) = lu(728) * lu(710) + lu(729) = lu(729) * lu(710) + lu(730) = lu(730) * lu(710) + lu(770) = lu(770) - lu(711) * lu(769) + lu(772) = lu(772) - lu(712) * lu(769) + lu(773) = lu(773) - lu(713) * lu(769) + lu(775) = lu(775) - lu(714) * lu(769) + lu(776) = lu(776) - lu(715) * lu(769) + lu(777) = - lu(716) * lu(769) + lu(778) = lu(778) - lu(717) * lu(769) + lu(779) = lu(779) - lu(718) * lu(769) + lu(780) = lu(780) - lu(719) * lu(769) + lu(781) = lu(781) - lu(720) * lu(769) + lu(782) = lu(782) - lu(721) * lu(769) + lu(783) = lu(783) - lu(722) * lu(769) + lu(784) = lu(784) - lu(723) * lu(769) + lu(785) = lu(785) - lu(724) * lu(769) + lu(787) = lu(787) - lu(725) * lu(769) + lu(788) = lu(788) - lu(726) * lu(769) + lu(789) = lu(789) - lu(727) * lu(769) + lu(790) = lu(790) - lu(728) * lu(769) + lu(791) = lu(791) - lu(729) * lu(769) + lu(792) = lu(792) - lu(730) * lu(769) + lu(847) = lu(847) - lu(711) * lu(846) + lu(850) = lu(850) - lu(712) * lu(846) + lu(851) = lu(851) - lu(713) * lu(846) + lu(853) = lu(853) - lu(714) * lu(846) + lu(854) = lu(854) - lu(715) * lu(846) + lu(855) = lu(855) - lu(716) * lu(846) + lu(856) = lu(856) - lu(717) * lu(846) + lu(857) = lu(857) - lu(718) * lu(846) + lu(858) = lu(858) - lu(719) * lu(846) + lu(860) = lu(860) - lu(720) * lu(846) + lu(861) = lu(861) - lu(721) * lu(846) + lu(863) = lu(863) - lu(722) * lu(846) + lu(864) = lu(864) - lu(723) * lu(846) + lu(865) = lu(865) - lu(724) * lu(846) + lu(867) = lu(867) - lu(725) * lu(846) + lu(868) = lu(868) - lu(726) * lu(846) + lu(869) = lu(869) - lu(727) * lu(846) + lu(870) = lu(870) - lu(728) * lu(846) + lu(872) = lu(872) - lu(729) * lu(846) + lu(873) = lu(873) - lu(730) * lu(846) + lu(890) = lu(890) - lu(711) * lu(888) + lu(893) = lu(893) - lu(712) * lu(888) + lu(894) = lu(894) - lu(713) * lu(888) + lu(896) = lu(896) - lu(714) * lu(888) + lu(897) = lu(897) - lu(715) * lu(888) + lu(898) = lu(898) - lu(716) * lu(888) + lu(899) = lu(899) - lu(717) * lu(888) + lu(900) = lu(900) - lu(718) * lu(888) + lu(901) = lu(901) - lu(719) * lu(888) + lu(903) = lu(903) - lu(720) * lu(888) + lu(904) = lu(904) - lu(721) * lu(888) + lu(906) = lu(906) - lu(722) * lu(888) + lu(907) = lu(907) - lu(723) * lu(888) + lu(908) = lu(908) - lu(724) * lu(888) + lu(910) = lu(910) - lu(725) * lu(888) + lu(911) = lu(911) - lu(726) * lu(888) + lu(912) = lu(912) - lu(727) * lu(888) + lu(913) = lu(913) - lu(728) * lu(888) + lu(915) = lu(915) - lu(729) * lu(888) + lu(916) = lu(916) - lu(730) * lu(888) + lu(927) = lu(927) - lu(711) * lu(925) + lu(930) = lu(930) - lu(712) * lu(925) + lu(931) = lu(931) - lu(713) * lu(925) + lu(933) = lu(933) - lu(714) * lu(925) + lu(934) = lu(934) - lu(715) * lu(925) + lu(935) = lu(935) - lu(716) * lu(925) + lu(936) = lu(936) - lu(717) * lu(925) + lu(937) = lu(937) - lu(718) * lu(925) + lu(938) = lu(938) - lu(719) * lu(925) + lu(940) = lu(940) - lu(720) * lu(925) + lu(941) = lu(941) - lu(721) * lu(925) + lu(943) = lu(943) - lu(722) * lu(925) + lu(944) = lu(944) - lu(723) * lu(925) + lu(945) = lu(945) - lu(724) * lu(925) + lu(947) = lu(947) - lu(725) * lu(925) + lu(948) = lu(948) - lu(726) * lu(925) + lu(949) = lu(949) - lu(727) * lu(925) + lu(950) = lu(950) - lu(728) * lu(925) + lu(952) = lu(952) - lu(729) * lu(925) + lu(953) = lu(953) - lu(730) * lu(925) + lu(960) = lu(960) - lu(711) * lu(958) + lu(963) = lu(963) - lu(712) * lu(958) + lu(964) = lu(964) - lu(713) * lu(958) + lu(966) = lu(966) - lu(714) * lu(958) + lu(967) = lu(967) - lu(715) * lu(958) + lu(968) = lu(968) - lu(716) * lu(958) + lu(969) = lu(969) - lu(717) * lu(958) + lu(970) = lu(970) - lu(718) * lu(958) + lu(971) = lu(971) - lu(719) * lu(958) + lu(973) = lu(973) - lu(720) * lu(958) + lu(974) = lu(974) - lu(721) * lu(958) + lu(976) = lu(976) - lu(722) * lu(958) + lu(977) = lu(977) - lu(723) * lu(958) + lu(978) = lu(978) - lu(724) * lu(958) + lu(980) = - lu(725) * lu(958) + lu(981) = lu(981) - lu(726) * lu(958) + lu(982) = lu(982) - lu(727) * lu(958) + lu(983) = lu(983) - lu(728) * lu(958) + lu(985) = lu(985) - lu(729) * lu(958) + lu(986) = lu(986) - lu(730) * lu(958) + lu(1004) = lu(1004) - lu(711) * lu(1002) + lu(1007) = lu(1007) - lu(712) * lu(1002) + lu(1008) = lu(1008) - lu(713) * lu(1002) + lu(1010) = lu(1010) - lu(714) * lu(1002) + lu(1011) = lu(1011) - lu(715) * lu(1002) + lu(1012) = lu(1012) - lu(716) * lu(1002) + lu(1013) = lu(1013) - lu(717) * lu(1002) + lu(1014) = lu(1014) - lu(718) * lu(1002) + lu(1015) = lu(1015) - lu(719) * lu(1002) + lu(1017) = lu(1017) - lu(720) * lu(1002) + lu(1018) = lu(1018) - lu(721) * lu(1002) + lu(1020) = lu(1020) - lu(722) * lu(1002) + lu(1021) = lu(1021) - lu(723) * lu(1002) + lu(1022) = lu(1022) - lu(724) * lu(1002) + lu(1024) = lu(1024) - lu(725) * lu(1002) + lu(1025) = lu(1025) - lu(726) * lu(1002) + lu(1026) = lu(1026) - lu(727) * lu(1002) + lu(1027) = lu(1027) - lu(728) * lu(1002) + lu(1029) = lu(1029) - lu(729) * lu(1002) + lu(1030) = lu(1030) - lu(730) * lu(1002) + lu(1044) = lu(1044) - lu(711) * lu(1042) + lu(1047) = lu(1047) - lu(712) * lu(1042) + lu(1048) = lu(1048) - lu(713) * lu(1042) + lu(1050) = lu(1050) - lu(714) * lu(1042) + lu(1051) = lu(1051) - lu(715) * lu(1042) + lu(1052) = lu(1052) - lu(716) * lu(1042) + lu(1053) = lu(1053) - lu(717) * lu(1042) + lu(1054) = lu(1054) - lu(718) * lu(1042) + lu(1055) = lu(1055) - lu(719) * lu(1042) + lu(1057) = lu(1057) - lu(720) * lu(1042) + lu(1058) = lu(1058) - lu(721) * lu(1042) + lu(1060) = lu(1060) - lu(722) * lu(1042) + lu(1061) = lu(1061) - lu(723) * lu(1042) + lu(1062) = lu(1062) - lu(724) * lu(1042) + lu(1064) = lu(1064) - lu(725) * lu(1042) + lu(1065) = lu(1065) - lu(726) * lu(1042) + lu(1066) = lu(1066) - lu(727) * lu(1042) + lu(1067) = lu(1067) - lu(728) * lu(1042) + lu(1069) = lu(1069) - lu(729) * lu(1042) + lu(1070) = lu(1070) - lu(730) * lu(1042) + lu(1102) = lu(1102) - lu(711) * lu(1100) + lu(1105) = lu(1105) - lu(712) * lu(1100) + lu(1106) = lu(1106) - lu(713) * lu(1100) + lu(1108) = lu(1108) - lu(714) * lu(1100) + lu(1109) = lu(1109) - lu(715) * lu(1100) + lu(1110) = lu(1110) - lu(716) * lu(1100) + lu(1111) = lu(1111) - lu(717) * lu(1100) + lu(1112) = lu(1112) - lu(718) * lu(1100) + lu(1113) = lu(1113) - lu(719) * lu(1100) + lu(1115) = lu(1115) - lu(720) * lu(1100) + lu(1116) = lu(1116) - lu(721) * lu(1100) + lu(1118) = lu(1118) - lu(722) * lu(1100) + lu(1119) = lu(1119) - lu(723) * lu(1100) + lu(1120) = lu(1120) - lu(724) * lu(1100) + lu(1122) = lu(1122) - lu(725) * lu(1100) + lu(1123) = lu(1123) - lu(726) * lu(1100) + lu(1124) = lu(1124) - lu(727) * lu(1100) + lu(1125) = lu(1125) - lu(728) * lu(1100) + lu(1127) = lu(1127) - lu(729) * lu(1100) + lu(1128) = lu(1128) - lu(730) * lu(1100) + lu(1188) = lu(1188) - lu(711) * lu(1186) + lu(1191) = lu(1191) - lu(712) * lu(1186) + lu(1192) = lu(1192) - lu(713) * lu(1186) + lu(1194) = lu(1194) - lu(714) * lu(1186) + lu(1195) = lu(1195) - lu(715) * lu(1186) + lu(1196) = lu(1196) - lu(716) * lu(1186) + lu(1197) = lu(1197) - lu(717) * lu(1186) + lu(1198) = lu(1198) - lu(718) * lu(1186) + lu(1199) = lu(1199) - lu(719) * lu(1186) + lu(1201) = lu(1201) - lu(720) * lu(1186) + lu(1202) = lu(1202) - lu(721) * lu(1186) + lu(1204) = lu(1204) - lu(722) * lu(1186) + lu(1205) = lu(1205) - lu(723) * lu(1186) + lu(1206) = lu(1206) - lu(724) * lu(1186) + lu(1208) = lu(1208) - lu(725) * lu(1186) + lu(1209) = lu(1209) - lu(726) * lu(1186) + lu(1210) = lu(1210) - lu(727) * lu(1186) + lu(1211) = lu(1211) - lu(728) * lu(1186) + lu(1213) = lu(1213) - lu(729) * lu(1186) + lu(1214) = lu(1214) - lu(730) * lu(1186) + lu(1230) = lu(1230) - lu(711) * lu(1228) + lu(1233) = lu(1233) - lu(712) * lu(1228) + lu(1234) = lu(1234) - lu(713) * lu(1228) + lu(1236) = lu(1236) - lu(714) * lu(1228) + lu(1237) = lu(1237) - lu(715) * lu(1228) + lu(1238) = lu(1238) - lu(716) * lu(1228) + lu(1239) = lu(1239) - lu(717) * lu(1228) + lu(1240) = lu(1240) - lu(718) * lu(1228) + lu(1241) = lu(1241) - lu(719) * lu(1228) + lu(1243) = lu(1243) - lu(720) * lu(1228) + lu(1244) = lu(1244) - lu(721) * lu(1228) + lu(1246) = lu(1246) - lu(722) * lu(1228) + lu(1247) = lu(1247) - lu(723) * lu(1228) + lu(1248) = lu(1248) - lu(724) * lu(1228) + lu(1250) = lu(1250) - lu(725) * lu(1228) + lu(1251) = lu(1251) - lu(726) * lu(1228) + lu(1252) = lu(1252) - lu(727) * lu(1228) + lu(1253) = lu(1253) - lu(728) * lu(1228) + lu(1255) = lu(1255) - lu(729) * lu(1228) + lu(1256) = lu(1256) - lu(730) * lu(1228) + lu(1266) = lu(1266) - lu(711) * lu(1264) + lu(1269) = lu(1269) - lu(712) * lu(1264) + lu(1270) = lu(1270) - lu(713) * lu(1264) + lu(1272) = lu(1272) - lu(714) * lu(1264) + lu(1273) = lu(1273) - lu(715) * lu(1264) + lu(1274) = lu(1274) - lu(716) * lu(1264) + lu(1275) = lu(1275) - lu(717) * lu(1264) + lu(1276) = lu(1276) - lu(718) * lu(1264) + lu(1277) = lu(1277) - lu(719) * lu(1264) + lu(1279) = lu(1279) - lu(720) * lu(1264) + lu(1280) = lu(1280) - lu(721) * lu(1264) + lu(1282) = lu(1282) - lu(722) * lu(1264) + lu(1283) = lu(1283) - lu(723) * lu(1264) + lu(1284) = lu(1284) - lu(724) * lu(1264) + lu(1286) = lu(1286) - lu(725) * lu(1264) + lu(1287) = lu(1287) - lu(726) * lu(1264) + lu(1288) = lu(1288) - lu(727) * lu(1264) + lu(1289) = lu(1289) - lu(728) * lu(1264) + lu(1291) = lu(1291) - lu(729) * lu(1264) + lu(1292) = lu(1292) - lu(730) * lu(1264) + lu(1325) = lu(1325) - lu(711) * lu(1323) + lu(1328) = lu(1328) - lu(712) * lu(1323) + lu(1329) = lu(1329) - lu(713) * lu(1323) + lu(1331) = lu(1331) - lu(714) * lu(1323) + lu(1332) = lu(1332) - lu(715) * lu(1323) + lu(1333) = lu(1333) - lu(716) * lu(1323) + lu(1334) = lu(1334) - lu(717) * lu(1323) + lu(1335) = lu(1335) - lu(718) * lu(1323) + lu(1336) = lu(1336) - lu(719) * lu(1323) + lu(1338) = lu(1338) - lu(720) * lu(1323) + lu(1339) = lu(1339) - lu(721) * lu(1323) + lu(1341) = lu(1341) - lu(722) * lu(1323) + lu(1342) = lu(1342) - lu(723) * lu(1323) + lu(1343) = lu(1343) - lu(724) * lu(1323) + lu(1345) = lu(1345) - lu(725) * lu(1323) + lu(1346) = lu(1346) - lu(726) * lu(1323) + lu(1347) = lu(1347) - lu(727) * lu(1323) + lu(1348) = lu(1348) - lu(728) * lu(1323) + lu(1350) = lu(1350) - lu(729) * lu(1323) + lu(1351) = lu(1351) - lu(730) * lu(1323) + lu(1368) = lu(1368) - lu(711) * lu(1366) + lu(1371) = lu(1371) - lu(712) * lu(1366) + lu(1372) = lu(1372) - lu(713) * lu(1366) + lu(1374) = lu(1374) - lu(714) * lu(1366) + lu(1375) = lu(1375) - lu(715) * lu(1366) + lu(1376) = lu(1376) - lu(716) * lu(1366) + lu(1377) = lu(1377) - lu(717) * lu(1366) + lu(1378) = lu(1378) - lu(718) * lu(1366) + lu(1379) = lu(1379) - lu(719) * lu(1366) + lu(1381) = lu(1381) - lu(720) * lu(1366) + lu(1382) = lu(1382) - lu(721) * lu(1366) + lu(1384) = lu(1384) - lu(722) * lu(1366) + lu(1385) = lu(1385) - lu(723) * lu(1366) + lu(1386) = lu(1386) - lu(724) * lu(1366) + lu(1388) = lu(1388) - lu(725) * lu(1366) + lu(1389) = lu(1389) - lu(726) * lu(1366) + lu(1390) = lu(1390) - lu(727) * lu(1366) + lu(1391) = lu(1391) - lu(728) * lu(1366) + lu(1393) = lu(1393) - lu(729) * lu(1366) + lu(1394) = lu(1394) - lu(730) * lu(1366) + lu(1409) = lu(1409) - lu(711) * lu(1407) + lu(1412) = lu(1412) - lu(712) * lu(1407) + lu(1413) = lu(1413) - lu(713) * lu(1407) + lu(1415) = lu(1415) - lu(714) * lu(1407) + lu(1416) = lu(1416) - lu(715) * lu(1407) + lu(1417) = lu(1417) - lu(716) * lu(1407) + lu(1418) = lu(1418) - lu(717) * lu(1407) + lu(1419) = lu(1419) - lu(718) * lu(1407) + lu(1420) = lu(1420) - lu(719) * lu(1407) + lu(1422) = lu(1422) - lu(720) * lu(1407) + lu(1423) = lu(1423) - lu(721) * lu(1407) + lu(1425) = lu(1425) - lu(722) * lu(1407) + lu(1426) = lu(1426) - lu(723) * lu(1407) + lu(1427) = lu(1427) - lu(724) * lu(1407) + lu(1429) = - lu(725) * lu(1407) + lu(1430) = lu(1430) - lu(726) * lu(1407) + lu(1431) = lu(1431) - lu(727) * lu(1407) + lu(1432) = lu(1432) - lu(728) * lu(1407) + lu(1434) = lu(1434) - lu(729) * lu(1407) + lu(1435) = lu(1435) - lu(730) * lu(1407) + lu(1452) = lu(1452) - lu(711) * lu(1450) + lu(1455) = lu(1455) - lu(712) * lu(1450) + lu(1456) = lu(1456) - lu(713) * lu(1450) + lu(1458) = lu(1458) - lu(714) * lu(1450) + lu(1459) = lu(1459) - lu(715) * lu(1450) + lu(1460) = lu(1460) - lu(716) * lu(1450) + lu(1461) = lu(1461) - lu(717) * lu(1450) + lu(1462) = lu(1462) - lu(718) * lu(1450) + lu(1463) = lu(1463) - lu(719) * lu(1450) + lu(1465) = lu(1465) - lu(720) * lu(1450) + lu(1466) = lu(1466) - lu(721) * lu(1450) + lu(1468) = lu(1468) - lu(722) * lu(1450) + lu(1469) = lu(1469) - lu(723) * lu(1450) + lu(1470) = lu(1470) - lu(724) * lu(1450) + lu(1472) = lu(1472) - lu(725) * lu(1450) + lu(1473) = lu(1473) - lu(726) * lu(1450) + lu(1474) = lu(1474) - lu(727) * lu(1450) + lu(1475) = lu(1475) - lu(728) * lu(1450) + lu(1477) = lu(1477) - lu(729) * lu(1450) + lu(1478) = lu(1478) - lu(730) * lu(1450) + lu(1495) = lu(1495) - lu(711) * lu(1493) + lu(1498) = lu(1498) - lu(712) * lu(1493) + lu(1499) = lu(1499) - lu(713) * lu(1493) + lu(1501) = lu(1501) - lu(714) * lu(1493) + lu(1502) = lu(1502) - lu(715) * lu(1493) + lu(1503) = lu(1503) - lu(716) * lu(1493) + lu(1504) = lu(1504) - lu(717) * lu(1493) + lu(1505) = lu(1505) - lu(718) * lu(1493) + lu(1506) = lu(1506) - lu(719) * lu(1493) + lu(1508) = lu(1508) - lu(720) * lu(1493) + lu(1509) = lu(1509) - lu(721) * lu(1493) + lu(1511) = lu(1511) - lu(722) * lu(1493) + lu(1512) = lu(1512) - lu(723) * lu(1493) + lu(1513) = lu(1513) - lu(724) * lu(1493) + lu(1515) = lu(1515) - lu(725) * lu(1493) + lu(1516) = lu(1516) - lu(726) * lu(1493) + lu(1517) = lu(1517) - lu(727) * lu(1493) + lu(1518) = lu(1518) - lu(728) * lu(1493) + lu(1520) = lu(1520) - lu(729) * lu(1493) + lu(1521) = lu(1521) - lu(730) * lu(1493) + lu(1541) = lu(1541) - lu(711) * lu(1539) + lu(1544) = lu(1544) - lu(712) * lu(1539) + lu(1545) = lu(1545) - lu(713) * lu(1539) + lu(1547) = lu(1547) - lu(714) * lu(1539) + lu(1548) = lu(1548) - lu(715) * lu(1539) + lu(1549) = lu(1549) - lu(716) * lu(1539) + lu(1550) = lu(1550) - lu(717) * lu(1539) + lu(1551) = lu(1551) - lu(718) * lu(1539) + lu(1552) = lu(1552) - lu(719) * lu(1539) + lu(1554) = lu(1554) - lu(720) * lu(1539) + lu(1555) = lu(1555) - lu(721) * lu(1539) + lu(1557) = lu(1557) - lu(722) * lu(1539) + lu(1558) = lu(1558) - lu(723) * lu(1539) + lu(1559) = lu(1559) - lu(724) * lu(1539) + lu(1561) = lu(1561) - lu(725) * lu(1539) + lu(1562) = lu(1562) - lu(726) * lu(1539) + lu(1563) = lu(1563) - lu(727) * lu(1539) + lu(1564) = lu(1564) - lu(728) * lu(1539) + lu(1566) = lu(1566) - lu(729) * lu(1539) + lu(1567) = lu(1567) - lu(730) * lu(1539) + lu(1587) = lu(1587) - lu(711) * lu(1585) + lu(1590) = lu(1590) - lu(712) * lu(1585) + lu(1591) = lu(1591) - lu(713) * lu(1585) + lu(1593) = lu(1593) - lu(714) * lu(1585) + lu(1594) = lu(1594) - lu(715) * lu(1585) + lu(1595) = lu(1595) - lu(716) * lu(1585) + lu(1596) = lu(1596) - lu(717) * lu(1585) + lu(1597) = lu(1597) - lu(718) * lu(1585) + lu(1598) = lu(1598) - lu(719) * lu(1585) + lu(1600) = lu(1600) - lu(720) * lu(1585) + lu(1601) = lu(1601) - lu(721) * lu(1585) + lu(1603) = lu(1603) - lu(722) * lu(1585) + lu(1604) = lu(1604) - lu(723) * lu(1585) + lu(1605) = lu(1605) - lu(724) * lu(1585) + lu(1607) = lu(1607) - lu(725) * lu(1585) + lu(1608) = lu(1608) - lu(726) * lu(1585) + lu(1609) = lu(1609) - lu(727) * lu(1585) + lu(1610) = lu(1610) - lu(728) * lu(1585) + lu(1612) = lu(1612) - lu(729) * lu(1585) + lu(1613) = lu(1613) - lu(730) * lu(1585) + lu(1629) = - lu(711) * lu(1627) + lu(1631) = lu(1631) - lu(712) * lu(1627) + lu(1632) = lu(1632) - lu(713) * lu(1627) + lu(1634) = lu(1634) - lu(714) * lu(1627) + lu(1635) = lu(1635) - lu(715) * lu(1627) + lu(1636) = lu(1636) - lu(716) * lu(1627) + lu(1637) = lu(1637) - lu(717) * lu(1627) + lu(1638) = lu(1638) - lu(718) * lu(1627) + lu(1639) = lu(1639) - lu(719) * lu(1627) + lu(1641) = lu(1641) - lu(720) * lu(1627) + lu(1642) = lu(1642) - lu(721) * lu(1627) + lu(1644) = lu(1644) - lu(722) * lu(1627) + lu(1645) = lu(1645) - lu(723) * lu(1627) + lu(1646) = lu(1646) - lu(724) * lu(1627) + lu(1648) = lu(1648) - lu(725) * lu(1627) + lu(1649) = lu(1649) - lu(726) * lu(1627) + lu(1650) = lu(1650) - lu(727) * lu(1627) + lu(1651) = lu(1651) - lu(728) * lu(1627) + lu(1653) = lu(1653) - lu(729) * lu(1627) + lu(1654) = lu(1654) - lu(730) * lu(1627) + lu(1671) = lu(1671) - lu(711) * lu(1669) + lu(1674) = lu(1674) - lu(712) * lu(1669) + lu(1675) = lu(1675) - lu(713) * lu(1669) + lu(1677) = lu(1677) - lu(714) * lu(1669) + lu(1678) = lu(1678) - lu(715) * lu(1669) + lu(1679) = lu(1679) - lu(716) * lu(1669) + lu(1680) = lu(1680) - lu(717) * lu(1669) + lu(1681) = lu(1681) - lu(718) * lu(1669) + lu(1682) = lu(1682) - lu(719) * lu(1669) + lu(1684) = lu(1684) - lu(720) * lu(1669) + lu(1685) = lu(1685) - lu(721) * lu(1669) + lu(1687) = lu(1687) - lu(722) * lu(1669) + lu(1688) = lu(1688) - lu(723) * lu(1669) + lu(1689) = lu(1689) - lu(724) * lu(1669) + lu(1691) = lu(1691) - lu(725) * lu(1669) + lu(1692) = lu(1692) - lu(726) * lu(1669) + lu(1693) = lu(1693) - lu(727) * lu(1669) + lu(1694) = lu(1694) - lu(728) * lu(1669) + lu(1696) = lu(1696) - lu(729) * lu(1669) + lu(1697) = lu(1697) - lu(730) * lu(1669) + lu(1711) = lu(1711) - lu(711) * lu(1709) + lu(1714) = lu(1714) - lu(712) * lu(1709) + lu(1715) = lu(1715) - lu(713) * lu(1709) + lu(1717) = lu(1717) - lu(714) * lu(1709) + lu(1718) = lu(1718) - lu(715) * lu(1709) + lu(1719) = lu(1719) - lu(716) * lu(1709) + lu(1720) = lu(1720) - lu(717) * lu(1709) + lu(1721) = lu(1721) - lu(718) * lu(1709) + lu(1722) = lu(1722) - lu(719) * lu(1709) + lu(1724) = lu(1724) - lu(720) * lu(1709) + lu(1725) = lu(1725) - lu(721) * lu(1709) + lu(1727) = lu(1727) - lu(722) * lu(1709) + lu(1728) = lu(1728) - lu(723) * lu(1709) + lu(1729) = lu(1729) - lu(724) * lu(1709) + lu(1731) = lu(1731) - lu(725) * lu(1709) + lu(1732) = lu(1732) - lu(726) * lu(1709) + lu(1733) = lu(1733) - lu(727) * lu(1709) + lu(1734) = lu(1734) - lu(728) * lu(1709) + lu(1736) = lu(1736) - lu(729) * lu(1709) + lu(1737) = lu(1737) - lu(730) * lu(1709) + lu(1757) = lu(1757) - lu(711) * lu(1755) + lu(1760) = lu(1760) - lu(712) * lu(1755) + lu(1761) = lu(1761) - lu(713) * lu(1755) + lu(1763) = lu(1763) - lu(714) * lu(1755) + lu(1764) = lu(1764) - lu(715) * lu(1755) + lu(1765) = lu(1765) - lu(716) * lu(1755) + lu(1766) = lu(1766) - lu(717) * lu(1755) + lu(1767) = lu(1767) - lu(718) * lu(1755) + lu(1768) = lu(1768) - lu(719) * lu(1755) + lu(1770) = lu(1770) - lu(720) * lu(1755) + lu(1771) = lu(1771) - lu(721) * lu(1755) + lu(1773) = lu(1773) - lu(722) * lu(1755) + lu(1774) = lu(1774) - lu(723) * lu(1755) + lu(1775) = lu(1775) - lu(724) * lu(1755) + lu(1777) = lu(1777) - lu(725) * lu(1755) + lu(1778) = lu(1778) - lu(726) * lu(1755) + lu(1779) = lu(1779) - lu(727) * lu(1755) + lu(1780) = lu(1780) - lu(728) * lu(1755) + lu(1782) = lu(1782) - lu(729) * lu(1755) + lu(1783) = lu(1783) - lu(730) * lu(1755) + lu(1793) = lu(1793) - lu(711) * lu(1791) + lu(1796) = lu(1796) - lu(712) * lu(1791) + lu(1797) = lu(1797) - lu(713) * lu(1791) + lu(1799) = lu(1799) - lu(714) * lu(1791) + lu(1800) = lu(1800) - lu(715) * lu(1791) + lu(1801) = lu(1801) - lu(716) * lu(1791) + lu(1802) = lu(1802) - lu(717) * lu(1791) + lu(1803) = lu(1803) - lu(718) * lu(1791) + lu(1804) = lu(1804) - lu(719) * lu(1791) + lu(1806) = lu(1806) - lu(720) * lu(1791) + lu(1807) = lu(1807) - lu(721) * lu(1791) + lu(1809) = lu(1809) - lu(722) * lu(1791) + lu(1810) = lu(1810) - lu(723) * lu(1791) + lu(1811) = lu(1811) - lu(724) * lu(1791) + lu(1813) = - lu(725) * lu(1791) + lu(1814) = lu(1814) - lu(726) * lu(1791) + lu(1815) = lu(1815) - lu(727) * lu(1791) + lu(1816) = lu(1816) - lu(728) * lu(1791) + lu(1818) = lu(1818) - lu(729) * lu(1791) + lu(1819) = lu(1819) - lu(730) * lu(1791) + lu(1835) = lu(1835) - lu(711) * lu(1833) + lu(1838) = lu(1838) - lu(712) * lu(1833) + lu(1839) = lu(1839) - lu(713) * lu(1833) + lu(1841) = lu(1841) - lu(714) * lu(1833) + lu(1842) = lu(1842) - lu(715) * lu(1833) + lu(1843) = lu(1843) - lu(716) * lu(1833) + lu(1844) = lu(1844) - lu(717) * lu(1833) + lu(1845) = lu(1845) - lu(718) * lu(1833) + lu(1846) = lu(1846) - lu(719) * lu(1833) + lu(1848) = lu(1848) - lu(720) * lu(1833) + lu(1849) = lu(1849) - lu(721) * lu(1833) + lu(1851) = lu(1851) - lu(722) * lu(1833) + lu(1852) = lu(1852) - lu(723) * lu(1833) + lu(1853) = lu(1853) - lu(724) * lu(1833) + lu(1855) = lu(1855) - lu(725) * lu(1833) + lu(1856) = lu(1856) - lu(726) * lu(1833) + lu(1857) = lu(1857) - lu(727) * lu(1833) + lu(1858) = lu(1858) - lu(728) * lu(1833) + lu(1860) = lu(1860) - lu(729) * lu(1833) + lu(1861) = lu(1861) - lu(730) * lu(1833) + lu(1881) = lu(1881) - lu(711) * lu(1879) + lu(1884) = lu(1884) - lu(712) * lu(1879) + lu(1885) = lu(1885) - lu(713) * lu(1879) + lu(1887) = lu(1887) - lu(714) * lu(1879) + lu(1888) = lu(1888) - lu(715) * lu(1879) + lu(1889) = lu(1889) - lu(716) * lu(1879) + lu(1890) = lu(1890) - lu(717) * lu(1879) + lu(1891) = lu(1891) - lu(718) * lu(1879) + lu(1892) = lu(1892) - lu(719) * lu(1879) + lu(1894) = lu(1894) - lu(720) * lu(1879) + lu(1895) = lu(1895) - lu(721) * lu(1879) + lu(1897) = lu(1897) - lu(722) * lu(1879) + lu(1898) = lu(1898) - lu(723) * lu(1879) + lu(1899) = lu(1899) - lu(724) * lu(1879) + lu(1901) = lu(1901) - lu(725) * lu(1879) + lu(1902) = lu(1902) - lu(726) * lu(1879) + lu(1903) = lu(1903) - lu(727) * lu(1879) + lu(1904) = lu(1904) - lu(728) * lu(1879) + lu(1906) = lu(1906) - lu(729) * lu(1879) + lu(1907) = lu(1907) - lu(730) * lu(1879) + lu(744) = 1._r8 / lu(744) + lu(745) = lu(745) * lu(744) + lu(746) = lu(746) * lu(744) + lu(747) = lu(747) * lu(744) + lu(748) = lu(748) * lu(744) + lu(749) = lu(749) * lu(744) + lu(750) = lu(750) * lu(744) + lu(751) = lu(751) * lu(744) + lu(752) = lu(752) * lu(744) + lu(753) = lu(753) * lu(744) + lu(754) = lu(754) * lu(744) + lu(755) = lu(755) * lu(744) + lu(756) = lu(756) * lu(744) + lu(757) = lu(757) * lu(744) + lu(758) = lu(758) * lu(744) + lu(759) = lu(759) * lu(744) + lu(760) = lu(760) * lu(744) + lu(761) = lu(761) * lu(744) + lu(762) = lu(762) * lu(744) + lu(763) = lu(763) * lu(744) + lu(764) = lu(764) * lu(744) + lu(765) = lu(765) * lu(744) + lu(819) = lu(819) - lu(745) * lu(818) + lu(820) = lu(820) - lu(746) * lu(818) + lu(821) = lu(821) - lu(747) * lu(818) + lu(822) = lu(822) - lu(748) * lu(818) + lu(823) = lu(823) - lu(749) * lu(818) + lu(824) = lu(824) - lu(750) * lu(818) + lu(825) = lu(825) - lu(751) * lu(818) + lu(826) = lu(826) - lu(752) * lu(818) + lu(827) = lu(827) - lu(753) * lu(818) + lu(828) = lu(828) - lu(754) * lu(818) + lu(829) = lu(829) - lu(755) * lu(818) + lu(830) = lu(830) - lu(756) * lu(818) + lu(831) = lu(831) - lu(757) * lu(818) + lu(832) = lu(832) - lu(758) * lu(818) + lu(833) = lu(833) - lu(759) * lu(818) + lu(834) = lu(834) - lu(760) * lu(818) + lu(835) = lu(835) - lu(761) * lu(818) + lu(836) = lu(836) - lu(762) * lu(818) + lu(837) = lu(837) - lu(763) * lu(818) + lu(838) = lu(838) - lu(764) * lu(818) + lu(839) = lu(839) - lu(765) * lu(818) + lu(891) = lu(891) - lu(745) * lu(889) + lu(894) = lu(894) - lu(746) * lu(889) + lu(895) = lu(895) - lu(747) * lu(889) + lu(896) = lu(896) - lu(748) * lu(889) + lu(897) = lu(897) - lu(749) * lu(889) + lu(898) = lu(898) - lu(750) * lu(889) + lu(899) = lu(899) - lu(751) * lu(889) + lu(900) = lu(900) - lu(752) * lu(889) + lu(901) = lu(901) - lu(753) * lu(889) + lu(902) = lu(902) - lu(754) * lu(889) + lu(903) = lu(903) - lu(755) * lu(889) + lu(904) = lu(904) - lu(756) * lu(889) + lu(905) = lu(905) - lu(757) * lu(889) + lu(907) = lu(907) - lu(758) * lu(889) + lu(908) = lu(908) - lu(759) * lu(889) + lu(909) = lu(909) - lu(760) * lu(889) + lu(910) = lu(910) - lu(761) * lu(889) + lu(912) = lu(912) - lu(762) * lu(889) + lu(913) = lu(913) - lu(763) * lu(889) + lu(914) = lu(914) - lu(764) * lu(889) + lu(915) = lu(915) - lu(765) * lu(889) + lu(928) = lu(928) - lu(745) * lu(926) + lu(931) = lu(931) - lu(746) * lu(926) + lu(932) = lu(932) - lu(747) * lu(926) + lu(933) = lu(933) - lu(748) * lu(926) + lu(934) = lu(934) - lu(749) * lu(926) + lu(935) = lu(935) - lu(750) * lu(926) + lu(936) = lu(936) - lu(751) * lu(926) + lu(937) = lu(937) - lu(752) * lu(926) + lu(938) = lu(938) - lu(753) * lu(926) + lu(939) = lu(939) - lu(754) * lu(926) + lu(940) = lu(940) - lu(755) * lu(926) + lu(941) = lu(941) - lu(756) * lu(926) + lu(942) = lu(942) - lu(757) * lu(926) + lu(944) = lu(944) - lu(758) * lu(926) + lu(945) = lu(945) - lu(759) * lu(926) + lu(946) = lu(946) - lu(760) * lu(926) + lu(947) = lu(947) - lu(761) * lu(926) + lu(949) = lu(949) - lu(762) * lu(926) + lu(950) = lu(950) - lu(763) * lu(926) + lu(951) = lu(951) - lu(764) * lu(926) + lu(952) = lu(952) - lu(765) * lu(926) + lu(961) = lu(961) - lu(745) * lu(959) + lu(964) = lu(964) - lu(746) * lu(959) + lu(965) = lu(965) - lu(747) * lu(959) + lu(966) = lu(966) - lu(748) * lu(959) + lu(967) = lu(967) - lu(749) * lu(959) + lu(968) = lu(968) - lu(750) * lu(959) + lu(969) = lu(969) - lu(751) * lu(959) + lu(970) = lu(970) - lu(752) * lu(959) + lu(971) = lu(971) - lu(753) * lu(959) + lu(972) = lu(972) - lu(754) * lu(959) + lu(973) = lu(973) - lu(755) * lu(959) + lu(974) = lu(974) - lu(756) * lu(959) + lu(975) = lu(975) - lu(757) * lu(959) + lu(977) = lu(977) - lu(758) * lu(959) + lu(978) = lu(978) - lu(759) * lu(959) + lu(979) = lu(979) - lu(760) * lu(959) + lu(980) = lu(980) - lu(761) * lu(959) + lu(982) = lu(982) - lu(762) * lu(959) + lu(983) = lu(983) - lu(763) * lu(959) + lu(984) = lu(984) - lu(764) * lu(959) + lu(985) = lu(985) - lu(765) * lu(959) + lu(1005) = lu(1005) - lu(745) * lu(1003) + lu(1008) = lu(1008) - lu(746) * lu(1003) + lu(1009) = lu(1009) - lu(747) * lu(1003) + lu(1010) = lu(1010) - lu(748) * lu(1003) + lu(1011) = lu(1011) - lu(749) * lu(1003) + lu(1012) = lu(1012) - lu(750) * lu(1003) + lu(1013) = lu(1013) - lu(751) * lu(1003) + lu(1014) = lu(1014) - lu(752) * lu(1003) + lu(1015) = lu(1015) - lu(753) * lu(1003) + lu(1016) = lu(1016) - lu(754) * lu(1003) + lu(1017) = lu(1017) - lu(755) * lu(1003) + lu(1018) = lu(1018) - lu(756) * lu(1003) + lu(1019) = lu(1019) - lu(757) * lu(1003) + lu(1021) = lu(1021) - lu(758) * lu(1003) + lu(1022) = lu(1022) - lu(759) * lu(1003) + lu(1023) = lu(1023) - lu(760) * lu(1003) + lu(1024) = lu(1024) - lu(761) * lu(1003) + lu(1026) = lu(1026) - lu(762) * lu(1003) + lu(1027) = lu(1027) - lu(763) * lu(1003) + lu(1028) = lu(1028) - lu(764) * lu(1003) + lu(1029) = lu(1029) - lu(765) * lu(1003) + lu(1045) = lu(1045) - lu(745) * lu(1043) + lu(1048) = lu(1048) - lu(746) * lu(1043) + lu(1049) = lu(1049) - lu(747) * lu(1043) + lu(1050) = lu(1050) - lu(748) * lu(1043) + lu(1051) = lu(1051) - lu(749) * lu(1043) + lu(1052) = lu(1052) - lu(750) * lu(1043) + lu(1053) = lu(1053) - lu(751) * lu(1043) + lu(1054) = lu(1054) - lu(752) * lu(1043) + lu(1055) = lu(1055) - lu(753) * lu(1043) + lu(1056) = lu(1056) - lu(754) * lu(1043) + lu(1057) = lu(1057) - lu(755) * lu(1043) + lu(1058) = lu(1058) - lu(756) * lu(1043) + lu(1059) = lu(1059) - lu(757) * lu(1043) + lu(1061) = lu(1061) - lu(758) * lu(1043) + lu(1062) = lu(1062) - lu(759) * lu(1043) + lu(1063) = lu(1063) - lu(760) * lu(1043) + lu(1064) = lu(1064) - lu(761) * lu(1043) + lu(1066) = lu(1066) - lu(762) * lu(1043) + lu(1067) = lu(1067) - lu(763) * lu(1043) + lu(1068) = lu(1068) - lu(764) * lu(1043) + lu(1069) = lu(1069) - lu(765) * lu(1043) + lu(1103) = lu(1103) - lu(745) * lu(1101) + lu(1106) = lu(1106) - lu(746) * lu(1101) + lu(1107) = lu(1107) - lu(747) * lu(1101) + lu(1108) = lu(1108) - lu(748) * lu(1101) + lu(1109) = lu(1109) - lu(749) * lu(1101) + lu(1110) = lu(1110) - lu(750) * lu(1101) + lu(1111) = lu(1111) - lu(751) * lu(1101) + lu(1112) = lu(1112) - lu(752) * lu(1101) + lu(1113) = lu(1113) - lu(753) * lu(1101) + lu(1114) = lu(1114) - lu(754) * lu(1101) + lu(1115) = lu(1115) - lu(755) * lu(1101) + lu(1116) = lu(1116) - lu(756) * lu(1101) + lu(1117) = lu(1117) - lu(757) * lu(1101) + lu(1119) = lu(1119) - lu(758) * lu(1101) + lu(1120) = lu(1120) - lu(759) * lu(1101) + lu(1121) = lu(1121) - lu(760) * lu(1101) + lu(1122) = lu(1122) - lu(761) * lu(1101) + lu(1124) = lu(1124) - lu(762) * lu(1101) + lu(1125) = lu(1125) - lu(763) * lu(1101) + lu(1126) = lu(1126) - lu(764) * lu(1101) + lu(1127) = lu(1127) - lu(765) * lu(1101) + lu(1144) = lu(1144) - lu(745) * lu(1143) + lu(1146) = lu(1146) - lu(746) * lu(1143) + lu(1147) = lu(1147) - lu(747) * lu(1143) + lu(1148) = lu(1148) - lu(748) * lu(1143) + lu(1149) = lu(1149) - lu(749) * lu(1143) + lu(1150) = lu(1150) - lu(750) * lu(1143) + lu(1151) = lu(1151) - lu(751) * lu(1143) + lu(1152) = lu(1152) - lu(752) * lu(1143) + lu(1153) = lu(1153) - lu(753) * lu(1143) + lu(1154) = lu(1154) - lu(754) * lu(1143) + lu(1155) = lu(1155) - lu(755) * lu(1143) + lu(1156) = lu(1156) - lu(756) * lu(1143) + lu(1157) = lu(1157) - lu(757) * lu(1143) + lu(1159) = lu(1159) - lu(758) * lu(1143) + lu(1160) = lu(1160) - lu(759) * lu(1143) + lu(1161) = lu(1161) - lu(760) * lu(1143) + lu(1162) = lu(1162) - lu(761) * lu(1143) + lu(1164) = lu(1164) - lu(762) * lu(1143) + lu(1165) = lu(1165) - lu(763) * lu(1143) + lu(1166) = lu(1166) - lu(764) * lu(1143) + lu(1167) = lu(1167) - lu(765) * lu(1143) + lu(1189) = lu(1189) - lu(745) * lu(1187) + lu(1192) = lu(1192) - lu(746) * lu(1187) + lu(1193) = lu(1193) - lu(747) * lu(1187) + lu(1194) = lu(1194) - lu(748) * lu(1187) + lu(1195) = lu(1195) - lu(749) * lu(1187) + lu(1196) = lu(1196) - lu(750) * lu(1187) + lu(1197) = lu(1197) - lu(751) * lu(1187) + lu(1198) = lu(1198) - lu(752) * lu(1187) + lu(1199) = lu(1199) - lu(753) * lu(1187) + lu(1200) = lu(1200) - lu(754) * lu(1187) + lu(1201) = lu(1201) - lu(755) * lu(1187) + lu(1202) = lu(1202) - lu(756) * lu(1187) + lu(1203) = lu(1203) - lu(757) * lu(1187) + lu(1205) = lu(1205) - lu(758) * lu(1187) + lu(1206) = lu(1206) - lu(759) * lu(1187) + lu(1207) = lu(1207) - lu(760) * lu(1187) + lu(1208) = lu(1208) - lu(761) * lu(1187) + lu(1210) = lu(1210) - lu(762) * lu(1187) + lu(1211) = lu(1211) - lu(763) * lu(1187) + lu(1212) = lu(1212) - lu(764) * lu(1187) + lu(1213) = lu(1213) - lu(765) * lu(1187) + lu(1231) = lu(1231) - lu(745) * lu(1229) + lu(1234) = lu(1234) - lu(746) * lu(1229) + lu(1235) = lu(1235) - lu(747) * lu(1229) + lu(1236) = lu(1236) - lu(748) * lu(1229) + lu(1237) = lu(1237) - lu(749) * lu(1229) + lu(1238) = lu(1238) - lu(750) * lu(1229) + lu(1239) = lu(1239) - lu(751) * lu(1229) + lu(1240) = lu(1240) - lu(752) * lu(1229) + lu(1241) = lu(1241) - lu(753) * lu(1229) + lu(1242) = lu(1242) - lu(754) * lu(1229) + lu(1243) = lu(1243) - lu(755) * lu(1229) + lu(1244) = lu(1244) - lu(756) * lu(1229) + lu(1245) = lu(1245) - lu(757) * lu(1229) + lu(1247) = lu(1247) - lu(758) * lu(1229) + lu(1248) = lu(1248) - lu(759) * lu(1229) + lu(1249) = lu(1249) - lu(760) * lu(1229) + lu(1250) = lu(1250) - lu(761) * lu(1229) + lu(1252) = lu(1252) - lu(762) * lu(1229) + lu(1253) = lu(1253) - lu(763) * lu(1229) + lu(1254) = lu(1254) - lu(764) * lu(1229) + lu(1255) = lu(1255) - lu(765) * lu(1229) + lu(1267) = lu(1267) - lu(745) * lu(1265) + lu(1270) = lu(1270) - lu(746) * lu(1265) + lu(1271) = lu(1271) - lu(747) * lu(1265) + lu(1272) = lu(1272) - lu(748) * lu(1265) + lu(1273) = lu(1273) - lu(749) * lu(1265) + lu(1274) = lu(1274) - lu(750) * lu(1265) + lu(1275) = lu(1275) - lu(751) * lu(1265) + lu(1276) = lu(1276) - lu(752) * lu(1265) + lu(1277) = lu(1277) - lu(753) * lu(1265) + lu(1278) = lu(1278) - lu(754) * lu(1265) + lu(1279) = lu(1279) - lu(755) * lu(1265) + lu(1280) = lu(1280) - lu(756) * lu(1265) + lu(1281) = lu(1281) - lu(757) * lu(1265) + lu(1283) = lu(1283) - lu(758) * lu(1265) + lu(1284) = lu(1284) - lu(759) * lu(1265) + lu(1285) = lu(1285) - lu(760) * lu(1265) + lu(1286) = lu(1286) - lu(761) * lu(1265) + lu(1288) = lu(1288) - lu(762) * lu(1265) + lu(1289) = lu(1289) - lu(763) * lu(1265) + lu(1290) = lu(1290) - lu(764) * lu(1265) + lu(1291) = lu(1291) - lu(765) * lu(1265) + lu(1326) = lu(1326) - lu(745) * lu(1324) + lu(1329) = lu(1329) - lu(746) * lu(1324) + lu(1330) = lu(1330) - lu(747) * lu(1324) + lu(1331) = lu(1331) - lu(748) * lu(1324) + lu(1332) = lu(1332) - lu(749) * lu(1324) + lu(1333) = lu(1333) - lu(750) * lu(1324) + lu(1334) = lu(1334) - lu(751) * lu(1324) + lu(1335) = lu(1335) - lu(752) * lu(1324) + lu(1336) = lu(1336) - lu(753) * lu(1324) + lu(1337) = lu(1337) - lu(754) * lu(1324) + lu(1338) = lu(1338) - lu(755) * lu(1324) + lu(1339) = lu(1339) - lu(756) * lu(1324) + lu(1340) = lu(1340) - lu(757) * lu(1324) + lu(1342) = lu(1342) - lu(758) * lu(1324) + lu(1343) = lu(1343) - lu(759) * lu(1324) + lu(1344) = lu(1344) - lu(760) * lu(1324) + lu(1345) = lu(1345) - lu(761) * lu(1324) + lu(1347) = lu(1347) - lu(762) * lu(1324) + lu(1348) = lu(1348) - lu(763) * lu(1324) + lu(1349) = lu(1349) - lu(764) * lu(1324) + lu(1350) = lu(1350) - lu(765) * lu(1324) + lu(1369) = lu(1369) - lu(745) * lu(1367) + lu(1372) = lu(1372) - lu(746) * lu(1367) + lu(1373) = lu(1373) - lu(747) * lu(1367) + lu(1374) = lu(1374) - lu(748) * lu(1367) + lu(1375) = lu(1375) - lu(749) * lu(1367) + lu(1376) = lu(1376) - lu(750) * lu(1367) + lu(1377) = lu(1377) - lu(751) * lu(1367) + lu(1378) = lu(1378) - lu(752) * lu(1367) + lu(1379) = lu(1379) - lu(753) * lu(1367) + lu(1380) = lu(1380) - lu(754) * lu(1367) + lu(1381) = lu(1381) - lu(755) * lu(1367) + lu(1382) = lu(1382) - lu(756) * lu(1367) + lu(1383) = lu(1383) - lu(757) * lu(1367) + lu(1385) = lu(1385) - lu(758) * lu(1367) + lu(1386) = lu(1386) - lu(759) * lu(1367) + lu(1387) = lu(1387) - lu(760) * lu(1367) + lu(1388) = lu(1388) - lu(761) * lu(1367) + lu(1390) = lu(1390) - lu(762) * lu(1367) + lu(1391) = lu(1391) - lu(763) * lu(1367) + lu(1392) = lu(1392) - lu(764) * lu(1367) + lu(1393) = lu(1393) - lu(765) * lu(1367) + lu(1410) = lu(1410) - lu(745) * lu(1408) + lu(1413) = lu(1413) - lu(746) * lu(1408) + lu(1414) = lu(1414) - lu(747) * lu(1408) + lu(1415) = lu(1415) - lu(748) * lu(1408) + lu(1416) = lu(1416) - lu(749) * lu(1408) + lu(1417) = lu(1417) - lu(750) * lu(1408) + lu(1418) = lu(1418) - lu(751) * lu(1408) + lu(1419) = lu(1419) - lu(752) * lu(1408) + lu(1420) = lu(1420) - lu(753) * lu(1408) + lu(1421) = lu(1421) - lu(754) * lu(1408) + lu(1422) = lu(1422) - lu(755) * lu(1408) + lu(1423) = lu(1423) - lu(756) * lu(1408) + lu(1424) = lu(1424) - lu(757) * lu(1408) + lu(1426) = lu(1426) - lu(758) * lu(1408) + lu(1427) = lu(1427) - lu(759) * lu(1408) + lu(1428) = lu(1428) - lu(760) * lu(1408) + lu(1429) = lu(1429) - lu(761) * lu(1408) + lu(1431) = lu(1431) - lu(762) * lu(1408) + lu(1432) = lu(1432) - lu(763) * lu(1408) + lu(1433) = lu(1433) - lu(764) * lu(1408) + lu(1434) = lu(1434) - lu(765) * lu(1408) + lu(1453) = lu(1453) - lu(745) * lu(1451) + lu(1456) = lu(1456) - lu(746) * lu(1451) + lu(1457) = lu(1457) - lu(747) * lu(1451) + lu(1458) = lu(1458) - lu(748) * lu(1451) + lu(1459) = lu(1459) - lu(749) * lu(1451) + lu(1460) = lu(1460) - lu(750) * lu(1451) + lu(1461) = lu(1461) - lu(751) * lu(1451) + lu(1462) = lu(1462) - lu(752) * lu(1451) + lu(1463) = lu(1463) - lu(753) * lu(1451) + lu(1464) = lu(1464) - lu(754) * lu(1451) + lu(1465) = lu(1465) - lu(755) * lu(1451) + lu(1466) = lu(1466) - lu(756) * lu(1451) + lu(1467) = lu(1467) - lu(757) * lu(1451) + lu(1469) = lu(1469) - lu(758) * lu(1451) + lu(1470) = lu(1470) - lu(759) * lu(1451) + lu(1471) = lu(1471) - lu(760) * lu(1451) + lu(1472) = lu(1472) - lu(761) * lu(1451) + lu(1474) = lu(1474) - lu(762) * lu(1451) + lu(1475) = lu(1475) - lu(763) * lu(1451) + lu(1476) = lu(1476) - lu(764) * lu(1451) + lu(1477) = lu(1477) - lu(765) * lu(1451) + lu(1496) = lu(1496) - lu(745) * lu(1494) + lu(1499) = lu(1499) - lu(746) * lu(1494) + lu(1500) = lu(1500) - lu(747) * lu(1494) + lu(1501) = lu(1501) - lu(748) * lu(1494) + lu(1502) = lu(1502) - lu(749) * lu(1494) + lu(1503) = lu(1503) - lu(750) * lu(1494) + lu(1504) = lu(1504) - lu(751) * lu(1494) + lu(1505) = lu(1505) - lu(752) * lu(1494) + lu(1506) = lu(1506) - lu(753) * lu(1494) + lu(1507) = lu(1507) - lu(754) * lu(1494) + lu(1508) = lu(1508) - lu(755) * lu(1494) + lu(1509) = lu(1509) - lu(756) * lu(1494) + lu(1510) = lu(1510) - lu(757) * lu(1494) + lu(1512) = lu(1512) - lu(758) * lu(1494) + lu(1513) = lu(1513) - lu(759) * lu(1494) + lu(1514) = lu(1514) - lu(760) * lu(1494) + lu(1515) = lu(1515) - lu(761) * lu(1494) + lu(1517) = lu(1517) - lu(762) * lu(1494) + lu(1518) = lu(1518) - lu(763) * lu(1494) + lu(1519) = lu(1519) - lu(764) * lu(1494) + lu(1520) = lu(1520) - lu(765) * lu(1494) + lu(1542) = lu(1542) - lu(745) * lu(1540) + lu(1545) = lu(1545) - lu(746) * lu(1540) + lu(1546) = lu(1546) - lu(747) * lu(1540) + lu(1547) = lu(1547) - lu(748) * lu(1540) + lu(1548) = lu(1548) - lu(749) * lu(1540) + lu(1549) = lu(1549) - lu(750) * lu(1540) + lu(1550) = lu(1550) - lu(751) * lu(1540) + lu(1551) = lu(1551) - lu(752) * lu(1540) + lu(1552) = lu(1552) - lu(753) * lu(1540) + lu(1553) = lu(1553) - lu(754) * lu(1540) + lu(1554) = lu(1554) - lu(755) * lu(1540) + lu(1555) = lu(1555) - lu(756) * lu(1540) + lu(1556) = lu(1556) - lu(757) * lu(1540) + lu(1558) = lu(1558) - lu(758) * lu(1540) + lu(1559) = lu(1559) - lu(759) * lu(1540) + lu(1560) = lu(1560) - lu(760) * lu(1540) + lu(1561) = lu(1561) - lu(761) * lu(1540) + lu(1563) = lu(1563) - lu(762) * lu(1540) + lu(1564) = lu(1564) - lu(763) * lu(1540) + lu(1565) = lu(1565) - lu(764) * lu(1540) + lu(1566) = lu(1566) - lu(765) * lu(1540) + lu(1588) = lu(1588) - lu(745) * lu(1586) + lu(1591) = lu(1591) - lu(746) * lu(1586) + lu(1592) = lu(1592) - lu(747) * lu(1586) + lu(1593) = lu(1593) - lu(748) * lu(1586) + lu(1594) = lu(1594) - lu(749) * lu(1586) + lu(1595) = lu(1595) - lu(750) * lu(1586) + lu(1596) = lu(1596) - lu(751) * lu(1586) + lu(1597) = lu(1597) - lu(752) * lu(1586) + lu(1598) = lu(1598) - lu(753) * lu(1586) + lu(1599) = lu(1599) - lu(754) * lu(1586) + lu(1600) = lu(1600) - lu(755) * lu(1586) + lu(1601) = lu(1601) - lu(756) * lu(1586) + lu(1602) = lu(1602) - lu(757) * lu(1586) + lu(1604) = lu(1604) - lu(758) * lu(1586) + lu(1605) = lu(1605) - lu(759) * lu(1586) + lu(1606) = lu(1606) - lu(760) * lu(1586) + lu(1607) = lu(1607) - lu(761) * lu(1586) + lu(1609) = lu(1609) - lu(762) * lu(1586) + lu(1610) = lu(1610) - lu(763) * lu(1586) + lu(1611) = lu(1611) - lu(764) * lu(1586) + lu(1612) = lu(1612) - lu(765) * lu(1586) + lu(1630) = lu(1630) - lu(745) * lu(1628) + lu(1632) = lu(1632) - lu(746) * lu(1628) + lu(1633) = lu(1633) - lu(747) * lu(1628) + lu(1634) = lu(1634) - lu(748) * lu(1628) + lu(1635) = lu(1635) - lu(749) * lu(1628) + lu(1636) = lu(1636) - lu(750) * lu(1628) + lu(1637) = lu(1637) - lu(751) * lu(1628) + lu(1638) = lu(1638) - lu(752) * lu(1628) + lu(1639) = lu(1639) - lu(753) * lu(1628) + lu(1640) = lu(1640) - lu(754) * lu(1628) + lu(1641) = lu(1641) - lu(755) * lu(1628) + lu(1642) = lu(1642) - lu(756) * lu(1628) + lu(1643) = lu(1643) - lu(757) * lu(1628) + lu(1645) = lu(1645) - lu(758) * lu(1628) + lu(1646) = lu(1646) - lu(759) * lu(1628) + lu(1647) = lu(1647) - lu(760) * lu(1628) + lu(1648) = lu(1648) - lu(761) * lu(1628) + lu(1650) = lu(1650) - lu(762) * lu(1628) + lu(1651) = lu(1651) - lu(763) * lu(1628) + lu(1652) = lu(1652) - lu(764) * lu(1628) + lu(1653) = lu(1653) - lu(765) * lu(1628) + lu(1672) = lu(1672) - lu(745) * lu(1670) + lu(1675) = lu(1675) - lu(746) * lu(1670) + lu(1676) = lu(1676) - lu(747) * lu(1670) + lu(1677) = lu(1677) - lu(748) * lu(1670) + lu(1678) = lu(1678) - lu(749) * lu(1670) + lu(1679) = lu(1679) - lu(750) * lu(1670) + lu(1680) = lu(1680) - lu(751) * lu(1670) + lu(1681) = lu(1681) - lu(752) * lu(1670) + lu(1682) = lu(1682) - lu(753) * lu(1670) + lu(1683) = lu(1683) - lu(754) * lu(1670) + lu(1684) = lu(1684) - lu(755) * lu(1670) + lu(1685) = lu(1685) - lu(756) * lu(1670) + lu(1686) = lu(1686) - lu(757) * lu(1670) + lu(1688) = lu(1688) - lu(758) * lu(1670) + lu(1689) = lu(1689) - lu(759) * lu(1670) + lu(1690) = lu(1690) - lu(760) * lu(1670) + lu(1691) = lu(1691) - lu(761) * lu(1670) + lu(1693) = lu(1693) - lu(762) * lu(1670) + lu(1694) = lu(1694) - lu(763) * lu(1670) + lu(1695) = lu(1695) - lu(764) * lu(1670) + lu(1696) = lu(1696) - lu(765) * lu(1670) + lu(1712) = lu(1712) - lu(745) * lu(1710) + lu(1715) = lu(1715) - lu(746) * lu(1710) + lu(1716) = lu(1716) - lu(747) * lu(1710) + lu(1717) = lu(1717) - lu(748) * lu(1710) + lu(1718) = lu(1718) - lu(749) * lu(1710) + lu(1719) = lu(1719) - lu(750) * lu(1710) + lu(1720) = lu(1720) - lu(751) * lu(1710) + lu(1721) = lu(1721) - lu(752) * lu(1710) + lu(1722) = lu(1722) - lu(753) * lu(1710) + lu(1723) = lu(1723) - lu(754) * lu(1710) + lu(1724) = lu(1724) - lu(755) * lu(1710) + lu(1725) = lu(1725) - lu(756) * lu(1710) + lu(1726) = lu(1726) - lu(757) * lu(1710) + lu(1728) = lu(1728) - lu(758) * lu(1710) + lu(1729) = lu(1729) - lu(759) * lu(1710) + lu(1730) = lu(1730) - lu(760) * lu(1710) + lu(1731) = lu(1731) - lu(761) * lu(1710) + lu(1733) = lu(1733) - lu(762) * lu(1710) + lu(1734) = lu(1734) - lu(763) * lu(1710) + lu(1735) = lu(1735) - lu(764) * lu(1710) + lu(1736) = lu(1736) - lu(765) * lu(1710) + lu(1758) = lu(1758) - lu(745) * lu(1756) + lu(1761) = lu(1761) - lu(746) * lu(1756) + lu(1762) = lu(1762) - lu(747) * lu(1756) + lu(1763) = lu(1763) - lu(748) * lu(1756) + lu(1764) = lu(1764) - lu(749) * lu(1756) + lu(1765) = lu(1765) - lu(750) * lu(1756) + lu(1766) = lu(1766) - lu(751) * lu(1756) + lu(1767) = lu(1767) - lu(752) * lu(1756) + lu(1768) = lu(1768) - lu(753) * lu(1756) + lu(1769) = lu(1769) - lu(754) * lu(1756) + lu(1770) = lu(1770) - lu(755) * lu(1756) + lu(1771) = lu(1771) - lu(756) * lu(1756) + lu(1772) = lu(1772) - lu(757) * lu(1756) + lu(1774) = lu(1774) - lu(758) * lu(1756) + lu(1775) = lu(1775) - lu(759) * lu(1756) + lu(1776) = lu(1776) - lu(760) * lu(1756) + lu(1777) = lu(1777) - lu(761) * lu(1756) + lu(1779) = lu(1779) - lu(762) * lu(1756) + lu(1780) = lu(1780) - lu(763) * lu(1756) + lu(1781) = lu(1781) - lu(764) * lu(1756) + lu(1782) = lu(1782) - lu(765) * lu(1756) + lu(1794) = lu(1794) - lu(745) * lu(1792) + lu(1797) = lu(1797) - lu(746) * lu(1792) + lu(1798) = lu(1798) - lu(747) * lu(1792) + lu(1799) = lu(1799) - lu(748) * lu(1792) + lu(1800) = lu(1800) - lu(749) * lu(1792) + lu(1801) = lu(1801) - lu(750) * lu(1792) + lu(1802) = lu(1802) - lu(751) * lu(1792) + lu(1803) = lu(1803) - lu(752) * lu(1792) + lu(1804) = lu(1804) - lu(753) * lu(1792) + lu(1805) = lu(1805) - lu(754) * lu(1792) + lu(1806) = lu(1806) - lu(755) * lu(1792) + lu(1807) = lu(1807) - lu(756) * lu(1792) + lu(1808) = lu(1808) - lu(757) * lu(1792) + lu(1810) = lu(1810) - lu(758) * lu(1792) + lu(1811) = lu(1811) - lu(759) * lu(1792) + lu(1812) = lu(1812) - lu(760) * lu(1792) + lu(1813) = lu(1813) - lu(761) * lu(1792) + lu(1815) = lu(1815) - lu(762) * lu(1792) + lu(1816) = lu(1816) - lu(763) * lu(1792) + lu(1817) = lu(1817) - lu(764) * lu(1792) + lu(1818) = lu(1818) - lu(765) * lu(1792) + lu(1836) = lu(1836) - lu(745) * lu(1834) + lu(1839) = lu(1839) - lu(746) * lu(1834) + lu(1840) = lu(1840) - lu(747) * lu(1834) + lu(1841) = lu(1841) - lu(748) * lu(1834) + lu(1842) = lu(1842) - lu(749) * lu(1834) + lu(1843) = lu(1843) - lu(750) * lu(1834) + lu(1844) = lu(1844) - lu(751) * lu(1834) + lu(1845) = lu(1845) - lu(752) * lu(1834) + lu(1846) = lu(1846) - lu(753) * lu(1834) + lu(1847) = lu(1847) - lu(754) * lu(1834) + lu(1848) = lu(1848) - lu(755) * lu(1834) + lu(1849) = lu(1849) - lu(756) * lu(1834) + lu(1850) = lu(1850) - lu(757) * lu(1834) + lu(1852) = lu(1852) - lu(758) * lu(1834) + lu(1853) = lu(1853) - lu(759) * lu(1834) + lu(1854) = lu(1854) - lu(760) * lu(1834) + lu(1855) = lu(1855) - lu(761) * lu(1834) + lu(1857) = lu(1857) - lu(762) * lu(1834) + lu(1858) = lu(1858) - lu(763) * lu(1834) + lu(1859) = lu(1859) - lu(764) * lu(1834) + lu(1860) = lu(1860) - lu(765) * lu(1834) + lu(1882) = lu(1882) - lu(745) * lu(1880) + lu(1885) = lu(1885) - lu(746) * lu(1880) + lu(1886) = lu(1886) - lu(747) * lu(1880) + lu(1887) = lu(1887) - lu(748) * lu(1880) + lu(1888) = lu(1888) - lu(749) * lu(1880) + lu(1889) = lu(1889) - lu(750) * lu(1880) + lu(1890) = lu(1890) - lu(751) * lu(1880) + lu(1891) = lu(1891) - lu(752) * lu(1880) + lu(1892) = lu(1892) - lu(753) * lu(1880) + lu(1893) = lu(1893) - lu(754) * lu(1880) + lu(1894) = lu(1894) - lu(755) * lu(1880) + lu(1895) = lu(1895) - lu(756) * lu(1880) + lu(1896) = lu(1896) - lu(757) * lu(1880) + lu(1898) = lu(1898) - lu(758) * lu(1880) + lu(1899) = lu(1899) - lu(759) * lu(1880) + lu(1900) = lu(1900) - lu(760) * lu(1880) + lu(1901) = lu(1901) - lu(761) * lu(1880) + lu(1903) = lu(1903) - lu(762) * lu(1880) + lu(1904) = lu(1904) - lu(763) * lu(1880) + lu(1905) = lu(1905) - lu(764) * lu(1880) + lu(1906) = lu(1906) - lu(765) * lu(1880) + lu(770) = 1._r8 / lu(770) + lu(771) = lu(771) * lu(770) + lu(772) = lu(772) * lu(770) + lu(773) = lu(773) * lu(770) + lu(774) = lu(774) * lu(770) + lu(775) = lu(775) * lu(770) + lu(776) = lu(776) * lu(770) + lu(777) = lu(777) * lu(770) + lu(778) = lu(778) * lu(770) + lu(779) = lu(779) * lu(770) + lu(780) = lu(780) * lu(770) + lu(781) = lu(781) * lu(770) + lu(782) = lu(782) * lu(770) + lu(783) = lu(783) * lu(770) + lu(784) = lu(784) * lu(770) + lu(785) = lu(785) * lu(770) + lu(786) = lu(786) * lu(770) + lu(787) = lu(787) * lu(770) + lu(788) = lu(788) * lu(770) + lu(789) = lu(789) * lu(770) + lu(790) = lu(790) * lu(770) + lu(791) = lu(791) * lu(770) + lu(792) = lu(792) * lu(770) + lu(848) = lu(848) - lu(771) * lu(847) + lu(850) = lu(850) - lu(772) * lu(847) + lu(851) = lu(851) - lu(773) * lu(847) + lu(852) = lu(852) - lu(774) * lu(847) + lu(853) = lu(853) - lu(775) * lu(847) + lu(854) = lu(854) - lu(776) * lu(847) + lu(855) = lu(855) - lu(777) * lu(847) + lu(856) = lu(856) - lu(778) * lu(847) + lu(857) = lu(857) - lu(779) * lu(847) + lu(858) = lu(858) - lu(780) * lu(847) + lu(860) = lu(860) - lu(781) * lu(847) + lu(861) = lu(861) - lu(782) * lu(847) + lu(863) = lu(863) - lu(783) * lu(847) + lu(864) = lu(864) - lu(784) * lu(847) + lu(865) = lu(865) - lu(785) * lu(847) + lu(866) = lu(866) - lu(786) * lu(847) + lu(867) = lu(867) - lu(787) * lu(847) + lu(868) = lu(868) - lu(788) * lu(847) + lu(869) = lu(869) - lu(789) * lu(847) + lu(870) = lu(870) - lu(790) * lu(847) + lu(872) = lu(872) - lu(791) * lu(847) + lu(873) = lu(873) - lu(792) * lu(847) + lu(891) = lu(891) - lu(771) * lu(890) + lu(893) = lu(893) - lu(772) * lu(890) + lu(894) = lu(894) - lu(773) * lu(890) + lu(895) = lu(895) - lu(774) * lu(890) + lu(896) = lu(896) - lu(775) * lu(890) + lu(897) = lu(897) - lu(776) * lu(890) + lu(898) = lu(898) - lu(777) * lu(890) + lu(899) = lu(899) - lu(778) * lu(890) + lu(900) = lu(900) - lu(779) * lu(890) + lu(901) = lu(901) - lu(780) * lu(890) + lu(903) = lu(903) - lu(781) * lu(890) + lu(904) = lu(904) - lu(782) * lu(890) + lu(906) = lu(906) - lu(783) * lu(890) + lu(907) = lu(907) - lu(784) * lu(890) + lu(908) = lu(908) - lu(785) * lu(890) + lu(909) = lu(909) - lu(786) * lu(890) + lu(910) = lu(910) - lu(787) * lu(890) + lu(911) = lu(911) - lu(788) * lu(890) + lu(912) = lu(912) - lu(789) * lu(890) + lu(913) = lu(913) - lu(790) * lu(890) + lu(915) = lu(915) - lu(791) * lu(890) + lu(916) = lu(916) - lu(792) * lu(890) + lu(928) = lu(928) - lu(771) * lu(927) + lu(930) = lu(930) - lu(772) * lu(927) + lu(931) = lu(931) - lu(773) * lu(927) + lu(932) = lu(932) - lu(774) * lu(927) + lu(933) = lu(933) - lu(775) * lu(927) + lu(934) = lu(934) - lu(776) * lu(927) + lu(935) = lu(935) - lu(777) * lu(927) + lu(936) = lu(936) - lu(778) * lu(927) + lu(937) = lu(937) - lu(779) * lu(927) + lu(938) = lu(938) - lu(780) * lu(927) + lu(940) = lu(940) - lu(781) * lu(927) + lu(941) = lu(941) - lu(782) * lu(927) + lu(943) = lu(943) - lu(783) * lu(927) + lu(944) = lu(944) - lu(784) * lu(927) + lu(945) = lu(945) - lu(785) * lu(927) + lu(946) = lu(946) - lu(786) * lu(927) + lu(947) = lu(947) - lu(787) * lu(927) + lu(948) = lu(948) - lu(788) * lu(927) + lu(949) = lu(949) - lu(789) * lu(927) + lu(950) = lu(950) - lu(790) * lu(927) + lu(952) = lu(952) - lu(791) * lu(927) + lu(953) = lu(953) - lu(792) * lu(927) + lu(961) = lu(961) - lu(771) * lu(960) + lu(963) = lu(963) - lu(772) * lu(960) + lu(964) = lu(964) - lu(773) * lu(960) + lu(965) = lu(965) - lu(774) * lu(960) + lu(966) = lu(966) - lu(775) * lu(960) + lu(967) = lu(967) - lu(776) * lu(960) + lu(968) = lu(968) - lu(777) * lu(960) + lu(969) = lu(969) - lu(778) * lu(960) + lu(970) = lu(970) - lu(779) * lu(960) + lu(971) = lu(971) - lu(780) * lu(960) + lu(973) = lu(973) - lu(781) * lu(960) + lu(974) = lu(974) - lu(782) * lu(960) + lu(976) = lu(976) - lu(783) * lu(960) + lu(977) = lu(977) - lu(784) * lu(960) + lu(978) = lu(978) - lu(785) * lu(960) + lu(979) = lu(979) - lu(786) * lu(960) + lu(980) = lu(980) - lu(787) * lu(960) + lu(981) = lu(981) - lu(788) * lu(960) + lu(982) = lu(982) - lu(789) * lu(960) + lu(983) = lu(983) - lu(790) * lu(960) + lu(985) = lu(985) - lu(791) * lu(960) + lu(986) = lu(986) - lu(792) * lu(960) + lu(1005) = lu(1005) - lu(771) * lu(1004) + lu(1007) = lu(1007) - lu(772) * lu(1004) + lu(1008) = lu(1008) - lu(773) * lu(1004) + lu(1009) = lu(1009) - lu(774) * lu(1004) + lu(1010) = lu(1010) - lu(775) * lu(1004) + lu(1011) = lu(1011) - lu(776) * lu(1004) + lu(1012) = lu(1012) - lu(777) * lu(1004) + lu(1013) = lu(1013) - lu(778) * lu(1004) + lu(1014) = lu(1014) - lu(779) * lu(1004) + lu(1015) = lu(1015) - lu(780) * lu(1004) + lu(1017) = lu(1017) - lu(781) * lu(1004) + lu(1018) = lu(1018) - lu(782) * lu(1004) + lu(1020) = lu(1020) - lu(783) * lu(1004) + lu(1021) = lu(1021) - lu(784) * lu(1004) + lu(1022) = lu(1022) - lu(785) * lu(1004) + lu(1023) = lu(1023) - lu(786) * lu(1004) + lu(1024) = lu(1024) - lu(787) * lu(1004) + lu(1025) = lu(1025) - lu(788) * lu(1004) + lu(1026) = lu(1026) - lu(789) * lu(1004) + lu(1027) = lu(1027) - lu(790) * lu(1004) + lu(1029) = lu(1029) - lu(791) * lu(1004) + lu(1030) = lu(1030) - lu(792) * lu(1004) + lu(1045) = lu(1045) - lu(771) * lu(1044) + lu(1047) = lu(1047) - lu(772) * lu(1044) + lu(1048) = lu(1048) - lu(773) * lu(1044) + lu(1049) = lu(1049) - lu(774) * lu(1044) + lu(1050) = lu(1050) - lu(775) * lu(1044) + lu(1051) = lu(1051) - lu(776) * lu(1044) + lu(1052) = lu(1052) - lu(777) * lu(1044) + lu(1053) = lu(1053) - lu(778) * lu(1044) + lu(1054) = lu(1054) - lu(779) * lu(1044) + lu(1055) = lu(1055) - lu(780) * lu(1044) + lu(1057) = lu(1057) - lu(781) * lu(1044) + lu(1058) = lu(1058) - lu(782) * lu(1044) + lu(1060) = lu(1060) - lu(783) * lu(1044) + lu(1061) = lu(1061) - lu(784) * lu(1044) + lu(1062) = lu(1062) - lu(785) * lu(1044) + lu(1063) = lu(1063) - lu(786) * lu(1044) + lu(1064) = lu(1064) - lu(787) * lu(1044) + lu(1065) = lu(1065) - lu(788) * lu(1044) + lu(1066) = lu(1066) - lu(789) * lu(1044) + lu(1067) = lu(1067) - lu(790) * lu(1044) + lu(1069) = lu(1069) - lu(791) * lu(1044) + lu(1070) = lu(1070) - lu(792) * lu(1044) + lu(1103) = lu(1103) - lu(771) * lu(1102) + lu(1105) = lu(1105) - lu(772) * lu(1102) + lu(1106) = lu(1106) - lu(773) * lu(1102) + lu(1107) = lu(1107) - lu(774) * lu(1102) + lu(1108) = lu(1108) - lu(775) * lu(1102) + lu(1109) = lu(1109) - lu(776) * lu(1102) + lu(1110) = lu(1110) - lu(777) * lu(1102) + lu(1111) = lu(1111) - lu(778) * lu(1102) + lu(1112) = lu(1112) - lu(779) * lu(1102) + lu(1113) = lu(1113) - lu(780) * lu(1102) + lu(1115) = lu(1115) - lu(781) * lu(1102) + lu(1116) = lu(1116) - lu(782) * lu(1102) + lu(1118) = lu(1118) - lu(783) * lu(1102) + lu(1119) = lu(1119) - lu(784) * lu(1102) + lu(1120) = lu(1120) - lu(785) * lu(1102) + lu(1121) = lu(1121) - lu(786) * lu(1102) + lu(1122) = lu(1122) - lu(787) * lu(1102) + lu(1123) = lu(1123) - lu(788) * lu(1102) + lu(1124) = lu(1124) - lu(789) * lu(1102) + lu(1125) = lu(1125) - lu(790) * lu(1102) + lu(1127) = lu(1127) - lu(791) * lu(1102) + lu(1128) = lu(1128) - lu(792) * lu(1102) + lu(1189) = lu(1189) - lu(771) * lu(1188) + lu(1191) = lu(1191) - lu(772) * lu(1188) + lu(1192) = lu(1192) - lu(773) * lu(1188) + lu(1193) = lu(1193) - lu(774) * lu(1188) + lu(1194) = lu(1194) - lu(775) * lu(1188) + lu(1195) = lu(1195) - lu(776) * lu(1188) + lu(1196) = lu(1196) - lu(777) * lu(1188) + lu(1197) = lu(1197) - lu(778) * lu(1188) + lu(1198) = lu(1198) - lu(779) * lu(1188) + lu(1199) = lu(1199) - lu(780) * lu(1188) + lu(1201) = lu(1201) - lu(781) * lu(1188) + lu(1202) = lu(1202) - lu(782) * lu(1188) + lu(1204) = lu(1204) - lu(783) * lu(1188) + lu(1205) = lu(1205) - lu(784) * lu(1188) + lu(1206) = lu(1206) - lu(785) * lu(1188) + lu(1207) = lu(1207) - lu(786) * lu(1188) + lu(1208) = lu(1208) - lu(787) * lu(1188) + lu(1209) = lu(1209) - lu(788) * lu(1188) + lu(1210) = lu(1210) - lu(789) * lu(1188) + lu(1211) = lu(1211) - lu(790) * lu(1188) + lu(1213) = lu(1213) - lu(791) * lu(1188) + lu(1214) = lu(1214) - lu(792) * lu(1188) + lu(1231) = lu(1231) - lu(771) * lu(1230) + lu(1233) = lu(1233) - lu(772) * lu(1230) + lu(1234) = lu(1234) - lu(773) * lu(1230) + lu(1235) = lu(1235) - lu(774) * lu(1230) + lu(1236) = lu(1236) - lu(775) * lu(1230) + lu(1237) = lu(1237) - lu(776) * lu(1230) + lu(1238) = lu(1238) - lu(777) * lu(1230) + lu(1239) = lu(1239) - lu(778) * lu(1230) + lu(1240) = lu(1240) - lu(779) * lu(1230) + lu(1241) = lu(1241) - lu(780) * lu(1230) + lu(1243) = lu(1243) - lu(781) * lu(1230) + lu(1244) = lu(1244) - lu(782) * lu(1230) + lu(1246) = lu(1246) - lu(783) * lu(1230) + lu(1247) = lu(1247) - lu(784) * lu(1230) + lu(1248) = lu(1248) - lu(785) * lu(1230) + lu(1249) = lu(1249) - lu(786) * lu(1230) + lu(1250) = lu(1250) - lu(787) * lu(1230) + lu(1251) = lu(1251) - lu(788) * lu(1230) + lu(1252) = lu(1252) - lu(789) * lu(1230) + lu(1253) = lu(1253) - lu(790) * lu(1230) + lu(1255) = lu(1255) - lu(791) * lu(1230) + lu(1256) = lu(1256) - lu(792) * lu(1230) + lu(1267) = lu(1267) - lu(771) * lu(1266) + lu(1269) = lu(1269) - lu(772) * lu(1266) + lu(1270) = lu(1270) - lu(773) * lu(1266) + lu(1271) = lu(1271) - lu(774) * lu(1266) + lu(1272) = lu(1272) - lu(775) * lu(1266) + lu(1273) = lu(1273) - lu(776) * lu(1266) + lu(1274) = lu(1274) - lu(777) * lu(1266) + lu(1275) = lu(1275) - lu(778) * lu(1266) + lu(1276) = lu(1276) - lu(779) * lu(1266) + lu(1277) = lu(1277) - lu(780) * lu(1266) + lu(1279) = lu(1279) - lu(781) * lu(1266) + lu(1280) = lu(1280) - lu(782) * lu(1266) + lu(1282) = lu(1282) - lu(783) * lu(1266) + lu(1283) = lu(1283) - lu(784) * lu(1266) + lu(1284) = lu(1284) - lu(785) * lu(1266) + lu(1285) = lu(1285) - lu(786) * lu(1266) + lu(1286) = lu(1286) - lu(787) * lu(1266) + lu(1287) = lu(1287) - lu(788) * lu(1266) + lu(1288) = lu(1288) - lu(789) * lu(1266) + lu(1289) = lu(1289) - lu(790) * lu(1266) + lu(1291) = lu(1291) - lu(791) * lu(1266) + lu(1292) = lu(1292) - lu(792) * lu(1266) + lu(1326) = lu(1326) - lu(771) * lu(1325) + lu(1328) = lu(1328) - lu(772) * lu(1325) + lu(1329) = lu(1329) - lu(773) * lu(1325) + lu(1330) = lu(1330) - lu(774) * lu(1325) + lu(1331) = lu(1331) - lu(775) * lu(1325) + lu(1332) = lu(1332) - lu(776) * lu(1325) + lu(1333) = lu(1333) - lu(777) * lu(1325) + lu(1334) = lu(1334) - lu(778) * lu(1325) + lu(1335) = lu(1335) - lu(779) * lu(1325) + lu(1336) = lu(1336) - lu(780) * lu(1325) + lu(1338) = lu(1338) - lu(781) * lu(1325) + lu(1339) = lu(1339) - lu(782) * lu(1325) + lu(1341) = lu(1341) - lu(783) * lu(1325) + lu(1342) = lu(1342) - lu(784) * lu(1325) + lu(1343) = lu(1343) - lu(785) * lu(1325) + lu(1344) = lu(1344) - lu(786) * lu(1325) + lu(1345) = lu(1345) - lu(787) * lu(1325) + lu(1346) = lu(1346) - lu(788) * lu(1325) + lu(1347) = lu(1347) - lu(789) * lu(1325) + lu(1348) = lu(1348) - lu(790) * lu(1325) + lu(1350) = lu(1350) - lu(791) * lu(1325) + lu(1351) = lu(1351) - lu(792) * lu(1325) + lu(1369) = lu(1369) - lu(771) * lu(1368) + lu(1371) = lu(1371) - lu(772) * lu(1368) + lu(1372) = lu(1372) - lu(773) * lu(1368) + lu(1373) = lu(1373) - lu(774) * lu(1368) + lu(1374) = lu(1374) - lu(775) * lu(1368) + lu(1375) = lu(1375) - lu(776) * lu(1368) + lu(1376) = lu(1376) - lu(777) * lu(1368) + lu(1377) = lu(1377) - lu(778) * lu(1368) + lu(1378) = lu(1378) - lu(779) * lu(1368) + lu(1379) = lu(1379) - lu(780) * lu(1368) + lu(1381) = lu(1381) - lu(781) * lu(1368) + lu(1382) = lu(1382) - lu(782) * lu(1368) + lu(1384) = lu(1384) - lu(783) * lu(1368) + lu(1385) = lu(1385) - lu(784) * lu(1368) + lu(1386) = lu(1386) - lu(785) * lu(1368) + lu(1387) = lu(1387) - lu(786) * lu(1368) + lu(1388) = lu(1388) - lu(787) * lu(1368) + lu(1389) = lu(1389) - lu(788) * lu(1368) + lu(1390) = lu(1390) - lu(789) * lu(1368) + lu(1391) = lu(1391) - lu(790) * lu(1368) + lu(1393) = lu(1393) - lu(791) * lu(1368) + lu(1394) = lu(1394) - lu(792) * lu(1368) + lu(1410) = lu(1410) - lu(771) * lu(1409) + lu(1412) = lu(1412) - lu(772) * lu(1409) + lu(1413) = lu(1413) - lu(773) * lu(1409) + lu(1414) = lu(1414) - lu(774) * lu(1409) + lu(1415) = lu(1415) - lu(775) * lu(1409) + lu(1416) = lu(1416) - lu(776) * lu(1409) + lu(1417) = lu(1417) - lu(777) * lu(1409) + lu(1418) = lu(1418) - lu(778) * lu(1409) + lu(1419) = lu(1419) - lu(779) * lu(1409) + lu(1420) = lu(1420) - lu(780) * lu(1409) + lu(1422) = lu(1422) - lu(781) * lu(1409) + lu(1423) = lu(1423) - lu(782) * lu(1409) + lu(1425) = lu(1425) - lu(783) * lu(1409) + lu(1426) = lu(1426) - lu(784) * lu(1409) + lu(1427) = lu(1427) - lu(785) * lu(1409) + lu(1428) = lu(1428) - lu(786) * lu(1409) + lu(1429) = lu(1429) - lu(787) * lu(1409) + lu(1430) = lu(1430) - lu(788) * lu(1409) + lu(1431) = lu(1431) - lu(789) * lu(1409) + lu(1432) = lu(1432) - lu(790) * lu(1409) + lu(1434) = lu(1434) - lu(791) * lu(1409) + lu(1435) = lu(1435) - lu(792) * lu(1409) + lu(1453) = lu(1453) - lu(771) * lu(1452) + lu(1455) = lu(1455) - lu(772) * lu(1452) + lu(1456) = lu(1456) - lu(773) * lu(1452) + lu(1457) = lu(1457) - lu(774) * lu(1452) + lu(1458) = lu(1458) - lu(775) * lu(1452) + lu(1459) = lu(1459) - lu(776) * lu(1452) + lu(1460) = lu(1460) - lu(777) * lu(1452) + lu(1461) = lu(1461) - lu(778) * lu(1452) + lu(1462) = lu(1462) - lu(779) * lu(1452) + lu(1463) = lu(1463) - lu(780) * lu(1452) + lu(1465) = lu(1465) - lu(781) * lu(1452) + lu(1466) = lu(1466) - lu(782) * lu(1452) + lu(1468) = lu(1468) - lu(783) * lu(1452) + lu(1469) = lu(1469) - lu(784) * lu(1452) + lu(1470) = lu(1470) - lu(785) * lu(1452) + lu(1471) = lu(1471) - lu(786) * lu(1452) + lu(1472) = lu(1472) - lu(787) * lu(1452) + lu(1473) = lu(1473) - lu(788) * lu(1452) + lu(1474) = lu(1474) - lu(789) * lu(1452) + lu(1475) = lu(1475) - lu(790) * lu(1452) + lu(1477) = lu(1477) - lu(791) * lu(1452) + lu(1478) = lu(1478) - lu(792) * lu(1452) + lu(1496) = lu(1496) - lu(771) * lu(1495) + lu(1498) = lu(1498) - lu(772) * lu(1495) + lu(1499) = lu(1499) - lu(773) * lu(1495) + lu(1500) = lu(1500) - lu(774) * lu(1495) + lu(1501) = lu(1501) - lu(775) * lu(1495) + lu(1502) = lu(1502) - lu(776) * lu(1495) + lu(1503) = lu(1503) - lu(777) * lu(1495) + lu(1504) = lu(1504) - lu(778) * lu(1495) + lu(1505) = lu(1505) - lu(779) * lu(1495) + lu(1506) = lu(1506) - lu(780) * lu(1495) + lu(1508) = lu(1508) - lu(781) * lu(1495) + lu(1509) = lu(1509) - lu(782) * lu(1495) + lu(1511) = lu(1511) - lu(783) * lu(1495) + lu(1512) = lu(1512) - lu(784) * lu(1495) + lu(1513) = lu(1513) - lu(785) * lu(1495) + lu(1514) = lu(1514) - lu(786) * lu(1495) + lu(1515) = lu(1515) - lu(787) * lu(1495) + lu(1516) = lu(1516) - lu(788) * lu(1495) + lu(1517) = lu(1517) - lu(789) * lu(1495) + lu(1518) = lu(1518) - lu(790) * lu(1495) + lu(1520) = lu(1520) - lu(791) * lu(1495) + lu(1521) = lu(1521) - lu(792) * lu(1495) + lu(1542) = lu(1542) - lu(771) * lu(1541) + lu(1544) = lu(1544) - lu(772) * lu(1541) + lu(1545) = lu(1545) - lu(773) * lu(1541) + lu(1546) = lu(1546) - lu(774) * lu(1541) + lu(1547) = lu(1547) - lu(775) * lu(1541) + lu(1548) = lu(1548) - lu(776) * lu(1541) + lu(1549) = lu(1549) - lu(777) * lu(1541) + lu(1550) = lu(1550) - lu(778) * lu(1541) + lu(1551) = lu(1551) - lu(779) * lu(1541) + lu(1552) = lu(1552) - lu(780) * lu(1541) + lu(1554) = lu(1554) - lu(781) * lu(1541) + lu(1555) = lu(1555) - lu(782) * lu(1541) + lu(1557) = lu(1557) - lu(783) * lu(1541) + lu(1558) = lu(1558) - lu(784) * lu(1541) + lu(1559) = lu(1559) - lu(785) * lu(1541) + lu(1560) = lu(1560) - lu(786) * lu(1541) + lu(1561) = lu(1561) - lu(787) * lu(1541) + lu(1562) = lu(1562) - lu(788) * lu(1541) + lu(1563) = lu(1563) - lu(789) * lu(1541) + lu(1564) = lu(1564) - lu(790) * lu(1541) + lu(1566) = lu(1566) - lu(791) * lu(1541) + lu(1567) = lu(1567) - lu(792) * lu(1541) + lu(1588) = lu(1588) - lu(771) * lu(1587) + lu(1590) = lu(1590) - lu(772) * lu(1587) + lu(1591) = lu(1591) - lu(773) * lu(1587) + lu(1592) = lu(1592) - lu(774) * lu(1587) + lu(1593) = lu(1593) - lu(775) * lu(1587) + lu(1594) = lu(1594) - lu(776) * lu(1587) + lu(1595) = lu(1595) - lu(777) * lu(1587) + lu(1596) = lu(1596) - lu(778) * lu(1587) + lu(1597) = lu(1597) - lu(779) * lu(1587) + lu(1598) = lu(1598) - lu(780) * lu(1587) + lu(1600) = lu(1600) - lu(781) * lu(1587) + lu(1601) = lu(1601) - lu(782) * lu(1587) + lu(1603) = lu(1603) - lu(783) * lu(1587) + lu(1604) = lu(1604) - lu(784) * lu(1587) + lu(1605) = lu(1605) - lu(785) * lu(1587) + lu(1606) = lu(1606) - lu(786) * lu(1587) + lu(1607) = lu(1607) - lu(787) * lu(1587) + lu(1608) = lu(1608) - lu(788) * lu(1587) + lu(1609) = lu(1609) - lu(789) * lu(1587) + lu(1610) = lu(1610) - lu(790) * lu(1587) + lu(1612) = lu(1612) - lu(791) * lu(1587) + lu(1613) = lu(1613) - lu(792) * lu(1587) + lu(1630) = lu(1630) - lu(771) * lu(1629) + lu(1631) = lu(1631) - lu(772) * lu(1629) + lu(1632) = lu(1632) - lu(773) * lu(1629) + lu(1633) = lu(1633) - lu(774) * lu(1629) + lu(1634) = lu(1634) - lu(775) * lu(1629) + lu(1635) = lu(1635) - lu(776) * lu(1629) + lu(1636) = lu(1636) - lu(777) * lu(1629) + lu(1637) = lu(1637) - lu(778) * lu(1629) + lu(1638) = lu(1638) - lu(779) * lu(1629) + lu(1639) = lu(1639) - lu(780) * lu(1629) + lu(1641) = lu(1641) - lu(781) * lu(1629) + lu(1642) = lu(1642) - lu(782) * lu(1629) + lu(1644) = lu(1644) - lu(783) * lu(1629) + lu(1645) = lu(1645) - lu(784) * lu(1629) + lu(1646) = lu(1646) - lu(785) * lu(1629) + lu(1647) = lu(1647) - lu(786) * lu(1629) + lu(1648) = lu(1648) - lu(787) * lu(1629) + lu(1649) = lu(1649) - lu(788) * lu(1629) + lu(1650) = lu(1650) - lu(789) * lu(1629) + lu(1651) = lu(1651) - lu(790) * lu(1629) + lu(1653) = lu(1653) - lu(791) * lu(1629) + lu(1654) = lu(1654) - lu(792) * lu(1629) + lu(1672) = lu(1672) - lu(771) * lu(1671) + lu(1674) = lu(1674) - lu(772) * lu(1671) + lu(1675) = lu(1675) - lu(773) * lu(1671) + lu(1676) = lu(1676) - lu(774) * lu(1671) + lu(1677) = lu(1677) - lu(775) * lu(1671) + lu(1678) = lu(1678) - lu(776) * lu(1671) + lu(1679) = lu(1679) - lu(777) * lu(1671) + lu(1680) = lu(1680) - lu(778) * lu(1671) + lu(1681) = lu(1681) - lu(779) * lu(1671) + lu(1682) = lu(1682) - lu(780) * lu(1671) + lu(1684) = lu(1684) - lu(781) * lu(1671) + lu(1685) = lu(1685) - lu(782) * lu(1671) + lu(1687) = lu(1687) - lu(783) * lu(1671) + lu(1688) = lu(1688) - lu(784) * lu(1671) + lu(1689) = lu(1689) - lu(785) * lu(1671) + lu(1690) = lu(1690) - lu(786) * lu(1671) + lu(1691) = lu(1691) - lu(787) * lu(1671) + lu(1692) = lu(1692) - lu(788) * lu(1671) + lu(1693) = lu(1693) - lu(789) * lu(1671) + lu(1694) = lu(1694) - lu(790) * lu(1671) + lu(1696) = lu(1696) - lu(791) * lu(1671) + lu(1697) = lu(1697) - lu(792) * lu(1671) + lu(1712) = lu(1712) - lu(771) * lu(1711) + lu(1714) = lu(1714) - lu(772) * lu(1711) + lu(1715) = lu(1715) - lu(773) * lu(1711) + lu(1716) = lu(1716) - lu(774) * lu(1711) + lu(1717) = lu(1717) - lu(775) * lu(1711) + lu(1718) = lu(1718) - lu(776) * lu(1711) + lu(1719) = lu(1719) - lu(777) * lu(1711) + lu(1720) = lu(1720) - lu(778) * lu(1711) + lu(1721) = lu(1721) - lu(779) * lu(1711) + lu(1722) = lu(1722) - lu(780) * lu(1711) + lu(1724) = lu(1724) - lu(781) * lu(1711) + lu(1725) = lu(1725) - lu(782) * lu(1711) + lu(1727) = lu(1727) - lu(783) * lu(1711) + lu(1728) = lu(1728) - lu(784) * lu(1711) + lu(1729) = lu(1729) - lu(785) * lu(1711) + lu(1730) = lu(1730) - lu(786) * lu(1711) + lu(1731) = lu(1731) - lu(787) * lu(1711) + lu(1732) = lu(1732) - lu(788) * lu(1711) + lu(1733) = lu(1733) - lu(789) * lu(1711) + lu(1734) = lu(1734) - lu(790) * lu(1711) + lu(1736) = lu(1736) - lu(791) * lu(1711) + lu(1737) = lu(1737) - lu(792) * lu(1711) + lu(1758) = lu(1758) - lu(771) * lu(1757) + lu(1760) = lu(1760) - lu(772) * lu(1757) + lu(1761) = lu(1761) - lu(773) * lu(1757) + lu(1762) = lu(1762) - lu(774) * lu(1757) + lu(1763) = lu(1763) - lu(775) * lu(1757) + lu(1764) = lu(1764) - lu(776) * lu(1757) + lu(1765) = lu(1765) - lu(777) * lu(1757) + lu(1766) = lu(1766) - lu(778) * lu(1757) + lu(1767) = lu(1767) - lu(779) * lu(1757) + lu(1768) = lu(1768) - lu(780) * lu(1757) + lu(1770) = lu(1770) - lu(781) * lu(1757) + lu(1771) = lu(1771) - lu(782) * lu(1757) + lu(1773) = lu(1773) - lu(783) * lu(1757) + lu(1774) = lu(1774) - lu(784) * lu(1757) + lu(1775) = lu(1775) - lu(785) * lu(1757) + lu(1776) = lu(1776) - lu(786) * lu(1757) + lu(1777) = lu(1777) - lu(787) * lu(1757) + lu(1778) = lu(1778) - lu(788) * lu(1757) + lu(1779) = lu(1779) - lu(789) * lu(1757) + lu(1780) = lu(1780) - lu(790) * lu(1757) + lu(1782) = lu(1782) - lu(791) * lu(1757) + lu(1783) = lu(1783) - lu(792) * lu(1757) + lu(1794) = lu(1794) - lu(771) * lu(1793) + lu(1796) = lu(1796) - lu(772) * lu(1793) + lu(1797) = lu(1797) - lu(773) * lu(1793) + lu(1798) = lu(1798) - lu(774) * lu(1793) + lu(1799) = lu(1799) - lu(775) * lu(1793) + lu(1800) = lu(1800) - lu(776) * lu(1793) + lu(1801) = lu(1801) - lu(777) * lu(1793) + lu(1802) = lu(1802) - lu(778) * lu(1793) + lu(1803) = lu(1803) - lu(779) * lu(1793) + lu(1804) = lu(1804) - lu(780) * lu(1793) + lu(1806) = lu(1806) - lu(781) * lu(1793) + lu(1807) = lu(1807) - lu(782) * lu(1793) + lu(1809) = lu(1809) - lu(783) * lu(1793) + lu(1810) = lu(1810) - lu(784) * lu(1793) + lu(1811) = lu(1811) - lu(785) * lu(1793) + lu(1812) = lu(1812) - lu(786) * lu(1793) + lu(1813) = lu(1813) - lu(787) * lu(1793) + lu(1814) = lu(1814) - lu(788) * lu(1793) + lu(1815) = lu(1815) - lu(789) * lu(1793) + lu(1816) = lu(1816) - lu(790) * lu(1793) + lu(1818) = lu(1818) - lu(791) * lu(1793) + lu(1819) = lu(1819) - lu(792) * lu(1793) + lu(1836) = lu(1836) - lu(771) * lu(1835) + lu(1838) = lu(1838) - lu(772) * lu(1835) + lu(1839) = lu(1839) - lu(773) * lu(1835) + lu(1840) = lu(1840) - lu(774) * lu(1835) + lu(1841) = lu(1841) - lu(775) * lu(1835) + lu(1842) = lu(1842) - lu(776) * lu(1835) + lu(1843) = lu(1843) - lu(777) * lu(1835) + lu(1844) = lu(1844) - lu(778) * lu(1835) + lu(1845) = lu(1845) - lu(779) * lu(1835) + lu(1846) = lu(1846) - lu(780) * lu(1835) + lu(1848) = lu(1848) - lu(781) * lu(1835) + lu(1849) = lu(1849) - lu(782) * lu(1835) + lu(1851) = lu(1851) - lu(783) * lu(1835) + lu(1852) = lu(1852) - lu(784) * lu(1835) + lu(1853) = lu(1853) - lu(785) * lu(1835) + lu(1854) = lu(1854) - lu(786) * lu(1835) + lu(1855) = lu(1855) - lu(787) * lu(1835) + lu(1856) = lu(1856) - lu(788) * lu(1835) + lu(1857) = lu(1857) - lu(789) * lu(1835) + lu(1858) = lu(1858) - lu(790) * lu(1835) + lu(1860) = lu(1860) - lu(791) * lu(1835) + lu(1861) = lu(1861) - lu(792) * lu(1835) + lu(1882) = lu(1882) - lu(771) * lu(1881) + lu(1884) = lu(1884) - lu(772) * lu(1881) + lu(1885) = lu(1885) - lu(773) * lu(1881) + lu(1886) = lu(1886) - lu(774) * lu(1881) + lu(1887) = lu(1887) - lu(775) * lu(1881) + lu(1888) = lu(1888) - lu(776) * lu(1881) + lu(1889) = lu(1889) - lu(777) * lu(1881) + lu(1890) = lu(1890) - lu(778) * lu(1881) + lu(1891) = lu(1891) - lu(779) * lu(1881) + lu(1892) = lu(1892) - lu(780) * lu(1881) + lu(1894) = lu(1894) - lu(781) * lu(1881) + lu(1895) = lu(1895) - lu(782) * lu(1881) + lu(1897) = lu(1897) - lu(783) * lu(1881) + lu(1898) = lu(1898) - lu(784) * lu(1881) + lu(1899) = lu(1899) - lu(785) * lu(1881) + lu(1900) = lu(1900) - lu(786) * lu(1881) + lu(1901) = lu(1901) - lu(787) * lu(1881) + lu(1902) = lu(1902) - lu(788) * lu(1881) + lu(1903) = lu(1903) - lu(789) * lu(1881) + lu(1904) = lu(1904) - lu(790) * lu(1881) + lu(1906) = lu(1906) - lu(791) * lu(1881) + lu(1907) = lu(1907) - lu(792) * lu(1881) + end subroutine lu_fac17 + subroutine lu_fac18( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(819) = 1._r8 / lu(819) + lu(820) = lu(820) * lu(819) + lu(821) = lu(821) * lu(819) + lu(822) = lu(822) * lu(819) + lu(823) = lu(823) * lu(819) + lu(824) = lu(824) * lu(819) + lu(825) = lu(825) * lu(819) + lu(826) = lu(826) * lu(819) + lu(827) = lu(827) * lu(819) + lu(828) = lu(828) * lu(819) + lu(829) = lu(829) * lu(819) + lu(830) = lu(830) * lu(819) + lu(831) = lu(831) * lu(819) + lu(832) = lu(832) * lu(819) + lu(833) = lu(833) * lu(819) + lu(834) = lu(834) * lu(819) + lu(835) = lu(835) * lu(819) + lu(836) = lu(836) * lu(819) + lu(837) = lu(837) * lu(819) + lu(838) = lu(838) * lu(819) + lu(839) = lu(839) * lu(819) + lu(840) = lu(840) * lu(819) + lu(851) = lu(851) - lu(820) * lu(848) + lu(852) = lu(852) - lu(821) * lu(848) + lu(853) = lu(853) - lu(822) * lu(848) + lu(854) = lu(854) - lu(823) * lu(848) + lu(855) = lu(855) - lu(824) * lu(848) + lu(856) = lu(856) - lu(825) * lu(848) + lu(857) = lu(857) - lu(826) * lu(848) + lu(858) = lu(858) - lu(827) * lu(848) + lu(859) = lu(859) - lu(828) * lu(848) + lu(860) = lu(860) - lu(829) * lu(848) + lu(861) = lu(861) - lu(830) * lu(848) + lu(862) = lu(862) - lu(831) * lu(848) + lu(864) = lu(864) - lu(832) * lu(848) + lu(865) = lu(865) - lu(833) * lu(848) + lu(866) = lu(866) - lu(834) * lu(848) + lu(867) = lu(867) - lu(835) * lu(848) + lu(869) = lu(869) - lu(836) * lu(848) + lu(870) = lu(870) - lu(837) * lu(848) + lu(871) = lu(871) - lu(838) * lu(848) + lu(872) = lu(872) - lu(839) * lu(848) + lu(873) = lu(873) - lu(840) * lu(848) + lu(894) = lu(894) - lu(820) * lu(891) + lu(895) = lu(895) - lu(821) * lu(891) + lu(896) = lu(896) - lu(822) * lu(891) + lu(897) = lu(897) - lu(823) * lu(891) + lu(898) = lu(898) - lu(824) * lu(891) + lu(899) = lu(899) - lu(825) * lu(891) + lu(900) = lu(900) - lu(826) * lu(891) + lu(901) = lu(901) - lu(827) * lu(891) + lu(902) = lu(902) - lu(828) * lu(891) + lu(903) = lu(903) - lu(829) * lu(891) + lu(904) = lu(904) - lu(830) * lu(891) + lu(905) = lu(905) - lu(831) * lu(891) + lu(907) = lu(907) - lu(832) * lu(891) + lu(908) = lu(908) - lu(833) * lu(891) + lu(909) = lu(909) - lu(834) * lu(891) + lu(910) = lu(910) - lu(835) * lu(891) + lu(912) = lu(912) - lu(836) * lu(891) + lu(913) = lu(913) - lu(837) * lu(891) + lu(914) = lu(914) - lu(838) * lu(891) + lu(915) = lu(915) - lu(839) * lu(891) + lu(916) = lu(916) - lu(840) * lu(891) + lu(931) = lu(931) - lu(820) * lu(928) + lu(932) = lu(932) - lu(821) * lu(928) + lu(933) = lu(933) - lu(822) * lu(928) + lu(934) = lu(934) - lu(823) * lu(928) + lu(935) = lu(935) - lu(824) * lu(928) + lu(936) = lu(936) - lu(825) * lu(928) + lu(937) = lu(937) - lu(826) * lu(928) + lu(938) = lu(938) - lu(827) * lu(928) + lu(939) = lu(939) - lu(828) * lu(928) + lu(940) = lu(940) - lu(829) * lu(928) + lu(941) = lu(941) - lu(830) * lu(928) + lu(942) = lu(942) - lu(831) * lu(928) + lu(944) = lu(944) - lu(832) * lu(928) + lu(945) = lu(945) - lu(833) * lu(928) + lu(946) = lu(946) - lu(834) * lu(928) + lu(947) = lu(947) - lu(835) * lu(928) + lu(949) = lu(949) - lu(836) * lu(928) + lu(950) = lu(950) - lu(837) * lu(928) + lu(951) = lu(951) - lu(838) * lu(928) + lu(952) = lu(952) - lu(839) * lu(928) + lu(953) = lu(953) - lu(840) * lu(928) + lu(964) = lu(964) - lu(820) * lu(961) + lu(965) = lu(965) - lu(821) * lu(961) + lu(966) = lu(966) - lu(822) * lu(961) + lu(967) = lu(967) - lu(823) * lu(961) + lu(968) = lu(968) - lu(824) * lu(961) + lu(969) = lu(969) - lu(825) * lu(961) + lu(970) = lu(970) - lu(826) * lu(961) + lu(971) = lu(971) - lu(827) * lu(961) + lu(972) = lu(972) - lu(828) * lu(961) + lu(973) = lu(973) - lu(829) * lu(961) + lu(974) = lu(974) - lu(830) * lu(961) + lu(975) = lu(975) - lu(831) * lu(961) + lu(977) = lu(977) - lu(832) * lu(961) + lu(978) = lu(978) - lu(833) * lu(961) + lu(979) = lu(979) - lu(834) * lu(961) + lu(980) = lu(980) - lu(835) * lu(961) + lu(982) = lu(982) - lu(836) * lu(961) + lu(983) = lu(983) - lu(837) * lu(961) + lu(984) = lu(984) - lu(838) * lu(961) + lu(985) = lu(985) - lu(839) * lu(961) + lu(986) = lu(986) - lu(840) * lu(961) + lu(1008) = lu(1008) - lu(820) * lu(1005) + lu(1009) = lu(1009) - lu(821) * lu(1005) + lu(1010) = lu(1010) - lu(822) * lu(1005) + lu(1011) = lu(1011) - lu(823) * lu(1005) + lu(1012) = lu(1012) - lu(824) * lu(1005) + lu(1013) = lu(1013) - lu(825) * lu(1005) + lu(1014) = lu(1014) - lu(826) * lu(1005) + lu(1015) = lu(1015) - lu(827) * lu(1005) + lu(1016) = lu(1016) - lu(828) * lu(1005) + lu(1017) = lu(1017) - lu(829) * lu(1005) + lu(1018) = lu(1018) - lu(830) * lu(1005) + lu(1019) = lu(1019) - lu(831) * lu(1005) + lu(1021) = lu(1021) - lu(832) * lu(1005) + lu(1022) = lu(1022) - lu(833) * lu(1005) + lu(1023) = lu(1023) - lu(834) * lu(1005) + lu(1024) = lu(1024) - lu(835) * lu(1005) + lu(1026) = lu(1026) - lu(836) * lu(1005) + lu(1027) = lu(1027) - lu(837) * lu(1005) + lu(1028) = lu(1028) - lu(838) * lu(1005) + lu(1029) = lu(1029) - lu(839) * lu(1005) + lu(1030) = lu(1030) - lu(840) * lu(1005) + lu(1048) = lu(1048) - lu(820) * lu(1045) + lu(1049) = lu(1049) - lu(821) * lu(1045) + lu(1050) = lu(1050) - lu(822) * lu(1045) + lu(1051) = lu(1051) - lu(823) * lu(1045) + lu(1052) = lu(1052) - lu(824) * lu(1045) + lu(1053) = lu(1053) - lu(825) * lu(1045) + lu(1054) = lu(1054) - lu(826) * lu(1045) + lu(1055) = lu(1055) - lu(827) * lu(1045) + lu(1056) = lu(1056) - lu(828) * lu(1045) + lu(1057) = lu(1057) - lu(829) * lu(1045) + lu(1058) = lu(1058) - lu(830) * lu(1045) + lu(1059) = lu(1059) - lu(831) * lu(1045) + lu(1061) = lu(1061) - lu(832) * lu(1045) + lu(1062) = lu(1062) - lu(833) * lu(1045) + lu(1063) = lu(1063) - lu(834) * lu(1045) + lu(1064) = lu(1064) - lu(835) * lu(1045) + lu(1066) = lu(1066) - lu(836) * lu(1045) + lu(1067) = lu(1067) - lu(837) * lu(1045) + lu(1068) = lu(1068) - lu(838) * lu(1045) + lu(1069) = lu(1069) - lu(839) * lu(1045) + lu(1070) = lu(1070) - lu(840) * lu(1045) + lu(1106) = lu(1106) - lu(820) * lu(1103) + lu(1107) = lu(1107) - lu(821) * lu(1103) + lu(1108) = lu(1108) - lu(822) * lu(1103) + lu(1109) = lu(1109) - lu(823) * lu(1103) + lu(1110) = lu(1110) - lu(824) * lu(1103) + lu(1111) = lu(1111) - lu(825) * lu(1103) + lu(1112) = lu(1112) - lu(826) * lu(1103) + lu(1113) = lu(1113) - lu(827) * lu(1103) + lu(1114) = lu(1114) - lu(828) * lu(1103) + lu(1115) = lu(1115) - lu(829) * lu(1103) + lu(1116) = lu(1116) - lu(830) * lu(1103) + lu(1117) = lu(1117) - lu(831) * lu(1103) + lu(1119) = lu(1119) - lu(832) * lu(1103) + lu(1120) = lu(1120) - lu(833) * lu(1103) + lu(1121) = lu(1121) - lu(834) * lu(1103) + lu(1122) = lu(1122) - lu(835) * lu(1103) + lu(1124) = lu(1124) - lu(836) * lu(1103) + lu(1125) = lu(1125) - lu(837) * lu(1103) + lu(1126) = lu(1126) - lu(838) * lu(1103) + lu(1127) = lu(1127) - lu(839) * lu(1103) + lu(1128) = lu(1128) - lu(840) * lu(1103) + lu(1146) = lu(1146) - lu(820) * lu(1144) + lu(1147) = lu(1147) - lu(821) * lu(1144) + lu(1148) = lu(1148) - lu(822) * lu(1144) + lu(1149) = lu(1149) - lu(823) * lu(1144) + lu(1150) = lu(1150) - lu(824) * lu(1144) + lu(1151) = lu(1151) - lu(825) * lu(1144) + lu(1152) = lu(1152) - lu(826) * lu(1144) + lu(1153) = lu(1153) - lu(827) * lu(1144) + lu(1154) = lu(1154) - lu(828) * lu(1144) + lu(1155) = lu(1155) - lu(829) * lu(1144) + lu(1156) = lu(1156) - lu(830) * lu(1144) + lu(1157) = lu(1157) - lu(831) * lu(1144) + lu(1159) = lu(1159) - lu(832) * lu(1144) + lu(1160) = lu(1160) - lu(833) * lu(1144) + lu(1161) = lu(1161) - lu(834) * lu(1144) + lu(1162) = lu(1162) - lu(835) * lu(1144) + lu(1164) = lu(1164) - lu(836) * lu(1144) + lu(1165) = lu(1165) - lu(837) * lu(1144) + lu(1166) = lu(1166) - lu(838) * lu(1144) + lu(1167) = lu(1167) - lu(839) * lu(1144) + lu(1168) = lu(1168) - lu(840) * lu(1144) + lu(1192) = lu(1192) - lu(820) * lu(1189) + lu(1193) = lu(1193) - lu(821) * lu(1189) + lu(1194) = lu(1194) - lu(822) * lu(1189) + lu(1195) = lu(1195) - lu(823) * lu(1189) + lu(1196) = lu(1196) - lu(824) * lu(1189) + lu(1197) = lu(1197) - lu(825) * lu(1189) + lu(1198) = lu(1198) - lu(826) * lu(1189) + lu(1199) = lu(1199) - lu(827) * lu(1189) + lu(1200) = lu(1200) - lu(828) * lu(1189) + lu(1201) = lu(1201) - lu(829) * lu(1189) + lu(1202) = lu(1202) - lu(830) * lu(1189) + lu(1203) = lu(1203) - lu(831) * lu(1189) + lu(1205) = lu(1205) - lu(832) * lu(1189) + lu(1206) = lu(1206) - lu(833) * lu(1189) + lu(1207) = lu(1207) - lu(834) * lu(1189) + lu(1208) = lu(1208) - lu(835) * lu(1189) + lu(1210) = lu(1210) - lu(836) * lu(1189) + lu(1211) = lu(1211) - lu(837) * lu(1189) + lu(1212) = lu(1212) - lu(838) * lu(1189) + lu(1213) = lu(1213) - lu(839) * lu(1189) + lu(1214) = lu(1214) - lu(840) * lu(1189) + lu(1234) = lu(1234) - lu(820) * lu(1231) + lu(1235) = lu(1235) - lu(821) * lu(1231) + lu(1236) = lu(1236) - lu(822) * lu(1231) + lu(1237) = lu(1237) - lu(823) * lu(1231) + lu(1238) = lu(1238) - lu(824) * lu(1231) + lu(1239) = lu(1239) - lu(825) * lu(1231) + lu(1240) = lu(1240) - lu(826) * lu(1231) + lu(1241) = lu(1241) - lu(827) * lu(1231) + lu(1242) = lu(1242) - lu(828) * lu(1231) + lu(1243) = lu(1243) - lu(829) * lu(1231) + lu(1244) = lu(1244) - lu(830) * lu(1231) + lu(1245) = lu(1245) - lu(831) * lu(1231) + lu(1247) = lu(1247) - lu(832) * lu(1231) + lu(1248) = lu(1248) - lu(833) * lu(1231) + lu(1249) = lu(1249) - lu(834) * lu(1231) + lu(1250) = lu(1250) - lu(835) * lu(1231) + lu(1252) = lu(1252) - lu(836) * lu(1231) + lu(1253) = lu(1253) - lu(837) * lu(1231) + lu(1254) = lu(1254) - lu(838) * lu(1231) + lu(1255) = lu(1255) - lu(839) * lu(1231) + lu(1256) = lu(1256) - lu(840) * lu(1231) + lu(1270) = lu(1270) - lu(820) * lu(1267) + lu(1271) = lu(1271) - lu(821) * lu(1267) + lu(1272) = lu(1272) - lu(822) * lu(1267) + lu(1273) = lu(1273) - lu(823) * lu(1267) + lu(1274) = lu(1274) - lu(824) * lu(1267) + lu(1275) = lu(1275) - lu(825) * lu(1267) + lu(1276) = lu(1276) - lu(826) * lu(1267) + lu(1277) = lu(1277) - lu(827) * lu(1267) + lu(1278) = lu(1278) - lu(828) * lu(1267) + lu(1279) = lu(1279) - lu(829) * lu(1267) + lu(1280) = lu(1280) - lu(830) * lu(1267) + lu(1281) = lu(1281) - lu(831) * lu(1267) + lu(1283) = lu(1283) - lu(832) * lu(1267) + lu(1284) = lu(1284) - lu(833) * lu(1267) + lu(1285) = lu(1285) - lu(834) * lu(1267) + lu(1286) = lu(1286) - lu(835) * lu(1267) + lu(1288) = lu(1288) - lu(836) * lu(1267) + lu(1289) = lu(1289) - lu(837) * lu(1267) + lu(1290) = lu(1290) - lu(838) * lu(1267) + lu(1291) = lu(1291) - lu(839) * lu(1267) + lu(1292) = lu(1292) - lu(840) * lu(1267) + lu(1329) = lu(1329) - lu(820) * lu(1326) + lu(1330) = lu(1330) - lu(821) * lu(1326) + lu(1331) = lu(1331) - lu(822) * lu(1326) + lu(1332) = lu(1332) - lu(823) * lu(1326) + lu(1333) = lu(1333) - lu(824) * lu(1326) + lu(1334) = lu(1334) - lu(825) * lu(1326) + lu(1335) = lu(1335) - lu(826) * lu(1326) + lu(1336) = lu(1336) - lu(827) * lu(1326) + lu(1337) = lu(1337) - lu(828) * lu(1326) + lu(1338) = lu(1338) - lu(829) * lu(1326) + lu(1339) = lu(1339) - lu(830) * lu(1326) + lu(1340) = lu(1340) - lu(831) * lu(1326) + lu(1342) = lu(1342) - lu(832) * lu(1326) + lu(1343) = lu(1343) - lu(833) * lu(1326) + lu(1344) = lu(1344) - lu(834) * lu(1326) + lu(1345) = lu(1345) - lu(835) * lu(1326) + lu(1347) = lu(1347) - lu(836) * lu(1326) + lu(1348) = lu(1348) - lu(837) * lu(1326) + lu(1349) = lu(1349) - lu(838) * lu(1326) + lu(1350) = lu(1350) - lu(839) * lu(1326) + lu(1351) = lu(1351) - lu(840) * lu(1326) + lu(1372) = lu(1372) - lu(820) * lu(1369) + lu(1373) = lu(1373) - lu(821) * lu(1369) + lu(1374) = lu(1374) - lu(822) * lu(1369) + lu(1375) = lu(1375) - lu(823) * lu(1369) + lu(1376) = lu(1376) - lu(824) * lu(1369) + lu(1377) = lu(1377) - lu(825) * lu(1369) + lu(1378) = lu(1378) - lu(826) * lu(1369) + lu(1379) = lu(1379) - lu(827) * lu(1369) + lu(1380) = lu(1380) - lu(828) * lu(1369) + lu(1381) = lu(1381) - lu(829) * lu(1369) + lu(1382) = lu(1382) - lu(830) * lu(1369) + lu(1383) = lu(1383) - lu(831) * lu(1369) + lu(1385) = lu(1385) - lu(832) * lu(1369) + lu(1386) = lu(1386) - lu(833) * lu(1369) + lu(1387) = lu(1387) - lu(834) * lu(1369) + lu(1388) = lu(1388) - lu(835) * lu(1369) + lu(1390) = lu(1390) - lu(836) * lu(1369) + lu(1391) = lu(1391) - lu(837) * lu(1369) + lu(1392) = lu(1392) - lu(838) * lu(1369) + lu(1393) = lu(1393) - lu(839) * lu(1369) + lu(1394) = lu(1394) - lu(840) * lu(1369) + lu(1413) = lu(1413) - lu(820) * lu(1410) + lu(1414) = lu(1414) - lu(821) * lu(1410) + lu(1415) = lu(1415) - lu(822) * lu(1410) + lu(1416) = lu(1416) - lu(823) * lu(1410) + lu(1417) = lu(1417) - lu(824) * lu(1410) + lu(1418) = lu(1418) - lu(825) * lu(1410) + lu(1419) = lu(1419) - lu(826) * lu(1410) + lu(1420) = lu(1420) - lu(827) * lu(1410) + lu(1421) = lu(1421) - lu(828) * lu(1410) + lu(1422) = lu(1422) - lu(829) * lu(1410) + lu(1423) = lu(1423) - lu(830) * lu(1410) + lu(1424) = lu(1424) - lu(831) * lu(1410) + lu(1426) = lu(1426) - lu(832) * lu(1410) + lu(1427) = lu(1427) - lu(833) * lu(1410) + lu(1428) = lu(1428) - lu(834) * lu(1410) + lu(1429) = lu(1429) - lu(835) * lu(1410) + lu(1431) = lu(1431) - lu(836) * lu(1410) + lu(1432) = lu(1432) - lu(837) * lu(1410) + lu(1433) = lu(1433) - lu(838) * lu(1410) + lu(1434) = lu(1434) - lu(839) * lu(1410) + lu(1435) = lu(1435) - lu(840) * lu(1410) + lu(1456) = lu(1456) - lu(820) * lu(1453) + lu(1457) = lu(1457) - lu(821) * lu(1453) + lu(1458) = lu(1458) - lu(822) * lu(1453) + lu(1459) = lu(1459) - lu(823) * lu(1453) + lu(1460) = lu(1460) - lu(824) * lu(1453) + lu(1461) = lu(1461) - lu(825) * lu(1453) + lu(1462) = lu(1462) - lu(826) * lu(1453) + lu(1463) = lu(1463) - lu(827) * lu(1453) + lu(1464) = lu(1464) - lu(828) * lu(1453) + lu(1465) = lu(1465) - lu(829) * lu(1453) + lu(1466) = lu(1466) - lu(830) * lu(1453) + lu(1467) = lu(1467) - lu(831) * lu(1453) + lu(1469) = lu(1469) - lu(832) * lu(1453) + lu(1470) = lu(1470) - lu(833) * lu(1453) + lu(1471) = lu(1471) - lu(834) * lu(1453) + lu(1472) = lu(1472) - lu(835) * lu(1453) + lu(1474) = lu(1474) - lu(836) * lu(1453) + lu(1475) = lu(1475) - lu(837) * lu(1453) + lu(1476) = lu(1476) - lu(838) * lu(1453) + lu(1477) = lu(1477) - lu(839) * lu(1453) + lu(1478) = lu(1478) - lu(840) * lu(1453) + lu(1499) = lu(1499) - lu(820) * lu(1496) + lu(1500) = lu(1500) - lu(821) * lu(1496) + lu(1501) = lu(1501) - lu(822) * lu(1496) + lu(1502) = lu(1502) - lu(823) * lu(1496) + lu(1503) = lu(1503) - lu(824) * lu(1496) + lu(1504) = lu(1504) - lu(825) * lu(1496) + lu(1505) = lu(1505) - lu(826) * lu(1496) + lu(1506) = lu(1506) - lu(827) * lu(1496) + lu(1507) = lu(1507) - lu(828) * lu(1496) + lu(1508) = lu(1508) - lu(829) * lu(1496) + lu(1509) = lu(1509) - lu(830) * lu(1496) + lu(1510) = lu(1510) - lu(831) * lu(1496) + lu(1512) = lu(1512) - lu(832) * lu(1496) + lu(1513) = lu(1513) - lu(833) * lu(1496) + lu(1514) = lu(1514) - lu(834) * lu(1496) + lu(1515) = lu(1515) - lu(835) * lu(1496) + lu(1517) = lu(1517) - lu(836) * lu(1496) + lu(1518) = lu(1518) - lu(837) * lu(1496) + lu(1519) = lu(1519) - lu(838) * lu(1496) + lu(1520) = lu(1520) - lu(839) * lu(1496) + lu(1521) = lu(1521) - lu(840) * lu(1496) + lu(1545) = lu(1545) - lu(820) * lu(1542) + lu(1546) = lu(1546) - lu(821) * lu(1542) + lu(1547) = lu(1547) - lu(822) * lu(1542) + lu(1548) = lu(1548) - lu(823) * lu(1542) + lu(1549) = lu(1549) - lu(824) * lu(1542) + lu(1550) = lu(1550) - lu(825) * lu(1542) + lu(1551) = lu(1551) - lu(826) * lu(1542) + lu(1552) = lu(1552) - lu(827) * lu(1542) + lu(1553) = lu(1553) - lu(828) * lu(1542) + lu(1554) = lu(1554) - lu(829) * lu(1542) + lu(1555) = lu(1555) - lu(830) * lu(1542) + lu(1556) = lu(1556) - lu(831) * lu(1542) + lu(1558) = lu(1558) - lu(832) * lu(1542) + lu(1559) = lu(1559) - lu(833) * lu(1542) + lu(1560) = lu(1560) - lu(834) * lu(1542) + lu(1561) = lu(1561) - lu(835) * lu(1542) + lu(1563) = lu(1563) - lu(836) * lu(1542) + lu(1564) = lu(1564) - lu(837) * lu(1542) + lu(1565) = lu(1565) - lu(838) * lu(1542) + lu(1566) = lu(1566) - lu(839) * lu(1542) + lu(1567) = lu(1567) - lu(840) * lu(1542) + lu(1591) = lu(1591) - lu(820) * lu(1588) + lu(1592) = lu(1592) - lu(821) * lu(1588) + lu(1593) = lu(1593) - lu(822) * lu(1588) + lu(1594) = lu(1594) - lu(823) * lu(1588) + lu(1595) = lu(1595) - lu(824) * lu(1588) + lu(1596) = lu(1596) - lu(825) * lu(1588) + lu(1597) = lu(1597) - lu(826) * lu(1588) + lu(1598) = lu(1598) - lu(827) * lu(1588) + lu(1599) = lu(1599) - lu(828) * lu(1588) + lu(1600) = lu(1600) - lu(829) * lu(1588) + lu(1601) = lu(1601) - lu(830) * lu(1588) + lu(1602) = lu(1602) - lu(831) * lu(1588) + lu(1604) = lu(1604) - lu(832) * lu(1588) + lu(1605) = lu(1605) - lu(833) * lu(1588) + lu(1606) = lu(1606) - lu(834) * lu(1588) + lu(1607) = lu(1607) - lu(835) * lu(1588) + lu(1609) = lu(1609) - lu(836) * lu(1588) + lu(1610) = lu(1610) - lu(837) * lu(1588) + lu(1611) = lu(1611) - lu(838) * lu(1588) + lu(1612) = lu(1612) - lu(839) * lu(1588) + lu(1613) = lu(1613) - lu(840) * lu(1588) + lu(1632) = lu(1632) - lu(820) * lu(1630) + lu(1633) = lu(1633) - lu(821) * lu(1630) + lu(1634) = lu(1634) - lu(822) * lu(1630) + lu(1635) = lu(1635) - lu(823) * lu(1630) + lu(1636) = lu(1636) - lu(824) * lu(1630) + lu(1637) = lu(1637) - lu(825) * lu(1630) + lu(1638) = lu(1638) - lu(826) * lu(1630) + lu(1639) = lu(1639) - lu(827) * lu(1630) + lu(1640) = lu(1640) - lu(828) * lu(1630) + lu(1641) = lu(1641) - lu(829) * lu(1630) + lu(1642) = lu(1642) - lu(830) * lu(1630) + lu(1643) = lu(1643) - lu(831) * lu(1630) + lu(1645) = lu(1645) - lu(832) * lu(1630) + lu(1646) = lu(1646) - lu(833) * lu(1630) + lu(1647) = lu(1647) - lu(834) * lu(1630) + lu(1648) = lu(1648) - lu(835) * lu(1630) + lu(1650) = lu(1650) - lu(836) * lu(1630) + lu(1651) = lu(1651) - lu(837) * lu(1630) + lu(1652) = lu(1652) - lu(838) * lu(1630) + lu(1653) = lu(1653) - lu(839) * lu(1630) + lu(1654) = lu(1654) - lu(840) * lu(1630) + lu(1675) = lu(1675) - lu(820) * lu(1672) + lu(1676) = lu(1676) - lu(821) * lu(1672) + lu(1677) = lu(1677) - lu(822) * lu(1672) + lu(1678) = lu(1678) - lu(823) * lu(1672) + lu(1679) = lu(1679) - lu(824) * lu(1672) + lu(1680) = lu(1680) - lu(825) * lu(1672) + lu(1681) = lu(1681) - lu(826) * lu(1672) + lu(1682) = lu(1682) - lu(827) * lu(1672) + lu(1683) = lu(1683) - lu(828) * lu(1672) + lu(1684) = lu(1684) - lu(829) * lu(1672) + lu(1685) = lu(1685) - lu(830) * lu(1672) + lu(1686) = lu(1686) - lu(831) * lu(1672) + lu(1688) = lu(1688) - lu(832) * lu(1672) + lu(1689) = lu(1689) - lu(833) * lu(1672) + lu(1690) = lu(1690) - lu(834) * lu(1672) + lu(1691) = lu(1691) - lu(835) * lu(1672) + lu(1693) = lu(1693) - lu(836) * lu(1672) + lu(1694) = lu(1694) - lu(837) * lu(1672) + lu(1695) = lu(1695) - lu(838) * lu(1672) + lu(1696) = lu(1696) - lu(839) * lu(1672) + lu(1697) = lu(1697) - lu(840) * lu(1672) + lu(1715) = lu(1715) - lu(820) * lu(1712) + lu(1716) = lu(1716) - lu(821) * lu(1712) + lu(1717) = lu(1717) - lu(822) * lu(1712) + lu(1718) = lu(1718) - lu(823) * lu(1712) + lu(1719) = lu(1719) - lu(824) * lu(1712) + lu(1720) = lu(1720) - lu(825) * lu(1712) + lu(1721) = lu(1721) - lu(826) * lu(1712) + lu(1722) = lu(1722) - lu(827) * lu(1712) + lu(1723) = lu(1723) - lu(828) * lu(1712) + lu(1724) = lu(1724) - lu(829) * lu(1712) + lu(1725) = lu(1725) - lu(830) * lu(1712) + lu(1726) = lu(1726) - lu(831) * lu(1712) + lu(1728) = lu(1728) - lu(832) * lu(1712) + lu(1729) = lu(1729) - lu(833) * lu(1712) + lu(1730) = lu(1730) - lu(834) * lu(1712) + lu(1731) = lu(1731) - lu(835) * lu(1712) + lu(1733) = lu(1733) - lu(836) * lu(1712) + lu(1734) = lu(1734) - lu(837) * lu(1712) + lu(1735) = lu(1735) - lu(838) * lu(1712) + lu(1736) = lu(1736) - lu(839) * lu(1712) + lu(1737) = lu(1737) - lu(840) * lu(1712) + lu(1761) = lu(1761) - lu(820) * lu(1758) + lu(1762) = lu(1762) - lu(821) * lu(1758) + lu(1763) = lu(1763) - lu(822) * lu(1758) + lu(1764) = lu(1764) - lu(823) * lu(1758) + lu(1765) = lu(1765) - lu(824) * lu(1758) + lu(1766) = lu(1766) - lu(825) * lu(1758) + lu(1767) = lu(1767) - lu(826) * lu(1758) + lu(1768) = lu(1768) - lu(827) * lu(1758) + lu(1769) = lu(1769) - lu(828) * lu(1758) + lu(1770) = lu(1770) - lu(829) * lu(1758) + lu(1771) = lu(1771) - lu(830) * lu(1758) + lu(1772) = lu(1772) - lu(831) * lu(1758) + lu(1774) = lu(1774) - lu(832) * lu(1758) + lu(1775) = lu(1775) - lu(833) * lu(1758) + lu(1776) = lu(1776) - lu(834) * lu(1758) + lu(1777) = lu(1777) - lu(835) * lu(1758) + lu(1779) = lu(1779) - lu(836) * lu(1758) + lu(1780) = lu(1780) - lu(837) * lu(1758) + lu(1781) = lu(1781) - lu(838) * lu(1758) + lu(1782) = lu(1782) - lu(839) * lu(1758) + lu(1783) = lu(1783) - lu(840) * lu(1758) + lu(1797) = lu(1797) - lu(820) * lu(1794) + lu(1798) = lu(1798) - lu(821) * lu(1794) + lu(1799) = lu(1799) - lu(822) * lu(1794) + lu(1800) = lu(1800) - lu(823) * lu(1794) + lu(1801) = lu(1801) - lu(824) * lu(1794) + lu(1802) = lu(1802) - lu(825) * lu(1794) + lu(1803) = lu(1803) - lu(826) * lu(1794) + lu(1804) = lu(1804) - lu(827) * lu(1794) + lu(1805) = lu(1805) - lu(828) * lu(1794) + lu(1806) = lu(1806) - lu(829) * lu(1794) + lu(1807) = lu(1807) - lu(830) * lu(1794) + lu(1808) = lu(1808) - lu(831) * lu(1794) + lu(1810) = lu(1810) - lu(832) * lu(1794) + lu(1811) = lu(1811) - lu(833) * lu(1794) + lu(1812) = lu(1812) - lu(834) * lu(1794) + lu(1813) = lu(1813) - lu(835) * lu(1794) + lu(1815) = lu(1815) - lu(836) * lu(1794) + lu(1816) = lu(1816) - lu(837) * lu(1794) + lu(1817) = lu(1817) - lu(838) * lu(1794) + lu(1818) = lu(1818) - lu(839) * lu(1794) + lu(1819) = lu(1819) - lu(840) * lu(1794) + lu(1839) = lu(1839) - lu(820) * lu(1836) + lu(1840) = lu(1840) - lu(821) * lu(1836) + lu(1841) = lu(1841) - lu(822) * lu(1836) + lu(1842) = lu(1842) - lu(823) * lu(1836) + lu(1843) = lu(1843) - lu(824) * lu(1836) + lu(1844) = lu(1844) - lu(825) * lu(1836) + lu(1845) = lu(1845) - lu(826) * lu(1836) + lu(1846) = lu(1846) - lu(827) * lu(1836) + lu(1847) = lu(1847) - lu(828) * lu(1836) + lu(1848) = lu(1848) - lu(829) * lu(1836) + lu(1849) = lu(1849) - lu(830) * lu(1836) + lu(1850) = lu(1850) - lu(831) * lu(1836) + lu(1852) = lu(1852) - lu(832) * lu(1836) + lu(1853) = lu(1853) - lu(833) * lu(1836) + lu(1854) = lu(1854) - lu(834) * lu(1836) + lu(1855) = lu(1855) - lu(835) * lu(1836) + lu(1857) = lu(1857) - lu(836) * lu(1836) + lu(1858) = lu(1858) - lu(837) * lu(1836) + lu(1859) = lu(1859) - lu(838) * lu(1836) + lu(1860) = lu(1860) - lu(839) * lu(1836) + lu(1861) = lu(1861) - lu(840) * lu(1836) + lu(1885) = lu(1885) - lu(820) * lu(1882) + lu(1886) = lu(1886) - lu(821) * lu(1882) + lu(1887) = lu(1887) - lu(822) * lu(1882) + lu(1888) = lu(1888) - lu(823) * lu(1882) + lu(1889) = lu(1889) - lu(824) * lu(1882) + lu(1890) = lu(1890) - lu(825) * lu(1882) + lu(1891) = lu(1891) - lu(826) * lu(1882) + lu(1892) = lu(1892) - lu(827) * lu(1882) + lu(1893) = lu(1893) - lu(828) * lu(1882) + lu(1894) = lu(1894) - lu(829) * lu(1882) + lu(1895) = lu(1895) - lu(830) * lu(1882) + lu(1896) = lu(1896) - lu(831) * lu(1882) + lu(1898) = lu(1898) - lu(832) * lu(1882) + lu(1899) = lu(1899) - lu(833) * lu(1882) + lu(1900) = lu(1900) - lu(834) * lu(1882) + lu(1901) = lu(1901) - lu(835) * lu(1882) + lu(1903) = lu(1903) - lu(836) * lu(1882) + lu(1904) = lu(1904) - lu(837) * lu(1882) + lu(1905) = lu(1905) - lu(838) * lu(1882) + lu(1906) = lu(1906) - lu(839) * lu(1882) + lu(1907) = lu(1907) - lu(840) * lu(1882) + lu(849) = 1._r8 / lu(849) + lu(850) = lu(850) * lu(849) + lu(851) = lu(851) * lu(849) + lu(852) = lu(852) * lu(849) + lu(853) = lu(853) * lu(849) + lu(854) = lu(854) * lu(849) + lu(855) = lu(855) * lu(849) + lu(856) = lu(856) * lu(849) + lu(857) = lu(857) * lu(849) + lu(858) = lu(858) * lu(849) + lu(859) = lu(859) * lu(849) + lu(860) = lu(860) * lu(849) + lu(861) = lu(861) * lu(849) + lu(862) = lu(862) * lu(849) + lu(863) = lu(863) * lu(849) + lu(864) = lu(864) * lu(849) + lu(865) = lu(865) * lu(849) + lu(866) = lu(866) * lu(849) + lu(867) = lu(867) * lu(849) + lu(868) = lu(868) * lu(849) + lu(869) = lu(869) * lu(849) + lu(870) = lu(870) * lu(849) + lu(871) = lu(871) * lu(849) + lu(872) = lu(872) * lu(849) + lu(873) = lu(873) * lu(849) + lu(893) = lu(893) - lu(850) * lu(892) + lu(894) = lu(894) - lu(851) * lu(892) + lu(895) = lu(895) - lu(852) * lu(892) + lu(896) = lu(896) - lu(853) * lu(892) + lu(897) = lu(897) - lu(854) * lu(892) + lu(898) = lu(898) - lu(855) * lu(892) + lu(899) = lu(899) - lu(856) * lu(892) + lu(900) = lu(900) - lu(857) * lu(892) + lu(901) = lu(901) - lu(858) * lu(892) + lu(902) = lu(902) - lu(859) * lu(892) + lu(903) = lu(903) - lu(860) * lu(892) + lu(904) = lu(904) - lu(861) * lu(892) + lu(905) = lu(905) - lu(862) * lu(892) + lu(906) = lu(906) - lu(863) * lu(892) + lu(907) = lu(907) - lu(864) * lu(892) + lu(908) = lu(908) - lu(865) * lu(892) + lu(909) = lu(909) - lu(866) * lu(892) + lu(910) = lu(910) - lu(867) * lu(892) + lu(911) = lu(911) - lu(868) * lu(892) + lu(912) = lu(912) - lu(869) * lu(892) + lu(913) = lu(913) - lu(870) * lu(892) + lu(914) = lu(914) - lu(871) * lu(892) + lu(915) = lu(915) - lu(872) * lu(892) + lu(916) = lu(916) - lu(873) * lu(892) + lu(930) = lu(930) - lu(850) * lu(929) + lu(931) = lu(931) - lu(851) * lu(929) + lu(932) = lu(932) - lu(852) * lu(929) + lu(933) = lu(933) - lu(853) * lu(929) + lu(934) = lu(934) - lu(854) * lu(929) + lu(935) = lu(935) - lu(855) * lu(929) + lu(936) = lu(936) - lu(856) * lu(929) + lu(937) = lu(937) - lu(857) * lu(929) + lu(938) = lu(938) - lu(858) * lu(929) + lu(939) = lu(939) - lu(859) * lu(929) + lu(940) = lu(940) - lu(860) * lu(929) + lu(941) = lu(941) - lu(861) * lu(929) + lu(942) = lu(942) - lu(862) * lu(929) + lu(943) = lu(943) - lu(863) * lu(929) + lu(944) = lu(944) - lu(864) * lu(929) + lu(945) = lu(945) - lu(865) * lu(929) + lu(946) = lu(946) - lu(866) * lu(929) + lu(947) = lu(947) - lu(867) * lu(929) + lu(948) = lu(948) - lu(868) * lu(929) + lu(949) = lu(949) - lu(869) * lu(929) + lu(950) = lu(950) - lu(870) * lu(929) + lu(951) = lu(951) - lu(871) * lu(929) + lu(952) = lu(952) - lu(872) * lu(929) + lu(953) = lu(953) - lu(873) * lu(929) + lu(963) = lu(963) - lu(850) * lu(962) + lu(964) = lu(964) - lu(851) * lu(962) + lu(965) = lu(965) - lu(852) * lu(962) + lu(966) = lu(966) - lu(853) * lu(962) + lu(967) = lu(967) - lu(854) * lu(962) + lu(968) = lu(968) - lu(855) * lu(962) + lu(969) = lu(969) - lu(856) * lu(962) + lu(970) = lu(970) - lu(857) * lu(962) + lu(971) = lu(971) - lu(858) * lu(962) + lu(972) = lu(972) - lu(859) * lu(962) + lu(973) = lu(973) - lu(860) * lu(962) + lu(974) = lu(974) - lu(861) * lu(962) + lu(975) = lu(975) - lu(862) * lu(962) + lu(976) = lu(976) - lu(863) * lu(962) + lu(977) = lu(977) - lu(864) * lu(962) + lu(978) = lu(978) - lu(865) * lu(962) + lu(979) = lu(979) - lu(866) * lu(962) + lu(980) = lu(980) - lu(867) * lu(962) + lu(981) = lu(981) - lu(868) * lu(962) + lu(982) = lu(982) - lu(869) * lu(962) + lu(983) = lu(983) - lu(870) * lu(962) + lu(984) = lu(984) - lu(871) * lu(962) + lu(985) = lu(985) - lu(872) * lu(962) + lu(986) = lu(986) - lu(873) * lu(962) + lu(1007) = lu(1007) - lu(850) * lu(1006) + lu(1008) = lu(1008) - lu(851) * lu(1006) + lu(1009) = lu(1009) - lu(852) * lu(1006) + lu(1010) = lu(1010) - lu(853) * lu(1006) + lu(1011) = lu(1011) - lu(854) * lu(1006) + lu(1012) = lu(1012) - lu(855) * lu(1006) + lu(1013) = lu(1013) - lu(856) * lu(1006) + lu(1014) = lu(1014) - lu(857) * lu(1006) + lu(1015) = lu(1015) - lu(858) * lu(1006) + lu(1016) = lu(1016) - lu(859) * lu(1006) + lu(1017) = lu(1017) - lu(860) * lu(1006) + lu(1018) = lu(1018) - lu(861) * lu(1006) + lu(1019) = lu(1019) - lu(862) * lu(1006) + lu(1020) = lu(1020) - lu(863) * lu(1006) + lu(1021) = lu(1021) - lu(864) * lu(1006) + lu(1022) = lu(1022) - lu(865) * lu(1006) + lu(1023) = lu(1023) - lu(866) * lu(1006) + lu(1024) = lu(1024) - lu(867) * lu(1006) + lu(1025) = lu(1025) - lu(868) * lu(1006) + lu(1026) = lu(1026) - lu(869) * lu(1006) + lu(1027) = lu(1027) - lu(870) * lu(1006) + lu(1028) = lu(1028) - lu(871) * lu(1006) + lu(1029) = lu(1029) - lu(872) * lu(1006) + lu(1030) = lu(1030) - lu(873) * lu(1006) + lu(1047) = lu(1047) - lu(850) * lu(1046) + lu(1048) = lu(1048) - lu(851) * lu(1046) + lu(1049) = lu(1049) - lu(852) * lu(1046) + lu(1050) = lu(1050) - lu(853) * lu(1046) + lu(1051) = lu(1051) - lu(854) * lu(1046) + lu(1052) = lu(1052) - lu(855) * lu(1046) + lu(1053) = lu(1053) - lu(856) * lu(1046) + lu(1054) = lu(1054) - lu(857) * lu(1046) + lu(1055) = lu(1055) - lu(858) * lu(1046) + lu(1056) = lu(1056) - lu(859) * lu(1046) + lu(1057) = lu(1057) - lu(860) * lu(1046) + lu(1058) = lu(1058) - lu(861) * lu(1046) + lu(1059) = lu(1059) - lu(862) * lu(1046) + lu(1060) = lu(1060) - lu(863) * lu(1046) + lu(1061) = lu(1061) - lu(864) * lu(1046) + lu(1062) = lu(1062) - lu(865) * lu(1046) + lu(1063) = lu(1063) - lu(866) * lu(1046) + lu(1064) = lu(1064) - lu(867) * lu(1046) + lu(1065) = lu(1065) - lu(868) * lu(1046) + lu(1066) = lu(1066) - lu(869) * lu(1046) + lu(1067) = lu(1067) - lu(870) * lu(1046) + lu(1068) = lu(1068) - lu(871) * lu(1046) + lu(1069) = lu(1069) - lu(872) * lu(1046) + lu(1070) = lu(1070) - lu(873) * lu(1046) + lu(1105) = lu(1105) - lu(850) * lu(1104) + lu(1106) = lu(1106) - lu(851) * lu(1104) + lu(1107) = lu(1107) - lu(852) * lu(1104) + lu(1108) = lu(1108) - lu(853) * lu(1104) + lu(1109) = lu(1109) - lu(854) * lu(1104) + lu(1110) = lu(1110) - lu(855) * lu(1104) + lu(1111) = lu(1111) - lu(856) * lu(1104) + lu(1112) = lu(1112) - lu(857) * lu(1104) + lu(1113) = lu(1113) - lu(858) * lu(1104) + lu(1114) = lu(1114) - lu(859) * lu(1104) + lu(1115) = lu(1115) - lu(860) * lu(1104) + lu(1116) = lu(1116) - lu(861) * lu(1104) + lu(1117) = lu(1117) - lu(862) * lu(1104) + lu(1118) = lu(1118) - lu(863) * lu(1104) + lu(1119) = lu(1119) - lu(864) * lu(1104) + lu(1120) = lu(1120) - lu(865) * lu(1104) + lu(1121) = lu(1121) - lu(866) * lu(1104) + lu(1122) = lu(1122) - lu(867) * lu(1104) + lu(1123) = lu(1123) - lu(868) * lu(1104) + lu(1124) = lu(1124) - lu(869) * lu(1104) + lu(1125) = lu(1125) - lu(870) * lu(1104) + lu(1126) = lu(1126) - lu(871) * lu(1104) + lu(1127) = lu(1127) - lu(872) * lu(1104) + lu(1128) = lu(1128) - lu(873) * lu(1104) + lu(1191) = lu(1191) - lu(850) * lu(1190) + lu(1192) = lu(1192) - lu(851) * lu(1190) + lu(1193) = lu(1193) - lu(852) * lu(1190) + lu(1194) = lu(1194) - lu(853) * lu(1190) + lu(1195) = lu(1195) - lu(854) * lu(1190) + lu(1196) = lu(1196) - lu(855) * lu(1190) + lu(1197) = lu(1197) - lu(856) * lu(1190) + lu(1198) = lu(1198) - lu(857) * lu(1190) + lu(1199) = lu(1199) - lu(858) * lu(1190) + lu(1200) = lu(1200) - lu(859) * lu(1190) + lu(1201) = lu(1201) - lu(860) * lu(1190) + lu(1202) = lu(1202) - lu(861) * lu(1190) + lu(1203) = lu(1203) - lu(862) * lu(1190) + lu(1204) = lu(1204) - lu(863) * lu(1190) + lu(1205) = lu(1205) - lu(864) * lu(1190) + lu(1206) = lu(1206) - lu(865) * lu(1190) + lu(1207) = lu(1207) - lu(866) * lu(1190) + lu(1208) = lu(1208) - lu(867) * lu(1190) + lu(1209) = lu(1209) - lu(868) * lu(1190) + lu(1210) = lu(1210) - lu(869) * lu(1190) + lu(1211) = lu(1211) - lu(870) * lu(1190) + lu(1212) = lu(1212) - lu(871) * lu(1190) + lu(1213) = lu(1213) - lu(872) * lu(1190) + lu(1214) = lu(1214) - lu(873) * lu(1190) + lu(1233) = lu(1233) - lu(850) * lu(1232) + lu(1234) = lu(1234) - lu(851) * lu(1232) + lu(1235) = lu(1235) - lu(852) * lu(1232) + lu(1236) = lu(1236) - lu(853) * lu(1232) + lu(1237) = lu(1237) - lu(854) * lu(1232) + lu(1238) = lu(1238) - lu(855) * lu(1232) + lu(1239) = lu(1239) - lu(856) * lu(1232) + lu(1240) = lu(1240) - lu(857) * lu(1232) + lu(1241) = lu(1241) - lu(858) * lu(1232) + lu(1242) = lu(1242) - lu(859) * lu(1232) + lu(1243) = lu(1243) - lu(860) * lu(1232) + lu(1244) = lu(1244) - lu(861) * lu(1232) + lu(1245) = lu(1245) - lu(862) * lu(1232) + lu(1246) = lu(1246) - lu(863) * lu(1232) + lu(1247) = lu(1247) - lu(864) * lu(1232) + lu(1248) = lu(1248) - lu(865) * lu(1232) + lu(1249) = lu(1249) - lu(866) * lu(1232) + lu(1250) = lu(1250) - lu(867) * lu(1232) + lu(1251) = lu(1251) - lu(868) * lu(1232) + lu(1252) = lu(1252) - lu(869) * lu(1232) + lu(1253) = lu(1253) - lu(870) * lu(1232) + lu(1254) = lu(1254) - lu(871) * lu(1232) + lu(1255) = lu(1255) - lu(872) * lu(1232) + lu(1256) = lu(1256) - lu(873) * lu(1232) + lu(1269) = lu(1269) - lu(850) * lu(1268) + lu(1270) = lu(1270) - lu(851) * lu(1268) + lu(1271) = lu(1271) - lu(852) * lu(1268) + lu(1272) = lu(1272) - lu(853) * lu(1268) + lu(1273) = lu(1273) - lu(854) * lu(1268) + lu(1274) = lu(1274) - lu(855) * lu(1268) + lu(1275) = lu(1275) - lu(856) * lu(1268) + lu(1276) = lu(1276) - lu(857) * lu(1268) + lu(1277) = lu(1277) - lu(858) * lu(1268) + lu(1278) = lu(1278) - lu(859) * lu(1268) + lu(1279) = lu(1279) - lu(860) * lu(1268) + lu(1280) = lu(1280) - lu(861) * lu(1268) + lu(1281) = lu(1281) - lu(862) * lu(1268) + lu(1282) = lu(1282) - lu(863) * lu(1268) + lu(1283) = lu(1283) - lu(864) * lu(1268) + lu(1284) = lu(1284) - lu(865) * lu(1268) + lu(1285) = lu(1285) - lu(866) * lu(1268) + lu(1286) = lu(1286) - lu(867) * lu(1268) + lu(1287) = lu(1287) - lu(868) * lu(1268) + lu(1288) = lu(1288) - lu(869) * lu(1268) + lu(1289) = lu(1289) - lu(870) * lu(1268) + lu(1290) = lu(1290) - lu(871) * lu(1268) + lu(1291) = lu(1291) - lu(872) * lu(1268) + lu(1292) = lu(1292) - lu(873) * lu(1268) + lu(1328) = lu(1328) - lu(850) * lu(1327) + lu(1329) = lu(1329) - lu(851) * lu(1327) + lu(1330) = lu(1330) - lu(852) * lu(1327) + lu(1331) = lu(1331) - lu(853) * lu(1327) + lu(1332) = lu(1332) - lu(854) * lu(1327) + lu(1333) = lu(1333) - lu(855) * lu(1327) + lu(1334) = lu(1334) - lu(856) * lu(1327) + lu(1335) = lu(1335) - lu(857) * lu(1327) + lu(1336) = lu(1336) - lu(858) * lu(1327) + lu(1337) = lu(1337) - lu(859) * lu(1327) + lu(1338) = lu(1338) - lu(860) * lu(1327) + lu(1339) = lu(1339) - lu(861) * lu(1327) + lu(1340) = lu(1340) - lu(862) * lu(1327) + lu(1341) = lu(1341) - lu(863) * lu(1327) + lu(1342) = lu(1342) - lu(864) * lu(1327) + lu(1343) = lu(1343) - lu(865) * lu(1327) + lu(1344) = lu(1344) - lu(866) * lu(1327) + lu(1345) = lu(1345) - lu(867) * lu(1327) + lu(1346) = lu(1346) - lu(868) * lu(1327) + lu(1347) = lu(1347) - lu(869) * lu(1327) + lu(1348) = lu(1348) - lu(870) * lu(1327) + lu(1349) = lu(1349) - lu(871) * lu(1327) + lu(1350) = lu(1350) - lu(872) * lu(1327) + lu(1351) = lu(1351) - lu(873) * lu(1327) + lu(1371) = lu(1371) - lu(850) * lu(1370) + lu(1372) = lu(1372) - lu(851) * lu(1370) + lu(1373) = lu(1373) - lu(852) * lu(1370) + lu(1374) = lu(1374) - lu(853) * lu(1370) + lu(1375) = lu(1375) - lu(854) * lu(1370) + lu(1376) = lu(1376) - lu(855) * lu(1370) + lu(1377) = lu(1377) - lu(856) * lu(1370) + lu(1378) = lu(1378) - lu(857) * lu(1370) + lu(1379) = lu(1379) - lu(858) * lu(1370) + lu(1380) = lu(1380) - lu(859) * lu(1370) + lu(1381) = lu(1381) - lu(860) * lu(1370) + lu(1382) = lu(1382) - lu(861) * lu(1370) + lu(1383) = lu(1383) - lu(862) * lu(1370) + lu(1384) = lu(1384) - lu(863) * lu(1370) + lu(1385) = lu(1385) - lu(864) * lu(1370) + lu(1386) = lu(1386) - lu(865) * lu(1370) + lu(1387) = lu(1387) - lu(866) * lu(1370) + lu(1388) = lu(1388) - lu(867) * lu(1370) + lu(1389) = lu(1389) - lu(868) * lu(1370) + lu(1390) = lu(1390) - lu(869) * lu(1370) + lu(1391) = lu(1391) - lu(870) * lu(1370) + lu(1392) = lu(1392) - lu(871) * lu(1370) + lu(1393) = lu(1393) - lu(872) * lu(1370) + lu(1394) = lu(1394) - lu(873) * lu(1370) + lu(1412) = lu(1412) - lu(850) * lu(1411) + lu(1413) = lu(1413) - lu(851) * lu(1411) + lu(1414) = lu(1414) - lu(852) * lu(1411) + lu(1415) = lu(1415) - lu(853) * lu(1411) + lu(1416) = lu(1416) - lu(854) * lu(1411) + lu(1417) = lu(1417) - lu(855) * lu(1411) + lu(1418) = lu(1418) - lu(856) * lu(1411) + lu(1419) = lu(1419) - lu(857) * lu(1411) + lu(1420) = lu(1420) - lu(858) * lu(1411) + lu(1421) = lu(1421) - lu(859) * lu(1411) + lu(1422) = lu(1422) - lu(860) * lu(1411) + lu(1423) = lu(1423) - lu(861) * lu(1411) + lu(1424) = lu(1424) - lu(862) * lu(1411) + lu(1425) = lu(1425) - lu(863) * lu(1411) + lu(1426) = lu(1426) - lu(864) * lu(1411) + lu(1427) = lu(1427) - lu(865) * lu(1411) + lu(1428) = lu(1428) - lu(866) * lu(1411) + lu(1429) = lu(1429) - lu(867) * lu(1411) + lu(1430) = lu(1430) - lu(868) * lu(1411) + lu(1431) = lu(1431) - lu(869) * lu(1411) + lu(1432) = lu(1432) - lu(870) * lu(1411) + lu(1433) = lu(1433) - lu(871) * lu(1411) + lu(1434) = lu(1434) - lu(872) * lu(1411) + lu(1435) = lu(1435) - lu(873) * lu(1411) + lu(1455) = lu(1455) - lu(850) * lu(1454) + lu(1456) = lu(1456) - lu(851) * lu(1454) + lu(1457) = lu(1457) - lu(852) * lu(1454) + lu(1458) = lu(1458) - lu(853) * lu(1454) + lu(1459) = lu(1459) - lu(854) * lu(1454) + lu(1460) = lu(1460) - lu(855) * lu(1454) + lu(1461) = lu(1461) - lu(856) * lu(1454) + lu(1462) = lu(1462) - lu(857) * lu(1454) + lu(1463) = lu(1463) - lu(858) * lu(1454) + lu(1464) = lu(1464) - lu(859) * lu(1454) + lu(1465) = lu(1465) - lu(860) * lu(1454) + lu(1466) = lu(1466) - lu(861) * lu(1454) + lu(1467) = lu(1467) - lu(862) * lu(1454) + lu(1468) = lu(1468) - lu(863) * lu(1454) + lu(1469) = lu(1469) - lu(864) * lu(1454) + lu(1470) = lu(1470) - lu(865) * lu(1454) + lu(1471) = lu(1471) - lu(866) * lu(1454) + lu(1472) = lu(1472) - lu(867) * lu(1454) + lu(1473) = lu(1473) - lu(868) * lu(1454) + lu(1474) = lu(1474) - lu(869) * lu(1454) + lu(1475) = lu(1475) - lu(870) * lu(1454) + lu(1476) = lu(1476) - lu(871) * lu(1454) + lu(1477) = lu(1477) - lu(872) * lu(1454) + lu(1478) = lu(1478) - lu(873) * lu(1454) + lu(1498) = lu(1498) - lu(850) * lu(1497) + lu(1499) = lu(1499) - lu(851) * lu(1497) + lu(1500) = lu(1500) - lu(852) * lu(1497) + lu(1501) = lu(1501) - lu(853) * lu(1497) + lu(1502) = lu(1502) - lu(854) * lu(1497) + lu(1503) = lu(1503) - lu(855) * lu(1497) + lu(1504) = lu(1504) - lu(856) * lu(1497) + lu(1505) = lu(1505) - lu(857) * lu(1497) + lu(1506) = lu(1506) - lu(858) * lu(1497) + lu(1507) = lu(1507) - lu(859) * lu(1497) + lu(1508) = lu(1508) - lu(860) * lu(1497) + lu(1509) = lu(1509) - lu(861) * lu(1497) + lu(1510) = lu(1510) - lu(862) * lu(1497) + lu(1511) = lu(1511) - lu(863) * lu(1497) + lu(1512) = lu(1512) - lu(864) * lu(1497) + lu(1513) = lu(1513) - lu(865) * lu(1497) + lu(1514) = lu(1514) - lu(866) * lu(1497) + lu(1515) = lu(1515) - lu(867) * lu(1497) + lu(1516) = lu(1516) - lu(868) * lu(1497) + lu(1517) = lu(1517) - lu(869) * lu(1497) + lu(1518) = lu(1518) - lu(870) * lu(1497) + lu(1519) = lu(1519) - lu(871) * lu(1497) + lu(1520) = lu(1520) - lu(872) * lu(1497) + lu(1521) = lu(1521) - lu(873) * lu(1497) + lu(1544) = lu(1544) - lu(850) * lu(1543) + lu(1545) = lu(1545) - lu(851) * lu(1543) + lu(1546) = lu(1546) - lu(852) * lu(1543) + lu(1547) = lu(1547) - lu(853) * lu(1543) + lu(1548) = lu(1548) - lu(854) * lu(1543) + lu(1549) = lu(1549) - lu(855) * lu(1543) + lu(1550) = lu(1550) - lu(856) * lu(1543) + lu(1551) = lu(1551) - lu(857) * lu(1543) + lu(1552) = lu(1552) - lu(858) * lu(1543) + lu(1553) = lu(1553) - lu(859) * lu(1543) + lu(1554) = lu(1554) - lu(860) * lu(1543) + lu(1555) = lu(1555) - lu(861) * lu(1543) + lu(1556) = lu(1556) - lu(862) * lu(1543) + lu(1557) = lu(1557) - lu(863) * lu(1543) + lu(1558) = lu(1558) - lu(864) * lu(1543) + lu(1559) = lu(1559) - lu(865) * lu(1543) + lu(1560) = lu(1560) - lu(866) * lu(1543) + lu(1561) = lu(1561) - lu(867) * lu(1543) + lu(1562) = lu(1562) - lu(868) * lu(1543) + lu(1563) = lu(1563) - lu(869) * lu(1543) + lu(1564) = lu(1564) - lu(870) * lu(1543) + lu(1565) = lu(1565) - lu(871) * lu(1543) + lu(1566) = lu(1566) - lu(872) * lu(1543) + lu(1567) = lu(1567) - lu(873) * lu(1543) + lu(1590) = lu(1590) - lu(850) * lu(1589) + lu(1591) = lu(1591) - lu(851) * lu(1589) + lu(1592) = lu(1592) - lu(852) * lu(1589) + lu(1593) = lu(1593) - lu(853) * lu(1589) + lu(1594) = lu(1594) - lu(854) * lu(1589) + lu(1595) = lu(1595) - lu(855) * lu(1589) + lu(1596) = lu(1596) - lu(856) * lu(1589) + lu(1597) = lu(1597) - lu(857) * lu(1589) + lu(1598) = lu(1598) - lu(858) * lu(1589) + lu(1599) = lu(1599) - lu(859) * lu(1589) + lu(1600) = lu(1600) - lu(860) * lu(1589) + lu(1601) = lu(1601) - lu(861) * lu(1589) + lu(1602) = lu(1602) - lu(862) * lu(1589) + lu(1603) = lu(1603) - lu(863) * lu(1589) + lu(1604) = lu(1604) - lu(864) * lu(1589) + lu(1605) = lu(1605) - lu(865) * lu(1589) + lu(1606) = lu(1606) - lu(866) * lu(1589) + lu(1607) = lu(1607) - lu(867) * lu(1589) + lu(1608) = lu(1608) - lu(868) * lu(1589) + lu(1609) = lu(1609) - lu(869) * lu(1589) + lu(1610) = lu(1610) - lu(870) * lu(1589) + lu(1611) = lu(1611) - lu(871) * lu(1589) + lu(1612) = lu(1612) - lu(872) * lu(1589) + lu(1613) = lu(1613) - lu(873) * lu(1589) + lu(1674) = lu(1674) - lu(850) * lu(1673) + lu(1675) = lu(1675) - lu(851) * lu(1673) + lu(1676) = lu(1676) - lu(852) * lu(1673) + lu(1677) = lu(1677) - lu(853) * lu(1673) + lu(1678) = lu(1678) - lu(854) * lu(1673) + lu(1679) = lu(1679) - lu(855) * lu(1673) + lu(1680) = lu(1680) - lu(856) * lu(1673) + lu(1681) = lu(1681) - lu(857) * lu(1673) + lu(1682) = lu(1682) - lu(858) * lu(1673) + lu(1683) = lu(1683) - lu(859) * lu(1673) + lu(1684) = lu(1684) - lu(860) * lu(1673) + lu(1685) = lu(1685) - lu(861) * lu(1673) + lu(1686) = lu(1686) - lu(862) * lu(1673) + lu(1687) = lu(1687) - lu(863) * lu(1673) + lu(1688) = lu(1688) - lu(864) * lu(1673) + lu(1689) = lu(1689) - lu(865) * lu(1673) + lu(1690) = lu(1690) - lu(866) * lu(1673) + lu(1691) = lu(1691) - lu(867) * lu(1673) + lu(1692) = lu(1692) - lu(868) * lu(1673) + lu(1693) = lu(1693) - lu(869) * lu(1673) + lu(1694) = lu(1694) - lu(870) * lu(1673) + lu(1695) = lu(1695) - lu(871) * lu(1673) + lu(1696) = lu(1696) - lu(872) * lu(1673) + lu(1697) = lu(1697) - lu(873) * lu(1673) + lu(1714) = lu(1714) - lu(850) * lu(1713) + lu(1715) = lu(1715) - lu(851) * lu(1713) + lu(1716) = lu(1716) - lu(852) * lu(1713) + lu(1717) = lu(1717) - lu(853) * lu(1713) + lu(1718) = lu(1718) - lu(854) * lu(1713) + lu(1719) = lu(1719) - lu(855) * lu(1713) + lu(1720) = lu(1720) - lu(856) * lu(1713) + lu(1721) = lu(1721) - lu(857) * lu(1713) + lu(1722) = lu(1722) - lu(858) * lu(1713) + lu(1723) = lu(1723) - lu(859) * lu(1713) + lu(1724) = lu(1724) - lu(860) * lu(1713) + lu(1725) = lu(1725) - lu(861) * lu(1713) + lu(1726) = lu(1726) - lu(862) * lu(1713) + lu(1727) = lu(1727) - lu(863) * lu(1713) + lu(1728) = lu(1728) - lu(864) * lu(1713) + lu(1729) = lu(1729) - lu(865) * lu(1713) + lu(1730) = lu(1730) - lu(866) * lu(1713) + lu(1731) = lu(1731) - lu(867) * lu(1713) + lu(1732) = lu(1732) - lu(868) * lu(1713) + lu(1733) = lu(1733) - lu(869) * lu(1713) + lu(1734) = lu(1734) - lu(870) * lu(1713) + lu(1735) = lu(1735) - lu(871) * lu(1713) + lu(1736) = lu(1736) - lu(872) * lu(1713) + lu(1737) = lu(1737) - lu(873) * lu(1713) + lu(1760) = lu(1760) - lu(850) * lu(1759) + lu(1761) = lu(1761) - lu(851) * lu(1759) + lu(1762) = lu(1762) - lu(852) * lu(1759) + lu(1763) = lu(1763) - lu(853) * lu(1759) + lu(1764) = lu(1764) - lu(854) * lu(1759) + lu(1765) = lu(1765) - lu(855) * lu(1759) + lu(1766) = lu(1766) - lu(856) * lu(1759) + lu(1767) = lu(1767) - lu(857) * lu(1759) + lu(1768) = lu(1768) - lu(858) * lu(1759) + lu(1769) = lu(1769) - lu(859) * lu(1759) + lu(1770) = lu(1770) - lu(860) * lu(1759) + lu(1771) = lu(1771) - lu(861) * lu(1759) + lu(1772) = lu(1772) - lu(862) * lu(1759) + lu(1773) = lu(1773) - lu(863) * lu(1759) + lu(1774) = lu(1774) - lu(864) * lu(1759) + lu(1775) = lu(1775) - lu(865) * lu(1759) + lu(1776) = lu(1776) - lu(866) * lu(1759) + lu(1777) = lu(1777) - lu(867) * lu(1759) + lu(1778) = lu(1778) - lu(868) * lu(1759) + lu(1779) = lu(1779) - lu(869) * lu(1759) + lu(1780) = lu(1780) - lu(870) * lu(1759) + lu(1781) = lu(1781) - lu(871) * lu(1759) + lu(1782) = lu(1782) - lu(872) * lu(1759) + lu(1783) = lu(1783) - lu(873) * lu(1759) + lu(1796) = lu(1796) - lu(850) * lu(1795) + lu(1797) = lu(1797) - lu(851) * lu(1795) + lu(1798) = lu(1798) - lu(852) * lu(1795) + lu(1799) = lu(1799) - lu(853) * lu(1795) + lu(1800) = lu(1800) - lu(854) * lu(1795) + lu(1801) = lu(1801) - lu(855) * lu(1795) + lu(1802) = lu(1802) - lu(856) * lu(1795) + lu(1803) = lu(1803) - lu(857) * lu(1795) + lu(1804) = lu(1804) - lu(858) * lu(1795) + lu(1805) = lu(1805) - lu(859) * lu(1795) + lu(1806) = lu(1806) - lu(860) * lu(1795) + lu(1807) = lu(1807) - lu(861) * lu(1795) + lu(1808) = lu(1808) - lu(862) * lu(1795) + lu(1809) = lu(1809) - lu(863) * lu(1795) + lu(1810) = lu(1810) - lu(864) * lu(1795) + lu(1811) = lu(1811) - lu(865) * lu(1795) + lu(1812) = lu(1812) - lu(866) * lu(1795) + lu(1813) = lu(1813) - lu(867) * lu(1795) + lu(1814) = lu(1814) - lu(868) * lu(1795) + lu(1815) = lu(1815) - lu(869) * lu(1795) + lu(1816) = lu(1816) - lu(870) * lu(1795) + lu(1817) = lu(1817) - lu(871) * lu(1795) + lu(1818) = lu(1818) - lu(872) * lu(1795) + lu(1819) = lu(1819) - lu(873) * lu(1795) + lu(1838) = lu(1838) - lu(850) * lu(1837) + lu(1839) = lu(1839) - lu(851) * lu(1837) + lu(1840) = lu(1840) - lu(852) * lu(1837) + lu(1841) = lu(1841) - lu(853) * lu(1837) + lu(1842) = lu(1842) - lu(854) * lu(1837) + lu(1843) = lu(1843) - lu(855) * lu(1837) + lu(1844) = lu(1844) - lu(856) * lu(1837) + lu(1845) = lu(1845) - lu(857) * lu(1837) + lu(1846) = lu(1846) - lu(858) * lu(1837) + lu(1847) = lu(1847) - lu(859) * lu(1837) + lu(1848) = lu(1848) - lu(860) * lu(1837) + lu(1849) = lu(1849) - lu(861) * lu(1837) + lu(1850) = lu(1850) - lu(862) * lu(1837) + lu(1851) = lu(1851) - lu(863) * lu(1837) + lu(1852) = lu(1852) - lu(864) * lu(1837) + lu(1853) = lu(1853) - lu(865) * lu(1837) + lu(1854) = lu(1854) - lu(866) * lu(1837) + lu(1855) = lu(1855) - lu(867) * lu(1837) + lu(1856) = lu(1856) - lu(868) * lu(1837) + lu(1857) = lu(1857) - lu(869) * lu(1837) + lu(1858) = lu(1858) - lu(870) * lu(1837) + lu(1859) = lu(1859) - lu(871) * lu(1837) + lu(1860) = lu(1860) - lu(872) * lu(1837) + lu(1861) = lu(1861) - lu(873) * lu(1837) + lu(1884) = lu(1884) - lu(850) * lu(1883) + lu(1885) = lu(1885) - lu(851) * lu(1883) + lu(1886) = lu(1886) - lu(852) * lu(1883) + lu(1887) = lu(1887) - lu(853) * lu(1883) + lu(1888) = lu(1888) - lu(854) * lu(1883) + lu(1889) = lu(1889) - lu(855) * lu(1883) + lu(1890) = lu(1890) - lu(856) * lu(1883) + lu(1891) = lu(1891) - lu(857) * lu(1883) + lu(1892) = lu(1892) - lu(858) * lu(1883) + lu(1893) = lu(1893) - lu(859) * lu(1883) + lu(1894) = lu(1894) - lu(860) * lu(1883) + lu(1895) = lu(1895) - lu(861) * lu(1883) + lu(1896) = lu(1896) - lu(862) * lu(1883) + lu(1897) = lu(1897) - lu(863) * lu(1883) + lu(1898) = lu(1898) - lu(864) * lu(1883) + lu(1899) = lu(1899) - lu(865) * lu(1883) + lu(1900) = lu(1900) - lu(866) * lu(1883) + lu(1901) = lu(1901) - lu(867) * lu(1883) + lu(1902) = lu(1902) - lu(868) * lu(1883) + lu(1903) = lu(1903) - lu(869) * lu(1883) + lu(1904) = lu(1904) - lu(870) * lu(1883) + lu(1905) = lu(1905) - lu(871) * lu(1883) + lu(1906) = lu(1906) - lu(872) * lu(1883) + lu(1907) = lu(1907) - lu(873) * lu(1883) + lu(893) = 1._r8 / lu(893) + lu(894) = lu(894) * lu(893) + lu(895) = lu(895) * lu(893) + lu(896) = lu(896) * lu(893) + lu(897) = lu(897) * lu(893) + lu(898) = lu(898) * lu(893) + lu(899) = lu(899) * lu(893) + lu(900) = lu(900) * lu(893) + lu(901) = lu(901) * lu(893) + lu(902) = lu(902) * lu(893) + lu(903) = lu(903) * lu(893) + lu(904) = lu(904) * lu(893) + lu(905) = lu(905) * lu(893) + lu(906) = lu(906) * lu(893) + lu(907) = lu(907) * lu(893) + lu(908) = lu(908) * lu(893) + lu(909) = lu(909) * lu(893) + lu(910) = lu(910) * lu(893) + lu(911) = lu(911) * lu(893) + lu(912) = lu(912) * lu(893) + lu(913) = lu(913) * lu(893) + lu(914) = lu(914) * lu(893) + lu(915) = lu(915) * lu(893) + lu(916) = lu(916) * lu(893) + lu(931) = lu(931) - lu(894) * lu(930) + lu(932) = lu(932) - lu(895) * lu(930) + lu(933) = lu(933) - lu(896) * lu(930) + lu(934) = lu(934) - lu(897) * lu(930) + lu(935) = lu(935) - lu(898) * lu(930) + lu(936) = lu(936) - lu(899) * lu(930) + lu(937) = lu(937) - lu(900) * lu(930) + lu(938) = lu(938) - lu(901) * lu(930) + lu(939) = lu(939) - lu(902) * lu(930) + lu(940) = lu(940) - lu(903) * lu(930) + lu(941) = lu(941) - lu(904) * lu(930) + lu(942) = lu(942) - lu(905) * lu(930) + lu(943) = lu(943) - lu(906) * lu(930) + lu(944) = lu(944) - lu(907) * lu(930) + lu(945) = lu(945) - lu(908) * lu(930) + lu(946) = lu(946) - lu(909) * lu(930) + lu(947) = lu(947) - lu(910) * lu(930) + lu(948) = lu(948) - lu(911) * lu(930) + lu(949) = lu(949) - lu(912) * lu(930) + lu(950) = lu(950) - lu(913) * lu(930) + lu(951) = lu(951) - lu(914) * lu(930) + lu(952) = lu(952) - lu(915) * lu(930) + lu(953) = lu(953) - lu(916) * lu(930) + lu(964) = lu(964) - lu(894) * lu(963) + lu(965) = lu(965) - lu(895) * lu(963) + lu(966) = lu(966) - lu(896) * lu(963) + lu(967) = lu(967) - lu(897) * lu(963) + lu(968) = lu(968) - lu(898) * lu(963) + lu(969) = lu(969) - lu(899) * lu(963) + lu(970) = lu(970) - lu(900) * lu(963) + lu(971) = lu(971) - lu(901) * lu(963) + lu(972) = lu(972) - lu(902) * lu(963) + lu(973) = lu(973) - lu(903) * lu(963) + lu(974) = lu(974) - lu(904) * lu(963) + lu(975) = lu(975) - lu(905) * lu(963) + lu(976) = lu(976) - lu(906) * lu(963) + lu(977) = lu(977) - lu(907) * lu(963) + lu(978) = lu(978) - lu(908) * lu(963) + lu(979) = lu(979) - lu(909) * lu(963) + lu(980) = lu(980) - lu(910) * lu(963) + lu(981) = lu(981) - lu(911) * lu(963) + lu(982) = lu(982) - lu(912) * lu(963) + lu(983) = lu(983) - lu(913) * lu(963) + lu(984) = lu(984) - lu(914) * lu(963) + lu(985) = lu(985) - lu(915) * lu(963) + lu(986) = lu(986) - lu(916) * lu(963) + lu(1008) = lu(1008) - lu(894) * lu(1007) + lu(1009) = lu(1009) - lu(895) * lu(1007) + lu(1010) = lu(1010) - lu(896) * lu(1007) + lu(1011) = lu(1011) - lu(897) * lu(1007) + lu(1012) = lu(1012) - lu(898) * lu(1007) + lu(1013) = lu(1013) - lu(899) * lu(1007) + lu(1014) = lu(1014) - lu(900) * lu(1007) + lu(1015) = lu(1015) - lu(901) * lu(1007) + lu(1016) = lu(1016) - lu(902) * lu(1007) + lu(1017) = lu(1017) - lu(903) * lu(1007) + lu(1018) = lu(1018) - lu(904) * lu(1007) + lu(1019) = lu(1019) - lu(905) * lu(1007) + lu(1020) = lu(1020) - lu(906) * lu(1007) + lu(1021) = lu(1021) - lu(907) * lu(1007) + lu(1022) = lu(1022) - lu(908) * lu(1007) + lu(1023) = lu(1023) - lu(909) * lu(1007) + lu(1024) = lu(1024) - lu(910) * lu(1007) + lu(1025) = lu(1025) - lu(911) * lu(1007) + lu(1026) = lu(1026) - lu(912) * lu(1007) + lu(1027) = lu(1027) - lu(913) * lu(1007) + lu(1028) = lu(1028) - lu(914) * lu(1007) + lu(1029) = lu(1029) - lu(915) * lu(1007) + lu(1030) = lu(1030) - lu(916) * lu(1007) + lu(1048) = lu(1048) - lu(894) * lu(1047) + lu(1049) = lu(1049) - lu(895) * lu(1047) + lu(1050) = lu(1050) - lu(896) * lu(1047) + lu(1051) = lu(1051) - lu(897) * lu(1047) + lu(1052) = lu(1052) - lu(898) * lu(1047) + lu(1053) = lu(1053) - lu(899) * lu(1047) + lu(1054) = lu(1054) - lu(900) * lu(1047) + lu(1055) = lu(1055) - lu(901) * lu(1047) + lu(1056) = lu(1056) - lu(902) * lu(1047) + lu(1057) = lu(1057) - lu(903) * lu(1047) + lu(1058) = lu(1058) - lu(904) * lu(1047) + lu(1059) = lu(1059) - lu(905) * lu(1047) + lu(1060) = lu(1060) - lu(906) * lu(1047) + lu(1061) = lu(1061) - lu(907) * lu(1047) + lu(1062) = lu(1062) - lu(908) * lu(1047) + lu(1063) = lu(1063) - lu(909) * lu(1047) + lu(1064) = lu(1064) - lu(910) * lu(1047) + lu(1065) = lu(1065) - lu(911) * lu(1047) + lu(1066) = lu(1066) - lu(912) * lu(1047) + lu(1067) = lu(1067) - lu(913) * lu(1047) + lu(1068) = lu(1068) - lu(914) * lu(1047) + lu(1069) = lu(1069) - lu(915) * lu(1047) + lu(1070) = lu(1070) - lu(916) * lu(1047) + lu(1106) = lu(1106) - lu(894) * lu(1105) + lu(1107) = lu(1107) - lu(895) * lu(1105) + lu(1108) = lu(1108) - lu(896) * lu(1105) + lu(1109) = lu(1109) - lu(897) * lu(1105) + lu(1110) = lu(1110) - lu(898) * lu(1105) + lu(1111) = lu(1111) - lu(899) * lu(1105) + lu(1112) = lu(1112) - lu(900) * lu(1105) + lu(1113) = lu(1113) - lu(901) * lu(1105) + lu(1114) = lu(1114) - lu(902) * lu(1105) + lu(1115) = lu(1115) - lu(903) * lu(1105) + lu(1116) = lu(1116) - lu(904) * lu(1105) + lu(1117) = lu(1117) - lu(905) * lu(1105) + lu(1118) = lu(1118) - lu(906) * lu(1105) + lu(1119) = lu(1119) - lu(907) * lu(1105) + lu(1120) = lu(1120) - lu(908) * lu(1105) + lu(1121) = lu(1121) - lu(909) * lu(1105) + lu(1122) = lu(1122) - lu(910) * lu(1105) + lu(1123) = lu(1123) - lu(911) * lu(1105) + lu(1124) = lu(1124) - lu(912) * lu(1105) + lu(1125) = lu(1125) - lu(913) * lu(1105) + lu(1126) = lu(1126) - lu(914) * lu(1105) + lu(1127) = lu(1127) - lu(915) * lu(1105) + lu(1128) = lu(1128) - lu(916) * lu(1105) + lu(1146) = lu(1146) - lu(894) * lu(1145) + lu(1147) = lu(1147) - lu(895) * lu(1145) + lu(1148) = lu(1148) - lu(896) * lu(1145) + lu(1149) = lu(1149) - lu(897) * lu(1145) + lu(1150) = lu(1150) - lu(898) * lu(1145) + lu(1151) = lu(1151) - lu(899) * lu(1145) + lu(1152) = lu(1152) - lu(900) * lu(1145) + lu(1153) = lu(1153) - lu(901) * lu(1145) + lu(1154) = lu(1154) - lu(902) * lu(1145) + lu(1155) = lu(1155) - lu(903) * lu(1145) + lu(1156) = lu(1156) - lu(904) * lu(1145) + lu(1157) = lu(1157) - lu(905) * lu(1145) + lu(1158) = lu(1158) - lu(906) * lu(1145) + lu(1159) = lu(1159) - lu(907) * lu(1145) + lu(1160) = lu(1160) - lu(908) * lu(1145) + lu(1161) = lu(1161) - lu(909) * lu(1145) + lu(1162) = lu(1162) - lu(910) * lu(1145) + lu(1163) = lu(1163) - lu(911) * lu(1145) + lu(1164) = lu(1164) - lu(912) * lu(1145) + lu(1165) = lu(1165) - lu(913) * lu(1145) + lu(1166) = lu(1166) - lu(914) * lu(1145) + lu(1167) = lu(1167) - lu(915) * lu(1145) + lu(1168) = lu(1168) - lu(916) * lu(1145) + lu(1192) = lu(1192) - lu(894) * lu(1191) + lu(1193) = lu(1193) - lu(895) * lu(1191) + lu(1194) = lu(1194) - lu(896) * lu(1191) + lu(1195) = lu(1195) - lu(897) * lu(1191) + lu(1196) = lu(1196) - lu(898) * lu(1191) + lu(1197) = lu(1197) - lu(899) * lu(1191) + lu(1198) = lu(1198) - lu(900) * lu(1191) + lu(1199) = lu(1199) - lu(901) * lu(1191) + lu(1200) = lu(1200) - lu(902) * lu(1191) + lu(1201) = lu(1201) - lu(903) * lu(1191) + lu(1202) = lu(1202) - lu(904) * lu(1191) + lu(1203) = lu(1203) - lu(905) * lu(1191) + lu(1204) = lu(1204) - lu(906) * lu(1191) + lu(1205) = lu(1205) - lu(907) * lu(1191) + lu(1206) = lu(1206) - lu(908) * lu(1191) + lu(1207) = lu(1207) - lu(909) * lu(1191) + lu(1208) = lu(1208) - lu(910) * lu(1191) + lu(1209) = lu(1209) - lu(911) * lu(1191) + lu(1210) = lu(1210) - lu(912) * lu(1191) + lu(1211) = lu(1211) - lu(913) * lu(1191) + lu(1212) = lu(1212) - lu(914) * lu(1191) + lu(1213) = lu(1213) - lu(915) * lu(1191) + lu(1214) = lu(1214) - lu(916) * lu(1191) + lu(1234) = lu(1234) - lu(894) * lu(1233) + lu(1235) = lu(1235) - lu(895) * lu(1233) + lu(1236) = lu(1236) - lu(896) * lu(1233) + lu(1237) = lu(1237) - lu(897) * lu(1233) + lu(1238) = lu(1238) - lu(898) * lu(1233) + lu(1239) = lu(1239) - lu(899) * lu(1233) + lu(1240) = lu(1240) - lu(900) * lu(1233) + lu(1241) = lu(1241) - lu(901) * lu(1233) + lu(1242) = lu(1242) - lu(902) * lu(1233) + lu(1243) = lu(1243) - lu(903) * lu(1233) + lu(1244) = lu(1244) - lu(904) * lu(1233) + lu(1245) = lu(1245) - lu(905) * lu(1233) + lu(1246) = lu(1246) - lu(906) * lu(1233) + lu(1247) = lu(1247) - lu(907) * lu(1233) + lu(1248) = lu(1248) - lu(908) * lu(1233) + lu(1249) = lu(1249) - lu(909) * lu(1233) + lu(1250) = lu(1250) - lu(910) * lu(1233) + lu(1251) = lu(1251) - lu(911) * lu(1233) + lu(1252) = lu(1252) - lu(912) * lu(1233) + lu(1253) = lu(1253) - lu(913) * lu(1233) + lu(1254) = lu(1254) - lu(914) * lu(1233) + lu(1255) = lu(1255) - lu(915) * lu(1233) + lu(1256) = lu(1256) - lu(916) * lu(1233) + lu(1270) = lu(1270) - lu(894) * lu(1269) + lu(1271) = lu(1271) - lu(895) * lu(1269) + lu(1272) = lu(1272) - lu(896) * lu(1269) + lu(1273) = lu(1273) - lu(897) * lu(1269) + lu(1274) = lu(1274) - lu(898) * lu(1269) + lu(1275) = lu(1275) - lu(899) * lu(1269) + lu(1276) = lu(1276) - lu(900) * lu(1269) + lu(1277) = lu(1277) - lu(901) * lu(1269) + lu(1278) = lu(1278) - lu(902) * lu(1269) + lu(1279) = lu(1279) - lu(903) * lu(1269) + lu(1280) = lu(1280) - lu(904) * lu(1269) + lu(1281) = lu(1281) - lu(905) * lu(1269) + lu(1282) = lu(1282) - lu(906) * lu(1269) + lu(1283) = lu(1283) - lu(907) * lu(1269) + lu(1284) = lu(1284) - lu(908) * lu(1269) + lu(1285) = lu(1285) - lu(909) * lu(1269) + lu(1286) = lu(1286) - lu(910) * lu(1269) + lu(1287) = lu(1287) - lu(911) * lu(1269) + lu(1288) = lu(1288) - lu(912) * lu(1269) + lu(1289) = lu(1289) - lu(913) * lu(1269) + lu(1290) = lu(1290) - lu(914) * lu(1269) + lu(1291) = lu(1291) - lu(915) * lu(1269) + lu(1292) = lu(1292) - lu(916) * lu(1269) + lu(1329) = lu(1329) - lu(894) * lu(1328) + lu(1330) = lu(1330) - lu(895) * lu(1328) + lu(1331) = lu(1331) - lu(896) * lu(1328) + lu(1332) = lu(1332) - lu(897) * lu(1328) + lu(1333) = lu(1333) - lu(898) * lu(1328) + lu(1334) = lu(1334) - lu(899) * lu(1328) + lu(1335) = lu(1335) - lu(900) * lu(1328) + lu(1336) = lu(1336) - lu(901) * lu(1328) + lu(1337) = lu(1337) - lu(902) * lu(1328) + lu(1338) = lu(1338) - lu(903) * lu(1328) + lu(1339) = lu(1339) - lu(904) * lu(1328) + lu(1340) = lu(1340) - lu(905) * lu(1328) + lu(1341) = lu(1341) - lu(906) * lu(1328) + lu(1342) = lu(1342) - lu(907) * lu(1328) + lu(1343) = lu(1343) - lu(908) * lu(1328) + lu(1344) = lu(1344) - lu(909) * lu(1328) + lu(1345) = lu(1345) - lu(910) * lu(1328) + lu(1346) = lu(1346) - lu(911) * lu(1328) + lu(1347) = lu(1347) - lu(912) * lu(1328) + lu(1348) = lu(1348) - lu(913) * lu(1328) + lu(1349) = lu(1349) - lu(914) * lu(1328) + lu(1350) = lu(1350) - lu(915) * lu(1328) + lu(1351) = lu(1351) - lu(916) * lu(1328) + lu(1372) = lu(1372) - lu(894) * lu(1371) + lu(1373) = lu(1373) - lu(895) * lu(1371) + lu(1374) = lu(1374) - lu(896) * lu(1371) + lu(1375) = lu(1375) - lu(897) * lu(1371) + lu(1376) = lu(1376) - lu(898) * lu(1371) + lu(1377) = lu(1377) - lu(899) * lu(1371) + lu(1378) = lu(1378) - lu(900) * lu(1371) + lu(1379) = lu(1379) - lu(901) * lu(1371) + lu(1380) = lu(1380) - lu(902) * lu(1371) + lu(1381) = lu(1381) - lu(903) * lu(1371) + lu(1382) = lu(1382) - lu(904) * lu(1371) + lu(1383) = lu(1383) - lu(905) * lu(1371) + lu(1384) = lu(1384) - lu(906) * lu(1371) + lu(1385) = lu(1385) - lu(907) * lu(1371) + lu(1386) = lu(1386) - lu(908) * lu(1371) + lu(1387) = lu(1387) - lu(909) * lu(1371) + lu(1388) = lu(1388) - lu(910) * lu(1371) + lu(1389) = lu(1389) - lu(911) * lu(1371) + lu(1390) = lu(1390) - lu(912) * lu(1371) + lu(1391) = lu(1391) - lu(913) * lu(1371) + lu(1392) = lu(1392) - lu(914) * lu(1371) + lu(1393) = lu(1393) - lu(915) * lu(1371) + lu(1394) = lu(1394) - lu(916) * lu(1371) + lu(1413) = lu(1413) - lu(894) * lu(1412) + lu(1414) = lu(1414) - lu(895) * lu(1412) + lu(1415) = lu(1415) - lu(896) * lu(1412) + lu(1416) = lu(1416) - lu(897) * lu(1412) + lu(1417) = lu(1417) - lu(898) * lu(1412) + lu(1418) = lu(1418) - lu(899) * lu(1412) + lu(1419) = lu(1419) - lu(900) * lu(1412) + lu(1420) = lu(1420) - lu(901) * lu(1412) + lu(1421) = lu(1421) - lu(902) * lu(1412) + lu(1422) = lu(1422) - lu(903) * lu(1412) + lu(1423) = lu(1423) - lu(904) * lu(1412) + lu(1424) = lu(1424) - lu(905) * lu(1412) + lu(1425) = lu(1425) - lu(906) * lu(1412) + lu(1426) = lu(1426) - lu(907) * lu(1412) + lu(1427) = lu(1427) - lu(908) * lu(1412) + lu(1428) = lu(1428) - lu(909) * lu(1412) + lu(1429) = lu(1429) - lu(910) * lu(1412) + lu(1430) = lu(1430) - lu(911) * lu(1412) + lu(1431) = lu(1431) - lu(912) * lu(1412) + lu(1432) = lu(1432) - lu(913) * lu(1412) + lu(1433) = lu(1433) - lu(914) * lu(1412) + lu(1434) = lu(1434) - lu(915) * lu(1412) + lu(1435) = lu(1435) - lu(916) * lu(1412) + lu(1456) = lu(1456) - lu(894) * lu(1455) + lu(1457) = lu(1457) - lu(895) * lu(1455) + lu(1458) = lu(1458) - lu(896) * lu(1455) + lu(1459) = lu(1459) - lu(897) * lu(1455) + lu(1460) = lu(1460) - lu(898) * lu(1455) + lu(1461) = lu(1461) - lu(899) * lu(1455) + lu(1462) = lu(1462) - lu(900) * lu(1455) + lu(1463) = lu(1463) - lu(901) * lu(1455) + lu(1464) = lu(1464) - lu(902) * lu(1455) + lu(1465) = lu(1465) - lu(903) * lu(1455) + lu(1466) = lu(1466) - lu(904) * lu(1455) + lu(1467) = lu(1467) - lu(905) * lu(1455) + lu(1468) = lu(1468) - lu(906) * lu(1455) + lu(1469) = lu(1469) - lu(907) * lu(1455) + lu(1470) = lu(1470) - lu(908) * lu(1455) + lu(1471) = lu(1471) - lu(909) * lu(1455) + lu(1472) = lu(1472) - lu(910) * lu(1455) + lu(1473) = lu(1473) - lu(911) * lu(1455) + lu(1474) = lu(1474) - lu(912) * lu(1455) + lu(1475) = lu(1475) - lu(913) * lu(1455) + lu(1476) = lu(1476) - lu(914) * lu(1455) + lu(1477) = lu(1477) - lu(915) * lu(1455) + lu(1478) = lu(1478) - lu(916) * lu(1455) + lu(1499) = lu(1499) - lu(894) * lu(1498) + lu(1500) = lu(1500) - lu(895) * lu(1498) + lu(1501) = lu(1501) - lu(896) * lu(1498) + lu(1502) = lu(1502) - lu(897) * lu(1498) + lu(1503) = lu(1503) - lu(898) * lu(1498) + lu(1504) = lu(1504) - lu(899) * lu(1498) + lu(1505) = lu(1505) - lu(900) * lu(1498) + lu(1506) = lu(1506) - lu(901) * lu(1498) + lu(1507) = lu(1507) - lu(902) * lu(1498) + lu(1508) = lu(1508) - lu(903) * lu(1498) + lu(1509) = lu(1509) - lu(904) * lu(1498) + lu(1510) = lu(1510) - lu(905) * lu(1498) + lu(1511) = lu(1511) - lu(906) * lu(1498) + lu(1512) = lu(1512) - lu(907) * lu(1498) + lu(1513) = lu(1513) - lu(908) * lu(1498) + lu(1514) = lu(1514) - lu(909) * lu(1498) + lu(1515) = lu(1515) - lu(910) * lu(1498) + lu(1516) = lu(1516) - lu(911) * lu(1498) + lu(1517) = lu(1517) - lu(912) * lu(1498) + lu(1518) = lu(1518) - lu(913) * lu(1498) + lu(1519) = lu(1519) - lu(914) * lu(1498) + lu(1520) = lu(1520) - lu(915) * lu(1498) + lu(1521) = lu(1521) - lu(916) * lu(1498) + lu(1545) = lu(1545) - lu(894) * lu(1544) + lu(1546) = lu(1546) - lu(895) * lu(1544) + lu(1547) = lu(1547) - lu(896) * lu(1544) + lu(1548) = lu(1548) - lu(897) * lu(1544) + lu(1549) = lu(1549) - lu(898) * lu(1544) + lu(1550) = lu(1550) - lu(899) * lu(1544) + lu(1551) = lu(1551) - lu(900) * lu(1544) + lu(1552) = lu(1552) - lu(901) * lu(1544) + lu(1553) = lu(1553) - lu(902) * lu(1544) + lu(1554) = lu(1554) - lu(903) * lu(1544) + lu(1555) = lu(1555) - lu(904) * lu(1544) + lu(1556) = lu(1556) - lu(905) * lu(1544) + lu(1557) = lu(1557) - lu(906) * lu(1544) + lu(1558) = lu(1558) - lu(907) * lu(1544) + lu(1559) = lu(1559) - lu(908) * lu(1544) + lu(1560) = lu(1560) - lu(909) * lu(1544) + lu(1561) = lu(1561) - lu(910) * lu(1544) + lu(1562) = lu(1562) - lu(911) * lu(1544) + lu(1563) = lu(1563) - lu(912) * lu(1544) + lu(1564) = lu(1564) - lu(913) * lu(1544) + lu(1565) = lu(1565) - lu(914) * lu(1544) + lu(1566) = lu(1566) - lu(915) * lu(1544) + lu(1567) = lu(1567) - lu(916) * lu(1544) + lu(1591) = lu(1591) - lu(894) * lu(1590) + lu(1592) = lu(1592) - lu(895) * lu(1590) + lu(1593) = lu(1593) - lu(896) * lu(1590) + lu(1594) = lu(1594) - lu(897) * lu(1590) + lu(1595) = lu(1595) - lu(898) * lu(1590) + lu(1596) = lu(1596) - lu(899) * lu(1590) + lu(1597) = lu(1597) - lu(900) * lu(1590) + lu(1598) = lu(1598) - lu(901) * lu(1590) + lu(1599) = lu(1599) - lu(902) * lu(1590) + lu(1600) = lu(1600) - lu(903) * lu(1590) + lu(1601) = lu(1601) - lu(904) * lu(1590) + lu(1602) = lu(1602) - lu(905) * lu(1590) + lu(1603) = lu(1603) - lu(906) * lu(1590) + lu(1604) = lu(1604) - lu(907) * lu(1590) + lu(1605) = lu(1605) - lu(908) * lu(1590) + lu(1606) = lu(1606) - lu(909) * lu(1590) + lu(1607) = lu(1607) - lu(910) * lu(1590) + lu(1608) = lu(1608) - lu(911) * lu(1590) + lu(1609) = lu(1609) - lu(912) * lu(1590) + lu(1610) = lu(1610) - lu(913) * lu(1590) + lu(1611) = lu(1611) - lu(914) * lu(1590) + lu(1612) = lu(1612) - lu(915) * lu(1590) + lu(1613) = lu(1613) - lu(916) * lu(1590) + lu(1632) = lu(1632) - lu(894) * lu(1631) + lu(1633) = lu(1633) - lu(895) * lu(1631) + lu(1634) = lu(1634) - lu(896) * lu(1631) + lu(1635) = lu(1635) - lu(897) * lu(1631) + lu(1636) = lu(1636) - lu(898) * lu(1631) + lu(1637) = lu(1637) - lu(899) * lu(1631) + lu(1638) = lu(1638) - lu(900) * lu(1631) + lu(1639) = lu(1639) - lu(901) * lu(1631) + lu(1640) = lu(1640) - lu(902) * lu(1631) + lu(1641) = lu(1641) - lu(903) * lu(1631) + lu(1642) = lu(1642) - lu(904) * lu(1631) + lu(1643) = lu(1643) - lu(905) * lu(1631) + lu(1644) = lu(1644) - lu(906) * lu(1631) + lu(1645) = lu(1645) - lu(907) * lu(1631) + lu(1646) = lu(1646) - lu(908) * lu(1631) + lu(1647) = lu(1647) - lu(909) * lu(1631) + lu(1648) = lu(1648) - lu(910) * lu(1631) + lu(1649) = lu(1649) - lu(911) * lu(1631) + lu(1650) = lu(1650) - lu(912) * lu(1631) + lu(1651) = lu(1651) - lu(913) * lu(1631) + lu(1652) = lu(1652) - lu(914) * lu(1631) + lu(1653) = lu(1653) - lu(915) * lu(1631) + lu(1654) = lu(1654) - lu(916) * lu(1631) + lu(1675) = lu(1675) - lu(894) * lu(1674) + lu(1676) = lu(1676) - lu(895) * lu(1674) + lu(1677) = lu(1677) - lu(896) * lu(1674) + lu(1678) = lu(1678) - lu(897) * lu(1674) + lu(1679) = lu(1679) - lu(898) * lu(1674) + lu(1680) = lu(1680) - lu(899) * lu(1674) + lu(1681) = lu(1681) - lu(900) * lu(1674) + lu(1682) = lu(1682) - lu(901) * lu(1674) + lu(1683) = lu(1683) - lu(902) * lu(1674) + lu(1684) = lu(1684) - lu(903) * lu(1674) + lu(1685) = lu(1685) - lu(904) * lu(1674) + lu(1686) = lu(1686) - lu(905) * lu(1674) + lu(1687) = lu(1687) - lu(906) * lu(1674) + lu(1688) = lu(1688) - lu(907) * lu(1674) + lu(1689) = lu(1689) - lu(908) * lu(1674) + lu(1690) = lu(1690) - lu(909) * lu(1674) + lu(1691) = lu(1691) - lu(910) * lu(1674) + lu(1692) = lu(1692) - lu(911) * lu(1674) + lu(1693) = lu(1693) - lu(912) * lu(1674) + lu(1694) = lu(1694) - lu(913) * lu(1674) + lu(1695) = lu(1695) - lu(914) * lu(1674) + lu(1696) = lu(1696) - lu(915) * lu(1674) + lu(1697) = lu(1697) - lu(916) * lu(1674) + lu(1715) = lu(1715) - lu(894) * lu(1714) + lu(1716) = lu(1716) - lu(895) * lu(1714) + lu(1717) = lu(1717) - lu(896) * lu(1714) + lu(1718) = lu(1718) - lu(897) * lu(1714) + lu(1719) = lu(1719) - lu(898) * lu(1714) + lu(1720) = lu(1720) - lu(899) * lu(1714) + lu(1721) = lu(1721) - lu(900) * lu(1714) + lu(1722) = lu(1722) - lu(901) * lu(1714) + lu(1723) = lu(1723) - lu(902) * lu(1714) + lu(1724) = lu(1724) - lu(903) * lu(1714) + lu(1725) = lu(1725) - lu(904) * lu(1714) + lu(1726) = lu(1726) - lu(905) * lu(1714) + lu(1727) = lu(1727) - lu(906) * lu(1714) + lu(1728) = lu(1728) - lu(907) * lu(1714) + lu(1729) = lu(1729) - lu(908) * lu(1714) + lu(1730) = lu(1730) - lu(909) * lu(1714) + lu(1731) = lu(1731) - lu(910) * lu(1714) + lu(1732) = lu(1732) - lu(911) * lu(1714) + lu(1733) = lu(1733) - lu(912) * lu(1714) + lu(1734) = lu(1734) - lu(913) * lu(1714) + lu(1735) = lu(1735) - lu(914) * lu(1714) + lu(1736) = lu(1736) - lu(915) * lu(1714) + lu(1737) = lu(1737) - lu(916) * lu(1714) + lu(1761) = lu(1761) - lu(894) * lu(1760) + lu(1762) = lu(1762) - lu(895) * lu(1760) + lu(1763) = lu(1763) - lu(896) * lu(1760) + lu(1764) = lu(1764) - lu(897) * lu(1760) + lu(1765) = lu(1765) - lu(898) * lu(1760) + lu(1766) = lu(1766) - lu(899) * lu(1760) + lu(1767) = lu(1767) - lu(900) * lu(1760) + lu(1768) = lu(1768) - lu(901) * lu(1760) + lu(1769) = lu(1769) - lu(902) * lu(1760) + lu(1770) = lu(1770) - lu(903) * lu(1760) + lu(1771) = lu(1771) - lu(904) * lu(1760) + lu(1772) = lu(1772) - lu(905) * lu(1760) + lu(1773) = lu(1773) - lu(906) * lu(1760) + lu(1774) = lu(1774) - lu(907) * lu(1760) + lu(1775) = lu(1775) - lu(908) * lu(1760) + lu(1776) = lu(1776) - lu(909) * lu(1760) + lu(1777) = lu(1777) - lu(910) * lu(1760) + lu(1778) = lu(1778) - lu(911) * lu(1760) + lu(1779) = lu(1779) - lu(912) * lu(1760) + lu(1780) = lu(1780) - lu(913) * lu(1760) + lu(1781) = lu(1781) - lu(914) * lu(1760) + lu(1782) = lu(1782) - lu(915) * lu(1760) + lu(1783) = lu(1783) - lu(916) * lu(1760) + lu(1797) = lu(1797) - lu(894) * lu(1796) + lu(1798) = lu(1798) - lu(895) * lu(1796) + lu(1799) = lu(1799) - lu(896) * lu(1796) + lu(1800) = lu(1800) - lu(897) * lu(1796) + lu(1801) = lu(1801) - lu(898) * lu(1796) + lu(1802) = lu(1802) - lu(899) * lu(1796) + lu(1803) = lu(1803) - lu(900) * lu(1796) + lu(1804) = lu(1804) - lu(901) * lu(1796) + lu(1805) = lu(1805) - lu(902) * lu(1796) + lu(1806) = lu(1806) - lu(903) * lu(1796) + lu(1807) = lu(1807) - lu(904) * lu(1796) + lu(1808) = lu(1808) - lu(905) * lu(1796) + lu(1809) = lu(1809) - lu(906) * lu(1796) + lu(1810) = lu(1810) - lu(907) * lu(1796) + lu(1811) = lu(1811) - lu(908) * lu(1796) + lu(1812) = lu(1812) - lu(909) * lu(1796) + lu(1813) = lu(1813) - lu(910) * lu(1796) + lu(1814) = lu(1814) - lu(911) * lu(1796) + lu(1815) = lu(1815) - lu(912) * lu(1796) + lu(1816) = lu(1816) - lu(913) * lu(1796) + lu(1817) = lu(1817) - lu(914) * lu(1796) + lu(1818) = lu(1818) - lu(915) * lu(1796) + lu(1819) = lu(1819) - lu(916) * lu(1796) + lu(1839) = lu(1839) - lu(894) * lu(1838) + lu(1840) = lu(1840) - lu(895) * lu(1838) + lu(1841) = lu(1841) - lu(896) * lu(1838) + lu(1842) = lu(1842) - lu(897) * lu(1838) + lu(1843) = lu(1843) - lu(898) * lu(1838) + lu(1844) = lu(1844) - lu(899) * lu(1838) + lu(1845) = lu(1845) - lu(900) * lu(1838) + lu(1846) = lu(1846) - lu(901) * lu(1838) + lu(1847) = lu(1847) - lu(902) * lu(1838) + lu(1848) = lu(1848) - lu(903) * lu(1838) + lu(1849) = lu(1849) - lu(904) * lu(1838) + lu(1850) = lu(1850) - lu(905) * lu(1838) + lu(1851) = lu(1851) - lu(906) * lu(1838) + lu(1852) = lu(1852) - lu(907) * lu(1838) + lu(1853) = lu(1853) - lu(908) * lu(1838) + lu(1854) = lu(1854) - lu(909) * lu(1838) + lu(1855) = lu(1855) - lu(910) * lu(1838) + lu(1856) = lu(1856) - lu(911) * lu(1838) + lu(1857) = lu(1857) - lu(912) * lu(1838) + lu(1858) = lu(1858) - lu(913) * lu(1838) + lu(1859) = lu(1859) - lu(914) * lu(1838) + lu(1860) = lu(1860) - lu(915) * lu(1838) + lu(1861) = lu(1861) - lu(916) * lu(1838) + lu(1885) = lu(1885) - lu(894) * lu(1884) + lu(1886) = lu(1886) - lu(895) * lu(1884) + lu(1887) = lu(1887) - lu(896) * lu(1884) + lu(1888) = lu(1888) - lu(897) * lu(1884) + lu(1889) = lu(1889) - lu(898) * lu(1884) + lu(1890) = lu(1890) - lu(899) * lu(1884) + lu(1891) = lu(1891) - lu(900) * lu(1884) + lu(1892) = lu(1892) - lu(901) * lu(1884) + lu(1893) = lu(1893) - lu(902) * lu(1884) + lu(1894) = lu(1894) - lu(903) * lu(1884) + lu(1895) = lu(1895) - lu(904) * lu(1884) + lu(1896) = lu(1896) - lu(905) * lu(1884) + lu(1897) = lu(1897) - lu(906) * lu(1884) + lu(1898) = lu(1898) - lu(907) * lu(1884) + lu(1899) = lu(1899) - lu(908) * lu(1884) + lu(1900) = lu(1900) - lu(909) * lu(1884) + lu(1901) = lu(1901) - lu(910) * lu(1884) + lu(1902) = lu(1902) - lu(911) * lu(1884) + lu(1903) = lu(1903) - lu(912) * lu(1884) + lu(1904) = lu(1904) - lu(913) * lu(1884) + lu(1905) = lu(1905) - lu(914) * lu(1884) + lu(1906) = lu(1906) - lu(915) * lu(1884) + lu(1907) = lu(1907) - lu(916) * lu(1884) + end subroutine lu_fac18 + subroutine lu_fac19( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(931) = 1._r8 / lu(931) + lu(932) = lu(932) * lu(931) + lu(933) = lu(933) * lu(931) + lu(934) = lu(934) * lu(931) + lu(935) = lu(935) * lu(931) + lu(936) = lu(936) * lu(931) + lu(937) = lu(937) * lu(931) + lu(938) = lu(938) * lu(931) + lu(939) = lu(939) * lu(931) + lu(940) = lu(940) * lu(931) + lu(941) = lu(941) * lu(931) + lu(942) = lu(942) * lu(931) + lu(943) = lu(943) * lu(931) + lu(944) = lu(944) * lu(931) + lu(945) = lu(945) * lu(931) + lu(946) = lu(946) * lu(931) + lu(947) = lu(947) * lu(931) + lu(948) = lu(948) * lu(931) + lu(949) = lu(949) * lu(931) + lu(950) = lu(950) * lu(931) + lu(951) = lu(951) * lu(931) + lu(952) = lu(952) * lu(931) + lu(953) = lu(953) * lu(931) + lu(965) = lu(965) - lu(932) * lu(964) + lu(966) = lu(966) - lu(933) * lu(964) + lu(967) = lu(967) - lu(934) * lu(964) + lu(968) = lu(968) - lu(935) * lu(964) + lu(969) = lu(969) - lu(936) * lu(964) + lu(970) = lu(970) - lu(937) * lu(964) + lu(971) = lu(971) - lu(938) * lu(964) + lu(972) = lu(972) - lu(939) * lu(964) + lu(973) = lu(973) - lu(940) * lu(964) + lu(974) = lu(974) - lu(941) * lu(964) + lu(975) = lu(975) - lu(942) * lu(964) + lu(976) = lu(976) - lu(943) * lu(964) + lu(977) = lu(977) - lu(944) * lu(964) + lu(978) = lu(978) - lu(945) * lu(964) + lu(979) = lu(979) - lu(946) * lu(964) + lu(980) = lu(980) - lu(947) * lu(964) + lu(981) = lu(981) - lu(948) * lu(964) + lu(982) = lu(982) - lu(949) * lu(964) + lu(983) = lu(983) - lu(950) * lu(964) + lu(984) = lu(984) - lu(951) * lu(964) + lu(985) = lu(985) - lu(952) * lu(964) + lu(986) = lu(986) - lu(953) * lu(964) + lu(1009) = lu(1009) - lu(932) * lu(1008) + lu(1010) = lu(1010) - lu(933) * lu(1008) + lu(1011) = lu(1011) - lu(934) * lu(1008) + lu(1012) = lu(1012) - lu(935) * lu(1008) + lu(1013) = lu(1013) - lu(936) * lu(1008) + lu(1014) = lu(1014) - lu(937) * lu(1008) + lu(1015) = lu(1015) - lu(938) * lu(1008) + lu(1016) = lu(1016) - lu(939) * lu(1008) + lu(1017) = lu(1017) - lu(940) * lu(1008) + lu(1018) = lu(1018) - lu(941) * lu(1008) + lu(1019) = lu(1019) - lu(942) * lu(1008) + lu(1020) = lu(1020) - lu(943) * lu(1008) + lu(1021) = lu(1021) - lu(944) * lu(1008) + lu(1022) = lu(1022) - lu(945) * lu(1008) + lu(1023) = lu(1023) - lu(946) * lu(1008) + lu(1024) = lu(1024) - lu(947) * lu(1008) + lu(1025) = lu(1025) - lu(948) * lu(1008) + lu(1026) = lu(1026) - lu(949) * lu(1008) + lu(1027) = lu(1027) - lu(950) * lu(1008) + lu(1028) = lu(1028) - lu(951) * lu(1008) + lu(1029) = lu(1029) - lu(952) * lu(1008) + lu(1030) = lu(1030) - lu(953) * lu(1008) + lu(1049) = lu(1049) - lu(932) * lu(1048) + lu(1050) = lu(1050) - lu(933) * lu(1048) + lu(1051) = lu(1051) - lu(934) * lu(1048) + lu(1052) = lu(1052) - lu(935) * lu(1048) + lu(1053) = lu(1053) - lu(936) * lu(1048) + lu(1054) = lu(1054) - lu(937) * lu(1048) + lu(1055) = lu(1055) - lu(938) * lu(1048) + lu(1056) = lu(1056) - lu(939) * lu(1048) + lu(1057) = lu(1057) - lu(940) * lu(1048) + lu(1058) = lu(1058) - lu(941) * lu(1048) + lu(1059) = lu(1059) - lu(942) * lu(1048) + lu(1060) = lu(1060) - lu(943) * lu(1048) + lu(1061) = lu(1061) - lu(944) * lu(1048) + lu(1062) = lu(1062) - lu(945) * lu(1048) + lu(1063) = lu(1063) - lu(946) * lu(1048) + lu(1064) = lu(1064) - lu(947) * lu(1048) + lu(1065) = lu(1065) - lu(948) * lu(1048) + lu(1066) = lu(1066) - lu(949) * lu(1048) + lu(1067) = lu(1067) - lu(950) * lu(1048) + lu(1068) = lu(1068) - lu(951) * lu(1048) + lu(1069) = lu(1069) - lu(952) * lu(1048) + lu(1070) = lu(1070) - lu(953) * lu(1048) + lu(1107) = lu(1107) - lu(932) * lu(1106) + lu(1108) = lu(1108) - lu(933) * lu(1106) + lu(1109) = lu(1109) - lu(934) * lu(1106) + lu(1110) = lu(1110) - lu(935) * lu(1106) + lu(1111) = lu(1111) - lu(936) * lu(1106) + lu(1112) = lu(1112) - lu(937) * lu(1106) + lu(1113) = lu(1113) - lu(938) * lu(1106) + lu(1114) = lu(1114) - lu(939) * lu(1106) + lu(1115) = lu(1115) - lu(940) * lu(1106) + lu(1116) = lu(1116) - lu(941) * lu(1106) + lu(1117) = lu(1117) - lu(942) * lu(1106) + lu(1118) = lu(1118) - lu(943) * lu(1106) + lu(1119) = lu(1119) - lu(944) * lu(1106) + lu(1120) = lu(1120) - lu(945) * lu(1106) + lu(1121) = lu(1121) - lu(946) * lu(1106) + lu(1122) = lu(1122) - lu(947) * lu(1106) + lu(1123) = lu(1123) - lu(948) * lu(1106) + lu(1124) = lu(1124) - lu(949) * lu(1106) + lu(1125) = lu(1125) - lu(950) * lu(1106) + lu(1126) = lu(1126) - lu(951) * lu(1106) + lu(1127) = lu(1127) - lu(952) * lu(1106) + lu(1128) = lu(1128) - lu(953) * lu(1106) + lu(1147) = lu(1147) - lu(932) * lu(1146) + lu(1148) = lu(1148) - lu(933) * lu(1146) + lu(1149) = lu(1149) - lu(934) * lu(1146) + lu(1150) = lu(1150) - lu(935) * lu(1146) + lu(1151) = lu(1151) - lu(936) * lu(1146) + lu(1152) = lu(1152) - lu(937) * lu(1146) + lu(1153) = lu(1153) - lu(938) * lu(1146) + lu(1154) = lu(1154) - lu(939) * lu(1146) + lu(1155) = lu(1155) - lu(940) * lu(1146) + lu(1156) = lu(1156) - lu(941) * lu(1146) + lu(1157) = lu(1157) - lu(942) * lu(1146) + lu(1158) = lu(1158) - lu(943) * lu(1146) + lu(1159) = lu(1159) - lu(944) * lu(1146) + lu(1160) = lu(1160) - lu(945) * lu(1146) + lu(1161) = lu(1161) - lu(946) * lu(1146) + lu(1162) = lu(1162) - lu(947) * lu(1146) + lu(1163) = lu(1163) - lu(948) * lu(1146) + lu(1164) = lu(1164) - lu(949) * lu(1146) + lu(1165) = lu(1165) - lu(950) * lu(1146) + lu(1166) = lu(1166) - lu(951) * lu(1146) + lu(1167) = lu(1167) - lu(952) * lu(1146) + lu(1168) = lu(1168) - lu(953) * lu(1146) + lu(1193) = lu(1193) - lu(932) * lu(1192) + lu(1194) = lu(1194) - lu(933) * lu(1192) + lu(1195) = lu(1195) - lu(934) * lu(1192) + lu(1196) = lu(1196) - lu(935) * lu(1192) + lu(1197) = lu(1197) - lu(936) * lu(1192) + lu(1198) = lu(1198) - lu(937) * lu(1192) + lu(1199) = lu(1199) - lu(938) * lu(1192) + lu(1200) = lu(1200) - lu(939) * lu(1192) + lu(1201) = lu(1201) - lu(940) * lu(1192) + lu(1202) = lu(1202) - lu(941) * lu(1192) + lu(1203) = lu(1203) - lu(942) * lu(1192) + lu(1204) = lu(1204) - lu(943) * lu(1192) + lu(1205) = lu(1205) - lu(944) * lu(1192) + lu(1206) = lu(1206) - lu(945) * lu(1192) + lu(1207) = lu(1207) - lu(946) * lu(1192) + lu(1208) = lu(1208) - lu(947) * lu(1192) + lu(1209) = lu(1209) - lu(948) * lu(1192) + lu(1210) = lu(1210) - lu(949) * lu(1192) + lu(1211) = lu(1211) - lu(950) * lu(1192) + lu(1212) = lu(1212) - lu(951) * lu(1192) + lu(1213) = lu(1213) - lu(952) * lu(1192) + lu(1214) = lu(1214) - lu(953) * lu(1192) + lu(1235) = lu(1235) - lu(932) * lu(1234) + lu(1236) = lu(1236) - lu(933) * lu(1234) + lu(1237) = lu(1237) - lu(934) * lu(1234) + lu(1238) = lu(1238) - lu(935) * lu(1234) + lu(1239) = lu(1239) - lu(936) * lu(1234) + lu(1240) = lu(1240) - lu(937) * lu(1234) + lu(1241) = lu(1241) - lu(938) * lu(1234) + lu(1242) = lu(1242) - lu(939) * lu(1234) + lu(1243) = lu(1243) - lu(940) * lu(1234) + lu(1244) = lu(1244) - lu(941) * lu(1234) + lu(1245) = lu(1245) - lu(942) * lu(1234) + lu(1246) = lu(1246) - lu(943) * lu(1234) + lu(1247) = lu(1247) - lu(944) * lu(1234) + lu(1248) = lu(1248) - lu(945) * lu(1234) + lu(1249) = lu(1249) - lu(946) * lu(1234) + lu(1250) = lu(1250) - lu(947) * lu(1234) + lu(1251) = lu(1251) - lu(948) * lu(1234) + lu(1252) = lu(1252) - lu(949) * lu(1234) + lu(1253) = lu(1253) - lu(950) * lu(1234) + lu(1254) = lu(1254) - lu(951) * lu(1234) + lu(1255) = lu(1255) - lu(952) * lu(1234) + lu(1256) = lu(1256) - lu(953) * lu(1234) + lu(1271) = lu(1271) - lu(932) * lu(1270) + lu(1272) = lu(1272) - lu(933) * lu(1270) + lu(1273) = lu(1273) - lu(934) * lu(1270) + lu(1274) = lu(1274) - lu(935) * lu(1270) + lu(1275) = lu(1275) - lu(936) * lu(1270) + lu(1276) = lu(1276) - lu(937) * lu(1270) + lu(1277) = lu(1277) - lu(938) * lu(1270) + lu(1278) = lu(1278) - lu(939) * lu(1270) + lu(1279) = lu(1279) - lu(940) * lu(1270) + lu(1280) = lu(1280) - lu(941) * lu(1270) + lu(1281) = lu(1281) - lu(942) * lu(1270) + lu(1282) = lu(1282) - lu(943) * lu(1270) + lu(1283) = lu(1283) - lu(944) * lu(1270) + lu(1284) = lu(1284) - lu(945) * lu(1270) + lu(1285) = lu(1285) - lu(946) * lu(1270) + lu(1286) = lu(1286) - lu(947) * lu(1270) + lu(1287) = lu(1287) - lu(948) * lu(1270) + lu(1288) = lu(1288) - lu(949) * lu(1270) + lu(1289) = lu(1289) - lu(950) * lu(1270) + lu(1290) = lu(1290) - lu(951) * lu(1270) + lu(1291) = lu(1291) - lu(952) * lu(1270) + lu(1292) = lu(1292) - lu(953) * lu(1270) + lu(1330) = lu(1330) - lu(932) * lu(1329) + lu(1331) = lu(1331) - lu(933) * lu(1329) + lu(1332) = lu(1332) - lu(934) * lu(1329) + lu(1333) = lu(1333) - lu(935) * lu(1329) + lu(1334) = lu(1334) - lu(936) * lu(1329) + lu(1335) = lu(1335) - lu(937) * lu(1329) + lu(1336) = lu(1336) - lu(938) * lu(1329) + lu(1337) = lu(1337) - lu(939) * lu(1329) + lu(1338) = lu(1338) - lu(940) * lu(1329) + lu(1339) = lu(1339) - lu(941) * lu(1329) + lu(1340) = lu(1340) - lu(942) * lu(1329) + lu(1341) = lu(1341) - lu(943) * lu(1329) + lu(1342) = lu(1342) - lu(944) * lu(1329) + lu(1343) = lu(1343) - lu(945) * lu(1329) + lu(1344) = lu(1344) - lu(946) * lu(1329) + lu(1345) = lu(1345) - lu(947) * lu(1329) + lu(1346) = lu(1346) - lu(948) * lu(1329) + lu(1347) = lu(1347) - lu(949) * lu(1329) + lu(1348) = lu(1348) - lu(950) * lu(1329) + lu(1349) = lu(1349) - lu(951) * lu(1329) + lu(1350) = lu(1350) - lu(952) * lu(1329) + lu(1351) = lu(1351) - lu(953) * lu(1329) + lu(1373) = lu(1373) - lu(932) * lu(1372) + lu(1374) = lu(1374) - lu(933) * lu(1372) + lu(1375) = lu(1375) - lu(934) * lu(1372) + lu(1376) = lu(1376) - lu(935) * lu(1372) + lu(1377) = lu(1377) - lu(936) * lu(1372) + lu(1378) = lu(1378) - lu(937) * lu(1372) + lu(1379) = lu(1379) - lu(938) * lu(1372) + lu(1380) = lu(1380) - lu(939) * lu(1372) + lu(1381) = lu(1381) - lu(940) * lu(1372) + lu(1382) = lu(1382) - lu(941) * lu(1372) + lu(1383) = lu(1383) - lu(942) * lu(1372) + lu(1384) = lu(1384) - lu(943) * lu(1372) + lu(1385) = lu(1385) - lu(944) * lu(1372) + lu(1386) = lu(1386) - lu(945) * lu(1372) + lu(1387) = lu(1387) - lu(946) * lu(1372) + lu(1388) = lu(1388) - lu(947) * lu(1372) + lu(1389) = lu(1389) - lu(948) * lu(1372) + lu(1390) = lu(1390) - lu(949) * lu(1372) + lu(1391) = lu(1391) - lu(950) * lu(1372) + lu(1392) = lu(1392) - lu(951) * lu(1372) + lu(1393) = lu(1393) - lu(952) * lu(1372) + lu(1394) = lu(1394) - lu(953) * lu(1372) + lu(1414) = lu(1414) - lu(932) * lu(1413) + lu(1415) = lu(1415) - lu(933) * lu(1413) + lu(1416) = lu(1416) - lu(934) * lu(1413) + lu(1417) = lu(1417) - lu(935) * lu(1413) + lu(1418) = lu(1418) - lu(936) * lu(1413) + lu(1419) = lu(1419) - lu(937) * lu(1413) + lu(1420) = lu(1420) - lu(938) * lu(1413) + lu(1421) = lu(1421) - lu(939) * lu(1413) + lu(1422) = lu(1422) - lu(940) * lu(1413) + lu(1423) = lu(1423) - lu(941) * lu(1413) + lu(1424) = lu(1424) - lu(942) * lu(1413) + lu(1425) = lu(1425) - lu(943) * lu(1413) + lu(1426) = lu(1426) - lu(944) * lu(1413) + lu(1427) = lu(1427) - lu(945) * lu(1413) + lu(1428) = lu(1428) - lu(946) * lu(1413) + lu(1429) = lu(1429) - lu(947) * lu(1413) + lu(1430) = lu(1430) - lu(948) * lu(1413) + lu(1431) = lu(1431) - lu(949) * lu(1413) + lu(1432) = lu(1432) - lu(950) * lu(1413) + lu(1433) = lu(1433) - lu(951) * lu(1413) + lu(1434) = lu(1434) - lu(952) * lu(1413) + lu(1435) = lu(1435) - lu(953) * lu(1413) + lu(1457) = lu(1457) - lu(932) * lu(1456) + lu(1458) = lu(1458) - lu(933) * lu(1456) + lu(1459) = lu(1459) - lu(934) * lu(1456) + lu(1460) = lu(1460) - lu(935) * lu(1456) + lu(1461) = lu(1461) - lu(936) * lu(1456) + lu(1462) = lu(1462) - lu(937) * lu(1456) + lu(1463) = lu(1463) - lu(938) * lu(1456) + lu(1464) = lu(1464) - lu(939) * lu(1456) + lu(1465) = lu(1465) - lu(940) * lu(1456) + lu(1466) = lu(1466) - lu(941) * lu(1456) + lu(1467) = lu(1467) - lu(942) * lu(1456) + lu(1468) = lu(1468) - lu(943) * lu(1456) + lu(1469) = lu(1469) - lu(944) * lu(1456) + lu(1470) = lu(1470) - lu(945) * lu(1456) + lu(1471) = lu(1471) - lu(946) * lu(1456) + lu(1472) = lu(1472) - lu(947) * lu(1456) + lu(1473) = lu(1473) - lu(948) * lu(1456) + lu(1474) = lu(1474) - lu(949) * lu(1456) + lu(1475) = lu(1475) - lu(950) * lu(1456) + lu(1476) = lu(1476) - lu(951) * lu(1456) + lu(1477) = lu(1477) - lu(952) * lu(1456) + lu(1478) = lu(1478) - lu(953) * lu(1456) + lu(1500) = lu(1500) - lu(932) * lu(1499) + lu(1501) = lu(1501) - lu(933) * lu(1499) + lu(1502) = lu(1502) - lu(934) * lu(1499) + lu(1503) = lu(1503) - lu(935) * lu(1499) + lu(1504) = lu(1504) - lu(936) * lu(1499) + lu(1505) = lu(1505) - lu(937) * lu(1499) + lu(1506) = lu(1506) - lu(938) * lu(1499) + lu(1507) = lu(1507) - lu(939) * lu(1499) + lu(1508) = lu(1508) - lu(940) * lu(1499) + lu(1509) = lu(1509) - lu(941) * lu(1499) + lu(1510) = lu(1510) - lu(942) * lu(1499) + lu(1511) = lu(1511) - lu(943) * lu(1499) + lu(1512) = lu(1512) - lu(944) * lu(1499) + lu(1513) = lu(1513) - lu(945) * lu(1499) + lu(1514) = lu(1514) - lu(946) * lu(1499) + lu(1515) = lu(1515) - lu(947) * lu(1499) + lu(1516) = lu(1516) - lu(948) * lu(1499) + lu(1517) = lu(1517) - lu(949) * lu(1499) + lu(1518) = lu(1518) - lu(950) * lu(1499) + lu(1519) = lu(1519) - lu(951) * lu(1499) + lu(1520) = lu(1520) - lu(952) * lu(1499) + lu(1521) = lu(1521) - lu(953) * lu(1499) + lu(1546) = lu(1546) - lu(932) * lu(1545) + lu(1547) = lu(1547) - lu(933) * lu(1545) + lu(1548) = lu(1548) - lu(934) * lu(1545) + lu(1549) = lu(1549) - lu(935) * lu(1545) + lu(1550) = lu(1550) - lu(936) * lu(1545) + lu(1551) = lu(1551) - lu(937) * lu(1545) + lu(1552) = lu(1552) - lu(938) * lu(1545) + lu(1553) = lu(1553) - lu(939) * lu(1545) + lu(1554) = lu(1554) - lu(940) * lu(1545) + lu(1555) = lu(1555) - lu(941) * lu(1545) + lu(1556) = lu(1556) - lu(942) * lu(1545) + lu(1557) = lu(1557) - lu(943) * lu(1545) + lu(1558) = lu(1558) - lu(944) * lu(1545) + lu(1559) = lu(1559) - lu(945) * lu(1545) + lu(1560) = lu(1560) - lu(946) * lu(1545) + lu(1561) = lu(1561) - lu(947) * lu(1545) + lu(1562) = lu(1562) - lu(948) * lu(1545) + lu(1563) = lu(1563) - lu(949) * lu(1545) + lu(1564) = lu(1564) - lu(950) * lu(1545) + lu(1565) = lu(1565) - lu(951) * lu(1545) + lu(1566) = lu(1566) - lu(952) * lu(1545) + lu(1567) = lu(1567) - lu(953) * lu(1545) + lu(1592) = lu(1592) - lu(932) * lu(1591) + lu(1593) = lu(1593) - lu(933) * lu(1591) + lu(1594) = lu(1594) - lu(934) * lu(1591) + lu(1595) = lu(1595) - lu(935) * lu(1591) + lu(1596) = lu(1596) - lu(936) * lu(1591) + lu(1597) = lu(1597) - lu(937) * lu(1591) + lu(1598) = lu(1598) - lu(938) * lu(1591) + lu(1599) = lu(1599) - lu(939) * lu(1591) + lu(1600) = lu(1600) - lu(940) * lu(1591) + lu(1601) = lu(1601) - lu(941) * lu(1591) + lu(1602) = lu(1602) - lu(942) * lu(1591) + lu(1603) = lu(1603) - lu(943) * lu(1591) + lu(1604) = lu(1604) - lu(944) * lu(1591) + lu(1605) = lu(1605) - lu(945) * lu(1591) + lu(1606) = lu(1606) - lu(946) * lu(1591) + lu(1607) = lu(1607) - lu(947) * lu(1591) + lu(1608) = lu(1608) - lu(948) * lu(1591) + lu(1609) = lu(1609) - lu(949) * lu(1591) + lu(1610) = lu(1610) - lu(950) * lu(1591) + lu(1611) = lu(1611) - lu(951) * lu(1591) + lu(1612) = lu(1612) - lu(952) * lu(1591) + lu(1613) = lu(1613) - lu(953) * lu(1591) + lu(1633) = lu(1633) - lu(932) * lu(1632) + lu(1634) = lu(1634) - lu(933) * lu(1632) + lu(1635) = lu(1635) - lu(934) * lu(1632) + lu(1636) = lu(1636) - lu(935) * lu(1632) + lu(1637) = lu(1637) - lu(936) * lu(1632) + lu(1638) = lu(1638) - lu(937) * lu(1632) + lu(1639) = lu(1639) - lu(938) * lu(1632) + lu(1640) = lu(1640) - lu(939) * lu(1632) + lu(1641) = lu(1641) - lu(940) * lu(1632) + lu(1642) = lu(1642) - lu(941) * lu(1632) + lu(1643) = lu(1643) - lu(942) * lu(1632) + lu(1644) = lu(1644) - lu(943) * lu(1632) + lu(1645) = lu(1645) - lu(944) * lu(1632) + lu(1646) = lu(1646) - lu(945) * lu(1632) + lu(1647) = lu(1647) - lu(946) * lu(1632) + lu(1648) = lu(1648) - lu(947) * lu(1632) + lu(1649) = lu(1649) - lu(948) * lu(1632) + lu(1650) = lu(1650) - lu(949) * lu(1632) + lu(1651) = lu(1651) - lu(950) * lu(1632) + lu(1652) = lu(1652) - lu(951) * lu(1632) + lu(1653) = lu(1653) - lu(952) * lu(1632) + lu(1654) = lu(1654) - lu(953) * lu(1632) + lu(1676) = lu(1676) - lu(932) * lu(1675) + lu(1677) = lu(1677) - lu(933) * lu(1675) + lu(1678) = lu(1678) - lu(934) * lu(1675) + lu(1679) = lu(1679) - lu(935) * lu(1675) + lu(1680) = lu(1680) - lu(936) * lu(1675) + lu(1681) = lu(1681) - lu(937) * lu(1675) + lu(1682) = lu(1682) - lu(938) * lu(1675) + lu(1683) = lu(1683) - lu(939) * lu(1675) + lu(1684) = lu(1684) - lu(940) * lu(1675) + lu(1685) = lu(1685) - lu(941) * lu(1675) + lu(1686) = lu(1686) - lu(942) * lu(1675) + lu(1687) = lu(1687) - lu(943) * lu(1675) + lu(1688) = lu(1688) - lu(944) * lu(1675) + lu(1689) = lu(1689) - lu(945) * lu(1675) + lu(1690) = lu(1690) - lu(946) * lu(1675) + lu(1691) = lu(1691) - lu(947) * lu(1675) + lu(1692) = lu(1692) - lu(948) * lu(1675) + lu(1693) = lu(1693) - lu(949) * lu(1675) + lu(1694) = lu(1694) - lu(950) * lu(1675) + lu(1695) = lu(1695) - lu(951) * lu(1675) + lu(1696) = lu(1696) - lu(952) * lu(1675) + lu(1697) = lu(1697) - lu(953) * lu(1675) + lu(1716) = lu(1716) - lu(932) * lu(1715) + lu(1717) = lu(1717) - lu(933) * lu(1715) + lu(1718) = lu(1718) - lu(934) * lu(1715) + lu(1719) = lu(1719) - lu(935) * lu(1715) + lu(1720) = lu(1720) - lu(936) * lu(1715) + lu(1721) = lu(1721) - lu(937) * lu(1715) + lu(1722) = lu(1722) - lu(938) * lu(1715) + lu(1723) = lu(1723) - lu(939) * lu(1715) + lu(1724) = lu(1724) - lu(940) * lu(1715) + lu(1725) = lu(1725) - lu(941) * lu(1715) + lu(1726) = lu(1726) - lu(942) * lu(1715) + lu(1727) = lu(1727) - lu(943) * lu(1715) + lu(1728) = lu(1728) - lu(944) * lu(1715) + lu(1729) = lu(1729) - lu(945) * lu(1715) + lu(1730) = lu(1730) - lu(946) * lu(1715) + lu(1731) = lu(1731) - lu(947) * lu(1715) + lu(1732) = lu(1732) - lu(948) * lu(1715) + lu(1733) = lu(1733) - lu(949) * lu(1715) + lu(1734) = lu(1734) - lu(950) * lu(1715) + lu(1735) = lu(1735) - lu(951) * lu(1715) + lu(1736) = lu(1736) - lu(952) * lu(1715) + lu(1737) = lu(1737) - lu(953) * lu(1715) + lu(1762) = lu(1762) - lu(932) * lu(1761) + lu(1763) = lu(1763) - lu(933) * lu(1761) + lu(1764) = lu(1764) - lu(934) * lu(1761) + lu(1765) = lu(1765) - lu(935) * lu(1761) + lu(1766) = lu(1766) - lu(936) * lu(1761) + lu(1767) = lu(1767) - lu(937) * lu(1761) + lu(1768) = lu(1768) - lu(938) * lu(1761) + lu(1769) = lu(1769) - lu(939) * lu(1761) + lu(1770) = lu(1770) - lu(940) * lu(1761) + lu(1771) = lu(1771) - lu(941) * lu(1761) + lu(1772) = lu(1772) - lu(942) * lu(1761) + lu(1773) = lu(1773) - lu(943) * lu(1761) + lu(1774) = lu(1774) - lu(944) * lu(1761) + lu(1775) = lu(1775) - lu(945) * lu(1761) + lu(1776) = lu(1776) - lu(946) * lu(1761) + lu(1777) = lu(1777) - lu(947) * lu(1761) + lu(1778) = lu(1778) - lu(948) * lu(1761) + lu(1779) = lu(1779) - lu(949) * lu(1761) + lu(1780) = lu(1780) - lu(950) * lu(1761) + lu(1781) = lu(1781) - lu(951) * lu(1761) + lu(1782) = lu(1782) - lu(952) * lu(1761) + lu(1783) = lu(1783) - lu(953) * lu(1761) + lu(1798) = lu(1798) - lu(932) * lu(1797) + lu(1799) = lu(1799) - lu(933) * lu(1797) + lu(1800) = lu(1800) - lu(934) * lu(1797) + lu(1801) = lu(1801) - lu(935) * lu(1797) + lu(1802) = lu(1802) - lu(936) * lu(1797) + lu(1803) = lu(1803) - lu(937) * lu(1797) + lu(1804) = lu(1804) - lu(938) * lu(1797) + lu(1805) = lu(1805) - lu(939) * lu(1797) + lu(1806) = lu(1806) - lu(940) * lu(1797) + lu(1807) = lu(1807) - lu(941) * lu(1797) + lu(1808) = lu(1808) - lu(942) * lu(1797) + lu(1809) = lu(1809) - lu(943) * lu(1797) + lu(1810) = lu(1810) - lu(944) * lu(1797) + lu(1811) = lu(1811) - lu(945) * lu(1797) + lu(1812) = lu(1812) - lu(946) * lu(1797) + lu(1813) = lu(1813) - lu(947) * lu(1797) + lu(1814) = lu(1814) - lu(948) * lu(1797) + lu(1815) = lu(1815) - lu(949) * lu(1797) + lu(1816) = lu(1816) - lu(950) * lu(1797) + lu(1817) = lu(1817) - lu(951) * lu(1797) + lu(1818) = lu(1818) - lu(952) * lu(1797) + lu(1819) = lu(1819) - lu(953) * lu(1797) + lu(1840) = lu(1840) - lu(932) * lu(1839) + lu(1841) = lu(1841) - lu(933) * lu(1839) + lu(1842) = lu(1842) - lu(934) * lu(1839) + lu(1843) = lu(1843) - lu(935) * lu(1839) + lu(1844) = lu(1844) - lu(936) * lu(1839) + lu(1845) = lu(1845) - lu(937) * lu(1839) + lu(1846) = lu(1846) - lu(938) * lu(1839) + lu(1847) = lu(1847) - lu(939) * lu(1839) + lu(1848) = lu(1848) - lu(940) * lu(1839) + lu(1849) = lu(1849) - lu(941) * lu(1839) + lu(1850) = lu(1850) - lu(942) * lu(1839) + lu(1851) = lu(1851) - lu(943) * lu(1839) + lu(1852) = lu(1852) - lu(944) * lu(1839) + lu(1853) = lu(1853) - lu(945) * lu(1839) + lu(1854) = lu(1854) - lu(946) * lu(1839) + lu(1855) = lu(1855) - lu(947) * lu(1839) + lu(1856) = lu(1856) - lu(948) * lu(1839) + lu(1857) = lu(1857) - lu(949) * lu(1839) + lu(1858) = lu(1858) - lu(950) * lu(1839) + lu(1859) = lu(1859) - lu(951) * lu(1839) + lu(1860) = lu(1860) - lu(952) * lu(1839) + lu(1861) = lu(1861) - lu(953) * lu(1839) + lu(1886) = lu(1886) - lu(932) * lu(1885) + lu(1887) = lu(1887) - lu(933) * lu(1885) + lu(1888) = lu(1888) - lu(934) * lu(1885) + lu(1889) = lu(1889) - lu(935) * lu(1885) + lu(1890) = lu(1890) - lu(936) * lu(1885) + lu(1891) = lu(1891) - lu(937) * lu(1885) + lu(1892) = lu(1892) - lu(938) * lu(1885) + lu(1893) = lu(1893) - lu(939) * lu(1885) + lu(1894) = lu(1894) - lu(940) * lu(1885) + lu(1895) = lu(1895) - lu(941) * lu(1885) + lu(1896) = lu(1896) - lu(942) * lu(1885) + lu(1897) = lu(1897) - lu(943) * lu(1885) + lu(1898) = lu(1898) - lu(944) * lu(1885) + lu(1899) = lu(1899) - lu(945) * lu(1885) + lu(1900) = lu(1900) - lu(946) * lu(1885) + lu(1901) = lu(1901) - lu(947) * lu(1885) + lu(1902) = lu(1902) - lu(948) * lu(1885) + lu(1903) = lu(1903) - lu(949) * lu(1885) + lu(1904) = lu(1904) - lu(950) * lu(1885) + lu(1905) = lu(1905) - lu(951) * lu(1885) + lu(1906) = lu(1906) - lu(952) * lu(1885) + lu(1907) = lu(1907) - lu(953) * lu(1885) + lu(965) = 1._r8 / lu(965) + lu(966) = lu(966) * lu(965) + lu(967) = lu(967) * lu(965) + lu(968) = lu(968) * lu(965) + lu(969) = lu(969) * lu(965) + lu(970) = lu(970) * lu(965) + lu(971) = lu(971) * lu(965) + lu(972) = lu(972) * lu(965) + lu(973) = lu(973) * lu(965) + lu(974) = lu(974) * lu(965) + lu(975) = lu(975) * lu(965) + lu(976) = lu(976) * lu(965) + lu(977) = lu(977) * lu(965) + lu(978) = lu(978) * lu(965) + lu(979) = lu(979) * lu(965) + lu(980) = lu(980) * lu(965) + lu(981) = lu(981) * lu(965) + lu(982) = lu(982) * lu(965) + lu(983) = lu(983) * lu(965) + lu(984) = lu(984) * lu(965) + lu(985) = lu(985) * lu(965) + lu(986) = lu(986) * lu(965) + lu(1010) = lu(1010) - lu(966) * lu(1009) + lu(1011) = lu(1011) - lu(967) * lu(1009) + lu(1012) = lu(1012) - lu(968) * lu(1009) + lu(1013) = lu(1013) - lu(969) * lu(1009) + lu(1014) = lu(1014) - lu(970) * lu(1009) + lu(1015) = lu(1015) - lu(971) * lu(1009) + lu(1016) = lu(1016) - lu(972) * lu(1009) + lu(1017) = lu(1017) - lu(973) * lu(1009) + lu(1018) = lu(1018) - lu(974) * lu(1009) + lu(1019) = lu(1019) - lu(975) * lu(1009) + lu(1020) = lu(1020) - lu(976) * lu(1009) + lu(1021) = lu(1021) - lu(977) * lu(1009) + lu(1022) = lu(1022) - lu(978) * lu(1009) + lu(1023) = lu(1023) - lu(979) * lu(1009) + lu(1024) = lu(1024) - lu(980) * lu(1009) + lu(1025) = lu(1025) - lu(981) * lu(1009) + lu(1026) = lu(1026) - lu(982) * lu(1009) + lu(1027) = lu(1027) - lu(983) * lu(1009) + lu(1028) = lu(1028) - lu(984) * lu(1009) + lu(1029) = lu(1029) - lu(985) * lu(1009) + lu(1030) = lu(1030) - lu(986) * lu(1009) + lu(1050) = lu(1050) - lu(966) * lu(1049) + lu(1051) = lu(1051) - lu(967) * lu(1049) + lu(1052) = lu(1052) - lu(968) * lu(1049) + lu(1053) = lu(1053) - lu(969) * lu(1049) + lu(1054) = lu(1054) - lu(970) * lu(1049) + lu(1055) = lu(1055) - lu(971) * lu(1049) + lu(1056) = lu(1056) - lu(972) * lu(1049) + lu(1057) = lu(1057) - lu(973) * lu(1049) + lu(1058) = lu(1058) - lu(974) * lu(1049) + lu(1059) = lu(1059) - lu(975) * lu(1049) + lu(1060) = lu(1060) - lu(976) * lu(1049) + lu(1061) = lu(1061) - lu(977) * lu(1049) + lu(1062) = lu(1062) - lu(978) * lu(1049) + lu(1063) = lu(1063) - lu(979) * lu(1049) + lu(1064) = lu(1064) - lu(980) * lu(1049) + lu(1065) = lu(1065) - lu(981) * lu(1049) + lu(1066) = lu(1066) - lu(982) * lu(1049) + lu(1067) = lu(1067) - lu(983) * lu(1049) + lu(1068) = lu(1068) - lu(984) * lu(1049) + lu(1069) = lu(1069) - lu(985) * lu(1049) + lu(1070) = lu(1070) - lu(986) * lu(1049) + lu(1108) = lu(1108) - lu(966) * lu(1107) + lu(1109) = lu(1109) - lu(967) * lu(1107) + lu(1110) = lu(1110) - lu(968) * lu(1107) + lu(1111) = lu(1111) - lu(969) * lu(1107) + lu(1112) = lu(1112) - lu(970) * lu(1107) + lu(1113) = lu(1113) - lu(971) * lu(1107) + lu(1114) = lu(1114) - lu(972) * lu(1107) + lu(1115) = lu(1115) - lu(973) * lu(1107) + lu(1116) = lu(1116) - lu(974) * lu(1107) + lu(1117) = lu(1117) - lu(975) * lu(1107) + lu(1118) = lu(1118) - lu(976) * lu(1107) + lu(1119) = lu(1119) - lu(977) * lu(1107) + lu(1120) = lu(1120) - lu(978) * lu(1107) + lu(1121) = lu(1121) - lu(979) * lu(1107) + lu(1122) = lu(1122) - lu(980) * lu(1107) + lu(1123) = lu(1123) - lu(981) * lu(1107) + lu(1124) = lu(1124) - lu(982) * lu(1107) + lu(1125) = lu(1125) - lu(983) * lu(1107) + lu(1126) = lu(1126) - lu(984) * lu(1107) + lu(1127) = lu(1127) - lu(985) * lu(1107) + lu(1128) = lu(1128) - lu(986) * lu(1107) + lu(1148) = lu(1148) - lu(966) * lu(1147) + lu(1149) = lu(1149) - lu(967) * lu(1147) + lu(1150) = lu(1150) - lu(968) * lu(1147) + lu(1151) = lu(1151) - lu(969) * lu(1147) + lu(1152) = lu(1152) - lu(970) * lu(1147) + lu(1153) = lu(1153) - lu(971) * lu(1147) + lu(1154) = lu(1154) - lu(972) * lu(1147) + lu(1155) = lu(1155) - lu(973) * lu(1147) + lu(1156) = lu(1156) - lu(974) * lu(1147) + lu(1157) = lu(1157) - lu(975) * lu(1147) + lu(1158) = lu(1158) - lu(976) * lu(1147) + lu(1159) = lu(1159) - lu(977) * lu(1147) + lu(1160) = lu(1160) - lu(978) * lu(1147) + lu(1161) = lu(1161) - lu(979) * lu(1147) + lu(1162) = lu(1162) - lu(980) * lu(1147) + lu(1163) = lu(1163) - lu(981) * lu(1147) + lu(1164) = lu(1164) - lu(982) * lu(1147) + lu(1165) = lu(1165) - lu(983) * lu(1147) + lu(1166) = lu(1166) - lu(984) * lu(1147) + lu(1167) = lu(1167) - lu(985) * lu(1147) + lu(1168) = lu(1168) - lu(986) * lu(1147) + lu(1194) = lu(1194) - lu(966) * lu(1193) + lu(1195) = lu(1195) - lu(967) * lu(1193) + lu(1196) = lu(1196) - lu(968) * lu(1193) + lu(1197) = lu(1197) - lu(969) * lu(1193) + lu(1198) = lu(1198) - lu(970) * lu(1193) + lu(1199) = lu(1199) - lu(971) * lu(1193) + lu(1200) = lu(1200) - lu(972) * lu(1193) + lu(1201) = lu(1201) - lu(973) * lu(1193) + lu(1202) = lu(1202) - lu(974) * lu(1193) + lu(1203) = lu(1203) - lu(975) * lu(1193) + lu(1204) = lu(1204) - lu(976) * lu(1193) + lu(1205) = lu(1205) - lu(977) * lu(1193) + lu(1206) = lu(1206) - lu(978) * lu(1193) + lu(1207) = lu(1207) - lu(979) * lu(1193) + lu(1208) = lu(1208) - lu(980) * lu(1193) + lu(1209) = lu(1209) - lu(981) * lu(1193) + lu(1210) = lu(1210) - lu(982) * lu(1193) + lu(1211) = lu(1211) - lu(983) * lu(1193) + lu(1212) = lu(1212) - lu(984) * lu(1193) + lu(1213) = lu(1213) - lu(985) * lu(1193) + lu(1214) = lu(1214) - lu(986) * lu(1193) + lu(1236) = lu(1236) - lu(966) * lu(1235) + lu(1237) = lu(1237) - lu(967) * lu(1235) + lu(1238) = lu(1238) - lu(968) * lu(1235) + lu(1239) = lu(1239) - lu(969) * lu(1235) + lu(1240) = lu(1240) - lu(970) * lu(1235) + lu(1241) = lu(1241) - lu(971) * lu(1235) + lu(1242) = lu(1242) - lu(972) * lu(1235) + lu(1243) = lu(1243) - lu(973) * lu(1235) + lu(1244) = lu(1244) - lu(974) * lu(1235) + lu(1245) = lu(1245) - lu(975) * lu(1235) + lu(1246) = lu(1246) - lu(976) * lu(1235) + lu(1247) = lu(1247) - lu(977) * lu(1235) + lu(1248) = lu(1248) - lu(978) * lu(1235) + lu(1249) = lu(1249) - lu(979) * lu(1235) + lu(1250) = lu(1250) - lu(980) * lu(1235) + lu(1251) = lu(1251) - lu(981) * lu(1235) + lu(1252) = lu(1252) - lu(982) * lu(1235) + lu(1253) = lu(1253) - lu(983) * lu(1235) + lu(1254) = lu(1254) - lu(984) * lu(1235) + lu(1255) = lu(1255) - lu(985) * lu(1235) + lu(1256) = lu(1256) - lu(986) * lu(1235) + lu(1272) = lu(1272) - lu(966) * lu(1271) + lu(1273) = lu(1273) - lu(967) * lu(1271) + lu(1274) = lu(1274) - lu(968) * lu(1271) + lu(1275) = lu(1275) - lu(969) * lu(1271) + lu(1276) = lu(1276) - lu(970) * lu(1271) + lu(1277) = lu(1277) - lu(971) * lu(1271) + lu(1278) = lu(1278) - lu(972) * lu(1271) + lu(1279) = lu(1279) - lu(973) * lu(1271) + lu(1280) = lu(1280) - lu(974) * lu(1271) + lu(1281) = lu(1281) - lu(975) * lu(1271) + lu(1282) = lu(1282) - lu(976) * lu(1271) + lu(1283) = lu(1283) - lu(977) * lu(1271) + lu(1284) = lu(1284) - lu(978) * lu(1271) + lu(1285) = lu(1285) - lu(979) * lu(1271) + lu(1286) = lu(1286) - lu(980) * lu(1271) + lu(1287) = lu(1287) - lu(981) * lu(1271) + lu(1288) = lu(1288) - lu(982) * lu(1271) + lu(1289) = lu(1289) - lu(983) * lu(1271) + lu(1290) = lu(1290) - lu(984) * lu(1271) + lu(1291) = lu(1291) - lu(985) * lu(1271) + lu(1292) = lu(1292) - lu(986) * lu(1271) + lu(1331) = lu(1331) - lu(966) * lu(1330) + lu(1332) = lu(1332) - lu(967) * lu(1330) + lu(1333) = lu(1333) - lu(968) * lu(1330) + lu(1334) = lu(1334) - lu(969) * lu(1330) + lu(1335) = lu(1335) - lu(970) * lu(1330) + lu(1336) = lu(1336) - lu(971) * lu(1330) + lu(1337) = lu(1337) - lu(972) * lu(1330) + lu(1338) = lu(1338) - lu(973) * lu(1330) + lu(1339) = lu(1339) - lu(974) * lu(1330) + lu(1340) = lu(1340) - lu(975) * lu(1330) + lu(1341) = lu(1341) - lu(976) * lu(1330) + lu(1342) = lu(1342) - lu(977) * lu(1330) + lu(1343) = lu(1343) - lu(978) * lu(1330) + lu(1344) = lu(1344) - lu(979) * lu(1330) + lu(1345) = lu(1345) - lu(980) * lu(1330) + lu(1346) = lu(1346) - lu(981) * lu(1330) + lu(1347) = lu(1347) - lu(982) * lu(1330) + lu(1348) = lu(1348) - lu(983) * lu(1330) + lu(1349) = lu(1349) - lu(984) * lu(1330) + lu(1350) = lu(1350) - lu(985) * lu(1330) + lu(1351) = lu(1351) - lu(986) * lu(1330) + lu(1374) = lu(1374) - lu(966) * lu(1373) + lu(1375) = lu(1375) - lu(967) * lu(1373) + lu(1376) = lu(1376) - lu(968) * lu(1373) + lu(1377) = lu(1377) - lu(969) * lu(1373) + lu(1378) = lu(1378) - lu(970) * lu(1373) + lu(1379) = lu(1379) - lu(971) * lu(1373) + lu(1380) = lu(1380) - lu(972) * lu(1373) + lu(1381) = lu(1381) - lu(973) * lu(1373) + lu(1382) = lu(1382) - lu(974) * lu(1373) + lu(1383) = lu(1383) - lu(975) * lu(1373) + lu(1384) = lu(1384) - lu(976) * lu(1373) + lu(1385) = lu(1385) - lu(977) * lu(1373) + lu(1386) = lu(1386) - lu(978) * lu(1373) + lu(1387) = lu(1387) - lu(979) * lu(1373) + lu(1388) = lu(1388) - lu(980) * lu(1373) + lu(1389) = lu(1389) - lu(981) * lu(1373) + lu(1390) = lu(1390) - lu(982) * lu(1373) + lu(1391) = lu(1391) - lu(983) * lu(1373) + lu(1392) = lu(1392) - lu(984) * lu(1373) + lu(1393) = lu(1393) - lu(985) * lu(1373) + lu(1394) = lu(1394) - lu(986) * lu(1373) + lu(1415) = lu(1415) - lu(966) * lu(1414) + lu(1416) = lu(1416) - lu(967) * lu(1414) + lu(1417) = lu(1417) - lu(968) * lu(1414) + lu(1418) = lu(1418) - lu(969) * lu(1414) + lu(1419) = lu(1419) - lu(970) * lu(1414) + lu(1420) = lu(1420) - lu(971) * lu(1414) + lu(1421) = lu(1421) - lu(972) * lu(1414) + lu(1422) = lu(1422) - lu(973) * lu(1414) + lu(1423) = lu(1423) - lu(974) * lu(1414) + lu(1424) = lu(1424) - lu(975) * lu(1414) + lu(1425) = lu(1425) - lu(976) * lu(1414) + lu(1426) = lu(1426) - lu(977) * lu(1414) + lu(1427) = lu(1427) - lu(978) * lu(1414) + lu(1428) = lu(1428) - lu(979) * lu(1414) + lu(1429) = lu(1429) - lu(980) * lu(1414) + lu(1430) = lu(1430) - lu(981) * lu(1414) + lu(1431) = lu(1431) - lu(982) * lu(1414) + lu(1432) = lu(1432) - lu(983) * lu(1414) + lu(1433) = lu(1433) - lu(984) * lu(1414) + lu(1434) = lu(1434) - lu(985) * lu(1414) + lu(1435) = lu(1435) - lu(986) * lu(1414) + lu(1458) = lu(1458) - lu(966) * lu(1457) + lu(1459) = lu(1459) - lu(967) * lu(1457) + lu(1460) = lu(1460) - lu(968) * lu(1457) + lu(1461) = lu(1461) - lu(969) * lu(1457) + lu(1462) = lu(1462) - lu(970) * lu(1457) + lu(1463) = lu(1463) - lu(971) * lu(1457) + lu(1464) = lu(1464) - lu(972) * lu(1457) + lu(1465) = lu(1465) - lu(973) * lu(1457) + lu(1466) = lu(1466) - lu(974) * lu(1457) + lu(1467) = lu(1467) - lu(975) * lu(1457) + lu(1468) = lu(1468) - lu(976) * lu(1457) + lu(1469) = lu(1469) - lu(977) * lu(1457) + lu(1470) = lu(1470) - lu(978) * lu(1457) + lu(1471) = lu(1471) - lu(979) * lu(1457) + lu(1472) = lu(1472) - lu(980) * lu(1457) + lu(1473) = lu(1473) - lu(981) * lu(1457) + lu(1474) = lu(1474) - lu(982) * lu(1457) + lu(1475) = lu(1475) - lu(983) * lu(1457) + lu(1476) = lu(1476) - lu(984) * lu(1457) + lu(1477) = lu(1477) - lu(985) * lu(1457) + lu(1478) = lu(1478) - lu(986) * lu(1457) + lu(1501) = lu(1501) - lu(966) * lu(1500) + lu(1502) = lu(1502) - lu(967) * lu(1500) + lu(1503) = lu(1503) - lu(968) * lu(1500) + lu(1504) = lu(1504) - lu(969) * lu(1500) + lu(1505) = lu(1505) - lu(970) * lu(1500) + lu(1506) = lu(1506) - lu(971) * lu(1500) + lu(1507) = lu(1507) - lu(972) * lu(1500) + lu(1508) = lu(1508) - lu(973) * lu(1500) + lu(1509) = lu(1509) - lu(974) * lu(1500) + lu(1510) = lu(1510) - lu(975) * lu(1500) + lu(1511) = lu(1511) - lu(976) * lu(1500) + lu(1512) = lu(1512) - lu(977) * lu(1500) + lu(1513) = lu(1513) - lu(978) * lu(1500) + lu(1514) = lu(1514) - lu(979) * lu(1500) + lu(1515) = lu(1515) - lu(980) * lu(1500) + lu(1516) = lu(1516) - lu(981) * lu(1500) + lu(1517) = lu(1517) - lu(982) * lu(1500) + lu(1518) = lu(1518) - lu(983) * lu(1500) + lu(1519) = lu(1519) - lu(984) * lu(1500) + lu(1520) = lu(1520) - lu(985) * lu(1500) + lu(1521) = lu(1521) - lu(986) * lu(1500) + lu(1547) = lu(1547) - lu(966) * lu(1546) + lu(1548) = lu(1548) - lu(967) * lu(1546) + lu(1549) = lu(1549) - lu(968) * lu(1546) + lu(1550) = lu(1550) - lu(969) * lu(1546) + lu(1551) = lu(1551) - lu(970) * lu(1546) + lu(1552) = lu(1552) - lu(971) * lu(1546) + lu(1553) = lu(1553) - lu(972) * lu(1546) + lu(1554) = lu(1554) - lu(973) * lu(1546) + lu(1555) = lu(1555) - lu(974) * lu(1546) + lu(1556) = lu(1556) - lu(975) * lu(1546) + lu(1557) = lu(1557) - lu(976) * lu(1546) + lu(1558) = lu(1558) - lu(977) * lu(1546) + lu(1559) = lu(1559) - lu(978) * lu(1546) + lu(1560) = lu(1560) - lu(979) * lu(1546) + lu(1561) = lu(1561) - lu(980) * lu(1546) + lu(1562) = lu(1562) - lu(981) * lu(1546) + lu(1563) = lu(1563) - lu(982) * lu(1546) + lu(1564) = lu(1564) - lu(983) * lu(1546) + lu(1565) = lu(1565) - lu(984) * lu(1546) + lu(1566) = lu(1566) - lu(985) * lu(1546) + lu(1567) = lu(1567) - lu(986) * lu(1546) + lu(1593) = lu(1593) - lu(966) * lu(1592) + lu(1594) = lu(1594) - lu(967) * lu(1592) + lu(1595) = lu(1595) - lu(968) * lu(1592) + lu(1596) = lu(1596) - lu(969) * lu(1592) + lu(1597) = lu(1597) - lu(970) * lu(1592) + lu(1598) = lu(1598) - lu(971) * lu(1592) + lu(1599) = lu(1599) - lu(972) * lu(1592) + lu(1600) = lu(1600) - lu(973) * lu(1592) + lu(1601) = lu(1601) - lu(974) * lu(1592) + lu(1602) = lu(1602) - lu(975) * lu(1592) + lu(1603) = lu(1603) - lu(976) * lu(1592) + lu(1604) = lu(1604) - lu(977) * lu(1592) + lu(1605) = lu(1605) - lu(978) * lu(1592) + lu(1606) = lu(1606) - lu(979) * lu(1592) + lu(1607) = lu(1607) - lu(980) * lu(1592) + lu(1608) = lu(1608) - lu(981) * lu(1592) + lu(1609) = lu(1609) - lu(982) * lu(1592) + lu(1610) = lu(1610) - lu(983) * lu(1592) + lu(1611) = lu(1611) - lu(984) * lu(1592) + lu(1612) = lu(1612) - lu(985) * lu(1592) + lu(1613) = lu(1613) - lu(986) * lu(1592) + lu(1634) = lu(1634) - lu(966) * lu(1633) + lu(1635) = lu(1635) - lu(967) * lu(1633) + lu(1636) = lu(1636) - lu(968) * lu(1633) + lu(1637) = lu(1637) - lu(969) * lu(1633) + lu(1638) = lu(1638) - lu(970) * lu(1633) + lu(1639) = lu(1639) - lu(971) * lu(1633) + lu(1640) = lu(1640) - lu(972) * lu(1633) + lu(1641) = lu(1641) - lu(973) * lu(1633) + lu(1642) = lu(1642) - lu(974) * lu(1633) + lu(1643) = lu(1643) - lu(975) * lu(1633) + lu(1644) = lu(1644) - lu(976) * lu(1633) + lu(1645) = lu(1645) - lu(977) * lu(1633) + lu(1646) = lu(1646) - lu(978) * lu(1633) + lu(1647) = lu(1647) - lu(979) * lu(1633) + lu(1648) = lu(1648) - lu(980) * lu(1633) + lu(1649) = lu(1649) - lu(981) * lu(1633) + lu(1650) = lu(1650) - lu(982) * lu(1633) + lu(1651) = lu(1651) - lu(983) * lu(1633) + lu(1652) = lu(1652) - lu(984) * lu(1633) + lu(1653) = lu(1653) - lu(985) * lu(1633) + lu(1654) = lu(1654) - lu(986) * lu(1633) + lu(1677) = lu(1677) - lu(966) * lu(1676) + lu(1678) = lu(1678) - lu(967) * lu(1676) + lu(1679) = lu(1679) - lu(968) * lu(1676) + lu(1680) = lu(1680) - lu(969) * lu(1676) + lu(1681) = lu(1681) - lu(970) * lu(1676) + lu(1682) = lu(1682) - lu(971) * lu(1676) + lu(1683) = lu(1683) - lu(972) * lu(1676) + lu(1684) = lu(1684) - lu(973) * lu(1676) + lu(1685) = lu(1685) - lu(974) * lu(1676) + lu(1686) = lu(1686) - lu(975) * lu(1676) + lu(1687) = lu(1687) - lu(976) * lu(1676) + lu(1688) = lu(1688) - lu(977) * lu(1676) + lu(1689) = lu(1689) - lu(978) * lu(1676) + lu(1690) = lu(1690) - lu(979) * lu(1676) + lu(1691) = lu(1691) - lu(980) * lu(1676) + lu(1692) = lu(1692) - lu(981) * lu(1676) + lu(1693) = lu(1693) - lu(982) * lu(1676) + lu(1694) = lu(1694) - lu(983) * lu(1676) + lu(1695) = lu(1695) - lu(984) * lu(1676) + lu(1696) = lu(1696) - lu(985) * lu(1676) + lu(1697) = lu(1697) - lu(986) * lu(1676) + lu(1717) = lu(1717) - lu(966) * lu(1716) + lu(1718) = lu(1718) - lu(967) * lu(1716) + lu(1719) = lu(1719) - lu(968) * lu(1716) + lu(1720) = lu(1720) - lu(969) * lu(1716) + lu(1721) = lu(1721) - lu(970) * lu(1716) + lu(1722) = lu(1722) - lu(971) * lu(1716) + lu(1723) = lu(1723) - lu(972) * lu(1716) + lu(1724) = lu(1724) - lu(973) * lu(1716) + lu(1725) = lu(1725) - lu(974) * lu(1716) + lu(1726) = lu(1726) - lu(975) * lu(1716) + lu(1727) = lu(1727) - lu(976) * lu(1716) + lu(1728) = lu(1728) - lu(977) * lu(1716) + lu(1729) = lu(1729) - lu(978) * lu(1716) + lu(1730) = lu(1730) - lu(979) * lu(1716) + lu(1731) = lu(1731) - lu(980) * lu(1716) + lu(1732) = lu(1732) - lu(981) * lu(1716) + lu(1733) = lu(1733) - lu(982) * lu(1716) + lu(1734) = lu(1734) - lu(983) * lu(1716) + lu(1735) = lu(1735) - lu(984) * lu(1716) + lu(1736) = lu(1736) - lu(985) * lu(1716) + lu(1737) = lu(1737) - lu(986) * lu(1716) + lu(1763) = lu(1763) - lu(966) * lu(1762) + lu(1764) = lu(1764) - lu(967) * lu(1762) + lu(1765) = lu(1765) - lu(968) * lu(1762) + lu(1766) = lu(1766) - lu(969) * lu(1762) + lu(1767) = lu(1767) - lu(970) * lu(1762) + lu(1768) = lu(1768) - lu(971) * lu(1762) + lu(1769) = lu(1769) - lu(972) * lu(1762) + lu(1770) = lu(1770) - lu(973) * lu(1762) + lu(1771) = lu(1771) - lu(974) * lu(1762) + lu(1772) = lu(1772) - lu(975) * lu(1762) + lu(1773) = lu(1773) - lu(976) * lu(1762) + lu(1774) = lu(1774) - lu(977) * lu(1762) + lu(1775) = lu(1775) - lu(978) * lu(1762) + lu(1776) = lu(1776) - lu(979) * lu(1762) + lu(1777) = lu(1777) - lu(980) * lu(1762) + lu(1778) = lu(1778) - lu(981) * lu(1762) + lu(1779) = lu(1779) - lu(982) * lu(1762) + lu(1780) = lu(1780) - lu(983) * lu(1762) + lu(1781) = lu(1781) - lu(984) * lu(1762) + lu(1782) = lu(1782) - lu(985) * lu(1762) + lu(1783) = lu(1783) - lu(986) * lu(1762) + lu(1799) = lu(1799) - lu(966) * lu(1798) + lu(1800) = lu(1800) - lu(967) * lu(1798) + lu(1801) = lu(1801) - lu(968) * lu(1798) + lu(1802) = lu(1802) - lu(969) * lu(1798) + lu(1803) = lu(1803) - lu(970) * lu(1798) + lu(1804) = lu(1804) - lu(971) * lu(1798) + lu(1805) = lu(1805) - lu(972) * lu(1798) + lu(1806) = lu(1806) - lu(973) * lu(1798) + lu(1807) = lu(1807) - lu(974) * lu(1798) + lu(1808) = lu(1808) - lu(975) * lu(1798) + lu(1809) = lu(1809) - lu(976) * lu(1798) + lu(1810) = lu(1810) - lu(977) * lu(1798) + lu(1811) = lu(1811) - lu(978) * lu(1798) + lu(1812) = lu(1812) - lu(979) * lu(1798) + lu(1813) = lu(1813) - lu(980) * lu(1798) + lu(1814) = lu(1814) - lu(981) * lu(1798) + lu(1815) = lu(1815) - lu(982) * lu(1798) + lu(1816) = lu(1816) - lu(983) * lu(1798) + lu(1817) = lu(1817) - lu(984) * lu(1798) + lu(1818) = lu(1818) - lu(985) * lu(1798) + lu(1819) = lu(1819) - lu(986) * lu(1798) + lu(1841) = lu(1841) - lu(966) * lu(1840) + lu(1842) = lu(1842) - lu(967) * lu(1840) + lu(1843) = lu(1843) - lu(968) * lu(1840) + lu(1844) = lu(1844) - lu(969) * lu(1840) + lu(1845) = lu(1845) - lu(970) * lu(1840) + lu(1846) = lu(1846) - lu(971) * lu(1840) + lu(1847) = lu(1847) - lu(972) * lu(1840) + lu(1848) = lu(1848) - lu(973) * lu(1840) + lu(1849) = lu(1849) - lu(974) * lu(1840) + lu(1850) = lu(1850) - lu(975) * lu(1840) + lu(1851) = lu(1851) - lu(976) * lu(1840) + lu(1852) = lu(1852) - lu(977) * lu(1840) + lu(1853) = lu(1853) - lu(978) * lu(1840) + lu(1854) = lu(1854) - lu(979) * lu(1840) + lu(1855) = lu(1855) - lu(980) * lu(1840) + lu(1856) = lu(1856) - lu(981) * lu(1840) + lu(1857) = lu(1857) - lu(982) * lu(1840) + lu(1858) = lu(1858) - lu(983) * lu(1840) + lu(1859) = lu(1859) - lu(984) * lu(1840) + lu(1860) = lu(1860) - lu(985) * lu(1840) + lu(1861) = lu(1861) - lu(986) * lu(1840) + lu(1887) = lu(1887) - lu(966) * lu(1886) + lu(1888) = lu(1888) - lu(967) * lu(1886) + lu(1889) = lu(1889) - lu(968) * lu(1886) + lu(1890) = lu(1890) - lu(969) * lu(1886) + lu(1891) = lu(1891) - lu(970) * lu(1886) + lu(1892) = lu(1892) - lu(971) * lu(1886) + lu(1893) = lu(1893) - lu(972) * lu(1886) + lu(1894) = lu(1894) - lu(973) * lu(1886) + lu(1895) = lu(1895) - lu(974) * lu(1886) + lu(1896) = lu(1896) - lu(975) * lu(1886) + lu(1897) = lu(1897) - lu(976) * lu(1886) + lu(1898) = lu(1898) - lu(977) * lu(1886) + lu(1899) = lu(1899) - lu(978) * lu(1886) + lu(1900) = lu(1900) - lu(979) * lu(1886) + lu(1901) = lu(1901) - lu(980) * lu(1886) + lu(1902) = lu(1902) - lu(981) * lu(1886) + lu(1903) = lu(1903) - lu(982) * lu(1886) + lu(1904) = lu(1904) - lu(983) * lu(1886) + lu(1905) = lu(1905) - lu(984) * lu(1886) + lu(1906) = lu(1906) - lu(985) * lu(1886) + lu(1907) = lu(1907) - lu(986) * lu(1886) + lu(1010) = 1._r8 / lu(1010) + lu(1011) = lu(1011) * lu(1010) + lu(1012) = lu(1012) * lu(1010) + lu(1013) = lu(1013) * lu(1010) + lu(1014) = lu(1014) * lu(1010) + lu(1015) = lu(1015) * lu(1010) + lu(1016) = lu(1016) * lu(1010) + lu(1017) = lu(1017) * lu(1010) + lu(1018) = lu(1018) * lu(1010) + lu(1019) = lu(1019) * lu(1010) + lu(1020) = lu(1020) * lu(1010) + lu(1021) = lu(1021) * lu(1010) + lu(1022) = lu(1022) * lu(1010) + lu(1023) = lu(1023) * lu(1010) + lu(1024) = lu(1024) * lu(1010) + lu(1025) = lu(1025) * lu(1010) + lu(1026) = lu(1026) * lu(1010) + lu(1027) = lu(1027) * lu(1010) + lu(1028) = lu(1028) * lu(1010) + lu(1029) = lu(1029) * lu(1010) + lu(1030) = lu(1030) * lu(1010) + lu(1051) = lu(1051) - lu(1011) * lu(1050) + lu(1052) = lu(1052) - lu(1012) * lu(1050) + lu(1053) = lu(1053) - lu(1013) * lu(1050) + lu(1054) = lu(1054) - lu(1014) * lu(1050) + lu(1055) = lu(1055) - lu(1015) * lu(1050) + lu(1056) = lu(1056) - lu(1016) * lu(1050) + lu(1057) = lu(1057) - lu(1017) * lu(1050) + lu(1058) = lu(1058) - lu(1018) * lu(1050) + lu(1059) = lu(1059) - lu(1019) * lu(1050) + lu(1060) = lu(1060) - lu(1020) * lu(1050) + lu(1061) = lu(1061) - lu(1021) * lu(1050) + lu(1062) = lu(1062) - lu(1022) * lu(1050) + lu(1063) = lu(1063) - lu(1023) * lu(1050) + lu(1064) = lu(1064) - lu(1024) * lu(1050) + lu(1065) = lu(1065) - lu(1025) * lu(1050) + lu(1066) = lu(1066) - lu(1026) * lu(1050) + lu(1067) = lu(1067) - lu(1027) * lu(1050) + lu(1068) = lu(1068) - lu(1028) * lu(1050) + lu(1069) = lu(1069) - lu(1029) * lu(1050) + lu(1070) = lu(1070) - lu(1030) * lu(1050) + lu(1109) = lu(1109) - lu(1011) * lu(1108) + lu(1110) = lu(1110) - lu(1012) * lu(1108) + lu(1111) = lu(1111) - lu(1013) * lu(1108) + lu(1112) = lu(1112) - lu(1014) * lu(1108) + lu(1113) = lu(1113) - lu(1015) * lu(1108) + lu(1114) = lu(1114) - lu(1016) * lu(1108) + lu(1115) = lu(1115) - lu(1017) * lu(1108) + lu(1116) = lu(1116) - lu(1018) * lu(1108) + lu(1117) = lu(1117) - lu(1019) * lu(1108) + lu(1118) = lu(1118) - lu(1020) * lu(1108) + lu(1119) = lu(1119) - lu(1021) * lu(1108) + lu(1120) = lu(1120) - lu(1022) * lu(1108) + lu(1121) = lu(1121) - lu(1023) * lu(1108) + lu(1122) = lu(1122) - lu(1024) * lu(1108) + lu(1123) = lu(1123) - lu(1025) * lu(1108) + lu(1124) = lu(1124) - lu(1026) * lu(1108) + lu(1125) = lu(1125) - lu(1027) * lu(1108) + lu(1126) = lu(1126) - lu(1028) * lu(1108) + lu(1127) = lu(1127) - lu(1029) * lu(1108) + lu(1128) = lu(1128) - lu(1030) * lu(1108) + lu(1149) = lu(1149) - lu(1011) * lu(1148) + lu(1150) = lu(1150) - lu(1012) * lu(1148) + lu(1151) = lu(1151) - lu(1013) * lu(1148) + lu(1152) = lu(1152) - lu(1014) * lu(1148) + lu(1153) = lu(1153) - lu(1015) * lu(1148) + lu(1154) = lu(1154) - lu(1016) * lu(1148) + lu(1155) = lu(1155) - lu(1017) * lu(1148) + lu(1156) = lu(1156) - lu(1018) * lu(1148) + lu(1157) = lu(1157) - lu(1019) * lu(1148) + lu(1158) = lu(1158) - lu(1020) * lu(1148) + lu(1159) = lu(1159) - lu(1021) * lu(1148) + lu(1160) = lu(1160) - lu(1022) * lu(1148) + lu(1161) = lu(1161) - lu(1023) * lu(1148) + lu(1162) = lu(1162) - lu(1024) * lu(1148) + lu(1163) = lu(1163) - lu(1025) * lu(1148) + lu(1164) = lu(1164) - lu(1026) * lu(1148) + lu(1165) = lu(1165) - lu(1027) * lu(1148) + lu(1166) = lu(1166) - lu(1028) * lu(1148) + lu(1167) = lu(1167) - lu(1029) * lu(1148) + lu(1168) = lu(1168) - lu(1030) * lu(1148) + lu(1195) = lu(1195) - lu(1011) * lu(1194) + lu(1196) = lu(1196) - lu(1012) * lu(1194) + lu(1197) = lu(1197) - lu(1013) * lu(1194) + lu(1198) = lu(1198) - lu(1014) * lu(1194) + lu(1199) = lu(1199) - lu(1015) * lu(1194) + lu(1200) = lu(1200) - lu(1016) * lu(1194) + lu(1201) = lu(1201) - lu(1017) * lu(1194) + lu(1202) = lu(1202) - lu(1018) * lu(1194) + lu(1203) = lu(1203) - lu(1019) * lu(1194) + lu(1204) = lu(1204) - lu(1020) * lu(1194) + lu(1205) = lu(1205) - lu(1021) * lu(1194) + lu(1206) = lu(1206) - lu(1022) * lu(1194) + lu(1207) = lu(1207) - lu(1023) * lu(1194) + lu(1208) = lu(1208) - lu(1024) * lu(1194) + lu(1209) = lu(1209) - lu(1025) * lu(1194) + lu(1210) = lu(1210) - lu(1026) * lu(1194) + lu(1211) = lu(1211) - lu(1027) * lu(1194) + lu(1212) = lu(1212) - lu(1028) * lu(1194) + lu(1213) = lu(1213) - lu(1029) * lu(1194) + lu(1214) = lu(1214) - lu(1030) * lu(1194) + lu(1237) = lu(1237) - lu(1011) * lu(1236) + lu(1238) = lu(1238) - lu(1012) * lu(1236) + lu(1239) = lu(1239) - lu(1013) * lu(1236) + lu(1240) = lu(1240) - lu(1014) * lu(1236) + lu(1241) = lu(1241) - lu(1015) * lu(1236) + lu(1242) = lu(1242) - lu(1016) * lu(1236) + lu(1243) = lu(1243) - lu(1017) * lu(1236) + lu(1244) = lu(1244) - lu(1018) * lu(1236) + lu(1245) = lu(1245) - lu(1019) * lu(1236) + lu(1246) = lu(1246) - lu(1020) * lu(1236) + lu(1247) = lu(1247) - lu(1021) * lu(1236) + lu(1248) = lu(1248) - lu(1022) * lu(1236) + lu(1249) = lu(1249) - lu(1023) * lu(1236) + lu(1250) = lu(1250) - lu(1024) * lu(1236) + lu(1251) = lu(1251) - lu(1025) * lu(1236) + lu(1252) = lu(1252) - lu(1026) * lu(1236) + lu(1253) = lu(1253) - lu(1027) * lu(1236) + lu(1254) = lu(1254) - lu(1028) * lu(1236) + lu(1255) = lu(1255) - lu(1029) * lu(1236) + lu(1256) = lu(1256) - lu(1030) * lu(1236) + lu(1273) = lu(1273) - lu(1011) * lu(1272) + lu(1274) = lu(1274) - lu(1012) * lu(1272) + lu(1275) = lu(1275) - lu(1013) * lu(1272) + lu(1276) = lu(1276) - lu(1014) * lu(1272) + lu(1277) = lu(1277) - lu(1015) * lu(1272) + lu(1278) = lu(1278) - lu(1016) * lu(1272) + lu(1279) = lu(1279) - lu(1017) * lu(1272) + lu(1280) = lu(1280) - lu(1018) * lu(1272) + lu(1281) = lu(1281) - lu(1019) * lu(1272) + lu(1282) = lu(1282) - lu(1020) * lu(1272) + lu(1283) = lu(1283) - lu(1021) * lu(1272) + lu(1284) = lu(1284) - lu(1022) * lu(1272) + lu(1285) = lu(1285) - lu(1023) * lu(1272) + lu(1286) = lu(1286) - lu(1024) * lu(1272) + lu(1287) = lu(1287) - lu(1025) * lu(1272) + lu(1288) = lu(1288) - lu(1026) * lu(1272) + lu(1289) = lu(1289) - lu(1027) * lu(1272) + lu(1290) = lu(1290) - lu(1028) * lu(1272) + lu(1291) = lu(1291) - lu(1029) * lu(1272) + lu(1292) = lu(1292) - lu(1030) * lu(1272) + lu(1332) = lu(1332) - lu(1011) * lu(1331) + lu(1333) = lu(1333) - lu(1012) * lu(1331) + lu(1334) = lu(1334) - lu(1013) * lu(1331) + lu(1335) = lu(1335) - lu(1014) * lu(1331) + lu(1336) = lu(1336) - lu(1015) * lu(1331) + lu(1337) = lu(1337) - lu(1016) * lu(1331) + lu(1338) = lu(1338) - lu(1017) * lu(1331) + lu(1339) = lu(1339) - lu(1018) * lu(1331) + lu(1340) = lu(1340) - lu(1019) * lu(1331) + lu(1341) = lu(1341) - lu(1020) * lu(1331) + lu(1342) = lu(1342) - lu(1021) * lu(1331) + lu(1343) = lu(1343) - lu(1022) * lu(1331) + lu(1344) = lu(1344) - lu(1023) * lu(1331) + lu(1345) = lu(1345) - lu(1024) * lu(1331) + lu(1346) = lu(1346) - lu(1025) * lu(1331) + lu(1347) = lu(1347) - lu(1026) * lu(1331) + lu(1348) = lu(1348) - lu(1027) * lu(1331) + lu(1349) = lu(1349) - lu(1028) * lu(1331) + lu(1350) = lu(1350) - lu(1029) * lu(1331) + lu(1351) = lu(1351) - lu(1030) * lu(1331) + lu(1375) = lu(1375) - lu(1011) * lu(1374) + lu(1376) = lu(1376) - lu(1012) * lu(1374) + lu(1377) = lu(1377) - lu(1013) * lu(1374) + lu(1378) = lu(1378) - lu(1014) * lu(1374) + lu(1379) = lu(1379) - lu(1015) * lu(1374) + lu(1380) = lu(1380) - lu(1016) * lu(1374) + lu(1381) = lu(1381) - lu(1017) * lu(1374) + lu(1382) = lu(1382) - lu(1018) * lu(1374) + lu(1383) = lu(1383) - lu(1019) * lu(1374) + lu(1384) = lu(1384) - lu(1020) * lu(1374) + lu(1385) = lu(1385) - lu(1021) * lu(1374) + lu(1386) = lu(1386) - lu(1022) * lu(1374) + lu(1387) = lu(1387) - lu(1023) * lu(1374) + lu(1388) = lu(1388) - lu(1024) * lu(1374) + lu(1389) = lu(1389) - lu(1025) * lu(1374) + lu(1390) = lu(1390) - lu(1026) * lu(1374) + lu(1391) = lu(1391) - lu(1027) * lu(1374) + lu(1392) = lu(1392) - lu(1028) * lu(1374) + lu(1393) = lu(1393) - lu(1029) * lu(1374) + lu(1394) = lu(1394) - lu(1030) * lu(1374) + lu(1416) = lu(1416) - lu(1011) * lu(1415) + lu(1417) = lu(1417) - lu(1012) * lu(1415) + lu(1418) = lu(1418) - lu(1013) * lu(1415) + lu(1419) = lu(1419) - lu(1014) * lu(1415) + lu(1420) = lu(1420) - lu(1015) * lu(1415) + lu(1421) = lu(1421) - lu(1016) * lu(1415) + lu(1422) = lu(1422) - lu(1017) * lu(1415) + lu(1423) = lu(1423) - lu(1018) * lu(1415) + lu(1424) = lu(1424) - lu(1019) * lu(1415) + lu(1425) = lu(1425) - lu(1020) * lu(1415) + lu(1426) = lu(1426) - lu(1021) * lu(1415) + lu(1427) = lu(1427) - lu(1022) * lu(1415) + lu(1428) = lu(1428) - lu(1023) * lu(1415) + lu(1429) = lu(1429) - lu(1024) * lu(1415) + lu(1430) = lu(1430) - lu(1025) * lu(1415) + lu(1431) = lu(1431) - lu(1026) * lu(1415) + lu(1432) = lu(1432) - lu(1027) * lu(1415) + lu(1433) = lu(1433) - lu(1028) * lu(1415) + lu(1434) = lu(1434) - lu(1029) * lu(1415) + lu(1435) = lu(1435) - lu(1030) * lu(1415) + lu(1459) = lu(1459) - lu(1011) * lu(1458) + lu(1460) = lu(1460) - lu(1012) * lu(1458) + lu(1461) = lu(1461) - lu(1013) * lu(1458) + lu(1462) = lu(1462) - lu(1014) * lu(1458) + lu(1463) = lu(1463) - lu(1015) * lu(1458) + lu(1464) = lu(1464) - lu(1016) * lu(1458) + lu(1465) = lu(1465) - lu(1017) * lu(1458) + lu(1466) = lu(1466) - lu(1018) * lu(1458) + lu(1467) = lu(1467) - lu(1019) * lu(1458) + lu(1468) = lu(1468) - lu(1020) * lu(1458) + lu(1469) = lu(1469) - lu(1021) * lu(1458) + lu(1470) = lu(1470) - lu(1022) * lu(1458) + lu(1471) = lu(1471) - lu(1023) * lu(1458) + lu(1472) = lu(1472) - lu(1024) * lu(1458) + lu(1473) = lu(1473) - lu(1025) * lu(1458) + lu(1474) = lu(1474) - lu(1026) * lu(1458) + lu(1475) = lu(1475) - lu(1027) * lu(1458) + lu(1476) = lu(1476) - lu(1028) * lu(1458) + lu(1477) = lu(1477) - lu(1029) * lu(1458) + lu(1478) = lu(1478) - lu(1030) * lu(1458) + lu(1502) = lu(1502) - lu(1011) * lu(1501) + lu(1503) = lu(1503) - lu(1012) * lu(1501) + lu(1504) = lu(1504) - lu(1013) * lu(1501) + lu(1505) = lu(1505) - lu(1014) * lu(1501) + lu(1506) = lu(1506) - lu(1015) * lu(1501) + lu(1507) = lu(1507) - lu(1016) * lu(1501) + lu(1508) = lu(1508) - lu(1017) * lu(1501) + lu(1509) = lu(1509) - lu(1018) * lu(1501) + lu(1510) = lu(1510) - lu(1019) * lu(1501) + lu(1511) = lu(1511) - lu(1020) * lu(1501) + lu(1512) = lu(1512) - lu(1021) * lu(1501) + lu(1513) = lu(1513) - lu(1022) * lu(1501) + lu(1514) = lu(1514) - lu(1023) * lu(1501) + lu(1515) = lu(1515) - lu(1024) * lu(1501) + lu(1516) = lu(1516) - lu(1025) * lu(1501) + lu(1517) = lu(1517) - lu(1026) * lu(1501) + lu(1518) = lu(1518) - lu(1027) * lu(1501) + lu(1519) = lu(1519) - lu(1028) * lu(1501) + lu(1520) = lu(1520) - lu(1029) * lu(1501) + lu(1521) = lu(1521) - lu(1030) * lu(1501) + lu(1548) = lu(1548) - lu(1011) * lu(1547) + lu(1549) = lu(1549) - lu(1012) * lu(1547) + lu(1550) = lu(1550) - lu(1013) * lu(1547) + lu(1551) = lu(1551) - lu(1014) * lu(1547) + lu(1552) = lu(1552) - lu(1015) * lu(1547) + lu(1553) = lu(1553) - lu(1016) * lu(1547) + lu(1554) = lu(1554) - lu(1017) * lu(1547) + lu(1555) = lu(1555) - lu(1018) * lu(1547) + lu(1556) = lu(1556) - lu(1019) * lu(1547) + lu(1557) = lu(1557) - lu(1020) * lu(1547) + lu(1558) = lu(1558) - lu(1021) * lu(1547) + lu(1559) = lu(1559) - lu(1022) * lu(1547) + lu(1560) = lu(1560) - lu(1023) * lu(1547) + lu(1561) = lu(1561) - lu(1024) * lu(1547) + lu(1562) = lu(1562) - lu(1025) * lu(1547) + lu(1563) = lu(1563) - lu(1026) * lu(1547) + lu(1564) = lu(1564) - lu(1027) * lu(1547) + lu(1565) = lu(1565) - lu(1028) * lu(1547) + lu(1566) = lu(1566) - lu(1029) * lu(1547) + lu(1567) = lu(1567) - lu(1030) * lu(1547) + lu(1594) = lu(1594) - lu(1011) * lu(1593) + lu(1595) = lu(1595) - lu(1012) * lu(1593) + lu(1596) = lu(1596) - lu(1013) * lu(1593) + lu(1597) = lu(1597) - lu(1014) * lu(1593) + lu(1598) = lu(1598) - lu(1015) * lu(1593) + lu(1599) = lu(1599) - lu(1016) * lu(1593) + lu(1600) = lu(1600) - lu(1017) * lu(1593) + lu(1601) = lu(1601) - lu(1018) * lu(1593) + lu(1602) = lu(1602) - lu(1019) * lu(1593) + lu(1603) = lu(1603) - lu(1020) * lu(1593) + lu(1604) = lu(1604) - lu(1021) * lu(1593) + lu(1605) = lu(1605) - lu(1022) * lu(1593) + lu(1606) = lu(1606) - lu(1023) * lu(1593) + lu(1607) = lu(1607) - lu(1024) * lu(1593) + lu(1608) = lu(1608) - lu(1025) * lu(1593) + lu(1609) = lu(1609) - lu(1026) * lu(1593) + lu(1610) = lu(1610) - lu(1027) * lu(1593) + lu(1611) = lu(1611) - lu(1028) * lu(1593) + lu(1612) = lu(1612) - lu(1029) * lu(1593) + lu(1613) = lu(1613) - lu(1030) * lu(1593) + lu(1635) = lu(1635) - lu(1011) * lu(1634) + lu(1636) = lu(1636) - lu(1012) * lu(1634) + lu(1637) = lu(1637) - lu(1013) * lu(1634) + lu(1638) = lu(1638) - lu(1014) * lu(1634) + lu(1639) = lu(1639) - lu(1015) * lu(1634) + lu(1640) = lu(1640) - lu(1016) * lu(1634) + lu(1641) = lu(1641) - lu(1017) * lu(1634) + lu(1642) = lu(1642) - lu(1018) * lu(1634) + lu(1643) = lu(1643) - lu(1019) * lu(1634) + lu(1644) = lu(1644) - lu(1020) * lu(1634) + lu(1645) = lu(1645) - lu(1021) * lu(1634) + lu(1646) = lu(1646) - lu(1022) * lu(1634) + lu(1647) = lu(1647) - lu(1023) * lu(1634) + lu(1648) = lu(1648) - lu(1024) * lu(1634) + lu(1649) = lu(1649) - lu(1025) * lu(1634) + lu(1650) = lu(1650) - lu(1026) * lu(1634) + lu(1651) = lu(1651) - lu(1027) * lu(1634) + lu(1652) = lu(1652) - lu(1028) * lu(1634) + lu(1653) = lu(1653) - lu(1029) * lu(1634) + lu(1654) = lu(1654) - lu(1030) * lu(1634) + lu(1678) = lu(1678) - lu(1011) * lu(1677) + lu(1679) = lu(1679) - lu(1012) * lu(1677) + lu(1680) = lu(1680) - lu(1013) * lu(1677) + lu(1681) = lu(1681) - lu(1014) * lu(1677) + lu(1682) = lu(1682) - lu(1015) * lu(1677) + lu(1683) = lu(1683) - lu(1016) * lu(1677) + lu(1684) = lu(1684) - lu(1017) * lu(1677) + lu(1685) = lu(1685) - lu(1018) * lu(1677) + lu(1686) = lu(1686) - lu(1019) * lu(1677) + lu(1687) = lu(1687) - lu(1020) * lu(1677) + lu(1688) = lu(1688) - lu(1021) * lu(1677) + lu(1689) = lu(1689) - lu(1022) * lu(1677) + lu(1690) = lu(1690) - lu(1023) * lu(1677) + lu(1691) = lu(1691) - lu(1024) * lu(1677) + lu(1692) = lu(1692) - lu(1025) * lu(1677) + lu(1693) = lu(1693) - lu(1026) * lu(1677) + lu(1694) = lu(1694) - lu(1027) * lu(1677) + lu(1695) = lu(1695) - lu(1028) * lu(1677) + lu(1696) = lu(1696) - lu(1029) * lu(1677) + lu(1697) = lu(1697) - lu(1030) * lu(1677) + lu(1718) = lu(1718) - lu(1011) * lu(1717) + lu(1719) = lu(1719) - lu(1012) * lu(1717) + lu(1720) = lu(1720) - lu(1013) * lu(1717) + lu(1721) = lu(1721) - lu(1014) * lu(1717) + lu(1722) = lu(1722) - lu(1015) * lu(1717) + lu(1723) = lu(1723) - lu(1016) * lu(1717) + lu(1724) = lu(1724) - lu(1017) * lu(1717) + lu(1725) = lu(1725) - lu(1018) * lu(1717) + lu(1726) = lu(1726) - lu(1019) * lu(1717) + lu(1727) = lu(1727) - lu(1020) * lu(1717) + lu(1728) = lu(1728) - lu(1021) * lu(1717) + lu(1729) = lu(1729) - lu(1022) * lu(1717) + lu(1730) = lu(1730) - lu(1023) * lu(1717) + lu(1731) = lu(1731) - lu(1024) * lu(1717) + lu(1732) = lu(1732) - lu(1025) * lu(1717) + lu(1733) = lu(1733) - lu(1026) * lu(1717) + lu(1734) = lu(1734) - lu(1027) * lu(1717) + lu(1735) = lu(1735) - lu(1028) * lu(1717) + lu(1736) = lu(1736) - lu(1029) * lu(1717) + lu(1737) = lu(1737) - lu(1030) * lu(1717) + lu(1764) = lu(1764) - lu(1011) * lu(1763) + lu(1765) = lu(1765) - lu(1012) * lu(1763) + lu(1766) = lu(1766) - lu(1013) * lu(1763) + lu(1767) = lu(1767) - lu(1014) * lu(1763) + lu(1768) = lu(1768) - lu(1015) * lu(1763) + lu(1769) = lu(1769) - lu(1016) * lu(1763) + lu(1770) = lu(1770) - lu(1017) * lu(1763) + lu(1771) = lu(1771) - lu(1018) * lu(1763) + lu(1772) = lu(1772) - lu(1019) * lu(1763) + lu(1773) = lu(1773) - lu(1020) * lu(1763) + lu(1774) = lu(1774) - lu(1021) * lu(1763) + lu(1775) = lu(1775) - lu(1022) * lu(1763) + lu(1776) = lu(1776) - lu(1023) * lu(1763) + lu(1777) = lu(1777) - lu(1024) * lu(1763) + lu(1778) = lu(1778) - lu(1025) * lu(1763) + lu(1779) = lu(1779) - lu(1026) * lu(1763) + lu(1780) = lu(1780) - lu(1027) * lu(1763) + lu(1781) = lu(1781) - lu(1028) * lu(1763) + lu(1782) = lu(1782) - lu(1029) * lu(1763) + lu(1783) = lu(1783) - lu(1030) * lu(1763) + lu(1800) = lu(1800) - lu(1011) * lu(1799) + lu(1801) = lu(1801) - lu(1012) * lu(1799) + lu(1802) = lu(1802) - lu(1013) * lu(1799) + lu(1803) = lu(1803) - lu(1014) * lu(1799) + lu(1804) = lu(1804) - lu(1015) * lu(1799) + lu(1805) = lu(1805) - lu(1016) * lu(1799) + lu(1806) = lu(1806) - lu(1017) * lu(1799) + lu(1807) = lu(1807) - lu(1018) * lu(1799) + lu(1808) = lu(1808) - lu(1019) * lu(1799) + lu(1809) = lu(1809) - lu(1020) * lu(1799) + lu(1810) = lu(1810) - lu(1021) * lu(1799) + lu(1811) = lu(1811) - lu(1022) * lu(1799) + lu(1812) = lu(1812) - lu(1023) * lu(1799) + lu(1813) = lu(1813) - lu(1024) * lu(1799) + lu(1814) = lu(1814) - lu(1025) * lu(1799) + lu(1815) = lu(1815) - lu(1026) * lu(1799) + lu(1816) = lu(1816) - lu(1027) * lu(1799) + lu(1817) = lu(1817) - lu(1028) * lu(1799) + lu(1818) = lu(1818) - lu(1029) * lu(1799) + lu(1819) = lu(1819) - lu(1030) * lu(1799) + lu(1842) = lu(1842) - lu(1011) * lu(1841) + lu(1843) = lu(1843) - lu(1012) * lu(1841) + lu(1844) = lu(1844) - lu(1013) * lu(1841) + lu(1845) = lu(1845) - lu(1014) * lu(1841) + lu(1846) = lu(1846) - lu(1015) * lu(1841) + lu(1847) = lu(1847) - lu(1016) * lu(1841) + lu(1848) = lu(1848) - lu(1017) * lu(1841) + lu(1849) = lu(1849) - lu(1018) * lu(1841) + lu(1850) = lu(1850) - lu(1019) * lu(1841) + lu(1851) = lu(1851) - lu(1020) * lu(1841) + lu(1852) = lu(1852) - lu(1021) * lu(1841) + lu(1853) = lu(1853) - lu(1022) * lu(1841) + lu(1854) = lu(1854) - lu(1023) * lu(1841) + lu(1855) = lu(1855) - lu(1024) * lu(1841) + lu(1856) = lu(1856) - lu(1025) * lu(1841) + lu(1857) = lu(1857) - lu(1026) * lu(1841) + lu(1858) = lu(1858) - lu(1027) * lu(1841) + lu(1859) = lu(1859) - lu(1028) * lu(1841) + lu(1860) = lu(1860) - lu(1029) * lu(1841) + lu(1861) = lu(1861) - lu(1030) * lu(1841) + lu(1888) = lu(1888) - lu(1011) * lu(1887) + lu(1889) = lu(1889) - lu(1012) * lu(1887) + lu(1890) = lu(1890) - lu(1013) * lu(1887) + lu(1891) = lu(1891) - lu(1014) * lu(1887) + lu(1892) = lu(1892) - lu(1015) * lu(1887) + lu(1893) = lu(1893) - lu(1016) * lu(1887) + lu(1894) = lu(1894) - lu(1017) * lu(1887) + lu(1895) = lu(1895) - lu(1018) * lu(1887) + lu(1896) = lu(1896) - lu(1019) * lu(1887) + lu(1897) = lu(1897) - lu(1020) * lu(1887) + lu(1898) = lu(1898) - lu(1021) * lu(1887) + lu(1899) = lu(1899) - lu(1022) * lu(1887) + lu(1900) = lu(1900) - lu(1023) * lu(1887) + lu(1901) = lu(1901) - lu(1024) * lu(1887) + lu(1902) = lu(1902) - lu(1025) * lu(1887) + lu(1903) = lu(1903) - lu(1026) * lu(1887) + lu(1904) = lu(1904) - lu(1027) * lu(1887) + lu(1905) = lu(1905) - lu(1028) * lu(1887) + lu(1906) = lu(1906) - lu(1029) * lu(1887) + lu(1907) = lu(1907) - lu(1030) * lu(1887) + end subroutine lu_fac19 + subroutine lu_fac20( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1051) = 1._r8 / lu(1051) + lu(1052) = lu(1052) * lu(1051) + lu(1053) = lu(1053) * lu(1051) + lu(1054) = lu(1054) * lu(1051) + lu(1055) = lu(1055) * lu(1051) + lu(1056) = lu(1056) * lu(1051) + lu(1057) = lu(1057) * lu(1051) + lu(1058) = lu(1058) * lu(1051) + lu(1059) = lu(1059) * lu(1051) + lu(1060) = lu(1060) * lu(1051) + lu(1061) = lu(1061) * lu(1051) + lu(1062) = lu(1062) * lu(1051) + lu(1063) = lu(1063) * lu(1051) + lu(1064) = lu(1064) * lu(1051) + lu(1065) = lu(1065) * lu(1051) + lu(1066) = lu(1066) * lu(1051) + lu(1067) = lu(1067) * lu(1051) + lu(1068) = lu(1068) * lu(1051) + lu(1069) = lu(1069) * lu(1051) + lu(1070) = lu(1070) * lu(1051) + lu(1110) = lu(1110) - lu(1052) * lu(1109) + lu(1111) = lu(1111) - lu(1053) * lu(1109) + lu(1112) = lu(1112) - lu(1054) * lu(1109) + lu(1113) = lu(1113) - lu(1055) * lu(1109) + lu(1114) = lu(1114) - lu(1056) * lu(1109) + lu(1115) = lu(1115) - lu(1057) * lu(1109) + lu(1116) = lu(1116) - lu(1058) * lu(1109) + lu(1117) = lu(1117) - lu(1059) * lu(1109) + lu(1118) = lu(1118) - lu(1060) * lu(1109) + lu(1119) = lu(1119) - lu(1061) * lu(1109) + lu(1120) = lu(1120) - lu(1062) * lu(1109) + lu(1121) = lu(1121) - lu(1063) * lu(1109) + lu(1122) = lu(1122) - lu(1064) * lu(1109) + lu(1123) = lu(1123) - lu(1065) * lu(1109) + lu(1124) = lu(1124) - lu(1066) * lu(1109) + lu(1125) = lu(1125) - lu(1067) * lu(1109) + lu(1126) = lu(1126) - lu(1068) * lu(1109) + lu(1127) = lu(1127) - lu(1069) * lu(1109) + lu(1128) = lu(1128) - lu(1070) * lu(1109) + lu(1150) = lu(1150) - lu(1052) * lu(1149) + lu(1151) = lu(1151) - lu(1053) * lu(1149) + lu(1152) = lu(1152) - lu(1054) * lu(1149) + lu(1153) = lu(1153) - lu(1055) * lu(1149) + lu(1154) = lu(1154) - lu(1056) * lu(1149) + lu(1155) = lu(1155) - lu(1057) * lu(1149) + lu(1156) = lu(1156) - lu(1058) * lu(1149) + lu(1157) = lu(1157) - lu(1059) * lu(1149) + lu(1158) = lu(1158) - lu(1060) * lu(1149) + lu(1159) = lu(1159) - lu(1061) * lu(1149) + lu(1160) = lu(1160) - lu(1062) * lu(1149) + lu(1161) = lu(1161) - lu(1063) * lu(1149) + lu(1162) = lu(1162) - lu(1064) * lu(1149) + lu(1163) = lu(1163) - lu(1065) * lu(1149) + lu(1164) = lu(1164) - lu(1066) * lu(1149) + lu(1165) = lu(1165) - lu(1067) * lu(1149) + lu(1166) = lu(1166) - lu(1068) * lu(1149) + lu(1167) = lu(1167) - lu(1069) * lu(1149) + lu(1168) = lu(1168) - lu(1070) * lu(1149) + lu(1196) = lu(1196) - lu(1052) * lu(1195) + lu(1197) = lu(1197) - lu(1053) * lu(1195) + lu(1198) = lu(1198) - lu(1054) * lu(1195) + lu(1199) = lu(1199) - lu(1055) * lu(1195) + lu(1200) = lu(1200) - lu(1056) * lu(1195) + lu(1201) = lu(1201) - lu(1057) * lu(1195) + lu(1202) = lu(1202) - lu(1058) * lu(1195) + lu(1203) = lu(1203) - lu(1059) * lu(1195) + lu(1204) = lu(1204) - lu(1060) * lu(1195) + lu(1205) = lu(1205) - lu(1061) * lu(1195) + lu(1206) = lu(1206) - lu(1062) * lu(1195) + lu(1207) = lu(1207) - lu(1063) * lu(1195) + lu(1208) = lu(1208) - lu(1064) * lu(1195) + lu(1209) = lu(1209) - lu(1065) * lu(1195) + lu(1210) = lu(1210) - lu(1066) * lu(1195) + lu(1211) = lu(1211) - lu(1067) * lu(1195) + lu(1212) = lu(1212) - lu(1068) * lu(1195) + lu(1213) = lu(1213) - lu(1069) * lu(1195) + lu(1214) = lu(1214) - lu(1070) * lu(1195) + lu(1238) = lu(1238) - lu(1052) * lu(1237) + lu(1239) = lu(1239) - lu(1053) * lu(1237) + lu(1240) = lu(1240) - lu(1054) * lu(1237) + lu(1241) = lu(1241) - lu(1055) * lu(1237) + lu(1242) = lu(1242) - lu(1056) * lu(1237) + lu(1243) = lu(1243) - lu(1057) * lu(1237) + lu(1244) = lu(1244) - lu(1058) * lu(1237) + lu(1245) = lu(1245) - lu(1059) * lu(1237) + lu(1246) = lu(1246) - lu(1060) * lu(1237) + lu(1247) = lu(1247) - lu(1061) * lu(1237) + lu(1248) = lu(1248) - lu(1062) * lu(1237) + lu(1249) = lu(1249) - lu(1063) * lu(1237) + lu(1250) = lu(1250) - lu(1064) * lu(1237) + lu(1251) = lu(1251) - lu(1065) * lu(1237) + lu(1252) = lu(1252) - lu(1066) * lu(1237) + lu(1253) = lu(1253) - lu(1067) * lu(1237) + lu(1254) = lu(1254) - lu(1068) * lu(1237) + lu(1255) = lu(1255) - lu(1069) * lu(1237) + lu(1256) = lu(1256) - lu(1070) * lu(1237) + lu(1274) = lu(1274) - lu(1052) * lu(1273) + lu(1275) = lu(1275) - lu(1053) * lu(1273) + lu(1276) = lu(1276) - lu(1054) * lu(1273) + lu(1277) = lu(1277) - lu(1055) * lu(1273) + lu(1278) = lu(1278) - lu(1056) * lu(1273) + lu(1279) = lu(1279) - lu(1057) * lu(1273) + lu(1280) = lu(1280) - lu(1058) * lu(1273) + lu(1281) = lu(1281) - lu(1059) * lu(1273) + lu(1282) = lu(1282) - lu(1060) * lu(1273) + lu(1283) = lu(1283) - lu(1061) * lu(1273) + lu(1284) = lu(1284) - lu(1062) * lu(1273) + lu(1285) = lu(1285) - lu(1063) * lu(1273) + lu(1286) = lu(1286) - lu(1064) * lu(1273) + lu(1287) = lu(1287) - lu(1065) * lu(1273) + lu(1288) = lu(1288) - lu(1066) * lu(1273) + lu(1289) = lu(1289) - lu(1067) * lu(1273) + lu(1290) = lu(1290) - lu(1068) * lu(1273) + lu(1291) = lu(1291) - lu(1069) * lu(1273) + lu(1292) = lu(1292) - lu(1070) * lu(1273) + lu(1333) = lu(1333) - lu(1052) * lu(1332) + lu(1334) = lu(1334) - lu(1053) * lu(1332) + lu(1335) = lu(1335) - lu(1054) * lu(1332) + lu(1336) = lu(1336) - lu(1055) * lu(1332) + lu(1337) = lu(1337) - lu(1056) * lu(1332) + lu(1338) = lu(1338) - lu(1057) * lu(1332) + lu(1339) = lu(1339) - lu(1058) * lu(1332) + lu(1340) = lu(1340) - lu(1059) * lu(1332) + lu(1341) = lu(1341) - lu(1060) * lu(1332) + lu(1342) = lu(1342) - lu(1061) * lu(1332) + lu(1343) = lu(1343) - lu(1062) * lu(1332) + lu(1344) = lu(1344) - lu(1063) * lu(1332) + lu(1345) = lu(1345) - lu(1064) * lu(1332) + lu(1346) = lu(1346) - lu(1065) * lu(1332) + lu(1347) = lu(1347) - lu(1066) * lu(1332) + lu(1348) = lu(1348) - lu(1067) * lu(1332) + lu(1349) = lu(1349) - lu(1068) * lu(1332) + lu(1350) = lu(1350) - lu(1069) * lu(1332) + lu(1351) = lu(1351) - lu(1070) * lu(1332) + lu(1376) = lu(1376) - lu(1052) * lu(1375) + lu(1377) = lu(1377) - lu(1053) * lu(1375) + lu(1378) = lu(1378) - lu(1054) * lu(1375) + lu(1379) = lu(1379) - lu(1055) * lu(1375) + lu(1380) = lu(1380) - lu(1056) * lu(1375) + lu(1381) = lu(1381) - lu(1057) * lu(1375) + lu(1382) = lu(1382) - lu(1058) * lu(1375) + lu(1383) = lu(1383) - lu(1059) * lu(1375) + lu(1384) = lu(1384) - lu(1060) * lu(1375) + lu(1385) = lu(1385) - lu(1061) * lu(1375) + lu(1386) = lu(1386) - lu(1062) * lu(1375) + lu(1387) = lu(1387) - lu(1063) * lu(1375) + lu(1388) = lu(1388) - lu(1064) * lu(1375) + lu(1389) = lu(1389) - lu(1065) * lu(1375) + lu(1390) = lu(1390) - lu(1066) * lu(1375) + lu(1391) = lu(1391) - lu(1067) * lu(1375) + lu(1392) = lu(1392) - lu(1068) * lu(1375) + lu(1393) = lu(1393) - lu(1069) * lu(1375) + lu(1394) = lu(1394) - lu(1070) * lu(1375) + lu(1417) = lu(1417) - lu(1052) * lu(1416) + lu(1418) = lu(1418) - lu(1053) * lu(1416) + lu(1419) = lu(1419) - lu(1054) * lu(1416) + lu(1420) = lu(1420) - lu(1055) * lu(1416) + lu(1421) = lu(1421) - lu(1056) * lu(1416) + lu(1422) = lu(1422) - lu(1057) * lu(1416) + lu(1423) = lu(1423) - lu(1058) * lu(1416) + lu(1424) = lu(1424) - lu(1059) * lu(1416) + lu(1425) = lu(1425) - lu(1060) * lu(1416) + lu(1426) = lu(1426) - lu(1061) * lu(1416) + lu(1427) = lu(1427) - lu(1062) * lu(1416) + lu(1428) = lu(1428) - lu(1063) * lu(1416) + lu(1429) = lu(1429) - lu(1064) * lu(1416) + lu(1430) = lu(1430) - lu(1065) * lu(1416) + lu(1431) = lu(1431) - lu(1066) * lu(1416) + lu(1432) = lu(1432) - lu(1067) * lu(1416) + lu(1433) = lu(1433) - lu(1068) * lu(1416) + lu(1434) = lu(1434) - lu(1069) * lu(1416) + lu(1435) = lu(1435) - lu(1070) * lu(1416) + lu(1460) = lu(1460) - lu(1052) * lu(1459) + lu(1461) = lu(1461) - lu(1053) * lu(1459) + lu(1462) = lu(1462) - lu(1054) * lu(1459) + lu(1463) = lu(1463) - lu(1055) * lu(1459) + lu(1464) = lu(1464) - lu(1056) * lu(1459) + lu(1465) = lu(1465) - lu(1057) * lu(1459) + lu(1466) = lu(1466) - lu(1058) * lu(1459) + lu(1467) = lu(1467) - lu(1059) * lu(1459) + lu(1468) = lu(1468) - lu(1060) * lu(1459) + lu(1469) = lu(1469) - lu(1061) * lu(1459) + lu(1470) = lu(1470) - lu(1062) * lu(1459) + lu(1471) = lu(1471) - lu(1063) * lu(1459) + lu(1472) = lu(1472) - lu(1064) * lu(1459) + lu(1473) = lu(1473) - lu(1065) * lu(1459) + lu(1474) = lu(1474) - lu(1066) * lu(1459) + lu(1475) = lu(1475) - lu(1067) * lu(1459) + lu(1476) = lu(1476) - lu(1068) * lu(1459) + lu(1477) = lu(1477) - lu(1069) * lu(1459) + lu(1478) = lu(1478) - lu(1070) * lu(1459) + lu(1503) = lu(1503) - lu(1052) * lu(1502) + lu(1504) = lu(1504) - lu(1053) * lu(1502) + lu(1505) = lu(1505) - lu(1054) * lu(1502) + lu(1506) = lu(1506) - lu(1055) * lu(1502) + lu(1507) = lu(1507) - lu(1056) * lu(1502) + lu(1508) = lu(1508) - lu(1057) * lu(1502) + lu(1509) = lu(1509) - lu(1058) * lu(1502) + lu(1510) = lu(1510) - lu(1059) * lu(1502) + lu(1511) = lu(1511) - lu(1060) * lu(1502) + lu(1512) = lu(1512) - lu(1061) * lu(1502) + lu(1513) = lu(1513) - lu(1062) * lu(1502) + lu(1514) = lu(1514) - lu(1063) * lu(1502) + lu(1515) = lu(1515) - lu(1064) * lu(1502) + lu(1516) = lu(1516) - lu(1065) * lu(1502) + lu(1517) = lu(1517) - lu(1066) * lu(1502) + lu(1518) = lu(1518) - lu(1067) * lu(1502) + lu(1519) = lu(1519) - lu(1068) * lu(1502) + lu(1520) = lu(1520) - lu(1069) * lu(1502) + lu(1521) = lu(1521) - lu(1070) * lu(1502) + lu(1549) = lu(1549) - lu(1052) * lu(1548) + lu(1550) = lu(1550) - lu(1053) * lu(1548) + lu(1551) = lu(1551) - lu(1054) * lu(1548) + lu(1552) = lu(1552) - lu(1055) * lu(1548) + lu(1553) = lu(1553) - lu(1056) * lu(1548) + lu(1554) = lu(1554) - lu(1057) * lu(1548) + lu(1555) = lu(1555) - lu(1058) * lu(1548) + lu(1556) = lu(1556) - lu(1059) * lu(1548) + lu(1557) = lu(1557) - lu(1060) * lu(1548) + lu(1558) = lu(1558) - lu(1061) * lu(1548) + lu(1559) = lu(1559) - lu(1062) * lu(1548) + lu(1560) = lu(1560) - lu(1063) * lu(1548) + lu(1561) = lu(1561) - lu(1064) * lu(1548) + lu(1562) = lu(1562) - lu(1065) * lu(1548) + lu(1563) = lu(1563) - lu(1066) * lu(1548) + lu(1564) = lu(1564) - lu(1067) * lu(1548) + lu(1565) = lu(1565) - lu(1068) * lu(1548) + lu(1566) = lu(1566) - lu(1069) * lu(1548) + lu(1567) = lu(1567) - lu(1070) * lu(1548) + lu(1595) = lu(1595) - lu(1052) * lu(1594) + lu(1596) = lu(1596) - lu(1053) * lu(1594) + lu(1597) = lu(1597) - lu(1054) * lu(1594) + lu(1598) = lu(1598) - lu(1055) * lu(1594) + lu(1599) = lu(1599) - lu(1056) * lu(1594) + lu(1600) = lu(1600) - lu(1057) * lu(1594) + lu(1601) = lu(1601) - lu(1058) * lu(1594) + lu(1602) = lu(1602) - lu(1059) * lu(1594) + lu(1603) = lu(1603) - lu(1060) * lu(1594) + lu(1604) = lu(1604) - lu(1061) * lu(1594) + lu(1605) = lu(1605) - lu(1062) * lu(1594) + lu(1606) = lu(1606) - lu(1063) * lu(1594) + lu(1607) = lu(1607) - lu(1064) * lu(1594) + lu(1608) = lu(1608) - lu(1065) * lu(1594) + lu(1609) = lu(1609) - lu(1066) * lu(1594) + lu(1610) = lu(1610) - lu(1067) * lu(1594) + lu(1611) = lu(1611) - lu(1068) * lu(1594) + lu(1612) = lu(1612) - lu(1069) * lu(1594) + lu(1613) = lu(1613) - lu(1070) * lu(1594) + lu(1636) = lu(1636) - lu(1052) * lu(1635) + lu(1637) = lu(1637) - lu(1053) * lu(1635) + lu(1638) = lu(1638) - lu(1054) * lu(1635) + lu(1639) = lu(1639) - lu(1055) * lu(1635) + lu(1640) = lu(1640) - lu(1056) * lu(1635) + lu(1641) = lu(1641) - lu(1057) * lu(1635) + lu(1642) = lu(1642) - lu(1058) * lu(1635) + lu(1643) = lu(1643) - lu(1059) * lu(1635) + lu(1644) = lu(1644) - lu(1060) * lu(1635) + lu(1645) = lu(1645) - lu(1061) * lu(1635) + lu(1646) = lu(1646) - lu(1062) * lu(1635) + lu(1647) = lu(1647) - lu(1063) * lu(1635) + lu(1648) = lu(1648) - lu(1064) * lu(1635) + lu(1649) = lu(1649) - lu(1065) * lu(1635) + lu(1650) = lu(1650) - lu(1066) * lu(1635) + lu(1651) = lu(1651) - lu(1067) * lu(1635) + lu(1652) = lu(1652) - lu(1068) * lu(1635) + lu(1653) = lu(1653) - lu(1069) * lu(1635) + lu(1654) = lu(1654) - lu(1070) * lu(1635) + lu(1679) = lu(1679) - lu(1052) * lu(1678) + lu(1680) = lu(1680) - lu(1053) * lu(1678) + lu(1681) = lu(1681) - lu(1054) * lu(1678) + lu(1682) = lu(1682) - lu(1055) * lu(1678) + lu(1683) = lu(1683) - lu(1056) * lu(1678) + lu(1684) = lu(1684) - lu(1057) * lu(1678) + lu(1685) = lu(1685) - lu(1058) * lu(1678) + lu(1686) = lu(1686) - lu(1059) * lu(1678) + lu(1687) = lu(1687) - lu(1060) * lu(1678) + lu(1688) = lu(1688) - lu(1061) * lu(1678) + lu(1689) = lu(1689) - lu(1062) * lu(1678) + lu(1690) = lu(1690) - lu(1063) * lu(1678) + lu(1691) = lu(1691) - lu(1064) * lu(1678) + lu(1692) = lu(1692) - lu(1065) * lu(1678) + lu(1693) = lu(1693) - lu(1066) * lu(1678) + lu(1694) = lu(1694) - lu(1067) * lu(1678) + lu(1695) = lu(1695) - lu(1068) * lu(1678) + lu(1696) = lu(1696) - lu(1069) * lu(1678) + lu(1697) = lu(1697) - lu(1070) * lu(1678) + lu(1719) = lu(1719) - lu(1052) * lu(1718) + lu(1720) = lu(1720) - lu(1053) * lu(1718) + lu(1721) = lu(1721) - lu(1054) * lu(1718) + lu(1722) = lu(1722) - lu(1055) * lu(1718) + lu(1723) = lu(1723) - lu(1056) * lu(1718) + lu(1724) = lu(1724) - lu(1057) * lu(1718) + lu(1725) = lu(1725) - lu(1058) * lu(1718) + lu(1726) = lu(1726) - lu(1059) * lu(1718) + lu(1727) = lu(1727) - lu(1060) * lu(1718) + lu(1728) = lu(1728) - lu(1061) * lu(1718) + lu(1729) = lu(1729) - lu(1062) * lu(1718) + lu(1730) = lu(1730) - lu(1063) * lu(1718) + lu(1731) = lu(1731) - lu(1064) * lu(1718) + lu(1732) = lu(1732) - lu(1065) * lu(1718) + lu(1733) = lu(1733) - lu(1066) * lu(1718) + lu(1734) = lu(1734) - lu(1067) * lu(1718) + lu(1735) = lu(1735) - lu(1068) * lu(1718) + lu(1736) = lu(1736) - lu(1069) * lu(1718) + lu(1737) = lu(1737) - lu(1070) * lu(1718) + lu(1765) = lu(1765) - lu(1052) * lu(1764) + lu(1766) = lu(1766) - lu(1053) * lu(1764) + lu(1767) = lu(1767) - lu(1054) * lu(1764) + lu(1768) = lu(1768) - lu(1055) * lu(1764) + lu(1769) = lu(1769) - lu(1056) * lu(1764) + lu(1770) = lu(1770) - lu(1057) * lu(1764) + lu(1771) = lu(1771) - lu(1058) * lu(1764) + lu(1772) = lu(1772) - lu(1059) * lu(1764) + lu(1773) = lu(1773) - lu(1060) * lu(1764) + lu(1774) = lu(1774) - lu(1061) * lu(1764) + lu(1775) = lu(1775) - lu(1062) * lu(1764) + lu(1776) = lu(1776) - lu(1063) * lu(1764) + lu(1777) = lu(1777) - lu(1064) * lu(1764) + lu(1778) = lu(1778) - lu(1065) * lu(1764) + lu(1779) = lu(1779) - lu(1066) * lu(1764) + lu(1780) = lu(1780) - lu(1067) * lu(1764) + lu(1781) = lu(1781) - lu(1068) * lu(1764) + lu(1782) = lu(1782) - lu(1069) * lu(1764) + lu(1783) = lu(1783) - lu(1070) * lu(1764) + lu(1801) = lu(1801) - lu(1052) * lu(1800) + lu(1802) = lu(1802) - lu(1053) * lu(1800) + lu(1803) = lu(1803) - lu(1054) * lu(1800) + lu(1804) = lu(1804) - lu(1055) * lu(1800) + lu(1805) = lu(1805) - lu(1056) * lu(1800) + lu(1806) = lu(1806) - lu(1057) * lu(1800) + lu(1807) = lu(1807) - lu(1058) * lu(1800) + lu(1808) = lu(1808) - lu(1059) * lu(1800) + lu(1809) = lu(1809) - lu(1060) * lu(1800) + lu(1810) = lu(1810) - lu(1061) * lu(1800) + lu(1811) = lu(1811) - lu(1062) * lu(1800) + lu(1812) = lu(1812) - lu(1063) * lu(1800) + lu(1813) = lu(1813) - lu(1064) * lu(1800) + lu(1814) = lu(1814) - lu(1065) * lu(1800) + lu(1815) = lu(1815) - lu(1066) * lu(1800) + lu(1816) = lu(1816) - lu(1067) * lu(1800) + lu(1817) = lu(1817) - lu(1068) * lu(1800) + lu(1818) = lu(1818) - lu(1069) * lu(1800) + lu(1819) = lu(1819) - lu(1070) * lu(1800) + lu(1843) = lu(1843) - lu(1052) * lu(1842) + lu(1844) = lu(1844) - lu(1053) * lu(1842) + lu(1845) = lu(1845) - lu(1054) * lu(1842) + lu(1846) = lu(1846) - lu(1055) * lu(1842) + lu(1847) = lu(1847) - lu(1056) * lu(1842) + lu(1848) = lu(1848) - lu(1057) * lu(1842) + lu(1849) = lu(1849) - lu(1058) * lu(1842) + lu(1850) = lu(1850) - lu(1059) * lu(1842) + lu(1851) = lu(1851) - lu(1060) * lu(1842) + lu(1852) = lu(1852) - lu(1061) * lu(1842) + lu(1853) = lu(1853) - lu(1062) * lu(1842) + lu(1854) = lu(1854) - lu(1063) * lu(1842) + lu(1855) = lu(1855) - lu(1064) * lu(1842) + lu(1856) = lu(1856) - lu(1065) * lu(1842) + lu(1857) = lu(1857) - lu(1066) * lu(1842) + lu(1858) = lu(1858) - lu(1067) * lu(1842) + lu(1859) = lu(1859) - lu(1068) * lu(1842) + lu(1860) = lu(1860) - lu(1069) * lu(1842) + lu(1861) = lu(1861) - lu(1070) * lu(1842) + lu(1889) = lu(1889) - lu(1052) * lu(1888) + lu(1890) = lu(1890) - lu(1053) * lu(1888) + lu(1891) = lu(1891) - lu(1054) * lu(1888) + lu(1892) = lu(1892) - lu(1055) * lu(1888) + lu(1893) = lu(1893) - lu(1056) * lu(1888) + lu(1894) = lu(1894) - lu(1057) * lu(1888) + lu(1895) = lu(1895) - lu(1058) * lu(1888) + lu(1896) = lu(1896) - lu(1059) * lu(1888) + lu(1897) = lu(1897) - lu(1060) * lu(1888) + lu(1898) = lu(1898) - lu(1061) * lu(1888) + lu(1899) = lu(1899) - lu(1062) * lu(1888) + lu(1900) = lu(1900) - lu(1063) * lu(1888) + lu(1901) = lu(1901) - lu(1064) * lu(1888) + lu(1902) = lu(1902) - lu(1065) * lu(1888) + lu(1903) = lu(1903) - lu(1066) * lu(1888) + lu(1904) = lu(1904) - lu(1067) * lu(1888) + lu(1905) = lu(1905) - lu(1068) * lu(1888) + lu(1906) = lu(1906) - lu(1069) * lu(1888) + lu(1907) = lu(1907) - lu(1070) * lu(1888) + lu(1110) = 1._r8 / lu(1110) + lu(1111) = lu(1111) * lu(1110) + lu(1112) = lu(1112) * lu(1110) + lu(1113) = lu(1113) * lu(1110) + lu(1114) = lu(1114) * lu(1110) + lu(1115) = lu(1115) * lu(1110) + lu(1116) = lu(1116) * lu(1110) + lu(1117) = lu(1117) * lu(1110) + lu(1118) = lu(1118) * lu(1110) + lu(1119) = lu(1119) * lu(1110) + lu(1120) = lu(1120) * lu(1110) + lu(1121) = lu(1121) * lu(1110) + lu(1122) = lu(1122) * lu(1110) + lu(1123) = lu(1123) * lu(1110) + lu(1124) = lu(1124) * lu(1110) + lu(1125) = lu(1125) * lu(1110) + lu(1126) = lu(1126) * lu(1110) + lu(1127) = lu(1127) * lu(1110) + lu(1128) = lu(1128) * lu(1110) + lu(1151) = lu(1151) - lu(1111) * lu(1150) + lu(1152) = lu(1152) - lu(1112) * lu(1150) + lu(1153) = lu(1153) - lu(1113) * lu(1150) + lu(1154) = lu(1154) - lu(1114) * lu(1150) + lu(1155) = lu(1155) - lu(1115) * lu(1150) + lu(1156) = lu(1156) - lu(1116) * lu(1150) + lu(1157) = lu(1157) - lu(1117) * lu(1150) + lu(1158) = lu(1158) - lu(1118) * lu(1150) + lu(1159) = lu(1159) - lu(1119) * lu(1150) + lu(1160) = lu(1160) - lu(1120) * lu(1150) + lu(1161) = lu(1161) - lu(1121) * lu(1150) + lu(1162) = lu(1162) - lu(1122) * lu(1150) + lu(1163) = lu(1163) - lu(1123) * lu(1150) + lu(1164) = lu(1164) - lu(1124) * lu(1150) + lu(1165) = lu(1165) - lu(1125) * lu(1150) + lu(1166) = lu(1166) - lu(1126) * lu(1150) + lu(1167) = lu(1167) - lu(1127) * lu(1150) + lu(1168) = lu(1168) - lu(1128) * lu(1150) + lu(1197) = lu(1197) - lu(1111) * lu(1196) + lu(1198) = lu(1198) - lu(1112) * lu(1196) + lu(1199) = lu(1199) - lu(1113) * lu(1196) + lu(1200) = lu(1200) - lu(1114) * lu(1196) + lu(1201) = lu(1201) - lu(1115) * lu(1196) + lu(1202) = lu(1202) - lu(1116) * lu(1196) + lu(1203) = lu(1203) - lu(1117) * lu(1196) + lu(1204) = lu(1204) - lu(1118) * lu(1196) + lu(1205) = lu(1205) - lu(1119) * lu(1196) + lu(1206) = lu(1206) - lu(1120) * lu(1196) + lu(1207) = lu(1207) - lu(1121) * lu(1196) + lu(1208) = lu(1208) - lu(1122) * lu(1196) + lu(1209) = lu(1209) - lu(1123) * lu(1196) + lu(1210) = lu(1210) - lu(1124) * lu(1196) + lu(1211) = lu(1211) - lu(1125) * lu(1196) + lu(1212) = lu(1212) - lu(1126) * lu(1196) + lu(1213) = lu(1213) - lu(1127) * lu(1196) + lu(1214) = lu(1214) - lu(1128) * lu(1196) + lu(1239) = lu(1239) - lu(1111) * lu(1238) + lu(1240) = lu(1240) - lu(1112) * lu(1238) + lu(1241) = lu(1241) - lu(1113) * lu(1238) + lu(1242) = lu(1242) - lu(1114) * lu(1238) + lu(1243) = lu(1243) - lu(1115) * lu(1238) + lu(1244) = lu(1244) - lu(1116) * lu(1238) + lu(1245) = lu(1245) - lu(1117) * lu(1238) + lu(1246) = lu(1246) - lu(1118) * lu(1238) + lu(1247) = lu(1247) - lu(1119) * lu(1238) + lu(1248) = lu(1248) - lu(1120) * lu(1238) + lu(1249) = lu(1249) - lu(1121) * lu(1238) + lu(1250) = lu(1250) - lu(1122) * lu(1238) + lu(1251) = lu(1251) - lu(1123) * lu(1238) + lu(1252) = lu(1252) - lu(1124) * lu(1238) + lu(1253) = lu(1253) - lu(1125) * lu(1238) + lu(1254) = lu(1254) - lu(1126) * lu(1238) + lu(1255) = lu(1255) - lu(1127) * lu(1238) + lu(1256) = lu(1256) - lu(1128) * lu(1238) + lu(1275) = lu(1275) - lu(1111) * lu(1274) + lu(1276) = lu(1276) - lu(1112) * lu(1274) + lu(1277) = lu(1277) - lu(1113) * lu(1274) + lu(1278) = lu(1278) - lu(1114) * lu(1274) + lu(1279) = lu(1279) - lu(1115) * lu(1274) + lu(1280) = lu(1280) - lu(1116) * lu(1274) + lu(1281) = lu(1281) - lu(1117) * lu(1274) + lu(1282) = lu(1282) - lu(1118) * lu(1274) + lu(1283) = lu(1283) - lu(1119) * lu(1274) + lu(1284) = lu(1284) - lu(1120) * lu(1274) + lu(1285) = lu(1285) - lu(1121) * lu(1274) + lu(1286) = lu(1286) - lu(1122) * lu(1274) + lu(1287) = lu(1287) - lu(1123) * lu(1274) + lu(1288) = lu(1288) - lu(1124) * lu(1274) + lu(1289) = lu(1289) - lu(1125) * lu(1274) + lu(1290) = lu(1290) - lu(1126) * lu(1274) + lu(1291) = lu(1291) - lu(1127) * lu(1274) + lu(1292) = lu(1292) - lu(1128) * lu(1274) + lu(1334) = lu(1334) - lu(1111) * lu(1333) + lu(1335) = lu(1335) - lu(1112) * lu(1333) + lu(1336) = lu(1336) - lu(1113) * lu(1333) + lu(1337) = lu(1337) - lu(1114) * lu(1333) + lu(1338) = lu(1338) - lu(1115) * lu(1333) + lu(1339) = lu(1339) - lu(1116) * lu(1333) + lu(1340) = lu(1340) - lu(1117) * lu(1333) + lu(1341) = lu(1341) - lu(1118) * lu(1333) + lu(1342) = lu(1342) - lu(1119) * lu(1333) + lu(1343) = lu(1343) - lu(1120) * lu(1333) + lu(1344) = lu(1344) - lu(1121) * lu(1333) + lu(1345) = lu(1345) - lu(1122) * lu(1333) + lu(1346) = lu(1346) - lu(1123) * lu(1333) + lu(1347) = lu(1347) - lu(1124) * lu(1333) + lu(1348) = lu(1348) - lu(1125) * lu(1333) + lu(1349) = lu(1349) - lu(1126) * lu(1333) + lu(1350) = lu(1350) - lu(1127) * lu(1333) + lu(1351) = lu(1351) - lu(1128) * lu(1333) + lu(1377) = lu(1377) - lu(1111) * lu(1376) + lu(1378) = lu(1378) - lu(1112) * lu(1376) + lu(1379) = lu(1379) - lu(1113) * lu(1376) + lu(1380) = lu(1380) - lu(1114) * lu(1376) + lu(1381) = lu(1381) - lu(1115) * lu(1376) + lu(1382) = lu(1382) - lu(1116) * lu(1376) + lu(1383) = lu(1383) - lu(1117) * lu(1376) + lu(1384) = lu(1384) - lu(1118) * lu(1376) + lu(1385) = lu(1385) - lu(1119) * lu(1376) + lu(1386) = lu(1386) - lu(1120) * lu(1376) + lu(1387) = lu(1387) - lu(1121) * lu(1376) + lu(1388) = lu(1388) - lu(1122) * lu(1376) + lu(1389) = lu(1389) - lu(1123) * lu(1376) + lu(1390) = lu(1390) - lu(1124) * lu(1376) + lu(1391) = lu(1391) - lu(1125) * lu(1376) + lu(1392) = lu(1392) - lu(1126) * lu(1376) + lu(1393) = lu(1393) - lu(1127) * lu(1376) + lu(1394) = lu(1394) - lu(1128) * lu(1376) + lu(1418) = lu(1418) - lu(1111) * lu(1417) + lu(1419) = lu(1419) - lu(1112) * lu(1417) + lu(1420) = lu(1420) - lu(1113) * lu(1417) + lu(1421) = lu(1421) - lu(1114) * lu(1417) + lu(1422) = lu(1422) - lu(1115) * lu(1417) + lu(1423) = lu(1423) - lu(1116) * lu(1417) + lu(1424) = lu(1424) - lu(1117) * lu(1417) + lu(1425) = lu(1425) - lu(1118) * lu(1417) + lu(1426) = lu(1426) - lu(1119) * lu(1417) + lu(1427) = lu(1427) - lu(1120) * lu(1417) + lu(1428) = lu(1428) - lu(1121) * lu(1417) + lu(1429) = lu(1429) - lu(1122) * lu(1417) + lu(1430) = lu(1430) - lu(1123) * lu(1417) + lu(1431) = lu(1431) - lu(1124) * lu(1417) + lu(1432) = lu(1432) - lu(1125) * lu(1417) + lu(1433) = lu(1433) - lu(1126) * lu(1417) + lu(1434) = lu(1434) - lu(1127) * lu(1417) + lu(1435) = lu(1435) - lu(1128) * lu(1417) + lu(1461) = lu(1461) - lu(1111) * lu(1460) + lu(1462) = lu(1462) - lu(1112) * lu(1460) + lu(1463) = lu(1463) - lu(1113) * lu(1460) + lu(1464) = lu(1464) - lu(1114) * lu(1460) + lu(1465) = lu(1465) - lu(1115) * lu(1460) + lu(1466) = lu(1466) - lu(1116) * lu(1460) + lu(1467) = lu(1467) - lu(1117) * lu(1460) + lu(1468) = lu(1468) - lu(1118) * lu(1460) + lu(1469) = lu(1469) - lu(1119) * lu(1460) + lu(1470) = lu(1470) - lu(1120) * lu(1460) + lu(1471) = lu(1471) - lu(1121) * lu(1460) + lu(1472) = lu(1472) - lu(1122) * lu(1460) + lu(1473) = lu(1473) - lu(1123) * lu(1460) + lu(1474) = lu(1474) - lu(1124) * lu(1460) + lu(1475) = lu(1475) - lu(1125) * lu(1460) + lu(1476) = lu(1476) - lu(1126) * lu(1460) + lu(1477) = lu(1477) - lu(1127) * lu(1460) + lu(1478) = lu(1478) - lu(1128) * lu(1460) + lu(1504) = lu(1504) - lu(1111) * lu(1503) + lu(1505) = lu(1505) - lu(1112) * lu(1503) + lu(1506) = lu(1506) - lu(1113) * lu(1503) + lu(1507) = lu(1507) - lu(1114) * lu(1503) + lu(1508) = lu(1508) - lu(1115) * lu(1503) + lu(1509) = lu(1509) - lu(1116) * lu(1503) + lu(1510) = lu(1510) - lu(1117) * lu(1503) + lu(1511) = lu(1511) - lu(1118) * lu(1503) + lu(1512) = lu(1512) - lu(1119) * lu(1503) + lu(1513) = lu(1513) - lu(1120) * lu(1503) + lu(1514) = lu(1514) - lu(1121) * lu(1503) + lu(1515) = lu(1515) - lu(1122) * lu(1503) + lu(1516) = lu(1516) - lu(1123) * lu(1503) + lu(1517) = lu(1517) - lu(1124) * lu(1503) + lu(1518) = lu(1518) - lu(1125) * lu(1503) + lu(1519) = lu(1519) - lu(1126) * lu(1503) + lu(1520) = lu(1520) - lu(1127) * lu(1503) + lu(1521) = lu(1521) - lu(1128) * lu(1503) + lu(1550) = lu(1550) - lu(1111) * lu(1549) + lu(1551) = lu(1551) - lu(1112) * lu(1549) + lu(1552) = lu(1552) - lu(1113) * lu(1549) + lu(1553) = lu(1553) - lu(1114) * lu(1549) + lu(1554) = lu(1554) - lu(1115) * lu(1549) + lu(1555) = lu(1555) - lu(1116) * lu(1549) + lu(1556) = lu(1556) - lu(1117) * lu(1549) + lu(1557) = lu(1557) - lu(1118) * lu(1549) + lu(1558) = lu(1558) - lu(1119) * lu(1549) + lu(1559) = lu(1559) - lu(1120) * lu(1549) + lu(1560) = lu(1560) - lu(1121) * lu(1549) + lu(1561) = lu(1561) - lu(1122) * lu(1549) + lu(1562) = lu(1562) - lu(1123) * lu(1549) + lu(1563) = lu(1563) - lu(1124) * lu(1549) + lu(1564) = lu(1564) - lu(1125) * lu(1549) + lu(1565) = lu(1565) - lu(1126) * lu(1549) + lu(1566) = lu(1566) - lu(1127) * lu(1549) + lu(1567) = lu(1567) - lu(1128) * lu(1549) + lu(1596) = lu(1596) - lu(1111) * lu(1595) + lu(1597) = lu(1597) - lu(1112) * lu(1595) + lu(1598) = lu(1598) - lu(1113) * lu(1595) + lu(1599) = lu(1599) - lu(1114) * lu(1595) + lu(1600) = lu(1600) - lu(1115) * lu(1595) + lu(1601) = lu(1601) - lu(1116) * lu(1595) + lu(1602) = lu(1602) - lu(1117) * lu(1595) + lu(1603) = lu(1603) - lu(1118) * lu(1595) + lu(1604) = lu(1604) - lu(1119) * lu(1595) + lu(1605) = lu(1605) - lu(1120) * lu(1595) + lu(1606) = lu(1606) - lu(1121) * lu(1595) + lu(1607) = lu(1607) - lu(1122) * lu(1595) + lu(1608) = lu(1608) - lu(1123) * lu(1595) + lu(1609) = lu(1609) - lu(1124) * lu(1595) + lu(1610) = lu(1610) - lu(1125) * lu(1595) + lu(1611) = lu(1611) - lu(1126) * lu(1595) + lu(1612) = lu(1612) - lu(1127) * lu(1595) + lu(1613) = lu(1613) - lu(1128) * lu(1595) + lu(1637) = lu(1637) - lu(1111) * lu(1636) + lu(1638) = lu(1638) - lu(1112) * lu(1636) + lu(1639) = lu(1639) - lu(1113) * lu(1636) + lu(1640) = lu(1640) - lu(1114) * lu(1636) + lu(1641) = lu(1641) - lu(1115) * lu(1636) + lu(1642) = lu(1642) - lu(1116) * lu(1636) + lu(1643) = lu(1643) - lu(1117) * lu(1636) + lu(1644) = lu(1644) - lu(1118) * lu(1636) + lu(1645) = lu(1645) - lu(1119) * lu(1636) + lu(1646) = lu(1646) - lu(1120) * lu(1636) + lu(1647) = lu(1647) - lu(1121) * lu(1636) + lu(1648) = lu(1648) - lu(1122) * lu(1636) + lu(1649) = lu(1649) - lu(1123) * lu(1636) + lu(1650) = lu(1650) - lu(1124) * lu(1636) + lu(1651) = lu(1651) - lu(1125) * lu(1636) + lu(1652) = lu(1652) - lu(1126) * lu(1636) + lu(1653) = lu(1653) - lu(1127) * lu(1636) + lu(1654) = lu(1654) - lu(1128) * lu(1636) + lu(1680) = lu(1680) - lu(1111) * lu(1679) + lu(1681) = lu(1681) - lu(1112) * lu(1679) + lu(1682) = lu(1682) - lu(1113) * lu(1679) + lu(1683) = lu(1683) - lu(1114) * lu(1679) + lu(1684) = lu(1684) - lu(1115) * lu(1679) + lu(1685) = lu(1685) - lu(1116) * lu(1679) + lu(1686) = lu(1686) - lu(1117) * lu(1679) + lu(1687) = lu(1687) - lu(1118) * lu(1679) + lu(1688) = lu(1688) - lu(1119) * lu(1679) + lu(1689) = lu(1689) - lu(1120) * lu(1679) + lu(1690) = lu(1690) - lu(1121) * lu(1679) + lu(1691) = lu(1691) - lu(1122) * lu(1679) + lu(1692) = lu(1692) - lu(1123) * lu(1679) + lu(1693) = lu(1693) - lu(1124) * lu(1679) + lu(1694) = lu(1694) - lu(1125) * lu(1679) + lu(1695) = lu(1695) - lu(1126) * lu(1679) + lu(1696) = lu(1696) - lu(1127) * lu(1679) + lu(1697) = lu(1697) - lu(1128) * lu(1679) + lu(1720) = lu(1720) - lu(1111) * lu(1719) + lu(1721) = lu(1721) - lu(1112) * lu(1719) + lu(1722) = lu(1722) - lu(1113) * lu(1719) + lu(1723) = lu(1723) - lu(1114) * lu(1719) + lu(1724) = lu(1724) - lu(1115) * lu(1719) + lu(1725) = lu(1725) - lu(1116) * lu(1719) + lu(1726) = lu(1726) - lu(1117) * lu(1719) + lu(1727) = lu(1727) - lu(1118) * lu(1719) + lu(1728) = lu(1728) - lu(1119) * lu(1719) + lu(1729) = lu(1729) - lu(1120) * lu(1719) + lu(1730) = lu(1730) - lu(1121) * lu(1719) + lu(1731) = lu(1731) - lu(1122) * lu(1719) + lu(1732) = lu(1732) - lu(1123) * lu(1719) + lu(1733) = lu(1733) - lu(1124) * lu(1719) + lu(1734) = lu(1734) - lu(1125) * lu(1719) + lu(1735) = lu(1735) - lu(1126) * lu(1719) + lu(1736) = lu(1736) - lu(1127) * lu(1719) + lu(1737) = lu(1737) - lu(1128) * lu(1719) + lu(1766) = lu(1766) - lu(1111) * lu(1765) + lu(1767) = lu(1767) - lu(1112) * lu(1765) + lu(1768) = lu(1768) - lu(1113) * lu(1765) + lu(1769) = lu(1769) - lu(1114) * lu(1765) + lu(1770) = lu(1770) - lu(1115) * lu(1765) + lu(1771) = lu(1771) - lu(1116) * lu(1765) + lu(1772) = lu(1772) - lu(1117) * lu(1765) + lu(1773) = lu(1773) - lu(1118) * lu(1765) + lu(1774) = lu(1774) - lu(1119) * lu(1765) + lu(1775) = lu(1775) - lu(1120) * lu(1765) + lu(1776) = lu(1776) - lu(1121) * lu(1765) + lu(1777) = lu(1777) - lu(1122) * lu(1765) + lu(1778) = lu(1778) - lu(1123) * lu(1765) + lu(1779) = lu(1779) - lu(1124) * lu(1765) + lu(1780) = lu(1780) - lu(1125) * lu(1765) + lu(1781) = lu(1781) - lu(1126) * lu(1765) + lu(1782) = lu(1782) - lu(1127) * lu(1765) + lu(1783) = lu(1783) - lu(1128) * lu(1765) + lu(1802) = lu(1802) - lu(1111) * lu(1801) + lu(1803) = lu(1803) - lu(1112) * lu(1801) + lu(1804) = lu(1804) - lu(1113) * lu(1801) + lu(1805) = lu(1805) - lu(1114) * lu(1801) + lu(1806) = lu(1806) - lu(1115) * lu(1801) + lu(1807) = lu(1807) - lu(1116) * lu(1801) + lu(1808) = lu(1808) - lu(1117) * lu(1801) + lu(1809) = lu(1809) - lu(1118) * lu(1801) + lu(1810) = lu(1810) - lu(1119) * lu(1801) + lu(1811) = lu(1811) - lu(1120) * lu(1801) + lu(1812) = lu(1812) - lu(1121) * lu(1801) + lu(1813) = lu(1813) - lu(1122) * lu(1801) + lu(1814) = lu(1814) - lu(1123) * lu(1801) + lu(1815) = lu(1815) - lu(1124) * lu(1801) + lu(1816) = lu(1816) - lu(1125) * lu(1801) + lu(1817) = lu(1817) - lu(1126) * lu(1801) + lu(1818) = lu(1818) - lu(1127) * lu(1801) + lu(1819) = lu(1819) - lu(1128) * lu(1801) + lu(1844) = lu(1844) - lu(1111) * lu(1843) + lu(1845) = lu(1845) - lu(1112) * lu(1843) + lu(1846) = lu(1846) - lu(1113) * lu(1843) + lu(1847) = lu(1847) - lu(1114) * lu(1843) + lu(1848) = lu(1848) - lu(1115) * lu(1843) + lu(1849) = lu(1849) - lu(1116) * lu(1843) + lu(1850) = lu(1850) - lu(1117) * lu(1843) + lu(1851) = lu(1851) - lu(1118) * lu(1843) + lu(1852) = lu(1852) - lu(1119) * lu(1843) + lu(1853) = lu(1853) - lu(1120) * lu(1843) + lu(1854) = lu(1854) - lu(1121) * lu(1843) + lu(1855) = lu(1855) - lu(1122) * lu(1843) + lu(1856) = lu(1856) - lu(1123) * lu(1843) + lu(1857) = lu(1857) - lu(1124) * lu(1843) + lu(1858) = lu(1858) - lu(1125) * lu(1843) + lu(1859) = lu(1859) - lu(1126) * lu(1843) + lu(1860) = lu(1860) - lu(1127) * lu(1843) + lu(1861) = lu(1861) - lu(1128) * lu(1843) + lu(1890) = lu(1890) - lu(1111) * lu(1889) + lu(1891) = lu(1891) - lu(1112) * lu(1889) + lu(1892) = lu(1892) - lu(1113) * lu(1889) + lu(1893) = lu(1893) - lu(1114) * lu(1889) + lu(1894) = lu(1894) - lu(1115) * lu(1889) + lu(1895) = lu(1895) - lu(1116) * lu(1889) + lu(1896) = lu(1896) - lu(1117) * lu(1889) + lu(1897) = lu(1897) - lu(1118) * lu(1889) + lu(1898) = lu(1898) - lu(1119) * lu(1889) + lu(1899) = lu(1899) - lu(1120) * lu(1889) + lu(1900) = lu(1900) - lu(1121) * lu(1889) + lu(1901) = lu(1901) - lu(1122) * lu(1889) + lu(1902) = lu(1902) - lu(1123) * lu(1889) + lu(1903) = lu(1903) - lu(1124) * lu(1889) + lu(1904) = lu(1904) - lu(1125) * lu(1889) + lu(1905) = lu(1905) - lu(1126) * lu(1889) + lu(1906) = lu(1906) - lu(1127) * lu(1889) + lu(1907) = lu(1907) - lu(1128) * lu(1889) + lu(1151) = 1._r8 / lu(1151) + lu(1152) = lu(1152) * lu(1151) + lu(1153) = lu(1153) * lu(1151) + lu(1154) = lu(1154) * lu(1151) + lu(1155) = lu(1155) * lu(1151) + lu(1156) = lu(1156) * lu(1151) + lu(1157) = lu(1157) * lu(1151) + lu(1158) = lu(1158) * lu(1151) + lu(1159) = lu(1159) * lu(1151) + lu(1160) = lu(1160) * lu(1151) + lu(1161) = lu(1161) * lu(1151) + lu(1162) = lu(1162) * lu(1151) + lu(1163) = lu(1163) * lu(1151) + lu(1164) = lu(1164) * lu(1151) + lu(1165) = lu(1165) * lu(1151) + lu(1166) = lu(1166) * lu(1151) + lu(1167) = lu(1167) * lu(1151) + lu(1168) = lu(1168) * lu(1151) + lu(1198) = lu(1198) - lu(1152) * lu(1197) + lu(1199) = lu(1199) - lu(1153) * lu(1197) + lu(1200) = lu(1200) - lu(1154) * lu(1197) + lu(1201) = lu(1201) - lu(1155) * lu(1197) + lu(1202) = lu(1202) - lu(1156) * lu(1197) + lu(1203) = lu(1203) - lu(1157) * lu(1197) + lu(1204) = lu(1204) - lu(1158) * lu(1197) + lu(1205) = lu(1205) - lu(1159) * lu(1197) + lu(1206) = lu(1206) - lu(1160) * lu(1197) + lu(1207) = lu(1207) - lu(1161) * lu(1197) + lu(1208) = lu(1208) - lu(1162) * lu(1197) + lu(1209) = lu(1209) - lu(1163) * lu(1197) + lu(1210) = lu(1210) - lu(1164) * lu(1197) + lu(1211) = lu(1211) - lu(1165) * lu(1197) + lu(1212) = lu(1212) - lu(1166) * lu(1197) + lu(1213) = lu(1213) - lu(1167) * lu(1197) + lu(1214) = lu(1214) - lu(1168) * lu(1197) + lu(1240) = lu(1240) - lu(1152) * lu(1239) + lu(1241) = lu(1241) - lu(1153) * lu(1239) + lu(1242) = lu(1242) - lu(1154) * lu(1239) + lu(1243) = lu(1243) - lu(1155) * lu(1239) + lu(1244) = lu(1244) - lu(1156) * lu(1239) + lu(1245) = lu(1245) - lu(1157) * lu(1239) + lu(1246) = lu(1246) - lu(1158) * lu(1239) + lu(1247) = lu(1247) - lu(1159) * lu(1239) + lu(1248) = lu(1248) - lu(1160) * lu(1239) + lu(1249) = lu(1249) - lu(1161) * lu(1239) + lu(1250) = lu(1250) - lu(1162) * lu(1239) + lu(1251) = lu(1251) - lu(1163) * lu(1239) + lu(1252) = lu(1252) - lu(1164) * lu(1239) + lu(1253) = lu(1253) - lu(1165) * lu(1239) + lu(1254) = lu(1254) - lu(1166) * lu(1239) + lu(1255) = lu(1255) - lu(1167) * lu(1239) + lu(1256) = lu(1256) - lu(1168) * lu(1239) + lu(1276) = lu(1276) - lu(1152) * lu(1275) + lu(1277) = lu(1277) - lu(1153) * lu(1275) + lu(1278) = lu(1278) - lu(1154) * lu(1275) + lu(1279) = lu(1279) - lu(1155) * lu(1275) + lu(1280) = lu(1280) - lu(1156) * lu(1275) + lu(1281) = lu(1281) - lu(1157) * lu(1275) + lu(1282) = lu(1282) - lu(1158) * lu(1275) + lu(1283) = lu(1283) - lu(1159) * lu(1275) + lu(1284) = lu(1284) - lu(1160) * lu(1275) + lu(1285) = lu(1285) - lu(1161) * lu(1275) + lu(1286) = lu(1286) - lu(1162) * lu(1275) + lu(1287) = lu(1287) - lu(1163) * lu(1275) + lu(1288) = lu(1288) - lu(1164) * lu(1275) + lu(1289) = lu(1289) - lu(1165) * lu(1275) + lu(1290) = lu(1290) - lu(1166) * lu(1275) + lu(1291) = lu(1291) - lu(1167) * lu(1275) + lu(1292) = lu(1292) - lu(1168) * lu(1275) + lu(1335) = lu(1335) - lu(1152) * lu(1334) + lu(1336) = lu(1336) - lu(1153) * lu(1334) + lu(1337) = lu(1337) - lu(1154) * lu(1334) + lu(1338) = lu(1338) - lu(1155) * lu(1334) + lu(1339) = lu(1339) - lu(1156) * lu(1334) + lu(1340) = lu(1340) - lu(1157) * lu(1334) + lu(1341) = lu(1341) - lu(1158) * lu(1334) + lu(1342) = lu(1342) - lu(1159) * lu(1334) + lu(1343) = lu(1343) - lu(1160) * lu(1334) + lu(1344) = lu(1344) - lu(1161) * lu(1334) + lu(1345) = lu(1345) - lu(1162) * lu(1334) + lu(1346) = lu(1346) - lu(1163) * lu(1334) + lu(1347) = lu(1347) - lu(1164) * lu(1334) + lu(1348) = lu(1348) - lu(1165) * lu(1334) + lu(1349) = lu(1349) - lu(1166) * lu(1334) + lu(1350) = lu(1350) - lu(1167) * lu(1334) + lu(1351) = lu(1351) - lu(1168) * lu(1334) + lu(1378) = lu(1378) - lu(1152) * lu(1377) + lu(1379) = lu(1379) - lu(1153) * lu(1377) + lu(1380) = lu(1380) - lu(1154) * lu(1377) + lu(1381) = lu(1381) - lu(1155) * lu(1377) + lu(1382) = lu(1382) - lu(1156) * lu(1377) + lu(1383) = lu(1383) - lu(1157) * lu(1377) + lu(1384) = lu(1384) - lu(1158) * lu(1377) + lu(1385) = lu(1385) - lu(1159) * lu(1377) + lu(1386) = lu(1386) - lu(1160) * lu(1377) + lu(1387) = lu(1387) - lu(1161) * lu(1377) + lu(1388) = lu(1388) - lu(1162) * lu(1377) + lu(1389) = lu(1389) - lu(1163) * lu(1377) + lu(1390) = lu(1390) - lu(1164) * lu(1377) + lu(1391) = lu(1391) - lu(1165) * lu(1377) + lu(1392) = lu(1392) - lu(1166) * lu(1377) + lu(1393) = lu(1393) - lu(1167) * lu(1377) + lu(1394) = lu(1394) - lu(1168) * lu(1377) + lu(1419) = lu(1419) - lu(1152) * lu(1418) + lu(1420) = lu(1420) - lu(1153) * lu(1418) + lu(1421) = lu(1421) - lu(1154) * lu(1418) + lu(1422) = lu(1422) - lu(1155) * lu(1418) + lu(1423) = lu(1423) - lu(1156) * lu(1418) + lu(1424) = lu(1424) - lu(1157) * lu(1418) + lu(1425) = lu(1425) - lu(1158) * lu(1418) + lu(1426) = lu(1426) - lu(1159) * lu(1418) + lu(1427) = lu(1427) - lu(1160) * lu(1418) + lu(1428) = lu(1428) - lu(1161) * lu(1418) + lu(1429) = lu(1429) - lu(1162) * lu(1418) + lu(1430) = lu(1430) - lu(1163) * lu(1418) + lu(1431) = lu(1431) - lu(1164) * lu(1418) + lu(1432) = lu(1432) - lu(1165) * lu(1418) + lu(1433) = lu(1433) - lu(1166) * lu(1418) + lu(1434) = lu(1434) - lu(1167) * lu(1418) + lu(1435) = lu(1435) - lu(1168) * lu(1418) + lu(1462) = lu(1462) - lu(1152) * lu(1461) + lu(1463) = lu(1463) - lu(1153) * lu(1461) + lu(1464) = lu(1464) - lu(1154) * lu(1461) + lu(1465) = lu(1465) - lu(1155) * lu(1461) + lu(1466) = lu(1466) - lu(1156) * lu(1461) + lu(1467) = lu(1467) - lu(1157) * lu(1461) + lu(1468) = lu(1468) - lu(1158) * lu(1461) + lu(1469) = lu(1469) - lu(1159) * lu(1461) + lu(1470) = lu(1470) - lu(1160) * lu(1461) + lu(1471) = lu(1471) - lu(1161) * lu(1461) + lu(1472) = lu(1472) - lu(1162) * lu(1461) + lu(1473) = lu(1473) - lu(1163) * lu(1461) + lu(1474) = lu(1474) - lu(1164) * lu(1461) + lu(1475) = lu(1475) - lu(1165) * lu(1461) + lu(1476) = lu(1476) - lu(1166) * lu(1461) + lu(1477) = lu(1477) - lu(1167) * lu(1461) + lu(1478) = lu(1478) - lu(1168) * lu(1461) + lu(1505) = lu(1505) - lu(1152) * lu(1504) + lu(1506) = lu(1506) - lu(1153) * lu(1504) + lu(1507) = lu(1507) - lu(1154) * lu(1504) + lu(1508) = lu(1508) - lu(1155) * lu(1504) + lu(1509) = lu(1509) - lu(1156) * lu(1504) + lu(1510) = lu(1510) - lu(1157) * lu(1504) + lu(1511) = lu(1511) - lu(1158) * lu(1504) + lu(1512) = lu(1512) - lu(1159) * lu(1504) + lu(1513) = lu(1513) - lu(1160) * lu(1504) + lu(1514) = lu(1514) - lu(1161) * lu(1504) + lu(1515) = lu(1515) - lu(1162) * lu(1504) + lu(1516) = lu(1516) - lu(1163) * lu(1504) + lu(1517) = lu(1517) - lu(1164) * lu(1504) + lu(1518) = lu(1518) - lu(1165) * lu(1504) + lu(1519) = lu(1519) - lu(1166) * lu(1504) + lu(1520) = lu(1520) - lu(1167) * lu(1504) + lu(1521) = lu(1521) - lu(1168) * lu(1504) + lu(1551) = lu(1551) - lu(1152) * lu(1550) + lu(1552) = lu(1552) - lu(1153) * lu(1550) + lu(1553) = lu(1553) - lu(1154) * lu(1550) + lu(1554) = lu(1554) - lu(1155) * lu(1550) + lu(1555) = lu(1555) - lu(1156) * lu(1550) + lu(1556) = lu(1556) - lu(1157) * lu(1550) + lu(1557) = lu(1557) - lu(1158) * lu(1550) + lu(1558) = lu(1558) - lu(1159) * lu(1550) + lu(1559) = lu(1559) - lu(1160) * lu(1550) + lu(1560) = lu(1560) - lu(1161) * lu(1550) + lu(1561) = lu(1561) - lu(1162) * lu(1550) + lu(1562) = lu(1562) - lu(1163) * lu(1550) + lu(1563) = lu(1563) - lu(1164) * lu(1550) + lu(1564) = lu(1564) - lu(1165) * lu(1550) + lu(1565) = lu(1565) - lu(1166) * lu(1550) + lu(1566) = lu(1566) - lu(1167) * lu(1550) + lu(1567) = lu(1567) - lu(1168) * lu(1550) + lu(1597) = lu(1597) - lu(1152) * lu(1596) + lu(1598) = lu(1598) - lu(1153) * lu(1596) + lu(1599) = lu(1599) - lu(1154) * lu(1596) + lu(1600) = lu(1600) - lu(1155) * lu(1596) + lu(1601) = lu(1601) - lu(1156) * lu(1596) + lu(1602) = lu(1602) - lu(1157) * lu(1596) + lu(1603) = lu(1603) - lu(1158) * lu(1596) + lu(1604) = lu(1604) - lu(1159) * lu(1596) + lu(1605) = lu(1605) - lu(1160) * lu(1596) + lu(1606) = lu(1606) - lu(1161) * lu(1596) + lu(1607) = lu(1607) - lu(1162) * lu(1596) + lu(1608) = lu(1608) - lu(1163) * lu(1596) + lu(1609) = lu(1609) - lu(1164) * lu(1596) + lu(1610) = lu(1610) - lu(1165) * lu(1596) + lu(1611) = lu(1611) - lu(1166) * lu(1596) + lu(1612) = lu(1612) - lu(1167) * lu(1596) + lu(1613) = lu(1613) - lu(1168) * lu(1596) + lu(1638) = lu(1638) - lu(1152) * lu(1637) + lu(1639) = lu(1639) - lu(1153) * lu(1637) + lu(1640) = lu(1640) - lu(1154) * lu(1637) + lu(1641) = lu(1641) - lu(1155) * lu(1637) + lu(1642) = lu(1642) - lu(1156) * lu(1637) + lu(1643) = lu(1643) - lu(1157) * lu(1637) + lu(1644) = lu(1644) - lu(1158) * lu(1637) + lu(1645) = lu(1645) - lu(1159) * lu(1637) + lu(1646) = lu(1646) - lu(1160) * lu(1637) + lu(1647) = lu(1647) - lu(1161) * lu(1637) + lu(1648) = lu(1648) - lu(1162) * lu(1637) + lu(1649) = lu(1649) - lu(1163) * lu(1637) + lu(1650) = lu(1650) - lu(1164) * lu(1637) + lu(1651) = lu(1651) - lu(1165) * lu(1637) + lu(1652) = lu(1652) - lu(1166) * lu(1637) + lu(1653) = lu(1653) - lu(1167) * lu(1637) + lu(1654) = lu(1654) - lu(1168) * lu(1637) + lu(1681) = lu(1681) - lu(1152) * lu(1680) + lu(1682) = lu(1682) - lu(1153) * lu(1680) + lu(1683) = lu(1683) - lu(1154) * lu(1680) + lu(1684) = lu(1684) - lu(1155) * lu(1680) + lu(1685) = lu(1685) - lu(1156) * lu(1680) + lu(1686) = lu(1686) - lu(1157) * lu(1680) + lu(1687) = lu(1687) - lu(1158) * lu(1680) + lu(1688) = lu(1688) - lu(1159) * lu(1680) + lu(1689) = lu(1689) - lu(1160) * lu(1680) + lu(1690) = lu(1690) - lu(1161) * lu(1680) + lu(1691) = lu(1691) - lu(1162) * lu(1680) + lu(1692) = lu(1692) - lu(1163) * lu(1680) + lu(1693) = lu(1693) - lu(1164) * lu(1680) + lu(1694) = lu(1694) - lu(1165) * lu(1680) + lu(1695) = lu(1695) - lu(1166) * lu(1680) + lu(1696) = lu(1696) - lu(1167) * lu(1680) + lu(1697) = lu(1697) - lu(1168) * lu(1680) + lu(1721) = lu(1721) - lu(1152) * lu(1720) + lu(1722) = lu(1722) - lu(1153) * lu(1720) + lu(1723) = lu(1723) - lu(1154) * lu(1720) + lu(1724) = lu(1724) - lu(1155) * lu(1720) + lu(1725) = lu(1725) - lu(1156) * lu(1720) + lu(1726) = lu(1726) - lu(1157) * lu(1720) + lu(1727) = lu(1727) - lu(1158) * lu(1720) + lu(1728) = lu(1728) - lu(1159) * lu(1720) + lu(1729) = lu(1729) - lu(1160) * lu(1720) + lu(1730) = lu(1730) - lu(1161) * lu(1720) + lu(1731) = lu(1731) - lu(1162) * lu(1720) + lu(1732) = lu(1732) - lu(1163) * lu(1720) + lu(1733) = lu(1733) - lu(1164) * lu(1720) + lu(1734) = lu(1734) - lu(1165) * lu(1720) + lu(1735) = lu(1735) - lu(1166) * lu(1720) + lu(1736) = lu(1736) - lu(1167) * lu(1720) + lu(1737) = lu(1737) - lu(1168) * lu(1720) + lu(1767) = lu(1767) - lu(1152) * lu(1766) + lu(1768) = lu(1768) - lu(1153) * lu(1766) + lu(1769) = lu(1769) - lu(1154) * lu(1766) + lu(1770) = lu(1770) - lu(1155) * lu(1766) + lu(1771) = lu(1771) - lu(1156) * lu(1766) + lu(1772) = lu(1772) - lu(1157) * lu(1766) + lu(1773) = lu(1773) - lu(1158) * lu(1766) + lu(1774) = lu(1774) - lu(1159) * lu(1766) + lu(1775) = lu(1775) - lu(1160) * lu(1766) + lu(1776) = lu(1776) - lu(1161) * lu(1766) + lu(1777) = lu(1777) - lu(1162) * lu(1766) + lu(1778) = lu(1778) - lu(1163) * lu(1766) + lu(1779) = lu(1779) - lu(1164) * lu(1766) + lu(1780) = lu(1780) - lu(1165) * lu(1766) + lu(1781) = lu(1781) - lu(1166) * lu(1766) + lu(1782) = lu(1782) - lu(1167) * lu(1766) + lu(1783) = lu(1783) - lu(1168) * lu(1766) + lu(1803) = lu(1803) - lu(1152) * lu(1802) + lu(1804) = lu(1804) - lu(1153) * lu(1802) + lu(1805) = lu(1805) - lu(1154) * lu(1802) + lu(1806) = lu(1806) - lu(1155) * lu(1802) + lu(1807) = lu(1807) - lu(1156) * lu(1802) + lu(1808) = lu(1808) - lu(1157) * lu(1802) + lu(1809) = lu(1809) - lu(1158) * lu(1802) + lu(1810) = lu(1810) - lu(1159) * lu(1802) + lu(1811) = lu(1811) - lu(1160) * lu(1802) + lu(1812) = lu(1812) - lu(1161) * lu(1802) + lu(1813) = lu(1813) - lu(1162) * lu(1802) + lu(1814) = lu(1814) - lu(1163) * lu(1802) + lu(1815) = lu(1815) - lu(1164) * lu(1802) + lu(1816) = lu(1816) - lu(1165) * lu(1802) + lu(1817) = lu(1817) - lu(1166) * lu(1802) + lu(1818) = lu(1818) - lu(1167) * lu(1802) + lu(1819) = lu(1819) - lu(1168) * lu(1802) + lu(1845) = lu(1845) - lu(1152) * lu(1844) + lu(1846) = lu(1846) - lu(1153) * lu(1844) + lu(1847) = lu(1847) - lu(1154) * lu(1844) + lu(1848) = lu(1848) - lu(1155) * lu(1844) + lu(1849) = lu(1849) - lu(1156) * lu(1844) + lu(1850) = lu(1850) - lu(1157) * lu(1844) + lu(1851) = lu(1851) - lu(1158) * lu(1844) + lu(1852) = lu(1852) - lu(1159) * lu(1844) + lu(1853) = lu(1853) - lu(1160) * lu(1844) + lu(1854) = lu(1854) - lu(1161) * lu(1844) + lu(1855) = lu(1855) - lu(1162) * lu(1844) + lu(1856) = lu(1856) - lu(1163) * lu(1844) + lu(1857) = lu(1857) - lu(1164) * lu(1844) + lu(1858) = lu(1858) - lu(1165) * lu(1844) + lu(1859) = lu(1859) - lu(1166) * lu(1844) + lu(1860) = lu(1860) - lu(1167) * lu(1844) + lu(1861) = lu(1861) - lu(1168) * lu(1844) + lu(1891) = lu(1891) - lu(1152) * lu(1890) + lu(1892) = lu(1892) - lu(1153) * lu(1890) + lu(1893) = lu(1893) - lu(1154) * lu(1890) + lu(1894) = lu(1894) - lu(1155) * lu(1890) + lu(1895) = lu(1895) - lu(1156) * lu(1890) + lu(1896) = lu(1896) - lu(1157) * lu(1890) + lu(1897) = lu(1897) - lu(1158) * lu(1890) + lu(1898) = lu(1898) - lu(1159) * lu(1890) + lu(1899) = lu(1899) - lu(1160) * lu(1890) + lu(1900) = lu(1900) - lu(1161) * lu(1890) + lu(1901) = lu(1901) - lu(1162) * lu(1890) + lu(1902) = lu(1902) - lu(1163) * lu(1890) + lu(1903) = lu(1903) - lu(1164) * lu(1890) + lu(1904) = lu(1904) - lu(1165) * lu(1890) + lu(1905) = lu(1905) - lu(1166) * lu(1890) + lu(1906) = lu(1906) - lu(1167) * lu(1890) + lu(1907) = lu(1907) - lu(1168) * lu(1890) + end subroutine lu_fac20 + subroutine lu_fac21( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1198) = 1._r8 / lu(1198) + lu(1199) = lu(1199) * lu(1198) + lu(1200) = lu(1200) * lu(1198) + lu(1201) = lu(1201) * lu(1198) + lu(1202) = lu(1202) * lu(1198) + lu(1203) = lu(1203) * lu(1198) + lu(1204) = lu(1204) * lu(1198) + lu(1205) = lu(1205) * lu(1198) + lu(1206) = lu(1206) * lu(1198) + lu(1207) = lu(1207) * lu(1198) + lu(1208) = lu(1208) * lu(1198) + lu(1209) = lu(1209) * lu(1198) + lu(1210) = lu(1210) * lu(1198) + lu(1211) = lu(1211) * lu(1198) + lu(1212) = lu(1212) * lu(1198) + lu(1213) = lu(1213) * lu(1198) + lu(1214) = lu(1214) * lu(1198) + lu(1241) = lu(1241) - lu(1199) * lu(1240) + lu(1242) = lu(1242) - lu(1200) * lu(1240) + lu(1243) = lu(1243) - lu(1201) * lu(1240) + lu(1244) = lu(1244) - lu(1202) * lu(1240) + lu(1245) = lu(1245) - lu(1203) * lu(1240) + lu(1246) = lu(1246) - lu(1204) * lu(1240) + lu(1247) = lu(1247) - lu(1205) * lu(1240) + lu(1248) = lu(1248) - lu(1206) * lu(1240) + lu(1249) = lu(1249) - lu(1207) * lu(1240) + lu(1250) = lu(1250) - lu(1208) * lu(1240) + lu(1251) = lu(1251) - lu(1209) * lu(1240) + lu(1252) = lu(1252) - lu(1210) * lu(1240) + lu(1253) = lu(1253) - lu(1211) * lu(1240) + lu(1254) = lu(1254) - lu(1212) * lu(1240) + lu(1255) = lu(1255) - lu(1213) * lu(1240) + lu(1256) = lu(1256) - lu(1214) * lu(1240) + lu(1277) = lu(1277) - lu(1199) * lu(1276) + lu(1278) = lu(1278) - lu(1200) * lu(1276) + lu(1279) = lu(1279) - lu(1201) * lu(1276) + lu(1280) = lu(1280) - lu(1202) * lu(1276) + lu(1281) = lu(1281) - lu(1203) * lu(1276) + lu(1282) = lu(1282) - lu(1204) * lu(1276) + lu(1283) = lu(1283) - lu(1205) * lu(1276) + lu(1284) = lu(1284) - lu(1206) * lu(1276) + lu(1285) = lu(1285) - lu(1207) * lu(1276) + lu(1286) = lu(1286) - lu(1208) * lu(1276) + lu(1287) = lu(1287) - lu(1209) * lu(1276) + lu(1288) = lu(1288) - lu(1210) * lu(1276) + lu(1289) = lu(1289) - lu(1211) * lu(1276) + lu(1290) = lu(1290) - lu(1212) * lu(1276) + lu(1291) = lu(1291) - lu(1213) * lu(1276) + lu(1292) = lu(1292) - lu(1214) * lu(1276) + lu(1336) = lu(1336) - lu(1199) * lu(1335) + lu(1337) = lu(1337) - lu(1200) * lu(1335) + lu(1338) = lu(1338) - lu(1201) * lu(1335) + lu(1339) = lu(1339) - lu(1202) * lu(1335) + lu(1340) = lu(1340) - lu(1203) * lu(1335) + lu(1341) = lu(1341) - lu(1204) * lu(1335) + lu(1342) = lu(1342) - lu(1205) * lu(1335) + lu(1343) = lu(1343) - lu(1206) * lu(1335) + lu(1344) = lu(1344) - lu(1207) * lu(1335) + lu(1345) = lu(1345) - lu(1208) * lu(1335) + lu(1346) = lu(1346) - lu(1209) * lu(1335) + lu(1347) = lu(1347) - lu(1210) * lu(1335) + lu(1348) = lu(1348) - lu(1211) * lu(1335) + lu(1349) = lu(1349) - lu(1212) * lu(1335) + lu(1350) = lu(1350) - lu(1213) * lu(1335) + lu(1351) = lu(1351) - lu(1214) * lu(1335) + lu(1379) = lu(1379) - lu(1199) * lu(1378) + lu(1380) = lu(1380) - lu(1200) * lu(1378) + lu(1381) = lu(1381) - lu(1201) * lu(1378) + lu(1382) = lu(1382) - lu(1202) * lu(1378) + lu(1383) = lu(1383) - lu(1203) * lu(1378) + lu(1384) = lu(1384) - lu(1204) * lu(1378) + lu(1385) = lu(1385) - lu(1205) * lu(1378) + lu(1386) = lu(1386) - lu(1206) * lu(1378) + lu(1387) = lu(1387) - lu(1207) * lu(1378) + lu(1388) = lu(1388) - lu(1208) * lu(1378) + lu(1389) = lu(1389) - lu(1209) * lu(1378) + lu(1390) = lu(1390) - lu(1210) * lu(1378) + lu(1391) = lu(1391) - lu(1211) * lu(1378) + lu(1392) = lu(1392) - lu(1212) * lu(1378) + lu(1393) = lu(1393) - lu(1213) * lu(1378) + lu(1394) = lu(1394) - lu(1214) * lu(1378) + lu(1420) = lu(1420) - lu(1199) * lu(1419) + lu(1421) = lu(1421) - lu(1200) * lu(1419) + lu(1422) = lu(1422) - lu(1201) * lu(1419) + lu(1423) = lu(1423) - lu(1202) * lu(1419) + lu(1424) = lu(1424) - lu(1203) * lu(1419) + lu(1425) = lu(1425) - lu(1204) * lu(1419) + lu(1426) = lu(1426) - lu(1205) * lu(1419) + lu(1427) = lu(1427) - lu(1206) * lu(1419) + lu(1428) = lu(1428) - lu(1207) * lu(1419) + lu(1429) = lu(1429) - lu(1208) * lu(1419) + lu(1430) = lu(1430) - lu(1209) * lu(1419) + lu(1431) = lu(1431) - lu(1210) * lu(1419) + lu(1432) = lu(1432) - lu(1211) * lu(1419) + lu(1433) = lu(1433) - lu(1212) * lu(1419) + lu(1434) = lu(1434) - lu(1213) * lu(1419) + lu(1435) = lu(1435) - lu(1214) * lu(1419) + lu(1463) = lu(1463) - lu(1199) * lu(1462) + lu(1464) = lu(1464) - lu(1200) * lu(1462) + lu(1465) = lu(1465) - lu(1201) * lu(1462) + lu(1466) = lu(1466) - lu(1202) * lu(1462) + lu(1467) = lu(1467) - lu(1203) * lu(1462) + lu(1468) = lu(1468) - lu(1204) * lu(1462) + lu(1469) = lu(1469) - lu(1205) * lu(1462) + lu(1470) = lu(1470) - lu(1206) * lu(1462) + lu(1471) = lu(1471) - lu(1207) * lu(1462) + lu(1472) = lu(1472) - lu(1208) * lu(1462) + lu(1473) = lu(1473) - lu(1209) * lu(1462) + lu(1474) = lu(1474) - lu(1210) * lu(1462) + lu(1475) = lu(1475) - lu(1211) * lu(1462) + lu(1476) = lu(1476) - lu(1212) * lu(1462) + lu(1477) = lu(1477) - lu(1213) * lu(1462) + lu(1478) = lu(1478) - lu(1214) * lu(1462) + lu(1506) = lu(1506) - lu(1199) * lu(1505) + lu(1507) = lu(1507) - lu(1200) * lu(1505) + lu(1508) = lu(1508) - lu(1201) * lu(1505) + lu(1509) = lu(1509) - lu(1202) * lu(1505) + lu(1510) = lu(1510) - lu(1203) * lu(1505) + lu(1511) = lu(1511) - lu(1204) * lu(1505) + lu(1512) = lu(1512) - lu(1205) * lu(1505) + lu(1513) = lu(1513) - lu(1206) * lu(1505) + lu(1514) = lu(1514) - lu(1207) * lu(1505) + lu(1515) = lu(1515) - lu(1208) * lu(1505) + lu(1516) = lu(1516) - lu(1209) * lu(1505) + lu(1517) = lu(1517) - lu(1210) * lu(1505) + lu(1518) = lu(1518) - lu(1211) * lu(1505) + lu(1519) = lu(1519) - lu(1212) * lu(1505) + lu(1520) = lu(1520) - lu(1213) * lu(1505) + lu(1521) = lu(1521) - lu(1214) * lu(1505) + lu(1552) = lu(1552) - lu(1199) * lu(1551) + lu(1553) = lu(1553) - lu(1200) * lu(1551) + lu(1554) = lu(1554) - lu(1201) * lu(1551) + lu(1555) = lu(1555) - lu(1202) * lu(1551) + lu(1556) = lu(1556) - lu(1203) * lu(1551) + lu(1557) = lu(1557) - lu(1204) * lu(1551) + lu(1558) = lu(1558) - lu(1205) * lu(1551) + lu(1559) = lu(1559) - lu(1206) * lu(1551) + lu(1560) = lu(1560) - lu(1207) * lu(1551) + lu(1561) = lu(1561) - lu(1208) * lu(1551) + lu(1562) = lu(1562) - lu(1209) * lu(1551) + lu(1563) = lu(1563) - lu(1210) * lu(1551) + lu(1564) = lu(1564) - lu(1211) * lu(1551) + lu(1565) = lu(1565) - lu(1212) * lu(1551) + lu(1566) = lu(1566) - lu(1213) * lu(1551) + lu(1567) = lu(1567) - lu(1214) * lu(1551) + lu(1598) = lu(1598) - lu(1199) * lu(1597) + lu(1599) = lu(1599) - lu(1200) * lu(1597) + lu(1600) = lu(1600) - lu(1201) * lu(1597) + lu(1601) = lu(1601) - lu(1202) * lu(1597) + lu(1602) = lu(1602) - lu(1203) * lu(1597) + lu(1603) = lu(1603) - lu(1204) * lu(1597) + lu(1604) = lu(1604) - lu(1205) * lu(1597) + lu(1605) = lu(1605) - lu(1206) * lu(1597) + lu(1606) = lu(1606) - lu(1207) * lu(1597) + lu(1607) = lu(1607) - lu(1208) * lu(1597) + lu(1608) = lu(1608) - lu(1209) * lu(1597) + lu(1609) = lu(1609) - lu(1210) * lu(1597) + lu(1610) = lu(1610) - lu(1211) * lu(1597) + lu(1611) = lu(1611) - lu(1212) * lu(1597) + lu(1612) = lu(1612) - lu(1213) * lu(1597) + lu(1613) = lu(1613) - lu(1214) * lu(1597) + lu(1639) = lu(1639) - lu(1199) * lu(1638) + lu(1640) = lu(1640) - lu(1200) * lu(1638) + lu(1641) = lu(1641) - lu(1201) * lu(1638) + lu(1642) = lu(1642) - lu(1202) * lu(1638) + lu(1643) = lu(1643) - lu(1203) * lu(1638) + lu(1644) = lu(1644) - lu(1204) * lu(1638) + lu(1645) = lu(1645) - lu(1205) * lu(1638) + lu(1646) = lu(1646) - lu(1206) * lu(1638) + lu(1647) = lu(1647) - lu(1207) * lu(1638) + lu(1648) = lu(1648) - lu(1208) * lu(1638) + lu(1649) = lu(1649) - lu(1209) * lu(1638) + lu(1650) = lu(1650) - lu(1210) * lu(1638) + lu(1651) = lu(1651) - lu(1211) * lu(1638) + lu(1652) = lu(1652) - lu(1212) * lu(1638) + lu(1653) = lu(1653) - lu(1213) * lu(1638) + lu(1654) = lu(1654) - lu(1214) * lu(1638) + lu(1682) = lu(1682) - lu(1199) * lu(1681) + lu(1683) = lu(1683) - lu(1200) * lu(1681) + lu(1684) = lu(1684) - lu(1201) * lu(1681) + lu(1685) = lu(1685) - lu(1202) * lu(1681) + lu(1686) = lu(1686) - lu(1203) * lu(1681) + lu(1687) = lu(1687) - lu(1204) * lu(1681) + lu(1688) = lu(1688) - lu(1205) * lu(1681) + lu(1689) = lu(1689) - lu(1206) * lu(1681) + lu(1690) = lu(1690) - lu(1207) * lu(1681) + lu(1691) = lu(1691) - lu(1208) * lu(1681) + lu(1692) = lu(1692) - lu(1209) * lu(1681) + lu(1693) = lu(1693) - lu(1210) * lu(1681) + lu(1694) = lu(1694) - lu(1211) * lu(1681) + lu(1695) = lu(1695) - lu(1212) * lu(1681) + lu(1696) = lu(1696) - lu(1213) * lu(1681) + lu(1697) = lu(1697) - lu(1214) * lu(1681) + lu(1722) = lu(1722) - lu(1199) * lu(1721) + lu(1723) = lu(1723) - lu(1200) * lu(1721) + lu(1724) = lu(1724) - lu(1201) * lu(1721) + lu(1725) = lu(1725) - lu(1202) * lu(1721) + lu(1726) = lu(1726) - lu(1203) * lu(1721) + lu(1727) = lu(1727) - lu(1204) * lu(1721) + lu(1728) = lu(1728) - lu(1205) * lu(1721) + lu(1729) = lu(1729) - lu(1206) * lu(1721) + lu(1730) = lu(1730) - lu(1207) * lu(1721) + lu(1731) = lu(1731) - lu(1208) * lu(1721) + lu(1732) = lu(1732) - lu(1209) * lu(1721) + lu(1733) = lu(1733) - lu(1210) * lu(1721) + lu(1734) = lu(1734) - lu(1211) * lu(1721) + lu(1735) = lu(1735) - lu(1212) * lu(1721) + lu(1736) = lu(1736) - lu(1213) * lu(1721) + lu(1737) = lu(1737) - lu(1214) * lu(1721) + lu(1768) = lu(1768) - lu(1199) * lu(1767) + lu(1769) = lu(1769) - lu(1200) * lu(1767) + lu(1770) = lu(1770) - lu(1201) * lu(1767) + lu(1771) = lu(1771) - lu(1202) * lu(1767) + lu(1772) = lu(1772) - lu(1203) * lu(1767) + lu(1773) = lu(1773) - lu(1204) * lu(1767) + lu(1774) = lu(1774) - lu(1205) * lu(1767) + lu(1775) = lu(1775) - lu(1206) * lu(1767) + lu(1776) = lu(1776) - lu(1207) * lu(1767) + lu(1777) = lu(1777) - lu(1208) * lu(1767) + lu(1778) = lu(1778) - lu(1209) * lu(1767) + lu(1779) = lu(1779) - lu(1210) * lu(1767) + lu(1780) = lu(1780) - lu(1211) * lu(1767) + lu(1781) = lu(1781) - lu(1212) * lu(1767) + lu(1782) = lu(1782) - lu(1213) * lu(1767) + lu(1783) = lu(1783) - lu(1214) * lu(1767) + lu(1804) = lu(1804) - lu(1199) * lu(1803) + lu(1805) = lu(1805) - lu(1200) * lu(1803) + lu(1806) = lu(1806) - lu(1201) * lu(1803) + lu(1807) = lu(1807) - lu(1202) * lu(1803) + lu(1808) = lu(1808) - lu(1203) * lu(1803) + lu(1809) = lu(1809) - lu(1204) * lu(1803) + lu(1810) = lu(1810) - lu(1205) * lu(1803) + lu(1811) = lu(1811) - lu(1206) * lu(1803) + lu(1812) = lu(1812) - lu(1207) * lu(1803) + lu(1813) = lu(1813) - lu(1208) * lu(1803) + lu(1814) = lu(1814) - lu(1209) * lu(1803) + lu(1815) = lu(1815) - lu(1210) * lu(1803) + lu(1816) = lu(1816) - lu(1211) * lu(1803) + lu(1817) = lu(1817) - lu(1212) * lu(1803) + lu(1818) = lu(1818) - lu(1213) * lu(1803) + lu(1819) = lu(1819) - lu(1214) * lu(1803) + lu(1846) = lu(1846) - lu(1199) * lu(1845) + lu(1847) = lu(1847) - lu(1200) * lu(1845) + lu(1848) = lu(1848) - lu(1201) * lu(1845) + lu(1849) = lu(1849) - lu(1202) * lu(1845) + lu(1850) = lu(1850) - lu(1203) * lu(1845) + lu(1851) = lu(1851) - lu(1204) * lu(1845) + lu(1852) = lu(1852) - lu(1205) * lu(1845) + lu(1853) = lu(1853) - lu(1206) * lu(1845) + lu(1854) = lu(1854) - lu(1207) * lu(1845) + lu(1855) = lu(1855) - lu(1208) * lu(1845) + lu(1856) = lu(1856) - lu(1209) * lu(1845) + lu(1857) = lu(1857) - lu(1210) * lu(1845) + lu(1858) = lu(1858) - lu(1211) * lu(1845) + lu(1859) = lu(1859) - lu(1212) * lu(1845) + lu(1860) = lu(1860) - lu(1213) * lu(1845) + lu(1861) = lu(1861) - lu(1214) * lu(1845) + lu(1892) = lu(1892) - lu(1199) * lu(1891) + lu(1893) = lu(1893) - lu(1200) * lu(1891) + lu(1894) = lu(1894) - lu(1201) * lu(1891) + lu(1895) = lu(1895) - lu(1202) * lu(1891) + lu(1896) = lu(1896) - lu(1203) * lu(1891) + lu(1897) = lu(1897) - lu(1204) * lu(1891) + lu(1898) = lu(1898) - lu(1205) * lu(1891) + lu(1899) = lu(1899) - lu(1206) * lu(1891) + lu(1900) = lu(1900) - lu(1207) * lu(1891) + lu(1901) = lu(1901) - lu(1208) * lu(1891) + lu(1902) = lu(1902) - lu(1209) * lu(1891) + lu(1903) = lu(1903) - lu(1210) * lu(1891) + lu(1904) = lu(1904) - lu(1211) * lu(1891) + lu(1905) = lu(1905) - lu(1212) * lu(1891) + lu(1906) = lu(1906) - lu(1213) * lu(1891) + lu(1907) = lu(1907) - lu(1214) * lu(1891) + lu(1241) = 1._r8 / lu(1241) + lu(1242) = lu(1242) * lu(1241) + lu(1243) = lu(1243) * lu(1241) + lu(1244) = lu(1244) * lu(1241) + lu(1245) = lu(1245) * lu(1241) + lu(1246) = lu(1246) * lu(1241) + lu(1247) = lu(1247) * lu(1241) + lu(1248) = lu(1248) * lu(1241) + lu(1249) = lu(1249) * lu(1241) + lu(1250) = lu(1250) * lu(1241) + lu(1251) = lu(1251) * lu(1241) + lu(1252) = lu(1252) * lu(1241) + lu(1253) = lu(1253) * lu(1241) + lu(1254) = lu(1254) * lu(1241) + lu(1255) = lu(1255) * lu(1241) + lu(1256) = lu(1256) * lu(1241) + lu(1278) = lu(1278) - lu(1242) * lu(1277) + lu(1279) = lu(1279) - lu(1243) * lu(1277) + lu(1280) = lu(1280) - lu(1244) * lu(1277) + lu(1281) = lu(1281) - lu(1245) * lu(1277) + lu(1282) = lu(1282) - lu(1246) * lu(1277) + lu(1283) = lu(1283) - lu(1247) * lu(1277) + lu(1284) = lu(1284) - lu(1248) * lu(1277) + lu(1285) = lu(1285) - lu(1249) * lu(1277) + lu(1286) = lu(1286) - lu(1250) * lu(1277) + lu(1287) = lu(1287) - lu(1251) * lu(1277) + lu(1288) = lu(1288) - lu(1252) * lu(1277) + lu(1289) = lu(1289) - lu(1253) * lu(1277) + lu(1290) = lu(1290) - lu(1254) * lu(1277) + lu(1291) = lu(1291) - lu(1255) * lu(1277) + lu(1292) = lu(1292) - lu(1256) * lu(1277) + lu(1337) = lu(1337) - lu(1242) * lu(1336) + lu(1338) = lu(1338) - lu(1243) * lu(1336) + lu(1339) = lu(1339) - lu(1244) * lu(1336) + lu(1340) = lu(1340) - lu(1245) * lu(1336) + lu(1341) = lu(1341) - lu(1246) * lu(1336) + lu(1342) = lu(1342) - lu(1247) * lu(1336) + lu(1343) = lu(1343) - lu(1248) * lu(1336) + lu(1344) = lu(1344) - lu(1249) * lu(1336) + lu(1345) = lu(1345) - lu(1250) * lu(1336) + lu(1346) = lu(1346) - lu(1251) * lu(1336) + lu(1347) = lu(1347) - lu(1252) * lu(1336) + lu(1348) = lu(1348) - lu(1253) * lu(1336) + lu(1349) = lu(1349) - lu(1254) * lu(1336) + lu(1350) = lu(1350) - lu(1255) * lu(1336) + lu(1351) = lu(1351) - lu(1256) * lu(1336) + lu(1380) = lu(1380) - lu(1242) * lu(1379) + lu(1381) = lu(1381) - lu(1243) * lu(1379) + lu(1382) = lu(1382) - lu(1244) * lu(1379) + lu(1383) = lu(1383) - lu(1245) * lu(1379) + lu(1384) = lu(1384) - lu(1246) * lu(1379) + lu(1385) = lu(1385) - lu(1247) * lu(1379) + lu(1386) = lu(1386) - lu(1248) * lu(1379) + lu(1387) = lu(1387) - lu(1249) * lu(1379) + lu(1388) = lu(1388) - lu(1250) * lu(1379) + lu(1389) = lu(1389) - lu(1251) * lu(1379) + lu(1390) = lu(1390) - lu(1252) * lu(1379) + lu(1391) = lu(1391) - lu(1253) * lu(1379) + lu(1392) = lu(1392) - lu(1254) * lu(1379) + lu(1393) = lu(1393) - lu(1255) * lu(1379) + lu(1394) = lu(1394) - lu(1256) * lu(1379) + lu(1421) = lu(1421) - lu(1242) * lu(1420) + lu(1422) = lu(1422) - lu(1243) * lu(1420) + lu(1423) = lu(1423) - lu(1244) * lu(1420) + lu(1424) = lu(1424) - lu(1245) * lu(1420) + lu(1425) = lu(1425) - lu(1246) * lu(1420) + lu(1426) = lu(1426) - lu(1247) * lu(1420) + lu(1427) = lu(1427) - lu(1248) * lu(1420) + lu(1428) = lu(1428) - lu(1249) * lu(1420) + lu(1429) = lu(1429) - lu(1250) * lu(1420) + lu(1430) = lu(1430) - lu(1251) * lu(1420) + lu(1431) = lu(1431) - lu(1252) * lu(1420) + lu(1432) = lu(1432) - lu(1253) * lu(1420) + lu(1433) = lu(1433) - lu(1254) * lu(1420) + lu(1434) = lu(1434) - lu(1255) * lu(1420) + lu(1435) = lu(1435) - lu(1256) * lu(1420) + lu(1464) = lu(1464) - lu(1242) * lu(1463) + lu(1465) = lu(1465) - lu(1243) * lu(1463) + lu(1466) = lu(1466) - lu(1244) * lu(1463) + lu(1467) = lu(1467) - lu(1245) * lu(1463) + lu(1468) = lu(1468) - lu(1246) * lu(1463) + lu(1469) = lu(1469) - lu(1247) * lu(1463) + lu(1470) = lu(1470) - lu(1248) * lu(1463) + lu(1471) = lu(1471) - lu(1249) * lu(1463) + lu(1472) = lu(1472) - lu(1250) * lu(1463) + lu(1473) = lu(1473) - lu(1251) * lu(1463) + lu(1474) = lu(1474) - lu(1252) * lu(1463) + lu(1475) = lu(1475) - lu(1253) * lu(1463) + lu(1476) = lu(1476) - lu(1254) * lu(1463) + lu(1477) = lu(1477) - lu(1255) * lu(1463) + lu(1478) = lu(1478) - lu(1256) * lu(1463) + lu(1507) = lu(1507) - lu(1242) * lu(1506) + lu(1508) = lu(1508) - lu(1243) * lu(1506) + lu(1509) = lu(1509) - lu(1244) * lu(1506) + lu(1510) = lu(1510) - lu(1245) * lu(1506) + lu(1511) = lu(1511) - lu(1246) * lu(1506) + lu(1512) = lu(1512) - lu(1247) * lu(1506) + lu(1513) = lu(1513) - lu(1248) * lu(1506) + lu(1514) = lu(1514) - lu(1249) * lu(1506) + lu(1515) = lu(1515) - lu(1250) * lu(1506) + lu(1516) = lu(1516) - lu(1251) * lu(1506) + lu(1517) = lu(1517) - lu(1252) * lu(1506) + lu(1518) = lu(1518) - lu(1253) * lu(1506) + lu(1519) = lu(1519) - lu(1254) * lu(1506) + lu(1520) = lu(1520) - lu(1255) * lu(1506) + lu(1521) = lu(1521) - lu(1256) * lu(1506) + lu(1553) = lu(1553) - lu(1242) * lu(1552) + lu(1554) = lu(1554) - lu(1243) * lu(1552) + lu(1555) = lu(1555) - lu(1244) * lu(1552) + lu(1556) = lu(1556) - lu(1245) * lu(1552) + lu(1557) = lu(1557) - lu(1246) * lu(1552) + lu(1558) = lu(1558) - lu(1247) * lu(1552) + lu(1559) = lu(1559) - lu(1248) * lu(1552) + lu(1560) = lu(1560) - lu(1249) * lu(1552) + lu(1561) = lu(1561) - lu(1250) * lu(1552) + lu(1562) = lu(1562) - lu(1251) * lu(1552) + lu(1563) = lu(1563) - lu(1252) * lu(1552) + lu(1564) = lu(1564) - lu(1253) * lu(1552) + lu(1565) = lu(1565) - lu(1254) * lu(1552) + lu(1566) = lu(1566) - lu(1255) * lu(1552) + lu(1567) = lu(1567) - lu(1256) * lu(1552) + lu(1599) = lu(1599) - lu(1242) * lu(1598) + lu(1600) = lu(1600) - lu(1243) * lu(1598) + lu(1601) = lu(1601) - lu(1244) * lu(1598) + lu(1602) = lu(1602) - lu(1245) * lu(1598) + lu(1603) = lu(1603) - lu(1246) * lu(1598) + lu(1604) = lu(1604) - lu(1247) * lu(1598) + lu(1605) = lu(1605) - lu(1248) * lu(1598) + lu(1606) = lu(1606) - lu(1249) * lu(1598) + lu(1607) = lu(1607) - lu(1250) * lu(1598) + lu(1608) = lu(1608) - lu(1251) * lu(1598) + lu(1609) = lu(1609) - lu(1252) * lu(1598) + lu(1610) = lu(1610) - lu(1253) * lu(1598) + lu(1611) = lu(1611) - lu(1254) * lu(1598) + lu(1612) = lu(1612) - lu(1255) * lu(1598) + lu(1613) = lu(1613) - lu(1256) * lu(1598) + lu(1640) = lu(1640) - lu(1242) * lu(1639) + lu(1641) = lu(1641) - lu(1243) * lu(1639) + lu(1642) = lu(1642) - lu(1244) * lu(1639) + lu(1643) = lu(1643) - lu(1245) * lu(1639) + lu(1644) = lu(1644) - lu(1246) * lu(1639) + lu(1645) = lu(1645) - lu(1247) * lu(1639) + lu(1646) = lu(1646) - lu(1248) * lu(1639) + lu(1647) = lu(1647) - lu(1249) * lu(1639) + lu(1648) = lu(1648) - lu(1250) * lu(1639) + lu(1649) = lu(1649) - lu(1251) * lu(1639) + lu(1650) = lu(1650) - lu(1252) * lu(1639) + lu(1651) = lu(1651) - lu(1253) * lu(1639) + lu(1652) = lu(1652) - lu(1254) * lu(1639) + lu(1653) = lu(1653) - lu(1255) * lu(1639) + lu(1654) = lu(1654) - lu(1256) * lu(1639) + lu(1683) = lu(1683) - lu(1242) * lu(1682) + lu(1684) = lu(1684) - lu(1243) * lu(1682) + lu(1685) = lu(1685) - lu(1244) * lu(1682) + lu(1686) = lu(1686) - lu(1245) * lu(1682) + lu(1687) = lu(1687) - lu(1246) * lu(1682) + lu(1688) = lu(1688) - lu(1247) * lu(1682) + lu(1689) = lu(1689) - lu(1248) * lu(1682) + lu(1690) = lu(1690) - lu(1249) * lu(1682) + lu(1691) = lu(1691) - lu(1250) * lu(1682) + lu(1692) = lu(1692) - lu(1251) * lu(1682) + lu(1693) = lu(1693) - lu(1252) * lu(1682) + lu(1694) = lu(1694) - lu(1253) * lu(1682) + lu(1695) = lu(1695) - lu(1254) * lu(1682) + lu(1696) = lu(1696) - lu(1255) * lu(1682) + lu(1697) = lu(1697) - lu(1256) * lu(1682) + lu(1723) = lu(1723) - lu(1242) * lu(1722) + lu(1724) = lu(1724) - lu(1243) * lu(1722) + lu(1725) = lu(1725) - lu(1244) * lu(1722) + lu(1726) = lu(1726) - lu(1245) * lu(1722) + lu(1727) = lu(1727) - lu(1246) * lu(1722) + lu(1728) = lu(1728) - lu(1247) * lu(1722) + lu(1729) = lu(1729) - lu(1248) * lu(1722) + lu(1730) = lu(1730) - lu(1249) * lu(1722) + lu(1731) = lu(1731) - lu(1250) * lu(1722) + lu(1732) = lu(1732) - lu(1251) * lu(1722) + lu(1733) = lu(1733) - lu(1252) * lu(1722) + lu(1734) = lu(1734) - lu(1253) * lu(1722) + lu(1735) = lu(1735) - lu(1254) * lu(1722) + lu(1736) = lu(1736) - lu(1255) * lu(1722) + lu(1737) = lu(1737) - lu(1256) * lu(1722) + lu(1769) = lu(1769) - lu(1242) * lu(1768) + lu(1770) = lu(1770) - lu(1243) * lu(1768) + lu(1771) = lu(1771) - lu(1244) * lu(1768) + lu(1772) = lu(1772) - lu(1245) * lu(1768) + lu(1773) = lu(1773) - lu(1246) * lu(1768) + lu(1774) = lu(1774) - lu(1247) * lu(1768) + lu(1775) = lu(1775) - lu(1248) * lu(1768) + lu(1776) = lu(1776) - lu(1249) * lu(1768) + lu(1777) = lu(1777) - lu(1250) * lu(1768) + lu(1778) = lu(1778) - lu(1251) * lu(1768) + lu(1779) = lu(1779) - lu(1252) * lu(1768) + lu(1780) = lu(1780) - lu(1253) * lu(1768) + lu(1781) = lu(1781) - lu(1254) * lu(1768) + lu(1782) = lu(1782) - lu(1255) * lu(1768) + lu(1783) = lu(1783) - lu(1256) * lu(1768) + lu(1805) = lu(1805) - lu(1242) * lu(1804) + lu(1806) = lu(1806) - lu(1243) * lu(1804) + lu(1807) = lu(1807) - lu(1244) * lu(1804) + lu(1808) = lu(1808) - lu(1245) * lu(1804) + lu(1809) = lu(1809) - lu(1246) * lu(1804) + lu(1810) = lu(1810) - lu(1247) * lu(1804) + lu(1811) = lu(1811) - lu(1248) * lu(1804) + lu(1812) = lu(1812) - lu(1249) * lu(1804) + lu(1813) = lu(1813) - lu(1250) * lu(1804) + lu(1814) = lu(1814) - lu(1251) * lu(1804) + lu(1815) = lu(1815) - lu(1252) * lu(1804) + lu(1816) = lu(1816) - lu(1253) * lu(1804) + lu(1817) = lu(1817) - lu(1254) * lu(1804) + lu(1818) = lu(1818) - lu(1255) * lu(1804) + lu(1819) = lu(1819) - lu(1256) * lu(1804) + lu(1847) = lu(1847) - lu(1242) * lu(1846) + lu(1848) = lu(1848) - lu(1243) * lu(1846) + lu(1849) = lu(1849) - lu(1244) * lu(1846) + lu(1850) = lu(1850) - lu(1245) * lu(1846) + lu(1851) = lu(1851) - lu(1246) * lu(1846) + lu(1852) = lu(1852) - lu(1247) * lu(1846) + lu(1853) = lu(1853) - lu(1248) * lu(1846) + lu(1854) = lu(1854) - lu(1249) * lu(1846) + lu(1855) = lu(1855) - lu(1250) * lu(1846) + lu(1856) = lu(1856) - lu(1251) * lu(1846) + lu(1857) = lu(1857) - lu(1252) * lu(1846) + lu(1858) = lu(1858) - lu(1253) * lu(1846) + lu(1859) = lu(1859) - lu(1254) * lu(1846) + lu(1860) = lu(1860) - lu(1255) * lu(1846) + lu(1861) = lu(1861) - lu(1256) * lu(1846) + lu(1893) = lu(1893) - lu(1242) * lu(1892) + lu(1894) = lu(1894) - lu(1243) * lu(1892) + lu(1895) = lu(1895) - lu(1244) * lu(1892) + lu(1896) = lu(1896) - lu(1245) * lu(1892) + lu(1897) = lu(1897) - lu(1246) * lu(1892) + lu(1898) = lu(1898) - lu(1247) * lu(1892) + lu(1899) = lu(1899) - lu(1248) * lu(1892) + lu(1900) = lu(1900) - lu(1249) * lu(1892) + lu(1901) = lu(1901) - lu(1250) * lu(1892) + lu(1902) = lu(1902) - lu(1251) * lu(1892) + lu(1903) = lu(1903) - lu(1252) * lu(1892) + lu(1904) = lu(1904) - lu(1253) * lu(1892) + lu(1905) = lu(1905) - lu(1254) * lu(1892) + lu(1906) = lu(1906) - lu(1255) * lu(1892) + lu(1907) = lu(1907) - lu(1256) * lu(1892) + lu(1278) = 1._r8 / lu(1278) + lu(1279) = lu(1279) * lu(1278) + lu(1280) = lu(1280) * lu(1278) + lu(1281) = lu(1281) * lu(1278) + lu(1282) = lu(1282) * lu(1278) + lu(1283) = lu(1283) * lu(1278) + lu(1284) = lu(1284) * lu(1278) + lu(1285) = lu(1285) * lu(1278) + lu(1286) = lu(1286) * lu(1278) + lu(1287) = lu(1287) * lu(1278) + lu(1288) = lu(1288) * lu(1278) + lu(1289) = lu(1289) * lu(1278) + lu(1290) = lu(1290) * lu(1278) + lu(1291) = lu(1291) * lu(1278) + lu(1292) = lu(1292) * lu(1278) + lu(1338) = lu(1338) - lu(1279) * lu(1337) + lu(1339) = lu(1339) - lu(1280) * lu(1337) + lu(1340) = lu(1340) - lu(1281) * lu(1337) + lu(1341) = lu(1341) - lu(1282) * lu(1337) + lu(1342) = lu(1342) - lu(1283) * lu(1337) + lu(1343) = lu(1343) - lu(1284) * lu(1337) + lu(1344) = lu(1344) - lu(1285) * lu(1337) + lu(1345) = lu(1345) - lu(1286) * lu(1337) + lu(1346) = lu(1346) - lu(1287) * lu(1337) + lu(1347) = lu(1347) - lu(1288) * lu(1337) + lu(1348) = lu(1348) - lu(1289) * lu(1337) + lu(1349) = lu(1349) - lu(1290) * lu(1337) + lu(1350) = lu(1350) - lu(1291) * lu(1337) + lu(1351) = lu(1351) - lu(1292) * lu(1337) + lu(1381) = lu(1381) - lu(1279) * lu(1380) + lu(1382) = lu(1382) - lu(1280) * lu(1380) + lu(1383) = lu(1383) - lu(1281) * lu(1380) + lu(1384) = lu(1384) - lu(1282) * lu(1380) + lu(1385) = lu(1385) - lu(1283) * lu(1380) + lu(1386) = lu(1386) - lu(1284) * lu(1380) + lu(1387) = lu(1387) - lu(1285) * lu(1380) + lu(1388) = lu(1388) - lu(1286) * lu(1380) + lu(1389) = lu(1389) - lu(1287) * lu(1380) + lu(1390) = lu(1390) - lu(1288) * lu(1380) + lu(1391) = lu(1391) - lu(1289) * lu(1380) + lu(1392) = lu(1392) - lu(1290) * lu(1380) + lu(1393) = lu(1393) - lu(1291) * lu(1380) + lu(1394) = lu(1394) - lu(1292) * lu(1380) + lu(1422) = lu(1422) - lu(1279) * lu(1421) + lu(1423) = lu(1423) - lu(1280) * lu(1421) + lu(1424) = lu(1424) - lu(1281) * lu(1421) + lu(1425) = lu(1425) - lu(1282) * lu(1421) + lu(1426) = lu(1426) - lu(1283) * lu(1421) + lu(1427) = lu(1427) - lu(1284) * lu(1421) + lu(1428) = lu(1428) - lu(1285) * lu(1421) + lu(1429) = lu(1429) - lu(1286) * lu(1421) + lu(1430) = lu(1430) - lu(1287) * lu(1421) + lu(1431) = lu(1431) - lu(1288) * lu(1421) + lu(1432) = lu(1432) - lu(1289) * lu(1421) + lu(1433) = lu(1433) - lu(1290) * lu(1421) + lu(1434) = lu(1434) - lu(1291) * lu(1421) + lu(1435) = lu(1435) - lu(1292) * lu(1421) + lu(1465) = lu(1465) - lu(1279) * lu(1464) + lu(1466) = lu(1466) - lu(1280) * lu(1464) + lu(1467) = lu(1467) - lu(1281) * lu(1464) + lu(1468) = lu(1468) - lu(1282) * lu(1464) + lu(1469) = lu(1469) - lu(1283) * lu(1464) + lu(1470) = lu(1470) - lu(1284) * lu(1464) + lu(1471) = lu(1471) - lu(1285) * lu(1464) + lu(1472) = lu(1472) - lu(1286) * lu(1464) + lu(1473) = lu(1473) - lu(1287) * lu(1464) + lu(1474) = lu(1474) - lu(1288) * lu(1464) + lu(1475) = lu(1475) - lu(1289) * lu(1464) + lu(1476) = lu(1476) - lu(1290) * lu(1464) + lu(1477) = lu(1477) - lu(1291) * lu(1464) + lu(1478) = lu(1478) - lu(1292) * lu(1464) + lu(1508) = lu(1508) - lu(1279) * lu(1507) + lu(1509) = lu(1509) - lu(1280) * lu(1507) + lu(1510) = lu(1510) - lu(1281) * lu(1507) + lu(1511) = lu(1511) - lu(1282) * lu(1507) + lu(1512) = lu(1512) - lu(1283) * lu(1507) + lu(1513) = lu(1513) - lu(1284) * lu(1507) + lu(1514) = lu(1514) - lu(1285) * lu(1507) + lu(1515) = lu(1515) - lu(1286) * lu(1507) + lu(1516) = lu(1516) - lu(1287) * lu(1507) + lu(1517) = lu(1517) - lu(1288) * lu(1507) + lu(1518) = lu(1518) - lu(1289) * lu(1507) + lu(1519) = lu(1519) - lu(1290) * lu(1507) + lu(1520) = lu(1520) - lu(1291) * lu(1507) + lu(1521) = lu(1521) - lu(1292) * lu(1507) + lu(1554) = lu(1554) - lu(1279) * lu(1553) + lu(1555) = lu(1555) - lu(1280) * lu(1553) + lu(1556) = lu(1556) - lu(1281) * lu(1553) + lu(1557) = lu(1557) - lu(1282) * lu(1553) + lu(1558) = lu(1558) - lu(1283) * lu(1553) + lu(1559) = lu(1559) - lu(1284) * lu(1553) + lu(1560) = lu(1560) - lu(1285) * lu(1553) + lu(1561) = lu(1561) - lu(1286) * lu(1553) + lu(1562) = lu(1562) - lu(1287) * lu(1553) + lu(1563) = lu(1563) - lu(1288) * lu(1553) + lu(1564) = lu(1564) - lu(1289) * lu(1553) + lu(1565) = lu(1565) - lu(1290) * lu(1553) + lu(1566) = lu(1566) - lu(1291) * lu(1553) + lu(1567) = lu(1567) - lu(1292) * lu(1553) + lu(1600) = lu(1600) - lu(1279) * lu(1599) + lu(1601) = lu(1601) - lu(1280) * lu(1599) + lu(1602) = lu(1602) - lu(1281) * lu(1599) + lu(1603) = lu(1603) - lu(1282) * lu(1599) + lu(1604) = lu(1604) - lu(1283) * lu(1599) + lu(1605) = lu(1605) - lu(1284) * lu(1599) + lu(1606) = lu(1606) - lu(1285) * lu(1599) + lu(1607) = lu(1607) - lu(1286) * lu(1599) + lu(1608) = lu(1608) - lu(1287) * lu(1599) + lu(1609) = lu(1609) - lu(1288) * lu(1599) + lu(1610) = lu(1610) - lu(1289) * lu(1599) + lu(1611) = lu(1611) - lu(1290) * lu(1599) + lu(1612) = lu(1612) - lu(1291) * lu(1599) + lu(1613) = lu(1613) - lu(1292) * lu(1599) + lu(1641) = lu(1641) - lu(1279) * lu(1640) + lu(1642) = lu(1642) - lu(1280) * lu(1640) + lu(1643) = lu(1643) - lu(1281) * lu(1640) + lu(1644) = lu(1644) - lu(1282) * lu(1640) + lu(1645) = lu(1645) - lu(1283) * lu(1640) + lu(1646) = lu(1646) - lu(1284) * lu(1640) + lu(1647) = lu(1647) - lu(1285) * lu(1640) + lu(1648) = lu(1648) - lu(1286) * lu(1640) + lu(1649) = lu(1649) - lu(1287) * lu(1640) + lu(1650) = lu(1650) - lu(1288) * lu(1640) + lu(1651) = lu(1651) - lu(1289) * lu(1640) + lu(1652) = lu(1652) - lu(1290) * lu(1640) + lu(1653) = lu(1653) - lu(1291) * lu(1640) + lu(1654) = lu(1654) - lu(1292) * lu(1640) + lu(1684) = lu(1684) - lu(1279) * lu(1683) + lu(1685) = lu(1685) - lu(1280) * lu(1683) + lu(1686) = lu(1686) - lu(1281) * lu(1683) + lu(1687) = lu(1687) - lu(1282) * lu(1683) + lu(1688) = lu(1688) - lu(1283) * lu(1683) + lu(1689) = lu(1689) - lu(1284) * lu(1683) + lu(1690) = lu(1690) - lu(1285) * lu(1683) + lu(1691) = lu(1691) - lu(1286) * lu(1683) + lu(1692) = lu(1692) - lu(1287) * lu(1683) + lu(1693) = lu(1693) - lu(1288) * lu(1683) + lu(1694) = lu(1694) - lu(1289) * lu(1683) + lu(1695) = lu(1695) - lu(1290) * lu(1683) + lu(1696) = lu(1696) - lu(1291) * lu(1683) + lu(1697) = lu(1697) - lu(1292) * lu(1683) + lu(1724) = lu(1724) - lu(1279) * lu(1723) + lu(1725) = lu(1725) - lu(1280) * lu(1723) + lu(1726) = lu(1726) - lu(1281) * lu(1723) + lu(1727) = lu(1727) - lu(1282) * lu(1723) + lu(1728) = lu(1728) - lu(1283) * lu(1723) + lu(1729) = lu(1729) - lu(1284) * lu(1723) + lu(1730) = lu(1730) - lu(1285) * lu(1723) + lu(1731) = lu(1731) - lu(1286) * lu(1723) + lu(1732) = lu(1732) - lu(1287) * lu(1723) + lu(1733) = lu(1733) - lu(1288) * lu(1723) + lu(1734) = lu(1734) - lu(1289) * lu(1723) + lu(1735) = lu(1735) - lu(1290) * lu(1723) + lu(1736) = lu(1736) - lu(1291) * lu(1723) + lu(1737) = lu(1737) - lu(1292) * lu(1723) + lu(1770) = lu(1770) - lu(1279) * lu(1769) + lu(1771) = lu(1771) - lu(1280) * lu(1769) + lu(1772) = lu(1772) - lu(1281) * lu(1769) + lu(1773) = lu(1773) - lu(1282) * lu(1769) + lu(1774) = lu(1774) - lu(1283) * lu(1769) + lu(1775) = lu(1775) - lu(1284) * lu(1769) + lu(1776) = lu(1776) - lu(1285) * lu(1769) + lu(1777) = lu(1777) - lu(1286) * lu(1769) + lu(1778) = lu(1778) - lu(1287) * lu(1769) + lu(1779) = lu(1779) - lu(1288) * lu(1769) + lu(1780) = lu(1780) - lu(1289) * lu(1769) + lu(1781) = lu(1781) - lu(1290) * lu(1769) + lu(1782) = lu(1782) - lu(1291) * lu(1769) + lu(1783) = lu(1783) - lu(1292) * lu(1769) + lu(1806) = lu(1806) - lu(1279) * lu(1805) + lu(1807) = lu(1807) - lu(1280) * lu(1805) + lu(1808) = lu(1808) - lu(1281) * lu(1805) + lu(1809) = lu(1809) - lu(1282) * lu(1805) + lu(1810) = lu(1810) - lu(1283) * lu(1805) + lu(1811) = lu(1811) - lu(1284) * lu(1805) + lu(1812) = lu(1812) - lu(1285) * lu(1805) + lu(1813) = lu(1813) - lu(1286) * lu(1805) + lu(1814) = lu(1814) - lu(1287) * lu(1805) + lu(1815) = lu(1815) - lu(1288) * lu(1805) + lu(1816) = lu(1816) - lu(1289) * lu(1805) + lu(1817) = lu(1817) - lu(1290) * lu(1805) + lu(1818) = lu(1818) - lu(1291) * lu(1805) + lu(1819) = lu(1819) - lu(1292) * lu(1805) + lu(1848) = lu(1848) - lu(1279) * lu(1847) + lu(1849) = lu(1849) - lu(1280) * lu(1847) + lu(1850) = lu(1850) - lu(1281) * lu(1847) + lu(1851) = lu(1851) - lu(1282) * lu(1847) + lu(1852) = lu(1852) - lu(1283) * lu(1847) + lu(1853) = lu(1853) - lu(1284) * lu(1847) + lu(1854) = lu(1854) - lu(1285) * lu(1847) + lu(1855) = lu(1855) - lu(1286) * lu(1847) + lu(1856) = lu(1856) - lu(1287) * lu(1847) + lu(1857) = lu(1857) - lu(1288) * lu(1847) + lu(1858) = lu(1858) - lu(1289) * lu(1847) + lu(1859) = lu(1859) - lu(1290) * lu(1847) + lu(1860) = lu(1860) - lu(1291) * lu(1847) + lu(1861) = lu(1861) - lu(1292) * lu(1847) + lu(1894) = lu(1894) - lu(1279) * lu(1893) + lu(1895) = lu(1895) - lu(1280) * lu(1893) + lu(1896) = lu(1896) - lu(1281) * lu(1893) + lu(1897) = lu(1897) - lu(1282) * lu(1893) + lu(1898) = lu(1898) - lu(1283) * lu(1893) + lu(1899) = lu(1899) - lu(1284) * lu(1893) + lu(1900) = lu(1900) - lu(1285) * lu(1893) + lu(1901) = lu(1901) - lu(1286) * lu(1893) + lu(1902) = lu(1902) - lu(1287) * lu(1893) + lu(1903) = lu(1903) - lu(1288) * lu(1893) + lu(1904) = lu(1904) - lu(1289) * lu(1893) + lu(1905) = lu(1905) - lu(1290) * lu(1893) + lu(1906) = lu(1906) - lu(1291) * lu(1893) + lu(1907) = lu(1907) - lu(1292) * lu(1893) + lu(1338) = 1._r8 / lu(1338) + lu(1339) = lu(1339) * lu(1338) + lu(1340) = lu(1340) * lu(1338) + lu(1341) = lu(1341) * lu(1338) + lu(1342) = lu(1342) * lu(1338) + lu(1343) = lu(1343) * lu(1338) + lu(1344) = lu(1344) * lu(1338) + lu(1345) = lu(1345) * lu(1338) + lu(1346) = lu(1346) * lu(1338) + lu(1347) = lu(1347) * lu(1338) + lu(1348) = lu(1348) * lu(1338) + lu(1349) = lu(1349) * lu(1338) + lu(1350) = lu(1350) * lu(1338) + lu(1351) = lu(1351) * lu(1338) + lu(1382) = lu(1382) - lu(1339) * lu(1381) + lu(1383) = lu(1383) - lu(1340) * lu(1381) + lu(1384) = lu(1384) - lu(1341) * lu(1381) + lu(1385) = lu(1385) - lu(1342) * lu(1381) + lu(1386) = lu(1386) - lu(1343) * lu(1381) + lu(1387) = lu(1387) - lu(1344) * lu(1381) + lu(1388) = lu(1388) - lu(1345) * lu(1381) + lu(1389) = lu(1389) - lu(1346) * lu(1381) + lu(1390) = lu(1390) - lu(1347) * lu(1381) + lu(1391) = lu(1391) - lu(1348) * lu(1381) + lu(1392) = lu(1392) - lu(1349) * lu(1381) + lu(1393) = lu(1393) - lu(1350) * lu(1381) + lu(1394) = lu(1394) - lu(1351) * lu(1381) + lu(1423) = lu(1423) - lu(1339) * lu(1422) + lu(1424) = lu(1424) - lu(1340) * lu(1422) + lu(1425) = lu(1425) - lu(1341) * lu(1422) + lu(1426) = lu(1426) - lu(1342) * lu(1422) + lu(1427) = lu(1427) - lu(1343) * lu(1422) + lu(1428) = lu(1428) - lu(1344) * lu(1422) + lu(1429) = lu(1429) - lu(1345) * lu(1422) + lu(1430) = lu(1430) - lu(1346) * lu(1422) + lu(1431) = lu(1431) - lu(1347) * lu(1422) + lu(1432) = lu(1432) - lu(1348) * lu(1422) + lu(1433) = lu(1433) - lu(1349) * lu(1422) + lu(1434) = lu(1434) - lu(1350) * lu(1422) + lu(1435) = lu(1435) - lu(1351) * lu(1422) + lu(1466) = lu(1466) - lu(1339) * lu(1465) + lu(1467) = lu(1467) - lu(1340) * lu(1465) + lu(1468) = lu(1468) - lu(1341) * lu(1465) + lu(1469) = lu(1469) - lu(1342) * lu(1465) + lu(1470) = lu(1470) - lu(1343) * lu(1465) + lu(1471) = lu(1471) - lu(1344) * lu(1465) + lu(1472) = lu(1472) - lu(1345) * lu(1465) + lu(1473) = lu(1473) - lu(1346) * lu(1465) + lu(1474) = lu(1474) - lu(1347) * lu(1465) + lu(1475) = lu(1475) - lu(1348) * lu(1465) + lu(1476) = lu(1476) - lu(1349) * lu(1465) + lu(1477) = lu(1477) - lu(1350) * lu(1465) + lu(1478) = lu(1478) - lu(1351) * lu(1465) + lu(1509) = lu(1509) - lu(1339) * lu(1508) + lu(1510) = lu(1510) - lu(1340) * lu(1508) + lu(1511) = lu(1511) - lu(1341) * lu(1508) + lu(1512) = lu(1512) - lu(1342) * lu(1508) + lu(1513) = lu(1513) - lu(1343) * lu(1508) + lu(1514) = lu(1514) - lu(1344) * lu(1508) + lu(1515) = lu(1515) - lu(1345) * lu(1508) + lu(1516) = lu(1516) - lu(1346) * lu(1508) + lu(1517) = lu(1517) - lu(1347) * lu(1508) + lu(1518) = lu(1518) - lu(1348) * lu(1508) + lu(1519) = lu(1519) - lu(1349) * lu(1508) + lu(1520) = lu(1520) - lu(1350) * lu(1508) + lu(1521) = lu(1521) - lu(1351) * lu(1508) + lu(1555) = lu(1555) - lu(1339) * lu(1554) + lu(1556) = lu(1556) - lu(1340) * lu(1554) + lu(1557) = lu(1557) - lu(1341) * lu(1554) + lu(1558) = lu(1558) - lu(1342) * lu(1554) + lu(1559) = lu(1559) - lu(1343) * lu(1554) + lu(1560) = lu(1560) - lu(1344) * lu(1554) + lu(1561) = lu(1561) - lu(1345) * lu(1554) + lu(1562) = lu(1562) - lu(1346) * lu(1554) + lu(1563) = lu(1563) - lu(1347) * lu(1554) + lu(1564) = lu(1564) - lu(1348) * lu(1554) + lu(1565) = lu(1565) - lu(1349) * lu(1554) + lu(1566) = lu(1566) - lu(1350) * lu(1554) + lu(1567) = lu(1567) - lu(1351) * lu(1554) + lu(1601) = lu(1601) - lu(1339) * lu(1600) + lu(1602) = lu(1602) - lu(1340) * lu(1600) + lu(1603) = lu(1603) - lu(1341) * lu(1600) + lu(1604) = lu(1604) - lu(1342) * lu(1600) + lu(1605) = lu(1605) - lu(1343) * lu(1600) + lu(1606) = lu(1606) - lu(1344) * lu(1600) + lu(1607) = lu(1607) - lu(1345) * lu(1600) + lu(1608) = lu(1608) - lu(1346) * lu(1600) + lu(1609) = lu(1609) - lu(1347) * lu(1600) + lu(1610) = lu(1610) - lu(1348) * lu(1600) + lu(1611) = lu(1611) - lu(1349) * lu(1600) + lu(1612) = lu(1612) - lu(1350) * lu(1600) + lu(1613) = lu(1613) - lu(1351) * lu(1600) + lu(1642) = lu(1642) - lu(1339) * lu(1641) + lu(1643) = lu(1643) - lu(1340) * lu(1641) + lu(1644) = lu(1644) - lu(1341) * lu(1641) + lu(1645) = lu(1645) - lu(1342) * lu(1641) + lu(1646) = lu(1646) - lu(1343) * lu(1641) + lu(1647) = lu(1647) - lu(1344) * lu(1641) + lu(1648) = lu(1648) - lu(1345) * lu(1641) + lu(1649) = lu(1649) - lu(1346) * lu(1641) + lu(1650) = lu(1650) - lu(1347) * lu(1641) + lu(1651) = lu(1651) - lu(1348) * lu(1641) + lu(1652) = lu(1652) - lu(1349) * lu(1641) + lu(1653) = lu(1653) - lu(1350) * lu(1641) + lu(1654) = lu(1654) - lu(1351) * lu(1641) + lu(1685) = lu(1685) - lu(1339) * lu(1684) + lu(1686) = lu(1686) - lu(1340) * lu(1684) + lu(1687) = lu(1687) - lu(1341) * lu(1684) + lu(1688) = lu(1688) - lu(1342) * lu(1684) + lu(1689) = lu(1689) - lu(1343) * lu(1684) + lu(1690) = lu(1690) - lu(1344) * lu(1684) + lu(1691) = lu(1691) - lu(1345) * lu(1684) + lu(1692) = lu(1692) - lu(1346) * lu(1684) + lu(1693) = lu(1693) - lu(1347) * lu(1684) + lu(1694) = lu(1694) - lu(1348) * lu(1684) + lu(1695) = lu(1695) - lu(1349) * lu(1684) + lu(1696) = lu(1696) - lu(1350) * lu(1684) + lu(1697) = lu(1697) - lu(1351) * lu(1684) + lu(1725) = lu(1725) - lu(1339) * lu(1724) + lu(1726) = lu(1726) - lu(1340) * lu(1724) + lu(1727) = lu(1727) - lu(1341) * lu(1724) + lu(1728) = lu(1728) - lu(1342) * lu(1724) + lu(1729) = lu(1729) - lu(1343) * lu(1724) + lu(1730) = lu(1730) - lu(1344) * lu(1724) + lu(1731) = lu(1731) - lu(1345) * lu(1724) + lu(1732) = lu(1732) - lu(1346) * lu(1724) + lu(1733) = lu(1733) - lu(1347) * lu(1724) + lu(1734) = lu(1734) - lu(1348) * lu(1724) + lu(1735) = lu(1735) - lu(1349) * lu(1724) + lu(1736) = lu(1736) - lu(1350) * lu(1724) + lu(1737) = lu(1737) - lu(1351) * lu(1724) + lu(1771) = lu(1771) - lu(1339) * lu(1770) + lu(1772) = lu(1772) - lu(1340) * lu(1770) + lu(1773) = lu(1773) - lu(1341) * lu(1770) + lu(1774) = lu(1774) - lu(1342) * lu(1770) + lu(1775) = lu(1775) - lu(1343) * lu(1770) + lu(1776) = lu(1776) - lu(1344) * lu(1770) + lu(1777) = lu(1777) - lu(1345) * lu(1770) + lu(1778) = lu(1778) - lu(1346) * lu(1770) + lu(1779) = lu(1779) - lu(1347) * lu(1770) + lu(1780) = lu(1780) - lu(1348) * lu(1770) + lu(1781) = lu(1781) - lu(1349) * lu(1770) + lu(1782) = lu(1782) - lu(1350) * lu(1770) + lu(1783) = lu(1783) - lu(1351) * lu(1770) + lu(1807) = lu(1807) - lu(1339) * lu(1806) + lu(1808) = lu(1808) - lu(1340) * lu(1806) + lu(1809) = lu(1809) - lu(1341) * lu(1806) + lu(1810) = lu(1810) - lu(1342) * lu(1806) + lu(1811) = lu(1811) - lu(1343) * lu(1806) + lu(1812) = lu(1812) - lu(1344) * lu(1806) + lu(1813) = lu(1813) - lu(1345) * lu(1806) + lu(1814) = lu(1814) - lu(1346) * lu(1806) + lu(1815) = lu(1815) - lu(1347) * lu(1806) + lu(1816) = lu(1816) - lu(1348) * lu(1806) + lu(1817) = lu(1817) - lu(1349) * lu(1806) + lu(1818) = lu(1818) - lu(1350) * lu(1806) + lu(1819) = lu(1819) - lu(1351) * lu(1806) + lu(1849) = lu(1849) - lu(1339) * lu(1848) + lu(1850) = lu(1850) - lu(1340) * lu(1848) + lu(1851) = lu(1851) - lu(1341) * lu(1848) + lu(1852) = lu(1852) - lu(1342) * lu(1848) + lu(1853) = lu(1853) - lu(1343) * lu(1848) + lu(1854) = lu(1854) - lu(1344) * lu(1848) + lu(1855) = lu(1855) - lu(1345) * lu(1848) + lu(1856) = lu(1856) - lu(1346) * lu(1848) + lu(1857) = lu(1857) - lu(1347) * lu(1848) + lu(1858) = lu(1858) - lu(1348) * lu(1848) + lu(1859) = lu(1859) - lu(1349) * lu(1848) + lu(1860) = lu(1860) - lu(1350) * lu(1848) + lu(1861) = lu(1861) - lu(1351) * lu(1848) + lu(1895) = lu(1895) - lu(1339) * lu(1894) + lu(1896) = lu(1896) - lu(1340) * lu(1894) + lu(1897) = lu(1897) - lu(1341) * lu(1894) + lu(1898) = lu(1898) - lu(1342) * lu(1894) + lu(1899) = lu(1899) - lu(1343) * lu(1894) + lu(1900) = lu(1900) - lu(1344) * lu(1894) + lu(1901) = lu(1901) - lu(1345) * lu(1894) + lu(1902) = lu(1902) - lu(1346) * lu(1894) + lu(1903) = lu(1903) - lu(1347) * lu(1894) + lu(1904) = lu(1904) - lu(1348) * lu(1894) + lu(1905) = lu(1905) - lu(1349) * lu(1894) + lu(1906) = lu(1906) - lu(1350) * lu(1894) + lu(1907) = lu(1907) - lu(1351) * lu(1894) + end subroutine lu_fac21 + subroutine lu_fac22( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1382) = 1._r8 / lu(1382) + lu(1383) = lu(1383) * lu(1382) + lu(1384) = lu(1384) * lu(1382) + lu(1385) = lu(1385) * lu(1382) + lu(1386) = lu(1386) * lu(1382) + lu(1387) = lu(1387) * lu(1382) + lu(1388) = lu(1388) * lu(1382) + lu(1389) = lu(1389) * lu(1382) + lu(1390) = lu(1390) * lu(1382) + lu(1391) = lu(1391) * lu(1382) + lu(1392) = lu(1392) * lu(1382) + lu(1393) = lu(1393) * lu(1382) + lu(1394) = lu(1394) * lu(1382) + lu(1424) = lu(1424) - lu(1383) * lu(1423) + lu(1425) = lu(1425) - lu(1384) * lu(1423) + lu(1426) = lu(1426) - lu(1385) * lu(1423) + lu(1427) = lu(1427) - lu(1386) * lu(1423) + lu(1428) = lu(1428) - lu(1387) * lu(1423) + lu(1429) = lu(1429) - lu(1388) * lu(1423) + lu(1430) = lu(1430) - lu(1389) * lu(1423) + lu(1431) = lu(1431) - lu(1390) * lu(1423) + lu(1432) = lu(1432) - lu(1391) * lu(1423) + lu(1433) = lu(1433) - lu(1392) * lu(1423) + lu(1434) = lu(1434) - lu(1393) * lu(1423) + lu(1435) = lu(1435) - lu(1394) * lu(1423) + lu(1467) = lu(1467) - lu(1383) * lu(1466) + lu(1468) = lu(1468) - lu(1384) * lu(1466) + lu(1469) = lu(1469) - lu(1385) * lu(1466) + lu(1470) = lu(1470) - lu(1386) * lu(1466) + lu(1471) = lu(1471) - lu(1387) * lu(1466) + lu(1472) = lu(1472) - lu(1388) * lu(1466) + lu(1473) = lu(1473) - lu(1389) * lu(1466) + lu(1474) = lu(1474) - lu(1390) * lu(1466) + lu(1475) = lu(1475) - lu(1391) * lu(1466) + lu(1476) = lu(1476) - lu(1392) * lu(1466) + lu(1477) = lu(1477) - lu(1393) * lu(1466) + lu(1478) = lu(1478) - lu(1394) * lu(1466) + lu(1510) = lu(1510) - lu(1383) * lu(1509) + lu(1511) = lu(1511) - lu(1384) * lu(1509) + lu(1512) = lu(1512) - lu(1385) * lu(1509) + lu(1513) = lu(1513) - lu(1386) * lu(1509) + lu(1514) = lu(1514) - lu(1387) * lu(1509) + lu(1515) = lu(1515) - lu(1388) * lu(1509) + lu(1516) = lu(1516) - lu(1389) * lu(1509) + lu(1517) = lu(1517) - lu(1390) * lu(1509) + lu(1518) = lu(1518) - lu(1391) * lu(1509) + lu(1519) = lu(1519) - lu(1392) * lu(1509) + lu(1520) = lu(1520) - lu(1393) * lu(1509) + lu(1521) = lu(1521) - lu(1394) * lu(1509) + lu(1556) = lu(1556) - lu(1383) * lu(1555) + lu(1557) = lu(1557) - lu(1384) * lu(1555) + lu(1558) = lu(1558) - lu(1385) * lu(1555) + lu(1559) = lu(1559) - lu(1386) * lu(1555) + lu(1560) = lu(1560) - lu(1387) * lu(1555) + lu(1561) = lu(1561) - lu(1388) * lu(1555) + lu(1562) = lu(1562) - lu(1389) * lu(1555) + lu(1563) = lu(1563) - lu(1390) * lu(1555) + lu(1564) = lu(1564) - lu(1391) * lu(1555) + lu(1565) = lu(1565) - lu(1392) * lu(1555) + lu(1566) = lu(1566) - lu(1393) * lu(1555) + lu(1567) = lu(1567) - lu(1394) * lu(1555) + lu(1602) = lu(1602) - lu(1383) * lu(1601) + lu(1603) = lu(1603) - lu(1384) * lu(1601) + lu(1604) = lu(1604) - lu(1385) * lu(1601) + lu(1605) = lu(1605) - lu(1386) * lu(1601) + lu(1606) = lu(1606) - lu(1387) * lu(1601) + lu(1607) = lu(1607) - lu(1388) * lu(1601) + lu(1608) = lu(1608) - lu(1389) * lu(1601) + lu(1609) = lu(1609) - lu(1390) * lu(1601) + lu(1610) = lu(1610) - lu(1391) * lu(1601) + lu(1611) = lu(1611) - lu(1392) * lu(1601) + lu(1612) = lu(1612) - lu(1393) * lu(1601) + lu(1613) = lu(1613) - lu(1394) * lu(1601) + lu(1643) = lu(1643) - lu(1383) * lu(1642) + lu(1644) = lu(1644) - lu(1384) * lu(1642) + lu(1645) = lu(1645) - lu(1385) * lu(1642) + lu(1646) = lu(1646) - lu(1386) * lu(1642) + lu(1647) = lu(1647) - lu(1387) * lu(1642) + lu(1648) = lu(1648) - lu(1388) * lu(1642) + lu(1649) = lu(1649) - lu(1389) * lu(1642) + lu(1650) = lu(1650) - lu(1390) * lu(1642) + lu(1651) = lu(1651) - lu(1391) * lu(1642) + lu(1652) = lu(1652) - lu(1392) * lu(1642) + lu(1653) = lu(1653) - lu(1393) * lu(1642) + lu(1654) = lu(1654) - lu(1394) * lu(1642) + lu(1686) = lu(1686) - lu(1383) * lu(1685) + lu(1687) = lu(1687) - lu(1384) * lu(1685) + lu(1688) = lu(1688) - lu(1385) * lu(1685) + lu(1689) = lu(1689) - lu(1386) * lu(1685) + lu(1690) = lu(1690) - lu(1387) * lu(1685) + lu(1691) = lu(1691) - lu(1388) * lu(1685) + lu(1692) = lu(1692) - lu(1389) * lu(1685) + lu(1693) = lu(1693) - lu(1390) * lu(1685) + lu(1694) = lu(1694) - lu(1391) * lu(1685) + lu(1695) = lu(1695) - lu(1392) * lu(1685) + lu(1696) = lu(1696) - lu(1393) * lu(1685) + lu(1697) = lu(1697) - lu(1394) * lu(1685) + lu(1726) = lu(1726) - lu(1383) * lu(1725) + lu(1727) = lu(1727) - lu(1384) * lu(1725) + lu(1728) = lu(1728) - lu(1385) * lu(1725) + lu(1729) = lu(1729) - lu(1386) * lu(1725) + lu(1730) = lu(1730) - lu(1387) * lu(1725) + lu(1731) = lu(1731) - lu(1388) * lu(1725) + lu(1732) = lu(1732) - lu(1389) * lu(1725) + lu(1733) = lu(1733) - lu(1390) * lu(1725) + lu(1734) = lu(1734) - lu(1391) * lu(1725) + lu(1735) = lu(1735) - lu(1392) * lu(1725) + lu(1736) = lu(1736) - lu(1393) * lu(1725) + lu(1737) = lu(1737) - lu(1394) * lu(1725) + lu(1772) = lu(1772) - lu(1383) * lu(1771) + lu(1773) = lu(1773) - lu(1384) * lu(1771) + lu(1774) = lu(1774) - lu(1385) * lu(1771) + lu(1775) = lu(1775) - lu(1386) * lu(1771) + lu(1776) = lu(1776) - lu(1387) * lu(1771) + lu(1777) = lu(1777) - lu(1388) * lu(1771) + lu(1778) = lu(1778) - lu(1389) * lu(1771) + lu(1779) = lu(1779) - lu(1390) * lu(1771) + lu(1780) = lu(1780) - lu(1391) * lu(1771) + lu(1781) = lu(1781) - lu(1392) * lu(1771) + lu(1782) = lu(1782) - lu(1393) * lu(1771) + lu(1783) = lu(1783) - lu(1394) * lu(1771) + lu(1808) = lu(1808) - lu(1383) * lu(1807) + lu(1809) = lu(1809) - lu(1384) * lu(1807) + lu(1810) = lu(1810) - lu(1385) * lu(1807) + lu(1811) = lu(1811) - lu(1386) * lu(1807) + lu(1812) = lu(1812) - lu(1387) * lu(1807) + lu(1813) = lu(1813) - lu(1388) * lu(1807) + lu(1814) = lu(1814) - lu(1389) * lu(1807) + lu(1815) = lu(1815) - lu(1390) * lu(1807) + lu(1816) = lu(1816) - lu(1391) * lu(1807) + lu(1817) = lu(1817) - lu(1392) * lu(1807) + lu(1818) = lu(1818) - lu(1393) * lu(1807) + lu(1819) = lu(1819) - lu(1394) * lu(1807) + lu(1850) = lu(1850) - lu(1383) * lu(1849) + lu(1851) = lu(1851) - lu(1384) * lu(1849) + lu(1852) = lu(1852) - lu(1385) * lu(1849) + lu(1853) = lu(1853) - lu(1386) * lu(1849) + lu(1854) = lu(1854) - lu(1387) * lu(1849) + lu(1855) = lu(1855) - lu(1388) * lu(1849) + lu(1856) = lu(1856) - lu(1389) * lu(1849) + lu(1857) = lu(1857) - lu(1390) * lu(1849) + lu(1858) = lu(1858) - lu(1391) * lu(1849) + lu(1859) = lu(1859) - lu(1392) * lu(1849) + lu(1860) = lu(1860) - lu(1393) * lu(1849) + lu(1861) = lu(1861) - lu(1394) * lu(1849) + lu(1896) = lu(1896) - lu(1383) * lu(1895) + lu(1897) = lu(1897) - lu(1384) * lu(1895) + lu(1898) = lu(1898) - lu(1385) * lu(1895) + lu(1899) = lu(1899) - lu(1386) * lu(1895) + lu(1900) = lu(1900) - lu(1387) * lu(1895) + lu(1901) = lu(1901) - lu(1388) * lu(1895) + lu(1902) = lu(1902) - lu(1389) * lu(1895) + lu(1903) = lu(1903) - lu(1390) * lu(1895) + lu(1904) = lu(1904) - lu(1391) * lu(1895) + lu(1905) = lu(1905) - lu(1392) * lu(1895) + lu(1906) = lu(1906) - lu(1393) * lu(1895) + lu(1907) = lu(1907) - lu(1394) * lu(1895) + lu(1424) = 1._r8 / lu(1424) + lu(1425) = lu(1425) * lu(1424) + lu(1426) = lu(1426) * lu(1424) + lu(1427) = lu(1427) * lu(1424) + lu(1428) = lu(1428) * lu(1424) + lu(1429) = lu(1429) * lu(1424) + lu(1430) = lu(1430) * lu(1424) + lu(1431) = lu(1431) * lu(1424) + lu(1432) = lu(1432) * lu(1424) + lu(1433) = lu(1433) * lu(1424) + lu(1434) = lu(1434) * lu(1424) + lu(1435) = lu(1435) * lu(1424) + lu(1468) = lu(1468) - lu(1425) * lu(1467) + lu(1469) = lu(1469) - lu(1426) * lu(1467) + lu(1470) = lu(1470) - lu(1427) * lu(1467) + lu(1471) = lu(1471) - lu(1428) * lu(1467) + lu(1472) = lu(1472) - lu(1429) * lu(1467) + lu(1473) = lu(1473) - lu(1430) * lu(1467) + lu(1474) = lu(1474) - lu(1431) * lu(1467) + lu(1475) = lu(1475) - lu(1432) * lu(1467) + lu(1476) = lu(1476) - lu(1433) * lu(1467) + lu(1477) = lu(1477) - lu(1434) * lu(1467) + lu(1478) = lu(1478) - lu(1435) * lu(1467) + lu(1511) = lu(1511) - lu(1425) * lu(1510) + lu(1512) = lu(1512) - lu(1426) * lu(1510) + lu(1513) = lu(1513) - lu(1427) * lu(1510) + lu(1514) = lu(1514) - lu(1428) * lu(1510) + lu(1515) = lu(1515) - lu(1429) * lu(1510) + lu(1516) = lu(1516) - lu(1430) * lu(1510) + lu(1517) = lu(1517) - lu(1431) * lu(1510) + lu(1518) = lu(1518) - lu(1432) * lu(1510) + lu(1519) = lu(1519) - lu(1433) * lu(1510) + lu(1520) = lu(1520) - lu(1434) * lu(1510) + lu(1521) = lu(1521) - lu(1435) * lu(1510) + lu(1557) = lu(1557) - lu(1425) * lu(1556) + lu(1558) = lu(1558) - lu(1426) * lu(1556) + lu(1559) = lu(1559) - lu(1427) * lu(1556) + lu(1560) = lu(1560) - lu(1428) * lu(1556) + lu(1561) = lu(1561) - lu(1429) * lu(1556) + lu(1562) = lu(1562) - lu(1430) * lu(1556) + lu(1563) = lu(1563) - lu(1431) * lu(1556) + lu(1564) = lu(1564) - lu(1432) * lu(1556) + lu(1565) = lu(1565) - lu(1433) * lu(1556) + lu(1566) = lu(1566) - lu(1434) * lu(1556) + lu(1567) = lu(1567) - lu(1435) * lu(1556) + lu(1603) = lu(1603) - lu(1425) * lu(1602) + lu(1604) = lu(1604) - lu(1426) * lu(1602) + lu(1605) = lu(1605) - lu(1427) * lu(1602) + lu(1606) = lu(1606) - lu(1428) * lu(1602) + lu(1607) = lu(1607) - lu(1429) * lu(1602) + lu(1608) = lu(1608) - lu(1430) * lu(1602) + lu(1609) = lu(1609) - lu(1431) * lu(1602) + lu(1610) = lu(1610) - lu(1432) * lu(1602) + lu(1611) = lu(1611) - lu(1433) * lu(1602) + lu(1612) = lu(1612) - lu(1434) * lu(1602) + lu(1613) = lu(1613) - lu(1435) * lu(1602) + lu(1644) = lu(1644) - lu(1425) * lu(1643) + lu(1645) = lu(1645) - lu(1426) * lu(1643) + lu(1646) = lu(1646) - lu(1427) * lu(1643) + lu(1647) = lu(1647) - lu(1428) * lu(1643) + lu(1648) = lu(1648) - lu(1429) * lu(1643) + lu(1649) = lu(1649) - lu(1430) * lu(1643) + lu(1650) = lu(1650) - lu(1431) * lu(1643) + lu(1651) = lu(1651) - lu(1432) * lu(1643) + lu(1652) = lu(1652) - lu(1433) * lu(1643) + lu(1653) = lu(1653) - lu(1434) * lu(1643) + lu(1654) = lu(1654) - lu(1435) * lu(1643) + lu(1687) = lu(1687) - lu(1425) * lu(1686) + lu(1688) = lu(1688) - lu(1426) * lu(1686) + lu(1689) = lu(1689) - lu(1427) * lu(1686) + lu(1690) = lu(1690) - lu(1428) * lu(1686) + lu(1691) = lu(1691) - lu(1429) * lu(1686) + lu(1692) = lu(1692) - lu(1430) * lu(1686) + lu(1693) = lu(1693) - lu(1431) * lu(1686) + lu(1694) = lu(1694) - lu(1432) * lu(1686) + lu(1695) = lu(1695) - lu(1433) * lu(1686) + lu(1696) = lu(1696) - lu(1434) * lu(1686) + lu(1697) = lu(1697) - lu(1435) * lu(1686) + lu(1727) = lu(1727) - lu(1425) * lu(1726) + lu(1728) = lu(1728) - lu(1426) * lu(1726) + lu(1729) = lu(1729) - lu(1427) * lu(1726) + lu(1730) = lu(1730) - lu(1428) * lu(1726) + lu(1731) = lu(1731) - lu(1429) * lu(1726) + lu(1732) = lu(1732) - lu(1430) * lu(1726) + lu(1733) = lu(1733) - lu(1431) * lu(1726) + lu(1734) = lu(1734) - lu(1432) * lu(1726) + lu(1735) = lu(1735) - lu(1433) * lu(1726) + lu(1736) = lu(1736) - lu(1434) * lu(1726) + lu(1737) = lu(1737) - lu(1435) * lu(1726) + lu(1773) = lu(1773) - lu(1425) * lu(1772) + lu(1774) = lu(1774) - lu(1426) * lu(1772) + lu(1775) = lu(1775) - lu(1427) * lu(1772) + lu(1776) = lu(1776) - lu(1428) * lu(1772) + lu(1777) = lu(1777) - lu(1429) * lu(1772) + lu(1778) = lu(1778) - lu(1430) * lu(1772) + lu(1779) = lu(1779) - lu(1431) * lu(1772) + lu(1780) = lu(1780) - lu(1432) * lu(1772) + lu(1781) = lu(1781) - lu(1433) * lu(1772) + lu(1782) = lu(1782) - lu(1434) * lu(1772) + lu(1783) = lu(1783) - lu(1435) * lu(1772) + lu(1809) = lu(1809) - lu(1425) * lu(1808) + lu(1810) = lu(1810) - lu(1426) * lu(1808) + lu(1811) = lu(1811) - lu(1427) * lu(1808) + lu(1812) = lu(1812) - lu(1428) * lu(1808) + lu(1813) = lu(1813) - lu(1429) * lu(1808) + lu(1814) = lu(1814) - lu(1430) * lu(1808) + lu(1815) = lu(1815) - lu(1431) * lu(1808) + lu(1816) = lu(1816) - lu(1432) * lu(1808) + lu(1817) = lu(1817) - lu(1433) * lu(1808) + lu(1818) = lu(1818) - lu(1434) * lu(1808) + lu(1819) = lu(1819) - lu(1435) * lu(1808) + lu(1851) = lu(1851) - lu(1425) * lu(1850) + lu(1852) = lu(1852) - lu(1426) * lu(1850) + lu(1853) = lu(1853) - lu(1427) * lu(1850) + lu(1854) = lu(1854) - lu(1428) * lu(1850) + lu(1855) = lu(1855) - lu(1429) * lu(1850) + lu(1856) = lu(1856) - lu(1430) * lu(1850) + lu(1857) = lu(1857) - lu(1431) * lu(1850) + lu(1858) = lu(1858) - lu(1432) * lu(1850) + lu(1859) = lu(1859) - lu(1433) * lu(1850) + lu(1860) = lu(1860) - lu(1434) * lu(1850) + lu(1861) = lu(1861) - lu(1435) * lu(1850) + lu(1897) = lu(1897) - lu(1425) * lu(1896) + lu(1898) = lu(1898) - lu(1426) * lu(1896) + lu(1899) = lu(1899) - lu(1427) * lu(1896) + lu(1900) = lu(1900) - lu(1428) * lu(1896) + lu(1901) = lu(1901) - lu(1429) * lu(1896) + lu(1902) = lu(1902) - lu(1430) * lu(1896) + lu(1903) = lu(1903) - lu(1431) * lu(1896) + lu(1904) = lu(1904) - lu(1432) * lu(1896) + lu(1905) = lu(1905) - lu(1433) * lu(1896) + lu(1906) = lu(1906) - lu(1434) * lu(1896) + lu(1907) = lu(1907) - lu(1435) * lu(1896) + lu(1468) = 1._r8 / lu(1468) + lu(1469) = lu(1469) * lu(1468) + lu(1470) = lu(1470) * lu(1468) + lu(1471) = lu(1471) * lu(1468) + lu(1472) = lu(1472) * lu(1468) + lu(1473) = lu(1473) * lu(1468) + lu(1474) = lu(1474) * lu(1468) + lu(1475) = lu(1475) * lu(1468) + lu(1476) = lu(1476) * lu(1468) + lu(1477) = lu(1477) * lu(1468) + lu(1478) = lu(1478) * lu(1468) + lu(1512) = lu(1512) - lu(1469) * lu(1511) + lu(1513) = lu(1513) - lu(1470) * lu(1511) + lu(1514) = lu(1514) - lu(1471) * lu(1511) + lu(1515) = lu(1515) - lu(1472) * lu(1511) + lu(1516) = lu(1516) - lu(1473) * lu(1511) + lu(1517) = lu(1517) - lu(1474) * lu(1511) + lu(1518) = lu(1518) - lu(1475) * lu(1511) + lu(1519) = lu(1519) - lu(1476) * lu(1511) + lu(1520) = lu(1520) - lu(1477) * lu(1511) + lu(1521) = lu(1521) - lu(1478) * lu(1511) + lu(1558) = lu(1558) - lu(1469) * lu(1557) + lu(1559) = lu(1559) - lu(1470) * lu(1557) + lu(1560) = lu(1560) - lu(1471) * lu(1557) + lu(1561) = lu(1561) - lu(1472) * lu(1557) + lu(1562) = lu(1562) - lu(1473) * lu(1557) + lu(1563) = lu(1563) - lu(1474) * lu(1557) + lu(1564) = lu(1564) - lu(1475) * lu(1557) + lu(1565) = lu(1565) - lu(1476) * lu(1557) + lu(1566) = lu(1566) - lu(1477) * lu(1557) + lu(1567) = lu(1567) - lu(1478) * lu(1557) + lu(1604) = lu(1604) - lu(1469) * lu(1603) + lu(1605) = lu(1605) - lu(1470) * lu(1603) + lu(1606) = lu(1606) - lu(1471) * lu(1603) + lu(1607) = lu(1607) - lu(1472) * lu(1603) + lu(1608) = lu(1608) - lu(1473) * lu(1603) + lu(1609) = lu(1609) - lu(1474) * lu(1603) + lu(1610) = lu(1610) - lu(1475) * lu(1603) + lu(1611) = lu(1611) - lu(1476) * lu(1603) + lu(1612) = lu(1612) - lu(1477) * lu(1603) + lu(1613) = lu(1613) - lu(1478) * lu(1603) + lu(1645) = lu(1645) - lu(1469) * lu(1644) + lu(1646) = lu(1646) - lu(1470) * lu(1644) + lu(1647) = lu(1647) - lu(1471) * lu(1644) + lu(1648) = lu(1648) - lu(1472) * lu(1644) + lu(1649) = lu(1649) - lu(1473) * lu(1644) + lu(1650) = lu(1650) - lu(1474) * lu(1644) + lu(1651) = lu(1651) - lu(1475) * lu(1644) + lu(1652) = lu(1652) - lu(1476) * lu(1644) + lu(1653) = lu(1653) - lu(1477) * lu(1644) + lu(1654) = lu(1654) - lu(1478) * lu(1644) + lu(1688) = lu(1688) - lu(1469) * lu(1687) + lu(1689) = lu(1689) - lu(1470) * lu(1687) + lu(1690) = lu(1690) - lu(1471) * lu(1687) + lu(1691) = lu(1691) - lu(1472) * lu(1687) + lu(1692) = lu(1692) - lu(1473) * lu(1687) + lu(1693) = lu(1693) - lu(1474) * lu(1687) + lu(1694) = lu(1694) - lu(1475) * lu(1687) + lu(1695) = lu(1695) - lu(1476) * lu(1687) + lu(1696) = lu(1696) - lu(1477) * lu(1687) + lu(1697) = lu(1697) - lu(1478) * lu(1687) + lu(1728) = lu(1728) - lu(1469) * lu(1727) + lu(1729) = lu(1729) - lu(1470) * lu(1727) + lu(1730) = lu(1730) - lu(1471) * lu(1727) + lu(1731) = lu(1731) - lu(1472) * lu(1727) + lu(1732) = lu(1732) - lu(1473) * lu(1727) + lu(1733) = lu(1733) - lu(1474) * lu(1727) + lu(1734) = lu(1734) - lu(1475) * lu(1727) + lu(1735) = lu(1735) - lu(1476) * lu(1727) + lu(1736) = lu(1736) - lu(1477) * lu(1727) + lu(1737) = lu(1737) - lu(1478) * lu(1727) + lu(1774) = lu(1774) - lu(1469) * lu(1773) + lu(1775) = lu(1775) - lu(1470) * lu(1773) + lu(1776) = lu(1776) - lu(1471) * lu(1773) + lu(1777) = lu(1777) - lu(1472) * lu(1773) + lu(1778) = lu(1778) - lu(1473) * lu(1773) + lu(1779) = lu(1779) - lu(1474) * lu(1773) + lu(1780) = lu(1780) - lu(1475) * lu(1773) + lu(1781) = lu(1781) - lu(1476) * lu(1773) + lu(1782) = lu(1782) - lu(1477) * lu(1773) + lu(1783) = lu(1783) - lu(1478) * lu(1773) + lu(1810) = lu(1810) - lu(1469) * lu(1809) + lu(1811) = lu(1811) - lu(1470) * lu(1809) + lu(1812) = lu(1812) - lu(1471) * lu(1809) + lu(1813) = lu(1813) - lu(1472) * lu(1809) + lu(1814) = lu(1814) - lu(1473) * lu(1809) + lu(1815) = lu(1815) - lu(1474) * lu(1809) + lu(1816) = lu(1816) - lu(1475) * lu(1809) + lu(1817) = lu(1817) - lu(1476) * lu(1809) + lu(1818) = lu(1818) - lu(1477) * lu(1809) + lu(1819) = lu(1819) - lu(1478) * lu(1809) + lu(1852) = lu(1852) - lu(1469) * lu(1851) + lu(1853) = lu(1853) - lu(1470) * lu(1851) + lu(1854) = lu(1854) - lu(1471) * lu(1851) + lu(1855) = lu(1855) - lu(1472) * lu(1851) + lu(1856) = lu(1856) - lu(1473) * lu(1851) + lu(1857) = lu(1857) - lu(1474) * lu(1851) + lu(1858) = lu(1858) - lu(1475) * lu(1851) + lu(1859) = lu(1859) - lu(1476) * lu(1851) + lu(1860) = lu(1860) - lu(1477) * lu(1851) + lu(1861) = lu(1861) - lu(1478) * lu(1851) + lu(1898) = lu(1898) - lu(1469) * lu(1897) + lu(1899) = lu(1899) - lu(1470) * lu(1897) + lu(1900) = lu(1900) - lu(1471) * lu(1897) + lu(1901) = lu(1901) - lu(1472) * lu(1897) + lu(1902) = lu(1902) - lu(1473) * lu(1897) + lu(1903) = lu(1903) - lu(1474) * lu(1897) + lu(1904) = lu(1904) - lu(1475) * lu(1897) + lu(1905) = lu(1905) - lu(1476) * lu(1897) + lu(1906) = lu(1906) - lu(1477) * lu(1897) + lu(1907) = lu(1907) - lu(1478) * lu(1897) + lu(1512) = 1._r8 / lu(1512) + lu(1513) = lu(1513) * lu(1512) + lu(1514) = lu(1514) * lu(1512) + lu(1515) = lu(1515) * lu(1512) + lu(1516) = lu(1516) * lu(1512) + lu(1517) = lu(1517) * lu(1512) + lu(1518) = lu(1518) * lu(1512) + lu(1519) = lu(1519) * lu(1512) + lu(1520) = lu(1520) * lu(1512) + lu(1521) = lu(1521) * lu(1512) + lu(1559) = lu(1559) - lu(1513) * lu(1558) + lu(1560) = lu(1560) - lu(1514) * lu(1558) + lu(1561) = lu(1561) - lu(1515) * lu(1558) + lu(1562) = lu(1562) - lu(1516) * lu(1558) + lu(1563) = lu(1563) - lu(1517) * lu(1558) + lu(1564) = lu(1564) - lu(1518) * lu(1558) + lu(1565) = lu(1565) - lu(1519) * lu(1558) + lu(1566) = lu(1566) - lu(1520) * lu(1558) + lu(1567) = lu(1567) - lu(1521) * lu(1558) + lu(1605) = lu(1605) - lu(1513) * lu(1604) + lu(1606) = lu(1606) - lu(1514) * lu(1604) + lu(1607) = lu(1607) - lu(1515) * lu(1604) + lu(1608) = lu(1608) - lu(1516) * lu(1604) + lu(1609) = lu(1609) - lu(1517) * lu(1604) + lu(1610) = lu(1610) - lu(1518) * lu(1604) + lu(1611) = lu(1611) - lu(1519) * lu(1604) + lu(1612) = lu(1612) - lu(1520) * lu(1604) + lu(1613) = lu(1613) - lu(1521) * lu(1604) + lu(1646) = lu(1646) - lu(1513) * lu(1645) + lu(1647) = lu(1647) - lu(1514) * lu(1645) + lu(1648) = lu(1648) - lu(1515) * lu(1645) + lu(1649) = lu(1649) - lu(1516) * lu(1645) + lu(1650) = lu(1650) - lu(1517) * lu(1645) + lu(1651) = lu(1651) - lu(1518) * lu(1645) + lu(1652) = lu(1652) - lu(1519) * lu(1645) + lu(1653) = lu(1653) - lu(1520) * lu(1645) + lu(1654) = lu(1654) - lu(1521) * lu(1645) + lu(1689) = lu(1689) - lu(1513) * lu(1688) + lu(1690) = lu(1690) - lu(1514) * lu(1688) + lu(1691) = lu(1691) - lu(1515) * lu(1688) + lu(1692) = lu(1692) - lu(1516) * lu(1688) + lu(1693) = lu(1693) - lu(1517) * lu(1688) + lu(1694) = lu(1694) - lu(1518) * lu(1688) + lu(1695) = lu(1695) - lu(1519) * lu(1688) + lu(1696) = lu(1696) - lu(1520) * lu(1688) + lu(1697) = lu(1697) - lu(1521) * lu(1688) + lu(1729) = lu(1729) - lu(1513) * lu(1728) + lu(1730) = lu(1730) - lu(1514) * lu(1728) + lu(1731) = lu(1731) - lu(1515) * lu(1728) + lu(1732) = lu(1732) - lu(1516) * lu(1728) + lu(1733) = lu(1733) - lu(1517) * lu(1728) + lu(1734) = lu(1734) - lu(1518) * lu(1728) + lu(1735) = lu(1735) - lu(1519) * lu(1728) + lu(1736) = lu(1736) - lu(1520) * lu(1728) + lu(1737) = lu(1737) - lu(1521) * lu(1728) + lu(1775) = lu(1775) - lu(1513) * lu(1774) + lu(1776) = lu(1776) - lu(1514) * lu(1774) + lu(1777) = lu(1777) - lu(1515) * lu(1774) + lu(1778) = lu(1778) - lu(1516) * lu(1774) + lu(1779) = lu(1779) - lu(1517) * lu(1774) + lu(1780) = lu(1780) - lu(1518) * lu(1774) + lu(1781) = lu(1781) - lu(1519) * lu(1774) + lu(1782) = lu(1782) - lu(1520) * lu(1774) + lu(1783) = lu(1783) - lu(1521) * lu(1774) + lu(1811) = lu(1811) - lu(1513) * lu(1810) + lu(1812) = lu(1812) - lu(1514) * lu(1810) + lu(1813) = lu(1813) - lu(1515) * lu(1810) + lu(1814) = lu(1814) - lu(1516) * lu(1810) + lu(1815) = lu(1815) - lu(1517) * lu(1810) + lu(1816) = lu(1816) - lu(1518) * lu(1810) + lu(1817) = lu(1817) - lu(1519) * lu(1810) + lu(1818) = lu(1818) - lu(1520) * lu(1810) + lu(1819) = lu(1819) - lu(1521) * lu(1810) + lu(1853) = lu(1853) - lu(1513) * lu(1852) + lu(1854) = lu(1854) - lu(1514) * lu(1852) + lu(1855) = lu(1855) - lu(1515) * lu(1852) + lu(1856) = lu(1856) - lu(1516) * lu(1852) + lu(1857) = lu(1857) - lu(1517) * lu(1852) + lu(1858) = lu(1858) - lu(1518) * lu(1852) + lu(1859) = lu(1859) - lu(1519) * lu(1852) + lu(1860) = lu(1860) - lu(1520) * lu(1852) + lu(1861) = lu(1861) - lu(1521) * lu(1852) + lu(1899) = lu(1899) - lu(1513) * lu(1898) + lu(1900) = lu(1900) - lu(1514) * lu(1898) + lu(1901) = lu(1901) - lu(1515) * lu(1898) + lu(1902) = lu(1902) - lu(1516) * lu(1898) + lu(1903) = lu(1903) - lu(1517) * lu(1898) + lu(1904) = lu(1904) - lu(1518) * lu(1898) + lu(1905) = lu(1905) - lu(1519) * lu(1898) + lu(1906) = lu(1906) - lu(1520) * lu(1898) + lu(1907) = lu(1907) - lu(1521) * lu(1898) + lu(1559) = 1._r8 / lu(1559) + lu(1560) = lu(1560) * lu(1559) + lu(1561) = lu(1561) * lu(1559) + lu(1562) = lu(1562) * lu(1559) + lu(1563) = lu(1563) * lu(1559) + lu(1564) = lu(1564) * lu(1559) + lu(1565) = lu(1565) * lu(1559) + lu(1566) = lu(1566) * lu(1559) + lu(1567) = lu(1567) * lu(1559) + lu(1606) = lu(1606) - lu(1560) * lu(1605) + lu(1607) = lu(1607) - lu(1561) * lu(1605) + lu(1608) = lu(1608) - lu(1562) * lu(1605) + lu(1609) = lu(1609) - lu(1563) * lu(1605) + lu(1610) = lu(1610) - lu(1564) * lu(1605) + lu(1611) = lu(1611) - lu(1565) * lu(1605) + lu(1612) = lu(1612) - lu(1566) * lu(1605) + lu(1613) = lu(1613) - lu(1567) * lu(1605) + lu(1647) = lu(1647) - lu(1560) * lu(1646) + lu(1648) = lu(1648) - lu(1561) * lu(1646) + lu(1649) = lu(1649) - lu(1562) * lu(1646) + lu(1650) = lu(1650) - lu(1563) * lu(1646) + lu(1651) = lu(1651) - lu(1564) * lu(1646) + lu(1652) = lu(1652) - lu(1565) * lu(1646) + lu(1653) = lu(1653) - lu(1566) * lu(1646) + lu(1654) = lu(1654) - lu(1567) * lu(1646) + lu(1690) = lu(1690) - lu(1560) * lu(1689) + lu(1691) = lu(1691) - lu(1561) * lu(1689) + lu(1692) = lu(1692) - lu(1562) * lu(1689) + lu(1693) = lu(1693) - lu(1563) * lu(1689) + lu(1694) = lu(1694) - lu(1564) * lu(1689) + lu(1695) = lu(1695) - lu(1565) * lu(1689) + lu(1696) = lu(1696) - lu(1566) * lu(1689) + lu(1697) = lu(1697) - lu(1567) * lu(1689) + lu(1730) = lu(1730) - lu(1560) * lu(1729) + lu(1731) = lu(1731) - lu(1561) * lu(1729) + lu(1732) = lu(1732) - lu(1562) * lu(1729) + lu(1733) = lu(1733) - lu(1563) * lu(1729) + lu(1734) = lu(1734) - lu(1564) * lu(1729) + lu(1735) = lu(1735) - lu(1565) * lu(1729) + lu(1736) = lu(1736) - lu(1566) * lu(1729) + lu(1737) = lu(1737) - lu(1567) * lu(1729) + lu(1776) = lu(1776) - lu(1560) * lu(1775) + lu(1777) = lu(1777) - lu(1561) * lu(1775) + lu(1778) = lu(1778) - lu(1562) * lu(1775) + lu(1779) = lu(1779) - lu(1563) * lu(1775) + lu(1780) = lu(1780) - lu(1564) * lu(1775) + lu(1781) = lu(1781) - lu(1565) * lu(1775) + lu(1782) = lu(1782) - lu(1566) * lu(1775) + lu(1783) = lu(1783) - lu(1567) * lu(1775) + lu(1812) = lu(1812) - lu(1560) * lu(1811) + lu(1813) = lu(1813) - lu(1561) * lu(1811) + lu(1814) = lu(1814) - lu(1562) * lu(1811) + lu(1815) = lu(1815) - lu(1563) * lu(1811) + lu(1816) = lu(1816) - lu(1564) * lu(1811) + lu(1817) = lu(1817) - lu(1565) * lu(1811) + lu(1818) = lu(1818) - lu(1566) * lu(1811) + lu(1819) = lu(1819) - lu(1567) * lu(1811) + lu(1854) = lu(1854) - lu(1560) * lu(1853) + lu(1855) = lu(1855) - lu(1561) * lu(1853) + lu(1856) = lu(1856) - lu(1562) * lu(1853) + lu(1857) = lu(1857) - lu(1563) * lu(1853) + lu(1858) = lu(1858) - lu(1564) * lu(1853) + lu(1859) = lu(1859) - lu(1565) * lu(1853) + lu(1860) = lu(1860) - lu(1566) * lu(1853) + lu(1861) = lu(1861) - lu(1567) * lu(1853) + lu(1900) = lu(1900) - lu(1560) * lu(1899) + lu(1901) = lu(1901) - lu(1561) * lu(1899) + lu(1902) = lu(1902) - lu(1562) * lu(1899) + lu(1903) = lu(1903) - lu(1563) * lu(1899) + lu(1904) = lu(1904) - lu(1564) * lu(1899) + lu(1905) = lu(1905) - lu(1565) * lu(1899) + lu(1906) = lu(1906) - lu(1566) * lu(1899) + lu(1907) = lu(1907) - lu(1567) * lu(1899) + end subroutine lu_fac22 + subroutine lu_fac23( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1606) = 1._r8 / lu(1606) + lu(1607) = lu(1607) * lu(1606) + lu(1608) = lu(1608) * lu(1606) + lu(1609) = lu(1609) * lu(1606) + lu(1610) = lu(1610) * lu(1606) + lu(1611) = lu(1611) * lu(1606) + lu(1612) = lu(1612) * lu(1606) + lu(1613) = lu(1613) * lu(1606) + lu(1648) = lu(1648) - lu(1607) * lu(1647) + lu(1649) = lu(1649) - lu(1608) * lu(1647) + lu(1650) = lu(1650) - lu(1609) * lu(1647) + lu(1651) = lu(1651) - lu(1610) * lu(1647) + lu(1652) = lu(1652) - lu(1611) * lu(1647) + lu(1653) = lu(1653) - lu(1612) * lu(1647) + lu(1654) = lu(1654) - lu(1613) * lu(1647) + lu(1691) = lu(1691) - lu(1607) * lu(1690) + lu(1692) = lu(1692) - lu(1608) * lu(1690) + lu(1693) = lu(1693) - lu(1609) * lu(1690) + lu(1694) = lu(1694) - lu(1610) * lu(1690) + lu(1695) = lu(1695) - lu(1611) * lu(1690) + lu(1696) = lu(1696) - lu(1612) * lu(1690) + lu(1697) = lu(1697) - lu(1613) * lu(1690) + lu(1731) = lu(1731) - lu(1607) * lu(1730) + lu(1732) = lu(1732) - lu(1608) * lu(1730) + lu(1733) = lu(1733) - lu(1609) * lu(1730) + lu(1734) = lu(1734) - lu(1610) * lu(1730) + lu(1735) = lu(1735) - lu(1611) * lu(1730) + lu(1736) = lu(1736) - lu(1612) * lu(1730) + lu(1737) = lu(1737) - lu(1613) * lu(1730) + lu(1777) = lu(1777) - lu(1607) * lu(1776) + lu(1778) = lu(1778) - lu(1608) * lu(1776) + lu(1779) = lu(1779) - lu(1609) * lu(1776) + lu(1780) = lu(1780) - lu(1610) * lu(1776) + lu(1781) = lu(1781) - lu(1611) * lu(1776) + lu(1782) = lu(1782) - lu(1612) * lu(1776) + lu(1783) = lu(1783) - lu(1613) * lu(1776) + lu(1813) = lu(1813) - lu(1607) * lu(1812) + lu(1814) = lu(1814) - lu(1608) * lu(1812) + lu(1815) = lu(1815) - lu(1609) * lu(1812) + lu(1816) = lu(1816) - lu(1610) * lu(1812) + lu(1817) = lu(1817) - lu(1611) * lu(1812) + lu(1818) = lu(1818) - lu(1612) * lu(1812) + lu(1819) = lu(1819) - lu(1613) * lu(1812) + lu(1855) = lu(1855) - lu(1607) * lu(1854) + lu(1856) = lu(1856) - lu(1608) * lu(1854) + lu(1857) = lu(1857) - lu(1609) * lu(1854) + lu(1858) = lu(1858) - lu(1610) * lu(1854) + lu(1859) = lu(1859) - lu(1611) * lu(1854) + lu(1860) = lu(1860) - lu(1612) * lu(1854) + lu(1861) = lu(1861) - lu(1613) * lu(1854) + lu(1901) = lu(1901) - lu(1607) * lu(1900) + lu(1902) = lu(1902) - lu(1608) * lu(1900) + lu(1903) = lu(1903) - lu(1609) * lu(1900) + lu(1904) = lu(1904) - lu(1610) * lu(1900) + lu(1905) = lu(1905) - lu(1611) * lu(1900) + lu(1906) = lu(1906) - lu(1612) * lu(1900) + lu(1907) = lu(1907) - lu(1613) * lu(1900) + lu(1648) = 1._r8 / lu(1648) + lu(1649) = lu(1649) * lu(1648) + lu(1650) = lu(1650) * lu(1648) + lu(1651) = lu(1651) * lu(1648) + lu(1652) = lu(1652) * lu(1648) + lu(1653) = lu(1653) * lu(1648) + lu(1654) = lu(1654) * lu(1648) + lu(1692) = lu(1692) - lu(1649) * lu(1691) + lu(1693) = lu(1693) - lu(1650) * lu(1691) + lu(1694) = lu(1694) - lu(1651) * lu(1691) + lu(1695) = lu(1695) - lu(1652) * lu(1691) + lu(1696) = lu(1696) - lu(1653) * lu(1691) + lu(1697) = lu(1697) - lu(1654) * lu(1691) + lu(1732) = lu(1732) - lu(1649) * lu(1731) + lu(1733) = lu(1733) - lu(1650) * lu(1731) + lu(1734) = lu(1734) - lu(1651) * lu(1731) + lu(1735) = lu(1735) - lu(1652) * lu(1731) + lu(1736) = lu(1736) - lu(1653) * lu(1731) + lu(1737) = lu(1737) - lu(1654) * lu(1731) + lu(1778) = lu(1778) - lu(1649) * lu(1777) + lu(1779) = lu(1779) - lu(1650) * lu(1777) + lu(1780) = lu(1780) - lu(1651) * lu(1777) + lu(1781) = lu(1781) - lu(1652) * lu(1777) + lu(1782) = lu(1782) - lu(1653) * lu(1777) + lu(1783) = lu(1783) - lu(1654) * lu(1777) + lu(1814) = lu(1814) - lu(1649) * lu(1813) + lu(1815) = lu(1815) - lu(1650) * lu(1813) + lu(1816) = lu(1816) - lu(1651) * lu(1813) + lu(1817) = lu(1817) - lu(1652) * lu(1813) + lu(1818) = lu(1818) - lu(1653) * lu(1813) + lu(1819) = lu(1819) - lu(1654) * lu(1813) + lu(1856) = lu(1856) - lu(1649) * lu(1855) + lu(1857) = lu(1857) - lu(1650) * lu(1855) + lu(1858) = lu(1858) - lu(1651) * lu(1855) + lu(1859) = lu(1859) - lu(1652) * lu(1855) + lu(1860) = lu(1860) - lu(1653) * lu(1855) + lu(1861) = lu(1861) - lu(1654) * lu(1855) + lu(1902) = lu(1902) - lu(1649) * lu(1901) + lu(1903) = lu(1903) - lu(1650) * lu(1901) + lu(1904) = lu(1904) - lu(1651) * lu(1901) + lu(1905) = lu(1905) - lu(1652) * lu(1901) + lu(1906) = lu(1906) - lu(1653) * lu(1901) + lu(1907) = lu(1907) - lu(1654) * lu(1901) + lu(1692) = 1._r8 / lu(1692) + lu(1693) = lu(1693) * lu(1692) + lu(1694) = lu(1694) * lu(1692) + lu(1695) = lu(1695) * lu(1692) + lu(1696) = lu(1696) * lu(1692) + lu(1697) = lu(1697) * lu(1692) + lu(1733) = lu(1733) - lu(1693) * lu(1732) + lu(1734) = lu(1734) - lu(1694) * lu(1732) + lu(1735) = lu(1735) - lu(1695) * lu(1732) + lu(1736) = lu(1736) - lu(1696) * lu(1732) + lu(1737) = lu(1737) - lu(1697) * lu(1732) + lu(1779) = lu(1779) - lu(1693) * lu(1778) + lu(1780) = lu(1780) - lu(1694) * lu(1778) + lu(1781) = lu(1781) - lu(1695) * lu(1778) + lu(1782) = lu(1782) - lu(1696) * lu(1778) + lu(1783) = lu(1783) - lu(1697) * lu(1778) + lu(1815) = lu(1815) - lu(1693) * lu(1814) + lu(1816) = lu(1816) - lu(1694) * lu(1814) + lu(1817) = lu(1817) - lu(1695) * lu(1814) + lu(1818) = lu(1818) - lu(1696) * lu(1814) + lu(1819) = lu(1819) - lu(1697) * lu(1814) + lu(1857) = lu(1857) - lu(1693) * lu(1856) + lu(1858) = lu(1858) - lu(1694) * lu(1856) + lu(1859) = lu(1859) - lu(1695) * lu(1856) + lu(1860) = lu(1860) - lu(1696) * lu(1856) + lu(1861) = lu(1861) - lu(1697) * lu(1856) + lu(1903) = lu(1903) - lu(1693) * lu(1902) + lu(1904) = lu(1904) - lu(1694) * lu(1902) + lu(1905) = lu(1905) - lu(1695) * lu(1902) + lu(1906) = lu(1906) - lu(1696) * lu(1902) + lu(1907) = lu(1907) - lu(1697) * lu(1902) + lu(1733) = 1._r8 / lu(1733) + lu(1734) = lu(1734) * lu(1733) + lu(1735) = lu(1735) * lu(1733) + lu(1736) = lu(1736) * lu(1733) + lu(1737) = lu(1737) * lu(1733) + lu(1780) = lu(1780) - lu(1734) * lu(1779) + lu(1781) = lu(1781) - lu(1735) * lu(1779) + lu(1782) = lu(1782) - lu(1736) * lu(1779) + lu(1783) = lu(1783) - lu(1737) * lu(1779) + lu(1816) = lu(1816) - lu(1734) * lu(1815) + lu(1817) = lu(1817) - lu(1735) * lu(1815) + lu(1818) = lu(1818) - lu(1736) * lu(1815) + lu(1819) = lu(1819) - lu(1737) * lu(1815) + lu(1858) = lu(1858) - lu(1734) * lu(1857) + lu(1859) = lu(1859) - lu(1735) * lu(1857) + lu(1860) = lu(1860) - lu(1736) * lu(1857) + lu(1861) = lu(1861) - lu(1737) * lu(1857) + lu(1904) = lu(1904) - lu(1734) * lu(1903) + lu(1905) = lu(1905) - lu(1735) * lu(1903) + lu(1906) = lu(1906) - lu(1736) * lu(1903) + lu(1907) = lu(1907) - lu(1737) * lu(1903) + lu(1780) = 1._r8 / lu(1780) + lu(1781) = lu(1781) * lu(1780) + lu(1782) = lu(1782) * lu(1780) + lu(1783) = lu(1783) * lu(1780) + lu(1817) = lu(1817) - lu(1781) * lu(1816) + lu(1818) = lu(1818) - lu(1782) * lu(1816) + lu(1819) = lu(1819) - lu(1783) * lu(1816) + lu(1859) = lu(1859) - lu(1781) * lu(1858) + lu(1860) = lu(1860) - lu(1782) * lu(1858) + lu(1861) = lu(1861) - lu(1783) * lu(1858) + lu(1905) = lu(1905) - lu(1781) * lu(1904) + lu(1906) = lu(1906) - lu(1782) * lu(1904) + lu(1907) = lu(1907) - lu(1783) * lu(1904) + lu(1817) = 1._r8 / lu(1817) + lu(1818) = lu(1818) * lu(1817) + lu(1819) = lu(1819) * lu(1817) + lu(1860) = lu(1860) - lu(1818) * lu(1859) + lu(1861) = lu(1861) - lu(1819) * lu(1859) + lu(1906) = lu(1906) - lu(1818) * lu(1905) + lu(1907) = lu(1907) - lu(1819) * lu(1905) + lu(1860) = 1._r8 / lu(1860) + lu(1861) = lu(1861) * lu(1860) + lu(1907) = lu(1907) - lu(1861) * lu(1906) + lu(1907) = 1._r8 / lu(1907) + end subroutine lu_fac23 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + call lu_fac12( lu ) + call lu_fac13( lu ) + call lu_fac14( lu ) + call lu_fac15( lu ) + call lu_fac16( lu ) + call lu_fac17( lu ) + call lu_fac18( lu ) + call lu_fac19( lu ) + call lu_fac20( lu ) + call lu_fac21( lu ) + call lu_fac22( lu ) + call lu_fac23( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..08741e4176 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 @@ -0,0 +1,2095 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(106) = b(106) - lu(22) * b(21) + b(112) = b(112) - lu(23) * b(21) + b(53) = b(53) - lu(25) * b(22) + b(82) = b(82) - lu(26) * b(22) + b(30) = b(30) - lu(28) * b(23) + b(100) = b(100) - lu(29) * b(23) + b(112) = b(112) - lu(31) * b(24) + b(53) = b(53) - lu(33) * b(25) + b(82) = b(82) - lu(34) * b(25) + b(112) = b(112) - lu(35) * b(25) + b(81) = b(81) - lu(37) * b(26) + b(112) = b(112) - lu(38) * b(26) + b(53) = b(53) - lu(40) * b(27) + b(91) = b(91) - lu(41) * b(27) + b(100) = b(100) - lu(43) * b(28) + b(108) = b(108) - lu(44) * b(28) + b(109) = b(109) - lu(45) * b(28) + b(100) = b(100) - lu(47) * b(29) + b(103) = b(103) - lu(48) * b(29) + b(109) = b(109) - lu(49) * b(29) + b(58) = b(58) - lu(52) * b(30) + b(95) = b(95) - lu(53) * b(30) + b(100) = b(100) - lu(54) * b(30) + b(58) = b(58) - lu(56) * b(31) + b(86) = b(86) - lu(57) * b(31) + b(88) = b(88) - lu(58) * b(31) + b(107) = b(107) - lu(59) * b(31) + b(109) = b(109) - lu(60) * b(31) + b(61) = b(61) - lu(62) * b(32) + b(97) = b(97) - lu(63) * b(32) + b(58) = b(58) - lu(65) * b(33) + b(67) = b(67) - lu(66) * b(33) + b(95) = b(95) - lu(67) * b(33) + b(106) = b(106) - lu(68) * b(33) + b(48) = b(48) - lu(70) * b(34) + b(50) = b(50) - lu(71) * b(34) + b(58) = b(58) - lu(72) * b(34) + b(67) = b(67) - lu(73) * b(34) + b(88) = b(88) - lu(74) * b(34) + b(91) = b(91) - lu(75) * b(34) + b(95) = b(95) - lu(76) * b(34) + b(44) = b(44) - lu(78) * b(35) + b(88) = b(88) - lu(79) * b(35) + b(91) = b(91) - lu(80) * b(35) + b(96) = b(96) - lu(81) * b(35) + b(100) = b(100) - lu(82) * b(35) + b(51) = b(51) - lu(84) * b(36) + b(96) = b(96) - lu(85) * b(36) + b(100) = b(100) - lu(86) * b(36) + b(101) = b(101) - lu(87) * b(36) + b(104) = b(104) - lu(88) * b(36) + b(63) = b(63) - lu(90) * b(37) + b(73) = b(73) - lu(91) * b(37) + b(88) = b(88) - lu(92) * b(37) + b(91) = b(91) - lu(93) * b(37) + b(100) = b(100) - lu(94) * b(37) + b(57) = b(57) - lu(96) * b(38) + b(64) = b(64) - lu(97) * b(38) + b(95) = b(95) - lu(98) * b(38) + b(97) = b(97) - lu(99) * b(38) + b(110) = b(110) - lu(100) * b(38) + b(113) = b(113) - lu(101) * b(38) + b(86) = b(86) - lu(103) * b(39) + b(88) = b(88) - lu(104) * b(39) + b(97) = b(97) - lu(105) * b(39) + b(100) = b(100) - lu(106) * b(39) + b(105) = b(105) - lu(107) * b(39) + b(107) = b(107) - lu(108) * b(39) + b(64) = b(64) - lu(110) * b(40) + b(82) = b(82) - lu(111) * b(40) + b(97) = b(97) - lu(112) * b(40) + b(104) = b(104) - lu(113) * b(40) + b(52) = b(52) - lu(115) * b(41) + b(75) = b(75) - lu(116) * b(41) + b(81) = b(81) - lu(117) * b(41) + b(95) = b(95) - lu(118) * b(41) + b(105) = b(105) - lu(119) * b(41) + b(107) = b(107) - lu(120) * b(41) + b(109) = b(109) - lu(121) * b(41) + b(74) = b(74) - lu(123) * b(42) + b(84) = b(84) - lu(124) * b(42) + b(95) = b(95) - lu(125) * b(42) + b(97) = b(97) - lu(126) * b(42) + b(102) = b(102) - lu(127) * b(42) + b(111) = b(111) - lu(128) * b(42) + b(86) = b(86) - lu(130) * b(43) + b(88) = b(88) - lu(131) * b(43) + b(93) = b(93) - lu(132) * b(43) + b(95) = b(95) - lu(133) * b(43) + b(100) = b(100) - lu(134) * b(43) + b(112) = b(112) - lu(135) * b(43) + b(54) = b(54) - lu(137) * b(44) + b(91) = b(91) - lu(138) * b(44) + b(96) = b(96) - lu(139) * b(44) + b(100) = b(100) - lu(140) * b(44) + b(101) = b(101) - lu(141) * b(44) + b(57) = b(57) - lu(144) * b(45) + b(64) = b(64) - lu(145) * b(45) + b(82) = b(82) - lu(146) * b(45) + b(95) = b(95) - lu(147) * b(45) + b(96) = b(96) - lu(148) * b(45) + b(97) = b(97) - lu(149) * b(45) + b(104) = b(104) - lu(150) * b(45) + b(110) = b(110) - lu(151) * b(45) + b(113) = b(113) - lu(152) * b(45) + b(47) = b(47) - lu(154) * b(46) + b(96) = b(96) - lu(155) * b(46) + b(98) = b(98) - lu(156) * b(46) + b(100) = b(100) - lu(157) * b(46) + b(102) = b(102) - lu(158) * b(46) + b(104) = b(104) - lu(159) * b(46) + b(113) = b(113) - lu(160) * b(46) + b(96) = b(96) - lu(162) * b(47) + b(98) = b(98) - lu(163) * b(47) + b(100) = b(100) - lu(164) * b(47) + b(102) = b(102) - lu(165) * b(47) + b(104) = b(104) - lu(166) * b(47) + b(113) = b(113) - lu(167) * b(47) + b(67) = b(67) - lu(169) * b(48) + b(88) = b(88) - lu(170) * b(48) + b(91) = b(91) - lu(171) * b(48) + b(94) = b(94) - lu(172) * b(48) + b(95) = b(95) - lu(173) * b(48) + b(97) = b(97) - lu(174) * b(48) + b(54) = b(54) - lu(178) * b(49) + b(88) = b(88) - lu(179) * b(49) + b(91) = b(91) - lu(180) * b(49) + b(96) = b(96) - lu(181) * b(49) + b(97) = b(97) - lu(182) * b(49) + b(100) = b(100) - lu(183) * b(49) + b(101) = b(101) - lu(184) * b(49) + b(110) = b(110) - lu(185) * b(49) + b(86) = b(86) - lu(187) * b(50) + b(88) = b(88) - lu(188) * b(50) + b(91) = b(91) - lu(189) * b(50) + b(102) = b(102) - lu(190) * b(50) + b(88) = b(88) - lu(192) * b(51) + b(100) = b(100) - lu(193) * b(51) + b(104) = b(104) - lu(194) * b(51) + b(105) = b(105) - lu(195) * b(51) + b(75) = b(75) - lu(198) * b(52) + b(81) = b(81) - lu(199) * b(52) + b(88) = b(88) - lu(200) * b(52) + b(93) = b(93) - lu(201) * b(52) + b(95) = b(95) - lu(202) * b(52) + b(100) = b(100) - lu(203) * b(52) + b(112) = b(112) - lu(204) * b(52) + b(63) = b(63) - lu(207) * b(53) + b(80) = b(80) - lu(208) * b(53) + b(88) = b(88) - lu(209) * b(53) + b(91) = b(91) - lu(210) * b(53) + b(100) = b(100) - lu(211) * b(53) + b(107) = b(107) - lu(212) * b(53) + b(109) = b(109) - lu(213) * b(53) + b(91) = b(91) - lu(216) * b(54) + b(96) = b(96) - lu(217) * b(54) + b(100) = b(100) - lu(218) * b(54) + b(101) = b(101) - lu(219) * b(54) + b(81) = b(81) - lu(221) * b(55) + b(82) = b(82) - lu(222) * b(55) + b(88) = b(88) - lu(223) * b(55) + b(91) = b(91) - lu(224) * b(55) + b(95) = b(95) - lu(225) * b(55) + b(100) = b(100) - lu(226) * b(55) + b(88) = b(88) - lu(229) * b(56) + b(93) = b(93) - lu(230) * b(56) + b(95) = b(95) - lu(231) * b(56) + b(100) = b(100) - lu(232) * b(56) + b(106) = b(106) - lu(233) * b(56) + b(112) = b(112) - lu(234) * b(56) + b(64) = b(64) - lu(237) * b(57) + b(86) = b(86) - lu(238) * b(57) + b(88) = b(88) - lu(239) * b(57) + b(91) = b(91) - lu(240) * b(57) + b(95) = b(95) - lu(241) * b(57) + b(97) = b(97) - lu(242) * b(57) + b(102) = b(102) - lu(243) * b(57) + b(110) = b(110) - lu(244) * b(57) + b(113) = b(113) - lu(245) * b(57) + b(67) = b(67) - lu(248) * b(58) + b(86) = b(86) - lu(249) * b(58) + b(88) = b(88) - lu(250) * b(58) + b(95) = b(95) - lu(251) * b(58) + b(100) = b(100) - lu(252) * b(58) + b(88) = b(88) - lu(256) * b(59) + b(93) = b(93) - lu(257) * b(59) + b(95) = b(95) - lu(258) * b(59) + b(100) = b(100) - lu(259) * b(59) + b(105) = b(105) - lu(260) * b(59) + b(106) = b(106) - lu(261) * b(59) + b(107) = b(107) - lu(262) * b(59) + b(109) = b(109) - lu(263) * b(59) + b(112) = b(112) - lu(264) * b(59) + b(83) = b(83) - lu(266) * b(60) + b(87) = b(87) - lu(267) * b(60) + b(95) = b(95) - lu(268) * b(60) + b(97) = b(97) - lu(269) * b(60) + b(104) = b(104) - lu(270) * b(60) + b(105) = b(105) - lu(271) * b(60) + b(112) = b(112) - lu(272) * b(60) + b(65) = b(65) - lu(274) * b(61) + b(94) = b(94) - lu(275) * b(61) + b(96) = b(96) - lu(276) * b(61) + b(97) = b(97) - lu(277) * b(61) + b(99) = b(99) - lu(278) * b(61) + b(110) = b(110) - lu(279) * b(61) + b(111) = b(111) - lu(280) * b(61) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(76) = b(76) - lu(284) * b(62) + b(77) = b(77) - lu(285) * b(62) + b(79) = b(79) - lu(286) * b(62) + b(95) = b(95) - lu(287) * b(62) + b(100) = b(100) - lu(288) * b(62) + b(103) = b(103) - lu(289) * b(62) + b(104) = b(104) - lu(290) * b(62) + b(105) = b(105) - lu(291) * b(62) + b(107) = b(107) - lu(292) * b(62) + b(108) = b(108) - lu(293) * b(62) + b(109) = b(109) - lu(294) * b(62) + b(73) = b(73) - lu(297) * b(63) + b(86) = b(86) - lu(298) * b(63) + b(88) = b(88) - lu(299) * b(63) + b(91) = b(91) - lu(300) * b(63) + b(97) = b(97) - lu(301) * b(63) + b(100) = b(100) - lu(302) * b(63) + b(104) = b(104) - lu(303) * b(63) + b(105) = b(105) - lu(304) * b(63) + b(106) = b(106) - lu(305) * b(63) + b(112) = b(112) - lu(306) * b(63) + b(86) = b(86) - lu(310) * b(64) + b(88) = b(88) - lu(311) * b(64) + b(91) = b(91) - lu(312) * b(64) + b(95) = b(95) - lu(313) * b(64) + b(96) = b(96) - lu(314) * b(64) + b(97) = b(97) - lu(315) * b(64) + b(102) = b(102) - lu(316) * b(64) + b(104) = b(104) - lu(317) * b(64) + b(105) = b(105) - lu(318) * b(64) + b(110) = b(110) - lu(319) * b(64) + b(113) = b(113) - lu(320) * b(64) + b(88) = b(88) - lu(325) * b(65) + b(91) = b(91) - lu(326) * b(65) + b(94) = b(94) - lu(327) * b(65) + b(95) = b(95) - lu(328) * b(65) + b(96) = b(96) - lu(329) * b(65) + b(97) = b(97) - lu(330) * b(65) + b(99) = b(99) - lu(331) * b(65) + b(100) = b(100) - lu(332) * b(65) + b(101) = b(101) - lu(333) * b(65) + b(110) = b(110) - lu(334) * b(65) + b(111) = b(111) - lu(335) * b(65) + b(88) = b(88) - lu(337) * b(66) + b(90) = b(90) - lu(338) * b(66) + b(91) = b(91) - lu(339) * b(66) + b(97) = b(97) - lu(340) * b(66) + b(98) = b(98) - lu(341) * b(66) + b(100) = b(100) - lu(342) * b(66) + b(101) = b(101) - lu(343) * b(66) + b(102) = b(102) - lu(344) * b(66) + b(103) = b(103) - lu(345) * b(66) + b(104) = b(104) - lu(346) * b(66) + b(108) = b(108) - lu(347) * b(66) + b(110) = b(110) - lu(348) * b(66) + b(113) = b(113) - lu(349) * b(66) + b(75) = b(75) - lu(354) * b(67) + b(81) = b(81) - lu(355) * b(67) + b(86) = b(86) - lu(356) * b(67) + b(88) = b(88) - lu(357) * b(67) + b(91) = b(91) - lu(358) * b(67) + b(94) = b(94) - lu(359) * b(67) + b(95) = b(95) - lu(360) * b(67) + b(97) = b(97) - lu(361) * b(67) + b(100) = b(100) - lu(362) * b(67) + b(104) = b(104) - lu(363) * b(67) + b(105) = b(105) - lu(364) * b(67) + b(106) = b(106) - lu(365) * b(67) + b(112) = b(112) - lu(366) * b(67) + b(78) = b(78) - lu(368) * b(68) + b(90) = b(90) - lu(369) * b(68) + b(91) = b(91) - lu(370) * b(68) + b(95) = b(95) - lu(371) * b(68) + b(97) = b(97) - lu(372) * b(68) + b(98) = b(98) - lu(373) * b(68) + b(100) = b(100) - lu(374) * b(68) + b(101) = b(101) - lu(375) * b(68) + b(102) = b(102) - lu(376) * b(68) + b(103) = b(103) - lu(377) * b(68) + b(104) = b(104) - lu(378) * b(68) + b(108) = b(108) - lu(379) * b(68) + b(110) = b(110) - lu(380) * b(68) + b(113) = b(113) - lu(381) * b(68) + b(83) = b(83) - lu(383) * b(69) + b(90) = b(90) - lu(384) * b(69) + b(91) = b(91) - lu(385) * b(69) + b(93) = b(93) - lu(386) * b(69) + b(97) = b(97) - lu(387) * b(69) + b(98) = b(98) - lu(388) * b(69) + b(100) = b(100) - lu(389) * b(69) + b(101) = b(101) - lu(390) * b(69) + b(103) = b(103) - lu(391) * b(69) + b(104) = b(104) - lu(392) * b(69) + b(108) = b(108) - lu(393) * b(69) + b(110) = b(110) - lu(394) * b(69) + b(112) = b(112) - lu(395) * b(69) + b(113) = b(113) - lu(396) * b(69) + b(83) = b(83) - lu(399) * b(70) + b(90) = b(90) - lu(400) * b(70) + b(91) = b(91) - lu(401) * b(70) + b(93) = b(93) - lu(402) * b(70) + b(97) = b(97) - lu(403) * b(70) + b(98) = b(98) - lu(404) * b(70) + b(100) = b(100) - lu(405) * b(70) + b(101) = b(101) - lu(406) * b(70) + b(103) = b(103) - lu(407) * b(70) + b(104) = b(104) - lu(408) * b(70) + b(108) = b(108) - lu(409) * b(70) + b(110) = b(110) - lu(410) * b(70) + b(112) = b(112) - lu(411) * b(70) + b(113) = b(113) - lu(412) * b(70) + b(87) = b(87) - lu(414) * b(71) + b(90) = b(90) - lu(415) * b(71) + b(91) = b(91) - lu(416) * b(71) + b(97) = b(97) - lu(417) * b(71) + b(98) = b(98) - lu(418) * b(71) + b(100) = b(100) - lu(419) * b(71) + b(101) = b(101) - lu(420) * b(71) + b(103) = b(103) - lu(421) * b(71) + b(104) = b(104) - lu(422) * b(71) + b(105) = b(105) - lu(423) * b(71) + b(108) = b(108) - lu(424) * b(71) + b(110) = b(110) - lu(425) * b(71) + b(113) = b(113) - lu(426) * b(71) + b(76) = b(76) - lu(428) * b(72) + b(90) = b(90) - lu(429) * b(72) + b(91) = b(91) - lu(430) * b(72) + b(93) = b(93) - lu(431) * b(72) + b(97) = b(97) - lu(432) * b(72) + b(98) = b(98) - lu(433) * b(72) + b(100) = b(100) - lu(434) * b(72) + b(101) = b(101) - lu(435) * b(72) + b(103) = b(103) - lu(436) * b(72) + b(104) = b(104) - lu(437) * b(72) + b(107) = b(107) - lu(438) * b(72) + b(108) = b(108) - lu(439) * b(72) + b(109) = b(109) - lu(440) * b(72) + b(110) = b(110) - lu(441) * b(72) + b(113) = b(113) - lu(442) * b(72) + b(80) = b(80) - lu(446) * b(73) + b(81) = b(81) - lu(447) * b(73) + b(82) = b(82) - lu(448) * b(73) + b(86) = b(86) - lu(449) * b(73) + b(88) = b(88) - lu(450) * b(73) + b(91) = b(91) - lu(451) * b(73) + b(93) = b(93) - lu(452) * b(73) + b(95) = b(95) - lu(453) * b(73) + b(100) = b(100) - lu(454) * b(73) + b(102) = b(102) - lu(455) * b(73) + b(107) = b(107) - lu(456) * b(73) + b(109) = b(109) - lu(457) * b(73) + b(112) = b(112) - lu(458) * b(73) + b(85) = b(85) - lu(460) * b(74) + b(87) = b(87) - lu(461) * b(74) + b(89) = b(89) - lu(462) * b(74) + b(91) = b(91) - lu(463) * b(74) + b(92) = b(92) - lu(464) * b(74) + b(94) = b(94) - lu(465) * b(74) + b(95) = b(95) - lu(466) * b(74) + b(96) = b(96) - lu(467) * b(74) + b(97) = b(97) - lu(468) * b(74) + b(99) = b(99) - lu(469) * b(74) + b(102) = b(102) - lu(470) * b(74) + b(104) = b(104) - lu(471) * b(74) + b(105) = b(105) - lu(472) * b(74) + b(111) = b(111) - lu(473) * b(74) + b(81) = b(81) - lu(481) * b(75) + b(86) = b(86) - lu(482) * b(75) + b(88) = b(88) - lu(483) * b(75) + b(91) = b(91) - lu(484) * b(75) + b(93) = b(93) - lu(485) * b(75) + b(94) = b(94) - lu(486) * b(75) + b(95) = b(95) - lu(487) * b(75) + b(97) = b(97) - lu(488) * b(75) + b(100) = b(100) - lu(489) * b(75) + b(104) = b(104) - lu(490) * b(75) + b(105) = b(105) - lu(491) * b(75) + b(106) = b(106) - lu(492) * b(75) + b(107) = b(107) - lu(493) * b(75) + b(109) = b(109) - lu(494) * b(75) + b(112) = b(112) - lu(495) * b(75) + b(85) = b(85) - lu(497) * b(76) + b(90) = b(90) - lu(498) * b(76) + b(97) = b(97) - lu(499) * b(76) + b(98) = b(98) - lu(500) * b(76) + b(100) = b(100) - lu(501) * b(76) + b(101) = b(101) - lu(502) * b(76) + b(103) = b(103) - lu(503) * b(76) + b(104) = b(104) - lu(504) * b(76) + b(107) = b(107) - lu(505) * b(76) + b(108) = b(108) - lu(506) * b(76) + b(109) = b(109) - lu(507) * b(76) + b(110) = b(110) - lu(508) * b(76) + b(113) = b(113) - lu(509) * b(76) + b(79) = b(79) - lu(513) * b(77) + b(85) = b(85) - lu(514) * b(77) + b(90) = b(90) - lu(515) * b(77) + b(91) = b(91) - lu(516) * b(77) + b(95) = b(95) - lu(517) * b(77) + b(97) = b(97) - lu(518) * b(77) + b(98) = b(98) - lu(519) * b(77) + b(100) = b(100) - lu(520) * b(77) + b(101) = b(101) - lu(521) * b(77) + b(103) = b(103) - lu(522) * b(77) + b(104) = b(104) - lu(523) * b(77) + b(105) = b(105) - lu(524) * b(77) + b(107) = b(107) - lu(525) * b(77) + b(108) = b(108) - lu(526) * b(77) + b(109) = b(109) - lu(527) * b(77) + b(110) = b(110) - lu(528) * b(77) + b(113) = b(113) - lu(529) * b(77) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(79) = b(79) - lu(533) * b(78) + b(85) = b(85) - lu(534) * b(78) + b(87) = b(87) - lu(535) * b(78) + b(89) = b(89) - lu(536) * b(78) + b(90) = b(90) - lu(537) * b(78) + b(91) = b(91) - lu(538) * b(78) + b(95) = b(95) - lu(539) * b(78) + b(97) = b(97) - lu(540) * b(78) + b(98) = b(98) - lu(541) * b(78) + b(100) = b(100) - lu(542) * b(78) + b(101) = b(101) - lu(543) * b(78) + b(102) = b(102) - lu(544) * b(78) + b(103) = b(103) - lu(545) * b(78) + b(104) = b(104) - lu(546) * b(78) + b(105) = b(105) - lu(547) * b(78) + b(108) = b(108) - lu(548) * b(78) + b(110) = b(110) - lu(549) * b(78) + b(113) = b(113) - lu(550) * b(78) + b(85) = b(85) - lu(555) * b(79) + b(90) = b(90) - lu(556) * b(79) + b(91) = b(91) - lu(557) * b(79) + b(95) = b(95) - lu(558) * b(79) + b(97) = b(97) - lu(559) * b(79) + b(98) = b(98) - lu(560) * b(79) + b(100) = b(100) - lu(561) * b(79) + b(101) = b(101) - lu(562) * b(79) + b(103) = b(103) - lu(563) * b(79) + b(104) = b(104) - lu(564) * b(79) + b(105) = b(105) - lu(565) * b(79) + b(107) = b(107) - lu(566) * b(79) + b(108) = b(108) - lu(567) * b(79) + b(109) = b(109) - lu(568) * b(79) + b(110) = b(110) - lu(569) * b(79) + b(113) = b(113) - lu(570) * b(79) + b(81) = b(81) - lu(576) * b(80) + b(82) = b(82) - lu(577) * b(80) + b(86) = b(86) - lu(578) * b(80) + b(88) = b(88) - lu(579) * b(80) + b(91) = b(91) - lu(580) * b(80) + b(92) = b(92) - lu(581) * b(80) + b(93) = b(93) - lu(582) * b(80) + b(95) = b(95) - lu(583) * b(80) + b(96) = b(96) - lu(584) * b(80) + b(97) = b(97) - lu(585) * b(80) + b(99) = b(99) - lu(586) * b(80) + b(100) = b(100) - lu(587) * b(80) + b(102) = b(102) - lu(588) * b(80) + b(104) = b(104) - lu(589) * b(80) + b(105) = b(105) - lu(590) * b(80) + b(106) = b(106) - lu(591) * b(80) + b(107) = b(107) - lu(592) * b(80) + b(109) = b(109) - lu(593) * b(80) + b(112) = b(112) - lu(594) * b(80) + b(82) = b(82) - lu(601) * b(81) + b(86) = b(86) - lu(602) * b(81) + b(88) = b(88) - lu(603) * b(81) + b(91) = b(91) - lu(604) * b(81) + b(92) = b(92) - lu(605) * b(81) + b(93) = b(93) - lu(606) * b(81) + b(94) = b(94) - lu(607) * b(81) + b(95) = b(95) - lu(608) * b(81) + b(96) = b(96) - lu(609) * b(81) + b(97) = b(97) - lu(610) * b(81) + b(99) = b(99) - lu(611) * b(81) + b(100) = b(100) - lu(612) * b(81) + b(102) = b(102) - lu(613) * b(81) + b(104) = b(104) - lu(614) * b(81) + b(105) = b(105) - lu(615) * b(81) + b(106) = b(106) - lu(616) * b(81) + b(107) = b(107) - lu(617) * b(81) + b(109) = b(109) - lu(618) * b(81) + b(112) = b(112) - lu(619) * b(81) + b(86) = b(86) - lu(632) * b(82) + b(88) = b(88) - lu(633) * b(82) + b(91) = b(91) - lu(634) * b(82) + b(92) = b(92) - lu(635) * b(82) + b(93) = b(93) - lu(636) * b(82) + b(94) = b(94) - lu(637) * b(82) + b(95) = b(95) - lu(638) * b(82) + b(96) = b(96) - lu(639) * b(82) + b(97) = b(97) - lu(640) * b(82) + b(99) = b(99) - lu(641) * b(82) + b(100) = b(100) - lu(642) * b(82) + b(101) = b(101) - lu(643) * b(82) + b(102) = b(102) - lu(644) * b(82) + b(104) = b(104) - lu(645) * b(82) + b(105) = b(105) - lu(646) * b(82) + b(106) = b(106) - lu(647) * b(82) + b(107) = b(107) - lu(648) * b(82) + b(109) = b(109) - lu(649) * b(82) + b(110) = b(110) - lu(650) * b(82) + b(111) = b(111) - lu(651) * b(82) + b(112) = b(112) - lu(652) * b(82) + b(85) = b(85) - lu(656) * b(83) + b(87) = b(87) - lu(657) * b(83) + b(90) = b(90) - lu(658) * b(83) + b(91) = b(91) - lu(659) * b(83) + b(93) = b(93) - lu(660) * b(83) + b(96) = b(96) - lu(661) * b(83) + b(97) = b(97) - lu(662) * b(83) + b(98) = b(98) - lu(663) * b(83) + b(100) = b(100) - lu(664) * b(83) + b(101) = b(101) - lu(665) * b(83) + b(103) = b(103) - lu(666) * b(83) + b(104) = b(104) - lu(667) * b(83) + b(105) = b(105) - lu(668) * b(83) + b(108) = b(108) - lu(669) * b(83) + b(109) = b(109) - lu(670) * b(83) + b(110) = b(110) - lu(671) * b(83) + b(112) = b(112) - lu(672) * b(83) + b(113) = b(113) - lu(673) * b(83) + b(85) = b(85) - lu(678) * b(84) + b(86) = b(86) - lu(679) * b(84) + b(87) = b(87) - lu(680) * b(84) + b(88) = b(88) - lu(681) * b(84) + b(89) = b(89) - lu(682) * b(84) + b(90) = b(90) - lu(683) * b(84) + b(91) = b(91) - lu(684) * b(84) + b(92) = b(92) - lu(685) * b(84) + b(93) = b(93) - lu(686) * b(84) + b(94) = b(94) - lu(687) * b(84) + b(95) = b(95) - lu(688) * b(84) + b(96) = b(96) - lu(689) * b(84) + b(97) = b(97) - lu(690) * b(84) + b(98) = b(98) - lu(691) * b(84) + b(99) = b(99) - lu(692) * b(84) + b(100) = b(100) - lu(693) * b(84) + b(101) = b(101) - lu(694) * b(84) + b(102) = b(102) - lu(695) * b(84) + b(103) = b(103) - lu(696) * b(84) + b(104) = b(104) - lu(697) * b(84) + b(105) = b(105) - lu(698) * b(84) + b(106) = b(106) - lu(699) * b(84) + b(108) = b(108) - lu(700) * b(84) + b(109) = b(109) - lu(701) * b(84) + b(110) = b(110) - lu(702) * b(84) + b(111) = b(111) - lu(703) * b(84) + b(112) = b(112) - lu(704) * b(84) + b(113) = b(113) - lu(705) * b(84) + b(87) = b(87) - lu(711) * b(85) + b(90) = b(90) - lu(712) * b(85) + b(91) = b(91) - lu(713) * b(85) + b(93) = b(93) - lu(714) * b(85) + b(94) = b(94) - lu(715) * b(85) + b(95) = b(95) - lu(716) * b(85) + b(96) = b(96) - lu(717) * b(85) + b(97) = b(97) - lu(718) * b(85) + b(98) = b(98) - lu(719) * b(85) + b(100) = b(100) - lu(720) * b(85) + b(101) = b(101) - lu(721) * b(85) + b(103) = b(103) - lu(722) * b(85) + b(104) = b(104) - lu(723) * b(85) + b(105) = b(105) - lu(724) * b(85) + b(107) = b(107) - lu(725) * b(85) + b(108) = b(108) - lu(726) * b(85) + b(109) = b(109) - lu(727) * b(85) + b(110) = b(110) - lu(728) * b(85) + b(112) = b(112) - lu(729) * b(85) + b(113) = b(113) - lu(730) * b(85) + b(88) = b(88) - lu(745) * b(86) + b(91) = b(91) - lu(746) * b(86) + b(92) = b(92) - lu(747) * b(86) + b(93) = b(93) - lu(748) * b(86) + b(94) = b(94) - lu(749) * b(86) + b(95) = b(95) - lu(750) * b(86) + b(96) = b(96) - lu(751) * b(86) + b(97) = b(97) - lu(752) * b(86) + b(98) = b(98) - lu(753) * b(86) + b(99) = b(99) - lu(754) * b(86) + b(100) = b(100) - lu(755) * b(86) + b(101) = b(101) - lu(756) * b(86) + b(102) = b(102) - lu(757) * b(86) + b(104) = b(104) - lu(758) * b(86) + b(105) = b(105) - lu(759) * b(86) + b(106) = b(106) - lu(760) * b(86) + b(107) = b(107) - lu(761) * b(86) + b(109) = b(109) - lu(762) * b(86) + b(110) = b(110) - lu(763) * b(86) + b(111) = b(111) - lu(764) * b(86) + b(112) = b(112) - lu(765) * b(86) + b(88) = b(88) - lu(771) * b(87) + b(90) = b(90) - lu(772) * b(87) + b(91) = b(91) - lu(773) * b(87) + b(92) = b(92) - lu(774) * b(87) + b(93) = b(93) - lu(775) * b(87) + b(94) = b(94) - lu(776) * b(87) + b(95) = b(95) - lu(777) * b(87) + b(96) = b(96) - lu(778) * b(87) + b(97) = b(97) - lu(779) * b(87) + b(98) = b(98) - lu(780) * b(87) + b(100) = b(100) - lu(781) * b(87) + b(101) = b(101) - lu(782) * b(87) + b(103) = b(103) - lu(783) * b(87) + b(104) = b(104) - lu(784) * b(87) + b(105) = b(105) - lu(785) * b(87) + b(106) = b(106) - lu(786) * b(87) + b(107) = b(107) - lu(787) * b(87) + b(108) = b(108) - lu(788) * b(87) + b(109) = b(109) - lu(789) * b(87) + b(110) = b(110) - lu(790) * b(87) + b(112) = b(112) - lu(791) * b(87) + b(113) = b(113) - lu(792) * b(87) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(91) = b(91) - lu(820) * b(88) + b(92) = b(92) - lu(821) * b(88) + b(93) = b(93) - lu(822) * b(88) + b(94) = b(94) - lu(823) * b(88) + b(95) = b(95) - lu(824) * b(88) + b(96) = b(96) - lu(825) * b(88) + b(97) = b(97) - lu(826) * b(88) + b(98) = b(98) - lu(827) * b(88) + b(99) = b(99) - lu(828) * b(88) + b(100) = b(100) - lu(829) * b(88) + b(101) = b(101) - lu(830) * b(88) + b(102) = b(102) - lu(831) * b(88) + b(104) = b(104) - lu(832) * b(88) + b(105) = b(105) - lu(833) * b(88) + b(106) = b(106) - lu(834) * b(88) + b(107) = b(107) - lu(835) * b(88) + b(109) = b(109) - lu(836) * b(88) + b(110) = b(110) - lu(837) * b(88) + b(111) = b(111) - lu(838) * b(88) + b(112) = b(112) - lu(839) * b(88) + b(113) = b(113) - lu(840) * b(88) + b(90) = b(90) - lu(850) * b(89) + b(91) = b(91) - lu(851) * b(89) + b(92) = b(92) - lu(852) * b(89) + b(93) = b(93) - lu(853) * b(89) + b(94) = b(94) - lu(854) * b(89) + b(95) = b(95) - lu(855) * b(89) + b(96) = b(96) - lu(856) * b(89) + b(97) = b(97) - lu(857) * b(89) + b(98) = b(98) - lu(858) * b(89) + b(99) = b(99) - lu(859) * b(89) + b(100) = b(100) - lu(860) * b(89) + b(101) = b(101) - lu(861) * b(89) + b(102) = b(102) - lu(862) * b(89) + b(103) = b(103) - lu(863) * b(89) + b(104) = b(104) - lu(864) * b(89) + b(105) = b(105) - lu(865) * b(89) + b(106) = b(106) - lu(866) * b(89) + b(107) = b(107) - lu(867) * b(89) + b(108) = b(108) - lu(868) * b(89) + b(109) = b(109) - lu(869) * b(89) + b(110) = b(110) - lu(870) * b(89) + b(111) = b(111) - lu(871) * b(89) + b(112) = b(112) - lu(872) * b(89) + b(113) = b(113) - lu(873) * b(89) + b(91) = b(91) - lu(894) * b(90) + b(92) = b(92) - lu(895) * b(90) + b(93) = b(93) - lu(896) * b(90) + b(94) = b(94) - lu(897) * b(90) + b(95) = b(95) - lu(898) * b(90) + b(96) = b(96) - lu(899) * b(90) + b(97) = b(97) - lu(900) * b(90) + b(98) = b(98) - lu(901) * b(90) + b(99) = b(99) - lu(902) * b(90) + b(100) = b(100) - lu(903) * b(90) + b(101) = b(101) - lu(904) * b(90) + b(102) = b(102) - lu(905) * b(90) + b(103) = b(103) - lu(906) * b(90) + b(104) = b(104) - lu(907) * b(90) + b(105) = b(105) - lu(908) * b(90) + b(106) = b(106) - lu(909) * b(90) + b(107) = b(107) - lu(910) * b(90) + b(108) = b(108) - lu(911) * b(90) + b(109) = b(109) - lu(912) * b(90) + b(110) = b(110) - lu(913) * b(90) + b(111) = b(111) - lu(914) * b(90) + b(112) = b(112) - lu(915) * b(90) + b(113) = b(113) - lu(916) * b(90) + b(92) = b(92) - lu(932) * b(91) + b(93) = b(93) - lu(933) * b(91) + b(94) = b(94) - lu(934) * b(91) + b(95) = b(95) - lu(935) * b(91) + b(96) = b(96) - lu(936) * b(91) + b(97) = b(97) - lu(937) * b(91) + b(98) = b(98) - lu(938) * b(91) + b(99) = b(99) - lu(939) * b(91) + b(100) = b(100) - lu(940) * b(91) + b(101) = b(101) - lu(941) * b(91) + b(102) = b(102) - lu(942) * b(91) + b(103) = b(103) - lu(943) * b(91) + b(104) = b(104) - lu(944) * b(91) + b(105) = b(105) - lu(945) * b(91) + b(106) = b(106) - lu(946) * b(91) + b(107) = b(107) - lu(947) * b(91) + b(108) = b(108) - lu(948) * b(91) + b(109) = b(109) - lu(949) * b(91) + b(110) = b(110) - lu(950) * b(91) + b(111) = b(111) - lu(951) * b(91) + b(112) = b(112) - lu(952) * b(91) + b(113) = b(113) - lu(953) * b(91) + b(93) = b(93) - lu(966) * b(92) + b(94) = b(94) - lu(967) * b(92) + b(95) = b(95) - lu(968) * b(92) + b(96) = b(96) - lu(969) * b(92) + b(97) = b(97) - lu(970) * b(92) + b(98) = b(98) - lu(971) * b(92) + b(99) = b(99) - lu(972) * b(92) + b(100) = b(100) - lu(973) * b(92) + b(101) = b(101) - lu(974) * b(92) + b(102) = b(102) - lu(975) * b(92) + b(103) = b(103) - lu(976) * b(92) + b(104) = b(104) - lu(977) * b(92) + b(105) = b(105) - lu(978) * b(92) + b(106) = b(106) - lu(979) * b(92) + b(107) = b(107) - lu(980) * b(92) + b(108) = b(108) - lu(981) * b(92) + b(109) = b(109) - lu(982) * b(92) + b(110) = b(110) - lu(983) * b(92) + b(111) = b(111) - lu(984) * b(92) + b(112) = b(112) - lu(985) * b(92) + b(113) = b(113) - lu(986) * b(92) + b(94) = b(94) - lu(1011) * b(93) + b(95) = b(95) - lu(1012) * b(93) + b(96) = b(96) - lu(1013) * b(93) + b(97) = b(97) - lu(1014) * b(93) + b(98) = b(98) - lu(1015) * b(93) + b(99) = b(99) - lu(1016) * b(93) + b(100) = b(100) - lu(1017) * b(93) + b(101) = b(101) - lu(1018) * b(93) + b(102) = b(102) - lu(1019) * b(93) + b(103) = b(103) - lu(1020) * b(93) + b(104) = b(104) - lu(1021) * b(93) + b(105) = b(105) - lu(1022) * b(93) + b(106) = b(106) - lu(1023) * b(93) + b(107) = b(107) - lu(1024) * b(93) + b(108) = b(108) - lu(1025) * b(93) + b(109) = b(109) - lu(1026) * b(93) + b(110) = b(110) - lu(1027) * b(93) + b(111) = b(111) - lu(1028) * b(93) + b(112) = b(112) - lu(1029) * b(93) + b(113) = b(113) - lu(1030) * b(93) + b(95) = b(95) - lu(1052) * b(94) + b(96) = b(96) - lu(1053) * b(94) + b(97) = b(97) - lu(1054) * b(94) + b(98) = b(98) - lu(1055) * b(94) + b(99) = b(99) - lu(1056) * b(94) + b(100) = b(100) - lu(1057) * b(94) + b(101) = b(101) - lu(1058) * b(94) + b(102) = b(102) - lu(1059) * b(94) + b(103) = b(103) - lu(1060) * b(94) + b(104) = b(104) - lu(1061) * b(94) + b(105) = b(105) - lu(1062) * b(94) + b(106) = b(106) - lu(1063) * b(94) + b(107) = b(107) - lu(1064) * b(94) + b(108) = b(108) - lu(1065) * b(94) + b(109) = b(109) - lu(1066) * b(94) + b(110) = b(110) - lu(1067) * b(94) + b(111) = b(111) - lu(1068) * b(94) + b(112) = b(112) - lu(1069) * b(94) + b(113) = b(113) - lu(1070) * b(94) + b(96) = b(96) - lu(1111) * b(95) + b(97) = b(97) - lu(1112) * b(95) + b(98) = b(98) - lu(1113) * b(95) + b(99) = b(99) - lu(1114) * b(95) + b(100) = b(100) - lu(1115) * b(95) + b(101) = b(101) - lu(1116) * b(95) + b(102) = b(102) - lu(1117) * b(95) + b(103) = b(103) - lu(1118) * b(95) + b(104) = b(104) - lu(1119) * b(95) + b(105) = b(105) - lu(1120) * b(95) + b(106) = b(106) - lu(1121) * b(95) + b(107) = b(107) - lu(1122) * b(95) + b(108) = b(108) - lu(1123) * b(95) + b(109) = b(109) - lu(1124) * b(95) + b(110) = b(110) - lu(1125) * b(95) + b(111) = b(111) - lu(1126) * b(95) + b(112) = b(112) - lu(1127) * b(95) + b(113) = b(113) - lu(1128) * b(95) + b(97) = b(97) - lu(1152) * b(96) + b(98) = b(98) - lu(1153) * b(96) + b(99) = b(99) - lu(1154) * b(96) + b(100) = b(100) - lu(1155) * b(96) + b(101) = b(101) - lu(1156) * b(96) + b(102) = b(102) - lu(1157) * b(96) + b(103) = b(103) - lu(1158) * b(96) + b(104) = b(104) - lu(1159) * b(96) + b(105) = b(105) - lu(1160) * b(96) + b(106) = b(106) - lu(1161) * b(96) + b(107) = b(107) - lu(1162) * b(96) + b(108) = b(108) - lu(1163) * b(96) + b(109) = b(109) - lu(1164) * b(96) + b(110) = b(110) - lu(1165) * b(96) + b(111) = b(111) - lu(1166) * b(96) + b(112) = b(112) - lu(1167) * b(96) + b(113) = b(113) - lu(1168) * b(96) + b(98) = b(98) - lu(1199) * b(97) + b(99) = b(99) - lu(1200) * b(97) + b(100) = b(100) - lu(1201) * b(97) + b(101) = b(101) - lu(1202) * b(97) + b(102) = b(102) - lu(1203) * b(97) + b(103) = b(103) - lu(1204) * b(97) + b(104) = b(104) - lu(1205) * b(97) + b(105) = b(105) - lu(1206) * b(97) + b(106) = b(106) - lu(1207) * b(97) + b(107) = b(107) - lu(1208) * b(97) + b(108) = b(108) - lu(1209) * b(97) + b(109) = b(109) - lu(1210) * b(97) + b(110) = b(110) - lu(1211) * b(97) + b(111) = b(111) - lu(1212) * b(97) + b(112) = b(112) - lu(1213) * b(97) + b(113) = b(113) - lu(1214) * b(97) + end subroutine lu_slv04 + subroutine lu_slv05( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(99) = b(99) - lu(1242) * b(98) + b(100) = b(100) - lu(1243) * b(98) + b(101) = b(101) - lu(1244) * b(98) + b(102) = b(102) - lu(1245) * b(98) + b(103) = b(103) - lu(1246) * b(98) + b(104) = b(104) - lu(1247) * b(98) + b(105) = b(105) - lu(1248) * b(98) + b(106) = b(106) - lu(1249) * b(98) + b(107) = b(107) - lu(1250) * b(98) + b(108) = b(108) - lu(1251) * b(98) + b(109) = b(109) - lu(1252) * b(98) + b(110) = b(110) - lu(1253) * b(98) + b(111) = b(111) - lu(1254) * b(98) + b(112) = b(112) - lu(1255) * b(98) + b(113) = b(113) - lu(1256) * b(98) + b(100) = b(100) - lu(1279) * b(99) + b(101) = b(101) - lu(1280) * b(99) + b(102) = b(102) - lu(1281) * b(99) + b(103) = b(103) - lu(1282) * b(99) + b(104) = b(104) - lu(1283) * b(99) + b(105) = b(105) - lu(1284) * b(99) + b(106) = b(106) - lu(1285) * b(99) + b(107) = b(107) - lu(1286) * b(99) + b(108) = b(108) - lu(1287) * b(99) + b(109) = b(109) - lu(1288) * b(99) + b(110) = b(110) - lu(1289) * b(99) + b(111) = b(111) - lu(1290) * b(99) + b(112) = b(112) - lu(1291) * b(99) + b(113) = b(113) - lu(1292) * b(99) + b(101) = b(101) - lu(1339) * b(100) + b(102) = b(102) - lu(1340) * b(100) + b(103) = b(103) - lu(1341) * b(100) + b(104) = b(104) - lu(1342) * b(100) + b(105) = b(105) - lu(1343) * b(100) + b(106) = b(106) - lu(1344) * b(100) + b(107) = b(107) - lu(1345) * b(100) + b(108) = b(108) - lu(1346) * b(100) + b(109) = b(109) - lu(1347) * b(100) + b(110) = b(110) - lu(1348) * b(100) + b(111) = b(111) - lu(1349) * b(100) + b(112) = b(112) - lu(1350) * b(100) + b(113) = b(113) - lu(1351) * b(100) + b(102) = b(102) - lu(1383) * b(101) + b(103) = b(103) - lu(1384) * b(101) + b(104) = b(104) - lu(1385) * b(101) + b(105) = b(105) - lu(1386) * b(101) + b(106) = b(106) - lu(1387) * b(101) + b(107) = b(107) - lu(1388) * b(101) + b(108) = b(108) - lu(1389) * b(101) + b(109) = b(109) - lu(1390) * b(101) + b(110) = b(110) - lu(1391) * b(101) + b(111) = b(111) - lu(1392) * b(101) + b(112) = b(112) - lu(1393) * b(101) + b(113) = b(113) - lu(1394) * b(101) + b(103) = b(103) - lu(1425) * b(102) + b(104) = b(104) - lu(1426) * b(102) + b(105) = b(105) - lu(1427) * b(102) + b(106) = b(106) - lu(1428) * b(102) + b(107) = b(107) - lu(1429) * b(102) + b(108) = b(108) - lu(1430) * b(102) + b(109) = b(109) - lu(1431) * b(102) + b(110) = b(110) - lu(1432) * b(102) + b(111) = b(111) - lu(1433) * b(102) + b(112) = b(112) - lu(1434) * b(102) + b(113) = b(113) - lu(1435) * b(102) + b(104) = b(104) - lu(1469) * b(103) + b(105) = b(105) - lu(1470) * b(103) + b(106) = b(106) - lu(1471) * b(103) + b(107) = b(107) - lu(1472) * b(103) + b(108) = b(108) - lu(1473) * b(103) + b(109) = b(109) - lu(1474) * b(103) + b(110) = b(110) - lu(1475) * b(103) + b(111) = b(111) - lu(1476) * b(103) + b(112) = b(112) - lu(1477) * b(103) + b(113) = b(113) - lu(1478) * b(103) + b(105) = b(105) - lu(1513) * b(104) + b(106) = b(106) - lu(1514) * b(104) + b(107) = b(107) - lu(1515) * b(104) + b(108) = b(108) - lu(1516) * b(104) + b(109) = b(109) - lu(1517) * b(104) + b(110) = b(110) - lu(1518) * b(104) + b(111) = b(111) - lu(1519) * b(104) + b(112) = b(112) - lu(1520) * b(104) + b(113) = b(113) - lu(1521) * b(104) + b(106) = b(106) - lu(1560) * b(105) + b(107) = b(107) - lu(1561) * b(105) + b(108) = b(108) - lu(1562) * b(105) + b(109) = b(109) - lu(1563) * b(105) + b(110) = b(110) - lu(1564) * b(105) + b(111) = b(111) - lu(1565) * b(105) + b(112) = b(112) - lu(1566) * b(105) + b(113) = b(113) - lu(1567) * b(105) + b(107) = b(107) - lu(1607) * b(106) + b(108) = b(108) - lu(1608) * b(106) + b(109) = b(109) - lu(1609) * b(106) + b(110) = b(110) - lu(1610) * b(106) + b(111) = b(111) - lu(1611) * b(106) + b(112) = b(112) - lu(1612) * b(106) + b(113) = b(113) - lu(1613) * b(106) + b(108) = b(108) - lu(1649) * b(107) + b(109) = b(109) - lu(1650) * b(107) + b(110) = b(110) - lu(1651) * b(107) + b(111) = b(111) - lu(1652) * b(107) + b(112) = b(112) - lu(1653) * b(107) + b(113) = b(113) - lu(1654) * b(107) + b(109) = b(109) - lu(1693) * b(108) + b(110) = b(110) - lu(1694) * b(108) + b(111) = b(111) - lu(1695) * b(108) + b(112) = b(112) - lu(1696) * b(108) + b(113) = b(113) - lu(1697) * b(108) + b(110) = b(110) - lu(1734) * b(109) + b(111) = b(111) - lu(1735) * b(109) + b(112) = b(112) - lu(1736) * b(109) + b(113) = b(113) - lu(1737) * b(109) + b(111) = b(111) - lu(1781) * b(110) + b(112) = b(112) - lu(1782) * b(110) + b(113) = b(113) - lu(1783) * b(110) + b(112) = b(112) - lu(1818) * b(111) + b(113) = b(113) - lu(1819) * b(111) + b(113) = b(113) - lu(1861) * b(112) + end subroutine lu_slv05 + subroutine lu_slv06( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(113) = b(113) * lu(1907) + b(112) = b(112) - lu(1906) * b(113) + b(111) = b(111) - lu(1905) * b(113) + b(110) = b(110) - lu(1904) * b(113) + b(109) = b(109) - lu(1903) * b(113) + b(108) = b(108) - lu(1902) * b(113) + b(107) = b(107) - lu(1901) * b(113) + b(106) = b(106) - lu(1900) * b(113) + b(105) = b(105) - lu(1899) * b(113) + b(104) = b(104) - lu(1898) * b(113) + b(103) = b(103) - lu(1897) * b(113) + b(102) = b(102) - lu(1896) * b(113) + b(101) = b(101) - lu(1895) * b(113) + b(100) = b(100) - lu(1894) * b(113) + b(99) = b(99) - lu(1893) * b(113) + b(98) = b(98) - lu(1892) * b(113) + b(97) = b(97) - lu(1891) * b(113) + b(96) = b(96) - lu(1890) * b(113) + b(95) = b(95) - lu(1889) * b(113) + b(94) = b(94) - lu(1888) * b(113) + b(93) = b(93) - lu(1887) * b(113) + b(92) = b(92) - lu(1886) * b(113) + b(91) = b(91) - lu(1885) * b(113) + b(90) = b(90) - lu(1884) * b(113) + b(89) = b(89) - lu(1883) * b(113) + b(88) = b(88) - lu(1882) * b(113) + b(87) = b(87) - lu(1881) * b(113) + b(86) = b(86) - lu(1880) * b(113) + b(85) = b(85) - lu(1879) * b(113) + b(84) = b(84) - lu(1878) * b(113) + b(83) = b(83) - lu(1877) * b(113) + b(82) = b(82) - lu(1876) * b(113) + b(79) = b(79) - lu(1875) * b(113) + b(78) = b(78) - lu(1874) * b(113) + b(77) = b(77) - lu(1873) * b(113) + b(76) = b(76) - lu(1872) * b(113) + b(72) = b(72) - lu(1871) * b(113) + b(71) = b(71) - lu(1870) * b(113) + b(70) = b(70) - lu(1869) * b(113) + b(69) = b(69) - lu(1868) * b(113) + b(68) = b(68) - lu(1867) * b(113) + b(66) = b(66) - lu(1866) * b(113) + b(64) = b(64) - lu(1865) * b(113) + b(47) = b(47) - lu(1864) * b(113) + b(46) = b(46) - lu(1863) * b(113) + b(40) = b(40) - lu(1862) * b(113) + b(112) = b(112) * lu(1860) + b(111) = b(111) - lu(1859) * b(112) + b(110) = b(110) - lu(1858) * b(112) + b(109) = b(109) - lu(1857) * b(112) + b(108) = b(108) - lu(1856) * b(112) + b(107) = b(107) - lu(1855) * b(112) + b(106) = b(106) - lu(1854) * b(112) + b(105) = b(105) - lu(1853) * b(112) + b(104) = b(104) - lu(1852) * b(112) + b(103) = b(103) - lu(1851) * b(112) + b(102) = b(102) - lu(1850) * b(112) + b(101) = b(101) - lu(1849) * b(112) + b(100) = b(100) - lu(1848) * b(112) + b(99) = b(99) - lu(1847) * b(112) + b(98) = b(98) - lu(1846) * b(112) + b(97) = b(97) - lu(1845) * b(112) + b(96) = b(96) - lu(1844) * b(112) + b(95) = b(95) - lu(1843) * b(112) + b(94) = b(94) - lu(1842) * b(112) + b(93) = b(93) - lu(1841) * b(112) + b(92) = b(92) - lu(1840) * b(112) + b(91) = b(91) - lu(1839) * b(112) + b(90) = b(90) - lu(1838) * b(112) + b(89) = b(89) - lu(1837) * b(112) + b(88) = b(88) - lu(1836) * b(112) + b(87) = b(87) - lu(1835) * b(112) + b(86) = b(86) - lu(1834) * b(112) + b(85) = b(85) - lu(1833) * b(112) + b(84) = b(84) - lu(1832) * b(112) + b(83) = b(83) - lu(1831) * b(112) + b(82) = b(82) - lu(1830) * b(112) + b(81) = b(81) - lu(1829) * b(112) + b(80) = b(80) - lu(1828) * b(112) + b(73) = b(73) - lu(1827) * b(112) + b(63) = b(63) - lu(1826) * b(112) + b(60) = b(60) - lu(1825) * b(112) + b(59) = b(59) - lu(1824) * b(112) + b(56) = b(56) - lu(1823) * b(112) + b(50) = b(50) - lu(1822) * b(112) + b(43) = b(43) - lu(1821) * b(112) + b(24) = b(24) - lu(1820) * b(112) + b(111) = b(111) * lu(1817) + b(110) = b(110) - lu(1816) * b(111) + b(109) = b(109) - lu(1815) * b(111) + b(108) = b(108) - lu(1814) * b(111) + b(107) = b(107) - lu(1813) * b(111) + b(106) = b(106) - lu(1812) * b(111) + b(105) = b(105) - lu(1811) * b(111) + b(104) = b(104) - lu(1810) * b(111) + b(103) = b(103) - lu(1809) * b(111) + b(102) = b(102) - lu(1808) * b(111) + b(101) = b(101) - lu(1807) * b(111) + b(100) = b(100) - lu(1806) * b(111) + b(99) = b(99) - lu(1805) * b(111) + b(98) = b(98) - lu(1804) * b(111) + b(97) = b(97) - lu(1803) * b(111) + b(96) = b(96) - lu(1802) * b(111) + b(95) = b(95) - lu(1801) * b(111) + b(94) = b(94) - lu(1800) * b(111) + b(93) = b(93) - lu(1799) * b(111) + b(92) = b(92) - lu(1798) * b(111) + b(91) = b(91) - lu(1797) * b(111) + b(90) = b(90) - lu(1796) * b(111) + b(89) = b(89) - lu(1795) * b(111) + b(88) = b(88) - lu(1794) * b(111) + b(87) = b(87) - lu(1793) * b(111) + b(86) = b(86) - lu(1792) * b(111) + b(85) = b(85) - lu(1791) * b(111) + b(84) = b(84) - lu(1790) * b(111) + b(83) = b(83) - lu(1789) * b(111) + b(74) = b(74) - lu(1788) * b(111) + b(65) = b(65) - lu(1787) * b(111) + b(61) = b(61) - lu(1786) * b(111) + b(60) = b(60) - lu(1785) * b(111) + b(42) = b(42) - lu(1784) * b(111) + b(110) = b(110) * lu(1780) + b(109) = b(109) - lu(1779) * b(110) + b(108) = b(108) - lu(1778) * b(110) + b(107) = b(107) - lu(1777) * b(110) + b(106) = b(106) - lu(1776) * b(110) + b(105) = b(105) - lu(1775) * b(110) + b(104) = b(104) - lu(1774) * b(110) + b(103) = b(103) - lu(1773) * b(110) + b(102) = b(102) - lu(1772) * b(110) + b(101) = b(101) - lu(1771) * b(110) + b(100) = b(100) - lu(1770) * b(110) + b(99) = b(99) - lu(1769) * b(110) + b(98) = b(98) - lu(1768) * b(110) + b(97) = b(97) - lu(1767) * b(110) + b(96) = b(96) - lu(1766) * b(110) + b(95) = b(95) - lu(1765) * b(110) + b(94) = b(94) - lu(1764) * b(110) + b(93) = b(93) - lu(1763) * b(110) + b(92) = b(92) - lu(1762) * b(110) + b(91) = b(91) - lu(1761) * b(110) + b(90) = b(90) - lu(1760) * b(110) + b(89) = b(89) - lu(1759) * b(110) + b(88) = b(88) - lu(1758) * b(110) + b(87) = b(87) - lu(1757) * b(110) + b(86) = b(86) - lu(1756) * b(110) + b(85) = b(85) - lu(1755) * b(110) + b(84) = b(84) - lu(1754) * b(110) + b(83) = b(83) - lu(1753) * b(110) + b(82) = b(82) - lu(1752) * b(110) + b(79) = b(79) - lu(1751) * b(110) + b(78) = b(78) - lu(1750) * b(110) + b(77) = b(77) - lu(1749) * b(110) + b(76) = b(76) - lu(1748) * b(110) + b(72) = b(72) - lu(1747) * b(110) + b(71) = b(71) - lu(1746) * b(110) + b(70) = b(70) - lu(1745) * b(110) + b(69) = b(69) - lu(1744) * b(110) + b(68) = b(68) - lu(1743) * b(110) + b(66) = b(66) - lu(1742) * b(110) + b(65) = b(65) - lu(1741) * b(110) + b(64) = b(64) - lu(1740) * b(110) + b(54) = b(54) - lu(1739) * b(110) + b(49) = b(49) - lu(1738) * b(110) + b(109) = b(109) * lu(1733) + b(108) = b(108) - lu(1732) * b(109) + b(107) = b(107) - lu(1731) * b(109) + b(106) = b(106) - lu(1730) * b(109) + b(105) = b(105) - lu(1729) * b(109) + b(104) = b(104) - lu(1728) * b(109) + b(103) = b(103) - lu(1727) * b(109) + b(102) = b(102) - lu(1726) * b(109) + b(101) = b(101) - lu(1725) * b(109) + b(100) = b(100) - lu(1724) * b(109) + b(99) = b(99) - lu(1723) * b(109) + b(98) = b(98) - lu(1722) * b(109) + b(97) = b(97) - lu(1721) * b(109) + b(96) = b(96) - lu(1720) * b(109) + b(95) = b(95) - lu(1719) * b(109) + b(94) = b(94) - lu(1718) * b(109) + b(93) = b(93) - lu(1717) * b(109) + b(92) = b(92) - lu(1716) * b(109) + b(91) = b(91) - lu(1715) * b(109) + b(90) = b(90) - lu(1714) * b(109) + b(89) = b(89) - lu(1713) * b(109) + b(88) = b(88) - lu(1712) * b(109) + b(87) = b(87) - lu(1711) * b(109) + b(86) = b(86) - lu(1710) * b(109) + b(85) = b(85) - lu(1709) * b(109) + b(83) = b(83) - lu(1708) * b(109) + b(82) = b(82) - lu(1707) * b(109) + b(81) = b(81) - lu(1706) * b(109) + b(80) = b(80) - lu(1705) * b(109) + b(79) = b(79) - lu(1704) * b(109) + b(76) = b(76) - lu(1703) * b(109) + b(73) = b(73) - lu(1702) * b(109) + b(72) = b(72) - lu(1701) * b(109) + b(63) = b(63) - lu(1700) * b(109) + b(53) = b(53) - lu(1699) * b(109) + b(27) = b(27) - lu(1698) * b(109) + b(108) = b(108) * lu(1692) + b(107) = b(107) - lu(1691) * b(108) + b(106) = b(106) - lu(1690) * b(108) + b(105) = b(105) - lu(1689) * b(108) + b(104) = b(104) - lu(1688) * b(108) + b(103) = b(103) - lu(1687) * b(108) + b(102) = b(102) - lu(1686) * b(108) + b(101) = b(101) - lu(1685) * b(108) + b(100) = b(100) - lu(1684) * b(108) + b(99) = b(99) - lu(1683) * b(108) + b(98) = b(98) - lu(1682) * b(108) + b(97) = b(97) - lu(1681) * b(108) + b(96) = b(96) - lu(1680) * b(108) + b(95) = b(95) - lu(1679) * b(108) + b(94) = b(94) - lu(1678) * b(108) + b(93) = b(93) - lu(1677) * b(108) + b(92) = b(92) - lu(1676) * b(108) + b(91) = b(91) - lu(1675) * b(108) + b(90) = b(90) - lu(1674) * b(108) + b(89) = b(89) - lu(1673) * b(108) + b(88) = b(88) - lu(1672) * b(108) + b(87) = b(87) - lu(1671) * b(108) + b(86) = b(86) - lu(1670) * b(108) + b(85) = b(85) - lu(1669) * b(108) + b(84) = b(84) - lu(1668) * b(108) + b(83) = b(83) - lu(1667) * b(108) + b(79) = b(79) - lu(1666) * b(108) + b(78) = b(78) - lu(1665) * b(108) + b(77) = b(77) - lu(1664) * b(108) + b(76) = b(76) - lu(1663) * b(108) + b(72) = b(72) - lu(1662) * b(108) + b(71) = b(71) - lu(1661) * b(108) + b(70) = b(70) - lu(1660) * b(108) + b(69) = b(69) - lu(1659) * b(108) + b(68) = b(68) - lu(1658) * b(108) + b(66) = b(66) - lu(1657) * b(108) + b(62) = b(62) - lu(1656) * b(108) + b(28) = b(28) - lu(1655) * b(108) + end subroutine lu_slv06 + subroutine lu_slv07( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(107) = b(107) * lu(1648) + b(106) = b(106) - lu(1647) * b(107) + b(105) = b(105) - lu(1646) * b(107) + b(104) = b(104) - lu(1645) * b(107) + b(103) = b(103) - lu(1644) * b(107) + b(102) = b(102) - lu(1643) * b(107) + b(101) = b(101) - lu(1642) * b(107) + b(100) = b(100) - lu(1641) * b(107) + b(99) = b(99) - lu(1640) * b(107) + b(98) = b(98) - lu(1639) * b(107) + b(97) = b(97) - lu(1638) * b(107) + b(96) = b(96) - lu(1637) * b(107) + b(95) = b(95) - lu(1636) * b(107) + b(94) = b(94) - lu(1635) * b(107) + b(93) = b(93) - lu(1634) * b(107) + b(92) = b(92) - lu(1633) * b(107) + b(91) = b(91) - lu(1632) * b(107) + b(90) = b(90) - lu(1631) * b(107) + b(88) = b(88) - lu(1630) * b(107) + b(87) = b(87) - lu(1629) * b(107) + b(86) = b(86) - lu(1628) * b(107) + b(85) = b(85) - lu(1627) * b(107) + b(82) = b(82) - lu(1626) * b(107) + b(81) = b(81) - lu(1625) * b(107) + b(80) = b(80) - lu(1624) * b(107) + b(79) = b(79) - lu(1623) * b(107) + b(77) = b(77) - lu(1622) * b(107) + b(76) = b(76) - lu(1621) * b(107) + b(75) = b(75) - lu(1620) * b(107) + b(73) = b(73) - lu(1619) * b(107) + b(67) = b(67) - lu(1618) * b(107) + b(62) = b(62) - lu(1617) * b(107) + b(58) = b(58) - lu(1616) * b(107) + b(50) = b(50) - lu(1615) * b(107) + b(31) = b(31) - lu(1614) * b(107) + b(106) = b(106) * lu(1606) + b(105) = b(105) - lu(1605) * b(106) + b(104) = b(104) - lu(1604) * b(106) + b(103) = b(103) - lu(1603) * b(106) + b(102) = b(102) - lu(1602) * b(106) + b(101) = b(101) - lu(1601) * b(106) + b(100) = b(100) - lu(1600) * b(106) + b(99) = b(99) - lu(1599) * b(106) + b(98) = b(98) - lu(1598) * b(106) + b(97) = b(97) - lu(1597) * b(106) + b(96) = b(96) - lu(1596) * b(106) + b(95) = b(95) - lu(1595) * b(106) + b(94) = b(94) - lu(1594) * b(106) + b(93) = b(93) - lu(1593) * b(106) + b(92) = b(92) - lu(1592) * b(106) + b(91) = b(91) - lu(1591) * b(106) + b(90) = b(90) - lu(1590) * b(106) + b(89) = b(89) - lu(1589) * b(106) + b(88) = b(88) - lu(1588) * b(106) + b(87) = b(87) - lu(1587) * b(106) + b(86) = b(86) - lu(1586) * b(106) + b(85) = b(85) - lu(1585) * b(106) + b(84) = b(84) - lu(1584) * b(106) + b(83) = b(83) - lu(1583) * b(106) + b(82) = b(82) - lu(1582) * b(106) + b(81) = b(81) - lu(1581) * b(106) + b(80) = b(80) - lu(1580) * b(106) + b(75) = b(75) - lu(1579) * b(106) + b(73) = b(73) - lu(1578) * b(106) + b(67) = b(67) - lu(1577) * b(106) + b(63) = b(63) - lu(1576) * b(106) + b(60) = b(60) - lu(1575) * b(106) + b(59) = b(59) - lu(1574) * b(106) + b(58) = b(58) - lu(1573) * b(106) + b(56) = b(56) - lu(1572) * b(106) + b(33) = b(33) - lu(1571) * b(106) + b(26) = b(26) - lu(1570) * b(106) + b(24) = b(24) - lu(1569) * b(106) + b(21) = b(21) - lu(1568) * b(106) + b(105) = b(105) * lu(1559) + b(104) = b(104) - lu(1558) * b(105) + b(103) = b(103) - lu(1557) * b(105) + b(102) = b(102) - lu(1556) * b(105) + b(101) = b(101) - lu(1555) * b(105) + b(100) = b(100) - lu(1554) * b(105) + b(99) = b(99) - lu(1553) * b(105) + b(98) = b(98) - lu(1552) * b(105) + b(97) = b(97) - lu(1551) * b(105) + b(96) = b(96) - lu(1550) * b(105) + b(95) = b(95) - lu(1549) * b(105) + b(94) = b(94) - lu(1548) * b(105) + b(93) = b(93) - lu(1547) * b(105) + b(92) = b(92) - lu(1546) * b(105) + b(91) = b(91) - lu(1545) * b(105) + b(90) = b(90) - lu(1544) * b(105) + b(89) = b(89) - lu(1543) * b(105) + b(88) = b(88) - lu(1542) * b(105) + b(87) = b(87) - lu(1541) * b(105) + b(86) = b(86) - lu(1540) * b(105) + b(85) = b(85) - lu(1539) * b(105) + b(83) = b(83) - lu(1538) * b(105) + b(82) = b(82) - lu(1537) * b(105) + b(81) = b(81) - lu(1536) * b(105) + b(79) = b(79) - lu(1535) * b(105) + b(78) = b(78) - lu(1534) * b(105) + b(77) = b(77) - lu(1533) * b(105) + b(76) = b(76) - lu(1532) * b(105) + b(75) = b(75) - lu(1531) * b(105) + b(74) = b(74) - lu(1530) * b(105) + b(67) = b(67) - lu(1529) * b(105) + b(64) = b(64) - lu(1528) * b(105) + b(62) = b(62) - lu(1527) * b(105) + b(59) = b(59) - lu(1526) * b(105) + b(58) = b(58) - lu(1525) * b(105) + b(52) = b(52) - lu(1524) * b(105) + b(41) = b(41) - lu(1523) * b(105) + b(39) = b(39) - lu(1522) * b(105) + b(104) = b(104) * lu(1512) + b(103) = b(103) - lu(1511) * b(104) + b(102) = b(102) - lu(1510) * b(104) + b(101) = b(101) - lu(1509) * b(104) + b(100) = b(100) - lu(1508) * b(104) + b(99) = b(99) - lu(1507) * b(104) + b(98) = b(98) - lu(1506) * b(104) + b(97) = b(97) - lu(1505) * b(104) + b(96) = b(96) - lu(1504) * b(104) + b(95) = b(95) - lu(1503) * b(104) + b(94) = b(94) - lu(1502) * b(104) + b(93) = b(93) - lu(1501) * b(104) + b(92) = b(92) - lu(1500) * b(104) + b(91) = b(91) - lu(1499) * b(104) + b(90) = b(90) - lu(1498) * b(104) + b(89) = b(89) - lu(1497) * b(104) + b(88) = b(88) - lu(1496) * b(104) + b(87) = b(87) - lu(1495) * b(104) + b(86) = b(86) - lu(1494) * b(104) + b(85) = b(85) - lu(1493) * b(104) + b(83) = b(83) - lu(1492) * b(104) + b(82) = b(82) - lu(1491) * b(104) + b(81) = b(81) - lu(1490) * b(104) + b(80) = b(80) - lu(1489) * b(104) + b(79) = b(79) - lu(1488) * b(104) + b(78) = b(78) - lu(1487) * b(104) + b(75) = b(75) - lu(1486) * b(104) + b(74) = b(74) - lu(1485) * b(104) + b(73) = b(73) - lu(1484) * b(104) + b(71) = b(71) - lu(1483) * b(104) + b(64) = b(64) - lu(1482) * b(104) + b(63) = b(63) - lu(1481) * b(104) + b(60) = b(60) - lu(1480) * b(104) + b(51) = b(51) - lu(1479) * b(104) + b(103) = b(103) * lu(1468) + b(102) = b(102) - lu(1467) * b(103) + b(101) = b(101) - lu(1466) * b(103) + b(100) = b(100) - lu(1465) * b(103) + b(99) = b(99) - lu(1464) * b(103) + b(98) = b(98) - lu(1463) * b(103) + b(97) = b(97) - lu(1462) * b(103) + b(96) = b(96) - lu(1461) * b(103) + b(95) = b(95) - lu(1460) * b(103) + b(94) = b(94) - lu(1459) * b(103) + b(93) = b(93) - lu(1458) * b(103) + b(92) = b(92) - lu(1457) * b(103) + b(91) = b(91) - lu(1456) * b(103) + b(90) = b(90) - lu(1455) * b(103) + b(89) = b(89) - lu(1454) * b(103) + b(88) = b(88) - lu(1453) * b(103) + b(87) = b(87) - lu(1452) * b(103) + b(86) = b(86) - lu(1451) * b(103) + b(85) = b(85) - lu(1450) * b(103) + b(84) = b(84) - lu(1449) * b(103) + b(83) = b(83) - lu(1448) * b(103) + b(79) = b(79) - lu(1447) * b(103) + b(78) = b(78) - lu(1446) * b(103) + b(77) = b(77) - lu(1445) * b(103) + b(76) = b(76) - lu(1444) * b(103) + b(72) = b(72) - lu(1443) * b(103) + b(71) = b(71) - lu(1442) * b(103) + b(70) = b(70) - lu(1441) * b(103) + b(69) = b(69) - lu(1440) * b(103) + b(68) = b(68) - lu(1439) * b(103) + b(66) = b(66) - lu(1438) * b(103) + b(62) = b(62) - lu(1437) * b(103) + b(29) = b(29) - lu(1436) * b(103) + b(102) = b(102) * lu(1424) + b(101) = b(101) - lu(1423) * b(102) + b(100) = b(100) - lu(1422) * b(102) + b(99) = b(99) - lu(1421) * b(102) + b(98) = b(98) - lu(1420) * b(102) + b(97) = b(97) - lu(1419) * b(102) + b(96) = b(96) - lu(1418) * b(102) + b(95) = b(95) - lu(1417) * b(102) + b(94) = b(94) - lu(1416) * b(102) + b(93) = b(93) - lu(1415) * b(102) + b(92) = b(92) - lu(1414) * b(102) + b(91) = b(91) - lu(1413) * b(102) + b(90) = b(90) - lu(1412) * b(102) + b(89) = b(89) - lu(1411) * b(102) + b(88) = b(88) - lu(1410) * b(102) + b(87) = b(87) - lu(1409) * b(102) + b(86) = b(86) - lu(1408) * b(102) + b(85) = b(85) - lu(1407) * b(102) + b(84) = b(84) - lu(1406) * b(102) + b(74) = b(74) - lu(1405) * b(102) + b(66) = b(66) - lu(1404) * b(102) + b(65) = b(65) - lu(1403) * b(102) + b(64) = b(64) - lu(1402) * b(102) + b(61) = b(61) - lu(1401) * b(102) + b(57) = b(57) - lu(1400) * b(102) + b(50) = b(50) - lu(1399) * b(102) + b(47) = b(47) - lu(1398) * b(102) + b(46) = b(46) - lu(1397) * b(102) + b(42) = b(42) - lu(1396) * b(102) + b(32) = b(32) - lu(1395) * b(102) + end subroutine lu_slv07 + subroutine lu_slv08( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(101) = b(101) * lu(1382) + b(100) = b(100) - lu(1381) * b(101) + b(99) = b(99) - lu(1380) * b(101) + b(98) = b(98) - lu(1379) * b(101) + b(97) = b(97) - lu(1378) * b(101) + b(96) = b(96) - lu(1377) * b(101) + b(95) = b(95) - lu(1376) * b(101) + b(94) = b(94) - lu(1375) * b(101) + b(93) = b(93) - lu(1374) * b(101) + b(92) = b(92) - lu(1373) * b(101) + b(91) = b(91) - lu(1372) * b(101) + b(90) = b(90) - lu(1371) * b(101) + b(89) = b(89) - lu(1370) * b(101) + b(88) = b(88) - lu(1369) * b(101) + b(87) = b(87) - lu(1368) * b(101) + b(86) = b(86) - lu(1367) * b(101) + b(85) = b(85) - lu(1366) * b(101) + b(84) = b(84) - lu(1365) * b(101) + b(83) = b(83) - lu(1364) * b(101) + b(79) = b(79) - lu(1363) * b(101) + b(78) = b(78) - lu(1362) * b(101) + b(77) = b(77) - lu(1361) * b(101) + b(76) = b(76) - lu(1360) * b(101) + b(72) = b(72) - lu(1359) * b(101) + b(71) = b(71) - lu(1358) * b(101) + b(70) = b(70) - lu(1357) * b(101) + b(69) = b(69) - lu(1356) * b(101) + b(68) = b(68) - lu(1355) * b(101) + b(66) = b(66) - lu(1354) * b(101) + b(54) = b(54) - lu(1353) * b(101) + b(44) = b(44) - lu(1352) * b(101) + b(100) = b(100) * lu(1338) + b(99) = b(99) - lu(1337) * b(100) + b(98) = b(98) - lu(1336) * b(100) + b(97) = b(97) - lu(1335) * b(100) + b(96) = b(96) - lu(1334) * b(100) + b(95) = b(95) - lu(1333) * b(100) + b(94) = b(94) - lu(1332) * b(100) + b(93) = b(93) - lu(1331) * b(100) + b(92) = b(92) - lu(1330) * b(100) + b(91) = b(91) - lu(1329) * b(100) + b(90) = b(90) - lu(1328) * b(100) + b(89) = b(89) - lu(1327) * b(100) + b(88) = b(88) - lu(1326) * b(100) + b(87) = b(87) - lu(1325) * b(100) + b(86) = b(86) - lu(1324) * b(100) + b(85) = b(85) - lu(1323) * b(100) + b(83) = b(83) - lu(1322) * b(100) + b(82) = b(82) - lu(1321) * b(100) + b(81) = b(81) - lu(1320) * b(100) + b(80) = b(80) - lu(1319) * b(100) + b(79) = b(79) - lu(1318) * b(100) + b(78) = b(78) - lu(1317) * b(100) + b(77) = b(77) - lu(1316) * b(100) + b(75) = b(75) - lu(1315) * b(100) + b(73) = b(73) - lu(1314) * b(100) + b(71) = b(71) - lu(1313) * b(100) + b(70) = b(70) - lu(1312) * b(100) + b(68) = b(68) - lu(1311) * b(100) + b(67) = b(67) - lu(1310) * b(100) + b(65) = b(65) - lu(1309) * b(100) + b(63) = b(63) - lu(1308) * b(100) + b(58) = b(58) - lu(1307) * b(100) + b(54) = b(54) - lu(1306) * b(100) + b(53) = b(53) - lu(1305) * b(100) + b(51) = b(51) - lu(1304) * b(100) + b(49) = b(49) - lu(1303) * b(100) + b(47) = b(47) - lu(1302) * b(100) + b(46) = b(46) - lu(1301) * b(100) + b(44) = b(44) - lu(1300) * b(100) + b(36) = b(36) - lu(1299) * b(100) + b(35) = b(35) - lu(1298) * b(100) + b(30) = b(30) - lu(1297) * b(100) + b(29) = b(29) - lu(1296) * b(100) + b(28) = b(28) - lu(1295) * b(100) + b(27) = b(27) - lu(1294) * b(100) + b(23) = b(23) - lu(1293) * b(100) + b(99) = b(99) * lu(1278) + b(98) = b(98) - lu(1277) * b(99) + b(97) = b(97) - lu(1276) * b(99) + b(96) = b(96) - lu(1275) * b(99) + b(95) = b(95) - lu(1274) * b(99) + b(94) = b(94) - lu(1273) * b(99) + b(93) = b(93) - lu(1272) * b(99) + b(92) = b(92) - lu(1271) * b(99) + b(91) = b(91) - lu(1270) * b(99) + b(90) = b(90) - lu(1269) * b(99) + b(89) = b(89) - lu(1268) * b(99) + b(88) = b(88) - lu(1267) * b(99) + b(87) = b(87) - lu(1266) * b(99) + b(86) = b(86) - lu(1265) * b(99) + b(85) = b(85) - lu(1264) * b(99) + b(83) = b(83) - lu(1263) * b(99) + b(82) = b(82) - lu(1262) * b(99) + b(81) = b(81) - lu(1261) * b(99) + b(80) = b(80) - lu(1260) * b(99) + b(74) = b(74) - lu(1259) * b(99) + b(65) = b(65) - lu(1258) * b(99) + b(61) = b(61) - lu(1257) * b(99) + b(98) = b(98) * lu(1241) + b(97) = b(97) - lu(1240) * b(98) + b(96) = b(96) - lu(1239) * b(98) + b(95) = b(95) - lu(1238) * b(98) + b(94) = b(94) - lu(1237) * b(98) + b(93) = b(93) - lu(1236) * b(98) + b(92) = b(92) - lu(1235) * b(98) + b(91) = b(91) - lu(1234) * b(98) + b(90) = b(90) - lu(1233) * b(98) + b(89) = b(89) - lu(1232) * b(98) + b(88) = b(88) - lu(1231) * b(98) + b(87) = b(87) - lu(1230) * b(98) + b(86) = b(86) - lu(1229) * b(98) + b(85) = b(85) - lu(1228) * b(98) + b(84) = b(84) - lu(1227) * b(98) + b(83) = b(83) - lu(1226) * b(98) + b(79) = b(79) - lu(1225) * b(98) + b(78) = b(78) - lu(1224) * b(98) + b(77) = b(77) - lu(1223) * b(98) + b(76) = b(76) - lu(1222) * b(98) + b(72) = b(72) - lu(1221) * b(98) + b(71) = b(71) - lu(1220) * b(98) + b(70) = b(70) - lu(1219) * b(98) + b(69) = b(69) - lu(1218) * b(98) + b(68) = b(68) - lu(1217) * b(98) + b(66) = b(66) - lu(1216) * b(98) + b(54) = b(54) - lu(1215) * b(98) + b(97) = b(97) * lu(1198) + b(96) = b(96) - lu(1197) * b(97) + b(95) = b(95) - lu(1196) * b(97) + b(94) = b(94) - lu(1195) * b(97) + b(93) = b(93) - lu(1194) * b(97) + b(92) = b(92) - lu(1193) * b(97) + b(91) = b(91) - lu(1192) * b(97) + b(90) = b(90) - lu(1191) * b(97) + b(89) = b(89) - lu(1190) * b(97) + b(88) = b(88) - lu(1189) * b(97) + b(87) = b(87) - lu(1188) * b(97) + b(86) = b(86) - lu(1187) * b(97) + b(85) = b(85) - lu(1186) * b(97) + b(84) = b(84) - lu(1185) * b(97) + b(82) = b(82) - lu(1184) * b(97) + b(81) = b(81) - lu(1183) * b(97) + b(75) = b(75) - lu(1182) * b(97) + b(74) = b(74) - lu(1181) * b(97) + b(67) = b(67) - lu(1180) * b(97) + b(65) = b(65) - lu(1179) * b(97) + b(64) = b(64) - lu(1178) * b(97) + b(61) = b(61) - lu(1177) * b(97) + b(58) = b(58) - lu(1176) * b(97) + b(57) = b(57) - lu(1175) * b(97) + b(48) = b(48) - lu(1174) * b(97) + b(45) = b(45) - lu(1173) * b(97) + b(42) = b(42) - lu(1172) * b(97) + b(40) = b(40) - lu(1171) * b(97) + b(38) = b(38) - lu(1170) * b(97) + b(32) = b(32) - lu(1169) * b(97) + b(96) = b(96) * lu(1151) + b(95) = b(95) - lu(1150) * b(96) + b(94) = b(94) - lu(1149) * b(96) + b(93) = b(93) - lu(1148) * b(96) + b(92) = b(92) - lu(1147) * b(96) + b(91) = b(91) - lu(1146) * b(96) + b(90) = b(90) - lu(1145) * b(96) + b(88) = b(88) - lu(1144) * b(96) + b(86) = b(86) - lu(1143) * b(96) + b(82) = b(82) - lu(1142) * b(96) + b(65) = b(65) - lu(1141) * b(96) + b(64) = b(64) - lu(1140) * b(96) + b(57) = b(57) - lu(1139) * b(96) + b(54) = b(54) - lu(1138) * b(96) + b(51) = b(51) - lu(1137) * b(96) + b(49) = b(49) - lu(1136) * b(96) + b(47) = b(47) - lu(1135) * b(96) + b(46) = b(46) - lu(1134) * b(96) + b(45) = b(45) - lu(1133) * b(96) + b(44) = b(44) - lu(1132) * b(96) + b(40) = b(40) - lu(1131) * b(96) + b(36) = b(36) - lu(1130) * b(96) + b(35) = b(35) - lu(1129) * b(96) + b(95) = b(95) * lu(1110) + b(94) = b(94) - lu(1109) * b(95) + b(93) = b(93) - lu(1108) * b(95) + b(92) = b(92) - lu(1107) * b(95) + b(91) = b(91) - lu(1106) * b(95) + b(90) = b(90) - lu(1105) * b(95) + b(89) = b(89) - lu(1104) * b(95) + b(88) = b(88) - lu(1103) * b(95) + b(87) = b(87) - lu(1102) * b(95) + b(86) = b(86) - lu(1101) * b(95) + b(85) = b(85) - lu(1100) * b(95) + b(84) = b(84) - lu(1099) * b(95) + b(83) = b(83) - lu(1098) * b(95) + b(82) = b(82) - lu(1097) * b(95) + b(81) = b(81) - lu(1096) * b(95) + b(80) = b(80) - lu(1095) * b(95) + b(75) = b(75) - lu(1094) * b(95) + b(74) = b(74) - lu(1093) * b(95) + b(73) = b(73) - lu(1092) * b(95) + b(67) = b(67) - lu(1091) * b(95) + b(65) = b(65) - lu(1090) * b(95) + b(64) = b(64) - lu(1089) * b(95) + b(61) = b(61) - lu(1088) * b(95) + b(60) = b(60) - lu(1087) * b(95) + b(59) = b(59) - lu(1086) * b(95) + b(58) = b(58) - lu(1085) * b(95) + b(57) = b(57) - lu(1084) * b(95) + b(56) = b(56) - lu(1083) * b(95) + b(55) = b(55) - lu(1082) * b(95) + b(52) = b(52) - lu(1081) * b(95) + b(50) = b(50) - lu(1080) * b(95) + b(48) = b(48) - lu(1079) * b(95) + b(45) = b(45) - lu(1078) * b(95) + b(43) = b(43) - lu(1077) * b(95) + b(42) = b(42) - lu(1076) * b(95) + b(41) = b(41) - lu(1075) * b(95) + b(40) = b(40) - lu(1074) * b(95) + b(38) = b(38) - lu(1073) * b(95) + b(34) = b(34) - lu(1072) * b(95) + b(32) = b(32) - lu(1071) * b(95) + end subroutine lu_slv08 + subroutine lu_slv09( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(94) = b(94) * lu(1051) + b(93) = b(93) - lu(1050) * b(94) + b(92) = b(92) - lu(1049) * b(94) + b(91) = b(91) - lu(1048) * b(94) + b(90) = b(90) - lu(1047) * b(94) + b(89) = b(89) - lu(1046) * b(94) + b(88) = b(88) - lu(1045) * b(94) + b(87) = b(87) - lu(1044) * b(94) + b(86) = b(86) - lu(1043) * b(94) + b(85) = b(85) - lu(1042) * b(94) + b(84) = b(84) - lu(1041) * b(94) + b(82) = b(82) - lu(1040) * b(94) + b(81) = b(81) - lu(1039) * b(94) + b(75) = b(75) - lu(1038) * b(94) + b(74) = b(74) - lu(1037) * b(94) + b(67) = b(67) - lu(1036) * b(94) + b(65) = b(65) - lu(1035) * b(94) + b(61) = b(61) - lu(1034) * b(94) + b(58) = b(58) - lu(1033) * b(94) + b(48) = b(48) - lu(1032) * b(94) + b(32) = b(32) - lu(1031) * b(94) + b(93) = b(93) * lu(1010) + b(92) = b(92) - lu(1009) * b(93) + b(91) = b(91) - lu(1008) * b(93) + b(90) = b(90) - lu(1007) * b(93) + b(89) = b(89) - lu(1006) * b(93) + b(88) = b(88) - lu(1005) * b(93) + b(87) = b(87) - lu(1004) * b(93) + b(86) = b(86) - lu(1003) * b(93) + b(85) = b(85) - lu(1002) * b(93) + b(84) = b(84) - lu(1001) * b(93) + b(83) = b(83) - lu(1000) * b(93) + b(82) = b(82) - lu(999) * b(93) + b(81) = b(81) - lu(998) * b(93) + b(76) = b(76) - lu(997) * b(93) + b(75) = b(75) - lu(996) * b(93) + b(72) = b(72) - lu(995) * b(93) + b(70) = b(70) - lu(994) * b(93) + b(69) = b(69) - lu(993) * b(93) + b(59) = b(59) - lu(992) * b(93) + b(56) = b(56) - lu(991) * b(93) + b(52) = b(52) - lu(990) * b(93) + b(51) = b(51) - lu(989) * b(93) + b(26) = b(26) - lu(988) * b(93) + b(24) = b(24) - lu(987) * b(93) + b(92) = b(92) * lu(965) + b(91) = b(91) - lu(964) * b(92) + b(90) = b(90) - lu(963) * b(92) + b(89) = b(89) - lu(962) * b(92) + b(88) = b(88) - lu(961) * b(92) + b(87) = b(87) - lu(960) * b(92) + b(86) = b(86) - lu(959) * b(92) + b(85) = b(85) - lu(958) * b(92) + b(83) = b(83) - lu(957) * b(92) + b(74) = b(74) - lu(956) * b(92) + b(66) = b(66) - lu(955) * b(92) + b(60) = b(60) - lu(954) * b(92) + b(91) = b(91) * lu(931) + b(90) = b(90) - lu(930) * b(91) + b(89) = b(89) - lu(929) * b(91) + b(88) = b(88) - lu(928) * b(91) + b(87) = b(87) - lu(927) * b(91) + b(86) = b(86) - lu(926) * b(91) + b(85) = b(85) - lu(925) * b(91) + b(84) = b(84) - lu(924) * b(91) + b(83) = b(83) - lu(923) * b(91) + b(82) = b(82) - lu(922) * b(91) + b(81) = b(81) - lu(921) * b(91) + b(80) = b(80) - lu(920) * b(91) + b(74) = b(74) - lu(919) * b(91) + b(54) = b(54) - lu(918) * b(91) + b(51) = b(51) - lu(917) * b(91) + b(90) = b(90) * lu(893) + b(89) = b(89) - lu(892) * b(90) + b(88) = b(88) - lu(891) * b(90) + b(87) = b(87) - lu(890) * b(90) + b(86) = b(86) - lu(889) * b(90) + b(85) = b(85) - lu(888) * b(90) + b(84) = b(84) - lu(887) * b(90) + b(83) = b(83) - lu(886) * b(90) + b(79) = b(79) - lu(885) * b(90) + b(78) = b(78) - lu(884) * b(90) + b(77) = b(77) - lu(883) * b(90) + b(76) = b(76) - lu(882) * b(90) + b(72) = b(72) - lu(881) * b(90) + b(71) = b(71) - lu(880) * b(90) + b(70) = b(70) - lu(879) * b(90) + b(69) = b(69) - lu(878) * b(90) + b(68) = b(68) - lu(877) * b(90) + b(66) = b(66) - lu(876) * b(90) + b(51) = b(51) - lu(875) * b(90) + b(36) = b(36) - lu(874) * b(90) + b(89) = b(89) * lu(849) + b(88) = b(88) - lu(848) * b(89) + b(87) = b(87) - lu(847) * b(89) + b(85) = b(85) - lu(846) * b(89) + b(83) = b(83) - lu(845) * b(89) + b(79) = b(79) - lu(844) * b(89) + b(78) = b(78) - lu(843) * b(89) + b(74) = b(74) - lu(842) * b(89) + b(60) = b(60) - lu(841) * b(89) + b(88) = b(88) * lu(819) + b(86) = b(86) - lu(818) * b(88) + b(82) = b(82) - lu(817) * b(88) + b(81) = b(81) - lu(816) * b(88) + b(80) = b(80) - lu(815) * b(88) + b(75) = b(75) - lu(814) * b(88) + b(73) = b(73) - lu(813) * b(88) + b(67) = b(67) - lu(812) * b(88) + b(64) = b(64) - lu(811) * b(88) + b(63) = b(63) - lu(810) * b(88) + b(59) = b(59) - lu(809) * b(88) + b(58) = b(58) - lu(808) * b(88) + b(56) = b(56) - lu(807) * b(88) + b(55) = b(55) - lu(806) * b(88) + b(54) = b(54) - lu(805) * b(88) + b(53) = b(53) - lu(804) * b(88) + b(51) = b(51) - lu(803) * b(88) + b(50) = b(50) - lu(802) * b(88) + b(48) = b(48) - lu(801) * b(88) + b(43) = b(43) - lu(800) * b(88) + b(39) = b(39) - lu(799) * b(88) + b(37) = b(37) - lu(798) * b(88) + b(34) = b(34) - lu(797) * b(88) + b(31) = b(31) - lu(796) * b(88) + b(30) = b(30) - lu(795) * b(88) + b(25) = b(25) - lu(794) * b(88) + b(22) = b(22) - lu(793) * b(88) + b(87) = b(87) * lu(770) + b(85) = b(85) - lu(769) * b(87) + b(83) = b(83) - lu(768) * b(87) + b(71) = b(71) - lu(767) * b(87) + b(51) = b(51) - lu(766) * b(87) + b(86) = b(86) * lu(744) + b(82) = b(82) - lu(743) * b(86) + b(81) = b(81) - lu(742) * b(86) + b(80) = b(80) - lu(741) * b(86) + b(75) = b(75) - lu(740) * b(86) + b(73) = b(73) - lu(739) * b(86) + b(63) = b(63) - lu(738) * b(86) + b(56) = b(56) - lu(737) * b(86) + b(55) = b(55) - lu(736) * b(86) + b(54) = b(54) - lu(735) * b(86) + b(52) = b(52) - lu(734) * b(86) + b(43) = b(43) - lu(733) * b(86) + b(39) = b(39) - lu(732) * b(86) + b(37) = b(37) - lu(731) * b(86) + b(85) = b(85) * lu(710) + b(83) = b(83) - lu(709) * b(85) + b(79) = b(79) - lu(708) * b(85) + b(76) = b(76) - lu(707) * b(85) + b(72) = b(72) - lu(706) * b(85) + b(84) = b(84) * lu(677) + b(83) = b(83) - lu(676) * b(84) + b(74) = b(74) - lu(675) * b(84) + b(60) = b(60) - lu(674) * b(84) + b(83) = b(83) * lu(655) + b(70) = b(70) - lu(654) * b(83) + b(69) = b(69) - lu(653) * b(83) + b(82) = b(82) * lu(631) + b(81) = b(81) - lu(630) * b(82) + b(80) = b(80) - lu(629) * b(82) + b(73) = b(73) - lu(628) * b(82) + b(65) = b(65) - lu(627) * b(82) + b(63) = b(63) - lu(626) * b(82) + b(61) = b(61) - lu(625) * b(82) + b(55) = b(55) - lu(624) * b(82) + b(53) = b(53) - lu(623) * b(82) + b(32) = b(32) - lu(622) * b(82) + b(25) = b(25) - lu(621) * b(82) + b(22) = b(22) - lu(620) * b(82) + b(81) = b(81) * lu(600) + b(80) = b(80) - lu(599) * b(81) + b(75) = b(75) - lu(598) * b(81) + b(73) = b(73) - lu(597) * b(81) + b(55) = b(55) - lu(596) * b(81) + b(50) = b(50) - lu(595) * b(81) + b(80) = b(80) * lu(575) + b(73) = b(73) - lu(574) * b(80) + b(63) = b(63) - lu(573) * b(80) + b(53) = b(53) - lu(572) * b(80) + b(27) = b(27) - lu(571) * b(80) + b(79) = b(79) * lu(554) + b(77) = b(77) - lu(553) * b(79) + b(76) = b(76) - lu(552) * b(79) + b(62) = b(62) - lu(551) * b(79) + b(78) = b(78) * lu(532) + b(71) = b(71) - lu(531) * b(78) + b(68) = b(68) - lu(530) * b(78) + b(77) = b(77) * lu(512) + b(76) = b(76) - lu(511) * b(77) + b(62) = b(62) - lu(510) * b(77) + b(76) = b(76) * lu(496) + b(75) = b(75) * lu(480) + b(67) = b(67) - lu(479) * b(75) + b(58) = b(58) - lu(478) * b(75) + b(52) = b(52) - lu(477) * b(75) + b(41) = b(41) - lu(476) * b(75) + b(33) = b(33) - lu(475) * b(75) + b(26) = b(26) - lu(474) * b(75) + b(74) = b(74) * lu(459) + end subroutine lu_slv09 + subroutine lu_slv10( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(73) = b(73) * lu(445) + b(55) = b(55) - lu(444) * b(73) + b(50) = b(50) - lu(443) * b(73) + b(72) = b(72) * lu(427) + b(71) = b(71) * lu(413) + b(70) = b(70) * lu(398) + b(69) = b(69) - lu(397) * b(70) + b(69) = b(69) * lu(382) + b(68) = b(68) * lu(367) + b(67) = b(67) * lu(353) + b(58) = b(58) - lu(352) * b(67) + b(48) = b(48) - lu(351) * b(67) + b(33) = b(33) - lu(350) * b(67) + b(66) = b(66) * lu(336) + b(65) = b(65) * lu(324) + b(61) = b(61) - lu(323) * b(65) + b(54) = b(54) - lu(322) * b(65) + b(49) = b(49) - lu(321) * b(65) + b(64) = b(64) * lu(309) + b(57) = b(57) - lu(308) * b(64) + b(38) = b(38) - lu(307) * b(64) + b(63) = b(63) * lu(296) + b(37) = b(37) - lu(295) * b(63) + b(62) = b(62) * lu(283) + b(29) = b(29) - lu(282) * b(62) + b(28) = b(28) - lu(281) * b(62) + b(61) = b(61) * lu(273) + b(60) = b(60) * lu(265) + b(59) = b(59) * lu(255) + b(56) = b(56) - lu(254) * b(59) + b(24) = b(24) - lu(253) * b(59) + b(58) = b(58) * lu(247) + b(30) = b(30) - lu(246) * b(58) + b(57) = b(57) * lu(236) + b(50) = b(50) - lu(235) * b(57) + b(56) = b(56) * lu(228) + b(24) = b(24) - lu(227) * b(56) + b(55) = b(55) * lu(220) + b(54) = b(54) * lu(215) + b(44) = b(44) - lu(214) * b(54) + b(53) = b(53) * lu(206) + b(27) = b(27) - lu(205) * b(53) + b(52) = b(52) * lu(197) + b(26) = b(26) - lu(196) * b(52) + b(51) = b(51) * lu(191) + b(50) = b(50) * lu(186) + b(49) = b(49) * lu(177) + b(44) = b(44) - lu(176) * b(49) + b(35) = b(35) - lu(175) * b(49) + b(48) = b(48) * lu(168) + b(47) = b(47) * lu(161) + b(46) = b(46) * lu(153) + b(45) = b(45) * lu(143) + b(40) = b(40) - lu(142) * b(45) + b(44) = b(44) * lu(136) + b(43) = b(43) * lu(129) + b(42) = b(42) * lu(122) + b(41) = b(41) * lu(114) + b(40) = b(40) * lu(109) + b(39) = b(39) * lu(102) + b(38) = b(38) * lu(95) + b(37) = b(37) * lu(89) + b(36) = b(36) * lu(83) + b(35) = b(35) * lu(77) + b(34) = b(34) * lu(69) + b(33) = b(33) * lu(64) + b(32) = b(32) * lu(61) + b(31) = b(31) * lu(55) + b(30) = b(30) * lu(51) + b(23) = b(23) - lu(50) * b(30) + b(29) = b(29) * lu(46) + b(28) = b(28) * lu(42) + b(27) = b(27) * lu(39) + b(26) = b(26) * lu(36) + b(25) = b(25) * lu(32) + b(24) = b(24) * lu(30) + b(23) = b(23) * lu(27) + b(22) = b(22) * lu(24) + b(21) = b(21) * lu(21) + b(20) = b(20) * lu(20) + b(19) = b(19) * lu(19) + b(18) = b(18) * lu(18) + b(17) = b(17) * lu(17) + b(16) = b(16) * lu(16) + b(15) = b(15) * lu(15) + b(14) = b(14) * lu(14) + b(13) = b(13) * lu(13) + b(12) = b(12) * lu(12) + b(11) = b(11) * lu(11) + b(10) = b(10) * lu(10) + b(9) = b(9) * lu(9) + b(8) = b(8) * lu(8) + b(7) = b(7) * lu(7) + b(6) = b(6) * lu(6) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv10 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + call lu_slv05( lu, b ) + call lu_slv06( lu, b ) + call lu_slv07( lu, b ) + call lu_slv08( lu, b ) + call lu_slv09( lu, b ) + call lu_slv10( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..18d1a870e6 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 @@ -0,0 +1,2981 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1051) = -(rxt(106)*y(2) + rxt(124)*y(134) + rxt(150)*y(18) + rxt(155) & + *y(87) + rxt(163)*y(88) + rxt(178)*y(6) + rxt(181)*y(7) + rxt(193) & + *y(85) + rxt(220)*y(86) + rxt(269)*y(59) + rxt(272)*y(60) & + + rxt(315)*y(130) + rxt(374)*y(108) + rxt(377)*y(106) + rxt(388) & + *y(107) + rxt(405)*y(110) + rxt(420)*y(112) + rxt(428)*y(113) & + + rxt(434)*y(114)) + mat(1109) = -rxt(106)*y(1) + mat(637) = -rxt(124)*y(1) + mat(934) = -rxt(150)*y(1) + mat(823) = -rxt(155)*y(1) + mat(749) = -rxt(163)*y(1) + mat(1502) = -rxt(178)*y(1) + mat(1548) = -rxt(181)*y(1) + mat(1842) = -rxt(193)*y(1) + mat(607) = -rxt(220)*y(1) + mat(172) = -rxt(269)*y(1) + mat(359) = -rxt(272)*y(1) + mat(1149) = -rxt(315)*y(1) + mat(465) = -rxt(374)*y(1) + mat(1273) = -rxt(377)*y(1) + mat(1800) = -rxt(388)*y(1) + mat(967) = -rxt(405)*y(1) + mat(687) = -rxt(420)*y(1) + mat(776) = -rxt(428)*y(1) + mat(715) = -rxt(434)*y(1) + mat(1109) = mat(1109) + rxt(105)*y(3) + rxt(336)*y(91) + rxt(369)*y(107) + mat(1195) = rxt(105)*y(2) + mat(275) = rxt(366)*y(106) + mat(327) = rxt(336)*y(2) + mat(1273) = mat(1273) + rxt(366)*y(133) + mat(1800) = mat(1800) + rxt(369)*y(2) + mat(1110) = -(rxt(105)*y(3) + rxt(106)*y(1) + 4._r8*rxt(107)*y(2) + rxt(154) & + *y(87) + rxt(161)*y(17) + rxt(162)*y(88) + rxt(165)*y(19) & + + rxt(176)*y(6) + (rxt(179) + rxt(180)) * y(7) + rxt(187)*y(8) & + + rxt(200)*y(24) + rxt(213)*y(27) + rxt(214)*y(28) + rxt(217) & + *y(29) + rxt(223)*y(31) + rxt(233)*y(32) + rxt(234)*y(33) & + + rxt(235)*y(34) + rxt(257)*y(15) + rxt(265)*y(58) + (rxt(301) & + + rxt(302)) * y(89) + rxt(308)*y(127) + rxt(336)*y(91) + rxt(364) & + *y(106) + (rxt(369) + rxt(387)) * y(107) + (rxt(373) + rxt(396) & + ) * y(108) + rxt(375)*y(110) + rxt(403)*y(109) + rxt(411)*y(111) & + + rxt(422)*y(112) + rxt(433)*y(114) + rxt(443)*y(124)) + mat(1196) = -rxt(105)*y(2) + mat(1052) = -rxt(106)*y(2) + mat(824) = -rxt(154)*y(2) + mat(583) = -rxt(161)*y(2) + mat(750) = -rxt(162)*y(2) + mat(133) = -rxt(165)*y(2) + mat(1503) = -rxt(176)*y(2) + mat(1549) = -(rxt(179) + rxt(180)) * y(2) + mat(1636) = -rxt(187)*y(2) + mat(1595) = -rxt(200)*y(2) + mat(1012) = -rxt(213)*y(2) + mat(231) = -rxt(214)*y(2) + mat(258) = -rxt(217)*y(2) + mat(487) = -rxt(223)*y(2) + mat(225) = -rxt(233)*y(2) + mat(202) = -rxt(234)*y(2) + mat(118) = -rxt(235)*y(2) + mat(453) = -rxt(257)*y(2) + mat(76) = -rxt(265)*y(2) + mat(147) = -(rxt(301) + rxt(302)) * y(2) + mat(98) = -rxt(308)*y(2) + mat(328) = -rxt(336)*y(2) + mat(1274) = -rxt(364)*y(2) + mat(1801) = -(rxt(369) + rxt(387)) * y(2) + mat(466) = -(rxt(373) + rxt(396)) * y(2) + mat(968) = -rxt(375)*y(2) + mat(125) = -rxt(403)*y(2) + mat(855) = -rxt(411)*y(2) + mat(688) = -rxt(422)*y(2) + mat(716) = -rxt(433)*y(2) + mat(268) = -rxt(443)*y(2) + mat(1052) = mat(1052) + rxt(377)*y(106) + mat(638) = (rxt(119)+rxt(120))*y(3) + mat(1196) = mat(1196) + (rxt(119)+rxt(120))*y(134) + rxt(171)*y(5) + rxt(307) & + *y(127) + rxt(299)*y(128) + rxt(268)*y(59) + rxt(271)*y(60) + mat(313) = rxt(171)*y(3) + rxt(172)*y(6) + rxt(173)*y(7) + rxt(304)*y(90) + mat(1503) = mat(1503) + rxt(172)*y(5) + rxt(399)*y(108) + mat(1549) = mat(1549) + rxt(173)*y(5) + rxt(380)*y(106) + rxt(401)*y(108) + mat(824) = mat(824) + 2.000_r8*rxt(157)*y(87) + mat(935) = rxt(153)*y(88) + mat(750) = mat(750) + rxt(153)*y(18) + mat(1843) = rxt(385)*y(106) + rxt(417)*y(111) + mat(1765) = rxt(304)*y(5) + rxt(565)*y(111) + rxt(574)*y(115) + rxt(572) & + *y(116) + 1.150_r8*rxt(312)*y(130) + mat(98) = mat(98) + rxt(307)*y(3) + mat(241) = rxt(299)*y(3) + mat(1889) = rxt(549)*y(111) + rxt(558)*y(115) + rxt(556)*y(116) + rxt(311) & + *y(130) + mat(1376) = rxt(501)*y(111) + rxt(510)*y(115) + rxt(508)*y(116) + mat(1679) = (rxt(469)+rxt(580))*y(111) + (rxt(478)+rxt(590))*y(115) + ( & + + rxt(476)+rxt(588))*y(116) + mat(1460) = (rxt(485)+rxt(582))*y(111) + (rxt(494)+rxt(591))*y(115) + ( & + + rxt(492)+rxt(589))*y(116) + mat(1238) = rxt(517)*y(111) + rxt(526)*y(115) + rxt(524)*y(116) + mat(898) = rxt(533)*y(111) + rxt(542)*y(115) + rxt(540)*y(116) + mat(1274) = mat(1274) + rxt(377)*y(1) + rxt(380)*y(7) + rxt(385)*y(85) + mat(466) = mat(466) + rxt(399)*y(6) + rxt(401)*y(7) + mat(855) = mat(855) + rxt(417)*y(85) + rxt(565)*y(90) + rxt(549)*y(129) & + + rxt(501)*y(95) + (rxt(469)+rxt(580))*y(96) + (rxt(485) & + +rxt(582))*y(97) + rxt(517)*y(101) + rxt(533)*y(102) + mat(539) = rxt(574)*y(90) + rxt(558)*y(129) + rxt(510)*y(95) + (rxt(478) & + +rxt(590))*y(96) + (rxt(494)+rxt(591))*y(97) + rxt(526)*y(101) & + + rxt(542)*y(102) + mat(371) = rxt(572)*y(90) + rxt(556)*y(129) + rxt(508)*y(95) + (rxt(476) & + +rxt(588))*y(96) + (rxt(492)+rxt(589))*y(97) + rxt(524)*y(101) & + + rxt(540)*y(102) + mat(1150) = 1.150_r8*rxt(312)*y(90) + rxt(311)*y(129) + mat(173) = rxt(268)*y(3) + mat(360) = rxt(271)*y(3) + mat(631) = -((rxt(119) + rxt(120)) * y(3) + rxt(121)*y(135) + rxt(124)*y(1) & + + rxt(141)*y(53) + rxt(142)*y(54) + rxt(146)*y(17) + rxt(147) & + *y(27) + rxt(148)*y(32)) + mat(1184) = -(rxt(119) + rxt(120)) * y(134) + mat(1321) = -rxt(121)*y(134) + mat(1040) = -rxt(124)*y(134) + mat(26) = -rxt(141)*y(134) + mat(34) = -rxt(142)*y(134) + mat(577) = -rxt(146)*y(134) + mat(999) = -rxt(147)*y(134) + mat(222) = -rxt(148)*y(134) + mat(1184) = mat(1184) + rxt(168)*y(131) + mat(1752) = .850_r8*rxt(312)*y(130) + mat(111) = rxt(168)*y(3) + mat(1142) = .850_r8*rxt(312)*y(90) + mat(1198) = -(rxt(105)*y(2) + rxt(115)*y(133) + rxt(119)*y(134) + rxt(149) & + *y(18) + rxt(168)*y(131) + rxt(171)*y(5) + rxt(268)*y(59) & + + rxt(271)*y(60) + rxt(299)*y(128) + (rxt(306) + rxt(307) & + ) * y(127) + rxt(309)*y(89) + (rxt(314) + rxt(316)) * y(130) & + + rxt(332)*y(90) + rxt(378)*y(106) + rxt(391)*y(107) + rxt(412) & + *y(111)) + mat(1112) = -rxt(105)*y(3) + mat(277) = -rxt(115)*y(3) + mat(640) = -rxt(119)*y(3) + mat(937) = -rxt(149)*y(3) + mat(112) = -rxt(168)*y(3) + mat(315) = -rxt(171)*y(3) + mat(174) = -rxt(268)*y(3) + mat(361) = -rxt(271)*y(3) + mat(242) = -rxt(299)*y(3) + mat(99) = -(rxt(306) + rxt(307)) * y(3) + mat(149) = -rxt(309)*y(3) + mat(1152) = -(rxt(314) + rxt(316)) * y(3) + mat(1767) = -rxt(332)*y(3) + mat(1276) = -rxt(378)*y(3) + mat(1803) = -rxt(391)*y(3) + mat(857) = -rxt(412)*y(3) + mat(1054) = 2.000_r8*rxt(106)*y(2) + 2.000_r8*rxt(124)*y(134) + rxt(178)*y(6) & + + rxt(181)*y(7) + rxt(155)*y(87) + rxt(150)*y(18) & + + 2.000_r8*rxt(163)*y(88) + rxt(193)*y(85) + rxt(220)*y(86) & + + rxt(388)*y(107) + 3.000_r8*rxt(374)*y(108) + rxt(420)*y(112) & + + rxt(428)*y(113) + 2.000_r8*rxt(434)*y(114) + rxt(315)*y(130) & + + rxt(269)*y(59) + rxt(272)*y(60) + mat(1112) = mat(1112) + 2.000_r8*rxt(106)*y(1) + 2.000_r8*rxt(107)*y(2) & + + rxt(114)*y(133) + rxt(179)*y(7) + rxt(154)*y(87) + rxt(187) & + *y(8) + rxt(162)*y(88) + rxt(200)*y(24) + rxt(223)*y(31) & + + rxt(364)*y(106) + rxt(387)*y(107) + (2.000_r8*rxt(373) & + +rxt(396))*y(108) + rxt(403)*y(109) + rxt(422)*y(112) & + + rxt(433)*y(114) + rxt(443)*y(124) + mat(640) = mat(640) + 2.000_r8*rxt(124)*y(1) + mat(1198) = mat(1198) + 2.000_r8*rxt(115)*y(133) + mat(277) = mat(277) + rxt(114)*y(2) + 2.000_r8*rxt(115)*y(3) & + + 2.000_r8*rxt(335)*y(91) + 2.000_r8*rxt(370)*y(107) + mat(1419) = rxt(398)*y(108) + rxt(404)*y(109) + mat(315) = mat(315) + rxt(175)*y(7) + mat(1505) = rxt(178)*y(1) + rxt(305)*y(90) + rxt(402)*y(108) + mat(1551) = rxt(181)*y(1) + rxt(179)*y(2) + rxt(175)*y(5) + rxt(390)*y(107) & + + rxt(400)*y(108) + mat(826) = rxt(155)*y(1) + rxt(154)*y(2) + rxt(191)*y(10) + rxt(156)*y(88) & + + rxt(202)*y(24) + mat(1638) = rxt(187)*y(2) + rxt(189)*y(88) + mat(105) = rxt(191)*y(87) + mat(301) = rxt(259)*y(88) + mat(937) = mat(937) + rxt(150)*y(1) + rxt(152)*y(88) + rxt(397)*y(108) + mat(752) = 2.000_r8*rxt(163)*y(1) + rxt(162)*y(2) + rxt(156)*y(87) + rxt(189) & + *y(8) + rxt(259)*y(13) + rxt(152)*y(18) + 2.000_r8*rxt(164) & + *y(88) + rxt(196)*y(85) + rxt(203)*y(24) + rxt(221)*y(86) & + + rxt(225)*y(31) + mat(1335) = rxt(334)*y(91) + (rxt(337)+rxt(338))*y(92) + mat(1845) = rxt(193)*y(1) + rxt(196)*y(88) + rxt(395)*y(107) + rxt(424) & + *y(112) + mat(1597) = rxt(200)*y(2) + rxt(202)*y(87) + rxt(203)*y(88) + ( & + + 2.000_r8*rxt(207)+2.000_r8*rxt(208))*y(24) + (rxt(229) & + +rxt(230))*y(31) + rxt(386)*y(106) + rxt(394)*y(107) + rxt(419) & + *y(111) + rxt(425)*y(112) + mat(610) = rxt(220)*y(1) + rxt(221)*y(88) + mat(488) = rxt(223)*y(2) + rxt(225)*y(88) + (rxt(229)+rxt(230))*y(24) & + + 2.000_r8*rxt(231)*y(31) + mat(1767) = mat(1767) + rxt(305)*y(6) + rxt(565)*y(111) + 2.000_r8*rxt(570) & + *y(112) + rxt(579)*y(113) + rxt(567)*y(114) + rxt(568)*y(122) & + + rxt(574)*y(115) + rxt(572)*y(116) + rxt(575)*y(117) + rxt(571) & + *y(118) + rxt(578)*y(119) + rxt(564)*y(120) + rxt(576)*y(121) & + + rxt(573)*y(123) + rxt(577)*y(125) + rxt(566)*y(126) + mat(1891) = rxt(553)*y(107) + rxt(554)*y(112) + mat(330) = 2.000_r8*rxt(335)*y(133) + rxt(334)*y(135) + 2.000_r8*rxt(317) & + *y(130) + mat(182) = (rxt(337)+rxt(338))*y(135) + rxt(322)*y(130) + mat(1378) = rxt(505)*y(107) + rxt(506)*y(112) + mat(1681) = rxt(473)*y(107) + rxt(474)*y(112) + mat(1462) = rxt(489)*y(107) + rxt(490)*y(112) + mat(1240) = rxt(521)*y(107) + rxt(522)*y(112) + mat(900) = rxt(537)*y(107) + rxt(538)*y(112) + mat(1276) = mat(1276) + rxt(364)*y(2) + rxt(386)*y(24) + mat(1803) = mat(1803) + rxt(388)*y(1) + rxt(387)*y(2) + 2.000_r8*rxt(370) & + *y(133) + rxt(390)*y(7) + rxt(395)*y(85) + rxt(394)*y(24) & + + rxt(553)*y(129) + rxt(505)*y(95) + rxt(473)*y(96) + rxt(489) & + *y(97) + rxt(521)*y(101) + rxt(537)*y(102) + mat(468) = 3.000_r8*rxt(374)*y(1) + (2.000_r8*rxt(373)+rxt(396))*y(2) & + + rxt(398)*y(57) + rxt(402)*y(6) + rxt(400)*y(7) + rxt(397) & + *y(18) + mat(126) = rxt(403)*y(2) + rxt(404)*y(57) + mat(857) = mat(857) + rxt(419)*y(24) + rxt(565)*y(90) + mat(690) = rxt(420)*y(1) + rxt(422)*y(2) + rxt(424)*y(85) + rxt(425)*y(24) & + + 2.000_r8*rxt(570)*y(90) + rxt(554)*y(129) + rxt(506)*y(95) & + + rxt(474)*y(96) + rxt(490)*y(97) + rxt(522)*y(101) + rxt(538) & + *y(102) + mat(779) = rxt(428)*y(1) + rxt(579)*y(90) + mat(718) = 2.000_r8*rxt(434)*y(1) + rxt(433)*y(2) + rxt(567)*y(90) + mat(340) = rxt(568)*y(90) + mat(540) = rxt(574)*y(90) + mat(372) = rxt(572)*y(90) + mat(417) = rxt(575)*y(90) + mat(559) = rxt(571)*y(90) + mat(518) = rxt(578)*y(90) + mat(499) = rxt(564)*y(90) + mat(432) = rxt(576)*y(90) + mat(662) = rxt(573)*y(90) + mat(269) = rxt(443)*y(2) + mat(403) = rxt(577)*y(90) + mat(387) = rxt(566)*y(90) + mat(1152) = mat(1152) + rxt(315)*y(1) + 2.000_r8*rxt(317)*y(91) + rxt(322) & + *y(92) + mat(174) = mat(174) + rxt(269)*y(1) + mat(361) = mat(361) + rxt(272)*y(1) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(61) = -(rxt(108)*y(2) + rxt(109)*y(3) + rxt(111)*y(1) + rxt(112)*y(57)) + mat(1071) = -rxt(108)*y(132) + mat(1169) = -rxt(109)*y(132) + mat(1031) = -rxt(111)*y(132) + mat(1395) = -rxt(112)*y(132) + mat(622) = rxt(119)*y(3) + mat(1169) = mat(1169) + rxt(119)*y(134) + mat(273) = -(rxt(114)*y(2) + rxt(115)*y(3) + rxt(335)*y(91) + rxt(366)*y(106) & + + rxt(370)*y(107)) + mat(1088) = -rxt(114)*y(133) + mat(1177) = -rxt(115)*y(133) + mat(323) = -rxt(335)*y(133) + mat(1257) = -rxt(366)*y(133) + mat(1786) = -rxt(370)*y(133) + mat(1034) = rxt(111)*y(132) + mat(1088) = mat(1088) + rxt(108)*y(132) + mat(1177) = mat(1177) + rxt(109)*y(132) + mat(62) = rxt(111)*y(1) + rxt(108)*y(2) + rxt(109)*y(3) + rxt(112)*y(57) + mat(1401) = rxt(112)*y(132) + mat(575) = -(rxt(146)*y(134) + rxt(159)*y(87) + rxt(161)*y(2) + rxt(194) & + *y(85) + rxt(237)*y(56) + (rxt(368) + rxt(382)) * y(106)) + mat(629) = -rxt(146)*y(17) + mat(815) = -rxt(159)*y(17) + mat(1095) = -rxt(161)*y(17) + mat(1828) = -rxt(194)*y(17) + mat(208) = -rxt(237)*y(17) + mat(1260) = -(rxt(368) + rxt(382)) * y(17) + mat(920) = rxt(152)*y(88) + mat(741) = rxt(152)*y(18) + mat(186) = -((rxt(253) + rxt(254)) * y(87)) + mat(802) = -(rxt(253) + rxt(254)) * y(16) + mat(1080) = rxt(257)*y(15) + rxt(265)*y(58) + mat(1399) = rxt(303)*y(128) + mat(802) = mat(802) + rxt(256)*y(15) + rxt(266)*y(58) + mat(1615) = rxt(255)*y(15) + mat(443) = rxt(257)*y(2) + rxt(256)*y(87) + rxt(255)*y(8) + rxt(198)*y(85) & + + rxt(222)*y(86) + mat(1822) = rxt(198)*y(15) + mat(595) = rxt(222)*y(15) + mat(235) = rxt(303)*y(57) + mat(71) = rxt(265)*y(2) + rxt(266)*y(87) + mat(1424) = -(rxt(303)*y(128) + rxt(330)*y(105) + rxt(360)*y(129) + rxt(381) & + *y(106) + rxt(389)*y(107) + rxt(398)*y(108) + rxt(404)*y(109) & + + rxt(407)*y(110)) + mat(243) = -rxt(303)*y(57) + mat(158) = -rxt(330)*y(57) + mat(1896) = -rxt(360)*y(57) + mat(1281) = -rxt(381)*y(57) + mat(1808) = -rxt(389)*y(57) + mat(470) = -rxt(398)*y(57) + mat(127) = -rxt(404)*y(57) + mat(975) = -rxt(407)*y(57) + mat(1059) = rxt(420)*y(112) + mat(1117) = rxt(411)*y(111) + mat(1203) = rxt(412)*y(111) + mat(190) = (rxt(253)+rxt(254))*y(87) + mat(1510) = rxt(414)*y(111) + (rxt(450)+rxt(456))*y(115) + mat(1556) = rxt(415)*y(111) + (rxt(451)+rxt(453))*y(115) + mat(831) = (rxt(253)+rxt(254))*y(16) + mat(1726) = rxt(416)*y(111) + mat(942) = rxt(413)*y(111) + mat(1340) = rxt(359)*y(104) + mat(1850) = (rxt(417)+rxt(418))*y(111) + rxt(424)*y(112) + mat(1602) = rxt(419)*y(111) + rxt(425)*y(112) + mat(1019) = rxt(423)*y(112) + mat(1772) = rxt(565)*y(111) + rxt(570)*y(112) + rxt(568)*y(122) + rxt(574) & + *y(115) + rxt(572)*y(116) + mat(1896) = mat(1896) + rxt(549)*y(111) + rxt(554)*y(112) + rxt(552)*y(122) & + + rxt(558)*y(115) + rxt(556)*y(116) + mat(1383) = rxt(501)*y(111) + rxt(506)*y(112) + rxt(504)*y(122) + rxt(510) & + *y(115) + rxt(508)*y(116) + mat(1686) = (rxt(469)+rxt(580))*y(111) + rxt(474)*y(112) + rxt(472)*y(122) + ( & + + rxt(478)+rxt(590))*y(115) + (rxt(476)+rxt(588))*y(116) + mat(1467) = (rxt(485)+rxt(582))*y(111) + rxt(490)*y(112) + rxt(488)*y(122) + ( & + + rxt(494)+rxt(591))*y(115) + (rxt(492)+rxt(589))*y(116) + mat(1245) = rxt(517)*y(111) + rxt(522)*y(112) + rxt(520)*y(122) + rxt(526) & + *y(115) + rxt(524)*y(116) + mat(905) = rxt(533)*y(111) + rxt(538)*y(112) + rxt(536)*y(122) + rxt(542) & + *y(115) + rxt(540)*y(116) + mat(165) = rxt(359)*y(135) + rxt(318)*y(130) + mat(862) = rxt(411)*y(2) + rxt(412)*y(3) + rxt(414)*y(6) + rxt(415)*y(7) & + + rxt(416)*y(9) + rxt(413)*y(18) + (rxt(417)+rxt(418))*y(85) & + + rxt(419)*y(24) + rxt(565)*y(90) + rxt(549)*y(129) + rxt(501) & + *y(95) + (rxt(469)+rxt(580))*y(96) + (rxt(485)+rxt(582))*y(97) & + + rxt(517)*y(101) + rxt(533)*y(102) + mat(695) = rxt(420)*y(1) + rxt(424)*y(85) + rxt(425)*y(24) + rxt(423)*y(27) & + + rxt(570)*y(90) + rxt(554)*y(129) + rxt(506)*y(95) + rxt(474) & + *y(96) + rxt(490)*y(97) + rxt(522)*y(101) + rxt(538)*y(102) + mat(344) = rxt(568)*y(90) + rxt(552)*y(129) + rxt(504)*y(95) + rxt(472)*y(96) & + + rxt(488)*y(97) + rxt(520)*y(101) + rxt(536)*y(102) + mat(544) = (rxt(450)+rxt(456))*y(6) + (rxt(451)+rxt(453))*y(7) + rxt(574) & + *y(90) + rxt(558)*y(129) + rxt(510)*y(95) + (rxt(478)+rxt(590)) & + *y(96) + (rxt(494)+rxt(591))*y(97) + rxt(526)*y(101) + rxt(542) & + *y(102) + mat(376) = rxt(572)*y(90) + rxt(556)*y(129) + rxt(508)*y(95) + (rxt(476) & + +rxt(588))*y(96) + (rxt(492)+rxt(589))*y(97) + rxt(524)*y(101) & + + rxt(540)*y(102) + mat(1157) = rxt(318)*y(104) + mat(309) = -(rxt(170)*y(87) + rxt(171)*y(3) + rxt(172)*y(6) + (rxt(173) & + + rxt(174) + rxt(175)) * y(7) + rxt(304)*y(90)) + mat(811) = -rxt(170)*y(5) + mat(1178) = -rxt(171)*y(5) + mat(1482) = -rxt(172)*y(5) + mat(1528) = -(rxt(173) + rxt(174) + rxt(175)) * y(5) + mat(1740) = -rxt(304)*y(5) + mat(1089) = rxt(308)*y(127) + rxt(169)*y(131) + mat(1178) = mat(1178) + rxt(306)*y(127) + mat(145) = 1.100_r8*rxt(313)*y(130) + mat(97) = rxt(308)*y(2) + rxt(306)*y(3) + mat(1865) = .200_r8*rxt(311)*y(130) + mat(110) = rxt(169)*y(2) + mat(1140) = 1.100_r8*rxt(313)*y(89) + .200_r8*rxt(311)*y(129) + mat(1512) = -(rxt(166)*y(18) + rxt(172)*y(5) + rxt(176)*y(2) + rxt(177)*y(88) & + + rxt(178)*y(1) + rxt(186)*y(8) + rxt(205)*y(24) + rxt(226) & + *y(31) + rxt(258)*y(13) + rxt(305)*y(90) + rxt(365)*y(106) & + + (rxt(399) + rxt(402)) * y(108) + rxt(414)*y(111) + (rxt(441) & + + rxt(442)) * y(124) + (rxt(450) + rxt(456)) * y(115)) + mat(944) = -rxt(166)*y(6) + mat(317) = -rxt(172)*y(6) + mat(1119) = -rxt(176)*y(6) + mat(758) = -rxt(177)*y(6) + mat(1061) = -rxt(178)*y(6) + mat(1645) = -rxt(186)*y(6) + mat(1604) = -rxt(205)*y(6) + mat(490) = -rxt(226)*y(6) + mat(303) = -rxt(258)*y(6) + mat(1774) = -rxt(305)*y(6) + mat(1283) = -rxt(365)*y(6) + mat(471) = -(rxt(399) + rxt(402)) * y(6) + mat(864) = -rxt(414)*y(6) + mat(270) = -(rxt(441) + rxt(442)) * y(6) + mat(546) = -(rxt(450) + rxt(456)) * y(6) + mat(1119) = mat(1119) + rxt(179)*y(7) + mat(1205) = rxt(171)*y(5) + rxt(168)*y(131) + mat(317) = mat(317) + rxt(171)*y(3) + 2.000_r8*rxt(174)*y(7) + rxt(170)*y(87) + mat(1558) = rxt(179)*y(2) + 2.000_r8*rxt(174)*y(5) + rxt(427)*y(113) & + + rxt(273)*y(60) + mat(832) = rxt(170)*y(5) + mat(944) = mat(944) + rxt(356)*y(101) + rxt(426)*y(113) + mat(1898) = rxt(553)*y(107) + rxt(549)*y(111) + rxt(554)*y(112) + rxt(563) & + *y(113) + rxt(551)*y(114) + rxt(552)*y(122) + rxt(558)*y(115) & + + rxt(556)*y(116) + rxt(559)*y(117) + rxt(555)*y(118) + rxt(562) & + *y(119) + rxt(548)*y(120) + rxt(560)*y(121) + rxt(557)*y(123) & + + rxt(561)*y(125) + rxt(550)*y(126) + mat(113) = rxt(168)*y(3) + mat(1247) = rxt(356)*y(18) + rxt(521)*y(107) + rxt(517)*y(111) + rxt(522) & + *y(112) + rxt(531)*y(113) + rxt(519)*y(114) + rxt(520)*y(122) & + + rxt(526)*y(115) + rxt(524)*y(116) + rxt(527)*y(117) + rxt(523) & + *y(118) + rxt(530)*y(119) + rxt(516)*y(120) + rxt(528)*y(121) & + + rxt(525)*y(123) + rxt(529)*y(125) + rxt(518)*y(126) + rxt(319) & + *y(130) + mat(907) = rxt(537)*y(107) + rxt(533)*y(111) + rxt(538)*y(112) + rxt(547) & + *y(113) + rxt(535)*y(114) + rxt(536)*y(122) + rxt(542)*y(115) & + + rxt(540)*y(116) + rxt(543)*y(117) + rxt(539)*y(118) + rxt(546) & + *y(119) + rxt(532)*y(120) + rxt(544)*y(121) + rxt(541)*y(123) & + + rxt(545)*y(125) + rxt(534)*y(126) + rxt(320)*y(130) + mat(88) = rxt(321)*y(130) + mat(166) = rxt(318)*y(130) + mat(159) = rxt(329)*y(130) + mat(1810) = rxt(553)*y(129) + rxt(521)*y(101) + rxt(537)*y(102) + mat(864) = mat(864) + rxt(549)*y(129) + rxt(517)*y(101) + rxt(533)*y(102) + mat(697) = rxt(554)*y(129) + rxt(522)*y(101) + rxt(538)*y(102) + mat(784) = rxt(427)*y(7) + rxt(426)*y(18) + rxt(563)*y(129) + rxt(531)*y(101) & + + rxt(547)*y(102) + mat(723) = rxt(551)*y(129) + rxt(519)*y(101) + rxt(535)*y(102) + mat(346) = rxt(552)*y(129) + rxt(520)*y(101) + rxt(536)*y(102) + mat(546) = mat(546) + rxt(558)*y(129) + rxt(526)*y(101) + rxt(542)*y(102) + mat(378) = rxt(556)*y(129) + rxt(524)*y(101) + rxt(540)*y(102) + mat(422) = rxt(559)*y(129) + rxt(527)*y(101) + rxt(543)*y(102) + mat(564) = rxt(555)*y(129) + rxt(523)*y(101) + rxt(539)*y(102) + mat(523) = rxt(562)*y(129) + rxt(530)*y(101) + rxt(546)*y(102) + mat(504) = rxt(548)*y(129) + rxt(516)*y(101) + rxt(532)*y(102) + mat(437) = rxt(560)*y(129) + rxt(528)*y(101) + rxt(544)*y(102) + mat(667) = rxt(557)*y(129) + rxt(525)*y(101) + rxt(541)*y(102) + mat(408) = rxt(561)*y(129) + rxt(529)*y(101) + rxt(545)*y(102) + mat(392) = rxt(550)*y(129) + rxt(518)*y(101) + rxt(534)*y(102) + mat(1159) = rxt(319)*y(101) + rxt(320)*y(102) + rxt(321)*y(103) + rxt(318) & + *y(104) + rxt(329)*y(105) + mat(363) = rxt(273)*y(7) + mat(1559) = -((rxt(173) + rxt(174) + rxt(175)) * y(5) + (rxt(179) + rxt(180) & + ) * y(2) + rxt(181)*y(1) + rxt(182)*y(8) + rxt(184)*y(87) & + + rxt(190)*y(88) + rxt(206)*y(24) + rxt(227)*y(31) + rxt(273) & + *y(60) + rxt(380)*y(106) + rxt(390)*y(107) + (rxt(400) + rxt(401) & + ) * y(108) + rxt(406)*y(110) + rxt(415)*y(111) + rxt(427)*y(113) & + + rxt(437)*y(123) + (rxt(451) + rxt(453)) * y(115)) + mat(318) = -(rxt(173) + rxt(174) + rxt(175)) * y(7) + mat(1120) = -(rxt(179) + rxt(180)) * y(7) + mat(1062) = -rxt(181)*y(7) + mat(1646) = -rxt(182)*y(7) + mat(833) = -rxt(184)*y(7) + mat(759) = -rxt(190)*y(7) + mat(1605) = -rxt(206)*y(7) + mat(491) = -rxt(227)*y(7) + mat(364) = -rxt(273)*y(7) + mat(1284) = -rxt(380)*y(7) + mat(1811) = -rxt(390)*y(7) + mat(472) = -(rxt(400) + rxt(401)) * y(7) + mat(978) = -rxt(406)*y(7) + mat(865) = -rxt(415)*y(7) + mat(785) = -rxt(427)*y(7) + mat(668) = -rxt(437)*y(7) + mat(547) = -(rxt(451) + rxt(453)) * y(7) + mat(1062) = mat(1062) + rxt(178)*y(6) + mat(1120) = mat(1120) + rxt(176)*y(6) + rxt(187)*y(8) + mat(1513) = rxt(178)*y(1) + rxt(176)*y(2) + 2.000_r8*rxt(186)*y(8) + rxt(258) & + *y(13) + rxt(177)*y(88) + rxt(205)*y(24) + rxt(226)*y(31) & + + rxt(365)*y(106) + rxt(442)*y(124) + mat(833) = mat(833) + rxt(188)*y(8) + rxt(167)*y(20) + rxt(191)*y(10) & + + rxt(355)*y(101) + mat(1646) = mat(1646) + rxt(187)*y(2) + 2.000_r8*rxt(186)*y(6) + rxt(188) & + *y(87) + rxt(189)*y(88) + mat(195) = rxt(167)*y(87) + mat(107) = rxt(191)*y(87) + mat(304) = rxt(258)*y(6) + mat(759) = mat(759) + rxt(177)*y(6) + rxt(189)*y(8) + mat(1853) = rxt(431)*y(113) + mat(1605) = mat(1605) + rxt(205)*y(6) + mat(491) = mat(491) + rxt(226)*y(6) + mat(1775) = rxt(579)*y(113) + rxt(575)*y(117) + mat(1899) = rxt(563)*y(113) + rxt(559)*y(117) + mat(1386) = rxt(515)*y(113) + rxt(511)*y(117) + mat(1689) = rxt(483)*y(113) + rxt(479)*y(117) + mat(1470) = rxt(499)*y(113) + rxt(495)*y(117) + mat(1248) = rxt(355)*y(87) + rxt(531)*y(113) + rxt(527)*y(117) + mat(908) = rxt(547)*y(113) + rxt(543)*y(117) + mat(1284) = mat(1284) + rxt(365)*y(6) + mat(785) = mat(785) + rxt(431)*y(85) + rxt(579)*y(90) + rxt(563)*y(129) & + + rxt(515)*y(95) + rxt(483)*y(96) + rxt(499)*y(97) + rxt(531) & + *y(101) + rxt(547)*y(102) + mat(423) = rxt(575)*y(90) + rxt(559)*y(129) + rxt(511)*y(95) + rxt(479)*y(96) & + + rxt(495)*y(97) + rxt(527)*y(101) + rxt(543)*y(102) + mat(271) = rxt(442)*y(6) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(819) = -(rxt(154)*y(2) + rxt(155)*y(1) + rxt(156)*y(88) + (4._r8*rxt(157) & + + 4._r8*rxt(158)) * y(87) + rxt(159)*y(17) + rxt(160)*y(19) & + + rxt(167)*y(20) + rxt(170)*y(5) + rxt(184)*y(7) + rxt(185)*y(9) & + + rxt(188)*y(8) + rxt(191)*y(10) + (rxt(201) + rxt(202)) * y(24) & + + rxt(212)*y(27) + rxt(216)*y(28) + rxt(218)*y(29) + rxt(224) & + *y(31) + rxt(232)*y(32) + (rxt(253) + rxt(254)) * y(16) + rxt(256) & + *y(15) + rxt(260)*y(14) + rxt(266)*y(58) + rxt(267)*y(59) & + + rxt(270)*y(60) + rxt(277)*y(61) + (rxt(279) + rxt(280) & + ) * y(64) + rxt(355)*y(101)) + mat(1103) = -rxt(154)*y(87) + mat(1045) = -rxt(155)*y(87) + mat(745) = -rxt(156)*y(87) + mat(579) = -rxt(159)*y(87) + mat(131) = -rxt(160)*y(87) + mat(192) = -rxt(167)*y(87) + mat(311) = -rxt(170)*y(87) + mat(1542) = -rxt(184)*y(87) + mat(1712) = -rxt(185)*y(87) + mat(1630) = -rxt(188)*y(87) + mat(104) = -rxt(191)*y(87) + mat(1588) = -(rxt(201) + rxt(202)) * y(87) + mat(1005) = -rxt(212)*y(87) + mat(229) = -rxt(216)*y(87) + mat(256) = -rxt(218)*y(87) + mat(483) = -rxt(224)*y(87) + mat(223) = -rxt(232)*y(87) + mat(188) = -(rxt(253) + rxt(254)) * y(87) + mat(450) = -rxt(256)*y(87) + mat(92) = -rxt(260)*y(87) + mat(74) = -rxt(266)*y(87) + mat(170) = -rxt(267)*y(87) + mat(357) = -rxt(270)*y(87) + mat(250) = -rxt(277)*y(87) + mat(58) = -(rxt(279) + rxt(280)) * y(87) + mat(1231) = -rxt(355)*y(87) + mat(1045) = mat(1045) + rxt(150)*y(18) + rxt(163)*y(88) + rxt(405)*y(110) + mat(1103) = mat(1103) + rxt(161)*y(17) + rxt(257)*y(15) + rxt(162)*y(88) & + + rxt(165)*y(19) + rxt(213)*y(27) + rxt(214)*y(28) + rxt(233) & + *y(32) + rxt(234)*y(33) + mat(633) = rxt(146)*y(17) + 2.000_r8*rxt(121)*y(135) + rxt(147)*y(27) & + + rxt(148)*y(32) + mat(579) = mat(579) + rxt(161)*y(2) + rxt(146)*y(134) + mat(1496) = rxt(177)*y(88) + mat(1542) = mat(1542) + rxt(406)*y(110) + mat(1630) = mat(1630) + rxt(189)*y(88) + mat(1712) = mat(1712) + rxt(383)*y(106) + rxt(416)*y(111) + mat(450) = mat(450) + rxt(257)*y(2) + mat(928) = rxt(150)*y(1) + 2.000_r8*rxt(151)*y(88) + rxt(421)*y(112) + mat(745) = mat(745) + rxt(163)*y(1) + rxt(162)*y(2) + rxt(177)*y(6) & + + rxt(189)*y(8) + 2.000_r8*rxt(151)*y(18) + rxt(197)*y(85) + mat(131) = mat(131) + rxt(165)*y(2) + mat(1326) = 2.000_r8*rxt(121)*y(134) + rxt(338)*y(92) + rxt(339)*y(98) & + + rxt(379)*y(106) + rxt(236)*y(56) + mat(1836) = rxt(197)*y(88) + rxt(409)*y(110) + mat(1588) = mat(1588) + rxt(410)*y(110) + mat(1005) = mat(1005) + rxt(213)*y(2) + rxt(147)*y(134) + rxt(384)*y(106) + mat(229) = mat(229) + rxt(214)*y(2) + mat(223) = mat(223) + rxt(233)*y(2) + rxt(148)*y(134) + mat(200) = rxt(234)*y(2) + mat(1758) = rxt(568)*y(122) + mat(1882) = rxt(552)*y(122) + mat(179) = rxt(338)*y(135) + mat(1369) = rxt(504)*y(122) + mat(1672) = rxt(472)*y(122) + mat(1453) = rxt(488)*y(122) + mat(79) = rxt(339)*y(135) + rxt(323)*y(130) + mat(1231) = mat(1231) + rxt(520)*y(122) + mat(891) = rxt(536)*y(122) + mat(1267) = rxt(383)*y(9) + rxt(379)*y(135) + rxt(384)*y(27) + mat(848) = rxt(416)*y(9) + mat(681) = rxt(421)*y(18) + mat(961) = rxt(405)*y(1) + rxt(406)*y(7) + rxt(409)*y(85) + rxt(410)*y(24) + mat(337) = rxt(568)*y(90) + rxt(552)*y(129) + rxt(504)*y(95) + rxt(472)*y(96) & + + rxt(488)*y(97) + rxt(520)*y(101) + rxt(536)*y(102) + mat(1144) = rxt(323)*y(98) + mat(209) = rxt(236)*y(135) + mat(1648) = -(rxt(182)*y(7) + rxt(186)*y(6) + rxt(187)*y(2) + rxt(188)*y(87) & + + rxt(189)*y(88) + rxt(255)*y(15) + rxt(281)*y(64)) + mat(1561) = -rxt(182)*y(8) + mat(1515) = -rxt(186)*y(8) + mat(1122) = -rxt(187)*y(8) + mat(835) = -rxt(188)*y(8) + mat(761) = -rxt(189)*y(8) + mat(456) = -rxt(255)*y(8) + mat(59) = -rxt(281)*y(8) + mat(1064) = rxt(181)*y(7) + mat(1122) = mat(1122) + rxt(180)*y(7) + rxt(217)*y(29) + rxt(235)*y(34) + mat(1561) = mat(1561) + rxt(181)*y(1) + rxt(180)*y(2) + mat(835) = mat(835) + rxt(185)*y(9) + rxt(218)*y(29) + mat(1731) = rxt(185)*y(87) + rxt(239)*y(56) + mat(761) = mat(761) + rxt(354)*y(101) + mat(1855) = rxt(219)*y(29) + mat(1607) = rxt(432)*y(113) + mat(262) = rxt(217)*y(2) + rxt(218)*y(87) + rxt(219)*y(85) + mat(120) = rxt(235)*y(2) + mat(1777) = rxt(567)*y(114) + rxt(571)*y(118) + rxt(578)*y(119) + rxt(564) & + *y(120) + rxt(576)*y(121) + mat(1901) = rxt(551)*y(114) + rxt(555)*y(118) + rxt(562)*y(119) + rxt(548) & + *y(120) + rxt(560)*y(121) + mat(1388) = rxt(507)*y(118) + rxt(514)*y(119) + rxt(512)*y(121) + mat(1691) = (rxt(475)+rxt(592))*y(118) + rxt(482)*y(119) + rxt(480)*y(121) + mat(1472) = (rxt(491)+rxt(593))*y(118) + rxt(498)*y(119) + rxt(496)*y(121) + mat(1250) = rxt(354)*y(88) + rxt(519)*y(114) + rxt(523)*y(118) + rxt(530) & + *y(119) + rxt(516)*y(120) + rxt(528)*y(121) + mat(910) = rxt(535)*y(114) + rxt(539)*y(118) + rxt(546)*y(119) + rxt(532) & + *y(120) + rxt(544)*y(121) + mat(787) = rxt(432)*y(24) + mat(725) = rxt(567)*y(90) + rxt(551)*y(129) + rxt(519)*y(101) + rxt(535) & + *y(102) + mat(566) = rxt(571)*y(90) + rxt(555)*y(129) + rxt(507)*y(95) + (rxt(475) & + +rxt(592))*y(96) + (rxt(491)+rxt(593))*y(97) + rxt(523)*y(101) & + + rxt(539)*y(102) + mat(525) = rxt(578)*y(90) + rxt(562)*y(129) + rxt(514)*y(95) + rxt(482)*y(96) & + + rxt(498)*y(97) + rxt(530)*y(101) + rxt(546)*y(102) + mat(505) = rxt(564)*y(90) + rxt(548)*y(129) + rxt(516)*y(101) + rxt(532) & + *y(102) + mat(438) = rxt(576)*y(90) + rxt(560)*y(129) + rxt(512)*y(95) + rxt(480)*y(96) & + + rxt(496)*y(97) + rxt(528)*y(101) + rxt(544)*y(102) + mat(212) = rxt(239)*y(9) + mat(191) = -(rxt(167)*y(87)) + mat(803) = -rxt(167)*y(20) + mat(1479) = rxt(166)*y(18) + mat(917) = rxt(166)*y(6) + mat(1304) = rxt(358)*y(103) + mat(989) = rxt(430)*y(113) + mat(84) = rxt(358)*y(135) + mat(766) = rxt(430)*y(27) + mat(1733) = -(rxt(185)*y(87) + rxt(239)*y(56) + rxt(383)*y(106) + rxt(392) & + *y(107) + rxt(416)*y(111) + rxt(429)*y(113) + rxt(438)*y(123) & + + rxt(463)*y(114) + rxt(464)*y(121) + rxt(467)*y(118)) + mat(836) = -rxt(185)*y(9) + mat(213) = -rxt(239)*y(9) + mat(1288) = -rxt(383)*y(9) + mat(1815) = -rxt(392)*y(9) + mat(869) = -rxt(416)*y(9) + mat(789) = -rxt(429)*y(9) + mat(670) = -rxt(438)*y(9) + mat(727) = -rxt(463)*y(9) + mat(440) = -rxt(464)*y(9) + mat(568) = -rxt(467)*y(9) + mat(1563) = rxt(184)*y(87) + mat(836) = mat(836) + rxt(184)*y(7) + mat(1650) = rxt(255)*y(15) + rxt(281)*y(64) + mat(294) = rxt(348)*y(96) + rxt(349)*y(97) + rxt(466)*y(118) + rxt(461) & + *y(119) + mat(457) = rxt(255)*y(8) + mat(1347) = rxt(350)*y(99) + rxt(351)*y(100) + mat(1026) = (rxt(285)+rxt(290)+rxt(296))*y(29) + rxt(435)*y(114) + mat(263) = (rxt(285)+rxt(290)+rxt(296))*y(27) + mat(1779) = rxt(564)*y(120) + mat(1903) = rxt(548)*y(120) + mat(1390) = rxt(503)*y(114) + 2.000_r8*rxt(500)*y(120) + mat(1693) = rxt(348)*y(11) + (rxt(471)+rxt(581))*y(114) + (2.000_r8*rxt(468) & + +2.000_r8*rxt(586))*y(120) + mat(1474) = rxt(349)*y(11) + (rxt(487)+rxt(583))*y(114) + (2.000_r8*rxt(484) & + +2.000_r8*rxt(587))*y(120) + mat(45) = rxt(350)*y(135) + mat(49) = rxt(351)*y(135) + mat(1252) = rxt(516)*y(120) + mat(912) = rxt(532)*y(120) + mat(727) = mat(727) + rxt(435)*y(27) + rxt(503)*y(95) + (rxt(471)+rxt(581)) & + *y(96) + (rxt(487)+rxt(583))*y(97) + mat(568) = mat(568) + rxt(466)*y(11) + mat(527) = rxt(461)*y(11) + mat(507) = rxt(564)*y(90) + rxt(548)*y(129) + 2.000_r8*rxt(500)*y(95) + ( & + + 2.000_r8*rxt(468)+2.000_r8*rxt(586))*y(96) + ( & + + 2.000_r8*rxt(484)+2.000_r8*rxt(587))*y(97) + rxt(516)*y(101) & + + rxt(532)*y(102) + mat(60) = rxt(281)*y(8) + mat(102) = -(rxt(191)*y(87)) + mat(799) = -rxt(191)*y(10) + mat(1522) = rxt(190)*y(88) + mat(732) = rxt(190)*y(7) + mat(283) = -(rxt(348)*y(96) + rxt(349)*y(97) + rxt(461)*y(119) + rxt(466) & + *y(118)) + mat(1656) = -rxt(348)*y(11) + mat(1437) = -rxt(349)*y(11) + mat(510) = -rxt(461)*y(11) + mat(551) = -rxt(466)*y(11) + mat(1527) = rxt(182)*y(8) + mat(1617) = rxt(182)*y(7) + mat(296) = -(rxt(204)*y(24) + rxt(258)*y(6) + rxt(259)*y(88)) + mat(1576) = -rxt(204)*y(13) + mat(1481) = -rxt(258)*y(13) + mat(738) = -rxt(259)*y(13) + mat(810) = rxt(260)*y(14) + mat(90) = rxt(260)*y(87) + mat(89) = -(rxt(260)*y(87)) + mat(798) = -rxt(260)*y(14) + mat(295) = rxt(259)*y(88) + mat(731) = rxt(259)*y(13) + mat(445) = -(rxt(198)*y(85) + rxt(222)*y(86) + rxt(255)*y(8) + rxt(256)*y(87) & + + rxt(257)*y(2)) + mat(1827) = -rxt(198)*y(15) + mat(597) = -rxt(222)*y(15) + mat(1619) = -rxt(255)*y(15) + mat(813) = -rxt(256)*y(15) + mat(1092) = -rxt(257)*y(15) + mat(1484) = rxt(258)*y(13) + mat(297) = rxt(258)*y(6) + rxt(204)*y(24) + mat(1578) = rxt(204)*y(13) + end subroutine nlnmat03 + subroutine nlnmat04( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(931) = -(rxt(149)*y(3) + rxt(150)*y(1) + (rxt(151) + rxt(152) + rxt(153) & + ) * y(88) + rxt(166)*y(6) + rxt(356)*y(101) + rxt(372)*y(107) & + + rxt(376)*y(110) + rxt(397)*y(108) + rxt(413)*y(111) + rxt(421) & + *y(112) + rxt(426)*y(113) + rxt(436)*y(123)) + mat(1192) = -rxt(149)*y(18) + mat(1048) = -rxt(150)*y(18) + mat(746) = -(rxt(151) + rxt(152) + rxt(153)) * y(18) + mat(1499) = -rxt(166)*y(18) + mat(1234) = -rxt(356)*y(18) + mat(1797) = -rxt(372)*y(18) + mat(964) = -rxt(376)*y(18) + mat(463) = -rxt(397)*y(18) + mat(851) = -rxt(413)*y(18) + mat(684) = -rxt(421)*y(18) + mat(773) = -rxt(426)*y(18) + mat(659) = -rxt(436)*y(18) + mat(1106) = rxt(161)*y(17) + rxt(154)*y(87) + mat(634) = rxt(146)*y(17) + mat(580) = rxt(161)*y(2) + rxt(146)*y(134) + rxt(159)*y(87) + rxt(194)*y(85) & + + rxt(382)*y(106) + rxt(237)*y(56) + mat(189) = rxt(253)*y(87) + mat(312) = rxt(170)*y(87) + mat(820) = rxt(154)*y(2) + rxt(159)*y(17) + rxt(253)*y(16) + rxt(170)*y(5) & + + rxt(256)*y(15) + rxt(266)*y(58) + rxt(267)*y(59) + rxt(270) & + *y(60) + mat(451) = rxt(256)*y(87) + mat(1839) = rxt(194)*y(17) + mat(216) = rxt(324)*y(130) + mat(138) = rxt(325)*y(130) + mat(1372) = rxt(505)*y(107) + rxt(501)*y(111) + rxt(506)*y(112) + rxt(515) & + *y(113) + rxt(504)*y(122) + rxt(510)*y(115) + rxt(508)*y(116) & + + rxt(511)*y(117) + rxt(507)*y(118) + rxt(514)*y(119) + rxt(512) & + *y(121) + rxt(509)*y(123) + rxt(513)*y(125) + rxt(502)*y(126) & + + rxt(326)*y(130) + mat(1675) = rxt(473)*y(107) + (rxt(469)+rxt(580))*y(111) + rxt(474)*y(112) & + + rxt(483)*y(113) + rxt(472)*y(122) + (rxt(478)+rxt(590))*y(115) + ( & + + rxt(476)+rxt(588))*y(116) + rxt(479)*y(117) + (rxt(475) & + +rxt(592))*y(118) + rxt(482)*y(119) + rxt(480)*y(121) & + + rxt(477)*y(123) + rxt(481)*y(125) + rxt(470)*y(126) + rxt(327) & + *y(130) + mat(1456) = rxt(489)*y(107) + (rxt(485)+rxt(582))*y(111) + rxt(490)*y(112) & + + rxt(499)*y(113) + rxt(488)*y(122) + (rxt(494)+rxt(591))*y(115) + ( & + + rxt(492)+rxt(589))*y(116) + rxt(495)*y(117) + (rxt(491) & + +rxt(593))*y(118) + rxt(498)*y(119) + rxt(496)*y(121) & + + rxt(493)*y(123) + rxt(497)*y(125) + rxt(486)*y(126) + rxt(328) & + *y(130) + mat(80) = rxt(323)*y(130) + mat(1270) = rxt(382)*y(17) + mat(1797) = mat(1797) + rxt(505)*y(95) + rxt(473)*y(96) + rxt(489)*y(97) + mat(851) = mat(851) + rxt(501)*y(95) + (rxt(469)+rxt(580))*y(96) + (rxt(485) & + +rxt(582))*y(97) + mat(684) = mat(684) + rxt(506)*y(95) + rxt(474)*y(96) + rxt(490)*y(97) + mat(773) = mat(773) + rxt(515)*y(95) + rxt(483)*y(96) + rxt(499)*y(97) + mat(339) = rxt(504)*y(95) + rxt(472)*y(96) + rxt(488)*y(97) + mat(538) = rxt(510)*y(95) + (rxt(478)+rxt(590))*y(96) + (rxt(494)+rxt(591)) & + *y(97) + mat(370) = rxt(508)*y(95) + (rxt(476)+rxt(588))*y(96) + (rxt(492)+rxt(589)) & + *y(97) + mat(416) = rxt(511)*y(95) + rxt(479)*y(96) + rxt(495)*y(97) + mat(557) = rxt(507)*y(95) + (rxt(475)+rxt(592))*y(96) + (rxt(491)+rxt(593)) & + *y(97) + mat(516) = rxt(514)*y(95) + rxt(482)*y(96) + rxt(498)*y(97) + mat(430) = rxt(512)*y(95) + rxt(480)*y(96) + rxt(496)*y(97) + mat(659) = mat(659) + rxt(509)*y(95) + rxt(477)*y(96) + rxt(493)*y(97) + mat(401) = rxt(513)*y(95) + rxt(481)*y(96) + rxt(497)*y(97) + mat(385) = rxt(502)*y(95) + rxt(470)*y(96) + rxt(486)*y(97) + mat(1146) = rxt(324)*y(93) + rxt(325)*y(94) + rxt(326)*y(95) + rxt(327)*y(96) & + + rxt(328)*y(97) + rxt(323)*y(98) + mat(210) = rxt(237)*y(17) + mat(75) = rxt(266)*y(87) + mat(171) = rxt(267)*y(87) + mat(358) = rxt(270)*y(87) + mat(744) = -((rxt(151) + rxt(152) + rxt(153)) * y(18) + rxt(156)*y(87) & + + rxt(162)*y(2) + rxt(163)*y(1) + 4._r8*rxt(164)*y(88) + rxt(177) & + *y(6) + rxt(189)*y(8) + rxt(190)*y(7) + (rxt(196) + rxt(197) & + ) * y(85) + rxt(203)*y(24) + rxt(221)*y(86) + rxt(225)*y(31) & + + rxt(259)*y(13) + rxt(354)*y(101)) + mat(926) = -(rxt(151) + rxt(152) + rxt(153)) * y(88) + mat(818) = -rxt(156)*y(88) + mat(1101) = -rxt(162)*y(88) + mat(1043) = -rxt(163)*y(88) + mat(1494) = -rxt(177)*y(88) + mat(1628) = -rxt(189)*y(88) + mat(1540) = -rxt(190)*y(88) + mat(1834) = -(rxt(196) + rxt(197)) * y(88) + mat(1586) = -rxt(203)*y(88) + mat(602) = -rxt(221)*y(88) + mat(482) = -rxt(225)*y(88) + mat(298) = -rxt(259)*y(88) + mat(1229) = -rxt(354)*y(88) + mat(1043) = mat(1043) + rxt(155)*y(87) + mat(1101) = mat(1101) + rxt(257)*y(15) + rxt(165)*y(19) + rxt(375)*y(110) + mat(1187) = rxt(149)*y(18) + mat(187) = rxt(254)*y(87) + mat(1494) = mat(1494) + rxt(258)*y(13) + mat(818) = mat(818) + rxt(155)*y(1) + rxt(254)*y(16) + rxt(188)*y(8) & + + rxt(160)*y(19) + rxt(201)*y(24) + rxt(224)*y(31) + rxt(277) & + *y(61) + .500_r8*rxt(279)*y(64) + mat(1628) = mat(1628) + rxt(188)*y(87) + rxt(255)*y(15) + mat(1710) = rxt(392)*y(107) + mat(298) = mat(298) + rxt(258)*y(6) + rxt(204)*y(24) + mat(449) = rxt(257)*y(2) + rxt(255)*y(8) + rxt(198)*y(85) + rxt(222)*y(86) + mat(926) = mat(926) + rxt(149)*y(3) + rxt(372)*y(107) + mat(130) = rxt(165)*y(2) + rxt(160)*y(87) + rxt(195)*y(85) + mat(1834) = mat(1834) + rxt(198)*y(15) + rxt(195)*y(19) + mat(1586) = mat(1586) + rxt(201)*y(87) + rxt(204)*y(13) + mat(1003) = rxt(393)*y(107) + rxt(423)*y(112) + mat(602) = mat(602) + rxt(222)*y(15) + mat(482) = mat(482) + rxt(224)*y(87) + mat(1792) = rxt(392)*y(9) + rxt(372)*y(18) + rxt(393)*y(27) + mat(679) = rxt(423)*y(27) + mat(959) = rxt(375)*y(2) + mat(249) = rxt(277)*y(87) + mat(57) = .500_r8*rxt(279)*y(87) + mat(129) = -(rxt(160)*y(87) + rxt(165)*y(2) + rxt(195)*y(85)) + mat(800) = -rxt(160)*y(19) + mat(1077) = -rxt(165)*y(19) + mat(1821) = -rxt(195)*y(19) + mat(800) = mat(800) + 2.000_r8*rxt(158)*y(87) + mat(733) = 2.000_r8*rxt(164)*y(88) + mat(1338) = -(rxt(121)*y(134) + rxt(236)*y(56) + rxt(278)*y(62) + rxt(331) & + *y(105) + rxt(333)*y(90) + rxt(334)*y(91) + (rxt(337) + rxt(338) & + ) * y(92) + rxt(339)*y(98) + rxt(340)*y(93) + rxt(342)*y(94) & + + rxt(344)*y(95) + rxt(346)*y(96) + rxt(350)*y(99) + rxt(351) & + *y(100) + rxt(352)*y(129) + rxt(353)*y(101) + rxt(357)*y(102) & + + rxt(358)*y(103) + rxt(359)*y(104) + rxt(379)*y(106) + rxt(439) & + *y(123) + rxt(447)*y(111) + rxt(448)*y(114) + rxt(454)*y(115) & + + rxt(458)*y(113) + rxt(459)*y(118)) + mat(642) = -rxt(121)*y(135) + mat(211) = -rxt(236)*y(135) + mat(54) = -rxt(278)*y(135) + mat(157) = -rxt(331)*y(135) + mat(1770) = -rxt(333)*y(135) + mat(332) = -rxt(334)*y(135) + mat(183) = -(rxt(337) + rxt(338)) * y(135) + mat(82) = -rxt(339)*y(135) + mat(218) = -rxt(340)*y(135) + mat(140) = -rxt(342)*y(135) + mat(1381) = -rxt(344)*y(135) + mat(1684) = -rxt(346)*y(135) + mat(43) = -rxt(350)*y(135) + mat(47) = -rxt(351)*y(135) + mat(1894) = -rxt(352)*y(135) + mat(1243) = -rxt(353)*y(135) + mat(903) = -rxt(357)*y(135) + mat(86) = -rxt(358)*y(135) + mat(164) = -rxt(359)*y(135) + mat(1279) = -rxt(379)*y(135) + mat(664) = -rxt(439)*y(135) + mat(860) = -rxt(447)*y(135) + mat(720) = -rxt(448)*y(135) + mat(542) = -rxt(454)*y(135) + mat(781) = -rxt(458)*y(135) + mat(561) = -rxt(459)*y(135) + mat(587) = rxt(159)*y(87) + rxt(368)*y(106) + mat(1508) = rxt(450)*y(115) + mat(1554) = rxt(451)*y(115) + mat(829) = rxt(159)*y(17) + 2.000_r8*rxt(157)*y(87) + rxt(167)*y(20) & + + rxt(185)*y(9) + rxt(191)*y(10) + rxt(260)*y(14) + rxt(256) & + *y(15) + rxt(156)*y(88) + rxt(160)*y(19) + rxt(212)*y(27) & + + rxt(216)*y(28) + rxt(232)*y(32) + mat(193) = rxt(167)*y(87) + mat(1724) = rxt(185)*y(87) + rxt(467)*y(118) + mat(106) = rxt(191)*y(87) + mat(288) = rxt(461)*y(119) + mat(94) = rxt(260)*y(87) + mat(454) = rxt(256)*y(87) + mat(940) = rxt(153)*y(88) + rxt(376)*y(110) + mat(755) = rxt(156)*y(87) + rxt(153)*y(18) + mat(134) = rxt(160)*y(87) + mat(1017) = rxt(212)*y(87) + (rxt(286)+rxt(291)+rxt(297))*y(28) + (rxt(287) & + +rxt(298))*y(33) + rxt(408)*y(110) + rxt(444)*y(125) + mat(232) = rxt(216)*y(87) + (rxt(286)+rxt(291)+rxt(297))*y(27) + mat(226) = rxt(232)*y(87) + mat(203) = (rxt(287)+rxt(298))*y(27) + mat(1770) = mat(1770) + rxt(574)*y(115) + 2.000_r8*rxt(572)*y(116) + rxt(575) & + *y(117) + rxt(571)*y(118) + 2.000_r8*rxt(578)*y(119) + rxt(577) & + *y(125) + mat(1894) = mat(1894) + rxt(558)*y(115) + 2.000_r8*rxt(556)*y(116) + rxt(559) & + *y(117) + rxt(555)*y(118) + 2.000_r8*rxt(562)*y(119) + rxt(561) & + *y(125) + mat(183) = mat(183) + rxt(322)*y(130) + mat(218) = mat(218) + rxt(324)*y(130) + mat(140) = mat(140) + 2.000_r8*rxt(325)*y(130) + mat(1381) = mat(1381) + 3.000_r8*rxt(505)*y(107) + 3.000_r8*rxt(501)*y(111) & + + 3.000_r8*rxt(506)*y(112) + 3.000_r8*rxt(515)*y(113) & + + 3.000_r8*rxt(503)*y(114) + 3.000_r8*rxt(504)*y(122) & + + 4.000_r8*rxt(510)*y(115) + 5.000_r8*rxt(508)*y(116) & + + 4.000_r8*rxt(511)*y(117) + 4.000_r8*rxt(507)*y(118) & + + 5.000_r8*rxt(514)*y(119) + 3.000_r8*rxt(500)*y(120) & + + 3.000_r8*rxt(512)*y(121) + 3.000_r8*rxt(509)*y(123) & + + 4.000_r8*rxt(513)*y(125) + 3.000_r8*rxt(502)*y(126) & + + 3.000_r8*rxt(326)*y(130) + mat(1684) = mat(1684) + 4.000_r8*rxt(473)*y(107) + (4.000_r8*rxt(469) & + +4.000_r8*rxt(580))*y(111) + 4.000_r8*rxt(474)*y(112) & + + 4.000_r8*rxt(483)*y(113) + (4.000_r8*rxt(471) & + +4.000_r8*rxt(581))*y(114) + 4.000_r8*rxt(472)*y(122) + ( & + + 5.000_r8*rxt(478)+5.000_r8*rxt(590))*y(115) + ( & + + 6.000_r8*rxt(476)+6.000_r8*rxt(588))*y(116) & + + 5.000_r8*rxt(479)*y(117) + (5.000_r8*rxt(475) & + +5.000_r8*rxt(592))*y(118) + 6.000_r8*rxt(482)*y(119) + ( & + + 4.000_r8*rxt(468)+4.000_r8*rxt(586))*y(120) & + + 4.000_r8*rxt(480)*y(121) + 4.000_r8*rxt(477)*y(123) & + + 5.000_r8*rxt(481)*y(125) + (4.000_r8*rxt(470) & + +4.000_r8*rxt(584))*y(126) + 4.000_r8*rxt(327)*y(130) + mat(1465) = 5.000_r8*rxt(489)*y(107) + (5.000_r8*rxt(485)+5.000_r8*rxt(582)) & + *y(111) + 5.000_r8*rxt(490)*y(112) + 5.000_r8*rxt(499)*y(113) + ( & + + 5.000_r8*rxt(487)+5.000_r8*rxt(583))*y(114) & + + 5.000_r8*rxt(488)*y(122) + (6.000_r8*rxt(494) & + +6.000_r8*rxt(591))*y(115) + (7.000_r8*rxt(492) & + +7.000_r8*rxt(589))*y(116) + 6.000_r8*rxt(495)*y(117) + ( & + + 6.000_r8*rxt(491)+6.000_r8*rxt(593))*y(118) & + + 7.000_r8*rxt(498)*y(119) + (5.000_r8*rxt(484) & + +5.000_r8*rxt(587))*y(120) + 5.000_r8*rxt(496)*y(121) & + + 5.000_r8*rxt(493)*y(123) + 6.000_r8*rxt(497)*y(125) + ( & + + 5.000_r8*rxt(486)+5.000_r8*rxt(585))*y(126) & + + 5.000_r8*rxt(328)*y(130) + mat(82) = mat(82) + rxt(323)*y(130) + mat(1243) = mat(1243) + rxt(521)*y(107) + rxt(517)*y(111) + rxt(522)*y(112) & + + rxt(531)*y(113) + rxt(519)*y(114) + rxt(520)*y(122) & + + 2.000_r8*rxt(526)*y(115) + 3.000_r8*rxt(524)*y(116) & + + 2.000_r8*rxt(527)*y(117) + 2.000_r8*rxt(523)*y(118) & + + 3.000_r8*rxt(530)*y(119) + rxt(516)*y(120) + rxt(528)*y(121) & + + rxt(525)*y(123) + 2.000_r8*rxt(529)*y(125) + rxt(518)*y(126) & + + rxt(319)*y(130) + mat(903) = mat(903) + 2.000_r8*rxt(537)*y(107) + 2.000_r8*rxt(533)*y(111) & + + 2.000_r8*rxt(538)*y(112) + 2.000_r8*rxt(547)*y(113) & + + 2.000_r8*rxt(535)*y(114) + 2.000_r8*rxt(536)*y(122) & + + 3.000_r8*rxt(542)*y(115) + 4.000_r8*rxt(540)*y(116) & + + 3.000_r8*rxt(543)*y(117) + 3.000_r8*rxt(539)*y(118) & + + 4.000_r8*rxt(546)*y(119) + 2.000_r8*rxt(532)*y(120) & + + 2.000_r8*rxt(544)*y(121) + 2.000_r8*rxt(541)*y(123) & + + 3.000_r8*rxt(545)*y(125) + 2.000_r8*rxt(534)*y(126) & + + 2.000_r8*rxt(320)*y(130) + mat(86) = mat(86) + 3.000_r8*rxt(321)*y(130) + mat(1279) = mat(1279) + rxt(368)*y(17) + mat(1806) = 3.000_r8*rxt(505)*y(95) + 4.000_r8*rxt(473)*y(96) & + + 5.000_r8*rxt(489)*y(97) + rxt(521)*y(101) + 2.000_r8*rxt(537) & + *y(102) + mat(860) = mat(860) + 3.000_r8*rxt(501)*y(95) + (4.000_r8*rxt(469) & + +4.000_r8*rxt(580))*y(96) + (5.000_r8*rxt(485) & + +5.000_r8*rxt(582))*y(97) + rxt(517)*y(101) + 2.000_r8*rxt(533) & + *y(102) + mat(693) = 3.000_r8*rxt(506)*y(95) + 4.000_r8*rxt(474)*y(96) & + + 5.000_r8*rxt(490)*y(97) + rxt(522)*y(101) + 2.000_r8*rxt(538) & + *y(102) + mat(781) = mat(781) + 3.000_r8*rxt(515)*y(95) + 4.000_r8*rxt(483)*y(96) & + + 5.000_r8*rxt(499)*y(97) + rxt(531)*y(101) + 2.000_r8*rxt(547) & + *y(102) + mat(720) = mat(720) + 3.000_r8*rxt(503)*y(95) + (4.000_r8*rxt(471) & + +4.000_r8*rxt(581))*y(96) + (5.000_r8*rxt(487) & + +5.000_r8*rxt(583))*y(97) + rxt(519)*y(101) + 2.000_r8*rxt(535) & + *y(102) + mat(973) = rxt(376)*y(18) + rxt(408)*y(27) + mat(342) = 3.000_r8*rxt(504)*y(95) + 4.000_r8*rxt(472)*y(96) & + + 5.000_r8*rxt(488)*y(97) + rxt(520)*y(101) + 2.000_r8*rxt(536) & + *y(102) + mat(542) = mat(542) + rxt(450)*y(6) + rxt(451)*y(7) + rxt(574)*y(90) & + + rxt(558)*y(129) + 4.000_r8*rxt(510)*y(95) + (5.000_r8*rxt(478) & + +5.000_r8*rxt(590))*y(96) + (6.000_r8*rxt(494) & + +6.000_r8*rxt(591))*y(97) + 2.000_r8*rxt(526)*y(101) & + + 3.000_r8*rxt(542)*y(102) + mat(374) = 2.000_r8*rxt(572)*y(90) + 2.000_r8*rxt(556)*y(129) & + + 5.000_r8*rxt(508)*y(95) + (6.000_r8*rxt(476)+6.000_r8*rxt(588)) & + *y(96) + (7.000_r8*rxt(492)+7.000_r8*rxt(589))*y(97) & + + 3.000_r8*rxt(524)*y(101) + 4.000_r8*rxt(540)*y(102) + mat(419) = rxt(575)*y(90) + rxt(559)*y(129) + 4.000_r8*rxt(511)*y(95) & + + 5.000_r8*rxt(479)*y(96) + 6.000_r8*rxt(495)*y(97) & + + 2.000_r8*rxt(527)*y(101) + 3.000_r8*rxt(543)*y(102) + mat(561) = mat(561) + rxt(467)*y(9) + rxt(571)*y(90) + rxt(555)*y(129) & + + 4.000_r8*rxt(507)*y(95) + (5.000_r8*rxt(475)+5.000_r8*rxt(592)) & + *y(96) + (6.000_r8*rxt(491)+6.000_r8*rxt(593))*y(97) & + + 2.000_r8*rxt(523)*y(101) + 3.000_r8*rxt(539)*y(102) + mat(520) = rxt(461)*y(11) + 2.000_r8*rxt(578)*y(90) + 2.000_r8*rxt(562) & + *y(129) + 5.000_r8*rxt(514)*y(95) + 6.000_r8*rxt(482)*y(96) & + + 7.000_r8*rxt(498)*y(97) + 3.000_r8*rxt(530)*y(101) & + + 4.000_r8*rxt(546)*y(102) + mat(501) = 3.000_r8*rxt(500)*y(95) + (4.000_r8*rxt(468)+4.000_r8*rxt(586)) & + *y(96) + (5.000_r8*rxt(484)+5.000_r8*rxt(587))*y(97) + rxt(516) & + *y(101) + 2.000_r8*rxt(532)*y(102) + mat(434) = 3.000_r8*rxt(512)*y(95) + 4.000_r8*rxt(480)*y(96) & + + 5.000_r8*rxt(496)*y(97) + rxt(528)*y(101) + 2.000_r8*rxt(544) & + *y(102) + mat(664) = mat(664) + 3.000_r8*rxt(509)*y(95) + 4.000_r8*rxt(477)*y(96) & + + 5.000_r8*rxt(493)*y(97) + rxt(525)*y(101) + 2.000_r8*rxt(541) & + *y(102) + mat(405) = rxt(444)*y(27) + rxt(577)*y(90) + rxt(561)*y(129) & + + 4.000_r8*rxt(513)*y(95) + 5.000_r8*rxt(481)*y(96) & + + 6.000_r8*rxt(497)*y(97) + 2.000_r8*rxt(529)*y(101) & + + 3.000_r8*rxt(545)*y(102) + mat(389) = 3.000_r8*rxt(502)*y(95) + (4.000_r8*rxt(470)+4.000_r8*rxt(584)) & + *y(96) + (5.000_r8*rxt(486)+5.000_r8*rxt(585))*y(97) + rxt(518) & + *y(101) + 2.000_r8*rxt(534)*y(102) + mat(1155) = rxt(322)*y(92) + rxt(324)*y(93) + 2.000_r8*rxt(325)*y(94) & + + 3.000_r8*rxt(326)*y(95) + 4.000_r8*rxt(327)*y(96) & + + 5.000_r8*rxt(328)*y(97) + rxt(323)*y(98) + rxt(319)*y(101) & + + 2.000_r8*rxt(320)*y(102) + 3.000_r8*rxt(321)*y(103) + end subroutine nlnmat04 + subroutine nlnmat05( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1860) = -(rxt(193)*y(1) + rxt(194)*y(17) + rxt(195)*y(19) + (rxt(196) & + + rxt(197)) * y(88) + rxt(198)*y(15) + rxt(215)*y(28) + rxt(219) & + *y(29) + rxt(385)*y(106) + rxt(395)*y(107) + rxt(409)*y(110) & + + (rxt(417) + rxt(418)) * y(111) + rxt(424)*y(112) + rxt(431) & + *y(113)) + mat(1069) = -rxt(193)*y(85) + mat(594) = -rxt(194)*y(85) + mat(135) = -rxt(195)*y(85) + mat(765) = -(rxt(196) + rxt(197)) * y(85) + mat(458) = -rxt(198)*y(85) + mat(234) = -rxt(215)*y(85) + mat(264) = -rxt(219)*y(85) + mat(1291) = -rxt(385)*y(85) + mat(1818) = -rxt(395)*y(85) + mat(985) = -rxt(409)*y(85) + mat(872) = -(rxt(417) + rxt(418)) * y(85) + mat(704) = -rxt(424)*y(85) + mat(791) = -rxt(431)*y(85) + mat(1127) = rxt(200)*y(24) + rxt(213)*y(27) + mat(652) = rxt(147)*y(27) + rxt(142)*y(54) + mat(1520) = rxt(205)*y(24) + rxt(441)*y(124) + mat(1566) = rxt(437)*y(123) + mat(839) = rxt(201)*y(24) + rxt(212)*y(27) + mat(306) = rxt(204)*y(24) + mat(1612) = rxt(200)*y(2) + rxt(205)*y(6) + rxt(201)*y(87) + rxt(204)*y(13) + ( & + + 4.000_r8*rxt(207)+2.000_r8*rxt(209))*y(24) + rxt(229)*y(31) & + + rxt(274)*y(60) + mat(1029) = rxt(213)*y(2) + rxt(147)*y(134) + rxt(212)*y(87) + mat(495) = rxt(229)*y(24) + mat(1782) = rxt(573)*y(123) + rxt(577)*y(125) + rxt(566)*y(126) + mat(1906) = rxt(557)*y(123) + rxt(561)*y(125) + rxt(550)*y(126) + mat(1393) = rxt(509)*y(123) + rxt(513)*y(125) + rxt(502)*y(126) + mat(1696) = rxt(477)*y(123) + rxt(481)*y(125) + rxt(470)*y(126) + mat(1477) = rxt(493)*y(123) + rxt(497)*y(125) + rxt(486)*y(126) + mat(1255) = rxt(525)*y(123) + rxt(529)*y(125) + rxt(518)*y(126) + mat(915) = rxt(541)*y(123) + rxt(545)*y(125) + rxt(534)*y(126) + mat(672) = rxt(437)*y(7) + rxt(573)*y(90) + rxt(557)*y(129) + rxt(509)*y(95) & + + rxt(477)*y(96) + rxt(493)*y(97) + rxt(525)*y(101) + rxt(541) & + *y(102) + mat(272) = rxt(441)*y(6) + mat(411) = rxt(577)*y(90) + rxt(561)*y(129) + rxt(513)*y(95) + rxt(481)*y(96) & + + rxt(497)*y(97) + rxt(529)*y(101) + rxt(545)*y(102) + mat(395) = rxt(566)*y(90) + rxt(550)*y(129) + rxt(502)*y(95) + rxt(470)*y(96) & + + rxt(486)*y(97) + rxt(518)*y(101) + rxt(534)*y(102) + mat(35) = rxt(142)*y(134) + mat(366) = rxt(274)*y(24) + mat(1820) = rxt(219)*y(29) + mat(1569) = 2.000_r8*rxt(208)*y(24) + mat(987) = (rxt(286)+rxt(291)+rxt(297))*y(28) + (rxt(285)+rxt(290)+rxt(296)) & + *y(29) + mat(227) = (rxt(286)+rxt(291)+rxt(297))*y(27) + mat(253) = rxt(219)*y(85) + (rxt(285)+rxt(290)+rxt(296))*y(27) + mat(1606) = -(rxt(200)*y(2) + (rxt(201) + rxt(202)) * y(87) + rxt(203)*y(88) & + + rxt(204)*y(13) + rxt(205)*y(6) + rxt(206)*y(7) + (4._r8*rxt(207) & + + 4._r8*rxt(208) + 4._r8*rxt(209) + 4._r8*rxt(210)) * y(24) & + + (rxt(228) + rxt(229) + rxt(230)) * y(31) + rxt(274)*y(60) & + + rxt(386)*y(106) + rxt(394)*y(107) + rxt(410)*y(110) + rxt(419) & + *y(111) + rxt(425)*y(112) + rxt(432)*y(113)) + mat(1121) = -rxt(200)*y(24) + mat(834) = -(rxt(201) + rxt(202)) * y(24) + mat(760) = -rxt(203)*y(24) + mat(305) = -rxt(204)*y(24) + mat(1514) = -rxt(205)*y(24) + mat(1560) = -rxt(206)*y(24) + mat(492) = -(rxt(228) + rxt(229) + rxt(230)) * y(24) + mat(365) = -rxt(274)*y(24) + mat(1285) = -rxt(386)*y(24) + mat(1812) = -rxt(394)*y(24) + mat(979) = -rxt(410)*y(24) + mat(866) = -rxt(419)*y(24) + mat(699) = -rxt(425)*y(24) + mat(786) = -rxt(432)*y(24) + mat(1063) = rxt(193)*y(85) + mat(1121) = mat(1121) + rxt(214)*y(28) + rxt(217)*y(29) + mat(834) = mat(834) + rxt(216)*y(28) + mat(760) = mat(760) + rxt(197)*y(85) + mat(1854) = rxt(193)*y(1) + rxt(197)*y(88) + rxt(215)*y(28) + mat(68) = rxt(276)*y(60) + mat(233) = rxt(214)*y(2) + rxt(216)*y(87) + rxt(215)*y(85) + mat(261) = rxt(217)*y(2) + mat(365) = mat(365) + rxt(276)*y(25) + mat(64) = -(rxt(276)*y(60)) + mat(350) = -rxt(276)*y(25) + mat(1571) = 2.000_r8*rxt(209)*y(24) + rxt(228)*y(31) + mat(475) = rxt(228)*y(24) + mat(1568) = 2.000_r8*rxt(210)*y(24) + mat(1010) = -(rxt(147)*y(134) + rxt(212)*y(87) + rxt(213)*y(2) + (rxt(285) & + + rxt(290) + rxt(296)) * y(29) + (rxt(286) + rxt(291) + rxt(297) & + ) * y(28) + (rxt(287) + rxt(298)) * y(33) + rxt(384)*y(106) & + + rxt(393)*y(107) + rxt(408)*y(110) + rxt(423)*y(112) + rxt(430) & + *y(113) + (rxt(435) + rxt(465)) * y(114) + rxt(440)*y(123) & + + rxt(444)*y(125)) + mat(636) = -rxt(147)*y(27) + mat(822) = -rxt(212)*y(27) + mat(1108) = -rxt(213)*y(27) + mat(257) = -(rxt(285) + rxt(290) + rxt(296)) * y(27) + mat(230) = -(rxt(286) + rxt(291) + rxt(297)) * y(27) + mat(201) = -(rxt(287) + rxt(298)) * y(27) + mat(1272) = -rxt(384)*y(27) + mat(1799) = -rxt(393)*y(27) + mat(966) = -rxt(408)*y(27) + mat(686) = -rxt(423)*y(27) + mat(775) = -rxt(430)*y(27) + mat(714) = -(rxt(435) + rxt(465)) * y(27) + mat(660) = -rxt(440)*y(27) + mat(402) = -rxt(444)*y(27) + mat(582) = rxt(194)*y(85) + mat(822) = mat(822) + rxt(202)*y(24) + mat(1717) = rxt(464)*y(121) + rxt(438)*y(123) + mat(452) = rxt(198)*y(85) + mat(933) = rxt(436)*y(123) + mat(748) = rxt(196)*y(85) + mat(132) = rxt(195)*y(85) + mat(1841) = rxt(194)*y(17) + rxt(198)*y(15) + rxt(196)*y(88) + rxt(195)*y(19) & + + rxt(215)*y(28) + mat(1593) = rxt(202)*y(87) + mat(230) = mat(230) + rxt(215)*y(85) + mat(1763) = rxt(576)*y(121) + rxt(566)*y(126) + mat(1887) = rxt(560)*y(121) + rxt(550)*y(126) + mat(1374) = rxt(512)*y(121) + rxt(502)*y(126) + mat(1677) = rxt(480)*y(121) + (rxt(470)+2.000_r8*rxt(584))*y(126) + mat(1458) = rxt(496)*y(121) + (rxt(486)+2.000_r8*rxt(585))*y(126) + mat(1236) = rxt(528)*y(121) + rxt(518)*y(126) + mat(896) = rxt(544)*y(121) + rxt(534)*y(126) + mat(431) = rxt(464)*y(9) + rxt(576)*y(90) + rxt(560)*y(129) + rxt(512)*y(95) & + + rxt(480)*y(96) + rxt(496)*y(97) + rxt(528)*y(101) + rxt(544) & + *y(102) + mat(660) = mat(660) + rxt(438)*y(9) + rxt(436)*y(18) + mat(386) = rxt(566)*y(90) + rxt(550)*y(129) + rxt(502)*y(95) + (rxt(470) & + +2.000_r8*rxt(584))*y(96) + (rxt(486)+2.000_r8*rxt(585))*y(97) & + + rxt(518)*y(101) + rxt(534)*y(102) + mat(228) = -(rxt(214)*y(2) + rxt(215)*y(85) + rxt(216)*y(87) + (rxt(286) & + + rxt(291) + rxt(297)) * y(27)) + mat(1083) = -rxt(214)*y(28) + mat(1823) = -rxt(215)*y(28) + mat(807) = -rxt(216)*y(28) + mat(991) = -(rxt(286) + rxt(291) + rxt(297)) * y(28) + mat(807) = mat(807) + rxt(218)*y(29) + mat(737) = rxt(203)*y(24) + mat(1572) = rxt(203)*y(88) + mat(254) = rxt(218)*y(87) + mat(255) = -(rxt(217)*y(2) + rxt(218)*y(87) + rxt(219)*y(85) + (rxt(285) & + + rxt(290) + rxt(296)) * y(27)) + mat(1086) = -rxt(217)*y(29) + mat(809) = -rxt(218)*y(29) + mat(1824) = -rxt(219)*y(29) + mat(992) = -(rxt(285) + rxt(290) + rxt(296)) * y(29) + mat(1526) = rxt(206)*y(24) + mat(1574) = rxt(206)*y(7) + mat(1570) = rxt(230)*y(31) + mat(988) = (rxt(287)+rxt(298))*y(33) + mat(474) = rxt(230)*y(24) + mat(196) = (rxt(287)+rxt(298))*y(27) + mat(600) = -(rxt(220)*y(1) + rxt(221)*y(88) + rxt(222)*y(15)) + mat(1039) = -rxt(220)*y(86) + mat(742) = -rxt(221)*y(86) + mat(447) = -rxt(222)*y(86) + mat(1096) = rxt(223)*y(31) + rxt(233)*y(32) + mat(630) = rxt(148)*y(32) + mat(1490) = rxt(226)*y(31) + mat(816) = rxt(224)*y(31) + rxt(232)*y(32) + mat(1581) = (rxt(228)+rxt(229))*y(31) + mat(481) = rxt(223)*y(2) + rxt(226)*y(6) + rxt(224)*y(87) + (rxt(228) & + +rxt(229))*y(24) + 4.000_r8*rxt(231)*y(31) + rxt(275)*y(60) + mat(221) = rxt(233)*y(2) + rxt(148)*y(134) + rxt(232)*y(87) + mat(355) = rxt(275)*y(31) + mat(480) = -(rxt(223)*y(2) + rxt(224)*y(87) + rxt(225)*y(88) + rxt(226)*y(6) & + + rxt(227)*y(7) + (rxt(228) + rxt(229) + rxt(230)) * y(24) & + + 4._r8*rxt(231)*y(31) + rxt(275)*y(60)) + mat(1094) = -rxt(223)*y(31) + mat(814) = -rxt(224)*y(31) + mat(740) = -rxt(225)*y(31) + mat(1486) = -rxt(226)*y(31) + mat(1531) = -rxt(227)*y(31) + mat(1579) = -(rxt(228) + rxt(229) + rxt(230)) * y(31) + mat(354) = -rxt(275)*y(31) + mat(1038) = rxt(220)*y(86) + mat(1094) = mat(1094) + rxt(234)*y(33) + rxt(235)*y(34) + mat(598) = rxt(220)*y(1) + mat(198) = rxt(234)*y(2) + mat(116) = rxt(235)*y(2) + mat(220) = -(rxt(148)*y(134) + rxt(232)*y(87) + rxt(233)*y(2)) + mat(624) = -rxt(148)*y(32) + mat(806) = -rxt(232)*y(32) + mat(1082) = -rxt(233)*y(32) + mat(444) = rxt(222)*y(86) + mat(736) = rxt(221)*y(86) + mat(596) = rxt(222)*y(15) + rxt(221)*y(88) + mat(197) = -(rxt(234)*y(2) + (rxt(287) + rxt(298)) * y(27)) + mat(1081) = -rxt(234)*y(33) + mat(990) = -(rxt(287) + rxt(298)) * y(33) + mat(734) = rxt(225)*y(31) + mat(477) = rxt(225)*y(88) + mat(114) = -(rxt(235)*y(2)) + mat(1075) = -rxt(235)*y(34) + mat(1523) = rxt(227)*y(31) + mat(476) = rxt(227)*y(7) + mat(143) = -((rxt(301) + rxt(302)) * y(2) + rxt(309)*y(3) + rxt(313)*y(130)) + mat(1078) = -(rxt(301) + rxt(302)) * y(89) + mat(1173) = -rxt(309)*y(89) + mat(1133) = -rxt(313)*y(89) + mat(1780) = -(rxt(304)*y(5) + rxt(305)*y(6) + rxt(312)*y(130) + rxt(332)*y(3) & + + rxt(333)*y(135) + rxt(564)*y(120) + rxt(565)*y(111) + rxt(566) & + *y(126) + rxt(567)*y(114) + rxt(568)*y(122) + rxt(569)*y(107) & + + rxt(570)*y(112) + rxt(571)*y(118) + rxt(572)*y(116) + rxt(573) & + *y(123) + rxt(574)*y(115) + rxt(575)*y(117) + rxt(576)*y(121) & + + rxt(577)*y(125) + rxt(578)*y(119) + rxt(579)*y(113)) + mat(319) = -rxt(304)*y(90) + mat(1518) = -rxt(305)*y(90) + mat(1165) = -rxt(312)*y(90) + mat(1211) = -rxt(332)*y(90) + mat(1348) = -rxt(333)*y(90) + mat(508) = -rxt(564)*y(90) + mat(870) = -rxt(565)*y(90) + mat(394) = -rxt(566)*y(90) + mat(728) = -rxt(567)*y(90) + mat(348) = -rxt(568)*y(90) + mat(1816) = -rxt(569)*y(90) + mat(702) = -rxt(570)*y(90) + mat(569) = -rxt(571)*y(90) + mat(380) = -rxt(572)*y(90) + mat(671) = -rxt(573)*y(90) + mat(549) = -rxt(574)*y(90) + mat(425) = -rxt(575)*y(90) + mat(441) = -rxt(576)*y(90) + mat(410) = -rxt(577)*y(90) + mat(528) = -rxt(578)*y(90) + mat(790) = -rxt(579)*y(90) + mat(1125) = rxt(336)*y(91) + mat(1211) = mat(1211) + rxt(309)*y(89) + rxt(306)*y(127) + rxt(299)*y(128) + mat(279) = rxt(335)*y(91) + mat(1432) = rxt(303)*y(128) + mat(151) = rxt(309)*y(3) + mat(1780) = mat(1780) + 2.000_r8*rxt(569)*y(107) + mat(100) = rxt(306)*y(3) + mat(244) = rxt(299)*y(3) + rxt(303)*y(57) + mat(334) = rxt(336)*y(2) + rxt(335)*y(133) + mat(1816) = mat(1816) + 2.000_r8*rxt(569)*y(90) + end subroutine nlnmat05 + subroutine nlnmat06( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(95) = -((rxt(306) + rxt(307)) * y(3) + rxt(308)*y(2)) + mat(1170) = -(rxt(306) + rxt(307)) * y(127) + mat(1073) = -rxt(308)*y(127) + mat(236) = -(rxt(299)*y(3) + rxt(303)*y(57)) + mat(1175) = -rxt(299)*y(128) + mat(1400) = -rxt(303)*y(128) + mat(1084) = rxt(302)*y(89) + rxt(308)*y(127) + mat(144) = rxt(302)*y(2) + mat(96) = rxt(308)*y(2) + mat(1907) = -(rxt(311)*y(130) + rxt(352)*y(135) + rxt(360)*y(57) + rxt(548) & + *y(120) + rxt(549)*y(111) + rxt(550)*y(126) + rxt(551)*y(114) & + + rxt(552)*y(122) + rxt(553)*y(107) + rxt(554)*y(112) + rxt(555) & + *y(118) + rxt(556)*y(116) + rxt(557)*y(123) + rxt(558)*y(115) & + + rxt(559)*y(117) + rxt(560)*y(121) + rxt(561)*y(125) + rxt(562) & + *y(119) + rxt(563)*y(113)) + mat(1168) = -rxt(311)*y(129) + mat(1351) = -rxt(352)*y(129) + mat(1435) = -rxt(360)*y(129) + mat(509) = -rxt(548)*y(129) + mat(873) = -rxt(549)*y(129) + mat(396) = -rxt(550)*y(129) + mat(730) = -rxt(551)*y(129) + mat(349) = -rxt(552)*y(129) + mat(1819) = -rxt(553)*y(129) + mat(705) = -rxt(554)*y(129) + mat(570) = -rxt(555)*y(129) + mat(381) = -rxt(556)*y(129) + mat(673) = -rxt(557)*y(129) + mat(550) = -rxt(558)*y(129) + mat(426) = -rxt(559)*y(129) + mat(442) = -rxt(560)*y(129) + mat(412) = -rxt(561)*y(129) + mat(529) = -rxt(562)*y(129) + mat(792) = -rxt(563)*y(129) + mat(1128) = rxt(301)*y(89) + mat(1214) = rxt(307)*y(127) + mat(320) = rxt(304)*y(90) + mat(1521) = rxt(305)*y(90) + mat(152) = rxt(301)*y(2) + mat(1783) = rxt(304)*y(5) + rxt(305)*y(6) + mat(101) = rxt(307)*y(3) + mat(109) = -(rxt(168)*y(3) + rxt(169)*y(2)) + mat(1171) = -rxt(168)*y(131) + mat(1074) = -rxt(169)*y(131) + mat(1074) = mat(1074) + rxt(301)*y(89) + mat(142) = rxt(301)*y(2) + .900_r8*rxt(313)*y(130) + mat(1862) = .800_r8*rxt(311)*y(130) + mat(1131) = .900_r8*rxt(313)*y(89) + .800_r8*rxt(311)*y(129) + mat(324) = -(rxt(317)*y(130) + rxt(334)*y(135) + rxt(335)*y(133) + rxt(336) & + *y(2)) + mat(1141) = -rxt(317)*y(91) + mat(1309) = -rxt(334)*y(91) + mat(274) = -rxt(335)*y(91) + mat(1090) = -rxt(336)*y(91) + mat(1179) = rxt(332)*y(90) + mat(1741) = rxt(332)*y(3) + mat(177) = -(rxt(322)*y(130) + (rxt(337) + rxt(338)) * y(135)) + mat(1136) = -rxt(322)*y(92) + mat(1303) = -(rxt(337) + rxt(338)) * y(92) + mat(1303) = mat(1303) + rxt(333)*y(90) + rxt(334)*y(91) + mat(1738) = rxt(333)*y(135) + mat(321) = rxt(334)*y(135) + mat(215) = -(rxt(324)*y(130) + rxt(340)*y(135)) + mat(1138) = -rxt(324)*y(93) + mat(1306) = -rxt(340)*y(93) + mat(805) = rxt(355)*y(101) + mat(918) = rxt(356)*y(101) + mat(735) = rxt(354)*y(101) + mat(1306) = mat(1306) + rxt(338)*y(92) + mat(178) = rxt(338)*y(135) + mat(1215) = rxt(355)*y(87) + rxt(356)*y(18) + rxt(354)*y(88) + mat(136) = -(rxt(325)*y(130) + rxt(342)*y(135)) + mat(1132) = -rxt(325)*y(94) + mat(1300) = -rxt(342)*y(94) + mat(1300) = mat(1300) + rxt(340)*y(93) + rxt(339)*y(98) + mat(214) = rxt(340)*y(135) + mat(78) = rxt(339)*y(135) + mat(1382) = -(rxt(326)*y(130) + rxt(344)*y(135) + rxt(500)*y(120) + rxt(501) & + *y(111) + rxt(502)*y(126) + rxt(503)*y(114) + rxt(504)*y(122) & + + rxt(505)*y(107) + rxt(506)*y(112) + rxt(507)*y(118) + rxt(508) & + *y(116) + rxt(509)*y(123) + rxt(510)*y(115) + rxt(511)*y(117) & + + rxt(512)*y(121) + rxt(513)*y(125) + rxt(514)*y(119) + rxt(515) & + *y(113)) + mat(1156) = -rxt(326)*y(95) + mat(1339) = -rxt(344)*y(95) + mat(502) = -rxt(500)*y(95) + mat(861) = -rxt(501)*y(95) + mat(390) = -rxt(502)*y(95) + mat(721) = -rxt(503)*y(95) + mat(343) = -rxt(504)*y(95) + mat(1807) = -rxt(505)*y(95) + mat(694) = -rxt(506)*y(95) + mat(562) = -rxt(507)*y(95) + mat(375) = -rxt(508)*y(95) + mat(665) = -rxt(509)*y(95) + mat(543) = -rxt(510)*y(95) + mat(420) = -rxt(511)*y(95) + mat(435) = -rxt(512)*y(95) + mat(406) = -rxt(513)*y(95) + mat(521) = -rxt(514)*y(95) + mat(782) = -rxt(515)*y(95) + mat(1339) = mat(1339) + rxt(342)*y(94) + rxt(358)*y(103) + mat(141) = rxt(342)*y(135) + mat(87) = rxt(358)*y(135) + mat(1692) = -(rxt(327)*y(130) + rxt(346)*y(135) + rxt(348)*y(11) + (rxt(468) & + + rxt(586)) * y(120) + (rxt(469) + rxt(580)) * y(111) + (rxt(470) & + + rxt(584)) * y(126) + (rxt(471) + rxt(581)) * y(114) + rxt(472) & + *y(122) + rxt(473)*y(107) + rxt(474)*y(112) + (rxt(475) + rxt(592) & + ) * y(118) + (rxt(476) + rxt(588)) * y(116) + rxt(477)*y(123) & + + (rxt(478) + rxt(590)) * y(115) + rxt(479)*y(117) + rxt(480) & + *y(121) + rxt(481)*y(125) + rxt(482)*y(119) + rxt(483)*y(113)) + mat(1163) = -rxt(327)*y(96) + mat(1346) = -rxt(346)*y(96) + mat(293) = -rxt(348)*y(96) + mat(506) = -(rxt(468) + rxt(586)) * y(96) + mat(868) = -(rxt(469) + rxt(580)) * y(96) + mat(393) = -(rxt(470) + rxt(584)) * y(96) + mat(726) = -(rxt(471) + rxt(581)) * y(96) + mat(347) = -rxt(472)*y(96) + mat(1814) = -rxt(473)*y(96) + mat(700) = -rxt(474)*y(96) + mat(567) = -(rxt(475) + rxt(592)) * y(96) + mat(379) = -(rxt(476) + rxt(588)) * y(96) + mat(669) = -rxt(477)*y(96) + mat(548) = -(rxt(478) + rxt(590)) * y(96) + mat(424) = -rxt(479)*y(96) + mat(439) = -rxt(480)*y(96) + mat(409) = -rxt(481)*y(96) + mat(526) = -rxt(482)*y(96) + mat(788) = -rxt(483)*y(96) + mat(1346) = mat(1346) + rxt(344)*y(95) + rxt(350)*y(99) + mat(1389) = rxt(344)*y(135) + mat(44) = rxt(350)*y(135) + mat(1468) = -(rxt(328)*y(130) + rxt(349)*y(11) + (rxt(484) + rxt(587) & + ) * y(120) + (rxt(485) + rxt(582)) * y(111) + (rxt(486) + rxt(585) & + ) * y(126) + (rxt(487) + rxt(583)) * y(114) + rxt(488)*y(122) & + + rxt(489)*y(107) + rxt(490)*y(112) + (rxt(491) + rxt(593) & + ) * y(118) + (rxt(492) + rxt(589)) * y(116) + rxt(493)*y(123) & + + (rxt(494) + rxt(591)) * y(115) + rxt(495)*y(117) + rxt(496) & + *y(121) + rxt(497)*y(125) + rxt(498)*y(119) + rxt(499)*y(113)) + mat(1158) = -rxt(328)*y(97) + mat(289) = -rxt(349)*y(97) + mat(503) = -(rxt(484) + rxt(587)) * y(97) + mat(863) = -(rxt(485) + rxt(582)) * y(97) + mat(391) = -(rxt(486) + rxt(585)) * y(97) + mat(722) = -(rxt(487) + rxt(583)) * y(97) + mat(345) = -rxt(488)*y(97) + mat(1809) = -rxt(489)*y(97) + mat(696) = -rxt(490)*y(97) + mat(563) = -(rxt(491) + rxt(593)) * y(97) + mat(377) = -(rxt(492) + rxt(589)) * y(97) + mat(666) = -rxt(493)*y(97) + mat(545) = -(rxt(494) + rxt(591)) * y(97) + mat(421) = -rxt(495)*y(97) + mat(436) = -rxt(496)*y(97) + mat(407) = -rxt(497)*y(97) + mat(522) = -rxt(498)*y(97) + mat(783) = -rxt(499)*y(97) + mat(1341) = rxt(346)*y(96) + rxt(351)*y(100) + mat(1687) = rxt(346)*y(135) + mat(48) = rxt(351)*y(135) + mat(77) = -(rxt(323)*y(130) + rxt(339)*y(135)) + mat(1129) = -rxt(323)*y(98) + mat(1298) = -rxt(339)*y(98) + mat(1298) = mat(1298) + rxt(337)*y(92) + mat(175) = rxt(337)*y(135) + mat(42) = -(rxt(350)*y(135)) + mat(1295) = -rxt(350)*y(99) + mat(281) = rxt(348)*y(96) + mat(1655) = rxt(348)*y(11) + mat(46) = -(rxt(351)*y(135)) + mat(1296) = -rxt(351)*y(100) + mat(282) = rxt(349)*y(97) + mat(1436) = rxt(349)*y(11) + mat(1241) = -(rxt(319)*y(130) + rxt(353)*y(135) + rxt(354)*y(88) + rxt(355) & + *y(87) + rxt(356)*y(18) + rxt(516)*y(120) + rxt(517)*y(111) & + + rxt(518)*y(126) + rxt(519)*y(114) + rxt(520)*y(122) + rxt(521) & + *y(107) + rxt(522)*y(112) + rxt(523)*y(118) + rxt(524)*y(116) & + + rxt(525)*y(123) + rxt(526)*y(115) + rxt(527)*y(117) + rxt(528) & + *y(121) + rxt(529)*y(125) + rxt(530)*y(119) + rxt(531)*y(113)) + mat(1153) = -rxt(319)*y(101) + mat(1336) = -rxt(353)*y(101) + mat(753) = -rxt(354)*y(101) + mat(827) = -rxt(355)*y(101) + mat(938) = -rxt(356)*y(101) + mat(500) = -rxt(516)*y(101) + mat(858) = -rxt(517)*y(101) + mat(388) = -rxt(518)*y(101) + mat(719) = -rxt(519)*y(101) + mat(341) = -rxt(520)*y(101) + mat(1804) = -rxt(521)*y(101) + mat(691) = -rxt(522)*y(101) + mat(560) = -rxt(523)*y(101) + mat(373) = -rxt(524)*y(101) + mat(663) = -rxt(525)*y(101) + mat(541) = -rxt(526)*y(101) + mat(418) = -rxt(527)*y(101) + mat(433) = -rxt(528)*y(101) + mat(404) = -rxt(529)*y(101) + mat(519) = -rxt(530)*y(101) + mat(780) = -rxt(531)*y(101) + mat(1336) = mat(1336) + rxt(352)*y(129) + rxt(359)*y(104) + rxt(331)*y(105) + mat(1892) = rxt(352)*y(135) + mat(163) = rxt(359)*y(135) + mat(156) = rxt(331)*y(135) + end subroutine nlnmat06 + subroutine nlnmat07( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(893) = -(rxt(320)*y(130) + rxt(357)*y(135) + rxt(532)*y(120) + rxt(533) & + *y(111) + rxt(534)*y(126) + rxt(535)*y(114) + rxt(536)*y(122) & + + rxt(537)*y(107) + rxt(538)*y(112) + rxt(539)*y(118) + rxt(540) & + *y(116) + rxt(541)*y(123) + rxt(542)*y(115) + rxt(543)*y(117) & + + rxt(544)*y(121) + rxt(545)*y(125) + rxt(546)*y(119) + rxt(547) & + *y(113)) + mat(1145) = -rxt(320)*y(102) + mat(1328) = -rxt(357)*y(102) + mat(498) = -rxt(532)*y(102) + mat(850) = -rxt(533)*y(102) + mat(384) = -rxt(534)*y(102) + mat(712) = -rxt(535)*y(102) + mat(338) = -rxt(536)*y(102) + mat(1796) = -rxt(537)*y(102) + mat(683) = -rxt(538)*y(102) + mat(556) = -rxt(539)*y(102) + mat(369) = -rxt(540)*y(102) + mat(658) = -rxt(541)*y(102) + mat(537) = -rxt(542)*y(102) + mat(415) = -rxt(543)*y(102) + mat(429) = -rxt(544)*y(102) + mat(400) = -rxt(545)*y(102) + mat(515) = -rxt(546)*y(102) + mat(772) = -rxt(547)*y(102) + mat(1328) = mat(1328) + rxt(353)*y(101) + mat(1233) = rxt(353)*y(135) + mat(83) = -(rxt(321)*y(130) + rxt(358)*y(135)) + mat(1130) = -rxt(321)*y(103) + mat(1299) = -rxt(358)*y(103) + mat(1299) = mat(1299) + rxt(357)*y(102) + mat(874) = rxt(357)*y(135) + mat(161) = -(rxt(318)*y(130) + rxt(359)*y(135)) + mat(1135) = -rxt(318)*y(104) + mat(1302) = -rxt(359)*y(104) + mat(1398) = rxt(360)*y(129) + rxt(330)*y(105) + mat(1864) = rxt(360)*y(57) + mat(154) = rxt(330)*y(57) + mat(153) = -(rxt(329)*y(130) + rxt(330)*y(57) + rxt(331)*y(135)) + mat(1134) = -rxt(329)*y(105) + mat(1397) = -rxt(330)*y(105) + mat(1301) = -rxt(331)*y(105) + mat(1278) = -(rxt(364)*y(2) + rxt(365)*y(6) + rxt(366)*y(133) + (rxt(368) & + + rxt(382)) * y(17) + rxt(377)*y(1) + rxt(378)*y(3) + rxt(379) & + *y(135) + rxt(380)*y(7) + rxt(381)*y(57) + rxt(383)*y(9) + rxt(384) & + *y(27) + rxt(385)*y(85) + rxt(386)*y(24)) + mat(1114) = -rxt(364)*y(106) + mat(1507) = -rxt(365)*y(106) + mat(278) = -rxt(366)*y(106) + mat(586) = -(rxt(368) + rxt(382)) * y(106) + mat(1056) = -rxt(377)*y(106) + mat(1200) = -rxt(378)*y(106) + mat(1337) = -rxt(379)*y(106) + mat(1553) = -rxt(380)*y(106) + mat(1421) = -rxt(381)*y(106) + mat(1723) = -rxt(383)*y(106) + mat(1016) = -rxt(384)*y(106) + mat(1847) = -rxt(385)*y(106) + mat(1599) = -rxt(386)*y(106) + mat(1056) = mat(1056) + rxt(315)*y(130) + mat(1114) = mat(1114) + rxt(387)*y(107) + mat(1805) = rxt(387)*y(2) + mat(1154) = rxt(315)*y(1) + mat(1817) = -((rxt(369) + rxt(387)) * y(2) + rxt(370)*y(133) + rxt(372)*y(18) & + + rxt(388)*y(1) + rxt(389)*y(57) + rxt(390)*y(7) + rxt(391)*y(3) & + + rxt(392)*y(9) + rxt(393)*y(27) + rxt(394)*y(24) + rxt(395) & + *y(85) + rxt(473)*y(96) + rxt(489)*y(97) + rxt(505)*y(95) & + + rxt(521)*y(101) + rxt(537)*y(102) + rxt(553)*y(129) + rxt(569) & + *y(90)) + mat(1126) = -(rxt(369) + rxt(387)) * y(107) + mat(280) = -rxt(370)*y(107) + mat(951) = -rxt(372)*y(107) + mat(1068) = -rxt(388)*y(107) + mat(1433) = -rxt(389)*y(107) + mat(1565) = -rxt(390)*y(107) + mat(1212) = -rxt(391)*y(107) + mat(1735) = -rxt(392)*y(107) + mat(1028) = -rxt(393)*y(107) + mat(1611) = -rxt(394)*y(107) + mat(1859) = -rxt(395)*y(107) + mat(1695) = -rxt(473)*y(107) + mat(1476) = -rxt(489)*y(107) + mat(1392) = -rxt(505)*y(107) + mat(1254) = -rxt(521)*y(107) + mat(914) = -rxt(537)*y(107) + mat(1905) = -rxt(553)*y(107) + mat(1781) = -rxt(569)*y(107) + mat(1126) = mat(1126) + rxt(396)*y(108) + rxt(411)*y(111) + mat(1212) = mat(1212) + (rxt(314)+rxt(316))*y(130) + mat(473) = rxt(396)*y(2) + mat(871) = rxt(411)*y(2) + mat(1166) = (rxt(314)+rxt(316))*y(3) + mat(459) = -((rxt(373) + rxt(396)) * y(2) + rxt(374)*y(1) + rxt(397)*y(18) & + + rxt(398)*y(57) + (rxt(399) + rxt(402)) * y(6) + (rxt(400) & + + rxt(401)) * y(7)) + mat(1093) = -(rxt(373) + rxt(396)) * y(108) + mat(1037) = -rxt(374)*y(108) + mat(919) = -rxt(397)*y(108) + mat(1405) = -rxt(398)*y(108) + mat(1485) = -(rxt(399) + rxt(402)) * y(108) + mat(1530) = -(rxt(400) + rxt(401)) * y(108) + mat(1037) = mat(1037) + rxt(377)*y(106) + rxt(388)*y(107) + rxt(420)*y(112) & + + rxt(405)*y(110) + mat(1093) = mat(1093) + rxt(403)*y(109) + mat(1181) = rxt(378)*y(106) + rxt(412)*y(111) + mat(1259) = rxt(377)*y(1) + rxt(378)*y(3) + mat(1788) = rxt(388)*y(1) + mat(123) = rxt(403)*y(2) + mat(842) = rxt(412)*y(3) + mat(675) = rxt(420)*y(1) + mat(956) = rxt(405)*y(1) + mat(122) = -(rxt(403)*y(2) + rxt(404)*y(57)) + mat(1076) = -rxt(403)*y(109) + mat(1396) = -rxt(404)*y(109) + mat(1172) = rxt(391)*y(107) + mat(1784) = rxt(391)*y(3) + mat(849) = -(rxt(411)*y(2) + rxt(412)*y(3) + rxt(413)*y(18) + rxt(414)*y(6) & + + rxt(415)*y(7) + rxt(416)*y(9) + (rxt(417) + rxt(418)) * y(85) & + + rxt(419)*y(24) + rxt(447)*y(135) + (rxt(469) + rxt(580) & + ) * y(96) + (rxt(485) + rxt(582)) * y(97) + rxt(501)*y(95) & + + rxt(517)*y(101) + rxt(533)*y(102) + rxt(549)*y(129) + rxt(565) & + *y(90)) + mat(1104) = -rxt(411)*y(111) + mat(1190) = -rxt(412)*y(111) + mat(929) = -rxt(413)*y(111) + mat(1497) = -rxt(414)*y(111) + mat(1543) = -rxt(415)*y(111) + mat(1713) = -rxt(416)*y(111) + mat(1837) = -(rxt(417) + rxt(418)) * y(111) + mat(1589) = -rxt(419)*y(111) + mat(1327) = -rxt(447)*y(111) + mat(1673) = -(rxt(469) + rxt(580)) * y(111) + mat(1454) = -(rxt(485) + rxt(582)) * y(111) + mat(1370) = -rxt(501)*y(111) + mat(1232) = -rxt(517)*y(111) + mat(892) = -rxt(533)*y(111) + mat(1883) = -rxt(549)*y(111) + mat(1759) = -rxt(565)*y(111) + mat(1104) = mat(1104) + rxt(422)*y(112) + mat(1411) = rxt(381)*y(106) + rxt(398)*y(108) + mat(929) = mat(929) + rxt(421)*y(112) + mat(1268) = rxt(381)*y(57) + mat(462) = rxt(398)*y(57) + mat(682) = rxt(422)*y(2) + rxt(421)*y(18) + mat(677) = -(rxt(420)*y(1) + rxt(421)*y(18) + rxt(422)*y(2) + rxt(423)*y(27) & + + rxt(424)*y(85) + rxt(425)*y(24) + rxt(474)*y(96) + rxt(490) & + *y(97) + rxt(506)*y(95) + rxt(522)*y(101) + rxt(538)*y(102) & + + rxt(554)*y(129) + rxt(570)*y(90)) + mat(1041) = -rxt(420)*y(112) + mat(924) = -rxt(421)*y(112) + mat(1099) = -rxt(422)*y(112) + mat(1001) = -rxt(423)*y(112) + mat(1832) = -rxt(424)*y(112) + mat(1584) = -rxt(425)*y(112) + mat(1668) = -rxt(474)*y(112) + mat(1449) = -rxt(490)*y(112) + mat(1365) = -rxt(506)*y(112) + mat(1227) = -rxt(522)*y(112) + mat(887) = -rxt(538)*y(112) + mat(1878) = -rxt(554)*y(112) + mat(1754) = -rxt(570)*y(112) + mat(1406) = rxt(389)*y(107) + rxt(404)*y(109) + mat(1790) = rxt(389)*y(57) + mat(124) = rxt(404)*y(57) + mat(770) = -(rxt(426)*y(18) + rxt(427)*y(7) + rxt(428)*y(1) + rxt(429)*y(9) & + + rxt(430)*y(27) + rxt(431)*y(85) + rxt(432)*y(24) + rxt(458) & + *y(135) + rxt(483)*y(96) + rxt(499)*y(97) + rxt(515)*y(95) & + + rxt(531)*y(101) + rxt(547)*y(102) + rxt(563)*y(129) + rxt(579) & + *y(90)) + mat(927) = -rxt(426)*y(113) + mat(1541) = -rxt(427)*y(113) + mat(1044) = -rxt(428)*y(113) + mat(1711) = -rxt(429)*y(113) + mat(1004) = -rxt(430)*y(113) + mat(1835) = -rxt(431)*y(113) + mat(1587) = -rxt(432)*y(113) + mat(1325) = -rxt(458)*y(113) + mat(1671) = -rxt(483)*y(113) + mat(1452) = -rxt(499)*y(113) + mat(1368) = -rxt(515)*y(113) + mat(1230) = -rxt(531)*y(113) + mat(890) = -rxt(547)*y(113) + mat(1881) = -rxt(563)*y(113) + mat(1757) = -rxt(579)*y(113) + mat(1044) = mat(1044) + rxt(434)*y(114) + mat(1102) = rxt(433)*y(114) + mat(1495) = rxt(402)*y(108) + rxt(414)*y(111) + rxt(450)*y(115) + rxt(441) & + *y(124) + mat(1541) = mat(1541) + rxt(380)*y(106) + rxt(390)*y(107) + rxt(401)*y(108) & + + rxt(406)*y(110) + rxt(437)*y(123) + mat(1266) = rxt(380)*y(7) + mat(1793) = rxt(390)*y(7) + mat(461) = rxt(402)*y(6) + rxt(401)*y(7) + mat(847) = rxt(414)*y(6) + mat(711) = rxt(434)*y(1) + rxt(433)*y(2) + mat(960) = rxt(406)*y(7) + mat(535) = rxt(450)*y(6) + mat(657) = rxt(437)*y(7) + mat(267) = rxt(441)*y(6) + mat(710) = -(rxt(433)*y(2) + rxt(434)*y(1) + (rxt(435) + rxt(465)) * y(27) & + + rxt(448)*y(135) + rxt(463)*y(9) + (rxt(471) + rxt(581) & + ) * y(96) + (rxt(487) + rxt(583)) * y(97) + rxt(503)*y(95) & + + rxt(519)*y(101) + rxt(535)*y(102) + rxt(551)*y(129) + rxt(567) & + *y(90)) + mat(1100) = -rxt(433)*y(114) + mat(1042) = -rxt(434)*y(114) + mat(1002) = -(rxt(435) + rxt(465)) * y(114) + mat(1323) = -rxt(448)*y(114) + mat(1709) = -rxt(463)*y(114) + mat(1669) = -(rxt(471) + rxt(581)) * y(114) + mat(1450) = -(rxt(487) + rxt(583)) * y(114) + mat(1366) = -rxt(503)*y(114) + mat(1228) = -rxt(519)*y(114) + mat(888) = -rxt(535)*y(114) + mat(1879) = -rxt(551)*y(114) + mat(1755) = -rxt(567)*y(114) + mat(1042) = mat(1042) + rxt(428)*y(113) + mat(1493) = rxt(399)*y(108) + mat(1539) = rxt(400)*y(108) + rxt(415)*y(111) + rxt(427)*y(113) + rxt(451) & + *y(115) + mat(1709) = mat(1709) + rxt(383)*y(106) + rxt(392)*y(107) + rxt(416)*y(111) & + + rxt(429)*y(113) + rxt(438)*y(123) + mat(1264) = rxt(383)*y(9) + mat(1791) = rxt(392)*y(9) + mat(460) = rxt(399)*y(6) + rxt(400)*y(7) + mat(846) = rxt(415)*y(7) + rxt(416)*y(9) + mat(769) = rxt(428)*y(1) + rxt(427)*y(7) + rxt(429)*y(9) + mat(534) = rxt(451)*y(7) + mat(656) = rxt(438)*y(9) + end subroutine nlnmat07 + subroutine nlnmat08( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(965) = -(rxt(375)*y(2) + rxt(376)*y(18) + rxt(405)*y(1) + rxt(406)*y(7) & + + rxt(407)*y(57) + rxt(408)*y(27) + rxt(409)*y(85) + rxt(410) & + *y(24)) + mat(1107) = -rxt(375)*y(110) + mat(932) = -rxt(376)*y(110) + mat(1049) = -rxt(405)*y(110) + mat(1546) = -rxt(406)*y(110) + mat(1414) = -rxt(407)*y(110) + mat(1009) = -rxt(408)*y(110) + mat(1840) = -rxt(409)*y(110) + mat(1592) = -rxt(410)*y(110) + mat(581) = rxt(382)*y(106) + mat(932) = mat(932) + rxt(397)*y(108) + rxt(413)*y(111) + rxt(426)*y(113) + mat(1330) = rxt(379)*y(106) + mat(1271) = rxt(382)*y(17) + rxt(379)*y(135) + mat(464) = rxt(397)*y(18) + mat(852) = rxt(413)*y(18) + mat(774) = rxt(426)*y(18) + mat(336) = -(rxt(472)*y(96) + rxt(488)*y(97) + rxt(504)*y(95) + rxt(520) & + *y(101) + rxt(536)*y(102) + rxt(552)*y(129) + rxt(568)*y(90)) + mat(1657) = -rxt(472)*y(122) + mat(1438) = -rxt(488)*y(122) + mat(1354) = -rxt(504)*y(122) + mat(1216) = -rxt(520)*y(122) + mat(876) = -rxt(536)*y(122) + mat(1866) = -rxt(552)*y(122) + mat(1742) = -rxt(568)*y(122) + mat(1404) = rxt(407)*y(110) + mat(955) = rxt(407)*y(57) + mat(532) = -((rxt(450) + rxt(456)) * y(6) + (rxt(451) + rxt(453)) * y(7) & + + rxt(454)*y(135) + (rxt(478) + rxt(590)) * y(96) + (rxt(494) & + + rxt(591)) * y(97) + rxt(510)*y(95) + rxt(526)*y(101) + rxt(542) & + *y(102) + rxt(558)*y(129) + rxt(574)*y(90)) + mat(1487) = -(rxt(450) + rxt(456)) * y(115) + mat(1534) = -(rxt(451) + rxt(453)) * y(115) + mat(1317) = -rxt(454)*y(115) + mat(1665) = -(rxt(478) + rxt(590)) * y(115) + mat(1446) = -(rxt(494) + rxt(591)) * y(115) + mat(1362) = -rxt(510)*y(115) + mat(1224) = -rxt(526)*y(115) + mat(884) = -rxt(542)*y(115) + mat(1874) = -rxt(558)*y(115) + mat(1750) = -rxt(574)*y(115) + mat(1317) = mat(1317) + rxt(447)*y(111) + mat(843) = rxt(447)*y(135) + mat(367) = -((rxt(476) + rxt(588)) * y(96) + (rxt(492) + rxt(589)) * y(97) & + + rxt(508)*y(95) + rxt(524)*y(101) + rxt(540)*y(102) + rxt(556) & + *y(129) + rxt(572)*y(90)) + mat(1658) = -(rxt(476) + rxt(588)) * y(116) + mat(1439) = -(rxt(492) + rxt(589)) * y(116) + mat(1355) = -rxt(508)*y(116) + mat(1217) = -rxt(524)*y(116) + mat(877) = -rxt(540)*y(116) + mat(1867) = -rxt(556)*y(116) + mat(1743) = -rxt(572)*y(116) + mat(1311) = rxt(454)*y(115) + mat(530) = rxt(454)*y(135) + mat(413) = -(rxt(479)*y(96) + rxt(495)*y(97) + rxt(511)*y(95) + rxt(527) & + *y(101) + rxt(543)*y(102) + rxt(559)*y(129) + rxt(575)*y(90)) + mat(1661) = -rxt(479)*y(117) + mat(1442) = -rxt(495)*y(117) + mat(1358) = -rxt(511)*y(117) + mat(1220) = -rxt(527)*y(117) + mat(880) = -rxt(543)*y(117) + mat(1870) = -rxt(559)*y(117) + mat(1746) = -rxt(575)*y(117) + mat(1483) = rxt(456)*y(115) + mat(1313) = rxt(458)*y(113) + mat(767) = rxt(458)*y(135) + mat(531) = rxt(456)*y(6) + mat(554) = -(rxt(459)*y(135) + rxt(466)*y(11) + rxt(467)*y(9) + (rxt(475) & + + rxt(592)) * y(96) + (rxt(491) + rxt(593)) * y(97) + rxt(507) & + *y(95) + rxt(523)*y(101) + rxt(539)*y(102) + rxt(555)*y(129) & + + rxt(571)*y(90)) + mat(1318) = -rxt(459)*y(118) + mat(286) = -rxt(466)*y(118) + mat(1704) = -rxt(467)*y(118) + mat(1666) = -(rxt(475) + rxt(592)) * y(118) + mat(1447) = -(rxt(491) + rxt(593)) * y(118) + mat(1363) = -rxt(507)*y(118) + mat(1225) = -rxt(523)*y(118) + mat(885) = -rxt(539)*y(118) + mat(1875) = -rxt(555)*y(118) + mat(1751) = -rxt(571)*y(118) + mat(1535) = rxt(453)*y(115) + mat(1318) = mat(1318) + rxt(448)*y(114) + mat(708) = rxt(448)*y(135) + mat(533) = rxt(453)*y(7) + mat(512) = -(rxt(461)*y(11) + rxt(482)*y(96) + rxt(498)*y(97) + rxt(514) & + *y(95) + rxt(530)*y(101) + rxt(546)*y(102) + rxt(562)*y(129) & + + rxt(578)*y(90)) + mat(285) = -rxt(461)*y(119) + mat(1664) = -rxt(482)*y(119) + mat(1445) = -rxt(498)*y(119) + mat(1361) = -rxt(514)*y(119) + mat(1223) = -rxt(530)*y(119) + mat(883) = -rxt(546)*y(119) + mat(1873) = -rxt(562)*y(119) + mat(1749) = -rxt(578)*y(119) + mat(1316) = rxt(459)*y(118) + mat(553) = rxt(459)*y(135) + mat(496) = -((rxt(468) + rxt(586)) * y(96) + (rxt(484) + rxt(587)) * y(97) & + + rxt(500)*y(95) + rxt(516)*y(101) + rxt(532)*y(102) + rxt(548) & + *y(129) + rxt(564)*y(90)) + mat(1663) = -(rxt(468) + rxt(586)) * y(120) + mat(1444) = -(rxt(484) + rxt(587)) * y(120) + mat(1360) = -rxt(500)*y(120) + mat(1222) = -rxt(516)*y(120) + mat(882) = -rxt(532)*y(120) + mat(1872) = -rxt(548)*y(120) + mat(1748) = -rxt(564)*y(120) + mat(1703) = rxt(463)*y(114) + rxt(467)*y(118) + rxt(464)*y(121) + mat(284) = rxt(466)*y(118) + rxt(461)*y(119) + mat(707) = rxt(463)*y(9) + mat(552) = rxt(467)*y(9) + rxt(466)*y(11) + mat(511) = rxt(461)*y(11) + mat(428) = rxt(464)*y(9) + mat(427) = -(rxt(464)*y(9) + rxt(480)*y(96) + rxt(496)*y(97) + rxt(512)*y(95) & + + rxt(528)*y(101) + rxt(544)*y(102) + rxt(560)*y(129) + rxt(576) & + *y(90)) + mat(1701) = -rxt(464)*y(121) + mat(1662) = -rxt(480)*y(121) + mat(1443) = -rxt(496)*y(121) + mat(1359) = -rxt(512)*y(121) + mat(1221) = -rxt(528)*y(121) + mat(881) = -rxt(544)*y(121) + mat(1871) = -rxt(560)*y(121) + mat(1747) = -rxt(576)*y(121) + mat(995) = rxt(465)*y(114) + mat(706) = rxt(465)*y(27) + mat(655) = -(rxt(436)*y(18) + rxt(437)*y(7) + rxt(438)*y(9) + rxt(439)*y(135) & + + rxt(440)*y(27) + rxt(477)*y(96) + rxt(493)*y(97) + rxt(509) & + *y(95) + rxt(525)*y(101) + rxt(541)*y(102) + rxt(557)*y(129) & + + rxt(573)*y(90)) + mat(923) = -rxt(436)*y(123) + mat(1538) = -rxt(437)*y(123) + mat(1708) = -rxt(438)*y(123) + mat(1322) = -rxt(439)*y(123) + mat(1000) = -rxt(440)*y(123) + mat(1667) = -rxt(477)*y(123) + mat(1448) = -rxt(493)*y(123) + mat(1364) = -rxt(509)*y(123) + mat(1226) = -rxt(525)*y(123) + mat(886) = -rxt(541)*y(123) + mat(1877) = -rxt(557)*y(123) + mat(1753) = -rxt(573)*y(123) + mat(1098) = rxt(443)*y(124) + mat(1492) = rxt(442)*y(124) + mat(1831) = rxt(385)*y(106) + rxt(395)*y(107) + rxt(417)*y(111) + rxt(424) & + *y(112) + rxt(431)*y(113) + rxt(409)*y(110) + mat(1583) = rxt(386)*y(106) + rxt(419)*y(111) + rxt(432)*y(113) + mat(1000) = mat(1000) + rxt(384)*y(106) + rxt(393)*y(107) + rxt(423)*y(112) & + + rxt(430)*y(113) + rxt(435)*y(114) + rxt(408)*y(110) + mat(1263) = rxt(385)*y(85) + rxt(386)*y(24) + rxt(384)*y(27) + mat(1789) = rxt(395)*y(85) + rxt(393)*y(27) + mat(845) = rxt(417)*y(85) + rxt(419)*y(24) + mat(676) = rxt(424)*y(85) + rxt(423)*y(27) + mat(768) = rxt(431)*y(85) + rxt(432)*y(24) + rxt(430)*y(27) + mat(709) = rxt(435)*y(27) + mat(957) = rxt(409)*y(85) + rxt(408)*y(27) + mat(266) = rxt(443)*y(2) + rxt(442)*y(6) + mat(265) = -((rxt(441) + rxt(442)) * y(6) + rxt(443)*y(2)) + mat(1480) = -(rxt(441) + rxt(442)) * y(124) + mat(1087) = -rxt(443)*y(124) + mat(1825) = rxt(418)*y(111) + mat(1575) = rxt(394)*y(107) + rxt(425)*y(112) + rxt(410)*y(110) + mat(1785) = rxt(394)*y(24) + mat(841) = rxt(418)*y(85) + mat(674) = rxt(425)*y(24) + mat(954) = rxt(410)*y(24) + mat(398) = -(rxt(444)*y(27) + rxt(481)*y(96) + rxt(497)*y(97) + rxt(513) & + *y(95) + rxt(529)*y(101) + rxt(545)*y(102) + rxt(561)*y(129) & + + rxt(577)*y(90)) + mat(994) = -rxt(444)*y(125) + mat(1660) = -rxt(481)*y(125) + mat(1441) = -rxt(497)*y(125) + mat(1357) = -rxt(513)*y(125) + mat(1219) = -rxt(529)*y(125) + mat(879) = -rxt(545)*y(125) + mat(1869) = -rxt(561)*y(125) + mat(1745) = -rxt(577)*y(125) + mat(1312) = rxt(439)*y(123) + mat(654) = rxt(439)*y(135) + mat(382) = -((rxt(470) + rxt(584)) * y(96) + (rxt(486) + rxt(585)) * y(97) & + + rxt(502)*y(95) + rxt(518)*y(101) + rxt(534)*y(102) + rxt(550) & + *y(129) + rxt(566)*y(90)) + mat(1659) = -(rxt(470) + rxt(584)) * y(126) + mat(1440) = -(rxt(486) + rxt(585)) * y(126) + mat(1356) = -rxt(502)*y(126) + mat(1218) = -rxt(518)*y(126) + mat(878) = -rxt(534)*y(126) + mat(1868) = -rxt(550)*y(126) + mat(1744) = -rxt(566)*y(126) + mat(993) = rxt(440)*y(123) + rxt(444)*y(125) + mat(653) = rxt(440)*y(27) + mat(397) = rxt(444)*y(27) + mat(1151) = -(rxt(311)*y(129) + rxt(312)*y(90) + rxt(313)*y(89) + (rxt(314) & + + rxt(316)) * y(3) + rxt(315)*y(1) + rxt(317)*y(91) + rxt(318) & + *y(104) + rxt(319)*y(101) + rxt(320)*y(102) + rxt(321)*y(103) & + + rxt(322)*y(92) + rxt(323)*y(98) + rxt(324)*y(93) + rxt(325) & + *y(94) + rxt(326)*y(95) + rxt(327)*y(96) + rxt(328)*y(97) & + + rxt(329)*y(105)) + mat(1890) = -rxt(311)*y(130) + mat(1766) = -rxt(312)*y(130) + mat(148) = -rxt(313)*y(130) + mat(1197) = -(rxt(314) + rxt(316)) * y(130) + mat(1053) = -rxt(315)*y(130) + mat(329) = -rxt(317)*y(130) + mat(162) = -rxt(318)*y(130) + mat(1239) = -rxt(319)*y(130) + mat(899) = -rxt(320)*y(130) + mat(85) = -rxt(321)*y(130) + mat(181) = -rxt(322)*y(130) + mat(81) = -rxt(323)*y(130) + mat(217) = -rxt(324)*y(130) + mat(139) = -rxt(325)*y(130) + mat(1377) = -rxt(326)*y(130) + mat(1680) = -rxt(327)*y(130) + mat(1461) = -rxt(328)*y(130) + mat(155) = -rxt(329)*y(130) + mat(1053) = mat(1053) + rxt(374)*y(108) + mat(1111) = rxt(364)*y(106) + rxt(369)*y(107) + rxt(373)*y(108) + rxt(375) & + *y(110) + mat(276) = rxt(366)*y(106) + rxt(370)*y(107) + mat(584) = rxt(368)*y(106) + mat(1504) = rxt(365)*y(106) + mat(936) = rxt(372)*y(107) + rxt(376)*y(110) + rxt(436)*y(123) + mat(1275) = rxt(364)*y(2) + rxt(366)*y(133) + rxt(368)*y(17) + rxt(365)*y(6) + mat(1802) = rxt(369)*y(2) + rxt(370)*y(133) + rxt(372)*y(18) + mat(467) = rxt(374)*y(1) + rxt(373)*y(2) + mat(969) = rxt(375)*y(2) + rxt(376)*y(18) + mat(661) = rxt(436)*y(18) + end subroutine nlnmat08 + subroutine nlnmat09( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(24) = -(rxt(141)*y(134)) + mat(620) = -rxt(141)*y(53) + mat(32) = -(rxt(142)*y(134)) + mat(621) = -rxt(142)*y(54) + mat(571) = rxt(237)*y(56) + mat(1698) = rxt(239)*y(56) + mat(1294) = rxt(236)*y(56) + mat(205) = rxt(237)*y(17) + rxt(239)*y(9) + rxt(236)*y(135) + mat(206) = -(rxt(236)*y(135) + rxt(237)*y(17) + rxt(239)*y(9)) + mat(1305) = -rxt(236)*y(56) + mat(572) = -rxt(237)*y(56) + mat(1699) = -rxt(239)*y(56) + mat(623) = 2.000_r8*rxt(141)*y(53) + rxt(142)*y(54) + mat(25) = 2.000_r8*rxt(141)*y(134) + mat(33) = rxt(142)*y(134) + mat(69) = -(rxt(265)*y(2) + rxt(266)*y(87)) + mat(1072) = -rxt(265)*y(58) + mat(797) = -rxt(266)*y(58) + mat(168) = -(rxt(267)*y(87) + rxt(268)*y(3) + rxt(269)*y(1)) + mat(801) = -rxt(267)*y(59) + mat(1174) = -rxt(268)*y(59) + mat(1032) = -rxt(269)*y(59) + mat(353) = -(rxt(270)*y(87) + rxt(271)*y(3) + rxt(272)*y(1) + rxt(273)*y(7) & + + rxt(274)*y(24) + rxt(275)*y(31) + rxt(276)*y(25)) + mat(812) = -rxt(270)*y(60) + mat(1180) = -rxt(271)*y(60) + mat(1036) = -rxt(272)*y(60) + mat(1529) = -rxt(273)*y(60) + mat(1577) = -rxt(274)*y(60) + mat(479) = -rxt(275)*y(60) + mat(66) = -rxt(276)*y(60) + mat(1036) = mat(1036) + rxt(269)*y(59) + mat(1091) = rxt(265)*y(58) + mat(1180) = mat(1180) + rxt(268)*y(59) + mat(812) = mat(812) + rxt(267)*y(59) + mat(73) = rxt(265)*y(2) + mat(169) = rxt(269)*y(1) + rxt(268)*y(3) + rxt(267)*y(87) + mat(247) = -(rxt(277)*y(87)) + mat(808) = -rxt(277)*y(61) + mat(1033) = rxt(272)*y(60) + mat(1176) = rxt(271)*y(60) + mat(1525) = rxt(273)*y(60) + mat(808) = mat(808) + rxt(266)*y(58) + rxt(270)*y(60) + (.500_r8*rxt(279) & + +rxt(280))*y(64) + mat(1616) = rxt(281)*y(64) + mat(1573) = rxt(274)*y(60) + mat(65) = rxt(276)*y(60) + mat(478) = rxt(275)*y(60) + mat(72) = rxt(266)*y(87) + mat(352) = rxt(272)*y(1) + rxt(271)*y(3) + rxt(273)*y(7) + rxt(270)*y(87) & + + rxt(274)*y(24) + rxt(276)*y(25) + rxt(275)*y(31) + mat(56) = (.500_r8*rxt(279)+rxt(280))*y(87) + rxt(281)*y(8) + mat(51) = -(rxt(278)*y(135)) + mat(1297) = -rxt(278)*y(62) + mat(795) = rxt(277)*y(61) + mat(246) = rxt(277)*y(87) + mat(1293) = rxt(278)*y(62) + mat(50) = rxt(278)*y(135) + mat(55) = -((rxt(279) + rxt(280)) * y(87) + rxt(281)*y(8)) + mat(796) = -(rxt(279) + rxt(280)) * y(64) + mat(1614) = -rxt(281)*y(64) + end subroutine nlnmat09 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = mat( 24) + lmat( 24) + mat( 25) = mat( 25) + lmat( 25) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = mat( 32) + lmat( 32) + mat( 33) = mat( 33) + lmat( 33) + mat( 35) = mat( 35) + lmat( 35) + mat( 36) = lmat( 36) + mat( 37) = lmat( 37) + mat( 38) = lmat( 38) + mat( 39) = lmat( 39) + mat( 40) = lmat( 40) + mat( 41) = lmat( 41) + mat( 42) = mat( 42) + lmat( 42) + mat( 46) = mat( 46) + lmat( 46) + mat( 51) = mat( 51) + lmat( 51) + mat( 52) = lmat( 52) + mat( 53) = lmat( 53) + mat( 55) = mat( 55) + lmat( 55) + mat( 61) = mat( 61) + lmat( 61) + mat( 62) = mat( 62) + lmat( 62) + mat( 63) = lmat( 63) + mat( 64) = mat( 64) + lmat( 64) + mat( 67) = lmat( 67) + mat( 68) = mat( 68) + lmat( 68) + mat( 69) = mat( 69) + lmat( 69) + mat( 70) = lmat( 70) + mat( 71) = mat( 71) + lmat( 71) + mat( 77) = mat( 77) + lmat( 77) + mat( 83) = mat( 83) + lmat( 83) + mat( 89) = mat( 89) + lmat( 89) + mat( 91) = lmat( 91) + mat( 92) = mat( 92) + lmat( 92) + mat( 93) = lmat( 93) + mat( 95) = mat( 95) + lmat( 95) + mat( 102) = mat( 102) + lmat( 102) + mat( 103) = lmat( 103) + mat( 104) = mat( 104) + lmat( 104) + mat( 107) = mat( 107) + lmat( 107) + mat( 108) = lmat( 108) + mat( 109) = mat( 109) + lmat( 109) + mat( 114) = mat( 114) + lmat( 114) + mat( 115) = lmat( 115) + mat( 116) = mat( 116) + lmat( 116) + mat( 117) = lmat( 117) + mat( 119) = lmat( 119) + mat( 120) = mat( 120) + lmat( 120) + mat( 121) = lmat( 121) + mat( 122) = mat( 122) + lmat( 122) + mat( 126) = mat( 126) + lmat( 126) + mat( 128) = lmat( 128) + mat( 129) = mat( 129) + lmat( 129) + mat( 131) = mat( 131) + lmat( 131) + mat( 136) = mat( 136) + lmat( 136) + mat( 137) = lmat( 137) + mat( 140) = mat( 140) + lmat( 140) + mat( 143) = mat( 143) + lmat( 143) + mat( 153) = mat( 153) + lmat( 153) + mat( 160) = lmat( 160) + mat( 161) = mat( 161) + lmat( 161) + mat( 165) = mat( 165) + lmat( 165) + mat( 167) = lmat( 167) + mat( 168) = mat( 168) + lmat( 168) + mat( 177) = mat( 177) + lmat( 177) + mat( 183) = mat( 183) + lmat( 183) + mat( 185) = lmat( 185) + mat( 186) = mat( 186) + lmat( 186) + mat( 191) = mat( 191) + lmat( 191) + mat( 192) = mat( 192) + lmat( 192) + mat( 194) = lmat( 194) + mat( 197) = mat( 197) + lmat( 197) + mat( 199) = lmat( 199) + mat( 200) = mat( 200) + lmat( 200) + mat( 205) = mat( 205) + lmat( 205) + mat( 206) = mat( 206) + lmat( 206) + mat( 207) = lmat( 207) + mat( 215) = mat( 215) + lmat( 215) + mat( 220) = mat( 220) + lmat( 220) + mat( 221) = mat( 221) + lmat( 221) + mat( 224) = lmat( 224) + mat( 228) = mat( 228) + lmat( 228) + mat( 229) = mat( 229) + lmat( 229) + mat( 234) = mat( 234) + lmat( 234) + mat( 236) = mat( 236) + lmat( 236) + mat( 237) = lmat( 237) + mat( 245) = lmat( 245) + mat( 247) = mat( 247) + lmat( 247) + mat( 248) = lmat( 248) + mat( 251) = lmat( 251) + mat( 254) = mat( 254) + lmat( 254) + mat( 255) = mat( 255) + lmat( 255) + mat( 260) = lmat( 260) + mat( 261) = mat( 261) + lmat( 261) + mat( 262) = mat( 262) + lmat( 262) + mat( 263) = mat( 263) + lmat( 263) + mat( 264) = mat( 264) + lmat( 264) + mat( 265) = mat( 265) + lmat( 265) + mat( 273) = mat( 273) + lmat( 273) + mat( 277) = mat( 277) + lmat( 277) + mat( 283) = mat( 283) + lmat( 283) + mat( 287) = lmat( 287) + mat( 290) = lmat( 290) + mat( 291) = lmat( 291) + mat( 292) = lmat( 292) + mat( 294) = mat( 294) + lmat( 294) + mat( 296) = mat( 296) + lmat( 296) + mat( 307) = lmat( 307) + mat( 309) = mat( 309) + lmat( 309) + mat( 314) = lmat( 314) + mat( 324) = mat( 324) + lmat( 324) + mat( 336) = mat( 336) + lmat( 336) + mat( 351) = lmat( 351) + mat( 353) = mat( 353) + lmat( 353) + mat( 360) = mat( 360) + lmat( 360) + mat( 367) = mat( 367) + lmat( 367) + mat( 368) = lmat( 368) + mat( 374) = mat( 374) + lmat( 374) + mat( 382) = mat( 382) + lmat( 382) + mat( 383) = lmat( 383) + mat( 386) = mat( 386) + lmat( 386) + mat( 398) = mat( 398) + lmat( 398) + mat( 399) = lmat( 399) + mat( 405) = mat( 405) + lmat( 405) + mat( 413) = mat( 413) + lmat( 413) + mat( 414) = lmat( 414) + mat( 419) = mat( 419) + lmat( 419) + mat( 427) = mat( 427) + lmat( 427) + mat( 443) = mat( 443) + lmat( 443) + mat( 445) = mat( 445) + lmat( 445) + mat( 446) = lmat( 446) + mat( 451) = mat( 451) + lmat( 451) + mat( 459) = mat( 459) + lmat( 459) + mat( 465) = mat( 465) + lmat( 465) + mat( 467) = mat( 467) + lmat( 467) + mat( 468) = mat( 468) + lmat( 468) + mat( 469) = lmat( 469) + mat( 480) = mat( 480) + lmat( 480) + mat( 481) = mat( 481) + lmat( 481) + mat( 487) = mat( 487) + lmat( 487) + mat( 496) = mat( 496) + lmat( 496) + mat( 497) = lmat( 497) + mat( 507) = mat( 507) + lmat( 507) + mat( 512) = mat( 512) + lmat( 512) + mat( 513) = lmat( 513) + mat( 520) = mat( 520) + lmat( 520) + mat( 532) = mat( 532) + lmat( 532) + mat( 536) = lmat( 536) + mat( 542) = mat( 542) + lmat( 542) + mat( 554) = mat( 554) + lmat( 554) + mat( 555) = lmat( 555) + mat( 561) = mat( 561) + lmat( 561) + mat( 575) = mat( 575) + lmat( 575) + mat( 600) = mat( 600) + lmat( 600) + mat( 620) = mat( 620) + lmat( 620) + mat( 621) = mat( 621) + lmat( 621) + mat( 623) = mat( 623) + lmat( 623) + mat( 626) = lmat( 626) + mat( 628) = lmat( 628) + mat( 629) = mat( 629) + lmat( 629) + mat( 630) = mat( 630) + lmat( 630) + mat( 631) = mat( 631) + lmat( 631) + mat( 632) = lmat( 632) + mat( 633) = mat( 633) + lmat( 633) + mat( 634) = mat( 634) + lmat( 634) + mat( 638) = mat( 638) + lmat( 638) + mat( 640) = mat( 640) + lmat( 640) + mat( 645) = lmat( 645) + mat( 652) = mat( 652) + lmat( 652) + mat( 655) = mat( 655) + lmat( 655) + mat( 677) = mat( 677) + lmat( 677) + mat( 695) = mat( 695) + lmat( 695) + mat( 703) = lmat( 703) + mat( 710) = mat( 710) + lmat( 710) + mat( 717) = lmat( 717) + mat( 725) = mat( 725) + lmat( 725) + mat( 733) = mat( 733) + lmat( 733) + mat( 744) = mat( 744) + lmat( 744) + mat( 770) = mat( 770) + lmat( 770) + mat( 778) = lmat( 778) + mat( 785) = mat( 785) + lmat( 785) + mat( 793) = lmat( 793) + mat( 794) = lmat( 794) + mat( 810) = mat( 810) + lmat( 810) + mat( 816) = mat( 816) + lmat( 816) + mat( 818) = mat( 818) + lmat( 818) + mat( 819) = mat( 819) + lmat( 819) + mat( 829) = mat( 829) + lmat( 829) + mat( 839) = mat( 839) + lmat( 839) + mat( 849) = mat( 849) + lmat( 849) + mat( 859) = lmat( 859) + mat( 862) = mat( 862) + lmat( 862) + mat( 893) = mat( 893) + lmat( 893) + mat( 931) = mat( 931) + lmat( 931) + mat( 961) = mat( 961) + lmat( 961) + mat( 965) = mat( 965) + lmat( 965) + mat( 969) = mat( 969) + lmat( 969) + mat(1008) = lmat(1008) + mat(1010) = mat(1010) + lmat(1010) + mat(1029) = mat(1029) + lmat(1029) + mat(1034) = mat(1034) + lmat(1034) + mat(1040) = mat(1040) + lmat(1040) + mat(1051) = mat(1051) + lmat(1051) + mat(1052) = mat(1052) + lmat(1052) + mat(1054) = mat(1054) + lmat(1054) + mat(1084) = mat(1084) + lmat(1084) + mat(1110) = mat(1110) + lmat(1110) + mat(1111) = mat(1111) + lmat(1111) + mat(1151) = mat(1151) + lmat(1151) + mat(1175) = mat(1175) + lmat(1175) + mat(1184) = mat(1184) + lmat(1184) + mat(1196) = mat(1196) + lmat(1196) + mat(1197) = mat(1197) + lmat(1197) + mat(1198) = mat(1198) + lmat(1198) + mat(1211) = mat(1211) + lmat(1211) + mat(1241) = mat(1241) + lmat(1241) + mat(1274) = mat(1274) + lmat(1274) + mat(1275) = mat(1275) + lmat(1275) + mat(1278) = mat(1278) + lmat(1278) + mat(1319) = lmat(1319) + mat(1321) = mat(1321) + lmat(1321) + mat(1326) = mat(1326) + lmat(1326) + mat(1329) = lmat(1329) + mat(1333) = lmat(1333) + mat(1338) = mat(1338) + lmat(1338) + mat(1352) = lmat(1352) + mat(1381) = mat(1381) + lmat(1381) + mat(1382) = mat(1382) + lmat(1382) + mat(1399) = mat(1399) + lmat(1399) + mat(1417) = lmat(1417) + mat(1424) = mat(1424) + lmat(1424) + mat(1465) = mat(1465) + lmat(1465) + mat(1468) = mat(1468) + lmat(1468) + mat(1473) = lmat(1473) + mat(1482) = mat(1482) + lmat(1482) + mat(1503) = mat(1503) + lmat(1503) + mat(1504) = mat(1504) + lmat(1504) + mat(1512) = mat(1512) + lmat(1512) + mat(1521) = mat(1521) + lmat(1521) + mat(1542) = mat(1542) + lmat(1542) + mat(1549) = mat(1549) + lmat(1549) + mat(1558) = mat(1558) + lmat(1558) + mat(1559) = mat(1559) + lmat(1559) + mat(1563) = mat(1563) + lmat(1563) + mat(1595) = mat(1595) + lmat(1595) + mat(1606) = mat(1606) + lmat(1606) + mat(1612) = mat(1612) + lmat(1612) + mat(1636) = mat(1636) + lmat(1636) + mat(1638) = mat(1638) + lmat(1638) + mat(1645) = mat(1645) + lmat(1645) + mat(1646) = mat(1646) + lmat(1646) + mat(1648) = mat(1648) + lmat(1648) + mat(1650) = mat(1650) + lmat(1650) + mat(1684) = mat(1684) + lmat(1684) + mat(1685) = lmat(1685) + mat(1692) = mat(1692) + lmat(1692) + mat(1712) = mat(1712) + lmat(1712) + mat(1729) = lmat(1729) + mat(1733) = mat(1733) + lmat(1733) + mat(1774) = mat(1774) + lmat(1774) + mat(1780) = mat(1780) + lmat(1780) + mat(1783) = mat(1783) + lmat(1783) + mat(1802) = mat(1802) + lmat(1802) + mat(1803) = mat(1803) + lmat(1803) + mat(1817) = mat(1817) + lmat(1817) + mat(1822) = mat(1822) + lmat(1822) + mat(1826) = lmat(1826) + mat(1829) = lmat(1829) + mat(1834) = mat(1834) + lmat(1834) + mat(1841) = mat(1841) + lmat(1841) + mat(1860) = mat(1860) + lmat(1860) + mat(1863) = lmat(1863) + mat(1907) = mat(1907) + lmat(1907) + mat( 146) = 0._r8 + mat( 150) = 0._r8 + mat( 176) = 0._r8 + mat( 180) = 0._r8 + mat( 184) = 0._r8 + mat( 204) = 0._r8 + mat( 219) = 0._r8 + mat( 238) = 0._r8 + mat( 239) = 0._r8 + mat( 240) = 0._r8 + mat( 252) = 0._r8 + mat( 259) = 0._r8 + mat( 299) = 0._r8 + mat( 300) = 0._r8 + mat( 302) = 0._r8 + mat( 308) = 0._r8 + mat( 310) = 0._r8 + mat( 316) = 0._r8 + mat( 322) = 0._r8 + mat( 325) = 0._r8 + mat( 326) = 0._r8 + mat( 331) = 0._r8 + mat( 333) = 0._r8 + mat( 335) = 0._r8 + mat( 356) = 0._r8 + mat( 362) = 0._r8 + mat( 448) = 0._r8 + mat( 455) = 0._r8 + mat( 484) = 0._r8 + mat( 485) = 0._r8 + mat( 486) = 0._r8 + mat( 489) = 0._r8 + mat( 493) = 0._r8 + mat( 494) = 0._r8 + mat( 514) = 0._r8 + mat( 517) = 0._r8 + mat( 524) = 0._r8 + mat( 558) = 0._r8 + mat( 565) = 0._r8 + mat( 573) = 0._r8 + mat( 574) = 0._r8 + mat( 576) = 0._r8 + mat( 578) = 0._r8 + mat( 585) = 0._r8 + mat( 588) = 0._r8 + mat( 589) = 0._r8 + mat( 590) = 0._r8 + mat( 591) = 0._r8 + mat( 592) = 0._r8 + mat( 593) = 0._r8 + mat( 599) = 0._r8 + mat( 601) = 0._r8 + mat( 603) = 0._r8 + mat( 604) = 0._r8 + mat( 605) = 0._r8 + mat( 606) = 0._r8 + mat( 608) = 0._r8 + mat( 609) = 0._r8 + mat( 611) = 0._r8 + mat( 612) = 0._r8 + mat( 613) = 0._r8 + mat( 614) = 0._r8 + mat( 615) = 0._r8 + mat( 616) = 0._r8 + mat( 617) = 0._r8 + mat( 618) = 0._r8 + mat( 619) = 0._r8 + mat( 625) = 0._r8 + mat( 627) = 0._r8 + mat( 635) = 0._r8 + mat( 639) = 0._r8 + mat( 641) = 0._r8 + mat( 643) = 0._r8 + mat( 644) = 0._r8 + mat( 646) = 0._r8 + mat( 647) = 0._r8 + mat( 648) = 0._r8 + mat( 649) = 0._r8 + mat( 650) = 0._r8 + mat( 651) = 0._r8 + mat( 678) = 0._r8 + mat( 680) = 0._r8 + mat( 685) = 0._r8 + mat( 689) = 0._r8 + mat( 692) = 0._r8 + mat( 698) = 0._r8 + mat( 701) = 0._r8 + mat( 713) = 0._r8 + mat( 724) = 0._r8 + mat( 729) = 0._r8 + mat( 739) = 0._r8 + mat( 743) = 0._r8 + mat( 747) = 0._r8 + mat( 751) = 0._r8 + mat( 754) = 0._r8 + mat( 756) = 0._r8 + mat( 757) = 0._r8 + mat( 762) = 0._r8 + mat( 763) = 0._r8 + mat( 764) = 0._r8 + mat( 771) = 0._r8 + mat( 777) = 0._r8 + mat( 804) = 0._r8 + mat( 817) = 0._r8 + mat( 821) = 0._r8 + mat( 825) = 0._r8 + mat( 828) = 0._r8 + mat( 830) = 0._r8 + mat( 837) = 0._r8 + mat( 838) = 0._r8 + mat( 840) = 0._r8 + mat( 844) = 0._r8 + mat( 853) = 0._r8 + mat( 854) = 0._r8 + mat( 856) = 0._r8 + mat( 867) = 0._r8 + mat( 875) = 0._r8 + mat( 889) = 0._r8 + mat( 894) = 0._r8 + mat( 895) = 0._r8 + mat( 897) = 0._r8 + mat( 901) = 0._r8 + mat( 902) = 0._r8 + mat( 904) = 0._r8 + mat( 906) = 0._r8 + mat( 909) = 0._r8 + mat( 911) = 0._r8 + mat( 913) = 0._r8 + mat( 916) = 0._r8 + mat( 921) = 0._r8 + mat( 922) = 0._r8 + mat( 925) = 0._r8 + mat( 930) = 0._r8 + mat( 939) = 0._r8 + mat( 941) = 0._r8 + mat( 943) = 0._r8 + mat( 945) = 0._r8 + mat( 946) = 0._r8 + mat( 947) = 0._r8 + mat( 948) = 0._r8 + mat( 949) = 0._r8 + mat( 950) = 0._r8 + mat( 952) = 0._r8 + mat( 953) = 0._r8 + mat( 958) = 0._r8 + mat( 962) = 0._r8 + mat( 963) = 0._r8 + mat( 970) = 0._r8 + mat( 971) = 0._r8 + mat( 972) = 0._r8 + mat( 974) = 0._r8 + mat( 976) = 0._r8 + mat( 977) = 0._r8 + mat( 980) = 0._r8 + mat( 981) = 0._r8 + mat( 982) = 0._r8 + mat( 983) = 0._r8 + mat( 984) = 0._r8 + mat( 986) = 0._r8 + mat( 996) = 0._r8 + mat( 997) = 0._r8 + mat( 998) = 0._r8 + mat(1006) = 0._r8 + mat(1007) = 0._r8 + mat(1011) = 0._r8 + mat(1013) = 0._r8 + mat(1014) = 0._r8 + mat(1015) = 0._r8 + mat(1018) = 0._r8 + mat(1020) = 0._r8 + mat(1021) = 0._r8 + mat(1022) = 0._r8 + mat(1023) = 0._r8 + mat(1024) = 0._r8 + mat(1025) = 0._r8 + mat(1027) = 0._r8 + mat(1030) = 0._r8 + mat(1035) = 0._r8 + mat(1046) = 0._r8 + mat(1047) = 0._r8 + mat(1050) = 0._r8 + mat(1055) = 0._r8 + mat(1057) = 0._r8 + mat(1058) = 0._r8 + mat(1060) = 0._r8 + mat(1065) = 0._r8 + mat(1066) = 0._r8 + mat(1067) = 0._r8 + mat(1070) = 0._r8 + mat(1079) = 0._r8 + mat(1085) = 0._r8 + mat(1097) = 0._r8 + mat(1105) = 0._r8 + mat(1113) = 0._r8 + mat(1115) = 0._r8 + mat(1116) = 0._r8 + mat(1118) = 0._r8 + mat(1123) = 0._r8 + mat(1124) = 0._r8 + mat(1137) = 0._r8 + mat(1139) = 0._r8 + mat(1143) = 0._r8 + mat(1147) = 0._r8 + mat(1148) = 0._r8 + mat(1160) = 0._r8 + mat(1161) = 0._r8 + mat(1162) = 0._r8 + mat(1164) = 0._r8 + mat(1167) = 0._r8 + mat(1182) = 0._r8 + mat(1183) = 0._r8 + mat(1185) = 0._r8 + mat(1186) = 0._r8 + mat(1188) = 0._r8 + mat(1189) = 0._r8 + mat(1191) = 0._r8 + mat(1193) = 0._r8 + mat(1194) = 0._r8 + mat(1199) = 0._r8 + mat(1201) = 0._r8 + mat(1202) = 0._r8 + mat(1204) = 0._r8 + mat(1206) = 0._r8 + mat(1207) = 0._r8 + mat(1208) = 0._r8 + mat(1209) = 0._r8 + mat(1210) = 0._r8 + mat(1213) = 0._r8 + mat(1235) = 0._r8 + mat(1237) = 0._r8 + mat(1242) = 0._r8 + mat(1244) = 0._r8 + mat(1246) = 0._r8 + mat(1249) = 0._r8 + mat(1251) = 0._r8 + mat(1253) = 0._r8 + mat(1256) = 0._r8 + mat(1258) = 0._r8 + mat(1261) = 0._r8 + mat(1262) = 0._r8 + mat(1265) = 0._r8 + mat(1269) = 0._r8 + mat(1277) = 0._r8 + mat(1280) = 0._r8 + mat(1282) = 0._r8 + mat(1286) = 0._r8 + mat(1287) = 0._r8 + mat(1289) = 0._r8 + mat(1290) = 0._r8 + mat(1292) = 0._r8 + mat(1307) = 0._r8 + mat(1308) = 0._r8 + mat(1310) = 0._r8 + mat(1314) = 0._r8 + mat(1315) = 0._r8 + mat(1320) = 0._r8 + mat(1324) = 0._r8 + mat(1331) = 0._r8 + mat(1332) = 0._r8 + mat(1334) = 0._r8 + mat(1342) = 0._r8 + mat(1343) = 0._r8 + mat(1344) = 0._r8 + mat(1345) = 0._r8 + mat(1349) = 0._r8 + mat(1350) = 0._r8 + mat(1353) = 0._r8 + mat(1367) = 0._r8 + mat(1371) = 0._r8 + mat(1373) = 0._r8 + mat(1375) = 0._r8 + mat(1379) = 0._r8 + mat(1380) = 0._r8 + mat(1384) = 0._r8 + mat(1385) = 0._r8 + mat(1387) = 0._r8 + mat(1391) = 0._r8 + mat(1394) = 0._r8 + mat(1402) = 0._r8 + mat(1403) = 0._r8 + mat(1407) = 0._r8 + mat(1408) = 0._r8 + mat(1409) = 0._r8 + mat(1410) = 0._r8 + mat(1412) = 0._r8 + mat(1413) = 0._r8 + mat(1415) = 0._r8 + mat(1416) = 0._r8 + mat(1418) = 0._r8 + mat(1420) = 0._r8 + mat(1422) = 0._r8 + mat(1423) = 0._r8 + mat(1425) = 0._r8 + mat(1426) = 0._r8 + mat(1427) = 0._r8 + mat(1428) = 0._r8 + mat(1429) = 0._r8 + mat(1430) = 0._r8 + mat(1431) = 0._r8 + mat(1434) = 0._r8 + mat(1451) = 0._r8 + mat(1455) = 0._r8 + mat(1457) = 0._r8 + mat(1459) = 0._r8 + mat(1463) = 0._r8 + mat(1464) = 0._r8 + mat(1466) = 0._r8 + mat(1469) = 0._r8 + mat(1471) = 0._r8 + mat(1475) = 0._r8 + mat(1478) = 0._r8 + mat(1488) = 0._r8 + mat(1489) = 0._r8 + mat(1491) = 0._r8 + mat(1498) = 0._r8 + mat(1500) = 0._r8 + mat(1501) = 0._r8 + mat(1506) = 0._r8 + mat(1509) = 0._r8 + mat(1511) = 0._r8 + mat(1516) = 0._r8 + mat(1517) = 0._r8 + mat(1519) = 0._r8 + mat(1524) = 0._r8 + mat(1532) = 0._r8 + mat(1533) = 0._r8 + mat(1536) = 0._r8 + mat(1537) = 0._r8 + mat(1544) = 0._r8 + mat(1545) = 0._r8 + mat(1547) = 0._r8 + mat(1550) = 0._r8 + mat(1552) = 0._r8 + mat(1555) = 0._r8 + mat(1557) = 0._r8 + mat(1562) = 0._r8 + mat(1564) = 0._r8 + mat(1567) = 0._r8 + mat(1580) = 0._r8 + mat(1582) = 0._r8 + mat(1585) = 0._r8 + mat(1590) = 0._r8 + mat(1591) = 0._r8 + mat(1594) = 0._r8 + mat(1596) = 0._r8 + mat(1598) = 0._r8 + mat(1600) = 0._r8 + mat(1601) = 0._r8 + mat(1603) = 0._r8 + mat(1608) = 0._r8 + mat(1609) = 0._r8 + mat(1610) = 0._r8 + mat(1613) = 0._r8 + mat(1618) = 0._r8 + mat(1620) = 0._r8 + mat(1621) = 0._r8 + mat(1622) = 0._r8 + mat(1623) = 0._r8 + mat(1624) = 0._r8 + mat(1625) = 0._r8 + mat(1626) = 0._r8 + mat(1627) = 0._r8 + mat(1629) = 0._r8 + mat(1631) = 0._r8 + mat(1632) = 0._r8 + mat(1633) = 0._r8 + mat(1634) = 0._r8 + mat(1635) = 0._r8 + mat(1637) = 0._r8 + mat(1639) = 0._r8 + mat(1640) = 0._r8 + mat(1641) = 0._r8 + mat(1642) = 0._r8 + mat(1643) = 0._r8 + mat(1644) = 0._r8 + mat(1647) = 0._r8 + mat(1649) = 0._r8 + mat(1651) = 0._r8 + mat(1652) = 0._r8 + mat(1653) = 0._r8 + mat(1654) = 0._r8 + mat(1670) = 0._r8 + mat(1674) = 0._r8 + mat(1676) = 0._r8 + mat(1678) = 0._r8 + mat(1682) = 0._r8 + mat(1683) = 0._r8 + mat(1688) = 0._r8 + mat(1690) = 0._r8 + mat(1694) = 0._r8 + mat(1697) = 0._r8 + mat(1700) = 0._r8 + mat(1702) = 0._r8 + mat(1705) = 0._r8 + mat(1706) = 0._r8 + mat(1707) = 0._r8 + mat(1714) = 0._r8 + mat(1715) = 0._r8 + mat(1716) = 0._r8 + mat(1718) = 0._r8 + mat(1719) = 0._r8 + mat(1720) = 0._r8 + mat(1721) = 0._r8 + mat(1722) = 0._r8 + mat(1725) = 0._r8 + mat(1727) = 0._r8 + mat(1728) = 0._r8 + mat(1730) = 0._r8 + mat(1732) = 0._r8 + mat(1734) = 0._r8 + mat(1736) = 0._r8 + mat(1737) = 0._r8 + mat(1739) = 0._r8 + mat(1756) = 0._r8 + mat(1760) = 0._r8 + mat(1761) = 0._r8 + mat(1762) = 0._r8 + mat(1764) = 0._r8 + mat(1768) = 0._r8 + mat(1769) = 0._r8 + mat(1771) = 0._r8 + mat(1773) = 0._r8 + mat(1776) = 0._r8 + mat(1778) = 0._r8 + mat(1787) = 0._r8 + mat(1794) = 0._r8 + mat(1795) = 0._r8 + mat(1798) = 0._r8 + mat(1813) = 0._r8 + mat(1830) = 0._r8 + mat(1833) = 0._r8 + mat(1838) = 0._r8 + mat(1844) = 0._r8 + mat(1846) = 0._r8 + mat(1848) = 0._r8 + mat(1849) = 0._r8 + mat(1851) = 0._r8 + mat(1852) = 0._r8 + mat(1856) = 0._r8 + mat(1857) = 0._r8 + mat(1858) = 0._r8 + mat(1861) = 0._r8 + mat(1876) = 0._r8 + mat(1880) = 0._r8 + mat(1884) = 0._r8 + mat(1885) = 0._r8 + mat(1886) = 0._r8 + mat(1888) = 0._r8 + mat(1893) = 0._r8 + mat(1895) = 0._r8 + mat(1897) = 0._r8 + mat(1900) = 0._r8 + mat(1902) = 0._r8 + mat(1904) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 24) = mat( 24) - dti + mat( 27) = mat( 27) - dti + mat( 30) = mat( 30) - dti + mat( 32) = mat( 32) - dti + mat( 36) = mat( 36) - dti + mat( 39) = mat( 39) - dti + mat( 42) = mat( 42) - dti + mat( 46) = mat( 46) - dti + mat( 51) = mat( 51) - dti + mat( 55) = mat( 55) - dti + mat( 61) = mat( 61) - dti + mat( 64) = mat( 64) - dti + mat( 69) = mat( 69) - dti + mat( 77) = mat( 77) - dti + mat( 83) = mat( 83) - dti + mat( 89) = mat( 89) - dti + mat( 95) = mat( 95) - dti + mat( 102) = mat( 102) - dti + mat( 109) = mat( 109) - dti + mat( 114) = mat( 114) - dti + mat( 122) = mat( 122) - dti + mat( 129) = mat( 129) - dti + mat( 136) = mat( 136) - dti + mat( 143) = mat( 143) - dti + mat( 153) = mat( 153) - dti + mat( 161) = mat( 161) - dti + mat( 168) = mat( 168) - dti + mat( 177) = mat( 177) - dti + mat( 186) = mat( 186) - dti + mat( 191) = mat( 191) - dti + mat( 197) = mat( 197) - dti + mat( 206) = mat( 206) - dti + mat( 215) = mat( 215) - dti + mat( 220) = mat( 220) - dti + mat( 228) = mat( 228) - dti + mat( 236) = mat( 236) - dti + mat( 247) = mat( 247) - dti + mat( 255) = mat( 255) - dti + mat( 265) = mat( 265) - dti + mat( 273) = mat( 273) - dti + mat( 283) = mat( 283) - dti + mat( 296) = mat( 296) - dti + mat( 309) = mat( 309) - dti + mat( 324) = mat( 324) - dti + mat( 336) = mat( 336) - dti + mat( 353) = mat( 353) - dti + mat( 367) = mat( 367) - dti + mat( 382) = mat( 382) - dti + mat( 398) = mat( 398) - dti + mat( 413) = mat( 413) - dti + mat( 427) = mat( 427) - dti + mat( 445) = mat( 445) - dti + mat( 459) = mat( 459) - dti + mat( 480) = mat( 480) - dti + mat( 496) = mat( 496) - dti + mat( 512) = mat( 512) - dti + mat( 532) = mat( 532) - dti + mat( 554) = mat( 554) - dti + mat( 575) = mat( 575) - dti + mat( 600) = mat( 600) - dti + mat( 631) = mat( 631) - dti + mat( 655) = mat( 655) - dti + mat( 677) = mat( 677) - dti + mat( 710) = mat( 710) - dti + mat( 744) = mat( 744) - dti + mat( 770) = mat( 770) - dti + mat( 819) = mat( 819) - dti + mat( 849) = mat( 849) - dti + mat( 893) = mat( 893) - dti + mat( 931) = mat( 931) - dti + mat( 965) = mat( 965) - dti + mat(1010) = mat(1010) - dti + mat(1051) = mat(1051) - dti + mat(1110) = mat(1110) - dti + mat(1151) = mat(1151) - dti + mat(1198) = mat(1198) - dti + mat(1241) = mat(1241) - dti + mat(1278) = mat(1278) - dti + mat(1338) = mat(1338) - dti + mat(1382) = mat(1382) - dti + mat(1424) = mat(1424) - dti + mat(1468) = mat(1468) - dti + mat(1512) = mat(1512) - dti + mat(1559) = mat(1559) - dti + mat(1606) = mat(1606) - dti + mat(1648) = mat(1648) - dti + mat(1692) = mat(1692) - dti + mat(1733) = mat(1733) - dti + mat(1780) = mat(1780) - dti + mat(1817) = mat(1817) - dti + mat(1860) = mat(1860) - dti + mat(1907) = mat(1907) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat05( mat, y, rxt ) + call nlnmat06( mat, y, rxt ) + call nlnmat07( mat, y, rxt ) + call nlnmat08( mat, y, rxt ) + call nlnmat09( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..04aed372d4 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 72) = p_rate(:,k, 72) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 76) = p_rate(:,k, 76) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 77) = p_rate(:,k, 77) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 79) = p_rate(:,k, 79) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 84) = p_rate(:,k, 84) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 88) = p_rate(:,k, 88) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 89) = p_rate(:,k, 89) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 91) = p_rate(:,k, 91) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..61fca66aec --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 @@ -0,0 +1,879 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = (rxt(:,:,238)* y(:,:,56) +rxt(:,:,199)* y(:,:,85) +rxt(:,:,252) & + * y(:,:,87) + (rxt(:,:,143) +rxt(:,:,144) +rxt(:,:,145))* y(:,:,134) & + + rxt(:,:,59) + rxt(:,:,60) + het_rates(:,:,12))* y(:,:,12) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,122) +rxt(:,:,123))* y(:,:,134) + rxt(:,:,5) & + + het_rates(:,:,4))* y(:,:,4) + prod(:,:,2) = 0._r8 + loss(:,:,3) = (rxt(:,:,240)* y(:,:,85) +rxt(:,:,241)* y(:,:,87) + rxt(:,:,37) & + + het_rates(:,:,35))* y(:,:,35) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,245)* y(:,:,85) +rxt(:,:,244)* y(:,:,87) +rxt(:,:,134) & + * y(:,:,134) + rxt(:,:,48) + het_rates(:,:,36))* y(:,:,36) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,125)* y(:,:,134) + rxt(:,:,40) + het_rates(:,:,37)) & + * y(:,:,37) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,126)* y(:,:,134) + rxt(:,:,41) + het_rates(:,:,38)) & + * y(:,:,38) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,127)* y(:,:,134) + rxt(:,:,42) + het_rates(:,:,39)) & + * y(:,:,39) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,128)* y(:,:,134) + rxt(:,:,43) + het_rates(:,:,47)) & + * y(:,:,47) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,129)* y(:,:,134) + rxt(:,:,44) + het_rates(:,:,48)) & + * y(:,:,48) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,243)* y(:,:,87) +rxt(:,:,130)* y(:,:,134) & + + rxt(:,:,45) + het_rates(:,:,40))* y(:,:,40) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,246)* y(:,:,87) +rxt(:,:,131)* y(:,:,134) & + + rxt(:,:,46) + het_rates(:,:,45))* y(:,:,45) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,247)* y(:,:,87) +rxt(:,:,132)* y(:,:,134) & + + rxt(:,:,47) + het_rates(:,:,46))* y(:,:,46) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,133)* y(:,:,134) + rxt(:,:,38) + het_rates(:,:,41)) & + * y(:,:,41) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,242)* y(:,:,87) + rxt(:,:,39) + het_rates(:,:,42)) & + * y(:,:,42) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,136)* y(:,:,134) + rxt(:,:,49) + het_rates(:,:,43)) & + * y(:,:,43) + prod(:,:,15) = 0._r8 + loss(:,:,16) = (rxt(:,:,135)* y(:,:,134) + rxt(:,:,50) + het_rates(:,:,44)) & + * y(:,:,44) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,137)* y(:,:,134) + rxt(:,:,53) + het_rates(:,:,49)) & + * y(:,:,49) + prod(:,:,17) = 0._r8 + loss(:,:,18) = (rxt(:,:,138)* y(:,:,134) + rxt(:,:,54) + het_rates(:,:,50)) & + * y(:,:,50) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,251)* y(:,:,85) +rxt(:,:,249)* y(:,:,87) & + +rxt(:,:,139)* y(:,:,134) + rxt(:,:,51) + het_rates(:,:,51)) & + * y(:,:,51) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,250)* y(:,:,85) +rxt(:,:,248)* y(:,:,87) & + +rxt(:,:,140)* y(:,:,134) + rxt(:,:,52) + het_rates(:,:,52)) & + * y(:,:,52) + prod(:,:,20) = 0._r8 + loss(:,:,21) = ( + het_rates(:,:,21))* y(:,:,21) + prod(:,:,21) = 0._r8 + loss(:,:,22) = ( + het_rates(:,:,22))* y(:,:,22) + prod(:,:,22) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(94) = (rxt(106)* y(2) +rxt(178)* y(6) +rxt(181)* y(7) +rxt(150)* y(18) & + +rxt(269)* y(59) +rxt(272)* y(60) +rxt(193)* y(85) +rxt(220)* y(86) & + +rxt(155)* y(87) +rxt(163)* y(88) +rxt(377)* y(106) +rxt(388) & + * y(107) +rxt(374)* y(108) +rxt(405)* y(110) +rxt(420)* y(112) & + +rxt(428)* y(113) +rxt(434)* y(114) +rxt(315)* y(130) +rxt(124) & + * y(134) + rxt(3) + rxt(4) + het_rates(1))* y(1) + prod(94) = (rxt(105)*y(3) +rxt(336)*y(91) +rxt(369)*y(107))*y(2) & + +rxt(366)*y(133)*y(106) +rxt(96)*y(108) + loss(95) = (rxt(106)* y(1) + 2._r8*rxt(107)* y(2) +rxt(105)* y(3) +rxt(176) & + * y(6) + (rxt(179) +rxt(180))* y(7) +rxt(187)* y(8) +rxt(257)* y(15) & + +rxt(161)* y(17) +rxt(165)* y(19) +rxt(200)* y(24) +rxt(213)* y(27) & + +rxt(214)* y(28) +rxt(217)* y(29) +rxt(223)* y(31) +rxt(233)* y(32) & + +rxt(234)* y(33) +rxt(235)* y(34) +rxt(265)* y(58) +rxt(154)* y(87) & + +rxt(162)* y(88) + (rxt(301) +rxt(302))* y(89) +rxt(336)* y(91) & + +rxt(364)* y(106) + (rxt(369) +rxt(387))* y(107) + (rxt(373) + & + rxt(396))* y(108) +rxt(403)* y(109) +rxt(375)* y(110) +rxt(411) & + * y(111) +rxt(422)* y(112) +rxt(433)* y(114) +rxt(443)* y(124) & + +rxt(308)* y(127) + rxt(67) + rxt(68) + rxt(69) + rxt(80) + rxt(81) & + + rxt(82) + het_rates(2))* y(2) + prod(95) = (rxt(1) +2.000_r8*rxt(2) +rxt(73) +rxt(74) +rxt(75) + & + 2.000_r8*rxt(78) +rxt(85) +rxt(86) +rxt(87) +2.000_r8*rxt(90) + & + rxt(119)*y(134) +rxt(120)*y(134) +rxt(171)*y(5) +rxt(268)*y(59) + & + rxt(271)*y(60) +rxt(299)*y(128) +rxt(307)*y(127))*y(3) & + + (rxt(417)*y(85) +rxt(469)*y(96) +rxt(485)*y(97) +rxt(501)*y(95) + & + rxt(517)*y(101) +rxt(533)*y(102) +rxt(549)*y(129) +rxt(565)*y(90) + & + rxt(580)*y(96) +rxt(582)*y(97))*y(111) + (rxt(478)*y(96) + & + rxt(494)*y(97) +rxt(510)*y(95) +rxt(526)*y(101) +rxt(542)*y(102) + & + rxt(558)*y(129) +rxt(574)*y(90) +rxt(590)*y(96) +rxt(591)*y(97)) & + *y(115) + (rxt(476)*y(96) +rxt(492)*y(97) +rxt(508)*y(95) + & + rxt(524)*y(101) +rxt(540)*y(102) +rxt(556)*y(129) +rxt(572)*y(90) + & + rxt(588)*y(96) +rxt(589)*y(97))*y(116) + (rxt(94) +rxt(367) + & + rxt(377)*y(1) +rxt(380)*y(7) +rxt(385)*y(85))*y(106) & + + (rxt(172)*y(6) +rxt(173)*y(7) +rxt(304)*y(90))*y(5) + (rxt(6) + & + rxt(399)*y(108))*y(6) + (rxt(8) +rxt(401)*y(108))*y(7) + (rxt(58) + & + rxt(92))*y(57) + (rxt(311)*y(129) +1.150_r8*rxt(312)*y(90))*y(130) & + +rxt(4)*y(1) +rxt(12)*y(8) +rxt(10)*y(11) +rxt(153)*y(88)*y(18) & + +rxt(24)*y(24) +rxt(25)*y(25) +rxt(32)*y(31) +rxt(65)*y(60) +rxt(62) & + *y(61) +rxt(63)*y(62) +rxt(157)*y(87)*y(87) +rxt(118)*y(134) +rxt(21) & + *y(135) + loss(82) = (rxt(124)* y(1) + (rxt(119) +rxt(120))* y(3) + (rxt(122) + & + rxt(123))* y(4) + (rxt(143) +rxt(144) +rxt(145))* y(12) +rxt(146) & + * y(17) +rxt(147)* y(27) +rxt(148)* y(32) +rxt(134)* y(36) +rxt(125) & + * y(37) +rxt(126)* y(38) +rxt(127)* y(39) +rxt(130)* y(40) +rxt(133) & + * y(41) +rxt(136)* y(43) +rxt(135)* y(44) +rxt(131)* y(45) +rxt(132) & + * y(46) +rxt(128)* y(47) +rxt(129)* y(48) +rxt(137)* y(49) +rxt(138) & + * y(50) +rxt(139)* y(51) +rxt(140)* y(52) +rxt(141)* y(53) +rxt(142) & + * y(54) +rxt(121)* y(135) + rxt(118) + het_rates(134))* y(134) + prod(82) = (rxt(1) +rxt(168)*y(131))*y(3) +rxt(3)*y(1) & + +.850_r8*rxt(312)*y(130)*y(90) +rxt(20)*y(135) + loss(97) = (rxt(105)* y(2) +rxt(171)* y(5) +rxt(149)* y(18) +rxt(268)* y(59) & + +rxt(271)* y(60) +rxt(309)* y(89) +rxt(332)* y(90) +rxt(378)* y(106) & + +rxt(391)* y(107) +rxt(412)* y(111) + (rxt(306) +rxt(307))* y(127) & + +rxt(299)* y(128) + (rxt(314) +rxt(316))* y(130) +rxt(168)* y(131) & + +rxt(115)* y(133) +rxt(119)* y(134) + rxt(1) + rxt(2) + rxt(71) & + + rxt(73) + rxt(74) + rxt(75) + rxt(78) + rxt(83) + rxt(85) & + + rxt(86) + rxt(87) + rxt(90) + het_rates(3))* y(3) + prod(97) = (rxt(4) +2.000_r8*rxt(106)*y(2) +2.000_r8*rxt(124)*y(134) + & + rxt(150)*y(18) +rxt(155)*y(87) +2.000_r8*rxt(163)*y(88) + & + rxt(178)*y(6) +rxt(181)*y(7) +rxt(193)*y(85) +rxt(220)*y(86) + & + rxt(269)*y(59) +rxt(272)*y(60) +rxt(315)*y(130) + & + 3.000_r8*rxt(374)*y(108) +rxt(388)*y(107) +rxt(420)*y(112) + & + rxt(428)*y(113) +2.000_r8*rxt(434)*y(114))*y(1) + (rxt(107)*y(2) + & + rxt(114)*y(133) +rxt(154)*y(87) +rxt(162)*y(88) +rxt(179)*y(7) + & + rxt(187)*y(8) +rxt(200)*y(24) +rxt(223)*y(31) +rxt(364)*y(106) + & + 2.000_r8*rxt(373)*y(108) +rxt(387)*y(107) +rxt(396)*y(108) + & + rxt(403)*y(109) +rxt(422)*y(112) +rxt(433)*y(114) +rxt(443)*y(124)) & + *y(2) + (rxt(305)*y(6) +rxt(564)*y(120) +rxt(565)*y(111) + & + rxt(566)*y(126) +rxt(567)*y(114) +rxt(568)*y(122) + & + 2.000_r8*rxt(570)*y(112) +rxt(571)*y(118) +rxt(572)*y(116) + & + rxt(573)*y(123) +rxt(574)*y(115) +rxt(575)*y(117) +rxt(576)*y(121) + & + rxt(577)*y(125) +rxt(578)*y(119) +rxt(579)*y(113))*y(90) + (rxt(95) + & + rxt(371) +2.000_r8*rxt(370)*y(133) +rxt(390)*y(7) +rxt(394)*y(24) + & + rxt(395)*y(85) +rxt(473)*y(96) +rxt(489)*y(97) +rxt(505)*y(95) + & + rxt(521)*y(101) +rxt(537)*y(102) +rxt(553)*y(129))*y(107) & + + (rxt(202)*y(87) +rxt(203)*y(88) +rxt(207)*y(24) +rxt(208)*y(24) + & + rxt(229)*y(31) +rxt(230)*y(31) +rxt(386)*y(106) +rxt(419)*y(111) + & + rxt(425)*y(112))*y(24) + (rxt(152)*y(18) +rxt(156)*y(87) + & + rxt(164)*y(88) +rxt(189)*y(8) +rxt(196)*y(85) +rxt(221)*y(86) + & + rxt(225)*y(31) +rxt(259)*y(13))*y(88) + (rxt(424)*y(85) + & + rxt(474)*y(96) +rxt(490)*y(97) +rxt(506)*y(95) +rxt(522)*y(101) + & + rxt(538)*y(102) +rxt(554)*y(129))*y(112) + (rxt(100) + & + rxt(397)*y(18) +rxt(398)*y(57) +rxt(400)*y(7) +rxt(402)*y(6))*y(108) & + + (rxt(116) +rxt(117) +2.000_r8*rxt(115)*y(3) + & + 2.000_r8*rxt(335)*y(91))*y(133) + (rxt(322)*y(130) +rxt(337)*y(135) + & + rxt(338)*y(135))*y(92) + (2.000_r8*rxt(317)*y(130) +rxt(334)*y(135)) & + *y(91) + (rxt(101) +rxt(404)*y(57))*y(109) +rxt(123)*y(134)*y(4) & + +rxt(175)*y(7)*y(5) +rxt(13)*y(8) +rxt(191)*y(87)*y(10) & + +rxt(231)*y(31)*y(31) +rxt(113)*y(132) + loss(32) = (rxt(111)* y(1) +rxt(108)* y(2) +rxt(109)* y(3) +rxt(112)* y(57) & + + rxt(110) + rxt(113) + het_rates(132))* y(132) + prod(32) =rxt(119)*y(134)*y(3) + loss(61) = (rxt(114)* y(2) +rxt(115)* y(3) +rxt(335)* y(91) +rxt(366)* y(106) & + +rxt(370)* y(107) + rxt(116) + rxt(117) + het_rates(133))* y(133) + prod(61) = (rxt(110) +rxt(108)*y(2) +rxt(109)*y(3) +rxt(111)*y(1) + & + rxt(112)*y(57))*y(132) +rxt(3)*y(1) + loss(80) = (rxt(161)* y(2) +rxt(237)* y(56) +rxt(194)* y(85) +rxt(159)* y(87) & + + (rxt(368) +rxt(382))* y(106) +rxt(146)* y(134) + het_rates(17)) & + * y(17) + prod(80) =rxt(145)*y(134)*y(12) +rxt(18)*y(15) +rxt(152)*y(88)*y(18) +rxt(20) & + *y(135) + loss(50) = ((rxt(253) +rxt(254))* y(87) + het_rates(16))* y(16) + prod(50) = (rxt(17) +rxt(18) +rxt(198)*y(85) +rxt(222)*y(86) +rxt(255)*y(8) + & + rxt(256)*y(87) +rxt(257)*y(2))*y(15) + (rxt(58) +rxt(92) + & + rxt(303)*y(128))*y(57) + (rxt(64) +rxt(265)*y(2) +rxt(266)*y(87)) & + *y(58) +rxt(240)*y(85)*y(35) + loss(102) = (rxt(330)* y(105) +rxt(381)* y(106) +rxt(389)* y(107) +rxt(398) & + * y(108) +rxt(404)* y(109) +rxt(407)* y(110) +rxt(303)* y(128) & + +rxt(360)* y(129) + rxt(58) + rxt(92) + het_rates(57))* y(57) + prod(102) = (rxt(102) +rxt(411)*y(2) +rxt(412)*y(3) +rxt(413)*y(18) + & + rxt(414)*y(6) +rxt(415)*y(7) +rxt(416)*y(9) +rxt(417)*y(85) + & + rxt(418)*y(85) +rxt(419)*y(24) +rxt(469)*y(96) +rxt(485)*y(97) + & + rxt(501)*y(95) +rxt(517)*y(101) +rxt(533)*y(102) +rxt(549)*y(129) + & + rxt(565)*y(90) +rxt(580)*y(96) +rxt(582)*y(97))*y(111) & + + (rxt(450)*y(6) +rxt(451)*y(7) +rxt(453)*y(7) +rxt(456)*y(6) + & + rxt(478)*y(96) +rxt(494)*y(97) +rxt(510)*y(95) +rxt(526)*y(101) + & + rxt(542)*y(102) +rxt(558)*y(129) +rxt(574)*y(90) +rxt(590)*y(96) + & + rxt(591)*y(97))*y(115) + (rxt(103) +rxt(420)*y(1) +rxt(423)*y(27) + & + rxt(424)*y(85) +rxt(425)*y(24) +rxt(474)*y(96) +rxt(490)*y(97) + & + rxt(506)*y(95) +rxt(522)*y(101) +rxt(538)*y(102) +rxt(554)*y(129) + & + rxt(570)*y(90))*y(112) + (rxt(476)*y(96) +rxt(492)*y(97) + & + rxt(508)*y(95) +rxt(524)*y(101) +rxt(540)*y(102) +rxt(556)*y(129) + & + rxt(572)*y(90) +rxt(588)*y(96) +rxt(589)*y(97))*y(116) & + + (rxt(472)*y(96) +rxt(488)*y(97) +rxt(504)*y(95) +rxt(520)*y(101) + & + rxt(536)*y(102) +rxt(552)*y(129) +rxt(568)*y(90))*y(122) & + + (rxt(361) +rxt(318)*y(130) +rxt(359)*y(135))*y(104) & + + (rxt(253)*y(87) +rxt(254)*y(87))*y(16) + loss(64) = (rxt(171)* y(3) +rxt(172)* y(6) + (rxt(173) +rxt(174) +rxt(175)) & + * y(7) +rxt(170)* y(87) +rxt(304)* y(90) + rxt(70) + het_rates(5)) & + * y(5) + prod(64) = (rxt(169)*y(131) +rxt(308)*y(127))*y(2) & + + (.200_r8*rxt(311)*y(129) +1.100_r8*rxt(313)*y(89))*y(130) & + +rxt(306)*y(127)*y(3) +rxt(6)*y(6) +rxt(300)*y(128) + loss(104) = (rxt(178)* y(1) +rxt(176)* y(2) +rxt(172)* y(5) +rxt(186)* y(8) & + +rxt(258)* y(13) +rxt(166)* y(18) +rxt(205)* y(24) +rxt(226)* y(31) & + +rxt(177)* y(88) +rxt(305)* y(90) +rxt(365)* y(106) + (rxt(399) + & + rxt(402))* y(108) +rxt(414)* y(111) + (rxt(450) +rxt(456))* y(115) & + + (rxt(441) +rxt(442))* y(124) + rxt(6) + rxt(7) + het_rates(6)) & + * y(6) + prod(104) = (rxt(319)*y(130) +rxt(356)*y(18) +rxt(516)*y(120) + & + rxt(517)*y(111) +rxt(518)*y(126) +rxt(519)*y(114) +rxt(520)*y(122) + & + rxt(521)*y(107) +rxt(522)*y(112) +rxt(523)*y(118) +rxt(524)*y(116) + & + rxt(525)*y(123) +rxt(526)*y(115) +rxt(527)*y(117) +rxt(528)*y(121) + & + rxt(529)*y(125) +rxt(530)*y(119) +rxt(531)*y(113))*y(101) & + + (rxt(320)*y(130) +rxt(532)*y(120) +rxt(533)*y(111) + & + rxt(534)*y(126) +rxt(535)*y(114) +rxt(536)*y(122) +rxt(537)*y(107) + & + rxt(538)*y(112) +rxt(539)*y(118) +rxt(540)*y(116) +rxt(541)*y(123) + & + rxt(542)*y(115) +rxt(543)*y(117) +rxt(544)*y(121) +rxt(545)*y(125) + & + rxt(546)*y(119) +rxt(547)*y(113))*y(102) + (rxt(548)*y(120) + & + rxt(549)*y(111) +rxt(550)*y(126) +rxt(551)*y(114) +rxt(552)*y(122) + & + rxt(553)*y(107) +rxt(554)*y(112) +rxt(555)*y(118) +rxt(556)*y(116) + & + rxt(557)*y(123) +rxt(558)*y(115) +rxt(559)*y(117) +rxt(560)*y(121) + & + rxt(561)*y(125) +rxt(562)*y(119) +rxt(563)*y(113))*y(129) + (rxt(8) + & + .500_r8*rxt(263) +2.000_r8*rxt(174)*y(5) +rxt(179)*y(2) + & + rxt(273)*y(60) +rxt(427)*y(113))*y(7) + (rxt(318)*y(104) + & + rxt(321)*y(103) +rxt(329)*y(105))*y(130) + (rxt(168)*y(131) + & + rxt(171)*y(5))*y(3) +2.000_r8*rxt(122)*y(134)*y(4) +rxt(170)*y(87) & + *y(5) +rxt(13)*y(8) +rxt(10)*y(11) +rxt(426)*y(113)*y(18) +rxt(66) & + *y(20) +rxt(310)*y(90) + loss(105) = (rxt(181)* y(1) + (rxt(179) +rxt(180))* y(2) + (rxt(173) + & + rxt(174) +rxt(175))* y(5) +rxt(182)* y(8) +rxt(206)* y(24) +rxt(227) & + * y(31) +rxt(273)* y(60) +rxt(184)* y(87) +rxt(190)* y(88) +rxt(380) & + * y(106) +rxt(390)* y(107) + (rxt(400) +rxt(401))* y(108) +rxt(406) & + * y(110) +rxt(415)* y(111) +rxt(427)* y(113) + (rxt(451) +rxt(453)) & + * y(115) +rxt(437)* y(123) + rxt(8) + rxt(263) + het_rates(7))* y(7) + prod(105) = (rxt(176)*y(2) +rxt(177)*y(88) +rxt(178)*y(1) + & + 2.000_r8*rxt(186)*y(8) +rxt(205)*y(24) +rxt(226)*y(31) + & + rxt(258)*y(13) +rxt(365)*y(106) +rxt(442)*y(124))*y(6) + (rxt(98) + & + rxt(431)*y(85) +rxt(483)*y(96) +rxt(499)*y(97) +rxt(515)*y(95) + & + rxt(531)*y(101) +rxt(547)*y(102) +rxt(563)*y(129) +rxt(579)*y(90)) & + *y(113) + (rxt(479)*y(96) +rxt(495)*y(97) +rxt(511)*y(95) + & + rxt(527)*y(101) +rxt(543)*y(102) +rxt(559)*y(129) +rxt(575)*y(90)) & + *y(117) + (rxt(12) +rxt(187)*y(2) +rxt(188)*y(87) +rxt(189)*y(88)) & + *y(8) + (rxt(15) +rxt(192) +rxt(191)*y(87))*y(10) + (rxt(9) + & + rxt(183))*y(11) + (rxt(167)*y(20) +rxt(355)*y(101))*y(87) +rxt(11) & + *y(9) +rxt(30)*y(29) +rxt(36)*y(34) + loss(88) = (rxt(155)* y(1) +rxt(154)* y(2) +rxt(170)* y(5) +rxt(184)* y(7) & + +rxt(188)* y(8) +rxt(185)* y(9) +rxt(191)* y(10) +rxt(252)* y(12) & + +rxt(260)* y(14) +rxt(256)* y(15) + (rxt(253) +rxt(254))* y(16) & + +rxt(159)* y(17) +rxt(160)* y(19) +rxt(167)* y(20) + (rxt(201) + & + rxt(202))* y(24) +rxt(212)* y(27) +rxt(216)* y(28) +rxt(218)* y(29) & + +rxt(224)* y(31) +rxt(232)* y(32) +rxt(241)* y(35) +rxt(244)* y(36) & + +rxt(243)* y(40) +rxt(242)* y(42) +rxt(246)* y(45) +rxt(247)* y(46) & + +rxt(249)* y(51) +rxt(248)* y(52) +rxt(266)* y(58) +rxt(267)* y(59) & + +rxt(270)* y(60) +rxt(277)* y(61) + (rxt(279) +rxt(280))* y(64) & + + 2._r8*(rxt(157) +rxt(158))* y(87) +rxt(156)* y(88) +rxt(355) & + * y(101) + het_rates(87))* y(87) + prod(88) = (rxt(161)*y(17) +rxt(162)*y(88) +rxt(165)*y(19) +rxt(213)*y(27) + & + rxt(214)*y(28) +rxt(233)*y(32) +rxt(234)*y(33) +rxt(257)*y(15))*y(2) & + + (rxt(472)*y(96) +rxt(488)*y(97) +rxt(504)*y(95) +rxt(520)*y(101) + & + rxt(536)*y(102) +rxt(552)*y(129) +rxt(568)*y(90))*y(122) + (rxt(19) + & + 2.000_r8*rxt(121)*y(134) +rxt(236)*y(56) +rxt(338)*y(92) + & + rxt(339)*y(98) +rxt(379)*y(106))*y(135) + (2.000_r8*rxt(151)*y(18) + & + rxt(163)*y(1) +rxt(177)*y(6) +rxt(189)*y(8) +rxt(197)*y(85))*y(88) & + + (rxt(97) +rxt(405)*y(1) +rxt(406)*y(7) +rxt(409)*y(85) + & + rxt(410)*y(24))*y(110) + (rxt(143)*y(12) +rxt(146)*y(17) + & + rxt(147)*y(27) +rxt(148)*y(32))*y(134) + (rxt(11) +rxt(383)*y(106) + & + rxt(416)*y(111))*y(9) + (rxt(150)*y(1) +rxt(421)*y(112))*y(18) & + +.500_r8*rxt(263)*y(7) +rxt(14)*y(10) +rxt(16)*y(14) & + +2.000_r8*rxt(22)*y(19) +rxt(66)*y(20) +rxt(384)*y(106)*y(27) & + +rxt(27)*y(28) +rxt(33)*y(33) +rxt(323)*y(130)*y(98) + loss(107) = (rxt(187)* y(2) +rxt(186)* y(6) +rxt(182)* y(7) +rxt(255)* y(15) & + +rxt(281)* y(64) +rxt(188)* y(87) +rxt(189)* y(88) + rxt(12) & + + rxt(13) + rxt(262) + het_rates(8))* y(8) + prod(107) = (rxt(475)*y(96) +rxt(491)*y(97) +rxt(507)*y(95) + & + rxt(523)*y(101) +rxt(539)*y(102) +rxt(555)*y(129) +rxt(571)*y(90) + & + rxt(592)*y(96) +rxt(593)*y(97))*y(118) + (rxt(482)*y(96) + & + rxt(498)*y(97) +rxt(514)*y(95) +rxt(530)*y(101) +rxt(546)*y(102) + & + rxt(562)*y(129) +rxt(578)*y(90))*y(119) + (rxt(480)*y(96) + & + rxt(496)*y(97) +rxt(512)*y(95) +rxt(528)*y(101) +rxt(544)*y(102) + & + rxt(560)*y(129) +rxt(576)*y(90))*y(121) + (rxt(99) +rxt(519)*y(101) + & + rxt(535)*y(102) +rxt(551)*y(129) +rxt(567)*y(90))*y(114) + (rxt(29) + & + rxt(217)*y(2) +rxt(218)*y(87) +rxt(219)*y(85))*y(29) & + + (rxt(516)*y(101) +rxt(532)*y(102) +rxt(548)*y(129) + & + rxt(564)*y(90))*y(120) + (rxt(9) +rxt(10) +rxt(183))*y(11) & + + (rxt(180)*y(7) +rxt(235)*y(34))*y(2) + (rxt(185)*y(87) + & + rxt(239)*y(56))*y(9) +rxt(181)*y(7)*y(1) +rxt(14)*y(10) & + +rxt(432)*y(113)*y(24) +rxt(35)*y(34) +rxt(354)*y(101)*y(88) + loss(51) = (rxt(167)* y(87) + rxt(66) + het_rates(20))* y(20) + prod(51) =rxt(166)*y(18)*y(6) +rxt(430)*y(113)*y(27) +rxt(358)*y(135)*y(103) + loss(109) = (rxt(239)* y(56) +rxt(185)* y(87) +rxt(383)* y(106) +rxt(392) & + * y(107) +rxt(416)* y(111) +rxt(429)* y(113) +rxt(463)* y(114) & + +rxt(467)* y(118) +rxt(464)* y(121) +rxt(438)* y(123) + rxt(11) & + + het_rates(9))* y(9) + prod(109) = (rxt(462) +2.000_r8*rxt(468)*y(96) +2.000_r8*rxt(484)*y(97) + & + 2.000_r8*rxt(500)*y(95) +rxt(516)*y(101) +rxt(532)*y(102) + & + rxt(548)*y(129) +rxt(564)*y(90) +2.000_r8*rxt(586)*y(96) + & + 2.000_r8*rxt(587)*y(97))*y(120) + (2.000_r8*rxt(261) + & + 2.000_r8*rxt(282) +2.000_r8*rxt(288) +2.000_r8*rxt(293) + & + rxt(348)*y(96) +rxt(349)*y(97) +rxt(461)*y(119) +rxt(466)*y(118)) & + *y(11) + (rxt(283) +rxt(289) +rxt(294) +rxt(285)*y(27) + & + rxt(290)*y(27) +rxt(296)*y(27))*y(29) + (rxt(435)*y(27) + & + rxt(471)*y(96) +rxt(487)*y(97) +rxt(503)*y(95) +rxt(581)*y(96) + & + rxt(583)*y(97))*y(114) + (rxt(262) +rxt(255)*y(15) +rxt(281)*y(64)) & + *y(8) + (rxt(284) +rxt(292) +rxt(295))*y(34) + (.500_r8*rxt(263) + & + rxt(184)*y(87))*y(7) + (rxt(350)*y(99) +rxt(351)*y(100))*y(135) + loss(39) = (rxt(191)* y(87) + rxt(14) + rxt(15) + rxt(192) + het_rates(10)) & + * y(10) + prod(39) =rxt(190)*y(88)*y(7) + loss(62) = (rxt(348)* y(96) +rxt(349)* y(97) +rxt(466)* y(118) +rxt(461) & + * y(119) + rxt(9) + rxt(10) + rxt(183) + rxt(261) + rxt(282) & + + rxt(288) + rxt(293) + het_rates(11))* y(11) + prod(62) =rxt(182)*y(8)*y(7) + loss(63) = (rxt(258)* y(6) +rxt(204)* y(24) +rxt(259)* y(88) + het_rates(13)) & + * y(13) + prod(63) = (rxt(143)*y(134) +rxt(199)*y(85) +rxt(238)*y(56) +rxt(252)*y(87)) & + *y(12) +rxt(260)*y(87)*y(14) + loss(37) = (rxt(260)* y(87) + rxt(16) + het_rates(14))* y(14) + prod(37) =rxt(259)*y(88)*y(13) + loss(73) = (rxt(257)* y(2) +rxt(255)* y(8) +rxt(198)* y(85) +rxt(222)* y(86) & + +rxt(256)* y(87) + rxt(17) + rxt(18) + het_rates(15))* y(15) + prod(73) = (rxt(144)*y(134) +rxt(145)*y(134))*y(12) + (rxt(204)*y(24) + & + rxt(258)*y(6))*y(13) +rxt(16)*y(14) + loss(91) = (rxt(150)* y(1) +rxt(149)* y(3) +rxt(166)* y(6) + (rxt(151) + & + rxt(152) +rxt(153))* y(88) +rxt(356)* y(101) +rxt(372)* y(107) & + +rxt(397)* y(108) +rxt(376)* y(110) +rxt(413)* y(111) +rxt(421) & + * y(112) +rxt(426)* y(113) +rxt(436)* y(123) + het_rates(18))* y(18) + prod(91) = (rxt(327)*y(130) +rxt(469)*y(111) +rxt(470)*y(126) + & + rxt(472)*y(122) +rxt(473)*y(107) +rxt(474)*y(112) +rxt(475)*y(118) + & + rxt(476)*y(116) +rxt(477)*y(123) +rxt(478)*y(115) +rxt(479)*y(117) + & + rxt(480)*y(121) +rxt(481)*y(125) +rxt(482)*y(119) +rxt(483)*y(113) + & + rxt(580)*y(111) +rxt(588)*y(116) +rxt(590)*y(115) +rxt(592)*y(118)) & + *y(96) + (rxt(328)*y(130) +rxt(485)*y(111) +rxt(486)*y(126) + & + rxt(488)*y(122) +rxt(489)*y(107) +rxt(490)*y(112) +rxt(491)*y(118) + & + rxt(492)*y(116) +rxt(493)*y(123) +rxt(494)*y(115) +rxt(495)*y(117) + & + rxt(496)*y(121) +rxt(497)*y(125) +rxt(498)*y(119) +rxt(499)*y(113) + & + rxt(582)*y(111) +rxt(589)*y(116) +rxt(591)*y(115) +rxt(593)*y(118)) & + *y(97) + (rxt(326)*y(130) +rxt(501)*y(111) +rxt(502)*y(126) + & + rxt(504)*y(122) +rxt(505)*y(107) +rxt(506)*y(112) +rxt(507)*y(118) + & + rxt(508)*y(116) +rxt(509)*y(123) +rxt(510)*y(115) +rxt(511)*y(117) + & + rxt(512)*y(121) +rxt(513)*y(125) +rxt(514)*y(119) +rxt(515)*y(113)) & + *y(95) + (rxt(154)*y(2) +rxt(159)*y(17) +rxt(170)*y(5) + & + rxt(253)*y(16) +rxt(256)*y(15) +rxt(266)*y(58) +rxt(267)*y(59) + & + rxt(270)*y(60))*y(87) + (rxt(146)*y(134) +rxt(161)*y(2) + & + rxt(194)*y(85) +rxt(237)*y(56) +rxt(382)*y(106))*y(17) & + + (rxt(323)*y(98) +rxt(324)*y(93) +rxt(325)*y(94))*y(130) & + + (rxt(19) +2.000_r8*rxt(21))*y(135) +rxt(144)*y(134)*y(12) +rxt(16) & + *y(14) +2.000_r8*rxt(17)*y(15) +rxt(28)*y(27) +rxt(34)*y(32) +rxt(57) & + *y(55) + loss(86) = (rxt(163)* y(1) +rxt(162)* y(2) +rxt(177)* y(6) +rxt(190)* y(7) & + +rxt(189)* y(8) +rxt(259)* y(13) + (rxt(151) +rxt(152) +rxt(153)) & + * y(18) +rxt(203)* y(24) +rxt(225)* y(31) + (rxt(196) +rxt(197)) & + * y(85) +rxt(221)* y(86) +rxt(156)* y(87) + 2._r8*rxt(164)* y(88) & + +rxt(354)* y(101) + rxt(264) + het_rates(88))* y(88) + prod(86) = (rxt(241)*y(35) +rxt(244)*y(36) +rxt(155)*y(1) +rxt(160)*y(19) + & + rxt(188)*y(8) +rxt(201)*y(24) +rxt(224)*y(31) +rxt(254)*y(16) + & + rxt(277)*y(61) +.500_r8*rxt(279)*y(64))*y(87) + (rxt(198)*y(85) + & + rxt(222)*y(86) +rxt(255)*y(8) +rxt(257)*y(2))*y(15) & + + (rxt(240)*y(35) +rxt(245)*y(36) +rxt(195)*y(19))*y(85) & + + (rxt(372)*y(18) +rxt(392)*y(9) +rxt(393)*y(27))*y(107) & + + (rxt(165)*y(19) +rxt(375)*y(110))*y(2) + (rxt(15) +rxt(192))*y(10) & + + (rxt(204)*y(24) +rxt(258)*y(6))*y(13) +rxt(149)*y(18)*y(3) & + +rxt(144)*y(134)*y(12) +rxt(423)*y(112)*y(27) + loss(43) = (rxt(165)* y(2) +rxt(195)* y(85) +rxt(160)* y(87) + rxt(22) & + + het_rates(19))* y(19) + prod(43) = (.500_r8*rxt(264) +rxt(164)*y(88))*y(88) +rxt(158)*y(87)*y(87) + loss(100) = (rxt(236)* y(56) +rxt(278)* y(62) +rxt(333)* y(90) +rxt(334) & + * y(91) + (rxt(337) +rxt(338))* y(92) +rxt(340)* y(93) +rxt(342) & + * y(94) +rxt(344)* y(95) +rxt(346)* y(96) +rxt(339)* y(98) +rxt(350) & + * y(99) +rxt(351)* y(100) +rxt(353)* y(101) +rxt(357)* y(102) & + +rxt(358)* y(103) +rxt(359)* y(104) +rxt(331)* y(105) +rxt(379) & + * y(106) +rxt(447)* y(111) +rxt(458)* y(113) +rxt(448)* y(114) & + +rxt(454)* y(115) +rxt(459)* y(118) +rxt(439)* y(123) +rxt(352) & + * y(129) +rxt(121)* y(134) + rxt(19) + rxt(20) + rxt(21) & + + het_rates(135))* y(135) + prod(100) = (rxt(345) +4.000_r8*rxt(327)*y(130) +4.000_r8*rxt(468)*y(120) + & + 4.000_r8*rxt(469)*y(111) +4.000_r8*rxt(470)*y(126) + & + 4.000_r8*rxt(471)*y(114) +4.000_r8*rxt(472)*y(122) + & + 4.000_r8*rxt(473)*y(107) +4.000_r8*rxt(474)*y(112) + & + 5.000_r8*rxt(475)*y(118) +6.000_r8*rxt(476)*y(116) + & + 4.000_r8*rxt(477)*y(123) +5.000_r8*rxt(478)*y(115) + & + 5.000_r8*rxt(479)*y(117) +4.000_r8*rxt(480)*y(121) + & + 5.000_r8*rxt(481)*y(125) +6.000_r8*rxt(482)*y(119) + & + 4.000_r8*rxt(483)*y(113) +4.000_r8*rxt(580)*y(111) + & + 4.000_r8*rxt(581)*y(114) +4.000_r8*rxt(584)*y(126) + & + 4.000_r8*rxt(586)*y(120) +6.000_r8*rxt(588)*y(116) + & + 5.000_r8*rxt(590)*y(115) +5.000_r8*rxt(592)*y(118))*y(96) & + + (rxt(347) +5.000_r8*rxt(328)*y(130) +5.000_r8*rxt(484)*y(120) + & + 5.000_r8*rxt(485)*y(111) +5.000_r8*rxt(486)*y(126) + & + 5.000_r8*rxt(487)*y(114) +5.000_r8*rxt(488)*y(122) + & + 5.000_r8*rxt(489)*y(107) +5.000_r8*rxt(490)*y(112) + & + 6.000_r8*rxt(491)*y(118) +7.000_r8*rxt(492)*y(116) + & + 5.000_r8*rxt(493)*y(123) +6.000_r8*rxt(494)*y(115) + & + 6.000_r8*rxt(495)*y(117) +5.000_r8*rxt(496)*y(121) + & + 6.000_r8*rxt(497)*y(125) +7.000_r8*rxt(498)*y(119) + & + 5.000_r8*rxt(499)*y(113) +5.000_r8*rxt(582)*y(111) + & + 5.000_r8*rxt(583)*y(114) +5.000_r8*rxt(585)*y(126) + & + 5.000_r8*rxt(587)*y(120) +7.000_r8*rxt(589)*y(116) + & + 6.000_r8*rxt(591)*y(115) +6.000_r8*rxt(593)*y(118))*y(97) & + + (rxt(241)*y(35) +rxt(242)*y(42) +rxt(243)*y(40) +rxt(244)*y(36) + & + rxt(248)*y(52) +rxt(252)*y(12) +rxt(156)*y(88) +rxt(157)*y(87) + & + rxt(159)*y(17) +rxt(160)*y(19) +rxt(167)*y(20) +rxt(185)*y(9) + & + rxt(191)*y(10) +rxt(212)*y(27) +rxt(216)*y(28) +rxt(232)*y(32) + & + rxt(256)*y(15) +rxt(260)*y(14))*y(87) + (rxt(343) + & + 3.000_r8*rxt(326)*y(130) +3.000_r8*rxt(500)*y(120) + & + 3.000_r8*rxt(501)*y(111) +3.000_r8*rxt(502)*y(126) + & + 3.000_r8*rxt(503)*y(114) +3.000_r8*rxt(504)*y(122) + & + 3.000_r8*rxt(505)*y(107) +3.000_r8*rxt(506)*y(112) + & + 4.000_r8*rxt(507)*y(118) +5.000_r8*rxt(508)*y(116) + & + 3.000_r8*rxt(509)*y(123) +4.000_r8*rxt(510)*y(115) + & + 4.000_r8*rxt(511)*y(117) +3.000_r8*rxt(512)*y(121) + & + 4.000_r8*rxt(513)*y(125) +5.000_r8*rxt(514)*y(119) + & + 3.000_r8*rxt(515)*y(113))*y(95) + (rxt(319)*y(130) +rxt(516)*y(120) + & + rxt(517)*y(111) +rxt(518)*y(126) +rxt(519)*y(114) +rxt(520)*y(122) + & + rxt(521)*y(107) +rxt(522)*y(112) +2.000_r8*rxt(523)*y(118) + & + 3.000_r8*rxt(524)*y(116) +rxt(525)*y(123) +2.000_r8*rxt(526)*y(115) + & + 2.000_r8*rxt(527)*y(117) +rxt(528)*y(121) +2.000_r8*rxt(529)*y(125) + & + 3.000_r8*rxt(530)*y(119) +rxt(531)*y(113))*y(101) & + + (2.000_r8*rxt(320)*y(130) +2.000_r8*rxt(532)*y(120) + & + 2.000_r8*rxt(533)*y(111) +2.000_r8*rxt(534)*y(126) + & + 2.000_r8*rxt(535)*y(114) +2.000_r8*rxt(536)*y(122) + & + 2.000_r8*rxt(537)*y(107) +2.000_r8*rxt(538)*y(112) + & + 3.000_r8*rxt(539)*y(118) +4.000_r8*rxt(540)*y(116) + & + 2.000_r8*rxt(541)*y(123) +3.000_r8*rxt(542)*y(115) + & + 3.000_r8*rxt(543)*y(117) +2.000_r8*rxt(544)*y(121) + & + 3.000_r8*rxt(545)*y(125) +4.000_r8*rxt(546)*y(119) + & + 2.000_r8*rxt(547)*y(113))*y(102) + (rxt(286)*y(28) +rxt(287)*y(33) + & + rxt(291)*y(28) +rxt(297)*y(28) +rxt(298)*y(33) +rxt(408)*y(110) + & + rxt(444)*y(125))*y(27) + (rxt(571)*y(118) +2.000_r8*rxt(572)*y(116) + & + rxt(574)*y(115) +rxt(575)*y(117) +rxt(577)*y(125) + & + 2.000_r8*rxt(578)*y(119))*y(90) + (rxt(555)*y(118) + & + 2.000_r8*rxt(556)*y(116) +rxt(558)*y(115) +rxt(559)*y(117) + & + rxt(561)*y(125) +2.000_r8*rxt(562)*y(119))*y(129) & + + (3.000_r8*rxt(321)*y(103) +rxt(322)*y(92) +rxt(323)*y(98) + & + rxt(324)*y(93) +2.000_r8*rxt(325)*y(94))*y(130) + (rxt(104) + & + rxt(452) +rxt(450)*y(6) +rxt(451)*y(7))*y(115) + (rxt(153)*y(88) + & + rxt(376)*y(110))*y(18) + (rxt(449) +rxt(467)*y(9))*y(118) & + + (rxt(460) +rxt(461)*y(11))*y(119) +rxt(368)*y(106)*y(17) +rxt(61) & + *y(63) +rxt(93)*y(92) +rxt(341)*y(94) +rxt(455)*y(116) +rxt(457) & + *y(117) +rxt(445)*y(125) + loss(112) = (rxt(193)* y(1) +rxt(199)* y(12) +rxt(198)* y(15) +rxt(194) & + * y(17) +rxt(195)* y(19) +rxt(215)* y(28) +rxt(219)* y(29) +rxt(240) & + * y(35) +rxt(245)* y(36) +rxt(251)* y(51) +rxt(250)* y(52) & + + (rxt(196) +rxt(197))* y(88) +rxt(385)* y(106) +rxt(395)* y(107) & + +rxt(409)* y(110) + (rxt(417) +rxt(418))* y(111) +rxt(424)* y(112) & + +rxt(431)* y(113) + het_rates(85))* y(85) + prod(112) = (2.000_r8*rxt(125)*y(37) +2.000_r8*rxt(126)*y(38) + & + 2.000_r8*rxt(127)*y(39) +2.000_r8*rxt(128)*y(47) +rxt(129)*y(48) + & + rxt(130)*y(40) +rxt(131)*y(45) +rxt(132)*y(46) + & + 4.000_r8*rxt(133)*y(41) +rxt(135)*y(44) +rxt(142)*y(54) + & + rxt(147)*y(27))*y(134) + (rxt(24) +rxt(200)*y(2) +rxt(201)*y(87) + & + rxt(204)*y(13) +rxt(205)*y(6) +2.000_r8*rxt(207)*y(24) + & + rxt(209)*y(24) +rxt(229)*y(31) +rxt(274)*y(60))*y(24) & + + (rxt(437)*y(7) +rxt(477)*y(96) +rxt(493)*y(97) +rxt(509)*y(95) + & + rxt(525)*y(101) +rxt(541)*y(102) +rxt(557)*y(129) +rxt(573)*y(90)) & + *y(123) + (rxt(481)*y(96) +rxt(497)*y(97) +rxt(513)*y(95) + & + rxt(529)*y(101) +rxt(545)*y(102) +rxt(561)*y(129) +rxt(577)*y(90)) & + *y(125) + (rxt(470)*y(96) +rxt(486)*y(97) +rxt(502)*y(95) + & + rxt(518)*y(101) +rxt(534)*y(102) +rxt(550)*y(129) +rxt(566)*y(90)) & + *y(126) + (rxt(241)*y(35) +3.000_r8*rxt(242)*y(42) +rxt(243)*y(40) + & + rxt(246)*y(45) +rxt(247)*y(46) +rxt(212)*y(27))*y(87) + (rxt(28) + & + rxt(213)*y(2))*y(27) +rxt(441)*y(124)*y(6) +2.000_r8*rxt(23)*y(23) & + +2.000_r8*rxt(26)*y(26) +rxt(27)*y(28) +rxt(29)*y(29) +rxt(31)*y(30) & + +rxt(56)*y(54) + loss(24) = ( + rxt(23) + het_rates(23))* y(23) + prod(24) = (rxt(285)*y(29) +rxt(286)*y(28) +rxt(290)*y(29) +rxt(291)*y(28) + & + rxt(296)*y(29) +rxt(297)*y(28))*y(27) +rxt(208)*y(24)*y(24) & + +rxt(219)*y(85)*y(29) + loss(106) = (rxt(200)* y(2) +rxt(205)* y(6) +rxt(206)* y(7) +rxt(204)* y(13) & + + 2._r8*(rxt(207) +rxt(208) +rxt(209) +rxt(210))* y(24) & + + (rxt(228) +rxt(229) +rxt(230))* y(31) +rxt(274)* y(60) & + + (rxt(201) +rxt(202))* y(87) +rxt(203)* y(88) +rxt(386)* y(106) & + +rxt(394)* y(107) +rxt(410)* y(110) +rxt(419)* y(111) +rxt(425) & + * y(112) +rxt(432)* y(113) + rxt(24) + het_rates(24))* y(24) + prod(106) = (rxt(214)*y(2) +rxt(215)*y(85) +rxt(216)*y(87))*y(28) & + + (rxt(25) +rxt(276)*y(60))*y(25) + (rxt(30) +rxt(217)*y(2))*y(29) & + + (rxt(193)*y(1) +rxt(197)*y(88))*y(85) +2.000_r8*rxt(211)*y(26) + loss(33) = (rxt(276)* y(60) + rxt(25) + het_rates(25))* y(25) + prod(33) = (rxt(209)*y(24) +rxt(228)*y(31))*y(24) + loss(21) = ( + rxt(26) + rxt(211) + het_rates(26))* y(26) + prod(21) =rxt(210)*y(24)*y(24) + loss(93) = (rxt(213)* y(2) + (rxt(286) +rxt(291) +rxt(297))* y(28) & + + (rxt(285) +rxt(290) +rxt(296))* y(29) + (rxt(287) +rxt(298)) & + * y(33) +rxt(212)* y(87) +rxt(384)* y(106) +rxt(393)* y(107) & + +rxt(408)* y(110) +rxt(423)* y(112) +rxt(430)* y(113) + (rxt(435) + & + rxt(465))* y(114) +rxt(440)* y(123) +rxt(444)* y(125) +rxt(147) & + * y(134) + rxt(28) + het_rates(27))* y(27) + prod(93) = (rxt(199)*y(12) +2.000_r8*rxt(240)*y(35) +rxt(245)*y(36) + & + rxt(250)*y(52) +rxt(251)*y(51) +rxt(194)*y(17) +rxt(195)*y(19) + & + rxt(196)*y(88) +rxt(198)*y(15) +rxt(215)*y(28))*y(85) + (rxt(446) + & + rxt(470)*y(96) +rxt(486)*y(97) +rxt(502)*y(95) +rxt(518)*y(101) + & + rxt(534)*y(102) +rxt(550)*y(129) +rxt(566)*y(90) + & + 2.000_r8*rxt(584)*y(96) +2.000_r8*rxt(585)*y(97))*y(126) & + + (rxt(464)*y(9) +rxt(480)*y(96) +rxt(496)*y(97) +rxt(512)*y(95) + & + rxt(528)*y(101) +rxt(544)*y(102) +rxt(560)*y(129) +rxt(576)*y(90)) & + *y(121) + (rxt(436)*y(18) +rxt(438)*y(9))*y(123) +rxt(202)*y(87) & + *y(24) + loss(56) = (rxt(214)* y(2) + (rxt(286) +rxt(291) +rxt(297))* y(27) +rxt(215) & + * y(85) +rxt(216)* y(87) + rxt(27) + het_rates(28))* y(28) + prod(56) = (rxt(283) +rxt(289) +rxt(294) +rxt(218)*y(87))*y(29) & + +rxt(203)*y(88)*y(24) + loss(59) = (rxt(217)* y(2) + (rxt(285) +rxt(290) +rxt(296))* y(27) +rxt(219) & + * y(85) +rxt(218)* y(87) + rxt(29) + rxt(30) + rxt(283) + rxt(289) & + + rxt(294) + het_rates(29))* y(29) + prod(59) =rxt(206)*y(24)*y(7) + loss(26) = ( + rxt(31) + het_rates(30))* y(30) + prod(26) = (rxt(287)*y(33) +rxt(298)*y(33))*y(27) +rxt(230)*y(31)*y(24) + loss(81) = (rxt(220)* y(1) +rxt(222)* y(15) +rxt(221)* y(88) + het_rates(86)) & + * y(86) + prod(81) = (rxt(32) +rxt(223)*y(2) +rxt(224)*y(87) +rxt(226)*y(6) + & + rxt(228)*y(24) +rxt(229)*y(24) +2.000_r8*rxt(231)*y(31) + & + rxt(275)*y(60))*y(31) + (rxt(134)*y(36) +rxt(135)*y(44) + & + rxt(136)*y(43) +2.000_r8*rxt(137)*y(49) +2.000_r8*rxt(138)*y(50) + & + 3.000_r8*rxt(139)*y(51) +2.000_r8*rxt(140)*y(52) +rxt(148)*y(32)) & + *y(134) + (rxt(244)*y(36) +2.000_r8*rxt(248)*y(52) + & + 3.000_r8*rxt(249)*y(51) +rxt(232)*y(32))*y(87) + (rxt(245)*y(36) + & + 2.000_r8*rxt(250)*y(52) +3.000_r8*rxt(251)*y(51))*y(85) + (rxt(34) + & + rxt(233)*y(2))*y(32) +rxt(31)*y(30) +rxt(33)*y(33) +rxt(35)*y(34) + loss(75) = (rxt(223)* y(2) +rxt(226)* y(6) +rxt(227)* y(7) + (rxt(228) + & + rxt(229) +rxt(230))* y(24) + 2._r8*rxt(231)* y(31) +rxt(275)* y(60) & + +rxt(224)* y(87) +rxt(225)* y(88) + rxt(32) + het_rates(31))* y(31) + prod(75) = (rxt(234)*y(33) +rxt(235)*y(34))*y(2) +rxt(220)*y(86)*y(1) & + +rxt(36)*y(34) + loss(55) = (rxt(233)* y(2) +rxt(232)* y(87) +rxt(148)* y(134) + rxt(34) & + + het_rates(32))* y(32) + prod(55) = (rxt(221)*y(88) +rxt(222)*y(15))*y(86) + loss(52) = (rxt(234)* y(2) + (rxt(287) +rxt(298))* y(27) + rxt(33) & + + het_rates(33))* y(33) + prod(52) = (rxt(284) +rxt(292) +rxt(295))*y(34) +rxt(225)*y(88)*y(31) + loss(41) = (rxt(235)* y(2) + rxt(35) + rxt(36) + rxt(284) + rxt(292) & + + rxt(295) + het_rates(34))* y(34) + prod(41) =rxt(227)*y(31)*y(7) + loss(45) = ((rxt(301) +rxt(302))* y(2) +rxt(309)* y(3) +rxt(313)* y(130) & + + het_rates(89))* y(89) + prod(45) = 0._r8 + loss(110) = (rxt(332)* y(3) +rxt(304)* y(5) +rxt(305)* y(6) +rxt(569)* y(107) & + +rxt(565)* y(111) +rxt(570)* y(112) +rxt(579)* y(113) +rxt(567) & + * y(114) +rxt(574)* y(115) +rxt(572)* y(116) +rxt(575)* y(117) & + +rxt(571)* y(118) +rxt(578)* y(119) +rxt(564)* y(120) +rxt(576) & + * y(121) +rxt(568)* y(122) +rxt(573)* y(123) +rxt(577)* y(125) & + +rxt(566)* y(126) +rxt(312)* y(130) +rxt(333)* y(135) + rxt(310) & + + het_rates(90))* y(90) + prod(110) = (rxt(71) +rxt(83) +rxt(299)*y(128) +rxt(306)*y(127) + & + rxt(309)*y(89))*y(3) + (rxt(335)*y(133) +rxt(336)*y(2))*y(91) & + +rxt(303)*y(128)*y(57) +2.000_r8*rxt(569)*y(107)*y(90) +rxt(93) & + *y(92) + loss(38) = (rxt(308)* y(2) + (rxt(306) +rxt(307))* y(3) + het_rates(127)) & + * y(127) + prod(38) =rxt(70)*y(5) + loss(57) = (rxt(299)* y(3) +rxt(303)* y(57) + rxt(300) + het_rates(128)) & + * y(128) + prod(57) = (rxt(67) +rxt(68) +rxt(69) +rxt(80) +rxt(81) +rxt(82) + & + rxt(302)*y(89) +rxt(308)*y(127))*y(2) + (rxt(73) +rxt(74) +rxt(75) + & + rxt(85) +rxt(86) +rxt(87))*y(3) + loss(113) = (rxt(360)* y(57) +rxt(553)* y(107) +rxt(549)* y(111) +rxt(554) & + * y(112) +rxt(563)* y(113) +rxt(551)* y(114) +rxt(558)* y(115) & + +rxt(556)* y(116) +rxt(559)* y(117) +rxt(555)* y(118) +rxt(562) & + * y(119) +rxt(548)* y(120) +rxt(560)* y(121) +rxt(552)* y(122) & + +rxt(557)* y(123) +rxt(561)* y(125) +rxt(550)* y(126) +rxt(311) & + * y(130) +rxt(352)* y(135) + rxt(362) + het_rates(129))* y(129) + prod(113) = (rxt(310) +rxt(304)*y(5) +rxt(305)*y(6))*y(90) +rxt(301)*y(89) & + *y(2) +rxt(307)*y(127)*y(3) +rxt(7)*y(6) +rxt(361)*y(104) +rxt(363) & + *y(105) +rxt(300)*y(128) + loss(40) = (rxt(169)* y(2) +rxt(168)* y(3) + het_rates(131))* y(131) + prod(40) = (rxt(301)*y(2) +.900_r8*rxt(313)*y(130))*y(89) & + +.800_r8*rxt(311)*y(130)*y(129) + loss(65) = (rxt(336)* y(2) +rxt(317)* y(130) +rxt(335)* y(133) +rxt(334) & + * y(135) + het_rates(91))* y(91) + prod(65) =rxt(332)*y(90)*y(3) + loss(49) = (rxt(322)* y(130) + (rxt(337) +rxt(338))* y(135) + rxt(93) & + + het_rates(92))* y(92) + prod(49) = (rxt(333)*y(90) +rxt(334)*y(91))*y(135) + loss(54) = (rxt(324)* y(130) +rxt(340)* y(135) + het_rates(93))* y(93) + prod(54) = (rxt(354)*y(88) +rxt(355)*y(87) +rxt(356)*y(18))*y(101) & + +rxt(338)*y(135)*y(92) +rxt(341)*y(94) + loss(44) = (rxt(325)* y(130) +rxt(342)* y(135) + rxt(341) + het_rates(94)) & + * y(94) + prod(44) = (rxt(339)*y(98) +rxt(340)*y(93))*y(135) +rxt(343)*y(95) + loss(101) = (rxt(505)* y(107) +rxt(501)* y(111) +rxt(506)* y(112) +rxt(515) & + * y(113) +rxt(503)* y(114) +rxt(510)* y(115) +rxt(508)* y(116) & + +rxt(511)* y(117) +rxt(507)* y(118) +rxt(514)* y(119) +rxt(500) & + * y(120) +rxt(512)* y(121) +rxt(504)* y(122) +rxt(509)* y(123) & + +rxt(513)* y(125) +rxt(502)* y(126) +rxt(326)* y(130) +rxt(344) & + * y(135) + rxt(343) + het_rates(95))* y(95) + prod(101) = (rxt(342)*y(94) +rxt(358)*y(103))*y(135) +rxt(345)*y(96) + loss(108) = (rxt(348)* y(11) +rxt(473)* y(107) + (rxt(469) +rxt(580))* y(111) & + +rxt(474)* y(112) +rxt(483)* y(113) + (rxt(471) +rxt(581))* y(114) & + + (rxt(478) +rxt(590))* y(115) + (rxt(476) +rxt(588))* y(116) & + +rxt(479)* y(117) + (rxt(475) +rxt(592))* y(118) +rxt(482)* y(119) & + + (rxt(468) +rxt(586))* y(120) +rxt(480)* y(121) +rxt(472)* y(122) & + +rxt(477)* y(123) +rxt(481)* y(125) + (rxt(470) +rxt(584))* y(126) & + +rxt(327)* y(130) +rxt(346)* y(135) + rxt(345) + het_rates(96)) & + * y(96) + prod(108) = (rxt(344)*y(95) +rxt(350)*y(99))*y(135) +rxt(347)*y(97) + loss(103) = (rxt(349)* y(11) +rxt(489)* y(107) + (rxt(485) +rxt(582))* y(111) & + +rxt(490)* y(112) +rxt(499)* y(113) + (rxt(487) +rxt(583))* y(114) & + + (rxt(494) +rxt(591))* y(115) + (rxt(492) +rxt(589))* y(116) & + +rxt(495)* y(117) + (rxt(491) +rxt(593))* y(118) +rxt(498)* y(119) & + + (rxt(484) +rxt(587))* y(120) +rxt(496)* y(121) +rxt(488)* y(122) & + +rxt(493)* y(123) +rxt(497)* y(125) + (rxt(486) +rxt(585))* y(126) & + +rxt(328)* y(130) + rxt(347) + het_rates(97))* y(97) + prod(103) = (rxt(346)*y(96) +rxt(351)*y(100))*y(135) + loss(35) = (rxt(323)* y(130) +rxt(339)* y(135) + het_rates(98))* y(98) + prod(35) =rxt(337)*y(135)*y(92) + loss(28) = (rxt(350)* y(135) + het_rates(99))* y(99) + prod(28) =rxt(348)*y(96)*y(11) + loss(29) = (rxt(351)* y(135) + het_rates(100))* y(100) + prod(29) =rxt(349)*y(97)*y(11) + loss(98) = (rxt(356)* y(18) +rxt(355)* y(87) +rxt(354)* y(88) +rxt(521) & + * y(107) +rxt(517)* y(111) +rxt(522)* y(112) +rxt(531)* y(113) & + +rxt(519)* y(114) +rxt(526)* y(115) +rxt(524)* y(116) +rxt(527) & + * y(117) +rxt(523)* y(118) +rxt(530)* y(119) +rxt(516)* y(120) & + +rxt(528)* y(121) +rxt(520)* y(122) +rxt(525)* y(123) +rxt(529) & + * y(125) +rxt(518)* y(126) +rxt(319)* y(130) +rxt(353)* y(135) & + + het_rates(101))* y(101) + prod(98) = (rxt(331)*y(105) +rxt(352)*y(129) +rxt(359)*y(104))*y(135) + loss(90) = (rxt(537)* y(107) +rxt(533)* y(111) +rxt(538)* y(112) +rxt(547) & + * y(113) +rxt(535)* y(114) +rxt(542)* y(115) +rxt(540)* y(116) & + +rxt(543)* y(117) +rxt(539)* y(118) +rxt(546)* y(119) +rxt(532) & + * y(120) +rxt(544)* y(121) +rxt(536)* y(122) +rxt(541)* y(123) & + +rxt(545)* y(125) +rxt(534)* y(126) +rxt(320)* y(130) +rxt(357) & + * y(135) + het_rates(102))* y(102) + prod(90) =rxt(353)*y(135)*y(101) + loss(36) = (rxt(321)* y(130) +rxt(358)* y(135) + het_rates(103))* y(103) + prod(36) =rxt(357)*y(135)*y(102) + loss(47) = (rxt(318)* y(130) +rxt(359)* y(135) + rxt(361) + het_rates(104)) & + * y(104) + prod(47) = (rxt(330)*y(105) +rxt(360)*y(129))*y(57) + loss(46) = (rxt(330)* y(57) +rxt(329)* y(130) +rxt(331)* y(135) + rxt(363) & + + het_rates(105))* y(105) + prod(46) =rxt(362)*y(129) + loss(99) = (rxt(377)* y(1) +rxt(364)* y(2) +rxt(378)* y(3) +rxt(365)* y(6) & + +rxt(380)* y(7) +rxt(383)* y(9) + (rxt(368) +rxt(382))* y(17) & + +rxt(386)* y(24) +rxt(384)* y(27) +rxt(381)* y(57) +rxt(385)* y(85) & + +rxt(366)* y(133) +rxt(379)* y(135) + rxt(94) + rxt(367) & + + het_rates(106))* y(106) + prod(99) =rxt(315)*y(130)*y(1) +rxt(387)*y(107)*y(2) +rxt(100)*y(108) & + +rxt(102)*y(111) + loss(111) = (rxt(388)* y(1) + (rxt(369) +rxt(387))* y(2) +rxt(391)* y(3) & + +rxt(390)* y(7) +rxt(392)* y(9) +rxt(372)* y(18) +rxt(394)* y(24) & + +rxt(393)* y(27) +rxt(389)* y(57) +rxt(395)* y(85) +rxt(569)* y(90) & + +rxt(505)* y(95) +rxt(473)* y(96) +rxt(489)* y(97) +rxt(521)* y(101) & + +rxt(537)* y(102) +rxt(553)* y(129) +rxt(370)* y(133) + rxt(95) & + + rxt(371) + het_rates(107))* y(107) + prod(111) = (rxt(396)*y(108) +rxt(411)*y(111))*y(2) + (rxt(314)*y(130) + & + rxt(316)*y(130))*y(3) +rxt(101)*y(109) +rxt(103)*y(112) + loss(74) = (rxt(374)* y(1) + (rxt(373) +rxt(396))* y(2) + (rxt(399) + & + rxt(402))* y(6) + (rxt(400) +rxt(401))* y(7) +rxt(397)* y(18) & + +rxt(398)* y(57) + rxt(96) + rxt(100) + het_rates(108))* y(108) + prod(74) = (rxt(377)*y(106) +rxt(388)*y(107) +rxt(405)*y(110) + & + rxt(420)*y(112))*y(1) + (rxt(378)*y(106) +rxt(412)*y(111))*y(3) & + +rxt(403)*y(109)*y(2) + loss(42) = (rxt(403)* y(2) +rxt(404)* y(57) + rxt(101) + het_rates(109)) & + * y(109) + prod(42) =rxt(391)*y(107)*y(3) + loss(89) = (rxt(411)* y(2) +rxt(412)* y(3) +rxt(414)* y(6) +rxt(415)* y(7) & + +rxt(416)* y(9) +rxt(413)* y(18) +rxt(419)* y(24) + (rxt(417) + & + rxt(418))* y(85) +rxt(565)* y(90) +rxt(501)* y(95) + (rxt(469) + & + rxt(580))* y(96) + (rxt(485) +rxt(582))* y(97) +rxt(517)* y(101) & + +rxt(533)* y(102) +rxt(549)* y(129) +rxt(447)* y(135) + rxt(102) & + + het_rates(111))* y(111) + prod(89) = (rxt(381)*y(106) +rxt(398)*y(108))*y(57) + (rxt(421)*y(18) + & + rxt(422)*y(2))*y(112) + (rxt(104) +rxt(452))*y(115) + loss(84) = (rxt(420)* y(1) +rxt(422)* y(2) +rxt(421)* y(18) +rxt(425)* y(24) & + +rxt(423)* y(27) +rxt(424)* y(85) +rxt(570)* y(90) +rxt(506)* y(95) & + +rxt(474)* y(96) +rxt(490)* y(97) +rxt(522)* y(101) +rxt(538) & + * y(102) +rxt(554)* y(129) + rxt(103) + het_rates(112))* y(112) + prod(84) = (rxt(389)*y(107) +rxt(404)*y(109))*y(57) + loss(87) = (rxt(428)* y(1) +rxt(427)* y(7) +rxt(429)* y(9) +rxt(426)* y(18) & + +rxt(432)* y(24) +rxt(430)* y(27) +rxt(431)* y(85) +rxt(579)* y(90) & + +rxt(515)* y(95) +rxt(483)* y(96) +rxt(499)* y(97) +rxt(531)* y(101) & + +rxt(547)* y(102) +rxt(563)* y(129) +rxt(458)* y(135) + rxt(98) & + + het_rates(113))* y(113) + prod(87) = (rxt(380)*y(106) +rxt(390)*y(107) +rxt(401)*y(108) + & + rxt(406)*y(110) +rxt(437)*y(123))*y(7) + (rxt(402)*y(108) + & + rxt(414)*y(111) +rxt(441)*y(124) +rxt(450)*y(115))*y(6) & + + (rxt(433)*y(2) +rxt(434)*y(1))*y(114) +rxt(457)*y(117) + loss(85) = (rxt(434)* y(1) +rxt(433)* y(2) +rxt(463)* y(9) + (rxt(435) + & + rxt(465))* y(27) +rxt(567)* y(90) +rxt(503)* y(95) + (rxt(471) + & + rxt(581))* y(96) + (rxt(487) +rxt(583))* y(97) +rxt(519)* y(101) & + +rxt(535)* y(102) +rxt(551)* y(129) +rxt(448)* y(135) + rxt(99) & + + het_rates(114))* y(114) + prod(85) = (rxt(383)*y(106) +rxt(392)*y(107) +rxt(416)*y(111) + & + rxt(429)*y(113) +rxt(438)*y(123))*y(9) + (rxt(400)*y(108) + & + rxt(415)*y(111) +rxt(427)*y(113) +rxt(451)*y(115))*y(7) & + +rxt(428)*y(113)*y(1) +rxt(399)*y(108)*y(6) +rxt(449)*y(118) & + +rxt(462)*y(120) + loss(92) = (rxt(405)* y(1) +rxt(375)* y(2) +rxt(406)* y(7) +rxt(376)* y(18) & + +rxt(410)* y(24) +rxt(408)* y(27) +rxt(407)* y(57) +rxt(409)* y(85) & + + rxt(97) + het_rates(110))* y(110) + prod(92) = (rxt(397)*y(108) +rxt(413)*y(111) +rxt(426)*y(113))*y(18) & + + (rxt(379)*y(135) +rxt(382)*y(17))*y(106) + loss(66) = (rxt(568)* y(90) +rxt(504)* y(95) +rxt(472)* y(96) +rxt(488) & + * y(97) +rxt(520)* y(101) +rxt(536)* y(102) +rxt(552)* y(129) & + + het_rates(122))* y(122) + prod(66) =rxt(407)*y(110)*y(57) + loss(78) = ((rxt(450) +rxt(456))* y(6) + (rxt(451) +rxt(453))* y(7) +rxt(574) & + * y(90) +rxt(510)* y(95) + (rxt(478) +rxt(590))* y(96) + (rxt(494) + & + rxt(591))* y(97) +rxt(526)* y(101) +rxt(542)* y(102) +rxt(558) & + * y(129) +rxt(454)* y(135) + rxt(104) + rxt(452) + het_rates(115)) & + * y(115) + prod(78) =rxt(447)*y(135)*y(111) +rxt(455)*y(116) + loss(68) = (rxt(572)* y(90) +rxt(508)* y(95) + (rxt(476) +rxt(588))* y(96) & + + (rxt(492) +rxt(589))* y(97) +rxt(524)* y(101) +rxt(540)* y(102) & + +rxt(556)* y(129) + rxt(455) + het_rates(116))* y(116) + prod(68) =rxt(454)*y(135)*y(115) + loss(71) = (rxt(575)* y(90) +rxt(511)* y(95) +rxt(479)* y(96) +rxt(495) & + * y(97) +rxt(527)* y(101) +rxt(543)* y(102) +rxt(559)* y(129) & + + rxt(457) + het_rates(117))* y(117) + prod(71) =rxt(456)*y(115)*y(6) +rxt(458)*y(135)*y(113) + loss(79) = (rxt(467)* y(9) +rxt(466)* y(11) +rxt(571)* y(90) +rxt(507)* y(95) & + + (rxt(475) +rxt(592))* y(96) + (rxt(491) +rxt(593))* y(97) & + +rxt(523)* y(101) +rxt(539)* y(102) +rxt(555)* y(129) +rxt(459) & + * y(135) + rxt(449) + het_rates(118))* y(118) + prod(79) =rxt(453)*y(115)*y(7) +rxt(448)*y(135)*y(114) +rxt(460)*y(119) + loss(77) = (rxt(461)* y(11) +rxt(578)* y(90) +rxt(514)* y(95) +rxt(482) & + * y(96) +rxt(498)* y(97) +rxt(530)* y(101) +rxt(546)* y(102) & + +rxt(562)* y(129) + rxt(460) + het_rates(119))* y(119) + prod(77) =rxt(459)*y(135)*y(118) + loss(76) = (rxt(564)* y(90) +rxt(500)* y(95) + (rxt(468) +rxt(586))* y(96) & + + (rxt(484) +rxt(587))* y(97) +rxt(516)* y(101) +rxt(532)* y(102) & + +rxt(548)* y(129) + rxt(462) + het_rates(120))* y(120) + prod(76) = (rxt(463)*y(114) +rxt(464)*y(121) +rxt(467)*y(118))*y(9) & + + (rxt(461)*y(119) +rxt(466)*y(118))*y(11) + loss(72) = (rxt(464)* y(9) +rxt(576)* y(90) +rxt(512)* y(95) +rxt(480)* y(96) & + +rxt(496)* y(97) +rxt(528)* y(101) +rxt(544)* y(102) +rxt(560) & + * y(129) + het_rates(121))* y(121) + prod(72) =rxt(465)*y(114)*y(27) + loss(83) = (rxt(437)* y(7) +rxt(438)* y(9) +rxt(436)* y(18) +rxt(440)* y(27) & + +rxt(573)* y(90) +rxt(509)* y(95) +rxt(477)* y(96) +rxt(493)* y(97) & + +rxt(525)* y(101) +rxt(541)* y(102) +rxt(557)* y(129) +rxt(439) & + * y(135) + het_rates(123))* y(123) + prod(83) = (rxt(384)*y(106) +rxt(393)*y(107) +rxt(408)*y(110) + & + rxt(423)*y(112) +rxt(430)*y(113) +rxt(435)*y(114))*y(27) & + + (rxt(385)*y(106) +rxt(395)*y(107) +rxt(409)*y(110) + & + rxt(417)*y(111) +rxt(424)*y(112) +rxt(431)*y(113))*y(85) & + + (rxt(386)*y(106) +rxt(419)*y(111) +rxt(432)*y(113))*y(24) & + + (rxt(442)*y(6) +rxt(443)*y(2))*y(124) +rxt(445)*y(125) +rxt(446) & + *y(126) + loss(60) = (rxt(443)* y(2) + (rxt(441) +rxt(442))* y(6) + het_rates(124)) & + * y(124) + prod(60) = (rxt(394)*y(107) +rxt(410)*y(110) +rxt(425)*y(112))*y(24) & + +rxt(418)*y(111)*y(85) + loss(70) = (rxt(444)* y(27) +rxt(577)* y(90) +rxt(513)* y(95) +rxt(481) & + * y(96) +rxt(497)* y(97) +rxt(529)* y(101) +rxt(545)* y(102) & + +rxt(561)* y(129) + rxt(445) + het_rates(125))* y(125) + prod(70) =rxt(439)*y(135)*y(123) + loss(69) = (rxt(566)* y(90) +rxt(502)* y(95) + (rxt(470) +rxt(584))* y(96) & + + (rxt(486) +rxt(585))* y(97) +rxt(518)* y(101) +rxt(534)* y(102) & + +rxt(550)* y(129) + rxt(446) + het_rates(126))* y(126) + prod(69) = (rxt(440)*y(123) +rxt(444)*y(125))*y(27) + loss(96) = (rxt(315)* y(1) + (rxt(314) +rxt(316))* y(3) +rxt(313)* y(89) & + +rxt(312)* y(90) +rxt(317)* y(91) +rxt(322)* y(92) +rxt(324)* y(93) & + +rxt(325)* y(94) +rxt(326)* y(95) +rxt(327)* y(96) +rxt(328)* y(97) & + +rxt(323)* y(98) +rxt(319)* y(101) +rxt(320)* y(102) +rxt(321) & + * y(103) +rxt(318)* y(104) +rxt(329)* y(105) +rxt(311)* y(129) & + + het_rates(130))* y(130) + prod(96) = (rxt(67) +rxt(68) +rxt(69) +rxt(80) +rxt(81) +rxt(82) + & + rxt(364)*y(106) +rxt(369)*y(107) +rxt(373)*y(108) +rxt(375)*y(110)) & + *y(2) + (rxt(71) +rxt(73) +rxt(74) +rxt(75) +rxt(83) +rxt(85) + & + rxt(86) +rxt(87))*y(3) + (rxt(94) +rxt(367) +rxt(365)*y(6) + & + rxt(366)*y(133) +rxt(368)*y(17))*y(106) + (rxt(95) +rxt(371) + & + rxt(370)*y(133) +rxt(372)*y(18))*y(107) + (rxt(376)*y(110) + & + rxt(436)*y(123))*y(18) + (rxt(96) +rxt(374)*y(1))*y(108) +rxt(70) & + *y(5) +rxt(7)*y(6) +rxt(97)*y(110) +rxt(98)*y(113) +rxt(99)*y(114) + loss(22) = (rxt(141)* y(134) + rxt(55) + het_rates(53))* y(53) + prod(22) = (rxt(126)*y(38) +rxt(127)*y(39) +2.000_r8*rxt(128)*y(47) + & + 2.000_r8*rxt(129)*y(48) +rxt(130)*y(40) +rxt(132)*y(46) + & + rxt(135)*y(44) +rxt(136)*y(43) +rxt(137)*y(49) + & + 2.000_r8*rxt(138)*y(50))*y(134) + (rxt(243)*y(40) +rxt(247)*y(46)) & + *y(87) + loss(25) = (rxt(142)* y(134) + rxt(56) + het_rates(54))* y(54) + prod(25) = (rxt(125)*y(37) +rxt(127)*y(39) +rxt(131)*y(45))*y(134) & + +rxt(246)*y(87)*y(45) + loss(27) = ( + rxt(57) + het_rates(55))* y(55) + prod(27) = (rxt(238)*y(12) +rxt(236)*y(135) +rxt(237)*y(17) +rxt(239)*y(9)) & + *y(56) + loss(53) = (rxt(239)* y(9) +rxt(238)* y(12) +rxt(237)* y(17) +rxt(236) & + * y(135) + het_rates(56))* y(56) + prod(53) = (rxt(129)*y(48) +rxt(136)*y(43) +2.000_r8*rxt(141)*y(53) + & + rxt(142)*y(54))*y(134) +2.000_r8*rxt(55)*y(53) +rxt(56)*y(54) & + +rxt(57)*y(55) + loss(34) = (rxt(265)* y(2) +rxt(266)* y(87) + rxt(64) + het_rates(58))* y(58) + prod(34) = 0._r8 + loss(48) = (rxt(269)* y(1) +rxt(268)* y(3) +rxt(267)* y(87) + het_rates(59)) & + * y(59) + prod(48) =rxt(64)*y(58) +rxt(65)*y(60) + loss(67) = (rxt(272)* y(1) +rxt(271)* y(3) +rxt(273)* y(7) +rxt(274)* y(24) & + +rxt(276)* y(25) +rxt(275)* y(31) +rxt(270)* y(87) + rxt(65) & + + het_rates(60))* y(60) + prod(67) = (rxt(267)*y(87) +rxt(268)*y(3) +rxt(269)*y(1))*y(59) & + +rxt(265)*y(58)*y(2) +rxt(62)*y(61) + loss(58) = (rxt(277)* y(87) + rxt(62) + het_rates(61))* y(61) + prod(58) = (rxt(270)*y(87) +rxt(271)*y(3) +rxt(272)*y(1) +rxt(273)*y(7) + & + rxt(274)*y(24) +rxt(275)*y(31) +rxt(276)*y(25))*y(60) & + + (.500_r8*rxt(279)*y(87) +rxt(280)*y(87) +rxt(281)*y(8))*y(64) & + +rxt(266)*y(87)*y(58) +rxt(63)*y(62) + loss(30) = (rxt(278)* y(135) + rxt(63) + het_rates(62))* y(62) + prod(30) =rxt(277)*y(87)*y(61) +rxt(61)*y(63) + loss(23) = ( + rxt(61) + het_rates(63))* y(63) + prod(23) =rxt(278)*y(135)*y(62) + loss(31) = (rxt(281)* y(8) + (rxt(279) +rxt(280))* y(87) + het_rates(64)) & + * y(64) + prod(31) = 0._r8 + loss(1) = ( + het_rates(65))* y(65) + prod(1) = 0._r8 + loss(2) = ( + het_rates(66))* y(66) + prod(2) = 0._r8 + loss(3) = ( + het_rates(67))* y(67) + prod(3) = 0._r8 + loss(4) = ( + het_rates(68))* y(68) + prod(4) = 0._r8 + loss(5) = ( + het_rates(69))* y(69) + prod(5) = 0._r8 + loss(6) = ( + het_rates(70))* y(70) + prod(6) = 0._r8 + loss(7) = ( + het_rates(71))* y(71) + prod(7) = 0._r8 + loss(8) = ( + het_rates(72))* y(72) + prod(8) = 0._r8 + loss(9) = ( + het_rates(73))* y(73) + prod(9) = 0._r8 + loss(10) = ( + het_rates(74))* y(74) + prod(10) = 0._r8 + loss(11) = ( + het_rates(75))* y(75) + prod(11) = 0._r8 + loss(12) = ( + het_rates(76))* y(76) + prod(12) = 0._r8 + loss(13) = ( + het_rates(77))* y(77) + prod(13) = 0._r8 + loss(14) = ( + het_rates(78))* y(78) + prod(14) = 0._r8 + loss(15) = ( + het_rates(79))* y(79) + prod(15) = 0._r8 + loss(16) = ( + het_rates(80))* y(80) + prod(16) = 0._r8 + loss(17) = ( + het_rates(81))* y(81) + prod(17) = 0._r8 + loss(18) = ( + het_rates(82))* y(82) + prod(18) = 0._r8 + loss(19) = ( + het_rates(83))* y(83) + prod(19) = 0._r8 + loss(20) = ( + het_rates(84))* y(84) + prod(20) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..8eb0ed6c0e --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,605 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 6) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 6) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 7) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 10) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 10) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 14) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 135) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 135) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 135) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 19) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 25) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 28) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 27) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 30) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 31) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 33) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 32) ! rate_const*HBR + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 34) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 34) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 35) ! rate_const*CH3CL + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 41) ! rate_const*CCL4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 42) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 37) ! rate_const*CFC11 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 38) ! rate_const*CFC12 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 39) ! rate_const*CFC113 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 47) ! rate_const*CFC114 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 48) ! rate_const*CFC115 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 40) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 45) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 46) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 36) ! rate_const*CH3BR + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 43) ! rate_const*CF3BR + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 44) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 51) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 52) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*H1202 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 50) ! rate_const*H2402 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 53) ! rate_const*COF2 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*COFCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 55) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 57) ! rate_const*CO2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 12) ! rate_const*CH4 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 12) ! rate_const*CH4 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 63) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 61) ! rate_const*SO2 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 62) ! rate_const*SO3 + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 58) ! rate_const*OCS + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 60) ! rate_const*SO + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 20) ! rate_const*HONO + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 5) ! rate_const*N + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 3) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 3) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 57) ! rate_const*CO2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 92) ! rate_const*O2p_H2O + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 106) ! rate_const*Om + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 107) ! rate_const*O2m + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 108) ! rate_const*O3m + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 110) ! rate_const*OHm + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 113) ! rate_const*NO2m + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 114) ! rate_const*NO3m + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 108) ! rate_const*O3m + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 109) ! rate_const*O4m + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 111) ! rate_const*CO3m + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 112) ! rate_const*CO4m + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 115) ! rate_const*CO3m_H2O + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 2)*sol(:ncol,:, 3) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 132)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 132)*sol(:ncol,:, 3) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 132) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 132)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 132)*sol(:ncol,:, 57) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 132) ! rate_const*O2_1S + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 133)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 133)*sol(:ncol,:, 3) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 133) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 133) ! rate_const*O2_1D + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 134) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 134)*sol(:ncol,:, 3) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 134)*sol(:ncol,:, 3) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 134)*sol(:ncol,:, 135) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 134)*sol(:ncol,:, 4) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 134)*sol(:ncol,:, 4) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 134)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 134)*sol(:ncol,:, 37) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 134)*sol(:ncol,:, 38) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 134)*sol(:ncol,:, 39) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 134)*sol(:ncol,:, 47) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 134)*sol(:ncol,:, 48) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 134)*sol(:ncol,:, 40) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 134)*sol(:ncol,:, 45) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 134)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 134)*sol(:ncol,:, 41) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 134)*sol(:ncol,:, 36) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 134)*sol(:ncol,:, 44) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 134)*sol(:ncol,:, 43) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 134)*sol(:ncol,:, 49) ! rate_const*O1D*H1202 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 134)*sol(:ncol,:, 50) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 134)*sol(:ncol,:, 51) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 134)*sol(:ncol,:, 52) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 134)*sol(:ncol,:, 53) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 134)*sol(:ncol,:, 54) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 134)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 134)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 134)*sol(:ncol,:, 12) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 134)*sol(:ncol,:, 17) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 134)*sol(:ncol,:, 27) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 134)*sol(:ncol,:, 32) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 18)*sol(:ncol,:, 3) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 18)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 18)*sol(:ncol,:, 88) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 18)*sol(:ncol,:, 88) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 18)*sol(:ncol,:, 88) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 87)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 87)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 87)*sol(:ncol,:, 88) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 87)*sol(:ncol,:, 87) ! rate_const*OH*OH + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 87)*sol(:ncol,:, 87) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 87)*sol(:ncol,:, 17) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 87)*sol(:ncol,:, 19) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 17)*sol(:ncol,:, 2) ! rate_const*H2*O + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 88)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 88)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 88)*sol(:ncol,:, 88) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 19)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 18)*sol(:ncol,:, 6) ! rate_const*M*H*NO + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 87)*sol(:ncol,:, 20) ! rate_const*OH*HONO + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 131)*sol(:ncol,:, 3) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 131)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 5)*sol(:ncol,:, 87) ! rate_const*N*OH + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 5)*sol(:ncol,:, 3) ! rate_const*N*O2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 5)*sol(:ncol,:, 6) ! rate_const*N*NO + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 6)*sol(:ncol,:, 88) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 6)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 7)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 7)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 7)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 7)*sol(:ncol,:, 8) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 11) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 7)*sol(:ncol,:, 87) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 9)*sol(:ncol,:, 87) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 8)*sol(:ncol,:, 6) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 8)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 8)*sol(:ncol,:, 87) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 8)*sol(:ncol,:, 88) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 7)*sol(:ncol,:, 88) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 10)*sol(:ncol,:, 87) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 10) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 85)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 85)*sol(:ncol,:, 17) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 85)*sol(:ncol,:, 19) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 85)*sol(:ncol,:, 88) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 85)*sol(:ncol,:, 88) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 85)*sol(:ncol,:, 15) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 85)*sol(:ncol,:, 12) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 24)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 24)*sol(:ncol,:, 87) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 24)*sol(:ncol,:, 87) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 24)*sol(:ncol,:, 88) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 24)*sol(:ncol,:, 13) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 24)*sol(:ncol,:, 6) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 24)*sol(:ncol,:, 7) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 26) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 27)*sol(:ncol,:, 87) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 27)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 28)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 28)*sol(:ncol,:, 85) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 28)*sol(:ncol,:, 87) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 29)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 29)*sol(:ncol,:, 87) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 29)*sol(:ncol,:, 85) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 86)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 86)*sol(:ncol,:, 88) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 86)*sol(:ncol,:, 15) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 31)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 31)*sol(:ncol,:, 87) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 31)*sol(:ncol,:, 88) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 31)*sol(:ncol,:, 6) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 31)*sol(:ncol,:, 7) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 31)*sol(:ncol,:, 24) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 31)*sol(:ncol,:, 24) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 31)*sol(:ncol,:, 24) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 31)*sol(:ncol,:, 31) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 32)*sol(:ncol,:, 87) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 32)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 34)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 56)*sol(:ncol,:, 135) ! rate_const*F*H2O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 56)*sol(:ncol,:, 17) ! rate_const*F*H2 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 56)*sol(:ncol,:, 12) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 56)*sol(:ncol,:, 9) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 35)*sol(:ncol,:, 85) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 35)*sol(:ncol,:, 87) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 42)*sol(:ncol,:, 87) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 40)*sol(:ncol,:, 87) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 36)*sol(:ncol,:, 87) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 36)*sol(:ncol,:, 85) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 45)*sol(:ncol,:, 87) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 46)*sol(:ncol,:, 87) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 52)*sol(:ncol,:, 87) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 51)*sol(:ncol,:, 87) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 52)*sol(:ncol,:, 85) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 51)*sol(:ncol,:, 85) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 12)*sol(:ncol,:, 87) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 16)*sol(:ncol,:, 87) ! rate_const*CO*OH + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 16)*sol(:ncol,:, 87) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 15)*sol(:ncol,:, 8) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 15)*sol(:ncol,:, 87) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 15)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 13)*sol(:ncol,:, 6) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 13)*sol(:ncol,:, 88) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 14)*sol(:ncol,:, 87) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 8) ! rate_const*NO3 + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 7) ! rate_const*NO2 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 88) ! rate_const*HO2 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 58)*sol(:ncol,:, 2) ! rate_const*OCS*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 58)*sol(:ncol,:, 87) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 59)*sol(:ncol,:, 87) ! rate_const*S*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 59)*sol(:ncol,:, 3) ! rate_const*S*O2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 59)*sol(:ncol,:, 1) ! rate_const*S*O3 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 60)*sol(:ncol,:, 87) ! rate_const*SO*OH + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 60)*sol(:ncol,:, 3) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 60)*sol(:ncol,:, 1) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 60)*sol(:ncol,:, 7) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 60)*sol(:ncol,:, 24) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 60)*sol(:ncol,:, 31) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 60)*sol(:ncol,:, 25) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 62)*sol(:ncol,:, 135) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 64)*sol(:ncol,:, 87) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 64)*sol(:ncol,:, 87) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 64)*sol(:ncol,:, 8) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 34) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 28)*sol(:ncol,:, 27) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 33)*sol(:ncol,:, 27) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 28)*sol(:ncol,:, 27) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 34) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 11) ! rate_const*N2O5 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 34) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 28)*sol(:ncol,:, 27) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 33)*sol(:ncol,:, 27) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 128)*sol(:ncol,:, 3) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 128) ! rate_const*N2*Op + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 89)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 89)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 128)*sol(:ncol,:, 57) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 90)*sol(:ncol,:, 5) ! rate_const*O2p*N + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 90)*sol(:ncol,:, 6) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 127)*sol(:ncol,:, 3) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 127)*sol(:ncol,:, 3) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 127)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 89)*sol(:ncol,:, 3) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 90) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 129)*sol(:ncol,:, 130) ! rate_const*NOp*e + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 90)*sol(:ncol,:, 130) ! rate_const*O2p*e + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 89)*sol(:ncol,:, 130) ! rate_const*N2p*e + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 3)*sol(:ncol,:, 130) ! rate_const*N2*O2*e + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 1)*sol(:ncol,:, 130) ! rate_const*O3*e + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 3)*sol(:ncol,:, 130) ! rate_const*M*O2*e + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 91)*sol(:ncol,:, 130) ! rate_const*O4p*e + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 104)*sol(:ncol,:, 130) ! rate_const*NOp_CO2*e + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 101)*sol(:ncol,:, 130) ! rate_const*NOp_H2O*e + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 102)*sol(:ncol,:, 130) ! rate_const*NOp_2H2O*e + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 103)*sol(:ncol,:, 130) ! rate_const*NOp_3H2O*e + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 92)*sol(:ncol,:, 130) ! rate_const*O2p_H2O*e + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 98)*sol(:ncol,:, 130) ! rate_const*H3Op_OH*e + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 93)*sol(:ncol,:, 130) ! rate_const*Hp_H2O*e + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 94)*sol(:ncol,:, 130) ! rate_const*Hp_2H2O*e + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 95)*sol(:ncol,:, 130) ! rate_const*Hp_3H2O*e + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 96)*sol(:ncol,:, 130) ! rate_const*Hp_4H2O*e + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 97)*sol(:ncol,:, 130) ! rate_const*Hp_5H2O*e + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 105)*sol(:ncol,:, 130) ! rate_const*NOp_N2*e + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 105)*sol(:ncol,:, 57) ! rate_const*NOp_N2*CO2 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 105)*sol(:ncol,:, 135) ! rate_const*NOp_N2*H2O + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 90)*sol(:ncol,:, 3) ! rate_const*M*O2p*O2 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 90)*sol(:ncol,:, 135) ! rate_const*M*O2p*H2O + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 91)*sol(:ncol,:, 135) ! rate_const*O4p*H2O + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*O4p*O2_1D + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 91)*sol(:ncol,:, 2) ! rate_const*O4p*O + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 92)*sol(:ncol,:, 135) ! rate_const*O2p_H2O*H2O + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 92)*sol(:ncol,:, 135) ! rate_const*O2p_H2O*H2O + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*H3Op_OH*H2O + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 93)*sol(:ncol,:, 135) ! rate_const*M*Hp_H2O*H2O + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 94) ! rate_const*M*Hp_2H2O + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 94)*sol(:ncol,:, 135) ! rate_const*M*Hp_2H2O*H2O + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 95) ! rate_const*M*Hp_3H2O + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 95)*sol(:ncol,:, 135) ! rate_const*M*Hp_3H2O*H2O + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 96) ! rate_const*M*Hp_4H2O + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 96)*sol(:ncol,:, 135) ! rate_const*M*Hp_4H2O*H2O + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 97) ! rate_const*M*Hp_5H2O + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 96)*sol(:ncol,:, 11) ! rate_const*Hp_4H2O*N2O5 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 97)*sol(:ncol,:, 11) ! rate_const*Hp_5H2O*N2O5 + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 99)*sol(:ncol,:, 135) ! rate_const*Hp_3N1*H2O + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 100)*sol(:ncol,:, 135) ! rate_const*Hp_4N1*H2O + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 129)*sol(:ncol,:, 135) ! rate_const*M*NOp*H2O + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 101)*sol(:ncol,:, 135) ! rate_const*M*NOp_H2O*H2O + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 101)*sol(:ncol,:, 88) ! rate_const*NOp_H2O*HO2 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 101)*sol(:ncol,:, 87) ! rate_const*NOp_H2O*OH + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 101)*sol(:ncol,:, 18) ! rate_const*NOp_H2O*H + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 102)*sol(:ncol,:, 135) ! rate_const*M*NOp_2H2O*H2O + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 103)*sol(:ncol,:, 135) ! rate_const*NOp_3H2O*H2O + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 104)*sol(:ncol,:, 135) ! rate_const*NOp_CO2*H2O + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 129)*sol(:ncol,:, 57) ! rate_const*M*NOp*CO2 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 104) ! rate_const*M*NOp_CO2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 129) ! rate_const*N2*M*NOp + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 105) ! rate_const*M*NOp_N2 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 106)*sol(:ncol,:, 2) ! rate_const*Om*O + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 106)*sol(:ncol,:, 6) ! rate_const*Om*NO + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 106)*sol(:ncol,:, 133) ! rate_const*Om*O2_1D + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 106) ! rate_const*M*Om + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 106)*sol(:ncol,:, 17) ! rate_const*Om*H2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 107)*sol(:ncol,:, 2) ! rate_const*O2m*O + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 107)*sol(:ncol,:, 133) ! rate_const*O2m*O2_1D + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 107) ! rate_const*N2*O2m + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 107)*sol(:ncol,:, 18) ! rate_const*O2m*H + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 108)*sol(:ncol,:, 2) ! rate_const*O3m*O + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 108)*sol(:ncol,:, 1) ! rate_const*O3m*O3 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 110)*sol(:ncol,:, 2) ! rate_const*OHm*O + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 110)*sol(:ncol,:, 18) ! rate_const*OHm*H + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 106)*sol(:ncol,:, 1) ! rate_const*Om*O3 + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 106)*sol(:ncol,:, 3) ! rate_const*M*Om*O2 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 106)*sol(:ncol,:, 135) ! rate_const*Om*H2O + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 106)*sol(:ncol,:, 7) ! rate_const*Om*NO2 + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 106)*sol(:ncol,:, 57) ! rate_const*M*Om*CO2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 106)*sol(:ncol,:, 17) ! rate_const*Om*H2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 106)*sol(:ncol,:, 9) ! rate_const*Om*HNO3 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 106)*sol(:ncol,:, 27) ! rate_const*Om*HCL + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 106)*sol(:ncol,:, 85) ! rate_const*Om*CL + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 106)*sol(:ncol,:, 24) ! rate_const*Om*CLO + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 107)*sol(:ncol,:, 2) ! rate_const*O2m*O + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 107)*sol(:ncol,:, 1) ! rate_const*O2m*O3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 107)*sol(:ncol,:, 57) ! rate_const*M*O2m*CO2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 107)*sol(:ncol,:, 7) ! rate_const*O2m*NO2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 107)*sol(:ncol,:, 3) ! rate_const*M*O2m*O2 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 107)*sol(:ncol,:, 9) ! rate_const*O2m*HNO3 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 107)*sol(:ncol,:, 27) ! rate_const*O2m*HCL + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 107)*sol(:ncol,:, 24) ! rate_const*O2m*CLO + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 107)*sol(:ncol,:, 85) ! rate_const*O2m*CL + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 108)*sol(:ncol,:, 2) ! rate_const*O3m*O + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 108)*sol(:ncol,:, 18) ! rate_const*O3m*H + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 108)*sol(:ncol,:, 57) ! rate_const*O3m*CO2 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 108)*sol(:ncol,:, 6) ! rate_const*O3m*NO + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 108)*sol(:ncol,:, 7) ! rate_const*O3m*NO2 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 108)*sol(:ncol,:, 7) ! rate_const*O3m*NO2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 108)*sol(:ncol,:, 6) ! rate_const*O3m*NO + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 109)*sol(:ncol,:, 2) ! rate_const*O4m*O + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 109)*sol(:ncol,:, 57) ! rate_const*O4m*CO2 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 110)*sol(:ncol,:, 1) ! rate_const*OHm*O3 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 110)*sol(:ncol,:, 7) ! rate_const*OHm*NO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 110)*sol(:ncol,:, 57) ! rate_const*M*OHm*CO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 110)*sol(:ncol,:, 27) ! rate_const*OHm*HCL + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 110)*sol(:ncol,:, 85) ! rate_const*OHm*CL + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 110)*sol(:ncol,:, 24) ! rate_const*OHm*CLO + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 111)*sol(:ncol,:, 2) ! rate_const*CO3m*O + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 111)*sol(:ncol,:, 3) ! rate_const*CO3m*O2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 111)*sol(:ncol,:, 18) ! rate_const*CO3m*H + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 111)*sol(:ncol,:, 6) ! rate_const*CO3m*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 111)*sol(:ncol,:, 7) ! rate_const*CO3m*NO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 111)*sol(:ncol,:, 9) ! rate_const*CO3m*HNO3 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 111)*sol(:ncol,:, 85) ! rate_const*CO3m*CL + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 111)*sol(:ncol,:, 85) ! rate_const*CO3m*CL + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 111)*sol(:ncol,:, 24) ! rate_const*CO3m*CLO + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 112)*sol(:ncol,:, 1) ! rate_const*CO4m*O3 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 112)*sol(:ncol,:, 18) ! rate_const*CO4m*H + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 112)*sol(:ncol,:, 2) ! rate_const*CO4m*O + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 112)*sol(:ncol,:, 27) ! rate_const*CO4m*HCL + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 112)*sol(:ncol,:, 85) ! rate_const*CO4m*CL + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 112)*sol(:ncol,:, 24) ! rate_const*CO4m*CLO + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 113)*sol(:ncol,:, 18) ! rate_const*NO2m*H + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 113)*sol(:ncol,:, 7) ! rate_const*NO2m*NO2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 113)*sol(:ncol,:, 1) ! rate_const*NO2m*O3 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 113)*sol(:ncol,:, 9) ! rate_const*NO2m*HNO3 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 113)*sol(:ncol,:, 27) ! rate_const*NO2m*HCL + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 113)*sol(:ncol,:, 85) ! rate_const*NO2m*CL + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 113)*sol(:ncol,:, 24) ! rate_const*NO2m*CLO + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 114)*sol(:ncol,:, 2) ! rate_const*NO3m*O + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 114)*sol(:ncol,:, 1) ! rate_const*NO3m*O3 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 114)*sol(:ncol,:, 27) ! rate_const*NO3m*HCL + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 123)*sol(:ncol,:, 18) ! rate_const*CLm*H + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 123)*sol(:ncol,:, 7) ! rate_const*CLm*NO2 + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 123)*sol(:ncol,:, 9) ! rate_const*CLm*HNO3 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 123)*sol(:ncol,:, 135) ! rate_const*M*CLm*H2O + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 123)*sol(:ncol,:, 27) ! rate_const*M*CLm*HCL + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 124)*sol(:ncol,:, 6) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 124)*sol(:ncol,:, 6) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 124)*sol(:ncol,:, 2) ! rate_const*CLOm*O + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 125)*sol(:ncol,:, 27) ! rate_const*CLm_H2O*HCL + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 125) ! rate_const*M*CLm_H2O + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 126) ! rate_const*M*CLm_HCL + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 111)*sol(:ncol,:, 135) ! rate_const*M*CO3m*H2O + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 114)*sol(:ncol,:, 135) ! rate_const*M*NO3m*H2O + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 118) ! rate_const*M*NO3m_H2O + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 115)*sol(:ncol,:, 6) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 115)*sol(:ncol,:, 7) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 115) ! rate_const*M*CO3m_H2O + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 115)*sol(:ncol,:, 7) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 115)*sol(:ncol,:, 135) ! rate_const*M*CO3m_H2O*H2O + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 116) ! rate_const*M*CO3m2H2O + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 115)*sol(:ncol,:, 6) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 117) ! rate_const*M*NO2m_H2O + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 113)*sol(:ncol,:, 135) ! rate_const*M*NO2m*H2O + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 118)*sol(:ncol,:, 135) ! rate_const*M*NO3m_H2O*H2O + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 119) ! rate_const*M*NO3m2H2O + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 119)*sol(:ncol,:, 11) ! rate_const*NO3m2H2O*N2O5 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 120) ! rate_const*M*NO3mHNO3 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 114)*sol(:ncol,:, 9) ! rate_const*M*NO3m*HNO3 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 121)*sol(:ncol,:, 9) ! rate_const*NO3m_HCL*HNO3 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 114)*sol(:ncol,:, 27) ! rate_const*M*NO3m*HCL + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 118)*sol(:ncol,:, 11) ! rate_const*NO3m_H2O*N2O5 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 118)*sol(:ncol,:, 9) ! rate_const*NO3m_H2O*HNO3 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 96)*sol(:ncol,:, 120) ! rate_const*Hp_4H2O*NO3mHNO3 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 96)*sol(:ncol,:, 111) ! rate_const*Hp_4H2O*CO3m + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 96)*sol(:ncol,:, 126) ! rate_const*Hp_4H2O*CLm_HCL + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 96)*sol(:ncol,:, 114) ! rate_const*Hp_4H2O*NO3m + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 96)*sol(:ncol,:, 122) ! rate_const*Hp_4H2O*HCO3m + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 96)*sol(:ncol,:, 107) ! rate_const*Hp_4H2O*O2m + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 96)*sol(:ncol,:, 112) ! rate_const*Hp_4H2O*CO4m + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 96)*sol(:ncol,:, 118) ! rate_const*Hp_4H2O*NO3m_H2O + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 96)*sol(:ncol,:, 116) ! rate_const*Hp_4H2O*CO3m2H2O + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 96)*sol(:ncol,:, 123) ! rate_const*Hp_4H2O*CLm + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 96)*sol(:ncol,:, 115) ! rate_const*Hp_4H2O*CO3m_H2O + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 96)*sol(:ncol,:, 117) ! rate_const*Hp_4H2O*NO2m_H2O + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 96)*sol(:ncol,:, 121) ! rate_const*Hp_4H2O*NO3m_HCL + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 96)*sol(:ncol,:, 125) ! rate_const*Hp_4H2O*CLm_H2O + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 96)*sol(:ncol,:, 119) ! rate_const*Hp_4H2O*NO3m2H2O + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 96)*sol(:ncol,:, 113) ! rate_const*Hp_4H2O*NO2m + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 97)*sol(:ncol,:, 120) ! rate_const*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 97)*sol(:ncol,:, 111) ! rate_const*Hp_5H2O*CO3m + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 97)*sol(:ncol,:, 126) ! rate_const*Hp_5H2O*CLm_HCL + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 97)*sol(:ncol,:, 114) ! rate_const*Hp_5H2O*NO3m + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 97)*sol(:ncol,:, 122) ! rate_const*Hp_5H2O*HCO3m + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 97)*sol(:ncol,:, 107) ! rate_const*Hp_5H2O*O2m + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 97)*sol(:ncol,:, 112) ! rate_const*Hp_5H2O*CO4m + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 97)*sol(:ncol,:, 118) ! rate_const*Hp_5H2O*NO3m_H2O + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 97)*sol(:ncol,:, 116) ! rate_const*Hp_5H2O*CO3m2H2O + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 97)*sol(:ncol,:, 123) ! rate_const*Hp_5H2O*CLm + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 97)*sol(:ncol,:, 115) ! rate_const*Hp_5H2O*CO3m_H2O + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 97)*sol(:ncol,:, 117) ! rate_const*Hp_5H2O*NO2m_H2O + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 97)*sol(:ncol,:, 121) ! rate_const*Hp_5H2O*NO3m_HCL + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 97)*sol(:ncol,:, 125) ! rate_const*Hp_5H2O*CLm_H2O + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 97)*sol(:ncol,:, 119) ! rate_const*Hp_5H2O*NO3m2H2O + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 97)*sol(:ncol,:, 113) ! rate_const*Hp_5H2O*NO2m + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 95)*sol(:ncol,:, 120) ! rate_const*Hp_3H2O*NO3mHNO3 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 95)*sol(:ncol,:, 111) ! rate_const*Hp_3H2O*CO3m + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 95)*sol(:ncol,:, 126) ! rate_const*Hp_3H2O*CLm_HCL + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 95)*sol(:ncol,:, 114) ! rate_const*Hp_3H2O*NO3m + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 95)*sol(:ncol,:, 122) ! rate_const*Hp_3H2O*HCO3m + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 95)*sol(:ncol,:, 107) ! rate_const*Hp_3H2O*O2m + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 95)*sol(:ncol,:, 112) ! rate_const*Hp_3H2O*CO4m + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 95)*sol(:ncol,:, 118) ! rate_const*Hp_3H2O*NO3m_H2O + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 95)*sol(:ncol,:, 116) ! rate_const*Hp_3H2O*CO3m2H2O + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 95)*sol(:ncol,:, 123) ! rate_const*Hp_3H2O*CLm + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 95)*sol(:ncol,:, 115) ! rate_const*Hp_3H2O*CO3m_H2O + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 95)*sol(:ncol,:, 117) ! rate_const*Hp_3H2O*NO2m_H2O + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 95)*sol(:ncol,:, 121) ! rate_const*Hp_3H2O*NO3m_HCL + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 95)*sol(:ncol,:, 125) ! rate_const*Hp_3H2O*CLm_H2O + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 95)*sol(:ncol,:, 119) ! rate_const*Hp_3H2O*NO3m2H2O + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 95)*sol(:ncol,:, 113) ! rate_const*Hp_3H2O*NO2m + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 101)*sol(:ncol,:, 120) ! rate_const*NOp_H2O*NO3mHNO3 + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 101)*sol(:ncol,:, 111) ! rate_const*NOp_H2O*CO3m + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 101)*sol(:ncol,:, 126) ! rate_const*NOp_H2O*CLm_HCL + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 101)*sol(:ncol,:, 114) ! rate_const*NOp_H2O*NO3m + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 101)*sol(:ncol,:, 122) ! rate_const*NOp_H2O*HCO3m + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 101)*sol(:ncol,:, 107) ! rate_const*NOp_H2O*O2m + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 101)*sol(:ncol,:, 112) ! rate_const*NOp_H2O*CO4m + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 101)*sol(:ncol,:, 118) ! rate_const*NOp_H2O*NO3m_H2O + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 101)*sol(:ncol,:, 116) ! rate_const*NOp_H2O*CO3m2H2O + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 101)*sol(:ncol,:, 123) ! rate_const*NOp_H2O*CLm + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 101)*sol(:ncol,:, 115) ! rate_const*NOp_H2O*CO3m_H2O + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 101)*sol(:ncol,:, 117) ! rate_const*NOp_H2O*NO2m_H2O + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 101)*sol(:ncol,:, 121) ! rate_const*NOp_H2O*NO3m_HCL + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 101)*sol(:ncol,:, 125) ! rate_const*NOp_H2O*CLm_H2O + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 101)*sol(:ncol,:, 119) ! rate_const*NOp_H2O*NO3m2H2O + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 101)*sol(:ncol,:, 113) ! rate_const*NOp_H2O*NO2m + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 102)*sol(:ncol,:, 120) ! rate_const*NOp_2H2O*NO3mHNO3 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 102)*sol(:ncol,:, 111) ! rate_const*NOp_2H2O*CO3m + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 102)*sol(:ncol,:, 126) ! rate_const*NOp_2H2O*CLm_HCL + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 102)*sol(:ncol,:, 114) ! rate_const*NOp_2H2O*NO3m + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 102)*sol(:ncol,:, 122) ! rate_const*NOp_2H2O*HCO3m + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 102)*sol(:ncol,:, 107) ! rate_const*NOp_2H2O*O2m + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 102)*sol(:ncol,:, 112) ! rate_const*NOp_2H2O*CO4m + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 102)*sol(:ncol,:, 118) ! rate_const*NOp_2H2O*NO3m_H2O + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 102)*sol(:ncol,:, 116) ! rate_const*NOp_2H2O*CO3m2H2O + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 102)*sol(:ncol,:, 123) ! rate_const*NOp_2H2O*CLm + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 102)*sol(:ncol,:, 115) ! rate_const*NOp_2H2O*CO3m_H2O + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 102)*sol(:ncol,:, 117) ! rate_const*NOp_2H2O*NO2m_H2O + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 102)*sol(:ncol,:, 121) ! rate_const*NOp_2H2O*NO3m_HCL + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 102)*sol(:ncol,:, 125) ! rate_const*NOp_2H2O*CLm_H2O + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 102)*sol(:ncol,:, 119) ! rate_const*NOp_2H2O*NO3m2H2O + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 102)*sol(:ncol,:, 113) ! rate_const*NOp_2H2O*NO2m + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 129)*sol(:ncol,:, 120) ! rate_const*NOp*NO3mHNO3 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 129)*sol(:ncol,:, 111) ! rate_const*NOp*CO3m + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 129)*sol(:ncol,:, 126) ! rate_const*NOp*CLm_HCL + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 129)*sol(:ncol,:, 114) ! rate_const*NOp*NO3m + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 129)*sol(:ncol,:, 122) ! rate_const*NOp*HCO3m + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 129)*sol(:ncol,:, 107) ! rate_const*NOp*O2m + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 129)*sol(:ncol,:, 112) ! rate_const*NOp*CO4m + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 129)*sol(:ncol,:, 118) ! rate_const*NOp*NO3m_H2O + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 129)*sol(:ncol,:, 116) ! rate_const*NOp*CO3m2H2O + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 129)*sol(:ncol,:, 123) ! rate_const*NOp*CLm + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 129)*sol(:ncol,:, 115) ! rate_const*NOp*CO3m_H2O + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 129)*sol(:ncol,:, 117) ! rate_const*NOp*NO2m_H2O + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 129)*sol(:ncol,:, 121) ! rate_const*NOp*NO3m_HCL + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 129)*sol(:ncol,:, 125) ! rate_const*NOp*CLm_H2O + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 129)*sol(:ncol,:, 119) ! rate_const*NOp*NO3m2H2O + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 129)*sol(:ncol,:, 113) ! rate_const*NOp*NO2m + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 90)*sol(:ncol,:, 120) ! rate_const*O2p*NO3mHNO3 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 90)*sol(:ncol,:, 111) ! rate_const*O2p*CO3m + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 90)*sol(:ncol,:, 126) ! rate_const*O2p*CLm_HCL + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 90)*sol(:ncol,:, 114) ! rate_const*O2p*NO3m + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 90)*sol(:ncol,:, 122) ! rate_const*O2p*HCO3m + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 90)*sol(:ncol,:, 107) ! rate_const*O2p*O2m + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 90)*sol(:ncol,:, 112) ! rate_const*O2p*CO4m + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 90)*sol(:ncol,:, 118) ! rate_const*O2p*NO3m_H2O + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 90)*sol(:ncol,:, 116) ! rate_const*O2p*CO3m2H2O + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 90)*sol(:ncol,:, 123) ! rate_const*O2p*CLm + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 90)*sol(:ncol,:, 115) ! rate_const*O2p*CO3m_H2O + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 90)*sol(:ncol,:, 117) ! rate_const*O2p*NO2m_H2O + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 90)*sol(:ncol,:, 121) ! rate_const*O2p*NO3m_HCL + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 90)*sol(:ncol,:, 125) ! rate_const*O2p*CLm_H2O + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 90)*sol(:ncol,:, 119) ! rate_const*O2p*NO3m2H2O + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 90)*sol(:ncol,:, 113) ! rate_const*O2p*NO2m + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 96)*sol(:ncol,:, 111) ! rate_const*M*Hp_4H2O*CO3m + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 96)*sol(:ncol,:, 114) ! rate_const*M*Hp_4H2O*NO3m + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 97)*sol(:ncol,:, 111) ! rate_const*M*Hp_5H2O*CO3m + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 97)*sol(:ncol,:, 114) ! rate_const*M*Hp_5H2O*NO3m + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 96)*sol(:ncol,:, 126) ! rate_const*M*Hp_4H2O*CLm_HCL + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 97)*sol(:ncol,:, 126) ! rate_const*M*Hp_5H2O*CLm_HCL + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 96)*sol(:ncol,:, 120) ! rate_const*M*Hp_4H2O*NO3mHNO3 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 97)*sol(:ncol,:, 120) ! rate_const*M*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 96)*sol(:ncol,:, 116) ! rate_const*M*Hp_4H2O*CO3m2H2O + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 97)*sol(:ncol,:, 116) ! rate_const*M*Hp_5H2O*CO3m2H2O + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 96)*sol(:ncol,:, 115) ! rate_const*M*Hp_4H2O*CO3m_H2O + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 97)*sol(:ncol,:, 115) ! rate_const*M*Hp_5H2O*CO3m_H2O + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 96)*sol(:ncol,:, 118) ! rate_const*M*Hp_4H2O*NO3m_H2O + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 97)*sol(:ncol,:, 118) ! rate_const*M*Hp_5H2O*NO3m_H2O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..b2b4ff6f76 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 @@ -0,0 +1,592 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,108) = 8.00e-14_r8 + rate(:,:,109) = 3.90e-17_r8 + rate(:,:,112) = 4.20e-13_r8 + rate(:,:,113) = 8.50e-2_r8 + rate(:,:,114) = 1.30e-16_r8 + rate(:,:,116) = 1.00e-20_r8 + rate(:,:,117) = 2.58e-04_r8 + rate(:,:,124) = 1.20e-10_r8 + rate(:,:,125) = 2.02e-10_r8 + rate(:,:,126) = 1.204e-10_r8 + rate(:,:,127) = 1.50e-10_r8 + rate(:,:,128) = 9.75e-11_r8 + rate(:,:,129) = 1.50e-11_r8 + rate(:,:,130) = 7.20e-11_r8 + rate(:,:,131) = 1.794e-10_r8 + rate(:,:,132) = 1.628e-10_r8 + rate(:,:,133) = 2.84e-10_r8 + rate(:,:,134) = 1.674e-10_r8 + rate(:,:,135) = 9.60e-11_r8 + rate(:,:,136) = 4.10e-11_r8 + rate(:,:,137) = 1.012e-10_r8 + rate(:,:,138) = 1.20e-10_r8 + rate(:,:,139) = 4.49e-10_r8 + rate(:,:,140) = 2.57e-10_r8 + rate(:,:,141) = 2.14e-11_r8 + rate(:,:,142) = 1.90e-10_r8 + rate(:,:,143) = 1.31e-10_r8 + rate(:,:,144) = 3.50e-11_r8 + rate(:,:,145) = 9.00e-12_r8 + rate(:,:,146) = 1.20e-10_r8 + rate(:,:,147) = 1.50e-10_r8 + rate(:,:,148) = 1.20e-10_r8 + rate(:,:,151) = 7.20e-11_r8 + rate(:,:,152) = 6.90e-12_r8 + rate(:,:,153) = 1.60e-12_r8 + rate(:,:,157) = 1.80e-12_r8 + rate(:,:,160) = 1.80e-12_r8 + rate(:,:,168) = 5.00e-12_r8 + rate(:,:,169) = 7.00e-13_r8 + rate(:,:,170) = 5.00e-11_r8 + rate(:,:,187) = 1.00e-11_r8 + rate(:,:,188) = 2.20e-11_r8 + rate(:,:,189) = 3.50e-12_r8 + rate(:,:,214) = 1.70e-13_r8 + rate(:,:,267) = 6.60E-11_r8 + rate(:,:,268) = 2.30E-12_r8 + rate(:,:,269) = 1.20E-11_r8 + rate(:,:,273) = 1.40E-11_r8 + rate(:,:,274) = 2.80E-11_r8 + rate(:,:,275) = 5.70E-11_r8 + rate(:,:,276) = 1.90E-12_r8 + rate(:,:,303) = 9.0e-10_r8 + rate(:,:,304) = 1.0e-10_r8 + rate(:,:,305) = 4.4e-10_r8 + rate(:,:,306) = 4.0e-10_r8 + rate(:,:,307) = 2.0e-10_r8 + rate(:,:,308) = 1.0e-12_r8 + rate(:,:,309) = 6.0e-11_r8 + rate(:,:,310) = 5.0e-16_r8 + rate(:,:,318) = 1.5e-6_r8 + rate(:,:,319) = 1.5e-6_r8 + rate(:,:,320) = 2.0e-6_r8 + rate(:,:,321) = 2.0e-6_r8 + rate(:,:,322) = 2.0e-6_r8 + rate(:,:,323) = 1.5e-6_r8 + rate(:,:,327) = 3.6e-6_r8 + rate(:,:,328) = 5.0e-6_r8 + rate(:,:,330) = 1e-9_r8 + rate(:,:,331) = 1e-9_r8 + rate(:,:,333) = 2.8e-28_r8 + rate(:,:,334) = 1.7e-9_r8 + rate(:,:,335) = 1.5e-10_r8 + rate(:,:,336) = 3.e-10_r8 + rate(:,:,337) = 9.0e-10_r8 + rate(:,:,338) = 2.4e-10_r8 + rate(:,:,339) = 2.0e-9_r8 + rate(:,:,348) = 4.0e-12_r8 + rate(:,:,349) = 7.0e-12_r8 + rate(:,:,350) = 1.0e-9_r8 + rate(:,:,351) = 1.0e-9_r8 + rate(:,:,354) = 0.5e-9_r8 + rate(:,:,355) = 1.e-10_r8 + rate(:,:,356) = 7.e-12_r8 + rate(:,:,358) = 7e-11_r8 + rate(:,:,359) = 1.e-9_r8 + rate(:,:,364) = 1.9e-10_r8 + rate(:,:,366) = 3.e-10_r8 + rate(:,:,367) = 0.5e-12_r8 + rate(:,:,368) = 5.8e-10_r8 + rate(:,:,369) = 1.5e-10_r8 + rate(:,:,370) = 2.e-10_r8 + rate(:,:,372) = 1.4e-9_r8 + rate(:,:,373) = 1.e-10_r8 + rate(:,:,374) = 1.e-10_r8 + rate(:,:,375) = 2.e-10_r8 + rate(:,:,376) = 1.4e-9_r8 + rate(:,:,377) = 8.0e-10_r8 + rate(:,:,378) = 2.9e-31_r8 + rate(:,:,379) = 6.0e-13_r8 + rate(:,:,380) = 1.0e-9_r8 + rate(:,:,381) = 2.0e-28_r8 + rate(:,:,382) = 3.2e-11_r8 + rate(:,:,383) = 3.6e-9_r8 + rate(:,:,384) = 2.e-9_r8 + rate(:,:,385) = 1.e-10_r8 + rate(:,:,386) = 1.e-10_r8 + rate(:,:,387) = 1.5e-10_r8 + rate(:,:,388) = 7.8e-10_r8 + rate(:,:,389) = 9.9e-30_r8 + rate(:,:,390) = 7.e-10_r8 + rate(:,:,391) = 3.4e-31_r8 + rate(:,:,392) = 2.9e-9_r8 + rate(:,:,393) = 1.6e-9_r8 + rate(:,:,394) = 1.e-10_r8 + rate(:,:,395) = 1.e-10_r8 + rate(:,:,396) = 2.5e-10_r8 + rate(:,:,397) = 8.4e-10_r8 + rate(:,:,398) = 5.5e-10_r8 + rate(:,:,403) = 4.e-10_r8 + rate(:,:,404) = 4.3e-10_r8 + rate(:,:,405) = 9.e-10_r8 + rate(:,:,406) = 1.1e-9_r8 + rate(:,:,407) = 7.6e-28_r8 + rate(:,:,408) = 1.e-9_r8 + rate(:,:,409) = 1.e-10_r8 + rate(:,:,410) = 1.e-10_r8 + rate(:,:,411) = 1.1e-10_r8 + rate(:,:,412) = 6.0e-15_r8 + rate(:,:,413) = 1.7e-10_r8 + rate(:,:,416) = 3.51e-10_r8 + rate(:,:,417) = 1.e-10_r8 + rate(:,:,418) = 1.e-10_r8 + rate(:,:,419) = 1.e-11_r8 + rate(:,:,420) = 1.3e-10_r8 + rate(:,:,421) = 2.2e-10_r8 + rate(:,:,422) = 1.4e-10_r8 + rate(:,:,423) = 1.2e-9_r8 + rate(:,:,424) = 1.e-10_r8 + rate(:,:,425) = 1.0e-10_r8 + rate(:,:,426) = 3.e-10_r8 + rate(:,:,427) = 2.e-13_r8 + rate(:,:,428) = 1.2e-10_r8 + rate(:,:,429) = 1.6e-9_r8 + rate(:,:,430) = 1.4e-9_r8 + rate(:,:,431) = 1.0e-10_r8 + rate(:,:,432) = 1.0e-10_r8 + rate(:,:,433) = 0.5e-11_r8 + rate(:,:,434) = 1.e-13_r8 + rate(:,:,435) = 1.e-12_r8 + rate(:,:,436) = 9.6e-10_r8 + rate(:,:,437) = 6.0e-12_r8 + rate(:,:,438) = 1.6e-9_r8 + rate(:,:,439) = 2.e-29_r8 + rate(:,:,440) = 1.0e-27_r8 + rate(:,:,441) = 2.9e-12_r8 + rate(:,:,442) = 2.9e-11_r8 + rate(:,:,443) = 2.0e-10_r8 + rate(:,:,444) = 1.3e-9_r8 + rate(:,:,447) = 1.0e-28_r8 + rate(:,:,448) = 1.6e-28_r8 + rate(:,:,450) = 3.5e-12_r8 + rate(:,:,451) = 4.0e-11_r8 + rate(:,:,453) = 4.0e-11_r8 + rate(:,:,454) = 1.0e-28_r8 + rate(:,:,456) = 3.5e-12_r8 + rate(:,:,458) = 1.6e-28_r8 + rate(:,:,459) = 1.6e-28_r8 + rate(:,:,461) = 7.0e-10_r8 + rate(:,:,463) = 1.45e-26_r8 + rate(:,:,464) = 7.6e-10_r8 + rate(:,:,466) = 7.0e-10_r8 + rate(:,:,467) = 1.6e-9_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,106) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,110) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,111) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,115) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,118) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,119) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,120) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,121) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,122) = 7.25e-11_r8 * exp_fac(:,:) + rate(:,:,123) = 4.63e-11_r8 * exp_fac(:,:) + rate(:,:,150) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:,154) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:,155) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,156) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,224) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,159) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,161) = 1.60e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,162) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,232) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,260) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,163) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,165) = 1.40e-12_r8 * exp( -2000._r8 * itemp(:,:) ) + rate(:,:,167) = 1.8e-11_r8 * exp( 390._r8 * itemp(:,:) ) + rate(:,:,171) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:,172) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,173) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,174) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,175) = 1.45e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,177) = 3.30e-12_r8 * exp_fac(:,:) + rate(:,:,196) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,201) = 7.40e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,178) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,233) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,179) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,181) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,207) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,186) = 1.50e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,191) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,193) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,194) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,195) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,197) = 3.60e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,198) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,199) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,200) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,202) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,223) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,231) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,203) = 2.60e-12_r8 * exp_fac(:,:) + rate(:,:,205) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,230) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,204) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,208) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,209) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,212) = 1.80e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,213) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,215) = 3.40e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,216) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,237) = 1.40e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,217) = 3.60e-12_r8 * exp_fac(:,:) + rate(:,:,248) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,218) = 1.20e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,219) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,220) = 1.60e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,221) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,222) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,250) = 6.30e-12_r8 * exp_fac(:,:) + rate(:,:,225) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,226) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,229) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,228) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,234) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,235) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,236) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,267) = 6.60E-11_r8 * exp_fac(:,:) + rate(:,:,268) = 2.30E-12_r8 * exp_fac(:,:) + rate(:,:,269) = 1.20E-11_r8 * exp_fac(:,:) + rate(:,:,273) = 1.40E-11_r8 * exp_fac(:,:) + rate(:,:,274) = 2.80E-11_r8 * exp_fac(:,:) + rate(:,:,275) = 5.70E-11_r8 * exp_fac(:,:) + rate(:,:,276) = 1.90E-12_r8 * exp_fac(:,:) + rate(:,:,303) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,304) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,305) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,306) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,307) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,308) = 1.0e-12_r8 * exp_fac(:,:) + rate(:,:,309) = 6.0e-11_r8 * exp_fac(:,:) + rate(:,:,310) = 5.0e-16_r8 * exp_fac(:,:) + rate(:,:,318) = 1.5e-6_r8 * exp_fac(:,:) + rate(:,:,319) = 1.5e-6_r8 * exp_fac(:,:) + rate(:,:,320) = 2.0e-6_r8 * exp_fac(:,:) + rate(:,:,321) = 2.0e-6_r8 * exp_fac(:,:) + rate(:,:,322) = 2.0e-6_r8 * exp_fac(:,:) + rate(:,:,323) = 1.5e-6_r8 * exp_fac(:,:) + rate(:,:,327) = 3.6e-6_r8 * exp_fac(:,:) + rate(:,:,328) = 5.0e-6_r8 * exp_fac(:,:) + rate(:,:,330) = 1e-9_r8 * exp_fac(:,:) + rate(:,:,331) = 1e-9_r8 * exp_fac(:,:) + rate(:,:,333) = 2.8e-28_r8 * exp_fac(:,:) + rate(:,:,334) = 1.7e-9_r8 * exp_fac(:,:) + rate(:,:,335) = 1.5e-10_r8 * exp_fac(:,:) + rate(:,:,336) = 3.e-10_r8 * exp_fac(:,:) + rate(:,:,337) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,338) = 2.4e-10_r8 * exp_fac(:,:) + rate(:,:,339) = 2.0e-9_r8 * exp_fac(:,:) + rate(:,:,348) = 4.0e-12_r8 * exp_fac(:,:) + rate(:,:,349) = 7.0e-12_r8 * exp_fac(:,:) + rate(:,:,350) = 1.0e-9_r8 * exp_fac(:,:) + rate(:,:,351) = 1.0e-9_r8 * exp_fac(:,:) + rate(:,:,354) = 0.5e-9_r8 * exp_fac(:,:) + rate(:,:,355) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,356) = 7.e-12_r8 * exp_fac(:,:) + rate(:,:,358) = 7e-11_r8 * exp_fac(:,:) + rate(:,:,359) = 1.e-9_r8 * exp_fac(:,:) + rate(:,:,364) = 1.9e-10_r8 * exp_fac(:,:) + rate(:,:,366) = 3.e-10_r8 * exp_fac(:,:) + rate(:,:,367) = 0.5e-12_r8 * exp_fac(:,:) + rate(:,:,368) = 5.8e-10_r8 * exp_fac(:,:) + rate(:,:,369) = 1.5e-10_r8 * exp_fac(:,:) + rate(:,:,370) = 2.e-10_r8 * exp_fac(:,:) + rate(:,:,372) = 1.4e-9_r8 * exp_fac(:,:) + rate(:,:,373) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,374) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,375) = 2.e-10_r8 * exp_fac(:,:) + rate(:,:,376) = 1.4e-9_r8 * exp_fac(:,:) + rate(:,:,377) = 8.0e-10_r8 * exp_fac(:,:) + rate(:,:,378) = 2.9e-31_r8 * exp_fac(:,:) + rate(:,:,379) = 6.0e-13_r8 * exp_fac(:,:) + rate(:,:,380) = 1.0e-9_r8 * exp_fac(:,:) + rate(:,:,381) = 2.0e-28_r8 * exp_fac(:,:) + rate(:,:,382) = 3.2e-11_r8 * exp_fac(:,:) + rate(:,:,383) = 3.6e-9_r8 * exp_fac(:,:) + rate(:,:,384) = 2.e-9_r8 * exp_fac(:,:) + rate(:,:,385) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,386) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,387) = 1.5e-10_r8 * exp_fac(:,:) + rate(:,:,388) = 7.8e-10_r8 * exp_fac(:,:) + rate(:,:,389) = 9.9e-30_r8 * exp_fac(:,:) + rate(:,:,390) = 7.e-10_r8 * exp_fac(:,:) + rate(:,:,391) = 3.4e-31_r8 * exp_fac(:,:) + rate(:,:,392) = 2.9e-9_r8 * exp_fac(:,:) + rate(:,:,393) = 1.6e-9_r8 * exp_fac(:,:) + rate(:,:,394) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,395) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,396) = 2.5e-10_r8 * exp_fac(:,:) + rate(:,:,397) = 8.4e-10_r8 * exp_fac(:,:) + rate(:,:,398) = 5.5e-10_r8 * exp_fac(:,:) + rate(:,:,403) = 4.e-10_r8 * exp_fac(:,:) + rate(:,:,404) = 4.3e-10_r8 * exp_fac(:,:) + rate(:,:,405) = 9.e-10_r8 * exp_fac(:,:) + rate(:,:,406) = 1.1e-9_r8 * exp_fac(:,:) + rate(:,:,407) = 7.6e-28_r8 * exp_fac(:,:) + rate(:,:,408) = 1.e-9_r8 * exp_fac(:,:) + rate(:,:,409) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,410) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,411) = 1.1e-10_r8 * exp_fac(:,:) + rate(:,:,412) = 6.0e-15_r8 * exp_fac(:,:) + rate(:,:,413) = 1.7e-10_r8 * exp_fac(:,:) + rate(:,:,416) = 3.51e-10_r8 * exp_fac(:,:) + rate(:,:,417) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,418) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,419) = 1.e-11_r8 * exp_fac(:,:) + rate(:,:,420) = 1.3e-10_r8 * exp_fac(:,:) + rate(:,:,421) = 2.2e-10_r8 * exp_fac(:,:) + rate(:,:,422) = 1.4e-10_r8 * exp_fac(:,:) + rate(:,:,423) = 1.2e-9_r8 * exp_fac(:,:) + rate(:,:,424) = 1.e-10_r8 * exp_fac(:,:) + rate(:,:,425) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,426) = 3.e-10_r8 * exp_fac(:,:) + rate(:,:,427) = 2.e-13_r8 * exp_fac(:,:) + rate(:,:,428) = 1.2e-10_r8 * exp_fac(:,:) + rate(:,:,429) = 1.6e-9_r8 * exp_fac(:,:) + rate(:,:,430) = 1.4e-9_r8 * exp_fac(:,:) + rate(:,:,431) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,432) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,433) = 0.5e-11_r8 * exp_fac(:,:) + rate(:,:,434) = 1.e-13_r8 * exp_fac(:,:) + rate(:,:,435) = 1.e-12_r8 * exp_fac(:,:) + rate(:,:,436) = 9.6e-10_r8 * exp_fac(:,:) + rate(:,:,437) = 6.0e-12_r8 * exp_fac(:,:) + rate(:,:,438) = 1.6e-9_r8 * exp_fac(:,:) + rate(:,:,439) = 2.e-29_r8 * exp_fac(:,:) + rate(:,:,440) = 1.0e-27_r8 * exp_fac(:,:) + rate(:,:,441) = 2.9e-12_r8 * exp_fac(:,:) + rate(:,:,442) = 2.9e-11_r8 * exp_fac(:,:) + rate(:,:,443) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,444) = 1.3e-9_r8 * exp_fac(:,:) + rate(:,:,447) = 1.0e-28_r8 * exp_fac(:,:) + rate(:,:,448) = 1.6e-28_r8 * exp_fac(:,:) + rate(:,:,450) = 3.5e-12_r8 * exp_fac(:,:) + rate(:,:,451) = 4.0e-11_r8 * exp_fac(:,:) + rate(:,:,453) = 4.0e-11_r8 * exp_fac(:,:) + rate(:,:,454) = 1.0e-28_r8 * exp_fac(:,:) + rate(:,:,456) = 3.5e-12_r8 * exp_fac(:,:) + rate(:,:,458) = 1.6e-28_r8 * exp_fac(:,:) + rate(:,:,459) = 1.6e-28_r8 * exp_fac(:,:) + rate(:,:,461) = 7.0e-10_r8 * exp_fac(:,:) + rate(:,:,463) = 1.45e-26_r8 * exp_fac(:,:) + rate(:,:,464) = 7.6e-10_r8 * exp_fac(:,:) + rate(:,:,466) = 7.0e-10_r8 * exp_fac(:,:) + rate(:,:,467) = 1.6e-9_r8 * exp_fac(:,:) + rate(:,:,238) = 1.60e-10_r8 * exp( -260._r8 * itemp(:,:) ) + rate(:,:,239) = 6.00e-12_r8 * exp( 400._r8 * itemp(:,:) ) + rate(:,:,240) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,241) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,242) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,243) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,246) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,257) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,244) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,245) = 1.40e-11_r8 * exp( -1030._r8 * itemp(:,:) ) + rate(:,:,247) = 1.30e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,249) = 1.35e-12_r8 * exp( -600._r8 * itemp(:,:) ) + rate(:,:,251) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,252) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,255) = 6.00e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,256) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,258) = 2.80e-12_r8 * exp( 300._r8 * itemp(:,:) ) + rate(:,:,259) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,265) = 2.10E-11_r8 * exp( -2200.0_r8 * itemp(:,:) ) + rate(:,:,266) = 1.10E-13_r8 * exp( -1200.0_r8 * itemp(:,:) ) + rate(:,:,270) = 2.70E-11_r8 * exp( 335._r8 * itemp(:,:) ) + rate(:,:,271) = 1.25E-13_r8 * exp( -2190.0_r8 * itemp(:,:) ) + rate(:,:,272) = 3.40E-12_r8 * exp( -1100.0_r8 * itemp(:,:) ) + rate(:,:,280) = 9.60e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,281) = 1.90e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,149), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.60e-11_r8 + call jpl( rate(1,1,158), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 7e-31_r8 * itemp(:,:)**2.6_r8 + kinf(:,:) = 3.6e-11_r8 * itemp(:,:)**0.1_r8 + call jpl( rate(1,1,166), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,176), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,180), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,182), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,184), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,190), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,206), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 3.0e-12_r8 * itemp(:,:)**2.0_r8 + call jpl( rate(1,1,210), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,227), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,254), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,108) = 8.00e-14_r8 + rate(:,:kbot,109) = 3.90e-17_r8 + rate(:,:kbot,114) = 1.30e-16_r8 + rate(:,:kbot,116) = 1.00e-20_r8 + rate(:,:kbot,152) = 6.90e-12_r8 + rate(:,:kbot,168) = 5.00e-12_r8 + rate(:,:kbot,169) = 7.00e-13_r8 + rate(:,:kbot,304) = 1.0e-10_r8 + rate(:,:kbot,305) = 4.4e-10_r8 + rate(:,:kbot,306) = 4.0e-10_r8 + rate(:,:kbot,307) = 2.0e-10_r8 + rate(:,:kbot,308) = 1.0e-12_r8 + rate(:,:kbot,309) = 6.0e-11_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,106) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,110) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,111) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,115) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,118) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,119) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,120) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,150) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,154) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,155) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,156) = 4.80e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,162) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,163) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,171) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,172) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,177) = 3.30e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,178) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,179) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,149) = wrk(:,:) + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..e1fc58bf3c --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 @@ -0,0 +1,691 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 22, 0, 0, 113, 0 /) + + cls_rxt_cnt(:,1) = (/ 1, 57, 0, 22 /) + cls_rxt_cnt(:,4) = (/ 29, 151, 413, 113 /) + + solsym(:135) = (/ 'O3 ','O ','O2 ','N2O ','N ', & + 'NO ','NO2 ','NO3 ','HNO3 ','HO2NO2 ', & + 'N2O5 ','CH4 ','CH3O2 ','CH3OOH ','CH2O ', & + 'CO ','H2 ','H ','H2O2 ','HONO ', & + 'CLY ','BRY ','CL2 ','CLO ','OCLO ', & + 'CL2O2 ','HCL ','HOCL ','CLONO2 ','BRCL ', & + 'BRO ','HBR ','HOBR ','BRONO2 ','CH3CL ', & + 'CH3BR ','CFC11 ','CFC12 ','CFC113 ','HCFC22 ', & + 'CCL4 ','CH3CCL3 ','CF3BR ','CF2CLBR ','HCFC141B ', & + 'HCFC142B ','CFC114 ','CFC115 ','H1202 ','H2402 ', & + 'CHBR3 ','CH2BR2 ','COF2 ','COFCL ','HF ', & + 'F ','CO2 ','OCS ','S ','SO ', & + 'SO2 ','SO3 ','H2SO4 ','DMS ','SOAG ', & + 'so4_a1 ','pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ', & + 'ncl_a1 ','num_a1 ','so4_a2 ','soa_a2 ','ncl_a2 ', & + 'num_a2 ','dst_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ', & + 'num_a3 ','pom_a4 ','bc_a4 ','num_a4 ','CL ', & + 'BR ','OH ','HO2 ','N2p ','O2p ', & + 'O4p ','O2p_H2O ','Hp_H2O ','Hp_2H2O ','Hp_3H2O ', & + 'Hp_4H2O ','Hp_5H2O ','H3Op_OH ','Hp_3N1 ','Hp_4N1 ', & + 'NOp_H2O ','NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_N2 ', & + 'Om ','O2m ','O3m ','O4m ','OHm ', & + 'CO3m ','CO4m ','NO2m ','NO3m ','CO3m_H2O ', & + 'CO3m2H2O ','NO2m_H2O ','NO3m_H2O ','NO3m2H2O ','NO3mHNO3 ', & + 'NO3m_HCL ','HCO3m ','CLm ','CLOm ','CLm_H2O ', & + 'CLm_HCL ','Np ','Op ','NOp ','e ', & + 'N2D ','O2_1S ','O2_1D ','O1D ','H2O ' /) + + adv_mass(:135) = (/ 47.998200_r8, 15.999400_r8, 31.998800_r8, 44.012880_r8, 14.006740_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 63.012340_r8, 79.011740_r8, & + 108.010480_r8, 16.040600_r8, 47.032000_r8, 48.039400_r8, 30.025200_r8, & + 28.010400_r8, 2.014800_r8, 1.007400_r8, 34.013600_r8, 47.012940_r8, & + 100.916850_r8, 99.716850_r8, 70.905400_r8, 51.452100_r8, 67.451500_r8, & + 102.904200_r8, 36.460100_r8, 52.459500_r8, 97.457640_r8, 115.356700_r8, & + 95.903400_r8, 80.911400_r8, 96.910800_r8, 141.908940_r8, 50.485900_r8, & + 94.937200_r8, 137.367503_r8, 120.913206_r8, 187.375310_r8, 86.467906_r8, & + 153.821800_r8, 133.402300_r8, 148.910210_r8, 165.364506_r8, 116.948003_r8, & + 100.493706_r8, 170.921013_r8, 154.466716_r8, 209.815806_r8, 259.823613_r8, & + 252.730400_r8, 173.833800_r8, 66.007206_r8, 82.461503_r8, 20.005803_r8, & + 18.998403_r8, 44.009800_r8, 60.076400_r8, 32.066000_r8, 48.065400_r8, & + 64.064800_r8, 80.064200_r8, 98.078400_r8, 62.132400_r8, 12.011000_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 58.442468_r8, 1.007400_r8, 115.107340_r8, 12.011000_r8, 58.442468_r8, & + 1.007400_r8, 135.064039_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, & + 1.007400_r8, 12.011000_r8, 12.011000_r8, 1.007400_r8, 35.452700_r8, & + 79.904000_r8, 17.006800_r8, 33.006200_r8, 28.013480_r8, 31.998800_r8, & + 63.997600_r8, 50.013000_r8, 19.021600_r8, 37.035800_r8, 55.050000_r8, & + 73.064200_r8, 91.078400_r8, 36.028400_r8, 118.062340_r8, 136.076540_r8, & + 48.020340_r8, 66.034540_r8, 68.049340_r8, 74.015940_r8, 58.019620_r8, & + 15.999400_r8, 31.998800_r8, 47.998200_r8, 63.997600_r8, 17.006800_r8, & + 60.009200_r8, 76.008600_r8, 46.005540_r8, 62.004940_r8, 78.023400_r8, & + 96.037600_r8, 64.019740_r8, 80.019140_r8, 98.033340_r8, 125.017280_r8, & + 98.465040_r8, 61.016600_r8, 35.452700_r8, 51.452100_r8, 53.466900_r8, & + 71.912800_r8, 14.006740_r8, 15.999400_r8, 30.006140_r8, 0.548567E-03_r8, & + 14.006740_r8, 31.998800_r8, 31.998800_r8, 15.999400_r8, 18.014200_r8 /) + + crb_mass(:135) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 22,1) = (/ 12, 4, 35, 36, 37, 38, 39, 47, 48, 40, & + 45, 46, 41, 42, 43, 44, 49, 50, 51, 52, & + 21, 22 /) + clsmap(:113,4) = (/ 1, 2, 134, 3, 132, 133, 17, 16, 57, 5, & + 6, 7, 87, 8, 20, 9, 10, 11, 13, 14, & + 15, 18, 88, 19, 135, 85, 23, 24, 25, 26, & + 27, 28, 29, 30, 86, 31, 32, 33, 34, 89, & + 90, 127, 128, 129, 131, 91, 92, 93, 94, 95, & + 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, & + 106, 107, 108, 109, 111, 112, 113, 114, 110, 122, & + 115, 116, 117, 118, 119, 120, 121, 123, 124, 125, & + 126, 130, 53, 54, 55, 56, 58, 59, 60, 61, & + 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, & + 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, & + 82, 83, 84 /) + + permute(:113,4) = (/ 94, 95, 82, 97, 32, 61, 80, 50, 102, 64, & + 104, 105, 88, 107, 51, 109, 39, 62, 63, 37, & + 73, 91, 86, 43, 100, 112, 24, 106, 33, 21, & + 93, 56, 59, 26, 81, 75, 55, 52, 41, 45, & + 110, 38, 57, 113, 40, 65, 49, 54, 44, 101, & + 108, 103, 35, 28, 29, 98, 90, 36, 47, 46, & + 99, 111, 74, 42, 89, 84, 87, 85, 92, 66, & + 78, 68, 71, 79, 77, 76, 72, 83, 60, 70, & + 69, 96, 22, 25, 27, 53, 34, 48, 67, 58, & + 30, 23, 31, 1, 2, 3, 4, 5, 6, 7, & + 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, & + 18, 19, 20 /) + + diag_map(:113) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 24, 27, 30, 32, 36, 39, 42, 46, 51, & + 55, 61, 64, 69, 77, 83, 89, 95, 102, 109, & + 114, 122, 129, 136, 143, 153, 161, 168, 177, 186, & + 191, 197, 206, 215, 220, 228, 236, 247, 255, 265, & + 273, 283, 296, 309, 324, 336, 353, 367, 382, 398, & + 413, 427, 445, 459, 480, 496, 512, 532, 554, 575, & + 600, 631, 655, 677, 710, 744, 770, 819, 849, 893, & + 931, 965,1010,1051,1110,1151,1198,1241,1278,1338, & + 1382,1424,1468,1512,1559,1606,1648,1692,1733,1780, & + 1817,1860,1907 /) + + extfrc_lst(: 23) = (/ 'NO ','NO2 ','CO ','SO2 ','DMS ', & + 'so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ','bc_a1 ', & + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','Op ', & + 'O2p ','Np ','N2p ','N2D ','O ', & + 'N ','e ','OH ' /) + + frc_from_dataset(: 23) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 50) = (/ 'CL ', 'BR ', 'OH ', 'HO2 ', 'Op ', & + 'O2p ', 'NOp ', 'Np ', 'N2p ', 'e ', & + 'O2_1S ', 'O2_1D ', 'N2D ', 'O1D ', 'O4p ', & + 'O2p_H2O ', 'Hp_H2O ', 'Hp_2H2O ', 'Hp_3H2O ', 'Hp_4H2O ', & + 'Hp_5H2O ', 'H3Op_OH ', 'Hp_3N1 ', 'Hp_4N1 ', 'NOp_H2O ', & + 'NOp_2H2O ', 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_N2 ', 'Om ', & + 'O2m ', 'O3m ', 'O4m ', 'CO3m ', 'CO4m ', & + 'NO2m ', 'NO3m ', 'OHm ', 'HCO3m ', 'CO3m_H2O ', & + 'CO3m2H2O ', 'NO2m_H2O ', 'NO3m_H2O ', 'NO3m2H2O ', 'NO3mHNO3 ', & + 'NO3m_HCL ', 'CLm ', 'CLOm ', 'CLm_H2O ', 'CLm_HCL ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jhbr ', & + 'jbrono2_a ', 'jbrono2_b ', & + 'jch3cl ', 'jccl4 ', & + 'jch3ccl3 ', 'jcfcl3 ', & + 'jcf2cl2 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jhcfc22 ', 'jhcfc141b ', & + 'jhcfc142b ', 'jch3br ', & + 'jcf3br ', 'jcf2clbr ', & + 'jchbr3 ', 'jch2br2 ', & + 'jh1202 ', 'jh2402 ', & + 'jcof2 ', 'jcofcl ', & + 'jhf ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jh2so4 ', 'jso2 ', & + 'jso3 ', 'jocs ', & + 'jso ', 'jhono ', & + 'jeuv_1 ', 'jeuv_2 ', & + 'jeuv_3 ', 'jeuv_4 ', & + 'jeuv_5 ', 'jeuv_6 ', & + 'jeuv_7 ', 'jeuv_8 ', & + 'jeuv_9 ', 'jeuv_10 ', & + 'jeuv_11 ', 'jeuv_12 ', & + 'jeuv_13 ', 'jeuv_14 ', & + 'jeuv_15 ', 'jeuv_16 ', & + 'jeuv_17 ', 'jeuv_18 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_24 ', & + 'jeuv_25 ', 'jeuv_26 ', & + 'jppi ', 'jepn1 ', & + 'jepn2 ', 'jepn3 ', & + 'jepn4 ', 'jepn6 ', & + 'jepn7 ', 'jpni1 ', & + 'jpni2 ', 'jpni3 ', & + 'jpni4 ', 'jpni5 ', & + 'usr_O_O2 ', 'O_O3 ', & + 'usr_O_O ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_N2 ', & + 'O2_1S_O3 ', 'O2_1S_CO2 ', & + 'ag2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1D_N2 ', & + 'ag1 ', 'O1D_N2 ', & + 'O1D_O2 ', 'O1D_O2b ', & + 'O1D_H2O ', 'O1D_N2Oa ', & + 'O1D_N2Ob ', 'O1D_O3 ', & + 'O1D_CFC11 ', 'O1D_CFC12 ', & + 'O1D_CFC113 ', 'O1D_CFC114 ', & + 'O1D_CFC115 ', 'O1D_HCFC22 ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_CCL4 ', 'O1D_CH3BR ', & + 'O1D_CF2CLBR ', 'O1D_CF3BR ', & + 'O1D_H1202 ', 'O1D_H2402 ', & + 'O1D_CHBR3 ', 'O1D_CH2BR2 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_H2 ', & + 'O1D_HCL ', 'O1D_HBR ', & + 'H_O2 ', 'H_O3 ', & + 'H_HO2a ', 'H_HO2 ', & + 'H_HO2b ', 'OH_O ', & + 'OH_O3 ', 'OH_HO2 ', & + 'OH_OH ', 'OH_OH_M ', & + 'OH_H2 ', 'OH_H2O2 ', & + 'H2_O ', 'HO2_O ', & + 'HO2_O3 ', 'usr_HO2_HO2 ', & + 'H2O2_O ', 'HONO1 ', & + 'HONO2 ', 'N2D_O2 ', & + 'N2D_O ', 'N_OH ', & + 'N_O2 ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'NO_O ', & + 'NO_HO2 ', 'NO_O3 ', & + 'NO2_O ', 'NO2_O_M ', & + 'NO2_O3 ', 'tag_NO2_NO3 ', & + 'usr_N2O5_M ', 'tag_NO2_OH ', & + 'usr_HNO3_OH ', 'NO3_NO ', & + 'NO3_O ', 'NO3_OH ', & + 'NO3_HO2 ', 'tag_NO2_HO2 ', & + 'HO2NO2_OH ', 'usr_HO2NO2_M ', & + 'CL_O3 ', 'CL_H2 ', & + 'CL_H2O2 ', 'CL_HO2a ', & + 'CL_HO2b ', 'CL_CH2O ', & + 'CL_CH4 ', 'CLO_O ' /) + rxt_tag_lst( 201: 400) = (/ 'CLO_OHa ', 'CLO_OHb ', & + 'CLO_HO2 ', 'CLO_CH3O2 ', & + 'CLO_NO ', 'CLO_NO2_M ', & + 'CLO_CLOa ', 'CLO_CLOb ', & + 'CLO_CLOc ', 'tag_CLO_CLO_M ', & + 'usr_CL2O2_M ', 'HCL_OH ', & + 'HCL_O ', 'HOCL_O ', & + 'HOCL_CL ', 'HOCL_OH ', & + 'CLONO2_O ', 'CLONO2_OH ', & + 'CLONO2_CL ', 'BR_O3 ', & + 'BR_HO2 ', 'BR_CH2O ', & + 'BRO_O ', 'BRO_OH ', & + 'BRO_HO2 ', 'BRO_NO ', & + 'BRO_NO2_M ', 'BRO_CLOa ', & + 'BRO_CLOb ', 'BRO_CLOc ', & + 'BRO_BRO ', 'HBR_OH ', & + 'HBR_O ', 'HOBR_O ', & + 'BRONO2_O ', 'F_H2O ', & + 'F_H2 ', 'F_CH4 ', & + 'F_HNO3 ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CH3CCL3_OH ', & + 'HCFC22_OH ', 'CH3BR_OH ', & + 'CH3BR_CL ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'CH2BR2_OH ', & + 'CHBR3_OH ', 'CH2BR2_CL ', & + 'CHBR3_CL ', 'CH4_OH ', & + 'usr_CO_OH_b ', 'CO_OH_M ', & + 'CH2O_NO3 ', 'CH2O_OH ', & + 'CH2O_O ', 'CH3O2_NO ', & + 'CH3O2_HO2 ', 'CH3OOH_OH ', & + 'usr_N2O5_aer ', 'usr_NO3_aer ', & + 'usr_NO2_aer ', 'usr_HO2_aer ', & + 'OCS_O ', 'OCS_OH ', & + 'S_OH ', 'S_O2 ', & + 'S_O3 ', 'SO_OH ', & + 'SO_O2 ', 'SO_O3 ', & + 'SO_NO2 ', 'SO_CLO ', & + 'SO_BRO ', 'SO_OCLO ', & + 'usr_SO2_OH ', 'usr_SO3_H2O ', & + 'usr_DMS_OH ', 'DMS_OHb ', & + 'DMS_NO3 ', 'het1 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'ion_Op_O2 ', 'ion_Op_N2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Op_CO2 ', 'ion_O2p_N ', & + 'ion_O2p_NO ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_Np_O ', & + 'ion_N2p_O2 ', 'ion_O2p_N2 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ean1 ', & + 'ean2 ', 'ean3 ', & + 'rpe1 ', 'rpe2 ', & + 'rpe3 ', 'rpe4 ', & + 'rpe5 ', 'pir1 ', & + 'pir2 ', 'pir3 ', & + 'pir4 ', 'pir5 ', & + 'pir6 ', 'pir7 ', & + 'pir8 ', 'pir9 ', & + 'pir10 ', 'pir11 ', & + 'pir12 ', 'pir13 ', & + 'pir14 ', 'pir15 ', & + 'pir16 ', 'edn1 ', & + 'edn2 ', 'nir1 ', & + 'nir2 ', 'nir3 ', & + 'nir4 ', 'nir5 ', & + 'nir6 ', 'usr_CLm_H2O_M ', & + 'usr_CLm_HCL_M ', 'nir7 ', & + 'nir8 ', 'nir9 ', & + 'nir10 ', 'nir11 ', & + 'nir12 ', 'nir13 ', & + 'iira1 ', 'iira2 ', & + 'iira3 ', 'iira4 ', & + 'iira5 ', 'iira6 ', & + 'iira7 ', 'iira8 ', & + 'iira9 ', 'iira10 ', & + 'iira11 ', 'iira12 ', & + 'iira13 ', 'iira14 ', & + 'iira15 ', 'iira16 ', & + 'iira17 ', 'iira18 ', & + 'iira19 ', 'iira20 ', & + 'iira21 ', 'iira22 ', & + 'iira23 ', 'iira24 ', & + 'iira25 ', 'iira26 ', & + 'iira27 ', 'iira28 ', & + 'iira29 ', 'iira30 ', & + 'iira31 ', 'iira32 ', & + 'iira33 ', 'iira34 ', & + 'iira35 ', 'iira36 ', & + 'iira37 ', 'iira38 ', & + 'iira39 ', 'iira40 ', & + 'iira41 ', 'iira42 ', & + 'iira43 ', 'iira44 ', & + 'iira45 ', 'iira46 ' /) + rxt_tag_lst( 401: 480) = (/ 'iira47 ', 'iira48 ', & + 'iira49 ', 'iira50 ', & + 'iira51 ', 'iira52 ', & + 'iira53 ', 'iira54 ', & + 'iira55 ', 'iira56 ', & + 'iira57 ', 'iira58 ', & + 'iira59 ', 'iira60 ', & + 'iira61 ', 'iira62 ', & + 'iira63 ', 'iira64 ', & + 'iira65 ', 'iira66 ', & + 'iira67 ', 'iira68 ', & + 'iira69 ', 'iira70 ', & + 'iira71 ', 'iira72 ', & + 'iira73 ', 'iira74 ', & + 'iira75 ', 'iira76 ', & + 'iira77 ', 'iira78 ', & + 'iira79 ', 'iira80 ', & + 'iira81 ', 'iira82 ', & + 'iira83 ', 'iira84 ', & + 'iira85 ', 'iira86 ', & + 'iira87 ', 'iira88 ', & + 'iira89 ', 'iira90 ', & + 'iira91 ', 'iira92 ', & + 'iira93 ', 'iira94 ', & + 'iira95 ', 'iira96 ', & + 'iira97 ', 'iira98 ', & + 'iira99 ', 'iira100 ', & + 'iira101 ', 'iira102 ', & + 'iira103 ', 'iira104 ', & + 'iira105 ', 'iira106 ', & + 'iira107 ', 'iira108 ', & + 'iira109 ', 'iira110 ', & + 'iira111 ', 'iira112 ', & + 'iirb1 ', 'iirb2 ', & + 'iirb3 ', 'iirb4 ', & + 'iirb5 ', 'iirb6 ', & + 'iirb7 ', 'iirb8 ', & + 'iirb9 ', 'iirb10 ', & + 'iirb11 ', 'iirb12 ', & + 'iirb13 ', 'iirb14 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 324, 325, 326, & + 329, 332, 340, 341, 342, 343, 344, 345, 346, 347, & + 352, 353, 357, 360, 361, 362, 363, 365, 371, 399, & + 400, 401, 402, 414, 415, 445, 446, 449, 452, 455, & + 457, 460, 462, 465, 468, 469, 470, 471, 472, 473, & + 474, 475, 476, 477, 478, 479, 480, 481, 482, 483, & + 484, 485, 486, 487, 488, 489, 490, 491, 492, 493, & + 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, & + 504, 505, 506, 507, 508, 509, 510, 511, 512, 513, & + 514, 515, 516, 517, 518, 519, 520, 521, 522, 523, & + 524, 525, 526, 527, 528, 529, 530, 531, 532, 533, & + 534, 535, 536, 537, 538, 539, 540, 541, 542, 543, & + 544, 545, 546, 547, 548, 549, 550, 551, 552, 553, & + 554, 555, 556, 557, 558, 559, 560, 561, 562, 563, & + 564, 565, 566, 567, 568, 569, 570, 571, 572, 573, & + 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, & + 584, 585, 586, 587, 588, 589, 590, 591, 592, 593 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 105, 106, 107, 108, 109, & + 110, 111, 114, 115, 116, & + 118, 119, 120, 149, 150, & + 152, 154, 155, 156, 162, & + 163, 164, 168, 169, 171, & + 172, 177, 178, 179, 299, & + 300, 301, 304, 305, 306, & + 307, 308, 309, 311, 312, & + 313 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.910000_r8, 32.910000_r8, 189.810000_r8, 203.400000_r8, 194.710000_r8, & + 232.590000_r8, 67.670000_r8, 165.300000_r8, 293.620000_r8, 226.580000_r8, & + 120.100000_r8, 165.510000_r8, 177.510000_r8, 229.610000_r8, 133.750000_r8, & + 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 3, 2, 3, 2, 3, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, & + 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 2, 2, 2, 3, 2, 3, 2, 3, & + 2, 3, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 3, 2, 2, 3, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 3, 2, 2, 2, 2, & + 2, 2, 3, 3, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 3, 3, 2, 2, 2, 3, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, & + 3, 3, 3, 3, 3, 3, 3, 3, 3 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_sc/chem_mech.doc b/src/chemistry/pp_waccm_sc/chem_mech.doc new file mode 100644 index 0000000000..93d7f5f47b --- /dev/null +++ b/src/chemistry/pp_waccm_sc/chem_mech.doc @@ -0,0 +1,51 @@ + + + Solution species + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 (CFCl3) + ( 4) CFC12 (CF2Cl2) + ( 5) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 + ( 4) CFC12 + ( 5) H2O + + Photolysis + + Reactions + ch4_loss ( 1) CH4 -> 2.*H2O rate = ** User defined ** ( 1) + n2o_loss ( 2) N2O -> (No products) rate = ** User defined ** ( 2) + cfc11_loss ( 3) CFC11 -> (No products) rate = ** User defined ** ( 3) + cfc12_loss ( 4) CFC12 -> (No products) rate = ** User defined ** ( 4) + lyman_alpha ( 5) H2O -> (No products) rate = ** User defined ** ( 5) + +Extraneous prod/loss species + + + Equation Report + + d(CH4)/dt = - r1*CH4 + d(N2O)/dt = - r2*N2O + d(CFC11)/dt = - r3*CFC11 + d(CFC12)/dt = - r4*CFC12 + d(H2O)/dt = 2*r1*CH4 + - r5*H2O diff --git a/src/chemistry/pp_waccm_sc/chem_mech.in b/src/chemistry/pp_waccm_sc/chem_mech.in new file mode 100644 index 0000000000..d20671a259 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/chem_mech.in @@ -0,0 +1,57 @@ + SPECIES + + Solution + CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2, H2O + End Solution + + Fixed + M, N2, O2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + CH4, N2O, CFC11, CFC12, H2O + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + End Photolysis + + Reactions + [ch4_loss] CH4 -> 2.* H2O + [n2o_loss] N2O -> + [cfc11_loss] CFC11 -> + [cfc12_loss] CFC12 -> + [lyman_alpha] H2O -> + End Reactions + + Ext Forcing + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS + + diff --git a/src/chemistry/pp_waccm_sc/chem_mods.F90 b/src/chemistry/pp_waccm_sc/chem_mods.F90 new file mode 100644 index 0000000000..b89c8308f5 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 0, & ! number of photolysis reactions + rxntot = 5, & ! number of total reactions + gascnt = 5, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 5, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 6, & ! number of non-zero matrix entries + extcnt = 0, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 5, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 5, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_sc/m_rxt_id.F90 b/src/chemistry/pp_waccm_sc/m_rxt_id.F90 new file mode 100644 index 0000000000..a2c78d2381 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/m_rxt_id.F90 @@ -0,0 +1,8 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_ch4_loss = 1 + integer, parameter :: rid_n2o_loss = 2 + integer, parameter :: rid_cfc11_loss = 3 + integer, parameter :: rid_cfc12_loss = 4 + integer, parameter :: rid_lyman_alpha = 5 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_sc/m_spc_id.F90 b/src/chemistry/pp_waccm_sc/m_spc_id.F90 new file mode 100644 index 0000000000..1a2625b12d --- /dev/null +++ b/src/chemistry/pp_waccm_sc/m_spc_id.F90 @@ -0,0 +1,8 @@ + module m_spc_id + implicit none + integer, parameter :: id_CH4 = 1 + integer, parameter :: id_N2O = 2 + integer, parameter :: id_CFC11 = 3 + integer, parameter :: id_CFC12 = 4 + integer, parameter :: id_H2O = 5 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_sc/mo_adjrxt.F90 b/src/chemistry/pp_waccm_sc/mo_adjrxt.F90 new file mode 100644 index 0000000000..94f2dcce83 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_adjrxt.F90 @@ -0,0 +1,17 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_sc/mo_exp_sol.F90 b/src/chemistry/pp_waccm_sc/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 b/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_sc/mo_indprd.F90 b/src/chemistry/pp_waccm_sc/mo_indprd.F90 new file mode 100644 index 0000000000..de6a52e4d1 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_indprd.F90 @@ -0,0 +1,31 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 new file mode 100644 index 0000000000..38a2e6094a --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_lin_matrix.F90 @@ -0,0 +1,42 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(1) + het_rates(1) ) + mat(3) = -( rxt(2) + het_rates(2) ) + mat(4) = -( rxt(3) + het_rates(3) ) + mat(5) = -( rxt(4) + het_rates(4) ) + mat(6) = -( rxt(5) + het_rates(5) ) + mat(2) = 2.000_r8*rxt(1) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_sc/mo_lu_factor.F90 b/src/chemistry/pp_waccm_sc/mo_lu_factor.F90 new file mode 100644 index 0000000000..93c12c312a --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_lu_factor.F90 @@ -0,0 +1,28 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_sc/mo_lu_solve.F90 b/src/chemistry/pp_waccm_sc/mo_lu_solve.F90 new file mode 100644 index 0000000000..9edb11193c --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_lu_solve.F90 @@ -0,0 +1,58 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(5) = b(5) - lu(2) * b(1) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(5) = b(5) * lu(6) + b(4) = b(4) * lu(5) + b(3) = b(3) * lu(4) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 new file mode 100644 index 0000000000..cad55bf083 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_nln_matrix.F90 @@ -0,0 +1,46 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_sc/mo_phtadj.F90 b/src/chemistry/pp_waccm_sc/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_sc/mo_prod_loss.F90 b/src/chemistry/pp_waccm_sc/mo_prod_loss.F90 new file mode 100644 index 0000000000..015d5e6d60 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_prod_loss.F90 @@ -0,0 +1,46 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(1) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + rxt(2) + het_rates(2))* y(2) + prod(2) = 0._r8 + loss(3) = ( + rxt(3) + het_rates(3))* y(3) + prod(3) = 0._r8 + loss(4) = ( + rxt(4) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(5) + het_rates(5))* y(5) + prod(5) =2.000_r8*rxt(1)*y(1) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_sc/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_sc/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e6c98049bf --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_rxt_rates_conv.F90 @@ -0,0 +1,17 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 1) ! rate_const*CH4 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*N2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*CFC11 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 4) ! rate_const*CFC12 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*H2O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_sc/mo_setrxt.F90 b/src/chemistry/pp_waccm_sc/mo_setrxt.F90 new file mode 100644 index 0000000000..a82675a8be --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_setrxt.F90 @@ -0,0 +1,52 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 b/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 new file mode 100644 index 0000000000..d551c4eab8 --- /dev/null +++ b/src/chemistry/pp_waccm_sc/mo_sim_dat.F90 @@ -0,0 +1,83 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 5, 0 /) + + cls_rxt_cnt(:,4) = (/ 0, 5, 0, 5 /) + + solsym(: 5) = (/ 'CH4 ','N2O ','CFC11 ','CFC12 ','H2O ' /) + + adv_mass(: 5) = (/ 16.040600_r8, 44.012880_r8, 137.367503_r8, 120.913206_r8, 18.014200_r8 /) + + crb_mass(: 5) = (/ 12.011000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8 /) + + clsmap(: 5,4) = (/ 1, 2, 3, 4, 5 /) + + permute(: 5,4) = (/ 1, 2, 3, 4, 5 /) + + diag_map(: 5) = (/ 1, 3, 4, 5, 6 /) + + inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 5) = (/ 'ch4_loss ', 'n2o_loss ', & + 'cfc11_loss ', 'cfc12_loss ', & + 'lyman_alpha ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc b/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc new file mode 100644 index 0000000000..da0749a30d --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc @@ -0,0 +1,148 @@ + + + Solution species + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 (CFCl3) + ( 4) CFC12 (CF2Cl2) + ( 5) H2O2 + ( 6) H2SO4 + ( 7) SO2 + ( 8) DMS (CH3SCH3) + ( 9) SOAG (C) + ( 10) so4_a1 (NH4HSO4) + ( 11) pom_a1 (C) + ( 12) soa_a1 (C) + ( 13) bc_a1 (C) + ( 14) dst_a1 (AlSiO5) + ( 15) ncl_a1 (NaCl) + ( 16) num_a1 (H) + ( 17) so4_a2 (NH4HSO4) + ( 18) soa_a2 (C) + ( 19) ncl_a2 (NaCl) + ( 20) num_a2 (H) + ( 21) dst_a2 (AlSiO5) + ( 22) dst_a3 (AlSiO5) + ( 23) ncl_a3 (NaCl) + ( 24) so4_a3 (NH4HSO4) + ( 25) num_a3 (H) + ( 26) pom_a4 (C) + ( 27) bc_a4 (C) + ( 28) num_a4 (H) + ( 29) H2O + + + Invariant species + ( 1) M + ( 2) N2 + ( 3) O2 + ( 4) O3 + ( 5) OH + ( 6) NO3 + ( 7) HO2 + ( 8) HALONS + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CFC11 + ( 4) CFC12 + ( 5) H2O + ( 6) H2O2 + ( 7) H2SO4 + ( 8) SO2 + ( 9) DMS + ( 10) SOAG + ( 11) so4_a1 + ( 12) pom_a1 + ( 13) soa_a1 + ( 14) bc_a1 + ( 15) dst_a1 + ( 16) ncl_a1 + ( 17) num_a1 + ( 18) so4_a2 + ( 19) soa_a2 + ( 20) ncl_a2 + ( 21) num_a2 + ( 22) dst_a2 + ( 23) dst_a3 + ( 24) ncl_a3 + ( 25) so4_a3 + ( 26) num_a3 + ( 27) pom_a4 + ( 28) bc_a4 + ( 29) num_a4 + + Photolysis + jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + + Reactions + ch4_loss ( 1) CH4 -> 2.*H2O rate = ** User defined ** ( 2) + n2o_loss ( 2) N2O -> (No products) rate = ** User defined ** ( 3) + cfc11_loss ( 3) CFC11 -> (No products) rate = ** User defined ** ( 4) + cfc12_loss ( 4) CFC12 -> (No products) rate = ** User defined ** ( 5) + lyman_alpha ( 5) H2O -> (No products) rate = ** User defined ** ( 6) + usr_HO2_HO2 ( 6) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 7) + ( 7) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 8) + usr_SO2_OH ( 8) SO2 + OH -> H2SO4 rate = ** User defined ** ( 9) + ( 9) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 10) + usr_DMS_OH ( 10) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 11) + ( 11) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 12) + +Extraneous prod/loss species + ( 1) SO2 (dataset) + ( 2) so4_a1 (dataset) + ( 3) so4_a2 (dataset) + ( 4) pom_a1 (dataset) + ( 5) pom_a4 (dataset) + ( 6) bc_a1 (dataset) + ( 7) bc_a4 (dataset) + ( 8) num_a1 (dataset) + ( 9) num_a2 (dataset) + (10) num_a4 (dataset) + (11) H2O (dataset) + + + Equation Report + + d(CH4)/dt = - r1*CH4 + d(N2O)/dt = - r2*N2O + d(CFC11)/dt = - r3*CFC11 + d(CFC12)/dt = - r4*CFC12 + d(H2O2)/dt = r6 + - j1*H2O2 - r7*OH*H2O2 + d(H2SO4)/dt = r8*OH*SO2 + d(SO2)/dt = r9*OH*DMS + .5*r10*OH*DMS + r11*NO3*DMS + - r8*OH*SO2 + d(DMS)/dt = - r9*OH*DMS - r10*OH*DMS - r11*NO3*DMS + d(SOAG)/dt = 0 + d(so4_a1)/dt = 0 + d(pom_a1)/dt = 0 + d(soa_a1)/dt = 0 + d(bc_a1)/dt = 0 + d(dst_a1)/dt = 0 + d(ncl_a1)/dt = 0 + d(num_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(soa_a2)/dt = 0 + d(ncl_a2)/dt = 0 + d(num_a2)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(ncl_a3)/dt = 0 + d(so4_a3)/dt = 0 + d(num_a3)/dt = 0 + d(pom_a4)/dt = 0 + d(bc_a4)/dt = 0 + d(num_a4)/dt = 0 + d(H2O)/dt = 2*r1*CH4 + r7*OH*H2O2 + - r5*H2O diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mech.in b/src/chemistry/pp_waccm_sc_mam4/chem_mech.in new file mode 100644 index 0000000000..927087dff1 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mech.in @@ -0,0 +1,98 @@ + + SPECIES + + Solution + CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2 + H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C + so4_a1 -> NH4HSO4 + pom_a1 -> C, soa_a1 -> C, bc_a1 -> C + dst_a1 -> AlSiO5, ncl_a1 -> NaCl + num_a1 -> H + so4_a2 -> NH4HSO4 + soa_a2 -> C, ncl_a2 -> NaCl + num_a2 -> H + dst_a2 -> AlSiO5 + dst_a3 -> AlSiO5, ncl_a3 -> NaCl + so4_a3 -> NH4HSO4 + num_a3 -> H + pom_a4 -> C, bc_a4 -> C + num_a4 -> H + H2O + End Solution + + Fixed + M, N2, O2, O3, OH, NO3, HO2, HALONS->CFCl3 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + End SPECIES + + Solution Classes + Explicit + End Explicit + Implicit + CH4, N2O, CFC11, CFC12, H2O + H2O2, H2SO4, SO2, DMS, SOAG + so4_a1, pom_a1 + soa_a1, bc_a1, dst_a1, ncl_a1 + num_a1 + so4_a2, soa_a2, ncl_a2, num_a2 + dst_a2 + dst_a3, ncl_a3, so4_a3, num_a3 + pom_a4, bc_a4, num_a4 + End Implicit + End Solution Classes + + CHEMISTRY + Photolysis + [jh2o2] H2O2 + hv -> + End Photolysis + + Reactions + [ch4_loss] CH4 -> 2.* H2O + [n2o_loss] N2O -> + [cfc11_loss] CFC11 -> + [cfc12_loss] CFC12 -> + [lyman_alpha] H2O -> + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + [usr_SO2_OH] SO2 + OH -> H2SO4 + DMS + OH -> SO2 ; 9.6e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + End Reactions + + Ext Forcing + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + H2O <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS + diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 new file mode 100644 index 0000000000..f75b1c9a8a --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 1, & ! number of photolysis reactions + rxntot = 12, & ! number of total reactions + gascnt = 11, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 29, & ! number of "gas phase" species + nfs = 8, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 33, & ! number of non-zero matrix entries + extcnt = 11, & ! number of species with external forcing + clscnt1 = 0, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 29, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 9, & + enthalpy_cnt = 0, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..d1114dd177 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 @@ -0,0 +1,15 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_ch4_loss = 2 + integer, parameter :: rid_n2o_loss = 3 + integer, parameter :: rid_cfc11_loss = 4 + integer, parameter :: rid_cfc12_loss = 5 + integer, parameter :: rid_lyman_alpha = 6 + integer, parameter :: rid_usr_HO2_HO2 = 7 + integer, parameter :: rid_usr_SO2_OH = 9 + integer, parameter :: rid_usr_DMS_OH = 11 + integer, parameter :: rid_r0008 = 8 + integer, parameter :: rid_r0010 = 10 + integer, parameter :: rid_r0012 = 12 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..091e8d3969 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 @@ -0,0 +1,32 @@ + module m_spc_id + implicit none + integer, parameter :: id_CH4 = 1 + integer, parameter :: id_N2O = 2 + integer, parameter :: id_CFC11 = 3 + integer, parameter :: id_CFC12 = 4 + integer, parameter :: id_H2O2 = 5 + integer, parameter :: id_H2SO4 = 6 + integer, parameter :: id_SO2 = 7 + integer, parameter :: id_DMS = 8 + integer, parameter :: id_SOAG = 9 + integer, parameter :: id_so4_a1 = 10 + integer, parameter :: id_pom_a1 = 11 + integer, parameter :: id_soa_a1 = 12 + integer, parameter :: id_bc_a1 = 13 + integer, parameter :: id_dst_a1 = 14 + integer, parameter :: id_ncl_a1 = 15 + integer, parameter :: id_num_a1 = 16 + integer, parameter :: id_so4_a2 = 17 + integer, parameter :: id_soa_a2 = 18 + integer, parameter :: id_ncl_a2 = 19 + integer, parameter :: id_num_a2 = 20 + integer, parameter :: id_dst_a2 = 21 + integer, parameter :: id_dst_a3 = 22 + integer, parameter :: id_ncl_a3 = 23 + integer, parameter :: id_so4_a3 = 24 + integer, parameter :: id_num_a3 = 25 + integer, parameter :: id_pom_a4 = 26 + integer, parameter :: id_bc_a4 = 27 + integer, parameter :: id_num_a4 = 28 + integer, parameter :: id_H2O = 29 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..e1c3fe9281 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 @@ -0,0 +1,28 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 8) = rate(:,:, 8) * inv(:,:, 5) + rate(:,:, 9) = rate(:,:, 9) * inv(:,:, 5) + rate(:,:, 10) = rate(:,:, 10) * inv(:,:, 5) + rate(:,:, 11) = rate(:,:, 11) * inv(:,:, 5) + rate(:,:, 12) = rate(:,:, 12) * inv(:,:, 6) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..9a8ee552e7 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 @@ -0,0 +1,55 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = + extfrc(:,:,11) + prod(:,:,6) =rxt(:,:,7) + prod(:,:,7) = 0._r8 + prod(:,:,8) = + extfrc(:,:,1) + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = + extfrc(:,:,2) + prod(:,:,12) = + extfrc(:,:,4) + prod(:,:,13) = 0._r8 + prod(:,:,14) = + extfrc(:,:,6) + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = + extfrc(:,:,8) + prod(:,:,18) = + extfrc(:,:,3) + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = + extfrc(:,:,9) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = + extfrc(:,:,5) + prod(:,:,28) = + extfrc(:,:,7) + prod(:,:,29) = + extfrc(:,:,10) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..e42386a02a --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 @@ -0,0 +1,69 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( rxt(2) + het_rates(1) ) + mat(3) = -( rxt(3) + het_rates(2) ) + mat(4) = -( rxt(4) + het_rates(3) ) + mat(5) = -( rxt(5) + het_rates(4) ) + mat(6) = -( rxt(6) + het_rates(29) ) + mat(2) = 2.000_r8*rxt(2) + mat(7) = rxt(8) + mat(8) = -( rxt(1) + rxt(8) + het_rates(5) ) + mat(9) = -( het_rates(6) ) + mat(10) = rxt(9) + mat(11) = -( rxt(9) + het_rates(7) ) + mat(12) = rxt(10) + .500_r8*rxt(11) + rxt(12) + mat(13) = -( rxt(10) + rxt(11) + rxt(12) + het_rates(8) ) + mat(14) = -( het_rates(9) ) + mat(15) = -( het_rates(10) ) + mat(16) = -( het_rates(11) ) + mat(17) = -( het_rates(12) ) + mat(18) = -( het_rates(13) ) + mat(19) = -( het_rates(14) ) + mat(20) = -( het_rates(15) ) + mat(21) = -( het_rates(16) ) + mat(22) = -( het_rates(17) ) + mat(23) = -( het_rates(18) ) + mat(24) = -( het_rates(19) ) + mat(25) = -( het_rates(20) ) + mat(26) = -( het_rates(21) ) + mat(27) = -( het_rates(22) ) + mat(28) = -( het_rates(23) ) + mat(29) = -( het_rates(24) ) + mat(30) = -( het_rates(25) ) + mat(31) = -( het_rates(26) ) + mat(32) = -( het_rates(27) ) + mat(33) = -( het_rates(28) ) + end subroutine linmat01 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..555ac57311 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 @@ -0,0 +1,52 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(11) = 1._r8 / lu(11) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(25) = 1._r8 / lu(25) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) + lu(31) = 1._r8 / lu(31) + lu(32) = 1._r8 / lu(32) + lu(33) = 1._r8 / lu(33) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..cc7266ce23 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 @@ -0,0 +1,85 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(5) = b(5) - lu(2) * b(1) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(29) = b(29) * lu(33) + b(28) = b(28) * lu(32) + b(27) = b(27) * lu(31) + b(26) = b(26) * lu(30) + b(25) = b(25) * lu(29) + b(24) = b(24) * lu(28) + b(23) = b(23) * lu(27) + b(22) = b(22) * lu(26) + b(21) = b(21) * lu(25) + b(20) = b(20) * lu(24) + b(19) = b(19) * lu(23) + b(18) = b(18) * lu(22) + b(17) = b(17) * lu(21) + b(16) = b(16) * lu(20) + b(15) = b(15) * lu(19) + b(14) = b(14) * lu(18) + b(13) = b(13) * lu(17) + b(12) = b(12) * lu(16) + b(11) = b(11) * lu(15) + b(10) = b(10) * lu(14) + b(9) = b(9) * lu(13) + b(8) = b(8) - lu(12) * b(9) + b(8) = b(8) * lu(11) + b(7) = b(7) - lu(10) * b(8) + b(7) = b(7) * lu(9) + b(6) = b(6) * lu(8) + b(5) = b(5) - lu(7) * b(6) + b(5) = b(5) * lu(6) + b(4) = b(4) * lu(5) + b(3) = b(3) * lu(4) + b(2) = b(2) * lu(3) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..1606ff3b72 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 @@ -0,0 +1,97 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = lmat( 33) + mat( 1) = mat( 1) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 11) = mat( 11) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 25) = mat( 25) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti + mat( 31) = mat( 31) - dti + mat( 32) = mat( 32) - dti + mat( 33) = mat( 33) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_phtadj.F90 @@ -0,0 +1,24 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..01b921b8c1 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 @@ -0,0 +1,94 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + rxt(2) + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + rxt(3) + het_rates(2))* y(2) + prod(2) = 0._r8 + loss(3) = ( + rxt(4) + het_rates(3))* y(3) + prod(3) = 0._r8 + loss(4) = ( + rxt(5) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(6) + het_rates(29))* y(29) + prod(5) =2.000_r8*rxt(2)*y(1) +rxt(8)*y(5) + loss(6) = ( + rxt(1) + rxt(8) + het_rates(5))* y(5) + prod(6) = 0._r8 + loss(7) = ( + het_rates(6))* y(6) + prod(7) =rxt(9)*y(7) + loss(8) = ( + rxt(9) + het_rates(7))* y(7) + prod(8) = (rxt(10) +.500_r8*rxt(11) +rxt(12))*y(8) + loss(9) = ( + rxt(10) + rxt(11) + rxt(12) + het_rates(8))* y(8) + prod(9) = 0._r8 + loss(10) = ( + het_rates(9))* y(9) + prod(10) = 0._r8 + loss(11) = ( + het_rates(10))* y(10) + prod(11) = 0._r8 + loss(12) = ( + het_rates(11))* y(11) + prod(12) = 0._r8 + loss(13) = ( + het_rates(12))* y(12) + prod(13) = 0._r8 + loss(14) = ( + het_rates(13))* y(13) + prod(14) = 0._r8 + loss(15) = ( + het_rates(14))* y(14) + prod(15) = 0._r8 + loss(16) = ( + het_rates(15))* y(15) + prod(16) = 0._r8 + loss(17) = ( + het_rates(16))* y(16) + prod(17) = 0._r8 + loss(18) = ( + het_rates(17))* y(17) + prod(18) = 0._r8 + loss(19) = ( + het_rates(18))* y(18) + prod(19) = 0._r8 + loss(20) = ( + het_rates(19))* y(19) + prod(20) = 0._r8 + loss(21) = ( + het_rates(20))* y(20) + prod(21) = 0._r8 + loss(22) = ( + het_rates(21))* y(21) + prod(22) = 0._r8 + loss(23) = ( + het_rates(22))* y(22) + prod(23) = 0._r8 + loss(24) = ( + het_rates(23))* y(23) + prod(24) = 0._r8 + loss(25) = ( + het_rates(24))* y(24) + prod(25) = 0._r8 + loss(26) = ( + het_rates(25))* y(25) + prod(26) = 0._r8 + loss(27) = ( + het_rates(26))* y(26) + prod(27) = 0._r8 + loss(28) = ( + het_rates(27))* y(27) + prod(28) = 0._r8 + loss(29) = ( + het_rates(28))* y(28) + prod(29) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..2ba4ae7b40 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,24 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 5) ! rate_const*H2O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*CH4 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 2) ! rate_const*N2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*CFC11 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*CFC12 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 29) ! rate_const*H2O + ! rate_const + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 5) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 7) ! rate_const*OH*SO2 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 8) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 8) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 8) ! rate_const*NO3*DMS + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..b649fc0d19 --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 @@ -0,0 +1,73 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,8) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) + rate(:,:,10) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,12) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..314b969a9e --- /dev/null +++ b/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 @@ -0,0 +1,137 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 0, 0, 0, 29, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 11, 0, 29 /) + + solsym(: 29) = (/ 'CH4 ','N2O ','CFC11 ','CFC12 ','H2O2 ', & + 'H2SO4 ','SO2 ','DMS ','SOAG ','so4_a1 ', & + 'pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ','ncl_a1 ', & + 'num_a1 ','so4_a2 ','soa_a2 ','ncl_a2 ','num_a2 ', & + 'dst_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ','num_a3 ', & + 'pom_a4 ','bc_a4 ','num_a4 ','H2O ' /) + + adv_mass(: 29) = (/ 16.040600_r8, 44.012880_r8, 137.367503_r8, 120.913206_r8, 34.013600_r8, & + 98.078400_r8, 64.064800_r8, 62.132400_r8, 12.011000_r8, 115.107340_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, 58.442468_r8, & + 1.007400_r8, 115.107340_r8, 12.011000_r8, 58.442468_r8, 1.007400_r8, & + 135.064039_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 1.007400_r8, 18.014200_r8 /) + + crb_mass(: 29) = (/ 12.011000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 8) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & + 62.0049400_r8, 33.0062000_r8, 137.367503_r8 /) + + clsmap(: 29,4) = (/ 1, 2, 3, 4, 29, 5, 6, 7, 8, 9, & + 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, & + 20, 21, 22, 23, 24, 25, 26, 27, 28 /) + + permute(: 29,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29 /) + + diag_map(: 29) = (/ 1, 3, 4, 5, 6, 8, 9, 11, 13, 14, & + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, & + 25, 26, 27, 28, 29, 30, 31, 32, 33 /) + + extfrc_lst(: 11) = (/ 'SO2 ','so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ', & + 'bc_a1 ','bc_a4 ','num_a1 ','num_a2 ','num_a4 ', & + 'H2O ' /) + + frc_from_dataset(: 11) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true. /) + + inv_lst(: 8) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & + 'NO3 ', 'HO2 ', 'HALONS ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 9) = (/ 'jh2o2 ', 'ch4_loss ', & + 'n2o_loss ', 'cfc11_loss ', & + 'cfc12_loss ', 'lyman_alpha ', & + 'usr_HO2_HO2 ', 'usr_SO2_OH ', & + 'usr_DMS_OH ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 9, 11 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ' /) + pht_alias_lst(:,2) = (/ ' ' /) + pht_alias_mult(:,1) = (/ 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, & + 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt/chem_mech.doc new file mode 100644 index 0000000000..778385892e --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/chem_mech.doc @@ -0,0 +1,1433 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O1D (O) + ( 4) O2 + ( 5) O2_1S (O2) + ( 6) O2_1D (O2) + ( 7) N2O + ( 8) N + ( 9) NO + ( 10) NO2 + ( 11) NO3 + ( 12) HNO3 + ( 13) HO2NO2 + ( 14) N2O5 + ( 15) CH4 + ( 16) CH3O2 + ( 17) CH3OOH + ( 18) CH3OH + ( 19) CH2O + ( 20) CO + ( 21) H2 + ( 22) H + ( 23) OH + ( 24) HO2 + ( 25) H2O2 + ( 26) CLY + ( 27) BRY + ( 28) CL (Cl) + ( 29) CL2 (Cl2) + ( 30) CLO (ClO) + ( 31) OCLO (OClO) + ( 32) CL2O2 (Cl2O2) + ( 33) HCL (HCl) + ( 34) HOCL (HOCl) + ( 35) CLONO2 (ClONO2) + ( 36) BRCL (BrCl) + ( 37) BR (Br) + ( 38) BRO (BrO) + ( 39) HBR (HBr) + ( 40) HOBR (HOBr) + ( 41) BRONO2 (BrONO2) + ( 42) HCN + ( 43) CH3CN + ( 44) C2H4 + ( 45) C2H6 + ( 46) C2H5O2 + ( 47) C2H5OOH + ( 48) CH3CO3 + ( 49) CH3COOH + ( 50) CH3CHO + ( 51) C2H5OH + ( 52) GLYALD (HOCH2CHO) + ( 53) GLYOXAL (C2H2O2) + ( 54) CH3COOOH + ( 55) EO2 (HOCH2CH2O2) + ( 56) EO (HOCH2CH2O) + ( 57) EOOH (HOCH2CH2OOH) + ( 58) PAN (CH3CO3NO2) + ( 59) C3H6 + ( 60) C3H8 + ( 61) C3H7O2 + ( 62) C3H7OOH + ( 63) CH3COCH3 + ( 64) PO2 (C3H6OHO2) + ( 65) POOH (C3H6OHOOH) + ( 66) HYAC (CH3COCH2OH) + ( 67) RO2 (CH3COCH2O2) + ( 68) CH3COCHO + ( 69) ROOH (CH3COCH2OOH) + ( 70) BIGENE (C4H8) + ( 71) BIGALK (C5H12) + ( 72) MEK (C4H8O) + ( 73) ENEO2 (C4H9O3) + ( 74) MEKO2 (C4H7O3) + ( 75) MEKOOH (C4H8O3) + ( 76) MCO3 (CH2CCH3CO3) + ( 77) MVK (CH2CHCOCH3) + ( 78) MACR (CH2CCH3CHO) + ( 79) MACRO2 (CH3COCHO2CH2OH) + ( 80) MACROOH (CH3COCHOOHCH2OH) + ( 81) MPAN (CH2CCH3CO3NO2) + ( 82) ONIT (CH3COCH2ONO2) + ( 83) ISOP (C5H8) + ( 84) ALKO2 (C5H11O2) + ( 85) ALKOOH (C5H12O2) + ( 86) BIGALD (C5H6O2) + ( 87) HYDRALD (HOCH2CCH3CHCHO) + ( 88) ISOPO2 (HOCH2COOCH3CHCH2) + ( 89) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 90) ONITR (CH2CCH3CHONO2CH2OH) + ( 91) XO2 (HOCH2COOCH3CHOHCHO) + ( 92) XOOH (HOCH2COOHCH3CHOHCHO) + ( 93) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 94) TOLUENE (C7H8) + ( 95) CRESOL (C7H8O) + ( 96) TOLO2 (C7H9O5) + ( 97) TOLOOH (C7H10O5) + ( 98) XOH (C7H10O6) + ( 99) BENZENE (C6H6) + (100) BENO2 (C6H7O3) + (101) BENOOH (C6H8O3) + (102) XYLENE (C8H10) + (103) XYLO2 (C8H11O3) + (104) XYLOOH (C8H12O3) + (105) C10H16 + (106) TERPO2 (C10H17O3) + (107) TERPOOH (C10H18O3) + (108) CH3CL (CH3Cl) + (109) CH3BR (CH3Br) + (110) CFC11 (CFCl3) + (111) CFC12 (CF2Cl2) + (112) CFC113 (CCl2FCClF2) + (113) HCFC22 (CHF2Cl) + (114) CCL4 (CCl4) + (115) CH3CCL3 (CH3CCl3) + (116) CF3BR (CF3Br) + (117) CF2CLBR (CF2ClBr) + (118) HCFC141B (CH3CCl2F) + (119) HCFC142B (CH3CClF2) + (120) CFC114 (CClF2CClF2) + (121) CFC115 (CClF2CF3) + (122) H1202 (CBr2F2) + (123) H2402 (CBrF2CBrF2) + (124) CHBR3 (CHBr3) + (125) CH2BR2 (CH2Br2) + (126) CO2 + (127) N2p (N2) + (128) O2p (O2) + (129) Np (N) + (130) Op (O) + (131) NOp (NO) + (132) e (E) + (133) N2D (N) + (134) H2O + (135) C2H2 + (136) HCOOH + (137) HOCH2OO + (138) COF2 + (139) COFCL (COFCl) + (140) HF + (141) F + (142) CB1 (C) + (143) CB2 (C) + (144) OC1 (C) + (145) OC2 (C) + (146) SOAM (C10H16O4) + (147) SOAI (CH3C4H9O4) + (148) SOAT (C7H9O3) + (149) SOAB (C6H7O3) + (150) SOAX (C8H11O3) + (151) SOGM (C10H16O4) + (152) SOGI (CH3C4H9O4) + (153) SOGT (C7H9O3) + (154) SOGB (C6H7O3) + (155) SOGX (C8H11O3) + (156) SO2 + (157) DMS (CH3SCH3) + (158) SO4 + (159) NH3 + (160) NH4 + (161) NH4NO3 + (162) SSLT01 (NaCl) + (163) SSLT02 (NaCl) + (164) SSLT03 (NaCl) + (165) SSLT04 (NaCl) + (166) DST01 (AlSiO5) + (167) DST02 (AlSiO5) + (168) DST03 (AlSiO5) + (169) DST04 (AlSiO5) + (170) NH_5 (CO) + (171) NH_50 (CO) + (172) NH_50W (CO) + (173) AOA_NH (CO) + (174) ST80_25 (CO) + (175) CO_25 (CO) + (176) CO_50 (CO) + (177) SO2t (SO2) + (178) SF6 + (179) SF6em (SF6) + (180) O3S (O3) + (181) E90 (CO) + (182) E90_NH (CO) + (183) E90_SH (CO) + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) O3S + ( 2) CH4 + ( 3) N2O + ( 4) CH3CL + ( 5) CH3BR + ( 6) CFC11 + ( 7) CFC12 + ( 8) CFC113 + ( 9) CFC114 + ( 10) CFC115 + ( 11) HCFC22 + ( 12) HCFC141B + ( 13) HCFC142B + ( 14) CCL4 + ( 15) CH3CCL3 + ( 16) CF3BR + ( 17) CF2CLBR + ( 18) H1202 + ( 19) H2402 + ( 20) CHBR3 + ( 21) CH2BR2 + ( 22) CO2 + ( 23) CLY + ( 24) BRY + ( 25) E90 + ( 26) E90_NH + ( 27) E90_SH + ( 28) NH_5 + ( 29) NH_50 + ( 30) NH_50W + ( 31) AOA_NH + ( 32) ST80_25 + ( 33) CO_25 + ( 34) CO_50 + ( 35) SO2t + ( 36) SF6 + ( 37) SF6em + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) H2 + ( 8) CO + ( 9) N + ( 10) NO + ( 11) NO2 + ( 12) OH + ( 13) NO3 + ( 14) HNO3 + ( 15) HO2NO2 + ( 16) N2O5 + ( 17) CH3O2 + ( 18) CH3OOH + ( 19) HCN + ( 20) CH3CN + ( 21) CH2O + ( 22) H + ( 23) HO2 + ( 24) H2O2 + ( 25) H2O + ( 26) CL + ( 27) CL2 + ( 28) CLO + ( 29) OCLO + ( 30) CL2O2 + ( 31) HCL + ( 32) HOCL + ( 33) CLONO2 + ( 34) BRCL + ( 35) BR + ( 36) BRO + ( 37) HBR + ( 38) HOBR + ( 39) BRONO2 + ( 40) N2p + ( 41) O2p + ( 42) Np + ( 43) Op + ( 44) NOp + ( 45) N2D + ( 46) e + ( 47) C3H6 + ( 48) ISOP + ( 49) PO2 + ( 50) CH3CHO + ( 51) CH3COOH + ( 52) POOH + ( 53) CH3CO3 + ( 54) CH3COOOH + ( 55) PAN + ( 56) ONIT + ( 57) C2H6 + ( 58) C2H4 + ( 59) BIGALK + ( 60) MPAN + ( 61) BIGENE + ( 62) ENEO2 + ( 63) ALKO2 + ( 64) ALKOOH + ( 65) MEK + ( 66) MEKO2 + ( 67) MEKOOH + ( 68) TOLUENE + ( 69) CRESOL + ( 70) TOLO2 + ( 71) TOLOOH + ( 72) XOH + ( 73) TERPO2 + ( 74) TERPOOH + ( 75) BIGALD + ( 76) GLYOXAL + ( 77) BENZENE + ( 78) BENO2 + ( 79) BENOOH + ( 80) XYLENE + ( 81) XYLO2 + ( 82) XYLOOH + ( 83) ISOPO2 + ( 84) MVK + ( 85) MACR + ( 86) MACRO2 + ( 87) MACROOH + ( 88) MCO3 + ( 89) C2H5O2 + ( 90) C2H5OOH + ( 91) C10H16 + ( 92) C3H8 + ( 93) C3H7O2 + ( 94) C3H7OOH + ( 95) CH3COCH3 + ( 96) ROOH + ( 97) CH3OH + ( 98) C2H5OH + ( 99) GLYALD + (100) HYAC + (101) EO2 + (102) EO + (103) EOOH + (104) HYDRALD + (105) RO2 + (106) CH3COCHO + (107) ISOPNO3 + (108) ONITR + (109) XO2 + (110) XOOH + (111) ISOPOOH + (112) C2H2 + (113) HCOOH + (114) HOCH2OO + (115) COF2 + (116) COFCL + (117) HF + (118) F + (119) SO2 + (120) DMS + (121) SO4 + (122) NH3 + (123) NH4 + (124) NH4NO3 + (125) SOAM + (126) SOAI + (127) SOAT + (128) SOAB + (129) SOAX + (130) SOGM + (131) SOGI + (132) SOGT + (133) SOGB + (134) SOGX + (135) CB1 + (136) CB2 + (137) OC1 + (138) OC2 + (139) SSLT01 + (140) SSLT02 + (141) SSLT03 + (142) SSLT04 + (143) DST01 + (144) DST02 + (145) DST03 + (146) DST04 + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> CL + O rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jhbr ( 34) HBR + hv -> BR + H rate = ** User defined ** ( 34) + jbrono2_a ( 35) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 35) + jbrono2_b ( 36) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 36) + jch3cl ( 37) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 37) + jccl4 ( 38) CCL4 + hv -> 4*CL rate = ** User defined ** ( 38) + jch3ccl3 ( 39) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 39) + jcfcl3 ( 40) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 40) + jcf2cl2 ( 41) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 41) + jcfc113 ( 42) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 42) + jcfc114 ( 43) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 43) + jcfc115 ( 44) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 44) + jhcfc22 ( 45) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 45) + jhcfc141b ( 46) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 46) + jhcfc142b ( 47) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 47) + jch3br ( 48) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 48) + jcf3br ( 49) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 49) + jcf2clbr ( 50) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 50) + jchbr3 ( 51) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 51) + jch2br2 ( 52) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 52) + jh1202 ( 53) H1202 + hv -> 2*BR + COF2 rate = ** User defined ** ( 53) + jh2402 ( 54) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 54) + jcof2 ( 55) COF2 + hv -> 2*F rate = ** User defined ** ( 55) + jcofcl ( 56) COFCL + hv -> F + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jco2 ( 58) CO2 + hv -> CO + O rate = ** User defined ** ( 58) + jch4_a ( 59) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 59) + jch4_b ( 60) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 60) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch3cho ( 61) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jch3co3h ( 63) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 63) + jpan ( 64) PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 rate = ** User defined ** ( 64) + jmpan ( 65) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 65) + jmacr_a ( 66) MACR + hv -> 1.34*HO2 + .66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 66) + jmacr_b ( 67) MACR + hv -> .66*HO2 + 1.34*CO rate = ** User defined ** ( 67) + jmvk ( 68) MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 rate = ** User defined ** ( 68) + jc2h5ooh ( 69) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 69) + jeooh ( 70) EOOH + hv -> EO + OH rate = ** User defined ** ( 70) + jc3h7ooh ( 71) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 71) + jrooh ( 72) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 72) + jacet ( 73) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 73) + jmgly ( 74) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 74) + jxooh ( 75) XOOH + hv -> OH rate = ** User defined ** ( 75) + jonitr ( 76) ONITR + hv -> HO2 + CO + NO2 + CH2O rate = ** User defined ** ( 76) + jisopooh ( 77) ISOPOOH + hv -> .402*MVK + .288*MACR + .69*CH2O + HO2 rate = ** User defined ** ( 77) + jhyac ( 78) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 78) + jglyald ( 79) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 79) + jmek ( 80) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 80) + jbigald ( 81) BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 rate = ** User defined ** ( 81) + + .18*CH3COCHO + jglyoxal ( 82) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 82) + jalkooh ( 83) ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK rate = ** User defined ** ( 83) + + OH + jmekooh ( 84) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 84) + jtolooh ( 85) TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD rate = ** User defined ** ( 85) + jterpooh ( 86) TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR rate = ** User defined ** ( 86) + jsf6 ( 87) SF6 + hv -> {sink} rate = ** User defined ** ( 87) + jsf6em ( 88) SF6em + hv -> {sink} rate = ** User defined ** ( 88) + jeuv_1 ( 89) O + hv -> Op + e rate = ** User defined ** ( 89) + jeuv_2 ( 90) O + hv -> Op + e rate = ** User defined ** ( 90) + jeuv_3 ( 91) O + hv -> Op + e rate = ** User defined ** ( 91) + jeuv_4 ( 92) N + hv -> Np + e rate = ** User defined ** ( 92) + jeuv_5 ( 93) O2 + hv -> O2p + e rate = ** User defined ** ( 93) + jeuv_6 ( 94) N2 + hv -> N2p + e rate = ** User defined ** ( 94) + jeuv_7 ( 95) O2 + hv -> O + Op + e rate = ** User defined ** ( 95) + jeuv_8 ( 96) O2 + hv -> O + Op + e rate = ** User defined ** ( 96) + jeuv_9 ( 97) O2 + hv -> O + Op + e rate = ** User defined ** ( 97) + jeuv_10 ( 98) N2 + hv -> N + Np + e rate = ** User defined ** ( 98) + jeuv_11 ( 99) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 99) + jeuv_12 (100) O2 + hv -> 2*O rate = ** User defined ** (100) + jeuv_13 (101) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** (101) + jeuv_14 (102) O + hv -> Op + e rate = ** User defined ** (102) + jeuv_15 (103) O + hv -> Op + e rate = ** User defined ** (103) + jeuv_16 (104) O + hv -> Op + e rate = ** User defined ** (104) + jeuv_17 (105) O2 + hv -> O2p + e rate = ** User defined ** (105) + jeuv_18 (106) N2 + hv -> N2p + e rate = ** User defined ** (106) + jeuv_19 (107) O2 + hv -> O + Op + e rate = ** User defined ** (107) + jeuv_20 (108) O2 + hv -> O + Op + e rate = ** User defined ** (108) + jeuv_21 (109) O2 + hv -> O + Op + e rate = ** User defined ** (109) + jeuv_22 (110) N2 + hv -> N + Np + e rate = ** User defined ** (110) + jeuv_23 (111) N2 + hv -> N2D + Np + e rate = ** User defined ** (111) + jeuv_24 (112) O2 + hv -> 2*O rate = ** User defined ** (112) + jeuv_25 (113) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** (113) + jeuv_26 (114) CO2 + hv -> CO + O rate = ** User defined ** (114) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** (115) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (116) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** (117) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 (118) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (119) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (120) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (121) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (122) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 (123) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (124) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (125) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (126) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 (127) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (128) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) (129) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) (130) + O1D_H2O ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (131) + O1D_N2Oa ( 18) O1D + N2O -> 2*NO rate = 7.25E-11*exp( 20./t) (132) + O1D_N2Ob ( 19) O1D + N2O -> N2 + O2 rate = 4.63E-11*exp( 20./t) (133) + O1D_O3 ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 (134) + O1D_CFC11 ( 21) O1D + CFC11 -> 2*CL + COFCL rate = 2.02E-10 (135) + O1D_CFC12 ( 22) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (136) + O1D_CFC113 ( 23) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 1.50E-10 (137) + O1D_CFC114 ( 24) O1D + CFC114 -> 2*CL + 2*COF2 rate = 9.75E-11 (138) + O1D_CFC115 ( 25) O1D + CFC115 -> CL + F + 2*COF2 rate = 1.50E-11 (139) + O1D_HCFC22 ( 26) O1D + HCFC22 -> CL + COF2 rate = 7.20E-11 (140) + O1D_HCFC141B ( 27) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (141) + O1D_HCFC142B ( 28) O1D + HCFC142B -> CL + COF2 rate = 1.63E-10 (142) + O1D_CCL4 ( 29) O1D + CCL4 -> 4*CL rate = 2.84E-10 (143) + O1D_CH3BR ( 30) O1D + CH3BR -> BR rate = 1.67E-10 (144) + O1D_CF2CLBR ( 31) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.60E-11 (145) + O1D_CF3BR ( 32) O1D + CF3BR -> BR + F + COF2 rate = 4.10E-11 (146) + O1D_H1202 ( 33) O1D + H1202 -> 2*BR + COF2 rate = 1.01E-10 (147) + O1D_H2402 ( 34) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (148) + O1D_CHBR3 ( 35) O1D + CHBR3 -> 3*BR rate = 4.49E-10 (149) + O1D_CH2BR2 ( 36) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (150) + O1D_COF2 ( 37) O1D + COF2 -> 2*F rate = 2.14E-11 (151) + O1D_COFCL ( 38) O1D + COFCL -> F + CL rate = 1.90E-10 (152) + O1D_CH4a ( 39) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (153) + O1D_CH4b ( 40) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (154) + O1D_CH4c ( 41) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (155) + O1D_H2 ( 42) O1D + H2 -> H + OH rate = 1.20E-10 (156) + O1D_HCL ( 43) O1D + HCL -> CL + OH rate = 1.50E-10 (157) + O1D_HBR ( 44) O1D + HBR -> BR + OH rate = 1.20E-10 (158) + O1D_HCN ( 45) O1D + HCN -> OH rate = 7.70E-11*exp( 100./t) (159) + H_O2 ( 46) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (160) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + H_O3 ( 47) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (161) + H_HO2a ( 48) H + HO2 -> 2*OH rate = 7.20E-11 (162) + H_HO2 ( 49) H + HO2 -> H2 + O2 rate = 6.90E-12 (163) + H_HO2b ( 50) H + HO2 -> H2O + O rate = 1.60E-12 (164) + OH_O ( 51) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (165) + OH_O3 ( 52) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (166) + OH_HO2 ( 53) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (167) + OH_OH ( 54) OH + OH -> H2O + O rate = 1.80E-12 (168) + OH_OH_M ( 55) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (169) + ki=2.60E-11 + f=0.60 + OH_H2 ( 56) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (170) + OH_H2O2 ( 57) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (171) + H2_O ( 58) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (172) + HO2_O ( 59) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (173) + HO2_O3 ( 60) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (174) + usr_HO2_HO2 ( 61) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (175) + H2O2_O ( 62) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (176) + HCN_OH ( 63) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (177) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + CH3CN_OH ( 64) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (178) + N2D_O2 ( 65) N2D + O2 -> NO + O1D rate = 5.00E-12 (179) + N2D_O ( 66) N2D + O -> N + O rate = 7.00E-13 (180) + N_OH ( 67) N + OH -> NO + H rate = 5.00E-11 (181) + N_O2 ( 68) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (182) + N_NO ( 69) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (183) + N_NO2a ( 70) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (184) + N_NO2b ( 71) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (185) + N_NO2c ( 72) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (186) + NO_O_M ( 73) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (187) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 74) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (188) + NO_O3 ( 75) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (189) + NO2_O ( 76) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (190) + NO2_O_M ( 77) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (191) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO2_O3 ( 78) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (192) + tag_NO2_NO3 ( 79) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (193) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 80) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (194) + tag_NO2_OH ( 81) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (195) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 82) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (196) + NO3_NO ( 83) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (197) + NO3_O ( 84) NO3 + O -> NO2 + O2 rate = 1.00E-11 (198) + NO3_OH ( 85) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (199) + NO3_HO2 ( 86) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (200) + tag_NO2_HO2 ( 87) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (201) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + HO2NO2_OH ( 88) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (202) + usr_HO2NO2_M ( 89) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (203) + CL_O3 ( 90) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (204) + CL_H2 ( 91) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (205) + CL_H2O2 ( 92) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (206) + CL_HO2a ( 93) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (207) + CL_HO2b ( 94) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (208) + CL_CH2O ( 95) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (209) + CL_CH4 ( 96) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (210) + CLO_O ( 97) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (211) + CLO_OHa ( 98) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (212) + CLO_OHb ( 99) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (213) + CLO_HO2 (100) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (214) + CLO_CH3O2 (101) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (215) + CLO_NO (102) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (216) + CLO_NO2_M (103) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (217) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLO_CLOa (104) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (218) + CLO_CLOb (105) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (219) + CLO_CLOc (106) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (220) + tag_CLO_CLO_M (107) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (221) + ki=3.00E-12*(300/t)**2.00 + f=0.60 + usr_CL2O2_M (108) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (222) + HCL_OH (109) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (223) + HCL_O (110) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (224) + HOCL_O (111) HOCL + O -> CLO + OH rate = 1.70E-13 (225) + HOCL_CL (112) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (226) + HOCL_OH (113) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (227) + CLONO2_O (114) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (228) + CLONO2_OH (115) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (229) + CLONO2_CL (116) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (230) + BR_O3 (117) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (231) + BR_HO2 (118) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (232) + BR_CH2O (119) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (233) + BRO_O (120) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (234) + BRO_OH (121) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (235) + BRO_HO2 (122) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (236) + BRO_NO (123) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (237) + BRO_NO2_M (124) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (238) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRO_CLOa (125) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (239) + BRO_CLOb (126) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (240) + BRO_CLOc (127) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (241) + BRO_BRO (128) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (242) + HBR_OH (129) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (243) + HBR_O (130) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (244) + HOBR_O (131) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (245) + BRONO2_O (132) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (246) + F_H2O (133) F + H2O -> HF + OH rate = 1.40E-11 (247) + F_H2 (134) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (248) + F_CH4 (135) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (249) + F_HNO3 (136) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (250) + CH3CL_CL (137) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (251) + CH3CL_OH (138) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (252) + CH3CCL3_OH (139) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (253) + HCFC22_OH (140) HCFC22 + OH -> H2O + CL + COF2 rate = 1.05E-12*exp( -1600./t) (254) + CH3BR_OH (141) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (255) + CH3BR_CL (142) CH3BR + CL -> HCL + HO2 + BR rate = 1.40E-11*exp( -1030./t) (256) + HCFC141B_OH (143) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (257) + HCFC142B_OH (144) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (258) + CH2BR2_OH (145) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (259) + CHBR3_OH (146) CHBR3 + OH -> 3*BR rate = 1.35E-12*exp( -600./t) (260) + CH2BR2_CL (147) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (261) + CHBR3_CL (148) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (262) + CH4_OH (149) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (263) + usr_CO_OH_b (150) CO + OH -> CO2 + H rate = ** User defined ** (264) + CO_OH_M (151) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (265) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + CH2O_NO3 (152) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (266) + CH2O_OH (153) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (267) + CH2O_O (154) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (268) + CH2O_HO2 (155) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (269) + CH3O2_NO (156) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (270) + CH3O2_HO2 (157) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (271) + CH3O2_CH3O2a (158) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (272) + CH3O2_CH3O2b (159) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (273) + CH3OH_OH (160) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (274) + CH3OOH_OH (161) CH3OOH + OH -> .7*CH3O2 + .3*OH + .3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (275) + HCOOH_OH (162) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.50E-13 (276) + HOCH2OO_M (163) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (277) + HOCH2OO_NO (164) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (278) + HOCH2OO_HO2 (165) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (279) + C2H2_CL_M (166) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (280) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (281) + ki=3.10E-10*(300/t) + f=0.60 + C2H6_CL (168) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (282) + C2H2_OH_M (169) C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 troe : ko=5.50E-30 (283) + + .35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H6_OH (170) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (284) + tag_C2H4_OH (171) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (285) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + EO2_NO (172) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (286) + EO2_HO2 (173) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (287) + EO_O2 (174) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (288) + EO_M (175) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (289) + C2H4_O3 (176) C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH rate = 1.20E-14*exp( -2630./t) (290) + CH3COOH_OH (177) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (291) + C2H5O2_NO (178) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (292) + C2H5O2_HO2 (179) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (293) + C2H5O2_CH3O2 (180) C2H5O2 + CH3O2 -> .7*CH2O + .8*CH3CHO + HO2 + .3*CH3OH + .2*C2H5OH rate = 2.00E-13 (294) + C2H5O2_C2H5O2 (181) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + .4*C2H5OH rate = 6.80E-14 (295) + C2H5OOH_OH (182) C2H5OOH + OH -> .5*C2H5O2 + .5*CH3CHO + .5*OH rate = 3.80E-12*exp( 200./t) (296) + CH3CHO_OH (183) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (297) + CH3CHO_NO3 (184) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (298) + CH3CO3_NO (185) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (299) + tag_CH3CO3_NO2 (186) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (300) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + CH3CO3_HO2 (187) CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 rate = 4.30E-13*exp( 1040./t) (301) + CH3CO3_CH3O2 (188) CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH rate = 2.00E-12*exp( 500./t) (302) + CH3CO3_CH3CO3 (189) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.50E-12*exp( 500./t) (303) + CH3COOOH_OH (190) CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O rate = 1.00E-12 (304) + GLYALD_OH (191) GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 rate = 1.00E-11 (305) + GLYOXAL_OH (192) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (306) + C2H5OH_OH (193) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (307) + usr_PAN_M (194) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (308) + PAN_OH (195) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (309) + tag_C3H6_OH (196) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (310) + ki=3.00E-11 + f=0.50 + C3H6_O3 (197) C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 + .56*CO rate = 6.50E-15*exp( -1900./t) (311) + + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + C3H6_NO3 (198) C3H6 + NO3 -> ONIT rate = 4.60E-13*exp( -1156./t) (312) + C3H7O2_NO (199) C3H7O2 + NO -> .82*CH3COCH3 + NO2 + HO2 + .27*CH3CHO rate = 4.20E-12*exp( 180./t) (313) + C3H7O2_HO2 (200) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (314) + CH3H7O2_CH3O2 (201) C3H7O2 + CH3O2 -> CH2O + HO2 + .82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (315) + CH3H7OOH_OH (202) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (316) + C3H8_OH (203) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (317) + PO2_NO (204) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (318) + PO2_HO2 (205) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (319) + POOH_OH (206) POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (320) + usr_CH3COCH3_OH (207) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (321) + RO2_NO (208) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (322) + RO2_HO2 (209) RO2 + HO2 -> ROOH + O2 rate = 8.60E-13*exp( 700./t) (323) + RO2_CH3O2 (210) RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC + .5*CH3COCHO rate = 7.10E-13*exp( 500./t) (324) + + .5*CH3OH + ROOH_OH (211) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (325) + HYAC_OH (212) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (326) + CH3COCHO_OH (213) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (327) + CH3COCHO_NO3 (214) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (328) + ONIT_OH (215) ONIT + OH -> NO2 + CH3COCHO rate = 6.80E-13 (329) + BIGENE_OH (216) BIGENE + OH -> ENEO2 rate = 5.40E-11 (330) + ENEO2_NO (217) ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (331) + MVK_OH (218) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (332) + MVK_O3 (219) MVK + O3 -> .8*CH2O + .95*CH3COCHO + .08*OH + .2*O3 + .06*HO2 rate = 7.52E-16*exp( -1521./t) (333) + + .05*CO + .04*CH3CHO + MEK_OH (220) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (334) + MEKO2_NO (221) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (335) + MEKO2_HO2 (222) MEKO2 + HO2 -> MEKOOH rate = 7.50E-13*exp( 700./t) (336) + MEKOOH_OH (223) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (337) + MACR_OH (224) MACR + OH -> .5*MACRO2 + .5*H2O + .5*MCO3 rate = 1.86E-11*exp( 175./t) (338) + MACR_O3 (225) MACR + O3 -> .8*CH3COCHO + .275*HO2 + .2*CO + .2*O3 + .7*CH2O rate = 4.40E-15*exp( -2500./t) (339) + + .215*OH + MACRO2_NOa (226) MACRO2 + NO -> NO2 + .47*HO2 + .25*CH2O + .53*GLYALD + .25*CH3COCHO rate = 2.70E-12*exp( 360./t) (340) + + .53*CH3CO3 + .22*HYAC + .22*CO + MACRO2_NOb (227) MACRO2 + NO -> 0.8*ONITR rate = 1.30E-13*exp( 360./t) (341) + MACRO2_NO3 (228) MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO + .22*CO rate = 2.40E-12 (342) + + .53*GLYALD + .22*HYAC + .53*CH3CO3 + MACRO2_HO2 (229) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (343) + MACRO2_CH3O2 (230) MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO rate = 5.00E-13*exp( 400./t) (344) + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + MACRO2_CH3CO3 (231) MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 rate = 1.40E-11 (345) + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + MACROOH_OH (232) MACROOH + OH -> .5*MCO3 + .2*MACRO2 + .1*OH + .2*HO2 rate = 2.30E-11*exp( 200./t) (346) + MCO3_NO (233) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (347) + MCO3_NO3 (234) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (348) + MCO3_HO2 (235) MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 rate = 4.30E-13*exp( 1040./t) (349) + MCO3_CH3O2 (236) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (350) + MCO3_CH3CO3 (237) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (351) + MCO3_MCO3 (238) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (352) + usr_MCO3_NO2 (239) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (353) + usr_MPAN_M (240) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (354) + MPAN_OH_M (241) MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + 0.5*CO2 + M troe : ko=8.00E-27*(300/t)**3.50 (355) + ki=3.00E-11 + f=0.50 + ISOP_OH (242) ISOP + OH -> ISOPO2 rate = 2.54E-11*exp( 410./t) (356) + ISOP_O3 (243) ISOP + O3 -> .4*MACR + .2*MVK + .07*C3H6 + .27*OH + .06*HO2 rate = 1.05E-14*exp( -2000./t) (357) + + .6*CH2O + .3*CO + .1*O3 + .2*MCO3 + .2*CH3COOH + ISOP_NO3 (244) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (358) + ISOPO2_NO (245) ISOPO2 + NO -> .08*ONITR + .92*NO2 + .23*MACR + .32*MVK rate = 4.40E-12*exp( 180./t) (359) + + .33*HYDRALD + .02*GLYOXAL + .02*GLYALD + + .02*CH3COCHO + .02*HYAC + .55*CH2O + .92*HO2 + ISOPO2_NO3 (246) ISOPO2 + NO3 -> HO2 + NO2 + .6*CH2O + .25*MACR + .35*MVK rate = 2.40E-12 (360) + + .4*HYDRALD + ISOPO2_HO2 (247) ISOPO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (361) + ISOPOOH_OH (248) ISOPOOH + OH -> .8*XO2 + .2*ISOPO2 rate = 1.52E-11*exp( 200./t) (362) + ISOPO2_CH3O2 (249) ISOPO2 + CH3O2 -> .25*CH3OH + HO2 + 1.2*CH2O + .19*MACR + .26*MVK rate = 5.00E-13*exp( 400./t) (363) + + .3*HYDRALD + ISOPO2_CH3CO3 (250) ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6*CH2O + .25*MACR + .35*MVK rate = 1.40E-11 (364) + + .4*HYDRALD + ISOPNO3_NO (251) ISOPNO3 + NO -> 1.206*NO2 + .794*HO2 + .072*CH2O + .167*MACR rate = 2.70E-12*exp( 360./t) (365) + + .039*MVK + .794*ONITR + ISOPNO3_NO3 (252) ISOPNO3 + NO3 -> 1.206*NO2 + .072*CH2O + .167*MACR + .039*MVK rate = 2.40E-12 (366) + + .794*ONITR + .794*HO2 + ISOPNO3_HO2 (253) ISOPNO3 + HO2 -> .206*NO2 + .206*CH2O + .206*OH + .167*MACR rate = 8.00E-13*exp( 700./t) (367) + + .039*MVK + .794*ONITR + BIGALK_OH (254) BIGALK + OH -> ALKO2 rate = 3.50E-12 (368) + ONITR_OH (255) ONITR + OH -> HYDRALD + .4*NO2 + HO2 rate = 4.50E-11 (369) + ONITR_NO3 (256) ONITR + NO3 -> HO2 + NO2 + HYDRALD rate = 1.40E-12*exp( -1860./t) (370) + HYDRALD_OH (257) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (371) + ALKO2_NO (258) ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK rate = 4.20E-12*exp( 180./t) (372) + + .9*NO2 + .1*ONIT + ALKO2_HO2 (259) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (373) + ALKOOH_OH (260) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (374) + XO2_NO (261) XO2 + NO -> NO2 + HO2 + .25*CO + .25*CH2O + .25*GLYOXAL rate = 2.70E-12*exp( 360./t) (375) + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + XO2_NO3 (262) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (376) + + .25*CH3COCHO + .25*GLYALD + XO2_HO2 (263) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (377) + XO2_CH3O2 (264) XO2 + CH3O2 -> .3*CH3OH + .8*HO2 + .8*CH2O + .2*CO + .1*GLYOXAL rate = 5.00E-13*exp( 400./t) (378) + + .1*CH3COCHO + .1*HYAC + .1*GLYALD + XO2_CH3CO3 (265) XO2 + CH3CO3 -> .25*CO + .25*CH2O + .25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (379) + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + CO2 + XOOH_OHa (266) XOOH + OH -> H2O + XO2 rate = 1.90E-12*exp( 190./t) (380) + usr_XOOH_OH (267) XOOH + OH -> H2O + OH rate = ** User defined ** (381) + TOLUENE_OH (268) TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 rate = 1.70E-12*exp( 352./t) (382) + TOLO2_NO (269) TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + .9*NO2 rate = 4.20E-12*exp( 180./t) (383) + + .9*HO2 + TOLO2_HO2 (270) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (384) + TOLO2_OH (271) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (385) + CRESOL_OH (272) CRESOL + OH -> XOH rate = 3.00E-12 (386) + XOH_NO2 (273) XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 rate = 1.00E-11 (387) + BENZENE_OH (274) BENZENE + OH -> BENO2 rate = 2.30E-12*exp( -193./t) (388) + BENO2_HO2 (275) BENO2 + HO2 -> BENOOH rate = 1.40E-12*exp( 700./t) (389) + BENO2_NO (276) BENO2 + NO -> 0.9*GLYOXAL + 0.9*BIGALD + 0.9*NO2 + 0.9*HO2 rate = 2.60E-12*exp( 350./t) (390) + XYLENE_OH (277) XYLENE + OH -> XYLO2 rate = 2.30E-11 (391) + XYLO2_HO2 (278) XYLO2 + HO2 -> XYLOOH rate = 1.40E-12*exp( 700./t) (392) + XYLO2_NO (279) XYLO2 + NO -> 0.62*BIGALD + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.9*NO2 rate = 2.60E-12*exp( 350./t) (393) + + 0.9*HO2 + C10H16_OH (280) C10H16 + OH -> TERPO2 rate = 1.20E-11*exp( 444./t) (394) + C10H16_O3 (281) C10H16 + O3 -> .7*OH + MVK + MACR + HO2 rate = 1.00E-15*exp( -732./t) (395) + C10H16_NO3 (282) C10H16 + NO3 -> TERPO2 + NO2 rate = 1.20E-12*exp( 490./t) (396) + TERPO2_NO (283) TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 rate = 4.20E-12*exp( 180./t) (397) + TERPO2_HO2 (284) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (398) + TERPOOH_OH (285) TERPOOH + OH -> TERPO2 rate = 3.80E-12*exp( 200./t) (399) + usr_N2O5_aer (286) N2O5 -> 2*HNO3 rate = ** User defined ** (400) + usr_NO3_aer (287) NO3 -> HNO3 rate = ** User defined ** (401) + usr_NO2_aer (288) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (402) + CB1_CB2 (289) CB1 -> CB2 rate = 7.10E-06 (403) + usr_SO2_OH (290) SO2 + OH -> SO4 rate = ** User defined ** (404) + DMS_OHa (291) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (405) + usr_DMS_OH (292) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** (406) + DMS_NO3 (293) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (407) + NH3_OH (294) NH3 + OH -> H2O rate = 1.70E-12*exp( -710./t) (408) + OC1_OC2 (295) OC1 -> OC2 rate = 7.10E-06 (409) + usr_HO2_aer (296) HO2 -> 0.5*H2O2 rate = ** User defined ** (410) + usr_CB1_strat_ta (297) CB1 -> (No products) rate = 6.34E-08 (411) + usr_CB2_strat_ta (298) CB2 -> (No products) rate = 6.34E-08 (412) + usr_OC1_strat_ta (299) OC1 -> (No products) rate = 6.34E-08 (413) + usr_OC2_strat_ta (300) OC2 -> (No products) rate = 6.34E-08 (414) + usr_SO4_strat_ta (301) SO4 -> (No products) rate = 6.34E-08 (415) + usr_SOAM_strat_t (302) SOAM -> (No products) rate = 6.34E-08 (416) + usr_SOAI_strat_t (303) SOAI -> (No products) rate = 6.34E-08 (417) + usr_SOAB_strat_t (304) SOAB -> (No products) rate = 6.34E-08 (418) + usr_SOAT_strat_t (305) SOAT -> (No products) rate = 6.34E-08 (419) + usr_SOAX_strat_t (306) SOAX -> (No products) rate = 6.34E-08 (420) + usr_NH4_strat_ta (307) NH4 -> (No products) rate = 6.34E-08 (421) + usr_NH4NO3_strat (308) NH4NO3 -> (No products) rate = 6.34E-08 (422) + usr_SSLT01_strat (309) SSLT01 -> (No products) rate = 6.34E-08 (423) + usr_SSLT02_strat (310) SSLT02 -> (No products) rate = 6.34E-08 (424) + usr_SSLT03_strat (311) SSLT03 -> (No products) rate = 6.34E-08 (425) + usr_SSLT04_strat (312) SSLT04 -> (No products) rate = 6.34E-08 (426) + usr_DST01_strat_ (313) DST01 -> (No products) rate = 6.34E-08 (427) + usr_DST02_strat_ (314) DST02 -> (No products) rate = 6.34E-08 (428) + usr_DST03_strat_ (315) DST03 -> (No products) rate = 6.34E-08 (429) + usr_DST04_strat_ (316) DST04 -> (No products) rate = 6.34E-08 (430) + usr_SO2t_strat_t (317) SO2t -> (No products) rate = 6.34E-08 (431) + het1 (318) N2O5 -> 2*HNO3 rate = ** User defined ** (432) + het2 (319) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (433) + het3 (320) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (434) + het4 (321) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (435) + het5 (322) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (436) + het6 (323) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (437) + het7 (324) N2O5 -> 2*HNO3 rate = ** User defined ** (438) + het8 (325) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (439) + het9 (326) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (440) + het10 (327) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (441) + het11 (328) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (442) + het12 (329) N2O5 -> 2*HNO3 rate = ** User defined ** (443) + het13 (330) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (444) + het14 (331) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (445) + het15 (332) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (446) + het16 (333) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (447) + het17 (334) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (448) + ion_Op_O2 (335) Op + O2 -> O2p + O rate = ** User defined ** (449) + ion_Op_N2 (336) Op + N2 -> NOp + N rate = ** User defined ** (450) + ion_N2p_Oa (337) N2p + O -> NOp + N2D rate = ** User defined ** (451) + ion_N2p_Ob (338) N2p + O -> Op + N2 rate = ** User defined ** (452) + ion_Op_CO2 (339) Op + CO2 -> O2p + CO rate = 9.00E-10 (453) + ion_O2p_N (340) O2p + N -> NOp + O rate = 1.00E-10 (454) + ion_O2p_NO (341) O2p + NO -> NOp + O2 rate = 4.40E-10 (455) + ion_Np_O2a (342) Np + O2 -> O2p + N rate = 4.00E-10 (456) + ion_Np_O2b (343) Np + O2 -> NOp + O rate = 2.00E-10 (457) + ion_Np_O (344) Np + O -> Op + N rate = 1.00E-12 (458) + ion_N2p_O2 (345) N2p + O2 -> O2p + N2 rate = 6.00E-11 (459) + ion_O2p_N2 (346) O2p + N2 -> NOp + NO rate = 5.00E-16 (460) + elec1 (347) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (461) + elec2 (348) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (462) + elec3 (349) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (463) + NH_5_tau (350) NH_5 -> (No products) rate = 2.31E-06 (464) + NH_50_tau (351) NH_50 -> (No products) rate = 2.31E-07 (465) + NH_50W_tau (352) NH_50W -> (No products) rate = 2.31E-07 (466) + ST80_25_tau (353) ST80_25 -> (No products) rate = 4.63E-07 (467) + CO_25_tau (354) CO_25 -> (No products) rate = 4.63E-07 (468) + CO_50_tau (355) CO_50 -> (No products) rate = 2.31E-07 (469) + E90_tau (356) E90 -> (No products) rate = 1.29E-07 (470) + E90_NH_tau (357) E90_NH -> (No products) rate = 1.29E-07 (471) + E90_SH_tau (358) E90_SH -> (No products) rate = 1.29E-07 (472) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) SO4 (dataset) + ( 6) CB1 (dataset) + ( 7) Op + ( 8) O2p + ( 9) Np + (10) N2p + (11) N2D + (12) N + (13) e + (14) OH + (15) AOA_NH + + + Equation Report + + d(O3)/dt = r1*M*O*O2 + .25*r187*CH3CO3*HO2 + .2*r219*MVK*O3 + .2*r225*MACR*O3 + .25*r235*MCO3*HO2 + + .1*r243*ISOP*O3 + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r47*H*O3 - r52*OH*O3 - r60*HO2*O3 - r75*NO*O3 + - r78*NO2*O3 - r90*CL*O3 - r117*BR*O3 - r176*C2H4*O3 - r197*C3H6*O3 - r219*MVK*O3 - r225*MACR*O3 + - r243*ISOP*O3 - r281*C10H16*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j58*CO2 + .18*j60*CH4 + j95*O2 + j96*O2 + j97*O2 + 2*j100*O2 + j107*O2 + j108*O2 + + j109*O2 + 2*j112*O2 + j114*CO2 + r14*N2*O1D + r15*O1D*O2 + r16*O1D*O2 + r50*H*HO2 + r54*OH*OH + + r68*N*O2 + r69*N*NO + r70*N*NO2 + r335*Op*O2 + r340*O2p*N + r343*Np*O2 + r347*NOp*e + + 1.15*r348*O2p*e + - j89*O - j90*O - j91*O - j102*O - j103*O - j104*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O + - r51*OH*O - r58*H2*O - r59*HO2*O - r62*H2O2*O - r73*M*NO*O - r76*NO2*O - r77*M*NO2*O + - r84*NO3*O - r97*CLO*O - r110*HCL*O - r111*HOCL*O - r114*CLONO2*O - r120*BRO*O - r130*HBR*O + - r131*HOBR*O - r132*BRONO2*O - r154*CH2O*O - r337*N2p*O - r338*N2p*O - r344*Np*O + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r65*N2D*O2 + .85*r348*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*CFC114*O1D - r25*CFC115*O1D + - r26*HCFC22*O1D - r27*HCFC141B*O1D - r28*HCFC142B*O1D - r29*CCL4*O1D - r30*CH3BR*O1D + - r31*CF2CLBR*O1D - r32*CF3BR*O1D - r33*H1202*O1D - r34*H2402*O1D - r35*CHBR3*O1D + - r36*CH2BR2*O1D - r37*COF2*O1D - r38*COFCL*O1D - r39*CH4*O1D - r40*CH4*O1D - r41*CH4*O1D + - r42*H2*O1D - r43*HCL*O1D - r44*HBR*O1D - r45*HCN*O1D + d(O2)/dt = j4*O3 + j13*NO3 + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + r20*O1D*O3 + r47*H*O3 + r49*H*HO2 + r51*OH*O + + r52*OH*O3 + r53*OH*HO2 + r59*HO2*O + 2*r60*HO2*O3 + r61*HO2*HO2 + r72*N*NO2 + r75*NO*O3 + + r76*NO2*O + r78*NO2*O3 + r84*NO3*O + r86*NO3*HO2 + r88*HO2NO2*OH + r90*CL*O3 + r93*CL*HO2 + + r97*CLO*O + r99*CLO*OH + r100*CLO*HO2 + r104*CLO*CLO + r105*CLO*CLO + r117*BR*O3 + r118*BR*HO2 + + r120*BRO*O + r122*BRO*HO2 + r126*BRO*CLO + r127*BRO*CLO + r128*BRO*BRO + r157*CH3O2*HO2 + + r179*C2H5O2*HO2 + r200*C3H7O2*HO2 + r205*PO2*HO2 + r209*RO2*HO2 + .75*r235*MCO3*HO2 + + r341*O2p*NO + - j1*O2 - j2*O2 - j93*O2 - j95*O2 - j96*O2 - j97*O2 - j100*O2 - j105*O2 - j107*O2 - j108*O2 + - j109*O2 - j112*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r46*M*H*O2 - r65*N2D*O2 + - r68*N*O2 - r174*EO*O2 - r335*Op*O2 - r342*Np*O2 - r343*Np*O2 - r345*N2p*O2 + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(N2O)/dt = r70*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j98*N2 + .8*j101*N2 + j110*N2 + .8*j113*N2 + j6*NO + r336*N2*Op + r66*N2D*O + r342*Np*O2 + + r344*Np*O + .2*r347*NOp*e + 1.1*r349*N2p*e + - j92*N - r67*OH*N - r68*O2*N - r69*NO*N - r70*NO2*N - r71*NO2*N - r72*NO2*N - r340*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + .5*r288*NO2 + r346*N2*O2p + 2*r18*O1D*N2O + r65*N2D*O2 + r67*N*OH + + r68*N*O2 + 2*r71*N*NO2 + r76*NO2*O + - j6*NO - j7*NO - r69*N*NO - r73*M*O*NO - r74*HO2*NO - r75*O3*NO - r83*NO3*NO - r102*CLO*NO + - r123*BRO*NO - r156*CH3O2*NO - r164*HOCH2OO*NO - r172*EO2*NO - r178*C2H5O2*NO - r185*CH3CO3*NO + - r199*C3H7O2*NO - r204*PO2*NO - r208*RO2*NO - r217*ENEO2*NO - r221*MEKO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r233*MCO3*NO - r245*ISOPO2*NO - r251*ISOPNO3*NO - r258*ALKO2*NO - r261*XO2*NO + - r269*TOLO2*NO - r276*BENO2*NO - r279*XYLO2*NO - r283*TERPO2*NO - r341*O2p*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j36*BRONO2 + .6*j64*PAN + j65*MPAN + + j76*ONITR + r80*M*N2O5 + r89*M*HO2NO2 + r194*M*PAN + r240*M*MPAN + r73*M*NO*O + r74*NO*HO2 + + r75*NO*O3 + 2*r83*NO3*NO + r84*NO3*O + r85*NO3*OH + r86*NO3*HO2 + r88*HO2NO2*OH + r102*CLO*NO + + r123*BRO*NO + r156*CH3O2*NO + r164*HOCH2OO*NO + r172*EO2*NO + r178*C2H5O2*NO + r185*CH3CO3*NO + + r199*C3H7O2*NO + r204*PO2*NO + r208*RO2*NO + r215*ONIT*OH + r217*ENEO2*NO + r221*MEKO2*NO + + r226*MACRO2*NO + r228*MACRO2*NO3 + r233*MCO3*NO + r234*MCO3*NO3 + .92*r245*ISOPO2*NO + + r246*ISOPO2*NO3 + 1.206*r251*ISOPNO3*NO + 1.206*r252*ISOPNO3*NO3 + .206*r253*ISOPNO3*HO2 + + .4*r255*ONITR*OH + r256*ONITR*NO3 + .9*r258*ALKO2*NO + r261*XO2*NO + r262*XO2*NO3 + + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + .9*r279*XYLO2*NO + r282*C10H16*NO3 + + r283*TERPO2*NO + - j8*NO2 - r288*NO2 - r70*N*NO2 - r71*N*NO2 - r72*N*NO2 - r76*O*NO2 - r77*M*O*NO2 - r78*O3*NO2 + - r79*M*NO3*NO2 - r81*M*OH*NO2 - r87*M*HO2*NO2 - r103*M*CLO*NO2 - r124*M*BRO*NO2 + - r186*M*CH3CO3*NO2 - r239*M*MCO3*NO2 - r273*XOH*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j35*BRONO2 + .4*j64*PAN + r80*M*N2O5 + + r77*M*NO2*O + r78*NO2*O3 + r82*HNO3*OH + r114*CLONO2*O + r115*CLONO2*OH + r116*CLONO2*CL + + r132*BRONO2*O + r136*F*HNO3 + r195*PAN*OH + .5*r241*M*MPAN*OH + - j12*NO3 - j13*NO3 - r287*NO3 - r79*M*NO2*NO3 - r83*NO*NO3 - r84*O*NO3 - r85*OH*NO3 + - r86*HO2*NO3 - r152*CH2O*NO3 - r184*CH3CHO*NO3 - r198*C3H6*NO3 - r214*CH3COCHO*NO3 + - r228*MACRO2*NO3 - r234*MCO3*NO3 - r244*ISOP*NO3 - r246*ISOPO2*NO3 - r252*ISOPNO3*NO3 + - r256*ONITR*NO3 - r262*XO2*NO3 - r282*C10H16*NO3 - r293*DMS*NO3 + d(HNO3)/dt = 2*r286*N2O5 + r287*NO3 + .5*r288*NO2 + 2*r318*N2O5 + r319*CLONO2 + r320*BRONO2 + 2*r324*N2O5 + + r325*CLONO2 + r328*BRONO2 + 2*r329*N2O5 + r330*CLONO2 + r331*BRONO2 + r81*M*NO2*OH + + r152*CH2O*NO3 + r184*CH3CHO*NO3 + r214*CH3COCHO*NO3 + r293*DMS*NO3 + r321*CLONO2*HCL + + r326*CLONO2*HCL + r332*CLONO2*HCL + - j11*HNO3 - r82*OH*HNO3 - r136*F*HNO3 + d(HO2NO2)/dt = r87*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r89*M*HO2NO2 - r88*OH*HO2NO2 + d(N2O5)/dt = r79*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r80*M*N2O5 - r286*N2O5 - r318*N2O5 - r324*N2O5 - r329*N2O5 + d(CH4)/dt = .08*r197*C3H6*O3 + - j59*CH4 - j60*CH4 - r39*O1D*CH4 - r40*O1D*CH4 - r41*O1D*CH4 - r96*CL*CH4 - r135*F*CH4 + - r149*OH*CH4 + d(CH3O2)/dt = j37*CH3CL + j48*CH3BR + j59*CH4 + j61*CH3CHO + j63*CH3COOOH + .4*j64*PAN + .3*j68*MVK + + j73*CH3COCH3 + r39*O1D*CH4 + r96*CL*CH4 + r135*F*CH4 + r149*CH4*OH + .7*r161*CH3OOH*OH + + r177*CH3COOH*OH + r185*CH3CO3*NO + .9*r188*CH3CO3*CH3O2 + 2*r189*CH3CO3*CH3CO3 + + .31*r197*C3H6*O3 + r231*MACRO2*CH3CO3 + r237*MCO3*CH3CO3 + r250*ISOPO2*CH3CO3 + + r265*XO2*CH3CO3 + - r101*CLO*CH3O2 - r156*NO*CH3O2 - r157*HO2*CH3O2 - 2*r158*CH3O2*CH3O2 - 2*r159*CH3O2*CH3O2 + - r180*C2H5O2*CH3O2 - r188*CH3CO3*CH3O2 - r201*C3H7O2*CH3O2 - r210*RO2*CH3O2 + - r230*MACRO2*CH3O2 - r236*MCO3*CH3O2 - r249*ISOPO2*CH3O2 - r264*XO2*CH3O2 + d(CH3OOH)/dt = r157*CH3O2*HO2 + - j16*CH3OOH - r161*OH*CH3OOH + d(CH3OH)/dt = r159*CH3O2*CH3O2 + .3*r180*C2H5O2*CH3O2 + .5*r210*RO2*CH3O2 + .25*r230*MACRO2*CH3O2 + + .25*r249*ISOPO2*CH3O2 + .3*r264*XO2*CH3O2 + - r160*OH*CH3OH + d(CH2O)/dt = j16*CH3OOH + .18*j60*CH4 + j62*POOH + 1.34*j66*MACR + j72*ROOH + j76*ONITR + .69*j77*ISOPOOH + + j78*HYAC + j79*GLYALD + .1*j83*ALKOOH + r163*HOCH2OO + 2*r175*EO + r40*O1D*CH4 + r41*O1D*CH4 + + r101*CLO*CH3O2 + r156*CH3O2*NO + 2*r158*CH3O2*CH3O2 + r159*CH3O2*CH3O2 + r160*CH3OH*OH + + .3*r161*CH3OOH*OH + .5*r172*EO2*NO + r176*C2H4*O3 + .7*r180*C2H5O2*CH3O2 + r188*CH3CO3*CH3O2 + + .5*r190*CH3COOOH*OH + .8*r191*GLYALD*OH + r195*PAN*OH + .54*r197*C3H6*O3 + r201*C3H7O2*CH3O2 + + r204*PO2*NO + r208*RO2*NO + .8*r210*RO2*CH3O2 + .5*r217*ENEO2*NO + .8*r219*MVK*O3 + + .7*r225*MACR*O3 + .25*r226*MACRO2*NO + .25*r228*MACRO2*NO3 + .88*r230*MACRO2*CH3O2 + + .25*r231*MACRO2*CH3CO3 + r233*MCO3*NO + r234*MCO3*NO3 + 2*r236*MCO3*CH3O2 + r237*MCO3*CH3CO3 + + 2*r238*MCO3*MCO3 + .5*r241*M*MPAN*OH + .6*r243*ISOP*O3 + .55*r245*ISOPO2*NO + + .6*r246*ISOPO2*NO3 + 1.2*r249*ISOPO2*CH3O2 + .6*r250*ISOPO2*CH3CO3 + .072*r251*ISOPNO3*NO + + .072*r252*ISOPNO3*NO3 + .206*r253*ISOPNO3*HO2 + .1*r258*ALKO2*NO + .25*r261*XO2*NO + + .8*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j17*CH2O - j18*CH2O - r95*CL*CH2O - r119*BR*CH2O - r152*NO3*CH2O - r153*OH*CH2O + - r154*O*CH2O - r155*HO2*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j58*CO2 + .38*j60*CH4 + j61*CH3CHO + 1.34*j67*MACR + .7*j68*MVK + + j74*CH3COCHO + j76*ONITR + j79*GLYALD + .45*j81*BIGALD + 2*j82*GLYOXAL + j114*CO2 + + r95*CL*CH2O + r119*BR*CH2O + r137*CH3CL*CL + r152*CH2O*NO3 + r153*CH2O*OH + r154*CH2O*O + + .35*r169*M*C2H2*OH + .5*r176*C2H4*O3 + r192*GLYOXAL*OH + .56*r197*C3H6*O3 + r213*CH3COCHO*OH + + r214*CH3COCHO*NO3 + .05*r219*MVK*O3 + .2*r225*MACR*O3 + .22*r226*MACRO2*NO + .22*r228*MACRO2*NO3 + + .11*r230*MACRO2*CH3O2 + .22*r231*MACRO2*CH3CO3 + .3*r243*ISOP*O3 + .25*r261*XO2*NO + + .5*r262*XO2*NO3 + .2*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + r339*Op*CO2 + - r150*OH*CO - r151*M*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j60*CH4 + r41*O1D*CH4 + r49*H*HO2 + - r42*O1D*H2 - r56*OH*H2 - r58*O*H2 - r91*CL*H2 - r134*F*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j34*HBR + j57*HF + j59*CH4 + + .33*j60*CH4 + r40*O1D*CH4 + r42*O1D*H2 + r51*OH*O + r56*OH*H2 + r58*H2*O + r67*N*OH + + r91*CL*H2 + r134*F*H2 + r150*CO*OH + r153*CH2O*OH + - r46*M*O2*H - r47*O3*H - r48*HO2*H - r49*HO2*H - r50*HO2*H + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .33*j60*CH4 + + j62*POOH + j63*CH3COOOH + j69*C2H5OOH + j70*EOOH + j71*C3H7OOH + j72*ROOH + j75*XOOH + + j83*ALKOOH + j84*MEKOOH + j85*TOLOOH + j86*TERPOOH + .5*r288*NO2 + 2*r17*O1D*H2O + r39*O1D*CH4 + + r42*O1D*H2 + r43*O1D*HCL + r44*O1D*HBR + r45*O1D*HCN + r47*H*O3 + 2*r48*H*HO2 + r58*H2*O + + r59*HO2*O + r60*HO2*O3 + r62*H2O2*O + r74*NO*HO2 + r86*NO3*HO2 + r94*CL*HO2 + r110*HCL*O + + r111*HOCL*O + r130*HBR*O + r131*HOBR*O + r133*F*H2O + r154*CH2O*O + .3*r161*CH3OOH*OH + + .65*r169*M*C2H2*OH + .12*r176*C2H4*O3 + .5*r182*C2H5OOH*OH + .33*r197*C3H6*O3 + .5*r206*POOH*OH + + .08*r219*MVK*O3 + .215*r225*MACR*O3 + .1*r232*MACROOH*OH + .27*r243*ISOP*O3 + + .206*r253*ISOPNO3*HO2 + .7*r281*C10H16*O3 + - r51*O*OH - r52*O3*OH - r53*HO2*OH - 2*r54*OH*OH - 2*r55*M*OH*OH - r56*H2*OH - r57*H2O2*OH + - r63*M*HCN*OH - r64*CH3CN*OH - r67*N*OH - r81*M*NO2*OH - r82*HNO3*OH - r85*NO3*OH + - r88*HO2NO2*OH - r98*CLO*OH - r99*CLO*OH - r109*HCL*OH - r113*HOCL*OH - r115*CLONO2*OH + - r121*BRO*OH - r129*HBR*OH - r138*CH3CL*OH - r139*CH3CCL3*OH - r140*HCFC22*OH - r141*CH3BR*OH + - r143*HCFC141B*OH - r144*HCFC142B*OH - r145*CH2BR2*OH - r146*CHBR3*OH - r149*CH4*OH - r150*CO*OH + - r151*M*CO*OH - r153*CH2O*OH - r160*CH3OH*OH - r161*CH3OOH*OH - r162*HCOOH*OH - r169*M*C2H2*OH + - r170*C2H6*OH - r171*M*C2H4*OH - r177*CH3COOH*OH - r182*C2H5OOH*OH - r183*CH3CHO*OH + - r190*CH3COOOH*OH - r191*GLYALD*OH - r192*GLYOXAL*OH - r193*C2H5OH*OH - r195*PAN*OH + - r196*M*C3H6*OH - r202*C3H7OOH*OH - r203*C3H8*OH - r206*POOH*OH - r207*CH3COCH3*OH + - r211*ROOH*OH - r212*HYAC*OH - r213*CH3COCHO*OH - r215*ONIT*OH - r216*BIGENE*OH - r218*MVK*OH + - r220*MEK*OH - r223*MEKOOH*OH - r224*MACR*OH - r232*MACROOH*OH - r241*M*MPAN*OH - r242*ISOP*OH + - r248*ISOPOOH*OH - r254*BIGALK*OH - r255*ONITR*OH - r257*HYDRALD*OH - r260*ALKOOH*OH + - r266*XOOH*OH - r268*TOLUENE*OH - r271*TOLOOH*OH - r272*CRESOL*OH - r274*BENZENE*OH + - r277*XYLENE*OH - r280*C10H16*OH - r285*TERPOOH*OH - r290*SO2*OH - r291*DMS*OH - r292*DMS*OH + - r294*NH3*OH + d(HO2)/dt = j15*HO2NO2 + j61*CH3CHO + j62*POOH + 1.34*j66*MACR + .66*j67*MACR + j69*C2H5OOH + j71*C3H7OOH + + j74*CH3COCHO + j76*ONITR + j77*ISOPOOH + j78*HYAC + 2*j79*GLYALD + .56*j81*BIGALD + + 2*j82*GLYOXAL + .9*j83*ALKOOH + j86*TERPOOH + r89*M*HO2NO2 + r163*HOCH2OO + r175*EO + + r40*O1D*CH4 + r46*M*H*O2 + r52*OH*O3 + r57*OH*H2O2 + r62*H2O2*O + r63*M*HCN*OH + r64*CH3CN*OH + + r85*NO3*OH + r92*CL*H2O2 + r95*CL*CH2O + r98*CLO*OH + r101*CLO*CH3O2 + r119*BR*CH2O + + r121*BRO*OH + r137*CH3CL*CL + r138*CH3CL*OH + r141*CH3BR*OH + r142*CH3BR*CL + r151*M*CO*OH + + r152*CH2O*NO3 + r154*CH2O*O + r156*CH3O2*NO + 2*r158*CH3O2*CH3O2 + r160*CH3OH*OH + + r162*HCOOH*OH + r164*HOCH2OO*NO + .35*r169*M*C2H2*OH + .25*r172*EO2*NO + r174*EO*O2 + + .12*r176*C2H4*O3 + r178*C2H5O2*NO + r180*C2H5O2*CH3O2 + 1.2*r181*C2H5O2*C2H5O2 + + .9*r188*CH3CO3*CH3O2 + r191*GLYALD*OH + r192*GLYOXAL*OH + r193*C2H5OH*OH + .19*r197*C3H6*O3 + + r199*C3H7O2*NO + r201*C3H7O2*CH3O2 + r204*PO2*NO + .3*r210*RO2*CH3O2 + r212*HYAC*OH + + r217*ENEO2*NO + .06*r219*MVK*O3 + .275*r225*MACR*O3 + .47*r226*MACRO2*NO + .47*r228*MACRO2*NO3 + + .73*r230*MACRO2*CH3O2 + .47*r231*MACRO2*CH3CO3 + .2*r232*MACROOH*OH + r236*MCO3*CH3O2 + + .5*r241*M*MPAN*OH + .06*r243*ISOP*O3 + .92*r245*ISOPO2*NO + r246*ISOPO2*NO3 + r249*ISOPO2*CH3O2 + + r250*ISOPO2*CH3CO3 + .794*r251*ISOPNO3*NO + .794*r252*ISOPNO3*NO3 + r255*ONITR*OH + + r256*ONITR*NO3 + .9*r258*ALKO2*NO + r261*XO2*NO + r262*XO2*NO3 + .8*r264*XO2*CH3O2 + + r265*XO2*CH3CO3 + .25*r268*TOLUENE*OH + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + + .9*r279*XYLO2*NO + r281*C10H16*O3 + r283*TERPO2*NO + .5*r292*DMS*OH + - r296*HO2 - r48*H*HO2 - r49*H*HO2 - r50*H*HO2 - r53*OH*HO2 - r59*O*HO2 - r60*O3*HO2 + - 2*r61*HO2*HO2 - r74*NO*HO2 - r86*NO3*HO2 - r87*M*NO2*HO2 - r93*CL*HO2 - r94*CL*HO2 + - r100*CLO*HO2 - r118*BR*HO2 - r122*BRO*HO2 - r155*CH2O*HO2 - r157*CH3O2*HO2 - r165*HOCH2OO*HO2 + - r173*EO2*HO2 - r179*C2H5O2*HO2 - r187*CH3CO3*HO2 - r200*C3H7O2*HO2 - r205*PO2*HO2 + - r209*RO2*HO2 - r222*MEKO2*HO2 - r229*MACRO2*HO2 - r235*MCO3*HO2 - r247*ISOPO2*HO2 + - r253*ISOPNO3*HO2 - r259*ALKO2*HO2 - r263*XO2*HO2 - r270*TOLO2*HO2 - r275*BENO2*HO2 + - r278*XYLO2*HO2 - r284*TERPO2*HO2 + d(H2O2)/dt = .5*r296*HO2 + r55*M*OH*OH + r61*HO2*HO2 + - j22*H2O2 - r57*OH*H2O2 - r62*O*H2O2 - r92*CL*H2O2 + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j37*CH3CL + + 4*j38*CCL4 + 3*j39*CH3CCL3 + 2*j40*CFC11 + 2*j41*CFC12 + 2*j42*CFC113 + 2*j43*CFC114 + + j44*CFC115 + j45*HCFC22 + j46*HCFC141B + j47*HCFC142B + j50*CF2CLBR + j56*COFCL + + 2*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 2*r23*O1D*CFC113 + 2*r24*O1D*CFC114 + r25*O1D*CFC115 + + r26*O1D*HCFC22 + r27*O1D*HCFC141B + r28*O1D*HCFC142B + 4*r29*O1D*CCL4 + r31*O1D*CF2CLBR + + r38*O1D*COFCL + r43*O1D*HCL + r97*CLO*O + r98*CLO*OH + r101*CLO*CH3O2 + r102*CLO*NO + + 2*r104*CLO*CLO + r106*CLO*CLO + r109*HCL*OH + r110*HCL*O + r126*BRO*CLO + r138*CH3CL*OH + + 3*r139*CH3CCL3*OH + r140*HCFC22*OH + r143*HCFC141B*OH + r144*HCFC142B*OH + - r90*O3*CL - r91*H2*CL - r92*H2O2*CL - r93*HO2*CL - r94*HO2*CL - r95*CH2O*CL - r96*CH4*CL + - r112*HOCL*CL - r116*CLONO2*CL - r137*CH3CL*CL - r142*CH3BR*CL - r147*CH2BR2*CL - r148*CHBR3*CL + - r168*C2H6*CL + d(CL2)/dt = r105*CLO*CLO + r116*CLONO2*CL + r321*CLONO2*HCL + r322*HOCL*HCL + r326*CLONO2*HCL + r327*HOCL*HCL + + r332*CLONO2*HCL + r333*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r108*M*CL2O2 + r108*M*CL2O2 + r90*CL*O3 + r94*CL*HO2 + r111*HOCL*O + + r112*HOCL*CL + r113*HOCL*OH + r114*CLONO2*O + - j24*CLO - r97*O*CLO - r98*OH*CLO - r99*OH*CLO - r100*HO2*CLO - r101*CH3O2*CLO - r102*NO*CLO + - r103*M*NO2*CLO - 2*r104*CLO*CLO - 2*r105*CLO*CLO - 2*r106*CLO*CLO - 2*r107*M*CLO*CLO + - r125*BRO*CLO - r126*BRO*CLO - r127*BRO*CLO + d(OCLO)/dt = r106*CLO*CLO + r125*BRO*CLO + - j25*OCLO + d(CL2O2)/dt = r107*M*CLO*CLO + - j26*CL2O2 - r108*M*CL2O2 + d(HCL)/dt = r91*CL*H2 + r92*CL*H2O2 + r93*CL*HO2 + r95*CL*CH2O + r96*CL*CH4 + r99*CLO*OH + r112*HOCL*CL + + 2*r137*CH3CL*CL + r142*CH3BR*CL + r147*CH2BR2*CL + r148*CHBR3*CL + r168*C2H6*CL + - j28*HCL - r43*O1D*HCL - r109*OH*HCL - r110*O*HCL - r321*CLONO2*HCL - r322*HOCL*HCL + - r323*HOBR*HCL - r326*CLONO2*HCL - r327*HOCL*HCL - r332*CLONO2*HCL - r333*HOCL*HCL + - r334*HOBR*HCL + d(HOCL)/dt = r319*CLONO2 + r325*CLONO2 + r330*CLONO2 + r100*CLO*HO2 + r115*CLONO2*OH + - j27*HOCL - r111*O*HOCL - r112*CL*HOCL - r113*OH*HOCL - r322*HCL*HOCL - r327*HCL*HOCL + - r333*HCL*HOCL + d(CLONO2)/dt = r103*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r319*CLONO2 - r325*CLONO2 - r330*CLONO2 - r114*O*CLONO2 + - r115*OH*CLONO2 - r116*CL*CLONO2 - r321*HCL*CLONO2 - r326*HCL*CLONO2 - r332*HCL*CLONO2 + d(BRCL)/dt = r127*BRO*CLO + r323*HOBR*HCL + r334*HOBR*HCL + - j31*BRCL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*HBR + j35*BRONO2 + j48*CH3BR + j49*CF3BR + j50*CF2CLBR + + 3*j51*CHBR3 + 2*j52*CH2BR2 + 2*j53*H1202 + 2*j54*H2402 + r30*O1D*CH3BR + r31*O1D*CF2CLBR + + r32*O1D*CF3BR + 2*r33*O1D*H1202 + 2*r34*O1D*H2402 + 3*r35*O1D*CHBR3 + 2*r36*O1D*CH2BR2 + + r44*O1D*HBR + r120*BRO*O + r121*BRO*OH + r123*BRO*NO + r125*BRO*CLO + r126*BRO*CLO + + 2*r128*BRO*BRO + r129*HBR*OH + r130*HBR*O + r141*CH3BR*OH + r142*CH3BR*CL + 2*r145*CH2BR2*OH + + 3*r146*CHBR3*OH + 2*r147*CH2BR2*CL + 3*r148*CHBR3*CL + - r117*O3*BR - r118*HO2*BR - r119*CH2O*BR + d(BRO)/dt = j36*BRONO2 + r117*BR*O3 + r131*HOBR*O + r132*BRONO2*O + - j32*BRO - r120*O*BRO - r121*OH*BRO - r122*HO2*BRO - r123*NO*BRO - r124*M*NO2*BRO + - r125*CLO*BRO - r126*CLO*BRO - r127*CLO*BRO - 2*r128*BRO*BRO + d(HBR)/dt = r118*BR*HO2 + r119*BR*CH2O + - j34*HBR - r44*O1D*HBR - r129*OH*HBR - r130*O*HBR + d(HOBR)/dt = r320*BRONO2 + r328*BRONO2 + r331*BRONO2 + r122*BRO*HO2 + - j33*HOBR - r131*O*HOBR - r323*HCL*HOBR - r334*HCL*HOBR + d(BRONO2)/dt = r124*M*BRO*NO2 + - j35*BRONO2 - j36*BRONO2 - r320*BRONO2 - r328*BRONO2 - r331*BRONO2 - r132*O*BRONO2 + d(HCN)/dt = - r45*O1D*HCN - r63*M*OH*HCN + d(CH3CN)/dt = - r64*OH*CH3CN + d(C2H4)/dt = - r167*M*CL*C2H4 - r171*M*OH*C2H4 - r176*O3*C2H4 + d(C2H6)/dt = - r168*CL*C2H6 - r170*OH*C2H6 + d(C2H5O2)/dt = j80*MEK + r168*C2H6*CL + r170*C2H6*OH + .5*r182*C2H5OOH*OH + - r178*NO*C2H5O2 - r179*HO2*C2H5O2 - r180*CH3O2*C2H5O2 - 2*r181*C2H5O2*C2H5O2 + d(C2H5OOH)/dt = r179*C2H5O2*HO2 + - j69*C2H5OOH - r182*OH*C2H5OOH + d(CH3CO3)/dt = .6*j64*PAN + 1.34*j66*MACR + .3*j68*MVK + j72*ROOH + j73*CH3COCH3 + j74*CH3COCHO + j78*HYAC + + j80*MEK + .13*j81*BIGALD + j84*MEKOOH + r194*M*PAN + r183*CH3CHO*OH + r184*CH3CHO*NO3 + + .5*r190*CH3COOOH*OH + r208*RO2*NO + .3*r210*RO2*CH3O2 + r213*CH3COCHO*OH + r214*CH3COCHO*NO3 + + r221*MEKO2*NO + .53*r226*MACRO2*NO + .53*r228*MACRO2*NO3 + .26*r230*MACRO2*CH3O2 + + .53*r231*MACRO2*CH3CO3 + r233*MCO3*NO + r234*MCO3*NO3 + r236*MCO3*CH3O2 + 2*r238*MCO3*MCO3 + - r185*NO*CH3CO3 - r186*M*NO2*CH3CO3 - r187*HO2*CH3CO3 - r188*CH3O2*CH3CO3 + - 2*r189*CH3CO3*CH3CO3 - r231*MACRO2*CH3CO3 - r250*ISOPO2*CH3CO3 - r265*XO2*CH3CO3 + d(CH3COOH)/dt = .25*r187*CH3CO3*HO2 + .1*r188*CH3CO3*CH3O2 + .25*r197*C3H6*O3 + .25*r235*MCO3*HO2 + + .2*r243*ISOP*O3 + - r177*OH*CH3COOH + d(CH3CHO)/dt = j62*POOH + j69*C2H5OOH + .4*j83*ALKOOH + j84*MEKOOH + r178*C2H5O2*NO + .8*r180*C2H5O2*CH3O2 + + 1.6*r181*C2H5O2*C2H5O2 + .5*r182*C2H5OOH*OH + r193*C2H5OH*OH + .5*r197*C3H6*O3 + + .27*r199*C3H7O2*NO + r204*PO2*NO + r217*ENEO2*NO + .04*r219*MVK*O3 + r221*MEKO2*NO + + .4*r258*ALKO2*NO + - j61*CH3CHO - r183*OH*CH3CHO - r184*NO3*CH3CHO + d(C2H5OH)/dt = .2*r180*C2H5O2*CH3O2 + .4*r181*C2H5O2*C2H5O2 + - r193*OH*C2H5OH + d(GLYALD)/dt = r174*EO*O2 + .53*r226*MACRO2*NO + .53*r228*MACRO2*NO3 + .26*r230*MACRO2*CH3O2 + + .53*r231*MACRO2*CH3CO3 + .02*r245*ISOPO2*NO + .25*r261*XO2*NO + .25*r262*XO2*NO3 + + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j79*GLYALD - r191*OH*GLYALD + d(GLYOXAL)/dt = .13*j81*BIGALD + .45*j85*TOLOOH + .65*r169*M*C2H2*OH + .2*r191*GLYALD*OH + .02*r245*ISOPO2*NO + + .25*r261*XO2*NO + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + + .45*r269*TOLO2*NO + .9*r276*BENO2*NO + .34*r279*XYLO2*NO + - j82*GLYOXAL - r192*OH*GLYOXAL + d(CH3COOOH)/dt = .75*r187*CH3CO3*HO2 + .75*r235*MCO3*HO2 + - j63*CH3COOOH - r190*OH*CH3COOOH + d(EO2)/dt = r171*M*C2H4*OH + - r172*NO*EO2 - r173*HO2*EO2 + d(EO)/dt = j70*EOOH + .75*r172*EO2*NO + - r175*EO - r174*O2*EO + d(EOOH)/dt = r173*EO2*HO2 + - j70*EOOH + d(PAN)/dt = r186*M*CH3CO3*NO2 + - j64*PAN - r194*M*PAN - r195*OH*PAN + d(C3H6)/dt = .7*j68*MVK + .07*r243*ISOP*O3 + - r196*M*OH*C3H6 - r197*O3*C3H6 - r198*NO3*C3H6 + d(C3H8)/dt = - r203*OH*C3H8 + d(C3H7O2)/dt = r202*C3H7OOH*OH + r203*C3H8*OH + - r199*NO*C3H7O2 - r200*HO2*C3H7O2 - r201*CH3O2*C3H7O2 + d(C3H7OOH)/dt = r200*C3H7O2*HO2 + - j71*C3H7OOH - r202*OH*C3H7OOH + d(CH3COCH3)/dt = .82*j71*C3H7OOH + .25*j83*ALKOOH + .1*j86*TERPOOH + .82*r199*C3H7O2*NO + + .82*r201*C3H7O2*CH3O2 + .5*r217*ENEO2*NO + .25*r258*ALKO2*NO + .1*r283*TERPO2*NO + - j73*CH3COCH3 - r207*OH*CH3COCH3 + d(PO2)/dt = r196*M*C3H6*OH + .5*r206*POOH*OH + - r204*NO*PO2 - r205*HO2*PO2 + d(POOH)/dt = r205*PO2*HO2 + - j62*POOH - r206*OH*POOH + d(HYAC)/dt = .5*r206*POOH*OH + .2*r210*RO2*CH3O2 + .22*r226*MACRO2*NO + .22*r228*MACRO2*NO3 + + .23*r230*MACRO2*CH3O2 + .22*r231*MACRO2*CH3CO3 + .5*r241*M*MPAN*OH + .02*r245*ISOPO2*NO + + .25*r261*XO2*NO + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j78*HYAC - r212*OH*HYAC + d(RO2)/dt = r207*CH3COCH3*OH + r211*ROOH*OH + - r208*NO*RO2 - r209*HO2*RO2 - r210*CH3O2*RO2 + d(CH3COCHO)/dt = .18*j81*BIGALD + .45*j85*TOLOOH + .5*r210*RO2*CH3O2 + r212*HYAC*OH + r215*ONIT*OH + + .95*r219*MVK*O3 + .8*r225*MACR*O3 + .25*r226*MACRO2*NO + .25*r228*MACRO2*NO3 + + .24*r230*MACRO2*CH3O2 + .25*r231*MACRO2*CH3CO3 + .02*r245*ISOPO2*NO + .25*r261*XO2*NO + + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + .45*r269*TOLO2*NO + + .54*r279*XYLO2*NO + - j74*CH3COCHO - r213*OH*CH3COCHO - r214*NO3*CH3COCHO + d(ROOH)/dt = r209*RO2*HO2 + - j72*ROOH - r211*OH*ROOH + d(BIGENE)/dt = - r216*OH*BIGENE + d(BIGALK)/dt = - r254*OH*BIGALK + d(MEK)/dt = .8*j83*ALKOOH + .8*r258*ALKO2*NO + - j80*MEK - r220*OH*MEK + d(ENEO2)/dt = r216*BIGENE*OH + - r217*NO*ENEO2 + d(MEKO2)/dt = r220*MEK*OH + r223*MEKOOH*OH + - r221*NO*MEKO2 - r222*HO2*MEKO2 + d(MEKOOH)/dt = r222*MEKO2*HO2 + - j84*MEKOOH - r223*OH*MEKOOH + d(MCO3)/dt = j65*MPAN + .66*j66*MACR + r240*M*MPAN + .5*r224*MACR*OH + .5*r232*MACROOH*OH + .2*r243*ISOP*O3 + - r233*NO*MCO3 - r234*NO3*MCO3 - r235*HO2*MCO3 - r236*CH3O2*MCO3 - r237*CH3CO3*MCO3 + - 2*r238*MCO3*MCO3 - r239*M*NO2*MCO3 + d(MVK)/dt = .402*j77*ISOPOOH + j86*TERPOOH + .2*r243*ISOP*O3 + .32*r245*ISOPO2*NO + .35*r246*ISOPO2*NO3 + + .26*r249*ISOPO2*CH3O2 + .35*r250*ISOPO2*CH3CO3 + .039*r251*ISOPNO3*NO + .039*r252*ISOPNO3*NO3 + + .039*r253*ISOPNO3*HO2 + r281*C10H16*O3 + r283*TERPO2*NO + - j68*MVK - r218*OH*MVK - r219*O3*MVK + d(MACR)/dt = .288*j77*ISOPOOH + j86*TERPOOH + .4*r243*ISOP*O3 + .23*r245*ISOPO2*NO + .25*r246*ISOPO2*NO3 + + .19*r249*ISOPO2*CH3O2 + .25*r250*ISOPO2*CH3CO3 + .167*r251*ISOPNO3*NO + .167*r252*ISOPNO3*NO3 + + .167*r253*ISOPNO3*HO2 + r281*C10H16*O3 + r283*TERPO2*NO + - j66*MACR - j67*MACR - r224*OH*MACR - r225*O3*MACR + d(MACRO2)/dt = r218*MVK*OH + .5*r224*MACR*OH + .2*r232*MACROOH*OH + - r226*NO*MACRO2 - r227*NO*MACRO2 - r228*NO3*MACRO2 - r229*HO2*MACRO2 - r230*CH3O2*MACRO2 + - r231*CH3CO3*MACRO2 + d(MACROOH)/dt = r229*MACRO2*HO2 + - r232*OH*MACROOH + d(MPAN)/dt = r239*M*MCO3*NO2 + - j65*MPAN - r240*M*MPAN - r241*M*OH*MPAN + d(ONIT)/dt = r198*C3H6*NO3 + .1*r258*ALKO2*NO + - r215*OH*ONIT + d(ISOP)/dt = - r242*OH*ISOP - r243*O3*ISOP - r244*NO3*ISOP + d(ALKO2)/dt = r254*BIGALK*OH + r260*ALKOOH*OH + - r258*NO*ALKO2 - r259*HO2*ALKO2 + d(ALKOOH)/dt = r259*ALKO2*HO2 + - j83*ALKOOH - r260*OH*ALKOOH + d(BIGALD)/dt = .9*j85*TOLOOH + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + .62*r279*XYLO2*NO + - j81*BIGALD + d(HYDRALD)/dt = .33*r245*ISOPO2*NO + .4*r246*ISOPO2*NO3 + .3*r249*ISOPO2*CH3O2 + .4*r250*ISOPO2*CH3CO3 + + r255*ONITR*OH + r256*ONITR*NO3 + - r257*OH*HYDRALD + d(ISOPO2)/dt = r242*ISOP*OH + .2*r248*ISOPOOH*OH + - r245*NO*ISOPO2 - r246*NO3*ISOPO2 - r247*HO2*ISOPO2 - r249*CH3O2*ISOPO2 - r250*CH3CO3*ISOPO2 + d(ISOPNO3)/dt = r244*ISOP*NO3 + - r251*NO*ISOPNO3 - r252*NO3*ISOPNO3 - r253*HO2*ISOPNO3 + d(ONITR)/dt = .8*r227*MACRO2*NO + .08*r245*ISOPO2*NO + .794*r251*ISOPNO3*NO + .794*r252*ISOPNO3*NO3 + + .794*r253*ISOPNO3*HO2 + - j76*ONITR - r255*OH*ONITR - r256*NO3*ONITR + d(XO2)/dt = .8*r248*ISOPOOH*OH + r257*HYDRALD*OH + r266*XOOH*OH + - r261*NO*XO2 - r262*NO3*XO2 - r263*HO2*XO2 - r264*CH3O2*XO2 - r265*CH3CO3*XO2 + d(XOOH)/dt = r263*XO2*HO2 + - j75*XOOH - r266*OH*XOOH - r267*OH*XOOH + d(ISOPOOH)/dt = r247*ISOPO2*HO2 + - j77*ISOPOOH - r248*OH*ISOPOOH + d(TOLUENE)/dt = - r268*OH*TOLUENE + d(CRESOL)/dt = .25*r268*TOLUENE*OH + - r272*OH*CRESOL + d(TOLO2)/dt = .7*r268*TOLUENE*OH + r271*TOLOOH*OH + - r269*NO*TOLO2 - r270*HO2*TOLO2 + d(TOLOOH)/dt = r270*TOLO2*HO2 + - j85*TOLOOH - r271*OH*TOLOOH + d(XOH)/dt = r272*CRESOL*OH + - r273*NO2*XOH + d(BENZENE)/dt = - r274*OH*BENZENE + d(BENO2)/dt = r274*BENZENE*OH + - r275*HO2*BENO2 - r276*NO*BENO2 + d(BENOOH)/dt = r275*BENO2*HO2 + d(XYLENE)/dt = - r277*OH*XYLENE + d(XYLO2)/dt = r277*XYLENE*OH + - r278*HO2*XYLO2 - r279*NO*XYLO2 + d(XYLOOH)/dt = r278*XYLO2*HO2 + d(C10H16)/dt = - r280*OH*C10H16 - r281*O3*C10H16 - r282*NO3*C10H16 + d(TERPO2)/dt = r280*C10H16*OH + r282*C10H16*NO3 + r285*TERPOOH*OH + - r283*NO*TERPO2 - r284*HO2*TERPO2 + d(TERPOOH)/dt = r284*TERPO2*HO2 + - j86*TERPOOH - r285*OH*TERPOOH + d(CH3CL)/dt = - j37*CH3CL - r137*CL*CH3CL - r138*OH*CH3CL + d(CH3BR)/dt = - j48*CH3BR - r30*O1D*CH3BR - r141*OH*CH3BR - r142*CL*CH3BR + d(CFC11)/dt = - j40*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j41*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j42*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j45*HCFC22 - r26*O1D*HCFC22 - r140*OH*HCFC22 + d(CCL4)/dt = - j38*CCL4 - r29*O1D*CCL4 + d(CH3CCL3)/dt = - j39*CH3CCL3 - r139*OH*CH3CCL3 + d(CF3BR)/dt = - j49*CF3BR - r32*O1D*CF3BR + d(CF2CLBR)/dt = - j50*CF2CLBR - r31*O1D*CF2CLBR + d(HCFC141B)/dt = - j46*HCFC141B - r27*O1D*HCFC141B - r143*OH*HCFC141B + d(HCFC142B)/dt = - j47*HCFC142B - r28*O1D*HCFC142B - r144*OH*HCFC142B + d(CFC114)/dt = - j43*CFC114 - r24*O1D*CFC114 + d(CFC115)/dt = - j44*CFC115 - r25*O1D*CFC115 + d(H1202)/dt = - j53*H1202 - r33*O1D*H1202 + d(H2402)/dt = - j54*H2402 - r34*O1D*H2402 + d(CHBR3)/dt = - j51*CHBR3 - r35*O1D*CHBR3 - r146*OH*CHBR3 - r148*CL*CHBR3 + d(CH2BR2)/dt = - j52*CH2BR2 - r36*O1D*CH2BR2 - r145*OH*CH2BR2 - r147*CL*CH2BR2 + d(CO2)/dt = .44*j60*CH4 + j63*CH3COOOH + .4*j64*PAN + r150*CO*OH + r151*M*CO*OH + r162*HCOOH*OH + + r177*CH3COOH*OH + r185*CH3CO3*NO + .9*r188*CH3CO3*CH3O2 + 2*r189*CH3CO3*CH3CO3 + + .5*r190*CH3COOOH*OH + .8*r191*GLYALD*OH + r192*GLYOXAL*OH + r236*MCO3*CH3O2 + + 2*r237*MCO3*CH3CO3 + 2*r238*MCO3*MCO3 + .5*r241*M*MPAN*OH + r265*XO2*CH3CO3 + - j58*CO2 - j114*CO2 - r339*Op*CO2 + d(N2p)/dt = j94*N2 + j106*N2 + - r337*O*N2p - r338*O*N2p - r345*O2*N2p - r349*e*N2p + d(O2p)/dt = j93*O2 + j105*O2 + r335*Op*O2 + r339*Op*CO2 + r342*Np*O2 + r345*N2p*O2 + - r346*N2*O2p - r340*N*O2p - r341*NO*O2p - r348*e*O2p + d(Np)/dt = j98*N2 + j99*N2 + j110*N2 + j111*N2 + j92*N + - r342*O2*Np - r343*O2*Np - r344*O*Np + d(Op)/dt = j89*O + j90*O + j91*O + j95*O2 + j96*O2 + j97*O2 + j102*O + j103*O + j104*O + j107*O2 + + j108*O2 + j109*O2 + r338*N2p*O + r344*Np*O + - r336*N2*Op - r335*O2*Op - r339*CO2*Op + d(NOp)/dt = j7*NO + r336*N2*Op + r346*N2*O2p + r337*N2p*O + r340*O2p*N + r341*O2p*NO + r343*Np*O2 + - r347*e*NOp + d(e)/dt = j94*N2 + j98*N2 + j99*N2 + j106*N2 + j110*N2 + j111*N2 + j7*NO + j89*O + j90*O + j91*O + j92*N + + j93*O2 + j95*O2 + j96*O2 + j97*O2 + j102*O + j103*O + j104*O + j105*O2 + j107*O2 + j108*O2 + + j109*O2 + - r347*NOp*e - r348*O2p*e - r349*N2p*e + d(N2D)/dt = j99*N2 + 1.2*j101*N2 + j111*N2 + 1.2*j113*N2 + r337*N2p*O + .8*r347*NOp*e + .9*r349*N2p*e + - r65*O2*N2D - r66*O*N2D + d(H2O)/dt = .05*j60*CH4 + r50*H*HO2 + r53*OH*HO2 + r54*OH*OH + r56*OH*H2 + r57*OH*H2O2 + r82*HNO3*OH + + r88*HO2NO2*OH + r109*HCL*OH + r113*HOCL*OH + r129*HBR*OH + r138*CH3CL*OH + r139*CH3CCL3*OH + + r140*HCFC22*OH + r141*CH3BR*OH + r145*CH2BR2*OH + r149*CH4*OH + r153*CH2O*OH + r161*CH3OOH*OH + + r162*HCOOH*OH + r170*C2H6*OH + r177*CH3COOH*OH + r183*CH3CHO*OH + r190*CH3COOOH*OH + + r202*C3H7OOH*OH + r203*C3H8*OH + r206*POOH*OH + r207*CH3COCH3*OH + r211*ROOH*OH + + r213*CH3COCHO*OH + .5*r224*MACR*OH + r266*XOOH*OH + r267*XOOH*OH + r294*NH3*OH + r322*HOCL*HCL + + r323*HOBR*HCL + r327*HOCL*HCL + r333*HOCL*HCL + r334*HOBR*HCL + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r133*F*H2O + d(C2H2)/dt = - r166*M*CL*C2H2 - r169*M*OH*C2H2 + d(HCOOH)/dt = r164*HOCH2OO*NO + r165*HOCH2OO*HO2 + .35*r169*M*C2H2*OH + .5*r176*C2H4*O3 + - r162*OH*HCOOH + d(HOCH2OO)/dt = r155*CH2O*HO2 + - r163*HOCH2OO - r164*NO*HOCH2OO - r165*HO2*HOCH2OO + d(COF2)/dt = j41*CFC12 + j42*CFC113 + 2*j43*CFC114 + 2*j44*CFC115 + j45*HCFC22 + j47*HCFC142B + j49*CF3BR + + j50*CF2CLBR + j53*H1202 + 2*j54*H2402 + r22*O1D*CFC12 + r23*O1D*CFC113 + 2*r24*O1D*CFC114 + + 2*r25*O1D*CFC115 + r26*O1D*HCFC22 + r28*O1D*HCFC142B + r31*O1D*CF2CLBR + r32*O1D*CF3BR + + r33*O1D*H1202 + 2*r34*O1D*H2402 + r140*HCFC22*OH + r144*HCFC142B*OH + - j55*COF2 - r37*O1D*COF2 + d(COFCL)/dt = j40*CFC11 + j42*CFC113 + j46*HCFC141B + r21*O1D*CFC11 + r23*O1D*CFC113 + r27*O1D*HCFC141B + + r143*HCFC141B*OH + - j56*COFCL - r38*O1D*COFCL + d(HF)/dt = r133*F*H2O + r134*F*H2 + r135*F*CH4 + r136*F*HNO3 + - j57*HF + d(F)/dt = j44*CFC115 + j49*CF3BR + 2*j55*COF2 + j56*COFCL + j57*HF + r25*O1D*CFC115 + r32*O1D*CF3BR + + 2*r37*O1D*COF2 + r38*O1D*COFCL + - r133*H2O*F - r134*H2*F - r135*CH4*F - r136*HNO3*F + d(CB1)/dt = - r289*CB1 - r297*CB1 + d(CB2)/dt = r289*CB1 + - r298*CB2 + d(OC1)/dt = - r295*OC1 - r299*OC1 + d(OC2)/dt = r295*OC1 + - r300*OC2 + d(SOAM)/dt = - r302*SOAM + d(SOAI)/dt = - r303*SOAI + d(SOAT)/dt = - r305*SOAT + d(SOAB)/dt = - r304*SOAB + d(SOAX)/dt = - r306*SOAX + d(SOGM)/dt = 0 + d(SOGI)/dt = 0 + d(SOGT)/dt = 0 + d(SOGB)/dt = 0 + d(SOGX)/dt = 0 + d(SO2)/dt = r291*DMS*OH + .5*r292*DMS*OH + r293*DMS*NO3 + - r290*OH*SO2 + d(DMS)/dt = - r291*OH*DMS - r292*OH*DMS - r293*NO3*DMS + d(SO4)/dt = r290*SO2*OH + - r301*SO4 + d(NH3)/dt = - r294*OH*NH3 + d(NH4)/dt = - r307*NH4 + d(NH4NO3)/dt = - r308*NH4NO3 + d(SSLT01)/dt = - r309*SSLT01 + d(SSLT02)/dt = - r310*SSLT02 + d(SSLT03)/dt = - r311*SSLT03 + d(SSLT04)/dt = - r312*SSLT04 + d(DST01)/dt = - r313*DST01 + d(DST02)/dt = - r314*DST02 + d(DST03)/dt = - r315*DST03 + d(DST04)/dt = - r316*DST04 + d(NH_5)/dt = - r350*NH_5 + d(NH_50)/dt = - r351*NH_50 + d(NH_50W)/dt = - r352*NH_50W + d(AOA_NH)/dt = 0 + d(ST80_25)/dt = - r353*ST80_25 + d(CO_25)/dt = - r354*CO_25 + d(CO_50)/dt = - r355*CO_50 + d(SO2t)/dt = - r317*SO2t + d(SF6)/dt = - j87*SF6 + d(SF6em)/dt = - j88*SF6em + d(O3S)/dt = 0 + d(E90)/dt = - r356*E90 + d(E90_NH)/dt = - r357*E90_NH + d(E90_SH)/dt = - r358*E90_SH diff --git a/src/chemistry/pp_waccm_tsmlt/chem_mech.in b/src/chemistry/pp_waccm_tsmlt/chem_mech.in new file mode 100644 index 0000000000..91c043612a --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/chem_mech.in @@ -0,0 +1,779 @@ +* MOZART-4 mechanism (as in Emmons et al., 2010) +* plus: HCN, CH3CN, C2H2, HCOOH, HOCH2OO +* for use with photolysis lookup table +* Nov 8, 2010: RO2+CH3O2 rate corrected +* Jan 19, 2010: stratospheric species added (WACCM4) +* April 26, 2011: sync 133spc to trop_mozart and JPL06 +* March 15, 2012: correct HCN+OH and MPAN+OH (add +M) +* Jan 23, 2013: change to JPL2010, ADDED EOOH, +Wegner stratospheric chemistry updates +* Jan 23, 2013: add HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 +* Feb 19, 2013: final modifications to trop/strat. DEK. +* Mar 2013: Added SOA from Colette Heald (new species + reactions soa4-10) +* Sep 10, 2014: CCMI TSMLT merged with SOA mechanism; modified CH4 + hv products (DEK). +* Sep 10, 2014 (LKE): updated products of ISOPO2+NO, ISOPO2+NO3, ISOPNO3+HO2, XO2+NO, +* XO2+NO3,XO2+CH3O2,XO2+CH3CO3. Cleaned up labels, comments for benzene,xylene + + SPECIES + + Solution + O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH3OH, CH2O, CO + H2, H, OH, HO2, H2O2 + CLY, BRY + CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + HCN, CH3CN, C2H4, C2H6, C2H5O2, C2H5OOH, CH3CO3, CH3COOH, CH3CHO, C2H5OH, GLYALD -> HOCH2CHO + GLYOXAL -> C2H2O2, CH3COOOH, EO2 -> HOCH2CH2O2, EO -> HOCH2CH2O, EOOH -> HOCH2CH2OOH, PAN -> CH3CO3NO2 + C3H6, C3H8, C3H7O2, C3H7OOH, CH3COCH3, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH, HYAC -> CH3COCH2OH + RO2 -> CH3COCH2O2, CH3COCHO, ROOH -> CH3COCH2OOH + BIGENE -> C4H8, BIGALK -> C5H12, MEK -> C4H8O, ENEO2 -> C4H9O3, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3 + MCO3 -> CH2CCH3CO3, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO + MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH, MPAN -> CH2CCH3CO3NO2, ONIT -> CH3COCH2ONO2 + ISOP -> C5H8, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, BIGALD -> C5H6O2, HYDRALD -> HOCH2CCH3CHCHO + ISOPO2 -> HOCH2COOCH3CHCH2, ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH + XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO, ISOPOOH -> HOCH2COOHCH3CHCH2 + TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5, XOH -> C7H10O6 + BENZENE -> C6H6, BENO2 -> C6H7O3, BENOOH -> C6H8O3 + XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLOOH -> C8H12O3 + C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3 + CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl + CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 + CFC114 -> CClF2CClF2, CFC115 -> CClF2CF3, H1202 -> CBr2F2 + H2402 ->CBrF2CBrF2, CHBR3 -> CHBr3, CH2BR2 -> CH2Br2 + CO2, N2p -> N2, O2p -> O2 + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N, H2O + C2H2, HCOOH, HOCH2OO, COF2, COFCL -> COFCl, HF, F + CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C + SOAM -> C10H16O4, SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3 + SOGM -> C10H16O4, SOGI -> CH3C4H9O4, SOGT -> C7H9O3, SOGB -> C6H7O3, SOGX -> C8H11O3 + SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3 + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + NH_5 -> CO, NH_50 -> CO, NH_50W -> CO, AOA_NH -> CO, ST80_25 -> CO, CO_25 -> CO, CO_50 -> CO + SO2t -> SO2, SF6, SF6em -> SF6, O3S -> O3 + E90 -> CO, E90_NH -> CO, E90_SH -> CO + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + END Species + + Solution classes + Explicit + O3S, CH4, N2O, CH3CL, CH3BR, CFC11, CFC12, CFC113 + CFC114, CFC115, HCFC22, HCFC141B, HCFC142B, CCL4 + CH3CCL3, CF3BR, CF2CLBR, H1202, H2402, CHBR3, CH2BR2 + CO2, CLY, BRY, E90, E90_NH, E90_SH, NH_5, NH_50, NH_50W, + AOA_NH, ST80_25, CO_25, CO_50, SO2t, SF6, SF6em + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D, H2, CO + N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, HCN, CH3CN, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e + C3H6, ISOP, PO2, CH3CHO, CH3COOH + POOH, CH3CO3, CH3COOOH, PAN, ONIT, C2H6, C2H4, BIGALK, MPAN + BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE + CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL + BENZENE, BENO2, BENOOH, XYLENE, XYLO2, XYLOOH + ISOPO2, MVK, MACR, MACRO2, MACROOH + MCO3, C2H5O2, C2H5OOH, C10H16 + C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH + CH3OH, C2H5OH, GLYALD, HYAC, EO2 + EO, EOOH, HYDRALD, RO2, CH3COCHO, ISOPNO3, ONITR + XO2, XOOH, ISOPOOH + C2H2, HCOOH, HOCH2OO, COF2, COFCL, HF, F + SO2, DMS, SO4, NH3, NH4, NH4NO3, SOAM, SOAI, SOAT, SOAB, SOAX + SOGM, SOGI, SOGT, SOGB, SOGX + CB1, CB2, OC1, OC2 + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> CL + O + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jhbr] HBR + hv -> BR + H + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 2*CL + COFCL + [jcf2cl2] CFC12 + hv -> 2*CL + COF2 + [jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 + [jcfc114] CFC114 + hv -> 2*CL + 2*COF2 + [jcfc115] CFC115 + hv -> CL + F + 2*COF2 + [jhcfc22] HCFC22 + hv -> CL + COF2 + [jhcfc141b] HCFC141B + hv -> CL + COFCL + [jhcfc142b] HCFC142B + hv -> CL + COF2 + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + F + COF2 + [jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 + [jchbr3] CHBR3 + hv -> 3*BR + [jch2br2] CH2BR2 + hv -> 2*BR + [jh1202] H1202 + hv -> 2*BR + COF2 + [jh2402] H2402 + hv -> 2*BR + 2*COF2 + [jcof2] COF2 + hv -> 2*F + [jcofcl] COFCL + hv -> F + CL + [jhf] HF + hv -> H + F + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O + [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 + [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH + [jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 + [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 + [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 + [jmacr_a] MACR + hv -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3 + [jmacr_b] MACR + hv -> .66 * HO2 + 1.34 * CO + [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3 + [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH + [jeooh->,jch3ooh] EOOH + hv -> EO + OH + [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2 + [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH + [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 + [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 + [jxooh->,jch3ooh] XOOH + hv -> OH + [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O + [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2 + [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O + [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O + [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 + [jbigald->,0.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL +.56*HO2 + .13*CH3CO3 + .18*CH3COCHO + [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 + [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH + [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO + [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR + [jsf6] SF6 + hv -> sink + [jsf6em->jsf6,jsf6] SF6em + hv -> sink + +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op + e + [jeuv_3=userdefined,userdefined] O + hv -> Op + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op + e + [jeuv_16=userdefined,userdefined] O + hv -> Op + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 + +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + [O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60. + [O1D_N2Oa] O1D + N2O -> 2*NO ; 7.25e-11, 20. + [O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.63e-11, 20. + [O1D_O3] O1D + O3 -> O2 + O2 ; 1.20e-10 + [O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.02e-10 + [O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 + [O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 1.50e-10 + [O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 9.75e-11 + [O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 1.50e-11 + [O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.20e-11 + [O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 + [O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.628e-10 + [O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.84e-10 + [O1D_CH3BR] O1D + CH3BR -> BR ; 1.674e-10 + [O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.60e-11 + [O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.10e-11 + [O1D_H1202] O1D + H1202 -> 2*BR + COF2 ; 1.012e-10 + [O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.20e-10 + [O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.49e-10 + [O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 + [O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 + [O1D_COFCL] O1D + COFCL -> F + CL ; 1.90e-10 + [O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 + [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.50e-11 + [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9.00e-12 + [O1D_H2] O1D + H2 -> H + OH ; 1.20e-10 + [O1D_HCL] O1D + HCL -> CL + OH ; 1.50e-10 + [O1D_HBR] O1D + HBR -> BR + OH ; 1.20e-10 + [O1D_HCN] O1D + HCN -> OH ; 7.70e-11, 100. + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 7.5e-11, -0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [H_HO2a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [H_HO2b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 1.80e-11, 180. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + [OH_OH] OH + OH -> H2O + O ; 1.80e-12 + [OH_OH_M] OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6 + [OH_H2] OH + H2 -> H2O + H ; 2.80e-12, -1800. + [OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [H2_O] H2 + O -> OH + H ; 1.60e-11, -4570. + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + [HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8 + [CH3CN_OH] CH3CN + OH -> HO2 ; 7.80e-13, -1050. + +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_OH] N + OH -> NO + H ; 5.00e-11 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + [N_NO2a] N + NO2 -> N2O + O ; 2.90e-12, 220. + [N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220. + [N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220. + [NO_O_M] NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.30e-12, 270. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.10e-12, 210. + [NO2_O_M] NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + [NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + [NO3_NO] NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + [NO3_O] NO3 + O -> NO2 + O2 ; 1.00e-11 + [NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.20e-11 + [NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + [HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + [CL_O3] CL + O3 -> CLO + O2 ; 2.30e-11, -200. + [CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270. + [CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + [CL_HO2a] CL + HO2 -> HCL + O2 ; 1.40e-11, 270. + [CL_HO2b] CL + HO2 -> OH + CLO ; 3.60e-11, -375. + [CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + [CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + [CLO_O] CLO + O -> CL + O2 ; 2.80e-11, 85. + [CLO_OHa] CLO + OH -> CL + HO2 ; 7.40e-12, 270. + [CLO_OHb] CLO + OH -> HCL + O2 ; 6.00e-13, 230. + [CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.60e-12, 290. + [CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115. + [CLO_NO] CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + [CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + [CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + [CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + [CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 3.0e-12, 2.0, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + [HCL_OH] HCL + OH -> H2O + CL ; 1.80e-12, -250. + [HCL_O] HCL + O -> CL + OH ; 1.00e-11, -3300. + [HOCL_O] HOCL + O -> CLO + OH ; 1.70e-13 + [HOCL_CL] HOCL + CL -> HCL + CLO ; 3.40e-12, -130. + [HOCL_OH] HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + [CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.60e-12, -840. + [CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + [CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + [BR_O3] BR + O3 -> BRO + O2 ; 1.60e-11, -780. + [BR_HO2] BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + [BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + [BRO_O] BRO + O -> BR + O2 ; 1.90e-11, 230. + [BRO_OH] BRO + OH -> BR + HO2 ; 1.70e-11, 250. + [BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + [BRO_NO] BRO + NO -> BR + NO2 ; 8.80e-12, 260. + [BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + [BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + [BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + [BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + [BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + [HBR_OH] HBR + OH -> BR + H2O ; 5.50e-12, 200. + [HBR_O] HBR + O -> BR + OH ; 5.80e-12, -1500. + [HOBR_O] HOBR + O -> BRO + OH ; 1.20e-10, -430. + [BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Odd Flourine Reactions +* -------------------------------------------------------------- + [F_H2O] F + H2O -> HF + OH ; 1.40e-11, 0. + [F_H2] F + H2 -> HF + H ; 1.40e-10, -500. + [F_CH4] F + CH4 -> HF + CH3O2 ; 1.60e-10, -260. + [F_HNO3] F + HNO3 -> HF + NO3 ; 6.00e-12, 400. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + [CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + [CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + [CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + [HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 1.05e-12, -1600. + [CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + [CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.40e-11, -1030. + [HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600. + [HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.30e-12, -1770. + [CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2.00e-12, -840. + [CHBR3_OH] CHBR3 + OH -> 3*BR ; 1.35e-12, -600. + [CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.30e-12, -800. + [CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850. + +* -------------------------------------------------------------- +* C-1 Degradation (Methane, CO, CH2O and derivatives) +* -------------------------------------------------------------- + [CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + [usr_CO_OH_b] CO + OH -> CO2 + H + [CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058. + [CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + [CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + [CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625. + [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + [CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + [CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.00e-13, -424. + [CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.90e-14, 706. + [CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.90e-12, -345. + [CH3OOH_OH] CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.80e-12, 200. + [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4.50e-13 + [HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.40e12, -7000. + [HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.60e-12, 265. + [HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.50e-13, 700. + +* -------------------------------------------------------------- +* C-2 Degradation +* +* EO = HOCH2CH2O +* EO2 = HOCH2CH2O2 +* EOOH = HOCH2CH2OOH +* PAN = CH3CO3NO2 +* GLYALD = HOCH2CHO +* GLYOXAL= C2H2O2 +* C2H2 = C2H2 +* -------------------------------------------------------------- + [C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.20e-30, 2.4, 2.2e-10, 0.7, 0.6 + [C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.60e-29, 3.3, 3.1e-10, 1.0, 0.6 + [C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.20e-11, -70. + [C2H2_OH_M] C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.50e-30, 0.0, 8.3e-13, -2.0, 0.6 + + .35*CO + M + [C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020. + [tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.60e-29, 3.1, 9.00e-12, 0.85, 0.48 + [EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.20e-12, 180. + [EO2_HO2] EO2 + HO2 -> EOOH ; 7.50e-13, 700. + [EO_O2] EO + O2 -> GLYALD + HO2 ; 1.00e-14 + [EO_M] EO -> 2 * CH2O + HO2 ; 1.60e11, -4150. + [C2H4_O3] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630. + [CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.00e-13 + [C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.60e-12, 365. + [C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.50e-13, 700. + [C2H5O2_CH3O2] C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.00e-13 + + .3 * CH3OH + .2 * C2H5OH + [C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.80e-14 + [C2H5OOH_OH] C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.80e-12, 200. + [CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350. + [CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.40e-12, -1900. + [CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.10e-12, 270. + [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 9.70e-29, 5.6, 9.30e-12, 1.5, 0.6 + [CH3CO3_HO2] CH3CO3 + HO2 -> .75 * CH3COOOH + .25 * CH3COOH + .25 * O3 ; 4.30e-13, 1040. + [CH3CO3_CH3O2] CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.00e-12, 500. + + .9*CO2 + .1*CH3COOH + [CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.50e-12, 500. + [CH3COOOH_OH] CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1.00e-12 + [GLYALD_OH] GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.00e-11 + [GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 + [C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.90e-12, -230. + [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M + [PAN_OH] PAN + OH -> CH2O + NO3 ; 4.00e-14 + +* -------------------------------------------------------------- +* C-3 Degradation +* +* PO2 = C3H6OHO2 +* POOH = C3H6OHOOH +* RO2 = CH3COCH2O2 +* ROOH = CH3COCH2OOH +* HYAC = CH3COCH2OH +* ONIT = CH3COCH2ONO2 +* -------------------------------------------------------------- + [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5 + [C3H6_O3] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 ; 6.50e-15, -1900. + + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + [C3H6_NO3] C3H6 + NO3 -> ONIT ; 4.60e-13, -1156. + [C3H7O2_NO] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.20e-12, 180. + [C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.50e-13, 700. + [CH3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40. + [CH3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.80e-12, 200. + [C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 8.70e-12, -615. + [PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.20e-12, 180. + [PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.50e-13, 700. + [POOH_OH] POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.80e-12, 200. + [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O + [RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.90e-12, 300. + [RO2_HO2] RO2 + HO2 -> ROOH + O2 ; 8.60e-13, 700. + [RO2_CH3O2] RO2 + CH3O2 -> .3*CH3CO3 + .8* CH2O + .3*HO2 + .2*HYAC ; 7.10e-13, 500. + + .5*CH3COCHO + .5*CH3OH + [ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.80e-12, 200. + [HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3.00e-12 + [CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.40e-13, 830. + [CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.40e-12, -1860. + [ONIT_OH] ONIT + OH -> NO2 + CH3COCHO ; 6.80e-13 + +* -------------------------------------------------------------- +* C-4 Degradation +* BIGENE -> C4H8 +* ENEO2 = C4H9O3 +* MEK = C4H8O +* MEKO2 = C4H7O3 +* MEKOOH = C4H8O3 +* MVK = CH2CHCOCH3 +* MACR = CH2CCH3CHO +* MACRO2 = CH3COCHO2CH2OH +* MACROOH = CH3COCHOOHCH2OH +* MCO3 = CH2CCH3CO3 +* MPAN = CH2CCH3CO3NO2 +* -------------------------------------------------------------- + [BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.40e-11 + [ENEO2_NO] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.20e-12, 180. + [MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452. + [MVK_O3] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH ; 7.52e-16, -1521. + + .2 * O3 + .06 * HO2 + .05 * CO + .04 * CH3CHO + [MEK_OH] MEK + OH -> MEKO2 ; 2.30e-12, -170. + [MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.20e-12, 180. + [MEKO2_HO2] MEKO2 + HO2 -> MEKOOH ; 7.50e-13, 700. + [MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.80e-12, 200. + [MACR_OH] MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175. + [MACR_O3] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO ; 4.40e-15, -2500. + + .2 * O3 + .7 * CH2O + .215 * OH + [MACRO2_NOa] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.70e-12, 360. + + .53 * GLYALD + .25 * CH3COCHO + + .53 * CH3CO3 + .22 * HYAC + .22 * CO + [MACRO2_NOb] MACRO2 + NO -> 0.8*ONITR ; 1.30e-13, 360. + [MACRO2_NO3] MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O ; 2.40e-12 + + .25 * CH3COCHO + .22 * CO + + .53 * GLYALD + .22*HYAC + .53*CH3CO3 + [MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8.00e-13, 700. + [MACRO2_CH3O2] MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO ; 5.00e-13, 400. + + .24 * CH3COCHO + + .26 * GLYALD + .26 * CH3CO3 + + .25 * CH3OH + .23 * HYAC + [MACRO2_CH3CO3] MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO ; 1.40e-11 + + .47 * HO2 + .53 * GLYALD + + .22 * HYAC + .25*CH2O + .53*CH3CO3 + [MACROOH_OH] MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.30e-11, 200. + [MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.30e-12, 360. + [MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.00e-12 + [MCO3_HO2] MCO3 + HO2 -> .25 * O3 + .25 * CH3COOH + .75 * CH3COOOH ; 4.30e-13, 1040. + + .75 * O2 + [MCO3_CH3O2] MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.00e-12, 500. + [MCO3_CH3CO3] MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.60e-12, 530. + [MCO3_MCO3] MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.30e-12, 530. + [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M + [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M + [MPAN_OH_M] MPAN + OH + M -> .5 * HYAC + .5 * NO3 + .5 * CH2O ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5 + + .5 *HO2 + 0.5 * CO2 + M + +* -------------------------------------------------------------- +* C-5 Degradation +* +* ISOP = C5H8 +* ISOPO2 = HOCH2COOCH3CHCH2 +* ISOPNO3 = CH2CHCCH3OOCH2ONO2 +* ISOPOOH = HOCH2COOHCH3CHCH2 +* BIGALK = C5H12, +* ALKO2 = C5H11O2 +* ALKOOH = C5H12O2 +* ONITR = CH2CCH3CHONO2CH2OH +* XO2 = HOCH2COOCH3CHOHCHO +* XOOH = HOCH2COOHCH3CHOHCHO +* -------------------------------------------------------------- + [ISOP_OH] ISOP + OH -> ISOPO2 ; 2.54e-11, 410. + [ISOP_O3] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000. + + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3 + + .2 * MCO3 + .2 * CH3COOH + [ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446. + [ISOPO2_NO] ISOPO2 + NO -> .08*ONITR + .92*NO2 + .23*MACR + .32*MVK ; 4.40e-12, 180. + + .33*HYDRALD + .02*GLYOXAL + .02*GLYALD + + .02*CH3COCHO + .02*HYAC + .55*CH2O + .92*HO2 + [ISOPO2_NO3] ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.40e-12 + + .35 * MVK + .4 * HYDRALD + [ISOPO2_HO2] ISOPO2 + HO2 -> ISOPOOH ; 8.00e-13, 700. + [ISOPOOH_OH] ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200. + [ISOPO2_CH3O2] ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.00e-13, 400. + + .19 * MACR + .26 * MVK + .3 * HYDRALD + [ISOPO2_CH3CO3] ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.40e-11 + + .25 * MACR + .35 * MVK + .4 * HYDRALD + [ISOPNO3_NO] ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O ; 2.70e-12, 360. + + .167 * MACR + .039 * MVK + .794 * ONITR + [ISOPNO3_NO3] ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR ; 2.40e-12 + + .039 * MVK + .794 * ONITR + .794 * HO2 + [ISOPNO3_HO2] ISOPNO3 + HO2 -> .206*NO2 + .206*CH2O +.206*OH ; 8.00e-13, 700. + + .167 * MACR + .039 * MVK + .794 * ONITR + [BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.50e-12 + [ONITR_OH] ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.50e-11 + [ONITR_NO3] ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.40e-12, -1860. + [HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175. + [ALKO2_NO] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 ; 4.20e-12, 180. + + .9*HO2 + .8*MEK + .9*NO2 + .1*ONIT + [ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.50e-13, 700. + [ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.80e-12, 200. + [XO2_NO] XO2 + NO -> NO2 + HO2 + .25*CO + .25*CH2O + .25*GLYOXAL ; 2.7e-12, 360. + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + [XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12 + + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD + [XO2_HO2] XO2 + HO2 -> XOOH ; 8.00e-13, 700. + [XO2_CH3O2] XO2 + CH3O2 -> .3*CH3OH + .8*HO2 + .8*CH2O + .2*CO ; 5.e-13, 400. + + .1*GLYOXAL + .1*CH3COCHO + .1*HYAC + .1*GLYALD + [XO2_CH3CO3] XO2 + CH3CO3 -> .25*CO + .25*CH2O + .25*GLYOXAL + CH3O2 ; 1.3e-12, 640. + + HO2 + .25*CH3COCHO + .25*HYAC + .25*GLYALD + CO2 + [XOOH_OHa] XOOH + OH -> H2O + XO2 ; 1.90e-12, 190. + [usr_XOOH_OH] XOOH + OH -> H2O + OH + +* -------------------------------------------------------------- +* C-7 degradation +* +* TOLUENE = C7H8 +* CRESOL = C7H8O +* TOLO2 = C7H9O5 +* TOLOOH = C7H10O5 +* XOH = C7H10O6 +* -------------------------------------------------------------- + [TOLUENE_OH] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.70e-12, 352. + [TOLO2_NO] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.20e-12, 180. + + .9*NO2 + .9*HO2 + [TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.50e-13, 700. + [TOLO2_OH] TOLOOH + OH -> TOLO2 ; 3.80e-12, 200. + [CRESOL_OH] CRESOL + OH -> XOH ; 3.00e-12 + [XOH_NO2] XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.00e-11 + [BENZENE_OH] BENZENE + OH -> BENO2 ; 2.3e-12, -193 + [BENO2_HO2] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700 + [BENO2_NO] BENO2 + NO -> 0.9*GLYOXAL + 0.9*BIGALD + 0.9*NO2 + 0.9*HO2 ; 2.6e-12, 350 + [XYLENE_OH] XYLENE + OH -> XYLO2 ; 2.3e-11 + [XYLO2_HO2] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700 + [XYLO2_NO] XYLO2 + NO -> 0.62*BIGALD + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.9*NO2 + 0.9*HO2 ; 2.6e-12, 350 +* -------------------------------------------------------------- +* C-10 degradation +* +* TERPO2 = C10H17O3 +* TERPOOH = C10H18O3 +* -------------------------------------------------------------- + [C10H16_OH] C10H16 + OH -> TERPO2 ; 1.2e-11, 444. + [C10H16_O3] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732. + [C10H16_NO3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490. + [TERPO2_NO] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180. + [TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700. + [TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.8e-12, 200. + +* -------------------------------------------------------------- +* Tropospheric Heterogeneous Reactions +* -------------------------------------------------------------- + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + [CB1_CB2] CB1 -> CB2 ; 7.10e-6 + [usr_SO2_OH] SO2 + OH -> SO4 + [DMS_OHa] DMS + OH -> SO2 ; 9.60e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.90e-13, 520. + [NH3_OH] NH3 + OH -> H2O ; 1.70e-12, -710. + [OC1_OC2] OC1 -> OC2 ; 7.10e-6 + [usr_HO2_aer] HO2 -> 0.5*H2O2 + +* -------------------------------------------------------------- +* Stratospheric removal rates for BAM aerosols +* -------------------------------------------------------------- + [usr_CB1_strat_tau] CB1 -> ; 6.34e-8 + [usr_CB2_strat_tau] CB2 -> ; 6.34e-8 + [usr_OC1_strat_tau] OC1 -> ; 6.34e-8 + [usr_OC2_strat_tau] OC2 -> ; 6.34e-8 + [usr_SO4_strat_tau] SO4 -> ; 6.34e-8 + [usr_SOAM_strat_tau] SOAM-> ; 6.34e-8 + [usr_SOAI_strat_tau] SOAI-> ; 6.34e-8 + [usr_SOAB_strat_tau] SOAB-> ; 6.34e-8 + [usr_SOAT_strat_tau] SOAT-> ; 6.34e-8 + [usr_SOAX_strat_tau] SOAX-> ; 6.34e-8 + [usr_NH4_strat_tau] NH4 -> ; 6.34e-8 + [usr_NH4NO3_strat_tau] NH4NO3 -> ; 6.34e-8 + [usr_SSLT01_strat_tau] SSLT01 -> ; 6.34e-8 + [usr_SSLT02_strat_tau] SSLT02 -> ; 6.34e-8 + [usr_SSLT03_strat_tau] SSLT03 -> ; 6.34e-8 + [usr_SSLT04_strat_tau] SSLT04 -> ; 6.34e-8 + [usr_DST01_strat_tau] DST01 -> ; 6.34e-8 + [usr_DST02_strat_tau] DST02 -> ; 6.34e-8 + [usr_DST03_strat_tau] DST03 -> ; 6.34e-8 + [usr_DST04_strat_tau] DST04 -> ; 6.34e-8 + [usr_SO2t_strat_tau] SO2t -> ; 6.34e-8 + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 + +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + [ion_N2p_Ob] N2p + O -> Op + N2 + [ion_Op_CO2] Op + CO2 -> O2p + CO ; 9.0e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + [ion_O2p_N2] O2p + N2 -> NOp + NO ; 5.0e-16 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + +* -------------------------------------------------------------- +* synthetic tracer reactions +* -------------------------------------------------------------- + [NH_5_tau] NH_5 -> ; 2.31e-06 + [NH_50_tau] NH_50 -> ; 2.31e-07 + [NH_50W_tau] NH_50W -> ; 2.31e-07 + [ST80_25_tau] ST80_25 -> ; 4.63e-07 + [CO_25_tau] CO_25 -> ; 4.63e-07 + [CO_50_tau] CO_50 -> ; 2.31e-07 + [E90_tau] E90 -> ; 1.29e-07 + [E90_NH_tau] E90_NH -> ; 1.29e-07 + [E90_SH_tau] E90_SH -> ; 1.29e-07 + End Reactions + + Ext Forcing + NO <-dataset + NO2 <-dataset + CO <-dataset + SO2 <- dataset + SO4 <- dataset + CB1 <- dataset + Op, O2p, Np, N2p, N2D, N, e, OH, AOA_NH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = intel + model = cam + model_architecture = SCALAR + architecture = hybrid +* vec_ftns = on + namemod = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 new file mode 100644 index 0000000000..b39c79bbe5 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 114, & ! number of photolysis reactions + rxntot = 472, & ! number of total reactions + gascnt = 358, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 183, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 1471, & ! number of non-zero matrix entries + extcnt = 15, & ! number of species with external forcing + clscnt1 = 37, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 146, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 472, & + enthalpy_cnt = 41, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 new file mode 100644 index 0000000000..455f96851d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/m_rxt_id.F90 @@ -0,0 +1,475 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jhbr = 34 + integer, parameter :: rid_jbrono2_a = 35 + integer, parameter :: rid_jbrono2_b = 36 + integer, parameter :: rid_jch3cl = 37 + integer, parameter :: rid_jccl4 = 38 + integer, parameter :: rid_jch3ccl3 = 39 + integer, parameter :: rid_jcfcl3 = 40 + integer, parameter :: rid_jcf2cl2 = 41 + integer, parameter :: rid_jcfc113 = 42 + integer, parameter :: rid_jcfc114 = 43 + integer, parameter :: rid_jcfc115 = 44 + integer, parameter :: rid_jhcfc22 = 45 + integer, parameter :: rid_jhcfc141b = 46 + integer, parameter :: rid_jhcfc142b = 47 + integer, parameter :: rid_jch3br = 48 + integer, parameter :: rid_jcf3br = 49 + integer, parameter :: rid_jcf2clbr = 50 + integer, parameter :: rid_jchbr3 = 51 + integer, parameter :: rid_jch2br2 = 52 + integer, parameter :: rid_jh1202 = 53 + integer, parameter :: rid_jh2402 = 54 + integer, parameter :: rid_jcof2 = 55 + integer, parameter :: rid_jcofcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jco2 = 58 + integer, parameter :: rid_jch4_a = 59 + integer, parameter :: rid_jch4_b = 60 + integer, parameter :: rid_jch3cho = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jch3co3h = 63 + integer, parameter :: rid_jpan = 64 + integer, parameter :: rid_jmpan = 65 + integer, parameter :: rid_jmacr_a = 66 + integer, parameter :: rid_jmacr_b = 67 + integer, parameter :: rid_jmvk = 68 + integer, parameter :: rid_jc2h5ooh = 69 + integer, parameter :: rid_jeooh = 70 + integer, parameter :: rid_jc3h7ooh = 71 + integer, parameter :: rid_jrooh = 72 + integer, parameter :: rid_jacet = 73 + integer, parameter :: rid_jmgly = 74 + integer, parameter :: rid_jxooh = 75 + integer, parameter :: rid_jonitr = 76 + integer, parameter :: rid_jisopooh = 77 + integer, parameter :: rid_jhyac = 78 + integer, parameter :: rid_jglyald = 79 + integer, parameter :: rid_jmek = 80 + integer, parameter :: rid_jbigald = 81 + integer, parameter :: rid_jglyoxal = 82 + integer, parameter :: rid_jalkooh = 83 + integer, parameter :: rid_jmekooh = 84 + integer, parameter :: rid_jtolooh = 85 + integer, parameter :: rid_jterpooh = 86 + integer, parameter :: rid_jsf6 = 87 + integer, parameter :: rid_jsf6em = 88 + integer, parameter :: rid_jeuv_1 = 89 + integer, parameter :: rid_jeuv_2 = 90 + integer, parameter :: rid_jeuv_3 = 91 + integer, parameter :: rid_jeuv_4 = 92 + integer, parameter :: rid_jeuv_5 = 93 + integer, parameter :: rid_jeuv_6 = 94 + integer, parameter :: rid_jeuv_7 = 95 + integer, parameter :: rid_jeuv_8 = 96 + integer, parameter :: rid_jeuv_9 = 97 + integer, parameter :: rid_jeuv_10 = 98 + integer, parameter :: rid_jeuv_11 = 99 + integer, parameter :: rid_jeuv_12 = 100 + integer, parameter :: rid_jeuv_13 = 101 + integer, parameter :: rid_jeuv_14 = 102 + integer, parameter :: rid_jeuv_15 = 103 + integer, parameter :: rid_jeuv_16 = 104 + integer, parameter :: rid_jeuv_17 = 105 + integer, parameter :: rid_jeuv_18 = 106 + integer, parameter :: rid_jeuv_19 = 107 + integer, parameter :: rid_jeuv_20 = 108 + integer, parameter :: rid_jeuv_21 = 109 + integer, parameter :: rid_jeuv_22 = 110 + integer, parameter :: rid_jeuv_23 = 111 + integer, parameter :: rid_jeuv_24 = 112 + integer, parameter :: rid_jeuv_25 = 113 + integer, parameter :: rid_jeuv_26 = 114 + integer, parameter :: rid_usr_O_O2 = 115 + integer, parameter :: rid_O_O3 = 116 + integer, parameter :: rid_usr_O_O = 117 + integer, parameter :: rid_O2_1S_O = 118 + integer, parameter :: rid_O2_1S_O2 = 119 + integer, parameter :: rid_O2_1S_N2 = 120 + integer, parameter :: rid_O2_1S_O3 = 121 + integer, parameter :: rid_O2_1S_CO2 = 122 + integer, parameter :: rid_ag2 = 123 + integer, parameter :: rid_O2_1D_O = 124 + integer, parameter :: rid_O2_1D_O2 = 125 + integer, parameter :: rid_O2_1D_N2 = 126 + integer, parameter :: rid_ag1 = 127 + integer, parameter :: rid_O1D_N2 = 128 + integer, parameter :: rid_O1D_O2 = 129 + integer, parameter :: rid_O1D_O2b = 130 + integer, parameter :: rid_O1D_H2O = 131 + integer, parameter :: rid_O1D_N2Oa = 132 + integer, parameter :: rid_O1D_N2Ob = 133 + integer, parameter :: rid_O1D_O3 = 134 + integer, parameter :: rid_O1D_CFC11 = 135 + integer, parameter :: rid_O1D_CFC12 = 136 + integer, parameter :: rid_O1D_CFC113 = 137 + integer, parameter :: rid_O1D_CFC114 = 138 + integer, parameter :: rid_O1D_CFC115 = 139 + integer, parameter :: rid_O1D_HCFC22 = 140 + integer, parameter :: rid_O1D_HCFC141B = 141 + integer, parameter :: rid_O1D_HCFC142B = 142 + integer, parameter :: rid_O1D_CCL4 = 143 + integer, parameter :: rid_O1D_CH3BR = 144 + integer, parameter :: rid_O1D_CF2CLBR = 145 + integer, parameter :: rid_O1D_CF3BR = 146 + integer, parameter :: rid_O1D_H1202 = 147 + integer, parameter :: rid_O1D_H2402 = 148 + integer, parameter :: rid_O1D_CHBR3 = 149 + integer, parameter :: rid_O1D_CH2BR2 = 150 + integer, parameter :: rid_O1D_COF2 = 151 + integer, parameter :: rid_O1D_COFCL = 152 + integer, parameter :: rid_O1D_CH4a = 153 + integer, parameter :: rid_O1D_CH4b = 154 + integer, parameter :: rid_O1D_CH4c = 155 + integer, parameter :: rid_O1D_H2 = 156 + integer, parameter :: rid_O1D_HCL = 157 + integer, parameter :: rid_O1D_HBR = 158 + integer, parameter :: rid_O1D_HCN = 159 + integer, parameter :: rid_H_O2 = 160 + integer, parameter :: rid_H_O3 = 161 + integer, parameter :: rid_H_HO2a = 162 + integer, parameter :: rid_H_HO2 = 163 + integer, parameter :: rid_H_HO2b = 164 + integer, parameter :: rid_OH_O = 165 + integer, parameter :: rid_OH_O3 = 166 + integer, parameter :: rid_OH_HO2 = 167 + integer, parameter :: rid_OH_OH = 168 + integer, parameter :: rid_OH_OH_M = 169 + integer, parameter :: rid_OH_H2 = 170 + integer, parameter :: rid_OH_H2O2 = 171 + integer, parameter :: rid_H2_O = 172 + integer, parameter :: rid_HO2_O = 173 + integer, parameter :: rid_HO2_O3 = 174 + integer, parameter :: rid_usr_HO2_HO2 = 175 + integer, parameter :: rid_H2O2_O = 176 + integer, parameter :: rid_HCN_OH = 177 + integer, parameter :: rid_CH3CN_OH = 178 + integer, parameter :: rid_N2D_O2 = 179 + integer, parameter :: rid_N2D_O = 180 + integer, parameter :: rid_N_OH = 181 + integer, parameter :: rid_N_O2 = 182 + integer, parameter :: rid_N_NO = 183 + integer, parameter :: rid_N_NO2a = 184 + integer, parameter :: rid_N_NO2b = 185 + integer, parameter :: rid_N_NO2c = 186 + integer, parameter :: rid_NO_O_M = 187 + integer, parameter :: rid_NO_HO2 = 188 + integer, parameter :: rid_NO_O3 = 189 + integer, parameter :: rid_NO2_O = 190 + integer, parameter :: rid_NO2_O_M = 191 + integer, parameter :: rid_NO2_O3 = 192 + integer, parameter :: rid_tag_NO2_NO3 = 193 + integer, parameter :: rid_usr_N2O5_M = 194 + integer, parameter :: rid_tag_NO2_OH = 195 + integer, parameter :: rid_usr_HNO3_OH = 196 + integer, parameter :: rid_NO3_NO = 197 + integer, parameter :: rid_NO3_O = 198 + integer, parameter :: rid_NO3_OH = 199 + integer, parameter :: rid_NO3_HO2 = 200 + integer, parameter :: rid_tag_NO2_HO2 = 201 + integer, parameter :: rid_HO2NO2_OH = 202 + integer, parameter :: rid_usr_HO2NO2_M = 203 + integer, parameter :: rid_CL_O3 = 204 + integer, parameter :: rid_CL_H2 = 205 + integer, parameter :: rid_CL_H2O2 = 206 + integer, parameter :: rid_CL_HO2a = 207 + integer, parameter :: rid_CL_HO2b = 208 + integer, parameter :: rid_CL_CH2O = 209 + integer, parameter :: rid_CL_CH4 = 210 + integer, parameter :: rid_CLO_O = 211 + integer, parameter :: rid_CLO_OHa = 212 + integer, parameter :: rid_CLO_OHb = 213 + integer, parameter :: rid_CLO_HO2 = 214 + integer, parameter :: rid_CLO_CH3O2 = 215 + integer, parameter :: rid_CLO_NO = 216 + integer, parameter :: rid_CLO_NO2_M = 217 + integer, parameter :: rid_CLO_CLOa = 218 + integer, parameter :: rid_CLO_CLOb = 219 + integer, parameter :: rid_CLO_CLOc = 220 + integer, parameter :: rid_tag_CLO_CLO_M = 221 + integer, parameter :: rid_usr_CL2O2_M = 222 + integer, parameter :: rid_HCL_OH = 223 + integer, parameter :: rid_HCL_O = 224 + integer, parameter :: rid_HOCL_O = 225 + integer, parameter :: rid_HOCL_CL = 226 + integer, parameter :: rid_HOCL_OH = 227 + integer, parameter :: rid_CLONO2_O = 228 + integer, parameter :: rid_CLONO2_OH = 229 + integer, parameter :: rid_CLONO2_CL = 230 + integer, parameter :: rid_BR_O3 = 231 + integer, parameter :: rid_BR_HO2 = 232 + integer, parameter :: rid_BR_CH2O = 233 + integer, parameter :: rid_BRO_O = 234 + integer, parameter :: rid_BRO_OH = 235 + integer, parameter :: rid_BRO_HO2 = 236 + integer, parameter :: rid_BRO_NO = 237 + integer, parameter :: rid_BRO_NO2_M = 238 + integer, parameter :: rid_BRO_CLOa = 239 + integer, parameter :: rid_BRO_CLOb = 240 + integer, parameter :: rid_BRO_CLOc = 241 + integer, parameter :: rid_BRO_BRO = 242 + integer, parameter :: rid_HBR_OH = 243 + integer, parameter :: rid_HBR_O = 244 + integer, parameter :: rid_HOBR_O = 245 + integer, parameter :: rid_BRONO2_O = 246 + integer, parameter :: rid_F_H2O = 247 + integer, parameter :: rid_F_H2 = 248 + integer, parameter :: rid_F_CH4 = 249 + integer, parameter :: rid_F_HNO3 = 250 + integer, parameter :: rid_CH3CL_CL = 251 + integer, parameter :: rid_CH3CL_OH = 252 + integer, parameter :: rid_CH3CCL3_OH = 253 + integer, parameter :: rid_HCFC22_OH = 254 + integer, parameter :: rid_CH3BR_OH = 255 + integer, parameter :: rid_CH3BR_CL = 256 + integer, parameter :: rid_HCFC141B_OH = 257 + integer, parameter :: rid_HCFC142B_OH = 258 + integer, parameter :: rid_CH2BR2_OH = 259 + integer, parameter :: rid_CHBR3_OH = 260 + integer, parameter :: rid_CH2BR2_CL = 261 + integer, parameter :: rid_CHBR3_CL = 262 + integer, parameter :: rid_CH4_OH = 263 + integer, parameter :: rid_usr_CO_OH_b = 264 + integer, parameter :: rid_CO_OH_M = 265 + integer, parameter :: rid_CH2O_NO3 = 266 + integer, parameter :: rid_CH2O_OH = 267 + integer, parameter :: rid_CH2O_O = 268 + integer, parameter :: rid_CH2O_HO2 = 269 + integer, parameter :: rid_CH3O2_NO = 270 + integer, parameter :: rid_CH3O2_HO2 = 271 + integer, parameter :: rid_CH3O2_CH3O2a = 272 + integer, parameter :: rid_CH3O2_CH3O2b = 273 + integer, parameter :: rid_CH3OH_OH = 274 + integer, parameter :: rid_CH3OOH_OH = 275 + integer, parameter :: rid_HCOOH_OH = 276 + integer, parameter :: rid_HOCH2OO_M = 277 + integer, parameter :: rid_HOCH2OO_NO = 278 + integer, parameter :: rid_HOCH2OO_HO2 = 279 + integer, parameter :: rid_C2H2_CL_M = 280 + integer, parameter :: rid_C2H4_CL_M = 281 + integer, parameter :: rid_C2H6_CL = 282 + integer, parameter :: rid_C2H2_OH_M = 283 + integer, parameter :: rid_C2H6_OH = 284 + integer, parameter :: rid_tag_C2H4_OH = 285 + integer, parameter :: rid_EO2_NO = 286 + integer, parameter :: rid_EO2_HO2 = 287 + integer, parameter :: rid_EO_O2 = 288 + integer, parameter :: rid_EO_M = 289 + integer, parameter :: rid_C2H4_O3 = 290 + integer, parameter :: rid_CH3COOH_OH = 291 + integer, parameter :: rid_C2H5O2_NO = 292 + integer, parameter :: rid_C2H5O2_HO2 = 293 + integer, parameter :: rid_C2H5O2_CH3O2 = 294 + integer, parameter :: rid_C2H5O2_C2H5O2 = 295 + integer, parameter :: rid_C2H5OOH_OH = 296 + integer, parameter :: rid_CH3CHO_OH = 297 + integer, parameter :: rid_CH3CHO_NO3 = 298 + integer, parameter :: rid_CH3CO3_NO = 299 + integer, parameter :: rid_tag_CH3CO3_NO2 = 300 + integer, parameter :: rid_CH3CO3_HO2 = 301 + integer, parameter :: rid_CH3CO3_CH3O2 = 302 + integer, parameter :: rid_CH3CO3_CH3CO3 = 303 + integer, parameter :: rid_CH3COOOH_OH = 304 + integer, parameter :: rid_GLYALD_OH = 305 + integer, parameter :: rid_GLYOXAL_OH = 306 + integer, parameter :: rid_C2H5OH_OH = 307 + integer, parameter :: rid_usr_PAN_M = 308 + integer, parameter :: rid_PAN_OH = 309 + integer, parameter :: rid_tag_C3H6_OH = 310 + integer, parameter :: rid_C3H6_O3 = 311 + integer, parameter :: rid_C3H6_NO3 = 312 + integer, parameter :: rid_C3H7O2_NO = 313 + integer, parameter :: rid_C3H7O2_HO2 = 314 + integer, parameter :: rid_CH3H7O2_CH3O2 = 315 + integer, parameter :: rid_CH3H7OOH_OH = 316 + integer, parameter :: rid_C3H8_OH = 317 + integer, parameter :: rid_PO2_NO = 318 + integer, parameter :: rid_PO2_HO2 = 319 + integer, parameter :: rid_POOH_OH = 320 + integer, parameter :: rid_usr_CH3COCH3_OH = 321 + integer, parameter :: rid_RO2_NO = 322 + integer, parameter :: rid_RO2_HO2 = 323 + integer, parameter :: rid_RO2_CH3O2 = 324 + integer, parameter :: rid_ROOH_OH = 325 + integer, parameter :: rid_HYAC_OH = 326 + integer, parameter :: rid_CH3COCHO_OH = 327 + integer, parameter :: rid_CH3COCHO_NO3 = 328 + integer, parameter :: rid_ONIT_OH = 329 + integer, parameter :: rid_BIGENE_OH = 330 + integer, parameter :: rid_ENEO2_NO = 331 + integer, parameter :: rid_MVK_OH = 332 + integer, parameter :: rid_MVK_O3 = 333 + integer, parameter :: rid_MEK_OH = 334 + integer, parameter :: rid_MEKO2_NO = 335 + integer, parameter :: rid_MEKO2_HO2 = 336 + integer, parameter :: rid_MEKOOH_OH = 337 + integer, parameter :: rid_MACR_OH = 338 + integer, parameter :: rid_MACR_O3 = 339 + integer, parameter :: rid_MACRO2_NOa = 340 + integer, parameter :: rid_MACRO2_NOb = 341 + integer, parameter :: rid_MACRO2_NO3 = 342 + integer, parameter :: rid_MACRO2_HO2 = 343 + integer, parameter :: rid_MACRO2_CH3O2 = 344 + integer, parameter :: rid_MACRO2_CH3CO3 = 345 + integer, parameter :: rid_MACROOH_OH = 346 + integer, parameter :: rid_MCO3_NO = 347 + integer, parameter :: rid_MCO3_NO3 = 348 + integer, parameter :: rid_MCO3_HO2 = 349 + integer, parameter :: rid_MCO3_CH3O2 = 350 + integer, parameter :: rid_MCO3_CH3CO3 = 351 + integer, parameter :: rid_MCO3_MCO3 = 352 + integer, parameter :: rid_usr_MCO3_NO2 = 353 + integer, parameter :: rid_usr_MPAN_M = 354 + integer, parameter :: rid_MPAN_OH_M = 355 + integer, parameter :: rid_ISOP_OH = 356 + integer, parameter :: rid_ISOP_O3 = 357 + integer, parameter :: rid_ISOP_NO3 = 358 + integer, parameter :: rid_ISOPO2_NO = 359 + integer, parameter :: rid_ISOPO2_NO3 = 360 + integer, parameter :: rid_ISOPO2_HO2 = 361 + integer, parameter :: rid_ISOPOOH_OH = 362 + integer, parameter :: rid_ISOPO2_CH3O2 = 363 + integer, parameter :: rid_ISOPO2_CH3CO3 = 364 + integer, parameter :: rid_ISOPNO3_NO = 365 + integer, parameter :: rid_ISOPNO3_NO3 = 366 + integer, parameter :: rid_ISOPNO3_HO2 = 367 + integer, parameter :: rid_BIGALK_OH = 368 + integer, parameter :: rid_ONITR_OH = 369 + integer, parameter :: rid_ONITR_NO3 = 370 + integer, parameter :: rid_HYDRALD_OH = 371 + integer, parameter :: rid_ALKO2_NO = 372 + integer, parameter :: rid_ALKO2_HO2 = 373 + integer, parameter :: rid_ALKOOH_OH = 374 + integer, parameter :: rid_XO2_NO = 375 + integer, parameter :: rid_XO2_NO3 = 376 + integer, parameter :: rid_XO2_HO2 = 377 + integer, parameter :: rid_XO2_CH3O2 = 378 + integer, parameter :: rid_XO2_CH3CO3 = 379 + integer, parameter :: rid_XOOH_OHa = 380 + integer, parameter :: rid_usr_XOOH_OH = 381 + integer, parameter :: rid_TOLUENE_OH = 382 + integer, parameter :: rid_TOLO2_NO = 383 + integer, parameter :: rid_TOLO2_HO2 = 384 + integer, parameter :: rid_TOLO2_OH = 385 + integer, parameter :: rid_CRESOL_OH = 386 + integer, parameter :: rid_XOH_NO2 = 387 + integer, parameter :: rid_BENZENE_OH = 388 + integer, parameter :: rid_BENO2_HO2 = 389 + integer, parameter :: rid_BENO2_NO = 390 + integer, parameter :: rid_XYLENE_OH = 391 + integer, parameter :: rid_XYLO2_HO2 = 392 + integer, parameter :: rid_XYLO2_NO = 393 + integer, parameter :: rid_C10H16_OH = 394 + integer, parameter :: rid_C10H16_O3 = 395 + integer, parameter :: rid_C10H16_NO3 = 396 + integer, parameter :: rid_TERPO2_NO = 397 + integer, parameter :: rid_TERPO2_HO2 = 398 + integer, parameter :: rid_TERPOOH_OH = 399 + integer, parameter :: rid_usr_N2O5_aer = 400 + integer, parameter :: rid_usr_NO3_aer = 401 + integer, parameter :: rid_usr_NO2_aer = 402 + integer, parameter :: rid_CB1_CB2 = 403 + integer, parameter :: rid_usr_SO2_OH = 404 + integer, parameter :: rid_DMS_OHa = 405 + integer, parameter :: rid_usr_DMS_OH = 406 + integer, parameter :: rid_DMS_NO3 = 407 + integer, parameter :: rid_NH3_OH = 408 + integer, parameter :: rid_OC1_OC2 = 409 + integer, parameter :: rid_usr_HO2_aer = 410 + integer, parameter :: rid_usr_CB1_strat_tau = 411 + integer, parameter :: rid_usr_CB2_strat_tau = 412 + integer, parameter :: rid_usr_OC1_strat_tau = 413 + integer, parameter :: rid_usr_OC2_strat_tau = 414 + integer, parameter :: rid_usr_SO4_strat_tau = 415 + integer, parameter :: rid_usr_SOAM_strat_tau = 416 + integer, parameter :: rid_usr_SOAI_strat_tau = 417 + integer, parameter :: rid_usr_SOAB_strat_tau = 418 + integer, parameter :: rid_usr_SOAT_strat_tau = 419 + integer, parameter :: rid_usr_SOAX_strat_tau = 420 + integer, parameter :: rid_usr_NH4_strat_tau = 421 + integer, parameter :: rid_usr_NH4NO3_strat_tau = 422 + integer, parameter :: rid_usr_SSLT01_strat_tau = 423 + integer, parameter :: rid_usr_SSLT02_strat_tau = 424 + integer, parameter :: rid_usr_SSLT03_strat_tau = 425 + integer, parameter :: rid_usr_SSLT04_strat_tau = 426 + integer, parameter :: rid_usr_DST01_strat_tau = 427 + integer, parameter :: rid_usr_DST02_strat_tau = 428 + integer, parameter :: rid_usr_DST03_strat_tau = 429 + integer, parameter :: rid_usr_DST04_strat_tau = 430 + integer, parameter :: rid_usr_SO2t_strat_tau = 431 + integer, parameter :: rid_het1 = 432 + integer, parameter :: rid_het2 = 433 + integer, parameter :: rid_het3 = 434 + integer, parameter :: rid_het4 = 435 + integer, parameter :: rid_het5 = 436 + integer, parameter :: rid_het6 = 437 + integer, parameter :: rid_het7 = 438 + integer, parameter :: rid_het8 = 439 + integer, parameter :: rid_het9 = 440 + integer, parameter :: rid_het10 = 441 + integer, parameter :: rid_het11 = 442 + integer, parameter :: rid_het12 = 443 + integer, parameter :: rid_het13 = 444 + integer, parameter :: rid_het14 = 445 + integer, parameter :: rid_het15 = 446 + integer, parameter :: rid_het16 = 447 + integer, parameter :: rid_het17 = 448 + integer, parameter :: rid_ion_Op_O2 = 449 + integer, parameter :: rid_ion_Op_N2 = 450 + integer, parameter :: rid_ion_N2p_Oa = 451 + integer, parameter :: rid_ion_N2p_Ob = 452 + integer, parameter :: rid_ion_Op_CO2 = 453 + integer, parameter :: rid_ion_O2p_N = 454 + integer, parameter :: rid_ion_O2p_NO = 455 + integer, parameter :: rid_ion_Np_O2a = 456 + integer, parameter :: rid_ion_Np_O2b = 457 + integer, parameter :: rid_ion_Np_O = 458 + integer, parameter :: rid_ion_N2p_O2 = 459 + integer, parameter :: rid_ion_O2p_N2 = 460 + integer, parameter :: rid_elec1 = 461 + integer, parameter :: rid_elec2 = 462 + integer, parameter :: rid_elec3 = 463 + integer, parameter :: rid_NH_5_tau = 464 + integer, parameter :: rid_NH_50_tau = 465 + integer, parameter :: rid_NH_50W_tau = 466 + integer, parameter :: rid_ST80_25_tau = 467 + integer, parameter :: rid_CO_25_tau = 468 + integer, parameter :: rid_CO_50_tau = 469 + integer, parameter :: rid_E90_tau = 470 + integer, parameter :: rid_E90_NH_tau = 471 + integer, parameter :: rid_E90_SH_tau = 472 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 new file mode 100644 index 0000000000..024d86d1ee --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/m_spc_id.F90 @@ -0,0 +1,186 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O1D = 3 + integer, parameter :: id_O2 = 4 + integer, parameter :: id_O2_1S = 5 + integer, parameter :: id_O2_1D = 6 + integer, parameter :: id_N2O = 7 + integer, parameter :: id_N = 8 + integer, parameter :: id_NO = 9 + integer, parameter :: id_NO2 = 10 + integer, parameter :: id_NO3 = 11 + integer, parameter :: id_HNO3 = 12 + integer, parameter :: id_HO2NO2 = 13 + integer, parameter :: id_N2O5 = 14 + integer, parameter :: id_CH4 = 15 + integer, parameter :: id_CH3O2 = 16 + integer, parameter :: id_CH3OOH = 17 + integer, parameter :: id_CH3OH = 18 + integer, parameter :: id_CH2O = 19 + integer, parameter :: id_CO = 20 + integer, parameter :: id_H2 = 21 + integer, parameter :: id_H = 22 + integer, parameter :: id_OH = 23 + integer, parameter :: id_HO2 = 24 + integer, parameter :: id_H2O2 = 25 + integer, parameter :: id_CLY = 26 + integer, parameter :: id_BRY = 27 + integer, parameter :: id_CL = 28 + integer, parameter :: id_CL2 = 29 + integer, parameter :: id_CLO = 30 + integer, parameter :: id_OCLO = 31 + integer, parameter :: id_CL2O2 = 32 + integer, parameter :: id_HCL = 33 + integer, parameter :: id_HOCL = 34 + integer, parameter :: id_CLONO2 = 35 + integer, parameter :: id_BRCL = 36 + integer, parameter :: id_BR = 37 + integer, parameter :: id_BRO = 38 + integer, parameter :: id_HBR = 39 + integer, parameter :: id_HOBR = 40 + integer, parameter :: id_BRONO2 = 41 + integer, parameter :: id_HCN = 42 + integer, parameter :: id_CH3CN = 43 + integer, parameter :: id_C2H4 = 44 + integer, parameter :: id_C2H6 = 45 + integer, parameter :: id_C2H5O2 = 46 + integer, parameter :: id_C2H5OOH = 47 + integer, parameter :: id_CH3CO3 = 48 + integer, parameter :: id_CH3COOH = 49 + integer, parameter :: id_CH3CHO = 50 + integer, parameter :: id_C2H5OH = 51 + integer, parameter :: id_GLYALD = 52 + integer, parameter :: id_GLYOXAL = 53 + integer, parameter :: id_CH3COOOH = 54 + integer, parameter :: id_EO2 = 55 + integer, parameter :: id_EO = 56 + integer, parameter :: id_EOOH = 57 + integer, parameter :: id_PAN = 58 + integer, parameter :: id_C3H6 = 59 + integer, parameter :: id_C3H8 = 60 + integer, parameter :: id_C3H7O2 = 61 + integer, parameter :: id_C3H7OOH = 62 + integer, parameter :: id_CH3COCH3 = 63 + integer, parameter :: id_PO2 = 64 + integer, parameter :: id_POOH = 65 + integer, parameter :: id_HYAC = 66 + integer, parameter :: id_RO2 = 67 + integer, parameter :: id_CH3COCHO = 68 + integer, parameter :: id_ROOH = 69 + integer, parameter :: id_BIGENE = 70 + integer, parameter :: id_BIGALK = 71 + integer, parameter :: id_MEK = 72 + integer, parameter :: id_ENEO2 = 73 + integer, parameter :: id_MEKO2 = 74 + integer, parameter :: id_MEKOOH = 75 + integer, parameter :: id_MCO3 = 76 + integer, parameter :: id_MVK = 77 + integer, parameter :: id_MACR = 78 + integer, parameter :: id_MACRO2 = 79 + integer, parameter :: id_MACROOH = 80 + integer, parameter :: id_MPAN = 81 + integer, parameter :: id_ONIT = 82 + integer, parameter :: id_ISOP = 83 + integer, parameter :: id_ALKO2 = 84 + integer, parameter :: id_ALKOOH = 85 + integer, parameter :: id_BIGALD = 86 + integer, parameter :: id_HYDRALD = 87 + integer, parameter :: id_ISOPO2 = 88 + integer, parameter :: id_ISOPNO3 = 89 + integer, parameter :: id_ONITR = 90 + integer, parameter :: id_XO2 = 91 + integer, parameter :: id_XOOH = 92 + integer, parameter :: id_ISOPOOH = 93 + integer, parameter :: id_TOLUENE = 94 + integer, parameter :: id_CRESOL = 95 + integer, parameter :: id_TOLO2 = 96 + integer, parameter :: id_TOLOOH = 97 + integer, parameter :: id_XOH = 98 + integer, parameter :: id_BENZENE = 99 + integer, parameter :: id_BENO2 = 100 + integer, parameter :: id_BENOOH = 101 + integer, parameter :: id_XYLENE = 102 + integer, parameter :: id_XYLO2 = 103 + integer, parameter :: id_XYLOOH = 104 + integer, parameter :: id_C10H16 = 105 + integer, parameter :: id_TERPO2 = 106 + integer, parameter :: id_TERPOOH = 107 + integer, parameter :: id_CH3CL = 108 + integer, parameter :: id_CH3BR = 109 + integer, parameter :: id_CFC11 = 110 + integer, parameter :: id_CFC12 = 111 + integer, parameter :: id_CFC113 = 112 + integer, parameter :: id_HCFC22 = 113 + integer, parameter :: id_CCL4 = 114 + integer, parameter :: id_CH3CCL3 = 115 + integer, parameter :: id_CF3BR = 116 + integer, parameter :: id_CF2CLBR = 117 + integer, parameter :: id_HCFC141B = 118 + integer, parameter :: id_HCFC142B = 119 + integer, parameter :: id_CFC114 = 120 + integer, parameter :: id_CFC115 = 121 + integer, parameter :: id_H1202 = 122 + integer, parameter :: id_H2402 = 123 + integer, parameter :: id_CHBR3 = 124 + integer, parameter :: id_CH2BR2 = 125 + integer, parameter :: id_CO2 = 126 + integer, parameter :: id_N2p = 127 + integer, parameter :: id_O2p = 128 + integer, parameter :: id_Np = 129 + integer, parameter :: id_Op = 130 + integer, parameter :: id_NOp = 131 + integer, parameter :: id_e = 132 + integer, parameter :: id_N2D = 133 + integer, parameter :: id_H2O = 134 + integer, parameter :: id_C2H2 = 135 + integer, parameter :: id_HCOOH = 136 + integer, parameter :: id_HOCH2OO = 137 + integer, parameter :: id_COF2 = 138 + integer, parameter :: id_COFCL = 139 + integer, parameter :: id_HF = 140 + integer, parameter :: id_F = 141 + integer, parameter :: id_CB1 = 142 + integer, parameter :: id_CB2 = 143 + integer, parameter :: id_OC1 = 144 + integer, parameter :: id_OC2 = 145 + integer, parameter :: id_SOAM = 146 + integer, parameter :: id_SOAI = 147 + integer, parameter :: id_SOAT = 148 + integer, parameter :: id_SOAB = 149 + integer, parameter :: id_SOAX = 150 + integer, parameter :: id_SOGM = 151 + integer, parameter :: id_SOGI = 152 + integer, parameter :: id_SOGT = 153 + integer, parameter :: id_SOGB = 154 + integer, parameter :: id_SOGX = 155 + integer, parameter :: id_SO2 = 156 + integer, parameter :: id_DMS = 157 + integer, parameter :: id_SO4 = 158 + integer, parameter :: id_NH3 = 159 + integer, parameter :: id_NH4 = 160 + integer, parameter :: id_NH4NO3 = 161 + integer, parameter :: id_SSLT01 = 162 + integer, parameter :: id_SSLT02 = 163 + integer, parameter :: id_SSLT03 = 164 + integer, parameter :: id_SSLT04 = 165 + integer, parameter :: id_DST01 = 166 + integer, parameter :: id_DST02 = 167 + integer, parameter :: id_DST03 = 168 + integer, parameter :: id_DST04 = 169 + integer, parameter :: id_NH_5 = 170 + integer, parameter :: id_NH_50 = 171 + integer, parameter :: id_NH_50W = 172 + integer, parameter :: id_AOA_NH = 173 + integer, parameter :: id_ST80_25 = 174 + integer, parameter :: id_CO_25 = 175 + integer, parameter :: id_CO_50 = 176 + integer, parameter :: id_SO2t = 177 + integer, parameter :: id_SF6 = 178 + integer, parameter :: id_SF6em = 179 + integer, parameter :: id_O3S = 180 + integer, parameter :: id_E90 = 181 + integer, parameter :: id_E90_NH = 182 + integer, parameter :: id_E90_SH = 183 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 new file mode 100644 index 0000000000..0d8570d4b0 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_adjrxt.F90 @@ -0,0 +1,348 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:,115) = rate(:,:,115) * inv(:,:, 1) + rate(:,:,117) = rate(:,:,117) * inv(:,:, 1) + rate(:,:,120) = rate(:,:,120) * inv(:,:, 2) + rate(:,:,126) = rate(:,:,126) * inv(:,:, 2) + rate(:,:,128) = rate(:,:,128) * inv(:,:, 2) + rate(:,:,160) = rate(:,:,160) * inv(:,:, 1) + rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) + rate(:,:,177) = rate(:,:,177) * inv(:,:, 1) + rate(:,:,187) = rate(:,:,187) * inv(:,:, 1) + rate(:,:,191) = rate(:,:,191) * inv(:,:, 1) + rate(:,:,193) = rate(:,:,193) * inv(:,:, 1) + rate(:,:,194) = rate(:,:,194) * inv(:,:, 1) + rate(:,:,195) = rate(:,:,195) * inv(:,:, 1) + rate(:,:,201) = rate(:,:,201) * inv(:,:, 1) + rate(:,:,203) = rate(:,:,203) * inv(:,:, 1) + rate(:,:,217) = rate(:,:,217) * inv(:,:, 1) + rate(:,:,221) = rate(:,:,221) * inv(:,:, 1) + rate(:,:,222) = rate(:,:,222) * inv(:,:, 1) + rate(:,:,238) = rate(:,:,238) * inv(:,:, 1) + rate(:,:,265) = rate(:,:,265) * inv(:,:, 1) + rate(:,:,280) = rate(:,:,280) * inv(:,:, 1) + rate(:,:,281) = rate(:,:,281) * inv(:,:, 1) + rate(:,:,283) = rate(:,:,283) * inv(:,:, 1) + rate(:,:,285) = rate(:,:,285) * inv(:,:, 1) + rate(:,:,300) = rate(:,:,300) * inv(:,:, 1) + rate(:,:,308) = rate(:,:,308) * inv(:,:, 1) + rate(:,:,310) = rate(:,:,310) * inv(:,:, 1) + rate(:,:,353) = rate(:,:,353) * inv(:,:, 1) + rate(:,:,354) = rate(:,:,354) * inv(:,:, 1) + rate(:,:,355) = rate(:,:,355) * inv(:,:, 1) + rate(:,:,450) = rate(:,:,450) * inv(:,:, 2) + rate(:,:,460) = rate(:,:,460) * inv(:,:, 2) + rate(:,:,115) = rate(:,:,115) * m(:,:) + rate(:,:,116) = rate(:,:,116) * m(:,:) + rate(:,:,117) = rate(:,:,117) * m(:,:) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,129) = rate(:,:,129) * m(:,:) + rate(:,:,130) = rate(:,:,130) * m(:,:) + rate(:,:,131) = rate(:,:,131) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,264) = rate(:,:,264) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,269) = rate(:,:,269) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,274) = rate(:,:,274) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,278) = rate(:,:,278) * m(:,:) + rate(:,:,279) = rate(:,:,279) * m(:,:) + rate(:,:,280) = rate(:,:,280) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,285) = rate(:,:,285) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,288) = rate(:,:,288) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,292) = rate(:,:,292) * m(:,:) + rate(:,:,293) = rate(:,:,293) * m(:,:) + rate(:,:,294) = rate(:,:,294) * m(:,:) + rate(:,:,295) = rate(:,:,295) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + rate(:,:,299) = rate(:,:,299) * m(:,:) + rate(:,:,300) = rate(:,:,300) * m(:,:) + rate(:,:,301) = rate(:,:,301) * m(:,:) + rate(:,:,302) = rate(:,:,302) * m(:,:) + rate(:,:,303) = rate(:,:,303) * m(:,:) + rate(:,:,304) = rate(:,:,304) * m(:,:) + rate(:,:,305) = rate(:,:,305) * m(:,:) + rate(:,:,306) = rate(:,:,306) * m(:,:) + rate(:,:,307) = rate(:,:,307) * m(:,:) + rate(:,:,309) = rate(:,:,309) * m(:,:) + rate(:,:,310) = rate(:,:,310) * m(:,:) + rate(:,:,311) = rate(:,:,311) * m(:,:) + rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:,313) = rate(:,:,313) * m(:,:) + rate(:,:,314) = rate(:,:,314) * m(:,:) + rate(:,:,315) = rate(:,:,315) * m(:,:) + rate(:,:,316) = rate(:,:,316) * m(:,:) + rate(:,:,317) = rate(:,:,317) * m(:,:) + rate(:,:,318) = rate(:,:,318) * m(:,:) + rate(:,:,319) = rate(:,:,319) * m(:,:) + rate(:,:,320) = rate(:,:,320) * m(:,:) + rate(:,:,321) = rate(:,:,321) * m(:,:) + rate(:,:,322) = rate(:,:,322) * m(:,:) + rate(:,:,323) = rate(:,:,323) * m(:,:) + rate(:,:,324) = rate(:,:,324) * m(:,:) + rate(:,:,325) = rate(:,:,325) * m(:,:) + rate(:,:,326) = rate(:,:,326) * m(:,:) + rate(:,:,327) = rate(:,:,327) * m(:,:) + rate(:,:,328) = rate(:,:,328) * m(:,:) + rate(:,:,329) = rate(:,:,329) * m(:,:) + rate(:,:,330) = rate(:,:,330) * m(:,:) + rate(:,:,331) = rate(:,:,331) * m(:,:) + rate(:,:,332) = rate(:,:,332) * m(:,:) + rate(:,:,333) = rate(:,:,333) * m(:,:) + rate(:,:,334) = rate(:,:,334) * m(:,:) + rate(:,:,335) = rate(:,:,335) * m(:,:) + rate(:,:,336) = rate(:,:,336) * m(:,:) + rate(:,:,337) = rate(:,:,337) * m(:,:) + rate(:,:,338) = rate(:,:,338) * m(:,:) + rate(:,:,339) = rate(:,:,339) * m(:,:) + rate(:,:,340) = rate(:,:,340) * m(:,:) + rate(:,:,341) = rate(:,:,341) * m(:,:) + rate(:,:,342) = rate(:,:,342) * m(:,:) + rate(:,:,343) = rate(:,:,343) * m(:,:) + rate(:,:,344) = rate(:,:,344) * m(:,:) + rate(:,:,345) = rate(:,:,345) * m(:,:) + rate(:,:,346) = rate(:,:,346) * m(:,:) + rate(:,:,347) = rate(:,:,347) * m(:,:) + rate(:,:,348) = rate(:,:,348) * m(:,:) + rate(:,:,349) = rate(:,:,349) * m(:,:) + rate(:,:,350) = rate(:,:,350) * m(:,:) + rate(:,:,351) = rate(:,:,351) * m(:,:) + rate(:,:,352) = rate(:,:,352) * m(:,:) + rate(:,:,353) = rate(:,:,353) * m(:,:) + rate(:,:,355) = rate(:,:,355) * m(:,:) + rate(:,:,356) = rate(:,:,356) * m(:,:) + rate(:,:,357) = rate(:,:,357) * m(:,:) + rate(:,:,358) = rate(:,:,358) * m(:,:) + rate(:,:,359) = rate(:,:,359) * m(:,:) + rate(:,:,360) = rate(:,:,360) * m(:,:) + rate(:,:,361) = rate(:,:,361) * m(:,:) + rate(:,:,362) = rate(:,:,362) * m(:,:) + rate(:,:,363) = rate(:,:,363) * m(:,:) + rate(:,:,364) = rate(:,:,364) * m(:,:) + rate(:,:,365) = rate(:,:,365) * m(:,:) + rate(:,:,366) = rate(:,:,366) * m(:,:) + rate(:,:,367) = rate(:,:,367) * m(:,:) + rate(:,:,368) = rate(:,:,368) * m(:,:) + rate(:,:,369) = rate(:,:,369) * m(:,:) + rate(:,:,370) = rate(:,:,370) * m(:,:) + rate(:,:,371) = rate(:,:,371) * m(:,:) + rate(:,:,372) = rate(:,:,372) * m(:,:) + rate(:,:,373) = rate(:,:,373) * m(:,:) + rate(:,:,374) = rate(:,:,374) * m(:,:) + rate(:,:,375) = rate(:,:,375) * m(:,:) + rate(:,:,376) = rate(:,:,376) * m(:,:) + rate(:,:,377) = rate(:,:,377) * m(:,:) + rate(:,:,378) = rate(:,:,378) * m(:,:) + rate(:,:,379) = rate(:,:,379) * m(:,:) + rate(:,:,380) = rate(:,:,380) * m(:,:) + rate(:,:,381) = rate(:,:,381) * m(:,:) + rate(:,:,382) = rate(:,:,382) * m(:,:) + rate(:,:,383) = rate(:,:,383) * m(:,:) + rate(:,:,384) = rate(:,:,384) * m(:,:) + rate(:,:,385) = rate(:,:,385) * m(:,:) + rate(:,:,386) = rate(:,:,386) * m(:,:) + rate(:,:,387) = rate(:,:,387) * m(:,:) + rate(:,:,388) = rate(:,:,388) * m(:,:) + rate(:,:,389) = rate(:,:,389) * m(:,:) + rate(:,:,390) = rate(:,:,390) * m(:,:) + rate(:,:,391) = rate(:,:,391) * m(:,:) + rate(:,:,392) = rate(:,:,392) * m(:,:) + rate(:,:,393) = rate(:,:,393) * m(:,:) + rate(:,:,394) = rate(:,:,394) * m(:,:) + rate(:,:,395) = rate(:,:,395) * m(:,:) + rate(:,:,396) = rate(:,:,396) * m(:,:) + rate(:,:,397) = rate(:,:,397) * m(:,:) + rate(:,:,398) = rate(:,:,398) * m(:,:) + rate(:,:,399) = rate(:,:,399) * m(:,:) + rate(:,:,404) = rate(:,:,404) * m(:,:) + rate(:,:,405) = rate(:,:,405) * m(:,:) + rate(:,:,406) = rate(:,:,406) * m(:,:) + rate(:,:,407) = rate(:,:,407) * m(:,:) + rate(:,:,408) = rate(:,:,408) * m(:,:) + rate(:,:,435) = rate(:,:,435) * m(:,:) + rate(:,:,436) = rate(:,:,436) * m(:,:) + rate(:,:,437) = rate(:,:,437) * m(:,:) + rate(:,:,440) = rate(:,:,440) * m(:,:) + rate(:,:,441) = rate(:,:,441) * m(:,:) + rate(:,:,446) = rate(:,:,446) * m(:,:) + rate(:,:,447) = rate(:,:,447) * m(:,:) + rate(:,:,448) = rate(:,:,448) * m(:,:) + rate(:,:,449) = rate(:,:,449) * m(:,:) + rate(:,:,451) = rate(:,:,451) * m(:,:) + rate(:,:,452) = rate(:,:,452) * m(:,:) + rate(:,:,453) = rate(:,:,453) * m(:,:) + rate(:,:,454) = rate(:,:,454) * m(:,:) + rate(:,:,455) = rate(:,:,455) * m(:,:) + rate(:,:,456) = rate(:,:,456) * m(:,:) + rate(:,:,457) = rate(:,:,457) * m(:,:) + rate(:,:,458) = rate(:,:,458) * m(:,:) + rate(:,:,459) = rate(:,:,459) * m(:,:) + rate(:,:,461) = rate(:,:,461) * m(:,:) + rate(:,:,462) = rate(:,:,462) * m(:,:) + rate(:,:,463) = rate(:,:,463) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 new file mode 100644 index 0000000000..3e82f67f0d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_indprd.F90 @@ -0,0 +1,241 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 + prod(:,:,2) =.080_r8*rxt(:,:,311)*y(:,:,59)*y(:,:,1) + prod(:,:,3) =rxt(:,:,184)*y(:,:,10)*y(:,:,8) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) = (rxt(:,:,264)*y(:,:,20) +rxt(:,:,265)*y(:,:,20) + & + rxt(:,:,276)*y(:,:,136) +rxt(:,:,291)*y(:,:,49) + & + .500_r8*rxt(:,:,304)*y(:,:,54) +.800_r8*rxt(:,:,305)*y(:,:,52) + & + rxt(:,:,306)*y(:,:,53) +.500_r8*rxt(:,:,355)*y(:,:,81))*y(:,:,23) & + + (rxt(:,:,299)*y(:,:,9) +.900_r8*rxt(:,:,302)*y(:,:,16) + & + 2.000_r8*rxt(:,:,303)*y(:,:,48) +2.000_r8*rxt(:,:,351)*y(:,:,76) + & + rxt(:,:,379)*y(:,:,91))*y(:,:,48) + (rxt(:,:,350)*y(:,:,16) + & + 2.000_r8*rxt(:,:,352)*y(:,:,76))*y(:,:,76) +rxt(:,:,63)*y(:,:,54) & + +.400_r8*rxt(:,:,64)*y(:,:,58) + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,31) = + extfrc(:,:,15) + prod(:,:,32) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,37) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,139) = 0._r8 + prod(:,:,146) = (rxt(:,:,58) +rxt(:,:,114))*y(:,:,126) +.180_r8*rxt(:,:,60) & + *y(:,:,15) + prod(:,:,143) =rxt(:,:,5)*y(:,:,7) + prod(:,:,129) = 0._r8 + prod(:,:,43) = 0._r8 + prod(:,:,42) = 0._r8 + prod(:,:,120) =1.440_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,115) = (rxt(:,:,58) +rxt(:,:,114))*y(:,:,126) +.380_r8*rxt(:,:,60) & + *y(:,:,15) + extfrc(:,:,3) + prod(:,:,105) = (rxt(:,:,98) +.800_r8*rxt(:,:,101) +rxt(:,:,110) + & + .800_r8*rxt(:,:,113)) + extfrc(:,:,12) + prod(:,:,134) = + extfrc(:,:,1) + prod(:,:,144) = + extfrc(:,:,2) + prod(:,:,138) =.330_r8*rxt(:,:,60)*y(:,:,15) + extfrc(:,:,14) + prod(:,:,135) = 0._r8 + prod(:,:,131) = 0._r8 + prod(:,:,73) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,136) =rxt(:,:,59)*y(:,:,15) +rxt(:,:,37)*y(:,:,108) +rxt(:,:,48) & + *y(:,:,109) + prod(:,:,67) = 0._r8 + prod(:,:,47) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,140) =.180_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,141) = (rxt(:,:,59) +.330_r8*rxt(:,:,60))*y(:,:,15) + prod(:,:,142) = 0._r8 + prod(:,:,89) = 0._r8 + prod(:,:,130) =.050_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,145) =rxt(:,:,37)*y(:,:,108) +2.000_r8*rxt(:,:,40)*y(:,:,110) & + +2.000_r8*rxt(:,:,41)*y(:,:,111) +2.000_r8*rxt(:,:,42)*y(:,:,112) & + +rxt(:,:,45)*y(:,:,113) +4.000_r8*rxt(:,:,38)*y(:,:,114) & + +3.000_r8*rxt(:,:,39)*y(:,:,115) +rxt(:,:,50)*y(:,:,117) & + +rxt(:,:,46)*y(:,:,118) +rxt(:,:,47)*y(:,:,119) & + +2.000_r8*rxt(:,:,43)*y(:,:,120) +rxt(:,:,44)*y(:,:,121) + prod(:,:,44) = 0._r8 + prod(:,:,132) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,137) = 0._r8 + prod(:,:,107) = 0._r8 + prod(:,:,113) = 0._r8 + prod(:,:,50) = 0._r8 + prod(:,:,133) =rxt(:,:,48)*y(:,:,109) +rxt(:,:,49)*y(:,:,116) +rxt(:,:,50) & + *y(:,:,117) +2.000_r8*rxt(:,:,53)*y(:,:,122) +2.000_r8*rxt(:,:,54) & + *y(:,:,123) +3.000_r8*rxt(:,:,51)*y(:,:,124) +2.000_r8*rxt(:,:,52) & + *y(:,:,125) + prod(:,:,128) = 0._r8 + prod(:,:,104) = 0._r8 + prod(:,:,96) = 0._r8 + prod(:,:,80) = 0._r8 + prod(:,:,92) = (rxt(:,:,94) +rxt(:,:,106)) + extfrc(:,:,10) + prod(:,:,98) = + extfrc(:,:,8) + prod(:,:,72) = (rxt(:,:,98) +rxt(:,:,99) +rxt(:,:,110) +rxt(:,:,111)) & + + extfrc(:,:,9) + prod(:,:,88) = + extfrc(:,:,7) + prod(:,:,99) = 0._r8 + prod(:,:,76) = (rxt(:,:,99) +1.200_r8*rxt(:,:,101) +rxt(:,:,111) + & + 1.200_r8*rxt(:,:,113)) + extfrc(:,:,11) + prod(:,:,100) = (rxt(:,:,94) +rxt(:,:,98) +rxt(:,:,99) +rxt(:,:,106) + & + rxt(:,:,110) +rxt(:,:,111)) + extfrc(:,:,13) + prod(:,:,114) = 0._r8 + prod(:,:,109) = 0._r8 + prod(:,:,103) = 0._r8 + prod(:,:,116) = 0._r8 + prod(:,:,87) = 0._r8 + prod(:,:,82) = 0._r8 + prod(:,:,127) = 0._r8 + prod(:,:,75) = 0._r8 + prod(:,:,74) = 0._r8 + prod(:,:,61) = 0._r8 + prod(:,:,53) = 0._r8 + prod(:,:,77) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,81) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,56) = 0._r8 + prod(:,:,93) = 0._r8 + prod(:,:,90) = 0._r8 + prod(:,:,68) = 0._r8 + prod(:,:,91) = 0._r8 + prod(:,:,57) = 0._r8 + prod(:,:,38) = 0._r8 + prod(:,:,39) = 0._r8 + prod(:,:,84) = 0._r8 + prod(:,:,62) = 0._r8 + prod(:,:,45) = 0._r8 + prod(:,:,112) = 0._r8 + prod(:,:,70) = 0._r8 + prod(:,:,85) = 0._r8 + prod(:,:,95) = 0._r8 + prod(:,:,31) = 0._r8 + prod(:,:,63) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,71) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,123) = 0._r8 + prod(:,:,125) = 0._r8 + prod(:,:,119) = 0._r8 + prod(:,:,124) = 0._r8 + prod(:,:,58) = 0._r8 + prod(:,:,126) = 0._r8 + prod(:,:,106) = 0._r8 + prod(:,:,59) = 0._r8 + prod(:,:,86) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,108) = 0._r8 + prod(:,:,64) = 0._r8 + prod(:,:,94) = 0._r8 + prod(:,:,65) = 0._r8 + prod(:,:,79) = 0._r8 + prod(:,:,51) = 0._r8 + prod(:,:,110) = 0._r8 + prod(:,:,118) = 0._r8 + prod(:,:,97) = 0._r8 + prod(:,:,69) = 0._r8 + prod(:,:,40) = 0._r8 + prod(:,:,60) = 0._r8 + prod(:,:,117) = 0._r8 + prod(:,:,121) = 0._r8 + prod(:,:,102) = 0._r8 + prod(:,:,111) = 0._r8 + prod(:,:,122) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,83) = 0._r8 + prod(:,:,54) = 0._r8 + prod(:,:,78) = 0._r8 + prod(:,:,66) = 0._r8 + prod(:,:,41) =rxt(:,:,41)*y(:,:,111) +rxt(:,:,42)*y(:,:,112) +rxt(:,:,45) & + *y(:,:,113) +rxt(:,:,49)*y(:,:,116) +rxt(:,:,50)*y(:,:,117) & + +rxt(:,:,47)*y(:,:,119) +2.000_r8*rxt(:,:,43)*y(:,:,120) & + +2.000_r8*rxt(:,:,44)*y(:,:,121) +rxt(:,:,53)*y(:,:,122) & + +2.000_r8*rxt(:,:,54)*y(:,:,123) + prod(:,:,46) =rxt(:,:,40)*y(:,:,110) +rxt(:,:,42)*y(:,:,112) +rxt(:,:,46) & + *y(:,:,118) + prod(:,:,48) = 0._r8 + prod(:,:,101) =rxt(:,:,49)*y(:,:,116) +rxt(:,:,44)*y(:,:,121) + prod(:,:,36) = + extfrc(:,:,4) + prod(:,:,49) = 0._r8 + prod(:,:,3) = + extfrc(:,:,5) + prod(:,:,33) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = + extfrc(:,:,6) + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 new file mode 100644 index 0000000000..3818567715 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_lin_matrix.F90 @@ -0,0 +1,440 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1223) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(1471) = -( rxt(89) + rxt(90) + rxt(91) + rxt(102) + rxt(103) + rxt(104) & + + het_rates(2) ) + mat(852) = rxt(1) + 2.000_r8*rxt(2) + rxt(95) + rxt(96) + rxt(97) & + + 2.000_r8*rxt(100) + rxt(107) + rxt(108) + rxt(109) & + + 2.000_r8*rxt(112) + mat(1230) = rxt(4) + mat(983) = rxt(6) + mat(1400) = rxt(8) + mat(131) = rxt(10) + mat(1024) = rxt(12) + mat(865) = rxt(21) + mat(904) = rxt(24) + mat(60) = rxt(25) + mat(829) = rxt(32) + mat(1365) = rxt(128) + mat(1362) = -( rxt(128) + rxt(132)*y(7) + rxt(133)*y(7) + rxt(135)*y(110) & + + rxt(136)*y(111) + rxt(137)*y(112) + rxt(138)*y(120) & + + rxt(139)*y(121) + rxt(140)*y(113) + rxt(141)*y(118) & + + rxt(142)*y(119) + rxt(143)*y(114) + rxt(144)*y(109) & + + rxt(145)*y(117) + rxt(146)*y(116) + rxt(147)*y(122) & + + rxt(148)*y(123) + rxt(149)*y(124) + rxt(150)*y(125) & + + rxt(153)*y(15) + rxt(154)*y(15) + rxt(155)*y(15) + het_rates(3) ) + mat(850) = rxt(1) + mat(1227) = rxt(3) + mat(863) = rxt(20) + mat(843) = -( rxt(1) + rxt(2) + rxt(93) + rxt(95) + rxt(96) + rxt(97) + rxt(100) & + + rxt(105) + rxt(107) + rxt(108) + rxt(109) + rxt(112) & + + het_rates(4) ) + mat(1213) = rxt(4) + mat(1009) = rxt(13) + mat(79) = rxt(123) + mat(76) = rxt(126) + rxt(127) + mat(1349) = rxt(133)*y(7) + mat(78) = -( rxt(120) + rxt(123) + rxt(122)*y(126) + het_rates(5) ) + mat(75) = -( rxt(126) + rxt(127) + het_rates(6) ) + mat(1188) = rxt(3) + mat(77) = rxt(120) + rxt(122)*y(126) + mat(657) = -( het_rates(21) ) + mat(1235) = rxt(18) + mat(855) = rxt(20) + mat(1348) = rxt(155)*y(15) + mat(609) = -( het_rates(20) ) + mat(1234) = rxt(17) + rxt(18) + mat(613) = rxt(61) + mat(643) = 1.340_r8*rxt(67) + mat(745) = .700_r8*rxt(68) + mat(668) = rxt(74) + mat(559) = rxt(76) + mat(553) = rxt(79) + mat(314) = .450_r8*rxt(81) + mat(398) = 2.000_r8*rxt(82) + mat(1413) = rxt(251)*y(108) + mat(335) = rxt(453)*y(126) + mat(489) = -( rxt(92) + het_rates(8) ) + mat(947) = rxt(6) + mat(334) = rxt(450) + mat(971) = -( rxt(6) + rxt(7) + het_rates(9) ) + mat(1388) = rxt(8) + .500_r8*rxt(402) + mat(128) = rxt(10) + mat(1012) = rxt(13) + mat(425) = rxt(460) + mat(1353) = 2.000_r8*rxt(132)*y(7) + mat(1398) = -( rxt(8) + rxt(402) + het_rates(10) ) + mat(130) = rxt(9) + rxt(194) + mat(877) = rxt(11) + mat(1022) = rxt(12) + mat(236) = rxt(15) + rxt(203) + mat(588) = rxt(30) + mat(277) = rxt(36) + mat(243) = .600_r8*rxt(64) + rxt(308) + mat(286) = rxt(65) + rxt(354) + mat(565) = rxt(76) + mat(1179) = -( rxt(252)*y(108) + rxt(253)*y(115) + rxt(254)*y(113) & + + rxt(255)*y(109) + rxt(257)*y(118) + rxt(258)*y(119) & + + rxt(259)*y(125) + rxt(260)*y(124) + rxt(263)*y(15) + het_rates(23) & + ) + mat(874) = rxt(11) + mat(234) = rxt(14) + mat(195) = rxt(16) + mat(861) = rxt(19) + mat(341) = 2.000_r8*rxt(22) + mat(515) = rxt(27) + mat(407) = rxt(33) + mat(292) = rxt(62) + mat(248) = rxt(63) + mat(152) = rxt(69) + mat(71) = rxt(70) + mat(178) = rxt(71) + mat(184) = rxt(72) + mat(113) = rxt(75) + mat(353) = rxt(83) + mat(143) = rxt(84) + mat(166) = rxt(85) + mat(213) = rxt(86) + mat(1392) = .500_r8*rxt(402) + mat(1357) = rxt(153)*y(15) + mat(1013) = -( rxt(12) + rxt(13) + rxt(401) + het_rates(11) ) + mat(129) = rxt(9) + rxt(10) + rxt(194) + mat(233) = rxt(14) + mat(585) = rxt(29) + mat(276) = rxt(35) + mat(239) = .400_r8*rxt(64) + mat(870) = -( rxt(11) + het_rates(12) ) + mat(127) = 2.000_r8*rxt(400) + 2.000_r8*rxt(432) + 2.000_r8*rxt(438) & + + 2.000_r8*rxt(443) + mat(1011) = rxt(401) + mat(1385) = .500_r8*rxt(402) + mat(583) = rxt(433) + rxt(439) + rxt(444) + mat(274) = rxt(434) + rxt(442) + rxt(445) + mat(230) = -( rxt(14) + rxt(15) + rxt(203) + het_rates(13) ) + mat(126) = -( rxt(9) + rxt(10) + rxt(194) + rxt(400) + rxt(432) + rxt(438) & + + rxt(443) + het_rates(14) ) + mat(1054) = -( het_rates(16) ) + mat(619) = rxt(61) + mat(247) = rxt(63) + mat(240) = .400_r8*rxt(64) + mat(758) = .300_r8*rxt(68) + mat(395) = rxt(73) + mat(1355) = rxt(153)*y(15) + mat(1424) = rxt(210)*y(15) + mat(453) = rxt(249)*y(15) + mat(1177) = rxt(263)*y(15) + mat(192) = -( rxt(16) + het_rates(17) ) + mat(90) = -( het_rates(42) ) + mat(48) = -( het_rates(43) ) + mat(1245) = -( rxt(17) + rxt(18) + het_rates(19) ) + mat(196) = rxt(16) + mat(293) = rxt(62) + mat(652) = 1.340_r8*rxt(66) + mat(185) = rxt(72) + mat(563) = rxt(76) + mat(301) = .690_r8*rxt(77) + mat(641) = rxt(78) + mat(555) = rxt(79) + mat(354) = .100_r8*rxt(83) + mat(189) = rxt(277) + mat(206) = 2.000_r8*rxt(289) + mat(1359) = rxt(154)*y(15) + rxt(155)*y(15) + mat(1263) = -( het_rates(22) ) + mat(197) = rxt(16) + mat(1246) = 2.000_r8*rxt(17) + mat(862) = rxt(19) + 2.000_r8*rxt(21) + mat(1083) = rxt(28) + mat(481) = rxt(34) + mat(96) = rxt(57) + mat(1360) = rxt(154)*y(15) + mat(1337) = -( rxt(410) + het_rates(24) ) + mat(235) = rxt(15) + rxt(203) + mat(622) = rxt(61) + mat(294) = rxt(62) + mat(654) = 1.340_r8*rxt(66) + .660_r8*rxt(67) + mat(153) = rxt(69) + mat(179) = rxt(71) + mat(676) = rxt(74) + mat(564) = rxt(76) + mat(302) = rxt(77) + mat(642) = rxt(78) + mat(556) = 2.000_r8*rxt(79) + mat(317) = .560_r8*rxt(81) + mat(400) = 2.000_r8*rxt(82) + mat(355) = .900_r8*rxt(83) + mat(214) = rxt(86) + mat(190) = rxt(277) + mat(207) = rxt(289) + mat(1361) = rxt(154)*y(15) + mat(1430) = rxt(251)*y(108) + rxt(256)*y(109) + mat(1183) = rxt(252)*y(108) + rxt(255)*y(109) + mat(338) = -( rxt(22) + het_rates(25) ) + mat(1293) = .500_r8*rxt(410) + mat(856) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(134) ) + mat(1171) = rxt(252)*y(108) + rxt(253)*y(115) + rxt(254)*y(113) + rxt(255)*y(109) & + + rxt(259)*y(125) + rxt(263)*y(15) + mat(1433) = -( rxt(210)*y(15) + rxt(251)*y(108) + rxt(256)*y(109) & + + rxt(261)*y(125) + rxt(262)*y(124) + het_rates(28) ) + mat(81) = 2.000_r8*rxt(23) + mat(903) = rxt(24) + mat(32) = 2.000_r8*rxt(26) + mat(516) = rxt(27) + mat(1087) = rxt(28) + mat(589) = rxt(29) + mat(105) = rxt(31) + mat(89) = rxt(56) + mat(1364) = 2.000_r8*rxt(135)*y(110) + 2.000_r8*rxt(136)*y(111) & + + 2.000_r8*rxt(137)*y(112) + 2.000_r8*rxt(138)*y(120) & + + rxt(139)*y(121) + rxt(140)*y(113) + rxt(141)*y(118) & + + rxt(142)*y(119) + 4.000_r8*rxt(143)*y(114) + rxt(145)*y(117) + mat(1186) = rxt(252)*y(108) + 3.000_r8*rxt(253)*y(115) + rxt(254)*y(113) & + + rxt(257)*y(118) + rxt(258)*y(119) + mat(80) = -( rxt(23) + het_rates(29) ) + mat(890) = -( rxt(24) + het_rates(30) ) + mat(59) = rxt(25) + mat(584) = rxt(30) + mat(31) = 2.000_r8*rxt(222) + mat(58) = -( rxt(25) + het_rates(31) ) + mat(30) = -( rxt(26) + rxt(222) + het_rates(32) ) + mat(1079) = -( rxt(28) + het_rates(33) ) + mat(1425) = rxt(210)*y(15) + 2.000_r8*rxt(251)*y(108) + rxt(256)*y(109) & + + rxt(261)*y(125) + rxt(262)*y(124) + mat(511) = -( rxt(27) + het_rates(34) ) + mat(580) = rxt(433) + rxt(439) + rxt(444) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(581) = -( rxt(29) + rxt(30) + rxt(433) + rxt(439) + rxt(444) + het_rates(35) & + ) + mat(103) = -( rxt(31) + het_rates(36) ) + mat(912) = -( het_rates(37) ) + mat(104) = rxt(31) + mat(821) = rxt(32) + mat(405) = rxt(33) + mat(479) = rxt(34) + mat(275) = rxt(35) + mat(1352) = rxt(144)*y(109) + rxt(145)*y(117) + rxt(146)*y(116) & + + 2.000_r8*rxt(147)*y(122) + 2.000_r8*rxt(148)*y(123) & + + 3.000_r8*rxt(149)*y(124) + 2.000_r8*rxt(150)*y(125) + mat(1174) = rxt(255)*y(109) + 2.000_r8*rxt(259)*y(125) + 3.000_r8*rxt(260)*y(124) + mat(1421) = rxt(256)*y(109) + 2.000_r8*rxt(261)*y(125) + 3.000_r8*rxt(262)*y(124) + mat(816) = -( rxt(32) + het_rates(38) ) + mat(273) = rxt(36) + mat(477) = -( rxt(34) + het_rates(39) ) + mat(402) = -( rxt(33) + het_rates(40) ) + mat(272) = rxt(434) + rxt(442) + rxt(445) + mat(271) = -( rxt(35) + rxt(36) + rxt(434) + rxt(442) + rxt(445) + het_rates(41) & + ) + mat(366) = -( het_rates(127) ) + mat(420) = -( rxt(460) + het_rates(128) ) + mat(837) = rxt(93) + rxt(105) + mat(332) = rxt(453)*y(126) + mat(223) = -( het_rates(129) ) + mat(484) = rxt(92) + mat(331) = -( rxt(450) + rxt(453)*y(126) + het_rates(130) ) + mat(1440) = rxt(89) + rxt(90) + rxt(91) + rxt(102) + rxt(103) + rxt(104) + mat(835) = rxt(95) + rxt(96) + rxt(97) + rxt(107) + rxt(108) + rxt(109) + mat(429) = -( het_rates(131) ) + mat(943) = rxt(7) + mat(333) = rxt(450) + mat(421) = rxt(460) + mat(250) = -( het_rates(133) ) + mat(440) = -( het_rates(132) ) + mat(944) = rxt(7) + mat(1446) = rxt(89) + rxt(90) + rxt(91) + rxt(102) + rxt(103) + rxt(104) + mat(488) = rxt(92) + mat(839) = rxt(93) + rxt(95) + rxt(96) + rxt(97) + rxt(105) + rxt(107) + rxt(108) & + + rxt(109) + mat(594) = -( het_rates(59) ) + mat(744) = .700_r8*rxt(68) + mat(534) = -( het_rates(83) ) + mat(467) = -( het_rates(64) ) + mat(614) = -( rxt(61) + het_rates(50) ) + mat(289) = rxt(62) + mat(151) = rxt(69) + mat(351) = .400_r8*rxt(83) + mat(141) = rxt(84) + mat(327) = -( het_rates(49) ) + mat(287) = -( rxt(62) + het_rates(65) ) + mat(799) = -( het_rates(48) ) + mat(238) = .600_r8*rxt(64) + rxt(308) + mat(648) = 1.340_r8*rxt(66) + mat(752) = .300_r8*rxt(68) + mat(182) = rxt(72) + mat(393) = rxt(73) + mat(670) = rxt(74) + mat(639) = rxt(78) + mat(201) = rxt(80) + mat(316) = .130_r8*rxt(81) + mat(142) = rxt(84) + mat(244) = -( rxt(63) + het_rates(54) ) + mat(237) = -( rxt(64) + rxt(308) + het_rates(58) ) + mat(157) = -( het_rates(82) ) + mat(114) = -( het_rates(45) ) + mat(255) = -( het_rates(44) ) + mat(33) = -( het_rates(71) ) + mat(279) = -( rxt(65) + rxt(354) + het_rates(81) ) + mat(36) = -( het_rates(70) ) + mat(132) = -( het_rates(73) ) + mat(380) = -( het_rates(84) ) + mat(346) = -( rxt(83) + het_rates(85) ) + mat(198) = -( rxt(80) + het_rates(72) ) + mat(345) = .800_r8*rxt(83) + mat(357) = -( het_rates(74) ) + mat(139) = -( rxt(84) + het_rates(75) ) + mat(61) = -( het_rates(94) ) + mat(66) = -( het_rates(95) ) + mat(304) = -( het_rates(96) ) + mat(161) = -( rxt(85) + het_rates(97) ) + mat(82) = -( het_rates(98) ) + mat(568) = -( het_rates(106) ) + mat(208) = -( rxt(86) + het_rates(107) ) + mat(312) = -( rxt(81) + het_rates(86) ) + mat(163) = .900_r8*rxt(85) + mat(397) = -( rxt(82) + het_rates(53) ) + mat(313) = .130_r8*rxt(81) + mat(164) = .450_r8*rxt(85) + mat(39) = -( het_rates(99) ) + mat(168) = -( het_rates(100) ) + mat(1) = -( het_rates(101) ) + mat(42) = -( het_rates(102) ) + mat(216) = -( het_rates(103) ) + mat(2) = -( het_rates(104) ) + mat(707) = -( het_rates(88) ) + mat(750) = -( rxt(68) + het_rates(77) ) + mat(299) = .402_r8*rxt(77) + mat(212) = rxt(86) + mat(644) = -( rxt(66) + rxt(67) + het_rates(78) ) + mat(296) = .288_r8*rxt(77) + mat(211) = rxt(86) + mat(731) = -( het_rates(79) ) + mat(144) = -( het_rates(80) ) + mat(770) = -( het_rates(76) ) + mat(281) = rxt(65) + rxt(354) + mat(647) = .660_r8*rxt(66) + mat(501) = -( het_rates(46) ) + mat(200) = rxt(80) + mat(149) = -( rxt(69) + het_rates(47) ) + mat(318) = -( het_rates(105) ) + mat(51) = -( het_rates(60) ) + mat(520) = -( het_rates(61) ) + mat(174) = -( rxt(71) + het_rates(62) ) + mat(391) = -( rxt(73) + het_rates(63) ) + mat(175) = .820_r8*rxt(71) + mat(349) = .250_r8*rxt(83) + mat(209) = .100_r8*rxt(86) + mat(180) = -( rxt(72) + het_rates(69) ) + mat(267) = -( het_rates(18) ) + mat(106) = -( het_rates(51) ) + mat(552) = -( rxt(79) + het_rates(52) ) + mat(637) = -( rxt(78) + het_rates(66) ) + mat(412) = -( het_rates(55) ) + mat(203) = -( rxt(289) + het_rates(56) ) + mat(70) = rxt(70) + mat(69) = -( rxt(70) + het_rates(57) ) + mat(154) = -( het_rates(87) ) + mat(625) = -( het_rates(67) ) + mat(669) = -( rxt(74) + het_rates(68) ) + mat(315) = .180_r8*rxt(81) + mat(165) = .450_r8*rxt(85) + mat(456) = -( het_rates(89) ) + mat(558) = -( rxt(76) + het_rates(90) ) + mat(684) = -( het_rates(91) ) + mat(110) = -( rxt(75) + het_rates(92) ) + mat(295) = -( rxt(77) + het_rates(93) ) + mat(120) = -( het_rates(135) ) + mat(263) = -( het_rates(136) ) + mat(186) = -( rxt(277) + het_rates(137) ) + mat(72) = -( rxt(55) + het_rates(138) ) + mat(1342) = rxt(136)*y(111) + rxt(137)*y(112) + 2.000_r8*rxt(138)*y(120) & + + 2.000_r8*rxt(139)*y(121) + rxt(140)*y(113) + rxt(142)*y(119) & + + rxt(145)*y(117) + rxt(146)*y(116) + rxt(147)*y(122) & + + 2.000_r8*rxt(148)*y(123) + mat(1100) = rxt(254)*y(113) + rxt(258)*y(119) + mat(86) = -( rxt(56) + het_rates(139) ) + mat(1344) = rxt(135)*y(110) + rxt(137)*y(112) + rxt(141)*y(118) + mat(1102) = rxt(257)*y(118) + mat(94) = -( rxt(57) + het_rates(140) ) + mat(447) = rxt(249)*y(15) + mat(448) = -( rxt(249)*y(15) + het_rates(141) ) + mat(73) = 2.000_r8*rxt(55) + mat(87) = rxt(56) + mat(95) = rxt(57) + mat(1346) = rxt(139)*y(121) + rxt(146)*y(116) + mat(56) = -( het_rates(156) ) + mat(98) = -( het_rates(157) ) + mat(3) = -( rxt(415) + het_rates(158) ) + mat(45) = -( het_rates(159) ) + mat(4) = -( rxt(421) + het_rates(160) ) + mat(5) = -( rxt(422) + het_rates(161) ) + mat(6) = -( rxt(416) + het_rates(146) ) + mat(7) = -( rxt(417) + het_rates(147) ) + mat(8) = -( rxt(419) + het_rates(148) ) + mat(9) = -( rxt(418) + het_rates(149) ) + mat(10) = -( rxt(420) + het_rates(150) ) + mat(11) = -( het_rates(151) ) + mat(12) = -( het_rates(152) ) + mat(13) = -( het_rates(153) ) + mat(14) = -( het_rates(154) ) + mat(15) = -( het_rates(155) ) + mat(16) = -( rxt(403) + rxt(411) + het_rates(142) ) + mat(18) = -( rxt(412) + het_rates(143) ) + mat(17) = rxt(403) + mat(19) = -( rxt(409) + rxt(413) + het_rates(144) ) + mat(21) = -( rxt(414) + het_rates(145) ) + mat(20) = rxt(409) + mat(22) = -( rxt(423) + het_rates(162) ) + mat(23) = -( rxt(424) + het_rates(163) ) + mat(24) = -( rxt(425) + het_rates(164) ) + mat(25) = -( rxt(426) + het_rates(165) ) + mat(26) = -( rxt(427) + het_rates(166) ) + mat(27) = -( rxt(428) + het_rates(167) ) + mat(28) = -( rxt(429) + het_rates(168) ) + mat(29) = -( rxt(430) + het_rates(169) ) + end subroutine linmat02 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 new file mode 100644 index 0000000000..1e8bdb0b8d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_lu_factor.F90 @@ -0,0 +1,5327 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = lu(17) * lu(16) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = lu(20) * lu(19) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(25) = 1._r8 / lu(25) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) + lu(31) = lu(31) * lu(30) + lu(32) = lu(32) * lu(30) + lu(890) = lu(890) - lu(31) * lu(880) + lu(903) = lu(903) - lu(32) * lu(880) + lu(33) = 1._r8 / lu(33) + lu(34) = lu(34) * lu(33) + lu(35) = lu(35) * lu(33) + lu(1139) = lu(1139) - lu(34) * lu(1090) + lu(1179) = lu(1179) - lu(35) * lu(1090) + lu(36) = 1._r8 / lu(36) + lu(37) = lu(37) * lu(36) + lu(38) = lu(38) * lu(36) + lu(1109) = lu(1109) - lu(37) * lu(1091) + lu(1179) = lu(1179) - lu(38) * lu(1091) + lu(39) = 1._r8 / lu(39) + lu(40) = lu(40) * lu(39) + lu(41) = lu(41) * lu(39) + lu(1116) = lu(1116) - lu(40) * lu(1092) + lu(1179) = lu(1179) - lu(41) * lu(1092) + lu(42) = 1._r8 / lu(42) + lu(43) = lu(43) * lu(42) + lu(44) = lu(44) * lu(42) + lu(1122) = lu(1122) - lu(43) * lu(1093) + lu(1179) = lu(1179) - lu(44) * lu(1093) + lu(45) = 1._r8 / lu(45) + lu(46) = lu(46) * lu(45) + lu(47) = lu(47) * lu(45) + lu(1171) = lu(1171) - lu(46) * lu(1094) + lu(1179) = lu(1179) - lu(47) * lu(1094) + lu(48) = 1._r8 / lu(48) + lu(49) = lu(49) * lu(48) + lu(50) = lu(50) * lu(48) + lu(1179) = lu(1179) - lu(49) * lu(1095) + lu(1183) = lu(1183) - lu(50) * lu(1095) + lu(51) = 1._r8 / lu(51) + lu(52) = lu(52) * lu(51) + lu(53) = lu(53) * lu(51) + lu(54) = lu(54) * lu(51) + lu(1149) = lu(1149) - lu(52) * lu(1096) + lu(1171) = lu(1171) - lu(53) * lu(1096) + lu(1179) = lu(1179) - lu(54) * lu(1096) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(56) = 1._r8 / lu(56) + lu(57) = lu(57) * lu(56) + lu(101) = lu(101) - lu(57) * lu(97) + lu(1016) = lu(1016) - lu(57) * lu(984) + lu(1179) = lu(1179) - lu(57) * lu(1097) + lu(58) = 1._r8 / lu(58) + lu(59) = lu(59) * lu(58) + lu(60) = lu(60) * lu(58) + lu(820) = lu(820) - lu(59) * lu(812) + lu(829) = lu(829) - lu(60) * lu(812) + lu(890) = lu(890) - lu(59) * lu(881) + lu(904) = lu(904) - lu(60) * lu(881) + lu(61) = 1._r8 / lu(61) + lu(62) = lu(62) * lu(61) + lu(63) = lu(63) * lu(61) + lu(64) = lu(64) * lu(61) + lu(65) = lu(65) * lu(61) + lu(1099) = lu(1099) - lu(62) * lu(1098) + lu(1132) = lu(1132) - lu(63) * lu(1098) + lu(1179) = lu(1179) - lu(64) * lu(1098) + lu(1183) = lu(1183) - lu(65) * lu(1098) + lu(66) = 1._r8 / lu(66) + lu(67) = lu(67) * lu(66) + lu(68) = lu(68) * lu(66) + lu(1101) = lu(1101) - lu(67) * lu(1099) + lu(1179) = lu(1179) - lu(68) * lu(1099) + lu(69) = 1._r8 / lu(69) + lu(70) = lu(70) * lu(69) + lu(71) = lu(71) * lu(69) + lu(411) = lu(411) - lu(70) * lu(410) + lu(416) = - lu(71) * lu(410) + lu(1282) = - lu(70) * lu(1271) + lu(1333) = lu(1333) - lu(71) * lu(1271) + lu(72) = 1._r8 / lu(72) + lu(73) = lu(73) * lu(72) + lu(74) = lu(74) * lu(72) + lu(1143) = - lu(73) * lu(1100) + lu(1184) = - lu(74) * lu(1100) + lu(1346) = lu(1346) - lu(73) * lu(1342) + lu(1362) = lu(1362) - lu(74) * lu(1342) + lu(75) = 1._r8 / lu(75) + lu(76) = lu(76) * lu(75) + lu(79) = lu(79) - lu(76) * lu(77) + lu(843) = lu(843) - lu(76) * lu(830) + lu(1213) = lu(1213) - lu(76) * lu(1188) + lu(1454) = lu(1454) - lu(76) * lu(1435) + lu(78) = 1._r8 / lu(78) + lu(79) = lu(79) * lu(78) + lu(843) = lu(843) - lu(79) * lu(831) + lu(1213) = lu(1213) - lu(79) * lu(1189) + lu(1349) = lu(1349) - lu(79) * lu(1343) + lu(1454) = lu(1454) - lu(79) * lu(1436) + lu(80) = 1._r8 / lu(80) + lu(81) = lu(81) * lu(80) + lu(516) = lu(516) - lu(81) * lu(510) + lu(589) = lu(589) - lu(81) * lu(579) + lu(903) = lu(903) - lu(81) * lu(882) + lu(1087) = lu(1087) - lu(81) * lu(1065) + lu(1433) = lu(1433) - lu(81) * lu(1401) + lu(82) = 1._r8 / lu(82) + lu(83) = lu(83) * lu(82) + lu(84) = lu(84) * lu(82) + lu(85) = lu(85) * lu(82) + lu(1133) = - lu(83) * lu(1101) + lu(1183) = lu(1183) - lu(84) * lu(1101) + lu(1185) = lu(1185) - lu(85) * lu(1101) + lu(1372) = lu(1372) - lu(83) * lu(1366) + lu(1396) = lu(1396) - lu(84) * lu(1366) + lu(1398) = lu(1398) - lu(85) * lu(1366) + lu(86) = 1._r8 / lu(86) + lu(87) = lu(87) * lu(86) + lu(88) = lu(88) * lu(86) + lu(89) = lu(89) * lu(86) + lu(1143) = lu(1143) - lu(87) * lu(1102) + lu(1184) = lu(1184) - lu(88) * lu(1102) + lu(1186) = lu(1186) - lu(89) * lu(1102) + lu(1346) = lu(1346) - lu(87) * lu(1344) + lu(1362) = lu(1362) - lu(88) * lu(1344) + lu(1364) = lu(1364) - lu(89) * lu(1344) + lu(90) = 1._r8 / lu(90) + lu(91) = lu(91) * lu(90) + lu(92) = lu(92) * lu(90) + lu(93) = lu(93) * lu(90) + lu(1179) = lu(1179) - lu(91) * lu(1103) + lu(1183) = lu(1183) - lu(92) * lu(1103) + lu(1184) = lu(1184) - lu(93) * lu(1103) + lu(1357) = lu(1357) - lu(91) * lu(1345) + lu(1361) = lu(1361) - lu(92) * lu(1345) + lu(1362) = lu(1362) - lu(93) * lu(1345) + lu(94) = 1._r8 / lu(94) + lu(95) = lu(95) * lu(94) + lu(96) = lu(96) * lu(94) + lu(448) = lu(448) - lu(95) * lu(447) + lu(455) = lu(455) - lu(96) * lu(447) + lu(656) = lu(656) - lu(95) * lu(655) + lu(664) = lu(664) - lu(96) * lu(655) + lu(854) = lu(854) - lu(95) * lu(853) + lu(862) = lu(862) - lu(96) * lu(853) + lu(867) = lu(867) - lu(95) * lu(866) + lu(875) = - lu(96) * lu(866) + lu(98) = 1._r8 / lu(98) + lu(99) = lu(99) * lu(98) + lu(100) = lu(100) * lu(98) + lu(101) = lu(101) * lu(98) + lu(102) = lu(102) * lu(98) + lu(1011) = lu(1011) - lu(99) * lu(985) + lu(1013) = lu(1013) - lu(100) * lu(985) + lu(1016) = lu(1016) - lu(101) * lu(985) + lu(1020) = lu(1020) - lu(102) * lu(985) + lu(1172) = lu(1172) - lu(99) * lu(1104) + lu(1176) = lu(1176) - lu(100) * lu(1104) + lu(1179) = lu(1179) - lu(101) * lu(1104) + lu(1183) = lu(1183) - lu(102) * lu(1104) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(103) = 1._r8 / lu(103) + lu(104) = lu(104) * lu(103) + lu(105) = lu(105) * lu(103) + lu(405) = lu(405) - lu(104) * lu(401) + lu(408) = - lu(105) * lu(401) + lu(821) = lu(821) - lu(104) * lu(813) + lu(828) = lu(828) - lu(105) * lu(813) + lu(891) = lu(891) - lu(104) * lu(883) + lu(903) = lu(903) - lu(105) * lu(883) + lu(1075) = - lu(104) * lu(1066) + lu(1087) = lu(1087) - lu(105) * lu(1066) + lu(106) = 1._r8 / lu(106) + lu(107) = lu(107) * lu(106) + lu(108) = lu(108) * lu(106) + lu(109) = lu(109) * lu(106) + lu(502) = lu(502) - lu(107) * lu(498) + lu(506) = - lu(108) * lu(498) + lu(508) = lu(508) - lu(109) * lu(498) + lu(1036) = lu(1036) - lu(107) * lu(1025) + lu(1056) = - lu(108) * lu(1025) + lu(1060) = lu(1060) - lu(109) * lu(1025) + lu(1157) = lu(1157) - lu(107) * lu(1105) + lu(1179) = lu(1179) - lu(108) * lu(1105) + lu(1183) = lu(1183) - lu(109) * lu(1105) + lu(110) = 1._r8 / lu(110) + lu(111) = lu(111) * lu(110) + lu(112) = lu(112) * lu(110) + lu(113) = lu(113) * lu(110) + lu(684) = lu(684) - lu(111) * lu(677) + lu(686) = - lu(112) * lu(677) + lu(691) = - lu(113) * lu(677) + lu(1163) = lu(1163) - lu(111) * lu(1106) + lu(1171) = lu(1171) - lu(112) * lu(1106) + lu(1179) = lu(1179) - lu(113) * lu(1106) + lu(1317) = lu(1317) - lu(111) * lu(1272) + lu(1325) = lu(1325) - lu(112) * lu(1272) + lu(1333) = lu(1333) - lu(113) * lu(1272) + lu(114) = 1._r8 / lu(114) + lu(115) = lu(115) * lu(114) + lu(116) = lu(116) * lu(114) + lu(117) = lu(117) * lu(114) + lu(118) = lu(118) * lu(114) + lu(119) = lu(119) * lu(114) + lu(1147) = lu(1147) - lu(115) * lu(1107) + lu(1171) = lu(1171) - lu(116) * lu(1107) + lu(1178) = lu(1178) - lu(117) * lu(1107) + lu(1179) = lu(1179) - lu(118) * lu(1107) + lu(1186) = lu(1186) - lu(119) * lu(1107) + lu(1409) = lu(1409) - lu(115) * lu(1402) + lu(1418) = - lu(116) * lu(1402) + lu(1425) = lu(1425) - lu(117) * lu(1402) + lu(1426) = lu(1426) - lu(118) * lu(1402) + lu(1433) = lu(1433) - lu(119) * lu(1402) + lu(120) = 1._r8 / lu(120) + lu(121) = lu(121) * lu(120) + lu(122) = lu(122) * lu(120) + lu(123) = lu(123) * lu(120) + lu(124) = lu(124) * lu(120) + lu(125) = lu(125) * lu(120) + lu(1127) = lu(1127) - lu(121) * lu(1108) + lu(1141) = lu(1141) - lu(122) * lu(1108) + lu(1156) = lu(1156) - lu(123) * lu(1108) + lu(1179) = lu(1179) - lu(124) * lu(1108) + lu(1183) = lu(1183) - lu(125) * lu(1108) + lu(1405) = - lu(121) * lu(1403) + lu(1407) = - lu(122) * lu(1403) + lu(1413) = lu(1413) - lu(123) * lu(1403) + lu(1426) = lu(1426) - lu(124) * lu(1403) + lu(1430) = lu(1430) - lu(125) * lu(1403) + lu(126) = 1._r8 / lu(126) + lu(127) = lu(127) * lu(126) + lu(128) = lu(128) * lu(126) + lu(129) = lu(129) * lu(126) + lu(130) = lu(130) * lu(126) + lu(131) = lu(131) * lu(126) + lu(1011) = lu(1011) - lu(127) * lu(986) + lu(1012) = lu(1012) - lu(128) * lu(986) + lu(1013) = lu(1013) - lu(129) * lu(986) + lu(1022) = lu(1022) - lu(130) * lu(986) + lu(1024) = lu(1024) - lu(131) * lu(986) + lu(1385) = lu(1385) - lu(127) * lu(1367) + lu(1388) = lu(1388) - lu(128) * lu(1367) + lu(1389) = lu(1389) - lu(129) * lu(1367) + lu(1398) = lu(1398) - lu(130) * lu(1367) + lu(1400) = lu(1400) - lu(131) * lu(1367) + lu(132) = 1._r8 / lu(132) + lu(133) = lu(133) * lu(132) + lu(134) = lu(134) * lu(132) + lu(135) = lu(135) * lu(132) + lu(136) = lu(136) * lu(132) + lu(137) = lu(137) * lu(132) + lu(138) = lu(138) * lu(132) + lu(939) = lu(939) - lu(133) * lu(926) + lu(954) = lu(954) - lu(134) * lu(926) + lu(971) = lu(971) - lu(135) * lu(926) + lu(977) = lu(977) - lu(136) * lu(926) + lu(979) = lu(979) - lu(137) * lu(926) + lu(981) = lu(981) - lu(138) * lu(926) + lu(1140) = lu(1140) - lu(133) * lu(1109) + lu(1157) = lu(1157) - lu(134) * lu(1109) + lu(1175) = lu(1175) - lu(135) * lu(1109) + lu(1181) = lu(1181) - lu(136) * lu(1109) + lu(1183) = lu(1183) - lu(137) * lu(1109) + lu(1185) = lu(1185) - lu(138) * lu(1109) + lu(139) = 1._r8 / lu(139) + lu(140) = lu(140) * lu(139) + lu(141) = lu(141) * lu(139) + lu(142) = lu(142) * lu(139) + lu(143) = lu(143) * lu(139) + lu(357) = lu(357) - lu(140) * lu(356) + lu(358) = lu(358) - lu(141) * lu(356) + lu(359) = lu(359) - lu(142) * lu(356) + lu(361) = - lu(143) * lu(356) + lu(1138) = lu(1138) - lu(140) * lu(1110) + lu(1157) = lu(1157) - lu(141) * lu(1110) + lu(1168) = lu(1168) - lu(142) * lu(1110) + lu(1179) = lu(1179) - lu(143) * lu(1110) + lu(1295) = lu(1295) - lu(140) * lu(1273) + lu(1311) = - lu(141) * lu(1273) + lu(1322) = lu(1322) - lu(142) * lu(1273) + lu(1333) = lu(1333) - lu(143) * lu(1273) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(144) = 1._r8 / lu(144) + lu(145) = lu(145) * lu(144) + lu(146) = lu(146) * lu(144) + lu(147) = lu(147) * lu(144) + lu(148) = lu(148) * lu(144) + lu(731) = lu(731) - lu(145) * lu(723) + lu(732) = - lu(146) * lu(723) + lu(739) = - lu(147) * lu(723) + lu(742) = lu(742) - lu(148) * lu(723) + lu(1165) = lu(1165) - lu(145) * lu(1111) + lu(1167) = lu(1167) - lu(146) * lu(1111) + lu(1179) = lu(1179) - lu(147) * lu(1111) + lu(1183) = lu(1183) - lu(148) * lu(1111) + lu(1319) = lu(1319) - lu(145) * lu(1274) + lu(1321) = lu(1321) - lu(146) * lu(1274) + lu(1333) = lu(1333) - lu(147) * lu(1274) + lu(1337) = lu(1337) - lu(148) * lu(1274) + lu(149) = 1._r8 / lu(149) + lu(150) = lu(150) * lu(149) + lu(151) = lu(151) * lu(149) + lu(152) = lu(152) * lu(149) + lu(153) = lu(153) * lu(149) + lu(501) = lu(501) - lu(150) * lu(499) + lu(502) = lu(502) - lu(151) * lu(499) + lu(506) = lu(506) - lu(152) * lu(499) + lu(508) = lu(508) - lu(153) * lu(499) + lu(1147) = lu(1147) - lu(150) * lu(1112) + lu(1157) = lu(1157) - lu(151) * lu(1112) + lu(1179) = lu(1179) - lu(152) * lu(1112) + lu(1183) = lu(1183) - lu(153) * lu(1112) + lu(1304) = lu(1304) - lu(150) * lu(1275) + lu(1311) = lu(1311) - lu(151) * lu(1275) + lu(1333) = lu(1333) - lu(152) * lu(1275) + lu(1337) = lu(1337) - lu(153) * lu(1275) + lu(154) = 1._r8 / lu(154) + lu(155) = lu(155) * lu(154) + lu(156) = lu(156) * lu(154) + lu(560) = - lu(155) * lu(557) + lu(562) = lu(562) - lu(156) * lu(557) + lu(706) = - lu(155) * lu(696) + lu(717) = - lu(156) * lu(696) + lu(794) = lu(794) - lu(155) * lu(784) + lu(806) = - lu(156) * lu(784) + lu(959) = lu(959) - lu(155) * lu(927) + lu(975) = lu(975) - lu(156) * lu(927) + lu(1003) = lu(1003) - lu(155) * lu(987) + lu(1016) = lu(1016) - lu(156) * lu(987) + lu(1041) = lu(1041) - lu(155) * lu(1026) + lu(1056) = lu(1056) - lu(156) * lu(1026) + lu(1163) = lu(1163) - lu(155) * lu(1113) + lu(1179) = lu(1179) - lu(156) * lu(1113) + lu(157) = 1._r8 / lu(157) + lu(158) = lu(158) * lu(157) + lu(159) = lu(159) * lu(157) + lu(160) = lu(160) * lu(157) + lu(384) = - lu(158) * lu(376) + lu(387) = - lu(159) * lu(376) + lu(390) = lu(390) - lu(160) * lu(376) + lu(598) = - lu(158) * lu(591) + lu(604) = lu(604) - lu(159) * lu(591) + lu(608) = - lu(160) * lu(591) + lu(958) = lu(958) - lu(158) * lu(928) + lu(975) = lu(975) - lu(159) * lu(928) + lu(981) = lu(981) - lu(160) * lu(928) + lu(1002) = lu(1002) - lu(158) * lu(988) + lu(1016) = lu(1016) - lu(159) * lu(988) + lu(1022) = lu(1022) - lu(160) * lu(988) + lu(1162) = lu(1162) - lu(158) * lu(1114) + lu(1179) = lu(1179) - lu(159) * lu(1114) + lu(1185) = lu(1185) - lu(160) * lu(1114) + lu(161) = 1._r8 / lu(161) + lu(162) = lu(162) * lu(161) + lu(163) = lu(163) * lu(161) + lu(164) = lu(164) * lu(161) + lu(165) = lu(165) * lu(161) + lu(166) = lu(166) * lu(161) + lu(304) = lu(304) - lu(162) * lu(303) + lu(305) = lu(305) - lu(163) * lu(303) + lu(306) = lu(306) - lu(164) * lu(303) + lu(307) = lu(307) - lu(165) * lu(303) + lu(309) = - lu(166) * lu(303) + lu(1132) = lu(1132) - lu(162) * lu(1115) + lu(1133) = lu(1133) - lu(163) * lu(1115) + lu(1141) = lu(1141) - lu(164) * lu(1115) + lu(1162) = lu(1162) - lu(165) * lu(1115) + lu(1179) = lu(1179) - lu(166) * lu(1115) + lu(1290) = lu(1290) - lu(162) * lu(1276) + lu(1291) = - lu(163) * lu(1276) + lu(1298) = - lu(164) * lu(1276) + lu(1316) = - lu(165) * lu(1276) + lu(1333) = lu(1333) - lu(166) * lu(1276) + lu(168) = 1._r8 / lu(168) + lu(169) = lu(169) * lu(168) + lu(170) = lu(170) * lu(168) + lu(171) = lu(171) * lu(168) + lu(172) = lu(172) * lu(168) + lu(173) = lu(173) * lu(168) + lu(936) = lu(936) - lu(169) * lu(929) + lu(940) = lu(940) - lu(170) * lu(929) + lu(971) = lu(971) - lu(171) * lu(929) + lu(979) = lu(979) - lu(172) * lu(929) + lu(981) = lu(981) - lu(173) * lu(929) + lu(1133) = lu(1133) - lu(169) * lu(1116) + lu(1141) = lu(1141) - lu(170) * lu(1116) + lu(1175) = lu(1175) - lu(171) * lu(1116) + lu(1183) = lu(1183) - lu(172) * lu(1116) + lu(1185) = lu(1185) - lu(173) * lu(1116) + lu(1291) = lu(1291) - lu(169) * lu(1277) + lu(1298) = lu(1298) - lu(170) * lu(1277) + lu(1329) = lu(1329) - lu(171) * lu(1277) + lu(1337) = lu(1337) - lu(172) * lu(1277) + lu(1339) = lu(1339) - lu(173) * lu(1277) + lu(174) = 1._r8 / lu(174) + lu(175) = lu(175) * lu(174) + lu(176) = lu(176) * lu(174) + lu(177) = lu(177) * lu(174) + lu(178) = lu(178) * lu(174) + lu(179) = lu(179) * lu(174) + lu(519) = lu(519) - lu(175) * lu(518) + lu(520) = lu(520) - lu(176) * lu(518) + lu(525) = - lu(177) * lu(518) + lu(528) = - lu(178) * lu(518) + lu(530) = lu(530) - lu(179) * lu(518) + lu(1140) = lu(1140) - lu(175) * lu(1117) + lu(1149) = lu(1149) - lu(176) * lu(1117) + lu(1171) = lu(1171) - lu(177) * lu(1117) + lu(1179) = lu(1179) - lu(178) * lu(1117) + lu(1183) = lu(1183) - lu(179) * lu(1117) + lu(1297) = - lu(175) * lu(1278) + lu(1306) = lu(1306) - lu(176) * lu(1278) + lu(1325) = lu(1325) - lu(177) * lu(1278) + lu(1333) = lu(1333) - lu(178) * lu(1278) + lu(1337) = lu(1337) - lu(179) * lu(1278) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(180) = 1._r8 / lu(180) + lu(181) = lu(181) * lu(180) + lu(182) = lu(182) * lu(180) + lu(183) = lu(183) * lu(180) + lu(184) = lu(184) * lu(180) + lu(185) = lu(185) * lu(180) + lu(625) = lu(625) - lu(181) * lu(623) + lu(628) = lu(628) - lu(182) * lu(623) + lu(630) = - lu(183) * lu(623) + lu(633) = - lu(184) * lu(623) + lu(634) = lu(634) - lu(185) * lu(623) + lu(1158) = lu(1158) - lu(181) * lu(1118) + lu(1168) = lu(1168) - lu(182) * lu(1118) + lu(1171) = lu(1171) - lu(183) * lu(1118) + lu(1179) = lu(1179) - lu(184) * lu(1118) + lu(1181) = lu(1181) - lu(185) * lu(1118) + lu(1312) = lu(1312) - lu(181) * lu(1279) + lu(1322) = lu(1322) - lu(182) * lu(1279) + lu(1325) = lu(1325) - lu(183) * lu(1279) + lu(1333) = lu(1333) - lu(184) * lu(1279) + lu(1335) = lu(1335) - lu(185) * lu(1279) + lu(186) = 1._r8 / lu(186) + lu(187) = lu(187) * lu(186) + lu(188) = lu(188) * lu(186) + lu(189) = lu(189) * lu(186) + lu(190) = lu(190) * lu(186) + lu(191) = lu(191) * lu(186) + lu(934) = lu(934) - lu(187) * lu(930) + lu(971) = lu(971) - lu(188) * lu(930) + lu(977) = lu(977) - lu(189) * lu(930) + lu(979) = lu(979) - lu(190) * lu(930) + lu(981) = lu(981) - lu(191) * lu(930) + lu(1232) = - lu(187) * lu(1231) + lu(1239) = - lu(188) * lu(1231) + lu(1245) = lu(1245) - lu(189) * lu(1231) + lu(1247) = lu(1247) - lu(190) * lu(1231) + lu(1249) = - lu(191) * lu(1231) + lu(1287) = lu(1287) - lu(187) * lu(1280) + lu(1329) = lu(1329) - lu(188) * lu(1280) + lu(1335) = lu(1335) - lu(189) * lu(1280) + lu(1337) = lu(1337) - lu(190) * lu(1280) + lu(1339) = lu(1339) - lu(191) * lu(1280) + lu(192) = 1._r8 / lu(192) + lu(193) = lu(193) * lu(192) + lu(194) = lu(194) * lu(192) + lu(195) = lu(195) * lu(192) + lu(196) = lu(196) * lu(192) + lu(197) = lu(197) * lu(192) + lu(1048) = - lu(193) * lu(1027) + lu(1054) = lu(1054) - lu(194) * lu(1027) + lu(1056) = lu(1056) - lu(195) * lu(1027) + lu(1058) = lu(1058) - lu(196) * lu(1027) + lu(1059) = - lu(197) * lu(1027) + lu(1171) = lu(1171) - lu(193) * lu(1119) + lu(1177) = lu(1177) - lu(194) * lu(1119) + lu(1179) = lu(1179) - lu(195) * lu(1119) + lu(1181) = lu(1181) - lu(196) * lu(1119) + lu(1182) = lu(1182) - lu(197) * lu(1119) + lu(1325) = lu(1325) - lu(193) * lu(1281) + lu(1331) = lu(1331) - lu(194) * lu(1281) + lu(1333) = lu(1333) - lu(195) * lu(1281) + lu(1335) = lu(1335) - lu(196) * lu(1281) + lu(1336) = lu(1336) - lu(197) * lu(1281) + lu(198) = 1._r8 / lu(198) + lu(199) = lu(199) * lu(198) + lu(200) = lu(200) * lu(198) + lu(201) = lu(201) * lu(198) + lu(202) = lu(202) * lu(198) + lu(347) = - lu(199) * lu(345) + lu(350) = - lu(200) * lu(345) + lu(352) = - lu(201) * lu(345) + lu(353) = lu(353) - lu(202) * lu(345) + lu(379) = - lu(199) * lu(377) + lu(382) = - lu(200) * lu(377) + lu(385) = - lu(201) * lu(377) + lu(387) = lu(387) - lu(202) * lu(377) + lu(937) = lu(937) - lu(199) * lu(931) + lu(948) = lu(948) - lu(200) * lu(931) + lu(964) = lu(964) - lu(201) * lu(931) + lu(975) = lu(975) - lu(202) * lu(931) + lu(1138) = lu(1138) - lu(199) * lu(1120) + lu(1147) = lu(1147) - lu(200) * lu(1120) + lu(1168) = lu(1168) - lu(201) * lu(1120) + lu(1179) = lu(1179) - lu(202) * lu(1120) + lu(203) = 1._r8 / lu(203) + lu(204) = lu(204) * lu(203) + lu(205) = lu(205) * lu(203) + lu(206) = lu(206) * lu(203) + lu(207) = lu(207) * lu(203) + lu(413) = - lu(204) * lu(411) + lu(414) = - lu(205) * lu(411) + lu(417) = lu(417) - lu(206) * lu(411) + lu(418) = lu(418) - lu(207) * lu(411) + lu(841) = lu(841) - lu(204) * lu(832) + lu(843) = lu(843) - lu(205) * lu(832) + lu(847) = - lu(206) * lu(832) + lu(849) = lu(849) - lu(207) * lu(832) + lu(950) = lu(950) - lu(204) * lu(932) + lu(966) = lu(966) - lu(205) * lu(932) + lu(977) = lu(977) - lu(206) * lu(932) + lu(979) = lu(979) - lu(207) * lu(932) + lu(1307) = - lu(204) * lu(1282) + lu(1324) = lu(1324) - lu(205) * lu(1282) + lu(1335) = lu(1335) - lu(206) * lu(1282) + lu(1337) = lu(1337) - lu(207) * lu(1282) + lu(208) = 1._r8 / lu(208) + lu(209) = lu(209) * lu(208) + lu(210) = lu(210) * lu(208) + lu(211) = lu(211) * lu(208) + lu(212) = lu(212) * lu(208) + lu(213) = lu(213) * lu(208) + lu(214) = lu(214) * lu(208) + lu(567) = lu(567) - lu(209) * lu(566) + lu(568) = lu(568) - lu(210) * lu(566) + lu(570) = lu(570) - lu(211) * lu(566) + lu(571) = lu(571) - lu(212) * lu(566) + lu(576) = - lu(213) * lu(566) + lu(577) = lu(577) - lu(214) * lu(566) + lu(1140) = lu(1140) - lu(209) * lu(1121) + lu(1153) = lu(1153) - lu(210) * lu(1121) + lu(1160) = lu(1160) - lu(211) * lu(1121) + lu(1166) = lu(1166) - lu(212) * lu(1121) + lu(1179) = lu(1179) - lu(213) * lu(1121) + lu(1183) = lu(1183) - lu(214) * lu(1121) + lu(1297) = lu(1297) - lu(209) * lu(1283) + lu(1309) = lu(1309) - lu(210) * lu(1283) + lu(1314) = lu(1314) - lu(211) * lu(1283) + lu(1320) = lu(1320) - lu(212) * lu(1283) + lu(1333) = lu(1333) - lu(213) * lu(1283) + lu(1337) = lu(1337) - lu(214) * lu(1283) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(216) = 1._r8 / lu(216) + lu(217) = lu(217) * lu(216) + lu(218) = lu(218) * lu(216) + lu(219) = lu(219) * lu(216) + lu(220) = lu(220) * lu(216) + lu(221) = lu(221) * lu(216) + lu(222) = lu(222) * lu(216) + lu(936) = lu(936) - lu(217) * lu(933) + lu(940) = lu(940) - lu(218) * lu(933) + lu(958) = lu(958) - lu(219) * lu(933) + lu(971) = lu(971) - lu(220) * lu(933) + lu(979) = lu(979) - lu(221) * lu(933) + lu(981) = lu(981) - lu(222) * lu(933) + lu(1133) = lu(1133) - lu(217) * lu(1122) + lu(1141) = lu(1141) - lu(218) * lu(1122) + lu(1162) = lu(1162) - lu(219) * lu(1122) + lu(1175) = lu(1175) - lu(220) * lu(1122) + lu(1183) = lu(1183) - lu(221) * lu(1122) + lu(1185) = lu(1185) - lu(222) * lu(1122) + lu(1291) = lu(1291) - lu(217) * lu(1284) + lu(1298) = lu(1298) - lu(218) * lu(1284) + lu(1316) = lu(1316) - lu(219) * lu(1284) + lu(1329) = lu(1329) - lu(220) * lu(1284) + lu(1337) = lu(1337) - lu(221) * lu(1284) + lu(1339) = lu(1339) - lu(222) * lu(1284) + lu(223) = 1._r8 / lu(223) + lu(224) = lu(224) * lu(223) + lu(225) = lu(225) * lu(223) + lu(226) = lu(226) * lu(223) + lu(227) = lu(227) * lu(223) + lu(228) = lu(228) * lu(223) + lu(229) = lu(229) * lu(223) + lu(485) = - lu(224) * lu(484) + lu(486) = lu(486) - lu(225) * lu(484) + lu(487) = lu(487) - lu(226) * lu(484) + lu(489) = lu(489) - lu(227) * lu(484) + lu(491) = lu(491) - lu(228) * lu(484) + lu(497) = lu(497) - lu(229) * lu(484) + lu(835) = lu(835) - lu(224) * lu(833) + lu(837) = lu(837) - lu(225) * lu(833) + lu(838) = lu(838) - lu(226) * lu(833) + lu(840) = lu(840) - lu(227) * lu(833) + lu(843) = lu(843) - lu(228) * lu(833) + lu(852) = lu(852) - lu(229) * lu(833) + lu(1440) = lu(1440) - lu(224) * lu(1437) + lu(1444) = - lu(225) * lu(1437) + lu(1445) = lu(1445) - lu(226) * lu(1437) + lu(1448) = lu(1448) - lu(227) * lu(1437) + lu(1454) = lu(1454) - lu(228) * lu(1437) + lu(1471) = lu(1471) - lu(229) * lu(1437) + lu(230) = 1._r8 / lu(230) + lu(231) = lu(231) * lu(230) + lu(232) = lu(232) * lu(230) + lu(233) = lu(233) * lu(230) + lu(234) = lu(234) * lu(230) + lu(235) = lu(235) * lu(230) + lu(236) = lu(236) * lu(230) + lu(1170) = lu(1170) - lu(231) * lu(1123) + lu(1171) = lu(1171) - lu(232) * lu(1123) + lu(1176) = lu(1176) - lu(233) * lu(1123) + lu(1179) = lu(1179) - lu(234) * lu(1123) + lu(1183) = lu(1183) - lu(235) * lu(1123) + lu(1185) = lu(1185) - lu(236) * lu(1123) + lu(1324) = lu(1324) - lu(231) * lu(1285) + lu(1325) = lu(1325) - lu(232) * lu(1285) + lu(1330) = lu(1330) - lu(233) * lu(1285) + lu(1333) = lu(1333) - lu(234) * lu(1285) + lu(1337) = lu(1337) - lu(235) * lu(1285) + lu(1339) = lu(1339) - lu(236) * lu(1285) + lu(1383) = lu(1383) - lu(231) * lu(1368) + lu(1384) = - lu(232) * lu(1368) + lu(1389) = lu(1389) - lu(233) * lu(1368) + lu(1392) = lu(1392) - lu(234) * lu(1368) + lu(1396) = lu(1396) - lu(235) * lu(1368) + lu(1398) = lu(1398) - lu(236) * lu(1368) + lu(237) = 1._r8 / lu(237) + lu(238) = lu(238) * lu(237) + lu(239) = lu(239) * lu(237) + lu(240) = lu(240) * lu(237) + lu(241) = lu(241) * lu(237) + lu(242) = lu(242) * lu(237) + lu(243) = lu(243) * lu(237) + lu(799) = lu(799) - lu(238) * lu(785) + lu(804) = - lu(239) * lu(785) + lu(805) = lu(805) - lu(240) * lu(785) + lu(806) = lu(806) - lu(241) * lu(785) + lu(808) = lu(808) - lu(242) * lu(785) + lu(811) = lu(811) - lu(243) * lu(785) + lu(1168) = lu(1168) - lu(238) * lu(1124) + lu(1176) = lu(1176) - lu(239) * lu(1124) + lu(1177) = lu(1177) - lu(240) * lu(1124) + lu(1179) = lu(1179) - lu(241) * lu(1124) + lu(1181) = lu(1181) - lu(242) * lu(1124) + lu(1185) = lu(1185) - lu(243) * lu(1124) + lu(1381) = lu(1381) - lu(238) * lu(1369) + lu(1389) = lu(1389) - lu(239) * lu(1369) + lu(1390) = - lu(240) * lu(1369) + lu(1392) = lu(1392) - lu(241) * lu(1369) + lu(1394) = - lu(242) * lu(1369) + lu(1398) = lu(1398) - lu(243) * lu(1369) + lu(244) = 1._r8 / lu(244) + lu(245) = lu(245) * lu(244) + lu(246) = lu(246) * lu(244) + lu(247) = lu(247) * lu(244) + lu(248) = lu(248) * lu(244) + lu(249) = lu(249) * lu(244) + lu(771) = lu(771) - lu(245) * lu(765) + lu(773) = - lu(246) * lu(765) + lu(777) = lu(777) - lu(247) * lu(765) + lu(778) = - lu(248) * lu(765) + lu(780) = lu(780) - lu(249) * lu(765) + lu(799) = lu(799) - lu(245) * lu(786) + lu(801) = - lu(246) * lu(786) + lu(805) = lu(805) - lu(247) * lu(786) + lu(806) = lu(806) - lu(248) * lu(786) + lu(808) = lu(808) - lu(249) * lu(786) + lu(1168) = lu(1168) - lu(245) * lu(1125) + lu(1171) = lu(1171) - lu(246) * lu(1125) + lu(1177) = lu(1177) - lu(247) * lu(1125) + lu(1179) = lu(1179) - lu(248) * lu(1125) + lu(1181) = lu(1181) - lu(249) * lu(1125) + lu(1322) = lu(1322) - lu(245) * lu(1286) + lu(1325) = lu(1325) - lu(246) * lu(1286) + lu(1331) = lu(1331) - lu(247) * lu(1286) + lu(1333) = lu(1333) - lu(248) * lu(1286) + lu(1335) = lu(1335) - lu(249) * lu(1286) + lu(250) = 1._r8 / lu(250) + lu(251) = lu(251) * lu(250) + lu(252) = lu(252) * lu(250) + lu(253) = lu(253) * lu(250) + lu(254) = lu(254) * lu(250) + lu(370) = lu(370) - lu(251) * lu(364) + lu(372) = lu(372) - lu(252) * lu(364) + lu(373) = - lu(253) * lu(364) + lu(374) = - lu(254) * lu(364) + lu(431) = lu(431) - lu(251) * lu(428) + lu(432) = - lu(252) * lu(428) + lu(433) = - lu(253) * lu(428) + lu(434) = - lu(254) * lu(428) + lu(441) = lu(441) - lu(251) * lu(436) + lu(443) = - lu(252) * lu(436) + lu(444) = - lu(253) * lu(436) + lu(445) = lu(445) - lu(254) * lu(436) + lu(840) = lu(840) - lu(251) * lu(834) + lu(843) = lu(843) - lu(252) * lu(834) + lu(844) = lu(844) - lu(253) * lu(834) + lu(850) = lu(850) - lu(254) * lu(834) + lu(1448) = lu(1448) - lu(251) * lu(1438) + lu(1454) = lu(1454) - lu(252) * lu(1438) + lu(1459) = lu(1459) - lu(253) * lu(1438) + lu(1468) = - lu(254) * lu(1438) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(255) = 1._r8 / lu(255) + lu(256) = lu(256) * lu(255) + lu(257) = lu(257) * lu(255) + lu(258) = lu(258) * lu(255) + lu(259) = lu(259) * lu(255) + lu(260) = lu(260) * lu(255) + lu(261) = lu(261) * lu(255) + lu(262) = lu(262) * lu(255) + lu(1127) = lu(1127) - lu(256) * lu(1126) + lu(1142) = lu(1142) - lu(257) * lu(1126) + lu(1156) = lu(1156) - lu(258) * lu(1126) + lu(1179) = lu(1179) - lu(259) * lu(1126) + lu(1180) = lu(1180) - lu(260) * lu(1126) + lu(1181) = lu(1181) - lu(261) * lu(1126) + lu(1183) = lu(1183) - lu(262) * lu(1126) + lu(1191) = lu(1191) - lu(256) * lu(1190) + lu(1194) = - lu(257) * lu(1190) + lu(1200) = lu(1200) - lu(258) * lu(1190) + lu(1222) = lu(1222) - lu(259) * lu(1190) + lu(1223) = lu(1223) - lu(260) * lu(1190) + lu(1224) = lu(1224) - lu(261) * lu(1190) + lu(1226) = lu(1226) - lu(262) * lu(1190) + lu(1405) = lu(1405) - lu(256) * lu(1404) + lu(1408) = - lu(257) * lu(1404) + lu(1413) = lu(1413) - lu(258) * lu(1404) + lu(1426) = lu(1426) - lu(259) * lu(1404) + lu(1427) = lu(1427) - lu(260) * lu(1404) + lu(1428) = lu(1428) - lu(261) * lu(1404) + lu(1430) = lu(1430) - lu(262) * lu(1404) + lu(263) = 1._r8 / lu(263) + lu(264) = lu(264) * lu(263) + lu(265) = lu(265) * lu(263) + lu(266) = lu(266) * lu(263) + lu(967) = - lu(264) * lu(934) + lu(975) = lu(975) - lu(265) * lu(934) + lu(979) = lu(979) - lu(266) * lu(934) + lu(1171) = lu(1171) - lu(264) * lu(1127) + lu(1179) = lu(1179) - lu(265) * lu(1127) + lu(1183) = lu(1183) - lu(266) * lu(1127) + lu(1214) = - lu(264) * lu(1191) + lu(1222) = lu(1222) - lu(265) * lu(1191) + lu(1226) = lu(1226) - lu(266) * lu(1191) + lu(1236) = lu(1236) - lu(264) * lu(1232) + lu(1243) = lu(1243) - lu(265) * lu(1232) + lu(1247) = lu(1247) - lu(266) * lu(1232) + lu(1325) = lu(1325) - lu(264) * lu(1287) + lu(1333) = lu(1333) - lu(265) * lu(1287) + lu(1337) = lu(1337) - lu(266) * lu(1287) + lu(1418) = lu(1418) - lu(264) * lu(1405) + lu(1426) = lu(1426) - lu(265) * lu(1405) + lu(1430) = lu(1430) - lu(266) * lu(1405) + lu(267) = 1._r8 / lu(267) + lu(268) = lu(268) * lu(267) + lu(269) = lu(269) * lu(267) + lu(270) = lu(270) * lu(267) + lu(506) = lu(506) - lu(268) * lu(500) + lu(507) = lu(507) - lu(269) * lu(500) + lu(508) = lu(508) - lu(270) * lu(500) + lu(633) = lu(633) - lu(268) * lu(624) + lu(634) = lu(634) - lu(269) * lu(624) + lu(635) = lu(635) - lu(270) * lu(624) + lu(691) = lu(691) - lu(268) * lu(678) + lu(692) = lu(692) - lu(269) * lu(678) + lu(694) = lu(694) - lu(270) * lu(678) + lu(717) = lu(717) - lu(268) * lu(697) + lu(719) = lu(719) - lu(269) * lu(697) + lu(721) = lu(721) - lu(270) * lu(697) + lu(739) = lu(739) - lu(268) * lu(724) + lu(740) = lu(740) - lu(269) * lu(724) + lu(742) = lu(742) - lu(270) * lu(724) + lu(1056) = lu(1056) - lu(268) * lu(1028) + lu(1058) = lu(1058) - lu(269) * lu(1028) + lu(1060) = lu(1060) - lu(270) * lu(1028) + lu(1179) = lu(1179) - lu(268) * lu(1128) + lu(1181) = lu(1181) - lu(269) * lu(1128) + lu(1183) = lu(1183) - lu(270) * lu(1128) + lu(271) = 1._r8 / lu(271) + lu(272) = lu(272) * lu(271) + lu(273) = lu(273) * lu(271) + lu(274) = lu(274) * lu(271) + lu(275) = lu(275) * lu(271) + lu(276) = lu(276) * lu(271) + lu(277) = lu(277) * lu(271) + lu(278) = lu(278) * lu(271) + lu(815) = lu(815) - lu(272) * lu(814) + lu(816) = lu(816) - lu(273) * lu(814) + lu(819) = - lu(274) * lu(814) + lu(821) = lu(821) - lu(275) * lu(814) + lu(823) = - lu(276) * lu(814) + lu(827) = lu(827) - lu(277) * lu(814) + lu(829) = lu(829) - lu(278) * lu(814) + lu(1374) = - lu(272) * lu(1370) + lu(1382) = lu(1382) - lu(273) * lu(1370) + lu(1385) = lu(1385) - lu(274) * lu(1370) + lu(1387) = - lu(275) * lu(1370) + lu(1389) = lu(1389) - lu(276) * lu(1370) + lu(1398) = lu(1398) - lu(277) * lu(1370) + lu(1400) = lu(1400) - lu(278) * lu(1370) + lu(1443) = lu(1443) - lu(272) * lu(1439) + lu(1453) = lu(1453) - lu(273) * lu(1439) + lu(1456) = - lu(274) * lu(1439) + lu(1458) = lu(1458) - lu(275) * lu(1439) + lu(1460) = lu(1460) - lu(276) * lu(1439) + lu(1469) = lu(1469) - lu(277) * lu(1439) + lu(1471) = lu(1471) - lu(278) * lu(1439) + lu(279) = 1._r8 / lu(279) + lu(280) = lu(280) * lu(279) + lu(281) = lu(281) * lu(279) + lu(282) = lu(282) * lu(279) + lu(283) = lu(283) * lu(279) + lu(284) = lu(284) * lu(279) + lu(285) = lu(285) * lu(279) + lu(286) = lu(286) * lu(279) + lu(768) = - lu(280) * lu(766) + lu(770) = lu(770) - lu(281) * lu(766) + lu(776) = lu(776) - lu(282) * lu(766) + lu(778) = lu(778) - lu(283) * lu(766) + lu(780) = lu(780) - lu(284) * lu(766) + lu(782) = lu(782) - lu(285) * lu(766) + lu(783) = lu(783) - lu(286) * lu(766) + lu(1159) = lu(1159) - lu(280) * lu(1129) + lu(1167) = lu(1167) - lu(281) * lu(1129) + lu(1176) = lu(1176) - lu(282) * lu(1129) + lu(1179) = lu(1179) - lu(283) * lu(1129) + lu(1181) = lu(1181) - lu(284) * lu(1129) + lu(1183) = lu(1183) - lu(285) * lu(1129) + lu(1185) = lu(1185) - lu(286) * lu(1129) + lu(1378) = - lu(280) * lu(1371) + lu(1380) = lu(1380) - lu(281) * lu(1371) + lu(1389) = lu(1389) - lu(282) * lu(1371) + lu(1392) = lu(1392) - lu(283) * lu(1371) + lu(1394) = lu(1394) - lu(284) * lu(1371) + lu(1396) = lu(1396) - lu(285) * lu(1371) + lu(1398) = lu(1398) - lu(286) * lu(1371) + lu(287) = 1._r8 / lu(287) + lu(288) = lu(288) * lu(287) + lu(289) = lu(289) * lu(287) + lu(290) = lu(290) * lu(287) + lu(291) = lu(291) * lu(287) + lu(292) = lu(292) * lu(287) + lu(293) = lu(293) * lu(287) + lu(294) = lu(294) * lu(287) + lu(467) = lu(467) - lu(288) * lu(466) + lu(468) = lu(468) - lu(289) * lu(466) + lu(469) = - lu(290) * lu(466) + lu(471) = - lu(291) * lu(466) + lu(473) = - lu(292) * lu(466) + lu(474) = lu(474) - lu(293) * lu(466) + lu(475) = lu(475) - lu(294) * lu(466) + lu(1144) = lu(1144) - lu(288) * lu(1130) + lu(1157) = lu(1157) - lu(289) * lu(1130) + lu(1159) = lu(1159) - lu(290) * lu(1130) + lu(1171) = lu(1171) - lu(291) * lu(1130) + lu(1179) = lu(1179) - lu(292) * lu(1130) + lu(1181) = lu(1181) - lu(293) * lu(1130) + lu(1183) = lu(1183) - lu(294) * lu(1130) + lu(1302) = lu(1302) - lu(288) * lu(1288) + lu(1311) = lu(1311) - lu(289) * lu(1288) + lu(1313) = - lu(290) * lu(1288) + lu(1325) = lu(1325) - lu(291) * lu(1288) + lu(1333) = lu(1333) - lu(292) * lu(1288) + lu(1335) = lu(1335) - lu(293) * lu(1288) + lu(1337) = lu(1337) - lu(294) * lu(1288) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(295) = 1._r8 / lu(295) + lu(296) = lu(296) * lu(295) + lu(297) = lu(297) * lu(295) + lu(298) = lu(298) * lu(295) + lu(299) = lu(299) * lu(295) + lu(300) = lu(300) * lu(295) + lu(301) = lu(301) * lu(295) + lu(302) = lu(302) * lu(295) + lu(704) = lu(704) - lu(296) * lu(698) + lu(706) = lu(706) - lu(297) * lu(698) + lu(707) = lu(707) - lu(298) * lu(698) + lu(709) = lu(709) - lu(299) * lu(698) + lu(717) = lu(717) - lu(300) * lu(698) + lu(719) = lu(719) - lu(301) * lu(698) + lu(721) = lu(721) - lu(302) * lu(698) + lu(1160) = lu(1160) - lu(296) * lu(1131) + lu(1163) = lu(1163) - lu(297) * lu(1131) + lu(1164) = lu(1164) - lu(298) * lu(1131) + lu(1166) = lu(1166) - lu(299) * lu(1131) + lu(1179) = lu(1179) - lu(300) * lu(1131) + lu(1181) = lu(1181) - lu(301) * lu(1131) + lu(1183) = lu(1183) - lu(302) * lu(1131) + lu(1314) = lu(1314) - lu(296) * lu(1289) + lu(1317) = lu(1317) - lu(297) * lu(1289) + lu(1318) = lu(1318) - lu(298) * lu(1289) + lu(1320) = lu(1320) - lu(299) * lu(1289) + lu(1333) = lu(1333) - lu(300) * lu(1289) + lu(1335) = lu(1335) - lu(301) * lu(1289) + lu(1337) = lu(1337) - lu(302) * lu(1289) + lu(304) = 1._r8 / lu(304) + lu(305) = lu(305) * lu(304) + lu(306) = lu(306) * lu(304) + lu(307) = lu(307) * lu(304) + lu(308) = lu(308) * lu(304) + lu(309) = lu(309) * lu(304) + lu(310) = lu(310) * lu(304) + lu(311) = lu(311) * lu(304) + lu(936) = lu(936) - lu(305) * lu(935) + lu(940) = lu(940) - lu(306) * lu(935) + lu(958) = lu(958) - lu(307) * lu(935) + lu(971) = lu(971) - lu(308) * lu(935) + lu(975) = lu(975) - lu(309) * lu(935) + lu(979) = lu(979) - lu(310) * lu(935) + lu(981) = lu(981) - lu(311) * lu(935) + lu(1133) = lu(1133) - lu(305) * lu(1132) + lu(1141) = lu(1141) - lu(306) * lu(1132) + lu(1162) = lu(1162) - lu(307) * lu(1132) + lu(1175) = lu(1175) - lu(308) * lu(1132) + lu(1179) = lu(1179) - lu(309) * lu(1132) + lu(1183) = lu(1183) - lu(310) * lu(1132) + lu(1185) = lu(1185) - lu(311) * lu(1132) + lu(1291) = lu(1291) - lu(305) * lu(1290) + lu(1298) = lu(1298) - lu(306) * lu(1290) + lu(1316) = lu(1316) - lu(307) * lu(1290) + lu(1329) = lu(1329) - lu(308) * lu(1290) + lu(1333) = lu(1333) - lu(309) * lu(1290) + lu(1337) = lu(1337) - lu(310) * lu(1290) + lu(1339) = lu(1339) - lu(311) * lu(1290) + lu(312) = 1._r8 / lu(312) + lu(313) = lu(313) * lu(312) + lu(314) = lu(314) * lu(312) + lu(315) = lu(315) * lu(312) + lu(316) = lu(316) * lu(312) + lu(317) = lu(317) * lu(312) + lu(940) = lu(940) - lu(313) * lu(936) + lu(953) = lu(953) - lu(314) * lu(936) + lu(958) = lu(958) - lu(315) * lu(936) + lu(964) = lu(964) - lu(316) * lu(936) + lu(979) = lu(979) - lu(317) * lu(936) + lu(1141) = lu(1141) - lu(313) * lu(1133) + lu(1156) = lu(1156) - lu(314) * lu(1133) + lu(1162) = lu(1162) - lu(315) * lu(1133) + lu(1168) = lu(1168) - lu(316) * lu(1133) + lu(1183) = lu(1183) - lu(317) * lu(1133) + lu(1298) = lu(1298) - lu(313) * lu(1291) + lu(1310) = - lu(314) * lu(1291) + lu(1316) = lu(1316) - lu(315) * lu(1291) + lu(1322) = lu(1322) - lu(316) * lu(1291) + lu(1337) = lu(1337) - lu(317) * lu(1291) + lu(1373) = - lu(313) * lu(1372) + lu(1377) = - lu(314) * lu(1372) + lu(1379) = - lu(315) * lu(1372) + lu(1381) = lu(1381) - lu(316) * lu(1372) + lu(1396) = lu(1396) - lu(317) * lu(1372) + lu(318) = 1._r8 / lu(318) + lu(319) = lu(319) * lu(318) + lu(320) = lu(320) * lu(318) + lu(321) = lu(321) * lu(318) + lu(322) = lu(322) * lu(318) + lu(323) = lu(323) * lu(318) + lu(324) = lu(324) * lu(318) + lu(325) = lu(325) * lu(318) + lu(326) = lu(326) * lu(318) + lu(995) = lu(995) - lu(319) * lu(989) + lu(1001) = lu(1001) - lu(320) * lu(989) + lu(1006) = lu(1006) - lu(321) * lu(989) + lu(1013) = lu(1013) - lu(322) * lu(989) + lu(1016) = lu(1016) - lu(323) * lu(989) + lu(1017) = - lu(324) * lu(989) + lu(1020) = lu(1020) - lu(325) * lu(989) + lu(1022) = lu(1022) - lu(326) * lu(989) + lu(1153) = lu(1153) - lu(319) * lu(1134) + lu(1160) = lu(1160) - lu(320) * lu(1134) + lu(1166) = lu(1166) - lu(321) * lu(1134) + lu(1176) = lu(1176) - lu(322) * lu(1134) + lu(1179) = lu(1179) - lu(323) * lu(1134) + lu(1180) = lu(1180) - lu(324) * lu(1134) + lu(1183) = lu(1183) - lu(325) * lu(1134) + lu(1185) = lu(1185) - lu(326) * lu(1134) + lu(1198) = - lu(319) * lu(1192) + lu(1204) = lu(1204) - lu(320) * lu(1192) + lu(1209) = lu(1209) - lu(321) * lu(1192) + lu(1219) = lu(1219) - lu(322) * lu(1192) + lu(1222) = lu(1222) - lu(323) * lu(1192) + lu(1223) = lu(1223) - lu(324) * lu(1192) + lu(1226) = lu(1226) - lu(325) * lu(1192) + lu(1228) = lu(1228) - lu(326) * lu(1192) + lu(327) = 1._r8 / lu(327) + lu(328) = lu(328) * lu(327) + lu(329) = lu(329) * lu(327) + lu(330) = lu(330) * lu(327) + lu(542) = - lu(328) * lu(532) + lu(545) = - lu(329) * lu(532) + lu(546) = lu(546) - lu(330) * lu(532) + lu(600) = - lu(328) * lu(592) + lu(603) = lu(603) - lu(329) * lu(592) + lu(604) = lu(604) - lu(330) * lu(592) + lu(773) = lu(773) - lu(328) * lu(767) + lu(777) = lu(777) - lu(329) * lu(767) + lu(778) = lu(778) - lu(330) * lu(767) + lu(801) = lu(801) - lu(328) * lu(787) + lu(805) = lu(805) - lu(329) * lu(787) + lu(806) = lu(806) - lu(330) * lu(787) + lu(1048) = lu(1048) - lu(328) * lu(1029) + lu(1054) = lu(1054) - lu(329) * lu(1029) + lu(1056) = lu(1056) - lu(330) * lu(1029) + lu(1171) = lu(1171) - lu(328) * lu(1135) + lu(1177) = lu(1177) - lu(329) * lu(1135) + lu(1179) = lu(1179) - lu(330) * lu(1135) + lu(1214) = lu(1214) - lu(328) * lu(1193) + lu(1220) = lu(1220) - lu(329) * lu(1193) + lu(1222) = lu(1222) - lu(330) * lu(1193) + lu(1325) = lu(1325) - lu(328) * lu(1292) + lu(1331) = lu(1331) - lu(329) * lu(1292) + lu(1333) = lu(1333) - lu(330) * lu(1292) + lu(331) = 1._r8 / lu(331) + lu(332) = lu(332) * lu(331) + lu(333) = lu(333) * lu(331) + lu(334) = lu(334) * lu(331) + lu(335) = lu(335) * lu(331) + lu(336) = lu(336) * lu(331) + lu(337) = lu(337) * lu(331) + lu(367) = lu(367) - lu(332) * lu(365) + lu(368) = lu(368) - lu(333) * lu(365) + lu(370) = lu(370) - lu(334) * lu(365) + lu(371) = - lu(335) * lu(365) + lu(372) = lu(372) - lu(336) * lu(365) + lu(375) = lu(375) - lu(337) * lu(365) + lu(486) = lu(486) - lu(332) * lu(485) + lu(487) = lu(487) - lu(333) * lu(485) + lu(489) = lu(489) - lu(334) * lu(485) + lu(490) = - lu(335) * lu(485) + lu(491) = lu(491) - lu(336) * lu(485) + lu(497) = lu(497) - lu(337) * lu(485) + lu(837) = lu(837) - lu(332) * lu(835) + lu(838) = lu(838) - lu(333) * lu(835) + lu(840) = lu(840) - lu(334) * lu(835) + lu(842) = - lu(335) * lu(835) + lu(843) = lu(843) - lu(336) * lu(835) + lu(852) = lu(852) - lu(337) * lu(835) + lu(1444) = lu(1444) - lu(332) * lu(1440) + lu(1445) = lu(1445) - lu(333) * lu(1440) + lu(1448) = lu(1448) - lu(334) * lu(1440) + lu(1451) = lu(1451) - lu(335) * lu(1440) + lu(1454) = lu(1454) - lu(336) * lu(1440) + lu(1471) = lu(1471) - lu(337) * lu(1440) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(338) = 1._r8 / lu(338) + lu(339) = lu(339) * lu(338) + lu(340) = lu(340) * lu(338) + lu(341) = lu(341) * lu(338) + lu(342) = lu(342) * lu(338) + lu(343) = lu(343) * lu(338) + lu(344) = lu(344) * lu(338) + lu(1171) = lu(1171) - lu(339) * lu(1136) + lu(1178) = lu(1178) - lu(340) * lu(1136) + lu(1179) = lu(1179) - lu(341) * lu(1136) + lu(1183) = lu(1183) - lu(342) * lu(1136) + lu(1186) = lu(1186) - lu(343) * lu(1136) + lu(1187) = lu(1187) - lu(344) * lu(1136) + lu(1325) = lu(1325) - lu(339) * lu(1293) + lu(1332) = lu(1332) - lu(340) * lu(1293) + lu(1333) = lu(1333) - lu(341) * lu(1293) + lu(1337) = lu(1337) - lu(342) * lu(1293) + lu(1340) = lu(1340) - lu(343) * lu(1293) + lu(1341) = lu(1341) - lu(344) * lu(1293) + lu(1418) = lu(1418) - lu(339) * lu(1406) + lu(1425) = lu(1425) - lu(340) * lu(1406) + lu(1426) = lu(1426) - lu(341) * lu(1406) + lu(1430) = lu(1430) - lu(342) * lu(1406) + lu(1433) = lu(1433) - lu(343) * lu(1406) + lu(1434) = - lu(344) * lu(1406) + lu(1455) = - lu(339) * lu(1441) + lu(1462) = lu(1462) - lu(340) * lu(1441) + lu(1463) = lu(1463) - lu(341) * lu(1441) + lu(1467) = lu(1467) - lu(342) * lu(1441) + lu(1470) = lu(1470) - lu(343) * lu(1441) + lu(1471) = lu(1471) - lu(344) * lu(1441) + lu(346) = 1._r8 / lu(346) + lu(347) = lu(347) * lu(346) + lu(348) = lu(348) * lu(346) + lu(349) = lu(349) * lu(346) + lu(350) = lu(350) * lu(346) + lu(351) = lu(351) * lu(346) + lu(352) = lu(352) * lu(346) + lu(353) = lu(353) * lu(346) + lu(354) = lu(354) * lu(346) + lu(355) = lu(355) * lu(346) + lu(379) = lu(379) - lu(347) * lu(378) + lu(380) = lu(380) - lu(348) * lu(378) + lu(381) = lu(381) - lu(349) * lu(378) + lu(382) = lu(382) - lu(350) * lu(378) + lu(383) = lu(383) - lu(351) * lu(378) + lu(385) = lu(385) - lu(352) * lu(378) + lu(387) = lu(387) - lu(353) * lu(378) + lu(388) = lu(388) - lu(354) * lu(378) + lu(389) = lu(389) - lu(355) * lu(378) + lu(1138) = lu(1138) - lu(347) * lu(1137) + lu(1139) = lu(1139) - lu(348) * lu(1137) + lu(1140) = lu(1140) - lu(349) * lu(1137) + lu(1147) = lu(1147) - lu(350) * lu(1137) + lu(1157) = lu(1157) - lu(351) * lu(1137) + lu(1168) = lu(1168) - lu(352) * lu(1137) + lu(1179) = lu(1179) - lu(353) * lu(1137) + lu(1181) = lu(1181) - lu(354) * lu(1137) + lu(1183) = lu(1183) - lu(355) * lu(1137) + lu(1295) = lu(1295) - lu(347) * lu(1294) + lu(1296) = lu(1296) - lu(348) * lu(1294) + lu(1297) = lu(1297) - lu(349) * lu(1294) + lu(1304) = lu(1304) - lu(350) * lu(1294) + lu(1311) = lu(1311) - lu(351) * lu(1294) + lu(1322) = lu(1322) - lu(352) * lu(1294) + lu(1333) = lu(1333) - lu(353) * lu(1294) + lu(1335) = lu(1335) - lu(354) * lu(1294) + lu(1337) = lu(1337) - lu(355) * lu(1294) + lu(357) = 1._r8 / lu(357) + lu(358) = lu(358) * lu(357) + lu(359) = lu(359) * lu(357) + lu(360) = lu(360) * lu(357) + lu(361) = lu(361) * lu(357) + lu(362) = lu(362) * lu(357) + lu(363) = lu(363) * lu(357) + lu(383) = lu(383) - lu(358) * lu(379) + lu(385) = lu(385) - lu(359) * lu(379) + lu(386) = lu(386) - lu(360) * lu(379) + lu(387) = lu(387) - lu(361) * lu(379) + lu(389) = lu(389) - lu(362) * lu(379) + lu(390) = lu(390) - lu(363) * lu(379) + lu(954) = lu(954) - lu(358) * lu(937) + lu(964) = lu(964) - lu(359) * lu(937) + lu(971) = lu(971) - lu(360) * lu(937) + lu(975) = lu(975) - lu(361) * lu(937) + lu(979) = lu(979) - lu(362) * lu(937) + lu(981) = lu(981) - lu(363) * lu(937) + lu(1157) = lu(1157) - lu(358) * lu(1138) + lu(1168) = lu(1168) - lu(359) * lu(1138) + lu(1175) = lu(1175) - lu(360) * lu(1138) + lu(1179) = lu(1179) - lu(361) * lu(1138) + lu(1183) = lu(1183) - lu(362) * lu(1138) + lu(1185) = lu(1185) - lu(363) * lu(1138) + lu(1311) = lu(1311) - lu(358) * lu(1295) + lu(1322) = lu(1322) - lu(359) * lu(1295) + lu(1329) = lu(1329) - lu(360) * lu(1295) + lu(1333) = lu(1333) - lu(361) * lu(1295) + lu(1337) = lu(1337) - lu(362) * lu(1295) + lu(1339) = lu(1339) - lu(363) * lu(1295) + lu(366) = 1._r8 / lu(366) + lu(367) = lu(367) * lu(366) + lu(368) = lu(368) * lu(366) + lu(369) = lu(369) * lu(366) + lu(370) = lu(370) * lu(366) + lu(371) = lu(371) * lu(366) + lu(372) = lu(372) * lu(366) + lu(373) = lu(373) * lu(366) + lu(374) = lu(374) * lu(366) + lu(375) = lu(375) * lu(366) + lu(438) = lu(438) - lu(367) * lu(437) + lu(439) = lu(439) - lu(368) * lu(437) + lu(440) = lu(440) - lu(369) * lu(437) + lu(441) = lu(441) - lu(370) * lu(437) + lu(442) = - lu(371) * lu(437) + lu(443) = lu(443) - lu(372) * lu(437) + lu(444) = lu(444) - lu(373) * lu(437) + lu(445) = lu(445) - lu(374) * lu(437) + lu(446) = lu(446) - lu(375) * lu(437) + lu(837) = lu(837) - lu(367) * lu(836) + lu(838) = lu(838) - lu(368) * lu(836) + lu(839) = lu(839) - lu(369) * lu(836) + lu(840) = lu(840) - lu(370) * lu(836) + lu(842) = lu(842) - lu(371) * lu(836) + lu(843) = lu(843) - lu(372) * lu(836) + lu(844) = lu(844) - lu(373) * lu(836) + lu(850) = lu(850) - lu(374) * lu(836) + lu(852) = lu(852) - lu(375) * lu(836) + lu(1444) = lu(1444) - lu(367) * lu(1442) + lu(1445) = lu(1445) - lu(368) * lu(1442) + lu(1446) = lu(1446) - lu(369) * lu(1442) + lu(1448) = lu(1448) - lu(370) * lu(1442) + lu(1451) = lu(1451) - lu(371) * lu(1442) + lu(1454) = lu(1454) - lu(372) * lu(1442) + lu(1459) = lu(1459) - lu(373) * lu(1442) + lu(1468) = lu(1468) - lu(374) * lu(1442) + lu(1471) = lu(1471) - lu(375) * lu(1442) + lu(380) = 1._r8 / lu(380) + lu(381) = lu(381) * lu(380) + lu(382) = lu(382) * lu(380) + lu(383) = lu(383) * lu(380) + lu(384) = lu(384) * lu(380) + lu(385) = lu(385) * lu(380) + lu(386) = lu(386) * lu(380) + lu(387) = lu(387) * lu(380) + lu(388) = lu(388) * lu(380) + lu(389) = lu(389) * lu(380) + lu(390) = lu(390) * lu(380) + lu(939) = lu(939) - lu(381) * lu(938) + lu(948) = lu(948) - lu(382) * lu(938) + lu(954) = lu(954) - lu(383) * lu(938) + lu(958) = lu(958) - lu(384) * lu(938) + lu(964) = lu(964) - lu(385) * lu(938) + lu(971) = lu(971) - lu(386) * lu(938) + lu(975) = lu(975) - lu(387) * lu(938) + lu(977) = lu(977) - lu(388) * lu(938) + lu(979) = lu(979) - lu(389) * lu(938) + lu(981) = lu(981) - lu(390) * lu(938) + lu(1140) = lu(1140) - lu(381) * lu(1139) + lu(1147) = lu(1147) - lu(382) * lu(1139) + lu(1157) = lu(1157) - lu(383) * lu(1139) + lu(1162) = lu(1162) - lu(384) * lu(1139) + lu(1168) = lu(1168) - lu(385) * lu(1139) + lu(1175) = lu(1175) - lu(386) * lu(1139) + lu(1179) = lu(1179) - lu(387) * lu(1139) + lu(1181) = lu(1181) - lu(388) * lu(1139) + lu(1183) = lu(1183) - lu(389) * lu(1139) + lu(1185) = lu(1185) - lu(390) * lu(1139) + lu(1297) = lu(1297) - lu(381) * lu(1296) + lu(1304) = lu(1304) - lu(382) * lu(1296) + lu(1311) = lu(1311) - lu(383) * lu(1296) + lu(1316) = lu(1316) - lu(384) * lu(1296) + lu(1322) = lu(1322) - lu(385) * lu(1296) + lu(1329) = lu(1329) - lu(386) * lu(1296) + lu(1333) = lu(1333) - lu(387) * lu(1296) + lu(1335) = lu(1335) - lu(388) * lu(1296) + lu(1337) = lu(1337) - lu(389) * lu(1296) + lu(1339) = lu(1339) - lu(390) * lu(1296) + lu(391) = 1._r8 / lu(391) + lu(392) = lu(392) * lu(391) + lu(393) = lu(393) * lu(391) + lu(394) = lu(394) * lu(391) + lu(395) = lu(395) * lu(391) + lu(396) = lu(396) * lu(391) + lu(522) = - lu(392) * lu(519) + lu(523) = - lu(393) * lu(519) + lu(525) = lu(525) - lu(394) * lu(519) + lu(527) = lu(527) - lu(395) * lu(519) + lu(528) = lu(528) - lu(396) * lu(519) + lu(569) = - lu(392) * lu(567) + lu(572) = - lu(393) * lu(567) + lu(573) = - lu(394) * lu(567) + lu(575) = - lu(395) * lu(567) + lu(576) = lu(576) - lu(396) * lu(567) + lu(955) = lu(955) - lu(392) * lu(939) + lu(964) = lu(964) - lu(393) * lu(939) + lu(967) = lu(967) - lu(394) * lu(939) + lu(973) = lu(973) - lu(395) * lu(939) + lu(975) = lu(975) - lu(396) * lu(939) + lu(1037) = lu(1037) - lu(392) * lu(1030) + lu(1046) = lu(1046) - lu(393) * lu(1030) + lu(1048) = lu(1048) - lu(394) * lu(1030) + lu(1054) = lu(1054) - lu(395) * lu(1030) + lu(1056) = lu(1056) - lu(396) * lu(1030) + lu(1158) = lu(1158) - lu(392) * lu(1140) + lu(1168) = lu(1168) - lu(393) * lu(1140) + lu(1171) = lu(1171) - lu(394) * lu(1140) + lu(1177) = lu(1177) - lu(395) * lu(1140) + lu(1179) = lu(1179) - lu(396) * lu(1140) + lu(1312) = lu(1312) - lu(392) * lu(1297) + lu(1322) = lu(1322) - lu(393) * lu(1297) + lu(1325) = lu(1325) - lu(394) * lu(1297) + lu(1331) = lu(1331) - lu(395) * lu(1297) + lu(1333) = lu(1333) - lu(396) * lu(1297) + end subroutine lu_fac09 + subroutine lu_fac10( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(397) = 1._r8 / lu(397) + lu(398) = lu(398) * lu(397) + lu(399) = lu(399) * lu(397) + lu(400) = lu(400) * lu(397) + lu(553) = lu(553) - lu(398) * lu(551) + lu(554) = lu(554) - lu(399) * lu(551) + lu(556) = lu(556) - lu(400) * lu(551) + lu(681) = lu(681) - lu(398) * lu(679) + lu(691) = lu(691) - lu(399) * lu(679) + lu(694) = lu(694) - lu(400) * lu(679) + lu(702) = - lu(398) * lu(699) + lu(717) = lu(717) - lu(399) * lu(699) + lu(721) = lu(721) - lu(400) * lu(699) + lu(790) = lu(790) - lu(398) * lu(788) + lu(806) = lu(806) - lu(399) * lu(788) + lu(810) = lu(810) - lu(400) * lu(788) + lu(953) = lu(953) - lu(398) * lu(940) + lu(975) = lu(975) - lu(399) * lu(940) + lu(979) = lu(979) - lu(400) * lu(940) + lu(997) = lu(997) - lu(398) * lu(990) + lu(1016) = lu(1016) - lu(399) * lu(990) + lu(1020) = lu(1020) - lu(400) * lu(990) + lu(1035) = lu(1035) - lu(398) * lu(1031) + lu(1056) = lu(1056) - lu(399) * lu(1031) + lu(1060) = lu(1060) - lu(400) * lu(1031) + lu(1156) = lu(1156) - lu(398) * lu(1141) + lu(1179) = lu(1179) - lu(399) * lu(1141) + lu(1183) = lu(1183) - lu(400) * lu(1141) + lu(1310) = lu(1310) - lu(398) * lu(1298) + lu(1333) = lu(1333) - lu(399) * lu(1298) + lu(1337) = lu(1337) - lu(400) * lu(1298) + lu(1377) = lu(1377) - lu(398) * lu(1373) + lu(1392) = lu(1392) - lu(399) * lu(1373) + lu(1396) = lu(1396) - lu(400) * lu(1373) + lu(1413) = lu(1413) - lu(398) * lu(1407) + lu(1426) = lu(1426) - lu(399) * lu(1407) + lu(1430) = lu(1430) - lu(400) * lu(1407) + lu(402) = 1._r8 / lu(402) + lu(403) = lu(403) * lu(402) + lu(404) = lu(404) * lu(402) + lu(405) = lu(405) * lu(402) + lu(406) = lu(406) * lu(402) + lu(407) = lu(407) * lu(402) + lu(408) = lu(408) * lu(402) + lu(409) = lu(409) * lu(402) + lu(816) = lu(816) - lu(403) * lu(815) + lu(818) = - lu(404) * lu(815) + lu(821) = lu(821) - lu(405) * lu(815) + lu(824) = - lu(406) * lu(815) + lu(825) = lu(825) - lu(407) * lu(815) + lu(828) = lu(828) - lu(408) * lu(815) + lu(829) = lu(829) - lu(409) * lu(815) + lu(1070) = - lu(403) * lu(1067) + lu(1072) = lu(1072) - lu(404) * lu(1067) + lu(1075) = lu(1075) - lu(405) * lu(1067) + lu(1079) = lu(1079) - lu(406) * lu(1067) + lu(1080) = lu(1080) - lu(407) * lu(1067) + lu(1087) = lu(1087) - lu(408) * lu(1067) + lu(1088) = lu(1088) - lu(409) * lu(1067) + lu(1323) = lu(1323) - lu(403) * lu(1299) + lu(1325) = lu(1325) - lu(404) * lu(1299) + lu(1328) = lu(1328) - lu(405) * lu(1299) + lu(1332) = lu(1332) - lu(406) * lu(1299) + lu(1333) = lu(1333) - lu(407) * lu(1299) + lu(1340) = lu(1340) - lu(408) * lu(1299) + lu(1341) = lu(1341) - lu(409) * lu(1299) + lu(1382) = lu(1382) - lu(403) * lu(1374) + lu(1384) = lu(1384) - lu(404) * lu(1374) + lu(1387) = lu(1387) - lu(405) * lu(1374) + lu(1391) = - lu(406) * lu(1374) + lu(1392) = lu(1392) - lu(407) * lu(1374) + lu(1399) = - lu(408) * lu(1374) + lu(1400) = lu(1400) - lu(409) * lu(1374) + lu(1453) = lu(1453) - lu(403) * lu(1443) + lu(1455) = lu(1455) - lu(404) * lu(1443) + lu(1458) = lu(1458) - lu(405) * lu(1443) + lu(1462) = lu(1462) - lu(406) * lu(1443) + lu(1463) = lu(1463) - lu(407) * lu(1443) + lu(1470) = lu(1470) - lu(408) * lu(1443) + lu(1471) = lu(1471) - lu(409) * lu(1443) + lu(412) = 1._r8 / lu(412) + lu(413) = lu(413) * lu(412) + lu(414) = lu(414) * lu(412) + lu(415) = lu(415) * lu(412) + lu(416) = lu(416) * lu(412) + lu(417) = lu(417) * lu(412) + lu(418) = lu(418) * lu(412) + lu(419) = lu(419) * lu(412) + lu(950) = lu(950) - lu(413) * lu(941) + lu(966) = lu(966) - lu(414) * lu(941) + lu(971) = lu(971) - lu(415) * lu(941) + lu(975) = lu(975) - lu(416) * lu(941) + lu(977) = lu(977) - lu(417) * lu(941) + lu(979) = lu(979) - lu(418) * lu(941) + lu(981) = lu(981) - lu(419) * lu(941) + lu(1151) = lu(1151) - lu(413) * lu(1142) + lu(1170) = lu(1170) - lu(414) * lu(1142) + lu(1175) = lu(1175) - lu(415) * lu(1142) + lu(1179) = lu(1179) - lu(416) * lu(1142) + lu(1181) = lu(1181) - lu(417) * lu(1142) + lu(1183) = lu(1183) - lu(418) * lu(1142) + lu(1185) = lu(1185) - lu(419) * lu(1142) + lu(1196) = - lu(413) * lu(1194) + lu(1213) = lu(1213) - lu(414) * lu(1194) + lu(1218) = lu(1218) - lu(415) * lu(1194) + lu(1222) = lu(1222) - lu(416) * lu(1194) + lu(1224) = lu(1224) - lu(417) * lu(1194) + lu(1226) = lu(1226) - lu(418) * lu(1194) + lu(1228) = lu(1228) - lu(419) * lu(1194) + lu(1307) = lu(1307) - lu(413) * lu(1300) + lu(1324) = lu(1324) - lu(414) * lu(1300) + lu(1329) = lu(1329) - lu(415) * lu(1300) + lu(1333) = lu(1333) - lu(416) * lu(1300) + lu(1335) = lu(1335) - lu(417) * lu(1300) + lu(1337) = lu(1337) - lu(418) * lu(1300) + lu(1339) = lu(1339) - lu(419) * lu(1300) + lu(1411) = - lu(413) * lu(1408) + lu(1417) = lu(1417) - lu(414) * lu(1408) + lu(1422) = - lu(415) * lu(1408) + lu(1426) = lu(1426) - lu(416) * lu(1408) + lu(1428) = lu(1428) - lu(417) * lu(1408) + lu(1430) = lu(1430) - lu(418) * lu(1408) + lu(1432) = - lu(419) * lu(1408) + lu(420) = 1._r8 / lu(420) + lu(421) = lu(421) * lu(420) + lu(422) = lu(422) * lu(420) + lu(423) = lu(423) * lu(420) + lu(424) = lu(424) * lu(420) + lu(425) = lu(425) * lu(420) + lu(426) = lu(426) * lu(420) + lu(427) = lu(427) * lu(420) + lu(439) = lu(439) - lu(421) * lu(438) + lu(440) = lu(440) - lu(422) * lu(438) + lu(441) = lu(441) - lu(423) * lu(438) + lu(443) = lu(443) - lu(424) * lu(438) + lu(444) = lu(444) - lu(425) * lu(438) + lu(445) = lu(445) - lu(426) * lu(438) + lu(446) = lu(446) - lu(427) * lu(438) + lu(487) = lu(487) - lu(421) * lu(486) + lu(488) = lu(488) - lu(422) * lu(486) + lu(489) = lu(489) - lu(423) * lu(486) + lu(491) = lu(491) - lu(424) * lu(486) + lu(492) = lu(492) - lu(425) * lu(486) + lu(495) = - lu(426) * lu(486) + lu(497) = lu(497) - lu(427) * lu(486) + lu(838) = lu(838) - lu(421) * lu(837) + lu(839) = lu(839) - lu(422) * lu(837) + lu(840) = lu(840) - lu(423) * lu(837) + lu(843) = lu(843) - lu(424) * lu(837) + lu(844) = lu(844) - lu(425) * lu(837) + lu(850) = lu(850) - lu(426) * lu(837) + lu(852) = lu(852) - lu(427) * lu(837) + lu(943) = lu(943) - lu(421) * lu(942) + lu(944) = lu(944) - lu(422) * lu(942) + lu(947) = lu(947) - lu(423) * lu(942) + lu(966) = lu(966) - lu(424) * lu(942) + lu(971) = lu(971) - lu(425) * lu(942) + lu(980) = - lu(426) * lu(942) + lu(983) = lu(983) - lu(427) * lu(942) + lu(1445) = lu(1445) - lu(421) * lu(1444) + lu(1446) = lu(1446) - lu(422) * lu(1444) + lu(1448) = lu(1448) - lu(423) * lu(1444) + lu(1454) = lu(1454) - lu(424) * lu(1444) + lu(1459) = lu(1459) - lu(425) * lu(1444) + lu(1468) = lu(1468) - lu(426) * lu(1444) + lu(1471) = lu(1471) - lu(427) * lu(1444) + lu(429) = 1._r8 / lu(429) + lu(430) = lu(430) * lu(429) + lu(431) = lu(431) * lu(429) + lu(432) = lu(432) * lu(429) + lu(433) = lu(433) * lu(429) + lu(434) = lu(434) * lu(429) + lu(435) = lu(435) * lu(429) + lu(440) = lu(440) - lu(430) * lu(439) + lu(441) = lu(441) - lu(431) * lu(439) + lu(443) = lu(443) - lu(432) * lu(439) + lu(444) = lu(444) - lu(433) * lu(439) + lu(445) = lu(445) - lu(434) * lu(439) + lu(446) = lu(446) - lu(435) * lu(439) + lu(488) = lu(488) - lu(430) * lu(487) + lu(489) = lu(489) - lu(431) * lu(487) + lu(491) = lu(491) - lu(432) * lu(487) + lu(492) = lu(492) - lu(433) * lu(487) + lu(495) = lu(495) - lu(434) * lu(487) + lu(497) = lu(497) - lu(435) * lu(487) + lu(839) = lu(839) - lu(430) * lu(838) + lu(840) = lu(840) - lu(431) * lu(838) + lu(843) = lu(843) - lu(432) * lu(838) + lu(844) = lu(844) - lu(433) * lu(838) + lu(850) = lu(850) - lu(434) * lu(838) + lu(852) = lu(852) - lu(435) * lu(838) + lu(944) = lu(944) - lu(430) * lu(943) + lu(947) = lu(947) - lu(431) * lu(943) + lu(966) = lu(966) - lu(432) * lu(943) + lu(971) = lu(971) - lu(433) * lu(943) + lu(980) = lu(980) - lu(434) * lu(943) + lu(983) = lu(983) - lu(435) * lu(943) + lu(1446) = lu(1446) - lu(430) * lu(1445) + lu(1448) = lu(1448) - lu(431) * lu(1445) + lu(1454) = lu(1454) - lu(432) * lu(1445) + lu(1459) = lu(1459) - lu(433) * lu(1445) + lu(1468) = lu(1468) - lu(434) * lu(1445) + lu(1471) = lu(1471) - lu(435) * lu(1445) + lu(440) = 1._r8 / lu(440) + lu(441) = lu(441) * lu(440) + lu(442) = lu(442) * lu(440) + lu(443) = lu(443) * lu(440) + lu(444) = lu(444) * lu(440) + lu(445) = lu(445) * lu(440) + lu(446) = lu(446) * lu(440) + lu(489) = lu(489) - lu(441) * lu(488) + lu(490) = lu(490) - lu(442) * lu(488) + lu(491) = lu(491) - lu(443) * lu(488) + lu(492) = lu(492) - lu(444) * lu(488) + lu(495) = lu(495) - lu(445) * lu(488) + lu(497) = lu(497) - lu(446) * lu(488) + lu(840) = lu(840) - lu(441) * lu(839) + lu(842) = lu(842) - lu(442) * lu(839) + lu(843) = lu(843) - lu(443) * lu(839) + lu(844) = lu(844) - lu(444) * lu(839) + lu(850) = lu(850) - lu(445) * lu(839) + lu(852) = lu(852) - lu(446) * lu(839) + lu(947) = lu(947) - lu(441) * lu(944) + lu(953) = lu(953) - lu(442) * lu(944) + lu(966) = lu(966) - lu(443) * lu(944) + lu(971) = lu(971) - lu(444) * lu(944) + lu(980) = lu(980) - lu(445) * lu(944) + lu(983) = lu(983) - lu(446) * lu(944) + lu(1448) = lu(1448) - lu(441) * lu(1446) + lu(1451) = lu(1451) - lu(442) * lu(1446) + lu(1454) = lu(1454) - lu(443) * lu(1446) + lu(1459) = lu(1459) - lu(444) * lu(1446) + lu(1468) = lu(1468) - lu(445) * lu(1446) + lu(1471) = lu(1471) - lu(446) * lu(1446) + end subroutine lu_fac10 + subroutine lu_fac11( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(448) = 1._r8 / lu(448) + lu(449) = lu(449) * lu(448) + lu(450) = lu(450) * lu(448) + lu(451) = lu(451) * lu(448) + lu(452) = lu(452) * lu(448) + lu(453) = lu(453) * lu(448) + lu(454) = lu(454) * lu(448) + lu(455) = lu(455) * lu(448) + lu(657) = lu(657) - lu(449) * lu(656) + lu(658) = lu(658) - lu(450) * lu(656) + lu(659) = - lu(451) * lu(656) + lu(660) = - lu(452) * lu(656) + lu(661) = - lu(453) * lu(656) + lu(663) = lu(663) - lu(454) * lu(656) + lu(664) = lu(664) - lu(455) * lu(656) + lu(855) = lu(855) - lu(449) * lu(854) + lu(856) = lu(856) - lu(450) * lu(854) + lu(857) = - lu(451) * lu(854) + lu(858) = - lu(452) * lu(854) + lu(859) = - lu(453) * lu(854) + lu(861) = lu(861) - lu(454) * lu(854) + lu(862) = lu(862) - lu(455) * lu(854) + lu(868) = - lu(449) * lu(867) + lu(869) = lu(869) - lu(450) * lu(867) + lu(870) = lu(870) - lu(451) * lu(867) + lu(871) = lu(871) - lu(452) * lu(867) + lu(872) = - lu(453) * lu(867) + lu(874) = lu(874) - lu(454) * lu(867) + lu(875) = lu(875) - lu(455) * lu(867) + lu(1161) = lu(1161) - lu(449) * lu(1143) + lu(1171) = lu(1171) - lu(450) * lu(1143) + lu(1172) = lu(1172) - lu(451) * lu(1143) + lu(1176) = lu(1176) - lu(452) * lu(1143) + lu(1177) = lu(1177) - lu(453) * lu(1143) + lu(1179) = lu(1179) - lu(454) * lu(1143) + lu(1182) = lu(1182) - lu(455) * lu(1143) + lu(1348) = lu(1348) - lu(449) * lu(1346) + lu(1350) = lu(1350) - lu(450) * lu(1346) + lu(1351) = - lu(451) * lu(1346) + lu(1354) = - lu(452) * lu(1346) + lu(1355) = lu(1355) - lu(453) * lu(1346) + lu(1357) = lu(1357) - lu(454) * lu(1346) + lu(1360) = lu(1360) - lu(455) * lu(1346) + lu(456) = 1._r8 / lu(456) + lu(457) = lu(457) * lu(456) + lu(458) = lu(458) * lu(456) + lu(459) = lu(459) * lu(456) + lu(460) = lu(460) * lu(456) + lu(461) = lu(461) * lu(456) + lu(462) = lu(462) * lu(456) + lu(463) = lu(463) * lu(456) + lu(464) = lu(464) * lu(456) + lu(465) = lu(465) * lu(456) + lu(535) = - lu(457) * lu(533) + lu(538) = lu(538) - lu(458) * lu(533) + lu(540) = lu(540) - lu(459) * lu(533) + lu(543) = - lu(460) * lu(533) + lu(544) = lu(544) - lu(461) * lu(533) + lu(546) = lu(546) - lu(462) * lu(533) + lu(548) = lu(548) - lu(463) * lu(533) + lu(549) = lu(549) - lu(464) * lu(533) + lu(550) = - lu(465) * lu(533) + lu(951) = lu(951) - lu(457) * lu(945) + lu(957) = lu(957) - lu(458) * lu(945) + lu(962) = lu(962) - lu(459) * lu(945) + lu(971) = lu(971) - lu(460) * lu(945) + lu(972) = lu(972) - lu(461) * lu(945) + lu(975) = lu(975) - lu(462) * lu(945) + lu(977) = lu(977) - lu(463) * lu(945) + lu(979) = lu(979) - lu(464) * lu(945) + lu(981) = lu(981) - lu(465) * lu(945) + lu(994) = lu(994) - lu(457) * lu(991) + lu(1001) = lu(1001) - lu(458) * lu(991) + lu(1006) = lu(1006) - lu(459) * lu(991) + lu(1012) = lu(1012) - lu(460) * lu(991) + lu(1013) = lu(1013) - lu(461) * lu(991) + lu(1016) = lu(1016) - lu(462) * lu(991) + lu(1018) = lu(1018) - lu(463) * lu(991) + lu(1020) = lu(1020) - lu(464) * lu(991) + lu(1022) = lu(1022) - lu(465) * lu(991) + lu(1308) = lu(1308) - lu(457) * lu(1301) + lu(1314) = lu(1314) - lu(458) * lu(1301) + lu(1320) = lu(1320) - lu(459) * lu(1301) + lu(1329) = lu(1329) - lu(460) * lu(1301) + lu(1330) = lu(1330) - lu(461) * lu(1301) + lu(1333) = lu(1333) - lu(462) * lu(1301) + lu(1335) = lu(1335) - lu(463) * lu(1301) + lu(1337) = lu(1337) - lu(464) * lu(1301) + lu(1339) = lu(1339) - lu(465) * lu(1301) + lu(467) = 1._r8 / lu(467) + lu(468) = lu(468) * lu(467) + lu(469) = lu(469) * lu(467) + lu(470) = lu(470) * lu(467) + lu(471) = lu(471) * lu(467) + lu(472) = lu(472) * lu(467) + lu(473) = lu(473) * lu(467) + lu(474) = lu(474) * lu(467) + lu(475) = lu(475) * lu(467) + lu(476) = lu(476) * lu(467) + lu(596) = lu(596) - lu(468) * lu(593) + lu(597) = - lu(469) * lu(593) + lu(599) = - lu(470) * lu(593) + lu(600) = lu(600) - lu(471) * lu(593) + lu(601) = - lu(472) * lu(593) + lu(604) = lu(604) - lu(473) * lu(593) + lu(606) = lu(606) - lu(474) * lu(593) + lu(607) = lu(607) - lu(475) * lu(593) + lu(608) = lu(608) - lu(476) * lu(593) + lu(954) = lu(954) - lu(468) * lu(946) + lu(956) = lu(956) - lu(469) * lu(946) + lu(966) = lu(966) - lu(470) * lu(946) + lu(967) = lu(967) - lu(471) * lu(946) + lu(971) = lu(971) - lu(472) * lu(946) + lu(975) = lu(975) - lu(473) * lu(946) + lu(977) = lu(977) - lu(474) * lu(946) + lu(979) = lu(979) - lu(475) * lu(946) + lu(981) = lu(981) - lu(476) * lu(946) + lu(1157) = lu(1157) - lu(468) * lu(1144) + lu(1159) = lu(1159) - lu(469) * lu(1144) + lu(1170) = lu(1170) - lu(470) * lu(1144) + lu(1171) = lu(1171) - lu(471) * lu(1144) + lu(1175) = lu(1175) - lu(472) * lu(1144) + lu(1179) = lu(1179) - lu(473) * lu(1144) + lu(1181) = lu(1181) - lu(474) * lu(1144) + lu(1183) = lu(1183) - lu(475) * lu(1144) + lu(1185) = lu(1185) - lu(476) * lu(1144) + lu(1311) = lu(1311) - lu(468) * lu(1302) + lu(1313) = lu(1313) - lu(469) * lu(1302) + lu(1324) = lu(1324) - lu(470) * lu(1302) + lu(1325) = lu(1325) - lu(471) * lu(1302) + lu(1329) = lu(1329) - lu(472) * lu(1302) + lu(1333) = lu(1333) - lu(473) * lu(1302) + lu(1335) = lu(1335) - lu(474) * lu(1302) + lu(1337) = lu(1337) - lu(475) * lu(1302) + lu(1339) = lu(1339) - lu(476) * lu(1302) + lu(477) = 1._r8 / lu(477) + lu(478) = lu(478) * lu(477) + lu(479) = lu(479) * lu(477) + lu(480) = lu(480) * lu(477) + lu(481) = lu(481) * lu(477) + lu(482) = lu(482) * lu(477) + lu(483) = lu(483) * lu(477) + lu(909) = - lu(478) * lu(905) + lu(912) = lu(912) - lu(479) * lu(905) + lu(917) = - lu(480) * lu(905) + lu(920) = - lu(481) * lu(905) + lu(922) = - lu(482) * lu(905) + lu(925) = - lu(483) * lu(905) + lu(1171) = lu(1171) - lu(478) * lu(1145) + lu(1174) = lu(1174) - lu(479) * lu(1145) + lu(1179) = lu(1179) - lu(480) * lu(1145) + lu(1182) = lu(1182) - lu(481) * lu(1145) + lu(1184) = lu(1184) - lu(482) * lu(1145) + lu(1187) = lu(1187) - lu(483) * lu(1145) + lu(1236) = lu(1236) - lu(478) * lu(1233) + lu(1238) = lu(1238) - lu(479) * lu(1233) + lu(1243) = lu(1243) - lu(480) * lu(1233) + lu(1246) = lu(1246) - lu(481) * lu(1233) + lu(1248) = - lu(482) * lu(1233) + lu(1251) = lu(1251) - lu(483) * lu(1233) + lu(1325) = lu(1325) - lu(478) * lu(1303) + lu(1328) = lu(1328) - lu(479) * lu(1303) + lu(1333) = lu(1333) - lu(480) * lu(1303) + lu(1336) = lu(1336) - lu(481) * lu(1303) + lu(1338) = - lu(482) * lu(1303) + lu(1341) = lu(1341) - lu(483) * lu(1303) + lu(1350) = lu(1350) - lu(478) * lu(1347) + lu(1352) = lu(1352) - lu(479) * lu(1347) + lu(1357) = lu(1357) - lu(480) * lu(1347) + lu(1360) = lu(1360) - lu(481) * lu(1347) + lu(1362) = lu(1362) - lu(482) * lu(1347) + lu(1365) = lu(1365) - lu(483) * lu(1347) + lu(1455) = lu(1455) - lu(478) * lu(1447) + lu(1458) = lu(1458) - lu(479) * lu(1447) + lu(1463) = lu(1463) - lu(480) * lu(1447) + lu(1466) = lu(1466) - lu(481) * lu(1447) + lu(1468) = lu(1468) - lu(482) * lu(1447) + lu(1471) = lu(1471) - lu(483) * lu(1447) + end subroutine lu_fac11 + subroutine lu_fac12( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(489) = 1._r8 / lu(489) + lu(490) = lu(490) * lu(489) + lu(491) = lu(491) * lu(489) + lu(492) = lu(492) * lu(489) + lu(493) = lu(493) * lu(489) + lu(494) = lu(494) * lu(489) + lu(495) = lu(495) * lu(489) + lu(496) = lu(496) * lu(489) + lu(497) = lu(497) * lu(489) + lu(842) = lu(842) - lu(490) * lu(840) + lu(843) = lu(843) - lu(491) * lu(840) + lu(844) = lu(844) - lu(492) * lu(840) + lu(845) = - lu(493) * lu(840) + lu(848) = lu(848) - lu(494) * lu(840) + lu(850) = lu(850) - lu(495) * lu(840) + lu(851) = - lu(496) * lu(840) + lu(852) = lu(852) - lu(497) * lu(840) + lu(953) = lu(953) - lu(490) * lu(947) + lu(966) = lu(966) - lu(491) * lu(947) + lu(971) = lu(971) - lu(492) * lu(947) + lu(975) = lu(975) - lu(493) * lu(947) + lu(978) = - lu(494) * lu(947) + lu(980) = lu(980) - lu(495) * lu(947) + lu(981) = lu(981) - lu(496) * lu(947) + lu(983) = lu(983) - lu(497) * lu(947) + lu(1156) = lu(1156) - lu(490) * lu(1146) + lu(1170) = lu(1170) - lu(491) * lu(1146) + lu(1175) = lu(1175) - lu(492) * lu(1146) + lu(1179) = lu(1179) - lu(493) * lu(1146) + lu(1182) = lu(1182) - lu(494) * lu(1146) + lu(1184) = lu(1184) - lu(495) * lu(1146) + lu(1185) = lu(1185) - lu(496) * lu(1146) + lu(1187) = lu(1187) - lu(497) * lu(1146) + lu(1377) = lu(1377) - lu(490) * lu(1375) + lu(1383) = lu(1383) - lu(491) * lu(1375) + lu(1388) = lu(1388) - lu(492) * lu(1375) + lu(1392) = lu(1392) - lu(493) * lu(1375) + lu(1395) = - lu(494) * lu(1375) + lu(1397) = - lu(495) * lu(1375) + lu(1398) = lu(1398) - lu(496) * lu(1375) + lu(1400) = lu(1400) - lu(497) * lu(1375) + lu(1451) = lu(1451) - lu(490) * lu(1448) + lu(1454) = lu(1454) - lu(491) * lu(1448) + lu(1459) = lu(1459) - lu(492) * lu(1448) + lu(1463) = lu(1463) - lu(493) * lu(1448) + lu(1466) = lu(1466) - lu(494) * lu(1448) + lu(1468) = lu(1468) - lu(495) * lu(1448) + lu(1469) = lu(1469) - lu(496) * lu(1448) + lu(1471) = lu(1471) - lu(497) * lu(1448) + lu(501) = 1._r8 / lu(501) + lu(502) = lu(502) * lu(501) + lu(503) = lu(503) * lu(501) + lu(504) = lu(504) * lu(501) + lu(505) = lu(505) * lu(501) + lu(506) = lu(506) * lu(501) + lu(507) = lu(507) * lu(501) + lu(508) = lu(508) * lu(501) + lu(509) = lu(509) * lu(501) + lu(954) = lu(954) - lu(502) * lu(948) + lu(966) = lu(966) - lu(503) * lu(948) + lu(971) = lu(971) - lu(504) * lu(948) + lu(973) = lu(973) - lu(505) * lu(948) + lu(975) = lu(975) - lu(506) * lu(948) + lu(977) = lu(977) - lu(507) * lu(948) + lu(979) = lu(979) - lu(508) * lu(948) + lu(981) = lu(981) - lu(509) * lu(948) + lu(1036) = lu(1036) - lu(502) * lu(1032) + lu(1047) = lu(1047) - lu(503) * lu(1032) + lu(1052) = lu(1052) - lu(504) * lu(1032) + lu(1054) = lu(1054) - lu(505) * lu(1032) + lu(1056) = lu(1056) - lu(506) * lu(1032) + lu(1058) = lu(1058) - lu(507) * lu(1032) + lu(1060) = lu(1060) - lu(508) * lu(1032) + lu(1062) = lu(1062) - lu(509) * lu(1032) + lu(1157) = lu(1157) - lu(502) * lu(1147) + lu(1170) = lu(1170) - lu(503) * lu(1147) + lu(1175) = lu(1175) - lu(504) * lu(1147) + lu(1177) = lu(1177) - lu(505) * lu(1147) + lu(1179) = lu(1179) - lu(506) * lu(1147) + lu(1181) = lu(1181) - lu(507) * lu(1147) + lu(1183) = lu(1183) - lu(508) * lu(1147) + lu(1185) = lu(1185) - lu(509) * lu(1147) + lu(1311) = lu(1311) - lu(502) * lu(1304) + lu(1324) = lu(1324) - lu(503) * lu(1304) + lu(1329) = lu(1329) - lu(504) * lu(1304) + lu(1331) = lu(1331) - lu(505) * lu(1304) + lu(1333) = lu(1333) - lu(506) * lu(1304) + lu(1335) = lu(1335) - lu(507) * lu(1304) + lu(1337) = lu(1337) - lu(508) * lu(1304) + lu(1339) = lu(1339) - lu(509) * lu(1304) + lu(1414) = - lu(502) * lu(1409) + lu(1417) = lu(1417) - lu(503) * lu(1409) + lu(1422) = lu(1422) - lu(504) * lu(1409) + lu(1424) = lu(1424) - lu(505) * lu(1409) + lu(1426) = lu(1426) - lu(506) * lu(1409) + lu(1428) = lu(1428) - lu(507) * lu(1409) + lu(1430) = lu(1430) - lu(508) * lu(1409) + lu(1432) = lu(1432) - lu(509) * lu(1409) + lu(511) = 1._r8 / lu(511) + lu(512) = lu(512) * lu(511) + lu(513) = lu(513) * lu(511) + lu(514) = lu(514) * lu(511) + lu(515) = lu(515) * lu(511) + lu(516) = lu(516) * lu(511) + lu(517) = lu(517) * lu(511) + lu(582) = - lu(512) * lu(580) + lu(584) = lu(584) - lu(513) * lu(580) + lu(586) = lu(586) - lu(514) * lu(580) + lu(587) = lu(587) - lu(515) * lu(580) + lu(589) = lu(589) - lu(516) * lu(580) + lu(590) = lu(590) - lu(517) * lu(580) + lu(888) = - lu(512) * lu(884) + lu(890) = lu(890) - lu(513) * lu(884) + lu(895) = lu(895) - lu(514) * lu(884) + lu(896) = lu(896) - lu(515) * lu(884) + lu(903) = lu(903) - lu(516) * lu(884) + lu(904) = lu(904) - lu(517) * lu(884) + lu(1072) = lu(1072) - lu(512) * lu(1068) + lu(1074) = - lu(513) * lu(1068) + lu(1079) = lu(1079) - lu(514) * lu(1068) + lu(1080) = lu(1080) - lu(515) * lu(1068) + lu(1087) = lu(1087) - lu(516) * lu(1068) + lu(1088) = lu(1088) - lu(517) * lu(1068) + lu(1171) = lu(1171) - lu(512) * lu(1148) + lu(1173) = lu(1173) - lu(513) * lu(1148) + lu(1178) = lu(1178) - lu(514) * lu(1148) + lu(1179) = lu(1179) - lu(515) * lu(1148) + lu(1186) = lu(1186) - lu(516) * lu(1148) + lu(1187) = lu(1187) - lu(517) * lu(1148) + lu(1325) = lu(1325) - lu(512) * lu(1305) + lu(1327) = lu(1327) - lu(513) * lu(1305) + lu(1332) = lu(1332) - lu(514) * lu(1305) + lu(1333) = lu(1333) - lu(515) * lu(1305) + lu(1340) = lu(1340) - lu(516) * lu(1305) + lu(1341) = lu(1341) - lu(517) * lu(1305) + lu(1418) = lu(1418) - lu(512) * lu(1410) + lu(1420) = lu(1420) - lu(513) * lu(1410) + lu(1425) = lu(1425) - lu(514) * lu(1410) + lu(1426) = lu(1426) - lu(515) * lu(1410) + lu(1433) = lu(1433) - lu(516) * lu(1410) + lu(1434) = lu(1434) - lu(517) * lu(1410) + lu(1455) = lu(1455) - lu(512) * lu(1449) + lu(1457) = lu(1457) - lu(513) * lu(1449) + lu(1462) = lu(1462) - lu(514) * lu(1449) + lu(1463) = lu(1463) - lu(515) * lu(1449) + lu(1470) = lu(1470) - lu(516) * lu(1449) + lu(1471) = lu(1471) - lu(517) * lu(1449) + lu(520) = 1._r8 / lu(520) + lu(521) = lu(521) * lu(520) + lu(522) = lu(522) * lu(520) + lu(523) = lu(523) * lu(520) + lu(524) = lu(524) * lu(520) + lu(525) = lu(525) * lu(520) + lu(526) = lu(526) * lu(520) + lu(527) = lu(527) * lu(520) + lu(528) = lu(528) * lu(520) + lu(529) = lu(529) * lu(520) + lu(530) = lu(530) * lu(520) + lu(531) = lu(531) * lu(520) + lu(954) = lu(954) - lu(521) * lu(949) + lu(955) = lu(955) - lu(522) * lu(949) + lu(964) = lu(964) - lu(523) * lu(949) + lu(966) = lu(966) - lu(524) * lu(949) + lu(967) = lu(967) - lu(525) * lu(949) + lu(971) = lu(971) - lu(526) * lu(949) + lu(973) = lu(973) - lu(527) * lu(949) + lu(975) = lu(975) - lu(528) * lu(949) + lu(977) = lu(977) - lu(529) * lu(949) + lu(979) = lu(979) - lu(530) * lu(949) + lu(981) = lu(981) - lu(531) * lu(949) + lu(1036) = lu(1036) - lu(521) * lu(1033) + lu(1037) = lu(1037) - lu(522) * lu(1033) + lu(1046) = lu(1046) - lu(523) * lu(1033) + lu(1047) = lu(1047) - lu(524) * lu(1033) + lu(1048) = lu(1048) - lu(525) * lu(1033) + lu(1052) = lu(1052) - lu(526) * lu(1033) + lu(1054) = lu(1054) - lu(527) * lu(1033) + lu(1056) = lu(1056) - lu(528) * lu(1033) + lu(1058) = lu(1058) - lu(529) * lu(1033) + lu(1060) = lu(1060) - lu(530) * lu(1033) + lu(1062) = lu(1062) - lu(531) * lu(1033) + lu(1157) = lu(1157) - lu(521) * lu(1149) + lu(1158) = lu(1158) - lu(522) * lu(1149) + lu(1168) = lu(1168) - lu(523) * lu(1149) + lu(1170) = lu(1170) - lu(524) * lu(1149) + lu(1171) = lu(1171) - lu(525) * lu(1149) + lu(1175) = lu(1175) - lu(526) * lu(1149) + lu(1177) = lu(1177) - lu(527) * lu(1149) + lu(1179) = lu(1179) - lu(528) * lu(1149) + lu(1181) = lu(1181) - lu(529) * lu(1149) + lu(1183) = lu(1183) - lu(530) * lu(1149) + lu(1185) = lu(1185) - lu(531) * lu(1149) + lu(1311) = lu(1311) - lu(521) * lu(1306) + lu(1312) = lu(1312) - lu(522) * lu(1306) + lu(1322) = lu(1322) - lu(523) * lu(1306) + lu(1324) = lu(1324) - lu(524) * lu(1306) + lu(1325) = lu(1325) - lu(525) * lu(1306) + lu(1329) = lu(1329) - lu(526) * lu(1306) + lu(1331) = lu(1331) - lu(527) * lu(1306) + lu(1333) = lu(1333) - lu(528) * lu(1306) + lu(1335) = lu(1335) - lu(529) * lu(1306) + lu(1337) = lu(1337) - lu(530) * lu(1306) + lu(1339) = lu(1339) - lu(531) * lu(1306) + lu(534) = 1._r8 / lu(534) + lu(535) = lu(535) * lu(534) + lu(536) = lu(536) * lu(534) + lu(537) = lu(537) * lu(534) + lu(538) = lu(538) * lu(534) + lu(539) = lu(539) * lu(534) + lu(540) = lu(540) * lu(534) + lu(541) = lu(541) * lu(534) + lu(542) = lu(542) * lu(534) + lu(543) = lu(543) * lu(534) + lu(544) = lu(544) * lu(534) + lu(545) = lu(545) * lu(534) + lu(546) = lu(546) * lu(534) + lu(547) = lu(547) * lu(534) + lu(548) = lu(548) * lu(534) + lu(549) = lu(549) * lu(534) + lu(550) = lu(550) * lu(534) + lu(994) = lu(994) - lu(535) * lu(992) + lu(996) = lu(996) - lu(536) * lu(992) + lu(997) = lu(997) - lu(537) * lu(992) + lu(1001) = lu(1001) - lu(538) * lu(992) + lu(1004) = lu(1004) - lu(539) * lu(992) + lu(1006) = lu(1006) - lu(540) * lu(992) + lu(1007) = lu(1007) - lu(541) * lu(992) + lu(1010) = - lu(542) * lu(992) + lu(1012) = lu(1012) - lu(543) * lu(992) + lu(1013) = lu(1013) - lu(544) * lu(992) + lu(1014) = - lu(545) * lu(992) + lu(1016) = lu(1016) - lu(546) * lu(992) + lu(1017) = lu(1017) - lu(547) * lu(992) + lu(1018) = lu(1018) - lu(548) * lu(992) + lu(1020) = lu(1020) - lu(549) * lu(992) + lu(1022) = lu(1022) - lu(550) * lu(992) + lu(1152) = lu(1152) - lu(535) * lu(1150) + lu(1155) = lu(1155) - lu(536) * lu(1150) + lu(1156) = lu(1156) - lu(537) * lu(1150) + lu(1160) = lu(1160) - lu(538) * lu(1150) + lu(1164) = lu(1164) - lu(539) * lu(1150) + lu(1166) = lu(1166) - lu(540) * lu(1150) + lu(1167) = lu(1167) - lu(541) * lu(1150) + lu(1171) = lu(1171) - lu(542) * lu(1150) + lu(1175) = lu(1175) - lu(543) * lu(1150) + lu(1176) = lu(1176) - lu(544) * lu(1150) + lu(1177) = lu(1177) - lu(545) * lu(1150) + lu(1179) = lu(1179) - lu(546) * lu(1150) + lu(1180) = lu(1180) - lu(547) * lu(1150) + lu(1181) = lu(1181) - lu(548) * lu(1150) + lu(1183) = lu(1183) - lu(549) * lu(1150) + lu(1185) = lu(1185) - lu(550) * lu(1150) + lu(1197) = - lu(535) * lu(1195) + lu(1199) = lu(1199) - lu(536) * lu(1195) + lu(1200) = lu(1200) - lu(537) * lu(1195) + lu(1204) = lu(1204) - lu(538) * lu(1195) + lu(1207) = - lu(539) * lu(1195) + lu(1209) = lu(1209) - lu(540) * lu(1195) + lu(1210) = lu(1210) - lu(541) * lu(1195) + lu(1214) = lu(1214) - lu(542) * lu(1195) + lu(1218) = lu(1218) - lu(543) * lu(1195) + lu(1219) = lu(1219) - lu(544) * lu(1195) + lu(1220) = lu(1220) - lu(545) * lu(1195) + lu(1222) = lu(1222) - lu(546) * lu(1195) + lu(1223) = lu(1223) - lu(547) * lu(1195) + lu(1224) = lu(1224) - lu(548) * lu(1195) + lu(1226) = lu(1226) - lu(549) * lu(1195) + lu(1228) = lu(1228) - lu(550) * lu(1195) + end subroutine lu_fac12 + subroutine lu_fac13( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(552) = 1._r8 / lu(552) + lu(553) = lu(553) * lu(552) + lu(554) = lu(554) * lu(552) + lu(555) = lu(555) * lu(552) + lu(556) = lu(556) * lu(552) + lu(681) = lu(681) - lu(553) * lu(680) + lu(691) = lu(691) - lu(554) * lu(680) + lu(692) = lu(692) - lu(555) * lu(680) + lu(694) = lu(694) - lu(556) * lu(680) + lu(702) = lu(702) - lu(553) * lu(700) + lu(717) = lu(717) - lu(554) * lu(700) + lu(719) = lu(719) - lu(555) * lu(700) + lu(721) = lu(721) - lu(556) * lu(700) + lu(727) = lu(727) - lu(553) * lu(725) + lu(739) = lu(739) - lu(554) * lu(725) + lu(740) = lu(740) - lu(555) * lu(725) + lu(742) = lu(742) - lu(556) * lu(725) + lu(790) = lu(790) - lu(553) * lu(789) + lu(806) = lu(806) - lu(554) * lu(789) + lu(808) = lu(808) - lu(555) * lu(789) + lu(810) = lu(810) - lu(556) * lu(789) + lu(842) = lu(842) - lu(553) * lu(841) + lu(845) = lu(845) - lu(554) * lu(841) + lu(847) = lu(847) - lu(555) * lu(841) + lu(849) = lu(849) - lu(556) * lu(841) + lu(953) = lu(953) - lu(553) * lu(950) + lu(975) = lu(975) - lu(554) * lu(950) + lu(977) = lu(977) - lu(555) * lu(950) + lu(979) = lu(979) - lu(556) * lu(950) + lu(997) = lu(997) - lu(553) * lu(993) + lu(1016) = lu(1016) - lu(554) * lu(993) + lu(1018) = lu(1018) - lu(555) * lu(993) + lu(1020) = lu(1020) - lu(556) * lu(993) + lu(1035) = lu(1035) - lu(553) * lu(1034) + lu(1056) = lu(1056) - lu(554) * lu(1034) + lu(1058) = lu(1058) - lu(555) * lu(1034) + lu(1060) = lu(1060) - lu(556) * lu(1034) + lu(1156) = lu(1156) - lu(553) * lu(1151) + lu(1179) = lu(1179) - lu(554) * lu(1151) + lu(1181) = lu(1181) - lu(555) * lu(1151) + lu(1183) = lu(1183) - lu(556) * lu(1151) + lu(1200) = lu(1200) - lu(553) * lu(1196) + lu(1222) = lu(1222) - lu(554) * lu(1196) + lu(1224) = lu(1224) - lu(555) * lu(1196) + lu(1226) = lu(1226) - lu(556) * lu(1196) + lu(1310) = lu(1310) - lu(553) * lu(1307) + lu(1333) = lu(1333) - lu(554) * lu(1307) + lu(1335) = lu(1335) - lu(555) * lu(1307) + lu(1337) = lu(1337) - lu(556) * lu(1307) + lu(1413) = lu(1413) - lu(553) * lu(1411) + lu(1426) = lu(1426) - lu(554) * lu(1411) + lu(1428) = lu(1428) - lu(555) * lu(1411) + lu(1430) = lu(1430) - lu(556) * lu(1411) + lu(558) = 1._r8 / lu(558) + lu(559) = lu(559) * lu(558) + lu(560) = lu(560) * lu(558) + lu(561) = lu(561) * lu(558) + lu(562) = lu(562) * lu(558) + lu(563) = lu(563) * lu(558) + lu(564) = lu(564) * lu(558) + lu(565) = lu(565) * lu(558) + lu(702) = lu(702) - lu(559) * lu(701) + lu(706) = lu(706) - lu(560) * lu(701) + lu(715) = lu(715) - lu(561) * lu(701) + lu(717) = lu(717) - lu(562) * lu(701) + lu(719) = lu(719) - lu(563) * lu(701) + lu(721) = lu(721) - lu(564) * lu(701) + lu(722) = lu(722) - lu(565) * lu(701) + lu(727) = lu(727) - lu(559) * lu(726) + lu(730) = - lu(560) * lu(726) + lu(737) = lu(737) - lu(561) * lu(726) + lu(739) = lu(739) - lu(562) * lu(726) + lu(740) = lu(740) - lu(563) * lu(726) + lu(742) = lu(742) - lu(564) * lu(726) + lu(743) = lu(743) - lu(565) * lu(726) + lu(953) = lu(953) - lu(559) * lu(951) + lu(959) = lu(959) - lu(560) * lu(951) + lu(972) = lu(972) - lu(561) * lu(951) + lu(975) = lu(975) - lu(562) * lu(951) + lu(977) = lu(977) - lu(563) * lu(951) + lu(979) = lu(979) - lu(564) * lu(951) + lu(981) = lu(981) - lu(565) * lu(951) + lu(997) = lu(997) - lu(559) * lu(994) + lu(1003) = lu(1003) - lu(560) * lu(994) + lu(1013) = lu(1013) - lu(561) * lu(994) + lu(1016) = lu(1016) - lu(562) * lu(994) + lu(1018) = lu(1018) - lu(563) * lu(994) + lu(1020) = lu(1020) - lu(564) * lu(994) + lu(1022) = lu(1022) - lu(565) * lu(994) + lu(1156) = lu(1156) - lu(559) * lu(1152) + lu(1163) = lu(1163) - lu(560) * lu(1152) + lu(1176) = lu(1176) - lu(561) * lu(1152) + lu(1179) = lu(1179) - lu(562) * lu(1152) + lu(1181) = lu(1181) - lu(563) * lu(1152) + lu(1183) = lu(1183) - lu(564) * lu(1152) + lu(1185) = lu(1185) - lu(565) * lu(1152) + lu(1200) = lu(1200) - lu(559) * lu(1197) + lu(1206) = - lu(560) * lu(1197) + lu(1219) = lu(1219) - lu(561) * lu(1197) + lu(1222) = lu(1222) - lu(562) * lu(1197) + lu(1224) = lu(1224) - lu(563) * lu(1197) + lu(1226) = lu(1226) - lu(564) * lu(1197) + lu(1228) = lu(1228) - lu(565) * lu(1197) + lu(1310) = lu(1310) - lu(559) * lu(1308) + lu(1317) = lu(1317) - lu(560) * lu(1308) + lu(1330) = lu(1330) - lu(561) * lu(1308) + lu(1333) = lu(1333) - lu(562) * lu(1308) + lu(1335) = lu(1335) - lu(563) * lu(1308) + lu(1337) = lu(1337) - lu(564) * lu(1308) + lu(1339) = lu(1339) - lu(565) * lu(1308) + lu(568) = 1._r8 / lu(568) + lu(569) = lu(569) * lu(568) + lu(570) = lu(570) * lu(568) + lu(571) = lu(571) * lu(568) + lu(572) = lu(572) * lu(568) + lu(573) = lu(573) * lu(568) + lu(574) = lu(574) * lu(568) + lu(575) = lu(575) * lu(568) + lu(576) = lu(576) * lu(568) + lu(577) = lu(577) * lu(568) + lu(578) = lu(578) * lu(568) + lu(955) = lu(955) - lu(569) * lu(952) + lu(957) = lu(957) - lu(570) * lu(952) + lu(962) = lu(962) - lu(571) * lu(952) + lu(964) = lu(964) - lu(572) * lu(952) + lu(967) = lu(967) - lu(573) * lu(952) + lu(971) = lu(971) - lu(574) * lu(952) + lu(973) = lu(973) - lu(575) * lu(952) + lu(975) = lu(975) - lu(576) * lu(952) + lu(979) = lu(979) - lu(577) * lu(952) + lu(981) = lu(981) - lu(578) * lu(952) + lu(999) = - lu(569) * lu(995) + lu(1001) = lu(1001) - lu(570) * lu(995) + lu(1006) = lu(1006) - lu(571) * lu(995) + lu(1008) = lu(1008) - lu(572) * lu(995) + lu(1010) = lu(1010) - lu(573) * lu(995) + lu(1012) = lu(1012) - lu(574) * lu(995) + lu(1014) = lu(1014) - lu(575) * lu(995) + lu(1016) = lu(1016) - lu(576) * lu(995) + lu(1020) = lu(1020) - lu(577) * lu(995) + lu(1022) = lu(1022) - lu(578) * lu(995) + lu(1158) = lu(1158) - lu(569) * lu(1153) + lu(1160) = lu(1160) - lu(570) * lu(1153) + lu(1166) = lu(1166) - lu(571) * lu(1153) + lu(1168) = lu(1168) - lu(572) * lu(1153) + lu(1171) = lu(1171) - lu(573) * lu(1153) + lu(1175) = lu(1175) - lu(574) * lu(1153) + lu(1177) = lu(1177) - lu(575) * lu(1153) + lu(1179) = lu(1179) - lu(576) * lu(1153) + lu(1183) = lu(1183) - lu(577) * lu(1153) + lu(1185) = lu(1185) - lu(578) * lu(1153) + lu(1202) = - lu(569) * lu(1198) + lu(1204) = lu(1204) - lu(570) * lu(1198) + lu(1209) = lu(1209) - lu(571) * lu(1198) + lu(1211) = - lu(572) * lu(1198) + lu(1214) = lu(1214) - lu(573) * lu(1198) + lu(1218) = lu(1218) - lu(574) * lu(1198) + lu(1220) = lu(1220) - lu(575) * lu(1198) + lu(1222) = lu(1222) - lu(576) * lu(1198) + lu(1226) = lu(1226) - lu(577) * lu(1198) + lu(1228) = lu(1228) - lu(578) * lu(1198) + lu(1312) = lu(1312) - lu(569) * lu(1309) + lu(1314) = lu(1314) - lu(570) * lu(1309) + lu(1320) = lu(1320) - lu(571) * lu(1309) + lu(1322) = lu(1322) - lu(572) * lu(1309) + lu(1325) = lu(1325) - lu(573) * lu(1309) + lu(1329) = lu(1329) - lu(574) * lu(1309) + lu(1331) = lu(1331) - lu(575) * lu(1309) + lu(1333) = lu(1333) - lu(576) * lu(1309) + lu(1337) = lu(1337) - lu(577) * lu(1309) + lu(1339) = lu(1339) - lu(578) * lu(1309) + lu(581) = 1._r8 / lu(581) + lu(582) = lu(582) * lu(581) + lu(583) = lu(583) * lu(581) + lu(584) = lu(584) * lu(581) + lu(585) = lu(585) * lu(581) + lu(586) = lu(586) * lu(581) + lu(587) = lu(587) * lu(581) + lu(588) = lu(588) * lu(581) + lu(589) = lu(589) * lu(581) + lu(590) = lu(590) * lu(581) + lu(888) = lu(888) - lu(582) * lu(885) + lu(889) = - lu(583) * lu(885) + lu(890) = lu(890) - lu(584) * lu(885) + lu(893) = - lu(585) * lu(885) + lu(895) = lu(895) - lu(586) * lu(885) + lu(896) = lu(896) - lu(587) * lu(885) + lu(902) = lu(902) - lu(588) * lu(885) + lu(903) = lu(903) - lu(589) * lu(885) + lu(904) = lu(904) - lu(590) * lu(885) + lu(1072) = lu(1072) - lu(582) * lu(1069) + lu(1073) = lu(1073) - lu(583) * lu(1069) + lu(1074) = lu(1074) - lu(584) * lu(1069) + lu(1077) = - lu(585) * lu(1069) + lu(1079) = lu(1079) - lu(586) * lu(1069) + lu(1080) = lu(1080) - lu(587) * lu(1069) + lu(1086) = - lu(588) * lu(1069) + lu(1087) = lu(1087) - lu(589) * lu(1069) + lu(1088) = lu(1088) - lu(590) * lu(1069) + lu(1171) = lu(1171) - lu(582) * lu(1154) + lu(1172) = lu(1172) - lu(583) * lu(1154) + lu(1173) = lu(1173) - lu(584) * lu(1154) + lu(1176) = lu(1176) - lu(585) * lu(1154) + lu(1178) = lu(1178) - lu(586) * lu(1154) + lu(1179) = lu(1179) - lu(587) * lu(1154) + lu(1185) = lu(1185) - lu(588) * lu(1154) + lu(1186) = lu(1186) - lu(589) * lu(1154) + lu(1187) = lu(1187) - lu(590) * lu(1154) + lu(1384) = lu(1384) - lu(582) * lu(1376) + lu(1385) = lu(1385) - lu(583) * lu(1376) + lu(1386) = lu(1386) - lu(584) * lu(1376) + lu(1389) = lu(1389) - lu(585) * lu(1376) + lu(1391) = lu(1391) - lu(586) * lu(1376) + lu(1392) = lu(1392) - lu(587) * lu(1376) + lu(1398) = lu(1398) - lu(588) * lu(1376) + lu(1399) = lu(1399) - lu(589) * lu(1376) + lu(1400) = lu(1400) - lu(590) * lu(1376) + lu(1418) = lu(1418) - lu(582) * lu(1412) + lu(1419) = - lu(583) * lu(1412) + lu(1420) = lu(1420) - lu(584) * lu(1412) + lu(1423) = lu(1423) - lu(585) * lu(1412) + lu(1425) = lu(1425) - lu(586) * lu(1412) + lu(1426) = lu(1426) - lu(587) * lu(1412) + lu(1432) = lu(1432) - lu(588) * lu(1412) + lu(1433) = lu(1433) - lu(589) * lu(1412) + lu(1434) = lu(1434) - lu(590) * lu(1412) + lu(1455) = lu(1455) - lu(582) * lu(1450) + lu(1456) = lu(1456) - lu(583) * lu(1450) + lu(1457) = lu(1457) - lu(584) * lu(1450) + lu(1460) = lu(1460) - lu(585) * lu(1450) + lu(1462) = lu(1462) - lu(586) * lu(1450) + lu(1463) = lu(1463) - lu(587) * lu(1450) + lu(1469) = lu(1469) - lu(588) * lu(1450) + lu(1470) = lu(1470) - lu(589) * lu(1450) + lu(1471) = lu(1471) - lu(590) * lu(1450) + lu(594) = 1._r8 / lu(594) + lu(595) = lu(595) * lu(594) + lu(596) = lu(596) * lu(594) + lu(597) = lu(597) * lu(594) + lu(598) = lu(598) * lu(594) + lu(599) = lu(599) * lu(594) + lu(600) = lu(600) * lu(594) + lu(601) = lu(601) * lu(594) + lu(602) = lu(602) * lu(594) + lu(603) = lu(603) * lu(594) + lu(604) = lu(604) * lu(594) + lu(605) = lu(605) * lu(594) + lu(606) = lu(606) * lu(594) + lu(607) = lu(607) * lu(594) + lu(608) = lu(608) * lu(594) + lu(745) = lu(745) - lu(595) * lu(744) + lu(746) = lu(746) - lu(596) * lu(744) + lu(747) = - lu(597) * lu(744) + lu(748) = lu(748) - lu(598) * lu(744) + lu(753) = - lu(599) * lu(744) + lu(754) = - lu(600) * lu(744) + lu(756) = - lu(601) * lu(744) + lu(757) = - lu(602) * lu(744) + lu(758) = lu(758) - lu(603) * lu(744) + lu(759) = lu(759) - lu(604) * lu(744) + lu(760) = lu(760) - lu(605) * lu(744) + lu(761) = lu(761) - lu(606) * lu(744) + lu(763) = lu(763) - lu(607) * lu(744) + lu(764) = - lu(608) * lu(744) + lu(997) = lu(997) - lu(595) * lu(996) + lu(998) = lu(998) - lu(596) * lu(996) + lu(1000) = lu(1000) - lu(597) * lu(996) + lu(1002) = lu(1002) - lu(598) * lu(996) + lu(1009) = lu(1009) - lu(599) * lu(996) + lu(1010) = lu(1010) - lu(600) * lu(996) + lu(1012) = lu(1012) - lu(601) * lu(996) + lu(1013) = lu(1013) - lu(602) * lu(996) + lu(1014) = lu(1014) - lu(603) * lu(996) + lu(1016) = lu(1016) - lu(604) * lu(996) + lu(1017) = lu(1017) - lu(605) * lu(996) + lu(1018) = lu(1018) - lu(606) * lu(996) + lu(1020) = lu(1020) - lu(607) * lu(996) + lu(1022) = lu(1022) - lu(608) * lu(996) + lu(1156) = lu(1156) - lu(595) * lu(1155) + lu(1157) = lu(1157) - lu(596) * lu(1155) + lu(1159) = lu(1159) - lu(597) * lu(1155) + lu(1162) = lu(1162) - lu(598) * lu(1155) + lu(1170) = lu(1170) - lu(599) * lu(1155) + lu(1171) = lu(1171) - lu(600) * lu(1155) + lu(1175) = lu(1175) - lu(601) * lu(1155) + lu(1176) = lu(1176) - lu(602) * lu(1155) + lu(1177) = lu(1177) - lu(603) * lu(1155) + lu(1179) = lu(1179) - lu(604) * lu(1155) + lu(1180) = lu(1180) - lu(605) * lu(1155) + lu(1181) = lu(1181) - lu(606) * lu(1155) + lu(1183) = lu(1183) - lu(607) * lu(1155) + lu(1185) = lu(1185) - lu(608) * lu(1155) + lu(1200) = lu(1200) - lu(595) * lu(1199) + lu(1201) = lu(1201) - lu(596) * lu(1199) + lu(1203) = - lu(597) * lu(1199) + lu(1205) = lu(1205) - lu(598) * lu(1199) + lu(1213) = lu(1213) - lu(599) * lu(1199) + lu(1214) = lu(1214) - lu(600) * lu(1199) + lu(1218) = lu(1218) - lu(601) * lu(1199) + lu(1219) = lu(1219) - lu(602) * lu(1199) + lu(1220) = lu(1220) - lu(603) * lu(1199) + lu(1222) = lu(1222) - lu(604) * lu(1199) + lu(1223) = lu(1223) - lu(605) * lu(1199) + lu(1224) = lu(1224) - lu(606) * lu(1199) + lu(1226) = lu(1226) - lu(607) * lu(1199) + lu(1228) = lu(1228) - lu(608) * lu(1199) + end subroutine lu_fac13 + subroutine lu_fac14( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(609) = 1._r8 / lu(609) + lu(610) = lu(610) * lu(609) + lu(611) = lu(611) * lu(609) + lu(612) = lu(612) * lu(609) + lu(620) = lu(620) - lu(610) * lu(613) + lu(621) = - lu(611) * lu(613) + lu(622) = lu(622) - lu(612) * lu(613) + lu(650) = lu(650) - lu(610) * lu(643) + lu(653) = - lu(611) * lu(643) + lu(654) = lu(654) - lu(612) * lu(643) + lu(674) = lu(674) - lu(610) * lu(668) + lu(675) = - lu(611) * lu(668) + lu(676) = lu(676) - lu(612) * lu(668) + lu(691) = lu(691) - lu(610) * lu(681) + lu(693) = - lu(611) * lu(681) + lu(694) = lu(694) - lu(612) * lu(681) + lu(717) = lu(717) - lu(610) * lu(702) + lu(720) = - lu(611) * lu(702) + lu(721) = lu(721) - lu(612) * lu(702) + lu(739) = lu(739) - lu(610) * lu(727) + lu(741) = - lu(611) * lu(727) + lu(742) = lu(742) - lu(612) * lu(727) + lu(759) = lu(759) - lu(610) * lu(745) + lu(762) = - lu(611) * lu(745) + lu(763) = lu(763) - lu(612) * lu(745) + lu(806) = lu(806) - lu(610) * lu(790) + lu(809) = - lu(611) * lu(790) + lu(810) = lu(810) - lu(612) * lu(790) + lu(845) = lu(845) - lu(610) * lu(842) + lu(848) = lu(848) - lu(611) * lu(842) + lu(849) = lu(849) - lu(612) * lu(842) + lu(917) = lu(917) - lu(610) * lu(906) + lu(920) = lu(920) - lu(611) * lu(906) + lu(921) = lu(921) - lu(612) * lu(906) + lu(975) = lu(975) - lu(610) * lu(953) + lu(978) = lu(978) - lu(611) * lu(953) + lu(979) = lu(979) - lu(612) * lu(953) + lu(1016) = lu(1016) - lu(610) * lu(997) + lu(1019) = - lu(611) * lu(997) + lu(1020) = lu(1020) - lu(612) * lu(997) + lu(1056) = lu(1056) - lu(610) * lu(1035) + lu(1059) = lu(1059) - lu(611) * lu(1035) + lu(1060) = lu(1060) - lu(612) * lu(1035) + lu(1179) = lu(1179) - lu(610) * lu(1156) + lu(1182) = lu(1182) - lu(611) * lu(1156) + lu(1183) = lu(1183) - lu(612) * lu(1156) + lu(1222) = lu(1222) - lu(610) * lu(1200) + lu(1225) = lu(1225) - lu(611) * lu(1200) + lu(1226) = lu(1226) - lu(612) * lu(1200) + lu(1243) = lu(1243) - lu(610) * lu(1234) + lu(1246) = lu(1246) - lu(611) * lu(1234) + lu(1247) = lu(1247) - lu(612) * lu(1234) + lu(1333) = lu(1333) - lu(610) * lu(1310) + lu(1336) = lu(1336) - lu(611) * lu(1310) + lu(1337) = lu(1337) - lu(612) * lu(1310) + lu(1392) = lu(1392) - lu(610) * lu(1377) + lu(1395) = lu(1395) - lu(611) * lu(1377) + lu(1396) = lu(1396) - lu(612) * lu(1377) + lu(1426) = lu(1426) - lu(610) * lu(1413) + lu(1429) = lu(1429) - lu(611) * lu(1413) + lu(1430) = lu(1430) - lu(612) * lu(1413) + lu(1463) = lu(1463) - lu(610) * lu(1451) + lu(1466) = lu(1466) - lu(611) * lu(1451) + lu(1467) = lu(1467) - lu(612) * lu(1451) + lu(614) = 1._r8 / lu(614) + lu(615) = lu(615) * lu(614) + lu(616) = lu(616) * lu(614) + lu(617) = lu(617) * lu(614) + lu(618) = lu(618) * lu(614) + lu(619) = lu(619) * lu(614) + lu(620) = lu(620) * lu(614) + lu(621) = lu(621) * lu(614) + lu(622) = lu(622) * lu(614) + lu(752) = lu(752) - lu(615) * lu(746) + lu(754) = lu(754) - lu(616) * lu(746) + lu(755) = - lu(617) * lu(746) + lu(757) = lu(757) - lu(618) * lu(746) + lu(758) = lu(758) - lu(619) * lu(746) + lu(759) = lu(759) - lu(620) * lu(746) + lu(762) = lu(762) - lu(621) * lu(746) + lu(763) = lu(763) - lu(622) * lu(746) + lu(964) = lu(964) - lu(615) * lu(954) + lu(967) = lu(967) - lu(616) * lu(954) + lu(968) = - lu(617) * lu(954) + lu(972) = lu(972) - lu(618) * lu(954) + lu(973) = lu(973) - lu(619) * lu(954) + lu(975) = lu(975) - lu(620) * lu(954) + lu(978) = lu(978) - lu(621) * lu(954) + lu(979) = lu(979) - lu(622) * lu(954) + lu(1008) = lu(1008) - lu(615) * lu(998) + lu(1010) = lu(1010) - lu(616) * lu(998) + lu(1011) = lu(1011) - lu(617) * lu(998) + lu(1013) = lu(1013) - lu(618) * lu(998) + lu(1014) = lu(1014) - lu(619) * lu(998) + lu(1016) = lu(1016) - lu(620) * lu(998) + lu(1019) = lu(1019) - lu(621) * lu(998) + lu(1020) = lu(1020) - lu(622) * lu(998) + lu(1046) = lu(1046) - lu(615) * lu(1036) + lu(1048) = lu(1048) - lu(616) * lu(1036) + lu(1049) = - lu(617) * lu(1036) + lu(1053) = - lu(618) * lu(1036) + lu(1054) = lu(1054) - lu(619) * lu(1036) + lu(1056) = lu(1056) - lu(620) * lu(1036) + lu(1059) = lu(1059) - lu(621) * lu(1036) + lu(1060) = lu(1060) - lu(622) * lu(1036) + lu(1168) = lu(1168) - lu(615) * lu(1157) + lu(1171) = lu(1171) - lu(616) * lu(1157) + lu(1172) = lu(1172) - lu(617) * lu(1157) + lu(1176) = lu(1176) - lu(618) * lu(1157) + lu(1177) = lu(1177) - lu(619) * lu(1157) + lu(1179) = lu(1179) - lu(620) * lu(1157) + lu(1182) = lu(1182) - lu(621) * lu(1157) + lu(1183) = lu(1183) - lu(622) * lu(1157) + lu(1211) = lu(1211) - lu(615) * lu(1201) + lu(1214) = lu(1214) - lu(616) * lu(1201) + lu(1215) = - lu(617) * lu(1201) + lu(1219) = lu(1219) - lu(618) * lu(1201) + lu(1220) = lu(1220) - lu(619) * lu(1201) + lu(1222) = lu(1222) - lu(620) * lu(1201) + lu(1225) = lu(1225) - lu(621) * lu(1201) + lu(1226) = lu(1226) - lu(622) * lu(1201) + lu(1322) = lu(1322) - lu(615) * lu(1311) + lu(1325) = lu(1325) - lu(616) * lu(1311) + lu(1326) = - lu(617) * lu(1311) + lu(1330) = lu(1330) - lu(618) * lu(1311) + lu(1331) = lu(1331) - lu(619) * lu(1311) + lu(1333) = lu(1333) - lu(620) * lu(1311) + lu(1336) = lu(1336) - lu(621) * lu(1311) + lu(1337) = lu(1337) - lu(622) * lu(1311) + lu(1416) = - lu(615) * lu(1414) + lu(1418) = lu(1418) - lu(616) * lu(1414) + lu(1419) = lu(1419) - lu(617) * lu(1414) + lu(1423) = lu(1423) - lu(618) * lu(1414) + lu(1424) = lu(1424) - lu(619) * lu(1414) + lu(1426) = lu(1426) - lu(620) * lu(1414) + lu(1429) = lu(1429) - lu(621) * lu(1414) + lu(1430) = lu(1430) - lu(622) * lu(1414) + lu(625) = 1._r8 / lu(625) + lu(626) = lu(626) * lu(625) + lu(627) = lu(627) * lu(625) + lu(628) = lu(628) * lu(625) + lu(629) = lu(629) * lu(625) + lu(630) = lu(630) * lu(625) + lu(631) = lu(631) * lu(625) + lu(632) = lu(632) * lu(625) + lu(633) = lu(633) * lu(625) + lu(634) = lu(634) * lu(625) + lu(635) = lu(635) * lu(625) + lu(636) = lu(636) * lu(625) + lu(956) = lu(956) - lu(626) * lu(955) + lu(958) = lu(958) - lu(627) * lu(955) + lu(964) = lu(964) - lu(628) * lu(955) + lu(966) = lu(966) - lu(629) * lu(955) + lu(967) = lu(967) - lu(630) * lu(955) + lu(971) = lu(971) - lu(631) * lu(955) + lu(973) = lu(973) - lu(632) * lu(955) + lu(975) = lu(975) - lu(633) * lu(955) + lu(977) = lu(977) - lu(634) * lu(955) + lu(979) = lu(979) - lu(635) * lu(955) + lu(981) = lu(981) - lu(636) * lu(955) + lu(1000) = lu(1000) - lu(626) * lu(999) + lu(1002) = lu(1002) - lu(627) * lu(999) + lu(1008) = lu(1008) - lu(628) * lu(999) + lu(1009) = lu(1009) - lu(629) * lu(999) + lu(1010) = lu(1010) - lu(630) * lu(999) + lu(1012) = lu(1012) - lu(631) * lu(999) + lu(1014) = lu(1014) - lu(632) * lu(999) + lu(1016) = lu(1016) - lu(633) * lu(999) + lu(1018) = lu(1018) - lu(634) * lu(999) + lu(1020) = lu(1020) - lu(635) * lu(999) + lu(1022) = lu(1022) - lu(636) * lu(999) + lu(1038) = lu(1038) - lu(626) * lu(1037) + lu(1040) = lu(1040) - lu(627) * lu(1037) + lu(1046) = lu(1046) - lu(628) * lu(1037) + lu(1047) = lu(1047) - lu(629) * lu(1037) + lu(1048) = lu(1048) - lu(630) * lu(1037) + lu(1052) = lu(1052) - lu(631) * lu(1037) + lu(1054) = lu(1054) - lu(632) * lu(1037) + lu(1056) = lu(1056) - lu(633) * lu(1037) + lu(1058) = lu(1058) - lu(634) * lu(1037) + lu(1060) = lu(1060) - lu(635) * lu(1037) + lu(1062) = lu(1062) - lu(636) * lu(1037) + lu(1159) = lu(1159) - lu(626) * lu(1158) + lu(1162) = lu(1162) - lu(627) * lu(1158) + lu(1168) = lu(1168) - lu(628) * lu(1158) + lu(1170) = lu(1170) - lu(629) * lu(1158) + lu(1171) = lu(1171) - lu(630) * lu(1158) + lu(1175) = lu(1175) - lu(631) * lu(1158) + lu(1177) = lu(1177) - lu(632) * lu(1158) + lu(1179) = lu(1179) - lu(633) * lu(1158) + lu(1181) = lu(1181) - lu(634) * lu(1158) + lu(1183) = lu(1183) - lu(635) * lu(1158) + lu(1185) = lu(1185) - lu(636) * lu(1158) + lu(1203) = lu(1203) - lu(626) * lu(1202) + lu(1205) = lu(1205) - lu(627) * lu(1202) + lu(1211) = lu(1211) - lu(628) * lu(1202) + lu(1213) = lu(1213) - lu(629) * lu(1202) + lu(1214) = lu(1214) - lu(630) * lu(1202) + lu(1218) = lu(1218) - lu(631) * lu(1202) + lu(1220) = lu(1220) - lu(632) * lu(1202) + lu(1222) = lu(1222) - lu(633) * lu(1202) + lu(1224) = lu(1224) - lu(634) * lu(1202) + lu(1226) = lu(1226) - lu(635) * lu(1202) + lu(1228) = lu(1228) - lu(636) * lu(1202) + lu(1313) = lu(1313) - lu(626) * lu(1312) + lu(1316) = lu(1316) - lu(627) * lu(1312) + lu(1322) = lu(1322) - lu(628) * lu(1312) + lu(1324) = lu(1324) - lu(629) * lu(1312) + lu(1325) = lu(1325) - lu(630) * lu(1312) + lu(1329) = lu(1329) - lu(631) * lu(1312) + lu(1331) = lu(1331) - lu(632) * lu(1312) + lu(1333) = lu(1333) - lu(633) * lu(1312) + lu(1335) = lu(1335) - lu(634) * lu(1312) + lu(1337) = lu(1337) - lu(635) * lu(1312) + lu(1339) = lu(1339) - lu(636) * lu(1312) + lu(637) = 1._r8 / lu(637) + lu(638) = lu(638) * lu(637) + lu(639) = lu(639) * lu(637) + lu(640) = lu(640) * lu(637) + lu(641) = lu(641) * lu(637) + lu(642) = lu(642) * lu(637) + lu(683) = lu(683) - lu(638) * lu(682) + lu(685) = lu(685) - lu(639) * lu(682) + lu(691) = lu(691) - lu(640) * lu(682) + lu(692) = lu(692) - lu(641) * lu(682) + lu(694) = lu(694) - lu(642) * lu(682) + lu(705) = lu(705) - lu(638) * lu(703) + lu(711) = lu(711) - lu(639) * lu(703) + lu(717) = lu(717) - lu(640) * lu(703) + lu(719) = lu(719) - lu(641) * lu(703) + lu(721) = lu(721) - lu(642) * lu(703) + lu(729) = lu(729) - lu(638) * lu(728) + lu(733) = lu(733) - lu(639) * lu(728) + lu(739) = lu(739) - lu(640) * lu(728) + lu(740) = lu(740) - lu(641) * lu(728) + lu(742) = lu(742) - lu(642) * lu(728) + lu(748) = lu(748) - lu(638) * lu(747) + lu(752) = lu(752) - lu(639) * lu(747) + lu(759) = lu(759) - lu(640) * lu(747) + lu(761) = lu(761) - lu(641) * lu(747) + lu(763) = lu(763) - lu(642) * lu(747) + lu(769) = - lu(638) * lu(768) + lu(771) = lu(771) - lu(639) * lu(768) + lu(778) = lu(778) - lu(640) * lu(768) + lu(780) = lu(780) - lu(641) * lu(768) + lu(782) = lu(782) - lu(642) * lu(768) + lu(793) = lu(793) - lu(638) * lu(791) + lu(799) = lu(799) - lu(639) * lu(791) + lu(806) = lu(806) - lu(640) * lu(791) + lu(808) = lu(808) - lu(641) * lu(791) + lu(810) = lu(810) - lu(642) * lu(791) + lu(958) = lu(958) - lu(638) * lu(956) + lu(964) = lu(964) - lu(639) * lu(956) + lu(975) = lu(975) - lu(640) * lu(956) + lu(977) = lu(977) - lu(641) * lu(956) + lu(979) = lu(979) - lu(642) * lu(956) + lu(1002) = lu(1002) - lu(638) * lu(1000) + lu(1008) = lu(1008) - lu(639) * lu(1000) + lu(1016) = lu(1016) - lu(640) * lu(1000) + lu(1018) = lu(1018) - lu(641) * lu(1000) + lu(1020) = lu(1020) - lu(642) * lu(1000) + lu(1040) = lu(1040) - lu(638) * lu(1038) + lu(1046) = lu(1046) - lu(639) * lu(1038) + lu(1056) = lu(1056) - lu(640) * lu(1038) + lu(1058) = lu(1058) - lu(641) * lu(1038) + lu(1060) = lu(1060) - lu(642) * lu(1038) + lu(1162) = lu(1162) - lu(638) * lu(1159) + lu(1168) = lu(1168) - lu(639) * lu(1159) + lu(1179) = lu(1179) - lu(640) * lu(1159) + lu(1181) = lu(1181) - lu(641) * lu(1159) + lu(1183) = lu(1183) - lu(642) * lu(1159) + lu(1205) = lu(1205) - lu(638) * lu(1203) + lu(1211) = lu(1211) - lu(639) * lu(1203) + lu(1222) = lu(1222) - lu(640) * lu(1203) + lu(1224) = lu(1224) - lu(641) * lu(1203) + lu(1226) = lu(1226) - lu(642) * lu(1203) + lu(1316) = lu(1316) - lu(638) * lu(1313) + lu(1322) = lu(1322) - lu(639) * lu(1313) + lu(1333) = lu(1333) - lu(640) * lu(1313) + lu(1335) = lu(1335) - lu(641) * lu(1313) + lu(1337) = lu(1337) - lu(642) * lu(1313) + lu(1379) = lu(1379) - lu(638) * lu(1378) + lu(1381) = lu(1381) - lu(639) * lu(1378) + lu(1392) = lu(1392) - lu(640) * lu(1378) + lu(1394) = lu(1394) - lu(641) * lu(1378) + lu(1396) = lu(1396) - lu(642) * lu(1378) + lu(644) = 1._r8 / lu(644) + lu(645) = lu(645) * lu(644) + lu(646) = lu(646) * lu(644) + lu(647) = lu(647) * lu(644) + lu(648) = lu(648) * lu(644) + lu(649) = lu(649) * lu(644) + lu(650) = lu(650) * lu(644) + lu(651) = lu(651) * lu(644) + lu(652) = lu(652) * lu(644) + lu(653) = lu(653) * lu(644) + lu(654) = lu(654) * lu(644) + lu(705) = lu(705) - lu(645) * lu(704) + lu(708) = - lu(646) * lu(704) + lu(710) = - lu(647) * lu(704) + lu(711) = lu(711) - lu(648) * lu(704) + lu(712) = - lu(649) * lu(704) + lu(717) = lu(717) - lu(650) * lu(704) + lu(718) = - lu(651) * lu(704) + lu(719) = lu(719) - lu(652) * lu(704) + lu(720) = lu(720) - lu(653) * lu(704) + lu(721) = lu(721) - lu(654) * lu(704) + lu(793) = lu(793) - lu(645) * lu(792) + lu(796) = lu(796) - lu(646) * lu(792) + lu(798) = lu(798) - lu(647) * lu(792) + lu(799) = lu(799) - lu(648) * lu(792) + lu(801) = lu(801) - lu(649) * lu(792) + lu(806) = lu(806) - lu(650) * lu(792) + lu(807) = lu(807) - lu(651) * lu(792) + lu(808) = lu(808) - lu(652) * lu(792) + lu(809) = lu(809) - lu(653) * lu(792) + lu(810) = lu(810) - lu(654) * lu(792) + lu(958) = lu(958) - lu(645) * lu(957) + lu(961) = lu(961) - lu(646) * lu(957) + lu(963) = lu(963) - lu(647) * lu(957) + lu(964) = lu(964) - lu(648) * lu(957) + lu(967) = lu(967) - lu(649) * lu(957) + lu(975) = lu(975) - lu(650) * lu(957) + lu(976) = lu(976) - lu(651) * lu(957) + lu(977) = lu(977) - lu(652) * lu(957) + lu(978) = lu(978) - lu(653) * lu(957) + lu(979) = lu(979) - lu(654) * lu(957) + lu(1002) = lu(1002) - lu(645) * lu(1001) + lu(1005) = lu(1005) - lu(646) * lu(1001) + lu(1007) = lu(1007) - lu(647) * lu(1001) + lu(1008) = lu(1008) - lu(648) * lu(1001) + lu(1010) = lu(1010) - lu(649) * lu(1001) + lu(1016) = lu(1016) - lu(650) * lu(1001) + lu(1017) = lu(1017) - lu(651) * lu(1001) + lu(1018) = lu(1018) - lu(652) * lu(1001) + lu(1019) = lu(1019) - lu(653) * lu(1001) + lu(1020) = lu(1020) - lu(654) * lu(1001) + lu(1040) = lu(1040) - lu(645) * lu(1039) + lu(1043) = lu(1043) - lu(646) * lu(1039) + lu(1045) = lu(1045) - lu(647) * lu(1039) + lu(1046) = lu(1046) - lu(648) * lu(1039) + lu(1048) = lu(1048) - lu(649) * lu(1039) + lu(1056) = lu(1056) - lu(650) * lu(1039) + lu(1057) = - lu(651) * lu(1039) + lu(1058) = lu(1058) - lu(652) * lu(1039) + lu(1059) = lu(1059) - lu(653) * lu(1039) + lu(1060) = lu(1060) - lu(654) * lu(1039) + lu(1162) = lu(1162) - lu(645) * lu(1160) + lu(1165) = lu(1165) - lu(646) * lu(1160) + lu(1167) = lu(1167) - lu(647) * lu(1160) + lu(1168) = lu(1168) - lu(648) * lu(1160) + lu(1171) = lu(1171) - lu(649) * lu(1160) + lu(1179) = lu(1179) - lu(650) * lu(1160) + lu(1180) = lu(1180) - lu(651) * lu(1160) + lu(1181) = lu(1181) - lu(652) * lu(1160) + lu(1182) = lu(1182) - lu(653) * lu(1160) + lu(1183) = lu(1183) - lu(654) * lu(1160) + lu(1205) = lu(1205) - lu(645) * lu(1204) + lu(1208) = - lu(646) * lu(1204) + lu(1210) = lu(1210) - lu(647) * lu(1204) + lu(1211) = lu(1211) - lu(648) * lu(1204) + lu(1214) = lu(1214) - lu(649) * lu(1204) + lu(1222) = lu(1222) - lu(650) * lu(1204) + lu(1223) = lu(1223) - lu(651) * lu(1204) + lu(1224) = lu(1224) - lu(652) * lu(1204) + lu(1225) = lu(1225) - lu(653) * lu(1204) + lu(1226) = lu(1226) - lu(654) * lu(1204) + lu(1316) = lu(1316) - lu(645) * lu(1314) + lu(1319) = lu(1319) - lu(646) * lu(1314) + lu(1321) = lu(1321) - lu(647) * lu(1314) + lu(1322) = lu(1322) - lu(648) * lu(1314) + lu(1325) = lu(1325) - lu(649) * lu(1314) + lu(1333) = lu(1333) - lu(650) * lu(1314) + lu(1334) = lu(1334) - lu(651) * lu(1314) + lu(1335) = lu(1335) - lu(652) * lu(1314) + lu(1336) = lu(1336) - lu(653) * lu(1314) + lu(1337) = lu(1337) - lu(654) * lu(1314) + end subroutine lu_fac14 + subroutine lu_fac15( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(657) = 1._r8 / lu(657) + lu(658) = lu(658) * lu(657) + lu(659) = lu(659) * lu(657) + lu(660) = lu(660) * lu(657) + lu(661) = lu(661) * lu(657) + lu(662) = lu(662) * lu(657) + lu(663) = lu(663) * lu(657) + lu(664) = lu(664) * lu(657) + lu(665) = lu(665) * lu(657) + lu(666) = lu(666) * lu(657) + lu(667) = lu(667) * lu(657) + lu(856) = lu(856) - lu(658) * lu(855) + lu(857) = lu(857) - lu(659) * lu(855) + lu(858) = lu(858) - lu(660) * lu(855) + lu(859) = lu(859) - lu(661) * lu(855) + lu(860) = - lu(662) * lu(855) + lu(861) = lu(861) - lu(663) * lu(855) + lu(862) = lu(862) - lu(664) * lu(855) + lu(863) = lu(863) - lu(665) * lu(855) + lu(864) = - lu(666) * lu(855) + lu(865) = lu(865) - lu(667) * lu(855) + lu(869) = lu(869) - lu(658) * lu(868) + lu(870) = lu(870) - lu(659) * lu(868) + lu(871) = lu(871) - lu(660) * lu(868) + lu(872) = lu(872) - lu(661) * lu(868) + lu(873) = - lu(662) * lu(868) + lu(874) = lu(874) - lu(663) * lu(868) + lu(875) = lu(875) - lu(664) * lu(868) + lu(876) = - lu(665) * lu(868) + lu(878) = - lu(666) * lu(868) + lu(879) = - lu(667) * lu(868) + lu(1171) = lu(1171) - lu(658) * lu(1161) + lu(1172) = lu(1172) - lu(659) * lu(1161) + lu(1176) = lu(1176) - lu(660) * lu(1161) + lu(1177) = lu(1177) - lu(661) * lu(1161) + lu(1178) = lu(1178) - lu(662) * lu(1161) + lu(1179) = lu(1179) - lu(663) * lu(1161) + lu(1182) = lu(1182) - lu(664) * lu(1161) + lu(1184) = lu(1184) - lu(665) * lu(1161) + lu(1186) = lu(1186) - lu(666) * lu(1161) + lu(1187) = lu(1187) - lu(667) * lu(1161) + lu(1236) = lu(1236) - lu(658) * lu(1235) + lu(1237) = lu(1237) - lu(659) * lu(1235) + lu(1240) = lu(1240) - lu(660) * lu(1235) + lu(1241) = - lu(661) * lu(1235) + lu(1242) = lu(1242) - lu(662) * lu(1235) + lu(1243) = lu(1243) - lu(663) * lu(1235) + lu(1246) = lu(1246) - lu(664) * lu(1235) + lu(1248) = lu(1248) - lu(665) * lu(1235) + lu(1250) = lu(1250) - lu(666) * lu(1235) + lu(1251) = lu(1251) - lu(667) * lu(1235) + lu(1254) = lu(1254) - lu(658) * lu(1252) + lu(1255) = - lu(659) * lu(1252) + lu(1257) = - lu(660) * lu(1252) + lu(1258) = - lu(661) * lu(1252) + lu(1259) = - lu(662) * lu(1252) + lu(1260) = lu(1260) - lu(663) * lu(1252) + lu(1263) = lu(1263) - lu(664) * lu(1252) + lu(1265) = - lu(665) * lu(1252) + lu(1267) = - lu(666) * lu(1252) + lu(1268) = lu(1268) - lu(667) * lu(1252) + lu(1325) = lu(1325) - lu(658) * lu(1315) + lu(1326) = lu(1326) - lu(659) * lu(1315) + lu(1330) = lu(1330) - lu(660) * lu(1315) + lu(1331) = lu(1331) - lu(661) * lu(1315) + lu(1332) = lu(1332) - lu(662) * lu(1315) + lu(1333) = lu(1333) - lu(663) * lu(1315) + lu(1336) = lu(1336) - lu(664) * lu(1315) + lu(1338) = lu(1338) - lu(665) * lu(1315) + lu(1340) = lu(1340) - lu(666) * lu(1315) + lu(1341) = lu(1341) - lu(667) * lu(1315) + lu(1350) = lu(1350) - lu(658) * lu(1348) + lu(1351) = lu(1351) - lu(659) * lu(1348) + lu(1354) = lu(1354) - lu(660) * lu(1348) + lu(1355) = lu(1355) - lu(661) * lu(1348) + lu(1356) = lu(1356) - lu(662) * lu(1348) + lu(1357) = lu(1357) - lu(663) * lu(1348) + lu(1360) = lu(1360) - lu(664) * lu(1348) + lu(1362) = lu(1362) - lu(665) * lu(1348) + lu(1364) = lu(1364) - lu(666) * lu(1348) + lu(1365) = lu(1365) - lu(667) * lu(1348) + lu(1418) = lu(1418) - lu(658) * lu(1415) + lu(1419) = lu(1419) - lu(659) * lu(1415) + lu(1423) = lu(1423) - lu(660) * lu(1415) + lu(1424) = lu(1424) - lu(661) * lu(1415) + lu(1425) = lu(1425) - lu(662) * lu(1415) + lu(1426) = lu(1426) - lu(663) * lu(1415) + lu(1429) = lu(1429) - lu(664) * lu(1415) + lu(1431) = - lu(665) * lu(1415) + lu(1433) = lu(1433) - lu(666) * lu(1415) + lu(1434) = lu(1434) - lu(667) * lu(1415) + lu(1455) = lu(1455) - lu(658) * lu(1452) + lu(1456) = lu(1456) - lu(659) * lu(1452) + lu(1460) = lu(1460) - lu(660) * lu(1452) + lu(1461) = - lu(661) * lu(1452) + lu(1462) = lu(1462) - lu(662) * lu(1452) + lu(1463) = lu(1463) - lu(663) * lu(1452) + lu(1466) = lu(1466) - lu(664) * lu(1452) + lu(1468) = lu(1468) - lu(665) * lu(1452) + lu(1470) = lu(1470) - lu(666) * lu(1452) + lu(1471) = lu(1471) - lu(667) * lu(1452) + lu(669) = 1._r8 / lu(669) + lu(670) = lu(670) * lu(669) + lu(671) = lu(671) * lu(669) + lu(672) = lu(672) * lu(669) + lu(673) = lu(673) * lu(669) + lu(674) = lu(674) * lu(669) + lu(675) = lu(675) * lu(669) + lu(676) = lu(676) * lu(669) + lu(685) = lu(685) - lu(670) * lu(683) + lu(686) = lu(686) - lu(671) * lu(683) + lu(687) = - lu(672) * lu(683) + lu(689) = lu(689) - lu(673) * lu(683) + lu(691) = lu(691) - lu(674) * lu(683) + lu(693) = lu(693) - lu(675) * lu(683) + lu(694) = lu(694) - lu(676) * lu(683) + lu(711) = lu(711) - lu(670) * lu(705) + lu(712) = lu(712) - lu(671) * lu(705) + lu(713) = - lu(672) * lu(705) + lu(715) = lu(715) - lu(673) * lu(705) + lu(717) = lu(717) - lu(674) * lu(705) + lu(720) = lu(720) - lu(675) * lu(705) + lu(721) = lu(721) - lu(676) * lu(705) + lu(733) = lu(733) - lu(670) * lu(729) + lu(734) = - lu(671) * lu(729) + lu(735) = - lu(672) * lu(729) + lu(737) = lu(737) - lu(673) * lu(729) + lu(739) = lu(739) - lu(674) * lu(729) + lu(741) = lu(741) - lu(675) * lu(729) + lu(742) = lu(742) - lu(676) * lu(729) + lu(752) = lu(752) - lu(670) * lu(748) + lu(754) = lu(754) - lu(671) * lu(748) + lu(755) = lu(755) - lu(672) * lu(748) + lu(757) = lu(757) - lu(673) * lu(748) + lu(759) = lu(759) - lu(674) * lu(748) + lu(762) = lu(762) - lu(675) * lu(748) + lu(763) = lu(763) - lu(676) * lu(748) + lu(771) = lu(771) - lu(670) * lu(769) + lu(773) = lu(773) - lu(671) * lu(769) + lu(774) = - lu(672) * lu(769) + lu(776) = lu(776) - lu(673) * lu(769) + lu(778) = lu(778) - lu(674) * lu(769) + lu(781) = - lu(675) * lu(769) + lu(782) = lu(782) - lu(676) * lu(769) + lu(799) = lu(799) - lu(670) * lu(793) + lu(801) = lu(801) - lu(671) * lu(793) + lu(802) = - lu(672) * lu(793) + lu(804) = lu(804) - lu(673) * lu(793) + lu(806) = lu(806) - lu(674) * lu(793) + lu(809) = lu(809) - lu(675) * lu(793) + lu(810) = lu(810) - lu(676) * lu(793) + lu(964) = lu(964) - lu(670) * lu(958) + lu(967) = lu(967) - lu(671) * lu(958) + lu(968) = lu(968) - lu(672) * lu(958) + lu(972) = lu(972) - lu(673) * lu(958) + lu(975) = lu(975) - lu(674) * lu(958) + lu(978) = lu(978) - lu(675) * lu(958) + lu(979) = lu(979) - lu(676) * lu(958) + lu(1008) = lu(1008) - lu(670) * lu(1002) + lu(1010) = lu(1010) - lu(671) * lu(1002) + lu(1011) = lu(1011) - lu(672) * lu(1002) + lu(1013) = lu(1013) - lu(673) * lu(1002) + lu(1016) = lu(1016) - lu(674) * lu(1002) + lu(1019) = lu(1019) - lu(675) * lu(1002) + lu(1020) = lu(1020) - lu(676) * lu(1002) + lu(1046) = lu(1046) - lu(670) * lu(1040) + lu(1048) = lu(1048) - lu(671) * lu(1040) + lu(1049) = lu(1049) - lu(672) * lu(1040) + lu(1053) = lu(1053) - lu(673) * lu(1040) + lu(1056) = lu(1056) - lu(674) * lu(1040) + lu(1059) = lu(1059) - lu(675) * lu(1040) + lu(1060) = lu(1060) - lu(676) * lu(1040) + lu(1168) = lu(1168) - lu(670) * lu(1162) + lu(1171) = lu(1171) - lu(671) * lu(1162) + lu(1172) = lu(1172) - lu(672) * lu(1162) + lu(1176) = lu(1176) - lu(673) * lu(1162) + lu(1179) = lu(1179) - lu(674) * lu(1162) + lu(1182) = lu(1182) - lu(675) * lu(1162) + lu(1183) = lu(1183) - lu(676) * lu(1162) + lu(1211) = lu(1211) - lu(670) * lu(1205) + lu(1214) = lu(1214) - lu(671) * lu(1205) + lu(1215) = lu(1215) - lu(672) * lu(1205) + lu(1219) = lu(1219) - lu(673) * lu(1205) + lu(1222) = lu(1222) - lu(674) * lu(1205) + lu(1225) = lu(1225) - lu(675) * lu(1205) + lu(1226) = lu(1226) - lu(676) * lu(1205) + lu(1322) = lu(1322) - lu(670) * lu(1316) + lu(1325) = lu(1325) - lu(671) * lu(1316) + lu(1326) = lu(1326) - lu(672) * lu(1316) + lu(1330) = lu(1330) - lu(673) * lu(1316) + lu(1333) = lu(1333) - lu(674) * lu(1316) + lu(1336) = lu(1336) - lu(675) * lu(1316) + lu(1337) = lu(1337) - lu(676) * lu(1316) + lu(1381) = lu(1381) - lu(670) * lu(1379) + lu(1384) = lu(1384) - lu(671) * lu(1379) + lu(1385) = lu(1385) - lu(672) * lu(1379) + lu(1389) = lu(1389) - lu(673) * lu(1379) + lu(1392) = lu(1392) - lu(674) * lu(1379) + lu(1395) = lu(1395) - lu(675) * lu(1379) + lu(1396) = lu(1396) - lu(676) * lu(1379) + lu(684) = 1._r8 / lu(684) + lu(685) = lu(685) * lu(684) + lu(686) = lu(686) * lu(684) + lu(687) = lu(687) * lu(684) + lu(688) = lu(688) * lu(684) + lu(689) = lu(689) * lu(684) + lu(690) = lu(690) * lu(684) + lu(691) = lu(691) * lu(684) + lu(692) = lu(692) * lu(684) + lu(693) = lu(693) * lu(684) + lu(694) = lu(694) * lu(684) + lu(695) = lu(695) * lu(684) + lu(711) = lu(711) - lu(685) * lu(706) + lu(712) = lu(712) - lu(686) * lu(706) + lu(713) = lu(713) - lu(687) * lu(706) + lu(714) = lu(714) - lu(688) * lu(706) + lu(715) = lu(715) - lu(689) * lu(706) + lu(716) = lu(716) - lu(690) * lu(706) + lu(717) = lu(717) - lu(691) * lu(706) + lu(719) = lu(719) - lu(692) * lu(706) + lu(720) = lu(720) - lu(693) * lu(706) + lu(721) = lu(721) - lu(694) * lu(706) + lu(722) = lu(722) - lu(695) * lu(706) + lu(733) = lu(733) - lu(685) * lu(730) + lu(734) = lu(734) - lu(686) * lu(730) + lu(735) = lu(735) - lu(687) * lu(730) + lu(736) = lu(736) - lu(688) * lu(730) + lu(737) = lu(737) - lu(689) * lu(730) + lu(738) = lu(738) - lu(690) * lu(730) + lu(739) = lu(739) - lu(691) * lu(730) + lu(740) = lu(740) - lu(692) * lu(730) + lu(741) = lu(741) - lu(693) * lu(730) + lu(742) = lu(742) - lu(694) * lu(730) + lu(743) = lu(743) - lu(695) * lu(730) + lu(799) = lu(799) - lu(685) * lu(794) + lu(801) = lu(801) - lu(686) * lu(794) + lu(802) = lu(802) - lu(687) * lu(794) + lu(803) = lu(803) - lu(688) * lu(794) + lu(804) = lu(804) - lu(689) * lu(794) + lu(805) = lu(805) - lu(690) * lu(794) + lu(806) = lu(806) - lu(691) * lu(794) + lu(808) = lu(808) - lu(692) * lu(794) + lu(809) = lu(809) - lu(693) * lu(794) + lu(810) = lu(810) - lu(694) * lu(794) + lu(811) = lu(811) - lu(695) * lu(794) + lu(964) = lu(964) - lu(685) * lu(959) + lu(967) = lu(967) - lu(686) * lu(959) + lu(968) = lu(968) - lu(687) * lu(959) + lu(971) = lu(971) - lu(688) * lu(959) + lu(972) = lu(972) - lu(689) * lu(959) + lu(973) = lu(973) - lu(690) * lu(959) + lu(975) = lu(975) - lu(691) * lu(959) + lu(977) = lu(977) - lu(692) * lu(959) + lu(978) = lu(978) - lu(693) * lu(959) + lu(979) = lu(979) - lu(694) * lu(959) + lu(981) = lu(981) - lu(695) * lu(959) + lu(1008) = lu(1008) - lu(685) * lu(1003) + lu(1010) = lu(1010) - lu(686) * lu(1003) + lu(1011) = lu(1011) - lu(687) * lu(1003) + lu(1012) = lu(1012) - lu(688) * lu(1003) + lu(1013) = lu(1013) - lu(689) * lu(1003) + lu(1014) = lu(1014) - lu(690) * lu(1003) + lu(1016) = lu(1016) - lu(691) * lu(1003) + lu(1018) = lu(1018) - lu(692) * lu(1003) + lu(1019) = lu(1019) - lu(693) * lu(1003) + lu(1020) = lu(1020) - lu(694) * lu(1003) + lu(1022) = lu(1022) - lu(695) * lu(1003) + lu(1046) = lu(1046) - lu(685) * lu(1041) + lu(1048) = lu(1048) - lu(686) * lu(1041) + lu(1049) = lu(1049) - lu(687) * lu(1041) + lu(1052) = lu(1052) - lu(688) * lu(1041) + lu(1053) = lu(1053) - lu(689) * lu(1041) + lu(1054) = lu(1054) - lu(690) * lu(1041) + lu(1056) = lu(1056) - lu(691) * lu(1041) + lu(1058) = lu(1058) - lu(692) * lu(1041) + lu(1059) = lu(1059) - lu(693) * lu(1041) + lu(1060) = lu(1060) - lu(694) * lu(1041) + lu(1062) = lu(1062) - lu(695) * lu(1041) + lu(1168) = lu(1168) - lu(685) * lu(1163) + lu(1171) = lu(1171) - lu(686) * lu(1163) + lu(1172) = lu(1172) - lu(687) * lu(1163) + lu(1175) = lu(1175) - lu(688) * lu(1163) + lu(1176) = lu(1176) - lu(689) * lu(1163) + lu(1177) = lu(1177) - lu(690) * lu(1163) + lu(1179) = lu(1179) - lu(691) * lu(1163) + lu(1181) = lu(1181) - lu(692) * lu(1163) + lu(1182) = lu(1182) - lu(693) * lu(1163) + lu(1183) = lu(1183) - lu(694) * lu(1163) + lu(1185) = lu(1185) - lu(695) * lu(1163) + lu(1211) = lu(1211) - lu(685) * lu(1206) + lu(1214) = lu(1214) - lu(686) * lu(1206) + lu(1215) = lu(1215) - lu(687) * lu(1206) + lu(1218) = lu(1218) - lu(688) * lu(1206) + lu(1219) = lu(1219) - lu(689) * lu(1206) + lu(1220) = lu(1220) - lu(690) * lu(1206) + lu(1222) = lu(1222) - lu(691) * lu(1206) + lu(1224) = lu(1224) - lu(692) * lu(1206) + lu(1225) = lu(1225) - lu(693) * lu(1206) + lu(1226) = lu(1226) - lu(694) * lu(1206) + lu(1228) = lu(1228) - lu(695) * lu(1206) + lu(1322) = lu(1322) - lu(685) * lu(1317) + lu(1325) = lu(1325) - lu(686) * lu(1317) + lu(1326) = lu(1326) - lu(687) * lu(1317) + lu(1329) = lu(1329) - lu(688) * lu(1317) + lu(1330) = lu(1330) - lu(689) * lu(1317) + lu(1331) = lu(1331) - lu(690) * lu(1317) + lu(1333) = lu(1333) - lu(691) * lu(1317) + lu(1335) = lu(1335) - lu(692) * lu(1317) + lu(1336) = lu(1336) - lu(693) * lu(1317) + lu(1337) = lu(1337) - lu(694) * lu(1317) + lu(1339) = lu(1339) - lu(695) * lu(1317) + end subroutine lu_fac15 + subroutine lu_fac16( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(707) = 1._r8 / lu(707) + lu(708) = lu(708) * lu(707) + lu(709) = lu(709) * lu(707) + lu(710) = lu(710) * lu(707) + lu(711) = lu(711) * lu(707) + lu(712) = lu(712) * lu(707) + lu(713) = lu(713) * lu(707) + lu(714) = lu(714) * lu(707) + lu(715) = lu(715) * lu(707) + lu(716) = lu(716) * lu(707) + lu(717) = lu(717) * lu(707) + lu(718) = lu(718) * lu(707) + lu(719) = lu(719) * lu(707) + lu(720) = lu(720) * lu(707) + lu(721) = lu(721) * lu(707) + lu(722) = lu(722) * lu(707) + lu(796) = lu(796) - lu(708) * lu(795) + lu(797) = lu(797) - lu(709) * lu(795) + lu(798) = lu(798) - lu(710) * lu(795) + lu(799) = lu(799) - lu(711) * lu(795) + lu(801) = lu(801) - lu(712) * lu(795) + lu(802) = lu(802) - lu(713) * lu(795) + lu(803) = lu(803) - lu(714) * lu(795) + lu(804) = lu(804) - lu(715) * lu(795) + lu(805) = lu(805) - lu(716) * lu(795) + lu(806) = lu(806) - lu(717) * lu(795) + lu(807) = lu(807) - lu(718) * lu(795) + lu(808) = lu(808) - lu(719) * lu(795) + lu(809) = lu(809) - lu(720) * lu(795) + lu(810) = lu(810) - lu(721) * lu(795) + lu(811) = lu(811) - lu(722) * lu(795) + lu(961) = lu(961) - lu(708) * lu(960) + lu(962) = lu(962) - lu(709) * lu(960) + lu(963) = lu(963) - lu(710) * lu(960) + lu(964) = lu(964) - lu(711) * lu(960) + lu(967) = lu(967) - lu(712) * lu(960) + lu(968) = lu(968) - lu(713) * lu(960) + lu(971) = lu(971) - lu(714) * lu(960) + lu(972) = lu(972) - lu(715) * lu(960) + lu(973) = lu(973) - lu(716) * lu(960) + lu(975) = lu(975) - lu(717) * lu(960) + lu(976) = lu(976) - lu(718) * lu(960) + lu(977) = lu(977) - lu(719) * lu(960) + lu(978) = lu(978) - lu(720) * lu(960) + lu(979) = lu(979) - lu(721) * lu(960) + lu(981) = lu(981) - lu(722) * lu(960) + lu(1005) = lu(1005) - lu(708) * lu(1004) + lu(1006) = lu(1006) - lu(709) * lu(1004) + lu(1007) = lu(1007) - lu(710) * lu(1004) + lu(1008) = lu(1008) - lu(711) * lu(1004) + lu(1010) = lu(1010) - lu(712) * lu(1004) + lu(1011) = lu(1011) - lu(713) * lu(1004) + lu(1012) = lu(1012) - lu(714) * lu(1004) + lu(1013) = lu(1013) - lu(715) * lu(1004) + lu(1014) = lu(1014) - lu(716) * lu(1004) + lu(1016) = lu(1016) - lu(717) * lu(1004) + lu(1017) = lu(1017) - lu(718) * lu(1004) + lu(1018) = lu(1018) - lu(719) * lu(1004) + lu(1019) = lu(1019) - lu(720) * lu(1004) + lu(1020) = lu(1020) - lu(721) * lu(1004) + lu(1022) = lu(1022) - lu(722) * lu(1004) + lu(1043) = lu(1043) - lu(708) * lu(1042) + lu(1044) = lu(1044) - lu(709) * lu(1042) + lu(1045) = lu(1045) - lu(710) * lu(1042) + lu(1046) = lu(1046) - lu(711) * lu(1042) + lu(1048) = lu(1048) - lu(712) * lu(1042) + lu(1049) = lu(1049) - lu(713) * lu(1042) + lu(1052) = lu(1052) - lu(714) * lu(1042) + lu(1053) = lu(1053) - lu(715) * lu(1042) + lu(1054) = lu(1054) - lu(716) * lu(1042) + lu(1056) = lu(1056) - lu(717) * lu(1042) + lu(1057) = lu(1057) - lu(718) * lu(1042) + lu(1058) = lu(1058) - lu(719) * lu(1042) + lu(1059) = lu(1059) - lu(720) * lu(1042) + lu(1060) = lu(1060) - lu(721) * lu(1042) + lu(1062) = lu(1062) - lu(722) * lu(1042) + lu(1165) = lu(1165) - lu(708) * lu(1164) + lu(1166) = lu(1166) - lu(709) * lu(1164) + lu(1167) = lu(1167) - lu(710) * lu(1164) + lu(1168) = lu(1168) - lu(711) * lu(1164) + lu(1171) = lu(1171) - lu(712) * lu(1164) + lu(1172) = lu(1172) - lu(713) * lu(1164) + lu(1175) = lu(1175) - lu(714) * lu(1164) + lu(1176) = lu(1176) - lu(715) * lu(1164) + lu(1177) = lu(1177) - lu(716) * lu(1164) + lu(1179) = lu(1179) - lu(717) * lu(1164) + lu(1180) = lu(1180) - lu(718) * lu(1164) + lu(1181) = lu(1181) - lu(719) * lu(1164) + lu(1182) = lu(1182) - lu(720) * lu(1164) + lu(1183) = lu(1183) - lu(721) * lu(1164) + lu(1185) = lu(1185) - lu(722) * lu(1164) + lu(1208) = lu(1208) - lu(708) * lu(1207) + lu(1209) = lu(1209) - lu(709) * lu(1207) + lu(1210) = lu(1210) - lu(710) * lu(1207) + lu(1211) = lu(1211) - lu(711) * lu(1207) + lu(1214) = lu(1214) - lu(712) * lu(1207) + lu(1215) = lu(1215) - lu(713) * lu(1207) + lu(1218) = lu(1218) - lu(714) * lu(1207) + lu(1219) = lu(1219) - lu(715) * lu(1207) + lu(1220) = lu(1220) - lu(716) * lu(1207) + lu(1222) = lu(1222) - lu(717) * lu(1207) + lu(1223) = lu(1223) - lu(718) * lu(1207) + lu(1224) = lu(1224) - lu(719) * lu(1207) + lu(1225) = lu(1225) - lu(720) * lu(1207) + lu(1226) = lu(1226) - lu(721) * lu(1207) + lu(1228) = lu(1228) - lu(722) * lu(1207) + lu(1319) = lu(1319) - lu(708) * lu(1318) + lu(1320) = lu(1320) - lu(709) * lu(1318) + lu(1321) = lu(1321) - lu(710) * lu(1318) + lu(1322) = lu(1322) - lu(711) * lu(1318) + lu(1325) = lu(1325) - lu(712) * lu(1318) + lu(1326) = lu(1326) - lu(713) * lu(1318) + lu(1329) = lu(1329) - lu(714) * lu(1318) + lu(1330) = lu(1330) - lu(715) * lu(1318) + lu(1331) = lu(1331) - lu(716) * lu(1318) + lu(1333) = lu(1333) - lu(717) * lu(1318) + lu(1334) = lu(1334) - lu(718) * lu(1318) + lu(1335) = lu(1335) - lu(719) * lu(1318) + lu(1336) = lu(1336) - lu(720) * lu(1318) + lu(1337) = lu(1337) - lu(721) * lu(1318) + lu(1339) = lu(1339) - lu(722) * lu(1318) + lu(731) = 1._r8 / lu(731) + lu(732) = lu(732) * lu(731) + lu(733) = lu(733) * lu(731) + lu(734) = lu(734) * lu(731) + lu(735) = lu(735) * lu(731) + lu(736) = lu(736) * lu(731) + lu(737) = lu(737) * lu(731) + lu(738) = lu(738) * lu(731) + lu(739) = lu(739) * lu(731) + lu(740) = lu(740) * lu(731) + lu(741) = lu(741) * lu(731) + lu(742) = lu(742) * lu(731) + lu(743) = lu(743) * lu(731) + lu(751) = - lu(732) * lu(749) + lu(752) = lu(752) - lu(733) * lu(749) + lu(754) = lu(754) - lu(734) * lu(749) + lu(755) = lu(755) - lu(735) * lu(749) + lu(756) = lu(756) - lu(736) * lu(749) + lu(757) = lu(757) - lu(737) * lu(749) + lu(758) = lu(758) - lu(738) * lu(749) + lu(759) = lu(759) - lu(739) * lu(749) + lu(761) = lu(761) - lu(740) * lu(749) + lu(762) = lu(762) - lu(741) * lu(749) + lu(763) = lu(763) - lu(742) * lu(749) + lu(764) = lu(764) - lu(743) * lu(749) + lu(798) = lu(798) - lu(732) * lu(796) + lu(799) = lu(799) - lu(733) * lu(796) + lu(801) = lu(801) - lu(734) * lu(796) + lu(802) = lu(802) - lu(735) * lu(796) + lu(803) = lu(803) - lu(736) * lu(796) + lu(804) = lu(804) - lu(737) * lu(796) + lu(805) = lu(805) - lu(738) * lu(796) + lu(806) = lu(806) - lu(739) * lu(796) + lu(808) = lu(808) - lu(740) * lu(796) + lu(809) = lu(809) - lu(741) * lu(796) + lu(810) = lu(810) - lu(742) * lu(796) + lu(811) = lu(811) - lu(743) * lu(796) + lu(963) = lu(963) - lu(732) * lu(961) + lu(964) = lu(964) - lu(733) * lu(961) + lu(967) = lu(967) - lu(734) * lu(961) + lu(968) = lu(968) - lu(735) * lu(961) + lu(971) = lu(971) - lu(736) * lu(961) + lu(972) = lu(972) - lu(737) * lu(961) + lu(973) = lu(973) - lu(738) * lu(961) + lu(975) = lu(975) - lu(739) * lu(961) + lu(977) = lu(977) - lu(740) * lu(961) + lu(978) = lu(978) - lu(741) * lu(961) + lu(979) = lu(979) - lu(742) * lu(961) + lu(981) = lu(981) - lu(743) * lu(961) + lu(1007) = lu(1007) - lu(732) * lu(1005) + lu(1008) = lu(1008) - lu(733) * lu(1005) + lu(1010) = lu(1010) - lu(734) * lu(1005) + lu(1011) = lu(1011) - lu(735) * lu(1005) + lu(1012) = lu(1012) - lu(736) * lu(1005) + lu(1013) = lu(1013) - lu(737) * lu(1005) + lu(1014) = lu(1014) - lu(738) * lu(1005) + lu(1016) = lu(1016) - lu(739) * lu(1005) + lu(1018) = lu(1018) - lu(740) * lu(1005) + lu(1019) = lu(1019) - lu(741) * lu(1005) + lu(1020) = lu(1020) - lu(742) * lu(1005) + lu(1022) = lu(1022) - lu(743) * lu(1005) + lu(1045) = lu(1045) - lu(732) * lu(1043) + lu(1046) = lu(1046) - lu(733) * lu(1043) + lu(1048) = lu(1048) - lu(734) * lu(1043) + lu(1049) = lu(1049) - lu(735) * lu(1043) + lu(1052) = lu(1052) - lu(736) * lu(1043) + lu(1053) = lu(1053) - lu(737) * lu(1043) + lu(1054) = lu(1054) - lu(738) * lu(1043) + lu(1056) = lu(1056) - lu(739) * lu(1043) + lu(1058) = lu(1058) - lu(740) * lu(1043) + lu(1059) = lu(1059) - lu(741) * lu(1043) + lu(1060) = lu(1060) - lu(742) * lu(1043) + lu(1062) = lu(1062) - lu(743) * lu(1043) + lu(1167) = lu(1167) - lu(732) * lu(1165) + lu(1168) = lu(1168) - lu(733) * lu(1165) + lu(1171) = lu(1171) - lu(734) * lu(1165) + lu(1172) = lu(1172) - lu(735) * lu(1165) + lu(1175) = lu(1175) - lu(736) * lu(1165) + lu(1176) = lu(1176) - lu(737) * lu(1165) + lu(1177) = lu(1177) - lu(738) * lu(1165) + lu(1179) = lu(1179) - lu(739) * lu(1165) + lu(1181) = lu(1181) - lu(740) * lu(1165) + lu(1182) = lu(1182) - lu(741) * lu(1165) + lu(1183) = lu(1183) - lu(742) * lu(1165) + lu(1185) = lu(1185) - lu(743) * lu(1165) + lu(1210) = lu(1210) - lu(732) * lu(1208) + lu(1211) = lu(1211) - lu(733) * lu(1208) + lu(1214) = lu(1214) - lu(734) * lu(1208) + lu(1215) = lu(1215) - lu(735) * lu(1208) + lu(1218) = lu(1218) - lu(736) * lu(1208) + lu(1219) = lu(1219) - lu(737) * lu(1208) + lu(1220) = lu(1220) - lu(738) * lu(1208) + lu(1222) = lu(1222) - lu(739) * lu(1208) + lu(1224) = lu(1224) - lu(740) * lu(1208) + lu(1225) = lu(1225) - lu(741) * lu(1208) + lu(1226) = lu(1226) - lu(742) * lu(1208) + lu(1228) = lu(1228) - lu(743) * lu(1208) + lu(1321) = lu(1321) - lu(732) * lu(1319) + lu(1322) = lu(1322) - lu(733) * lu(1319) + lu(1325) = lu(1325) - lu(734) * lu(1319) + lu(1326) = lu(1326) - lu(735) * lu(1319) + lu(1329) = lu(1329) - lu(736) * lu(1319) + lu(1330) = lu(1330) - lu(737) * lu(1319) + lu(1331) = lu(1331) - lu(738) * lu(1319) + lu(1333) = lu(1333) - lu(739) * lu(1319) + lu(1335) = lu(1335) - lu(740) * lu(1319) + lu(1336) = lu(1336) - lu(741) * lu(1319) + lu(1337) = lu(1337) - lu(742) * lu(1319) + lu(1339) = lu(1339) - lu(743) * lu(1319) + lu(750) = 1._r8 / lu(750) + lu(751) = lu(751) * lu(750) + lu(752) = lu(752) * lu(750) + lu(753) = lu(753) * lu(750) + lu(754) = lu(754) * lu(750) + lu(755) = lu(755) * lu(750) + lu(756) = lu(756) * lu(750) + lu(757) = lu(757) * lu(750) + lu(758) = lu(758) * lu(750) + lu(759) = lu(759) * lu(750) + lu(760) = lu(760) * lu(750) + lu(761) = lu(761) * lu(750) + lu(762) = lu(762) * lu(750) + lu(763) = lu(763) * lu(750) + lu(764) = lu(764) * lu(750) + lu(798) = lu(798) - lu(751) * lu(797) + lu(799) = lu(799) - lu(752) * lu(797) + lu(800) = - lu(753) * lu(797) + lu(801) = lu(801) - lu(754) * lu(797) + lu(802) = lu(802) - lu(755) * lu(797) + lu(803) = lu(803) - lu(756) * lu(797) + lu(804) = lu(804) - lu(757) * lu(797) + lu(805) = lu(805) - lu(758) * lu(797) + lu(806) = lu(806) - lu(759) * lu(797) + lu(807) = lu(807) - lu(760) * lu(797) + lu(808) = lu(808) - lu(761) * lu(797) + lu(809) = lu(809) - lu(762) * lu(797) + lu(810) = lu(810) - lu(763) * lu(797) + lu(811) = lu(811) - lu(764) * lu(797) + lu(963) = lu(963) - lu(751) * lu(962) + lu(964) = lu(964) - lu(752) * lu(962) + lu(966) = lu(966) - lu(753) * lu(962) + lu(967) = lu(967) - lu(754) * lu(962) + lu(968) = lu(968) - lu(755) * lu(962) + lu(971) = lu(971) - lu(756) * lu(962) + lu(972) = lu(972) - lu(757) * lu(962) + lu(973) = lu(973) - lu(758) * lu(962) + lu(975) = lu(975) - lu(759) * lu(962) + lu(976) = lu(976) - lu(760) * lu(962) + lu(977) = lu(977) - lu(761) * lu(962) + lu(978) = lu(978) - lu(762) * lu(962) + lu(979) = lu(979) - lu(763) * lu(962) + lu(981) = lu(981) - lu(764) * lu(962) + lu(1007) = lu(1007) - lu(751) * lu(1006) + lu(1008) = lu(1008) - lu(752) * lu(1006) + lu(1009) = lu(1009) - lu(753) * lu(1006) + lu(1010) = lu(1010) - lu(754) * lu(1006) + lu(1011) = lu(1011) - lu(755) * lu(1006) + lu(1012) = lu(1012) - lu(756) * lu(1006) + lu(1013) = lu(1013) - lu(757) * lu(1006) + lu(1014) = lu(1014) - lu(758) * lu(1006) + lu(1016) = lu(1016) - lu(759) * lu(1006) + lu(1017) = lu(1017) - lu(760) * lu(1006) + lu(1018) = lu(1018) - lu(761) * lu(1006) + lu(1019) = lu(1019) - lu(762) * lu(1006) + lu(1020) = lu(1020) - lu(763) * lu(1006) + lu(1022) = lu(1022) - lu(764) * lu(1006) + lu(1045) = lu(1045) - lu(751) * lu(1044) + lu(1046) = lu(1046) - lu(752) * lu(1044) + lu(1047) = lu(1047) - lu(753) * lu(1044) + lu(1048) = lu(1048) - lu(754) * lu(1044) + lu(1049) = lu(1049) - lu(755) * lu(1044) + lu(1052) = lu(1052) - lu(756) * lu(1044) + lu(1053) = lu(1053) - lu(757) * lu(1044) + lu(1054) = lu(1054) - lu(758) * lu(1044) + lu(1056) = lu(1056) - lu(759) * lu(1044) + lu(1057) = lu(1057) - lu(760) * lu(1044) + lu(1058) = lu(1058) - lu(761) * lu(1044) + lu(1059) = lu(1059) - lu(762) * lu(1044) + lu(1060) = lu(1060) - lu(763) * lu(1044) + lu(1062) = lu(1062) - lu(764) * lu(1044) + lu(1167) = lu(1167) - lu(751) * lu(1166) + lu(1168) = lu(1168) - lu(752) * lu(1166) + lu(1170) = lu(1170) - lu(753) * lu(1166) + lu(1171) = lu(1171) - lu(754) * lu(1166) + lu(1172) = lu(1172) - lu(755) * lu(1166) + lu(1175) = lu(1175) - lu(756) * lu(1166) + lu(1176) = lu(1176) - lu(757) * lu(1166) + lu(1177) = lu(1177) - lu(758) * lu(1166) + lu(1179) = lu(1179) - lu(759) * lu(1166) + lu(1180) = lu(1180) - lu(760) * lu(1166) + lu(1181) = lu(1181) - lu(761) * lu(1166) + lu(1182) = lu(1182) - lu(762) * lu(1166) + lu(1183) = lu(1183) - lu(763) * lu(1166) + lu(1185) = lu(1185) - lu(764) * lu(1166) + lu(1210) = lu(1210) - lu(751) * lu(1209) + lu(1211) = lu(1211) - lu(752) * lu(1209) + lu(1213) = lu(1213) - lu(753) * lu(1209) + lu(1214) = lu(1214) - lu(754) * lu(1209) + lu(1215) = lu(1215) - lu(755) * lu(1209) + lu(1218) = lu(1218) - lu(756) * lu(1209) + lu(1219) = lu(1219) - lu(757) * lu(1209) + lu(1220) = lu(1220) - lu(758) * lu(1209) + lu(1222) = lu(1222) - lu(759) * lu(1209) + lu(1223) = lu(1223) - lu(760) * lu(1209) + lu(1224) = lu(1224) - lu(761) * lu(1209) + lu(1225) = lu(1225) - lu(762) * lu(1209) + lu(1226) = lu(1226) - lu(763) * lu(1209) + lu(1228) = lu(1228) - lu(764) * lu(1209) + lu(1321) = lu(1321) - lu(751) * lu(1320) + lu(1322) = lu(1322) - lu(752) * lu(1320) + lu(1324) = lu(1324) - lu(753) * lu(1320) + lu(1325) = lu(1325) - lu(754) * lu(1320) + lu(1326) = lu(1326) - lu(755) * lu(1320) + lu(1329) = lu(1329) - lu(756) * lu(1320) + lu(1330) = lu(1330) - lu(757) * lu(1320) + lu(1331) = lu(1331) - lu(758) * lu(1320) + lu(1333) = lu(1333) - lu(759) * lu(1320) + lu(1334) = lu(1334) - lu(760) * lu(1320) + lu(1335) = lu(1335) - lu(761) * lu(1320) + lu(1336) = lu(1336) - lu(762) * lu(1320) + lu(1337) = lu(1337) - lu(763) * lu(1320) + lu(1339) = lu(1339) - lu(764) * lu(1320) + lu(770) = 1._r8 / lu(770) + lu(771) = lu(771) * lu(770) + lu(772) = lu(772) * lu(770) + lu(773) = lu(773) * lu(770) + lu(774) = lu(774) * lu(770) + lu(775) = lu(775) * lu(770) + lu(776) = lu(776) * lu(770) + lu(777) = lu(777) * lu(770) + lu(778) = lu(778) * lu(770) + lu(779) = lu(779) * lu(770) + lu(780) = lu(780) * lu(770) + lu(781) = lu(781) * lu(770) + lu(782) = lu(782) * lu(770) + lu(783) = lu(783) * lu(770) + lu(799) = lu(799) - lu(771) * lu(798) + lu(800) = lu(800) - lu(772) * lu(798) + lu(801) = lu(801) - lu(773) * lu(798) + lu(802) = lu(802) - lu(774) * lu(798) + lu(803) = lu(803) - lu(775) * lu(798) + lu(804) = lu(804) - lu(776) * lu(798) + lu(805) = lu(805) - lu(777) * lu(798) + lu(806) = lu(806) - lu(778) * lu(798) + lu(807) = lu(807) - lu(779) * lu(798) + lu(808) = lu(808) - lu(780) * lu(798) + lu(809) = lu(809) - lu(781) * lu(798) + lu(810) = lu(810) - lu(782) * lu(798) + lu(811) = lu(811) - lu(783) * lu(798) + lu(964) = lu(964) - lu(771) * lu(963) + lu(966) = lu(966) - lu(772) * lu(963) + lu(967) = lu(967) - lu(773) * lu(963) + lu(968) = lu(968) - lu(774) * lu(963) + lu(971) = lu(971) - lu(775) * lu(963) + lu(972) = lu(972) - lu(776) * lu(963) + lu(973) = lu(973) - lu(777) * lu(963) + lu(975) = lu(975) - lu(778) * lu(963) + lu(976) = lu(976) - lu(779) * lu(963) + lu(977) = lu(977) - lu(780) * lu(963) + lu(978) = lu(978) - lu(781) * lu(963) + lu(979) = lu(979) - lu(782) * lu(963) + lu(981) = lu(981) - lu(783) * lu(963) + lu(1008) = lu(1008) - lu(771) * lu(1007) + lu(1009) = lu(1009) - lu(772) * lu(1007) + lu(1010) = lu(1010) - lu(773) * lu(1007) + lu(1011) = lu(1011) - lu(774) * lu(1007) + lu(1012) = lu(1012) - lu(775) * lu(1007) + lu(1013) = lu(1013) - lu(776) * lu(1007) + lu(1014) = lu(1014) - lu(777) * lu(1007) + lu(1016) = lu(1016) - lu(778) * lu(1007) + lu(1017) = lu(1017) - lu(779) * lu(1007) + lu(1018) = lu(1018) - lu(780) * lu(1007) + lu(1019) = lu(1019) - lu(781) * lu(1007) + lu(1020) = lu(1020) - lu(782) * lu(1007) + lu(1022) = lu(1022) - lu(783) * lu(1007) + lu(1046) = lu(1046) - lu(771) * lu(1045) + lu(1047) = lu(1047) - lu(772) * lu(1045) + lu(1048) = lu(1048) - lu(773) * lu(1045) + lu(1049) = lu(1049) - lu(774) * lu(1045) + lu(1052) = lu(1052) - lu(775) * lu(1045) + lu(1053) = lu(1053) - lu(776) * lu(1045) + lu(1054) = lu(1054) - lu(777) * lu(1045) + lu(1056) = lu(1056) - lu(778) * lu(1045) + lu(1057) = lu(1057) - lu(779) * lu(1045) + lu(1058) = lu(1058) - lu(780) * lu(1045) + lu(1059) = lu(1059) - lu(781) * lu(1045) + lu(1060) = lu(1060) - lu(782) * lu(1045) + lu(1062) = lu(1062) - lu(783) * lu(1045) + lu(1168) = lu(1168) - lu(771) * lu(1167) + lu(1170) = lu(1170) - lu(772) * lu(1167) + lu(1171) = lu(1171) - lu(773) * lu(1167) + lu(1172) = lu(1172) - lu(774) * lu(1167) + lu(1175) = lu(1175) - lu(775) * lu(1167) + lu(1176) = lu(1176) - lu(776) * lu(1167) + lu(1177) = lu(1177) - lu(777) * lu(1167) + lu(1179) = lu(1179) - lu(778) * lu(1167) + lu(1180) = lu(1180) - lu(779) * lu(1167) + lu(1181) = lu(1181) - lu(780) * lu(1167) + lu(1182) = lu(1182) - lu(781) * lu(1167) + lu(1183) = lu(1183) - lu(782) * lu(1167) + lu(1185) = lu(1185) - lu(783) * lu(1167) + lu(1211) = lu(1211) - lu(771) * lu(1210) + lu(1213) = lu(1213) - lu(772) * lu(1210) + lu(1214) = lu(1214) - lu(773) * lu(1210) + lu(1215) = lu(1215) - lu(774) * lu(1210) + lu(1218) = lu(1218) - lu(775) * lu(1210) + lu(1219) = lu(1219) - lu(776) * lu(1210) + lu(1220) = lu(1220) - lu(777) * lu(1210) + lu(1222) = lu(1222) - lu(778) * lu(1210) + lu(1223) = lu(1223) - lu(779) * lu(1210) + lu(1224) = lu(1224) - lu(780) * lu(1210) + lu(1225) = lu(1225) - lu(781) * lu(1210) + lu(1226) = lu(1226) - lu(782) * lu(1210) + lu(1228) = lu(1228) - lu(783) * lu(1210) + lu(1322) = lu(1322) - lu(771) * lu(1321) + lu(1324) = lu(1324) - lu(772) * lu(1321) + lu(1325) = lu(1325) - lu(773) * lu(1321) + lu(1326) = lu(1326) - lu(774) * lu(1321) + lu(1329) = lu(1329) - lu(775) * lu(1321) + lu(1330) = lu(1330) - lu(776) * lu(1321) + lu(1331) = lu(1331) - lu(777) * lu(1321) + lu(1333) = lu(1333) - lu(778) * lu(1321) + lu(1334) = lu(1334) - lu(779) * lu(1321) + lu(1335) = lu(1335) - lu(780) * lu(1321) + lu(1336) = lu(1336) - lu(781) * lu(1321) + lu(1337) = lu(1337) - lu(782) * lu(1321) + lu(1339) = lu(1339) - lu(783) * lu(1321) + lu(1381) = lu(1381) - lu(771) * lu(1380) + lu(1383) = lu(1383) - lu(772) * lu(1380) + lu(1384) = lu(1384) - lu(773) * lu(1380) + lu(1385) = lu(1385) - lu(774) * lu(1380) + lu(1388) = lu(1388) - lu(775) * lu(1380) + lu(1389) = lu(1389) - lu(776) * lu(1380) + lu(1390) = lu(1390) - lu(777) * lu(1380) + lu(1392) = lu(1392) - lu(778) * lu(1380) + lu(1393) = lu(1393) - lu(779) * lu(1380) + lu(1394) = lu(1394) - lu(780) * lu(1380) + lu(1395) = lu(1395) - lu(781) * lu(1380) + lu(1396) = lu(1396) - lu(782) * lu(1380) + lu(1398) = lu(1398) - lu(783) * lu(1380) + end subroutine lu_fac16 + subroutine lu_fac17( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(799) = 1._r8 / lu(799) + lu(800) = lu(800) * lu(799) + lu(801) = lu(801) * lu(799) + lu(802) = lu(802) * lu(799) + lu(803) = lu(803) * lu(799) + lu(804) = lu(804) * lu(799) + lu(805) = lu(805) * lu(799) + lu(806) = lu(806) * lu(799) + lu(807) = lu(807) * lu(799) + lu(808) = lu(808) * lu(799) + lu(809) = lu(809) * lu(799) + lu(810) = lu(810) * lu(799) + lu(811) = lu(811) * lu(799) + lu(966) = lu(966) - lu(800) * lu(964) + lu(967) = lu(967) - lu(801) * lu(964) + lu(968) = lu(968) - lu(802) * lu(964) + lu(971) = lu(971) - lu(803) * lu(964) + lu(972) = lu(972) - lu(804) * lu(964) + lu(973) = lu(973) - lu(805) * lu(964) + lu(975) = lu(975) - lu(806) * lu(964) + lu(976) = lu(976) - lu(807) * lu(964) + lu(977) = lu(977) - lu(808) * lu(964) + lu(978) = lu(978) - lu(809) * lu(964) + lu(979) = lu(979) - lu(810) * lu(964) + lu(981) = lu(981) - lu(811) * lu(964) + lu(1009) = lu(1009) - lu(800) * lu(1008) + lu(1010) = lu(1010) - lu(801) * lu(1008) + lu(1011) = lu(1011) - lu(802) * lu(1008) + lu(1012) = lu(1012) - lu(803) * lu(1008) + lu(1013) = lu(1013) - lu(804) * lu(1008) + lu(1014) = lu(1014) - lu(805) * lu(1008) + lu(1016) = lu(1016) - lu(806) * lu(1008) + lu(1017) = lu(1017) - lu(807) * lu(1008) + lu(1018) = lu(1018) - lu(808) * lu(1008) + lu(1019) = lu(1019) - lu(809) * lu(1008) + lu(1020) = lu(1020) - lu(810) * lu(1008) + lu(1022) = lu(1022) - lu(811) * lu(1008) + lu(1047) = lu(1047) - lu(800) * lu(1046) + lu(1048) = lu(1048) - lu(801) * lu(1046) + lu(1049) = lu(1049) - lu(802) * lu(1046) + lu(1052) = lu(1052) - lu(803) * lu(1046) + lu(1053) = lu(1053) - lu(804) * lu(1046) + lu(1054) = lu(1054) - lu(805) * lu(1046) + lu(1056) = lu(1056) - lu(806) * lu(1046) + lu(1057) = lu(1057) - lu(807) * lu(1046) + lu(1058) = lu(1058) - lu(808) * lu(1046) + lu(1059) = lu(1059) - lu(809) * lu(1046) + lu(1060) = lu(1060) - lu(810) * lu(1046) + lu(1062) = lu(1062) - lu(811) * lu(1046) + lu(1170) = lu(1170) - lu(800) * lu(1168) + lu(1171) = lu(1171) - lu(801) * lu(1168) + lu(1172) = lu(1172) - lu(802) * lu(1168) + lu(1175) = lu(1175) - lu(803) * lu(1168) + lu(1176) = lu(1176) - lu(804) * lu(1168) + lu(1177) = lu(1177) - lu(805) * lu(1168) + lu(1179) = lu(1179) - lu(806) * lu(1168) + lu(1180) = lu(1180) - lu(807) * lu(1168) + lu(1181) = lu(1181) - lu(808) * lu(1168) + lu(1182) = lu(1182) - lu(809) * lu(1168) + lu(1183) = lu(1183) - lu(810) * lu(1168) + lu(1185) = lu(1185) - lu(811) * lu(1168) + lu(1213) = lu(1213) - lu(800) * lu(1211) + lu(1214) = lu(1214) - lu(801) * lu(1211) + lu(1215) = lu(1215) - lu(802) * lu(1211) + lu(1218) = lu(1218) - lu(803) * lu(1211) + lu(1219) = lu(1219) - lu(804) * lu(1211) + lu(1220) = lu(1220) - lu(805) * lu(1211) + lu(1222) = lu(1222) - lu(806) * lu(1211) + lu(1223) = lu(1223) - lu(807) * lu(1211) + lu(1224) = lu(1224) - lu(808) * lu(1211) + lu(1225) = lu(1225) - lu(809) * lu(1211) + lu(1226) = lu(1226) - lu(810) * lu(1211) + lu(1228) = lu(1228) - lu(811) * lu(1211) + lu(1324) = lu(1324) - lu(800) * lu(1322) + lu(1325) = lu(1325) - lu(801) * lu(1322) + lu(1326) = lu(1326) - lu(802) * lu(1322) + lu(1329) = lu(1329) - lu(803) * lu(1322) + lu(1330) = lu(1330) - lu(804) * lu(1322) + lu(1331) = lu(1331) - lu(805) * lu(1322) + lu(1333) = lu(1333) - lu(806) * lu(1322) + lu(1334) = lu(1334) - lu(807) * lu(1322) + lu(1335) = lu(1335) - lu(808) * lu(1322) + lu(1336) = lu(1336) - lu(809) * lu(1322) + lu(1337) = lu(1337) - lu(810) * lu(1322) + lu(1339) = lu(1339) - lu(811) * lu(1322) + lu(1383) = lu(1383) - lu(800) * lu(1381) + lu(1384) = lu(1384) - lu(801) * lu(1381) + lu(1385) = lu(1385) - lu(802) * lu(1381) + lu(1388) = lu(1388) - lu(803) * lu(1381) + lu(1389) = lu(1389) - lu(804) * lu(1381) + lu(1390) = lu(1390) - lu(805) * lu(1381) + lu(1392) = lu(1392) - lu(806) * lu(1381) + lu(1393) = lu(1393) - lu(807) * lu(1381) + lu(1394) = lu(1394) - lu(808) * lu(1381) + lu(1395) = lu(1395) - lu(809) * lu(1381) + lu(1396) = lu(1396) - lu(810) * lu(1381) + lu(1398) = lu(1398) - lu(811) * lu(1381) + lu(1417) = lu(1417) - lu(800) * lu(1416) + lu(1418) = lu(1418) - lu(801) * lu(1416) + lu(1419) = lu(1419) - lu(802) * lu(1416) + lu(1422) = lu(1422) - lu(803) * lu(1416) + lu(1423) = lu(1423) - lu(804) * lu(1416) + lu(1424) = lu(1424) - lu(805) * lu(1416) + lu(1426) = lu(1426) - lu(806) * lu(1416) + lu(1427) = lu(1427) - lu(807) * lu(1416) + lu(1428) = lu(1428) - lu(808) * lu(1416) + lu(1429) = lu(1429) - lu(809) * lu(1416) + lu(1430) = lu(1430) - lu(810) * lu(1416) + lu(1432) = lu(1432) - lu(811) * lu(1416) + lu(816) = 1._r8 / lu(816) + lu(817) = lu(817) * lu(816) + lu(818) = lu(818) * lu(816) + lu(819) = lu(819) * lu(816) + lu(820) = lu(820) * lu(816) + lu(821) = lu(821) * lu(816) + lu(822) = lu(822) * lu(816) + lu(823) = lu(823) * lu(816) + lu(824) = lu(824) * lu(816) + lu(825) = lu(825) * lu(816) + lu(826) = lu(826) * lu(816) + lu(827) = lu(827) * lu(816) + lu(828) = lu(828) * lu(816) + lu(829) = lu(829) * lu(816) + lu(887) = lu(887) - lu(817) * lu(886) + lu(888) = lu(888) - lu(818) * lu(886) + lu(889) = lu(889) - lu(819) * lu(886) + lu(890) = lu(890) - lu(820) * lu(886) + lu(891) = lu(891) - lu(821) * lu(886) + lu(892) = lu(892) - lu(822) * lu(886) + lu(893) = lu(893) - lu(823) * lu(886) + lu(895) = lu(895) - lu(824) * lu(886) + lu(896) = lu(896) - lu(825) * lu(886) + lu(900) = lu(900) - lu(826) * lu(886) + lu(902) = lu(902) - lu(827) * lu(886) + lu(903) = lu(903) - lu(828) * lu(886) + lu(904) = lu(904) - lu(829) * lu(886) + lu(908) = lu(908) - lu(817) * lu(907) + lu(909) = lu(909) - lu(818) * lu(907) + lu(910) = - lu(819) * lu(907) + lu(911) = - lu(820) * lu(907) + lu(912) = lu(912) - lu(821) * lu(907) + lu(913) = - lu(822) * lu(907) + lu(914) = - lu(823) * lu(907) + lu(916) = - lu(824) * lu(907) + lu(917) = lu(917) - lu(825) * lu(907) + lu(921) = lu(921) - lu(826) * lu(907) + lu(923) = - lu(827) * lu(907) + lu(924) = - lu(828) * lu(907) + lu(925) = lu(925) - lu(829) * lu(907) + lu(966) = lu(966) - lu(817) * lu(965) + lu(967) = lu(967) - lu(818) * lu(965) + lu(968) = lu(968) - lu(819) * lu(965) + lu(969) = lu(969) - lu(820) * lu(965) + lu(970) = lu(970) - lu(821) * lu(965) + lu(971) = lu(971) - lu(822) * lu(965) + lu(972) = lu(972) - lu(823) * lu(965) + lu(974) = - lu(824) * lu(965) + lu(975) = lu(975) - lu(825) * lu(965) + lu(979) = lu(979) - lu(826) * lu(965) + lu(981) = lu(981) - lu(827) * lu(965) + lu(982) = lu(982) - lu(828) * lu(965) + lu(983) = lu(983) - lu(829) * lu(965) + lu(1071) = - lu(817) * lu(1070) + lu(1072) = lu(1072) - lu(818) * lu(1070) + lu(1073) = lu(1073) - lu(819) * lu(1070) + lu(1074) = lu(1074) - lu(820) * lu(1070) + lu(1075) = lu(1075) - lu(821) * lu(1070) + lu(1076) = - lu(822) * lu(1070) + lu(1077) = lu(1077) - lu(823) * lu(1070) + lu(1079) = lu(1079) - lu(824) * lu(1070) + lu(1080) = lu(1080) - lu(825) * lu(1070) + lu(1084) = - lu(826) * lu(1070) + lu(1086) = lu(1086) - lu(827) * lu(1070) + lu(1087) = lu(1087) - lu(828) * lu(1070) + lu(1088) = lu(1088) - lu(829) * lu(1070) + lu(1170) = lu(1170) - lu(817) * lu(1169) + lu(1171) = lu(1171) - lu(818) * lu(1169) + lu(1172) = lu(1172) - lu(819) * lu(1169) + lu(1173) = lu(1173) - lu(820) * lu(1169) + lu(1174) = lu(1174) - lu(821) * lu(1169) + lu(1175) = lu(1175) - lu(822) * lu(1169) + lu(1176) = lu(1176) - lu(823) * lu(1169) + lu(1178) = lu(1178) - lu(824) * lu(1169) + lu(1179) = lu(1179) - lu(825) * lu(1169) + lu(1183) = lu(1183) - lu(826) * lu(1169) + lu(1185) = lu(1185) - lu(827) * lu(1169) + lu(1186) = lu(1186) - lu(828) * lu(1169) + lu(1187) = lu(1187) - lu(829) * lu(1169) + lu(1213) = lu(1213) - lu(817) * lu(1212) + lu(1214) = lu(1214) - lu(818) * lu(1212) + lu(1215) = lu(1215) - lu(819) * lu(1212) + lu(1216) = lu(1216) - lu(820) * lu(1212) + lu(1217) = lu(1217) - lu(821) * lu(1212) + lu(1218) = lu(1218) - lu(822) * lu(1212) + lu(1219) = lu(1219) - lu(823) * lu(1212) + lu(1221) = - lu(824) * lu(1212) + lu(1222) = lu(1222) - lu(825) * lu(1212) + lu(1226) = lu(1226) - lu(826) * lu(1212) + lu(1228) = lu(1228) - lu(827) * lu(1212) + lu(1229) = lu(1229) - lu(828) * lu(1212) + lu(1230) = lu(1230) - lu(829) * lu(1212) + lu(1324) = lu(1324) - lu(817) * lu(1323) + lu(1325) = lu(1325) - lu(818) * lu(1323) + lu(1326) = lu(1326) - lu(819) * lu(1323) + lu(1327) = lu(1327) - lu(820) * lu(1323) + lu(1328) = lu(1328) - lu(821) * lu(1323) + lu(1329) = lu(1329) - lu(822) * lu(1323) + lu(1330) = lu(1330) - lu(823) * lu(1323) + lu(1332) = lu(1332) - lu(824) * lu(1323) + lu(1333) = lu(1333) - lu(825) * lu(1323) + lu(1337) = lu(1337) - lu(826) * lu(1323) + lu(1339) = lu(1339) - lu(827) * lu(1323) + lu(1340) = lu(1340) - lu(828) * lu(1323) + lu(1341) = lu(1341) - lu(829) * lu(1323) + lu(1383) = lu(1383) - lu(817) * lu(1382) + lu(1384) = lu(1384) - lu(818) * lu(1382) + lu(1385) = lu(1385) - lu(819) * lu(1382) + lu(1386) = lu(1386) - lu(820) * lu(1382) + lu(1387) = lu(1387) - lu(821) * lu(1382) + lu(1388) = lu(1388) - lu(822) * lu(1382) + lu(1389) = lu(1389) - lu(823) * lu(1382) + lu(1391) = lu(1391) - lu(824) * lu(1382) + lu(1392) = lu(1392) - lu(825) * lu(1382) + lu(1396) = lu(1396) - lu(826) * lu(1382) + lu(1398) = lu(1398) - lu(827) * lu(1382) + lu(1399) = lu(1399) - lu(828) * lu(1382) + lu(1400) = lu(1400) - lu(829) * lu(1382) + lu(1454) = lu(1454) - lu(817) * lu(1453) + lu(1455) = lu(1455) - lu(818) * lu(1453) + lu(1456) = lu(1456) - lu(819) * lu(1453) + lu(1457) = lu(1457) - lu(820) * lu(1453) + lu(1458) = lu(1458) - lu(821) * lu(1453) + lu(1459) = lu(1459) - lu(822) * lu(1453) + lu(1460) = lu(1460) - lu(823) * lu(1453) + lu(1462) = lu(1462) - lu(824) * lu(1453) + lu(1463) = lu(1463) - lu(825) * lu(1453) + lu(1467) = lu(1467) - lu(826) * lu(1453) + lu(1469) = lu(1469) - lu(827) * lu(1453) + lu(1470) = lu(1470) - lu(828) * lu(1453) + lu(1471) = lu(1471) - lu(829) * lu(1453) + lu(843) = 1._r8 / lu(843) + lu(844) = lu(844) * lu(843) + lu(845) = lu(845) * lu(843) + lu(846) = lu(846) * lu(843) + lu(847) = lu(847) * lu(843) + lu(848) = lu(848) * lu(843) + lu(849) = lu(849) * lu(843) + lu(850) = lu(850) * lu(843) + lu(851) = lu(851) * lu(843) + lu(852) = lu(852) * lu(843) + lu(892) = lu(892) - lu(844) * lu(887) + lu(896) = lu(896) - lu(845) * lu(887) + lu(897) = - lu(846) * lu(887) + lu(898) = lu(898) - lu(847) * lu(887) + lu(899) = - lu(848) * lu(887) + lu(900) = lu(900) - lu(849) * lu(887) + lu(901) = - lu(850) * lu(887) + lu(902) = lu(902) - lu(851) * lu(887) + lu(904) = lu(904) - lu(852) * lu(887) + lu(913) = lu(913) - lu(844) * lu(908) + lu(917) = lu(917) - lu(845) * lu(908) + lu(918) = lu(918) - lu(846) * lu(908) + lu(919) = lu(919) - lu(847) * lu(908) + lu(920) = lu(920) - lu(848) * lu(908) + lu(921) = lu(921) - lu(849) * lu(908) + lu(922) = lu(922) - lu(850) * lu(908) + lu(923) = lu(923) - lu(851) * lu(908) + lu(925) = lu(925) - lu(852) * lu(908) + lu(971) = lu(971) - lu(844) * lu(966) + lu(975) = lu(975) - lu(845) * lu(966) + lu(976) = lu(976) - lu(846) * lu(966) + lu(977) = lu(977) - lu(847) * lu(966) + lu(978) = lu(978) - lu(848) * lu(966) + lu(979) = lu(979) - lu(849) * lu(966) + lu(980) = lu(980) - lu(850) * lu(966) + lu(981) = lu(981) - lu(851) * lu(966) + lu(983) = lu(983) - lu(852) * lu(966) + lu(1012) = lu(1012) - lu(844) * lu(1009) + lu(1016) = lu(1016) - lu(845) * lu(1009) + lu(1017) = lu(1017) - lu(846) * lu(1009) + lu(1018) = lu(1018) - lu(847) * lu(1009) + lu(1019) = lu(1019) - lu(848) * lu(1009) + lu(1020) = lu(1020) - lu(849) * lu(1009) + lu(1021) = - lu(850) * lu(1009) + lu(1022) = lu(1022) - lu(851) * lu(1009) + lu(1024) = lu(1024) - lu(852) * lu(1009) + lu(1052) = lu(1052) - lu(844) * lu(1047) + lu(1056) = lu(1056) - lu(845) * lu(1047) + lu(1057) = lu(1057) - lu(846) * lu(1047) + lu(1058) = lu(1058) - lu(847) * lu(1047) + lu(1059) = lu(1059) - lu(848) * lu(1047) + lu(1060) = lu(1060) - lu(849) * lu(1047) + lu(1061) = - lu(850) * lu(1047) + lu(1062) = lu(1062) - lu(851) * lu(1047) + lu(1064) = - lu(852) * lu(1047) + lu(1076) = lu(1076) - lu(844) * lu(1071) + lu(1080) = lu(1080) - lu(845) * lu(1071) + lu(1081) = - lu(846) * lu(1071) + lu(1082) = - lu(847) * lu(1071) + lu(1083) = lu(1083) - lu(848) * lu(1071) + lu(1084) = lu(1084) - lu(849) * lu(1071) + lu(1085) = lu(1085) - lu(850) * lu(1071) + lu(1086) = lu(1086) - lu(851) * lu(1071) + lu(1088) = lu(1088) - lu(852) * lu(1071) + lu(1175) = lu(1175) - lu(844) * lu(1170) + lu(1179) = lu(1179) - lu(845) * lu(1170) + lu(1180) = lu(1180) - lu(846) * lu(1170) + lu(1181) = lu(1181) - lu(847) * lu(1170) + lu(1182) = lu(1182) - lu(848) * lu(1170) + lu(1183) = lu(1183) - lu(849) * lu(1170) + lu(1184) = lu(1184) - lu(850) * lu(1170) + lu(1185) = lu(1185) - lu(851) * lu(1170) + lu(1187) = lu(1187) - lu(852) * lu(1170) + lu(1218) = lu(1218) - lu(844) * lu(1213) + lu(1222) = lu(1222) - lu(845) * lu(1213) + lu(1223) = lu(1223) - lu(846) * lu(1213) + lu(1224) = lu(1224) - lu(847) * lu(1213) + lu(1225) = lu(1225) - lu(848) * lu(1213) + lu(1226) = lu(1226) - lu(849) * lu(1213) + lu(1227) = lu(1227) - lu(850) * lu(1213) + lu(1228) = lu(1228) - lu(851) * lu(1213) + lu(1230) = lu(1230) - lu(852) * lu(1213) + lu(1256) = - lu(844) * lu(1253) + lu(1260) = lu(1260) - lu(845) * lu(1253) + lu(1261) = lu(1261) - lu(846) * lu(1253) + lu(1262) = - lu(847) * lu(1253) + lu(1263) = lu(1263) - lu(848) * lu(1253) + lu(1264) = lu(1264) - lu(849) * lu(1253) + lu(1265) = lu(1265) - lu(850) * lu(1253) + lu(1266) = - lu(851) * lu(1253) + lu(1268) = lu(1268) - lu(852) * lu(1253) + lu(1329) = lu(1329) - lu(844) * lu(1324) + lu(1333) = lu(1333) - lu(845) * lu(1324) + lu(1334) = lu(1334) - lu(846) * lu(1324) + lu(1335) = lu(1335) - lu(847) * lu(1324) + lu(1336) = lu(1336) - lu(848) * lu(1324) + lu(1337) = lu(1337) - lu(849) * lu(1324) + lu(1338) = lu(1338) - lu(850) * lu(1324) + lu(1339) = lu(1339) - lu(851) * lu(1324) + lu(1341) = lu(1341) - lu(852) * lu(1324) + lu(1353) = lu(1353) - lu(844) * lu(1349) + lu(1357) = lu(1357) - lu(845) * lu(1349) + lu(1358) = lu(1358) - lu(846) * lu(1349) + lu(1359) = lu(1359) - lu(847) * lu(1349) + lu(1360) = lu(1360) - lu(848) * lu(1349) + lu(1361) = lu(1361) - lu(849) * lu(1349) + lu(1362) = lu(1362) - lu(850) * lu(1349) + lu(1363) = - lu(851) * lu(1349) + lu(1365) = lu(1365) - lu(852) * lu(1349) + lu(1388) = lu(1388) - lu(844) * lu(1383) + lu(1392) = lu(1392) - lu(845) * lu(1383) + lu(1393) = lu(1393) - lu(846) * lu(1383) + lu(1394) = lu(1394) - lu(847) * lu(1383) + lu(1395) = lu(1395) - lu(848) * lu(1383) + lu(1396) = lu(1396) - lu(849) * lu(1383) + lu(1397) = lu(1397) - lu(850) * lu(1383) + lu(1398) = lu(1398) - lu(851) * lu(1383) + lu(1400) = lu(1400) - lu(852) * lu(1383) + lu(1422) = lu(1422) - lu(844) * lu(1417) + lu(1426) = lu(1426) - lu(845) * lu(1417) + lu(1427) = lu(1427) - lu(846) * lu(1417) + lu(1428) = lu(1428) - lu(847) * lu(1417) + lu(1429) = lu(1429) - lu(848) * lu(1417) + lu(1430) = lu(1430) - lu(849) * lu(1417) + lu(1431) = lu(1431) - lu(850) * lu(1417) + lu(1432) = lu(1432) - lu(851) * lu(1417) + lu(1434) = lu(1434) - lu(852) * lu(1417) + lu(1459) = lu(1459) - lu(844) * lu(1454) + lu(1463) = lu(1463) - lu(845) * lu(1454) + lu(1464) = lu(1464) - lu(846) * lu(1454) + lu(1465) = lu(1465) - lu(847) * lu(1454) + lu(1466) = lu(1466) - lu(848) * lu(1454) + lu(1467) = lu(1467) - lu(849) * lu(1454) + lu(1468) = lu(1468) - lu(850) * lu(1454) + lu(1469) = lu(1469) - lu(851) * lu(1454) + lu(1471) = lu(1471) - lu(852) * lu(1454) + end subroutine lu_fac17 + subroutine lu_fac18( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(856) = 1._r8 / lu(856) + lu(857) = lu(857) * lu(856) + lu(858) = lu(858) * lu(856) + lu(859) = lu(859) * lu(856) + lu(860) = lu(860) * lu(856) + lu(861) = lu(861) * lu(856) + lu(862) = lu(862) * lu(856) + lu(863) = lu(863) * lu(856) + lu(864) = lu(864) * lu(856) + lu(865) = lu(865) * lu(856) + lu(870) = lu(870) - lu(857) * lu(869) + lu(871) = lu(871) - lu(858) * lu(869) + lu(872) = lu(872) - lu(859) * lu(869) + lu(873) = lu(873) - lu(860) * lu(869) + lu(874) = lu(874) - lu(861) * lu(869) + lu(875) = lu(875) - lu(862) * lu(869) + lu(876) = lu(876) - lu(863) * lu(869) + lu(878) = lu(878) - lu(864) * lu(869) + lu(879) = lu(879) - lu(865) * lu(869) + lu(889) = lu(889) - lu(857) * lu(888) + lu(893) = lu(893) - lu(858) * lu(888) + lu(894) = lu(894) - lu(859) * lu(888) + lu(895) = lu(895) - lu(860) * lu(888) + lu(896) = lu(896) - lu(861) * lu(888) + lu(899) = lu(899) - lu(862) * lu(888) + lu(901) = lu(901) - lu(863) * lu(888) + lu(903) = lu(903) - lu(864) * lu(888) + lu(904) = lu(904) - lu(865) * lu(888) + lu(910) = lu(910) - lu(857) * lu(909) + lu(914) = lu(914) - lu(858) * lu(909) + lu(915) = - lu(859) * lu(909) + lu(916) = lu(916) - lu(860) * lu(909) + lu(917) = lu(917) - lu(861) * lu(909) + lu(920) = lu(920) - lu(862) * lu(909) + lu(922) = lu(922) - lu(863) * lu(909) + lu(924) = lu(924) - lu(864) * lu(909) + lu(925) = lu(925) - lu(865) * lu(909) + lu(968) = lu(968) - lu(857) * lu(967) + lu(972) = lu(972) - lu(858) * lu(967) + lu(973) = lu(973) - lu(859) * lu(967) + lu(974) = lu(974) - lu(860) * lu(967) + lu(975) = lu(975) - lu(861) * lu(967) + lu(978) = lu(978) - lu(862) * lu(967) + lu(980) = lu(980) - lu(863) * lu(967) + lu(982) = lu(982) - lu(864) * lu(967) + lu(983) = lu(983) - lu(865) * lu(967) + lu(1011) = lu(1011) - lu(857) * lu(1010) + lu(1013) = lu(1013) - lu(858) * lu(1010) + lu(1014) = lu(1014) - lu(859) * lu(1010) + lu(1015) = - lu(860) * lu(1010) + lu(1016) = lu(1016) - lu(861) * lu(1010) + lu(1019) = lu(1019) - lu(862) * lu(1010) + lu(1021) = lu(1021) - lu(863) * lu(1010) + lu(1023) = - lu(864) * lu(1010) + lu(1024) = lu(1024) - lu(865) * lu(1010) + lu(1049) = lu(1049) - lu(857) * lu(1048) + lu(1053) = lu(1053) - lu(858) * lu(1048) + lu(1054) = lu(1054) - lu(859) * lu(1048) + lu(1055) = - lu(860) * lu(1048) + lu(1056) = lu(1056) - lu(861) * lu(1048) + lu(1059) = lu(1059) - lu(862) * lu(1048) + lu(1061) = lu(1061) - lu(863) * lu(1048) + lu(1063) = lu(1063) - lu(864) * lu(1048) + lu(1064) = lu(1064) - lu(865) * lu(1048) + lu(1073) = lu(1073) - lu(857) * lu(1072) + lu(1077) = lu(1077) - lu(858) * lu(1072) + lu(1078) = - lu(859) * lu(1072) + lu(1079) = lu(1079) - lu(860) * lu(1072) + lu(1080) = lu(1080) - lu(861) * lu(1072) + lu(1083) = lu(1083) - lu(862) * lu(1072) + lu(1085) = lu(1085) - lu(863) * lu(1072) + lu(1087) = lu(1087) - lu(864) * lu(1072) + lu(1088) = lu(1088) - lu(865) * lu(1072) + lu(1172) = lu(1172) - lu(857) * lu(1171) + lu(1176) = lu(1176) - lu(858) * lu(1171) + lu(1177) = lu(1177) - lu(859) * lu(1171) + lu(1178) = lu(1178) - lu(860) * lu(1171) + lu(1179) = lu(1179) - lu(861) * lu(1171) + lu(1182) = lu(1182) - lu(862) * lu(1171) + lu(1184) = lu(1184) - lu(863) * lu(1171) + lu(1186) = lu(1186) - lu(864) * lu(1171) + lu(1187) = lu(1187) - lu(865) * lu(1171) + lu(1215) = lu(1215) - lu(857) * lu(1214) + lu(1219) = lu(1219) - lu(858) * lu(1214) + lu(1220) = lu(1220) - lu(859) * lu(1214) + lu(1221) = lu(1221) - lu(860) * lu(1214) + lu(1222) = lu(1222) - lu(861) * lu(1214) + lu(1225) = lu(1225) - lu(862) * lu(1214) + lu(1227) = lu(1227) - lu(863) * lu(1214) + lu(1229) = lu(1229) - lu(864) * lu(1214) + lu(1230) = lu(1230) - lu(865) * lu(1214) + lu(1237) = lu(1237) - lu(857) * lu(1236) + lu(1240) = lu(1240) - lu(858) * lu(1236) + lu(1241) = lu(1241) - lu(859) * lu(1236) + lu(1242) = lu(1242) - lu(860) * lu(1236) + lu(1243) = lu(1243) - lu(861) * lu(1236) + lu(1246) = lu(1246) - lu(862) * lu(1236) + lu(1248) = lu(1248) - lu(863) * lu(1236) + lu(1250) = lu(1250) - lu(864) * lu(1236) + lu(1251) = lu(1251) - lu(865) * lu(1236) + lu(1255) = lu(1255) - lu(857) * lu(1254) + lu(1257) = lu(1257) - lu(858) * lu(1254) + lu(1258) = lu(1258) - lu(859) * lu(1254) + lu(1259) = lu(1259) - lu(860) * lu(1254) + lu(1260) = lu(1260) - lu(861) * lu(1254) + lu(1263) = lu(1263) - lu(862) * lu(1254) + lu(1265) = lu(1265) - lu(863) * lu(1254) + lu(1267) = lu(1267) - lu(864) * lu(1254) + lu(1268) = lu(1268) - lu(865) * lu(1254) + lu(1326) = lu(1326) - lu(857) * lu(1325) + lu(1330) = lu(1330) - lu(858) * lu(1325) + lu(1331) = lu(1331) - lu(859) * lu(1325) + lu(1332) = lu(1332) - lu(860) * lu(1325) + lu(1333) = lu(1333) - lu(861) * lu(1325) + lu(1336) = lu(1336) - lu(862) * lu(1325) + lu(1338) = lu(1338) - lu(863) * lu(1325) + lu(1340) = lu(1340) - lu(864) * lu(1325) + lu(1341) = lu(1341) - lu(865) * lu(1325) + lu(1351) = lu(1351) - lu(857) * lu(1350) + lu(1354) = lu(1354) - lu(858) * lu(1350) + lu(1355) = lu(1355) - lu(859) * lu(1350) + lu(1356) = lu(1356) - lu(860) * lu(1350) + lu(1357) = lu(1357) - lu(861) * lu(1350) + lu(1360) = lu(1360) - lu(862) * lu(1350) + lu(1362) = lu(1362) - lu(863) * lu(1350) + lu(1364) = lu(1364) - lu(864) * lu(1350) + lu(1365) = lu(1365) - lu(865) * lu(1350) + lu(1385) = lu(1385) - lu(857) * lu(1384) + lu(1389) = lu(1389) - lu(858) * lu(1384) + lu(1390) = lu(1390) - lu(859) * lu(1384) + lu(1391) = lu(1391) - lu(860) * lu(1384) + lu(1392) = lu(1392) - lu(861) * lu(1384) + lu(1395) = lu(1395) - lu(862) * lu(1384) + lu(1397) = lu(1397) - lu(863) * lu(1384) + lu(1399) = lu(1399) - lu(864) * lu(1384) + lu(1400) = lu(1400) - lu(865) * lu(1384) + lu(1419) = lu(1419) - lu(857) * lu(1418) + lu(1423) = lu(1423) - lu(858) * lu(1418) + lu(1424) = lu(1424) - lu(859) * lu(1418) + lu(1425) = lu(1425) - lu(860) * lu(1418) + lu(1426) = lu(1426) - lu(861) * lu(1418) + lu(1429) = lu(1429) - lu(862) * lu(1418) + lu(1431) = lu(1431) - lu(863) * lu(1418) + lu(1433) = lu(1433) - lu(864) * lu(1418) + lu(1434) = lu(1434) - lu(865) * lu(1418) + lu(1456) = lu(1456) - lu(857) * lu(1455) + lu(1460) = lu(1460) - lu(858) * lu(1455) + lu(1461) = lu(1461) - lu(859) * lu(1455) + lu(1462) = lu(1462) - lu(860) * lu(1455) + lu(1463) = lu(1463) - lu(861) * lu(1455) + lu(1466) = lu(1466) - lu(862) * lu(1455) + lu(1468) = lu(1468) - lu(863) * lu(1455) + lu(1470) = lu(1470) - lu(864) * lu(1455) + lu(1471) = lu(1471) - lu(865) * lu(1455) + lu(870) = 1._r8 / lu(870) + lu(871) = lu(871) * lu(870) + lu(872) = lu(872) * lu(870) + lu(873) = lu(873) * lu(870) + lu(874) = lu(874) * lu(870) + lu(875) = lu(875) * lu(870) + lu(876) = lu(876) * lu(870) + lu(877) = lu(877) * lu(870) + lu(878) = lu(878) * lu(870) + lu(879) = lu(879) * lu(870) + lu(893) = lu(893) - lu(871) * lu(889) + lu(894) = lu(894) - lu(872) * lu(889) + lu(895) = lu(895) - lu(873) * lu(889) + lu(896) = lu(896) - lu(874) * lu(889) + lu(899) = lu(899) - lu(875) * lu(889) + lu(901) = lu(901) - lu(876) * lu(889) + lu(902) = lu(902) - lu(877) * lu(889) + lu(903) = lu(903) - lu(878) * lu(889) + lu(904) = lu(904) - lu(879) * lu(889) + lu(914) = lu(914) - lu(871) * lu(910) + lu(915) = lu(915) - lu(872) * lu(910) + lu(916) = lu(916) - lu(873) * lu(910) + lu(917) = lu(917) - lu(874) * lu(910) + lu(920) = lu(920) - lu(875) * lu(910) + lu(922) = lu(922) - lu(876) * lu(910) + lu(923) = lu(923) - lu(877) * lu(910) + lu(924) = lu(924) - lu(878) * lu(910) + lu(925) = lu(925) - lu(879) * lu(910) + lu(972) = lu(972) - lu(871) * lu(968) + lu(973) = lu(973) - lu(872) * lu(968) + lu(974) = lu(974) - lu(873) * lu(968) + lu(975) = lu(975) - lu(874) * lu(968) + lu(978) = lu(978) - lu(875) * lu(968) + lu(980) = lu(980) - lu(876) * lu(968) + lu(981) = lu(981) - lu(877) * lu(968) + lu(982) = lu(982) - lu(878) * lu(968) + lu(983) = lu(983) - lu(879) * lu(968) + lu(1013) = lu(1013) - lu(871) * lu(1011) + lu(1014) = lu(1014) - lu(872) * lu(1011) + lu(1015) = lu(1015) - lu(873) * lu(1011) + lu(1016) = lu(1016) - lu(874) * lu(1011) + lu(1019) = lu(1019) - lu(875) * lu(1011) + lu(1021) = lu(1021) - lu(876) * lu(1011) + lu(1022) = lu(1022) - lu(877) * lu(1011) + lu(1023) = lu(1023) - lu(878) * lu(1011) + lu(1024) = lu(1024) - lu(879) * lu(1011) + lu(1053) = lu(1053) - lu(871) * lu(1049) + lu(1054) = lu(1054) - lu(872) * lu(1049) + lu(1055) = lu(1055) - lu(873) * lu(1049) + lu(1056) = lu(1056) - lu(874) * lu(1049) + lu(1059) = lu(1059) - lu(875) * lu(1049) + lu(1061) = lu(1061) - lu(876) * lu(1049) + lu(1062) = lu(1062) - lu(877) * lu(1049) + lu(1063) = lu(1063) - lu(878) * lu(1049) + lu(1064) = lu(1064) - lu(879) * lu(1049) + lu(1077) = lu(1077) - lu(871) * lu(1073) + lu(1078) = lu(1078) - lu(872) * lu(1073) + lu(1079) = lu(1079) - lu(873) * lu(1073) + lu(1080) = lu(1080) - lu(874) * lu(1073) + lu(1083) = lu(1083) - lu(875) * lu(1073) + lu(1085) = lu(1085) - lu(876) * lu(1073) + lu(1086) = lu(1086) - lu(877) * lu(1073) + lu(1087) = lu(1087) - lu(878) * lu(1073) + lu(1088) = lu(1088) - lu(879) * lu(1073) + lu(1176) = lu(1176) - lu(871) * lu(1172) + lu(1177) = lu(1177) - lu(872) * lu(1172) + lu(1178) = lu(1178) - lu(873) * lu(1172) + lu(1179) = lu(1179) - lu(874) * lu(1172) + lu(1182) = lu(1182) - lu(875) * lu(1172) + lu(1184) = lu(1184) - lu(876) * lu(1172) + lu(1185) = lu(1185) - lu(877) * lu(1172) + lu(1186) = lu(1186) - lu(878) * lu(1172) + lu(1187) = lu(1187) - lu(879) * lu(1172) + lu(1219) = lu(1219) - lu(871) * lu(1215) + lu(1220) = lu(1220) - lu(872) * lu(1215) + lu(1221) = lu(1221) - lu(873) * lu(1215) + lu(1222) = lu(1222) - lu(874) * lu(1215) + lu(1225) = lu(1225) - lu(875) * lu(1215) + lu(1227) = lu(1227) - lu(876) * lu(1215) + lu(1228) = lu(1228) - lu(877) * lu(1215) + lu(1229) = lu(1229) - lu(878) * lu(1215) + lu(1230) = lu(1230) - lu(879) * lu(1215) + lu(1240) = lu(1240) - lu(871) * lu(1237) + lu(1241) = lu(1241) - lu(872) * lu(1237) + lu(1242) = lu(1242) - lu(873) * lu(1237) + lu(1243) = lu(1243) - lu(874) * lu(1237) + lu(1246) = lu(1246) - lu(875) * lu(1237) + lu(1248) = lu(1248) - lu(876) * lu(1237) + lu(1249) = lu(1249) - lu(877) * lu(1237) + lu(1250) = lu(1250) - lu(878) * lu(1237) + lu(1251) = lu(1251) - lu(879) * lu(1237) + lu(1257) = lu(1257) - lu(871) * lu(1255) + lu(1258) = lu(1258) - lu(872) * lu(1255) + lu(1259) = lu(1259) - lu(873) * lu(1255) + lu(1260) = lu(1260) - lu(874) * lu(1255) + lu(1263) = lu(1263) - lu(875) * lu(1255) + lu(1265) = lu(1265) - lu(876) * lu(1255) + lu(1266) = lu(1266) - lu(877) * lu(1255) + lu(1267) = lu(1267) - lu(878) * lu(1255) + lu(1268) = lu(1268) - lu(879) * lu(1255) + lu(1330) = lu(1330) - lu(871) * lu(1326) + lu(1331) = lu(1331) - lu(872) * lu(1326) + lu(1332) = lu(1332) - lu(873) * lu(1326) + lu(1333) = lu(1333) - lu(874) * lu(1326) + lu(1336) = lu(1336) - lu(875) * lu(1326) + lu(1338) = lu(1338) - lu(876) * lu(1326) + lu(1339) = lu(1339) - lu(877) * lu(1326) + lu(1340) = lu(1340) - lu(878) * lu(1326) + lu(1341) = lu(1341) - lu(879) * lu(1326) + lu(1354) = lu(1354) - lu(871) * lu(1351) + lu(1355) = lu(1355) - lu(872) * lu(1351) + lu(1356) = lu(1356) - lu(873) * lu(1351) + lu(1357) = lu(1357) - lu(874) * lu(1351) + lu(1360) = lu(1360) - lu(875) * lu(1351) + lu(1362) = lu(1362) - lu(876) * lu(1351) + lu(1363) = lu(1363) - lu(877) * lu(1351) + lu(1364) = lu(1364) - lu(878) * lu(1351) + lu(1365) = lu(1365) - lu(879) * lu(1351) + lu(1389) = lu(1389) - lu(871) * lu(1385) + lu(1390) = lu(1390) - lu(872) * lu(1385) + lu(1391) = lu(1391) - lu(873) * lu(1385) + lu(1392) = lu(1392) - lu(874) * lu(1385) + lu(1395) = lu(1395) - lu(875) * lu(1385) + lu(1397) = lu(1397) - lu(876) * lu(1385) + lu(1398) = lu(1398) - lu(877) * lu(1385) + lu(1399) = lu(1399) - lu(878) * lu(1385) + lu(1400) = lu(1400) - lu(879) * lu(1385) + lu(1423) = lu(1423) - lu(871) * lu(1419) + lu(1424) = lu(1424) - lu(872) * lu(1419) + lu(1425) = lu(1425) - lu(873) * lu(1419) + lu(1426) = lu(1426) - lu(874) * lu(1419) + lu(1429) = lu(1429) - lu(875) * lu(1419) + lu(1431) = lu(1431) - lu(876) * lu(1419) + lu(1432) = lu(1432) - lu(877) * lu(1419) + lu(1433) = lu(1433) - lu(878) * lu(1419) + lu(1434) = lu(1434) - lu(879) * lu(1419) + lu(1460) = lu(1460) - lu(871) * lu(1456) + lu(1461) = lu(1461) - lu(872) * lu(1456) + lu(1462) = lu(1462) - lu(873) * lu(1456) + lu(1463) = lu(1463) - lu(874) * lu(1456) + lu(1466) = lu(1466) - lu(875) * lu(1456) + lu(1468) = lu(1468) - lu(876) * lu(1456) + lu(1469) = lu(1469) - lu(877) * lu(1456) + lu(1470) = lu(1470) - lu(878) * lu(1456) + lu(1471) = lu(1471) - lu(879) * lu(1456) + lu(890) = 1._r8 / lu(890) + lu(891) = lu(891) * lu(890) + lu(892) = lu(892) * lu(890) + lu(893) = lu(893) * lu(890) + lu(894) = lu(894) * lu(890) + lu(895) = lu(895) * lu(890) + lu(896) = lu(896) * lu(890) + lu(897) = lu(897) * lu(890) + lu(898) = lu(898) * lu(890) + lu(899) = lu(899) * lu(890) + lu(900) = lu(900) * lu(890) + lu(901) = lu(901) * lu(890) + lu(902) = lu(902) * lu(890) + lu(903) = lu(903) * lu(890) + lu(904) = lu(904) * lu(890) + lu(912) = lu(912) - lu(891) * lu(911) + lu(913) = lu(913) - lu(892) * lu(911) + lu(914) = lu(914) - lu(893) * lu(911) + lu(915) = lu(915) - lu(894) * lu(911) + lu(916) = lu(916) - lu(895) * lu(911) + lu(917) = lu(917) - lu(896) * lu(911) + lu(918) = lu(918) - lu(897) * lu(911) + lu(919) = lu(919) - lu(898) * lu(911) + lu(920) = lu(920) - lu(899) * lu(911) + lu(921) = lu(921) - lu(900) * lu(911) + lu(922) = lu(922) - lu(901) * lu(911) + lu(923) = lu(923) - lu(902) * lu(911) + lu(924) = lu(924) - lu(903) * lu(911) + lu(925) = lu(925) - lu(904) * lu(911) + lu(970) = lu(970) - lu(891) * lu(969) + lu(971) = lu(971) - lu(892) * lu(969) + lu(972) = lu(972) - lu(893) * lu(969) + lu(973) = lu(973) - lu(894) * lu(969) + lu(974) = lu(974) - lu(895) * lu(969) + lu(975) = lu(975) - lu(896) * lu(969) + lu(976) = lu(976) - lu(897) * lu(969) + lu(977) = lu(977) - lu(898) * lu(969) + lu(978) = lu(978) - lu(899) * lu(969) + lu(979) = lu(979) - lu(900) * lu(969) + lu(980) = lu(980) - lu(901) * lu(969) + lu(981) = lu(981) - lu(902) * lu(969) + lu(982) = lu(982) - lu(903) * lu(969) + lu(983) = lu(983) - lu(904) * lu(969) + lu(1051) = - lu(891) * lu(1050) + lu(1052) = lu(1052) - lu(892) * lu(1050) + lu(1053) = lu(1053) - lu(893) * lu(1050) + lu(1054) = lu(1054) - lu(894) * lu(1050) + lu(1055) = lu(1055) - lu(895) * lu(1050) + lu(1056) = lu(1056) - lu(896) * lu(1050) + lu(1057) = lu(1057) - lu(897) * lu(1050) + lu(1058) = lu(1058) - lu(898) * lu(1050) + lu(1059) = lu(1059) - lu(899) * lu(1050) + lu(1060) = lu(1060) - lu(900) * lu(1050) + lu(1061) = lu(1061) - lu(901) * lu(1050) + lu(1062) = lu(1062) - lu(902) * lu(1050) + lu(1063) = lu(1063) - lu(903) * lu(1050) + lu(1064) = lu(1064) - lu(904) * lu(1050) + lu(1075) = lu(1075) - lu(891) * lu(1074) + lu(1076) = lu(1076) - lu(892) * lu(1074) + lu(1077) = lu(1077) - lu(893) * lu(1074) + lu(1078) = lu(1078) - lu(894) * lu(1074) + lu(1079) = lu(1079) - lu(895) * lu(1074) + lu(1080) = lu(1080) - lu(896) * lu(1074) + lu(1081) = lu(1081) - lu(897) * lu(1074) + lu(1082) = lu(1082) - lu(898) * lu(1074) + lu(1083) = lu(1083) - lu(899) * lu(1074) + lu(1084) = lu(1084) - lu(900) * lu(1074) + lu(1085) = lu(1085) - lu(901) * lu(1074) + lu(1086) = lu(1086) - lu(902) * lu(1074) + lu(1087) = lu(1087) - lu(903) * lu(1074) + lu(1088) = lu(1088) - lu(904) * lu(1074) + lu(1174) = lu(1174) - lu(891) * lu(1173) + lu(1175) = lu(1175) - lu(892) * lu(1173) + lu(1176) = lu(1176) - lu(893) * lu(1173) + lu(1177) = lu(1177) - lu(894) * lu(1173) + lu(1178) = lu(1178) - lu(895) * lu(1173) + lu(1179) = lu(1179) - lu(896) * lu(1173) + lu(1180) = lu(1180) - lu(897) * lu(1173) + lu(1181) = lu(1181) - lu(898) * lu(1173) + lu(1182) = lu(1182) - lu(899) * lu(1173) + lu(1183) = lu(1183) - lu(900) * lu(1173) + lu(1184) = lu(1184) - lu(901) * lu(1173) + lu(1185) = lu(1185) - lu(902) * lu(1173) + lu(1186) = lu(1186) - lu(903) * lu(1173) + lu(1187) = lu(1187) - lu(904) * lu(1173) + lu(1217) = lu(1217) - lu(891) * lu(1216) + lu(1218) = lu(1218) - lu(892) * lu(1216) + lu(1219) = lu(1219) - lu(893) * lu(1216) + lu(1220) = lu(1220) - lu(894) * lu(1216) + lu(1221) = lu(1221) - lu(895) * lu(1216) + lu(1222) = lu(1222) - lu(896) * lu(1216) + lu(1223) = lu(1223) - lu(897) * lu(1216) + lu(1224) = lu(1224) - lu(898) * lu(1216) + lu(1225) = lu(1225) - lu(899) * lu(1216) + lu(1226) = lu(1226) - lu(900) * lu(1216) + lu(1227) = lu(1227) - lu(901) * lu(1216) + lu(1228) = lu(1228) - lu(902) * lu(1216) + lu(1229) = lu(1229) - lu(903) * lu(1216) + lu(1230) = lu(1230) - lu(904) * lu(1216) + lu(1328) = lu(1328) - lu(891) * lu(1327) + lu(1329) = lu(1329) - lu(892) * lu(1327) + lu(1330) = lu(1330) - lu(893) * lu(1327) + lu(1331) = lu(1331) - lu(894) * lu(1327) + lu(1332) = lu(1332) - lu(895) * lu(1327) + lu(1333) = lu(1333) - lu(896) * lu(1327) + lu(1334) = lu(1334) - lu(897) * lu(1327) + lu(1335) = lu(1335) - lu(898) * lu(1327) + lu(1336) = lu(1336) - lu(899) * lu(1327) + lu(1337) = lu(1337) - lu(900) * lu(1327) + lu(1338) = lu(1338) - lu(901) * lu(1327) + lu(1339) = lu(1339) - lu(902) * lu(1327) + lu(1340) = lu(1340) - lu(903) * lu(1327) + lu(1341) = lu(1341) - lu(904) * lu(1327) + lu(1387) = lu(1387) - lu(891) * lu(1386) + lu(1388) = lu(1388) - lu(892) * lu(1386) + lu(1389) = lu(1389) - lu(893) * lu(1386) + lu(1390) = lu(1390) - lu(894) * lu(1386) + lu(1391) = lu(1391) - lu(895) * lu(1386) + lu(1392) = lu(1392) - lu(896) * lu(1386) + lu(1393) = lu(1393) - lu(897) * lu(1386) + lu(1394) = lu(1394) - lu(898) * lu(1386) + lu(1395) = lu(1395) - lu(899) * lu(1386) + lu(1396) = lu(1396) - lu(900) * lu(1386) + lu(1397) = lu(1397) - lu(901) * lu(1386) + lu(1398) = lu(1398) - lu(902) * lu(1386) + lu(1399) = lu(1399) - lu(903) * lu(1386) + lu(1400) = lu(1400) - lu(904) * lu(1386) + lu(1421) = lu(1421) - lu(891) * lu(1420) + lu(1422) = lu(1422) - lu(892) * lu(1420) + lu(1423) = lu(1423) - lu(893) * lu(1420) + lu(1424) = lu(1424) - lu(894) * lu(1420) + lu(1425) = lu(1425) - lu(895) * lu(1420) + lu(1426) = lu(1426) - lu(896) * lu(1420) + lu(1427) = lu(1427) - lu(897) * lu(1420) + lu(1428) = lu(1428) - lu(898) * lu(1420) + lu(1429) = lu(1429) - lu(899) * lu(1420) + lu(1430) = lu(1430) - lu(900) * lu(1420) + lu(1431) = lu(1431) - lu(901) * lu(1420) + lu(1432) = lu(1432) - lu(902) * lu(1420) + lu(1433) = lu(1433) - lu(903) * lu(1420) + lu(1434) = lu(1434) - lu(904) * lu(1420) + lu(1458) = lu(1458) - lu(891) * lu(1457) + lu(1459) = lu(1459) - lu(892) * lu(1457) + lu(1460) = lu(1460) - lu(893) * lu(1457) + lu(1461) = lu(1461) - lu(894) * lu(1457) + lu(1462) = lu(1462) - lu(895) * lu(1457) + lu(1463) = lu(1463) - lu(896) * lu(1457) + lu(1464) = lu(1464) - lu(897) * lu(1457) + lu(1465) = lu(1465) - lu(898) * lu(1457) + lu(1466) = lu(1466) - lu(899) * lu(1457) + lu(1467) = lu(1467) - lu(900) * lu(1457) + lu(1468) = lu(1468) - lu(901) * lu(1457) + lu(1469) = lu(1469) - lu(902) * lu(1457) + lu(1470) = lu(1470) - lu(903) * lu(1457) + lu(1471) = lu(1471) - lu(904) * lu(1457) + lu(912) = 1._r8 / lu(912) + lu(913) = lu(913) * lu(912) + lu(914) = lu(914) * lu(912) + lu(915) = lu(915) * lu(912) + lu(916) = lu(916) * lu(912) + lu(917) = lu(917) * lu(912) + lu(918) = lu(918) * lu(912) + lu(919) = lu(919) * lu(912) + lu(920) = lu(920) * lu(912) + lu(921) = lu(921) * lu(912) + lu(922) = lu(922) * lu(912) + lu(923) = lu(923) * lu(912) + lu(924) = lu(924) * lu(912) + lu(925) = lu(925) * lu(912) + lu(971) = lu(971) - lu(913) * lu(970) + lu(972) = lu(972) - lu(914) * lu(970) + lu(973) = lu(973) - lu(915) * lu(970) + lu(974) = lu(974) - lu(916) * lu(970) + lu(975) = lu(975) - lu(917) * lu(970) + lu(976) = lu(976) - lu(918) * lu(970) + lu(977) = lu(977) - lu(919) * lu(970) + lu(978) = lu(978) - lu(920) * lu(970) + lu(979) = lu(979) - lu(921) * lu(970) + lu(980) = lu(980) - lu(922) * lu(970) + lu(981) = lu(981) - lu(923) * lu(970) + lu(982) = lu(982) - lu(924) * lu(970) + lu(983) = lu(983) - lu(925) * lu(970) + lu(1052) = lu(1052) - lu(913) * lu(1051) + lu(1053) = lu(1053) - lu(914) * lu(1051) + lu(1054) = lu(1054) - lu(915) * lu(1051) + lu(1055) = lu(1055) - lu(916) * lu(1051) + lu(1056) = lu(1056) - lu(917) * lu(1051) + lu(1057) = lu(1057) - lu(918) * lu(1051) + lu(1058) = lu(1058) - lu(919) * lu(1051) + lu(1059) = lu(1059) - lu(920) * lu(1051) + lu(1060) = lu(1060) - lu(921) * lu(1051) + lu(1061) = lu(1061) - lu(922) * lu(1051) + lu(1062) = lu(1062) - lu(923) * lu(1051) + lu(1063) = lu(1063) - lu(924) * lu(1051) + lu(1064) = lu(1064) - lu(925) * lu(1051) + lu(1076) = lu(1076) - lu(913) * lu(1075) + lu(1077) = lu(1077) - lu(914) * lu(1075) + lu(1078) = lu(1078) - lu(915) * lu(1075) + lu(1079) = lu(1079) - lu(916) * lu(1075) + lu(1080) = lu(1080) - lu(917) * lu(1075) + lu(1081) = lu(1081) - lu(918) * lu(1075) + lu(1082) = lu(1082) - lu(919) * lu(1075) + lu(1083) = lu(1083) - lu(920) * lu(1075) + lu(1084) = lu(1084) - lu(921) * lu(1075) + lu(1085) = lu(1085) - lu(922) * lu(1075) + lu(1086) = lu(1086) - lu(923) * lu(1075) + lu(1087) = lu(1087) - lu(924) * lu(1075) + lu(1088) = lu(1088) - lu(925) * lu(1075) + lu(1175) = lu(1175) - lu(913) * lu(1174) + lu(1176) = lu(1176) - lu(914) * lu(1174) + lu(1177) = lu(1177) - lu(915) * lu(1174) + lu(1178) = lu(1178) - lu(916) * lu(1174) + lu(1179) = lu(1179) - lu(917) * lu(1174) + lu(1180) = lu(1180) - lu(918) * lu(1174) + lu(1181) = lu(1181) - lu(919) * lu(1174) + lu(1182) = lu(1182) - lu(920) * lu(1174) + lu(1183) = lu(1183) - lu(921) * lu(1174) + lu(1184) = lu(1184) - lu(922) * lu(1174) + lu(1185) = lu(1185) - lu(923) * lu(1174) + lu(1186) = lu(1186) - lu(924) * lu(1174) + lu(1187) = lu(1187) - lu(925) * lu(1174) + lu(1218) = lu(1218) - lu(913) * lu(1217) + lu(1219) = lu(1219) - lu(914) * lu(1217) + lu(1220) = lu(1220) - lu(915) * lu(1217) + lu(1221) = lu(1221) - lu(916) * lu(1217) + lu(1222) = lu(1222) - lu(917) * lu(1217) + lu(1223) = lu(1223) - lu(918) * lu(1217) + lu(1224) = lu(1224) - lu(919) * lu(1217) + lu(1225) = lu(1225) - lu(920) * lu(1217) + lu(1226) = lu(1226) - lu(921) * lu(1217) + lu(1227) = lu(1227) - lu(922) * lu(1217) + lu(1228) = lu(1228) - lu(923) * lu(1217) + lu(1229) = lu(1229) - lu(924) * lu(1217) + lu(1230) = lu(1230) - lu(925) * lu(1217) + lu(1239) = lu(1239) - lu(913) * lu(1238) + lu(1240) = lu(1240) - lu(914) * lu(1238) + lu(1241) = lu(1241) - lu(915) * lu(1238) + lu(1242) = lu(1242) - lu(916) * lu(1238) + lu(1243) = lu(1243) - lu(917) * lu(1238) + lu(1244) = - lu(918) * lu(1238) + lu(1245) = lu(1245) - lu(919) * lu(1238) + lu(1246) = lu(1246) - lu(920) * lu(1238) + lu(1247) = lu(1247) - lu(921) * lu(1238) + lu(1248) = lu(1248) - lu(922) * lu(1238) + lu(1249) = lu(1249) - lu(923) * lu(1238) + lu(1250) = lu(1250) - lu(924) * lu(1238) + lu(1251) = lu(1251) - lu(925) * lu(1238) + lu(1329) = lu(1329) - lu(913) * lu(1328) + lu(1330) = lu(1330) - lu(914) * lu(1328) + lu(1331) = lu(1331) - lu(915) * lu(1328) + lu(1332) = lu(1332) - lu(916) * lu(1328) + lu(1333) = lu(1333) - lu(917) * lu(1328) + lu(1334) = lu(1334) - lu(918) * lu(1328) + lu(1335) = lu(1335) - lu(919) * lu(1328) + lu(1336) = lu(1336) - lu(920) * lu(1328) + lu(1337) = lu(1337) - lu(921) * lu(1328) + lu(1338) = lu(1338) - lu(922) * lu(1328) + lu(1339) = lu(1339) - lu(923) * lu(1328) + lu(1340) = lu(1340) - lu(924) * lu(1328) + lu(1341) = lu(1341) - lu(925) * lu(1328) + lu(1353) = lu(1353) - lu(913) * lu(1352) + lu(1354) = lu(1354) - lu(914) * lu(1352) + lu(1355) = lu(1355) - lu(915) * lu(1352) + lu(1356) = lu(1356) - lu(916) * lu(1352) + lu(1357) = lu(1357) - lu(917) * lu(1352) + lu(1358) = lu(1358) - lu(918) * lu(1352) + lu(1359) = lu(1359) - lu(919) * lu(1352) + lu(1360) = lu(1360) - lu(920) * lu(1352) + lu(1361) = lu(1361) - lu(921) * lu(1352) + lu(1362) = lu(1362) - lu(922) * lu(1352) + lu(1363) = lu(1363) - lu(923) * lu(1352) + lu(1364) = lu(1364) - lu(924) * lu(1352) + lu(1365) = lu(1365) - lu(925) * lu(1352) + lu(1388) = lu(1388) - lu(913) * lu(1387) + lu(1389) = lu(1389) - lu(914) * lu(1387) + lu(1390) = lu(1390) - lu(915) * lu(1387) + lu(1391) = lu(1391) - lu(916) * lu(1387) + lu(1392) = lu(1392) - lu(917) * lu(1387) + lu(1393) = lu(1393) - lu(918) * lu(1387) + lu(1394) = lu(1394) - lu(919) * lu(1387) + lu(1395) = lu(1395) - lu(920) * lu(1387) + lu(1396) = lu(1396) - lu(921) * lu(1387) + lu(1397) = lu(1397) - lu(922) * lu(1387) + lu(1398) = lu(1398) - lu(923) * lu(1387) + lu(1399) = lu(1399) - lu(924) * lu(1387) + lu(1400) = lu(1400) - lu(925) * lu(1387) + lu(1422) = lu(1422) - lu(913) * lu(1421) + lu(1423) = lu(1423) - lu(914) * lu(1421) + lu(1424) = lu(1424) - lu(915) * lu(1421) + lu(1425) = lu(1425) - lu(916) * lu(1421) + lu(1426) = lu(1426) - lu(917) * lu(1421) + lu(1427) = lu(1427) - lu(918) * lu(1421) + lu(1428) = lu(1428) - lu(919) * lu(1421) + lu(1429) = lu(1429) - lu(920) * lu(1421) + lu(1430) = lu(1430) - lu(921) * lu(1421) + lu(1431) = lu(1431) - lu(922) * lu(1421) + lu(1432) = lu(1432) - lu(923) * lu(1421) + lu(1433) = lu(1433) - lu(924) * lu(1421) + lu(1434) = lu(1434) - lu(925) * lu(1421) + lu(1459) = lu(1459) - lu(913) * lu(1458) + lu(1460) = lu(1460) - lu(914) * lu(1458) + lu(1461) = lu(1461) - lu(915) * lu(1458) + lu(1462) = lu(1462) - lu(916) * lu(1458) + lu(1463) = lu(1463) - lu(917) * lu(1458) + lu(1464) = lu(1464) - lu(918) * lu(1458) + lu(1465) = lu(1465) - lu(919) * lu(1458) + lu(1466) = lu(1466) - lu(920) * lu(1458) + lu(1467) = lu(1467) - lu(921) * lu(1458) + lu(1468) = lu(1468) - lu(922) * lu(1458) + lu(1469) = lu(1469) - lu(923) * lu(1458) + lu(1470) = lu(1470) - lu(924) * lu(1458) + lu(1471) = lu(1471) - lu(925) * lu(1458) + end subroutine lu_fac18 + subroutine lu_fac19( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(971) = 1._r8 / lu(971) + lu(972) = lu(972) * lu(971) + lu(973) = lu(973) * lu(971) + lu(974) = lu(974) * lu(971) + lu(975) = lu(975) * lu(971) + lu(976) = lu(976) * lu(971) + lu(977) = lu(977) * lu(971) + lu(978) = lu(978) * lu(971) + lu(979) = lu(979) * lu(971) + lu(980) = lu(980) * lu(971) + lu(981) = lu(981) * lu(971) + lu(982) = lu(982) * lu(971) + lu(983) = lu(983) * lu(971) + lu(1013) = lu(1013) - lu(972) * lu(1012) + lu(1014) = lu(1014) - lu(973) * lu(1012) + lu(1015) = lu(1015) - lu(974) * lu(1012) + lu(1016) = lu(1016) - lu(975) * lu(1012) + lu(1017) = lu(1017) - lu(976) * lu(1012) + lu(1018) = lu(1018) - lu(977) * lu(1012) + lu(1019) = lu(1019) - lu(978) * lu(1012) + lu(1020) = lu(1020) - lu(979) * lu(1012) + lu(1021) = lu(1021) - lu(980) * lu(1012) + lu(1022) = lu(1022) - lu(981) * lu(1012) + lu(1023) = lu(1023) - lu(982) * lu(1012) + lu(1024) = lu(1024) - lu(983) * lu(1012) + lu(1053) = lu(1053) - lu(972) * lu(1052) + lu(1054) = lu(1054) - lu(973) * lu(1052) + lu(1055) = lu(1055) - lu(974) * lu(1052) + lu(1056) = lu(1056) - lu(975) * lu(1052) + lu(1057) = lu(1057) - lu(976) * lu(1052) + lu(1058) = lu(1058) - lu(977) * lu(1052) + lu(1059) = lu(1059) - lu(978) * lu(1052) + lu(1060) = lu(1060) - lu(979) * lu(1052) + lu(1061) = lu(1061) - lu(980) * lu(1052) + lu(1062) = lu(1062) - lu(981) * lu(1052) + lu(1063) = lu(1063) - lu(982) * lu(1052) + lu(1064) = lu(1064) - lu(983) * lu(1052) + lu(1077) = lu(1077) - lu(972) * lu(1076) + lu(1078) = lu(1078) - lu(973) * lu(1076) + lu(1079) = lu(1079) - lu(974) * lu(1076) + lu(1080) = lu(1080) - lu(975) * lu(1076) + lu(1081) = lu(1081) - lu(976) * lu(1076) + lu(1082) = lu(1082) - lu(977) * lu(1076) + lu(1083) = lu(1083) - lu(978) * lu(1076) + lu(1084) = lu(1084) - lu(979) * lu(1076) + lu(1085) = lu(1085) - lu(980) * lu(1076) + lu(1086) = lu(1086) - lu(981) * lu(1076) + lu(1087) = lu(1087) - lu(982) * lu(1076) + lu(1088) = lu(1088) - lu(983) * lu(1076) + lu(1176) = lu(1176) - lu(972) * lu(1175) + lu(1177) = lu(1177) - lu(973) * lu(1175) + lu(1178) = lu(1178) - lu(974) * lu(1175) + lu(1179) = lu(1179) - lu(975) * lu(1175) + lu(1180) = lu(1180) - lu(976) * lu(1175) + lu(1181) = lu(1181) - lu(977) * lu(1175) + lu(1182) = lu(1182) - lu(978) * lu(1175) + lu(1183) = lu(1183) - lu(979) * lu(1175) + lu(1184) = lu(1184) - lu(980) * lu(1175) + lu(1185) = lu(1185) - lu(981) * lu(1175) + lu(1186) = lu(1186) - lu(982) * lu(1175) + lu(1187) = lu(1187) - lu(983) * lu(1175) + lu(1219) = lu(1219) - lu(972) * lu(1218) + lu(1220) = lu(1220) - lu(973) * lu(1218) + lu(1221) = lu(1221) - lu(974) * lu(1218) + lu(1222) = lu(1222) - lu(975) * lu(1218) + lu(1223) = lu(1223) - lu(976) * lu(1218) + lu(1224) = lu(1224) - lu(977) * lu(1218) + lu(1225) = lu(1225) - lu(978) * lu(1218) + lu(1226) = lu(1226) - lu(979) * lu(1218) + lu(1227) = lu(1227) - lu(980) * lu(1218) + lu(1228) = lu(1228) - lu(981) * lu(1218) + lu(1229) = lu(1229) - lu(982) * lu(1218) + lu(1230) = lu(1230) - lu(983) * lu(1218) + lu(1240) = lu(1240) - lu(972) * lu(1239) + lu(1241) = lu(1241) - lu(973) * lu(1239) + lu(1242) = lu(1242) - lu(974) * lu(1239) + lu(1243) = lu(1243) - lu(975) * lu(1239) + lu(1244) = lu(1244) - lu(976) * lu(1239) + lu(1245) = lu(1245) - lu(977) * lu(1239) + lu(1246) = lu(1246) - lu(978) * lu(1239) + lu(1247) = lu(1247) - lu(979) * lu(1239) + lu(1248) = lu(1248) - lu(980) * lu(1239) + lu(1249) = lu(1249) - lu(981) * lu(1239) + lu(1250) = lu(1250) - lu(982) * lu(1239) + lu(1251) = lu(1251) - lu(983) * lu(1239) + lu(1257) = lu(1257) - lu(972) * lu(1256) + lu(1258) = lu(1258) - lu(973) * lu(1256) + lu(1259) = lu(1259) - lu(974) * lu(1256) + lu(1260) = lu(1260) - lu(975) * lu(1256) + lu(1261) = lu(1261) - lu(976) * lu(1256) + lu(1262) = lu(1262) - lu(977) * lu(1256) + lu(1263) = lu(1263) - lu(978) * lu(1256) + lu(1264) = lu(1264) - lu(979) * lu(1256) + lu(1265) = lu(1265) - lu(980) * lu(1256) + lu(1266) = lu(1266) - lu(981) * lu(1256) + lu(1267) = lu(1267) - lu(982) * lu(1256) + lu(1268) = lu(1268) - lu(983) * lu(1256) + lu(1330) = lu(1330) - lu(972) * lu(1329) + lu(1331) = lu(1331) - lu(973) * lu(1329) + lu(1332) = lu(1332) - lu(974) * lu(1329) + lu(1333) = lu(1333) - lu(975) * lu(1329) + lu(1334) = lu(1334) - lu(976) * lu(1329) + lu(1335) = lu(1335) - lu(977) * lu(1329) + lu(1336) = lu(1336) - lu(978) * lu(1329) + lu(1337) = lu(1337) - lu(979) * lu(1329) + lu(1338) = lu(1338) - lu(980) * lu(1329) + lu(1339) = lu(1339) - lu(981) * lu(1329) + lu(1340) = lu(1340) - lu(982) * lu(1329) + lu(1341) = lu(1341) - lu(983) * lu(1329) + lu(1354) = lu(1354) - lu(972) * lu(1353) + lu(1355) = lu(1355) - lu(973) * lu(1353) + lu(1356) = lu(1356) - lu(974) * lu(1353) + lu(1357) = lu(1357) - lu(975) * lu(1353) + lu(1358) = lu(1358) - lu(976) * lu(1353) + lu(1359) = lu(1359) - lu(977) * lu(1353) + lu(1360) = lu(1360) - lu(978) * lu(1353) + lu(1361) = lu(1361) - lu(979) * lu(1353) + lu(1362) = lu(1362) - lu(980) * lu(1353) + lu(1363) = lu(1363) - lu(981) * lu(1353) + lu(1364) = lu(1364) - lu(982) * lu(1353) + lu(1365) = lu(1365) - lu(983) * lu(1353) + lu(1389) = lu(1389) - lu(972) * lu(1388) + lu(1390) = lu(1390) - lu(973) * lu(1388) + lu(1391) = lu(1391) - lu(974) * lu(1388) + lu(1392) = lu(1392) - lu(975) * lu(1388) + lu(1393) = lu(1393) - lu(976) * lu(1388) + lu(1394) = lu(1394) - lu(977) * lu(1388) + lu(1395) = lu(1395) - lu(978) * lu(1388) + lu(1396) = lu(1396) - lu(979) * lu(1388) + lu(1397) = lu(1397) - lu(980) * lu(1388) + lu(1398) = lu(1398) - lu(981) * lu(1388) + lu(1399) = lu(1399) - lu(982) * lu(1388) + lu(1400) = lu(1400) - lu(983) * lu(1388) + lu(1423) = lu(1423) - lu(972) * lu(1422) + lu(1424) = lu(1424) - lu(973) * lu(1422) + lu(1425) = lu(1425) - lu(974) * lu(1422) + lu(1426) = lu(1426) - lu(975) * lu(1422) + lu(1427) = lu(1427) - lu(976) * lu(1422) + lu(1428) = lu(1428) - lu(977) * lu(1422) + lu(1429) = lu(1429) - lu(978) * lu(1422) + lu(1430) = lu(1430) - lu(979) * lu(1422) + lu(1431) = lu(1431) - lu(980) * lu(1422) + lu(1432) = lu(1432) - lu(981) * lu(1422) + lu(1433) = lu(1433) - lu(982) * lu(1422) + lu(1434) = lu(1434) - lu(983) * lu(1422) + lu(1460) = lu(1460) - lu(972) * lu(1459) + lu(1461) = lu(1461) - lu(973) * lu(1459) + lu(1462) = lu(1462) - lu(974) * lu(1459) + lu(1463) = lu(1463) - lu(975) * lu(1459) + lu(1464) = lu(1464) - lu(976) * lu(1459) + lu(1465) = lu(1465) - lu(977) * lu(1459) + lu(1466) = lu(1466) - lu(978) * lu(1459) + lu(1467) = lu(1467) - lu(979) * lu(1459) + lu(1468) = lu(1468) - lu(980) * lu(1459) + lu(1469) = lu(1469) - lu(981) * lu(1459) + lu(1470) = lu(1470) - lu(982) * lu(1459) + lu(1471) = lu(1471) - lu(983) * lu(1459) + lu(1013) = 1._r8 / lu(1013) + lu(1014) = lu(1014) * lu(1013) + lu(1015) = lu(1015) * lu(1013) + lu(1016) = lu(1016) * lu(1013) + lu(1017) = lu(1017) * lu(1013) + lu(1018) = lu(1018) * lu(1013) + lu(1019) = lu(1019) * lu(1013) + lu(1020) = lu(1020) * lu(1013) + lu(1021) = lu(1021) * lu(1013) + lu(1022) = lu(1022) * lu(1013) + lu(1023) = lu(1023) * lu(1013) + lu(1024) = lu(1024) * lu(1013) + lu(1054) = lu(1054) - lu(1014) * lu(1053) + lu(1055) = lu(1055) - lu(1015) * lu(1053) + lu(1056) = lu(1056) - lu(1016) * lu(1053) + lu(1057) = lu(1057) - lu(1017) * lu(1053) + lu(1058) = lu(1058) - lu(1018) * lu(1053) + lu(1059) = lu(1059) - lu(1019) * lu(1053) + lu(1060) = lu(1060) - lu(1020) * lu(1053) + lu(1061) = lu(1061) - lu(1021) * lu(1053) + lu(1062) = lu(1062) - lu(1022) * lu(1053) + lu(1063) = lu(1063) - lu(1023) * lu(1053) + lu(1064) = lu(1064) - lu(1024) * lu(1053) + lu(1078) = lu(1078) - lu(1014) * lu(1077) + lu(1079) = lu(1079) - lu(1015) * lu(1077) + lu(1080) = lu(1080) - lu(1016) * lu(1077) + lu(1081) = lu(1081) - lu(1017) * lu(1077) + lu(1082) = lu(1082) - lu(1018) * lu(1077) + lu(1083) = lu(1083) - lu(1019) * lu(1077) + lu(1084) = lu(1084) - lu(1020) * lu(1077) + lu(1085) = lu(1085) - lu(1021) * lu(1077) + lu(1086) = lu(1086) - lu(1022) * lu(1077) + lu(1087) = lu(1087) - lu(1023) * lu(1077) + lu(1088) = lu(1088) - lu(1024) * lu(1077) + lu(1177) = lu(1177) - lu(1014) * lu(1176) + lu(1178) = lu(1178) - lu(1015) * lu(1176) + lu(1179) = lu(1179) - lu(1016) * lu(1176) + lu(1180) = lu(1180) - lu(1017) * lu(1176) + lu(1181) = lu(1181) - lu(1018) * lu(1176) + lu(1182) = lu(1182) - lu(1019) * lu(1176) + lu(1183) = lu(1183) - lu(1020) * lu(1176) + lu(1184) = lu(1184) - lu(1021) * lu(1176) + lu(1185) = lu(1185) - lu(1022) * lu(1176) + lu(1186) = lu(1186) - lu(1023) * lu(1176) + lu(1187) = lu(1187) - lu(1024) * lu(1176) + lu(1220) = lu(1220) - lu(1014) * lu(1219) + lu(1221) = lu(1221) - lu(1015) * lu(1219) + lu(1222) = lu(1222) - lu(1016) * lu(1219) + lu(1223) = lu(1223) - lu(1017) * lu(1219) + lu(1224) = lu(1224) - lu(1018) * lu(1219) + lu(1225) = lu(1225) - lu(1019) * lu(1219) + lu(1226) = lu(1226) - lu(1020) * lu(1219) + lu(1227) = lu(1227) - lu(1021) * lu(1219) + lu(1228) = lu(1228) - lu(1022) * lu(1219) + lu(1229) = lu(1229) - lu(1023) * lu(1219) + lu(1230) = lu(1230) - lu(1024) * lu(1219) + lu(1241) = lu(1241) - lu(1014) * lu(1240) + lu(1242) = lu(1242) - lu(1015) * lu(1240) + lu(1243) = lu(1243) - lu(1016) * lu(1240) + lu(1244) = lu(1244) - lu(1017) * lu(1240) + lu(1245) = lu(1245) - lu(1018) * lu(1240) + lu(1246) = lu(1246) - lu(1019) * lu(1240) + lu(1247) = lu(1247) - lu(1020) * lu(1240) + lu(1248) = lu(1248) - lu(1021) * lu(1240) + lu(1249) = lu(1249) - lu(1022) * lu(1240) + lu(1250) = lu(1250) - lu(1023) * lu(1240) + lu(1251) = lu(1251) - lu(1024) * lu(1240) + lu(1258) = lu(1258) - lu(1014) * lu(1257) + lu(1259) = lu(1259) - lu(1015) * lu(1257) + lu(1260) = lu(1260) - lu(1016) * lu(1257) + lu(1261) = lu(1261) - lu(1017) * lu(1257) + lu(1262) = lu(1262) - lu(1018) * lu(1257) + lu(1263) = lu(1263) - lu(1019) * lu(1257) + lu(1264) = lu(1264) - lu(1020) * lu(1257) + lu(1265) = lu(1265) - lu(1021) * lu(1257) + lu(1266) = lu(1266) - lu(1022) * lu(1257) + lu(1267) = lu(1267) - lu(1023) * lu(1257) + lu(1268) = lu(1268) - lu(1024) * lu(1257) + lu(1331) = lu(1331) - lu(1014) * lu(1330) + lu(1332) = lu(1332) - lu(1015) * lu(1330) + lu(1333) = lu(1333) - lu(1016) * lu(1330) + lu(1334) = lu(1334) - lu(1017) * lu(1330) + lu(1335) = lu(1335) - lu(1018) * lu(1330) + lu(1336) = lu(1336) - lu(1019) * lu(1330) + lu(1337) = lu(1337) - lu(1020) * lu(1330) + lu(1338) = lu(1338) - lu(1021) * lu(1330) + lu(1339) = lu(1339) - lu(1022) * lu(1330) + lu(1340) = lu(1340) - lu(1023) * lu(1330) + lu(1341) = lu(1341) - lu(1024) * lu(1330) + lu(1355) = lu(1355) - lu(1014) * lu(1354) + lu(1356) = lu(1356) - lu(1015) * lu(1354) + lu(1357) = lu(1357) - lu(1016) * lu(1354) + lu(1358) = lu(1358) - lu(1017) * lu(1354) + lu(1359) = lu(1359) - lu(1018) * lu(1354) + lu(1360) = lu(1360) - lu(1019) * lu(1354) + lu(1361) = lu(1361) - lu(1020) * lu(1354) + lu(1362) = lu(1362) - lu(1021) * lu(1354) + lu(1363) = lu(1363) - lu(1022) * lu(1354) + lu(1364) = lu(1364) - lu(1023) * lu(1354) + lu(1365) = lu(1365) - lu(1024) * lu(1354) + lu(1390) = lu(1390) - lu(1014) * lu(1389) + lu(1391) = lu(1391) - lu(1015) * lu(1389) + lu(1392) = lu(1392) - lu(1016) * lu(1389) + lu(1393) = lu(1393) - lu(1017) * lu(1389) + lu(1394) = lu(1394) - lu(1018) * lu(1389) + lu(1395) = lu(1395) - lu(1019) * lu(1389) + lu(1396) = lu(1396) - lu(1020) * lu(1389) + lu(1397) = lu(1397) - lu(1021) * lu(1389) + lu(1398) = lu(1398) - lu(1022) * lu(1389) + lu(1399) = lu(1399) - lu(1023) * lu(1389) + lu(1400) = lu(1400) - lu(1024) * lu(1389) + lu(1424) = lu(1424) - lu(1014) * lu(1423) + lu(1425) = lu(1425) - lu(1015) * lu(1423) + lu(1426) = lu(1426) - lu(1016) * lu(1423) + lu(1427) = lu(1427) - lu(1017) * lu(1423) + lu(1428) = lu(1428) - lu(1018) * lu(1423) + lu(1429) = lu(1429) - lu(1019) * lu(1423) + lu(1430) = lu(1430) - lu(1020) * lu(1423) + lu(1431) = lu(1431) - lu(1021) * lu(1423) + lu(1432) = lu(1432) - lu(1022) * lu(1423) + lu(1433) = lu(1433) - lu(1023) * lu(1423) + lu(1434) = lu(1434) - lu(1024) * lu(1423) + lu(1461) = lu(1461) - lu(1014) * lu(1460) + lu(1462) = lu(1462) - lu(1015) * lu(1460) + lu(1463) = lu(1463) - lu(1016) * lu(1460) + lu(1464) = lu(1464) - lu(1017) * lu(1460) + lu(1465) = lu(1465) - lu(1018) * lu(1460) + lu(1466) = lu(1466) - lu(1019) * lu(1460) + lu(1467) = lu(1467) - lu(1020) * lu(1460) + lu(1468) = lu(1468) - lu(1021) * lu(1460) + lu(1469) = lu(1469) - lu(1022) * lu(1460) + lu(1470) = lu(1470) - lu(1023) * lu(1460) + lu(1471) = lu(1471) - lu(1024) * lu(1460) + lu(1054) = 1._r8 / lu(1054) + lu(1055) = lu(1055) * lu(1054) + lu(1056) = lu(1056) * lu(1054) + lu(1057) = lu(1057) * lu(1054) + lu(1058) = lu(1058) * lu(1054) + lu(1059) = lu(1059) * lu(1054) + lu(1060) = lu(1060) * lu(1054) + lu(1061) = lu(1061) * lu(1054) + lu(1062) = lu(1062) * lu(1054) + lu(1063) = lu(1063) * lu(1054) + lu(1064) = lu(1064) * lu(1054) + lu(1079) = lu(1079) - lu(1055) * lu(1078) + lu(1080) = lu(1080) - lu(1056) * lu(1078) + lu(1081) = lu(1081) - lu(1057) * lu(1078) + lu(1082) = lu(1082) - lu(1058) * lu(1078) + lu(1083) = lu(1083) - lu(1059) * lu(1078) + lu(1084) = lu(1084) - lu(1060) * lu(1078) + lu(1085) = lu(1085) - lu(1061) * lu(1078) + lu(1086) = lu(1086) - lu(1062) * lu(1078) + lu(1087) = lu(1087) - lu(1063) * lu(1078) + lu(1088) = lu(1088) - lu(1064) * lu(1078) + lu(1178) = lu(1178) - lu(1055) * lu(1177) + lu(1179) = lu(1179) - lu(1056) * lu(1177) + lu(1180) = lu(1180) - lu(1057) * lu(1177) + lu(1181) = lu(1181) - lu(1058) * lu(1177) + lu(1182) = lu(1182) - lu(1059) * lu(1177) + lu(1183) = lu(1183) - lu(1060) * lu(1177) + lu(1184) = lu(1184) - lu(1061) * lu(1177) + lu(1185) = lu(1185) - lu(1062) * lu(1177) + lu(1186) = lu(1186) - lu(1063) * lu(1177) + lu(1187) = lu(1187) - lu(1064) * lu(1177) + lu(1221) = lu(1221) - lu(1055) * lu(1220) + lu(1222) = lu(1222) - lu(1056) * lu(1220) + lu(1223) = lu(1223) - lu(1057) * lu(1220) + lu(1224) = lu(1224) - lu(1058) * lu(1220) + lu(1225) = lu(1225) - lu(1059) * lu(1220) + lu(1226) = lu(1226) - lu(1060) * lu(1220) + lu(1227) = lu(1227) - lu(1061) * lu(1220) + lu(1228) = lu(1228) - lu(1062) * lu(1220) + lu(1229) = lu(1229) - lu(1063) * lu(1220) + lu(1230) = lu(1230) - lu(1064) * lu(1220) + lu(1242) = lu(1242) - lu(1055) * lu(1241) + lu(1243) = lu(1243) - lu(1056) * lu(1241) + lu(1244) = lu(1244) - lu(1057) * lu(1241) + lu(1245) = lu(1245) - lu(1058) * lu(1241) + lu(1246) = lu(1246) - lu(1059) * lu(1241) + lu(1247) = lu(1247) - lu(1060) * lu(1241) + lu(1248) = lu(1248) - lu(1061) * lu(1241) + lu(1249) = lu(1249) - lu(1062) * lu(1241) + lu(1250) = lu(1250) - lu(1063) * lu(1241) + lu(1251) = lu(1251) - lu(1064) * lu(1241) + lu(1259) = lu(1259) - lu(1055) * lu(1258) + lu(1260) = lu(1260) - lu(1056) * lu(1258) + lu(1261) = lu(1261) - lu(1057) * lu(1258) + lu(1262) = lu(1262) - lu(1058) * lu(1258) + lu(1263) = lu(1263) - lu(1059) * lu(1258) + lu(1264) = lu(1264) - lu(1060) * lu(1258) + lu(1265) = lu(1265) - lu(1061) * lu(1258) + lu(1266) = lu(1266) - lu(1062) * lu(1258) + lu(1267) = lu(1267) - lu(1063) * lu(1258) + lu(1268) = lu(1268) - lu(1064) * lu(1258) + lu(1332) = lu(1332) - lu(1055) * lu(1331) + lu(1333) = lu(1333) - lu(1056) * lu(1331) + lu(1334) = lu(1334) - lu(1057) * lu(1331) + lu(1335) = lu(1335) - lu(1058) * lu(1331) + lu(1336) = lu(1336) - lu(1059) * lu(1331) + lu(1337) = lu(1337) - lu(1060) * lu(1331) + lu(1338) = lu(1338) - lu(1061) * lu(1331) + lu(1339) = lu(1339) - lu(1062) * lu(1331) + lu(1340) = lu(1340) - lu(1063) * lu(1331) + lu(1341) = lu(1341) - lu(1064) * lu(1331) + lu(1356) = lu(1356) - lu(1055) * lu(1355) + lu(1357) = lu(1357) - lu(1056) * lu(1355) + lu(1358) = lu(1358) - lu(1057) * lu(1355) + lu(1359) = lu(1359) - lu(1058) * lu(1355) + lu(1360) = lu(1360) - lu(1059) * lu(1355) + lu(1361) = lu(1361) - lu(1060) * lu(1355) + lu(1362) = lu(1362) - lu(1061) * lu(1355) + lu(1363) = lu(1363) - lu(1062) * lu(1355) + lu(1364) = lu(1364) - lu(1063) * lu(1355) + lu(1365) = lu(1365) - lu(1064) * lu(1355) + lu(1391) = lu(1391) - lu(1055) * lu(1390) + lu(1392) = lu(1392) - lu(1056) * lu(1390) + lu(1393) = lu(1393) - lu(1057) * lu(1390) + lu(1394) = lu(1394) - lu(1058) * lu(1390) + lu(1395) = lu(1395) - lu(1059) * lu(1390) + lu(1396) = lu(1396) - lu(1060) * lu(1390) + lu(1397) = lu(1397) - lu(1061) * lu(1390) + lu(1398) = lu(1398) - lu(1062) * lu(1390) + lu(1399) = lu(1399) - lu(1063) * lu(1390) + lu(1400) = lu(1400) - lu(1064) * lu(1390) + lu(1425) = lu(1425) - lu(1055) * lu(1424) + lu(1426) = lu(1426) - lu(1056) * lu(1424) + lu(1427) = lu(1427) - lu(1057) * lu(1424) + lu(1428) = lu(1428) - lu(1058) * lu(1424) + lu(1429) = lu(1429) - lu(1059) * lu(1424) + lu(1430) = lu(1430) - lu(1060) * lu(1424) + lu(1431) = lu(1431) - lu(1061) * lu(1424) + lu(1432) = lu(1432) - lu(1062) * lu(1424) + lu(1433) = lu(1433) - lu(1063) * lu(1424) + lu(1434) = lu(1434) - lu(1064) * lu(1424) + lu(1462) = lu(1462) - lu(1055) * lu(1461) + lu(1463) = lu(1463) - lu(1056) * lu(1461) + lu(1464) = lu(1464) - lu(1057) * lu(1461) + lu(1465) = lu(1465) - lu(1058) * lu(1461) + lu(1466) = lu(1466) - lu(1059) * lu(1461) + lu(1467) = lu(1467) - lu(1060) * lu(1461) + lu(1468) = lu(1468) - lu(1061) * lu(1461) + lu(1469) = lu(1469) - lu(1062) * lu(1461) + lu(1470) = lu(1470) - lu(1063) * lu(1461) + lu(1471) = lu(1471) - lu(1064) * lu(1461) + lu(1079) = 1._r8 / lu(1079) + lu(1080) = lu(1080) * lu(1079) + lu(1081) = lu(1081) * lu(1079) + lu(1082) = lu(1082) * lu(1079) + lu(1083) = lu(1083) * lu(1079) + lu(1084) = lu(1084) * lu(1079) + lu(1085) = lu(1085) * lu(1079) + lu(1086) = lu(1086) * lu(1079) + lu(1087) = lu(1087) * lu(1079) + lu(1088) = lu(1088) * lu(1079) + lu(1179) = lu(1179) - lu(1080) * lu(1178) + lu(1180) = lu(1180) - lu(1081) * lu(1178) + lu(1181) = lu(1181) - lu(1082) * lu(1178) + lu(1182) = lu(1182) - lu(1083) * lu(1178) + lu(1183) = lu(1183) - lu(1084) * lu(1178) + lu(1184) = lu(1184) - lu(1085) * lu(1178) + lu(1185) = lu(1185) - lu(1086) * lu(1178) + lu(1186) = lu(1186) - lu(1087) * lu(1178) + lu(1187) = lu(1187) - lu(1088) * lu(1178) + lu(1222) = lu(1222) - lu(1080) * lu(1221) + lu(1223) = lu(1223) - lu(1081) * lu(1221) + lu(1224) = lu(1224) - lu(1082) * lu(1221) + lu(1225) = lu(1225) - lu(1083) * lu(1221) + lu(1226) = lu(1226) - lu(1084) * lu(1221) + lu(1227) = lu(1227) - lu(1085) * lu(1221) + lu(1228) = lu(1228) - lu(1086) * lu(1221) + lu(1229) = lu(1229) - lu(1087) * lu(1221) + lu(1230) = lu(1230) - lu(1088) * lu(1221) + lu(1243) = lu(1243) - lu(1080) * lu(1242) + lu(1244) = lu(1244) - lu(1081) * lu(1242) + lu(1245) = lu(1245) - lu(1082) * lu(1242) + lu(1246) = lu(1246) - lu(1083) * lu(1242) + lu(1247) = lu(1247) - lu(1084) * lu(1242) + lu(1248) = lu(1248) - lu(1085) * lu(1242) + lu(1249) = lu(1249) - lu(1086) * lu(1242) + lu(1250) = lu(1250) - lu(1087) * lu(1242) + lu(1251) = lu(1251) - lu(1088) * lu(1242) + lu(1260) = lu(1260) - lu(1080) * lu(1259) + lu(1261) = lu(1261) - lu(1081) * lu(1259) + lu(1262) = lu(1262) - lu(1082) * lu(1259) + lu(1263) = lu(1263) - lu(1083) * lu(1259) + lu(1264) = lu(1264) - lu(1084) * lu(1259) + lu(1265) = lu(1265) - lu(1085) * lu(1259) + lu(1266) = lu(1266) - lu(1086) * lu(1259) + lu(1267) = lu(1267) - lu(1087) * lu(1259) + lu(1268) = lu(1268) - lu(1088) * lu(1259) + lu(1333) = lu(1333) - lu(1080) * lu(1332) + lu(1334) = lu(1334) - lu(1081) * lu(1332) + lu(1335) = lu(1335) - lu(1082) * lu(1332) + lu(1336) = lu(1336) - lu(1083) * lu(1332) + lu(1337) = lu(1337) - lu(1084) * lu(1332) + lu(1338) = lu(1338) - lu(1085) * lu(1332) + lu(1339) = lu(1339) - lu(1086) * lu(1332) + lu(1340) = lu(1340) - lu(1087) * lu(1332) + lu(1341) = lu(1341) - lu(1088) * lu(1332) + lu(1357) = lu(1357) - lu(1080) * lu(1356) + lu(1358) = lu(1358) - lu(1081) * lu(1356) + lu(1359) = lu(1359) - lu(1082) * lu(1356) + lu(1360) = lu(1360) - lu(1083) * lu(1356) + lu(1361) = lu(1361) - lu(1084) * lu(1356) + lu(1362) = lu(1362) - lu(1085) * lu(1356) + lu(1363) = lu(1363) - lu(1086) * lu(1356) + lu(1364) = lu(1364) - lu(1087) * lu(1356) + lu(1365) = lu(1365) - lu(1088) * lu(1356) + lu(1392) = lu(1392) - lu(1080) * lu(1391) + lu(1393) = lu(1393) - lu(1081) * lu(1391) + lu(1394) = lu(1394) - lu(1082) * lu(1391) + lu(1395) = lu(1395) - lu(1083) * lu(1391) + lu(1396) = lu(1396) - lu(1084) * lu(1391) + lu(1397) = lu(1397) - lu(1085) * lu(1391) + lu(1398) = lu(1398) - lu(1086) * lu(1391) + lu(1399) = lu(1399) - lu(1087) * lu(1391) + lu(1400) = lu(1400) - lu(1088) * lu(1391) + lu(1426) = lu(1426) - lu(1080) * lu(1425) + lu(1427) = lu(1427) - lu(1081) * lu(1425) + lu(1428) = lu(1428) - lu(1082) * lu(1425) + lu(1429) = lu(1429) - lu(1083) * lu(1425) + lu(1430) = lu(1430) - lu(1084) * lu(1425) + lu(1431) = lu(1431) - lu(1085) * lu(1425) + lu(1432) = lu(1432) - lu(1086) * lu(1425) + lu(1433) = lu(1433) - lu(1087) * lu(1425) + lu(1434) = lu(1434) - lu(1088) * lu(1425) + lu(1463) = lu(1463) - lu(1080) * lu(1462) + lu(1464) = lu(1464) - lu(1081) * lu(1462) + lu(1465) = lu(1465) - lu(1082) * lu(1462) + lu(1466) = lu(1466) - lu(1083) * lu(1462) + lu(1467) = lu(1467) - lu(1084) * lu(1462) + lu(1468) = lu(1468) - lu(1085) * lu(1462) + lu(1469) = lu(1469) - lu(1086) * lu(1462) + lu(1470) = lu(1470) - lu(1087) * lu(1462) + lu(1471) = lu(1471) - lu(1088) * lu(1462) + lu(1179) = 1._r8 / lu(1179) + lu(1180) = lu(1180) * lu(1179) + lu(1181) = lu(1181) * lu(1179) + lu(1182) = lu(1182) * lu(1179) + lu(1183) = lu(1183) * lu(1179) + lu(1184) = lu(1184) * lu(1179) + lu(1185) = lu(1185) * lu(1179) + lu(1186) = lu(1186) * lu(1179) + lu(1187) = lu(1187) * lu(1179) + lu(1223) = lu(1223) - lu(1180) * lu(1222) + lu(1224) = lu(1224) - lu(1181) * lu(1222) + lu(1225) = lu(1225) - lu(1182) * lu(1222) + lu(1226) = lu(1226) - lu(1183) * lu(1222) + lu(1227) = lu(1227) - lu(1184) * lu(1222) + lu(1228) = lu(1228) - lu(1185) * lu(1222) + lu(1229) = lu(1229) - lu(1186) * lu(1222) + lu(1230) = lu(1230) - lu(1187) * lu(1222) + lu(1244) = lu(1244) - lu(1180) * lu(1243) + lu(1245) = lu(1245) - lu(1181) * lu(1243) + lu(1246) = lu(1246) - lu(1182) * lu(1243) + lu(1247) = lu(1247) - lu(1183) * lu(1243) + lu(1248) = lu(1248) - lu(1184) * lu(1243) + lu(1249) = lu(1249) - lu(1185) * lu(1243) + lu(1250) = lu(1250) - lu(1186) * lu(1243) + lu(1251) = lu(1251) - lu(1187) * lu(1243) + lu(1261) = lu(1261) - lu(1180) * lu(1260) + lu(1262) = lu(1262) - lu(1181) * lu(1260) + lu(1263) = lu(1263) - lu(1182) * lu(1260) + lu(1264) = lu(1264) - lu(1183) * lu(1260) + lu(1265) = lu(1265) - lu(1184) * lu(1260) + lu(1266) = lu(1266) - lu(1185) * lu(1260) + lu(1267) = lu(1267) - lu(1186) * lu(1260) + lu(1268) = lu(1268) - lu(1187) * lu(1260) + lu(1334) = lu(1334) - lu(1180) * lu(1333) + lu(1335) = lu(1335) - lu(1181) * lu(1333) + lu(1336) = lu(1336) - lu(1182) * lu(1333) + lu(1337) = lu(1337) - lu(1183) * lu(1333) + lu(1338) = lu(1338) - lu(1184) * lu(1333) + lu(1339) = lu(1339) - lu(1185) * lu(1333) + lu(1340) = lu(1340) - lu(1186) * lu(1333) + lu(1341) = lu(1341) - lu(1187) * lu(1333) + lu(1358) = lu(1358) - lu(1180) * lu(1357) + lu(1359) = lu(1359) - lu(1181) * lu(1357) + lu(1360) = lu(1360) - lu(1182) * lu(1357) + lu(1361) = lu(1361) - lu(1183) * lu(1357) + lu(1362) = lu(1362) - lu(1184) * lu(1357) + lu(1363) = lu(1363) - lu(1185) * lu(1357) + lu(1364) = lu(1364) - lu(1186) * lu(1357) + lu(1365) = lu(1365) - lu(1187) * lu(1357) + lu(1393) = lu(1393) - lu(1180) * lu(1392) + lu(1394) = lu(1394) - lu(1181) * lu(1392) + lu(1395) = lu(1395) - lu(1182) * lu(1392) + lu(1396) = lu(1396) - lu(1183) * lu(1392) + lu(1397) = lu(1397) - lu(1184) * lu(1392) + lu(1398) = lu(1398) - lu(1185) * lu(1392) + lu(1399) = lu(1399) - lu(1186) * lu(1392) + lu(1400) = lu(1400) - lu(1187) * lu(1392) + lu(1427) = lu(1427) - lu(1180) * lu(1426) + lu(1428) = lu(1428) - lu(1181) * lu(1426) + lu(1429) = lu(1429) - lu(1182) * lu(1426) + lu(1430) = lu(1430) - lu(1183) * lu(1426) + lu(1431) = lu(1431) - lu(1184) * lu(1426) + lu(1432) = lu(1432) - lu(1185) * lu(1426) + lu(1433) = lu(1433) - lu(1186) * lu(1426) + lu(1434) = lu(1434) - lu(1187) * lu(1426) + lu(1464) = lu(1464) - lu(1180) * lu(1463) + lu(1465) = lu(1465) - lu(1181) * lu(1463) + lu(1466) = lu(1466) - lu(1182) * lu(1463) + lu(1467) = lu(1467) - lu(1183) * lu(1463) + lu(1468) = lu(1468) - lu(1184) * lu(1463) + lu(1469) = lu(1469) - lu(1185) * lu(1463) + lu(1470) = lu(1470) - lu(1186) * lu(1463) + lu(1471) = lu(1471) - lu(1187) * lu(1463) + end subroutine lu_fac19 + subroutine lu_fac20( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1223) = 1._r8 / lu(1223) + lu(1224) = lu(1224) * lu(1223) + lu(1225) = lu(1225) * lu(1223) + lu(1226) = lu(1226) * lu(1223) + lu(1227) = lu(1227) * lu(1223) + lu(1228) = lu(1228) * lu(1223) + lu(1229) = lu(1229) * lu(1223) + lu(1230) = lu(1230) * lu(1223) + lu(1245) = lu(1245) - lu(1224) * lu(1244) + lu(1246) = lu(1246) - lu(1225) * lu(1244) + lu(1247) = lu(1247) - lu(1226) * lu(1244) + lu(1248) = lu(1248) - lu(1227) * lu(1244) + lu(1249) = lu(1249) - lu(1228) * lu(1244) + lu(1250) = lu(1250) - lu(1229) * lu(1244) + lu(1251) = lu(1251) - lu(1230) * lu(1244) + lu(1262) = lu(1262) - lu(1224) * lu(1261) + lu(1263) = lu(1263) - lu(1225) * lu(1261) + lu(1264) = lu(1264) - lu(1226) * lu(1261) + lu(1265) = lu(1265) - lu(1227) * lu(1261) + lu(1266) = lu(1266) - lu(1228) * lu(1261) + lu(1267) = lu(1267) - lu(1229) * lu(1261) + lu(1268) = lu(1268) - lu(1230) * lu(1261) + lu(1335) = lu(1335) - lu(1224) * lu(1334) + lu(1336) = lu(1336) - lu(1225) * lu(1334) + lu(1337) = lu(1337) - lu(1226) * lu(1334) + lu(1338) = lu(1338) - lu(1227) * lu(1334) + lu(1339) = lu(1339) - lu(1228) * lu(1334) + lu(1340) = lu(1340) - lu(1229) * lu(1334) + lu(1341) = lu(1341) - lu(1230) * lu(1334) + lu(1359) = lu(1359) - lu(1224) * lu(1358) + lu(1360) = lu(1360) - lu(1225) * lu(1358) + lu(1361) = lu(1361) - lu(1226) * lu(1358) + lu(1362) = lu(1362) - lu(1227) * lu(1358) + lu(1363) = lu(1363) - lu(1228) * lu(1358) + lu(1364) = lu(1364) - lu(1229) * lu(1358) + lu(1365) = lu(1365) - lu(1230) * lu(1358) + lu(1394) = lu(1394) - lu(1224) * lu(1393) + lu(1395) = lu(1395) - lu(1225) * lu(1393) + lu(1396) = lu(1396) - lu(1226) * lu(1393) + lu(1397) = lu(1397) - lu(1227) * lu(1393) + lu(1398) = lu(1398) - lu(1228) * lu(1393) + lu(1399) = lu(1399) - lu(1229) * lu(1393) + lu(1400) = lu(1400) - lu(1230) * lu(1393) + lu(1428) = lu(1428) - lu(1224) * lu(1427) + lu(1429) = lu(1429) - lu(1225) * lu(1427) + lu(1430) = lu(1430) - lu(1226) * lu(1427) + lu(1431) = lu(1431) - lu(1227) * lu(1427) + lu(1432) = lu(1432) - lu(1228) * lu(1427) + lu(1433) = lu(1433) - lu(1229) * lu(1427) + lu(1434) = lu(1434) - lu(1230) * lu(1427) + lu(1465) = lu(1465) - lu(1224) * lu(1464) + lu(1466) = lu(1466) - lu(1225) * lu(1464) + lu(1467) = lu(1467) - lu(1226) * lu(1464) + lu(1468) = lu(1468) - lu(1227) * lu(1464) + lu(1469) = lu(1469) - lu(1228) * lu(1464) + lu(1470) = lu(1470) - lu(1229) * lu(1464) + lu(1471) = lu(1471) - lu(1230) * lu(1464) + lu(1245) = 1._r8 / lu(1245) + lu(1246) = lu(1246) * lu(1245) + lu(1247) = lu(1247) * lu(1245) + lu(1248) = lu(1248) * lu(1245) + lu(1249) = lu(1249) * lu(1245) + lu(1250) = lu(1250) * lu(1245) + lu(1251) = lu(1251) * lu(1245) + lu(1263) = lu(1263) - lu(1246) * lu(1262) + lu(1264) = lu(1264) - lu(1247) * lu(1262) + lu(1265) = lu(1265) - lu(1248) * lu(1262) + lu(1266) = lu(1266) - lu(1249) * lu(1262) + lu(1267) = lu(1267) - lu(1250) * lu(1262) + lu(1268) = lu(1268) - lu(1251) * lu(1262) + lu(1336) = lu(1336) - lu(1246) * lu(1335) + lu(1337) = lu(1337) - lu(1247) * lu(1335) + lu(1338) = lu(1338) - lu(1248) * lu(1335) + lu(1339) = lu(1339) - lu(1249) * lu(1335) + lu(1340) = lu(1340) - lu(1250) * lu(1335) + lu(1341) = lu(1341) - lu(1251) * lu(1335) + lu(1360) = lu(1360) - lu(1246) * lu(1359) + lu(1361) = lu(1361) - lu(1247) * lu(1359) + lu(1362) = lu(1362) - lu(1248) * lu(1359) + lu(1363) = lu(1363) - lu(1249) * lu(1359) + lu(1364) = lu(1364) - lu(1250) * lu(1359) + lu(1365) = lu(1365) - lu(1251) * lu(1359) + lu(1395) = lu(1395) - lu(1246) * lu(1394) + lu(1396) = lu(1396) - lu(1247) * lu(1394) + lu(1397) = lu(1397) - lu(1248) * lu(1394) + lu(1398) = lu(1398) - lu(1249) * lu(1394) + lu(1399) = lu(1399) - lu(1250) * lu(1394) + lu(1400) = lu(1400) - lu(1251) * lu(1394) + lu(1429) = lu(1429) - lu(1246) * lu(1428) + lu(1430) = lu(1430) - lu(1247) * lu(1428) + lu(1431) = lu(1431) - lu(1248) * lu(1428) + lu(1432) = lu(1432) - lu(1249) * lu(1428) + lu(1433) = lu(1433) - lu(1250) * lu(1428) + lu(1434) = lu(1434) - lu(1251) * lu(1428) + lu(1466) = lu(1466) - lu(1246) * lu(1465) + lu(1467) = lu(1467) - lu(1247) * lu(1465) + lu(1468) = lu(1468) - lu(1248) * lu(1465) + lu(1469) = lu(1469) - lu(1249) * lu(1465) + lu(1470) = lu(1470) - lu(1250) * lu(1465) + lu(1471) = lu(1471) - lu(1251) * lu(1465) + lu(1263) = 1._r8 / lu(1263) + lu(1264) = lu(1264) * lu(1263) + lu(1265) = lu(1265) * lu(1263) + lu(1266) = lu(1266) * lu(1263) + lu(1267) = lu(1267) * lu(1263) + lu(1268) = lu(1268) * lu(1263) + lu(1337) = lu(1337) - lu(1264) * lu(1336) + lu(1338) = lu(1338) - lu(1265) * lu(1336) + lu(1339) = lu(1339) - lu(1266) * lu(1336) + lu(1340) = lu(1340) - lu(1267) * lu(1336) + lu(1341) = lu(1341) - lu(1268) * lu(1336) + lu(1361) = lu(1361) - lu(1264) * lu(1360) + lu(1362) = lu(1362) - lu(1265) * lu(1360) + lu(1363) = lu(1363) - lu(1266) * lu(1360) + lu(1364) = lu(1364) - lu(1267) * lu(1360) + lu(1365) = lu(1365) - lu(1268) * lu(1360) + lu(1396) = lu(1396) - lu(1264) * lu(1395) + lu(1397) = lu(1397) - lu(1265) * lu(1395) + lu(1398) = lu(1398) - lu(1266) * lu(1395) + lu(1399) = lu(1399) - lu(1267) * lu(1395) + lu(1400) = lu(1400) - lu(1268) * lu(1395) + lu(1430) = lu(1430) - lu(1264) * lu(1429) + lu(1431) = lu(1431) - lu(1265) * lu(1429) + lu(1432) = lu(1432) - lu(1266) * lu(1429) + lu(1433) = lu(1433) - lu(1267) * lu(1429) + lu(1434) = lu(1434) - lu(1268) * lu(1429) + lu(1467) = lu(1467) - lu(1264) * lu(1466) + lu(1468) = lu(1468) - lu(1265) * lu(1466) + lu(1469) = lu(1469) - lu(1266) * lu(1466) + lu(1470) = lu(1470) - lu(1267) * lu(1466) + lu(1471) = lu(1471) - lu(1268) * lu(1466) + lu(1337) = 1._r8 / lu(1337) + lu(1338) = lu(1338) * lu(1337) + lu(1339) = lu(1339) * lu(1337) + lu(1340) = lu(1340) * lu(1337) + lu(1341) = lu(1341) * lu(1337) + lu(1362) = lu(1362) - lu(1338) * lu(1361) + lu(1363) = lu(1363) - lu(1339) * lu(1361) + lu(1364) = lu(1364) - lu(1340) * lu(1361) + lu(1365) = lu(1365) - lu(1341) * lu(1361) + lu(1397) = lu(1397) - lu(1338) * lu(1396) + lu(1398) = lu(1398) - lu(1339) * lu(1396) + lu(1399) = lu(1399) - lu(1340) * lu(1396) + lu(1400) = lu(1400) - lu(1341) * lu(1396) + lu(1431) = lu(1431) - lu(1338) * lu(1430) + lu(1432) = lu(1432) - lu(1339) * lu(1430) + lu(1433) = lu(1433) - lu(1340) * lu(1430) + lu(1434) = lu(1434) - lu(1341) * lu(1430) + lu(1468) = lu(1468) - lu(1338) * lu(1467) + lu(1469) = lu(1469) - lu(1339) * lu(1467) + lu(1470) = lu(1470) - lu(1340) * lu(1467) + lu(1471) = lu(1471) - lu(1341) * lu(1467) + lu(1362) = 1._r8 / lu(1362) + lu(1363) = lu(1363) * lu(1362) + lu(1364) = lu(1364) * lu(1362) + lu(1365) = lu(1365) * lu(1362) + lu(1398) = lu(1398) - lu(1363) * lu(1397) + lu(1399) = lu(1399) - lu(1364) * lu(1397) + lu(1400) = lu(1400) - lu(1365) * lu(1397) + lu(1432) = lu(1432) - lu(1363) * lu(1431) + lu(1433) = lu(1433) - lu(1364) * lu(1431) + lu(1434) = lu(1434) - lu(1365) * lu(1431) + lu(1469) = lu(1469) - lu(1363) * lu(1468) + lu(1470) = lu(1470) - lu(1364) * lu(1468) + lu(1471) = lu(1471) - lu(1365) * lu(1468) + lu(1398) = 1._r8 / lu(1398) + lu(1399) = lu(1399) * lu(1398) + lu(1400) = lu(1400) * lu(1398) + lu(1433) = lu(1433) - lu(1399) * lu(1432) + lu(1434) = lu(1434) - lu(1400) * lu(1432) + lu(1470) = lu(1470) - lu(1399) * lu(1469) + lu(1471) = lu(1471) - lu(1400) * lu(1469) + lu(1433) = 1._r8 / lu(1433) + lu(1434) = lu(1434) * lu(1433) + lu(1471) = lu(1471) - lu(1434) * lu(1470) + lu(1471) = 1._r8 / lu(1471) + end subroutine lu_fac20 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + call lu_fac12( lu ) + call lu_fac13( lu ) + call lu_fac14( lu ) + call lu_fac15( lu ) + call lu_fac16( lu ) + call lu_fac17( lu ) + call lu_fac18( lu ) + call lu_fac19( lu ) + call lu_fac20( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 new file mode 100644 index 0000000000..06173cf108 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_lu_solve.F90 @@ -0,0 +1,1625 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(17) = b(17) - lu(17) * b(16) + b(19) = b(19) - lu(20) * b(18) + b(132) = b(132) - lu(31) * b(28) + b(145) = b(145) - lu(32) * b(28) + b(93) = b(93) - lu(34) * b(29) + b(138) = b(138) - lu(35) * b(29) + b(56) = b(56) - lu(37) * b(30) + b(138) = b(138) - lu(38) * b(30) + b(63) = b(63) - lu(40) * b(31) + b(138) = b(138) - lu(41) * b(31) + b(71) = b(71) - lu(43) * b(32) + b(138) = b(138) - lu(44) * b(32) + b(130) = b(130) - lu(46) * b(33) + b(138) = b(138) - lu(47) * b(33) + b(138) = b(138) - lu(49) * b(34) + b(142) = b(142) - lu(50) * b(34) + b(108) = b(108) - lu(52) * b(35) + b(130) = b(130) - lu(53) * b(35) + b(138) = b(138) - lu(54) * b(35) + b(138) = b(138) - lu(57) * b(36) + b(132) = b(132) - lu(59) * b(37) + b(146) = b(146) - lu(60) * b(37) + b(39) = b(39) - lu(62) * b(38) + b(84) = b(84) - lu(63) * b(38) + b(138) = b(138) - lu(64) * b(38) + b(142) = b(142) - lu(65) * b(38) + b(45) = b(45) - lu(67) * b(39) + b(138) = b(138) - lu(68) * b(39) + b(69) = b(69) - lu(70) * b(40) + b(138) = b(138) - lu(71) * b(40) + b(101) = b(101) - lu(73) * b(41) + b(143) = b(143) - lu(74) * b(41) + b(129) = b(129) - lu(76) * b(42) + b(129) = b(129) - lu(79) * b(43) + b(145) = b(145) - lu(81) * b(44) + b(85) = b(85) - lu(83) * b(45) + b(142) = b(142) - lu(84) * b(45) + b(144) = b(144) - lu(85) * b(45) + b(101) = b(101) - lu(87) * b(46) + b(143) = b(143) - lu(88) * b(46) + b(145) = b(145) - lu(89) * b(46) + b(138) = b(138) - lu(91) * b(47) + b(142) = b(142) - lu(92) * b(47) + b(143) = b(143) - lu(93) * b(47) + b(101) = b(101) - lu(95) * b(48) + b(141) = b(141) - lu(96) * b(48) + b(131) = b(131) - lu(99) * b(49) + b(135) = b(135) - lu(100) * b(49) + b(138) = b(138) - lu(101) * b(49) + b(142) = b(142) - lu(102) * b(49) + b(133) = b(133) - lu(104) * b(50) + b(145) = b(145) - lu(105) * b(50) + b(116) = b(116) - lu(107) * b(51) + b(138) = b(138) - lu(108) * b(51) + b(142) = b(142) - lu(109) * b(51) + b(122) = b(122) - lu(111) * b(52) + b(130) = b(130) - lu(112) * b(52) + b(138) = b(138) - lu(113) * b(52) + b(106) = b(106) - lu(115) * b(53) + b(130) = b(130) - lu(116) * b(53) + b(137) = b(137) - lu(117) * b(53) + b(138) = b(138) - lu(118) * b(53) + b(145) = b(145) - lu(119) * b(53) + b(78) = b(78) - lu(121) * b(54) + b(95) = b(95) - lu(122) * b(54) + b(115) = b(115) - lu(123) * b(54) + b(138) = b(138) - lu(124) * b(54) + b(142) = b(142) - lu(125) * b(54) + b(131) = b(131) - lu(127) * b(55) + b(134) = b(134) - lu(128) * b(55) + b(135) = b(135) - lu(129) * b(55) + b(144) = b(144) - lu(130) * b(55) + b(146) = b(146) - lu(131) * b(55) + b(94) = b(94) - lu(133) * b(56) + b(116) = b(116) - lu(134) * b(56) + b(134) = b(134) - lu(135) * b(56) + b(140) = b(140) - lu(136) * b(56) + b(142) = b(142) - lu(137) * b(56) + b(144) = b(144) - lu(138) * b(56) + b(91) = b(91) - lu(140) * b(57) + b(116) = b(116) - lu(141) * b(57) + b(127) = b(127) - lu(142) * b(57) + b(138) = b(138) - lu(143) * b(57) + b(124) = b(124) - lu(145) * b(58) + b(126) = b(126) - lu(146) * b(58) + b(138) = b(138) - lu(147) * b(58) + b(142) = b(142) - lu(148) * b(58) + b(106) = b(106) - lu(150) * b(59) + b(116) = b(116) - lu(151) * b(59) + b(138) = b(138) - lu(152) * b(59) + b(142) = b(142) - lu(153) * b(59) + b(122) = b(122) - lu(155) * b(60) + b(138) = b(138) - lu(156) * b(60) + b(121) = b(121) - lu(158) * b(61) + b(138) = b(138) - lu(159) * b(61) + b(144) = b(144) - lu(160) * b(61) + b(84) = b(84) - lu(162) * b(62) + b(85) = b(85) - lu(163) * b(62) + b(95) = b(95) - lu(164) * b(62) + b(121) = b(121) - lu(165) * b(62) + b(138) = b(138) - lu(166) * b(62) + b(85) = b(85) - lu(169) * b(63) + b(95) = b(95) - lu(170) * b(63) + b(134) = b(134) - lu(171) * b(63) + b(142) = b(142) - lu(172) * b(63) + b(144) = b(144) - lu(173) * b(63) + b(94) = b(94) - lu(175) * b(64) + b(108) = b(108) - lu(176) * b(64) + b(130) = b(130) - lu(177) * b(64) + b(138) = b(138) - lu(178) * b(64) + b(142) = b(142) - lu(179) * b(64) + b(117) = b(117) - lu(181) * b(65) + b(127) = b(127) - lu(182) * b(65) + b(130) = b(130) - lu(183) * b(65) + b(138) = b(138) - lu(184) * b(65) + b(140) = b(140) - lu(185) * b(65) + b(78) = b(78) - lu(187) * b(66) + b(134) = b(134) - lu(188) * b(66) + b(140) = b(140) - lu(189) * b(66) + b(142) = b(142) - lu(190) * b(66) + b(144) = b(144) - lu(191) * b(66) + b(130) = b(130) - lu(193) * b(67) + b(136) = b(136) - lu(194) * b(67) + b(138) = b(138) - lu(195) * b(67) + b(140) = b(140) - lu(196) * b(67) + b(141) = b(141) - lu(197) * b(67) + b(91) = b(91) - lu(199) * b(68) + b(106) = b(106) - lu(200) * b(68) + b(127) = b(127) - lu(201) * b(68) + b(138) = b(138) - lu(202) * b(68) + b(110) = b(110) - lu(204) * b(69) + b(129) = b(129) - lu(205) * b(69) + b(140) = b(140) - lu(206) * b(69) + b(142) = b(142) - lu(207) * b(69) + b(94) = b(94) - lu(209) * b(70) + b(112) = b(112) - lu(210) * b(70) + b(119) = b(119) - lu(211) * b(70) + b(125) = b(125) - lu(212) * b(70) + b(138) = b(138) - lu(213) * b(70) + b(142) = b(142) - lu(214) * b(70) + b(85) = b(85) - lu(217) * b(71) + b(95) = b(95) - lu(218) * b(71) + b(121) = b(121) - lu(219) * b(71) + b(134) = b(134) - lu(220) * b(71) + b(142) = b(142) - lu(221) * b(71) + b(144) = b(144) - lu(222) * b(71) + b(88) = b(88) - lu(224) * b(72) + b(98) = b(98) - lu(225) * b(72) + b(99) = b(99) - lu(226) * b(72) + b(105) = b(105) - lu(227) * b(72) + b(129) = b(129) - lu(228) * b(72) + b(146) = b(146) - lu(229) * b(72) + b(129) = b(129) - lu(231) * b(73) + b(130) = b(130) - lu(232) * b(73) + b(135) = b(135) - lu(233) * b(73) + b(138) = b(138) - lu(234) * b(73) + b(142) = b(142) - lu(235) * b(73) + b(144) = b(144) - lu(236) * b(73) + b(127) = b(127) - lu(238) * b(74) + b(135) = b(135) - lu(239) * b(74) + b(136) = b(136) - lu(240) * b(74) + b(138) = b(138) - lu(241) * b(74) + b(140) = b(140) - lu(242) * b(74) + b(144) = b(144) - lu(243) * b(74) + b(127) = b(127) - lu(245) * b(75) + b(130) = b(130) - lu(246) * b(75) + b(136) = b(136) - lu(247) * b(75) + b(138) = b(138) - lu(248) * b(75) + b(140) = b(140) - lu(249) * b(75) + b(105) = b(105) - lu(251) * b(76) + b(129) = b(129) - lu(252) * b(76) + b(134) = b(134) - lu(253) * b(76) + b(143) = b(143) - lu(254) * b(76) + b(78) = b(78) - lu(256) * b(77) + b(97) = b(97) - lu(257) * b(77) + b(115) = b(115) - lu(258) * b(77) + b(138) = b(138) - lu(259) * b(77) + b(139) = b(139) - lu(260) * b(77) + b(140) = b(140) - lu(261) * b(77) + b(142) = b(142) - lu(262) * b(77) + b(130) = b(130) - lu(264) * b(78) + b(138) = b(138) - lu(265) * b(78) + b(142) = b(142) - lu(266) * b(78) + b(138) = b(138) - lu(268) * b(79) + b(140) = b(140) - lu(269) * b(79) + b(142) = b(142) - lu(270) * b(79) + b(96) = b(96) - lu(272) * b(80) + b(128) = b(128) - lu(273) * b(80) + b(131) = b(131) - lu(274) * b(80) + b(133) = b(133) - lu(275) * b(80) + b(135) = b(135) - lu(276) * b(80) + b(144) = b(144) - lu(277) * b(80) + b(146) = b(146) - lu(278) * b(80) + b(118) = b(118) - lu(280) * b(81) + b(126) = b(126) - lu(281) * b(81) + b(135) = b(135) - lu(282) * b(81) + b(138) = b(138) - lu(283) * b(81) + b(140) = b(140) - lu(284) * b(81) + b(142) = b(142) - lu(285) * b(81) + b(144) = b(144) - lu(286) * b(81) + b(103) = b(103) - lu(288) * b(82) + b(116) = b(116) - lu(289) * b(82) + b(118) = b(118) - lu(290) * b(82) + b(130) = b(130) - lu(291) * b(82) + b(138) = b(138) - lu(292) * b(82) + b(140) = b(140) - lu(293) * b(82) + b(142) = b(142) - lu(294) * b(82) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(119) = b(119) - lu(296) * b(83) + b(122) = b(122) - lu(297) * b(83) + b(123) = b(123) - lu(298) * b(83) + b(125) = b(125) - lu(299) * b(83) + b(138) = b(138) - lu(300) * b(83) + b(140) = b(140) - lu(301) * b(83) + b(142) = b(142) - lu(302) * b(83) + b(85) = b(85) - lu(305) * b(84) + b(95) = b(95) - lu(306) * b(84) + b(121) = b(121) - lu(307) * b(84) + b(134) = b(134) - lu(308) * b(84) + b(138) = b(138) - lu(309) * b(84) + b(142) = b(142) - lu(310) * b(84) + b(144) = b(144) - lu(311) * b(84) + b(95) = b(95) - lu(313) * b(85) + b(115) = b(115) - lu(314) * b(85) + b(121) = b(121) - lu(315) * b(85) + b(127) = b(127) - lu(316) * b(85) + b(142) = b(142) - lu(317) * b(85) + b(112) = b(112) - lu(319) * b(86) + b(119) = b(119) - lu(320) * b(86) + b(125) = b(125) - lu(321) * b(86) + b(135) = b(135) - lu(322) * b(86) + b(138) = b(138) - lu(323) * b(86) + b(139) = b(139) - lu(324) * b(86) + b(142) = b(142) - lu(325) * b(86) + b(144) = b(144) - lu(326) * b(86) + b(130) = b(130) - lu(328) * b(87) + b(136) = b(136) - lu(329) * b(87) + b(138) = b(138) - lu(330) * b(87) + b(98) = b(98) - lu(332) * b(88) + b(99) = b(99) - lu(333) * b(88) + b(105) = b(105) - lu(334) * b(88) + b(115) = b(115) - lu(335) * b(88) + b(129) = b(129) - lu(336) * b(88) + b(146) = b(146) - lu(337) * b(88) + b(130) = b(130) - lu(339) * b(89) + b(137) = b(137) - lu(340) * b(89) + b(138) = b(138) - lu(341) * b(89) + b(142) = b(142) - lu(342) * b(89) + b(145) = b(145) - lu(343) * b(89) + b(146) = b(146) - lu(344) * b(89) + b(91) = b(91) - lu(347) * b(90) + b(93) = b(93) - lu(348) * b(90) + b(94) = b(94) - lu(349) * b(90) + b(106) = b(106) - lu(350) * b(90) + b(116) = b(116) - lu(351) * b(90) + b(127) = b(127) - lu(352) * b(90) + b(138) = b(138) - lu(353) * b(90) + b(140) = b(140) - lu(354) * b(90) + b(142) = b(142) - lu(355) * b(90) + b(116) = b(116) - lu(358) * b(91) + b(127) = b(127) - lu(359) * b(91) + b(134) = b(134) - lu(360) * b(91) + b(138) = b(138) - lu(361) * b(91) + b(142) = b(142) - lu(362) * b(91) + b(144) = b(144) - lu(363) * b(91) + b(98) = b(98) - lu(367) * b(92) + b(99) = b(99) - lu(368) * b(92) + b(100) = b(100) - lu(369) * b(92) + b(105) = b(105) - lu(370) * b(92) + b(115) = b(115) - lu(371) * b(92) + b(129) = b(129) - lu(372) * b(92) + b(134) = b(134) - lu(373) * b(92) + b(143) = b(143) - lu(374) * b(92) + b(146) = b(146) - lu(375) * b(92) + b(94) = b(94) - lu(381) * b(93) + b(106) = b(106) - lu(382) * b(93) + b(116) = b(116) - lu(383) * b(93) + b(121) = b(121) - lu(384) * b(93) + b(127) = b(127) - lu(385) * b(93) + b(134) = b(134) - lu(386) * b(93) + b(138) = b(138) - lu(387) * b(93) + b(140) = b(140) - lu(388) * b(93) + b(142) = b(142) - lu(389) * b(93) + b(144) = b(144) - lu(390) * b(93) + b(117) = b(117) - lu(392) * b(94) + b(127) = b(127) - lu(393) * b(94) + b(130) = b(130) - lu(394) * b(94) + b(136) = b(136) - lu(395) * b(94) + b(138) = b(138) - lu(396) * b(94) + b(115) = b(115) - lu(398) * b(95) + b(138) = b(138) - lu(399) * b(95) + b(142) = b(142) - lu(400) * b(95) + b(128) = b(128) - lu(403) * b(96) + b(130) = b(130) - lu(404) * b(96) + b(133) = b(133) - lu(405) * b(96) + b(137) = b(137) - lu(406) * b(96) + b(138) = b(138) - lu(407) * b(96) + b(145) = b(145) - lu(408) * b(96) + b(146) = b(146) - lu(409) * b(96) + b(110) = b(110) - lu(413) * b(97) + b(129) = b(129) - lu(414) * b(97) + b(134) = b(134) - lu(415) * b(97) + b(138) = b(138) - lu(416) * b(97) + b(140) = b(140) - lu(417) * b(97) + b(142) = b(142) - lu(418) * b(97) + b(144) = b(144) - lu(419) * b(97) + b(99) = b(99) - lu(421) * b(98) + b(100) = b(100) - lu(422) * b(98) + b(105) = b(105) - lu(423) * b(98) + b(129) = b(129) - lu(424) * b(98) + b(134) = b(134) - lu(425) * b(98) + b(143) = b(143) - lu(426) * b(98) + b(146) = b(146) - lu(427) * b(98) + b(100) = b(100) - lu(430) * b(99) + b(105) = b(105) - lu(431) * b(99) + b(129) = b(129) - lu(432) * b(99) + b(134) = b(134) - lu(433) * b(99) + b(143) = b(143) - lu(434) * b(99) + b(146) = b(146) - lu(435) * b(99) + b(105) = b(105) - lu(441) * b(100) + b(115) = b(115) - lu(442) * b(100) + b(129) = b(129) - lu(443) * b(100) + b(134) = b(134) - lu(444) * b(100) + b(143) = b(143) - lu(445) * b(100) + b(146) = b(146) - lu(446) * b(100) + b(120) = b(120) - lu(449) * b(101) + b(130) = b(130) - lu(450) * b(101) + b(131) = b(131) - lu(451) * b(101) + b(135) = b(135) - lu(452) * b(101) + b(136) = b(136) - lu(453) * b(101) + b(138) = b(138) - lu(454) * b(101) + b(141) = b(141) - lu(455) * b(101) + b(111) = b(111) - lu(457) * b(102) + b(119) = b(119) - lu(458) * b(102) + b(125) = b(125) - lu(459) * b(102) + b(134) = b(134) - lu(460) * b(102) + b(135) = b(135) - lu(461) * b(102) + b(138) = b(138) - lu(462) * b(102) + b(140) = b(140) - lu(463) * b(102) + b(142) = b(142) - lu(464) * b(102) + b(144) = b(144) - lu(465) * b(102) + b(116) = b(116) - lu(468) * b(103) + b(118) = b(118) - lu(469) * b(103) + b(129) = b(129) - lu(470) * b(103) + b(130) = b(130) - lu(471) * b(103) + b(134) = b(134) - lu(472) * b(103) + b(138) = b(138) - lu(473) * b(103) + b(140) = b(140) - lu(474) * b(103) + b(142) = b(142) - lu(475) * b(103) + b(144) = b(144) - lu(476) * b(103) + b(130) = b(130) - lu(478) * b(104) + b(133) = b(133) - lu(479) * b(104) + b(138) = b(138) - lu(480) * b(104) + b(141) = b(141) - lu(481) * b(104) + b(143) = b(143) - lu(482) * b(104) + b(146) = b(146) - lu(483) * b(104) + b(115) = b(115) - lu(490) * b(105) + b(129) = b(129) - lu(491) * b(105) + b(134) = b(134) - lu(492) * b(105) + b(138) = b(138) - lu(493) * b(105) + b(141) = b(141) - lu(494) * b(105) + b(143) = b(143) - lu(495) * b(105) + b(144) = b(144) - lu(496) * b(105) + b(146) = b(146) - lu(497) * b(105) + b(116) = b(116) - lu(502) * b(106) + b(129) = b(129) - lu(503) * b(106) + b(134) = b(134) - lu(504) * b(106) + b(136) = b(136) - lu(505) * b(106) + b(138) = b(138) - lu(506) * b(106) + b(140) = b(140) - lu(507) * b(106) + b(142) = b(142) - lu(508) * b(106) + b(144) = b(144) - lu(509) * b(106) + b(130) = b(130) - lu(512) * b(107) + b(132) = b(132) - lu(513) * b(107) + b(137) = b(137) - lu(514) * b(107) + b(138) = b(138) - lu(515) * b(107) + b(145) = b(145) - lu(516) * b(107) + b(146) = b(146) - lu(517) * b(107) + b(116) = b(116) - lu(521) * b(108) + b(117) = b(117) - lu(522) * b(108) + b(127) = b(127) - lu(523) * b(108) + b(129) = b(129) - lu(524) * b(108) + b(130) = b(130) - lu(525) * b(108) + b(134) = b(134) - lu(526) * b(108) + b(136) = b(136) - lu(527) * b(108) + b(138) = b(138) - lu(528) * b(108) + b(140) = b(140) - lu(529) * b(108) + b(142) = b(142) - lu(530) * b(108) + b(144) = b(144) - lu(531) * b(108) + b(111) = b(111) - lu(535) * b(109) + b(114) = b(114) - lu(536) * b(109) + b(115) = b(115) - lu(537) * b(109) + b(119) = b(119) - lu(538) * b(109) + b(123) = b(123) - lu(539) * b(109) + b(125) = b(125) - lu(540) * b(109) + b(126) = b(126) - lu(541) * b(109) + b(130) = b(130) - lu(542) * b(109) + b(134) = b(134) - lu(543) * b(109) + b(135) = b(135) - lu(544) * b(109) + b(136) = b(136) - lu(545) * b(109) + b(138) = b(138) - lu(546) * b(109) + b(139) = b(139) - lu(547) * b(109) + b(140) = b(140) - lu(548) * b(109) + b(142) = b(142) - lu(549) * b(109) + b(144) = b(144) - lu(550) * b(109) + b(115) = b(115) - lu(553) * b(110) + b(138) = b(138) - lu(554) * b(110) + b(140) = b(140) - lu(555) * b(110) + b(142) = b(142) - lu(556) * b(110) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(115) = b(115) - lu(559) * b(111) + b(122) = b(122) - lu(560) * b(111) + b(135) = b(135) - lu(561) * b(111) + b(138) = b(138) - lu(562) * b(111) + b(140) = b(140) - lu(563) * b(111) + b(142) = b(142) - lu(564) * b(111) + b(144) = b(144) - lu(565) * b(111) + b(117) = b(117) - lu(569) * b(112) + b(119) = b(119) - lu(570) * b(112) + b(125) = b(125) - lu(571) * b(112) + b(127) = b(127) - lu(572) * b(112) + b(130) = b(130) - lu(573) * b(112) + b(134) = b(134) - lu(574) * b(112) + b(136) = b(136) - lu(575) * b(112) + b(138) = b(138) - lu(576) * b(112) + b(142) = b(142) - lu(577) * b(112) + b(144) = b(144) - lu(578) * b(112) + b(130) = b(130) - lu(582) * b(113) + b(131) = b(131) - lu(583) * b(113) + b(132) = b(132) - lu(584) * b(113) + b(135) = b(135) - lu(585) * b(113) + b(137) = b(137) - lu(586) * b(113) + b(138) = b(138) - lu(587) * b(113) + b(144) = b(144) - lu(588) * b(113) + b(145) = b(145) - lu(589) * b(113) + b(146) = b(146) - lu(590) * b(113) + b(115) = b(115) - lu(595) * b(114) + b(116) = b(116) - lu(596) * b(114) + b(118) = b(118) - lu(597) * b(114) + b(121) = b(121) - lu(598) * b(114) + b(129) = b(129) - lu(599) * b(114) + b(130) = b(130) - lu(600) * b(114) + b(134) = b(134) - lu(601) * b(114) + b(135) = b(135) - lu(602) * b(114) + b(136) = b(136) - lu(603) * b(114) + b(138) = b(138) - lu(604) * b(114) + b(139) = b(139) - lu(605) * b(114) + b(140) = b(140) - lu(606) * b(114) + b(142) = b(142) - lu(607) * b(114) + b(144) = b(144) - lu(608) * b(114) + b(138) = b(138) - lu(610) * b(115) + b(141) = b(141) - lu(611) * b(115) + b(142) = b(142) - lu(612) * b(115) + b(127) = b(127) - lu(615) * b(116) + b(130) = b(130) - lu(616) * b(116) + b(131) = b(131) - lu(617) * b(116) + b(135) = b(135) - lu(618) * b(116) + b(136) = b(136) - lu(619) * b(116) + b(138) = b(138) - lu(620) * b(116) + b(141) = b(141) - lu(621) * b(116) + b(142) = b(142) - lu(622) * b(116) + b(118) = b(118) - lu(626) * b(117) + b(121) = b(121) - lu(627) * b(117) + b(127) = b(127) - lu(628) * b(117) + b(129) = b(129) - lu(629) * b(117) + b(130) = b(130) - lu(630) * b(117) + b(134) = b(134) - lu(631) * b(117) + b(136) = b(136) - lu(632) * b(117) + b(138) = b(138) - lu(633) * b(117) + b(140) = b(140) - lu(634) * b(117) + b(142) = b(142) - lu(635) * b(117) + b(144) = b(144) - lu(636) * b(117) + b(121) = b(121) - lu(638) * b(118) + b(127) = b(127) - lu(639) * b(118) + b(138) = b(138) - lu(640) * b(118) + b(140) = b(140) - lu(641) * b(118) + b(142) = b(142) - lu(642) * b(118) + b(121) = b(121) - lu(645) * b(119) + b(124) = b(124) - lu(646) * b(119) + b(126) = b(126) - lu(647) * b(119) + b(127) = b(127) - lu(648) * b(119) + b(130) = b(130) - lu(649) * b(119) + b(138) = b(138) - lu(650) * b(119) + b(139) = b(139) - lu(651) * b(119) + b(140) = b(140) - lu(652) * b(119) + b(141) = b(141) - lu(653) * b(119) + b(142) = b(142) - lu(654) * b(119) + b(130) = b(130) - lu(658) * b(120) + b(131) = b(131) - lu(659) * b(120) + b(135) = b(135) - lu(660) * b(120) + b(136) = b(136) - lu(661) * b(120) + b(137) = b(137) - lu(662) * b(120) + b(138) = b(138) - lu(663) * b(120) + b(141) = b(141) - lu(664) * b(120) + b(143) = b(143) - lu(665) * b(120) + b(145) = b(145) - lu(666) * b(120) + b(146) = b(146) - lu(667) * b(120) + b(127) = b(127) - lu(670) * b(121) + b(130) = b(130) - lu(671) * b(121) + b(131) = b(131) - lu(672) * b(121) + b(135) = b(135) - lu(673) * b(121) + b(138) = b(138) - lu(674) * b(121) + b(141) = b(141) - lu(675) * b(121) + b(142) = b(142) - lu(676) * b(121) + b(127) = b(127) - lu(685) * b(122) + b(130) = b(130) - lu(686) * b(122) + b(131) = b(131) - lu(687) * b(122) + b(134) = b(134) - lu(688) * b(122) + b(135) = b(135) - lu(689) * b(122) + b(136) = b(136) - lu(690) * b(122) + b(138) = b(138) - lu(691) * b(122) + b(140) = b(140) - lu(692) * b(122) + b(141) = b(141) - lu(693) * b(122) + b(142) = b(142) - lu(694) * b(122) + b(144) = b(144) - lu(695) * b(122) + b(124) = b(124) - lu(708) * b(123) + b(125) = b(125) - lu(709) * b(123) + b(126) = b(126) - lu(710) * b(123) + b(127) = b(127) - lu(711) * b(123) + b(130) = b(130) - lu(712) * b(123) + b(131) = b(131) - lu(713) * b(123) + b(134) = b(134) - lu(714) * b(123) + b(135) = b(135) - lu(715) * b(123) + b(136) = b(136) - lu(716) * b(123) + b(138) = b(138) - lu(717) * b(123) + b(139) = b(139) - lu(718) * b(123) + b(140) = b(140) - lu(719) * b(123) + b(141) = b(141) - lu(720) * b(123) + b(142) = b(142) - lu(721) * b(123) + b(144) = b(144) - lu(722) * b(123) + b(126) = b(126) - lu(732) * b(124) + b(127) = b(127) - lu(733) * b(124) + b(130) = b(130) - lu(734) * b(124) + b(131) = b(131) - lu(735) * b(124) + b(134) = b(134) - lu(736) * b(124) + b(135) = b(135) - lu(737) * b(124) + b(136) = b(136) - lu(738) * b(124) + b(138) = b(138) - lu(739) * b(124) + b(140) = b(140) - lu(740) * b(124) + b(141) = b(141) - lu(741) * b(124) + b(142) = b(142) - lu(742) * b(124) + b(144) = b(144) - lu(743) * b(124) + b(126) = b(126) - lu(751) * b(125) + b(127) = b(127) - lu(752) * b(125) + b(129) = b(129) - lu(753) * b(125) + b(130) = b(130) - lu(754) * b(125) + b(131) = b(131) - lu(755) * b(125) + b(134) = b(134) - lu(756) * b(125) + b(135) = b(135) - lu(757) * b(125) + b(136) = b(136) - lu(758) * b(125) + b(138) = b(138) - lu(759) * b(125) + b(139) = b(139) - lu(760) * b(125) + b(140) = b(140) - lu(761) * b(125) + b(141) = b(141) - lu(762) * b(125) + b(142) = b(142) - lu(763) * b(125) + b(144) = b(144) - lu(764) * b(125) + b(127) = b(127) - lu(771) * b(126) + b(129) = b(129) - lu(772) * b(126) + b(130) = b(130) - lu(773) * b(126) + b(131) = b(131) - lu(774) * b(126) + b(134) = b(134) - lu(775) * b(126) + b(135) = b(135) - lu(776) * b(126) + b(136) = b(136) - lu(777) * b(126) + b(138) = b(138) - lu(778) * b(126) + b(139) = b(139) - lu(779) * b(126) + b(140) = b(140) - lu(780) * b(126) + b(141) = b(141) - lu(781) * b(126) + b(142) = b(142) - lu(782) * b(126) + b(144) = b(144) - lu(783) * b(126) + b(129) = b(129) - lu(800) * b(127) + b(130) = b(130) - lu(801) * b(127) + b(131) = b(131) - lu(802) * b(127) + b(134) = b(134) - lu(803) * b(127) + b(135) = b(135) - lu(804) * b(127) + b(136) = b(136) - lu(805) * b(127) + b(138) = b(138) - lu(806) * b(127) + b(139) = b(139) - lu(807) * b(127) + b(140) = b(140) - lu(808) * b(127) + b(141) = b(141) - lu(809) * b(127) + b(142) = b(142) - lu(810) * b(127) + b(144) = b(144) - lu(811) * b(127) + b(129) = b(129) - lu(817) * b(128) + b(130) = b(130) - lu(818) * b(128) + b(131) = b(131) - lu(819) * b(128) + b(132) = b(132) - lu(820) * b(128) + b(133) = b(133) - lu(821) * b(128) + b(134) = b(134) - lu(822) * b(128) + b(135) = b(135) - lu(823) * b(128) + b(137) = b(137) - lu(824) * b(128) + b(138) = b(138) - lu(825) * b(128) + b(142) = b(142) - lu(826) * b(128) + b(144) = b(144) - lu(827) * b(128) + b(145) = b(145) - lu(828) * b(128) + b(146) = b(146) - lu(829) * b(128) + b(134) = b(134) - lu(844) * b(129) + b(138) = b(138) - lu(845) * b(129) + b(139) = b(139) - lu(846) * b(129) + b(140) = b(140) - lu(847) * b(129) + b(141) = b(141) - lu(848) * b(129) + b(142) = b(142) - lu(849) * b(129) + b(143) = b(143) - lu(850) * b(129) + b(144) = b(144) - lu(851) * b(129) + b(146) = b(146) - lu(852) * b(129) + b(131) = b(131) - lu(857) * b(130) + b(135) = b(135) - lu(858) * b(130) + b(136) = b(136) - lu(859) * b(130) + b(137) = b(137) - lu(860) * b(130) + b(138) = b(138) - lu(861) * b(130) + b(141) = b(141) - lu(862) * b(130) + b(143) = b(143) - lu(863) * b(130) + b(145) = b(145) - lu(864) * b(130) + b(146) = b(146) - lu(865) * b(130) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(135) = b(135) - lu(871) * b(131) + b(136) = b(136) - lu(872) * b(131) + b(137) = b(137) - lu(873) * b(131) + b(138) = b(138) - lu(874) * b(131) + b(141) = b(141) - lu(875) * b(131) + b(143) = b(143) - lu(876) * b(131) + b(144) = b(144) - lu(877) * b(131) + b(145) = b(145) - lu(878) * b(131) + b(146) = b(146) - lu(879) * b(131) + b(133) = b(133) - lu(891) * b(132) + b(134) = b(134) - lu(892) * b(132) + b(135) = b(135) - lu(893) * b(132) + b(136) = b(136) - lu(894) * b(132) + b(137) = b(137) - lu(895) * b(132) + b(138) = b(138) - lu(896) * b(132) + b(139) = b(139) - lu(897) * b(132) + b(140) = b(140) - lu(898) * b(132) + b(141) = b(141) - lu(899) * b(132) + b(142) = b(142) - lu(900) * b(132) + b(143) = b(143) - lu(901) * b(132) + b(144) = b(144) - lu(902) * b(132) + b(145) = b(145) - lu(903) * b(132) + b(146) = b(146) - lu(904) * b(132) + b(134) = b(134) - lu(913) * b(133) + b(135) = b(135) - lu(914) * b(133) + b(136) = b(136) - lu(915) * b(133) + b(137) = b(137) - lu(916) * b(133) + b(138) = b(138) - lu(917) * b(133) + b(139) = b(139) - lu(918) * b(133) + b(140) = b(140) - lu(919) * b(133) + b(141) = b(141) - lu(920) * b(133) + b(142) = b(142) - lu(921) * b(133) + b(143) = b(143) - lu(922) * b(133) + b(144) = b(144) - lu(923) * b(133) + b(145) = b(145) - lu(924) * b(133) + b(146) = b(146) - lu(925) * b(133) + b(135) = b(135) - lu(972) * b(134) + b(136) = b(136) - lu(973) * b(134) + b(137) = b(137) - lu(974) * b(134) + b(138) = b(138) - lu(975) * b(134) + b(139) = b(139) - lu(976) * b(134) + b(140) = b(140) - lu(977) * b(134) + b(141) = b(141) - lu(978) * b(134) + b(142) = b(142) - lu(979) * b(134) + b(143) = b(143) - lu(980) * b(134) + b(144) = b(144) - lu(981) * b(134) + b(145) = b(145) - lu(982) * b(134) + b(146) = b(146) - lu(983) * b(134) + b(136) = b(136) - lu(1014) * b(135) + b(137) = b(137) - lu(1015) * b(135) + b(138) = b(138) - lu(1016) * b(135) + b(139) = b(139) - lu(1017) * b(135) + b(140) = b(140) - lu(1018) * b(135) + b(141) = b(141) - lu(1019) * b(135) + b(142) = b(142) - lu(1020) * b(135) + b(143) = b(143) - lu(1021) * b(135) + b(144) = b(144) - lu(1022) * b(135) + b(145) = b(145) - lu(1023) * b(135) + b(146) = b(146) - lu(1024) * b(135) + b(137) = b(137) - lu(1055) * b(136) + b(138) = b(138) - lu(1056) * b(136) + b(139) = b(139) - lu(1057) * b(136) + b(140) = b(140) - lu(1058) * b(136) + b(141) = b(141) - lu(1059) * b(136) + b(142) = b(142) - lu(1060) * b(136) + b(143) = b(143) - lu(1061) * b(136) + b(144) = b(144) - lu(1062) * b(136) + b(145) = b(145) - lu(1063) * b(136) + b(146) = b(146) - lu(1064) * b(136) + b(138) = b(138) - lu(1080) * b(137) + b(139) = b(139) - lu(1081) * b(137) + b(140) = b(140) - lu(1082) * b(137) + b(141) = b(141) - lu(1083) * b(137) + b(142) = b(142) - lu(1084) * b(137) + b(143) = b(143) - lu(1085) * b(137) + b(144) = b(144) - lu(1086) * b(137) + b(145) = b(145) - lu(1087) * b(137) + b(146) = b(146) - lu(1088) * b(137) + b(139) = b(139) - lu(1180) * b(138) + b(140) = b(140) - lu(1181) * b(138) + b(141) = b(141) - lu(1182) * b(138) + b(142) = b(142) - lu(1183) * b(138) + b(143) = b(143) - lu(1184) * b(138) + b(144) = b(144) - lu(1185) * b(138) + b(145) = b(145) - lu(1186) * b(138) + b(146) = b(146) - lu(1187) * b(138) + b(140) = b(140) - lu(1224) * b(139) + b(141) = b(141) - lu(1225) * b(139) + b(142) = b(142) - lu(1226) * b(139) + b(143) = b(143) - lu(1227) * b(139) + b(144) = b(144) - lu(1228) * b(139) + b(145) = b(145) - lu(1229) * b(139) + b(146) = b(146) - lu(1230) * b(139) + b(141) = b(141) - lu(1246) * b(140) + b(142) = b(142) - lu(1247) * b(140) + b(143) = b(143) - lu(1248) * b(140) + b(144) = b(144) - lu(1249) * b(140) + b(145) = b(145) - lu(1250) * b(140) + b(146) = b(146) - lu(1251) * b(140) + b(142) = b(142) - lu(1264) * b(141) + b(143) = b(143) - lu(1265) * b(141) + b(144) = b(144) - lu(1266) * b(141) + b(145) = b(145) - lu(1267) * b(141) + b(146) = b(146) - lu(1268) * b(141) + b(143) = b(143) - lu(1338) * b(142) + b(144) = b(144) - lu(1339) * b(142) + b(145) = b(145) - lu(1340) * b(142) + b(146) = b(146) - lu(1341) * b(142) + b(144) = b(144) - lu(1363) * b(143) + b(145) = b(145) - lu(1364) * b(143) + b(146) = b(146) - lu(1365) * b(143) + b(145) = b(145) - lu(1399) * b(144) + b(146) = b(146) - lu(1400) * b(144) + b(146) = b(146) - lu(1434) * b(145) + end subroutine lu_slv04 + subroutine lu_slv05( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(146) = b(146) * lu(1471) + b(145) = b(145) - lu(1470) * b(146) + b(144) = b(144) - lu(1469) * b(146) + b(143) = b(143) - lu(1468) * b(146) + b(142) = b(142) - lu(1467) * b(146) + b(141) = b(141) - lu(1466) * b(146) + b(140) = b(140) - lu(1465) * b(146) + b(139) = b(139) - lu(1464) * b(146) + b(138) = b(138) - lu(1463) * b(146) + b(137) = b(137) - lu(1462) * b(146) + b(136) = b(136) - lu(1461) * b(146) + b(135) = b(135) - lu(1460) * b(146) + b(134) = b(134) - lu(1459) * b(146) + b(133) = b(133) - lu(1458) * b(146) + b(132) = b(132) - lu(1457) * b(146) + b(131) = b(131) - lu(1456) * b(146) + b(130) = b(130) - lu(1455) * b(146) + b(129) = b(129) - lu(1454) * b(146) + b(128) = b(128) - lu(1453) * b(146) + b(120) = b(120) - lu(1452) * b(146) + b(115) = b(115) - lu(1451) * b(146) + b(113) = b(113) - lu(1450) * b(146) + b(107) = b(107) - lu(1449) * b(146) + b(105) = b(105) - lu(1448) * b(146) + b(104) = b(104) - lu(1447) * b(146) + b(100) = b(100) - lu(1446) * b(146) + b(99) = b(99) - lu(1445) * b(146) + b(98) = b(98) - lu(1444) * b(146) + b(96) = b(96) - lu(1443) * b(146) + b(92) = b(92) - lu(1442) * b(146) + b(89) = b(89) - lu(1441) * b(146) + b(88) = b(88) - lu(1440) * b(146) + b(80) = b(80) - lu(1439) * b(146) + b(76) = b(76) - lu(1438) * b(146) + b(72) = b(72) - lu(1437) * b(146) + b(43) = b(43) - lu(1436) * b(146) + b(42) = b(42) - lu(1435) * b(146) + b(145) = b(145) * lu(1433) + b(144) = b(144) - lu(1432) * b(145) + b(143) = b(143) - lu(1431) * b(145) + b(142) = b(142) - lu(1430) * b(145) + b(141) = b(141) - lu(1429) * b(145) + b(140) = b(140) - lu(1428) * b(145) + b(139) = b(139) - lu(1427) * b(145) + b(138) = b(138) - lu(1426) * b(145) + b(137) = b(137) - lu(1425) * b(145) + b(136) = b(136) - lu(1424) * b(145) + b(135) = b(135) - lu(1423) * b(145) + b(134) = b(134) - lu(1422) * b(145) + b(133) = b(133) - lu(1421) * b(145) + b(132) = b(132) - lu(1420) * b(145) + b(131) = b(131) - lu(1419) * b(145) + b(130) = b(130) - lu(1418) * b(145) + b(129) = b(129) - lu(1417) * b(145) + b(127) = b(127) - lu(1416) * b(145) + b(120) = b(120) - lu(1415) * b(145) + b(116) = b(116) - lu(1414) * b(145) + b(115) = b(115) - lu(1413) * b(145) + b(113) = b(113) - lu(1412) * b(145) + b(110) = b(110) - lu(1411) * b(145) + b(107) = b(107) - lu(1410) * b(145) + b(106) = b(106) - lu(1409) * b(145) + b(97) = b(97) - lu(1408) * b(145) + b(95) = b(95) - lu(1407) * b(145) + b(89) = b(89) - lu(1406) * b(145) + b(78) = b(78) - lu(1405) * b(145) + b(77) = b(77) - lu(1404) * b(145) + b(54) = b(54) - lu(1403) * b(145) + b(53) = b(53) - lu(1402) * b(145) + b(44) = b(44) - lu(1401) * b(145) + b(144) = b(144) * lu(1398) + b(143) = b(143) - lu(1397) * b(144) + b(142) = b(142) - lu(1396) * b(144) + b(141) = b(141) - lu(1395) * b(144) + b(140) = b(140) - lu(1394) * b(144) + b(139) = b(139) - lu(1393) * b(144) + b(138) = b(138) - lu(1392) * b(144) + b(137) = b(137) - lu(1391) * b(144) + b(136) = b(136) - lu(1390) * b(144) + b(135) = b(135) - lu(1389) * b(144) + b(134) = b(134) - lu(1388) * b(144) + b(133) = b(133) - lu(1387) * b(144) + b(132) = b(132) - lu(1386) * b(144) + b(131) = b(131) - lu(1385) * b(144) + b(130) = b(130) - lu(1384) * b(144) + b(129) = b(129) - lu(1383) * b(144) + b(128) = b(128) - lu(1382) * b(144) + b(127) = b(127) - lu(1381) * b(144) + b(126) = b(126) - lu(1380) * b(144) + b(121) = b(121) - lu(1379) * b(144) + b(118) = b(118) - lu(1378) * b(144) + b(115) = b(115) - lu(1377) * b(144) + b(113) = b(113) - lu(1376) * b(144) + b(105) = b(105) - lu(1375) * b(144) + b(96) = b(96) - lu(1374) * b(144) + b(95) = b(95) - lu(1373) * b(144) + b(85) = b(85) - lu(1372) * b(144) + b(81) = b(81) - lu(1371) * b(144) + b(80) = b(80) - lu(1370) * b(144) + b(74) = b(74) - lu(1369) * b(144) + b(73) = b(73) - lu(1368) * b(144) + b(55) = b(55) - lu(1367) * b(144) + b(45) = b(45) - lu(1366) * b(144) + b(143) = b(143) * lu(1362) + b(142) = b(142) - lu(1361) * b(143) + b(141) = b(141) - lu(1360) * b(143) + b(140) = b(140) - lu(1359) * b(143) + b(139) = b(139) - lu(1358) * b(143) + b(138) = b(138) - lu(1357) * b(143) + b(137) = b(137) - lu(1356) * b(143) + b(136) = b(136) - lu(1355) * b(143) + b(135) = b(135) - lu(1354) * b(143) + b(134) = b(134) - lu(1353) * b(143) + b(133) = b(133) - lu(1352) * b(143) + b(131) = b(131) - lu(1351) * b(143) + b(130) = b(130) - lu(1350) * b(143) + b(129) = b(129) - lu(1349) * b(143) + b(120) = b(120) - lu(1348) * b(143) + b(104) = b(104) - lu(1347) * b(143) + b(101) = b(101) - lu(1346) * b(143) + b(47) = b(47) - lu(1345) * b(143) + b(46) = b(46) - lu(1344) * b(143) + b(43) = b(43) - lu(1343) * b(143) + b(41) = b(41) - lu(1342) * b(143) + b(142) = b(142) * lu(1337) + b(141) = b(141) - lu(1336) * b(142) + b(140) = b(140) - lu(1335) * b(142) + b(139) = b(139) - lu(1334) * b(142) + b(138) = b(138) - lu(1333) * b(142) + b(137) = b(137) - lu(1332) * b(142) + b(136) = b(136) - lu(1331) * b(142) + b(135) = b(135) - lu(1330) * b(142) + b(134) = b(134) - lu(1329) * b(142) + b(133) = b(133) - lu(1328) * b(142) + b(132) = b(132) - lu(1327) * b(142) + b(131) = b(131) - lu(1326) * b(142) + b(130) = b(130) - lu(1325) * b(142) + b(129) = b(129) - lu(1324) * b(142) + b(128) = b(128) - lu(1323) * b(142) + b(127) = b(127) - lu(1322) * b(142) + b(126) = b(126) - lu(1321) * b(142) + b(125) = b(125) - lu(1320) * b(142) + b(124) = b(124) - lu(1319) * b(142) + b(123) = b(123) - lu(1318) * b(142) + b(122) = b(122) - lu(1317) * b(142) + b(121) = b(121) - lu(1316) * b(142) + b(120) = b(120) - lu(1315) * b(142) + b(119) = b(119) - lu(1314) * b(142) + b(118) = b(118) - lu(1313) * b(142) + b(117) = b(117) - lu(1312) * b(142) + b(116) = b(116) - lu(1311) * b(142) + b(115) = b(115) - lu(1310) * b(142) + b(112) = b(112) - lu(1309) * b(142) + b(111) = b(111) - lu(1308) * b(142) + b(110) = b(110) - lu(1307) * b(142) + b(108) = b(108) - lu(1306) * b(142) + b(107) = b(107) - lu(1305) * b(142) + b(106) = b(106) - lu(1304) * b(142) + b(104) = b(104) - lu(1303) * b(142) + b(103) = b(103) - lu(1302) * b(142) + b(102) = b(102) - lu(1301) * b(142) + b(97) = b(97) - lu(1300) * b(142) + b(96) = b(96) - lu(1299) * b(142) + b(95) = b(95) - lu(1298) * b(142) + b(94) = b(94) - lu(1297) * b(142) + b(93) = b(93) - lu(1296) * b(142) + b(91) = b(91) - lu(1295) * b(142) + b(90) = b(90) - lu(1294) * b(142) + b(89) = b(89) - lu(1293) * b(142) + b(87) = b(87) - lu(1292) * b(142) + b(85) = b(85) - lu(1291) * b(142) + b(84) = b(84) - lu(1290) * b(142) + b(83) = b(83) - lu(1289) * b(142) + b(82) = b(82) - lu(1288) * b(142) + b(78) = b(78) - lu(1287) * b(142) + b(75) = b(75) - lu(1286) * b(142) + b(73) = b(73) - lu(1285) * b(142) + b(71) = b(71) - lu(1284) * b(142) + b(70) = b(70) - lu(1283) * b(142) + b(69) = b(69) - lu(1282) * b(142) + b(67) = b(67) - lu(1281) * b(142) + b(66) = b(66) - lu(1280) * b(142) + b(65) = b(65) - lu(1279) * b(142) + b(64) = b(64) - lu(1278) * b(142) + b(63) = b(63) - lu(1277) * b(142) + b(62) = b(62) - lu(1276) * b(142) + b(59) = b(59) - lu(1275) * b(142) + b(58) = b(58) - lu(1274) * b(142) + b(57) = b(57) - lu(1273) * b(142) + b(52) = b(52) - lu(1272) * b(142) + b(40) = b(40) - lu(1271) * b(142) + b(2) = b(2) - lu(1270) * b(142) + b(1) = b(1) - lu(1269) * b(142) + b(141) = b(141) * lu(1263) + b(140) = b(140) - lu(1262) * b(141) + b(139) = b(139) - lu(1261) * b(141) + b(138) = b(138) - lu(1260) * b(141) + b(137) = b(137) - lu(1259) * b(141) + b(136) = b(136) - lu(1258) * b(141) + b(135) = b(135) - lu(1257) * b(141) + b(134) = b(134) - lu(1256) * b(141) + b(131) = b(131) - lu(1255) * b(141) + b(130) = b(130) - lu(1254) * b(141) + b(129) = b(129) - lu(1253) * b(141) + b(120) = b(120) - lu(1252) * b(141) + end subroutine lu_slv05 + subroutine lu_slv06( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(140) = b(140) * lu(1245) + b(139) = b(139) - lu(1244) * b(140) + b(138) = b(138) - lu(1243) * b(140) + b(137) = b(137) - lu(1242) * b(140) + b(136) = b(136) - lu(1241) * b(140) + b(135) = b(135) - lu(1240) * b(140) + b(134) = b(134) - lu(1239) * b(140) + b(133) = b(133) - lu(1238) * b(140) + b(131) = b(131) - lu(1237) * b(140) + b(130) = b(130) - lu(1236) * b(140) + b(120) = b(120) - lu(1235) * b(140) + b(115) = b(115) - lu(1234) * b(140) + b(104) = b(104) - lu(1233) * b(140) + b(78) = b(78) - lu(1232) * b(140) + b(66) = b(66) - lu(1231) * b(140) + b(139) = b(139) * lu(1223) + b(138) = b(138) - lu(1222) * b(139) + b(137) = b(137) - lu(1221) * b(139) + b(136) = b(136) - lu(1220) * b(139) + b(135) = b(135) - lu(1219) * b(139) + b(134) = b(134) - lu(1218) * b(139) + b(133) = b(133) - lu(1217) * b(139) + b(132) = b(132) - lu(1216) * b(139) + b(131) = b(131) - lu(1215) * b(139) + b(130) = b(130) - lu(1214) * b(139) + b(129) = b(129) - lu(1213) * b(139) + b(128) = b(128) - lu(1212) * b(139) + b(127) = b(127) - lu(1211) * b(139) + b(126) = b(126) - lu(1210) * b(139) + b(125) = b(125) - lu(1209) * b(139) + b(124) = b(124) - lu(1208) * b(139) + b(123) = b(123) - lu(1207) * b(139) + b(122) = b(122) - lu(1206) * b(139) + b(121) = b(121) - lu(1205) * b(139) + b(119) = b(119) - lu(1204) * b(139) + b(118) = b(118) - lu(1203) * b(139) + b(117) = b(117) - lu(1202) * b(139) + b(116) = b(116) - lu(1201) * b(139) + b(115) = b(115) - lu(1200) * b(139) + b(114) = b(114) - lu(1199) * b(139) + b(112) = b(112) - lu(1198) * b(139) + b(111) = b(111) - lu(1197) * b(139) + b(110) = b(110) - lu(1196) * b(139) + b(109) = b(109) - lu(1195) * b(139) + b(97) = b(97) - lu(1194) * b(139) + b(87) = b(87) - lu(1193) * b(139) + b(86) = b(86) - lu(1192) * b(139) + b(78) = b(78) - lu(1191) * b(139) + b(77) = b(77) - lu(1190) * b(139) + b(43) = b(43) - lu(1189) * b(139) + b(42) = b(42) - lu(1188) * b(139) + b(138) = b(138) * lu(1179) + b(137) = b(137) - lu(1178) * b(138) + b(136) = b(136) - lu(1177) * b(138) + b(135) = b(135) - lu(1176) * b(138) + b(134) = b(134) - lu(1175) * b(138) + b(133) = b(133) - lu(1174) * b(138) + b(132) = b(132) - lu(1173) * b(138) + b(131) = b(131) - lu(1172) * b(138) + b(130) = b(130) - lu(1171) * b(138) + b(129) = b(129) - lu(1170) * b(138) + b(128) = b(128) - lu(1169) * b(138) + b(127) = b(127) - lu(1168) * b(138) + b(126) = b(126) - lu(1167) * b(138) + b(125) = b(125) - lu(1166) * b(138) + b(124) = b(124) - lu(1165) * b(138) + b(123) = b(123) - lu(1164) * b(138) + b(122) = b(122) - lu(1163) * b(138) + b(121) = b(121) - lu(1162) * b(138) + b(120) = b(120) - lu(1161) * b(138) + b(119) = b(119) - lu(1160) * b(138) + b(118) = b(118) - lu(1159) * b(138) + b(117) = b(117) - lu(1158) * b(138) + b(116) = b(116) - lu(1157) * b(138) + b(115) = b(115) - lu(1156) * b(138) + b(114) = b(114) - lu(1155) * b(138) + b(113) = b(113) - lu(1154) * b(138) + b(112) = b(112) - lu(1153) * b(138) + b(111) = b(111) - lu(1152) * b(138) + b(110) = b(110) - lu(1151) * b(138) + b(109) = b(109) - lu(1150) * b(138) + b(108) = b(108) - lu(1149) * b(138) + b(107) = b(107) - lu(1148) * b(138) + b(106) = b(106) - lu(1147) * b(138) + b(105) = b(105) - lu(1146) * b(138) + b(104) = b(104) - lu(1145) * b(138) + b(103) = b(103) - lu(1144) * b(138) + b(101) = b(101) - lu(1143) * b(138) + b(97) = b(97) - lu(1142) * b(138) + b(95) = b(95) - lu(1141) * b(138) + b(94) = b(94) - lu(1140) * b(138) + b(93) = b(93) - lu(1139) * b(138) + b(91) = b(91) - lu(1138) * b(138) + b(90) = b(90) - lu(1137) * b(138) + b(89) = b(89) - lu(1136) * b(138) + b(87) = b(87) - lu(1135) * b(138) + b(86) = b(86) - lu(1134) * b(138) + b(85) = b(85) - lu(1133) * b(138) + b(84) = b(84) - lu(1132) * b(138) + b(83) = b(83) - lu(1131) * b(138) + b(82) = b(82) - lu(1130) * b(138) + b(81) = b(81) - lu(1129) * b(138) + b(79) = b(79) - lu(1128) * b(138) + b(78) = b(78) - lu(1127) * b(138) + b(77) = b(77) - lu(1126) * b(138) + b(75) = b(75) - lu(1125) * b(138) + b(74) = b(74) - lu(1124) * b(138) + b(73) = b(73) - lu(1123) * b(138) + b(71) = b(71) - lu(1122) * b(138) + b(70) = b(70) - lu(1121) * b(138) + b(68) = b(68) - lu(1120) * b(138) + b(67) = b(67) - lu(1119) * b(138) + b(65) = b(65) - lu(1118) * b(138) + b(64) = b(64) - lu(1117) * b(138) + b(63) = b(63) - lu(1116) * b(138) + b(62) = b(62) - lu(1115) * b(138) + b(61) = b(61) - lu(1114) * b(138) + b(60) = b(60) - lu(1113) * b(138) + b(59) = b(59) - lu(1112) * b(138) + b(58) = b(58) - lu(1111) * b(138) + b(57) = b(57) - lu(1110) * b(138) + b(56) = b(56) - lu(1109) * b(138) + b(54) = b(54) - lu(1108) * b(138) + b(53) = b(53) - lu(1107) * b(138) + b(52) = b(52) - lu(1106) * b(138) + b(51) = b(51) - lu(1105) * b(138) + b(49) = b(49) - lu(1104) * b(138) + b(47) = b(47) - lu(1103) * b(138) + b(46) = b(46) - lu(1102) * b(138) + b(45) = b(45) - lu(1101) * b(138) + b(41) = b(41) - lu(1100) * b(138) + b(39) = b(39) - lu(1099) * b(138) + b(38) = b(38) - lu(1098) * b(138) + b(36) = b(36) - lu(1097) * b(138) + b(35) = b(35) - lu(1096) * b(138) + b(34) = b(34) - lu(1095) * b(138) + b(33) = b(33) - lu(1094) * b(138) + b(32) = b(32) - lu(1093) * b(138) + b(31) = b(31) - lu(1092) * b(138) + b(30) = b(30) - lu(1091) * b(138) + b(29) = b(29) - lu(1090) * b(138) + b(3) = b(3) - lu(1089) * b(138) + b(137) = b(137) * lu(1079) + b(136) = b(136) - lu(1078) * b(137) + b(135) = b(135) - lu(1077) * b(137) + b(134) = b(134) - lu(1076) * b(137) + b(133) = b(133) - lu(1075) * b(137) + b(132) = b(132) - lu(1074) * b(137) + b(131) = b(131) - lu(1073) * b(137) + b(130) = b(130) - lu(1072) * b(137) + b(129) = b(129) - lu(1071) * b(137) + b(128) = b(128) - lu(1070) * b(137) + b(113) = b(113) - lu(1069) * b(137) + b(107) = b(107) - lu(1068) * b(137) + b(96) = b(96) - lu(1067) * b(137) + b(50) = b(50) - lu(1066) * b(137) + b(44) = b(44) - lu(1065) * b(137) + b(136) = b(136) * lu(1054) + b(135) = b(135) - lu(1053) * b(136) + b(134) = b(134) - lu(1052) * b(136) + b(133) = b(133) - lu(1051) * b(136) + b(132) = b(132) - lu(1050) * b(136) + b(131) = b(131) - lu(1049) * b(136) + b(130) = b(130) - lu(1048) * b(136) + b(129) = b(129) - lu(1047) * b(136) + b(127) = b(127) - lu(1046) * b(136) + b(126) = b(126) - lu(1045) * b(136) + b(125) = b(125) - lu(1044) * b(136) + b(124) = b(124) - lu(1043) * b(136) + b(123) = b(123) - lu(1042) * b(136) + b(122) = b(122) - lu(1041) * b(136) + b(121) = b(121) - lu(1040) * b(136) + b(119) = b(119) - lu(1039) * b(136) + b(118) = b(118) - lu(1038) * b(136) + b(117) = b(117) - lu(1037) * b(136) + b(116) = b(116) - lu(1036) * b(136) + b(115) = b(115) - lu(1035) * b(136) + b(110) = b(110) - lu(1034) * b(136) + b(108) = b(108) - lu(1033) * b(136) + b(106) = b(106) - lu(1032) * b(136) + b(95) = b(95) - lu(1031) * b(136) + b(94) = b(94) - lu(1030) * b(136) + b(87) = b(87) - lu(1029) * b(136) + b(79) = b(79) - lu(1028) * b(136) + b(67) = b(67) - lu(1027) * b(136) + b(60) = b(60) - lu(1026) * b(136) + b(51) = b(51) - lu(1025) * b(136) + b(135) = b(135) * lu(1013) + b(134) = b(134) - lu(1012) * b(135) + b(131) = b(131) - lu(1011) * b(135) + b(130) = b(130) - lu(1010) * b(135) + b(129) = b(129) - lu(1009) * b(135) + b(127) = b(127) - lu(1008) * b(135) + b(126) = b(126) - lu(1007) * b(135) + b(125) = b(125) - lu(1006) * b(135) + b(124) = b(124) - lu(1005) * b(135) + b(123) = b(123) - lu(1004) * b(135) + b(122) = b(122) - lu(1003) * b(135) + b(121) = b(121) - lu(1002) * b(135) + b(119) = b(119) - lu(1001) * b(135) + b(118) = b(118) - lu(1000) * b(135) + b(117) = b(117) - lu(999) * b(135) + b(116) = b(116) - lu(998) * b(135) + b(115) = b(115) - lu(997) * b(135) + b(114) = b(114) - lu(996) * b(135) + b(112) = b(112) - lu(995) * b(135) + b(111) = b(111) - lu(994) * b(135) + b(110) = b(110) - lu(993) * b(135) + b(109) = b(109) - lu(992) * b(135) + b(102) = b(102) - lu(991) * b(135) + b(95) = b(95) - lu(990) * b(135) + b(86) = b(86) - lu(989) * b(135) + b(61) = b(61) - lu(988) * b(135) + b(60) = b(60) - lu(987) * b(135) + b(55) = b(55) - lu(986) * b(135) + b(49) = b(49) - lu(985) * b(135) + b(36) = b(36) - lu(984) * b(135) + end subroutine lu_slv06 + subroutine lu_slv07( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(134) = b(134) * lu(971) + b(133) = b(133) - lu(970) * b(134) + b(132) = b(132) - lu(969) * b(134) + b(131) = b(131) - lu(968) * b(134) + b(130) = b(130) - lu(967) * b(134) + b(129) = b(129) - lu(966) * b(134) + b(128) = b(128) - lu(965) * b(134) + b(127) = b(127) - lu(964) * b(134) + b(126) = b(126) - lu(963) * b(134) + b(125) = b(125) - lu(962) * b(134) + b(124) = b(124) - lu(961) * b(134) + b(123) = b(123) - lu(960) * b(134) + b(122) = b(122) - lu(959) * b(134) + b(121) = b(121) - lu(958) * b(134) + b(119) = b(119) - lu(957) * b(134) + b(118) = b(118) - lu(956) * b(134) + b(117) = b(117) - lu(955) * b(134) + b(116) = b(116) - lu(954) * b(134) + b(115) = b(115) - lu(953) * b(134) + b(112) = b(112) - lu(952) * b(134) + b(111) = b(111) - lu(951) * b(134) + b(110) = b(110) - lu(950) * b(134) + b(108) = b(108) - lu(949) * b(134) + b(106) = b(106) - lu(948) * b(134) + b(105) = b(105) - lu(947) * b(134) + b(103) = b(103) - lu(946) * b(134) + b(102) = b(102) - lu(945) * b(134) + b(100) = b(100) - lu(944) * b(134) + b(99) = b(99) - lu(943) * b(134) + b(98) = b(98) - lu(942) * b(134) + b(97) = b(97) - lu(941) * b(134) + b(95) = b(95) - lu(940) * b(134) + b(94) = b(94) - lu(939) * b(134) + b(93) = b(93) - lu(938) * b(134) + b(91) = b(91) - lu(937) * b(134) + b(85) = b(85) - lu(936) * b(134) + b(84) = b(84) - lu(935) * b(134) + b(78) = b(78) - lu(934) * b(134) + b(71) = b(71) - lu(933) * b(134) + b(69) = b(69) - lu(932) * b(134) + b(68) = b(68) - lu(931) * b(134) + b(66) = b(66) - lu(930) * b(134) + b(63) = b(63) - lu(929) * b(134) + b(61) = b(61) - lu(928) * b(134) + b(60) = b(60) - lu(927) * b(134) + b(56) = b(56) - lu(926) * b(134) + b(133) = b(133) * lu(912) + b(132) = b(132) - lu(911) * b(133) + b(131) = b(131) - lu(910) * b(133) + b(130) = b(130) - lu(909) * b(133) + b(129) = b(129) - lu(908) * b(133) + b(128) = b(128) - lu(907) * b(133) + b(115) = b(115) - lu(906) * b(133) + b(104) = b(104) - lu(905) * b(133) + b(132) = b(132) * lu(890) + b(131) = b(131) - lu(889) * b(132) + b(130) = b(130) - lu(888) * b(132) + b(129) = b(129) - lu(887) * b(132) + b(128) = b(128) - lu(886) * b(132) + b(113) = b(113) - lu(885) * b(132) + b(107) = b(107) - lu(884) * b(132) + b(50) = b(50) - lu(883) * b(132) + b(44) = b(44) - lu(882) * b(132) + b(37) = b(37) - lu(881) * b(132) + b(28) = b(28) - lu(880) * b(132) + b(131) = b(131) * lu(870) + b(130) = b(130) - lu(869) * b(131) + b(120) = b(120) - lu(868) * b(131) + b(101) = b(101) - lu(867) * b(131) + b(48) = b(48) - lu(866) * b(131) + b(130) = b(130) * lu(856) + b(120) = b(120) - lu(855) * b(130) + b(101) = b(101) - lu(854) * b(130) + b(48) = b(48) - lu(853) * b(130) + b(129) = b(129) * lu(843) + b(115) = b(115) - lu(842) * b(129) + b(110) = b(110) - lu(841) * b(129) + b(105) = b(105) - lu(840) * b(129) + b(100) = b(100) - lu(839) * b(129) + b(99) = b(99) - lu(838) * b(129) + b(98) = b(98) - lu(837) * b(129) + b(92) = b(92) - lu(836) * b(129) + b(88) = b(88) - lu(835) * b(129) + b(76) = b(76) - lu(834) * b(129) + b(72) = b(72) - lu(833) * b(129) + b(69) = b(69) - lu(832) * b(129) + b(43) = b(43) - lu(831) * b(129) + b(42) = b(42) - lu(830) * b(129) + b(128) = b(128) * lu(816) + b(96) = b(96) - lu(815) * b(128) + b(80) = b(80) - lu(814) * b(128) + b(50) = b(50) - lu(813) * b(128) + b(37) = b(37) - lu(812) * b(128) + b(127) = b(127) * lu(799) + b(126) = b(126) - lu(798) * b(127) + b(125) = b(125) - lu(797) * b(127) + b(124) = b(124) - lu(796) * b(127) + b(123) = b(123) - lu(795) * b(127) + b(122) = b(122) - lu(794) * b(127) + b(121) = b(121) - lu(793) * b(127) + b(119) = b(119) - lu(792) * b(127) + b(118) = b(118) - lu(791) * b(127) + b(115) = b(115) - lu(790) * b(127) + b(110) = b(110) - lu(789) * b(127) + b(95) = b(95) - lu(788) * b(127) + b(87) = b(87) - lu(787) * b(127) + b(75) = b(75) - lu(786) * b(127) + b(74) = b(74) - lu(785) * b(127) + b(60) = b(60) - lu(784) * b(127) + b(126) = b(126) * lu(770) + b(121) = b(121) - lu(769) * b(126) + b(118) = b(118) - lu(768) * b(126) + b(87) = b(87) - lu(767) * b(126) + b(81) = b(81) - lu(766) * b(126) + b(75) = b(75) - lu(765) * b(126) + b(125) = b(125) * lu(750) + b(124) = b(124) - lu(749) * b(125) + b(121) = b(121) - lu(748) * b(125) + b(118) = b(118) - lu(747) * b(125) + b(116) = b(116) - lu(746) * b(125) + b(115) = b(115) - lu(745) * b(125) + b(114) = b(114) - lu(744) * b(125) + b(124) = b(124) * lu(731) + b(122) = b(122) - lu(730) * b(124) + b(121) = b(121) - lu(729) * b(124) + b(118) = b(118) - lu(728) * b(124) + b(115) = b(115) - lu(727) * b(124) + b(111) = b(111) - lu(726) * b(124) + b(110) = b(110) - lu(725) * b(124) + b(79) = b(79) - lu(724) * b(124) + b(58) = b(58) - lu(723) * b(124) + b(123) = b(123) * lu(707) + b(122) = b(122) - lu(706) * b(123) + b(121) = b(121) - lu(705) * b(123) + b(119) = b(119) - lu(704) * b(123) + b(118) = b(118) - lu(703) * b(123) + b(115) = b(115) - lu(702) * b(123) + b(111) = b(111) - lu(701) * b(123) + b(110) = b(110) - lu(700) * b(123) + b(95) = b(95) - lu(699) * b(123) + b(83) = b(83) - lu(698) * b(123) + b(79) = b(79) - lu(697) * b(123) + b(60) = b(60) - lu(696) * b(123) + b(122) = b(122) * lu(684) + b(121) = b(121) - lu(683) * b(122) + b(118) = b(118) - lu(682) * b(122) + b(115) = b(115) - lu(681) * b(122) + b(110) = b(110) - lu(680) * b(122) + b(95) = b(95) - lu(679) * b(122) + b(79) = b(79) - lu(678) * b(122) + b(52) = b(52) - lu(677) * b(122) + b(121) = b(121) * lu(669) + b(115) = b(115) - lu(668) * b(121) + b(120) = b(120) * lu(657) + b(101) = b(101) - lu(656) * b(120) + b(48) = b(48) - lu(655) * b(120) + b(119) = b(119) * lu(644) + b(115) = b(115) - lu(643) * b(119) + b(118) = b(118) * lu(637) + b(117) = b(117) * lu(625) + b(79) = b(79) - lu(624) * b(117) + b(65) = b(65) - lu(623) * b(117) + b(116) = b(116) * lu(614) + b(115) = b(115) - lu(613) * b(116) + b(115) = b(115) * lu(609) + b(114) = b(114) * lu(594) + b(103) = b(103) - lu(593) * b(114) + b(87) = b(87) - lu(592) * b(114) + b(61) = b(61) - lu(591) * b(114) + b(113) = b(113) * lu(581) + b(107) = b(107) - lu(580) * b(113) + b(44) = b(44) - lu(579) * b(113) + b(112) = b(112) * lu(568) + b(94) = b(94) - lu(567) * b(112) + b(70) = b(70) - lu(566) * b(112) + b(111) = b(111) * lu(558) + b(60) = b(60) - lu(557) * b(111) + b(110) = b(110) * lu(552) + b(95) = b(95) - lu(551) * b(110) + b(109) = b(109) * lu(534) + b(102) = b(102) - lu(533) * b(109) + b(87) = b(87) - lu(532) * b(109) + b(108) = b(108) * lu(520) + b(94) = b(94) - lu(519) * b(108) + b(64) = b(64) - lu(518) * b(108) + b(107) = b(107) * lu(511) + b(44) = b(44) - lu(510) * b(107) + b(106) = b(106) * lu(501) + b(79) = b(79) - lu(500) * b(106) + b(59) = b(59) - lu(499) * b(106) + b(51) = b(51) - lu(498) * b(106) + b(105) = b(105) * lu(489) + b(100) = b(100) - lu(488) * b(105) + b(99) = b(99) - lu(487) * b(105) + b(98) = b(98) - lu(486) * b(105) + b(88) = b(88) - lu(485) * b(105) + b(72) = b(72) - lu(484) * b(105) + b(104) = b(104) * lu(477) + b(103) = b(103) * lu(467) + b(82) = b(82) - lu(466) * b(103) + b(102) = b(102) * lu(456) + end subroutine lu_slv07 + subroutine lu_slv08( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(101) = b(101) * lu(448) + b(48) = b(48) - lu(447) * b(101) + b(100) = b(100) * lu(440) + b(99) = b(99) - lu(439) * b(100) + b(98) = b(98) - lu(438) * b(100) + b(92) = b(92) - lu(437) * b(100) + b(76) = b(76) - lu(436) * b(100) + b(99) = b(99) * lu(429) + b(76) = b(76) - lu(428) * b(99) + b(98) = b(98) * lu(420) + b(97) = b(97) * lu(412) + b(69) = b(69) - lu(411) * b(97) + b(40) = b(40) - lu(410) * b(97) + b(96) = b(96) * lu(402) + b(50) = b(50) - lu(401) * b(96) + b(95) = b(95) * lu(397) + b(94) = b(94) * lu(391) + b(93) = b(93) * lu(380) + b(91) = b(91) - lu(379) * b(93) + b(90) = b(90) - lu(378) * b(93) + b(68) = b(68) - lu(377) * b(93) + b(61) = b(61) - lu(376) * b(93) + b(92) = b(92) * lu(366) + b(88) = b(88) - lu(365) * b(92) + b(76) = b(76) - lu(364) * b(92) + b(91) = b(91) * lu(357) + b(57) = b(57) - lu(356) * b(91) + b(90) = b(90) * lu(346) + b(68) = b(68) - lu(345) * b(90) + b(89) = b(89) * lu(338) + b(88) = b(88) * lu(331) + b(87) = b(87) * lu(327) + b(86) = b(86) * lu(318) + b(85) = b(85) * lu(312) + b(84) = b(84) * lu(304) + b(62) = b(62) - lu(303) * b(84) + b(83) = b(83) * lu(295) + b(82) = b(82) * lu(287) + b(81) = b(81) * lu(279) + b(80) = b(80) * lu(271) + b(79) = b(79) * lu(267) + b(78) = b(78) * lu(263) + b(77) = b(77) * lu(255) + b(76) = b(76) * lu(250) + b(75) = b(75) * lu(244) + b(74) = b(74) * lu(237) + b(73) = b(73) * lu(230) + b(72) = b(72) * lu(223) + b(71) = b(71) * lu(216) + b(2) = b(2) - lu(215) * b(71) + b(70) = b(70) * lu(208) + b(69) = b(69) * lu(203) + b(68) = b(68) * lu(198) + b(67) = b(67) * lu(192) + b(66) = b(66) * lu(186) + b(65) = b(65) * lu(180) + b(64) = b(64) * lu(174) + b(63) = b(63) * lu(168) + b(1) = b(1) - lu(167) * b(63) + b(62) = b(62) * lu(161) + b(61) = b(61) * lu(157) + b(60) = b(60) * lu(154) + b(59) = b(59) * lu(149) + b(58) = b(58) * lu(144) + b(57) = b(57) * lu(139) + b(56) = b(56) * lu(132) + b(55) = b(55) * lu(126) + b(54) = b(54) * lu(120) + b(53) = b(53) * lu(114) + b(52) = b(52) * lu(110) + b(51) = b(51) * lu(106) + b(50) = b(50) * lu(103) + b(49) = b(49) * lu(98) + b(36) = b(36) - lu(97) * b(49) + b(48) = b(48) * lu(94) + b(47) = b(47) * lu(90) + b(46) = b(46) * lu(86) + b(45) = b(45) * lu(82) + b(44) = b(44) * lu(80) + b(43) = b(43) * lu(78) + b(42) = b(42) - lu(77) * b(43) + b(42) = b(42) * lu(75) + b(41) = b(41) * lu(72) + b(40) = b(40) * lu(69) + b(39) = b(39) * lu(66) + b(38) = b(38) * lu(61) + b(37) = b(37) * lu(58) + b(36) = b(36) * lu(56) + b(3) = b(3) - lu(55) * b(36) + b(35) = b(35) * lu(51) + b(34) = b(34) * lu(48) + b(33) = b(33) * lu(45) + b(32) = b(32) * lu(42) + b(31) = b(31) * lu(39) + b(30) = b(30) * lu(36) + b(29) = b(29) * lu(33) + b(28) = b(28) * lu(30) + b(27) = b(27) * lu(29) + b(26) = b(26) * lu(28) + b(25) = b(25) * lu(27) + b(24) = b(24) * lu(26) + b(23) = b(23) * lu(25) + b(22) = b(22) * lu(24) + b(21) = b(21) * lu(23) + b(20) = b(20) * lu(22) + b(19) = b(19) * lu(21) + b(18) = b(18) * lu(19) + b(17) = b(17) * lu(18) + b(16) = b(16) * lu(16) + b(15) = b(15) * lu(15) + b(14) = b(14) * lu(14) + b(13) = b(13) * lu(13) + b(12) = b(12) * lu(12) + b(11) = b(11) * lu(11) + b(10) = b(10) * lu(10) + b(9) = b(9) * lu(9) + b(8) = b(8) * lu(8) + b(7) = b(7) * lu(7) + b(6) = b(6) * lu(6) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv08 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + call lu_slv05( lu, b ) + call lu_slv06( lu, b ) + call lu_slv07( lu, b ) + call lu_slv08( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 new file mode 100644 index 0000000000..40ae151e96 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_nln_matrix.F90 @@ -0,0 +1,2340 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1223) = -(rxt(116)*y(2) + rxt(134)*y(3) + rxt(161)*y(22) + rxt(166)*y(23) & + + rxt(174)*y(24) + rxt(189)*y(9) + rxt(192)*y(10) + rxt(204) & + *y(28) + rxt(231)*y(37) + rxt(290)*y(44) + rxt(311)*y(59) & + + rxt(333)*y(77) + rxt(339)*y(78) + rxt(357)*y(83) + rxt(395) & + *y(105)) + mat(1464) = -rxt(116)*y(1) + mat(1358) = -rxt(134)*y(1) + mat(1261) = -rxt(161)*y(1) + mat(1180) = -rxt(166)*y(1) + mat(1334) = -rxt(174)*y(1) + mat(976) = -rxt(189)*y(1) + mat(1393) = -rxt(192)*y(1) + mat(1427) = -rxt(204)*y(1) + mat(918) = -rxt(231)*y(1) + mat(260) = -rxt(290)*y(1) + mat(605) = -rxt(311)*y(1) + mat(760) = -rxt(333)*y(1) + mat(651) = -rxt(339)*y(1) + mat(547) = -rxt(357)*y(1) + mat(324) = -rxt(395)*y(1) + mat(1223) = mat(1223) + .100_r8*rxt(357)*y(83) + .200_r8*rxt(333)*y(77) & + + .200_r8*rxt(339)*y(78) + mat(1464) = mat(1464) + rxt(115)*y(4) + mat(846) = rxt(115)*y(2) + mat(1334) = mat(1334) + .250_r8*rxt(301)*y(48) + .250_r8*rxt(349)*y(76) + mat(547) = mat(547) + .100_r8*rxt(357)*y(1) + mat(807) = .250_r8*rxt(301)*y(24) + mat(760) = mat(760) + .200_r8*rxt(333)*y(1) + mat(651) = mat(651) + .200_r8*rxt(339)*y(1) + mat(779) = .250_r8*rxt(349)*y(24) + mat(1471) = -(rxt(115)*y(4) + rxt(116)*y(1) + 4._r8*rxt(117)*y(2) + rxt(165) & + *y(23) + rxt(172)*y(21) + rxt(173)*y(24) + rxt(176)*y(25) & + + rxt(187)*y(9) + (rxt(190) + rxt(191)) * y(10) + rxt(198)*y(11) & + + rxt(211)*y(30) + rxt(224)*y(33) + rxt(225)*y(34) + rxt(228) & + *y(35) + rxt(234)*y(38) + rxt(244)*y(39) + rxt(245)*y(40) & + + rxt(246)*y(41) + rxt(268)*y(19) + (rxt(451) + rxt(452) & + ) * y(127) + rxt(458)*y(129)) + mat(852) = -rxt(115)*y(2) + mat(1230) = -rxt(116)*y(2) + mat(1187) = -rxt(165)*y(2) + mat(667) = -rxt(172)*y(2) + mat(1341) = -rxt(173)*y(2) + mat(344) = -rxt(176)*y(2) + mat(983) = -rxt(187)*y(2) + mat(1400) = -(rxt(190) + rxt(191)) * y(2) + mat(1024) = -rxt(198)*y(2) + mat(904) = -rxt(211)*y(2) + mat(1088) = -rxt(224)*y(2) + mat(517) = -rxt(225)*y(2) + mat(590) = -rxt(228)*y(2) + mat(829) = -rxt(234)*y(2) + mat(483) = -rxt(244)*y(2) + mat(409) = -rxt(245)*y(2) + mat(278) = -rxt(246)*y(2) + mat(1251) = -rxt(268)*y(2) + mat(375) = -(rxt(451) + rxt(452)) * y(2) + mat(229) = -rxt(458)*y(2) + mat(1365) = (rxt(129)+rxt(130))*y(4) + mat(852) = mat(852) + (rxt(129)+rxt(130))*y(3) + rxt(182)*y(8) + rxt(457) & + *y(129) + rxt(449)*y(130) + mat(497) = rxt(182)*y(4) + rxt(183)*y(9) + rxt(184)*y(10) + rxt(454)*y(128) + mat(983) = mat(983) + rxt(183)*y(8) + mat(1400) = mat(1400) + rxt(184)*y(8) + mat(1187) = mat(1187) + 2.000_r8*rxt(168)*y(23) + mat(1268) = rxt(164)*y(24) + mat(1341) = mat(1341) + rxt(164)*y(22) + mat(427) = rxt(454)*y(8) + 1.150_r8*rxt(462)*y(132) + mat(229) = mat(229) + rxt(457)*y(4) + mat(337) = rxt(449)*y(4) + mat(435) = rxt(461)*y(132) + mat(446) = 1.150_r8*rxt(462)*y(128) + rxt(461)*y(131) + mat(1362) = -((rxt(129) + rxt(130)) * y(4) + rxt(131)*y(134) + rxt(134)*y(1) & + + rxt(151)*y(138) + rxt(152)*y(139) + rxt(156)*y(21) + rxt(157) & + *y(33) + rxt(158)*y(39) + rxt(159)*y(42)) + mat(850) = -(rxt(129) + rxt(130)) * y(3) + mat(863) = -rxt(131)*y(3) + mat(1227) = -rxt(134)*y(3) + mat(74) = -rxt(151)*y(3) + mat(88) = -rxt(152)*y(3) + mat(665) = -rxt(156)*y(3) + mat(1085) = -rxt(157)*y(3) + mat(482) = -rxt(158)*y(3) + mat(93) = -rxt(159)*y(3) + mat(850) = mat(850) + rxt(179)*y(133) + mat(426) = .850_r8*rxt(462)*y(132) + mat(254) = rxt(179)*y(4) + mat(445) = .850_r8*rxt(462)*y(128) + mat(843) = -(rxt(115)*y(2) + rxt(125)*y(6) + rxt(129)*y(3) + rxt(160)*y(22) & + + rxt(179)*y(133) + rxt(182)*y(8) + rxt(288)*y(56) + rxt(449) & + *y(130) + (rxt(456) + rxt(457)) * y(129) + rxt(459)*y(127)) + mat(1454) = -rxt(115)*y(4) + mat(76) = -rxt(125)*y(4) + mat(1349) = -rxt(129)*y(4) + mat(1253) = -rxt(160)*y(4) + mat(252) = -rxt(179)*y(4) + mat(491) = -rxt(182)*y(4) + mat(205) = -rxt(288)*y(4) + mat(336) = -rxt(449)*y(4) + mat(228) = -(rxt(456) + rxt(457)) * y(4) + mat(372) = -rxt(459)*y(4) + mat(1213) = 2.000_r8*rxt(116)*y(2) + 2.000_r8*rxt(134)*y(3) + rxt(189)*y(9) & + + rxt(192)*y(10) + rxt(166)*y(23) + rxt(161)*y(22) & + + 2.000_r8*rxt(174)*y(24) + rxt(204)*y(28) + rxt(231)*y(37) + mat(1454) = mat(1454) + 2.000_r8*rxt(116)*y(1) + 2.000_r8*rxt(117)*y(2) & + + rxt(124)*y(6) + rxt(190)*y(10) + rxt(165)*y(23) + rxt(198) & + *y(11) + rxt(173)*y(24) + rxt(211)*y(30) + rxt(234)*y(38) + mat(1349) = mat(1349) + 2.000_r8*rxt(134)*y(1) + mat(843) = mat(843) + 2.000_r8*rxt(125)*y(6) + mat(76) = mat(76) + rxt(124)*y(2) + 2.000_r8*rxt(125)*y(4) + mat(491) = mat(491) + rxt(186)*y(10) + mat(966) = rxt(189)*y(1) + rxt(455)*y(128) + mat(1383) = rxt(192)*y(1) + rxt(190)*y(2) + rxt(186)*y(8) + mat(1170) = rxt(166)*y(1) + rxt(165)*y(2) + rxt(202)*y(13) + rxt(167)*y(24) & + + rxt(213)*y(30) + mat(1009) = rxt(198)*y(2) + rxt(200)*y(24) + mat(231) = rxt(202)*y(23) + mat(1047) = rxt(271)*y(24) + mat(1253) = mat(1253) + rxt(161)*y(1) + rxt(163)*y(24) + mat(1324) = 2.000_r8*rxt(174)*y(1) + rxt(173)*y(2) + rxt(167)*y(23) & + + rxt(200)*y(11) + rxt(271)*y(16) + rxt(163)*y(22) & + + 2.000_r8*rxt(175)*y(24) + rxt(207)*y(28) + rxt(214)*y(30) & + + rxt(232)*y(37) + rxt(236)*y(38) + rxt(319)*y(64) & + + .750_r8*rxt(349)*y(76) + rxt(293)*y(46) + rxt(314)*y(61) & + + rxt(323)*y(67) + mat(1417) = rxt(204)*y(1) + rxt(207)*y(24) + mat(887) = rxt(211)*y(2) + rxt(213)*y(23) + rxt(214)*y(24) + ( & + + 2.000_r8*rxt(218)+2.000_r8*rxt(219))*y(30) + (rxt(240) & + +rxt(241))*y(38) + mat(908) = rxt(231)*y(1) + rxt(232)*y(24) + mat(817) = rxt(234)*y(2) + rxt(236)*y(24) + (rxt(240)+rxt(241))*y(30) & + + 2.000_r8*rxt(242)*y(38) + mat(424) = rxt(455)*y(9) + mat(470) = rxt(319)*y(24) + mat(772) = .750_r8*rxt(349)*y(24) + mat(503) = rxt(293)*y(24) + mat(524) = rxt(314)*y(24) + mat(629) = rxt(323)*y(24) + mat(78) = -(rxt(118)*y(2) + rxt(119)*y(4) + rxt(121)*y(1)) + mat(1436) = -rxt(118)*y(5) + mat(831) = -rxt(119)*y(5) + mat(1189) = -rxt(121)*y(5) + mat(1343) = rxt(129)*y(4) + mat(831) = mat(831) + rxt(129)*y(3) + mat(75) = -(rxt(124)*y(2) + rxt(125)*y(4)) + mat(1435) = -rxt(124)*y(6) + mat(830) = -rxt(125)*y(6) + mat(1188) = rxt(121)*y(5) + mat(1435) = mat(1435) + rxt(118)*y(5) + mat(830) = mat(830) + rxt(119)*y(5) + mat(77) = rxt(121)*y(1) + rxt(118)*y(2) + rxt(119)*y(4) + mat(657) = -(rxt(156)*y(3) + rxt(170)*y(23) + rxt(172)*y(2) + rxt(205)*y(28) & + + rxt(248)*y(141)) + mat(1348) = -rxt(156)*y(21) + mat(1161) = -rxt(170)*y(21) + mat(1452) = -rxt(172)*y(21) + mat(1415) = -rxt(205)*y(21) + mat(449) = -rxt(248)*y(21) + mat(1252) = rxt(163)*y(24) + mat(1315) = rxt(163)*y(22) + mat(609) = -((rxt(264) + rxt(265)) * y(23)) + mat(1156) = -(rxt(264) + rxt(265)) * y(20) + mat(1200) = .560_r8*rxt(311)*y(59) + .300_r8*rxt(357)*y(83) & + + .500_r8*rxt(290)*y(44) + .050_r8*rxt(333)*y(77) & + + .200_r8*rxt(339)*y(78) + mat(1451) = rxt(268)*y(19) + mat(953) = .220_r8*rxt(340)*y(79) + .250_r8*rxt(375)*y(91) + mat(1156) = mat(1156) + rxt(267)*y(19) + rxt(306)*y(53) + rxt(327)*y(68) & + + .350_r8*rxt(283)*y(135) + mat(997) = rxt(266)*y(19) + .220_r8*rxt(342)*y(79) + rxt(328)*y(68) & + + .500_r8*rxt(376)*y(91) + mat(1035) = .110_r8*rxt(344)*y(79) + .200_r8*rxt(378)*y(91) + mat(1234) = rxt(268)*y(2) + rxt(267)*y(23) + rxt(266)*y(11) + rxt(209)*y(28) & + + rxt(233)*y(37) + mat(1413) = rxt(209)*y(19) + mat(906) = rxt(233)*y(19) + mat(595) = .560_r8*rxt(311)*y(1) + mat(537) = .300_r8*rxt(357)*y(1) + mat(790) = .220_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(258) = .500_r8*rxt(290)*y(1) + mat(398) = rxt(306)*y(23) + mat(745) = .050_r8*rxt(333)*y(1) + mat(643) = .200_r8*rxt(339)*y(1) + mat(727) = .220_r8*rxt(340)*y(9) + .220_r8*rxt(342)*y(11) + .110_r8*rxt(344) & + *y(16) + .220_r8*rxt(345)*y(48) + mat(668) = rxt(327)*y(23) + rxt(328)*y(11) + mat(681) = .250_r8*rxt(375)*y(9) + .500_r8*rxt(376)*y(11) + .200_r8*rxt(378) & + *y(16) + .250_r8*rxt(379)*y(48) + mat(123) = .350_r8*rxt(283)*y(23) + mat(489) = -(rxt(181)*y(23) + rxt(182)*y(4) + rxt(183)*y(9) + (rxt(184) & + + rxt(185) + rxt(186)) * y(10) + rxt(454)*y(128)) + mat(1146) = -rxt(181)*y(8) + mat(840) = -rxt(182)*y(8) + mat(947) = -rxt(183)*y(8) + mat(1375) = -(rxt(184) + rxt(185) + rxt(186)) * y(8) + mat(423) = -rxt(454)*y(8) + mat(1448) = rxt(458)*y(129) + rxt(180)*y(133) + mat(840) = mat(840) + rxt(456)*y(129) + mat(370) = 1.100_r8*rxt(463)*y(132) + mat(227) = rxt(458)*y(2) + rxt(456)*y(4) + mat(431) = .200_r8*rxt(461)*y(132) + mat(251) = rxt(180)*y(2) + mat(441) = 1.100_r8*rxt(463)*y(127) + .200_r8*rxt(461)*y(131) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(971) = -(rxt(183)*y(8) + rxt(187)*y(2) + rxt(188)*y(24) + rxt(189)*y(1) & + + rxt(197)*y(11) + rxt(216)*y(30) + rxt(237)*y(38) + rxt(270) & + *y(16) + rxt(278)*y(137) + rxt(286)*y(55) + rxt(292)*y(46) & + + rxt(299)*y(48) + rxt(313)*y(61) + rxt(318)*y(64) + rxt(322) & + *y(67) + rxt(331)*y(73) + rxt(335)*y(74) + (rxt(340) + rxt(341) & + ) * y(79) + rxt(347)*y(76) + rxt(359)*y(88) + rxt(365)*y(89) & + + rxt(372)*y(84) + rxt(375)*y(91) + rxt(383)*y(96) + rxt(390) & + *y(100) + rxt(393)*y(103) + rxt(397)*y(106) + rxt(455)*y(128)) + mat(492) = -rxt(183)*y(9) + mat(1459) = -rxt(187)*y(9) + mat(1329) = -rxt(188)*y(9) + mat(1218) = -rxt(189)*y(9) + mat(1012) = -rxt(197)*y(9) + mat(892) = -rxt(216)*y(9) + mat(822) = -rxt(237)*y(9) + mat(1052) = -rxt(270)*y(9) + mat(188) = -rxt(278)*y(9) + mat(415) = -rxt(286)*y(9) + mat(504) = -rxt(292)*y(9) + mat(803) = -rxt(299)*y(9) + mat(526) = -rxt(313)*y(9) + mat(472) = -rxt(318)*y(9) + mat(631) = -rxt(322)*y(9) + mat(135) = -rxt(331)*y(9) + mat(360) = -rxt(335)*y(9) + mat(736) = -(rxt(340) + rxt(341)) * y(9) + mat(775) = -rxt(347)*y(9) + mat(714) = -rxt(359)*y(9) + mat(460) = -rxt(365)*y(9) + mat(386) = -rxt(372)*y(9) + mat(688) = -rxt(375)*y(9) + mat(308) = -rxt(383)*y(9) + mat(171) = -rxt(390)*y(9) + mat(220) = -rxt(393)*y(9) + mat(574) = -rxt(397)*y(9) + mat(425) = -rxt(455)*y(9) + mat(1459) = mat(1459) + rxt(190)*y(10) + mat(844) = rxt(182)*y(8) + rxt(179)*y(133) + mat(492) = mat(492) + rxt(182)*y(4) + 2.000_r8*rxt(185)*y(10) + rxt(181) & + *y(23) + mat(1388) = rxt(190)*y(2) + 2.000_r8*rxt(185)*y(8) + mat(1175) = rxt(181)*y(8) + mat(253) = rxt(179)*y(4) + mat(1398) = -((rxt(184) + rxt(185) + rxt(186)) * y(8) + (rxt(190) + rxt(191) & + ) * y(2) + rxt(192)*y(1) + rxt(193)*y(11) + rxt(195)*y(23) & + + rxt(201)*y(24) + rxt(217)*y(30) + rxt(238)*y(38) + rxt(300) & + *y(48) + rxt(353)*y(76) + rxt(387)*y(98)) + mat(496) = -(rxt(184) + rxt(185) + rxt(186)) * y(10) + mat(1469) = -(rxt(190) + rxt(191)) * y(10) + mat(1228) = -rxt(192)*y(10) + mat(1022) = -rxt(193)*y(10) + mat(1185) = -rxt(195)*y(10) + mat(1339) = -rxt(201)*y(10) + mat(902) = -rxt(217)*y(10) + mat(827) = -rxt(238)*y(10) + mat(811) = -rxt(300)*y(10) + mat(783) = -rxt(353)*y(10) + mat(85) = -rxt(387)*y(10) + mat(1228) = mat(1228) + rxt(189)*y(9) + mat(1469) = mat(1469) + rxt(187)*y(9) + rxt(198)*y(11) + mat(981) = rxt(189)*y(1) + rxt(187)*y(2) + 2.000_r8*rxt(197)*y(11) + rxt(270) & + *y(16) + rxt(188)*y(24) + rxt(216)*y(30) + rxt(237)*y(38) & + + rxt(318)*y(64) + rxt(299)*y(48) + rxt(331)*y(73) & + + .900_r8*rxt(372)*y(84) + rxt(335)*y(74) + .900_r8*rxt(383) & + *y(96) + rxt(397)*y(106) + .900_r8*rxt(390)*y(100) & + + .900_r8*rxt(393)*y(103) + .920_r8*rxt(359)*y(88) + rxt(340) & + *y(79) + rxt(347)*y(76) + rxt(292)*y(46) + rxt(313)*y(61) & + + rxt(286)*y(55) + rxt(322)*y(67) + 1.206_r8*rxt(365)*y(89) & + + rxt(375)*y(91) + rxt(278)*y(137) + mat(1398) = mat(1398) + .700_r8*rxt(387)*y(98) + mat(1185) = mat(1185) + rxt(199)*y(11) + rxt(202)*y(13) + rxt(329)*y(82) & + + .400_r8*rxt(369)*y(90) + mat(1022) = mat(1022) + rxt(198)*y(2) + 2.000_r8*rxt(197)*y(9) + rxt(199) & + *y(23) + rxt(200)*y(24) + rxt(360)*y(88) + rxt(342)*y(79) & + + rxt(348)*y(76) + rxt(396)*y(105) + 1.206_r8*rxt(366)*y(89) & + + rxt(370)*y(90) + rxt(376)*y(91) + mat(236) = rxt(202)*y(23) + mat(1062) = rxt(270)*y(9) + mat(1339) = mat(1339) + rxt(188)*y(9) + rxt(200)*y(11) + .206_r8*rxt(367) & + *y(89) + mat(902) = mat(902) + rxt(216)*y(9) + mat(827) = mat(827) + rxt(237)*y(9) + mat(476) = rxt(318)*y(9) + mat(811) = mat(811) + rxt(299)*y(9) + mat(160) = rxt(329)*y(23) + mat(138) = rxt(331)*y(9) + mat(390) = .900_r8*rxt(372)*y(9) + mat(363) = rxt(335)*y(9) + mat(311) = .900_r8*rxt(383)*y(9) + mat(85) = mat(85) + .700_r8*rxt(387)*y(10) + mat(578) = rxt(397)*y(9) + mat(173) = .900_r8*rxt(390)*y(9) + mat(222) = .900_r8*rxt(393)*y(9) + mat(722) = .920_r8*rxt(359)*y(9) + rxt(360)*y(11) + mat(743) = rxt(340)*y(9) + rxt(342)*y(11) + mat(783) = mat(783) + rxt(347)*y(9) + rxt(348)*y(11) + mat(509) = rxt(292)*y(9) + mat(326) = rxt(396)*y(11) + mat(531) = rxt(313)*y(9) + mat(419) = rxt(286)*y(9) + mat(636) = rxt(322)*y(9) + mat(465) = 1.206_r8*rxt(365)*y(9) + 1.206_r8*rxt(366)*y(11) & + + .206_r8*rxt(367)*y(24) + mat(565) = .400_r8*rxt(369)*y(23) + rxt(370)*y(11) + mat(695) = rxt(375)*y(9) + rxt(376)*y(11) + mat(191) = rxt(278)*y(9) + mat(1179) = -(rxt(165)*y(2) + rxt(166)*y(1) + rxt(167)*y(24) + (4._r8*rxt(168) & + + 4._r8*rxt(169)) * y(23) + rxt(170)*y(21) + rxt(171)*y(25) & + + rxt(177)*y(42) + rxt(178)*y(43) + rxt(181)*y(8) + rxt(195) & + *y(10) + rxt(196)*y(12) + rxt(199)*y(11) + rxt(202)*y(13) & + + (rxt(212) + rxt(213)) * y(30) + rxt(223)*y(33) + rxt(227) & + *y(34) + rxt(229)*y(35) + rxt(235)*y(38) + rxt(243)*y(39) & + + (rxt(264) + rxt(265)) * y(20) + rxt(267)*y(19) + rxt(274) & + *y(18) + rxt(275)*y(17) + rxt(276)*y(136) + rxt(283)*y(135) & + + rxt(284)*y(45) + rxt(285)*y(44) + rxt(291)*y(49) + rxt(296) & + *y(47) + rxt(297)*y(50) + rxt(304)*y(54) + rxt(305)*y(52) & + + rxt(306)*y(53) + rxt(307)*y(51) + rxt(309)*y(58) + rxt(310) & + *y(59) + rxt(316)*y(62) + rxt(317)*y(60) + rxt(320)*y(65) & + + rxt(321)*y(63) + rxt(325)*y(69) + rxt(326)*y(66) + rxt(327) & + *y(68) + rxt(329)*y(82) + rxt(330)*y(70) + rxt(332)*y(77) & + + rxt(334)*y(72) + rxt(337)*y(75) + rxt(338)*y(78) + rxt(346) & + *y(80) + rxt(355)*y(81) + rxt(356)*y(83) + rxt(362)*y(93) & + + rxt(368)*y(71) + rxt(369)*y(90) + rxt(371)*y(87) + rxt(374) & + *y(85) + rxt(380)*y(92) + rxt(382)*y(94) + rxt(385)*y(97) & + + rxt(386)*y(95) + rxt(388)*y(99) + rxt(391)*y(102) + rxt(394) & + *y(105) + rxt(399)*y(107) + rxt(404)*y(156) + (rxt(405) + rxt(406) & + ) * y(157) + rxt(408)*y(159)) + mat(1463) = -rxt(165)*y(23) + mat(1222) = -rxt(166)*y(23) + mat(1333) = -rxt(167)*y(23) + mat(663) = -rxt(170)*y(23) + mat(341) = -rxt(171)*y(23) + mat(91) = -rxt(177)*y(23) + mat(49) = -rxt(178)*y(23) + mat(493) = -rxt(181)*y(23) + mat(1392) = -rxt(195)*y(23) + mat(874) = -rxt(196)*y(23) + mat(1016) = -rxt(199)*y(23) + mat(234) = -rxt(202)*y(23) + mat(896) = -(rxt(212) + rxt(213)) * y(23) + mat(1080) = -rxt(223)*y(23) + mat(515) = -rxt(227)*y(23) + mat(587) = -rxt(229)*y(23) + mat(825) = -rxt(235)*y(23) + mat(480) = -rxt(243)*y(23) + mat(610) = -(rxt(264) + rxt(265)) * y(23) + mat(1243) = -rxt(267)*y(23) + mat(268) = -rxt(274)*y(23) + mat(195) = -rxt(275)*y(23) + mat(265) = -rxt(276)*y(23) + mat(124) = -rxt(283)*y(23) + mat(118) = -rxt(284)*y(23) + mat(259) = -rxt(285)*y(23) + mat(330) = -rxt(291)*y(23) + mat(152) = -rxt(296)*y(23) + mat(620) = -rxt(297)*y(23) + mat(248) = -rxt(304)*y(23) + mat(554) = -rxt(305)*y(23) + mat(399) = -rxt(306)*y(23) + mat(108) = -rxt(307)*y(23) + mat(241) = -rxt(309)*y(23) + mat(604) = -rxt(310)*y(23) + mat(178) = -rxt(316)*y(23) + mat(54) = -rxt(317)*y(23) + mat(292) = -rxt(320)*y(23) + mat(396) = -rxt(321)*y(23) + mat(184) = -rxt(325)*y(23) + mat(640) = -rxt(326)*y(23) + mat(674) = -rxt(327)*y(23) + mat(159) = -rxt(329)*y(23) + mat(38) = -rxt(330)*y(23) + mat(759) = -rxt(332)*y(23) + mat(202) = -rxt(334)*y(23) + mat(143) = -rxt(337)*y(23) + mat(650) = -rxt(338)*y(23) + mat(147) = -rxt(346)*y(23) + mat(283) = -rxt(355)*y(23) + mat(546) = -rxt(356)*y(23) + mat(300) = -rxt(362)*y(23) + mat(35) = -rxt(368)*y(23) + mat(562) = -rxt(369)*y(23) + mat(156) = -rxt(371)*y(23) + mat(353) = -rxt(374)*y(23) + mat(113) = -rxt(380)*y(23) + mat(64) = -rxt(382)*y(23) + mat(166) = -rxt(385)*y(23) + mat(68) = -rxt(386)*y(23) + mat(41) = -rxt(388)*y(23) + mat(44) = -rxt(391)*y(23) + mat(323) = -rxt(394)*y(23) + mat(213) = -rxt(399)*y(23) + mat(57) = -rxt(404)*y(23) + mat(101) = -(rxt(405) + rxt(406)) * y(23) + mat(47) = -rxt(408)*y(23) + mat(1222) = mat(1222) + rxt(161)*y(22) + rxt(174)*y(24) + .330_r8*rxt(311) & + *y(59) + .270_r8*rxt(357)*y(83) + .120_r8*rxt(290)*y(44) & + + .080_r8*rxt(333)*y(77) + .215_r8*rxt(339)*y(78) & + + .700_r8*rxt(395)*y(105) + mat(1463) = mat(1463) + rxt(172)*y(21) + rxt(268)*y(19) + rxt(173)*y(24) & + + rxt(176)*y(25) + rxt(224)*y(33) + rxt(225)*y(34) + rxt(244) & + *y(39) + rxt(245)*y(40) + mat(1357) = rxt(156)*y(21) + rxt(159)*y(42) + 2.000_r8*rxt(131)*y(134) & + + rxt(157)*y(33) + rxt(158)*y(39) + mat(663) = mat(663) + rxt(172)*y(2) + rxt(156)*y(3) + mat(975) = rxt(188)*y(24) + mat(1179) = mat(1179) + .300_r8*rxt(275)*y(17) + .500_r8*rxt(320)*y(65) & + + .100_r8*rxt(346)*y(80) + .500_r8*rxt(296)*y(47) & + + .650_r8*rxt(283)*y(135) + mat(1016) = mat(1016) + rxt(200)*y(24) + mat(195) = mat(195) + .300_r8*rxt(275)*y(23) + mat(91) = mat(91) + rxt(159)*y(3) + mat(1243) = mat(1243) + rxt(268)*y(2) + mat(1260) = rxt(161)*y(1) + 2.000_r8*rxt(162)*y(24) + mat(1333) = mat(1333) + rxt(174)*y(1) + rxt(173)*y(2) + rxt(188)*y(9) & + + rxt(200)*y(11) + 2.000_r8*rxt(162)*y(22) + rxt(208)*y(28) & + + .206_r8*rxt(367)*y(89) + mat(341) = mat(341) + rxt(176)*y(2) + mat(861) = 2.000_r8*rxt(131)*y(3) + rxt(247)*y(141) + mat(1426) = rxt(208)*y(24) + mat(1080) = mat(1080) + rxt(224)*y(2) + rxt(157)*y(3) + mat(515) = mat(515) + rxt(225)*y(2) + mat(480) = mat(480) + rxt(244)*y(2) + rxt(158)*y(3) + mat(407) = rxt(245)*y(2) + mat(604) = mat(604) + .330_r8*rxt(311)*y(1) + mat(546) = mat(546) + .270_r8*rxt(357)*y(1) + mat(292) = mat(292) + .500_r8*rxt(320)*y(23) + mat(259) = mat(259) + .120_r8*rxt(290)*y(1) + mat(759) = mat(759) + .080_r8*rxt(333)*y(1) + mat(650) = mat(650) + .215_r8*rxt(339)*y(1) + mat(147) = mat(147) + .100_r8*rxt(346)*y(23) + mat(152) = mat(152) + .500_r8*rxt(296)*y(23) + mat(323) = mat(323) + .700_r8*rxt(395)*y(1) + mat(462) = .206_r8*rxt(367)*y(24) + mat(124) = mat(124) + .650_r8*rxt(283)*y(23) + mat(454) = rxt(247)*y(134) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1013) = -(rxt(193)*y(10) + rxt(197)*y(9) + rxt(198)*y(2) + rxt(199)*y(23) & + + rxt(200)*y(24) + rxt(266)*y(19) + rxt(298)*y(50) + rxt(312) & + *y(59) + rxt(328)*y(68) + rxt(342)*y(79) + rxt(348)*y(76) & + + rxt(358)*y(83) + rxt(360)*y(88) + rxt(366)*y(89) + rxt(370) & + *y(90) + rxt(376)*y(91) + rxt(396)*y(105) + rxt(407)*y(157)) + mat(1389) = -rxt(193)*y(11) + mat(972) = -rxt(197)*y(11) + mat(1460) = -rxt(198)*y(11) + mat(1176) = -rxt(199)*y(11) + mat(1330) = -rxt(200)*y(11) + mat(1240) = -rxt(266)*y(11) + mat(618) = -rxt(298)*y(11) + mat(602) = -rxt(312)*y(11) + mat(673) = -rxt(328)*y(11) + mat(737) = -rxt(342)*y(11) + mat(776) = -rxt(348)*y(11) + mat(544) = -rxt(358)*y(11) + mat(715) = -rxt(360)*y(11) + mat(461) = -rxt(366)*y(11) + mat(561) = -rxt(370)*y(11) + mat(689) = -rxt(376)*y(11) + mat(322) = -rxt(396)*y(11) + mat(100) = -rxt(407)*y(11) + mat(1219) = rxt(192)*y(10) + mat(1460) = mat(1460) + rxt(191)*y(10) + rxt(228)*y(35) + rxt(246)*y(41) + mat(1389) = mat(1389) + rxt(192)*y(1) + rxt(191)*y(2) + mat(1176) = mat(1176) + rxt(196)*y(12) + rxt(229)*y(35) + rxt(309)*y(58) & + + .500_r8*rxt(355)*y(81) + mat(871) = rxt(196)*y(23) + rxt(250)*y(141) + mat(1423) = rxt(230)*y(35) + mat(585) = rxt(228)*y(2) + rxt(229)*y(23) + rxt(230)*y(28) + mat(276) = rxt(246)*y(2) + mat(239) = rxt(309)*y(23) + mat(282) = .500_r8*rxt(355)*y(23) + mat(452) = rxt(250)*y(12) + mat(870) = -(rxt(196)*y(23) + rxt(250)*y(141)) + mat(1172) = -rxt(196)*y(12) + mat(451) = -rxt(250)*y(12) + mat(1385) = rxt(195)*y(23) + mat(1172) = mat(1172) + rxt(195)*y(10) + mat(1011) = rxt(266)*y(19) + rxt(298)*y(50) + rxt(328)*y(68) + rxt(407) & + *y(157) + mat(1237) = rxt(266)*y(11) + mat(1073) = (rxt(435)+rxt(440)+rxt(446))*y(35) + mat(583) = (rxt(435)+rxt(440)+rxt(446))*y(33) + mat(617) = rxt(298)*y(11) + mat(672) = rxt(328)*y(11) + mat(99) = rxt(407)*y(11) + mat(230) = -(rxt(202)*y(23)) + mat(1123) = -rxt(202)*y(13) + mat(1368) = rxt(201)*y(24) + mat(1285) = rxt(201)*y(10) + mat(1367) = rxt(193)*y(11) + mat(986) = rxt(193)*y(10) + mat(1054) = -(rxt(215)*y(30) + rxt(270)*y(9) + rxt(271)*y(24) + (4._r8*rxt(272) & + + 4._r8*rxt(273)) * y(16) + rxt(294)*y(46) + rxt(302)*y(48) & + + rxt(315)*y(61) + rxt(324)*y(67) + rxt(344)*y(79) + rxt(350) & + *y(76) + rxt(363)*y(88) + rxt(378)*y(91)) + mat(894) = -rxt(215)*y(16) + mat(973) = -rxt(270)*y(16) + mat(1331) = -rxt(271)*y(16) + mat(505) = -rxt(294)*y(16) + mat(805) = -rxt(302)*y(16) + mat(527) = -rxt(315)*y(16) + mat(632) = -rxt(324)*y(16) + mat(738) = -rxt(344)*y(16) + mat(777) = -rxt(350)*y(16) + mat(716) = -rxt(363)*y(16) + mat(690) = -rxt(378)*y(16) + mat(1220) = .310_r8*rxt(311)*y(59) + mat(973) = mat(973) + rxt(299)*y(48) + mat(1177) = .700_r8*rxt(275)*y(17) + rxt(291)*y(49) + mat(1054) = mat(1054) + .900_r8*rxt(302)*y(48) + mat(194) = .700_r8*rxt(275)*y(23) + mat(603) = .310_r8*rxt(311)*y(1) + mat(329) = rxt(291)*y(23) + mat(805) = mat(805) + rxt(299)*y(9) + .900_r8*rxt(302)*y(16) & + + 4.000_r8*rxt(303)*y(48) + rxt(364)*y(88) + rxt(345)*y(79) & + + rxt(351)*y(76) + rxt(379)*y(91) + mat(716) = mat(716) + rxt(364)*y(48) + mat(738) = mat(738) + rxt(345)*y(48) + mat(777) = mat(777) + rxt(351)*y(48) + mat(690) = mat(690) + rxt(379)*y(48) + mat(192) = -(rxt(275)*y(23)) + mat(1119) = -rxt(275)*y(17) + mat(1027) = rxt(271)*y(24) + mat(1281) = rxt(271)*y(16) + mat(90) = -(rxt(159)*y(3) + rxt(177)*y(23)) + mat(1345) = -rxt(159)*y(42) + mat(1103) = -rxt(177)*y(42) + mat(48) = -(rxt(178)*y(23)) + mat(1095) = -rxt(178)*y(43) + mat(1245) = -(rxt(209)*y(28) + rxt(233)*y(37) + rxt(266)*y(11) + rxt(267) & + *y(23) + rxt(268)*y(2) + rxt(269)*y(24)) + mat(1428) = -rxt(209)*y(19) + mat(919) = -rxt(233)*y(19) + mat(1018) = -rxt(266)*y(19) + mat(1181) = -rxt(267)*y(19) + mat(1465) = -rxt(268)*y(19) + mat(1335) = -rxt(269)*y(19) + mat(1224) = .540_r8*rxt(311)*y(59) + .600_r8*rxt(357)*y(83) + rxt(290)*y(44) & + + .800_r8*rxt(333)*y(77) + .700_r8*rxt(339)*y(78) + mat(977) = rxt(270)*y(16) + rxt(318)*y(64) + .500_r8*rxt(331)*y(73) & + + .100_r8*rxt(372)*y(84) + .550_r8*rxt(359)*y(88) & + + .250_r8*rxt(340)*y(79) + rxt(347)*y(76) + .500_r8*rxt(286) & + *y(55) + rxt(322)*y(67) + .072_r8*rxt(365)*y(89) & + + .250_r8*rxt(375)*y(91) + mat(1181) = mat(1181) + .300_r8*rxt(275)*y(17) + .500_r8*rxt(304)*y(54) & + + rxt(309)*y(58) + .500_r8*rxt(355)*y(81) + rxt(274)*y(18) & + + .800_r8*rxt(305)*y(52) + mat(1018) = mat(1018) + .600_r8*rxt(360)*y(88) + .250_r8*rxt(342)*y(79) & + + rxt(348)*y(76) + .072_r8*rxt(366)*y(89) + mat(1058) = rxt(270)*y(9) + (4.000_r8*rxt(272)+2.000_r8*rxt(273))*y(16) & + + rxt(215)*y(30) + rxt(302)*y(48) + 1.200_r8*rxt(363)*y(88) & + + .880_r8*rxt(344)*y(79) + 2.000_r8*rxt(350)*y(76) & + + .700_r8*rxt(294)*y(46) + rxt(315)*y(61) + .800_r8*rxt(324) & + *y(67) + .800_r8*rxt(378)*y(91) + mat(196) = .300_r8*rxt(275)*y(23) + mat(1335) = mat(1335) + .206_r8*rxt(367)*y(89) + mat(898) = rxt(215)*y(16) + mat(606) = .540_r8*rxt(311)*y(1) + mat(548) = .600_r8*rxt(357)*y(1) + mat(474) = rxt(318)*y(9) + mat(808) = rxt(302)*y(16) + .600_r8*rxt(364)*y(88) + .250_r8*rxt(345)*y(79) & + + rxt(351)*y(76) + .250_r8*rxt(379)*y(91) + mat(249) = .500_r8*rxt(304)*y(23) + mat(242) = rxt(309)*y(23) + mat(261) = rxt(290)*y(1) + mat(284) = .500_r8*rxt(355)*y(23) + mat(136) = .500_r8*rxt(331)*y(9) + mat(388) = .100_r8*rxt(372)*y(9) + mat(719) = .550_r8*rxt(359)*y(9) + .600_r8*rxt(360)*y(11) + 1.200_r8*rxt(363) & + *y(16) + .600_r8*rxt(364)*y(48) + mat(761) = .800_r8*rxt(333)*y(1) + mat(652) = .700_r8*rxt(339)*y(1) + mat(740) = .250_r8*rxt(340)*y(9) + .250_r8*rxt(342)*y(11) + .880_r8*rxt(344) & + *y(16) + .250_r8*rxt(345)*y(48) + mat(780) = rxt(347)*y(9) + rxt(348)*y(11) + 2.000_r8*rxt(350)*y(16) & + + rxt(351)*y(48) + 4.000_r8*rxt(352)*y(76) + mat(507) = .700_r8*rxt(294)*y(16) + mat(529) = rxt(315)*y(16) + mat(269) = rxt(274)*y(23) + mat(555) = .800_r8*rxt(305)*y(23) + mat(417) = .500_r8*rxt(286)*y(9) + mat(634) = rxt(322)*y(9) + .800_r8*rxt(324)*y(16) + mat(463) = .072_r8*rxt(365)*y(9) + .072_r8*rxt(366)*y(11) + .206_r8*rxt(367) & + *y(24) + mat(692) = .250_r8*rxt(375)*y(9) + .800_r8*rxt(378)*y(16) + .250_r8*rxt(379) & + *y(48) + mat(1263) = -(rxt(160)*y(4) + rxt(161)*y(1) + (rxt(162) + rxt(163) + rxt(164) & + ) * y(24)) + mat(848) = -rxt(160)*y(22) + mat(1225) = -rxt(161)*y(22) + mat(1336) = -(rxt(162) + rxt(163) + rxt(164)) * y(22) + mat(1466) = rxt(172)*y(21) + rxt(165)*y(23) + mat(1360) = rxt(156)*y(21) + mat(664) = rxt(172)*y(2) + rxt(156)*y(3) + rxt(170)*y(23) + rxt(205)*y(28) & + + rxt(248)*y(141) + mat(611) = rxt(264)*y(23) + mat(494) = rxt(181)*y(23) + mat(1182) = rxt(165)*y(2) + rxt(170)*y(21) + rxt(264)*y(20) + rxt(181)*y(8) & + + rxt(267)*y(19) + mat(1246) = rxt(267)*y(23) + mat(1429) = rxt(205)*y(21) + mat(455) = rxt(248)*y(21) + mat(1337) = -((rxt(162) + rxt(163) + rxt(164)) * y(22) + rxt(167)*y(23) & + + rxt(173)*y(2) + rxt(174)*y(1) + 4._r8*rxt(175)*y(24) + rxt(188) & + *y(9) + rxt(200)*y(11) + rxt(201)*y(10) + (rxt(207) + rxt(208) & + ) * y(28) + rxt(214)*y(30) + rxt(232)*y(37) + rxt(236)*y(38) & + + rxt(269)*y(19) + rxt(271)*y(16) + rxt(279)*y(137) + rxt(287) & + *y(55) + rxt(293)*y(46) + rxt(301)*y(48) + rxt(314)*y(61) & + + rxt(319)*y(64) + rxt(323)*y(67) + rxt(336)*y(74) + rxt(343) & + *y(79) + rxt(349)*y(76) + rxt(361)*y(88) + rxt(367)*y(89) & + + rxt(373)*y(84) + rxt(377)*y(91) + rxt(384)*y(96) + rxt(389) & + *y(100) + rxt(392)*y(103) + rxt(398)*y(106)) + mat(1264) = -(rxt(162) + rxt(163) + rxt(164)) * y(24) + mat(1183) = -rxt(167)*y(24) + mat(1467) = -rxt(173)*y(24) + mat(1226) = -rxt(174)*y(24) + mat(979) = -rxt(188)*y(24) + mat(1020) = -rxt(200)*y(24) + mat(1396) = -rxt(201)*y(24) + mat(1430) = -(rxt(207) + rxt(208)) * y(24) + mat(900) = -rxt(214)*y(24) + mat(921) = -rxt(232)*y(24) + mat(826) = -rxt(236)*y(24) + mat(1247) = -rxt(269)*y(24) + mat(1060) = -rxt(271)*y(24) + mat(190) = -rxt(279)*y(24) + mat(418) = -rxt(287)*y(24) + mat(508) = -rxt(293)*y(24) + mat(810) = -rxt(301)*y(24) + mat(530) = -rxt(314)*y(24) + mat(475) = -rxt(319)*y(24) + mat(635) = -rxt(323)*y(24) + mat(362) = -rxt(336)*y(24) + mat(742) = -rxt(343)*y(24) + mat(782) = -rxt(349)*y(24) + mat(721) = -rxt(361)*y(24) + mat(464) = -rxt(367)*y(24) + mat(389) = -rxt(373)*y(24) + mat(694) = -rxt(377)*y(24) + mat(310) = -rxt(384)*y(24) + mat(172) = -rxt(389)*y(24) + mat(221) = -rxt(392)*y(24) + mat(577) = -rxt(398)*y(24) + mat(1226) = mat(1226) + rxt(166)*y(23) + .190_r8*rxt(311)*y(59) & + + .060_r8*rxt(357)*y(83) + .120_r8*rxt(290)*y(44) & + + .060_r8*rxt(333)*y(77) + .275_r8*rxt(339)*y(78) + rxt(395) & + *y(105) + mat(1467) = mat(1467) + rxt(268)*y(19) + rxt(176)*y(25) + mat(849) = rxt(160)*y(22) + rxt(288)*y(56) + mat(612) = rxt(265)*y(23) + mat(979) = mat(979) + rxt(270)*y(16) + rxt(318)*y(64) + rxt(331)*y(73) & + + .900_r8*rxt(372)*y(84) + .900_r8*rxt(383)*y(96) + rxt(397) & + *y(106) + .900_r8*rxt(390)*y(100) + .900_r8*rxt(393)*y(103) & + + .920_r8*rxt(359)*y(88) + .470_r8*rxt(340)*y(79) + rxt(292) & + *y(46) + rxt(313)*y(61) + .250_r8*rxt(286)*y(55) & + + .794_r8*rxt(365)*y(89) + rxt(375)*y(91) + rxt(278)*y(137) + mat(1396) = mat(1396) + .700_r8*rxt(387)*y(98) + mat(1183) = mat(1183) + rxt(166)*y(1) + rxt(265)*y(20) + rxt(199)*y(11) & + + rxt(177)*y(42) + rxt(178)*y(43) + rxt(171)*y(25) + rxt(212) & + *y(30) + rxt(235)*y(38) + .500_r8*rxt(355)*y(81) & + + .250_r8*rxt(382)*y(94) + rxt(306)*y(53) + .200_r8*rxt(346) & + *y(80) + rxt(274)*y(18) + rxt(307)*y(51) + rxt(305)*y(52) & + + rxt(326)*y(66) + rxt(369)*y(90) + .350_r8*rxt(283)*y(135) & + + rxt(276)*y(136) + .500_r8*rxt(406)*y(157) + mat(1020) = mat(1020) + rxt(199)*y(23) + rxt(266)*y(19) + rxt(360)*y(88) & + + .470_r8*rxt(342)*y(79) + .794_r8*rxt(366)*y(89) + rxt(370) & + *y(90) + rxt(376)*y(91) + mat(1060) = mat(1060) + rxt(270)*y(9) + 4.000_r8*rxt(272)*y(16) + rxt(215) & + *y(30) + .900_r8*rxt(302)*y(48) + rxt(363)*y(88) & + + .730_r8*rxt(344)*y(79) + rxt(350)*y(76) + rxt(294)*y(46) & + + rxt(315)*y(61) + .300_r8*rxt(324)*y(67) + .800_r8*rxt(378) & + *y(91) + mat(92) = rxt(177)*y(23) + mat(50) = rxt(178)*y(23) + mat(1247) = mat(1247) + rxt(268)*y(2) + rxt(266)*y(11) + rxt(209)*y(28) & + + rxt(233)*y(37) + mat(1264) = mat(1264) + rxt(160)*y(4) + mat(342) = rxt(176)*y(2) + rxt(171)*y(23) + rxt(206)*y(28) + mat(1430) = mat(1430) + rxt(209)*y(19) + rxt(206)*y(25) + mat(900) = mat(900) + rxt(212)*y(23) + rxt(215)*y(16) + mat(921) = mat(921) + rxt(233)*y(19) + mat(826) = mat(826) + rxt(235)*y(23) + mat(607) = .190_r8*rxt(311)*y(1) + mat(549) = .060_r8*rxt(357)*y(1) + mat(475) = mat(475) + rxt(318)*y(9) + mat(810) = mat(810) + .900_r8*rxt(302)*y(16) + rxt(364)*y(88) & + + .470_r8*rxt(345)*y(79) + rxt(379)*y(91) + mat(262) = .120_r8*rxt(290)*y(1) + mat(285) = .500_r8*rxt(355)*y(23) + mat(137) = rxt(331)*y(9) + mat(389) = mat(389) + .900_r8*rxt(372)*y(9) + mat(65) = .250_r8*rxt(382)*y(23) + mat(310) = mat(310) + .900_r8*rxt(383)*y(9) + mat(84) = .700_r8*rxt(387)*y(10) + mat(577) = mat(577) + rxt(397)*y(9) + mat(400) = rxt(306)*y(23) + mat(172) = mat(172) + .900_r8*rxt(390)*y(9) + mat(221) = mat(221) + .900_r8*rxt(393)*y(9) + mat(721) = mat(721) + .920_r8*rxt(359)*y(9) + rxt(360)*y(11) + rxt(363)*y(16) & + + rxt(364)*y(48) + mat(763) = .060_r8*rxt(333)*y(1) + mat(654) = .275_r8*rxt(339)*y(1) + mat(742) = mat(742) + .470_r8*rxt(340)*y(9) + .470_r8*rxt(342)*y(11) & + + .730_r8*rxt(344)*y(16) + .470_r8*rxt(345)*y(48) + mat(148) = .200_r8*rxt(346)*y(23) + mat(782) = mat(782) + rxt(350)*y(16) + mat(508) = mat(508) + rxt(292)*y(9) + rxt(294)*y(16) + 2.400_r8*rxt(295) & + *y(46) + mat(325) = rxt(395)*y(1) + mat(530) = mat(530) + rxt(313)*y(9) + rxt(315)*y(16) + mat(270) = rxt(274)*y(23) + mat(109) = rxt(307)*y(23) + mat(556) = rxt(305)*y(23) + mat(642) = rxt(326)*y(23) + mat(418) = mat(418) + .250_r8*rxt(286)*y(9) + mat(207) = rxt(288)*y(4) + mat(635) = mat(635) + .300_r8*rxt(324)*y(16) + mat(464) = mat(464) + .794_r8*rxt(365)*y(9) + .794_r8*rxt(366)*y(11) + mat(564) = rxt(369)*y(23) + rxt(370)*y(11) + mat(694) = mat(694) + rxt(375)*y(9) + rxt(376)*y(11) + .800_r8*rxt(378)*y(16) & + + rxt(379)*y(48) + mat(125) = .350_r8*rxt(283)*y(23) + mat(266) = rxt(276)*y(23) + mat(190) = mat(190) + rxt(278)*y(9) + mat(102) = .500_r8*rxt(406)*y(23) + end subroutine nlnmat03 + subroutine nlnmat04( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(338) = -(rxt(171)*y(23) + rxt(176)*y(2) + rxt(206)*y(28)) + mat(1136) = -rxt(171)*y(25) + mat(1441) = -rxt(176)*y(25) + mat(1406) = -rxt(206)*y(25) + mat(1136) = mat(1136) + 2.000_r8*rxt(169)*y(23) + mat(1293) = 2.000_r8*rxt(175)*y(24) + mat(856) = -(rxt(131)*y(3) + rxt(247)*y(141)) + mat(1350) = -rxt(131)*y(134) + mat(450) = -rxt(247)*y(134) + mat(658) = rxt(170)*y(23) + mat(1171) = rxt(170)*y(21) + 2.000_r8*rxt(168)*y(23) + rxt(196)*y(12) & + + rxt(202)*y(13) + rxt(275)*y(17) + rxt(267)*y(19) + rxt(167) & + *y(24) + rxt(171)*y(25) + rxt(223)*y(33) + rxt(227)*y(34) & + + rxt(243)*y(39) + rxt(297)*y(50) + rxt(291)*y(49) + rxt(320) & + *y(65) + rxt(304)*y(54) + rxt(284)*y(45) + .500_r8*rxt(338) & + *y(78) + rxt(317)*y(60) + rxt(316)*y(62) + rxt(321)*y(63) & + + rxt(325)*y(69) + rxt(327)*y(68) + (rxt(380)+rxt(381))*y(92) & + + rxt(276)*y(136) + rxt(408)*y(159) + mat(869) = rxt(196)*y(23) + mat(232) = rxt(202)*y(23) + mat(193) = rxt(275)*y(23) + mat(1236) = rxt(267)*y(23) + mat(1254) = rxt(164)*y(24) + mat(1325) = rxt(167)*y(23) + rxt(164)*y(22) + mat(339) = rxt(171)*y(23) + mat(1072) = rxt(223)*y(23) + (rxt(436)+rxt(441)+rxt(447))*y(34) + (rxt(437) & + +rxt(448))*y(40) + mat(512) = rxt(227)*y(23) + (rxt(436)+rxt(441)+rxt(447))*y(33) + mat(478) = rxt(243)*y(23) + mat(404) = (rxt(437)+rxt(448))*y(33) + mat(616) = rxt(297)*y(23) + mat(328) = rxt(291)*y(23) + mat(291) = rxt(320)*y(23) + mat(246) = rxt(304)*y(23) + mat(116) = rxt(284)*y(23) + mat(649) = .500_r8*rxt(338)*y(23) + mat(53) = rxt(317)*y(23) + mat(177) = rxt(316)*y(23) + mat(394) = rxt(321)*y(23) + mat(183) = rxt(325)*y(23) + mat(671) = rxt(327)*y(23) + mat(112) = (rxt(380)+rxt(381))*y(23) + mat(264) = rxt(276)*y(23) + mat(46) = rxt(408)*y(23) + mat(1433) = -(rxt(204)*y(1) + rxt(205)*y(21) + rxt(206)*y(25) + (rxt(207) & + + rxt(208)) * y(24) + rxt(209)*y(19) + rxt(226)*y(34) + rxt(230) & + *y(35) + rxt(282)*y(45)) + mat(1229) = -rxt(204)*y(28) + mat(666) = -rxt(205)*y(28) + mat(343) = -rxt(206)*y(28) + mat(1340) = -(rxt(207) + rxt(208)) * y(28) + mat(1250) = -rxt(209)*y(28) + mat(516) = -rxt(226)*y(28) + mat(589) = -rxt(230)*y(28) + mat(119) = -rxt(282)*y(28) + mat(1470) = rxt(211)*y(30) + rxt(224)*y(33) + mat(1364) = rxt(157)*y(33) + rxt(152)*y(139) + mat(982) = rxt(216)*y(30) + mat(1186) = rxt(212)*y(30) + rxt(223)*y(33) + mat(1063) = rxt(215)*y(30) + mat(903) = rxt(211)*y(2) + rxt(216)*y(9) + rxt(212)*y(23) + rxt(215)*y(16) + ( & + + 4.000_r8*rxt(218)+2.000_r8*rxt(220))*y(30) + rxt(240)*y(38) + mat(1087) = rxt(224)*y(2) + rxt(157)*y(3) + rxt(223)*y(23) + mat(828) = rxt(240)*y(30) + mat(89) = rxt(152)*y(3) + mat(1401) = rxt(230)*y(35) + mat(882) = 2.000_r8*rxt(219)*y(30) + mat(1065) = (rxt(436)+rxt(441)+rxt(447))*y(34) + (rxt(435)+rxt(440)+rxt(446)) & + *y(35) + mat(510) = (rxt(436)+rxt(441)+rxt(447))*y(33) + mat(579) = rxt(230)*y(28) + (rxt(435)+rxt(440)+rxt(446))*y(33) + mat(890) = -(rxt(211)*y(2) + (rxt(212) + rxt(213)) * y(23) + rxt(214)*y(24) & + + rxt(215)*y(16) + rxt(216)*y(9) + rxt(217)*y(10) + (4._r8*rxt(218) & + + 4._r8*rxt(219) + 4._r8*rxt(220) + 4._r8*rxt(221)) * y(30) & + + (rxt(239) + rxt(240) + rxt(241)) * y(38)) + mat(1457) = -rxt(211)*y(30) + mat(1173) = -(rxt(212) + rxt(213)) * y(30) + mat(1327) = -rxt(214)*y(30) + mat(1050) = -rxt(215)*y(30) + mat(969) = -rxt(216)*y(30) + mat(1386) = -rxt(217)*y(30) + mat(820) = -(rxt(239) + rxt(240) + rxt(241)) * y(30) + mat(1216) = rxt(204)*y(28) + mat(1457) = mat(1457) + rxt(225)*y(34) + rxt(228)*y(35) + mat(1173) = mat(1173) + rxt(227)*y(34) + mat(1327) = mat(1327) + rxt(208)*y(28) + mat(1420) = rxt(204)*y(1) + rxt(208)*y(24) + rxt(226)*y(34) + mat(513) = rxt(225)*y(2) + rxt(227)*y(23) + rxt(226)*y(28) + mat(584) = rxt(228)*y(2) + mat(881) = 2.000_r8*rxt(220)*y(30) + rxt(239)*y(38) + mat(812) = rxt(239)*y(30) + mat(880) = 2.000_r8*rxt(221)*y(30) + mat(1079) = -(rxt(157)*y(3) + rxt(223)*y(23) + rxt(224)*y(2) + (rxt(435) & + + rxt(440) + rxt(446)) * y(35) + (rxt(436) + rxt(441) + rxt(447) & + ) * y(34) + (rxt(437) + rxt(448)) * y(40)) + mat(1356) = -rxt(157)*y(33) + mat(1178) = -rxt(223)*y(33) + mat(1462) = -rxt(224)*y(33) + mat(586) = -(rxt(435) + rxt(440) + rxt(446)) * y(33) + mat(514) = -(rxt(436) + rxt(441) + rxt(447)) * y(33) + mat(406) = -(rxt(437) + rxt(448)) * y(33) + mat(662) = rxt(205)*y(28) + mat(1178) = mat(1178) + rxt(213)*y(30) + mat(1242) = rxt(209)*y(28) + mat(1332) = rxt(207)*y(28) + mat(340) = rxt(206)*y(28) + mat(1425) = rxt(205)*y(21) + rxt(209)*y(19) + rxt(207)*y(24) + rxt(206)*y(25) & + + rxt(226)*y(34) + rxt(282)*y(45) + mat(895) = rxt(213)*y(23) + mat(514) = mat(514) + rxt(226)*y(28) + mat(117) = rxt(282)*y(28) + mat(511) = -(rxt(225)*y(2) + rxt(226)*y(28) + rxt(227)*y(23) + (rxt(436) & + + rxt(441) + rxt(447)) * y(33)) + mat(1449) = -rxt(225)*y(34) + mat(1410) = -rxt(226)*y(34) + mat(1148) = -rxt(227)*y(34) + mat(1068) = -(rxt(436) + rxt(441) + rxt(447)) * y(34) + mat(1148) = mat(1148) + rxt(229)*y(35) + mat(1305) = rxt(214)*y(30) + mat(884) = rxt(214)*y(24) + mat(580) = rxt(229)*y(23) + mat(581) = -(rxt(228)*y(2) + rxt(229)*y(23) + rxt(230)*y(28) + (rxt(435) & + + rxt(440) + rxt(446)) * y(33)) + mat(1450) = -rxt(228)*y(35) + mat(1154) = -rxt(229)*y(35) + mat(1412) = -rxt(230)*y(35) + mat(1069) = -(rxt(435) + rxt(440) + rxt(446)) * y(35) + mat(1376) = rxt(217)*y(30) + mat(885) = rxt(217)*y(10) + mat(883) = rxt(241)*y(38) + mat(1066) = (rxt(437)+rxt(448))*y(40) + mat(813) = rxt(241)*y(30) + mat(401) = (rxt(437)+rxt(448))*y(33) + mat(912) = -(rxt(231)*y(1) + rxt(232)*y(24) + rxt(233)*y(19)) + mat(1217) = -rxt(231)*y(37) + mat(1328) = -rxt(232)*y(37) + mat(1238) = -rxt(233)*y(37) + mat(1458) = rxt(234)*y(38) + rxt(244)*y(39) + mat(1352) = rxt(158)*y(39) + mat(970) = rxt(237)*y(38) + mat(1174) = rxt(235)*y(38) + rxt(243)*y(39) + mat(891) = (rxt(239)+rxt(240))*y(38) + mat(821) = rxt(234)*y(2) + rxt(237)*y(9) + rxt(235)*y(23) + (rxt(239) & + +rxt(240))*y(30) + 4.000_r8*rxt(242)*y(38) + mat(479) = rxt(244)*y(2) + rxt(158)*y(3) + rxt(243)*y(23) + mat(816) = -(rxt(234)*y(2) + rxt(235)*y(23) + rxt(236)*y(24) + rxt(237)*y(9) & + + rxt(238)*y(10) + (rxt(239) + rxt(240) + rxt(241)) * y(30) & + + 4._r8*rxt(242)*y(38)) + mat(1453) = -rxt(234)*y(38) + mat(1169) = -rxt(235)*y(38) + mat(1323) = -rxt(236)*y(38) + mat(965) = -rxt(237)*y(38) + mat(1382) = -rxt(238)*y(38) + mat(886) = -(rxt(239) + rxt(240) + rxt(241)) * y(38) + mat(1212) = rxt(231)*y(37) + mat(1453) = mat(1453) + rxt(245)*y(40) + rxt(246)*y(41) + mat(907) = rxt(231)*y(1) + mat(403) = rxt(245)*y(2) + mat(273) = rxt(246)*y(2) + mat(477) = -(rxt(158)*y(3) + rxt(243)*y(23) + rxt(244)*y(2)) + mat(1347) = -rxt(158)*y(39) + mat(1145) = -rxt(243)*y(39) + mat(1447) = -rxt(244)*y(39) + mat(1233) = rxt(233)*y(37) + mat(1303) = rxt(232)*y(37) + mat(905) = rxt(233)*y(19) + rxt(232)*y(24) + mat(402) = -(rxt(245)*y(2) + (rxt(437) + rxt(448)) * y(33)) + mat(1443) = -rxt(245)*y(40) + mat(1067) = -(rxt(437) + rxt(448)) * y(40) + mat(1299) = rxt(236)*y(38) + mat(815) = rxt(236)*y(24) + mat(271) = -(rxt(246)*y(2)) + mat(1439) = -rxt(246)*y(41) + mat(1370) = rxt(238)*y(38) + mat(814) = rxt(238)*y(10) + mat(366) = -((rxt(451) + rxt(452)) * y(2) + rxt(459)*y(4) + rxt(463)*y(132)) + mat(1442) = -(rxt(451) + rxt(452)) * y(127) + mat(836) = -rxt(459)*y(127) + mat(437) = -rxt(463)*y(127) + mat(420) = -(rxt(454)*y(8) + rxt(455)*y(9) + rxt(462)*y(132)) + mat(486) = -rxt(454)*y(128) + mat(942) = -rxt(455)*y(128) + mat(438) = -rxt(462)*y(128) + mat(837) = rxt(459)*y(127) + rxt(456)*y(129) + rxt(449)*y(130) + mat(367) = rxt(459)*y(4) + mat(225) = rxt(456)*y(4) + mat(332) = rxt(449)*y(4) + mat(223) = -((rxt(456) + rxt(457)) * y(4) + rxt(458)*y(2)) + mat(833) = -(rxt(456) + rxt(457)) * y(129) + mat(1437) = -rxt(458)*y(129) + mat(331) = -(rxt(449)*y(4)) + mat(835) = -rxt(449)*y(130) + mat(1440) = rxt(452)*y(127) + rxt(458)*y(129) + mat(365) = rxt(452)*y(2) + mat(224) = rxt(458)*y(2) + mat(429) = -(rxt(461)*y(132)) + mat(439) = -rxt(461)*y(131) + mat(1445) = rxt(451)*y(127) + mat(838) = rxt(457)*y(129) + mat(487) = rxt(454)*y(128) + mat(943) = rxt(455)*y(128) + mat(368) = rxt(451)*y(2) + mat(421) = rxt(454)*y(8) + rxt(455)*y(9) + mat(226) = rxt(457)*y(4) + end subroutine nlnmat04 + subroutine nlnmat05( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(250) = -(rxt(179)*y(4) + rxt(180)*y(2)) + mat(834) = -rxt(179)*y(133) + mat(1438) = -rxt(180)*y(133) + mat(1438) = mat(1438) + rxt(451)*y(127) + mat(364) = rxt(451)*y(2) + .900_r8*rxt(463)*y(132) + mat(428) = .800_r8*rxt(461)*y(132) + mat(436) = .900_r8*rxt(463)*y(127) + .800_r8*rxt(461)*y(131) + mat(440) = -(rxt(461)*y(131) + rxt(462)*y(128) + rxt(463)*y(127)) + mat(430) = -rxt(461)*y(132) + mat(422) = -rxt(462)*y(132) + mat(369) = -rxt(463)*y(132) + mat(594) = -(rxt(310)*y(23) + rxt(311)*y(1) + rxt(312)*y(11)) + mat(1155) = -rxt(310)*y(59) + mat(1199) = -rxt(311)*y(59) + mat(996) = -rxt(312)*y(59) + mat(1199) = mat(1199) + .070_r8*rxt(357)*y(83) + mat(536) = .070_r8*rxt(357)*y(1) + mat(534) = -(rxt(356)*y(23) + rxt(357)*y(1) + rxt(358)*y(11)) + mat(1150) = -rxt(356)*y(83) + mat(1195) = -rxt(357)*y(83) + mat(992) = -rxt(358)*y(83) + mat(467) = -(rxt(318)*y(9) + rxt(319)*y(24)) + mat(946) = -rxt(318)*y(64) + mat(1302) = -rxt(319)*y(64) + mat(1144) = rxt(310)*y(59) + .500_r8*rxt(320)*y(65) + mat(593) = rxt(310)*y(23) + mat(288) = .500_r8*rxt(320)*y(23) + mat(614) = -(rxt(297)*y(23) + rxt(298)*y(11)) + mat(1157) = -rxt(297)*y(50) + mat(998) = -rxt(298)*y(50) + mat(1201) = .500_r8*rxt(311)*y(59) + .040_r8*rxt(333)*y(77) + mat(954) = rxt(318)*y(64) + rxt(331)*y(73) + .400_r8*rxt(372)*y(84) & + + rxt(335)*y(74) + rxt(292)*y(46) + .270_r8*rxt(313)*y(61) + mat(1157) = mat(1157) + .500_r8*rxt(296)*y(47) + rxt(307)*y(51) + mat(1036) = .800_r8*rxt(294)*y(46) + mat(596) = .500_r8*rxt(311)*y(1) + mat(468) = rxt(318)*y(9) + mat(134) = rxt(331)*y(9) + mat(383) = .400_r8*rxt(372)*y(9) + mat(358) = rxt(335)*y(9) + mat(746) = .040_r8*rxt(333)*y(1) + mat(502) = rxt(292)*y(9) + .800_r8*rxt(294)*y(16) + 3.200_r8*rxt(295)*y(46) + mat(151) = .500_r8*rxt(296)*y(23) + mat(521) = .270_r8*rxt(313)*y(9) + mat(107) = rxt(307)*y(23) + mat(327) = -(rxt(291)*y(23)) + mat(1135) = -rxt(291)*y(49) + mat(1193) = .250_r8*rxt(311)*y(59) + .200_r8*rxt(357)*y(83) + mat(1029) = .100_r8*rxt(302)*y(48) + mat(1292) = .250_r8*rxt(301)*y(48) + .250_r8*rxt(349)*y(76) + mat(592) = .250_r8*rxt(311)*y(1) + mat(532) = .200_r8*rxt(357)*y(1) + mat(787) = .100_r8*rxt(302)*y(16) + .250_r8*rxt(301)*y(24) + mat(767) = .250_r8*rxt(349)*y(24) + mat(287) = -(rxt(320)*y(23)) + mat(1130) = -rxt(320)*y(65) + mat(1288) = rxt(319)*y(64) + mat(466) = rxt(319)*y(24) + mat(799) = -(rxt(299)*y(9) + rxt(300)*y(10) + rxt(301)*y(24) + rxt(302)*y(16) & + + 4._r8*rxt(303)*y(48) + rxt(345)*y(79) + rxt(364)*y(88) + rxt(379) & + *y(91)) + mat(964) = -rxt(299)*y(48) + mat(1381) = -rxt(300)*y(48) + mat(1322) = -rxt(301)*y(48) + mat(1046) = -rxt(302)*y(48) + mat(733) = -rxt(345)*y(48) + mat(711) = -rxt(364)*y(48) + mat(685) = -rxt(379)*y(48) + mat(964) = mat(964) + rxt(335)*y(74) + .530_r8*rxt(340)*y(79) + rxt(347) & + *y(76) + rxt(322)*y(67) + mat(1168) = rxt(297)*y(50) + .500_r8*rxt(304)*y(54) + rxt(327)*y(68) + mat(1008) = rxt(298)*y(50) + .530_r8*rxt(342)*y(79) + rxt(348)*y(76) & + + rxt(328)*y(68) + mat(1046) = mat(1046) + .260_r8*rxt(344)*y(79) + rxt(350)*y(76) & + + .300_r8*rxt(324)*y(67) + mat(615) = rxt(297)*y(23) + rxt(298)*y(11) + mat(799) = mat(799) + .530_r8*rxt(345)*y(79) + mat(245) = .500_r8*rxt(304)*y(23) + mat(359) = rxt(335)*y(9) + mat(733) = mat(733) + .530_r8*rxt(340)*y(9) + .530_r8*rxt(342)*y(11) & + + .260_r8*rxt(344)*y(16) + .530_r8*rxt(345)*y(48) + mat(771) = rxt(347)*y(9) + rxt(348)*y(11) + rxt(350)*y(16) & + + 4.000_r8*rxt(352)*y(76) + mat(628) = rxt(322)*y(9) + .300_r8*rxt(324)*y(16) + mat(670) = rxt(327)*y(23) + rxt(328)*y(11) + mat(244) = -(rxt(304)*y(23)) + mat(1125) = -rxt(304)*y(54) + mat(1286) = .750_r8*rxt(301)*y(48) + .750_r8*rxt(349)*y(76) + mat(786) = .750_r8*rxt(301)*y(24) + mat(765) = .750_r8*rxt(349)*y(24) + mat(237) = -(rxt(309)*y(23)) + mat(1124) = -rxt(309)*y(58) + mat(1369) = rxt(300)*y(48) + mat(785) = rxt(300)*y(10) + mat(157) = -(rxt(329)*y(23)) + mat(1114) = -rxt(329)*y(82) + mat(928) = .100_r8*rxt(372)*y(84) + mat(988) = rxt(312)*y(59) + mat(591) = rxt(312)*y(11) + mat(376) = .100_r8*rxt(372)*y(9) + mat(114) = -(rxt(282)*y(28) + rxt(284)*y(23)) + mat(1402) = -rxt(282)*y(45) + mat(1107) = -rxt(284)*y(45) + mat(255) = -(rxt(281)*y(28) + rxt(285)*y(23) + rxt(290)*y(1)) + mat(1404) = -rxt(281)*y(44) + mat(1126) = -rxt(285)*y(44) + mat(1190) = -rxt(290)*y(44) + mat(33) = -(rxt(368)*y(23)) + mat(1090) = -rxt(368)*y(71) + mat(279) = -(rxt(355)*y(23)) + mat(1129) = -rxt(355)*y(81) + mat(1371) = rxt(353)*y(76) + mat(766) = rxt(353)*y(10) + mat(36) = -(rxt(330)*y(23)) + mat(1091) = -rxt(330)*y(70) + mat(132) = -(rxt(331)*y(9)) + mat(926) = -rxt(331)*y(73) + mat(1109) = rxt(330)*y(70) + mat(37) = rxt(330)*y(23) + mat(380) = -(rxt(372)*y(9) + rxt(373)*y(24)) + mat(938) = -rxt(372)*y(84) + mat(1296) = -rxt(373)*y(84) + mat(1139) = rxt(368)*y(71) + rxt(374)*y(85) + mat(34) = rxt(368)*y(23) + mat(348) = rxt(374)*y(23) + mat(346) = -(rxt(374)*y(23)) + mat(1137) = -rxt(374)*y(85) + mat(1294) = rxt(373)*y(84) + mat(378) = rxt(373)*y(24) + mat(198) = -(rxt(334)*y(23)) + mat(1120) = -rxt(334)*y(72) + mat(931) = .800_r8*rxt(372)*y(84) + mat(377) = .800_r8*rxt(372)*y(9) + mat(357) = -(rxt(335)*y(9) + rxt(336)*y(24)) + mat(937) = -rxt(335)*y(74) + mat(1295) = -rxt(336)*y(74) + mat(1138) = rxt(334)*y(72) + rxt(337)*y(75) + mat(199) = rxt(334)*y(23) + mat(140) = rxt(337)*y(23) + mat(139) = -(rxt(337)*y(23)) + mat(1110) = -rxt(337)*y(75) + mat(1273) = rxt(336)*y(74) + mat(356) = rxt(336)*y(24) + mat(61) = -(rxt(382)*y(23)) + mat(1098) = -rxt(382)*y(94) + mat(66) = -(rxt(386)*y(23)) + mat(1099) = -rxt(386)*y(95) + mat(1099) = mat(1099) + .250_r8*rxt(382)*y(94) + mat(62) = .250_r8*rxt(382)*y(23) + mat(304) = -(rxt(383)*y(9) + rxt(384)*y(24)) + mat(935) = -rxt(383)*y(96) + mat(1290) = -rxt(384)*y(96) + mat(1132) = .700_r8*rxt(382)*y(94) + rxt(385)*y(97) + mat(63) = .700_r8*rxt(382)*y(23) + mat(162) = rxt(385)*y(23) + mat(161) = -(rxt(385)*y(23)) + mat(1115) = -rxt(385)*y(97) + mat(1276) = rxt(384)*y(96) + mat(303) = rxt(384)*y(24) + mat(82) = -(rxt(387)*y(10)) + mat(1366) = -rxt(387)*y(98) + mat(1101) = rxt(386)*y(95) + mat(67) = rxt(386)*y(23) + mat(568) = -(rxt(397)*y(9) + rxt(398)*y(24)) + mat(952) = -rxt(397)*y(106) + mat(1309) = -rxt(398)*y(106) + mat(1153) = rxt(399)*y(107) + rxt(394)*y(105) + mat(995) = rxt(396)*y(105) + mat(210) = rxt(399)*y(23) + mat(319) = rxt(394)*y(23) + rxt(396)*y(11) + mat(208) = -(rxt(399)*y(23)) + mat(1121) = -rxt(399)*y(107) + mat(1283) = rxt(398)*y(106) + mat(566) = rxt(398)*y(24) + mat(936) = .900_r8*rxt(383)*y(96) + .900_r8*rxt(390)*y(100) & + + .620_r8*rxt(393)*y(103) + mat(1372) = .700_r8*rxt(387)*y(98) + mat(305) = .900_r8*rxt(383)*y(9) + mat(83) = .700_r8*rxt(387)*y(10) + mat(169) = .900_r8*rxt(390)*y(9) + mat(217) = .620_r8*rxt(393)*y(9) + mat(397) = -(rxt(306)*y(23)) + mat(1141) = -rxt(306)*y(53) + mat(940) = .450_r8*rxt(383)*y(96) + .900_r8*rxt(390)*y(100) & + + .340_r8*rxt(393)*y(103) + .020_r8*rxt(359)*y(88) & + + .250_r8*rxt(375)*y(91) + mat(1141) = mat(1141) + .200_r8*rxt(305)*y(52) + .650_r8*rxt(283)*y(135) + mat(990) = .250_r8*rxt(376)*y(91) + mat(1031) = .100_r8*rxt(378)*y(91) + mat(788) = .250_r8*rxt(379)*y(91) + mat(306) = .450_r8*rxt(383)*y(9) + mat(170) = .900_r8*rxt(390)*y(9) + mat(218) = .340_r8*rxt(393)*y(9) + mat(699) = .020_r8*rxt(359)*y(9) + mat(551) = .200_r8*rxt(305)*y(23) + mat(679) = .250_r8*rxt(375)*y(9) + .250_r8*rxt(376)*y(11) + .100_r8*rxt(378) & + *y(16) + .250_r8*rxt(379)*y(48) + mat(122) = .650_r8*rxt(283)*y(23) + mat(39) = -(rxt(388)*y(23)) + mat(1092) = -rxt(388)*y(99) + mat(168) = -(rxt(389)*y(24) + rxt(390)*y(9)) + mat(1277) = -rxt(389)*y(100) + mat(929) = -rxt(390)*y(100) + mat(1116) = rxt(388)*y(99) + mat(40) = rxt(388)*y(23) + end subroutine nlnmat05 + subroutine nlnmat06( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1269) = rxt(389)*y(100) + mat(167) = rxt(389)*y(24) + mat(42) = -(rxt(391)*y(23)) + mat(1093) = -rxt(391)*y(102) + mat(216) = -(rxt(392)*y(24) + rxt(393)*y(9)) + mat(1284) = -rxt(392)*y(103) + mat(933) = -rxt(393)*y(103) + mat(1122) = rxt(391)*y(102) + mat(43) = rxt(391)*y(23) + mat(1270) = rxt(392)*y(103) + mat(215) = rxt(392)*y(24) + mat(707) = -(rxt(359)*y(9) + rxt(360)*y(11) + rxt(361)*y(24) + rxt(363)*y(16) & + + rxt(364)*y(48)) + mat(960) = -rxt(359)*y(88) + mat(1004) = -rxt(360)*y(88) + mat(1318) = -rxt(361)*y(88) + mat(1042) = -rxt(363)*y(88) + mat(795) = -rxt(364)*y(88) + mat(1164) = rxt(356)*y(83) + .200_r8*rxt(362)*y(93) + mat(539) = rxt(356)*y(23) + mat(298) = .200_r8*rxt(362)*y(23) + mat(750) = -(rxt(332)*y(23) + rxt(333)*y(1)) + mat(1166) = -rxt(332)*y(77) + mat(1209) = -rxt(333)*y(77) + mat(1209) = mat(1209) + .200_r8*rxt(357)*y(83) + rxt(395)*y(105) + mat(962) = rxt(397)*y(106) + .320_r8*rxt(359)*y(88) + .039_r8*rxt(365)*y(89) + mat(1006) = .350_r8*rxt(360)*y(88) + .039_r8*rxt(366)*y(89) + mat(1044) = .260_r8*rxt(363)*y(88) + mat(1320) = .039_r8*rxt(367)*y(89) + mat(540) = .200_r8*rxt(357)*y(1) + mat(797) = .350_r8*rxt(364)*y(88) + mat(571) = rxt(397)*y(9) + mat(709) = .320_r8*rxt(359)*y(9) + .350_r8*rxt(360)*y(11) + .260_r8*rxt(363) & + *y(16) + .350_r8*rxt(364)*y(48) + mat(321) = rxt(395)*y(1) + mat(459) = .039_r8*rxt(365)*y(9) + .039_r8*rxt(366)*y(11) + .039_r8*rxt(367) & + *y(24) + mat(644) = -(rxt(338)*y(23) + rxt(339)*y(1)) + mat(1160) = -rxt(338)*y(78) + mat(1204) = -rxt(339)*y(78) + mat(1204) = mat(1204) + .400_r8*rxt(357)*y(83) + rxt(395)*y(105) + mat(957) = rxt(397)*y(106) + .230_r8*rxt(359)*y(88) + .167_r8*rxt(365)*y(89) + mat(1001) = .250_r8*rxt(360)*y(88) + .167_r8*rxt(366)*y(89) + mat(1039) = .190_r8*rxt(363)*y(88) + mat(1314) = .167_r8*rxt(367)*y(89) + mat(538) = .400_r8*rxt(357)*y(1) + mat(792) = .250_r8*rxt(364)*y(88) + mat(570) = rxt(397)*y(9) + mat(704) = .230_r8*rxt(359)*y(9) + .250_r8*rxt(360)*y(11) + .190_r8*rxt(363) & + *y(16) + .250_r8*rxt(364)*y(48) + mat(320) = rxt(395)*y(1) + mat(458) = .167_r8*rxt(365)*y(9) + .167_r8*rxt(366)*y(11) + .167_r8*rxt(367) & + *y(24) + mat(731) = -((rxt(340) + rxt(341)) * y(9) + rxt(342)*y(11) + rxt(343)*y(24) & + + rxt(344)*y(16) + rxt(345)*y(48)) + mat(961) = -(rxt(340) + rxt(341)) * y(79) + mat(1005) = -rxt(342)*y(79) + mat(1319) = -rxt(343)*y(79) + mat(1043) = -rxt(344)*y(79) + mat(796) = -rxt(345)*y(79) + mat(1165) = rxt(332)*y(77) + .500_r8*rxt(338)*y(78) + .200_r8*rxt(346)*y(80) + mat(749) = rxt(332)*y(23) + mat(646) = .500_r8*rxt(338)*y(23) + mat(145) = .200_r8*rxt(346)*y(23) + mat(144) = -(rxt(346)*y(23)) + mat(1111) = -rxt(346)*y(80) + mat(1274) = rxt(343)*y(79) + mat(723) = rxt(343)*y(24) + mat(770) = -(rxt(347)*y(9) + rxt(348)*y(11) + rxt(349)*y(24) + rxt(350)*y(16) & + + rxt(351)*y(48) + 4._r8*rxt(352)*y(76) + rxt(353)*y(10)) + mat(963) = -rxt(347)*y(76) + mat(1007) = -rxt(348)*y(76) + mat(1321) = -rxt(349)*y(76) + mat(1045) = -rxt(350)*y(76) + mat(798) = -rxt(351)*y(76) + mat(1380) = -rxt(353)*y(76) + mat(1210) = .200_r8*rxt(357)*y(83) + mat(1167) = .500_r8*rxt(338)*y(78) + .500_r8*rxt(346)*y(80) + mat(541) = .200_r8*rxt(357)*y(1) + mat(647) = .500_r8*rxt(338)*y(23) + mat(146) = .500_r8*rxt(346)*y(23) + mat(501) = -(rxt(292)*y(9) + rxt(293)*y(24) + rxt(294)*y(16) + 4._r8*rxt(295) & + *y(46)) + mat(948) = -rxt(292)*y(46) + mat(1304) = -rxt(293)*y(46) + mat(1032) = -rxt(294)*y(46) + mat(1147) = rxt(284)*y(45) + .500_r8*rxt(296)*y(47) + mat(1409) = rxt(282)*y(45) + mat(115) = rxt(284)*y(23) + rxt(282)*y(28) + mat(150) = .500_r8*rxt(296)*y(23) + mat(149) = -(rxt(296)*y(23)) + mat(1112) = -rxt(296)*y(47) + mat(1275) = rxt(293)*y(46) + mat(499) = rxt(293)*y(24) + mat(318) = -(rxt(394)*y(23) + rxt(395)*y(1) + rxt(396)*y(11)) + mat(1134) = -rxt(394)*y(105) + mat(1192) = -rxt(395)*y(105) + mat(989) = -rxt(396)*y(105) + mat(51) = -(rxt(317)*y(23)) + mat(1096) = -rxt(317)*y(60) + mat(520) = -(rxt(313)*y(9) + rxt(314)*y(24) + rxt(315)*y(16)) + mat(949) = -rxt(313)*y(61) + mat(1306) = -rxt(314)*y(61) + mat(1033) = -rxt(315)*y(61) + mat(1149) = rxt(317)*y(60) + rxt(316)*y(62) + mat(52) = rxt(317)*y(23) + mat(176) = rxt(316)*y(23) + mat(174) = -(rxt(316)*y(23)) + mat(1117) = -rxt(316)*y(62) + mat(1278) = rxt(314)*y(61) + mat(518) = rxt(314)*y(24) + mat(391) = -(rxt(321)*y(23)) + mat(1140) = -rxt(321)*y(63) + mat(939) = .500_r8*rxt(331)*y(73) + .250_r8*rxt(372)*y(84) + .100_r8*rxt(397) & + *y(106) + .820_r8*rxt(313)*y(61) + mat(1030) = .820_r8*rxt(315)*y(61) + mat(133) = .500_r8*rxt(331)*y(9) + mat(381) = .250_r8*rxt(372)*y(9) + mat(567) = .100_r8*rxt(397)*y(9) + mat(519) = .820_r8*rxt(313)*y(9) + .820_r8*rxt(315)*y(16) + mat(180) = -(rxt(325)*y(23)) + mat(1118) = -rxt(325)*y(69) + mat(1279) = rxt(323)*y(67) + mat(623) = rxt(323)*y(24) + mat(267) = -(rxt(274)*y(23)) + mat(1128) = -rxt(274)*y(18) + mat(1028) = 2.000_r8*rxt(273)*y(16) + .250_r8*rxt(363)*y(88) & + + .250_r8*rxt(344)*y(79) + .300_r8*rxt(294)*y(46) & + + .500_r8*rxt(324)*y(67) + .300_r8*rxt(378)*y(91) + mat(697) = .250_r8*rxt(363)*y(16) + mat(724) = .250_r8*rxt(344)*y(16) + mat(500) = .300_r8*rxt(294)*y(16) + mat(624) = .500_r8*rxt(324)*y(16) + mat(678) = .300_r8*rxt(378)*y(16) + mat(106) = -(rxt(307)*y(23)) + mat(1105) = -rxt(307)*y(51) + mat(1025) = .200_r8*rxt(294)*y(46) + mat(498) = .200_r8*rxt(294)*y(16) + .800_r8*rxt(295)*y(46) + mat(552) = -(rxt(305)*y(23)) + mat(1151) = -rxt(305)*y(52) + mat(841) = rxt(288)*y(56) + mat(950) = .020_r8*rxt(359)*y(88) + .530_r8*rxt(340)*y(79) + .250_r8*rxt(375) & + *y(91) + mat(993) = .530_r8*rxt(342)*y(79) + .250_r8*rxt(376)*y(91) + mat(1034) = .260_r8*rxt(344)*y(79) + .100_r8*rxt(378)*y(91) + mat(789) = .530_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(700) = .020_r8*rxt(359)*y(9) + mat(725) = .530_r8*rxt(340)*y(9) + .530_r8*rxt(342)*y(11) + .260_r8*rxt(344) & + *y(16) + .530_r8*rxt(345)*y(48) + mat(204) = rxt(288)*y(4) + mat(680) = .250_r8*rxt(375)*y(9) + .250_r8*rxt(376)*y(11) + .100_r8*rxt(378) & + *y(16) + .250_r8*rxt(379)*y(48) + mat(637) = -(rxt(326)*y(23)) + mat(1159) = -rxt(326)*y(66) + mat(956) = .020_r8*rxt(359)*y(88) + .220_r8*rxt(340)*y(79) + .250_r8*rxt(375) & + *y(91) + mat(1159) = mat(1159) + .500_r8*rxt(320)*y(65) + .500_r8*rxt(355)*y(81) + mat(1000) = .220_r8*rxt(342)*y(79) + .250_r8*rxt(376)*y(91) + mat(1038) = .230_r8*rxt(344)*y(79) + .200_r8*rxt(324)*y(67) & + + .100_r8*rxt(378)*y(91) + mat(290) = .500_r8*rxt(320)*y(23) + mat(791) = .220_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(280) = .500_r8*rxt(355)*y(23) + mat(703) = .020_r8*rxt(359)*y(9) + mat(728) = .220_r8*rxt(340)*y(9) + .220_r8*rxt(342)*y(11) + .230_r8*rxt(344) & + *y(16) + .220_r8*rxt(345)*y(48) + mat(626) = .200_r8*rxt(324)*y(16) + mat(682) = .250_r8*rxt(375)*y(9) + .250_r8*rxt(376)*y(11) + .100_r8*rxt(378) & + *y(16) + .250_r8*rxt(379)*y(48) + mat(412) = -(rxt(286)*y(9) + rxt(287)*y(24)) + mat(941) = -rxt(286)*y(55) + mat(1300) = -rxt(287)*y(55) + mat(1142) = rxt(285)*y(44) + mat(257) = rxt(285)*y(23) + mat(203) = -(rxt(288)*y(4)) + mat(832) = -rxt(288)*y(56) + mat(932) = .750_r8*rxt(286)*y(55) + mat(411) = .750_r8*rxt(286)*y(9) + mat(1271) = rxt(287)*y(55) + mat(410) = rxt(287)*y(24) + mat(154) = -(rxt(371)*y(23)) + mat(1113) = -rxt(371)*y(87) + mat(927) = .330_r8*rxt(359)*y(88) + mat(1113) = mat(1113) + rxt(369)*y(90) + mat(987) = .400_r8*rxt(360)*y(88) + rxt(370)*y(90) + mat(1026) = .300_r8*rxt(363)*y(88) + mat(784) = .400_r8*rxt(364)*y(88) + mat(696) = .330_r8*rxt(359)*y(9) + .400_r8*rxt(360)*y(11) + .300_r8*rxt(363) & + *y(16) + .400_r8*rxt(364)*y(48) + mat(557) = rxt(369)*y(23) + rxt(370)*y(11) + mat(625) = -(rxt(322)*y(9) + rxt(323)*y(24) + rxt(324)*y(16)) + mat(955) = -rxt(322)*y(67) + mat(1312) = -rxt(323)*y(67) + mat(1037) = -rxt(324)*y(67) + mat(1158) = rxt(321)*y(63) + rxt(325)*y(69) + mat(392) = rxt(321)*y(23) + mat(181) = rxt(325)*y(23) + mat(669) = -(rxt(327)*y(23) + rxt(328)*y(11)) + mat(1162) = -rxt(327)*y(68) + mat(1002) = -rxt(328)*y(68) + mat(1205) = .950_r8*rxt(333)*y(77) + .800_r8*rxt(339)*y(78) + mat(958) = .450_r8*rxt(383)*y(96) + .540_r8*rxt(393)*y(103) & + + .020_r8*rxt(359)*y(88) + .250_r8*rxt(340)*y(79) & + + .250_r8*rxt(375)*y(91) + mat(1162) = mat(1162) + rxt(329)*y(82) + rxt(326)*y(66) + mat(1002) = mat(1002) + .250_r8*rxt(342)*y(79) + .250_r8*rxt(376)*y(91) + mat(1040) = .240_r8*rxt(344)*y(79) + .500_r8*rxt(324)*y(67) & + + .100_r8*rxt(378)*y(91) + mat(793) = .250_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(158) = rxt(329)*y(23) + mat(307) = .450_r8*rxt(383)*y(9) + mat(219) = .540_r8*rxt(393)*y(9) + mat(705) = .020_r8*rxt(359)*y(9) + mat(748) = .950_r8*rxt(333)*y(1) + mat(645) = .800_r8*rxt(339)*y(1) + mat(729) = .250_r8*rxt(340)*y(9) + .250_r8*rxt(342)*y(11) + .240_r8*rxt(344) & + *y(16) + .250_r8*rxt(345)*y(48) + mat(638) = rxt(326)*y(23) + mat(627) = .500_r8*rxt(324)*y(16) + mat(683) = .250_r8*rxt(375)*y(9) + .250_r8*rxt(376)*y(11) + .100_r8*rxt(378) & + *y(16) + .250_r8*rxt(379)*y(48) + end subroutine nlnmat06 + subroutine nlnmat07( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(456) = -(rxt(365)*y(9) + rxt(366)*y(11) + rxt(367)*y(24)) + mat(945) = -rxt(365)*y(89) + mat(991) = -rxt(366)*y(89) + mat(1301) = -rxt(367)*y(89) + mat(991) = mat(991) + rxt(358)*y(83) + mat(533) = rxt(358)*y(11) + mat(558) = -(rxt(369)*y(23) + rxt(370)*y(11)) + mat(1152) = -rxt(369)*y(90) + mat(994) = -rxt(370)*y(90) + mat(951) = .080_r8*rxt(359)*y(88) + .800_r8*rxt(341)*y(79) + .794_r8*rxt(365) & + *y(89) + mat(994) = mat(994) + .794_r8*rxt(366)*y(89) + mat(1308) = .794_r8*rxt(367)*y(89) + mat(701) = .080_r8*rxt(359)*y(9) + mat(726) = .800_r8*rxt(341)*y(9) + mat(457) = .794_r8*rxt(365)*y(9) + .794_r8*rxt(366)*y(11) + .794_r8*rxt(367) & + *y(24) + mat(684) = -(rxt(375)*y(9) + rxt(376)*y(11) + rxt(377)*y(24) + rxt(378)*y(16) & + + rxt(379)*y(48)) + mat(959) = -rxt(375)*y(91) + mat(1003) = -rxt(376)*y(91) + mat(1317) = -rxt(377)*y(91) + mat(1041) = -rxt(378)*y(91) + mat(794) = -rxt(379)*y(91) + mat(1163) = rxt(371)*y(87) + rxt(380)*y(92) + .800_r8*rxt(362)*y(93) + mat(155) = rxt(371)*y(23) + mat(111) = rxt(380)*y(23) + mat(297) = .800_r8*rxt(362)*y(23) + mat(110) = -((rxt(380) + rxt(381)) * y(23)) + mat(1106) = -(rxt(380) + rxt(381)) * y(92) + mat(1272) = rxt(377)*y(91) + mat(677) = rxt(377)*y(24) + mat(295) = -(rxt(362)*y(23)) + mat(1131) = -rxt(362)*y(93) + mat(1289) = rxt(361)*y(88) + mat(698) = rxt(361)*y(24) + mat(120) = -(rxt(280)*y(28) + rxt(283)*y(23)) + mat(1403) = -rxt(280)*y(135) + mat(1108) = -rxt(283)*y(135) + mat(263) = -(rxt(276)*y(23)) + mat(1127) = -rxt(276)*y(136) + mat(1191) = .500_r8*rxt(290)*y(44) + mat(934) = rxt(278)*y(137) + mat(1127) = mat(1127) + .350_r8*rxt(283)*y(135) + mat(1287) = rxt(279)*y(137) + mat(256) = .500_r8*rxt(290)*y(1) + mat(121) = .350_r8*rxt(283)*y(23) + mat(187) = rxt(278)*y(9) + rxt(279)*y(24) + mat(186) = -(rxt(278)*y(9) + rxt(279)*y(24)) + mat(930) = -rxt(278)*y(137) + mat(1280) = -rxt(279)*y(137) + mat(1231) = rxt(269)*y(24) + mat(1280) = mat(1280) + rxt(269)*y(19) + mat(72) = -(rxt(151)*y(3)) + mat(1342) = -rxt(151)*y(138) + mat(86) = -(rxt(152)*y(3)) + mat(1344) = -rxt(152)*y(139) + mat(655) = rxt(248)*y(141) + mat(866) = rxt(250)*y(141) + mat(853) = rxt(247)*y(141) + mat(447) = rxt(248)*y(21) + rxt(250)*y(12) + rxt(247)*y(134) + mat(448) = -(rxt(247)*y(134) + rxt(248)*y(21) + rxt(250)*y(12)) + mat(854) = -rxt(247)*y(141) + mat(656) = -rxt(248)*y(141) + mat(867) = -rxt(250)*y(141) + mat(1346) = 2.000_r8*rxt(151)*y(138) + rxt(152)*y(139) + mat(73) = 2.000_r8*rxt(151)*y(3) + mat(87) = rxt(152)*y(3) + mat(56) = -(rxt(404)*y(23)) + mat(1097) = -rxt(404)*y(156) + mat(1097) = mat(1097) + (rxt(405)+.500_r8*rxt(406))*y(157) + mat(984) = rxt(407)*y(157) + mat(97) = (rxt(405)+.500_r8*rxt(406))*y(23) + rxt(407)*y(11) + mat(98) = -((rxt(405) + rxt(406)) * y(23) + rxt(407)*y(11)) + mat(1104) = -(rxt(405) + rxt(406)) * y(157) + mat(985) = -rxt(407)*y(157) + mat(1089) = rxt(404)*y(156) + mat(55) = rxt(404)*y(23) + mat(45) = -(rxt(408)*y(23)) + mat(1094) = -rxt(408)*y(159) + end subroutine nlnmat07 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = mat( 33) + lmat( 33) + mat( 36) = mat( 36) + lmat( 36) + mat( 39) = mat( 39) + lmat( 39) + mat( 42) = mat( 42) + lmat( 42) + mat( 45) = mat( 45) + lmat( 45) + mat( 48) = mat( 48) + lmat( 48) + mat( 51) = mat( 51) + lmat( 51) + mat( 56) = mat( 56) + lmat( 56) + mat( 58) = lmat( 58) + mat( 59) = lmat( 59) + mat( 60) = lmat( 60) + mat( 61) = mat( 61) + lmat( 61) + mat( 66) = mat( 66) + lmat( 66) + mat( 69) = lmat( 69) + mat( 70) = lmat( 70) + mat( 71) = lmat( 71) + mat( 72) = mat( 72) + lmat( 72) + mat( 73) = mat( 73) + lmat( 73) + mat( 75) = mat( 75) + lmat( 75) + mat( 76) = mat( 76) + lmat( 76) + mat( 77) = mat( 77) + lmat( 77) + mat( 78) = mat( 78) + lmat( 78) + mat( 79) = lmat( 79) + mat( 80) = lmat( 80) + mat( 81) = lmat( 81) + mat( 82) = mat( 82) + lmat( 82) + mat( 86) = mat( 86) + lmat( 86) + mat( 87) = mat( 87) + lmat( 87) + mat( 89) = mat( 89) + lmat( 89) + mat( 90) = mat( 90) + lmat( 90) + mat( 94) = lmat( 94) + mat( 95) = lmat( 95) + mat( 96) = lmat( 96) + mat( 98) = mat( 98) + lmat( 98) + mat( 103) = lmat( 103) + mat( 104) = lmat( 104) + mat( 105) = lmat( 105) + mat( 106) = mat( 106) + lmat( 106) + mat( 110) = mat( 110) + lmat( 110) + mat( 113) = mat( 113) + lmat( 113) + mat( 114) = mat( 114) + lmat( 114) + mat( 120) = mat( 120) + lmat( 120) + mat( 126) = lmat( 126) + mat( 127) = lmat( 127) + mat( 128) = lmat( 128) + mat( 129) = lmat( 129) + mat( 130) = lmat( 130) + mat( 131) = lmat( 131) + mat( 132) = mat( 132) + lmat( 132) + mat( 139) = mat( 139) + lmat( 139) + mat( 141) = lmat( 141) + mat( 142) = lmat( 142) + mat( 143) = mat( 143) + lmat( 143) + mat( 144) = mat( 144) + lmat( 144) + mat( 149) = mat( 149) + lmat( 149) + mat( 151) = mat( 151) + lmat( 151) + mat( 152) = mat( 152) + lmat( 152) + mat( 153) = lmat( 153) + mat( 154) = mat( 154) + lmat( 154) + mat( 157) = mat( 157) + lmat( 157) + mat( 161) = mat( 161) + lmat( 161) + mat( 163) = lmat( 163) + mat( 164) = lmat( 164) + mat( 165) = lmat( 165) + mat( 166) = mat( 166) + lmat( 166) + mat( 168) = mat( 168) + lmat( 168) + mat( 174) = mat( 174) + lmat( 174) + mat( 175) = lmat( 175) + mat( 178) = mat( 178) + lmat( 178) + mat( 179) = lmat( 179) + mat( 180) = mat( 180) + lmat( 180) + mat( 182) = lmat( 182) + mat( 184) = mat( 184) + lmat( 184) + mat( 185) = lmat( 185) + mat( 186) = mat( 186) + lmat( 186) + mat( 189) = lmat( 189) + mat( 190) = mat( 190) + lmat( 190) + mat( 192) = mat( 192) + lmat( 192) + mat( 195) = mat( 195) + lmat( 195) + mat( 196) = mat( 196) + lmat( 196) + mat( 197) = lmat( 197) + mat( 198) = mat( 198) + lmat( 198) + mat( 200) = lmat( 200) + mat( 201) = lmat( 201) + mat( 203) = mat( 203) + lmat( 203) + mat( 206) = lmat( 206) + mat( 207) = mat( 207) + lmat( 207) + mat( 208) = mat( 208) + lmat( 208) + mat( 209) = lmat( 209) + mat( 211) = lmat( 211) + mat( 212) = lmat( 212) + mat( 213) = mat( 213) + lmat( 213) + mat( 214) = lmat( 214) + mat( 216) = mat( 216) + lmat( 216) + mat( 223) = mat( 223) + lmat( 223) + mat( 230) = mat( 230) + lmat( 230) + mat( 233) = lmat( 233) + mat( 234) = mat( 234) + lmat( 234) + mat( 235) = lmat( 235) + mat( 236) = mat( 236) + lmat( 236) + mat( 237) = mat( 237) + lmat( 237) + mat( 238) = lmat( 238) + mat( 239) = mat( 239) + lmat( 239) + mat( 240) = lmat( 240) + mat( 243) = lmat( 243) + mat( 244) = mat( 244) + lmat( 244) + mat( 247) = lmat( 247) + mat( 248) = mat( 248) + lmat( 248) + mat( 250) = mat( 250) + lmat( 250) + mat( 255) = mat( 255) + lmat( 255) + mat( 263) = mat( 263) + lmat( 263) + mat( 267) = mat( 267) + lmat( 267) + mat( 271) = mat( 271) + lmat( 271) + mat( 272) = lmat( 272) + mat( 273) = mat( 273) + lmat( 273) + mat( 274) = lmat( 274) + mat( 275) = lmat( 275) + mat( 276) = mat( 276) + lmat( 276) + mat( 277) = lmat( 277) + mat( 279) = mat( 279) + lmat( 279) + mat( 281) = lmat( 281) + mat( 286) = lmat( 286) + mat( 287) = mat( 287) + lmat( 287) + mat( 289) = lmat( 289) + mat( 292) = mat( 292) + lmat( 292) + mat( 293) = lmat( 293) + mat( 294) = lmat( 294) + mat( 295) = mat( 295) + lmat( 295) + mat( 296) = lmat( 296) + mat( 299) = lmat( 299) + mat( 301) = lmat( 301) + mat( 302) = lmat( 302) + mat( 304) = mat( 304) + lmat( 304) + mat( 312) = lmat( 312) + mat( 313) = lmat( 313) + mat( 314) = lmat( 314) + mat( 315) = lmat( 315) + mat( 316) = lmat( 316) + mat( 317) = lmat( 317) + mat( 318) = mat( 318) + lmat( 318) + mat( 327) = mat( 327) + lmat( 327) + mat( 331) = mat( 331) + lmat( 331) + mat( 332) = mat( 332) + lmat( 332) + mat( 333) = lmat( 333) + mat( 334) = lmat( 334) + mat( 335) = lmat( 335) + mat( 338) = mat( 338) + lmat( 338) + mat( 341) = mat( 341) + lmat( 341) + mat( 345) = lmat( 345) + mat( 346) = mat( 346) + lmat( 346) + mat( 349) = lmat( 349) + mat( 351) = lmat( 351) + mat( 353) = mat( 353) + lmat( 353) + mat( 354) = lmat( 354) + mat( 355) = lmat( 355) + mat( 357) = mat( 357) + lmat( 357) + mat( 366) = mat( 366) + lmat( 366) + mat( 380) = mat( 380) + lmat( 380) + mat( 391) = mat( 391) + lmat( 391) + mat( 393) = lmat( 393) + mat( 395) = lmat( 395) + mat( 397) = mat( 397) + lmat( 397) + mat( 398) = mat( 398) + lmat( 398) + mat( 400) = mat( 400) + lmat( 400) + mat( 402) = mat( 402) + lmat( 402) + mat( 405) = lmat( 405) + mat( 407) = mat( 407) + lmat( 407) + mat( 412) = mat( 412) + lmat( 412) + mat( 420) = mat( 420) + lmat( 420) + mat( 421) = mat( 421) + lmat( 421) + mat( 425) = mat( 425) + lmat( 425) + mat( 429) = mat( 429) + lmat( 429) + mat( 440) = mat( 440) + lmat( 440) + mat( 447) = mat( 447) + lmat( 447) + mat( 448) = mat( 448) + lmat( 448) + mat( 453) = lmat( 453) + mat( 456) = mat( 456) + lmat( 456) + mat( 467) = mat( 467) + lmat( 467) + mat( 477) = mat( 477) + lmat( 477) + mat( 479) = mat( 479) + lmat( 479) + mat( 481) = lmat( 481) + mat( 484) = lmat( 484) + mat( 488) = lmat( 488) + mat( 489) = mat( 489) + lmat( 489) + mat( 501) = mat( 501) + lmat( 501) + mat( 511) = mat( 511) + lmat( 511) + mat( 515) = mat( 515) + lmat( 515) + mat( 516) = mat( 516) + lmat( 516) + mat( 520) = mat( 520) + lmat( 520) + mat( 534) = mat( 534) + lmat( 534) + mat( 552) = mat( 552) + lmat( 552) + mat( 553) = lmat( 553) + mat( 555) = mat( 555) + lmat( 555) + mat( 556) = mat( 556) + lmat( 556) + mat( 558) = mat( 558) + lmat( 558) + mat( 559) = lmat( 559) + mat( 563) = lmat( 563) + mat( 564) = mat( 564) + lmat( 564) + mat( 565) = mat( 565) + lmat( 565) + mat( 568) = mat( 568) + lmat( 568) + mat( 580) = mat( 580) + lmat( 580) + mat( 581) = mat( 581) + lmat( 581) + mat( 583) = mat( 583) + lmat( 583) + mat( 584) = mat( 584) + lmat( 584) + mat( 585) = mat( 585) + lmat( 585) + mat( 588) = lmat( 588) + mat( 589) = mat( 589) + lmat( 589) + mat( 594) = mat( 594) + lmat( 594) + mat( 609) = mat( 609) + lmat( 609) + mat( 613) = lmat( 613) + mat( 614) = mat( 614) + lmat( 614) + mat( 619) = lmat( 619) + mat( 622) = lmat( 622) + mat( 625) = mat( 625) + lmat( 625) + mat( 637) = mat( 637) + lmat( 637) + mat( 639) = lmat( 639) + mat( 641) = lmat( 641) + mat( 642) = mat( 642) + lmat( 642) + mat( 643) = mat( 643) + lmat( 643) + mat( 644) = mat( 644) + lmat( 644) + mat( 647) = mat( 647) + lmat( 647) + mat( 648) = lmat( 648) + mat( 652) = mat( 652) + lmat( 652) + mat( 654) = mat( 654) + lmat( 654) + mat( 657) = mat( 657) + lmat( 657) + mat( 668) = mat( 668) + lmat( 668) + mat( 669) = mat( 669) + lmat( 669) + mat( 670) = mat( 670) + lmat( 670) + mat( 676) = lmat( 676) + mat( 684) = mat( 684) + lmat( 684) + mat( 707) = mat( 707) + lmat( 707) + mat( 731) = mat( 731) + lmat( 731) + mat( 744) = lmat( 744) + mat( 745) = mat( 745) + lmat( 745) + mat( 750) = mat( 750) + lmat( 750) + mat( 752) = lmat( 752) + mat( 758) = lmat( 758) + mat( 770) = mat( 770) + lmat( 770) + mat( 799) = mat( 799) + lmat( 799) + mat( 816) = mat( 816) + lmat( 816) + mat( 821) = mat( 821) + lmat( 821) + mat( 829) = mat( 829) + lmat( 829) + mat( 835) = mat( 835) + lmat( 835) + mat( 837) = mat( 837) + lmat( 837) + mat( 839) = lmat( 839) + mat( 843) = mat( 843) + lmat( 843) + mat( 850) = mat( 850) + lmat( 850) + mat( 852) = mat( 852) + lmat( 852) + mat( 855) = lmat( 855) + mat( 856) = mat( 856) + lmat( 856) + mat( 861) = mat( 861) + lmat( 861) + mat( 862) = lmat( 862) + mat( 863) = mat( 863) + lmat( 863) + mat( 865) = lmat( 865) + mat( 870) = mat( 870) + lmat( 870) + mat( 874) = mat( 874) + lmat( 874) + mat( 877) = lmat( 877) + mat( 890) = mat( 890) + lmat( 890) + mat( 903) = mat( 903) + lmat( 903) + mat( 904) = mat( 904) + lmat( 904) + mat( 912) = mat( 912) + lmat( 912) + mat( 943) = mat( 943) + lmat( 943) + mat( 944) = lmat( 944) + mat( 947) = mat( 947) + lmat( 947) + mat( 971) = mat( 971) + lmat( 971) + mat( 983) = mat( 983) + lmat( 983) + mat(1009) = mat(1009) + lmat(1009) + mat(1011) = mat(1011) + lmat(1011) + mat(1012) = mat(1012) + lmat(1012) + mat(1013) = mat(1013) + lmat(1013) + mat(1022) = mat(1022) + lmat(1022) + mat(1024) = mat(1024) + lmat(1024) + mat(1054) = mat(1054) + lmat(1054) + mat(1079) = mat(1079) + lmat(1079) + mat(1083) = lmat(1083) + mat(1087) = mat(1087) + lmat(1087) + mat(1100) = lmat(1100) + mat(1102) = lmat(1102) + mat(1171) = mat(1171) + lmat(1171) + mat(1174) = mat(1174) + lmat(1174) + mat(1177) = mat(1177) + lmat(1177) + mat(1179) = mat(1179) + lmat(1179) + mat(1183) = mat(1183) + lmat(1183) + mat(1186) = mat(1186) + lmat(1186) + mat(1188) = mat(1188) + lmat(1188) + mat(1213) = mat(1213) + lmat(1213) + mat(1223) = mat(1223) + lmat(1223) + mat(1227) = mat(1227) + lmat(1227) + mat(1230) = mat(1230) + lmat(1230) + mat(1234) = mat(1234) + lmat(1234) + mat(1235) = lmat(1235) + mat(1245) = mat(1245) + lmat(1245) + mat(1246) = mat(1246) + lmat(1246) + mat(1263) = mat(1263) + lmat(1263) + mat(1293) = mat(1293) + lmat(1293) + mat(1337) = mat(1337) + lmat(1337) + mat(1342) = mat(1342) + lmat(1342) + mat(1344) = mat(1344) + lmat(1344) + mat(1346) = mat(1346) + lmat(1346) + mat(1348) = mat(1348) + lmat(1348) + mat(1349) = mat(1349) + lmat(1349) + mat(1352) = mat(1352) + lmat(1352) + mat(1353) = lmat(1353) + mat(1355) = lmat(1355) + mat(1357) = mat(1357) + lmat(1357) + mat(1359) = lmat(1359) + mat(1360) = mat(1360) + lmat(1360) + mat(1361) = lmat(1361) + mat(1362) = mat(1362) + lmat(1362) + mat(1364) = mat(1364) + lmat(1364) + mat(1365) = mat(1365) + lmat(1365) + mat(1385) = mat(1385) + lmat(1385) + mat(1388) = mat(1388) + lmat(1388) + mat(1392) = mat(1392) + lmat(1392) + mat(1398) = mat(1398) + lmat(1398) + mat(1400) = mat(1400) + lmat(1400) + mat(1413) = mat(1413) + lmat(1413) + mat(1421) = lmat(1421) + mat(1424) = lmat(1424) + mat(1425) = mat(1425) + lmat(1425) + mat(1430) = mat(1430) + lmat(1430) + mat(1433) = mat(1433) + lmat(1433) + mat(1440) = mat(1440) + lmat(1440) + mat(1446) = lmat(1446) + mat(1471) = mat(1471) + lmat(1471) + mat( 309) = 0._r8 + mat( 347) = 0._r8 + mat( 350) = 0._r8 + mat( 352) = 0._r8 + mat( 361) = 0._r8 + mat( 371) = 0._r8 + mat( 373) = 0._r8 + mat( 374) = 0._r8 + mat( 379) = 0._r8 + mat( 382) = 0._r8 + mat( 384) = 0._r8 + mat( 385) = 0._r8 + mat( 387) = 0._r8 + mat( 408) = 0._r8 + mat( 413) = 0._r8 + mat( 414) = 0._r8 + mat( 416) = 0._r8 + mat( 432) = 0._r8 + mat( 433) = 0._r8 + mat( 434) = 0._r8 + mat( 442) = 0._r8 + mat( 443) = 0._r8 + mat( 444) = 0._r8 + mat( 469) = 0._r8 + mat( 471) = 0._r8 + mat( 473) = 0._r8 + mat( 485) = 0._r8 + mat( 490) = 0._r8 + mat( 495) = 0._r8 + mat( 506) = 0._r8 + mat( 522) = 0._r8 + mat( 523) = 0._r8 + mat( 525) = 0._r8 + mat( 528) = 0._r8 + mat( 535) = 0._r8 + mat( 542) = 0._r8 + mat( 543) = 0._r8 + mat( 545) = 0._r8 + mat( 550) = 0._r8 + mat( 560) = 0._r8 + mat( 569) = 0._r8 + mat( 572) = 0._r8 + mat( 573) = 0._r8 + mat( 575) = 0._r8 + mat( 576) = 0._r8 + mat( 582) = 0._r8 + mat( 597) = 0._r8 + mat( 598) = 0._r8 + mat( 599) = 0._r8 + mat( 600) = 0._r8 + mat( 601) = 0._r8 + mat( 608) = 0._r8 + mat( 621) = 0._r8 + mat( 630) = 0._r8 + mat( 633) = 0._r8 + mat( 653) = 0._r8 + mat( 659) = 0._r8 + mat( 660) = 0._r8 + mat( 661) = 0._r8 + mat( 675) = 0._r8 + mat( 686) = 0._r8 + mat( 687) = 0._r8 + mat( 691) = 0._r8 + mat( 693) = 0._r8 + mat( 702) = 0._r8 + mat( 706) = 0._r8 + mat( 708) = 0._r8 + mat( 710) = 0._r8 + mat( 712) = 0._r8 + mat( 713) = 0._r8 + mat( 717) = 0._r8 + mat( 718) = 0._r8 + mat( 720) = 0._r8 + mat( 730) = 0._r8 + mat( 732) = 0._r8 + mat( 734) = 0._r8 + mat( 735) = 0._r8 + mat( 739) = 0._r8 + mat( 741) = 0._r8 + mat( 747) = 0._r8 + mat( 751) = 0._r8 + mat( 753) = 0._r8 + mat( 754) = 0._r8 + mat( 755) = 0._r8 + mat( 756) = 0._r8 + mat( 757) = 0._r8 + mat( 762) = 0._r8 + mat( 764) = 0._r8 + mat( 768) = 0._r8 + mat( 769) = 0._r8 + mat( 773) = 0._r8 + mat( 774) = 0._r8 + mat( 778) = 0._r8 + mat( 781) = 0._r8 + mat( 800) = 0._r8 + mat( 801) = 0._r8 + mat( 802) = 0._r8 + mat( 804) = 0._r8 + mat( 806) = 0._r8 + mat( 809) = 0._r8 + mat( 818) = 0._r8 + mat( 819) = 0._r8 + mat( 823) = 0._r8 + mat( 824) = 0._r8 + mat( 842) = 0._r8 + mat( 845) = 0._r8 + mat( 847) = 0._r8 + mat( 851) = 0._r8 + mat( 857) = 0._r8 + mat( 858) = 0._r8 + mat( 859) = 0._r8 + mat( 860) = 0._r8 + mat( 864) = 0._r8 + mat( 868) = 0._r8 + mat( 872) = 0._r8 + mat( 873) = 0._r8 + mat( 875) = 0._r8 + mat( 876) = 0._r8 + mat( 878) = 0._r8 + mat( 879) = 0._r8 + mat( 888) = 0._r8 + mat( 889) = 0._r8 + mat( 893) = 0._r8 + mat( 897) = 0._r8 + mat( 899) = 0._r8 + mat( 901) = 0._r8 + mat( 909) = 0._r8 + mat( 910) = 0._r8 + mat( 911) = 0._r8 + mat( 913) = 0._r8 + mat( 914) = 0._r8 + mat( 915) = 0._r8 + mat( 916) = 0._r8 + mat( 917) = 0._r8 + mat( 920) = 0._r8 + mat( 922) = 0._r8 + mat( 923) = 0._r8 + mat( 924) = 0._r8 + mat( 925) = 0._r8 + mat( 967) = 0._r8 + mat( 968) = 0._r8 + mat( 974) = 0._r8 + mat( 978) = 0._r8 + mat( 980) = 0._r8 + mat( 999) = 0._r8 + mat(1010) = 0._r8 + mat(1014) = 0._r8 + mat(1015) = 0._r8 + mat(1017) = 0._r8 + mat(1019) = 0._r8 + mat(1021) = 0._r8 + mat(1023) = 0._r8 + mat(1048) = 0._r8 + mat(1049) = 0._r8 + mat(1051) = 0._r8 + mat(1053) = 0._r8 + mat(1055) = 0._r8 + mat(1056) = 0._r8 + mat(1057) = 0._r8 + mat(1059) = 0._r8 + mat(1061) = 0._r8 + mat(1064) = 0._r8 + mat(1070) = 0._r8 + mat(1071) = 0._r8 + mat(1074) = 0._r8 + mat(1075) = 0._r8 + mat(1076) = 0._r8 + mat(1077) = 0._r8 + mat(1078) = 0._r8 + mat(1081) = 0._r8 + mat(1082) = 0._r8 + mat(1084) = 0._r8 + mat(1086) = 0._r8 + mat(1133) = 0._r8 + mat(1143) = 0._r8 + mat(1184) = 0._r8 + mat(1194) = 0._r8 + mat(1196) = 0._r8 + mat(1197) = 0._r8 + mat(1198) = 0._r8 + mat(1202) = 0._r8 + mat(1203) = 0._r8 + mat(1206) = 0._r8 + mat(1207) = 0._r8 + mat(1208) = 0._r8 + mat(1211) = 0._r8 + mat(1214) = 0._r8 + mat(1215) = 0._r8 + mat(1221) = 0._r8 + mat(1232) = 0._r8 + mat(1239) = 0._r8 + mat(1241) = 0._r8 + mat(1244) = 0._r8 + mat(1248) = 0._r8 + mat(1249) = 0._r8 + mat(1255) = 0._r8 + mat(1256) = 0._r8 + mat(1257) = 0._r8 + mat(1258) = 0._r8 + mat(1259) = 0._r8 + mat(1262) = 0._r8 + mat(1265) = 0._r8 + mat(1266) = 0._r8 + mat(1267) = 0._r8 + mat(1282) = 0._r8 + mat(1291) = 0._r8 + mat(1297) = 0._r8 + mat(1298) = 0._r8 + mat(1307) = 0._r8 + mat(1310) = 0._r8 + mat(1311) = 0._r8 + mat(1313) = 0._r8 + mat(1316) = 0._r8 + mat(1326) = 0._r8 + mat(1338) = 0._r8 + mat(1351) = 0._r8 + mat(1354) = 0._r8 + mat(1363) = 0._r8 + mat(1373) = 0._r8 + mat(1374) = 0._r8 + mat(1377) = 0._r8 + mat(1378) = 0._r8 + mat(1379) = 0._r8 + mat(1384) = 0._r8 + mat(1387) = 0._r8 + mat(1390) = 0._r8 + mat(1391) = 0._r8 + mat(1394) = 0._r8 + mat(1395) = 0._r8 + mat(1397) = 0._r8 + mat(1399) = 0._r8 + mat(1405) = 0._r8 + mat(1407) = 0._r8 + mat(1408) = 0._r8 + mat(1411) = 0._r8 + mat(1414) = 0._r8 + mat(1416) = 0._r8 + mat(1418) = 0._r8 + mat(1419) = 0._r8 + mat(1422) = 0._r8 + mat(1431) = 0._r8 + mat(1432) = 0._r8 + mat(1434) = 0._r8 + mat(1444) = 0._r8 + mat(1455) = 0._r8 + mat(1456) = 0._r8 + mat(1461) = 0._r8 + mat(1468) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 25) = mat( 25) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti + mat( 33) = mat( 33) - dti + mat( 36) = mat( 36) - dti + mat( 39) = mat( 39) - dti + mat( 42) = mat( 42) - dti + mat( 45) = mat( 45) - dti + mat( 48) = mat( 48) - dti + mat( 51) = mat( 51) - dti + mat( 56) = mat( 56) - dti + mat( 58) = mat( 58) - dti + mat( 61) = mat( 61) - dti + mat( 66) = mat( 66) - dti + mat( 69) = mat( 69) - dti + mat( 72) = mat( 72) - dti + mat( 75) = mat( 75) - dti + mat( 78) = mat( 78) - dti + mat( 80) = mat( 80) - dti + mat( 82) = mat( 82) - dti + mat( 86) = mat( 86) - dti + mat( 90) = mat( 90) - dti + mat( 94) = mat( 94) - dti + mat( 98) = mat( 98) - dti + mat( 103) = mat( 103) - dti + mat( 106) = mat( 106) - dti + mat( 110) = mat( 110) - dti + mat( 114) = mat( 114) - dti + mat( 120) = mat( 120) - dti + mat( 126) = mat( 126) - dti + mat( 132) = mat( 132) - dti + mat( 139) = mat( 139) - dti + mat( 144) = mat( 144) - dti + mat( 149) = mat( 149) - dti + mat( 154) = mat( 154) - dti + mat( 157) = mat( 157) - dti + mat( 161) = mat( 161) - dti + mat( 168) = mat( 168) - dti + mat( 174) = mat( 174) - dti + mat( 180) = mat( 180) - dti + mat( 186) = mat( 186) - dti + mat( 192) = mat( 192) - dti + mat( 198) = mat( 198) - dti + mat( 203) = mat( 203) - dti + mat( 208) = mat( 208) - dti + mat( 216) = mat( 216) - dti + mat( 223) = mat( 223) - dti + mat( 230) = mat( 230) - dti + mat( 237) = mat( 237) - dti + mat( 244) = mat( 244) - dti + mat( 250) = mat( 250) - dti + mat( 255) = mat( 255) - dti + mat( 263) = mat( 263) - dti + mat( 267) = mat( 267) - dti + mat( 271) = mat( 271) - dti + mat( 279) = mat( 279) - dti + mat( 287) = mat( 287) - dti + mat( 295) = mat( 295) - dti + mat( 304) = mat( 304) - dti + mat( 312) = mat( 312) - dti + mat( 318) = mat( 318) - dti + mat( 327) = mat( 327) - dti + mat( 331) = mat( 331) - dti + mat( 338) = mat( 338) - dti + mat( 346) = mat( 346) - dti + mat( 357) = mat( 357) - dti + mat( 366) = mat( 366) - dti + mat( 380) = mat( 380) - dti + mat( 391) = mat( 391) - dti + mat( 397) = mat( 397) - dti + mat( 402) = mat( 402) - dti + mat( 412) = mat( 412) - dti + mat( 420) = mat( 420) - dti + mat( 429) = mat( 429) - dti + mat( 440) = mat( 440) - dti + mat( 448) = mat( 448) - dti + mat( 456) = mat( 456) - dti + mat( 467) = mat( 467) - dti + mat( 477) = mat( 477) - dti + mat( 489) = mat( 489) - dti + mat( 501) = mat( 501) - dti + mat( 511) = mat( 511) - dti + mat( 520) = mat( 520) - dti + mat( 534) = mat( 534) - dti + mat( 552) = mat( 552) - dti + mat( 558) = mat( 558) - dti + mat( 568) = mat( 568) - dti + mat( 581) = mat( 581) - dti + mat( 594) = mat( 594) - dti + mat( 609) = mat( 609) - dti + mat( 614) = mat( 614) - dti + mat( 625) = mat( 625) - dti + mat( 637) = mat( 637) - dti + mat( 644) = mat( 644) - dti + mat( 657) = mat( 657) - dti + mat( 669) = mat( 669) - dti + mat( 684) = mat( 684) - dti + mat( 707) = mat( 707) - dti + mat( 731) = mat( 731) - dti + mat( 750) = mat( 750) - dti + mat( 770) = mat( 770) - dti + mat( 799) = mat( 799) - dti + mat( 816) = mat( 816) - dti + mat( 843) = mat( 843) - dti + mat( 856) = mat( 856) - dti + mat( 870) = mat( 870) - dti + mat( 890) = mat( 890) - dti + mat( 912) = mat( 912) - dti + mat( 971) = mat( 971) - dti + mat(1013) = mat(1013) - dti + mat(1054) = mat(1054) - dti + mat(1079) = mat(1079) - dti + mat(1179) = mat(1179) - dti + mat(1223) = mat(1223) - dti + mat(1245) = mat(1245) - dti + mat(1263) = mat(1263) - dti + mat(1337) = mat(1337) - dti + mat(1362) = mat(1362) - dti + mat(1398) = mat(1398) - dti + mat(1433) = mat(1433) - dti + mat(1471) = mat(1471) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat05( mat, y, rxt ) + call nlnmat06( mat, y, rxt ) + call nlnmat07( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 new file mode 100644 index 0000000000..c025fefbe8 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 94) = p_rate(:,k, 94) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 98) = p_rate(:,k, 98) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 99) = p_rate(:,k, 99) * inv(:,k, 2) * im(:,k) + p_rate(:,k,101) = p_rate(:,k,101) * inv(:,k, 2) * im(:,k) + p_rate(:,k,106) = p_rate(:,k,106) * inv(:,k, 2) * im(:,k) + p_rate(:,k,110) = p_rate(:,k,110) * inv(:,k, 2) * im(:,k) + p_rate(:,k,111) = p_rate(:,k,111) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 new file mode 100644 index 0000000000..c12b8d4f7c --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_prod_loss.F90 @@ -0,0 +1,819 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = ( + het_rates(:,:,180))* y(:,:,180) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,153) +rxt(:,:,154) +rxt(:,:,155))* y(:,:,3) & + +rxt(:,:,263)* y(:,:,23) +rxt(:,:,210)* y(:,:,28) +rxt(:,:,249) & + * y(:,:,141) + rxt(:,:,59) + rxt(:,:,60) + het_rates(:,:,15)) & + * y(:,:,15) + prod(:,:,2) = 0._r8 + loss(:,:,3) = ((rxt(:,:,132) +rxt(:,:,133))* y(:,:,3) + rxt(:,:,5) & + + het_rates(:,:,7))* y(:,:,7) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,252)* y(:,:,23) +rxt(:,:,251)* y(:,:,28) + rxt(:,:,37) & + + het_rates(:,:,108))* y(:,:,108) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,144)* y(:,:,3) +rxt(:,:,255)* y(:,:,23) +rxt(:,:,256) & + * y(:,:,28) + rxt(:,:,48) + het_rates(:,:,109))* y(:,:,109) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,135)* y(:,:,3) + rxt(:,:,40) + het_rates(:,:,110)) & + * y(:,:,110) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,136)* y(:,:,3) + rxt(:,:,41) + het_rates(:,:,111)) & + * y(:,:,111) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,137)* y(:,:,3) + rxt(:,:,42) + het_rates(:,:,112)) & + * y(:,:,112) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,138)* y(:,:,3) + rxt(:,:,43) + het_rates(:,:,120)) & + * y(:,:,120) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,139)* y(:,:,3) + rxt(:,:,44) + het_rates(:,:,121)) & + * y(:,:,121) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,140)* y(:,:,3) +rxt(:,:,254)* y(:,:,23) + rxt(:,:,45) & + + het_rates(:,:,113))* y(:,:,113) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,141)* y(:,:,3) +rxt(:,:,257)* y(:,:,23) + rxt(:,:,46) & + + het_rates(:,:,118))* y(:,:,118) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,142)* y(:,:,3) +rxt(:,:,258)* y(:,:,23) + rxt(:,:,47) & + + het_rates(:,:,119))* y(:,:,119) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,143)* y(:,:,3) + rxt(:,:,38) + het_rates(:,:,114)) & + * y(:,:,114) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,253)* y(:,:,23) + rxt(:,:,39) + het_rates(:,:,115)) & + * y(:,:,115) + prod(:,:,15) = 0._r8 + loss(:,:,16) = (rxt(:,:,146)* y(:,:,3) + rxt(:,:,49) + het_rates(:,:,116)) & + * y(:,:,116) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,145)* y(:,:,3) + rxt(:,:,50) + het_rates(:,:,117)) & + * y(:,:,117) + prod(:,:,17) = 0._r8 + loss(:,:,18) = (rxt(:,:,147)* y(:,:,3) + rxt(:,:,53) + het_rates(:,:,122)) & + * y(:,:,122) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,148)* y(:,:,3) + rxt(:,:,54) + het_rates(:,:,123)) & + * y(:,:,123) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,149)* y(:,:,3) +rxt(:,:,260)* y(:,:,23) +rxt(:,:,262) & + * y(:,:,28) + rxt(:,:,51) + het_rates(:,:,124))* y(:,:,124) + prod(:,:,20) = 0._r8 + loss(:,:,21) = (rxt(:,:,150)* y(:,:,3) +rxt(:,:,259)* y(:,:,23) +rxt(:,:,261) & + * y(:,:,28) + rxt(:,:,52) + het_rates(:,:,125))* y(:,:,125) + prod(:,:,21) = 0._r8 + loss(:,:,22) = (rxt(:,:,453)* y(:,:,130) + rxt(:,:,58) + rxt(:,:,114) & + + het_rates(:,:,126))* y(:,:,126) + prod(:,:,22) =.440_r8*rxt(:,:,60)*y(:,:,15) + loss(:,:,23) = ( + het_rates(:,:,26))* y(:,:,26) + prod(:,:,23) = 0._r8 + loss(:,:,24) = ( + het_rates(:,:,27))* y(:,:,27) + prod(:,:,24) = 0._r8 + loss(:,:,25) = ( + rxt(:,:,470) + het_rates(:,:,181))* y(:,:,181) + prod(:,:,25) = 0._r8 + loss(:,:,26) = ( + rxt(:,:,471) + het_rates(:,:,182))* y(:,:,182) + prod(:,:,26) = 0._r8 + loss(:,:,27) = ( + rxt(:,:,472) + het_rates(:,:,183))* y(:,:,183) + prod(:,:,27) = 0._r8 + loss(:,:,28) = ( + rxt(:,:,464) + het_rates(:,:,170))* y(:,:,170) + prod(:,:,28) = 0._r8 + loss(:,:,29) = ( + rxt(:,:,465) + het_rates(:,:,171))* y(:,:,171) + prod(:,:,29) = 0._r8 + loss(:,:,30) = ( + rxt(:,:,466) + het_rates(:,:,172))* y(:,:,172) + prod(:,:,30) = 0._r8 + loss(:,:,31) = ( + het_rates(:,:,173))* y(:,:,173) + prod(:,:,31) = 0._r8 + loss(:,:,32) = ( + rxt(:,:,467) + het_rates(:,:,174))* y(:,:,174) + prod(:,:,32) = 0._r8 + loss(:,:,33) = ( + rxt(:,:,468) + het_rates(:,:,175))* y(:,:,175) + prod(:,:,33) = 0._r8 + loss(:,:,34) = ( + rxt(:,:,469) + het_rates(:,:,176))* y(:,:,176) + prod(:,:,34) = 0._r8 + loss(:,:,35) = ( + rxt(:,:,431) + het_rates(:,:,177))* y(:,:,177) + prod(:,:,35) = 0._r8 + loss(:,:,36) = ( + rxt(:,:,87) + het_rates(:,:,178))* y(:,:,178) + prod(:,:,36) = 0._r8 + loss(:,:,37) = ( + rxt(:,:,88) + het_rates(:,:,179))* y(:,:,179) + prod(:,:,37) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(139) = (rxt(116)* y(2) +rxt(134)* y(3) +rxt(189)* y(9) +rxt(192)* y(10) & + +rxt(161)* y(22) +rxt(166)* y(23) +rxt(174)* y(24) +rxt(204)* y(28) & + +rxt(231)* y(37) +rxt(290)* y(44) +rxt(311)* y(59) +rxt(333)* y(77) & + +rxt(339)* y(78) +rxt(357)* y(83) +rxt(395)* y(105) + rxt(3) & + + rxt(4) + het_rates(1))* y(1) + prod(139) = (.200_r8*rxt(333)*y(77) +.200_r8*rxt(339)*y(78) + & + .100_r8*rxt(357)*y(83))*y(1) + (.250_r8*rxt(301)*y(48) + & + .250_r8*rxt(349)*y(76))*y(24) +rxt(115)*y(4)*y(2) + loss(146) = (rxt(116)* y(1) + 2._r8*rxt(117)* y(2) +rxt(115)* y(4) +rxt(187) & + * y(9) + (rxt(190) +rxt(191))* y(10) +rxt(198)* y(11) +rxt(268) & + * y(19) +rxt(172)* y(21) +rxt(165)* y(23) +rxt(173)* y(24) +rxt(176) & + * y(25) +rxt(211)* y(30) +rxt(224)* y(33) +rxt(225)* y(34) +rxt(228) & + * y(35) +rxt(234)* y(38) +rxt(244)* y(39) +rxt(245)* y(40) +rxt(246) & + * y(41) + (rxt(451) +rxt(452))* y(127) +rxt(458)* y(129) + rxt(89) & + + rxt(90) + rxt(91) + rxt(102) + rxt(103) + rxt(104) + het_rates(2)) & + * y(2) + prod(146) = (rxt(1) +2.000_r8*rxt(2) +rxt(95) +rxt(96) +rxt(97) + & + 2.000_r8*rxt(100) +rxt(107) +rxt(108) +rxt(109) +2.000_r8*rxt(112) + & + rxt(129)*y(3) +rxt(130)*y(3) +rxt(182)*y(8) +rxt(449)*y(130) + & + rxt(457)*y(129))*y(4) + (rxt(183)*y(9) +rxt(184)*y(10) + & + rxt(454)*y(128))*y(8) + (rxt(461)*y(131) +1.150_r8*rxt(462)*y(128)) & + *y(132) +rxt(4)*y(1) +rxt(128)*y(3) +rxt(6)*y(9) +rxt(8)*y(10) & + +rxt(12)*y(11) +rxt(10)*y(14) +rxt(164)*y(24)*y(22) +rxt(168)*y(23) & + *y(23) +rxt(24)*y(30) +rxt(25)*y(31) +rxt(32)*y(38) +rxt(21)*y(134) + loss(143) = (rxt(134)* y(1) + (rxt(129) +rxt(130))* y(4) + (rxt(132) + & + rxt(133))* y(7) + (rxt(153) +rxt(154) +rxt(155))* y(15) +rxt(156) & + * y(21) +rxt(157)* y(33) +rxt(158)* y(39) +rxt(159)* y(42) +rxt(144) & + * y(109) +rxt(135)* y(110) +rxt(136)* y(111) +rxt(137)* y(112) & + +rxt(140)* y(113) +rxt(143)* y(114) +rxt(146)* y(116) +rxt(145) & + * y(117) +rxt(141)* y(118) +rxt(142)* y(119) +rxt(138)* y(120) & + +rxt(139)* y(121) +rxt(147)* y(122) +rxt(148)* y(123) +rxt(149) & + * y(124) +rxt(150)* y(125) +rxt(131)* y(134) +rxt(151)* y(138) & + +rxt(152)* y(139) + rxt(128) + het_rates(3))* y(3) + prod(143) = (rxt(1) +rxt(179)*y(133))*y(4) +rxt(3)*y(1) & + +.850_r8*rxt(462)*y(132)*y(128) +rxt(20)*y(134) + loss(129) = (rxt(115)* y(2) +rxt(129)* y(3) +rxt(125)* y(6) +rxt(182)* y(8) & + +rxt(160)* y(22) +rxt(288)* y(56) +rxt(459)* y(127) + (rxt(456) + & + rxt(457))* y(129) +rxt(449)* y(130) +rxt(179)* y(133) + rxt(1) & + + rxt(2) + rxt(93) + rxt(95) + rxt(96) + rxt(97) + rxt(100) & + + rxt(105) + rxt(107) + rxt(108) + rxt(109) + rxt(112) & + + het_rates(4))* y(4) + prod(129) = (rxt(163)*y(22) +rxt(167)*y(23) +rxt(173)*y(2) + & + 2.000_r8*rxt(174)*y(1) +rxt(175)*y(24) +rxt(200)*y(11) + & + rxt(207)*y(28) +rxt(214)*y(30) +rxt(232)*y(37) +rxt(236)*y(38) + & + rxt(271)*y(16) +rxt(293)*y(46) +rxt(314)*y(61) +rxt(319)*y(64) + & + rxt(323)*y(67) +.750_r8*rxt(349)*y(76))*y(24) + (rxt(4) + & + 2.000_r8*rxt(116)*y(2) +2.000_r8*rxt(134)*y(3) +rxt(161)*y(22) + & + rxt(166)*y(23) +rxt(189)*y(9) +rxt(192)*y(10) +rxt(204)*y(28) + & + rxt(231)*y(37))*y(1) + (rxt(117)*y(2) +rxt(124)*y(6) + & + rxt(165)*y(23) +rxt(190)*y(10) +rxt(198)*y(11) +rxt(211)*y(30) + & + rxt(234)*y(38))*y(2) + (rxt(213)*y(23) +rxt(218)*y(30) + & + rxt(219)*y(30) +rxt(240)*y(38) +rxt(241)*y(38))*y(30) + (rxt(126) + & + rxt(127) +2.000_r8*rxt(125)*y(4))*y(6) +rxt(133)*y(7)*y(3) +rxt(123) & + *y(5) +rxt(186)*y(10)*y(8) +rxt(455)*y(128)*y(9) +rxt(13)*y(11) & + +rxt(202)*y(23)*y(13) +rxt(242)*y(38)*y(38) + loss(43) = (rxt(121)* y(1) +rxt(118)* y(2) +rxt(119)* y(4) +rxt(122)* y(126) & + + rxt(120) + rxt(123) + het_rates(5))* y(5) + prod(43) =rxt(129)*y(4)*y(3) + loss(42) = (rxt(124)* y(2) +rxt(125)* y(4) + rxt(126) + rxt(127) & + + het_rates(6))* y(6) + prod(42) = (rxt(120) +rxt(122)*y(126) +rxt(118)*y(2) +rxt(119)*y(4) + & + rxt(121)*y(1))*y(5) +rxt(3)*y(1) + loss(120) = (rxt(172)* y(2) +rxt(156)* y(3) +rxt(170)* y(23) +rxt(205)* y(28) & + +rxt(248)* y(141) + het_rates(21))* y(21) + prod(120) =rxt(155)*y(15)*y(3) +rxt(18)*y(19) +rxt(163)*y(24)*y(22) +rxt(20) & + *y(134) + loss(115) = ((rxt(264) +rxt(265))* y(23) + het_rates(20))* y(20) + prod(115) = (rxt(17) +rxt(18) +rxt(209)*y(28) +rxt(233)*y(37) + & + rxt(266)*y(11) +rxt(267)*y(23) +rxt(268)*y(2))*y(19) & + + (.500_r8*rxt(290)*y(44) +.560_r8*rxt(311)*y(59) + & + .050_r8*rxt(333)*y(77) +.200_r8*rxt(339)*y(78) + & + .300_r8*rxt(357)*y(83))*y(1) + (.220_r8*rxt(340)*y(9) + & + .220_r8*rxt(342)*y(11) +.110_r8*rxt(344)*y(16) + & + .220_r8*rxt(345)*y(48))*y(79) + (.250_r8*rxt(375)*y(9) + & + .500_r8*rxt(376)*y(11) +.200_r8*rxt(378)*y(16) + & + .250_r8*rxt(379)*y(48))*y(91) + (.350_r8*rxt(283)*y(135) + & + rxt(306)*y(53) +rxt(327)*y(68))*y(23) + (rxt(74) +rxt(328)*y(11)) & + *y(68) +rxt(251)*y(108)*y(28) +rxt(61)*y(50) +rxt(79)*y(52) & + +2.000_r8*rxt(82)*y(53) +.700_r8*rxt(68)*y(77) +1.340_r8*rxt(67) & + *y(78) +.450_r8*rxt(81)*y(86) +rxt(76)*y(90) +rxt(453)*y(130)*y(126) + loss(105) = (rxt(182)* y(4) +rxt(183)* y(9) + (rxt(184) +rxt(185) +rxt(186)) & + * y(10) +rxt(181)* y(23) +rxt(454)* y(128) + rxt(92) + het_rates(8)) & + * y(8) + prod(105) = (rxt(180)*y(133) +rxt(458)*y(129))*y(2) & + + (.200_r8*rxt(461)*y(131) +1.100_r8*rxt(463)*y(127))*y(132) & + +rxt(456)*y(129)*y(4) +rxt(6)*y(9) +rxt(450)*y(130) + loss(134) = (rxt(189)* y(1) +rxt(187)* y(2) +rxt(183)* y(8) +rxt(197)* y(11) & + +rxt(270)* y(16) +rxt(188)* y(24) +rxt(216)* y(30) +rxt(237)* y(38) & + +rxt(292)* y(46) +rxt(299)* y(48) +rxt(286)* y(55) +rxt(313)* y(61) & + +rxt(318)* y(64) +rxt(322)* y(67) +rxt(331)* y(73) +rxt(335)* y(74) & + +rxt(347)* y(76) + (rxt(340) +rxt(341))* y(79) +rxt(372)* y(84) & + +rxt(359)* y(88) +rxt(365)* y(89) +rxt(375)* y(91) +rxt(383)* y(96) & + +rxt(390)* y(100) +rxt(393)* y(103) +rxt(397)* y(106) +rxt(455) & + * y(128) +rxt(278)* y(137) + rxt(6) + rxt(7) + het_rates(9))* y(9) + prod(134) = (rxt(8) +.500_r8*rxt(402) +2.000_r8*rxt(185)*y(8) +rxt(190)*y(2)) & + *y(10) + (rxt(179)*y(133) +rxt(182)*y(8))*y(4) & + +2.000_r8*rxt(132)*y(7)*y(3) +rxt(181)*y(23)*y(8) +rxt(13)*y(11) & + +rxt(10)*y(14) +rxt(460)*y(128) + loss(144) = (rxt(192)* y(1) + (rxt(190) +rxt(191))* y(2) + (rxt(184) + & + rxt(185) +rxt(186))* y(8) +rxt(193)* y(11) +rxt(195)* y(23) +rxt(201) & + * y(24) +rxt(217)* y(30) +rxt(238)* y(38) +rxt(300)* y(48) +rxt(353) & + * y(76) +rxt(387)* y(98) + rxt(8) + rxt(402) + het_rates(10))* y(10) + prod(144) = (rxt(187)*y(2) +rxt(188)*y(24) +rxt(189)*y(1) + & + 2.000_r8*rxt(197)*y(11) +rxt(216)*y(30) +rxt(237)*y(38) + & + rxt(270)*y(16) +rxt(278)*y(137) +rxt(286)*y(55) +rxt(292)*y(46) + & + rxt(299)*y(48) +rxt(313)*y(61) +rxt(318)*y(64) +rxt(322)*y(67) + & + rxt(331)*y(73) +rxt(335)*y(74) +rxt(340)*y(79) +rxt(347)*y(76) + & + .920_r8*rxt(359)*y(88) +1.206_r8*rxt(365)*y(89) + & + .900_r8*rxt(372)*y(84) +rxt(375)*y(91) +.900_r8*rxt(383)*y(96) + & + .900_r8*rxt(390)*y(100) +.900_r8*rxt(393)*y(103) +rxt(397)*y(106)) & + *y(9) + (rxt(12) +rxt(198)*y(2) +rxt(199)*y(23) +rxt(200)*y(24) + & + rxt(342)*y(79) +rxt(348)*y(76) +rxt(360)*y(88) + & + 1.206_r8*rxt(366)*y(89) +rxt(370)*y(90) +rxt(376)*y(91) + & + rxt(396)*y(105))*y(11) + (rxt(15) +rxt(203) +rxt(202)*y(23))*y(13) & + + (rxt(9) +rxt(194))*y(14) + (rxt(329)*y(82) + & + .400_r8*rxt(369)*y(90))*y(23) + (.600_r8*rxt(64) +rxt(308))*y(58) & + + (rxt(65) +rxt(354))*y(81) +.700_r8*rxt(387)*y(98)*y(10) +rxt(11) & + *y(12) +.206_r8*rxt(367)*y(89)*y(24) +rxt(30)*y(35) +rxt(36)*y(41) & + +rxt(76)*y(90) + loss(138) = (rxt(166)* y(1) +rxt(165)* y(2) +rxt(181)* y(8) +rxt(195)* y(10) & + +rxt(199)* y(11) +rxt(196)* y(12) +rxt(202)* y(13) +rxt(263)* y(15) & + +rxt(275)* y(17) +rxt(274)* y(18) +rxt(267)* y(19) + (rxt(264) + & + rxt(265))* y(20) +rxt(170)* y(21) + 2._r8*(rxt(168) +rxt(169))* y(23) & + +rxt(167)* y(24) +rxt(171)* y(25) + (rxt(212) +rxt(213))* y(30) & + +rxt(223)* y(33) +rxt(227)* y(34) +rxt(229)* y(35) +rxt(235)* y(38) & + +rxt(243)* y(39) +rxt(177)* y(42) +rxt(178)* y(43) +rxt(285)* y(44) & + +rxt(284)* y(45) +rxt(296)* y(47) +rxt(291)* y(49) +rxt(297)* y(50) & + +rxt(307)* y(51) +rxt(305)* y(52) +rxt(306)* y(53) +rxt(304)* y(54) & + +rxt(309)* y(58) +rxt(310)* y(59) +rxt(317)* y(60) +rxt(316)* y(62) & + +rxt(321)* y(63) +rxt(320)* y(65) +rxt(326)* y(66) +rxt(327)* y(68) & + +rxt(325)* y(69) +rxt(330)* y(70) +rxt(368)* y(71) +rxt(334)* y(72) & + +rxt(337)* y(75) +rxt(332)* y(77) +rxt(338)* y(78) +rxt(346)* y(80) & + +rxt(355)* y(81) +rxt(329)* y(82) +rxt(356)* y(83) +rxt(374)* y(85) & + +rxt(371)* y(87) +rxt(369)* y(90) +rxt(380)* y(92) +rxt(362)* y(93) & + +rxt(382)* y(94) +rxt(386)* y(95) +rxt(385)* y(97) +rxt(388)* y(99) & + +rxt(391)* y(102) +rxt(394)* y(105) +rxt(399)* y(107) +rxt(252) & + * y(108) +rxt(255)* y(109) +rxt(254)* y(113) +rxt(253)* y(115) & + +rxt(257)* y(118) +rxt(258)* y(119) +rxt(260)* y(124) +rxt(259) & + * y(125) +rxt(283)* y(135) +rxt(276)* y(136) +rxt(404)* y(156) & + + (rxt(405) +rxt(406))* y(157) +rxt(408)* y(159) + het_rates(23)) & + * y(23) + prod(138) = (rxt(161)*y(22) +rxt(174)*y(24) +.120_r8*rxt(290)*y(44) + & + .330_r8*rxt(311)*y(59) +.080_r8*rxt(333)*y(77) + & + .215_r8*rxt(339)*y(78) +.270_r8*rxt(357)*y(83) + & + .700_r8*rxt(395)*y(105))*y(1) + (rxt(172)*y(21) +rxt(173)*y(24) + & + rxt(176)*y(25) +rxt(224)*y(33) +rxt(225)*y(34) +rxt(244)*y(39) + & + rxt(245)*y(40) +rxt(268)*y(19))*y(2) + (rxt(153)*y(15) + & + 2.000_r8*rxt(131)*y(134) +rxt(156)*y(21) +rxt(157)*y(33) + & + rxt(158)*y(39) +rxt(159)*y(42))*y(3) + (.300_r8*rxt(275)*y(17) + & + .650_r8*rxt(283)*y(135) +.500_r8*rxt(296)*y(47) + & + .500_r8*rxt(320)*y(65) +.100_r8*rxt(346)*y(80))*y(23) & + + (2.000_r8*rxt(162)*y(22) +rxt(188)*y(9) +rxt(200)*y(11) + & + rxt(208)*y(28) +.206_r8*rxt(367)*y(89))*y(24) + (rxt(19) + & + rxt(247)*y(141))*y(134) +.500_r8*rxt(402)*y(10) +rxt(11)*y(12) & + +rxt(14)*y(13) +rxt(16)*y(17) +2.000_r8*rxt(22)*y(25) +rxt(27)*y(34) & + +rxt(33)*y(40) +rxt(69)*y(47) +rxt(63)*y(54) +rxt(70)*y(57) +rxt(71) & + *y(62) +rxt(62)*y(65) +rxt(72)*y(69) +rxt(84)*y(75) +rxt(83)*y(85) & + +rxt(75)*y(92) +rxt(85)*y(97) +rxt(86)*y(107) + loss(135) = (rxt(198)* y(2) +rxt(197)* y(9) +rxt(193)* y(10) +rxt(266)* y(19) & + +rxt(199)* y(23) +rxt(200)* y(24) +rxt(298)* y(50) +rxt(312)* y(59) & + +rxt(328)* y(68) +rxt(348)* y(76) +rxt(342)* y(79) +rxt(358)* y(83) & + +rxt(360)* y(88) +rxt(366)* y(89) +rxt(370)* y(90) +rxt(376)* y(91) & + +rxt(396)* y(105) +rxt(407)* y(157) + rxt(12) + rxt(13) + rxt(401) & + + het_rates(11))* y(11) + prod(135) = (rxt(196)*y(12) +rxt(229)*y(35) +rxt(309)*y(58) + & + .500_r8*rxt(355)*y(81))*y(23) + (rxt(191)*y(10) +rxt(228)*y(35) + & + rxt(246)*y(41))*y(2) + (rxt(9) +rxt(10) +rxt(194))*y(14) + (rxt(29) + & + rxt(230)*y(28))*y(35) +rxt(192)*y(10)*y(1) +rxt(250)*y(141)*y(12) & + +rxt(14)*y(13) +rxt(35)*y(41) +.400_r8*rxt(64)*y(58) + loss(131) = (rxt(196)* y(23) +rxt(250)* y(141) + rxt(11) + het_rates(12)) & + * y(12) + prod(131) = (rxt(433) +rxt(439) +rxt(444) +rxt(435)*y(33) +rxt(440)*y(33) + & + rxt(446)*y(33))*y(35) + (rxt(401) +rxt(266)*y(19) +rxt(298)*y(50) + & + rxt(328)*y(68) +rxt(407)*y(157))*y(11) + (2.000_r8*rxt(400) + & + 2.000_r8*rxt(432) +2.000_r8*rxt(438) +2.000_r8*rxt(443))*y(14) & + + (rxt(434) +rxt(442) +rxt(445))*y(41) + (.500_r8*rxt(402) + & + rxt(195)*y(23))*y(10) + loss(73) = (rxt(202)* y(23) + rxt(14) + rxt(15) + rxt(203) + het_rates(13)) & + * y(13) + prod(73) =rxt(201)*y(24)*y(10) + loss(55) = ( + rxt(9) + rxt(10) + rxt(194) + rxt(400) + rxt(432) + rxt(438) & + + rxt(443) + het_rates(14))* y(14) + prod(55) =rxt(193)*y(11)*y(10) + loss(136) = (rxt(270)* y(9) + 2._r8*(rxt(272) +rxt(273))* y(16) +rxt(271) & + * y(24) +rxt(215)* y(30) +rxt(294)* y(46) +rxt(302)* y(48) +rxt(315) & + * y(61) +rxt(324)* y(67) +rxt(350)* y(76) +rxt(344)* y(79) +rxt(363) & + * y(88) +rxt(378)* y(91) + het_rates(16))* y(16) + prod(136) = (rxt(299)*y(9) +.900_r8*rxt(302)*y(16) +2.000_r8*rxt(303)*y(48) + & + rxt(345)*y(79) +rxt(351)*y(76) +rxt(364)*y(88) +rxt(379)*y(91))*y(48) & + + (rxt(153)*y(3) +rxt(210)*y(28) +rxt(249)*y(141) +rxt(263)*y(23)) & + *y(15) + (.700_r8*rxt(275)*y(17) +rxt(291)*y(49))*y(23) & + +.310_r8*rxt(311)*y(59)*y(1) +rxt(61)*y(50) +rxt(63)*y(54) & + +.400_r8*rxt(64)*y(58) +rxt(73)*y(63) +.300_r8*rxt(68)*y(77) + loss(67) = (rxt(275)* y(23) + rxt(16) + het_rates(17))* y(17) + prod(67) =rxt(271)*y(24)*y(16) + loss(47) = (rxt(159)* y(3) +rxt(177)* y(23) + het_rates(42))* y(42) + prod(47) = 0._r8 + loss(34) = (rxt(178)* y(23) + het_rates(43))* y(43) + prod(34) = 0._r8 + loss(140) = (rxt(268)* y(2) +rxt(266)* y(11) +rxt(267)* y(23) +rxt(269) & + * y(24) +rxt(209)* y(28) +rxt(233)* y(37) + rxt(17) + rxt(18) & + + het_rates(19))* y(19) + prod(140) = (rxt(215)*y(30) +rxt(270)*y(9) +2.000_r8*rxt(272)*y(16) + & + rxt(273)*y(16) +.700_r8*rxt(294)*y(46) +rxt(302)*y(48) + & + rxt(315)*y(61) +.800_r8*rxt(324)*y(67) +.880_r8*rxt(344)*y(79) + & + 2.000_r8*rxt(350)*y(76) +1.200_r8*rxt(363)*y(88) + & + .800_r8*rxt(378)*y(91))*y(16) + (.500_r8*rxt(286)*y(55) + & + rxt(318)*y(64) +rxt(322)*y(67) +.500_r8*rxt(331)*y(73) + & + .250_r8*rxt(340)*y(79) +rxt(347)*y(76) +.550_r8*rxt(359)*y(88) + & + .072_r8*rxt(365)*y(89) +.100_r8*rxt(372)*y(84) + & + .250_r8*rxt(375)*y(91))*y(9) + (rxt(274)*y(18) + & + .300_r8*rxt(275)*y(17) +.500_r8*rxt(304)*y(54) + & + .800_r8*rxt(305)*y(52) +rxt(309)*y(58) +.500_r8*rxt(355)*y(81))*y(23) & + + (rxt(290)*y(44) +.540_r8*rxt(311)*y(59) +.800_r8*rxt(333)*y(77) + & + .700_r8*rxt(339)*y(78) +.600_r8*rxt(357)*y(83))*y(1) & + + (.250_r8*rxt(342)*y(79) +rxt(348)*y(76) +.600_r8*rxt(360)*y(88) + & + .072_r8*rxt(366)*y(89))*y(11) + (.250_r8*rxt(345)*y(79) + & + rxt(351)*y(76) +.600_r8*rxt(364)*y(88) +.250_r8*rxt(379)*y(91))*y(48) & + + (rxt(154)*y(15) +rxt(155)*y(15))*y(3) +rxt(16)*y(17) & + +.206_r8*rxt(367)*y(89)*y(24) +rxt(79)*y(52) +2.000_r8*rxt(289) & + *y(56) +rxt(62)*y(65) +rxt(78)*y(66) +rxt(72)*y(69) & + +2.000_r8*rxt(352)*y(76)*y(76) +1.340_r8*rxt(66)*y(78) & + +.100_r8*rxt(83)*y(85) +rxt(76)*y(90) +.690_r8*rxt(77)*y(93) & + +rxt(277)*y(137) + loss(141) = (rxt(161)* y(1) +rxt(160)* y(4) + (rxt(162) +rxt(163) +rxt(164)) & + * y(24) + het_rates(22))* y(22) + prod(141) = (rxt(156)*y(3) +rxt(170)*y(23) +rxt(172)*y(2) +rxt(205)*y(28) + & + rxt(248)*y(141))*y(21) + (rxt(165)*y(2) +rxt(181)*y(8) + & + rxt(264)*y(20) +rxt(267)*y(19))*y(23) + (rxt(19) +2.000_r8*rxt(21)) & + *y(134) +rxt(154)*y(15)*y(3) +rxt(16)*y(17) +2.000_r8*rxt(17)*y(19) & + +rxt(28)*y(33) +rxt(34)*y(39) +rxt(57)*y(140) + loss(142) = (rxt(174)* y(1) +rxt(173)* y(2) +rxt(188)* y(9) +rxt(201)* y(10) & + +rxt(200)* y(11) +rxt(271)* y(16) +rxt(269)* y(19) + (rxt(162) + & + rxt(163) +rxt(164))* y(22) +rxt(167)* y(23) + 2._r8*rxt(175)* y(24) & + + (rxt(207) +rxt(208))* y(28) +rxt(214)* y(30) +rxt(232)* y(37) & + +rxt(236)* y(38) +rxt(293)* y(46) +rxt(301)* y(48) +rxt(287)* y(55) & + +rxt(314)* y(61) +rxt(319)* y(64) +rxt(323)* y(67) +rxt(336)* y(74) & + +rxt(349)* y(76) +rxt(343)* y(79) +rxt(373)* y(84) +rxt(361)* y(88) & + +rxt(367)* y(89) +rxt(377)* y(91) +rxt(384)* y(96) +rxt(389)* y(100) & + +rxt(392)* y(103) +rxt(398)* y(106) +rxt(279)* y(137) + rxt(410) & + + het_rates(24))* y(24) + prod(142) = (rxt(252)*y(108) +rxt(255)*y(109) +rxt(166)*y(1) + & + rxt(171)*y(25) +rxt(177)*y(42) +rxt(178)*y(43) +rxt(199)*y(11) + & + rxt(212)*y(30) +rxt(235)*y(38) +rxt(265)*y(20) +rxt(274)*y(18) + & + rxt(276)*y(136) +.350_r8*rxt(283)*y(135) +rxt(305)*y(52) + & + rxt(306)*y(53) +rxt(307)*y(51) +rxt(326)*y(66) + & + .200_r8*rxt(346)*y(80) +.500_r8*rxt(355)*y(81) +rxt(369)*y(90) + & + .250_r8*rxt(382)*y(94) +.500_r8*rxt(406)*y(157))*y(23) & + + (rxt(270)*y(16) +rxt(278)*y(137) +.250_r8*rxt(286)*y(55) + & + rxt(292)*y(46) +rxt(313)*y(61) +rxt(318)*y(64) +rxt(331)*y(73) + & + .470_r8*rxt(340)*y(79) +.920_r8*rxt(359)*y(88) + & + .794_r8*rxt(365)*y(89) +.900_r8*rxt(372)*y(84) +rxt(375)*y(91) + & + .900_r8*rxt(383)*y(96) +.900_r8*rxt(390)*y(100) + & + .900_r8*rxt(393)*y(103) +rxt(397)*y(106))*y(9) + (rxt(215)*y(30) + & + 2.000_r8*rxt(272)*y(16) +rxt(294)*y(46) +.900_r8*rxt(302)*y(48) + & + rxt(315)*y(61) +.300_r8*rxt(324)*y(67) +.730_r8*rxt(344)*y(79) + & + rxt(350)*y(76) +rxt(363)*y(88) +.800_r8*rxt(378)*y(91))*y(16) & + + (.120_r8*rxt(290)*y(44) +.190_r8*rxt(311)*y(59) + & + .060_r8*rxt(333)*y(77) +.275_r8*rxt(339)*y(78) + & + .060_r8*rxt(357)*y(83) +rxt(395)*y(105))*y(1) + (rxt(266)*y(19) + & + .470_r8*rxt(342)*y(79) +rxt(360)*y(88) +.794_r8*rxt(366)*y(89) + & + rxt(370)*y(90) +rxt(376)*y(91))*y(11) + (rxt(251)*y(108) + & + rxt(256)*y(109) +rxt(206)*y(25) +rxt(209)*y(19))*y(28) & + + (.470_r8*rxt(345)*y(79) +rxt(364)*y(88) +rxt(379)*y(91))*y(48) & + + (rxt(176)*y(25) +rxt(268)*y(19))*y(2) + (rxt(160)*y(22) + & + rxt(288)*y(56))*y(4) + (rxt(15) +rxt(203))*y(13) & + + (1.340_r8*rxt(66) +.660_r8*rxt(67))*y(78) +rxt(154)*y(15)*y(3) & + +.700_r8*rxt(387)*y(98)*y(10) +rxt(233)*y(37)*y(19) & + +1.200_r8*rxt(295)*y(46)*y(46) +rxt(69)*y(47) +rxt(61)*y(50) & + +2.000_r8*rxt(79)*y(52) +2.000_r8*rxt(82)*y(53) +rxt(289)*y(56) & + +rxt(71)*y(62) +rxt(62)*y(65) +rxt(78)*y(66) +rxt(74)*y(68) & + +.900_r8*rxt(83)*y(85) +.560_r8*rxt(81)*y(86) +rxt(76)*y(90) & + +rxt(77)*y(93) +rxt(86)*y(107) +rxt(277)*y(137) + loss(89) = (rxt(176)* y(2) +rxt(171)* y(23) +rxt(206)* y(28) + rxt(22) & + + het_rates(25))* y(25) + prod(89) = (.500_r8*rxt(410) +rxt(175)*y(24))*y(24) +rxt(169)*y(23)*y(23) + loss(130) = (rxt(131)* y(3) +rxt(247)* y(141) + rxt(19) + rxt(20) + rxt(21) & + + het_rates(134))* y(134) + prod(130) = (rxt(252)*y(108) +rxt(253)*y(115) +rxt(254)*y(113) + & + rxt(255)*y(109) +rxt(259)*y(125) +rxt(263)*y(15) +rxt(167)*y(24) + & + rxt(168)*y(23) +rxt(170)*y(21) +rxt(171)*y(25) +rxt(196)*y(12) + & + rxt(202)*y(13) +rxt(223)*y(33) +rxt(227)*y(34) +rxt(243)*y(39) + & + rxt(267)*y(19) +rxt(275)*y(17) +rxt(276)*y(136) +rxt(284)*y(45) + & + rxt(291)*y(49) +rxt(297)*y(50) +rxt(304)*y(54) +rxt(316)*y(62) + & + rxt(317)*y(60) +rxt(320)*y(65) +rxt(321)*y(63) +rxt(325)*y(69) + & + rxt(327)*y(68) +.500_r8*rxt(338)*y(78) +rxt(380)*y(92) + & + rxt(381)*y(92) +rxt(408)*y(159))*y(23) + (rxt(436)*y(34) + & + rxt(437)*y(40) +rxt(441)*y(34) +rxt(447)*y(34) +rxt(448)*y(40))*y(33) & + +rxt(164)*y(24)*y(22) + loss(145) = (rxt(204)* y(1) +rxt(210)* y(15) +rxt(209)* y(19) +rxt(205) & + * y(21) + (rxt(207) +rxt(208))* y(24) +rxt(206)* y(25) +rxt(226) & + * y(34) +rxt(230)* y(35) +rxt(282)* y(45) +rxt(251)* y(108) +rxt(256) & + * y(109) +rxt(262)* y(124) +rxt(261)* y(125) + het_rates(28))* y(28) + prod(145) = (2.000_r8*rxt(135)*y(110) +2.000_r8*rxt(136)*y(111) + & + 2.000_r8*rxt(137)*y(112) +2.000_r8*rxt(138)*y(120) +rxt(139)*y(121) + & + rxt(140)*y(113) +rxt(141)*y(118) +rxt(142)*y(119) + & + 4.000_r8*rxt(143)*y(114) +rxt(145)*y(117) +rxt(152)*y(139) + & + rxt(157)*y(33))*y(3) + (rxt(24) +rxt(211)*y(2) +rxt(212)*y(23) + & + rxt(215)*y(16) +rxt(216)*y(9) +2.000_r8*rxt(218)*y(30) + & + rxt(220)*y(30) +rxt(240)*y(38))*y(30) + (rxt(252)*y(108) + & + 3.000_r8*rxt(253)*y(115) +rxt(254)*y(113) +rxt(257)*y(118) + & + rxt(258)*y(119) +rxt(223)*y(33))*y(23) + (rxt(28) +rxt(224)*y(2)) & + *y(33) +2.000_r8*rxt(23)*y(29) +2.000_r8*rxt(26)*y(32) +rxt(27)*y(34) & + +rxt(29)*y(35) +rxt(31)*y(36) +rxt(56)*y(139) + loss(44) = ( + rxt(23) + het_rates(29))* y(29) + prod(44) = (rxt(435)*y(35) +rxt(436)*y(34) +rxt(440)*y(35) +rxt(441)*y(34) + & + rxt(446)*y(35) +rxt(447)*y(34))*y(33) +rxt(230)*y(35)*y(28) & + +rxt(219)*y(30)*y(30) + loss(132) = (rxt(211)* y(2) +rxt(216)* y(9) +rxt(217)* y(10) +rxt(215)* y(16) & + + (rxt(212) +rxt(213))* y(23) +rxt(214)* y(24) + 2._r8*(rxt(218) + & + rxt(219) +rxt(220) +rxt(221))* y(30) + (rxt(239) +rxt(240) +rxt(241)) & + * y(38) + rxt(24) + het_rates(30))* y(30) + prod(132) = (rxt(204)*y(1) +rxt(208)*y(24) +rxt(226)*y(34))*y(28) & + + (rxt(225)*y(34) +rxt(228)*y(35))*y(2) +rxt(227)*y(34)*y(23) & + +rxt(25)*y(31) +2.000_r8*rxt(222)*y(32) +rxt(30)*y(35) + loss(37) = ( + rxt(25) + het_rates(31))* y(31) + prod(37) = (rxt(220)*y(30) +rxt(239)*y(38))*y(30) + loss(28) = ( + rxt(26) + rxt(222) + het_rates(32))* y(32) + prod(28) =rxt(221)*y(30)*y(30) + loss(137) = (rxt(224)* y(2) +rxt(157)* y(3) +rxt(223)* y(23) + (rxt(436) + & + rxt(441) +rxt(447))* y(34) + (rxt(435) +rxt(440) +rxt(446))* y(35) & + + (rxt(437) +rxt(448))* y(40) + rxt(28) + het_rates(33))* y(33) + prod(137) = (rxt(210)*y(15) +2.000_r8*rxt(251)*y(108) +rxt(256)*y(109) + & + rxt(261)*y(125) +rxt(262)*y(124) +rxt(205)*y(21) +rxt(206)*y(25) + & + rxt(207)*y(24) +rxt(209)*y(19) +rxt(226)*y(34) +rxt(282)*y(45))*y(28) & + +rxt(213)*y(30)*y(23) + loss(107) = (rxt(225)* y(2) +rxt(227)* y(23) +rxt(226)* y(28) + (rxt(436) + & + rxt(441) +rxt(447))* y(33) + rxt(27) + het_rates(34))* y(34) + prod(107) = (rxt(433) +rxt(439) +rxt(444) +rxt(229)*y(23))*y(35) & + +rxt(214)*y(30)*y(24) + loss(113) = (rxt(228)* y(2) +rxt(229)* y(23) +rxt(230)* y(28) + (rxt(435) + & + rxt(440) +rxt(446))* y(33) + rxt(29) + rxt(30) + rxt(433) + rxt(439) & + + rxt(444) + het_rates(35))* y(35) + prod(113) =rxt(217)*y(30)*y(10) + loss(50) = ( + rxt(31) + het_rates(36))* y(36) + prod(50) = (rxt(437)*y(40) +rxt(448)*y(40))*y(33) +rxt(241)*y(38)*y(30) + loss(133) = (rxt(231)* y(1) +rxt(233)* y(19) +rxt(232)* y(24) & + + het_rates(37))* y(37) + prod(133) = (rxt(144)*y(109) +rxt(145)*y(117) +rxt(146)*y(116) + & + 2.000_r8*rxt(147)*y(122) +2.000_r8*rxt(148)*y(123) + & + 3.000_r8*rxt(149)*y(124) +2.000_r8*rxt(150)*y(125) +rxt(158)*y(39)) & + *y(3) + (rxt(32) +rxt(234)*y(2) +rxt(235)*y(23) +rxt(237)*y(9) + & + rxt(239)*y(30) +rxt(240)*y(30) +2.000_r8*rxt(242)*y(38))*y(38) & + + (rxt(255)*y(109) +2.000_r8*rxt(259)*y(125) + & + 3.000_r8*rxt(260)*y(124) +rxt(243)*y(39))*y(23) + (rxt(256)*y(109) + & + 2.000_r8*rxt(261)*y(125) +3.000_r8*rxt(262)*y(124))*y(28) & + + (rxt(34) +rxt(244)*y(2))*y(39) +rxt(31)*y(36) +rxt(33)*y(40) & + +rxt(35)*y(41) + loss(128) = (rxt(234)* y(2) +rxt(237)* y(9) +rxt(238)* y(10) +rxt(235)* y(23) & + +rxt(236)* y(24) + (rxt(239) +rxt(240) +rxt(241))* y(30) & + + 2._r8*rxt(242)* y(38) + rxt(32) + het_rates(38))* y(38) + prod(128) = (rxt(245)*y(40) +rxt(246)*y(41))*y(2) +rxt(231)*y(37)*y(1) & + +rxt(36)*y(41) + loss(104) = (rxt(244)* y(2) +rxt(158)* y(3) +rxt(243)* y(23) + rxt(34) & + + het_rates(39))* y(39) + prod(104) = (rxt(232)*y(24) +rxt(233)*y(19))*y(37) + loss(96) = (rxt(245)* y(2) + (rxt(437) +rxt(448))* y(33) + rxt(33) & + + het_rates(40))* y(40) + prod(96) = (rxt(434) +rxt(442) +rxt(445))*y(41) +rxt(236)*y(38)*y(24) + loss(80) = (rxt(246)* y(2) + rxt(35) + rxt(36) + rxt(434) + rxt(442) & + + rxt(445) + het_rates(41))* y(41) + prod(80) =rxt(238)*y(38)*y(10) + loss(92) = ((rxt(451) +rxt(452))* y(2) +rxt(459)* y(4) +rxt(463)* y(132) & + + het_rates(127))* y(127) + prod(92) = 0._r8 + loss(98) = (rxt(454)* y(8) +rxt(455)* y(9) +rxt(462)* y(132) + rxt(460) & + + het_rates(128))* y(128) + prod(98) = (rxt(93) +rxt(105) +rxt(449)*y(130) +rxt(456)*y(129) + & + rxt(459)*y(127))*y(4) +rxt(453)*y(130)*y(126) + loss(72) = (rxt(458)* y(2) + (rxt(456) +rxt(457))* y(4) + het_rates(129)) & + * y(129) + prod(72) =rxt(92)*y(8) + loss(88) = (rxt(449)* y(4) +rxt(453)* y(126) + rxt(450) + het_rates(130)) & + * y(130) + prod(88) = (rxt(89) +rxt(90) +rxt(91) +rxt(102) +rxt(103) +rxt(104) + & + rxt(452)*y(127) +rxt(458)*y(129))*y(2) + (rxt(95) +rxt(96) +rxt(97) + & + rxt(107) +rxt(108) +rxt(109))*y(4) + loss(99) = (rxt(461)* y(132) + het_rates(131))* y(131) + prod(99) = (rxt(460) +rxt(454)*y(8) +rxt(455)*y(9))*y(128) +rxt(451)*y(127) & + *y(2) +rxt(457)*y(129)*y(4) +rxt(7)*y(9) +rxt(450)*y(130) + loss(76) = (rxt(180)* y(2) +rxt(179)* y(4) + het_rates(133))* y(133) + prod(76) = (rxt(451)*y(2) +.900_r8*rxt(463)*y(132))*y(127) & + +.800_r8*rxt(461)*y(132)*y(131) + loss(100) = (rxt(463)* y(127) +rxt(462)* y(128) +rxt(461)* y(131) & + + het_rates(132))* y(132) + prod(100) = (rxt(93) +rxt(95) +rxt(96) +rxt(97) +rxt(105) +rxt(107) + & + rxt(108) +rxt(109))*y(4) + (rxt(89) +rxt(90) +rxt(91) +rxt(102) + & + rxt(103) +rxt(104))*y(2) +rxt(92)*y(8) +rxt(7)*y(9) + loss(114) = (rxt(311)* y(1) +rxt(312)* y(11) +rxt(310)* y(23) & + + het_rates(59))* y(59) + prod(114) =.070_r8*rxt(357)*y(83)*y(1) +.700_r8*rxt(68)*y(77) + loss(109) = (rxt(357)* y(1) +rxt(358)* y(11) +rxt(356)* y(23) & + + het_rates(83))* y(83) + prod(109) = 0._r8 + loss(103) = (rxt(318)* y(9) +rxt(319)* y(24) + het_rates(64))* y(64) + prod(103) = (rxt(310)*y(59) +.500_r8*rxt(320)*y(65))*y(23) + loss(116) = (rxt(298)* y(11) +rxt(297)* y(23) + rxt(61) + het_rates(50)) & + * y(50) + prod(116) = (rxt(292)*y(46) +.270_r8*rxt(313)*y(61) +rxt(318)*y(64) + & + rxt(331)*y(73) +rxt(335)*y(74) +.400_r8*rxt(372)*y(84))*y(9) & + + (.500_r8*rxt(311)*y(59) +.040_r8*rxt(333)*y(77))*y(1) & + + (.500_r8*rxt(296)*y(47) +rxt(307)*y(51))*y(23) & + + (.800_r8*rxt(294)*y(16) +1.600_r8*rxt(295)*y(46))*y(46) +rxt(69) & + *y(47) +rxt(62)*y(65) +rxt(84)*y(75) +.400_r8*rxt(83)*y(85) + loss(87) = (rxt(291)* y(23) + het_rates(49))* y(49) + prod(87) = (.250_r8*rxt(311)*y(59) +.200_r8*rxt(357)*y(83))*y(1) & + + (.250_r8*rxt(301)*y(48) +.250_r8*rxt(349)*y(76))*y(24) & + +.100_r8*rxt(302)*y(48)*y(16) + loss(82) = (rxt(320)* y(23) + rxt(62) + het_rates(65))* y(65) + prod(82) =rxt(319)*y(64)*y(24) + loss(127) = (rxt(299)* y(9) +rxt(300)* y(10) +rxt(302)* y(16) +rxt(301) & + * y(24) + 2._r8*rxt(303)* y(48) +rxt(345)* y(79) +rxt(364)* y(88) & + +rxt(379)* y(91) + het_rates(48))* y(48) + prod(127) = (rxt(322)*y(67) +rxt(335)*y(74) +.530_r8*rxt(340)*y(79) + & + rxt(347)*y(76))*y(9) + (rxt(298)*y(50) +rxt(328)*y(68) + & + .530_r8*rxt(342)*y(79) +rxt(348)*y(76))*y(11) & + + (.300_r8*rxt(324)*y(67) +.260_r8*rxt(344)*y(79) +rxt(350)*y(76)) & + *y(16) + (rxt(297)*y(50) +.500_r8*rxt(304)*y(54) +rxt(327)*y(68)) & + *y(23) + (.600_r8*rxt(64) +rxt(308))*y(58) +.530_r8*rxt(345)*y(79) & + *y(48) +rxt(73)*y(63) +rxt(78)*y(66) +rxt(74)*y(68) +rxt(72)*y(69) & + +rxt(80)*y(72) +rxt(84)*y(75) +2.000_r8*rxt(352)*y(76)*y(76) & + +.300_r8*rxt(68)*y(77) +1.340_r8*rxt(66)*y(78) +.130_r8*rxt(81) & + *y(86) + loss(75) = (rxt(304)* y(23) + rxt(63) + het_rates(54))* y(54) + prod(75) = (.750_r8*rxt(301)*y(48) +.750_r8*rxt(349)*y(76))*y(24) + loss(74) = (rxt(309)* y(23) + rxt(64) + rxt(308) + het_rates(58))* y(58) + prod(74) =rxt(300)*y(48)*y(10) + loss(61) = (rxt(329)* y(23) + het_rates(82))* y(82) + prod(61) =.100_r8*rxt(372)*y(84)*y(9) +rxt(312)*y(59)*y(11) + loss(53) = (rxt(284)* y(23) +rxt(282)* y(28) + het_rates(45))* y(45) + prod(53) = 0._r8 + loss(77) = (rxt(290)* y(1) +rxt(285)* y(23) +rxt(281)* y(28) + het_rates(44)) & + * y(44) + prod(77) = 0._r8 + loss(29) = (rxt(368)* y(23) + het_rates(71))* y(71) + prod(29) = 0._r8 + loss(81) = (rxt(355)* y(23) + rxt(65) + rxt(354) + het_rates(81))* y(81) + prod(81) =rxt(353)*y(76)*y(10) + loss(30) = (rxt(330)* y(23) + het_rates(70))* y(70) + prod(30) = 0._r8 + loss(56) = (rxt(331)* y(9) + het_rates(73))* y(73) + prod(56) =rxt(330)*y(70)*y(23) + loss(93) = (rxt(372)* y(9) +rxt(373)* y(24) + het_rates(84))* y(84) + prod(93) = (rxt(368)*y(71) +rxt(374)*y(85))*y(23) + loss(90) = (rxt(374)* y(23) + rxt(83) + het_rates(85))* y(85) + prod(90) =rxt(373)*y(84)*y(24) + loss(68) = (rxt(334)* y(23) + rxt(80) + het_rates(72))* y(72) + prod(68) =.800_r8*rxt(372)*y(84)*y(9) +.800_r8*rxt(83)*y(85) + loss(91) = (rxt(335)* y(9) +rxt(336)* y(24) + het_rates(74))* y(74) + prod(91) = (rxt(334)*y(72) +rxt(337)*y(75))*y(23) + loss(57) = (rxt(337)* y(23) + rxt(84) + het_rates(75))* y(75) + prod(57) =rxt(336)*y(74)*y(24) + loss(38) = (rxt(382)* y(23) + het_rates(94))* y(94) + prod(38) = 0._r8 + loss(39) = (rxt(386)* y(23) + het_rates(95))* y(95) + prod(39) =.250_r8*rxt(382)*y(94)*y(23) + loss(84) = (rxt(383)* y(9) +rxt(384)* y(24) + het_rates(96))* y(96) + prod(84) = (.700_r8*rxt(382)*y(94) +rxt(385)*y(97))*y(23) + loss(62) = (rxt(385)* y(23) + rxt(85) + het_rates(97))* y(97) + prod(62) =rxt(384)*y(96)*y(24) + loss(45) = (rxt(387)* y(10) + het_rates(98))* y(98) + prod(45) =rxt(386)*y(95)*y(23) + loss(112) = (rxt(397)* y(9) +rxt(398)* y(24) + het_rates(106))* y(106) + prod(112) = (rxt(394)*y(105) +rxt(399)*y(107))*y(23) +rxt(396)*y(105)*y(11) + loss(70) = (rxt(399)* y(23) + rxt(86) + het_rates(107))* y(107) + prod(70) =rxt(398)*y(106)*y(24) + loss(85) = ( + rxt(81) + het_rates(86))* y(86) + prod(85) = (.900_r8*rxt(383)*y(96) +.900_r8*rxt(390)*y(100) + & + .620_r8*rxt(393)*y(103))*y(9) +.700_r8*rxt(387)*y(98)*y(10) & + +.900_r8*rxt(85)*y(97) + loss(95) = (rxt(306)* y(23) + rxt(82) + het_rates(53))* y(53) + prod(95) = (.020_r8*rxt(359)*y(88) +.250_r8*rxt(375)*y(91) + & + .450_r8*rxt(383)*y(96) +.900_r8*rxt(390)*y(100) + & + .340_r8*rxt(393)*y(103))*y(9) + (.250_r8*rxt(376)*y(11) + & + .100_r8*rxt(378)*y(16) +.250_r8*rxt(379)*y(48))*y(91) & + + (.650_r8*rxt(283)*y(135) +.200_r8*rxt(305)*y(52))*y(23) & + +.130_r8*rxt(81)*y(86) +.450_r8*rxt(85)*y(97) + loss(31) = (rxt(388)* y(23) + het_rates(99))* y(99) + prod(31) = 0._r8 + loss(63) = (rxt(390)* y(9) +rxt(389)* y(24) + het_rates(100))* y(100) + prod(63) =rxt(388)*y(99)*y(23) + loss(1) = ( + het_rates(101))* y(101) + prod(1) =rxt(389)*y(100)*y(24) + loss(32) = (rxt(391)* y(23) + het_rates(102))* y(102) + prod(32) = 0._r8 + loss(71) = (rxt(393)* y(9) +rxt(392)* y(24) + het_rates(103))* y(103) + prod(71) =rxt(391)*y(102)*y(23) + loss(2) = ( + het_rates(104))* y(104) + prod(2) =rxt(392)*y(103)*y(24) + loss(123) = (rxt(359)* y(9) +rxt(360)* y(11) +rxt(363)* y(16) +rxt(361) & + * y(24) +rxt(364)* y(48) + het_rates(88))* y(88) + prod(123) = (rxt(356)*y(83) +.200_r8*rxt(362)*y(93))*y(23) + loss(125) = (rxt(333)* y(1) +rxt(332)* y(23) + rxt(68) + het_rates(77)) & + * y(77) + prod(125) = (.320_r8*rxt(359)*y(9) +.350_r8*rxt(360)*y(11) + & + .260_r8*rxt(363)*y(16) +.350_r8*rxt(364)*y(48))*y(88) & + + (.039_r8*rxt(365)*y(9) +.039_r8*rxt(366)*y(11) + & + .039_r8*rxt(367)*y(24))*y(89) + (.200_r8*rxt(357)*y(83) + & + rxt(395)*y(105))*y(1) +rxt(397)*y(106)*y(9) +.402_r8*rxt(77)*y(93) & + +rxt(86)*y(107) + loss(119) = (rxt(339)* y(1) +rxt(338)* y(23) + rxt(66) + rxt(67) & + + het_rates(78))* y(78) + prod(119) = (.230_r8*rxt(359)*y(9) +.250_r8*rxt(360)*y(11) + & + .190_r8*rxt(363)*y(16) +.250_r8*rxt(364)*y(48))*y(88) & + + (.167_r8*rxt(365)*y(9) +.167_r8*rxt(366)*y(11) + & + .167_r8*rxt(367)*y(24))*y(89) + (.400_r8*rxt(357)*y(83) + & + rxt(395)*y(105))*y(1) +rxt(397)*y(106)*y(9) +.288_r8*rxt(77)*y(93) & + +rxt(86)*y(107) + loss(124) = ((rxt(340) +rxt(341))* y(9) +rxt(342)* y(11) +rxt(344)* y(16) & + +rxt(343)* y(24) +rxt(345)* y(48) + het_rates(79))* y(79) + prod(124) = (rxt(332)*y(77) +.500_r8*rxt(338)*y(78) +.200_r8*rxt(346)*y(80)) & + *y(23) + loss(58) = (rxt(346)* y(23) + het_rates(80))* y(80) + prod(58) =rxt(343)*y(79)*y(24) + loss(126) = (rxt(347)* y(9) +rxt(353)* y(10) +rxt(348)* y(11) +rxt(350) & + * y(16) +rxt(349)* y(24) +rxt(351)* y(48) + 2._r8*rxt(352)* y(76) & + + het_rates(76))* y(76) + prod(126) = (.500_r8*rxt(338)*y(78) +.500_r8*rxt(346)*y(80))*y(23) & + + (rxt(65) +rxt(354))*y(81) +.200_r8*rxt(357)*y(83)*y(1) & + +.660_r8*rxt(66)*y(78) + loss(106) = (rxt(292)* y(9) +rxt(294)* y(16) +rxt(293)* y(24) & + + 2._r8*rxt(295)* y(46) + het_rates(46))* y(46) + prod(106) = (rxt(284)*y(45) +.500_r8*rxt(296)*y(47))*y(23) +rxt(282)*y(45) & + *y(28) +rxt(80)*y(72) + loss(59) = (rxt(296)* y(23) + rxt(69) + het_rates(47))* y(47) + prod(59) =rxt(293)*y(46)*y(24) + loss(86) = (rxt(395)* y(1) +rxt(396)* y(11) +rxt(394)* y(23) & + + het_rates(105))* y(105) + prod(86) = 0._r8 + loss(35) = (rxt(317)* y(23) + het_rates(60))* y(60) + prod(35) = 0._r8 + loss(108) = (rxt(313)* y(9) +rxt(315)* y(16) +rxt(314)* y(24) & + + het_rates(61))* y(61) + prod(108) = (rxt(316)*y(62) +rxt(317)*y(60))*y(23) + loss(64) = (rxt(316)* y(23) + rxt(71) + het_rates(62))* y(62) + prod(64) =rxt(314)*y(61)*y(24) + loss(94) = (rxt(321)* y(23) + rxt(73) + het_rates(63))* y(63) + prod(94) = (.820_r8*rxt(313)*y(61) +.500_r8*rxt(331)*y(73) + & + .250_r8*rxt(372)*y(84) +.100_r8*rxt(397)*y(106))*y(9) & + +.820_r8*rxt(315)*y(61)*y(16) +.820_r8*rxt(71)*y(62) & + +.250_r8*rxt(83)*y(85) +.100_r8*rxt(86)*y(107) + loss(65) = (rxt(325)* y(23) + rxt(72) + het_rates(69))* y(69) + prod(65) =rxt(323)*y(67)*y(24) + loss(79) = (rxt(274)* y(23) + het_rates(18))* y(18) + prod(79) = (rxt(273)*y(16) +.300_r8*rxt(294)*y(46) +.500_r8*rxt(324)*y(67) + & + .250_r8*rxt(344)*y(79) +.250_r8*rxt(363)*y(88) + & + .300_r8*rxt(378)*y(91))*y(16) + loss(51) = (rxt(307)* y(23) + het_rates(51))* y(51) + prod(51) = (.200_r8*rxt(294)*y(16) +.400_r8*rxt(295)*y(46))*y(46) + loss(110) = (rxt(305)* y(23) + rxt(79) + het_rates(52))* y(52) + prod(110) = (.530_r8*rxt(340)*y(9) +.530_r8*rxt(342)*y(11) + & + .260_r8*rxt(344)*y(16) +.530_r8*rxt(345)*y(48))*y(79) & + + (.250_r8*rxt(375)*y(9) +.250_r8*rxt(376)*y(11) + & + .100_r8*rxt(378)*y(16) +.250_r8*rxt(379)*y(48))*y(91) +rxt(288)*y(56) & + *y(4) +.020_r8*rxt(359)*y(88)*y(9) + loss(118) = (rxt(326)* y(23) + rxt(78) + het_rates(66))* y(66) + prod(118) = (.220_r8*rxt(340)*y(9) +.220_r8*rxt(342)*y(11) + & + .230_r8*rxt(344)*y(16) +.220_r8*rxt(345)*y(48))*y(79) & + + (.250_r8*rxt(375)*y(9) +.250_r8*rxt(376)*y(11) + & + .100_r8*rxt(378)*y(16) +.250_r8*rxt(379)*y(48))*y(91) & + + (.500_r8*rxt(320)*y(65) +.500_r8*rxt(355)*y(81))*y(23) & + +.020_r8*rxt(359)*y(88)*y(9) +.200_r8*rxt(324)*y(67)*y(16) + loss(97) = (rxt(286)* y(9) +rxt(287)* y(24) + het_rates(55))* y(55) + prod(97) =rxt(285)*y(44)*y(23) + loss(69) = (rxt(288)* y(4) + rxt(289) + het_rates(56))* y(56) + prod(69) =.750_r8*rxt(286)*y(55)*y(9) +rxt(70)*y(57) + loss(40) = ( + rxt(70) + het_rates(57))* y(57) + prod(40) =rxt(287)*y(55)*y(24) + loss(60) = (rxt(371)* y(23) + het_rates(87))* y(87) + prod(60) = (.330_r8*rxt(359)*y(9) +.400_r8*rxt(360)*y(11) + & + .300_r8*rxt(363)*y(16) +.400_r8*rxt(364)*y(48))*y(88) & + + (rxt(369)*y(23) +rxt(370)*y(11))*y(90) + loss(117) = (rxt(322)* y(9) +rxt(324)* y(16) +rxt(323)* y(24) & + + het_rates(67))* y(67) + prod(117) = (rxt(321)*y(63) +rxt(325)*y(69))*y(23) + loss(121) = (rxt(328)* y(11) +rxt(327)* y(23) + rxt(74) + het_rates(68)) & + * y(68) + prod(121) = (.250_r8*rxt(340)*y(79) +.020_r8*rxt(359)*y(88) + & + .250_r8*rxt(375)*y(91) +.450_r8*rxt(383)*y(96) + & + .540_r8*rxt(393)*y(103))*y(9) + (.500_r8*rxt(324)*y(67) + & + .240_r8*rxt(344)*y(79) +.100_r8*rxt(378)*y(91))*y(16) & + + (.950_r8*rxt(333)*y(77) +.800_r8*rxt(339)*y(78))*y(1) & + + (.250_r8*rxt(342)*y(79) +.250_r8*rxt(376)*y(91))*y(11) & + + (rxt(326)*y(66) +rxt(329)*y(82))*y(23) + (.250_r8*rxt(345)*y(79) + & + .250_r8*rxt(379)*y(91))*y(48) +.180_r8*rxt(81)*y(86) +.450_r8*rxt(85) & + *y(97) + loss(102) = (rxt(365)* y(9) +rxt(366)* y(11) +rxt(367)* y(24) & + + het_rates(89))* y(89) + prod(102) =rxt(358)*y(83)*y(11) + loss(111) = (rxt(370)* y(11) +rxt(369)* y(23) + rxt(76) + het_rates(90)) & + * y(90) + prod(111) = (.800_r8*rxt(341)*y(79) +.080_r8*rxt(359)*y(88) + & + .794_r8*rxt(365)*y(89))*y(9) + (.794_r8*rxt(366)*y(11) + & + .794_r8*rxt(367)*y(24))*y(89) + loss(122) = (rxt(375)* y(9) +rxt(376)* y(11) +rxt(378)* y(16) +rxt(377) & + * y(24) +rxt(379)* y(48) + het_rates(91))* y(91) + prod(122) = (.800_r8*rxt(362)*y(93) +rxt(371)*y(87) +rxt(380)*y(92))*y(23) + loss(52) = ((rxt(380) +rxt(381))* y(23) + rxt(75) + het_rates(92))* y(92) + prod(52) =rxt(377)*y(91)*y(24) + loss(83) = (rxt(362)* y(23) + rxt(77) + het_rates(93))* y(93) + prod(83) =rxt(361)*y(88)*y(24) + loss(54) = (rxt(283)* y(23) +rxt(280)* y(28) + het_rates(135))* y(135) + prod(54) = 0._r8 + loss(78) = (rxt(276)* y(23) + het_rates(136))* y(136) + prod(78) = (rxt(278)*y(9) +rxt(279)*y(24))*y(137) +.500_r8*rxt(290)*y(44) & + *y(1) +.350_r8*rxt(283)*y(135)*y(23) + loss(66) = (rxt(278)* y(9) +rxt(279)* y(24) + rxt(277) + het_rates(137)) & + * y(137) + prod(66) =rxt(269)*y(24)*y(19) + loss(41) = (rxt(151)* y(3) + rxt(55) + het_rates(138))* y(138) + prod(41) = (rxt(136)*y(111) +rxt(137)*y(112) +2.000_r8*rxt(138)*y(120) + & + 2.000_r8*rxt(139)*y(121) +rxt(140)*y(113) +rxt(142)*y(119) + & + rxt(145)*y(117) +rxt(146)*y(116) +rxt(147)*y(122) + & + 2.000_r8*rxt(148)*y(123))*y(3) + (rxt(254)*y(113) +rxt(258)*y(119)) & + *y(23) + loss(46) = (rxt(152)* y(3) + rxt(56) + het_rates(139))* y(139) + prod(46) = (rxt(135)*y(110) +rxt(137)*y(112) +rxt(141)*y(118))*y(3) & + +rxt(257)*y(118)*y(23) + loss(48) = ( + rxt(57) + het_rates(140))* y(140) + prod(48) = (rxt(249)*y(15) +rxt(247)*y(134) +rxt(248)*y(21) +rxt(250)*y(12)) & + *y(141) + loss(101) = (rxt(250)* y(12) +rxt(249)* y(15) +rxt(248)* y(21) +rxt(247) & + * y(134) + het_rates(141))* y(141) + prod(101) = (rxt(139)*y(121) +rxt(146)*y(116) +2.000_r8*rxt(151)*y(138) + & + rxt(152)*y(139))*y(3) +2.000_r8*rxt(55)*y(138) +rxt(56)*y(139) & + +rxt(57)*y(140) + loss(36) = (rxt(404)* y(23) + het_rates(156))* y(156) + prod(36) = (rxt(405)*y(23) +.500_r8*rxt(406)*y(23) +rxt(407)*y(11))*y(157) + loss(49) = (rxt(407)* y(11) + (rxt(405) +rxt(406))* y(23) + het_rates(157)) & + * y(157) + prod(49) = 0._r8 + loss(3) = ( + rxt(415) + het_rates(158))* y(158) + prod(3) =rxt(404)*y(156)*y(23) + loss(33) = (rxt(408)* y(23) + het_rates(159))* y(159) + prod(33) = 0._r8 + loss(4) = ( + rxt(421) + het_rates(160))* y(160) + prod(4) = 0._r8 + loss(5) = ( + rxt(422) + het_rates(161))* y(161) + prod(5) = 0._r8 + loss(6) = ( + rxt(416) + het_rates(146))* y(146) + prod(6) = 0._r8 + loss(7) = ( + rxt(417) + het_rates(147))* y(147) + prod(7) = 0._r8 + loss(8) = ( + rxt(419) + het_rates(148))* y(148) + prod(8) = 0._r8 + loss(9) = ( + rxt(418) + het_rates(149))* y(149) + prod(9) = 0._r8 + loss(10) = ( + rxt(420) + het_rates(150))* y(150) + prod(10) = 0._r8 + loss(11) = ( + het_rates(151))* y(151) + prod(11) = 0._r8 + loss(12) = ( + het_rates(152))* y(152) + prod(12) = 0._r8 + loss(13) = ( + het_rates(153))* y(153) + prod(13) = 0._r8 + loss(14) = ( + het_rates(154))* y(154) + prod(14) = 0._r8 + loss(15) = ( + het_rates(155))* y(155) + prod(15) = 0._r8 + loss(16) = ( + rxt(403) + rxt(411) + het_rates(142))* y(142) + prod(16) = 0._r8 + loss(17) = ( + rxt(412) + het_rates(143))* y(143) + prod(17) =rxt(403)*y(142) + loss(18) = ( + rxt(409) + rxt(413) + het_rates(144))* y(144) + prod(18) = 0._r8 + loss(19) = ( + rxt(414) + het_rates(145))* y(145) + prod(19) =rxt(409)*y(144) + loss(20) = ( + rxt(423) + het_rates(162))* y(162) + prod(20) = 0._r8 + loss(21) = ( + rxt(424) + het_rates(163))* y(163) + prod(21) = 0._r8 + loss(22) = ( + rxt(425) + het_rates(164))* y(164) + prod(22) = 0._r8 + loss(23) = ( + rxt(426) + het_rates(165))* y(165) + prod(23) = 0._r8 + loss(24) = ( + rxt(427) + het_rates(166))* y(166) + prod(24) = 0._r8 + loss(25) = ( + rxt(428) + het_rates(167))* y(167) + prod(25) = 0._r8 + loss(26) = ( + rxt(429) + het_rates(168))* y(168) + prod(26) = 0._r8 + loss(27) = ( + rxt(430) + het_rates(169))* y(169) + prod(27) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..342cb0dcbb --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_rxt_rates_conv.F90 @@ -0,0 +1,484 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 12) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 17) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 25) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 29) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 30) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 31) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 32) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 34) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 33) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 36) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 38) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 40) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 39) ! rate_const*HBR + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 108) ! rate_const*CH3CL + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 114) ! rate_const*CCL4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 115) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 110) ! rate_const*CFC11 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 111) ! rate_const*CFC12 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 112) ! rate_const*CFC113 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 120) ! rate_const*CFC114 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 121) ! rate_const*CFC115 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 113) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 118) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 119) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 109) ! rate_const*CH3BR + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 116) ! rate_const*CF3BR + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 117) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 124) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 125) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 122) ! rate_const*H1202 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 123) ! rate_const*H2402 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 138) ! rate_const*COF2 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 139) ! rate_const*COFCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 140) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 126) ! rate_const*CO2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 50) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 65) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 54) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 58) ! rate_const*PAN + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 81) ! rate_const*MPAN + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 78) ! rate_const*MACR + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 78) ! rate_const*MACR + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 77) ! rate_const*MVK + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 47) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 57) ! rate_const*EOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 62) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 69) ! rate_const*ROOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 63) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 68) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 92) ! rate_const*XOOH + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*ONITR + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 93) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 66) ! rate_const*HYAC + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 52) ! rate_const*GLYALD + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 72) ! rate_const*MEK + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 86) ! rate_const*BIGALD + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 53) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 85) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 75) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 97) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 107) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 178) ! rate_const*SF6 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 179) ! rate_const*SF6em + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 8) ! rate_const*N + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 126) ! rate_const*CO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 5)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 5) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 5)*sol(:ncol,:, 126) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 5) ! rate_const*O2_1S + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 6) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 6) ! rate_const*O2_1D + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 3) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 3)*sol(:ncol,:, 134) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 3)*sol(:ncol,:, 110) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 3)*sol(:ncol,:, 111) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 3)*sol(:ncol,:, 112) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 3)*sol(:ncol,:, 120) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 3)*sol(:ncol,:, 121) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 3)*sol(:ncol,:, 113) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 3)*sol(:ncol,:, 118) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 3)*sol(:ncol,:, 119) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 3)*sol(:ncol,:, 114) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 3)*sol(:ncol,:, 109) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 3)*sol(:ncol,:, 117) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 3)*sol(:ncol,:, 116) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 3)*sol(:ncol,:, 122) ! rate_const*O1D*H1202 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 3)*sol(:ncol,:, 123) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 3)*sol(:ncol,:, 124) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 3)*sol(:ncol,:, 125) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 3)*sol(:ncol,:, 138) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 3)*sol(:ncol,:, 139) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 3)*sol(:ncol,:, 21) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 3)*sol(:ncol,:, 33) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 3)*sol(:ncol,:, 39) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 3)*sol(:ncol,:, 42) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 22)*sol(:ncol,:, 4) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 22)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 23)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 23)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 23)*sol(:ncol,:, 24) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*OH*OH + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 23)*sol(:ncol,:, 25) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*H2*O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 24)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 24)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 25)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 42)*sol(:ncol,:, 23) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 43)*sol(:ncol,:, 23) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 133)*sol(:ncol,:, 4) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 133)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 8)*sol(:ncol,:, 23) ! rate_const*N*OH + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 8)*sol(:ncol,:, 4) ! rate_const*N*O2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 8)*sol(:ncol,:, 9) ! rate_const*N*NO + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 9)*sol(:ncol,:, 24) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 9)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 10)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 14) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 10)*sol(:ncol,:, 23) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 12)*sol(:ncol,:, 23) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 11)*sol(:ncol,:, 23) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 11)*sol(:ncol,:, 24) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 10)*sol(:ncol,:, 24) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 13)*sol(:ncol,:, 23) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 13) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 28)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 28)*sol(:ncol,:, 25) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 28)*sol(:ncol,:, 24) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 28)*sol(:ncol,:, 24) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 28)*sol(:ncol,:, 19) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 28)*sol(:ncol,:, 15) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 30)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 30)*sol(:ncol,:, 24) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 30)*sol(:ncol,:, 16) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 30)*sol(:ncol,:, 9) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 30)*sol(:ncol,:, 10) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 32) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 33)*sol(:ncol,:, 23) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 34)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 34)*sol(:ncol,:, 28) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 34)*sol(:ncol,:, 23) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 35)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 35)*sol(:ncol,:, 23) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 35)*sol(:ncol,:, 28) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 37)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 37)*sol(:ncol,:, 24) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 37)*sol(:ncol,:, 19) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 38)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 38)*sol(:ncol,:, 23) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 38)*sol(:ncol,:, 24) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 38)*sol(:ncol,:, 9) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 38)*sol(:ncol,:, 10) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 38)*sol(:ncol,:, 38) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 39)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 40)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 41)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 141)*sol(:ncol,:, 134) ! rate_const*F*H2O + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 141)*sol(:ncol,:, 21) ! rate_const*F*H2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 141)*sol(:ncol,:, 15) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 141)*sol(:ncol,:, 12) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 108)*sol(:ncol,:, 28) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 108)*sol(:ncol,:, 23) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 115)*sol(:ncol,:, 23) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 113)*sol(:ncol,:, 23) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 109)*sol(:ncol,:, 23) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 109)*sol(:ncol,:, 28) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 118)*sol(:ncol,:, 23) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 119)*sol(:ncol,:, 23) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 125)*sol(:ncol,:, 23) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 124)*sol(:ncol,:, 23) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 125)*sol(:ncol,:, 28) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 124)*sol(:ncol,:, 28) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 15)*sol(:ncol,:, 23) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 20)*sol(:ncol,:, 23) ! rate_const*CO*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 20)*sol(:ncol,:, 23) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 19)*sol(:ncol,:, 11) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 19)*sol(:ncol,:, 23) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 19)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 19)*sol(:ncol,:, 24) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 16)*sol(:ncol,:, 9) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 16)*sol(:ncol,:, 24) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 16)*sol(:ncol,:, 16) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 16)*sol(:ncol,:, 16) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 18)*sol(:ncol,:, 23) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 17)*sol(:ncol,:, 23) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 136)*sol(:ncol,:, 23) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 137) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 137)*sol(:ncol,:, 9) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 137)*sol(:ncol,:, 24) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 135)*sol(:ncol,:, 28) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 44)*sol(:ncol,:, 28) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 45)*sol(:ncol,:, 28) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 135)*sol(:ncol,:, 23) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 45)*sol(:ncol,:, 23) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 44)*sol(:ncol,:, 23) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 55)*sol(:ncol,:, 9) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 55)*sol(:ncol,:, 24) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 56)*sol(:ncol,:, 4) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 56) ! rate_const*EO + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 44)*sol(:ncol,:, 1) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 49)*sol(:ncol,:, 23) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 46)*sol(:ncol,:, 9) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 46)*sol(:ncol,:, 24) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 46)*sol(:ncol,:, 16) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 46)*sol(:ncol,:, 46) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 47)*sol(:ncol,:, 23) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 50)*sol(:ncol,:, 23) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 50)*sol(:ncol,:, 11) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 48)*sol(:ncol,:, 9) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 48)*sol(:ncol,:, 10) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 48)*sol(:ncol,:, 24) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 48)*sol(:ncol,:, 16) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 48)*sol(:ncol,:, 48) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 54)*sol(:ncol,:, 23) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 52)*sol(:ncol,:, 23) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 53)*sol(:ncol,:, 23) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 51)*sol(:ncol,:, 23) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 58) ! rate_const*M*PAN + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 58)*sol(:ncol,:, 23) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 59)*sol(:ncol,:, 23) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 59)*sol(:ncol,:, 1) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 59)*sol(:ncol,:, 11) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 61)*sol(:ncol,:, 9) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 61)*sol(:ncol,:, 24) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 61)*sol(:ncol,:, 16) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 62)*sol(:ncol,:, 23) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 60)*sol(:ncol,:, 23) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 64)*sol(:ncol,:, 9) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 64)*sol(:ncol,:, 24) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 65)*sol(:ncol,:, 23) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 63)*sol(:ncol,:, 23) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 67)*sol(:ncol,:, 9) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 67)*sol(:ncol,:, 24) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 67)*sol(:ncol,:, 16) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 69)*sol(:ncol,:, 23) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 66)*sol(:ncol,:, 23) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 68)*sol(:ncol,:, 23) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 68)*sol(:ncol,:, 11) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 82)*sol(:ncol,:, 23) ! rate_const*ONIT*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 70)*sol(:ncol,:, 23) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 73)*sol(:ncol,:, 9) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 77)*sol(:ncol,:, 23) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 77)*sol(:ncol,:, 1) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 72)*sol(:ncol,:, 23) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 74)*sol(:ncol,:, 9) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 74)*sol(:ncol,:, 24) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 75)*sol(:ncol,:, 23) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 78)*sol(:ncol,:, 23) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 78)*sol(:ncol,:, 1) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 79)*sol(:ncol,:, 9) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 79)*sol(:ncol,:, 9) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 79)*sol(:ncol,:, 11) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 79)*sol(:ncol,:, 24) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 79)*sol(:ncol,:, 16) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 79)*sol(:ncol,:, 48) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 80)*sol(:ncol,:, 23) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 76)*sol(:ncol,:, 9) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 76)*sol(:ncol,:, 11) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 76)*sol(:ncol,:, 24) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 76)*sol(:ncol,:, 16) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 76)*sol(:ncol,:, 48) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 76)*sol(:ncol,:, 76) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 76)*sol(:ncol,:, 10) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 81) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 81)*sol(:ncol,:, 23) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 83)*sol(:ncol,:, 23) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 83)*sol(:ncol,:, 1) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 83)*sol(:ncol,:, 11) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 88)*sol(:ncol,:, 9) ! rate_const*ISOPO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 88)*sol(:ncol,:, 11) ! rate_const*ISOPO2*NO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 88)*sol(:ncol,:, 24) ! rate_const*ISOPO2*HO2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 93)*sol(:ncol,:, 23) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 88)*sol(:ncol,:, 16) ! rate_const*ISOPO2*CH3O2 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 88)*sol(:ncol,:, 48) ! rate_const*ISOPO2*CH3CO3 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 89)*sol(:ncol,:, 9) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 89)*sol(:ncol,:, 11) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 89)*sol(:ncol,:, 24) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 71)*sol(:ncol,:, 23) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 90)*sol(:ncol,:, 23) ! rate_const*ONITR*OH + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 90)*sol(:ncol,:, 11) ! rate_const*ONITR*NO3 + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 87)*sol(:ncol,:, 23) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 84)*sol(:ncol,:, 9) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 84)*sol(:ncol,:, 24) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 85)*sol(:ncol,:, 23) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 91)*sol(:ncol,:, 9) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 91)*sol(:ncol,:, 11) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 91)*sol(:ncol,:, 24) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 91)*sol(:ncol,:, 16) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 91)*sol(:ncol,:, 48) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 94)*sol(:ncol,:, 23) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 96)*sol(:ncol,:, 9) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 96)*sol(:ncol,:, 24) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 97)*sol(:ncol,:, 23) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 95)*sol(:ncol,:, 23) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 98)*sol(:ncol,:, 10) ! rate_const*XOH*NO2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 99)*sol(:ncol,:, 23) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 100)*sol(:ncol,:, 24) ! rate_const*BENO2*HO2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 100)*sol(:ncol,:, 9) ! rate_const*BENO2*NO + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 102)*sol(:ncol,:, 23) ! rate_const*XYLENE*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 103)*sol(:ncol,:, 24) ! rate_const*XYLO2*HO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 103)*sol(:ncol,:, 9) ! rate_const*XYLO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 105)*sol(:ncol,:, 23) ! rate_const*C10H16*OH + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 105)*sol(:ncol,:, 1) ! rate_const*C10H16*O3 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 105)*sol(:ncol,:, 11) ! rate_const*C10H16*NO3 + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 106)*sol(:ncol,:, 9) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 106)*sol(:ncol,:, 24) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 107)*sol(:ncol,:, 23) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 142) ! rate_const*CB1 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 156)*sol(:ncol,:, 23) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 157)*sol(:ncol,:, 23) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 157)*sol(:ncol,:, 23) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 157)*sol(:ncol,:, 11) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 159)*sol(:ncol,:, 23) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 144) ! rate_const*OC1 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 24) ! rate_const*HO2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 142) ! rate_const*CB1 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 143) ! rate_const*CB2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 144) ! rate_const*OC1 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 145) ! rate_const*OC2 + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 158) ! rate_const*SO4 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 146) ! rate_const*SOAM + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 147) ! rate_const*SOAI + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 149) ! rate_const*SOAB + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 148) ! rate_const*SOAT + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 150) ! rate_const*SOAX + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 160) ! rate_const*NH4 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 161) ! rate_const*NH4NO3 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 162) ! rate_const*SSLT01 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 163) ! rate_const*SSLT02 + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 164) ! rate_const*SSLT03 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 165) ! rate_const*SSLT04 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 166) ! rate_const*DST01 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 167) ! rate_const*DST02 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 168) ! rate_const*DST03 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 169) ! rate_const*DST04 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 177) ! rate_const*SO2t + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 130)*sol(:ncol,:, 4) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 130) ! rate_const*N2*Op + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 127)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 127)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 130)*sol(:ncol,:, 126) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 128)*sol(:ncol,:, 8) ! rate_const*O2p*N + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 128)*sol(:ncol,:, 9) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 129)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 129)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 129)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 127)*sol(:ncol,:, 4) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 128) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 131)*sol(:ncol,:, 132) ! rate_const*NOp*e + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 128)*sol(:ncol,:, 132) ! rate_const*O2p*e + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 127)*sol(:ncol,:, 132) ! rate_const*N2p*e + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 170) ! rate_const*NH_5 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 171) ! rate_const*NH_50 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 172) ! rate_const*NH_50W + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 174) ! rate_const*ST80_25 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 175) ! rate_const*CO_25 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 176) ! rate_const*CO_50 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 181) ! rate_const*E90 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 182) ! rate_const*E90_NH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 183) ! rate_const*E90_SH + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 new file mode 100644 index 0000000000..434d2ce50c --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_setrxt.F90 @@ -0,0 +1,602 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,118) = 8.00e-14_r8 + rate(:,:,119) = 3.90e-17_r8 + rate(:,:,122) = 4.20e-13_r8 + rate(:,:,123) = 8.50e-2_r8 + rate(:,:,124) = 1.30e-16_r8 + rate(:,:,126) = 1.00e-20_r8 + rate(:,:,127) = 2.58e-04_r8 + rate(:,:,134) = 1.20e-10_r8 + rate(:,:,135) = 2.02e-10_r8 + rate(:,:,136) = 1.204e-10_r8 + rate(:,:,137) = 1.50e-10_r8 + rate(:,:,138) = 9.75e-11_r8 + rate(:,:,139) = 1.50e-11_r8 + rate(:,:,140) = 7.20e-11_r8 + rate(:,:,141) = 1.794e-10_r8 + rate(:,:,142) = 1.628e-10_r8 + rate(:,:,143) = 2.84e-10_r8 + rate(:,:,144) = 1.674e-10_r8 + rate(:,:,145) = 9.60e-11_r8 + rate(:,:,146) = 4.10e-11_r8 + rate(:,:,147) = 1.012e-10_r8 + rate(:,:,148) = 1.20e-10_r8 + rate(:,:,149) = 4.49e-10_r8 + rate(:,:,150) = 2.57e-10_r8 + rate(:,:,151) = 2.14e-11_r8 + rate(:,:,152) = 1.90e-10_r8 + rate(:,:,153) = 1.31e-10_r8 + rate(:,:,154) = 3.50e-11_r8 + rate(:,:,155) = 9.00e-12_r8 + rate(:,:,156) = 1.20e-10_r8 + rate(:,:,157) = 1.50e-10_r8 + rate(:,:,158) = 1.20e-10_r8 + rate(:,:,162) = 7.20e-11_r8 + rate(:,:,163) = 6.90e-12_r8 + rate(:,:,164) = 1.60e-12_r8 + rate(:,:,168) = 1.80e-12_r8 + rate(:,:,171) = 1.80e-12_r8 + rate(:,:,179) = 5.00e-12_r8 + rate(:,:,180) = 7.00e-13_r8 + rate(:,:,181) = 5.00e-11_r8 + rate(:,:,198) = 1.00e-11_r8 + rate(:,:,199) = 2.20e-11_r8 + rate(:,:,200) = 3.50e-12_r8 + rate(:,:,225) = 1.70e-13_r8 + rate(:,:,276) = 4.50e-13_r8 + rate(:,:,288) = 1.00e-14_r8 + rate(:,:,291) = 7.00e-13_r8 + rate(:,:,294) = 2.00e-13_r8 + rate(:,:,295) = 6.80e-14_r8 + rate(:,:,304) = 1.00e-12_r8 + rate(:,:,305) = 1.00e-11_r8 + rate(:,:,306) = 1.15e-11_r8 + rate(:,:,309) = 4.00e-14_r8 + rate(:,:,326) = 3.00e-12_r8 + rate(:,:,329) = 6.80e-13_r8 + rate(:,:,330) = 5.40e-11_r8 + rate(:,:,342) = 2.40e-12_r8 + rate(:,:,345) = 1.40e-11_r8 + rate(:,:,348) = 5.00e-12_r8 + rate(:,:,360) = 2.40e-12_r8 + rate(:,:,364) = 1.40e-11_r8 + rate(:,:,366) = 2.40e-12_r8 + rate(:,:,368) = 3.50e-12_r8 + rate(:,:,369) = 4.50e-11_r8 + rate(:,:,376) = 2.40e-12_r8 + rate(:,:,386) = 3.00e-12_r8 + rate(:,:,387) = 1.00e-11_r8 + rate(:,:,391) = 2.3e-11_r8 + rate(:,:,403) = 7.10e-6_r8 + rate(:,:,409) = 7.10e-6_r8 + rate(:,:,411) = 6.34e-8_r8 + rate(:,:,412) = 6.34e-8_r8 + rate(:,:,413) = 6.34e-8_r8 + rate(:,:,414) = 6.34e-8_r8 + rate(:,:,415) = 6.34e-8_r8 + rate(:,:,416) = 6.34e-8_r8 + rate(:,:,417) = 6.34e-8_r8 + rate(:,:,418) = 6.34e-8_r8 + rate(:,:,419) = 6.34e-8_r8 + rate(:,:,420) = 6.34e-8_r8 + rate(:,:,421) = 6.34e-8_r8 + rate(:,:,422) = 6.34e-8_r8 + rate(:,:,423) = 6.34e-8_r8 + rate(:,:,424) = 6.34e-8_r8 + rate(:,:,425) = 6.34e-8_r8 + rate(:,:,426) = 6.34e-8_r8 + rate(:,:,427) = 6.34e-8_r8 + rate(:,:,428) = 6.34e-8_r8 + rate(:,:,429) = 6.34e-8_r8 + rate(:,:,430) = 6.34e-8_r8 + rate(:,:,431) = 6.34e-8_r8 + rate(:,:,453) = 9.0e-10_r8 + rate(:,:,454) = 1.0e-10_r8 + rate(:,:,455) = 4.4e-10_r8 + rate(:,:,456) = 4.0e-10_r8 + rate(:,:,457) = 2.0e-10_r8 + rate(:,:,458) = 1.0e-12_r8 + rate(:,:,459) = 6.0e-11_r8 + rate(:,:,460) = 5.0e-16_r8 + rate(:,:,464) = 2.31e-06_r8 + rate(:,:,465) = 2.31e-07_r8 + rate(:,:,466) = 2.31e-07_r8 + rate(:,:,467) = 4.63e-07_r8 + rate(:,:,468) = 4.63e-07_r8 + rate(:,:,469) = 2.31e-07_r8 + rate(:,:,470) = 1.29e-07_r8 + rate(:,:,471) = 1.29e-07_r8 + rate(:,:,472) = 1.29e-07_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,116) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,120) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,121) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,125) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,128) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,129) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,130) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,131) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,132) = 7.25e-11_r8 * exp_fac(:,:) + rate(:,:,133) = 4.63e-11_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 100._r8 * itemp(:,:) ) + rate(:,:,159) = 7.70e-11_r8 * exp_fac(:,:) + rate(:,:,183) = 2.10e-11_r8 * exp_fac(:,:) + rate(:,:,161) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 180._r8 * itemp(:,:) ) + rate(:,:,165) = 1.80e-11_r8 * exp_fac(:,:) + rate(:,:,286) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,313) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,318) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,331) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,335) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,359) = 4.40e-12_r8 * exp_fac(:,:) + rate(:,:,372) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,383) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,397) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,166) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,167) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,235) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,170) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,172) = 1.60e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,173) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,243) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,275) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,296) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,316) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,320) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,325) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,337) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,346) = 2.30e-11_r8 * exp_fac(:,:) + rate(:,:,362) = 1.52e-11_r8 * exp_fac(:,:) + rate(:,:,374) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,385) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,399) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,174) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2000._r8 * itemp(:,:) ) + rate(:,:,176) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,357) = 1.05e-14_r8 * exp_fac(:,:) + rate(:,:,178) = 7.80e-13_r8 * exp( -1050._r8 * itemp(:,:) ) + rate(:,:,182) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,184) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,185) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,186) = 1.45e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,188) = 3.30e-12_r8 * exp_fac(:,:) + rate(:,:,207) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,212) = 7.40e-12_r8 * exp_fac(:,:) + rate(:,:,299) = 8.10e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,189) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,244) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,190) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,192) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,218) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,197) = 1.50e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,202) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,204) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,205) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,206) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,208) = 3.60e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,209) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,210) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,211) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,213) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,234) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,242) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,214) = 2.60e-12_r8 * exp_fac(:,:) + rate(:,:,216) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,241) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,215) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,219) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,220) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,223) = 1.80e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,224) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,226) = 3.40e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,227) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,248) = 1.40e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,228) = 3.60e-12_r8 * exp_fac(:,:) + rate(:,:,259) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,229) = 1.20e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,230) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,231) = 1.60e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,232) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,233) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,261) = 6.30e-12_r8 * exp_fac(:,:) + rate(:,:,236) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,237) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,240) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,239) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,245) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,246) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,247) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,276) = 4.50e-13_r8 * exp_fac(:,:) + rate(:,:,288) = 1.00e-14_r8 * exp_fac(:,:) + rate(:,:,291) = 7.00e-13_r8 * exp_fac(:,:) + rate(:,:,294) = 2.00e-13_r8 * exp_fac(:,:) + rate(:,:,295) = 6.80e-14_r8 * exp_fac(:,:) + rate(:,:,304) = 1.00e-12_r8 * exp_fac(:,:) + rate(:,:,305) = 1.00e-11_r8 * exp_fac(:,:) + rate(:,:,306) = 1.15e-11_r8 * exp_fac(:,:) + rate(:,:,309) = 4.00e-14_r8 * exp_fac(:,:) + rate(:,:,326) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,329) = 6.80e-13_r8 * exp_fac(:,:) + rate(:,:,330) = 5.40e-11_r8 * exp_fac(:,:) + rate(:,:,342) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,345) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,348) = 5.00e-12_r8 * exp_fac(:,:) + rate(:,:,360) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,364) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,366) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,368) = 3.50e-12_r8 * exp_fac(:,:) + rate(:,:,369) = 4.50e-11_r8 * exp_fac(:,:) + rate(:,:,376) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,386) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,387) = 1.00e-11_r8 * exp_fac(:,:) + rate(:,:,391) = 2.3e-11_r8 * exp_fac(:,:) + rate(:,:,403) = 7.10e-6_r8 * exp_fac(:,:) + rate(:,:,409) = 7.10e-6_r8 * exp_fac(:,:) + rate(:,:,411) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,412) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,413) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,414) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,415) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,416) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,417) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,418) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,419) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,420) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,421) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,422) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,423) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,424) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,425) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,426) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,427) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,428) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,429) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,430) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,431) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,453) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,454) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,455) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,456) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,457) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,458) = 1.0e-12_r8 * exp_fac(:,:) + rate(:,:,459) = 6.0e-11_r8 * exp_fac(:,:) + rate(:,:,460) = 5.0e-16_r8 * exp_fac(:,:) + rate(:,:,464) = 2.31e-06_r8 * exp_fac(:,:) + rate(:,:,465) = 2.31e-07_r8 * exp_fac(:,:) + rate(:,:,466) = 2.31e-07_r8 * exp_fac(:,:) + rate(:,:,467) = 4.63e-07_r8 * exp_fac(:,:) + rate(:,:,468) = 4.63e-07_r8 * exp_fac(:,:) + rate(:,:,469) = 2.31e-07_r8 * exp_fac(:,:) + rate(:,:,470) = 1.29e-07_r8 * exp_fac(:,:) + rate(:,:,471) = 1.29e-07_r8 * exp_fac(:,:) + rate(:,:,472) = 1.29e-07_r8 * exp_fac(:,:) + rate(:,:,249) = 1.60e-10_r8 * exp( -260._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 400._r8 * itemp(:,:) ) + rate(:,:,250) = 6.00e-12_r8 * exp_fac(:,:) + rate(:,:,344) = 5.00e-13_r8 * exp_fac(:,:) + rate(:,:,363) = 5.00e-13_r8 * exp_fac(:,:) + rate(:,:,378) = 5.e-13_r8 * exp_fac(:,:) + rate(:,:,251) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,252) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,253) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,254) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,257) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,268) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,255) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,256) = 1.40e-11_r8 * exp( -1030._r8 * itemp(:,:) ) + rate(:,:,258) = 1.30e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,260) = 1.35e-12_r8 * exp( -600._r8 * itemp(:,:) ) + rate(:,:,262) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,263) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,266) = 6.00e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,267) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,269) = 9.7e-15_r8 * exp( 625._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 300._r8 * itemp(:,:) ) + rate(:,:,270) = 2.80e-12_r8 * exp_fac(:,:) + rate(:,:,322) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,271) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,272) = 5.00e-13_r8 * exp( -424._r8 * itemp(:,:) ) + rate(:,:,273) = 1.90e-14_r8 * exp( 706._r8 * itemp(:,:) ) + rate(:,:,274) = 2.90e-12_r8 * exp( -345._r8 * itemp(:,:) ) + rate(:,:,277) = 2.40e12_r8 * exp( -7000._r8 * itemp(:,:) ) + rate(:,:,278) = 2.60e-12_r8 * exp( 265._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 700._r8 * itemp(:,:) ) + rate(:,:,279) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,287) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,293) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,314) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,319) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,323) = 8.60e-13_r8 * exp_fac(:,:) + rate(:,:,336) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,343) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,361) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,367) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,373) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,377) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,384) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,389) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,392) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,398) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,282) = 7.20e-11_r8 * exp( -70._r8 * itemp(:,:) ) + rate(:,:,284) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:,:) ) + rate(:,:,289) = 1.60e11_r8 * exp( -4150._r8 * itemp(:,:) ) + rate(:,:,290) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:,:) ) + rate(:,:,292) = 2.60e-12_r8 * exp( 365._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 350._r8 * itemp(:,:) ) + rate(:,:,297) = 4.63e-12_r8 * exp_fac(:,:) + rate(:,:,390) = 2.6e-12_r8 * exp_fac(:,:) + rate(:,:,393) = 2.6e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1900._r8 * itemp(:,:) ) + rate(:,:,298) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,311) = 6.50e-15_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 1040._r8 * itemp(:,:) ) + rate(:,:,301) = 4.30e-13_r8 * exp_fac(:,:) + rate(:,:,349) = 4.30e-13_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 500._r8 * itemp(:,:) ) + rate(:,:,302) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,303) = 2.50e-12_r8 * exp_fac(:,:) + rate(:,:,324) = 7.10e-13_r8 * exp_fac(:,:) + rate(:,:,350) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,307) = 6.90e-12_r8 * exp( -230._r8 * itemp(:,:) ) + rate(:,:,312) = 4.60e-13_r8 * exp( -1156._r8 * itemp(:,:) ) + rate(:,:,315) = 3.75e-13_r8 * exp( -40._r8 * itemp(:,:) ) + rate(:,:,317) = 8.70e-12_r8 * exp( -615._r8 * itemp(:,:) ) + rate(:,:,327) = 8.40e-13_r8 * exp( 830._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1860._r8 * itemp(:,:) ) + rate(:,:,328) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,370) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,332) = 4.13e-12_r8 * exp( 452._r8 * itemp(:,:) ) + rate(:,:,333) = 7.52e-16_r8 * exp( -1521._r8 * itemp(:,:) ) + rate(:,:,334) = 2.30e-12_r8 * exp( -170._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 175._r8 * itemp(:,:) ) + rate(:,:,338) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,371) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,339) = 4.40e-15_r8 * exp( -2500._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 360._r8 * itemp(:,:) ) + rate(:,:,340) = 2.70e-12_r8 * exp_fac(:,:) + rate(:,:,341) = 1.30e-13_r8 * exp_fac(:,:) + rate(:,:,347) = 5.30e-12_r8 * exp_fac(:,:) + rate(:,:,365) = 2.70e-12_r8 * exp_fac(:,:) + rate(:,:,375) = 2.7e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 530._r8 * itemp(:,:) ) + rate(:,:,351) = 4.60e-12_r8 * exp_fac(:,:) + rate(:,:,352) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,356) = 2.54e-11_r8 * exp( 410._r8 * itemp(:,:) ) + rate(:,:,358) = 3.03e-12_r8 * exp( -446._r8 * itemp(:,:) ) + rate(:,:,379) = 1.3e-12_r8 * exp( 640._r8 * itemp(:,:) ) + rate(:,:,380) = 1.90e-12_r8 * exp( 190._r8 * itemp(:,:) ) + rate(:,:,382) = 1.70e-12_r8 * exp( 352._r8 * itemp(:,:) ) + rate(:,:,388) = 2.3e-12_r8 * exp( -193._r8 * itemp(:,:) ) + rate(:,:,394) = 1.2e-11_r8 * exp( 444._r8 * itemp(:,:) ) + rate(:,:,395) = 1.e-15_r8 * exp( -732._r8 * itemp(:,:) ) + rate(:,:,396) = 1.2e-12_r8 * exp( 490._r8 * itemp(:,:) ) + rate(:,:,405) = 9.60e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,407) = 1.90e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,408) = 1.70e-12_r8 * exp( -710._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,160), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.60e-11_r8 + call jpl( rate(1,1,169), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 4.28e-33_r8 + kinf(:,:) = 9.30e-15_r8 * itemp(:,:)**(-4.42_r8) + call jpl( rate(1,1,177), m, 0.8_r8, ko, kinf, n ) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,187), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,191), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,193), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,195), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,201), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,217), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 3.0e-12_r8 * itemp(:,:)**2.0_r8 + call jpl( rate(1,1,221), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,238), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,265), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-30_r8 * itemp(:,:)**2.4_r8 + kinf(:,:) = 2.2e-10_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,280), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-29_r8 * itemp(:,:)**3.3_r8 + kinf(:,:) = 3.1e-10_r8 * itemp(:,:) + call jpl( rate(1,1,281), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.50e-30_r8 + kinf(:,:) = 8.3e-13_r8 * itemp(:,:)**(-2.0_r8) + call jpl( rate(1,1,283), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 8.60e-29_r8 * itemp(:,:)**3.1_r8 + kinf(:,:) = 9.00e-12_r8 * itemp(:,:)**0.85_r8 + call jpl( rate(1,1,285), m, 0.48_r8, ko, kinf, n ) + + ko(:,:) = 9.70e-29_r8 * itemp(:,:)**5.6_r8 + kinf(:,:) = 9.30e-12_r8 * itemp(:,:)**1.5_r8 + call jpl( rate(1,1,300), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 8.00e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.00e-11_r8 + call jpl( rate(1,1,310), m, 0.5_r8, ko, kinf, n ) + + ko(:,:) = 8.00e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.00e-11_r8 + call jpl( rate(1,1,355), m, 0.5_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,118) = 8.00e-14_r8 + rate(:,:kbot,119) = 3.90e-17_r8 + rate(:,:kbot,124) = 1.30e-16_r8 + rate(:,:kbot,126) = 1.00e-20_r8 + rate(:,:kbot,163) = 6.90e-12_r8 + rate(:,:kbot,179) = 5.00e-12_r8 + rate(:,:kbot,180) = 7.00e-13_r8 + rate(:,:kbot,454) = 1.0e-10_r8 + rate(:,:kbot,455) = 4.4e-10_r8 + rate(:,:kbot,456) = 4.0e-10_r8 + rate(:,:kbot,457) = 2.0e-10_r8 + rate(:,:kbot,458) = 1.0e-12_r8 + rate(:,:kbot,459) = 6.0e-11_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,116) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,120) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,121) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,125) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,128) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,129) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,130) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,161) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,165) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,166) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,167) = 4.80e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,173) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,174) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,182) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,183) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,188) = 3.30e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,189) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,190) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,160) = wrk(:,:) + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 new file mode 100644 index 0000000000..13a055175f --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt/mo_sim_dat.F90 @@ -0,0 +1,709 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 37, 0, 0, 146, 0 /) + + cls_rxt_cnt(:,1) = (/ 19, 72, 0, 37 /) + cls_rxt_cnt(:,4) = (/ 31, 168, 261, 146 /) + + solsym(:183) = (/ 'O3 ','O ','O1D ','O2 ','O2_1S ', & + 'O2_1D ','N2O ','N ','NO ','NO2 ', & + 'NO3 ','HNO3 ','HO2NO2 ','N2O5 ','CH4 ', & + 'CH3O2 ','CH3OOH ','CH3OH ','CH2O ','CO ', & + 'H2 ','H ','OH ','HO2 ','H2O2 ', & + 'CLY ','BRY ','CL ','CL2 ','CLO ', & + 'OCLO ','CL2O2 ','HCL ','HOCL ','CLONO2 ', & + 'BRCL ','BR ','BRO ','HBR ','HOBR ', & + 'BRONO2 ','HCN ','CH3CN ','C2H4 ','C2H6 ', & + 'C2H5O2 ','C2H5OOH ','CH3CO3 ','CH3COOH ','CH3CHO ', & + 'C2H5OH ','GLYALD ','GLYOXAL ','CH3COOOH ','EO2 ', & + 'EO ','EOOH ','PAN ','C3H6 ','C3H8 ', & + 'C3H7O2 ','C3H7OOH ','CH3COCH3 ','PO2 ','POOH ', & + 'HYAC ','RO2 ','CH3COCHO ','ROOH ','BIGENE ', & + 'BIGALK ','MEK ','ENEO2 ','MEKO2 ','MEKOOH ', & + 'MCO3 ','MVK ','MACR ','MACRO2 ','MACROOH ', & + 'MPAN ','ONIT ','ISOP ','ALKO2 ','ALKOOH ', & + 'BIGALD ','HYDRALD ','ISOPO2 ','ISOPNO3 ','ONITR ', & + 'XO2 ','XOOH ','ISOPOOH ','TOLUENE ','CRESOL ', & + 'TOLO2 ','TOLOOH ','XOH ','BENZENE ','BENO2 ', & + 'BENOOH ','XYLENE ','XYLO2 ','XYLOOH ','C10H16 ', & + 'TERPO2 ','TERPOOH ','CH3CL ','CH3BR ','CFC11 ', & + 'CFC12 ','CFC113 ','HCFC22 ','CCL4 ','CH3CCL3 ', & + 'CF3BR ','CF2CLBR ','HCFC141B ','HCFC142B ','CFC114 ', & + 'CFC115 ','H1202 ','H2402 ','CHBR3 ','CH2BR2 ', & + 'CO2 ','N2p ','O2p ','Np ','Op ', & + 'NOp ','e ','N2D ','H2O ','C2H2 ', & + 'HCOOH ','HOCH2OO ','COF2 ','COFCL ','HF ', & + 'F ','CB1 ','CB2 ','OC1 ','OC2 ', & + 'SOAM ','SOAI ','SOAT ','SOAB ','SOAX ', & + 'SOGM ','SOGI ','SOGT ','SOGB ','SOGX ', & + 'SO2 ','DMS ','SO4 ','NH3 ','NH4 ', & + 'NH4NO3 ','SSLT01 ','SSLT02 ','SSLT03 ','SSLT04 ', & + 'DST01 ','DST02 ','DST03 ','DST04 ','NH_5 ', & + 'NH_50 ','NH_50W ','AOA_NH ','ST80_25 ','CO_25 ', & + 'CO_50 ','SO2t ','SF6 ','SF6em ','O3S ', & + 'E90 ','E90_NH ','E90_SH ' /) + + adv_mass(:183) = (/ 47.998200_r8, 15.999400_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, & + 31.998800_r8, 44.012880_r8, 14.006740_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 63.012340_r8, 79.011740_r8, 108.010480_r8, 16.040600_r8, & + 47.032000_r8, 48.039400_r8, 32.040000_r8, 30.025200_r8, 28.010400_r8, & + 2.014800_r8, 1.007400_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, & + 100.916850_r8, 99.716850_r8, 35.452700_r8, 70.905400_r8, 51.452100_r8, & + 67.451500_r8, 102.904200_r8, 36.460100_r8, 52.459500_r8, 97.457640_r8, & + 115.356700_r8, 79.904000_r8, 95.903400_r8, 80.911400_r8, 96.910800_r8, & + 141.908940_r8, 27.025140_r8, 41.050940_r8, 28.051600_r8, 30.066400_r8, & + 61.057800_r8, 62.065200_r8, 75.042400_r8, 60.050400_r8, 44.051000_r8, & + 46.065800_r8, 60.050400_r8, 58.035600_r8, 76.049800_r8, 77.057200_r8, & + 61.057800_r8, 78.064600_r8, 121.047940_r8, 42.077400_r8, 44.092200_r8, & + 75.083600_r8, 76.091000_r8, 58.076800_r8, 91.083000_r8, 92.090400_r8, & + 74.076200_r8, 89.068200_r8, 72.061400_r8, 90.075600_r8, 56.103200_r8, & + 72.143800_r8, 72.102600_r8, 105.108800_r8, 103.094000_r8, 104.101400_r8, & + 101.079200_r8, 70.087800_r8, 70.087800_r8, 119.093400_r8, 120.100800_r8, & + 147.084740_r8, 119.074340_r8, 68.114200_r8, 103.135200_r8, 104.142600_r8, & + 98.098200_r8, 100.113000_r8, 117.119800_r8, 162.117940_r8, 147.125940_r8, & + 149.118600_r8, 150.126000_r8, 118.127200_r8, 92.136200_r8, 108.135600_r8, & + 173.140600_r8, 174.148000_r8, 190.147400_r8, 78.110400_r8, 127.116000_r8, & + 128.123400_r8, 106.162000_r8, 155.167600_r8, 156.175000_r8, 136.228400_r8, & + 185.234000_r8, 186.241400_r8, 50.485900_r8, 94.937200_r8, 137.367503_r8, & + 120.913206_r8, 187.375310_r8, 86.467906_r8, 153.821800_r8, 133.402300_r8, & + 148.910210_r8, 165.364506_r8, 116.948003_r8, 100.493706_r8, 170.921013_r8, & + 154.466716_r8, 209.815806_r8, 259.823613_r8, 252.730400_r8, 173.833800_r8, & + 44.009800_r8, 28.013480_r8, 31.998800_r8, 14.006740_r8, 15.999400_r8, & + 30.006140_r8, 0.548567E-03_r8, 14.006740_r8, 18.014200_r8, 26.036800_r8, & + 46.024600_r8, 63.031400_r8, 66.007206_r8, 82.461503_r8, 20.005803_r8, & + 18.998403_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 200.226000_r8, 136.141400_r8, 141.141800_r8, 127.116000_r8, 155.167600_r8, & + 200.226000_r8, 136.141400_r8, 141.141800_r8, 127.116000_r8, 155.167600_r8, & + 64.064800_r8, 62.132400_r8, 96.063600_r8, 17.028940_r8, 18.036340_r8, & + 80.041280_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, 28.010400_r8, & + 28.010400_r8, 28.010400_r8, 28.010400_r8, 28.010400_r8, 28.010400_r8, & + 28.010400_r8, 64.064800_r8, 146.056419_r8, 146.056419_r8, 47.998200_r8, & + 28.010400_r8, 28.010400_r8, 28.010400_r8 /) + + crb_mass(:183) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 48.044000_r8, & + 60.055000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 84.077000_r8, 84.077000_r8, & + 84.077000_r8, 84.077000_r8, 84.077000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 120.110000_r8, 60.055000_r8, 84.077000_r8, 72.066000_r8, 96.088000_r8, & + 120.110000_r8, 60.055000_r8, 84.077000_r8, 72.066000_r8, 96.088000_r8, & + 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 37,1) = (/ 180, 15, 7, 108, 109, 110, 111, 112, 120, 121, & + 113, 118, 119, 114, 115, 116, 117, 122, 123, 124, & + 125, 126, 26, 27, 181, 182, 183, 170, 171, 172, & + 173, 174, 175, 176, 177, 178, 179 /) + clsmap(:146,4) = (/ 1, 2, 3, 4, 5, 6, 21, 20, 8, 9, & + 10, 23, 11, 12, 13, 14, 16, 17, 42, 43, & + 19, 22, 24, 25, 134, 28, 29, 30, 31, 32, & + 33, 34, 35, 36, 37, 38, 39, 40, 41, 127, & + 128, 129, 130, 131, 133, 132, 59, 83, 64, 50, & + 49, 65, 48, 54, 58, 82, 45, 44, 71, 81, & + 70, 73, 84, 85, 72, 74, 75, 94, 95, 96, & + 97, 98, 106, 107, 86, 53, 99, 100, 101, 102, & + 103, 104, 88, 77, 78, 79, 80, 76, 46, 47, & + 105, 60, 61, 62, 63, 69, 18, 51, 52, 66, & + 55, 56, 57, 87, 67, 68, 89, 90, 91, 92, & + 93, 135, 136, 137, 138, 139, 140, 141, 156, 157, & + 158, 159, 160, 161, 146, 147, 148, 149, 150, 151, & + 152, 153, 154, 155, 142, 143, 144, 145, 162, 163, & + 164, 165, 166, 167, 168, 169 /) + + permute(:146,4) = (/ 139, 146, 143, 129, 43, 42, 120, 115, 105, 134, & + 144, 138, 135, 131, 73, 55, 136, 67, 47, 34, & + 140, 141, 142, 89, 130, 145, 44, 132, 37, 28, & + 137, 107, 113, 50, 133, 128, 104, 96, 80, 92, & + 98, 72, 88, 99, 76, 100, 114, 109, 103, 116, & + 87, 82, 127, 75, 74, 61, 53, 77, 29, 81, & + 30, 56, 93, 90, 68, 91, 57, 38, 39, 84, & + 62, 45, 112, 70, 85, 95, 31, 63, 1, 32, & + 71, 2, 123, 125, 119, 124, 58, 126, 106, 59, & + 86, 35, 108, 64, 94, 65, 79, 51, 110, 118, & + 97, 69, 40, 60, 117, 121, 102, 111, 122, 52, & + 83, 54, 78, 66, 41, 46, 48, 101, 36, 49, & + 3, 33, 4, 5, 6, 7, 8, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27 /) + + diag_map(:146) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 18, 19, 21, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 33, 36, & + 39, 42, 45, 48, 51, 56, 58, 61, 66, 69, & + 72, 75, 78, 80, 82, 86, 90, 94, 98, 103, & + 106, 110, 114, 120, 126, 132, 139, 144, 149, 154, & + 157, 161, 168, 174, 180, 186, 192, 198, 203, 208, & + 216, 223, 230, 237, 244, 250, 255, 263, 267, 271, & + 279, 287, 295, 304, 312, 318, 327, 331, 338, 346, & + 357, 366, 380, 391, 397, 402, 412, 420, 429, 440, & + 448, 456, 467, 477, 489, 501, 511, 520, 534, 552, & + 558, 568, 581, 594, 609, 614, 625, 637, 644, 657, & + 669, 684, 707, 731, 750, 770, 799, 816, 843, 856, & + 870, 890, 912, 971,1013,1054,1079,1179,1223,1245, & + 1263,1337,1362,1398,1433,1471 /) + + extfrc_lst(: 15) = (/ 'NO ','NO2 ','CO ','SO2 ','SO4 ', & + 'CB1 ','Op ','O2p ','Np ','N2p ', & + 'N2D ','N ','e ','OH ','AOA_NH ' /) + + frc_from_dataset(: 15) = (/ .true., .true., .true., .true., .true., & + .true., .false., .false., .false., .false., & + .false., .false., .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jhbr ', & + 'jbrono2_a ', 'jbrono2_b ', & + 'jch3cl ', 'jccl4 ', & + 'jch3ccl3 ', 'jcfcl3 ', & + 'jcf2cl2 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jhcfc22 ', 'jhcfc141b ', & + 'jhcfc142b ', 'jch3br ', & + 'jcf3br ', 'jcf2clbr ', & + 'jchbr3 ', 'jch2br2 ', & + 'jh1202 ', 'jh2402 ', & + 'jcof2 ', 'jcofcl ', & + 'jhf ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jch3cho ', 'jpooh ', & + 'jch3co3h ', 'jpan ', & + 'jmpan ', 'jmacr_a ', & + 'jmacr_b ', 'jmvk ', & + 'jc2h5ooh ', 'jeooh ', & + 'jc3h7ooh ', 'jrooh ', & + 'jacet ', 'jmgly ', & + 'jxooh ', 'jonitr ', & + 'jisopooh ', 'jhyac ', & + 'jglyald ', 'jmek ', & + 'jbigald ', 'jglyoxal ', & + 'jalkooh ', 'jmekooh ', & + 'jtolooh ', 'jterpooh ', & + 'jsf6 ', 'jsf6em ', & + 'jeuv_1 ', 'jeuv_2 ', & + 'jeuv_3 ', 'jeuv_4 ', & + 'jeuv_5 ', 'jeuv_6 ', & + 'jeuv_7 ', 'jeuv_8 ', & + 'jeuv_9 ', 'jeuv_10 ', & + 'jeuv_11 ', 'jeuv_12 ', & + 'jeuv_13 ', 'jeuv_14 ', & + 'jeuv_15 ', 'jeuv_16 ', & + 'jeuv_17 ', 'jeuv_18 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_24 ', & + 'jeuv_25 ', 'jeuv_26 ', & + 'usr_O_O2 ', 'O_O3 ', & + 'usr_O_O ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_N2 ', & + 'O2_1S_O3 ', 'O2_1S_CO2 ', & + 'ag2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1D_N2 ', & + 'ag1 ', 'O1D_N2 ', & + 'O1D_O2 ', 'O1D_O2b ', & + 'O1D_H2O ', 'O1D_N2Oa ', & + 'O1D_N2Ob ', 'O1D_O3 ', & + 'O1D_CFC11 ', 'O1D_CFC12 ', & + 'O1D_CFC113 ', 'O1D_CFC114 ', & + 'O1D_CFC115 ', 'O1D_HCFC22 ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_CCL4 ', 'O1D_CH3BR ', & + 'O1D_CF2CLBR ', 'O1D_CF3BR ', & + 'O1D_H1202 ', 'O1D_H2402 ', & + 'O1D_CHBR3 ', 'O1D_CH2BR2 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_H2 ', & + 'O1D_HCL ', 'O1D_HBR ', & + 'O1D_HCN ', 'H_O2 ', & + 'H_O3 ', 'H_HO2a ', & + 'H_HO2 ', 'H_HO2b ', & + 'OH_O ', 'OH_O3 ', & + 'OH_HO2 ', 'OH_OH ', & + 'OH_OH_M ', 'OH_H2 ', & + 'OH_H2O2 ', 'H2_O ', & + 'HO2_O ', 'HO2_O3 ', & + 'usr_HO2_HO2 ', 'H2O2_O ', & + 'HCN_OH ', 'CH3CN_OH ', & + 'N2D_O2 ', 'N2D_O ', & + 'N_OH ', 'N_O2 ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'NO_O_M ', 'NO_HO2 ', & + 'NO_O3 ', 'NO2_O ', & + 'NO2_O_M ', 'NO2_O3 ', & + 'tag_NO2_NO3 ', 'usr_N2O5_M ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'NO3_NO ', 'NO3_O ', & + 'NO3_OH ', 'NO3_HO2 ' /) + rxt_tag_lst( 201: 400) = (/ 'tag_NO2_HO2 ', 'HO2NO2_OH ', & + 'usr_HO2NO2_M ', 'CL_O3 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'CLO_HO2 ', & + 'CLO_CH3O2 ', 'CLO_NO ', & + 'CLO_NO2_M ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'HCL_OH ', 'HCL_O ', & + 'HOCL_O ', 'HOCL_CL ', & + 'HOCL_OH ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLONO2_CL ', & + 'BR_O3 ', 'BR_HO2 ', & + 'BR_CH2O ', 'BRO_O ', & + 'BRO_OH ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_BRO ', & + 'HBR_OH ', 'HBR_O ', & + 'HOBR_O ', 'BRONO2_O ', & + 'F_H2O ', 'F_H2 ', & + 'F_CH4 ', 'F_HNO3 ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CH3CCL3_OH ', 'HCFC22_OH ', & + 'CH3BR_OH ', 'CH3BR_CL ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'CH2BR2_OH ', 'CHBR3_OH ', & + 'CH2BR2_CL ', 'CHBR3_CL ', & + 'CH4_OH ', 'usr_CO_OH_b ', & + 'CO_OH_M ', 'CH2O_NO3 ', & + 'CH2O_OH ', 'CH2O_O ', & + 'CH2O_HO2 ', 'CH3O2_NO ', & + 'CH3O2_HO2 ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'HCOOH_OH ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'HOCH2OO_HO2 ', 'C2H2_CL_M ', & + 'C2H4_CL_M ', 'C2H6_CL ', & + 'C2H2_OH_M ', 'C2H6_OH ', & + 'tag_C2H4_OH ', 'EO2_NO ', & + 'EO2_HO2 ', 'EO_O2 ', & + 'EO_M ', 'C2H4_O3 ', & + 'CH3COOH_OH ', 'C2H5O2_NO ', & + 'C2H5O2_HO2 ', 'C2H5O2_CH3O2 ', & + 'C2H5O2_C2H5O2 ', 'C2H5OOH_OH ', & + 'CH3CHO_OH ', 'CH3CHO_NO3 ', & + 'CH3CO3_NO ', 'tag_CH3CO3_NO2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_CH3CO3 ', 'CH3COOOH_OH ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'C2H5OH_OH ', 'usr_PAN_M ', & + 'PAN_OH ', 'tag_C3H6_OH ', & + 'C3H6_O3 ', 'C3H6_NO3 ', & + 'C3H7O2_NO ', 'C3H7O2_HO2 ', & + 'CH3H7O2_CH3O2 ', 'CH3H7OOH_OH ', & + 'C3H8_OH ', 'PO2_NO ', & + 'PO2_HO2 ', 'POOH_OH ', & + 'usr_CH3COCH3_OH ', 'RO2_NO ', & + 'RO2_HO2 ', 'RO2_CH3O2 ', & + 'ROOH_OH ', 'HYAC_OH ', & + 'CH3COCHO_OH ', 'CH3COCHO_NO3 ', & + 'ONIT_OH ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'MVK_OH ', & + 'MVK_O3 ', 'MEK_OH ', & + 'MEKO2_NO ', 'MEKO2_HO2 ', & + 'MEKOOH_OH ', 'MACR_OH ', & + 'MACR_O3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACRO2_NO3 ', & + 'MACRO2_HO2 ', 'MACRO2_CH3O2 ', & + 'MACRO2_CH3CO3 ', 'MACROOH_OH ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MCO3_HO2 ', 'MCO3_CH3O2 ', & + 'MCO3_CH3CO3 ', 'MCO3_MCO3 ', & + 'usr_MCO3_NO2 ', 'usr_MPAN_M ', & + 'MPAN_OH_M ', 'ISOP_OH ', & + 'ISOP_O3 ', 'ISOP_NO3 ', & + 'ISOPO2_NO ', 'ISOPO2_NO3 ', & + 'ISOPO2_HO2 ', 'ISOPOOH_OH ', & + 'ISOPO2_CH3O2 ', 'ISOPO2_CH3CO3 ', & + 'ISOPNO3_NO ', 'ISOPNO3_NO3 ', & + 'ISOPNO3_HO2 ', 'BIGALK_OH ', & + 'ONITR_OH ', 'ONITR_NO3 ', & + 'HYDRALD_OH ', 'ALKO2_NO ', & + 'ALKO2_HO2 ', 'ALKOOH_OH ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XO2_HO2 ', 'XO2_CH3O2 ', & + 'XO2_CH3CO3 ', 'XOOH_OHa ', & + 'usr_XOOH_OH ', 'TOLUENE_OH ', & + 'TOLO2_NO ', 'TOLO2_HO2 ', & + 'TOLO2_OH ', 'CRESOL_OH ', & + 'XOH_NO2 ', 'BENZENE_OH ', & + 'BENO2_HO2 ', 'BENO2_NO ', & + 'XYLENE_OH ', 'XYLO2_HO2 ', & + 'XYLO2_NO ', 'C10H16_OH ', & + 'C10H16_O3 ', 'C10H16_NO3 ', & + 'TERPO2_NO ', 'TERPO2_HO2 ', & + 'TERPOOH_OH ', 'usr_N2O5_aer ' /) + rxt_tag_lst( 401: 472) = (/ 'usr_NO3_aer ', 'usr_NO2_aer ', & + 'CB1_CB2 ', 'usr_SO2_OH ', & + 'DMS_OHa ', 'usr_DMS_OH ', & + 'DMS_NO3 ', 'NH3_OH ', & + 'OC1_OC2 ', 'usr_HO2_aer ', & + 'usr_CB1_strat_tau ', 'usr_CB2_strat_tau ', & + 'usr_OC1_strat_tau ', 'usr_OC2_strat_tau ', & + 'usr_SO4_strat_tau ', 'usr_SOAM_strat_tau ', & + 'usr_SOAI_strat_tau ', 'usr_SOAB_strat_tau ', & + 'usr_SOAT_strat_tau ', 'usr_SOAX_strat_tau ', & + 'usr_NH4_strat_tau ', 'usr_NH4NO3_strat_tau ', & + 'usr_SSLT01_strat_tau ', 'usr_SSLT02_strat_tau ', & + 'usr_SSLT03_strat_tau ', 'usr_SSLT04_strat_tau ', & + 'usr_DST01_strat_tau ', 'usr_DST02_strat_tau ', & + 'usr_DST03_strat_tau ', 'usr_DST04_strat_tau ', & + 'usr_SO2t_strat_tau ', 'het1 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'ion_Op_O2 ', 'ion_Op_N2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Op_CO2 ', 'ion_O2p_N ', & + 'ion_O2p_NO ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_Np_O ', & + 'ion_N2p_O2 ', 'ion_O2p_N2 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'NH_5_tau ', & + 'NH_50_tau ', 'NH_50W_tau ', & + 'ST80_25_tau ', 'CO_25_tau ', & + 'CO_50_tau ', 'E90_tau ', & + 'E90_NH_tau ', 'E90_SH_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jsf6 ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', 'jh2o2 ', ' ', & + 'jpan ', ' ', ' ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', 'jch3ooh ', 'jch3cho ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jno2 ', 'jmgly ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', 'jsf6 ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 0.28_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 0.2_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 115, 116, 117, 118, 119, & + 120, 121, 124, 125, 126, & + 128, 129, 130, 160, 161, & + 163, 165, 166, 167, 173, & + 174, 175, 179, 180, 182, & + 183, 188, 189, 190, 449, & + 450, 451, 454, 455, 456, & + 457, 458, 459, 461, 462, & + 463 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.810000_r8, 32.910000_r8, 189.810000_r8, 203.400000_r8, 194.710000_r8, & + 232.590000_r8, 67.670000_r8, 165.300000_r8, 293.620000_r8, 226.580000_r8, & + 120.100000_r8, 165.510000_r8, 177.510000_r8, 229.610000_r8, 133.750000_r8, & + 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 3, 2, 3, 2, & + 3, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 2, 2, 3, 3, 2, 3, 2, & + 3, 2, 2, 2, 1, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 1, 1, 1, 2, & + 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc new file mode 100644 index 0000000000..f80fe5ddd4 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc @@ -0,0 +1,1877 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BENZENE (C6H6) + ( 8) BENZOOH (C6H8O5) + ( 9) BEPOMUC (C6H6O3) + ( 10) BIGALD (C5H6O2) + ( 11) BIGALD1 (C4H4O2) + ( 12) BIGALD2 (C5H6O2) + ( 13) BIGALD3 (C5H6O2) + ( 14) BIGALD4 (C6H8O2) + ( 15) BIGALK (C5H12) + ( 16) BIGENE (C4H8) + ( 17) BR (Br) + ( 18) BRCL (BrCl) + ( 19) BRO (BrO) + ( 20) BRONO2 (BrONO2) + ( 21) BRY + ( 22) BZALD (C7H6O) + ( 23) BZOOH (C7H8O2) + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH (C6H5OOH) + ( 33) CCL4 (CCl4) + ( 34) CF2CLBR (CF2ClBr) + ( 35) CF3BR (CF3Br) + ( 36) CFC11 (CFCl3) + ( 37) CFC113 (CCl2FCClF2) + ( 38) CFC114 (CClF2CClF2) + ( 39) CFC115 (CClF2CF3) + ( 40) CFC12 (CF2Cl2) + ( 41) CH2BR2 (CH2Br2) + ( 42) CH2O + ( 43) CH3BR (CH3Br) + ( 44) CH3CCL3 (CH3CCl3) + ( 45) CH3CHO + ( 46) CH3CL (CH3Cl) + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 (CHBr3) + ( 56) CL (Cl) + ( 57) CL2 (Cl2) + ( 58) CL2O2 (Cl2O2) + ( 59) CLO (ClO) + ( 60) CLONO2 (ClONO2) + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL (COFCl) + ( 66) CRESOL (C7H8O) + ( 67) DMS (CH3SCH3) + ( 68) dst_a1 (AlSiO5) + ( 69) dst_a2 (AlSiO5) + ( 70) dst_a3 (AlSiO5) + ( 71) E90 (CO) + ( 72) EOOH (HOCH2CH2OOH) + ( 73) F + ( 74) GLYALD (HOCH2CHO) + ( 75) GLYOXAL (C2H2O2) + ( 76) H + ( 77) H2 + ( 78) H2402 (CBrF2CBrF2) + ( 79) H2O2 + ( 80) H2SO4 (H2SO4) + ( 81) HBR (HBr) + ( 82) HCFC141B (CH3CCl2F) + ( 83) HCFC142B (CH3CClF2) + ( 84) HCFC22 (CHF2Cl) + ( 85) HCL (HCl) + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2NO2 + ( 91) HOBR (HOBr) + ( 92) HOCL (HOCl) + ( 93) HONITR (C4H9NO4) + ( 94) HPALD (HOOCH2CCH3CHCHO) + ( 95) HYAC (CH3COCH2OH) + ( 96) HYDRALD (HOCH2CCH3CHCHO) + ( 97) IEPOX (C5H10O3) + ( 98) ISOP (C5H8) + ( 99) ISOPNITA (C5H9NO4) + (100) ISOPNITB (C5H9NO4) + (101) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (102) ISOPNOOH (C5H9NO5) + (103) ISOPOOH (HOCH2COOHCH3CHCH2) + (104) IVOC (C13H28) + (105) MACR (CH2CCH3CHO) + (106) MACROOH (CH3COCHOOHCH2OH) + (107) MEK (C4H8O) + (108) MEKOOH (C4H8O3) + (109) MPAN (CH2CCH3CO3NO2) + (110) MTERP (C10H16) + (111) MVK (CH2CHCOCH3) + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH (C5H9NO4) + (116) NC4CHO (C5H7NO4) + (117) ncl_a1 (NaCl) + (118) ncl_a2 (NaCl) + (119) ncl_a3 (NaCl) + (120) NH3 + (121) NH4 + (122) NH_5 (CO) + (123) NH_50 (CO) + (124) NO + (125) NO2 + (126) NO3 + (127) NOA (CH3COCH2ONO2) + (128) NTERPOOH (C10H17NO5) + (129) num_a1 (H) + (130) num_a2 (H) + (131) num_a3 (H) + (132) num_a4 (H) + (133) O + (134) O2 + (135) O3 + (136) OCLO (OClO) + (137) OCS (OCS) + (138) ONITR (C4H7NO4) + (139) PAN (CH3CO3NO2) + (140) PBZNIT (C7H5O3NO2) + (141) PHENO (C6H5O) + (142) PHENOL (C6H5OH) + (143) PHENOOH (C6H8O6) + (144) pom_a1 (C) + (145) pom_a4 (C) + (146) POOH (C3H6OHOOH) + (147) ROOH (CH3COCH2OOH) + (148) S (S) + (149) SF6 + (150) SO (SO) + (151) SO2 + (152) SO3 (SO3) + (153) so4_a1 (NH4HSO4) + (154) so4_a2 (NH4HSO4) + (155) so4_a3 (NH4HSO4) + (156) soa1_a1 (C15H38O2) + (157) soa1_a2 (C15H38O2) + (158) soa2_a1 (C15H38O2) + (159) soa2_a2 (C15H38O2) + (160) soa3_a1 (C15H38O2) + (161) soa3_a2 (C15H38O2) + (162) soa4_a1 (C15H38O2) + (163) soa4_a2 (C15H38O2) + (164) soa5_a1 (C15H38O2) + (165) soa5_a2 (C15H38O2) + (166) SOAG0 (C15H38O2) + (167) SOAG1 (C15H38O2) + (168) SOAG2 (C15H38O2) + (169) SOAG3 (C15H38O2) + (170) SOAG4 (C15H38O2) + (171) ST80_25 (CO) + (172) SVOC (C22H46) + (173) TEPOMUC (C7H8O3) + (174) TERP2OOH (C10H18O3) + (175) TERPNIT (C10H17NO4) + (176) TERPOOH (C10H18O3) + (177) TERPROD1 (C10H16O2) + (178) TERPROD2 (C9H14O2) + (179) TOLOOH (C7H10O5) + (180) TOLUENE (C7H8) + (181) XOOH (HOCH2COOHCH3CHOHCHO) + (182) XYLENES (C8H10) + (183) XYLENOOH (C8H12O5) + (184) XYLOL (C8H10O) + (185) XYLOLOOH (C8H12O6) + (186) NHDEP (N) + (187) NDEP (N) + (188) ACBZO2 (C7H5O3) + (189) ALKO2 (C5H11O2) + (190) BENZO2 (C6H7O5) + (191) BZOO (C7H7O2) + (192) C2H5O2 + (193) C3H7O2 + (194) C6H5O2 + (195) CH3CO3 + (196) CH3O2 + (197) DICARBO2 (C5H5O4) + (198) e (E) + (199) ENEO2 (C4H9O3) + (200) EO (HOCH2CH2O) + (201) EO2 (HOCH2CH2O2) + (202) HO2 + (203) HOCH2OO + (204) ISOPAO2 (HOC5H8O2) + (205) ISOPBO2 (HOC5H8O2) + (206) MACRO2 (CH3COCHO2CH2OH) + (207) MALO2 (C4H3O4) + (208) MCO3 (CH2CCH3CO3) + (209) MDIALO2 (C4H5O4) + (210) MEKO2 (C4H7O3) + (211) N2D (N) + (212) N2p (N2) + (213) NOp (NO) + (214) Np (N) + (215) NTERPO2 (C10H16NO5) + (216) O1D (O) + (217) O2_1D (O2) + (218) O2_1S (O2) + (219) O2p (O2) + (220) OH + (221) Op (O) + (222) PHENO2 (C6H7O6) + (223) PO2 (C3H6OHO2) + (224) RO2 (CH3COCH2O2) + (225) TERP2O2 (C10H15O4) + (226) TERPO2 (C10H17O3) + (227) TOLO2 (C7H9O5) + (228) XO2 (HOCH2COOCH3CHOHCHO) + (229) XYLENO2 (C8H11O5) + (230) XYLOLO2 (C8H11O6) + (231) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) AOA_NH + ( 2) BRY + ( 3) CCL4 + ( 4) CF2CLBR + ( 5) CF3BR + ( 6) CFC11 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) CFC12 + ( 11) CH2BR2 + ( 12) CH3BR + ( 13) CH3CCL3 + ( 14) CH3CL + ( 15) CH4 + ( 16) CHBR3 + ( 17) CLY + ( 18) CO2 + ( 19) E90 + ( 20) H2402 + ( 21) HCFC141B + ( 22) HCFC142B + ( 23) HCFC22 + ( 24) N2O + ( 25) NH_5 + ( 26) NH_50 + ( 27) SF6 + ( 28) ST80_25 + ( 29) NHDEP + ( 30) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) bc_a1 + ( 4) bc_a4 + ( 5) BCARY + ( 6) BENZENE + ( 7) BENZOOH + ( 8) BEPOMUC + ( 9) BIGALD + ( 10) BIGALD1 + ( 11) BIGALD2 + ( 12) BIGALD3 + ( 13) BIGALD4 + ( 14) BIGALK + ( 15) BIGENE + ( 16) BR + ( 17) BRCL + ( 18) BRO + ( 19) BRONO2 + ( 20) BZALD + ( 21) BZOOH + ( 22) C2H2 + ( 23) C2H4 + ( 24) C2H5OH + ( 25) C2H5OOH + ( 26) C2H6 + ( 27) C3H6 + ( 28) C3H7OOH + ( 29) C3H8 + ( 30) C6H5OOH + ( 31) CH2O + ( 32) CH3CHO + ( 33) CH3CN + ( 34) CH3COCH3 + ( 35) CH3COCHO + ( 36) CH3COOH + ( 37) CH3COOOH + ( 38) CH3OH + ( 39) CH3OOH + ( 40) CL + ( 41) CL2 + ( 42) CL2O2 + ( 43) CLO + ( 44) CLONO2 + ( 45) CO + ( 46) COF2 + ( 47) COFCL + ( 48) CRESOL + ( 49) DMS + ( 50) dst_a1 + ( 51) dst_a2 + ( 52) dst_a3 + ( 53) EOOH + ( 54) F + ( 55) GLYALD + ( 56) GLYOXAL + ( 57) H + ( 58) H2 + ( 59) H2O2 + ( 60) H2SO4 + ( 61) HBR + ( 62) HCL + ( 63) HCN + ( 64) HCOOH + ( 65) HF + ( 66) HNO3 + ( 67) HO2NO2 + ( 68) HOBR + ( 69) HOCL + ( 70) HONITR + ( 71) HPALD + ( 72) HYAC + ( 73) HYDRALD + ( 74) IEPOX + ( 75) ISOP + ( 76) ISOPNITA + ( 77) ISOPNITB + ( 78) ISOPNO3 + ( 79) ISOPNOOH + ( 80) ISOPOOH + ( 81) IVOC + ( 82) MACR + ( 83) MACROOH + ( 84) MEK + ( 85) MEKOOH + ( 86) MPAN + ( 87) MTERP + ( 88) MVK + ( 89) N + ( 90) N2O5 + ( 91) NC4CH2OH + ( 92) NC4CHO + ( 93) ncl_a1 + ( 94) ncl_a2 + ( 95) ncl_a3 + ( 96) NH3 + ( 97) NH4 + ( 98) NO + ( 99) NO2 + (100) NO3 + (101) NOA + (102) NTERPOOH + (103) num_a1 + (104) num_a2 + (105) num_a3 + (106) num_a4 + (107) O + (108) O2 + (109) O3 + (110) OCLO + (111) OCS + (112) ONITR + (113) PAN + (114) PBZNIT + (115) PHENO + (116) PHENOL + (117) PHENOOH + (118) pom_a1 + (119) pom_a4 + (120) POOH + (121) ROOH + (122) S + (123) SO + (124) SO2 + (125) SO3 + (126) so4_a1 + (127) so4_a2 + (128) so4_a3 + (129) soa1_a1 + (130) soa1_a2 + (131) soa2_a1 + (132) soa2_a2 + (133) soa3_a1 + (134) soa3_a2 + (135) soa4_a1 + (136) soa4_a2 + (137) soa5_a1 + (138) soa5_a2 + (139) SOAG0 + (140) SOAG1 + (141) SOAG2 + (142) SOAG3 + (143) SOAG4 + (144) SVOC + (145) TEPOMUC + (146) TERP2OOH + (147) TERPNIT + (148) TERPOOH + (149) TERPROD1 + (150) TERPROD2 + (151) TOLOOH + (152) TOLUENE + (153) XOOH + (154) XYLENES + (155) XYLENOOH + (156) XYLOL + (157) XYLOLOOH + (158) ACBZO2 + (159) ALKO2 + (160) BENZO2 + (161) BZOO + (162) C2H5O2 + (163) C3H7O2 + (164) C6H5O2 + (165) CH3CO3 + (166) CH3O2 + (167) DICARBO2 + (168) e + (169) ENEO2 + (170) EO + (171) EO2 + (172) HO2 + (173) HOCH2OO + (174) ISOPAO2 + (175) ISOPBO2 + (176) MACRO2 + (177) MALO2 + (178) MCO3 + (179) MDIALO2 + (180) MEKO2 + (181) N2D + (182) N2p + (183) NOp + (184) Np + (185) NTERPO2 + (186) O1D + (187) O2_1D + (188) O2_1S + (189) O2p + (190) OH + (191) Op + (192) PHENO2 + (193) PO2 + (194) RO2 + (195) TERP2O2 + (196) TERPO2 + (197) TOLO2 + (198) XO2 + (199) XYLENO2 + (200) XYLOLO2 + (201) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jalknit ( 20) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + jalkooh ( 21) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 21) + + 0.8*MEK + OH + jbenzooh ( 22) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 22) + jbepomuc ( 23) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 23) + jbigald ( 24) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 24) + + 0.18*CH3COCHO + jbigald1 ( 25) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 25) + jbigald2 ( 26) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 26) + jbigald3 ( 27) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 27) + jbigald4 ( 28) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 28) + jbzooh ( 29) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 29) + jc2h5ooh ( 30) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 30) + jc3h7ooh ( 31) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 31) + jc6h5ooh ( 32) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 32) + jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) + jch2o_b ( 34) CH2O + hv -> CO + H2 rate = ** User defined ** ( 34) + jch3cho ( 35) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 35) + jacet ( 36) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 36) + jmgly ( 37) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 37) + jch3co3h ( 38) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 38) + jch3ooh ( 39) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 39) + jch4_a ( 40) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 40) + jch4_b ( 41) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 41) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 42) CO2 + hv -> CO + O rate = ** User defined ** ( 42) + jeooh ( 43) EOOH + hv -> EO + OH rate = ** User defined ** ( 43) + jglyald ( 44) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 44) + jglyoxal ( 45) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 45) + jhonitr ( 46) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 46) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 47) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 47) + jhyac ( 48) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 48) + jisopnooh ( 49) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 49) + jisopooh ( 50) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) + jmacr_b ( 52) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 52) + jmek ( 53) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 53) + jmekooh ( 54) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 54) + jmpan ( 55) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 55) + jmvk ( 56) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 56) + jnc4cho ( 57) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 57) + jnoa ( 58) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 58) + jnterpooh ( 59) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 59) + jonitr ( 60) ONITR + hv -> NO2 rate = ** User defined ** ( 60) + jpan ( 61) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 61) + jphenooh ( 62) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 62) + jpooh ( 63) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 63) + jrooh ( 64) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 64) + jtepomuc ( 65) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 65) + jterp2ooh ( 66) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 66) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 67) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 67) + jterpooh ( 68) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 68) + jterprd1 ( 69) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 69) + jterprd2 ( 70) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 70) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 71) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 71) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 72) XOOH + hv -> OH rate = ** User defined ** ( 72) + jxylenooh ( 73) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 73) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 74) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 74) + jbrcl ( 75) BRCL + hv -> BR + CL rate = ** User defined ** ( 75) + jbro ( 76) BRO + hv -> BR + O rate = ** User defined ** ( 76) + jbrono2_b ( 77) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 77) + jbrono2_a ( 78) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 78) + jccl4 ( 79) CCL4 + hv -> 4*CL rate = ** User defined ** ( 79) + jcf2clbr ( 80) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 80) + jcf3br ( 81) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 81) + jcfcl3 ( 82) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 82) + jcfc113 ( 83) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 83) + jcfc114 ( 84) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 84) + jcfc115 ( 85) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 85) + jcf2cl2 ( 86) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 86) + jch2br2 ( 87) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 87) + jch3br ( 88) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 88) + jch3ccl3 ( 89) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 89) + jch3cl ( 90) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 90) + jchbr3 ( 91) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 91) + jcl2 ( 92) CL2 + hv -> 2*CL rate = ** User defined ** ( 92) + jcl2o2 ( 93) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 93) + jclo ( 94) CLO + hv -> CL + O rate = ** User defined ** ( 94) + jclono2_a ( 95) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 95) + jclono2_b ( 96) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 96) + jcof2 ( 97) COF2 + hv -> 2*F rate = ** User defined ** ( 97) + jcofcl ( 98) COFCL + hv -> F + CL rate = ** User defined ** ( 98) + jh2402 ( 99) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 99) + jhbr (100) HBR + hv -> BR + H rate = ** User defined ** (100) + jhcfc141b (101) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (101) + jhcfc142b (102) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (102) + jhcfc22 (103) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (103) + jhcl (104) HCL + hv -> H + CL rate = ** User defined ** (104) + jhf (105) HF + hv -> H + F rate = ** User defined ** (105) + jhobr (106) HOBR + hv -> BR + OH rate = ** User defined ** (106) + jhocl (107) HOCL + hv -> OH + CL rate = ** User defined ** (107) + joclo (108) OCLO + hv -> O + CLO rate = ** User defined ** (108) + jsf6 (109) SF6 + hv -> {sink} rate = ** User defined ** (109) + jeuv_26 (110) CO2 + hv -> CO + O rate = ** User defined ** (110) + jeuv_4 (111) N + hv -> Np + e rate = ** User defined ** (111) + jeuv_13 (112) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (112) + jeuv_11 (113) N2 + hv -> N2D + Np + e rate = ** User defined ** (113) + jeuv_6 (114) N2 + hv -> N2p + e rate = ** User defined ** (114) + jeuv_10 (115) N2 + hv -> N + Np + e rate = ** User defined ** (115) + jeuv_22 (116) N2 + hv -> N + Np + e rate = ** User defined ** (116) + jeuv_23 (117) N2 + hv -> N2D + Np + e rate = ** User defined ** (117) + jeuv_25 (118) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (118) + jeuv_18 (119) N2 + hv -> N2p + e rate = ** User defined ** (119) + jeuv_2 (120) O + hv -> Op + e rate = ** User defined ** (120) + jeuv_1 (121) O + hv -> Op + e rate = ** User defined ** (121) + jeuv_16 (122) O + hv -> Op + e rate = ** User defined ** (122) + jeuv_15 (123) O + hv -> Op + e rate = ** User defined ** (123) + jeuv_14 (124) O + hv -> Op + e rate = ** User defined ** (124) + jeuv_3 (125) O + hv -> Op + e rate = ** User defined ** (125) + jeuv_17 (126) O2 + hv -> O2p + e rate = ** User defined ** (126) + jeuv_9 (127) O2 + hv -> O + Op + e rate = ** User defined ** (127) + jeuv_8 (128) O2 + hv -> O + Op + e rate = ** User defined ** (128) + jeuv_7 (129) O2 + hv -> O + Op + e rate = ** User defined ** (129) + jeuv_5 (130) O2 + hv -> O2p + e rate = ** User defined ** (130) + jeuv_19 (131) O2 + hv -> O + Op + e rate = ** User defined ** (131) + jeuv_20 (132) O2 + hv -> O + Op + e rate = ** User defined ** (132) + jeuv_21 (133) O2 + hv -> O + Op + e rate = ** User defined ** (133) + jeuv_24 (134) O2 + hv -> 2*O rate = ** User defined ** (134) + jeuv_12 (135) O2 + hv -> 2*O rate = ** User defined ** (135) + jh2so4 (136) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (136) + jocs (137) OCS + hv -> S + CO rate = ** User defined ** (137) + jso (138) SO + hv -> S + O rate = ** User defined ** (138) + jso2 (139) SO2 + hv -> SO + O rate = ** User defined ** (139) + jso3 (140) SO3 + hv -> SO2 + O rate = ** User defined ** (140) + jsoa1_a1 (141) soa1_a1 + hv -> (No products) rate = ** User defined ** (141) + jsoa1_a2 (142) soa1_a2 + hv -> (No products) rate = ** User defined ** (142) + jsoa2_a1 (143) soa2_a1 + hv -> (No products) rate = ** User defined ** (143) + jsoa2_a2 (144) soa2_a2 + hv -> (No products) rate = ** User defined ** (144) + jsoa3_a1 (145) soa3_a1 + hv -> (No products) rate = ** User defined ** (145) + jsoa3_a2 (146) soa3_a2 + hv -> (No products) rate = ** User defined ** (146) + jsoa4_a1 (147) soa4_a1 + hv -> (No products) rate = ** User defined ** (147) + jsoa4_a2 (148) soa4_a2 + hv -> (No products) rate = ** User defined ** (148) + jsoa5_a1 (149) soa5_a1 + hv -> (No products) rate = ** User defined ** (149) + jsoa5_a2 (150) soa5_a2 + hv -> (No products) rate = ** User defined ** (150) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 (151) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 (152) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 (153) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (154) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (155) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) (156) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) (157) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 (158) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (159) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (160) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (161) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (162) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (163) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (164) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (165) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (166) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (167) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (168) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (169) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (170) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (171) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (172) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (173) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (174) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (175) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (176) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (177) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (178) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (179) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (180) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (181) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (182) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (183) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (184) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (185) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (186) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (187) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (188) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (189) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (190) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (191) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (192) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (193) + N_O2 ( 44) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (194) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (195) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (196) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (197) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (198) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (199) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.00E-11 (200) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (201) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (202) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (203) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (204) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (205) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (206) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (207) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (208) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (209) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (210) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (211) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (212) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (213) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (214) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (215) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (216) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (217) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (218) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (219) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (220) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (221) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (222) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (223) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (224) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (225) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (226) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (227) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (228) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (229) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (230) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (231) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (232) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (233) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (234) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (235) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (236) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (237) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (238) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (239) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (240) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (241) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (242) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (243) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (244) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (245) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (246) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (247) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (248) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (249) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (250) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (251) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (252) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (253) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (254) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (255) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (256) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (257) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (258) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (259) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (260) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (261) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (262) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (263) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (264) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (265) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (266) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (267) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (268) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (269) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (270) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (271) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (272) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (273) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (274) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (275) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (276) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (277) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (278) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (279) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (280) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (281) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (282) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (283) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (284) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (285) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (286) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (287) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (288) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (289) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (290) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (291) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (292) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (293) + CH2O_HO2 (144) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (294) + CH2O_NO3 (145) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (295) + CH2O_O (146) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (296) + CH2O_OH (147) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (297) + CH3O2_CH3O2a (148) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (298) + CH3O2_CH3O2b (149) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (299) + CH3O2_HO2 (150) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (300) + CH3O2_NO (151) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (301) + CH3OH_OH (152) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (302) + CH3OOH_OH (153) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (303) + CH4_OH (154) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (304) + CO_OH_M (155) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (305) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + HCN_OH (156) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (306) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + HCOOH_OH (157) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (307) + HOCH2OO_HO2 (158) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (308) + HOCH2OO_M (159) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (309) + HOCH2OO_NO (160) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (310) + O1D_CH4a (161) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (311) + O1D_CH4b (162) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (312) + O1D_CH4c (163) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (313) + O1D_HCN (164) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (314) + usr_CO_OH_b (165) CO + OH -> CO2 + H rate = ** User defined ** (315) + C2H2_CL_M (166) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (316) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (167) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (317) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (168) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (318) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (169) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (319) + C2H5O2_C2H5O2 (170) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (320) + C2H5O2_CH3O2 (171) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (321) + + 0.2*C2H5OH + C2H5O2_HO2 (172) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (322) + C2H5O2_NO (173) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (323) + C2H5OH_OH (174) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (324) + C2H5OOH_OH (175) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (325) + C2H6_CL (176) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (326) + C2H6_OH (177) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (327) + CH3CHO_NO3 (178) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (328) + CH3CHO_OH (179) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (329) + CH3CN_OH (180) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (330) + CH3CO3_CH3CO3 (181) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (331) + CH3CO3_CH3O2 (182) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (332) + + 0.1*CH3COOH + CH3CO3_HO2 (183) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (333) + + 0.45*CH3O2 + CH3CO3_NO (184) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (334) + CH3COOH_OH (185) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (335) + CH3COOOH_OH (186) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (336) + EO2_HO2 (187) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (337) + EO2_NO (188) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (338) + EO_M (189) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (339) + EO_O2 (190) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (340) + GLYALD_OH (191) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (341) + GLYOXAL_OH (192) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (342) + PAN_OH (193) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (343) + tag_C2H4_OH (194) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (344) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (195) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (345) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_PAN_M (196) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (346) + C3H6_NO3 (197) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (347) + C3H6_O3 (198) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (348) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (199) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (349) + C3H7O2_HO2 (200) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (350) + C3H7O2_NO (201) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (351) + C3H7OOH_OH (202) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (352) + C3H8_OH (203) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (353) + CH3COCHO_NO3 (204) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (354) + CH3COCHO_OH (205) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (355) + HYAC_OH (206) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (356) + NOA_OH (207) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (357) + PO2_HO2 (208) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (358) + PO2_NO (209) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (359) + POOH_OH (210) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (360) + RO2_CH3O2 (211) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (361) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (212) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (362) + RO2_NO (213) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (363) + ROOH_OH (214) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (364) + tag_C3H6_OH (215) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (365) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (216) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (366) + BIGENE_NO3 (217) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (367) + BIGENE_OH (218) BIGENE + OH -> ENEO2 rate = 5.40E-11 (368) + ENEO2_NO (219) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (369) + ENEO2_NOb (220) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (370) + HONITR_OH (221) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (371) + MACRO2_CH3CO3 (222) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (372) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (223) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (373) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (224) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (374) + MACRO2_NO3 (225) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (375) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (226) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (376) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (227) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (377) + MACR_O3 (228) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (378) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (229) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (379) + MACROOH_OH (230) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (380) + MCO3_CH3CO3 (231) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (381) + MCO3_CH3O2 (232) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (382) + MCO3_HO2 (233) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (383) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (234) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (384) + MCO3_NO (235) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (385) + MCO3_NO3 (236) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (386) + MEKO2_HO2 (237) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (387) + MEKO2_NO (238) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (388) + MEK_OH (239) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (389) + MEKOOH_OH (240) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (390) + MPAN_OH_M (241) MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 troe : ko=8.00E-27*(300/t)**3.50 (391) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (242) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (392) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (243) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (393) + usr_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (394) + usr_MPAN_M (245) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (395) + ALKNIT_OH (246) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (396) + ALKO2_HO2 (247) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (397) + ALKO2_NO (248) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (398) + + NO2 + ALKO2_NOb (249) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (399) + ALKOOH_OH (250) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (400) + BIGALK_OH (251) BIGALK + OH -> ALKO2 rate = 3.50E-12 (401) + HPALD_OH (252) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (402) + HYDRALD_OH (253) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (403) + IEPOX_OH (254) IEPOX + OH -> XO2 rate = 1.30E-11 (404) + ISOPAO2_CH3CO3 (255) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (405) + ISOPAO2_CH3O2 (256) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (406) + + 0.44*MVK + ISOPAO2_HO2 (257) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (407) + ISOPAO2_NO (258) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (408) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (259) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (409) + ISOPBO2_CH3CO3 (260) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (410) + ISOPBO2_CH3O2 (261) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (411) + ISOPBO2_HO2 (262) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (412) + ISOPBO2_M (263) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (413) + ISOPBO2_NO (264) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (414) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (265) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (415) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (266) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (416) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (267) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (417) + ISOP_NO3 (268) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (418) + ISOPNO3_CH3CO3 (269) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (419) + ISOPNO3_CH3O2 (270) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (420) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (271) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (421) + ISOPNO3_NO (272) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (422) + ISOPNO3_NO3 (273) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (423) + ISOPNOOH_OH (274) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (424) + ISOP_O3 (275) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (425) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (276) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (426) + ISOPOOH_OH (277) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (427) + NC4CH2OH_OH (278) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (428) + NC4CHO_OH (279) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (429) + XO2_CH3CO3 (280) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (430) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (281) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (431) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (282) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (432) + XO2_NO (283) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (433) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (284) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (434) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (285) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (435) + ACBZO2_HO2 (286) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (436) + ACBZO2_NO (287) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (437) + BENZENE_OH (288) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (438) + BENZO2_HO2 (289) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (439) + BENZO2_NO (290) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (440) + BENZOOH_OH (291) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (441) + BZALD_OH (292) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (442) + BZOO_HO2 (293) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (443) + BZOOH_OH (294) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (444) + BZOO_NO (295) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (445) + C6H5O2_HO2 (296) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (446) + C6H5O2_NO (297) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (447) + C6H5OOH_OH (298) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (448) + CRESOL_OH (299) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (449) + DICARBO2_HO2 (300) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (450) + + 0.33*CH3O2 + DICARBO2_NO (301) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (451) + + 0.83*CH3O2 + DICARBO2_NO2 (302) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (452) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (303) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (453) + MALO2_NO (304) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (454) + MALO2_NO2 (305) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (455) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (306) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (456) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (307) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (457) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (308) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (458) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (309) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (459) + PHENO2_NO (310) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (460) + PHENOL_OH (311) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (461) + PHENO_NO2 (312) PHENO + NO2 -> NDEP rate = 2.10E-12 (462) + PHENO_O3 (313) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (463) + PHENOOH_OH (314) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (464) + tag_ACBZO2_NO2 (315) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (465) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (316) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (466) + TOLO2_NO (317) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (467) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (318) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (468) + TOLUENE_OH (319) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (469) + + 0.28*HO2 + usr_PBZNIT_M (320) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (470) + XYLENES_OH (321) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (471) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (322) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (472) + XYLENO2_NO (323) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (473) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (324) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (474) + XYLOLO2_HO2 (325) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (475) + XYLOLO2_NO (326) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (476) + XYLOL_OH (327) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (477) + XYLOLOOH_OH (328) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (478) + BCARY_NO3 (329) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (479) + BCARY_O3 (330) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (480) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (331) BCARY + OH -> TERPO2 rate = 2.00E-10 (481) + MTERP_NO3 (332) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (482) + MTERP_O3 (333) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (483) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (334) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (484) + NTERPO2_CH3O2 (335) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (485) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (336) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (486) + NTERPO2_NO (337) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (487) + NTERPO2_NO3 (338) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (488) + NTERPOOH_OH (339) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (489) + TERP2O2_CH3O2 (340) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (490) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (341) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (491) + TERP2O2_NO (342) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (492) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (343) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (493) + TERPNIT_OH (344) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (494) + TERPO2_CH3O2 (345) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (495) + + 0.025*CH3COCH3 + TERPO2_HO2 (346) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (496) + TERPO2_NO (347) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (497) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (348) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (498) + TERPROD1_NO3 (349) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (499) + TERPROD1_OH (350) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (500) + TERPROD2_OH (351) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (501) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + OCS_O (352) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (502) + OCS_OH (353) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (503) + S_O2 (354) S + O2 -> SO + O rate = 2.30E-12 (504) + S_O3 (355) S + O3 -> SO + O2 rate = 1.20E-11 (505) + SO_BRO (356) SO + BRO -> SO2 + BR rate = 5.70E-11 (506) + SO_CLO (357) SO + CLO -> SO2 + CL rate = 2.80E-11 (507) + S_OH (358) S + OH -> SO + H rate = 6.60E-11 (508) + SO_NO2 (359) SO + NO2 -> SO2 + NO rate = 1.40E-11 (509) + SO_O2 (360) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (510) + SO_O3 (361) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (511) + SO_OCLO (362) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (512) + SO_OH (363) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (513) + usr_SO2_OH (364) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (514) + usr_SO3_H2O (365) SO3 + H2O -> H2SO4 rate = ** User defined ** (515) + DMS_NO3 (366) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (516) + DMS_OHa (367) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (517) + NH3_OH (368) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (518) + usr_DMS_OH (369) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (519) + usr_GLYOXAL_aer (370) GLYOXAL -> SOAG0 rate = ** User defined ** (520) + usr_HO2_aer (371) HO2 -> 0.5*H2O2 rate = ** User defined ** (521) + usr_HONITR_aer (372) HONITR -> HNO3 rate = ** User defined ** (522) + usr_ISOPNITA_aer (373) ISOPNITA -> HNO3 rate = ** User defined ** (523) + usr_ISOPNITB_aer (374) ISOPNITB -> HNO3 rate = ** User defined ** (524) + usr_N2O5_aer (375) N2O5 -> 2*HNO3 rate = ** User defined ** (525) + usr_NC4CH2OH_aer (376) NC4CH2OH -> HNO3 rate = ** User defined ** (526) + usr_NC4CHO_aer (377) NC4CHO -> HNO3 rate = ** User defined ** (527) + usr_NH4_strat_ta (378) NH4 -> NHDEP rate = 6.34E-08 (528) + usr_NO2_aer (379) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (529) + usr_NO3_aer (380) NO3 -> HNO3 rate = ** User defined ** (530) + usr_NTERPOOH_aer (381) NTERPOOH -> HNO3 rate = ** User defined ** (531) + usr_ONITR_aer (382) ONITR -> HNO3 rate = ** User defined ** (532) + usr_TERPNIT_aer (383) TERPNIT -> HNO3 rate = ** User defined ** (533) + BCARY_NO3_vbs (384) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (534) + BCARY_O3_vbs (385) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (535) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (386) BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.00E-10 (536) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BENZENE_OH_vbs (387) BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 rate = 2.30E-12*exp( -193./t) (537) + + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 + ISOP_NO3_vbs (388) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (538) + ISOP_O3_vbs (389) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (539) + ISOP_OH_vbs (390) ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.54E-11*exp( 410./t) (540) + + 0.0271*SOAG3 + 0.0474*SOAG4 + IVOC_OH (391) IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 1.34E-11 (541) + + 0.0076*SOAG3 + 0.0113*SOAG4 + MTERP_NO3_vbs (392) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (542) + MTERP_O3_vbs (393) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (543) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERP_OH_vbs (394) MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 1.20E-11*exp( 440./t) (544) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + SVOC_OH (395) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (545) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (396) TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 rate = 1.70E-12*exp( 352./t) (546) + + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0232*SOAG4 + XYLENES_OH_vbs (397) XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 rate = 1.70E-11 (547) + + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 + het1 (398) N2O5 -> 2*HNO3 rate = ** User defined ** (548) + het10 (399) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (549) + het11 (400) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (550) + het12 (401) N2O5 -> 2*HNO3 rate = ** User defined ** (551) + het13 (402) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (552) + het14 (403) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (553) + het15 (404) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (554) + het16 (405) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (555) + het17 (406) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (556) + het2 (407) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (557) + het3 (408) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (558) + het4 (409) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (559) + het5 (410) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (560) + het6 (411) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (561) + het7 (412) N2O5 -> 2*HNO3 rate = ** User defined ** (562) + het8 (413) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (563) + het9 (414) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (564) + elec1 (415) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (565) + elec2 (416) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (566) + elec3 (417) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (567) + ion_N2p_O2 (418) N2p + O2 -> O2p + N2 rate = 6.00E-11 (568) + ion_N2p_Oa (419) N2p + O -> NOp + N2D rate = ** User defined ** (569) + ion_N2p_Ob (420) N2p + O -> Op + N2 rate = ** User defined ** (570) + ion_Np_O (421) Np + O -> Op + N rate = 1.00E-12 (571) + ion_Np_O2a (422) Np + O2 -> O2p + N rate = 4.00E-10 (572) + ion_Np_O2b (423) Np + O2 -> NOp + O rate = 2.00E-10 (573) + ion_O2p_N (424) O2p + N -> NOp + O rate = 1.00E-10 (574) + ion_O2p_N2 (425) O2p + N2 -> NOp + NO rate = 5.00E-16 (575) + ion_O2p_NO (426) O2p + NO -> NOp + O2 rate = 4.40E-10 (576) + ion_Op_CO2 (427) Op + CO2 -> O2p + CO rate = 9.00E-10 (577) + ion_Op_N2 (428) Op + N2 -> NOp + N rate = ** User defined ** (578) + ion_Op_O2 (429) Op + O2 -> O2p + O rate = ** User defined ** (579) + E90_tau (430) E90 -> {sink} rate = 1.29E-07 (580) + NH_50_tau (431) NH_50 -> (No products) rate = 2.31E-07 (581) + NH_5_tau (432) NH_5 -> (No products) rate = 2.31E-06 (582) + ST80_25_tau (433) ST80_25 -> (No products) rate = 4.63E-07 (583) + +Extraneous prod/loss species + ( 1) NO2 (dataset) + ( 2) NO (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) SVOC (dataset) + ( 6) so4_a1 (dataset) + ( 7) so4_a2 (dataset) + ( 8) pom_a1 (dataset) + ( 9) pom_a4 (dataset) + (10) num_a1 (dataset) + (11) num_a2 (dataset) + (12) num_a4 (dataset) + (13) bc_a1 (dataset) + (14) bc_a4 (dataset) + (15) AOA_NH + (16) O2p + (17) Np + (18) N2p + (19) N2D + (20) e + (21) N + (22) OH + (23) Op + + + Equation Report + + d(ALKNIT)/dt = r249*ALKO2*NO + - j20*ALKNIT - r246*OH*ALKNIT + d(ALKOOH)/dt = r247*ALKO2*HO2 + - j21*ALKOOH - r250*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r329*NO3*BCARY - r330*O3*BCARY - r331*OH*BCARY + d(BENZENE)/dt = - r288*OH*BENZENE + d(BENZOOH)/dt = r289*BENZO2*HO2 + - j22*BENZOOH - r291*OH*BENZOOH + d(BEPOMUC)/dt = .12*r288*BENZENE*OH + - j23*BEPOMUC + d(BIGALD)/dt = .1*r330*BCARY*O3 + .1*r333*MTERP*O3 + - j24*BIGALD + d(BIGALD1)/dt = .5*j22*BENZOOH + j23*BEPOMUC + .2*j71*TOLOOH + .06*j73*XYLENOOH + .5*r290*BENZO2*NO + + .2*r317*TOLO2*NO + .06*r323*XYLENO2*NO + - j25*BIGALD1 + d(BIGALD2)/dt = .2*j71*TOLOOH + .2*j73*XYLENOOH + .2*r317*TOLO2*NO + .2*r323*XYLENO2*NO + - j26*BIGALD2 + d(BIGALD3)/dt = j47*HPALD + j57*NC4CHO + .2*j71*TOLOOH + .15*j73*XYLENOOH + .2*r317*TOLO2*NO + + .15*r323*XYLENO2*NO + - j27*BIGALD3 + d(BIGALD4)/dt = .21*j73*XYLENOOH + .21*r323*XYLENO2*NO + - j28*BIGALD4 + d(BIGALK)/dt = .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r251*OH*BIGALK + d(BIGENE)/dt = - r217*NO3*BIGENE - r218*OH*BIGENE + d(BR)/dt = j75*BRCL + j76*BRO + j78*BRONO2 + j80*CF2CLBR + j81*CF3BR + 2*j87*CH2BR2 + j88*CH3BR + + 3*j91*CHBR3 + 2*j99*H2402 + j100*HBR + j106*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r356*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r406*HOBR*HCL + r411*HOBR*HCL + - j75*BRCL + d(BRO)/dt = j77*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j76*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r356*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j77*BRONO2 - j78*BRONO2 - r400*BRONO2 - r403*BRONO2 - r408*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j29*BZOOH + r295*BZOO*NO + - r292*OH*BZALD + d(BZOOH)/dt = r293*BZOO*HO2 + - j29*BZOOH - r294*OH*BZOOH + d(C2H2)/dt = - r166*M*CL*C2H2 - r167*M*OH*C2H2 + d(C2H4)/dt = - r168*M*CL*C2H4 - r169*O3*C2H4 - r194*M*OH*C2H4 + d(C2H5OH)/dt = .4*r170*C2H5O2*C2H5O2 + .2*r171*C2H5O2*CH3O2 + - r174*OH*C2H5OH + d(C2H5OOH)/dt = r172*C2H5O2*HO2 + - j30*C2H5OOH - r175*OH*C2H5OOH + d(C2H6)/dt = - r176*CL*C2H6 - r177*OH*C2H6 + d(C3H6)/dt = .7*j56*MVK + .13*r275*ISOP*O3 + - r197*NO3*C3H6 - r198*O3*C3H6 - r215*M*OH*C3H6 + d(C3H7OOH)/dt = r200*C3H7O2*HO2 + - j31*C3H7OOH - r202*OH*C3H7OOH + d(C3H8)/dt = - r203*OH*C3H8 + d(C6H5OOH)/dt = r296*C6H5O2*HO2 + - j32*C6H5OOH - r298*OH*C6H5OOH + d(CCL4)/dt = - j79*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j80*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j81*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j82*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j83*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j84*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j85*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j86*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j87*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j41*CH4 + j44*GLYALD + .33*j46*HONITR + + j48*HYAC + .69*j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH + + .375*j66*TERP2OOH + .4*j68*TERPOOH + .68*j70*TERPROD2 + r159*HOCH2OO + 2*r189*EO + + r71*CLO*CH3O2 + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + + .3*r153*CH3OOH*OH + r162*O1D*CH4 + r163*O1D*CH4 + r169*C2H4*O3 + .7*r171*C2H5O2*CH3O2 + + r182*CH3CO3*CH3O2 + .5*r186*CH3COOOH*OH + .5*r188*EO2*NO + .8*r191*GLYALD*OH + r193*PAN*OH + + .5*r198*C3H6*O3 + r199*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + + r213*RO2*NO + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 + + .88*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 + + r231*MCO3*CH3CO3 + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + + r236*MCO3*NO3 + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + 1.5*r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + .75*r261*ISOPBO2*CH3O2 + .3*r266*ISOPNITA*OH + .8*r270*ISOPNO3*CH3O2 + .91*r275*ISOP*O3 + + .25*r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + .25*r283*XO2*NO + .34*r330*BCARY*O3 + + .34*r333*MTERP*O3 + .75*r335*NTERPO2*CH3O2 + .93*r340*TERP2O2*CH3O2 + .34*r342*TERP2O2*NO + + .95*r345*TERPO2*CH3O2 + .32*r347*TERPO2*NO + .68*r351*TERPROD2*OH + - j33*CH2O - j34*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*HO2*CH2O - r145*NO3*CH2O + - r146*O*CH2O - r147*OH*CH2O + d(CH3BR)/dt = - j88*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j89*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j20*ALKNIT + .4*j21*ALKOOH + j30*C2H5OOH + .33*j46*HONITR + j54*MEKOOH + j63*POOH + + 1.6*r170*C2H5O2*C2H5O2 + .8*r171*C2H5O2*CH3O2 + r173*C2H5O2*NO + r174*C2H5OH*OH + + .5*r175*C2H5OOH*OH + .5*r198*C3H6*O3 + .27*r201*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + + r219*ENEO2*NO + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .1*r242*MVK*O3 + .8*r246*ALKNIT*OH + + .4*r248*ALKO2*NO + - j35*CH3CHO - r178*NO3*CH3CHO - r179*OH*CH3CHO + d(CH3CL)/dt = - j90*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3CN)/dt = - r180*OH*CH3CN + d(CH3COCH3)/dt = .25*j20*ALKNIT + .25*j21*ALKOOH + .82*j31*C3H7OOH + .17*j46*HONITR + .3*j66*TERP2OOH + + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r199*C3H7O2*CH3O2 + .82*r201*C3H7O2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .8*r246*ALKNIT*OH + .25*r248*ALKO2*NO + + .52*r330*BCARY*O3 + .52*r333*MTERP*O3 + .15*r340*TERP2O2*CH3O2 + .27*r342*TERP2O2*NO + + .025*r345*TERPO2*CH3O2 + .04*r347*TERPO2*NO + .5*r351*TERPROD2*OH + - j36*CH3COCH3 - r216*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j24*BIGALD + j28*BIGALD4 + .4*j71*TOLOOH + .54*j73*XYLENOOH + .51*j74*XYLOLOOH + + r206*HYAC*OH + r207*NOA*OH + .5*r211*RO2*CH3O2 + .25*r222*MACRO2*CH3CO3 + + .24*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .88*r228*MACR*O3 + + .5*r242*MVK*O3 + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + + .17*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .4*r317*TOLO2*NO + + .54*r323*XYLENO2*NO + .51*r326*XYLOLO2*NO + - j37*CH3COCHO - r204*NO3*CH3COCHO - r205*OH*CH3COCHO + d(CH3COOH)/dt = .1*r182*CH3CO3*CH3O2 + .15*r183*CH3CO3*HO2 + .12*r198*C3H6*O3 + .15*r233*MCO3*HO2 + - r185*OH*CH3COOH + d(CH3COOOH)/dt = .4*r183*CH3CO3*HO2 + .4*r233*MCO3*HO2 + - j38*CH3COOOH - r186*OH*CH3COOOH + d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r171*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + + .25*r256*ISOPAO2*CH3O2 + .25*r261*ISOPBO2*CH3O2 + .2*r270*ISOPNO3*CH3O2 + .3*r281*XO2*CH3O2 + + .25*r335*NTERPO2*CH3O2 + .25*r340*TERP2O2*CH3O2 + .25*r345*TERPO2*CH3O2 + - r152*OH*CH3OH + d(CH3OOH)/dt = r150*CH3O2*HO2 + - j39*CH3OOH - r153*OH*CH3OOH + d(CH4)/dt = .1*r198*C3H6*O3 + - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r161*O1D*CH4 - r162*O1D*CH4 + - r163*O1D*CH4 + d(CHBR3)/dt = - j91*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j75*BRCL + 4*j79*CCL4 + j80*CF2CLBR + 2*j82*CFC11 + 2*j83*CFC113 + 2*j84*CFC114 + j85*CFC115 + + 2*j86*CFC12 + 3*j89*CH3CCL3 + j90*CH3CL + 2*j92*CL2 + 2*j93*CL2O2 + j94*CLO + j95*CLONO2 + + j98*COFCL + j101*HCFC141B + j102*HCFC142B + j103*HCFC22 + j104*HCL + j107*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r357*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + - r176*C2H6*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r399*HOCL*HCL + r404*CLONO2*HCL + r405*HOCL*HCL + r409*CLONO2*HCL + + r410*HOCL*HCL + r414*CLONO2*HCL + - j92*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j93*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j96*CLONO2 + j108*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r362*SO*OCLO + - j94*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r357*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j95*CLONO2 - j96*CLONO2 - r402*CLONO2 - r407*CLONO2 - r413*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r404*HCL*CLONO2 - r409*HCL*CLONO2 - r414*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j23*BEPOMUC + .45*j24*BIGALD + .6*j27*BIGALD3 + j28*BIGALD4 + j33*CH2O + j34*CH2O + + j35*CH3CHO + j37*CH3COCHO + .38*j41*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + + .33*j46*HONITR + 1.34*j52*MACR + .7*j56*MVK + 1.5*j65*TEPOMUC + .25*j66*TERP2OOH + j69*TERPROD1 + + 1.7*j70*TERPROD2 + j110*CO2 + j137*OCS + r64*CL*CH2O + r100*BR*CH2O + r132*CH3CL*CL + + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r167*M*C2H2*OH + .63*r169*C2H4*O3 + + r192*GLYOXAL*OH + .56*r198*C3H6*O3 + r204*CH3COCHO*NO3 + r205*CH3COCHO*OH + + .22*r222*MACRO2*CH3CO3 + .11*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + + .65*r228*MACR*O3 + .56*r242*MVK*O3 + .62*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .2*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .5*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .14*r306*MDIALO2*HO2 + .35*r307*MDIALO2*NO + + .23*r330*BCARY*O3 + .23*r333*MTERP*O3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO + + .7*r351*TERPROD2*OH + r352*OCS*O + r353*OCS*OH + r427*Op*CO2 + - r155*M*OH*CO - r165*OH*CO + d(CO2)/dt = j38*CH3COOOH + .44*j41*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r155*M*CO*OH + + r157*HCOOH*OH + r165*CO*OH + 2*r181*CH3CO3*CH3CO3 + .9*r182*CH3CO3*CH3O2 + r184*CH3CO3*NO + + r185*CH3COOH*OH + .5*r186*CH3COOOH*OH + .8*r191*GLYALD*OH + r192*GLYOXAL*OH + .2*r198*C3H6*O3 + + 2*r231*MCO3*CH3CO3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + .5*r241*M*MPAN*OH + + .1*r242*MVK*O3 + r255*ISOPAO2*CH3CO3 + r280*XO2*CH3CO3 + .27*r330*BCARY*O3 + .27*r333*MTERP*O3 + + .5*r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + 1.8*r351*TERPROD2*OH + - j42*CO2 - j110*CO2 - r427*Op*CO2 + d(COF2)/dt = j80*CF2CLBR + j81*CF3BR + j83*CFC113 + 2*j84*CFC114 + 2*j85*CFC115 + j86*CFC12 + 2*j99*H2402 + + j102*HCFC142B + j103*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j97*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j82*CFC11 + j83*CFC113 + j101*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j98*COFCL - r126*O1D*COFCL + d(CRESOL)/dt = .18*r319*TOLUENE*OH + - r299*OH*CRESOL + d(DMS)/dt = - r366*NO3*DMS - r367*OH*DMS - r369*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r430*E90 + d(EOOH)/dt = r187*EO2*HO2 + - j43*EOOH + d(F)/dt = j81*CF3BR + j85*CFC115 + 2*j97*COF2 + j98*COFCL + j105*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r190*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + r278*NC4CH2OH*OH + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .125*r340*TERP2O2*CH3O2 + + .225*r342*TERP2O2*NO + - j44*GLYALD - r191*OH*GLYALD + d(GLYOXAL)/dt = j22*BENZOOH + .13*j24*BIGALD + .7*j62*PHENOOH + .6*j71*TOLOOH + .34*j73*XYLENOOH + + .17*j74*XYLOLOOH + .65*r167*M*C2H2*OH + .2*r191*GLYALD*OH + .05*r264*ISOPBO2*NO + + .05*r265*ISOPBO2*NO3 + r279*NC4CHO*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .25*r284*XO2*NO3 + r290*BENZO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .7*r310*PHENO2*NO + .6*r317*TOLO2*NO + + .34*r323*XYLENO2*NO + .17*r326*XYLOLO2*NO + - j45*GLYOXAL - r370*GLYOXAL - r192*OH*GLYOXAL + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j33*CH2O + j39*CH3OOH + j40*CH4 + .33*j41*CH4 + j100*HBR + j104*HCL + + j105*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r162*O1D*CH4 + r165*CO*OH + r353*OCS*OH + r358*S*OH + + r363*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j34*CH2O + 1.4400001*j41*CH4 + r22*H*HO2 + r163*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j99*H2402 - r118*O1D*H2402 + d(H2O2)/dt = .5*r371*HO2 + r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r365*SO3*H2O + - j136*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j100*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j101*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j102*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j103*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r176*C2H6*CL + - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r399*HOCL*HCL + - r404*CLONO2*HCL - r405*HOCL*HCL - r406*HOBR*HCL - r409*CLONO2*HCL - r410*HOCL*HCL + - r411*HOBR*HCL - r414*CLONO2*HCL + d(HCN)/dt = - r156*M*OH*HCN - r164*O1D*HCN + d(HCOOH)/dt = r158*HOCH2OO*HO2 + r160*HOCH2OO*NO + .35*r167*M*C2H2*OH + .37*r169*C2H4*O3 + .12*r198*C3H6*O3 + + .33*r228*MACR*O3 + .12*r242*MVK*O3 + .11*r275*ISOP*O3 + .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r157*OH*HCOOH + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j105*HF + d(HNO3)/dt = r372*HONITR + r373*ISOPNITA + r374*ISOPNITB + 2*r375*N2O5 + r376*NC4CH2OH + r377*NC4CHO + + .5*r379*NO2 + r380*NO3 + r381*NTERPOOH + r382*ONITR + r383*TERPNIT + 2*r398*N2O5 + + r400*BRONO2 + 2*r401*N2O5 + r402*CLONO2 + r403*BRONO2 + r407*CLONO2 + r408*BRONO2 + + 2*r412*N2O5 + r413*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r178*CH3CHO*NO3 + + r204*CH3COCHO*NO3 + r366*DMS*NO3 + r404*CLONO2*HCL + r409*CLONO2*HCL + r414*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r400*BRONO2 + r403*BRONO2 + r408*BRONO2 + r107*BRO*HO2 + - j106*HOBR - r115*O*HOBR - r406*HCL*HOBR - r411*HCL*HOBR + d(HOCL)/dt = r402*CLONO2 + r407*CLONO2 + r413*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r399*HCL*HOCL - r405*HCL*HOCL + - r410*HCL*HOCL + d(HONITR)/dt = r220*ENEO2*NO + r227*MACRO2*NO + .3*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + - j46*HONITR - r372*HONITR - r221*OH*HONITR + d(HPALD)/dt = r263*ISOPBO2 + - j47*HPALD - r252*OH*HPALD + d(HYAC)/dt = .17*j46*HONITR + .5*r210*POOH*OH + .2*r211*RO2*CH3O2 + .22*r222*MACRO2*CH3CO3 + + .23*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + .5*r241*M*MPAN*OH + + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + - j48*HYAC - r206*OH*HYAC + d(HYDRALD)/dt = r260*ISOPBO2*CH3CO3 + .75*r261*ISOPBO2*CH3O2 + .87*r264*ISOPBO2*NO + .95*r265*ISOPBO2*NO3 + - r253*OH*HYDRALD + d(IEPOX)/dt = .6*r277*ISOPOOH*OH + - r254*OH*IEPOX + d(ISOP)/dt = - r268*NO3*ISOP - r275*O3*ISOP - r276*OH*ISOP + d(ISOPNITA)/dt = .08*r258*ISOPAO2*NO + - r373*ISOPNITA - r266*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r264*ISOPBO2*NO + - r374*ISOPNITB - r267*OH*ISOPNITB + d(ISOPNO3)/dt = r268*ISOP*NO3 + - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 + - r273*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r271*ISOPNO3*HO2 + - j49*ISOPNOOH - r274*OH*ISOPNOOH + d(ISOPOOH)/dt = j49*ISOPNOOH + r257*ISOPAO2*HO2 + r262*ISOPBO2*HO2 + - j50*ISOPOOH - r277*OH*ISOPOOH + d(IVOC)/dt = - r391*OH*IVOC + d(MACR)/dt = .288*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + + .4*r259*ISOPAO2*NO3 + .3*r275*ISOP*O3 + - j51*MACR - j52*MACR - r228*O3*MACR - r229*OH*MACR + d(MACROOH)/dt = r224*MACRO2*HO2 + - r230*OH*MACROOH + d(MEK)/dt = .8*j20*ALKNIT + .8*j21*ALKOOH + .8*r248*ALKO2*NO + - j53*MEK - r239*OH*MEK + d(MEKOOH)/dt = .8*r237*MEKO2*HO2 + - j54*MEKOOH - r240*OH*MEKOOH + d(MPAN)/dt = r244*M*MCO3*NO2 + - j55*MPAN - r245*M*MPAN - r241*M*OH*MPAN + d(MTERP)/dt = - r332*NO3*MTERP - r333*O3*MTERP - r334*OH*MTERP + d(MVK)/dt = .402*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + + .6*r259*ISOPAO2*NO3 + .2*r275*ISOP*O3 + - j56*MVK - r242*O3*MVK - r243*OH*MVK + d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r428*N2*Op + r38*N2D*O + .2*r415*NOp*e + + 1.1*r417*N2p*e + r421*Np*O + r422*Np*O2 + - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r424*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r375*N2O5 - r398*N2O5 - r401*N2O5 - r412*N2O5 + d(NC4CH2OH)/dt = .2*r270*ISOPNO3*CH3O2 + - r376*NC4CH2OH - r278*OH*NC4CH2OH + d(NC4CHO)/dt = r269*ISOPNO3*CH3CO3 + .8*r270*ISOPNO3*CH3O2 + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + - j57*NC4CHO - r377*NC4CHO - r279*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r368*OH*NH3 + d(NH4)/dt = - r378*NH4 + d(NH_5)/dt = - r432*NH_5 + d(NH_50)/dt = - r431*NH_50 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r379*NO2 + r425*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 + + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r359*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r151*CH3O2*NO - r160*HOCH2OO*NO - r173*C2H5O2*NO - r184*CH3CO3*NO - r188*EO2*NO + - r201*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r235*MCO3*NO - r238*MEKO2*NO - r248*ALKO2*NO - r249*ALKO2*NO - r258*ISOPAO2*NO + - r264*ISOPBO2*NO - r272*ISOPNO3*NO - r283*XO2*NO - r287*ACBZO2*NO - r290*BENZO2*NO + - r295*BZOO*NO - r297*C6H5O2*NO - r301*DICARBO2*NO - r304*MALO2*NO - r307*MDIALO2*NO + - r310*PHENO2*NO - r317*TOLO2*NO - r323*XYLENO2*NO - r326*XYLOLO2*NO - r337*NTERPO2*NO + - r342*TERP2O2*NO - r347*TERPO2*NO - r426*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j20*ALKNIT + j46*HONITR + j49*ISOPNOOH + j55*MPAN + + j57*NC4CHO + j58*NOA + j59*NTERPOOH + j60*ONITR + .6*j61*PAN + j67*TERPNIT + j77*BRONO2 + + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r196*M*PAN + r245*M*MPAN + r320*M*PBZNIT + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r160*HOCH2OO*NO + r173*C2H5O2*NO + + r184*CH3CO3*NO + r188*EO2*NO + r201*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + + r217*BIGENE*NO3 + r219*ENEO2*NO + r225*MACRO2*NO3 + r226*MACRO2*NO + r235*MCO3*NO + + r236*MCO3*NO3 + r238*MEKO2*NO + r246*ALKNIT*OH + r248*ALKO2*NO + .92*r258*ISOPAO2*NO + + r259*ISOPAO2*NO3 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r283*XO2*NO + r284*XO2*NO3 + r287*ACBZO2*NO + + r290*BENZO2*NO + r295*BZOO*NO + r297*C6H5O2*NO + r301*DICARBO2*NO + r304*MALO2*NO + + r307*MDIALO2*NO + r310*PHENO2*NO + r317*TOLO2*NO + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .5*r335*NTERPO2*CH3O2 + 1.6*r337*NTERPO2*NO + 2*r338*NTERPO2*NO3 + .9*r342*TERP2O2*NO + + r344*TERPNIT*OH + .8*r347*TERPO2*NO + - j17*NO2 - r379*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r195*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 + - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r359*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j61*PAN + j78*BRONO2 + j95*CLONO2 + r63*M*N2O5 + + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + + r110*BRONO2*O + r124*F*HNO3 + r193*PAN*OH + .5*r241*M*MPAN*OH + - j18*NO3 - j19*NO3 - r380*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r145*CH2O*NO3 - r178*CH3CHO*NO3 - r197*C3H6*NO3 - r204*CH3COCHO*NO3 + - r217*BIGENE*NO3 - r225*MACRO2*NO3 - r236*MCO3*NO3 - r259*ISOPAO2*NO3 - r265*ISOPBO2*NO3 + - r268*ISOP*NO3 - r273*ISOPNO3*NO3 - r284*XO2*NO3 - r329*BCARY*NO3 - r332*MTERP*NO3 + - r338*NTERPO2*NO3 - r349*TERPROD1*NO3 - r366*DMS*NO3 + d(NOA)/dt = r197*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH + - j58*NOA - r207*OH*NOA + d(NTERPOOH)/dt = r336*NTERPO2*HO2 + - j59*NTERPOOH - r381*NTERPOOH - r339*OH*NTERPOOH + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j41*CH4 + + j42*CO2 + j76*BRO + j94*CLO + j108*OCLO + j110*CO2 + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + 2*j134*O2 + 2*j135*O2 + j138*SO + j139*SO2 + j140*SO3 + r5*N2*O1D + + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + r354*S*O2 + + r360*SO*O2 + r415*NOp*e + 1.15*r416*O2p*e + r423*Np*O2 + r424*O2p*N + r429*Op*O2 + - j120*O - j121*O - j122*O - j123*O - j124*O - j125*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r352*OCS*O - r419*N2p*O - r420*N2p*O - r421*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r150*CH3O2*HO2 + + r172*C2H5O2*HO2 + r200*C3H7O2*HO2 + r208*PO2*HO2 + r355*S*O3 + r361*SO*O3 + r426*O2p*NO + - j5*O2 - j6*O2 - j126*O2 - j127*O2 - j128*O2 - j129*O2 - j130*O2 - j131*O2 - j132*O2 + - j133*O2 - j134*O2 - j135*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 + - r44*N*O2 - r190*EO*O2 - r354*S*O2 - r360*SO*O2 - r418*N2p*O2 - r422*Np*O2 - r423*Np*O2 + - r429*Op*O2 + d(O3)/dt = r19*M*O*O2 + .15*r183*CH3CO3*HO2 + .15*r233*MCO3*HO2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r169*C2H4*O3 - r198*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 + - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r355*S*O3 - r361*SO*O3 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j108*OCLO - r362*SO*OCLO + d(OCS)/dt = - j137*OCS - r352*O*OCS - r353*OH*OCS + d(ONITR)/dt = r221*HONITR*OH + .1*r342*TERP2O2*NO + - j60*ONITR - r382*ONITR + d(PAN)/dt = r195*M*CH3CO3*NO2 + - j61*PAN - r196*M*PAN - r193*OH*PAN + d(PBZNIT)/dt = r315*M*ACBZO2*NO2 + - r320*M*PBZNIT + d(PHENO)/dt = j32*C6H5OOH + r297*C6H5O2*NO + .07*r299*CRESOL*OH + .06*r311*PHENOL*OH + .07*r327*XYLOL*OH + - r312*NO2*PHENO - r313*O3*PHENO + d(PHENOL)/dt = .53*r288*BENZENE*OH + - r311*OH*PHENOL + d(PHENOOH)/dt = r309*PHENO2*HO2 + - j62*PHENOOH - r314*OH*PHENOOH + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r208*PO2*HO2 + - j63*POOH - r210*OH*POOH + d(ROOH)/dt = .85*r212*RO2*HO2 + - j64*ROOH - r214*OH*ROOH + d(S)/dt = j137*OCS + j138*SO + - r354*O2*S - r355*O3*S - r358*OH*S + d(SF6)/dt = - j109*SF6 + d(SO)/dt = j139*SO2 + r352*OCS*O + r354*S*O2 + r355*S*O3 + r358*S*OH + - j138*SO - r356*BRO*SO - r357*CLO*SO - r359*NO2*SO - r360*O2*SO - r361*O3*SO - r362*OCLO*SO + - r363*OH*SO + d(SO2)/dt = j140*SO3 + r353*OCS*OH + r356*SO*BRO + r357*SO*CLO + r359*SO*NO2 + r360*SO*O2 + r361*SO*O3 + + r362*SO*OCLO + r363*SO*OH + r366*DMS*NO3 + r367*DMS*OH + .5*r369*DMS*OH + - j139*SO2 - r364*OH*SO2 + d(SO3)/dt = j136*H2SO4 + r364*SO2*OH + - j140*SO3 - r365*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soa1_a1)/dt = - j141*soa1_a1 + d(soa1_a2)/dt = - j142*soa1_a2 + d(soa2_a1)/dt = - j143*soa2_a1 + d(soa2_a2)/dt = - j144*soa2_a2 + d(soa3_a1)/dt = - j145*soa3_a1 + d(soa3_a2)/dt = - j146*soa3_a2 + d(soa4_a1)/dt = - j147*soa4_a1 + d(soa4_a2)/dt = - j148*soa4_a2 + d(soa5_a1)/dt = - j149*soa5_a1 + d(soa5_a2)/dt = - j150*soa5_a2 + d(SOAG0)/dt = r370*GLYOXAL + .2202*r385*BCARY*O3 + .2202*r386*BCARY*OH + .0023*r387*BENZENE*OH + + .0031*r390*ISOP*OH + .2381*r391*IVOC*OH + .0508*r393*MTERP*O3 + .0508*r394*MTERP*OH + + .5931*r395*SVOC*OH + .1364*r396*TOLUENE*OH + .1677*r397*XYLENES*OH + d(SOAG1)/dt = .2067*r385*BCARY*O3 + .2067*r386*BCARY*OH + .0008*r387*BENZENE*OH + .0035*r390*ISOP*OH + + .1308*r391*IVOC*OH + .1149*r393*MTERP*O3 + .1149*r394*MTERP*OH + .1534*r395*SVOC*OH + + .0101*r396*TOLUENE*OH + .0174*r397*XYLENES*OH + d(SOAG2)/dt = .0653*r385*BCARY*O3 + .0653*r386*BCARY*OH + .0843*r387*BENZENE*OH + .0003*r390*ISOP*OH + + .0348*r391*IVOC*OH + .0348*r393*MTERP*O3 + .0348*r394*MTERP*OH + .0459*r395*SVOC*OH + + .0763*r396*TOLUENE*OH + .086*r397*XYLENES*OH + d(SOAG3)/dt = .17493*r384*BCARY*NO3 + .1284*r385*BCARY*O3 + .1284*r386*BCARY*OH + .0443*r387*BENZENE*OH + + .059024*r388*ISOP*NO3 + .0033*r389*ISOP*O3 + .0271*r390*ISOP*OH + .0076*r391*IVOC*OH + + .17493*r392*MTERP*NO3 + .0554*r393*MTERP*O3 + .0554*r394*MTERP*OH + .0085*r395*SVOC*OH + + .2157*r396*TOLUENE*OH + .0512*r397*XYLENES*OH + d(SOAG4)/dt = .59019*r384*BCARY*NO3 + .114*r385*BCARY*O3 + .114*r386*BCARY*OH + .1621*r387*BENZENE*OH + + .025024*r388*ISOP*NO3 + .0474*r390*ISOP*OH + .0113*r391*IVOC*OH + .59019*r392*MTERP*NO3 + + .1278*r393*MTERP*O3 + .1278*r394*MTERP*OH + .0128*r395*SVOC*OH + .0232*r396*TOLUENE*OH + + .1598*r397*XYLENES*OH + d(ST80_25)/dt = - r433*ST80_25 + d(SVOC)/dt = - r395*OH*SVOC + d(TEPOMUC)/dt = .1*r319*TOLUENE*OH + .23*r321*XYLENES*OH + - j65*TEPOMUC + d(TERP2OOH)/dt = r341*TERP2O2*HO2 + - j66*TERP2OOH - r343*OH*TERP2OOH + d(TERPNIT)/dt = .5*r335*NTERPO2*CH3O2 + .2*r337*NTERPO2*NO + .2*r347*TERPO2*NO + - j67*TERPNIT - r383*TERPNIT - r344*OH*TERPNIT + d(TERPOOH)/dt = r346*TERPO2*HO2 + - j68*TERPOOH - r348*OH*TERPOOH + d(TERPROD1)/dt = j59*NTERPOOH + j67*TERPNIT + j68*TERPOOH + .33*r330*BCARY*O3 + .33*r333*MTERP*O3 + + .5*r335*NTERPO2*CH3O2 + .8*r337*NTERPO2*NO + r338*NTERPO2*NO3 + r344*TERPNIT*OH + + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + - j69*TERPROD1 - r349*NO3*TERPROD1 - r350*OH*TERPROD1 + d(TERPROD2)/dt = j66*TERP2OOH + j69*TERPROD1 + .3*r330*BCARY*O3 + .3*r333*MTERP*O3 + r340*TERP2O2*CH3O2 + + .9*r342*TERP2O2*NO + - j70*TERPROD2 - r351*OH*TERPROD2 + d(TOLOOH)/dt = r316*TOLO2*HO2 + - j71*TOLOOH - r318*OH*TOLOOH + d(TOLUENE)/dt = - r319*OH*TOLUENE + d(XOOH)/dt = r282*XO2*HO2 + - j72*XOOH - r285*OH*XOOH + d(XYLENES)/dt = - r321*OH*XYLENES + d(XYLENOOH)/dt = r322*XYLENO2*HO2 + - j73*XYLENOOH - r324*OH*XYLENOOH + d(XYLOL)/dt = .15*r321*XYLENES*OH + - r327*OH*XYLOL + d(XYLOLOOH)/dt = r325*XYLOLO2*HO2 + - j74*XYLOLOOH - r328*OH*XYLOLOOH + d(NHDEP)/dt = r378*NH4 + r368*NH3*OH + d(NDEP)/dt = .5*r241*M*MPAN*OH + r302*M*DICARBO2*NO2 + r305*M*MALO2*NO2 + r308*M*MDIALO2*NO2 + r312*PHENO*NO2 + + .2*r337*NTERPO2*NO + .5*r349*TERPROD1*NO3 + d(ACBZO2)/dt = r320*M*PBZNIT + r292*BZALD*OH + - r286*HO2*ACBZO2 - r287*NO*ACBZO2 - r315*M*NO2*ACBZO2 + d(ALKO2)/dt = r250*ALKOOH*OH + r251*BIGALK*OH + - r247*HO2*ALKO2 - r248*NO*ALKO2 - r249*NO*ALKO2 + d(BENZO2)/dt = .35*r288*BENZENE*OH + r291*BENZOOH*OH + - r289*HO2*BENZO2 - r290*NO*BENZO2 + d(BZOO)/dt = r294*BZOOH*OH + .07*r319*TOLUENE*OH + .06*r321*XYLENES*OH + - r293*HO2*BZOO - r295*NO*BZOO + d(C2H5O2)/dt = j53*MEK + .5*r175*C2H5OOH*OH + r176*C2H6*CL + r177*C2H6*OH + - 2*r170*C2H5O2*C2H5O2 - r171*CH3O2*C2H5O2 - r172*HO2*C2H5O2 - r173*NO*C2H5O2 + d(C3H7O2)/dt = r202*C3H7OOH*OH + r203*C3H8*OH + - r199*CH3O2*C3H7O2 - r200*HO2*C3H7O2 - r201*NO*C3H7O2 + d(C6H5O2)/dt = .4*r286*ACBZO2*HO2 + r287*ACBZO2*NO + r298*C6H5OOH*OH + r313*PHENO*O3 + - r296*HO2*C6H5O2 - r297*NO*C6H5O2 + d(CH3CO3)/dt = .13*j24*BIGALD + j28*BIGALD4 + j36*CH3COCH3 + j37*CH3COCHO + .33*j46*HONITR + j48*HYAC + + 1.34*j51*MACR + j53*MEK + j54*MEKOOH + .3*j56*MVK + j58*NOA + .6*j61*PAN + j64*ROOH + + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r196*M*PAN + r178*CH3CHO*NO3 + r179*CH3CHO*OH + + .5*r186*CH3COOOH*OH + r204*CH3COCHO*NO3 + r205*CH3COCHO*OH + .3*r211*RO2*CH3O2 + + .15*r212*RO2*HO2 + r213*RO2*NO + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .1*r228*MACR*O3 + r232*MCO3*CH3O2 + + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + .2*r237*MEKO2*HO2 + + r238*MEKO2*NO + .28*r242*MVK*O3 + .08*r275*ISOP*O3 + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .65*r351*TERPROD2*OH + - 2*r181*CH3CO3*CH3CO3 - r182*CH3O2*CH3CO3 - r183*HO2*CH3CO3 - r184*NO*CH3CO3 + - r195*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 + - r269*ISOPNO3*CH3CO3 - r280*XO2*CH3CO3 + d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j40*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR + + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r161*O1D*CH4 + + 2*r181*CH3CO3*CH3CO3 + .9*r182*CH3CO3*CH3O2 + .45*r183*CH3CO3*HO2 + r184*CH3CO3*NO + + r185*CH3COOH*OH + .28*r198*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + + r255*ISOPAO2*CH3CO3 + r260*ISOPBO2*CH3CO3 + r269*ISOPNO3*CH3CO3 + .05*r275*ISOP*O3 + + r280*XO2*CH3CO3 + .33*r300*DICARBO2*HO2 + .83*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + + .17*r307*MDIALO2*NO + - r71*CLO*CH3O2 - 2*r148*CH3O2*CH3O2 - 2*r149*CH3O2*CH3O2 - r150*HO2*CH3O2 - r151*NO*CH3O2 + - r171*C2H5O2*CH3O2 - r182*CH3CO3*CH3O2 - r199*C3H7O2*CH3O2 - r211*RO2*CH3O2 + - r223*MACRO2*CH3O2 - r232*MCO3*CH3O2 - r256*ISOPAO2*CH3O2 - r261*ISOPBO2*CH3O2 + - r270*ISOPNO3*CH3O2 - r281*XO2*CH3O2 - r335*NTERPO2*CH3O2 - r340*TERP2O2*CH3O2 + - r345*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j26*BIGALD2 + - r300*HO2*DICARBO2 - r301*NO*DICARBO2 - r302*M*NO2*DICARBO2 + d(e)/dt = j113*N2 + j114*N2 + j115*N2 + j116*N2 + j117*N2 + j119*N2 + j16*NO + j111*N + j120*O + j121*O + + j122*O + j123*O + j124*O + j125*O + j126*O2 + j127*O2 + j128*O2 + j129*O2 + j130*O2 + + j131*O2 + j132*O2 + j133*O2 + - r415*NOp*e - r416*O2p*e - r417*N2p*e + d(ENEO2)/dt = r218*BIGENE*OH + - r219*NO*ENEO2 - r220*NO*ENEO2 + d(EO)/dt = j43*EOOH + .75*r188*EO2*NO + - r189*EO - r190*O2*EO + d(EO2)/dt = r194*M*C2H4*OH + - r187*HO2*EO2 - r188*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD + + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR + + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO + + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH + + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 + + r159*HOCH2OO + r189*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 + + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*CO*OH + + r156*M*HCN*OH + r157*HCOOH*OH + r160*HOCH2OO*NO + r162*O1D*CH4 + .35*r167*M*C2H2*OH + + .13*r169*C2H4*O3 + 1.2*r170*C2H5O2*C2H5O2 + r171*C2H5O2*CH3O2 + r173*C2H5O2*NO + r174*C2H5OH*OH + + r180*CH3CN*OH + .9*r182*CH3CO3*CH3O2 + .25*r188*EO2*NO + r190*EO*O2 + r191*GLYALD*OH + + r192*GLYOXAL*OH + .28*r198*C3H6*O3 + r199*C3H7O2*CH3O2 + r201*C3H7O2*NO + r206*HYAC*OH + + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 + + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 + + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH + + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 + + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH + + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO + + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 + + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + + .2*r351*TERPROD2*OH + r364*SO2*OH + .5*r369*DMS*OH + - r371*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r158*HOCH2OO*HO2 + - r172*C2H5O2*HO2 - r183*CH3CO3*HO2 - r187*EO2*HO2 - r200*C3H7O2*HO2 - r208*PO2*HO2 + - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 + - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 + - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 + - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 + - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 + d(HOCH2OO)/dt = r144*CH2O*HO2 + - r159*HOCH2OO - r158*HO2*HOCH2OO - r160*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r276*ISOP*OH + - r255*CH3CO3*ISOPAO2 - r256*CH3O2*ISOPAO2 - r257*HO2*ISOPAO2 - r258*NO*ISOPAO2 + - r259*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r276*ISOP*OH + - r263*ISOPBO2 - r260*CH3CO3*ISOPBO2 - r261*CH3O2*ISOPBO2 - r262*HO2*ISOPBO2 + - r264*NO*ISOPBO2 - r265*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r229*MACR*OH + .2*r230*MACROOH*OH + r243*MVK*OH + - r222*CH3CO3*MACRO2 - r223*CH3O2*MACRO2 - r224*HO2*MACRO2 - r225*NO3*MACRO2 - r226*NO*MACRO2 + - r227*NO*MACRO2 + d(MALO2)/dt = .6*j25*BIGALD1 + - r303*HO2*MALO2 - r304*NO*MALO2 - r305*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j55*MPAN + r245*M*MPAN + .5*r229*MACR*OH + .5*r230*MACROOH*OH + - r231*CH3CO3*MCO3 - r232*CH3O2*MCO3 - r233*HO2*MCO3 - 2*r234*MCO3*MCO3 - r235*NO*MCO3 + - r236*NO3*MCO3 - r244*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j27*BIGALD3 + - r306*HO2*MDIALO2 - r307*NO*MDIALO2 - r308*M*NO2*MDIALO2 + d(MEKO2)/dt = r239*MEK*OH + r240*MEKOOH*OH + - r237*HO2*MEKO2 - r238*NO*MEKO2 + d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r415*NOp*e + .9*r417*N2p*e + r419*N2p*O + - r38*O*N2D - r39*O2*N2D + d(N2p)/dt = j114*N2 + j119*N2 + - r417*e*N2p - r418*O2*N2p - r419*O*N2p - r420*O*N2p + d(NOp)/dt = j16*NO + r425*N2*O2p + r428*N2*Op + r419*N2p*O + r423*Np*O2 + r424*O2p*N + r426*O2p*NO + - r415*e*NOp + d(Np)/dt = j113*N2 + j115*N2 + j116*N2 + j117*N2 + j111*N + - r421*O*Np - r422*O2*Np - r423*O2*Np + d(NTERPO2)/dt = r329*BCARY*NO3 + r332*MTERP*NO3 + r339*NTERPOOH*OH + .5*r349*TERPROD1*NO3 + - r335*CH3O2*NTERPO2 - r336*HO2*NTERPO2 - r337*NO*NTERPO2 - r338*NO3*NTERPO2 + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r416*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r161*CH4*O1D - r162*CH4*O1D - r163*CH4*O1D - r164*HCN*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j126*O2 + j130*O2 + r418*N2p*O2 + r422*Np*O2 + r427*Op*CO2 + r429*Op*O2 + - r425*N2*O2p - r416*e*O2p - r424*N*O2p - r426*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j21*ALKOOH + j22*BENZOOH + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j41*CH4 + j43*EOOH + j47*HPALD + + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + j68*TERPOOH + + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + .5*r379*NO2 + + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + r27*HO2*O3 + + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + r96*O1D*HCL + + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + .3*r153*CH3OOH*OH + + r161*O1D*CH4 + r164*O1D*HCN + .65*r167*M*C2H2*OH + .13*r169*C2H4*O3 + .5*r175*C2H5OOH*OH + + .45*r183*CH3CO3*HO2 + .36*r198*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + .24*r228*MACR*O3 + + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + .32*r275*ISOP*O3 + + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + .4*r300*DICARBO2*HO2 + + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r147*CH2O*OH - r152*CH3OH*OH + - r153*CH3OOH*OH - r154*CH4*OH - r155*M*CO*OH - r156*M*HCN*OH - r157*HCOOH*OH - r165*CO*OH + - r167*M*C2H2*OH - r174*C2H5OH*OH - r175*C2H5OOH*OH - r177*C2H6*OH - r179*CH3CHO*OH + - r180*CH3CN*OH - r185*CH3COOH*OH - r186*CH3COOOH*OH - r191*GLYALD*OH - r192*GLYOXAL*OH + - r193*PAN*OH - r194*M*C2H4*OH - r202*C3H7OOH*OH - r203*C3H8*OH - r205*CH3COCHO*OH - r206*HYAC*OH + - r207*NOA*OH - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH + - r221*HONITR*OH - r229*MACR*OH - r230*MACROOH*OH - r239*MEK*OH - r240*MEKOOH*OH - r241*M*MPAN*OH + - r243*MVK*OH - r246*ALKNIT*OH - r250*ALKOOH*OH - r251*BIGALK*OH - r252*HPALD*OH + - r253*HYDRALD*OH - r254*IEPOX*OH - r266*ISOPNITA*OH - r267*ISOPNITB*OH - r274*ISOPNOOH*OH + - r276*ISOP*OH - r277*ISOPOOH*OH - r278*NC4CH2OH*OH - r279*NC4CHO*OH - r285*XOOH*OH + - r288*BENZENE*OH - r291*BENZOOH*OH - r292*BZALD*OH - r294*BZOOH*OH - r298*C6H5OOH*OH + - r299*CRESOL*OH - r311*PHENOL*OH - r314*PHENOOH*OH - r318*TOLOOH*OH - r319*TOLUENE*OH + - r321*XYLENES*OH - r324*XYLENOOH*OH - r327*XYLOL*OH - r328*XYLOLOOH*OH - r331*BCARY*OH + - r334*MTERP*OH - r339*NTERPOOH*OH - r343*TERP2OOH*OH - r344*TERPNIT*OH - r348*TERPOOH*OH + - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*OCS*OH - r358*S*OH - r363*SO*OH - r364*SO2*OH + - r367*DMS*OH - r368*NH3*OH - r369*DMS*OH + d(Op)/dt = j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + r420*N2p*O + r421*Np*O + - r428*N2*Op - r427*CO2*Op - r429*O2*Op + d(PHENO2)/dt = .2*r299*CRESOL*OH + .14*r311*PHENOL*OH + r314*PHENOOH*OH + - r309*HO2*PHENO2 - r310*NO*PHENO2 + d(PO2)/dt = .5*r210*POOH*OH + r215*M*C3H6*OH + - r208*HO2*PO2 - r209*NO*PO2 + d(RO2)/dt = .15*j70*TERPROD2 + r214*ROOH*OH + r216*CH3COCH3*OH + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .15*r351*TERPROD2*OH + - r211*CH3O2*RO2 - r212*HO2*RO2 - r213*NO*RO2 + d(TERP2O2)/dt = r343*TERP2OOH*OH + .5*r349*TERPROD1*NO3 + r350*TERPROD1*OH + - r340*CH3O2*TERP2O2 - r341*HO2*TERP2O2 - r342*NO*TERP2O2 + d(TERPO2)/dt = r331*BCARY*OH + r334*MTERP*OH + r348*TERPOOH*OH + - r345*CH3O2*TERPO2 - r346*HO2*TERPO2 - r347*NO*TERPO2 + d(TOLO2)/dt = r318*TOLOOH*OH + .65*r319*TOLUENE*OH + - r316*HO2*TOLO2 - r317*NO*TOLO2 + d(XO2)/dt = r252*HPALD*OH + r253*HYDRALD*OH + r254*IEPOX*OH + .4*r277*ISOPOOH*OH + .5*r285*XOOH*OH + - r280*CH3CO3*XO2 - r281*CH3O2*XO2 - r282*HO2*XO2 - r283*NO*XO2 - r284*NO3*XO2 + d(XYLENO2)/dt = .56*r321*XYLENES*OH + r324*XYLENOOH*OH + - r322*HO2*XYLENO2 - r323*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r327*XYLOL*OH + r328*XYLOLOOH*OH + - r325*HO2*XYLOLO2 - r326*NO*XYLOLO2 + d(H2O)/dt = .05*j41*CH4 + j136*H2SO4 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + r34*OH*OH + + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + r128*CH2BR2*OH + + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + r147*CH2O*OH + + r153*CH3OOH*OH + r154*CH4*OH + r157*HCOOH*OH + r177*C2H6*OH + r179*CH3CHO*OH + r185*CH3COOH*OH + + r186*CH3COOOH*OH + r202*C3H7OOH*OH + r203*C3H8*OH + r205*CH3COCHO*OH + r210*POOH*OH + + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r368*NH3*OH + r399*HOCL*HCL + + r405*HOCL*HCL + r406*HOBR*HCL + r410*HOCL*HCL + r411*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r365*SO3*H2O diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in new file mode 100644 index 0000000000..a60448932c --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in @@ -0,0 +1,1259 @@ +* Comments +* User-given Tag Description: TSMLT1 for CESM2.0 +* Tag database identifier : MZ197_TSMLT1_20180423 +* Tag created by : lke +* Tag created from branch : TSMLT1 +* Tag created on : 2018-04-23 17:47:30.657331-06 +* Comments for this tag follow: +* lke : 2018-04-23 : Latest change only removes O3S loss reactions. + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CHO, + CH3CL -> CH3Cl, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + O, + O2, + O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + pom_a1 -> C, + pom_a4 -> C, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soa1_a1 -> C15H38O2, + soa1_a2 -> C15H38O2, + soa2_a1 -> C15H38O2, + soa2_a2 -> C15H38O2, + soa3_a1 -> C15H38O2, + soa3_a2 -> C15H38O2, + soa4_a1 -> C15H38O2, + soa4_a2 -> C15H38O2, + soa5_a1 -> C15H38O2, + soa5_a2 -> C15H38O2, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H18O3, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BENZO2 -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + e -> E, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + NTERPO2 -> C10H16NO5, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BENZO2, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + e, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + N2D, + N2p, + NOp, + Np, + NTERPO2, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + XO2, + XYLENO2, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + AOA_NH + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH3BR + CH3CCL3 + CH3CL + CH4 + CHBR3 + CLY + CO2 + E90 + H2402 + HCFC141B + HCFC142B + HCFC22 + N2O + NH_5 + NH_50 + SF6 + ST80_25 + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + bc_a1 + bc_a4 + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CH2O + CH3CHO + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CL + CL2 + CL2O2 + CLO + CLONO2 + CO + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2O2 + H2SO4 + HBR + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPOOH + IVOC + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + N + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + O + O2 + O3 + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pom_a1 + pom_a4 + POOH + ROOH + S + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + SVOC + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BENZO2 + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + e + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + N2D + N2p + NOp + Np + NTERPO2 + O1D + O2_1D + O2_1S + O2p + OH + Op + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + XO2 + XYLENO2 + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 +[jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 +[jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 +[jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jco2] CO2 + hv -> CO + O +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_2=userdefined,userdefined] O + hv -> Op + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_16=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_3=userdefined,userdefined] O + hv -> Op + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O +********************************* +*** soa +********************************* +[jsoa1_a1->,.0004*jno2] soa1_a1 + hv -> +[jsoa1_a2->,.0004*jno2] soa1_a2 + hv -> +[jsoa2_a1->,.0004*jno2] soa2_a1 + hv -> +[jsoa2_a2->,.0004*jno2] soa2_a2 + hv -> +[jsoa3_a1->,.0004*jno2] soa3_a1 + hv -> +[jsoa3_a2->,.0004*jno2] soa3_a2 + hv -> +[jsoa4_a1->,.0004*jno2] soa4_a1 + hv -> +[jsoa4_a2->,.0004*jno2] soa4_a2 + hv -> +[jsoa5_a1->,.0004*jno2] soa5_a1 + hv -> +[jsoa5_a2->,.0004*jno2] soa5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 1.5e-11, -3600 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.5e-11, 170 +[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.3e-12, 270 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 ; 5e-13, -424 +[CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14, 706 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.9e-12, -345 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 +[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH_b] CO + OH -> CO2 + H +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.6e-29, 3.3, 3.1e-10, 1, 0.6 +[C2H4_O3] C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O ; 1.2e-14, -2630 +[C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH ; 6.8e-14 +[C2H5O2_CH3O2] C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH + 0.2*C2H5OH ; 2e-13 +[C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 +[C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 +[C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12, -230 +[C2H5OOH_OH] C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH ; 3.8e-12, 200 +[C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.2e-11, -70 +[C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020 +[CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 +[CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.9e-12, 500 +[CH3CO3_CH3O2] CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 + 0.1*CH3COOH ; 2e-12, 500 +[CH3CO3_HO2] CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH + 0.45*CH3O2 ; 4.3e-13, 1040 +[CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 +[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7e-13 +[CH3COOOH_OH] CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O ; 1e-12 +[EO2_HO2] EO2 + HO2 -> EOOH ; 7.5e-13, 700 +[EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.2e-12, 180 +[EO_M] EO -> 2*CH2O + HO2 ; 1.6e+11, -4150 +[EO_O2] EO + O2 -> GLYALD + HO2 ; 1e-14 +[GLYALD_OH] GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 ; 1e-11 +[GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 +[PAN_OH] PAN + OH -> CH2O + NO3 ; 4e-14 +[tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.6e-29, 3.1, 9e-12, 0.85, 0.48 +[tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M +********************************* +*** C3 +********************************* +[C3H6_NO3] C3H6 + NO3 -> NOA ; 4.6e-13, -1156 +[C3H6_O3] C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH ; 6.5e-15, -1900 +[C3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 ; 3.75e-13, -40 +[C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 +[C3H7O2_NO] C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO ; 4.2e-12, 180 +[C3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 +[C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 8.7e-12, -615 +[CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 +[CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13, 830 +[HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3e-12 +[NOA_OH] NOA + OH -> NO2 + CH3COCHO ; 6.7e-13 +[PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 +[PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 +[POOH_OH] POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O ; 3.8e-12, 200 +[RO2_CH3O2] RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC + 0.5*CH3COCHO + 0.5*CH3OH ; 7.1e-13, 500 +[RO2_HO2] RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 ; 8.6e-13, 700 +[RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 +[ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 +[tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O +********************************* +*** C4 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 ; 1.4e-11 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC ; 5e-13, 400 +[MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8e-13, 700 +[MACRO2_NO3] MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 ; 2.4e-12 +[MACRO2_NOa] MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO ; 2.7e-12, 360 +[MACRO2_NOb] MACRO2 + NO -> HONITR ; 1.3e-13, 360 +[MACR_O3] MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 ; 1.5e-15, -2100 +[MACR_OH] MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 ; 2.3e-11, 200 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 +[MCO3_CH3O2] MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 ; 2.3e-12, 530 +[MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5e-12 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[MPAN_OH_M] MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 + M + 0.5*NDEP ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVK_O3] MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH ; 8.5e-16, -1520 +[MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452 +[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[ISOP_O3] ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 ; 1.05e-14, -2000 +[ISOP_OH] ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[XO2_CH3CO3] XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 ; 1.3e-12, 640 +[XO2_CH3O2] XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD ; 5e-13, 400 +[XO2_HO2] XO2 + HO2 -> XOOH ; 8e-13, 700 +[XO2_NO] XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD ; 2.7e-12, 360 +[XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*GLYALD ; 2.4e-12 +[XOOH_OH] XOOH + OH -> 0.5*XO2 + 0.5*OH ; 1.52e-12, 200 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** Sulfur +********************************* +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.7e-11, 335 +[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> HNO3 +[usr_NH4_strat_tau] NH4 -> 1*NHDEP ; 6.34e-08 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +[usr_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 2.3e-12, -193 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.54e-11, 410 +[IVOC_OH] IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 1.2e-11, 440 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0232*SOAG4 ; 1.7e-12, 352 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 1.7e-11 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Ions +********************************* +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +********************************* +*** Tracers +********************************* +[E90_tau] E90 -> sink ; 1.29e-07 +[NH_50_tau] NH_50 -> ; 2.31e-07 +[NH_5_tau] NH_5 -> ; 2.31e-06 +[ST80_25_tau] ST80_25 -> ; 4.63e-07 + End Reactions + + Ext Forcing + NO2 <- dataset + NO <- dataset + CO <- dataset + SO2 <- dataset + SVOC <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + AOA_NH + O2p + Np + N2p + N2D + e + N + OH + Op + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid +* vec_ftns = on + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 new file mode 100644 index 0000000000..d665a9bd94 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 150, & ! number of photolysis reactions + rxntot = 583, & ! number of total reactions + gascnt = 433, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 231, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2170, & ! number of non-zero matrix entries + extcnt = 23, & ! number of species with external forcing + clscnt1 = 30, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 201, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 583, & + enthalpy_cnt = 41, & + nslvd = 43 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..43b467b513 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 @@ -0,0 +1,586 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jalknit = 20 + integer, parameter :: rid_jalkooh = 21 + integer, parameter :: rid_jbenzooh = 22 + integer, parameter :: rid_jbepomuc = 23 + integer, parameter :: rid_jbigald = 24 + integer, parameter :: rid_jbigald1 = 25 + integer, parameter :: rid_jbigald2 = 26 + integer, parameter :: rid_jbigald3 = 27 + integer, parameter :: rid_jbigald4 = 28 + integer, parameter :: rid_jbzooh = 29 + integer, parameter :: rid_jc2h5ooh = 30 + integer, parameter :: rid_jc3h7ooh = 31 + integer, parameter :: rid_jc6h5ooh = 32 + integer, parameter :: rid_jch2o_a = 33 + integer, parameter :: rid_jch2o_b = 34 + integer, parameter :: rid_jch3cho = 35 + integer, parameter :: rid_jacet = 36 + integer, parameter :: rid_jmgly = 37 + integer, parameter :: rid_jch3co3h = 38 + integer, parameter :: rid_jch3ooh = 39 + integer, parameter :: rid_jch4_a = 40 + integer, parameter :: rid_jch4_b = 41 + integer, parameter :: rid_jco2 = 42 + integer, parameter :: rid_jeooh = 43 + integer, parameter :: rid_jglyald = 44 + integer, parameter :: rid_jglyoxal = 45 + integer, parameter :: rid_jhonitr = 46 + integer, parameter :: rid_jhpald = 47 + integer, parameter :: rid_jhyac = 48 + integer, parameter :: rid_jisopnooh = 49 + integer, parameter :: rid_jisopooh = 50 + integer, parameter :: rid_jmacr_a = 51 + integer, parameter :: rid_jmacr_b = 52 + integer, parameter :: rid_jmek = 53 + integer, parameter :: rid_jmekooh = 54 + integer, parameter :: rid_jmpan = 55 + integer, parameter :: rid_jmvk = 56 + integer, parameter :: rid_jnc4cho = 57 + integer, parameter :: rid_jnoa = 58 + integer, parameter :: rid_jnterpooh = 59 + integer, parameter :: rid_jonitr = 60 + integer, parameter :: rid_jpan = 61 + integer, parameter :: rid_jphenooh = 62 + integer, parameter :: rid_jpooh = 63 + integer, parameter :: rid_jrooh = 64 + integer, parameter :: rid_jtepomuc = 65 + integer, parameter :: rid_jterp2ooh = 66 + integer, parameter :: rid_jterpnit = 67 + integer, parameter :: rid_jterpooh = 68 + integer, parameter :: rid_jterprd1 = 69 + integer, parameter :: rid_jterprd2 = 70 + integer, parameter :: rid_jtolooh = 71 + integer, parameter :: rid_jxooh = 72 + integer, parameter :: rid_jxylenooh = 73 + integer, parameter :: rid_jxylolooh = 74 + integer, parameter :: rid_jbrcl = 75 + integer, parameter :: rid_jbro = 76 + integer, parameter :: rid_jbrono2_b = 77 + integer, parameter :: rid_jbrono2_a = 78 + integer, parameter :: rid_jccl4 = 79 + integer, parameter :: rid_jcf2clbr = 80 + integer, parameter :: rid_jcf3br = 81 + integer, parameter :: rid_jcfcl3 = 82 + integer, parameter :: rid_jcfc113 = 83 + integer, parameter :: rid_jcfc114 = 84 + integer, parameter :: rid_jcfc115 = 85 + integer, parameter :: rid_jcf2cl2 = 86 + integer, parameter :: rid_jch2br2 = 87 + integer, parameter :: rid_jch3br = 88 + integer, parameter :: rid_jch3ccl3 = 89 + integer, parameter :: rid_jch3cl = 90 + integer, parameter :: rid_jchbr3 = 91 + integer, parameter :: rid_jcl2 = 92 + integer, parameter :: rid_jcl2o2 = 93 + integer, parameter :: rid_jclo = 94 + integer, parameter :: rid_jclono2_a = 95 + integer, parameter :: rid_jclono2_b = 96 + integer, parameter :: rid_jcof2 = 97 + integer, parameter :: rid_jcofcl = 98 + integer, parameter :: rid_jh2402 = 99 + integer, parameter :: rid_jhbr = 100 + integer, parameter :: rid_jhcfc141b = 101 + integer, parameter :: rid_jhcfc142b = 102 + integer, parameter :: rid_jhcfc22 = 103 + integer, parameter :: rid_jhcl = 104 + integer, parameter :: rid_jhf = 105 + integer, parameter :: rid_jhobr = 106 + integer, parameter :: rid_jhocl = 107 + integer, parameter :: rid_joclo = 108 + integer, parameter :: rid_jsf6 = 109 + integer, parameter :: rid_jeuv_26 = 110 + integer, parameter :: rid_jeuv_4 = 111 + integer, parameter :: rid_jeuv_13 = 112 + integer, parameter :: rid_jeuv_11 = 113 + integer, parameter :: rid_jeuv_6 = 114 + integer, parameter :: rid_jeuv_10 = 115 + integer, parameter :: rid_jeuv_22 = 116 + integer, parameter :: rid_jeuv_23 = 117 + integer, parameter :: rid_jeuv_25 = 118 + integer, parameter :: rid_jeuv_18 = 119 + integer, parameter :: rid_jeuv_2 = 120 + integer, parameter :: rid_jeuv_1 = 121 + integer, parameter :: rid_jeuv_16 = 122 + integer, parameter :: rid_jeuv_15 = 123 + integer, parameter :: rid_jeuv_14 = 124 + integer, parameter :: rid_jeuv_3 = 125 + integer, parameter :: rid_jeuv_17 = 126 + integer, parameter :: rid_jeuv_9 = 127 + integer, parameter :: rid_jeuv_8 = 128 + integer, parameter :: rid_jeuv_7 = 129 + integer, parameter :: rid_jeuv_5 = 130 + integer, parameter :: rid_jeuv_19 = 131 + integer, parameter :: rid_jeuv_20 = 132 + integer, parameter :: rid_jeuv_21 = 133 + integer, parameter :: rid_jeuv_24 = 134 + integer, parameter :: rid_jeuv_12 = 135 + integer, parameter :: rid_jh2so4 = 136 + integer, parameter :: rid_jocs = 137 + integer, parameter :: rid_jso = 138 + integer, parameter :: rid_jso2 = 139 + integer, parameter :: rid_jso3 = 140 + integer, parameter :: rid_jsoa1_a1 = 141 + integer, parameter :: rid_jsoa1_a2 = 142 + integer, parameter :: rid_jsoa2_a1 = 143 + integer, parameter :: rid_jsoa2_a2 = 144 + integer, parameter :: rid_jsoa3_a1 = 145 + integer, parameter :: rid_jsoa3_a2 = 146 + integer, parameter :: rid_jsoa4_a1 = 147 + integer, parameter :: rid_jsoa4_a2 = 148 + integer, parameter :: rid_jsoa5_a1 = 149 + integer, parameter :: rid_jsoa5_a2 = 150 + integer, parameter :: rid_ag1 = 151 + integer, parameter :: rid_ag2 = 152 + integer, parameter :: rid_O1D_H2 = 153 + integer, parameter :: rid_O1D_H2O = 154 + integer, parameter :: rid_O1D_N2 = 155 + integer, parameter :: rid_O1D_O2 = 156 + integer, parameter :: rid_O1D_O2b = 157 + integer, parameter :: rid_O1D_O3 = 158 + integer, parameter :: rid_O2_1D_N2 = 159 + integer, parameter :: rid_O2_1D_O = 160 + integer, parameter :: rid_O2_1D_O2 = 161 + integer, parameter :: rid_O2_1S_CO2 = 162 + integer, parameter :: rid_O2_1S_N2 = 163 + integer, parameter :: rid_O2_1S_O = 164 + integer, parameter :: rid_O2_1S_O2 = 165 + integer, parameter :: rid_O2_1S_O3 = 166 + integer, parameter :: rid_O_O3 = 167 + integer, parameter :: rid_usr_O_O = 168 + integer, parameter :: rid_usr_O_O2 = 169 + integer, parameter :: rid_H2_O = 170 + integer, parameter :: rid_H2O2_O = 171 + integer, parameter :: rid_H_HO2 = 172 + integer, parameter :: rid_H_HO2a = 173 + integer, parameter :: rid_H_HO2b = 174 + integer, parameter :: rid_H_O2 = 175 + integer, parameter :: rid_HO2_O = 176 + integer, parameter :: rid_HO2_O3 = 177 + integer, parameter :: rid_H_O3 = 178 + integer, parameter :: rid_OH_H2 = 179 + integer, parameter :: rid_OH_H2O2 = 180 + integer, parameter :: rid_OH_HO2 = 181 + integer, parameter :: rid_OH_O = 182 + integer, parameter :: rid_OH_O3 = 183 + integer, parameter :: rid_OH_OH = 184 + integer, parameter :: rid_OH_OH_M = 185 + integer, parameter :: rid_usr_HO2_HO2 = 186 + integer, parameter :: rid_HO2NO2_OH = 187 + integer, parameter :: rid_N2D_O = 188 + integer, parameter :: rid_N2D_O2 = 189 + integer, parameter :: rid_N_NO = 190 + integer, parameter :: rid_N_NO2a = 191 + integer, parameter :: rid_N_NO2b = 192 + integer, parameter :: rid_N_NO2c = 193 + integer, parameter :: rid_N_O2 = 194 + integer, parameter :: rid_NO2_O = 195 + integer, parameter :: rid_NO2_O3 = 196 + integer, parameter :: rid_NO2_O_M = 197 + integer, parameter :: rid_NO3_HO2 = 198 + integer, parameter :: rid_NO3_NO = 199 + integer, parameter :: rid_NO3_O = 200 + integer, parameter :: rid_NO3_OH = 201 + integer, parameter :: rid_N_OH = 202 + integer, parameter :: rid_NO_HO2 = 203 + integer, parameter :: rid_NO_O3 = 204 + integer, parameter :: rid_NO_O_M = 205 + integer, parameter :: rid_O1D_N2Oa = 206 + integer, parameter :: rid_O1D_N2Ob = 207 + integer, parameter :: rid_tag_NO2_HO2 = 208 + integer, parameter :: rid_tag_NO2_NO3 = 209 + integer, parameter :: rid_tag_NO2_OH = 210 + integer, parameter :: rid_usr_HNO3_OH = 211 + integer, parameter :: rid_usr_HO2NO2_M = 212 + integer, parameter :: rid_usr_N2O5_M = 213 + integer, parameter :: rid_CL_CH2O = 214 + integer, parameter :: rid_CL_CH4 = 215 + integer, parameter :: rid_CL_H2 = 216 + integer, parameter :: rid_CL_H2O2 = 217 + integer, parameter :: rid_CL_HO2a = 218 + integer, parameter :: rid_CL_HO2b = 219 + integer, parameter :: rid_CL_O3 = 220 + integer, parameter :: rid_CLO_CH3O2 = 221 + integer, parameter :: rid_CLO_CLOa = 222 + integer, parameter :: rid_CLO_CLOb = 223 + integer, parameter :: rid_CLO_CLOc = 224 + integer, parameter :: rid_CLO_HO2 = 225 + integer, parameter :: rid_CLO_NO = 226 + integer, parameter :: rid_CLONO2_CL = 227 + integer, parameter :: rid_CLO_NO2_M = 228 + integer, parameter :: rid_CLONO2_O = 229 + integer, parameter :: rid_CLONO2_OH = 230 + integer, parameter :: rid_CLO_O = 231 + integer, parameter :: rid_CLO_OHa = 232 + integer, parameter :: rid_CLO_OHb = 233 + integer, parameter :: rid_HCL_O = 234 + integer, parameter :: rid_HCL_OH = 235 + integer, parameter :: rid_HOCL_CL = 236 + integer, parameter :: rid_HOCL_O = 237 + integer, parameter :: rid_HOCL_OH = 238 + integer, parameter :: rid_O1D_CCL4 = 239 + integer, parameter :: rid_O1D_CF2CLBR = 240 + integer, parameter :: rid_O1D_CFC11 = 241 + integer, parameter :: rid_O1D_CFC113 = 242 + integer, parameter :: rid_O1D_CFC114 = 243 + integer, parameter :: rid_O1D_CFC115 = 244 + integer, parameter :: rid_O1D_CFC12 = 245 + integer, parameter :: rid_O1D_HCLa = 246 + integer, parameter :: rid_O1D_HCLb = 247 + integer, parameter :: rid_tag_CLO_CLO_M = 248 + integer, parameter :: rid_usr_CL2O2_M = 249 + integer, parameter :: rid_BR_CH2O = 250 + integer, parameter :: rid_BR_HO2 = 251 + integer, parameter :: rid_BR_O3 = 252 + integer, parameter :: rid_BRO_BRO = 253 + integer, parameter :: rid_BRO_CLOa = 254 + integer, parameter :: rid_BRO_CLOb = 255 + integer, parameter :: rid_BRO_CLOc = 256 + integer, parameter :: rid_BRO_HO2 = 257 + integer, parameter :: rid_BRO_NO = 258 + integer, parameter :: rid_BRO_NO2_M = 259 + integer, parameter :: rid_BRONO2_O = 260 + integer, parameter :: rid_BRO_O = 261 + integer, parameter :: rid_BRO_OH = 262 + integer, parameter :: rid_HBR_O = 263 + integer, parameter :: rid_HBR_OH = 264 + integer, parameter :: rid_HOBR_O = 265 + integer, parameter :: rid_O1D_CF3BR = 266 + integer, parameter :: rid_O1D_CHBR3 = 267 + integer, parameter :: rid_O1D_H2402 = 268 + integer, parameter :: rid_O1D_HBRa = 269 + integer, parameter :: rid_O1D_HBRb = 270 + integer, parameter :: rid_F_CH4 = 271 + integer, parameter :: rid_F_H2 = 272 + integer, parameter :: rid_F_H2O = 273 + integer, parameter :: rid_F_HNO3 = 274 + integer, parameter :: rid_O1D_COF2 = 275 + integer, parameter :: rid_O1D_COFCL = 276 + integer, parameter :: rid_CH2BR2_CL = 277 + integer, parameter :: rid_CH2BR2_OH = 278 + integer, parameter :: rid_CH3BR_CL = 279 + integer, parameter :: rid_CH3BR_OH = 280 + integer, parameter :: rid_CH3CCL3_OH = 281 + integer, parameter :: rid_CH3CL_CL = 282 + integer, parameter :: rid_CH3CL_OH = 283 + integer, parameter :: rid_CHBR3_CL = 284 + integer, parameter :: rid_CHBR3_OH = 285 + integer, parameter :: rid_HCFC141B_OH = 286 + integer, parameter :: rid_HCFC142B_OH = 287 + integer, parameter :: rid_HCFC22_OH = 288 + integer, parameter :: rid_O1D_CH2BR2 = 289 + integer, parameter :: rid_O1D_CH3BR = 290 + integer, parameter :: rid_O1D_HCFC141B = 291 + integer, parameter :: rid_O1D_HCFC142B = 292 + integer, parameter :: rid_O1D_HCFC22 = 293 + integer, parameter :: rid_CH2O_HO2 = 294 + integer, parameter :: rid_CH2O_NO3 = 295 + integer, parameter :: rid_CH2O_O = 296 + integer, parameter :: rid_CH2O_OH = 297 + integer, parameter :: rid_CH3O2_CH3O2a = 298 + integer, parameter :: rid_CH3O2_CH3O2b = 299 + integer, parameter :: rid_CH3O2_HO2 = 300 + integer, parameter :: rid_CH3O2_NO = 301 + integer, parameter :: rid_CH3OH_OH = 302 + integer, parameter :: rid_CH3OOH_OH = 303 + integer, parameter :: rid_CH4_OH = 304 + integer, parameter :: rid_CO_OH_M = 305 + integer, parameter :: rid_HCN_OH = 306 + integer, parameter :: rid_HCOOH_OH = 307 + integer, parameter :: rid_HOCH2OO_HO2 = 308 + integer, parameter :: rid_HOCH2OO_M = 309 + integer, parameter :: rid_HOCH2OO_NO = 310 + integer, parameter :: rid_O1D_CH4a = 311 + integer, parameter :: rid_O1D_CH4b = 312 + integer, parameter :: rid_O1D_CH4c = 313 + integer, parameter :: rid_O1D_HCN = 314 + integer, parameter :: rid_usr_CO_OH_b = 315 + integer, parameter :: rid_C2H2_CL_M = 316 + integer, parameter :: rid_C2H2_OH_M = 317 + integer, parameter :: rid_C2H4_CL_M = 318 + integer, parameter :: rid_C2H4_O3 = 319 + integer, parameter :: rid_C2H5O2_C2H5O2 = 320 + integer, parameter :: rid_C2H5O2_CH3O2 = 321 + integer, parameter :: rid_C2H5O2_HO2 = 322 + integer, parameter :: rid_C2H5O2_NO = 323 + integer, parameter :: rid_C2H5OH_OH = 324 + integer, parameter :: rid_C2H5OOH_OH = 325 + integer, parameter :: rid_C2H6_CL = 326 + integer, parameter :: rid_C2H6_OH = 327 + integer, parameter :: rid_CH3CHO_NO3 = 328 + integer, parameter :: rid_CH3CHO_OH = 329 + integer, parameter :: rid_CH3CN_OH = 330 + integer, parameter :: rid_CH3CO3_CH3CO3 = 331 + integer, parameter :: rid_CH3CO3_CH3O2 = 332 + integer, parameter :: rid_CH3CO3_HO2 = 333 + integer, parameter :: rid_CH3CO3_NO = 334 + integer, parameter :: rid_CH3COOH_OH = 335 + integer, parameter :: rid_CH3COOOH_OH = 336 + integer, parameter :: rid_EO2_HO2 = 337 + integer, parameter :: rid_EO2_NO = 338 + integer, parameter :: rid_EO_M = 339 + integer, parameter :: rid_EO_O2 = 340 + integer, parameter :: rid_GLYALD_OH = 341 + integer, parameter :: rid_GLYOXAL_OH = 342 + integer, parameter :: rid_PAN_OH = 343 + integer, parameter :: rid_tag_C2H4_OH = 344 + integer, parameter :: rid_tag_CH3CO3_NO2 = 345 + integer, parameter :: rid_usr_PAN_M = 346 + integer, parameter :: rid_C3H6_NO3 = 347 + integer, parameter :: rid_C3H6_O3 = 348 + integer, parameter :: rid_C3H7O2_CH3O2 = 349 + integer, parameter :: rid_C3H7O2_HO2 = 350 + integer, parameter :: rid_C3H7O2_NO = 351 + integer, parameter :: rid_C3H7OOH_OH = 352 + integer, parameter :: rid_C3H8_OH = 353 + integer, parameter :: rid_CH3COCHO_NO3 = 354 + integer, parameter :: rid_CH3COCHO_OH = 355 + integer, parameter :: rid_HYAC_OH = 356 + integer, parameter :: rid_NOA_OH = 357 + integer, parameter :: rid_PO2_HO2 = 358 + integer, parameter :: rid_PO2_NO = 359 + integer, parameter :: rid_POOH_OH = 360 + integer, parameter :: rid_RO2_CH3O2 = 361 + integer, parameter :: rid_RO2_HO2 = 362 + integer, parameter :: rid_RO2_NO = 363 + integer, parameter :: rid_ROOH_OH = 364 + integer, parameter :: rid_tag_C3H6_OH = 365 + integer, parameter :: rid_usr_CH3COCH3_OH = 366 + integer, parameter :: rid_BIGENE_NO3 = 367 + integer, parameter :: rid_BIGENE_OH = 368 + integer, parameter :: rid_ENEO2_NO = 369 + integer, parameter :: rid_ENEO2_NOb = 370 + integer, parameter :: rid_HONITR_OH = 371 + integer, parameter :: rid_MACRO2_CH3CO3 = 372 + integer, parameter :: rid_MACRO2_CH3O2 = 373 + integer, parameter :: rid_MACRO2_HO2 = 374 + integer, parameter :: rid_MACRO2_NO3 = 375 + integer, parameter :: rid_MACRO2_NOa = 376 + integer, parameter :: rid_MACRO2_NOb = 377 + integer, parameter :: rid_MACR_O3 = 378 + integer, parameter :: rid_MACR_OH = 379 + integer, parameter :: rid_MACROOH_OH = 380 + integer, parameter :: rid_MCO3_CH3CO3 = 381 + integer, parameter :: rid_MCO3_CH3O2 = 382 + integer, parameter :: rid_MCO3_HO2 = 383 + integer, parameter :: rid_MCO3_MCO3 = 384 + integer, parameter :: rid_MCO3_NO = 385 + integer, parameter :: rid_MCO3_NO3 = 386 + integer, parameter :: rid_MEKO2_HO2 = 387 + integer, parameter :: rid_MEKO2_NO = 388 + integer, parameter :: rid_MEK_OH = 389 + integer, parameter :: rid_MEKOOH_OH = 390 + integer, parameter :: rid_MPAN_OH_M = 391 + integer, parameter :: rid_MVK_O3 = 392 + integer, parameter :: rid_MVK_OH = 393 + integer, parameter :: rid_usr_MCO3_NO2 = 394 + integer, parameter :: rid_usr_MPAN_M = 395 + integer, parameter :: rid_ALKNIT_OH = 396 + integer, parameter :: rid_ALKO2_HO2 = 397 + integer, parameter :: rid_ALKO2_NO = 398 + integer, parameter :: rid_ALKO2_NOb = 399 + integer, parameter :: rid_ALKOOH_OH = 400 + integer, parameter :: rid_BIGALK_OH = 401 + integer, parameter :: rid_HPALD_OH = 402 + integer, parameter :: rid_HYDRALD_OH = 403 + integer, parameter :: rid_IEPOX_OH = 404 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 405 + integer, parameter :: rid_ISOPAO2_CH3O2 = 406 + integer, parameter :: rid_ISOPAO2_HO2 = 407 + integer, parameter :: rid_ISOPAO2_NO = 408 + integer, parameter :: rid_ISOPAO2_NO3 = 409 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 410 + integer, parameter :: rid_ISOPBO2_CH3O2 = 411 + integer, parameter :: rid_ISOPBO2_HO2 = 412 + integer, parameter :: rid_ISOPBO2_M = 413 + integer, parameter :: rid_ISOPBO2_NO = 414 + integer, parameter :: rid_ISOPBO2_NO3 = 415 + integer, parameter :: rid_ISOPNITA_OH = 416 + integer, parameter :: rid_ISOPNITB_OH = 417 + integer, parameter :: rid_ISOP_NO3 = 418 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 419 + integer, parameter :: rid_ISOPNO3_CH3O2 = 420 + integer, parameter :: rid_ISOPNO3_HO2 = 421 + integer, parameter :: rid_ISOPNO3_NO = 422 + integer, parameter :: rid_ISOPNO3_NO3 = 423 + integer, parameter :: rid_ISOPNOOH_OH = 424 + integer, parameter :: rid_ISOP_O3 = 425 + integer, parameter :: rid_ISOP_OH = 426 + integer, parameter :: rid_ISOPOOH_OH = 427 + integer, parameter :: rid_NC4CH2OH_OH = 428 + integer, parameter :: rid_NC4CHO_OH = 429 + integer, parameter :: rid_XO2_CH3CO3 = 430 + integer, parameter :: rid_XO2_CH3O2 = 431 + integer, parameter :: rid_XO2_HO2 = 432 + integer, parameter :: rid_XO2_NO = 433 + integer, parameter :: rid_XO2_NO3 = 434 + integer, parameter :: rid_XOOH_OH = 435 + integer, parameter :: rid_ACBZO2_HO2 = 436 + integer, parameter :: rid_ACBZO2_NO = 437 + integer, parameter :: rid_BENZENE_OH = 438 + integer, parameter :: rid_BENZO2_HO2 = 439 + integer, parameter :: rid_BENZO2_NO = 440 + integer, parameter :: rid_BENZOOH_OH = 441 + integer, parameter :: rid_BZALD_OH = 442 + integer, parameter :: rid_BZOO_HO2 = 443 + integer, parameter :: rid_BZOOH_OH = 444 + integer, parameter :: rid_BZOO_NO = 445 + integer, parameter :: rid_C6H5O2_HO2 = 446 + integer, parameter :: rid_C6H5O2_NO = 447 + integer, parameter :: rid_C6H5OOH_OH = 448 + integer, parameter :: rid_CRESOL_OH = 449 + integer, parameter :: rid_DICARBO2_HO2 = 450 + integer, parameter :: rid_DICARBO2_NO = 451 + integer, parameter :: rid_DICARBO2_NO2 = 452 + integer, parameter :: rid_MALO2_HO2 = 453 + integer, parameter :: rid_MALO2_NO = 454 + integer, parameter :: rid_MALO2_NO2 = 455 + integer, parameter :: rid_MDIALO2_HO2 = 456 + integer, parameter :: rid_MDIALO2_NO = 457 + integer, parameter :: rid_MDIALO2_NO2 = 458 + integer, parameter :: rid_PHENO2_HO2 = 459 + integer, parameter :: rid_PHENO2_NO = 460 + integer, parameter :: rid_PHENOL_OH = 461 + integer, parameter :: rid_PHENO_NO2 = 462 + integer, parameter :: rid_PHENO_O3 = 463 + integer, parameter :: rid_PHENOOH_OH = 464 + integer, parameter :: rid_tag_ACBZO2_NO2 = 465 + integer, parameter :: rid_TOLO2_HO2 = 466 + integer, parameter :: rid_TOLO2_NO = 467 + integer, parameter :: rid_TOLOOH_OH = 468 + integer, parameter :: rid_TOLUENE_OH = 469 + integer, parameter :: rid_usr_PBZNIT_M = 470 + integer, parameter :: rid_XYLENES_OH = 471 + integer, parameter :: rid_XYLENO2_HO2 = 472 + integer, parameter :: rid_XYLENO2_NO = 473 + integer, parameter :: rid_XYLENOOH_OH = 474 + integer, parameter :: rid_XYLOLO2_HO2 = 475 + integer, parameter :: rid_XYLOLO2_NO = 476 + integer, parameter :: rid_XYLOL_OH = 477 + integer, parameter :: rid_XYLOLOOH_OH = 478 + integer, parameter :: rid_BCARY_NO3 = 479 + integer, parameter :: rid_BCARY_O3 = 480 + integer, parameter :: rid_BCARY_OH = 481 + integer, parameter :: rid_MTERP_NO3 = 482 + integer, parameter :: rid_MTERP_O3 = 483 + integer, parameter :: rid_MTERP_OH = 484 + integer, parameter :: rid_NTERPO2_CH3O2 = 485 + integer, parameter :: rid_NTERPO2_HO2 = 486 + integer, parameter :: rid_NTERPO2_NO = 487 + integer, parameter :: rid_NTERPO2_NO3 = 488 + integer, parameter :: rid_NTERPOOH_OH = 489 + integer, parameter :: rid_TERP2O2_CH3O2 = 490 + integer, parameter :: rid_TERP2O2_HO2 = 491 + integer, parameter :: rid_TERP2O2_NO = 492 + integer, parameter :: rid_TERP2OOH_OH = 493 + integer, parameter :: rid_TERPNIT_OH = 494 + integer, parameter :: rid_TERPO2_CH3O2 = 495 + integer, parameter :: rid_TERPO2_HO2 = 496 + integer, parameter :: rid_TERPO2_NO = 497 + integer, parameter :: rid_TERPOOH_OH = 498 + integer, parameter :: rid_TERPROD1_NO3 = 499 + integer, parameter :: rid_TERPROD1_OH = 500 + integer, parameter :: rid_TERPROD2_OH = 501 + integer, parameter :: rid_OCS_O = 502 + integer, parameter :: rid_OCS_OH = 503 + integer, parameter :: rid_S_O2 = 504 + integer, parameter :: rid_S_O3 = 505 + integer, parameter :: rid_SO_BRO = 506 + integer, parameter :: rid_SO_CLO = 507 + integer, parameter :: rid_S_OH = 508 + integer, parameter :: rid_SO_NO2 = 509 + integer, parameter :: rid_SO_O2 = 510 + integer, parameter :: rid_SO_O3 = 511 + integer, parameter :: rid_SO_OCLO = 512 + integer, parameter :: rid_SO_OH = 513 + integer, parameter :: rid_usr_SO2_OH = 514 + integer, parameter :: rid_usr_SO3_H2O = 515 + integer, parameter :: rid_DMS_NO3 = 516 + integer, parameter :: rid_DMS_OHa = 517 + integer, parameter :: rid_NH3_OH = 518 + integer, parameter :: rid_usr_DMS_OH = 519 + integer, parameter :: rid_usr_GLYOXAL_aer = 520 + integer, parameter :: rid_usr_HO2_aer = 521 + integer, parameter :: rid_usr_HONITR_aer = 522 + integer, parameter :: rid_usr_ISOPNITA_aer = 523 + integer, parameter :: rid_usr_ISOPNITB_aer = 524 + integer, parameter :: rid_usr_N2O5_aer = 525 + integer, parameter :: rid_usr_NC4CH2OH_aer = 526 + integer, parameter :: rid_usr_NC4CHO_aer = 527 + integer, parameter :: rid_usr_NH4_strat_tau = 528 + integer, parameter :: rid_usr_NO2_aer = 529 + integer, parameter :: rid_usr_NO3_aer = 530 + integer, parameter :: rid_usr_NTERPOOH_aer = 531 + integer, parameter :: rid_usr_ONITR_aer = 532 + integer, parameter :: rid_usr_TERPNIT_aer = 533 + integer, parameter :: rid_BCARY_NO3_vbs = 534 + integer, parameter :: rid_BCARY_O3_vbs = 535 + integer, parameter :: rid_BCARY_OH_vbs = 536 + integer, parameter :: rid_BENZENE_OH_vbs = 537 + integer, parameter :: rid_ISOP_NO3_vbs = 538 + integer, parameter :: rid_ISOP_O3_vbs = 539 + integer, parameter :: rid_ISOP_OH_vbs = 540 + integer, parameter :: rid_IVOC_OH = 541 + integer, parameter :: rid_MTERP_NO3_vbs = 542 + integer, parameter :: rid_MTERP_O3_vbs = 543 + integer, parameter :: rid_MTERP_OH_vbs = 544 + integer, parameter :: rid_SVOC_OH = 545 + integer, parameter :: rid_TOLUENE_OH_vbs = 546 + integer, parameter :: rid_XYLENES_OH_vbs = 547 + integer, parameter :: rid_het1 = 548 + integer, parameter :: rid_het10 = 549 + integer, parameter :: rid_het11 = 550 + integer, parameter :: rid_het12 = 551 + integer, parameter :: rid_het13 = 552 + integer, parameter :: rid_het14 = 553 + integer, parameter :: rid_het15 = 554 + integer, parameter :: rid_het16 = 555 + integer, parameter :: rid_het17 = 556 + integer, parameter :: rid_het2 = 557 + integer, parameter :: rid_het3 = 558 + integer, parameter :: rid_het4 = 559 + integer, parameter :: rid_het5 = 560 + integer, parameter :: rid_het6 = 561 + integer, parameter :: rid_het7 = 562 + integer, parameter :: rid_het8 = 563 + integer, parameter :: rid_het9 = 564 + integer, parameter :: rid_elec1 = 565 + integer, parameter :: rid_elec2 = 566 + integer, parameter :: rid_elec3 = 567 + integer, parameter :: rid_ion_N2p_O2 = 568 + integer, parameter :: rid_ion_N2p_Oa = 569 + integer, parameter :: rid_ion_N2p_Ob = 570 + integer, parameter :: rid_ion_Np_O = 571 + integer, parameter :: rid_ion_Np_O2a = 572 + integer, parameter :: rid_ion_Np_O2b = 573 + integer, parameter :: rid_ion_O2p_N = 574 + integer, parameter :: rid_ion_O2p_N2 = 575 + integer, parameter :: rid_ion_O2p_NO = 576 + integer, parameter :: rid_ion_Op_CO2 = 577 + integer, parameter :: rid_ion_Op_N2 = 578 + integer, parameter :: rid_ion_Op_O2 = 579 + integer, parameter :: rid_E90_tau = 580 + integer, parameter :: rid_NH_50_tau = 581 + integer, parameter :: rid_NH_5_tau = 582 + integer, parameter :: rid_ST80_25_tau = 583 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..8152221e42 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 @@ -0,0 +1,234 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BENZENE = 7 + integer, parameter :: id_BENZOOH = 8 + integer, parameter :: id_BEPOMUC = 9 + integer, parameter :: id_BIGALD = 10 + integer, parameter :: id_BIGALD1 = 11 + integer, parameter :: id_BIGALD2 = 12 + integer, parameter :: id_BIGALD3 = 13 + integer, parameter :: id_BIGALD4 = 14 + integer, parameter :: id_BIGALK = 15 + integer, parameter :: id_BIGENE = 16 + integer, parameter :: id_BR = 17 + integer, parameter :: id_BRCL = 18 + integer, parameter :: id_BRO = 19 + integer, parameter :: id_BRONO2 = 20 + integer, parameter :: id_BRY = 21 + integer, parameter :: id_BZALD = 22 + integer, parameter :: id_BZOOH = 23 + integer, parameter :: id_C2H2 = 24 + integer, parameter :: id_C2H4 = 25 + integer, parameter :: id_C2H5OH = 26 + integer, parameter :: id_C2H5OOH = 27 + integer, parameter :: id_C2H6 = 28 + integer, parameter :: id_C3H6 = 29 + integer, parameter :: id_C3H7OOH = 30 + integer, parameter :: id_C3H8 = 31 + integer, parameter :: id_C6H5OOH = 32 + integer, parameter :: id_CCL4 = 33 + integer, parameter :: id_CF2CLBR = 34 + integer, parameter :: id_CF3BR = 35 + integer, parameter :: id_CFC11 = 36 + integer, parameter :: id_CFC113 = 37 + integer, parameter :: id_CFC114 = 38 + integer, parameter :: id_CFC115 = 39 + integer, parameter :: id_CFC12 = 40 + integer, parameter :: id_CH2BR2 = 41 + integer, parameter :: id_CH2O = 42 + integer, parameter :: id_CH3BR = 43 + integer, parameter :: id_CH3CCL3 = 44 + integer, parameter :: id_CH3CHO = 45 + integer, parameter :: id_CH3CL = 46 + integer, parameter :: id_CH3CN = 47 + integer, parameter :: id_CH3COCH3 = 48 + integer, parameter :: id_CH3COCHO = 49 + integer, parameter :: id_CH3COOH = 50 + integer, parameter :: id_CH3COOOH = 51 + integer, parameter :: id_CH3OH = 52 + integer, parameter :: id_CH3OOH = 53 + integer, parameter :: id_CH4 = 54 + integer, parameter :: id_CHBR3 = 55 + integer, parameter :: id_CL = 56 + integer, parameter :: id_CL2 = 57 + integer, parameter :: id_CL2O2 = 58 + integer, parameter :: id_CLO = 59 + integer, parameter :: id_CLONO2 = 60 + integer, parameter :: id_CLY = 61 + integer, parameter :: id_CO = 62 + integer, parameter :: id_CO2 = 63 + integer, parameter :: id_COF2 = 64 + integer, parameter :: id_COFCL = 65 + integer, parameter :: id_CRESOL = 66 + integer, parameter :: id_DMS = 67 + integer, parameter :: id_dst_a1 = 68 + integer, parameter :: id_dst_a2 = 69 + integer, parameter :: id_dst_a3 = 70 + integer, parameter :: id_E90 = 71 + integer, parameter :: id_EOOH = 72 + integer, parameter :: id_F = 73 + integer, parameter :: id_GLYALD = 74 + integer, parameter :: id_GLYOXAL = 75 + integer, parameter :: id_H = 76 + integer, parameter :: id_H2 = 77 + integer, parameter :: id_H2402 = 78 + integer, parameter :: id_H2O2 = 79 + integer, parameter :: id_H2SO4 = 80 + integer, parameter :: id_HBR = 81 + integer, parameter :: id_HCFC141B = 82 + integer, parameter :: id_HCFC142B = 83 + integer, parameter :: id_HCFC22 = 84 + integer, parameter :: id_HCL = 85 + integer, parameter :: id_HCN = 86 + integer, parameter :: id_HCOOH = 87 + integer, parameter :: id_HF = 88 + integer, parameter :: id_HNO3 = 89 + integer, parameter :: id_HO2NO2 = 90 + integer, parameter :: id_HOBR = 91 + integer, parameter :: id_HOCL = 92 + integer, parameter :: id_HONITR = 93 + integer, parameter :: id_HPALD = 94 + integer, parameter :: id_HYAC = 95 + integer, parameter :: id_HYDRALD = 96 + integer, parameter :: id_IEPOX = 97 + integer, parameter :: id_ISOP = 98 + integer, parameter :: id_ISOPNITA = 99 + integer, parameter :: id_ISOPNITB = 100 + integer, parameter :: id_ISOPNO3 = 101 + integer, parameter :: id_ISOPNOOH = 102 + integer, parameter :: id_ISOPOOH = 103 + integer, parameter :: id_IVOC = 104 + integer, parameter :: id_MACR = 105 + integer, parameter :: id_MACROOH = 106 + integer, parameter :: id_MEK = 107 + integer, parameter :: id_MEKOOH = 108 + integer, parameter :: id_MPAN = 109 + integer, parameter :: id_MTERP = 110 + integer, parameter :: id_MVK = 111 + integer, parameter :: id_N = 112 + integer, parameter :: id_N2O = 113 + integer, parameter :: id_N2O5 = 114 + integer, parameter :: id_NC4CH2OH = 115 + integer, parameter :: id_NC4CHO = 116 + integer, parameter :: id_ncl_a1 = 117 + integer, parameter :: id_ncl_a2 = 118 + integer, parameter :: id_ncl_a3 = 119 + integer, parameter :: id_NH3 = 120 + integer, parameter :: id_NH4 = 121 + integer, parameter :: id_NH_5 = 122 + integer, parameter :: id_NH_50 = 123 + integer, parameter :: id_NO = 124 + integer, parameter :: id_NO2 = 125 + integer, parameter :: id_NO3 = 126 + integer, parameter :: id_NOA = 127 + integer, parameter :: id_NTERPOOH = 128 + integer, parameter :: id_num_a1 = 129 + integer, parameter :: id_num_a2 = 130 + integer, parameter :: id_num_a3 = 131 + integer, parameter :: id_num_a4 = 132 + integer, parameter :: id_O = 133 + integer, parameter :: id_O2 = 134 + integer, parameter :: id_O3 = 135 + integer, parameter :: id_OCLO = 136 + integer, parameter :: id_OCS = 137 + integer, parameter :: id_ONITR = 138 + integer, parameter :: id_PAN = 139 + integer, parameter :: id_PBZNIT = 140 + integer, parameter :: id_PHENO = 141 + integer, parameter :: id_PHENOL = 142 + integer, parameter :: id_PHENOOH = 143 + integer, parameter :: id_pom_a1 = 144 + integer, parameter :: id_pom_a4 = 145 + integer, parameter :: id_POOH = 146 + integer, parameter :: id_ROOH = 147 + integer, parameter :: id_S = 148 + integer, parameter :: id_SF6 = 149 + integer, parameter :: id_SO = 150 + integer, parameter :: id_SO2 = 151 + integer, parameter :: id_SO3 = 152 + integer, parameter :: id_so4_a1 = 153 + integer, parameter :: id_so4_a2 = 154 + integer, parameter :: id_so4_a3 = 155 + integer, parameter :: id_soa1_a1 = 156 + integer, parameter :: id_soa1_a2 = 157 + integer, parameter :: id_soa2_a1 = 158 + integer, parameter :: id_soa2_a2 = 159 + integer, parameter :: id_soa3_a1 = 160 + integer, parameter :: id_soa3_a2 = 161 + integer, parameter :: id_soa4_a1 = 162 + integer, parameter :: id_soa4_a2 = 163 + integer, parameter :: id_soa5_a1 = 164 + integer, parameter :: id_soa5_a2 = 165 + integer, parameter :: id_SOAG0 = 166 + integer, parameter :: id_SOAG1 = 167 + integer, parameter :: id_SOAG2 = 168 + integer, parameter :: id_SOAG3 = 169 + integer, parameter :: id_SOAG4 = 170 + integer, parameter :: id_ST80_25 = 171 + integer, parameter :: id_SVOC = 172 + integer, parameter :: id_TEPOMUC = 173 + integer, parameter :: id_TERP2OOH = 174 + integer, parameter :: id_TERPNIT = 175 + integer, parameter :: id_TERPOOH = 176 + integer, parameter :: id_TERPROD1 = 177 + integer, parameter :: id_TERPROD2 = 178 + integer, parameter :: id_TOLOOH = 179 + integer, parameter :: id_TOLUENE = 180 + integer, parameter :: id_XOOH = 181 + integer, parameter :: id_XYLENES = 182 + integer, parameter :: id_XYLENOOH = 183 + integer, parameter :: id_XYLOL = 184 + integer, parameter :: id_XYLOLOOH = 185 + integer, parameter :: id_NHDEP = 186 + integer, parameter :: id_NDEP = 187 + integer, parameter :: id_ACBZO2 = 188 + integer, parameter :: id_ALKO2 = 189 + integer, parameter :: id_BENZO2 = 190 + integer, parameter :: id_BZOO = 191 + integer, parameter :: id_C2H5O2 = 192 + integer, parameter :: id_C3H7O2 = 193 + integer, parameter :: id_C6H5O2 = 194 + integer, parameter :: id_CH3CO3 = 195 + integer, parameter :: id_CH3O2 = 196 + integer, parameter :: id_DICARBO2 = 197 + integer, parameter :: id_e = 198 + integer, parameter :: id_ENEO2 = 199 + integer, parameter :: id_EO = 200 + integer, parameter :: id_EO2 = 201 + integer, parameter :: id_HO2 = 202 + integer, parameter :: id_HOCH2OO = 203 + integer, parameter :: id_ISOPAO2 = 204 + integer, parameter :: id_ISOPBO2 = 205 + integer, parameter :: id_MACRO2 = 206 + integer, parameter :: id_MALO2 = 207 + integer, parameter :: id_MCO3 = 208 + integer, parameter :: id_MDIALO2 = 209 + integer, parameter :: id_MEKO2 = 210 + integer, parameter :: id_N2D = 211 + integer, parameter :: id_N2p = 212 + integer, parameter :: id_NOp = 213 + integer, parameter :: id_Np = 214 + integer, parameter :: id_NTERPO2 = 215 + integer, parameter :: id_O1D = 216 + integer, parameter :: id_O2_1D = 217 + integer, parameter :: id_O2_1S = 218 + integer, parameter :: id_O2p = 219 + integer, parameter :: id_OH = 220 + integer, parameter :: id_Op = 221 + integer, parameter :: id_PHENO2 = 222 + integer, parameter :: id_PO2 = 223 + integer, parameter :: id_RO2 = 224 + integer, parameter :: id_TERP2O2 = 225 + integer, parameter :: id_TERPO2 = 226 + integer, parameter :: id_TOLO2 = 227 + integer, parameter :: id_XO2 = 228 + integer, parameter :: id_XYLENO2 = 229 + integer, parameter :: id_XYLOLO2 = 230 + integer, parameter :: id_H2O = 231 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..e97c5a1e39 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 @@ -0,0 +1,444 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:,155) = rate(:,:,155) * inv(:,:, 2) + rate(:,:,159) = rate(:,:,159) * inv(:,:, 2) + rate(:,:,163) = rate(:,:,163) * inv(:,:, 2) + rate(:,:,168) = rate(:,:,168) * inv(:,:, 1) + rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) + rate(:,:,175) = rate(:,:,175) * inv(:,:, 1) + rate(:,:,185) = rate(:,:,185) * inv(:,:, 1) + rate(:,:,197) = rate(:,:,197) * inv(:,:, 1) + rate(:,:,205) = rate(:,:,205) * inv(:,:, 1) + rate(:,:,208) = rate(:,:,208) * inv(:,:, 1) + rate(:,:,209) = rate(:,:,209) * inv(:,:, 1) + rate(:,:,210) = rate(:,:,210) * inv(:,:, 1) + rate(:,:,212) = rate(:,:,212) * inv(:,:, 1) + rate(:,:,213) = rate(:,:,213) * inv(:,:, 1) + rate(:,:,228) = rate(:,:,228) * inv(:,:, 1) + rate(:,:,248) = rate(:,:,248) * inv(:,:, 1) + rate(:,:,249) = rate(:,:,249) * inv(:,:, 1) + rate(:,:,259) = rate(:,:,259) * inv(:,:, 1) + rate(:,:,305) = rate(:,:,305) * inv(:,:, 1) + rate(:,:,306) = rate(:,:,306) * inv(:,:, 1) + rate(:,:,316) = rate(:,:,316) * inv(:,:, 1) + rate(:,:,317) = rate(:,:,317) * inv(:,:, 1) + rate(:,:,318) = rate(:,:,318) * inv(:,:, 1) + rate(:,:,344) = rate(:,:,344) * inv(:,:, 1) + rate(:,:,345) = rate(:,:,345) * inv(:,:, 1) + rate(:,:,346) = rate(:,:,346) * inv(:,:, 1) + rate(:,:,365) = rate(:,:,365) * inv(:,:, 1) + rate(:,:,391) = rate(:,:,391) * inv(:,:, 1) + rate(:,:,394) = rate(:,:,394) * inv(:,:, 1) + rate(:,:,395) = rate(:,:,395) * inv(:,:, 1) + rate(:,:,452) = rate(:,:,452) * inv(:,:, 1) + rate(:,:,455) = rate(:,:,455) * inv(:,:, 1) + rate(:,:,458) = rate(:,:,458) * inv(:,:, 1) + rate(:,:,465) = rate(:,:,465) * inv(:,:, 1) + rate(:,:,470) = rate(:,:,470) * inv(:,:, 1) + rate(:,:,575) = rate(:,:,575) * inv(:,:, 2) + rate(:,:,578) = rate(:,:,578) * inv(:,:, 2) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,197) = rate(:,:,197) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,206) = rate(:,:,206) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,225) = rate(:,:,225) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,264) = rate(:,:,264) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,269) = rate(:,:,269) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,274) = rate(:,:,274) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,277) = rate(:,:,277) * m(:,:) + rate(:,:,278) = rate(:,:,278) * m(:,:) + rate(:,:,279) = rate(:,:,279) * m(:,:) + rate(:,:,280) = rate(:,:,280) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,285) = rate(:,:,285) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,288) = rate(:,:,288) * m(:,:) + rate(:,:,289) = rate(:,:,289) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,292) = rate(:,:,292) * m(:,:) + rate(:,:,293) = rate(:,:,293) * m(:,:) + rate(:,:,294) = rate(:,:,294) * m(:,:) + rate(:,:,295) = rate(:,:,295) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + rate(:,:,299) = rate(:,:,299) * m(:,:) + rate(:,:,300) = rate(:,:,300) * m(:,:) + rate(:,:,301) = rate(:,:,301) * m(:,:) + rate(:,:,302) = rate(:,:,302) * m(:,:) + rate(:,:,303) = rate(:,:,303) * m(:,:) + rate(:,:,304) = rate(:,:,304) * m(:,:) + rate(:,:,305) = rate(:,:,305) * m(:,:) + rate(:,:,306) = rate(:,:,306) * m(:,:) + rate(:,:,307) = rate(:,:,307) * m(:,:) + rate(:,:,308) = rate(:,:,308) * m(:,:) + rate(:,:,310) = rate(:,:,310) * m(:,:) + rate(:,:,311) = rate(:,:,311) * m(:,:) + rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:,313) = rate(:,:,313) * m(:,:) + rate(:,:,314) = rate(:,:,314) * m(:,:) + rate(:,:,315) = rate(:,:,315) * m(:,:) + rate(:,:,316) = rate(:,:,316) * m(:,:) + rate(:,:,317) = rate(:,:,317) * m(:,:) + rate(:,:,318) = rate(:,:,318) * m(:,:) + rate(:,:,319) = rate(:,:,319) * m(:,:) + rate(:,:,320) = rate(:,:,320) * m(:,:) + rate(:,:,321) = rate(:,:,321) * m(:,:) + rate(:,:,322) = rate(:,:,322) * m(:,:) + rate(:,:,323) = rate(:,:,323) * m(:,:) + rate(:,:,324) = rate(:,:,324) * m(:,:) + rate(:,:,325) = rate(:,:,325) * m(:,:) + rate(:,:,326) = rate(:,:,326) * m(:,:) + rate(:,:,327) = rate(:,:,327) * m(:,:) + rate(:,:,328) = rate(:,:,328) * m(:,:) + rate(:,:,329) = rate(:,:,329) * m(:,:) + rate(:,:,330) = rate(:,:,330) * m(:,:) + rate(:,:,331) = rate(:,:,331) * m(:,:) + rate(:,:,332) = rate(:,:,332) * m(:,:) + rate(:,:,333) = rate(:,:,333) * m(:,:) + rate(:,:,334) = rate(:,:,334) * m(:,:) + rate(:,:,335) = rate(:,:,335) * m(:,:) + rate(:,:,336) = rate(:,:,336) * m(:,:) + rate(:,:,337) = rate(:,:,337) * m(:,:) + rate(:,:,338) = rate(:,:,338) * m(:,:) + rate(:,:,340) = rate(:,:,340) * m(:,:) + rate(:,:,341) = rate(:,:,341) * m(:,:) + rate(:,:,342) = rate(:,:,342) * m(:,:) + rate(:,:,343) = rate(:,:,343) * m(:,:) + rate(:,:,344) = rate(:,:,344) * m(:,:) + rate(:,:,345) = rate(:,:,345) * m(:,:) + rate(:,:,347) = rate(:,:,347) * m(:,:) + rate(:,:,348) = rate(:,:,348) * m(:,:) + rate(:,:,349) = rate(:,:,349) * m(:,:) + rate(:,:,350) = rate(:,:,350) * m(:,:) + rate(:,:,351) = rate(:,:,351) * m(:,:) + rate(:,:,352) = rate(:,:,352) * m(:,:) + rate(:,:,353) = rate(:,:,353) * m(:,:) + rate(:,:,354) = rate(:,:,354) * m(:,:) + rate(:,:,355) = rate(:,:,355) * m(:,:) + rate(:,:,356) = rate(:,:,356) * m(:,:) + rate(:,:,357) = rate(:,:,357) * m(:,:) + rate(:,:,358) = rate(:,:,358) * m(:,:) + rate(:,:,359) = rate(:,:,359) * m(:,:) + rate(:,:,360) = rate(:,:,360) * m(:,:) + rate(:,:,361) = rate(:,:,361) * m(:,:) + rate(:,:,362) = rate(:,:,362) * m(:,:) + rate(:,:,363) = rate(:,:,363) * m(:,:) + rate(:,:,364) = rate(:,:,364) * m(:,:) + rate(:,:,365) = rate(:,:,365) * m(:,:) + rate(:,:,366) = rate(:,:,366) * m(:,:) + rate(:,:,367) = rate(:,:,367) * m(:,:) + rate(:,:,368) = rate(:,:,368) * m(:,:) + rate(:,:,369) = rate(:,:,369) * m(:,:) + rate(:,:,370) = rate(:,:,370) * m(:,:) + rate(:,:,371) = rate(:,:,371) * m(:,:) + rate(:,:,372) = rate(:,:,372) * m(:,:) + rate(:,:,373) = rate(:,:,373) * m(:,:) + rate(:,:,374) = rate(:,:,374) * m(:,:) + rate(:,:,375) = rate(:,:,375) * m(:,:) + rate(:,:,376) = rate(:,:,376) * m(:,:) + rate(:,:,377) = rate(:,:,377) * m(:,:) + rate(:,:,378) = rate(:,:,378) * m(:,:) + rate(:,:,379) = rate(:,:,379) * m(:,:) + rate(:,:,380) = rate(:,:,380) * m(:,:) + rate(:,:,381) = rate(:,:,381) * m(:,:) + rate(:,:,382) = rate(:,:,382) * m(:,:) + rate(:,:,383) = rate(:,:,383) * m(:,:) + rate(:,:,384) = rate(:,:,384) * m(:,:) + rate(:,:,385) = rate(:,:,385) * m(:,:) + rate(:,:,386) = rate(:,:,386) * m(:,:) + rate(:,:,387) = rate(:,:,387) * m(:,:) + rate(:,:,388) = rate(:,:,388) * m(:,:) + rate(:,:,389) = rate(:,:,389) * m(:,:) + rate(:,:,390) = rate(:,:,390) * m(:,:) + rate(:,:,391) = rate(:,:,391) * m(:,:) + rate(:,:,392) = rate(:,:,392) * m(:,:) + rate(:,:,393) = rate(:,:,393) * m(:,:) + rate(:,:,394) = rate(:,:,394) * m(:,:) + rate(:,:,396) = rate(:,:,396) * m(:,:) + rate(:,:,397) = rate(:,:,397) * m(:,:) + rate(:,:,398) = rate(:,:,398) * m(:,:) + rate(:,:,399) = rate(:,:,399) * m(:,:) + rate(:,:,400) = rate(:,:,400) * m(:,:) + rate(:,:,401) = rate(:,:,401) * m(:,:) + rate(:,:,402) = rate(:,:,402) * m(:,:) + rate(:,:,403) = rate(:,:,403) * m(:,:) + rate(:,:,404) = rate(:,:,404) * m(:,:) + rate(:,:,405) = rate(:,:,405) * m(:,:) + rate(:,:,406) = rate(:,:,406) * m(:,:) + rate(:,:,407) = rate(:,:,407) * m(:,:) + rate(:,:,408) = rate(:,:,408) * m(:,:) + rate(:,:,409) = rate(:,:,409) * m(:,:) + rate(:,:,410) = rate(:,:,410) * m(:,:) + rate(:,:,411) = rate(:,:,411) * m(:,:) + rate(:,:,412) = rate(:,:,412) * m(:,:) + rate(:,:,414) = rate(:,:,414) * m(:,:) + rate(:,:,415) = rate(:,:,415) * m(:,:) + rate(:,:,416) = rate(:,:,416) * m(:,:) + rate(:,:,417) = rate(:,:,417) * m(:,:) + rate(:,:,418) = rate(:,:,418) * m(:,:) + rate(:,:,419) = rate(:,:,419) * m(:,:) + rate(:,:,420) = rate(:,:,420) * m(:,:) + rate(:,:,421) = rate(:,:,421) * m(:,:) + rate(:,:,422) = rate(:,:,422) * m(:,:) + rate(:,:,423) = rate(:,:,423) * m(:,:) + rate(:,:,424) = rate(:,:,424) * m(:,:) + rate(:,:,425) = rate(:,:,425) * m(:,:) + rate(:,:,426) = rate(:,:,426) * m(:,:) + rate(:,:,427) = rate(:,:,427) * m(:,:) + rate(:,:,428) = rate(:,:,428) * m(:,:) + rate(:,:,429) = rate(:,:,429) * m(:,:) + rate(:,:,430) = rate(:,:,430) * m(:,:) + rate(:,:,431) = rate(:,:,431) * m(:,:) + rate(:,:,432) = rate(:,:,432) * m(:,:) + rate(:,:,433) = rate(:,:,433) * m(:,:) + rate(:,:,434) = rate(:,:,434) * m(:,:) + rate(:,:,435) = rate(:,:,435) * m(:,:) + rate(:,:,436) = rate(:,:,436) * m(:,:) + rate(:,:,437) = rate(:,:,437) * m(:,:) + rate(:,:,438) = rate(:,:,438) * m(:,:) + rate(:,:,439) = rate(:,:,439) * m(:,:) + rate(:,:,440) = rate(:,:,440) * m(:,:) + rate(:,:,441) = rate(:,:,441) * m(:,:) + rate(:,:,442) = rate(:,:,442) * m(:,:) + rate(:,:,443) = rate(:,:,443) * m(:,:) + rate(:,:,444) = rate(:,:,444) * m(:,:) + rate(:,:,445) = rate(:,:,445) * m(:,:) + rate(:,:,446) = rate(:,:,446) * m(:,:) + rate(:,:,447) = rate(:,:,447) * m(:,:) + rate(:,:,448) = rate(:,:,448) * m(:,:) + rate(:,:,449) = rate(:,:,449) * m(:,:) + rate(:,:,450) = rate(:,:,450) * m(:,:) + rate(:,:,451) = rate(:,:,451) * m(:,:) + rate(:,:,452) = rate(:,:,452) * m(:,:) + rate(:,:,453) = rate(:,:,453) * m(:,:) + rate(:,:,454) = rate(:,:,454) * m(:,:) + rate(:,:,455) = rate(:,:,455) * m(:,:) + rate(:,:,456) = rate(:,:,456) * m(:,:) + rate(:,:,457) = rate(:,:,457) * m(:,:) + rate(:,:,458) = rate(:,:,458) * m(:,:) + rate(:,:,459) = rate(:,:,459) * m(:,:) + rate(:,:,460) = rate(:,:,460) * m(:,:) + rate(:,:,461) = rate(:,:,461) * m(:,:) + rate(:,:,462) = rate(:,:,462) * m(:,:) + rate(:,:,463) = rate(:,:,463) * m(:,:) + rate(:,:,464) = rate(:,:,464) * m(:,:) + rate(:,:,465) = rate(:,:,465) * m(:,:) + rate(:,:,466) = rate(:,:,466) * m(:,:) + rate(:,:,467) = rate(:,:,467) * m(:,:) + rate(:,:,468) = rate(:,:,468) * m(:,:) + rate(:,:,469) = rate(:,:,469) * m(:,:) + rate(:,:,471) = rate(:,:,471) * m(:,:) + rate(:,:,472) = rate(:,:,472) * m(:,:) + rate(:,:,473) = rate(:,:,473) * m(:,:) + rate(:,:,474) = rate(:,:,474) * m(:,:) + rate(:,:,475) = rate(:,:,475) * m(:,:) + rate(:,:,476) = rate(:,:,476) * m(:,:) + rate(:,:,477) = rate(:,:,477) * m(:,:) + rate(:,:,478) = rate(:,:,478) * m(:,:) + rate(:,:,479) = rate(:,:,479) * m(:,:) + rate(:,:,480) = rate(:,:,480) * m(:,:) + rate(:,:,481) = rate(:,:,481) * m(:,:) + rate(:,:,482) = rate(:,:,482) * m(:,:) + rate(:,:,483) = rate(:,:,483) * m(:,:) + rate(:,:,484) = rate(:,:,484) * m(:,:) + rate(:,:,485) = rate(:,:,485) * m(:,:) + rate(:,:,486) = rate(:,:,486) * m(:,:) + rate(:,:,487) = rate(:,:,487) * m(:,:) + rate(:,:,488) = rate(:,:,488) * m(:,:) + rate(:,:,489) = rate(:,:,489) * m(:,:) + rate(:,:,490) = rate(:,:,490) * m(:,:) + rate(:,:,491) = rate(:,:,491) * m(:,:) + rate(:,:,492) = rate(:,:,492) * m(:,:) + rate(:,:,493) = rate(:,:,493) * m(:,:) + rate(:,:,494) = rate(:,:,494) * m(:,:) + rate(:,:,495) = rate(:,:,495) * m(:,:) + rate(:,:,496) = rate(:,:,496) * m(:,:) + rate(:,:,497) = rate(:,:,497) * m(:,:) + rate(:,:,498) = rate(:,:,498) * m(:,:) + rate(:,:,499) = rate(:,:,499) * m(:,:) + rate(:,:,500) = rate(:,:,500) * m(:,:) + rate(:,:,501) = rate(:,:,501) * m(:,:) + rate(:,:,502) = rate(:,:,502) * m(:,:) + rate(:,:,503) = rate(:,:,503) * m(:,:) + rate(:,:,504) = rate(:,:,504) * m(:,:) + rate(:,:,505) = rate(:,:,505) * m(:,:) + rate(:,:,506) = rate(:,:,506) * m(:,:) + rate(:,:,507) = rate(:,:,507) * m(:,:) + rate(:,:,508) = rate(:,:,508) * m(:,:) + rate(:,:,509) = rate(:,:,509) * m(:,:) + rate(:,:,510) = rate(:,:,510) * m(:,:) + rate(:,:,511) = rate(:,:,511) * m(:,:) + rate(:,:,512) = rate(:,:,512) * m(:,:) + rate(:,:,513) = rate(:,:,513) * m(:,:) + rate(:,:,514) = rate(:,:,514) * m(:,:) + rate(:,:,515) = rate(:,:,515) * m(:,:) + rate(:,:,516) = rate(:,:,516) * m(:,:) + rate(:,:,517) = rate(:,:,517) * m(:,:) + rate(:,:,518) = rate(:,:,518) * m(:,:) + rate(:,:,519) = rate(:,:,519) * m(:,:) + rate(:,:,534) = rate(:,:,534) * m(:,:) + rate(:,:,535) = rate(:,:,535) * m(:,:) + rate(:,:,536) = rate(:,:,536) * m(:,:) + rate(:,:,537) = rate(:,:,537) * m(:,:) + rate(:,:,538) = rate(:,:,538) * m(:,:) + rate(:,:,539) = rate(:,:,539) * m(:,:) + rate(:,:,540) = rate(:,:,540) * m(:,:) + rate(:,:,541) = rate(:,:,541) * m(:,:) + rate(:,:,542) = rate(:,:,542) * m(:,:) + rate(:,:,543) = rate(:,:,543) * m(:,:) + rate(:,:,544) = rate(:,:,544) * m(:,:) + rate(:,:,545) = rate(:,:,545) * m(:,:) + rate(:,:,546) = rate(:,:,546) * m(:,:) + rate(:,:,547) = rate(:,:,547) * m(:,:) + rate(:,:,549) = rate(:,:,549) * m(:,:) + rate(:,:,554) = rate(:,:,554) * m(:,:) + rate(:,:,555) = rate(:,:,555) * m(:,:) + rate(:,:,556) = rate(:,:,556) * m(:,:) + rate(:,:,559) = rate(:,:,559) * m(:,:) + rate(:,:,560) = rate(:,:,560) * m(:,:) + rate(:,:,561) = rate(:,:,561) * m(:,:) + rate(:,:,564) = rate(:,:,564) * m(:,:) + rate(:,:,565) = rate(:,:,565) * m(:,:) + rate(:,:,566) = rate(:,:,566) * m(:,:) + rate(:,:,567) = rate(:,:,567) * m(:,:) + rate(:,:,568) = rate(:,:,568) * m(:,:) + rate(:,:,569) = rate(:,:,569) * m(:,:) + rate(:,:,570) = rate(:,:,570) * m(:,:) + rate(:,:,571) = rate(:,:,571) * m(:,:) + rate(:,:,572) = rate(:,:,572) * m(:,:) + rate(:,:,573) = rate(:,:,573) * m(:,:) + rate(:,:,574) = rate(:,:,574) * m(:,:) + rate(:,:,576) = rate(:,:,576) * m(:,:) + rate(:,:,577) = rate(:,:,577) * m(:,:) + rate(:,:,579) = rate(:,:,579) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..0b52bbf95c --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 @@ -0,0 +1,289 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) = + extfrc(:,15) + prod(:,2) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) =.100_r8*rxt(:,348)*y(:,135)*y(:,29) + prod(:,16) = 0._r8 + prod(:,17) = 0._r8 + prod(:,18) = (rxt(:,305)*y(:,62) +rxt(:,307)*y(:,87) +rxt(:,315)*y(:,62) + & + rxt(:,335)*y(:,50) +.500_r8*rxt(:,336)*y(:,51) + & + .800_r8*rxt(:,341)*y(:,74) +rxt(:,342)*y(:,75) + & + .500_r8*rxt(:,391)*y(:,109) +1.800_r8*rxt(:,501)*y(:,178))*y(:,220) & + + (2.000_r8*rxt(:,331)*y(:,195) +.900_r8*rxt(:,332)*y(:,196) + & + rxt(:,334)*y(:,124) +2.000_r8*rxt(:,381)*y(:,208) + & + rxt(:,405)*y(:,204) +rxt(:,430)*y(:,228))*y(:,195) & + + (.200_r8*rxt(:,348)*y(:,29) +.100_r8*rxt(:,392)*y(:,111) + & + .270_r8*rxt(:,480)*y(:,6) +.270_r8*rxt(:,483)*y(:,110))*y(:,135) & + + (rxt(:,382)*y(:,196) +.450_r8*rxt(:,383)*y(:,202) + & + 2.000_r8*rxt(:,384)*y(:,208))*y(:,208) & + + (.500_r8*rxt(:,490)*y(:,196) +.900_r8*rxt(:,492)*y(:,124)) & + *y(:,225) +rxt(:,38)*y(:,51) +.400_r8*rxt(:,61)*y(:,139) +rxt(:,66) & + *y(:,174) +.800_r8*rxt(:,70)*y(:,178) + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,24) =rxt(:,191)*y(:,125)*y(:,112) + prod(:,25) = 0._r8 + prod(:,26) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) =rxt(:,518)*y(:,220)*y(:,120) +rxt(:,528)*y(:,121) + prod(:,30) = (rxt(:,452)*y(:,197) +rxt(:,455)*y(:,207) +rxt(:,458)*y(:,209) + & + rxt(:,462)*y(:,141))*y(:,125) +.500_r8*rxt(:,391)*y(:,220)*y(:,109) & + +.200_r8*rxt(:,487)*y(:,215)*y(:,124) +.500_r8*rxt(:,499)*y(:,177) & + *y(:,126) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,123) = 0._r8 + prod(:,124) = 0._r8 + prod(:,1) = + extfrc(:,13) + prod(:,2) = + extfrc(:,14) + prod(:,153) = 0._r8 + prod(:,48) = 0._r8 + prod(:,84) = 0._r8 + prod(:,49) = 0._r8 + prod(:,85) = 0._r8 + prod(:,95) = 0._r8 + prod(:,70) = 0._r8 + prod(:,118) = 0._r8 + prod(:,76) = 0._r8 + prod(:,62) = 0._r8 + prod(:,82) = 0._r8 + prod(:,184) =rxt(:,80)*y(:,34) +rxt(:,81)*y(:,35) +2.000_r8*rxt(:,87)*y(:,41) & + +rxt(:,88)*y(:,43) +3.000_r8*rxt(:,91)*y(:,55) +2.000_r8*rxt(:,99) & + *y(:,78) + prod(:,63) = 0._r8 + prod(:,198) = 0._r8 + prod(:,110) = 0._r8 + prod(:,64) = 0._r8 + prod(:,79) = 0._r8 + prod(:,71) = 0._r8 + prod(:,112) = 0._r8 + prod(:,66) = 0._r8 + prod(:,80) = 0._r8 + prod(:,72) = 0._r8 + prod(:,160) = 0._r8 + prod(:,89) = 0._r8 + prod(:,39) = 0._r8 + prod(:,67) = 0._r8 + prod(:,193) =.180_r8*rxt(:,41)*y(:,54) + prod(:,170) = 0._r8 + prod(:,38) = 0._r8 + prod(:,156) = 0._r8 + prod(:,175) = 0._r8 + prod(:,111) = 0._r8 + prod(:,105) = 0._r8 + prod(:,140) = 0._r8 + prod(:,90) = 0._r8 + prod(:,188) =4.000_r8*rxt(:,79)*y(:,33) +rxt(:,80)*y(:,34) & + +2.000_r8*rxt(:,82)*y(:,36) +2.000_r8*rxt(:,83)*y(:,37) & + +2.000_r8*rxt(:,84)*y(:,38) +rxt(:,85)*y(:,39) +2.000_r8*rxt(:,86) & + *y(:,40) +3.000_r8*rxt(:,89)*y(:,44) +rxt(:,90)*y(:,46) +rxt(:,101) & + *y(:,82) +rxt(:,102)*y(:,83) +rxt(:,103)*y(:,84) + prod(:,47) = 0._r8 + prod(:,36) = 0._r8 + prod(:,200) = 0._r8 + prod(:,157) = 0._r8 + prod(:,165) = (rxt(:,42) +rxt(:,110))*y(:,63) +.380_r8*rxt(:,41)*y(:,54) & + + extfrc(:,3) + prod(:,40) =rxt(:,80)*y(:,34) +rxt(:,81)*y(:,35) +rxt(:,83)*y(:,37) & + +2.000_r8*rxt(:,84)*y(:,38) +2.000_r8*rxt(:,85)*y(:,39) +rxt(:,86) & + *y(:,40) +2.000_r8*rxt(:,99)*y(:,78) +rxt(:,102)*y(:,83) +rxt(:,103) & + *y(:,84) + prod(:,51) =rxt(:,82)*y(:,36) +rxt(:,83)*y(:,37) +rxt(:,101)*y(:,82) + prod(:,54) = 0._r8 + prod(:,69) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,41) = 0._r8 + prod(:,136) =rxt(:,81)*y(:,35) +rxt(:,85)*y(:,39) + prod(:,161) = 0._r8 + prod(:,149) = 0._r8 + prod(:,195) = (rxt(:,40) +.330_r8*rxt(:,41))*y(:,54) + prod(:,172) =1.440_r8*rxt(:,41)*y(:,54) + prod(:,115) = 0._r8 + prod(:,42) = 0._r8 + prod(:,145) = 0._r8 + prod(:,183) = 0._r8 + prod(:,52) = 0._r8 + prod(:,141) = 0._r8 + prod(:,59) = 0._r8 + prod(:,196) = 0._r8 + prod(:,99) = 0._r8 + prod(:,134) = 0._r8 + prod(:,146) = 0._r8 + prod(:,162) = 0._r8 + prod(:,60) = 0._r8 + prod(:,164) = 0._r8 + prod(:,73) = 0._r8 + prod(:,43) = 0._r8 + prod(:,148) = 0._r8 + prod(:,119) = 0._r8 + prod(:,108) = 0._r8 + prod(:,173) = 0._r8 + prod(:,88) = 0._r8 + prod(:,127) = 0._r8 + prod(:,34) = 0._r8 + prod(:,174) = 0._r8 + prod(:,74) = 0._r8 + prod(:,107) = 0._r8 + prod(:,75) = 0._r8 + prod(:,114) = 0._r8 + prod(:,151) = 0._r8 + prod(:,179) = 0._r8 + prod(:,144) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & + .800_r8*rxt(:,118)) + extfrc(:,21) + prod(:,68) = 0._r8 + prod(:,83) = 0._r8 + prod(:,159) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,37) = 0._r8 + prod(:,9) = 0._r8 + prod(:,187) = + extfrc(:,2) + prod(:,197) = + extfrc(:,1) + prod(:,194) = 0._r8 + prod(:,147) = 0._r8 + prod(:,86) = 0._r8 + prod(:,10) = + extfrc(:,10) + prod(:,11) = + extfrc(:,11) + prod(:,12) = 0._r8 + prod(:,13) = + extfrc(:,12) + prod(:,192) = (rxt(:,42) +rxt(:,110))*y(:,63) +.180_r8*rxt(:,41)*y(:,54) + prod(:,186) = 0._r8 + prod(:,191) = 0._r8 + prod(:,77) = 0._r8 + prod(:,81) = 0._r8 + prod(:,61) = 0._r8 + prod(:,97) = 0._r8 + prod(:,44) = 0._r8 + prod(:,98) = 0._r8 + prod(:,50) = 0._r8 + prod(:,78) = 0._r8 + prod(:,14) = + extfrc(:,8) + prod(:,15) = + extfrc(:,9) + prod(:,109) = 0._r8 + prod(:,87) = 0._r8 + prod(:,129) = 0._r8 + prod(:,182) = 0._r8 + prod(:,155) = + extfrc(:,4) + prod(:,65) = 0._r8 + prod(:,16) = + extfrc(:,6) + prod(:,17) = + extfrc(:,7) + prod(:,18) = 0._r8 + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,24) = 0._r8 + prod(:,25) = 0._r8 + prod(:,26) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,35) = + extfrc(:,5) + prod(:,55) = 0._r8 + prod(:,116) = 0._r8 + prod(:,121) = 0._r8 + prod(:,100) = 0._r8 + prod(:,158) = 0._r8 + prod(:,163) = 0._r8 + prod(:,117) = 0._r8 + prod(:,53) = 0._r8 + prod(:,56) = 0._r8 + prod(:,57) = 0._r8 + prod(:,128) = 0._r8 + prod(:,58) = 0._r8 + prod(:,91) = 0._r8 + prod(:,104) = 0._r8 + prod(:,154) = 0._r8 + prod(:,101) = 0._r8 + prod(:,92) = 0._r8 + prod(:,152) = 0._r8 + prod(:,143) = 0._r8 + prod(:,122) = 0._r8 + prod(:,181) = 0._r8 + prod(:,185) =rxt(:,88)*y(:,43) +rxt(:,90)*y(:,46) +rxt(:,40)*y(:,54) + prod(:,133) = 0._r8 + prod(:,139) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & + rxt(:,119)) + extfrc(:,20) + prod(:,113) = 0._r8 + prod(:,96) = 0._r8 + prod(:,135) = 0._r8 + prod(:,199) = 0._r8 + prod(:,93) = 0._r8 + prod(:,176) = 0._r8 + prod(:,177) = 0._r8 + prod(:,178) = 0._r8 + prod(:,130) = 0._r8 + prod(:,180) = 0._r8 + prod(:,150) = 0._r8 + prod(:,125) = 0._r8 + prod(:,106) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & + 1.200_r8*rxt(:,118)) + extfrc(:,19) + prod(:,126) = (rxt(:,114) +rxt(:,119)) + extfrc(:,18) + prod(:,138) = 0._r8 + prod(:,102) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + extfrc(:,17) + prod(:,168) = 0._r8 + prod(:,189) =rxt(:,12)*y(:,113) + prod(:,45) = 0._r8 + prod(:,46) = 0._r8 + prod(:,137) = + extfrc(:,16) + prod(:,190) =.330_r8*rxt(:,41)*y(:,54) + extfrc(:,22) + prod(:,120) = + extfrc(:,23) + prod(:,94) = 0._r8 + prod(:,142) = 0._r8 + prod(:,169) = 0._r8 + prod(:,167) = 0._r8 + prod(:,166) = 0._r8 + prod(:,131) = 0._r8 + prod(:,171) = 0._r8 + prod(:,132) = 0._r8 + prod(:,103) = 0._r8 + prod(:,201) =.050_r8*rxt(:,41)*y(:,54) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..36378089c7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 @@ -0,0 +1,653 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,536) = -( rxt(k,20) + het_rates(k,1) ) + mat(k,547) = -( rxt(k,21) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,4) ) + mat(k,2) = -( het_rates(k,5) ) + mat(k,858) = -( het_rates(k,6) ) + mat(k,86) = -( het_rates(k,7) ) + mat(k,273) = -( rxt(k,22) + het_rates(k,8) ) + mat(k,92) = -( rxt(k,23) + het_rates(k,9) ) + mat(k,279) = -( rxt(k,24) + het_rates(k,10) ) + mat(k,342) = -( rxt(k,25) + het_rates(k,11) ) + mat(k,274) = .500_r8*rxt(k,22) + mat(k,93) = rxt(k,23) + mat(k,491) = .200_r8*rxt(k,71) + mat(k,587) = .060_r8*rxt(k,73) + mat(k,197) = -( rxt(k,26) + het_rates(k,12) ) + mat(k,490) = .200_r8*rxt(k,71) + mat(k,585) = .200_r8*rxt(k,73) + mat(k,501) = -( rxt(k,27) + het_rates(k,13) ) + mat(k,156) = rxt(k,47) + mat(k,924) = rxt(k,57) + mat(k,493) = .200_r8*rxt(k,71) + mat(k,588) = .150_r8*rxt(k,73) + mat(k,225) = -( rxt(k,28) + het_rates(k,14) ) + mat(k,586) = .210_r8*rxt(k,73) + mat(k,163) = -( het_rates(k,15) ) + mat(k,259) = -( het_rates(k,16) ) + mat(k,1352) = -( het_rates(k,17) ) + mat(k,167) = rxt(k,75) + mat(k,2006) = rxt(k,76) + mat(k,440) = rxt(k,78) + mat(k,754) = rxt(k,100) + mat(k,656) = rxt(k,106) + mat(k,1565) = rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) & + + 3.000_r8*rxt(k,267)*y(k,55) + 2.000_r8*rxt(k,268)*y(k,78) & + + 2.000_r8*rxt(k,289)*y(k,41) + rxt(k,290)*y(k,43) + mat(k,1539) = 2.000_r8*rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & + + 3.000_r8*rxt(k,284)*y(k,55) + mat(k,1713) = 2.000_r8*rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) & + + 3.000_r8*rxt(k,285)*y(k,55) + mat(k,166) = -( rxt(k,75) + het_rates(k,18) ) + mat(k,2019) = -( rxt(k,76) + het_rates(k,19) ) + mat(k,445) = rxt(k,77) + mat(k,438) = -( rxt(k,77) + rxt(k,78) + rxt(k,550) + rxt(k,553) + rxt(k,558) & + + het_rates(k,20) ) + mat(k,169) = -( het_rates(k,22) ) + mat(k,240) = rxt(k,29) + mat(k,241) = -( rxt(k,29) + het_rates(k,23) ) + mat(k,200) = -( het_rates(k,24) ) + mat(k,450) = -( het_rates(k,25) ) + mat(k,177) = -( het_rates(k,26) ) + mat(k,246) = -( rxt(k,30) + het_rates(k,27) ) + mat(k,206) = -( het_rates(k,28) ) + mat(k,943) = -( het_rates(k,29) ) + mat(k,1245) = .700_r8*rxt(k,56) + mat(k,303) = -( rxt(k,31) + het_rates(k,30) ) + mat(k,55) = -( het_rates(k,31) ) + mat(k,181) = -( rxt(k,32) + het_rates(k,32) ) + mat(k,1849) = -( rxt(k,33) + rxt(k,34) + het_rates(k,42) ) + mat(k,543) = .100_r8*rxt(k,20) + mat(k,555) = .100_r8*rxt(k,21) + mat(k,312) = rxt(k,39) + mat(k,963) = rxt(k,44) + mat(k,976) = .330_r8*rxt(k,46) + mat(k,995) = rxt(k,48) + mat(k,583) = .690_r8*rxt(k,50) + mat(k,1147) = 1.340_r8*rxt(k,51) + mat(k,773) = rxt(k,58) + mat(k,435) = rxt(k,63) + mat(k,295) = rxt(k,64) + mat(k,488) = .375_r8*rxt(k,66) + mat(k,373) = .400_r8*rxt(k,68) + mat(k,988) = .680_r8*rxt(k,70) + mat(k,332) = rxt(k,309) + mat(k,348) = 2.000_r8*rxt(k,339) + mat(k,1574) = rxt(k,312)*y(k,54) + rxt(k,313)*y(k,54) + mat(k,1076) = -( rxt(k,35) + het_rates(k,45) ) + mat(k,540) = .400_r8*rxt(k,20) + mat(k,552) = .400_r8*rxt(k,21) + mat(k,248) = rxt(k,30) + mat(k,972) = .330_r8*rxt(k,46) + mat(k,222) = rxt(k,54) + mat(k,433) = rxt(k,63) + mat(k,52) = -( het_rates(k,47) ) + mat(k,898) = -( rxt(k,36) + het_rates(k,48) ) + mat(k,539) = .250_r8*rxt(k,20) + mat(k,551) = .250_r8*rxt(k,21) + mat(k,305) = .820_r8*rxt(k,31) + mat(k,966) = .170_r8*rxt(k,46) + mat(k,482) = .300_r8*rxt(k,66) + mat(k,369) = .050_r8*rxt(k,68) + mat(k,981) = .500_r8*rxt(k,70) + mat(k,1152) = -( rxt(k,37) + het_rates(k,49) ) + mat(k,282) = .180_r8*rxt(k,24) + mat(k,227) = rxt(k,28) + mat(k,498) = .400_r8*rxt(k,71) + mat(k,596) = .540_r8*rxt(k,73) + mat(k,318) = .510_r8*rxt(k,74) + mat(k,446) = -( het_rates(k,50) ) + mat(k,406) = -( rxt(k,38) + het_rates(k,51) ) + mat(k,708) = -( het_rates(k,52) ) + mat(k,309) = -( rxt(k,39) + het_rates(k,53) ) + mat(k,1543) = -( rxt(k,215)*y(k,54) + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & + + rxt(k,282)*y(k,46) + rxt(k,284)*y(k,55) + het_rates(k,56) ) + mat(k,168) = rxt(k,75) + mat(k,80) = 2.000_r8*rxt(k,92) + mat(k,47) = 2.000_r8*rxt(k,93) + mat(k,2131) = rxt(k,94) + mat(k,908) = rxt(k,95) + mat(k,103) = rxt(k,98) + mat(k,1339) = rxt(k,104) + mat(k,764) = rxt(k,107) + mat(k,1569) = 4.000_r8*rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) & + + 2.000_r8*rxt(k,241)*y(k,36) + 2.000_r8*rxt(k,242)*y(k,37) & + + 2.000_r8*rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & + + 2.000_r8*rxt(k,245)*y(k,40) + rxt(k,291)*y(k,82) & + + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) + mat(k,1717) = 3.000_r8*rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) & + + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + mat(k,79) = -( rxt(k,92) + het_rates(k,57) ) + mat(k,46) = -( rxt(k,93) + rxt(k,249) + het_rates(k,58) ) + mat(k,2143) = -( rxt(k,94) + het_rates(k,59) ) + mat(k,914) = rxt(k,96) + mat(k,234) = rxt(k,108) + mat(k,48) = 2.000_r8*rxt(k,249) + mat(k,906) = -( rxt(k,95) + rxt(k,96) + rxt(k,552) + rxt(k,557) + rxt(k,563) & + + het_rates(k,60) ) + mat(k,997) = -( het_rates(k,62) ) + mat(k,94) = 1.500_r8*rxt(k,23) + mat(k,281) = .450_r8*rxt(k,24) + mat(k,503) = .600_r8*rxt(k,27) + mat(k,226) = rxt(k,28) + mat(k,1837) = rxt(k,33) + rxt(k,34) + mat(k,1075) = rxt(k,35) + mat(k,1151) = rxt(k,37) + mat(k,961) = rxt(k,44) + mat(k,799) = 2.000_r8*rxt(k,45) + mat(k,970) = .330_r8*rxt(k,46) + mat(k,1139) = 1.340_r8*rxt(k,52) + mat(k,1247) = .700_r8*rxt(k,56) + mat(k,127) = 1.500_r8*rxt(k,65) + mat(k,485) = .250_r8*rxt(k,66) + mat(k,918) = rxt(k,69) + mat(k,983) = 1.700_r8*rxt(k,70) + mat(k,254) = rxt(k,137) + mat(k,1534) = rxt(k,282)*y(k,46) + mat(k,518) = rxt(k,577)*y(k,63) + mat(k,59) = -( rxt(k,97) + het_rates(k,64) ) + mat(k,1557) = rxt(k,240)*y(k,34) + rxt(k,242)*y(k,37) & + + 2.000_r8*rxt(k,243)*y(k,38) + 2.000_r8*rxt(k,244)*y(k,39) & + + rxt(k,245)*y(k,40) + rxt(k,266)*y(k,35) & + + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,292)*y(k,83) & + + rxt(k,293)*y(k,84) + mat(k,1593) = rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + mat(k,101) = -( rxt(k,98) + het_rates(k,65) ) + mat(k,1559) = rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) + rxt(k,291)*y(k,82) + mat(k,1598) = rxt(k,286)*y(k,82) + mat(k,121) = -( het_rates(k,66) ) + mat(k,191) = -( het_rates(k,67) ) + mat(k,3) = -( het_rates(k,68) ) + mat(k,4) = -( het_rates(k,69) ) + mat(k,5) = -( het_rates(k,70) ) + mat(k,62) = -( rxt(k,43) + het_rates(k,72) ) + mat(k,673) = -( rxt(k,271)*y(k,54) + het_rates(k,73) ) + mat(k,60) = 2.000_r8*rxt(k,97) + mat(k,102) = rxt(k,98) + mat(k,153) = rxt(k,105) + mat(k,1561) = rxt(k,244)*y(k,39) + rxt(k,266)*y(k,35) + mat(k,960) = -( rxt(k,44) + het_rates(k,74) ) + mat(k,967) = .330_r8*rxt(k,46) + mat(k,483) = .250_r8*rxt(k,66) + mat(k,798) = -( rxt(k,45) + rxt(k,520) + het_rates(k,75) ) + mat(k,276) = rxt(k,22) + mat(k,280) = .130_r8*rxt(k,24) + mat(k,237) = .700_r8*rxt(k,62) + mat(k,497) = .600_r8*rxt(k,71) + mat(k,593) = .340_r8*rxt(k,73) + mat(k,317) = .170_r8*rxt(k,74) + mat(k,1928) = -( het_rates(k,76) ) + mat(k,2164) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,1851) = 2.000_r8*rxt(k,33) + mat(k,313) = rxt(k,39) + mat(k,758) = rxt(k,100) + mat(k,1344) = rxt(k,104) + mat(k,154) = rxt(k,105) + mat(k,1576) = rxt(k,312)*y(k,54) + mat(k,1104) = -( het_rates(k,77) ) + mat(k,2150) = rxt(k,1) + mat(k,1838) = rxt(k,34) + mat(k,1563) = rxt(k,313)*y(k,54) + mat(k,474) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,2052) = .500_r8*rxt(k,521) + mat(k,65) = -( rxt(k,136) + het_rates(k,80) ) + mat(k,753) = -( rxt(k,100) + het_rates(k,81) ) + mat(k,1337) = -( rxt(k,104) + het_rates(k,85) ) + mat(k,1538) = rxt(k,215)*y(k,54) + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & + + 2.000_r8*rxt(k,282)*y(k,46) + rxt(k,284)*y(k,55) + mat(k,105) = -( het_rates(k,86) ) + mat(k,712) = -( het_rates(k,87) ) + mat(k,152) = -( rxt(k,105) + het_rates(k,88) ) + mat(k,672) = rxt(k,271)*y(k,54) + mat(k,1951) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,977) = rxt(k,522) + mat(k,511) = rxt(k,523) + mat(k,428) = rxt(k,524) + mat(k,189) = 2.000_r8*rxt(k,525) + 2.000_r8*rxt(k,548) + 2.000_r8*rxt(k,551) & + + 2.000_r8*rxt(k,562) + mat(k,271) = rxt(k,526) + mat(k,936) = rxt(k,527) + mat(k,1993) = .500_r8*rxt(k,529) + mat(k,1909) = rxt(k,530) + mat(k,289) = rxt(k,531) + mat(k,161) = rxt(k,532) + mat(k,524) = rxt(k,533) + mat(k,443) = rxt(k,550) + rxt(k,553) + rxt(k,558) + mat(k,912) = rxt(k,552) + rxt(k,557) + rxt(k,563) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,361) = -( rxt(k,10) + rxt(k,11) + rxt(k,212) + het_rates(k,90) ) + mat(k,654) = -( rxt(k,106) + het_rates(k,91) ) + mat(k,439) = rxt(k,550) + rxt(k,553) + rxt(k,558) + mat(k,762) = -( rxt(k,107) + het_rates(k,92) ) + mat(k,905) = rxt(k,552) + rxt(k,557) + rxt(k,563) + mat(k,968) = -( rxt(k,46) + rxt(k,522) + het_rates(k,93) ) + mat(k,155) = -( rxt(k,47) + het_rates(k,94) ) + mat(k,1188) = rxt(k,413) + mat(k,991) = -( rxt(k,48) + het_rates(k,95) ) + mat(k,969) = .170_r8*rxt(k,46) + mat(k,212) = -( het_rates(k,96) ) + mat(k,68) = -( het_rates(k,97) ) + mat(k,781) = -( het_rates(k,98) ) + mat(k,505) = -( rxt(k,523) + het_rates(k,99) ) + mat(k,422) = -( rxt(k,524) + het_rates(k,100) ) + mat(k,1124) = -( het_rates(k,101) ) + mat(k,297) = -( rxt(k,49) + het_rates(k,102) ) + mat(k,578) = -( rxt(k,50) + het_rates(k,103) ) + mat(k,298) = rxt(k,49) + mat(k,39) = -( het_rates(k,104) ) + mat(k,1140) = -( rxt(k,51) + rxt(k,52) + het_rates(k,105) ) + mat(k,580) = .288_r8*rxt(k,50) + mat(k,215) = -( het_rates(k,106) ) + mat(k,417) = -( rxt(k,53) + het_rates(k,107) ) + mat(k,535) = .800_r8*rxt(k,20) + mat(k,546) = .800_r8*rxt(k,21) + mat(k,220) = -( rxt(k,54) + het_rates(k,108) ) + mat(k,466) = -( rxt(k,55) + rxt(k,395) + het_rates(k,109) ) + mat(k,820) = -( het_rates(k,110) ) + mat(k,1251) = -( rxt(k,56) + het_rates(k,111) ) + mat(k,581) = .402_r8*rxt(k,50) + mat(k,744) = -( rxt(k,111) + het_rates(k,112) ) + mat(k,1475) = rxt(k,15) + mat(k,517) = rxt(k,578) + mat(k,185) = -( rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,548) & + + rxt(k,551) + rxt(k,562) + het_rates(k,114) ) + mat(k,267) = -( rxt(k,526) + het_rates(k,115) ) + mat(k,928) = -( rxt(k,57) + rxt(k,527) + het_rates(k,116) ) + mat(k,6) = -( het_rates(k,117) ) + mat(k,7) = -( het_rates(k,118) ) + mat(k,8) = -( het_rates(k,119) ) + mat(k,49) = -( het_rates(k,120) ) + mat(k,9) = -( rxt(k,528) + het_rates(k,121) ) + mat(k,1507) = -( rxt(k,15) + rxt(k,16) + het_rates(k,124) ) + mat(k,186) = rxt(k,14) + mat(k,1984) = rxt(k,17) + .500_r8*rxt(k,529) + mat(k,1900) = rxt(k,19) + mat(k,686) = rxt(k,575) + mat(k,1568) = 2.000_r8*rxt(k,206)*y(k,113) + mat(k,1994) = -( rxt(k,17) + rxt(k,529) + het_rates(k,125) ) + mat(k,1952) = rxt(k,9) + mat(k,365) = rxt(k,11) + rxt(k,212) + mat(k,190) = rxt(k,13) + rxt(k,213) + mat(k,1910) = rxt(k,18) + mat(k,544) = rxt(k,20) + mat(k,978) = rxt(k,46) + mat(k,301) = rxt(k,49) + mat(k,472) = rxt(k,55) + rxt(k,395) + mat(k,937) = rxt(k,57) + mat(k,774) = rxt(k,58) + mat(k,290) = rxt(k,59) + mat(k,162) = rxt(k,60) + mat(k,356) = .600_r8*rxt(k,61) + rxt(k,346) + mat(k,525) = rxt(k,67) + mat(k,444) = rxt(k,77) + mat(k,913) = rxt(k,96) + mat(k,73) = rxt(k,470) + mat(k,1907) = -( rxt(k,18) + rxt(k,19) + rxt(k,530) + het_rates(k,126) ) + mat(k,364) = rxt(k,10) + mat(k,188) = rxt(k,13) + rxt(k,14) + rxt(k,213) + mat(k,355) = .400_r8*rxt(k,61) + mat(k,442) = rxt(k,78) + mat(k,911) = rxt(k,95) + mat(k,769) = -( rxt(k,58) + het_rates(k,127) ) + mat(k,285) = -( rxt(k,59) + rxt(k,531) + het_rates(k,128) ) + mat(k,10) = -( het_rates(k,129) ) + mat(k,11) = -( het_rates(k,130) ) + mat(k,12) = -( het_rates(k,131) ) + mat(k,13) = -( het_rates(k,132) ) + mat(k,1824) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + het_rates(k,133) ) + mat(k,2161) = rxt(k,2) + mat(k,1433) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + 2.000_r8*rxt(k,134) & + + 2.000_r8*rxt(k,135) + mat(k,1783) = rxt(k,8) + mat(k,187) = rxt(k,14) + mat(k,1512) = rxt(k,15) + mat(k,1989) = rxt(k,17) + mat(k,1905) = rxt(k,18) + mat(k,2013) = rxt(k,76) + mat(k,2135) = rxt(k,94) + mat(k,233) = rxt(k,108) + mat(k,1325) = rxt(k,138) + mat(k,895) = rxt(k,139) + mat(k,175) = rxt(k,140) + mat(k,1573) = rxt(k,155) + mat(k,1427) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + + rxt(k,129) + rxt(k,130) + rxt(k,131) + rxt(k,132) + rxt(k,133) & + + rxt(k,134) + rxt(k,135) + het_rates(k,134) ) + mat(k,1777) = rxt(k,8) + mat(k,1899) = rxt(k,19) + mat(k,75) = rxt(k,151) + rxt(k,159) + mat(k,78) = rxt(k,152) + mat(k,1567) = rxt(k,207)*y(k,113) + mat(k,1782) = -( rxt(k,7) + rxt(k,8) + het_rates(k,135) ) + mat(k,230) = -( rxt(k,108) + het_rates(k,136) ) + mat(k,251) = -( rxt(k,137) + het_rates(k,137) ) + mat(k,160) = -( rxt(k,60) + rxt(k,532) + het_rates(k,138) ) + mat(k,350) = -( rxt(k,61) + rxt(k,346) + het_rates(k,139) ) + mat(k,71) = -( rxt(k,470) + het_rates(k,140) ) + mat(k,357) = -( het_rates(k,141) ) + mat(k,182) = rxt(k,32) + mat(k,96) = -( het_rates(k,142) ) + mat(k,235) = -( rxt(k,62) + het_rates(k,143) ) + mat(k,14) = -( het_rates(k,144) ) + mat(k,15) = -( het_rates(k,145) ) + mat(k,430) = -( rxt(k,63) + het_rates(k,146) ) + mat(k,291) = -( rxt(k,64) + het_rates(k,147) ) + mat(k,600) = -( het_rates(k,148) ) + mat(k,252) = rxt(k,137) + mat(k,1316) = rxt(k,138) + mat(k,1318) = -( rxt(k,138) + het_rates(k,150) ) + mat(k,893) = rxt(k,139) + mat(k,892) = -( rxt(k,139) + het_rates(k,151) ) + mat(k,174) = rxt(k,140) + mat(k,173) = -( rxt(k,140) + het_rates(k,152) ) + mat(k,66) = rxt(k,136) + mat(k,16) = -( het_rates(k,153) ) + mat(k,17) = -( het_rates(k,154) ) + mat(k,18) = -( het_rates(k,155) ) + mat(k,19) = -( rxt(k,141) + het_rates(k,156) ) + mat(k,20) = -( rxt(k,142) + het_rates(k,157) ) + mat(k,21) = -( rxt(k,143) + het_rates(k,158) ) + mat(k,22) = -( rxt(k,144) + het_rates(k,159) ) + mat(k,23) = -( rxt(k,145) + het_rates(k,160) ) + mat(k,24) = -( rxt(k,146) + het_rates(k,161) ) + mat(k,25) = -( rxt(k,147) + het_rates(k,162) ) + mat(k,26) = -( rxt(k,148) + het_rates(k,163) ) + mat(k,27) = -( rxt(k,149) + het_rates(k,164) ) + mat(k,28) = -( rxt(k,150) + het_rates(k,165) ) + mat(k,29) = -( het_rates(k,166) ) + mat(k,797) = rxt(k,520) + mat(k,30) = -( het_rates(k,167) ) + mat(k,31) = -( het_rates(k,168) ) + mat(k,32) = -( het_rates(k,169) ) + mat(k,33) = -( het_rates(k,170) ) + mat(k,45) = -( het_rates(k,172) ) + mat(k,126) = -( rxt(k,65) + het_rates(k,173) ) + mat(k,481) = -( rxt(k,66) + het_rates(k,174) ) + mat(k,521) = -( rxt(k,67) + rxt(k,533) + het_rates(k,175) ) + mat(k,368) = -( rxt(k,68) + het_rates(k,176) ) + mat(k,916) = -( rxt(k,69) + het_rates(k,177) ) + mat(k,286) = rxt(k,59) + mat(k,522) = rxt(k,67) + mat(k,370) = rxt(k,68) + mat(k,982) = -( rxt(k,70) + het_rates(k,178) ) + mat(k,484) = rxt(k,66) + mat(k,917) = rxt(k,69) + mat(k,492) = -( rxt(k,71) + het_rates(k,179) ) + mat(k,114) = -( het_rates(k,180) ) + mat(k,130) = -( rxt(k,72) + het_rates(k,181) ) + mat(k,139) = -( het_rates(k,182) ) + mat(k,589) = -( rxt(k,73) + het_rates(k,183) ) + mat(k,147) = -( het_rates(k,184) ) + mat(k,315) = -( rxt(k,74) + het_rates(k,185) ) + mat(k,400) = -( het_rates(k,188) ) + mat(k,72) = rxt(k,470) + mat(k,880) = -( het_rates(k,189) ) + mat(k,377) = -( het_rates(k,190) ) + mat(k,323) = -( het_rates(k,191) ) + mat(k,840) = -( het_rates(k,192) ) + mat(k,419) = rxt(k,53) + mat(k,728) = -( het_rates(k,193) ) + mat(k,529) = -( het_rates(k,194) ) + mat(k,1302) = -( het_rates(k,195) ) + mat(k,283) = .130_r8*rxt(k,24) + mat(k,228) = rxt(k,28) + mat(k,900) = rxt(k,36) + mat(k,1153) = rxt(k,37) + mat(k,973) = .330_r8*rxt(k,46) + mat(k,993) = rxt(k,48) + mat(k,1144) = 1.340_r8*rxt(k,51) + mat(k,420) = rxt(k,53) + mat(k,223) = rxt(k,54) + mat(k,1253) = .300_r8*rxt(k,56) + mat(k,771) = rxt(k,58) + mat(k,351) = .600_r8*rxt(k,61) + rxt(k,346) + mat(k,293) = rxt(k,64) + mat(k,128) = .500_r8*rxt(k,65) + mat(k,985) = .650_r8*rxt(k,70) + mat(k,1396) = -( het_rates(k,196) ) + mat(k,1078) = rxt(k,35) + mat(k,901) = rxt(k,36) + mat(k,408) = rxt(k,38) + mat(k,1254) = .300_r8*rxt(k,56) + mat(k,352) = .400_r8*rxt(k,61) + mat(k,1540) = rxt(k,215)*y(k,54) + mat(k,675) = rxt(k,271)*y(k,54) + mat(k,1714) = rxt(k,304)*y(k,54) + mat(k,1566) = rxt(k,311)*y(k,54) + end do + end subroutine linmat02 + subroutine linmat03( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,645) = -( het_rates(k,197) ) + mat(k,198) = .600_r8*rxt(k,26) + mat(k,701) = -( het_rates(k,198) ) + mat(k,1471) = rxt(k,16) + mat(k,743) = rxt(k,111) + mat(k,1806) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1420) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + mat(k,458) = -( het_rates(k,199) ) + mat(k,345) = -( rxt(k,339) + het_rates(k,200) ) + mat(k,63) = rxt(k,43) + mat(k,664) = -( het_rates(k,201) ) + mat(k,2115) = -( rxt(k,521) + het_rates(k,202) ) + mat(k,366) = rxt(k,11) + rxt(k,212) + mat(k,545) = rxt(k,20) + mat(k,556) = .900_r8*rxt(k,21) + mat(k,278) = rxt(k,22) + mat(k,95) = 1.500_r8*rxt(k,23) + mat(k,284) = .560_r8*rxt(k,24) + mat(k,344) = rxt(k,25) + mat(k,199) = .600_r8*rxt(k,26) + mat(k,504) = .600_r8*rxt(k,27) + mat(k,229) = rxt(k,28) + mat(k,245) = rxt(k,29) + mat(k,250) = rxt(k,30) + mat(k,307) = rxt(k,31) + mat(k,1083) = rxt(k,35) + mat(k,1158) = rxt(k,37) + mat(k,964) = 2.000_r8*rxt(k,44) + mat(k,801) = 2.000_r8*rxt(k,45) + mat(k,979) = .670_r8*rxt(k,46) + mat(k,159) = rxt(k,47) + mat(k,996) = rxt(k,48) + mat(k,302) = rxt(k,49) + mat(k,584) = rxt(k,50) + mat(k,1149) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) + mat(k,938) = rxt(k,57) + mat(k,239) = rxt(k,62) + mat(k,436) = rxt(k,63) + mat(k,129) = rxt(k,65) + mat(k,489) = rxt(k,66) + mat(k,526) = rxt(k,67) + mat(k,374) = rxt(k,68) + mat(k,923) = rxt(k,69) + mat(k,989) = 1.200_r8*rxt(k,70) + mat(k,500) = rxt(k,71) + mat(k,599) = rxt(k,73) + mat(k,320) = rxt(k,74) + mat(k,334) = rxt(k,309) + mat(k,349) = rxt(k,339) + mat(k,1220) = rxt(k,413) + mat(k,1554) = rxt(k,279)*y(k,43) + rxt(k,282)*y(k,46) + mat(k,1728) = rxt(k,280)*y(k,43) + rxt(k,283)*y(k,46) + mat(k,1580) = rxt(k,312)*y(k,54) + mat(k,329) = -( rxt(k,309) + het_rates(k,203) ) + mat(k,1172) = -( het_rates(k,204) ) + mat(k,1206) = -( rxt(k,413) + het_rates(k,205) ) + mat(k,1231) = -( het_rates(k,206) ) + mat(k,607) = -( het_rates(k,207) ) + mat(k,343) = .600_r8*rxt(k,25) + mat(k,1271) = -( het_rates(k,208) ) + mat(k,1143) = .660_r8*rxt(k,51) + mat(k,468) = rxt(k,55) + rxt(k,395) + mat(k,803) = -( het_rates(k,209) ) + mat(k,502) = .600_r8*rxt(k,27) + mat(k,558) = -( het_rates(k,210) ) + mat(k,412) = -( het_rates(k,211) ) + mat(k,567) = -( het_rates(k,212) ) + mat(k,690) = -( het_rates(k,213) ) + mat(k,1470) = rxt(k,16) + mat(k,682) = rxt(k,575) + mat(k,516) = rxt(k,578) + mat(k,384) = -( het_rates(k,214) ) + mat(k,739) = rxt(k,111) + mat(k,1049) = -( het_rates(k,215) ) + mat(k,1570) = -( rxt(k,155) + rxt(k,206)*y(k,113) + rxt(k,207)*y(k,113) & + + rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) + rxt(k,241)*y(k,36) & + + rxt(k,242)*y(k,37) + rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & + + rxt(k,245)*y(k,40) + rxt(k,266)*y(k,35) + rxt(k,267)*y(k,55) & + + rxt(k,268)*y(k,78) + rxt(k,289)*y(k,41) + rxt(k,290)*y(k,43) & + + rxt(k,291)*y(k,82) + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) & + + rxt(k,311)*y(k,54) + rxt(k,312)*y(k,54) + rxt(k,313)*y(k,54) & + + het_rates(k,216) ) + mat(k,2158) = rxt(k,1) + mat(k,1430) = rxt(k,6) + mat(k,1780) = rxt(k,7) + mat(k,74) = -( rxt(k,151) + rxt(k,159) + het_rates(k,217) ) + mat(k,1736) = rxt(k,7) + mat(k,76) = rxt(k,163) + rxt(k,162)*y(k,63) + mat(k,77) = -( rxt(k,152) + rxt(k,163) + rxt(k,162)*y(k,63) + het_rates(k,218) ) + mat(k,681) = -( rxt(k,575) + het_rates(k,219) ) + mat(k,1418) = rxt(k,126) + rxt(k,130) + mat(k,515) = rxt(k,577)*y(k,63) + mat(k,1719) = -( rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) + rxt(k,281)*y(k,44) & + + rxt(k,283)*y(k,46) + rxt(k,285)*y(k,55) + rxt(k,286)*y(k,82) & + + rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + rxt(k,304)*y(k,54) & + + het_rates(k,220) ) + mat(k,2159) = rxt(k,3) + mat(k,477) = 2.000_r8*rxt(k,4) + mat(k,1945) = rxt(k,9) + mat(k,363) = rxt(k,10) + mat(k,554) = rxt(k,21) + mat(k,277) = rxt(k,22) + mat(k,244) = rxt(k,29) + mat(k,249) = rxt(k,30) + mat(k,306) = rxt(k,31) + mat(k,184) = rxt(k,32) + mat(k,409) = rxt(k,38) + mat(k,311) = rxt(k,39) + mat(k,64) = rxt(k,43) + mat(k,158) = rxt(k,47) + mat(k,224) = rxt(k,54) + mat(k,288) = rxt(k,59) + mat(k,238) = rxt(k,62) + mat(k,434) = rxt(k,63) + mat(k,294) = rxt(k,64) + mat(k,487) = rxt(k,66) + mat(k,372) = rxt(k,68) + mat(k,499) = rxt(k,71) + mat(k,132) = rxt(k,72) + mat(k,598) = rxt(k,73) + mat(k,319) = rxt(k,74) + mat(k,658) = rxt(k,106) + mat(k,765) = rxt(k,107) + mat(k,1987) = .500_r8*rxt(k,529) + mat(k,1571) = rxt(k,311)*y(k,54) + mat(k,514) = -( rxt(k,578) + rxt(k,577)*y(k,63) + het_rates(k,221) ) + mat(k,1800) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1415) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + + rxt(k,133) + mat(k,336) = -( het_rates(k,222) ) + mat(k,717) = -( het_rates(k,223) ) + mat(k,1065) = -( het_rates(k,224) ) + mat(k,984) = .150_r8*rxt(k,70) + mat(k,1030) = -( het_rates(k,225) ) + mat(k,1008) = -( het_rates(k,226) ) + mat(k,618) = -( het_rates(k,227) ) + mat(k,1091) = -( het_rates(k,228) ) + mat(k,634) = -( het_rates(k,229) ) + mat(k,392) = -( het_rates(k,230) ) + mat(k,2170) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,231) ) + mat(k,67) = rxt(k,136) + mat(k,1730) = rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) + rxt(k,281)*y(k,44) & + + rxt(k,283)*y(k,46) + rxt(k,288)*y(k,84) + rxt(k,304)*y(k,54) + end do + end subroutine linmat03 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..94c56c85ac --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 @@ -0,0 +1,7992 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = 1._r8 / lu(k,3) + lu(k,4) = 1._r8 / lu(k,4) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = 1._r8 / lu(k,6) + lu(k,7) = 1._r8 / lu(k,7) + lu(k,8) = 1._r8 / lu(k,8) + lu(k,9) = 1._r8 / lu(k,9) + lu(k,10) = 1._r8 / lu(k,10) + lu(k,11) = 1._r8 / lu(k,11) + lu(k,12) = 1._r8 / lu(k,12) + lu(k,13) = 1._r8 / lu(k,13) + lu(k,14) = 1._r8 / lu(k,14) + lu(k,15) = 1._r8 / lu(k,15) + lu(k,16) = 1._r8 / lu(k,16) + lu(k,17) = 1._r8 / lu(k,17) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,19) = 1._r8 / lu(k,19) + lu(k,20) = 1._r8 / lu(k,20) + lu(k,21) = 1._r8 / lu(k,21) + lu(k,22) = 1._r8 / lu(k,22) + lu(k,23) = 1._r8 / lu(k,23) + lu(k,24) = 1._r8 / lu(k,24) + lu(k,25) = 1._r8 / lu(k,25) + lu(k,26) = 1._r8 / lu(k,26) + lu(k,27) = 1._r8 / lu(k,27) + lu(k,28) = 1._r8 / lu(k,28) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = 1._r8 / lu(k,30) + lu(k,31) = 1._r8 / lu(k,31) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = 1._r8 / lu(k,33) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = lu(k,47) * lu(k,46) + lu(k,48) = lu(k,48) * lu(k,46) + lu(k,2131) = lu(k,2131) - lu(k,47) * lu(k,2118) + lu(k,2143) = lu(k,2143) - lu(k,48) * lu(k,2118) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,50) = lu(k,50) * lu(k,49) + lu(k,51) = lu(k,51) * lu(k,49) + lu(k,1719) = lu(k,1719) - lu(k,50) * lu(k,1590) + lu(k,1730) = lu(k,1730) - lu(k,51) * lu(k,1590) + lu(k,52) = 1._r8 / lu(k,52) + lu(k,53) = lu(k,53) * lu(k,52) + lu(k,54) = lu(k,54) * lu(k,52) + lu(k,1719) = lu(k,1719) - lu(k,53) * lu(k,1591) + lu(k,1728) = lu(k,1728) - lu(k,54) * lu(k,1591) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = lu(k,56) * lu(k,55) + lu(k,57) = lu(k,57) * lu(k,55) + lu(k,58) = lu(k,58) * lu(k,55) + lu(k,1672) = lu(k,1672) - lu(k,56) * lu(k,1592) + lu(k,1719) = lu(k,1719) - lu(k,57) * lu(k,1592) + lu(k,1730) = lu(k,1730) - lu(k,58) * lu(k,1592) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = lu(k,60) * lu(k,59) + lu(k,61) = lu(k,61) * lu(k,59) + lu(k,1561) = lu(k,1561) - lu(k,60) * lu(k,1557) + lu(k,1570) = lu(k,1570) - lu(k,61) * lu(k,1557) + lu(k,1668) = - lu(k,60) * lu(k,1593) + lu(k,1718) = - lu(k,61) * lu(k,1593) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,62) = 1._r8 / lu(k,62) + lu(k,63) = lu(k,63) * lu(k,62) + lu(k,64) = lu(k,64) * lu(k,62) + lu(k,663) = lu(k,663) - lu(k,63) * lu(k,662) + lu(k,668) = - lu(k,64) * lu(k,662) + lu(k,2042) = - lu(k,63) * lu(k,2023) + lu(k,2106) = lu(k,2106) - lu(k,64) * lu(k,2023) + lu(k,65) = 1._r8 / lu(k,65) + lu(k,66) = lu(k,66) * lu(k,65) + lu(k,67) = lu(k,67) * lu(k,65) + lu(k,173) = lu(k,173) - lu(k,66) * lu(k,172) + lu(k,176) = lu(k,176) - lu(k,67) * lu(k,172) + lu(k,2147) = lu(k,2147) - lu(k,66) * lu(k,2145) + lu(k,2170) = lu(k,2170) - lu(k,67) * lu(k,2145) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,69) = lu(k,69) * lu(k,68) + lu(k,70) = lu(k,70) * lu(k,68) + lu(k,579) = lu(k,579) - lu(k,69) * lu(k,577) + lu(k,582) = lu(k,582) - lu(k,70) * lu(k,577) + lu(k,1700) = lu(k,1700) - lu(k,69) * lu(k,1594) + lu(k,1719) = lu(k,1719) - lu(k,70) * lu(k,1594) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,72) = lu(k,72) * lu(k,71) + lu(k,73) = lu(k,73) * lu(k,71) + lu(k,400) = lu(k,400) - lu(k,72) * lu(k,399) + lu(k,404) = lu(k,404) - lu(k,73) * lu(k,399) + lu(k,1962) = lu(k,1962) - lu(k,72) * lu(k,1957) + lu(k,1994) = lu(k,1994) - lu(k,73) * lu(k,1957) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,75) = lu(k,75) * lu(k,74) + lu(k,78) = lu(k,78) - lu(k,75) * lu(k,76) + lu(k,1427) = lu(k,1427) - lu(k,75) * lu(k,1410) + lu(k,1777) = lu(k,1777) - lu(k,75) * lu(k,1736) + lu(k,1818) = lu(k,1818) - lu(k,75) * lu(k,1793) + lu(k,77) = 1._r8 / lu(k,77) + lu(k,78) = lu(k,78) * lu(k,77) + lu(k,1427) = lu(k,1427) - lu(k,78) * lu(k,1411) + lu(k,1567) = lu(k,1567) - lu(k,78) * lu(k,1558) + lu(k,1777) = lu(k,1777) - lu(k,78) * lu(k,1737) + lu(k,1818) = lu(k,1818) - lu(k,78) * lu(k,1794) + lu(k,79) = 1._r8 / lu(k,79) + lu(k,80) = lu(k,80) * lu(k,79) + lu(k,764) = lu(k,764) - lu(k,80) * lu(k,761) + lu(k,908) = lu(k,908) - lu(k,80) * lu(k,904) + lu(k,1339) = lu(k,1339) - lu(k,80) * lu(k,1332) + lu(k,1543) = lu(k,1543) - lu(k,80) * lu(k,1522) + lu(k,2131) = lu(k,2131) - lu(k,80) * lu(k,2119) + lu(k,86) = 1._r8 / lu(k,86) + lu(k,87) = lu(k,87) * lu(k,86) + lu(k,88) = lu(k,88) * lu(k,86) + lu(k,89) = lu(k,89) * lu(k,86) + lu(k,90) = lu(k,90) * lu(k,86) + lu(k,91) = lu(k,91) * lu(k,86) + lu(k,1596) = lu(k,1596) - lu(k,87) * lu(k,1595) + lu(k,1597) = lu(k,1597) - lu(k,88) * lu(k,1595) + lu(k,1639) = lu(k,1639) - lu(k,89) * lu(k,1595) + lu(k,1719) = lu(k,1719) - lu(k,90) * lu(k,1595) + lu(k,1728) = lu(k,1728) - lu(k,91) * lu(k,1595) + lu(k,92) = 1._r8 / lu(k,92) + lu(k,93) = lu(k,93) * lu(k,92) + lu(k,94) = lu(k,94) * lu(k,92) + lu(k,95) = lu(k,95) * lu(k,92) + lu(k,1634) = - lu(k,93) * lu(k,1596) + lu(k,1694) = lu(k,1694) - lu(k,94) * lu(k,1596) + lu(k,1728) = lu(k,1728) - lu(k,95) * lu(k,1596) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = lu(k,97) * lu(k,96) + lu(k,98) = lu(k,98) * lu(k,96) + lu(k,99) = lu(k,99) * lu(k,96) + lu(k,100) = lu(k,100) * lu(k,96) + lu(k,1633) = lu(k,1633) - lu(k,97) * lu(k,1597) + lu(k,1636) = lu(k,1636) - lu(k,98) * lu(k,1597) + lu(k,1719) = lu(k,1719) - lu(k,99) * lu(k,1597) + lu(k,1728) = lu(k,1728) - lu(k,100) * lu(k,1597) + lu(k,101) = 1._r8 / lu(k,101) + lu(k,102) = lu(k,102) * lu(k,101) + lu(k,103) = lu(k,103) * lu(k,101) + lu(k,104) = lu(k,104) * lu(k,101) + lu(k,1561) = lu(k,1561) - lu(k,102) * lu(k,1559) + lu(k,1569) = lu(k,1569) - lu(k,103) * lu(k,1559) + lu(k,1570) = lu(k,1570) - lu(k,104) * lu(k,1559) + lu(k,1668) = lu(k,1668) - lu(k,102) * lu(k,1598) + lu(k,1717) = lu(k,1717) - lu(k,103) * lu(k,1598) + lu(k,1718) = lu(k,1718) - lu(k,104) * lu(k,1598) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,106) = lu(k,106) * lu(k,105) + lu(k,107) = lu(k,107) * lu(k,105) + lu(k,108) = lu(k,108) * lu(k,105) + lu(k,1570) = lu(k,1570) - lu(k,106) * lu(k,1560) + lu(k,1571) = lu(k,1571) - lu(k,107) * lu(k,1560) + lu(k,1580) = lu(k,1580) - lu(k,108) * lu(k,1560) + lu(k,1718) = lu(k,1718) - lu(k,106) * lu(k,1599) + lu(k,1719) = lu(k,1719) - lu(k,107) * lu(k,1599) + lu(k,1728) = lu(k,1728) - lu(k,108) * lu(k,1599) + lu(k,114) = 1._r8 / lu(k,114) + lu(k,115) = lu(k,115) * lu(k,114) + lu(k,116) = lu(k,116) * lu(k,114) + lu(k,117) = lu(k,117) * lu(k,114) + lu(k,118) = lu(k,118) * lu(k,114) + lu(k,119) = lu(k,119) * lu(k,114) + lu(k,120) = lu(k,120) * lu(k,114) + lu(k,1601) = lu(k,1601) - lu(k,115) * lu(k,1600) + lu(k,1602) = lu(k,1602) - lu(k,116) * lu(k,1600) + lu(k,1632) = lu(k,1632) - lu(k,117) * lu(k,1600) + lu(k,1664) = lu(k,1664) - lu(k,118) * lu(k,1600) + lu(k,1719) = lu(k,1719) - lu(k,119) * lu(k,1600) + lu(k,1728) = lu(k,1728) - lu(k,120) * lu(k,1600) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,121) = 1._r8 / lu(k,121) + lu(k,122) = lu(k,122) * lu(k,121) + lu(k,123) = lu(k,123) * lu(k,121) + lu(k,124) = lu(k,124) * lu(k,121) + lu(k,125) = lu(k,125) * lu(k,121) + lu(k,1633) = lu(k,1633) - lu(k,122) * lu(k,1601) + lu(k,1636) = lu(k,1636) - lu(k,123) * lu(k,1601) + lu(k,1719) = lu(k,1719) - lu(k,124) * lu(k,1601) + lu(k,1728) = lu(k,1728) - lu(k,125) * lu(k,1601) + lu(k,126) = 1._r8 / lu(k,126) + lu(k,127) = lu(k,127) * lu(k,126) + lu(k,128) = lu(k,128) * lu(k,126) + lu(k,129) = lu(k,129) * lu(k,126) + lu(k,143) = - lu(k,127) * lu(k,138) + lu(k,144) = - lu(k,128) * lu(k,138) + lu(k,146) = lu(k,146) - lu(k,129) * lu(k,138) + lu(k,1694) = lu(k,1694) - lu(k,127) * lu(k,1602) + lu(k,1710) = lu(k,1710) - lu(k,128) * lu(k,1602) + lu(k,1728) = lu(k,1728) - lu(k,129) * lu(k,1602) + lu(k,130) = 1._r8 / lu(k,130) + lu(k,131) = lu(k,131) * lu(k,130) + lu(k,132) = lu(k,132) * lu(k,130) + lu(k,1091) = lu(k,1091) - lu(k,131) * lu(k,1085) + lu(k,1096) = - lu(k,132) * lu(k,1085) + lu(k,1700) = lu(k,1700) - lu(k,131) * lu(k,1603) + lu(k,1719) = lu(k,1719) - lu(k,132) * lu(k,1603) + lu(k,2088) = lu(k,2088) - lu(k,131) * lu(k,2024) + lu(k,2106) = lu(k,2106) - lu(k,132) * lu(k,2024) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,142) = lu(k,142) * lu(k,139) + lu(k,143) = lu(k,143) * lu(k,139) + lu(k,144) = lu(k,144) * lu(k,139) + lu(k,145) = lu(k,145) * lu(k,139) + lu(k,146) = lu(k,146) * lu(k,139) + lu(k,1605) = lu(k,1605) - lu(k,140) * lu(k,1604) + lu(k,1632) = lu(k,1632) - lu(k,141) * lu(k,1604) + lu(k,1665) = lu(k,1665) - lu(k,142) * lu(k,1604) + lu(k,1694) = lu(k,1694) - lu(k,143) * lu(k,1604) + lu(k,1710) = lu(k,1710) - lu(k,144) * lu(k,1604) + lu(k,1719) = lu(k,1719) - lu(k,145) * lu(k,1604) + lu(k,1728) = lu(k,1728) - lu(k,146) * lu(k,1604) + lu(k,147) = 1._r8 / lu(k,147) + lu(k,148) = lu(k,148) * lu(k,147) + lu(k,149) = lu(k,149) * lu(k,147) + lu(k,150) = lu(k,150) * lu(k,147) + lu(k,151) = lu(k,151) * lu(k,147) + lu(k,1636) = lu(k,1636) - lu(k,148) * lu(k,1605) + lu(k,1640) = lu(k,1640) - lu(k,149) * lu(k,1605) + lu(k,1719) = lu(k,1719) - lu(k,150) * lu(k,1605) + lu(k,1728) = lu(k,1728) - lu(k,151) * lu(k,1605) + lu(k,152) = 1._r8 / lu(k,152) + lu(k,153) = lu(k,153) * lu(k,152) + lu(k,154) = lu(k,154) * lu(k,152) + lu(k,673) = lu(k,673) - lu(k,153) * lu(k,672) + lu(k,678) = lu(k,678) - lu(k,154) * lu(k,672) + lu(k,1103) = lu(k,1103) - lu(k,153) * lu(k,1102) + lu(k,1112) = lu(k,1112) - lu(k,154) * lu(k,1102) + lu(k,1936) = lu(k,1936) - lu(k,153) * lu(k,1935) + lu(k,1950) = - lu(k,154) * lu(k,1935) + lu(k,2148) = lu(k,2148) - lu(k,153) * lu(k,2146) + lu(k,2164) = lu(k,2164) - lu(k,154) * lu(k,2146) + lu(k,155) = 1._r8 / lu(k,155) + lu(k,156) = lu(k,156) * lu(k,155) + lu(k,157) = lu(k,157) * lu(k,155) + lu(k,158) = lu(k,158) * lu(k,155) + lu(k,159) = lu(k,159) * lu(k,155) + lu(k,1191) = - lu(k,156) * lu(k,1188) + lu(k,1203) = - lu(k,157) * lu(k,1188) + lu(k,1213) = - lu(k,158) * lu(k,1188) + lu(k,1220) = lu(k,1220) - lu(k,159) * lu(k,1188) + lu(k,1653) = - lu(k,156) * lu(k,1606) + lu(k,1700) = lu(k,1700) - lu(k,157) * lu(k,1606) + lu(k,1719) = lu(k,1719) - lu(k,158) * lu(k,1606) + lu(k,1728) = lu(k,1728) - lu(k,159) * lu(k,1606) + lu(k,160) = 1._r8 / lu(k,160) + lu(k,161) = lu(k,161) * lu(k,160) + lu(k,162) = lu(k,162) * lu(k,160) + lu(k,977) = lu(k,977) - lu(k,161) * lu(k,965) + lu(k,978) = lu(k,978) - lu(k,162) * lu(k,965) + lu(k,1038) = - lu(k,161) * lu(k,1023) + lu(k,1039) = lu(k,1039) - lu(k,162) * lu(k,1023) + lu(k,1516) = - lu(k,161) * lu(k,1441) + lu(k,1517) = lu(k,1517) - lu(k,162) * lu(k,1441) + lu(k,1725) = lu(k,1725) - lu(k,161) * lu(k,1607) + lu(k,1726) = lu(k,1726) - lu(k,162) * lu(k,1607) + lu(k,163) = 1._r8 / lu(k,163) + lu(k,164) = lu(k,164) * lu(k,163) + lu(k,165) = lu(k,165) * lu(k,163) + lu(k,821) = - lu(k,164) * lu(k,816) + lu(k,831) = lu(k,831) - lu(k,165) * lu(k,816) + lu(k,859) = - lu(k,164) * lu(k,854) + lu(k,869) = lu(k,869) - lu(k,165) * lu(k,854) + lu(k,1683) = lu(k,1683) - lu(k,164) * lu(k,1608) + lu(k,1719) = lu(k,1719) - lu(k,165) * lu(k,1608) + lu(k,1751) = - lu(k,164) * lu(k,1738) + lu(k,1781) = lu(k,1781) - lu(k,165) * lu(k,1738) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,166) = 1._r8 / lu(k,166) + lu(k,167) = lu(k,167) * lu(k,166) + lu(k,168) = lu(k,168) * lu(k,166) + lu(k,656) = lu(k,656) - lu(k,167) * lu(k,653) + lu(k,657) = - lu(k,168) * lu(k,653) + lu(k,1338) = - lu(k,167) * lu(k,1333) + lu(k,1339) = lu(k,1339) - lu(k,168) * lu(k,1333) + lu(k,2006) = lu(k,2006) - lu(k,167) * lu(k,1999) + lu(k,2009) = lu(k,2009) - lu(k,168) * lu(k,1999) + lu(k,2127) = lu(k,2127) - lu(k,167) * lu(k,2120) + lu(k,2131) = lu(k,2131) - lu(k,168) * lu(k,2120) + lu(k,169) = 1._r8 / lu(k,169) + lu(k,170) = lu(k,170) * lu(k,169) + lu(k,171) = lu(k,171) * lu(k,169) + lu(k,243) = - lu(k,170) * lu(k,240) + lu(k,244) = lu(k,244) - lu(k,171) * lu(k,240) + lu(k,324) = - lu(k,170) * lu(k,321) + lu(k,326) = - lu(k,171) * lu(k,321) + lu(k,1454) = lu(k,1454) - lu(k,170) * lu(k,1442) + lu(k,1510) = lu(k,1510) - lu(k,171) * lu(k,1442) + lu(k,1641) = lu(k,1641) - lu(k,170) * lu(k,1609) + lu(k,1719) = lu(k,1719) - lu(k,171) * lu(k,1609) + lu(k,173) = 1._r8 / lu(k,173) + lu(k,174) = lu(k,174) * lu(k,173) + lu(k,175) = lu(k,175) * lu(k,173) + lu(k,176) = lu(k,176) * lu(k,173) + lu(k,892) = lu(k,892) - lu(k,174) * lu(k,891) + lu(k,895) = lu(k,895) - lu(k,175) * lu(k,891) + lu(k,897) = - lu(k,176) * lu(k,891) + lu(k,1684) = lu(k,1684) - lu(k,174) * lu(k,1610) + lu(k,1721) = lu(k,1721) - lu(k,175) * lu(k,1610) + lu(k,1730) = lu(k,1730) - lu(k,176) * lu(k,1610) + lu(k,2149) = - lu(k,174) * lu(k,2147) + lu(k,2161) = lu(k,2161) - lu(k,175) * lu(k,2147) + lu(k,2170) = lu(k,2170) - lu(k,176) * lu(k,2147) + lu(k,177) = 1._r8 / lu(k,177) + lu(k,178) = lu(k,178) * lu(k,177) + lu(k,179) = lu(k,179) * lu(k,177) + lu(k,180) = lu(k,180) * lu(k,177) + lu(k,841) = lu(k,841) - lu(k,178) * lu(k,837) + lu(k,845) = - lu(k,179) * lu(k,837) + lu(k,848) = lu(k,848) - lu(k,180) * lu(k,837) + lu(k,1385) = lu(k,1385) - lu(k,178) * lu(k,1363) + lu(k,1400) = - lu(k,179) * lu(k,1363) + lu(k,1407) = lu(k,1407) - lu(k,180) * lu(k,1363) + lu(k,1699) = lu(k,1699) - lu(k,178) * lu(k,1611) + lu(k,1719) = lu(k,1719) - lu(k,179) * lu(k,1611) + lu(k,1728) = lu(k,1728) - lu(k,180) * lu(k,1611) + lu(k,181) = 1._r8 / lu(k,181) + lu(k,182) = lu(k,182) * lu(k,181) + lu(k,183) = lu(k,183) * lu(k,181) + lu(k,184) = lu(k,184) * lu(k,181) + lu(k,528) = lu(k,528) - lu(k,182) * lu(k,527) + lu(k,529) = lu(k,529) - lu(k,183) * lu(k,527) + lu(k,531) = - lu(k,184) * lu(k,527) + lu(k,1636) = lu(k,1636) - lu(k,182) * lu(k,1612) + lu(k,1656) = lu(k,1656) - lu(k,183) * lu(k,1612) + lu(k,1719) = lu(k,1719) - lu(k,184) * lu(k,1612) + lu(k,2043) = - lu(k,182) * lu(k,2025) + lu(k,2056) = lu(k,2056) - lu(k,183) * lu(k,2025) + lu(k,2106) = lu(k,2106) - lu(k,184) * lu(k,2025) + lu(k,185) = 1._r8 / lu(k,185) + lu(k,186) = lu(k,186) * lu(k,185) + lu(k,187) = lu(k,187) * lu(k,185) + lu(k,188) = lu(k,188) * lu(k,185) + lu(k,189) = lu(k,189) * lu(k,185) + lu(k,190) = lu(k,190) * lu(k,185) + lu(k,1900) = lu(k,1900) - lu(k,186) * lu(k,1860) + lu(k,1905) = lu(k,1905) - lu(k,187) * lu(k,1860) + lu(k,1907) = lu(k,1907) - lu(k,188) * lu(k,1860) + lu(k,1909) = lu(k,1909) - lu(k,189) * lu(k,1860) + lu(k,1910) = lu(k,1910) - lu(k,190) * lu(k,1860) + lu(k,1984) = lu(k,1984) - lu(k,186) * lu(k,1958) + lu(k,1989) = lu(k,1989) - lu(k,187) * lu(k,1958) + lu(k,1991) = lu(k,1991) - lu(k,188) * lu(k,1958) + lu(k,1993) = lu(k,1993) - lu(k,189) * lu(k,1958) + lu(k,1994) = lu(k,1994) - lu(k,190) * lu(k,1958) + lu(k,191) = 1._r8 / lu(k,191) + lu(k,192) = lu(k,192) * lu(k,191) + lu(k,193) = lu(k,193) * lu(k,191) + lu(k,194) = lu(k,194) * lu(k,191) + lu(k,195) = lu(k,195) * lu(k,191) + lu(k,196) = lu(k,196) * lu(k,191) + lu(k,1684) = lu(k,1684) - lu(k,192) * lu(k,1613) + lu(k,1719) = lu(k,1719) - lu(k,193) * lu(k,1613) + lu(k,1723) = lu(k,1723) - lu(k,194) * lu(k,1613) + lu(k,1725) = lu(k,1725) - lu(k,195) * lu(k,1613) + lu(k,1728) = lu(k,1728) - lu(k,196) * lu(k,1613) + lu(k,1871) = lu(k,1871) - lu(k,192) * lu(k,1861) + lu(k,1903) = lu(k,1903) - lu(k,193) * lu(k,1861) + lu(k,1907) = lu(k,1907) - lu(k,194) * lu(k,1861) + lu(k,1909) = lu(k,1909) - lu(k,195) * lu(k,1861) + lu(k,1912) = lu(k,1912) - lu(k,196) * lu(k,1861) + lu(k,197) = 1._r8 / lu(k,197) + lu(k,198) = lu(k,198) * lu(k,197) + lu(k,199) = lu(k,199) * lu(k,197) + lu(k,496) = - lu(k,198) * lu(k,490) + lu(k,500) = lu(k,500) - lu(k,199) * lu(k,490) + lu(k,592) = - lu(k,198) * lu(k,585) + lu(k,599) = lu(k,599) - lu(k,199) * lu(k,585) + lu(k,619) = - lu(k,198) * lu(k,613) + lu(k,627) = lu(k,627) - lu(k,199) * lu(k,613) + lu(k,635) = - lu(k,198) * lu(k,628) + lu(k,644) = lu(k,644) - lu(k,199) * lu(k,628) + lu(k,1467) = lu(k,1467) - lu(k,198) * lu(k,1443) + lu(k,1519) = lu(k,1519) - lu(k,199) * lu(k,1443) + lu(k,200) = 1._r8 / lu(k,200) + lu(k,201) = lu(k,201) * lu(k,200) + lu(k,202) = lu(k,202) * lu(k,200) + lu(k,203) = lu(k,203) * lu(k,200) + lu(k,204) = lu(k,204) * lu(k,200) + lu(k,205) = lu(k,205) * lu(k,200) + lu(k,1528) = - lu(k,201) * lu(k,1523) + lu(k,1530) = - lu(k,202) * lu(k,1523) + lu(k,1534) = lu(k,1534) - lu(k,203) * lu(k,1523) + lu(k,1545) = lu(k,1545) - lu(k,204) * lu(k,1523) + lu(k,1554) = lu(k,1554) - lu(k,205) * lu(k,1523) + lu(k,1670) = lu(k,1670) - lu(k,201) * lu(k,1614) + lu(k,1678) = lu(k,1678) - lu(k,202) * lu(k,1614) + lu(k,1694) = lu(k,1694) - lu(k,203) * lu(k,1614) + lu(k,1719) = lu(k,1719) - lu(k,204) * lu(k,1614) + lu(k,1728) = lu(k,1728) - lu(k,205) * lu(k,1614) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,206) = 1._r8 / lu(k,206) + lu(k,207) = lu(k,207) * lu(k,206) + lu(k,208) = lu(k,208) * lu(k,206) + lu(k,209) = lu(k,209) * lu(k,206) + lu(k,210) = lu(k,210) * lu(k,206) + lu(k,211) = lu(k,211) * lu(k,206) + lu(k,1531) = lu(k,1531) - lu(k,207) * lu(k,1524) + lu(k,1538) = lu(k,1538) - lu(k,208) * lu(k,1524) + lu(k,1543) = lu(k,1543) - lu(k,209) * lu(k,1524) + lu(k,1545) = lu(k,1545) - lu(k,210) * lu(k,1524) + lu(k,1556) = - lu(k,211) * lu(k,1524) + lu(k,1681) = lu(k,1681) - lu(k,207) * lu(k,1615) + lu(k,1712) = lu(k,1712) - lu(k,208) * lu(k,1615) + lu(k,1717) = lu(k,1717) - lu(k,209) * lu(k,1615) + lu(k,1719) = lu(k,1719) - lu(k,210) * lu(k,1615) + lu(k,1730) = lu(k,1730) - lu(k,211) * lu(k,1615) + lu(k,212) = 1._r8 / lu(k,212) + lu(k,213) = lu(k,213) * lu(k,212) + lu(k,214) = lu(k,214) * lu(k,212) + lu(k,1203) = lu(k,1203) - lu(k,213) * lu(k,1189) + lu(k,1213) = lu(k,1213) - lu(k,214) * lu(k,1189) + lu(k,1293) = lu(k,1293) - lu(k,213) * lu(k,1284) + lu(k,1306) = lu(k,1306) - lu(k,214) * lu(k,1284) + lu(k,1386) = lu(k,1386) - lu(k,213) * lu(k,1364) + lu(k,1400) = lu(k,1400) - lu(k,214) * lu(k,1364) + lu(k,1494) = lu(k,1494) - lu(k,213) * lu(k,1444) + lu(k,1510) = lu(k,1510) - lu(k,214) * lu(k,1444) + lu(k,1700) = lu(k,1700) - lu(k,213) * lu(k,1616) + lu(k,1719) = lu(k,1719) - lu(k,214) * lu(k,1616) + lu(k,1886) = lu(k,1886) - lu(k,213) * lu(k,1862) + lu(k,1903) = lu(k,1903) - lu(k,214) * lu(k,1862) + lu(k,215) = 1._r8 / lu(k,215) + lu(k,216) = lu(k,216) * lu(k,215) + lu(k,217) = lu(k,217) * lu(k,215) + lu(k,218) = lu(k,218) * lu(k,215) + lu(k,219) = lu(k,219) * lu(k,215) + lu(k,1231) = lu(k,1231) - lu(k,216) * lu(k,1222) + lu(k,1232) = - lu(k,217) * lu(k,1222) + lu(k,1236) = - lu(k,218) * lu(k,1222) + lu(k,1242) = lu(k,1242) - lu(k,219) * lu(k,1222) + lu(k,1707) = lu(k,1707) - lu(k,216) * lu(k,1617) + lu(k,1709) = lu(k,1709) - lu(k,217) * lu(k,1617) + lu(k,1719) = lu(k,1719) - lu(k,218) * lu(k,1617) + lu(k,1728) = lu(k,1728) - lu(k,219) * lu(k,1617) + lu(k,2095) = lu(k,2095) - lu(k,216) * lu(k,2026) + lu(k,2097) = lu(k,2097) - lu(k,217) * lu(k,2026) + lu(k,2106) = lu(k,2106) - lu(k,218) * lu(k,2026) + lu(k,2115) = lu(k,2115) - lu(k,219) * lu(k,2026) + lu(k,220) = 1._r8 / lu(k,220) + lu(k,221) = lu(k,221) * lu(k,220) + lu(k,222) = lu(k,222) * lu(k,220) + lu(k,223) = lu(k,223) * lu(k,220) + lu(k,224) = lu(k,224) * lu(k,220) + lu(k,558) = lu(k,558) - lu(k,221) * lu(k,557) + lu(k,559) = lu(k,559) - lu(k,222) * lu(k,557) + lu(k,560) = lu(k,560) - lu(k,223) * lu(k,557) + lu(k,562) = lu(k,562) - lu(k,224) * lu(k,557) + lu(k,1659) = lu(k,1659) - lu(k,221) * lu(k,1618) + lu(k,1699) = lu(k,1699) - lu(k,222) * lu(k,1618) + lu(k,1710) = lu(k,1710) - lu(k,223) * lu(k,1618) + lu(k,1719) = lu(k,1719) - lu(k,224) * lu(k,1618) + lu(k,2058) = lu(k,2058) - lu(k,221) * lu(k,2027) + lu(k,2087) = lu(k,2087) - lu(k,222) * lu(k,2027) + lu(k,2098) = lu(k,2098) - lu(k,223) * lu(k,2027) + lu(k,2106) = lu(k,2106) - lu(k,224) * lu(k,2027) + lu(k,225) = 1._r8 / lu(k,225) + lu(k,226) = lu(k,226) * lu(k,225) + lu(k,227) = lu(k,227) * lu(k,225) + lu(k,228) = lu(k,228) * lu(k,225) + lu(k,229) = lu(k,229) * lu(k,225) + lu(k,595) = - lu(k,226) * lu(k,586) + lu(k,596) = lu(k,596) - lu(k,227) * lu(k,586) + lu(k,597) = - lu(k,228) * lu(k,586) + lu(k,599) = lu(k,599) - lu(k,229) * lu(k,586) + lu(k,638) = - lu(k,226) * lu(k,629) + lu(k,639) = lu(k,639) - lu(k,227) * lu(k,629) + lu(k,640) = - lu(k,228) * lu(k,629) + lu(k,644) = lu(k,644) - lu(k,229) * lu(k,629) + lu(k,1488) = lu(k,1488) - lu(k,226) * lu(k,1445) + lu(k,1497) = lu(k,1497) - lu(k,227) * lu(k,1445) + lu(k,1503) = lu(k,1503) - lu(k,228) * lu(k,1445) + lu(k,1519) = lu(k,1519) - lu(k,229) * lu(k,1445) + lu(k,230) = 1._r8 / lu(k,230) + lu(k,231) = lu(k,231) * lu(k,230) + lu(k,232) = lu(k,232) * lu(k,230) + lu(k,233) = lu(k,233) * lu(k,230) + lu(k,234) = lu(k,234) * lu(k,230) + lu(k,1317) = lu(k,1317) - lu(k,231) * lu(k,1315) + lu(k,1318) = lu(k,1318) - lu(k,232) * lu(k,1315) + lu(k,1325) = lu(k,1325) - lu(k,233) * lu(k,1315) + lu(k,1330) = lu(k,1330) - lu(k,234) * lu(k,1315) + lu(k,2003) = lu(k,2003) - lu(k,231) * lu(k,2000) + lu(k,2004) = lu(k,2004) - lu(k,232) * lu(k,2000) + lu(k,2013) = lu(k,2013) - lu(k,233) * lu(k,2000) + lu(k,2021) = lu(k,2021) - lu(k,234) * lu(k,2000) + lu(k,2123) = lu(k,2123) - lu(k,231) * lu(k,2121) + lu(k,2125) = lu(k,2125) - lu(k,232) * lu(k,2121) + lu(k,2135) = lu(k,2135) - lu(k,233) * lu(k,2121) + lu(k,2143) = lu(k,2143) - lu(k,234) * lu(k,2121) + lu(k,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,238) = lu(k,238) * lu(k,235) + lu(k,239) = lu(k,239) * lu(k,235) + lu(k,336) = lu(k,336) - lu(k,236) * lu(k,335) + lu(k,337) = lu(k,337) - lu(k,237) * lu(k,335) + lu(k,339) = - lu(k,238) * lu(k,335) + lu(k,341) = lu(k,341) - lu(k,239) * lu(k,335) + lu(k,1633) = lu(k,1633) - lu(k,236) * lu(k,1619) + lu(k,1678) = lu(k,1678) - lu(k,237) * lu(k,1619) + lu(k,1719) = lu(k,1719) - lu(k,238) * lu(k,1619) + lu(k,1728) = lu(k,1728) - lu(k,239) * lu(k,1619) + lu(k,2040) = lu(k,2040) - lu(k,236) * lu(k,2028) + lu(k,2073) = lu(k,2073) - lu(k,237) * lu(k,2028) + lu(k,2106) = lu(k,2106) - lu(k,238) * lu(k,2028) + lu(k,2115) = lu(k,2115) - lu(k,239) * lu(k,2028) + lu(k,241) = 1._r8 / lu(k,241) + lu(k,242) = lu(k,242) * lu(k,241) + lu(k,243) = lu(k,243) * lu(k,241) + lu(k,244) = lu(k,244) * lu(k,241) + lu(k,245) = lu(k,245) * lu(k,241) + lu(k,323) = lu(k,323) - lu(k,242) * lu(k,322) + lu(k,324) = lu(k,324) - lu(k,243) * lu(k,322) + lu(k,326) = lu(k,326) - lu(k,244) * lu(k,322) + lu(k,328) = lu(k,328) - lu(k,245) * lu(k,322) + lu(k,1632) = lu(k,1632) - lu(k,242) * lu(k,1620) + lu(k,1641) = lu(k,1641) - lu(k,243) * lu(k,1620) + lu(k,1719) = lu(k,1719) - lu(k,244) * lu(k,1620) + lu(k,1728) = lu(k,1728) - lu(k,245) * lu(k,1620) + lu(k,2038) = lu(k,2038) - lu(k,242) * lu(k,2029) + lu(k,2048) = lu(k,2048) - lu(k,243) * lu(k,2029) + lu(k,2106) = lu(k,2106) - lu(k,244) * lu(k,2029) + lu(k,2115) = lu(k,2115) - lu(k,245) * lu(k,2029) + lu(k,246) = 1._r8 / lu(k,246) + lu(k,247) = lu(k,247) * lu(k,246) + lu(k,248) = lu(k,248) * lu(k,246) + lu(k,249) = lu(k,249) * lu(k,246) + lu(k,250) = lu(k,250) * lu(k,246) + lu(k,840) = lu(k,840) - lu(k,247) * lu(k,838) + lu(k,841) = lu(k,841) - lu(k,248) * lu(k,838) + lu(k,845) = lu(k,845) - lu(k,249) * lu(k,838) + lu(k,848) = lu(k,848) - lu(k,250) * lu(k,838) + lu(k,1681) = lu(k,1681) - lu(k,247) * lu(k,1621) + lu(k,1699) = lu(k,1699) - lu(k,248) * lu(k,1621) + lu(k,1719) = lu(k,1719) - lu(k,249) * lu(k,1621) + lu(k,1728) = lu(k,1728) - lu(k,250) * lu(k,1621) + lu(k,2075) = lu(k,2075) - lu(k,247) * lu(k,2030) + lu(k,2087) = lu(k,2087) - lu(k,248) * lu(k,2030) + lu(k,2106) = lu(k,2106) - lu(k,249) * lu(k,2030) + lu(k,2115) = lu(k,2115) - lu(k,250) * lu(k,2030) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,251) = 1._r8 / lu(k,251) + lu(k,252) = lu(k,252) * lu(k,251) + lu(k,253) = lu(k,253) * lu(k,251) + lu(k,254) = lu(k,254) * lu(k,251) + lu(k,255) = lu(k,255) * lu(k,251) + lu(k,256) = lu(k,256) * lu(k,251) + lu(k,257) = lu(k,257) * lu(k,251) + lu(k,258) = lu(k,258) * lu(k,251) + lu(k,1662) = lu(k,1662) - lu(k,252) * lu(k,1622) + lu(k,1684) = lu(k,1684) - lu(k,253) * lu(k,1622) + lu(k,1694) = lu(k,1694) - lu(k,254) * lu(k,1622) + lu(k,1711) = lu(k,1711) - lu(k,255) * lu(k,1622) + lu(k,1719) = lu(k,1719) - lu(k,256) * lu(k,1622) + lu(k,1721) = lu(k,1721) - lu(k,257) * lu(k,1622) + lu(k,1724) = lu(k,1724) - lu(k,258) * lu(k,1622) + lu(k,1802) = - lu(k,252) * lu(k,1795) + lu(k,1810) = - lu(k,253) * lu(k,1795) + lu(k,1812) = lu(k,1812) - lu(k,254) * lu(k,1795) + lu(k,1814) = lu(k,1814) - lu(k,255) * lu(k,1795) + lu(k,1822) = lu(k,1822) - lu(k,256) * lu(k,1795) + lu(k,1824) = lu(k,1824) - lu(k,257) * lu(k,1795) + lu(k,1827) = lu(k,1827) - lu(k,258) * lu(k,1795) + lu(k,259) = 1._r8 / lu(k,259) + lu(k,260) = lu(k,260) * lu(k,259) + lu(k,261) = lu(k,261) * lu(k,259) + lu(k,262) = lu(k,262) * lu(k,259) + lu(k,263) = lu(k,263) * lu(k,259) + lu(k,264) = lu(k,264) * lu(k,259) + lu(k,265) = lu(k,265) * lu(k,259) + lu(k,266) = lu(k,266) * lu(k,259) + lu(k,1648) = lu(k,1648) - lu(k,260) * lu(k,1623) + lu(k,1685) = lu(k,1685) - lu(k,261) * lu(k,1623) + lu(k,1699) = lu(k,1699) - lu(k,262) * lu(k,1623) + lu(k,1719) = lu(k,1719) - lu(k,263) * lu(k,1623) + lu(k,1722) = lu(k,1722) - lu(k,264) * lu(k,1623) + lu(k,1723) = lu(k,1723) - lu(k,265) * lu(k,1623) + lu(k,1726) = lu(k,1726) - lu(k,266) * lu(k,1623) + lu(k,1864) = - lu(k,260) * lu(k,1863) + lu(k,1872) = lu(k,1872) - lu(k,261) * lu(k,1863) + lu(k,1885) = lu(k,1885) - lu(k,262) * lu(k,1863) + lu(k,1903) = lu(k,1903) - lu(k,263) * lu(k,1863) + lu(k,1906) = lu(k,1906) - lu(k,264) * lu(k,1863) + lu(k,1907) = lu(k,1907) - lu(k,265) * lu(k,1863) + lu(k,1910) = lu(k,1910) - lu(k,266) * lu(k,1863) + lu(k,267) = 1._r8 / lu(k,267) + lu(k,268) = lu(k,268) * lu(k,267) + lu(k,269) = lu(k,269) * lu(k,267) + lu(k,270) = lu(k,270) * lu(k,267) + lu(k,271) = lu(k,271) * lu(k,267) + lu(k,272) = lu(k,272) * lu(k,267) + lu(k,1119) = - lu(k,268) * lu(k,1115) + lu(k,1121) = - lu(k,269) * lu(k,1115) + lu(k,1131) = - lu(k,270) * lu(k,1115) + lu(k,1135) = - lu(k,271) * lu(k,1115) + lu(k,1137) = lu(k,1137) - lu(k,272) * lu(k,1115) + lu(k,1371) = - lu(k,268) * lu(k,1365) + lu(k,1377) = lu(k,1377) - lu(k,269) * lu(k,1365) + lu(k,1400) = lu(k,1400) - lu(k,270) * lu(k,1365) + lu(k,1405) = - lu(k,271) * lu(k,1365) + lu(k,1407) = lu(k,1407) - lu(k,272) * lu(k,1365) + lu(k,1676) = lu(k,1676) - lu(k,268) * lu(k,1624) + lu(k,1690) = lu(k,1690) - lu(k,269) * lu(k,1624) + lu(k,1719) = lu(k,1719) - lu(k,270) * lu(k,1624) + lu(k,1725) = lu(k,1725) - lu(k,271) * lu(k,1624) + lu(k,1728) = lu(k,1728) - lu(k,272) * lu(k,1624) + lu(k,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,276) = lu(k,276) * lu(k,273) + lu(k,277) = lu(k,277) * lu(k,273) + lu(k,278) = lu(k,278) * lu(k,273) + lu(k,376) = lu(k,376) - lu(k,274) * lu(k,375) + lu(k,377) = lu(k,377) - lu(k,275) * lu(k,375) + lu(k,379) = lu(k,379) - lu(k,276) * lu(k,375) + lu(k,381) = - lu(k,277) * lu(k,375) + lu(k,383) = lu(k,383) - lu(k,278) * lu(k,375) + lu(k,1634) = lu(k,1634) - lu(k,274) * lu(k,1625) + lu(k,1639) = lu(k,1639) - lu(k,275) * lu(k,1625) + lu(k,1678) = lu(k,1678) - lu(k,276) * lu(k,1625) + lu(k,1719) = lu(k,1719) - lu(k,277) * lu(k,1625) + lu(k,1728) = lu(k,1728) - lu(k,278) * lu(k,1625) + lu(k,2041) = - lu(k,274) * lu(k,2031) + lu(k,2046) = lu(k,2046) - lu(k,275) * lu(k,2031) + lu(k,2073) = lu(k,2073) - lu(k,276) * lu(k,2031) + lu(k,2106) = lu(k,2106) - lu(k,277) * lu(k,2031) + lu(k,2115) = lu(k,2115) - lu(k,278) * lu(k,2031) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,282) = lu(k,282) * lu(k,279) + lu(k,283) = lu(k,283) * lu(k,279) + lu(k,284) = lu(k,284) * lu(k,279) + lu(k,819) = - lu(k,280) * lu(k,817) + lu(k,825) = lu(k,825) - lu(k,281) * lu(k,817) + lu(k,829) = - lu(k,282) * lu(k,817) + lu(k,830) = lu(k,830) - lu(k,283) * lu(k,817) + lu(k,835) = lu(k,835) - lu(k,284) * lu(k,817) + lu(k,857) = - lu(k,280) * lu(k,855) + lu(k,863) = lu(k,863) - lu(k,281) * lu(k,855) + lu(k,867) = - lu(k,282) * lu(k,855) + lu(k,868) = lu(k,868) - lu(k,283) * lu(k,855) + lu(k,873) = lu(k,873) - lu(k,284) * lu(k,855) + lu(k,1748) = - lu(k,280) * lu(k,1739) + lu(k,1759) = lu(k,1759) - lu(k,281) * lu(k,1739) + lu(k,1767) = lu(k,1767) - lu(k,282) * lu(k,1739) + lu(k,1773) = lu(k,1773) - lu(k,283) * lu(k,1739) + lu(k,1790) = lu(k,1790) - lu(k,284) * lu(k,1739) + lu(k,285) = 1._r8 / lu(k,285) + lu(k,286) = lu(k,286) * lu(k,285) + lu(k,287) = lu(k,287) * lu(k,285) + lu(k,288) = lu(k,288) * lu(k,285) + lu(k,289) = lu(k,289) * lu(k,285) + lu(k,290) = lu(k,290) * lu(k,285) + lu(k,1045) = lu(k,1045) - lu(k,286) * lu(k,1042) + lu(k,1049) = lu(k,1049) - lu(k,287) * lu(k,1042) + lu(k,1054) = - lu(k,288) * lu(k,1042) + lu(k,1058) = - lu(k,289) * lu(k,1042) + lu(k,1059) = lu(k,1059) - lu(k,290) * lu(k,1042) + lu(k,1687) = lu(k,1687) - lu(k,286) * lu(k,1626) + lu(k,1697) = lu(k,1697) - lu(k,287) * lu(k,1626) + lu(k,1719) = lu(k,1719) - lu(k,288) * lu(k,1626) + lu(k,1725) = lu(k,1725) - lu(k,289) * lu(k,1626) + lu(k,1726) = lu(k,1726) - lu(k,290) * lu(k,1626) + lu(k,2078) = - lu(k,286) * lu(k,2032) + lu(k,2085) = lu(k,2085) - lu(k,287) * lu(k,2032) + lu(k,2106) = lu(k,2106) - lu(k,288) * lu(k,2032) + lu(k,2112) = - lu(k,289) * lu(k,2032) + lu(k,2113) = lu(k,2113) - lu(k,290) * lu(k,2032) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,291) = 1._r8 / lu(k,291) + lu(k,292) = lu(k,292) * lu(k,291) + lu(k,293) = lu(k,293) * lu(k,291) + lu(k,294) = lu(k,294) * lu(k,291) + lu(k,295) = lu(k,295) * lu(k,291) + lu(k,296) = lu(k,296) * lu(k,291) + lu(k,1065) = lu(k,1065) - lu(k,292) * lu(k,1062) + lu(k,1067) = lu(k,1067) - lu(k,293) * lu(k,1062) + lu(k,1070) = lu(k,1070) - lu(k,294) * lu(k,1062) + lu(k,1071) = lu(k,1071) - lu(k,295) * lu(k,1062) + lu(k,1074) = - lu(k,296) * lu(k,1062) + lu(k,1698) = lu(k,1698) - lu(k,292) * lu(k,1627) + lu(k,1710) = lu(k,1710) - lu(k,293) * lu(k,1627) + lu(k,1719) = lu(k,1719) - lu(k,294) * lu(k,1627) + lu(k,1722) = lu(k,1722) - lu(k,295) * lu(k,1627) + lu(k,1730) = lu(k,1730) - lu(k,296) * lu(k,1627) + lu(k,2086) = lu(k,2086) - lu(k,292) * lu(k,2033) + lu(k,2098) = lu(k,2098) - lu(k,293) * lu(k,2033) + lu(k,2106) = lu(k,2106) - lu(k,294) * lu(k,2033) + lu(k,2109) = lu(k,2109) - lu(k,295) * lu(k,2033) + lu(k,2117) = lu(k,2117) - lu(k,296) * lu(k,2033) + lu(k,297) = 1._r8 / lu(k,297) + lu(k,298) = lu(k,298) * lu(k,297) + lu(k,299) = lu(k,299) * lu(k,297) + lu(k,300) = lu(k,300) * lu(k,297) + lu(k,301) = lu(k,301) * lu(k,297) + lu(k,302) = lu(k,302) * lu(k,297) + lu(k,1117) = - lu(k,298) * lu(k,1116) + lu(k,1119) = lu(k,1119) - lu(k,299) * lu(k,1116) + lu(k,1131) = lu(k,1131) - lu(k,300) * lu(k,1116) + lu(k,1136) = lu(k,1136) - lu(k,301) * lu(k,1116) + lu(k,1137) = lu(k,1137) - lu(k,302) * lu(k,1116) + lu(k,1660) = lu(k,1660) - lu(k,298) * lu(k,1628) + lu(k,1676) = lu(k,1676) - lu(k,299) * lu(k,1628) + lu(k,1719) = lu(k,1719) - lu(k,300) * lu(k,1628) + lu(k,1726) = lu(k,1726) - lu(k,301) * lu(k,1628) + lu(k,1728) = lu(k,1728) - lu(k,302) * lu(k,1628) + lu(k,2059) = lu(k,2059) - lu(k,298) * lu(k,2034) + lu(k,2072) = - lu(k,299) * lu(k,2034) + lu(k,2106) = lu(k,2106) - lu(k,300) * lu(k,2034) + lu(k,2113) = lu(k,2113) - lu(k,301) * lu(k,2034) + lu(k,2115) = lu(k,2115) - lu(k,302) * lu(k,2034) + lu(k,303) = 1._r8 / lu(k,303) + lu(k,304) = lu(k,304) * lu(k,303) + lu(k,305) = lu(k,305) * lu(k,303) + lu(k,306) = lu(k,306) * lu(k,303) + lu(k,307) = lu(k,307) * lu(k,303) + lu(k,308) = lu(k,308) * lu(k,303) + lu(k,728) = lu(k,728) - lu(k,304) * lu(k,727) + lu(k,729) = lu(k,729) - lu(k,305) * lu(k,727) + lu(k,734) = - lu(k,306) * lu(k,727) + lu(k,737) = lu(k,737) - lu(k,307) * lu(k,727) + lu(k,738) = - lu(k,308) * lu(k,727) + lu(k,1672) = lu(k,1672) - lu(k,304) * lu(k,1629) + lu(k,1685) = lu(k,1685) - lu(k,305) * lu(k,1629) + lu(k,1719) = lu(k,1719) - lu(k,306) * lu(k,1629) + lu(k,1728) = lu(k,1728) - lu(k,307) * lu(k,1629) + lu(k,1730) = lu(k,1730) - lu(k,308) * lu(k,1629) + lu(k,2069) = lu(k,2069) - lu(k,304) * lu(k,2035) + lu(k,2077) = - lu(k,305) * lu(k,2035) + lu(k,2106) = lu(k,2106) - lu(k,306) * lu(k,2035) + lu(k,2115) = lu(k,2115) - lu(k,307) * lu(k,2035) + lu(k,2117) = lu(k,2117) - lu(k,308) * lu(k,2035) + lu(k,309) = 1._r8 / lu(k,309) + lu(k,310) = lu(k,310) * lu(k,309) + lu(k,311) = lu(k,311) * lu(k,309) + lu(k,312) = lu(k,312) * lu(k,309) + lu(k,313) = lu(k,313) * lu(k,309) + lu(k,314) = lu(k,314) * lu(k,309) + lu(k,1396) = lu(k,1396) - lu(k,310) * lu(k,1366) + lu(k,1400) = lu(k,1400) - lu(k,311) * lu(k,1366) + lu(k,1402) = lu(k,1402) - lu(k,312) * lu(k,1366) + lu(k,1404) = - lu(k,313) * lu(k,1366) + lu(k,1409) = - lu(k,314) * lu(k,1366) + lu(k,1714) = lu(k,1714) - lu(k,310) * lu(k,1630) + lu(k,1719) = lu(k,1719) - lu(k,311) * lu(k,1630) + lu(k,1722) = lu(k,1722) - lu(k,312) * lu(k,1630) + lu(k,1724) = lu(k,1724) - lu(k,313) * lu(k,1630) + lu(k,1730) = lu(k,1730) - lu(k,314) * lu(k,1630) + lu(k,2101) = lu(k,2101) - lu(k,310) * lu(k,2036) + lu(k,2106) = lu(k,2106) - lu(k,311) * lu(k,2036) + lu(k,2109) = lu(k,2109) - lu(k,312) * lu(k,2036) + lu(k,2111) = lu(k,2111) - lu(k,313) * lu(k,2036) + lu(k,2117) = lu(k,2117) - lu(k,314) * lu(k,2036) + lu(k,315) = 1._r8 / lu(k,315) + lu(k,316) = lu(k,316) * lu(k,315) + lu(k,317) = lu(k,317) * lu(k,315) + lu(k,318) = lu(k,318) * lu(k,315) + lu(k,319) = lu(k,319) * lu(k,315) + lu(k,320) = lu(k,320) * lu(k,315) + lu(k,392) = lu(k,392) - lu(k,316) * lu(k,391) + lu(k,393) = lu(k,393) - lu(k,317) * lu(k,391) + lu(k,394) = lu(k,394) - lu(k,318) * lu(k,391) + lu(k,396) = - lu(k,319) * lu(k,391) + lu(k,398) = lu(k,398) - lu(k,320) * lu(k,391) + lu(k,1640) = lu(k,1640) - lu(k,316) * lu(k,1631) + lu(k,1678) = lu(k,1678) - lu(k,317) * lu(k,1631) + lu(k,1704) = lu(k,1704) - lu(k,318) * lu(k,1631) + lu(k,1719) = lu(k,1719) - lu(k,319) * lu(k,1631) + lu(k,1728) = lu(k,1728) - lu(k,320) * lu(k,1631) + lu(k,2047) = lu(k,2047) - lu(k,316) * lu(k,2037) + lu(k,2073) = lu(k,2073) - lu(k,317) * lu(k,2037) + lu(k,2092) = lu(k,2092) - lu(k,318) * lu(k,2037) + lu(k,2106) = lu(k,2106) - lu(k,319) * lu(k,2037) + lu(k,2115) = lu(k,2115) - lu(k,320) * lu(k,2037) + lu(k,323) = 1._r8 / lu(k,323) + lu(k,324) = lu(k,324) * lu(k,323) + lu(k,325) = lu(k,325) * lu(k,323) + lu(k,326) = lu(k,326) * lu(k,323) + lu(k,327) = lu(k,327) * lu(k,323) + lu(k,328) = lu(k,328) * lu(k,323) + lu(k,1454) = lu(k,1454) - lu(k,324) * lu(k,1446) + lu(k,1507) = lu(k,1507) - lu(k,325) * lu(k,1446) + lu(k,1510) = lu(k,1510) - lu(k,326) * lu(k,1446) + lu(k,1517) = lu(k,1517) - lu(k,327) * lu(k,1446) + lu(k,1519) = lu(k,1519) - lu(k,328) * lu(k,1446) + lu(k,1641) = lu(k,1641) - lu(k,324) * lu(k,1632) + lu(k,1716) = lu(k,1716) - lu(k,325) * lu(k,1632) + lu(k,1719) = lu(k,1719) - lu(k,326) * lu(k,1632) + lu(k,1726) = lu(k,1726) - lu(k,327) * lu(k,1632) + lu(k,1728) = lu(k,1728) - lu(k,328) * lu(k,1632) + lu(k,2048) = lu(k,2048) - lu(k,324) * lu(k,2038) + lu(k,2103) = lu(k,2103) - lu(k,325) * lu(k,2038) + lu(k,2106) = lu(k,2106) - lu(k,326) * lu(k,2038) + lu(k,2113) = lu(k,2113) - lu(k,327) * lu(k,2038) + lu(k,2115) = lu(k,2115) - lu(k,328) * lu(k,2038) + lu(k,329) = 1._r8 / lu(k,329) + lu(k,330) = lu(k,330) * lu(k,329) + lu(k,331) = lu(k,331) * lu(k,329) + lu(k,332) = lu(k,332) * lu(k,329) + lu(k,333) = lu(k,333) * lu(k,329) + lu(k,334) = lu(k,334) * lu(k,329) + lu(k,1472) = lu(k,1472) - lu(k,330) * lu(k,1447) + lu(k,1507) = lu(k,1507) - lu(k,331) * lu(k,1447) + lu(k,1513) = lu(k,1513) - lu(k,332) * lu(k,1447) + lu(k,1517) = lu(k,1517) - lu(k,333) * lu(k,1447) + lu(k,1519) = lu(k,1519) - lu(k,334) * lu(k,1447) + lu(k,1835) = - lu(k,330) * lu(k,1834) + lu(k,1843) = - lu(k,331) * lu(k,1834) + lu(k,1849) = lu(k,1849) - lu(k,332) * lu(k,1834) + lu(k,1853) = - lu(k,333) * lu(k,1834) + lu(k,1855) = lu(k,1855) - lu(k,334) * lu(k,1834) + lu(k,2067) = lu(k,2067) - lu(k,330) * lu(k,2039) + lu(k,2103) = lu(k,2103) - lu(k,331) * lu(k,2039) + lu(k,2109) = lu(k,2109) - lu(k,332) * lu(k,2039) + lu(k,2113) = lu(k,2113) - lu(k,333) * lu(k,2039) + lu(k,2115) = lu(k,2115) - lu(k,334) * lu(k,2039) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,336) = 1._r8 / lu(k,336) + lu(k,337) = lu(k,337) * lu(k,336) + lu(k,338) = lu(k,338) * lu(k,336) + lu(k,339) = lu(k,339) * lu(k,336) + lu(k,340) = lu(k,340) * lu(k,336) + lu(k,341) = lu(k,341) * lu(k,336) + lu(k,1477) = lu(k,1477) - lu(k,337) * lu(k,1448) + lu(k,1507) = lu(k,1507) - lu(k,338) * lu(k,1448) + lu(k,1510) = lu(k,1510) - lu(k,339) * lu(k,1448) + lu(k,1517) = lu(k,1517) - lu(k,340) * lu(k,1448) + lu(k,1519) = lu(k,1519) - lu(k,341) * lu(k,1448) + lu(k,1678) = lu(k,1678) - lu(k,337) * lu(k,1633) + lu(k,1716) = lu(k,1716) - lu(k,338) * lu(k,1633) + lu(k,1719) = lu(k,1719) - lu(k,339) * lu(k,1633) + lu(k,1726) = lu(k,1726) - lu(k,340) * lu(k,1633) + lu(k,1728) = lu(k,1728) - lu(k,341) * lu(k,1633) + lu(k,2073) = lu(k,2073) - lu(k,337) * lu(k,2040) + lu(k,2103) = lu(k,2103) - lu(k,338) * lu(k,2040) + lu(k,2106) = lu(k,2106) - lu(k,339) * lu(k,2040) + lu(k,2113) = lu(k,2113) - lu(k,340) * lu(k,2040) + lu(k,2115) = lu(k,2115) - lu(k,341) * lu(k,2040) + lu(k,342) = 1._r8 / lu(k,342) + lu(k,343) = lu(k,343) * lu(k,342) + lu(k,344) = lu(k,344) * lu(k,342) + lu(k,378) = - lu(k,343) * lu(k,376) + lu(k,383) = lu(k,383) - lu(k,344) * lu(k,376) + lu(k,494) = - lu(k,343) * lu(k,491) + lu(k,500) = lu(k,500) - lu(k,344) * lu(k,491) + lu(k,590) = - lu(k,343) * lu(k,587) + lu(k,599) = lu(k,599) - lu(k,344) * lu(k,587) + lu(k,617) = - lu(k,343) * lu(k,614) + lu(k,627) = lu(k,627) - lu(k,344) * lu(k,614) + lu(k,633) = - lu(k,343) * lu(k,630) + lu(k,644) = lu(k,644) - lu(k,344) * lu(k,630) + lu(k,1464) = lu(k,1464) - lu(k,343) * lu(k,1449) + lu(k,1519) = lu(k,1519) - lu(k,344) * lu(k,1449) + lu(k,1663) = - lu(k,343) * lu(k,1634) + lu(k,1728) = lu(k,1728) - lu(k,344) * lu(k,1634) + lu(k,2061) = lu(k,2061) - lu(k,343) * lu(k,2041) + lu(k,2115) = lu(k,2115) - lu(k,344) * lu(k,2041) + lu(k,345) = 1._r8 / lu(k,345) + lu(k,346) = lu(k,346) * lu(k,345) + lu(k,347) = lu(k,347) * lu(k,345) + lu(k,348) = lu(k,348) * lu(k,345) + lu(k,349) = lu(k,349) * lu(k,345) + lu(k,665) = - lu(k,346) * lu(k,663) + lu(k,666) = - lu(k,347) * lu(k,663) + lu(k,669) = lu(k,669) - lu(k,348) * lu(k,663) + lu(k,671) = lu(k,671) - lu(k,349) * lu(k,663) + lu(k,1423) = lu(k,1423) - lu(k,346) * lu(k,1412) + lu(k,1427) = lu(k,1427) - lu(k,347) * lu(k,1412) + lu(k,1434) = - lu(k,348) * lu(k,1412) + lu(k,1438) = lu(k,1438) - lu(k,349) * lu(k,1412) + lu(k,1484) = lu(k,1484) - lu(k,346) * lu(k,1450) + lu(k,1506) = lu(k,1506) - lu(k,347) * lu(k,1450) + lu(k,1513) = lu(k,1513) - lu(k,348) * lu(k,1450) + lu(k,1519) = lu(k,1519) - lu(k,349) * lu(k,1450) + lu(k,2079) = - lu(k,346) * lu(k,2042) + lu(k,2102) = lu(k,2102) - lu(k,347) * lu(k,2042) + lu(k,2109) = lu(k,2109) - lu(k,348) * lu(k,2042) + lu(k,2115) = lu(k,2115) - lu(k,349) * lu(k,2042) + lu(k,350) = 1._r8 / lu(k,350) + lu(k,351) = lu(k,351) * lu(k,350) + lu(k,352) = lu(k,352) * lu(k,350) + lu(k,353) = lu(k,353) * lu(k,350) + lu(k,354) = lu(k,354) * lu(k,350) + lu(k,355) = lu(k,355) * lu(k,350) + lu(k,356) = lu(k,356) * lu(k,350) + lu(k,1302) = lu(k,1302) - lu(k,351) * lu(k,1285) + lu(k,1303) = lu(k,1303) - lu(k,352) * lu(k,1285) + lu(k,1306) = lu(k,1306) - lu(k,353) * lu(k,1285) + lu(k,1308) = lu(k,1308) - lu(k,354) * lu(k,1285) + lu(k,1309) = - lu(k,355) * lu(k,1285) + lu(k,1312) = lu(k,1312) - lu(k,356) * lu(k,1285) + lu(k,1710) = lu(k,1710) - lu(k,351) * lu(k,1635) + lu(k,1714) = lu(k,1714) - lu(k,352) * lu(k,1635) + lu(k,1719) = lu(k,1719) - lu(k,353) * lu(k,1635) + lu(k,1722) = lu(k,1722) - lu(k,354) * lu(k,1635) + lu(k,1723) = lu(k,1723) - lu(k,355) * lu(k,1635) + lu(k,1726) = lu(k,1726) - lu(k,356) * lu(k,1635) + lu(k,1978) = lu(k,1978) - lu(k,351) * lu(k,1959) + lu(k,1982) = - lu(k,352) * lu(k,1959) + lu(k,1987) = lu(k,1987) - lu(k,353) * lu(k,1959) + lu(k,1990) = - lu(k,354) * lu(k,1959) + lu(k,1991) = lu(k,1991) - lu(k,355) * lu(k,1959) + lu(k,1994) = lu(k,1994) - lu(k,356) * lu(k,1959) + lu(k,357) = 1._r8 / lu(k,357) + lu(k,358) = lu(k,358) * lu(k,357) + lu(k,359) = lu(k,359) * lu(k,357) + lu(k,360) = lu(k,360) * lu(k,357) + lu(k,529) = lu(k,529) - lu(k,358) * lu(k,528) + lu(k,532) = - lu(k,359) * lu(k,528) + lu(k,533) = lu(k,533) - lu(k,360) * lu(k,528) + lu(k,1461) = lu(k,1461) - lu(k,358) * lu(k,1451) + lu(k,1511) = lu(k,1511) - lu(k,359) * lu(k,1451) + lu(k,1517) = lu(k,1517) - lu(k,360) * lu(k,1451) + lu(k,1656) = lu(k,1656) - lu(k,358) * lu(k,1636) + lu(k,1720) = lu(k,1720) - lu(k,359) * lu(k,1636) + lu(k,1726) = lu(k,1726) - lu(k,360) * lu(k,1636) + lu(k,1743) = lu(k,1743) - lu(k,358) * lu(k,1740) + lu(k,1782) = lu(k,1782) - lu(k,359) * lu(k,1740) + lu(k,1788) = lu(k,1788) - lu(k,360) * lu(k,1740) + lu(k,1965) = - lu(k,358) * lu(k,1960) + lu(k,1988) = lu(k,1988) - lu(k,359) * lu(k,1960) + lu(k,1994) = lu(k,1994) - lu(k,360) * lu(k,1960) + lu(k,2056) = lu(k,2056) - lu(k,358) * lu(k,2043) + lu(k,2107) = lu(k,2107) - lu(k,359) * lu(k,2043) + lu(k,2113) = lu(k,2113) - lu(k,360) * lu(k,2043) + lu(k,361) = 1._r8 / lu(k,361) + lu(k,362) = lu(k,362) * lu(k,361) + lu(k,363) = lu(k,363) * lu(k,361) + lu(k,364) = lu(k,364) * lu(k,361) + lu(k,365) = lu(k,365) * lu(k,361) + lu(k,366) = lu(k,366) * lu(k,361) + lu(k,367) = lu(k,367) * lu(k,361) + lu(k,1715) = lu(k,1715) - lu(k,362) * lu(k,1637) + lu(k,1719) = lu(k,1719) - lu(k,363) * lu(k,1637) + lu(k,1723) = lu(k,1723) - lu(k,364) * lu(k,1637) + lu(k,1726) = lu(k,1726) - lu(k,365) * lu(k,1637) + lu(k,1728) = lu(k,1728) - lu(k,366) * lu(k,1637) + lu(k,1730) = lu(k,1730) - lu(k,367) * lu(k,1637) + lu(k,1983) = lu(k,1983) - lu(k,362) * lu(k,1961) + lu(k,1987) = lu(k,1987) - lu(k,363) * lu(k,1961) + lu(k,1991) = lu(k,1991) - lu(k,364) * lu(k,1961) + lu(k,1994) = lu(k,1994) - lu(k,365) * lu(k,1961) + lu(k,1996) = lu(k,1996) - lu(k,366) * lu(k,1961) + lu(k,1998) = - lu(k,367) * lu(k,1961) + lu(k,2102) = lu(k,2102) - lu(k,362) * lu(k,2044) + lu(k,2106) = lu(k,2106) - lu(k,363) * lu(k,2044) + lu(k,2110) = lu(k,2110) - lu(k,364) * lu(k,2044) + lu(k,2113) = lu(k,2113) - lu(k,365) * lu(k,2044) + lu(k,2115) = lu(k,2115) - lu(k,366) * lu(k,2044) + lu(k,2117) = lu(k,2117) - lu(k,367) * lu(k,2044) + lu(k,368) = 1._r8 / lu(k,368) + lu(k,369) = lu(k,369) * lu(k,368) + lu(k,370) = lu(k,370) * lu(k,368) + lu(k,371) = lu(k,371) * lu(k,368) + lu(k,372) = lu(k,372) * lu(k,368) + lu(k,373) = lu(k,373) * lu(k,368) + lu(k,374) = lu(k,374) * lu(k,368) + lu(k,1004) = lu(k,1004) - lu(k,369) * lu(k,1001) + lu(k,1005) = lu(k,1005) - lu(k,370) * lu(k,1001) + lu(k,1008) = lu(k,1008) - lu(k,371) * lu(k,1001) + lu(k,1015) = - lu(k,372) * lu(k,1001) + lu(k,1016) = lu(k,1016) - lu(k,373) * lu(k,1001) + lu(k,1021) = lu(k,1021) - lu(k,374) * lu(k,1001) + lu(k,1685) = lu(k,1685) - lu(k,369) * lu(k,1638) + lu(k,1687) = lu(k,1687) - lu(k,370) * lu(k,1638) + lu(k,1695) = lu(k,1695) - lu(k,371) * lu(k,1638) + lu(k,1719) = lu(k,1719) - lu(k,372) * lu(k,1638) + lu(k,1722) = lu(k,1722) - lu(k,373) * lu(k,1638) + lu(k,1728) = lu(k,1728) - lu(k,374) * lu(k,1638) + lu(k,2077) = lu(k,2077) - lu(k,369) * lu(k,2045) + lu(k,2078) = lu(k,2078) - lu(k,370) * lu(k,2045) + lu(k,2083) = lu(k,2083) - lu(k,371) * lu(k,2045) + lu(k,2106) = lu(k,2106) - lu(k,372) * lu(k,2045) + lu(k,2109) = lu(k,2109) - lu(k,373) * lu(k,2045) + lu(k,2115) = lu(k,2115) - lu(k,374) * lu(k,2045) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,377) = 1._r8 / lu(k,377) + lu(k,378) = lu(k,378) * lu(k,377) + lu(k,379) = lu(k,379) * lu(k,377) + lu(k,380) = lu(k,380) * lu(k,377) + lu(k,381) = lu(k,381) * lu(k,377) + lu(k,382) = lu(k,382) * lu(k,377) + lu(k,383) = lu(k,383) * lu(k,377) + lu(k,1464) = lu(k,1464) - lu(k,378) * lu(k,1452) + lu(k,1477) = lu(k,1477) - lu(k,379) * lu(k,1452) + lu(k,1507) = lu(k,1507) - lu(k,380) * lu(k,1452) + lu(k,1510) = lu(k,1510) - lu(k,381) * lu(k,1452) + lu(k,1517) = lu(k,1517) - lu(k,382) * lu(k,1452) + lu(k,1519) = lu(k,1519) - lu(k,383) * lu(k,1452) + lu(k,1663) = lu(k,1663) - lu(k,378) * lu(k,1639) + lu(k,1678) = lu(k,1678) - lu(k,379) * lu(k,1639) + lu(k,1716) = lu(k,1716) - lu(k,380) * lu(k,1639) + lu(k,1719) = lu(k,1719) - lu(k,381) * lu(k,1639) + lu(k,1726) = lu(k,1726) - lu(k,382) * lu(k,1639) + lu(k,1728) = lu(k,1728) - lu(k,383) * lu(k,1639) + lu(k,2061) = lu(k,2061) - lu(k,378) * lu(k,2046) + lu(k,2073) = lu(k,2073) - lu(k,379) * lu(k,2046) + lu(k,2103) = lu(k,2103) - lu(k,380) * lu(k,2046) + lu(k,2106) = lu(k,2106) - lu(k,381) * lu(k,2046) + lu(k,2113) = lu(k,2113) - lu(k,382) * lu(k,2046) + lu(k,2115) = lu(k,2115) - lu(k,383) * lu(k,2046) + lu(k,384) = 1._r8 / lu(k,384) + lu(k,385) = lu(k,385) * lu(k,384) + lu(k,386) = lu(k,386) * lu(k,384) + lu(k,387) = lu(k,387) * lu(k,384) + lu(k,388) = lu(k,388) * lu(k,384) + lu(k,389) = lu(k,389) * lu(k,384) + lu(k,390) = lu(k,390) * lu(k,384) + lu(k,740) = - lu(k,385) * lu(k,739) + lu(k,741) = lu(k,741) - lu(k,386) * lu(k,739) + lu(k,742) = lu(k,742) - lu(k,387) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,388) * lu(k,739) + lu(k,746) = lu(k,746) - lu(k,389) * lu(k,739) + lu(k,750) = lu(k,750) - lu(k,390) * lu(k,739) + lu(k,1415) = lu(k,1415) - lu(k,385) * lu(k,1413) + lu(k,1418) = lu(k,1418) - lu(k,386) * lu(k,1413) + lu(k,1419) = lu(k,1419) - lu(k,387) * lu(k,1413) + lu(k,1421) = lu(k,1421) - lu(k,388) * lu(k,1413) + lu(k,1427) = lu(k,1427) - lu(k,389) * lu(k,1413) + lu(k,1433) = lu(k,1433) - lu(k,390) * lu(k,1413) + lu(k,1800) = lu(k,1800) - lu(k,385) * lu(k,1796) + lu(k,1804) = - lu(k,386) * lu(k,1796) + lu(k,1805) = lu(k,1805) - lu(k,387) * lu(k,1796) + lu(k,1807) = lu(k,1807) - lu(k,388) * lu(k,1796) + lu(k,1818) = lu(k,1818) - lu(k,389) * lu(k,1796) + lu(k,1824) = lu(k,1824) - lu(k,390) * lu(k,1796) + lu(k,392) = 1._r8 / lu(k,392) + lu(k,393) = lu(k,393) * lu(k,392) + lu(k,394) = lu(k,394) * lu(k,392) + lu(k,395) = lu(k,395) * lu(k,392) + lu(k,396) = lu(k,396) * lu(k,392) + lu(k,397) = lu(k,397) * lu(k,392) + lu(k,398) = lu(k,398) * lu(k,392) + lu(k,1477) = lu(k,1477) - lu(k,393) * lu(k,1453) + lu(k,1497) = lu(k,1497) - lu(k,394) * lu(k,1453) + lu(k,1507) = lu(k,1507) - lu(k,395) * lu(k,1453) + lu(k,1510) = lu(k,1510) - lu(k,396) * lu(k,1453) + lu(k,1517) = lu(k,1517) - lu(k,397) * lu(k,1453) + lu(k,1519) = lu(k,1519) - lu(k,398) * lu(k,1453) + lu(k,1678) = lu(k,1678) - lu(k,393) * lu(k,1640) + lu(k,1704) = lu(k,1704) - lu(k,394) * lu(k,1640) + lu(k,1716) = lu(k,1716) - lu(k,395) * lu(k,1640) + lu(k,1719) = lu(k,1719) - lu(k,396) * lu(k,1640) + lu(k,1726) = lu(k,1726) - lu(k,397) * lu(k,1640) + lu(k,1728) = lu(k,1728) - lu(k,398) * lu(k,1640) + lu(k,2073) = lu(k,2073) - lu(k,393) * lu(k,2047) + lu(k,2092) = lu(k,2092) - lu(k,394) * lu(k,2047) + lu(k,2103) = lu(k,2103) - lu(k,395) * lu(k,2047) + lu(k,2106) = lu(k,2106) - lu(k,396) * lu(k,2047) + lu(k,2113) = lu(k,2113) - lu(k,397) * lu(k,2047) + lu(k,2115) = lu(k,2115) - lu(k,398) * lu(k,2047) + lu(k,400) = 1._r8 / lu(k,400) + lu(k,401) = lu(k,401) * lu(k,400) + lu(k,402) = lu(k,402) * lu(k,400) + lu(k,403) = lu(k,403) * lu(k,400) + lu(k,404) = lu(k,404) * lu(k,400) + lu(k,405) = lu(k,405) * lu(k,400) + lu(k,1461) = lu(k,1461) - lu(k,401) * lu(k,1454) + lu(k,1507) = lu(k,1507) - lu(k,402) * lu(k,1454) + lu(k,1510) = lu(k,1510) - lu(k,403) * lu(k,1454) + lu(k,1517) = lu(k,1517) - lu(k,404) * lu(k,1454) + lu(k,1519) = lu(k,1519) - lu(k,405) * lu(k,1454) + lu(k,1656) = lu(k,1656) - lu(k,401) * lu(k,1641) + lu(k,1716) = lu(k,1716) - lu(k,402) * lu(k,1641) + lu(k,1719) = lu(k,1719) - lu(k,403) * lu(k,1641) + lu(k,1726) = lu(k,1726) - lu(k,404) * lu(k,1641) + lu(k,1728) = lu(k,1728) - lu(k,405) * lu(k,1641) + lu(k,1965) = lu(k,1965) - lu(k,401) * lu(k,1962) + lu(k,1984) = lu(k,1984) - lu(k,402) * lu(k,1962) + lu(k,1987) = lu(k,1987) - lu(k,403) * lu(k,1962) + lu(k,1994) = lu(k,1994) - lu(k,404) * lu(k,1962) + lu(k,1996) = lu(k,1996) - lu(k,405) * lu(k,1962) + lu(k,2056) = lu(k,2056) - lu(k,401) * lu(k,2048) + lu(k,2103) = lu(k,2103) - lu(k,402) * lu(k,2048) + lu(k,2106) = lu(k,2106) - lu(k,403) * lu(k,2048) + lu(k,2113) = lu(k,2113) - lu(k,404) * lu(k,2048) + lu(k,2115) = lu(k,2115) - lu(k,405) * lu(k,2048) + lu(k,406) = 1._r8 / lu(k,406) + lu(k,407) = lu(k,407) * lu(k,406) + lu(k,408) = lu(k,408) * lu(k,406) + lu(k,409) = lu(k,409) * lu(k,406) + lu(k,410) = lu(k,410) * lu(k,406) + lu(k,411) = lu(k,411) * lu(k,406) + lu(k,1272) = lu(k,1272) - lu(k,407) * lu(k,1266) + lu(k,1273) = lu(k,1273) - lu(k,408) * lu(k,1266) + lu(k,1275) = lu(k,1275) - lu(k,409) * lu(k,1266) + lu(k,1277) = lu(k,1277) - lu(k,410) * lu(k,1266) + lu(k,1283) = - lu(k,411) * lu(k,1266) + lu(k,1302) = lu(k,1302) - lu(k,407) * lu(k,1286) + lu(k,1303) = lu(k,1303) - lu(k,408) * lu(k,1286) + lu(k,1306) = lu(k,1306) - lu(k,409) * lu(k,1286) + lu(k,1308) = lu(k,1308) - lu(k,410) * lu(k,1286) + lu(k,1314) = - lu(k,411) * lu(k,1286) + lu(k,1710) = lu(k,1710) - lu(k,407) * lu(k,1642) + lu(k,1714) = lu(k,1714) - lu(k,408) * lu(k,1642) + lu(k,1719) = lu(k,1719) - lu(k,409) * lu(k,1642) + lu(k,1722) = lu(k,1722) - lu(k,410) * lu(k,1642) + lu(k,1730) = lu(k,1730) - lu(k,411) * lu(k,1642) + lu(k,2098) = lu(k,2098) - lu(k,407) * lu(k,2049) + lu(k,2101) = lu(k,2101) - lu(k,408) * lu(k,2049) + lu(k,2106) = lu(k,2106) - lu(k,409) * lu(k,2049) + lu(k,2109) = lu(k,2109) - lu(k,410) * lu(k,2049) + lu(k,2117) = lu(k,2117) - lu(k,411) * lu(k,2049) + lu(k,412) = 1._r8 / lu(k,412) + lu(k,413) = lu(k,413) * lu(k,412) + lu(k,414) = lu(k,414) * lu(k,412) + lu(k,415) = lu(k,415) * lu(k,412) + lu(k,416) = lu(k,416) * lu(k,412) + lu(k,571) = lu(k,571) - lu(k,413) * lu(k,565) + lu(k,573) = lu(k,573) - lu(k,414) * lu(k,565) + lu(k,574) = - lu(k,415) * lu(k,565) + lu(k,575) = - lu(k,416) * lu(k,565) + lu(k,692) = lu(k,692) - lu(k,413) * lu(k,689) + lu(k,693) = - lu(k,414) * lu(k,689) + lu(k,694) = - lu(k,415) * lu(k,689) + lu(k,695) = - lu(k,416) * lu(k,689) + lu(k,702) = lu(k,702) - lu(k,413) * lu(k,697) + lu(k,704) = - lu(k,414) * lu(k,697) + lu(k,705) = - lu(k,415) * lu(k,697) + lu(k,706) = lu(k,706) - lu(k,416) * lu(k,697) + lu(k,1421) = lu(k,1421) - lu(k,413) * lu(k,1414) + lu(k,1427) = lu(k,1427) - lu(k,414) * lu(k,1414) + lu(k,1428) = lu(k,1428) - lu(k,415) * lu(k,1414) + lu(k,1430) = lu(k,1430) - lu(k,416) * lu(k,1414) + lu(k,1807) = lu(k,1807) - lu(k,413) * lu(k,1797) + lu(k,1818) = lu(k,1818) - lu(k,414) * lu(k,1797) + lu(k,1819) = lu(k,1819) - lu(k,415) * lu(k,1797) + lu(k,1821) = - lu(k,416) * lu(k,1797) + lu(k,417) = 1._r8 / lu(k,417) + lu(k,418) = lu(k,418) * lu(k,417) + lu(k,419) = lu(k,419) * lu(k,417) + lu(k,420) = lu(k,420) * lu(k,417) + lu(k,421) = lu(k,421) * lu(k,417) + lu(k,537) = - lu(k,418) * lu(k,535) + lu(k,538) = - lu(k,419) * lu(k,535) + lu(k,541) = - lu(k,420) * lu(k,535) + lu(k,542) = lu(k,542) - lu(k,421) * lu(k,535) + lu(k,548) = - lu(k,418) * lu(k,546) + lu(k,549) = - lu(k,419) * lu(k,546) + lu(k,553) = - lu(k,420) * lu(k,546) + lu(k,554) = lu(k,554) - lu(k,421) * lu(k,546) + lu(k,878) = - lu(k,418) * lu(k,875) + lu(k,879) = - lu(k,419) * lu(k,875) + lu(k,883) = - lu(k,420) * lu(k,875) + lu(k,887) = - lu(k,421) * lu(k,875) + lu(k,1463) = lu(k,1463) - lu(k,418) * lu(k,1455) + lu(k,1479) = lu(k,1479) - lu(k,419) * lu(k,1455) + lu(k,1503) = lu(k,1503) - lu(k,420) * lu(k,1455) + lu(k,1510) = lu(k,1510) - lu(k,421) * lu(k,1455) + lu(k,1659) = lu(k,1659) - lu(k,418) * lu(k,1643) + lu(k,1681) = lu(k,1681) - lu(k,419) * lu(k,1643) + lu(k,1710) = lu(k,1710) - lu(k,420) * lu(k,1643) + lu(k,1719) = lu(k,1719) - lu(k,421) * lu(k,1643) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,422) = 1._r8 / lu(k,422) + lu(k,423) = lu(k,423) * lu(k,422) + lu(k,424) = lu(k,424) * lu(k,422) + lu(k,425) = lu(k,425) * lu(k,422) + lu(k,426) = lu(k,426) * lu(k,422) + lu(k,427) = lu(k,427) * lu(k,422) + lu(k,428) = lu(k,428) * lu(k,422) + lu(k,429) = lu(k,429) * lu(k,422) + lu(k,1194) = - lu(k,423) * lu(k,1190) + lu(k,1197) = lu(k,1197) - lu(k,424) * lu(k,1190) + lu(k,1198) = - lu(k,425) * lu(k,1190) + lu(k,1199) = lu(k,1199) - lu(k,426) * lu(k,1190) + lu(k,1213) = lu(k,1213) - lu(k,427) * lu(k,1190) + lu(k,1218) = - lu(k,428) * lu(k,1190) + lu(k,1220) = lu(k,1220) - lu(k,429) * lu(k,1190) + lu(k,1476) = - lu(k,423) * lu(k,1456) + lu(k,1484) = lu(k,1484) - lu(k,424) * lu(k,1456) + lu(k,1485) = lu(k,1485) - lu(k,425) * lu(k,1456) + lu(k,1487) = lu(k,1487) - lu(k,426) * lu(k,1456) + lu(k,1510) = lu(k,1510) - lu(k,427) * lu(k,1456) + lu(k,1516) = lu(k,1516) - lu(k,428) * lu(k,1456) + lu(k,1519) = lu(k,1519) - lu(k,429) * lu(k,1456) + lu(k,1676) = lu(k,1676) - lu(k,423) * lu(k,1644) + lu(k,1690) = lu(k,1690) - lu(k,424) * lu(k,1644) + lu(k,1691) = lu(k,1691) - lu(k,425) * lu(k,1644) + lu(k,1693) = lu(k,1693) - lu(k,426) * lu(k,1644) + lu(k,1719) = lu(k,1719) - lu(k,427) * lu(k,1644) + lu(k,1725) = lu(k,1725) - lu(k,428) * lu(k,1644) + lu(k,1728) = lu(k,1728) - lu(k,429) * lu(k,1644) + lu(k,430) = 1._r8 / lu(k,430) + lu(k,431) = lu(k,431) * lu(k,430) + lu(k,432) = lu(k,432) * lu(k,430) + lu(k,433) = lu(k,433) * lu(k,430) + lu(k,434) = lu(k,434) * lu(k,430) + lu(k,435) = lu(k,435) * lu(k,430) + lu(k,436) = lu(k,436) * lu(k,430) + lu(k,437) = lu(k,437) * lu(k,430) + lu(k,717) = lu(k,717) - lu(k,431) * lu(k,716) + lu(k,718) = - lu(k,432) * lu(k,716) + lu(k,719) = lu(k,719) - lu(k,433) * lu(k,716) + lu(k,722) = - lu(k,434) * lu(k,716) + lu(k,723) = lu(k,723) - lu(k,435) * lu(k,716) + lu(k,725) = lu(k,725) - lu(k,436) * lu(k,716) + lu(k,726) = - lu(k,437) * lu(k,716) + lu(k,1671) = lu(k,1671) - lu(k,431) * lu(k,1645) + lu(k,1693) = lu(k,1693) - lu(k,432) * lu(k,1645) + lu(k,1699) = lu(k,1699) - lu(k,433) * lu(k,1645) + lu(k,1719) = lu(k,1719) - lu(k,434) * lu(k,1645) + lu(k,1722) = lu(k,1722) - lu(k,435) * lu(k,1645) + lu(k,1728) = lu(k,1728) - lu(k,436) * lu(k,1645) + lu(k,1730) = lu(k,1730) - lu(k,437) * lu(k,1645) + lu(k,2068) = lu(k,2068) - lu(k,431) * lu(k,2050) + lu(k,2081) = - lu(k,432) * lu(k,2050) + lu(k,2087) = lu(k,2087) - lu(k,433) * lu(k,2050) + lu(k,2106) = lu(k,2106) - lu(k,434) * lu(k,2050) + lu(k,2109) = lu(k,2109) - lu(k,435) * lu(k,2050) + lu(k,2115) = lu(k,2115) - lu(k,436) * lu(k,2050) + lu(k,2117) = lu(k,2117) - lu(k,437) * lu(k,2050) + lu(k,438) = 1._r8 / lu(k,438) + lu(k,439) = lu(k,439) * lu(k,438) + lu(k,440) = lu(k,440) * lu(k,438) + lu(k,441) = lu(k,441) * lu(k,438) + lu(k,442) = lu(k,442) * lu(k,438) + lu(k,443) = lu(k,443) * lu(k,438) + lu(k,444) = lu(k,444) * lu(k,438) + lu(k,445) = lu(k,445) * lu(k,438) + lu(k,1803) = lu(k,1803) - lu(k,439) * lu(k,1798) + lu(k,1816) = lu(k,1816) - lu(k,440) * lu(k,1798) + lu(k,1824) = lu(k,1824) - lu(k,441) * lu(k,1798) + lu(k,1826) = lu(k,1826) - lu(k,442) * lu(k,1798) + lu(k,1828) = - lu(k,443) * lu(k,1798) + lu(k,1829) = lu(k,1829) - lu(k,444) * lu(k,1798) + lu(k,1830) = lu(k,1830) - lu(k,445) * lu(k,1798) + lu(k,1968) = - lu(k,439) * lu(k,1963) + lu(k,1981) = - lu(k,440) * lu(k,1963) + lu(k,1989) = lu(k,1989) - lu(k,441) * lu(k,1963) + lu(k,1991) = lu(k,1991) - lu(k,442) * lu(k,1963) + lu(k,1993) = lu(k,1993) - lu(k,443) * lu(k,1963) + lu(k,1994) = lu(k,1994) - lu(k,444) * lu(k,1963) + lu(k,1995) = lu(k,1995) - lu(k,445) * lu(k,1963) + lu(k,2002) = lu(k,2002) - lu(k,439) * lu(k,2001) + lu(k,2006) = lu(k,2006) - lu(k,440) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,441) * lu(k,2001) + lu(k,2015) = - lu(k,442) * lu(k,2001) + lu(k,2017) = - lu(k,443) * lu(k,2001) + lu(k,2018) = lu(k,2018) - lu(k,444) * lu(k,2001) + lu(k,2019) = lu(k,2019) - lu(k,445) * lu(k,2001) + lu(k,446) = 1._r8 / lu(k,446) + lu(k,447) = lu(k,447) * lu(k,446) + lu(k,448) = lu(k,448) * lu(k,446) + lu(k,449) = lu(k,449) * lu(k,446) + lu(k,949) = lu(k,949) - lu(k,447) * lu(k,939) + lu(k,952) = lu(k,952) - lu(k,448) * lu(k,939) + lu(k,958) = - lu(k,449) * lu(k,939) + lu(k,1273) = lu(k,1273) - lu(k,447) * lu(k,1267) + lu(k,1275) = lu(k,1275) - lu(k,448) * lu(k,1267) + lu(k,1283) = lu(k,1283) - lu(k,449) * lu(k,1267) + lu(k,1303) = lu(k,1303) - lu(k,447) * lu(k,1287) + lu(k,1306) = lu(k,1306) - lu(k,448) * lu(k,1287) + lu(k,1314) = lu(k,1314) - lu(k,449) * lu(k,1287) + lu(k,1396) = lu(k,1396) - lu(k,447) * lu(k,1367) + lu(k,1400) = lu(k,1400) - lu(k,448) * lu(k,1367) + lu(k,1409) = lu(k,1409) - lu(k,449) * lu(k,1367) + lu(k,1714) = lu(k,1714) - lu(k,447) * lu(k,1646) + lu(k,1719) = lu(k,1719) - lu(k,448) * lu(k,1646) + lu(k,1730) = lu(k,1730) - lu(k,449) * lu(k,1646) + lu(k,1776) = lu(k,1776) - lu(k,447) * lu(k,1741) + lu(k,1781) = lu(k,1781) - lu(k,448) * lu(k,1741) + lu(k,1792) = - lu(k,449) * lu(k,1741) + lu(k,2101) = lu(k,2101) - lu(k,447) * lu(k,2051) + lu(k,2106) = lu(k,2106) - lu(k,448) * lu(k,2051) + lu(k,2117) = lu(k,2117) - lu(k,449) * lu(k,2051) + lu(k,450) = 1._r8 / lu(k,450) + lu(k,451) = lu(k,451) * lu(k,450) + lu(k,452) = lu(k,452) * lu(k,450) + lu(k,453) = lu(k,453) * lu(k,450) + lu(k,454) = lu(k,454) * lu(k,450) + lu(k,455) = lu(k,455) * lu(k,450) + lu(k,456) = lu(k,456) * lu(k,450) + lu(k,457) = lu(k,457) * lu(k,450) + lu(k,1527) = - lu(k,451) * lu(k,1525) + lu(k,1528) = lu(k,1528) - lu(k,452) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,453) * lu(k,1525) + lu(k,1545) = lu(k,1545) - lu(k,454) * lu(k,1525) + lu(k,1546) = lu(k,1546) - lu(k,455) * lu(k,1525) + lu(k,1548) = lu(k,1548) - lu(k,456) * lu(k,1525) + lu(k,1554) = lu(k,1554) - lu(k,457) * lu(k,1525) + lu(k,1667) = lu(k,1667) - lu(k,451) * lu(k,1647) + lu(k,1670) = lu(k,1670) - lu(k,452) * lu(k,1647) + lu(k,1694) = lu(k,1694) - lu(k,453) * lu(k,1647) + lu(k,1719) = lu(k,1719) - lu(k,454) * lu(k,1647) + lu(k,1720) = lu(k,1720) - lu(k,455) * lu(k,1647) + lu(k,1722) = lu(k,1722) - lu(k,456) * lu(k,1647) + lu(k,1728) = lu(k,1728) - lu(k,457) * lu(k,1647) + lu(k,1745) = - lu(k,451) * lu(k,1742) + lu(k,1746) = lu(k,1746) - lu(k,452) * lu(k,1742) + lu(k,1759) = lu(k,1759) - lu(k,453) * lu(k,1742) + lu(k,1781) = lu(k,1781) - lu(k,454) * lu(k,1742) + lu(k,1782) = lu(k,1782) - lu(k,455) * lu(k,1742) + lu(k,1784) = lu(k,1784) - lu(k,456) * lu(k,1742) + lu(k,1790) = lu(k,1790) - lu(k,457) * lu(k,1742) + end do + end subroutine lu_fac10 + subroutine lu_fac11( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,458) = 1._r8 / lu(k,458) + lu(k,459) = lu(k,459) * lu(k,458) + lu(k,460) = lu(k,460) * lu(k,458) + lu(k,461) = lu(k,461) * lu(k,458) + lu(k,462) = lu(k,462) * lu(k,458) + lu(k,463) = lu(k,463) * lu(k,458) + lu(k,464) = lu(k,464) * lu(k,458) + lu(k,465) = lu(k,465) * lu(k,458) + lu(k,1481) = lu(k,1481) - lu(k,459) * lu(k,1457) + lu(k,1485) = lu(k,1485) - lu(k,460) * lu(k,1457) + lu(k,1493) = lu(k,1493) - lu(k,461) * lu(k,1457) + lu(k,1507) = lu(k,1507) - lu(k,462) * lu(k,1457) + lu(k,1513) = lu(k,1513) - lu(k,463) * lu(k,1457) + lu(k,1517) = lu(k,1517) - lu(k,464) * lu(k,1457) + lu(k,1519) = lu(k,1519) - lu(k,465) * lu(k,1457) + lu(k,1685) = lu(k,1685) - lu(k,459) * lu(k,1648) + lu(k,1691) = lu(k,1691) - lu(k,460) * lu(k,1648) + lu(k,1699) = lu(k,1699) - lu(k,461) * lu(k,1648) + lu(k,1716) = lu(k,1716) - lu(k,462) * lu(k,1648) + lu(k,1722) = lu(k,1722) - lu(k,463) * lu(k,1648) + lu(k,1726) = lu(k,1726) - lu(k,464) * lu(k,1648) + lu(k,1728) = lu(k,1728) - lu(k,465) * lu(k,1648) + lu(k,1872) = lu(k,1872) - lu(k,459) * lu(k,1864) + lu(k,1877) = - lu(k,460) * lu(k,1864) + lu(k,1885) = lu(k,1885) - lu(k,461) * lu(k,1864) + lu(k,1900) = lu(k,1900) - lu(k,462) * lu(k,1864) + lu(k,1906) = lu(k,1906) - lu(k,463) * lu(k,1864) + lu(k,1910) = lu(k,1910) - lu(k,464) * lu(k,1864) + lu(k,1912) = lu(k,1912) - lu(k,465) * lu(k,1864) + lu(k,466) = 1._r8 / lu(k,466) + lu(k,467) = lu(k,467) * lu(k,466) + lu(k,468) = lu(k,468) * lu(k,466) + lu(k,469) = lu(k,469) * lu(k,466) + lu(k,470) = lu(k,470) * lu(k,466) + lu(k,471) = lu(k,471) * lu(k,466) + lu(k,472) = lu(k,472) * lu(k,466) + lu(k,473) = lu(k,473) * lu(k,466) + lu(k,1269) = - lu(k,467) * lu(k,1268) + lu(k,1271) = lu(k,1271) - lu(k,468) * lu(k,1268) + lu(k,1275) = lu(k,1275) - lu(k,469) * lu(k,1268) + lu(k,1277) = lu(k,1277) - lu(k,470) * lu(k,1268) + lu(k,1278) = lu(k,1278) - lu(k,471) * lu(k,1268) + lu(k,1281) = lu(k,1281) - lu(k,472) * lu(k,1268) + lu(k,1282) = lu(k,1282) - lu(k,473) * lu(k,1268) + lu(k,1693) = lu(k,1693) - lu(k,467) * lu(k,1649) + lu(k,1709) = lu(k,1709) - lu(k,468) * lu(k,1649) + lu(k,1719) = lu(k,1719) - lu(k,469) * lu(k,1649) + lu(k,1722) = lu(k,1722) - lu(k,470) * lu(k,1649) + lu(k,1723) = lu(k,1723) - lu(k,471) * lu(k,1649) + lu(k,1726) = lu(k,1726) - lu(k,472) * lu(k,1649) + lu(k,1728) = lu(k,1728) - lu(k,473) * lu(k,1649) + lu(k,1974) = - lu(k,467) * lu(k,1964) + lu(k,1977) = lu(k,1977) - lu(k,468) * lu(k,1964) + lu(k,1987) = lu(k,1987) - lu(k,469) * lu(k,1964) + lu(k,1990) = lu(k,1990) - lu(k,470) * lu(k,1964) + lu(k,1991) = lu(k,1991) - lu(k,471) * lu(k,1964) + lu(k,1994) = lu(k,1994) - lu(k,472) * lu(k,1964) + lu(k,1996) = lu(k,1996) - lu(k,473) * lu(k,1964) + lu(k,474) = 1._r8 / lu(k,474) + lu(k,475) = lu(k,475) * lu(k,474) + lu(k,476) = lu(k,476) * lu(k,474) + lu(k,477) = lu(k,477) * lu(k,474) + lu(k,478) = lu(k,478) * lu(k,474) + lu(k,479) = lu(k,479) * lu(k,474) + lu(k,480) = lu(k,480) * lu(k,474) + lu(k,1538) = lu(k,1538) - lu(k,475) * lu(k,1526) + lu(k,1543) = lu(k,1543) - lu(k,476) * lu(k,1526) + lu(k,1545) = lu(k,1545) - lu(k,477) * lu(k,1526) + lu(k,1547) = - lu(k,478) * lu(k,1526) + lu(k,1554) = lu(k,1554) - lu(k,479) * lu(k,1526) + lu(k,1556) = lu(k,1556) - lu(k,480) * lu(k,1526) + lu(k,1712) = lu(k,1712) - lu(k,475) * lu(k,1650) + lu(k,1717) = lu(k,1717) - lu(k,476) * lu(k,1650) + lu(k,1719) = lu(k,1719) - lu(k,477) * lu(k,1650) + lu(k,1721) = lu(k,1721) - lu(k,478) * lu(k,1650) + lu(k,1728) = lu(k,1728) - lu(k,479) * lu(k,1650) + lu(k,1730) = lu(k,1730) - lu(k,480) * lu(k,1650) + lu(k,1815) = lu(k,1815) - lu(k,475) * lu(k,1799) + lu(k,1820) = lu(k,1820) - lu(k,476) * lu(k,1799) + lu(k,1822) = lu(k,1822) - lu(k,477) * lu(k,1799) + lu(k,1824) = lu(k,1824) - lu(k,478) * lu(k,1799) + lu(k,1831) = lu(k,1831) - lu(k,479) * lu(k,1799) + lu(k,1833) = - lu(k,480) * lu(k,1799) + lu(k,2099) = lu(k,2099) - lu(k,475) * lu(k,2052) + lu(k,2104) = lu(k,2104) - lu(k,476) * lu(k,2052) + lu(k,2106) = lu(k,2106) - lu(k,477) * lu(k,2052) + lu(k,2108) = lu(k,2108) - lu(k,478) * lu(k,2052) + lu(k,2115) = lu(k,2115) - lu(k,479) * lu(k,2052) + lu(k,2117) = lu(k,2117) - lu(k,480) * lu(k,2052) + lu(k,481) = 1._r8 / lu(k,481) + lu(k,482) = lu(k,482) * lu(k,481) + lu(k,483) = lu(k,483) * lu(k,481) + lu(k,484) = lu(k,484) * lu(k,481) + lu(k,485) = lu(k,485) * lu(k,481) + lu(k,486) = lu(k,486) * lu(k,481) + lu(k,487) = lu(k,487) * lu(k,481) + lu(k,488) = lu(k,488) * lu(k,481) + lu(k,489) = lu(k,489) * lu(k,481) + lu(k,1026) = lu(k,1026) - lu(k,482) * lu(k,1024) + lu(k,1027) = lu(k,1027) - lu(k,483) * lu(k,1024) + lu(k,1028) = lu(k,1028) - lu(k,484) * lu(k,1024) + lu(k,1029) = lu(k,1029) - lu(k,485) * lu(k,1024) + lu(k,1030) = lu(k,1030) - lu(k,486) * lu(k,1024) + lu(k,1035) = - lu(k,487) * lu(k,1024) + lu(k,1036) = lu(k,1036) - lu(k,488) * lu(k,1024) + lu(k,1040) = lu(k,1040) - lu(k,489) * lu(k,1024) + lu(k,1685) = lu(k,1685) - lu(k,482) * lu(k,1651) + lu(k,1690) = lu(k,1690) - lu(k,483) * lu(k,1651) + lu(k,1692) = lu(k,1692) - lu(k,484) * lu(k,1651) + lu(k,1694) = lu(k,1694) - lu(k,485) * lu(k,1651) + lu(k,1696) = lu(k,1696) - lu(k,486) * lu(k,1651) + lu(k,1719) = lu(k,1719) - lu(k,487) * lu(k,1651) + lu(k,1722) = lu(k,1722) - lu(k,488) * lu(k,1651) + lu(k,1728) = lu(k,1728) - lu(k,489) * lu(k,1651) + lu(k,2077) = lu(k,2077) - lu(k,482) * lu(k,2053) + lu(k,2079) = lu(k,2079) - lu(k,483) * lu(k,2053) + lu(k,2080) = - lu(k,484) * lu(k,2053) + lu(k,2082) = lu(k,2082) - lu(k,485) * lu(k,2053) + lu(k,2084) = lu(k,2084) - lu(k,486) * lu(k,2053) + lu(k,2106) = lu(k,2106) - lu(k,487) * lu(k,2053) + lu(k,2109) = lu(k,2109) - lu(k,488) * lu(k,2053) + lu(k,2115) = lu(k,2115) - lu(k,489) * lu(k,2053) + lu(k,492) = 1._r8 / lu(k,492) + lu(k,493) = lu(k,493) * lu(k,492) + lu(k,494) = lu(k,494) * lu(k,492) + lu(k,495) = lu(k,495) * lu(k,492) + lu(k,496) = lu(k,496) * lu(k,492) + lu(k,497) = lu(k,497) * lu(k,492) + lu(k,498) = lu(k,498) * lu(k,492) + lu(k,499) = lu(k,499) * lu(k,492) + lu(k,500) = lu(k,500) * lu(k,492) + lu(k,616) = lu(k,616) - lu(k,493) * lu(k,615) + lu(k,617) = lu(k,617) - lu(k,494) * lu(k,615) + lu(k,618) = lu(k,618) - lu(k,495) * lu(k,615) + lu(k,619) = lu(k,619) - lu(k,496) * lu(k,615) + lu(k,620) = lu(k,620) - lu(k,497) * lu(k,615) + lu(k,623) = lu(k,623) - lu(k,498) * lu(k,615) + lu(k,625) = - lu(k,499) * lu(k,615) + lu(k,627) = lu(k,627) - lu(k,500) * lu(k,615) + lu(k,1653) = lu(k,1653) - lu(k,493) * lu(k,1652) + lu(k,1663) = lu(k,1663) - lu(k,494) * lu(k,1652) + lu(k,1664) = lu(k,1664) - lu(k,495) * lu(k,1652) + lu(k,1666) = - lu(k,496) * lu(k,1652) + lu(k,1678) = lu(k,1678) - lu(k,497) * lu(k,1652) + lu(k,1704) = lu(k,1704) - lu(k,498) * lu(k,1652) + lu(k,1719) = lu(k,1719) - lu(k,499) * lu(k,1652) + lu(k,1728) = lu(k,1728) - lu(k,500) * lu(k,1652) + lu(k,2055) = - lu(k,493) * lu(k,2054) + lu(k,2061) = lu(k,2061) - lu(k,494) * lu(k,2054) + lu(k,2062) = lu(k,2062) - lu(k,495) * lu(k,2054) + lu(k,2064) = lu(k,2064) - lu(k,496) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,497) * lu(k,2054) + lu(k,2092) = lu(k,2092) - lu(k,498) * lu(k,2054) + lu(k,2106) = lu(k,2106) - lu(k,499) * lu(k,2054) + lu(k,2115) = lu(k,2115) - lu(k,500) * lu(k,2054) + end do + end subroutine lu_fac11 + subroutine lu_fac12( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,501) = 1._r8 / lu(k,501) + lu(k,502) = lu(k,502) * lu(k,501) + lu(k,503) = lu(k,503) * lu(k,501) + lu(k,504) = lu(k,504) * lu(k,501) + lu(k,594) = - lu(k,502) * lu(k,588) + lu(k,595) = lu(k,595) - lu(k,503) * lu(k,588) + lu(k,599) = lu(k,599) - lu(k,504) * lu(k,588) + lu(k,621) = - lu(k,502) * lu(k,616) + lu(k,622) = - lu(k,503) * lu(k,616) + lu(k,627) = lu(k,627) - lu(k,504) * lu(k,616) + lu(k,637) = - lu(k,502) * lu(k,631) + lu(k,638) = lu(k,638) - lu(k,503) * lu(k,631) + lu(k,644) = lu(k,644) - lu(k,504) * lu(k,631) + lu(k,927) = - lu(k,502) * lu(k,924) + lu(k,929) = - lu(k,503) * lu(k,924) + lu(k,938) = lu(k,938) - lu(k,504) * lu(k,924) + lu(k,1196) = - lu(k,502) * lu(k,1191) + lu(k,1200) = - lu(k,503) * lu(k,1191) + lu(k,1220) = lu(k,1220) - lu(k,504) * lu(k,1191) + lu(k,1478) = lu(k,1478) - lu(k,502) * lu(k,1458) + lu(k,1488) = lu(k,1488) - lu(k,503) * lu(k,1458) + lu(k,1519) = lu(k,1519) - lu(k,504) * lu(k,1458) + lu(k,1679) = - lu(k,502) * lu(k,1653) + lu(k,1694) = lu(k,1694) - lu(k,503) * lu(k,1653) + lu(k,1728) = lu(k,1728) - lu(k,504) * lu(k,1653) + lu(k,2074) = lu(k,2074) - lu(k,502) * lu(k,2055) + lu(k,2082) = lu(k,2082) - lu(k,503) * lu(k,2055) + lu(k,2115) = lu(k,2115) - lu(k,504) * lu(k,2055) + lu(k,505) = 1._r8 / lu(k,505) + lu(k,506) = lu(k,506) * lu(k,505) + lu(k,507) = lu(k,507) * lu(k,505) + lu(k,508) = lu(k,508) * lu(k,505) + lu(k,509) = lu(k,509) * lu(k,505) + lu(k,510) = lu(k,510) * lu(k,505) + lu(k,511) = lu(k,511) * lu(k,505) + lu(k,512) = lu(k,512) * lu(k,505) + lu(k,513) = lu(k,513) * lu(k,505) + lu(k,1163) = - lu(k,506) * lu(k,1160) + lu(k,1164) = - lu(k,507) * lu(k,1160) + lu(k,1165) = - lu(k,508) * lu(k,1160) + lu(k,1179) = - lu(k,509) * lu(k,1160) + lu(k,1181) = lu(k,1181) - lu(k,510) * lu(k,1160) + lu(k,1184) = - lu(k,511) * lu(k,1160) + lu(k,1185) = lu(k,1185) - lu(k,512) * lu(k,1160) + lu(k,1186) = lu(k,1186) - lu(k,513) * lu(k,1160) + lu(k,1484) = lu(k,1484) - lu(k,506) * lu(k,1459) + lu(k,1485) = lu(k,1485) - lu(k,507) * lu(k,1459) + lu(k,1487) = lu(k,1487) - lu(k,508) * lu(k,1459) + lu(k,1510) = lu(k,1510) - lu(k,509) * lu(k,1459) + lu(k,1513) = lu(k,1513) - lu(k,510) * lu(k,1459) + lu(k,1516) = lu(k,1516) - lu(k,511) * lu(k,1459) + lu(k,1517) = lu(k,1517) - lu(k,512) * lu(k,1459) + lu(k,1519) = lu(k,1519) - lu(k,513) * lu(k,1459) + lu(k,1690) = lu(k,1690) - lu(k,506) * lu(k,1654) + lu(k,1691) = lu(k,1691) - lu(k,507) * lu(k,1654) + lu(k,1693) = lu(k,1693) - lu(k,508) * lu(k,1654) + lu(k,1719) = lu(k,1719) - lu(k,509) * lu(k,1654) + lu(k,1722) = lu(k,1722) - lu(k,510) * lu(k,1654) + lu(k,1725) = lu(k,1725) - lu(k,511) * lu(k,1654) + lu(k,1726) = lu(k,1726) - lu(k,512) * lu(k,1654) + lu(k,1728) = lu(k,1728) - lu(k,513) * lu(k,1654) + lu(k,514) = 1._r8 / lu(k,514) + lu(k,515) = lu(k,515) * lu(k,514) + lu(k,516) = lu(k,516) * lu(k,514) + lu(k,517) = lu(k,517) * lu(k,514) + lu(k,518) = lu(k,518) * lu(k,514) + lu(k,519) = lu(k,519) * lu(k,514) + lu(k,520) = lu(k,520) * lu(k,514) + lu(k,568) = lu(k,568) - lu(k,515) * lu(k,566) + lu(k,569) = lu(k,569) - lu(k,516) * lu(k,566) + lu(k,571) = lu(k,571) - lu(k,517) * lu(k,566) + lu(k,572) = - lu(k,518) * lu(k,566) + lu(k,573) = lu(k,573) - lu(k,519) * lu(k,566) + lu(k,576) = lu(k,576) - lu(k,520) * lu(k,566) + lu(k,741) = lu(k,741) - lu(k,515) * lu(k,740) + lu(k,742) = lu(k,742) - lu(k,516) * lu(k,740) + lu(k,744) = lu(k,744) - lu(k,517) * lu(k,740) + lu(k,745) = - lu(k,518) * lu(k,740) + lu(k,746) = lu(k,746) - lu(k,519) * lu(k,740) + lu(k,750) = lu(k,750) - lu(k,520) * lu(k,740) + lu(k,1418) = lu(k,1418) - lu(k,515) * lu(k,1415) + lu(k,1419) = lu(k,1419) - lu(k,516) * lu(k,1415) + lu(k,1421) = lu(k,1421) - lu(k,517) * lu(k,1415) + lu(k,1424) = - lu(k,518) * lu(k,1415) + lu(k,1427) = lu(k,1427) - lu(k,519) * lu(k,1415) + lu(k,1433) = lu(k,1433) - lu(k,520) * lu(k,1415) + lu(k,1804) = lu(k,1804) - lu(k,515) * lu(k,1800) + lu(k,1805) = lu(k,1805) - lu(k,516) * lu(k,1800) + lu(k,1807) = lu(k,1807) - lu(k,517) * lu(k,1800) + lu(k,1812) = lu(k,1812) - lu(k,518) * lu(k,1800) + lu(k,1818) = lu(k,1818) - lu(k,519) * lu(k,1800) + lu(k,1824) = lu(k,1824) - lu(k,520) * lu(k,1800) + lu(k,521) = 1._r8 / lu(k,521) + lu(k,522) = lu(k,522) * lu(k,521) + lu(k,523) = lu(k,523) * lu(k,521) + lu(k,524) = lu(k,524) * lu(k,521) + lu(k,525) = lu(k,525) * lu(k,521) + lu(k,526) = lu(k,526) * lu(k,521) + lu(k,1005) = lu(k,1005) - lu(k,522) * lu(k,1002) + lu(k,1015) = lu(k,1015) - lu(k,523) * lu(k,1002) + lu(k,1019) = - lu(k,524) * lu(k,1002) + lu(k,1020) = lu(k,1020) - lu(k,525) * lu(k,1002) + lu(k,1021) = lu(k,1021) - lu(k,526) * lu(k,1002) + lu(k,1045) = lu(k,1045) - lu(k,522) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,523) * lu(k,1043) + lu(k,1058) = lu(k,1058) - lu(k,524) * lu(k,1043) + lu(k,1059) = lu(k,1059) - lu(k,525) * lu(k,1043) + lu(k,1060) = lu(k,1060) - lu(k,526) * lu(k,1043) + lu(k,1375) = lu(k,1375) - lu(k,522) * lu(k,1368) + lu(k,1400) = lu(k,1400) - lu(k,523) * lu(k,1368) + lu(k,1405) = lu(k,1405) - lu(k,524) * lu(k,1368) + lu(k,1406) = lu(k,1406) - lu(k,525) * lu(k,1368) + lu(k,1407) = lu(k,1407) - lu(k,526) * lu(k,1368) + lu(k,1482) = lu(k,1482) - lu(k,522) * lu(k,1460) + lu(k,1510) = lu(k,1510) - lu(k,523) * lu(k,1460) + lu(k,1516) = lu(k,1516) - lu(k,524) * lu(k,1460) + lu(k,1517) = lu(k,1517) - lu(k,525) * lu(k,1460) + lu(k,1519) = lu(k,1519) - lu(k,526) * lu(k,1460) + lu(k,1687) = lu(k,1687) - lu(k,522) * lu(k,1655) + lu(k,1719) = lu(k,1719) - lu(k,523) * lu(k,1655) + lu(k,1725) = lu(k,1725) - lu(k,524) * lu(k,1655) + lu(k,1726) = lu(k,1726) - lu(k,525) * lu(k,1655) + lu(k,1728) = lu(k,1728) - lu(k,526) * lu(k,1655) + lu(k,529) = 1._r8 / lu(k,529) + lu(k,530) = lu(k,530) * lu(k,529) + lu(k,531) = lu(k,531) * lu(k,529) + lu(k,532) = lu(k,532) * lu(k,529) + lu(k,533) = lu(k,533) * lu(k,529) + lu(k,534) = lu(k,534) * lu(k,529) + lu(k,1507) = lu(k,1507) - lu(k,530) * lu(k,1461) + lu(k,1510) = lu(k,1510) - lu(k,531) * lu(k,1461) + lu(k,1511) = lu(k,1511) - lu(k,532) * lu(k,1461) + lu(k,1517) = lu(k,1517) - lu(k,533) * lu(k,1461) + lu(k,1519) = lu(k,1519) - lu(k,534) * lu(k,1461) + lu(k,1716) = lu(k,1716) - lu(k,530) * lu(k,1656) + lu(k,1719) = lu(k,1719) - lu(k,531) * lu(k,1656) + lu(k,1720) = lu(k,1720) - lu(k,532) * lu(k,1656) + lu(k,1726) = lu(k,1726) - lu(k,533) * lu(k,1656) + lu(k,1728) = lu(k,1728) - lu(k,534) * lu(k,1656) + lu(k,1778) = lu(k,1778) - lu(k,530) * lu(k,1743) + lu(k,1781) = lu(k,1781) - lu(k,531) * lu(k,1743) + lu(k,1782) = lu(k,1782) - lu(k,532) * lu(k,1743) + lu(k,1788) = lu(k,1788) - lu(k,533) * lu(k,1743) + lu(k,1790) = lu(k,1790) - lu(k,534) * lu(k,1743) + lu(k,1984) = lu(k,1984) - lu(k,530) * lu(k,1965) + lu(k,1987) = lu(k,1987) - lu(k,531) * lu(k,1965) + lu(k,1988) = lu(k,1988) - lu(k,532) * lu(k,1965) + lu(k,1994) = lu(k,1994) - lu(k,533) * lu(k,1965) + lu(k,1996) = lu(k,1996) - lu(k,534) * lu(k,1965) + lu(k,2103) = lu(k,2103) - lu(k,530) * lu(k,2056) + lu(k,2106) = lu(k,2106) - lu(k,531) * lu(k,2056) + lu(k,2107) = lu(k,2107) - lu(k,532) * lu(k,2056) + lu(k,2113) = lu(k,2113) - lu(k,533) * lu(k,2056) + lu(k,2115) = lu(k,2115) - lu(k,534) * lu(k,2056) + lu(k,536) = 1._r8 / lu(k,536) + lu(k,537) = lu(k,537) * lu(k,536) + lu(k,538) = lu(k,538) * lu(k,536) + lu(k,539) = lu(k,539) * lu(k,536) + lu(k,540) = lu(k,540) * lu(k,536) + lu(k,541) = lu(k,541) * lu(k,536) + lu(k,542) = lu(k,542) * lu(k,536) + lu(k,543) = lu(k,543) * lu(k,536) + lu(k,544) = lu(k,544) * lu(k,536) + lu(k,545) = lu(k,545) * lu(k,536) + lu(k,878) = lu(k,878) - lu(k,537) * lu(k,876) + lu(k,879) = lu(k,879) - lu(k,538) * lu(k,876) + lu(k,881) = lu(k,881) - lu(k,539) * lu(k,876) + lu(k,882) = lu(k,882) - lu(k,540) * lu(k,876) + lu(k,883) = lu(k,883) - lu(k,541) * lu(k,876) + lu(k,887) = lu(k,887) - lu(k,542) * lu(k,876) + lu(k,888) = lu(k,888) - lu(k,543) * lu(k,876) + lu(k,889) = lu(k,889) - lu(k,544) * lu(k,876) + lu(k,890) = lu(k,890) - lu(k,545) * lu(k,876) + lu(k,1463) = lu(k,1463) - lu(k,537) * lu(k,1462) + lu(k,1479) = lu(k,1479) - lu(k,538) * lu(k,1462) + lu(k,1481) = lu(k,1481) - lu(k,539) * lu(k,1462) + lu(k,1493) = lu(k,1493) - lu(k,540) * lu(k,1462) + lu(k,1503) = lu(k,1503) - lu(k,541) * lu(k,1462) + lu(k,1510) = lu(k,1510) - lu(k,542) * lu(k,1462) + lu(k,1513) = lu(k,1513) - lu(k,543) * lu(k,1462) + lu(k,1517) = lu(k,1517) - lu(k,544) * lu(k,1462) + lu(k,1519) = lu(k,1519) - lu(k,545) * lu(k,1462) + lu(k,1659) = lu(k,1659) - lu(k,537) * lu(k,1657) + lu(k,1681) = lu(k,1681) - lu(k,538) * lu(k,1657) + lu(k,1685) = lu(k,1685) - lu(k,539) * lu(k,1657) + lu(k,1699) = lu(k,1699) - lu(k,540) * lu(k,1657) + lu(k,1710) = lu(k,1710) - lu(k,541) * lu(k,1657) + lu(k,1719) = lu(k,1719) - lu(k,542) * lu(k,1657) + lu(k,1722) = lu(k,1722) - lu(k,543) * lu(k,1657) + lu(k,1726) = lu(k,1726) - lu(k,544) * lu(k,1657) + lu(k,1728) = lu(k,1728) - lu(k,545) * lu(k,1657) + end do + end subroutine lu_fac12 + subroutine lu_fac13( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,547) = 1._r8 / lu(k,547) + lu(k,548) = lu(k,548) * lu(k,547) + lu(k,549) = lu(k,549) * lu(k,547) + lu(k,550) = lu(k,550) * lu(k,547) + lu(k,551) = lu(k,551) * lu(k,547) + lu(k,552) = lu(k,552) * lu(k,547) + lu(k,553) = lu(k,553) * lu(k,547) + lu(k,554) = lu(k,554) * lu(k,547) + lu(k,555) = lu(k,555) * lu(k,547) + lu(k,556) = lu(k,556) * lu(k,547) + lu(k,878) = lu(k,878) - lu(k,548) * lu(k,877) + lu(k,879) = lu(k,879) - lu(k,549) * lu(k,877) + lu(k,880) = lu(k,880) - lu(k,550) * lu(k,877) + lu(k,881) = lu(k,881) - lu(k,551) * lu(k,877) + lu(k,882) = lu(k,882) - lu(k,552) * lu(k,877) + lu(k,883) = lu(k,883) - lu(k,553) * lu(k,877) + lu(k,887) = lu(k,887) - lu(k,554) * lu(k,877) + lu(k,888) = lu(k,888) - lu(k,555) * lu(k,877) + lu(k,890) = lu(k,890) - lu(k,556) * lu(k,877) + lu(k,1659) = lu(k,1659) - lu(k,548) * lu(k,1658) + lu(k,1681) = lu(k,1681) - lu(k,549) * lu(k,1658) + lu(k,1683) = lu(k,1683) - lu(k,550) * lu(k,1658) + lu(k,1685) = lu(k,1685) - lu(k,551) * lu(k,1658) + lu(k,1699) = lu(k,1699) - lu(k,552) * lu(k,1658) + lu(k,1710) = lu(k,1710) - lu(k,553) * lu(k,1658) + lu(k,1719) = lu(k,1719) - lu(k,554) * lu(k,1658) + lu(k,1722) = lu(k,1722) - lu(k,555) * lu(k,1658) + lu(k,1728) = lu(k,1728) - lu(k,556) * lu(k,1658) + lu(k,2058) = lu(k,2058) - lu(k,548) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,549) * lu(k,2057) + lu(k,2076) = lu(k,2076) - lu(k,550) * lu(k,2057) + lu(k,2077) = lu(k,2077) - lu(k,551) * lu(k,2057) + lu(k,2087) = lu(k,2087) - lu(k,552) * lu(k,2057) + lu(k,2098) = lu(k,2098) - lu(k,553) * lu(k,2057) + lu(k,2106) = lu(k,2106) - lu(k,554) * lu(k,2057) + lu(k,2109) = lu(k,2109) - lu(k,555) * lu(k,2057) + lu(k,2115) = lu(k,2115) - lu(k,556) * lu(k,2057) + lu(k,558) = 1._r8 / lu(k,558) + lu(k,559) = lu(k,559) * lu(k,558) + lu(k,560) = lu(k,560) * lu(k,558) + lu(k,561) = lu(k,561) * lu(k,558) + lu(k,562) = lu(k,562) * lu(k,558) + lu(k,563) = lu(k,563) * lu(k,558) + lu(k,564) = lu(k,564) * lu(k,558) + lu(k,882) = lu(k,882) - lu(k,559) * lu(k,878) + lu(k,883) = lu(k,883) - lu(k,560) * lu(k,878) + lu(k,886) = lu(k,886) - lu(k,561) * lu(k,878) + lu(k,887) = lu(k,887) - lu(k,562) * lu(k,878) + lu(k,889) = lu(k,889) - lu(k,563) * lu(k,878) + lu(k,890) = lu(k,890) - lu(k,564) * lu(k,878) + lu(k,1493) = lu(k,1493) - lu(k,559) * lu(k,1463) + lu(k,1503) = lu(k,1503) - lu(k,560) * lu(k,1463) + lu(k,1507) = lu(k,1507) - lu(k,561) * lu(k,1463) + lu(k,1510) = lu(k,1510) - lu(k,562) * lu(k,1463) + lu(k,1517) = lu(k,1517) - lu(k,563) * lu(k,1463) + lu(k,1519) = lu(k,1519) - lu(k,564) * lu(k,1463) + lu(k,1699) = lu(k,1699) - lu(k,559) * lu(k,1659) + lu(k,1710) = lu(k,1710) - lu(k,560) * lu(k,1659) + lu(k,1716) = lu(k,1716) - lu(k,561) * lu(k,1659) + lu(k,1719) = lu(k,1719) - lu(k,562) * lu(k,1659) + lu(k,1726) = lu(k,1726) - lu(k,563) * lu(k,1659) + lu(k,1728) = lu(k,1728) - lu(k,564) * lu(k,1659) + lu(k,2087) = lu(k,2087) - lu(k,559) * lu(k,2058) + lu(k,2098) = lu(k,2098) - lu(k,560) * lu(k,2058) + lu(k,2103) = lu(k,2103) - lu(k,561) * lu(k,2058) + lu(k,2106) = lu(k,2106) - lu(k,562) * lu(k,2058) + lu(k,2113) = lu(k,2113) - lu(k,563) * lu(k,2058) + lu(k,2115) = lu(k,2115) - lu(k,564) * lu(k,2058) + lu(k,567) = 1._r8 / lu(k,567) + lu(k,568) = lu(k,568) * lu(k,567) + lu(k,569) = lu(k,569) * lu(k,567) + lu(k,570) = lu(k,570) * lu(k,567) + lu(k,571) = lu(k,571) * lu(k,567) + lu(k,572) = lu(k,572) * lu(k,567) + lu(k,573) = lu(k,573) * lu(k,567) + lu(k,574) = lu(k,574) * lu(k,567) + lu(k,575) = lu(k,575) * lu(k,567) + lu(k,576) = lu(k,576) * lu(k,567) + lu(k,699) = lu(k,699) - lu(k,568) * lu(k,698) + lu(k,700) = lu(k,700) - lu(k,569) * lu(k,698) + lu(k,701) = lu(k,701) - lu(k,570) * lu(k,698) + lu(k,702) = lu(k,702) - lu(k,571) * lu(k,698) + lu(k,703) = - lu(k,572) * lu(k,698) + lu(k,704) = lu(k,704) - lu(k,573) * lu(k,698) + lu(k,705) = lu(k,705) - lu(k,574) * lu(k,698) + lu(k,706) = lu(k,706) - lu(k,575) * lu(k,698) + lu(k,707) = lu(k,707) - lu(k,576) * lu(k,698) + lu(k,1418) = lu(k,1418) - lu(k,568) * lu(k,1416) + lu(k,1419) = lu(k,1419) - lu(k,569) * lu(k,1416) + lu(k,1420) = lu(k,1420) - lu(k,570) * lu(k,1416) + lu(k,1421) = lu(k,1421) - lu(k,571) * lu(k,1416) + lu(k,1424) = lu(k,1424) - lu(k,572) * lu(k,1416) + lu(k,1427) = lu(k,1427) - lu(k,573) * lu(k,1416) + lu(k,1428) = lu(k,1428) - lu(k,574) * lu(k,1416) + lu(k,1430) = lu(k,1430) - lu(k,575) * lu(k,1416) + lu(k,1433) = lu(k,1433) - lu(k,576) * lu(k,1416) + lu(k,1804) = lu(k,1804) - lu(k,568) * lu(k,1801) + lu(k,1805) = lu(k,1805) - lu(k,569) * lu(k,1801) + lu(k,1806) = lu(k,1806) - lu(k,570) * lu(k,1801) + lu(k,1807) = lu(k,1807) - lu(k,571) * lu(k,1801) + lu(k,1812) = lu(k,1812) - lu(k,572) * lu(k,1801) + lu(k,1818) = lu(k,1818) - lu(k,573) * lu(k,1801) + lu(k,1819) = lu(k,1819) - lu(k,574) * lu(k,1801) + lu(k,1821) = lu(k,1821) - lu(k,575) * lu(k,1801) + lu(k,1824) = lu(k,1824) - lu(k,576) * lu(k,1801) + lu(k,578) = 1._r8 / lu(k,578) + lu(k,579) = lu(k,579) * lu(k,578) + lu(k,580) = lu(k,580) * lu(k,578) + lu(k,581) = lu(k,581) * lu(k,578) + lu(k,582) = lu(k,582) * lu(k,578) + lu(k,583) = lu(k,583) * lu(k,578) + lu(k,584) = lu(k,584) * lu(k,578) + lu(k,1123) = - lu(k,579) * lu(k,1117) + lu(k,1125) = - lu(k,580) * lu(k,1117) + lu(k,1127) = - lu(k,581) * lu(k,1117) + lu(k,1131) = lu(k,1131) - lu(k,582) * lu(k,1117) + lu(k,1132) = lu(k,1132) - lu(k,583) * lu(k,1117) + lu(k,1137) = lu(k,1137) - lu(k,584) * lu(k,1117) + lu(k,1169) = - lu(k,579) * lu(k,1161) + lu(k,1170) = lu(k,1170) - lu(k,580) * lu(k,1161) + lu(k,1174) = lu(k,1174) - lu(k,581) * lu(k,1161) + lu(k,1179) = lu(k,1179) - lu(k,582) * lu(k,1161) + lu(k,1181) = lu(k,1181) - lu(k,583) * lu(k,1161) + lu(k,1186) = lu(k,1186) - lu(k,584) * lu(k,1161) + lu(k,1203) = lu(k,1203) - lu(k,579) * lu(k,1192) + lu(k,1204) = - lu(k,580) * lu(k,1192) + lu(k,1208) = - lu(k,581) * lu(k,1192) + lu(k,1213) = lu(k,1213) - lu(k,582) * lu(k,1192) + lu(k,1215) = lu(k,1215) - lu(k,583) * lu(k,1192) + lu(k,1220) = lu(k,1220) - lu(k,584) * lu(k,1192) + lu(k,1700) = lu(k,1700) - lu(k,579) * lu(k,1660) + lu(k,1703) = lu(k,1703) - lu(k,580) * lu(k,1660) + lu(k,1708) = lu(k,1708) - lu(k,581) * lu(k,1660) + lu(k,1719) = lu(k,1719) - lu(k,582) * lu(k,1660) + lu(k,1722) = lu(k,1722) - lu(k,583) * lu(k,1660) + lu(k,1728) = lu(k,1728) - lu(k,584) * lu(k,1660) + lu(k,2088) = lu(k,2088) - lu(k,579) * lu(k,2059) + lu(k,2091) = - lu(k,580) * lu(k,2059) + lu(k,2096) = - lu(k,581) * lu(k,2059) + lu(k,2106) = lu(k,2106) - lu(k,582) * lu(k,2059) + lu(k,2109) = lu(k,2109) - lu(k,583) * lu(k,2059) + lu(k,2115) = lu(k,2115) - lu(k,584) * lu(k,2059) + lu(k,589) = 1._r8 / lu(k,589) + lu(k,590) = lu(k,590) * lu(k,589) + lu(k,591) = lu(k,591) * lu(k,589) + lu(k,592) = lu(k,592) * lu(k,589) + lu(k,593) = lu(k,593) * lu(k,589) + lu(k,594) = lu(k,594) * lu(k,589) + lu(k,595) = lu(k,595) * lu(k,589) + lu(k,596) = lu(k,596) * lu(k,589) + lu(k,597) = lu(k,597) * lu(k,589) + lu(k,598) = lu(k,598) * lu(k,589) + lu(k,599) = lu(k,599) * lu(k,589) + lu(k,633) = lu(k,633) - lu(k,590) * lu(k,632) + lu(k,634) = lu(k,634) - lu(k,591) * lu(k,632) + lu(k,635) = lu(k,635) - lu(k,592) * lu(k,632) + lu(k,636) = lu(k,636) - lu(k,593) * lu(k,632) + lu(k,637) = lu(k,637) - lu(k,594) * lu(k,632) + lu(k,638) = lu(k,638) - lu(k,595) * lu(k,632) + lu(k,639) = lu(k,639) - lu(k,596) * lu(k,632) + lu(k,640) = lu(k,640) - lu(k,597) * lu(k,632) + lu(k,642) = - lu(k,598) * lu(k,632) + lu(k,644) = lu(k,644) - lu(k,599) * lu(k,632) + lu(k,1663) = lu(k,1663) - lu(k,590) * lu(k,1661) + lu(k,1665) = lu(k,1665) - lu(k,591) * lu(k,1661) + lu(k,1666) = lu(k,1666) - lu(k,592) * lu(k,1661) + lu(k,1678) = lu(k,1678) - lu(k,593) * lu(k,1661) + lu(k,1679) = lu(k,1679) - lu(k,594) * lu(k,1661) + lu(k,1694) = lu(k,1694) - lu(k,595) * lu(k,1661) + lu(k,1704) = lu(k,1704) - lu(k,596) * lu(k,1661) + lu(k,1710) = lu(k,1710) - lu(k,597) * lu(k,1661) + lu(k,1719) = lu(k,1719) - lu(k,598) * lu(k,1661) + lu(k,1728) = lu(k,1728) - lu(k,599) * lu(k,1661) + lu(k,2061) = lu(k,2061) - lu(k,590) * lu(k,2060) + lu(k,2063) = lu(k,2063) - lu(k,591) * lu(k,2060) + lu(k,2064) = lu(k,2064) - lu(k,592) * lu(k,2060) + lu(k,2073) = lu(k,2073) - lu(k,593) * lu(k,2060) + lu(k,2074) = lu(k,2074) - lu(k,594) * lu(k,2060) + lu(k,2082) = lu(k,2082) - lu(k,595) * lu(k,2060) + lu(k,2092) = lu(k,2092) - lu(k,596) * lu(k,2060) + lu(k,2098) = lu(k,2098) - lu(k,597) * lu(k,2060) + lu(k,2106) = lu(k,2106) - lu(k,598) * lu(k,2060) + lu(k,2115) = lu(k,2115) - lu(k,599) * lu(k,2060) + end do + end subroutine lu_fac13 + subroutine lu_fac14( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,600) = 1._r8 / lu(k,600) + lu(k,601) = lu(k,601) * lu(k,600) + lu(k,602) = lu(k,602) * lu(k,600) + lu(k,603) = lu(k,603) * lu(k,600) + lu(k,604) = lu(k,604) * lu(k,600) + lu(k,605) = lu(k,605) * lu(k,600) + lu(k,606) = lu(k,606) * lu(k,600) + lu(k,1318) = lu(k,1318) - lu(k,601) * lu(k,1316) + lu(k,1320) = lu(k,1320) - lu(k,602) * lu(k,1316) + lu(k,1323) = lu(k,1323) - lu(k,603) * lu(k,1316) + lu(k,1324) = lu(k,1324) - lu(k,604) * lu(k,1316) + lu(k,1325) = lu(k,1325) - lu(k,605) * lu(k,1316) + lu(k,1326) = lu(k,1326) - lu(k,606) * lu(k,1316) + lu(k,1425) = lu(k,1425) - lu(k,601) * lu(k,1417) + lu(k,1427) = lu(k,1427) - lu(k,602) * lu(k,1417) + lu(k,1431) = - lu(k,603) * lu(k,1417) + lu(k,1432) = lu(k,1432) - lu(k,604) * lu(k,1417) + lu(k,1433) = lu(k,1433) - lu(k,605) * lu(k,1417) + lu(k,1435) = lu(k,1435) - lu(k,606) * lu(k,1417) + lu(k,1711) = lu(k,1711) - lu(k,601) * lu(k,1662) + lu(k,1715) = lu(k,1715) - lu(k,602) * lu(k,1662) + lu(k,1719) = lu(k,1719) - lu(k,603) * lu(k,1662) + lu(k,1720) = lu(k,1720) - lu(k,604) * lu(k,1662) + lu(k,1721) = lu(k,1721) - lu(k,605) * lu(k,1662) + lu(k,1724) = lu(k,1724) - lu(k,606) * lu(k,1662) + lu(k,1774) = lu(k,1774) - lu(k,601) * lu(k,1744) + lu(k,1777) = lu(k,1777) - lu(k,602) * lu(k,1744) + lu(k,1781) = lu(k,1781) - lu(k,603) * lu(k,1744) + lu(k,1782) = lu(k,1782) - lu(k,604) * lu(k,1744) + lu(k,1783) = lu(k,1783) - lu(k,605) * lu(k,1744) + lu(k,1786) = lu(k,1786) - lu(k,606) * lu(k,1744) + lu(k,1814) = lu(k,1814) - lu(k,601) * lu(k,1802) + lu(k,1818) = lu(k,1818) - lu(k,602) * lu(k,1802) + lu(k,1822) = lu(k,1822) - lu(k,603) * lu(k,1802) + lu(k,1823) = lu(k,1823) - lu(k,604) * lu(k,1802) + lu(k,1824) = lu(k,1824) - lu(k,605) * lu(k,1802) + lu(k,1827) = lu(k,1827) - lu(k,606) * lu(k,1802) + lu(k,607) = 1._r8 / lu(k,607) + lu(k,608) = lu(k,608) * lu(k,607) + lu(k,609) = lu(k,609) * lu(k,607) + lu(k,610) = lu(k,610) * lu(k,607) + lu(k,611) = lu(k,611) * lu(k,607) + lu(k,612) = lu(k,612) * lu(k,607) + lu(k,620) = lu(k,620) - lu(k,608) * lu(k,617) + lu(k,622) = lu(k,622) - lu(k,609) * lu(k,617) + lu(k,624) = lu(k,624) - lu(k,610) * lu(k,617) + lu(k,626) = lu(k,626) - lu(k,611) * lu(k,617) + lu(k,627) = lu(k,627) - lu(k,612) * lu(k,617) + lu(k,636) = lu(k,636) - lu(k,608) * lu(k,633) + lu(k,638) = lu(k,638) - lu(k,609) * lu(k,633) + lu(k,641) = lu(k,641) - lu(k,610) * lu(k,633) + lu(k,643) = lu(k,643) - lu(k,611) * lu(k,633) + lu(k,644) = lu(k,644) - lu(k,612) * lu(k,633) + lu(k,1477) = lu(k,1477) - lu(k,608) * lu(k,1464) + lu(k,1488) = lu(k,1488) - lu(k,609) * lu(k,1464) + lu(k,1507) = lu(k,1507) - lu(k,610) * lu(k,1464) + lu(k,1517) = lu(k,1517) - lu(k,611) * lu(k,1464) + lu(k,1519) = lu(k,1519) - lu(k,612) * lu(k,1464) + lu(k,1678) = lu(k,1678) - lu(k,608) * lu(k,1663) + lu(k,1694) = lu(k,1694) - lu(k,609) * lu(k,1663) + lu(k,1716) = lu(k,1716) - lu(k,610) * lu(k,1663) + lu(k,1726) = lu(k,1726) - lu(k,611) * lu(k,1663) + lu(k,1728) = lu(k,1728) - lu(k,612) * lu(k,1663) + lu(k,1970) = - lu(k,608) * lu(k,1966) + lu(k,1975) = - lu(k,609) * lu(k,1966) + lu(k,1984) = lu(k,1984) - lu(k,610) * lu(k,1966) + lu(k,1994) = lu(k,1994) - lu(k,611) * lu(k,1966) + lu(k,1996) = lu(k,1996) - lu(k,612) * lu(k,1966) + lu(k,2073) = lu(k,2073) - lu(k,608) * lu(k,2061) + lu(k,2082) = lu(k,2082) - lu(k,609) * lu(k,2061) + lu(k,2103) = lu(k,2103) - lu(k,610) * lu(k,2061) + lu(k,2113) = lu(k,2113) - lu(k,611) * lu(k,2061) + lu(k,2115) = lu(k,2115) - lu(k,612) * lu(k,2061) + lu(k,618) = 1._r8 / lu(k,618) + lu(k,619) = lu(k,619) * lu(k,618) + lu(k,620) = lu(k,620) * lu(k,618) + lu(k,621) = lu(k,621) * lu(k,618) + lu(k,622) = lu(k,622) * lu(k,618) + lu(k,623) = lu(k,623) * lu(k,618) + lu(k,624) = lu(k,624) * lu(k,618) + lu(k,625) = lu(k,625) * lu(k,618) + lu(k,626) = lu(k,626) * lu(k,618) + lu(k,627) = lu(k,627) * lu(k,618) + lu(k,1467) = lu(k,1467) - lu(k,619) * lu(k,1465) + lu(k,1477) = lu(k,1477) - lu(k,620) * lu(k,1465) + lu(k,1478) = lu(k,1478) - lu(k,621) * lu(k,1465) + lu(k,1488) = lu(k,1488) - lu(k,622) * lu(k,1465) + lu(k,1497) = lu(k,1497) - lu(k,623) * lu(k,1465) + lu(k,1507) = lu(k,1507) - lu(k,624) * lu(k,1465) + lu(k,1510) = lu(k,1510) - lu(k,625) * lu(k,1465) + lu(k,1517) = lu(k,1517) - lu(k,626) * lu(k,1465) + lu(k,1519) = lu(k,1519) - lu(k,627) * lu(k,1465) + lu(k,1666) = lu(k,1666) - lu(k,619) * lu(k,1664) + lu(k,1678) = lu(k,1678) - lu(k,620) * lu(k,1664) + lu(k,1679) = lu(k,1679) - lu(k,621) * lu(k,1664) + lu(k,1694) = lu(k,1694) - lu(k,622) * lu(k,1664) + lu(k,1704) = lu(k,1704) - lu(k,623) * lu(k,1664) + lu(k,1716) = lu(k,1716) - lu(k,624) * lu(k,1664) + lu(k,1719) = lu(k,1719) - lu(k,625) * lu(k,1664) + lu(k,1726) = lu(k,1726) - lu(k,626) * lu(k,1664) + lu(k,1728) = lu(k,1728) - lu(k,627) * lu(k,1664) + lu(k,2064) = lu(k,2064) - lu(k,619) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,620) * lu(k,2062) + lu(k,2074) = lu(k,2074) - lu(k,621) * lu(k,2062) + lu(k,2082) = lu(k,2082) - lu(k,622) * lu(k,2062) + lu(k,2092) = lu(k,2092) - lu(k,623) * lu(k,2062) + lu(k,2103) = lu(k,2103) - lu(k,624) * lu(k,2062) + lu(k,2106) = lu(k,2106) - lu(k,625) * lu(k,2062) + lu(k,2113) = lu(k,2113) - lu(k,626) * lu(k,2062) + lu(k,2115) = lu(k,2115) - lu(k,627) * lu(k,2062) + lu(k,634) = 1._r8 / lu(k,634) + lu(k,635) = lu(k,635) * lu(k,634) + lu(k,636) = lu(k,636) * lu(k,634) + lu(k,637) = lu(k,637) * lu(k,634) + lu(k,638) = lu(k,638) * lu(k,634) + lu(k,639) = lu(k,639) * lu(k,634) + lu(k,640) = lu(k,640) * lu(k,634) + lu(k,641) = lu(k,641) * lu(k,634) + lu(k,642) = lu(k,642) * lu(k,634) + lu(k,643) = lu(k,643) * lu(k,634) + lu(k,644) = lu(k,644) * lu(k,634) + lu(k,1467) = lu(k,1467) - lu(k,635) * lu(k,1466) + lu(k,1477) = lu(k,1477) - lu(k,636) * lu(k,1466) + lu(k,1478) = lu(k,1478) - lu(k,637) * lu(k,1466) + lu(k,1488) = lu(k,1488) - lu(k,638) * lu(k,1466) + lu(k,1497) = lu(k,1497) - lu(k,639) * lu(k,1466) + lu(k,1503) = lu(k,1503) - lu(k,640) * lu(k,1466) + lu(k,1507) = lu(k,1507) - lu(k,641) * lu(k,1466) + lu(k,1510) = lu(k,1510) - lu(k,642) * lu(k,1466) + lu(k,1517) = lu(k,1517) - lu(k,643) * lu(k,1466) + lu(k,1519) = lu(k,1519) - lu(k,644) * lu(k,1466) + lu(k,1666) = lu(k,1666) - lu(k,635) * lu(k,1665) + lu(k,1678) = lu(k,1678) - lu(k,636) * lu(k,1665) + lu(k,1679) = lu(k,1679) - lu(k,637) * lu(k,1665) + lu(k,1694) = lu(k,1694) - lu(k,638) * lu(k,1665) + lu(k,1704) = lu(k,1704) - lu(k,639) * lu(k,1665) + lu(k,1710) = lu(k,1710) - lu(k,640) * lu(k,1665) + lu(k,1716) = lu(k,1716) - lu(k,641) * lu(k,1665) + lu(k,1719) = lu(k,1719) - lu(k,642) * lu(k,1665) + lu(k,1726) = lu(k,1726) - lu(k,643) * lu(k,1665) + lu(k,1728) = lu(k,1728) - lu(k,644) * lu(k,1665) + lu(k,2064) = lu(k,2064) - lu(k,635) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,636) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,637) * lu(k,2063) + lu(k,2082) = lu(k,2082) - lu(k,638) * lu(k,2063) + lu(k,2092) = lu(k,2092) - lu(k,639) * lu(k,2063) + lu(k,2098) = lu(k,2098) - lu(k,640) * lu(k,2063) + lu(k,2103) = lu(k,2103) - lu(k,641) * lu(k,2063) + lu(k,2106) = lu(k,2106) - lu(k,642) * lu(k,2063) + lu(k,2113) = lu(k,2113) - lu(k,643) * lu(k,2063) + lu(k,2115) = lu(k,2115) - lu(k,644) * lu(k,2063) + lu(k,645) = 1._r8 / lu(k,645) + lu(k,646) = lu(k,646) * lu(k,645) + lu(k,647) = lu(k,647) * lu(k,645) + lu(k,648) = lu(k,648) * lu(k,645) + lu(k,649) = lu(k,649) * lu(k,645) + lu(k,650) = lu(k,650) * lu(k,645) + lu(k,651) = lu(k,651) * lu(k,645) + lu(k,652) = lu(k,652) * lu(k,645) + lu(k,1488) = lu(k,1488) - lu(k,646) * lu(k,1467) + lu(k,1497) = lu(k,1497) - lu(k,647) * lu(k,1467) + lu(k,1505) = lu(k,1505) - lu(k,648) * lu(k,1467) + lu(k,1507) = lu(k,1507) - lu(k,649) * lu(k,1467) + lu(k,1510) = lu(k,1510) - lu(k,650) * lu(k,1467) + lu(k,1517) = lu(k,1517) - lu(k,651) * lu(k,1467) + lu(k,1519) = lu(k,1519) - lu(k,652) * lu(k,1467) + lu(k,1694) = lu(k,1694) - lu(k,646) * lu(k,1666) + lu(k,1704) = lu(k,1704) - lu(k,647) * lu(k,1666) + lu(k,1714) = lu(k,1714) - lu(k,648) * lu(k,1666) + lu(k,1716) = lu(k,1716) - lu(k,649) * lu(k,1666) + lu(k,1719) = lu(k,1719) - lu(k,650) * lu(k,1666) + lu(k,1726) = lu(k,1726) - lu(k,651) * lu(k,1666) + lu(k,1728) = lu(k,1728) - lu(k,652) * lu(k,1666) + lu(k,1975) = lu(k,1975) - lu(k,646) * lu(k,1967) + lu(k,1976) = - lu(k,647) * lu(k,1967) + lu(k,1982) = lu(k,1982) - lu(k,648) * lu(k,1967) + lu(k,1984) = lu(k,1984) - lu(k,649) * lu(k,1967) + lu(k,1987) = lu(k,1987) - lu(k,650) * lu(k,1967) + lu(k,1994) = lu(k,1994) - lu(k,651) * lu(k,1967) + lu(k,1996) = lu(k,1996) - lu(k,652) * lu(k,1967) + lu(k,2082) = lu(k,2082) - lu(k,646) * lu(k,2064) + lu(k,2092) = lu(k,2092) - lu(k,647) * lu(k,2064) + lu(k,2101) = lu(k,2101) - lu(k,648) * lu(k,2064) + lu(k,2103) = lu(k,2103) - lu(k,649) * lu(k,2064) + lu(k,2106) = lu(k,2106) - lu(k,650) * lu(k,2064) + lu(k,2113) = lu(k,2113) - lu(k,651) * lu(k,2064) + lu(k,2115) = lu(k,2115) - lu(k,652) * lu(k,2064) + lu(k,654) = 1._r8 / lu(k,654) + lu(k,655) = lu(k,655) * lu(k,654) + lu(k,656) = lu(k,656) * lu(k,654) + lu(k,657) = lu(k,657) * lu(k,654) + lu(k,658) = lu(k,658) * lu(k,654) + lu(k,659) = lu(k,659) * lu(k,654) + lu(k,660) = lu(k,660) * lu(k,654) + lu(k,661) = lu(k,661) * lu(k,654) + lu(k,1337) = lu(k,1337) - lu(k,655) * lu(k,1334) + lu(k,1338) = lu(k,1338) - lu(k,656) * lu(k,1334) + lu(k,1339) = lu(k,1339) - lu(k,657) * lu(k,1334) + lu(k,1341) = lu(k,1341) - lu(k,658) * lu(k,1334) + lu(k,1342) = lu(k,1342) - lu(k,659) * lu(k,1334) + lu(k,1347) = - lu(k,660) * lu(k,1334) + lu(k,1349) = lu(k,1349) - lu(k,661) * lu(k,1334) + lu(k,1815) = lu(k,1815) - lu(k,655) * lu(k,1803) + lu(k,1816) = lu(k,1816) - lu(k,656) * lu(k,1803) + lu(k,1820) = lu(k,1820) - lu(k,657) * lu(k,1803) + lu(k,1822) = lu(k,1822) - lu(k,658) * lu(k,1803) + lu(k,1824) = lu(k,1824) - lu(k,659) * lu(k,1803) + lu(k,1830) = lu(k,1830) - lu(k,660) * lu(k,1803) + lu(k,1833) = lu(k,1833) - lu(k,661) * lu(k,1803) + lu(k,1980) = - lu(k,655) * lu(k,1968) + lu(k,1981) = lu(k,1981) - lu(k,656) * lu(k,1968) + lu(k,1985) = - lu(k,657) * lu(k,1968) + lu(k,1987) = lu(k,1987) - lu(k,658) * lu(k,1968) + lu(k,1989) = lu(k,1989) - lu(k,659) * lu(k,1968) + lu(k,1995) = lu(k,1995) - lu(k,660) * lu(k,1968) + lu(k,1998) = lu(k,1998) - lu(k,661) * lu(k,1968) + lu(k,2005) = - lu(k,655) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,656) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,657) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,658) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,659) * lu(k,2002) + lu(k,2019) = lu(k,2019) - lu(k,660) * lu(k,2002) + lu(k,2022) = - lu(k,661) * lu(k,2002) + lu(k,2099) = lu(k,2099) - lu(k,655) * lu(k,2065) + lu(k,2100) = lu(k,2100) - lu(k,656) * lu(k,2065) + lu(k,2104) = lu(k,2104) - lu(k,657) * lu(k,2065) + lu(k,2106) = lu(k,2106) - lu(k,658) * lu(k,2065) + lu(k,2108) = lu(k,2108) - lu(k,659) * lu(k,2065) + lu(k,2114) = lu(k,2114) - lu(k,660) * lu(k,2065) + lu(k,2117) = lu(k,2117) - lu(k,661) * lu(k,2065) + end do + end subroutine lu_fac14 + subroutine lu_fac15( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,664) = 1._r8 / lu(k,664) + lu(k,665) = lu(k,665) * lu(k,664) + lu(k,666) = lu(k,666) * lu(k,664) + lu(k,667) = lu(k,667) * lu(k,664) + lu(k,668) = lu(k,668) * lu(k,664) + lu(k,669) = lu(k,669) * lu(k,664) + lu(k,670) = lu(k,670) * lu(k,664) + lu(k,671) = lu(k,671) * lu(k,664) + lu(k,1484) = lu(k,1484) - lu(k,665) * lu(k,1468) + lu(k,1506) = lu(k,1506) - lu(k,666) * lu(k,1468) + lu(k,1507) = lu(k,1507) - lu(k,667) * lu(k,1468) + lu(k,1510) = lu(k,1510) - lu(k,668) * lu(k,1468) + lu(k,1513) = lu(k,1513) - lu(k,669) * lu(k,1468) + lu(k,1517) = lu(k,1517) - lu(k,670) * lu(k,1468) + lu(k,1519) = lu(k,1519) - lu(k,671) * lu(k,1468) + lu(k,1533) = - lu(k,665) * lu(k,1527) + lu(k,1541) = lu(k,1541) - lu(k,666) * lu(k,1527) + lu(k,1542) = - lu(k,667) * lu(k,1527) + lu(k,1545) = lu(k,1545) - lu(k,668) * lu(k,1527) + lu(k,1548) = lu(k,1548) - lu(k,669) * lu(k,1527) + lu(k,1552) = - lu(k,670) * lu(k,1527) + lu(k,1554) = lu(k,1554) - lu(k,671) * lu(k,1527) + lu(k,1690) = lu(k,1690) - lu(k,665) * lu(k,1667) + lu(k,1715) = lu(k,1715) - lu(k,666) * lu(k,1667) + lu(k,1716) = lu(k,1716) - lu(k,667) * lu(k,1667) + lu(k,1719) = lu(k,1719) - lu(k,668) * lu(k,1667) + lu(k,1722) = lu(k,1722) - lu(k,669) * lu(k,1667) + lu(k,1726) = lu(k,1726) - lu(k,670) * lu(k,1667) + lu(k,1728) = lu(k,1728) - lu(k,671) * lu(k,1667) + lu(k,1756) = - lu(k,665) * lu(k,1745) + lu(k,1777) = lu(k,1777) - lu(k,666) * lu(k,1745) + lu(k,1778) = lu(k,1778) - lu(k,667) * lu(k,1745) + lu(k,1781) = lu(k,1781) - lu(k,668) * lu(k,1745) + lu(k,1784) = lu(k,1784) - lu(k,669) * lu(k,1745) + lu(k,1788) = lu(k,1788) - lu(k,670) * lu(k,1745) + lu(k,1790) = lu(k,1790) - lu(k,671) * lu(k,1745) + lu(k,2079) = lu(k,2079) - lu(k,665) * lu(k,2066) + lu(k,2102) = lu(k,2102) - lu(k,666) * lu(k,2066) + lu(k,2103) = lu(k,2103) - lu(k,667) * lu(k,2066) + lu(k,2106) = lu(k,2106) - lu(k,668) * lu(k,2066) + lu(k,2109) = lu(k,2109) - lu(k,669) * lu(k,2066) + lu(k,2113) = lu(k,2113) - lu(k,670) * lu(k,2066) + lu(k,2115) = lu(k,2115) - lu(k,671) * lu(k,2066) + lu(k,673) = 1._r8 / lu(k,673) + lu(k,674) = lu(k,674) * lu(k,673) + lu(k,675) = lu(k,675) * lu(k,673) + lu(k,676) = lu(k,676) * lu(k,673) + lu(k,677) = lu(k,677) * lu(k,673) + lu(k,678) = lu(k,678) * lu(k,673) + lu(k,679) = lu(k,679) * lu(k,673) + lu(k,680) = lu(k,680) * lu(k,673) + lu(k,1104) = lu(k,1104) - lu(k,674) * lu(k,1103) + lu(k,1106) = - lu(k,675) * lu(k,1103) + lu(k,1109) = lu(k,1109) - lu(k,676) * lu(k,1103) + lu(k,1111) = - lu(k,677) * lu(k,1103) + lu(k,1112) = lu(k,1112) - lu(k,678) * lu(k,1103) + lu(k,1113) = - lu(k,679) * lu(k,1103) + lu(k,1114) = lu(k,1114) - lu(k,680) * lu(k,1103) + lu(k,1563) = lu(k,1563) - lu(k,674) * lu(k,1561) + lu(k,1566) = lu(k,1566) - lu(k,675) * lu(k,1561) + lu(k,1571) = lu(k,1571) - lu(k,676) * lu(k,1561) + lu(k,1575) = - lu(k,677) * lu(k,1561) + lu(k,1576) = lu(k,1576) - lu(k,678) * lu(k,1561) + lu(k,1577) = - lu(k,679) * lu(k,1561) + lu(k,1582) = lu(k,1582) - lu(k,680) * lu(k,1561) + lu(k,1701) = lu(k,1701) - lu(k,674) * lu(k,1668) + lu(k,1714) = lu(k,1714) - lu(k,675) * lu(k,1668) + lu(k,1719) = lu(k,1719) - lu(k,676) * lu(k,1668) + lu(k,1723) = lu(k,1723) - lu(k,677) * lu(k,1668) + lu(k,1724) = lu(k,1724) - lu(k,678) * lu(k,1668) + lu(k,1725) = lu(k,1725) - lu(k,679) * lu(k,1668) + lu(k,1730) = lu(k,1730) - lu(k,680) * lu(k,1668) + lu(k,1937) = - lu(k,674) * lu(k,1936) + lu(k,1940) = - lu(k,675) * lu(k,1936) + lu(k,1945) = lu(k,1945) - lu(k,676) * lu(k,1936) + lu(k,1949) = lu(k,1949) - lu(k,677) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,678) * lu(k,1936) + lu(k,1951) = lu(k,1951) - lu(k,679) * lu(k,1936) + lu(k,1956) = lu(k,1956) - lu(k,680) * lu(k,1936) + lu(k,2150) = lu(k,2150) - lu(k,674) * lu(k,2148) + lu(k,2154) = - lu(k,675) * lu(k,2148) + lu(k,2159) = lu(k,2159) - lu(k,676) * lu(k,2148) + lu(k,2163) = - lu(k,677) * lu(k,2148) + lu(k,2164) = lu(k,2164) - lu(k,678) * lu(k,2148) + lu(k,2165) = - lu(k,679) * lu(k,2148) + lu(k,2170) = lu(k,2170) - lu(k,680) * lu(k,2148) + lu(k,681) = 1._r8 / lu(k,681) + lu(k,682) = lu(k,682) * lu(k,681) + lu(k,683) = lu(k,683) * lu(k,681) + lu(k,684) = lu(k,684) * lu(k,681) + lu(k,685) = lu(k,685) * lu(k,681) + lu(k,686) = lu(k,686) * lu(k,681) + lu(k,687) = lu(k,687) * lu(k,681) + lu(k,688) = lu(k,688) * lu(k,681) + lu(k,700) = lu(k,700) - lu(k,682) * lu(k,699) + lu(k,701) = lu(k,701) - lu(k,683) * lu(k,699) + lu(k,702) = lu(k,702) - lu(k,684) * lu(k,699) + lu(k,704) = lu(k,704) - lu(k,685) * lu(k,699) + lu(k,705) = lu(k,705) - lu(k,686) * lu(k,699) + lu(k,706) = lu(k,706) - lu(k,687) * lu(k,699) + lu(k,707) = lu(k,707) - lu(k,688) * lu(k,699) + lu(k,742) = lu(k,742) - lu(k,682) * lu(k,741) + lu(k,743) = lu(k,743) - lu(k,683) * lu(k,741) + lu(k,744) = lu(k,744) - lu(k,684) * lu(k,741) + lu(k,746) = lu(k,746) - lu(k,685) * lu(k,741) + lu(k,747) = lu(k,747) - lu(k,686) * lu(k,741) + lu(k,748) = - lu(k,687) * lu(k,741) + lu(k,750) = lu(k,750) - lu(k,688) * lu(k,741) + lu(k,1419) = lu(k,1419) - lu(k,682) * lu(k,1418) + lu(k,1420) = lu(k,1420) - lu(k,683) * lu(k,1418) + lu(k,1421) = lu(k,1421) - lu(k,684) * lu(k,1418) + lu(k,1427) = lu(k,1427) - lu(k,685) * lu(k,1418) + lu(k,1428) = lu(k,1428) - lu(k,686) * lu(k,1418) + lu(k,1430) = lu(k,1430) - lu(k,687) * lu(k,1418) + lu(k,1433) = lu(k,1433) - lu(k,688) * lu(k,1418) + lu(k,1470) = lu(k,1470) - lu(k,682) * lu(k,1469) + lu(k,1471) = lu(k,1471) - lu(k,683) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,684) * lu(k,1469) + lu(k,1506) = lu(k,1506) - lu(k,685) * lu(k,1469) + lu(k,1507) = lu(k,1507) - lu(k,686) * lu(k,1469) + lu(k,1509) = - lu(k,687) * lu(k,1469) + lu(k,1512) = lu(k,1512) - lu(k,688) * lu(k,1469) + lu(k,1805) = lu(k,1805) - lu(k,682) * lu(k,1804) + lu(k,1806) = lu(k,1806) - lu(k,683) * lu(k,1804) + lu(k,1807) = lu(k,1807) - lu(k,684) * lu(k,1804) + lu(k,1818) = lu(k,1818) - lu(k,685) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,686) * lu(k,1804) + lu(k,1821) = lu(k,1821) - lu(k,687) * lu(k,1804) + lu(k,1824) = lu(k,1824) - lu(k,688) * lu(k,1804) + lu(k,690) = 1._r8 / lu(k,690) + lu(k,691) = lu(k,691) * lu(k,690) + lu(k,692) = lu(k,692) * lu(k,690) + lu(k,693) = lu(k,693) * lu(k,690) + lu(k,694) = lu(k,694) * lu(k,690) + lu(k,695) = lu(k,695) * lu(k,690) + lu(k,696) = lu(k,696) * lu(k,690) + lu(k,701) = lu(k,701) - lu(k,691) * lu(k,700) + lu(k,702) = lu(k,702) - lu(k,692) * lu(k,700) + lu(k,704) = lu(k,704) - lu(k,693) * lu(k,700) + lu(k,705) = lu(k,705) - lu(k,694) * lu(k,700) + lu(k,706) = lu(k,706) - lu(k,695) * lu(k,700) + lu(k,707) = lu(k,707) - lu(k,696) * lu(k,700) + lu(k,743) = lu(k,743) - lu(k,691) * lu(k,742) + lu(k,744) = lu(k,744) - lu(k,692) * lu(k,742) + lu(k,746) = lu(k,746) - lu(k,693) * lu(k,742) + lu(k,747) = lu(k,747) - lu(k,694) * lu(k,742) + lu(k,748) = lu(k,748) - lu(k,695) * lu(k,742) + lu(k,750) = lu(k,750) - lu(k,696) * lu(k,742) + lu(k,1420) = lu(k,1420) - lu(k,691) * lu(k,1419) + lu(k,1421) = lu(k,1421) - lu(k,692) * lu(k,1419) + lu(k,1427) = lu(k,1427) - lu(k,693) * lu(k,1419) + lu(k,1428) = lu(k,1428) - lu(k,694) * lu(k,1419) + lu(k,1430) = lu(k,1430) - lu(k,695) * lu(k,1419) + lu(k,1433) = lu(k,1433) - lu(k,696) * lu(k,1419) + lu(k,1471) = lu(k,1471) - lu(k,691) * lu(k,1470) + lu(k,1475) = lu(k,1475) - lu(k,692) * lu(k,1470) + lu(k,1506) = lu(k,1506) - lu(k,693) * lu(k,1470) + lu(k,1507) = lu(k,1507) - lu(k,694) * lu(k,1470) + lu(k,1509) = lu(k,1509) - lu(k,695) * lu(k,1470) + lu(k,1512) = lu(k,1512) - lu(k,696) * lu(k,1470) + lu(k,1806) = lu(k,1806) - lu(k,691) * lu(k,1805) + lu(k,1807) = lu(k,1807) - lu(k,692) * lu(k,1805) + lu(k,1818) = lu(k,1818) - lu(k,693) * lu(k,1805) + lu(k,1819) = lu(k,1819) - lu(k,694) * lu(k,1805) + lu(k,1821) = lu(k,1821) - lu(k,695) * lu(k,1805) + lu(k,1824) = lu(k,1824) - lu(k,696) * lu(k,1805) + lu(k,701) = 1._r8 / lu(k,701) + lu(k,702) = lu(k,702) * lu(k,701) + lu(k,703) = lu(k,703) * lu(k,701) + lu(k,704) = lu(k,704) * lu(k,701) + lu(k,705) = lu(k,705) * lu(k,701) + lu(k,706) = lu(k,706) * lu(k,701) + lu(k,707) = lu(k,707) * lu(k,701) + lu(k,744) = lu(k,744) - lu(k,702) * lu(k,743) + lu(k,745) = lu(k,745) - lu(k,703) * lu(k,743) + lu(k,746) = lu(k,746) - lu(k,704) * lu(k,743) + lu(k,747) = lu(k,747) - lu(k,705) * lu(k,743) + lu(k,748) = lu(k,748) - lu(k,706) * lu(k,743) + lu(k,750) = lu(k,750) - lu(k,707) * lu(k,743) + lu(k,1421) = lu(k,1421) - lu(k,702) * lu(k,1420) + lu(k,1424) = lu(k,1424) - lu(k,703) * lu(k,1420) + lu(k,1427) = lu(k,1427) - lu(k,704) * lu(k,1420) + lu(k,1428) = lu(k,1428) - lu(k,705) * lu(k,1420) + lu(k,1430) = lu(k,1430) - lu(k,706) * lu(k,1420) + lu(k,1433) = lu(k,1433) - lu(k,707) * lu(k,1420) + lu(k,1475) = lu(k,1475) - lu(k,702) * lu(k,1471) + lu(k,1488) = lu(k,1488) - lu(k,703) * lu(k,1471) + lu(k,1506) = lu(k,1506) - lu(k,704) * lu(k,1471) + lu(k,1507) = lu(k,1507) - lu(k,705) * lu(k,1471) + lu(k,1509) = lu(k,1509) - lu(k,706) * lu(k,1471) + lu(k,1512) = lu(k,1512) - lu(k,707) * lu(k,1471) + lu(k,1807) = lu(k,1807) - lu(k,702) * lu(k,1806) + lu(k,1812) = lu(k,1812) - lu(k,703) * lu(k,1806) + lu(k,1818) = lu(k,1818) - lu(k,704) * lu(k,1806) + lu(k,1819) = lu(k,1819) - lu(k,705) * lu(k,1806) + lu(k,1821) = lu(k,1821) - lu(k,706) * lu(k,1806) + lu(k,1824) = lu(k,1824) - lu(k,707) * lu(k,1806) + end do + end subroutine lu_fac15 + subroutine lu_fac16( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,708) = 1._r8 / lu(k,708) + lu(k,709) = lu(k,709) * lu(k,708) + lu(k,710) = lu(k,710) * lu(k,708) + lu(k,711) = lu(k,711) * lu(k,708) + lu(k,845) = lu(k,845) - lu(k,709) * lu(k,839) + lu(k,846) = lu(k,846) - lu(k,710) * lu(k,839) + lu(k,848) = lu(k,848) - lu(k,711) * lu(k,839) + lu(k,1015) = lu(k,1015) - lu(k,709) * lu(k,1003) + lu(k,1016) = lu(k,1016) - lu(k,710) * lu(k,1003) + lu(k,1021) = lu(k,1021) - lu(k,711) * lu(k,1003) + lu(k,1035) = lu(k,1035) - lu(k,709) * lu(k,1025) + lu(k,1036) = lu(k,1036) - lu(k,710) * lu(k,1025) + lu(k,1040) = lu(k,1040) - lu(k,711) * lu(k,1025) + lu(k,1054) = lu(k,1054) - lu(k,709) * lu(k,1044) + lu(k,1055) = lu(k,1055) - lu(k,710) * lu(k,1044) + lu(k,1060) = lu(k,1060) - lu(k,711) * lu(k,1044) + lu(k,1070) = lu(k,1070) - lu(k,709) * lu(k,1063) + lu(k,1071) = lu(k,1071) - lu(k,710) * lu(k,1063) + lu(k,1073) = lu(k,1073) - lu(k,711) * lu(k,1063) + lu(k,1096) = lu(k,1096) - lu(k,709) * lu(k,1086) + lu(k,1097) = lu(k,1097) - lu(k,710) * lu(k,1086) + lu(k,1101) = lu(k,1101) - lu(k,711) * lu(k,1086) + lu(k,1131) = lu(k,1131) - lu(k,709) * lu(k,1118) + lu(k,1132) = lu(k,1132) - lu(k,710) * lu(k,1118) + lu(k,1137) = lu(k,1137) - lu(k,711) * lu(k,1118) + lu(k,1179) = lu(k,1179) - lu(k,709) * lu(k,1162) + lu(k,1181) = lu(k,1181) - lu(k,710) * lu(k,1162) + lu(k,1186) = lu(k,1186) - lu(k,711) * lu(k,1162) + lu(k,1213) = lu(k,1213) - lu(k,709) * lu(k,1193) + lu(k,1215) = lu(k,1215) - lu(k,710) * lu(k,1193) + lu(k,1220) = lu(k,1220) - lu(k,711) * lu(k,1193) + lu(k,1236) = lu(k,1236) - lu(k,709) * lu(k,1223) + lu(k,1237) = lu(k,1237) - lu(k,710) * lu(k,1223) + lu(k,1242) = lu(k,1242) - lu(k,711) * lu(k,1223) + lu(k,1400) = lu(k,1400) - lu(k,709) * lu(k,1369) + lu(k,1402) = lu(k,1402) - lu(k,710) * lu(k,1369) + lu(k,1407) = lu(k,1407) - lu(k,711) * lu(k,1369) + lu(k,1719) = lu(k,1719) - lu(k,709) * lu(k,1669) + lu(k,1722) = lu(k,1722) - lu(k,710) * lu(k,1669) + lu(k,1728) = lu(k,1728) - lu(k,711) * lu(k,1669) + lu(k,712) = 1._r8 / lu(k,712) + lu(k,713) = lu(k,713) * lu(k,712) + lu(k,714) = lu(k,714) * lu(k,712) + lu(k,715) = lu(k,715) * lu(k,712) + lu(k,791) = lu(k,791) - lu(k,713) * lu(k,780) + lu(k,795) = lu(k,795) - lu(k,714) * lu(k,780) + lu(k,796) = - lu(k,715) * lu(k,780) + lu(k,831) = lu(k,831) - lu(k,713) * lu(k,818) + lu(k,835) = lu(k,835) - lu(k,714) * lu(k,818) + lu(k,836) = - lu(k,715) * lu(k,818) + lu(k,869) = lu(k,869) - lu(k,713) * lu(k,856) + lu(k,873) = lu(k,873) - lu(k,714) * lu(k,856) + lu(k,874) = - lu(k,715) * lu(k,856) + lu(k,952) = lu(k,952) - lu(k,713) * lu(k,940) + lu(k,957) = lu(k,957) - lu(k,714) * lu(k,940) + lu(k,958) = lu(k,958) - lu(k,715) * lu(k,940) + lu(k,1145) = lu(k,1145) - lu(k,713) * lu(k,1138) + lu(k,1149) = lu(k,1149) - lu(k,714) * lu(k,1138) + lu(k,1150) = lu(k,1150) - lu(k,715) * lu(k,1138) + lu(k,1257) = lu(k,1257) - lu(k,713) * lu(k,1244) + lu(k,1264) = lu(k,1264) - lu(k,714) * lu(k,1244) + lu(k,1265) = - lu(k,715) * lu(k,1244) + lu(k,1510) = lu(k,1510) - lu(k,713) * lu(k,1472) + lu(k,1519) = lu(k,1519) - lu(k,714) * lu(k,1472) + lu(k,1521) = - lu(k,715) * lu(k,1472) + lu(k,1545) = lu(k,1545) - lu(k,713) * lu(k,1528) + lu(k,1554) = lu(k,1554) - lu(k,714) * lu(k,1528) + lu(k,1556) = lu(k,1556) - lu(k,715) * lu(k,1528) + lu(k,1719) = lu(k,1719) - lu(k,713) * lu(k,1670) + lu(k,1728) = lu(k,1728) - lu(k,714) * lu(k,1670) + lu(k,1730) = lu(k,1730) - lu(k,715) * lu(k,1670) + lu(k,1781) = lu(k,1781) - lu(k,713) * lu(k,1746) + lu(k,1790) = lu(k,1790) - lu(k,714) * lu(k,1746) + lu(k,1792) = lu(k,1792) - lu(k,715) * lu(k,1746) + lu(k,1846) = lu(k,1846) - lu(k,713) * lu(k,1835) + lu(k,1855) = lu(k,1855) - lu(k,714) * lu(k,1835) + lu(k,1857) = lu(k,1857) - lu(k,715) * lu(k,1835) + lu(k,2106) = lu(k,2106) - lu(k,713) * lu(k,2067) + lu(k,2115) = lu(k,2115) - lu(k,714) * lu(k,2067) + lu(k,2117) = lu(k,2117) - lu(k,715) * lu(k,2067) + lu(k,717) = 1._r8 / lu(k,717) + lu(k,718) = lu(k,718) * lu(k,717) + lu(k,719) = lu(k,719) * lu(k,717) + lu(k,720) = lu(k,720) * lu(k,717) + lu(k,721) = lu(k,721) * lu(k,717) + lu(k,722) = lu(k,722) * lu(k,717) + lu(k,723) = lu(k,723) * lu(k,717) + lu(k,724) = lu(k,724) * lu(k,717) + lu(k,725) = lu(k,725) * lu(k,717) + lu(k,726) = lu(k,726) * lu(k,717) + lu(k,944) = - lu(k,718) * lu(k,941) + lu(k,946) = lu(k,946) - lu(k,719) * lu(k,941) + lu(k,950) = - lu(k,720) * lu(k,941) + lu(k,951) = - lu(k,721) * lu(k,941) + lu(k,952) = lu(k,952) - lu(k,722) * lu(k,941) + lu(k,954) = lu(k,954) - lu(k,723) * lu(k,941) + lu(k,956) = - lu(k,724) * lu(k,941) + lu(k,957) = lu(k,957) - lu(k,725) * lu(k,941) + lu(k,958) = lu(k,958) - lu(k,726) * lu(k,941) + lu(k,1487) = lu(k,1487) - lu(k,718) * lu(k,1473) + lu(k,1493) = lu(k,1493) - lu(k,719) * lu(k,1473) + lu(k,1506) = lu(k,1506) - lu(k,720) * lu(k,1473) + lu(k,1507) = lu(k,1507) - lu(k,721) * lu(k,1473) + lu(k,1510) = lu(k,1510) - lu(k,722) * lu(k,1473) + lu(k,1513) = lu(k,1513) - lu(k,723) * lu(k,1473) + lu(k,1517) = lu(k,1517) - lu(k,724) * lu(k,1473) + lu(k,1519) = lu(k,1519) - lu(k,725) * lu(k,1473) + lu(k,1521) = lu(k,1521) - lu(k,726) * lu(k,1473) + lu(k,1693) = lu(k,1693) - lu(k,718) * lu(k,1671) + lu(k,1699) = lu(k,1699) - lu(k,719) * lu(k,1671) + lu(k,1715) = lu(k,1715) - lu(k,720) * lu(k,1671) + lu(k,1716) = lu(k,1716) - lu(k,721) * lu(k,1671) + lu(k,1719) = lu(k,1719) - lu(k,722) * lu(k,1671) + lu(k,1722) = lu(k,1722) - lu(k,723) * lu(k,1671) + lu(k,1726) = lu(k,1726) - lu(k,724) * lu(k,1671) + lu(k,1728) = lu(k,1728) - lu(k,725) * lu(k,1671) + lu(k,1730) = lu(k,1730) - lu(k,726) * lu(k,1671) + lu(k,2081) = lu(k,2081) - lu(k,718) * lu(k,2068) + lu(k,2087) = lu(k,2087) - lu(k,719) * lu(k,2068) + lu(k,2102) = lu(k,2102) - lu(k,720) * lu(k,2068) + lu(k,2103) = lu(k,2103) - lu(k,721) * lu(k,2068) + lu(k,2106) = lu(k,2106) - lu(k,722) * lu(k,2068) + lu(k,2109) = lu(k,2109) - lu(k,723) * lu(k,2068) + lu(k,2113) = lu(k,2113) - lu(k,724) * lu(k,2068) + lu(k,2115) = lu(k,2115) - lu(k,725) * lu(k,2068) + lu(k,2117) = lu(k,2117) - lu(k,726) * lu(k,2068) + lu(k,728) = 1._r8 / lu(k,728) + lu(k,729) = lu(k,729) * lu(k,728) + lu(k,730) = lu(k,730) * lu(k,728) + lu(k,731) = lu(k,731) * lu(k,728) + lu(k,732) = lu(k,732) * lu(k,728) + lu(k,733) = lu(k,733) * lu(k,728) + lu(k,734) = lu(k,734) * lu(k,728) + lu(k,735) = lu(k,735) * lu(k,728) + lu(k,736) = lu(k,736) * lu(k,728) + lu(k,737) = lu(k,737) * lu(k,728) + lu(k,738) = lu(k,738) * lu(k,728) + lu(k,1374) = lu(k,1374) - lu(k,729) * lu(k,1370) + lu(k,1385) = lu(k,1385) - lu(k,730) * lu(k,1370) + lu(k,1396) = lu(k,1396) - lu(k,731) * lu(k,1370) + lu(k,1397) = lu(k,1397) - lu(k,732) * lu(k,1370) + lu(k,1398) = lu(k,1398) - lu(k,733) * lu(k,1370) + lu(k,1400) = lu(k,1400) - lu(k,734) * lu(k,1370) + lu(k,1402) = lu(k,1402) - lu(k,735) * lu(k,1370) + lu(k,1406) = lu(k,1406) - lu(k,736) * lu(k,1370) + lu(k,1407) = lu(k,1407) - lu(k,737) * lu(k,1370) + lu(k,1409) = lu(k,1409) - lu(k,738) * lu(k,1370) + lu(k,1481) = lu(k,1481) - lu(k,729) * lu(k,1474) + lu(k,1493) = lu(k,1493) - lu(k,730) * lu(k,1474) + lu(k,1505) = lu(k,1505) - lu(k,731) * lu(k,1474) + lu(k,1506) = lu(k,1506) - lu(k,732) * lu(k,1474) + lu(k,1507) = lu(k,1507) - lu(k,733) * lu(k,1474) + lu(k,1510) = lu(k,1510) - lu(k,734) * lu(k,1474) + lu(k,1513) = lu(k,1513) - lu(k,735) * lu(k,1474) + lu(k,1517) = lu(k,1517) - lu(k,736) * lu(k,1474) + lu(k,1519) = lu(k,1519) - lu(k,737) * lu(k,1474) + lu(k,1521) = lu(k,1521) - lu(k,738) * lu(k,1474) + lu(k,1685) = lu(k,1685) - lu(k,729) * lu(k,1672) + lu(k,1699) = lu(k,1699) - lu(k,730) * lu(k,1672) + lu(k,1714) = lu(k,1714) - lu(k,731) * lu(k,1672) + lu(k,1715) = lu(k,1715) - lu(k,732) * lu(k,1672) + lu(k,1716) = lu(k,1716) - lu(k,733) * lu(k,1672) + lu(k,1719) = lu(k,1719) - lu(k,734) * lu(k,1672) + lu(k,1722) = lu(k,1722) - lu(k,735) * lu(k,1672) + lu(k,1726) = lu(k,1726) - lu(k,736) * lu(k,1672) + lu(k,1728) = lu(k,1728) - lu(k,737) * lu(k,1672) + lu(k,1730) = lu(k,1730) - lu(k,738) * lu(k,1672) + lu(k,2077) = lu(k,2077) - lu(k,729) * lu(k,2069) + lu(k,2087) = lu(k,2087) - lu(k,730) * lu(k,2069) + lu(k,2101) = lu(k,2101) - lu(k,731) * lu(k,2069) + lu(k,2102) = lu(k,2102) - lu(k,732) * lu(k,2069) + lu(k,2103) = lu(k,2103) - lu(k,733) * lu(k,2069) + lu(k,2106) = lu(k,2106) - lu(k,734) * lu(k,2069) + lu(k,2109) = lu(k,2109) - lu(k,735) * lu(k,2069) + lu(k,2113) = lu(k,2113) - lu(k,736) * lu(k,2069) + lu(k,2115) = lu(k,2115) - lu(k,737) * lu(k,2069) + lu(k,2117) = lu(k,2117) - lu(k,738) * lu(k,2069) + lu(k,744) = 1._r8 / lu(k,744) + lu(k,745) = lu(k,745) * lu(k,744) + lu(k,746) = lu(k,746) * lu(k,744) + lu(k,747) = lu(k,747) * lu(k,744) + lu(k,748) = lu(k,748) * lu(k,744) + lu(k,749) = lu(k,749) * lu(k,744) + lu(k,750) = lu(k,750) * lu(k,744) + lu(k,751) = lu(k,751) * lu(k,744) + lu(k,752) = lu(k,752) * lu(k,744) + lu(k,1424) = lu(k,1424) - lu(k,745) * lu(k,1421) + lu(k,1427) = lu(k,1427) - lu(k,746) * lu(k,1421) + lu(k,1428) = lu(k,1428) - lu(k,747) * lu(k,1421) + lu(k,1430) = lu(k,1430) - lu(k,748) * lu(k,1421) + lu(k,1431) = lu(k,1431) - lu(k,749) * lu(k,1421) + lu(k,1433) = lu(k,1433) - lu(k,750) * lu(k,1421) + lu(k,1435) = lu(k,1435) - lu(k,751) * lu(k,1421) + lu(k,1436) = - lu(k,752) * lu(k,1421) + lu(k,1488) = lu(k,1488) - lu(k,745) * lu(k,1475) + lu(k,1506) = lu(k,1506) - lu(k,746) * lu(k,1475) + lu(k,1507) = lu(k,1507) - lu(k,747) * lu(k,1475) + lu(k,1509) = lu(k,1509) - lu(k,748) * lu(k,1475) + lu(k,1510) = lu(k,1510) - lu(k,749) * lu(k,1475) + lu(k,1512) = lu(k,1512) - lu(k,750) * lu(k,1475) + lu(k,1515) = - lu(k,751) * lu(k,1475) + lu(k,1517) = lu(k,1517) - lu(k,752) * lu(k,1475) + lu(k,1694) = lu(k,1694) - lu(k,745) * lu(k,1673) + lu(k,1715) = lu(k,1715) - lu(k,746) * lu(k,1673) + lu(k,1716) = lu(k,1716) - lu(k,747) * lu(k,1673) + lu(k,1718) = lu(k,1718) - lu(k,748) * lu(k,1673) + lu(k,1719) = lu(k,1719) - lu(k,749) * lu(k,1673) + lu(k,1721) = lu(k,1721) - lu(k,750) * lu(k,1673) + lu(k,1724) = lu(k,1724) - lu(k,751) * lu(k,1673) + lu(k,1726) = lu(k,1726) - lu(k,752) * lu(k,1673) + lu(k,1812) = lu(k,1812) - lu(k,745) * lu(k,1807) + lu(k,1818) = lu(k,1818) - lu(k,746) * lu(k,1807) + lu(k,1819) = lu(k,1819) - lu(k,747) * lu(k,1807) + lu(k,1821) = lu(k,1821) - lu(k,748) * lu(k,1807) + lu(k,1822) = lu(k,1822) - lu(k,749) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,750) * lu(k,1807) + lu(k,1827) = lu(k,1827) - lu(k,751) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,752) * lu(k,1807) + lu(k,1975) = lu(k,1975) - lu(k,745) * lu(k,1969) + lu(k,1983) = lu(k,1983) - lu(k,746) * lu(k,1969) + lu(k,1984) = lu(k,1984) - lu(k,747) * lu(k,1969) + lu(k,1986) = - lu(k,748) * lu(k,1969) + lu(k,1987) = lu(k,1987) - lu(k,749) * lu(k,1969) + lu(k,1989) = lu(k,1989) - lu(k,750) * lu(k,1969) + lu(k,1992) = - lu(k,751) * lu(k,1969) + lu(k,1994) = lu(k,1994) - lu(k,752) * lu(k,1969) + end do + end subroutine lu_fac16 + subroutine lu_fac17( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,753) = 1._r8 / lu(k,753) + lu(k,754) = lu(k,754) * lu(k,753) + lu(k,755) = lu(k,755) * lu(k,753) + lu(k,756) = lu(k,756) * lu(k,753) + lu(k,757) = lu(k,757) * lu(k,753) + lu(k,758) = lu(k,758) * lu(k,753) + lu(k,759) = lu(k,759) * lu(k,753) + lu(k,760) = lu(k,760) * lu(k,753) + lu(k,1352) = lu(k,1352) - lu(k,754) * lu(k,1350) + lu(k,1354) = - lu(k,755) * lu(k,1350) + lu(k,1355) = - lu(k,756) * lu(k,1350) + lu(k,1357) = - lu(k,757) * lu(k,1350) + lu(k,1359) = - lu(k,758) * lu(k,1350) + lu(k,1360) = lu(k,1360) - lu(k,759) * lu(k,1350) + lu(k,1362) = - lu(k,760) * lu(k,1350) + lu(k,1565) = lu(k,1565) - lu(k,754) * lu(k,1562) + lu(k,1570) = lu(k,1570) - lu(k,755) * lu(k,1562) + lu(k,1571) = lu(k,1571) - lu(k,756) * lu(k,1562) + lu(k,1573) = lu(k,1573) - lu(k,757) * lu(k,1562) + lu(k,1576) = lu(k,1576) - lu(k,758) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,759) * lu(k,1562) + lu(k,1582) = lu(k,1582) - lu(k,760) * lu(k,1562) + lu(k,1713) = lu(k,1713) - lu(k,754) * lu(k,1674) + lu(k,1718) = lu(k,1718) - lu(k,755) * lu(k,1674) + lu(k,1719) = lu(k,1719) - lu(k,756) * lu(k,1674) + lu(k,1721) = lu(k,1721) - lu(k,757) * lu(k,1674) + lu(k,1724) = lu(k,1724) - lu(k,758) * lu(k,1674) + lu(k,1727) = lu(k,1727) - lu(k,759) * lu(k,1674) + lu(k,1730) = lu(k,1730) - lu(k,760) * lu(k,1674) + lu(k,1816) = lu(k,1816) - lu(k,754) * lu(k,1808) + lu(k,1821) = lu(k,1821) - lu(k,755) * lu(k,1808) + lu(k,1822) = lu(k,1822) - lu(k,756) * lu(k,1808) + lu(k,1824) = lu(k,1824) - lu(k,757) * lu(k,1808) + lu(k,1827) = lu(k,1827) - lu(k,758) * lu(k,1808) + lu(k,1830) = lu(k,1830) - lu(k,759) * lu(k,1808) + lu(k,1833) = lu(k,1833) - lu(k,760) * lu(k,1808) + lu(k,1840) = lu(k,1840) - lu(k,754) * lu(k,1836) + lu(k,1845) = - lu(k,755) * lu(k,1836) + lu(k,1846) = lu(k,1846) - lu(k,756) * lu(k,1836) + lu(k,1848) = lu(k,1848) - lu(k,757) * lu(k,1836) + lu(k,1851) = lu(k,1851) - lu(k,758) * lu(k,1836) + lu(k,1854) = - lu(k,759) * lu(k,1836) + lu(k,1857) = lu(k,1857) - lu(k,760) * lu(k,1836) + lu(k,2100) = lu(k,2100) - lu(k,754) * lu(k,2070) + lu(k,2105) = - lu(k,755) * lu(k,2070) + lu(k,2106) = lu(k,2106) - lu(k,756) * lu(k,2070) + lu(k,2108) = lu(k,2108) - lu(k,757) * lu(k,2070) + lu(k,2111) = lu(k,2111) - lu(k,758) * lu(k,2070) + lu(k,2114) = lu(k,2114) - lu(k,759) * lu(k,2070) + lu(k,2117) = lu(k,2117) - lu(k,760) * lu(k,2070) + lu(k,762) = 1._r8 / lu(k,762) + lu(k,763) = lu(k,763) * lu(k,762) + lu(k,764) = lu(k,764) * lu(k,762) + lu(k,765) = lu(k,765) * lu(k,762) + lu(k,766) = lu(k,766) * lu(k,762) + lu(k,767) = lu(k,767) * lu(k,762) + lu(k,768) = lu(k,768) * lu(k,762) + lu(k,907) = lu(k,907) - lu(k,763) * lu(k,905) + lu(k,908) = lu(k,908) - lu(k,764) * lu(k,905) + lu(k,909) = lu(k,909) - lu(k,765) * lu(k,905) + lu(k,910) = lu(k,910) - lu(k,766) * lu(k,905) + lu(k,914) = lu(k,914) - lu(k,767) * lu(k,905) + lu(k,915) = - lu(k,768) * lu(k,905) + lu(k,1337) = lu(k,1337) - lu(k,763) * lu(k,1335) + lu(k,1339) = lu(k,1339) - lu(k,764) * lu(k,1335) + lu(k,1341) = lu(k,1341) - lu(k,765) * lu(k,1335) + lu(k,1342) = lu(k,1342) - lu(k,766) * lu(k,1335) + lu(k,1348) = lu(k,1348) - lu(k,767) * lu(k,1335) + lu(k,1349) = lu(k,1349) - lu(k,768) * lu(k,1335) + lu(k,1538) = lu(k,1538) - lu(k,763) * lu(k,1529) + lu(k,1543) = lu(k,1543) - lu(k,764) * lu(k,1529) + lu(k,1545) = lu(k,1545) - lu(k,765) * lu(k,1529) + lu(k,1547) = lu(k,1547) - lu(k,766) * lu(k,1529) + lu(k,1555) = lu(k,1555) - lu(k,767) * lu(k,1529) + lu(k,1556) = lu(k,1556) - lu(k,768) * lu(k,1529) + lu(k,1712) = lu(k,1712) - lu(k,763) * lu(k,1675) + lu(k,1717) = lu(k,1717) - lu(k,764) * lu(k,1675) + lu(k,1719) = lu(k,1719) - lu(k,765) * lu(k,1675) + lu(k,1721) = lu(k,1721) - lu(k,766) * lu(k,1675) + lu(k,1729) = lu(k,1729) - lu(k,767) * lu(k,1675) + lu(k,1730) = lu(k,1730) - lu(k,768) * lu(k,1675) + lu(k,1815) = lu(k,1815) - lu(k,763) * lu(k,1809) + lu(k,1820) = lu(k,1820) - lu(k,764) * lu(k,1809) + lu(k,1822) = lu(k,1822) - lu(k,765) * lu(k,1809) + lu(k,1824) = lu(k,1824) - lu(k,766) * lu(k,1809) + lu(k,1832) = lu(k,1832) - lu(k,767) * lu(k,1809) + lu(k,1833) = lu(k,1833) - lu(k,768) * lu(k,1809) + lu(k,2099) = lu(k,2099) - lu(k,763) * lu(k,2071) + lu(k,2104) = lu(k,2104) - lu(k,764) * lu(k,2071) + lu(k,2106) = lu(k,2106) - lu(k,765) * lu(k,2071) + lu(k,2108) = lu(k,2108) - lu(k,766) * lu(k,2071) + lu(k,2116) = lu(k,2116) - lu(k,767) * lu(k,2071) + lu(k,2117) = lu(k,2117) - lu(k,768) * lu(k,2071) + lu(k,2126) = lu(k,2126) - lu(k,763) * lu(k,2122) + lu(k,2131) = lu(k,2131) - lu(k,764) * lu(k,2122) + lu(k,2133) = lu(k,2133) - lu(k,765) * lu(k,2122) + lu(k,2135) = lu(k,2135) - lu(k,766) * lu(k,2122) + lu(k,2143) = lu(k,2143) - lu(k,767) * lu(k,2122) + lu(k,2144) = - lu(k,768) * lu(k,2122) + lu(k,769) = 1._r8 / lu(k,769) + lu(k,770) = lu(k,770) * lu(k,769) + lu(k,771) = lu(k,771) * lu(k,769) + lu(k,772) = lu(k,772) * lu(k,769) + lu(k,773) = lu(k,773) * lu(k,769) + lu(k,774) = lu(k,774) * lu(k,769) + lu(k,930) = - lu(k,770) * lu(k,925) + lu(k,931) = - lu(k,771) * lu(k,925) + lu(k,934) = lu(k,934) - lu(k,772) * lu(k,925) + lu(k,935) = - lu(k,773) * lu(k,925) + lu(k,937) = lu(k,937) - lu(k,774) * lu(k,925) + lu(k,947) = - lu(k,770) * lu(k,942) + lu(k,948) = - lu(k,771) * lu(k,942) + lu(k,952) = lu(k,952) - lu(k,772) * lu(k,942) + lu(k,954) = lu(k,954) - lu(k,773) * lu(k,942) + lu(k,956) = lu(k,956) - lu(k,774) * lu(k,942) + lu(k,1126) = - lu(k,770) * lu(k,1119) + lu(k,1128) = lu(k,1128) - lu(k,771) * lu(k,1119) + lu(k,1131) = lu(k,1131) - lu(k,772) * lu(k,1119) + lu(k,1132) = lu(k,1132) - lu(k,773) * lu(k,1119) + lu(k,1136) = lu(k,1136) - lu(k,774) * lu(k,1119) + lu(k,1205) = lu(k,1205) - lu(k,770) * lu(k,1194) + lu(k,1210) = lu(k,1210) - lu(k,771) * lu(k,1194) + lu(k,1213) = lu(k,1213) - lu(k,772) * lu(k,1194) + lu(k,1215) = lu(k,1215) - lu(k,773) * lu(k,1194) + lu(k,1219) = lu(k,1219) - lu(k,774) * lu(k,1194) + lu(k,1389) = lu(k,1389) - lu(k,770) * lu(k,1371) + lu(k,1395) = lu(k,1395) - lu(k,771) * lu(k,1371) + lu(k,1400) = lu(k,1400) - lu(k,772) * lu(k,1371) + lu(k,1402) = lu(k,1402) - lu(k,773) * lu(k,1371) + lu(k,1406) = lu(k,1406) - lu(k,774) * lu(k,1371) + lu(k,1497) = lu(k,1497) - lu(k,770) * lu(k,1476) + lu(k,1503) = lu(k,1503) - lu(k,771) * lu(k,1476) + lu(k,1510) = lu(k,1510) - lu(k,772) * lu(k,1476) + lu(k,1513) = lu(k,1513) - lu(k,773) * lu(k,1476) + lu(k,1517) = lu(k,1517) - lu(k,774) * lu(k,1476) + lu(k,1704) = lu(k,1704) - lu(k,770) * lu(k,1676) + lu(k,1710) = lu(k,1710) - lu(k,771) * lu(k,1676) + lu(k,1719) = lu(k,1719) - lu(k,772) * lu(k,1676) + lu(k,1722) = lu(k,1722) - lu(k,773) * lu(k,1676) + lu(k,1726) = lu(k,1726) - lu(k,774) * lu(k,1676) + lu(k,1889) = lu(k,1889) - lu(k,770) * lu(k,1865) + lu(k,1895) = lu(k,1895) - lu(k,771) * lu(k,1865) + lu(k,1903) = lu(k,1903) - lu(k,772) * lu(k,1865) + lu(k,1906) = lu(k,1906) - lu(k,773) * lu(k,1865) + lu(k,1910) = lu(k,1910) - lu(k,774) * lu(k,1865) + lu(k,2092) = lu(k,2092) - lu(k,770) * lu(k,2072) + lu(k,2098) = lu(k,2098) - lu(k,771) * lu(k,2072) + lu(k,2106) = lu(k,2106) - lu(k,772) * lu(k,2072) + lu(k,2109) = lu(k,2109) - lu(k,773) * lu(k,2072) + lu(k,2113) = lu(k,2113) - lu(k,774) * lu(k,2072) + lu(k,781) = 1._r8 / lu(k,781) + lu(k,782) = lu(k,782) * lu(k,781) + lu(k,783) = lu(k,783) * lu(k,781) + lu(k,784) = lu(k,784) * lu(k,781) + lu(k,785) = lu(k,785) * lu(k,781) + lu(k,786) = lu(k,786) * lu(k,781) + lu(k,787) = lu(k,787) * lu(k,781) + lu(k,788) = lu(k,788) * lu(k,781) + lu(k,789) = lu(k,789) * lu(k,781) + lu(k,790) = lu(k,790) * lu(k,781) + lu(k,791) = lu(k,791) * lu(k,781) + lu(k,792) = lu(k,792) * lu(k,781) + lu(k,793) = lu(k,793) * lu(k,781) + lu(k,794) = lu(k,794) * lu(k,781) + lu(k,795) = lu(k,795) * lu(k,781) + lu(k,796) = lu(k,796) * lu(k,781) + lu(k,1689) = lu(k,1689) - lu(k,782) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,783) * lu(k,1677) + lu(k,1702) = - lu(k,784) * lu(k,1677) + lu(k,1703) = lu(k,1703) - lu(k,785) * lu(k,1677) + lu(k,1705) = lu(k,1705) - lu(k,786) * lu(k,1677) + lu(k,1706) = lu(k,1706) - lu(k,787) * lu(k,1677) + lu(k,1708) = lu(k,1708) - lu(k,788) * lu(k,1677) + lu(k,1710) = lu(k,1710) - lu(k,789) * lu(k,1677) + lu(k,1714) = lu(k,1714) - lu(k,790) * lu(k,1677) + lu(k,1719) = lu(k,1719) - lu(k,791) * lu(k,1677) + lu(k,1720) = lu(k,1720) - lu(k,792) * lu(k,1677) + lu(k,1722) = lu(k,1722) - lu(k,793) * lu(k,1677) + lu(k,1723) = lu(k,1723) - lu(k,794) * lu(k,1677) + lu(k,1728) = lu(k,1728) - lu(k,795) * lu(k,1677) + lu(k,1730) = lu(k,1730) - lu(k,796) * lu(k,1677) + lu(k,1755) = lu(k,1755) - lu(k,782) * lu(k,1747) + lu(k,1759) = lu(k,1759) - lu(k,783) * lu(k,1747) + lu(k,1765) = - lu(k,784) * lu(k,1747) + lu(k,1766) = lu(k,1766) - lu(k,785) * lu(k,1747) + lu(k,1768) = - lu(k,786) * lu(k,1747) + lu(k,1769) = - lu(k,787) * lu(k,1747) + lu(k,1771) = lu(k,1771) - lu(k,788) * lu(k,1747) + lu(k,1773) = lu(k,1773) - lu(k,789) * lu(k,1747) + lu(k,1776) = lu(k,1776) - lu(k,790) * lu(k,1747) + lu(k,1781) = lu(k,1781) - lu(k,791) * lu(k,1747) + lu(k,1782) = lu(k,1782) - lu(k,792) * lu(k,1747) + lu(k,1784) = lu(k,1784) - lu(k,793) * lu(k,1747) + lu(k,1785) = lu(k,1785) - lu(k,794) * lu(k,1747) + lu(k,1790) = lu(k,1790) - lu(k,795) * lu(k,1747) + lu(k,1792) = lu(k,1792) - lu(k,796) * lu(k,1747) + lu(k,1875) = lu(k,1875) - lu(k,782) * lu(k,1866) + lu(k,1880) = lu(k,1880) - lu(k,783) * lu(k,1866) + lu(k,1887) = lu(k,1887) - lu(k,784) * lu(k,1866) + lu(k,1888) = lu(k,1888) - lu(k,785) * lu(k,1866) + lu(k,1890) = lu(k,1890) - lu(k,786) * lu(k,1866) + lu(k,1891) = lu(k,1891) - lu(k,787) * lu(k,1866) + lu(k,1893) = lu(k,1893) - lu(k,788) * lu(k,1866) + lu(k,1895) = lu(k,1895) - lu(k,789) * lu(k,1866) + lu(k,1898) = - lu(k,790) * lu(k,1866) + lu(k,1903) = lu(k,1903) - lu(k,791) * lu(k,1866) + lu(k,1904) = - lu(k,792) * lu(k,1866) + lu(k,1906) = lu(k,1906) - lu(k,793) * lu(k,1866) + lu(k,1907) = lu(k,1907) - lu(k,794) * lu(k,1866) + lu(k,1912) = lu(k,1912) - lu(k,795) * lu(k,1866) + lu(k,1914) = - lu(k,796) * lu(k,1866) + end do + end subroutine lu_fac17 + subroutine lu_fac18( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,798) = 1._r8 / lu(k,798) + lu(k,799) = lu(k,799) * lu(k,798) + lu(k,800) = lu(k,800) * lu(k,798) + lu(k,801) = lu(k,801) * lu(k,798) + lu(k,804) = lu(k,804) - lu(k,799) * lu(k,802) + lu(k,808) = lu(k,808) - lu(k,800) * lu(k,802) + lu(k,810) = lu(k,810) - lu(k,801) * lu(k,802) + lu(k,825) = lu(k,825) - lu(k,799) * lu(k,819) + lu(k,831) = lu(k,831) - lu(k,800) * lu(k,819) + lu(k,835) = lu(k,835) - lu(k,801) * lu(k,819) + lu(k,863) = lu(k,863) - lu(k,799) * lu(k,857) + lu(k,869) = lu(k,869) - lu(k,800) * lu(k,857) + lu(k,873) = lu(k,873) - lu(k,801) * lu(k,857) + lu(k,929) = lu(k,929) - lu(k,799) * lu(k,926) + lu(k,934) = lu(k,934) - lu(k,800) * lu(k,926) + lu(k,938) = lu(k,938) - lu(k,801) * lu(k,926) + lu(k,961) = lu(k,961) - lu(k,799) * lu(k,959) + lu(k,962) = lu(k,962) - lu(k,800) * lu(k,959) + lu(k,964) = lu(k,964) - lu(k,801) * lu(k,959) + lu(k,1090) = lu(k,1090) - lu(k,799) * lu(k,1087) + lu(k,1096) = lu(k,1096) - lu(k,800) * lu(k,1087) + lu(k,1101) = lu(k,1101) - lu(k,801) * lu(k,1087) + lu(k,1200) = lu(k,1200) - lu(k,799) * lu(k,1195) + lu(k,1213) = lu(k,1213) - lu(k,800) * lu(k,1195) + lu(k,1220) = lu(k,1220) - lu(k,801) * lu(k,1195) + lu(k,1292) = lu(k,1292) - lu(k,799) * lu(k,1288) + lu(k,1306) = lu(k,1306) - lu(k,800) * lu(k,1288) + lu(k,1313) = lu(k,1313) - lu(k,801) * lu(k,1288) + lu(k,1380) = lu(k,1380) - lu(k,799) * lu(k,1372) + lu(k,1400) = lu(k,1400) - lu(k,800) * lu(k,1372) + lu(k,1407) = lu(k,1407) - lu(k,801) * lu(k,1372) + lu(k,1488) = lu(k,1488) - lu(k,799) * lu(k,1477) + lu(k,1510) = lu(k,1510) - lu(k,800) * lu(k,1477) + lu(k,1519) = lu(k,1519) - lu(k,801) * lu(k,1477) + lu(k,1534) = lu(k,1534) - lu(k,799) * lu(k,1530) + lu(k,1545) = lu(k,1545) - lu(k,800) * lu(k,1530) + lu(k,1554) = lu(k,1554) - lu(k,801) * lu(k,1530) + lu(k,1694) = lu(k,1694) - lu(k,799) * lu(k,1678) + lu(k,1719) = lu(k,1719) - lu(k,800) * lu(k,1678) + lu(k,1728) = lu(k,1728) - lu(k,801) * lu(k,1678) + lu(k,1759) = lu(k,1759) - lu(k,799) * lu(k,1748) + lu(k,1781) = lu(k,1781) - lu(k,800) * lu(k,1748) + lu(k,1790) = lu(k,1790) - lu(k,801) * lu(k,1748) + lu(k,1880) = lu(k,1880) - lu(k,799) * lu(k,1867) + lu(k,1903) = lu(k,1903) - lu(k,800) * lu(k,1867) + lu(k,1912) = lu(k,1912) - lu(k,801) * lu(k,1867) + lu(k,1975) = lu(k,1975) - lu(k,799) * lu(k,1970) + lu(k,1987) = lu(k,1987) - lu(k,800) * lu(k,1970) + lu(k,1996) = lu(k,1996) - lu(k,801) * lu(k,1970) + lu(k,2082) = lu(k,2082) - lu(k,799) * lu(k,2073) + lu(k,2106) = lu(k,2106) - lu(k,800) * lu(k,2073) + lu(k,2115) = lu(k,2115) - lu(k,801) * lu(k,2073) + lu(k,803) = 1._r8 / lu(k,803) + lu(k,804) = lu(k,804) * lu(k,803) + lu(k,805) = lu(k,805) * lu(k,803) + lu(k,806) = lu(k,806) * lu(k,803) + lu(k,807) = lu(k,807) * lu(k,803) + lu(k,808) = lu(k,808) * lu(k,803) + lu(k,809) = lu(k,809) * lu(k,803) + lu(k,810) = lu(k,810) * lu(k,803) + lu(k,929) = lu(k,929) - lu(k,804) * lu(k,927) + lu(k,930) = lu(k,930) - lu(k,805) * lu(k,927) + lu(k,932) = - lu(k,806) * lu(k,927) + lu(k,933) = - lu(k,807) * lu(k,927) + lu(k,934) = lu(k,934) - lu(k,808) * lu(k,927) + lu(k,937) = lu(k,937) - lu(k,809) * lu(k,927) + lu(k,938) = lu(k,938) - lu(k,810) * lu(k,927) + lu(k,1200) = lu(k,1200) - lu(k,804) * lu(k,1196) + lu(k,1205) = lu(k,1205) - lu(k,805) * lu(k,1196) + lu(k,1211) = lu(k,1211) - lu(k,806) * lu(k,1196) + lu(k,1212) = lu(k,1212) - lu(k,807) * lu(k,1196) + lu(k,1213) = lu(k,1213) - lu(k,808) * lu(k,1196) + lu(k,1219) = lu(k,1219) - lu(k,809) * lu(k,1196) + lu(k,1220) = lu(k,1220) - lu(k,810) * lu(k,1196) + lu(k,1488) = lu(k,1488) - lu(k,804) * lu(k,1478) + lu(k,1497) = lu(k,1497) - lu(k,805) * lu(k,1478) + lu(k,1505) = lu(k,1505) - lu(k,806) * lu(k,1478) + lu(k,1507) = lu(k,1507) - lu(k,807) * lu(k,1478) + lu(k,1510) = lu(k,1510) - lu(k,808) * lu(k,1478) + lu(k,1517) = lu(k,1517) - lu(k,809) * lu(k,1478) + lu(k,1519) = lu(k,1519) - lu(k,810) * lu(k,1478) + lu(k,1694) = lu(k,1694) - lu(k,804) * lu(k,1679) + lu(k,1704) = lu(k,1704) - lu(k,805) * lu(k,1679) + lu(k,1714) = lu(k,1714) - lu(k,806) * lu(k,1679) + lu(k,1716) = lu(k,1716) - lu(k,807) * lu(k,1679) + lu(k,1719) = lu(k,1719) - lu(k,808) * lu(k,1679) + lu(k,1726) = lu(k,1726) - lu(k,809) * lu(k,1679) + lu(k,1728) = lu(k,1728) - lu(k,810) * lu(k,1679) + lu(k,1975) = lu(k,1975) - lu(k,804) * lu(k,1971) + lu(k,1976) = lu(k,1976) - lu(k,805) * lu(k,1971) + lu(k,1982) = lu(k,1982) - lu(k,806) * lu(k,1971) + lu(k,1984) = lu(k,1984) - lu(k,807) * lu(k,1971) + lu(k,1987) = lu(k,1987) - lu(k,808) * lu(k,1971) + lu(k,1994) = lu(k,1994) - lu(k,809) * lu(k,1971) + lu(k,1996) = lu(k,1996) - lu(k,810) * lu(k,1971) + lu(k,2082) = lu(k,2082) - lu(k,804) * lu(k,2074) + lu(k,2092) = lu(k,2092) - lu(k,805) * lu(k,2074) + lu(k,2101) = lu(k,2101) - lu(k,806) * lu(k,2074) + lu(k,2103) = lu(k,2103) - lu(k,807) * lu(k,2074) + lu(k,2106) = lu(k,2106) - lu(k,808) * lu(k,2074) + lu(k,2113) = lu(k,2113) - lu(k,809) * lu(k,2074) + lu(k,2115) = lu(k,2115) - lu(k,810) * lu(k,2074) + lu(k,820) = 1._r8 / lu(k,820) + lu(k,821) = lu(k,821) * lu(k,820) + lu(k,822) = lu(k,822) * lu(k,820) + lu(k,823) = lu(k,823) * lu(k,820) + lu(k,824) = lu(k,824) * lu(k,820) + lu(k,825) = lu(k,825) * lu(k,820) + lu(k,826) = lu(k,826) * lu(k,820) + lu(k,827) = lu(k,827) * lu(k,820) + lu(k,828) = lu(k,828) * lu(k,820) + lu(k,829) = lu(k,829) * lu(k,820) + lu(k,830) = lu(k,830) * lu(k,820) + lu(k,831) = lu(k,831) * lu(k,820) + lu(k,832) = lu(k,832) * lu(k,820) + lu(k,833) = lu(k,833) * lu(k,820) + lu(k,834) = lu(k,834) * lu(k,820) + lu(k,835) = lu(k,835) * lu(k,820) + lu(k,836) = lu(k,836) * lu(k,820) + lu(k,1683) = lu(k,1683) - lu(k,821) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,822) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,823) * lu(k,1680) + lu(k,1692) = lu(k,1692) - lu(k,824) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,825) * lu(k,1680) + lu(k,1695) = lu(k,1695) - lu(k,826) * lu(k,1680) + lu(k,1697) = lu(k,1697) - lu(k,827) * lu(k,1680) + lu(k,1698) = lu(k,1698) - lu(k,828) * lu(k,1680) + lu(k,1704) = lu(k,1704) - lu(k,829) * lu(k,1680) + lu(k,1710) = lu(k,1710) - lu(k,830) * lu(k,1680) + lu(k,1719) = lu(k,1719) - lu(k,831) * lu(k,1680) + lu(k,1720) = lu(k,1720) - lu(k,832) * lu(k,1680) + lu(k,1722) = lu(k,1722) - lu(k,833) * lu(k,1680) + lu(k,1723) = lu(k,1723) - lu(k,834) * lu(k,1680) + lu(k,1728) = lu(k,1728) - lu(k,835) * lu(k,1680) + lu(k,1730) = lu(k,1730) - lu(k,836) * lu(k,1680) + lu(k,1751) = lu(k,1751) - lu(k,821) * lu(k,1749) + lu(k,1753) = lu(k,1753) - lu(k,822) * lu(k,1749) + lu(k,1754) = lu(k,1754) - lu(k,823) * lu(k,1749) + lu(k,1757) = lu(k,1757) - lu(k,824) * lu(k,1749) + lu(k,1759) = lu(k,1759) - lu(k,825) * lu(k,1749) + lu(k,1760) = - lu(k,826) * lu(k,1749) + lu(k,1762) = - lu(k,827) * lu(k,1749) + lu(k,1763) = lu(k,1763) - lu(k,828) * lu(k,1749) + lu(k,1767) = lu(k,1767) - lu(k,829) * lu(k,1749) + lu(k,1773) = lu(k,1773) - lu(k,830) * lu(k,1749) + lu(k,1781) = lu(k,1781) - lu(k,831) * lu(k,1749) + lu(k,1782) = lu(k,1782) - lu(k,832) * lu(k,1749) + lu(k,1784) = lu(k,1784) - lu(k,833) * lu(k,1749) + lu(k,1785) = lu(k,1785) - lu(k,834) * lu(k,1749) + lu(k,1790) = lu(k,1790) - lu(k,835) * lu(k,1749) + lu(k,1792) = lu(k,1792) - lu(k,836) * lu(k,1749) + lu(k,1870) = - lu(k,821) * lu(k,1868) + lu(k,1872) = lu(k,1872) - lu(k,822) * lu(k,1868) + lu(k,1873) = lu(k,1873) - lu(k,823) * lu(k,1868) + lu(k,1878) = - lu(k,824) * lu(k,1868) + lu(k,1880) = lu(k,1880) - lu(k,825) * lu(k,1868) + lu(k,1881) = - lu(k,826) * lu(k,1868) + lu(k,1883) = lu(k,1883) - lu(k,827) * lu(k,1868) + lu(k,1884) = - lu(k,828) * lu(k,1868) + lu(k,1889) = lu(k,1889) - lu(k,829) * lu(k,1868) + lu(k,1895) = lu(k,1895) - lu(k,830) * lu(k,1868) + lu(k,1903) = lu(k,1903) - lu(k,831) * lu(k,1868) + lu(k,1904) = lu(k,1904) - lu(k,832) * lu(k,1868) + lu(k,1906) = lu(k,1906) - lu(k,833) * lu(k,1868) + lu(k,1907) = lu(k,1907) - lu(k,834) * lu(k,1868) + lu(k,1912) = lu(k,1912) - lu(k,835) * lu(k,1868) + lu(k,1914) = lu(k,1914) - lu(k,836) * lu(k,1868) + lu(k,840) = 1._r8 / lu(k,840) + lu(k,841) = lu(k,841) * lu(k,840) + lu(k,842) = lu(k,842) * lu(k,840) + lu(k,843) = lu(k,843) * lu(k,840) + lu(k,844) = lu(k,844) * lu(k,840) + lu(k,845) = lu(k,845) * lu(k,840) + lu(k,846) = lu(k,846) * lu(k,840) + lu(k,847) = lu(k,847) * lu(k,840) + lu(k,848) = lu(k,848) * lu(k,840) + lu(k,882) = lu(k,882) - lu(k,841) * lu(k,879) + lu(k,884) = - lu(k,842) * lu(k,879) + lu(k,885) = - lu(k,843) * lu(k,879) + lu(k,886) = lu(k,886) - lu(k,844) * lu(k,879) + lu(k,887) = lu(k,887) - lu(k,845) * lu(k,879) + lu(k,888) = lu(k,888) - lu(k,846) * lu(k,879) + lu(k,889) = lu(k,889) - lu(k,847) * lu(k,879) + lu(k,890) = lu(k,890) - lu(k,848) * lu(k,879) + lu(k,1385) = lu(k,1385) - lu(k,841) * lu(k,1373) + lu(k,1396) = lu(k,1396) - lu(k,842) * lu(k,1373) + lu(k,1397) = lu(k,1397) - lu(k,843) * lu(k,1373) + lu(k,1398) = lu(k,1398) - lu(k,844) * lu(k,1373) + lu(k,1400) = lu(k,1400) - lu(k,845) * lu(k,1373) + lu(k,1402) = lu(k,1402) - lu(k,846) * lu(k,1373) + lu(k,1406) = lu(k,1406) - lu(k,847) * lu(k,1373) + lu(k,1407) = lu(k,1407) - lu(k,848) * lu(k,1373) + lu(k,1493) = lu(k,1493) - lu(k,841) * lu(k,1479) + lu(k,1505) = lu(k,1505) - lu(k,842) * lu(k,1479) + lu(k,1506) = lu(k,1506) - lu(k,843) * lu(k,1479) + lu(k,1507) = lu(k,1507) - lu(k,844) * lu(k,1479) + lu(k,1510) = lu(k,1510) - lu(k,845) * lu(k,1479) + lu(k,1513) = lu(k,1513) - lu(k,846) * lu(k,1479) + lu(k,1517) = lu(k,1517) - lu(k,847) * lu(k,1479) + lu(k,1519) = lu(k,1519) - lu(k,848) * lu(k,1479) + lu(k,1535) = - lu(k,841) * lu(k,1531) + lu(k,1540) = lu(k,1540) - lu(k,842) * lu(k,1531) + lu(k,1541) = lu(k,1541) - lu(k,843) * lu(k,1531) + lu(k,1542) = lu(k,1542) - lu(k,844) * lu(k,1531) + lu(k,1545) = lu(k,1545) - lu(k,845) * lu(k,1531) + lu(k,1548) = lu(k,1548) - lu(k,846) * lu(k,1531) + lu(k,1552) = lu(k,1552) - lu(k,847) * lu(k,1531) + lu(k,1554) = lu(k,1554) - lu(k,848) * lu(k,1531) + lu(k,1699) = lu(k,1699) - lu(k,841) * lu(k,1681) + lu(k,1714) = lu(k,1714) - lu(k,842) * lu(k,1681) + lu(k,1715) = lu(k,1715) - lu(k,843) * lu(k,1681) + lu(k,1716) = lu(k,1716) - lu(k,844) * lu(k,1681) + lu(k,1719) = lu(k,1719) - lu(k,845) * lu(k,1681) + lu(k,1722) = lu(k,1722) - lu(k,846) * lu(k,1681) + lu(k,1726) = lu(k,1726) - lu(k,847) * lu(k,1681) + lu(k,1728) = lu(k,1728) - lu(k,848) * lu(k,1681) + lu(k,2087) = lu(k,2087) - lu(k,841) * lu(k,2075) + lu(k,2101) = lu(k,2101) - lu(k,842) * lu(k,2075) + lu(k,2102) = lu(k,2102) - lu(k,843) * lu(k,2075) + lu(k,2103) = lu(k,2103) - lu(k,844) * lu(k,2075) + lu(k,2106) = lu(k,2106) - lu(k,845) * lu(k,2075) + lu(k,2109) = lu(k,2109) - lu(k,846) * lu(k,2075) + lu(k,2113) = lu(k,2113) - lu(k,847) * lu(k,2075) + lu(k,2115) = lu(k,2115) - lu(k,848) * lu(k,2075) + lu(k,858) = 1._r8 / lu(k,858) + lu(k,859) = lu(k,859) * lu(k,858) + lu(k,860) = lu(k,860) * lu(k,858) + lu(k,861) = lu(k,861) * lu(k,858) + lu(k,862) = lu(k,862) * lu(k,858) + lu(k,863) = lu(k,863) * lu(k,858) + lu(k,864) = lu(k,864) * lu(k,858) + lu(k,865) = lu(k,865) * lu(k,858) + lu(k,866) = lu(k,866) * lu(k,858) + lu(k,867) = lu(k,867) * lu(k,858) + lu(k,868) = lu(k,868) * lu(k,858) + lu(k,869) = lu(k,869) * lu(k,858) + lu(k,870) = lu(k,870) * lu(k,858) + lu(k,871) = lu(k,871) * lu(k,858) + lu(k,872) = lu(k,872) * lu(k,858) + lu(k,873) = lu(k,873) * lu(k,858) + lu(k,874) = lu(k,874) * lu(k,858) + lu(k,1683) = lu(k,1683) - lu(k,859) * lu(k,1682) + lu(k,1685) = lu(k,1685) - lu(k,860) * lu(k,1682) + lu(k,1687) = lu(k,1687) - lu(k,861) * lu(k,1682) + lu(k,1692) = lu(k,1692) - lu(k,862) * lu(k,1682) + lu(k,1694) = lu(k,1694) - lu(k,863) * lu(k,1682) + lu(k,1695) = lu(k,1695) - lu(k,864) * lu(k,1682) + lu(k,1697) = lu(k,1697) - lu(k,865) * lu(k,1682) + lu(k,1698) = lu(k,1698) - lu(k,866) * lu(k,1682) + lu(k,1704) = lu(k,1704) - lu(k,867) * lu(k,1682) + lu(k,1710) = lu(k,1710) - lu(k,868) * lu(k,1682) + lu(k,1719) = lu(k,1719) - lu(k,869) * lu(k,1682) + lu(k,1720) = lu(k,1720) - lu(k,870) * lu(k,1682) + lu(k,1722) = lu(k,1722) - lu(k,871) * lu(k,1682) + lu(k,1723) = lu(k,1723) - lu(k,872) * lu(k,1682) + lu(k,1728) = lu(k,1728) - lu(k,873) * lu(k,1682) + lu(k,1730) = lu(k,1730) - lu(k,874) * lu(k,1682) + lu(k,1751) = lu(k,1751) - lu(k,859) * lu(k,1750) + lu(k,1753) = lu(k,1753) - lu(k,860) * lu(k,1750) + lu(k,1754) = lu(k,1754) - lu(k,861) * lu(k,1750) + lu(k,1757) = lu(k,1757) - lu(k,862) * lu(k,1750) + lu(k,1759) = lu(k,1759) - lu(k,863) * lu(k,1750) + lu(k,1760) = lu(k,1760) - lu(k,864) * lu(k,1750) + lu(k,1762) = lu(k,1762) - lu(k,865) * lu(k,1750) + lu(k,1763) = lu(k,1763) - lu(k,866) * lu(k,1750) + lu(k,1767) = lu(k,1767) - lu(k,867) * lu(k,1750) + lu(k,1773) = lu(k,1773) - lu(k,868) * lu(k,1750) + lu(k,1781) = lu(k,1781) - lu(k,869) * lu(k,1750) + lu(k,1782) = lu(k,1782) - lu(k,870) * lu(k,1750) + lu(k,1784) = lu(k,1784) - lu(k,871) * lu(k,1750) + lu(k,1785) = lu(k,1785) - lu(k,872) * lu(k,1750) + lu(k,1790) = lu(k,1790) - lu(k,873) * lu(k,1750) + lu(k,1792) = lu(k,1792) - lu(k,874) * lu(k,1750) + lu(k,1870) = lu(k,1870) - lu(k,859) * lu(k,1869) + lu(k,1872) = lu(k,1872) - lu(k,860) * lu(k,1869) + lu(k,1873) = lu(k,1873) - lu(k,861) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,862) * lu(k,1869) + lu(k,1880) = lu(k,1880) - lu(k,863) * lu(k,1869) + lu(k,1881) = lu(k,1881) - lu(k,864) * lu(k,1869) + lu(k,1883) = lu(k,1883) - lu(k,865) * lu(k,1869) + lu(k,1884) = lu(k,1884) - lu(k,866) * lu(k,1869) + lu(k,1889) = lu(k,1889) - lu(k,867) * lu(k,1869) + lu(k,1895) = lu(k,1895) - lu(k,868) * lu(k,1869) + lu(k,1903) = lu(k,1903) - lu(k,869) * lu(k,1869) + lu(k,1904) = lu(k,1904) - lu(k,870) * lu(k,1869) + lu(k,1906) = lu(k,1906) - lu(k,871) * lu(k,1869) + lu(k,1907) = lu(k,1907) - lu(k,872) * lu(k,1869) + lu(k,1912) = lu(k,1912) - lu(k,873) * lu(k,1869) + lu(k,1914) = lu(k,1914) - lu(k,874) * lu(k,1869) + end do + end subroutine lu_fac18 + subroutine lu_fac19( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,880) = 1._r8 / lu(k,880) + lu(k,881) = lu(k,881) * lu(k,880) + lu(k,882) = lu(k,882) * lu(k,880) + lu(k,883) = lu(k,883) * lu(k,880) + lu(k,884) = lu(k,884) * lu(k,880) + lu(k,885) = lu(k,885) * lu(k,880) + lu(k,886) = lu(k,886) * lu(k,880) + lu(k,887) = lu(k,887) * lu(k,880) + lu(k,888) = lu(k,888) * lu(k,880) + lu(k,889) = lu(k,889) * lu(k,880) + lu(k,890) = lu(k,890) * lu(k,880) + lu(k,1481) = lu(k,1481) - lu(k,881) * lu(k,1480) + lu(k,1493) = lu(k,1493) - lu(k,882) * lu(k,1480) + lu(k,1503) = lu(k,1503) - lu(k,883) * lu(k,1480) + lu(k,1505) = lu(k,1505) - lu(k,884) * lu(k,1480) + lu(k,1506) = lu(k,1506) - lu(k,885) * lu(k,1480) + lu(k,1507) = lu(k,1507) - lu(k,886) * lu(k,1480) + lu(k,1510) = lu(k,1510) - lu(k,887) * lu(k,1480) + lu(k,1513) = lu(k,1513) - lu(k,888) * lu(k,1480) + lu(k,1517) = lu(k,1517) - lu(k,889) * lu(k,1480) + lu(k,1519) = lu(k,1519) - lu(k,890) * lu(k,1480) + lu(k,1685) = lu(k,1685) - lu(k,881) * lu(k,1683) + lu(k,1699) = lu(k,1699) - lu(k,882) * lu(k,1683) + lu(k,1710) = lu(k,1710) - lu(k,883) * lu(k,1683) + lu(k,1714) = lu(k,1714) - lu(k,884) * lu(k,1683) + lu(k,1715) = lu(k,1715) - lu(k,885) * lu(k,1683) + lu(k,1716) = lu(k,1716) - lu(k,886) * lu(k,1683) + lu(k,1719) = lu(k,1719) - lu(k,887) * lu(k,1683) + lu(k,1722) = lu(k,1722) - lu(k,888) * lu(k,1683) + lu(k,1726) = lu(k,1726) - lu(k,889) * lu(k,1683) + lu(k,1728) = lu(k,1728) - lu(k,890) * lu(k,1683) + lu(k,1753) = lu(k,1753) - lu(k,881) * lu(k,1751) + lu(k,1764) = lu(k,1764) - lu(k,882) * lu(k,1751) + lu(k,1773) = lu(k,1773) - lu(k,883) * lu(k,1751) + lu(k,1776) = lu(k,1776) - lu(k,884) * lu(k,1751) + lu(k,1777) = lu(k,1777) - lu(k,885) * lu(k,1751) + lu(k,1778) = lu(k,1778) - lu(k,886) * lu(k,1751) + lu(k,1781) = lu(k,1781) - lu(k,887) * lu(k,1751) + lu(k,1784) = lu(k,1784) - lu(k,888) * lu(k,1751) + lu(k,1788) = lu(k,1788) - lu(k,889) * lu(k,1751) + lu(k,1790) = lu(k,1790) - lu(k,890) * lu(k,1751) + lu(k,1872) = lu(k,1872) - lu(k,881) * lu(k,1870) + lu(k,1885) = lu(k,1885) - lu(k,882) * lu(k,1870) + lu(k,1895) = lu(k,1895) - lu(k,883) * lu(k,1870) + lu(k,1898) = lu(k,1898) - lu(k,884) * lu(k,1870) + lu(k,1899) = lu(k,1899) - lu(k,885) * lu(k,1870) + lu(k,1900) = lu(k,1900) - lu(k,886) * lu(k,1870) + lu(k,1903) = lu(k,1903) - lu(k,887) * lu(k,1870) + lu(k,1906) = lu(k,1906) - lu(k,888) * lu(k,1870) + lu(k,1910) = lu(k,1910) - lu(k,889) * lu(k,1870) + lu(k,1912) = lu(k,1912) - lu(k,890) * lu(k,1870) + lu(k,2077) = lu(k,2077) - lu(k,881) * lu(k,2076) + lu(k,2087) = lu(k,2087) - lu(k,882) * lu(k,2076) + lu(k,2098) = lu(k,2098) - lu(k,883) * lu(k,2076) + lu(k,2101) = lu(k,2101) - lu(k,884) * lu(k,2076) + lu(k,2102) = lu(k,2102) - lu(k,885) * lu(k,2076) + lu(k,2103) = lu(k,2103) - lu(k,886) * lu(k,2076) + lu(k,2106) = lu(k,2106) - lu(k,887) * lu(k,2076) + lu(k,2109) = lu(k,2109) - lu(k,888) * lu(k,2076) + lu(k,2113) = lu(k,2113) - lu(k,889) * lu(k,2076) + lu(k,2115) = lu(k,2115) - lu(k,890) * lu(k,2076) + lu(k,892) = 1._r8 / lu(k,892) + lu(k,893) = lu(k,893) * lu(k,892) + lu(k,894) = lu(k,894) * lu(k,892) + lu(k,895) = lu(k,895) * lu(k,892) + lu(k,896) = lu(k,896) * lu(k,892) + lu(k,897) = lu(k,897) * lu(k,892) + lu(k,1318) = lu(k,1318) - lu(k,893) * lu(k,1317) + lu(k,1323) = lu(k,1323) - lu(k,894) * lu(k,1317) + lu(k,1325) = lu(k,1325) - lu(k,895) * lu(k,1317) + lu(k,1329) = - lu(k,896) * lu(k,1317) + lu(k,1331) = - lu(k,897) * lu(k,1317) + lu(k,1425) = lu(k,1425) - lu(k,893) * lu(k,1422) + lu(k,1431) = lu(k,1431) - lu(k,894) * lu(k,1422) + lu(k,1433) = lu(k,1433) - lu(k,895) * lu(k,1422) + lu(k,1438) = lu(k,1438) - lu(k,896) * lu(k,1422) + lu(k,1440) = - lu(k,897) * lu(k,1422) + lu(k,1711) = lu(k,1711) - lu(k,893) * lu(k,1684) + lu(k,1719) = lu(k,1719) - lu(k,894) * lu(k,1684) + lu(k,1721) = lu(k,1721) - lu(k,895) * lu(k,1684) + lu(k,1728) = lu(k,1728) - lu(k,896) * lu(k,1684) + lu(k,1730) = lu(k,1730) - lu(k,897) * lu(k,1684) + lu(k,1774) = lu(k,1774) - lu(k,893) * lu(k,1752) + lu(k,1781) = lu(k,1781) - lu(k,894) * lu(k,1752) + lu(k,1783) = lu(k,1783) - lu(k,895) * lu(k,1752) + lu(k,1790) = lu(k,1790) - lu(k,896) * lu(k,1752) + lu(k,1792) = lu(k,1792) - lu(k,897) * lu(k,1752) + lu(k,1814) = lu(k,1814) - lu(k,893) * lu(k,1810) + lu(k,1822) = lu(k,1822) - lu(k,894) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,895) * lu(k,1810) + lu(k,1831) = lu(k,1831) - lu(k,896) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,897) * lu(k,1810) + lu(k,1896) = - lu(k,893) * lu(k,1871) + lu(k,1903) = lu(k,1903) - lu(k,894) * lu(k,1871) + lu(k,1905) = lu(k,1905) - lu(k,895) * lu(k,1871) + lu(k,1912) = lu(k,1912) - lu(k,896) * lu(k,1871) + lu(k,1914) = lu(k,1914) - lu(k,897) * lu(k,1871) + lu(k,1979) = lu(k,1979) - lu(k,893) * lu(k,1972) + lu(k,1987) = lu(k,1987) - lu(k,894) * lu(k,1972) + lu(k,1989) = lu(k,1989) - lu(k,895) * lu(k,1972) + lu(k,1996) = lu(k,1996) - lu(k,896) * lu(k,1972) + lu(k,1998) = lu(k,1998) - lu(k,897) * lu(k,1972) + lu(k,2004) = lu(k,2004) - lu(k,893) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,894) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,895) * lu(k,2003) + lu(k,2020) = lu(k,2020) - lu(k,896) * lu(k,2003) + lu(k,2022) = lu(k,2022) - lu(k,897) * lu(k,2003) + lu(k,2125) = lu(k,2125) - lu(k,893) * lu(k,2123) + lu(k,2133) = lu(k,2133) - lu(k,894) * lu(k,2123) + lu(k,2135) = lu(k,2135) - lu(k,895) * lu(k,2123) + lu(k,2142) = lu(k,2142) - lu(k,896) * lu(k,2123) + lu(k,2144) = lu(k,2144) - lu(k,897) * lu(k,2123) + lu(k,2151) = - lu(k,893) * lu(k,2149) + lu(k,2159) = lu(k,2159) - lu(k,894) * lu(k,2149) + lu(k,2161) = lu(k,2161) - lu(k,895) * lu(k,2149) + lu(k,2168) = - lu(k,896) * lu(k,2149) + lu(k,2170) = lu(k,2170) - lu(k,897) * lu(k,2149) + lu(k,898) = 1._r8 / lu(k,898) + lu(k,899) = lu(k,899) * lu(k,898) + lu(k,900) = lu(k,900) * lu(k,898) + lu(k,901) = lu(k,901) * lu(k,898) + lu(k,902) = lu(k,902) * lu(k,898) + lu(k,903) = lu(k,903) * lu(k,898) + lu(k,971) = - lu(k,899) * lu(k,966) + lu(k,973) = lu(k,973) - lu(k,900) * lu(k,966) + lu(k,974) = - lu(k,901) * lu(k,966) + lu(k,975) = lu(k,975) - lu(k,902) * lu(k,966) + lu(k,980) = - lu(k,903) * lu(k,966) + lu(k,984) = lu(k,984) - lu(k,899) * lu(k,981) + lu(k,985) = lu(k,985) - lu(k,900) * lu(k,981) + lu(k,986) = - lu(k,901) * lu(k,981) + lu(k,987) = lu(k,987) - lu(k,902) * lu(k,981) + lu(k,990) = - lu(k,903) * lu(k,981) + lu(k,1011) = - lu(k,899) * lu(k,1004) + lu(k,1012) = - lu(k,900) * lu(k,1004) + lu(k,1013) = lu(k,1013) - lu(k,901) * lu(k,1004) + lu(k,1015) = lu(k,1015) - lu(k,902) * lu(k,1004) + lu(k,1022) = - lu(k,903) * lu(k,1004) + lu(k,1031) = - lu(k,899) * lu(k,1026) + lu(k,1032) = - lu(k,900) * lu(k,1026) + lu(k,1033) = lu(k,1033) - lu(k,901) * lu(k,1026) + lu(k,1035) = lu(k,1035) - lu(k,902) * lu(k,1026) + lu(k,1041) = - lu(k,903) * lu(k,1026) + lu(k,1384) = lu(k,1384) - lu(k,899) * lu(k,1374) + lu(k,1395) = lu(k,1395) - lu(k,900) * lu(k,1374) + lu(k,1396) = lu(k,1396) - lu(k,901) * lu(k,1374) + lu(k,1400) = lu(k,1400) - lu(k,902) * lu(k,1374) + lu(k,1409) = lu(k,1409) - lu(k,903) * lu(k,1374) + lu(k,1492) = lu(k,1492) - lu(k,899) * lu(k,1481) + lu(k,1503) = lu(k,1503) - lu(k,900) * lu(k,1481) + lu(k,1505) = lu(k,1505) - lu(k,901) * lu(k,1481) + lu(k,1510) = lu(k,1510) - lu(k,902) * lu(k,1481) + lu(k,1521) = lu(k,1521) - lu(k,903) * lu(k,1481) + lu(k,1698) = lu(k,1698) - lu(k,899) * lu(k,1685) + lu(k,1710) = lu(k,1710) - lu(k,900) * lu(k,1685) + lu(k,1714) = lu(k,1714) - lu(k,901) * lu(k,1685) + lu(k,1719) = lu(k,1719) - lu(k,902) * lu(k,1685) + lu(k,1730) = lu(k,1730) - lu(k,903) * lu(k,1685) + lu(k,1763) = lu(k,1763) - lu(k,899) * lu(k,1753) + lu(k,1773) = lu(k,1773) - lu(k,900) * lu(k,1753) + lu(k,1776) = lu(k,1776) - lu(k,901) * lu(k,1753) + lu(k,1781) = lu(k,1781) - lu(k,902) * lu(k,1753) + lu(k,1792) = lu(k,1792) - lu(k,903) * lu(k,1753) + lu(k,1884) = lu(k,1884) - lu(k,899) * lu(k,1872) + lu(k,1895) = lu(k,1895) - lu(k,900) * lu(k,1872) + lu(k,1898) = lu(k,1898) - lu(k,901) * lu(k,1872) + lu(k,1903) = lu(k,1903) - lu(k,902) * lu(k,1872) + lu(k,1914) = lu(k,1914) - lu(k,903) * lu(k,1872) + lu(k,2086) = lu(k,2086) - lu(k,899) * lu(k,2077) + lu(k,2098) = lu(k,2098) - lu(k,900) * lu(k,2077) + lu(k,2101) = lu(k,2101) - lu(k,901) * lu(k,2077) + lu(k,2106) = lu(k,2106) - lu(k,902) * lu(k,2077) + lu(k,2117) = lu(k,2117) - lu(k,903) * lu(k,2077) + lu(k,906) = 1._r8 / lu(k,906) + lu(k,907) = lu(k,907) * lu(k,906) + lu(k,908) = lu(k,908) * lu(k,906) + lu(k,909) = lu(k,909) * lu(k,906) + lu(k,910) = lu(k,910) * lu(k,906) + lu(k,911) = lu(k,911) * lu(k,906) + lu(k,912) = lu(k,912) * lu(k,906) + lu(k,913) = lu(k,913) * lu(k,906) + lu(k,914) = lu(k,914) * lu(k,906) + lu(k,915) = lu(k,915) * lu(k,906) + lu(k,1337) = lu(k,1337) - lu(k,907) * lu(k,1336) + lu(k,1339) = lu(k,1339) - lu(k,908) * lu(k,1336) + lu(k,1341) = lu(k,1341) - lu(k,909) * lu(k,1336) + lu(k,1342) = lu(k,1342) - lu(k,910) * lu(k,1336) + lu(k,1343) = - lu(k,911) * lu(k,1336) + lu(k,1345) = lu(k,1345) - lu(k,912) * lu(k,1336) + lu(k,1346) = - lu(k,913) * lu(k,1336) + lu(k,1348) = lu(k,1348) - lu(k,914) * lu(k,1336) + lu(k,1349) = lu(k,1349) - lu(k,915) * lu(k,1336) + lu(k,1538) = lu(k,1538) - lu(k,907) * lu(k,1532) + lu(k,1543) = lu(k,1543) - lu(k,908) * lu(k,1532) + lu(k,1545) = lu(k,1545) - lu(k,909) * lu(k,1532) + lu(k,1547) = lu(k,1547) - lu(k,910) * lu(k,1532) + lu(k,1549) = lu(k,1549) - lu(k,911) * lu(k,1532) + lu(k,1551) = - lu(k,912) * lu(k,1532) + lu(k,1552) = lu(k,1552) - lu(k,913) * lu(k,1532) + lu(k,1555) = lu(k,1555) - lu(k,914) * lu(k,1532) + lu(k,1556) = lu(k,1556) - lu(k,915) * lu(k,1532) + lu(k,1712) = lu(k,1712) - lu(k,907) * lu(k,1686) + lu(k,1717) = lu(k,1717) - lu(k,908) * lu(k,1686) + lu(k,1719) = lu(k,1719) - lu(k,909) * lu(k,1686) + lu(k,1721) = lu(k,1721) - lu(k,910) * lu(k,1686) + lu(k,1723) = lu(k,1723) - lu(k,911) * lu(k,1686) + lu(k,1725) = lu(k,1725) - lu(k,912) * lu(k,1686) + lu(k,1726) = lu(k,1726) - lu(k,913) * lu(k,1686) + lu(k,1729) = lu(k,1729) - lu(k,914) * lu(k,1686) + lu(k,1730) = lu(k,1730) - lu(k,915) * lu(k,1686) + lu(k,1815) = lu(k,1815) - lu(k,907) * lu(k,1811) + lu(k,1820) = lu(k,1820) - lu(k,908) * lu(k,1811) + lu(k,1822) = lu(k,1822) - lu(k,909) * lu(k,1811) + lu(k,1824) = lu(k,1824) - lu(k,910) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,911) * lu(k,1811) + lu(k,1828) = lu(k,1828) - lu(k,912) * lu(k,1811) + lu(k,1829) = lu(k,1829) - lu(k,913) * lu(k,1811) + lu(k,1832) = lu(k,1832) - lu(k,914) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,915) * lu(k,1811) + lu(k,1980) = lu(k,1980) - lu(k,907) * lu(k,1973) + lu(k,1985) = lu(k,1985) - lu(k,908) * lu(k,1973) + lu(k,1987) = lu(k,1987) - lu(k,909) * lu(k,1973) + lu(k,1989) = lu(k,1989) - lu(k,910) * lu(k,1973) + lu(k,1991) = lu(k,1991) - lu(k,911) * lu(k,1973) + lu(k,1993) = lu(k,1993) - lu(k,912) * lu(k,1973) + lu(k,1994) = lu(k,1994) - lu(k,913) * lu(k,1973) + lu(k,1997) = lu(k,1997) - lu(k,914) * lu(k,1973) + lu(k,1998) = lu(k,1998) - lu(k,915) * lu(k,1973) + lu(k,2126) = lu(k,2126) - lu(k,907) * lu(k,2124) + lu(k,2131) = lu(k,2131) - lu(k,908) * lu(k,2124) + lu(k,2133) = lu(k,2133) - lu(k,909) * lu(k,2124) + lu(k,2135) = lu(k,2135) - lu(k,910) * lu(k,2124) + lu(k,2137) = - lu(k,911) * lu(k,2124) + lu(k,2139) = - lu(k,912) * lu(k,2124) + lu(k,2140) = lu(k,2140) - lu(k,913) * lu(k,2124) + lu(k,2143) = lu(k,2143) - lu(k,914) * lu(k,2124) + lu(k,2144) = lu(k,2144) - lu(k,915) * lu(k,2124) + end do + end subroutine lu_fac19 + subroutine lu_fac20( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,916) = 1._r8 / lu(k,916) + lu(k,917) = lu(k,917) * lu(k,916) + lu(k,918) = lu(k,918) * lu(k,916) + lu(k,919) = lu(k,919) * lu(k,916) + lu(k,920) = lu(k,920) * lu(k,916) + lu(k,921) = lu(k,921) * lu(k,916) + lu(k,922) = lu(k,922) * lu(k,916) + lu(k,923) = lu(k,923) * lu(k,916) + lu(k,1006) = - lu(k,917) * lu(k,1005) + lu(k,1007) = - lu(k,918) * lu(k,1005) + lu(k,1009) = - lu(k,919) * lu(k,1005) + lu(k,1010) = - lu(k,920) * lu(k,1005) + lu(k,1015) = lu(k,1015) - lu(k,921) * lu(k,1005) + lu(k,1017) = - lu(k,922) * lu(k,1005) + lu(k,1021) = lu(k,1021) - lu(k,923) * lu(k,1005) + lu(k,1046) = - lu(k,917) * lu(k,1045) + lu(k,1047) = - lu(k,918) * lu(k,1045) + lu(k,1048) = - lu(k,919) * lu(k,1045) + lu(k,1049) = lu(k,1049) - lu(k,920) * lu(k,1045) + lu(k,1054) = lu(k,1054) - lu(k,921) * lu(k,1045) + lu(k,1056) = lu(k,1056) - lu(k,922) * lu(k,1045) + lu(k,1060) = lu(k,1060) - lu(k,923) * lu(k,1045) + lu(k,1378) = lu(k,1378) - lu(k,917) * lu(k,1375) + lu(k,1380) = lu(k,1380) - lu(k,918) * lu(k,1375) + lu(k,1382) = lu(k,1382) - lu(k,919) * lu(k,1375) + lu(k,1383) = lu(k,1383) - lu(k,920) * lu(k,1375) + lu(k,1400) = lu(k,1400) - lu(k,921) * lu(k,1375) + lu(k,1403) = - lu(k,922) * lu(k,1375) + lu(k,1407) = lu(k,1407) - lu(k,923) * lu(k,1375) + lu(k,1486) = lu(k,1486) - lu(k,917) * lu(k,1482) + lu(k,1488) = lu(k,1488) - lu(k,918) * lu(k,1482) + lu(k,1490) = lu(k,1490) - lu(k,919) * lu(k,1482) + lu(k,1491) = lu(k,1491) - lu(k,920) * lu(k,1482) + lu(k,1510) = lu(k,1510) - lu(k,921) * lu(k,1482) + lu(k,1514) = lu(k,1514) - lu(k,922) * lu(k,1482) + lu(k,1519) = lu(k,1519) - lu(k,923) * lu(k,1482) + lu(k,1692) = lu(k,1692) - lu(k,917) * lu(k,1687) + lu(k,1694) = lu(k,1694) - lu(k,918) * lu(k,1687) + lu(k,1696) = lu(k,1696) - lu(k,919) * lu(k,1687) + lu(k,1697) = lu(k,1697) - lu(k,920) * lu(k,1687) + lu(k,1719) = lu(k,1719) - lu(k,921) * lu(k,1687) + lu(k,1723) = lu(k,1723) - lu(k,922) * lu(k,1687) + lu(k,1728) = lu(k,1728) - lu(k,923) * lu(k,1687) + lu(k,1757) = lu(k,1757) - lu(k,917) * lu(k,1754) + lu(k,1759) = lu(k,1759) - lu(k,918) * lu(k,1754) + lu(k,1761) = - lu(k,919) * lu(k,1754) + lu(k,1762) = lu(k,1762) - lu(k,920) * lu(k,1754) + lu(k,1781) = lu(k,1781) - lu(k,921) * lu(k,1754) + lu(k,1785) = lu(k,1785) - lu(k,922) * lu(k,1754) + lu(k,1790) = lu(k,1790) - lu(k,923) * lu(k,1754) + lu(k,1878) = lu(k,1878) - lu(k,917) * lu(k,1873) + lu(k,1880) = lu(k,1880) - lu(k,918) * lu(k,1873) + lu(k,1882) = lu(k,1882) - lu(k,919) * lu(k,1873) + lu(k,1883) = lu(k,1883) - lu(k,920) * lu(k,1873) + lu(k,1903) = lu(k,1903) - lu(k,921) * lu(k,1873) + lu(k,1907) = lu(k,1907) - lu(k,922) * lu(k,1873) + lu(k,1912) = lu(k,1912) - lu(k,923) * lu(k,1873) + lu(k,2080) = lu(k,2080) - lu(k,917) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,918) * lu(k,2078) + lu(k,2084) = lu(k,2084) - lu(k,919) * lu(k,2078) + lu(k,2085) = lu(k,2085) - lu(k,920) * lu(k,2078) + lu(k,2106) = lu(k,2106) - lu(k,921) * lu(k,2078) + lu(k,2110) = lu(k,2110) - lu(k,922) * lu(k,2078) + lu(k,2115) = lu(k,2115) - lu(k,923) * lu(k,2078) + lu(k,928) = 1._r8 / lu(k,928) + lu(k,929) = lu(k,929) * lu(k,928) + lu(k,930) = lu(k,930) * lu(k,928) + lu(k,931) = lu(k,931) * lu(k,928) + lu(k,932) = lu(k,932) * lu(k,928) + lu(k,933) = lu(k,933) * lu(k,928) + lu(k,934) = lu(k,934) * lu(k,928) + lu(k,935) = lu(k,935) * lu(k,928) + lu(k,936) = lu(k,936) * lu(k,928) + lu(k,937) = lu(k,937) * lu(k,928) + lu(k,938) = lu(k,938) * lu(k,928) + lu(k,1122) = - lu(k,929) * lu(k,1120) + lu(k,1126) = lu(k,1126) - lu(k,930) * lu(k,1120) + lu(k,1128) = lu(k,1128) - lu(k,931) * lu(k,1120) + lu(k,1129) = lu(k,1129) - lu(k,932) * lu(k,1120) + lu(k,1130) = lu(k,1130) - lu(k,933) * lu(k,1120) + lu(k,1131) = lu(k,1131) - lu(k,934) * lu(k,1120) + lu(k,1132) = lu(k,1132) - lu(k,935) * lu(k,1120) + lu(k,1135) = lu(k,1135) - lu(k,936) * lu(k,1120) + lu(k,1136) = lu(k,1136) - lu(k,937) * lu(k,1120) + lu(k,1137) = lu(k,1137) - lu(k,938) * lu(k,1120) + lu(k,1292) = lu(k,1292) - lu(k,929) * lu(k,1289) + lu(k,1296) = lu(k,1296) - lu(k,930) * lu(k,1289) + lu(k,1302) = lu(k,1302) - lu(k,931) * lu(k,1289) + lu(k,1303) = lu(k,1303) - lu(k,932) * lu(k,1289) + lu(k,1305) = lu(k,1305) - lu(k,933) * lu(k,1289) + lu(k,1306) = lu(k,1306) - lu(k,934) * lu(k,1289) + lu(k,1308) = lu(k,1308) - lu(k,935) * lu(k,1289) + lu(k,1311) = - lu(k,936) * lu(k,1289) + lu(k,1312) = lu(k,1312) - lu(k,937) * lu(k,1289) + lu(k,1313) = lu(k,1313) - lu(k,938) * lu(k,1289) + lu(k,1380) = lu(k,1380) - lu(k,929) * lu(k,1376) + lu(k,1389) = lu(k,1389) - lu(k,930) * lu(k,1376) + lu(k,1395) = lu(k,1395) - lu(k,931) * lu(k,1376) + lu(k,1396) = lu(k,1396) - lu(k,932) * lu(k,1376) + lu(k,1398) = lu(k,1398) - lu(k,933) * lu(k,1376) + lu(k,1400) = lu(k,1400) - lu(k,934) * lu(k,1376) + lu(k,1402) = lu(k,1402) - lu(k,935) * lu(k,1376) + lu(k,1405) = lu(k,1405) - lu(k,936) * lu(k,1376) + lu(k,1406) = lu(k,1406) - lu(k,937) * lu(k,1376) + lu(k,1407) = lu(k,1407) - lu(k,938) * lu(k,1376) + lu(k,1488) = lu(k,1488) - lu(k,929) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,930) * lu(k,1483) + lu(k,1503) = lu(k,1503) - lu(k,931) * lu(k,1483) + lu(k,1505) = lu(k,1505) - lu(k,932) * lu(k,1483) + lu(k,1507) = lu(k,1507) - lu(k,933) * lu(k,1483) + lu(k,1510) = lu(k,1510) - lu(k,934) * lu(k,1483) + lu(k,1513) = lu(k,1513) - lu(k,935) * lu(k,1483) + lu(k,1516) = lu(k,1516) - lu(k,936) * lu(k,1483) + lu(k,1517) = lu(k,1517) - lu(k,937) * lu(k,1483) + lu(k,1519) = lu(k,1519) - lu(k,938) * lu(k,1483) + lu(k,1694) = lu(k,1694) - lu(k,929) * lu(k,1688) + lu(k,1704) = lu(k,1704) - lu(k,930) * lu(k,1688) + lu(k,1710) = lu(k,1710) - lu(k,931) * lu(k,1688) + lu(k,1714) = lu(k,1714) - lu(k,932) * lu(k,1688) + lu(k,1716) = lu(k,1716) - lu(k,933) * lu(k,1688) + lu(k,1719) = lu(k,1719) - lu(k,934) * lu(k,1688) + lu(k,1722) = lu(k,1722) - lu(k,935) * lu(k,1688) + lu(k,1725) = lu(k,1725) - lu(k,936) * lu(k,1688) + lu(k,1726) = lu(k,1726) - lu(k,937) * lu(k,1688) + lu(k,1728) = lu(k,1728) - lu(k,938) * lu(k,1688) + lu(k,1880) = lu(k,1880) - lu(k,929) * lu(k,1874) + lu(k,1889) = lu(k,1889) - lu(k,930) * lu(k,1874) + lu(k,1895) = lu(k,1895) - lu(k,931) * lu(k,1874) + lu(k,1898) = lu(k,1898) - lu(k,932) * lu(k,1874) + lu(k,1900) = lu(k,1900) - lu(k,933) * lu(k,1874) + lu(k,1903) = lu(k,1903) - lu(k,934) * lu(k,1874) + lu(k,1906) = lu(k,1906) - lu(k,935) * lu(k,1874) + lu(k,1909) = lu(k,1909) - lu(k,936) * lu(k,1874) + lu(k,1910) = lu(k,1910) - lu(k,937) * lu(k,1874) + lu(k,1912) = lu(k,1912) - lu(k,938) * lu(k,1874) + lu(k,943) = 1._r8 / lu(k,943) + lu(k,944) = lu(k,944) * lu(k,943) + lu(k,945) = lu(k,945) * lu(k,943) + lu(k,946) = lu(k,946) * lu(k,943) + lu(k,947) = lu(k,947) * lu(k,943) + lu(k,948) = lu(k,948) * lu(k,943) + lu(k,949) = lu(k,949) * lu(k,943) + lu(k,950) = lu(k,950) * lu(k,943) + lu(k,951) = lu(k,951) * lu(k,943) + lu(k,952) = lu(k,952) * lu(k,943) + lu(k,953) = lu(k,953) * lu(k,943) + lu(k,954) = lu(k,954) * lu(k,943) + lu(k,955) = lu(k,955) * lu(k,943) + lu(k,956) = lu(k,956) * lu(k,943) + lu(k,957) = lu(k,957) * lu(k,943) + lu(k,958) = lu(k,958) * lu(k,943) + lu(k,1246) = - lu(k,944) * lu(k,1245) + lu(k,1247) = lu(k,1247) - lu(k,945) * lu(k,1245) + lu(k,1248) = lu(k,1248) - lu(k,946) * lu(k,1245) + lu(k,1249) = lu(k,1249) - lu(k,947) * lu(k,1245) + lu(k,1253) = lu(k,1253) - lu(k,948) * lu(k,1245) + lu(k,1254) = lu(k,1254) - lu(k,949) * lu(k,1245) + lu(k,1255) = - lu(k,950) * lu(k,1245) + lu(k,1256) = - lu(k,951) * lu(k,1245) + lu(k,1257) = lu(k,1257) - lu(k,952) * lu(k,1245) + lu(k,1258) = lu(k,1258) - lu(k,953) * lu(k,1245) + lu(k,1259) = lu(k,1259) - lu(k,954) * lu(k,1245) + lu(k,1260) = - lu(k,955) * lu(k,1245) + lu(k,1263) = - lu(k,956) * lu(k,1245) + lu(k,1264) = lu(k,1264) - lu(k,957) * lu(k,1245) + lu(k,1265) = lu(k,1265) - lu(k,958) * lu(k,1245) + lu(k,1693) = lu(k,1693) - lu(k,944) * lu(k,1689) + lu(k,1694) = lu(k,1694) - lu(k,945) * lu(k,1689) + lu(k,1699) = lu(k,1699) - lu(k,946) * lu(k,1689) + lu(k,1704) = lu(k,1704) - lu(k,947) * lu(k,1689) + lu(k,1710) = lu(k,1710) - lu(k,948) * lu(k,1689) + lu(k,1714) = lu(k,1714) - lu(k,949) * lu(k,1689) + lu(k,1715) = lu(k,1715) - lu(k,950) * lu(k,1689) + lu(k,1716) = lu(k,1716) - lu(k,951) * lu(k,1689) + lu(k,1719) = lu(k,1719) - lu(k,952) * lu(k,1689) + lu(k,1720) = lu(k,1720) - lu(k,953) * lu(k,1689) + lu(k,1722) = lu(k,1722) - lu(k,954) * lu(k,1689) + lu(k,1723) = lu(k,1723) - lu(k,955) * lu(k,1689) + lu(k,1726) = lu(k,1726) - lu(k,956) * lu(k,1689) + lu(k,1728) = lu(k,1728) - lu(k,957) * lu(k,1689) + lu(k,1730) = lu(k,1730) - lu(k,958) * lu(k,1689) + lu(k,1758) = - lu(k,944) * lu(k,1755) + lu(k,1759) = lu(k,1759) - lu(k,945) * lu(k,1755) + lu(k,1764) = lu(k,1764) - lu(k,946) * lu(k,1755) + lu(k,1767) = lu(k,1767) - lu(k,947) * lu(k,1755) + lu(k,1773) = lu(k,1773) - lu(k,948) * lu(k,1755) + lu(k,1776) = lu(k,1776) - lu(k,949) * lu(k,1755) + lu(k,1777) = lu(k,1777) - lu(k,950) * lu(k,1755) + lu(k,1778) = lu(k,1778) - lu(k,951) * lu(k,1755) + lu(k,1781) = lu(k,1781) - lu(k,952) * lu(k,1755) + lu(k,1782) = lu(k,1782) - lu(k,953) * lu(k,1755) + lu(k,1784) = lu(k,1784) - lu(k,954) * lu(k,1755) + lu(k,1785) = lu(k,1785) - lu(k,955) * lu(k,1755) + lu(k,1788) = lu(k,1788) - lu(k,956) * lu(k,1755) + lu(k,1790) = lu(k,1790) - lu(k,957) * lu(k,1755) + lu(k,1792) = lu(k,1792) - lu(k,958) * lu(k,1755) + lu(k,1879) = lu(k,1879) - lu(k,944) * lu(k,1875) + lu(k,1880) = lu(k,1880) - lu(k,945) * lu(k,1875) + lu(k,1885) = lu(k,1885) - lu(k,946) * lu(k,1875) + lu(k,1889) = lu(k,1889) - lu(k,947) * lu(k,1875) + lu(k,1895) = lu(k,1895) - lu(k,948) * lu(k,1875) + lu(k,1898) = lu(k,1898) - lu(k,949) * lu(k,1875) + lu(k,1899) = lu(k,1899) - lu(k,950) * lu(k,1875) + lu(k,1900) = lu(k,1900) - lu(k,951) * lu(k,1875) + lu(k,1903) = lu(k,1903) - lu(k,952) * lu(k,1875) + lu(k,1904) = lu(k,1904) - lu(k,953) * lu(k,1875) + lu(k,1906) = lu(k,1906) - lu(k,954) * lu(k,1875) + lu(k,1907) = lu(k,1907) - lu(k,955) * lu(k,1875) + lu(k,1910) = lu(k,1910) - lu(k,956) * lu(k,1875) + lu(k,1912) = lu(k,1912) - lu(k,957) * lu(k,1875) + lu(k,1914) = lu(k,1914) - lu(k,958) * lu(k,1875) + end do + end subroutine lu_fac20 + subroutine lu_fac21( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,960) = 1._r8 / lu(k,960) + lu(k,961) = lu(k,961) * lu(k,960) + lu(k,962) = lu(k,962) * lu(k,960) + lu(k,963) = lu(k,963) * lu(k,960) + lu(k,964) = lu(k,964) * lu(k,960) + lu(k,970) = lu(k,970) - lu(k,961) * lu(k,967) + lu(k,975) = lu(k,975) - lu(k,962) * lu(k,967) + lu(k,976) = lu(k,976) - lu(k,963) * lu(k,967) + lu(k,979) = lu(k,979) - lu(k,964) * lu(k,967) + lu(k,1029) = lu(k,1029) - lu(k,961) * lu(k,1027) + lu(k,1035) = lu(k,1035) - lu(k,962) * lu(k,1027) + lu(k,1036) = lu(k,1036) - lu(k,963) * lu(k,1027) + lu(k,1040) = lu(k,1040) - lu(k,964) * lu(k,1027) + lu(k,1090) = lu(k,1090) - lu(k,961) * lu(k,1088) + lu(k,1096) = lu(k,1096) - lu(k,962) * lu(k,1088) + lu(k,1097) = lu(k,1097) - lu(k,963) * lu(k,1088) + lu(k,1101) = lu(k,1101) - lu(k,964) * lu(k,1088) + lu(k,1122) = lu(k,1122) - lu(k,961) * lu(k,1121) + lu(k,1131) = lu(k,1131) - lu(k,962) * lu(k,1121) + lu(k,1132) = lu(k,1132) - lu(k,963) * lu(k,1121) + lu(k,1137) = lu(k,1137) - lu(k,964) * lu(k,1121) + lu(k,1166) = - lu(k,961) * lu(k,1163) + lu(k,1179) = lu(k,1179) - lu(k,962) * lu(k,1163) + lu(k,1181) = lu(k,1181) - lu(k,963) * lu(k,1163) + lu(k,1186) = lu(k,1186) - lu(k,964) * lu(k,1163) + lu(k,1200) = lu(k,1200) - lu(k,961) * lu(k,1197) + lu(k,1213) = lu(k,1213) - lu(k,962) * lu(k,1197) + lu(k,1215) = lu(k,1215) - lu(k,963) * lu(k,1197) + lu(k,1220) = lu(k,1220) - lu(k,964) * lu(k,1197) + lu(k,1227) = lu(k,1227) - lu(k,961) * lu(k,1224) + lu(k,1236) = lu(k,1236) - lu(k,962) * lu(k,1224) + lu(k,1237) = lu(k,1237) - lu(k,963) * lu(k,1224) + lu(k,1242) = lu(k,1242) - lu(k,964) * lu(k,1224) + lu(k,1292) = lu(k,1292) - lu(k,961) * lu(k,1290) + lu(k,1306) = lu(k,1306) - lu(k,962) * lu(k,1290) + lu(k,1308) = lu(k,1308) - lu(k,963) * lu(k,1290) + lu(k,1313) = lu(k,1313) - lu(k,964) * lu(k,1290) + lu(k,1380) = lu(k,1380) - lu(k,961) * lu(k,1377) + lu(k,1400) = lu(k,1400) - lu(k,962) * lu(k,1377) + lu(k,1402) = lu(k,1402) - lu(k,963) * lu(k,1377) + lu(k,1407) = lu(k,1407) - lu(k,964) * lu(k,1377) + lu(k,1424) = lu(k,1424) - lu(k,961) * lu(k,1423) + lu(k,1431) = lu(k,1431) - lu(k,962) * lu(k,1423) + lu(k,1434) = lu(k,1434) - lu(k,963) * lu(k,1423) + lu(k,1438) = lu(k,1438) - lu(k,964) * lu(k,1423) + lu(k,1488) = lu(k,1488) - lu(k,961) * lu(k,1484) + lu(k,1510) = lu(k,1510) - lu(k,962) * lu(k,1484) + lu(k,1513) = lu(k,1513) - lu(k,963) * lu(k,1484) + lu(k,1519) = lu(k,1519) - lu(k,964) * lu(k,1484) + lu(k,1534) = lu(k,1534) - lu(k,961) * lu(k,1533) + lu(k,1545) = lu(k,1545) - lu(k,962) * lu(k,1533) + lu(k,1548) = lu(k,1548) - lu(k,963) * lu(k,1533) + lu(k,1554) = lu(k,1554) - lu(k,964) * lu(k,1533) + lu(k,1694) = lu(k,1694) - lu(k,961) * lu(k,1690) + lu(k,1719) = lu(k,1719) - lu(k,962) * lu(k,1690) + lu(k,1722) = lu(k,1722) - lu(k,963) * lu(k,1690) + lu(k,1728) = lu(k,1728) - lu(k,964) * lu(k,1690) + lu(k,1759) = lu(k,1759) - lu(k,961) * lu(k,1756) + lu(k,1781) = lu(k,1781) - lu(k,962) * lu(k,1756) + lu(k,1784) = lu(k,1784) - lu(k,963) * lu(k,1756) + lu(k,1790) = lu(k,1790) - lu(k,964) * lu(k,1756) + lu(k,1880) = lu(k,1880) - lu(k,961) * lu(k,1876) + lu(k,1903) = lu(k,1903) - lu(k,962) * lu(k,1876) + lu(k,1906) = lu(k,1906) - lu(k,963) * lu(k,1876) + lu(k,1912) = lu(k,1912) - lu(k,964) * lu(k,1876) + lu(k,2082) = lu(k,2082) - lu(k,961) * lu(k,2079) + lu(k,2106) = lu(k,2106) - lu(k,962) * lu(k,2079) + lu(k,2109) = lu(k,2109) - lu(k,963) * lu(k,2079) + lu(k,2115) = lu(k,2115) - lu(k,964) * lu(k,2079) + lu(k,968) = 1._r8 / lu(k,968) + lu(k,969) = lu(k,969) * lu(k,968) + lu(k,970) = lu(k,970) * lu(k,968) + lu(k,971) = lu(k,971) * lu(k,968) + lu(k,972) = lu(k,972) * lu(k,968) + lu(k,973) = lu(k,973) * lu(k,968) + lu(k,974) = lu(k,974) * lu(k,968) + lu(k,975) = lu(k,975) * lu(k,968) + lu(k,976) = lu(k,976) * lu(k,968) + lu(k,977) = lu(k,977) * lu(k,968) + lu(k,978) = lu(k,978) * lu(k,968) + lu(k,979) = lu(k,979) * lu(k,968) + lu(k,980) = lu(k,980) * lu(k,968) + lu(k,1165) = lu(k,1165) - lu(k,969) * lu(k,1164) + lu(k,1166) = lu(k,1166) - lu(k,970) * lu(k,1164) + lu(k,1167) = - lu(k,971) * lu(k,1164) + lu(k,1168) = - lu(k,972) * lu(k,1164) + lu(k,1176) = lu(k,1176) - lu(k,973) * lu(k,1164) + lu(k,1177) = lu(k,1177) - lu(k,974) * lu(k,1164) + lu(k,1179) = lu(k,1179) - lu(k,975) * lu(k,1164) + lu(k,1181) = lu(k,1181) - lu(k,976) * lu(k,1164) + lu(k,1184) = lu(k,1184) - lu(k,977) * lu(k,1164) + lu(k,1185) = lu(k,1185) - lu(k,978) * lu(k,1164) + lu(k,1186) = lu(k,1186) - lu(k,979) * lu(k,1164) + lu(k,1187) = - lu(k,980) * lu(k,1164) + lu(k,1199) = lu(k,1199) - lu(k,969) * lu(k,1198) + lu(k,1200) = lu(k,1200) - lu(k,970) * lu(k,1198) + lu(k,1201) = - lu(k,971) * lu(k,1198) + lu(k,1202) = - lu(k,972) * lu(k,1198) + lu(k,1210) = lu(k,1210) - lu(k,973) * lu(k,1198) + lu(k,1211) = lu(k,1211) - lu(k,974) * lu(k,1198) + lu(k,1213) = lu(k,1213) - lu(k,975) * lu(k,1198) + lu(k,1215) = lu(k,1215) - lu(k,976) * lu(k,1198) + lu(k,1218) = lu(k,1218) - lu(k,977) * lu(k,1198) + lu(k,1219) = lu(k,1219) - lu(k,978) * lu(k,1198) + lu(k,1220) = lu(k,1220) - lu(k,979) * lu(k,1198) + lu(k,1221) = - lu(k,980) * lu(k,1198) + lu(k,1226) = lu(k,1226) - lu(k,969) * lu(k,1225) + lu(k,1227) = lu(k,1227) - lu(k,970) * lu(k,1225) + lu(k,1228) = - lu(k,971) * lu(k,1225) + lu(k,1229) = - lu(k,972) * lu(k,1225) + lu(k,1233) = lu(k,1233) - lu(k,973) * lu(k,1225) + lu(k,1234) = lu(k,1234) - lu(k,974) * lu(k,1225) + lu(k,1236) = lu(k,1236) - lu(k,975) * lu(k,1225) + lu(k,1237) = lu(k,1237) - lu(k,976) * lu(k,1225) + lu(k,1240) = - lu(k,977) * lu(k,1225) + lu(k,1241) = lu(k,1241) - lu(k,978) * lu(k,1225) + lu(k,1242) = lu(k,1242) - lu(k,979) * lu(k,1225) + lu(k,1243) = - lu(k,980) * lu(k,1225) + lu(k,1487) = lu(k,1487) - lu(k,969) * lu(k,1485) + lu(k,1488) = lu(k,1488) - lu(k,970) * lu(k,1485) + lu(k,1492) = lu(k,1492) - lu(k,971) * lu(k,1485) + lu(k,1493) = lu(k,1493) - lu(k,972) * lu(k,1485) + lu(k,1503) = lu(k,1503) - lu(k,973) * lu(k,1485) + lu(k,1505) = lu(k,1505) - lu(k,974) * lu(k,1485) + lu(k,1510) = lu(k,1510) - lu(k,975) * lu(k,1485) + lu(k,1513) = lu(k,1513) - lu(k,976) * lu(k,1485) + lu(k,1516) = lu(k,1516) - lu(k,977) * lu(k,1485) + lu(k,1517) = lu(k,1517) - lu(k,978) * lu(k,1485) + lu(k,1519) = lu(k,1519) - lu(k,979) * lu(k,1485) + lu(k,1521) = lu(k,1521) - lu(k,980) * lu(k,1485) + lu(k,1693) = lu(k,1693) - lu(k,969) * lu(k,1691) + lu(k,1694) = lu(k,1694) - lu(k,970) * lu(k,1691) + lu(k,1698) = lu(k,1698) - lu(k,971) * lu(k,1691) + lu(k,1699) = lu(k,1699) - lu(k,972) * lu(k,1691) + lu(k,1710) = lu(k,1710) - lu(k,973) * lu(k,1691) + lu(k,1714) = lu(k,1714) - lu(k,974) * lu(k,1691) + lu(k,1719) = lu(k,1719) - lu(k,975) * lu(k,1691) + lu(k,1722) = lu(k,1722) - lu(k,976) * lu(k,1691) + lu(k,1725) = lu(k,1725) - lu(k,977) * lu(k,1691) + lu(k,1726) = lu(k,1726) - lu(k,978) * lu(k,1691) + lu(k,1728) = lu(k,1728) - lu(k,979) * lu(k,1691) + lu(k,1730) = lu(k,1730) - lu(k,980) * lu(k,1691) + lu(k,1879) = lu(k,1879) - lu(k,969) * lu(k,1877) + lu(k,1880) = lu(k,1880) - lu(k,970) * lu(k,1877) + lu(k,1884) = lu(k,1884) - lu(k,971) * lu(k,1877) + lu(k,1885) = lu(k,1885) - lu(k,972) * lu(k,1877) + lu(k,1895) = lu(k,1895) - lu(k,973) * lu(k,1877) + lu(k,1898) = lu(k,1898) - lu(k,974) * lu(k,1877) + lu(k,1903) = lu(k,1903) - lu(k,975) * lu(k,1877) + lu(k,1906) = lu(k,1906) - lu(k,976) * lu(k,1877) + lu(k,1909) = lu(k,1909) - lu(k,977) * lu(k,1877) + lu(k,1910) = lu(k,1910) - lu(k,978) * lu(k,1877) + lu(k,1912) = lu(k,1912) - lu(k,979) * lu(k,1877) + lu(k,1914) = lu(k,1914) - lu(k,980) * lu(k,1877) + lu(k,982) = 1._r8 / lu(k,982) + lu(k,983) = lu(k,983) * lu(k,982) + lu(k,984) = lu(k,984) * lu(k,982) + lu(k,985) = lu(k,985) * lu(k,982) + lu(k,986) = lu(k,986) * lu(k,982) + lu(k,987) = lu(k,987) * lu(k,982) + lu(k,988) = lu(k,988) * lu(k,982) + lu(k,989) = lu(k,989) * lu(k,982) + lu(k,990) = lu(k,990) * lu(k,982) + lu(k,1007) = lu(k,1007) - lu(k,983) * lu(k,1006) + lu(k,1011) = lu(k,1011) - lu(k,984) * lu(k,1006) + lu(k,1012) = lu(k,1012) - lu(k,985) * lu(k,1006) + lu(k,1013) = lu(k,1013) - lu(k,986) * lu(k,1006) + lu(k,1015) = lu(k,1015) - lu(k,987) * lu(k,1006) + lu(k,1016) = lu(k,1016) - lu(k,988) * lu(k,1006) + lu(k,1021) = lu(k,1021) - lu(k,989) * lu(k,1006) + lu(k,1022) = lu(k,1022) - lu(k,990) * lu(k,1006) + lu(k,1029) = lu(k,1029) - lu(k,983) * lu(k,1028) + lu(k,1031) = lu(k,1031) - lu(k,984) * lu(k,1028) + lu(k,1032) = lu(k,1032) - lu(k,985) * lu(k,1028) + lu(k,1033) = lu(k,1033) - lu(k,986) * lu(k,1028) + lu(k,1035) = lu(k,1035) - lu(k,987) * lu(k,1028) + lu(k,1036) = lu(k,1036) - lu(k,988) * lu(k,1028) + lu(k,1040) = lu(k,1040) - lu(k,989) * lu(k,1028) + lu(k,1041) = lu(k,1041) - lu(k,990) * lu(k,1028) + lu(k,1047) = lu(k,1047) - lu(k,983) * lu(k,1046) + lu(k,1050) = - lu(k,984) * lu(k,1046) + lu(k,1051) = - lu(k,985) * lu(k,1046) + lu(k,1052) = lu(k,1052) - lu(k,986) * lu(k,1046) + lu(k,1054) = lu(k,1054) - lu(k,987) * lu(k,1046) + lu(k,1055) = lu(k,1055) - lu(k,988) * lu(k,1046) + lu(k,1060) = lu(k,1060) - lu(k,989) * lu(k,1046) + lu(k,1061) = - lu(k,990) * lu(k,1046) + lu(k,1380) = lu(k,1380) - lu(k,983) * lu(k,1378) + lu(k,1384) = lu(k,1384) - lu(k,984) * lu(k,1378) + lu(k,1395) = lu(k,1395) - lu(k,985) * lu(k,1378) + lu(k,1396) = lu(k,1396) - lu(k,986) * lu(k,1378) + lu(k,1400) = lu(k,1400) - lu(k,987) * lu(k,1378) + lu(k,1402) = lu(k,1402) - lu(k,988) * lu(k,1378) + lu(k,1407) = lu(k,1407) - lu(k,989) * lu(k,1378) + lu(k,1409) = lu(k,1409) - lu(k,990) * lu(k,1378) + lu(k,1488) = lu(k,1488) - lu(k,983) * lu(k,1486) + lu(k,1492) = lu(k,1492) - lu(k,984) * lu(k,1486) + lu(k,1503) = lu(k,1503) - lu(k,985) * lu(k,1486) + lu(k,1505) = lu(k,1505) - lu(k,986) * lu(k,1486) + lu(k,1510) = lu(k,1510) - lu(k,987) * lu(k,1486) + lu(k,1513) = lu(k,1513) - lu(k,988) * lu(k,1486) + lu(k,1519) = lu(k,1519) - lu(k,989) * lu(k,1486) + lu(k,1521) = lu(k,1521) - lu(k,990) * lu(k,1486) + lu(k,1694) = lu(k,1694) - lu(k,983) * lu(k,1692) + lu(k,1698) = lu(k,1698) - lu(k,984) * lu(k,1692) + lu(k,1710) = lu(k,1710) - lu(k,985) * lu(k,1692) + lu(k,1714) = lu(k,1714) - lu(k,986) * lu(k,1692) + lu(k,1719) = lu(k,1719) - lu(k,987) * lu(k,1692) + lu(k,1722) = lu(k,1722) - lu(k,988) * lu(k,1692) + lu(k,1728) = lu(k,1728) - lu(k,989) * lu(k,1692) + lu(k,1730) = lu(k,1730) - lu(k,990) * lu(k,1692) + lu(k,1759) = lu(k,1759) - lu(k,983) * lu(k,1757) + lu(k,1763) = lu(k,1763) - lu(k,984) * lu(k,1757) + lu(k,1773) = lu(k,1773) - lu(k,985) * lu(k,1757) + lu(k,1776) = lu(k,1776) - lu(k,986) * lu(k,1757) + lu(k,1781) = lu(k,1781) - lu(k,987) * lu(k,1757) + lu(k,1784) = lu(k,1784) - lu(k,988) * lu(k,1757) + lu(k,1790) = lu(k,1790) - lu(k,989) * lu(k,1757) + lu(k,1792) = lu(k,1792) - lu(k,990) * lu(k,1757) + lu(k,1880) = lu(k,1880) - lu(k,983) * lu(k,1878) + lu(k,1884) = lu(k,1884) - lu(k,984) * lu(k,1878) + lu(k,1895) = lu(k,1895) - lu(k,985) * lu(k,1878) + lu(k,1898) = lu(k,1898) - lu(k,986) * lu(k,1878) + lu(k,1903) = lu(k,1903) - lu(k,987) * lu(k,1878) + lu(k,1906) = lu(k,1906) - lu(k,988) * lu(k,1878) + lu(k,1912) = lu(k,1912) - lu(k,989) * lu(k,1878) + lu(k,1914) = lu(k,1914) - lu(k,990) * lu(k,1878) + lu(k,2082) = lu(k,2082) - lu(k,983) * lu(k,2080) + lu(k,2086) = lu(k,2086) - lu(k,984) * lu(k,2080) + lu(k,2098) = lu(k,2098) - lu(k,985) * lu(k,2080) + lu(k,2101) = lu(k,2101) - lu(k,986) * lu(k,2080) + lu(k,2106) = lu(k,2106) - lu(k,987) * lu(k,2080) + lu(k,2109) = lu(k,2109) - lu(k,988) * lu(k,2080) + lu(k,2115) = lu(k,2115) - lu(k,989) * lu(k,2080) + lu(k,2117) = lu(k,2117) - lu(k,990) * lu(k,2080) + lu(k,991) = 1._r8 / lu(k,991) + lu(k,992) = lu(k,992) * lu(k,991) + lu(k,993) = lu(k,993) * lu(k,991) + lu(k,994) = lu(k,994) * lu(k,991) + lu(k,995) = lu(k,995) * lu(k,991) + lu(k,996) = lu(k,996) * lu(k,991) + lu(k,1066) = lu(k,1066) - lu(k,992) * lu(k,1064) + lu(k,1067) = lu(k,1067) - lu(k,993) * lu(k,1064) + lu(k,1070) = lu(k,1070) - lu(k,994) * lu(k,1064) + lu(k,1071) = lu(k,1071) - lu(k,995) * lu(k,1064) + lu(k,1073) = lu(k,1073) - lu(k,996) * lu(k,1064) + lu(k,1092) = lu(k,1092) - lu(k,992) * lu(k,1089) + lu(k,1093) = lu(k,1093) - lu(k,993) * lu(k,1089) + lu(k,1096) = lu(k,1096) - lu(k,994) * lu(k,1089) + lu(k,1097) = lu(k,1097) - lu(k,995) * lu(k,1089) + lu(k,1101) = lu(k,1101) - lu(k,996) * lu(k,1089) + lu(k,1171) = - lu(k,992) * lu(k,1165) + lu(k,1176) = lu(k,1176) - lu(k,993) * lu(k,1165) + lu(k,1179) = lu(k,1179) - lu(k,994) * lu(k,1165) + lu(k,1181) = lu(k,1181) - lu(k,995) * lu(k,1165) + lu(k,1186) = lu(k,1186) - lu(k,996) * lu(k,1165) + lu(k,1205) = lu(k,1205) - lu(k,992) * lu(k,1199) + lu(k,1210) = lu(k,1210) - lu(k,993) * lu(k,1199) + lu(k,1213) = lu(k,1213) - lu(k,994) * lu(k,1199) + lu(k,1215) = lu(k,1215) - lu(k,995) * lu(k,1199) + lu(k,1220) = lu(k,1220) - lu(k,996) * lu(k,1199) + lu(k,1230) = lu(k,1230) - lu(k,992) * lu(k,1226) + lu(k,1233) = lu(k,1233) - lu(k,993) * lu(k,1226) + lu(k,1236) = lu(k,1236) - lu(k,994) * lu(k,1226) + lu(k,1237) = lu(k,1237) - lu(k,995) * lu(k,1226) + lu(k,1242) = lu(k,1242) - lu(k,996) * lu(k,1226) + lu(k,1249) = lu(k,1249) - lu(k,992) * lu(k,1246) + lu(k,1253) = lu(k,1253) - lu(k,993) * lu(k,1246) + lu(k,1257) = lu(k,1257) - lu(k,994) * lu(k,1246) + lu(k,1259) = lu(k,1259) - lu(k,995) * lu(k,1246) + lu(k,1264) = lu(k,1264) - lu(k,996) * lu(k,1246) + lu(k,1270) = - lu(k,992) * lu(k,1269) + lu(k,1272) = lu(k,1272) - lu(k,993) * lu(k,1269) + lu(k,1275) = lu(k,1275) - lu(k,994) * lu(k,1269) + lu(k,1277) = lu(k,1277) - lu(k,995) * lu(k,1269) + lu(k,1282) = lu(k,1282) - lu(k,996) * lu(k,1269) + lu(k,1296) = lu(k,1296) - lu(k,992) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,993) * lu(k,1291) + lu(k,1306) = lu(k,1306) - lu(k,994) * lu(k,1291) + lu(k,1308) = lu(k,1308) - lu(k,995) * lu(k,1291) + lu(k,1313) = lu(k,1313) - lu(k,996) * lu(k,1291) + lu(k,1389) = lu(k,1389) - lu(k,992) * lu(k,1379) + lu(k,1395) = lu(k,1395) - lu(k,993) * lu(k,1379) + lu(k,1400) = lu(k,1400) - lu(k,994) * lu(k,1379) + lu(k,1402) = lu(k,1402) - lu(k,995) * lu(k,1379) + lu(k,1407) = lu(k,1407) - lu(k,996) * lu(k,1379) + lu(k,1497) = lu(k,1497) - lu(k,992) * lu(k,1487) + lu(k,1503) = lu(k,1503) - lu(k,993) * lu(k,1487) + lu(k,1510) = lu(k,1510) - lu(k,994) * lu(k,1487) + lu(k,1513) = lu(k,1513) - lu(k,995) * lu(k,1487) + lu(k,1519) = lu(k,1519) - lu(k,996) * lu(k,1487) + lu(k,1704) = lu(k,1704) - lu(k,992) * lu(k,1693) + lu(k,1710) = lu(k,1710) - lu(k,993) * lu(k,1693) + lu(k,1719) = lu(k,1719) - lu(k,994) * lu(k,1693) + lu(k,1722) = lu(k,1722) - lu(k,995) * lu(k,1693) + lu(k,1728) = lu(k,1728) - lu(k,996) * lu(k,1693) + lu(k,1767) = lu(k,1767) - lu(k,992) * lu(k,1758) + lu(k,1773) = lu(k,1773) - lu(k,993) * lu(k,1758) + lu(k,1781) = lu(k,1781) - lu(k,994) * lu(k,1758) + lu(k,1784) = lu(k,1784) - lu(k,995) * lu(k,1758) + lu(k,1790) = lu(k,1790) - lu(k,996) * lu(k,1758) + lu(k,1889) = lu(k,1889) - lu(k,992) * lu(k,1879) + lu(k,1895) = lu(k,1895) - lu(k,993) * lu(k,1879) + lu(k,1903) = lu(k,1903) - lu(k,994) * lu(k,1879) + lu(k,1906) = lu(k,1906) - lu(k,995) * lu(k,1879) + lu(k,1912) = lu(k,1912) - lu(k,996) * lu(k,1879) + lu(k,1976) = lu(k,1976) - lu(k,992) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,993) * lu(k,1974) + lu(k,1987) = lu(k,1987) - lu(k,994) * lu(k,1974) + lu(k,1990) = lu(k,1990) - lu(k,995) * lu(k,1974) + lu(k,1996) = lu(k,1996) - lu(k,996) * lu(k,1974) + lu(k,2092) = lu(k,2092) - lu(k,992) * lu(k,2081) + lu(k,2098) = lu(k,2098) - lu(k,993) * lu(k,2081) + lu(k,2106) = lu(k,2106) - lu(k,994) * lu(k,2081) + lu(k,2109) = lu(k,2109) - lu(k,995) * lu(k,2081) + lu(k,2115) = lu(k,2115) - lu(k,996) * lu(k,2081) + lu(k,997) = 1._r8 / lu(k,997) + lu(k,998) = lu(k,998) * lu(k,997) + lu(k,999) = lu(k,999) * lu(k,997) + lu(k,1000) = lu(k,1000) * lu(k,997) + lu(k,1015) = lu(k,1015) - lu(k,998) * lu(k,1007) + lu(k,1018) = - lu(k,999) * lu(k,1007) + lu(k,1021) = lu(k,1021) - lu(k,1000) * lu(k,1007) + lu(k,1035) = lu(k,1035) - lu(k,998) * lu(k,1029) + lu(k,1037) = - lu(k,999) * lu(k,1029) + lu(k,1040) = lu(k,1040) - lu(k,1000) * lu(k,1029) + lu(k,1054) = lu(k,1054) - lu(k,998) * lu(k,1047) + lu(k,1057) = - lu(k,999) * lu(k,1047) + lu(k,1060) = lu(k,1060) - lu(k,1000) * lu(k,1047) + lu(k,1079) = lu(k,1079) - lu(k,998) * lu(k,1075) + lu(k,1081) = - lu(k,999) * lu(k,1075) + lu(k,1083) = lu(k,1083) - lu(k,1000) * lu(k,1075) + lu(k,1096) = lu(k,1096) - lu(k,998) * lu(k,1090) + lu(k,1099) = - lu(k,999) * lu(k,1090) + lu(k,1101) = lu(k,1101) - lu(k,1000) * lu(k,1090) + lu(k,1131) = lu(k,1131) - lu(k,998) * lu(k,1122) + lu(k,1134) = - lu(k,999) * lu(k,1122) + lu(k,1137) = lu(k,1137) - lu(k,1000) * lu(k,1122) + lu(k,1145) = lu(k,1145) - lu(k,998) * lu(k,1139) + lu(k,1148) = - lu(k,999) * lu(k,1139) + lu(k,1149) = lu(k,1149) - lu(k,1000) * lu(k,1139) + lu(k,1154) = lu(k,1154) - lu(k,998) * lu(k,1151) + lu(k,1156) = - lu(k,999) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,1000) * lu(k,1151) + lu(k,1179) = lu(k,1179) - lu(k,998) * lu(k,1166) + lu(k,1183) = - lu(k,999) * lu(k,1166) + lu(k,1186) = lu(k,1186) - lu(k,1000) * lu(k,1166) + lu(k,1213) = lu(k,1213) - lu(k,998) * lu(k,1200) + lu(k,1217) = - lu(k,999) * lu(k,1200) + lu(k,1220) = lu(k,1220) - lu(k,1000) * lu(k,1200) + lu(k,1236) = lu(k,1236) - lu(k,998) * lu(k,1227) + lu(k,1239) = - lu(k,999) * lu(k,1227) + lu(k,1242) = lu(k,1242) - lu(k,1000) * lu(k,1227) + lu(k,1257) = lu(k,1257) - lu(k,998) * lu(k,1247) + lu(k,1261) = - lu(k,999) * lu(k,1247) + lu(k,1264) = lu(k,1264) - lu(k,1000) * lu(k,1247) + lu(k,1306) = lu(k,1306) - lu(k,998) * lu(k,1292) + lu(k,1310) = - lu(k,999) * lu(k,1292) + lu(k,1313) = lu(k,1313) - lu(k,1000) * lu(k,1292) + lu(k,1355) = lu(k,1355) - lu(k,998) * lu(k,1351) + lu(k,1359) = lu(k,1359) - lu(k,999) * lu(k,1351) + lu(k,1361) = lu(k,1361) - lu(k,1000) * lu(k,1351) + lu(k,1400) = lu(k,1400) - lu(k,998) * lu(k,1380) + lu(k,1404) = lu(k,1404) - lu(k,999) * lu(k,1380) + lu(k,1407) = lu(k,1407) - lu(k,1000) * lu(k,1380) + lu(k,1431) = lu(k,1431) - lu(k,998) * lu(k,1424) + lu(k,1435) = lu(k,1435) - lu(k,999) * lu(k,1424) + lu(k,1438) = lu(k,1438) - lu(k,1000) * lu(k,1424) + lu(k,1510) = lu(k,1510) - lu(k,998) * lu(k,1488) + lu(k,1515) = lu(k,1515) - lu(k,999) * lu(k,1488) + lu(k,1519) = lu(k,1519) - lu(k,1000) * lu(k,1488) + lu(k,1545) = lu(k,1545) - lu(k,998) * lu(k,1534) + lu(k,1550) = lu(k,1550) - lu(k,999) * lu(k,1534) + lu(k,1554) = lu(k,1554) - lu(k,1000) * lu(k,1534) + lu(k,1719) = lu(k,1719) - lu(k,998) * lu(k,1694) + lu(k,1724) = lu(k,1724) - lu(k,999) * lu(k,1694) + lu(k,1728) = lu(k,1728) - lu(k,1000) * lu(k,1694) + lu(k,1781) = lu(k,1781) - lu(k,998) * lu(k,1759) + lu(k,1786) = lu(k,1786) - lu(k,999) * lu(k,1759) + lu(k,1790) = lu(k,1790) - lu(k,1000) * lu(k,1759) + lu(k,1822) = lu(k,1822) - lu(k,998) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,999) * lu(k,1812) + lu(k,1831) = lu(k,1831) - lu(k,1000) * lu(k,1812) + lu(k,1846) = lu(k,1846) - lu(k,998) * lu(k,1837) + lu(k,1851) = lu(k,1851) - lu(k,999) * lu(k,1837) + lu(k,1855) = lu(k,1855) - lu(k,1000) * lu(k,1837) + lu(k,1903) = lu(k,1903) - lu(k,998) * lu(k,1880) + lu(k,1908) = - lu(k,999) * lu(k,1880) + lu(k,1912) = lu(k,1912) - lu(k,1000) * lu(k,1880) + lu(k,1987) = lu(k,1987) - lu(k,998) * lu(k,1975) + lu(k,1992) = lu(k,1992) - lu(k,999) * lu(k,1975) + lu(k,1996) = lu(k,1996) - lu(k,1000) * lu(k,1975) + lu(k,2106) = lu(k,2106) - lu(k,998) * lu(k,2082) + lu(k,2111) = lu(k,2111) - lu(k,999) * lu(k,2082) + lu(k,2115) = lu(k,2115) - lu(k,1000) * lu(k,2082) + end do + end subroutine lu_fac21 + subroutine lu_fac22( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1008) = 1._r8 / lu(k,1008) + lu(k,1009) = lu(k,1009) * lu(k,1008) + lu(k,1010) = lu(k,1010) * lu(k,1008) + lu(k,1011) = lu(k,1011) * lu(k,1008) + lu(k,1012) = lu(k,1012) * lu(k,1008) + lu(k,1013) = lu(k,1013) * lu(k,1008) + lu(k,1014) = lu(k,1014) * lu(k,1008) + lu(k,1015) = lu(k,1015) * lu(k,1008) + lu(k,1016) = lu(k,1016) * lu(k,1008) + lu(k,1017) = lu(k,1017) * lu(k,1008) + lu(k,1018) = lu(k,1018) * lu(k,1008) + lu(k,1019) = lu(k,1019) * lu(k,1008) + lu(k,1020) = lu(k,1020) * lu(k,1008) + lu(k,1021) = lu(k,1021) * lu(k,1008) + lu(k,1022) = lu(k,1022) * lu(k,1008) + lu(k,1382) = lu(k,1382) - lu(k,1009) * lu(k,1381) + lu(k,1383) = lu(k,1383) - lu(k,1010) * lu(k,1381) + lu(k,1384) = lu(k,1384) - lu(k,1011) * lu(k,1381) + lu(k,1395) = lu(k,1395) - lu(k,1012) * lu(k,1381) + lu(k,1396) = lu(k,1396) - lu(k,1013) * lu(k,1381) + lu(k,1398) = lu(k,1398) - lu(k,1014) * lu(k,1381) + lu(k,1400) = lu(k,1400) - lu(k,1015) * lu(k,1381) + lu(k,1402) = lu(k,1402) - lu(k,1016) * lu(k,1381) + lu(k,1403) = lu(k,1403) - lu(k,1017) * lu(k,1381) + lu(k,1404) = lu(k,1404) - lu(k,1018) * lu(k,1381) + lu(k,1405) = lu(k,1405) - lu(k,1019) * lu(k,1381) + lu(k,1406) = lu(k,1406) - lu(k,1020) * lu(k,1381) + lu(k,1407) = lu(k,1407) - lu(k,1021) * lu(k,1381) + lu(k,1409) = lu(k,1409) - lu(k,1022) * lu(k,1381) + lu(k,1490) = lu(k,1490) - lu(k,1009) * lu(k,1489) + lu(k,1491) = lu(k,1491) - lu(k,1010) * lu(k,1489) + lu(k,1492) = lu(k,1492) - lu(k,1011) * lu(k,1489) + lu(k,1503) = lu(k,1503) - lu(k,1012) * lu(k,1489) + lu(k,1505) = lu(k,1505) - lu(k,1013) * lu(k,1489) + lu(k,1507) = lu(k,1507) - lu(k,1014) * lu(k,1489) + lu(k,1510) = lu(k,1510) - lu(k,1015) * lu(k,1489) + lu(k,1513) = lu(k,1513) - lu(k,1016) * lu(k,1489) + lu(k,1514) = lu(k,1514) - lu(k,1017) * lu(k,1489) + lu(k,1515) = lu(k,1515) - lu(k,1018) * lu(k,1489) + lu(k,1516) = lu(k,1516) - lu(k,1019) * lu(k,1489) + lu(k,1517) = lu(k,1517) - lu(k,1020) * lu(k,1489) + lu(k,1519) = lu(k,1519) - lu(k,1021) * lu(k,1489) + lu(k,1521) = lu(k,1521) - lu(k,1022) * lu(k,1489) + lu(k,1696) = lu(k,1696) - lu(k,1009) * lu(k,1695) + lu(k,1697) = lu(k,1697) - lu(k,1010) * lu(k,1695) + lu(k,1698) = lu(k,1698) - lu(k,1011) * lu(k,1695) + lu(k,1710) = lu(k,1710) - lu(k,1012) * lu(k,1695) + lu(k,1714) = lu(k,1714) - lu(k,1013) * lu(k,1695) + lu(k,1716) = lu(k,1716) - lu(k,1014) * lu(k,1695) + lu(k,1719) = lu(k,1719) - lu(k,1015) * lu(k,1695) + lu(k,1722) = lu(k,1722) - lu(k,1016) * lu(k,1695) + lu(k,1723) = lu(k,1723) - lu(k,1017) * lu(k,1695) + lu(k,1724) = lu(k,1724) - lu(k,1018) * lu(k,1695) + lu(k,1725) = lu(k,1725) - lu(k,1019) * lu(k,1695) + lu(k,1726) = lu(k,1726) - lu(k,1020) * lu(k,1695) + lu(k,1728) = lu(k,1728) - lu(k,1021) * lu(k,1695) + lu(k,1730) = lu(k,1730) - lu(k,1022) * lu(k,1695) + lu(k,1761) = lu(k,1761) - lu(k,1009) * lu(k,1760) + lu(k,1762) = lu(k,1762) - lu(k,1010) * lu(k,1760) + lu(k,1763) = lu(k,1763) - lu(k,1011) * lu(k,1760) + lu(k,1773) = lu(k,1773) - lu(k,1012) * lu(k,1760) + lu(k,1776) = lu(k,1776) - lu(k,1013) * lu(k,1760) + lu(k,1778) = lu(k,1778) - lu(k,1014) * lu(k,1760) + lu(k,1781) = lu(k,1781) - lu(k,1015) * lu(k,1760) + lu(k,1784) = lu(k,1784) - lu(k,1016) * lu(k,1760) + lu(k,1785) = lu(k,1785) - lu(k,1017) * lu(k,1760) + lu(k,1786) = lu(k,1786) - lu(k,1018) * lu(k,1760) + lu(k,1787) = - lu(k,1019) * lu(k,1760) + lu(k,1788) = lu(k,1788) - lu(k,1020) * lu(k,1760) + lu(k,1790) = lu(k,1790) - lu(k,1021) * lu(k,1760) + lu(k,1792) = lu(k,1792) - lu(k,1022) * lu(k,1760) + lu(k,1882) = lu(k,1882) - lu(k,1009) * lu(k,1881) + lu(k,1883) = lu(k,1883) - lu(k,1010) * lu(k,1881) + lu(k,1884) = lu(k,1884) - lu(k,1011) * lu(k,1881) + lu(k,1895) = lu(k,1895) - lu(k,1012) * lu(k,1881) + lu(k,1898) = lu(k,1898) - lu(k,1013) * lu(k,1881) + lu(k,1900) = lu(k,1900) - lu(k,1014) * lu(k,1881) + lu(k,1903) = lu(k,1903) - lu(k,1015) * lu(k,1881) + lu(k,1906) = lu(k,1906) - lu(k,1016) * lu(k,1881) + lu(k,1907) = lu(k,1907) - lu(k,1017) * lu(k,1881) + lu(k,1908) = lu(k,1908) - lu(k,1018) * lu(k,1881) + lu(k,1909) = lu(k,1909) - lu(k,1019) * lu(k,1881) + lu(k,1910) = lu(k,1910) - lu(k,1020) * lu(k,1881) + lu(k,1912) = lu(k,1912) - lu(k,1021) * lu(k,1881) + lu(k,1914) = lu(k,1914) - lu(k,1022) * lu(k,1881) + lu(k,2084) = lu(k,2084) - lu(k,1009) * lu(k,2083) + lu(k,2085) = lu(k,2085) - lu(k,1010) * lu(k,2083) + lu(k,2086) = lu(k,2086) - lu(k,1011) * lu(k,2083) + lu(k,2098) = lu(k,2098) - lu(k,1012) * lu(k,2083) + lu(k,2101) = lu(k,2101) - lu(k,1013) * lu(k,2083) + lu(k,2103) = lu(k,2103) - lu(k,1014) * lu(k,2083) + lu(k,2106) = lu(k,2106) - lu(k,1015) * lu(k,2083) + lu(k,2109) = lu(k,2109) - lu(k,1016) * lu(k,2083) + lu(k,2110) = lu(k,2110) - lu(k,1017) * lu(k,2083) + lu(k,2111) = lu(k,2111) - lu(k,1018) * lu(k,2083) + lu(k,2112) = lu(k,2112) - lu(k,1019) * lu(k,2083) + lu(k,2113) = lu(k,2113) - lu(k,1020) * lu(k,2083) + lu(k,2115) = lu(k,2115) - lu(k,1021) * lu(k,2083) + lu(k,2117) = lu(k,2117) - lu(k,1022) * lu(k,2083) + lu(k,1030) = 1._r8 / lu(k,1030) + lu(k,1031) = lu(k,1031) * lu(k,1030) + lu(k,1032) = lu(k,1032) * lu(k,1030) + lu(k,1033) = lu(k,1033) * lu(k,1030) + lu(k,1034) = lu(k,1034) * lu(k,1030) + lu(k,1035) = lu(k,1035) * lu(k,1030) + lu(k,1036) = lu(k,1036) * lu(k,1030) + lu(k,1037) = lu(k,1037) * lu(k,1030) + lu(k,1038) = lu(k,1038) * lu(k,1030) + lu(k,1039) = lu(k,1039) * lu(k,1030) + lu(k,1040) = lu(k,1040) * lu(k,1030) + lu(k,1041) = lu(k,1041) * lu(k,1030) + lu(k,1050) = lu(k,1050) - lu(k,1031) * lu(k,1048) + lu(k,1051) = lu(k,1051) - lu(k,1032) * lu(k,1048) + lu(k,1052) = lu(k,1052) - lu(k,1033) * lu(k,1048) + lu(k,1053) = lu(k,1053) - lu(k,1034) * lu(k,1048) + lu(k,1054) = lu(k,1054) - lu(k,1035) * lu(k,1048) + lu(k,1055) = lu(k,1055) - lu(k,1036) * lu(k,1048) + lu(k,1057) = lu(k,1057) - lu(k,1037) * lu(k,1048) + lu(k,1058) = lu(k,1058) - lu(k,1038) * lu(k,1048) + lu(k,1059) = lu(k,1059) - lu(k,1039) * lu(k,1048) + lu(k,1060) = lu(k,1060) - lu(k,1040) * lu(k,1048) + lu(k,1061) = lu(k,1061) - lu(k,1041) * lu(k,1048) + lu(k,1384) = lu(k,1384) - lu(k,1031) * lu(k,1382) + lu(k,1395) = lu(k,1395) - lu(k,1032) * lu(k,1382) + lu(k,1396) = lu(k,1396) - lu(k,1033) * lu(k,1382) + lu(k,1398) = lu(k,1398) - lu(k,1034) * lu(k,1382) + lu(k,1400) = lu(k,1400) - lu(k,1035) * lu(k,1382) + lu(k,1402) = lu(k,1402) - lu(k,1036) * lu(k,1382) + lu(k,1404) = lu(k,1404) - lu(k,1037) * lu(k,1382) + lu(k,1405) = lu(k,1405) - lu(k,1038) * lu(k,1382) + lu(k,1406) = lu(k,1406) - lu(k,1039) * lu(k,1382) + lu(k,1407) = lu(k,1407) - lu(k,1040) * lu(k,1382) + lu(k,1409) = lu(k,1409) - lu(k,1041) * lu(k,1382) + lu(k,1492) = lu(k,1492) - lu(k,1031) * lu(k,1490) + lu(k,1503) = lu(k,1503) - lu(k,1032) * lu(k,1490) + lu(k,1505) = lu(k,1505) - lu(k,1033) * lu(k,1490) + lu(k,1507) = lu(k,1507) - lu(k,1034) * lu(k,1490) + lu(k,1510) = lu(k,1510) - lu(k,1035) * lu(k,1490) + lu(k,1513) = lu(k,1513) - lu(k,1036) * lu(k,1490) + lu(k,1515) = lu(k,1515) - lu(k,1037) * lu(k,1490) + lu(k,1516) = lu(k,1516) - lu(k,1038) * lu(k,1490) + lu(k,1517) = lu(k,1517) - lu(k,1039) * lu(k,1490) + lu(k,1519) = lu(k,1519) - lu(k,1040) * lu(k,1490) + lu(k,1521) = lu(k,1521) - lu(k,1041) * lu(k,1490) + lu(k,1698) = lu(k,1698) - lu(k,1031) * lu(k,1696) + lu(k,1710) = lu(k,1710) - lu(k,1032) * lu(k,1696) + lu(k,1714) = lu(k,1714) - lu(k,1033) * lu(k,1696) + lu(k,1716) = lu(k,1716) - lu(k,1034) * lu(k,1696) + lu(k,1719) = lu(k,1719) - lu(k,1035) * lu(k,1696) + lu(k,1722) = lu(k,1722) - lu(k,1036) * lu(k,1696) + lu(k,1724) = lu(k,1724) - lu(k,1037) * lu(k,1696) + lu(k,1725) = lu(k,1725) - lu(k,1038) * lu(k,1696) + lu(k,1726) = lu(k,1726) - lu(k,1039) * lu(k,1696) + lu(k,1728) = lu(k,1728) - lu(k,1040) * lu(k,1696) + lu(k,1730) = lu(k,1730) - lu(k,1041) * lu(k,1696) + lu(k,1763) = lu(k,1763) - lu(k,1031) * lu(k,1761) + lu(k,1773) = lu(k,1773) - lu(k,1032) * lu(k,1761) + lu(k,1776) = lu(k,1776) - lu(k,1033) * lu(k,1761) + lu(k,1778) = lu(k,1778) - lu(k,1034) * lu(k,1761) + lu(k,1781) = lu(k,1781) - lu(k,1035) * lu(k,1761) + lu(k,1784) = lu(k,1784) - lu(k,1036) * lu(k,1761) + lu(k,1786) = lu(k,1786) - lu(k,1037) * lu(k,1761) + lu(k,1787) = lu(k,1787) - lu(k,1038) * lu(k,1761) + lu(k,1788) = lu(k,1788) - lu(k,1039) * lu(k,1761) + lu(k,1790) = lu(k,1790) - lu(k,1040) * lu(k,1761) + lu(k,1792) = lu(k,1792) - lu(k,1041) * lu(k,1761) + lu(k,1884) = lu(k,1884) - lu(k,1031) * lu(k,1882) + lu(k,1895) = lu(k,1895) - lu(k,1032) * lu(k,1882) + lu(k,1898) = lu(k,1898) - lu(k,1033) * lu(k,1882) + lu(k,1900) = lu(k,1900) - lu(k,1034) * lu(k,1882) + lu(k,1903) = lu(k,1903) - lu(k,1035) * lu(k,1882) + lu(k,1906) = lu(k,1906) - lu(k,1036) * lu(k,1882) + lu(k,1908) = lu(k,1908) - lu(k,1037) * lu(k,1882) + lu(k,1909) = lu(k,1909) - lu(k,1038) * lu(k,1882) + lu(k,1910) = lu(k,1910) - lu(k,1039) * lu(k,1882) + lu(k,1912) = lu(k,1912) - lu(k,1040) * lu(k,1882) + lu(k,1914) = lu(k,1914) - lu(k,1041) * lu(k,1882) + lu(k,2086) = lu(k,2086) - lu(k,1031) * lu(k,2084) + lu(k,2098) = lu(k,2098) - lu(k,1032) * lu(k,2084) + lu(k,2101) = lu(k,2101) - lu(k,1033) * lu(k,2084) + lu(k,2103) = lu(k,2103) - lu(k,1034) * lu(k,2084) + lu(k,2106) = lu(k,2106) - lu(k,1035) * lu(k,2084) + lu(k,2109) = lu(k,2109) - lu(k,1036) * lu(k,2084) + lu(k,2111) = lu(k,2111) - lu(k,1037) * lu(k,2084) + lu(k,2112) = lu(k,2112) - lu(k,1038) * lu(k,2084) + lu(k,2113) = lu(k,2113) - lu(k,1039) * lu(k,2084) + lu(k,2115) = lu(k,2115) - lu(k,1040) * lu(k,2084) + lu(k,2117) = lu(k,2117) - lu(k,1041) * lu(k,2084) + lu(k,1049) = 1._r8 / lu(k,1049) + lu(k,1050) = lu(k,1050) * lu(k,1049) + lu(k,1051) = lu(k,1051) * lu(k,1049) + lu(k,1052) = lu(k,1052) * lu(k,1049) + lu(k,1053) = lu(k,1053) * lu(k,1049) + lu(k,1054) = lu(k,1054) * lu(k,1049) + lu(k,1055) = lu(k,1055) * lu(k,1049) + lu(k,1056) = lu(k,1056) * lu(k,1049) + lu(k,1057) = lu(k,1057) * lu(k,1049) + lu(k,1058) = lu(k,1058) * lu(k,1049) + lu(k,1059) = lu(k,1059) * lu(k,1049) + lu(k,1060) = lu(k,1060) * lu(k,1049) + lu(k,1061) = lu(k,1061) * lu(k,1049) + lu(k,1384) = lu(k,1384) - lu(k,1050) * lu(k,1383) + lu(k,1395) = lu(k,1395) - lu(k,1051) * lu(k,1383) + lu(k,1396) = lu(k,1396) - lu(k,1052) * lu(k,1383) + lu(k,1398) = lu(k,1398) - lu(k,1053) * lu(k,1383) + lu(k,1400) = lu(k,1400) - lu(k,1054) * lu(k,1383) + lu(k,1402) = lu(k,1402) - lu(k,1055) * lu(k,1383) + lu(k,1403) = lu(k,1403) - lu(k,1056) * lu(k,1383) + lu(k,1404) = lu(k,1404) - lu(k,1057) * lu(k,1383) + lu(k,1405) = lu(k,1405) - lu(k,1058) * lu(k,1383) + lu(k,1406) = lu(k,1406) - lu(k,1059) * lu(k,1383) + lu(k,1407) = lu(k,1407) - lu(k,1060) * lu(k,1383) + lu(k,1409) = lu(k,1409) - lu(k,1061) * lu(k,1383) + lu(k,1492) = lu(k,1492) - lu(k,1050) * lu(k,1491) + lu(k,1503) = lu(k,1503) - lu(k,1051) * lu(k,1491) + lu(k,1505) = lu(k,1505) - lu(k,1052) * lu(k,1491) + lu(k,1507) = lu(k,1507) - lu(k,1053) * lu(k,1491) + lu(k,1510) = lu(k,1510) - lu(k,1054) * lu(k,1491) + lu(k,1513) = lu(k,1513) - lu(k,1055) * lu(k,1491) + lu(k,1514) = lu(k,1514) - lu(k,1056) * lu(k,1491) + lu(k,1515) = lu(k,1515) - lu(k,1057) * lu(k,1491) + lu(k,1516) = lu(k,1516) - lu(k,1058) * lu(k,1491) + lu(k,1517) = lu(k,1517) - lu(k,1059) * lu(k,1491) + lu(k,1519) = lu(k,1519) - lu(k,1060) * lu(k,1491) + lu(k,1521) = lu(k,1521) - lu(k,1061) * lu(k,1491) + lu(k,1698) = lu(k,1698) - lu(k,1050) * lu(k,1697) + lu(k,1710) = lu(k,1710) - lu(k,1051) * lu(k,1697) + lu(k,1714) = lu(k,1714) - lu(k,1052) * lu(k,1697) + lu(k,1716) = lu(k,1716) - lu(k,1053) * lu(k,1697) + lu(k,1719) = lu(k,1719) - lu(k,1054) * lu(k,1697) + lu(k,1722) = lu(k,1722) - lu(k,1055) * lu(k,1697) + lu(k,1723) = lu(k,1723) - lu(k,1056) * lu(k,1697) + lu(k,1724) = lu(k,1724) - lu(k,1057) * lu(k,1697) + lu(k,1725) = lu(k,1725) - lu(k,1058) * lu(k,1697) + lu(k,1726) = lu(k,1726) - lu(k,1059) * lu(k,1697) + lu(k,1728) = lu(k,1728) - lu(k,1060) * lu(k,1697) + lu(k,1730) = lu(k,1730) - lu(k,1061) * lu(k,1697) + lu(k,1763) = lu(k,1763) - lu(k,1050) * lu(k,1762) + lu(k,1773) = lu(k,1773) - lu(k,1051) * lu(k,1762) + lu(k,1776) = lu(k,1776) - lu(k,1052) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,1053) * lu(k,1762) + lu(k,1781) = lu(k,1781) - lu(k,1054) * lu(k,1762) + lu(k,1784) = lu(k,1784) - lu(k,1055) * lu(k,1762) + lu(k,1785) = lu(k,1785) - lu(k,1056) * lu(k,1762) + lu(k,1786) = lu(k,1786) - lu(k,1057) * lu(k,1762) + lu(k,1787) = lu(k,1787) - lu(k,1058) * lu(k,1762) + lu(k,1788) = lu(k,1788) - lu(k,1059) * lu(k,1762) + lu(k,1790) = lu(k,1790) - lu(k,1060) * lu(k,1762) + lu(k,1792) = lu(k,1792) - lu(k,1061) * lu(k,1762) + lu(k,1884) = lu(k,1884) - lu(k,1050) * lu(k,1883) + lu(k,1895) = lu(k,1895) - lu(k,1051) * lu(k,1883) + lu(k,1898) = lu(k,1898) - lu(k,1052) * lu(k,1883) + lu(k,1900) = lu(k,1900) - lu(k,1053) * lu(k,1883) + lu(k,1903) = lu(k,1903) - lu(k,1054) * lu(k,1883) + lu(k,1906) = lu(k,1906) - lu(k,1055) * lu(k,1883) + lu(k,1907) = lu(k,1907) - lu(k,1056) * lu(k,1883) + lu(k,1908) = lu(k,1908) - lu(k,1057) * lu(k,1883) + lu(k,1909) = lu(k,1909) - lu(k,1058) * lu(k,1883) + lu(k,1910) = lu(k,1910) - lu(k,1059) * lu(k,1883) + lu(k,1912) = lu(k,1912) - lu(k,1060) * lu(k,1883) + lu(k,1914) = lu(k,1914) - lu(k,1061) * lu(k,1883) + lu(k,2086) = lu(k,2086) - lu(k,1050) * lu(k,2085) + lu(k,2098) = lu(k,2098) - lu(k,1051) * lu(k,2085) + lu(k,2101) = lu(k,2101) - lu(k,1052) * lu(k,2085) + lu(k,2103) = lu(k,2103) - lu(k,1053) * lu(k,2085) + lu(k,2106) = lu(k,2106) - lu(k,1054) * lu(k,2085) + lu(k,2109) = lu(k,2109) - lu(k,1055) * lu(k,2085) + lu(k,2110) = lu(k,2110) - lu(k,1056) * lu(k,2085) + lu(k,2111) = lu(k,2111) - lu(k,1057) * lu(k,2085) + lu(k,2112) = lu(k,2112) - lu(k,1058) * lu(k,2085) + lu(k,2113) = lu(k,2113) - lu(k,1059) * lu(k,2085) + lu(k,2115) = lu(k,2115) - lu(k,1060) * lu(k,2085) + lu(k,2117) = lu(k,2117) - lu(k,1061) * lu(k,2085) + lu(k,1065) = 1._r8 / lu(k,1065) + lu(k,1066) = lu(k,1066) * lu(k,1065) + lu(k,1067) = lu(k,1067) * lu(k,1065) + lu(k,1068) = lu(k,1068) * lu(k,1065) + lu(k,1069) = lu(k,1069) * lu(k,1065) + lu(k,1070) = lu(k,1070) * lu(k,1065) + lu(k,1071) = lu(k,1071) * lu(k,1065) + lu(k,1072) = lu(k,1072) * lu(k,1065) + lu(k,1073) = lu(k,1073) * lu(k,1065) + lu(k,1074) = lu(k,1074) * lu(k,1065) + lu(k,1171) = lu(k,1171) - lu(k,1066) * lu(k,1167) + lu(k,1176) = lu(k,1176) - lu(k,1067) * lu(k,1167) + lu(k,1177) = lu(k,1177) - lu(k,1068) * lu(k,1167) + lu(k,1178) = lu(k,1178) - lu(k,1069) * lu(k,1167) + lu(k,1179) = lu(k,1179) - lu(k,1070) * lu(k,1167) + lu(k,1181) = lu(k,1181) - lu(k,1071) * lu(k,1167) + lu(k,1185) = lu(k,1185) - lu(k,1072) * lu(k,1167) + lu(k,1186) = lu(k,1186) - lu(k,1073) * lu(k,1167) + lu(k,1187) = lu(k,1187) - lu(k,1074) * lu(k,1167) + lu(k,1205) = lu(k,1205) - lu(k,1066) * lu(k,1201) + lu(k,1210) = lu(k,1210) - lu(k,1067) * lu(k,1201) + lu(k,1211) = lu(k,1211) - lu(k,1068) * lu(k,1201) + lu(k,1212) = lu(k,1212) - lu(k,1069) * lu(k,1201) + lu(k,1213) = lu(k,1213) - lu(k,1070) * lu(k,1201) + lu(k,1215) = lu(k,1215) - lu(k,1071) * lu(k,1201) + lu(k,1219) = lu(k,1219) - lu(k,1072) * lu(k,1201) + lu(k,1220) = lu(k,1220) - lu(k,1073) * lu(k,1201) + lu(k,1221) = lu(k,1221) - lu(k,1074) * lu(k,1201) + lu(k,1230) = lu(k,1230) - lu(k,1066) * lu(k,1228) + lu(k,1233) = lu(k,1233) - lu(k,1067) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,1068) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,1069) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,1070) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,1071) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,1072) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,1073) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,1074) * lu(k,1228) + lu(k,1389) = lu(k,1389) - lu(k,1066) * lu(k,1384) + lu(k,1395) = lu(k,1395) - lu(k,1067) * lu(k,1384) + lu(k,1396) = lu(k,1396) - lu(k,1068) * lu(k,1384) + lu(k,1398) = lu(k,1398) - lu(k,1069) * lu(k,1384) + lu(k,1400) = lu(k,1400) - lu(k,1070) * lu(k,1384) + lu(k,1402) = lu(k,1402) - lu(k,1071) * lu(k,1384) + lu(k,1406) = lu(k,1406) - lu(k,1072) * lu(k,1384) + lu(k,1407) = lu(k,1407) - lu(k,1073) * lu(k,1384) + lu(k,1409) = lu(k,1409) - lu(k,1074) * lu(k,1384) + lu(k,1497) = lu(k,1497) - lu(k,1066) * lu(k,1492) + lu(k,1503) = lu(k,1503) - lu(k,1067) * lu(k,1492) + lu(k,1505) = lu(k,1505) - lu(k,1068) * lu(k,1492) + lu(k,1507) = lu(k,1507) - lu(k,1069) * lu(k,1492) + lu(k,1510) = lu(k,1510) - lu(k,1070) * lu(k,1492) + lu(k,1513) = lu(k,1513) - lu(k,1071) * lu(k,1492) + lu(k,1517) = lu(k,1517) - lu(k,1072) * lu(k,1492) + lu(k,1519) = lu(k,1519) - lu(k,1073) * lu(k,1492) + lu(k,1521) = lu(k,1521) - lu(k,1074) * lu(k,1492) + lu(k,1704) = lu(k,1704) - lu(k,1066) * lu(k,1698) + lu(k,1710) = lu(k,1710) - lu(k,1067) * lu(k,1698) + lu(k,1714) = lu(k,1714) - lu(k,1068) * lu(k,1698) + lu(k,1716) = lu(k,1716) - lu(k,1069) * lu(k,1698) + lu(k,1719) = lu(k,1719) - lu(k,1070) * lu(k,1698) + lu(k,1722) = lu(k,1722) - lu(k,1071) * lu(k,1698) + lu(k,1726) = lu(k,1726) - lu(k,1072) * lu(k,1698) + lu(k,1728) = lu(k,1728) - lu(k,1073) * lu(k,1698) + lu(k,1730) = lu(k,1730) - lu(k,1074) * lu(k,1698) + lu(k,1767) = lu(k,1767) - lu(k,1066) * lu(k,1763) + lu(k,1773) = lu(k,1773) - lu(k,1067) * lu(k,1763) + lu(k,1776) = lu(k,1776) - lu(k,1068) * lu(k,1763) + lu(k,1778) = lu(k,1778) - lu(k,1069) * lu(k,1763) + lu(k,1781) = lu(k,1781) - lu(k,1070) * lu(k,1763) + lu(k,1784) = lu(k,1784) - lu(k,1071) * lu(k,1763) + lu(k,1788) = lu(k,1788) - lu(k,1072) * lu(k,1763) + lu(k,1790) = lu(k,1790) - lu(k,1073) * lu(k,1763) + lu(k,1792) = lu(k,1792) - lu(k,1074) * lu(k,1763) + lu(k,1889) = lu(k,1889) - lu(k,1066) * lu(k,1884) + lu(k,1895) = lu(k,1895) - lu(k,1067) * lu(k,1884) + lu(k,1898) = lu(k,1898) - lu(k,1068) * lu(k,1884) + lu(k,1900) = lu(k,1900) - lu(k,1069) * lu(k,1884) + lu(k,1903) = lu(k,1903) - lu(k,1070) * lu(k,1884) + lu(k,1906) = lu(k,1906) - lu(k,1071) * lu(k,1884) + lu(k,1910) = lu(k,1910) - lu(k,1072) * lu(k,1884) + lu(k,1912) = lu(k,1912) - lu(k,1073) * lu(k,1884) + lu(k,1914) = lu(k,1914) - lu(k,1074) * lu(k,1884) + lu(k,2092) = lu(k,2092) - lu(k,1066) * lu(k,2086) + lu(k,2098) = lu(k,2098) - lu(k,1067) * lu(k,2086) + lu(k,2101) = lu(k,2101) - lu(k,1068) * lu(k,2086) + lu(k,2103) = lu(k,2103) - lu(k,1069) * lu(k,2086) + lu(k,2106) = lu(k,2106) - lu(k,1070) * lu(k,2086) + lu(k,2109) = lu(k,2109) - lu(k,1071) * lu(k,2086) + lu(k,2113) = lu(k,2113) - lu(k,1072) * lu(k,2086) + lu(k,2115) = lu(k,2115) - lu(k,1073) * lu(k,2086) + lu(k,2117) = lu(k,2117) - lu(k,1074) * lu(k,2086) + end do + end subroutine lu_fac22 + subroutine lu_fac23( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1076) = 1._r8 / lu(k,1076) + lu(k,1077) = lu(k,1077) * lu(k,1076) + lu(k,1078) = lu(k,1078) * lu(k,1076) + lu(k,1079) = lu(k,1079) * lu(k,1076) + lu(k,1080) = lu(k,1080) * lu(k,1076) + lu(k,1081) = lu(k,1081) * lu(k,1076) + lu(k,1082) = lu(k,1082) * lu(k,1076) + lu(k,1083) = lu(k,1083) * lu(k,1076) + lu(k,1084) = lu(k,1084) * lu(k,1076) + lu(k,1176) = lu(k,1176) - lu(k,1077) * lu(k,1168) + lu(k,1177) = lu(k,1177) - lu(k,1078) * lu(k,1168) + lu(k,1179) = lu(k,1179) - lu(k,1079) * lu(k,1168) + lu(k,1182) = lu(k,1182) - lu(k,1080) * lu(k,1168) + lu(k,1183) = lu(k,1183) - lu(k,1081) * lu(k,1168) + lu(k,1184) = lu(k,1184) - lu(k,1082) * lu(k,1168) + lu(k,1186) = lu(k,1186) - lu(k,1083) * lu(k,1168) + lu(k,1187) = lu(k,1187) - lu(k,1084) * lu(k,1168) + lu(k,1210) = lu(k,1210) - lu(k,1077) * lu(k,1202) + lu(k,1211) = lu(k,1211) - lu(k,1078) * lu(k,1202) + lu(k,1213) = lu(k,1213) - lu(k,1079) * lu(k,1202) + lu(k,1216) = lu(k,1216) - lu(k,1080) * lu(k,1202) + lu(k,1217) = lu(k,1217) - lu(k,1081) * lu(k,1202) + lu(k,1218) = lu(k,1218) - lu(k,1082) * lu(k,1202) + lu(k,1220) = lu(k,1220) - lu(k,1083) * lu(k,1202) + lu(k,1221) = lu(k,1221) - lu(k,1084) * lu(k,1202) + lu(k,1233) = lu(k,1233) - lu(k,1077) * lu(k,1229) + lu(k,1234) = lu(k,1234) - lu(k,1078) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,1079) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1080) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1081) * lu(k,1229) + lu(k,1240) = lu(k,1240) - lu(k,1082) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,1083) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,1084) * lu(k,1229) + lu(k,1253) = lu(k,1253) - lu(k,1077) * lu(k,1248) + lu(k,1254) = lu(k,1254) - lu(k,1078) * lu(k,1248) + lu(k,1257) = lu(k,1257) - lu(k,1079) * lu(k,1248) + lu(k,1260) = lu(k,1260) - lu(k,1080) * lu(k,1248) + lu(k,1261) = lu(k,1261) - lu(k,1081) * lu(k,1248) + lu(k,1262) = - lu(k,1082) * lu(k,1248) + lu(k,1264) = lu(k,1264) - lu(k,1083) * lu(k,1248) + lu(k,1265) = lu(k,1265) - lu(k,1084) * lu(k,1248) + lu(k,1395) = lu(k,1395) - lu(k,1077) * lu(k,1385) + lu(k,1396) = lu(k,1396) - lu(k,1078) * lu(k,1385) + lu(k,1400) = lu(k,1400) - lu(k,1079) * lu(k,1385) + lu(k,1403) = lu(k,1403) - lu(k,1080) * lu(k,1385) + lu(k,1404) = lu(k,1404) - lu(k,1081) * lu(k,1385) + lu(k,1405) = lu(k,1405) - lu(k,1082) * lu(k,1385) + lu(k,1407) = lu(k,1407) - lu(k,1083) * lu(k,1385) + lu(k,1409) = lu(k,1409) - lu(k,1084) * lu(k,1385) + lu(k,1503) = lu(k,1503) - lu(k,1077) * lu(k,1493) + lu(k,1505) = lu(k,1505) - lu(k,1078) * lu(k,1493) + lu(k,1510) = lu(k,1510) - lu(k,1079) * lu(k,1493) + lu(k,1514) = lu(k,1514) - lu(k,1080) * lu(k,1493) + lu(k,1515) = lu(k,1515) - lu(k,1081) * lu(k,1493) + lu(k,1516) = lu(k,1516) - lu(k,1082) * lu(k,1493) + lu(k,1519) = lu(k,1519) - lu(k,1083) * lu(k,1493) + lu(k,1521) = lu(k,1521) - lu(k,1084) * lu(k,1493) + lu(k,1537) = - lu(k,1077) * lu(k,1535) + lu(k,1540) = lu(k,1540) - lu(k,1078) * lu(k,1535) + lu(k,1545) = lu(k,1545) - lu(k,1079) * lu(k,1535) + lu(k,1549) = lu(k,1549) - lu(k,1080) * lu(k,1535) + lu(k,1550) = lu(k,1550) - lu(k,1081) * lu(k,1535) + lu(k,1551) = lu(k,1551) - lu(k,1082) * lu(k,1535) + lu(k,1554) = lu(k,1554) - lu(k,1083) * lu(k,1535) + lu(k,1556) = lu(k,1556) - lu(k,1084) * lu(k,1535) + lu(k,1710) = lu(k,1710) - lu(k,1077) * lu(k,1699) + lu(k,1714) = lu(k,1714) - lu(k,1078) * lu(k,1699) + lu(k,1719) = lu(k,1719) - lu(k,1079) * lu(k,1699) + lu(k,1723) = lu(k,1723) - lu(k,1080) * lu(k,1699) + lu(k,1724) = lu(k,1724) - lu(k,1081) * lu(k,1699) + lu(k,1725) = lu(k,1725) - lu(k,1082) * lu(k,1699) + lu(k,1728) = lu(k,1728) - lu(k,1083) * lu(k,1699) + lu(k,1730) = lu(k,1730) - lu(k,1084) * lu(k,1699) + lu(k,1773) = lu(k,1773) - lu(k,1077) * lu(k,1764) + lu(k,1776) = lu(k,1776) - lu(k,1078) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1079) * lu(k,1764) + lu(k,1785) = lu(k,1785) - lu(k,1080) * lu(k,1764) + lu(k,1786) = lu(k,1786) - lu(k,1081) * lu(k,1764) + lu(k,1787) = lu(k,1787) - lu(k,1082) * lu(k,1764) + lu(k,1790) = lu(k,1790) - lu(k,1083) * lu(k,1764) + lu(k,1792) = lu(k,1792) - lu(k,1084) * lu(k,1764) + lu(k,1895) = lu(k,1895) - lu(k,1077) * lu(k,1885) + lu(k,1898) = lu(k,1898) - lu(k,1078) * lu(k,1885) + lu(k,1903) = lu(k,1903) - lu(k,1079) * lu(k,1885) + lu(k,1907) = lu(k,1907) - lu(k,1080) * lu(k,1885) + lu(k,1908) = lu(k,1908) - lu(k,1081) * lu(k,1885) + lu(k,1909) = lu(k,1909) - lu(k,1082) * lu(k,1885) + lu(k,1912) = lu(k,1912) - lu(k,1083) * lu(k,1885) + lu(k,1914) = lu(k,1914) - lu(k,1084) * lu(k,1885) + lu(k,2098) = lu(k,2098) - lu(k,1077) * lu(k,2087) + lu(k,2101) = lu(k,2101) - lu(k,1078) * lu(k,2087) + lu(k,2106) = lu(k,2106) - lu(k,1079) * lu(k,2087) + lu(k,2110) = lu(k,2110) - lu(k,1080) * lu(k,2087) + lu(k,2111) = lu(k,2111) - lu(k,1081) * lu(k,2087) + lu(k,2112) = lu(k,2112) - lu(k,1082) * lu(k,2087) + lu(k,2115) = lu(k,2115) - lu(k,1083) * lu(k,2087) + lu(k,2117) = lu(k,2117) - lu(k,1084) * lu(k,2087) + lu(k,1091) = 1._r8 / lu(k,1091) + lu(k,1092) = lu(k,1092) * lu(k,1091) + lu(k,1093) = lu(k,1093) * lu(k,1091) + lu(k,1094) = lu(k,1094) * lu(k,1091) + lu(k,1095) = lu(k,1095) * lu(k,1091) + lu(k,1096) = lu(k,1096) * lu(k,1091) + lu(k,1097) = lu(k,1097) * lu(k,1091) + lu(k,1098) = lu(k,1098) * lu(k,1091) + lu(k,1099) = lu(k,1099) * lu(k,1091) + lu(k,1100) = lu(k,1100) * lu(k,1091) + lu(k,1101) = lu(k,1101) * lu(k,1091) + lu(k,1126) = lu(k,1126) - lu(k,1092) * lu(k,1123) + lu(k,1128) = lu(k,1128) - lu(k,1093) * lu(k,1123) + lu(k,1129) = lu(k,1129) - lu(k,1094) * lu(k,1123) + lu(k,1130) = lu(k,1130) - lu(k,1095) * lu(k,1123) + lu(k,1131) = lu(k,1131) - lu(k,1096) * lu(k,1123) + lu(k,1132) = lu(k,1132) - lu(k,1097) * lu(k,1123) + lu(k,1133) = lu(k,1133) - lu(k,1098) * lu(k,1123) + lu(k,1134) = lu(k,1134) - lu(k,1099) * lu(k,1123) + lu(k,1136) = lu(k,1136) - lu(k,1100) * lu(k,1123) + lu(k,1137) = lu(k,1137) - lu(k,1101) * lu(k,1123) + lu(k,1171) = lu(k,1171) - lu(k,1092) * lu(k,1169) + lu(k,1176) = lu(k,1176) - lu(k,1093) * lu(k,1169) + lu(k,1177) = lu(k,1177) - lu(k,1094) * lu(k,1169) + lu(k,1178) = lu(k,1178) - lu(k,1095) * lu(k,1169) + lu(k,1179) = lu(k,1179) - lu(k,1096) * lu(k,1169) + lu(k,1181) = lu(k,1181) - lu(k,1097) * lu(k,1169) + lu(k,1182) = lu(k,1182) - lu(k,1098) * lu(k,1169) + lu(k,1183) = lu(k,1183) - lu(k,1099) * lu(k,1169) + lu(k,1185) = lu(k,1185) - lu(k,1100) * lu(k,1169) + lu(k,1186) = lu(k,1186) - lu(k,1101) * lu(k,1169) + lu(k,1205) = lu(k,1205) - lu(k,1092) * lu(k,1203) + lu(k,1210) = lu(k,1210) - lu(k,1093) * lu(k,1203) + lu(k,1211) = lu(k,1211) - lu(k,1094) * lu(k,1203) + lu(k,1212) = lu(k,1212) - lu(k,1095) * lu(k,1203) + lu(k,1213) = lu(k,1213) - lu(k,1096) * lu(k,1203) + lu(k,1215) = lu(k,1215) - lu(k,1097) * lu(k,1203) + lu(k,1216) = lu(k,1216) - lu(k,1098) * lu(k,1203) + lu(k,1217) = lu(k,1217) - lu(k,1099) * lu(k,1203) + lu(k,1219) = lu(k,1219) - lu(k,1100) * lu(k,1203) + lu(k,1220) = lu(k,1220) - lu(k,1101) * lu(k,1203) + lu(k,1296) = lu(k,1296) - lu(k,1092) * lu(k,1293) + lu(k,1302) = lu(k,1302) - lu(k,1093) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1094) * lu(k,1293) + lu(k,1305) = lu(k,1305) - lu(k,1095) * lu(k,1293) + lu(k,1306) = lu(k,1306) - lu(k,1096) * lu(k,1293) + lu(k,1308) = lu(k,1308) - lu(k,1097) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1098) * lu(k,1293) + lu(k,1310) = lu(k,1310) - lu(k,1099) * lu(k,1293) + lu(k,1312) = lu(k,1312) - lu(k,1100) * lu(k,1293) + lu(k,1313) = lu(k,1313) - lu(k,1101) * lu(k,1293) + lu(k,1389) = lu(k,1389) - lu(k,1092) * lu(k,1386) + lu(k,1395) = lu(k,1395) - lu(k,1093) * lu(k,1386) + lu(k,1396) = lu(k,1396) - lu(k,1094) * lu(k,1386) + lu(k,1398) = lu(k,1398) - lu(k,1095) * lu(k,1386) + lu(k,1400) = lu(k,1400) - lu(k,1096) * lu(k,1386) + lu(k,1402) = lu(k,1402) - lu(k,1097) * lu(k,1386) + lu(k,1403) = lu(k,1403) - lu(k,1098) * lu(k,1386) + lu(k,1404) = lu(k,1404) - lu(k,1099) * lu(k,1386) + lu(k,1406) = lu(k,1406) - lu(k,1100) * lu(k,1386) + lu(k,1407) = lu(k,1407) - lu(k,1101) * lu(k,1386) + lu(k,1497) = lu(k,1497) - lu(k,1092) * lu(k,1494) + lu(k,1503) = lu(k,1503) - lu(k,1093) * lu(k,1494) + lu(k,1505) = lu(k,1505) - lu(k,1094) * lu(k,1494) + lu(k,1507) = lu(k,1507) - lu(k,1095) * lu(k,1494) + lu(k,1510) = lu(k,1510) - lu(k,1096) * lu(k,1494) + lu(k,1513) = lu(k,1513) - lu(k,1097) * lu(k,1494) + lu(k,1514) = lu(k,1514) - lu(k,1098) * lu(k,1494) + lu(k,1515) = lu(k,1515) - lu(k,1099) * lu(k,1494) + lu(k,1517) = lu(k,1517) - lu(k,1100) * lu(k,1494) + lu(k,1519) = lu(k,1519) - lu(k,1101) * lu(k,1494) + lu(k,1704) = lu(k,1704) - lu(k,1092) * lu(k,1700) + lu(k,1710) = lu(k,1710) - lu(k,1093) * lu(k,1700) + lu(k,1714) = lu(k,1714) - lu(k,1094) * lu(k,1700) + lu(k,1716) = lu(k,1716) - lu(k,1095) * lu(k,1700) + lu(k,1719) = lu(k,1719) - lu(k,1096) * lu(k,1700) + lu(k,1722) = lu(k,1722) - lu(k,1097) * lu(k,1700) + lu(k,1723) = lu(k,1723) - lu(k,1098) * lu(k,1700) + lu(k,1724) = lu(k,1724) - lu(k,1099) * lu(k,1700) + lu(k,1726) = lu(k,1726) - lu(k,1100) * lu(k,1700) + lu(k,1728) = lu(k,1728) - lu(k,1101) * lu(k,1700) + lu(k,1889) = lu(k,1889) - lu(k,1092) * lu(k,1886) + lu(k,1895) = lu(k,1895) - lu(k,1093) * lu(k,1886) + lu(k,1898) = lu(k,1898) - lu(k,1094) * lu(k,1886) + lu(k,1900) = lu(k,1900) - lu(k,1095) * lu(k,1886) + lu(k,1903) = lu(k,1903) - lu(k,1096) * lu(k,1886) + lu(k,1906) = lu(k,1906) - lu(k,1097) * lu(k,1886) + lu(k,1907) = lu(k,1907) - lu(k,1098) * lu(k,1886) + lu(k,1908) = lu(k,1908) - lu(k,1099) * lu(k,1886) + lu(k,1910) = lu(k,1910) - lu(k,1100) * lu(k,1886) + lu(k,1912) = lu(k,1912) - lu(k,1101) * lu(k,1886) + lu(k,2092) = lu(k,2092) - lu(k,1092) * lu(k,2088) + lu(k,2098) = lu(k,2098) - lu(k,1093) * lu(k,2088) + lu(k,2101) = lu(k,2101) - lu(k,1094) * lu(k,2088) + lu(k,2103) = lu(k,2103) - lu(k,1095) * lu(k,2088) + lu(k,2106) = lu(k,2106) - lu(k,1096) * lu(k,2088) + lu(k,2109) = lu(k,2109) - lu(k,1097) * lu(k,2088) + lu(k,2110) = lu(k,2110) - lu(k,1098) * lu(k,2088) + lu(k,2111) = lu(k,2111) - lu(k,1099) * lu(k,2088) + lu(k,2113) = lu(k,2113) - lu(k,1100) * lu(k,2088) + lu(k,2115) = lu(k,2115) - lu(k,1101) * lu(k,2088) + lu(k,1104) = 1._r8 / lu(k,1104) + lu(k,1105) = lu(k,1105) * lu(k,1104) + lu(k,1106) = lu(k,1106) * lu(k,1104) + lu(k,1107) = lu(k,1107) * lu(k,1104) + lu(k,1108) = lu(k,1108) * lu(k,1104) + lu(k,1109) = lu(k,1109) * lu(k,1104) + lu(k,1110) = lu(k,1110) * lu(k,1104) + lu(k,1111) = lu(k,1111) * lu(k,1104) + lu(k,1112) = lu(k,1112) * lu(k,1104) + lu(k,1113) = lu(k,1113) * lu(k,1104) + lu(k,1114) = lu(k,1114) * lu(k,1104) + lu(k,1538) = lu(k,1538) - lu(k,1105) * lu(k,1536) + lu(k,1540) = lu(k,1540) - lu(k,1106) * lu(k,1536) + lu(k,1543) = lu(k,1543) - lu(k,1107) * lu(k,1536) + lu(k,1544) = - lu(k,1108) * lu(k,1536) + lu(k,1545) = lu(k,1545) - lu(k,1109) * lu(k,1536) + lu(k,1547) = lu(k,1547) - lu(k,1110) * lu(k,1536) + lu(k,1549) = lu(k,1549) - lu(k,1111) * lu(k,1536) + lu(k,1550) = lu(k,1550) - lu(k,1112) * lu(k,1536) + lu(k,1551) = lu(k,1551) - lu(k,1113) * lu(k,1536) + lu(k,1556) = lu(k,1556) - lu(k,1114) * lu(k,1536) + lu(k,1564) = lu(k,1564) - lu(k,1105) * lu(k,1563) + lu(k,1566) = lu(k,1566) - lu(k,1106) * lu(k,1563) + lu(k,1569) = lu(k,1569) - lu(k,1107) * lu(k,1563) + lu(k,1570) = lu(k,1570) - lu(k,1108) * lu(k,1563) + lu(k,1571) = lu(k,1571) - lu(k,1109) * lu(k,1563) + lu(k,1573) = lu(k,1573) - lu(k,1110) * lu(k,1563) + lu(k,1575) = lu(k,1575) - lu(k,1111) * lu(k,1563) + lu(k,1576) = lu(k,1576) - lu(k,1112) * lu(k,1563) + lu(k,1577) = lu(k,1577) - lu(k,1113) * lu(k,1563) + lu(k,1582) = lu(k,1582) - lu(k,1114) * lu(k,1563) + lu(k,1712) = lu(k,1712) - lu(k,1105) * lu(k,1701) + lu(k,1714) = lu(k,1714) - lu(k,1106) * lu(k,1701) + lu(k,1717) = lu(k,1717) - lu(k,1107) * lu(k,1701) + lu(k,1718) = lu(k,1718) - lu(k,1108) * lu(k,1701) + lu(k,1719) = lu(k,1719) - lu(k,1109) * lu(k,1701) + lu(k,1721) = lu(k,1721) - lu(k,1110) * lu(k,1701) + lu(k,1723) = lu(k,1723) - lu(k,1111) * lu(k,1701) + lu(k,1724) = lu(k,1724) - lu(k,1112) * lu(k,1701) + lu(k,1725) = lu(k,1725) - lu(k,1113) * lu(k,1701) + lu(k,1730) = lu(k,1730) - lu(k,1114) * lu(k,1701) + lu(k,1815) = lu(k,1815) - lu(k,1105) * lu(k,1813) + lu(k,1817) = - lu(k,1106) * lu(k,1813) + lu(k,1820) = lu(k,1820) - lu(k,1107) * lu(k,1813) + lu(k,1821) = lu(k,1821) - lu(k,1108) * lu(k,1813) + lu(k,1822) = lu(k,1822) - lu(k,1109) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,1110) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1111) * lu(k,1813) + lu(k,1827) = lu(k,1827) - lu(k,1112) * lu(k,1813) + lu(k,1828) = lu(k,1828) - lu(k,1113) * lu(k,1813) + lu(k,1833) = lu(k,1833) - lu(k,1114) * lu(k,1813) + lu(k,1839) = lu(k,1839) - lu(k,1105) * lu(k,1838) + lu(k,1841) = - lu(k,1106) * lu(k,1838) + lu(k,1844) = lu(k,1844) - lu(k,1107) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,1108) * lu(k,1838) + lu(k,1846) = lu(k,1846) - lu(k,1109) * lu(k,1838) + lu(k,1848) = lu(k,1848) - lu(k,1110) * lu(k,1838) + lu(k,1850) = lu(k,1850) - lu(k,1111) * lu(k,1838) + lu(k,1851) = lu(k,1851) - lu(k,1112) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,1113) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,1114) * lu(k,1838) + lu(k,1916) = - lu(k,1105) * lu(k,1915) + lu(k,1918) = - lu(k,1106) * lu(k,1915) + lu(k,1921) = - lu(k,1107) * lu(k,1915) + lu(k,1922) = - lu(k,1108) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,1109) * lu(k,1915) + lu(k,1925) = lu(k,1925) - lu(k,1110) * lu(k,1915) + lu(k,1927) = - lu(k,1111) * lu(k,1915) + lu(k,1928) = lu(k,1928) - lu(k,1112) * lu(k,1915) + lu(k,1929) = - lu(k,1113) * lu(k,1915) + lu(k,1934) = lu(k,1934) - lu(k,1114) * lu(k,1915) + lu(k,1938) = - lu(k,1105) * lu(k,1937) + lu(k,1940) = lu(k,1940) - lu(k,1106) * lu(k,1937) + lu(k,1943) = - lu(k,1107) * lu(k,1937) + lu(k,1944) = - lu(k,1108) * lu(k,1937) + lu(k,1945) = lu(k,1945) - lu(k,1109) * lu(k,1937) + lu(k,1947) = - lu(k,1110) * lu(k,1937) + lu(k,1949) = lu(k,1949) - lu(k,1111) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1112) * lu(k,1937) + lu(k,1951) = lu(k,1951) - lu(k,1113) * lu(k,1937) + lu(k,1956) = lu(k,1956) - lu(k,1114) * lu(k,1937) + lu(k,2099) = lu(k,2099) - lu(k,1105) * lu(k,2089) + lu(k,2101) = lu(k,2101) - lu(k,1106) * lu(k,2089) + lu(k,2104) = lu(k,2104) - lu(k,1107) * lu(k,2089) + lu(k,2105) = lu(k,2105) - lu(k,1108) * lu(k,2089) + lu(k,2106) = lu(k,2106) - lu(k,1109) * lu(k,2089) + lu(k,2108) = lu(k,2108) - lu(k,1110) * lu(k,2089) + lu(k,2110) = lu(k,2110) - lu(k,1111) * lu(k,2089) + lu(k,2111) = lu(k,2111) - lu(k,1112) * lu(k,2089) + lu(k,2112) = lu(k,2112) - lu(k,1113) * lu(k,2089) + lu(k,2117) = lu(k,2117) - lu(k,1114) * lu(k,2089) + lu(k,2152) = - lu(k,1105) * lu(k,2150) + lu(k,2154) = lu(k,2154) - lu(k,1106) * lu(k,2150) + lu(k,2157) = - lu(k,1107) * lu(k,2150) + lu(k,2158) = lu(k,2158) - lu(k,1108) * lu(k,2150) + lu(k,2159) = lu(k,2159) - lu(k,1109) * lu(k,2150) + lu(k,2161) = lu(k,2161) - lu(k,1110) * lu(k,2150) + lu(k,2163) = lu(k,2163) - lu(k,1111) * lu(k,2150) + lu(k,2164) = lu(k,2164) - lu(k,1112) * lu(k,2150) + lu(k,2165) = lu(k,2165) - lu(k,1113) * lu(k,2150) + lu(k,2170) = lu(k,2170) - lu(k,1114) * lu(k,2150) + lu(k,1124) = 1._r8 / lu(k,1124) + lu(k,1125) = lu(k,1125) * lu(k,1124) + lu(k,1126) = lu(k,1126) * lu(k,1124) + lu(k,1127) = lu(k,1127) * lu(k,1124) + lu(k,1128) = lu(k,1128) * lu(k,1124) + lu(k,1129) = lu(k,1129) * lu(k,1124) + lu(k,1130) = lu(k,1130) * lu(k,1124) + lu(k,1131) = lu(k,1131) * lu(k,1124) + lu(k,1132) = lu(k,1132) * lu(k,1124) + lu(k,1133) = lu(k,1133) * lu(k,1124) + lu(k,1134) = lu(k,1134) * lu(k,1124) + lu(k,1135) = lu(k,1135) * lu(k,1124) + lu(k,1136) = lu(k,1136) * lu(k,1124) + lu(k,1137) = lu(k,1137) * lu(k,1124) + lu(k,1295) = lu(k,1295) - lu(k,1125) * lu(k,1294) + lu(k,1296) = lu(k,1296) - lu(k,1126) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,1127) * lu(k,1294) + lu(k,1302) = lu(k,1302) - lu(k,1128) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,1129) * lu(k,1294) + lu(k,1305) = lu(k,1305) - lu(k,1130) * lu(k,1294) + lu(k,1306) = lu(k,1306) - lu(k,1131) * lu(k,1294) + lu(k,1308) = lu(k,1308) - lu(k,1132) * lu(k,1294) + lu(k,1309) = lu(k,1309) - lu(k,1133) * lu(k,1294) + lu(k,1310) = lu(k,1310) - lu(k,1134) * lu(k,1294) + lu(k,1311) = lu(k,1311) - lu(k,1135) * lu(k,1294) + lu(k,1312) = lu(k,1312) - lu(k,1136) * lu(k,1294) + lu(k,1313) = lu(k,1313) - lu(k,1137) * lu(k,1294) + lu(k,1388) = lu(k,1388) - lu(k,1125) * lu(k,1387) + lu(k,1389) = lu(k,1389) - lu(k,1126) * lu(k,1387) + lu(k,1393) = lu(k,1393) - lu(k,1127) * lu(k,1387) + lu(k,1395) = lu(k,1395) - lu(k,1128) * lu(k,1387) + lu(k,1396) = lu(k,1396) - lu(k,1129) * lu(k,1387) + lu(k,1398) = lu(k,1398) - lu(k,1130) * lu(k,1387) + lu(k,1400) = lu(k,1400) - lu(k,1131) * lu(k,1387) + lu(k,1402) = lu(k,1402) - lu(k,1132) * lu(k,1387) + lu(k,1403) = lu(k,1403) - lu(k,1133) * lu(k,1387) + lu(k,1404) = lu(k,1404) - lu(k,1134) * lu(k,1387) + lu(k,1405) = lu(k,1405) - lu(k,1135) * lu(k,1387) + lu(k,1406) = lu(k,1406) - lu(k,1136) * lu(k,1387) + lu(k,1407) = lu(k,1407) - lu(k,1137) * lu(k,1387) + lu(k,1496) = lu(k,1496) - lu(k,1125) * lu(k,1495) + lu(k,1497) = lu(k,1497) - lu(k,1126) * lu(k,1495) + lu(k,1501) = lu(k,1501) - lu(k,1127) * lu(k,1495) + lu(k,1503) = lu(k,1503) - lu(k,1128) * lu(k,1495) + lu(k,1505) = lu(k,1505) - lu(k,1129) * lu(k,1495) + lu(k,1507) = lu(k,1507) - lu(k,1130) * lu(k,1495) + lu(k,1510) = lu(k,1510) - lu(k,1131) * lu(k,1495) + lu(k,1513) = lu(k,1513) - lu(k,1132) * lu(k,1495) + lu(k,1514) = lu(k,1514) - lu(k,1133) * lu(k,1495) + lu(k,1515) = lu(k,1515) - lu(k,1134) * lu(k,1495) + lu(k,1516) = lu(k,1516) - lu(k,1135) * lu(k,1495) + lu(k,1517) = lu(k,1517) - lu(k,1136) * lu(k,1495) + lu(k,1519) = lu(k,1519) - lu(k,1137) * lu(k,1495) + lu(k,1703) = lu(k,1703) - lu(k,1125) * lu(k,1702) + lu(k,1704) = lu(k,1704) - lu(k,1126) * lu(k,1702) + lu(k,1708) = lu(k,1708) - lu(k,1127) * lu(k,1702) + lu(k,1710) = lu(k,1710) - lu(k,1128) * lu(k,1702) + lu(k,1714) = lu(k,1714) - lu(k,1129) * lu(k,1702) + lu(k,1716) = lu(k,1716) - lu(k,1130) * lu(k,1702) + lu(k,1719) = lu(k,1719) - lu(k,1131) * lu(k,1702) + lu(k,1722) = lu(k,1722) - lu(k,1132) * lu(k,1702) + lu(k,1723) = lu(k,1723) - lu(k,1133) * lu(k,1702) + lu(k,1724) = lu(k,1724) - lu(k,1134) * lu(k,1702) + lu(k,1725) = lu(k,1725) - lu(k,1135) * lu(k,1702) + lu(k,1726) = lu(k,1726) - lu(k,1136) * lu(k,1702) + lu(k,1728) = lu(k,1728) - lu(k,1137) * lu(k,1702) + lu(k,1766) = lu(k,1766) - lu(k,1125) * lu(k,1765) + lu(k,1767) = lu(k,1767) - lu(k,1126) * lu(k,1765) + lu(k,1771) = lu(k,1771) - lu(k,1127) * lu(k,1765) + lu(k,1773) = lu(k,1773) - lu(k,1128) * lu(k,1765) + lu(k,1776) = lu(k,1776) - lu(k,1129) * lu(k,1765) + lu(k,1778) = lu(k,1778) - lu(k,1130) * lu(k,1765) + lu(k,1781) = lu(k,1781) - lu(k,1131) * lu(k,1765) + lu(k,1784) = lu(k,1784) - lu(k,1132) * lu(k,1765) + lu(k,1785) = lu(k,1785) - lu(k,1133) * lu(k,1765) + lu(k,1786) = lu(k,1786) - lu(k,1134) * lu(k,1765) + lu(k,1787) = lu(k,1787) - lu(k,1135) * lu(k,1765) + lu(k,1788) = lu(k,1788) - lu(k,1136) * lu(k,1765) + lu(k,1790) = lu(k,1790) - lu(k,1137) * lu(k,1765) + lu(k,1888) = lu(k,1888) - lu(k,1125) * lu(k,1887) + lu(k,1889) = lu(k,1889) - lu(k,1126) * lu(k,1887) + lu(k,1893) = lu(k,1893) - lu(k,1127) * lu(k,1887) + lu(k,1895) = lu(k,1895) - lu(k,1128) * lu(k,1887) + lu(k,1898) = lu(k,1898) - lu(k,1129) * lu(k,1887) + lu(k,1900) = lu(k,1900) - lu(k,1130) * lu(k,1887) + lu(k,1903) = lu(k,1903) - lu(k,1131) * lu(k,1887) + lu(k,1906) = lu(k,1906) - lu(k,1132) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,1133) * lu(k,1887) + lu(k,1908) = lu(k,1908) - lu(k,1134) * lu(k,1887) + lu(k,1909) = lu(k,1909) - lu(k,1135) * lu(k,1887) + lu(k,1910) = lu(k,1910) - lu(k,1136) * lu(k,1887) + lu(k,1912) = lu(k,1912) - lu(k,1137) * lu(k,1887) + lu(k,2091) = lu(k,2091) - lu(k,1125) * lu(k,2090) + lu(k,2092) = lu(k,2092) - lu(k,1126) * lu(k,2090) + lu(k,2096) = lu(k,2096) - lu(k,1127) * lu(k,2090) + lu(k,2098) = lu(k,2098) - lu(k,1128) * lu(k,2090) + lu(k,2101) = lu(k,2101) - lu(k,1129) * lu(k,2090) + lu(k,2103) = lu(k,2103) - lu(k,1130) * lu(k,2090) + lu(k,2106) = lu(k,2106) - lu(k,1131) * lu(k,2090) + lu(k,2109) = lu(k,2109) - lu(k,1132) * lu(k,2090) + lu(k,2110) = lu(k,2110) - lu(k,1133) * lu(k,2090) + lu(k,2111) = lu(k,2111) - lu(k,1134) * lu(k,2090) + lu(k,2112) = lu(k,2112) - lu(k,1135) * lu(k,2090) + lu(k,2113) = lu(k,2113) - lu(k,1136) * lu(k,2090) + lu(k,2115) = lu(k,2115) - lu(k,1137) * lu(k,2090) + end do + end subroutine lu_fac23 + subroutine lu_fac24( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1140) = 1._r8 / lu(k,1140) + lu(k,1141) = lu(k,1141) * lu(k,1140) + lu(k,1142) = lu(k,1142) * lu(k,1140) + lu(k,1143) = lu(k,1143) * lu(k,1140) + lu(k,1144) = lu(k,1144) * lu(k,1140) + lu(k,1145) = lu(k,1145) * lu(k,1140) + lu(k,1146) = lu(k,1146) * lu(k,1140) + lu(k,1147) = lu(k,1147) * lu(k,1140) + lu(k,1148) = lu(k,1148) * lu(k,1140) + lu(k,1149) = lu(k,1149) * lu(k,1140) + lu(k,1150) = lu(k,1150) * lu(k,1140) + lu(k,1171) = lu(k,1171) - lu(k,1141) * lu(k,1170) + lu(k,1173) = - lu(k,1142) * lu(k,1170) + lu(k,1175) = - lu(k,1143) * lu(k,1170) + lu(k,1176) = lu(k,1176) - lu(k,1144) * lu(k,1170) + lu(k,1179) = lu(k,1179) - lu(k,1145) * lu(k,1170) + lu(k,1180) = - lu(k,1146) * lu(k,1170) + lu(k,1181) = lu(k,1181) - lu(k,1147) * lu(k,1170) + lu(k,1183) = lu(k,1183) - lu(k,1148) * lu(k,1170) + lu(k,1186) = lu(k,1186) - lu(k,1149) * lu(k,1170) + lu(k,1187) = lu(k,1187) - lu(k,1150) * lu(k,1170) + lu(k,1205) = lu(k,1205) - lu(k,1141) * lu(k,1204) + lu(k,1207) = - lu(k,1142) * lu(k,1204) + lu(k,1209) = - lu(k,1143) * lu(k,1204) + lu(k,1210) = lu(k,1210) - lu(k,1144) * lu(k,1204) + lu(k,1213) = lu(k,1213) - lu(k,1145) * lu(k,1204) + lu(k,1214) = - lu(k,1146) * lu(k,1204) + lu(k,1215) = lu(k,1215) - lu(k,1147) * lu(k,1204) + lu(k,1217) = lu(k,1217) - lu(k,1148) * lu(k,1204) + lu(k,1220) = lu(k,1220) - lu(k,1149) * lu(k,1204) + lu(k,1221) = lu(k,1221) - lu(k,1150) * lu(k,1204) + lu(k,1296) = lu(k,1296) - lu(k,1141) * lu(k,1295) + lu(k,1299) = lu(k,1299) - lu(k,1142) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,1143) * lu(k,1295) + lu(k,1302) = lu(k,1302) - lu(k,1144) * lu(k,1295) + lu(k,1306) = lu(k,1306) - lu(k,1145) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,1146) * lu(k,1295) + lu(k,1308) = lu(k,1308) - lu(k,1147) * lu(k,1295) + lu(k,1310) = lu(k,1310) - lu(k,1148) * lu(k,1295) + lu(k,1313) = lu(k,1313) - lu(k,1149) * lu(k,1295) + lu(k,1314) = lu(k,1314) - lu(k,1150) * lu(k,1295) + lu(k,1389) = lu(k,1389) - lu(k,1141) * lu(k,1388) + lu(k,1392) = lu(k,1392) - lu(k,1142) * lu(k,1388) + lu(k,1394) = lu(k,1394) - lu(k,1143) * lu(k,1388) + lu(k,1395) = lu(k,1395) - lu(k,1144) * lu(k,1388) + lu(k,1400) = lu(k,1400) - lu(k,1145) * lu(k,1388) + lu(k,1401) = - lu(k,1146) * lu(k,1388) + lu(k,1402) = lu(k,1402) - lu(k,1147) * lu(k,1388) + lu(k,1404) = lu(k,1404) - lu(k,1148) * lu(k,1388) + lu(k,1407) = lu(k,1407) - lu(k,1149) * lu(k,1388) + lu(k,1409) = lu(k,1409) - lu(k,1150) * lu(k,1388) + lu(k,1497) = lu(k,1497) - lu(k,1141) * lu(k,1496) + lu(k,1500) = lu(k,1500) - lu(k,1142) * lu(k,1496) + lu(k,1502) = lu(k,1502) - lu(k,1143) * lu(k,1496) + lu(k,1503) = lu(k,1503) - lu(k,1144) * lu(k,1496) + lu(k,1510) = lu(k,1510) - lu(k,1145) * lu(k,1496) + lu(k,1511) = lu(k,1511) - lu(k,1146) * lu(k,1496) + lu(k,1513) = lu(k,1513) - lu(k,1147) * lu(k,1496) + lu(k,1515) = lu(k,1515) - lu(k,1148) * lu(k,1496) + lu(k,1519) = lu(k,1519) - lu(k,1149) * lu(k,1496) + lu(k,1521) = lu(k,1521) - lu(k,1150) * lu(k,1496) + lu(k,1704) = lu(k,1704) - lu(k,1141) * lu(k,1703) + lu(k,1707) = lu(k,1707) - lu(k,1142) * lu(k,1703) + lu(k,1709) = lu(k,1709) - lu(k,1143) * lu(k,1703) + lu(k,1710) = lu(k,1710) - lu(k,1144) * lu(k,1703) + lu(k,1719) = lu(k,1719) - lu(k,1145) * lu(k,1703) + lu(k,1720) = lu(k,1720) - lu(k,1146) * lu(k,1703) + lu(k,1722) = lu(k,1722) - lu(k,1147) * lu(k,1703) + lu(k,1724) = lu(k,1724) - lu(k,1148) * lu(k,1703) + lu(k,1728) = lu(k,1728) - lu(k,1149) * lu(k,1703) + lu(k,1730) = lu(k,1730) - lu(k,1150) * lu(k,1703) + lu(k,1767) = lu(k,1767) - lu(k,1141) * lu(k,1766) + lu(k,1770) = - lu(k,1142) * lu(k,1766) + lu(k,1772) = - lu(k,1143) * lu(k,1766) + lu(k,1773) = lu(k,1773) - lu(k,1144) * lu(k,1766) + lu(k,1781) = lu(k,1781) - lu(k,1145) * lu(k,1766) + lu(k,1782) = lu(k,1782) - lu(k,1146) * lu(k,1766) + lu(k,1784) = lu(k,1784) - lu(k,1147) * lu(k,1766) + lu(k,1786) = lu(k,1786) - lu(k,1148) * lu(k,1766) + lu(k,1790) = lu(k,1790) - lu(k,1149) * lu(k,1766) + lu(k,1792) = lu(k,1792) - lu(k,1150) * lu(k,1766) + lu(k,1889) = lu(k,1889) - lu(k,1141) * lu(k,1888) + lu(k,1892) = lu(k,1892) - lu(k,1142) * lu(k,1888) + lu(k,1894) = lu(k,1894) - lu(k,1143) * lu(k,1888) + lu(k,1895) = lu(k,1895) - lu(k,1144) * lu(k,1888) + lu(k,1903) = lu(k,1903) - lu(k,1145) * lu(k,1888) + lu(k,1904) = lu(k,1904) - lu(k,1146) * lu(k,1888) + lu(k,1906) = lu(k,1906) - lu(k,1147) * lu(k,1888) + lu(k,1908) = lu(k,1908) - lu(k,1148) * lu(k,1888) + lu(k,1912) = lu(k,1912) - lu(k,1149) * lu(k,1888) + lu(k,1914) = lu(k,1914) - lu(k,1150) * lu(k,1888) + lu(k,2092) = lu(k,2092) - lu(k,1141) * lu(k,2091) + lu(k,2095) = lu(k,2095) - lu(k,1142) * lu(k,2091) + lu(k,2097) = lu(k,2097) - lu(k,1143) * lu(k,2091) + lu(k,2098) = lu(k,2098) - lu(k,1144) * lu(k,2091) + lu(k,2106) = lu(k,2106) - lu(k,1145) * lu(k,2091) + lu(k,2107) = lu(k,2107) - lu(k,1146) * lu(k,2091) + lu(k,2109) = lu(k,2109) - lu(k,1147) * lu(k,2091) + lu(k,2111) = lu(k,2111) - lu(k,1148) * lu(k,2091) + lu(k,2115) = lu(k,2115) - lu(k,1149) * lu(k,2091) + lu(k,2117) = lu(k,2117) - lu(k,1150) * lu(k,2091) + lu(k,1152) = 1._r8 / lu(k,1152) + lu(k,1153) = lu(k,1153) * lu(k,1152) + lu(k,1154) = lu(k,1154) * lu(k,1152) + lu(k,1155) = lu(k,1155) * lu(k,1152) + lu(k,1156) = lu(k,1156) * lu(k,1152) + lu(k,1157) = lu(k,1157) * lu(k,1152) + lu(k,1158) = lu(k,1158) * lu(k,1152) + lu(k,1159) = lu(k,1159) * lu(k,1152) + lu(k,1176) = lu(k,1176) - lu(k,1153) * lu(k,1171) + lu(k,1179) = lu(k,1179) - lu(k,1154) * lu(k,1171) + lu(k,1182) = lu(k,1182) - lu(k,1155) * lu(k,1171) + lu(k,1183) = lu(k,1183) - lu(k,1156) * lu(k,1171) + lu(k,1184) = lu(k,1184) - lu(k,1157) * lu(k,1171) + lu(k,1186) = lu(k,1186) - lu(k,1158) * lu(k,1171) + lu(k,1187) = lu(k,1187) - lu(k,1159) * lu(k,1171) + lu(k,1210) = lu(k,1210) - lu(k,1153) * lu(k,1205) + lu(k,1213) = lu(k,1213) - lu(k,1154) * lu(k,1205) + lu(k,1216) = lu(k,1216) - lu(k,1155) * lu(k,1205) + lu(k,1217) = lu(k,1217) - lu(k,1156) * lu(k,1205) + lu(k,1218) = lu(k,1218) - lu(k,1157) * lu(k,1205) + lu(k,1220) = lu(k,1220) - lu(k,1158) * lu(k,1205) + lu(k,1221) = lu(k,1221) - lu(k,1159) * lu(k,1205) + lu(k,1233) = lu(k,1233) - lu(k,1153) * lu(k,1230) + lu(k,1236) = lu(k,1236) - lu(k,1154) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,1155) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,1156) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,1157) * lu(k,1230) + lu(k,1242) = lu(k,1242) - lu(k,1158) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,1159) * lu(k,1230) + lu(k,1253) = lu(k,1253) - lu(k,1153) * lu(k,1249) + lu(k,1257) = lu(k,1257) - lu(k,1154) * lu(k,1249) + lu(k,1260) = lu(k,1260) - lu(k,1155) * lu(k,1249) + lu(k,1261) = lu(k,1261) - lu(k,1156) * lu(k,1249) + lu(k,1262) = lu(k,1262) - lu(k,1157) * lu(k,1249) + lu(k,1264) = lu(k,1264) - lu(k,1158) * lu(k,1249) + lu(k,1265) = lu(k,1265) - lu(k,1159) * lu(k,1249) + lu(k,1272) = lu(k,1272) - lu(k,1153) * lu(k,1270) + lu(k,1275) = lu(k,1275) - lu(k,1154) * lu(k,1270) + lu(k,1278) = lu(k,1278) - lu(k,1155) * lu(k,1270) + lu(k,1279) = - lu(k,1156) * lu(k,1270) + lu(k,1280) = - lu(k,1157) * lu(k,1270) + lu(k,1282) = lu(k,1282) - lu(k,1158) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,1159) * lu(k,1270) + lu(k,1302) = lu(k,1302) - lu(k,1153) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,1154) * lu(k,1296) + lu(k,1309) = lu(k,1309) - lu(k,1155) * lu(k,1296) + lu(k,1310) = lu(k,1310) - lu(k,1156) * lu(k,1296) + lu(k,1311) = lu(k,1311) - lu(k,1157) * lu(k,1296) + lu(k,1313) = lu(k,1313) - lu(k,1158) * lu(k,1296) + lu(k,1314) = lu(k,1314) - lu(k,1159) * lu(k,1296) + lu(k,1395) = lu(k,1395) - lu(k,1153) * lu(k,1389) + lu(k,1400) = lu(k,1400) - lu(k,1154) * lu(k,1389) + lu(k,1403) = lu(k,1403) - lu(k,1155) * lu(k,1389) + lu(k,1404) = lu(k,1404) - lu(k,1156) * lu(k,1389) + lu(k,1405) = lu(k,1405) - lu(k,1157) * lu(k,1389) + lu(k,1407) = lu(k,1407) - lu(k,1158) * lu(k,1389) + lu(k,1409) = lu(k,1409) - lu(k,1159) * lu(k,1389) + lu(k,1503) = lu(k,1503) - lu(k,1153) * lu(k,1497) + lu(k,1510) = lu(k,1510) - lu(k,1154) * lu(k,1497) + lu(k,1514) = lu(k,1514) - lu(k,1155) * lu(k,1497) + lu(k,1515) = lu(k,1515) - lu(k,1156) * lu(k,1497) + lu(k,1516) = lu(k,1516) - lu(k,1157) * lu(k,1497) + lu(k,1519) = lu(k,1519) - lu(k,1158) * lu(k,1497) + lu(k,1521) = lu(k,1521) - lu(k,1159) * lu(k,1497) + lu(k,1710) = lu(k,1710) - lu(k,1153) * lu(k,1704) + lu(k,1719) = lu(k,1719) - lu(k,1154) * lu(k,1704) + lu(k,1723) = lu(k,1723) - lu(k,1155) * lu(k,1704) + lu(k,1724) = lu(k,1724) - lu(k,1156) * lu(k,1704) + lu(k,1725) = lu(k,1725) - lu(k,1157) * lu(k,1704) + lu(k,1728) = lu(k,1728) - lu(k,1158) * lu(k,1704) + lu(k,1730) = lu(k,1730) - lu(k,1159) * lu(k,1704) + lu(k,1773) = lu(k,1773) - lu(k,1153) * lu(k,1767) + lu(k,1781) = lu(k,1781) - lu(k,1154) * lu(k,1767) + lu(k,1785) = lu(k,1785) - lu(k,1155) * lu(k,1767) + lu(k,1786) = lu(k,1786) - lu(k,1156) * lu(k,1767) + lu(k,1787) = lu(k,1787) - lu(k,1157) * lu(k,1767) + lu(k,1790) = lu(k,1790) - lu(k,1158) * lu(k,1767) + lu(k,1792) = lu(k,1792) - lu(k,1159) * lu(k,1767) + lu(k,1895) = lu(k,1895) - lu(k,1153) * lu(k,1889) + lu(k,1903) = lu(k,1903) - lu(k,1154) * lu(k,1889) + lu(k,1907) = lu(k,1907) - lu(k,1155) * lu(k,1889) + lu(k,1908) = lu(k,1908) - lu(k,1156) * lu(k,1889) + lu(k,1909) = lu(k,1909) - lu(k,1157) * lu(k,1889) + lu(k,1912) = lu(k,1912) - lu(k,1158) * lu(k,1889) + lu(k,1914) = lu(k,1914) - lu(k,1159) * lu(k,1889) + lu(k,1978) = lu(k,1978) - lu(k,1153) * lu(k,1976) + lu(k,1987) = lu(k,1987) - lu(k,1154) * lu(k,1976) + lu(k,1991) = lu(k,1991) - lu(k,1155) * lu(k,1976) + lu(k,1992) = lu(k,1992) - lu(k,1156) * lu(k,1976) + lu(k,1993) = lu(k,1993) - lu(k,1157) * lu(k,1976) + lu(k,1996) = lu(k,1996) - lu(k,1158) * lu(k,1976) + lu(k,1998) = lu(k,1998) - lu(k,1159) * lu(k,1976) + lu(k,2098) = lu(k,2098) - lu(k,1153) * lu(k,2092) + lu(k,2106) = lu(k,2106) - lu(k,1154) * lu(k,2092) + lu(k,2110) = lu(k,2110) - lu(k,1155) * lu(k,2092) + lu(k,2111) = lu(k,2111) - lu(k,1156) * lu(k,2092) + lu(k,2112) = lu(k,2112) - lu(k,1157) * lu(k,2092) + lu(k,2115) = lu(k,2115) - lu(k,1158) * lu(k,2092) + lu(k,2117) = lu(k,2117) - lu(k,1159) * lu(k,2092) + lu(k,1172) = 1._r8 / lu(k,1172) + lu(k,1173) = lu(k,1173) * lu(k,1172) + lu(k,1174) = lu(k,1174) * lu(k,1172) + lu(k,1175) = lu(k,1175) * lu(k,1172) + lu(k,1176) = lu(k,1176) * lu(k,1172) + lu(k,1177) = lu(k,1177) * lu(k,1172) + lu(k,1178) = lu(k,1178) * lu(k,1172) + lu(k,1179) = lu(k,1179) * lu(k,1172) + lu(k,1180) = lu(k,1180) * lu(k,1172) + lu(k,1181) = lu(k,1181) * lu(k,1172) + lu(k,1182) = lu(k,1182) * lu(k,1172) + lu(k,1183) = lu(k,1183) * lu(k,1172) + lu(k,1184) = lu(k,1184) * lu(k,1172) + lu(k,1185) = lu(k,1185) * lu(k,1172) + lu(k,1186) = lu(k,1186) * lu(k,1172) + lu(k,1187) = lu(k,1187) * lu(k,1172) + lu(k,1299) = lu(k,1299) - lu(k,1173) * lu(k,1297) + lu(k,1300) = lu(k,1300) - lu(k,1174) * lu(k,1297) + lu(k,1301) = lu(k,1301) - lu(k,1175) * lu(k,1297) + lu(k,1302) = lu(k,1302) - lu(k,1176) * lu(k,1297) + lu(k,1303) = lu(k,1303) - lu(k,1177) * lu(k,1297) + lu(k,1305) = lu(k,1305) - lu(k,1178) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,1179) * lu(k,1297) + lu(k,1307) = lu(k,1307) - lu(k,1180) * lu(k,1297) + lu(k,1308) = lu(k,1308) - lu(k,1181) * lu(k,1297) + lu(k,1309) = lu(k,1309) - lu(k,1182) * lu(k,1297) + lu(k,1310) = lu(k,1310) - lu(k,1183) * lu(k,1297) + lu(k,1311) = lu(k,1311) - lu(k,1184) * lu(k,1297) + lu(k,1312) = lu(k,1312) - lu(k,1185) * lu(k,1297) + lu(k,1313) = lu(k,1313) - lu(k,1186) * lu(k,1297) + lu(k,1314) = lu(k,1314) - lu(k,1187) * lu(k,1297) + lu(k,1392) = lu(k,1392) - lu(k,1173) * lu(k,1390) + lu(k,1393) = lu(k,1393) - lu(k,1174) * lu(k,1390) + lu(k,1394) = lu(k,1394) - lu(k,1175) * lu(k,1390) + lu(k,1395) = lu(k,1395) - lu(k,1176) * lu(k,1390) + lu(k,1396) = lu(k,1396) - lu(k,1177) * lu(k,1390) + lu(k,1398) = lu(k,1398) - lu(k,1178) * lu(k,1390) + lu(k,1400) = lu(k,1400) - lu(k,1179) * lu(k,1390) + lu(k,1401) = lu(k,1401) - lu(k,1180) * lu(k,1390) + lu(k,1402) = lu(k,1402) - lu(k,1181) * lu(k,1390) + lu(k,1403) = lu(k,1403) - lu(k,1182) * lu(k,1390) + lu(k,1404) = lu(k,1404) - lu(k,1183) * lu(k,1390) + lu(k,1405) = lu(k,1405) - lu(k,1184) * lu(k,1390) + lu(k,1406) = lu(k,1406) - lu(k,1185) * lu(k,1390) + lu(k,1407) = lu(k,1407) - lu(k,1186) * lu(k,1390) + lu(k,1409) = lu(k,1409) - lu(k,1187) * lu(k,1390) + lu(k,1500) = lu(k,1500) - lu(k,1173) * lu(k,1498) + lu(k,1501) = lu(k,1501) - lu(k,1174) * lu(k,1498) + lu(k,1502) = lu(k,1502) - lu(k,1175) * lu(k,1498) + lu(k,1503) = lu(k,1503) - lu(k,1176) * lu(k,1498) + lu(k,1505) = lu(k,1505) - lu(k,1177) * lu(k,1498) + lu(k,1507) = lu(k,1507) - lu(k,1178) * lu(k,1498) + lu(k,1510) = lu(k,1510) - lu(k,1179) * lu(k,1498) + lu(k,1511) = lu(k,1511) - lu(k,1180) * lu(k,1498) + lu(k,1513) = lu(k,1513) - lu(k,1181) * lu(k,1498) + lu(k,1514) = lu(k,1514) - lu(k,1182) * lu(k,1498) + lu(k,1515) = lu(k,1515) - lu(k,1183) * lu(k,1498) + lu(k,1516) = lu(k,1516) - lu(k,1184) * lu(k,1498) + lu(k,1517) = lu(k,1517) - lu(k,1185) * lu(k,1498) + lu(k,1519) = lu(k,1519) - lu(k,1186) * lu(k,1498) + lu(k,1521) = lu(k,1521) - lu(k,1187) * lu(k,1498) + lu(k,1707) = lu(k,1707) - lu(k,1173) * lu(k,1705) + lu(k,1708) = lu(k,1708) - lu(k,1174) * lu(k,1705) + lu(k,1709) = lu(k,1709) - lu(k,1175) * lu(k,1705) + lu(k,1710) = lu(k,1710) - lu(k,1176) * lu(k,1705) + lu(k,1714) = lu(k,1714) - lu(k,1177) * lu(k,1705) + lu(k,1716) = lu(k,1716) - lu(k,1178) * lu(k,1705) + lu(k,1719) = lu(k,1719) - lu(k,1179) * lu(k,1705) + lu(k,1720) = lu(k,1720) - lu(k,1180) * lu(k,1705) + lu(k,1722) = lu(k,1722) - lu(k,1181) * lu(k,1705) + lu(k,1723) = lu(k,1723) - lu(k,1182) * lu(k,1705) + lu(k,1724) = lu(k,1724) - lu(k,1183) * lu(k,1705) + lu(k,1725) = lu(k,1725) - lu(k,1184) * lu(k,1705) + lu(k,1726) = lu(k,1726) - lu(k,1185) * lu(k,1705) + lu(k,1728) = lu(k,1728) - lu(k,1186) * lu(k,1705) + lu(k,1730) = lu(k,1730) - lu(k,1187) * lu(k,1705) + lu(k,1770) = lu(k,1770) - lu(k,1173) * lu(k,1768) + lu(k,1771) = lu(k,1771) - lu(k,1174) * lu(k,1768) + lu(k,1772) = lu(k,1772) - lu(k,1175) * lu(k,1768) + lu(k,1773) = lu(k,1773) - lu(k,1176) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1177) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1178) * lu(k,1768) + lu(k,1781) = lu(k,1781) - lu(k,1179) * lu(k,1768) + lu(k,1782) = lu(k,1782) - lu(k,1180) * lu(k,1768) + lu(k,1784) = lu(k,1784) - lu(k,1181) * lu(k,1768) + lu(k,1785) = lu(k,1785) - lu(k,1182) * lu(k,1768) + lu(k,1786) = lu(k,1786) - lu(k,1183) * lu(k,1768) + lu(k,1787) = lu(k,1787) - lu(k,1184) * lu(k,1768) + lu(k,1788) = lu(k,1788) - lu(k,1185) * lu(k,1768) + lu(k,1790) = lu(k,1790) - lu(k,1186) * lu(k,1768) + lu(k,1792) = lu(k,1792) - lu(k,1187) * lu(k,1768) + lu(k,1892) = lu(k,1892) - lu(k,1173) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1174) * lu(k,1890) + lu(k,1894) = lu(k,1894) - lu(k,1175) * lu(k,1890) + lu(k,1895) = lu(k,1895) - lu(k,1176) * lu(k,1890) + lu(k,1898) = lu(k,1898) - lu(k,1177) * lu(k,1890) + lu(k,1900) = lu(k,1900) - lu(k,1178) * lu(k,1890) + lu(k,1903) = lu(k,1903) - lu(k,1179) * lu(k,1890) + lu(k,1904) = lu(k,1904) - lu(k,1180) * lu(k,1890) + lu(k,1906) = lu(k,1906) - lu(k,1181) * lu(k,1890) + lu(k,1907) = lu(k,1907) - lu(k,1182) * lu(k,1890) + lu(k,1908) = lu(k,1908) - lu(k,1183) * lu(k,1890) + lu(k,1909) = lu(k,1909) - lu(k,1184) * lu(k,1890) + lu(k,1910) = lu(k,1910) - lu(k,1185) * lu(k,1890) + lu(k,1912) = lu(k,1912) - lu(k,1186) * lu(k,1890) + lu(k,1914) = lu(k,1914) - lu(k,1187) * lu(k,1890) + lu(k,2095) = lu(k,2095) - lu(k,1173) * lu(k,2093) + lu(k,2096) = lu(k,2096) - lu(k,1174) * lu(k,2093) + lu(k,2097) = lu(k,2097) - lu(k,1175) * lu(k,2093) + lu(k,2098) = lu(k,2098) - lu(k,1176) * lu(k,2093) + lu(k,2101) = lu(k,2101) - lu(k,1177) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,1178) * lu(k,2093) + lu(k,2106) = lu(k,2106) - lu(k,1179) * lu(k,2093) + lu(k,2107) = lu(k,2107) - lu(k,1180) * lu(k,2093) + lu(k,2109) = lu(k,2109) - lu(k,1181) * lu(k,2093) + lu(k,2110) = lu(k,2110) - lu(k,1182) * lu(k,2093) + lu(k,2111) = lu(k,2111) - lu(k,1183) * lu(k,2093) + lu(k,2112) = lu(k,2112) - lu(k,1184) * lu(k,2093) + lu(k,2113) = lu(k,2113) - lu(k,1185) * lu(k,2093) + lu(k,2115) = lu(k,2115) - lu(k,1186) * lu(k,2093) + lu(k,2117) = lu(k,2117) - lu(k,1187) * lu(k,2093) + lu(k,1206) = 1._r8 / lu(k,1206) + lu(k,1207) = lu(k,1207) * lu(k,1206) + lu(k,1208) = lu(k,1208) * lu(k,1206) + lu(k,1209) = lu(k,1209) * lu(k,1206) + lu(k,1210) = lu(k,1210) * lu(k,1206) + lu(k,1211) = lu(k,1211) * lu(k,1206) + lu(k,1212) = lu(k,1212) * lu(k,1206) + lu(k,1213) = lu(k,1213) * lu(k,1206) + lu(k,1214) = lu(k,1214) * lu(k,1206) + lu(k,1215) = lu(k,1215) * lu(k,1206) + lu(k,1216) = lu(k,1216) * lu(k,1206) + lu(k,1217) = lu(k,1217) * lu(k,1206) + lu(k,1218) = lu(k,1218) * lu(k,1206) + lu(k,1219) = lu(k,1219) * lu(k,1206) + lu(k,1220) = lu(k,1220) * lu(k,1206) + lu(k,1221) = lu(k,1221) * lu(k,1206) + lu(k,1299) = lu(k,1299) - lu(k,1207) * lu(k,1298) + lu(k,1300) = lu(k,1300) - lu(k,1208) * lu(k,1298) + lu(k,1301) = lu(k,1301) - lu(k,1209) * lu(k,1298) + lu(k,1302) = lu(k,1302) - lu(k,1210) * lu(k,1298) + lu(k,1303) = lu(k,1303) - lu(k,1211) * lu(k,1298) + lu(k,1305) = lu(k,1305) - lu(k,1212) * lu(k,1298) + lu(k,1306) = lu(k,1306) - lu(k,1213) * lu(k,1298) + lu(k,1307) = lu(k,1307) - lu(k,1214) * lu(k,1298) + lu(k,1308) = lu(k,1308) - lu(k,1215) * lu(k,1298) + lu(k,1309) = lu(k,1309) - lu(k,1216) * lu(k,1298) + lu(k,1310) = lu(k,1310) - lu(k,1217) * lu(k,1298) + lu(k,1311) = lu(k,1311) - lu(k,1218) * lu(k,1298) + lu(k,1312) = lu(k,1312) - lu(k,1219) * lu(k,1298) + lu(k,1313) = lu(k,1313) - lu(k,1220) * lu(k,1298) + lu(k,1314) = lu(k,1314) - lu(k,1221) * lu(k,1298) + lu(k,1392) = lu(k,1392) - lu(k,1207) * lu(k,1391) + lu(k,1393) = lu(k,1393) - lu(k,1208) * lu(k,1391) + lu(k,1394) = lu(k,1394) - lu(k,1209) * lu(k,1391) + lu(k,1395) = lu(k,1395) - lu(k,1210) * lu(k,1391) + lu(k,1396) = lu(k,1396) - lu(k,1211) * lu(k,1391) + lu(k,1398) = lu(k,1398) - lu(k,1212) * lu(k,1391) + lu(k,1400) = lu(k,1400) - lu(k,1213) * lu(k,1391) + lu(k,1401) = lu(k,1401) - lu(k,1214) * lu(k,1391) + lu(k,1402) = lu(k,1402) - lu(k,1215) * lu(k,1391) + lu(k,1403) = lu(k,1403) - lu(k,1216) * lu(k,1391) + lu(k,1404) = lu(k,1404) - lu(k,1217) * lu(k,1391) + lu(k,1405) = lu(k,1405) - lu(k,1218) * lu(k,1391) + lu(k,1406) = lu(k,1406) - lu(k,1219) * lu(k,1391) + lu(k,1407) = lu(k,1407) - lu(k,1220) * lu(k,1391) + lu(k,1409) = lu(k,1409) - lu(k,1221) * lu(k,1391) + lu(k,1500) = lu(k,1500) - lu(k,1207) * lu(k,1499) + lu(k,1501) = lu(k,1501) - lu(k,1208) * lu(k,1499) + lu(k,1502) = lu(k,1502) - lu(k,1209) * lu(k,1499) + lu(k,1503) = lu(k,1503) - lu(k,1210) * lu(k,1499) + lu(k,1505) = lu(k,1505) - lu(k,1211) * lu(k,1499) + lu(k,1507) = lu(k,1507) - lu(k,1212) * lu(k,1499) + lu(k,1510) = lu(k,1510) - lu(k,1213) * lu(k,1499) + lu(k,1511) = lu(k,1511) - lu(k,1214) * lu(k,1499) + lu(k,1513) = lu(k,1513) - lu(k,1215) * lu(k,1499) + lu(k,1514) = lu(k,1514) - lu(k,1216) * lu(k,1499) + lu(k,1515) = lu(k,1515) - lu(k,1217) * lu(k,1499) + lu(k,1516) = lu(k,1516) - lu(k,1218) * lu(k,1499) + lu(k,1517) = lu(k,1517) - lu(k,1219) * lu(k,1499) + lu(k,1519) = lu(k,1519) - lu(k,1220) * lu(k,1499) + lu(k,1521) = lu(k,1521) - lu(k,1221) * lu(k,1499) + lu(k,1707) = lu(k,1707) - lu(k,1207) * lu(k,1706) + lu(k,1708) = lu(k,1708) - lu(k,1208) * lu(k,1706) + lu(k,1709) = lu(k,1709) - lu(k,1209) * lu(k,1706) + lu(k,1710) = lu(k,1710) - lu(k,1210) * lu(k,1706) + lu(k,1714) = lu(k,1714) - lu(k,1211) * lu(k,1706) + lu(k,1716) = lu(k,1716) - lu(k,1212) * lu(k,1706) + lu(k,1719) = lu(k,1719) - lu(k,1213) * lu(k,1706) + lu(k,1720) = lu(k,1720) - lu(k,1214) * lu(k,1706) + lu(k,1722) = lu(k,1722) - lu(k,1215) * lu(k,1706) + lu(k,1723) = lu(k,1723) - lu(k,1216) * lu(k,1706) + lu(k,1724) = lu(k,1724) - lu(k,1217) * lu(k,1706) + lu(k,1725) = lu(k,1725) - lu(k,1218) * lu(k,1706) + lu(k,1726) = lu(k,1726) - lu(k,1219) * lu(k,1706) + lu(k,1728) = lu(k,1728) - lu(k,1220) * lu(k,1706) + lu(k,1730) = lu(k,1730) - lu(k,1221) * lu(k,1706) + lu(k,1770) = lu(k,1770) - lu(k,1207) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,1208) * lu(k,1769) + lu(k,1772) = lu(k,1772) - lu(k,1209) * lu(k,1769) + lu(k,1773) = lu(k,1773) - lu(k,1210) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1211) * lu(k,1769) + lu(k,1778) = lu(k,1778) - lu(k,1212) * lu(k,1769) + lu(k,1781) = lu(k,1781) - lu(k,1213) * lu(k,1769) + lu(k,1782) = lu(k,1782) - lu(k,1214) * lu(k,1769) + lu(k,1784) = lu(k,1784) - lu(k,1215) * lu(k,1769) + lu(k,1785) = lu(k,1785) - lu(k,1216) * lu(k,1769) + lu(k,1786) = lu(k,1786) - lu(k,1217) * lu(k,1769) + lu(k,1787) = lu(k,1787) - lu(k,1218) * lu(k,1769) + lu(k,1788) = lu(k,1788) - lu(k,1219) * lu(k,1769) + lu(k,1790) = lu(k,1790) - lu(k,1220) * lu(k,1769) + lu(k,1792) = lu(k,1792) - lu(k,1221) * lu(k,1769) + lu(k,1892) = lu(k,1892) - lu(k,1207) * lu(k,1891) + lu(k,1893) = lu(k,1893) - lu(k,1208) * lu(k,1891) + lu(k,1894) = lu(k,1894) - lu(k,1209) * lu(k,1891) + lu(k,1895) = lu(k,1895) - lu(k,1210) * lu(k,1891) + lu(k,1898) = lu(k,1898) - lu(k,1211) * lu(k,1891) + lu(k,1900) = lu(k,1900) - lu(k,1212) * lu(k,1891) + lu(k,1903) = lu(k,1903) - lu(k,1213) * lu(k,1891) + lu(k,1904) = lu(k,1904) - lu(k,1214) * lu(k,1891) + lu(k,1906) = lu(k,1906) - lu(k,1215) * lu(k,1891) + lu(k,1907) = lu(k,1907) - lu(k,1216) * lu(k,1891) + lu(k,1908) = lu(k,1908) - lu(k,1217) * lu(k,1891) + lu(k,1909) = lu(k,1909) - lu(k,1218) * lu(k,1891) + lu(k,1910) = lu(k,1910) - lu(k,1219) * lu(k,1891) + lu(k,1912) = lu(k,1912) - lu(k,1220) * lu(k,1891) + lu(k,1914) = lu(k,1914) - lu(k,1221) * lu(k,1891) + lu(k,2095) = lu(k,2095) - lu(k,1207) * lu(k,2094) + lu(k,2096) = lu(k,2096) - lu(k,1208) * lu(k,2094) + lu(k,2097) = lu(k,2097) - lu(k,1209) * lu(k,2094) + lu(k,2098) = lu(k,2098) - lu(k,1210) * lu(k,2094) + lu(k,2101) = lu(k,2101) - lu(k,1211) * lu(k,2094) + lu(k,2103) = lu(k,2103) - lu(k,1212) * lu(k,2094) + lu(k,2106) = lu(k,2106) - lu(k,1213) * lu(k,2094) + lu(k,2107) = lu(k,2107) - lu(k,1214) * lu(k,2094) + lu(k,2109) = lu(k,2109) - lu(k,1215) * lu(k,2094) + lu(k,2110) = lu(k,2110) - lu(k,1216) * lu(k,2094) + lu(k,2111) = lu(k,2111) - lu(k,1217) * lu(k,2094) + lu(k,2112) = lu(k,2112) - lu(k,1218) * lu(k,2094) + lu(k,2113) = lu(k,2113) - lu(k,1219) * lu(k,2094) + lu(k,2115) = lu(k,2115) - lu(k,1220) * lu(k,2094) + lu(k,2117) = lu(k,2117) - lu(k,1221) * lu(k,2094) + end do + end subroutine lu_fac24 + subroutine lu_fac25( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1231) = 1._r8 / lu(k,1231) + lu(k,1232) = lu(k,1232) * lu(k,1231) + lu(k,1233) = lu(k,1233) * lu(k,1231) + lu(k,1234) = lu(k,1234) * lu(k,1231) + lu(k,1235) = lu(k,1235) * lu(k,1231) + lu(k,1236) = lu(k,1236) * lu(k,1231) + lu(k,1237) = lu(k,1237) * lu(k,1231) + lu(k,1238) = lu(k,1238) * lu(k,1231) + lu(k,1239) = lu(k,1239) * lu(k,1231) + lu(k,1240) = lu(k,1240) * lu(k,1231) + lu(k,1241) = lu(k,1241) * lu(k,1231) + lu(k,1242) = lu(k,1242) * lu(k,1231) + lu(k,1243) = lu(k,1243) * lu(k,1231) + lu(k,1252) = - lu(k,1232) * lu(k,1250) + lu(k,1253) = lu(k,1253) - lu(k,1233) * lu(k,1250) + lu(k,1254) = lu(k,1254) - lu(k,1234) * lu(k,1250) + lu(k,1256) = lu(k,1256) - lu(k,1235) * lu(k,1250) + lu(k,1257) = lu(k,1257) - lu(k,1236) * lu(k,1250) + lu(k,1259) = lu(k,1259) - lu(k,1237) * lu(k,1250) + lu(k,1260) = lu(k,1260) - lu(k,1238) * lu(k,1250) + lu(k,1261) = lu(k,1261) - lu(k,1239) * lu(k,1250) + lu(k,1262) = lu(k,1262) - lu(k,1240) * lu(k,1250) + lu(k,1263) = lu(k,1263) - lu(k,1241) * lu(k,1250) + lu(k,1264) = lu(k,1264) - lu(k,1242) * lu(k,1250) + lu(k,1265) = lu(k,1265) - lu(k,1243) * lu(k,1250) + lu(k,1301) = lu(k,1301) - lu(k,1232) * lu(k,1299) + lu(k,1302) = lu(k,1302) - lu(k,1233) * lu(k,1299) + lu(k,1303) = lu(k,1303) - lu(k,1234) * lu(k,1299) + lu(k,1305) = lu(k,1305) - lu(k,1235) * lu(k,1299) + lu(k,1306) = lu(k,1306) - lu(k,1236) * lu(k,1299) + lu(k,1308) = lu(k,1308) - lu(k,1237) * lu(k,1299) + lu(k,1309) = lu(k,1309) - lu(k,1238) * lu(k,1299) + lu(k,1310) = lu(k,1310) - lu(k,1239) * lu(k,1299) + lu(k,1311) = lu(k,1311) - lu(k,1240) * lu(k,1299) + lu(k,1312) = lu(k,1312) - lu(k,1241) * lu(k,1299) + lu(k,1313) = lu(k,1313) - lu(k,1242) * lu(k,1299) + lu(k,1314) = lu(k,1314) - lu(k,1243) * lu(k,1299) + lu(k,1394) = lu(k,1394) - lu(k,1232) * lu(k,1392) + lu(k,1395) = lu(k,1395) - lu(k,1233) * lu(k,1392) + lu(k,1396) = lu(k,1396) - lu(k,1234) * lu(k,1392) + lu(k,1398) = lu(k,1398) - lu(k,1235) * lu(k,1392) + lu(k,1400) = lu(k,1400) - lu(k,1236) * lu(k,1392) + lu(k,1402) = lu(k,1402) - lu(k,1237) * lu(k,1392) + lu(k,1403) = lu(k,1403) - lu(k,1238) * lu(k,1392) + lu(k,1404) = lu(k,1404) - lu(k,1239) * lu(k,1392) + lu(k,1405) = lu(k,1405) - lu(k,1240) * lu(k,1392) + lu(k,1406) = lu(k,1406) - lu(k,1241) * lu(k,1392) + lu(k,1407) = lu(k,1407) - lu(k,1242) * lu(k,1392) + lu(k,1409) = lu(k,1409) - lu(k,1243) * lu(k,1392) + lu(k,1502) = lu(k,1502) - lu(k,1232) * lu(k,1500) + lu(k,1503) = lu(k,1503) - lu(k,1233) * lu(k,1500) + lu(k,1505) = lu(k,1505) - lu(k,1234) * lu(k,1500) + lu(k,1507) = lu(k,1507) - lu(k,1235) * lu(k,1500) + lu(k,1510) = lu(k,1510) - lu(k,1236) * lu(k,1500) + lu(k,1513) = lu(k,1513) - lu(k,1237) * lu(k,1500) + lu(k,1514) = lu(k,1514) - lu(k,1238) * lu(k,1500) + lu(k,1515) = lu(k,1515) - lu(k,1239) * lu(k,1500) + lu(k,1516) = lu(k,1516) - lu(k,1240) * lu(k,1500) + lu(k,1517) = lu(k,1517) - lu(k,1241) * lu(k,1500) + lu(k,1519) = lu(k,1519) - lu(k,1242) * lu(k,1500) + lu(k,1521) = lu(k,1521) - lu(k,1243) * lu(k,1500) + lu(k,1709) = lu(k,1709) - lu(k,1232) * lu(k,1707) + lu(k,1710) = lu(k,1710) - lu(k,1233) * lu(k,1707) + lu(k,1714) = lu(k,1714) - lu(k,1234) * lu(k,1707) + lu(k,1716) = lu(k,1716) - lu(k,1235) * lu(k,1707) + lu(k,1719) = lu(k,1719) - lu(k,1236) * lu(k,1707) + lu(k,1722) = lu(k,1722) - lu(k,1237) * lu(k,1707) + lu(k,1723) = lu(k,1723) - lu(k,1238) * lu(k,1707) + lu(k,1724) = lu(k,1724) - lu(k,1239) * lu(k,1707) + lu(k,1725) = lu(k,1725) - lu(k,1240) * lu(k,1707) + lu(k,1726) = lu(k,1726) - lu(k,1241) * lu(k,1707) + lu(k,1728) = lu(k,1728) - lu(k,1242) * lu(k,1707) + lu(k,1730) = lu(k,1730) - lu(k,1243) * lu(k,1707) + lu(k,1772) = lu(k,1772) - lu(k,1232) * lu(k,1770) + lu(k,1773) = lu(k,1773) - lu(k,1233) * lu(k,1770) + lu(k,1776) = lu(k,1776) - lu(k,1234) * lu(k,1770) + lu(k,1778) = lu(k,1778) - lu(k,1235) * lu(k,1770) + lu(k,1781) = lu(k,1781) - lu(k,1236) * lu(k,1770) + lu(k,1784) = lu(k,1784) - lu(k,1237) * lu(k,1770) + lu(k,1785) = lu(k,1785) - lu(k,1238) * lu(k,1770) + lu(k,1786) = lu(k,1786) - lu(k,1239) * lu(k,1770) + lu(k,1787) = lu(k,1787) - lu(k,1240) * lu(k,1770) + lu(k,1788) = lu(k,1788) - lu(k,1241) * lu(k,1770) + lu(k,1790) = lu(k,1790) - lu(k,1242) * lu(k,1770) + lu(k,1792) = lu(k,1792) - lu(k,1243) * lu(k,1770) + lu(k,1894) = lu(k,1894) - lu(k,1232) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,1233) * lu(k,1892) + lu(k,1898) = lu(k,1898) - lu(k,1234) * lu(k,1892) + lu(k,1900) = lu(k,1900) - lu(k,1235) * lu(k,1892) + lu(k,1903) = lu(k,1903) - lu(k,1236) * lu(k,1892) + lu(k,1906) = lu(k,1906) - lu(k,1237) * lu(k,1892) + lu(k,1907) = lu(k,1907) - lu(k,1238) * lu(k,1892) + lu(k,1908) = lu(k,1908) - lu(k,1239) * lu(k,1892) + lu(k,1909) = lu(k,1909) - lu(k,1240) * lu(k,1892) + lu(k,1910) = lu(k,1910) - lu(k,1241) * lu(k,1892) + lu(k,1912) = lu(k,1912) - lu(k,1242) * lu(k,1892) + lu(k,1914) = lu(k,1914) - lu(k,1243) * lu(k,1892) + lu(k,2097) = lu(k,2097) - lu(k,1232) * lu(k,2095) + lu(k,2098) = lu(k,2098) - lu(k,1233) * lu(k,2095) + lu(k,2101) = lu(k,2101) - lu(k,1234) * lu(k,2095) + lu(k,2103) = lu(k,2103) - lu(k,1235) * lu(k,2095) + lu(k,2106) = lu(k,2106) - lu(k,1236) * lu(k,2095) + lu(k,2109) = lu(k,2109) - lu(k,1237) * lu(k,2095) + lu(k,2110) = lu(k,2110) - lu(k,1238) * lu(k,2095) + lu(k,2111) = lu(k,2111) - lu(k,1239) * lu(k,2095) + lu(k,2112) = lu(k,2112) - lu(k,1240) * lu(k,2095) + lu(k,2113) = lu(k,2113) - lu(k,1241) * lu(k,2095) + lu(k,2115) = lu(k,2115) - lu(k,1242) * lu(k,2095) + lu(k,2117) = lu(k,2117) - lu(k,1243) * lu(k,2095) + lu(k,1251) = 1._r8 / lu(k,1251) + lu(k,1252) = lu(k,1252) * lu(k,1251) + lu(k,1253) = lu(k,1253) * lu(k,1251) + lu(k,1254) = lu(k,1254) * lu(k,1251) + lu(k,1255) = lu(k,1255) * lu(k,1251) + lu(k,1256) = lu(k,1256) * lu(k,1251) + lu(k,1257) = lu(k,1257) * lu(k,1251) + lu(k,1258) = lu(k,1258) * lu(k,1251) + lu(k,1259) = lu(k,1259) * lu(k,1251) + lu(k,1260) = lu(k,1260) * lu(k,1251) + lu(k,1261) = lu(k,1261) * lu(k,1251) + lu(k,1262) = lu(k,1262) * lu(k,1251) + lu(k,1263) = lu(k,1263) * lu(k,1251) + lu(k,1264) = lu(k,1264) * lu(k,1251) + lu(k,1265) = lu(k,1265) * lu(k,1251) + lu(k,1301) = lu(k,1301) - lu(k,1252) * lu(k,1300) + lu(k,1302) = lu(k,1302) - lu(k,1253) * lu(k,1300) + lu(k,1303) = lu(k,1303) - lu(k,1254) * lu(k,1300) + lu(k,1304) = - lu(k,1255) * lu(k,1300) + lu(k,1305) = lu(k,1305) - lu(k,1256) * lu(k,1300) + lu(k,1306) = lu(k,1306) - lu(k,1257) * lu(k,1300) + lu(k,1307) = lu(k,1307) - lu(k,1258) * lu(k,1300) + lu(k,1308) = lu(k,1308) - lu(k,1259) * lu(k,1300) + lu(k,1309) = lu(k,1309) - lu(k,1260) * lu(k,1300) + lu(k,1310) = lu(k,1310) - lu(k,1261) * lu(k,1300) + lu(k,1311) = lu(k,1311) - lu(k,1262) * lu(k,1300) + lu(k,1312) = lu(k,1312) - lu(k,1263) * lu(k,1300) + lu(k,1313) = lu(k,1313) - lu(k,1264) * lu(k,1300) + lu(k,1314) = lu(k,1314) - lu(k,1265) * lu(k,1300) + lu(k,1394) = lu(k,1394) - lu(k,1252) * lu(k,1393) + lu(k,1395) = lu(k,1395) - lu(k,1253) * lu(k,1393) + lu(k,1396) = lu(k,1396) - lu(k,1254) * lu(k,1393) + lu(k,1397) = lu(k,1397) - lu(k,1255) * lu(k,1393) + lu(k,1398) = lu(k,1398) - lu(k,1256) * lu(k,1393) + lu(k,1400) = lu(k,1400) - lu(k,1257) * lu(k,1393) + lu(k,1401) = lu(k,1401) - lu(k,1258) * lu(k,1393) + lu(k,1402) = lu(k,1402) - lu(k,1259) * lu(k,1393) + lu(k,1403) = lu(k,1403) - lu(k,1260) * lu(k,1393) + lu(k,1404) = lu(k,1404) - lu(k,1261) * lu(k,1393) + lu(k,1405) = lu(k,1405) - lu(k,1262) * lu(k,1393) + lu(k,1406) = lu(k,1406) - lu(k,1263) * lu(k,1393) + lu(k,1407) = lu(k,1407) - lu(k,1264) * lu(k,1393) + lu(k,1409) = lu(k,1409) - lu(k,1265) * lu(k,1393) + lu(k,1502) = lu(k,1502) - lu(k,1252) * lu(k,1501) + lu(k,1503) = lu(k,1503) - lu(k,1253) * lu(k,1501) + lu(k,1505) = lu(k,1505) - lu(k,1254) * lu(k,1501) + lu(k,1506) = lu(k,1506) - lu(k,1255) * lu(k,1501) + lu(k,1507) = lu(k,1507) - lu(k,1256) * lu(k,1501) + lu(k,1510) = lu(k,1510) - lu(k,1257) * lu(k,1501) + lu(k,1511) = lu(k,1511) - lu(k,1258) * lu(k,1501) + lu(k,1513) = lu(k,1513) - lu(k,1259) * lu(k,1501) + lu(k,1514) = lu(k,1514) - lu(k,1260) * lu(k,1501) + lu(k,1515) = lu(k,1515) - lu(k,1261) * lu(k,1501) + lu(k,1516) = lu(k,1516) - lu(k,1262) * lu(k,1501) + lu(k,1517) = lu(k,1517) - lu(k,1263) * lu(k,1501) + lu(k,1519) = lu(k,1519) - lu(k,1264) * lu(k,1501) + lu(k,1521) = lu(k,1521) - lu(k,1265) * lu(k,1501) + lu(k,1709) = lu(k,1709) - lu(k,1252) * lu(k,1708) + lu(k,1710) = lu(k,1710) - lu(k,1253) * lu(k,1708) + lu(k,1714) = lu(k,1714) - lu(k,1254) * lu(k,1708) + lu(k,1715) = lu(k,1715) - lu(k,1255) * lu(k,1708) + lu(k,1716) = lu(k,1716) - lu(k,1256) * lu(k,1708) + lu(k,1719) = lu(k,1719) - lu(k,1257) * lu(k,1708) + lu(k,1720) = lu(k,1720) - lu(k,1258) * lu(k,1708) + lu(k,1722) = lu(k,1722) - lu(k,1259) * lu(k,1708) + lu(k,1723) = lu(k,1723) - lu(k,1260) * lu(k,1708) + lu(k,1724) = lu(k,1724) - lu(k,1261) * lu(k,1708) + lu(k,1725) = lu(k,1725) - lu(k,1262) * lu(k,1708) + lu(k,1726) = lu(k,1726) - lu(k,1263) * lu(k,1708) + lu(k,1728) = lu(k,1728) - lu(k,1264) * lu(k,1708) + lu(k,1730) = lu(k,1730) - lu(k,1265) * lu(k,1708) + lu(k,1772) = lu(k,1772) - lu(k,1252) * lu(k,1771) + lu(k,1773) = lu(k,1773) - lu(k,1253) * lu(k,1771) + lu(k,1776) = lu(k,1776) - lu(k,1254) * lu(k,1771) + lu(k,1777) = lu(k,1777) - lu(k,1255) * lu(k,1771) + lu(k,1778) = lu(k,1778) - lu(k,1256) * lu(k,1771) + lu(k,1781) = lu(k,1781) - lu(k,1257) * lu(k,1771) + lu(k,1782) = lu(k,1782) - lu(k,1258) * lu(k,1771) + lu(k,1784) = lu(k,1784) - lu(k,1259) * lu(k,1771) + lu(k,1785) = lu(k,1785) - lu(k,1260) * lu(k,1771) + lu(k,1786) = lu(k,1786) - lu(k,1261) * lu(k,1771) + lu(k,1787) = lu(k,1787) - lu(k,1262) * lu(k,1771) + lu(k,1788) = lu(k,1788) - lu(k,1263) * lu(k,1771) + lu(k,1790) = lu(k,1790) - lu(k,1264) * lu(k,1771) + lu(k,1792) = lu(k,1792) - lu(k,1265) * lu(k,1771) + lu(k,1894) = lu(k,1894) - lu(k,1252) * lu(k,1893) + lu(k,1895) = lu(k,1895) - lu(k,1253) * lu(k,1893) + lu(k,1898) = lu(k,1898) - lu(k,1254) * lu(k,1893) + lu(k,1899) = lu(k,1899) - lu(k,1255) * lu(k,1893) + lu(k,1900) = lu(k,1900) - lu(k,1256) * lu(k,1893) + lu(k,1903) = lu(k,1903) - lu(k,1257) * lu(k,1893) + lu(k,1904) = lu(k,1904) - lu(k,1258) * lu(k,1893) + lu(k,1906) = lu(k,1906) - lu(k,1259) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1260) * lu(k,1893) + lu(k,1908) = lu(k,1908) - lu(k,1261) * lu(k,1893) + lu(k,1909) = lu(k,1909) - lu(k,1262) * lu(k,1893) + lu(k,1910) = lu(k,1910) - lu(k,1263) * lu(k,1893) + lu(k,1912) = lu(k,1912) - lu(k,1264) * lu(k,1893) + lu(k,1914) = lu(k,1914) - lu(k,1265) * lu(k,1893) + lu(k,2097) = lu(k,2097) - lu(k,1252) * lu(k,2096) + lu(k,2098) = lu(k,2098) - lu(k,1253) * lu(k,2096) + lu(k,2101) = lu(k,2101) - lu(k,1254) * lu(k,2096) + lu(k,2102) = lu(k,2102) - lu(k,1255) * lu(k,2096) + lu(k,2103) = lu(k,2103) - lu(k,1256) * lu(k,2096) + lu(k,2106) = lu(k,2106) - lu(k,1257) * lu(k,2096) + lu(k,2107) = lu(k,2107) - lu(k,1258) * lu(k,2096) + lu(k,2109) = lu(k,2109) - lu(k,1259) * lu(k,2096) + lu(k,2110) = lu(k,2110) - lu(k,1260) * lu(k,2096) + lu(k,2111) = lu(k,2111) - lu(k,1261) * lu(k,2096) + lu(k,2112) = lu(k,2112) - lu(k,1262) * lu(k,2096) + lu(k,2113) = lu(k,2113) - lu(k,1263) * lu(k,2096) + lu(k,2115) = lu(k,2115) - lu(k,1264) * lu(k,2096) + lu(k,2117) = lu(k,2117) - lu(k,1265) * lu(k,2096) + lu(k,1271) = 1._r8 / lu(k,1271) + lu(k,1272) = lu(k,1272) * lu(k,1271) + lu(k,1273) = lu(k,1273) * lu(k,1271) + lu(k,1274) = lu(k,1274) * lu(k,1271) + lu(k,1275) = lu(k,1275) * lu(k,1271) + lu(k,1276) = lu(k,1276) * lu(k,1271) + lu(k,1277) = lu(k,1277) * lu(k,1271) + lu(k,1278) = lu(k,1278) * lu(k,1271) + lu(k,1279) = lu(k,1279) * lu(k,1271) + lu(k,1280) = lu(k,1280) * lu(k,1271) + lu(k,1281) = lu(k,1281) * lu(k,1271) + lu(k,1282) = lu(k,1282) * lu(k,1271) + lu(k,1283) = lu(k,1283) * lu(k,1271) + lu(k,1302) = lu(k,1302) - lu(k,1272) * lu(k,1301) + lu(k,1303) = lu(k,1303) - lu(k,1273) * lu(k,1301) + lu(k,1305) = lu(k,1305) - lu(k,1274) * lu(k,1301) + lu(k,1306) = lu(k,1306) - lu(k,1275) * lu(k,1301) + lu(k,1307) = lu(k,1307) - lu(k,1276) * lu(k,1301) + lu(k,1308) = lu(k,1308) - lu(k,1277) * lu(k,1301) + lu(k,1309) = lu(k,1309) - lu(k,1278) * lu(k,1301) + lu(k,1310) = lu(k,1310) - lu(k,1279) * lu(k,1301) + lu(k,1311) = lu(k,1311) - lu(k,1280) * lu(k,1301) + lu(k,1312) = lu(k,1312) - lu(k,1281) * lu(k,1301) + lu(k,1313) = lu(k,1313) - lu(k,1282) * lu(k,1301) + lu(k,1314) = lu(k,1314) - lu(k,1283) * lu(k,1301) + lu(k,1395) = lu(k,1395) - lu(k,1272) * lu(k,1394) + lu(k,1396) = lu(k,1396) - lu(k,1273) * lu(k,1394) + lu(k,1398) = lu(k,1398) - lu(k,1274) * lu(k,1394) + lu(k,1400) = lu(k,1400) - lu(k,1275) * lu(k,1394) + lu(k,1401) = lu(k,1401) - lu(k,1276) * lu(k,1394) + lu(k,1402) = lu(k,1402) - lu(k,1277) * lu(k,1394) + lu(k,1403) = lu(k,1403) - lu(k,1278) * lu(k,1394) + lu(k,1404) = lu(k,1404) - lu(k,1279) * lu(k,1394) + lu(k,1405) = lu(k,1405) - lu(k,1280) * lu(k,1394) + lu(k,1406) = lu(k,1406) - lu(k,1281) * lu(k,1394) + lu(k,1407) = lu(k,1407) - lu(k,1282) * lu(k,1394) + lu(k,1409) = lu(k,1409) - lu(k,1283) * lu(k,1394) + lu(k,1503) = lu(k,1503) - lu(k,1272) * lu(k,1502) + lu(k,1505) = lu(k,1505) - lu(k,1273) * lu(k,1502) + lu(k,1507) = lu(k,1507) - lu(k,1274) * lu(k,1502) + lu(k,1510) = lu(k,1510) - lu(k,1275) * lu(k,1502) + lu(k,1511) = lu(k,1511) - lu(k,1276) * lu(k,1502) + lu(k,1513) = lu(k,1513) - lu(k,1277) * lu(k,1502) + lu(k,1514) = lu(k,1514) - lu(k,1278) * lu(k,1502) + lu(k,1515) = lu(k,1515) - lu(k,1279) * lu(k,1502) + lu(k,1516) = lu(k,1516) - lu(k,1280) * lu(k,1502) + lu(k,1517) = lu(k,1517) - lu(k,1281) * lu(k,1502) + lu(k,1519) = lu(k,1519) - lu(k,1282) * lu(k,1502) + lu(k,1521) = lu(k,1521) - lu(k,1283) * lu(k,1502) + lu(k,1710) = lu(k,1710) - lu(k,1272) * lu(k,1709) + lu(k,1714) = lu(k,1714) - lu(k,1273) * lu(k,1709) + lu(k,1716) = lu(k,1716) - lu(k,1274) * lu(k,1709) + lu(k,1719) = lu(k,1719) - lu(k,1275) * lu(k,1709) + lu(k,1720) = lu(k,1720) - lu(k,1276) * lu(k,1709) + lu(k,1722) = lu(k,1722) - lu(k,1277) * lu(k,1709) + lu(k,1723) = lu(k,1723) - lu(k,1278) * lu(k,1709) + lu(k,1724) = lu(k,1724) - lu(k,1279) * lu(k,1709) + lu(k,1725) = lu(k,1725) - lu(k,1280) * lu(k,1709) + lu(k,1726) = lu(k,1726) - lu(k,1281) * lu(k,1709) + lu(k,1728) = lu(k,1728) - lu(k,1282) * lu(k,1709) + lu(k,1730) = lu(k,1730) - lu(k,1283) * lu(k,1709) + lu(k,1773) = lu(k,1773) - lu(k,1272) * lu(k,1772) + lu(k,1776) = lu(k,1776) - lu(k,1273) * lu(k,1772) + lu(k,1778) = lu(k,1778) - lu(k,1274) * lu(k,1772) + lu(k,1781) = lu(k,1781) - lu(k,1275) * lu(k,1772) + lu(k,1782) = lu(k,1782) - lu(k,1276) * lu(k,1772) + lu(k,1784) = lu(k,1784) - lu(k,1277) * lu(k,1772) + lu(k,1785) = lu(k,1785) - lu(k,1278) * lu(k,1772) + lu(k,1786) = lu(k,1786) - lu(k,1279) * lu(k,1772) + lu(k,1787) = lu(k,1787) - lu(k,1280) * lu(k,1772) + lu(k,1788) = lu(k,1788) - lu(k,1281) * lu(k,1772) + lu(k,1790) = lu(k,1790) - lu(k,1282) * lu(k,1772) + lu(k,1792) = lu(k,1792) - lu(k,1283) * lu(k,1772) + lu(k,1895) = lu(k,1895) - lu(k,1272) * lu(k,1894) + lu(k,1898) = lu(k,1898) - lu(k,1273) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1274) * lu(k,1894) + lu(k,1903) = lu(k,1903) - lu(k,1275) * lu(k,1894) + lu(k,1904) = lu(k,1904) - lu(k,1276) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1277) * lu(k,1894) + lu(k,1907) = lu(k,1907) - lu(k,1278) * lu(k,1894) + lu(k,1908) = lu(k,1908) - lu(k,1279) * lu(k,1894) + lu(k,1909) = lu(k,1909) - lu(k,1280) * lu(k,1894) + lu(k,1910) = lu(k,1910) - lu(k,1281) * lu(k,1894) + lu(k,1912) = lu(k,1912) - lu(k,1282) * lu(k,1894) + lu(k,1914) = lu(k,1914) - lu(k,1283) * lu(k,1894) + lu(k,1978) = lu(k,1978) - lu(k,1272) * lu(k,1977) + lu(k,1982) = lu(k,1982) - lu(k,1273) * lu(k,1977) + lu(k,1984) = lu(k,1984) - lu(k,1274) * lu(k,1977) + lu(k,1987) = lu(k,1987) - lu(k,1275) * lu(k,1977) + lu(k,1988) = lu(k,1988) - lu(k,1276) * lu(k,1977) + lu(k,1990) = lu(k,1990) - lu(k,1277) * lu(k,1977) + lu(k,1991) = lu(k,1991) - lu(k,1278) * lu(k,1977) + lu(k,1992) = lu(k,1992) - lu(k,1279) * lu(k,1977) + lu(k,1993) = lu(k,1993) - lu(k,1280) * lu(k,1977) + lu(k,1994) = lu(k,1994) - lu(k,1281) * lu(k,1977) + lu(k,1996) = lu(k,1996) - lu(k,1282) * lu(k,1977) + lu(k,1998) = lu(k,1998) - lu(k,1283) * lu(k,1977) + lu(k,2098) = lu(k,2098) - lu(k,1272) * lu(k,2097) + lu(k,2101) = lu(k,2101) - lu(k,1273) * lu(k,2097) + lu(k,2103) = lu(k,2103) - lu(k,1274) * lu(k,2097) + lu(k,2106) = lu(k,2106) - lu(k,1275) * lu(k,2097) + lu(k,2107) = lu(k,2107) - lu(k,1276) * lu(k,2097) + lu(k,2109) = lu(k,2109) - lu(k,1277) * lu(k,2097) + lu(k,2110) = lu(k,2110) - lu(k,1278) * lu(k,2097) + lu(k,2111) = lu(k,2111) - lu(k,1279) * lu(k,2097) + lu(k,2112) = lu(k,2112) - lu(k,1280) * lu(k,2097) + lu(k,2113) = lu(k,2113) - lu(k,1281) * lu(k,2097) + lu(k,2115) = lu(k,2115) - lu(k,1282) * lu(k,2097) + lu(k,2117) = lu(k,2117) - lu(k,1283) * lu(k,2097) + lu(k,1302) = 1._r8 / lu(k,1302) + lu(k,1303) = lu(k,1303) * lu(k,1302) + lu(k,1304) = lu(k,1304) * lu(k,1302) + lu(k,1305) = lu(k,1305) * lu(k,1302) + lu(k,1306) = lu(k,1306) * lu(k,1302) + lu(k,1307) = lu(k,1307) * lu(k,1302) + lu(k,1308) = lu(k,1308) * lu(k,1302) + lu(k,1309) = lu(k,1309) * lu(k,1302) + lu(k,1310) = lu(k,1310) * lu(k,1302) + lu(k,1311) = lu(k,1311) * lu(k,1302) + lu(k,1312) = lu(k,1312) * lu(k,1302) + lu(k,1313) = lu(k,1313) * lu(k,1302) + lu(k,1314) = lu(k,1314) * lu(k,1302) + lu(k,1396) = lu(k,1396) - lu(k,1303) * lu(k,1395) + lu(k,1397) = lu(k,1397) - lu(k,1304) * lu(k,1395) + lu(k,1398) = lu(k,1398) - lu(k,1305) * lu(k,1395) + lu(k,1400) = lu(k,1400) - lu(k,1306) * lu(k,1395) + lu(k,1401) = lu(k,1401) - lu(k,1307) * lu(k,1395) + lu(k,1402) = lu(k,1402) - lu(k,1308) * lu(k,1395) + lu(k,1403) = lu(k,1403) - lu(k,1309) * lu(k,1395) + lu(k,1404) = lu(k,1404) - lu(k,1310) * lu(k,1395) + lu(k,1405) = lu(k,1405) - lu(k,1311) * lu(k,1395) + lu(k,1406) = lu(k,1406) - lu(k,1312) * lu(k,1395) + lu(k,1407) = lu(k,1407) - lu(k,1313) * lu(k,1395) + lu(k,1409) = lu(k,1409) - lu(k,1314) * lu(k,1395) + lu(k,1505) = lu(k,1505) - lu(k,1303) * lu(k,1503) + lu(k,1506) = lu(k,1506) - lu(k,1304) * lu(k,1503) + lu(k,1507) = lu(k,1507) - lu(k,1305) * lu(k,1503) + lu(k,1510) = lu(k,1510) - lu(k,1306) * lu(k,1503) + lu(k,1511) = lu(k,1511) - lu(k,1307) * lu(k,1503) + lu(k,1513) = lu(k,1513) - lu(k,1308) * lu(k,1503) + lu(k,1514) = lu(k,1514) - lu(k,1309) * lu(k,1503) + lu(k,1515) = lu(k,1515) - lu(k,1310) * lu(k,1503) + lu(k,1516) = lu(k,1516) - lu(k,1311) * lu(k,1503) + lu(k,1517) = lu(k,1517) - lu(k,1312) * lu(k,1503) + lu(k,1519) = lu(k,1519) - lu(k,1313) * lu(k,1503) + lu(k,1521) = lu(k,1521) - lu(k,1314) * lu(k,1503) + lu(k,1540) = lu(k,1540) - lu(k,1303) * lu(k,1537) + lu(k,1541) = lu(k,1541) - lu(k,1304) * lu(k,1537) + lu(k,1542) = lu(k,1542) - lu(k,1305) * lu(k,1537) + lu(k,1545) = lu(k,1545) - lu(k,1306) * lu(k,1537) + lu(k,1546) = lu(k,1546) - lu(k,1307) * lu(k,1537) + lu(k,1548) = lu(k,1548) - lu(k,1308) * lu(k,1537) + lu(k,1549) = lu(k,1549) - lu(k,1309) * lu(k,1537) + lu(k,1550) = lu(k,1550) - lu(k,1310) * lu(k,1537) + lu(k,1551) = lu(k,1551) - lu(k,1311) * lu(k,1537) + lu(k,1552) = lu(k,1552) - lu(k,1312) * lu(k,1537) + lu(k,1554) = lu(k,1554) - lu(k,1313) * lu(k,1537) + lu(k,1556) = lu(k,1556) - lu(k,1314) * lu(k,1537) + lu(k,1714) = lu(k,1714) - lu(k,1303) * lu(k,1710) + lu(k,1715) = lu(k,1715) - lu(k,1304) * lu(k,1710) + lu(k,1716) = lu(k,1716) - lu(k,1305) * lu(k,1710) + lu(k,1719) = lu(k,1719) - lu(k,1306) * lu(k,1710) + lu(k,1720) = lu(k,1720) - lu(k,1307) * lu(k,1710) + lu(k,1722) = lu(k,1722) - lu(k,1308) * lu(k,1710) + lu(k,1723) = lu(k,1723) - lu(k,1309) * lu(k,1710) + lu(k,1724) = lu(k,1724) - lu(k,1310) * lu(k,1710) + lu(k,1725) = lu(k,1725) - lu(k,1311) * lu(k,1710) + lu(k,1726) = lu(k,1726) - lu(k,1312) * lu(k,1710) + lu(k,1728) = lu(k,1728) - lu(k,1313) * lu(k,1710) + lu(k,1730) = lu(k,1730) - lu(k,1314) * lu(k,1710) + lu(k,1776) = lu(k,1776) - lu(k,1303) * lu(k,1773) + lu(k,1777) = lu(k,1777) - lu(k,1304) * lu(k,1773) + lu(k,1778) = lu(k,1778) - lu(k,1305) * lu(k,1773) + lu(k,1781) = lu(k,1781) - lu(k,1306) * lu(k,1773) + lu(k,1782) = lu(k,1782) - lu(k,1307) * lu(k,1773) + lu(k,1784) = lu(k,1784) - lu(k,1308) * lu(k,1773) + lu(k,1785) = lu(k,1785) - lu(k,1309) * lu(k,1773) + lu(k,1786) = lu(k,1786) - lu(k,1310) * lu(k,1773) + lu(k,1787) = lu(k,1787) - lu(k,1311) * lu(k,1773) + lu(k,1788) = lu(k,1788) - lu(k,1312) * lu(k,1773) + lu(k,1790) = lu(k,1790) - lu(k,1313) * lu(k,1773) + lu(k,1792) = lu(k,1792) - lu(k,1314) * lu(k,1773) + lu(k,1898) = lu(k,1898) - lu(k,1303) * lu(k,1895) + lu(k,1899) = lu(k,1899) - lu(k,1304) * lu(k,1895) + lu(k,1900) = lu(k,1900) - lu(k,1305) * lu(k,1895) + lu(k,1903) = lu(k,1903) - lu(k,1306) * lu(k,1895) + lu(k,1904) = lu(k,1904) - lu(k,1307) * lu(k,1895) + lu(k,1906) = lu(k,1906) - lu(k,1308) * lu(k,1895) + lu(k,1907) = lu(k,1907) - lu(k,1309) * lu(k,1895) + lu(k,1908) = lu(k,1908) - lu(k,1310) * lu(k,1895) + lu(k,1909) = lu(k,1909) - lu(k,1311) * lu(k,1895) + lu(k,1910) = lu(k,1910) - lu(k,1312) * lu(k,1895) + lu(k,1912) = lu(k,1912) - lu(k,1313) * lu(k,1895) + lu(k,1914) = lu(k,1914) - lu(k,1314) * lu(k,1895) + lu(k,1982) = lu(k,1982) - lu(k,1303) * lu(k,1978) + lu(k,1983) = lu(k,1983) - lu(k,1304) * lu(k,1978) + lu(k,1984) = lu(k,1984) - lu(k,1305) * lu(k,1978) + lu(k,1987) = lu(k,1987) - lu(k,1306) * lu(k,1978) + lu(k,1988) = lu(k,1988) - lu(k,1307) * lu(k,1978) + lu(k,1990) = lu(k,1990) - lu(k,1308) * lu(k,1978) + lu(k,1991) = lu(k,1991) - lu(k,1309) * lu(k,1978) + lu(k,1992) = lu(k,1992) - lu(k,1310) * lu(k,1978) + lu(k,1993) = lu(k,1993) - lu(k,1311) * lu(k,1978) + lu(k,1994) = lu(k,1994) - lu(k,1312) * lu(k,1978) + lu(k,1996) = lu(k,1996) - lu(k,1313) * lu(k,1978) + lu(k,1998) = lu(k,1998) - lu(k,1314) * lu(k,1978) + lu(k,2101) = lu(k,2101) - lu(k,1303) * lu(k,2098) + lu(k,2102) = lu(k,2102) - lu(k,1304) * lu(k,2098) + lu(k,2103) = lu(k,2103) - lu(k,1305) * lu(k,2098) + lu(k,2106) = lu(k,2106) - lu(k,1306) * lu(k,2098) + lu(k,2107) = lu(k,2107) - lu(k,1307) * lu(k,2098) + lu(k,2109) = lu(k,2109) - lu(k,1308) * lu(k,2098) + lu(k,2110) = lu(k,2110) - lu(k,1309) * lu(k,2098) + lu(k,2111) = lu(k,2111) - lu(k,1310) * lu(k,2098) + lu(k,2112) = lu(k,2112) - lu(k,1311) * lu(k,2098) + lu(k,2113) = lu(k,2113) - lu(k,1312) * lu(k,2098) + lu(k,2115) = lu(k,2115) - lu(k,1313) * lu(k,2098) + lu(k,2117) = lu(k,2117) - lu(k,1314) * lu(k,2098) + end do + end subroutine lu_fac25 + subroutine lu_fac26( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1318) = 1._r8 / lu(k,1318) + lu(k,1319) = lu(k,1319) * lu(k,1318) + lu(k,1320) = lu(k,1320) * lu(k,1318) + lu(k,1321) = lu(k,1321) * lu(k,1318) + lu(k,1322) = lu(k,1322) * lu(k,1318) + lu(k,1323) = lu(k,1323) * lu(k,1318) + lu(k,1324) = lu(k,1324) * lu(k,1318) + lu(k,1325) = lu(k,1325) * lu(k,1318) + lu(k,1326) = lu(k,1326) * lu(k,1318) + lu(k,1327) = lu(k,1327) * lu(k,1318) + lu(k,1328) = lu(k,1328) * lu(k,1318) + lu(k,1329) = lu(k,1329) * lu(k,1318) + lu(k,1330) = lu(k,1330) * lu(k,1318) + lu(k,1331) = lu(k,1331) * lu(k,1318) + lu(k,1426) = - lu(k,1319) * lu(k,1425) + lu(k,1427) = lu(k,1427) - lu(k,1320) * lu(k,1425) + lu(k,1428) = lu(k,1428) - lu(k,1321) * lu(k,1425) + lu(k,1429) = - lu(k,1322) * lu(k,1425) + lu(k,1431) = lu(k,1431) - lu(k,1323) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,1324) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,1325) * lu(k,1425) + lu(k,1435) = lu(k,1435) - lu(k,1326) * lu(k,1425) + lu(k,1436) = lu(k,1436) - lu(k,1327) * lu(k,1425) + lu(k,1437) = - lu(k,1328) * lu(k,1425) + lu(k,1438) = lu(k,1438) - lu(k,1329) * lu(k,1425) + lu(k,1439) = - lu(k,1330) * lu(k,1425) + lu(k,1440) = lu(k,1440) - lu(k,1331) * lu(k,1425) + lu(k,1713) = lu(k,1713) - lu(k,1319) * lu(k,1711) + lu(k,1715) = lu(k,1715) - lu(k,1320) * lu(k,1711) + lu(k,1716) = lu(k,1716) - lu(k,1321) * lu(k,1711) + lu(k,1717) = lu(k,1717) - lu(k,1322) * lu(k,1711) + lu(k,1719) = lu(k,1719) - lu(k,1323) * lu(k,1711) + lu(k,1720) = lu(k,1720) - lu(k,1324) * lu(k,1711) + lu(k,1721) = lu(k,1721) - lu(k,1325) * lu(k,1711) + lu(k,1724) = lu(k,1724) - lu(k,1326) * lu(k,1711) + lu(k,1726) = lu(k,1726) - lu(k,1327) * lu(k,1711) + lu(k,1727) = lu(k,1727) - lu(k,1328) * lu(k,1711) + lu(k,1728) = lu(k,1728) - lu(k,1329) * lu(k,1711) + lu(k,1729) = lu(k,1729) - lu(k,1330) * lu(k,1711) + lu(k,1730) = lu(k,1730) - lu(k,1331) * lu(k,1711) + lu(k,1775) = lu(k,1775) - lu(k,1319) * lu(k,1774) + lu(k,1777) = lu(k,1777) - lu(k,1320) * lu(k,1774) + lu(k,1778) = lu(k,1778) - lu(k,1321) * lu(k,1774) + lu(k,1779) = lu(k,1779) - lu(k,1322) * lu(k,1774) + lu(k,1781) = lu(k,1781) - lu(k,1323) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,1324) * lu(k,1774) + lu(k,1783) = lu(k,1783) - lu(k,1325) * lu(k,1774) + lu(k,1786) = lu(k,1786) - lu(k,1326) * lu(k,1774) + lu(k,1788) = lu(k,1788) - lu(k,1327) * lu(k,1774) + lu(k,1789) = lu(k,1789) - lu(k,1328) * lu(k,1774) + lu(k,1790) = lu(k,1790) - lu(k,1329) * lu(k,1774) + lu(k,1791) = lu(k,1791) - lu(k,1330) * lu(k,1774) + lu(k,1792) = lu(k,1792) - lu(k,1331) * lu(k,1774) + lu(k,1816) = lu(k,1816) - lu(k,1319) * lu(k,1814) + lu(k,1818) = lu(k,1818) - lu(k,1320) * lu(k,1814) + lu(k,1819) = lu(k,1819) - lu(k,1321) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1322) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1323) * lu(k,1814) + lu(k,1823) = lu(k,1823) - lu(k,1324) * lu(k,1814) + lu(k,1824) = lu(k,1824) - lu(k,1325) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,1326) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1327) * lu(k,1814) + lu(k,1830) = lu(k,1830) - lu(k,1328) * lu(k,1814) + lu(k,1831) = lu(k,1831) - lu(k,1329) * lu(k,1814) + lu(k,1832) = lu(k,1832) - lu(k,1330) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1331) * lu(k,1814) + lu(k,1897) = - lu(k,1319) * lu(k,1896) + lu(k,1899) = lu(k,1899) - lu(k,1320) * lu(k,1896) + lu(k,1900) = lu(k,1900) - lu(k,1321) * lu(k,1896) + lu(k,1901) = - lu(k,1322) * lu(k,1896) + lu(k,1903) = lu(k,1903) - lu(k,1323) * lu(k,1896) + lu(k,1904) = lu(k,1904) - lu(k,1324) * lu(k,1896) + lu(k,1905) = lu(k,1905) - lu(k,1325) * lu(k,1896) + lu(k,1908) = lu(k,1908) - lu(k,1326) * lu(k,1896) + lu(k,1910) = lu(k,1910) - lu(k,1327) * lu(k,1896) + lu(k,1911) = - lu(k,1328) * lu(k,1896) + lu(k,1912) = lu(k,1912) - lu(k,1329) * lu(k,1896) + lu(k,1913) = - lu(k,1330) * lu(k,1896) + lu(k,1914) = lu(k,1914) - lu(k,1331) * lu(k,1896) + lu(k,1981) = lu(k,1981) - lu(k,1319) * lu(k,1979) + lu(k,1983) = lu(k,1983) - lu(k,1320) * lu(k,1979) + lu(k,1984) = lu(k,1984) - lu(k,1321) * lu(k,1979) + lu(k,1985) = lu(k,1985) - lu(k,1322) * lu(k,1979) + lu(k,1987) = lu(k,1987) - lu(k,1323) * lu(k,1979) + lu(k,1988) = lu(k,1988) - lu(k,1324) * lu(k,1979) + lu(k,1989) = lu(k,1989) - lu(k,1325) * lu(k,1979) + lu(k,1992) = lu(k,1992) - lu(k,1326) * lu(k,1979) + lu(k,1994) = lu(k,1994) - lu(k,1327) * lu(k,1979) + lu(k,1995) = lu(k,1995) - lu(k,1328) * lu(k,1979) + lu(k,1996) = lu(k,1996) - lu(k,1329) * lu(k,1979) + lu(k,1997) = lu(k,1997) - lu(k,1330) * lu(k,1979) + lu(k,1998) = lu(k,1998) - lu(k,1331) * lu(k,1979) + lu(k,2006) = lu(k,2006) - lu(k,1319) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1320) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1321) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1322) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1323) * lu(k,2004) + lu(k,2012) = - lu(k,1324) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1325) * lu(k,2004) + lu(k,2016) = - lu(k,1326) * lu(k,2004) + lu(k,2018) = lu(k,2018) - lu(k,1327) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,1328) * lu(k,2004) + lu(k,2020) = lu(k,2020) - lu(k,1329) * lu(k,2004) + lu(k,2021) = lu(k,2021) - lu(k,1330) * lu(k,2004) + lu(k,2022) = lu(k,2022) - lu(k,1331) * lu(k,2004) + lu(k,2127) = lu(k,2127) - lu(k,1319) * lu(k,2125) + lu(k,2129) = lu(k,2129) - lu(k,1320) * lu(k,2125) + lu(k,2130) = lu(k,2130) - lu(k,1321) * lu(k,2125) + lu(k,2131) = lu(k,2131) - lu(k,1322) * lu(k,2125) + lu(k,2133) = lu(k,2133) - lu(k,1323) * lu(k,2125) + lu(k,2134) = - lu(k,1324) * lu(k,2125) + lu(k,2135) = lu(k,2135) - lu(k,1325) * lu(k,2125) + lu(k,2138) = - lu(k,1326) * lu(k,2125) + lu(k,2140) = lu(k,2140) - lu(k,1327) * lu(k,2125) + lu(k,2141) = lu(k,2141) - lu(k,1328) * lu(k,2125) + lu(k,2142) = lu(k,2142) - lu(k,1329) * lu(k,2125) + lu(k,2143) = lu(k,2143) - lu(k,1330) * lu(k,2125) + lu(k,2144) = lu(k,2144) - lu(k,1331) * lu(k,2125) + lu(k,2153) = - lu(k,1319) * lu(k,2151) + lu(k,2155) = - lu(k,1320) * lu(k,2151) + lu(k,2156) = - lu(k,1321) * lu(k,2151) + lu(k,2157) = lu(k,2157) - lu(k,1322) * lu(k,2151) + lu(k,2159) = lu(k,2159) - lu(k,1323) * lu(k,2151) + lu(k,2160) = - lu(k,1324) * lu(k,2151) + lu(k,2161) = lu(k,2161) - lu(k,1325) * lu(k,2151) + lu(k,2164) = lu(k,2164) - lu(k,1326) * lu(k,2151) + lu(k,2166) = - lu(k,1327) * lu(k,2151) + lu(k,2167) = - lu(k,1328) * lu(k,2151) + lu(k,2168) = lu(k,2168) - lu(k,1329) * lu(k,2151) + lu(k,2169) = - lu(k,1330) * lu(k,2151) + lu(k,2170) = lu(k,2170) - lu(k,1331) * lu(k,2151) + lu(k,1337) = 1._r8 / lu(k,1337) + lu(k,1338) = lu(k,1338) * lu(k,1337) + lu(k,1339) = lu(k,1339) * lu(k,1337) + lu(k,1340) = lu(k,1340) * lu(k,1337) + lu(k,1341) = lu(k,1341) * lu(k,1337) + lu(k,1342) = lu(k,1342) * lu(k,1337) + lu(k,1343) = lu(k,1343) * lu(k,1337) + lu(k,1344) = lu(k,1344) * lu(k,1337) + lu(k,1345) = lu(k,1345) * lu(k,1337) + lu(k,1346) = lu(k,1346) * lu(k,1337) + lu(k,1347) = lu(k,1347) * lu(k,1337) + lu(k,1348) = lu(k,1348) * lu(k,1337) + lu(k,1349) = lu(k,1349) * lu(k,1337) + lu(k,1539) = lu(k,1539) - lu(k,1338) * lu(k,1538) + lu(k,1543) = lu(k,1543) - lu(k,1339) * lu(k,1538) + lu(k,1544) = lu(k,1544) - lu(k,1340) * lu(k,1538) + lu(k,1545) = lu(k,1545) - lu(k,1341) * lu(k,1538) + lu(k,1547) = lu(k,1547) - lu(k,1342) * lu(k,1538) + lu(k,1549) = lu(k,1549) - lu(k,1343) * lu(k,1538) + lu(k,1550) = lu(k,1550) - lu(k,1344) * lu(k,1538) + lu(k,1551) = lu(k,1551) - lu(k,1345) * lu(k,1538) + lu(k,1552) = lu(k,1552) - lu(k,1346) * lu(k,1538) + lu(k,1553) = - lu(k,1347) * lu(k,1538) + lu(k,1555) = lu(k,1555) - lu(k,1348) * lu(k,1538) + lu(k,1556) = lu(k,1556) - lu(k,1349) * lu(k,1538) + lu(k,1565) = lu(k,1565) - lu(k,1338) * lu(k,1564) + lu(k,1569) = lu(k,1569) - lu(k,1339) * lu(k,1564) + lu(k,1570) = lu(k,1570) - lu(k,1340) * lu(k,1564) + lu(k,1571) = lu(k,1571) - lu(k,1341) * lu(k,1564) + lu(k,1573) = lu(k,1573) - lu(k,1342) * lu(k,1564) + lu(k,1575) = lu(k,1575) - lu(k,1343) * lu(k,1564) + lu(k,1576) = lu(k,1576) - lu(k,1344) * lu(k,1564) + lu(k,1577) = lu(k,1577) - lu(k,1345) * lu(k,1564) + lu(k,1578) = - lu(k,1346) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,1347) * lu(k,1564) + lu(k,1581) = lu(k,1581) - lu(k,1348) * lu(k,1564) + lu(k,1582) = lu(k,1582) - lu(k,1349) * lu(k,1564) + lu(k,1713) = lu(k,1713) - lu(k,1338) * lu(k,1712) + lu(k,1717) = lu(k,1717) - lu(k,1339) * lu(k,1712) + lu(k,1718) = lu(k,1718) - lu(k,1340) * lu(k,1712) + lu(k,1719) = lu(k,1719) - lu(k,1341) * lu(k,1712) + lu(k,1721) = lu(k,1721) - lu(k,1342) * lu(k,1712) + lu(k,1723) = lu(k,1723) - lu(k,1343) * lu(k,1712) + lu(k,1724) = lu(k,1724) - lu(k,1344) * lu(k,1712) + lu(k,1725) = lu(k,1725) - lu(k,1345) * lu(k,1712) + lu(k,1726) = lu(k,1726) - lu(k,1346) * lu(k,1712) + lu(k,1727) = lu(k,1727) - lu(k,1347) * lu(k,1712) + lu(k,1729) = lu(k,1729) - lu(k,1348) * lu(k,1712) + lu(k,1730) = lu(k,1730) - lu(k,1349) * lu(k,1712) + lu(k,1816) = lu(k,1816) - lu(k,1338) * lu(k,1815) + lu(k,1820) = lu(k,1820) - lu(k,1339) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1340) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1341) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1342) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1343) * lu(k,1815) + lu(k,1827) = lu(k,1827) - lu(k,1344) * lu(k,1815) + lu(k,1828) = lu(k,1828) - lu(k,1345) * lu(k,1815) + lu(k,1829) = lu(k,1829) - lu(k,1346) * lu(k,1815) + lu(k,1830) = lu(k,1830) - lu(k,1347) * lu(k,1815) + lu(k,1832) = lu(k,1832) - lu(k,1348) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1349) * lu(k,1815) + lu(k,1840) = lu(k,1840) - lu(k,1338) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,1339) * lu(k,1839) + lu(k,1845) = lu(k,1845) - lu(k,1340) * lu(k,1839) + lu(k,1846) = lu(k,1846) - lu(k,1341) * lu(k,1839) + lu(k,1848) = lu(k,1848) - lu(k,1342) * lu(k,1839) + lu(k,1850) = lu(k,1850) - lu(k,1343) * lu(k,1839) + lu(k,1851) = lu(k,1851) - lu(k,1344) * lu(k,1839) + lu(k,1852) = lu(k,1852) - lu(k,1345) * lu(k,1839) + lu(k,1853) = lu(k,1853) - lu(k,1346) * lu(k,1839) + lu(k,1854) = lu(k,1854) - lu(k,1347) * lu(k,1839) + lu(k,1856) = - lu(k,1348) * lu(k,1839) + lu(k,1857) = lu(k,1857) - lu(k,1349) * lu(k,1839) + lu(k,1917) = - lu(k,1338) * lu(k,1916) + lu(k,1921) = lu(k,1921) - lu(k,1339) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,1340) * lu(k,1916) + lu(k,1923) = lu(k,1923) - lu(k,1341) * lu(k,1916) + lu(k,1925) = lu(k,1925) - lu(k,1342) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,1343) * lu(k,1916) + lu(k,1928) = lu(k,1928) - lu(k,1344) * lu(k,1916) + lu(k,1929) = lu(k,1929) - lu(k,1345) * lu(k,1916) + lu(k,1930) = - lu(k,1346) * lu(k,1916) + lu(k,1931) = - lu(k,1347) * lu(k,1916) + lu(k,1933) = - lu(k,1348) * lu(k,1916) + lu(k,1934) = lu(k,1934) - lu(k,1349) * lu(k,1916) + lu(k,1939) = - lu(k,1338) * lu(k,1938) + lu(k,1943) = lu(k,1943) - lu(k,1339) * lu(k,1938) + lu(k,1944) = lu(k,1944) - lu(k,1340) * lu(k,1938) + lu(k,1945) = lu(k,1945) - lu(k,1341) * lu(k,1938) + lu(k,1947) = lu(k,1947) - lu(k,1342) * lu(k,1938) + lu(k,1949) = lu(k,1949) - lu(k,1343) * lu(k,1938) + lu(k,1950) = lu(k,1950) - lu(k,1344) * lu(k,1938) + lu(k,1951) = lu(k,1951) - lu(k,1345) * lu(k,1938) + lu(k,1952) = lu(k,1952) - lu(k,1346) * lu(k,1938) + lu(k,1953) = - lu(k,1347) * lu(k,1938) + lu(k,1955) = - lu(k,1348) * lu(k,1938) + lu(k,1956) = lu(k,1956) - lu(k,1349) * lu(k,1938) + lu(k,1981) = lu(k,1981) - lu(k,1338) * lu(k,1980) + lu(k,1985) = lu(k,1985) - lu(k,1339) * lu(k,1980) + lu(k,1986) = lu(k,1986) - lu(k,1340) * lu(k,1980) + lu(k,1987) = lu(k,1987) - lu(k,1341) * lu(k,1980) + lu(k,1989) = lu(k,1989) - lu(k,1342) * lu(k,1980) + lu(k,1991) = lu(k,1991) - lu(k,1343) * lu(k,1980) + lu(k,1992) = lu(k,1992) - lu(k,1344) * lu(k,1980) + lu(k,1993) = lu(k,1993) - lu(k,1345) * lu(k,1980) + lu(k,1994) = lu(k,1994) - lu(k,1346) * lu(k,1980) + lu(k,1995) = lu(k,1995) - lu(k,1347) * lu(k,1980) + lu(k,1997) = lu(k,1997) - lu(k,1348) * lu(k,1980) + lu(k,1998) = lu(k,1998) - lu(k,1349) * lu(k,1980) + lu(k,2006) = lu(k,2006) - lu(k,1338) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1339) * lu(k,2005) + lu(k,2010) = - lu(k,1340) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1341) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1342) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,1343) * lu(k,2005) + lu(k,2016) = lu(k,2016) - lu(k,1344) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1345) * lu(k,2005) + lu(k,2018) = lu(k,2018) - lu(k,1346) * lu(k,2005) + lu(k,2019) = lu(k,2019) - lu(k,1347) * lu(k,2005) + lu(k,2021) = lu(k,2021) - lu(k,1348) * lu(k,2005) + lu(k,2022) = lu(k,2022) - lu(k,1349) * lu(k,2005) + lu(k,2100) = lu(k,2100) - lu(k,1338) * lu(k,2099) + lu(k,2104) = lu(k,2104) - lu(k,1339) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1340) * lu(k,2099) + lu(k,2106) = lu(k,2106) - lu(k,1341) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1342) * lu(k,2099) + lu(k,2110) = lu(k,2110) - lu(k,1343) * lu(k,2099) + lu(k,2111) = lu(k,2111) - lu(k,1344) * lu(k,2099) + lu(k,2112) = lu(k,2112) - lu(k,1345) * lu(k,2099) + lu(k,2113) = lu(k,2113) - lu(k,1346) * lu(k,2099) + lu(k,2114) = lu(k,2114) - lu(k,1347) * lu(k,2099) + lu(k,2116) = lu(k,2116) - lu(k,1348) * lu(k,2099) + lu(k,2117) = lu(k,2117) - lu(k,1349) * lu(k,2099) + lu(k,2127) = lu(k,2127) - lu(k,1338) * lu(k,2126) + lu(k,2131) = lu(k,2131) - lu(k,1339) * lu(k,2126) + lu(k,2132) = - lu(k,1340) * lu(k,2126) + lu(k,2133) = lu(k,2133) - lu(k,1341) * lu(k,2126) + lu(k,2135) = lu(k,2135) - lu(k,1342) * lu(k,2126) + lu(k,2137) = lu(k,2137) - lu(k,1343) * lu(k,2126) + lu(k,2138) = lu(k,2138) - lu(k,1344) * lu(k,2126) + lu(k,2139) = lu(k,2139) - lu(k,1345) * lu(k,2126) + lu(k,2140) = lu(k,2140) - lu(k,1346) * lu(k,2126) + lu(k,2141) = lu(k,2141) - lu(k,1347) * lu(k,2126) + lu(k,2143) = lu(k,2143) - lu(k,1348) * lu(k,2126) + lu(k,2144) = lu(k,2144) - lu(k,1349) * lu(k,2126) + lu(k,2153) = lu(k,2153) - lu(k,1338) * lu(k,2152) + lu(k,2157) = lu(k,2157) - lu(k,1339) * lu(k,2152) + lu(k,2158) = lu(k,2158) - lu(k,1340) * lu(k,2152) + lu(k,2159) = lu(k,2159) - lu(k,1341) * lu(k,2152) + lu(k,2161) = lu(k,2161) - lu(k,1342) * lu(k,2152) + lu(k,2163) = lu(k,2163) - lu(k,1343) * lu(k,2152) + lu(k,2164) = lu(k,2164) - lu(k,1344) * lu(k,2152) + lu(k,2165) = lu(k,2165) - lu(k,1345) * lu(k,2152) + lu(k,2166) = lu(k,2166) - lu(k,1346) * lu(k,2152) + lu(k,2167) = lu(k,2167) - lu(k,1347) * lu(k,2152) + lu(k,2169) = lu(k,2169) - lu(k,1348) * lu(k,2152) + lu(k,2170) = lu(k,2170) - lu(k,1349) * lu(k,2152) + end do + end subroutine lu_fac26 + subroutine lu_fac27( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1352) = 1._r8 / lu(k,1352) + lu(k,1353) = lu(k,1353) * lu(k,1352) + lu(k,1354) = lu(k,1354) * lu(k,1352) + lu(k,1355) = lu(k,1355) * lu(k,1352) + lu(k,1356) = lu(k,1356) * lu(k,1352) + lu(k,1357) = lu(k,1357) * lu(k,1352) + lu(k,1358) = lu(k,1358) * lu(k,1352) + lu(k,1359) = lu(k,1359) * lu(k,1352) + lu(k,1360) = lu(k,1360) * lu(k,1352) + lu(k,1361) = lu(k,1361) * lu(k,1352) + lu(k,1362) = lu(k,1362) * lu(k,1352) + lu(k,1427) = lu(k,1427) - lu(k,1353) * lu(k,1426) + lu(k,1430) = lu(k,1430) - lu(k,1354) * lu(k,1426) + lu(k,1431) = lu(k,1431) - lu(k,1355) * lu(k,1426) + lu(k,1432) = lu(k,1432) - lu(k,1356) * lu(k,1426) + lu(k,1433) = lu(k,1433) - lu(k,1357) * lu(k,1426) + lu(k,1434) = lu(k,1434) - lu(k,1358) * lu(k,1426) + lu(k,1435) = lu(k,1435) - lu(k,1359) * lu(k,1426) + lu(k,1437) = lu(k,1437) - lu(k,1360) * lu(k,1426) + lu(k,1438) = lu(k,1438) - lu(k,1361) * lu(k,1426) + lu(k,1440) = lu(k,1440) - lu(k,1362) * lu(k,1426) + lu(k,1506) = lu(k,1506) - lu(k,1353) * lu(k,1504) + lu(k,1509) = lu(k,1509) - lu(k,1354) * lu(k,1504) + lu(k,1510) = lu(k,1510) - lu(k,1355) * lu(k,1504) + lu(k,1511) = lu(k,1511) - lu(k,1356) * lu(k,1504) + lu(k,1512) = lu(k,1512) - lu(k,1357) * lu(k,1504) + lu(k,1513) = lu(k,1513) - lu(k,1358) * lu(k,1504) + lu(k,1515) = lu(k,1515) - lu(k,1359) * lu(k,1504) + lu(k,1518) = lu(k,1518) - lu(k,1360) * lu(k,1504) + lu(k,1519) = lu(k,1519) - lu(k,1361) * lu(k,1504) + lu(k,1521) = lu(k,1521) - lu(k,1362) * lu(k,1504) + lu(k,1541) = lu(k,1541) - lu(k,1353) * lu(k,1539) + lu(k,1544) = lu(k,1544) - lu(k,1354) * lu(k,1539) + lu(k,1545) = lu(k,1545) - lu(k,1355) * lu(k,1539) + lu(k,1546) = lu(k,1546) - lu(k,1356) * lu(k,1539) + lu(k,1547) = lu(k,1547) - lu(k,1357) * lu(k,1539) + lu(k,1548) = lu(k,1548) - lu(k,1358) * lu(k,1539) + lu(k,1550) = lu(k,1550) - lu(k,1359) * lu(k,1539) + lu(k,1553) = lu(k,1553) - lu(k,1360) * lu(k,1539) + lu(k,1554) = lu(k,1554) - lu(k,1361) * lu(k,1539) + lu(k,1556) = lu(k,1556) - lu(k,1362) * lu(k,1539) + lu(k,1567) = lu(k,1567) - lu(k,1353) * lu(k,1565) + lu(k,1570) = lu(k,1570) - lu(k,1354) * lu(k,1565) + lu(k,1571) = lu(k,1571) - lu(k,1355) * lu(k,1565) + lu(k,1572) = lu(k,1572) - lu(k,1356) * lu(k,1565) + lu(k,1573) = lu(k,1573) - lu(k,1357) * lu(k,1565) + lu(k,1574) = lu(k,1574) - lu(k,1358) * lu(k,1565) + lu(k,1576) = lu(k,1576) - lu(k,1359) * lu(k,1565) + lu(k,1579) = lu(k,1579) - lu(k,1360) * lu(k,1565) + lu(k,1580) = lu(k,1580) - lu(k,1361) * lu(k,1565) + lu(k,1582) = lu(k,1582) - lu(k,1362) * lu(k,1565) + lu(k,1715) = lu(k,1715) - lu(k,1353) * lu(k,1713) + lu(k,1718) = lu(k,1718) - lu(k,1354) * lu(k,1713) + lu(k,1719) = lu(k,1719) - lu(k,1355) * lu(k,1713) + lu(k,1720) = lu(k,1720) - lu(k,1356) * lu(k,1713) + lu(k,1721) = lu(k,1721) - lu(k,1357) * lu(k,1713) + lu(k,1722) = lu(k,1722) - lu(k,1358) * lu(k,1713) + lu(k,1724) = lu(k,1724) - lu(k,1359) * lu(k,1713) + lu(k,1727) = lu(k,1727) - lu(k,1360) * lu(k,1713) + lu(k,1728) = lu(k,1728) - lu(k,1361) * lu(k,1713) + lu(k,1730) = lu(k,1730) - lu(k,1362) * lu(k,1713) + lu(k,1777) = lu(k,1777) - lu(k,1353) * lu(k,1775) + lu(k,1780) = lu(k,1780) - lu(k,1354) * lu(k,1775) + lu(k,1781) = lu(k,1781) - lu(k,1355) * lu(k,1775) + lu(k,1782) = lu(k,1782) - lu(k,1356) * lu(k,1775) + lu(k,1783) = lu(k,1783) - lu(k,1357) * lu(k,1775) + lu(k,1784) = lu(k,1784) - lu(k,1358) * lu(k,1775) + lu(k,1786) = lu(k,1786) - lu(k,1359) * lu(k,1775) + lu(k,1789) = lu(k,1789) - lu(k,1360) * lu(k,1775) + lu(k,1790) = lu(k,1790) - lu(k,1361) * lu(k,1775) + lu(k,1792) = lu(k,1792) - lu(k,1362) * lu(k,1775) + lu(k,1818) = lu(k,1818) - lu(k,1353) * lu(k,1816) + lu(k,1821) = lu(k,1821) - lu(k,1354) * lu(k,1816) + lu(k,1822) = lu(k,1822) - lu(k,1355) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1356) * lu(k,1816) + lu(k,1824) = lu(k,1824) - lu(k,1357) * lu(k,1816) + lu(k,1825) = lu(k,1825) - lu(k,1358) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1359) * lu(k,1816) + lu(k,1830) = lu(k,1830) - lu(k,1360) * lu(k,1816) + lu(k,1831) = lu(k,1831) - lu(k,1361) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,1362) * lu(k,1816) + lu(k,1842) = - lu(k,1353) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,1354) * lu(k,1840) + lu(k,1846) = lu(k,1846) - lu(k,1355) * lu(k,1840) + lu(k,1847) = - lu(k,1356) * lu(k,1840) + lu(k,1848) = lu(k,1848) - lu(k,1357) * lu(k,1840) + lu(k,1849) = lu(k,1849) - lu(k,1358) * lu(k,1840) + lu(k,1851) = lu(k,1851) - lu(k,1359) * lu(k,1840) + lu(k,1854) = lu(k,1854) - lu(k,1360) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,1361) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,1362) * lu(k,1840) + lu(k,1899) = lu(k,1899) - lu(k,1353) * lu(k,1897) + lu(k,1902) = - lu(k,1354) * lu(k,1897) + lu(k,1903) = lu(k,1903) - lu(k,1355) * lu(k,1897) + lu(k,1904) = lu(k,1904) - lu(k,1356) * lu(k,1897) + lu(k,1905) = lu(k,1905) - lu(k,1357) * lu(k,1897) + lu(k,1906) = lu(k,1906) - lu(k,1358) * lu(k,1897) + lu(k,1908) = lu(k,1908) - lu(k,1359) * lu(k,1897) + lu(k,1911) = lu(k,1911) - lu(k,1360) * lu(k,1897) + lu(k,1912) = lu(k,1912) - lu(k,1361) * lu(k,1897) + lu(k,1914) = lu(k,1914) - lu(k,1362) * lu(k,1897) + lu(k,1919) = lu(k,1919) - lu(k,1353) * lu(k,1917) + lu(k,1922) = lu(k,1922) - lu(k,1354) * lu(k,1917) + lu(k,1923) = lu(k,1923) - lu(k,1355) * lu(k,1917) + lu(k,1924) = lu(k,1924) - lu(k,1356) * lu(k,1917) + lu(k,1925) = lu(k,1925) - lu(k,1357) * lu(k,1917) + lu(k,1926) = - lu(k,1358) * lu(k,1917) + lu(k,1928) = lu(k,1928) - lu(k,1359) * lu(k,1917) + lu(k,1931) = lu(k,1931) - lu(k,1360) * lu(k,1917) + lu(k,1932) = lu(k,1932) - lu(k,1361) * lu(k,1917) + lu(k,1934) = lu(k,1934) - lu(k,1362) * lu(k,1917) + lu(k,1941) = - lu(k,1353) * lu(k,1939) + lu(k,1944) = lu(k,1944) - lu(k,1354) * lu(k,1939) + lu(k,1945) = lu(k,1945) - lu(k,1355) * lu(k,1939) + lu(k,1946) = - lu(k,1356) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1357) * lu(k,1939) + lu(k,1948) = - lu(k,1358) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1359) * lu(k,1939) + lu(k,1953) = lu(k,1953) - lu(k,1360) * lu(k,1939) + lu(k,1954) = - lu(k,1361) * lu(k,1939) + lu(k,1956) = lu(k,1956) - lu(k,1362) * lu(k,1939) + lu(k,1983) = lu(k,1983) - lu(k,1353) * lu(k,1981) + lu(k,1986) = lu(k,1986) - lu(k,1354) * lu(k,1981) + lu(k,1987) = lu(k,1987) - lu(k,1355) * lu(k,1981) + lu(k,1988) = lu(k,1988) - lu(k,1356) * lu(k,1981) + lu(k,1989) = lu(k,1989) - lu(k,1357) * lu(k,1981) + lu(k,1990) = lu(k,1990) - lu(k,1358) * lu(k,1981) + lu(k,1992) = lu(k,1992) - lu(k,1359) * lu(k,1981) + lu(k,1995) = lu(k,1995) - lu(k,1360) * lu(k,1981) + lu(k,1996) = lu(k,1996) - lu(k,1361) * lu(k,1981) + lu(k,1998) = lu(k,1998) - lu(k,1362) * lu(k,1981) + lu(k,2007) = lu(k,2007) - lu(k,1353) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1354) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1355) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1356) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1357) * lu(k,2006) + lu(k,2014) = - lu(k,1358) * lu(k,2006) + lu(k,2016) = lu(k,2016) - lu(k,1359) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1360) * lu(k,2006) + lu(k,2020) = lu(k,2020) - lu(k,1361) * lu(k,2006) + lu(k,2022) = lu(k,2022) - lu(k,1362) * lu(k,2006) + lu(k,2102) = lu(k,2102) - lu(k,1353) * lu(k,2100) + lu(k,2105) = lu(k,2105) - lu(k,1354) * lu(k,2100) + lu(k,2106) = lu(k,2106) - lu(k,1355) * lu(k,2100) + lu(k,2107) = lu(k,2107) - lu(k,1356) * lu(k,2100) + lu(k,2108) = lu(k,2108) - lu(k,1357) * lu(k,2100) + lu(k,2109) = lu(k,2109) - lu(k,1358) * lu(k,2100) + lu(k,2111) = lu(k,2111) - lu(k,1359) * lu(k,2100) + lu(k,2114) = lu(k,2114) - lu(k,1360) * lu(k,2100) + lu(k,2115) = lu(k,2115) - lu(k,1361) * lu(k,2100) + lu(k,2117) = lu(k,2117) - lu(k,1362) * lu(k,2100) + lu(k,2129) = lu(k,2129) - lu(k,1353) * lu(k,2127) + lu(k,2132) = lu(k,2132) - lu(k,1354) * lu(k,2127) + lu(k,2133) = lu(k,2133) - lu(k,1355) * lu(k,2127) + lu(k,2134) = lu(k,2134) - lu(k,1356) * lu(k,2127) + lu(k,2135) = lu(k,2135) - lu(k,1357) * lu(k,2127) + lu(k,2136) = lu(k,2136) - lu(k,1358) * lu(k,2127) + lu(k,2138) = lu(k,2138) - lu(k,1359) * lu(k,2127) + lu(k,2141) = lu(k,2141) - lu(k,1360) * lu(k,2127) + lu(k,2142) = lu(k,2142) - lu(k,1361) * lu(k,2127) + lu(k,2144) = lu(k,2144) - lu(k,1362) * lu(k,2127) + lu(k,2155) = lu(k,2155) - lu(k,1353) * lu(k,2153) + lu(k,2158) = lu(k,2158) - lu(k,1354) * lu(k,2153) + lu(k,2159) = lu(k,2159) - lu(k,1355) * lu(k,2153) + lu(k,2160) = lu(k,2160) - lu(k,1356) * lu(k,2153) + lu(k,2161) = lu(k,2161) - lu(k,1357) * lu(k,2153) + lu(k,2162) = - lu(k,1358) * lu(k,2153) + lu(k,2164) = lu(k,2164) - lu(k,1359) * lu(k,2153) + lu(k,2167) = lu(k,2167) - lu(k,1360) * lu(k,2153) + lu(k,2168) = lu(k,2168) - lu(k,1361) * lu(k,2153) + lu(k,2170) = lu(k,2170) - lu(k,1362) * lu(k,2153) + lu(k,1396) = 1._r8 / lu(k,1396) + lu(k,1397) = lu(k,1397) * lu(k,1396) + lu(k,1398) = lu(k,1398) * lu(k,1396) + lu(k,1399) = lu(k,1399) * lu(k,1396) + lu(k,1400) = lu(k,1400) * lu(k,1396) + lu(k,1401) = lu(k,1401) * lu(k,1396) + lu(k,1402) = lu(k,1402) * lu(k,1396) + lu(k,1403) = lu(k,1403) * lu(k,1396) + lu(k,1404) = lu(k,1404) * lu(k,1396) + lu(k,1405) = lu(k,1405) * lu(k,1396) + lu(k,1406) = lu(k,1406) * lu(k,1396) + lu(k,1407) = lu(k,1407) * lu(k,1396) + lu(k,1408) = lu(k,1408) * lu(k,1396) + lu(k,1409) = lu(k,1409) * lu(k,1396) + lu(k,1506) = lu(k,1506) - lu(k,1397) * lu(k,1505) + lu(k,1507) = lu(k,1507) - lu(k,1398) * lu(k,1505) + lu(k,1508) = lu(k,1508) - lu(k,1399) * lu(k,1505) + lu(k,1510) = lu(k,1510) - lu(k,1400) * lu(k,1505) + lu(k,1511) = lu(k,1511) - lu(k,1401) * lu(k,1505) + lu(k,1513) = lu(k,1513) - lu(k,1402) * lu(k,1505) + lu(k,1514) = lu(k,1514) - lu(k,1403) * lu(k,1505) + lu(k,1515) = lu(k,1515) - lu(k,1404) * lu(k,1505) + lu(k,1516) = lu(k,1516) - lu(k,1405) * lu(k,1505) + lu(k,1517) = lu(k,1517) - lu(k,1406) * lu(k,1505) + lu(k,1519) = lu(k,1519) - lu(k,1407) * lu(k,1505) + lu(k,1520) = lu(k,1520) - lu(k,1408) * lu(k,1505) + lu(k,1521) = lu(k,1521) - lu(k,1409) * lu(k,1505) + lu(k,1541) = lu(k,1541) - lu(k,1397) * lu(k,1540) + lu(k,1542) = lu(k,1542) - lu(k,1398) * lu(k,1540) + lu(k,1543) = lu(k,1543) - lu(k,1399) * lu(k,1540) + lu(k,1545) = lu(k,1545) - lu(k,1400) * lu(k,1540) + lu(k,1546) = lu(k,1546) - lu(k,1401) * lu(k,1540) + lu(k,1548) = lu(k,1548) - lu(k,1402) * lu(k,1540) + lu(k,1549) = lu(k,1549) - lu(k,1403) * lu(k,1540) + lu(k,1550) = lu(k,1550) - lu(k,1404) * lu(k,1540) + lu(k,1551) = lu(k,1551) - lu(k,1405) * lu(k,1540) + lu(k,1552) = lu(k,1552) - lu(k,1406) * lu(k,1540) + lu(k,1554) = lu(k,1554) - lu(k,1407) * lu(k,1540) + lu(k,1555) = lu(k,1555) - lu(k,1408) * lu(k,1540) + lu(k,1556) = lu(k,1556) - lu(k,1409) * lu(k,1540) + lu(k,1567) = lu(k,1567) - lu(k,1397) * lu(k,1566) + lu(k,1568) = lu(k,1568) - lu(k,1398) * lu(k,1566) + lu(k,1569) = lu(k,1569) - lu(k,1399) * lu(k,1566) + lu(k,1571) = lu(k,1571) - lu(k,1400) * lu(k,1566) + lu(k,1572) = lu(k,1572) - lu(k,1401) * lu(k,1566) + lu(k,1574) = lu(k,1574) - lu(k,1402) * lu(k,1566) + lu(k,1575) = lu(k,1575) - lu(k,1403) * lu(k,1566) + lu(k,1576) = lu(k,1576) - lu(k,1404) * lu(k,1566) + lu(k,1577) = lu(k,1577) - lu(k,1405) * lu(k,1566) + lu(k,1578) = lu(k,1578) - lu(k,1406) * lu(k,1566) + lu(k,1580) = lu(k,1580) - lu(k,1407) * lu(k,1566) + lu(k,1581) = lu(k,1581) - lu(k,1408) * lu(k,1566) + lu(k,1582) = lu(k,1582) - lu(k,1409) * lu(k,1566) + lu(k,1715) = lu(k,1715) - lu(k,1397) * lu(k,1714) + lu(k,1716) = lu(k,1716) - lu(k,1398) * lu(k,1714) + lu(k,1717) = lu(k,1717) - lu(k,1399) * lu(k,1714) + lu(k,1719) = lu(k,1719) - lu(k,1400) * lu(k,1714) + lu(k,1720) = lu(k,1720) - lu(k,1401) * lu(k,1714) + lu(k,1722) = lu(k,1722) - lu(k,1402) * lu(k,1714) + lu(k,1723) = lu(k,1723) - lu(k,1403) * lu(k,1714) + lu(k,1724) = lu(k,1724) - lu(k,1404) * lu(k,1714) + lu(k,1725) = lu(k,1725) - lu(k,1405) * lu(k,1714) + lu(k,1726) = lu(k,1726) - lu(k,1406) * lu(k,1714) + lu(k,1728) = lu(k,1728) - lu(k,1407) * lu(k,1714) + lu(k,1729) = lu(k,1729) - lu(k,1408) * lu(k,1714) + lu(k,1730) = lu(k,1730) - lu(k,1409) * lu(k,1714) + lu(k,1777) = lu(k,1777) - lu(k,1397) * lu(k,1776) + lu(k,1778) = lu(k,1778) - lu(k,1398) * lu(k,1776) + lu(k,1779) = lu(k,1779) - lu(k,1399) * lu(k,1776) + lu(k,1781) = lu(k,1781) - lu(k,1400) * lu(k,1776) + lu(k,1782) = lu(k,1782) - lu(k,1401) * lu(k,1776) + lu(k,1784) = lu(k,1784) - lu(k,1402) * lu(k,1776) + lu(k,1785) = lu(k,1785) - lu(k,1403) * lu(k,1776) + lu(k,1786) = lu(k,1786) - lu(k,1404) * lu(k,1776) + lu(k,1787) = lu(k,1787) - lu(k,1405) * lu(k,1776) + lu(k,1788) = lu(k,1788) - lu(k,1406) * lu(k,1776) + lu(k,1790) = lu(k,1790) - lu(k,1407) * lu(k,1776) + lu(k,1791) = lu(k,1791) - lu(k,1408) * lu(k,1776) + lu(k,1792) = lu(k,1792) - lu(k,1409) * lu(k,1776) + lu(k,1818) = lu(k,1818) - lu(k,1397) * lu(k,1817) + lu(k,1819) = lu(k,1819) - lu(k,1398) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1399) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1400) * lu(k,1817) + lu(k,1823) = lu(k,1823) - lu(k,1401) * lu(k,1817) + lu(k,1825) = lu(k,1825) - lu(k,1402) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1403) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1404) * lu(k,1817) + lu(k,1828) = lu(k,1828) - lu(k,1405) * lu(k,1817) + lu(k,1829) = lu(k,1829) - lu(k,1406) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,1407) * lu(k,1817) + lu(k,1832) = lu(k,1832) - lu(k,1408) * lu(k,1817) + lu(k,1833) = lu(k,1833) - lu(k,1409) * lu(k,1817) + lu(k,1842) = lu(k,1842) - lu(k,1397) * lu(k,1841) + lu(k,1843) = lu(k,1843) - lu(k,1398) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,1399) * lu(k,1841) + lu(k,1846) = lu(k,1846) - lu(k,1400) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,1401) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,1402) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,1403) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,1404) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,1405) * lu(k,1841) + lu(k,1853) = lu(k,1853) - lu(k,1406) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,1407) * lu(k,1841) + lu(k,1856) = lu(k,1856) - lu(k,1408) * lu(k,1841) + lu(k,1857) = lu(k,1857) - lu(k,1409) * lu(k,1841) + lu(k,1899) = lu(k,1899) - lu(k,1397) * lu(k,1898) + lu(k,1900) = lu(k,1900) - lu(k,1398) * lu(k,1898) + lu(k,1901) = lu(k,1901) - lu(k,1399) * lu(k,1898) + lu(k,1903) = lu(k,1903) - lu(k,1400) * lu(k,1898) + lu(k,1904) = lu(k,1904) - lu(k,1401) * lu(k,1898) + lu(k,1906) = lu(k,1906) - lu(k,1402) * lu(k,1898) + lu(k,1907) = lu(k,1907) - lu(k,1403) * lu(k,1898) + lu(k,1908) = lu(k,1908) - lu(k,1404) * lu(k,1898) + lu(k,1909) = lu(k,1909) - lu(k,1405) * lu(k,1898) + lu(k,1910) = lu(k,1910) - lu(k,1406) * lu(k,1898) + lu(k,1912) = lu(k,1912) - lu(k,1407) * lu(k,1898) + lu(k,1913) = lu(k,1913) - lu(k,1408) * lu(k,1898) + lu(k,1914) = lu(k,1914) - lu(k,1409) * lu(k,1898) + lu(k,1919) = lu(k,1919) - lu(k,1397) * lu(k,1918) + lu(k,1920) = - lu(k,1398) * lu(k,1918) + lu(k,1921) = lu(k,1921) - lu(k,1399) * lu(k,1918) + lu(k,1923) = lu(k,1923) - lu(k,1400) * lu(k,1918) + lu(k,1924) = lu(k,1924) - lu(k,1401) * lu(k,1918) + lu(k,1926) = lu(k,1926) - lu(k,1402) * lu(k,1918) + lu(k,1927) = lu(k,1927) - lu(k,1403) * lu(k,1918) + lu(k,1928) = lu(k,1928) - lu(k,1404) * lu(k,1918) + lu(k,1929) = lu(k,1929) - lu(k,1405) * lu(k,1918) + lu(k,1930) = lu(k,1930) - lu(k,1406) * lu(k,1918) + lu(k,1932) = lu(k,1932) - lu(k,1407) * lu(k,1918) + lu(k,1933) = lu(k,1933) - lu(k,1408) * lu(k,1918) + lu(k,1934) = lu(k,1934) - lu(k,1409) * lu(k,1918) + lu(k,1941) = lu(k,1941) - lu(k,1397) * lu(k,1940) + lu(k,1942) = - lu(k,1398) * lu(k,1940) + lu(k,1943) = lu(k,1943) - lu(k,1399) * lu(k,1940) + lu(k,1945) = lu(k,1945) - lu(k,1400) * lu(k,1940) + lu(k,1946) = lu(k,1946) - lu(k,1401) * lu(k,1940) + lu(k,1948) = lu(k,1948) - lu(k,1402) * lu(k,1940) + lu(k,1949) = lu(k,1949) - lu(k,1403) * lu(k,1940) + lu(k,1950) = lu(k,1950) - lu(k,1404) * lu(k,1940) + lu(k,1951) = lu(k,1951) - lu(k,1405) * lu(k,1940) + lu(k,1952) = lu(k,1952) - lu(k,1406) * lu(k,1940) + lu(k,1954) = lu(k,1954) - lu(k,1407) * lu(k,1940) + lu(k,1955) = lu(k,1955) - lu(k,1408) * lu(k,1940) + lu(k,1956) = lu(k,1956) - lu(k,1409) * lu(k,1940) + lu(k,1983) = lu(k,1983) - lu(k,1397) * lu(k,1982) + lu(k,1984) = lu(k,1984) - lu(k,1398) * lu(k,1982) + lu(k,1985) = lu(k,1985) - lu(k,1399) * lu(k,1982) + lu(k,1987) = lu(k,1987) - lu(k,1400) * lu(k,1982) + lu(k,1988) = lu(k,1988) - lu(k,1401) * lu(k,1982) + lu(k,1990) = lu(k,1990) - lu(k,1402) * lu(k,1982) + lu(k,1991) = lu(k,1991) - lu(k,1403) * lu(k,1982) + lu(k,1992) = lu(k,1992) - lu(k,1404) * lu(k,1982) + lu(k,1993) = lu(k,1993) - lu(k,1405) * lu(k,1982) + lu(k,1994) = lu(k,1994) - lu(k,1406) * lu(k,1982) + lu(k,1996) = lu(k,1996) - lu(k,1407) * lu(k,1982) + lu(k,1997) = lu(k,1997) - lu(k,1408) * lu(k,1982) + lu(k,1998) = lu(k,1998) - lu(k,1409) * lu(k,1982) + lu(k,2102) = lu(k,2102) - lu(k,1397) * lu(k,2101) + lu(k,2103) = lu(k,2103) - lu(k,1398) * lu(k,2101) + lu(k,2104) = lu(k,2104) - lu(k,1399) * lu(k,2101) + lu(k,2106) = lu(k,2106) - lu(k,1400) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1401) * lu(k,2101) + lu(k,2109) = lu(k,2109) - lu(k,1402) * lu(k,2101) + lu(k,2110) = lu(k,2110) - lu(k,1403) * lu(k,2101) + lu(k,2111) = lu(k,2111) - lu(k,1404) * lu(k,2101) + lu(k,2112) = lu(k,2112) - lu(k,1405) * lu(k,2101) + lu(k,2113) = lu(k,2113) - lu(k,1406) * lu(k,2101) + lu(k,2115) = lu(k,2115) - lu(k,1407) * lu(k,2101) + lu(k,2116) = lu(k,2116) - lu(k,1408) * lu(k,2101) + lu(k,2117) = lu(k,2117) - lu(k,1409) * lu(k,2101) + lu(k,2129) = lu(k,2129) - lu(k,1397) * lu(k,2128) + lu(k,2130) = lu(k,2130) - lu(k,1398) * lu(k,2128) + lu(k,2131) = lu(k,2131) - lu(k,1399) * lu(k,2128) + lu(k,2133) = lu(k,2133) - lu(k,1400) * lu(k,2128) + lu(k,2134) = lu(k,2134) - lu(k,1401) * lu(k,2128) + lu(k,2136) = lu(k,2136) - lu(k,1402) * lu(k,2128) + lu(k,2137) = lu(k,2137) - lu(k,1403) * lu(k,2128) + lu(k,2138) = lu(k,2138) - lu(k,1404) * lu(k,2128) + lu(k,2139) = lu(k,2139) - lu(k,1405) * lu(k,2128) + lu(k,2140) = lu(k,2140) - lu(k,1406) * lu(k,2128) + lu(k,2142) = lu(k,2142) - lu(k,1407) * lu(k,2128) + lu(k,2143) = lu(k,2143) - lu(k,1408) * lu(k,2128) + lu(k,2144) = lu(k,2144) - lu(k,1409) * lu(k,2128) + lu(k,2155) = lu(k,2155) - lu(k,1397) * lu(k,2154) + lu(k,2156) = lu(k,2156) - lu(k,1398) * lu(k,2154) + lu(k,2157) = lu(k,2157) - lu(k,1399) * lu(k,2154) + lu(k,2159) = lu(k,2159) - lu(k,1400) * lu(k,2154) + lu(k,2160) = lu(k,2160) - lu(k,1401) * lu(k,2154) + lu(k,2162) = lu(k,2162) - lu(k,1402) * lu(k,2154) + lu(k,2163) = lu(k,2163) - lu(k,1403) * lu(k,2154) + lu(k,2164) = lu(k,2164) - lu(k,1404) * lu(k,2154) + lu(k,2165) = lu(k,2165) - lu(k,1405) * lu(k,2154) + lu(k,2166) = lu(k,2166) - lu(k,1406) * lu(k,2154) + lu(k,2168) = lu(k,2168) - lu(k,1407) * lu(k,2154) + lu(k,2169) = lu(k,2169) - lu(k,1408) * lu(k,2154) + lu(k,2170) = lu(k,2170) - lu(k,1409) * lu(k,2154) + lu(k,1427) = 1._r8 / lu(k,1427) + lu(k,1428) = lu(k,1428) * lu(k,1427) + lu(k,1429) = lu(k,1429) * lu(k,1427) + lu(k,1430) = lu(k,1430) * lu(k,1427) + lu(k,1431) = lu(k,1431) * lu(k,1427) + lu(k,1432) = lu(k,1432) * lu(k,1427) + lu(k,1433) = lu(k,1433) * lu(k,1427) + lu(k,1434) = lu(k,1434) * lu(k,1427) + lu(k,1435) = lu(k,1435) * lu(k,1427) + lu(k,1436) = lu(k,1436) * lu(k,1427) + lu(k,1437) = lu(k,1437) * lu(k,1427) + lu(k,1438) = lu(k,1438) * lu(k,1427) + lu(k,1439) = lu(k,1439) * lu(k,1427) + lu(k,1440) = lu(k,1440) * lu(k,1427) + lu(k,1507) = lu(k,1507) - lu(k,1428) * lu(k,1506) + lu(k,1508) = lu(k,1508) - lu(k,1429) * lu(k,1506) + lu(k,1509) = lu(k,1509) - lu(k,1430) * lu(k,1506) + lu(k,1510) = lu(k,1510) - lu(k,1431) * lu(k,1506) + lu(k,1511) = lu(k,1511) - lu(k,1432) * lu(k,1506) + lu(k,1512) = lu(k,1512) - lu(k,1433) * lu(k,1506) + lu(k,1513) = lu(k,1513) - lu(k,1434) * lu(k,1506) + lu(k,1515) = lu(k,1515) - lu(k,1435) * lu(k,1506) + lu(k,1517) = lu(k,1517) - lu(k,1436) * lu(k,1506) + lu(k,1518) = lu(k,1518) - lu(k,1437) * lu(k,1506) + lu(k,1519) = lu(k,1519) - lu(k,1438) * lu(k,1506) + lu(k,1520) = lu(k,1520) - lu(k,1439) * lu(k,1506) + lu(k,1521) = lu(k,1521) - lu(k,1440) * lu(k,1506) + lu(k,1542) = lu(k,1542) - lu(k,1428) * lu(k,1541) + lu(k,1543) = lu(k,1543) - lu(k,1429) * lu(k,1541) + lu(k,1544) = lu(k,1544) - lu(k,1430) * lu(k,1541) + lu(k,1545) = lu(k,1545) - lu(k,1431) * lu(k,1541) + lu(k,1546) = lu(k,1546) - lu(k,1432) * lu(k,1541) + lu(k,1547) = lu(k,1547) - lu(k,1433) * lu(k,1541) + lu(k,1548) = lu(k,1548) - lu(k,1434) * lu(k,1541) + lu(k,1550) = lu(k,1550) - lu(k,1435) * lu(k,1541) + lu(k,1552) = lu(k,1552) - lu(k,1436) * lu(k,1541) + lu(k,1553) = lu(k,1553) - lu(k,1437) * lu(k,1541) + lu(k,1554) = lu(k,1554) - lu(k,1438) * lu(k,1541) + lu(k,1555) = lu(k,1555) - lu(k,1439) * lu(k,1541) + lu(k,1556) = lu(k,1556) - lu(k,1440) * lu(k,1541) + lu(k,1568) = lu(k,1568) - lu(k,1428) * lu(k,1567) + lu(k,1569) = lu(k,1569) - lu(k,1429) * lu(k,1567) + lu(k,1570) = lu(k,1570) - lu(k,1430) * lu(k,1567) + lu(k,1571) = lu(k,1571) - lu(k,1431) * lu(k,1567) + lu(k,1572) = lu(k,1572) - lu(k,1432) * lu(k,1567) + lu(k,1573) = lu(k,1573) - lu(k,1433) * lu(k,1567) + lu(k,1574) = lu(k,1574) - lu(k,1434) * lu(k,1567) + lu(k,1576) = lu(k,1576) - lu(k,1435) * lu(k,1567) + lu(k,1578) = lu(k,1578) - lu(k,1436) * lu(k,1567) + lu(k,1579) = lu(k,1579) - lu(k,1437) * lu(k,1567) + lu(k,1580) = lu(k,1580) - lu(k,1438) * lu(k,1567) + lu(k,1581) = lu(k,1581) - lu(k,1439) * lu(k,1567) + lu(k,1582) = lu(k,1582) - lu(k,1440) * lu(k,1567) + lu(k,1716) = lu(k,1716) - lu(k,1428) * lu(k,1715) + lu(k,1717) = lu(k,1717) - lu(k,1429) * lu(k,1715) + lu(k,1718) = lu(k,1718) - lu(k,1430) * lu(k,1715) + lu(k,1719) = lu(k,1719) - lu(k,1431) * lu(k,1715) + lu(k,1720) = lu(k,1720) - lu(k,1432) * lu(k,1715) + lu(k,1721) = lu(k,1721) - lu(k,1433) * lu(k,1715) + lu(k,1722) = lu(k,1722) - lu(k,1434) * lu(k,1715) + lu(k,1724) = lu(k,1724) - lu(k,1435) * lu(k,1715) + lu(k,1726) = lu(k,1726) - lu(k,1436) * lu(k,1715) + lu(k,1727) = lu(k,1727) - lu(k,1437) * lu(k,1715) + lu(k,1728) = lu(k,1728) - lu(k,1438) * lu(k,1715) + lu(k,1729) = lu(k,1729) - lu(k,1439) * lu(k,1715) + lu(k,1730) = lu(k,1730) - lu(k,1440) * lu(k,1715) + lu(k,1778) = lu(k,1778) - lu(k,1428) * lu(k,1777) + lu(k,1779) = lu(k,1779) - lu(k,1429) * lu(k,1777) + lu(k,1780) = lu(k,1780) - lu(k,1430) * lu(k,1777) + lu(k,1781) = lu(k,1781) - lu(k,1431) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,1432) * lu(k,1777) + lu(k,1783) = lu(k,1783) - lu(k,1433) * lu(k,1777) + lu(k,1784) = lu(k,1784) - lu(k,1434) * lu(k,1777) + lu(k,1786) = lu(k,1786) - lu(k,1435) * lu(k,1777) + lu(k,1788) = lu(k,1788) - lu(k,1436) * lu(k,1777) + lu(k,1789) = lu(k,1789) - lu(k,1437) * lu(k,1777) + lu(k,1790) = lu(k,1790) - lu(k,1438) * lu(k,1777) + lu(k,1791) = lu(k,1791) - lu(k,1439) * lu(k,1777) + lu(k,1792) = lu(k,1792) - lu(k,1440) * lu(k,1777) + lu(k,1819) = lu(k,1819) - lu(k,1428) * lu(k,1818) + lu(k,1820) = lu(k,1820) - lu(k,1429) * lu(k,1818) + lu(k,1821) = lu(k,1821) - lu(k,1430) * lu(k,1818) + lu(k,1822) = lu(k,1822) - lu(k,1431) * lu(k,1818) + lu(k,1823) = lu(k,1823) - lu(k,1432) * lu(k,1818) + lu(k,1824) = lu(k,1824) - lu(k,1433) * lu(k,1818) + lu(k,1825) = lu(k,1825) - lu(k,1434) * lu(k,1818) + lu(k,1827) = lu(k,1827) - lu(k,1435) * lu(k,1818) + lu(k,1829) = lu(k,1829) - lu(k,1436) * lu(k,1818) + lu(k,1830) = lu(k,1830) - lu(k,1437) * lu(k,1818) + lu(k,1831) = lu(k,1831) - lu(k,1438) * lu(k,1818) + lu(k,1832) = lu(k,1832) - lu(k,1439) * lu(k,1818) + lu(k,1833) = lu(k,1833) - lu(k,1440) * lu(k,1818) + lu(k,1843) = lu(k,1843) - lu(k,1428) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1429) * lu(k,1842) + lu(k,1845) = lu(k,1845) - lu(k,1430) * lu(k,1842) + lu(k,1846) = lu(k,1846) - lu(k,1431) * lu(k,1842) + lu(k,1847) = lu(k,1847) - lu(k,1432) * lu(k,1842) + lu(k,1848) = lu(k,1848) - lu(k,1433) * lu(k,1842) + lu(k,1849) = lu(k,1849) - lu(k,1434) * lu(k,1842) + lu(k,1851) = lu(k,1851) - lu(k,1435) * lu(k,1842) + lu(k,1853) = lu(k,1853) - lu(k,1436) * lu(k,1842) + lu(k,1854) = lu(k,1854) - lu(k,1437) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1438) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,1439) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1440) * lu(k,1842) + lu(k,1900) = lu(k,1900) - lu(k,1428) * lu(k,1899) + lu(k,1901) = lu(k,1901) - lu(k,1429) * lu(k,1899) + lu(k,1902) = lu(k,1902) - lu(k,1430) * lu(k,1899) + lu(k,1903) = lu(k,1903) - lu(k,1431) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,1432) * lu(k,1899) + lu(k,1905) = lu(k,1905) - lu(k,1433) * lu(k,1899) + lu(k,1906) = lu(k,1906) - lu(k,1434) * lu(k,1899) + lu(k,1908) = lu(k,1908) - lu(k,1435) * lu(k,1899) + lu(k,1910) = lu(k,1910) - lu(k,1436) * lu(k,1899) + lu(k,1911) = lu(k,1911) - lu(k,1437) * lu(k,1899) + lu(k,1912) = lu(k,1912) - lu(k,1438) * lu(k,1899) + lu(k,1913) = lu(k,1913) - lu(k,1439) * lu(k,1899) + lu(k,1914) = lu(k,1914) - lu(k,1440) * lu(k,1899) + lu(k,1920) = lu(k,1920) - lu(k,1428) * lu(k,1919) + lu(k,1921) = lu(k,1921) - lu(k,1429) * lu(k,1919) + lu(k,1922) = lu(k,1922) - lu(k,1430) * lu(k,1919) + lu(k,1923) = lu(k,1923) - lu(k,1431) * lu(k,1919) + lu(k,1924) = lu(k,1924) - lu(k,1432) * lu(k,1919) + lu(k,1925) = lu(k,1925) - lu(k,1433) * lu(k,1919) + lu(k,1926) = lu(k,1926) - lu(k,1434) * lu(k,1919) + lu(k,1928) = lu(k,1928) - lu(k,1435) * lu(k,1919) + lu(k,1930) = lu(k,1930) - lu(k,1436) * lu(k,1919) + lu(k,1931) = lu(k,1931) - lu(k,1437) * lu(k,1919) + lu(k,1932) = lu(k,1932) - lu(k,1438) * lu(k,1919) + lu(k,1933) = lu(k,1933) - lu(k,1439) * lu(k,1919) + lu(k,1934) = lu(k,1934) - lu(k,1440) * lu(k,1919) + lu(k,1942) = lu(k,1942) - lu(k,1428) * lu(k,1941) + lu(k,1943) = lu(k,1943) - lu(k,1429) * lu(k,1941) + lu(k,1944) = lu(k,1944) - lu(k,1430) * lu(k,1941) + lu(k,1945) = lu(k,1945) - lu(k,1431) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1432) * lu(k,1941) + lu(k,1947) = lu(k,1947) - lu(k,1433) * lu(k,1941) + lu(k,1948) = lu(k,1948) - lu(k,1434) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1435) * lu(k,1941) + lu(k,1952) = lu(k,1952) - lu(k,1436) * lu(k,1941) + lu(k,1953) = lu(k,1953) - lu(k,1437) * lu(k,1941) + lu(k,1954) = lu(k,1954) - lu(k,1438) * lu(k,1941) + lu(k,1955) = lu(k,1955) - lu(k,1439) * lu(k,1941) + lu(k,1956) = lu(k,1956) - lu(k,1440) * lu(k,1941) + lu(k,1984) = lu(k,1984) - lu(k,1428) * lu(k,1983) + lu(k,1985) = lu(k,1985) - lu(k,1429) * lu(k,1983) + lu(k,1986) = lu(k,1986) - lu(k,1430) * lu(k,1983) + lu(k,1987) = lu(k,1987) - lu(k,1431) * lu(k,1983) + lu(k,1988) = lu(k,1988) - lu(k,1432) * lu(k,1983) + lu(k,1989) = lu(k,1989) - lu(k,1433) * lu(k,1983) + lu(k,1990) = lu(k,1990) - lu(k,1434) * lu(k,1983) + lu(k,1992) = lu(k,1992) - lu(k,1435) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1436) * lu(k,1983) + lu(k,1995) = lu(k,1995) - lu(k,1437) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,1438) * lu(k,1983) + lu(k,1997) = lu(k,1997) - lu(k,1439) * lu(k,1983) + lu(k,1998) = lu(k,1998) - lu(k,1440) * lu(k,1983) + lu(k,2008) = lu(k,2008) - lu(k,1428) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1429) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1430) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1431) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1432) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1433) * lu(k,2007) + lu(k,2014) = lu(k,2014) - lu(k,1434) * lu(k,2007) + lu(k,2016) = lu(k,2016) - lu(k,1435) * lu(k,2007) + lu(k,2018) = lu(k,2018) - lu(k,1436) * lu(k,2007) + lu(k,2019) = lu(k,2019) - lu(k,1437) * lu(k,2007) + lu(k,2020) = lu(k,2020) - lu(k,1438) * lu(k,2007) + lu(k,2021) = lu(k,2021) - lu(k,1439) * lu(k,2007) + lu(k,2022) = lu(k,2022) - lu(k,1440) * lu(k,2007) + lu(k,2103) = lu(k,2103) - lu(k,1428) * lu(k,2102) + lu(k,2104) = lu(k,2104) - lu(k,1429) * lu(k,2102) + lu(k,2105) = lu(k,2105) - lu(k,1430) * lu(k,2102) + lu(k,2106) = lu(k,2106) - lu(k,1431) * lu(k,2102) + lu(k,2107) = lu(k,2107) - lu(k,1432) * lu(k,2102) + lu(k,2108) = lu(k,2108) - lu(k,1433) * lu(k,2102) + lu(k,2109) = lu(k,2109) - lu(k,1434) * lu(k,2102) + lu(k,2111) = lu(k,2111) - lu(k,1435) * lu(k,2102) + lu(k,2113) = lu(k,2113) - lu(k,1436) * lu(k,2102) + lu(k,2114) = lu(k,2114) - lu(k,1437) * lu(k,2102) + lu(k,2115) = lu(k,2115) - lu(k,1438) * lu(k,2102) + lu(k,2116) = lu(k,2116) - lu(k,1439) * lu(k,2102) + lu(k,2117) = lu(k,2117) - lu(k,1440) * lu(k,2102) + lu(k,2130) = lu(k,2130) - lu(k,1428) * lu(k,2129) + lu(k,2131) = lu(k,2131) - lu(k,1429) * lu(k,2129) + lu(k,2132) = lu(k,2132) - lu(k,1430) * lu(k,2129) + lu(k,2133) = lu(k,2133) - lu(k,1431) * lu(k,2129) + lu(k,2134) = lu(k,2134) - lu(k,1432) * lu(k,2129) + lu(k,2135) = lu(k,2135) - lu(k,1433) * lu(k,2129) + lu(k,2136) = lu(k,2136) - lu(k,1434) * lu(k,2129) + lu(k,2138) = lu(k,2138) - lu(k,1435) * lu(k,2129) + lu(k,2140) = lu(k,2140) - lu(k,1436) * lu(k,2129) + lu(k,2141) = lu(k,2141) - lu(k,1437) * lu(k,2129) + lu(k,2142) = lu(k,2142) - lu(k,1438) * lu(k,2129) + lu(k,2143) = lu(k,2143) - lu(k,1439) * lu(k,2129) + lu(k,2144) = lu(k,2144) - lu(k,1440) * lu(k,2129) + lu(k,2156) = lu(k,2156) - lu(k,1428) * lu(k,2155) + lu(k,2157) = lu(k,2157) - lu(k,1429) * lu(k,2155) + lu(k,2158) = lu(k,2158) - lu(k,1430) * lu(k,2155) + lu(k,2159) = lu(k,2159) - lu(k,1431) * lu(k,2155) + lu(k,2160) = lu(k,2160) - lu(k,1432) * lu(k,2155) + lu(k,2161) = lu(k,2161) - lu(k,1433) * lu(k,2155) + lu(k,2162) = lu(k,2162) - lu(k,1434) * lu(k,2155) + lu(k,2164) = lu(k,2164) - lu(k,1435) * lu(k,2155) + lu(k,2166) = lu(k,2166) - lu(k,1436) * lu(k,2155) + lu(k,2167) = lu(k,2167) - lu(k,1437) * lu(k,2155) + lu(k,2168) = lu(k,2168) - lu(k,1438) * lu(k,2155) + lu(k,2169) = lu(k,2169) - lu(k,1439) * lu(k,2155) + lu(k,2170) = lu(k,2170) - lu(k,1440) * lu(k,2155) + end do + end subroutine lu_fac27 + subroutine lu_fac28( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1507) = 1._r8 / lu(k,1507) + lu(k,1508) = lu(k,1508) * lu(k,1507) + lu(k,1509) = lu(k,1509) * lu(k,1507) + lu(k,1510) = lu(k,1510) * lu(k,1507) + lu(k,1511) = lu(k,1511) * lu(k,1507) + lu(k,1512) = lu(k,1512) * lu(k,1507) + lu(k,1513) = lu(k,1513) * lu(k,1507) + lu(k,1514) = lu(k,1514) * lu(k,1507) + lu(k,1515) = lu(k,1515) * lu(k,1507) + lu(k,1516) = lu(k,1516) * lu(k,1507) + lu(k,1517) = lu(k,1517) * lu(k,1507) + lu(k,1518) = lu(k,1518) * lu(k,1507) + lu(k,1519) = lu(k,1519) * lu(k,1507) + lu(k,1520) = lu(k,1520) * lu(k,1507) + lu(k,1521) = lu(k,1521) * lu(k,1507) + lu(k,1543) = lu(k,1543) - lu(k,1508) * lu(k,1542) + lu(k,1544) = lu(k,1544) - lu(k,1509) * lu(k,1542) + lu(k,1545) = lu(k,1545) - lu(k,1510) * lu(k,1542) + lu(k,1546) = lu(k,1546) - lu(k,1511) * lu(k,1542) + lu(k,1547) = lu(k,1547) - lu(k,1512) * lu(k,1542) + lu(k,1548) = lu(k,1548) - lu(k,1513) * lu(k,1542) + lu(k,1549) = lu(k,1549) - lu(k,1514) * lu(k,1542) + lu(k,1550) = lu(k,1550) - lu(k,1515) * lu(k,1542) + lu(k,1551) = lu(k,1551) - lu(k,1516) * lu(k,1542) + lu(k,1552) = lu(k,1552) - lu(k,1517) * lu(k,1542) + lu(k,1553) = lu(k,1553) - lu(k,1518) * lu(k,1542) + lu(k,1554) = lu(k,1554) - lu(k,1519) * lu(k,1542) + lu(k,1555) = lu(k,1555) - lu(k,1520) * lu(k,1542) + lu(k,1556) = lu(k,1556) - lu(k,1521) * lu(k,1542) + lu(k,1569) = lu(k,1569) - lu(k,1508) * lu(k,1568) + lu(k,1570) = lu(k,1570) - lu(k,1509) * lu(k,1568) + lu(k,1571) = lu(k,1571) - lu(k,1510) * lu(k,1568) + lu(k,1572) = lu(k,1572) - lu(k,1511) * lu(k,1568) + lu(k,1573) = lu(k,1573) - lu(k,1512) * lu(k,1568) + lu(k,1574) = lu(k,1574) - lu(k,1513) * lu(k,1568) + lu(k,1575) = lu(k,1575) - lu(k,1514) * lu(k,1568) + lu(k,1576) = lu(k,1576) - lu(k,1515) * lu(k,1568) + lu(k,1577) = lu(k,1577) - lu(k,1516) * lu(k,1568) + lu(k,1578) = lu(k,1578) - lu(k,1517) * lu(k,1568) + lu(k,1579) = lu(k,1579) - lu(k,1518) * lu(k,1568) + lu(k,1580) = lu(k,1580) - lu(k,1519) * lu(k,1568) + lu(k,1581) = lu(k,1581) - lu(k,1520) * lu(k,1568) + lu(k,1582) = lu(k,1582) - lu(k,1521) * lu(k,1568) + lu(k,1717) = lu(k,1717) - lu(k,1508) * lu(k,1716) + lu(k,1718) = lu(k,1718) - lu(k,1509) * lu(k,1716) + lu(k,1719) = lu(k,1719) - lu(k,1510) * lu(k,1716) + lu(k,1720) = lu(k,1720) - lu(k,1511) * lu(k,1716) + lu(k,1721) = lu(k,1721) - lu(k,1512) * lu(k,1716) + lu(k,1722) = lu(k,1722) - lu(k,1513) * lu(k,1716) + lu(k,1723) = lu(k,1723) - lu(k,1514) * lu(k,1716) + lu(k,1724) = lu(k,1724) - lu(k,1515) * lu(k,1716) + lu(k,1725) = lu(k,1725) - lu(k,1516) * lu(k,1716) + lu(k,1726) = lu(k,1726) - lu(k,1517) * lu(k,1716) + lu(k,1727) = lu(k,1727) - lu(k,1518) * lu(k,1716) + lu(k,1728) = lu(k,1728) - lu(k,1519) * lu(k,1716) + lu(k,1729) = lu(k,1729) - lu(k,1520) * lu(k,1716) + lu(k,1730) = lu(k,1730) - lu(k,1521) * lu(k,1716) + lu(k,1779) = lu(k,1779) - lu(k,1508) * lu(k,1778) + lu(k,1780) = lu(k,1780) - lu(k,1509) * lu(k,1778) + lu(k,1781) = lu(k,1781) - lu(k,1510) * lu(k,1778) + lu(k,1782) = lu(k,1782) - lu(k,1511) * lu(k,1778) + lu(k,1783) = lu(k,1783) - lu(k,1512) * lu(k,1778) + lu(k,1784) = lu(k,1784) - lu(k,1513) * lu(k,1778) + lu(k,1785) = lu(k,1785) - lu(k,1514) * lu(k,1778) + lu(k,1786) = lu(k,1786) - lu(k,1515) * lu(k,1778) + lu(k,1787) = lu(k,1787) - lu(k,1516) * lu(k,1778) + lu(k,1788) = lu(k,1788) - lu(k,1517) * lu(k,1778) + lu(k,1789) = lu(k,1789) - lu(k,1518) * lu(k,1778) + lu(k,1790) = lu(k,1790) - lu(k,1519) * lu(k,1778) + lu(k,1791) = lu(k,1791) - lu(k,1520) * lu(k,1778) + lu(k,1792) = lu(k,1792) - lu(k,1521) * lu(k,1778) + lu(k,1820) = lu(k,1820) - lu(k,1508) * lu(k,1819) + lu(k,1821) = lu(k,1821) - lu(k,1509) * lu(k,1819) + lu(k,1822) = lu(k,1822) - lu(k,1510) * lu(k,1819) + lu(k,1823) = lu(k,1823) - lu(k,1511) * lu(k,1819) + lu(k,1824) = lu(k,1824) - lu(k,1512) * lu(k,1819) + lu(k,1825) = lu(k,1825) - lu(k,1513) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1514) * lu(k,1819) + lu(k,1827) = lu(k,1827) - lu(k,1515) * lu(k,1819) + lu(k,1828) = lu(k,1828) - lu(k,1516) * lu(k,1819) + lu(k,1829) = lu(k,1829) - lu(k,1517) * lu(k,1819) + lu(k,1830) = lu(k,1830) - lu(k,1518) * lu(k,1819) + lu(k,1831) = lu(k,1831) - lu(k,1519) * lu(k,1819) + lu(k,1832) = lu(k,1832) - lu(k,1520) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,1521) * lu(k,1819) + lu(k,1844) = lu(k,1844) - lu(k,1508) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1509) * lu(k,1843) + lu(k,1846) = lu(k,1846) - lu(k,1510) * lu(k,1843) + lu(k,1847) = lu(k,1847) - lu(k,1511) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1512) * lu(k,1843) + lu(k,1849) = lu(k,1849) - lu(k,1513) * lu(k,1843) + lu(k,1850) = lu(k,1850) - lu(k,1514) * lu(k,1843) + lu(k,1851) = lu(k,1851) - lu(k,1515) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1516) * lu(k,1843) + lu(k,1853) = lu(k,1853) - lu(k,1517) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1518) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1519) * lu(k,1843) + lu(k,1856) = lu(k,1856) - lu(k,1520) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1521) * lu(k,1843) + lu(k,1901) = lu(k,1901) - lu(k,1508) * lu(k,1900) + lu(k,1902) = lu(k,1902) - lu(k,1509) * lu(k,1900) + lu(k,1903) = lu(k,1903) - lu(k,1510) * lu(k,1900) + lu(k,1904) = lu(k,1904) - lu(k,1511) * lu(k,1900) + lu(k,1905) = lu(k,1905) - lu(k,1512) * lu(k,1900) + lu(k,1906) = lu(k,1906) - lu(k,1513) * lu(k,1900) + lu(k,1907) = lu(k,1907) - lu(k,1514) * lu(k,1900) + lu(k,1908) = lu(k,1908) - lu(k,1515) * lu(k,1900) + lu(k,1909) = lu(k,1909) - lu(k,1516) * lu(k,1900) + lu(k,1910) = lu(k,1910) - lu(k,1517) * lu(k,1900) + lu(k,1911) = lu(k,1911) - lu(k,1518) * lu(k,1900) + lu(k,1912) = lu(k,1912) - lu(k,1519) * lu(k,1900) + lu(k,1913) = lu(k,1913) - lu(k,1520) * lu(k,1900) + lu(k,1914) = lu(k,1914) - lu(k,1521) * lu(k,1900) + lu(k,1921) = lu(k,1921) - lu(k,1508) * lu(k,1920) + lu(k,1922) = lu(k,1922) - lu(k,1509) * lu(k,1920) + lu(k,1923) = lu(k,1923) - lu(k,1510) * lu(k,1920) + lu(k,1924) = lu(k,1924) - lu(k,1511) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1512) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1513) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,1514) * lu(k,1920) + lu(k,1928) = lu(k,1928) - lu(k,1515) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1516) * lu(k,1920) + lu(k,1930) = lu(k,1930) - lu(k,1517) * lu(k,1920) + lu(k,1931) = lu(k,1931) - lu(k,1518) * lu(k,1920) + lu(k,1932) = lu(k,1932) - lu(k,1519) * lu(k,1920) + lu(k,1933) = lu(k,1933) - lu(k,1520) * lu(k,1920) + lu(k,1934) = lu(k,1934) - lu(k,1521) * lu(k,1920) + lu(k,1943) = lu(k,1943) - lu(k,1508) * lu(k,1942) + lu(k,1944) = lu(k,1944) - lu(k,1509) * lu(k,1942) + lu(k,1945) = lu(k,1945) - lu(k,1510) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1511) * lu(k,1942) + lu(k,1947) = lu(k,1947) - lu(k,1512) * lu(k,1942) + lu(k,1948) = lu(k,1948) - lu(k,1513) * lu(k,1942) + lu(k,1949) = lu(k,1949) - lu(k,1514) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1515) * lu(k,1942) + lu(k,1951) = lu(k,1951) - lu(k,1516) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,1517) * lu(k,1942) + lu(k,1953) = lu(k,1953) - lu(k,1518) * lu(k,1942) + lu(k,1954) = lu(k,1954) - lu(k,1519) * lu(k,1942) + lu(k,1955) = lu(k,1955) - lu(k,1520) * lu(k,1942) + lu(k,1956) = lu(k,1956) - lu(k,1521) * lu(k,1942) + lu(k,1985) = lu(k,1985) - lu(k,1508) * lu(k,1984) + lu(k,1986) = lu(k,1986) - lu(k,1509) * lu(k,1984) + lu(k,1987) = lu(k,1987) - lu(k,1510) * lu(k,1984) + lu(k,1988) = lu(k,1988) - lu(k,1511) * lu(k,1984) + lu(k,1989) = lu(k,1989) - lu(k,1512) * lu(k,1984) + lu(k,1990) = lu(k,1990) - lu(k,1513) * lu(k,1984) + lu(k,1991) = lu(k,1991) - lu(k,1514) * lu(k,1984) + lu(k,1992) = lu(k,1992) - lu(k,1515) * lu(k,1984) + lu(k,1993) = lu(k,1993) - lu(k,1516) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1517) * lu(k,1984) + lu(k,1995) = lu(k,1995) - lu(k,1518) * lu(k,1984) + lu(k,1996) = lu(k,1996) - lu(k,1519) * lu(k,1984) + lu(k,1997) = lu(k,1997) - lu(k,1520) * lu(k,1984) + lu(k,1998) = lu(k,1998) - lu(k,1521) * lu(k,1984) + lu(k,2009) = lu(k,2009) - lu(k,1508) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1509) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1510) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1511) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1512) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1513) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1514) * lu(k,2008) + lu(k,2016) = lu(k,2016) - lu(k,1515) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1516) * lu(k,2008) + lu(k,2018) = lu(k,2018) - lu(k,1517) * lu(k,2008) + lu(k,2019) = lu(k,2019) - lu(k,1518) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1519) * lu(k,2008) + lu(k,2021) = lu(k,2021) - lu(k,1520) * lu(k,2008) + lu(k,2022) = lu(k,2022) - lu(k,1521) * lu(k,2008) + lu(k,2104) = lu(k,2104) - lu(k,1508) * lu(k,2103) + lu(k,2105) = lu(k,2105) - lu(k,1509) * lu(k,2103) + lu(k,2106) = lu(k,2106) - lu(k,1510) * lu(k,2103) + lu(k,2107) = lu(k,2107) - lu(k,1511) * lu(k,2103) + lu(k,2108) = lu(k,2108) - lu(k,1512) * lu(k,2103) + lu(k,2109) = lu(k,2109) - lu(k,1513) * lu(k,2103) + lu(k,2110) = lu(k,2110) - lu(k,1514) * lu(k,2103) + lu(k,2111) = lu(k,2111) - lu(k,1515) * lu(k,2103) + lu(k,2112) = lu(k,2112) - lu(k,1516) * lu(k,2103) + lu(k,2113) = lu(k,2113) - lu(k,1517) * lu(k,2103) + lu(k,2114) = lu(k,2114) - lu(k,1518) * lu(k,2103) + lu(k,2115) = lu(k,2115) - lu(k,1519) * lu(k,2103) + lu(k,2116) = lu(k,2116) - lu(k,1520) * lu(k,2103) + lu(k,2117) = lu(k,2117) - lu(k,1521) * lu(k,2103) + lu(k,2131) = lu(k,2131) - lu(k,1508) * lu(k,2130) + lu(k,2132) = lu(k,2132) - lu(k,1509) * lu(k,2130) + lu(k,2133) = lu(k,2133) - lu(k,1510) * lu(k,2130) + lu(k,2134) = lu(k,2134) - lu(k,1511) * lu(k,2130) + lu(k,2135) = lu(k,2135) - lu(k,1512) * lu(k,2130) + lu(k,2136) = lu(k,2136) - lu(k,1513) * lu(k,2130) + lu(k,2137) = lu(k,2137) - lu(k,1514) * lu(k,2130) + lu(k,2138) = lu(k,2138) - lu(k,1515) * lu(k,2130) + lu(k,2139) = lu(k,2139) - lu(k,1516) * lu(k,2130) + lu(k,2140) = lu(k,2140) - lu(k,1517) * lu(k,2130) + lu(k,2141) = lu(k,2141) - lu(k,1518) * lu(k,2130) + lu(k,2142) = lu(k,2142) - lu(k,1519) * lu(k,2130) + lu(k,2143) = lu(k,2143) - lu(k,1520) * lu(k,2130) + lu(k,2144) = lu(k,2144) - lu(k,1521) * lu(k,2130) + lu(k,2157) = lu(k,2157) - lu(k,1508) * lu(k,2156) + lu(k,2158) = lu(k,2158) - lu(k,1509) * lu(k,2156) + lu(k,2159) = lu(k,2159) - lu(k,1510) * lu(k,2156) + lu(k,2160) = lu(k,2160) - lu(k,1511) * lu(k,2156) + lu(k,2161) = lu(k,2161) - lu(k,1512) * lu(k,2156) + lu(k,2162) = lu(k,2162) - lu(k,1513) * lu(k,2156) + lu(k,2163) = lu(k,2163) - lu(k,1514) * lu(k,2156) + lu(k,2164) = lu(k,2164) - lu(k,1515) * lu(k,2156) + lu(k,2165) = lu(k,2165) - lu(k,1516) * lu(k,2156) + lu(k,2166) = lu(k,2166) - lu(k,1517) * lu(k,2156) + lu(k,2167) = lu(k,2167) - lu(k,1518) * lu(k,2156) + lu(k,2168) = lu(k,2168) - lu(k,1519) * lu(k,2156) + lu(k,2169) = lu(k,2169) - lu(k,1520) * lu(k,2156) + lu(k,2170) = lu(k,2170) - lu(k,1521) * lu(k,2156) + lu(k,1543) = 1._r8 / lu(k,1543) + lu(k,1544) = lu(k,1544) * lu(k,1543) + lu(k,1545) = lu(k,1545) * lu(k,1543) + lu(k,1546) = lu(k,1546) * lu(k,1543) + lu(k,1547) = lu(k,1547) * lu(k,1543) + lu(k,1548) = lu(k,1548) * lu(k,1543) + lu(k,1549) = lu(k,1549) * lu(k,1543) + lu(k,1550) = lu(k,1550) * lu(k,1543) + lu(k,1551) = lu(k,1551) * lu(k,1543) + lu(k,1552) = lu(k,1552) * lu(k,1543) + lu(k,1553) = lu(k,1553) * lu(k,1543) + lu(k,1554) = lu(k,1554) * lu(k,1543) + lu(k,1555) = lu(k,1555) * lu(k,1543) + lu(k,1556) = lu(k,1556) * lu(k,1543) + lu(k,1570) = lu(k,1570) - lu(k,1544) * lu(k,1569) + lu(k,1571) = lu(k,1571) - lu(k,1545) * lu(k,1569) + lu(k,1572) = lu(k,1572) - lu(k,1546) * lu(k,1569) + lu(k,1573) = lu(k,1573) - lu(k,1547) * lu(k,1569) + lu(k,1574) = lu(k,1574) - lu(k,1548) * lu(k,1569) + lu(k,1575) = lu(k,1575) - lu(k,1549) * lu(k,1569) + lu(k,1576) = lu(k,1576) - lu(k,1550) * lu(k,1569) + lu(k,1577) = lu(k,1577) - lu(k,1551) * lu(k,1569) + lu(k,1578) = lu(k,1578) - lu(k,1552) * lu(k,1569) + lu(k,1579) = lu(k,1579) - lu(k,1553) * lu(k,1569) + lu(k,1580) = lu(k,1580) - lu(k,1554) * lu(k,1569) + lu(k,1581) = lu(k,1581) - lu(k,1555) * lu(k,1569) + lu(k,1582) = lu(k,1582) - lu(k,1556) * lu(k,1569) + lu(k,1718) = lu(k,1718) - lu(k,1544) * lu(k,1717) + lu(k,1719) = lu(k,1719) - lu(k,1545) * lu(k,1717) + lu(k,1720) = lu(k,1720) - lu(k,1546) * lu(k,1717) + lu(k,1721) = lu(k,1721) - lu(k,1547) * lu(k,1717) + lu(k,1722) = lu(k,1722) - lu(k,1548) * lu(k,1717) + lu(k,1723) = lu(k,1723) - lu(k,1549) * lu(k,1717) + lu(k,1724) = lu(k,1724) - lu(k,1550) * lu(k,1717) + lu(k,1725) = lu(k,1725) - lu(k,1551) * lu(k,1717) + lu(k,1726) = lu(k,1726) - lu(k,1552) * lu(k,1717) + lu(k,1727) = lu(k,1727) - lu(k,1553) * lu(k,1717) + lu(k,1728) = lu(k,1728) - lu(k,1554) * lu(k,1717) + lu(k,1729) = lu(k,1729) - lu(k,1555) * lu(k,1717) + lu(k,1730) = lu(k,1730) - lu(k,1556) * lu(k,1717) + lu(k,1780) = lu(k,1780) - lu(k,1544) * lu(k,1779) + lu(k,1781) = lu(k,1781) - lu(k,1545) * lu(k,1779) + lu(k,1782) = lu(k,1782) - lu(k,1546) * lu(k,1779) + lu(k,1783) = lu(k,1783) - lu(k,1547) * lu(k,1779) + lu(k,1784) = lu(k,1784) - lu(k,1548) * lu(k,1779) + lu(k,1785) = lu(k,1785) - lu(k,1549) * lu(k,1779) + lu(k,1786) = lu(k,1786) - lu(k,1550) * lu(k,1779) + lu(k,1787) = lu(k,1787) - lu(k,1551) * lu(k,1779) + lu(k,1788) = lu(k,1788) - lu(k,1552) * lu(k,1779) + lu(k,1789) = lu(k,1789) - lu(k,1553) * lu(k,1779) + lu(k,1790) = lu(k,1790) - lu(k,1554) * lu(k,1779) + lu(k,1791) = lu(k,1791) - lu(k,1555) * lu(k,1779) + lu(k,1792) = lu(k,1792) - lu(k,1556) * lu(k,1779) + lu(k,1821) = lu(k,1821) - lu(k,1544) * lu(k,1820) + lu(k,1822) = lu(k,1822) - lu(k,1545) * lu(k,1820) + lu(k,1823) = lu(k,1823) - lu(k,1546) * lu(k,1820) + lu(k,1824) = lu(k,1824) - lu(k,1547) * lu(k,1820) + lu(k,1825) = lu(k,1825) - lu(k,1548) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1549) * lu(k,1820) + lu(k,1827) = lu(k,1827) - lu(k,1550) * lu(k,1820) + lu(k,1828) = lu(k,1828) - lu(k,1551) * lu(k,1820) + lu(k,1829) = lu(k,1829) - lu(k,1552) * lu(k,1820) + lu(k,1830) = lu(k,1830) - lu(k,1553) * lu(k,1820) + lu(k,1831) = lu(k,1831) - lu(k,1554) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,1555) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1556) * lu(k,1820) + lu(k,1845) = lu(k,1845) - lu(k,1544) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1545) * lu(k,1844) + lu(k,1847) = lu(k,1847) - lu(k,1546) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,1547) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,1548) * lu(k,1844) + lu(k,1850) = lu(k,1850) - lu(k,1549) * lu(k,1844) + lu(k,1851) = lu(k,1851) - lu(k,1550) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1551) * lu(k,1844) + lu(k,1853) = lu(k,1853) - lu(k,1552) * lu(k,1844) + lu(k,1854) = lu(k,1854) - lu(k,1553) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1554) * lu(k,1844) + lu(k,1856) = lu(k,1856) - lu(k,1555) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1556) * lu(k,1844) + lu(k,1902) = lu(k,1902) - lu(k,1544) * lu(k,1901) + lu(k,1903) = lu(k,1903) - lu(k,1545) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1546) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1547) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,1548) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1549) * lu(k,1901) + lu(k,1908) = lu(k,1908) - lu(k,1550) * lu(k,1901) + lu(k,1909) = lu(k,1909) - lu(k,1551) * lu(k,1901) + lu(k,1910) = lu(k,1910) - lu(k,1552) * lu(k,1901) + lu(k,1911) = lu(k,1911) - lu(k,1553) * lu(k,1901) + lu(k,1912) = lu(k,1912) - lu(k,1554) * lu(k,1901) + lu(k,1913) = lu(k,1913) - lu(k,1555) * lu(k,1901) + lu(k,1914) = lu(k,1914) - lu(k,1556) * lu(k,1901) + lu(k,1922) = lu(k,1922) - lu(k,1544) * lu(k,1921) + lu(k,1923) = lu(k,1923) - lu(k,1545) * lu(k,1921) + lu(k,1924) = lu(k,1924) - lu(k,1546) * lu(k,1921) + lu(k,1925) = lu(k,1925) - lu(k,1547) * lu(k,1921) + lu(k,1926) = lu(k,1926) - lu(k,1548) * lu(k,1921) + lu(k,1927) = lu(k,1927) - lu(k,1549) * lu(k,1921) + lu(k,1928) = lu(k,1928) - lu(k,1550) * lu(k,1921) + lu(k,1929) = lu(k,1929) - lu(k,1551) * lu(k,1921) + lu(k,1930) = lu(k,1930) - lu(k,1552) * lu(k,1921) + lu(k,1931) = lu(k,1931) - lu(k,1553) * lu(k,1921) + lu(k,1932) = lu(k,1932) - lu(k,1554) * lu(k,1921) + lu(k,1933) = lu(k,1933) - lu(k,1555) * lu(k,1921) + lu(k,1934) = lu(k,1934) - lu(k,1556) * lu(k,1921) + lu(k,1944) = lu(k,1944) - lu(k,1544) * lu(k,1943) + lu(k,1945) = lu(k,1945) - lu(k,1545) * lu(k,1943) + lu(k,1946) = lu(k,1946) - lu(k,1546) * lu(k,1943) + lu(k,1947) = lu(k,1947) - lu(k,1547) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1548) * lu(k,1943) + lu(k,1949) = lu(k,1949) - lu(k,1549) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1550) * lu(k,1943) + lu(k,1951) = lu(k,1951) - lu(k,1551) * lu(k,1943) + lu(k,1952) = lu(k,1952) - lu(k,1552) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1553) * lu(k,1943) + lu(k,1954) = lu(k,1954) - lu(k,1554) * lu(k,1943) + lu(k,1955) = lu(k,1955) - lu(k,1555) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,1556) * lu(k,1943) + lu(k,1986) = lu(k,1986) - lu(k,1544) * lu(k,1985) + lu(k,1987) = lu(k,1987) - lu(k,1545) * lu(k,1985) + lu(k,1988) = lu(k,1988) - lu(k,1546) * lu(k,1985) + lu(k,1989) = lu(k,1989) - lu(k,1547) * lu(k,1985) + lu(k,1990) = lu(k,1990) - lu(k,1548) * lu(k,1985) + lu(k,1991) = lu(k,1991) - lu(k,1549) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,1550) * lu(k,1985) + lu(k,1993) = lu(k,1993) - lu(k,1551) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1552) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1553) * lu(k,1985) + lu(k,1996) = lu(k,1996) - lu(k,1554) * lu(k,1985) + lu(k,1997) = lu(k,1997) - lu(k,1555) * lu(k,1985) + lu(k,1998) = lu(k,1998) - lu(k,1556) * lu(k,1985) + lu(k,2010) = lu(k,2010) - lu(k,1544) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1545) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1546) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1547) * lu(k,2009) + lu(k,2014) = lu(k,2014) - lu(k,1548) * lu(k,2009) + lu(k,2015) = lu(k,2015) - lu(k,1549) * lu(k,2009) + lu(k,2016) = lu(k,2016) - lu(k,1550) * lu(k,2009) + lu(k,2017) = lu(k,2017) - lu(k,1551) * lu(k,2009) + lu(k,2018) = lu(k,2018) - lu(k,1552) * lu(k,2009) + lu(k,2019) = lu(k,2019) - lu(k,1553) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1554) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1555) * lu(k,2009) + lu(k,2022) = lu(k,2022) - lu(k,1556) * lu(k,2009) + lu(k,2105) = lu(k,2105) - lu(k,1544) * lu(k,2104) + lu(k,2106) = lu(k,2106) - lu(k,1545) * lu(k,2104) + lu(k,2107) = lu(k,2107) - lu(k,1546) * lu(k,2104) + lu(k,2108) = lu(k,2108) - lu(k,1547) * lu(k,2104) + lu(k,2109) = lu(k,2109) - lu(k,1548) * lu(k,2104) + lu(k,2110) = lu(k,2110) - lu(k,1549) * lu(k,2104) + lu(k,2111) = lu(k,2111) - lu(k,1550) * lu(k,2104) + lu(k,2112) = lu(k,2112) - lu(k,1551) * lu(k,2104) + lu(k,2113) = lu(k,2113) - lu(k,1552) * lu(k,2104) + lu(k,2114) = lu(k,2114) - lu(k,1553) * lu(k,2104) + lu(k,2115) = lu(k,2115) - lu(k,1554) * lu(k,2104) + lu(k,2116) = lu(k,2116) - lu(k,1555) * lu(k,2104) + lu(k,2117) = lu(k,2117) - lu(k,1556) * lu(k,2104) + lu(k,2132) = lu(k,2132) - lu(k,1544) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,1545) * lu(k,2131) + lu(k,2134) = lu(k,2134) - lu(k,1546) * lu(k,2131) + lu(k,2135) = lu(k,2135) - lu(k,1547) * lu(k,2131) + lu(k,2136) = lu(k,2136) - lu(k,1548) * lu(k,2131) + lu(k,2137) = lu(k,2137) - lu(k,1549) * lu(k,2131) + lu(k,2138) = lu(k,2138) - lu(k,1550) * lu(k,2131) + lu(k,2139) = lu(k,2139) - lu(k,1551) * lu(k,2131) + lu(k,2140) = lu(k,2140) - lu(k,1552) * lu(k,2131) + lu(k,2141) = lu(k,2141) - lu(k,1553) * lu(k,2131) + lu(k,2142) = lu(k,2142) - lu(k,1554) * lu(k,2131) + lu(k,2143) = lu(k,2143) - lu(k,1555) * lu(k,2131) + lu(k,2144) = lu(k,2144) - lu(k,1556) * lu(k,2131) + lu(k,2158) = lu(k,2158) - lu(k,1544) * lu(k,2157) + lu(k,2159) = lu(k,2159) - lu(k,1545) * lu(k,2157) + lu(k,2160) = lu(k,2160) - lu(k,1546) * lu(k,2157) + lu(k,2161) = lu(k,2161) - lu(k,1547) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1548) * lu(k,2157) + lu(k,2163) = lu(k,2163) - lu(k,1549) * lu(k,2157) + lu(k,2164) = lu(k,2164) - lu(k,1550) * lu(k,2157) + lu(k,2165) = lu(k,2165) - lu(k,1551) * lu(k,2157) + lu(k,2166) = lu(k,2166) - lu(k,1552) * lu(k,2157) + lu(k,2167) = lu(k,2167) - lu(k,1553) * lu(k,2157) + lu(k,2168) = lu(k,2168) - lu(k,1554) * lu(k,2157) + lu(k,2169) = lu(k,2169) - lu(k,1555) * lu(k,2157) + lu(k,2170) = lu(k,2170) - lu(k,1556) * lu(k,2157) + lu(k,1570) = 1._r8 / lu(k,1570) + lu(k,1571) = lu(k,1571) * lu(k,1570) + lu(k,1572) = lu(k,1572) * lu(k,1570) + lu(k,1573) = lu(k,1573) * lu(k,1570) + lu(k,1574) = lu(k,1574) * lu(k,1570) + lu(k,1575) = lu(k,1575) * lu(k,1570) + lu(k,1576) = lu(k,1576) * lu(k,1570) + lu(k,1577) = lu(k,1577) * lu(k,1570) + lu(k,1578) = lu(k,1578) * lu(k,1570) + lu(k,1579) = lu(k,1579) * lu(k,1570) + lu(k,1580) = lu(k,1580) * lu(k,1570) + lu(k,1581) = lu(k,1581) * lu(k,1570) + lu(k,1582) = lu(k,1582) * lu(k,1570) + lu(k,1719) = lu(k,1719) - lu(k,1571) * lu(k,1718) + lu(k,1720) = lu(k,1720) - lu(k,1572) * lu(k,1718) + lu(k,1721) = lu(k,1721) - lu(k,1573) * lu(k,1718) + lu(k,1722) = lu(k,1722) - lu(k,1574) * lu(k,1718) + lu(k,1723) = lu(k,1723) - lu(k,1575) * lu(k,1718) + lu(k,1724) = lu(k,1724) - lu(k,1576) * lu(k,1718) + lu(k,1725) = lu(k,1725) - lu(k,1577) * lu(k,1718) + lu(k,1726) = lu(k,1726) - lu(k,1578) * lu(k,1718) + lu(k,1727) = lu(k,1727) - lu(k,1579) * lu(k,1718) + lu(k,1728) = lu(k,1728) - lu(k,1580) * lu(k,1718) + lu(k,1729) = lu(k,1729) - lu(k,1581) * lu(k,1718) + lu(k,1730) = lu(k,1730) - lu(k,1582) * lu(k,1718) + lu(k,1781) = lu(k,1781) - lu(k,1571) * lu(k,1780) + lu(k,1782) = lu(k,1782) - lu(k,1572) * lu(k,1780) + lu(k,1783) = lu(k,1783) - lu(k,1573) * lu(k,1780) + lu(k,1784) = lu(k,1784) - lu(k,1574) * lu(k,1780) + lu(k,1785) = lu(k,1785) - lu(k,1575) * lu(k,1780) + lu(k,1786) = lu(k,1786) - lu(k,1576) * lu(k,1780) + lu(k,1787) = lu(k,1787) - lu(k,1577) * lu(k,1780) + lu(k,1788) = lu(k,1788) - lu(k,1578) * lu(k,1780) + lu(k,1789) = lu(k,1789) - lu(k,1579) * lu(k,1780) + lu(k,1790) = lu(k,1790) - lu(k,1580) * lu(k,1780) + lu(k,1791) = lu(k,1791) - lu(k,1581) * lu(k,1780) + lu(k,1792) = lu(k,1792) - lu(k,1582) * lu(k,1780) + lu(k,1822) = lu(k,1822) - lu(k,1571) * lu(k,1821) + lu(k,1823) = lu(k,1823) - lu(k,1572) * lu(k,1821) + lu(k,1824) = lu(k,1824) - lu(k,1573) * lu(k,1821) + lu(k,1825) = lu(k,1825) - lu(k,1574) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,1575) * lu(k,1821) + lu(k,1827) = lu(k,1827) - lu(k,1576) * lu(k,1821) + lu(k,1828) = lu(k,1828) - lu(k,1577) * lu(k,1821) + lu(k,1829) = lu(k,1829) - lu(k,1578) * lu(k,1821) + lu(k,1830) = lu(k,1830) - lu(k,1579) * lu(k,1821) + lu(k,1831) = lu(k,1831) - lu(k,1580) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,1581) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1582) * lu(k,1821) + lu(k,1846) = lu(k,1846) - lu(k,1571) * lu(k,1845) + lu(k,1847) = lu(k,1847) - lu(k,1572) * lu(k,1845) + lu(k,1848) = lu(k,1848) - lu(k,1573) * lu(k,1845) + lu(k,1849) = lu(k,1849) - lu(k,1574) * lu(k,1845) + lu(k,1850) = lu(k,1850) - lu(k,1575) * lu(k,1845) + lu(k,1851) = lu(k,1851) - lu(k,1576) * lu(k,1845) + lu(k,1852) = lu(k,1852) - lu(k,1577) * lu(k,1845) + lu(k,1853) = lu(k,1853) - lu(k,1578) * lu(k,1845) + lu(k,1854) = lu(k,1854) - lu(k,1579) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1580) * lu(k,1845) + lu(k,1856) = lu(k,1856) - lu(k,1581) * lu(k,1845) + lu(k,1857) = lu(k,1857) - lu(k,1582) * lu(k,1845) + lu(k,1903) = lu(k,1903) - lu(k,1571) * lu(k,1902) + lu(k,1904) = lu(k,1904) - lu(k,1572) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1573) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1574) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1575) * lu(k,1902) + lu(k,1908) = lu(k,1908) - lu(k,1576) * lu(k,1902) + lu(k,1909) = lu(k,1909) - lu(k,1577) * lu(k,1902) + lu(k,1910) = lu(k,1910) - lu(k,1578) * lu(k,1902) + lu(k,1911) = lu(k,1911) - lu(k,1579) * lu(k,1902) + lu(k,1912) = lu(k,1912) - lu(k,1580) * lu(k,1902) + lu(k,1913) = lu(k,1913) - lu(k,1581) * lu(k,1902) + lu(k,1914) = lu(k,1914) - lu(k,1582) * lu(k,1902) + lu(k,1923) = lu(k,1923) - lu(k,1571) * lu(k,1922) + lu(k,1924) = lu(k,1924) - lu(k,1572) * lu(k,1922) + lu(k,1925) = lu(k,1925) - lu(k,1573) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1574) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1575) * lu(k,1922) + lu(k,1928) = lu(k,1928) - lu(k,1576) * lu(k,1922) + lu(k,1929) = lu(k,1929) - lu(k,1577) * lu(k,1922) + lu(k,1930) = lu(k,1930) - lu(k,1578) * lu(k,1922) + lu(k,1931) = lu(k,1931) - lu(k,1579) * lu(k,1922) + lu(k,1932) = lu(k,1932) - lu(k,1580) * lu(k,1922) + lu(k,1933) = lu(k,1933) - lu(k,1581) * lu(k,1922) + lu(k,1934) = lu(k,1934) - lu(k,1582) * lu(k,1922) + lu(k,1945) = lu(k,1945) - lu(k,1571) * lu(k,1944) + lu(k,1946) = lu(k,1946) - lu(k,1572) * lu(k,1944) + lu(k,1947) = lu(k,1947) - lu(k,1573) * lu(k,1944) + lu(k,1948) = lu(k,1948) - lu(k,1574) * lu(k,1944) + lu(k,1949) = lu(k,1949) - lu(k,1575) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1576) * lu(k,1944) + lu(k,1951) = lu(k,1951) - lu(k,1577) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1578) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1579) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,1580) * lu(k,1944) + lu(k,1955) = lu(k,1955) - lu(k,1581) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,1582) * lu(k,1944) + lu(k,1987) = lu(k,1987) - lu(k,1571) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1572) * lu(k,1986) + lu(k,1989) = lu(k,1989) - lu(k,1573) * lu(k,1986) + lu(k,1990) = lu(k,1990) - lu(k,1574) * lu(k,1986) + lu(k,1991) = lu(k,1991) - lu(k,1575) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1576) * lu(k,1986) + lu(k,1993) = lu(k,1993) - lu(k,1577) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1578) * lu(k,1986) + lu(k,1995) = lu(k,1995) - lu(k,1579) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1580) * lu(k,1986) + lu(k,1997) = lu(k,1997) - lu(k,1581) * lu(k,1986) + lu(k,1998) = lu(k,1998) - lu(k,1582) * lu(k,1986) + lu(k,2011) = lu(k,2011) - lu(k,1571) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1572) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1573) * lu(k,2010) + lu(k,2014) = lu(k,2014) - lu(k,1574) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1575) * lu(k,2010) + lu(k,2016) = lu(k,2016) - lu(k,1576) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1577) * lu(k,2010) + lu(k,2018) = lu(k,2018) - lu(k,1578) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1579) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1580) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1581) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1582) * lu(k,2010) + lu(k,2106) = lu(k,2106) - lu(k,1571) * lu(k,2105) + lu(k,2107) = lu(k,2107) - lu(k,1572) * lu(k,2105) + lu(k,2108) = lu(k,2108) - lu(k,1573) * lu(k,2105) + lu(k,2109) = lu(k,2109) - lu(k,1574) * lu(k,2105) + lu(k,2110) = lu(k,2110) - lu(k,1575) * lu(k,2105) + lu(k,2111) = lu(k,2111) - lu(k,1576) * lu(k,2105) + lu(k,2112) = lu(k,2112) - lu(k,1577) * lu(k,2105) + lu(k,2113) = lu(k,2113) - lu(k,1578) * lu(k,2105) + lu(k,2114) = lu(k,2114) - lu(k,1579) * lu(k,2105) + lu(k,2115) = lu(k,2115) - lu(k,1580) * lu(k,2105) + lu(k,2116) = lu(k,2116) - lu(k,1581) * lu(k,2105) + lu(k,2117) = lu(k,2117) - lu(k,1582) * lu(k,2105) + lu(k,2133) = lu(k,2133) - lu(k,1571) * lu(k,2132) + lu(k,2134) = lu(k,2134) - lu(k,1572) * lu(k,2132) + lu(k,2135) = lu(k,2135) - lu(k,1573) * lu(k,2132) + lu(k,2136) = lu(k,2136) - lu(k,1574) * lu(k,2132) + lu(k,2137) = lu(k,2137) - lu(k,1575) * lu(k,2132) + lu(k,2138) = lu(k,2138) - lu(k,1576) * lu(k,2132) + lu(k,2139) = lu(k,2139) - lu(k,1577) * lu(k,2132) + lu(k,2140) = lu(k,2140) - lu(k,1578) * lu(k,2132) + lu(k,2141) = lu(k,2141) - lu(k,1579) * lu(k,2132) + lu(k,2142) = lu(k,2142) - lu(k,1580) * lu(k,2132) + lu(k,2143) = lu(k,2143) - lu(k,1581) * lu(k,2132) + lu(k,2144) = lu(k,2144) - lu(k,1582) * lu(k,2132) + lu(k,2159) = lu(k,2159) - lu(k,1571) * lu(k,2158) + lu(k,2160) = lu(k,2160) - lu(k,1572) * lu(k,2158) + lu(k,2161) = lu(k,2161) - lu(k,1573) * lu(k,2158) + lu(k,2162) = lu(k,2162) - lu(k,1574) * lu(k,2158) + lu(k,2163) = lu(k,2163) - lu(k,1575) * lu(k,2158) + lu(k,2164) = lu(k,2164) - lu(k,1576) * lu(k,2158) + lu(k,2165) = lu(k,2165) - lu(k,1577) * lu(k,2158) + lu(k,2166) = lu(k,2166) - lu(k,1578) * lu(k,2158) + lu(k,2167) = lu(k,2167) - lu(k,1579) * lu(k,2158) + lu(k,2168) = lu(k,2168) - lu(k,1580) * lu(k,2158) + lu(k,2169) = lu(k,2169) - lu(k,1581) * lu(k,2158) + lu(k,2170) = lu(k,2170) - lu(k,1582) * lu(k,2158) + lu(k,1719) = 1._r8 / lu(k,1719) + lu(k,1720) = lu(k,1720) * lu(k,1719) + lu(k,1721) = lu(k,1721) * lu(k,1719) + lu(k,1722) = lu(k,1722) * lu(k,1719) + lu(k,1723) = lu(k,1723) * lu(k,1719) + lu(k,1724) = lu(k,1724) * lu(k,1719) + lu(k,1725) = lu(k,1725) * lu(k,1719) + lu(k,1726) = lu(k,1726) * lu(k,1719) + lu(k,1727) = lu(k,1727) * lu(k,1719) + lu(k,1728) = lu(k,1728) * lu(k,1719) + lu(k,1729) = lu(k,1729) * lu(k,1719) + lu(k,1730) = lu(k,1730) * lu(k,1719) + lu(k,1782) = lu(k,1782) - lu(k,1720) * lu(k,1781) + lu(k,1783) = lu(k,1783) - lu(k,1721) * lu(k,1781) + lu(k,1784) = lu(k,1784) - lu(k,1722) * lu(k,1781) + lu(k,1785) = lu(k,1785) - lu(k,1723) * lu(k,1781) + lu(k,1786) = lu(k,1786) - lu(k,1724) * lu(k,1781) + lu(k,1787) = lu(k,1787) - lu(k,1725) * lu(k,1781) + lu(k,1788) = lu(k,1788) - lu(k,1726) * lu(k,1781) + lu(k,1789) = lu(k,1789) - lu(k,1727) * lu(k,1781) + lu(k,1790) = lu(k,1790) - lu(k,1728) * lu(k,1781) + lu(k,1791) = lu(k,1791) - lu(k,1729) * lu(k,1781) + lu(k,1792) = lu(k,1792) - lu(k,1730) * lu(k,1781) + lu(k,1823) = lu(k,1823) - lu(k,1720) * lu(k,1822) + lu(k,1824) = lu(k,1824) - lu(k,1721) * lu(k,1822) + lu(k,1825) = lu(k,1825) - lu(k,1722) * lu(k,1822) + lu(k,1826) = lu(k,1826) - lu(k,1723) * lu(k,1822) + lu(k,1827) = lu(k,1827) - lu(k,1724) * lu(k,1822) + lu(k,1828) = lu(k,1828) - lu(k,1725) * lu(k,1822) + lu(k,1829) = lu(k,1829) - lu(k,1726) * lu(k,1822) + lu(k,1830) = lu(k,1830) - lu(k,1727) * lu(k,1822) + lu(k,1831) = lu(k,1831) - lu(k,1728) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,1729) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1730) * lu(k,1822) + lu(k,1847) = lu(k,1847) - lu(k,1720) * lu(k,1846) + lu(k,1848) = lu(k,1848) - lu(k,1721) * lu(k,1846) + lu(k,1849) = lu(k,1849) - lu(k,1722) * lu(k,1846) + lu(k,1850) = lu(k,1850) - lu(k,1723) * lu(k,1846) + lu(k,1851) = lu(k,1851) - lu(k,1724) * lu(k,1846) + lu(k,1852) = lu(k,1852) - lu(k,1725) * lu(k,1846) + lu(k,1853) = lu(k,1853) - lu(k,1726) * lu(k,1846) + lu(k,1854) = lu(k,1854) - lu(k,1727) * lu(k,1846) + lu(k,1855) = lu(k,1855) - lu(k,1728) * lu(k,1846) + lu(k,1856) = lu(k,1856) - lu(k,1729) * lu(k,1846) + lu(k,1857) = lu(k,1857) - lu(k,1730) * lu(k,1846) + lu(k,1904) = lu(k,1904) - lu(k,1720) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1721) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1722) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1723) * lu(k,1903) + lu(k,1908) = lu(k,1908) - lu(k,1724) * lu(k,1903) + lu(k,1909) = lu(k,1909) - lu(k,1725) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,1726) * lu(k,1903) + lu(k,1911) = lu(k,1911) - lu(k,1727) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,1728) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1729) * lu(k,1903) + lu(k,1914) = lu(k,1914) - lu(k,1730) * lu(k,1903) + lu(k,1924) = lu(k,1924) - lu(k,1720) * lu(k,1923) + lu(k,1925) = lu(k,1925) - lu(k,1721) * lu(k,1923) + lu(k,1926) = lu(k,1926) - lu(k,1722) * lu(k,1923) + lu(k,1927) = lu(k,1927) - lu(k,1723) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1724) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,1725) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,1726) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,1727) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1728) * lu(k,1923) + lu(k,1933) = lu(k,1933) - lu(k,1729) * lu(k,1923) + lu(k,1934) = lu(k,1934) - lu(k,1730) * lu(k,1923) + lu(k,1946) = lu(k,1946) - lu(k,1720) * lu(k,1945) + lu(k,1947) = lu(k,1947) - lu(k,1721) * lu(k,1945) + lu(k,1948) = lu(k,1948) - lu(k,1722) * lu(k,1945) + lu(k,1949) = lu(k,1949) - lu(k,1723) * lu(k,1945) + lu(k,1950) = lu(k,1950) - lu(k,1724) * lu(k,1945) + lu(k,1951) = lu(k,1951) - lu(k,1725) * lu(k,1945) + lu(k,1952) = lu(k,1952) - lu(k,1726) * lu(k,1945) + lu(k,1953) = lu(k,1953) - lu(k,1727) * lu(k,1945) + lu(k,1954) = lu(k,1954) - lu(k,1728) * lu(k,1945) + lu(k,1955) = lu(k,1955) - lu(k,1729) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,1730) * lu(k,1945) + lu(k,1988) = lu(k,1988) - lu(k,1720) * lu(k,1987) + lu(k,1989) = lu(k,1989) - lu(k,1721) * lu(k,1987) + lu(k,1990) = lu(k,1990) - lu(k,1722) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1723) * lu(k,1987) + lu(k,1992) = lu(k,1992) - lu(k,1724) * lu(k,1987) + lu(k,1993) = lu(k,1993) - lu(k,1725) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1726) * lu(k,1987) + lu(k,1995) = lu(k,1995) - lu(k,1727) * lu(k,1987) + lu(k,1996) = lu(k,1996) - lu(k,1728) * lu(k,1987) + lu(k,1997) = lu(k,1997) - lu(k,1729) * lu(k,1987) + lu(k,1998) = lu(k,1998) - lu(k,1730) * lu(k,1987) + lu(k,2012) = lu(k,2012) - lu(k,1720) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1721) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1722) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1723) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1724) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1725) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1726) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1727) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1728) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1729) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1730) * lu(k,2011) + lu(k,2107) = lu(k,2107) - lu(k,1720) * lu(k,2106) + lu(k,2108) = lu(k,2108) - lu(k,1721) * lu(k,2106) + lu(k,2109) = lu(k,2109) - lu(k,1722) * lu(k,2106) + lu(k,2110) = lu(k,2110) - lu(k,1723) * lu(k,2106) + lu(k,2111) = lu(k,2111) - lu(k,1724) * lu(k,2106) + lu(k,2112) = lu(k,2112) - lu(k,1725) * lu(k,2106) + lu(k,2113) = lu(k,2113) - lu(k,1726) * lu(k,2106) + lu(k,2114) = lu(k,2114) - lu(k,1727) * lu(k,2106) + lu(k,2115) = lu(k,2115) - lu(k,1728) * lu(k,2106) + lu(k,2116) = lu(k,2116) - lu(k,1729) * lu(k,2106) + lu(k,2117) = lu(k,2117) - lu(k,1730) * lu(k,2106) + lu(k,2134) = lu(k,2134) - lu(k,1720) * lu(k,2133) + lu(k,2135) = lu(k,2135) - lu(k,1721) * lu(k,2133) + lu(k,2136) = lu(k,2136) - lu(k,1722) * lu(k,2133) + lu(k,2137) = lu(k,2137) - lu(k,1723) * lu(k,2133) + lu(k,2138) = lu(k,2138) - lu(k,1724) * lu(k,2133) + lu(k,2139) = lu(k,2139) - lu(k,1725) * lu(k,2133) + lu(k,2140) = lu(k,2140) - lu(k,1726) * lu(k,2133) + lu(k,2141) = lu(k,2141) - lu(k,1727) * lu(k,2133) + lu(k,2142) = lu(k,2142) - lu(k,1728) * lu(k,2133) + lu(k,2143) = lu(k,2143) - lu(k,1729) * lu(k,2133) + lu(k,2144) = lu(k,2144) - lu(k,1730) * lu(k,2133) + lu(k,2160) = lu(k,2160) - lu(k,1720) * lu(k,2159) + lu(k,2161) = lu(k,2161) - lu(k,1721) * lu(k,2159) + lu(k,2162) = lu(k,2162) - lu(k,1722) * lu(k,2159) + lu(k,2163) = lu(k,2163) - lu(k,1723) * lu(k,2159) + lu(k,2164) = lu(k,2164) - lu(k,1724) * lu(k,2159) + lu(k,2165) = lu(k,2165) - lu(k,1725) * lu(k,2159) + lu(k,2166) = lu(k,2166) - lu(k,1726) * lu(k,2159) + lu(k,2167) = lu(k,2167) - lu(k,1727) * lu(k,2159) + lu(k,2168) = lu(k,2168) - lu(k,1728) * lu(k,2159) + lu(k,2169) = lu(k,2169) - lu(k,1729) * lu(k,2159) + lu(k,2170) = lu(k,2170) - lu(k,1730) * lu(k,2159) + end do + end subroutine lu_fac28 + subroutine lu_fac29( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1782) = 1._r8 / lu(k,1782) + lu(k,1783) = lu(k,1783) * lu(k,1782) + lu(k,1784) = lu(k,1784) * lu(k,1782) + lu(k,1785) = lu(k,1785) * lu(k,1782) + lu(k,1786) = lu(k,1786) * lu(k,1782) + lu(k,1787) = lu(k,1787) * lu(k,1782) + lu(k,1788) = lu(k,1788) * lu(k,1782) + lu(k,1789) = lu(k,1789) * lu(k,1782) + lu(k,1790) = lu(k,1790) * lu(k,1782) + lu(k,1791) = lu(k,1791) * lu(k,1782) + lu(k,1792) = lu(k,1792) * lu(k,1782) + lu(k,1824) = lu(k,1824) - lu(k,1783) * lu(k,1823) + lu(k,1825) = lu(k,1825) - lu(k,1784) * lu(k,1823) + lu(k,1826) = lu(k,1826) - lu(k,1785) * lu(k,1823) + lu(k,1827) = lu(k,1827) - lu(k,1786) * lu(k,1823) + lu(k,1828) = lu(k,1828) - lu(k,1787) * lu(k,1823) + lu(k,1829) = lu(k,1829) - lu(k,1788) * lu(k,1823) + lu(k,1830) = lu(k,1830) - lu(k,1789) * lu(k,1823) + lu(k,1831) = lu(k,1831) - lu(k,1790) * lu(k,1823) + lu(k,1832) = lu(k,1832) - lu(k,1791) * lu(k,1823) + lu(k,1833) = lu(k,1833) - lu(k,1792) * lu(k,1823) + lu(k,1848) = lu(k,1848) - lu(k,1783) * lu(k,1847) + lu(k,1849) = lu(k,1849) - lu(k,1784) * lu(k,1847) + lu(k,1850) = lu(k,1850) - lu(k,1785) * lu(k,1847) + lu(k,1851) = lu(k,1851) - lu(k,1786) * lu(k,1847) + lu(k,1852) = lu(k,1852) - lu(k,1787) * lu(k,1847) + lu(k,1853) = lu(k,1853) - lu(k,1788) * lu(k,1847) + lu(k,1854) = lu(k,1854) - lu(k,1789) * lu(k,1847) + lu(k,1855) = lu(k,1855) - lu(k,1790) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,1791) * lu(k,1847) + lu(k,1857) = lu(k,1857) - lu(k,1792) * lu(k,1847) + lu(k,1905) = lu(k,1905) - lu(k,1783) * lu(k,1904) + lu(k,1906) = lu(k,1906) - lu(k,1784) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1785) * lu(k,1904) + lu(k,1908) = lu(k,1908) - lu(k,1786) * lu(k,1904) + lu(k,1909) = lu(k,1909) - lu(k,1787) * lu(k,1904) + lu(k,1910) = lu(k,1910) - lu(k,1788) * lu(k,1904) + lu(k,1911) = lu(k,1911) - lu(k,1789) * lu(k,1904) + lu(k,1912) = lu(k,1912) - lu(k,1790) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1791) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,1792) * lu(k,1904) + lu(k,1925) = lu(k,1925) - lu(k,1783) * lu(k,1924) + lu(k,1926) = lu(k,1926) - lu(k,1784) * lu(k,1924) + lu(k,1927) = lu(k,1927) - lu(k,1785) * lu(k,1924) + lu(k,1928) = lu(k,1928) - lu(k,1786) * lu(k,1924) + lu(k,1929) = lu(k,1929) - lu(k,1787) * lu(k,1924) + lu(k,1930) = lu(k,1930) - lu(k,1788) * lu(k,1924) + lu(k,1931) = lu(k,1931) - lu(k,1789) * lu(k,1924) + lu(k,1932) = lu(k,1932) - lu(k,1790) * lu(k,1924) + lu(k,1933) = lu(k,1933) - lu(k,1791) * lu(k,1924) + lu(k,1934) = lu(k,1934) - lu(k,1792) * lu(k,1924) + lu(k,1947) = lu(k,1947) - lu(k,1783) * lu(k,1946) + lu(k,1948) = lu(k,1948) - lu(k,1784) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1785) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,1786) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,1787) * lu(k,1946) + lu(k,1952) = lu(k,1952) - lu(k,1788) * lu(k,1946) + lu(k,1953) = lu(k,1953) - lu(k,1789) * lu(k,1946) + lu(k,1954) = lu(k,1954) - lu(k,1790) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,1791) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,1792) * lu(k,1946) + lu(k,1989) = lu(k,1989) - lu(k,1783) * lu(k,1988) + lu(k,1990) = lu(k,1990) - lu(k,1784) * lu(k,1988) + lu(k,1991) = lu(k,1991) - lu(k,1785) * lu(k,1988) + lu(k,1992) = lu(k,1992) - lu(k,1786) * lu(k,1988) + lu(k,1993) = lu(k,1993) - lu(k,1787) * lu(k,1988) + lu(k,1994) = lu(k,1994) - lu(k,1788) * lu(k,1988) + lu(k,1995) = lu(k,1995) - lu(k,1789) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,1790) * lu(k,1988) + lu(k,1997) = lu(k,1997) - lu(k,1791) * lu(k,1988) + lu(k,1998) = lu(k,1998) - lu(k,1792) * lu(k,1988) + lu(k,2013) = lu(k,2013) - lu(k,1783) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1784) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1785) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1786) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1787) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1788) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1789) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1790) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1791) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1792) * lu(k,2012) + lu(k,2108) = lu(k,2108) - lu(k,1783) * lu(k,2107) + lu(k,2109) = lu(k,2109) - lu(k,1784) * lu(k,2107) + lu(k,2110) = lu(k,2110) - lu(k,1785) * lu(k,2107) + lu(k,2111) = lu(k,2111) - lu(k,1786) * lu(k,2107) + lu(k,2112) = lu(k,2112) - lu(k,1787) * lu(k,2107) + lu(k,2113) = lu(k,2113) - lu(k,1788) * lu(k,2107) + lu(k,2114) = lu(k,2114) - lu(k,1789) * lu(k,2107) + lu(k,2115) = lu(k,2115) - lu(k,1790) * lu(k,2107) + lu(k,2116) = lu(k,2116) - lu(k,1791) * lu(k,2107) + lu(k,2117) = lu(k,2117) - lu(k,1792) * lu(k,2107) + lu(k,2135) = lu(k,2135) - lu(k,1783) * lu(k,2134) + lu(k,2136) = lu(k,2136) - lu(k,1784) * lu(k,2134) + lu(k,2137) = lu(k,2137) - lu(k,1785) * lu(k,2134) + lu(k,2138) = lu(k,2138) - lu(k,1786) * lu(k,2134) + lu(k,2139) = lu(k,2139) - lu(k,1787) * lu(k,2134) + lu(k,2140) = lu(k,2140) - lu(k,1788) * lu(k,2134) + lu(k,2141) = lu(k,2141) - lu(k,1789) * lu(k,2134) + lu(k,2142) = lu(k,2142) - lu(k,1790) * lu(k,2134) + lu(k,2143) = lu(k,2143) - lu(k,1791) * lu(k,2134) + lu(k,2144) = lu(k,2144) - lu(k,1792) * lu(k,2134) + lu(k,2161) = lu(k,2161) - lu(k,1783) * lu(k,2160) + lu(k,2162) = lu(k,2162) - lu(k,1784) * lu(k,2160) + lu(k,2163) = lu(k,2163) - lu(k,1785) * lu(k,2160) + lu(k,2164) = lu(k,2164) - lu(k,1786) * lu(k,2160) + lu(k,2165) = lu(k,2165) - lu(k,1787) * lu(k,2160) + lu(k,2166) = lu(k,2166) - lu(k,1788) * lu(k,2160) + lu(k,2167) = lu(k,2167) - lu(k,1789) * lu(k,2160) + lu(k,2168) = lu(k,2168) - lu(k,1790) * lu(k,2160) + lu(k,2169) = lu(k,2169) - lu(k,1791) * lu(k,2160) + lu(k,2170) = lu(k,2170) - lu(k,1792) * lu(k,2160) + lu(k,1824) = 1._r8 / lu(k,1824) + lu(k,1825) = lu(k,1825) * lu(k,1824) + lu(k,1826) = lu(k,1826) * lu(k,1824) + lu(k,1827) = lu(k,1827) * lu(k,1824) + lu(k,1828) = lu(k,1828) * lu(k,1824) + lu(k,1829) = lu(k,1829) * lu(k,1824) + lu(k,1830) = lu(k,1830) * lu(k,1824) + lu(k,1831) = lu(k,1831) * lu(k,1824) + lu(k,1832) = lu(k,1832) * lu(k,1824) + lu(k,1833) = lu(k,1833) * lu(k,1824) + lu(k,1849) = lu(k,1849) - lu(k,1825) * lu(k,1848) + lu(k,1850) = lu(k,1850) - lu(k,1826) * lu(k,1848) + lu(k,1851) = lu(k,1851) - lu(k,1827) * lu(k,1848) + lu(k,1852) = lu(k,1852) - lu(k,1828) * lu(k,1848) + lu(k,1853) = lu(k,1853) - lu(k,1829) * lu(k,1848) + lu(k,1854) = lu(k,1854) - lu(k,1830) * lu(k,1848) + lu(k,1855) = lu(k,1855) - lu(k,1831) * lu(k,1848) + lu(k,1856) = lu(k,1856) - lu(k,1832) * lu(k,1848) + lu(k,1857) = lu(k,1857) - lu(k,1833) * lu(k,1848) + lu(k,1906) = lu(k,1906) - lu(k,1825) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1826) * lu(k,1905) + lu(k,1908) = lu(k,1908) - lu(k,1827) * lu(k,1905) + lu(k,1909) = lu(k,1909) - lu(k,1828) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,1829) * lu(k,1905) + lu(k,1911) = lu(k,1911) - lu(k,1830) * lu(k,1905) + lu(k,1912) = lu(k,1912) - lu(k,1831) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1832) * lu(k,1905) + lu(k,1914) = lu(k,1914) - lu(k,1833) * lu(k,1905) + lu(k,1926) = lu(k,1926) - lu(k,1825) * lu(k,1925) + lu(k,1927) = lu(k,1927) - lu(k,1826) * lu(k,1925) + lu(k,1928) = lu(k,1928) - lu(k,1827) * lu(k,1925) + lu(k,1929) = lu(k,1929) - lu(k,1828) * lu(k,1925) + lu(k,1930) = lu(k,1930) - lu(k,1829) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,1830) * lu(k,1925) + lu(k,1932) = lu(k,1932) - lu(k,1831) * lu(k,1925) + lu(k,1933) = lu(k,1933) - lu(k,1832) * lu(k,1925) + lu(k,1934) = lu(k,1934) - lu(k,1833) * lu(k,1925) + lu(k,1948) = lu(k,1948) - lu(k,1825) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1826) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1827) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1828) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1829) * lu(k,1947) + lu(k,1953) = lu(k,1953) - lu(k,1830) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,1831) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,1832) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1833) * lu(k,1947) + lu(k,1990) = lu(k,1990) - lu(k,1825) * lu(k,1989) + lu(k,1991) = lu(k,1991) - lu(k,1826) * lu(k,1989) + lu(k,1992) = lu(k,1992) - lu(k,1827) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1828) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1829) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1830) * lu(k,1989) + lu(k,1996) = lu(k,1996) - lu(k,1831) * lu(k,1989) + lu(k,1997) = lu(k,1997) - lu(k,1832) * lu(k,1989) + lu(k,1998) = lu(k,1998) - lu(k,1833) * lu(k,1989) + lu(k,2014) = lu(k,2014) - lu(k,1825) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1826) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1827) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1828) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1829) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1830) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1831) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1832) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1833) * lu(k,2013) + lu(k,2109) = lu(k,2109) - lu(k,1825) * lu(k,2108) + lu(k,2110) = lu(k,2110) - lu(k,1826) * lu(k,2108) + lu(k,2111) = lu(k,2111) - lu(k,1827) * lu(k,2108) + lu(k,2112) = lu(k,2112) - lu(k,1828) * lu(k,2108) + lu(k,2113) = lu(k,2113) - lu(k,1829) * lu(k,2108) + lu(k,2114) = lu(k,2114) - lu(k,1830) * lu(k,2108) + lu(k,2115) = lu(k,2115) - lu(k,1831) * lu(k,2108) + lu(k,2116) = lu(k,2116) - lu(k,1832) * lu(k,2108) + lu(k,2117) = lu(k,2117) - lu(k,1833) * lu(k,2108) + lu(k,2136) = lu(k,2136) - lu(k,1825) * lu(k,2135) + lu(k,2137) = lu(k,2137) - lu(k,1826) * lu(k,2135) + lu(k,2138) = lu(k,2138) - lu(k,1827) * lu(k,2135) + lu(k,2139) = lu(k,2139) - lu(k,1828) * lu(k,2135) + lu(k,2140) = lu(k,2140) - lu(k,1829) * lu(k,2135) + lu(k,2141) = lu(k,2141) - lu(k,1830) * lu(k,2135) + lu(k,2142) = lu(k,2142) - lu(k,1831) * lu(k,2135) + lu(k,2143) = lu(k,2143) - lu(k,1832) * lu(k,2135) + lu(k,2144) = lu(k,2144) - lu(k,1833) * lu(k,2135) + lu(k,2162) = lu(k,2162) - lu(k,1825) * lu(k,2161) + lu(k,2163) = lu(k,2163) - lu(k,1826) * lu(k,2161) + lu(k,2164) = lu(k,2164) - lu(k,1827) * lu(k,2161) + lu(k,2165) = lu(k,2165) - lu(k,1828) * lu(k,2161) + lu(k,2166) = lu(k,2166) - lu(k,1829) * lu(k,2161) + lu(k,2167) = lu(k,2167) - lu(k,1830) * lu(k,2161) + lu(k,2168) = lu(k,2168) - lu(k,1831) * lu(k,2161) + lu(k,2169) = lu(k,2169) - lu(k,1832) * lu(k,2161) + lu(k,2170) = lu(k,2170) - lu(k,1833) * lu(k,2161) + lu(k,1849) = 1._r8 / lu(k,1849) + lu(k,1850) = lu(k,1850) * lu(k,1849) + lu(k,1851) = lu(k,1851) * lu(k,1849) + lu(k,1852) = lu(k,1852) * lu(k,1849) + lu(k,1853) = lu(k,1853) * lu(k,1849) + lu(k,1854) = lu(k,1854) * lu(k,1849) + lu(k,1855) = lu(k,1855) * lu(k,1849) + lu(k,1856) = lu(k,1856) * lu(k,1849) + lu(k,1857) = lu(k,1857) * lu(k,1849) + lu(k,1907) = lu(k,1907) - lu(k,1850) * lu(k,1906) + lu(k,1908) = lu(k,1908) - lu(k,1851) * lu(k,1906) + lu(k,1909) = lu(k,1909) - lu(k,1852) * lu(k,1906) + lu(k,1910) = lu(k,1910) - lu(k,1853) * lu(k,1906) + lu(k,1911) = lu(k,1911) - lu(k,1854) * lu(k,1906) + lu(k,1912) = lu(k,1912) - lu(k,1855) * lu(k,1906) + lu(k,1913) = lu(k,1913) - lu(k,1856) * lu(k,1906) + lu(k,1914) = lu(k,1914) - lu(k,1857) * lu(k,1906) + lu(k,1927) = lu(k,1927) - lu(k,1850) * lu(k,1926) + lu(k,1928) = lu(k,1928) - lu(k,1851) * lu(k,1926) + lu(k,1929) = lu(k,1929) - lu(k,1852) * lu(k,1926) + lu(k,1930) = lu(k,1930) - lu(k,1853) * lu(k,1926) + lu(k,1931) = lu(k,1931) - lu(k,1854) * lu(k,1926) + lu(k,1932) = lu(k,1932) - lu(k,1855) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,1856) * lu(k,1926) + lu(k,1934) = lu(k,1934) - lu(k,1857) * lu(k,1926) + lu(k,1949) = lu(k,1949) - lu(k,1850) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1851) * lu(k,1948) + lu(k,1951) = lu(k,1951) - lu(k,1852) * lu(k,1948) + lu(k,1952) = lu(k,1952) - lu(k,1853) * lu(k,1948) + lu(k,1953) = lu(k,1953) - lu(k,1854) * lu(k,1948) + lu(k,1954) = lu(k,1954) - lu(k,1855) * lu(k,1948) + lu(k,1955) = lu(k,1955) - lu(k,1856) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,1857) * lu(k,1948) + lu(k,1991) = lu(k,1991) - lu(k,1850) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1851) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1852) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1853) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,1854) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,1855) * lu(k,1990) + lu(k,1997) = lu(k,1997) - lu(k,1856) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1857) * lu(k,1990) + lu(k,2015) = lu(k,2015) - lu(k,1850) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1851) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1852) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1853) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1854) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1855) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1856) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1857) * lu(k,2014) + lu(k,2110) = lu(k,2110) - lu(k,1850) * lu(k,2109) + lu(k,2111) = lu(k,2111) - lu(k,1851) * lu(k,2109) + lu(k,2112) = lu(k,2112) - lu(k,1852) * lu(k,2109) + lu(k,2113) = lu(k,2113) - lu(k,1853) * lu(k,2109) + lu(k,2114) = lu(k,2114) - lu(k,1854) * lu(k,2109) + lu(k,2115) = lu(k,2115) - lu(k,1855) * lu(k,2109) + lu(k,2116) = lu(k,2116) - lu(k,1856) * lu(k,2109) + lu(k,2117) = lu(k,2117) - lu(k,1857) * lu(k,2109) + lu(k,2137) = lu(k,2137) - lu(k,1850) * lu(k,2136) + lu(k,2138) = lu(k,2138) - lu(k,1851) * lu(k,2136) + lu(k,2139) = lu(k,2139) - lu(k,1852) * lu(k,2136) + lu(k,2140) = lu(k,2140) - lu(k,1853) * lu(k,2136) + lu(k,2141) = lu(k,2141) - lu(k,1854) * lu(k,2136) + lu(k,2142) = lu(k,2142) - lu(k,1855) * lu(k,2136) + lu(k,2143) = lu(k,2143) - lu(k,1856) * lu(k,2136) + lu(k,2144) = lu(k,2144) - lu(k,1857) * lu(k,2136) + lu(k,2163) = lu(k,2163) - lu(k,1850) * lu(k,2162) + lu(k,2164) = lu(k,2164) - lu(k,1851) * lu(k,2162) + lu(k,2165) = lu(k,2165) - lu(k,1852) * lu(k,2162) + lu(k,2166) = lu(k,2166) - lu(k,1853) * lu(k,2162) + lu(k,2167) = lu(k,2167) - lu(k,1854) * lu(k,2162) + lu(k,2168) = lu(k,2168) - lu(k,1855) * lu(k,2162) + lu(k,2169) = lu(k,2169) - lu(k,1856) * lu(k,2162) + lu(k,2170) = lu(k,2170) - lu(k,1857) * lu(k,2162) + lu(k,1907) = 1._r8 / lu(k,1907) + lu(k,1908) = lu(k,1908) * lu(k,1907) + lu(k,1909) = lu(k,1909) * lu(k,1907) + lu(k,1910) = lu(k,1910) * lu(k,1907) + lu(k,1911) = lu(k,1911) * lu(k,1907) + lu(k,1912) = lu(k,1912) * lu(k,1907) + lu(k,1913) = lu(k,1913) * lu(k,1907) + lu(k,1914) = lu(k,1914) * lu(k,1907) + lu(k,1928) = lu(k,1928) - lu(k,1908) * lu(k,1927) + lu(k,1929) = lu(k,1929) - lu(k,1909) * lu(k,1927) + lu(k,1930) = lu(k,1930) - lu(k,1910) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1911) * lu(k,1927) + lu(k,1932) = lu(k,1932) - lu(k,1912) * lu(k,1927) + lu(k,1933) = lu(k,1933) - lu(k,1913) * lu(k,1927) + lu(k,1934) = lu(k,1934) - lu(k,1914) * lu(k,1927) + lu(k,1950) = lu(k,1950) - lu(k,1908) * lu(k,1949) + lu(k,1951) = lu(k,1951) - lu(k,1909) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,1910) * lu(k,1949) + lu(k,1953) = lu(k,1953) - lu(k,1911) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1912) * lu(k,1949) + lu(k,1955) = lu(k,1955) - lu(k,1913) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1914) * lu(k,1949) + lu(k,1992) = lu(k,1992) - lu(k,1908) * lu(k,1991) + lu(k,1993) = lu(k,1993) - lu(k,1909) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1910) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1911) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,1912) * lu(k,1991) + lu(k,1997) = lu(k,1997) - lu(k,1913) * lu(k,1991) + lu(k,1998) = lu(k,1998) - lu(k,1914) * lu(k,1991) + lu(k,2016) = lu(k,2016) - lu(k,1908) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1909) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1910) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1911) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1912) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1913) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1914) * lu(k,2015) + lu(k,2111) = lu(k,2111) - lu(k,1908) * lu(k,2110) + lu(k,2112) = lu(k,2112) - lu(k,1909) * lu(k,2110) + lu(k,2113) = lu(k,2113) - lu(k,1910) * lu(k,2110) + lu(k,2114) = lu(k,2114) - lu(k,1911) * lu(k,2110) + lu(k,2115) = lu(k,2115) - lu(k,1912) * lu(k,2110) + lu(k,2116) = lu(k,2116) - lu(k,1913) * lu(k,2110) + lu(k,2117) = lu(k,2117) - lu(k,1914) * lu(k,2110) + lu(k,2138) = lu(k,2138) - lu(k,1908) * lu(k,2137) + lu(k,2139) = lu(k,2139) - lu(k,1909) * lu(k,2137) + lu(k,2140) = lu(k,2140) - lu(k,1910) * lu(k,2137) + lu(k,2141) = lu(k,2141) - lu(k,1911) * lu(k,2137) + lu(k,2142) = lu(k,2142) - lu(k,1912) * lu(k,2137) + lu(k,2143) = lu(k,2143) - lu(k,1913) * lu(k,2137) + lu(k,2144) = lu(k,2144) - lu(k,1914) * lu(k,2137) + lu(k,2164) = lu(k,2164) - lu(k,1908) * lu(k,2163) + lu(k,2165) = lu(k,2165) - lu(k,1909) * lu(k,2163) + lu(k,2166) = lu(k,2166) - lu(k,1910) * lu(k,2163) + lu(k,2167) = lu(k,2167) - lu(k,1911) * lu(k,2163) + lu(k,2168) = lu(k,2168) - lu(k,1912) * lu(k,2163) + lu(k,2169) = lu(k,2169) - lu(k,1913) * lu(k,2163) + lu(k,2170) = lu(k,2170) - lu(k,1914) * lu(k,2163) + lu(k,1928) = 1._r8 / lu(k,1928) + lu(k,1929) = lu(k,1929) * lu(k,1928) + lu(k,1930) = lu(k,1930) * lu(k,1928) + lu(k,1931) = lu(k,1931) * lu(k,1928) + lu(k,1932) = lu(k,1932) * lu(k,1928) + lu(k,1933) = lu(k,1933) * lu(k,1928) + lu(k,1934) = lu(k,1934) * lu(k,1928) + lu(k,1951) = lu(k,1951) - lu(k,1929) * lu(k,1950) + lu(k,1952) = lu(k,1952) - lu(k,1930) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,1931) * lu(k,1950) + lu(k,1954) = lu(k,1954) - lu(k,1932) * lu(k,1950) + lu(k,1955) = lu(k,1955) - lu(k,1933) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1934) * lu(k,1950) + lu(k,1993) = lu(k,1993) - lu(k,1929) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1930) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1931) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,1932) * lu(k,1992) + lu(k,1997) = lu(k,1997) - lu(k,1933) * lu(k,1992) + lu(k,1998) = lu(k,1998) - lu(k,1934) * lu(k,1992) + lu(k,2017) = lu(k,2017) - lu(k,1929) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1930) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1931) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1932) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1933) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1934) * lu(k,2016) + lu(k,2112) = lu(k,2112) - lu(k,1929) * lu(k,2111) + lu(k,2113) = lu(k,2113) - lu(k,1930) * lu(k,2111) + lu(k,2114) = lu(k,2114) - lu(k,1931) * lu(k,2111) + lu(k,2115) = lu(k,2115) - lu(k,1932) * lu(k,2111) + lu(k,2116) = lu(k,2116) - lu(k,1933) * lu(k,2111) + lu(k,2117) = lu(k,2117) - lu(k,1934) * lu(k,2111) + lu(k,2139) = lu(k,2139) - lu(k,1929) * lu(k,2138) + lu(k,2140) = lu(k,2140) - lu(k,1930) * lu(k,2138) + lu(k,2141) = lu(k,2141) - lu(k,1931) * lu(k,2138) + lu(k,2142) = lu(k,2142) - lu(k,1932) * lu(k,2138) + lu(k,2143) = lu(k,2143) - lu(k,1933) * lu(k,2138) + lu(k,2144) = lu(k,2144) - lu(k,1934) * lu(k,2138) + lu(k,2165) = lu(k,2165) - lu(k,1929) * lu(k,2164) + lu(k,2166) = lu(k,2166) - lu(k,1930) * lu(k,2164) + lu(k,2167) = lu(k,2167) - lu(k,1931) * lu(k,2164) + lu(k,2168) = lu(k,2168) - lu(k,1932) * lu(k,2164) + lu(k,2169) = lu(k,2169) - lu(k,1933) * lu(k,2164) + lu(k,2170) = lu(k,2170) - lu(k,1934) * lu(k,2164) + lu(k,1951) = 1._r8 / lu(k,1951) + lu(k,1952) = lu(k,1952) * lu(k,1951) + lu(k,1953) = lu(k,1953) * lu(k,1951) + lu(k,1954) = lu(k,1954) * lu(k,1951) + lu(k,1955) = lu(k,1955) * lu(k,1951) + lu(k,1956) = lu(k,1956) * lu(k,1951) + lu(k,1994) = lu(k,1994) - lu(k,1952) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,1953) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,1954) * lu(k,1993) + lu(k,1997) = lu(k,1997) - lu(k,1955) * lu(k,1993) + lu(k,1998) = lu(k,1998) - lu(k,1956) * lu(k,1993) + lu(k,2018) = lu(k,2018) - lu(k,1952) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1953) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1954) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1955) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1956) * lu(k,2017) + lu(k,2113) = lu(k,2113) - lu(k,1952) * lu(k,2112) + lu(k,2114) = lu(k,2114) - lu(k,1953) * lu(k,2112) + lu(k,2115) = lu(k,2115) - lu(k,1954) * lu(k,2112) + lu(k,2116) = lu(k,2116) - lu(k,1955) * lu(k,2112) + lu(k,2117) = lu(k,2117) - lu(k,1956) * lu(k,2112) + lu(k,2140) = lu(k,2140) - lu(k,1952) * lu(k,2139) + lu(k,2141) = lu(k,2141) - lu(k,1953) * lu(k,2139) + lu(k,2142) = lu(k,2142) - lu(k,1954) * lu(k,2139) + lu(k,2143) = lu(k,2143) - lu(k,1955) * lu(k,2139) + lu(k,2144) = lu(k,2144) - lu(k,1956) * lu(k,2139) + lu(k,2166) = lu(k,2166) - lu(k,1952) * lu(k,2165) + lu(k,2167) = lu(k,2167) - lu(k,1953) * lu(k,2165) + lu(k,2168) = lu(k,2168) - lu(k,1954) * lu(k,2165) + lu(k,2169) = lu(k,2169) - lu(k,1955) * lu(k,2165) + lu(k,2170) = lu(k,2170) - lu(k,1956) * lu(k,2165) + end do + end subroutine lu_fac29 + subroutine lu_fac30( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1994) = 1._r8 / lu(k,1994) + lu(k,1995) = lu(k,1995) * lu(k,1994) + lu(k,1996) = lu(k,1996) * lu(k,1994) + lu(k,1997) = lu(k,1997) * lu(k,1994) + lu(k,1998) = lu(k,1998) * lu(k,1994) + lu(k,2019) = lu(k,2019) - lu(k,1995) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1996) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1997) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1998) * lu(k,2018) + lu(k,2114) = lu(k,2114) - lu(k,1995) * lu(k,2113) + lu(k,2115) = lu(k,2115) - lu(k,1996) * lu(k,2113) + lu(k,2116) = lu(k,2116) - lu(k,1997) * lu(k,2113) + lu(k,2117) = lu(k,2117) - lu(k,1998) * lu(k,2113) + lu(k,2141) = lu(k,2141) - lu(k,1995) * lu(k,2140) + lu(k,2142) = lu(k,2142) - lu(k,1996) * lu(k,2140) + lu(k,2143) = lu(k,2143) - lu(k,1997) * lu(k,2140) + lu(k,2144) = lu(k,2144) - lu(k,1998) * lu(k,2140) + lu(k,2167) = lu(k,2167) - lu(k,1995) * lu(k,2166) + lu(k,2168) = lu(k,2168) - lu(k,1996) * lu(k,2166) + lu(k,2169) = lu(k,2169) - lu(k,1997) * lu(k,2166) + lu(k,2170) = lu(k,2170) - lu(k,1998) * lu(k,2166) + lu(k,2019) = 1._r8 / lu(k,2019) + lu(k,2020) = lu(k,2020) * lu(k,2019) + lu(k,2021) = lu(k,2021) * lu(k,2019) + lu(k,2022) = lu(k,2022) * lu(k,2019) + lu(k,2115) = lu(k,2115) - lu(k,2020) * lu(k,2114) + lu(k,2116) = lu(k,2116) - lu(k,2021) * lu(k,2114) + lu(k,2117) = lu(k,2117) - lu(k,2022) * lu(k,2114) + lu(k,2142) = lu(k,2142) - lu(k,2020) * lu(k,2141) + lu(k,2143) = lu(k,2143) - lu(k,2021) * lu(k,2141) + lu(k,2144) = lu(k,2144) - lu(k,2022) * lu(k,2141) + lu(k,2168) = lu(k,2168) - lu(k,2020) * lu(k,2167) + lu(k,2169) = lu(k,2169) - lu(k,2021) * lu(k,2167) + lu(k,2170) = lu(k,2170) - lu(k,2022) * lu(k,2167) + lu(k,2115) = 1._r8 / lu(k,2115) + lu(k,2116) = lu(k,2116) * lu(k,2115) + lu(k,2117) = lu(k,2117) * lu(k,2115) + lu(k,2143) = lu(k,2143) - lu(k,2116) * lu(k,2142) + lu(k,2144) = lu(k,2144) - lu(k,2117) * lu(k,2142) + lu(k,2169) = lu(k,2169) - lu(k,2116) * lu(k,2168) + lu(k,2170) = lu(k,2170) - lu(k,2117) * lu(k,2168) + lu(k,2143) = 1._r8 / lu(k,2143) + lu(k,2144) = lu(k,2144) * lu(k,2143) + lu(k,2170) = lu(k,2170) - lu(k,2144) * lu(k,2169) + lu(k,2170) = 1._r8 / lu(k,2170) + end do + end subroutine lu_fac30 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + call lu_fac11( avec_len, lu ) + call lu_fac12( avec_len, lu ) + call lu_fac13( avec_len, lu ) + call lu_fac14( avec_len, lu ) + call lu_fac15( avec_len, lu ) + call lu_fac16( avec_len, lu ) + call lu_fac17( avec_len, lu ) + call lu_fac18( avec_len, lu ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..8af64dbcbd --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 @@ -0,0 +1,2421 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,188) = b(k,188) - lu(k,47) * b(k,36) + b(k,200) = b(k,200) - lu(k,48) * b(k,36) + b(k,190) = b(k,190) - lu(k,50) * b(k,37) + b(k,201) = b(k,201) - lu(k,51) * b(k,37) + b(k,190) = b(k,190) - lu(k,53) * b(k,38) + b(k,199) = b(k,199) - lu(k,54) * b(k,38) + b(k,143) = b(k,143) - lu(k,56) * b(k,39) + b(k,190) = b(k,190) - lu(k,57) * b(k,39) + b(k,201) = b(k,201) - lu(k,58) * b(k,39) + b(k,136) = b(k,136) - lu(k,60) * b(k,40) + b(k,189) = b(k,189) - lu(k,61) * b(k,40) + b(k,96) = b(k,96) - lu(k,63) * b(k,41) + b(k,190) = b(k,190) - lu(k,64) * b(k,41) + b(k,65) = b(k,65) - lu(k,66) * b(k,42) + b(k,201) = b(k,201) - lu(k,67) * b(k,42) + b(k,171) = b(k,171) - lu(k,69) * b(k,43) + b(k,190) = b(k,190) - lu(k,70) * b(k,43) + b(k,104) = b(k,104) - lu(k,72) * b(k,44) + b(k,197) = b(k,197) - lu(k,73) * b(k,44) + b(k,186) = b(k,186) - lu(k,75) * b(k,45) + b(k,186) = b(k,186) - lu(k,78) * b(k,46) + b(k,188) = b(k,188) - lu(k,80) * b(k,47) + b(k,49) = b(k,49) - lu(k,87) * b(k,48) + b(k,50) = b(k,50) - lu(k,88) * b(k,48) + b(k,101) = b(k,101) - lu(k,89) * b(k,48) + b(k,190) = b(k,190) - lu(k,90) * b(k,48) + b(k,199) = b(k,199) - lu(k,91) * b(k,48) + b(k,95) = b(k,95) - lu(k,93) * b(k,49) + b(k,165) = b(k,165) - lu(k,94) * b(k,49) + b(k,199) = b(k,199) - lu(k,95) * b(k,49) + b(k,94) = b(k,94) - lu(k,97) * b(k,50) + b(k,98) = b(k,98) - lu(k,98) * b(k,50) + b(k,190) = b(k,190) - lu(k,99) * b(k,50) + b(k,199) = b(k,199) - lu(k,100) * b(k,50) + b(k,136) = b(k,136) - lu(k,102) * b(k,51) + b(k,188) = b(k,188) - lu(k,103) * b(k,51) + b(k,189) = b(k,189) - lu(k,104) * b(k,51) + b(k,189) = b(k,189) - lu(k,106) * b(k,52) + b(k,190) = b(k,190) - lu(k,107) * b(k,52) + b(k,199) = b(k,199) - lu(k,108) * b(k,52) + b(k,54) = b(k,54) - lu(k,115) * b(k,53) + b(k,55) = b(k,55) - lu(k,116) * b(k,53) + b(k,92) = b(k,92) - lu(k,117) * b(k,53) + b(k,131) = b(k,131) - lu(k,118) * b(k,53) + b(k,190) = b(k,190) - lu(k,119) * b(k,53) + b(k,199) = b(k,199) - lu(k,120) * b(k,53) + b(k,94) = b(k,94) - lu(k,122) * b(k,54) + b(k,98) = b(k,98) - lu(k,123) * b(k,54) + b(k,190) = b(k,190) - lu(k,124) * b(k,54) + b(k,199) = b(k,199) - lu(k,125) * b(k,54) + b(k,165) = b(k,165) - lu(k,127) * b(k,55) + b(k,181) = b(k,181) - lu(k,128) * b(k,55) + b(k,199) = b(k,199) - lu(k,129) * b(k,55) + b(k,171) = b(k,171) - lu(k,131) * b(k,56) + b(k,190) = b(k,190) - lu(k,132) * b(k,56) + b(k,58) = b(k,58) - lu(k,140) * b(k,57) + b(k,92) = b(k,92) - lu(k,141) * b(k,57) + b(k,132) = b(k,132) - lu(k,142) * b(k,57) + b(k,165) = b(k,165) - lu(k,143) * b(k,57) + b(k,181) = b(k,181) - lu(k,144) * b(k,57) + b(k,190) = b(k,190) - lu(k,145) * b(k,57) + b(k,199) = b(k,199) - lu(k,146) * b(k,57) + b(k,98) = b(k,98) - lu(k,148) * b(k,58) + b(k,103) = b(k,103) - lu(k,149) * b(k,58) + b(k,190) = b(k,190) - lu(k,150) * b(k,58) + b(k,199) = b(k,199) - lu(k,151) * b(k,58) + b(k,136) = b(k,136) - lu(k,153) * b(k,59) + b(k,195) = b(k,195) - lu(k,154) * b(k,59) + b(k,118) = b(k,118) - lu(k,156) * b(k,60) + b(k,171) = b(k,171) - lu(k,157) * b(k,60) + b(k,190) = b(k,190) - lu(k,158) * b(k,60) + b(k,199) = b(k,199) - lu(k,159) * b(k,60) + b(k,196) = b(k,196) - lu(k,161) * b(k,61) + b(k,197) = b(k,197) - lu(k,162) * b(k,61) + b(k,154) = b(k,154) - lu(k,164) * b(k,62) + b(k,190) = b(k,190) - lu(k,165) * b(k,62) + b(k,184) = b(k,184) - lu(k,167) * b(k,63) + b(k,188) = b(k,188) - lu(k,168) * b(k,63) + b(k,104) = b(k,104) - lu(k,170) * b(k,64) + b(k,190) = b(k,190) - lu(k,171) * b(k,64) + b(k,155) = b(k,155) - lu(k,174) * b(k,65) + b(k,192) = b(k,192) - lu(k,175) * b(k,65) + b(k,201) = b(k,201) - lu(k,176) * b(k,65) + b(k,170) = b(k,170) - lu(k,178) * b(k,66) + b(k,190) = b(k,190) - lu(k,179) * b(k,66) + b(k,199) = b(k,199) - lu(k,180) * b(k,66) + b(k,98) = b(k,98) - lu(k,182) * b(k,67) + b(k,122) = b(k,122) - lu(k,183) * b(k,67) + b(k,190) = b(k,190) - lu(k,184) * b(k,67) + b(k,187) = b(k,187) - lu(k,186) * b(k,68) + b(k,192) = b(k,192) - lu(k,187) * b(k,68) + b(k,194) = b(k,194) - lu(k,188) * b(k,68) + b(k,196) = b(k,196) - lu(k,189) * b(k,68) + b(k,197) = b(k,197) - lu(k,190) * b(k,68) + b(k,155) = b(k,155) - lu(k,192) * b(k,69) + b(k,190) = b(k,190) - lu(k,193) * b(k,69) + b(k,194) = b(k,194) - lu(k,194) * b(k,69) + b(k,196) = b(k,196) - lu(k,195) * b(k,69) + b(k,199) = b(k,199) - lu(k,196) * b(k,69) + b(k,133) = b(k,133) - lu(k,198) * b(k,70) + b(k,199) = b(k,199) - lu(k,199) * b(k,70) + b(k,141) = b(k,141) - lu(k,201) * b(k,71) + b(k,149) = b(k,149) - lu(k,202) * b(k,71) + b(k,165) = b(k,165) - lu(k,203) * b(k,71) + b(k,190) = b(k,190) - lu(k,204) * b(k,71) + b(k,199) = b(k,199) - lu(k,205) * b(k,71) + b(k,152) = b(k,152) - lu(k,207) * b(k,72) + b(k,183) = b(k,183) - lu(k,208) * b(k,72) + b(k,188) = b(k,188) - lu(k,209) * b(k,72) + b(k,190) = b(k,190) - lu(k,210) * b(k,72) + b(k,201) = b(k,201) - lu(k,211) * b(k,72) + b(k,171) = b(k,171) - lu(k,213) * b(k,73) + b(k,190) = b(k,190) - lu(k,214) * b(k,73) + b(k,178) = b(k,178) - lu(k,216) * b(k,74) + b(k,180) = b(k,180) - lu(k,217) * b(k,74) + b(k,190) = b(k,190) - lu(k,218) * b(k,74) + b(k,199) = b(k,199) - lu(k,219) * b(k,74) + b(k,125) = b(k,125) - lu(k,221) * b(k,75) + b(k,170) = b(k,170) - lu(k,222) * b(k,75) + b(k,181) = b(k,181) - lu(k,223) * b(k,75) + b(k,190) = b(k,190) - lu(k,224) * b(k,75) + b(k,165) = b(k,165) - lu(k,226) * b(k,76) + b(k,175) = b(k,175) - lu(k,227) * b(k,76) + b(k,181) = b(k,181) - lu(k,228) * b(k,76) + b(k,199) = b(k,199) - lu(k,229) * b(k,76) + b(k,155) = b(k,155) - lu(k,231) * b(k,77) + b(k,182) = b(k,182) - lu(k,232) * b(k,77) + b(k,192) = b(k,192) - lu(k,233) * b(k,77) + b(k,200) = b(k,200) - lu(k,234) * b(k,77) + b(k,94) = b(k,94) - lu(k,236) * b(k,78) + b(k,149) = b(k,149) - lu(k,237) * b(k,78) + b(k,190) = b(k,190) - lu(k,238) * b(k,78) + b(k,199) = b(k,199) - lu(k,239) * b(k,78) + b(k,92) = b(k,92) - lu(k,242) * b(k,79) + b(k,104) = b(k,104) - lu(k,243) * b(k,79) + b(k,190) = b(k,190) - lu(k,244) * b(k,79) + b(k,199) = b(k,199) - lu(k,245) * b(k,79) + b(k,152) = b(k,152) - lu(k,247) * b(k,80) + b(k,170) = b(k,170) - lu(k,248) * b(k,80) + b(k,190) = b(k,190) - lu(k,249) * b(k,80) + b(k,199) = b(k,199) - lu(k,250) * b(k,80) + b(k,129) = b(k,129) - lu(k,252) * b(k,81) + b(k,155) = b(k,155) - lu(k,253) * b(k,81) + b(k,165) = b(k,165) - lu(k,254) * b(k,81) + b(k,182) = b(k,182) - lu(k,255) * b(k,81) + b(k,190) = b(k,190) - lu(k,256) * b(k,81) + b(k,192) = b(k,192) - lu(k,257) * b(k,81) + b(k,195) = b(k,195) - lu(k,258) * b(k,81) + b(k,113) = b(k,113) - lu(k,260) * b(k,82) + b(k,156) = b(k,156) - lu(k,261) * b(k,82) + b(k,170) = b(k,170) - lu(k,262) * b(k,82) + b(k,190) = b(k,190) - lu(k,263) * b(k,82) + b(k,193) = b(k,193) - lu(k,264) * b(k,82) + b(k,194) = b(k,194) - lu(k,265) * b(k,82) + b(k,197) = b(k,197) - lu(k,266) * b(k,82) + b(k,147) = b(k,147) - lu(k,268) * b(k,83) + b(k,161) = b(k,161) - lu(k,269) * b(k,83) + b(k,190) = b(k,190) - lu(k,270) * b(k,83) + b(k,196) = b(k,196) - lu(k,271) * b(k,83) + b(k,199) = b(k,199) - lu(k,272) * b(k,83) + b(k,95) = b(k,95) - lu(k,274) * b(k,84) + b(k,101) = b(k,101) - lu(k,275) * b(k,84) + b(k,149) = b(k,149) - lu(k,276) * b(k,84) + b(k,190) = b(k,190) - lu(k,277) * b(k,84) + b(k,199) = b(k,199) - lu(k,278) * b(k,84) + b(k,149) = b(k,149) - lu(k,280) * b(k,85) + b(k,165) = b(k,165) - lu(k,281) * b(k,85) + b(k,175) = b(k,175) - lu(k,282) * b(k,85) + b(k,181) = b(k,181) - lu(k,283) * b(k,85) + b(k,199) = b(k,199) - lu(k,284) * b(k,85) + b(k,158) = b(k,158) - lu(k,286) * b(k,86) + b(k,168) = b(k,168) - lu(k,287) * b(k,86) + b(k,190) = b(k,190) - lu(k,288) * b(k,86) + b(k,196) = b(k,196) - lu(k,289) * b(k,86) + b(k,197) = b(k,197) - lu(k,290) * b(k,86) + b(k,169) = b(k,169) - lu(k,292) * b(k,87) + b(k,181) = b(k,181) - lu(k,293) * b(k,87) + b(k,190) = b(k,190) - lu(k,294) * b(k,87) + b(k,193) = b(k,193) - lu(k,295) * b(k,87) + b(k,201) = b(k,201) - lu(k,296) * b(k,87) + b(k,127) = b(k,127) - lu(k,298) * b(k,88) + b(k,147) = b(k,147) - lu(k,299) * b(k,88) + b(k,190) = b(k,190) - lu(k,300) * b(k,88) + b(k,197) = b(k,197) - lu(k,301) * b(k,88) + b(k,199) = b(k,199) - lu(k,302) * b(k,88) + b(k,143) = b(k,143) - lu(k,304) * b(k,89) + b(k,156) = b(k,156) - lu(k,305) * b(k,89) + b(k,190) = b(k,190) - lu(k,306) * b(k,89) + b(k,199) = b(k,199) - lu(k,307) * b(k,89) + b(k,201) = b(k,201) - lu(k,308) * b(k,89) + b(k,185) = b(k,185) - lu(k,310) * b(k,90) + b(k,190) = b(k,190) - lu(k,311) * b(k,90) + b(k,193) = b(k,193) - lu(k,312) * b(k,90) + b(k,195) = b(k,195) - lu(k,313) * b(k,90) + b(k,201) = b(k,201) - lu(k,314) * b(k,90) + b(k,103) = b(k,103) - lu(k,316) * b(k,91) + b(k,149) = b(k,149) - lu(k,317) * b(k,91) + b(k,175) = b(k,175) - lu(k,318) * b(k,91) + b(k,190) = b(k,190) - lu(k,319) * b(k,91) + b(k,199) = b(k,199) - lu(k,320) * b(k,91) + b(k,104) = b(k,104) - lu(k,324) * b(k,92) + b(k,187) = b(k,187) - lu(k,325) * b(k,92) + b(k,190) = b(k,190) - lu(k,326) * b(k,92) + b(k,197) = b(k,197) - lu(k,327) * b(k,92) + b(k,199) = b(k,199) - lu(k,328) * b(k,92) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,141) = b(k,141) - lu(k,330) * b(k,93) + b(k,187) = b(k,187) - lu(k,331) * b(k,93) + b(k,193) = b(k,193) - lu(k,332) * b(k,93) + b(k,197) = b(k,197) - lu(k,333) * b(k,93) + b(k,199) = b(k,199) - lu(k,334) * b(k,93) + b(k,149) = b(k,149) - lu(k,337) * b(k,94) + b(k,187) = b(k,187) - lu(k,338) * b(k,94) + b(k,190) = b(k,190) - lu(k,339) * b(k,94) + b(k,197) = b(k,197) - lu(k,340) * b(k,94) + b(k,199) = b(k,199) - lu(k,341) * b(k,94) + b(k,130) = b(k,130) - lu(k,343) * b(k,95) + b(k,199) = b(k,199) - lu(k,344) * b(k,95) + b(k,161) = b(k,161) - lu(k,346) * b(k,96) + b(k,186) = b(k,186) - lu(k,347) * b(k,96) + b(k,193) = b(k,193) - lu(k,348) * b(k,96) + b(k,199) = b(k,199) - lu(k,349) * b(k,96) + b(k,181) = b(k,181) - lu(k,351) * b(k,97) + b(k,185) = b(k,185) - lu(k,352) * b(k,97) + b(k,190) = b(k,190) - lu(k,353) * b(k,97) + b(k,193) = b(k,193) - lu(k,354) * b(k,97) + b(k,194) = b(k,194) - lu(k,355) * b(k,97) + b(k,197) = b(k,197) - lu(k,356) * b(k,97) + b(k,122) = b(k,122) - lu(k,358) * b(k,98) + b(k,191) = b(k,191) - lu(k,359) * b(k,98) + b(k,197) = b(k,197) - lu(k,360) * b(k,98) + b(k,186) = b(k,186) - lu(k,362) * b(k,99) + b(k,190) = b(k,190) - lu(k,363) * b(k,99) + b(k,194) = b(k,194) - lu(k,364) * b(k,99) + b(k,197) = b(k,197) - lu(k,365) * b(k,99) + b(k,199) = b(k,199) - lu(k,366) * b(k,99) + b(k,201) = b(k,201) - lu(k,367) * b(k,99) + b(k,156) = b(k,156) - lu(k,369) * b(k,100) + b(k,158) = b(k,158) - lu(k,370) * b(k,100) + b(k,166) = b(k,166) - lu(k,371) * b(k,100) + b(k,190) = b(k,190) - lu(k,372) * b(k,100) + b(k,193) = b(k,193) - lu(k,373) * b(k,100) + b(k,199) = b(k,199) - lu(k,374) * b(k,100) + b(k,130) = b(k,130) - lu(k,378) * b(k,101) + b(k,149) = b(k,149) - lu(k,379) * b(k,101) + b(k,187) = b(k,187) - lu(k,380) * b(k,101) + b(k,190) = b(k,190) - lu(k,381) * b(k,101) + b(k,197) = b(k,197) - lu(k,382) * b(k,101) + b(k,199) = b(k,199) - lu(k,383) * b(k,101) + b(k,120) = b(k,120) - lu(k,385) * b(k,102) + b(k,137) = b(k,137) - lu(k,386) * b(k,102) + b(k,138) = b(k,138) - lu(k,387) * b(k,102) + b(k,144) = b(k,144) - lu(k,388) * b(k,102) + b(k,186) = b(k,186) - lu(k,389) * b(k,102) + b(k,192) = b(k,192) - lu(k,390) * b(k,102) + b(k,149) = b(k,149) - lu(k,393) * b(k,103) + b(k,175) = b(k,175) - lu(k,394) * b(k,103) + b(k,187) = b(k,187) - lu(k,395) * b(k,103) + b(k,190) = b(k,190) - lu(k,396) * b(k,103) + b(k,197) = b(k,197) - lu(k,397) * b(k,103) + b(k,199) = b(k,199) - lu(k,398) * b(k,103) + b(k,122) = b(k,122) - lu(k,401) * b(k,104) + b(k,187) = b(k,187) - lu(k,402) * b(k,104) + b(k,190) = b(k,190) - lu(k,403) * b(k,104) + b(k,197) = b(k,197) - lu(k,404) * b(k,104) + b(k,199) = b(k,199) - lu(k,405) * b(k,104) + b(k,181) = b(k,181) - lu(k,407) * b(k,105) + b(k,185) = b(k,185) - lu(k,408) * b(k,105) + b(k,190) = b(k,190) - lu(k,409) * b(k,105) + b(k,193) = b(k,193) - lu(k,410) * b(k,105) + b(k,201) = b(k,201) - lu(k,411) * b(k,105) + b(k,144) = b(k,144) - lu(k,413) * b(k,106) + b(k,186) = b(k,186) - lu(k,414) * b(k,106) + b(k,187) = b(k,187) - lu(k,415) * b(k,106) + b(k,189) = b(k,189) - lu(k,416) * b(k,106) + b(k,125) = b(k,125) - lu(k,418) * b(k,107) + b(k,152) = b(k,152) - lu(k,419) * b(k,107) + b(k,181) = b(k,181) - lu(k,420) * b(k,107) + b(k,190) = b(k,190) - lu(k,421) * b(k,107) + b(k,147) = b(k,147) - lu(k,423) * b(k,108) + b(k,161) = b(k,161) - lu(k,424) * b(k,108) + b(k,162) = b(k,162) - lu(k,425) * b(k,108) + b(k,164) = b(k,164) - lu(k,426) * b(k,108) + b(k,190) = b(k,190) - lu(k,427) * b(k,108) + b(k,196) = b(k,196) - lu(k,428) * b(k,108) + b(k,199) = b(k,199) - lu(k,429) * b(k,108) + b(k,142) = b(k,142) - lu(k,431) * b(k,109) + b(k,164) = b(k,164) - lu(k,432) * b(k,109) + b(k,170) = b(k,170) - lu(k,433) * b(k,109) + b(k,190) = b(k,190) - lu(k,434) * b(k,109) + b(k,193) = b(k,193) - lu(k,435) * b(k,109) + b(k,199) = b(k,199) - lu(k,436) * b(k,109) + b(k,201) = b(k,201) - lu(k,437) * b(k,109) + b(k,134) = b(k,134) - lu(k,439) * b(k,110) + b(k,184) = b(k,184) - lu(k,440) * b(k,110) + b(k,192) = b(k,192) - lu(k,441) * b(k,110) + b(k,194) = b(k,194) - lu(k,442) * b(k,110) + b(k,196) = b(k,196) - lu(k,443) * b(k,110) + b(k,197) = b(k,197) - lu(k,444) * b(k,110) + b(k,198) = b(k,198) - lu(k,445) * b(k,110) + b(k,185) = b(k,185) - lu(k,447) * b(k,111) + b(k,190) = b(k,190) - lu(k,448) * b(k,111) + b(k,201) = b(k,201) - lu(k,449) * b(k,111) + b(k,135) = b(k,135) - lu(k,451) * b(k,112) + b(k,141) = b(k,141) - lu(k,452) * b(k,112) + b(k,165) = b(k,165) - lu(k,453) * b(k,112) + b(k,190) = b(k,190) - lu(k,454) * b(k,112) + b(k,191) = b(k,191) - lu(k,455) * b(k,112) + b(k,193) = b(k,193) - lu(k,456) * b(k,112) + b(k,199) = b(k,199) - lu(k,457) * b(k,112) + b(k,156) = b(k,156) - lu(k,459) * b(k,113) + b(k,162) = b(k,162) - lu(k,460) * b(k,113) + b(k,170) = b(k,170) - lu(k,461) * b(k,113) + b(k,187) = b(k,187) - lu(k,462) * b(k,113) + b(k,193) = b(k,193) - lu(k,463) * b(k,113) + b(k,197) = b(k,197) - lu(k,464) * b(k,113) + b(k,199) = b(k,199) - lu(k,465) * b(k,113) + b(k,164) = b(k,164) - lu(k,467) * b(k,114) + b(k,180) = b(k,180) - lu(k,468) * b(k,114) + b(k,190) = b(k,190) - lu(k,469) * b(k,114) + b(k,193) = b(k,193) - lu(k,470) * b(k,114) + b(k,194) = b(k,194) - lu(k,471) * b(k,114) + b(k,197) = b(k,197) - lu(k,472) * b(k,114) + b(k,199) = b(k,199) - lu(k,473) * b(k,114) + b(k,183) = b(k,183) - lu(k,475) * b(k,115) + b(k,188) = b(k,188) - lu(k,476) * b(k,115) + b(k,190) = b(k,190) - lu(k,477) * b(k,115) + b(k,192) = b(k,192) - lu(k,478) * b(k,115) + b(k,199) = b(k,199) - lu(k,479) * b(k,115) + b(k,201) = b(k,201) - lu(k,480) * b(k,115) + b(k,156) = b(k,156) - lu(k,482) * b(k,116) + b(k,161) = b(k,161) - lu(k,483) * b(k,116) + b(k,163) = b(k,163) - lu(k,484) * b(k,116) + b(k,165) = b(k,165) - lu(k,485) * b(k,116) + b(k,167) = b(k,167) - lu(k,486) * b(k,116) + b(k,190) = b(k,190) - lu(k,487) * b(k,116) + b(k,193) = b(k,193) - lu(k,488) * b(k,116) + b(k,199) = b(k,199) - lu(k,489) * b(k,116) + b(k,118) = b(k,118) - lu(k,493) * b(k,117) + b(k,130) = b(k,130) - lu(k,494) * b(k,117) + b(k,131) = b(k,131) - lu(k,495) * b(k,117) + b(k,133) = b(k,133) - lu(k,496) * b(k,117) + b(k,149) = b(k,149) - lu(k,497) * b(k,117) + b(k,175) = b(k,175) - lu(k,498) * b(k,117) + b(k,190) = b(k,190) - lu(k,499) * b(k,117) + b(k,199) = b(k,199) - lu(k,500) * b(k,117) + b(k,150) = b(k,150) - lu(k,502) * b(k,118) + b(k,165) = b(k,165) - lu(k,503) * b(k,118) + b(k,199) = b(k,199) - lu(k,504) * b(k,118) + b(k,161) = b(k,161) - lu(k,506) * b(k,119) + b(k,162) = b(k,162) - lu(k,507) * b(k,119) + b(k,164) = b(k,164) - lu(k,508) * b(k,119) + b(k,190) = b(k,190) - lu(k,509) * b(k,119) + b(k,193) = b(k,193) - lu(k,510) * b(k,119) + b(k,196) = b(k,196) - lu(k,511) * b(k,119) + b(k,197) = b(k,197) - lu(k,512) * b(k,119) + b(k,199) = b(k,199) - lu(k,513) * b(k,119) + b(k,137) = b(k,137) - lu(k,515) * b(k,120) + b(k,138) = b(k,138) - lu(k,516) * b(k,120) + b(k,144) = b(k,144) - lu(k,517) * b(k,120) + b(k,165) = b(k,165) - lu(k,518) * b(k,120) + b(k,186) = b(k,186) - lu(k,519) * b(k,120) + b(k,192) = b(k,192) - lu(k,520) * b(k,120) + b(k,158) = b(k,158) - lu(k,522) * b(k,121) + b(k,190) = b(k,190) - lu(k,523) * b(k,121) + b(k,196) = b(k,196) - lu(k,524) * b(k,121) + b(k,197) = b(k,197) - lu(k,525) * b(k,121) + b(k,199) = b(k,199) - lu(k,526) * b(k,121) + b(k,187) = b(k,187) - lu(k,530) * b(k,122) + b(k,190) = b(k,190) - lu(k,531) * b(k,122) + b(k,191) = b(k,191) - lu(k,532) * b(k,122) + b(k,197) = b(k,197) - lu(k,533) * b(k,122) + b(k,199) = b(k,199) - lu(k,534) * b(k,122) + b(k,125) = b(k,125) - lu(k,537) * b(k,123) + b(k,152) = b(k,152) - lu(k,538) * b(k,123) + b(k,156) = b(k,156) - lu(k,539) * b(k,123) + b(k,170) = b(k,170) - lu(k,540) * b(k,123) + b(k,181) = b(k,181) - lu(k,541) * b(k,123) + b(k,190) = b(k,190) - lu(k,542) * b(k,123) + b(k,193) = b(k,193) - lu(k,543) * b(k,123) + b(k,197) = b(k,197) - lu(k,544) * b(k,123) + b(k,199) = b(k,199) - lu(k,545) * b(k,123) + b(k,125) = b(k,125) - lu(k,548) * b(k,124) + b(k,152) = b(k,152) - lu(k,549) * b(k,124) + b(k,154) = b(k,154) - lu(k,550) * b(k,124) + b(k,156) = b(k,156) - lu(k,551) * b(k,124) + b(k,170) = b(k,170) - lu(k,552) * b(k,124) + b(k,181) = b(k,181) - lu(k,553) * b(k,124) + b(k,190) = b(k,190) - lu(k,554) * b(k,124) + b(k,193) = b(k,193) - lu(k,555) * b(k,124) + b(k,199) = b(k,199) - lu(k,556) * b(k,124) + b(k,170) = b(k,170) - lu(k,559) * b(k,125) + b(k,181) = b(k,181) - lu(k,560) * b(k,125) + b(k,187) = b(k,187) - lu(k,561) * b(k,125) + b(k,190) = b(k,190) - lu(k,562) * b(k,125) + b(k,197) = b(k,197) - lu(k,563) * b(k,125) + b(k,199) = b(k,199) - lu(k,564) * b(k,125) + b(k,137) = b(k,137) - lu(k,568) * b(k,126) + b(k,138) = b(k,138) - lu(k,569) * b(k,126) + b(k,139) = b(k,139) - lu(k,570) * b(k,126) + b(k,144) = b(k,144) - lu(k,571) * b(k,126) + b(k,165) = b(k,165) - lu(k,572) * b(k,126) + b(k,186) = b(k,186) - lu(k,573) * b(k,126) + b(k,187) = b(k,187) - lu(k,574) * b(k,126) + b(k,189) = b(k,189) - lu(k,575) * b(k,126) + b(k,192) = b(k,192) - lu(k,576) * b(k,126) + b(k,171) = b(k,171) - lu(k,579) * b(k,127) + b(k,174) = b(k,174) - lu(k,580) * b(k,127) + b(k,179) = b(k,179) - lu(k,581) * b(k,127) + b(k,190) = b(k,190) - lu(k,582) * b(k,127) + b(k,193) = b(k,193) - lu(k,583) * b(k,127) + b(k,199) = b(k,199) - lu(k,584) * b(k,127) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,130) = b(k,130) - lu(k,590) * b(k,128) + b(k,132) = b(k,132) - lu(k,591) * b(k,128) + b(k,133) = b(k,133) - lu(k,592) * b(k,128) + b(k,149) = b(k,149) - lu(k,593) * b(k,128) + b(k,150) = b(k,150) - lu(k,594) * b(k,128) + b(k,165) = b(k,165) - lu(k,595) * b(k,128) + b(k,175) = b(k,175) - lu(k,596) * b(k,128) + b(k,181) = b(k,181) - lu(k,597) * b(k,128) + b(k,190) = b(k,190) - lu(k,598) * b(k,128) + b(k,199) = b(k,199) - lu(k,599) * b(k,128) + b(k,182) = b(k,182) - lu(k,601) * b(k,129) + b(k,186) = b(k,186) - lu(k,602) * b(k,129) + b(k,190) = b(k,190) - lu(k,603) * b(k,129) + b(k,191) = b(k,191) - lu(k,604) * b(k,129) + b(k,192) = b(k,192) - lu(k,605) * b(k,129) + b(k,195) = b(k,195) - lu(k,606) * b(k,129) + b(k,149) = b(k,149) - lu(k,608) * b(k,130) + b(k,165) = b(k,165) - lu(k,609) * b(k,130) + b(k,187) = b(k,187) - lu(k,610) * b(k,130) + b(k,197) = b(k,197) - lu(k,611) * b(k,130) + b(k,199) = b(k,199) - lu(k,612) * b(k,130) + b(k,133) = b(k,133) - lu(k,619) * b(k,131) + b(k,149) = b(k,149) - lu(k,620) * b(k,131) + b(k,150) = b(k,150) - lu(k,621) * b(k,131) + b(k,165) = b(k,165) - lu(k,622) * b(k,131) + b(k,175) = b(k,175) - lu(k,623) * b(k,131) + b(k,187) = b(k,187) - lu(k,624) * b(k,131) + b(k,190) = b(k,190) - lu(k,625) * b(k,131) + b(k,197) = b(k,197) - lu(k,626) * b(k,131) + b(k,199) = b(k,199) - lu(k,627) * b(k,131) + b(k,133) = b(k,133) - lu(k,635) * b(k,132) + b(k,149) = b(k,149) - lu(k,636) * b(k,132) + b(k,150) = b(k,150) - lu(k,637) * b(k,132) + b(k,165) = b(k,165) - lu(k,638) * b(k,132) + b(k,175) = b(k,175) - lu(k,639) * b(k,132) + b(k,181) = b(k,181) - lu(k,640) * b(k,132) + b(k,187) = b(k,187) - lu(k,641) * b(k,132) + b(k,190) = b(k,190) - lu(k,642) * b(k,132) + b(k,197) = b(k,197) - lu(k,643) * b(k,132) + b(k,199) = b(k,199) - lu(k,644) * b(k,132) + b(k,165) = b(k,165) - lu(k,646) * b(k,133) + b(k,175) = b(k,175) - lu(k,647) * b(k,133) + b(k,185) = b(k,185) - lu(k,648) * b(k,133) + b(k,187) = b(k,187) - lu(k,649) * b(k,133) + b(k,190) = b(k,190) - lu(k,650) * b(k,133) + b(k,197) = b(k,197) - lu(k,651) * b(k,133) + b(k,199) = b(k,199) - lu(k,652) * b(k,133) + b(k,183) = b(k,183) - lu(k,655) * b(k,134) + b(k,184) = b(k,184) - lu(k,656) * b(k,134) + b(k,188) = b(k,188) - lu(k,657) * b(k,134) + b(k,190) = b(k,190) - lu(k,658) * b(k,134) + b(k,192) = b(k,192) - lu(k,659) * b(k,134) + b(k,198) = b(k,198) - lu(k,660) * b(k,134) + b(k,201) = b(k,201) - lu(k,661) * b(k,134) + b(k,161) = b(k,161) - lu(k,665) * b(k,135) + b(k,186) = b(k,186) - lu(k,666) * b(k,135) + b(k,187) = b(k,187) - lu(k,667) * b(k,135) + b(k,190) = b(k,190) - lu(k,668) * b(k,135) + b(k,193) = b(k,193) - lu(k,669) * b(k,135) + b(k,197) = b(k,197) - lu(k,670) * b(k,135) + b(k,199) = b(k,199) - lu(k,671) * b(k,135) + b(k,172) = b(k,172) - lu(k,674) * b(k,136) + b(k,185) = b(k,185) - lu(k,675) * b(k,136) + b(k,190) = b(k,190) - lu(k,676) * b(k,136) + b(k,194) = b(k,194) - lu(k,677) * b(k,136) + b(k,195) = b(k,195) - lu(k,678) * b(k,136) + b(k,196) = b(k,196) - lu(k,679) * b(k,136) + b(k,201) = b(k,201) - lu(k,680) * b(k,136) + b(k,138) = b(k,138) - lu(k,682) * b(k,137) + b(k,139) = b(k,139) - lu(k,683) * b(k,137) + b(k,144) = b(k,144) - lu(k,684) * b(k,137) + b(k,186) = b(k,186) - lu(k,685) * b(k,137) + b(k,187) = b(k,187) - lu(k,686) * b(k,137) + b(k,189) = b(k,189) - lu(k,687) * b(k,137) + b(k,192) = b(k,192) - lu(k,688) * b(k,137) + b(k,139) = b(k,139) - lu(k,691) * b(k,138) + b(k,144) = b(k,144) - lu(k,692) * b(k,138) + b(k,186) = b(k,186) - lu(k,693) * b(k,138) + b(k,187) = b(k,187) - lu(k,694) * b(k,138) + b(k,189) = b(k,189) - lu(k,695) * b(k,138) + b(k,192) = b(k,192) - lu(k,696) * b(k,138) + b(k,144) = b(k,144) - lu(k,702) * b(k,139) + b(k,165) = b(k,165) - lu(k,703) * b(k,139) + b(k,186) = b(k,186) - lu(k,704) * b(k,139) + b(k,187) = b(k,187) - lu(k,705) * b(k,139) + b(k,189) = b(k,189) - lu(k,706) * b(k,139) + b(k,192) = b(k,192) - lu(k,707) * b(k,139) + b(k,190) = b(k,190) - lu(k,709) * b(k,140) + b(k,193) = b(k,193) - lu(k,710) * b(k,140) + b(k,199) = b(k,199) - lu(k,711) * b(k,140) + b(k,190) = b(k,190) - lu(k,713) * b(k,141) + b(k,199) = b(k,199) - lu(k,714) * b(k,141) + b(k,201) = b(k,201) - lu(k,715) * b(k,141) + b(k,164) = b(k,164) - lu(k,718) * b(k,142) + b(k,170) = b(k,170) - lu(k,719) * b(k,142) + b(k,186) = b(k,186) - lu(k,720) * b(k,142) + b(k,187) = b(k,187) - lu(k,721) * b(k,142) + b(k,190) = b(k,190) - lu(k,722) * b(k,142) + b(k,193) = b(k,193) - lu(k,723) * b(k,142) + b(k,197) = b(k,197) - lu(k,724) * b(k,142) + b(k,199) = b(k,199) - lu(k,725) * b(k,142) + b(k,201) = b(k,201) - lu(k,726) * b(k,142) + b(k,156) = b(k,156) - lu(k,729) * b(k,143) + b(k,170) = b(k,170) - lu(k,730) * b(k,143) + b(k,185) = b(k,185) - lu(k,731) * b(k,143) + b(k,186) = b(k,186) - lu(k,732) * b(k,143) + b(k,187) = b(k,187) - lu(k,733) * b(k,143) + b(k,190) = b(k,190) - lu(k,734) * b(k,143) + b(k,193) = b(k,193) - lu(k,735) * b(k,143) + b(k,197) = b(k,197) - lu(k,736) * b(k,143) + b(k,199) = b(k,199) - lu(k,737) * b(k,143) + b(k,201) = b(k,201) - lu(k,738) * b(k,143) + b(k,165) = b(k,165) - lu(k,745) * b(k,144) + b(k,186) = b(k,186) - lu(k,746) * b(k,144) + b(k,187) = b(k,187) - lu(k,747) * b(k,144) + b(k,189) = b(k,189) - lu(k,748) * b(k,144) + b(k,190) = b(k,190) - lu(k,749) * b(k,144) + b(k,192) = b(k,192) - lu(k,750) * b(k,144) + b(k,195) = b(k,195) - lu(k,751) * b(k,144) + b(k,197) = b(k,197) - lu(k,752) * b(k,144) + b(k,184) = b(k,184) - lu(k,754) * b(k,145) + b(k,189) = b(k,189) - lu(k,755) * b(k,145) + b(k,190) = b(k,190) - lu(k,756) * b(k,145) + b(k,192) = b(k,192) - lu(k,757) * b(k,145) + b(k,195) = b(k,195) - lu(k,758) * b(k,145) + b(k,198) = b(k,198) - lu(k,759) * b(k,145) + b(k,201) = b(k,201) - lu(k,760) * b(k,145) + b(k,183) = b(k,183) - lu(k,763) * b(k,146) + b(k,188) = b(k,188) - lu(k,764) * b(k,146) + b(k,190) = b(k,190) - lu(k,765) * b(k,146) + b(k,192) = b(k,192) - lu(k,766) * b(k,146) + b(k,200) = b(k,200) - lu(k,767) * b(k,146) + b(k,201) = b(k,201) - lu(k,768) * b(k,146) + b(k,175) = b(k,175) - lu(k,770) * b(k,147) + b(k,181) = b(k,181) - lu(k,771) * b(k,147) + b(k,190) = b(k,190) - lu(k,772) * b(k,147) + b(k,193) = b(k,193) - lu(k,773) * b(k,147) + b(k,197) = b(k,197) - lu(k,774) * b(k,147) + b(k,160) = b(k,160) - lu(k,782) * b(k,148) + b(k,165) = b(k,165) - lu(k,783) * b(k,148) + b(k,173) = b(k,173) - lu(k,784) * b(k,148) + b(k,174) = b(k,174) - lu(k,785) * b(k,148) + b(k,176) = b(k,176) - lu(k,786) * b(k,148) + b(k,177) = b(k,177) - lu(k,787) * b(k,148) + b(k,179) = b(k,179) - lu(k,788) * b(k,148) + b(k,181) = b(k,181) - lu(k,789) * b(k,148) + b(k,185) = b(k,185) - lu(k,790) * b(k,148) + b(k,190) = b(k,190) - lu(k,791) * b(k,148) + b(k,191) = b(k,191) - lu(k,792) * b(k,148) + b(k,193) = b(k,193) - lu(k,793) * b(k,148) + b(k,194) = b(k,194) - lu(k,794) * b(k,148) + b(k,199) = b(k,199) - lu(k,795) * b(k,148) + b(k,201) = b(k,201) - lu(k,796) * b(k,148) + b(k,165) = b(k,165) - lu(k,799) * b(k,149) + b(k,190) = b(k,190) - lu(k,800) * b(k,149) + b(k,199) = b(k,199) - lu(k,801) * b(k,149) + b(k,165) = b(k,165) - lu(k,804) * b(k,150) + b(k,175) = b(k,175) - lu(k,805) * b(k,150) + b(k,185) = b(k,185) - lu(k,806) * b(k,150) + b(k,187) = b(k,187) - lu(k,807) * b(k,150) + b(k,190) = b(k,190) - lu(k,808) * b(k,150) + b(k,197) = b(k,197) - lu(k,809) * b(k,150) + b(k,199) = b(k,199) - lu(k,810) * b(k,150) + b(k,154) = b(k,154) - lu(k,821) * b(k,151) + b(k,156) = b(k,156) - lu(k,822) * b(k,151) + b(k,158) = b(k,158) - lu(k,823) * b(k,151) + b(k,163) = b(k,163) - lu(k,824) * b(k,151) + b(k,165) = b(k,165) - lu(k,825) * b(k,151) + b(k,166) = b(k,166) - lu(k,826) * b(k,151) + b(k,168) = b(k,168) - lu(k,827) * b(k,151) + b(k,169) = b(k,169) - lu(k,828) * b(k,151) + b(k,175) = b(k,175) - lu(k,829) * b(k,151) + b(k,181) = b(k,181) - lu(k,830) * b(k,151) + b(k,190) = b(k,190) - lu(k,831) * b(k,151) + b(k,191) = b(k,191) - lu(k,832) * b(k,151) + b(k,193) = b(k,193) - lu(k,833) * b(k,151) + b(k,194) = b(k,194) - lu(k,834) * b(k,151) + b(k,199) = b(k,199) - lu(k,835) * b(k,151) + b(k,201) = b(k,201) - lu(k,836) * b(k,151) + b(k,170) = b(k,170) - lu(k,841) * b(k,152) + b(k,185) = b(k,185) - lu(k,842) * b(k,152) + b(k,186) = b(k,186) - lu(k,843) * b(k,152) + b(k,187) = b(k,187) - lu(k,844) * b(k,152) + b(k,190) = b(k,190) - lu(k,845) * b(k,152) + b(k,193) = b(k,193) - lu(k,846) * b(k,152) + b(k,197) = b(k,197) - lu(k,847) * b(k,152) + b(k,199) = b(k,199) - lu(k,848) * b(k,152) + b(k,154) = b(k,154) - lu(k,859) * b(k,153) + b(k,156) = b(k,156) - lu(k,860) * b(k,153) + b(k,158) = b(k,158) - lu(k,861) * b(k,153) + b(k,163) = b(k,163) - lu(k,862) * b(k,153) + b(k,165) = b(k,165) - lu(k,863) * b(k,153) + b(k,166) = b(k,166) - lu(k,864) * b(k,153) + b(k,168) = b(k,168) - lu(k,865) * b(k,153) + b(k,169) = b(k,169) - lu(k,866) * b(k,153) + b(k,175) = b(k,175) - lu(k,867) * b(k,153) + b(k,181) = b(k,181) - lu(k,868) * b(k,153) + b(k,190) = b(k,190) - lu(k,869) * b(k,153) + b(k,191) = b(k,191) - lu(k,870) * b(k,153) + b(k,193) = b(k,193) - lu(k,871) * b(k,153) + b(k,194) = b(k,194) - lu(k,872) * b(k,153) + b(k,199) = b(k,199) - lu(k,873) * b(k,153) + b(k,201) = b(k,201) - lu(k,874) * b(k,153) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,156) = b(k,156) - lu(k,881) * b(k,154) + b(k,170) = b(k,170) - lu(k,882) * b(k,154) + b(k,181) = b(k,181) - lu(k,883) * b(k,154) + b(k,185) = b(k,185) - lu(k,884) * b(k,154) + b(k,186) = b(k,186) - lu(k,885) * b(k,154) + b(k,187) = b(k,187) - lu(k,886) * b(k,154) + b(k,190) = b(k,190) - lu(k,887) * b(k,154) + b(k,193) = b(k,193) - lu(k,888) * b(k,154) + b(k,197) = b(k,197) - lu(k,889) * b(k,154) + b(k,199) = b(k,199) - lu(k,890) * b(k,154) + b(k,182) = b(k,182) - lu(k,893) * b(k,155) + b(k,190) = b(k,190) - lu(k,894) * b(k,155) + b(k,192) = b(k,192) - lu(k,895) * b(k,155) + b(k,199) = b(k,199) - lu(k,896) * b(k,155) + b(k,201) = b(k,201) - lu(k,897) * b(k,155) + b(k,169) = b(k,169) - lu(k,899) * b(k,156) + b(k,181) = b(k,181) - lu(k,900) * b(k,156) + b(k,185) = b(k,185) - lu(k,901) * b(k,156) + b(k,190) = b(k,190) - lu(k,902) * b(k,156) + b(k,201) = b(k,201) - lu(k,903) * b(k,156) + b(k,183) = b(k,183) - lu(k,907) * b(k,157) + b(k,188) = b(k,188) - lu(k,908) * b(k,157) + b(k,190) = b(k,190) - lu(k,909) * b(k,157) + b(k,192) = b(k,192) - lu(k,910) * b(k,157) + b(k,194) = b(k,194) - lu(k,911) * b(k,157) + b(k,196) = b(k,196) - lu(k,912) * b(k,157) + b(k,197) = b(k,197) - lu(k,913) * b(k,157) + b(k,200) = b(k,200) - lu(k,914) * b(k,157) + b(k,201) = b(k,201) - lu(k,915) * b(k,157) + b(k,163) = b(k,163) - lu(k,917) * b(k,158) + b(k,165) = b(k,165) - lu(k,918) * b(k,158) + b(k,167) = b(k,167) - lu(k,919) * b(k,158) + b(k,168) = b(k,168) - lu(k,920) * b(k,158) + b(k,190) = b(k,190) - lu(k,921) * b(k,158) + b(k,194) = b(k,194) - lu(k,922) * b(k,158) + b(k,199) = b(k,199) - lu(k,923) * b(k,158) + b(k,165) = b(k,165) - lu(k,929) * b(k,159) + b(k,175) = b(k,175) - lu(k,930) * b(k,159) + b(k,181) = b(k,181) - lu(k,931) * b(k,159) + b(k,185) = b(k,185) - lu(k,932) * b(k,159) + b(k,187) = b(k,187) - lu(k,933) * b(k,159) + b(k,190) = b(k,190) - lu(k,934) * b(k,159) + b(k,193) = b(k,193) - lu(k,935) * b(k,159) + b(k,196) = b(k,196) - lu(k,936) * b(k,159) + b(k,197) = b(k,197) - lu(k,937) * b(k,159) + b(k,199) = b(k,199) - lu(k,938) * b(k,159) + b(k,164) = b(k,164) - lu(k,944) * b(k,160) + b(k,165) = b(k,165) - lu(k,945) * b(k,160) + b(k,170) = b(k,170) - lu(k,946) * b(k,160) + b(k,175) = b(k,175) - lu(k,947) * b(k,160) + b(k,181) = b(k,181) - lu(k,948) * b(k,160) + b(k,185) = b(k,185) - lu(k,949) * b(k,160) + b(k,186) = b(k,186) - lu(k,950) * b(k,160) + b(k,187) = b(k,187) - lu(k,951) * b(k,160) + b(k,190) = b(k,190) - lu(k,952) * b(k,160) + b(k,191) = b(k,191) - lu(k,953) * b(k,160) + b(k,193) = b(k,193) - lu(k,954) * b(k,160) + b(k,194) = b(k,194) - lu(k,955) * b(k,160) + b(k,197) = b(k,197) - lu(k,956) * b(k,160) + b(k,199) = b(k,199) - lu(k,957) * b(k,160) + b(k,201) = b(k,201) - lu(k,958) * b(k,160) + b(k,165) = b(k,165) - lu(k,961) * b(k,161) + b(k,190) = b(k,190) - lu(k,962) * b(k,161) + b(k,193) = b(k,193) - lu(k,963) * b(k,161) + b(k,199) = b(k,199) - lu(k,964) * b(k,161) + b(k,164) = b(k,164) - lu(k,969) * b(k,162) + b(k,165) = b(k,165) - lu(k,970) * b(k,162) + b(k,169) = b(k,169) - lu(k,971) * b(k,162) + b(k,170) = b(k,170) - lu(k,972) * b(k,162) + b(k,181) = b(k,181) - lu(k,973) * b(k,162) + b(k,185) = b(k,185) - lu(k,974) * b(k,162) + b(k,190) = b(k,190) - lu(k,975) * b(k,162) + b(k,193) = b(k,193) - lu(k,976) * b(k,162) + b(k,196) = b(k,196) - lu(k,977) * b(k,162) + b(k,197) = b(k,197) - lu(k,978) * b(k,162) + b(k,199) = b(k,199) - lu(k,979) * b(k,162) + b(k,201) = b(k,201) - lu(k,980) * b(k,162) + b(k,165) = b(k,165) - lu(k,983) * b(k,163) + b(k,169) = b(k,169) - lu(k,984) * b(k,163) + b(k,181) = b(k,181) - lu(k,985) * b(k,163) + b(k,185) = b(k,185) - lu(k,986) * b(k,163) + b(k,190) = b(k,190) - lu(k,987) * b(k,163) + b(k,193) = b(k,193) - lu(k,988) * b(k,163) + b(k,199) = b(k,199) - lu(k,989) * b(k,163) + b(k,201) = b(k,201) - lu(k,990) * b(k,163) + b(k,175) = b(k,175) - lu(k,992) * b(k,164) + b(k,181) = b(k,181) - lu(k,993) * b(k,164) + b(k,190) = b(k,190) - lu(k,994) * b(k,164) + b(k,193) = b(k,193) - lu(k,995) * b(k,164) + b(k,199) = b(k,199) - lu(k,996) * b(k,164) + b(k,190) = b(k,190) - lu(k,998) * b(k,165) + b(k,195) = b(k,195) - lu(k,999) * b(k,165) + b(k,199) = b(k,199) - lu(k,1000) * b(k,165) + b(k,167) = b(k,167) - lu(k,1009) * b(k,166) + b(k,168) = b(k,168) - lu(k,1010) * b(k,166) + b(k,169) = b(k,169) - lu(k,1011) * b(k,166) + b(k,181) = b(k,181) - lu(k,1012) * b(k,166) + b(k,185) = b(k,185) - lu(k,1013) * b(k,166) + b(k,187) = b(k,187) - lu(k,1014) * b(k,166) + b(k,190) = b(k,190) - lu(k,1015) * b(k,166) + b(k,193) = b(k,193) - lu(k,1016) * b(k,166) + b(k,194) = b(k,194) - lu(k,1017) * b(k,166) + b(k,195) = b(k,195) - lu(k,1018) * b(k,166) + b(k,196) = b(k,196) - lu(k,1019) * b(k,166) + b(k,197) = b(k,197) - lu(k,1020) * b(k,166) + b(k,199) = b(k,199) - lu(k,1021) * b(k,166) + b(k,201) = b(k,201) - lu(k,1022) * b(k,166) + b(k,169) = b(k,169) - lu(k,1031) * b(k,167) + b(k,181) = b(k,181) - lu(k,1032) * b(k,167) + b(k,185) = b(k,185) - lu(k,1033) * b(k,167) + b(k,187) = b(k,187) - lu(k,1034) * b(k,167) + b(k,190) = b(k,190) - lu(k,1035) * b(k,167) + b(k,193) = b(k,193) - lu(k,1036) * b(k,167) + b(k,195) = b(k,195) - lu(k,1037) * b(k,167) + b(k,196) = b(k,196) - lu(k,1038) * b(k,167) + b(k,197) = b(k,197) - lu(k,1039) * b(k,167) + b(k,199) = b(k,199) - lu(k,1040) * b(k,167) + b(k,201) = b(k,201) - lu(k,1041) * b(k,167) + b(k,169) = b(k,169) - lu(k,1050) * b(k,168) + b(k,181) = b(k,181) - lu(k,1051) * b(k,168) + b(k,185) = b(k,185) - lu(k,1052) * b(k,168) + b(k,187) = b(k,187) - lu(k,1053) * b(k,168) + b(k,190) = b(k,190) - lu(k,1054) * b(k,168) + b(k,193) = b(k,193) - lu(k,1055) * b(k,168) + b(k,194) = b(k,194) - lu(k,1056) * b(k,168) + b(k,195) = b(k,195) - lu(k,1057) * b(k,168) + b(k,196) = b(k,196) - lu(k,1058) * b(k,168) + b(k,197) = b(k,197) - lu(k,1059) * b(k,168) + b(k,199) = b(k,199) - lu(k,1060) * b(k,168) + b(k,201) = b(k,201) - lu(k,1061) * b(k,168) + b(k,175) = b(k,175) - lu(k,1066) * b(k,169) + b(k,181) = b(k,181) - lu(k,1067) * b(k,169) + b(k,185) = b(k,185) - lu(k,1068) * b(k,169) + b(k,187) = b(k,187) - lu(k,1069) * b(k,169) + b(k,190) = b(k,190) - lu(k,1070) * b(k,169) + b(k,193) = b(k,193) - lu(k,1071) * b(k,169) + b(k,197) = b(k,197) - lu(k,1072) * b(k,169) + b(k,199) = b(k,199) - lu(k,1073) * b(k,169) + b(k,201) = b(k,201) - lu(k,1074) * b(k,169) + b(k,181) = b(k,181) - lu(k,1077) * b(k,170) + b(k,185) = b(k,185) - lu(k,1078) * b(k,170) + b(k,190) = b(k,190) - lu(k,1079) * b(k,170) + b(k,194) = b(k,194) - lu(k,1080) * b(k,170) + b(k,195) = b(k,195) - lu(k,1081) * b(k,170) + b(k,196) = b(k,196) - lu(k,1082) * b(k,170) + b(k,199) = b(k,199) - lu(k,1083) * b(k,170) + b(k,201) = b(k,201) - lu(k,1084) * b(k,170) + b(k,175) = b(k,175) - lu(k,1092) * b(k,171) + b(k,181) = b(k,181) - lu(k,1093) * b(k,171) + b(k,185) = b(k,185) - lu(k,1094) * b(k,171) + b(k,187) = b(k,187) - lu(k,1095) * b(k,171) + b(k,190) = b(k,190) - lu(k,1096) * b(k,171) + b(k,193) = b(k,193) - lu(k,1097) * b(k,171) + b(k,194) = b(k,194) - lu(k,1098) * b(k,171) + b(k,195) = b(k,195) - lu(k,1099) * b(k,171) + b(k,197) = b(k,197) - lu(k,1100) * b(k,171) + b(k,199) = b(k,199) - lu(k,1101) * b(k,171) + b(k,183) = b(k,183) - lu(k,1105) * b(k,172) + b(k,185) = b(k,185) - lu(k,1106) * b(k,172) + b(k,188) = b(k,188) - lu(k,1107) * b(k,172) + b(k,189) = b(k,189) - lu(k,1108) * b(k,172) + b(k,190) = b(k,190) - lu(k,1109) * b(k,172) + b(k,192) = b(k,192) - lu(k,1110) * b(k,172) + b(k,194) = b(k,194) - lu(k,1111) * b(k,172) + b(k,195) = b(k,195) - lu(k,1112) * b(k,172) + b(k,196) = b(k,196) - lu(k,1113) * b(k,172) + b(k,201) = b(k,201) - lu(k,1114) * b(k,172) + b(k,174) = b(k,174) - lu(k,1125) * b(k,173) + b(k,175) = b(k,175) - lu(k,1126) * b(k,173) + b(k,179) = b(k,179) - lu(k,1127) * b(k,173) + b(k,181) = b(k,181) - lu(k,1128) * b(k,173) + b(k,185) = b(k,185) - lu(k,1129) * b(k,173) + b(k,187) = b(k,187) - lu(k,1130) * b(k,173) + b(k,190) = b(k,190) - lu(k,1131) * b(k,173) + b(k,193) = b(k,193) - lu(k,1132) * b(k,173) + b(k,194) = b(k,194) - lu(k,1133) * b(k,173) + b(k,195) = b(k,195) - lu(k,1134) * b(k,173) + b(k,196) = b(k,196) - lu(k,1135) * b(k,173) + b(k,197) = b(k,197) - lu(k,1136) * b(k,173) + b(k,199) = b(k,199) - lu(k,1137) * b(k,173) + b(k,175) = b(k,175) - lu(k,1141) * b(k,174) + b(k,178) = b(k,178) - lu(k,1142) * b(k,174) + b(k,180) = b(k,180) - lu(k,1143) * b(k,174) + b(k,181) = b(k,181) - lu(k,1144) * b(k,174) + b(k,190) = b(k,190) - lu(k,1145) * b(k,174) + b(k,191) = b(k,191) - lu(k,1146) * b(k,174) + b(k,193) = b(k,193) - lu(k,1147) * b(k,174) + b(k,195) = b(k,195) - lu(k,1148) * b(k,174) + b(k,199) = b(k,199) - lu(k,1149) * b(k,174) + b(k,201) = b(k,201) - lu(k,1150) * b(k,174) + b(k,181) = b(k,181) - lu(k,1153) * b(k,175) + b(k,190) = b(k,190) - lu(k,1154) * b(k,175) + b(k,194) = b(k,194) - lu(k,1155) * b(k,175) + b(k,195) = b(k,195) - lu(k,1156) * b(k,175) + b(k,196) = b(k,196) - lu(k,1157) * b(k,175) + b(k,199) = b(k,199) - lu(k,1158) * b(k,175) + b(k,201) = b(k,201) - lu(k,1159) * b(k,175) + b(k,178) = b(k,178) - lu(k,1173) * b(k,176) + b(k,179) = b(k,179) - lu(k,1174) * b(k,176) + b(k,180) = b(k,180) - lu(k,1175) * b(k,176) + b(k,181) = b(k,181) - lu(k,1176) * b(k,176) + b(k,185) = b(k,185) - lu(k,1177) * b(k,176) + b(k,187) = b(k,187) - lu(k,1178) * b(k,176) + b(k,190) = b(k,190) - lu(k,1179) * b(k,176) + b(k,191) = b(k,191) - lu(k,1180) * b(k,176) + b(k,193) = b(k,193) - lu(k,1181) * b(k,176) + b(k,194) = b(k,194) - lu(k,1182) * b(k,176) + b(k,195) = b(k,195) - lu(k,1183) * b(k,176) + b(k,196) = b(k,196) - lu(k,1184) * b(k,176) + b(k,197) = b(k,197) - lu(k,1185) * b(k,176) + b(k,199) = b(k,199) - lu(k,1186) * b(k,176) + b(k,201) = b(k,201) - lu(k,1187) * b(k,176) + end do + end subroutine lu_slv04 + subroutine lu_slv05( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,178) = b(k,178) - lu(k,1207) * b(k,177) + b(k,179) = b(k,179) - lu(k,1208) * b(k,177) + b(k,180) = b(k,180) - lu(k,1209) * b(k,177) + b(k,181) = b(k,181) - lu(k,1210) * b(k,177) + b(k,185) = b(k,185) - lu(k,1211) * b(k,177) + b(k,187) = b(k,187) - lu(k,1212) * b(k,177) + b(k,190) = b(k,190) - lu(k,1213) * b(k,177) + b(k,191) = b(k,191) - lu(k,1214) * b(k,177) + b(k,193) = b(k,193) - lu(k,1215) * b(k,177) + b(k,194) = b(k,194) - lu(k,1216) * b(k,177) + b(k,195) = b(k,195) - lu(k,1217) * b(k,177) + b(k,196) = b(k,196) - lu(k,1218) * b(k,177) + b(k,197) = b(k,197) - lu(k,1219) * b(k,177) + b(k,199) = b(k,199) - lu(k,1220) * b(k,177) + b(k,201) = b(k,201) - lu(k,1221) * b(k,177) + b(k,180) = b(k,180) - lu(k,1232) * b(k,178) + b(k,181) = b(k,181) - lu(k,1233) * b(k,178) + b(k,185) = b(k,185) - lu(k,1234) * b(k,178) + b(k,187) = b(k,187) - lu(k,1235) * b(k,178) + b(k,190) = b(k,190) - lu(k,1236) * b(k,178) + b(k,193) = b(k,193) - lu(k,1237) * b(k,178) + b(k,194) = b(k,194) - lu(k,1238) * b(k,178) + b(k,195) = b(k,195) - lu(k,1239) * b(k,178) + b(k,196) = b(k,196) - lu(k,1240) * b(k,178) + b(k,197) = b(k,197) - lu(k,1241) * b(k,178) + b(k,199) = b(k,199) - lu(k,1242) * b(k,178) + b(k,201) = b(k,201) - lu(k,1243) * b(k,178) + b(k,180) = b(k,180) - lu(k,1252) * b(k,179) + b(k,181) = b(k,181) - lu(k,1253) * b(k,179) + b(k,185) = b(k,185) - lu(k,1254) * b(k,179) + b(k,186) = b(k,186) - lu(k,1255) * b(k,179) + b(k,187) = b(k,187) - lu(k,1256) * b(k,179) + b(k,190) = b(k,190) - lu(k,1257) * b(k,179) + b(k,191) = b(k,191) - lu(k,1258) * b(k,179) + b(k,193) = b(k,193) - lu(k,1259) * b(k,179) + b(k,194) = b(k,194) - lu(k,1260) * b(k,179) + b(k,195) = b(k,195) - lu(k,1261) * b(k,179) + b(k,196) = b(k,196) - lu(k,1262) * b(k,179) + b(k,197) = b(k,197) - lu(k,1263) * b(k,179) + b(k,199) = b(k,199) - lu(k,1264) * b(k,179) + b(k,201) = b(k,201) - lu(k,1265) * b(k,179) + b(k,181) = b(k,181) - lu(k,1272) * b(k,180) + b(k,185) = b(k,185) - lu(k,1273) * b(k,180) + b(k,187) = b(k,187) - lu(k,1274) * b(k,180) + b(k,190) = b(k,190) - lu(k,1275) * b(k,180) + b(k,191) = b(k,191) - lu(k,1276) * b(k,180) + b(k,193) = b(k,193) - lu(k,1277) * b(k,180) + b(k,194) = b(k,194) - lu(k,1278) * b(k,180) + b(k,195) = b(k,195) - lu(k,1279) * b(k,180) + b(k,196) = b(k,196) - lu(k,1280) * b(k,180) + b(k,197) = b(k,197) - lu(k,1281) * b(k,180) + b(k,199) = b(k,199) - lu(k,1282) * b(k,180) + b(k,201) = b(k,201) - lu(k,1283) * b(k,180) + b(k,185) = b(k,185) - lu(k,1303) * b(k,181) + b(k,186) = b(k,186) - lu(k,1304) * b(k,181) + b(k,187) = b(k,187) - lu(k,1305) * b(k,181) + b(k,190) = b(k,190) - lu(k,1306) * b(k,181) + b(k,191) = b(k,191) - lu(k,1307) * b(k,181) + b(k,193) = b(k,193) - lu(k,1308) * b(k,181) + b(k,194) = b(k,194) - lu(k,1309) * b(k,181) + b(k,195) = b(k,195) - lu(k,1310) * b(k,181) + b(k,196) = b(k,196) - lu(k,1311) * b(k,181) + b(k,197) = b(k,197) - lu(k,1312) * b(k,181) + b(k,199) = b(k,199) - lu(k,1313) * b(k,181) + b(k,201) = b(k,201) - lu(k,1314) * b(k,181) + b(k,184) = b(k,184) - lu(k,1319) * b(k,182) + b(k,186) = b(k,186) - lu(k,1320) * b(k,182) + b(k,187) = b(k,187) - lu(k,1321) * b(k,182) + b(k,188) = b(k,188) - lu(k,1322) * b(k,182) + b(k,190) = b(k,190) - lu(k,1323) * b(k,182) + b(k,191) = b(k,191) - lu(k,1324) * b(k,182) + b(k,192) = b(k,192) - lu(k,1325) * b(k,182) + b(k,195) = b(k,195) - lu(k,1326) * b(k,182) + b(k,197) = b(k,197) - lu(k,1327) * b(k,182) + b(k,198) = b(k,198) - lu(k,1328) * b(k,182) + b(k,199) = b(k,199) - lu(k,1329) * b(k,182) + b(k,200) = b(k,200) - lu(k,1330) * b(k,182) + b(k,201) = b(k,201) - lu(k,1331) * b(k,182) + b(k,184) = b(k,184) - lu(k,1338) * b(k,183) + b(k,188) = b(k,188) - lu(k,1339) * b(k,183) + b(k,189) = b(k,189) - lu(k,1340) * b(k,183) + b(k,190) = b(k,190) - lu(k,1341) * b(k,183) + b(k,192) = b(k,192) - lu(k,1342) * b(k,183) + b(k,194) = b(k,194) - lu(k,1343) * b(k,183) + b(k,195) = b(k,195) - lu(k,1344) * b(k,183) + b(k,196) = b(k,196) - lu(k,1345) * b(k,183) + b(k,197) = b(k,197) - lu(k,1346) * b(k,183) + b(k,198) = b(k,198) - lu(k,1347) * b(k,183) + b(k,200) = b(k,200) - lu(k,1348) * b(k,183) + b(k,201) = b(k,201) - lu(k,1349) * b(k,183) + b(k,186) = b(k,186) - lu(k,1353) * b(k,184) + b(k,189) = b(k,189) - lu(k,1354) * b(k,184) + b(k,190) = b(k,190) - lu(k,1355) * b(k,184) + b(k,191) = b(k,191) - lu(k,1356) * b(k,184) + b(k,192) = b(k,192) - lu(k,1357) * b(k,184) + b(k,193) = b(k,193) - lu(k,1358) * b(k,184) + b(k,195) = b(k,195) - lu(k,1359) * b(k,184) + b(k,198) = b(k,198) - lu(k,1360) * b(k,184) + b(k,199) = b(k,199) - lu(k,1361) * b(k,184) + b(k,201) = b(k,201) - lu(k,1362) * b(k,184) + b(k,186) = b(k,186) - lu(k,1397) * b(k,185) + b(k,187) = b(k,187) - lu(k,1398) * b(k,185) + b(k,188) = b(k,188) - lu(k,1399) * b(k,185) + b(k,190) = b(k,190) - lu(k,1400) * b(k,185) + b(k,191) = b(k,191) - lu(k,1401) * b(k,185) + b(k,193) = b(k,193) - lu(k,1402) * b(k,185) + b(k,194) = b(k,194) - lu(k,1403) * b(k,185) + b(k,195) = b(k,195) - lu(k,1404) * b(k,185) + b(k,196) = b(k,196) - lu(k,1405) * b(k,185) + b(k,197) = b(k,197) - lu(k,1406) * b(k,185) + b(k,199) = b(k,199) - lu(k,1407) * b(k,185) + b(k,200) = b(k,200) - lu(k,1408) * b(k,185) + b(k,201) = b(k,201) - lu(k,1409) * b(k,185) + b(k,187) = b(k,187) - lu(k,1428) * b(k,186) + b(k,188) = b(k,188) - lu(k,1429) * b(k,186) + b(k,189) = b(k,189) - lu(k,1430) * b(k,186) + b(k,190) = b(k,190) - lu(k,1431) * b(k,186) + b(k,191) = b(k,191) - lu(k,1432) * b(k,186) + b(k,192) = b(k,192) - lu(k,1433) * b(k,186) + b(k,193) = b(k,193) - lu(k,1434) * b(k,186) + b(k,195) = b(k,195) - lu(k,1435) * b(k,186) + b(k,197) = b(k,197) - lu(k,1436) * b(k,186) + b(k,198) = b(k,198) - lu(k,1437) * b(k,186) + b(k,199) = b(k,199) - lu(k,1438) * b(k,186) + b(k,200) = b(k,200) - lu(k,1439) * b(k,186) + b(k,201) = b(k,201) - lu(k,1440) * b(k,186) + b(k,188) = b(k,188) - lu(k,1508) * b(k,187) + b(k,189) = b(k,189) - lu(k,1509) * b(k,187) + b(k,190) = b(k,190) - lu(k,1510) * b(k,187) + b(k,191) = b(k,191) - lu(k,1511) * b(k,187) + b(k,192) = b(k,192) - lu(k,1512) * b(k,187) + b(k,193) = b(k,193) - lu(k,1513) * b(k,187) + b(k,194) = b(k,194) - lu(k,1514) * b(k,187) + b(k,195) = b(k,195) - lu(k,1515) * b(k,187) + b(k,196) = b(k,196) - lu(k,1516) * b(k,187) + b(k,197) = b(k,197) - lu(k,1517) * b(k,187) + b(k,198) = b(k,198) - lu(k,1518) * b(k,187) + b(k,199) = b(k,199) - lu(k,1519) * b(k,187) + b(k,200) = b(k,200) - lu(k,1520) * b(k,187) + b(k,201) = b(k,201) - lu(k,1521) * b(k,187) + b(k,189) = b(k,189) - lu(k,1544) * b(k,188) + b(k,190) = b(k,190) - lu(k,1545) * b(k,188) + b(k,191) = b(k,191) - lu(k,1546) * b(k,188) + b(k,192) = b(k,192) - lu(k,1547) * b(k,188) + b(k,193) = b(k,193) - lu(k,1548) * b(k,188) + b(k,194) = b(k,194) - lu(k,1549) * b(k,188) + b(k,195) = b(k,195) - lu(k,1550) * b(k,188) + b(k,196) = b(k,196) - lu(k,1551) * b(k,188) + b(k,197) = b(k,197) - lu(k,1552) * b(k,188) + b(k,198) = b(k,198) - lu(k,1553) * b(k,188) + b(k,199) = b(k,199) - lu(k,1554) * b(k,188) + b(k,200) = b(k,200) - lu(k,1555) * b(k,188) + b(k,201) = b(k,201) - lu(k,1556) * b(k,188) + b(k,190) = b(k,190) - lu(k,1571) * b(k,189) + b(k,191) = b(k,191) - lu(k,1572) * b(k,189) + b(k,192) = b(k,192) - lu(k,1573) * b(k,189) + b(k,193) = b(k,193) - lu(k,1574) * b(k,189) + b(k,194) = b(k,194) - lu(k,1575) * b(k,189) + b(k,195) = b(k,195) - lu(k,1576) * b(k,189) + b(k,196) = b(k,196) - lu(k,1577) * b(k,189) + b(k,197) = b(k,197) - lu(k,1578) * b(k,189) + b(k,198) = b(k,198) - lu(k,1579) * b(k,189) + b(k,199) = b(k,199) - lu(k,1580) * b(k,189) + b(k,200) = b(k,200) - lu(k,1581) * b(k,189) + b(k,201) = b(k,201) - lu(k,1582) * b(k,189) + b(k,191) = b(k,191) - lu(k,1720) * b(k,190) + b(k,192) = b(k,192) - lu(k,1721) * b(k,190) + b(k,193) = b(k,193) - lu(k,1722) * b(k,190) + b(k,194) = b(k,194) - lu(k,1723) * b(k,190) + b(k,195) = b(k,195) - lu(k,1724) * b(k,190) + b(k,196) = b(k,196) - lu(k,1725) * b(k,190) + b(k,197) = b(k,197) - lu(k,1726) * b(k,190) + b(k,198) = b(k,198) - lu(k,1727) * b(k,190) + b(k,199) = b(k,199) - lu(k,1728) * b(k,190) + b(k,200) = b(k,200) - lu(k,1729) * b(k,190) + b(k,201) = b(k,201) - lu(k,1730) * b(k,190) + b(k,192) = b(k,192) - lu(k,1783) * b(k,191) + b(k,193) = b(k,193) - lu(k,1784) * b(k,191) + b(k,194) = b(k,194) - lu(k,1785) * b(k,191) + b(k,195) = b(k,195) - lu(k,1786) * b(k,191) + b(k,196) = b(k,196) - lu(k,1787) * b(k,191) + b(k,197) = b(k,197) - lu(k,1788) * b(k,191) + b(k,198) = b(k,198) - lu(k,1789) * b(k,191) + b(k,199) = b(k,199) - lu(k,1790) * b(k,191) + b(k,200) = b(k,200) - lu(k,1791) * b(k,191) + b(k,201) = b(k,201) - lu(k,1792) * b(k,191) + b(k,193) = b(k,193) - lu(k,1825) * b(k,192) + b(k,194) = b(k,194) - lu(k,1826) * b(k,192) + b(k,195) = b(k,195) - lu(k,1827) * b(k,192) + b(k,196) = b(k,196) - lu(k,1828) * b(k,192) + b(k,197) = b(k,197) - lu(k,1829) * b(k,192) + b(k,198) = b(k,198) - lu(k,1830) * b(k,192) + b(k,199) = b(k,199) - lu(k,1831) * b(k,192) + b(k,200) = b(k,200) - lu(k,1832) * b(k,192) + b(k,201) = b(k,201) - lu(k,1833) * b(k,192) + b(k,194) = b(k,194) - lu(k,1850) * b(k,193) + b(k,195) = b(k,195) - lu(k,1851) * b(k,193) + b(k,196) = b(k,196) - lu(k,1852) * b(k,193) + b(k,197) = b(k,197) - lu(k,1853) * b(k,193) + b(k,198) = b(k,198) - lu(k,1854) * b(k,193) + b(k,199) = b(k,199) - lu(k,1855) * b(k,193) + b(k,200) = b(k,200) - lu(k,1856) * b(k,193) + b(k,201) = b(k,201) - lu(k,1857) * b(k,193) + end do + end subroutine lu_slv05 + subroutine lu_slv06( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,195) = b(k,195) - lu(k,1908) * b(k,194) + b(k,196) = b(k,196) - lu(k,1909) * b(k,194) + b(k,197) = b(k,197) - lu(k,1910) * b(k,194) + b(k,198) = b(k,198) - lu(k,1911) * b(k,194) + b(k,199) = b(k,199) - lu(k,1912) * b(k,194) + b(k,200) = b(k,200) - lu(k,1913) * b(k,194) + b(k,201) = b(k,201) - lu(k,1914) * b(k,194) + b(k,196) = b(k,196) - lu(k,1929) * b(k,195) + b(k,197) = b(k,197) - lu(k,1930) * b(k,195) + b(k,198) = b(k,198) - lu(k,1931) * b(k,195) + b(k,199) = b(k,199) - lu(k,1932) * b(k,195) + b(k,200) = b(k,200) - lu(k,1933) * b(k,195) + b(k,201) = b(k,201) - lu(k,1934) * b(k,195) + b(k,197) = b(k,197) - lu(k,1952) * b(k,196) + b(k,198) = b(k,198) - lu(k,1953) * b(k,196) + b(k,199) = b(k,199) - lu(k,1954) * b(k,196) + b(k,200) = b(k,200) - lu(k,1955) * b(k,196) + b(k,201) = b(k,201) - lu(k,1956) * b(k,196) + b(k,198) = b(k,198) - lu(k,1995) * b(k,197) + b(k,199) = b(k,199) - lu(k,1996) * b(k,197) + b(k,200) = b(k,200) - lu(k,1997) * b(k,197) + b(k,201) = b(k,201) - lu(k,1998) * b(k,197) + b(k,199) = b(k,199) - lu(k,2020) * b(k,198) + b(k,200) = b(k,200) - lu(k,2021) * b(k,198) + b(k,201) = b(k,201) - lu(k,2022) * b(k,198) + b(k,200) = b(k,200) - lu(k,2116) * b(k,199) + b(k,201) = b(k,201) - lu(k,2117) * b(k,199) + b(k,201) = b(k,201) - lu(k,2144) * b(k,200) + end do + end subroutine lu_slv06 + subroutine lu_slv07( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,201) = b(k,201) * lu(k,2170) + b(k,200) = b(k,200) - lu(k,2169) * b(k,201) + b(k,199) = b(k,199) - lu(k,2168) * b(k,201) + b(k,198) = b(k,198) - lu(k,2167) * b(k,201) + b(k,197) = b(k,197) - lu(k,2166) * b(k,201) + b(k,196) = b(k,196) - lu(k,2165) * b(k,201) + b(k,195) = b(k,195) - lu(k,2164) * b(k,201) + b(k,194) = b(k,194) - lu(k,2163) * b(k,201) + b(k,193) = b(k,193) - lu(k,2162) * b(k,201) + b(k,192) = b(k,192) - lu(k,2161) * b(k,201) + b(k,191) = b(k,191) - lu(k,2160) * b(k,201) + b(k,190) = b(k,190) - lu(k,2159) * b(k,201) + b(k,189) = b(k,189) - lu(k,2158) * b(k,201) + b(k,188) = b(k,188) - lu(k,2157) * b(k,201) + b(k,187) = b(k,187) - lu(k,2156) * b(k,201) + b(k,186) = b(k,186) - lu(k,2155) * b(k,201) + b(k,185) = b(k,185) - lu(k,2154) * b(k,201) + b(k,184) = b(k,184) - lu(k,2153) * b(k,201) + b(k,183) = b(k,183) - lu(k,2152) * b(k,201) + b(k,182) = b(k,182) - lu(k,2151) * b(k,201) + b(k,172) = b(k,172) - lu(k,2150) * b(k,201) + b(k,155) = b(k,155) - lu(k,2149) * b(k,201) + b(k,136) = b(k,136) - lu(k,2148) * b(k,201) + b(k,65) = b(k,65) - lu(k,2147) * b(k,201) + b(k,59) = b(k,59) - lu(k,2146) * b(k,201) + b(k,42) = b(k,42) - lu(k,2145) * b(k,201) + b(k,200) = b(k,200) * lu(k,2143) + b(k,199) = b(k,199) - lu(k,2142) * b(k,200) + b(k,198) = b(k,198) - lu(k,2141) * b(k,200) + b(k,197) = b(k,197) - lu(k,2140) * b(k,200) + b(k,196) = b(k,196) - lu(k,2139) * b(k,200) + b(k,195) = b(k,195) - lu(k,2138) * b(k,200) + b(k,194) = b(k,194) - lu(k,2137) * b(k,200) + b(k,193) = b(k,193) - lu(k,2136) * b(k,200) + b(k,192) = b(k,192) - lu(k,2135) * b(k,200) + b(k,191) = b(k,191) - lu(k,2134) * b(k,200) + b(k,190) = b(k,190) - lu(k,2133) * b(k,200) + b(k,189) = b(k,189) - lu(k,2132) * b(k,200) + b(k,188) = b(k,188) - lu(k,2131) * b(k,200) + b(k,187) = b(k,187) - lu(k,2130) * b(k,200) + b(k,186) = b(k,186) - lu(k,2129) * b(k,200) + b(k,185) = b(k,185) - lu(k,2128) * b(k,200) + b(k,184) = b(k,184) - lu(k,2127) * b(k,200) + b(k,183) = b(k,183) - lu(k,2126) * b(k,200) + b(k,182) = b(k,182) - lu(k,2125) * b(k,200) + b(k,157) = b(k,157) - lu(k,2124) * b(k,200) + b(k,155) = b(k,155) - lu(k,2123) * b(k,200) + b(k,146) = b(k,146) - lu(k,2122) * b(k,200) + b(k,77) = b(k,77) - lu(k,2121) * b(k,200) + b(k,63) = b(k,63) - lu(k,2120) * b(k,200) + b(k,47) = b(k,47) - lu(k,2119) * b(k,200) + b(k,36) = b(k,36) - lu(k,2118) * b(k,200) + b(k,199) = b(k,199) * lu(k,2115) + b(k,198) = b(k,198) - lu(k,2114) * b(k,199) + b(k,197) = b(k,197) - lu(k,2113) * b(k,199) + b(k,196) = b(k,196) - lu(k,2112) * b(k,199) + b(k,195) = b(k,195) - lu(k,2111) * b(k,199) + b(k,194) = b(k,194) - lu(k,2110) * b(k,199) + b(k,193) = b(k,193) - lu(k,2109) * b(k,199) + b(k,192) = b(k,192) - lu(k,2108) * b(k,199) + b(k,191) = b(k,191) - lu(k,2107) * b(k,199) + b(k,190) = b(k,190) - lu(k,2106) * b(k,199) + b(k,189) = b(k,189) - lu(k,2105) * b(k,199) + b(k,188) = b(k,188) - lu(k,2104) * b(k,199) + b(k,187) = b(k,187) - lu(k,2103) * b(k,199) + b(k,186) = b(k,186) - lu(k,2102) * b(k,199) + b(k,185) = b(k,185) - lu(k,2101) * b(k,199) + b(k,184) = b(k,184) - lu(k,2100) * b(k,199) + b(k,183) = b(k,183) - lu(k,2099) * b(k,199) + b(k,181) = b(k,181) - lu(k,2098) * b(k,199) + b(k,180) = b(k,180) - lu(k,2097) * b(k,199) + b(k,179) = b(k,179) - lu(k,2096) * b(k,199) + b(k,178) = b(k,178) - lu(k,2095) * b(k,199) + b(k,177) = b(k,177) - lu(k,2094) * b(k,199) + b(k,176) = b(k,176) - lu(k,2093) * b(k,199) + b(k,175) = b(k,175) - lu(k,2092) * b(k,199) + b(k,174) = b(k,174) - lu(k,2091) * b(k,199) + b(k,173) = b(k,173) - lu(k,2090) * b(k,199) + b(k,172) = b(k,172) - lu(k,2089) * b(k,199) + b(k,171) = b(k,171) - lu(k,2088) * b(k,199) + b(k,170) = b(k,170) - lu(k,2087) * b(k,199) + b(k,169) = b(k,169) - lu(k,2086) * b(k,199) + b(k,168) = b(k,168) - lu(k,2085) * b(k,199) + b(k,167) = b(k,167) - lu(k,2084) * b(k,199) + b(k,166) = b(k,166) - lu(k,2083) * b(k,199) + b(k,165) = b(k,165) - lu(k,2082) * b(k,199) + b(k,164) = b(k,164) - lu(k,2081) * b(k,199) + b(k,163) = b(k,163) - lu(k,2080) * b(k,199) + b(k,161) = b(k,161) - lu(k,2079) * b(k,199) + b(k,158) = b(k,158) - lu(k,2078) * b(k,199) + b(k,156) = b(k,156) - lu(k,2077) * b(k,199) + b(k,154) = b(k,154) - lu(k,2076) * b(k,199) + b(k,152) = b(k,152) - lu(k,2075) * b(k,199) + b(k,150) = b(k,150) - lu(k,2074) * b(k,199) + b(k,149) = b(k,149) - lu(k,2073) * b(k,199) + b(k,147) = b(k,147) - lu(k,2072) * b(k,199) + b(k,146) = b(k,146) - lu(k,2071) * b(k,199) + b(k,145) = b(k,145) - lu(k,2070) * b(k,199) + b(k,143) = b(k,143) - lu(k,2069) * b(k,199) + b(k,142) = b(k,142) - lu(k,2068) * b(k,199) + b(k,141) = b(k,141) - lu(k,2067) * b(k,199) + b(k,135) = b(k,135) - lu(k,2066) * b(k,199) + b(k,134) = b(k,134) - lu(k,2065) * b(k,199) + b(k,133) = b(k,133) - lu(k,2064) * b(k,199) + b(k,132) = b(k,132) - lu(k,2063) * b(k,199) + b(k,131) = b(k,131) - lu(k,2062) * b(k,199) + b(k,130) = b(k,130) - lu(k,2061) * b(k,199) + b(k,128) = b(k,128) - lu(k,2060) * b(k,199) + b(k,127) = b(k,127) - lu(k,2059) * b(k,199) + b(k,125) = b(k,125) - lu(k,2058) * b(k,199) + b(k,124) = b(k,124) - lu(k,2057) * b(k,199) + b(k,122) = b(k,122) - lu(k,2056) * b(k,199) + b(k,118) = b(k,118) - lu(k,2055) * b(k,199) + b(k,117) = b(k,117) - lu(k,2054) * b(k,199) + b(k,116) = b(k,116) - lu(k,2053) * b(k,199) + b(k,115) = b(k,115) - lu(k,2052) * b(k,199) + b(k,111) = b(k,111) - lu(k,2051) * b(k,199) + b(k,109) = b(k,109) - lu(k,2050) * b(k,199) + b(k,105) = b(k,105) - lu(k,2049) * b(k,199) + b(k,104) = b(k,104) - lu(k,2048) * b(k,199) + b(k,103) = b(k,103) - lu(k,2047) * b(k,199) + b(k,101) = b(k,101) - lu(k,2046) * b(k,199) + b(k,100) = b(k,100) - lu(k,2045) * b(k,199) + b(k,99) = b(k,99) - lu(k,2044) * b(k,199) + b(k,98) = b(k,98) - lu(k,2043) * b(k,199) + b(k,96) = b(k,96) - lu(k,2042) * b(k,199) + b(k,95) = b(k,95) - lu(k,2041) * b(k,199) + b(k,94) = b(k,94) - lu(k,2040) * b(k,199) + b(k,93) = b(k,93) - lu(k,2039) * b(k,199) + b(k,92) = b(k,92) - lu(k,2038) * b(k,199) + b(k,91) = b(k,91) - lu(k,2037) * b(k,199) + b(k,90) = b(k,90) - lu(k,2036) * b(k,199) + b(k,89) = b(k,89) - lu(k,2035) * b(k,199) + b(k,88) = b(k,88) - lu(k,2034) * b(k,199) + b(k,87) = b(k,87) - lu(k,2033) * b(k,199) + b(k,86) = b(k,86) - lu(k,2032) * b(k,199) + b(k,84) = b(k,84) - lu(k,2031) * b(k,199) + b(k,80) = b(k,80) - lu(k,2030) * b(k,199) + b(k,79) = b(k,79) - lu(k,2029) * b(k,199) + b(k,78) = b(k,78) - lu(k,2028) * b(k,199) + b(k,75) = b(k,75) - lu(k,2027) * b(k,199) + b(k,74) = b(k,74) - lu(k,2026) * b(k,199) + b(k,67) = b(k,67) - lu(k,2025) * b(k,199) + b(k,56) = b(k,56) - lu(k,2024) * b(k,199) + b(k,41) = b(k,41) - lu(k,2023) * b(k,199) + b(k,198) = b(k,198) * lu(k,2019) + b(k,197) = b(k,197) - lu(k,2018) * b(k,198) + b(k,196) = b(k,196) - lu(k,2017) * b(k,198) + b(k,195) = b(k,195) - lu(k,2016) * b(k,198) + b(k,194) = b(k,194) - lu(k,2015) * b(k,198) + b(k,193) = b(k,193) - lu(k,2014) * b(k,198) + b(k,192) = b(k,192) - lu(k,2013) * b(k,198) + b(k,191) = b(k,191) - lu(k,2012) * b(k,198) + b(k,190) = b(k,190) - lu(k,2011) * b(k,198) + b(k,189) = b(k,189) - lu(k,2010) * b(k,198) + b(k,188) = b(k,188) - lu(k,2009) * b(k,198) + b(k,187) = b(k,187) - lu(k,2008) * b(k,198) + b(k,186) = b(k,186) - lu(k,2007) * b(k,198) + b(k,184) = b(k,184) - lu(k,2006) * b(k,198) + b(k,183) = b(k,183) - lu(k,2005) * b(k,198) + b(k,182) = b(k,182) - lu(k,2004) * b(k,198) + b(k,155) = b(k,155) - lu(k,2003) * b(k,198) + b(k,134) = b(k,134) - lu(k,2002) * b(k,198) + b(k,110) = b(k,110) - lu(k,2001) * b(k,198) + b(k,77) = b(k,77) - lu(k,2000) * b(k,198) + b(k,63) = b(k,63) - lu(k,1999) * b(k,198) + b(k,197) = b(k,197) * lu(k,1994) + b(k,196) = b(k,196) - lu(k,1993) * b(k,197) + b(k,195) = b(k,195) - lu(k,1992) * b(k,197) + b(k,194) = b(k,194) - lu(k,1991) * b(k,197) + b(k,193) = b(k,193) - lu(k,1990) * b(k,197) + b(k,192) = b(k,192) - lu(k,1989) * b(k,197) + b(k,191) = b(k,191) - lu(k,1988) * b(k,197) + b(k,190) = b(k,190) - lu(k,1987) * b(k,197) + b(k,189) = b(k,189) - lu(k,1986) * b(k,197) + b(k,188) = b(k,188) - lu(k,1985) * b(k,197) + b(k,187) = b(k,187) - lu(k,1984) * b(k,197) + b(k,186) = b(k,186) - lu(k,1983) * b(k,197) + b(k,185) = b(k,185) - lu(k,1982) * b(k,197) + b(k,184) = b(k,184) - lu(k,1981) * b(k,197) + b(k,183) = b(k,183) - lu(k,1980) * b(k,197) + b(k,182) = b(k,182) - lu(k,1979) * b(k,197) + b(k,181) = b(k,181) - lu(k,1978) * b(k,197) + b(k,180) = b(k,180) - lu(k,1977) * b(k,197) + b(k,175) = b(k,175) - lu(k,1976) * b(k,197) + b(k,165) = b(k,165) - lu(k,1975) * b(k,197) + b(k,164) = b(k,164) - lu(k,1974) * b(k,197) + b(k,157) = b(k,157) - lu(k,1973) * b(k,197) + b(k,155) = b(k,155) - lu(k,1972) * b(k,197) + b(k,150) = b(k,150) - lu(k,1971) * b(k,197) + b(k,149) = b(k,149) - lu(k,1970) * b(k,197) + b(k,144) = b(k,144) - lu(k,1969) * b(k,197) + b(k,134) = b(k,134) - lu(k,1968) * b(k,197) + b(k,133) = b(k,133) - lu(k,1967) * b(k,197) + b(k,130) = b(k,130) - lu(k,1966) * b(k,197) + b(k,122) = b(k,122) - lu(k,1965) * b(k,197) + b(k,114) = b(k,114) - lu(k,1964) * b(k,197) + b(k,110) = b(k,110) - lu(k,1963) * b(k,197) + b(k,104) = b(k,104) - lu(k,1962) * b(k,197) + b(k,99) = b(k,99) - lu(k,1961) * b(k,197) + b(k,98) = b(k,98) - lu(k,1960) * b(k,197) + b(k,97) = b(k,97) - lu(k,1959) * b(k,197) + b(k,68) = b(k,68) - lu(k,1958) * b(k,197) + b(k,44) = b(k,44) - lu(k,1957) * b(k,197) + end do + end subroutine lu_slv07 + subroutine lu_slv08( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,196) = b(k,196) * lu(k,1951) + b(k,195) = b(k,195) - lu(k,1950) * b(k,196) + b(k,194) = b(k,194) - lu(k,1949) * b(k,196) + b(k,193) = b(k,193) - lu(k,1948) * b(k,196) + b(k,192) = b(k,192) - lu(k,1947) * b(k,196) + b(k,191) = b(k,191) - lu(k,1946) * b(k,196) + b(k,190) = b(k,190) - lu(k,1945) * b(k,196) + b(k,189) = b(k,189) - lu(k,1944) * b(k,196) + b(k,188) = b(k,188) - lu(k,1943) * b(k,196) + b(k,187) = b(k,187) - lu(k,1942) * b(k,196) + b(k,186) = b(k,186) - lu(k,1941) * b(k,196) + b(k,185) = b(k,185) - lu(k,1940) * b(k,196) + b(k,184) = b(k,184) - lu(k,1939) * b(k,196) + b(k,183) = b(k,183) - lu(k,1938) * b(k,196) + b(k,172) = b(k,172) - lu(k,1937) * b(k,196) + b(k,136) = b(k,136) - lu(k,1936) * b(k,196) + b(k,59) = b(k,59) - lu(k,1935) * b(k,196) + b(k,195) = b(k,195) * lu(k,1928) + b(k,194) = b(k,194) - lu(k,1927) * b(k,195) + b(k,193) = b(k,193) - lu(k,1926) * b(k,195) + b(k,192) = b(k,192) - lu(k,1925) * b(k,195) + b(k,191) = b(k,191) - lu(k,1924) * b(k,195) + b(k,190) = b(k,190) - lu(k,1923) * b(k,195) + b(k,189) = b(k,189) - lu(k,1922) * b(k,195) + b(k,188) = b(k,188) - lu(k,1921) * b(k,195) + b(k,187) = b(k,187) - lu(k,1920) * b(k,195) + b(k,186) = b(k,186) - lu(k,1919) * b(k,195) + b(k,185) = b(k,185) - lu(k,1918) * b(k,195) + b(k,184) = b(k,184) - lu(k,1917) * b(k,195) + b(k,183) = b(k,183) - lu(k,1916) * b(k,195) + b(k,172) = b(k,172) - lu(k,1915) * b(k,195) + b(k,194) = b(k,194) * lu(k,1907) + b(k,193) = b(k,193) - lu(k,1906) * b(k,194) + b(k,192) = b(k,192) - lu(k,1905) * b(k,194) + b(k,191) = b(k,191) - lu(k,1904) * b(k,194) + b(k,190) = b(k,190) - lu(k,1903) * b(k,194) + b(k,189) = b(k,189) - lu(k,1902) * b(k,194) + b(k,188) = b(k,188) - lu(k,1901) * b(k,194) + b(k,187) = b(k,187) - lu(k,1900) * b(k,194) + b(k,186) = b(k,186) - lu(k,1899) * b(k,194) + b(k,185) = b(k,185) - lu(k,1898) * b(k,194) + b(k,184) = b(k,184) - lu(k,1897) * b(k,194) + b(k,182) = b(k,182) - lu(k,1896) * b(k,194) + b(k,181) = b(k,181) - lu(k,1895) * b(k,194) + b(k,180) = b(k,180) - lu(k,1894) * b(k,194) + b(k,179) = b(k,179) - lu(k,1893) * b(k,194) + b(k,178) = b(k,178) - lu(k,1892) * b(k,194) + b(k,177) = b(k,177) - lu(k,1891) * b(k,194) + b(k,176) = b(k,176) - lu(k,1890) * b(k,194) + b(k,175) = b(k,175) - lu(k,1889) * b(k,194) + b(k,174) = b(k,174) - lu(k,1888) * b(k,194) + b(k,173) = b(k,173) - lu(k,1887) * b(k,194) + b(k,171) = b(k,171) - lu(k,1886) * b(k,194) + b(k,170) = b(k,170) - lu(k,1885) * b(k,194) + b(k,169) = b(k,169) - lu(k,1884) * b(k,194) + b(k,168) = b(k,168) - lu(k,1883) * b(k,194) + b(k,167) = b(k,167) - lu(k,1882) * b(k,194) + b(k,166) = b(k,166) - lu(k,1881) * b(k,194) + b(k,165) = b(k,165) - lu(k,1880) * b(k,194) + b(k,164) = b(k,164) - lu(k,1879) * b(k,194) + b(k,163) = b(k,163) - lu(k,1878) * b(k,194) + b(k,162) = b(k,162) - lu(k,1877) * b(k,194) + b(k,161) = b(k,161) - lu(k,1876) * b(k,194) + b(k,160) = b(k,160) - lu(k,1875) * b(k,194) + b(k,159) = b(k,159) - lu(k,1874) * b(k,194) + b(k,158) = b(k,158) - lu(k,1873) * b(k,194) + b(k,156) = b(k,156) - lu(k,1872) * b(k,194) + b(k,155) = b(k,155) - lu(k,1871) * b(k,194) + b(k,154) = b(k,154) - lu(k,1870) * b(k,194) + b(k,153) = b(k,153) - lu(k,1869) * b(k,194) + b(k,151) = b(k,151) - lu(k,1868) * b(k,194) + b(k,149) = b(k,149) - lu(k,1867) * b(k,194) + b(k,148) = b(k,148) - lu(k,1866) * b(k,194) + b(k,147) = b(k,147) - lu(k,1865) * b(k,194) + b(k,113) = b(k,113) - lu(k,1864) * b(k,194) + b(k,82) = b(k,82) - lu(k,1863) * b(k,194) + b(k,73) = b(k,73) - lu(k,1862) * b(k,194) + b(k,69) = b(k,69) - lu(k,1861) * b(k,194) + b(k,68) = b(k,68) - lu(k,1860) * b(k,194) + b(k,33) = b(k,33) - lu(k,1859) * b(k,194) + b(k,32) = b(k,32) - lu(k,1858) * b(k,194) + b(k,193) = b(k,193) * lu(k,1849) + b(k,192) = b(k,192) - lu(k,1848) * b(k,193) + b(k,191) = b(k,191) - lu(k,1847) * b(k,193) + b(k,190) = b(k,190) - lu(k,1846) * b(k,193) + b(k,189) = b(k,189) - lu(k,1845) * b(k,193) + b(k,188) = b(k,188) - lu(k,1844) * b(k,193) + b(k,187) = b(k,187) - lu(k,1843) * b(k,193) + b(k,186) = b(k,186) - lu(k,1842) * b(k,193) + b(k,185) = b(k,185) - lu(k,1841) * b(k,193) + b(k,184) = b(k,184) - lu(k,1840) * b(k,193) + b(k,183) = b(k,183) - lu(k,1839) * b(k,193) + b(k,172) = b(k,172) - lu(k,1838) * b(k,193) + b(k,165) = b(k,165) - lu(k,1837) * b(k,193) + b(k,145) = b(k,145) - lu(k,1836) * b(k,193) + b(k,141) = b(k,141) - lu(k,1835) * b(k,193) + b(k,93) = b(k,93) - lu(k,1834) * b(k,193) + b(k,192) = b(k,192) * lu(k,1824) + b(k,191) = b(k,191) - lu(k,1823) * b(k,192) + b(k,190) = b(k,190) - lu(k,1822) * b(k,192) + b(k,189) = b(k,189) - lu(k,1821) * b(k,192) + b(k,188) = b(k,188) - lu(k,1820) * b(k,192) + b(k,187) = b(k,187) - lu(k,1819) * b(k,192) + b(k,186) = b(k,186) - lu(k,1818) * b(k,192) + b(k,185) = b(k,185) - lu(k,1817) * b(k,192) + b(k,184) = b(k,184) - lu(k,1816) * b(k,192) + b(k,183) = b(k,183) - lu(k,1815) * b(k,192) + b(k,182) = b(k,182) - lu(k,1814) * b(k,192) + b(k,172) = b(k,172) - lu(k,1813) * b(k,192) + b(k,165) = b(k,165) - lu(k,1812) * b(k,192) + b(k,157) = b(k,157) - lu(k,1811) * b(k,192) + b(k,155) = b(k,155) - lu(k,1810) * b(k,192) + b(k,146) = b(k,146) - lu(k,1809) * b(k,192) + b(k,145) = b(k,145) - lu(k,1808) * b(k,192) + b(k,144) = b(k,144) - lu(k,1807) * b(k,192) + b(k,139) = b(k,139) - lu(k,1806) * b(k,192) + b(k,138) = b(k,138) - lu(k,1805) * b(k,192) + b(k,137) = b(k,137) - lu(k,1804) * b(k,192) + b(k,134) = b(k,134) - lu(k,1803) * b(k,192) + b(k,129) = b(k,129) - lu(k,1802) * b(k,192) + b(k,126) = b(k,126) - lu(k,1801) * b(k,192) + b(k,120) = b(k,120) - lu(k,1800) * b(k,192) + b(k,115) = b(k,115) - lu(k,1799) * b(k,192) + b(k,110) = b(k,110) - lu(k,1798) * b(k,192) + b(k,106) = b(k,106) - lu(k,1797) * b(k,192) + b(k,102) = b(k,102) - lu(k,1796) * b(k,192) + b(k,81) = b(k,81) - lu(k,1795) * b(k,192) + b(k,46) = b(k,46) - lu(k,1794) * b(k,192) + b(k,45) = b(k,45) - lu(k,1793) * b(k,192) + b(k,191) = b(k,191) * lu(k,1782) + b(k,190) = b(k,190) - lu(k,1781) * b(k,191) + b(k,189) = b(k,189) - lu(k,1780) * b(k,191) + b(k,188) = b(k,188) - lu(k,1779) * b(k,191) + b(k,187) = b(k,187) - lu(k,1778) * b(k,191) + b(k,186) = b(k,186) - lu(k,1777) * b(k,191) + b(k,185) = b(k,185) - lu(k,1776) * b(k,191) + b(k,184) = b(k,184) - lu(k,1775) * b(k,191) + b(k,182) = b(k,182) - lu(k,1774) * b(k,191) + b(k,181) = b(k,181) - lu(k,1773) * b(k,191) + b(k,180) = b(k,180) - lu(k,1772) * b(k,191) + b(k,179) = b(k,179) - lu(k,1771) * b(k,191) + b(k,178) = b(k,178) - lu(k,1770) * b(k,191) + b(k,177) = b(k,177) - lu(k,1769) * b(k,191) + b(k,176) = b(k,176) - lu(k,1768) * b(k,191) + b(k,175) = b(k,175) - lu(k,1767) * b(k,191) + b(k,174) = b(k,174) - lu(k,1766) * b(k,191) + b(k,173) = b(k,173) - lu(k,1765) * b(k,191) + b(k,170) = b(k,170) - lu(k,1764) * b(k,191) + b(k,169) = b(k,169) - lu(k,1763) * b(k,191) + b(k,168) = b(k,168) - lu(k,1762) * b(k,191) + b(k,167) = b(k,167) - lu(k,1761) * b(k,191) + b(k,166) = b(k,166) - lu(k,1760) * b(k,191) + b(k,165) = b(k,165) - lu(k,1759) * b(k,191) + b(k,164) = b(k,164) - lu(k,1758) * b(k,191) + b(k,163) = b(k,163) - lu(k,1757) * b(k,191) + b(k,161) = b(k,161) - lu(k,1756) * b(k,191) + b(k,160) = b(k,160) - lu(k,1755) * b(k,191) + b(k,158) = b(k,158) - lu(k,1754) * b(k,191) + b(k,156) = b(k,156) - lu(k,1753) * b(k,191) + b(k,155) = b(k,155) - lu(k,1752) * b(k,191) + b(k,154) = b(k,154) - lu(k,1751) * b(k,191) + b(k,153) = b(k,153) - lu(k,1750) * b(k,191) + b(k,151) = b(k,151) - lu(k,1749) * b(k,191) + b(k,149) = b(k,149) - lu(k,1748) * b(k,191) + b(k,148) = b(k,148) - lu(k,1747) * b(k,191) + b(k,141) = b(k,141) - lu(k,1746) * b(k,191) + b(k,135) = b(k,135) - lu(k,1745) * b(k,191) + b(k,129) = b(k,129) - lu(k,1744) * b(k,191) + b(k,122) = b(k,122) - lu(k,1743) * b(k,191) + b(k,112) = b(k,112) - lu(k,1742) * b(k,191) + b(k,111) = b(k,111) - lu(k,1741) * b(k,191) + b(k,98) = b(k,98) - lu(k,1740) * b(k,191) + b(k,85) = b(k,85) - lu(k,1739) * b(k,191) + b(k,62) = b(k,62) - lu(k,1738) * b(k,191) + b(k,46) = b(k,46) - lu(k,1737) * b(k,191) + b(k,45) = b(k,45) - lu(k,1736) * b(k,191) + b(k,33) = b(k,33) - lu(k,1735) * b(k,191) + b(k,32) = b(k,32) - lu(k,1734) * b(k,191) + b(k,31) = b(k,31) - lu(k,1733) * b(k,191) + b(k,30) = b(k,30) - lu(k,1732) * b(k,191) + b(k,29) = b(k,29) - lu(k,1731) * b(k,191) + b(k,190) = b(k,190) * lu(k,1719) + b(k,189) = b(k,189) - lu(k,1718) * b(k,190) + b(k,188) = b(k,188) - lu(k,1717) * b(k,190) + b(k,187) = b(k,187) - lu(k,1716) * b(k,190) + b(k,186) = b(k,186) - lu(k,1715) * b(k,190) + b(k,185) = b(k,185) - lu(k,1714) * b(k,190) + b(k,184) = b(k,184) - lu(k,1713) * b(k,190) + b(k,183) = b(k,183) - lu(k,1712) * b(k,190) + b(k,182) = b(k,182) - lu(k,1711) * b(k,190) + b(k,181) = b(k,181) - lu(k,1710) * b(k,190) + b(k,180) = b(k,180) - lu(k,1709) * b(k,190) + b(k,179) = b(k,179) - lu(k,1708) * b(k,190) + b(k,178) = b(k,178) - lu(k,1707) * b(k,190) + b(k,177) = b(k,177) - lu(k,1706) * b(k,190) + b(k,176) = b(k,176) - lu(k,1705) * b(k,190) + b(k,175) = b(k,175) - lu(k,1704) * b(k,190) + b(k,174) = b(k,174) - lu(k,1703) * b(k,190) + b(k,173) = b(k,173) - lu(k,1702) * b(k,190) + b(k,172) = b(k,172) - lu(k,1701) * b(k,190) + b(k,171) = b(k,171) - lu(k,1700) * b(k,190) + b(k,170) = b(k,170) - lu(k,1699) * b(k,190) + b(k,169) = b(k,169) - lu(k,1698) * b(k,190) + b(k,168) = b(k,168) - lu(k,1697) * b(k,190) + b(k,167) = b(k,167) - lu(k,1696) * b(k,190) + b(k,166) = b(k,166) - lu(k,1695) * b(k,190) + b(k,165) = b(k,165) - lu(k,1694) * b(k,190) + b(k,164) = b(k,164) - lu(k,1693) * b(k,190) + b(k,163) = b(k,163) - lu(k,1692) * b(k,190) + b(k,162) = b(k,162) - lu(k,1691) * b(k,190) + b(k,161) = b(k,161) - lu(k,1690) * b(k,190) + b(k,160) = b(k,160) - lu(k,1689) * b(k,190) + b(k,159) = b(k,159) - lu(k,1688) * b(k,190) + b(k,158) = b(k,158) - lu(k,1687) * b(k,190) + b(k,157) = b(k,157) - lu(k,1686) * b(k,190) + b(k,156) = b(k,156) - lu(k,1685) * b(k,190) + b(k,155) = b(k,155) - lu(k,1684) * b(k,190) + b(k,154) = b(k,154) - lu(k,1683) * b(k,190) + b(k,153) = b(k,153) - lu(k,1682) * b(k,190) + b(k,152) = b(k,152) - lu(k,1681) * b(k,190) + b(k,151) = b(k,151) - lu(k,1680) * b(k,190) + b(k,150) = b(k,150) - lu(k,1679) * b(k,190) + b(k,149) = b(k,149) - lu(k,1678) * b(k,190) + b(k,148) = b(k,148) - lu(k,1677) * b(k,190) + b(k,147) = b(k,147) - lu(k,1676) * b(k,190) + b(k,146) = b(k,146) - lu(k,1675) * b(k,190) + b(k,145) = b(k,145) - lu(k,1674) * b(k,190) + b(k,144) = b(k,144) - lu(k,1673) * b(k,190) + b(k,143) = b(k,143) - lu(k,1672) * b(k,190) + b(k,142) = b(k,142) - lu(k,1671) * b(k,190) + b(k,141) = b(k,141) - lu(k,1670) * b(k,190) + b(k,140) = b(k,140) - lu(k,1669) * b(k,190) + b(k,136) = b(k,136) - lu(k,1668) * b(k,190) + b(k,135) = b(k,135) - lu(k,1667) * b(k,190) + b(k,133) = b(k,133) - lu(k,1666) * b(k,190) + b(k,132) = b(k,132) - lu(k,1665) * b(k,190) + b(k,131) = b(k,131) - lu(k,1664) * b(k,190) + b(k,130) = b(k,130) - lu(k,1663) * b(k,190) + b(k,129) = b(k,129) - lu(k,1662) * b(k,190) + b(k,128) = b(k,128) - lu(k,1661) * b(k,190) + b(k,127) = b(k,127) - lu(k,1660) * b(k,190) + b(k,125) = b(k,125) - lu(k,1659) * b(k,190) + b(k,124) = b(k,124) - lu(k,1658) * b(k,190) + b(k,123) = b(k,123) - lu(k,1657) * b(k,190) + b(k,122) = b(k,122) - lu(k,1656) * b(k,190) + b(k,121) = b(k,121) - lu(k,1655) * b(k,190) + b(k,119) = b(k,119) - lu(k,1654) * b(k,190) + b(k,118) = b(k,118) - lu(k,1653) * b(k,190) + b(k,117) = b(k,117) - lu(k,1652) * b(k,190) + b(k,116) = b(k,116) - lu(k,1651) * b(k,190) + b(k,115) = b(k,115) - lu(k,1650) * b(k,190) + b(k,114) = b(k,114) - lu(k,1649) * b(k,190) + b(k,113) = b(k,113) - lu(k,1648) * b(k,190) + b(k,112) = b(k,112) - lu(k,1647) * b(k,190) + b(k,111) = b(k,111) - lu(k,1646) * b(k,190) + b(k,109) = b(k,109) - lu(k,1645) * b(k,190) + b(k,108) = b(k,108) - lu(k,1644) * b(k,190) + b(k,107) = b(k,107) - lu(k,1643) * b(k,190) + b(k,105) = b(k,105) - lu(k,1642) * b(k,190) + b(k,104) = b(k,104) - lu(k,1641) * b(k,190) + b(k,103) = b(k,103) - lu(k,1640) * b(k,190) + b(k,101) = b(k,101) - lu(k,1639) * b(k,190) + b(k,100) = b(k,100) - lu(k,1638) * b(k,190) + b(k,99) = b(k,99) - lu(k,1637) * b(k,190) + b(k,98) = b(k,98) - lu(k,1636) * b(k,190) + b(k,97) = b(k,97) - lu(k,1635) * b(k,190) + b(k,95) = b(k,95) - lu(k,1634) * b(k,190) + b(k,94) = b(k,94) - lu(k,1633) * b(k,190) + b(k,92) = b(k,92) - lu(k,1632) * b(k,190) + b(k,91) = b(k,91) - lu(k,1631) * b(k,190) + b(k,90) = b(k,90) - lu(k,1630) * b(k,190) + b(k,89) = b(k,89) - lu(k,1629) * b(k,190) + b(k,88) = b(k,88) - lu(k,1628) * b(k,190) + b(k,87) = b(k,87) - lu(k,1627) * b(k,190) + b(k,86) = b(k,86) - lu(k,1626) * b(k,190) + b(k,84) = b(k,84) - lu(k,1625) * b(k,190) + b(k,83) = b(k,83) - lu(k,1624) * b(k,190) + b(k,82) = b(k,82) - lu(k,1623) * b(k,190) + b(k,81) = b(k,81) - lu(k,1622) * b(k,190) + b(k,80) = b(k,80) - lu(k,1621) * b(k,190) + b(k,79) = b(k,79) - lu(k,1620) * b(k,190) + b(k,78) = b(k,78) - lu(k,1619) * b(k,190) + b(k,75) = b(k,75) - lu(k,1618) * b(k,190) + b(k,74) = b(k,74) - lu(k,1617) * b(k,190) + b(k,73) = b(k,73) - lu(k,1616) * b(k,190) + b(k,72) = b(k,72) - lu(k,1615) * b(k,190) + b(k,71) = b(k,71) - lu(k,1614) * b(k,190) + b(k,69) = b(k,69) - lu(k,1613) * b(k,190) + b(k,67) = b(k,67) - lu(k,1612) * b(k,190) + b(k,66) = b(k,66) - lu(k,1611) * b(k,190) + b(k,65) = b(k,65) - lu(k,1610) * b(k,190) + b(k,64) = b(k,64) - lu(k,1609) * b(k,190) + b(k,62) = b(k,62) - lu(k,1608) * b(k,190) + b(k,61) = b(k,61) - lu(k,1607) * b(k,190) + b(k,60) = b(k,60) - lu(k,1606) * b(k,190) + b(k,58) = b(k,58) - lu(k,1605) * b(k,190) + b(k,57) = b(k,57) - lu(k,1604) * b(k,190) + b(k,56) = b(k,56) - lu(k,1603) * b(k,190) + b(k,55) = b(k,55) - lu(k,1602) * b(k,190) + b(k,54) = b(k,54) - lu(k,1601) * b(k,190) + b(k,53) = b(k,53) - lu(k,1600) * b(k,190) + b(k,52) = b(k,52) - lu(k,1599) * b(k,190) + b(k,51) = b(k,51) - lu(k,1598) * b(k,190) + b(k,50) = b(k,50) - lu(k,1597) * b(k,190) + b(k,49) = b(k,49) - lu(k,1596) * b(k,190) + b(k,48) = b(k,48) - lu(k,1595) * b(k,190) + b(k,43) = b(k,43) - lu(k,1594) * b(k,190) + b(k,40) = b(k,40) - lu(k,1593) * b(k,190) + b(k,39) = b(k,39) - lu(k,1592) * b(k,190) + b(k,38) = b(k,38) - lu(k,1591) * b(k,190) + b(k,37) = b(k,37) - lu(k,1590) * b(k,190) + b(k,35) = b(k,35) - lu(k,1589) * b(k,190) + b(k,34) = b(k,34) - lu(k,1588) * b(k,190) + b(k,33) = b(k,33) - lu(k,1587) * b(k,190) + b(k,32) = b(k,32) - lu(k,1586) * b(k,190) + b(k,31) = b(k,31) - lu(k,1585) * b(k,190) + b(k,30) = b(k,30) - lu(k,1584) * b(k,190) + b(k,29) = b(k,29) - lu(k,1583) * b(k,190) + end do + end subroutine lu_slv08 + subroutine lu_slv09( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,189) = b(k,189) * lu(k,1570) + b(k,188) = b(k,188) - lu(k,1569) * b(k,189) + b(k,187) = b(k,187) - lu(k,1568) * b(k,189) + b(k,186) = b(k,186) - lu(k,1567) * b(k,189) + b(k,185) = b(k,185) - lu(k,1566) * b(k,189) + b(k,184) = b(k,184) - lu(k,1565) * b(k,189) + b(k,183) = b(k,183) - lu(k,1564) * b(k,189) + b(k,172) = b(k,172) - lu(k,1563) * b(k,189) + b(k,145) = b(k,145) - lu(k,1562) * b(k,189) + b(k,136) = b(k,136) - lu(k,1561) * b(k,189) + b(k,52) = b(k,52) - lu(k,1560) * b(k,189) + b(k,51) = b(k,51) - lu(k,1559) * b(k,189) + b(k,46) = b(k,46) - lu(k,1558) * b(k,189) + b(k,40) = b(k,40) - lu(k,1557) * b(k,189) + b(k,188) = b(k,188) * lu(k,1543) + b(k,187) = b(k,187) - lu(k,1542) * b(k,188) + b(k,186) = b(k,186) - lu(k,1541) * b(k,188) + b(k,185) = b(k,185) - lu(k,1540) * b(k,188) + b(k,184) = b(k,184) - lu(k,1539) * b(k,188) + b(k,183) = b(k,183) - lu(k,1538) * b(k,188) + b(k,181) = b(k,181) - lu(k,1537) * b(k,188) + b(k,172) = b(k,172) - lu(k,1536) * b(k,188) + b(k,170) = b(k,170) - lu(k,1535) * b(k,188) + b(k,165) = b(k,165) - lu(k,1534) * b(k,188) + b(k,161) = b(k,161) - lu(k,1533) * b(k,188) + b(k,157) = b(k,157) - lu(k,1532) * b(k,188) + b(k,152) = b(k,152) - lu(k,1531) * b(k,188) + b(k,149) = b(k,149) - lu(k,1530) * b(k,188) + b(k,146) = b(k,146) - lu(k,1529) * b(k,188) + b(k,141) = b(k,141) - lu(k,1528) * b(k,188) + b(k,135) = b(k,135) - lu(k,1527) * b(k,188) + b(k,115) = b(k,115) - lu(k,1526) * b(k,188) + b(k,112) = b(k,112) - lu(k,1525) * b(k,188) + b(k,72) = b(k,72) - lu(k,1524) * b(k,188) + b(k,71) = b(k,71) - lu(k,1523) * b(k,188) + b(k,47) = b(k,47) - lu(k,1522) * b(k,188) + b(k,187) = b(k,187) * lu(k,1507) + b(k,186) = b(k,186) - lu(k,1506) * b(k,187) + b(k,185) = b(k,185) - lu(k,1505) * b(k,187) + b(k,184) = b(k,184) - lu(k,1504) * b(k,187) + b(k,181) = b(k,181) - lu(k,1503) * b(k,187) + b(k,180) = b(k,180) - lu(k,1502) * b(k,187) + b(k,179) = b(k,179) - lu(k,1501) * b(k,187) + b(k,178) = b(k,178) - lu(k,1500) * b(k,187) + b(k,177) = b(k,177) - lu(k,1499) * b(k,187) + b(k,176) = b(k,176) - lu(k,1498) * b(k,187) + b(k,175) = b(k,175) - lu(k,1497) * b(k,187) + b(k,174) = b(k,174) - lu(k,1496) * b(k,187) + b(k,173) = b(k,173) - lu(k,1495) * b(k,187) + b(k,171) = b(k,171) - lu(k,1494) * b(k,187) + b(k,170) = b(k,170) - lu(k,1493) * b(k,187) + b(k,169) = b(k,169) - lu(k,1492) * b(k,187) + b(k,168) = b(k,168) - lu(k,1491) * b(k,187) + b(k,167) = b(k,167) - lu(k,1490) * b(k,187) + b(k,166) = b(k,166) - lu(k,1489) * b(k,187) + b(k,165) = b(k,165) - lu(k,1488) * b(k,187) + b(k,164) = b(k,164) - lu(k,1487) * b(k,187) + b(k,163) = b(k,163) - lu(k,1486) * b(k,187) + b(k,162) = b(k,162) - lu(k,1485) * b(k,187) + b(k,161) = b(k,161) - lu(k,1484) * b(k,187) + b(k,159) = b(k,159) - lu(k,1483) * b(k,187) + b(k,158) = b(k,158) - lu(k,1482) * b(k,187) + b(k,156) = b(k,156) - lu(k,1481) * b(k,187) + b(k,154) = b(k,154) - lu(k,1480) * b(k,187) + b(k,152) = b(k,152) - lu(k,1479) * b(k,187) + b(k,150) = b(k,150) - lu(k,1478) * b(k,187) + b(k,149) = b(k,149) - lu(k,1477) * b(k,187) + b(k,147) = b(k,147) - lu(k,1476) * b(k,187) + b(k,144) = b(k,144) - lu(k,1475) * b(k,187) + b(k,143) = b(k,143) - lu(k,1474) * b(k,187) + b(k,142) = b(k,142) - lu(k,1473) * b(k,187) + b(k,141) = b(k,141) - lu(k,1472) * b(k,187) + b(k,139) = b(k,139) - lu(k,1471) * b(k,187) + b(k,138) = b(k,138) - lu(k,1470) * b(k,187) + b(k,137) = b(k,137) - lu(k,1469) * b(k,187) + b(k,135) = b(k,135) - lu(k,1468) * b(k,187) + b(k,133) = b(k,133) - lu(k,1467) * b(k,187) + b(k,132) = b(k,132) - lu(k,1466) * b(k,187) + b(k,131) = b(k,131) - lu(k,1465) * b(k,187) + b(k,130) = b(k,130) - lu(k,1464) * b(k,187) + b(k,125) = b(k,125) - lu(k,1463) * b(k,187) + b(k,123) = b(k,123) - lu(k,1462) * b(k,187) + b(k,122) = b(k,122) - lu(k,1461) * b(k,187) + b(k,121) = b(k,121) - lu(k,1460) * b(k,187) + b(k,119) = b(k,119) - lu(k,1459) * b(k,187) + b(k,118) = b(k,118) - lu(k,1458) * b(k,187) + b(k,113) = b(k,113) - lu(k,1457) * b(k,187) + b(k,108) = b(k,108) - lu(k,1456) * b(k,187) + b(k,107) = b(k,107) - lu(k,1455) * b(k,187) + b(k,104) = b(k,104) - lu(k,1454) * b(k,187) + b(k,103) = b(k,103) - lu(k,1453) * b(k,187) + b(k,101) = b(k,101) - lu(k,1452) * b(k,187) + b(k,98) = b(k,98) - lu(k,1451) * b(k,187) + b(k,96) = b(k,96) - lu(k,1450) * b(k,187) + b(k,95) = b(k,95) - lu(k,1449) * b(k,187) + b(k,94) = b(k,94) - lu(k,1448) * b(k,187) + b(k,93) = b(k,93) - lu(k,1447) * b(k,187) + b(k,92) = b(k,92) - lu(k,1446) * b(k,187) + b(k,76) = b(k,76) - lu(k,1445) * b(k,187) + b(k,73) = b(k,73) - lu(k,1444) * b(k,187) + b(k,70) = b(k,70) - lu(k,1443) * b(k,187) + b(k,64) = b(k,64) - lu(k,1442) * b(k,187) + b(k,61) = b(k,61) - lu(k,1441) * b(k,187) + b(k,186) = b(k,186) * lu(k,1427) + b(k,184) = b(k,184) - lu(k,1426) * b(k,186) + b(k,182) = b(k,182) - lu(k,1425) * b(k,186) + b(k,165) = b(k,165) - lu(k,1424) * b(k,186) + b(k,161) = b(k,161) - lu(k,1423) * b(k,186) + b(k,155) = b(k,155) - lu(k,1422) * b(k,186) + b(k,144) = b(k,144) - lu(k,1421) * b(k,186) + b(k,139) = b(k,139) - lu(k,1420) * b(k,186) + b(k,138) = b(k,138) - lu(k,1419) * b(k,186) + b(k,137) = b(k,137) - lu(k,1418) * b(k,186) + b(k,129) = b(k,129) - lu(k,1417) * b(k,186) + b(k,126) = b(k,126) - lu(k,1416) * b(k,186) + b(k,120) = b(k,120) - lu(k,1415) * b(k,186) + b(k,106) = b(k,106) - lu(k,1414) * b(k,186) + b(k,102) = b(k,102) - lu(k,1413) * b(k,186) + b(k,96) = b(k,96) - lu(k,1412) * b(k,186) + b(k,46) = b(k,46) - lu(k,1411) * b(k,186) + b(k,45) = b(k,45) - lu(k,1410) * b(k,186) + b(k,185) = b(k,185) * lu(k,1396) + b(k,181) = b(k,181) - lu(k,1395) * b(k,185) + b(k,180) = b(k,180) - lu(k,1394) * b(k,185) + b(k,179) = b(k,179) - lu(k,1393) * b(k,185) + b(k,178) = b(k,178) - lu(k,1392) * b(k,185) + b(k,177) = b(k,177) - lu(k,1391) * b(k,185) + b(k,176) = b(k,176) - lu(k,1390) * b(k,185) + b(k,175) = b(k,175) - lu(k,1389) * b(k,185) + b(k,174) = b(k,174) - lu(k,1388) * b(k,185) + b(k,173) = b(k,173) - lu(k,1387) * b(k,185) + b(k,171) = b(k,171) - lu(k,1386) * b(k,185) + b(k,170) = b(k,170) - lu(k,1385) * b(k,185) + b(k,169) = b(k,169) - lu(k,1384) * b(k,185) + b(k,168) = b(k,168) - lu(k,1383) * b(k,185) + b(k,167) = b(k,167) - lu(k,1382) * b(k,185) + b(k,166) = b(k,166) - lu(k,1381) * b(k,185) + b(k,165) = b(k,165) - lu(k,1380) * b(k,185) + b(k,164) = b(k,164) - lu(k,1379) * b(k,185) + b(k,163) = b(k,163) - lu(k,1378) * b(k,185) + b(k,161) = b(k,161) - lu(k,1377) * b(k,185) + b(k,159) = b(k,159) - lu(k,1376) * b(k,185) + b(k,158) = b(k,158) - lu(k,1375) * b(k,185) + b(k,156) = b(k,156) - lu(k,1374) * b(k,185) + b(k,152) = b(k,152) - lu(k,1373) * b(k,185) + b(k,149) = b(k,149) - lu(k,1372) * b(k,185) + b(k,147) = b(k,147) - lu(k,1371) * b(k,185) + b(k,143) = b(k,143) - lu(k,1370) * b(k,185) + b(k,140) = b(k,140) - lu(k,1369) * b(k,185) + b(k,121) = b(k,121) - lu(k,1368) * b(k,185) + b(k,111) = b(k,111) - lu(k,1367) * b(k,185) + b(k,90) = b(k,90) - lu(k,1366) * b(k,185) + b(k,83) = b(k,83) - lu(k,1365) * b(k,185) + b(k,73) = b(k,73) - lu(k,1364) * b(k,185) + b(k,66) = b(k,66) - lu(k,1363) * b(k,185) + b(k,184) = b(k,184) * lu(k,1352) + b(k,165) = b(k,165) - lu(k,1351) * b(k,184) + b(k,145) = b(k,145) - lu(k,1350) * b(k,184) + b(k,183) = b(k,183) * lu(k,1337) + b(k,157) = b(k,157) - lu(k,1336) * b(k,183) + b(k,146) = b(k,146) - lu(k,1335) * b(k,183) + b(k,134) = b(k,134) - lu(k,1334) * b(k,183) + b(k,63) = b(k,63) - lu(k,1333) * b(k,183) + b(k,47) = b(k,47) - lu(k,1332) * b(k,183) + b(k,182) = b(k,182) * lu(k,1318) + b(k,155) = b(k,155) - lu(k,1317) * b(k,182) + b(k,129) = b(k,129) - lu(k,1316) * b(k,182) + b(k,77) = b(k,77) - lu(k,1315) * b(k,182) + b(k,181) = b(k,181) * lu(k,1302) + b(k,180) = b(k,180) - lu(k,1301) * b(k,181) + b(k,179) = b(k,179) - lu(k,1300) * b(k,181) + b(k,178) = b(k,178) - lu(k,1299) * b(k,181) + b(k,177) = b(k,177) - lu(k,1298) * b(k,181) + b(k,176) = b(k,176) - lu(k,1297) * b(k,181) + b(k,175) = b(k,175) - lu(k,1296) * b(k,181) + b(k,174) = b(k,174) - lu(k,1295) * b(k,181) + b(k,173) = b(k,173) - lu(k,1294) * b(k,181) + b(k,171) = b(k,171) - lu(k,1293) * b(k,181) + b(k,165) = b(k,165) - lu(k,1292) * b(k,181) + b(k,164) = b(k,164) - lu(k,1291) * b(k,181) + b(k,161) = b(k,161) - lu(k,1290) * b(k,181) + b(k,159) = b(k,159) - lu(k,1289) * b(k,181) + b(k,149) = b(k,149) - lu(k,1288) * b(k,181) + b(k,111) = b(k,111) - lu(k,1287) * b(k,181) + b(k,105) = b(k,105) - lu(k,1286) * b(k,181) + b(k,97) = b(k,97) - lu(k,1285) * b(k,181) + b(k,73) = b(k,73) - lu(k,1284) * b(k,181) + b(k,180) = b(k,180) * lu(k,1271) + b(k,175) = b(k,175) - lu(k,1270) * b(k,180) + b(k,164) = b(k,164) - lu(k,1269) * b(k,180) + b(k,114) = b(k,114) - lu(k,1268) * b(k,180) + b(k,111) = b(k,111) - lu(k,1267) * b(k,180) + b(k,105) = b(k,105) - lu(k,1266) * b(k,180) + b(k,179) = b(k,179) * lu(k,1251) + b(k,178) = b(k,178) - lu(k,1250) * b(k,179) + b(k,175) = b(k,175) - lu(k,1249) * b(k,179) + b(k,170) = b(k,170) - lu(k,1248) * b(k,179) + b(k,165) = b(k,165) - lu(k,1247) * b(k,179) + b(k,164) = b(k,164) - lu(k,1246) * b(k,179) + b(k,160) = b(k,160) - lu(k,1245) * b(k,179) + b(k,141) = b(k,141) - lu(k,1244) * b(k,179) + end do + end subroutine lu_slv09 + subroutine lu_slv10( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,178) = b(k,178) * lu(k,1231) + b(k,175) = b(k,175) - lu(k,1230) * b(k,178) + b(k,170) = b(k,170) - lu(k,1229) * b(k,178) + b(k,169) = b(k,169) - lu(k,1228) * b(k,178) + b(k,165) = b(k,165) - lu(k,1227) * b(k,178) + b(k,164) = b(k,164) - lu(k,1226) * b(k,178) + b(k,162) = b(k,162) - lu(k,1225) * b(k,178) + b(k,161) = b(k,161) - lu(k,1224) * b(k,178) + b(k,140) = b(k,140) - lu(k,1223) * b(k,178) + b(k,74) = b(k,74) - lu(k,1222) * b(k,178) + b(k,177) = b(k,177) * lu(k,1206) + b(k,175) = b(k,175) - lu(k,1205) * b(k,177) + b(k,174) = b(k,174) - lu(k,1204) * b(k,177) + b(k,171) = b(k,171) - lu(k,1203) * b(k,177) + b(k,170) = b(k,170) - lu(k,1202) * b(k,177) + b(k,169) = b(k,169) - lu(k,1201) * b(k,177) + b(k,165) = b(k,165) - lu(k,1200) * b(k,177) + b(k,164) = b(k,164) - lu(k,1199) * b(k,177) + b(k,162) = b(k,162) - lu(k,1198) * b(k,177) + b(k,161) = b(k,161) - lu(k,1197) * b(k,177) + b(k,150) = b(k,150) - lu(k,1196) * b(k,177) + b(k,149) = b(k,149) - lu(k,1195) * b(k,177) + b(k,147) = b(k,147) - lu(k,1194) * b(k,177) + b(k,140) = b(k,140) - lu(k,1193) * b(k,177) + b(k,127) = b(k,127) - lu(k,1192) * b(k,177) + b(k,118) = b(k,118) - lu(k,1191) * b(k,177) + b(k,108) = b(k,108) - lu(k,1190) * b(k,177) + b(k,73) = b(k,73) - lu(k,1189) * b(k,177) + b(k,60) = b(k,60) - lu(k,1188) * b(k,177) + b(k,176) = b(k,176) * lu(k,1172) + b(k,175) = b(k,175) - lu(k,1171) * b(k,176) + b(k,174) = b(k,174) - lu(k,1170) * b(k,176) + b(k,171) = b(k,171) - lu(k,1169) * b(k,176) + b(k,170) = b(k,170) - lu(k,1168) * b(k,176) + b(k,169) = b(k,169) - lu(k,1167) * b(k,176) + b(k,165) = b(k,165) - lu(k,1166) * b(k,176) + b(k,164) = b(k,164) - lu(k,1165) * b(k,176) + b(k,162) = b(k,162) - lu(k,1164) * b(k,176) + b(k,161) = b(k,161) - lu(k,1163) * b(k,176) + b(k,140) = b(k,140) - lu(k,1162) * b(k,176) + b(k,127) = b(k,127) - lu(k,1161) * b(k,176) + b(k,119) = b(k,119) - lu(k,1160) * b(k,176) + b(k,175) = b(k,175) * lu(k,1152) + b(k,165) = b(k,165) - lu(k,1151) * b(k,175) + b(k,174) = b(k,174) * lu(k,1140) + b(k,165) = b(k,165) - lu(k,1139) * b(k,174) + b(k,141) = b(k,141) - lu(k,1138) * b(k,174) + b(k,173) = b(k,173) * lu(k,1124) + b(k,171) = b(k,171) - lu(k,1123) * b(k,173) + b(k,165) = b(k,165) - lu(k,1122) * b(k,173) + b(k,161) = b(k,161) - lu(k,1121) * b(k,173) + b(k,159) = b(k,159) - lu(k,1120) * b(k,173) + b(k,147) = b(k,147) - lu(k,1119) * b(k,173) + b(k,140) = b(k,140) - lu(k,1118) * b(k,173) + b(k,127) = b(k,127) - lu(k,1117) * b(k,173) + b(k,88) = b(k,88) - lu(k,1116) * b(k,173) + b(k,83) = b(k,83) - lu(k,1115) * b(k,173) + b(k,172) = b(k,172) * lu(k,1104) + b(k,136) = b(k,136) - lu(k,1103) * b(k,172) + b(k,59) = b(k,59) - lu(k,1102) * b(k,172) + b(k,171) = b(k,171) * lu(k,1091) + b(k,165) = b(k,165) - lu(k,1090) * b(k,171) + b(k,164) = b(k,164) - lu(k,1089) * b(k,171) + b(k,161) = b(k,161) - lu(k,1088) * b(k,171) + b(k,149) = b(k,149) - lu(k,1087) * b(k,171) + b(k,140) = b(k,140) - lu(k,1086) * b(k,171) + b(k,56) = b(k,56) - lu(k,1085) * b(k,171) + b(k,170) = b(k,170) * lu(k,1076) + b(k,165) = b(k,165) - lu(k,1075) * b(k,170) + b(k,169) = b(k,169) * lu(k,1065) + b(k,164) = b(k,164) - lu(k,1064) * b(k,169) + b(k,140) = b(k,140) - lu(k,1063) * b(k,169) + b(k,87) = b(k,87) - lu(k,1062) * b(k,169) + b(k,168) = b(k,168) * lu(k,1049) + b(k,167) = b(k,167) - lu(k,1048) * b(k,168) + b(k,165) = b(k,165) - lu(k,1047) * b(k,168) + b(k,163) = b(k,163) - lu(k,1046) * b(k,168) + b(k,158) = b(k,158) - lu(k,1045) * b(k,168) + b(k,140) = b(k,140) - lu(k,1044) * b(k,168) + b(k,121) = b(k,121) - lu(k,1043) * b(k,168) + b(k,86) = b(k,86) - lu(k,1042) * b(k,168) + b(k,167) = b(k,167) * lu(k,1030) + b(k,165) = b(k,165) - lu(k,1029) * b(k,167) + b(k,163) = b(k,163) - lu(k,1028) * b(k,167) + b(k,161) = b(k,161) - lu(k,1027) * b(k,167) + b(k,156) = b(k,156) - lu(k,1026) * b(k,167) + b(k,140) = b(k,140) - lu(k,1025) * b(k,167) + b(k,116) = b(k,116) - lu(k,1024) * b(k,167) + b(k,61) = b(k,61) - lu(k,1023) * b(k,167) + b(k,166) = b(k,166) * lu(k,1008) + b(k,165) = b(k,165) - lu(k,1007) * b(k,166) + b(k,163) = b(k,163) - lu(k,1006) * b(k,166) + b(k,158) = b(k,158) - lu(k,1005) * b(k,166) + b(k,156) = b(k,156) - lu(k,1004) * b(k,166) + b(k,140) = b(k,140) - lu(k,1003) * b(k,166) + b(k,121) = b(k,121) - lu(k,1002) * b(k,166) + b(k,100) = b(k,100) - lu(k,1001) * b(k,166) + b(k,165) = b(k,165) * lu(k,997) + b(k,164) = b(k,164) * lu(k,991) + b(k,163) = b(k,163) * lu(k,982) + b(k,156) = b(k,156) - lu(k,981) * b(k,163) + b(k,162) = b(k,162) * lu(k,968) + b(k,161) = b(k,161) - lu(k,967) * b(k,162) + b(k,156) = b(k,156) - lu(k,966) * b(k,162) + b(k,61) = b(k,61) - lu(k,965) * b(k,162) + b(k,161) = b(k,161) * lu(k,960) + b(k,149) = b(k,149) - lu(k,959) * b(k,161) + b(k,160) = b(k,160) * lu(k,943) + b(k,147) = b(k,147) - lu(k,942) * b(k,160) + b(k,142) = b(k,142) - lu(k,941) * b(k,160) + b(k,141) = b(k,141) - lu(k,940) * b(k,160) + b(k,111) = b(k,111) - lu(k,939) * b(k,160) + b(k,159) = b(k,159) * lu(k,928) + b(k,150) = b(k,150) - lu(k,927) * b(k,159) + b(k,149) = b(k,149) - lu(k,926) * b(k,159) + b(k,147) = b(k,147) - lu(k,925) * b(k,159) + b(k,118) = b(k,118) - lu(k,924) * b(k,159) + b(k,158) = b(k,158) * lu(k,916) + b(k,157) = b(k,157) * lu(k,906) + b(k,146) = b(k,146) - lu(k,905) * b(k,157) + b(k,47) = b(k,47) - lu(k,904) * b(k,157) + b(k,156) = b(k,156) * lu(k,898) + b(k,155) = b(k,155) * lu(k,892) + b(k,65) = b(k,65) - lu(k,891) * b(k,155) + b(k,154) = b(k,154) * lu(k,880) + b(k,152) = b(k,152) - lu(k,879) * b(k,154) + b(k,125) = b(k,125) - lu(k,878) * b(k,154) + b(k,124) = b(k,124) - lu(k,877) * b(k,154) + b(k,123) = b(k,123) - lu(k,876) * b(k,154) + b(k,107) = b(k,107) - lu(k,875) * b(k,154) + b(k,153) = b(k,153) * lu(k,858) + b(k,149) = b(k,149) - lu(k,857) * b(k,153) + b(k,141) = b(k,141) - lu(k,856) * b(k,153) + b(k,85) = b(k,85) - lu(k,855) * b(k,153) + b(k,62) = b(k,62) - lu(k,854) * b(k,153) + b(k,33) = b(k,33) - lu(k,853) * b(k,153) + b(k,32) = b(k,32) - lu(k,852) * b(k,153) + b(k,31) = b(k,31) - lu(k,851) * b(k,153) + b(k,30) = b(k,30) - lu(k,850) * b(k,153) + b(k,29) = b(k,29) - lu(k,849) * b(k,153) + b(k,152) = b(k,152) * lu(k,840) + b(k,140) = b(k,140) - lu(k,839) * b(k,152) + b(k,80) = b(k,80) - lu(k,838) * b(k,152) + b(k,66) = b(k,66) - lu(k,837) * b(k,152) + b(k,151) = b(k,151) * lu(k,820) + b(k,149) = b(k,149) - lu(k,819) * b(k,151) + b(k,141) = b(k,141) - lu(k,818) * b(k,151) + b(k,85) = b(k,85) - lu(k,817) * b(k,151) + b(k,62) = b(k,62) - lu(k,816) * b(k,151) + b(k,33) = b(k,33) - lu(k,815) * b(k,151) + b(k,32) = b(k,32) - lu(k,814) * b(k,151) + b(k,31) = b(k,31) - lu(k,813) * b(k,151) + b(k,30) = b(k,30) - lu(k,812) * b(k,151) + b(k,29) = b(k,29) - lu(k,811) * b(k,151) + b(k,150) = b(k,150) * lu(k,803) + b(k,149) = b(k,149) - lu(k,802) * b(k,150) + b(k,149) = b(k,149) * lu(k,798) + b(k,29) = b(k,29) - lu(k,797) * b(k,149) + b(k,148) = b(k,148) * lu(k,781) + b(k,141) = b(k,141) - lu(k,780) * b(k,148) + b(k,33) = b(k,33) - lu(k,779) * b(k,148) + b(k,32) = b(k,32) - lu(k,778) * b(k,148) + b(k,31) = b(k,31) - lu(k,777) * b(k,148) + b(k,30) = b(k,30) - lu(k,776) * b(k,148) + b(k,29) = b(k,29) - lu(k,775) * b(k,148) + b(k,147) = b(k,147) * lu(k,769) + b(k,146) = b(k,146) * lu(k,762) + b(k,47) = b(k,47) - lu(k,761) * b(k,146) + b(k,145) = b(k,145) * lu(k,753) + b(k,144) = b(k,144) * lu(k,744) + b(k,139) = b(k,139) - lu(k,743) * b(k,144) + b(k,138) = b(k,138) - lu(k,742) * b(k,144) + b(k,137) = b(k,137) - lu(k,741) * b(k,144) + b(k,120) = b(k,120) - lu(k,740) * b(k,144) + b(k,102) = b(k,102) - lu(k,739) * b(k,144) + b(k,143) = b(k,143) * lu(k,728) + b(k,89) = b(k,89) - lu(k,727) * b(k,143) + b(k,142) = b(k,142) * lu(k,717) + b(k,109) = b(k,109) - lu(k,716) * b(k,142) + b(k,141) = b(k,141) * lu(k,712) + b(k,140) = b(k,140) * lu(k,708) + b(k,139) = b(k,139) * lu(k,701) + b(k,138) = b(k,138) - lu(k,700) * b(k,139) + b(k,137) = b(k,137) - lu(k,699) * b(k,139) + b(k,126) = b(k,126) - lu(k,698) * b(k,139) + b(k,106) = b(k,106) - lu(k,697) * b(k,139) + b(k,138) = b(k,138) * lu(k,690) + b(k,106) = b(k,106) - lu(k,689) * b(k,138) + b(k,137) = b(k,137) * lu(k,681) + b(k,136) = b(k,136) * lu(k,673) + b(k,59) = b(k,59) - lu(k,672) * b(k,136) + b(k,135) = b(k,135) * lu(k,664) + b(k,96) = b(k,96) - lu(k,663) * b(k,135) + b(k,41) = b(k,41) - lu(k,662) * b(k,135) + b(k,134) = b(k,134) * lu(k,654) + b(k,63) = b(k,63) - lu(k,653) * b(k,134) + b(k,133) = b(k,133) * lu(k,645) + b(k,132) = b(k,132) * lu(k,634) + b(k,130) = b(k,130) - lu(k,633) * b(k,132) + b(k,128) = b(k,128) - lu(k,632) * b(k,132) + b(k,118) = b(k,118) - lu(k,631) * b(k,132) + b(k,95) = b(k,95) - lu(k,630) * b(k,132) + b(k,76) = b(k,76) - lu(k,629) * b(k,132) + b(k,70) = b(k,70) - lu(k,628) * b(k,132) + end do + end subroutine lu_slv10 + subroutine lu_slv11( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,131) = b(k,131) * lu(k,618) + b(k,130) = b(k,130) - lu(k,617) * b(k,131) + b(k,118) = b(k,118) - lu(k,616) * b(k,131) + b(k,117) = b(k,117) - lu(k,615) * b(k,131) + b(k,95) = b(k,95) - lu(k,614) * b(k,131) + b(k,70) = b(k,70) - lu(k,613) * b(k,131) + b(k,130) = b(k,130) * lu(k,607) + b(k,129) = b(k,129) * lu(k,600) + b(k,128) = b(k,128) * lu(k,589) + b(k,118) = b(k,118) - lu(k,588) * b(k,128) + b(k,95) = b(k,95) - lu(k,587) * b(k,128) + b(k,76) = b(k,76) - lu(k,586) * b(k,128) + b(k,70) = b(k,70) - lu(k,585) * b(k,128) + b(k,127) = b(k,127) * lu(k,578) + b(k,43) = b(k,43) - lu(k,577) * b(k,127) + b(k,126) = b(k,126) * lu(k,567) + b(k,120) = b(k,120) - lu(k,566) * b(k,126) + b(k,106) = b(k,106) - lu(k,565) * b(k,126) + b(k,125) = b(k,125) * lu(k,558) + b(k,75) = b(k,75) - lu(k,557) * b(k,125) + b(k,124) = b(k,124) * lu(k,547) + b(k,107) = b(k,107) - lu(k,546) * b(k,124) + b(k,123) = b(k,123) * lu(k,536) + b(k,107) = b(k,107) - lu(k,535) * b(k,123) + b(k,122) = b(k,122) * lu(k,529) + b(k,98) = b(k,98) - lu(k,528) * b(k,122) + b(k,67) = b(k,67) - lu(k,527) * b(k,122) + b(k,121) = b(k,121) * lu(k,521) + b(k,120) = b(k,120) * lu(k,514) + b(k,119) = b(k,119) * lu(k,505) + b(k,118) = b(k,118) * lu(k,501) + b(k,117) = b(k,117) * lu(k,492) + b(k,95) = b(k,95) - lu(k,491) * b(k,117) + b(k,70) = b(k,70) - lu(k,490) * b(k,117) + b(k,116) = b(k,116) * lu(k,481) + b(k,115) = b(k,115) * lu(k,474) + b(k,114) = b(k,114) * lu(k,466) + b(k,113) = b(k,113) * lu(k,458) + b(k,112) = b(k,112) * lu(k,450) + b(k,111) = b(k,111) * lu(k,446) + b(k,110) = b(k,110) * lu(k,438) + b(k,109) = b(k,109) * lu(k,430) + b(k,108) = b(k,108) * lu(k,422) + b(k,107) = b(k,107) * lu(k,417) + b(k,106) = b(k,106) * lu(k,412) + b(k,105) = b(k,105) * lu(k,406) + b(k,104) = b(k,104) * lu(k,400) + b(k,44) = b(k,44) - lu(k,399) * b(k,104) + b(k,103) = b(k,103) * lu(k,392) + b(k,91) = b(k,91) - lu(k,391) * b(k,103) + b(k,102) = b(k,102) * lu(k,384) + b(k,101) = b(k,101) * lu(k,377) + b(k,95) = b(k,95) - lu(k,376) * b(k,101) + b(k,84) = b(k,84) - lu(k,375) * b(k,101) + b(k,100) = b(k,100) * lu(k,368) + b(k,99) = b(k,99) * lu(k,361) + b(k,98) = b(k,98) * lu(k,357) + b(k,97) = b(k,97) * lu(k,350) + b(k,96) = b(k,96) * lu(k,345) + b(k,95) = b(k,95) * lu(k,342) + b(k,94) = b(k,94) * lu(k,336) + b(k,78) = b(k,78) - lu(k,335) * b(k,94) + b(k,93) = b(k,93) * lu(k,329) + b(k,92) = b(k,92) * lu(k,323) + b(k,79) = b(k,79) - lu(k,322) * b(k,92) + b(k,64) = b(k,64) - lu(k,321) * b(k,92) + b(k,91) = b(k,91) * lu(k,315) + b(k,90) = b(k,90) * lu(k,309) + b(k,89) = b(k,89) * lu(k,303) + b(k,88) = b(k,88) * lu(k,297) + b(k,87) = b(k,87) * lu(k,291) + b(k,86) = b(k,86) * lu(k,285) + b(k,85) = b(k,85) * lu(k,279) + b(k,84) = b(k,84) * lu(k,273) + b(k,83) = b(k,83) * lu(k,267) + b(k,82) = b(k,82) * lu(k,259) + b(k,81) = b(k,81) * lu(k,251) + b(k,80) = b(k,80) * lu(k,246) + b(k,79) = b(k,79) * lu(k,241) + b(k,64) = b(k,64) - lu(k,240) * b(k,79) + b(k,78) = b(k,78) * lu(k,235) + b(k,77) = b(k,77) * lu(k,230) + b(k,76) = b(k,76) * lu(k,225) + b(k,75) = b(k,75) * lu(k,220) + b(k,74) = b(k,74) * lu(k,215) + b(k,73) = b(k,73) * lu(k,212) + b(k,72) = b(k,72) * lu(k,206) + b(k,71) = b(k,71) * lu(k,200) + b(k,70) = b(k,70) * lu(k,197) + b(k,69) = b(k,69) * lu(k,191) + b(k,68) = b(k,68) * lu(k,185) + b(k,67) = b(k,67) * lu(k,181) + b(k,66) = b(k,66) * lu(k,177) + b(k,65) = b(k,65) * lu(k,173) + b(k,42) = b(k,42) - lu(k,172) * b(k,65) + b(k,64) = b(k,64) * lu(k,169) + b(k,63) = b(k,63) * lu(k,166) + b(k,62) = b(k,62) * lu(k,163) + b(k,61) = b(k,61) * lu(k,160) + b(k,60) = b(k,60) * lu(k,155) + b(k,59) = b(k,59) * lu(k,152) + b(k,58) = b(k,58) * lu(k,147) + b(k,57) = b(k,57) * lu(k,139) + b(k,55) = b(k,55) - lu(k,138) * b(k,57) + b(k,33) = b(k,33) - lu(k,137) * b(k,57) + b(k,32) = b(k,32) - lu(k,136) * b(k,57) + b(k,31) = b(k,31) - lu(k,135) * b(k,57) + b(k,30) = b(k,30) - lu(k,134) * b(k,57) + b(k,29) = b(k,29) - lu(k,133) * b(k,57) + b(k,56) = b(k,56) * lu(k,130) + b(k,55) = b(k,55) * lu(k,126) + b(k,54) = b(k,54) * lu(k,121) + b(k,53) = b(k,53) * lu(k,114) + b(k,33) = b(k,33) - lu(k,113) * b(k,53) + b(k,32) = b(k,32) - lu(k,112) * b(k,53) + b(k,31) = b(k,31) - lu(k,111) * b(k,53) + b(k,30) = b(k,30) - lu(k,110) * b(k,53) + b(k,29) = b(k,29) - lu(k,109) * b(k,53) + b(k,52) = b(k,52) * lu(k,105) + b(k,51) = b(k,51) * lu(k,101) + b(k,50) = b(k,50) * lu(k,96) + b(k,49) = b(k,49) * lu(k,92) + b(k,48) = b(k,48) * lu(k,86) + b(k,33) = b(k,33) - lu(k,85) * b(k,48) + b(k,32) = b(k,32) - lu(k,84) * b(k,48) + b(k,31) = b(k,31) - lu(k,83) * b(k,48) + b(k,30) = b(k,30) - lu(k,82) * b(k,48) + b(k,29) = b(k,29) - lu(k,81) * b(k,48) + b(k,47) = b(k,47) * lu(k,79) + b(k,46) = b(k,46) * lu(k,77) + b(k,45) = b(k,45) - lu(k,76) * b(k,46) + b(k,45) = b(k,45) * lu(k,74) + b(k,44) = b(k,44) * lu(k,71) + b(k,43) = b(k,43) * lu(k,68) + b(k,42) = b(k,42) * lu(k,65) + b(k,41) = b(k,41) * lu(k,62) + b(k,40) = b(k,40) * lu(k,59) + b(k,39) = b(k,39) * lu(k,55) + b(k,38) = b(k,38) * lu(k,52) + b(k,37) = b(k,37) * lu(k,49) + b(k,36) = b(k,36) * lu(k,46) + b(k,35) = b(k,35) * lu(k,45) + b(k,33) = b(k,33) - lu(k,44) * b(k,35) + b(k,32) = b(k,32) - lu(k,43) * b(k,35) + b(k,31) = b(k,31) - lu(k,42) * b(k,35) + b(k,30) = b(k,30) - lu(k,41) * b(k,35) + b(k,29) = b(k,29) - lu(k,40) * b(k,35) + b(k,34) = b(k,34) * lu(k,39) + b(k,33) = b(k,33) - lu(k,38) * b(k,34) + b(k,32) = b(k,32) - lu(k,37) * b(k,34) + b(k,31) = b(k,31) - lu(k,36) * b(k,34) + b(k,30) = b(k,30) - lu(k,35) * b(k,34) + b(k,29) = b(k,29) - lu(k,34) * b(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + b(k,9) = b(k,9) * lu(k,9) + b(k,8) = b(k,8) * lu(k,8) + b(k,7) = b(k,7) * lu(k,7) + b(k,6) = b(k,6) * lu(k,6) + b(k,5) = b(k,5) * lu(k,5) + b(k,4) = b(k,4) * lu(k,4) + b(k,3) = b(k,3) * lu(k,3) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv11 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + call lu_slv05( avec_len, lu, b ) + call lu_slv06( avec_len, lu, b ) + call lu_slv07( avec_len, lu, b ) + call lu_slv08( avec_len, lu, b ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..bac2887807 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 @@ -0,0 +1,3510 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,536) = -(rxt(k,396)*y(k,220)) + mat(k,1657) = -rxt(k,396)*y(k,1) + mat(k,1462) = rxt(k,399)*y(k,189) + mat(k,876) = rxt(k,399)*y(k,124) + mat(k,547) = -(rxt(k,400)*y(k,220)) + mat(k,1658) = -rxt(k,400)*y(k,2) + mat(k,877) = rxt(k,397)*y(k,202) + mat(k,2057) = rxt(k,397)*y(k,189) + mat(k,858) = -(rxt(k,479)*y(k,126) + rxt(k,480)*y(k,135) + rxt(k,481) & + *y(k,220)) + mat(k,1869) = -rxt(k,479)*y(k,6) + mat(k,1750) = -rxt(k,480)*y(k,6) + mat(k,1682) = -rxt(k,481)*y(k,6) + mat(k,86) = -(rxt(k,438)*y(k,220)) + mat(k,1595) = -rxt(k,438)*y(k,7) + mat(k,273) = -(rxt(k,441)*y(k,220)) + mat(k,1625) = -rxt(k,441)*y(k,8) + mat(k,375) = rxt(k,439)*y(k,202) + mat(k,2031) = rxt(k,439)*y(k,190) + mat(k,87) = .120_r8*rxt(k,438)*y(k,220) + mat(k,1596) = .120_r8*rxt(k,438)*y(k,7) + mat(k,855) = .100_r8*rxt(k,480)*y(k,135) + mat(k,817) = .100_r8*rxt(k,483)*y(k,135) + mat(k,1739) = .100_r8*rxt(k,480)*y(k,6) + .100_r8*rxt(k,483)*y(k,110) + mat(k,1449) = .500_r8*rxt(k,440)*y(k,190) + .200_r8*rxt(k,467)*y(k,227) & + + .060_r8*rxt(k,473)*y(k,229) + mat(k,376) = .500_r8*rxt(k,440)*y(k,124) + mat(k,614) = .200_r8*rxt(k,467)*y(k,124) + mat(k,630) = .060_r8*rxt(k,473)*y(k,124) + mat(k,1443) = .200_r8*rxt(k,467)*y(k,227) + .200_r8*rxt(k,473)*y(k,229) + mat(k,613) = .200_r8*rxt(k,467)*y(k,124) + mat(k,628) = .200_r8*rxt(k,473)*y(k,124) + mat(k,1458) = .200_r8*rxt(k,467)*y(k,227) + .150_r8*rxt(k,473)*y(k,229) + mat(k,616) = .200_r8*rxt(k,467)*y(k,124) + mat(k,631) = .150_r8*rxt(k,473)*y(k,124) + mat(k,1445) = .210_r8*rxt(k,473)*y(k,229) + mat(k,629) = .210_r8*rxt(k,473)*y(k,124) + mat(k,163) = -(rxt(k,401)*y(k,220)) + mat(k,1608) = -rxt(k,401)*y(k,15) + mat(k,854) = .050_r8*rxt(k,480)*y(k,135) + mat(k,816) = .050_r8*rxt(k,483)*y(k,135) + mat(k,1738) = .050_r8*rxt(k,480)*y(k,6) + .050_r8*rxt(k,483)*y(k,110) + mat(k,259) = -(rxt(k,367)*y(k,126) + rxt(k,368)*y(k,220)) + mat(k,1863) = -rxt(k,367)*y(k,16) + mat(k,1623) = -rxt(k,368)*y(k,16) + mat(k,1352) = -(rxt(k,250)*y(k,42) + rxt(k,251)*y(k,202) + rxt(k,252) & + *y(k,135)) + mat(k,1840) = -rxt(k,250)*y(k,17) + mat(k,2100) = -rxt(k,251)*y(k,17) + mat(k,1775) = -rxt(k,252)*y(k,17) + mat(k,2006) = 4.000_r8*rxt(k,253)*y(k,19) + (rxt(k,254)+rxt(k,255))*y(k,59) & + + rxt(k,258)*y(k,124) + rxt(k,261)*y(k,133) + rxt(k,506) & + *y(k,150) + rxt(k,262)*y(k,220) + mat(k,2127) = (rxt(k,254)+rxt(k,255))*y(k,19) + mat(k,754) = rxt(k,263)*y(k,133) + rxt(k,269)*y(k,216) + rxt(k,264)*y(k,220) + mat(k,1504) = rxt(k,258)*y(k,19) + mat(k,1816) = rxt(k,261)*y(k,19) + rxt(k,263)*y(k,81) + mat(k,1319) = rxt(k,506)*y(k,19) + mat(k,1565) = rxt(k,269)*y(k,81) + mat(k,1713) = rxt(k,262)*y(k,19) + rxt(k,264)*y(k,81) + mat(k,1999) = rxt(k,256)*y(k,59) + mat(k,2120) = rxt(k,256)*y(k,19) + mat(k,1333) = (rxt(k,556)+rxt(k,561))*y(k,91) + mat(k,653) = (rxt(k,556)+rxt(k,561))*y(k,85) + mat(k,2019) = -(4._r8*rxt(k,253)*y(k,19) + (rxt(k,254) + rxt(k,255) + rxt(k,256) & + ) * y(k,59) + rxt(k,257)*y(k,202) + rxt(k,258)*y(k,124) & + + rxt(k,259)*y(k,125) + rxt(k,261)*y(k,133) + rxt(k,262) & + *y(k,220) + rxt(k,506)*y(k,150)) + mat(k,2141) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,19) + mat(k,2114) = -rxt(k,257)*y(k,19) + mat(k,1518) = -rxt(k,258)*y(k,19) + mat(k,1995) = -rxt(k,259)*y(k,19) + mat(k,1830) = -rxt(k,261)*y(k,19) + mat(k,1727) = -rxt(k,262)*y(k,19) + mat(k,1328) = -rxt(k,506)*y(k,19) + mat(k,1360) = rxt(k,252)*y(k,135) + mat(k,445) = rxt(k,260)*y(k,133) + mat(k,759) = rxt(k,270)*y(k,216) + mat(k,660) = rxt(k,265)*y(k,133) + mat(k,1830) = mat(k,1830) + rxt(k,260)*y(k,20) + rxt(k,265)*y(k,91) + mat(k,1789) = rxt(k,252)*y(k,17) + mat(k,1579) = rxt(k,270)*y(k,81) + mat(k,438) = -(rxt(k,260)*y(k,133)) + mat(k,1798) = -rxt(k,260)*y(k,20) + mat(k,2001) = rxt(k,259)*y(k,125) + mat(k,1963) = rxt(k,259)*y(k,19) + mat(k,169) = -(rxt(k,442)*y(k,220)) + mat(k,1609) = -rxt(k,442)*y(k,22) + mat(k,1442) = rxt(k,445)*y(k,191) + mat(k,321) = rxt(k,445)*y(k,124) + mat(k,241) = -(rxt(k,444)*y(k,220)) + mat(k,1620) = -rxt(k,444)*y(k,23) + mat(k,322) = rxt(k,443)*y(k,202) + mat(k,2029) = rxt(k,443)*y(k,191) + mat(k,200) = -(rxt(k,316)*y(k,56) + rxt(k,317)*y(k,220)) + mat(k,1523) = -rxt(k,316)*y(k,24) + mat(k,1614) = -rxt(k,317)*y(k,24) + mat(k,450) = -(rxt(k,318)*y(k,56) + rxt(k,319)*y(k,135) + rxt(k,344)*y(k,220)) + mat(k,1525) = -rxt(k,318)*y(k,25) + mat(k,1742) = -rxt(k,319)*y(k,25) + mat(k,1647) = -rxt(k,344)*y(k,25) + mat(k,177) = -(rxt(k,324)*y(k,220)) + mat(k,1611) = -rxt(k,324)*y(k,26) + mat(k,837) = .800_r8*rxt(k,320)*y(k,192) + .200_r8*rxt(k,321)*y(k,196) + mat(k,1363) = .200_r8*rxt(k,321)*y(k,192) + mat(k,246) = -(rxt(k,325)*y(k,220)) + mat(k,1621) = -rxt(k,325)*y(k,27) + mat(k,838) = rxt(k,322)*y(k,202) + mat(k,2030) = rxt(k,322)*y(k,192) + mat(k,206) = -(rxt(k,326)*y(k,56) + rxt(k,327)*y(k,220)) + mat(k,1524) = -rxt(k,326)*y(k,28) + mat(k,1615) = -rxt(k,327)*y(k,28) + mat(k,943) = -(rxt(k,347)*y(k,126) + rxt(k,348)*y(k,135) + rxt(k,365) & + *y(k,220)) + mat(k,1875) = -rxt(k,347)*y(k,29) + mat(k,1755) = -rxt(k,348)*y(k,29) + mat(k,1689) = -rxt(k,365)*y(k,29) + mat(k,782) = .130_r8*rxt(k,425)*y(k,135) + mat(k,1755) = mat(k,1755) + .130_r8*rxt(k,425)*y(k,98) + mat(k,303) = -(rxt(k,352)*y(k,220)) + mat(k,1629) = -rxt(k,352)*y(k,30) + mat(k,727) = rxt(k,350)*y(k,202) + mat(k,2035) = rxt(k,350)*y(k,193) + mat(k,55) = -(rxt(k,353)*y(k,220)) + mat(k,1592) = -rxt(k,353)*y(k,31) + mat(k,181) = -(rxt(k,448)*y(k,220)) + mat(k,1612) = -rxt(k,448)*y(k,32) + mat(k,527) = rxt(k,446)*y(k,202) + mat(k,2025) = rxt(k,446)*y(k,194) + mat(k,1849) = -(rxt(k,214)*y(k,56) + rxt(k,250)*y(k,17) + rxt(k,294)*y(k,202) & + + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,133) + rxt(k,297) & + *y(k,220)) + mat(k,1548) = -rxt(k,214)*y(k,42) + mat(k,1358) = -rxt(k,250)*y(k,42) + mat(k,2109) = -rxt(k,294)*y(k,42) + mat(k,1906) = -rxt(k,295)*y(k,42) + mat(k,1825) = -rxt(k,296)*y(k,42) + mat(k,1722) = -rxt(k,297)*y(k,42) + mat(k,543) = .400_r8*rxt(k,396)*y(k,220) + mat(k,871) = .340_r8*rxt(k,480)*y(k,135) + mat(k,264) = .500_r8*rxt(k,367)*y(k,126) + mat(k,456) = rxt(k,319)*y(k,135) + mat(k,954) = .500_r8*rxt(k,348)*y(k,135) + mat(k,410) = .500_r8*rxt(k,336)*y(k,220) + mat(k,710) = rxt(k,302)*y(k,220) + mat(k,312) = .300_r8*rxt(k,303)*y(k,220) + mat(k,2136) = rxt(k,221)*y(k,196) + mat(k,963) = .800_r8*rxt(k,341)*y(k,220) + mat(k,793) = .910_r8*rxt(k,425)*y(k,135) + mat(k,510) = .300_r8*rxt(k,416)*y(k,220) + mat(k,1132) = .800_r8*rxt(k,420)*y(k,196) + mat(k,1147) = .120_r8*rxt(k,378)*y(k,135) + mat(k,470) = .500_r8*rxt(k,391)*y(k,220) + mat(k,833) = .340_r8*rxt(k,483)*y(k,135) + mat(k,1259) = .600_r8*rxt(k,392)*y(k,135) + mat(k,1513) = .100_r8*rxt(k,398)*y(k,189) + rxt(k,301)*y(k,196) & + + .500_r8*rxt(k,369)*y(k,199) + .500_r8*rxt(k,338)*y(k,201) & + + .920_r8*rxt(k,408)*y(k,204) + .250_r8*rxt(k,376)*y(k,206) & + + rxt(k,385)*y(k,208) + rxt(k,359)*y(k,223) + rxt(k,363) & + *y(k,224) + .340_r8*rxt(k,492)*y(k,225) + .320_r8*rxt(k,497) & + *y(k,226) + .250_r8*rxt(k,433)*y(k,228) + mat(k,1906) = mat(k,1906) + .500_r8*rxt(k,367)*y(k,16) + rxt(k,409)*y(k,204) & + + .250_r8*rxt(k,375)*y(k,206) + rxt(k,386)*y(k,208) + mat(k,1784) = .340_r8*rxt(k,480)*y(k,6) + rxt(k,319)*y(k,25) & + + .500_r8*rxt(k,348)*y(k,29) + .910_r8*rxt(k,425)*y(k,98) & + + .120_r8*rxt(k,378)*y(k,105) + .340_r8*rxt(k,483)*y(k,110) & + + .600_r8*rxt(k,392)*y(k,111) + mat(k,354) = rxt(k,343)*y(k,220) + mat(k,988) = .680_r8*rxt(k,501)*y(k,220) + mat(k,888) = .100_r8*rxt(k,398)*y(k,124) + mat(k,846) = .700_r8*rxt(k,321)*y(k,196) + mat(k,735) = rxt(k,349)*y(k,196) + mat(k,1308) = rxt(k,332)*y(k,196) + rxt(k,405)*y(k,204) + .250_r8*rxt(k,372) & + *y(k,206) + rxt(k,381)*y(k,208) + .250_r8*rxt(k,430)*y(k,228) + mat(k,1402) = rxt(k,221)*y(k,59) + .800_r8*rxt(k,420)*y(k,101) + rxt(k,301) & + *y(k,124) + .700_r8*rxt(k,321)*y(k,192) + rxt(k,349)*y(k,193) & + + rxt(k,332)*y(k,195) + (4.000_r8*rxt(k,298)+2.000_r8*rxt(k,299)) & + *y(k,196) + 1.500_r8*rxt(k,406)*y(k,204) + .750_r8*rxt(k,411) & + *y(k,205) + .880_r8*rxt(k,373)*y(k,206) + 2.000_r8*rxt(k,382) & + *y(k,208) + .750_r8*rxt(k,485)*y(k,215) + .800_r8*rxt(k,361) & + *y(k,224) + .930_r8*rxt(k,490)*y(k,225) + .950_r8*rxt(k,495) & + *y(k,226) + .800_r8*rxt(k,431)*y(k,228) + mat(k,463) = .500_r8*rxt(k,369)*y(k,124) + mat(k,669) = .500_r8*rxt(k,338)*y(k,124) + mat(k,2109) = mat(k,2109) + .450_r8*rxt(k,383)*y(k,208) + .150_r8*rxt(k,362) & + *y(k,224) + mat(k,1181) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + rxt(k,405) & + *y(k,195) + 1.500_r8*rxt(k,406)*y(k,196) + mat(k,1215) = .750_r8*rxt(k,411)*y(k,196) + mat(k,1237) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,195) + .880_r8*rxt(k,373)*y(k,196) + mat(k,1277) = rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + rxt(k,381)*y(k,195) & + + 2.000_r8*rxt(k,382)*y(k,196) + .450_r8*rxt(k,383)*y(k,202) & + + 4.000_r8*rxt(k,384)*y(k,208) + mat(k,1055) = .750_r8*rxt(k,485)*y(k,196) + mat(k,1722) = mat(k,1722) + .400_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,336) & + *y(k,51) + rxt(k,302)*y(k,52) + .300_r8*rxt(k,303)*y(k,53) & + + .800_r8*rxt(k,341)*y(k,74) + .300_r8*rxt(k,416)*y(k,99) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,343)*y(k,139) & + + .680_r8*rxt(k,501)*y(k,178) + mat(k,723) = rxt(k,359)*y(k,124) + mat(k,1071) = rxt(k,363)*y(k,124) + .800_r8*rxt(k,361)*y(k,196) & + + .150_r8*rxt(k,362)*y(k,202) + mat(k,1036) = .340_r8*rxt(k,492)*y(k,124) + .930_r8*rxt(k,490)*y(k,196) + mat(k,1016) = .320_r8*rxt(k,497)*y(k,124) + .950_r8*rxt(k,495)*y(k,196) + mat(k,1097) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,430)*y(k,195) & + + .800_r8*rxt(k,431)*y(k,196) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1076) = -(rxt(k,328)*y(k,126) + rxt(k,329)*y(k,220)) + mat(k,1885) = -rxt(k,328)*y(k,45) + mat(k,1699) = -rxt(k,329)*y(k,45) + mat(k,540) = .800_r8*rxt(k,396)*y(k,220) + mat(k,262) = rxt(k,367)*y(k,126) + mat(k,178) = rxt(k,324)*y(k,220) + mat(k,248) = .500_r8*rxt(k,325)*y(k,220) + mat(k,946) = .500_r8*rxt(k,348)*y(k,135) + mat(k,1248) = .100_r8*rxt(k,392)*y(k,135) + mat(k,1493) = .400_r8*rxt(k,398)*y(k,189) + rxt(k,323)*y(k,192) & + + .270_r8*rxt(k,351)*y(k,193) + rxt(k,369)*y(k,199) + rxt(k,388) & + *y(k,210) + rxt(k,359)*y(k,223) + mat(k,1885) = mat(k,1885) + rxt(k,367)*y(k,16) + mat(k,1764) = .500_r8*rxt(k,348)*y(k,29) + .100_r8*rxt(k,392)*y(k,111) + mat(k,882) = .400_r8*rxt(k,398)*y(k,124) + mat(k,841) = rxt(k,323)*y(k,124) + 3.200_r8*rxt(k,320)*y(k,192) & + + .800_r8*rxt(k,321)*y(k,196) + mat(k,730) = .270_r8*rxt(k,351)*y(k,124) + mat(k,1385) = .800_r8*rxt(k,321)*y(k,192) + mat(k,461) = rxt(k,369)*y(k,124) + mat(k,2087) = .200_r8*rxt(k,387)*y(k,210) + mat(k,559) = rxt(k,388)*y(k,124) + .200_r8*rxt(k,387)*y(k,202) + mat(k,1699) = mat(k,1699) + .800_r8*rxt(k,396)*y(k,1) + rxt(k,324)*y(k,26) & + + .500_r8*rxt(k,325)*y(k,27) + mat(k,719) = rxt(k,359)*y(k,124) + mat(k,52) = -(rxt(k,330)*y(k,220)) + mat(k,1591) = -rxt(k,330)*y(k,47) + mat(k,898) = -(rxt(k,366)*y(k,220)) + mat(k,1685) = -rxt(k,366)*y(k,48) + mat(k,539) = .800_r8*rxt(k,396)*y(k,220) + mat(k,860) = .520_r8*rxt(k,480)*y(k,135) + mat(k,261) = .500_r8*rxt(k,367)*y(k,126) + mat(k,822) = .520_r8*rxt(k,483)*y(k,135) + mat(k,1481) = .250_r8*rxt(k,398)*y(k,189) + .820_r8*rxt(k,351)*y(k,193) & + + .500_r8*rxt(k,369)*y(k,199) + .270_r8*rxt(k,492)*y(k,225) & + + .040_r8*rxt(k,497)*y(k,226) + mat(k,1872) = .500_r8*rxt(k,367)*y(k,16) + mat(k,1753) = .520_r8*rxt(k,480)*y(k,6) + .520_r8*rxt(k,483)*y(k,110) + mat(k,981) = .500_r8*rxt(k,501)*y(k,220) + mat(k,881) = .250_r8*rxt(k,398)*y(k,124) + mat(k,729) = .820_r8*rxt(k,351)*y(k,124) + .820_r8*rxt(k,349)*y(k,196) + mat(k,1374) = .820_r8*rxt(k,349)*y(k,193) + .150_r8*rxt(k,490)*y(k,225) & + + .025_r8*rxt(k,495)*y(k,226) + mat(k,459) = .500_r8*rxt(k,369)*y(k,124) + mat(k,1685) = mat(k,1685) + .800_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,501) & + *y(k,178) + mat(k,1026) = .270_r8*rxt(k,492)*y(k,124) + .150_r8*rxt(k,490)*y(k,196) + mat(k,1004) = .040_r8*rxt(k,497)*y(k,124) + .025_r8*rxt(k,495)*y(k,196) + mat(k,1152) = -(rxt(k,354)*y(k,126) + rxt(k,355)*y(k,220)) + mat(k,1889) = -rxt(k,354)*y(k,49) + mat(k,1704) = -rxt(k,355)*y(k,49) + mat(k,992) = rxt(k,356)*y(k,220) + mat(k,1141) = .880_r8*rxt(k,378)*y(k,135) + mat(k,1249) = .500_r8*rxt(k,392)*y(k,135) + mat(k,1497) = .170_r8*rxt(k,451)*y(k,197) + .050_r8*rxt(k,414)*y(k,205) & + + .250_r8*rxt(k,376)*y(k,206) + .170_r8*rxt(k,457)*y(k,209) & + + .400_r8*rxt(k,467)*y(k,227) + .250_r8*rxt(k,433)*y(k,228) & + + .540_r8*rxt(k,473)*y(k,229) + .510_r8*rxt(k,476)*y(k,230) + mat(k,1889) = mat(k,1889) + .050_r8*rxt(k,415)*y(k,205) + .250_r8*rxt(k,375) & + *y(k,206) + .250_r8*rxt(k,434)*y(k,228) + mat(k,770) = rxt(k,357)*y(k,220) + mat(k,1767) = .880_r8*rxt(k,378)*y(k,105) + .500_r8*rxt(k,392)*y(k,111) + mat(k,1296) = .250_r8*rxt(k,372)*y(k,206) + .250_r8*rxt(k,430)*y(k,228) + mat(k,1389) = .240_r8*rxt(k,373)*y(k,206) + .500_r8*rxt(k,361)*y(k,224) & + + .100_r8*rxt(k,431)*y(k,228) + mat(k,647) = .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450)*y(k,202) + mat(k,2092) = .070_r8*rxt(k,450)*y(k,197) + .070_r8*rxt(k,456)*y(k,209) + mat(k,1205) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1230) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,195) + .240_r8*rxt(k,373)*y(k,196) + mat(k,805) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,202) + mat(k,1704) = mat(k,1704) + rxt(k,356)*y(k,95) + rxt(k,357)*y(k,127) + mat(k,1066) = .500_r8*rxt(k,361)*y(k,196) + mat(k,623) = .400_r8*rxt(k,467)*y(k,124) + mat(k,1092) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,195) + .100_r8*rxt(k,431)*y(k,196) + mat(k,639) = .540_r8*rxt(k,473)*y(k,124) + mat(k,394) = .510_r8*rxt(k,476)*y(k,124) + mat(k,446) = -(rxt(k,335)*y(k,220)) + mat(k,1646) = -rxt(k,335)*y(k,50) + mat(k,939) = .120_r8*rxt(k,348)*y(k,135) + mat(k,1741) = .120_r8*rxt(k,348)*y(k,29) + mat(k,1287) = .100_r8*rxt(k,332)*y(k,196) + .150_r8*rxt(k,333)*y(k,202) + mat(k,1367) = .100_r8*rxt(k,332)*y(k,195) + mat(k,2051) = .150_r8*rxt(k,333)*y(k,195) + .150_r8*rxt(k,383)*y(k,208) + mat(k,1267) = .150_r8*rxt(k,383)*y(k,202) + mat(k,406) = -(rxt(k,336)*y(k,220)) + mat(k,1642) = -rxt(k,336)*y(k,51) + mat(k,1286) = .400_r8*rxt(k,333)*y(k,202) + mat(k,2049) = .400_r8*rxt(k,333)*y(k,195) + .400_r8*rxt(k,383)*y(k,208) + mat(k,1266) = .400_r8*rxt(k,383)*y(k,202) + mat(k,708) = -(rxt(k,302)*y(k,220)) + mat(k,1669) = -rxt(k,302)*y(k,52) + mat(k,1118) = .200_r8*rxt(k,420)*y(k,196) + mat(k,839) = .300_r8*rxt(k,321)*y(k,196) + mat(k,1369) = .200_r8*rxt(k,420)*y(k,101) + .300_r8*rxt(k,321)*y(k,192) & + + 2.000_r8*rxt(k,299)*y(k,196) + .250_r8*rxt(k,406)*y(k,204) & + + .250_r8*rxt(k,411)*y(k,205) + .250_r8*rxt(k,373)*y(k,206) & + + .250_r8*rxt(k,485)*y(k,215) + .500_r8*rxt(k,361)*y(k,224) & + + .250_r8*rxt(k,490)*y(k,225) + .250_r8*rxt(k,495)*y(k,226) & + + .300_r8*rxt(k,431)*y(k,228) + mat(k,1162) = .250_r8*rxt(k,406)*y(k,196) + mat(k,1193) = .250_r8*rxt(k,411)*y(k,196) + mat(k,1223) = .250_r8*rxt(k,373)*y(k,196) + mat(k,1044) = .250_r8*rxt(k,485)*y(k,196) + mat(k,1063) = .500_r8*rxt(k,361)*y(k,196) + mat(k,1025) = .250_r8*rxt(k,490)*y(k,196) + mat(k,1003) = .250_r8*rxt(k,495)*y(k,196) + mat(k,1086) = .300_r8*rxt(k,431)*y(k,196) + mat(k,309) = -(rxt(k,303)*y(k,220)) + mat(k,1630) = -rxt(k,303)*y(k,53) + mat(k,1366) = rxt(k,300)*y(k,202) + mat(k,2036) = rxt(k,300)*y(k,196) + mat(k,1543) = -(rxt(k,214)*y(k,42) + rxt(k,216)*y(k,77) + rxt(k,217)*y(k,79) & + + (rxt(k,218) + rxt(k,219)) * y(k,202) + rxt(k,220)*y(k,135) & + + rxt(k,227)*y(k,60) + rxt(k,236)*y(k,92) + rxt(k,326)*y(k,28)) + mat(k,1844) = -rxt(k,214)*y(k,56) + mat(k,1107) = -rxt(k,216)*y(k,56) + mat(k,476) = -rxt(k,217)*y(k,56) + mat(k,2104) = -(rxt(k,218) + rxt(k,219)) * y(k,56) + mat(k,1779) = -rxt(k,220)*y(k,56) + mat(k,908) = -rxt(k,227)*y(k,56) + mat(k,764) = -rxt(k,236)*y(k,56) + mat(k,209) = -rxt(k,326)*y(k,56) + mat(k,2009) = rxt(k,255)*y(k,59) + mat(k,2131) = rxt(k,255)*y(k,19) + (4.000_r8*rxt(k,222)+2.000_r8*rxt(k,224)) & + *y(k,59) + rxt(k,226)*y(k,124) + rxt(k,231)*y(k,133) & + + rxt(k,507)*y(k,150) + rxt(k,221)*y(k,196) + rxt(k,232) & + *y(k,220) + mat(k,103) = rxt(k,276)*y(k,216) + mat(k,1339) = rxt(k,234)*y(k,133) + rxt(k,246)*y(k,216) + rxt(k,235)*y(k,220) + mat(k,1508) = rxt(k,226)*y(k,59) + mat(k,1820) = rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) + mat(k,1322) = rxt(k,507)*y(k,59) + mat(k,1399) = rxt(k,221)*y(k,59) + mat(k,1569) = rxt(k,276)*y(k,65) + rxt(k,246)*y(k,85) + mat(k,1717) = rxt(k,232)*y(k,59) + rxt(k,235)*y(k,85) + mat(k,1522) = rxt(k,227)*y(k,60) + mat(k,2119) = 2.000_r8*rxt(k,223)*y(k,59) + mat(k,904) = rxt(k,227)*y(k,56) + (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,85) + mat(k,1332) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,60) + (rxt(k,549) & + +rxt(k,555)+rxt(k,560))*y(k,92) + mat(k,761) = (rxt(k,549)+rxt(k,555)+rxt(k,560))*y(k,85) + mat(k,2118) = 2.000_r8*rxt(k,248)*y(k,59) + mat(k,2143) = -(rxt(k,221)*y(k,196) + (4._r8*rxt(k,222) + 4._r8*rxt(k,223) & + + 4._r8*rxt(k,224) + 4._r8*rxt(k,248)) * y(k,59) + rxt(k,225) & + *y(k,202) + rxt(k,226)*y(k,124) + rxt(k,228)*y(k,125) + rxt(k,231) & + *y(k,133) + (rxt(k,232) + rxt(k,233)) * y(k,220) + (rxt(k,254) & + + rxt(k,255) + rxt(k,256)) * y(k,19) + rxt(k,507)*y(k,150)) + mat(k,1408) = -rxt(k,221)*y(k,59) + mat(k,2116) = -rxt(k,225)*y(k,59) + mat(k,1520) = -rxt(k,226)*y(k,59) + mat(k,1997) = -rxt(k,228)*y(k,59) + mat(k,1832) = -rxt(k,231)*y(k,59) + mat(k,1729) = -(rxt(k,232) + rxt(k,233)) * y(k,59) + mat(k,2021) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,59) + mat(k,1330) = -rxt(k,507)*y(k,59) + mat(k,1555) = rxt(k,236)*y(k,92) + rxt(k,220)*y(k,135) + rxt(k,219)*y(k,202) + mat(k,914) = rxt(k,229)*y(k,133) + mat(k,1348) = rxt(k,247)*y(k,216) + mat(k,767) = rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,220) + mat(k,1832) = mat(k,1832) + rxt(k,229)*y(k,60) + rxt(k,237)*y(k,92) + mat(k,1791) = rxt(k,220)*y(k,56) + mat(k,234) = rxt(k,512)*y(k,150) + mat(k,1330) = mat(k,1330) + rxt(k,512)*y(k,136) + mat(k,2116) = mat(k,2116) + rxt(k,219)*y(k,56) + mat(k,1581) = rxt(k,247)*y(k,85) + mat(k,1729) = mat(k,1729) + rxt(k,238)*y(k,92) + mat(k,906) = -(rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,220) & + + (rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,85)) + mat(k,1532) = -rxt(k,227)*y(k,60) + mat(k,1811) = -rxt(k,229)*y(k,60) + mat(k,1686) = -rxt(k,230)*y(k,60) + mat(k,1336) = -(rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,60) + mat(k,2124) = rxt(k,228)*y(k,125) + mat(k,1973) = rxt(k,228)*y(k,59) + mat(k,997) = -((rxt(k,305) + rxt(k,315)) * y(k,220)) + mat(k,1694) = -(rxt(k,305) + rxt(k,315)) * y(k,62) + mat(k,863) = .230_r8*rxt(k,480)*y(k,135) + mat(k,1351) = rxt(k,250)*y(k,42) + mat(k,203) = .350_r8*rxt(k,317)*y(k,220) + mat(k,453) = .630_r8*rxt(k,319)*y(k,135) + mat(k,945) = .560_r8*rxt(k,348)*y(k,135) + mat(k,1837) = rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) + rxt(k,295)*y(k,126) & + + rxt(k,296)*y(k,133) + rxt(k,297)*y(k,220) + mat(k,1151) = rxt(k,354)*y(k,126) + rxt(k,355)*y(k,220) + mat(k,1534) = rxt(k,214)*y(k,42) + mat(k,799) = rxt(k,342)*y(k,220) + mat(k,783) = .620_r8*rxt(k,425)*y(k,135) + mat(k,1139) = .650_r8*rxt(k,378)*y(k,135) + mat(k,825) = .230_r8*rxt(k,483)*y(k,135) + mat(k,1247) = .560_r8*rxt(k,392)*y(k,135) + mat(k,1488) = .170_r8*rxt(k,451)*y(k,197) + .220_r8*rxt(k,376)*y(k,206) & + + .400_r8*rxt(k,454)*y(k,207) + .350_r8*rxt(k,457)*y(k,209) & + + .225_r8*rxt(k,492)*y(k,225) + .250_r8*rxt(k,433)*y(k,228) + mat(k,1880) = rxt(k,295)*y(k,42) + rxt(k,354)*y(k,49) + .220_r8*rxt(k,375) & + *y(k,206) + .500_r8*rxt(k,434)*y(k,228) + mat(k,1812) = rxt(k,296)*y(k,42) + rxt(k,502)*y(k,137) + mat(k,1759) = .230_r8*rxt(k,480)*y(k,6) + .630_r8*rxt(k,319)*y(k,25) & + + .560_r8*rxt(k,348)*y(k,29) + .620_r8*rxt(k,425)*y(k,98) & + + .650_r8*rxt(k,378)*y(k,105) + .230_r8*rxt(k,483)*y(k,110) & + + .560_r8*rxt(k,392)*y(k,111) + mat(k,254) = rxt(k,502)*y(k,133) + rxt(k,503)*y(k,220) + mat(k,983) = .700_r8*rxt(k,501)*y(k,220) + mat(k,1292) = .220_r8*rxt(k,372)*y(k,206) + .250_r8*rxt(k,430)*y(k,228) + mat(k,1380) = .110_r8*rxt(k,373)*y(k,206) + .125_r8*rxt(k,490)*y(k,225) & + + .200_r8*rxt(k,431)*y(k,228) + mat(k,646) = .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450)*y(k,202) + mat(k,2082) = .070_r8*rxt(k,450)*y(k,197) + .160_r8*rxt(k,453)*y(k,207) & + + .140_r8*rxt(k,456)*y(k,209) + mat(k,1227) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,195) + .110_r8*rxt(k,373)*y(k,196) + mat(k,609) = .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453)*y(k,202) + mat(k,804) = .350_r8*rxt(k,457)*y(k,124) + .140_r8*rxt(k,456)*y(k,202) + mat(k,1694) = mat(k,1694) + .350_r8*rxt(k,317)*y(k,24) + rxt(k,297)*y(k,42) & + + rxt(k,355)*y(k,49) + rxt(k,342)*y(k,75) + rxt(k,503)*y(k,137) & + + .700_r8*rxt(k,501)*y(k,178) + mat(k,1029) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,196) + mat(k,1090) = .250_r8*rxt(k,433)*y(k,124) + .500_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,195) + .200_r8*rxt(k,431)*y(k,196) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,59) = -(rxt(k,275)*y(k,216)) + mat(k,1557) = -rxt(k,275)*y(k,64) + mat(k,101) = -(rxt(k,276)*y(k,216)) + mat(k,1559) = -rxt(k,276)*y(k,65) + mat(k,121) = -(rxt(k,449)*y(k,220)) + mat(k,1601) = -rxt(k,449)*y(k,66) + mat(k,115) = .180_r8*rxt(k,469)*y(k,220) + mat(k,1601) = mat(k,1601) + .180_r8*rxt(k,469)*y(k,180) + mat(k,191) = -(rxt(k,516)*y(k,126) + (rxt(k,517) + rxt(k,519)) * y(k,220)) + mat(k,1861) = -rxt(k,516)*y(k,67) + mat(k,1613) = -(rxt(k,517) + rxt(k,519)) * y(k,67) + mat(k,662) = rxt(k,337)*y(k,202) + mat(k,2023) = rxt(k,337)*y(k,201) + mat(k,673) = -(rxt(k,272)*y(k,77) + rxt(k,273)*y(k,231) + rxt(k,274)*y(k,89)) + mat(k,1103) = -rxt(k,272)*y(k,73) + mat(k,2148) = -rxt(k,273)*y(k,73) + mat(k,1936) = -rxt(k,274)*y(k,73) + mat(k,60) = 2.000_r8*rxt(k,275)*y(k,216) + mat(k,102) = rxt(k,276)*y(k,216) + mat(k,1561) = 2.000_r8*rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) + mat(k,960) = -(rxt(k,341)*y(k,220)) + mat(k,1690) = -rxt(k,341)*y(k,74) + mat(k,506) = .700_r8*rxt(k,416)*y(k,220) + mat(k,424) = .500_r8*rxt(k,417)*y(k,220) + mat(k,269) = rxt(k,428)*y(k,220) + mat(k,1484) = .050_r8*rxt(k,414)*y(k,205) + .530_r8*rxt(k,376)*y(k,206) & + + .225_r8*rxt(k,492)*y(k,225) + .250_r8*rxt(k,433)*y(k,228) + mat(k,1876) = .050_r8*rxt(k,415)*y(k,205) + .530_r8*rxt(k,375)*y(k,206) & + + .250_r8*rxt(k,434)*y(k,228) + mat(k,1423) = rxt(k,340)*y(k,200) + mat(k,1290) = .530_r8*rxt(k,372)*y(k,206) + .250_r8*rxt(k,430)*y(k,228) + mat(k,1377) = .260_r8*rxt(k,373)*y(k,206) + .125_r8*rxt(k,490)*y(k,225) & + + .100_r8*rxt(k,431)*y(k,228) + mat(k,346) = rxt(k,340)*y(k,134) + mat(k,1197) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1224) = .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375)*y(k,126) & + + .530_r8*rxt(k,372)*y(k,195) + .260_r8*rxt(k,373)*y(k,196) + mat(k,1690) = mat(k,1690) + .700_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & + *y(k,100) + rxt(k,428)*y(k,115) + mat(k,1027) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,196) + mat(k,1088) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,195) + .100_r8*rxt(k,431)*y(k,196) + mat(k,798) = -(rxt(k,342)*y(k,220)) + mat(k,1678) = -rxt(k,342)*y(k,75) + mat(k,202) = .650_r8*rxt(k,317)*y(k,220) + mat(k,959) = .200_r8*rxt(k,341)*y(k,220) + mat(k,926) = rxt(k,429)*y(k,220) + mat(k,1477) = rxt(k,440)*y(k,190) + .050_r8*rxt(k,414)*y(k,205) & + + .400_r8*rxt(k,454)*y(k,207) + .170_r8*rxt(k,457)*y(k,209) & + + .700_r8*rxt(k,460)*y(k,222) + .600_r8*rxt(k,467)*y(k,227) & + + .250_r8*rxt(k,433)*y(k,228) + .340_r8*rxt(k,473)*y(k,229) & + + .170_r8*rxt(k,476)*y(k,230) + mat(k,1867) = .050_r8*rxt(k,415)*y(k,205) + .250_r8*rxt(k,434)*y(k,228) + mat(k,379) = rxt(k,440)*y(k,124) + mat(k,1288) = .250_r8*rxt(k,430)*y(k,228) + mat(k,1372) = .100_r8*rxt(k,431)*y(k,228) + mat(k,2073) = .160_r8*rxt(k,453)*y(k,207) + .070_r8*rxt(k,456)*y(k,209) + mat(k,1195) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,608) = .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453)*y(k,202) + mat(k,802) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,202) + mat(k,1678) = mat(k,1678) + .650_r8*rxt(k,317)*y(k,24) + .200_r8*rxt(k,341) & + *y(k,74) + rxt(k,429)*y(k,116) + mat(k,337) = .700_r8*rxt(k,460)*y(k,124) + mat(k,620) = .600_r8*rxt(k,467)*y(k,124) + mat(k,1087) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,195) + .100_r8*rxt(k,431)*y(k,196) + mat(k,636) = .340_r8*rxt(k,473)*y(k,124) + mat(k,393) = .170_r8*rxt(k,476)*y(k,124) + mat(k,1928) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,202) + rxt(k,175) & + *y(k,134) + rxt(k,178)*y(k,135)) + mat(k,2111) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + mat(k,1435) = -rxt(k,175)*y(k,76) + mat(k,1786) = -rxt(k,178)*y(k,76) + mat(k,1851) = rxt(k,297)*y(k,220) + mat(k,1550) = rxt(k,216)*y(k,77) + mat(k,999) = rxt(k,315)*y(k,220) + mat(k,678) = rxt(k,272)*y(k,77) + mat(k,1112) = rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73) + rxt(k,170)*y(k,133) & + + rxt(k,153)*y(k,216) + rxt(k,179)*y(k,220) + mat(k,758) = rxt(k,270)*y(k,216) + mat(k,1344) = rxt(k,247)*y(k,216) + mat(k,751) = rxt(k,202)*y(k,220) + mat(k,1827) = rxt(k,170)*y(k,77) + rxt(k,182)*y(k,220) + mat(k,258) = rxt(k,503)*y(k,220) + mat(k,606) = rxt(k,508)*y(k,220) + mat(k,1326) = rxt(k,513)*y(k,220) + mat(k,1576) = rxt(k,153)*y(k,77) + rxt(k,270)*y(k,81) + rxt(k,247)*y(k,85) + mat(k,1724) = rxt(k,297)*y(k,42) + rxt(k,315)*y(k,62) + rxt(k,179)*y(k,77) & + + rxt(k,202)*y(k,112) + rxt(k,182)*y(k,133) + rxt(k,503) & + *y(k,137) + rxt(k,508)*y(k,148) + rxt(k,513)*y(k,150) + mat(k,1104) = -(rxt(k,153)*y(k,216) + rxt(k,170)*y(k,133) + rxt(k,179) & + *y(k,220) + rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73)) + mat(k,1563) = -rxt(k,153)*y(k,77) + mat(k,1813) = -rxt(k,170)*y(k,77) + mat(k,1701) = -rxt(k,179)*y(k,77) + mat(k,1536) = -rxt(k,216)*y(k,77) + mat(k,674) = -rxt(k,272)*y(k,77) + mat(k,1915) = rxt(k,172)*y(k,202) + mat(k,2089) = rxt(k,172)*y(k,76) + mat(k,474) = -(rxt(k,171)*y(k,133) + rxt(k,180)*y(k,220) + rxt(k,217)*y(k,56)) + mat(k,1799) = -rxt(k,171)*y(k,79) + mat(k,1650) = -rxt(k,180)*y(k,79) + mat(k,1526) = -rxt(k,217)*y(k,79) + mat(k,2052) = 2.000_r8*rxt(k,186)*y(k,202) + mat(k,1650) = mat(k,1650) + 2.000_r8*rxt(k,185)*y(k,220) + mat(k,172) = rxt(k,515)*y(k,231) + mat(k,2145) = rxt(k,515)*y(k,152) + mat(k,753) = -(rxt(k,263)*y(k,133) + rxt(k,264)*y(k,220) + (rxt(k,269) & + + rxt(k,270)) * y(k,216)) + mat(k,1808) = -rxt(k,263)*y(k,81) + mat(k,1674) = -rxt(k,264)*y(k,81) + mat(k,1562) = -(rxt(k,269) + rxt(k,270)) * y(k,81) + mat(k,1350) = rxt(k,250)*y(k,42) + rxt(k,251)*y(k,202) + mat(k,1836) = rxt(k,250)*y(k,17) + mat(k,2070) = rxt(k,251)*y(k,17) + mat(k,1337) = -(rxt(k,234)*y(k,133) + rxt(k,235)*y(k,220) + (rxt(k,246) & + + rxt(k,247)) * y(k,216) + (rxt(k,549) + rxt(k,555) + rxt(k,560) & + ) * y(k,92) + (rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,60) & + + (rxt(k,556) + rxt(k,561)) * y(k,91)) + mat(k,1815) = -rxt(k,234)*y(k,85) + mat(k,1712) = -rxt(k,235)*y(k,85) + mat(k,1564) = -(rxt(k,246) + rxt(k,247)) * y(k,85) + mat(k,763) = -(rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,85) + mat(k,907) = -(rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,85) + mat(k,655) = -(rxt(k,556) + rxt(k,561)) * y(k,85) + mat(k,208) = rxt(k,326)*y(k,56) + mat(k,1839) = rxt(k,214)*y(k,56) + mat(k,1538) = rxt(k,326)*y(k,28) + rxt(k,214)*y(k,42) + rxt(k,216)*y(k,77) & + + rxt(k,217)*y(k,79) + rxt(k,236)*y(k,92) + rxt(k,218)*y(k,202) + mat(k,2126) = rxt(k,233)*y(k,220) + mat(k,1105) = rxt(k,216)*y(k,56) + mat(k,475) = rxt(k,217)*y(k,56) + mat(k,763) = mat(k,763) + rxt(k,236)*y(k,56) + mat(k,2099) = rxt(k,218)*y(k,56) + mat(k,1712) = mat(k,1712) + rxt(k,233)*y(k,59) + mat(k,105) = -(rxt(k,306)*y(k,220) + rxt(k,314)*y(k,216)) + mat(k,1599) = -rxt(k,306)*y(k,86) + mat(k,1560) = -rxt(k,314)*y(k,86) + mat(k,712) = -(rxt(k,307)*y(k,220)) + mat(k,1670) = -rxt(k,307)*y(k,87) + mat(k,856) = .050_r8*rxt(k,480)*y(k,135) + mat(k,201) = .350_r8*rxt(k,317)*y(k,220) + mat(k,452) = .370_r8*rxt(k,319)*y(k,135) + mat(k,940) = .120_r8*rxt(k,348)*y(k,135) + mat(k,780) = .110_r8*rxt(k,425)*y(k,135) + mat(k,1138) = .330_r8*rxt(k,378)*y(k,135) + mat(k,818) = .050_r8*rxt(k,483)*y(k,135) + mat(k,1244) = .120_r8*rxt(k,392)*y(k,135) + mat(k,1472) = rxt(k,310)*y(k,203) + mat(k,1746) = .050_r8*rxt(k,480)*y(k,6) + .370_r8*rxt(k,319)*y(k,25) & + + .120_r8*rxt(k,348)*y(k,29) + .110_r8*rxt(k,425)*y(k,98) & + + .330_r8*rxt(k,378)*y(k,105) + .050_r8*rxt(k,483)*y(k,110) & + + .120_r8*rxt(k,392)*y(k,111) + mat(k,2067) = rxt(k,308)*y(k,203) + mat(k,330) = rxt(k,310)*y(k,124) + rxt(k,308)*y(k,202) + mat(k,1670) = mat(k,1670) + .350_r8*rxt(k,317)*y(k,24) + mat(k,672) = rxt(k,272)*y(k,77) + rxt(k,274)*y(k,89) + rxt(k,273)*y(k,231) + mat(k,1102) = rxt(k,272)*y(k,73) + mat(k,1935) = rxt(k,274)*y(k,73) + mat(k,2146) = rxt(k,273)*y(k,73) + mat(k,1951) = -(rxt(k,211)*y(k,220) + rxt(k,274)*y(k,73)) + mat(k,1725) = -rxt(k,211)*y(k,89) + mat(k,679) = -rxt(k,274)*y(k,89) + mat(k,1852) = rxt(k,295)*y(k,126) + mat(k,1082) = rxt(k,328)*y(k,126) + mat(k,1157) = rxt(k,354)*y(k,126) + mat(k,912) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,85) + mat(k,195) = rxt(k,516)*y(k,126) + mat(k,1345) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,60) + mat(k,1993) = rxt(k,210)*y(k,220) + mat(k,1909) = rxt(k,295)*y(k,42) + rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) & + + rxt(k,516)*y(k,67) + mat(k,1725) = mat(k,1725) + rxt(k,210)*y(k,125) + mat(k,361) = -(rxt(k,187)*y(k,220)) + mat(k,1637) = -rxt(k,187)*y(k,90) + mat(k,1961) = rxt(k,208)*y(k,202) + mat(k,2044) = rxt(k,208)*y(k,125) + mat(k,654) = -(rxt(k,265)*y(k,133) + (rxt(k,556) + rxt(k,561)) * y(k,85)) + mat(k,1803) = -rxt(k,265)*y(k,91) + mat(k,1334) = -(rxt(k,556) + rxt(k,561)) * y(k,91) + mat(k,2002) = rxt(k,257)*y(k,202) + mat(k,2065) = rxt(k,257)*y(k,19) + mat(k,762) = -(rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,220) & + + (rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,85)) + mat(k,1529) = -rxt(k,236)*y(k,92) + mat(k,1809) = -rxt(k,237)*y(k,92) + mat(k,1675) = -rxt(k,238)*y(k,92) + mat(k,1335) = -(rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,92) + mat(k,2122) = rxt(k,225)*y(k,202) + mat(k,905) = rxt(k,230)*y(k,220) + mat(k,2071) = rxt(k,225)*y(k,59) + mat(k,1675) = mat(k,1675) + rxt(k,230)*y(k,60) + mat(k,968) = -(rxt(k,371)*y(k,220)) + mat(k,1691) = -rxt(k,371)*y(k,93) + mat(k,507) = .300_r8*rxt(k,416)*y(k,220) + mat(k,425) = .500_r8*rxt(k,417)*y(k,220) + mat(k,1485) = rxt(k,370)*y(k,199) + rxt(k,377)*y(k,206) + mat(k,460) = rxt(k,370)*y(k,124) + mat(k,1225) = rxt(k,377)*y(k,124) + mat(k,1691) = mat(k,1691) + .300_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & + *y(k,100) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,155) = -(rxt(k,402)*y(k,220)) + mat(k,1606) = -rxt(k,402)*y(k,94) + mat(k,991) = -(rxt(k,356)*y(k,220)) + mat(k,1693) = -rxt(k,356)*y(k,95) + mat(k,508) = .700_r8*rxt(k,416)*y(k,220) + mat(k,426) = .500_r8*rxt(k,417)*y(k,220) + mat(k,467) = .500_r8*rxt(k,391)*y(k,220) + mat(k,1487) = .050_r8*rxt(k,414)*y(k,205) + .220_r8*rxt(k,376)*y(k,206) & + + .250_r8*rxt(k,433)*y(k,228) + mat(k,1879) = .050_r8*rxt(k,415)*y(k,205) + .220_r8*rxt(k,375)*y(k,206) & + + .250_r8*rxt(k,434)*y(k,228) + mat(k,432) = .500_r8*rxt(k,360)*y(k,220) + mat(k,1291) = .220_r8*rxt(k,372)*y(k,206) + .250_r8*rxt(k,430)*y(k,228) + mat(k,1379) = .230_r8*rxt(k,373)*y(k,206) + .200_r8*rxt(k,361)*y(k,224) & + + .100_r8*rxt(k,431)*y(k,228) + mat(k,1199) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1226) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,195) + .230_r8*rxt(k,373)*y(k,196) + mat(k,1693) = mat(k,1693) + .700_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & + *y(k,100) + .500_r8*rxt(k,391)*y(k,109) + .500_r8*rxt(k,360) & + *y(k,146) + mat(k,1064) = .200_r8*rxt(k,361)*y(k,196) + mat(k,1089) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,195) + .100_r8*rxt(k,431)*y(k,196) + mat(k,212) = -(rxt(k,403)*y(k,220)) + mat(k,1616) = -rxt(k,403)*y(k,96) + mat(k,1444) = .870_r8*rxt(k,414)*y(k,205) + mat(k,1862) = .950_r8*rxt(k,415)*y(k,205) + mat(k,1284) = rxt(k,410)*y(k,205) + mat(k,1364) = .750_r8*rxt(k,411)*y(k,205) + mat(k,1189) = .870_r8*rxt(k,414)*y(k,124) + .950_r8*rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,195) + .750_r8*rxt(k,411)*y(k,196) + mat(k,68) = -(rxt(k,404)*y(k,220)) + mat(k,1594) = -rxt(k,404)*y(k,97) + mat(k,577) = .600_r8*rxt(k,427)*y(k,220) + mat(k,1594) = mat(k,1594) + .600_r8*rxt(k,427)*y(k,103) + mat(k,781) = -(rxt(k,418)*y(k,126) + rxt(k,425)*y(k,135) + rxt(k,426) & + *y(k,220)) + mat(k,1866) = -rxt(k,418)*y(k,98) + mat(k,1747) = -rxt(k,425)*y(k,98) + mat(k,1677) = -rxt(k,426)*y(k,98) + mat(k,505) = -(rxt(k,416)*y(k,220)) + mat(k,1654) = -rxt(k,416)*y(k,99) + mat(k,1459) = .080_r8*rxt(k,408)*y(k,204) + mat(k,1160) = .080_r8*rxt(k,408)*y(k,124) + mat(k,422) = -(rxt(k,417)*y(k,220)) + mat(k,1644) = -rxt(k,417)*y(k,100) + mat(k,1456) = .080_r8*rxt(k,414)*y(k,205) + mat(k,1190) = .080_r8*rxt(k,414)*y(k,124) + mat(k,1124) = -(rxt(k,419)*y(k,195) + rxt(k,420)*y(k,196) + rxt(k,421) & + *y(k,202) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126)) + mat(k,1294) = -rxt(k,419)*y(k,101) + mat(k,1387) = -rxt(k,420)*y(k,101) + mat(k,2090) = -rxt(k,421)*y(k,101) + mat(k,1495) = -rxt(k,422)*y(k,101) + mat(k,1887) = -rxt(k,423)*y(k,101) + mat(k,784) = rxt(k,418)*y(k,126) + mat(k,1887) = mat(k,1887) + rxt(k,418)*y(k,98) + mat(k,297) = -(rxt(k,424)*y(k,220)) + mat(k,1628) = -rxt(k,424)*y(k,102) + mat(k,1116) = rxt(k,421)*y(k,202) + mat(k,2034) = rxt(k,421)*y(k,101) + mat(k,578) = -(rxt(k,427)*y(k,220)) + mat(k,1660) = -rxt(k,427)*y(k,103) + mat(k,2059) = rxt(k,407)*y(k,204) + rxt(k,412)*y(k,205) + mat(k,1161) = rxt(k,407)*y(k,202) + mat(k,1192) = rxt(k,412)*y(k,202) + mat(k,39) = -(rxt(k,541)*y(k,220)) + mat(k,1588) = -rxt(k,541)*y(k,104) + mat(k,1140) = -(rxt(k,378)*y(k,135) + rxt(k,379)*y(k,220)) + mat(k,1766) = -rxt(k,378)*y(k,105) + mat(k,1703) = -rxt(k,379)*y(k,105) + mat(k,785) = .300_r8*rxt(k,425)*y(k,135) + mat(k,1496) = .360_r8*rxt(k,408)*y(k,204) + mat(k,1888) = .400_r8*rxt(k,409)*y(k,204) + mat(k,1766) = mat(k,1766) + .300_r8*rxt(k,425)*y(k,98) + mat(k,1295) = .390_r8*rxt(k,405)*y(k,204) + mat(k,1388) = .310_r8*rxt(k,406)*y(k,204) + mat(k,1170) = .360_r8*rxt(k,408)*y(k,124) + .400_r8*rxt(k,409)*y(k,126) & + + .390_r8*rxt(k,405)*y(k,195) + .310_r8*rxt(k,406)*y(k,196) + mat(k,215) = -(rxt(k,380)*y(k,220)) + mat(k,1617) = -rxt(k,380)*y(k,106) + mat(k,2026) = rxt(k,374)*y(k,206) + mat(k,1222) = rxt(k,374)*y(k,202) + mat(k,417) = -(rxt(k,389)*y(k,220)) + mat(k,1643) = -rxt(k,389)*y(k,107) + mat(k,1455) = .800_r8*rxt(k,398)*y(k,189) + mat(k,875) = .800_r8*rxt(k,398)*y(k,124) + mat(k,220) = -(rxt(k,390)*y(k,220)) + mat(k,1618) = -rxt(k,390)*y(k,108) + mat(k,2027) = .800_r8*rxt(k,387)*y(k,210) + mat(k,557) = .800_r8*rxt(k,387)*y(k,202) + mat(k,466) = -(rxt(k,391)*y(k,220)) + mat(k,1649) = -rxt(k,391)*y(k,109) + mat(k,1964) = rxt(k,394)*y(k,208) + mat(k,1268) = rxt(k,394)*y(k,125) + mat(k,820) = -(rxt(k,482)*y(k,126) + rxt(k,483)*y(k,135) + rxt(k,484) & + *y(k,220)) + mat(k,1868) = -rxt(k,482)*y(k,110) + mat(k,1749) = -rxt(k,483)*y(k,110) + mat(k,1680) = -rxt(k,484)*y(k,110) + mat(k,1251) = -(rxt(k,392)*y(k,135) + rxt(k,393)*y(k,220)) + mat(k,1771) = -rxt(k,392)*y(k,111) + mat(k,1708) = -rxt(k,393)*y(k,111) + mat(k,788) = .200_r8*rxt(k,425)*y(k,135) + mat(k,1501) = .560_r8*rxt(k,408)*y(k,204) + mat(k,1893) = .600_r8*rxt(k,409)*y(k,204) + mat(k,1771) = mat(k,1771) + .200_r8*rxt(k,425)*y(k,98) + mat(k,1300) = .610_r8*rxt(k,405)*y(k,204) + mat(k,1393) = .440_r8*rxt(k,406)*y(k,204) + mat(k,1174) = .560_r8*rxt(k,408)*y(k,124) + .600_r8*rxt(k,409)*y(k,126) & + + .610_r8*rxt(k,405)*y(k,195) + .440_r8*rxt(k,406)*y(k,196) + mat(k,744) = -(rxt(k,190)*y(k,124) + (rxt(k,191) + rxt(k,192) + rxt(k,193) & + ) * y(k,125) + rxt(k,194)*y(k,134) + rxt(k,202)*y(k,220) & + + rxt(k,574)*y(k,219)) + mat(k,1475) = -rxt(k,190)*y(k,112) + mat(k,1969) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + mat(k,1421) = -rxt(k,194)*y(k,112) + mat(k,1673) = -rxt(k,202)*y(k,112) + mat(k,684) = -rxt(k,574)*y(k,112) + mat(k,1807) = rxt(k,188)*y(k,211) + rxt(k,571)*y(k,214) + mat(k,1421) = mat(k,1421) + rxt(k,572)*y(k,214) + mat(k,702) = 1.100_r8*rxt(k,567)*y(k,212) + .200_r8*rxt(k,565)*y(k,213) + mat(k,413) = rxt(k,188)*y(k,133) + mat(k,571) = 1.100_r8*rxt(k,567)*y(k,198) + mat(k,692) = .200_r8*rxt(k,565)*y(k,198) + mat(k,388) = rxt(k,571)*y(k,133) + rxt(k,572)*y(k,134) + mat(k,1958) = rxt(k,209)*y(k,126) + mat(k,1860) = rxt(k,209)*y(k,125) + mat(k,267) = -(rxt(k,428)*y(k,220)) + mat(k,1624) = -rxt(k,428)*y(k,115) + mat(k,1115) = .200_r8*rxt(k,420)*y(k,196) + mat(k,1365) = .200_r8*rxt(k,420)*y(k,101) + mat(k,928) = -(rxt(k,429)*y(k,220)) + mat(k,1688) = -rxt(k,429)*y(k,116) + mat(k,1120) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + rxt(k,419)*y(k,195) & + + .800_r8*rxt(k,420)*y(k,196) + mat(k,1483) = rxt(k,422)*y(k,101) + mat(k,1874) = rxt(k,423)*y(k,101) + mat(k,1289) = rxt(k,419)*y(k,101) + mat(k,1376) = .800_r8*rxt(k,420)*y(k,101) + mat(k,49) = -(rxt(k,518)*y(k,220)) + mat(k,1590) = -rxt(k,518)*y(k,120) + mat(k,1507) = -(rxt(k,190)*y(k,112) + rxt(k,199)*y(k,126) + rxt(k,203) & + *y(k,202) + rxt(k,204)*y(k,135) + rxt(k,205)*y(k,133) + rxt(k,226) & + *y(k,59) + rxt(k,258)*y(k,19) + rxt(k,301)*y(k,196) + rxt(k,310) & + *y(k,203) + rxt(k,323)*y(k,192) + rxt(k,334)*y(k,195) + rxt(k,338) & + *y(k,201) + rxt(k,351)*y(k,193) + rxt(k,359)*y(k,223) + rxt(k,363) & + *y(k,224) + (rxt(k,369) + rxt(k,370)) * y(k,199) + (rxt(k,376) & + + rxt(k,377)) * y(k,206) + rxt(k,385)*y(k,208) + rxt(k,388) & + *y(k,210) + (rxt(k,398) + rxt(k,399)) * y(k,189) + rxt(k,408) & + *y(k,204) + rxt(k,414)*y(k,205) + rxt(k,422)*y(k,101) + rxt(k,433) & + *y(k,228) + rxt(k,437)*y(k,188) + rxt(k,440)*y(k,190) + rxt(k,445) & + *y(k,191) + rxt(k,447)*y(k,194) + rxt(k,451)*y(k,197) + rxt(k,454) & + *y(k,207) + rxt(k,457)*y(k,209) + rxt(k,460)*y(k,222) + rxt(k,467) & + *y(k,227) + rxt(k,473)*y(k,229) + rxt(k,476)*y(k,230) + rxt(k,487) & + *y(k,215) + rxt(k,492)*y(k,225) + rxt(k,497)*y(k,226) + rxt(k,576) & + *y(k,219)) + mat(k,747) = -rxt(k,190)*y(k,124) + mat(k,1900) = -rxt(k,199)*y(k,124) + mat(k,2103) = -rxt(k,203)*y(k,124) + mat(k,1778) = -rxt(k,204)*y(k,124) + mat(k,1819) = -rxt(k,205)*y(k,124) + mat(k,2130) = -rxt(k,226)*y(k,124) + mat(k,2008) = -rxt(k,258)*y(k,124) + mat(k,1398) = -rxt(k,301)*y(k,124) + mat(k,331) = -rxt(k,310)*y(k,124) + mat(k,844) = -rxt(k,323)*y(k,124) + mat(k,1305) = -rxt(k,334)*y(k,124) + mat(k,667) = -rxt(k,338)*y(k,124) + mat(k,733) = -rxt(k,351)*y(k,124) + mat(k,721) = -rxt(k,359)*y(k,124) + mat(k,1069) = -rxt(k,363)*y(k,124) + mat(k,462) = -(rxt(k,369) + rxt(k,370)) * y(k,124) + mat(k,1235) = -(rxt(k,376) + rxt(k,377)) * y(k,124) + mat(k,1274) = -rxt(k,385)*y(k,124) + mat(k,561) = -rxt(k,388)*y(k,124) + mat(k,886) = -(rxt(k,398) + rxt(k,399)) * y(k,124) + mat(k,1178) = -rxt(k,408)*y(k,124) + mat(k,1212) = -rxt(k,414)*y(k,124) + mat(k,1130) = -rxt(k,422)*y(k,124) + mat(k,1095) = -rxt(k,433)*y(k,124) + mat(k,402) = -rxt(k,437)*y(k,124) + mat(k,380) = -rxt(k,440)*y(k,124) + mat(k,325) = -rxt(k,445)*y(k,124) + mat(k,530) = -rxt(k,447)*y(k,124) + mat(k,649) = -rxt(k,451)*y(k,124) + mat(k,610) = -rxt(k,454)*y(k,124) + mat(k,807) = -rxt(k,457)*y(k,124) + mat(k,338) = -rxt(k,460)*y(k,124) + mat(k,624) = -rxt(k,467)*y(k,124) + mat(k,641) = -rxt(k,473)*y(k,124) + mat(k,395) = -rxt(k,476)*y(k,124) + mat(k,1053) = -rxt(k,487)*y(k,124) + mat(k,1034) = -rxt(k,492)*y(k,124) + mat(k,1014) = -rxt(k,497)*y(k,124) + mat(k,686) = -rxt(k,576)*y(k,124) + mat(k,747) = mat(k,747) + 2.000_r8*rxt(k,192)*y(k,125) + rxt(k,194)*y(k,134) & + + rxt(k,202)*y(k,220) + mat(k,1984) = 2.000_r8*rxt(k,192)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,509) & + *y(k,150) + mat(k,1819) = mat(k,1819) + rxt(k,195)*y(k,125) + mat(k,1428) = rxt(k,194)*y(k,112) + rxt(k,189)*y(k,211) + mat(k,1321) = rxt(k,509)*y(k,125) + mat(k,415) = rxt(k,189)*y(k,134) + mat(k,1716) = rxt(k,202)*y(k,112) + end do + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1994) = -((rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + (rxt(k,195) & + + rxt(k,197)) * y(k,133) + rxt(k,196)*y(k,135) + rxt(k,208) & + *y(k,202) + rxt(k,209)*y(k,126) + rxt(k,210)*y(k,220) + rxt(k,228) & + *y(k,59) + rxt(k,259)*y(k,19) + rxt(k,345)*y(k,195) + rxt(k,394) & + *y(k,208) + rxt(k,452)*y(k,197) + rxt(k,455)*y(k,207) + rxt(k,458) & + *y(k,209) + rxt(k,462)*y(k,141) + rxt(k,465)*y(k,188) + rxt(k,509) & + *y(k,150)) + mat(k,752) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,125) + mat(k,1829) = -(rxt(k,195) + rxt(k,197)) * y(k,125) + mat(k,1788) = -rxt(k,196)*y(k,125) + mat(k,2113) = -rxt(k,208)*y(k,125) + mat(k,1910) = -rxt(k,209)*y(k,125) + mat(k,1726) = -rxt(k,210)*y(k,125) + mat(k,2140) = -rxt(k,228)*y(k,125) + mat(k,2018) = -rxt(k,259)*y(k,125) + mat(k,1312) = -rxt(k,345)*y(k,125) + mat(k,1281) = -rxt(k,394)*y(k,125) + mat(k,651) = -rxt(k,452)*y(k,125) + mat(k,611) = -rxt(k,455)*y(k,125) + mat(k,809) = -rxt(k,458)*y(k,125) + mat(k,360) = -rxt(k,462)*y(k,125) + mat(k,404) = -rxt(k,465)*y(k,125) + mat(k,1327) = -rxt(k,509)*y(k,125) + mat(k,544) = rxt(k,396)*y(k,220) + mat(k,266) = rxt(k,367)*y(k,126) + mat(k,2018) = mat(k,2018) + rxt(k,258)*y(k,124) + mat(k,2140) = mat(k,2140) + rxt(k,226)*y(k,124) + mat(k,365) = rxt(k,187)*y(k,220) + mat(k,512) = .700_r8*rxt(k,416)*y(k,220) + mat(k,1136) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + mat(k,1517) = rxt(k,258)*y(k,19) + rxt(k,226)*y(k,59) + rxt(k,422)*y(k,101) & + + 2.000_r8*rxt(k,199)*y(k,126) + rxt(k,205)*y(k,133) & + + rxt(k,204)*y(k,135) + rxt(k,437)*y(k,188) + rxt(k,398) & + *y(k,189) + rxt(k,440)*y(k,190) + rxt(k,445)*y(k,191) & + + rxt(k,323)*y(k,192) + rxt(k,351)*y(k,193) + rxt(k,447) & + *y(k,194) + rxt(k,334)*y(k,195) + rxt(k,301)*y(k,196) & + + rxt(k,451)*y(k,197) + rxt(k,369)*y(k,199) + rxt(k,338) & + *y(k,201) + rxt(k,203)*y(k,202) + rxt(k,310)*y(k,203) & + + .920_r8*rxt(k,408)*y(k,204) + .920_r8*rxt(k,414)*y(k,205) & + + rxt(k,376)*y(k,206) + rxt(k,454)*y(k,207) + rxt(k,385) & + *y(k,208) + rxt(k,457)*y(k,209) + rxt(k,388)*y(k,210) & + + 1.600_r8*rxt(k,487)*y(k,215) + rxt(k,460)*y(k,222) & + + rxt(k,359)*y(k,223) + rxt(k,363)*y(k,224) + .900_r8*rxt(k,492) & + *y(k,225) + .800_r8*rxt(k,497)*y(k,226) + rxt(k,467)*y(k,227) & + + rxt(k,433)*y(k,228) + rxt(k,473)*y(k,229) + rxt(k,476) & + *y(k,230) + mat(k,1910) = mat(k,1910) + rxt(k,367)*y(k,16) + rxt(k,423)*y(k,101) & + + 2.000_r8*rxt(k,199)*y(k,124) + rxt(k,200)*y(k,133) & + + rxt(k,198)*y(k,202) + rxt(k,409)*y(k,204) + rxt(k,415) & + *y(k,205) + rxt(k,375)*y(k,206) + rxt(k,386)*y(k,208) & + + 2.000_r8*rxt(k,488)*y(k,215) + rxt(k,201)*y(k,220) & + + rxt(k,434)*y(k,228) + mat(k,774) = rxt(k,357)*y(k,220) + mat(k,1829) = mat(k,1829) + rxt(k,205)*y(k,124) + rxt(k,200)*y(k,126) + mat(k,1788) = mat(k,1788) + rxt(k,204)*y(k,124) + mat(k,525) = rxt(k,494)*y(k,220) + mat(k,404) = mat(k,404) + rxt(k,437)*y(k,124) + mat(k,889) = rxt(k,398)*y(k,124) + mat(k,382) = rxt(k,440)*y(k,124) + mat(k,327) = rxt(k,445)*y(k,124) + mat(k,847) = rxt(k,323)*y(k,124) + mat(k,736) = rxt(k,351)*y(k,124) + mat(k,533) = rxt(k,447)*y(k,124) + mat(k,1312) = mat(k,1312) + rxt(k,334)*y(k,124) + mat(k,1406) = rxt(k,301)*y(k,124) + .500_r8*rxt(k,485)*y(k,215) + mat(k,651) = mat(k,651) + rxt(k,451)*y(k,124) + mat(k,464) = rxt(k,369)*y(k,124) + mat(k,670) = rxt(k,338)*y(k,124) + mat(k,2113) = mat(k,2113) + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + mat(k,333) = rxt(k,310)*y(k,124) + mat(k,1185) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + mat(k,1219) = .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) + mat(k,1241) = rxt(k,376)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,611) = mat(k,611) + rxt(k,454)*y(k,124) + mat(k,1281) = mat(k,1281) + rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + mat(k,809) = mat(k,809) + rxt(k,457)*y(k,124) + mat(k,563) = rxt(k,388)*y(k,124) + mat(k,1059) = 1.600_r8*rxt(k,487)*y(k,124) + 2.000_r8*rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,196) + mat(k,1726) = mat(k,1726) + rxt(k,396)*y(k,1) + rxt(k,187)*y(k,90) & + + .700_r8*rxt(k,416)*y(k,99) + rxt(k,201)*y(k,126) + rxt(k,357) & + *y(k,127) + rxt(k,494)*y(k,175) + mat(k,340) = rxt(k,460)*y(k,124) + mat(k,724) = rxt(k,359)*y(k,124) + mat(k,1072) = rxt(k,363)*y(k,124) + mat(k,1039) = .900_r8*rxt(k,492)*y(k,124) + mat(k,1020) = .800_r8*rxt(k,497)*y(k,124) + mat(k,626) = rxt(k,467)*y(k,124) + mat(k,1100) = rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) + mat(k,643) = rxt(k,473)*y(k,124) + mat(k,397) = rxt(k,476)*y(k,124) + mat(k,1907) = -(rxt(k,198)*y(k,202) + rxt(k,199)*y(k,124) + rxt(k,200) & + *y(k,133) + rxt(k,201)*y(k,220) + rxt(k,209)*y(k,125) + rxt(k,295) & + *y(k,42) + rxt(k,328)*y(k,45) + rxt(k,347)*y(k,29) + rxt(k,354) & + *y(k,49) + rxt(k,367)*y(k,16) + rxt(k,375)*y(k,206) + rxt(k,386) & + *y(k,208) + rxt(k,409)*y(k,204) + rxt(k,415)*y(k,205) + rxt(k,418) & + *y(k,98) + rxt(k,423)*y(k,101) + rxt(k,434)*y(k,228) + rxt(k,479) & + *y(k,6) + rxt(k,482)*y(k,110) + rxt(k,488)*y(k,215) + rxt(k,499) & + *y(k,177) + rxt(k,516)*y(k,67)) + mat(k,2110) = -rxt(k,198)*y(k,126) + mat(k,1514) = -rxt(k,199)*y(k,126) + mat(k,1826) = -rxt(k,200)*y(k,126) + mat(k,1723) = -rxt(k,201)*y(k,126) + mat(k,1991) = -rxt(k,209)*y(k,126) + mat(k,1850) = -rxt(k,295)*y(k,126) + mat(k,1080) = -rxt(k,328)*y(k,126) + mat(k,955) = -rxt(k,347)*y(k,126) + mat(k,1155) = -rxt(k,354)*y(k,126) + mat(k,265) = -rxt(k,367)*y(k,126) + mat(k,1238) = -rxt(k,375)*y(k,126) + mat(k,1278) = -rxt(k,386)*y(k,126) + mat(k,1182) = -rxt(k,409)*y(k,126) + mat(k,1216) = -rxt(k,415)*y(k,126) + mat(k,794) = -rxt(k,418)*y(k,126) + mat(k,1133) = -rxt(k,423)*y(k,126) + mat(k,1098) = -rxt(k,434)*y(k,126) + mat(k,872) = -rxt(k,479)*y(k,126) + mat(k,834) = -rxt(k,482)*y(k,126) + mat(k,1056) = -rxt(k,488)*y(k,126) + mat(k,922) = -rxt(k,499)*y(k,126) + mat(k,194) = -rxt(k,516)*y(k,126) + mat(k,442) = rxt(k,260)*y(k,133) + mat(k,1549) = rxt(k,227)*y(k,60) + mat(k,911) = rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,220) + mat(k,677) = rxt(k,274)*y(k,89) + mat(k,1949) = rxt(k,274)*y(k,73) + rxt(k,211)*y(k,220) + mat(k,471) = .500_r8*rxt(k,391)*y(k,220) + mat(k,1991) = mat(k,1991) + rxt(k,197)*y(k,133) + rxt(k,196)*y(k,135) + mat(k,1826) = mat(k,1826) + rxt(k,260)*y(k,20) + rxt(k,229)*y(k,60) & + + rxt(k,197)*y(k,125) + mat(k,1785) = rxt(k,196)*y(k,125) + mat(k,355) = rxt(k,343)*y(k,220) + mat(k,1723) = mat(k,1723) + rxt(k,230)*y(k,60) + rxt(k,211)*y(k,89) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,343)*y(k,139) + mat(k,769) = -(rxt(k,357)*y(k,220)) + mat(k,1676) = -rxt(k,357)*y(k,127) + mat(k,942) = rxt(k,347)*y(k,126) + mat(k,423) = .500_r8*rxt(k,417)*y(k,220) + mat(k,299) = rxt(k,424)*y(k,220) + mat(k,268) = rxt(k,428)*y(k,220) + mat(k,925) = rxt(k,429)*y(k,220) + mat(k,1865) = rxt(k,347)*y(k,29) + mat(k,1676) = mat(k,1676) + .500_r8*rxt(k,417)*y(k,100) + rxt(k,424)*y(k,102) & + + rxt(k,428)*y(k,115) + rxt(k,429)*y(k,116) + mat(k,285) = -(rxt(k,489)*y(k,220)) + mat(k,1626) = -rxt(k,489)*y(k,128) + mat(k,2032) = rxt(k,486)*y(k,215) + mat(k,1042) = rxt(k,486)*y(k,202) + mat(k,1824) = -(rxt(k,167)*y(k,135) + 4._r8*rxt(k,168)*y(k,133) + rxt(k,169) & + *y(k,134) + rxt(k,170)*y(k,77) + rxt(k,171)*y(k,79) + rxt(k,176) & + *y(k,202) + rxt(k,182)*y(k,220) + (rxt(k,195) + rxt(k,197) & + ) * y(k,125) + rxt(k,200)*y(k,126) + rxt(k,205)*y(k,124) & + + rxt(k,229)*y(k,60) + rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) & + + rxt(k,237)*y(k,92) + rxt(k,260)*y(k,20) + rxt(k,261)*y(k,19) & + + rxt(k,263)*y(k,81) + rxt(k,265)*y(k,91) + rxt(k,296)*y(k,42) & + + rxt(k,502)*y(k,137) + (rxt(k,569) + rxt(k,570)) * y(k,212) & + + rxt(k,571)*y(k,214)) + mat(k,1783) = -rxt(k,167)*y(k,133) + mat(k,1433) = -rxt(k,169)*y(k,133) + mat(k,1110) = -rxt(k,170)*y(k,133) + mat(k,478) = -rxt(k,171)*y(k,133) + mat(k,2108) = -rxt(k,176)*y(k,133) + mat(k,1721) = -rxt(k,182)*y(k,133) + mat(k,1989) = -(rxt(k,195) + rxt(k,197)) * y(k,133) + mat(k,1905) = -rxt(k,200)*y(k,133) + mat(k,1512) = -rxt(k,205)*y(k,133) + mat(k,910) = -rxt(k,229)*y(k,133) + mat(k,2135) = -rxt(k,231)*y(k,133) + mat(k,1342) = -rxt(k,234)*y(k,133) + mat(k,766) = -rxt(k,237)*y(k,133) + mat(k,441) = -rxt(k,260)*y(k,133) + mat(k,2013) = -rxt(k,261)*y(k,133) + mat(k,757) = -rxt(k,263)*y(k,133) + mat(k,659) = -rxt(k,265)*y(k,133) + mat(k,1848) = -rxt(k,296)*y(k,133) + mat(k,257) = -rxt(k,502)*y(k,133) + mat(k,576) = -(rxt(k,569) + rxt(k,570)) * y(k,133) + mat(k,390) = -rxt(k,571)*y(k,133) + mat(k,1925) = rxt(k,174)*y(k,202) + mat(k,750) = rxt(k,190)*y(k,124) + rxt(k,191)*y(k,125) + rxt(k,194)*y(k,134) & + + rxt(k,574)*y(k,219) + mat(k,1512) = mat(k,1512) + rxt(k,190)*y(k,112) + mat(k,1989) = mat(k,1989) + rxt(k,191)*y(k,112) + mat(k,1433) = mat(k,1433) + rxt(k,194)*y(k,112) + rxt(k,504)*y(k,148) & + + rxt(k,510)*y(k,150) + rxt(k,573)*y(k,214) + (rxt(k,156) & + +rxt(k,157))*y(k,216) + rxt(k,579)*y(k,221) + mat(k,605) = rxt(k,504)*y(k,134) + mat(k,1325) = rxt(k,510)*y(k,134) + mat(k,707) = rxt(k,565)*y(k,213) + 1.150_r8*rxt(k,566)*y(k,219) + mat(k,2108) = mat(k,2108) + rxt(k,174)*y(k,76) + mat(k,696) = rxt(k,565)*y(k,198) + mat(k,390) = mat(k,390) + rxt(k,573)*y(k,134) + mat(k,1573) = (rxt(k,156)+rxt(k,157))*y(k,134) + mat(k,688) = rxt(k,574)*y(k,112) + 1.150_r8*rxt(k,566)*y(k,198) + mat(k,1721) = mat(k,1721) + 2.000_r8*rxt(k,184)*y(k,220) + mat(k,520) = rxt(k,579)*y(k,134) + mat(k,1427) = -(rxt(k,156)*y(k,216) + rxt(k,161)*y(k,217) + rxt(k,169) & + *y(k,133) + rxt(k,175)*y(k,76) + rxt(k,189)*y(k,211) + rxt(k,194) & + *y(k,112) + rxt(k,340)*y(k,200) + rxt(k,504)*y(k,148) + rxt(k,510) & + *y(k,150) + rxt(k,568)*y(k,212) + (rxt(k,572) + rxt(k,573) & + ) * y(k,214) + rxt(k,579)*y(k,221)) + mat(k,1567) = -rxt(k,156)*y(k,134) + mat(k,75) = -rxt(k,161)*y(k,134) + mat(k,1818) = -rxt(k,169)*y(k,134) + mat(k,1919) = -rxt(k,175)*y(k,134) + mat(k,414) = -rxt(k,189)*y(k,134) + mat(k,746) = -rxt(k,194)*y(k,134) + mat(k,347) = -rxt(k,340)*y(k,134) + mat(k,602) = -rxt(k,504)*y(k,134) + mat(k,1320) = -rxt(k,510)*y(k,134) + mat(k,573) = -rxt(k,568)*y(k,134) + mat(k,389) = -(rxt(k,572) + rxt(k,573)) * y(k,134) + mat(k,519) = -rxt(k,579)*y(k,134) + mat(k,1353) = rxt(k,252)*y(k,135) + rxt(k,251)*y(k,202) + mat(k,2007) = 2.000_r8*rxt(k,253)*y(k,19) + (rxt(k,255)+rxt(k,256))*y(k,59) & + + rxt(k,261)*y(k,133) + rxt(k,257)*y(k,202) + mat(k,1541) = rxt(k,220)*y(k,135) + rxt(k,218)*y(k,202) + mat(k,2129) = (rxt(k,255)+rxt(k,256))*y(k,19) + (2.000_r8*rxt(k,222) & + +2.000_r8*rxt(k,223))*y(k,59) + rxt(k,231)*y(k,133) & + + rxt(k,225)*y(k,202) + rxt(k,233)*y(k,220) + mat(k,1919) = mat(k,1919) + rxt(k,178)*y(k,135) + rxt(k,172)*y(k,202) + mat(k,362) = rxt(k,187)*y(k,220) + mat(k,746) = mat(k,746) + rxt(k,193)*y(k,125) + mat(k,1506) = rxt(k,204)*y(k,135) + rxt(k,576)*y(k,219) + mat(k,1983) = rxt(k,193)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,196)*y(k,135) + mat(k,1899) = rxt(k,200)*y(k,133) + rxt(k,198)*y(k,202) + mat(k,1818) = mat(k,1818) + rxt(k,261)*y(k,19) + rxt(k,231)*y(k,59) & + + rxt(k,195)*y(k,125) + rxt(k,200)*y(k,126) & + + 2.000_r8*rxt(k,168)*y(k,133) + 2.000_r8*rxt(k,167)*y(k,135) & + + rxt(k,176)*y(k,202) + rxt(k,160)*y(k,217) + rxt(k,182) & + *y(k,220) + mat(k,1427) = mat(k,1427) + 2.000_r8*rxt(k,161)*y(k,217) + mat(k,1777) = rxt(k,252)*y(k,17) + rxt(k,220)*y(k,56) + rxt(k,178)*y(k,76) & + + rxt(k,204)*y(k,124) + rxt(k,196)*y(k,125) & + + 2.000_r8*rxt(k,167)*y(k,133) + rxt(k,505)*y(k,148) & + + rxt(k,511)*y(k,150) + 2.000_r8*rxt(k,177)*y(k,202) & + + 2.000_r8*rxt(k,158)*y(k,216) + rxt(k,183)*y(k,220) + mat(k,602) = mat(k,602) + rxt(k,505)*y(k,135) + mat(k,1320) = mat(k,1320) + rxt(k,511)*y(k,135) + mat(k,843) = rxt(k,322)*y(k,202) + mat(k,732) = rxt(k,350)*y(k,202) + mat(k,1397) = rxt(k,300)*y(k,202) + mat(k,2102) = rxt(k,251)*y(k,17) + rxt(k,257)*y(k,19) + rxt(k,218)*y(k,56) & + + rxt(k,225)*y(k,59) + rxt(k,172)*y(k,76) + rxt(k,198)*y(k,126) & + + rxt(k,176)*y(k,133) + 2.000_r8*rxt(k,177)*y(k,135) & + + rxt(k,322)*y(k,192) + rxt(k,350)*y(k,193) + rxt(k,300) & + *y(k,196) + 2.000_r8*rxt(k,186)*y(k,202) + rxt(k,181)*y(k,220) & + + rxt(k,358)*y(k,223) + mat(k,1567) = mat(k,1567) + 2.000_r8*rxt(k,158)*y(k,135) + mat(k,75) = mat(k,75) + rxt(k,160)*y(k,133) + 2.000_r8*rxt(k,161)*y(k,134) + mat(k,685) = rxt(k,576)*y(k,124) + mat(k,1715) = rxt(k,233)*y(k,59) + rxt(k,187)*y(k,90) + rxt(k,182)*y(k,133) & + + rxt(k,183)*y(k,135) + rxt(k,181)*y(k,202) + mat(k,720) = rxt(k,358)*y(k,202) + end do + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1782) = -(rxt(k,158)*y(k,216) + rxt(k,167)*y(k,133) + rxt(k,177) & + *y(k,202) + rxt(k,178)*y(k,76) + rxt(k,183)*y(k,220) + rxt(k,196) & + *y(k,125) + rxt(k,204)*y(k,124) + rxt(k,220)*y(k,56) + rxt(k,252) & + *y(k,17) + rxt(k,319)*y(k,25) + rxt(k,348)*y(k,29) + rxt(k,378) & + *y(k,105) + rxt(k,392)*y(k,111) + rxt(k,425)*y(k,98) + rxt(k,463) & + *y(k,141) + rxt(k,480)*y(k,6) + rxt(k,483)*y(k,110) + rxt(k,505) & + *y(k,148) + rxt(k,511)*y(k,150)) + mat(k,1572) = -rxt(k,158)*y(k,135) + mat(k,1823) = -rxt(k,167)*y(k,135) + mat(k,2107) = -rxt(k,177)*y(k,135) + mat(k,1924) = -rxt(k,178)*y(k,135) + mat(k,1720) = -rxt(k,183)*y(k,135) + mat(k,1988) = -rxt(k,196)*y(k,135) + mat(k,1511) = -rxt(k,204)*y(k,135) + mat(k,1546) = -rxt(k,220)*y(k,135) + mat(k,1356) = -rxt(k,252)*y(k,135) + mat(k,455) = -rxt(k,319)*y(k,135) + mat(k,953) = -rxt(k,348)*y(k,135) + mat(k,1146) = -rxt(k,378)*y(k,135) + mat(k,1258) = -rxt(k,392)*y(k,135) + mat(k,792) = -rxt(k,425)*y(k,135) + mat(k,359) = -rxt(k,463)*y(k,135) + mat(k,870) = -rxt(k,480)*y(k,135) + mat(k,832) = -rxt(k,483)*y(k,135) + mat(k,604) = -rxt(k,505)*y(k,135) + mat(k,1324) = -rxt(k,511)*y(k,135) + mat(k,1823) = mat(k,1823) + rxt(k,169)*y(k,134) + mat(k,1432) = rxt(k,169)*y(k,133) + mat(k,1307) = .150_r8*rxt(k,333)*y(k,202) + mat(k,2107) = mat(k,2107) + .150_r8*rxt(k,333)*y(k,195) + .150_r8*rxt(k,383) & + *y(k,208) + mat(k,1276) = .150_r8*rxt(k,383)*y(k,202) + mat(k,230) = -(rxt(k,512)*y(k,150)) + mat(k,1315) = -rxt(k,512)*y(k,136) + mat(k,2000) = rxt(k,254)*y(k,59) + mat(k,2121) = rxt(k,254)*y(k,19) + 2.000_r8*rxt(k,224)*y(k,59) + mat(k,251) = -(rxt(k,502)*y(k,133) + rxt(k,503)*y(k,220)) + mat(k,1795) = -rxt(k,502)*y(k,137) + mat(k,1622) = -rxt(k,503)*y(k,137) + mat(k,965) = rxt(k,371)*y(k,220) + mat(k,1441) = .100_r8*rxt(k,492)*y(k,225) + mat(k,1607) = rxt(k,371)*y(k,93) + mat(k,1023) = .100_r8*rxt(k,492)*y(k,124) + mat(k,350) = -(rxt(k,343)*y(k,220)) + mat(k,1635) = -rxt(k,343)*y(k,139) + mat(k,1959) = rxt(k,345)*y(k,195) + mat(k,1285) = rxt(k,345)*y(k,125) + mat(k,1957) = rxt(k,465)*y(k,188) + mat(k,399) = rxt(k,465)*y(k,125) + mat(k,357) = -(rxt(k,462)*y(k,125) + rxt(k,463)*y(k,135)) + mat(k,1960) = -rxt(k,462)*y(k,141) + mat(k,1740) = -rxt(k,463)*y(k,141) + mat(k,123) = .070_r8*rxt(k,449)*y(k,220) + mat(k,1451) = rxt(k,447)*y(k,194) + mat(k,98) = .060_r8*rxt(k,461)*y(k,220) + mat(k,148) = .070_r8*rxt(k,477)*y(k,220) + mat(k,528) = rxt(k,447)*y(k,124) + mat(k,1636) = .070_r8*rxt(k,449)*y(k,66) + .060_r8*rxt(k,461)*y(k,142) & + + .070_r8*rxt(k,477)*y(k,184) + mat(k,96) = -(rxt(k,461)*y(k,220)) + mat(k,1597) = -rxt(k,461)*y(k,142) + mat(k,88) = .530_r8*rxt(k,438)*y(k,220) + mat(k,1597) = mat(k,1597) + .530_r8*rxt(k,438)*y(k,7) + mat(k,235) = -(rxt(k,464)*y(k,220)) + mat(k,1619) = -rxt(k,464)*y(k,143) + mat(k,2028) = rxt(k,459)*y(k,222) + mat(k,335) = rxt(k,459)*y(k,202) + mat(k,430) = -(rxt(k,360)*y(k,220)) + mat(k,1645) = -rxt(k,360)*y(k,146) + mat(k,2050) = rxt(k,358)*y(k,223) + mat(k,716) = rxt(k,358)*y(k,202) + mat(k,291) = -(rxt(k,364)*y(k,220)) + mat(k,1627) = -rxt(k,364)*y(k,147) + mat(k,2033) = .850_r8*rxt(k,362)*y(k,224) + mat(k,1062) = .850_r8*rxt(k,362)*y(k,202) + mat(k,600) = -(rxt(k,504)*y(k,134) + rxt(k,505)*y(k,135) + rxt(k,508) & + *y(k,220)) + mat(k,1417) = -rxt(k,504)*y(k,148) + mat(k,1744) = -rxt(k,505)*y(k,148) + mat(k,1662) = -rxt(k,508)*y(k,148) + mat(k,1318) = -(rxt(k,506)*y(k,19) + rxt(k,507)*y(k,59) + rxt(k,509)*y(k,125) & + + rxt(k,510)*y(k,134) + rxt(k,511)*y(k,135) + rxt(k,512) & + *y(k,136) + rxt(k,513)*y(k,220)) + mat(k,2004) = -rxt(k,506)*y(k,150) + mat(k,2125) = -rxt(k,507)*y(k,150) + mat(k,1979) = -rxt(k,509)*y(k,150) + mat(k,1425) = -rxt(k,510)*y(k,150) + mat(k,1774) = -rxt(k,511)*y(k,150) + mat(k,232) = -rxt(k,512)*y(k,150) + mat(k,1711) = -rxt(k,513)*y(k,150) + mat(k,1814) = rxt(k,502)*y(k,137) + mat(k,1425) = mat(k,1425) + rxt(k,504)*y(k,148) + mat(k,1774) = mat(k,1774) + rxt(k,505)*y(k,148) + mat(k,255) = rxt(k,502)*y(k,133) + mat(k,601) = rxt(k,504)*y(k,134) + rxt(k,505)*y(k,135) + rxt(k,508)*y(k,220) + mat(k,1711) = mat(k,1711) + rxt(k,508)*y(k,148) + mat(k,892) = -(rxt(k,514)*y(k,220)) + mat(k,1684) = -rxt(k,514)*y(k,151) + mat(k,2003) = rxt(k,506)*y(k,150) + mat(k,2123) = rxt(k,507)*y(k,150) + mat(k,192) = rxt(k,516)*y(k,126) + (rxt(k,517)+.500_r8*rxt(k,519))*y(k,220) + mat(k,1972) = rxt(k,509)*y(k,150) + mat(k,1871) = rxt(k,516)*y(k,67) + mat(k,1422) = rxt(k,510)*y(k,150) + mat(k,1752) = rxt(k,511)*y(k,150) + mat(k,231) = rxt(k,512)*y(k,150) + mat(k,253) = rxt(k,503)*y(k,220) + mat(k,1317) = rxt(k,506)*y(k,19) + rxt(k,507)*y(k,59) + rxt(k,509)*y(k,125) & + + rxt(k,510)*y(k,134) + rxt(k,511)*y(k,135) + rxt(k,512) & + *y(k,136) + rxt(k,513)*y(k,220) + mat(k,1684) = mat(k,1684) + (rxt(k,517)+.500_r8*rxt(k,519))*y(k,67) & + + rxt(k,503)*y(k,137) + rxt(k,513)*y(k,150) + mat(k,173) = -(rxt(k,515)*y(k,231)) + mat(k,2147) = -rxt(k,515)*y(k,152) + mat(k,891) = rxt(k,514)*y(k,220) + mat(k,1610) = rxt(k,514)*y(k,151) + mat(k,849) = .2202005_r8*rxt(k,535)*y(k,135) + .2202005_r8*rxt(k,536) & + *y(k,220) + mat(k,81) = .0023005_r8*rxt(k,537)*y(k,220) + mat(k,775) = .0031005_r8*rxt(k,540)*y(k,220) + mat(k,34) = .2381005_r8*rxt(k,541)*y(k,220) + mat(k,811) = .0508005_r8*rxt(k,543)*y(k,135) + .0508005_r8*rxt(k,544) & + *y(k,220) + mat(k,1731) = .2202005_r8*rxt(k,535)*y(k,6) + .0508005_r8*rxt(k,543)*y(k,110) + mat(k,40) = .5931005_r8*rxt(k,545)*y(k,220) + mat(k,109) = .1364005_r8*rxt(k,546)*y(k,220) + mat(k,133) = .1677005_r8*rxt(k,547)*y(k,220) + mat(k,1583) = .2202005_r8*rxt(k,536)*y(k,6) + .0023005_r8*rxt(k,537)*y(k,7) & + + .0031005_r8*rxt(k,540)*y(k,98) + .2381005_r8*rxt(k,541) & + *y(k,104) + .0508005_r8*rxt(k,544)*y(k,110) & + + .5931005_r8*rxt(k,545)*y(k,172) + .1364005_r8*rxt(k,546) & + *y(k,180) + .1677005_r8*rxt(k,547)*y(k,182) + mat(k,850) = .2067005_r8*rxt(k,535)*y(k,135) + .2067005_r8*rxt(k,536) & + *y(k,220) + mat(k,82) = .0008005_r8*rxt(k,537)*y(k,220) + mat(k,776) = .0035005_r8*rxt(k,540)*y(k,220) + mat(k,35) = .1308005_r8*rxt(k,541)*y(k,220) + mat(k,812) = .1149005_r8*rxt(k,543)*y(k,135) + .1149005_r8*rxt(k,544) & + *y(k,220) + mat(k,1732) = .2067005_r8*rxt(k,535)*y(k,6) + .1149005_r8*rxt(k,543)*y(k,110) + mat(k,41) = .1534005_r8*rxt(k,545)*y(k,220) + mat(k,110) = .0101005_r8*rxt(k,546)*y(k,220) + mat(k,134) = .0174005_r8*rxt(k,547)*y(k,220) + mat(k,1584) = .2067005_r8*rxt(k,536)*y(k,6) + .0008005_r8*rxt(k,537)*y(k,7) & + + .0035005_r8*rxt(k,540)*y(k,98) + .1308005_r8*rxt(k,541) & + *y(k,104) + .1149005_r8*rxt(k,544)*y(k,110) & + + .1534005_r8*rxt(k,545)*y(k,172) + .0101005_r8*rxt(k,546) & + *y(k,180) + .0174005_r8*rxt(k,547)*y(k,182) + mat(k,851) = .0653005_r8*rxt(k,535)*y(k,135) + .0653005_r8*rxt(k,536) & + *y(k,220) + mat(k,83) = .0843005_r8*rxt(k,537)*y(k,220) + mat(k,777) = .0003005_r8*rxt(k,540)*y(k,220) + mat(k,36) = .0348005_r8*rxt(k,541)*y(k,220) + mat(k,813) = .0348005_r8*rxt(k,543)*y(k,135) + .0348005_r8*rxt(k,544) & + *y(k,220) + mat(k,1733) = .0653005_r8*rxt(k,535)*y(k,6) + .0348005_r8*rxt(k,543)*y(k,110) + mat(k,42) = .0459005_r8*rxt(k,545)*y(k,220) + mat(k,111) = .0763005_r8*rxt(k,546)*y(k,220) + mat(k,135) = .086_r8*rxt(k,547)*y(k,220) + mat(k,1585) = .0653005_r8*rxt(k,536)*y(k,6) + .0843005_r8*rxt(k,537)*y(k,7) & + + .0003005_r8*rxt(k,540)*y(k,98) + .0348005_r8*rxt(k,541) & + *y(k,104) + .0348005_r8*rxt(k,544)*y(k,110) & + + .0459005_r8*rxt(k,545)*y(k,172) + .0763005_r8*rxt(k,546) & + *y(k,180) + .086_r8*rxt(k,547)*y(k,182) + mat(k,852) = .1749305_r8*rxt(k,534)*y(k,126) + .1284005_r8*rxt(k,535) & + *y(k,135) + .1284005_r8*rxt(k,536)*y(k,220) + mat(k,84) = .0443005_r8*rxt(k,537)*y(k,220) + mat(k,778) = .0590245_r8*rxt(k,538)*y(k,126) + .0033005_r8*rxt(k,539) & + *y(k,135) + .0271005_r8*rxt(k,540)*y(k,220) + mat(k,37) = .0076005_r8*rxt(k,541)*y(k,220) + mat(k,814) = .1749305_r8*rxt(k,542)*y(k,126) + .0554005_r8*rxt(k,543) & + *y(k,135) + .0554005_r8*rxt(k,544)*y(k,220) + mat(k,1858) = .1749305_r8*rxt(k,534)*y(k,6) + .0590245_r8*rxt(k,538)*y(k,98) & + + .1749305_r8*rxt(k,542)*y(k,110) + mat(k,1734) = .1284005_r8*rxt(k,535)*y(k,6) + .0033005_r8*rxt(k,539)*y(k,98) & + + .0554005_r8*rxt(k,543)*y(k,110) + mat(k,43) = .0085005_r8*rxt(k,545)*y(k,220) + mat(k,112) = .2157005_r8*rxt(k,546)*y(k,220) + mat(k,136) = .0512005_r8*rxt(k,547)*y(k,220) + mat(k,1586) = .1284005_r8*rxt(k,536)*y(k,6) + .0443005_r8*rxt(k,537)*y(k,7) & + + .0271005_r8*rxt(k,540)*y(k,98) + .0076005_r8*rxt(k,541) & + *y(k,104) + .0554005_r8*rxt(k,544)*y(k,110) & + + .0085005_r8*rxt(k,545)*y(k,172) + .2157005_r8*rxt(k,546) & + *y(k,180) + .0512005_r8*rxt(k,547)*y(k,182) + mat(k,853) = .5901905_r8*rxt(k,534)*y(k,126) + .114_r8*rxt(k,535)*y(k,135) & + + .114_r8*rxt(k,536)*y(k,220) + mat(k,85) = .1621005_r8*rxt(k,537)*y(k,220) + mat(k,779) = .0250245_r8*rxt(k,538)*y(k,126) + .0474005_r8*rxt(k,540) & + *y(k,220) + mat(k,38) = .0113005_r8*rxt(k,541)*y(k,220) + mat(k,815) = .5901905_r8*rxt(k,542)*y(k,126) + .1278005_r8*rxt(k,543) & + *y(k,135) + .1278005_r8*rxt(k,544)*y(k,220) + mat(k,1859) = .5901905_r8*rxt(k,534)*y(k,6) + .0250245_r8*rxt(k,538)*y(k,98) & + + .5901905_r8*rxt(k,542)*y(k,110) + mat(k,1735) = .114_r8*rxt(k,535)*y(k,6) + .1278005_r8*rxt(k,543)*y(k,110) + mat(k,44) = .0128005_r8*rxt(k,545)*y(k,220) + mat(k,113) = .0232005_r8*rxt(k,546)*y(k,220) + mat(k,137) = .1598005_r8*rxt(k,547)*y(k,220) + mat(k,1587) = .114_r8*rxt(k,536)*y(k,6) + .1621005_r8*rxt(k,537)*y(k,7) & + + .0474005_r8*rxt(k,540)*y(k,98) + .0113005_r8*rxt(k,541) & + *y(k,104) + .1278005_r8*rxt(k,544)*y(k,110) & + + .0128005_r8*rxt(k,545)*y(k,172) + .0232005_r8*rxt(k,546) & + *y(k,180) + .1598005_r8*rxt(k,547)*y(k,182) + end do + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,45) = -(rxt(k,545)*y(k,220)) + mat(k,1589) = -rxt(k,545)*y(k,172) + mat(k,116) = .100_r8*rxt(k,469)*y(k,220) + mat(k,138) = .230_r8*rxt(k,471)*y(k,220) + mat(k,1602) = .100_r8*rxt(k,469)*y(k,180) + .230_r8*rxt(k,471)*y(k,182) + mat(k,481) = -(rxt(k,493)*y(k,220)) + mat(k,1651) = -rxt(k,493)*y(k,174) + mat(k,2053) = rxt(k,491)*y(k,225) + mat(k,1024) = rxt(k,491)*y(k,202) + mat(k,521) = -(rxt(k,494)*y(k,220)) + mat(k,1655) = -rxt(k,494)*y(k,175) + mat(k,1460) = .200_r8*rxt(k,487)*y(k,215) + .200_r8*rxt(k,497)*y(k,226) + mat(k,1368) = .500_r8*rxt(k,485)*y(k,215) + mat(k,1043) = .200_r8*rxt(k,487)*y(k,124) + .500_r8*rxt(k,485)*y(k,196) + mat(k,1002) = .200_r8*rxt(k,497)*y(k,124) + mat(k,368) = -(rxt(k,498)*y(k,220)) + mat(k,1638) = -rxt(k,498)*y(k,176) + mat(k,2045) = rxt(k,496)*y(k,226) + mat(k,1001) = rxt(k,496)*y(k,202) + mat(k,916) = -(rxt(k,499)*y(k,126) + rxt(k,500)*y(k,220)) + mat(k,1873) = -rxt(k,499)*y(k,177) + mat(k,1687) = -rxt(k,500)*y(k,177) + mat(k,861) = .330_r8*rxt(k,480)*y(k,135) + mat(k,823) = .330_r8*rxt(k,483)*y(k,135) + mat(k,1482) = .800_r8*rxt(k,487)*y(k,215) + .800_r8*rxt(k,497)*y(k,226) + mat(k,1873) = mat(k,1873) + rxt(k,488)*y(k,215) + mat(k,1754) = .330_r8*rxt(k,480)*y(k,6) + .330_r8*rxt(k,483)*y(k,110) + mat(k,522) = rxt(k,494)*y(k,220) + mat(k,1375) = .500_r8*rxt(k,485)*y(k,215) + rxt(k,495)*y(k,226) + mat(k,1045) = .800_r8*rxt(k,487)*y(k,124) + rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,196) + mat(k,1687) = mat(k,1687) + rxt(k,494)*y(k,175) + mat(k,1005) = .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,196) + mat(k,982) = -(rxt(k,501)*y(k,220)) + mat(k,1692) = -rxt(k,501)*y(k,178) + mat(k,862) = .300_r8*rxt(k,480)*y(k,135) + mat(k,824) = .300_r8*rxt(k,483)*y(k,135) + mat(k,1486) = .900_r8*rxt(k,492)*y(k,225) + mat(k,1757) = .300_r8*rxt(k,480)*y(k,6) + .300_r8*rxt(k,483)*y(k,110) + mat(k,1378) = rxt(k,490)*y(k,225) + mat(k,1028) = .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,196) + mat(k,492) = -(rxt(k,468)*y(k,220)) + mat(k,1652) = -rxt(k,468)*y(k,179) + mat(k,2054) = rxt(k,466)*y(k,227) + mat(k,615) = rxt(k,466)*y(k,202) + mat(k,114) = -(rxt(k,469)*y(k,220)) + mat(k,1600) = -rxt(k,469)*y(k,180) + mat(k,130) = -(rxt(k,435)*y(k,220)) + mat(k,1603) = -rxt(k,435)*y(k,181) + mat(k,2024) = rxt(k,432)*y(k,228) + mat(k,1085) = rxt(k,432)*y(k,202) + mat(k,139) = -(rxt(k,471)*y(k,220)) + mat(k,1604) = -rxt(k,471)*y(k,182) + mat(k,589) = -(rxt(k,474)*y(k,220)) + mat(k,1661) = -rxt(k,474)*y(k,183) + mat(k,2060) = rxt(k,472)*y(k,229) + mat(k,632) = rxt(k,472)*y(k,202) + mat(k,147) = -(rxt(k,477)*y(k,220)) + mat(k,1605) = -rxt(k,477)*y(k,184) + mat(k,140) = .150_r8*rxt(k,471)*y(k,220) + mat(k,1605) = mat(k,1605) + .150_r8*rxt(k,471)*y(k,182) + mat(k,315) = -(rxt(k,478)*y(k,220)) + mat(k,1631) = -rxt(k,478)*y(k,185) + mat(k,2037) = rxt(k,475)*y(k,230) + mat(k,391) = rxt(k,475)*y(k,202) + mat(k,400) = -(rxt(k,436)*y(k,202) + rxt(k,437)*y(k,124) + rxt(k,465) & + *y(k,125)) + mat(k,2048) = -rxt(k,436)*y(k,188) + mat(k,1454) = -rxt(k,437)*y(k,188) + mat(k,1962) = -rxt(k,465)*y(k,188) + mat(k,170) = rxt(k,442)*y(k,220) + mat(k,1641) = rxt(k,442)*y(k,22) + mat(k,880) = -(rxt(k,397)*y(k,202) + (rxt(k,398) + rxt(k,399)) * y(k,124)) + mat(k,2076) = -rxt(k,397)*y(k,189) + mat(k,1480) = -(rxt(k,398) + rxt(k,399)) * y(k,189) + mat(k,550) = rxt(k,400)*y(k,220) + mat(k,164) = rxt(k,401)*y(k,220) + mat(k,1683) = rxt(k,400)*y(k,2) + rxt(k,401)*y(k,15) + mat(k,377) = -(rxt(k,439)*y(k,202) + rxt(k,440)*y(k,124)) + mat(k,2046) = -rxt(k,439)*y(k,190) + mat(k,1452) = -rxt(k,440)*y(k,190) + mat(k,89) = .350_r8*rxt(k,438)*y(k,220) + mat(k,275) = rxt(k,441)*y(k,220) + mat(k,1639) = .350_r8*rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) + mat(k,323) = -(rxt(k,443)*y(k,202) + rxt(k,445)*y(k,124)) + mat(k,2038) = -rxt(k,443)*y(k,191) + mat(k,1446) = -rxt(k,445)*y(k,191) + mat(k,242) = rxt(k,444)*y(k,220) + mat(k,117) = .070_r8*rxt(k,469)*y(k,220) + mat(k,141) = .060_r8*rxt(k,471)*y(k,220) + mat(k,1632) = rxt(k,444)*y(k,23) + .070_r8*rxt(k,469)*y(k,180) & + + .060_r8*rxt(k,471)*y(k,182) + mat(k,840) = -(4._r8*rxt(k,320)*y(k,192) + rxt(k,321)*y(k,196) + rxt(k,322) & + *y(k,202) + rxt(k,323)*y(k,124)) + mat(k,1373) = -rxt(k,321)*y(k,192) + mat(k,2075) = -rxt(k,322)*y(k,192) + mat(k,1479) = -rxt(k,323)*y(k,192) + mat(k,247) = .500_r8*rxt(k,325)*y(k,220) + mat(k,207) = rxt(k,326)*y(k,56) + rxt(k,327)*y(k,220) + mat(k,1531) = rxt(k,326)*y(k,28) + mat(k,1681) = .500_r8*rxt(k,325)*y(k,27) + rxt(k,327)*y(k,28) + mat(k,728) = -(rxt(k,349)*y(k,196) + rxt(k,350)*y(k,202) + rxt(k,351) & + *y(k,124)) + mat(k,1370) = -rxt(k,349)*y(k,193) + mat(k,2069) = -rxt(k,350)*y(k,193) + mat(k,1474) = -rxt(k,351)*y(k,193) + mat(k,304) = rxt(k,352)*y(k,220) + mat(k,56) = rxt(k,353)*y(k,220) + mat(k,1672) = rxt(k,352)*y(k,30) + rxt(k,353)*y(k,31) + mat(k,529) = -(rxt(k,446)*y(k,202) + rxt(k,447)*y(k,124)) + mat(k,2056) = -rxt(k,446)*y(k,194) + mat(k,1461) = -rxt(k,447)*y(k,194) + mat(k,183) = rxt(k,448)*y(k,220) + mat(k,1461) = mat(k,1461) + rxt(k,437)*y(k,188) + mat(k,1743) = rxt(k,463)*y(k,141) + mat(k,358) = rxt(k,463)*y(k,135) + mat(k,401) = rxt(k,437)*y(k,124) + .400_r8*rxt(k,436)*y(k,202) + mat(k,2056) = mat(k,2056) + .400_r8*rxt(k,436)*y(k,188) + mat(k,1656) = rxt(k,448)*y(k,32) + mat(k,1302) = -(4._r8*rxt(k,331)*y(k,195) + rxt(k,332)*y(k,196) + rxt(k,333) & + *y(k,202) + rxt(k,334)*y(k,124) + rxt(k,345)*y(k,125) + rxt(k,372) & + *y(k,206) + rxt(k,405)*y(k,204) + rxt(k,410)*y(k,205) + rxt(k,419) & + *y(k,101) + rxt(k,430)*y(k,228)) + mat(k,1395) = -rxt(k,332)*y(k,195) + mat(k,2098) = -rxt(k,333)*y(k,195) + mat(k,1503) = -rxt(k,334)*y(k,195) + mat(k,1978) = -rxt(k,345)*y(k,195) + mat(k,1233) = -rxt(k,372)*y(k,195) + mat(k,1176) = -rxt(k,405)*y(k,195) + mat(k,1210) = -rxt(k,410)*y(k,195) + mat(k,1128) = -rxt(k,419)*y(k,195) + mat(k,1093) = -rxt(k,430)*y(k,195) + mat(k,868) = .060_r8*rxt(k,480)*y(k,135) + mat(k,1077) = rxt(k,328)*y(k,126) + rxt(k,329)*y(k,220) + mat(k,1153) = rxt(k,354)*y(k,126) + rxt(k,355)*y(k,220) + mat(k,407) = .500_r8*rxt(k,336)*y(k,220) + mat(k,789) = .080_r8*rxt(k,425)*y(k,135) + mat(k,1144) = .100_r8*rxt(k,378)*y(k,135) + mat(k,830) = .060_r8*rxt(k,483)*y(k,135) + mat(k,1253) = .280_r8*rxt(k,392)*y(k,135) + mat(k,1503) = mat(k,1503) + .530_r8*rxt(k,376)*y(k,206) + rxt(k,385)*y(k,208) & + + rxt(k,388)*y(k,210) + rxt(k,363)*y(k,224) + mat(k,1895) = rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) + .530_r8*rxt(k,375) & + *y(k,206) + rxt(k,386)*y(k,208) + mat(k,1773) = .060_r8*rxt(k,480)*y(k,6) + .080_r8*rxt(k,425)*y(k,98) & + + .100_r8*rxt(k,378)*y(k,105) + .060_r8*rxt(k,483)*y(k,110) & + + .280_r8*rxt(k,392)*y(k,111) + mat(k,985) = .650_r8*rxt(k,501)*y(k,220) + mat(k,1302) = mat(k,1302) + .530_r8*rxt(k,372)*y(k,206) + mat(k,1395) = mat(k,1395) + .260_r8*rxt(k,373)*y(k,206) + rxt(k,382)*y(k,208) & + + .300_r8*rxt(k,361)*y(k,224) + mat(k,2098) = mat(k,2098) + .450_r8*rxt(k,383)*y(k,208) + .200_r8*rxt(k,387) & + *y(k,210) + .150_r8*rxt(k,362)*y(k,224) + mat(k,1233) = mat(k,1233) + .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375) & + *y(k,126) + .530_r8*rxt(k,372)*y(k,195) + .260_r8*rxt(k,373) & + *y(k,196) + mat(k,1272) = rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + rxt(k,382)*y(k,196) & + + .450_r8*rxt(k,383)*y(k,202) + 4.000_r8*rxt(k,384)*y(k,208) + mat(k,560) = rxt(k,388)*y(k,124) + .200_r8*rxt(k,387)*y(k,202) + mat(k,1710) = rxt(k,329)*y(k,45) + rxt(k,355)*y(k,49) + .500_r8*rxt(k,336) & + *y(k,51) + .650_r8*rxt(k,501)*y(k,178) + mat(k,1067) = rxt(k,363)*y(k,124) + .300_r8*rxt(k,361)*y(k,196) & + + .150_r8*rxt(k,362)*y(k,202) + mat(k,1396) = -(rxt(k,221)*y(k,59) + (4._r8*rxt(k,298) + 4._r8*rxt(k,299) & + ) * y(k,196) + rxt(k,300)*y(k,202) + rxt(k,301)*y(k,124) & + + rxt(k,321)*y(k,192) + rxt(k,332)*y(k,195) + rxt(k,349) & + *y(k,193) + rxt(k,361)*y(k,224) + rxt(k,373)*y(k,206) + rxt(k,382) & + *y(k,208) + rxt(k,406)*y(k,204) + rxt(k,411)*y(k,205) + rxt(k,420) & + *y(k,101) + rxt(k,431)*y(k,228) + rxt(k,485)*y(k,215) + rxt(k,490) & + *y(k,225) + rxt(k,495)*y(k,226)) + mat(k,2128) = -rxt(k,221)*y(k,196) + mat(k,2101) = -rxt(k,300)*y(k,196) + mat(k,1505) = -rxt(k,301)*y(k,196) + mat(k,842) = -rxt(k,321)*y(k,196) + mat(k,1303) = -rxt(k,332)*y(k,196) + mat(k,731) = -rxt(k,349)*y(k,196) + mat(k,1068) = -rxt(k,361)*y(k,196) + mat(k,1234) = -rxt(k,373)*y(k,196) + mat(k,1273) = -rxt(k,382)*y(k,196) + mat(k,1177) = -rxt(k,406)*y(k,196) + mat(k,1211) = -rxt(k,411)*y(k,196) + mat(k,1129) = -rxt(k,420)*y(k,196) + mat(k,1094) = -rxt(k,431)*y(k,196) + mat(k,1052) = -rxt(k,485)*y(k,196) + mat(k,1033) = -rxt(k,490)*y(k,196) + mat(k,1013) = -rxt(k,495)*y(k,196) + mat(k,949) = .280_r8*rxt(k,348)*y(k,135) + mat(k,447) = rxt(k,335)*y(k,220) + mat(k,310) = .700_r8*rxt(k,303)*y(k,220) + mat(k,790) = .050_r8*rxt(k,425)*y(k,135) + mat(k,1129) = mat(k,1129) + rxt(k,419)*y(k,195) + mat(k,1505) = mat(k,1505) + rxt(k,334)*y(k,195) + .830_r8*rxt(k,451)*y(k,197) & + + .170_r8*rxt(k,457)*y(k,209) + mat(k,1776) = .280_r8*rxt(k,348)*y(k,29) + .050_r8*rxt(k,425)*y(k,98) + mat(k,1303) = mat(k,1303) + rxt(k,419)*y(k,101) + rxt(k,334)*y(k,124) & + + 4.000_r8*rxt(k,331)*y(k,195) + .900_r8*rxt(k,332)*y(k,196) & + + .450_r8*rxt(k,333)*y(k,202) + rxt(k,405)*y(k,204) + rxt(k,410) & + *y(k,205) + rxt(k,372)*y(k,206) + rxt(k,381)*y(k,208) & + + rxt(k,430)*y(k,228) + mat(k,1396) = mat(k,1396) + .900_r8*rxt(k,332)*y(k,195) + mat(k,648) = .830_r8*rxt(k,451)*y(k,124) + .330_r8*rxt(k,450)*y(k,202) + mat(k,2101) = mat(k,2101) + .450_r8*rxt(k,333)*y(k,195) + .330_r8*rxt(k,450) & + *y(k,197) + .070_r8*rxt(k,456)*y(k,209) + mat(k,1177) = mat(k,1177) + rxt(k,405)*y(k,195) + mat(k,1211) = mat(k,1211) + rxt(k,410)*y(k,195) + mat(k,1234) = mat(k,1234) + rxt(k,372)*y(k,195) + mat(k,1273) = mat(k,1273) + rxt(k,381)*y(k,195) + mat(k,806) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,202) + mat(k,1714) = rxt(k,335)*y(k,50) + .700_r8*rxt(k,303)*y(k,53) + mat(k,1094) = mat(k,1094) + rxt(k,430)*y(k,195) + end do + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,645) = -(rxt(k,450)*y(k,202) + rxt(k,451)*y(k,124) + rxt(k,452) & + *y(k,125)) + mat(k,2064) = -rxt(k,450)*y(k,197) + mat(k,1467) = -rxt(k,451)*y(k,197) + mat(k,1967) = -rxt(k,452)*y(k,197) + mat(k,701) = -(rxt(k,565)*y(k,213) + rxt(k,566)*y(k,219) + rxt(k,567) & + *y(k,212)) + mat(k,691) = -rxt(k,565)*y(k,198) + mat(k,683) = -rxt(k,566)*y(k,198) + mat(k,570) = -rxt(k,567)*y(k,198) + mat(k,458) = -((rxt(k,369) + rxt(k,370)) * y(k,124)) + mat(k,1457) = -(rxt(k,369) + rxt(k,370)) * y(k,199) + mat(k,260) = rxt(k,368)*y(k,220) + mat(k,1648) = rxt(k,368)*y(k,16) + mat(k,345) = -(rxt(k,340)*y(k,134)) + mat(k,1412) = -rxt(k,340)*y(k,200) + mat(k,1450) = .750_r8*rxt(k,338)*y(k,201) + mat(k,663) = .750_r8*rxt(k,338)*y(k,124) + mat(k,664) = -(rxt(k,337)*y(k,202) + rxt(k,338)*y(k,124)) + mat(k,2066) = -rxt(k,337)*y(k,201) + mat(k,1468) = -rxt(k,338)*y(k,201) + mat(k,451) = rxt(k,344)*y(k,220) + mat(k,1667) = rxt(k,344)*y(k,25) + mat(k,2115) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + rxt(k,176) & + *y(k,133) + rxt(k,177)*y(k,135) + rxt(k,181)*y(k,220) & + + 4._r8*rxt(k,186)*y(k,202) + rxt(k,198)*y(k,126) + rxt(k,203) & + *y(k,124) + rxt(k,208)*y(k,125) + (rxt(k,218) + rxt(k,219) & + ) * y(k,56) + rxt(k,225)*y(k,59) + rxt(k,251)*y(k,17) + rxt(k,257) & + *y(k,19) + rxt(k,294)*y(k,42) + rxt(k,300)*y(k,196) + rxt(k,308) & + *y(k,203) + rxt(k,322)*y(k,192) + rxt(k,333)*y(k,195) + rxt(k,337) & + *y(k,201) + rxt(k,350)*y(k,193) + rxt(k,358)*y(k,223) + rxt(k,362) & + *y(k,224) + rxt(k,374)*y(k,206) + rxt(k,383)*y(k,208) + rxt(k,387) & + *y(k,210) + rxt(k,397)*y(k,189) + rxt(k,407)*y(k,204) + rxt(k,412) & + *y(k,205) + rxt(k,421)*y(k,101) + rxt(k,432)*y(k,228) + rxt(k,436) & + *y(k,188) + rxt(k,439)*y(k,190) + rxt(k,443)*y(k,191) + rxt(k,446) & + *y(k,194) + rxt(k,450)*y(k,197) + rxt(k,453)*y(k,207) + rxt(k,456) & + *y(k,209) + rxt(k,459)*y(k,222) + rxt(k,466)*y(k,227) + rxt(k,472) & + *y(k,229) + rxt(k,475)*y(k,230) + rxt(k,486)*y(k,215) + rxt(k,491) & + *y(k,225) + rxt(k,496)*y(k,226)) + mat(k,1932) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,202) + mat(k,1831) = -rxt(k,176)*y(k,202) + mat(k,1790) = -rxt(k,177)*y(k,202) + mat(k,1728) = -rxt(k,181)*y(k,202) + mat(k,1912) = -rxt(k,198)*y(k,202) + mat(k,1519) = -rxt(k,203)*y(k,202) + mat(k,1996) = -rxt(k,208)*y(k,202) + mat(k,1554) = -(rxt(k,218) + rxt(k,219)) * y(k,202) + mat(k,2142) = -rxt(k,225)*y(k,202) + mat(k,1361) = -rxt(k,251)*y(k,202) + mat(k,2020) = -rxt(k,257)*y(k,202) + mat(k,1855) = -rxt(k,294)*y(k,202) + mat(k,1407) = -rxt(k,300)*y(k,202) + mat(k,334) = -rxt(k,308)*y(k,202) + mat(k,848) = -rxt(k,322)*y(k,202) + mat(k,1313) = -rxt(k,333)*y(k,202) + mat(k,671) = -rxt(k,337)*y(k,202) + mat(k,737) = -rxt(k,350)*y(k,202) + mat(k,725) = -rxt(k,358)*y(k,202) + mat(k,1073) = -rxt(k,362)*y(k,202) + mat(k,1242) = -rxt(k,374)*y(k,202) + mat(k,1282) = -rxt(k,383)*y(k,202) + mat(k,564) = -rxt(k,387)*y(k,202) + mat(k,890) = -rxt(k,397)*y(k,202) + mat(k,1186) = -rxt(k,407)*y(k,202) + mat(k,1220) = -rxt(k,412)*y(k,202) + mat(k,1137) = -rxt(k,421)*y(k,202) + mat(k,1101) = -rxt(k,432)*y(k,202) + mat(k,405) = -rxt(k,436)*y(k,202) + mat(k,383) = -rxt(k,439)*y(k,202) + mat(k,328) = -rxt(k,443)*y(k,202) + mat(k,534) = -rxt(k,446)*y(k,202) + mat(k,652) = -rxt(k,450)*y(k,202) + mat(k,612) = -rxt(k,453)*y(k,202) + mat(k,810) = -rxt(k,456)*y(k,202) + mat(k,341) = -rxt(k,459)*y(k,202) + mat(k,627) = -rxt(k,466)*y(k,202) + mat(k,644) = -rxt(k,472)*y(k,202) + mat(k,398) = -rxt(k,475)*y(k,202) + mat(k,1060) = -rxt(k,486)*y(k,202) + mat(k,1040) = -rxt(k,491)*y(k,202) + mat(k,1021) = -rxt(k,496)*y(k,202) + mat(k,873) = .570_r8*rxt(k,480)*y(k,135) + mat(k,91) = .650_r8*rxt(k,438)*y(k,220) + mat(k,1361) = mat(k,1361) + rxt(k,250)*y(k,42) + mat(k,2020) = mat(k,2020) + rxt(k,262)*y(k,220) + mat(k,205) = .350_r8*rxt(k,317)*y(k,220) + mat(k,457) = .130_r8*rxt(k,319)*y(k,135) + mat(k,180) = rxt(k,324)*y(k,220) + mat(k,957) = .280_r8*rxt(k,348)*y(k,135) + mat(k,1855) = mat(k,1855) + rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) & + + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,133) + mat(k,54) = rxt(k,330)*y(k,220) + mat(k,711) = rxt(k,302)*y(k,220) + mat(k,1554) = mat(k,1554) + rxt(k,214)*y(k,42) + rxt(k,217)*y(k,79) + mat(k,2142) = mat(k,2142) + rxt(k,221)*y(k,196) + rxt(k,232)*y(k,220) + mat(k,1000) = rxt(k,305)*y(k,220) + mat(k,125) = .730_r8*rxt(k,449)*y(k,220) + mat(k,196) = .500_r8*rxt(k,519)*y(k,220) + mat(k,964) = rxt(k,341)*y(k,220) + mat(k,801) = rxt(k,342)*y(k,220) + mat(k,1932) = mat(k,1932) + rxt(k,175)*y(k,134) + mat(k,479) = rxt(k,217)*y(k,56) + rxt(k,171)*y(k,133) + rxt(k,180)*y(k,220) + mat(k,108) = rxt(k,306)*y(k,220) + mat(k,714) = rxt(k,307)*y(k,220) + mat(k,979) = rxt(k,371)*y(k,220) + mat(k,996) = rxt(k,356)*y(k,220) + mat(k,795) = .370_r8*rxt(k,425)*y(k,135) + mat(k,513) = .300_r8*rxt(k,416)*y(k,220) + mat(k,429) = rxt(k,417)*y(k,220) + mat(k,1137) = mat(k,1137) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) & + + rxt(k,419)*y(k,195) + 1.200_r8*rxt(k,420)*y(k,196) + mat(k,302) = rxt(k,424)*y(k,220) + mat(k,1149) = .140_r8*rxt(k,378)*y(k,135) + mat(k,219) = .200_r8*rxt(k,380)*y(k,220) + mat(k,473) = .500_r8*rxt(k,391)*y(k,220) + mat(k,835) = .570_r8*rxt(k,483)*y(k,135) + mat(k,1264) = .280_r8*rxt(k,392)*y(k,135) + mat(k,272) = rxt(k,428)*y(k,220) + mat(k,938) = rxt(k,429)*y(k,220) + mat(k,1519) = mat(k,1519) + rxt(k,422)*y(k,101) + rxt(k,398)*y(k,189) & + + rxt(k,440)*y(k,190) + rxt(k,445)*y(k,191) + rxt(k,323) & + *y(k,192) + rxt(k,351)*y(k,193) + rxt(k,301)*y(k,196) & + + .170_r8*rxt(k,451)*y(k,197) + rxt(k,369)*y(k,199) & + + .250_r8*rxt(k,338)*y(k,201) + rxt(k,310)*y(k,203) & + + .920_r8*rxt(k,408)*y(k,204) + .920_r8*rxt(k,414)*y(k,205) & + + .470_r8*rxt(k,376)*y(k,206) + .400_r8*rxt(k,454)*y(k,207) & + + .830_r8*rxt(k,457)*y(k,209) + rxt(k,460)*y(k,222) + rxt(k,359) & + *y(k,223) + .900_r8*rxt(k,492)*y(k,225) + .800_r8*rxt(k,497) & + *y(k,226) + rxt(k,467)*y(k,227) + rxt(k,433)*y(k,228) & + + rxt(k,473)*y(k,229) + rxt(k,476)*y(k,230) + mat(k,1912) = mat(k,1912) + rxt(k,295)*y(k,42) + rxt(k,423)*y(k,101) & + + rxt(k,409)*y(k,204) + rxt(k,415)*y(k,205) + .470_r8*rxt(k,375) & + *y(k,206) + rxt(k,201)*y(k,220) + rxt(k,434)*y(k,228) + mat(k,1831) = mat(k,1831) + rxt(k,296)*y(k,42) + rxt(k,171)*y(k,79) + mat(k,1438) = rxt(k,175)*y(k,76) + rxt(k,340)*y(k,200) + mat(k,1790) = mat(k,1790) + .570_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,319) & + *y(k,25) + .280_r8*rxt(k,348)*y(k,29) + .370_r8*rxt(k,425) & + *y(k,98) + .140_r8*rxt(k,378)*y(k,105) + .570_r8*rxt(k,483) & + *y(k,110) + .280_r8*rxt(k,392)*y(k,111) + rxt(k,183)*y(k,220) + mat(k,100) = .800_r8*rxt(k,461)*y(k,220) + mat(k,896) = rxt(k,514)*y(k,220) + mat(k,989) = .200_r8*rxt(k,501)*y(k,220) + mat(k,120) = .280_r8*rxt(k,469)*y(k,220) + mat(k,146) = .380_r8*rxt(k,471)*y(k,220) + mat(k,151) = .630_r8*rxt(k,477)*y(k,220) + mat(k,890) = mat(k,890) + rxt(k,398)*y(k,124) + mat(k,383) = mat(k,383) + rxt(k,440)*y(k,124) + mat(k,328) = mat(k,328) + rxt(k,445)*y(k,124) + mat(k,848) = mat(k,848) + rxt(k,323)*y(k,124) + 2.400_r8*rxt(k,320)*y(k,192) & + + rxt(k,321)*y(k,196) + mat(k,737) = mat(k,737) + rxt(k,351)*y(k,124) + rxt(k,349)*y(k,196) + mat(k,1313) = mat(k,1313) + rxt(k,419)*y(k,101) + .900_r8*rxt(k,332)*y(k,196) & + + rxt(k,405)*y(k,204) + rxt(k,410)*y(k,205) + .470_r8*rxt(k,372) & + *y(k,206) + rxt(k,430)*y(k,228) + mat(k,1407) = mat(k,1407) + rxt(k,221)*y(k,59) + 1.200_r8*rxt(k,420)*y(k,101) & + + rxt(k,301)*y(k,124) + rxt(k,321)*y(k,192) + rxt(k,349) & + *y(k,193) + .900_r8*rxt(k,332)*y(k,195) + 4.000_r8*rxt(k,298) & + *y(k,196) + rxt(k,406)*y(k,204) + rxt(k,411)*y(k,205) & + + .730_r8*rxt(k,373)*y(k,206) + rxt(k,382)*y(k,208) & + + .500_r8*rxt(k,485)*y(k,215) + .300_r8*rxt(k,361)*y(k,224) & + + rxt(k,490)*y(k,225) + rxt(k,495)*y(k,226) + .800_r8*rxt(k,431) & + *y(k,228) + mat(k,652) = mat(k,652) + .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450) & + *y(k,202) + mat(k,465) = rxt(k,369)*y(k,124) + mat(k,349) = rxt(k,340)*y(k,134) + mat(k,671) = mat(k,671) + .250_r8*rxt(k,338)*y(k,124) + mat(k,2115) = mat(k,2115) + .070_r8*rxt(k,450)*y(k,197) + .160_r8*rxt(k,453) & + *y(k,207) + .330_r8*rxt(k,456)*y(k,209) + mat(k,334) = mat(k,334) + rxt(k,310)*y(k,124) + mat(k,1186) = mat(k,1186) + .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) & + + rxt(k,405)*y(k,195) + rxt(k,406)*y(k,196) + mat(k,1220) = mat(k,1220) + .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,195) + rxt(k,411)*y(k,196) + mat(k,1242) = mat(k,1242) + .470_r8*rxt(k,376)*y(k,124) + .470_r8*rxt(k,375) & + *y(k,126) + .470_r8*rxt(k,372)*y(k,195) + .730_r8*rxt(k,373) & + *y(k,196) + mat(k,612) = mat(k,612) + .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453) & + *y(k,202) + mat(k,1282) = mat(k,1282) + rxt(k,382)*y(k,196) + mat(k,810) = mat(k,810) + .830_r8*rxt(k,457)*y(k,124) + .330_r8*rxt(k,456) & + *y(k,202) + mat(k,1060) = mat(k,1060) + .500_r8*rxt(k,485)*y(k,196) + mat(k,1728) = mat(k,1728) + .650_r8*rxt(k,438)*y(k,7) + rxt(k,262)*y(k,19) & + + .350_r8*rxt(k,317)*y(k,24) + rxt(k,324)*y(k,26) + rxt(k,330) & + *y(k,47) + rxt(k,302)*y(k,52) + rxt(k,232)*y(k,59) + rxt(k,305) & + *y(k,62) + .730_r8*rxt(k,449)*y(k,66) + .500_r8*rxt(k,519) & + *y(k,67) + rxt(k,341)*y(k,74) + rxt(k,342)*y(k,75) + rxt(k,180) & + *y(k,79) + rxt(k,306)*y(k,86) + rxt(k,307)*y(k,87) + rxt(k,371) & + *y(k,93) + rxt(k,356)*y(k,95) + .300_r8*rxt(k,416)*y(k,99) & + + rxt(k,417)*y(k,100) + rxt(k,424)*y(k,102) + .200_r8*rxt(k,380) & + *y(k,106) + .500_r8*rxt(k,391)*y(k,109) + rxt(k,428)*y(k,115) & + + rxt(k,429)*y(k,116) + rxt(k,201)*y(k,126) + rxt(k,183) & + *y(k,135) + .800_r8*rxt(k,461)*y(k,142) + rxt(k,514)*y(k,151) & + + .200_r8*rxt(k,501)*y(k,178) + .280_r8*rxt(k,469)*y(k,180) & + + .380_r8*rxt(k,471)*y(k,182) + .630_r8*rxt(k,477)*y(k,184) + mat(k,341) = mat(k,341) + rxt(k,460)*y(k,124) + mat(k,725) = mat(k,725) + rxt(k,359)*y(k,124) + mat(k,1073) = mat(k,1073) + .300_r8*rxt(k,361)*y(k,196) + mat(k,1040) = mat(k,1040) + .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,196) + mat(k,1021) = mat(k,1021) + .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,196) + mat(k,627) = mat(k,627) + rxt(k,467)*y(k,124) + mat(k,1101) = mat(k,1101) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) & + + rxt(k,430)*y(k,195) + .800_r8*rxt(k,431)*y(k,196) + mat(k,644) = mat(k,644) + rxt(k,473)*y(k,124) + mat(k,398) = mat(k,398) + rxt(k,476)*y(k,124) + end do + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,329) = -(rxt(k,308)*y(k,202) + rxt(k,310)*y(k,124)) + mat(k,2039) = -rxt(k,308)*y(k,203) + mat(k,1447) = -rxt(k,310)*y(k,203) + mat(k,1834) = rxt(k,294)*y(k,202) + mat(k,2039) = mat(k,2039) + rxt(k,294)*y(k,42) + mat(k,1172) = -(rxt(k,405)*y(k,195) + rxt(k,406)*y(k,196) + rxt(k,407) & + *y(k,202) + rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126)) + mat(k,1297) = -rxt(k,405)*y(k,204) + mat(k,1390) = -rxt(k,406)*y(k,204) + mat(k,2093) = -rxt(k,407)*y(k,204) + mat(k,1498) = -rxt(k,408)*y(k,204) + mat(k,1890) = -rxt(k,409)*y(k,204) + mat(k,786) = .600_r8*rxt(k,426)*y(k,220) + mat(k,1705) = .600_r8*rxt(k,426)*y(k,98) + mat(k,1206) = -(rxt(k,410)*y(k,195) + rxt(k,411)*y(k,196) + rxt(k,412) & + *y(k,202) + rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126)) + mat(k,1298) = -rxt(k,410)*y(k,205) + mat(k,1391) = -rxt(k,411)*y(k,205) + mat(k,2094) = -rxt(k,412)*y(k,205) + mat(k,1499) = -rxt(k,414)*y(k,205) + mat(k,1891) = -rxt(k,415)*y(k,205) + mat(k,787) = .400_r8*rxt(k,426)*y(k,220) + mat(k,1706) = .400_r8*rxt(k,426)*y(k,98) + mat(k,1231) = -(rxt(k,372)*y(k,195) + rxt(k,373)*y(k,196) + rxt(k,374) & + *y(k,202) + rxt(k,375)*y(k,126) + (rxt(k,376) + rxt(k,377) & + ) * y(k,124)) + mat(k,1299) = -rxt(k,372)*y(k,206) + mat(k,1392) = -rxt(k,373)*y(k,206) + mat(k,2095) = -rxt(k,374)*y(k,206) + mat(k,1892) = -rxt(k,375)*y(k,206) + mat(k,1500) = -(rxt(k,376) + rxt(k,377)) * y(k,206) + mat(k,1142) = .500_r8*rxt(k,379)*y(k,220) + mat(k,216) = .200_r8*rxt(k,380)*y(k,220) + mat(k,1250) = rxt(k,393)*y(k,220) + mat(k,1707) = .500_r8*rxt(k,379)*y(k,105) + .200_r8*rxt(k,380)*y(k,106) & + + rxt(k,393)*y(k,111) + mat(k,607) = -(rxt(k,453)*y(k,202) + rxt(k,454)*y(k,124) + rxt(k,455) & + *y(k,125)) + mat(k,2061) = -rxt(k,453)*y(k,207) + mat(k,1464) = -rxt(k,454)*y(k,207) + mat(k,1966) = -rxt(k,455)*y(k,207) + mat(k,1271) = -(rxt(k,381)*y(k,195) + rxt(k,382)*y(k,196) + rxt(k,383) & + *y(k,202) + 4._r8*rxt(k,384)*y(k,208) + rxt(k,385)*y(k,124) & + + rxt(k,386)*y(k,126) + rxt(k,394)*y(k,125)) + mat(k,1301) = -rxt(k,381)*y(k,208) + mat(k,1394) = -rxt(k,382)*y(k,208) + mat(k,2097) = -rxt(k,383)*y(k,208) + mat(k,1502) = -rxt(k,385)*y(k,208) + mat(k,1894) = -rxt(k,386)*y(k,208) + mat(k,1977) = -rxt(k,394)*y(k,208) + mat(k,1143) = .500_r8*rxt(k,379)*y(k,220) + mat(k,217) = .500_r8*rxt(k,380)*y(k,220) + mat(k,1709) = .500_r8*rxt(k,379)*y(k,105) + .500_r8*rxt(k,380)*y(k,106) + mat(k,803) = -(rxt(k,456)*y(k,202) + rxt(k,457)*y(k,124) + rxt(k,458) & + *y(k,125)) + mat(k,2074) = -rxt(k,456)*y(k,209) + mat(k,1478) = -rxt(k,457)*y(k,209) + mat(k,1971) = -rxt(k,458)*y(k,209) + mat(k,558) = -(rxt(k,387)*y(k,202) + rxt(k,388)*y(k,124)) + mat(k,2058) = -rxt(k,387)*y(k,210) + mat(k,1463) = -rxt(k,388)*y(k,210) + mat(k,418) = rxt(k,389)*y(k,220) + mat(k,221) = rxt(k,390)*y(k,220) + mat(k,1659) = rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) + mat(k,412) = -(rxt(k,188)*y(k,133) + rxt(k,189)*y(k,134)) + mat(k,1797) = -rxt(k,188)*y(k,211) + mat(k,1414) = -rxt(k,189)*y(k,211) + mat(k,1797) = mat(k,1797) + rxt(k,569)*y(k,212) + mat(k,697) = .900_r8*rxt(k,567)*y(k,212) + .800_r8*rxt(k,565)*y(k,213) + mat(k,565) = rxt(k,569)*y(k,133) + .900_r8*rxt(k,567)*y(k,198) + mat(k,689) = .800_r8*rxt(k,565)*y(k,198) + mat(k,567) = -(rxt(k,567)*y(k,198) + rxt(k,568)*y(k,134) + (rxt(k,569) & + + rxt(k,570)) * y(k,133)) + mat(k,698) = -rxt(k,567)*y(k,212) + mat(k,1416) = -rxt(k,568)*y(k,212) + mat(k,1801) = -(rxt(k,569) + rxt(k,570)) * y(k,212) + mat(k,690) = -(rxt(k,565)*y(k,198)) + mat(k,700) = -rxt(k,565)*y(k,213) + mat(k,742) = rxt(k,574)*y(k,219) + mat(k,1470) = rxt(k,576)*y(k,219) + mat(k,1805) = rxt(k,569)*y(k,212) + mat(k,1419) = rxt(k,573)*y(k,214) + mat(k,569) = rxt(k,569)*y(k,133) + mat(k,387) = rxt(k,573)*y(k,134) + mat(k,682) = rxt(k,574)*y(k,112) + rxt(k,576)*y(k,124) + mat(k,384) = -(rxt(k,571)*y(k,133) + (rxt(k,572) + rxt(k,573)) * y(k,134)) + mat(k,1796) = -rxt(k,571)*y(k,214) + mat(k,1413) = -(rxt(k,572) + rxt(k,573)) * y(k,214) + mat(k,1049) = -(rxt(k,485)*y(k,196) + rxt(k,486)*y(k,202) + rxt(k,487) & + *y(k,124) + rxt(k,488)*y(k,126)) + mat(k,1383) = -rxt(k,485)*y(k,215) + mat(k,2085) = -rxt(k,486)*y(k,215) + mat(k,1491) = -rxt(k,487)*y(k,215) + mat(k,1883) = -rxt(k,488)*y(k,215) + mat(k,865) = rxt(k,479)*y(k,126) + mat(k,827) = rxt(k,482)*y(k,126) + mat(k,1883) = mat(k,1883) + rxt(k,479)*y(k,6) + rxt(k,482)*y(k,110) & + + .500_r8*rxt(k,499)*y(k,177) + mat(k,287) = rxt(k,489)*y(k,220) + mat(k,920) = .500_r8*rxt(k,499)*y(k,126) + mat(k,1697) = rxt(k,489)*y(k,128) + mat(k,1570) = -(rxt(k,153)*y(k,77) + rxt(k,154)*y(k,231) + (rxt(k,156) & + + rxt(k,157)) * y(k,134) + rxt(k,158)*y(k,135) + (rxt(k,246) & + + rxt(k,247)) * y(k,85) + (rxt(k,269) + rxt(k,270)) * y(k,81) & + + rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) + rxt(k,314)*y(k,86)) + mat(k,1108) = -rxt(k,153)*y(k,216) + mat(k,2158) = -rxt(k,154)*y(k,216) + mat(k,1430) = -(rxt(k,156) + rxt(k,157)) * y(k,216) + mat(k,1780) = -rxt(k,158)*y(k,216) + mat(k,1340) = -(rxt(k,246) + rxt(k,247)) * y(k,216) + mat(k,755) = -(rxt(k,269) + rxt(k,270)) * y(k,216) + mat(k,61) = -rxt(k,275)*y(k,216) + mat(k,104) = -rxt(k,276)*y(k,216) + mat(k,106) = -rxt(k,314)*y(k,216) + mat(k,1430) = mat(k,1430) + rxt(k,189)*y(k,211) + mat(k,706) = .850_r8*rxt(k,566)*y(k,219) + mat(k,416) = rxt(k,189)*y(k,134) + mat(k,687) = .850_r8*rxt(k,566)*y(k,198) + mat(k,74) = -(rxt(k,160)*y(k,133) + rxt(k,161)*y(k,134)) + mat(k,1793) = -rxt(k,160)*y(k,217) + mat(k,1410) = -rxt(k,161)*y(k,217) + mat(k,1793) = mat(k,1793) + rxt(k,164)*y(k,218) + mat(k,1410) = mat(k,1410) + rxt(k,165)*y(k,218) + mat(k,1736) = rxt(k,166)*y(k,218) + mat(k,76) = rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) + rxt(k,166)*y(k,135) + mat(k,77) = -(rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) + rxt(k,166)*y(k,135)) + mat(k,1794) = -rxt(k,164)*y(k,218) + mat(k,1411) = -rxt(k,165)*y(k,218) + mat(k,1737) = -rxt(k,166)*y(k,218) + mat(k,1411) = mat(k,1411) + rxt(k,156)*y(k,216) + mat(k,1558) = rxt(k,156)*y(k,134) + mat(k,681) = -(rxt(k,566)*y(k,198) + rxt(k,574)*y(k,112) + rxt(k,576) & + *y(k,124)) + mat(k,699) = -rxt(k,566)*y(k,219) + mat(k,741) = -rxt(k,574)*y(k,219) + mat(k,1469) = -rxt(k,576)*y(k,219) + mat(k,1418) = rxt(k,568)*y(k,212) + rxt(k,572)*y(k,214) + rxt(k,579)*y(k,221) + mat(k,568) = rxt(k,568)*y(k,134) + mat(k,386) = rxt(k,572)*y(k,134) + mat(k,515) = rxt(k,579)*y(k,134) + mat(k,1719) = -(rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,181)*y(k,202) & + + rxt(k,182)*y(k,133) + rxt(k,183)*y(k,135) + (4._r8*rxt(k,184) & + + 4._r8*rxt(k,185)) * y(k,220) + rxt(k,187)*y(k,90) + rxt(k,201) & + *y(k,126) + rxt(k,202)*y(k,112) + rxt(k,210)*y(k,125) + rxt(k,211) & + *y(k,89) + rxt(k,230)*y(k,60) + (rxt(k,232) + rxt(k,233) & + ) * y(k,59) + rxt(k,235)*y(k,85) + rxt(k,238)*y(k,92) + rxt(k,262) & + *y(k,19) + rxt(k,264)*y(k,81) + rxt(k,297)*y(k,42) + rxt(k,302) & + *y(k,52) + rxt(k,303)*y(k,53) + (rxt(k,305) + rxt(k,315) & + ) * y(k,62) + rxt(k,306)*y(k,86) + rxt(k,307)*y(k,87) + rxt(k,317) & + *y(k,24) + rxt(k,324)*y(k,26) + rxt(k,325)*y(k,27) + rxt(k,327) & + *y(k,28) + rxt(k,329)*y(k,45) + rxt(k,330)*y(k,47) + rxt(k,335) & + *y(k,50) + rxt(k,336)*y(k,51) + rxt(k,341)*y(k,74) + rxt(k,342) & + *y(k,75) + rxt(k,343)*y(k,139) + rxt(k,344)*y(k,25) + rxt(k,352) & + *y(k,30) + rxt(k,353)*y(k,31) + rxt(k,355)*y(k,49) + rxt(k,356) & + *y(k,95) + rxt(k,357)*y(k,127) + rxt(k,360)*y(k,146) + rxt(k,364) & + *y(k,147) + rxt(k,365)*y(k,29) + rxt(k,366)*y(k,48) + rxt(k,368) & + *y(k,16) + rxt(k,371)*y(k,93) + rxt(k,379)*y(k,105) + rxt(k,380) & + *y(k,106) + rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) + rxt(k,391) & + *y(k,109) + rxt(k,393)*y(k,111) + rxt(k,396)*y(k,1) + rxt(k,400) & + *y(k,2) + rxt(k,401)*y(k,15) + rxt(k,402)*y(k,94) + rxt(k,403) & + *y(k,96) + rxt(k,404)*y(k,97) + rxt(k,416)*y(k,99) + rxt(k,417) & + *y(k,100) + rxt(k,424)*y(k,102) + rxt(k,426)*y(k,98) + rxt(k,427) & + *y(k,103) + rxt(k,428)*y(k,115) + rxt(k,429)*y(k,116) + rxt(k,435) & + *y(k,181) + rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) + rxt(k,442) & + *y(k,22) + rxt(k,444)*y(k,23) + rxt(k,448)*y(k,32) + rxt(k,449) & + *y(k,66) + rxt(k,461)*y(k,142) + rxt(k,464)*y(k,143) + rxt(k,468) & + *y(k,179) + rxt(k,469)*y(k,180) + rxt(k,471)*y(k,182) + rxt(k,474) & + *y(k,183) + rxt(k,477)*y(k,184) + rxt(k,478)*y(k,185) + rxt(k,481) & + *y(k,6) + rxt(k,484)*y(k,110) + rxt(k,489)*y(k,128) + rxt(k,493) & + *y(k,174) + rxt(k,494)*y(k,175) + rxt(k,498)*y(k,176) + rxt(k,500) & + *y(k,177) + rxt(k,501)*y(k,178) + rxt(k,503)*y(k,137) + rxt(k,508) & + *y(k,148) + rxt(k,513)*y(k,150) + rxt(k,514)*y(k,151) + (rxt(k,517) & + + rxt(k,519)) * y(k,67) + rxt(k,518)*y(k,120)) + mat(k,1109) = -rxt(k,179)*y(k,220) + mat(k,477) = -rxt(k,180)*y(k,220) + mat(k,2106) = -rxt(k,181)*y(k,220) + mat(k,1822) = -rxt(k,182)*y(k,220) + mat(k,1781) = -rxt(k,183)*y(k,220) + mat(k,363) = -rxt(k,187)*y(k,220) + mat(k,1903) = -rxt(k,201)*y(k,220) + mat(k,749) = -rxt(k,202)*y(k,220) + mat(k,1987) = -rxt(k,210)*y(k,220) + mat(k,1945) = -rxt(k,211)*y(k,220) + mat(k,909) = -rxt(k,230)*y(k,220) + mat(k,2133) = -(rxt(k,232) + rxt(k,233)) * y(k,220) + mat(k,1341) = -rxt(k,235)*y(k,220) + mat(k,765) = -rxt(k,238)*y(k,220) + mat(k,2011) = -rxt(k,262)*y(k,220) + mat(k,756) = -rxt(k,264)*y(k,220) + mat(k,1846) = -rxt(k,297)*y(k,220) + mat(k,709) = -rxt(k,302)*y(k,220) + mat(k,311) = -rxt(k,303)*y(k,220) + mat(k,998) = -(rxt(k,305) + rxt(k,315)) * y(k,220) + mat(k,107) = -rxt(k,306)*y(k,220) + mat(k,713) = -rxt(k,307)*y(k,220) + mat(k,204) = -rxt(k,317)*y(k,220) + mat(k,179) = -rxt(k,324)*y(k,220) + mat(k,249) = -rxt(k,325)*y(k,220) + mat(k,210) = -rxt(k,327)*y(k,220) + mat(k,1079) = -rxt(k,329)*y(k,220) + mat(k,53) = -rxt(k,330)*y(k,220) + mat(k,448) = -rxt(k,335)*y(k,220) + mat(k,409) = -rxt(k,336)*y(k,220) + mat(k,962) = -rxt(k,341)*y(k,220) + mat(k,800) = -rxt(k,342)*y(k,220) + mat(k,353) = -rxt(k,343)*y(k,220) + mat(k,454) = -rxt(k,344)*y(k,220) + mat(k,306) = -rxt(k,352)*y(k,220) + mat(k,57) = -rxt(k,353)*y(k,220) + mat(k,1154) = -rxt(k,355)*y(k,220) + mat(k,994) = -rxt(k,356)*y(k,220) + mat(k,772) = -rxt(k,357)*y(k,220) + mat(k,434) = -rxt(k,360)*y(k,220) + mat(k,294) = -rxt(k,364)*y(k,220) + mat(k,952) = -rxt(k,365)*y(k,220) + mat(k,902) = -rxt(k,366)*y(k,220) + mat(k,263) = -rxt(k,368)*y(k,220) + mat(k,975) = -rxt(k,371)*y(k,220) + mat(k,1145) = -rxt(k,379)*y(k,220) + mat(k,218) = -rxt(k,380)*y(k,220) + mat(k,421) = -rxt(k,389)*y(k,220) + mat(k,224) = -rxt(k,390)*y(k,220) + mat(k,469) = -rxt(k,391)*y(k,220) + mat(k,1257) = -rxt(k,393)*y(k,220) + mat(k,542) = -rxt(k,396)*y(k,220) + mat(k,554) = -rxt(k,400)*y(k,220) + mat(k,165) = -rxt(k,401)*y(k,220) + mat(k,158) = -rxt(k,402)*y(k,220) + mat(k,214) = -rxt(k,403)*y(k,220) + mat(k,70) = -rxt(k,404)*y(k,220) + mat(k,509) = -rxt(k,416)*y(k,220) + mat(k,427) = -rxt(k,417)*y(k,220) + mat(k,300) = -rxt(k,424)*y(k,220) + mat(k,791) = -rxt(k,426)*y(k,220) + mat(k,582) = -rxt(k,427)*y(k,220) + mat(k,270) = -rxt(k,428)*y(k,220) + mat(k,934) = -rxt(k,429)*y(k,220) + mat(k,132) = -rxt(k,435)*y(k,220) + mat(k,90) = -rxt(k,438)*y(k,220) + mat(k,277) = -rxt(k,441)*y(k,220) + mat(k,171) = -rxt(k,442)*y(k,220) + mat(k,244) = -rxt(k,444)*y(k,220) + mat(k,184) = -rxt(k,448)*y(k,220) + mat(k,124) = -rxt(k,449)*y(k,220) + mat(k,99) = -rxt(k,461)*y(k,220) + mat(k,238) = -rxt(k,464)*y(k,220) + mat(k,499) = -rxt(k,468)*y(k,220) + mat(k,119) = -rxt(k,469)*y(k,220) + mat(k,145) = -rxt(k,471)*y(k,220) + mat(k,598) = -rxt(k,474)*y(k,220) + mat(k,150) = -rxt(k,477)*y(k,220) + mat(k,319) = -rxt(k,478)*y(k,220) + mat(k,869) = -rxt(k,481)*y(k,220) + mat(k,831) = -rxt(k,484)*y(k,220) + mat(k,288) = -rxt(k,489)*y(k,220) + mat(k,487) = -rxt(k,493)*y(k,220) + mat(k,523) = -rxt(k,494)*y(k,220) + mat(k,372) = -rxt(k,498)*y(k,220) + mat(k,921) = -rxt(k,500)*y(k,220) + mat(k,987) = -rxt(k,501)*y(k,220) + mat(k,256) = -rxt(k,503)*y(k,220) + mat(k,603) = -rxt(k,508)*y(k,220) + mat(k,1323) = -rxt(k,513)*y(k,220) + mat(k,894) = -rxt(k,514)*y(k,220) + mat(k,193) = -(rxt(k,517) + rxt(k,519)) * y(k,220) + mat(k,50) = -rxt(k,518)*y(k,220) + mat(k,869) = mat(k,869) + .630_r8*rxt(k,480)*y(k,135) + mat(k,204) = mat(k,204) + .650_r8*rxt(k,317)*y(k,220) + mat(k,454) = mat(k,454) + .130_r8*rxt(k,319)*y(k,135) + mat(k,249) = mat(k,249) + .500_r8*rxt(k,325)*y(k,220) + mat(k,952) = mat(k,952) + .360_r8*rxt(k,348)*y(k,135) + mat(k,1846) = mat(k,1846) + rxt(k,296)*y(k,133) + mat(k,311) = mat(k,311) + .300_r8*rxt(k,303)*y(k,220) + mat(k,1545) = rxt(k,219)*y(k,202) + mat(k,676) = rxt(k,273)*y(k,231) + mat(k,1923) = rxt(k,178)*y(k,135) + 2.000_r8*rxt(k,173)*y(k,202) + mat(k,1109) = mat(k,1109) + rxt(k,170)*y(k,133) + rxt(k,153)*y(k,216) + mat(k,477) = mat(k,477) + rxt(k,171)*y(k,133) + mat(k,756) = mat(k,756) + rxt(k,263)*y(k,133) + rxt(k,269)*y(k,216) + mat(k,1341) = mat(k,1341) + rxt(k,234)*y(k,133) + rxt(k,246)*y(k,216) + mat(k,107) = mat(k,107) + rxt(k,314)*y(k,216) + mat(k,658) = rxt(k,265)*y(k,133) + mat(k,765) = mat(k,765) + rxt(k,237)*y(k,133) + mat(k,791) = mat(k,791) + .320_r8*rxt(k,425)*y(k,135) + mat(k,582) = mat(k,582) + .600_r8*rxt(k,427)*y(k,220) + mat(k,1145) = mat(k,1145) + .240_r8*rxt(k,378)*y(k,135) + mat(k,218) = mat(k,218) + .100_r8*rxt(k,380)*y(k,220) + mat(k,831) = mat(k,831) + .630_r8*rxt(k,483)*y(k,135) + mat(k,1257) = mat(k,1257) + .360_r8*rxt(k,392)*y(k,135) + mat(k,1510) = rxt(k,203)*y(k,202) + mat(k,1903) = mat(k,1903) + rxt(k,198)*y(k,202) + mat(k,1822) = mat(k,1822) + rxt(k,296)*y(k,42) + rxt(k,170)*y(k,77) & + + rxt(k,171)*y(k,79) + rxt(k,263)*y(k,81) + rxt(k,234)*y(k,85) & + + rxt(k,265)*y(k,91) + rxt(k,237)*y(k,92) + rxt(k,176)*y(k,202) + mat(k,1781) = mat(k,1781) + .630_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,319) & + *y(k,25) + .360_r8*rxt(k,348)*y(k,29) + rxt(k,178)*y(k,76) & + + .320_r8*rxt(k,425)*y(k,98) + .240_r8*rxt(k,378)*y(k,105) & + + .630_r8*rxt(k,483)*y(k,110) + .360_r8*rxt(k,392)*y(k,111) & + + rxt(k,177)*y(k,202) + mat(k,434) = mat(k,434) + .500_r8*rxt(k,360)*y(k,220) + mat(k,132) = mat(k,132) + .500_r8*rxt(k,435)*y(k,220) + mat(k,403) = .400_r8*rxt(k,436)*y(k,202) + mat(k,1306) = .450_r8*rxt(k,333)*y(k,202) + mat(k,650) = .400_r8*rxt(k,450)*y(k,202) + mat(k,2106) = mat(k,2106) + rxt(k,219)*y(k,56) + 2.000_r8*rxt(k,173)*y(k,76) & + + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + rxt(k,176) & + *y(k,133) + rxt(k,177)*y(k,135) + .400_r8*rxt(k,436)*y(k,188) & + + .450_r8*rxt(k,333)*y(k,195) + .400_r8*rxt(k,450)*y(k,197) & + + .450_r8*rxt(k,383)*y(k,208) + .400_r8*rxt(k,456)*y(k,209) & + + .200_r8*rxt(k,387)*y(k,210) + .150_r8*rxt(k,362)*y(k,224) + mat(k,1275) = .450_r8*rxt(k,383)*y(k,202) + mat(k,808) = .400_r8*rxt(k,456)*y(k,202) + mat(k,562) = .200_r8*rxt(k,387)*y(k,202) + mat(k,1571) = rxt(k,153)*y(k,77) + rxt(k,269)*y(k,81) + rxt(k,246)*y(k,85) & + + rxt(k,314)*y(k,86) + 2.000_r8*rxt(k,154)*y(k,231) + mat(k,1719) = mat(k,1719) + .650_r8*rxt(k,317)*y(k,24) + .500_r8*rxt(k,325) & + *y(k,27) + .300_r8*rxt(k,303)*y(k,53) + .600_r8*rxt(k,427) & + *y(k,103) + .100_r8*rxt(k,380)*y(k,106) + .500_r8*rxt(k,360) & + *y(k,146) + .500_r8*rxt(k,435)*y(k,181) + mat(k,1070) = .150_r8*rxt(k,362)*y(k,202) + mat(k,2159) = rxt(k,273)*y(k,73) + 2.000_r8*rxt(k,154)*y(k,216) + end do + end subroutine nlnmat09 + subroutine nlnmat10( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,514) = -(rxt(k,579)*y(k,134)) + mat(k,1415) = -rxt(k,579)*y(k,221) + mat(k,1800) = rxt(k,570)*y(k,212) + rxt(k,571)*y(k,214) + mat(k,566) = rxt(k,570)*y(k,133) + mat(k,385) = rxt(k,571)*y(k,133) + mat(k,336) = -(rxt(k,459)*y(k,202) + rxt(k,460)*y(k,124)) + mat(k,2040) = -rxt(k,459)*y(k,222) + mat(k,1448) = -rxt(k,460)*y(k,222) + mat(k,122) = .200_r8*rxt(k,449)*y(k,220) + mat(k,97) = .140_r8*rxt(k,461)*y(k,220) + mat(k,236) = rxt(k,464)*y(k,220) + mat(k,1633) = .200_r8*rxt(k,449)*y(k,66) + .140_r8*rxt(k,461)*y(k,142) & + + rxt(k,464)*y(k,143) + mat(k,717) = -(rxt(k,358)*y(k,202) + rxt(k,359)*y(k,124)) + mat(k,2068) = -rxt(k,358)*y(k,223) + mat(k,1473) = -rxt(k,359)*y(k,223) + mat(k,941) = rxt(k,365)*y(k,220) + mat(k,431) = .500_r8*rxt(k,360)*y(k,220) + mat(k,1671) = rxt(k,365)*y(k,29) + .500_r8*rxt(k,360)*y(k,146) + mat(k,1065) = -(rxt(k,361)*y(k,196) + rxt(k,362)*y(k,202) + rxt(k,363) & + *y(k,124)) + mat(k,1384) = -rxt(k,361)*y(k,224) + mat(k,2086) = -rxt(k,362)*y(k,224) + mat(k,1492) = -rxt(k,363)*y(k,224) + mat(k,866) = .060_r8*rxt(k,480)*y(k,135) + mat(k,899) = rxt(k,366)*y(k,220) + mat(k,828) = .060_r8*rxt(k,483)*y(k,135) + mat(k,1763) = .060_r8*rxt(k,480)*y(k,6) + .060_r8*rxt(k,483)*y(k,110) + mat(k,292) = rxt(k,364)*y(k,220) + mat(k,984) = .150_r8*rxt(k,501)*y(k,220) + mat(k,1698) = rxt(k,366)*y(k,48) + rxt(k,364)*y(k,147) + .150_r8*rxt(k,501) & + *y(k,178) + mat(k,1030) = -(rxt(k,490)*y(k,196) + rxt(k,491)*y(k,202) + rxt(k,492) & + *y(k,124)) + mat(k,1382) = -rxt(k,490)*y(k,225) + mat(k,2084) = -rxt(k,491)*y(k,225) + mat(k,1490) = -rxt(k,492)*y(k,225) + mat(k,1882) = .500_r8*rxt(k,499)*y(k,177) + mat(k,486) = rxt(k,493)*y(k,220) + mat(k,919) = .500_r8*rxt(k,499)*y(k,126) + rxt(k,500)*y(k,220) + mat(k,1696) = rxt(k,493)*y(k,174) + rxt(k,500)*y(k,177) + mat(k,1008) = -(rxt(k,495)*y(k,196) + rxt(k,496)*y(k,202) + rxt(k,497) & + *y(k,124)) + mat(k,1381) = -rxt(k,495)*y(k,226) + mat(k,2083) = -rxt(k,496)*y(k,226) + mat(k,1489) = -rxt(k,497)*y(k,226) + mat(k,864) = rxt(k,481)*y(k,220) + mat(k,826) = rxt(k,484)*y(k,220) + mat(k,371) = rxt(k,498)*y(k,220) + mat(k,1695) = rxt(k,481)*y(k,6) + rxt(k,484)*y(k,110) + rxt(k,498)*y(k,176) + mat(k,618) = -(rxt(k,466)*y(k,202) + rxt(k,467)*y(k,124)) + mat(k,2062) = -rxt(k,466)*y(k,227) + mat(k,1465) = -rxt(k,467)*y(k,227) + mat(k,495) = rxt(k,468)*y(k,220) + mat(k,118) = .650_r8*rxt(k,469)*y(k,220) + mat(k,1664) = rxt(k,468)*y(k,179) + .650_r8*rxt(k,469)*y(k,180) + mat(k,1091) = -(rxt(k,430)*y(k,195) + rxt(k,431)*y(k,196) + rxt(k,432) & + *y(k,202) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126)) + mat(k,1293) = -rxt(k,430)*y(k,228) + mat(k,1386) = -rxt(k,431)*y(k,228) + mat(k,2088) = -rxt(k,432)*y(k,228) + mat(k,1494) = -rxt(k,433)*y(k,228) + mat(k,1886) = -rxt(k,434)*y(k,228) + mat(k,157) = rxt(k,402)*y(k,220) + mat(k,213) = rxt(k,403)*y(k,220) + mat(k,69) = rxt(k,404)*y(k,220) + mat(k,579) = .400_r8*rxt(k,427)*y(k,220) + mat(k,131) = .500_r8*rxt(k,435)*y(k,220) + mat(k,1700) = rxt(k,402)*y(k,94) + rxt(k,403)*y(k,96) + rxt(k,404)*y(k,97) & + + .400_r8*rxt(k,427)*y(k,103) + .500_r8*rxt(k,435)*y(k,181) + mat(k,634) = -(rxt(k,472)*y(k,202) + rxt(k,473)*y(k,124)) + mat(k,2063) = -rxt(k,472)*y(k,229) + mat(k,1466) = -rxt(k,473)*y(k,229) + mat(k,142) = .560_r8*rxt(k,471)*y(k,220) + mat(k,591) = rxt(k,474)*y(k,220) + mat(k,1665) = .560_r8*rxt(k,471)*y(k,182) + rxt(k,474)*y(k,183) + mat(k,392) = -(rxt(k,475)*y(k,202) + rxt(k,476)*y(k,124)) + mat(k,2047) = -rxt(k,475)*y(k,230) + mat(k,1453) = -rxt(k,476)*y(k,230) + mat(k,149) = .300_r8*rxt(k,477)*y(k,220) + mat(k,316) = rxt(k,478)*y(k,220) + mat(k,1640) = .300_r8*rxt(k,477)*y(k,184) + rxt(k,478)*y(k,185) + mat(k,2170) = -(rxt(k,154)*y(k,216) + rxt(k,273)*y(k,73) + rxt(k,515) & + *y(k,152)) + mat(k,1582) = -rxt(k,154)*y(k,231) + mat(k,680) = -rxt(k,273)*y(k,231) + mat(k,176) = -rxt(k,515)*y(k,231) + mat(k,211) = rxt(k,327)*y(k,220) + mat(k,308) = rxt(k,352)*y(k,220) + mat(k,58) = rxt(k,353)*y(k,220) + mat(k,1857) = rxt(k,297)*y(k,220) + mat(k,1084) = rxt(k,329)*y(k,220) + mat(k,903) = rxt(k,366)*y(k,220) + mat(k,1159) = rxt(k,355)*y(k,220) + mat(k,449) = rxt(k,335)*y(k,220) + mat(k,411) = rxt(k,336)*y(k,220) + mat(k,314) = rxt(k,303)*y(k,220) + mat(k,1934) = rxt(k,174)*y(k,202) + mat(k,1114) = rxt(k,179)*y(k,220) + mat(k,480) = rxt(k,180)*y(k,220) + mat(k,760) = rxt(k,264)*y(k,220) + mat(k,1349) = (rxt(k,556)+rxt(k,561))*y(k,91) + (rxt(k,549)+rxt(k,555) & + +rxt(k,560))*y(k,92) + rxt(k,235)*y(k,220) + mat(k,715) = rxt(k,307)*y(k,220) + mat(k,1956) = rxt(k,211)*y(k,220) + mat(k,367) = rxt(k,187)*y(k,220) + mat(k,661) = (rxt(k,556)+rxt(k,561))*y(k,85) + mat(k,768) = (rxt(k,549)+rxt(k,555)+rxt(k,560))*y(k,85) + rxt(k,238)*y(k,220) + mat(k,1150) = .500_r8*rxt(k,379)*y(k,220) + mat(k,51) = rxt(k,518)*y(k,220) + mat(k,437) = rxt(k,360)*y(k,220) + mat(k,296) = rxt(k,364)*y(k,220) + mat(k,2117) = rxt(k,174)*y(k,76) + rxt(k,181)*y(k,220) + mat(k,1730) = rxt(k,327)*y(k,28) + rxt(k,352)*y(k,30) + rxt(k,353)*y(k,31) & + + rxt(k,297)*y(k,42) + rxt(k,329)*y(k,45) + rxt(k,366)*y(k,48) & + + rxt(k,355)*y(k,49) + rxt(k,335)*y(k,50) + rxt(k,336)*y(k,51) & + + rxt(k,303)*y(k,53) + rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) & + + rxt(k,264)*y(k,81) + rxt(k,235)*y(k,85) + rxt(k,307)*y(k,87) & + + rxt(k,211)*y(k,89) + rxt(k,187)*y(k,90) + rxt(k,238)*y(k,92) & + + .500_r8*rxt(k,379)*y(k,105) + rxt(k,518)*y(k,120) + rxt(k,360) & + *y(k,146) + rxt(k,364)*y(k,147) + rxt(k,181)*y(k,202) & + + 2.000_r8*rxt(k,184)*y(k,220) + end do + end subroutine nlnmat10 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = lmat(k, 5) + mat(k, 6) = lmat(k, 6) + mat(k, 7) = lmat(k, 7) + mat(k, 8) = lmat(k, 8) + mat(k, 9) = lmat(k, 9) + mat(k, 10) = lmat(k, 10) + mat(k, 11) = lmat(k, 11) + mat(k, 12) = lmat(k, 12) + mat(k, 13) = lmat(k, 13) + mat(k, 14) = lmat(k, 14) + mat(k, 15) = lmat(k, 15) + mat(k, 16) = lmat(k, 16) + mat(k, 17) = lmat(k, 17) + mat(k, 18) = lmat(k, 18) + mat(k, 19) = lmat(k, 19) + mat(k, 20) = lmat(k, 20) + mat(k, 21) = lmat(k, 21) + mat(k, 22) = lmat(k, 22) + mat(k, 23) = lmat(k, 23) + mat(k, 24) = lmat(k, 24) + mat(k, 25) = lmat(k, 25) + mat(k, 26) = lmat(k, 26) + mat(k, 27) = lmat(k, 27) + mat(k, 28) = lmat(k, 28) + mat(k, 29) = lmat(k, 29) + mat(k, 30) = lmat(k, 30) + mat(k, 31) = lmat(k, 31) + mat(k, 32) = lmat(k, 32) + mat(k, 33) = lmat(k, 33) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 46) = lmat(k, 46) + mat(k, 47) = lmat(k, 47) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 52) = mat(k, 52) + lmat(k, 52) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 59) = mat(k, 59) + lmat(k, 59) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 64) = lmat(k, 64) + mat(k, 65) = lmat(k, 65) + mat(k, 66) = lmat(k, 66) + mat(k, 67) = lmat(k, 67) + mat(k, 68) = mat(k, 68) + lmat(k, 68) + mat(k, 71) = lmat(k, 71) + mat(k, 72) = lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 76) = mat(k, 76) + lmat(k, 76) + mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 78) = lmat(k, 78) + mat(k, 79) = lmat(k, 79) + mat(k, 80) = lmat(k, 80) + mat(k, 86) = mat(k, 86) + lmat(k, 86) + mat(k, 92) = lmat(k, 92) + mat(k, 93) = lmat(k, 93) + mat(k, 94) = lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 102) = mat(k, 102) + lmat(k, 102) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 114) = mat(k, 114) + lmat(k, 114) + mat(k, 121) = mat(k, 121) + lmat(k, 121) + mat(k, 126) = lmat(k, 126) + mat(k, 127) = lmat(k, 127) + mat(k, 128) = lmat(k, 128) + mat(k, 129) = lmat(k, 129) + mat(k, 130) = mat(k, 130) + lmat(k, 130) + mat(k, 132) = mat(k, 132) + lmat(k, 132) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 152) = lmat(k, 152) + mat(k, 153) = lmat(k, 153) + mat(k, 154) = lmat(k, 154) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 156) = lmat(k, 156) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 159) = lmat(k, 159) + mat(k, 160) = lmat(k, 160) + mat(k, 161) = lmat(k, 161) + mat(k, 162) = lmat(k, 162) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 166) = lmat(k, 166) + mat(k, 167) = lmat(k, 167) + mat(k, 168) = lmat(k, 168) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 174) = lmat(k, 174) + mat(k, 175) = lmat(k, 175) + mat(k, 177) = mat(k, 177) + lmat(k, 177) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 182) = lmat(k, 182) + mat(k, 184) = mat(k, 184) + lmat(k, 184) + mat(k, 185) = lmat(k, 185) + mat(k, 186) = lmat(k, 186) + mat(k, 187) = lmat(k, 187) + mat(k, 188) = lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 190) = lmat(k, 190) + mat(k, 191) = mat(k, 191) + lmat(k, 191) + mat(k, 197) = lmat(k, 197) + mat(k, 198) = lmat(k, 198) + mat(k, 199) = lmat(k, 199) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 206) = mat(k, 206) + lmat(k, 206) + mat(k, 212) = mat(k, 212) + lmat(k, 212) + mat(k, 215) = mat(k, 215) + lmat(k, 215) + mat(k, 220) = mat(k, 220) + lmat(k, 220) + mat(k, 222) = lmat(k, 222) + mat(k, 223) = lmat(k, 223) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = lmat(k, 226) + mat(k, 227) = lmat(k, 227) + mat(k, 228) = lmat(k, 228) + mat(k, 229) = lmat(k, 229) + mat(k, 230) = mat(k, 230) + lmat(k, 230) + mat(k, 233) = lmat(k, 233) + mat(k, 234) = mat(k, 234) + lmat(k, 234) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 237) = lmat(k, 237) + mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 239) = lmat(k, 239) + mat(k, 240) = lmat(k, 240) + mat(k, 241) = mat(k, 241) + lmat(k, 241) + mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 250) = lmat(k, 250) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 252) = lmat(k, 252) + mat(k, 254) = mat(k, 254) + lmat(k, 254) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 267) = mat(k, 267) + lmat(k, 267) + mat(k, 271) = lmat(k, 271) + mat(k, 273) = mat(k, 273) + lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = mat(k, 277) + lmat(k, 277) + mat(k, 278) = lmat(k, 278) + mat(k, 279) = lmat(k, 279) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = lmat(k, 282) + mat(k, 283) = lmat(k, 283) + mat(k, 284) = lmat(k, 284) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 286) = lmat(k, 286) + mat(k, 288) = mat(k, 288) + lmat(k, 288) + mat(k, 289) = lmat(k, 289) + mat(k, 290) = lmat(k, 290) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 293) = lmat(k, 293) + mat(k, 294) = mat(k, 294) + lmat(k, 294) + mat(k, 295) = lmat(k, 295) + mat(k, 297) = mat(k, 297) + lmat(k, 297) + mat(k, 298) = lmat(k, 298) + mat(k, 301) = lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 303) = mat(k, 303) + lmat(k, 303) + mat(k, 305) = lmat(k, 305) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 307) = lmat(k, 307) + mat(k, 309) = mat(k, 309) + lmat(k, 309) + mat(k, 311) = mat(k, 311) + lmat(k, 311) + mat(k, 312) = mat(k, 312) + lmat(k, 312) + mat(k, 313) = lmat(k, 313) + mat(k, 315) = mat(k, 315) + lmat(k, 315) + mat(k, 317) = lmat(k, 317) + mat(k, 318) = lmat(k, 318) + mat(k, 319) = mat(k, 319) + lmat(k, 319) + mat(k, 320) = lmat(k, 320) + mat(k, 323) = mat(k, 323) + lmat(k, 323) + mat(k, 329) = mat(k, 329) + lmat(k, 329) + mat(k, 332) = lmat(k, 332) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 336) = mat(k, 336) + lmat(k, 336) + mat(k, 342) = lmat(k, 342) + mat(k, 343) = lmat(k, 343) + mat(k, 344) = lmat(k, 344) + mat(k, 345) = mat(k, 345) + lmat(k, 345) + mat(k, 348) = lmat(k, 348) + mat(k, 349) = mat(k, 349) + lmat(k, 349) + mat(k, 350) = mat(k, 350) + lmat(k, 350) + mat(k, 351) = lmat(k, 351) + mat(k, 352) = lmat(k, 352) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 356) = lmat(k, 356) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 364) = lmat(k, 364) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 366) = lmat(k, 366) + mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 369) = lmat(k, 369) + mat(k, 370) = lmat(k, 370) + mat(k, 372) = mat(k, 372) + lmat(k, 372) + mat(k, 373) = lmat(k, 373) + mat(k, 374) = lmat(k, 374) + mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 384) = mat(k, 384) + lmat(k, 384) + mat(k, 392) = mat(k, 392) + lmat(k, 392) + mat(k, 400) = mat(k, 400) + lmat(k, 400) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 408) = lmat(k, 408) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 412) = mat(k, 412) + lmat(k, 412) + mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 419) = lmat(k, 419) + mat(k, 420) = lmat(k, 420) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 428) = lmat(k, 428) + mat(k, 430) = mat(k, 430) + lmat(k, 430) + mat(k, 433) = lmat(k, 433) + mat(k, 434) = mat(k, 434) + lmat(k, 434) + mat(k, 435) = lmat(k, 435) + mat(k, 436) = lmat(k, 436) + mat(k, 438) = mat(k, 438) + lmat(k, 438) + mat(k, 439) = lmat(k, 439) + mat(k, 440) = lmat(k, 440) + mat(k, 442) = mat(k, 442) + lmat(k, 442) + mat(k, 443) = lmat(k, 443) + mat(k, 444) = lmat(k, 444) + mat(k, 445) = mat(k, 445) + lmat(k, 445) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 466) = mat(k, 466) + lmat(k, 466) + mat(k, 468) = lmat(k, 468) + mat(k, 472) = lmat(k, 472) + mat(k, 474) = mat(k, 474) + lmat(k, 474) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 482) = lmat(k, 482) + mat(k, 483) = lmat(k, 483) + mat(k, 484) = lmat(k, 484) + mat(k, 485) = lmat(k, 485) + mat(k, 487) = mat(k, 487) + lmat(k, 487) + mat(k, 488) = lmat(k, 488) + mat(k, 489) = lmat(k, 489) + mat(k, 490) = lmat(k, 490) + mat(k, 491) = lmat(k, 491) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 493) = lmat(k, 493) + mat(k, 497) = lmat(k, 497) + mat(k, 498) = lmat(k, 498) + mat(k, 499) = mat(k, 499) + lmat(k, 499) + mat(k, 500) = lmat(k, 500) + mat(k, 501) = lmat(k, 501) + mat(k, 502) = lmat(k, 502) + mat(k, 503) = lmat(k, 503) + mat(k, 504) = lmat(k, 504) + mat(k, 505) = mat(k, 505) + lmat(k, 505) + mat(k, 511) = lmat(k, 511) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 515) = mat(k, 515) + lmat(k, 515) + mat(k, 516) = lmat(k, 516) + mat(k, 517) = lmat(k, 517) + mat(k, 518) = lmat(k, 518) + mat(k, 521) = mat(k, 521) + lmat(k, 521) + mat(k, 522) = mat(k, 522) + lmat(k, 522) + mat(k, 524) = lmat(k, 524) + mat(k, 525) = mat(k, 525) + lmat(k, 525) + mat(k, 526) = lmat(k, 526) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 535) = lmat(k, 535) + mat(k, 536) = mat(k, 536) + lmat(k, 536) + mat(k, 539) = mat(k, 539) + lmat(k, 539) + mat(k, 540) = mat(k, 540) + lmat(k, 540) + mat(k, 543) = mat(k, 543) + lmat(k, 543) + mat(k, 544) = mat(k, 544) + lmat(k, 544) + mat(k, 545) = lmat(k, 545) + mat(k, 546) = lmat(k, 546) + mat(k, 547) = mat(k, 547) + lmat(k, 547) + mat(k, 551) = lmat(k, 551) + mat(k, 552) = lmat(k, 552) + mat(k, 554) = mat(k, 554) + lmat(k, 554) + mat(k, 555) = lmat(k, 555) + mat(k, 556) = lmat(k, 556) + mat(k, 558) = mat(k, 558) + lmat(k, 558) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 578) = mat(k, 578) + lmat(k, 578) + mat(k, 580) = lmat(k, 580) + mat(k, 581) = lmat(k, 581) + mat(k, 583) = lmat(k, 583) + mat(k, 584) = lmat(k, 584) + mat(k, 585) = lmat(k, 585) + mat(k, 586) = lmat(k, 586) + mat(k, 587) = lmat(k, 587) + mat(k, 588) = lmat(k, 588) + mat(k, 589) = mat(k, 589) + lmat(k, 589) + mat(k, 593) = lmat(k, 593) + mat(k, 596) = lmat(k, 596) + mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 599) = lmat(k, 599) + mat(k, 600) = mat(k, 600) + lmat(k, 600) + mat(k, 607) = mat(k, 607) + lmat(k, 607) + mat(k, 618) = mat(k, 618) + lmat(k, 618) + mat(k, 634) = mat(k, 634) + lmat(k, 634) + mat(k, 645) = mat(k, 645) + lmat(k, 645) + mat(k, 654) = mat(k, 654) + lmat(k, 654) + mat(k, 656) = lmat(k, 656) + mat(k, 658) = mat(k, 658) + lmat(k, 658) + mat(k, 664) = mat(k, 664) + lmat(k, 664) + mat(k, 672) = mat(k, 672) + lmat(k, 672) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 675) = lmat(k, 675) + mat(k, 681) = mat(k, 681) + lmat(k, 681) + mat(k, 682) = mat(k, 682) + lmat(k, 682) + mat(k, 686) = mat(k, 686) + lmat(k, 686) + mat(k, 690) = mat(k, 690) + lmat(k, 690) + mat(k, 701) = mat(k, 701) + lmat(k, 701) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 712) = mat(k, 712) + lmat(k, 712) + mat(k, 717) = mat(k, 717) + lmat(k, 717) + mat(k, 728) = mat(k, 728) + lmat(k, 728) + mat(k, 739) = lmat(k, 739) + mat(k, 743) = lmat(k, 743) + mat(k, 744) = mat(k, 744) + lmat(k, 744) + mat(k, 753) = mat(k, 753) + lmat(k, 753) + mat(k, 754) = mat(k, 754) + lmat(k, 754) + mat(k, 758) = mat(k, 758) + lmat(k, 758) + mat(k, 762) = mat(k, 762) + lmat(k, 762) + mat(k, 764) = mat(k, 764) + lmat(k, 764) + mat(k, 765) = mat(k, 765) + lmat(k, 765) + mat(k, 769) = mat(k, 769) + lmat(k, 769) + mat(k, 771) = lmat(k, 771) + mat(k, 773) = lmat(k, 773) + mat(k, 774) = mat(k, 774) + lmat(k, 774) + mat(k, 781) = mat(k, 781) + lmat(k, 781) + mat(k, 797) = lmat(k, 797) + mat(k, 798) = mat(k, 798) + lmat(k, 798) + mat(k, 799) = mat(k, 799) + lmat(k, 799) + mat(k, 801) = mat(k, 801) + lmat(k, 801) + mat(k, 803) = mat(k, 803) + lmat(k, 803) + mat(k, 820) = mat(k, 820) + lmat(k, 820) + mat(k, 840) = mat(k, 840) + lmat(k, 840) + mat(k, 858) = mat(k, 858) + lmat(k, 858) + mat(k, 880) = mat(k, 880) + lmat(k, 880) + mat(k, 892) = mat(k, 892) + lmat(k, 892) + mat(k, 893) = lmat(k, 893) + mat(k, 895) = lmat(k, 895) + mat(k, 898) = mat(k, 898) + lmat(k, 898) + mat(k, 900) = lmat(k, 900) + mat(k, 901) = lmat(k, 901) + mat(k, 905) = mat(k, 905) + lmat(k, 905) + mat(k, 906) = mat(k, 906) + lmat(k, 906) + mat(k, 908) = mat(k, 908) + lmat(k, 908) + mat(k, 911) = mat(k, 911) + lmat(k, 911) + mat(k, 912) = mat(k, 912) + lmat(k, 912) + mat(k, 913) = lmat(k, 913) + mat(k, 914) = mat(k, 914) + lmat(k, 914) + mat(k, 916) = mat(k, 916) + lmat(k, 916) + mat(k, 917) = lmat(k, 917) + mat(k, 918) = lmat(k, 918) + mat(k, 923) = lmat(k, 923) + mat(k, 924) = lmat(k, 924) + mat(k, 928) = mat(k, 928) + lmat(k, 928) + mat(k, 936) = lmat(k, 936) + mat(k, 937) = lmat(k, 937) + mat(k, 938) = mat(k, 938) + lmat(k, 938) + mat(k, 943) = mat(k, 943) + lmat(k, 943) + mat(k, 960) = mat(k, 960) + lmat(k, 960) + mat(k, 961) = lmat(k, 961) + mat(k, 963) = mat(k, 963) + lmat(k, 963) + mat(k, 964) = mat(k, 964) + lmat(k, 964) + mat(k, 966) = lmat(k, 966) + mat(k, 967) = lmat(k, 967) + mat(k, 968) = mat(k, 968) + lmat(k, 968) + mat(k, 969) = lmat(k, 969) + mat(k, 970) = lmat(k, 970) + mat(k, 972) = lmat(k, 972) + mat(k, 973) = lmat(k, 973) + mat(k, 976) = lmat(k, 976) + mat(k, 977) = lmat(k, 977) + mat(k, 978) = lmat(k, 978) + mat(k, 979) = mat(k, 979) + lmat(k, 979) + mat(k, 981) = mat(k, 981) + lmat(k, 981) + mat(k, 982) = mat(k, 982) + lmat(k, 982) + mat(k, 983) = mat(k, 983) + lmat(k, 983) + mat(k, 984) = mat(k, 984) + lmat(k, 984) + mat(k, 985) = mat(k, 985) + lmat(k, 985) + mat(k, 988) = mat(k, 988) + lmat(k, 988) + mat(k, 989) = mat(k, 989) + lmat(k, 989) + mat(k, 991) = mat(k, 991) + lmat(k, 991) + mat(k, 993) = lmat(k, 993) + mat(k, 995) = lmat(k, 995) + mat(k, 996) = mat(k, 996) + lmat(k, 996) + mat(k, 997) = mat(k, 997) + lmat(k, 997) + mat(k,1008) = mat(k,1008) + lmat(k,1008) + mat(k,1030) = mat(k,1030) + lmat(k,1030) + mat(k,1049) = mat(k,1049) + lmat(k,1049) + mat(k,1065) = mat(k,1065) + lmat(k,1065) + mat(k,1075) = lmat(k,1075) + mat(k,1076) = mat(k,1076) + lmat(k,1076) + mat(k,1078) = lmat(k,1078) + mat(k,1083) = lmat(k,1083) + mat(k,1091) = mat(k,1091) + lmat(k,1091) + mat(k,1104) = mat(k,1104) + lmat(k,1104) + mat(k,1124) = mat(k,1124) + lmat(k,1124) + mat(k,1139) = mat(k,1139) + lmat(k,1139) + mat(k,1140) = mat(k,1140) + lmat(k,1140) + mat(k,1143) = mat(k,1143) + lmat(k,1143) + mat(k,1144) = mat(k,1144) + lmat(k,1144) + mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1149) = mat(k,1149) + lmat(k,1149) + mat(k,1151) = mat(k,1151) + lmat(k,1151) + mat(k,1152) = mat(k,1152) + lmat(k,1152) + mat(k,1153) = mat(k,1153) + lmat(k,1153) + mat(k,1158) = lmat(k,1158) + mat(k,1172) = mat(k,1172) + lmat(k,1172) + mat(k,1188) = lmat(k,1188) + mat(k,1206) = mat(k,1206) + lmat(k,1206) + mat(k,1220) = mat(k,1220) + lmat(k,1220) + mat(k,1231) = mat(k,1231) + lmat(k,1231) + mat(k,1245) = lmat(k,1245) + mat(k,1247) = mat(k,1247) + lmat(k,1247) + mat(k,1251) = mat(k,1251) + lmat(k,1251) + mat(k,1253) = mat(k,1253) + lmat(k,1253) + mat(k,1254) = lmat(k,1254) + mat(k,1271) = mat(k,1271) + lmat(k,1271) + mat(k,1302) = mat(k,1302) + lmat(k,1302) + mat(k,1316) = lmat(k,1316) + mat(k,1318) = mat(k,1318) + lmat(k,1318) + mat(k,1325) = mat(k,1325) + lmat(k,1325) + mat(k,1337) = mat(k,1337) + lmat(k,1337) + mat(k,1339) = mat(k,1339) + lmat(k,1339) + mat(k,1344) = mat(k,1344) + lmat(k,1344) + mat(k,1352) = mat(k,1352) + lmat(k,1352) + mat(k,1396) = mat(k,1396) + lmat(k,1396) + mat(k,1415) = mat(k,1415) + lmat(k,1415) + mat(k,1418) = mat(k,1418) + lmat(k,1418) + mat(k,1420) = lmat(k,1420) + mat(k,1427) = mat(k,1427) + lmat(k,1427) + mat(k,1430) = mat(k,1430) + lmat(k,1430) + mat(k,1433) = mat(k,1433) + lmat(k,1433) + mat(k,1470) = mat(k,1470) + lmat(k,1470) + mat(k,1471) = lmat(k,1471) + mat(k,1475) = mat(k,1475) + lmat(k,1475) + mat(k,1507) = mat(k,1507) + lmat(k,1507) + mat(k,1512) = mat(k,1512) + lmat(k,1512) + mat(k,1534) = mat(k,1534) + lmat(k,1534) + mat(k,1538) = mat(k,1538) + lmat(k,1538) + mat(k,1539) = lmat(k,1539) + mat(k,1540) = lmat(k,1540) + mat(k,1543) = mat(k,1543) + lmat(k,1543) + mat(k,1554) = mat(k,1554) + lmat(k,1554) + mat(k,1557) = mat(k,1557) + lmat(k,1557) + mat(k,1559) = mat(k,1559) + lmat(k,1559) + mat(k,1561) = mat(k,1561) + lmat(k,1561) + mat(k,1563) = mat(k,1563) + lmat(k,1563) + mat(k,1565) = mat(k,1565) + lmat(k,1565) + mat(k,1566) = lmat(k,1566) + mat(k,1567) = mat(k,1567) + lmat(k,1567) + mat(k,1568) = lmat(k,1568) + mat(k,1569) = mat(k,1569) + lmat(k,1569) + mat(k,1570) = mat(k,1570) + lmat(k,1570) + mat(k,1571) = mat(k,1571) + lmat(k,1571) + mat(k,1573) = mat(k,1573) + lmat(k,1573) + mat(k,1574) = lmat(k,1574) + mat(k,1576) = mat(k,1576) + lmat(k,1576) + mat(k,1580) = lmat(k,1580) + mat(k,1593) = lmat(k,1593) + mat(k,1598) = lmat(k,1598) + mat(k,1713) = mat(k,1713) + lmat(k,1713) + mat(k,1714) = mat(k,1714) + lmat(k,1714) + mat(k,1717) = mat(k,1717) + lmat(k,1717) + mat(k,1719) = mat(k,1719) + lmat(k,1719) + mat(k,1728) = mat(k,1728) + lmat(k,1728) + mat(k,1730) = mat(k,1730) + lmat(k,1730) + mat(k,1736) = mat(k,1736) + lmat(k,1736) + mat(k,1777) = mat(k,1777) + lmat(k,1777) + mat(k,1780) = mat(k,1780) + lmat(k,1780) + mat(k,1782) = mat(k,1782) + lmat(k,1782) + mat(k,1783) = mat(k,1783) + lmat(k,1783) + mat(k,1800) = mat(k,1800) + lmat(k,1800) + mat(k,1806) = lmat(k,1806) + mat(k,1824) = mat(k,1824) + lmat(k,1824) + mat(k,1837) = mat(k,1837) + lmat(k,1837) + mat(k,1838) = lmat(k,1838) + mat(k,1849) = mat(k,1849) + lmat(k,1849) + mat(k,1851) = mat(k,1851) + lmat(k,1851) + mat(k,1899) = mat(k,1899) + lmat(k,1899) + mat(k,1900) = mat(k,1900) + lmat(k,1900) + mat(k,1905) = mat(k,1905) + lmat(k,1905) + mat(k,1907) = mat(k,1907) + lmat(k,1907) + mat(k,1909) = mat(k,1909) + lmat(k,1909) + mat(k,1910) = mat(k,1910) + lmat(k,1910) + mat(k,1928) = mat(k,1928) + lmat(k,1928) + mat(k,1945) = mat(k,1945) + lmat(k,1945) + mat(k,1951) = mat(k,1951) + lmat(k,1951) + mat(k,1952) = lmat(k,1952) + mat(k,1984) = mat(k,1984) + lmat(k,1984) + mat(k,1987) = mat(k,1987) + lmat(k,1987) + mat(k,1989) = mat(k,1989) + lmat(k,1989) + mat(k,1993) = mat(k,1993) + lmat(k,1993) + mat(k,1994) = mat(k,1994) + lmat(k,1994) + mat(k,2006) = mat(k,2006) + lmat(k,2006) + mat(k,2013) = mat(k,2013) + lmat(k,2013) + mat(k,2019) = mat(k,2019) + lmat(k,2019) + mat(k,2052) = mat(k,2052) + lmat(k,2052) + mat(k,2115) = mat(k,2115) + lmat(k,2115) + mat(k,2131) = mat(k,2131) + lmat(k,2131) + mat(k,2135) = mat(k,2135) + lmat(k,2135) + mat(k,2143) = mat(k,2143) + lmat(k,2143) + mat(k,2150) = lmat(k,2150) + mat(k,2158) = mat(k,2158) + lmat(k,2158) + mat(k,2159) = mat(k,2159) + lmat(k,2159) + mat(k,2161) = lmat(k,2161) + mat(k,2164) = lmat(k,2164) + mat(k,2170) = mat(k,2170) + lmat(k,2170) + mat(k, 143) = 0._r8 + mat(k, 144) = 0._r8 + mat(k, 243) = 0._r8 + mat(k, 324) = 0._r8 + mat(k, 326) = 0._r8 + mat(k, 339) = 0._r8 + mat(k, 378) = 0._r8 + mat(k, 381) = 0._r8 + mat(k, 396) = 0._r8 + mat(k, 494) = 0._r8 + mat(k, 496) = 0._r8 + mat(k, 531) = 0._r8 + mat(k, 532) = 0._r8 + mat(k, 537) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 541) = 0._r8 + mat(k, 548) = 0._r8 + mat(k, 549) = 0._r8 + mat(k, 553) = 0._r8 + mat(k, 572) = 0._r8 + mat(k, 574) = 0._r8 + mat(k, 575) = 0._r8 + mat(k, 590) = 0._r8 + mat(k, 592) = 0._r8 + mat(k, 594) = 0._r8 + mat(k, 595) = 0._r8 + mat(k, 597) = 0._r8 + mat(k, 617) = 0._r8 + mat(k, 619) = 0._r8 + mat(k, 621) = 0._r8 + mat(k, 622) = 0._r8 + mat(k, 625) = 0._r8 + mat(k, 633) = 0._r8 + mat(k, 635) = 0._r8 + mat(k, 637) = 0._r8 + mat(k, 638) = 0._r8 + mat(k, 640) = 0._r8 + mat(k, 642) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 665) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 668) = 0._r8 + mat(k, 693) = 0._r8 + mat(k, 694) = 0._r8 + mat(k, 695) = 0._r8 + mat(k, 703) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 705) = 0._r8 + mat(k, 718) = 0._r8 + mat(k, 722) = 0._r8 + mat(k, 726) = 0._r8 + mat(k, 734) = 0._r8 + mat(k, 738) = 0._r8 + mat(k, 740) = 0._r8 + mat(k, 745) = 0._r8 + mat(k, 748) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 819) = 0._r8 + mat(k, 821) = 0._r8 + mat(k, 829) = 0._r8 + mat(k, 836) = 0._r8 + mat(k, 845) = 0._r8 + mat(k, 857) = 0._r8 + mat(k, 859) = 0._r8 + mat(k, 867) = 0._r8 + mat(k, 874) = 0._r8 + mat(k, 878) = 0._r8 + mat(k, 879) = 0._r8 + mat(k, 883) = 0._r8 + mat(k, 884) = 0._r8 + mat(k, 885) = 0._r8 + mat(k, 887) = 0._r8 + mat(k, 897) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 927) = 0._r8 + mat(k, 929) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 931) = 0._r8 + mat(k, 932) = 0._r8 + mat(k, 933) = 0._r8 + mat(k, 935) = 0._r8 + mat(k, 944) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 948) = 0._r8 + mat(k, 950) = 0._r8 + mat(k, 951) = 0._r8 + mat(k, 956) = 0._r8 + mat(k, 958) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 974) = 0._r8 + mat(k, 980) = 0._r8 + mat(k, 986) = 0._r8 + mat(k, 990) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1007) = 0._r8 + mat(k,1009) = 0._r8 + mat(k,1010) = 0._r8 + mat(k,1011) = 0._r8 + mat(k,1012) = 0._r8 + mat(k,1015) = 0._r8 + mat(k,1017) = 0._r8 + mat(k,1018) = 0._r8 + mat(k,1019) = 0._r8 + mat(k,1022) = 0._r8 + mat(k,1031) = 0._r8 + mat(k,1032) = 0._r8 + mat(k,1035) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1041) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1048) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1054) = 0._r8 + mat(k,1057) = 0._r8 + mat(k,1058) = 0._r8 + mat(k,1061) = 0._r8 + mat(k,1074) = 0._r8 + mat(k,1081) = 0._r8 + mat(k,1096) = 0._r8 + mat(k,1099) = 0._r8 + mat(k,1106) = 0._r8 + mat(k,1111) = 0._r8 + mat(k,1113) = 0._r8 + mat(k,1117) = 0._r8 + mat(k,1119) = 0._r8 + mat(k,1121) = 0._r8 + mat(k,1122) = 0._r8 + mat(k,1123) = 0._r8 + mat(k,1125) = 0._r8 + mat(k,1126) = 0._r8 + mat(k,1127) = 0._r8 + mat(k,1131) = 0._r8 + mat(k,1134) = 0._r8 + mat(k,1135) = 0._r8 + mat(k,1148) = 0._r8 + mat(k,1156) = 0._r8 + mat(k,1163) = 0._r8 + mat(k,1164) = 0._r8 + mat(k,1165) = 0._r8 + mat(k,1166) = 0._r8 + mat(k,1167) = 0._r8 + mat(k,1168) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1171) = 0._r8 + mat(k,1173) = 0._r8 + mat(k,1175) = 0._r8 + mat(k,1179) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1184) = 0._r8 + mat(k,1187) = 0._r8 + mat(k,1191) = 0._r8 + mat(k,1194) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1201) = 0._r8 + mat(k,1202) = 0._r8 + mat(k,1203) = 0._r8 + mat(k,1204) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1209) = 0._r8 + mat(k,1213) = 0._r8 + mat(k,1214) = 0._r8 + mat(k,1217) = 0._r8 + mat(k,1218) = 0._r8 + mat(k,1221) = 0._r8 + mat(k,1228) = 0._r8 + mat(k,1229) = 0._r8 + mat(k,1232) = 0._r8 + mat(k,1236) = 0._r8 + mat(k,1239) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1243) = 0._r8 + mat(k,1246) = 0._r8 + mat(k,1252) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1256) = 0._r8 + mat(k,1260) = 0._r8 + mat(k,1261) = 0._r8 + mat(k,1262) = 0._r8 + mat(k,1263) = 0._r8 + mat(k,1265) = 0._r8 + mat(k,1269) = 0._r8 + mat(k,1270) = 0._r8 + mat(k,1279) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1309) = 0._r8 + mat(k,1310) = 0._r8 + mat(k,1311) = 0._r8 + mat(k,1314) = 0._r8 + mat(k,1329) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1346) = 0._r8 + mat(k,1347) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1355) = 0._r8 + mat(k,1357) = 0._r8 + mat(k,1359) = 0._r8 + mat(k,1362) = 0._r8 + mat(k,1371) = 0._r8 + mat(k,1400) = 0._r8 + mat(k,1401) = 0._r8 + mat(k,1403) = 0._r8 + mat(k,1404) = 0._r8 + mat(k,1405) = 0._r8 + mat(k,1409) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1426) = 0._r8 + mat(k,1429) = 0._r8 + mat(k,1431) = 0._r8 + mat(k,1434) = 0._r8 + mat(k,1436) = 0._r8 + mat(k,1437) = 0._r8 + mat(k,1439) = 0._r8 + mat(k,1440) = 0._r8 + mat(k,1476) = 0._r8 + mat(k,1509) = 0._r8 + mat(k,1515) = 0._r8 + mat(k,1516) = 0._r8 + mat(k,1521) = 0._r8 + mat(k,1527) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1530) = 0._r8 + mat(k,1533) = 0._r8 + mat(k,1535) = 0._r8 + mat(k,1537) = 0._r8 + mat(k,1542) = 0._r8 + mat(k,1544) = 0._r8 + mat(k,1547) = 0._r8 + mat(k,1551) = 0._r8 + mat(k,1552) = 0._r8 + mat(k,1553) = 0._r8 + mat(k,1556) = 0._r8 + mat(k,1575) = 0._r8 + mat(k,1577) = 0._r8 + mat(k,1578) = 0._r8 + mat(k,1634) = 0._r8 + mat(k,1653) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1666) = 0._r8 + mat(k,1668) = 0._r8 + mat(k,1679) = 0._r8 + mat(k,1702) = 0._r8 + mat(k,1718) = 0._r8 + mat(k,1745) = 0._r8 + mat(k,1748) = 0._r8 + mat(k,1751) = 0._r8 + mat(k,1756) = 0._r8 + mat(k,1758) = 0._r8 + mat(k,1760) = 0._r8 + mat(k,1761) = 0._r8 + mat(k,1762) = 0._r8 + mat(k,1765) = 0._r8 + mat(k,1768) = 0._r8 + mat(k,1769) = 0._r8 + mat(k,1770) = 0._r8 + mat(k,1772) = 0._r8 + mat(k,1787) = 0._r8 + mat(k,1792) = 0._r8 + mat(k,1802) = 0._r8 + mat(k,1804) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1817) = 0._r8 + mat(k,1821) = 0._r8 + mat(k,1828) = 0._r8 + mat(k,1833) = 0._r8 + mat(k,1835) = 0._r8 + mat(k,1841) = 0._r8 + mat(k,1842) = 0._r8 + mat(k,1843) = 0._r8 + mat(k,1845) = 0._r8 + mat(k,1847) = 0._r8 + mat(k,1853) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1856) = 0._r8 + mat(k,1864) = 0._r8 + mat(k,1870) = 0._r8 + mat(k,1877) = 0._r8 + mat(k,1878) = 0._r8 + mat(k,1881) = 0._r8 + mat(k,1884) = 0._r8 + mat(k,1896) = 0._r8 + mat(k,1897) = 0._r8 + mat(k,1898) = 0._r8 + mat(k,1901) = 0._r8 + mat(k,1902) = 0._r8 + mat(k,1904) = 0._r8 + mat(k,1908) = 0._r8 + mat(k,1911) = 0._r8 + mat(k,1913) = 0._r8 + mat(k,1914) = 0._r8 + mat(k,1916) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1918) = 0._r8 + mat(k,1920) = 0._r8 + mat(k,1921) = 0._r8 + mat(k,1922) = 0._r8 + mat(k,1926) = 0._r8 + mat(k,1927) = 0._r8 + mat(k,1929) = 0._r8 + mat(k,1930) = 0._r8 + mat(k,1931) = 0._r8 + mat(k,1933) = 0._r8 + mat(k,1937) = 0._r8 + mat(k,1938) = 0._r8 + mat(k,1939) = 0._r8 + mat(k,1940) = 0._r8 + mat(k,1941) = 0._r8 + mat(k,1942) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1948) = 0._r8 + mat(k,1950) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1954) = 0._r8 + mat(k,1955) = 0._r8 + mat(k,1965) = 0._r8 + mat(k,1968) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1974) = 0._r8 + mat(k,1975) = 0._r8 + mat(k,1976) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1981) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1985) = 0._r8 + mat(k,1986) = 0._r8 + mat(k,1990) = 0._r8 + mat(k,1992) = 0._r8 + mat(k,1998) = 0._r8 + mat(k,2005) = 0._r8 + mat(k,2010) = 0._r8 + mat(k,2012) = 0._r8 + mat(k,2014) = 0._r8 + mat(k,2015) = 0._r8 + mat(k,2016) = 0._r8 + mat(k,2017) = 0._r8 + mat(k,2022) = 0._r8 + mat(k,2041) = 0._r8 + mat(k,2042) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2055) = 0._r8 + mat(k,2072) = 0._r8 + mat(k,2077) = 0._r8 + mat(k,2078) = 0._r8 + mat(k,2079) = 0._r8 + mat(k,2080) = 0._r8 + mat(k,2081) = 0._r8 + mat(k,2091) = 0._r8 + mat(k,2096) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2112) = 0._r8 + mat(k,2132) = 0._r8 + mat(k,2134) = 0._r8 + mat(k,2137) = 0._r8 + mat(k,2138) = 0._r8 + mat(k,2139) = 0._r8 + mat(k,2144) = 0._r8 + mat(k,2149) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2152) = 0._r8 + mat(k,2153) = 0._r8 + mat(k,2154) = 0._r8 + mat(k,2155) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2157) = 0._r8 + mat(k,2160) = 0._r8 + mat(k,2162) = 0._r8 + mat(k,2163) = 0._r8 + mat(k,2165) = 0._r8 + mat(k,2166) = 0._r8 + mat(k,2167) = 0._r8 + mat(k,2168) = 0._r8 + mat(k,2169) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 3) = mat(k, 3) - dti(k) + mat(k, 4) = mat(k, 4) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 6) = mat(k, 6) - dti(k) + mat(k, 7) = mat(k, 7) - dti(k) + mat(k, 8) = mat(k, 8) - dti(k) + mat(k, 9) = mat(k, 9) - dti(k) + mat(k, 10) = mat(k, 10) - dti(k) + mat(k, 11) = mat(k, 11) - dti(k) + mat(k, 12) = mat(k, 12) - dti(k) + mat(k, 13) = mat(k, 13) - dti(k) + mat(k, 14) = mat(k, 14) - dti(k) + mat(k, 15) = mat(k, 15) - dti(k) + mat(k, 16) = mat(k, 16) - dti(k) + mat(k, 17) = mat(k, 17) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 19) = mat(k, 19) - dti(k) + mat(k, 20) = mat(k, 20) - dti(k) + mat(k, 21) = mat(k, 21) - dti(k) + mat(k, 22) = mat(k, 22) - dti(k) + mat(k, 23) = mat(k, 23) - dti(k) + mat(k, 24) = mat(k, 24) - dti(k) + mat(k, 25) = mat(k, 25) - dti(k) + mat(k, 26) = mat(k, 26) - dti(k) + mat(k, 27) = mat(k, 27) - dti(k) + mat(k, 28) = mat(k, 28) - dti(k) + mat(k, 29) = mat(k, 29) - dti(k) + mat(k, 30) = mat(k, 30) - dti(k) + mat(k, 31) = mat(k, 31) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 33) = mat(k, 33) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 65) = mat(k, 65) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 79) = mat(k, 79) - dti(k) + mat(k, 86) = mat(k, 86) - dti(k) + mat(k, 92) = mat(k, 92) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 114) = mat(k, 114) - dti(k) + mat(k, 121) = mat(k, 121) - dti(k) + mat(k, 126) = mat(k, 126) - dti(k) + mat(k, 130) = mat(k, 130) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 155) = mat(k, 155) - dti(k) + mat(k, 160) = mat(k, 160) - dti(k) + mat(k, 163) = mat(k, 163) - dti(k) + mat(k, 166) = mat(k, 166) - dti(k) + mat(k, 169) = mat(k, 169) - dti(k) + mat(k, 173) = mat(k, 173) - dti(k) + mat(k, 177) = mat(k, 177) - dti(k) + mat(k, 181) = mat(k, 181) - dti(k) + mat(k, 185) = mat(k, 185) - dti(k) + mat(k, 191) = mat(k, 191) - dti(k) + mat(k, 197) = mat(k, 197) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 206) = mat(k, 206) - dti(k) + mat(k, 212) = mat(k, 212) - dti(k) + mat(k, 215) = mat(k, 215) - dti(k) + mat(k, 220) = mat(k, 220) - dti(k) + mat(k, 225) = mat(k, 225) - dti(k) + mat(k, 230) = mat(k, 230) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 241) = mat(k, 241) - dti(k) + mat(k, 246) = mat(k, 246) - dti(k) + mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 259) = mat(k, 259) - dti(k) + mat(k, 267) = mat(k, 267) - dti(k) + mat(k, 273) = mat(k, 273) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 285) = mat(k, 285) - dti(k) + mat(k, 291) = mat(k, 291) - dti(k) + mat(k, 297) = mat(k, 297) - dti(k) + mat(k, 303) = mat(k, 303) - dti(k) + mat(k, 309) = mat(k, 309) - dti(k) + mat(k, 315) = mat(k, 315) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) + mat(k, 329) = mat(k, 329) - dti(k) + mat(k, 336) = mat(k, 336) - dti(k) + mat(k, 342) = mat(k, 342) - dti(k) + mat(k, 345) = mat(k, 345) - dti(k) + mat(k, 350) = mat(k, 350) - dti(k) + mat(k, 357) = mat(k, 357) - dti(k) + mat(k, 361) = mat(k, 361) - dti(k) + mat(k, 368) = mat(k, 368) - dti(k) + mat(k, 377) = mat(k, 377) - dti(k) + mat(k, 384) = mat(k, 384) - dti(k) + mat(k, 392) = mat(k, 392) - dti(k) + mat(k, 400) = mat(k, 400) - dti(k) + mat(k, 406) = mat(k, 406) - dti(k) + mat(k, 412) = mat(k, 412) - dti(k) + mat(k, 417) = mat(k, 417) - dti(k) + mat(k, 422) = mat(k, 422) - dti(k) + mat(k, 430) = mat(k, 430) - dti(k) + mat(k, 438) = mat(k, 438) - dti(k) + mat(k, 446) = mat(k, 446) - dti(k) + mat(k, 450) = mat(k, 450) - dti(k) + mat(k, 458) = mat(k, 458) - dti(k) + mat(k, 466) = mat(k, 466) - dti(k) + mat(k, 474) = mat(k, 474) - dti(k) + mat(k, 481) = mat(k, 481) - dti(k) + mat(k, 492) = mat(k, 492) - dti(k) + mat(k, 501) = mat(k, 501) - dti(k) + mat(k, 505) = mat(k, 505) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 521) = mat(k, 521) - dti(k) + mat(k, 529) = mat(k, 529) - dti(k) + mat(k, 536) = mat(k, 536) - dti(k) + mat(k, 547) = mat(k, 547) - dti(k) + mat(k, 558) = mat(k, 558) - dti(k) + mat(k, 567) = mat(k, 567) - dti(k) + mat(k, 578) = mat(k, 578) - dti(k) + mat(k, 589) = mat(k, 589) - dti(k) + mat(k, 600) = mat(k, 600) - dti(k) + mat(k, 607) = mat(k, 607) - dti(k) + mat(k, 618) = mat(k, 618) - dti(k) + mat(k, 634) = mat(k, 634) - dti(k) + mat(k, 645) = mat(k, 645) - dti(k) + mat(k, 654) = mat(k, 654) - dti(k) + mat(k, 664) = mat(k, 664) - dti(k) + mat(k, 673) = mat(k, 673) - dti(k) + mat(k, 681) = mat(k, 681) - dti(k) + mat(k, 690) = mat(k, 690) - dti(k) + mat(k, 701) = mat(k, 701) - dti(k) + mat(k, 708) = mat(k, 708) - dti(k) + mat(k, 712) = mat(k, 712) - dti(k) + mat(k, 717) = mat(k, 717) - dti(k) + mat(k, 728) = mat(k, 728) - dti(k) + mat(k, 744) = mat(k, 744) - dti(k) + mat(k, 753) = mat(k, 753) - dti(k) + mat(k, 762) = mat(k, 762) - dti(k) + mat(k, 769) = mat(k, 769) - dti(k) + mat(k, 781) = mat(k, 781) - dti(k) + mat(k, 798) = mat(k, 798) - dti(k) + mat(k, 803) = mat(k, 803) - dti(k) + mat(k, 820) = mat(k, 820) - dti(k) + mat(k, 840) = mat(k, 840) - dti(k) + mat(k, 858) = mat(k, 858) - dti(k) + mat(k, 880) = mat(k, 880) - dti(k) + mat(k, 892) = mat(k, 892) - dti(k) + mat(k, 898) = mat(k, 898) - dti(k) + mat(k, 906) = mat(k, 906) - dti(k) + mat(k, 916) = mat(k, 916) - dti(k) + mat(k, 928) = mat(k, 928) - dti(k) + mat(k, 943) = mat(k, 943) - dti(k) + mat(k, 960) = mat(k, 960) - dti(k) + mat(k, 968) = mat(k, 968) - dti(k) + mat(k, 982) = mat(k, 982) - dti(k) + mat(k, 991) = mat(k, 991) - dti(k) + mat(k, 997) = mat(k, 997) - dti(k) + mat(k,1008) = mat(k,1008) - dti(k) + mat(k,1030) = mat(k,1030) - dti(k) + mat(k,1049) = mat(k,1049) - dti(k) + mat(k,1065) = mat(k,1065) - dti(k) + mat(k,1076) = mat(k,1076) - dti(k) + mat(k,1091) = mat(k,1091) - dti(k) + mat(k,1104) = mat(k,1104) - dti(k) + mat(k,1124) = mat(k,1124) - dti(k) + mat(k,1140) = mat(k,1140) - dti(k) + mat(k,1152) = mat(k,1152) - dti(k) + mat(k,1172) = mat(k,1172) - dti(k) + mat(k,1206) = mat(k,1206) - dti(k) + mat(k,1231) = mat(k,1231) - dti(k) + mat(k,1251) = mat(k,1251) - dti(k) + mat(k,1271) = mat(k,1271) - dti(k) + mat(k,1302) = mat(k,1302) - dti(k) + mat(k,1318) = mat(k,1318) - dti(k) + mat(k,1337) = mat(k,1337) - dti(k) + mat(k,1352) = mat(k,1352) - dti(k) + mat(k,1396) = mat(k,1396) - dti(k) + mat(k,1427) = mat(k,1427) - dti(k) + mat(k,1507) = mat(k,1507) - dti(k) + mat(k,1543) = mat(k,1543) - dti(k) + mat(k,1570) = mat(k,1570) - dti(k) + mat(k,1719) = mat(k,1719) - dti(k) + mat(k,1782) = mat(k,1782) - dti(k) + mat(k,1824) = mat(k,1824) - dti(k) + mat(k,1849) = mat(k,1849) - dti(k) + mat(k,1907) = mat(k,1907) - dti(k) + mat(k,1928) = mat(k,1928) - dti(k) + mat(k,1951) = mat(k,1951) - dti(k) + mat(k,1994) = mat(k,1994) - dti(k) + mat(k,2019) = mat(k,2019) - dti(k) + mat(k,2115) = mat(k,2115) - dti(k) + mat(k,2143) = mat(k,2143) - dti(k) + mat(k,2170) = mat(k,2170) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat05( avec_len, mat, y, rxt ) + call nlnmat06( avec_len, mat, y, rxt ) + call nlnmat07( avec_len, mat, y, rxt ) + call nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..6a03fe4d4b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k,112) = p_rate(:,k,112) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + p_rate(:,k,114) = p_rate(:,k,114) * inv(:,k, 2) * im(:,k) + p_rate(:,k,115) = p_rate(:,k,115) * inv(:,k, 2) * im(:,k) + p_rate(:,k,116) = p_rate(:,k,116) * inv(:,k, 2) * im(:,k) + p_rate(:,k,117) = p_rate(:,k,117) * inv(:,k, 2) * im(:,k) + p_rate(:,k,118) = p_rate(:,k,118) * inv(:,k, 2) * im(:,k) + p_rate(:,k,119) = p_rate(:,k,119) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..aa6614ebad --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 @@ -0,0 +1,1252 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,21))* y(k,21) + prod(k,2) = 0._r8 + loss(k,3) = (rxt(k,239)* y(k,216) + rxt(k,79) + het_rates(k,33))* y(k,33) + prod(k,3) = 0._r8 + loss(k,4) = (rxt(k,240)* y(k,216) + rxt(k,80) + het_rates(k,34))* y(k,34) + prod(k,4) = 0._r8 + loss(k,5) = (rxt(k,266)* y(k,216) + rxt(k,81) + het_rates(k,35))* y(k,35) + prod(k,5) = 0._r8 + loss(k,6) = (rxt(k,241)* y(k,216) + rxt(k,82) + het_rates(k,36))* y(k,36) + prod(k,6) = 0._r8 + loss(k,7) = (rxt(k,242)* y(k,216) + rxt(k,83) + het_rates(k,37))* y(k,37) + prod(k,7) = 0._r8 + loss(k,8) = (rxt(k,243)* y(k,216) + rxt(k,84) + het_rates(k,38))* y(k,38) + prod(k,8) = 0._r8 + loss(k,9) = (rxt(k,244)* y(k,216) + rxt(k,85) + het_rates(k,39))* y(k,39) + prod(k,9) = 0._r8 + loss(k,10) = (rxt(k,245)* y(k,216) + rxt(k,86) + het_rates(k,40))* y(k,40) + prod(k,10) = 0._r8 + loss(k,11) = (rxt(k,277)* y(k,56) +rxt(k,289)* y(k,216) +rxt(k,278)* y(k,220) & + + rxt(k,87) + het_rates(k,41))* y(k,41) + prod(k,11) = 0._r8 + loss(k,12) = (rxt(k,279)* y(k,56) +rxt(k,290)* y(k,216) +rxt(k,280)* y(k,220) & + + rxt(k,88) + het_rates(k,43))* y(k,43) + prod(k,12) = 0._r8 + loss(k,13) = (rxt(k,281)* y(k,220) + rxt(k,89) + het_rates(k,44))* y(k,44) + prod(k,13) = 0._r8 + loss(k,14) = (rxt(k,282)* y(k,56) +rxt(k,283)* y(k,220) + rxt(k,90) & + + het_rates(k,46))* y(k,46) + prod(k,14) = 0._r8 + loss(k,15) = (rxt(k,215)* y(k,56) +rxt(k,271)* y(k,73) + (rxt(k,311) + & + rxt(k,312) +rxt(k,313))* y(k,216) +rxt(k,304)* y(k,220) + rxt(k,40) & + + rxt(k,41) + het_rates(k,54))* y(k,54) + prod(k,15) = 0._r8 + loss(k,16) = (rxt(k,284)* y(k,56) +rxt(k,267)* y(k,216) +rxt(k,285)* y(k,220) & + + rxt(k,91) + het_rates(k,55))* y(k,55) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,61))* y(k,61) + prod(k,17) = 0._r8 + loss(k,18) = (rxt(k,577)* y(k,221) + rxt(k,42) + rxt(k,110) & + + het_rates(k,63))* y(k,63) + prod(k,18) =.440_r8*rxt(k,41)*y(k,54) + loss(k,19) = ( + rxt(k,580) + het_rates(k,71))* y(k,71) + prod(k,19) = 0._r8 + loss(k,20) = (rxt(k,268)* y(k,216) + rxt(k,99) + het_rates(k,78))* y(k,78) + prod(k,20) = 0._r8 + loss(k,21) = (rxt(k,291)* y(k,216) +rxt(k,286)* y(k,220) + rxt(k,101) & + + het_rates(k,82))* y(k,82) + prod(k,21) = 0._r8 + loss(k,22) = (rxt(k,292)* y(k,216) +rxt(k,287)* y(k,220) + rxt(k,102) & + + het_rates(k,83))* y(k,83) + prod(k,22) = 0._r8 + loss(k,23) = (rxt(k,293)* y(k,216) +rxt(k,288)* y(k,220) + rxt(k,103) & + + het_rates(k,84))* y(k,84) + prod(k,23) = 0._r8 + loss(k,24) = ((rxt(k,206) +rxt(k,207))* y(k,216) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,24) = 0._r8 + loss(k,25) = ( + rxt(k,582) + het_rates(k,122))* y(k,122) + prod(k,25) = 0._r8 + loss(k,26) = ( + rxt(k,581) + het_rates(k,123))* y(k,123) + prod(k,26) = 0._r8 + loss(k,27) = ( + rxt(k,109) + het_rates(k,149))* y(k,149) + prod(k,27) = 0._r8 + loss(k,28) = ( + rxt(k,583) + het_rates(k,171))* y(k,171) + prod(k,28) = 0._r8 + loss(k,29) = ( + het_rates(k,186))* y(k,186) + prod(k,29) = 0._r8 + loss(k,30) = ( + het_rates(k,187))* y(k,187) + prod(k,30) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,123) = (rxt(k,396)* y(k,220) + rxt(k,20) + het_rates(k,1))* y(k,1) + prod(k,123) =rxt(k,399)*y(k,189)*y(k,124) + loss(k,124) = (rxt(k,400)* y(k,220) + rxt(k,21) + het_rates(k,2))* y(k,2) + prod(k,124) =rxt(k,397)*y(k,202)*y(k,189) + loss(k,1) = ( + het_rates(k,4))* y(k,4) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,5))* y(k,5) + prod(k,2) = 0._r8 + loss(k,153) = (rxt(k,479)* y(k,126) +rxt(k,480)* y(k,135) +rxt(k,481) & + * y(k,220) + het_rates(k,6))* y(k,6) + prod(k,153) = 0._r8 + loss(k,48) = (rxt(k,438)* y(k,220) + het_rates(k,7))* y(k,7) + prod(k,48) = 0._r8 + loss(k,84) = (rxt(k,441)* y(k,220) + rxt(k,22) + het_rates(k,8))* y(k,8) + prod(k,84) =rxt(k,439)*y(k,202)*y(k,190) + loss(k,49) = ( + rxt(k,23) + het_rates(k,9))* y(k,9) + prod(k,49) =.120_r8*rxt(k,438)*y(k,220)*y(k,7) + loss(k,85) = ( + rxt(k,24) + het_rates(k,10))* y(k,10) + prod(k,85) = (.100_r8*rxt(k,480)*y(k,6) +.100_r8*rxt(k,483)*y(k,110)) & + *y(k,135) + loss(k,95) = ( + rxt(k,25) + het_rates(k,11))* y(k,11) + prod(k,95) = (.500_r8*rxt(k,440)*y(k,190) +.200_r8*rxt(k,467)*y(k,227) + & + .060_r8*rxt(k,473)*y(k,229))*y(k,124) +.500_r8*rxt(k,22)*y(k,8) & + +rxt(k,23)*y(k,9) +.200_r8*rxt(k,71)*y(k,179) +.060_r8*rxt(k,73) & + *y(k,183) + loss(k,70) = ( + rxt(k,26) + het_rates(k,12))* y(k,12) + prod(k,70) = (.200_r8*rxt(k,467)*y(k,227) +.200_r8*rxt(k,473)*y(k,229)) & + *y(k,124) +.200_r8*rxt(k,71)*y(k,179) +.200_r8*rxt(k,73)*y(k,183) + loss(k,118) = ( + rxt(k,27) + het_rates(k,13))* y(k,13) + prod(k,118) = (.200_r8*rxt(k,467)*y(k,227) +.150_r8*rxt(k,473)*y(k,229)) & + *y(k,124) +rxt(k,47)*y(k,94) +rxt(k,57)*y(k,116) +.200_r8*rxt(k,71) & + *y(k,179) +.150_r8*rxt(k,73)*y(k,183) + loss(k,76) = ( + rxt(k,28) + het_rates(k,14))* y(k,14) + prod(k,76) =.210_r8*rxt(k,473)*y(k,229)*y(k,124) +.210_r8*rxt(k,73)*y(k,183) + loss(k,62) = (rxt(k,401)* y(k,220) + het_rates(k,15))* y(k,15) + prod(k,62) = (.050_r8*rxt(k,480)*y(k,6) +.050_r8*rxt(k,483)*y(k,110)) & + *y(k,135) + loss(k,82) = (rxt(k,367)* y(k,126) +rxt(k,368)* y(k,220) + het_rates(k,16)) & + * y(k,16) + prod(k,82) = 0._r8 + loss(k,184) = (rxt(k,250)* y(k,42) +rxt(k,252)* y(k,135) +rxt(k,251) & + * y(k,202) + het_rates(k,17))* y(k,17) + prod(k,184) = (rxt(k,76) +2.000_r8*rxt(k,253)*y(k,19) +rxt(k,254)*y(k,59) + & + rxt(k,255)*y(k,59) +rxt(k,258)*y(k,124) +rxt(k,261)*y(k,133) + & + rxt(k,262)*y(k,220) +rxt(k,506)*y(k,150))*y(k,19) & + + (rxt(k,240)*y(k,34) +rxt(k,266)*y(k,35) + & + 3.000_r8*rxt(k,267)*y(k,55) +2.000_r8*rxt(k,268)*y(k,78) + & + 2.000_r8*rxt(k,289)*y(k,41) +rxt(k,290)*y(k,43) +rxt(k,269)*y(k,81)) & + *y(k,216) + (2.000_r8*rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) + & + 3.000_r8*rxt(k,285)*y(k,55) +rxt(k,264)*y(k,81))*y(k,220) & + + (2.000_r8*rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) + & + 3.000_r8*rxt(k,284)*y(k,55))*y(k,56) + (rxt(k,100) + & + rxt(k,263)*y(k,133))*y(k,81) +rxt(k,75)*y(k,18) +rxt(k,78)*y(k,20) & + +rxt(k,106)*y(k,91) + loss(k,63) = ( + rxt(k,75) + het_rates(k,18))* y(k,18) + prod(k,63) = (rxt(k,556)*y(k,91) +rxt(k,561)*y(k,91))*y(k,85) & + +rxt(k,256)*y(k,59)*y(k,19) + loss(k,198) = (2._r8*rxt(k,253)* y(k,19) + (rxt(k,254) +rxt(k,255) + & + rxt(k,256))* y(k,59) +rxt(k,258)* y(k,124) +rxt(k,259)* y(k,125) & + +rxt(k,261)* y(k,133) +rxt(k,506)* y(k,150) +rxt(k,257)* y(k,202) & + +rxt(k,262)* y(k,220) + rxt(k,76) + het_rates(k,19))* y(k,19) + prod(k,198) = (rxt(k,77) +rxt(k,260)*y(k,133))*y(k,20) +rxt(k,252)*y(k,135) & + *y(k,17) +rxt(k,270)*y(k,216)*y(k,81) +rxt(k,265)*y(k,133)*y(k,91) + loss(k,110) = (rxt(k,260)* y(k,133) + rxt(k,77) + rxt(k,78) + rxt(k,550) & + + rxt(k,553) + rxt(k,558) + het_rates(k,20))* y(k,20) + prod(k,110) =rxt(k,259)*y(k,125)*y(k,19) + loss(k,64) = (rxt(k,442)* y(k,220) + het_rates(k,22))* y(k,22) + prod(k,64) =rxt(k,29)*y(k,23) +rxt(k,445)*y(k,191)*y(k,124) + loss(k,79) = (rxt(k,444)* y(k,220) + rxt(k,29) + het_rates(k,23))* y(k,23) + prod(k,79) =rxt(k,443)*y(k,202)*y(k,191) + loss(k,71) = (rxt(k,316)* y(k,56) +rxt(k,317)* y(k,220) + het_rates(k,24)) & + * y(k,24) + prod(k,71) = 0._r8 + loss(k,112) = (rxt(k,318)* y(k,56) +rxt(k,319)* y(k,135) +rxt(k,344) & + * y(k,220) + het_rates(k,25))* y(k,25) + prod(k,112) = 0._r8 + loss(k,66) = (rxt(k,324)* y(k,220) + het_rates(k,26))* y(k,26) + prod(k,66) = (.400_r8*rxt(k,320)*y(k,192) +.200_r8*rxt(k,321)*y(k,196)) & + *y(k,192) + loss(k,80) = (rxt(k,325)* y(k,220) + rxt(k,30) + het_rates(k,27))* y(k,27) + prod(k,80) =rxt(k,322)*y(k,202)*y(k,192) + loss(k,72) = (rxt(k,326)* y(k,56) +rxt(k,327)* y(k,220) + het_rates(k,28)) & + * y(k,28) + prod(k,72) = 0._r8 + loss(k,160) = (rxt(k,347)* y(k,126) +rxt(k,348)* y(k,135) +rxt(k,365) & + * y(k,220) + het_rates(k,29))* y(k,29) + prod(k,160) =.130_r8*rxt(k,425)*y(k,135)*y(k,98) +.700_r8*rxt(k,56)*y(k,111) + loss(k,89) = (rxt(k,352)* y(k,220) + rxt(k,31) + het_rates(k,30))* y(k,30) + prod(k,89) =rxt(k,350)*y(k,202)*y(k,193) + loss(k,39) = (rxt(k,353)* y(k,220) + het_rates(k,31))* y(k,31) + prod(k,39) = 0._r8 + loss(k,67) = (rxt(k,448)* y(k,220) + rxt(k,32) + het_rates(k,32))* y(k,32) + prod(k,67) =rxt(k,446)*y(k,202)*y(k,194) + loss(k,193) = (rxt(k,250)* y(k,17) +rxt(k,214)* y(k,56) +rxt(k,295)* y(k,126) & + +rxt(k,296)* y(k,133) +rxt(k,294)* y(k,202) +rxt(k,297)* y(k,220) & + + rxt(k,33) + rxt(k,34) + het_rates(k,42))* y(k,42) + prod(k,193) = (rxt(k,221)*y(k,59) +2.000_r8*rxt(k,298)*y(k,196) + & + rxt(k,299)*y(k,196) +rxt(k,301)*y(k,124) + & + .700_r8*rxt(k,321)*y(k,192) +rxt(k,332)*y(k,195) + & + rxt(k,349)*y(k,193) +.800_r8*rxt(k,361)*y(k,224) + & + .880_r8*rxt(k,373)*y(k,206) +2.000_r8*rxt(k,382)*y(k,208) + & + 1.500_r8*rxt(k,406)*y(k,204) +.750_r8*rxt(k,411)*y(k,205) + & + .800_r8*rxt(k,420)*y(k,101) +.800_r8*rxt(k,431)*y(k,228) + & + .750_r8*rxt(k,485)*y(k,215) +.930_r8*rxt(k,490)*y(k,225) + & + .950_r8*rxt(k,495)*y(k,226))*y(k,196) & + + (.500_r8*rxt(k,338)*y(k,201) +rxt(k,359)*y(k,223) + & + rxt(k,363)*y(k,224) +.500_r8*rxt(k,369)*y(k,199) + & + .250_r8*rxt(k,376)*y(k,206) +rxt(k,385)*y(k,208) + & + .100_r8*rxt(k,398)*y(k,189) +.920_r8*rxt(k,408)*y(k,204) + & + .250_r8*rxt(k,433)*y(k,228) +.340_r8*rxt(k,492)*y(k,225) + & + .320_r8*rxt(k,497)*y(k,226))*y(k,124) + (rxt(k,302)*y(k,52) + & + .300_r8*rxt(k,303)*y(k,53) +.500_r8*rxt(k,336)*y(k,51) + & + .800_r8*rxt(k,341)*y(k,74) +rxt(k,343)*y(k,139) + & + .500_r8*rxt(k,391)*y(k,109) +.400_r8*rxt(k,396)*y(k,1) + & + .300_r8*rxt(k,416)*y(k,99) +.680_r8*rxt(k,501)*y(k,178))*y(k,220) & + + (rxt(k,319)*y(k,25) +.500_r8*rxt(k,348)*y(k,29) + & + .120_r8*rxt(k,378)*y(k,105) +.600_r8*rxt(k,392)*y(k,111) + & + .910_r8*rxt(k,425)*y(k,98) +.340_r8*rxt(k,480)*y(k,6) + & + .340_r8*rxt(k,483)*y(k,110))*y(k,135) + (.500_r8*rxt(k,367)*y(k,16) + & + .250_r8*rxt(k,375)*y(k,206) +rxt(k,386)*y(k,208) + & + rxt(k,409)*y(k,204))*y(k,126) + (.250_r8*rxt(k,372)*y(k,206) + & + rxt(k,381)*y(k,208) +rxt(k,405)*y(k,204) + & + .250_r8*rxt(k,430)*y(k,228))*y(k,195) + (rxt(k,312)*y(k,216) + & + rxt(k,313)*y(k,216))*y(k,54) + (.150_r8*rxt(k,362)*y(k,224) + & + .450_r8*rxt(k,383)*y(k,208))*y(k,202) +.100_r8*rxt(k,20)*y(k,1) & + +.100_r8*rxt(k,21)*y(k,2) +rxt(k,39)*y(k,53) +rxt(k,44)*y(k,74) & + +.330_r8*rxt(k,46)*y(k,93) +rxt(k,48)*y(k,95) +.690_r8*rxt(k,50) & + *y(k,103) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,58)*y(k,127) +rxt(k,63) & + *y(k,146) +rxt(k,64)*y(k,147) +.375_r8*rxt(k,66)*y(k,174) & + +.400_r8*rxt(k,68)*y(k,176) +.680_r8*rxt(k,70)*y(k,178) & + +2.000_r8*rxt(k,339)*y(k,200) +rxt(k,309)*y(k,203) & + +2.000_r8*rxt(k,384)*y(k,208)*y(k,208) + loss(k,170) = (rxt(k,328)* y(k,126) +rxt(k,329)* y(k,220) + rxt(k,35) & + + het_rates(k,45))* y(k,45) + prod(k,170) = (rxt(k,323)*y(k,192) +.270_r8*rxt(k,351)*y(k,193) + & + rxt(k,359)*y(k,223) +rxt(k,369)*y(k,199) +rxt(k,388)*y(k,210) + & + .400_r8*rxt(k,398)*y(k,189))*y(k,124) + (rxt(k,324)*y(k,26) + & + .500_r8*rxt(k,325)*y(k,27) +.800_r8*rxt(k,396)*y(k,1))*y(k,220) & + + (.500_r8*rxt(k,348)*y(k,29) +.100_r8*rxt(k,392)*y(k,111))*y(k,135) & + + (1.600_r8*rxt(k,320)*y(k,192) +.800_r8*rxt(k,321)*y(k,196)) & + *y(k,192) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & + +rxt(k,367)*y(k,126)*y(k,16) +rxt(k,30)*y(k,27) +.330_r8*rxt(k,46) & + *y(k,93) +rxt(k,54)*y(k,108) +rxt(k,63)*y(k,146) & + +.200_r8*rxt(k,387)*y(k,210)*y(k,202) + loss(k,38) = (rxt(k,330)* y(k,220) + het_rates(k,47))* y(k,47) + prod(k,38) = 0._r8 + loss(k,156) = (rxt(k,366)* y(k,220) + rxt(k,36) + het_rates(k,48))* y(k,48) + prod(k,156) = (.820_r8*rxt(k,351)*y(k,193) +.500_r8*rxt(k,369)*y(k,199) + & + .250_r8*rxt(k,398)*y(k,189) +.270_r8*rxt(k,492)*y(k,225) + & + .040_r8*rxt(k,497)*y(k,226))*y(k,124) & + + (.820_r8*rxt(k,349)*y(k,193) +.150_r8*rxt(k,490)*y(k,225) + & + .025_r8*rxt(k,495)*y(k,226))*y(k,196) + (.250_r8*rxt(k,20) + & + .800_r8*rxt(k,396)*y(k,220))*y(k,1) + (.520_r8*rxt(k,480)*y(k,6) + & + .520_r8*rxt(k,483)*y(k,110))*y(k,135) + (.500_r8*rxt(k,70) + & + .500_r8*rxt(k,501)*y(k,220))*y(k,178) +.250_r8*rxt(k,21)*y(k,2) & + +.500_r8*rxt(k,367)*y(k,126)*y(k,16) +.820_r8*rxt(k,31)*y(k,30) & + +.170_r8*rxt(k,46)*y(k,93) +.300_r8*rxt(k,66)*y(k,174) & + +.050_r8*rxt(k,68)*y(k,176) + loss(k,175) = (rxt(k,354)* y(k,126) +rxt(k,355)* y(k,220) + rxt(k,37) & + + het_rates(k,49))* y(k,49) + prod(k,175) = (.250_r8*rxt(k,376)*y(k,206) +.050_r8*rxt(k,414)*y(k,205) + & + .250_r8*rxt(k,433)*y(k,228) +.170_r8*rxt(k,451)*y(k,197) + & + .170_r8*rxt(k,457)*y(k,209) +.400_r8*rxt(k,467)*y(k,227) + & + .540_r8*rxt(k,473)*y(k,229) +.510_r8*rxt(k,476)*y(k,230))*y(k,124) & + + (.250_r8*rxt(k,375)*y(k,206) +.050_r8*rxt(k,415)*y(k,205) + & + .250_r8*rxt(k,434)*y(k,228))*y(k,126) & + + (.500_r8*rxt(k,361)*y(k,224) +.240_r8*rxt(k,373)*y(k,206) + & + .100_r8*rxt(k,431)*y(k,228))*y(k,196) & + + (.880_r8*rxt(k,378)*y(k,105) +.500_r8*rxt(k,392)*y(k,111)) & + *y(k,135) + (.250_r8*rxt(k,372)*y(k,206) + & + .250_r8*rxt(k,430)*y(k,228))*y(k,195) & + + (.070_r8*rxt(k,450)*y(k,197) +.070_r8*rxt(k,456)*y(k,209)) & + *y(k,202) + (rxt(k,356)*y(k,95) +rxt(k,357)*y(k,127))*y(k,220) & + +.180_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +.400_r8*rxt(k,71) & + *y(k,179) +.540_r8*rxt(k,73)*y(k,183) +.510_r8*rxt(k,74)*y(k,185) + loss(k,111) = (rxt(k,335)* y(k,220) + het_rates(k,50))* y(k,50) + prod(k,111) = (.100_r8*rxt(k,332)*y(k,196) +.150_r8*rxt(k,333)*y(k,202)) & + *y(k,195) +.120_r8*rxt(k,348)*y(k,135)*y(k,29) & + +.150_r8*rxt(k,383)*y(k,208)*y(k,202) + loss(k,105) = (rxt(k,336)* y(k,220) + rxt(k,38) + het_rates(k,51))* y(k,51) + prod(k,105) = (.400_r8*rxt(k,333)*y(k,195) +.400_r8*rxt(k,383)*y(k,208)) & + *y(k,202) + loss(k,140) = (rxt(k,302)* y(k,220) + het_rates(k,52))* y(k,52) + prod(k,140) = (rxt(k,299)*y(k,196) +.300_r8*rxt(k,321)*y(k,192) + & + .500_r8*rxt(k,361)*y(k,224) +.250_r8*rxt(k,373)*y(k,206) + & + .250_r8*rxt(k,406)*y(k,204) +.250_r8*rxt(k,411)*y(k,205) + & + .200_r8*rxt(k,420)*y(k,101) +.300_r8*rxt(k,431)*y(k,228) + & + .250_r8*rxt(k,485)*y(k,215) +.250_r8*rxt(k,490)*y(k,225) + & + .250_r8*rxt(k,495)*y(k,226))*y(k,196) + loss(k,90) = (rxt(k,303)* y(k,220) + rxt(k,39) + het_rates(k,53))* y(k,53) + prod(k,90) =rxt(k,300)*y(k,202)*y(k,196) + loss(k,188) = (rxt(k,326)* y(k,28) +rxt(k,277)* y(k,41) +rxt(k,214)* y(k,42) & + +rxt(k,279)* y(k,43) +rxt(k,282)* y(k,46) +rxt(k,215)* y(k,54) & + +rxt(k,284)* y(k,55) +rxt(k,227)* y(k,60) +rxt(k,216)* y(k,77) & + +rxt(k,217)* y(k,79) +rxt(k,236)* y(k,92) +rxt(k,220)* y(k,135) & + + (rxt(k,218) +rxt(k,219))* y(k,202) + het_rates(k,56))* y(k,56) + prod(k,188) = (4.000_r8*rxt(k,239)*y(k,33) +rxt(k,240)*y(k,34) + & + 2.000_r8*rxt(k,241)*y(k,36) +2.000_r8*rxt(k,242)*y(k,37) + & + 2.000_r8*rxt(k,243)*y(k,38) +rxt(k,244)*y(k,39) + & + 2.000_r8*rxt(k,245)*y(k,40) +rxt(k,291)*y(k,82) +rxt(k,292)*y(k,83) + & + rxt(k,293)*y(k,84) +rxt(k,246)*y(k,85) +rxt(k,276)*y(k,65))*y(k,216) & + + (rxt(k,94) +rxt(k,221)*y(k,196) +2.000_r8*rxt(k,222)*y(k,59) + & + rxt(k,224)*y(k,59) +rxt(k,226)*y(k,124) +rxt(k,231)*y(k,133) + & + rxt(k,232)*y(k,220) +rxt(k,255)*y(k,19) +rxt(k,507)*y(k,150))*y(k,59) & + + (3.000_r8*rxt(k,281)*y(k,44) +rxt(k,283)*y(k,46) + & + rxt(k,286)*y(k,82) +rxt(k,287)*y(k,83) +rxt(k,288)*y(k,84) + & + rxt(k,235)*y(k,85))*y(k,220) + (rxt(k,104) +rxt(k,234)*y(k,133)) & + *y(k,85) +rxt(k,75)*y(k,18) +2.000_r8*rxt(k,92)*y(k,57) & + +2.000_r8*rxt(k,93)*y(k,58) +rxt(k,95)*y(k,60) +rxt(k,98)*y(k,65) & + +rxt(k,107)*y(k,92) + loss(k,47) = ( + rxt(k,92) + het_rates(k,57))* y(k,57) + prod(k,47) = (rxt(k,549)*y(k,92) +rxt(k,554)*y(k,60) +rxt(k,555)*y(k,92) + & + rxt(k,559)*y(k,60) +rxt(k,560)*y(k,92) +rxt(k,564)*y(k,60))*y(k,85) & + +rxt(k,227)*y(k,60)*y(k,56) +rxt(k,223)*y(k,59)*y(k,59) + loss(k,36) = ( + rxt(k,93) + rxt(k,249) + het_rates(k,58))* y(k,58) + prod(k,36) =rxt(k,248)*y(k,59)*y(k,59) + loss(k,200) = ((rxt(k,254) +rxt(k,255) +rxt(k,256))* y(k,19) & + + 2._r8*(rxt(k,222) +rxt(k,223) +rxt(k,224) +rxt(k,248))* y(k,59) & + +rxt(k,226)* y(k,124) +rxt(k,228)* y(k,125) +rxt(k,231)* y(k,133) & + +rxt(k,507)* y(k,150) +rxt(k,221)* y(k,196) +rxt(k,225)* y(k,202) & + + (rxt(k,232) +rxt(k,233))* y(k,220) + rxt(k,94) + het_rates(k,59)) & + * y(k,59) + prod(k,200) = (rxt(k,219)*y(k,202) +rxt(k,220)*y(k,135) +rxt(k,236)*y(k,92)) & + *y(k,56) + (rxt(k,96) +rxt(k,229)*y(k,133))*y(k,60) & + + (rxt(k,237)*y(k,133) +rxt(k,238)*y(k,220))*y(k,92) + (rxt(k,108) + & + rxt(k,512)*y(k,150))*y(k,136) +2.000_r8*rxt(k,249)*y(k,58) & + +rxt(k,247)*y(k,216)*y(k,85) + loss(k,157) = (rxt(k,227)* y(k,56) + (rxt(k,554) +rxt(k,559) +rxt(k,564)) & + * y(k,85) +rxt(k,229)* y(k,133) +rxt(k,230)* y(k,220) + rxt(k,95) & + + rxt(k,96) + rxt(k,552) + rxt(k,557) + rxt(k,563) & + + het_rates(k,60))* y(k,60) + prod(k,157) =rxt(k,228)*y(k,125)*y(k,59) + loss(k,165) = ((rxt(k,305) +rxt(k,315))* y(k,220) + het_rates(k,62))* y(k,62) + prod(k,165) = (rxt(k,33) +rxt(k,34) +rxt(k,214)*y(k,56) +rxt(k,250)*y(k,17) + & + rxt(k,295)*y(k,126) +rxt(k,296)*y(k,133) +rxt(k,297)*y(k,220)) & + *y(k,42) + (.630_r8*rxt(k,319)*y(k,25) +.560_r8*rxt(k,348)*y(k,29) + & + .650_r8*rxt(k,378)*y(k,105) +.560_r8*rxt(k,392)*y(k,111) + & + .620_r8*rxt(k,425)*y(k,98) +.230_r8*rxt(k,480)*y(k,6) + & + .230_r8*rxt(k,483)*y(k,110))*y(k,135) & + + (.220_r8*rxt(k,376)*y(k,206) +.250_r8*rxt(k,433)*y(k,228) + & + .170_r8*rxt(k,451)*y(k,197) +.400_r8*rxt(k,454)*y(k,207) + & + .350_r8*rxt(k,457)*y(k,209) +.225_r8*rxt(k,492)*y(k,225))*y(k,124) & + + (.350_r8*rxt(k,317)*y(k,24) +rxt(k,342)*y(k,75) + & + rxt(k,355)*y(k,49) +.700_r8*rxt(k,501)*y(k,178) +rxt(k,503)*y(k,137)) & + *y(k,220) + (rxt(k,354)*y(k,49) +.220_r8*rxt(k,375)*y(k,206) + & + .500_r8*rxt(k,434)*y(k,228))*y(k,126) & + + (.110_r8*rxt(k,373)*y(k,206) +.200_r8*rxt(k,431)*y(k,228) + & + .125_r8*rxt(k,490)*y(k,225))*y(k,196) & + + (.070_r8*rxt(k,450)*y(k,197) +.160_r8*rxt(k,453)*y(k,207) + & + .140_r8*rxt(k,456)*y(k,209))*y(k,202) + (rxt(k,137) + & + rxt(k,502)*y(k,133))*y(k,137) + (.220_r8*rxt(k,372)*y(k,206) + & + .250_r8*rxt(k,430)*y(k,228))*y(k,195) +1.500_r8*rxt(k,23)*y(k,9) & + +.450_r8*rxt(k,24)*y(k,10) +.600_r8*rxt(k,27)*y(k,13) +rxt(k,28) & + *y(k,14) +rxt(k,35)*y(k,45) +rxt(k,282)*y(k,56)*y(k,46) +rxt(k,37) & + *y(k,49) +rxt(k,577)*y(k,221)*y(k,63) +rxt(k,44)*y(k,74) & + +2.000_r8*rxt(k,45)*y(k,75) +.330_r8*rxt(k,46)*y(k,93) & + +1.340_r8*rxt(k,52)*y(k,105) +.700_r8*rxt(k,56)*y(k,111) & + +1.500_r8*rxt(k,65)*y(k,173) +.250_r8*rxt(k,66)*y(k,174) +rxt(k,69) & + *y(k,177) +1.700_r8*rxt(k,70)*y(k,178) + loss(k,40) = (rxt(k,275)* y(k,216) + rxt(k,97) + het_rates(k,64))* y(k,64) + prod(k,40) = (rxt(k,240)*y(k,34) +rxt(k,242)*y(k,37) + & + 2.000_r8*rxt(k,243)*y(k,38) +2.000_r8*rxt(k,244)*y(k,39) + & + rxt(k,245)*y(k,40) +rxt(k,266)*y(k,35) +2.000_r8*rxt(k,268)*y(k,78) + & + rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,216) & + + (rxt(k,287)*y(k,83) +rxt(k,288)*y(k,84))*y(k,220) + loss(k,51) = (rxt(k,276)* y(k,216) + rxt(k,98) + het_rates(k,65))* y(k,65) + prod(k,51) = (rxt(k,241)*y(k,36) +rxt(k,242)*y(k,37) +rxt(k,291)*y(k,82)) & + *y(k,216) +rxt(k,286)*y(k,220)*y(k,82) + loss(k,54) = (rxt(k,449)* y(k,220) + het_rates(k,66))* y(k,66) + prod(k,54) =.180_r8*rxt(k,469)*y(k,220)*y(k,180) + loss(k,69) = (rxt(k,516)* y(k,126) + (rxt(k,517) +rxt(k,519))* y(k,220) & + + het_rates(k,67))* y(k,67) + prod(k,69) = 0._r8 + loss(k,3) = ( + het_rates(k,68))* y(k,68) + prod(k,3) = 0._r8 + loss(k,4) = ( + het_rates(k,69))* y(k,69) + prod(k,4) = 0._r8 + loss(k,5) = ( + het_rates(k,70))* y(k,70) + prod(k,5) = 0._r8 + loss(k,41) = ( + rxt(k,43) + het_rates(k,72))* y(k,72) + prod(k,41) =rxt(k,337)*y(k,202)*y(k,201) + loss(k,136) = (rxt(k,271)* y(k,54) +rxt(k,272)* y(k,77) +rxt(k,274)* y(k,89) & + +rxt(k,273)* y(k,231) + het_rates(k,73))* y(k,73) + prod(k,136) = (rxt(k,244)*y(k,39) +rxt(k,266)*y(k,35) + & + 2.000_r8*rxt(k,275)*y(k,64) +rxt(k,276)*y(k,65))*y(k,216) & + +2.000_r8*rxt(k,97)*y(k,64) +rxt(k,98)*y(k,65) +rxt(k,105)*y(k,88) + loss(k,161) = (rxt(k,341)* y(k,220) + rxt(k,44) + het_rates(k,74))* y(k,74) + prod(k,161) = (.530_r8*rxt(k,376)*y(k,206) +.050_r8*rxt(k,414)*y(k,205) + & + .250_r8*rxt(k,433)*y(k,228) +.225_r8*rxt(k,492)*y(k,225))*y(k,124) & + + (.530_r8*rxt(k,375)*y(k,206) +.050_r8*rxt(k,415)*y(k,205) + & + .250_r8*rxt(k,434)*y(k,228))*y(k,126) & + + (.260_r8*rxt(k,373)*y(k,206) +.100_r8*rxt(k,431)*y(k,228) + & + .125_r8*rxt(k,490)*y(k,225))*y(k,196) + (.700_r8*rxt(k,416)*y(k,99) + & + .500_r8*rxt(k,417)*y(k,100) +rxt(k,428)*y(k,115))*y(k,220) & + + (.530_r8*rxt(k,372)*y(k,206) +.250_r8*rxt(k,430)*y(k,228)) & + *y(k,195) +.330_r8*rxt(k,46)*y(k,93) +rxt(k,340)*y(k,200)*y(k,134) & + +.250_r8*rxt(k,66)*y(k,174) + loss(k,149) = (rxt(k,342)* y(k,220) + rxt(k,45) + rxt(k,520) & + + het_rates(k,75))* y(k,75) + prod(k,149) = (.050_r8*rxt(k,414)*y(k,205) +.250_r8*rxt(k,433)*y(k,228) + & + rxt(k,440)*y(k,190) +.400_r8*rxt(k,454)*y(k,207) + & + .170_r8*rxt(k,457)*y(k,209) +.700_r8*rxt(k,460)*y(k,222) + & + .600_r8*rxt(k,467)*y(k,227) +.340_r8*rxt(k,473)*y(k,229) + & + .170_r8*rxt(k,476)*y(k,230))*y(k,124) + (.650_r8*rxt(k,317)*y(k,24) + & + .200_r8*rxt(k,341)*y(k,74) +rxt(k,429)*y(k,116))*y(k,220) & + + (.250_r8*rxt(k,430)*y(k,195) +.100_r8*rxt(k,431)*y(k,196) + & + .250_r8*rxt(k,434)*y(k,126))*y(k,228) & + + (.160_r8*rxt(k,453)*y(k,207) +.070_r8*rxt(k,456)*y(k,209)) & + *y(k,202) +rxt(k,22)*y(k,8) +.130_r8*rxt(k,24)*y(k,10) & + +.050_r8*rxt(k,415)*y(k,205)*y(k,126) +.700_r8*rxt(k,62)*y(k,143) & + +.600_r8*rxt(k,71)*y(k,179) +.340_r8*rxt(k,73)*y(k,183) & + +.170_r8*rxt(k,74)*y(k,185) + loss(k,195) = (rxt(k,175)* y(k,134) +rxt(k,178)* y(k,135) + (rxt(k,172) + & + rxt(k,173) +rxt(k,174))* y(k,202) + het_rates(k,76))* y(k,76) + prod(k,195) = (rxt(k,179)*y(k,77) +rxt(k,182)*y(k,133) +rxt(k,202)*y(k,112) + & + rxt(k,297)*y(k,42) +rxt(k,315)*y(k,62) +rxt(k,503)*y(k,137) + & + rxt(k,508)*y(k,148) +rxt(k,513)*y(k,150))*y(k,220) & + + (rxt(k,153)*y(k,216) +rxt(k,170)*y(k,133) +rxt(k,216)*y(k,56) + & + rxt(k,272)*y(k,73))*y(k,77) + (rxt(k,312)*y(k,54) + & + rxt(k,247)*y(k,85) +rxt(k,270)*y(k,81))*y(k,216) & + + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,231) +2.000_r8*rxt(k,33)*y(k,42) & + +rxt(k,39)*y(k,53) +rxt(k,100)*y(k,81) +rxt(k,104)*y(k,85) & + +rxt(k,105)*y(k,88) + loss(k,172) = (rxt(k,216)* y(k,56) +rxt(k,272)* y(k,73) +rxt(k,170)* y(k,133) & + +rxt(k,153)* y(k,216) +rxt(k,179)* y(k,220) + het_rates(k,77)) & + * y(k,77) + prod(k,172) =rxt(k,34)*y(k,42) +rxt(k,313)*y(k,216)*y(k,54) & + +rxt(k,172)*y(k,202)*y(k,76) +rxt(k,1)*y(k,231) + loss(k,115) = (rxt(k,217)* y(k,56) +rxt(k,171)* y(k,133) +rxt(k,180) & + * y(k,220) + rxt(k,4) + het_rates(k,79))* y(k,79) + prod(k,115) = (.500_r8*rxt(k,521) +rxt(k,186)*y(k,202))*y(k,202) & + +rxt(k,185)*y(k,220)*y(k,220) + loss(k,42) = ( + rxt(k,136) + het_rates(k,80))* y(k,80) + prod(k,42) =rxt(k,515)*y(k,231)*y(k,152) + loss(k,145) = (rxt(k,263)* y(k,133) + (rxt(k,269) +rxt(k,270))* y(k,216) & + +rxt(k,264)* y(k,220) + rxt(k,100) + het_rates(k,81))* y(k,81) + prod(k,145) = (rxt(k,250)*y(k,42) +rxt(k,251)*y(k,202))*y(k,17) + loss(k,183) = ((rxt(k,554) +rxt(k,559) +rxt(k,564))* y(k,60) + (rxt(k,556) + & + rxt(k,561))* y(k,91) + (rxt(k,549) +rxt(k,555) +rxt(k,560))* y(k,92) & + +rxt(k,234)* y(k,133) + (rxt(k,246) +rxt(k,247))* y(k,216) & + +rxt(k,235)* y(k,220) + rxt(k,104) + het_rates(k,85))* y(k,85) + prod(k,183) = (rxt(k,215)*y(k,54) +rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) + & + 2.000_r8*rxt(k,282)*y(k,46) +rxt(k,284)*y(k,55) +rxt(k,214)*y(k,42) + & + rxt(k,216)*y(k,77) +rxt(k,217)*y(k,79) +rxt(k,218)*y(k,202) + & + rxt(k,236)*y(k,92) +rxt(k,326)*y(k,28))*y(k,56) +rxt(k,233)*y(k,220) & + *y(k,59) + loss(k,52) = (rxt(k,314)* y(k,216) +rxt(k,306)* y(k,220) + het_rates(k,86)) & + * y(k,86) + prod(k,52) = 0._r8 + loss(k,141) = (rxt(k,307)* y(k,220) + het_rates(k,87))* y(k,87) + prod(k,141) = (.370_r8*rxt(k,319)*y(k,25) +.120_r8*rxt(k,348)*y(k,29) + & + .330_r8*rxt(k,378)*y(k,105) +.120_r8*rxt(k,392)*y(k,111) + & + .110_r8*rxt(k,425)*y(k,98) +.050_r8*rxt(k,480)*y(k,6) + & + .050_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,308)*y(k,202) + & + rxt(k,310)*y(k,124))*y(k,203) +.350_r8*rxt(k,317)*y(k,220)*y(k,24) + loss(k,59) = ( + rxt(k,105) + het_rates(k,88))* y(k,88) + prod(k,59) = (rxt(k,271)*y(k,54) +rxt(k,272)*y(k,77) +rxt(k,273)*y(k,231) + & + rxt(k,274)*y(k,89))*y(k,73) + loss(k,196) = (rxt(k,274)* y(k,73) +rxt(k,211)* y(k,220) + rxt(k,9) & + + het_rates(k,89))* y(k,89) + prod(k,196) = (rxt(k,552) +rxt(k,557) +rxt(k,563) +rxt(k,554)*y(k,85) + & + rxt(k,559)*y(k,85) +rxt(k,564)*y(k,85))*y(k,60) + (rxt(k,530) + & + rxt(k,295)*y(k,42) +rxt(k,328)*y(k,45) +rxt(k,354)*y(k,49) + & + rxt(k,516)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,525) + & + 2.000_r8*rxt(k,548) +2.000_r8*rxt(k,551) +2.000_r8*rxt(k,562)) & + *y(k,114) + (rxt(k,550) +rxt(k,553) +rxt(k,558))*y(k,20) & + + (.500_r8*rxt(k,529) +rxt(k,210)*y(k,220))*y(k,125) +rxt(k,522) & + *y(k,93) +rxt(k,523)*y(k,99) +rxt(k,524)*y(k,100) +rxt(k,526) & + *y(k,115) +rxt(k,527)*y(k,116) +rxt(k,531)*y(k,128) +rxt(k,532) & + *y(k,138) +rxt(k,533)*y(k,175) + loss(k,99) = (rxt(k,187)* y(k,220) + rxt(k,10) + rxt(k,11) + rxt(k,212) & + + het_rates(k,90))* y(k,90) + prod(k,99) =rxt(k,208)*y(k,202)*y(k,125) + loss(k,134) = ((rxt(k,556) +rxt(k,561))* y(k,85) +rxt(k,265)* y(k,133) & + + rxt(k,106) + het_rates(k,91))* y(k,91) + prod(k,134) = (rxt(k,550) +rxt(k,553) +rxt(k,558))*y(k,20) & + +rxt(k,257)*y(k,202)*y(k,19) + loss(k,146) = (rxt(k,236)* y(k,56) + (rxt(k,549) +rxt(k,555) +rxt(k,560)) & + * y(k,85) +rxt(k,237)* y(k,133) +rxt(k,238)* y(k,220) + rxt(k,107) & + + het_rates(k,92))* y(k,92) + prod(k,146) = (rxt(k,552) +rxt(k,557) +rxt(k,563) +rxt(k,230)*y(k,220)) & + *y(k,60) +rxt(k,225)*y(k,202)*y(k,59) + loss(k,162) = (rxt(k,371)* y(k,220) + rxt(k,46) + rxt(k,522) & + + het_rates(k,93))* y(k,93) + prod(k,162) = (rxt(k,370)*y(k,199) +rxt(k,377)*y(k,206))*y(k,124) & + + (.300_r8*rxt(k,416)*y(k,99) +.500_r8*rxt(k,417)*y(k,100))*y(k,220) + loss(k,60) = (rxt(k,402)* y(k,220) + rxt(k,47) + het_rates(k,94))* y(k,94) + prod(k,60) =rxt(k,413)*y(k,205) + loss(k,164) = (rxt(k,356)* y(k,220) + rxt(k,48) + het_rates(k,95))* y(k,95) + prod(k,164) = (.220_r8*rxt(k,372)*y(k,195) +.230_r8*rxt(k,373)*y(k,196) + & + .220_r8*rxt(k,375)*y(k,126) +.220_r8*rxt(k,376)*y(k,124))*y(k,206) & + + (.500_r8*rxt(k,360)*y(k,146) +.500_r8*rxt(k,391)*y(k,109) + & + .700_r8*rxt(k,416)*y(k,99) +.500_r8*rxt(k,417)*y(k,100))*y(k,220) & + + (.250_r8*rxt(k,430)*y(k,195) +.100_r8*rxt(k,431)*y(k,196) + & + .250_r8*rxt(k,433)*y(k,124) +.250_r8*rxt(k,434)*y(k,126))*y(k,228) & + + (.050_r8*rxt(k,414)*y(k,124) +.050_r8*rxt(k,415)*y(k,126)) & + *y(k,205) +.170_r8*rxt(k,46)*y(k,93) +.200_r8*rxt(k,361)*y(k,224) & + *y(k,196) + loss(k,73) = (rxt(k,403)* y(k,220) + het_rates(k,96))* y(k,96) + prod(k,73) = (rxt(k,410)*y(k,195) +.750_r8*rxt(k,411)*y(k,196) + & + .870_r8*rxt(k,414)*y(k,124) +.950_r8*rxt(k,415)*y(k,126))*y(k,205) + loss(k,43) = (rxt(k,404)* y(k,220) + het_rates(k,97))* y(k,97) + prod(k,43) =.600_r8*rxt(k,427)*y(k,220)*y(k,103) + loss(k,148) = (rxt(k,418)* y(k,126) +rxt(k,425)* y(k,135) +rxt(k,426) & + * y(k,220) + het_rates(k,98))* y(k,98) + prod(k,148) = 0._r8 + loss(k,119) = (rxt(k,416)* y(k,220) + rxt(k,523) + het_rates(k,99))* y(k,99) + prod(k,119) =.080_r8*rxt(k,408)*y(k,204)*y(k,124) + loss(k,108) = (rxt(k,417)* y(k,220) + rxt(k,524) + het_rates(k,100)) & + * y(k,100) + prod(k,108) =.080_r8*rxt(k,414)*y(k,205)*y(k,124) + loss(k,173) = (rxt(k,422)* y(k,124) +rxt(k,423)* y(k,126) +rxt(k,419) & + * y(k,195) +rxt(k,420)* y(k,196) +rxt(k,421)* y(k,202) & + + het_rates(k,101))* y(k,101) + prod(k,173) =rxt(k,418)*y(k,126)*y(k,98) + loss(k,88) = (rxt(k,424)* y(k,220) + rxt(k,49) + het_rates(k,102))* y(k,102) + prod(k,88) =rxt(k,421)*y(k,202)*y(k,101) + loss(k,127) = (rxt(k,427)* y(k,220) + rxt(k,50) + het_rates(k,103))* y(k,103) + prod(k,127) = (rxt(k,407)*y(k,204) +rxt(k,412)*y(k,205))*y(k,202) +rxt(k,49) & + *y(k,102) + loss(k,34) = (rxt(k,541)* y(k,220) + het_rates(k,104))* y(k,104) + prod(k,34) = 0._r8 + loss(k,174) = (rxt(k,378)* y(k,135) +rxt(k,379)* y(k,220) + rxt(k,51) & + + rxt(k,52) + het_rates(k,105))* y(k,105) + prod(k,174) = (.390_r8*rxt(k,405)*y(k,195) +.310_r8*rxt(k,406)*y(k,196) + & + .360_r8*rxt(k,408)*y(k,124) +.400_r8*rxt(k,409)*y(k,126))*y(k,204) & + +.300_r8*rxt(k,425)*y(k,135)*y(k,98) +.288_r8*rxt(k,50)*y(k,103) + loss(k,74) = (rxt(k,380)* y(k,220) + het_rates(k,106))* y(k,106) + prod(k,74) =rxt(k,374)*y(k,206)*y(k,202) + loss(k,107) = (rxt(k,389)* y(k,220) + rxt(k,53) + het_rates(k,107))* y(k,107) + prod(k,107) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & + +.800_r8*rxt(k,398)*y(k,189)*y(k,124) + loss(k,75) = (rxt(k,390)* y(k,220) + rxt(k,54) + het_rates(k,108))* y(k,108) + prod(k,75) =.800_r8*rxt(k,387)*y(k,210)*y(k,202) + loss(k,114) = (rxt(k,391)* y(k,220) + rxt(k,55) + rxt(k,395) & + + het_rates(k,109))* y(k,109) + prod(k,114) =rxt(k,394)*y(k,208)*y(k,125) + loss(k,151) = (rxt(k,482)* y(k,126) +rxt(k,483)* y(k,135) +rxt(k,484) & + * y(k,220) + het_rates(k,110))* y(k,110) + prod(k,151) = 0._r8 + loss(k,179) = (rxt(k,392)* y(k,135) +rxt(k,393)* y(k,220) + rxt(k,56) & + + het_rates(k,111))* y(k,111) + prod(k,179) = (.610_r8*rxt(k,405)*y(k,195) +.440_r8*rxt(k,406)*y(k,196) + & + .560_r8*rxt(k,408)*y(k,124) +.600_r8*rxt(k,409)*y(k,126))*y(k,204) & + +.200_r8*rxt(k,425)*y(k,135)*y(k,98) +.402_r8*rxt(k,50)*y(k,103) + loss(k,144) = (rxt(k,190)* y(k,124) + (rxt(k,191) +rxt(k,192) +rxt(k,193)) & + * y(k,125) +rxt(k,194)* y(k,134) +rxt(k,574)* y(k,219) +rxt(k,202) & + * y(k,220) + rxt(k,111) + het_rates(k,112))* y(k,112) + prod(k,144) = (rxt(k,188)*y(k,211) +rxt(k,571)*y(k,214))*y(k,133) & + + (.200_r8*rxt(k,565)*y(k,213) +1.100_r8*rxt(k,567)*y(k,212)) & + *y(k,198) +rxt(k,15)*y(k,124) +rxt(k,572)*y(k,214)*y(k,134) & + +rxt(k,578)*y(k,221) + loss(k,68) = ( + rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,548) & + + rxt(k,551) + rxt(k,562) + het_rates(k,114))* y(k,114) + prod(k,68) =rxt(k,209)*y(k,126)*y(k,125) + loss(k,83) = (rxt(k,428)* y(k,220) + rxt(k,526) + het_rates(k,115))* y(k,115) + prod(k,83) =.200_r8*rxt(k,420)*y(k,196)*y(k,101) + loss(k,159) = (rxt(k,429)* y(k,220) + rxt(k,57) + rxt(k,527) & + + het_rates(k,116))* y(k,116) + prod(k,159) = (rxt(k,419)*y(k,195) +.800_r8*rxt(k,420)*y(k,196) + & + rxt(k,422)*y(k,124) +rxt(k,423)*y(k,126))*y(k,101) + loss(k,6) = ( + het_rates(k,117))* y(k,117) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,118))* y(k,118) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,119))* y(k,119) + prod(k,8) = 0._r8 + loss(k,37) = (rxt(k,518)* y(k,220) + het_rates(k,120))* y(k,120) + prod(k,37) = 0._r8 + loss(k,9) = ( + rxt(k,528) + het_rates(k,121))* y(k,121) + prod(k,9) = 0._r8 + loss(k,187) = (rxt(k,258)* y(k,19) +rxt(k,226)* y(k,59) +rxt(k,422)* y(k,101) & + +rxt(k,190)* y(k,112) +rxt(k,199)* y(k,126) +rxt(k,205)* y(k,133) & + +rxt(k,204)* y(k,135) +rxt(k,437)* y(k,188) + (rxt(k,398) + & + rxt(k,399))* y(k,189) +rxt(k,440)* y(k,190) +rxt(k,445)* y(k,191) & + +rxt(k,323)* y(k,192) +rxt(k,351)* y(k,193) +rxt(k,447)* y(k,194) & + +rxt(k,334)* y(k,195) +rxt(k,301)* y(k,196) +rxt(k,451)* y(k,197) & + + (rxt(k,369) +rxt(k,370))* y(k,199) +rxt(k,338)* y(k,201) & + +rxt(k,203)* y(k,202) +rxt(k,310)* y(k,203) +rxt(k,408)* y(k,204) & + +rxt(k,414)* y(k,205) + (rxt(k,376) +rxt(k,377))* y(k,206) & + +rxt(k,454)* y(k,207) +rxt(k,385)* y(k,208) +rxt(k,457)* y(k,209) & + +rxt(k,388)* y(k,210) +rxt(k,487)* y(k,215) +rxt(k,576)* y(k,219) & + +rxt(k,460)* y(k,222) +rxt(k,359)* y(k,223) +rxt(k,363)* y(k,224) & + +rxt(k,492)* y(k,225) +rxt(k,497)* y(k,226) +rxt(k,467)* y(k,227) & + +rxt(k,433)* y(k,228) +rxt(k,473)* y(k,229) +rxt(k,476)* y(k,230) & + + rxt(k,15) + rxt(k,16) + het_rates(k,124))* y(k,124) + prod(k,187) = (rxt(k,17) +.500_r8*rxt(k,529) +2.000_r8*rxt(k,192)*y(k,112) + & + rxt(k,195)*y(k,133) +rxt(k,509)*y(k,150))*y(k,125) & + + (rxt(k,194)*y(k,134) +rxt(k,202)*y(k,220))*y(k,112) & + +2.000_r8*rxt(k,206)*y(k,216)*y(k,113) +rxt(k,14)*y(k,114) & + +rxt(k,19)*y(k,126) +rxt(k,189)*y(k,211)*y(k,134) +rxt(k,575) & + *y(k,219) + loss(k,197) = (rxt(k,259)* y(k,19) +rxt(k,228)* y(k,59) + (rxt(k,191) + & + rxt(k,192) +rxt(k,193))* y(k,112) +rxt(k,209)* y(k,126) & + + (rxt(k,195) +rxt(k,197))* y(k,133) +rxt(k,196)* y(k,135) & + +rxt(k,462)* y(k,141) +rxt(k,509)* y(k,150) +rxt(k,465)* y(k,188) & + +rxt(k,345)* y(k,195) +rxt(k,452)* y(k,197) +rxt(k,208)* y(k,202) & + +rxt(k,455)* y(k,207) +rxt(k,394)* y(k,208) +rxt(k,458)* y(k,209) & + +rxt(k,210)* y(k,220) + rxt(k,17) + rxt(k,529) + het_rates(k,125)) & + * y(k,125) + prod(k,197) = (2.000_r8*rxt(k,199)*y(k,126) +rxt(k,203)*y(k,202) + & + rxt(k,204)*y(k,135) +rxt(k,205)*y(k,133) +rxt(k,226)*y(k,59) + & + rxt(k,258)*y(k,19) +rxt(k,301)*y(k,196) +rxt(k,310)*y(k,203) + & + rxt(k,323)*y(k,192) +rxt(k,334)*y(k,195) +rxt(k,338)*y(k,201) + & + rxt(k,351)*y(k,193) +rxt(k,359)*y(k,223) +rxt(k,363)*y(k,224) + & + rxt(k,369)*y(k,199) +rxt(k,376)*y(k,206) +rxt(k,385)*y(k,208) + & + rxt(k,388)*y(k,210) +rxt(k,398)*y(k,189) + & + .920_r8*rxt(k,408)*y(k,204) +.920_r8*rxt(k,414)*y(k,205) + & + rxt(k,422)*y(k,101) +rxt(k,433)*y(k,228) +rxt(k,437)*y(k,188) + & + rxt(k,440)*y(k,190) +rxt(k,445)*y(k,191) +rxt(k,447)*y(k,194) + & + rxt(k,451)*y(k,197) +rxt(k,454)*y(k,207) +rxt(k,457)*y(k,209) + & + rxt(k,460)*y(k,222) +rxt(k,467)*y(k,227) +rxt(k,473)*y(k,229) + & + rxt(k,476)*y(k,230) +1.600_r8*rxt(k,487)*y(k,215) + & + .900_r8*rxt(k,492)*y(k,225) +.800_r8*rxt(k,497)*y(k,226))*y(k,124) & + + (rxt(k,18) +rxt(k,198)*y(k,202) +rxt(k,200)*y(k,133) + & + rxt(k,201)*y(k,220) +rxt(k,367)*y(k,16) +rxt(k,375)*y(k,206) + & + rxt(k,386)*y(k,208) +rxt(k,409)*y(k,204) +rxt(k,415)*y(k,205) + & + rxt(k,423)*y(k,101) +rxt(k,434)*y(k,228) + & + 2.000_r8*rxt(k,488)*y(k,215))*y(k,126) + (rxt(k,187)*y(k,90) + & + rxt(k,357)*y(k,127) +rxt(k,396)*y(k,1) +.700_r8*rxt(k,416)*y(k,99) + & + rxt(k,494)*y(k,175))*y(k,220) + (rxt(k,11) +rxt(k,212))*y(k,90) & + + (rxt(k,55) +rxt(k,395))*y(k,109) + (rxt(k,13) +rxt(k,213)) & + *y(k,114) + (.600_r8*rxt(k,61) +rxt(k,346))*y(k,139) +rxt(k,20) & + *y(k,1) +rxt(k,77)*y(k,20) +rxt(k,96)*y(k,60) +rxt(k,9)*y(k,89) & + +rxt(k,46)*y(k,93) +rxt(k,49)*y(k,102) +rxt(k,57)*y(k,116) & + +rxt(k,58)*y(k,127) +rxt(k,59)*y(k,128) +rxt(k,60)*y(k,138) & + +rxt(k,470)*y(k,140) +rxt(k,67)*y(k,175) & + +.500_r8*rxt(k,485)*y(k,215)*y(k,196) + loss(k,194) = (rxt(k,479)* y(k,6) +rxt(k,367)* y(k,16) +rxt(k,347)* y(k,29) & + +rxt(k,295)* y(k,42) +rxt(k,328)* y(k,45) +rxt(k,354)* y(k,49) & + +rxt(k,516)* y(k,67) +rxt(k,418)* y(k,98) +rxt(k,423)* y(k,101) & + +rxt(k,482)* y(k,110) +rxt(k,199)* y(k,124) +rxt(k,209)* y(k,125) & + +rxt(k,200)* y(k,133) +rxt(k,499)* y(k,177) +rxt(k,198)* y(k,202) & + +rxt(k,409)* y(k,204) +rxt(k,415)* y(k,205) +rxt(k,375)* y(k,206) & + +rxt(k,386)* y(k,208) +rxt(k,488)* y(k,215) +rxt(k,201)* y(k,220) & + +rxt(k,434)* y(k,228) + rxt(k,18) + rxt(k,19) + rxt(k,530) & + + het_rates(k,126))* y(k,126) + prod(k,194) = (rxt(k,95) +rxt(k,227)*y(k,56) +rxt(k,229)*y(k,133) + & + rxt(k,230)*y(k,220))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,213)) & + *y(k,114) + (rxt(k,211)*y(k,89) +rxt(k,343)*y(k,139) + & + .500_r8*rxt(k,391)*y(k,109))*y(k,220) + (rxt(k,78) + & + rxt(k,260)*y(k,133))*y(k,20) + (rxt(k,196)*y(k,135) + & + rxt(k,197)*y(k,133))*y(k,125) +rxt(k,274)*y(k,89)*y(k,73) +rxt(k,10) & + *y(k,90) +.400_r8*rxt(k,61)*y(k,139) + loss(k,147) = (rxt(k,357)* y(k,220) + rxt(k,58) + het_rates(k,127))* y(k,127) + prod(k,147) = (.500_r8*rxt(k,417)*y(k,100) +rxt(k,424)*y(k,102) + & + rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116))*y(k,220) & + +rxt(k,347)*y(k,126)*y(k,29) + loss(k,86) = (rxt(k,489)* y(k,220) + rxt(k,59) + rxt(k,531) & + + het_rates(k,128))* y(k,128) + prod(k,86) =rxt(k,486)*y(k,215)*y(k,202) + loss(k,10) = ( + het_rates(k,129))* y(k,129) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,130))* y(k,130) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,131))* y(k,131) + prod(k,12) = 0._r8 + loss(k,13) = ( + het_rates(k,132))* y(k,132) + prod(k,13) = 0._r8 + loss(k,192) = (rxt(k,261)* y(k,19) +rxt(k,260)* y(k,20) +rxt(k,296)* y(k,42) & + +rxt(k,231)* y(k,59) +rxt(k,229)* y(k,60) +rxt(k,170)* y(k,77) & + +rxt(k,171)* y(k,79) +rxt(k,263)* y(k,81) +rxt(k,234)* y(k,85) & + +rxt(k,265)* y(k,91) +rxt(k,237)* y(k,92) +rxt(k,205)* y(k,124) & + + (rxt(k,195) +rxt(k,197))* y(k,125) +rxt(k,200)* y(k,126) & + + 2._r8*rxt(k,168)* y(k,133) +rxt(k,169)* y(k,134) +rxt(k,167) & + * y(k,135) +rxt(k,502)* y(k,137) +rxt(k,176)* y(k,202) & + + (rxt(k,569) +rxt(k,570))* y(k,212) +rxt(k,571)* y(k,214) & + +rxt(k,182)* y(k,220) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + + rxt(k,123) + rxt(k,124) + rxt(k,125) + het_rates(k,133))* y(k,133) + prod(k,192) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & + rxt(k,129) +rxt(k,131) +rxt(k,132) +rxt(k,133) +2.000_r8*rxt(k,134) + & + 2.000_r8*rxt(k,135) +rxt(k,156)*y(k,216) +rxt(k,157)*y(k,216) + & + rxt(k,194)*y(k,112) +rxt(k,504)*y(k,148) +rxt(k,510)*y(k,150) + & + rxt(k,573)*y(k,214) +rxt(k,579)*y(k,221))*y(k,134) & + + (rxt(k,190)*y(k,124) +rxt(k,191)*y(k,125) +rxt(k,574)*y(k,219)) & + *y(k,112) + (rxt(k,565)*y(k,213) +1.150_r8*rxt(k,566)*y(k,219)) & + *y(k,198) +rxt(k,76)*y(k,19) +rxt(k,94)*y(k,59) +rxt(k,174)*y(k,202) & + *y(k,76) +rxt(k,14)*y(k,114) +rxt(k,15)*y(k,124) +rxt(k,17)*y(k,125) & + +rxt(k,18)*y(k,126) +rxt(k,8)*y(k,135) +rxt(k,108)*y(k,136) & + +rxt(k,138)*y(k,150) +rxt(k,139)*y(k,151) +rxt(k,140)*y(k,152) & + +rxt(k,155)*y(k,216) +rxt(k,184)*y(k,220)*y(k,220) +rxt(k,2) & + *y(k,231) + loss(k,186) = (rxt(k,175)* y(k,76) +rxt(k,194)* y(k,112) +rxt(k,169) & + * y(k,133) +rxt(k,504)* y(k,148) +rxt(k,510)* y(k,150) +rxt(k,340) & + * y(k,200) +rxt(k,189)* y(k,211) +rxt(k,568)* y(k,212) & + + (rxt(k,572) +rxt(k,573))* y(k,214) +rxt(k,156)* y(k,216) & + +rxt(k,161)* y(k,217) +rxt(k,579)* y(k,221) + rxt(k,5) + rxt(k,6) & + + rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + rxt(k,134) + rxt(k,135) & + + het_rates(k,134))* y(k,134) + prod(k,186) = (rxt(k,172)*y(k,76) +rxt(k,176)*y(k,133) + & + 2.000_r8*rxt(k,177)*y(k,135) +rxt(k,181)*y(k,220) + & + rxt(k,186)*y(k,202) +rxt(k,198)*y(k,126) +rxt(k,218)*y(k,56) + & + rxt(k,225)*y(k,59) +rxt(k,251)*y(k,17) +rxt(k,257)*y(k,19) + & + rxt(k,300)*y(k,196) +rxt(k,322)*y(k,192) +rxt(k,350)*y(k,193) + & + rxt(k,358)*y(k,223))*y(k,202) + (rxt(k,8) + & + 2.000_r8*rxt(k,158)*y(k,216) +2.000_r8*rxt(k,167)*y(k,133) + & + rxt(k,178)*y(k,76) +rxt(k,183)*y(k,220) +rxt(k,196)*y(k,125) + & + rxt(k,204)*y(k,124) +rxt(k,220)*y(k,56) +rxt(k,252)*y(k,17) + & + rxt(k,505)*y(k,148) +rxt(k,511)*y(k,150))*y(k,135) & + + (rxt(k,160)*y(k,217) +rxt(k,168)*y(k,133) +rxt(k,182)*y(k,220) + & + rxt(k,195)*y(k,125) +rxt(k,200)*y(k,126) +rxt(k,231)*y(k,59) + & + rxt(k,261)*y(k,19))*y(k,133) + (rxt(k,222)*y(k,59) + & + rxt(k,223)*y(k,59) +rxt(k,233)*y(k,220) +rxt(k,255)*y(k,19) + & + rxt(k,256)*y(k,19))*y(k,59) + (rxt(k,151) +rxt(k,159) + & + 2.000_r8*rxt(k,161)*y(k,134))*y(k,217) +rxt(k,253)*y(k,19)*y(k,19) & + +rxt(k,187)*y(k,220)*y(k,90) +rxt(k,193)*y(k,125)*y(k,112) & + +rxt(k,207)*y(k,216)*y(k,113) +rxt(k,576)*y(k,219)*y(k,124) & + +rxt(k,19)*y(k,126) +rxt(k,152)*y(k,218) + loss(k,191) = (rxt(k,480)* y(k,6) +rxt(k,252)* y(k,17) +rxt(k,319)* y(k,25) & + +rxt(k,348)* y(k,29) +rxt(k,220)* y(k,56) +rxt(k,178)* y(k,76) & + +rxt(k,425)* y(k,98) +rxt(k,378)* y(k,105) +rxt(k,483)* y(k,110) & + +rxt(k,392)* y(k,111) +rxt(k,204)* y(k,124) +rxt(k,196)* y(k,125) & + +rxt(k,167)* y(k,133) +rxt(k,463)* y(k,141) +rxt(k,505)* y(k,148) & + +rxt(k,511)* y(k,150) +rxt(k,177)* y(k,202) +rxt(k,158)* y(k,216) & + +rxt(k,183)* y(k,220) + rxt(k,7) + rxt(k,8) + het_rates(k,135)) & + * y(k,135) + prod(k,191) = (.150_r8*rxt(k,333)*y(k,195) +.150_r8*rxt(k,383)*y(k,208)) & + *y(k,202) +rxt(k,169)*y(k,134)*y(k,133) + loss(k,77) = (rxt(k,512)* y(k,150) + rxt(k,108) + het_rates(k,136))* y(k,136) + prod(k,77) = (rxt(k,224)*y(k,59) +rxt(k,254)*y(k,19))*y(k,59) + loss(k,81) = (rxt(k,502)* y(k,133) +rxt(k,503)* y(k,220) + rxt(k,137) & + + het_rates(k,137))* y(k,137) + prod(k,81) = 0._r8 + loss(k,61) = ( + rxt(k,60) + rxt(k,532) + het_rates(k,138))* y(k,138) + prod(k,61) =rxt(k,371)*y(k,220)*y(k,93) +.100_r8*rxt(k,492)*y(k,225)*y(k,124) + loss(k,97) = (rxt(k,343)* y(k,220) + rxt(k,61) + rxt(k,346) & + + het_rates(k,139))* y(k,139) + prod(k,97) =rxt(k,345)*y(k,195)*y(k,125) + loss(k,44) = ( + rxt(k,470) + het_rates(k,140))* y(k,140) + prod(k,44) =rxt(k,465)*y(k,188)*y(k,125) + loss(k,98) = (rxt(k,462)* y(k,125) +rxt(k,463)* y(k,135) + het_rates(k,141)) & + * y(k,141) + prod(k,98) = (.070_r8*rxt(k,449)*y(k,66) +.060_r8*rxt(k,461)*y(k,142) + & + .070_r8*rxt(k,477)*y(k,184))*y(k,220) +rxt(k,32)*y(k,32) & + +rxt(k,447)*y(k,194)*y(k,124) + loss(k,50) = (rxt(k,461)* y(k,220) + het_rates(k,142))* y(k,142) + prod(k,50) =.530_r8*rxt(k,438)*y(k,220)*y(k,7) + loss(k,78) = (rxt(k,464)* y(k,220) + rxt(k,62) + het_rates(k,143))* y(k,143) + prod(k,78) =rxt(k,459)*y(k,222)*y(k,202) + loss(k,14) = ( + het_rates(k,144))* y(k,144) + prod(k,14) = 0._r8 + loss(k,15) = ( + het_rates(k,145))* y(k,145) + prod(k,15) = 0._r8 + loss(k,109) = (rxt(k,360)* y(k,220) + rxt(k,63) + het_rates(k,146))* y(k,146) + prod(k,109) =rxt(k,358)*y(k,223)*y(k,202) + loss(k,87) = (rxt(k,364)* y(k,220) + rxt(k,64) + het_rates(k,147))* y(k,147) + prod(k,87) =.850_r8*rxt(k,362)*y(k,224)*y(k,202) + loss(k,129) = (rxt(k,504)* y(k,134) +rxt(k,505)* y(k,135) +rxt(k,508) & + * y(k,220) + het_rates(k,148))* y(k,148) + prod(k,129) =rxt(k,137)*y(k,137) +rxt(k,138)*y(k,150) + loss(k,182) = (rxt(k,506)* y(k,19) +rxt(k,507)* y(k,59) +rxt(k,509)* y(k,125) & + +rxt(k,510)* y(k,134) +rxt(k,511)* y(k,135) +rxt(k,512)* y(k,136) & + +rxt(k,513)* y(k,220) + rxt(k,138) + het_rates(k,150))* y(k,150) + prod(k,182) = (rxt(k,504)*y(k,134) +rxt(k,505)*y(k,135) +rxt(k,508)*y(k,220)) & + *y(k,148) +rxt(k,502)*y(k,137)*y(k,133) +rxt(k,139)*y(k,151) + loss(k,155) = (rxt(k,514)* y(k,220) + rxt(k,139) + het_rates(k,151)) & + * y(k,151) + prod(k,155) = (rxt(k,506)*y(k,19) +rxt(k,507)*y(k,59) +rxt(k,509)*y(k,125) + & + rxt(k,510)*y(k,134) +rxt(k,511)*y(k,135) +rxt(k,512)*y(k,136) + & + rxt(k,513)*y(k,220))*y(k,150) + (rxt(k,516)*y(k,126) + & + rxt(k,517)*y(k,220) +.500_r8*rxt(k,519)*y(k,220))*y(k,67) & + +rxt(k,503)*y(k,220)*y(k,137) +rxt(k,140)*y(k,152) + loss(k,65) = (rxt(k,515)* y(k,231) + rxt(k,140) + het_rates(k,152))* y(k,152) + prod(k,65) =rxt(k,136)*y(k,80) +rxt(k,514)*y(k,220)*y(k,151) + loss(k,16) = ( + het_rates(k,153))* y(k,153) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,154))* y(k,154) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,155))* y(k,155) + prod(k,18) = 0._r8 + loss(k,19) = ( + rxt(k,141) + het_rates(k,156))* y(k,156) + prod(k,19) = 0._r8 + loss(k,20) = ( + rxt(k,142) + het_rates(k,157))* y(k,157) + prod(k,20) = 0._r8 + loss(k,21) = ( + rxt(k,143) + het_rates(k,158))* y(k,158) + prod(k,21) = 0._r8 + loss(k,22) = ( + rxt(k,144) + het_rates(k,159))* y(k,159) + prod(k,22) = 0._r8 + loss(k,23) = ( + rxt(k,145) + het_rates(k,160))* y(k,160) + prod(k,23) = 0._r8 + loss(k,24) = ( + rxt(k,146) + het_rates(k,161))* y(k,161) + prod(k,24) = 0._r8 + loss(k,25) = ( + rxt(k,147) + het_rates(k,162))* y(k,162) + prod(k,25) = 0._r8 + loss(k,26) = ( + rxt(k,148) + het_rates(k,163))* y(k,163) + prod(k,26) = 0._r8 + loss(k,27) = ( + rxt(k,149) + het_rates(k,164))* y(k,164) + prod(k,27) = 0._r8 + loss(k,28) = ( + rxt(k,150) + het_rates(k,165))* y(k,165) + prod(k,28) = 0._r8 + loss(k,29) = ( + het_rates(k,166))* y(k,166) + prod(k,29) = (.2202005_r8*rxt(k,536)*y(k,6) +.0023005_r8*rxt(k,537)*y(k,7) + & + .0031005_r8*rxt(k,540)*y(k,98) +.2381005_r8*rxt(k,541)*y(k,104) + & + .0508005_r8*rxt(k,544)*y(k,110) +.5931005_r8*rxt(k,545)*y(k,172) + & + .1364005_r8*rxt(k,546)*y(k,180) +.1677005_r8*rxt(k,547)*y(k,182)) & + *y(k,220) + (.2202005_r8*rxt(k,535)*y(k,6) + & + .0508005_r8*rxt(k,543)*y(k,110))*y(k,135) +rxt(k,520)*y(k,75) + loss(k,30) = ( + het_rates(k,167))* y(k,167) + prod(k,30) = (.2067005_r8*rxt(k,536)*y(k,6) +.0008005_r8*rxt(k,537)*y(k,7) + & + .0035005_r8*rxt(k,540)*y(k,98) +.1308005_r8*rxt(k,541)*y(k,104) + & + .1149005_r8*rxt(k,544)*y(k,110) +.1534005_r8*rxt(k,545)*y(k,172) + & + .0101005_r8*rxt(k,546)*y(k,180) +.0174005_r8*rxt(k,547)*y(k,182)) & + *y(k,220) + (.2067005_r8*rxt(k,535)*y(k,6) + & + .1149005_r8*rxt(k,543)*y(k,110))*y(k,135) + loss(k,31) = ( + het_rates(k,168))* y(k,168) + prod(k,31) = (.0653005_r8*rxt(k,536)*y(k,6) +.0843005_r8*rxt(k,537)*y(k,7) + & + .0003005_r8*rxt(k,540)*y(k,98) +.0348005_r8*rxt(k,541)*y(k,104) + & + .0348005_r8*rxt(k,544)*y(k,110) +.0459005_r8*rxt(k,545)*y(k,172) + & + .0763005_r8*rxt(k,546)*y(k,180) +.086_r8*rxt(k,547)*y(k,182)) & + *y(k,220) + (.0653005_r8*rxt(k,535)*y(k,6) + & + .0348005_r8*rxt(k,543)*y(k,110))*y(k,135) + loss(k,32) = ( + het_rates(k,169))* y(k,169) + prod(k,32) = (.1284005_r8*rxt(k,536)*y(k,6) +.0443005_r8*rxt(k,537)*y(k,7) + & + .0271005_r8*rxt(k,540)*y(k,98) +.0076005_r8*rxt(k,541)*y(k,104) + & + .0554005_r8*rxt(k,544)*y(k,110) +.0085005_r8*rxt(k,545)*y(k,172) + & + .2157005_r8*rxt(k,546)*y(k,180) +.0512005_r8*rxt(k,547)*y(k,182)) & + *y(k,220) + (.1749305_r8*rxt(k,534)*y(k,6) + & + .0590245_r8*rxt(k,538)*y(k,98) +.1749305_r8*rxt(k,542)*y(k,110)) & + *y(k,126) + (.1284005_r8*rxt(k,535)*y(k,6) + & + .0033005_r8*rxt(k,539)*y(k,98) +.0554005_r8*rxt(k,543)*y(k,110)) & + *y(k,135) + loss(k,33) = ( + het_rates(k,170))* y(k,170) + prod(k,33) = (.114_r8*rxt(k,536)*y(k,6) +.1621005_r8*rxt(k,537)*y(k,7) + & + .0474005_r8*rxt(k,540)*y(k,98) +.0113005_r8*rxt(k,541)*y(k,104) + & + .1278005_r8*rxt(k,544)*y(k,110) +.0128005_r8*rxt(k,545)*y(k,172) + & + .0232005_r8*rxt(k,546)*y(k,180) +.1598005_r8*rxt(k,547)*y(k,182)) & + *y(k,220) + (.5901905_r8*rxt(k,534)*y(k,6) + & + .0250245_r8*rxt(k,538)*y(k,98) +.5901905_r8*rxt(k,542)*y(k,110)) & + *y(k,126) + (.114_r8*rxt(k,535)*y(k,6) + & + .1278005_r8*rxt(k,543)*y(k,110))*y(k,135) + loss(k,35) = (rxt(k,545)* y(k,220) + het_rates(k,172))* y(k,172) + prod(k,35) = 0._r8 + loss(k,55) = ( + rxt(k,65) + het_rates(k,173))* y(k,173) + prod(k,55) = (.100_r8*rxt(k,469)*y(k,180) +.230_r8*rxt(k,471)*y(k,182)) & + *y(k,220) + loss(k,116) = (rxt(k,493)* y(k,220) + rxt(k,66) + het_rates(k,174))* y(k,174) + prod(k,116) =rxt(k,491)*y(k,225)*y(k,202) + loss(k,121) = (rxt(k,494)* y(k,220) + rxt(k,67) + rxt(k,533) & + + het_rates(k,175))* y(k,175) + prod(k,121) = (.200_r8*rxt(k,487)*y(k,215) +.200_r8*rxt(k,497)*y(k,226)) & + *y(k,124) +.500_r8*rxt(k,485)*y(k,215)*y(k,196) + loss(k,100) = (rxt(k,498)* y(k,220) + rxt(k,68) + het_rates(k,176))* y(k,176) + prod(k,100) =rxt(k,496)*y(k,226)*y(k,202) + loss(k,158) = (rxt(k,499)* y(k,126) +rxt(k,500)* y(k,220) + rxt(k,69) & + + het_rates(k,177))* y(k,177) + prod(k,158) = (.500_r8*rxt(k,485)*y(k,196) +.800_r8*rxt(k,487)*y(k,124) + & + rxt(k,488)*y(k,126))*y(k,215) + (.330_r8*rxt(k,480)*y(k,6) + & + .330_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,67) + & + rxt(k,494)*y(k,220))*y(k,175) + (rxt(k,495)*y(k,196) + & + .800_r8*rxt(k,497)*y(k,124))*y(k,226) +rxt(k,59)*y(k,128) +rxt(k,68) & + *y(k,176) + loss(k,163) = (rxt(k,501)* y(k,220) + rxt(k,70) + het_rates(k,178))* y(k,178) + prod(k,163) = (.300_r8*rxt(k,480)*y(k,6) +.300_r8*rxt(k,483)*y(k,110)) & + *y(k,135) + (rxt(k,490)*y(k,196) +.900_r8*rxt(k,492)*y(k,124)) & + *y(k,225) +rxt(k,66)*y(k,174) +rxt(k,69)*y(k,177) + loss(k,117) = (rxt(k,468)* y(k,220) + rxt(k,71) + het_rates(k,179))* y(k,179) + prod(k,117) =rxt(k,466)*y(k,227)*y(k,202) + loss(k,53) = (rxt(k,469)* y(k,220) + het_rates(k,180))* y(k,180) + prod(k,53) = 0._r8 + loss(k,56) = (rxt(k,435)* y(k,220) + rxt(k,72) + het_rates(k,181))* y(k,181) + prod(k,56) =rxt(k,432)*y(k,228)*y(k,202) + loss(k,57) = (rxt(k,471)* y(k,220) + het_rates(k,182))* y(k,182) + prod(k,57) = 0._r8 + loss(k,128) = (rxt(k,474)* y(k,220) + rxt(k,73) + het_rates(k,183))* y(k,183) + prod(k,128) =rxt(k,472)*y(k,229)*y(k,202) + loss(k,58) = (rxt(k,477)* y(k,220) + het_rates(k,184))* y(k,184) + prod(k,58) =.150_r8*rxt(k,471)*y(k,220)*y(k,182) + loss(k,91) = (rxt(k,478)* y(k,220) + rxt(k,74) + het_rates(k,185))* y(k,185) + prod(k,91) =rxt(k,475)*y(k,230)*y(k,202) + loss(k,104) = (rxt(k,437)* y(k,124) +rxt(k,465)* y(k,125) +rxt(k,436) & + * y(k,202) + het_rates(k,188))* y(k,188) + prod(k,104) =rxt(k,442)*y(k,220)*y(k,22) +rxt(k,470)*y(k,140) + loss(k,154) = ((rxt(k,398) +rxt(k,399))* y(k,124) +rxt(k,397)* y(k,202) & + + het_rates(k,189))* y(k,189) + prod(k,154) = (rxt(k,400)*y(k,2) +rxt(k,401)*y(k,15))*y(k,220) + loss(k,101) = (rxt(k,440)* y(k,124) +rxt(k,439)* y(k,202) + het_rates(k,190)) & + * y(k,190) + prod(k,101) = (.350_r8*rxt(k,438)*y(k,7) +rxt(k,441)*y(k,8))*y(k,220) + loss(k,92) = (rxt(k,445)* y(k,124) +rxt(k,443)* y(k,202) + het_rates(k,191)) & + * y(k,191) + prod(k,92) = (rxt(k,444)*y(k,23) +.070_r8*rxt(k,469)*y(k,180) + & + .060_r8*rxt(k,471)*y(k,182))*y(k,220) + loss(k,152) = (rxt(k,323)* y(k,124) + 2._r8*rxt(k,320)* y(k,192) +rxt(k,321) & + * y(k,196) +rxt(k,322)* y(k,202) + het_rates(k,192))* y(k,192) + prod(k,152) = (rxt(k,326)*y(k,56) +rxt(k,327)*y(k,220))*y(k,28) & + +.500_r8*rxt(k,325)*y(k,220)*y(k,27) +rxt(k,53)*y(k,107) + loss(k,143) = (rxt(k,351)* y(k,124) +rxt(k,349)* y(k,196) +rxt(k,350) & + * y(k,202) + het_rates(k,193))* y(k,193) + prod(k,143) = (rxt(k,352)*y(k,30) +rxt(k,353)*y(k,31))*y(k,220) + loss(k,122) = (rxt(k,447)* y(k,124) +rxt(k,446)* y(k,202) + het_rates(k,194)) & + * y(k,194) + prod(k,122) = (.400_r8*rxt(k,436)*y(k,202) +rxt(k,437)*y(k,124))*y(k,188) & + +rxt(k,448)*y(k,220)*y(k,32) +rxt(k,463)*y(k,141)*y(k,135) + loss(k,181) = (rxt(k,419)* y(k,101) +rxt(k,334)* y(k,124) +rxt(k,345) & + * y(k,125) + 2._r8*rxt(k,331)* y(k,195) +rxt(k,332)* y(k,196) & + +rxt(k,333)* y(k,202) +rxt(k,405)* y(k,204) +rxt(k,410)* y(k,205) & + +rxt(k,372)* y(k,206) +rxt(k,430)* y(k,228) + het_rates(k,195)) & + * y(k,195) + prod(k,181) = (.100_r8*rxt(k,378)*y(k,105) +.280_r8*rxt(k,392)*y(k,111) + & + .080_r8*rxt(k,425)*y(k,98) +.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,382)*y(k,196) + & + .450_r8*rxt(k,383)*y(k,202) +2.000_r8*rxt(k,384)*y(k,208) + & + rxt(k,385)*y(k,124) +rxt(k,386)*y(k,126))*y(k,208) & + + (.530_r8*rxt(k,372)*y(k,195) +.260_r8*rxt(k,373)*y(k,196) + & + .530_r8*rxt(k,375)*y(k,126) +.530_r8*rxt(k,376)*y(k,124))*y(k,206) & + + (rxt(k,329)*y(k,45) +.500_r8*rxt(k,336)*y(k,51) + & + rxt(k,355)*y(k,49) +.650_r8*rxt(k,501)*y(k,178))*y(k,220) & + + (.300_r8*rxt(k,361)*y(k,196) +.150_r8*rxt(k,362)*y(k,202) + & + rxt(k,363)*y(k,124))*y(k,224) + (rxt(k,37) +rxt(k,354)*y(k,126)) & + *y(k,49) + (.600_r8*rxt(k,61) +rxt(k,346))*y(k,139) & + + (.200_r8*rxt(k,387)*y(k,202) +rxt(k,388)*y(k,124))*y(k,210) & + +.130_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +rxt(k,328)*y(k,126) & + *y(k,45) +rxt(k,36)*y(k,48) +.330_r8*rxt(k,46)*y(k,93) +rxt(k,48) & + *y(k,95) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,53)*y(k,107) +rxt(k,54) & + *y(k,108) +.300_r8*rxt(k,56)*y(k,111) +rxt(k,58)*y(k,127) +rxt(k,64) & + *y(k,147) +.500_r8*rxt(k,65)*y(k,173) +.650_r8*rxt(k,70)*y(k,178) + loss(k,185) = (rxt(k,221)* y(k,59) +rxt(k,420)* y(k,101) +rxt(k,301) & + * y(k,124) +rxt(k,321)* y(k,192) +rxt(k,349)* y(k,193) +rxt(k,332) & + * y(k,195) + 2._r8*(rxt(k,298) +rxt(k,299))* y(k,196) +rxt(k,300) & + * y(k,202) +rxt(k,406)* y(k,204) +rxt(k,411)* y(k,205) +rxt(k,373) & + * y(k,206) +rxt(k,382)* y(k,208) +rxt(k,485)* y(k,215) +rxt(k,361) & + * y(k,224) +rxt(k,490)* y(k,225) +rxt(k,495)* y(k,226) +rxt(k,431) & + * y(k,228) + het_rates(k,196))* y(k,196) + prod(k,185) = (2.000_r8*rxt(k,331)*y(k,195) +.900_r8*rxt(k,332)*y(k,196) + & + .450_r8*rxt(k,333)*y(k,202) +rxt(k,334)*y(k,124) + & + rxt(k,372)*y(k,206) +rxt(k,381)*y(k,208) +rxt(k,405)*y(k,204) + & + rxt(k,410)*y(k,205) +rxt(k,419)*y(k,101) +rxt(k,430)*y(k,228)) & + *y(k,195) + (rxt(k,215)*y(k,56) +rxt(k,271)*y(k,73) + & + rxt(k,304)*y(k,220) +rxt(k,311)*y(k,216))*y(k,54) & + + (.830_r8*rxt(k,451)*y(k,197) +.170_r8*rxt(k,457)*y(k,209)) & + *y(k,124) + (.280_r8*rxt(k,348)*y(k,29) +.050_r8*rxt(k,425)*y(k,98)) & + *y(k,135) + (.330_r8*rxt(k,450)*y(k,197) + & + .070_r8*rxt(k,456)*y(k,209))*y(k,202) + (.700_r8*rxt(k,303)*y(k,53) + & + rxt(k,335)*y(k,50))*y(k,220) +rxt(k,35)*y(k,45) +rxt(k,36)*y(k,48) & + +rxt(k,38)*y(k,51) +.300_r8*rxt(k,56)*y(k,111) +.400_r8*rxt(k,61) & + *y(k,139) + loss(k,133) = (rxt(k,451)* y(k,124) +rxt(k,452)* y(k,125) +rxt(k,450) & + * y(k,202) + het_rates(k,197))* y(k,197) + prod(k,133) =.600_r8*rxt(k,26)*y(k,12) + loss(k,139) = (rxt(k,567)* y(k,212) +rxt(k,565)* y(k,213) +rxt(k,566) & + * y(k,219) + het_rates(k,198))* y(k,198) + prod(k,139) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & + rxt(k,131) +rxt(k,132) +rxt(k,133))*y(k,134) + (rxt(k,120) + & + rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) +rxt(k,125))*y(k,133) & + +rxt(k,111)*y(k,112) +rxt(k,16)*y(k,124) + loss(k,113) = ((rxt(k,369) +rxt(k,370))* y(k,124) + het_rates(k,199)) & + * y(k,199) + prod(k,113) =rxt(k,368)*y(k,220)*y(k,16) + loss(k,96) = (rxt(k,340)* y(k,134) + rxt(k,339) + het_rates(k,200))* y(k,200) + prod(k,96) =rxt(k,43)*y(k,72) +.750_r8*rxt(k,338)*y(k,201)*y(k,124) + loss(k,135) = (rxt(k,338)* y(k,124) +rxt(k,337)* y(k,202) + het_rates(k,201)) & + * y(k,201) + prod(k,135) =rxt(k,344)*y(k,220)*y(k,25) + loss(k,199) = (rxt(k,251)* y(k,17) +rxt(k,257)* y(k,19) +rxt(k,294)* y(k,42) & + + (rxt(k,218) +rxt(k,219))* y(k,56) +rxt(k,225)* y(k,59) & + + (rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,76) +rxt(k,421) & + * y(k,101) +rxt(k,203)* y(k,124) +rxt(k,208)* y(k,125) +rxt(k,198) & + * y(k,126) +rxt(k,176)* y(k,133) +rxt(k,177)* y(k,135) +rxt(k,436) & + * y(k,188) +rxt(k,397)* y(k,189) +rxt(k,439)* y(k,190) +rxt(k,443) & + * y(k,191) +rxt(k,322)* y(k,192) +rxt(k,350)* y(k,193) +rxt(k,446) & + * y(k,194) +rxt(k,333)* y(k,195) +rxt(k,300)* y(k,196) +rxt(k,450) & + * y(k,197) +rxt(k,337)* y(k,201) + 2._r8*rxt(k,186)* y(k,202) & + +rxt(k,308)* y(k,203) +rxt(k,407)* y(k,204) +rxt(k,412)* y(k,205) & + +rxt(k,374)* y(k,206) +rxt(k,453)* y(k,207) +rxt(k,383)* y(k,208) & + +rxt(k,456)* y(k,209) +rxt(k,387)* y(k,210) +rxt(k,486)* y(k,215) & + +rxt(k,181)* y(k,220) +rxt(k,459)* y(k,222) +rxt(k,358)* y(k,223) & + +rxt(k,362)* y(k,224) +rxt(k,491)* y(k,225) +rxt(k,496)* y(k,226) & + +rxt(k,466)* y(k,227) +rxt(k,432)* y(k,228) +rxt(k,472)* y(k,229) & + +rxt(k,475)* y(k,230) + rxt(k,521) + het_rates(k,202))* y(k,202) + prod(k,199) = (rxt(k,280)*y(k,43) +rxt(k,283)*y(k,46) +rxt(k,180)*y(k,79) + & + rxt(k,183)*y(k,135) +rxt(k,201)*y(k,126) +rxt(k,232)*y(k,59) + & + rxt(k,262)*y(k,19) +rxt(k,302)*y(k,52) +rxt(k,305)*y(k,62) + & + rxt(k,306)*y(k,86) +rxt(k,307)*y(k,87) +.350_r8*rxt(k,317)*y(k,24) + & + rxt(k,324)*y(k,26) +rxt(k,330)*y(k,47) +rxt(k,341)*y(k,74) + & + rxt(k,342)*y(k,75) +rxt(k,356)*y(k,95) +rxt(k,371)*y(k,93) + & + .200_r8*rxt(k,380)*y(k,106) +.500_r8*rxt(k,391)*y(k,109) + & + .300_r8*rxt(k,416)*y(k,99) +rxt(k,417)*y(k,100) + & + rxt(k,424)*y(k,102) +rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116) + & + .650_r8*rxt(k,438)*y(k,7) +.730_r8*rxt(k,449)*y(k,66) + & + .800_r8*rxt(k,461)*y(k,142) +.280_r8*rxt(k,469)*y(k,180) + & + .380_r8*rxt(k,471)*y(k,182) +.630_r8*rxt(k,477)*y(k,184) + & + .200_r8*rxt(k,501)*y(k,178) +rxt(k,514)*y(k,151) + & + .500_r8*rxt(k,519)*y(k,67))*y(k,220) + (rxt(k,301)*y(k,196) + & + rxt(k,310)*y(k,203) +rxt(k,323)*y(k,192) + & + .250_r8*rxt(k,338)*y(k,201) +rxt(k,351)*y(k,193) + & + rxt(k,359)*y(k,223) +rxt(k,369)*y(k,199) + & + .470_r8*rxt(k,376)*y(k,206) +rxt(k,398)*y(k,189) + & + .920_r8*rxt(k,408)*y(k,204) +.920_r8*rxt(k,414)*y(k,205) + & + rxt(k,422)*y(k,101) +rxt(k,433)*y(k,228) +rxt(k,440)*y(k,190) + & + rxt(k,445)*y(k,191) +.170_r8*rxt(k,451)*y(k,197) + & + .400_r8*rxt(k,454)*y(k,207) +.830_r8*rxt(k,457)*y(k,209) + & + rxt(k,460)*y(k,222) +rxt(k,467)*y(k,227) +rxt(k,473)*y(k,229) + & + rxt(k,476)*y(k,230) +.900_r8*rxt(k,492)*y(k,225) + & + .800_r8*rxt(k,497)*y(k,226))*y(k,124) + (rxt(k,221)*y(k,59) + & + 2.000_r8*rxt(k,298)*y(k,196) +rxt(k,321)*y(k,192) + & + .900_r8*rxt(k,332)*y(k,195) +rxt(k,349)*y(k,193) + & + .300_r8*rxt(k,361)*y(k,224) +.730_r8*rxt(k,373)*y(k,206) + & + rxt(k,382)*y(k,208) +rxt(k,406)*y(k,204) +rxt(k,411)*y(k,205) + & + 1.200_r8*rxt(k,420)*y(k,101) +.800_r8*rxt(k,431)*y(k,228) + & + .500_r8*rxt(k,485)*y(k,215) +rxt(k,490)*y(k,225) + & + rxt(k,495)*y(k,226))*y(k,196) + (.130_r8*rxt(k,319)*y(k,25) + & + .280_r8*rxt(k,348)*y(k,29) +.140_r8*rxt(k,378)*y(k,105) + & + .280_r8*rxt(k,392)*y(k,111) +.370_r8*rxt(k,425)*y(k,98) + & + .570_r8*rxt(k,480)*y(k,6) +.570_r8*rxt(k,483)*y(k,110))*y(k,135) & + + (rxt(k,295)*y(k,42) +.470_r8*rxt(k,375)*y(k,206) + & + rxt(k,409)*y(k,204) +rxt(k,415)*y(k,205) +rxt(k,423)*y(k,101) + & + rxt(k,434)*y(k,228))*y(k,126) + (.470_r8*rxt(k,372)*y(k,206) + & + rxt(k,405)*y(k,204) +rxt(k,410)*y(k,205) +rxt(k,419)*y(k,101) + & + rxt(k,430)*y(k,228))*y(k,195) + (rxt(k,279)*y(k,43) + & + rxt(k,282)*y(k,46) +rxt(k,214)*y(k,42) +rxt(k,217)*y(k,79))*y(k,56) & + + (.070_r8*rxt(k,450)*y(k,197) +.160_r8*rxt(k,453)*y(k,207) + & + .330_r8*rxt(k,456)*y(k,209))*y(k,202) + (rxt(k,250)*y(k,17) + & + rxt(k,296)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,212))*y(k,90) & + + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,105) & + + (rxt(k,175)*y(k,76) +rxt(k,340)*y(k,200))*y(k,134) +rxt(k,20) & + *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & + +1.500_r8*rxt(k,23)*y(k,9) +.560_r8*rxt(k,24)*y(k,10) +rxt(k,25) & + *y(k,11) +.600_r8*rxt(k,26)*y(k,12) +.600_r8*rxt(k,27)*y(k,13) & + +rxt(k,28)*y(k,14) +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31) & + *y(k,30) +rxt(k,35)*y(k,45) +rxt(k,37)*y(k,49) +rxt(k,312)*y(k,216) & + *y(k,54) +2.000_r8*rxt(k,44)*y(k,74) +2.000_r8*rxt(k,45)*y(k,75) & + +rxt(k,171)*y(k,133)*y(k,79) +.670_r8*rxt(k,46)*y(k,93) +rxt(k,47) & + *y(k,94) +rxt(k,48)*y(k,95) +rxt(k,49)*y(k,102) +rxt(k,50)*y(k,103) & + +rxt(k,57)*y(k,116) +rxt(k,62)*y(k,143) +rxt(k,63)*y(k,146) & + +rxt(k,65)*y(k,173) +rxt(k,66)*y(k,174) +rxt(k,67)*y(k,175) & + +rxt(k,68)*y(k,176) +rxt(k,69)*y(k,177) +1.200_r8*rxt(k,70)*y(k,178) & + +rxt(k,71)*y(k,179) +rxt(k,73)*y(k,183) +rxt(k,74)*y(k,185) & + +1.200_r8*rxt(k,320)*y(k,192)*y(k,192) +rxt(k,339)*y(k,200) & + +rxt(k,309)*y(k,203) +rxt(k,413)*y(k,205) + loss(k,93) = (rxt(k,310)* y(k,124) +rxt(k,308)* y(k,202) + rxt(k,309) & + + het_rates(k,203))* y(k,203) + prod(k,93) =rxt(k,294)*y(k,202)*y(k,42) + loss(k,176) = (rxt(k,408)* y(k,124) +rxt(k,409)* y(k,126) +rxt(k,405) & + * y(k,195) +rxt(k,406)* y(k,196) +rxt(k,407)* y(k,202) & + + het_rates(k,204))* y(k,204) + prod(k,176) =.600_r8*rxt(k,426)*y(k,220)*y(k,98) + loss(k,177) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,126) +rxt(k,410) & + * y(k,195) +rxt(k,411)* y(k,196) +rxt(k,412)* y(k,202) + rxt(k,413) & + + het_rates(k,205))* y(k,205) + prod(k,177) =.400_r8*rxt(k,426)*y(k,220)*y(k,98) + loss(k,178) = ((rxt(k,376) +rxt(k,377))* y(k,124) +rxt(k,375)* y(k,126) & + +rxt(k,372)* y(k,195) +rxt(k,373)* y(k,196) +rxt(k,374)* y(k,202) & + + het_rates(k,206))* y(k,206) + prod(k,178) = (.500_r8*rxt(k,379)*y(k,105) +.200_r8*rxt(k,380)*y(k,106) + & + rxt(k,393)*y(k,111))*y(k,220) + loss(k,130) = (rxt(k,454)* y(k,124) +rxt(k,455)* y(k,125) +rxt(k,453) & + * y(k,202) + het_rates(k,207))* y(k,207) + prod(k,130) =.600_r8*rxt(k,25)*y(k,11) + loss(k,180) = (rxt(k,385)* y(k,124) +rxt(k,394)* y(k,125) +rxt(k,386) & + * y(k,126) +rxt(k,381)* y(k,195) +rxt(k,382)* y(k,196) +rxt(k,383) & + * y(k,202) + 2._r8*rxt(k,384)* y(k,208) + het_rates(k,208))* y(k,208) + prod(k,180) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,379)*y(k,220))*y(k,105) & + + (rxt(k,55) +rxt(k,395))*y(k,109) +.500_r8*rxt(k,380)*y(k,220) & + *y(k,106) + loss(k,150) = (rxt(k,457)* y(k,124) +rxt(k,458)* y(k,125) +rxt(k,456) & + * y(k,202) + het_rates(k,209))* y(k,209) + prod(k,150) =.600_r8*rxt(k,27)*y(k,13) + loss(k,125) = (rxt(k,388)* y(k,124) +rxt(k,387)* y(k,202) + het_rates(k,210)) & + * y(k,210) + prod(k,125) = (rxt(k,389)*y(k,107) +rxt(k,390)*y(k,108))*y(k,220) + loss(k,106) = (rxt(k,188)* y(k,133) +rxt(k,189)* y(k,134) + het_rates(k,211)) & + * y(k,211) + prod(k,106) = (.800_r8*rxt(k,565)*y(k,213) +.900_r8*rxt(k,567)*y(k,212)) & + *y(k,198) +rxt(k,569)*y(k,212)*y(k,133) + loss(k,126) = ((rxt(k,569) +rxt(k,570))* y(k,133) +rxt(k,568)* y(k,134) & + +rxt(k,567)* y(k,198) + het_rates(k,212))* y(k,212) + prod(k,126) = 0._r8 + loss(k,138) = (rxt(k,565)* y(k,198) + het_rates(k,213))* y(k,213) + prod(k,138) = (rxt(k,575) +rxt(k,574)*y(k,112) +rxt(k,576)*y(k,124))*y(k,219) & + +rxt(k,16)*y(k,124) +rxt(k,569)*y(k,212)*y(k,133) & + +rxt(k,573)*y(k,214)*y(k,134) +rxt(k,578)*y(k,221) + loss(k,102) = (rxt(k,571)* y(k,133) + (rxt(k,572) +rxt(k,573))* y(k,134) & + + het_rates(k,214))* y(k,214) + prod(k,102) =rxt(k,111)*y(k,112) + loss(k,168) = (rxt(k,487)* y(k,124) +rxt(k,488)* y(k,126) +rxt(k,485) & + * y(k,196) +rxt(k,486)* y(k,202) + het_rates(k,215))* y(k,215) + prod(k,168) = (rxt(k,479)*y(k,6) +rxt(k,482)*y(k,110) + & + .500_r8*rxt(k,499)*y(k,177))*y(k,126) +rxt(k,489)*y(k,220)*y(k,128) + loss(k,189) = (rxt(k,239)* y(k,33) +rxt(k,240)* y(k,34) +rxt(k,266)* y(k,35) & + +rxt(k,241)* y(k,36) +rxt(k,242)* y(k,37) +rxt(k,243)* y(k,38) & + +rxt(k,244)* y(k,39) +rxt(k,245)* y(k,40) +rxt(k,289)* y(k,41) & + +rxt(k,290)* y(k,43) + (rxt(k,311) +rxt(k,312) +rxt(k,313))* y(k,54) & + +rxt(k,267)* y(k,55) +rxt(k,275)* y(k,64) +rxt(k,276)* y(k,65) & + +rxt(k,153)* y(k,77) +rxt(k,268)* y(k,78) + (rxt(k,269) +rxt(k,270)) & + * y(k,81) +rxt(k,291)* y(k,82) +rxt(k,292)* y(k,83) +rxt(k,293) & + * y(k,84) + (rxt(k,246) +rxt(k,247))* y(k,85) +rxt(k,314)* y(k,86) & + + (rxt(k,206) +rxt(k,207))* y(k,113) + (rxt(k,156) +rxt(k,157)) & + * y(k,134) +rxt(k,158)* y(k,135) +rxt(k,154)* y(k,231) + rxt(k,155) & + + het_rates(k,216))* y(k,216) + prod(k,189) = (rxt(k,6) +rxt(k,189)*y(k,211))*y(k,134) +rxt(k,7)*y(k,135) & + +.850_r8*rxt(k,566)*y(k,219)*y(k,198) +rxt(k,1)*y(k,231) + loss(k,45) = (rxt(k,160)* y(k,133) +rxt(k,161)* y(k,134) + rxt(k,151) & + + rxt(k,159) + het_rates(k,217))* y(k,217) + prod(k,45) = (rxt(k,163) +rxt(k,162)*y(k,63) +rxt(k,164)*y(k,133) + & + rxt(k,165)*y(k,134) +rxt(k,166)*y(k,135))*y(k,218) +rxt(k,7)*y(k,135) + loss(k,46) = (rxt(k,162)* y(k,63) +rxt(k,164)* y(k,133) +rxt(k,165)* y(k,134) & + +rxt(k,166)* y(k,135) + rxt(k,152) + rxt(k,163) + het_rates(k,218)) & + * y(k,218) + prod(k,46) =rxt(k,156)*y(k,216)*y(k,134) + loss(k,137) = (rxt(k,574)* y(k,112) +rxt(k,576)* y(k,124) +rxt(k,566) & + * y(k,198) + rxt(k,575) + het_rates(k,219))* y(k,219) + prod(k,137) = (rxt(k,126) +rxt(k,130) +rxt(k,568)*y(k,212) + & + rxt(k,572)*y(k,214) +rxt(k,579)*y(k,221))*y(k,134) & + +rxt(k,577)*y(k,221)*y(k,63) + loss(k,190) = (rxt(k,396)* y(k,1) +rxt(k,400)* y(k,2) +rxt(k,481)* y(k,6) & + +rxt(k,438)* y(k,7) +rxt(k,441)* y(k,8) +rxt(k,401)* y(k,15) & + +rxt(k,368)* y(k,16) +rxt(k,262)* y(k,19) +rxt(k,442)* y(k,22) & + +rxt(k,444)* y(k,23) +rxt(k,317)* y(k,24) +rxt(k,344)* y(k,25) & + +rxt(k,324)* y(k,26) +rxt(k,325)* y(k,27) +rxt(k,327)* y(k,28) & + +rxt(k,365)* y(k,29) +rxt(k,352)* y(k,30) +rxt(k,353)* y(k,31) & + +rxt(k,448)* y(k,32) +rxt(k,278)* y(k,41) +rxt(k,297)* y(k,42) & + +rxt(k,280)* y(k,43) +rxt(k,281)* y(k,44) +rxt(k,329)* y(k,45) & + +rxt(k,283)* y(k,46) +rxt(k,330)* y(k,47) +rxt(k,366)* y(k,48) & + +rxt(k,355)* y(k,49) +rxt(k,335)* y(k,50) +rxt(k,336)* y(k,51) & + +rxt(k,302)* y(k,52) +rxt(k,303)* y(k,53) +rxt(k,304)* y(k,54) & + +rxt(k,285)* y(k,55) + (rxt(k,232) +rxt(k,233))* y(k,59) +rxt(k,230) & + * y(k,60) + (rxt(k,305) +rxt(k,315))* y(k,62) +rxt(k,449)* y(k,66) & + + (rxt(k,517) +rxt(k,519))* y(k,67) +rxt(k,341)* y(k,74) +rxt(k,342) & + * y(k,75) +rxt(k,179)* y(k,77) +rxt(k,180)* y(k,79) +rxt(k,264) & + * y(k,81) +rxt(k,286)* y(k,82) +rxt(k,287)* y(k,83) +rxt(k,288) & + * y(k,84) +rxt(k,235)* y(k,85) +rxt(k,306)* y(k,86) +rxt(k,307) & + * y(k,87) +rxt(k,211)* y(k,89) +rxt(k,187)* y(k,90) +rxt(k,238) & + * y(k,92) +rxt(k,371)* y(k,93) +rxt(k,402)* y(k,94) +rxt(k,356) & + * y(k,95) +rxt(k,403)* y(k,96) +rxt(k,404)* y(k,97) +rxt(k,426) & + * y(k,98) +rxt(k,416)* y(k,99) +rxt(k,417)* y(k,100) +rxt(k,424) & + * y(k,102) +rxt(k,427)* y(k,103) +rxt(k,379)* y(k,105) +rxt(k,380) & + * y(k,106) +rxt(k,389)* y(k,107) +rxt(k,390)* y(k,108) +rxt(k,391) & + * y(k,109) +rxt(k,484)* y(k,110) +rxt(k,393)* y(k,111) +rxt(k,202) & + * y(k,112) +rxt(k,428)* y(k,115) +rxt(k,429)* y(k,116) +rxt(k,518) & + * y(k,120) +rxt(k,210)* y(k,125) +rxt(k,201)* y(k,126) +rxt(k,357) & + * y(k,127) +rxt(k,489)* y(k,128) +rxt(k,182)* y(k,133) +rxt(k,183) & + * y(k,135) +rxt(k,503)* y(k,137) +rxt(k,343)* y(k,139) +rxt(k,461) & + * y(k,142) +rxt(k,464)* y(k,143) +rxt(k,360)* y(k,146) +rxt(k,364) & + * y(k,147) +rxt(k,508)* y(k,148) +rxt(k,513)* y(k,150) +rxt(k,514) & + * y(k,151) +rxt(k,493)* y(k,174) +rxt(k,494)* y(k,175) +rxt(k,498) & + * y(k,176) +rxt(k,500)* y(k,177) +rxt(k,501)* y(k,178) +rxt(k,468) & + * y(k,179) +rxt(k,469)* y(k,180) +rxt(k,435)* y(k,181) +rxt(k,471) & + * y(k,182) +rxt(k,474)* y(k,183) +rxt(k,477)* y(k,184) +rxt(k,478) & + * y(k,185) +rxt(k,181)* y(k,202) + 2._r8*(rxt(k,184) +rxt(k,185)) & + * y(k,220) + het_rates(k,220))* y(k,220) + prod(k,190) = (2.000_r8*rxt(k,173)*y(k,76) +rxt(k,176)*y(k,133) + & + rxt(k,177)*y(k,135) +rxt(k,198)*y(k,126) +rxt(k,203)*y(k,124) + & + rxt(k,219)*y(k,56) +.450_r8*rxt(k,333)*y(k,195) + & + .150_r8*rxt(k,362)*y(k,224) +.450_r8*rxt(k,383)*y(k,208) + & + .200_r8*rxt(k,387)*y(k,210) +.400_r8*rxt(k,436)*y(k,188) + & + .400_r8*rxt(k,450)*y(k,197) +.400_r8*rxt(k,456)*y(k,209))*y(k,202) & + + (rxt(k,178)*y(k,76) +.130_r8*rxt(k,319)*y(k,25) + & + .360_r8*rxt(k,348)*y(k,29) +.240_r8*rxt(k,378)*y(k,105) + & + .360_r8*rxt(k,392)*y(k,111) +.320_r8*rxt(k,425)*y(k,98) + & + .630_r8*rxt(k,480)*y(k,6) +.630_r8*rxt(k,483)*y(k,110))*y(k,135) & + + (rxt(k,170)*y(k,77) +rxt(k,171)*y(k,79) +rxt(k,234)*y(k,85) + & + rxt(k,237)*y(k,92) +rxt(k,263)*y(k,81) +rxt(k,265)*y(k,91) + & + rxt(k,296)*y(k,42))*y(k,133) + (.300_r8*rxt(k,303)*y(k,53) + & + .650_r8*rxt(k,317)*y(k,24) +.500_r8*rxt(k,325)*y(k,27) + & + .500_r8*rxt(k,360)*y(k,146) +.100_r8*rxt(k,380)*y(k,106) + & + .600_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,181))*y(k,220) & + + (rxt(k,311)*y(k,54) +rxt(k,153)*y(k,77) + & + 2.000_r8*rxt(k,154)*y(k,231) +rxt(k,246)*y(k,85) + & + rxt(k,269)*y(k,81) +rxt(k,314)*y(k,86))*y(k,216) + (rxt(k,3) + & + rxt(k,273)*y(k,73))*y(k,231) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & + +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31)*y(k,30) +rxt(k,32) & + *y(k,32) +rxt(k,38)*y(k,51) +rxt(k,39)*y(k,53) +rxt(k,43)*y(k,72) & + +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10)*y(k,90) & + +rxt(k,106)*y(k,91) +rxt(k,107)*y(k,92) +rxt(k,47)*y(k,94) & + +rxt(k,54)*y(k,108) +.500_r8*rxt(k,529)*y(k,125) +rxt(k,59)*y(k,128) & + +rxt(k,62)*y(k,143) +rxt(k,63)*y(k,146) +rxt(k,64)*y(k,147) & + +rxt(k,66)*y(k,174) +rxt(k,68)*y(k,176) +rxt(k,71)*y(k,179) & + +rxt(k,72)*y(k,181) +rxt(k,73)*y(k,183) +rxt(k,74)*y(k,185) + loss(k,120) = (rxt(k,577)* y(k,63) +rxt(k,579)* y(k,134) + rxt(k,578) & + + het_rates(k,221))* y(k,221) + prod(k,120) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & + rxt(k,125) +rxt(k,570)*y(k,212) +rxt(k,571)*y(k,214))*y(k,133) & + + (rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,131) +rxt(k,132) + & + rxt(k,133))*y(k,134) + loss(k,94) = (rxt(k,460)* y(k,124) +rxt(k,459)* y(k,202) + het_rates(k,222)) & + * y(k,222) + prod(k,94) = (.200_r8*rxt(k,449)*y(k,66) +.140_r8*rxt(k,461)*y(k,142) + & + rxt(k,464)*y(k,143))*y(k,220) + loss(k,142) = (rxt(k,359)* y(k,124) +rxt(k,358)* y(k,202) + het_rates(k,223)) & + * y(k,223) + prod(k,142) = (.500_r8*rxt(k,360)*y(k,146) +rxt(k,365)*y(k,29))*y(k,220) + loss(k,169) = (rxt(k,363)* y(k,124) +rxt(k,361)* y(k,196) +rxt(k,362) & + * y(k,202) + het_rates(k,224))* y(k,224) + prod(k,169) = (rxt(k,364)*y(k,147) +rxt(k,366)*y(k,48) + & + .150_r8*rxt(k,501)*y(k,178))*y(k,220) + (.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,135) +.150_r8*rxt(k,70)*y(k,178) + loss(k,167) = (rxt(k,492)* y(k,124) +rxt(k,490)* y(k,196) +rxt(k,491) & + * y(k,202) + het_rates(k,225))* y(k,225) + prod(k,167) = (.500_r8*rxt(k,499)*y(k,126) +rxt(k,500)*y(k,220))*y(k,177) & + +rxt(k,493)*y(k,220)*y(k,174) + loss(k,166) = (rxt(k,497)* y(k,124) +rxt(k,495)* y(k,196) +rxt(k,496) & + * y(k,202) + het_rates(k,226))* y(k,226) + prod(k,166) = (rxt(k,481)*y(k,6) +rxt(k,484)*y(k,110) +rxt(k,498)*y(k,176)) & + *y(k,220) + loss(k,131) = (rxt(k,467)* y(k,124) +rxt(k,466)* y(k,202) + het_rates(k,227)) & + * y(k,227) + prod(k,131) = (rxt(k,468)*y(k,179) +.650_r8*rxt(k,469)*y(k,180))*y(k,220) + loss(k,171) = (rxt(k,433)* y(k,124) +rxt(k,434)* y(k,126) +rxt(k,430) & + * y(k,195) +rxt(k,431)* y(k,196) +rxt(k,432)* y(k,202) & + + het_rates(k,228))* y(k,228) + prod(k,171) = (rxt(k,402)*y(k,94) +rxt(k,403)*y(k,96) +rxt(k,404)*y(k,97) + & + .400_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,181))*y(k,220) + loss(k,132) = (rxt(k,473)* y(k,124) +rxt(k,472)* y(k,202) + het_rates(k,229)) & + * y(k,229) + prod(k,132) = (.560_r8*rxt(k,471)*y(k,182) +rxt(k,474)*y(k,183))*y(k,220) + loss(k,103) = (rxt(k,476)* y(k,124) +rxt(k,475)* y(k,202) + het_rates(k,230)) & + * y(k,230) + prod(k,103) = (.300_r8*rxt(k,477)*y(k,184) +rxt(k,478)*y(k,185))*y(k,220) + loss(k,201) = (rxt(k,273)* y(k,73) +rxt(k,515)* y(k,152) +rxt(k,154) & + * y(k,216) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,231)) & + * y(k,231) + prod(k,201) = (rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) +rxt(k,281)*y(k,44) + & + rxt(k,283)*y(k,46) +rxt(k,288)*y(k,84) +rxt(k,304)*y(k,54) + & + rxt(k,179)*y(k,77) +rxt(k,180)*y(k,79) +rxt(k,181)*y(k,202) + & + rxt(k,184)*y(k,220) +rxt(k,187)*y(k,90) +rxt(k,211)*y(k,89) + & + rxt(k,235)*y(k,85) +rxt(k,238)*y(k,92) +rxt(k,264)*y(k,81) + & + rxt(k,297)*y(k,42) +rxt(k,303)*y(k,53) +rxt(k,307)*y(k,87) + & + rxt(k,327)*y(k,28) +rxt(k,329)*y(k,45) +rxt(k,335)*y(k,50) + & + rxt(k,336)*y(k,51) +rxt(k,352)*y(k,30) +rxt(k,353)*y(k,31) + & + rxt(k,355)*y(k,49) +rxt(k,360)*y(k,146) +rxt(k,364)*y(k,147) + & + rxt(k,366)*y(k,48) +.500_r8*rxt(k,379)*y(k,105) +rxt(k,518)*y(k,120)) & + *y(k,220) + (rxt(k,549)*y(k,92) +rxt(k,555)*y(k,92) + & + rxt(k,556)*y(k,91) +rxt(k,560)*y(k,92) +rxt(k,561)*y(k,91))*y(k,85) & + +rxt(k,174)*y(k,202)*y(k,76) +rxt(k,136)*y(k,80) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..34abd9b05d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,595 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 135) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 135) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 113) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 8) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 9) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 10) ! rate_const*BIGALD + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 11) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 12) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 13) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 14) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 23) ! rate_const*BZOOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 27) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 30) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 32) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 45) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 48) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 51) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 53) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 72) ! rate_const*EOOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 74) ! rate_const*GLYALD + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 94) ! rate_const*HPALD + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 95) ! rate_const*HYAC + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 103) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 107) ! rate_const*MEK + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 108) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 109) ! rate_const*MPAN + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 111) ! rate_const*MVK + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 127) ! rate_const*NOA + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 138) ! rate_const*ONITR + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 139) ! rate_const*PAN + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 143) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 146) ! rate_const*POOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 147) ! rate_const*ROOH + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 173) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 174) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 175) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 176) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 177) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 178) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 179) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 181) ! rate_const*XOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 183) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 185) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 18) ! rate_const*BRCL + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 19) ! rate_const*BRO + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 33) ! rate_const*CCL4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 34) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 35) ! rate_const*CF3BR + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 36) ! rate_const*CFC11 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 37) ! rate_const*CFC113 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 38) ! rate_const*CFC114 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 39) ! rate_const*CFC115 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 40) ! rate_const*CFC12 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 41) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 43) ! rate_const*CH3BR + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 44) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 46) ! rate_const*CH3CL + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 55) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 57) ! rate_const*CL2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 58) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 59) ! rate_const*CLO + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 64) ! rate_const*COF2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 65) ! rate_const*COFCL + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 78) ! rate_const*H2402 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 81) ! rate_const*HBR + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 82) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 83) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 84) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 85) ! rate_const*HCL + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 88) ! rate_const*HF + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 91) ! rate_const*HOBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 92) ! rate_const*HOCL + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 136) ! rate_const*OCLO + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*SF6 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 112) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 134) ! rate_const*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 80) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 137) ! rate_const*OCS + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 150) ! rate_const*SO + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 151) ! rate_const*SO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 152) ! rate_const*SO3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 156) ! rate_const*soa1_a1 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 157) ! rate_const*soa1_a2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 158) ! rate_const*soa2_a1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 159) ! rate_const*soa2_a2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 160) ! rate_const*soa3_a1 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 161) ! rate_const*soa3_a2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 162) ! rate_const*soa4_a1 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 163) ! rate_const*soa4_a2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 164) ! rate_const*soa5_a1 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 165) ! rate_const*soa5_a2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 217) ! rate_const*O2_1D + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 218) ! rate_const*O2_1S + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 216)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 216)*sol(:ncol,:, 231) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 216) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 216)*sol(:ncol,:, 134) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 216)*sol(:ncol,:, 134) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 216)*sol(:ncol,:, 135) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 217) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 217)*sol(:ncol,:, 133) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 218)*sol(:ncol,:, 63) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 218) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 218)*sol(:ncol,:, 133) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 218)*sol(:ncol,:, 134) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 218)*sol(:ncol,:, 135) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 133)*sol(:ncol,:, 135) ! rate_const*O*O3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*O*O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 77)*sol(:ncol,:, 133) ! rate_const*H2*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 79)*sol(:ncol,:, 133) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 76)*sol(:ncol,:, 202) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 76)*sol(:ncol,:, 202) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 76)*sol(:ncol,:, 202) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 76)*sol(:ncol,:, 134) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 202)*sol(:ncol,:, 133) ! rate_const*HO2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 202)*sol(:ncol,:, 135) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 76)*sol(:ncol,:, 135) ! rate_const*H*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 220)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 220)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 220)*sol(:ncol,:, 202) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 220)*sol(:ncol,:, 133) ! rate_const*OH*O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 220)*sol(:ncol,:, 135) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 220)*sol(:ncol,:, 220) ! rate_const*OH*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 220)*sol(:ncol,:, 220) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 202)*sol(:ncol,:, 202) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 90)*sol(:ncol,:, 220) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 211)*sol(:ncol,:, 133) ! rate_const*N2D*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 211)*sol(:ncol,:, 134) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 112)*sol(:ncol,:, 134) ! rate_const*N*O2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*NO2*O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 125)*sol(:ncol,:, 135) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 126)*sol(:ncol,:, 202) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 126)*sol(:ncol,:, 133) ! rate_const*NO3*O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 126)*sol(:ncol,:, 220) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 112)*sol(:ncol,:, 220) ! rate_const*N*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 124)*sol(:ncol,:, 202) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 124)*sol(:ncol,:, 135) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 216)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 216)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 125)*sol(:ncol,:, 202) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 125)*sol(:ncol,:, 220) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 89)*sol(:ncol,:, 220) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 114) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 56)*sol(:ncol,:, 202) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 56)*sol(:ncol,:, 202) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 56)*sol(:ncol,:, 135) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 59)*sol(:ncol,:, 196) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 59)*sol(:ncol,:, 202) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 60)*sol(:ncol,:, 220) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 59)*sol(:ncol,:, 133) ! rate_const*CLO*O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 59)*sol(:ncol,:, 220) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 59)*sol(:ncol,:, 220) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 85)*sol(:ncol,:, 133) ! rate_const*HCL*O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 85)*sol(:ncol,:, 220) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 92)*sol(:ncol,:, 220) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 216)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 216)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 216)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 216)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 216)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 216)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 216)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 216)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 216)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 17)*sol(:ncol,:, 202) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 17)*sol(:ncol,:, 135) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 19)*sol(:ncol,:, 202) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*BRO*O + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 19)*sol(:ncol,:, 220) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*HBR*O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 81)*sol(:ncol,:, 220) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 216)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 216)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 216)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 216)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 216)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 73)*sol(:ncol,:, 231) ! rate_const*F*H2O + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 216)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 216)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 41)*sol(:ncol,:, 220) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 43)*sol(:ncol,:, 220) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 44)*sol(:ncol,:, 220) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 46)*sol(:ncol,:, 220) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 55)*sol(:ncol,:, 220) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 82)*sol(:ncol,:, 220) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 83)*sol(:ncol,:, 220) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 220) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 216)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 216)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 216)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 216)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 216)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 42)*sol(:ncol,:, 202) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 42)*sol(:ncol,:, 133) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 42)*sol(:ncol,:, 220) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 196)*sol(:ncol,:, 196) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 196)*sol(:ncol,:, 196) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 196)*sol(:ncol,:, 202) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 52)*sol(:ncol,:, 220) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 53)*sol(:ncol,:, 220) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 54)*sol(:ncol,:, 220) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 62)*sol(:ncol,:, 220) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 86)*sol(:ncol,:, 220) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 87)*sol(:ncol,:, 220) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 203)*sol(:ncol,:, 202) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 203) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 203)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 216)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 216)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 216)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 216)*sol(:ncol,:, 86) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 62)*sol(:ncol,:, 220) ! rate_const*CO*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 24)*sol(:ncol,:, 220) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 25)*sol(:ncol,:, 135) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 192)*sol(:ncol,:, 192) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 192)*sol(:ncol,:, 196) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 192)*sol(:ncol,:, 202) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 26)*sol(:ncol,:, 220) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 27)*sol(:ncol,:, 220) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 28)*sol(:ncol,:, 220) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 45)*sol(:ncol,:, 220) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 47)*sol(:ncol,:, 220) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 195)*sol(:ncol,:, 195) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 195)*sol(:ncol,:, 196) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 195)*sol(:ncol,:, 202) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 50)*sol(:ncol,:, 220) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 51)*sol(:ncol,:, 220) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 201)*sol(:ncol,:, 202) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 201)*sol(:ncol,:, 124) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 200) ! rate_const*EO + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 200)*sol(:ncol,:, 134) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 74)*sol(:ncol,:, 220) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 75)*sol(:ncol,:, 220) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 139)*sol(:ncol,:, 220) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 25)*sol(:ncol,:, 220) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 195)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 139) ! rate_const*M*PAN + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 29)*sol(:ncol,:, 135) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 193)*sol(:ncol,:, 196) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 193)*sol(:ncol,:, 202) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 30)*sol(:ncol,:, 220) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 31)*sol(:ncol,:, 220) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 49)*sol(:ncol,:, 220) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 95)*sol(:ncol,:, 220) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 127)*sol(:ncol,:, 220) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 223)*sol(:ncol,:, 202) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 223)*sol(:ncol,:, 124) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 146)*sol(:ncol,:, 220) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 224)*sol(:ncol,:, 196) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 224)*sol(:ncol,:, 202) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 224)*sol(:ncol,:, 124) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 147)*sol(:ncol,:, 220) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 29)*sol(:ncol,:, 220) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 48)*sol(:ncol,:, 220) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 16)*sol(:ncol,:, 126) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 16)*sol(:ncol,:, 220) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 93)*sol(:ncol,:, 220) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 206)*sol(:ncol,:, 195) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 206)*sol(:ncol,:, 196) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 206)*sol(:ncol,:, 202) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 206)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 105)*sol(:ncol,:, 135) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 105)*sol(:ncol,:, 220) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 106)*sol(:ncol,:, 220) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 208)*sol(:ncol,:, 195) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 208)*sol(:ncol,:, 196) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 208)*sol(:ncol,:, 202) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 208)*sol(:ncol,:, 208) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 208)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 210)*sol(:ncol,:, 202) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 210)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 107)*sol(:ncol,:, 220) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 108)*sol(:ncol,:, 220) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 109)*sol(:ncol,:, 220) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 111)*sol(:ncol,:, 135) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 111)*sol(:ncol,:, 220) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 208)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 109) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 1)*sol(:ncol,:, 220) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 189)*sol(:ncol,:, 202) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 189)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 189)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 2)*sol(:ncol,:, 220) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 15)*sol(:ncol,:, 220) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 94)*sol(:ncol,:, 220) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 96)*sol(:ncol,:, 220) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 97)*sol(:ncol,:, 220) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 204)*sol(:ncol,:, 195) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 204)*sol(:ncol,:, 196) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 204)*sol(:ncol,:, 202) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 204)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 205)*sol(:ncol,:, 195) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 205)*sol(:ncol,:, 196) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 205)*sol(:ncol,:, 202) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 205) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 205)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 205)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 99)*sol(:ncol,:, 220) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 100)*sol(:ncol,:, 220) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 101)*sol(:ncol,:, 195) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 101)*sol(:ncol,:, 196) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 101)*sol(:ncol,:, 202) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 101)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 101)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 102)*sol(:ncol,:, 220) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 98)*sol(:ncol,:, 220) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 103)*sol(:ncol,:, 220) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 115)*sol(:ncol,:, 220) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 116)*sol(:ncol,:, 220) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 228)*sol(:ncol,:, 195) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 228)*sol(:ncol,:, 196) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 228)*sol(:ncol,:, 202) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 228)*sol(:ncol,:, 124) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 228)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 181)*sol(:ncol,:, 220) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 188)*sol(:ncol,:, 202) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 188)*sol(:ncol,:, 124) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 7)*sol(:ncol,:, 220) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 190)*sol(:ncol,:, 202) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 190)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 8)*sol(:ncol,:, 220) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 22)*sol(:ncol,:, 220) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 191)*sol(:ncol,:, 202) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 23)*sol(:ncol,:, 220) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 194)*sol(:ncol,:, 202) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 32)*sol(:ncol,:, 220) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 66)*sol(:ncol,:, 220) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 197)*sol(:ncol,:, 202) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 197)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 207)*sol(:ncol,:, 202) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 207)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 209)*sol(:ncol,:, 202) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 209)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 222)*sol(:ncol,:, 202) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 222)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 142)*sol(:ncol,:, 220) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 141)*sol(:ncol,:, 125) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 141)*sol(:ncol,:, 135) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 143)*sol(:ncol,:, 220) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 188)*sol(:ncol,:, 125) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 227)*sol(:ncol,:, 202) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 227)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 179)*sol(:ncol,:, 220) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 180)*sol(:ncol,:, 220) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 140) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 182)*sol(:ncol,:, 220) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 229)*sol(:ncol,:, 202) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 229)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 183)*sol(:ncol,:, 220) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 230)*sol(:ncol,:, 202) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 230)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 184)*sol(:ncol,:, 220) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 185)*sol(:ncol,:, 220) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 6)*sol(:ncol,:, 220) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 110)*sol(:ncol,:, 220) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 215)*sol(:ncol,:, 196) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 215)*sol(:ncol,:, 202) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 215)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 215)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 128)*sol(:ncol,:, 220) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 225)*sol(:ncol,:, 196) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 225)*sol(:ncol,:, 202) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 225)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 174)*sol(:ncol,:, 220) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 175)*sol(:ncol,:, 220) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 226)*sol(:ncol,:, 196) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 226)*sol(:ncol,:, 202) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 226)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 176)*sol(:ncol,:, 220) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 177)*sol(:ncol,:, 126) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 177)*sol(:ncol,:, 220) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 178)*sol(:ncol,:, 220) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 137)*sol(:ncol,:, 133) ! rate_const*OCS*O + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 137)*sol(:ncol,:, 220) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 148)*sol(:ncol,:, 134) ! rate_const*S*O2 + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 148)*sol(:ncol,:, 135) ! rate_const*S*O3 + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 150)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 150)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 148)*sol(:ncol,:, 220) ! rate_const*S*OH + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 150)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 150)*sol(:ncol,:, 134) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 150)*sol(:ncol,:, 135) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 150)*sol(:ncol,:, 136) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 150)*sol(:ncol,:, 220) ! rate_const*SO*OH + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 151)*sol(:ncol,:, 220) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 152)*sol(:ncol,:, 231) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 67)*sol(:ncol,:, 126) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 67)*sol(:ncol,:, 220) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 120)*sol(:ncol,:, 220) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 67)*sol(:ncol,:, 220) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 202) ! rate_const*HO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 99) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 100) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 115) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 121) ! rate_const*NH4 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 138) ! rate_const*ONITR + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 175) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 6)*sol(:ncol,:, 220) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 7)*sol(:ncol,:, 220) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 98)*sol(:ncol,:, 220) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 104)*sol(:ncol,:, 220) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 110)*sol(:ncol,:, 220) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 172)*sol(:ncol,:, 220) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 180)*sol(:ncol,:, 220) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 182)*sol(:ncol,:, 220) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 213)*sol(:ncol,:, 198) ! rate_const*NOp*e + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 219)*sol(:ncol,:, 198) ! rate_const*O2p*e + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 212)*sol(:ncol,:, 198) ! rate_const*N2p*e + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 212)*sol(:ncol,:, 134) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 212)*sol(:ncol,:, 133) ! rate_const*N2p*O + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 212)*sol(:ncol,:, 133) ! rate_const*N2p*O + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 214)*sol(:ncol,:, 133) ! rate_const*Np*O + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 214)*sol(:ncol,:, 134) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 214)*sol(:ncol,:, 134) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 219)*sol(:ncol,:, 112) ! rate_const*O2p*N + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 219) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 219)*sol(:ncol,:, 124) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 221)*sol(:ncol,:, 63) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 221) ! rate_const*N2*Op + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 221)*sol(:ncol,:, 134) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 171) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..ced8b90f31 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 @@ -0,0 +1,728 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,151) = 0.000258_r8 + rate(:,152) = 0.085_r8 + rate(:,153) = 1.2e-10_r8 + rate(:,158) = 1.2e-10_r8 + rate(:,159) = 1e-20_r8 + rate(:,160) = 1.3e-16_r8 + rate(:,162) = 4.2e-13_r8 + rate(:,164) = 8e-14_r8 + rate(:,165) = 3.9e-17_r8 + rate(:,172) = 6.9e-12_r8 + rate(:,173) = 7.2e-11_r8 + rate(:,174) = 1.6e-12_r8 + rate(:,180) = 1.8e-12_r8 + rate(:,184) = 1.8e-12_r8 + rate(:,188) = 7e-13_r8 + rate(:,189) = 5e-12_r8 + rate(:,198) = 3.5e-12_r8 + rate(:,200) = 1e-11_r8 + rate(:,201) = 2.2e-11_r8 + rate(:,202) = 5e-11_r8 + rate(:,237) = 1.7e-13_r8 + rate(:,239) = 2.607e-10_r8 + rate(:,240) = 9.75e-11_r8 + rate(:,241) = 2.07e-10_r8 + rate(:,242) = 2.088e-10_r8 + rate(:,243) = 1.17e-10_r8 + rate(:,244) = 4.644e-11_r8 + rate(:,245) = 1.204e-10_r8 + rate(:,246) = 9.9e-11_r8 + rate(:,247) = 3.3e-12_r8 + rate(:,266) = 4.5e-11_r8 + rate(:,267) = 4.62e-10_r8 + rate(:,268) = 1.2e-10_r8 + rate(:,269) = 9e-11_r8 + rate(:,270) = 3e-11_r8 + rate(:,275) = 2.14e-11_r8 + rate(:,276) = 1.9e-10_r8 + rate(:,289) = 2.57e-10_r8 + rate(:,290) = 1.8e-10_r8 + rate(:,291) = 1.794e-10_r8 + rate(:,292) = 1.3e-10_r8 + rate(:,293) = 7.65e-11_r8 + rate(:,307) = 4e-13_r8 + rate(:,311) = 1.31e-10_r8 + rate(:,312) = 3.5e-11_r8 + rate(:,313) = 9e-12_r8 + rate(:,320) = 6.8e-14_r8 + rate(:,321) = 2e-13_r8 + rate(:,335) = 7e-13_r8 + rate(:,336) = 1e-12_r8 + rate(:,340) = 1e-14_r8 + rate(:,341) = 1e-11_r8 + rate(:,342) = 1.15e-11_r8 + rate(:,343) = 4e-14_r8 + rate(:,356) = 3e-12_r8 + rate(:,357) = 6.7e-13_r8 + rate(:,367) = 3.5e-13_r8 + rate(:,368) = 5.4e-11_r8 + rate(:,371) = 2e-12_r8 + rate(:,372) = 1.4e-11_r8 + rate(:,375) = 2.4e-12_r8 + rate(:,386) = 5e-12_r8 + rate(:,396) = 1.6e-12_r8 + rate(:,398) = 6.7e-12_r8 + rate(:,401) = 3.5e-12_r8 + rate(:,404) = 1.3e-11_r8 + rate(:,405) = 1.4e-11_r8 + rate(:,409) = 2.4e-12_r8 + rate(:,410) = 1.4e-11_r8 + rate(:,415) = 2.4e-12_r8 + rate(:,416) = 4e-11_r8 + rate(:,417) = 4e-11_r8 + rate(:,419) = 1.4e-11_r8 + rate(:,423) = 2.4e-12_r8 + rate(:,424) = 4e-11_r8 + rate(:,428) = 7e-11_r8 + rate(:,429) = 1e-10_r8 + rate(:,434) = 2.4e-12_r8 + rate(:,449) = 4.7e-11_r8 + rate(:,462) = 2.1e-12_r8 + rate(:,463) = 2.8e-13_r8 + rate(:,471) = 1.7e-11_r8 + rate(:,477) = 8.4e-11_r8 + rate(:,479) = 1.9e-11_r8 + rate(:,480) = 1.2e-14_r8 + rate(:,481) = 2e-10_r8 + rate(:,488) = 2.4e-12_r8 + rate(:,489) = 2e-11_r8 + rate(:,493) = 2.3e-11_r8 + rate(:,494) = 2e-11_r8 + rate(:,498) = 3.3e-11_r8 + rate(:,499) = 1e-12_r8 + rate(:,500) = 5.7e-11_r8 + rate(:,501) = 3.4e-11_r8 + rate(:,504) = 2.3e-12_r8 + rate(:,505) = 1.2e-11_r8 + rate(:,506) = 5.7e-11_r8 + rate(:,507) = 2.8e-11_r8 + rate(:,508) = 6.6e-11_r8 + rate(:,509) = 1.4e-11_r8 + rate(:,512) = 1.9e-12_r8 + rate(:,528) = 6.34e-08_r8 + rate(:,534) = 1.9e-11_r8 + rate(:,535) = 1.2e-14_r8 + rate(:,536) = 2e-10_r8 + rate(:,541) = 1.34e-11_r8 + rate(:,545) = 1.34e-11_r8 + rate(:,547) = 1.7e-11_r8 + rate(:,568) = 6e-11_r8 + rate(:,571) = 1e-12_r8 + rate(:,572) = 4e-10_r8 + rate(:,573) = 2e-10_r8 + rate(:,574) = 1e-10_r8 + rate(:,575) = 5e-16_r8 + rate(:,576) = 4.4e-10_r8 + rate(:,577) = 9e-10_r8 + rate(:,580) = 1.29e-07_r8 + rate(:,581) = 2.31e-07_r8 + rate(:,582) = 2.31e-06_r8 + rate(:,583) = 4.63e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,154) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,155) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,156) = 2.64e-11_r8 * exp_fac(:) + rate(:,157) = 6.6e-12_r8 * exp_fac(:) + rate(:,161) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,163) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,166) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,167) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,170) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,171) = 1.4e-12_r8 * exp_fac(:) + rate(:,425) = 1.05e-14_r8 * exp_fac(:) + rate(:,539) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,176) = 3e-11_r8 * exp_fac(:) + rate(:,264) = 5.5e-12_r8 * exp_fac(:) + rate(:,303) = 3.8e-12_r8 * exp_fac(:) + rate(:,325) = 3.8e-12_r8 * exp_fac(:) + rate(:,352) = 3.8e-12_r8 * exp_fac(:) + rate(:,360) = 3.8e-12_r8 * exp_fac(:) + rate(:,364) = 3.8e-12_r8 * exp_fac(:) + rate(:,380) = 2.3e-11_r8 * exp_fac(:) + rate(:,390) = 3.8e-12_r8 * exp_fac(:) + rate(:,400) = 3.8e-12_r8 * exp_fac(:) + rate(:,427) = 1.52e-11_r8 * exp_fac(:) + rate(:,435) = 1.52e-12_r8 * exp_fac(:) + rate(:,441) = 3.8e-12_r8 * exp_fac(:) + rate(:,444) = 3.8e-12_r8 * exp_fac(:) + rate(:,448) = 3.8e-12_r8 * exp_fac(:) + rate(:,464) = 3.8e-12_r8 * exp_fac(:) + rate(:,468) = 3.8e-12_r8 * exp_fac(:) + rate(:,474) = 3.8e-12_r8 * exp_fac(:) + rate(:,478) = 3.8e-12_r8 * exp_fac(:) + rate(:,177) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,178) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,179) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,181) = 4.8e-11_r8 * exp_fac(:) + rate(:,262) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,182) = 1.8e-11_r8 * exp_fac(:) + rate(:,338) = 4.2e-12_r8 * exp_fac(:) + rate(:,351) = 4.2e-12_r8 * exp_fac(:) + rate(:,359) = 4.2e-12_r8 * exp_fac(:) + rate(:,388) = 4.2e-12_r8 * exp_fac(:) + rate(:,408) = 4.4e-12_r8 * exp_fac(:) + rate(:,414) = 4.4e-12_r8 * exp_fac(:) + rate(:,487) = 4.2e-12_r8 * exp_fac(:) + rate(:,492) = 4.2e-12_r8 * exp_fac(:) + rate(:,497) = 4.2e-12_r8 * exp_fac(:) + rate(:,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,187) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,191) = 2.9e-12_r8 * exp_fac(:) + rate(:,192) = 1.45e-12_r8 * exp_fac(:) + rate(:,193) = 1.45e-12_r8 * exp_fac(:) + rate(:,194) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,196) = 1.2e-13_r8 * exp_fac(:) + rate(:,222) = 3e-11_r8 * exp_fac(:) + rate(:,199) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,203) = 3.3e-12_r8 * exp_fac(:) + rate(:,218) = 1.4e-11_r8 * exp_fac(:) + rate(:,232) = 7.4e-12_r8 * exp_fac(:) + rate(:,334) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,204) = 3e-12_r8 * exp_fac(:) + rate(:,263) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,206) = 7.26e-11_r8 * exp_fac(:) + rate(:,207) = 4.64e-11_r8 * exp_fac(:) + rate(:,214) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,215) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,216) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,217) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + rate(:,219) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,220) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,221) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,223) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,224) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,225) = 2.6e-12_r8 * exp_fac(:) + rate(:,226) = 6.4e-12_r8 * exp_fac(:) + rate(:,256) = 4.1e-13_r8 * exp_fac(:) + rate(:,437) = 7.5e-12_r8 * exp_fac(:) + rate(:,451) = 7.5e-12_r8 * exp_fac(:) + rate(:,454) = 7.5e-12_r8 * exp_fac(:) + rate(:,457) = 7.5e-12_r8 * exp_fac(:) + rate(:,227) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,229) = 3.6e-12_r8 * exp_fac(:) + rate(:,278) = 2e-12_r8 * exp_fac(:) + rate(:,230) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,231) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,233) = 6e-13_r8 * exp_fac(:) + rate(:,253) = 1.5e-12_r8 * exp_fac(:) + rate(:,261) = 1.9e-11_r8 * exp_fac(:) + rate(:,234) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,235) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,236) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,238) = 3e-12_r8 * exp_fac(:) + rate(:,272) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,250) = 1.7e-11_r8 * exp_fac(:) + rate(:,277) = 6.3e-12_r8 * exp_fac(:) + rate(:,251) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,252) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,254) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,255) = 2.3e-12_r8 * exp_fac(:) + rate(:,258) = 8.8e-12_r8 * exp_fac(:) + rate(:,257) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,260) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,265) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,271) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,273) = 1.4e-11_r8 * exp_fac(:) + rate(:,275) = 2.14e-11_r8 * exp_fac(:) + rate(:,276) = 1.9e-10_r8 * exp_fac(:) + rate(:,289) = 2.57e-10_r8 * exp_fac(:) + rate(:,290) = 1.8e-10_r8 * exp_fac(:) + rate(:,291) = 1.794e-10_r8 * exp_fac(:) + rate(:,292) = 1.3e-10_r8 * exp_fac(:) + rate(:,293) = 7.65e-11_r8 * exp_fac(:) + rate(:,307) = 4e-13_r8 * exp_fac(:) + rate(:,311) = 1.31e-10_r8 * exp_fac(:) + rate(:,312) = 3.5e-11_r8 * exp_fac(:) + rate(:,313) = 9e-12_r8 * exp_fac(:) + rate(:,320) = 6.8e-14_r8 * exp_fac(:) + rate(:,321) = 2e-13_r8 * exp_fac(:) + rate(:,335) = 7e-13_r8 * exp_fac(:) + rate(:,336) = 1e-12_r8 * exp_fac(:) + rate(:,340) = 1e-14_r8 * exp_fac(:) + rate(:,341) = 1e-11_r8 * exp_fac(:) + rate(:,342) = 1.15e-11_r8 * exp_fac(:) + rate(:,343) = 4e-14_r8 * exp_fac(:) + rate(:,356) = 3e-12_r8 * exp_fac(:) + rate(:,357) = 6.7e-13_r8 * exp_fac(:) + rate(:,367) = 3.5e-13_r8 * exp_fac(:) + rate(:,368) = 5.4e-11_r8 * exp_fac(:) + rate(:,371) = 2e-12_r8 * exp_fac(:) + rate(:,372) = 1.4e-11_r8 * exp_fac(:) + rate(:,375) = 2.4e-12_r8 * exp_fac(:) + rate(:,386) = 5e-12_r8 * exp_fac(:) + rate(:,396) = 1.6e-12_r8 * exp_fac(:) + rate(:,398) = 6.7e-12_r8 * exp_fac(:) + rate(:,401) = 3.5e-12_r8 * exp_fac(:) + rate(:,404) = 1.3e-11_r8 * exp_fac(:) + rate(:,405) = 1.4e-11_r8 * exp_fac(:) + rate(:,409) = 2.4e-12_r8 * exp_fac(:) + rate(:,410) = 1.4e-11_r8 * exp_fac(:) + rate(:,415) = 2.4e-12_r8 * exp_fac(:) + rate(:,416) = 4e-11_r8 * exp_fac(:) + rate(:,417) = 4e-11_r8 * exp_fac(:) + rate(:,419) = 1.4e-11_r8 * exp_fac(:) + rate(:,423) = 2.4e-12_r8 * exp_fac(:) + rate(:,424) = 4e-11_r8 * exp_fac(:) + rate(:,428) = 7e-11_r8 * exp_fac(:) + rate(:,429) = 1e-10_r8 * exp_fac(:) + rate(:,434) = 2.4e-12_r8 * exp_fac(:) + rate(:,449) = 4.7e-11_r8 * exp_fac(:) + rate(:,462) = 2.1e-12_r8 * exp_fac(:) + rate(:,463) = 2.8e-13_r8 * exp_fac(:) + rate(:,471) = 1.7e-11_r8 * exp_fac(:) + rate(:,477) = 8.4e-11_r8 * exp_fac(:) + rate(:,479) = 1.9e-11_r8 * exp_fac(:) + rate(:,480) = 1.2e-14_r8 * exp_fac(:) + rate(:,481) = 2e-10_r8 * exp_fac(:) + rate(:,488) = 2.4e-12_r8 * exp_fac(:) + rate(:,489) = 2e-11_r8 * exp_fac(:) + rate(:,493) = 2.3e-11_r8 * exp_fac(:) + rate(:,494) = 2e-11_r8 * exp_fac(:) + rate(:,498) = 3.3e-11_r8 * exp_fac(:) + rate(:,499) = 1e-12_r8 * exp_fac(:) + rate(:,500) = 5.7e-11_r8 * exp_fac(:) + rate(:,501) = 3.4e-11_r8 * exp_fac(:) + rate(:,504) = 2.3e-12_r8 * exp_fac(:) + rate(:,505) = 1.2e-11_r8 * exp_fac(:) + rate(:,506) = 5.7e-11_r8 * exp_fac(:) + rate(:,507) = 2.8e-11_r8 * exp_fac(:) + rate(:,508) = 6.6e-11_r8 * exp_fac(:) + rate(:,509) = 1.4e-11_r8 * exp_fac(:) + rate(:,512) = 1.9e-12_r8 * exp_fac(:) + rate(:,528) = 6.34e-08_r8 * exp_fac(:) + rate(:,534) = 1.9e-11_r8 * exp_fac(:) + rate(:,535) = 1.2e-14_r8 * exp_fac(:) + rate(:,536) = 2e-10_r8 * exp_fac(:) + rate(:,541) = 1.34e-11_r8 * exp_fac(:) + rate(:,545) = 1.34e-11_r8 * exp_fac(:) + rate(:,547) = 1.7e-11_r8 * exp_fac(:) + rate(:,568) = 6e-11_r8 * exp_fac(:) + rate(:,571) = 1e-12_r8 * exp_fac(:) + rate(:,572) = 4e-10_r8 * exp_fac(:) + rate(:,573) = 2e-10_r8 * exp_fac(:) + rate(:,574) = 1e-10_r8 * exp_fac(:) + rate(:,575) = 5e-16_r8 * exp_fac(:) + rate(:,576) = 4.4e-10_r8 * exp_fac(:) + rate(:,577) = 9e-10_r8 * exp_fac(:) + rate(:,580) = 1.29e-07_r8 * exp_fac(:) + rate(:,581) = 2.31e-07_r8 * exp_fac(:) + rate(:,582) = 2.31e-06_r8 * exp_fac(:) + rate(:,583) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,274) = 6e-12_r8 * exp_fac(:) + rate(:,373) = 5e-13_r8 * exp_fac(:) + rate(:,406) = 5e-13_r8 * exp_fac(:) + rate(:,411) = 5e-13_r8 * exp_fac(:) + rate(:,420) = 5e-13_r8 * exp_fac(:) + rate(:,431) = 5e-13_r8 * exp_fac(:) + rate(:,279) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,280) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,281) = 1.64e-12_r8 * exp_fac(:) + rate(:,392) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,282) = 2.03e-11_r8 * exp_fac(:) + rate(:,511) = 3.4e-12_r8 * exp_fac(:) + rate(:,283) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,284) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,285) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,286) = 1.25e-12_r8 * exp_fac(:) + rate(:,296) = 3.4e-11_r8 * exp_fac(:) + rate(:,287) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,288) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,294) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,295) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,297) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) + rate(:,298) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,299) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,300) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,301) = 2.8e-12_r8 * exp_fac(:) + rate(:,363) = 2.9e-12_r8 * exp_fac(:) + rate(:,302) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,304) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,308) = 7.5e-13_r8 * exp_fac(:) + rate(:,322) = 7.5e-13_r8 * exp_fac(:) + rate(:,337) = 7.5e-13_r8 * exp_fac(:) + rate(:,350) = 7.5e-13_r8 * exp_fac(:) + rate(:,358) = 7.5e-13_r8 * exp_fac(:) + rate(:,362) = 8.6e-13_r8 * exp_fac(:) + rate(:,374) = 8e-13_r8 * exp_fac(:) + rate(:,387) = 7.5e-13_r8 * exp_fac(:) + rate(:,397) = 7.5e-13_r8 * exp_fac(:) + rate(:,407) = 8e-13_r8 * exp_fac(:) + rate(:,412) = 8e-13_r8 * exp_fac(:) + rate(:,421) = 8e-13_r8 * exp_fac(:) + rate(:,432) = 8e-13_r8 * exp_fac(:) + rate(:,439) = 7.5e-13_r8 * exp_fac(:) + rate(:,443) = 7.5e-13_r8 * exp_fac(:) + rate(:,446) = 7.5e-13_r8 * exp_fac(:) + rate(:,459) = 7.5e-13_r8 * exp_fac(:) + rate(:,466) = 7.5e-13_r8 * exp_fac(:) + rate(:,472) = 7.5e-13_r8 * exp_fac(:) + rate(:,475) = 7.5e-13_r8 * exp_fac(:) + rate(:,486) = 7.5e-13_r8 * exp_fac(:) + rate(:,491) = 7.5e-13_r8 * exp_fac(:) + rate(:,496) = 7.5e-13_r8 * exp_fac(:) + rate(:,309) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,310) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,314) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,319) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,323) = 2.6e-12_r8 * exp_fac(:) + rate(:,440) = 2.6e-12_r8 * exp_fac(:) + rate(:,445) = 2.6e-12_r8 * exp_fac(:) + rate(:,447) = 2.6e-12_r8 * exp_fac(:) + rate(:,460) = 2.6e-12_r8 * exp_fac(:) + rate(:,467) = 2.6e-12_r8 * exp_fac(:) + rate(:,473) = 2.6e-12_r8 * exp_fac(:) + rate(:,476) = 2.6e-12_r8 * exp_fac(:) + rate(:,324) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,326) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,327) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,328) = 1.4e-12_r8 * exp_fac(:) + rate(:,348) = 6.5e-15_r8 * exp_fac(:) + rate(:,329) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + rate(:,330) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,331) = 2.9e-12_r8 * exp_fac(:) + rate(:,332) = 2e-12_r8 * exp_fac(:) + rate(:,361) = 7.1e-13_r8 * exp_fac(:) + rate(:,382) = 2e-12_r8 * exp_fac(:) + rate(:,485) = 2e-12_r8 * exp_fac(:) + rate(:,490) = 2e-12_r8 * exp_fac(:) + rate(:,495) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,333) = 4.3e-13_r8 * exp_fac(:) + rate(:,383) = 4.3e-13_r8 * exp_fac(:) + rate(:,436) = 4.3e-13_r8 * exp_fac(:) + rate(:,450) = 4.3e-13_r8 * exp_fac(:) + rate(:,453) = 4.3e-13_r8 * exp_fac(:) + rate(:,456) = 4.3e-13_r8 * exp_fac(:) + rate(:,339) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,347) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,349) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,353) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) + rate(:,354) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,355) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,369) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,370) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,376) = 2.7e-12_r8 * exp_fac(:) + rate(:,377) = 1.3e-13_r8 * exp_fac(:) + rate(:,379) = 9.6e-12_r8 * exp_fac(:) + rate(:,385) = 5.3e-12_r8 * exp_fac(:) + rate(:,422) = 2.7e-12_r8 * exp_fac(:) + rate(:,433) = 2.7e-12_r8 * exp_fac(:) + rate(:,378) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,381) = 4.6e-12_r8 * exp_fac(:) + rate(:,384) = 2.3e-12_r8 * exp_fac(:) + rate(:,389) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,393) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,399) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,402) = 1.86e-11_r8 * exp_fac(:) + rate(:,403) = 1.86e-11_r8 * exp_fac(:) + rate(:,413) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,418) = 3.03e-12_r8 * exp_fac(:) + rate(:,538) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,426) = 2.54e-11_r8 * exp_fac(:) + rate(:,540) = 2.54e-11_r8 * exp_fac(:) + rate(:,430) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,438) = 2.3e-12_r8 * exp_fac(:) + rate(:,537) = 2.3e-12_r8 * exp_fac(:) + rate(:,442) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,461) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,469) = 1.7e-12_r8 * exp_fac(:) + rate(:,546) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,482) = 1.2e-12_r8 * exp_fac(:) + rate(:,542) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,483) = 6.3e-16_r8 * exp_fac(:) + rate(:,543) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,484) = 1.2e-11_r8 * exp_fac(:) + rate(:,544) = 1.2e-11_r8 * exp_fac(:) + rate(:,502) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,503) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,510) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,513) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + rate(:,516) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,517) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,518) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,175), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,185), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,197), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,205), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,208), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,209), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,210), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,228), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,248), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,259), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 + kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) + call jpl( rate(:,305), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 4.28e-33_r8 + kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) + call jpl( rate(:,306), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,316), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,317), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.6e-29_r8 * itemp(:)**3.3_r8 + kinf(:) = 3.1e-10_r8 * itemp(:) + call jpl( rate(:,318), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8.6e-29_r8 * itemp(:)**3.1_r8 + kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 + call jpl( rate(:,344), m, 0.48_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,345), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,365), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,391), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,452), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,455), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,458), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,465), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,159) = 1e-20_r8 + rate(:n,160) = 1.3e-16_r8 + rate(:n,164) = 8e-14_r8 + rate(:n,165) = 3.9e-17_r8 + rate(:n,172) = 6.9e-12_r8 + rate(:n,188) = 7e-13_r8 + rate(:n,189) = 5e-12_r8 + rate(:n,568) = 6e-11_r8 + rate(:n,571) = 1e-12_r8 + rate(:n,572) = 4e-10_r8 + rate(:n,573) = 2e-10_r8 + rate(:n,574) = 1e-10_r8 + rate(:n,576) = 4.4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,155) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,156) = 2.64e-11_r8 * exp_fac(:) + rate(:n,157) = 6.6e-12_r8 * exp_fac(:) + rate(:n,161) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,163) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,166) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,167) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,176) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,177) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,178) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,181) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,182) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,194) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,203) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,204) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,175) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..9c5d4078b5 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 @@ -0,0 +1,877 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 30, 0, 0, 201, 0 /) + + cls_rxt_cnt(:,1) = (/ 37, 63, 0, 30 /) + cls_rxt_cnt(:,4) = (/ 30, 195, 353, 201 /) + + solsym(:231) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & + 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & + 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & + 'BRY ','BZALD ','BZOOH ','C2H2 ','C2H4 ', & + 'C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ', & + 'C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CHO ', & + 'CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ','CH3COOH ', & + 'CH3COOOH ','CH3OH ','CH3OOH ','CH4 ','CHBR3 ', & + 'CL ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & + 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & + 'CRESOL ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & + 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & + 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & + 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & + 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & + 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & + 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & + 'NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ', & + 'NH4 ','NH_5 ','NH_50 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','O ','O2 ','O3 ', & + 'OCLO ','OCS ','ONITR ','PAN ','PBZNIT ', & + 'PHENO ','PHENOL ','PHENOOH ','pom_a1 ','pom_a4 ', & + 'POOH ','ROOH ','S ','SF6 ','SO ', & + 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'soa1_a1 ','soa1_a2 ','soa2_a1 ','soa2_a2 ','soa3_a1 ', & + 'soa3_a2 ','soa4_a1 ','soa4_a2 ','soa5_a1 ','soa5_a2 ', & + 'SOAG0 ','SOAG1 ','SOAG2 ','SOAG3 ','SOAG4 ', & + 'ST80_25 ','SVOC ','TEPOMUC ','TERP2OOH ','TERPNIT ', & + 'TERPOOH ','TERPROD1 ','TERPROD2 ','TOLOOH ','TOLUENE ', & + 'XOOH ','XYLENES ','XYLENOOH ','XYLOL ','XYLOLOOH ', & + 'NHDEP ','NDEP ','ACBZO2 ','ALKO2 ','BENZO2 ', & + 'BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ', & + 'CH3O2 ','DICARBO2 ','e ','ENEO2 ','EO ', & + 'EO2 ','HO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ', & + 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & + 'N2D ','N2p ','NOp ','Np ','NTERPO2 ', & + 'O1D ','O2_1D ','O2_1S ','O2p ','OH ', & + 'Op ','PHENO2 ','PO2 ','RO2 ','TERP2O2 ', & + 'TERPO2 ','TOLO2 ','XO2 ','XYLENO2 ','XYLOLO2 ', & + 'H2O ' /) + + adv_mass(:231) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & + 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & + 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & + 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, 28.051600_r8, & + 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, & + 44.092200_r8, 110.109200_r8, 153.821800_r8, 165.364506_r8, 148.910210_r8, & + 137.367503_r8, 187.375310_r8, 170.921013_r8, 154.466716_r8, 120.913206_r8, & + 173.833800_r8, 30.025200_r8, 94.937200_r8, 133.402300_r8, 44.051000_r8, & + 50.485900_r8, 41.050940_r8, 58.076800_r8, 72.061400_r8, 60.050400_r8, & + 76.049800_r8, 32.040000_r8, 48.039400_r8, 16.040600_r8, 252.730400_r8, & + 35.452700_r8, 70.905400_r8, 102.904200_r8, 51.452100_r8, 97.457640_r8, & + 100.916850_r8, 28.010400_r8, 44.009800_r8, 66.007206_r8, 82.461503_r8, & + 108.135600_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 28.010400_r8, 78.064600_r8, 18.998403_r8, 60.050400_r8, 58.035600_r8, & + 1.007400_r8, 2.014800_r8, 259.823613_r8, 34.013600_r8, 98.078400_r8, & + 80.911400_r8, 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & + 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & + 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & + 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & + 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & + 145.111140_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 17.028940_r8, & + 18.036340_r8, 28.010400_r8, 28.010400_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 119.074340_r8, 231.239540_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 15.999400_r8, 31.998800_r8, 47.998200_r8, & + 67.451500_r8, 60.076400_r8, 133.100140_r8, 121.047940_r8, 183.117740_r8, & + 93.102400_r8, 94.109800_r8, 176.121600_r8, 12.011000_r8, 12.011000_r8, & + 92.090400_r8, 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, & + 64.064800_r8, 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 28.010400_r8, 310.582400_r8, 140.134400_r8, 186.241400_r8, 215.240140_r8, & + 186.241400_r8, 168.227200_r8, 154.201400_r8, 174.148000_r8, 92.136200_r8, & + 150.126000_r8, 106.162000_r8, 188.173800_r8, 122.161400_r8, 204.173200_r8, & + 14.006740_r8, 14.006740_r8, 137.112200_r8, 103.135200_r8, 159.114800_r8, & + 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, & + 47.032000_r8, 129.089600_r8, 0.548567E-03_r8, 105.108800_r8, 61.057800_r8, & + 77.057200_r8, 33.006200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, & + 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & + 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, 230.232140_r8, & + 15.999400_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, 17.006800_r8, & + 15.999400_r8, 175.114200_r8, 91.083000_r8, 89.068200_r8, 199.218600_r8, & + 185.234000_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:231) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 72.066000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, & + 12.011000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_r8, 24.022000_r8, 24.022000_r8, & + 0.000000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + 60.055000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 36.033000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 48.044000_r8, 24.022000_r8, 84.077000_r8, & + 72.066000_r8, 72.066000_r8, 72.066000_r8, 12.011000_r8, 12.011000_r8, & + 36.033000_r8, 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 12.011000_r8, 264.242000_r8, 84.077000_r8, 120.110000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 108.099000_r8, 84.077000_r8, 84.077000_r8, & + 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8, 0.000000_r8, 84.077000_r8, 60.055000_r8, 72.066000_r8, & + 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, & + 12.011000_r8, 60.055000_r8, 0.000000_r8, 48.044000_r8, 24.022000_r8, & + 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 120.110000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, & + 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 30,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & + 82, 83, 84, 113, 122, 123, 149, 171, 186, 187 /) + clsmap(:201,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & + 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & + 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & + 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & + 81, 85, 86, 87, 88, 89, 90, 91, 92, 93, & + 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, & + 104, 105, 106, 107, 108, 109, 110, 111, 112, 114, & + 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & + 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, & + 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, & + 147, 148, 150, 151, 152, 153, 154, 155, 156, 157, & + 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, & + 168, 169, 170, 172, 173, 174, 175, 176, 177, 178, & + 179, 180, 181, 182, 183, 184, 185, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231 /) + + permute(:201,4) = (/ 123, 124, 1, 2, 153, 48, 84, 49, 85, 95, & + 70, 118, 76, 62, 82, 184, 63, 198, 110, 64, & + 79, 71, 112, 66, 80, 72, 160, 89, 39, 67, & + 193, 170, 38, 156, 175, 111, 105, 140, 90, 188, & + 47, 36, 200, 157, 165, 40, 51, 54, 69, 3, & + 4, 5, 41, 136, 161, 149, 195, 172, 115, 42, & + 145, 183, 52, 141, 59, 196, 99, 134, 146, 162, & + 60, 164, 73, 43, 148, 119, 108, 173, 88, 127, & + 34, 174, 74, 107, 75, 114, 151, 179, 144, 68, & + 83, 159, 6, 7, 8, 37, 9, 187, 197, 194, & + 147, 86, 10, 11, 12, 13, 192, 186, 191, 77, & + 81, 61, 97, 44, 98, 50, 78, 14, 15, 109, & + 87, 129, 182, 155, 65, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 35, 55, 116, 121, 100, 158, 163, & + 117, 53, 56, 57, 128, 58, 91, 104, 154, 101, & + 92, 152, 143, 122, 181, 185, 133, 139, 113, 96, & + 135, 199, 93, 176, 177, 178, 130, 180, 150, 125, & + 106, 126, 138, 102, 168, 189, 45, 46, 137, 190, & + 120, 94, 142, 169, 167, 166, 131, 171, 132, 103, & + 201 /) + + diag_map(:201) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 39, 45, 46, 49, 52, 55, 59, & + 62, 65, 68, 71, 74, 77, 79, 86, 92, 96, & + 101, 105, 114, 121, 126, 130, 139, 147, 152, 155, & + 160, 163, 166, 169, 173, 177, 181, 185, 191, 197, & + 200, 206, 212, 215, 220, 225, 230, 235, 241, 246, & + 251, 259, 267, 273, 279, 285, 291, 297, 303, 309, & + 315, 323, 329, 336, 342, 345, 350, 357, 361, 368, & + 377, 384, 392, 400, 406, 412, 417, 422, 430, 438, & + 446, 450, 458, 466, 474, 481, 492, 501, 505, 514, & + 521, 529, 536, 547, 558, 567, 578, 589, 600, 607, & + 618, 634, 645, 654, 664, 673, 681, 690, 701, 708, & + 712, 717, 728, 744, 753, 762, 769, 781, 798, 803, & + 820, 840, 858, 880, 892, 898, 906, 916, 928, 943, & + 960, 968, 982, 991, 997,1008,1030,1049,1065,1076, & + 1091,1104,1124,1140,1152,1172,1206,1231,1251,1271, & + 1302,1318,1337,1352,1396,1427,1507,1543,1570,1719, & + 1782,1824,1849,1907,1928,1951,1994,2019,2115,2143, & + 2170 /) + + extfrc_lst(: 23) = (/ 'NO2 ','NO ','CO ','SO2 ','SVOC ', & + 'so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ','num_a1 ', & + 'num_a2 ','num_a4 ','bc_a1 ','bc_a4 ','AOA_NH ', & + 'O2p ','Np ','N2p ','N2D ','e ', & + 'N ','OH ','Op ' /) + + frc_from_dataset(: 23) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 43) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'e ', 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', & + 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', & + 'MCO3 ', 'MDIALO2 ', 'MEKO2 ', 'N2D ', 'N2p ', & + 'NOp ', 'Np ', 'NTERPO2 ', 'O1D ', 'O2_1D ', & + 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'PHENO2 ', & + 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', 'TOLO2 ', & + 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jalknit ', & + 'jalkooh ', 'jbenzooh ', & + 'jbepomuc ', 'jbigald ', & + 'jbigald1 ', 'jbigald2 ', & + 'jbigald3 ', 'jbigald4 ', & + 'jbzooh ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jc6h5ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_a ', & + 'jch4_b ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhonitr ', & + 'jhpald ', 'jhyac ', & + 'jisopnooh ', 'jisopooh ', & + 'jmacr_a ', 'jmacr_b ', & + 'jmek ', 'jmekooh ', & + 'jmpan ', 'jmvk ', & + 'jnc4cho ', 'jnoa ', & + 'jnterpooh ', 'jonitr ', & + 'jpan ', 'jphenooh ', & + 'jpooh ', 'jrooh ', & + 'jtepomuc ', 'jterp2ooh ', & + 'jterpnit ', 'jterpooh ', & + 'jterprd1 ', 'jterprd2 ', & + 'jtolooh ', 'jxooh ', & + 'jxylenooh ', 'jxylolooh ', & + 'jbrcl ', 'jbro ', & + 'jbrono2_b ', 'jbrono2_a ', & + 'jccl4 ', 'jcf2clbr ', & + 'jcf3br ', 'jcfcl3 ', & + 'jcfc113 ', 'jcfc114 ', & + 'jcfc115 ', 'jcf2cl2 ', & + 'jch2br2 ', 'jch3br ', & + 'jch3ccl3 ', 'jch3cl ', & + 'jchbr3 ', 'jcl2 ', & + 'jcl2o2 ', 'jclo ', & + 'jclono2_a ', 'jclono2_b ', & + 'jcof2 ', 'jcofcl ', & + 'jh2402 ', 'jhbr ', & + 'jhcfc141b ', 'jhcfc142b ', & + 'jhcfc22 ', 'jhcl ', & + 'jhf ', 'jhobr ', & + 'jhocl ', 'joclo ', & + 'jsf6 ', 'jeuv_26 ', & + 'jeuv_4 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_6 ', & + 'jeuv_10 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_2 ', & + 'jeuv_1 ', 'jeuv_16 ', & + 'jeuv_15 ', 'jeuv_14 ', & + 'jeuv_3 ', 'jeuv_17 ', & + 'jeuv_9 ', 'jeuv_8 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jh2so4 ', & + 'jocs ', 'jso ', & + 'jso2 ', 'jso3 ', & + 'jsoa1_a1 ', 'jsoa1_a2 ', & + 'jsoa2_a1 ', 'jsoa2_a2 ', & + 'jsoa3_a1 ', 'jsoa3_a2 ', & + 'jsoa4_a1 ', 'jsoa4_a2 ', & + 'jsoa5_a1 ', 'jsoa5_a2 ', & + 'ag1 ', 'ag2 ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_O3 ', & + 'O2_1D_N2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1S_CO2 ', & + 'O2_1S_N2 ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_O3 ', & + 'O_O3 ', 'usr_O_O ', & + 'usr_O_O2 ', 'H2_O ', & + 'H2O2_O ', 'H_HO2 ', & + 'H_HO2a ', 'H_HO2b ', & + 'H_O2 ', 'HO2_O ', & + 'HO2_O3 ', 'H_O3 ', & + 'OH_H2 ', 'OH_H2O2 ', & + 'OH_HO2 ', 'OH_O ', & + 'OH_O3 ', 'OH_OH ', & + 'OH_OH_M ', 'usr_HO2_HO2 ', & + 'HO2NO2_OH ', 'N2D_O ', & + 'N2D_O2 ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'N_O2 ', & + 'NO2_O ', 'NO2_O3 ', & + 'NO2_O_M ', 'NO3_HO2 ', & + 'NO3_NO ', 'NO3_O ' /) + rxt_tag_lst( 201: 400) = (/ 'NO3_OH ', 'N_OH ', & + 'NO_HO2 ', 'NO_O3 ', & + 'NO_O_M ', 'O1D_N2Oa ', & + 'O1D_N2Ob ', 'tag_NO2_HO2 ', & + 'tag_NO2_NO3 ', 'tag_NO2_OH ', & + 'usr_HNO3_OH ', 'usr_HO2NO2_M ', & + 'usr_N2O5_M ', 'CL_CH2O ', & + 'CL_CH4 ', 'CL_H2 ', & + 'CL_H2O2 ', 'CL_HO2a ', & + 'CL_HO2b ', 'CL_O3 ', & + 'CLO_CH3O2 ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'CLO_HO2 ', 'CLO_NO ', & + 'CLONO2_CL ', 'CLO_NO2_M ', & + 'CLONO2_O ', 'CLONO2_OH ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'HCL_O ', & + 'HCL_OH ', 'HOCL_CL ', & + 'HOCL_O ', 'HOCL_OH ', & + 'O1D_CCL4 ', 'O1D_CF2CLBR ', & + 'O1D_CFC11 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_CFC12 ', 'O1D_HCLa ', & + 'O1D_HCLb ', 'tag_CLO_CLO_M ', & + 'usr_CL2O2_M ', 'BR_CH2O ', & + 'BR_HO2 ', 'BR_O3 ', & + 'BRO_BRO ', 'BRO_CLOa ', & + 'BRO_CLOb ', 'BRO_CLOc ', & + 'BRO_HO2 ', 'BRO_NO ', & + 'BRO_NO2_M ', 'BRONO2_O ', & + 'BRO_O ', 'BRO_OH ', & + 'HBR_O ', 'HBR_OH ', & + 'HOBR_O ', 'O1D_CF3BR ', & + 'O1D_CHBR3 ', 'O1D_H2402 ', & + 'O1D_HBRa ', 'O1D_HBRb ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'CO_OH_M ', 'HCN_OH ', & + 'HCOOH_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH_b ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', 'C2H4_CL_M ', & + 'C2H4_O3 ', 'C2H5O2_C2H5O2 ', & + 'C2H5O2_CH3O2 ', 'C2H5O2_HO2 ', & + 'C2H5O2_NO ', 'C2H5OH_OH ', & + 'C2H5OOH_OH ', 'C2H6_CL ', & + 'C2H6_OH ', 'CH3CHO_NO3 ', & + 'CH3CHO_OH ', 'CH3CN_OH ', & + 'CH3CO3_CH3CO3 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_NO ', & + 'CH3COOH_OH ', 'CH3COOOH_OH ', & + 'EO2_HO2 ', 'EO2_NO ', & + 'EO_M ', 'EO_O2 ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'PAN_OH ', 'tag_C2H4_OH ', & + 'tag_CH3CO3_NO2 ', 'usr_PAN_M ', & + 'C3H6_NO3 ', 'C3H6_O3 ', & + 'C3H7O2_CH3O2 ', 'C3H7O2_HO2 ', & + 'C3H7O2_NO ', 'C3H7OOH_OH ', & + 'C3H8_OH ', 'CH3COCHO_NO3 ', & + 'CH3COCHO_OH ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRO2_CH3CO3 ', & + 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & + 'MACRO2_NO3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACR_O3 ', & + 'MACR_OH ', 'MACROOH_OH ', & + 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & + 'MCO3_HO2 ', 'MCO3_MCO3 ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'usr_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ' /) + rxt_tag_lst( 401: 583) = (/ 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ', & + 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_OH ', 'OCS_O ', & + 'OCS_OH ', 'S_O2 ', & + 'S_O3 ', 'SO_BRO ', & + 'SO_CLO ', 'S_OH ', & + 'SO_NO2 ', 'SO_O2 ', & + 'SO_O3 ', 'SO_OCLO ', & + 'SO_OH ', 'usr_SO2_OH ', & + 'usr_SO3_H2O ', 'DMS_NO3 ', & + 'DMS_OHa ', 'NH3_OH ', & + 'usr_DMS_OH ', 'usr_GLYOXAL_aer ', & + 'usr_HO2_aer ', 'usr_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOC_OH ', 'MTERP_NO3_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'XYLENES_OH_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_O2 ', 'E90_tau ', & + 'NH_50_tau ', 'NH_5_tau ', & + 'ST80_25_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', 'jch2o_a ', 'jno2 ', ' ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + 'jacet ', 'jch3ooh ', 'jpan ', ' ', & + 'jch2o_a ', 'jch2o_a ', 'jch3ooh ', 'jch3cho ', & + ' ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jno2 ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3cho ', 'jch3cho ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, .10_r8, 0.2_r8, .14_r8, & + .20_r8, .20_r8, .006_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 0.28_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .10_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 155, 156, 157, 159, 160, & + 161, 163, 164, 165, 166, & + 167, 168, 169, 172, 175, & + 176, 177, 178, 181, 182, & + 183, 186, 188, 189, 190, & + 194, 195, 203, 204, 565, & + 566, 567, 568, 569, 571, & + 572, 573, 574, 576, 578, & + 579 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, & + 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, 203.400000_r8, & + 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, 67.670000_r8, & + 165.300000_r8, 165.510000_r8, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 82.389000_r8, & + 508.950000_r8, 354.830000_r8, 339.590000_r8, 67.530000_r8, 95.550000_r8, & + 239.840000_r8, 646.280000_r8, 406.160000_r8, 271.380000_r8, 105.040000_r8, & + 150.110000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 3, 3, 3, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 3, 2, 2, 1, 2, & + 2, 2, 2, 2, 2, 3, 3, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 2, 3, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 3, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 1, 2, 1, & + 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & + 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc new file mode 100644 index 0000000000..504099bf06 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.doc @@ -0,0 +1,1417 @@ + + + Solution species + ( 1) O3 + ( 2) O + ( 3) O1D (O) + ( 4) O2 + ( 5) O2_1S (O2) + ( 6) O2_1D (O2) + ( 7) N2O + ( 8) N + ( 9) NO + ( 10) NO2 + ( 11) NO3 + ( 12) HNO3 + ( 13) HO2NO2 + ( 14) N2O5 + ( 15) CH4 + ( 16) CH3O2 + ( 17) CH3OOH + ( 18) CH3OH + ( 19) CH2O + ( 20) CO + ( 21) H2 + ( 22) H + ( 23) OH + ( 24) HO2 + ( 25) H2O2 + ( 26) CLY + ( 27) BRY + ( 28) CL (Cl) + ( 29) CL2 (Cl2) + ( 30) CLO (ClO) + ( 31) OCLO (OClO) + ( 32) CL2O2 (Cl2O2) + ( 33) HCL (HCl) + ( 34) HOCL (HOCl) + ( 35) CLONO2 (ClONO2) + ( 36) BRCL (BrCl) + ( 37) BR (Br) + ( 38) BRO (BrO) + ( 39) HBR (HBr) + ( 40) HOBR (HOBr) + ( 41) BRONO2 (BrONO2) + ( 42) HCN + ( 43) CH3CN + ( 44) C2H4 + ( 45) C2H6 + ( 46) C2H5O2 + ( 47) C2H5OOH + ( 48) CH3CO3 + ( 49) CH3COOH + ( 50) CH3CHO + ( 51) C2H5OH + ( 52) GLYALD (HOCH2CHO) + ( 53) GLYOXAL (C2H2O2) + ( 54) CH3COOOH + ( 55) EO2 (HOCH2CH2O2) + ( 56) EO (HOCH2CH2O) + ( 57) EOOH (HOCH2CH2OOH) + ( 58) PAN (CH3CO3NO2) + ( 59) C3H6 + ( 60) C3H8 + ( 61) C3H7O2 + ( 62) C3H7OOH + ( 63) CH3COCH3 + ( 64) PO2 (C3H6OHO2) + ( 65) POOH (C3H6OHOOH) + ( 66) HYAC (CH3COCH2OH) + ( 67) RO2 (CH3COCH2O2) + ( 68) CH3COCHO + ( 69) ROOH (CH3COCH2OOH) + ( 70) BIGENE (C4H8) + ( 71) BIGALK (C5H12) + ( 72) MEK (C4H8O) + ( 73) ENEO2 (C4H9O3) + ( 74) MEKO2 (C4H7O3) + ( 75) MEKOOH (C4H8O3) + ( 76) MCO3 (CH2CCH3CO3) + ( 77) MVK (CH2CHCOCH3) + ( 78) MACR (CH2CCH3CHO) + ( 79) MACRO2 (CH3COCHO2CH2OH) + ( 80) MACROOH (CH3COCHOOHCH2OH) + ( 81) MPAN (CH2CCH3CO3NO2) + ( 82) ONIT (CH3COCH2ONO2) + ( 83) ISOP (C5H8) + ( 84) ALKO2 (C5H11O2) + ( 85) ALKOOH (C5H12O2) + ( 86) BIGALD (C5H6O2) + ( 87) HYDRALD (HOCH2CCH3CHCHO) + ( 88) ISOPO2 (HOCH2COOCH3CHCH2) + ( 89) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 90) ONITR (CH2CCH3CHONO2CH2OH) + ( 91) XO2 (HOCH2COOCH3CHOHCHO) + ( 92) XOOH (HOCH2COOHCH3CHOHCHO) + ( 93) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 94) TOLUENE (C7H8) + ( 95) CRESOL (C7H8O) + ( 96) TOLO2 (C7H9O5) + ( 97) TOLOOH (C7H10O5) + ( 98) XOH (C7H10O6) + ( 99) BENZENE (C6H6) + (100) BENO2 (C6H7O3) + (101) BENOOH (C6H8O3) + (102) XYLENE (C8H10) + (103) XYLO2 (C8H11O3) + (104) XYLOOH (C8H12O3) + (105) C10H16 + (106) TERPO2 (C10H17O3) + (107) TERPOOH (C10H18O3) + (108) CH3CL (CH3Cl) + (109) CH3BR (CH3Br) + (110) CFC11 (CFCl3) + (111) CFC12 (CF2Cl2) + (112) CFC113 (CCl2FCClF2) + (113) HCFC22 (CHF2Cl) + (114) CCL4 (CCl4) + (115) CH3CCL3 (CH3CCl3) + (116) CF3BR (CF3Br) + (117) CF2CLBR (CF2ClBr) + (118) HCFC141B (CH3CCl2F) + (119) HCFC142B (CH3CClF2) + (120) CFC114 (CClF2CClF2) + (121) CFC115 (CClF2CF3) + (122) H1202 (CBr2F2) + (123) H2402 (CBrF2CBrF2) + (124) CHBR3 (CHBr3) + (125) CH2BR2 (CH2Br2) + (126) CO2 + (127) N2p (N2) + (128) O2p (O2) + (129) Np (N) + (130) Op (O) + (131) NOp (NO) + (132) e (E) + (133) N2D (N) + (134) H2O + (135) C2H2 + (136) HCOOH + (137) HOCH2OO + (138) COF2 + (139) COFCL (COFCl) + (140) HF + (141) F + (142) CB1 (C) + (143) CB2 (C) + (144) OC1 (C) + (145) OC2 (C) + (146) SOAM (C10H16O4) + (147) SOAI (CH3C4H9O4) + (148) SOAT (C7H9O3) + (149) SOAB (C6H7O3) + (150) SOAX (C8H11O3) + (151) SOGM (C10H16O4) + (152) SOGI (CH3C4H9O4) + (153) SOGT (C7H9O3) + (154) SOGB (C6H7O3) + (155) SOGX (C8H11O3) + (156) SO2 + (157) DMS (CH3SCH3) + (158) SO4 + (159) NH3 + (160) NH4 + (161) NH4NO3 + (162) OCS + (163) S + (164) SO + (165) SO3 + (166) H2SO4 + (167) SSLT01 (NaCl) + (168) SSLT02 (NaCl) + (169) SSLT03 (NaCl) + (170) SSLT04 (NaCl) + (171) DST01 (AlSiO5) + (172) DST02 (AlSiO5) + (173) DST03 (AlSiO5) + (174) DST04 (AlSiO5) + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CH4 + ( 2) N2O + ( 3) CH3CL + ( 4) CH3BR + ( 5) CFC11 + ( 6) CFC12 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) HCFC22 + ( 11) HCFC141B + ( 12) HCFC142B + ( 13) CCL4 + ( 14) CH3CCL3 + ( 15) CF3BR + ( 16) CF2CLBR + ( 17) H1202 + ( 18) H2402 + ( 19) CHBR3 + ( 20) CH2BR2 + ( 21) CO2 + ( 22) CLY + ( 23) BRY + + Implicit + -------- + ( 1) O3 + ( 2) O + ( 3) O1D + ( 4) O2 + ( 5) O2_1S + ( 6) O2_1D + ( 7) H2 + ( 8) CO + ( 9) N + ( 10) NO + ( 11) NO2 + ( 12) OH + ( 13) NO3 + ( 14) HNO3 + ( 15) HO2NO2 + ( 16) N2O5 + ( 17) CH3O2 + ( 18) CH3OOH + ( 19) HCN + ( 20) CH3CN + ( 21) CH2O + ( 22) H + ( 23) HO2 + ( 24) H2O2 + ( 25) H2O + ( 26) CL + ( 27) CL2 + ( 28) CLO + ( 29) OCLO + ( 30) CL2O2 + ( 31) HCL + ( 32) HOCL + ( 33) CLONO2 + ( 34) BRCL + ( 35) BR + ( 36) BRO + ( 37) HBR + ( 38) HOBR + ( 39) BRONO2 + ( 40) N2p + ( 41) O2p + ( 42) Np + ( 43) Op + ( 44) NOp + ( 45) N2D + ( 46) e + ( 47) C3H6 + ( 48) ISOP + ( 49) PO2 + ( 50) CH3CHO + ( 51) CH3COOH + ( 52) POOH + ( 53) CH3CO3 + ( 54) CH3COOOH + ( 55) PAN + ( 56) ONIT + ( 57) C2H6 + ( 58) C2H4 + ( 59) BIGALK + ( 60) MPAN + ( 61) BIGENE + ( 62) ENEO2 + ( 63) ALKO2 + ( 64) ALKOOH + ( 65) MEK + ( 66) MEKO2 + ( 67) MEKOOH + ( 68) TOLUENE + ( 69) CRESOL + ( 70) TOLO2 + ( 71) TOLOOH + ( 72) XOH + ( 73) TERPO2 + ( 74) TERPOOH + ( 75) BIGALD + ( 76) GLYOXAL + ( 77) BENZENE + ( 78) BENO2 + ( 79) BENOOH + ( 80) XYLENE + ( 81) XYLO2 + ( 82) XYLOOH + ( 83) ISOPO2 + ( 84) MVK + ( 85) MACR + ( 86) MACRO2 + ( 87) MACROOH + ( 88) MCO3 + ( 89) C2H5O2 + ( 90) C2H5OOH + ( 91) C10H16 + ( 92) C3H8 + ( 93) C3H7O2 + ( 94) C3H7OOH + ( 95) CH3COCH3 + ( 96) ROOH + ( 97) CH3OH + ( 98) C2H5OH + ( 99) GLYALD + (100) HYAC + (101) EO2 + (102) EO + (103) EOOH + (104) HYDRALD + (105) RO2 + (106) CH3COCHO + (107) ISOPNO3 + (108) ONITR + (109) XO2 + (110) XOOH + (111) ISOPOOH + (112) C2H2 + (113) HCOOH + (114) HOCH2OO + (115) COF2 + (116) COFCL + (117) HF + (118) F + (119) SO2 + (120) DMS + (121) SO4 + (122) NH3 + (123) NH4 + (124) NH4NO3 + (125) SOAM + (126) SOAI + (127) SOAT + (128) SOAB + (129) SOAX + (130) SOGM + (131) SOGI + (132) SOGT + (133) SOGB + (134) SOGX + (135) OCS + (136) S + (137) SO + (138) SO3 + (139) H2SO4 + (140) CB1 + (141) CB2 + (142) OC1 + (143) OC2 + (144) SSLT01 + (145) SSLT02 + (146) SSLT03 + (147) SSLT04 + (148) DST01 + (149) DST02 + (150) DST03 + (151) DST04 + + Photolysis + jo2_a ( 1) O2 + hv -> O + O1D rate = ** User defined ** ( 1) + jo2_b ( 2) O2 + hv -> 2*O rate = ** User defined ** ( 2) + jo3_a ( 3) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 3) + jo3_b ( 4) O3 + hv -> O + O2 rate = ** User defined ** ( 4) + jn2o ( 5) N2O + hv -> O1D + N2 rate = ** User defined ** ( 5) + jno ( 6) NO + hv -> N + O rate = ** User defined ** ( 6) + jno_i ( 7) NO + hv -> NOp + e rate = ** User defined ** ( 7) + jno2 ( 8) NO2 + hv -> NO + O rate = ** User defined ** ( 8) + jn2o5_a ( 9) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 9) + jn2o5_b ( 10) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 10) + jhno3 ( 11) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 11) + jno3_a ( 12) NO3 + hv -> NO2 + O rate = ** User defined ** ( 12) + jno3_b ( 13) NO3 + hv -> NO + O2 rate = ** User defined ** ( 13) + jho2no2_a ( 14) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 14) + jho2no2_b ( 15) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 15) + jch3ooh ( 16) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 16) + jch2o_a ( 17) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 17) + jch2o_b ( 18) CH2O + hv -> CO + H2 rate = ** User defined ** ( 18) + jh2o_a ( 19) H2O + hv -> OH + H rate = ** User defined ** ( 19) + jh2o_b ( 20) H2O + hv -> H2 + O1D rate = ** User defined ** ( 20) + jh2o_c ( 21) H2O + hv -> 2*H + O rate = ** User defined ** ( 21) + jh2o2 ( 22) H2O2 + hv -> 2*OH rate = ** User defined ** ( 22) + jcl2 ( 23) CL2 + hv -> 2*CL rate = ** User defined ** ( 23) + jclo ( 24) CLO + hv -> CL + O rate = ** User defined ** ( 24) + joclo ( 25) OCLO + hv -> O + CLO rate = ** User defined ** ( 25) + jcl2o2 ( 26) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 26) + jhocl ( 27) HOCL + hv -> OH + CL rate = ** User defined ** ( 27) + jhcl ( 28) HCL + hv -> H + CL rate = ** User defined ** ( 28) + jclono2_a ( 29) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 29) + jclono2_b ( 30) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 30) + jbrcl ( 31) BRCL + hv -> BR + CL rate = ** User defined ** ( 31) + jbro ( 32) BRO + hv -> BR + O rate = ** User defined ** ( 32) + jhobr ( 33) HOBR + hv -> BR + OH rate = ** User defined ** ( 33) + jhbr ( 34) HBR + hv -> BR + H rate = ** User defined ** ( 34) + jbrono2_a ( 35) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 35) + jbrono2_b ( 36) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 36) + jch3cl ( 37) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 37) + jccl4 ( 38) CCL4 + hv -> 4*CL rate = ** User defined ** ( 38) + jch3ccl3 ( 39) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 39) + jcfcl3 ( 40) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 40) + jcf2cl2 ( 41) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 41) + jcfc113 ( 42) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 42) + jcfc114 ( 43) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 43) + jcfc115 ( 44) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 44) + jhcfc22 ( 45) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 45) + jhcfc141b ( 46) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 46) + jhcfc142b ( 47) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 47) + jch3br ( 48) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 48) + jcf3br ( 49) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 49) + jcf2clbr ( 50) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 50) + jchbr3 ( 51) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 51) + jch2br2 ( 52) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 52) + jh1202 ( 53) H1202 + hv -> 2*BR + COF2 rate = ** User defined ** ( 53) + jh2402 ( 54) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 54) + jcof2 ( 55) COF2 + hv -> 2*F rate = ** User defined ** ( 55) + jcofcl ( 56) COFCL + hv -> F + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jco2 ( 58) CO2 + hv -> CO + O rate = ** User defined ** ( 58) + jch4_a ( 59) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 59) + jch4_b ( 60) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 60) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch3cho ( 61) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jch3co3h ( 63) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 63) + jpan ( 64) PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 rate = ** User defined ** ( 64) + jmpan ( 65) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 65) + jmacr_a ( 66) MACR + hv -> 1.34*HO2 + .66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 66) + jmacr_b ( 67) MACR + hv -> .66*HO2 + 1.34*CO rate = ** User defined ** ( 67) + jmvk ( 68) MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 rate = ** User defined ** ( 68) + jc2h5ooh ( 69) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 69) + jeooh ( 70) EOOH + hv -> EO + OH rate = ** User defined ** ( 70) + jc3h7ooh ( 71) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 71) + jrooh ( 72) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 72) + jacet ( 73) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 73) + jmgly ( 74) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 74) + jxooh ( 75) XOOH + hv -> OH rate = ** User defined ** ( 75) + jonitr ( 76) ONITR + hv -> HO2 + CO + NO2 + CH2O rate = ** User defined ** ( 76) + jisopooh ( 77) ISOPOOH + hv -> .402*MVK + .288*MACR + .69*CH2O + HO2 rate = ** User defined ** ( 77) + jhyac ( 78) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 78) + jglyald ( 79) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 79) + jmek ( 80) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 80) + jbigald ( 81) BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 rate = ** User defined ** ( 81) + + .18*CH3COCHO + jglyoxal ( 82) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 82) + jalkooh ( 83) ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK rate = ** User defined ** ( 83) + + OH + jmekooh ( 84) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 84) + jtolooh ( 85) TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD rate = ** User defined ** ( 85) + jterpooh ( 86) TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR rate = ** User defined ** ( 86) + jh2so4 ( 87) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 87) + jso2 ( 88) SO2 + hv -> SO + O rate = ** User defined ** ( 88) + jso3 ( 89) SO3 + hv -> SO2 + O rate = ** User defined ** ( 89) + jocs ( 90) OCS + hv -> S + CO rate = ** User defined ** ( 90) + jso ( 91) SO + hv -> S + O rate = ** User defined ** ( 91) + jeuv_1 ( 92) O + hv -> Op + e rate = ** User defined ** ( 92) + jeuv_2 ( 93) O + hv -> Op + e rate = ** User defined ** ( 93) + jeuv_3 ( 94) O + hv -> Op + e rate = ** User defined ** ( 94) + jeuv_4 ( 95) N + hv -> Np + e rate = ** User defined ** ( 95) + jeuv_5 ( 96) O2 + hv -> O2p + e rate = ** User defined ** ( 96) + jeuv_6 ( 97) N2 + hv -> N2p + e rate = ** User defined ** ( 97) + jeuv_7 ( 98) O2 + hv -> O + Op + e rate = ** User defined ** ( 98) + jeuv_8 ( 99) O2 + hv -> O + Op + e rate = ** User defined ** ( 99) + jeuv_9 (100) O2 + hv -> O + Op + e rate = ** User defined ** (100) + jeuv_10 (101) N2 + hv -> N + Np + e rate = ** User defined ** (101) + jeuv_11 (102) N2 + hv -> N2D + Np + e rate = ** User defined ** (102) + jeuv_12 (103) O2 + hv -> 2*O rate = ** User defined ** (103) + jeuv_13 (104) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** (104) + jeuv_14 (105) O + hv -> Op + e rate = ** User defined ** (105) + jeuv_15 (106) O + hv -> Op + e rate = ** User defined ** (106) + jeuv_16 (107) O + hv -> Op + e rate = ** User defined ** (107) + jeuv_17 (108) O2 + hv -> O2p + e rate = ** User defined ** (108) + jeuv_18 (109) N2 + hv -> N2p + e rate = ** User defined ** (109) + jeuv_19 (110) O2 + hv -> O + Op + e rate = ** User defined ** (110) + jeuv_20 (111) O2 + hv -> O + Op + e rate = ** User defined ** (111) + jeuv_21 (112) O2 + hv -> O + Op + e rate = ** User defined ** (112) + jeuv_22 (113) N2 + hv -> N + Np + e rate = ** User defined ** (113) + jeuv_23 (114) N2 + hv -> N2D + Np + e rate = ** User defined ** (114) + jeuv_24 (115) O2 + hv -> 2*O rate = ** User defined ** (115) + jeuv_25 (116) N2 + hv -> 1.2*N2D + .8*N rate = ** User defined ** (116) + jeuv_26 (117) CO2 + hv -> CO + O rate = ** User defined ** (117) + + Reactions + usr_O_O2 ( 1) O + O2 + M -> O3 + M rate = ** User defined ** (118) + O_O3 ( 2) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (119) + usr_O_O ( 3) O + O + M -> O2 + M rate = ** User defined ** (120) + O2_1S_O ( 4) O2_1S + O -> O2_1D + O rate = 8.00E-14 (121) + O2_1S_O2 ( 5) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (122) + O2_1S_N2 ( 6) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (123) + O2_1S_O3 ( 7) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (124) + O2_1S_CO2 ( 8) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (125) + ag2 ( 9) O2_1S -> O2 rate = 8.50E-02 (126) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (127) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (128) + O2_1D_N2 ( 12) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (129) + ag1 ( 13) O2_1D -> O2 rate = 2.58E-04 (130) + O1D_N2 ( 14) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (131) + O1D_O2 ( 15) O1D + O2 -> O + O2_1S rate = 3.13E-11*exp( 55./t) (132) + O1D_O2b ( 16) O1D + O2 -> O + O2 rate = 1.65E-12*exp( 55./t) (133) + O1D_H2O ( 17) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (134) + O1D_N2Oa ( 18) O1D + N2O -> 2*NO rate = 7.25E-11*exp( 20./t) (135) + O1D_N2Ob ( 19) O1D + N2O -> N2 + O2 rate = 4.63E-11*exp( 20./t) (136) + O1D_O3 ( 20) O1D + O3 -> O2 + O2 rate = 1.20E-10 (137) + O1D_CFC11 ( 21) O1D + CFC11 -> 2*CL + COFCL rate = 2.02E-10 (138) + O1D_CFC12 ( 22) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (139) + O1D_CFC113 ( 23) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 1.50E-10 (140) + O1D_CFC114 ( 24) O1D + CFC114 -> 2*CL + 2*COF2 rate = 9.75E-11 (141) + O1D_CFC115 ( 25) O1D + CFC115 -> CL + F + 2*COF2 rate = 1.50E-11 (142) + O1D_HCFC22 ( 26) O1D + HCFC22 -> CL + COF2 rate = 7.20E-11 (143) + O1D_HCFC141B ( 27) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (144) + O1D_HCFC142B ( 28) O1D + HCFC142B -> CL + COF2 rate = 1.63E-10 (145) + O1D_CCL4 ( 29) O1D + CCL4 -> 4*CL rate = 2.84E-10 (146) + O1D_CH3BR ( 30) O1D + CH3BR -> BR rate = 1.67E-10 (147) + O1D_CF2CLBR ( 31) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.60E-11 (148) + O1D_CF3BR ( 32) O1D + CF3BR -> BR + F + COF2 rate = 4.10E-11 (149) + O1D_H1202 ( 33) O1D + H1202 -> 2*BR + COF2 rate = 1.01E-10 (150) + O1D_H2402 ( 34) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (151) + O1D_CHBR3 ( 35) O1D + CHBR3 -> 3*BR rate = 4.49E-10 (152) + O1D_CH2BR2 ( 36) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (153) + O1D_COF2 ( 37) O1D + COF2 -> 2*F rate = 2.14E-11 (154) + O1D_COFCL ( 38) O1D + COFCL -> F + CL rate = 1.90E-10 (155) + O1D_CH4a ( 39) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (156) + O1D_CH4b ( 40) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (157) + O1D_CH4c ( 41) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (158) + O1D_H2 ( 42) O1D + H2 -> H + OH rate = 1.20E-10 (159) + O1D_HCL ( 43) O1D + HCL -> CL + OH rate = 1.50E-10 (160) + O1D_HBR ( 44) O1D + HBR -> BR + OH rate = 1.20E-10 (161) + O1D_HCN ( 45) O1D + HCN -> OH rate = 7.70E-11*exp( 100./t) (162) + H_O2 ( 46) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (163) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + H_O3 ( 47) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (164) + H_HO2a ( 48) H + HO2 -> 2*OH rate = 7.20E-11 (165) + H_HO2 ( 49) H + HO2 -> H2 + O2 rate = 6.90E-12 (166) + H_HO2b ( 50) H + HO2 -> H2O + O rate = 1.60E-12 (167) + OH_O ( 51) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (168) + OH_O3 ( 52) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (169) + OH_HO2 ( 53) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (170) + OH_OH ( 54) OH + OH -> H2O + O rate = 1.80E-12 (171) + OH_OH_M ( 55) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (172) + ki=2.60E-11 + f=0.60 + OH_H2 ( 56) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (173) + OH_H2O2 ( 57) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (174) + H2_O ( 58) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (175) + HO2_O ( 59) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (176) + HO2_O3 ( 60) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (177) + usr_HO2_HO2 ( 61) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (178) + H2O2_O ( 62) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (179) + HCN_OH ( 63) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (180) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + CH3CN_OH ( 64) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (181) + N2D_O2 ( 65) N2D + O2 -> NO + O1D rate = 5.00E-12 (182) + N2D_O ( 66) N2D + O -> N + O rate = 7.00E-13 (183) + N_OH ( 67) N + OH -> NO + H rate = 5.00E-11 (184) + N_O2 ( 68) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (185) + N_NO ( 69) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (186) + N_NO2a ( 70) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (187) + N_NO2b ( 71) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (188) + N_NO2c ( 72) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (189) + NO_O_M ( 73) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (190) + ki=3.00E-11 + f=0.60 + NO_HO2 ( 74) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (191) + NO_O3 ( 75) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (192) + NO2_O ( 76) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (193) + NO2_O_M ( 77) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (194) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO2_O3 ( 78) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (195) + tag_NO2_NO3 ( 79) NO2 + NO3 + M -> N2O5 + M troe : ko=2.00E-30*(300/t)**4.40 (196) + ki=1.40E-12*(300/t)**0.70 + f=0.60 + usr_N2O5_M ( 80) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (197) + tag_NO2_OH ( 81) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (198) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 82) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (199) + NO3_NO ( 83) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (200) + NO3_O ( 84) NO3 + O -> NO2 + O2 rate = 1.00E-11 (201) + NO3_OH ( 85) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (202) + NO3_HO2 ( 86) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (203) + tag_NO2_HO2 ( 87) NO2 + HO2 + M -> HO2NO2 + M troe : ko=2.00E-31*(300/t)**3.40 (204) + ki=2.90E-12*(300/t)**1.10 + f=0.60 + HO2NO2_OH ( 88) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (205) + usr_HO2NO2_M ( 89) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (206) + CL_O3 ( 90) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (207) + CL_H2 ( 91) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (208) + CL_H2O2 ( 92) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (209) + CL_HO2a ( 93) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (210) + CL_HO2b ( 94) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (211) + CL_CH2O ( 95) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (212) + CL_CH4 ( 96) CL + CH4 -> CH3O2 + HCL rate = 7.30E-12*exp( -1280./t) (213) + CLO_O ( 97) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (214) + CLO_OHa ( 98) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (215) + CLO_OHb ( 99) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (216) + CLO_HO2 (100) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (217) + CLO_CH3O2 (101) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (218) + CLO_NO (102) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (219) + CLO_NO2_M (103) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (220) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLO_CLOa (104) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (221) + CLO_CLOb (105) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (222) + CLO_CLOc (106) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (223) + tag_CLO_CLO_M (107) CLO + CLO + M -> CL2O2 + M troe : ko=1.60E-32*(300/t)**4.50 (224) + ki=3.00E-12*(300/t)**2.00 + f=0.60 + usr_CL2O2_M (108) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (225) + HCL_OH (109) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (226) + HCL_O (110) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (227) + HOCL_O (111) HOCL + O -> CLO + OH rate = 1.70E-13 (228) + HOCL_CL (112) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (229) + HOCL_OH (113) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (230) + CLONO2_O (114) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (231) + CLONO2_OH (115) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (232) + CLONO2_CL (116) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (233) + BR_O3 (117) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (234) + BR_HO2 (118) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (235) + BR_CH2O (119) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (236) + BRO_O (120) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (237) + BRO_OH (121) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (238) + BRO_HO2 (122) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (239) + BRO_NO (123) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (240) + BRO_NO2_M (124) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (241) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRO_CLOa (125) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (242) + BRO_CLOb (126) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (243) + BRO_CLOc (127) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (244) + BRO_BRO (128) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (245) + HBR_OH (129) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (246) + HBR_O (130) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (247) + HOBR_O (131) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (248) + BRONO2_O (132) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (249) + F_H2O (133) F + H2O -> HF + OH rate = 1.40E-11 (250) + F_H2 (134) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (251) + F_CH4 (135) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (252) + F_HNO3 (136) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (253) + CH3CL_CL (137) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.17E-11*exp( -1130./t) (254) + CH3CL_OH (138) CH3CL + OH -> CL + H2O + HO2 rate = 2.40E-12*exp( -1250./t) (255) + CH3CCL3_OH (139) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (256) + HCFC22_OH (140) HCFC22 + OH -> H2O + CL + COF2 rate = 1.05E-12*exp( -1600./t) (257) + CH3BR_OH (141) CH3BR + OH -> BR + H2O + HO2 rate = 2.35E-12*exp( -1300./t) (258) + CH3BR_CL (142) CH3BR + CL -> HCL + HO2 + BR rate = 1.40E-11*exp( -1030./t) (259) + HCFC141B_OH (143) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (260) + HCFC142B_OH (144) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (261) + CH2BR2_OH (145) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (262) + CHBR3_OH (146) CHBR3 + OH -> 3*BR rate = 1.35E-12*exp( -600./t) (263) + CH2BR2_CL (147) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (264) + CHBR3_CL (148) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (265) + CH4_OH (149) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (266) + usr_CO_OH_b (150) CO + OH -> CO2 + H rate = ** User defined ** (267) + CO_OH_M (151) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.40 (268) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + CH2O_NO3 (152) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (269) + CH2O_OH (153) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (270) + CH2O_O (154) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (271) + CH2O_HO2 (155) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (272) + CH3O2_NO (156) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (273) + CH3O2_HO2 (157) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (274) + CH3O2_CH3O2a (158) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (275) + CH3O2_CH3O2b (159) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (276) + CH3OH_OH (160) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (277) + CH3OOH_OH (161) CH3OOH + OH -> .7*CH3O2 + .3*OH + .3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (278) + HCOOH_OH (162) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.50E-13 (279) + HOCH2OO_M (163) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (280) + HOCH2OO_NO (164) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (281) + HOCH2OO_HO2 (165) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (282) + C2H2_CL_M (166) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (283) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (284) + ki=3.10E-10*(300/t) + f=0.60 + C2H6_CL (168) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (285) + C2H2_OH_M (169) C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 troe : ko=5.50E-30 (286) + + .35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H6_OH (170) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (287) + tag_C2H4_OH (171) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (288) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + EO2_NO (172) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (289) + EO2_HO2 (173) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (290) + EO_O2 (174) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (291) + EO_M (175) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (292) + C2H4_O3 (176) C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH rate = 1.20E-14*exp( -2630./t) (293) + CH3COOH_OH (177) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (294) + C2H5O2_NO (178) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (295) + C2H5O2_HO2 (179) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (296) + C2H5O2_CH3O2 (180) C2H5O2 + CH3O2 -> .7*CH2O + .8*CH3CHO + HO2 + .3*CH3OH + .2*C2H5OH rate = 2.00E-13 (297) + C2H5O2_C2H5O2 (181) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + .4*C2H5OH rate = 6.80E-14 (298) + C2H5OOH_OH (182) C2H5OOH + OH -> .5*C2H5O2 + .5*CH3CHO + .5*OH rate = 3.80E-12*exp( 200./t) (299) + CH3CHO_OH (183) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (300) + CH3CHO_NO3 (184) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (301) + CH3CO3_NO (185) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (302) + tag_CH3CO3_NO2 (186) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (303) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + CH3CO3_HO2 (187) CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 rate = 4.30E-13*exp( 1040./t) (304) + CH3CO3_CH3O2 (188) CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH rate = 2.00E-12*exp( 500./t) (305) + CH3CO3_CH3CO3 (189) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.50E-12*exp( 500./t) (306) + CH3COOOH_OH (190) CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O rate = 1.00E-12 (307) + GLYALD_OH (191) GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 rate = 1.00E-11 (308) + GLYOXAL_OH (192) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (309) + C2H5OH_OH (193) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (310) + usr_PAN_M (194) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (311) + PAN_OH (195) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (312) + tag_C3H6_OH (196) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (313) + ki=3.00E-11 + f=0.50 + C3H6_O3 (197) C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 + .56*CO rate = 6.50E-15*exp( -1900./t) (314) + + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + C3H6_NO3 (198) C3H6 + NO3 -> ONIT rate = 4.60E-13*exp( -1156./t) (315) + C3H7O2_NO (199) C3H7O2 + NO -> .82*CH3COCH3 + NO2 + HO2 + .27*CH3CHO rate = 4.20E-12*exp( 180./t) (316) + C3H7O2_HO2 (200) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (317) + CH3H7O2_CH3O2 (201) C3H7O2 + CH3O2 -> CH2O + HO2 + .82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (318) + CH3H7OOH_OH (202) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (319) + C3H8_OH (203) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (320) + PO2_NO (204) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (321) + PO2_HO2 (205) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (322) + POOH_OH (206) POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (323) + usr_CH3COCH3_OH (207) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (324) + RO2_NO (208) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (325) + RO2_HO2 (209) RO2 + HO2 -> ROOH + O2 rate = 8.60E-13*exp( 700./t) (326) + RO2_CH3O2 (210) RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC + .5*CH3COCHO rate = 7.10E-13*exp( 500./t) (327) + + .5*CH3OH + ROOH_OH (211) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (328) + HYAC_OH (212) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (329) + CH3COCHO_OH (213) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (330) + CH3COCHO_NO3 (214) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (331) + ONIT_OH (215) ONIT + OH -> NO2 + CH3COCHO rate = 6.80E-13 (332) + BIGENE_OH (216) BIGENE + OH -> ENEO2 rate = 5.40E-11 (333) + ENEO2_NO (217) ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (334) + MVK_OH (218) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (335) + MVK_O3 (219) MVK + O3 -> .8*CH2O + .95*CH3COCHO + .08*OH + .2*O3 + .06*HO2 rate = 7.52E-16*exp( -1521./t) (336) + + .05*CO + .04*CH3CHO + MEK_OH (220) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (337) + MEKO2_NO (221) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (338) + MEKO2_HO2 (222) MEKO2 + HO2 -> MEKOOH rate = 7.50E-13*exp( 700./t) (339) + MEKOOH_OH (223) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (340) + MACR_OH (224) MACR + OH -> .5*MACRO2 + .5*H2O + .5*MCO3 rate = 1.86E-11*exp( 175./t) (341) + MACR_O3 (225) MACR + O3 -> .8*CH3COCHO + .275*HO2 + .2*CO + .2*O3 + .7*CH2O rate = 4.40E-15*exp( -2500./t) (342) + + .215*OH + MACRO2_NOa (226) MACRO2 + NO -> NO2 + .47*HO2 + .25*CH2O + .53*GLYALD + .25*CH3COCHO rate = 2.70E-12*exp( 360./t) (343) + + .53*CH3CO3 + .22*HYAC + .22*CO + MACRO2_NOb (227) MACRO2 + NO -> 0.8*ONITR rate = 1.30E-13*exp( 360./t) (344) + MACRO2_NO3 (228) MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO + .22*CO rate = 2.40E-12 (345) + + .53*GLYALD + .22*HYAC + .53*CH3CO3 + MACRO2_HO2 (229) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (346) + MACRO2_CH3O2 (230) MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO rate = 5.00E-13*exp( 400./t) (347) + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + MACRO2_CH3CO3 (231) MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 rate = 1.40E-11 (348) + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + MACROOH_OH (232) MACROOH + OH -> .5*MCO3 + .2*MACRO2 + .1*OH + .2*HO2 rate = 2.30E-11*exp( 200./t) (349) + MCO3_NO (233) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (350) + MCO3_NO3 (234) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (351) + MCO3_HO2 (235) MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 rate = 4.30E-13*exp( 1040./t) (352) + MCO3_CH3O2 (236) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (353) + MCO3_CH3CO3 (237) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (354) + MCO3_MCO3 (238) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (355) + usr_MCO3_NO2 (239) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (356) + usr_MPAN_M (240) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (357) + MPAN_OH_M (241) MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + 0.5*CO2 + M troe : ko=8.00E-27*(300/t)**3.50 (358) + ki=3.00E-11 + f=0.50 + ISOP_OH (242) ISOP + OH -> ISOPO2 rate = 2.54E-11*exp( 410./t) (359) + ISOP_O3 (243) ISOP + O3 -> .4*MACR + .2*MVK + .07*C3H6 + .27*OH + .06*HO2 rate = 1.05E-14*exp( -2000./t) (360) + + .6*CH2O + .3*CO + .1*O3 + .2*MCO3 + .2*CH3COOH + ISOP_NO3 (244) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (361) + ISOPO2_NO (245) ISOPO2 + NO -> .08*ONITR + .92*NO2 + .23*MACR + .32*MVK rate = 4.40E-12*exp( 180./t) (362) + + .33*HYDRALD + .02*GLYOXAL + .02*GLYALD + + .02*CH3COCHO + .02*HYAC + .55*CH2O + .92*HO2 + ISOPO2_NO3 (246) ISOPO2 + NO3 -> HO2 + NO2 + .6*CH2O + .25*MACR + .35*MVK rate = 2.40E-12 (363) + + .4*HYDRALD + ISOPO2_HO2 (247) ISOPO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (364) + ISOPOOH_OH (248) ISOPOOH + OH -> .8*XO2 + .2*ISOPO2 rate = 1.52E-11*exp( 200./t) (365) + ISOPO2_CH3O2 (249) ISOPO2 + CH3O2 -> .25*CH3OH + HO2 + 1.2*CH2O + .19*MACR + .26*MVK rate = 5.00E-13*exp( 400./t) (366) + + .3*HYDRALD + ISOPO2_CH3CO3 (250) ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6*CH2O + .25*MACR + .35*MVK rate = 1.40E-11 (367) + + .4*HYDRALD + ISOPNO3_NO (251) ISOPNO3 + NO -> 1.206*NO2 + .794*HO2 + .072*CH2O + .167*MACR rate = 2.70E-12*exp( 360./t) (368) + + .039*MVK + .794*ONITR + ISOPNO3_NO3 (252) ISOPNO3 + NO3 -> 1.206*NO2 + .072*CH2O + .167*MACR + .039*MVK rate = 2.40E-12 (369) + + .794*ONITR + .794*HO2 + ISOPNO3_HO2 (253) ISOPNO3 + HO2 -> .206*NO2 + .206*CH2O + .206*OH + .167*MACR rate = 8.00E-13*exp( 700./t) (370) + + .039*MVK + .794*ONITR + BIGALK_OH (254) BIGALK + OH -> ALKO2 rate = 3.50E-12 (371) + ONITR_OH (255) ONITR + OH -> HYDRALD + .4*NO2 + HO2 rate = 4.50E-11 (372) + ONITR_NO3 (256) ONITR + NO3 -> HO2 + NO2 + HYDRALD rate = 1.40E-12*exp( -1860./t) (373) + HYDRALD_OH (257) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (374) + ALKO2_NO (258) ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK rate = 4.20E-12*exp( 180./t) (375) + + .9*NO2 + .1*ONIT + ALKO2_HO2 (259) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (376) + ALKOOH_OH (260) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (377) + XO2_NO (261) XO2 + NO -> NO2 + HO2 + .25*CO + .25*CH2O + .25*GLYOXAL rate = 2.70E-12*exp( 360./t) (378) + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + XO2_NO3 (262) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (379) + + .25*CH3COCHO + .25*GLYALD + XO2_HO2 (263) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (380) + XO2_CH3O2 (264) XO2 + CH3O2 -> .3*CH3OH + .8*HO2 + .8*CH2O + .2*CO + .1*GLYOXAL rate = 5.00E-13*exp( 400./t) (381) + + .1*CH3COCHO + .1*HYAC + .1*GLYALD + XO2_CH3CO3 (265) XO2 + CH3CO3 -> .25*CO + .25*CH2O + .25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (382) + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + CO2 + XOOH_OHa (266) XOOH + OH -> H2O + XO2 rate = 1.90E-12*exp( 190./t) (383) + usr_XOOH_OH (267) XOOH + OH -> H2O + OH rate = ** User defined ** (384) + TOLUENE_OH (268) TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 rate = 1.70E-12*exp( 352./t) (385) + TOLO2_NO (269) TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + .9*NO2 rate = 4.20E-12*exp( 180./t) (386) + + .9*HO2 + TOLO2_HO2 (270) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (387) + TOLO2_OH (271) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (388) + CRESOL_OH (272) CRESOL + OH -> XOH rate = 3.00E-12 (389) + XOH_NO2 (273) XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 rate = 1.00E-11 (390) + BENZENE_OH (274) BENZENE + OH -> BENO2 rate = 2.30E-12*exp( -193./t) (391) + BENO2_HO2 (275) BENO2 + HO2 -> BENOOH rate = 1.40E-12*exp( 700./t) (392) + BENO2_NO (276) BENO2 + NO -> 0.9*GLYOXAL + 0.9*BIGALD + 0.9*NO2 + 0.9*HO2 rate = 2.60E-12*exp( 350./t) (393) + XYLENE_OH (277) XYLENE + OH -> XYLO2 rate = 2.30E-11 (394) + XYLO2_HO2 (278) XYLO2 + HO2 -> XYLOOH rate = 1.40E-12*exp( 700./t) (395) + XYLO2_NO (279) XYLO2 + NO -> 0.62*BIGALD + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.9*NO2 rate = 2.60E-12*exp( 350./t) (396) + + 0.9*HO2 + C10H16_OH (280) C10H16 + OH -> TERPO2 rate = 1.20E-11*exp( 444./t) (397) + C10H16_O3 (281) C10H16 + O3 -> .7*OH + MVK + MACR + HO2 rate = 1.00E-15*exp( -732./t) (398) + C10H16_NO3 (282) C10H16 + NO3 -> TERPO2 + NO2 rate = 1.20E-12*exp( 490./t) (399) + TERPO2_NO (283) TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 rate = 4.20E-12*exp( 180./t) (400) + TERPO2_HO2 (284) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (401) + TERPOOH_OH (285) TERPOOH + OH -> TERPO2 rate = 3.80E-12*exp( 200./t) (402) + usr_N2O5_aer (286) N2O5 -> 2*HNO3 rate = ** User defined ** (403) + usr_NO3_aer (287) NO3 -> HNO3 rate = ** User defined ** (404) + usr_NO2_aer (288) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (405) + CB1_CB2 (289) CB1 -> CB2 rate = 7.10E-06 (406) + OC1_OC2 (290) OC1 -> OC2 rate = 7.10E-06 (407) + usr_HO2_aer (291) HO2 -> 0.5*H2O2 rate = ** User defined ** (408) + usr_CB1_strat_ta (292) CB1 -> (No products) rate = 6.34E-08 (409) + usr_CB2_strat_ta (293) CB2 -> (No products) rate = 6.34E-08 (410) + usr_OC1_strat_ta (294) OC1 -> (No products) rate = 6.34E-08 (411) + usr_OC2_strat_ta (295) OC2 -> (No products) rate = 6.34E-08 (412) + usr_SO4_strat_ta (296) SO4 -> (No products) rate = 6.34E-08 (413) + usr_SOAM_strat_t (297) SOAM -> (No products) rate = 6.34E-08 (414) + usr_SOAI_strat_t (298) SOAI -> (No products) rate = 6.34E-08 (415) + usr_SOAB_strat_t (299) SOAB -> (No products) rate = 6.34E-08 (416) + usr_SOAT_strat_t (300) SOAT -> (No products) rate = 6.34E-08 (417) + usr_SOAX_strat_t (301) SOAX -> (No products) rate = 6.34E-08 (418) + usr_NH4_strat_ta (302) NH4 -> (No products) rate = 6.34E-08 (419) + usr_NH4NO3_strat (303) NH4NO3 -> (No products) rate = 6.34E-08 (420) + usr_SSLT01_strat (304) SSLT01 -> (No products) rate = 6.34E-08 (421) + usr_SSLT02_strat (305) SSLT02 -> (No products) rate = 6.34E-08 (422) + usr_SSLT03_strat (306) SSLT03 -> (No products) rate = 6.34E-08 (423) + usr_SSLT04_strat (307) SSLT04 -> (No products) rate = 6.34E-08 (424) + usr_DST01_strat_ (308) DST01 -> (No products) rate = 6.34E-08 (425) + usr_DST02_strat_ (309) DST02 -> (No products) rate = 6.34E-08 (426) + usr_DST03_strat_ (310) DST03 -> (No products) rate = 6.34E-08 (427) + usr_DST04_strat_ (311) DST04 -> (No products) rate = 6.34E-08 (428) + OCS_O (312) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (429) + OCS_OH (313) OCS + OH -> SO2 + CO + H rate = 1.10E-13*exp( -1200./t) (430) + S_OH (314) S + OH -> SO + H rate = 6.60E-11 (431) + S_O2 (315) S + O2 -> SO + O rate = 2.30E-12 (432) + S_O3 (316) S + O3 -> SO + O2 rate = 1.20E-11 (433) + SO_OH (317) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (434) + SO_O2 (318) SO + O2 -> SO2 + O rate = 1.25E-13*exp( -2190./t) (435) + SO_O3 (319) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (436) + SO_NO2 (320) SO + NO2 -> SO2 + NO rate = 1.40E-11 (437) + SO_CLO (321) SO + CLO -> SO2 + CL rate = 2.80E-11 (438) + SO_BRO (322) SO + BRO -> SO2 + BR rate = 5.70E-11 (439) + SO_OCLO (323) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (440) + usr_SO2_OH (324) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (441) + usr_SO3_H2O (325) SO3 + H2O -> H2SO4 rate = ** User defined ** (442) + DMS_OHa (326) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (443) + usr_DMS_OH (327) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** (444) + DMS_NO3 (328) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (445) + het1 (329) N2O5 -> 2*HNO3 rate = ** User defined ** (446) + het2 (330) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (447) + het3 (331) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (448) + het4 (332) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (449) + het5 (333) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (450) + het6 (334) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (451) + het7 (335) N2O5 -> 2*HNO3 rate = ** User defined ** (452) + het8 (336) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (453) + het9 (337) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (454) + het10 (338) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (455) + het11 (339) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (456) + het12 (340) N2O5 -> 2*HNO3 rate = ** User defined ** (457) + het13 (341) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (458) + het14 (342) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (459) + het15 (343) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (460) + het16 (344) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (461) + het17 (345) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (462) + ion_Op_O2 (346) Op + O2 -> O2p + O rate = ** User defined ** (463) + ion_Op_N2 (347) Op + N2 -> NOp + N rate = ** User defined ** (464) + ion_N2p_Oa (348) N2p + O -> NOp + N2D rate = ** User defined ** (465) + ion_N2p_Ob (349) N2p + O -> Op + N2 rate = ** User defined ** (466) + ion_Op_CO2 (350) Op + CO2 -> O2p + CO rate = 9.00E-10 (467) + ion_O2p_N (351) O2p + N -> NOp + O rate = 1.00E-10 (468) + ion_O2p_NO (352) O2p + NO -> NOp + O2 rate = 4.40E-10 (469) + ion_Np_O2a (353) Np + O2 -> O2p + N rate = 4.00E-10 (470) + ion_Np_O2b (354) Np + O2 -> NOp + O rate = 2.00E-10 (471) + ion_Np_O (355) Np + O -> Op + N rate = 1.00E-12 (472) + ion_N2p_O2 (356) N2p + O2 -> O2p + N2 rate = 6.00E-11 (473) + ion_O2p_N2 (357) O2p + N2 -> NOp + NO rate = 5.00E-16 (474) + elec1 (358) NOp + e -> .2*N + .8*N2D + O rate = ** User defined ** (475) + elec2 (359) O2p + e -> 1.15*O + .85*O1D rate = ** User defined ** (476) + elec3 (360) N2p + e -> 1.1*N + .9*N2D rate = ** User defined ** (477) + +Extraneous prod/loss species + ( 1) NO (dataset) + ( 2) NO2 (dataset) + ( 3) CO (dataset) + ( 4) SO2 (dataset) + ( 5) SO4 (dataset) + ( 6) CB1 (dataset) + ( 7) Op + ( 8) O2p + ( 9) Np + (10) N2p + (11) N2D + (12) N + (13) e + (14) OH + + + Equation Report + + d(O3)/dt = r1*M*O*O2 + .25*r187*CH3CO3*HO2 + .2*r219*MVK*O3 + .2*r225*MACR*O3 + .25*r235*MCO3*HO2 + + .1*r243*ISOP*O3 + - j3*O3 - j4*O3 - r2*O*O3 - r20*O1D*O3 - r47*H*O3 - r52*OH*O3 - r60*HO2*O3 - r75*NO*O3 + - r78*NO2*O3 - r90*CL*O3 - r117*BR*O3 - r176*C2H4*O3 - r197*C3H6*O3 - r219*MVK*O3 - r225*MACR*O3 + - r243*ISOP*O3 - r281*C10H16*O3 - r316*S*O3 - r319*SO*O3 + d(O)/dt = j1*O2 + 2*j2*O2 + j4*O3 + j6*NO + j8*NO2 + j10*N2O5 + j12*NO3 + j21*H2O + j24*CLO + j25*OCLO + + j32*BRO + j58*CO2 + .18*j60*CH4 + j88*SO2 + j89*SO3 + j91*SO + j98*O2 + j99*O2 + j100*O2 + + 2*j103*O2 + j110*O2 + j111*O2 + j112*O2 + 2*j115*O2 + j117*CO2 + r14*N2*O1D + r15*O1D*O2 + + r16*O1D*O2 + r50*H*HO2 + r54*OH*OH + r68*N*O2 + r69*N*NO + r70*N*NO2 + r315*S*O2 + r318*SO*O2 + + r346*Op*O2 + r351*O2p*N + r354*Np*O2 + r358*NOp*e + 1.15*r359*O2p*e + - j92*O - j93*O - j94*O - j105*O - j106*O - j107*O - r1*M*O2*O - r2*O3*O - 2*r3*M*O*O + - r51*OH*O - r58*H2*O - r59*HO2*O - r62*H2O2*O - r73*M*NO*O - r76*NO2*O - r77*M*NO2*O + - r84*NO3*O - r97*CLO*O - r110*HCL*O - r111*HOCL*O - r114*CLONO2*O - r120*BRO*O - r130*HBR*O + - r131*HOBR*O - r132*BRONO2*O - r154*CH2O*O - r312*OCS*O - r348*N2p*O - r349*N2p*O - r355*Np*O + d(O1D)/dt = j1*O2 + j3*O3 + j5*N2O + j20*H2O + r65*N2D*O2 + .85*r359*O2p*e + - r14*N2*O1D - r15*O2*O1D - r16*O2*O1D - r17*H2O*O1D - r18*N2O*O1D - r19*N2O*O1D - r20*O3*O1D + - r21*CFC11*O1D - r22*CFC12*O1D - r23*CFC113*O1D - r24*CFC114*O1D - r25*CFC115*O1D + - r26*HCFC22*O1D - r27*HCFC141B*O1D - r28*HCFC142B*O1D - r29*CCL4*O1D - r30*CH3BR*O1D + - r31*CF2CLBR*O1D - r32*CF3BR*O1D - r33*H1202*O1D - r34*H2402*O1D - r35*CHBR3*O1D + - r36*CH2BR2*O1D - r37*COF2*O1D - r38*COFCL*O1D - r39*CH4*O1D - r40*CH4*O1D - r41*CH4*O1D + - r42*H2*O1D - r43*HCL*O1D - r44*HBR*O1D - r45*HCN*O1D + d(O2)/dt = j4*O3 + j13*NO3 + r9*O2_1S + r12*N2*O2_1D + r13*O2_1D + 2*r2*O*O3 + r3*M*O*O + r10*O2_1D*O + + 2*r11*O2_1D*O2 + r19*O1D*N2O + r20*O1D*O3 + r20*O1D*O3 + r47*H*O3 + r49*H*HO2 + r51*OH*O + + r52*OH*O3 + r53*OH*HO2 + r59*HO2*O + 2*r60*HO2*O3 + r61*HO2*HO2 + r72*N*NO2 + r75*NO*O3 + + r76*NO2*O + r78*NO2*O3 + r84*NO3*O + r86*NO3*HO2 + r88*HO2NO2*OH + r90*CL*O3 + r93*CL*HO2 + + r97*CLO*O + r99*CLO*OH + r100*CLO*HO2 + r104*CLO*CLO + r105*CLO*CLO + r117*BR*O3 + r118*BR*HO2 + + r120*BRO*O + r122*BRO*HO2 + r126*BRO*CLO + r127*BRO*CLO + r128*BRO*BRO + r157*CH3O2*HO2 + + r179*C2H5O2*HO2 + r200*C3H7O2*HO2 + r205*PO2*HO2 + r209*RO2*HO2 + .75*r235*MCO3*HO2 + r316*S*O3 + + r319*SO*O3 + r352*O2p*NO + - j1*O2 - j2*O2 - j96*O2 - j98*O2 - j99*O2 - j100*O2 - j103*O2 - j108*O2 - j110*O2 - j111*O2 + - j112*O2 - j115*O2 - r1*M*O*O2 - r11*O2_1D*O2 - r15*O1D*O2 - r46*M*H*O2 - r65*N2D*O2 + - r68*N*O2 - r174*EO*O2 - r315*S*O2 - r318*SO*O2 - r346*Op*O2 - r353*Np*O2 - r354*Np*O2 + - r356*N2p*O2 + d(O2_1S)/dt = r15*O1D*O2 + - r6*N2*O2_1S - r9*O2_1S - r4*O*O2_1S - r5*O2*O2_1S - r7*O3*O2_1S - r8*CO2*O2_1S + d(O2_1D)/dt = j3*O3 + r6*N2*O2_1S + r4*O2_1S*O + r5*O2_1S*O2 + r7*O2_1S*O3 + r8*O2_1S*CO2 + - r12*N2*O2_1D - r13*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(N2O)/dt = r70*N*NO2 + - j5*N2O - r18*O1D*N2O - r19*O1D*N2O + d(N)/dt = j101*N2 + .8*j104*N2 + j113*N2 + .8*j116*N2 + j6*NO + r347*N2*Op + r66*N2D*O + r353*Np*O2 + + r355*Np*O + .2*r358*NOp*e + 1.1*r360*N2p*e + - j95*N - r67*OH*N - r68*O2*N - r69*NO*N - r70*NO2*N - r71*NO2*N - r72*NO2*N - r351*O2p*N + d(NO)/dt = j8*NO2 + j10*N2O5 + j13*NO3 + .5*r288*NO2 + r357*N2*O2p + 2*r18*O1D*N2O + r65*N2D*O2 + r67*N*OH + + r68*N*O2 + 2*r71*N*NO2 + r76*NO2*O + r320*SO*NO2 + - j6*NO - j7*NO - r69*N*NO - r73*M*O*NO - r74*HO2*NO - r75*O3*NO - r83*NO3*NO - r102*CLO*NO + - r123*BRO*NO - r156*CH3O2*NO - r164*HOCH2OO*NO - r172*EO2*NO - r178*C2H5O2*NO - r185*CH3CO3*NO + - r199*C3H7O2*NO - r204*PO2*NO - r208*RO2*NO - r217*ENEO2*NO - r221*MEKO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r233*MCO3*NO - r245*ISOPO2*NO - r251*ISOPNO3*NO - r258*ALKO2*NO - r261*XO2*NO + - r269*TOLO2*NO - r276*BENO2*NO - r279*XYLO2*NO - r283*TERPO2*NO - r352*O2p*NO + d(NO2)/dt = j9*N2O5 + j11*HNO3 + j12*NO3 + j15*HO2NO2 + j30*CLONO2 + j36*BRONO2 + .6*j64*PAN + j65*MPAN + + j76*ONITR + r80*M*N2O5 + r89*M*HO2NO2 + r194*M*PAN + r240*M*MPAN + r73*M*NO*O + r74*NO*HO2 + + r75*NO*O3 + 2*r83*NO3*NO + r84*NO3*O + r85*NO3*OH + r86*NO3*HO2 + r88*HO2NO2*OH + r102*CLO*NO + + r123*BRO*NO + r156*CH3O2*NO + r164*HOCH2OO*NO + r172*EO2*NO + r178*C2H5O2*NO + r185*CH3CO3*NO + + r199*C3H7O2*NO + r204*PO2*NO + r208*RO2*NO + r215*ONIT*OH + r217*ENEO2*NO + r221*MEKO2*NO + + r226*MACRO2*NO + r228*MACRO2*NO3 + r233*MCO3*NO + r234*MCO3*NO3 + .92*r245*ISOPO2*NO + + r246*ISOPO2*NO3 + 1.206*r251*ISOPNO3*NO + 1.206*r252*ISOPNO3*NO3 + .206*r253*ISOPNO3*HO2 + + .4*r255*ONITR*OH + r256*ONITR*NO3 + .9*r258*ALKO2*NO + r261*XO2*NO + r262*XO2*NO3 + + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + .9*r279*XYLO2*NO + r282*C10H16*NO3 + + r283*TERPO2*NO + - j8*NO2 - r288*NO2 - r70*N*NO2 - r71*N*NO2 - r72*N*NO2 - r76*O*NO2 - r77*M*O*NO2 - r78*O3*NO2 + - r79*M*NO3*NO2 - r81*M*OH*NO2 - r87*M*HO2*NO2 - r103*M*CLO*NO2 - r124*M*BRO*NO2 + - r186*M*CH3CO3*NO2 - r239*M*MCO3*NO2 - r273*XOH*NO2 - r320*SO*NO2 + d(NO3)/dt = j9*N2O5 + j10*N2O5 + j14*HO2NO2 + j29*CLONO2 + j35*BRONO2 + .4*j64*PAN + r80*M*N2O5 + + r77*M*NO2*O + r78*NO2*O3 + r82*HNO3*OH + r114*CLONO2*O + r115*CLONO2*OH + r116*CLONO2*CL + + r132*BRONO2*O + r136*F*HNO3 + r195*PAN*OH + .5*r241*M*MPAN*OH + - j12*NO3 - j13*NO3 - r287*NO3 - r79*M*NO2*NO3 - r83*NO*NO3 - r84*O*NO3 - r85*OH*NO3 + - r86*HO2*NO3 - r152*CH2O*NO3 - r184*CH3CHO*NO3 - r198*C3H6*NO3 - r214*CH3COCHO*NO3 + - r228*MACRO2*NO3 - r234*MCO3*NO3 - r244*ISOP*NO3 - r246*ISOPO2*NO3 - r252*ISOPNO3*NO3 + - r256*ONITR*NO3 - r262*XO2*NO3 - r282*C10H16*NO3 - r328*DMS*NO3 + d(HNO3)/dt = 2*r286*N2O5 + r287*NO3 + .5*r288*NO2 + 2*r329*N2O5 + r330*CLONO2 + r331*BRONO2 + 2*r335*N2O5 + + r336*CLONO2 + r339*BRONO2 + 2*r340*N2O5 + r341*CLONO2 + r342*BRONO2 + r81*M*NO2*OH + + r152*CH2O*NO3 + r184*CH3CHO*NO3 + r214*CH3COCHO*NO3 + r328*DMS*NO3 + r332*CLONO2*HCL + + r337*CLONO2*HCL + r343*CLONO2*HCL + - j11*HNO3 - r82*OH*HNO3 - r136*F*HNO3 + d(HO2NO2)/dt = r87*M*NO2*HO2 + - j14*HO2NO2 - j15*HO2NO2 - r89*M*HO2NO2 - r88*OH*HO2NO2 + d(N2O5)/dt = r79*M*NO2*NO3 + - j9*N2O5 - j10*N2O5 - r80*M*N2O5 - r286*N2O5 - r329*N2O5 - r335*N2O5 - r340*N2O5 + d(CH4)/dt = .08*r197*C3H6*O3 + - j59*CH4 - j60*CH4 - r39*O1D*CH4 - r40*O1D*CH4 - r41*O1D*CH4 - r96*CL*CH4 - r135*F*CH4 + - r149*OH*CH4 + d(CH3O2)/dt = j37*CH3CL + j48*CH3BR + j59*CH4 + j61*CH3CHO + j63*CH3COOOH + .4*j64*PAN + .3*j68*MVK + + j73*CH3COCH3 + r39*O1D*CH4 + r96*CL*CH4 + r135*F*CH4 + r149*CH4*OH + .7*r161*CH3OOH*OH + + r177*CH3COOH*OH + r185*CH3CO3*NO + .9*r188*CH3CO3*CH3O2 + 2*r189*CH3CO3*CH3CO3 + + .31*r197*C3H6*O3 + r231*MACRO2*CH3CO3 + r237*MCO3*CH3CO3 + r250*ISOPO2*CH3CO3 + + r265*XO2*CH3CO3 + - r101*CLO*CH3O2 - r156*NO*CH3O2 - r157*HO2*CH3O2 - 2*r158*CH3O2*CH3O2 - 2*r159*CH3O2*CH3O2 + - r180*C2H5O2*CH3O2 - r188*CH3CO3*CH3O2 - r201*C3H7O2*CH3O2 - r210*RO2*CH3O2 + - r230*MACRO2*CH3O2 - r236*MCO3*CH3O2 - r249*ISOPO2*CH3O2 - r264*XO2*CH3O2 + d(CH3OOH)/dt = r157*CH3O2*HO2 + - j16*CH3OOH - r161*OH*CH3OOH + d(CH3OH)/dt = r159*CH3O2*CH3O2 + .3*r180*C2H5O2*CH3O2 + .5*r210*RO2*CH3O2 + .25*r230*MACRO2*CH3O2 + + .25*r249*ISOPO2*CH3O2 + .3*r264*XO2*CH3O2 + - r160*OH*CH3OH + d(CH2O)/dt = j16*CH3OOH + .18*j60*CH4 + j62*POOH + 1.34*j66*MACR + j72*ROOH + j76*ONITR + .69*j77*ISOPOOH + + j78*HYAC + j79*GLYALD + .1*j83*ALKOOH + r163*HOCH2OO + 2*r175*EO + r40*O1D*CH4 + r41*O1D*CH4 + + r101*CLO*CH3O2 + r156*CH3O2*NO + 2*r158*CH3O2*CH3O2 + r159*CH3O2*CH3O2 + r160*CH3OH*OH + + .3*r161*CH3OOH*OH + .5*r172*EO2*NO + r176*C2H4*O3 + .7*r180*C2H5O2*CH3O2 + r188*CH3CO3*CH3O2 + + .5*r190*CH3COOOH*OH + .8*r191*GLYALD*OH + r195*PAN*OH + .54*r197*C3H6*O3 + r201*C3H7O2*CH3O2 + + r204*PO2*NO + r208*RO2*NO + .8*r210*RO2*CH3O2 + .5*r217*ENEO2*NO + .8*r219*MVK*O3 + + .7*r225*MACR*O3 + .25*r226*MACRO2*NO + .25*r228*MACRO2*NO3 + .88*r230*MACRO2*CH3O2 + + .25*r231*MACRO2*CH3CO3 + r233*MCO3*NO + r234*MCO3*NO3 + 2*r236*MCO3*CH3O2 + r237*MCO3*CH3CO3 + + 2*r238*MCO3*MCO3 + .5*r241*M*MPAN*OH + .6*r243*ISOP*O3 + .55*r245*ISOPO2*NO + + .6*r246*ISOPO2*NO3 + 1.2*r249*ISOPO2*CH3O2 + .6*r250*ISOPO2*CH3CO3 + .072*r251*ISOPNO3*NO + + .072*r252*ISOPNO3*NO3 + .206*r253*ISOPNO3*HO2 + .1*r258*ALKO2*NO + .25*r261*XO2*NO + + .8*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j17*CH2O - j18*CH2O - r95*CL*CH2O - r119*BR*CH2O - r152*NO3*CH2O - r153*OH*CH2O + - r154*O*CH2O - r155*HO2*CH2O + d(CO)/dt = j17*CH2O + j18*CH2O + j58*CO2 + .38*j60*CH4 + j61*CH3CHO + 1.34*j67*MACR + .7*j68*MVK + + j74*CH3COCHO + j76*ONITR + j79*GLYALD + .45*j81*BIGALD + 2*j82*GLYOXAL + j90*OCS + j117*CO2 + + r95*CL*CH2O + r119*BR*CH2O + r137*CH3CL*CL + r152*CH2O*NO3 + r153*CH2O*OH + r154*CH2O*O + + .35*r169*M*C2H2*OH + .5*r176*C2H4*O3 + r192*GLYOXAL*OH + .56*r197*C3H6*O3 + r213*CH3COCHO*OH + + r214*CH3COCHO*NO3 + .05*r219*MVK*O3 + .2*r225*MACR*O3 + .22*r226*MACRO2*NO + .22*r228*MACRO2*NO3 + + .11*r230*MACRO2*CH3O2 + .22*r231*MACRO2*CH3CO3 + .3*r243*ISOP*O3 + .25*r261*XO2*NO + + .5*r262*XO2*NO3 + .2*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + r312*OCS*O + r313*OCS*OH + + r350*Op*CO2 + - r150*OH*CO - r151*M*OH*CO + d(H2)/dt = j18*CH2O + j20*H2O + 1.4400001*j60*CH4 + r41*O1D*CH4 + r49*H*HO2 + - r42*O1D*H2 - r56*OH*H2 - r58*O*H2 - r91*CL*H2 - r134*F*H2 + d(H)/dt = j16*CH3OOH + 2*j17*CH2O + j19*H2O + 2*j21*H2O + j28*HCL + j34*HBR + j57*HF + j59*CH4 + + .33*j60*CH4 + r40*O1D*CH4 + r42*O1D*H2 + r51*OH*O + r56*OH*H2 + r58*H2*O + r67*N*OH + + r91*CL*H2 + r134*F*H2 + r150*CO*OH + r153*CH2O*OH + r313*OCS*OH + r314*S*OH + r317*SO*OH + - r46*M*O2*H - r47*O3*H - r48*HO2*H - r49*HO2*H - r50*HO2*H + d(OH)/dt = j11*HNO3 + j14*HO2NO2 + j16*CH3OOH + j19*H2O + 2*j22*H2O2 + j27*HOCL + j33*HOBR + .33*j60*CH4 + + j62*POOH + j63*CH3COOOH + j69*C2H5OOH + j70*EOOH + j71*C3H7OOH + j72*ROOH + j75*XOOH + + j83*ALKOOH + j84*MEKOOH + j85*TOLOOH + j86*TERPOOH + .5*r288*NO2 + 2*r17*O1D*H2O + r39*O1D*CH4 + + r42*O1D*H2 + r43*O1D*HCL + r44*O1D*HBR + r45*O1D*HCN + r47*H*O3 + 2*r48*H*HO2 + r58*H2*O + + r59*HO2*O + r60*HO2*O3 + r62*H2O2*O + r74*NO*HO2 + r86*NO3*HO2 + r94*CL*HO2 + r110*HCL*O + + r111*HOCL*O + r130*HBR*O + r131*HOBR*O + r133*F*H2O + r154*CH2O*O + .3*r161*CH3OOH*OH + + .65*r169*M*C2H2*OH + .12*r176*C2H4*O3 + .5*r182*C2H5OOH*OH + .33*r197*C3H6*O3 + .5*r206*POOH*OH + + .08*r219*MVK*O3 + .215*r225*MACR*O3 + .1*r232*MACROOH*OH + .27*r243*ISOP*O3 + + .206*r253*ISOPNO3*HO2 + .7*r281*C10H16*O3 + - r51*O*OH - r52*O3*OH - r53*HO2*OH - 2*r54*OH*OH - 2*r55*M*OH*OH - r56*H2*OH - r57*H2O2*OH + - r63*M*HCN*OH - r64*CH3CN*OH - r67*N*OH - r81*M*NO2*OH - r82*HNO3*OH - r85*NO3*OH + - r88*HO2NO2*OH - r98*CLO*OH - r99*CLO*OH - r109*HCL*OH - r113*HOCL*OH - r115*CLONO2*OH + - r121*BRO*OH - r129*HBR*OH - r138*CH3CL*OH - r139*CH3CCL3*OH - r140*HCFC22*OH - r141*CH3BR*OH + - r143*HCFC141B*OH - r144*HCFC142B*OH - r145*CH2BR2*OH - r146*CHBR3*OH - r149*CH4*OH - r150*CO*OH + - r151*M*CO*OH - r153*CH2O*OH - r160*CH3OH*OH - r161*CH3OOH*OH - r162*HCOOH*OH - r169*M*C2H2*OH + - r170*C2H6*OH - r171*M*C2H4*OH - r177*CH3COOH*OH - r182*C2H5OOH*OH - r183*CH3CHO*OH + - r190*CH3COOOH*OH - r191*GLYALD*OH - r192*GLYOXAL*OH - r193*C2H5OH*OH - r195*PAN*OH + - r196*M*C3H6*OH - r202*C3H7OOH*OH - r203*C3H8*OH - r206*POOH*OH - r207*CH3COCH3*OH + - r211*ROOH*OH - r212*HYAC*OH - r213*CH3COCHO*OH - r215*ONIT*OH - r216*BIGENE*OH - r218*MVK*OH + - r220*MEK*OH - r223*MEKOOH*OH - r224*MACR*OH - r232*MACROOH*OH - r241*M*MPAN*OH - r242*ISOP*OH + - r248*ISOPOOH*OH - r254*BIGALK*OH - r255*ONITR*OH - r257*HYDRALD*OH - r260*ALKOOH*OH + - r266*XOOH*OH - r268*TOLUENE*OH - r271*TOLOOH*OH - r272*CRESOL*OH - r274*BENZENE*OH + - r277*XYLENE*OH - r280*C10H16*OH - r285*TERPOOH*OH - r313*OCS*OH - r314*S*OH - r317*SO*OH + - r324*SO2*OH - r326*DMS*OH - r327*DMS*OH + d(HO2)/dt = j15*HO2NO2 + j61*CH3CHO + j62*POOH + 1.34*j66*MACR + .66*j67*MACR + j69*C2H5OOH + j71*C3H7OOH + + j74*CH3COCHO + j76*ONITR + j77*ISOPOOH + j78*HYAC + 2*j79*GLYALD + .56*j81*BIGALD + + 2*j82*GLYOXAL + .9*j83*ALKOOH + j86*TERPOOH + r89*M*HO2NO2 + r163*HOCH2OO + r175*EO + + r40*O1D*CH4 + r46*M*H*O2 + r52*OH*O3 + r57*OH*H2O2 + r62*H2O2*O + r63*M*HCN*OH + r64*CH3CN*OH + + r85*NO3*OH + r92*CL*H2O2 + r95*CL*CH2O + r98*CLO*OH + r101*CLO*CH3O2 + r119*BR*CH2O + + r121*BRO*OH + r137*CH3CL*CL + r138*CH3CL*OH + r141*CH3BR*OH + r142*CH3BR*CL + r151*M*CO*OH + + r152*CH2O*NO3 + r154*CH2O*O + r156*CH3O2*NO + 2*r158*CH3O2*CH3O2 + r160*CH3OH*OH + + r162*HCOOH*OH + r164*HOCH2OO*NO + .35*r169*M*C2H2*OH + .25*r172*EO2*NO + r174*EO*O2 + + .12*r176*C2H4*O3 + r178*C2H5O2*NO + r180*C2H5O2*CH3O2 + 1.2*r181*C2H5O2*C2H5O2 + + .9*r188*CH3CO3*CH3O2 + r191*GLYALD*OH + r192*GLYOXAL*OH + r193*C2H5OH*OH + .19*r197*C3H6*O3 + + r199*C3H7O2*NO + r201*C3H7O2*CH3O2 + r204*PO2*NO + .3*r210*RO2*CH3O2 + r212*HYAC*OH + + r217*ENEO2*NO + .06*r219*MVK*O3 + .275*r225*MACR*O3 + .47*r226*MACRO2*NO + .47*r228*MACRO2*NO3 + + .73*r230*MACRO2*CH3O2 + .47*r231*MACRO2*CH3CO3 + .2*r232*MACROOH*OH + r236*MCO3*CH3O2 + + .5*r241*M*MPAN*OH + .06*r243*ISOP*O3 + .92*r245*ISOPO2*NO + r246*ISOPO2*NO3 + r249*ISOPO2*CH3O2 + + r250*ISOPO2*CH3CO3 + .794*r251*ISOPNO3*NO + .794*r252*ISOPNO3*NO3 + r255*ONITR*OH + + r256*ONITR*NO3 + .9*r258*ALKO2*NO + r261*XO2*NO + r262*XO2*NO3 + .8*r264*XO2*CH3O2 + + r265*XO2*CH3CO3 + .25*r268*TOLUENE*OH + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + + .9*r279*XYLO2*NO + r281*C10H16*O3 + r283*TERPO2*NO + r324*SO2*OH + .5*r327*DMS*OH + - r291*HO2 - r48*H*HO2 - r49*H*HO2 - r50*H*HO2 - r53*OH*HO2 - r59*O*HO2 - r60*O3*HO2 + - 2*r61*HO2*HO2 - r74*NO*HO2 - r86*NO3*HO2 - r87*M*NO2*HO2 - r93*CL*HO2 - r94*CL*HO2 + - r100*CLO*HO2 - r118*BR*HO2 - r122*BRO*HO2 - r155*CH2O*HO2 - r157*CH3O2*HO2 - r165*HOCH2OO*HO2 + - r173*EO2*HO2 - r179*C2H5O2*HO2 - r187*CH3CO3*HO2 - r200*C3H7O2*HO2 - r205*PO2*HO2 + - r209*RO2*HO2 - r222*MEKO2*HO2 - r229*MACRO2*HO2 - r235*MCO3*HO2 - r247*ISOPO2*HO2 + - r253*ISOPNO3*HO2 - r259*ALKO2*HO2 - r263*XO2*HO2 - r270*TOLO2*HO2 - r275*BENO2*HO2 + - r278*XYLO2*HO2 - r284*TERPO2*HO2 + d(H2O2)/dt = .5*r291*HO2 + r55*M*OH*OH + r61*HO2*HO2 + - j22*H2O2 - r57*OH*H2O2 - r62*O*H2O2 - r92*CL*H2O2 + d(CLY)/dt = 0 + d(BRY)/dt = 0 + d(CL)/dt = 2*j23*CL2 + j24*CLO + 2*j26*CL2O2 + j27*HOCL + j28*HCL + j29*CLONO2 + j31*BRCL + j37*CH3CL + + 4*j38*CCL4 + 3*j39*CH3CCL3 + 2*j40*CFC11 + 2*j41*CFC12 + 2*j42*CFC113 + 2*j43*CFC114 + + j44*CFC115 + j45*HCFC22 + j46*HCFC141B + j47*HCFC142B + j50*CF2CLBR + j56*COFCL + + 2*r21*O1D*CFC11 + 2*r22*O1D*CFC12 + 2*r23*O1D*CFC113 + 2*r24*O1D*CFC114 + r25*O1D*CFC115 + + r26*O1D*HCFC22 + r27*O1D*HCFC141B + r28*O1D*HCFC142B + 4*r29*O1D*CCL4 + r31*O1D*CF2CLBR + + r38*O1D*COFCL + r43*O1D*HCL + r97*CLO*O + r98*CLO*OH + r101*CLO*CH3O2 + r102*CLO*NO + + 2*r104*CLO*CLO + r106*CLO*CLO + r109*HCL*OH + r110*HCL*O + r126*BRO*CLO + r138*CH3CL*OH + + 3*r139*CH3CCL3*OH + r140*HCFC22*OH + r143*HCFC141B*OH + r144*HCFC142B*OH + r321*SO*CLO + - r90*O3*CL - r91*H2*CL - r92*H2O2*CL - r93*HO2*CL - r94*HO2*CL - r95*CH2O*CL - r96*CH4*CL + - r112*HOCL*CL - r116*CLONO2*CL - r137*CH3CL*CL - r142*CH3BR*CL - r147*CH2BR2*CL - r148*CHBR3*CL + - r168*C2H6*CL + d(CL2)/dt = r105*CLO*CLO + r116*CLONO2*CL + r332*CLONO2*HCL + r333*HOCL*HCL + r337*CLONO2*HCL + r338*HOCL*HCL + + r343*CLONO2*HCL + r344*HOCL*HCL + - j23*CL2 + d(CLO)/dt = j25*OCLO + j30*CLONO2 + r108*M*CL2O2 + r108*M*CL2O2 + r90*CL*O3 + r94*CL*HO2 + r111*HOCL*O + + r112*HOCL*CL + r113*HOCL*OH + r114*CLONO2*O + r323*SO*OCLO + - j24*CLO - r97*O*CLO - r98*OH*CLO - r99*OH*CLO - r100*HO2*CLO - r101*CH3O2*CLO - r102*NO*CLO + - r103*M*NO2*CLO - 2*r104*CLO*CLO - 2*r105*CLO*CLO - 2*r106*CLO*CLO - 2*r107*M*CLO*CLO + - r125*BRO*CLO - r126*BRO*CLO - r127*BRO*CLO - r321*SO*CLO + d(OCLO)/dt = r106*CLO*CLO + r125*BRO*CLO + - j25*OCLO - r323*SO*OCLO + d(CL2O2)/dt = r107*M*CLO*CLO + - j26*CL2O2 - r108*M*CL2O2 + d(HCL)/dt = r91*CL*H2 + r92*CL*H2O2 + r93*CL*HO2 + r95*CL*CH2O + r96*CL*CH4 + r99*CLO*OH + r112*HOCL*CL + + 2*r137*CH3CL*CL + r142*CH3BR*CL + r147*CH2BR2*CL + r148*CHBR3*CL + r168*C2H6*CL + - j28*HCL - r43*O1D*HCL - r109*OH*HCL - r110*O*HCL - r332*CLONO2*HCL - r333*HOCL*HCL + - r334*HOBR*HCL - r337*CLONO2*HCL - r338*HOCL*HCL - r343*CLONO2*HCL - r344*HOCL*HCL + - r345*HOBR*HCL + d(HOCL)/dt = r330*CLONO2 + r336*CLONO2 + r341*CLONO2 + r100*CLO*HO2 + r115*CLONO2*OH + - j27*HOCL - r111*O*HOCL - r112*CL*HOCL - r113*OH*HOCL - r333*HCL*HOCL - r338*HCL*HOCL + - r344*HCL*HOCL + d(CLONO2)/dt = r103*M*CLO*NO2 + - j29*CLONO2 - j30*CLONO2 - r330*CLONO2 - r336*CLONO2 - r341*CLONO2 - r114*O*CLONO2 + - r115*OH*CLONO2 - r116*CL*CLONO2 - r332*HCL*CLONO2 - r337*HCL*CLONO2 - r343*HCL*CLONO2 + d(BRCL)/dt = r127*BRO*CLO + r334*HOBR*HCL + r345*HOBR*HCL + - j31*BRCL + d(BR)/dt = j31*BRCL + j32*BRO + j33*HOBR + j34*HBR + j35*BRONO2 + j48*CH3BR + j49*CF3BR + j50*CF2CLBR + + 3*j51*CHBR3 + 2*j52*CH2BR2 + 2*j53*H1202 + 2*j54*H2402 + r30*O1D*CH3BR + r31*O1D*CF2CLBR + + r32*O1D*CF3BR + 2*r33*O1D*H1202 + 2*r34*O1D*H2402 + 3*r35*O1D*CHBR3 + 2*r36*O1D*CH2BR2 + + r44*O1D*HBR + r120*BRO*O + r121*BRO*OH + r123*BRO*NO + r125*BRO*CLO + r126*BRO*CLO + + 2*r128*BRO*BRO + r129*HBR*OH + r130*HBR*O + r141*CH3BR*OH + r142*CH3BR*CL + 2*r145*CH2BR2*OH + + 3*r146*CHBR3*OH + 2*r147*CH2BR2*CL + 3*r148*CHBR3*CL + r322*SO*BRO + - r117*O3*BR - r118*HO2*BR - r119*CH2O*BR + d(BRO)/dt = j36*BRONO2 + r117*BR*O3 + r131*HOBR*O + r132*BRONO2*O + - j32*BRO - r120*O*BRO - r121*OH*BRO - r122*HO2*BRO - r123*NO*BRO - r124*M*NO2*BRO + - r125*CLO*BRO - r126*CLO*BRO - r127*CLO*BRO - 2*r128*BRO*BRO - r322*SO*BRO + d(HBR)/dt = r118*BR*HO2 + r119*BR*CH2O + - j34*HBR - r44*O1D*HBR - r129*OH*HBR - r130*O*HBR + d(HOBR)/dt = r331*BRONO2 + r339*BRONO2 + r342*BRONO2 + r122*BRO*HO2 + - j33*HOBR - r131*O*HOBR - r334*HCL*HOBR - r345*HCL*HOBR + d(BRONO2)/dt = r124*M*BRO*NO2 + - j35*BRONO2 - j36*BRONO2 - r331*BRONO2 - r339*BRONO2 - r342*BRONO2 - r132*O*BRONO2 + d(HCN)/dt = - r45*O1D*HCN - r63*M*OH*HCN + d(CH3CN)/dt = - r64*OH*CH3CN + d(C2H4)/dt = - r167*M*CL*C2H4 - r171*M*OH*C2H4 - r176*O3*C2H4 + d(C2H6)/dt = - r168*CL*C2H6 - r170*OH*C2H6 + d(C2H5O2)/dt = j80*MEK + r168*C2H6*CL + r170*C2H6*OH + .5*r182*C2H5OOH*OH + - r178*NO*C2H5O2 - r179*HO2*C2H5O2 - r180*CH3O2*C2H5O2 - 2*r181*C2H5O2*C2H5O2 + d(C2H5OOH)/dt = r179*C2H5O2*HO2 + - j69*C2H5OOH - r182*OH*C2H5OOH + d(CH3CO3)/dt = .6*j64*PAN + 1.34*j66*MACR + .3*j68*MVK + j72*ROOH + j73*CH3COCH3 + j74*CH3COCHO + j78*HYAC + + j80*MEK + .13*j81*BIGALD + j84*MEKOOH + r194*M*PAN + r183*CH3CHO*OH + r184*CH3CHO*NO3 + + .5*r190*CH3COOOH*OH + r208*RO2*NO + .3*r210*RO2*CH3O2 + r213*CH3COCHO*OH + r214*CH3COCHO*NO3 + + r221*MEKO2*NO + .53*r226*MACRO2*NO + .53*r228*MACRO2*NO3 + .26*r230*MACRO2*CH3O2 + + .53*r231*MACRO2*CH3CO3 + r233*MCO3*NO + r234*MCO3*NO3 + r236*MCO3*CH3O2 + 2*r238*MCO3*MCO3 + - r185*NO*CH3CO3 - r186*M*NO2*CH3CO3 - r187*HO2*CH3CO3 - r188*CH3O2*CH3CO3 + - 2*r189*CH3CO3*CH3CO3 - r231*MACRO2*CH3CO3 - r250*ISOPO2*CH3CO3 - r265*XO2*CH3CO3 + d(CH3COOH)/dt = .25*r187*CH3CO3*HO2 + .1*r188*CH3CO3*CH3O2 + .25*r197*C3H6*O3 + .25*r235*MCO3*HO2 + + .2*r243*ISOP*O3 + - r177*OH*CH3COOH + d(CH3CHO)/dt = j62*POOH + j69*C2H5OOH + .4*j83*ALKOOH + j84*MEKOOH + r178*C2H5O2*NO + .8*r180*C2H5O2*CH3O2 + + 1.6*r181*C2H5O2*C2H5O2 + .5*r182*C2H5OOH*OH + r193*C2H5OH*OH + .5*r197*C3H6*O3 + + .27*r199*C3H7O2*NO + r204*PO2*NO + r217*ENEO2*NO + .04*r219*MVK*O3 + r221*MEKO2*NO + + .4*r258*ALKO2*NO + - j61*CH3CHO - r183*OH*CH3CHO - r184*NO3*CH3CHO + d(C2H5OH)/dt = .2*r180*C2H5O2*CH3O2 + .4*r181*C2H5O2*C2H5O2 + - r193*OH*C2H5OH + d(GLYALD)/dt = r174*EO*O2 + .53*r226*MACRO2*NO + .53*r228*MACRO2*NO3 + .26*r230*MACRO2*CH3O2 + + .53*r231*MACRO2*CH3CO3 + .02*r245*ISOPO2*NO + .25*r261*XO2*NO + .25*r262*XO2*NO3 + + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j79*GLYALD - r191*OH*GLYALD + d(GLYOXAL)/dt = .13*j81*BIGALD + .45*j85*TOLOOH + .65*r169*M*C2H2*OH + .2*r191*GLYALD*OH + .02*r245*ISOPO2*NO + + .25*r261*XO2*NO + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + + .45*r269*TOLO2*NO + .9*r276*BENO2*NO + .34*r279*XYLO2*NO + - j82*GLYOXAL - r192*OH*GLYOXAL + d(CH3COOOH)/dt = .75*r187*CH3CO3*HO2 + .75*r235*MCO3*HO2 + - j63*CH3COOOH - r190*OH*CH3COOOH + d(EO2)/dt = r171*M*C2H4*OH + - r172*NO*EO2 - r173*HO2*EO2 + d(EO)/dt = j70*EOOH + .75*r172*EO2*NO + - r175*EO - r174*O2*EO + d(EOOH)/dt = r173*EO2*HO2 + - j70*EOOH + d(PAN)/dt = r186*M*CH3CO3*NO2 + - j64*PAN - r194*M*PAN - r195*OH*PAN + d(C3H6)/dt = .7*j68*MVK + .07*r243*ISOP*O3 + - r196*M*OH*C3H6 - r197*O3*C3H6 - r198*NO3*C3H6 + d(C3H8)/dt = - r203*OH*C3H8 + d(C3H7O2)/dt = r202*C3H7OOH*OH + r203*C3H8*OH + - r199*NO*C3H7O2 - r200*HO2*C3H7O2 - r201*CH3O2*C3H7O2 + d(C3H7OOH)/dt = r200*C3H7O2*HO2 + - j71*C3H7OOH - r202*OH*C3H7OOH + d(CH3COCH3)/dt = .82*j71*C3H7OOH + .25*j83*ALKOOH + .1*j86*TERPOOH + .82*r199*C3H7O2*NO + + .82*r201*C3H7O2*CH3O2 + .5*r217*ENEO2*NO + .25*r258*ALKO2*NO + .1*r283*TERPO2*NO + - j73*CH3COCH3 - r207*OH*CH3COCH3 + d(PO2)/dt = r196*M*C3H6*OH + .5*r206*POOH*OH + - r204*NO*PO2 - r205*HO2*PO2 + d(POOH)/dt = r205*PO2*HO2 + - j62*POOH - r206*OH*POOH + d(HYAC)/dt = .5*r206*POOH*OH + .2*r210*RO2*CH3O2 + .22*r226*MACRO2*NO + .22*r228*MACRO2*NO3 + + .23*r230*MACRO2*CH3O2 + .22*r231*MACRO2*CH3CO3 + .5*r241*M*MPAN*OH + .02*r245*ISOPO2*NO + + .25*r261*XO2*NO + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + - j78*HYAC - r212*OH*HYAC + d(RO2)/dt = r207*CH3COCH3*OH + r211*ROOH*OH + - r208*NO*RO2 - r209*HO2*RO2 - r210*CH3O2*RO2 + d(CH3COCHO)/dt = .18*j81*BIGALD + .45*j85*TOLOOH + .5*r210*RO2*CH3O2 + r212*HYAC*OH + r215*ONIT*OH + + .95*r219*MVK*O3 + .8*r225*MACR*O3 + .25*r226*MACRO2*NO + .25*r228*MACRO2*NO3 + + .24*r230*MACRO2*CH3O2 + .25*r231*MACRO2*CH3CO3 + .02*r245*ISOPO2*NO + .25*r261*XO2*NO + + .25*r262*XO2*NO3 + .1*r264*XO2*CH3O2 + .25*r265*XO2*CH3CO3 + .45*r269*TOLO2*NO + + .54*r279*XYLO2*NO + - j74*CH3COCHO - r213*OH*CH3COCHO - r214*NO3*CH3COCHO + d(ROOH)/dt = r209*RO2*HO2 + - j72*ROOH - r211*OH*ROOH + d(BIGENE)/dt = - r216*OH*BIGENE + d(BIGALK)/dt = - r254*OH*BIGALK + d(MEK)/dt = .8*j83*ALKOOH + .8*r258*ALKO2*NO + - j80*MEK - r220*OH*MEK + d(ENEO2)/dt = r216*BIGENE*OH + - r217*NO*ENEO2 + d(MEKO2)/dt = r220*MEK*OH + r223*MEKOOH*OH + - r221*NO*MEKO2 - r222*HO2*MEKO2 + d(MEKOOH)/dt = r222*MEKO2*HO2 + - j84*MEKOOH - r223*OH*MEKOOH + d(MCO3)/dt = j65*MPAN + .66*j66*MACR + r240*M*MPAN + .5*r224*MACR*OH + .5*r232*MACROOH*OH + .2*r243*ISOP*O3 + - r233*NO*MCO3 - r234*NO3*MCO3 - r235*HO2*MCO3 - r236*CH3O2*MCO3 - r237*CH3CO3*MCO3 + - 2*r238*MCO3*MCO3 - r239*M*NO2*MCO3 + d(MVK)/dt = .402*j77*ISOPOOH + j86*TERPOOH + .2*r243*ISOP*O3 + .32*r245*ISOPO2*NO + .35*r246*ISOPO2*NO3 + + .26*r249*ISOPO2*CH3O2 + .35*r250*ISOPO2*CH3CO3 + .039*r251*ISOPNO3*NO + .039*r252*ISOPNO3*NO3 + + .039*r253*ISOPNO3*HO2 + r281*C10H16*O3 + r283*TERPO2*NO + - j68*MVK - r218*OH*MVK - r219*O3*MVK + d(MACR)/dt = .288*j77*ISOPOOH + j86*TERPOOH + .4*r243*ISOP*O3 + .23*r245*ISOPO2*NO + .25*r246*ISOPO2*NO3 + + .19*r249*ISOPO2*CH3O2 + .25*r250*ISOPO2*CH3CO3 + .167*r251*ISOPNO3*NO + .167*r252*ISOPNO3*NO3 + + .167*r253*ISOPNO3*HO2 + r281*C10H16*O3 + r283*TERPO2*NO + - j66*MACR - j67*MACR - r224*OH*MACR - r225*O3*MACR + d(MACRO2)/dt = r218*MVK*OH + .5*r224*MACR*OH + .2*r232*MACROOH*OH + - r226*NO*MACRO2 - r227*NO*MACRO2 - r228*NO3*MACRO2 - r229*HO2*MACRO2 - r230*CH3O2*MACRO2 + - r231*CH3CO3*MACRO2 + d(MACROOH)/dt = r229*MACRO2*HO2 + - r232*OH*MACROOH + d(MPAN)/dt = r239*M*MCO3*NO2 + - j65*MPAN - r240*M*MPAN - r241*M*OH*MPAN + d(ONIT)/dt = r198*C3H6*NO3 + .1*r258*ALKO2*NO + - r215*OH*ONIT + d(ISOP)/dt = - r242*OH*ISOP - r243*O3*ISOP - r244*NO3*ISOP + d(ALKO2)/dt = r254*BIGALK*OH + r260*ALKOOH*OH + - r258*NO*ALKO2 - r259*HO2*ALKO2 + d(ALKOOH)/dt = r259*ALKO2*HO2 + - j83*ALKOOH - r260*OH*ALKOOH + d(BIGALD)/dt = .9*j85*TOLOOH + .9*r269*TOLO2*NO + .7*r273*XOH*NO2 + .9*r276*BENO2*NO + .62*r279*XYLO2*NO + - j81*BIGALD + d(HYDRALD)/dt = .33*r245*ISOPO2*NO + .4*r246*ISOPO2*NO3 + .3*r249*ISOPO2*CH3O2 + .4*r250*ISOPO2*CH3CO3 + + r255*ONITR*OH + r256*ONITR*NO3 + - r257*OH*HYDRALD + d(ISOPO2)/dt = r242*ISOP*OH + .2*r248*ISOPOOH*OH + - r245*NO*ISOPO2 - r246*NO3*ISOPO2 - r247*HO2*ISOPO2 - r249*CH3O2*ISOPO2 - r250*CH3CO3*ISOPO2 + d(ISOPNO3)/dt = r244*ISOP*NO3 + - r251*NO*ISOPNO3 - r252*NO3*ISOPNO3 - r253*HO2*ISOPNO3 + d(ONITR)/dt = .8*r227*MACRO2*NO + .08*r245*ISOPO2*NO + .794*r251*ISOPNO3*NO + .794*r252*ISOPNO3*NO3 + + .794*r253*ISOPNO3*HO2 + - j76*ONITR - r255*OH*ONITR - r256*NO3*ONITR + d(XO2)/dt = .8*r248*ISOPOOH*OH + r257*HYDRALD*OH + r266*XOOH*OH + - r261*NO*XO2 - r262*NO3*XO2 - r263*HO2*XO2 - r264*CH3O2*XO2 - r265*CH3CO3*XO2 + d(XOOH)/dt = r263*XO2*HO2 + - j75*XOOH - r266*OH*XOOH - r267*OH*XOOH + d(ISOPOOH)/dt = r247*ISOPO2*HO2 + - j77*ISOPOOH - r248*OH*ISOPOOH + d(TOLUENE)/dt = - r268*OH*TOLUENE + d(CRESOL)/dt = .25*r268*TOLUENE*OH + - r272*OH*CRESOL + d(TOLO2)/dt = .7*r268*TOLUENE*OH + r271*TOLOOH*OH + - r269*NO*TOLO2 - r270*HO2*TOLO2 + d(TOLOOH)/dt = r270*TOLO2*HO2 + - j85*TOLOOH - r271*OH*TOLOOH + d(XOH)/dt = r272*CRESOL*OH + - r273*NO2*XOH + d(BENZENE)/dt = - r274*OH*BENZENE + d(BENO2)/dt = r274*BENZENE*OH + - r275*HO2*BENO2 - r276*NO*BENO2 + d(BENOOH)/dt = r275*BENO2*HO2 + d(XYLENE)/dt = - r277*OH*XYLENE + d(XYLO2)/dt = r277*XYLENE*OH + - r278*HO2*XYLO2 - r279*NO*XYLO2 + d(XYLOOH)/dt = r278*XYLO2*HO2 + d(C10H16)/dt = - r280*OH*C10H16 - r281*O3*C10H16 - r282*NO3*C10H16 + d(TERPO2)/dt = r280*C10H16*OH + r282*C10H16*NO3 + r285*TERPOOH*OH + - r283*NO*TERPO2 - r284*HO2*TERPO2 + d(TERPOOH)/dt = r284*TERPO2*HO2 + - j86*TERPOOH - r285*OH*TERPOOH + d(CH3CL)/dt = - j37*CH3CL - r137*CL*CH3CL - r138*OH*CH3CL + d(CH3BR)/dt = - j48*CH3BR - r30*O1D*CH3BR - r141*OH*CH3BR - r142*CL*CH3BR + d(CFC11)/dt = - j40*CFC11 - r21*O1D*CFC11 + d(CFC12)/dt = - j41*CFC12 - r22*O1D*CFC12 + d(CFC113)/dt = - j42*CFC113 - r23*O1D*CFC113 + d(HCFC22)/dt = - j45*HCFC22 - r26*O1D*HCFC22 - r140*OH*HCFC22 + d(CCL4)/dt = - j38*CCL4 - r29*O1D*CCL4 + d(CH3CCL3)/dt = - j39*CH3CCL3 - r139*OH*CH3CCL3 + d(CF3BR)/dt = - j49*CF3BR - r32*O1D*CF3BR + d(CF2CLBR)/dt = - j50*CF2CLBR - r31*O1D*CF2CLBR + d(HCFC141B)/dt = - j46*HCFC141B - r27*O1D*HCFC141B - r143*OH*HCFC141B + d(HCFC142B)/dt = - j47*HCFC142B - r28*O1D*HCFC142B - r144*OH*HCFC142B + d(CFC114)/dt = - j43*CFC114 - r24*O1D*CFC114 + d(CFC115)/dt = - j44*CFC115 - r25*O1D*CFC115 + d(H1202)/dt = - j53*H1202 - r33*O1D*H1202 + d(H2402)/dt = - j54*H2402 - r34*O1D*H2402 + d(CHBR3)/dt = - j51*CHBR3 - r35*O1D*CHBR3 - r146*OH*CHBR3 - r148*CL*CHBR3 + d(CH2BR2)/dt = - j52*CH2BR2 - r36*O1D*CH2BR2 - r145*OH*CH2BR2 - r147*CL*CH2BR2 + d(CO2)/dt = .44*j60*CH4 + j63*CH3COOOH + .4*j64*PAN + r150*CO*OH + r151*M*CO*OH + r162*HCOOH*OH + + r177*CH3COOH*OH + r185*CH3CO3*NO + .9*r188*CH3CO3*CH3O2 + 2*r189*CH3CO3*CH3CO3 + + .5*r190*CH3COOOH*OH + .8*r191*GLYALD*OH + r192*GLYOXAL*OH + r236*MCO3*CH3O2 + + 2*r237*MCO3*CH3CO3 + 2*r238*MCO3*MCO3 + .5*r241*M*MPAN*OH + r265*XO2*CH3CO3 + - j58*CO2 - j117*CO2 - r350*Op*CO2 + d(N2p)/dt = j97*N2 + j109*N2 + - r348*O*N2p - r349*O*N2p - r356*O2*N2p - r360*e*N2p + d(O2p)/dt = j96*O2 + j108*O2 + r346*Op*O2 + r350*Op*CO2 + r353*Np*O2 + r356*N2p*O2 + - r357*N2*O2p - r351*N*O2p - r352*NO*O2p - r359*e*O2p + d(Np)/dt = j101*N2 + j102*N2 + j113*N2 + j114*N2 + j95*N + - r353*O2*Np - r354*O2*Np - r355*O*Np + d(Op)/dt = j92*O + j93*O + j94*O + j98*O2 + j99*O2 + j100*O2 + j105*O + j106*O + j107*O + j110*O2 + + j111*O2 + j112*O2 + r349*N2p*O + r355*Np*O + - r347*N2*Op - r346*O2*Op - r350*CO2*Op + d(NOp)/dt = j7*NO + r347*N2*Op + r357*N2*O2p + r348*N2p*O + r351*O2p*N + r352*O2p*NO + r354*Np*O2 + - r358*e*NOp + d(e)/dt = j97*N2 + j101*N2 + j102*N2 + j109*N2 + j113*N2 + j114*N2 + j7*NO + j92*O + j93*O + j94*O + + j95*N + j96*O2 + j98*O2 + j99*O2 + j100*O2 + j105*O + j106*O + j107*O + j108*O2 + j110*O2 + + j111*O2 + j112*O2 + - r358*NOp*e - r359*O2p*e - r360*N2p*e + d(N2D)/dt = j102*N2 + 1.2*j104*N2 + j114*N2 + 1.2*j116*N2 + r348*N2p*O + .8*r358*NOp*e + .9*r360*N2p*e + - r65*O2*N2D - r66*O*N2D + d(H2O)/dt = .05*j60*CH4 + j87*H2SO4 + r50*H*HO2 + r53*OH*HO2 + r54*OH*OH + r56*OH*H2 + r57*OH*H2O2 + + r82*HNO3*OH + r88*HO2NO2*OH + r109*HCL*OH + r113*HOCL*OH + r129*HBR*OH + r138*CH3CL*OH + + r139*CH3CCL3*OH + r140*HCFC22*OH + r141*CH3BR*OH + r145*CH2BR2*OH + r149*CH4*OH + r153*CH2O*OH + + r161*CH3OOH*OH + r162*HCOOH*OH + r170*C2H6*OH + r177*CH3COOH*OH + r183*CH3CHO*OH + + r190*CH3COOOH*OH + r202*C3H7OOH*OH + r203*C3H8*OH + r206*POOH*OH + r207*CH3COCH3*OH + + r211*ROOH*OH + r213*CH3COCHO*OH + .5*r224*MACR*OH + r266*XOOH*OH + r267*XOOH*OH + + r333*HOCL*HCL + r334*HOBR*HCL + r338*HOCL*HCL + r344*HOCL*HCL + r345*HOBR*HCL + - j19*H2O - j20*H2O - j21*H2O - r17*O1D*H2O - r133*F*H2O - r325*SO3*H2O + d(C2H2)/dt = - r166*M*CL*C2H2 - r169*M*OH*C2H2 + d(HCOOH)/dt = r164*HOCH2OO*NO + r165*HOCH2OO*HO2 + .35*r169*M*C2H2*OH + .5*r176*C2H4*O3 + - r162*OH*HCOOH + d(HOCH2OO)/dt = r155*CH2O*HO2 + - r163*HOCH2OO - r164*NO*HOCH2OO - r165*HO2*HOCH2OO + d(COF2)/dt = j41*CFC12 + j42*CFC113 + 2*j43*CFC114 + 2*j44*CFC115 + j45*HCFC22 + j47*HCFC142B + j49*CF3BR + + j50*CF2CLBR + j53*H1202 + 2*j54*H2402 + r22*O1D*CFC12 + r23*O1D*CFC113 + 2*r24*O1D*CFC114 + + 2*r25*O1D*CFC115 + r26*O1D*HCFC22 + r28*O1D*HCFC142B + r31*O1D*CF2CLBR + r32*O1D*CF3BR + + r33*O1D*H1202 + 2*r34*O1D*H2402 + r140*HCFC22*OH + r144*HCFC142B*OH + - j55*COF2 - r37*O1D*COF2 + d(COFCL)/dt = j40*CFC11 + j42*CFC113 + j46*HCFC141B + r21*O1D*CFC11 + r23*O1D*CFC113 + r27*O1D*HCFC141B + + r143*HCFC141B*OH + - j56*COFCL - r38*O1D*COFCL + d(HF)/dt = r133*F*H2O + r134*F*H2 + r135*F*CH4 + r136*F*HNO3 + - j57*HF + d(F)/dt = j44*CFC115 + j49*CF3BR + 2*j55*COF2 + j56*COFCL + j57*HF + r25*O1D*CFC115 + r32*O1D*CF3BR + + 2*r37*O1D*COF2 + r38*O1D*COFCL + - r133*H2O*F - r134*H2*F - r135*CH4*F - r136*HNO3*F + d(CB1)/dt = - r289*CB1 - r292*CB1 + d(CB2)/dt = r289*CB1 + - r293*CB2 + d(OC1)/dt = - r290*OC1 - r294*OC1 + d(OC2)/dt = r290*OC1 + - r295*OC2 + d(SOAM)/dt = - r297*SOAM + d(SOAI)/dt = - r298*SOAI + d(SOAT)/dt = - r300*SOAT + d(SOAB)/dt = - r299*SOAB + d(SOAX)/dt = - r301*SOAX + d(SOGM)/dt = 0 + d(SOGI)/dt = 0 + d(SOGT)/dt = 0 + d(SOGB)/dt = 0 + d(SOGX)/dt = 0 + d(SO2)/dt = j89*SO3 + r313*OCS*OH + r317*SO*OH + r318*SO*O2 + r319*SO*O3 + r320*SO*NO2 + r321*SO*CLO + + r322*SO*BRO + r323*SO*OCLO + r326*DMS*OH + .5*r327*DMS*OH + r328*DMS*NO3 + - j88*SO2 - r324*OH*SO2 + d(DMS)/dt = - r326*OH*DMS - r327*OH*DMS - r328*NO3*DMS + d(SO4)/dt = - r296*SO4 + d(NH3)/dt = 0 + d(NH4)/dt = - r302*NH4 + d(NH4NO3)/dt = - r303*NH4NO3 + d(OCS)/dt = - j90*OCS - r312*O*OCS - r313*OH*OCS + d(S)/dt = j90*OCS + j91*SO + - r314*OH*S - r315*O2*S - r316*O3*S + d(SO)/dt = j88*SO2 + r312*OCS*O + r314*S*OH + r315*S*O2 + r316*S*O3 + - j91*SO - r317*OH*SO - r318*O2*SO - r319*O3*SO - r320*NO2*SO - r321*CLO*SO - r322*BRO*SO + - r323*OCLO*SO + d(SO3)/dt = j87*H2SO4 + r324*SO2*OH + - j89*SO3 - r325*H2O*SO3 + d(H2SO4)/dt = r325*SO3*H2O + - j87*H2SO4 + d(SSLT01)/dt = - r304*SSLT01 + d(SSLT02)/dt = - r305*SSLT02 + d(SSLT03)/dt = - r306*SSLT03 + d(SSLT04)/dt = - r307*SSLT04 + d(DST01)/dt = - r308*DST01 + d(DST02)/dt = - r309*DST02 + d(DST03)/dt = - r310*DST03 + d(DST04)/dt = - r311*DST04 diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in new file mode 100644 index 0000000000..25f71518db --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mech.in @@ -0,0 +1,782 @@ +* MOZART-4 mechanism (as in Emmons et al., 2010) +* plus: HCN, CH3CN, C2H2, HCOOH, HOCH2OO +* for use with photolysis lookup table +* Nov 8, 2010: RO2+CH3O2 rate corrected +* Jan 19, 2010: stratospheric species added (WACCM4) +* April 26, 2011: sync 133spc to trop_mozart and JPL06 +* March 15, 2012: correct HCN+OH and MPAN+OH (add +M) +* Jan 23, 2013: change to JPL2010, ADDED EOOH, +Wegner stratospheric chemistry updates +* Jan 23, 2013: add HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 +* Feb 19, 2013: final modifications to trop/strat. DEK. +* Mar 2013: Added SOA from Colette Heald (new species + reactions soa4-10) +* Sep 10, 2014: CCMI TSMLT merged with SOA mechanism; modified CH4 + hv products (DEK). +* Sep 10, 2014 (LKE): updated products of ISOPO2+NO, ISOPO2+NO3, ISOPNO3+HO2, XO2+NO, +* XO2+NO3,XO2+CH3O2,XO2+CH3CO3. Cleaned up labels, comments for benzene,xylene + + SPECIES + + Solution + O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2 + N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5 + CH4, CH3O2, CH3OOH, CH3OH, CH2O, CO + H2, H, OH, HO2, H2O2 + CLY, BRY + CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2 + HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl + BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2 + HCN, CH3CN, C2H4, C2H6, C2H5O2, C2H5OOH, CH3CO3, CH3COOH, CH3CHO, C2H5OH, GLYALD -> HOCH2CHO + GLYOXAL -> C2H2O2, CH3COOOH, EO2 -> HOCH2CH2O2, EO -> HOCH2CH2O, EOOH -> HOCH2CH2OOH, PAN -> CH3CO3NO2 + C3H6, C3H8, C3H7O2, C3H7OOH, CH3COCH3, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH, HYAC -> CH3COCH2OH + RO2 -> CH3COCH2O2, CH3COCHO, ROOH -> CH3COCH2OOH + BIGENE -> C4H8, BIGALK -> C5H12, MEK -> C4H8O, ENEO2 -> C4H9O3, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3 + MCO3 -> CH2CCH3CO3, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO + MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH, MPAN -> CH2CCH3CO3NO2, ONIT -> CH3COCH2ONO2 + ISOP -> C5H8, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, BIGALD -> C5H6O2, HYDRALD -> HOCH2CCH3CHCHO + ISOPO2 -> HOCH2COOCH3CHCH2, ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH + XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO, ISOPOOH -> HOCH2COOHCH3CHCH2 + TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5, XOH -> C7H10O6 + BENZENE -> C6H6, BENO2 -> C6H7O3, BENOOH -> C6H8O3 + XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLOOH -> C8H12O3 + C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3 + CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3 + CFC12 -> CF2Cl2 + CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl + CCL4 -> CCl4, CH3CCL3 -> CH3CCl3 + CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, HCFC141B -> CH3CCl2F, HCFC142B -> CH3CClF2 + CFC114 -> CClF2CClF2, CFC115 -> CClF2CF3, H1202 -> CBr2F2 + H2402 ->CBrF2CBrF2, CHBR3 -> CHBr3, CH2BR2 -> CH2Br2 + CO2, N2p -> N2, O2p -> O2 + Np -> N, Op -> O, NOp -> NO, e -> E, N2D -> N, H2O + C2H2, HCOOH, HOCH2OO, COF2, COFCL -> COFCl, HF, F + CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C + SOAM -> C10H16O4, SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3 + SOGM -> C10H16O4, SOGI -> CH3C4H9O4, SOGT -> C7H9O3, SOGB -> C6H7O3, SOGX -> C8H11O3 + SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3 + OCS, S, SO, SO3, H2SO4 + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + End Solution + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + END Species + + Solution classes + Explicit + CH4, N2O, CH3CL, CH3BR, CFC11, CFC12, CFC113 + CFC114, CFC115, HCFC22, HCFC141B, HCFC142B, CCL4 + CH3CCL3, CF3BR, CF2CLBR, H1202, H2402, CHBR3, CH2BR2 + CO2, CLY, BRY + End explicit + Implicit + O3, O, O1D, O2, O2_1S, O2_1D, H2, CO + N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5 + CH3O2, CH3OOH, HCN, CH3CN, CH2O, H, HO2, H2O2, H2O + CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL + BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e + C3H6, ISOP, PO2, CH3CHO, CH3COOH + POOH, CH3CO3, CH3COOOH, PAN, ONIT, C2H6, C2H4, BIGALK, MPAN + BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE + CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL + BENZENE, BENO2, BENOOH, XYLENE, XYLO2, XYLOOH + ISOPO2, MVK, MACR, MACRO2, MACROOH + MCO3, C2H5O2, C2H5OOH, C10H16 + C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH + CH3OH, C2H5OH, GLYALD, HYAC, EO2 + EO, EOOH, HYDRALD, RO2, CH3COCHO, ISOPNO3, ONITR + XO2, XOOH, ISOPOOH + C2H2, HCOOH, HOCH2OO, COF2, COFCL, HF, F + SO2, DMS, SO4, NH3, NH4, NH4NO3, SOAM, SOAI, SOAT, SOAB, SOAX + SOGM, SOGI, SOGT, SOGB, SOGX + OCS, S, SO, SO3, H2SO4 + CB1, CB2, OC1, OC2 + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End implicit + End Solution classes + + CHEMISTRY + Photolysis + [jo2_a=userdefined,] O2 + hv -> O + O1D + [jo2_b=userdefined,] O2 + hv -> 2*O + [jo3_a] O3 + hv -> O1D + O2_1D + [jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno=userdefined,] NO + hv -> N + O + [jno_i] NO + hv -> NOp + e + [jno2] NO2 + hv -> NO + O + [jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jn2o5_b] N2O5 + hv -> NO + O + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> NO2 + O + [jno3_b] NO3 + hv -> NO + O2 + [jho2no2_a] HO2NO2 + hv -> OH + NO3 + [jho2no2_b] HO2NO2 + hv -> NO2 + HO2 + [jch3ooh] CH3OOH + hv -> CH2O + H + OH + [jch2o_a] CH2O + hv -> CO + 2*H + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o_a] H2O + hv -> OH + H + [jh2o_b] H2O + hv -> H2 + O1D + [jh2o_c] H2O + hv -> 2*H + O + [jh2o2] H2O2 + hv -> 2*OH + [jcl2] CL2 + hv -> 2*CL + [jclo] CLO + hv -> CL + O + [joclo] OCLO + hv -> O + CLO + [jcl2o2] CL2O2 + hv -> 2*CL + [jhocl] HOCL + hv -> OH + CL + [jhcl] HCL + hv -> H + CL + [jclono2_a] CLONO2 + hv -> CL + NO3 + [jclono2_b] CLONO2 + hv -> CLO + NO2 + [jbrcl] BRCL + hv -> BR + CL + [jbro] BRO + hv -> BR + O + [jhobr] HOBR + hv -> BR + OH + [jhbr] HBR + hv -> BR + H + [jbrono2_a] BRONO2 + hv -> BR + NO3 + [jbrono2_b] BRONO2 + hv -> BRO + NO2 + [jch3cl] CH3CL + hv -> CL + CH3O2 + [jccl4] CCL4 + hv -> 4*CL + [jch3ccl3] CH3CCL3 + hv -> 3*CL + [jcfcl3] CFC11 + hv -> 2*CL + COFCL + [jcf2cl2] CFC12 + hv -> 2*CL + COF2 + [jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 + [jcfc114] CFC114 + hv -> 2*CL + 2*COF2 + [jcfc115] CFC115 + hv -> CL + F + 2*COF2 + [jhcfc22] HCFC22 + hv -> CL + COF2 + [jhcfc141b] HCFC141B + hv -> CL + COFCL + [jhcfc142b] HCFC142B + hv -> CL + COF2 + [jch3br] CH3BR + hv -> BR + CH3O2 + [jcf3br] CF3BR + hv -> BR + F + COF2 + [jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 + [jchbr3] CHBR3 + hv -> 3*BR + [jch2br2] CH2BR2 + hv -> 2*BR + [jh1202] H1202 + hv -> 2*BR + COF2 + [jh2402] H2402 + hv -> 2*BR + 2*COF2 + [jcof2] COF2 + hv -> 2*F + [jcofcl] COFCL + hv -> F + CL + [jhf] HF + hv -> H + F + [jco2] CO2 + hv -> CO + O + [jch4_a] CH4 + hv -> H + CH3O2 + [jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O + [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 + [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH + [jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 + [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 + [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 + [jmacr_a] MACR + hv -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3 + [jmacr_b] MACR + hv -> .66 * HO2 + 1.34 * CO + [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3 + [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH + [jeooh->,jch3ooh] EOOH + hv -> EO + OH + [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2 + [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH + [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 + [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 + [jxooh->,jch3ooh] XOOH + hv -> OH + [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O + [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2 + [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O + [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O + [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 + [jbigald->,0.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL +.56*HO2 + .13*CH3CO3 + .18*CH3COCHO + [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 + [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH + [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO + [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR + [jh2so4] H2SO4 + hv -> SO3 + H2O + [jso2] SO2 + hv -> SO + O + [jso3] SO3 + hv -> SO2 + O + [jocs] OCS + hv -> S + CO + [jso] SO + hv -> S + O + +*------------------------------------------------------------------------------ +* photo-ionization +*------------------------------------------------------------------------------ + [jeuv_1=userdefined,userdefined] O + hv -> Op + e + [jeuv_2=userdefined,userdefined] O + hv -> Op + e + [jeuv_3=userdefined,userdefined] O + hv -> Op + e + [jeuv_4=userdefined,userdefined] N + hv -> Np + e + [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_14=userdefined,userdefined] O + hv -> Op + e + [jeuv_15=userdefined,userdefined] O + hv -> Op + e + [jeuv_16=userdefined,userdefined] O + hv -> Op + e + [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e + [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e + [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e + [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e + [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e + [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O + [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N + [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O + End Photolysis + + Reactions +* -------------------------------------------------------------- +* Odd-Oxygen Reactions +* -------------------------------------------------------------- + [usr_O_O2,cph=101.39] O + O2 + M -> O3 + M + [O_O3,cph=392.19] O + O3 -> 2*O2 ; 8.00e-12, -2060. + [usr_O_O,cph=493.58] O + O + M -> O2 + M + [O2_1S_O,cph=62.60] O2_1S + O -> O2_1D + O ; 8.00e-14 + [O2_1S_O2,cph=62.60] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17 + [O2_1S_N2,cph=62.60] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45. + [O2_1S_O3,cph=62.60] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135. + [O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13 + [ag2] O2_1S -> O2 ; 8.50e-2 + [O2_1D_O,cph=94.30] O2_1D + O -> O2 + O ; 1.30e-16 + [O2_1D_O2,cph=94.30] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220. + [O2_1D_N2,cph=94.30] O2_1D + N2 -> O2 + N2 ; 1.00e-20 + [ag1] O2_1D -> O2 ; 2.58e-04 + +* -------------------------------------------------------------- +* Odd-Oxygen Reactions (O1D only) +* -------------------------------------------------------------- + [O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110. + [O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 3.135e-11, 55. + [O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 1.65e-12, 55. + [O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60. + [O1D_N2Oa] O1D + N2O -> 2*NO ; 7.25e-11, 20. + [O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.63e-11, 20. + [O1D_O3] O1D + O3 -> O2 + O2 ; 1.20e-10 + [O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.02e-10 + [O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 + [O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 1.50e-10 + [O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 9.75e-11 + [O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 1.50e-11 + [O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.20e-11 + [O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 + [O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.628e-10 + [O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.84e-10 + [O1D_CH3BR] O1D + CH3BR -> BR ; 1.674e-10 + [O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.60e-11 + [O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.10e-11 + [O1D_H1202] O1D + H1202 -> 2*BR + COF2 ; 1.012e-10 + [O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.20e-10 + [O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.49e-10 + [O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 + [O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 + [O1D_COFCL] O1D + COFCL -> F + CL ; 1.90e-10 + [O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 + [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.50e-11 + [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9.00e-12 + [O1D_H2] O1D + H2 -> H + OH ; 1.20e-10 + [O1D_HCL] O1D + HCL -> CL + OH ; 1.50e-10 + [O1D_HBR] O1D + HBR -> BR + OH ; 1.20e-10 + [O1D_HCN] O1D + HCN -> OH ; 7.70e-11, 100. + +* -------------------------------------------------------------- +* Odd Hydrogen Reactions +* -------------------------------------------------------------- + [H_O2,cph=203.40] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 7.5e-11, -0.2, 0.6 + [H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.40e-10, -470. + [H_HO2a] H + HO2 -> 2*OH ; 7.20e-11 + [H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.90e-12 + [H_HO2b] H + HO2 -> H2O + O ; 1.60e-12 + [OH_O,cph=67.67] OH + O -> H + O2 ; 1.80e-11, 180. + [OH_O3,cph=165.30] OH + O3 -> HO2 + O2 ; 1.70e-12, -940. + [OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.80e-11, 250. + [OH_OH] OH + OH -> H2O + O ; 1.80e-12 + [OH_OH_M] OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6 + [OH_H2] OH + H2 -> H2O + H ; 2.80e-12, -1800. + [OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.80e-12 + [H2_O] H2 + O -> OH + H ; 1.60e-11, -4570. + [HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3.00e-11, 200. + [HO2_O3,cph=120.10] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490. + [usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 + [H2O2_O] H2O2 + O -> OH + HO2 ; 1.40e-12, -2000. + [HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8 + [CH3CN_OH] CH3CN + OH -> HO2 ; 7.80e-13, -1050. + +* -------------------------------------------------------------- +* Odd Nitrogen Reactions +* -------------------------------------------------------------- + [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5.00e-12 + [N2D_O,cph=229.61] N2D + O -> N + O ; 7.00e-13 + [N_OH] N + OH -> NO + H ; 5.00e-11 + [N_O2,cph=133.75] N + O2 -> NO + O ; 1.50e-11, -3600. + [N_NO,cph=313.75] N + NO -> N2 + O ; 2.10e-11, 100. + [N_NO2a] N + NO2 -> N2O + O ; 2.90e-12, 220. + [N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220. + [N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220. + [NO_O_M] NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6 + [NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.30e-12, 270. + [NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500. + [NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.10e-12, 210. + [NO2_O_M] NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6 + [NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450. + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + [NO3_NO] NO3 + NO -> 2*NO2 ; 1.50e-11, 170. + [NO3_O] NO3 + O -> NO2 + O2 ; 1.00e-11 + [NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.20e-11 + [NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6 + [HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380. + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + +* -------------------------------------------------------------- +* Odd Chlorine Reactions +* -------------------------------------------------------------- + [CL_O3] CL + O3 -> CLO + O2 ; 2.30e-11, -200. + [CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270. + [CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980. + [CL_HO2a] CL + HO2 -> HCL + O2 ; 1.40e-11, 270. + [CL_HO2b] CL + HO2 -> OH + CLO ; 3.60e-11, -375. + [CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30. + [CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280. + [CLO_O] CLO + O -> CL + O2 ; 2.80e-11, 85. + [CLO_OHa] CLO + OH -> CL + HO2 ; 7.40e-12, 270. + [CLO_OHb] CLO + OH -> HCL + O2 ; 6.00e-13, 230. + [CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.60e-12, 290. + [CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115. + [CLO_NO] CLO + NO -> NO2 + CL ; 6.40e-12 , 290. + [CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6 + [CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450. + [CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590. + [CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.50e-13, -1370. + [tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 3.0e-12, 2.0, 0.6 + [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M + [HCL_OH] HCL + OH -> H2O + CL ; 1.80e-12, -250. + [HCL_O] HCL + O -> CL + OH ; 1.00e-11, -3300. + [HOCL_O] HOCL + O -> CLO + OH ; 1.70e-13 + [HOCL_CL] HOCL + CL -> HCL + CLO ; 3.40e-12, -130. + [HOCL_OH] HOCL + OH -> H2O + CLO ; 3.00e-12, -500. + [CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.60e-12, -840. + [CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330. + [CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135. + +* -------------------------------------------------------------- +* Odd Bromine Reactions +* -------------------------------------------------------------- + [BR_O3] BR + O3 -> BRO + O2 ; 1.60e-11, -780. + [BR_HO2] BR + HO2 -> HBR + O2 ; 4.80e-12, -310. + [BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800. + [BRO_O] BRO + O -> BR + O2 ; 1.90e-11, 230. + [BRO_OH] BRO + OH -> BR + HO2 ; 1.70e-11, 250. + [BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460. + [BRO_NO] BRO + NO -> BR + NO2 ; 8.80e-12, 260. + [BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6 + [BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.50e-13, 550. + [BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260. + [BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.10e-13, 290. + [BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230. + [HBR_OH] HBR + OH -> BR + H2O ; 5.50e-12, 200. + [HBR_O] HBR + O -> BR + OH ; 5.80e-12, -1500. + [HOBR_O] HOBR + O -> BRO + OH ; 1.20e-10, -430. + [BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215. + +* -------------------------------------------------------------- +* Odd Flourine Reactions +* -------------------------------------------------------------- + [F_H2O] F + H2O -> HF + OH ; 1.40e-11, 0. + [F_H2] F + H2 -> HF + H ; 1.40e-10, -500. + [F_CH4] F + CH4 -> HF + CH3O2 ; 1.60e-10, -260. + [F_HNO3] F + HNO3 -> HF + NO3 ; 6.00e-12, 400. + +* -------------------------------------------------------------- +* Organic Halogens Reactions with Cl, OH +* -------------------------------------------------------------- + [CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130. + [CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250. + [CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520. + [HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 1.05e-12, -1600. + [CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300. + [CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.40e-11, -1030. + [HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600. + [HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.30e-12, -1770. + [CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2.00e-12, -840. + [CHBR3_OH] CHBR3 + OH -> 3*BR ; 1.35e-12, -600. + [CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.30e-12, -800. + [CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850. + +* -------------------------------------------------------------- +* C-1 Degradation (Methane, CO, CH2O and derivatives) +* -------------------------------------------------------------- + [CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775. + [usr_CO_OH_b] CO + OH -> CO2 + H + [CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058. + [CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.50e-12, 125. + [CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600. + [CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625. + [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300. + [CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750. + [CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.00e-13, -424. + [CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.90e-14, 706. + [CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.90e-12, -345. + [CH3OOH_OH] CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.80e-12, 200. + [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4.50e-13 + [HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.40e12, -7000. + [HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.60e-12, 265. + [HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.50e-13, 700. + +* -------------------------------------------------------------- +* C-2 Degradation +* +* EO = HOCH2CH2O +* EO2 = HOCH2CH2O2 +* EOOH = HOCH2CH2OOH +* PAN = CH3CO3NO2 +* GLYALD = HOCH2CHO +* GLYOXAL= C2H2O2 +* C2H2 = C2H2 +* -------------------------------------------------------------- + [C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.20e-30, 2.4, 2.2e-10, 0.7, 0.6 + [C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.60e-29, 3.3, 3.1e-10, 1.0, 0.6 + [C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.20e-11, -70. + [C2H2_OH_M] C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.50e-30, 0.0, 8.3e-13, -2.0, 0.6 + + .35*CO + M + [C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020. + [tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.60e-29, 3.1, 9.00e-12, 0.85, 0.48 + [EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.20e-12, 180. + [EO2_HO2] EO2 + HO2 -> EOOH ; 7.50e-13, 700. + [EO_O2] EO + O2 -> GLYALD + HO2 ; 1.00e-14 + [EO_M] EO -> 2 * CH2O + HO2 ; 1.60e11, -4150. + [C2H4_O3] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630. + [CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.00e-13 + [C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.60e-12, 365. + [C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.50e-13, 700. + [C2H5O2_CH3O2] C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.00e-13 + + .3 * CH3OH + .2 * C2H5OH + [C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.80e-14 + [C2H5OOH_OH] C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.80e-12, 200. + [CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350. + [CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.40e-12, -1900. + [CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.10e-12, 270. + [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 9.70e-29, 5.6, 9.30e-12, 1.5, 0.6 + [CH3CO3_HO2] CH3CO3 + HO2 -> .75 * CH3COOOH + .25 * CH3COOH + .25 * O3 ; 4.30e-13, 1040. + [CH3CO3_CH3O2] CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.00e-12, 500. + + .9*CO2 + .1*CH3COOH + [CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.50e-12, 500. + [CH3COOOH_OH] CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1.00e-12 + [GLYALD_OH] GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.00e-11 + [GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 + [C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.90e-12, -230. + [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M + [PAN_OH] PAN + OH -> CH2O + NO3 ; 4.00e-14 + +* -------------------------------------------------------------- +* C-3 Degradation +* +* PO2 = C3H6OHO2 +* POOH = C3H6OHOOH +* RO2 = CH3COCH2O2 +* ROOH = CH3COCH2OOH +* HYAC = CH3COCH2OH +* ONIT = CH3COCH2ONO2 +* -------------------------------------------------------------- + [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5 + [C3H6_O3] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 ; 6.50e-15, -1900. + + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + [C3H6_NO3] C3H6 + NO3 -> ONIT ; 4.60e-13, -1156. + [C3H7O2_NO] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.20e-12, 180. + [C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.50e-13, 700. + [CH3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40. + [CH3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.80e-12, 200. + [C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 8.70e-12, -615. + [PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.20e-12, 180. + [PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.50e-13, 700. + [POOH_OH] POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.80e-12, 200. + [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O + [RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.90e-12, 300. + [RO2_HO2] RO2 + HO2 -> ROOH + O2 ; 8.60e-13, 700. + [RO2_CH3O2] RO2 + CH3O2 -> .3*CH3CO3 + .8* CH2O + .3*HO2 + .2*HYAC ; 7.10e-13, 500. + + .5*CH3COCHO + .5*CH3OH + [ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.80e-12, 200. + [HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3.00e-12 + [CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.40e-13, 830. + [CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.40e-12, -1860. + [ONIT_OH] ONIT + OH -> NO2 + CH3COCHO ; 6.80e-13 + +* -------------------------------------------------------------- +* C-4 Degradation +* BIGENE -> C4H8 +* ENEO2 = C4H9O3 +* MEK = C4H8O +* MEKO2 = C4H7O3 +* MEKOOH = C4H8O3 +* MVK = CH2CHCOCH3 +* MACR = CH2CCH3CHO +* MACRO2 = CH3COCHO2CH2OH +* MACROOH = CH3COCHOOHCH2OH +* MCO3 = CH2CCH3CO3 +* MPAN = CH2CCH3CO3NO2 +* -------------------------------------------------------------- + [BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.40e-11 + [ENEO2_NO] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.20e-12, 180. + [MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452. + [MVK_O3] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH ; 7.52e-16, -1521. + + .2 * O3 + .06 * HO2 + .05 * CO + .04 * CH3CHO + [MEK_OH] MEK + OH -> MEKO2 ; 2.30e-12, -170. + [MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.20e-12, 180. + [MEKO2_HO2] MEKO2 + HO2 -> MEKOOH ; 7.50e-13, 700. + [MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.80e-12, 200. + [MACR_OH] MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175. + [MACR_O3] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO ; 4.40e-15, -2500. + + .2 * O3 + .7 * CH2O + .215 * OH + [MACRO2_NOa] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.70e-12, 360. + + .53 * GLYALD + .25 * CH3COCHO + + .53 * CH3CO3 + .22 * HYAC + .22 * CO + [MACRO2_NOb] MACRO2 + NO -> 0.8*ONITR ; 1.30e-13, 360. + [MACRO2_NO3] MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O ; 2.40e-12 + + .25 * CH3COCHO + .22 * CO + + .53 * GLYALD + .22*HYAC + .53*CH3CO3 + [MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8.00e-13, 700. + [MACRO2_CH3O2] MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO ; 5.00e-13, 400. + + .24 * CH3COCHO + + .26 * GLYALD + .26 * CH3CO3 + + .25 * CH3OH + .23 * HYAC + [MACRO2_CH3CO3] MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO ; 1.40e-11 + + .47 * HO2 + .53 * GLYALD + + .22 * HYAC + .25*CH2O + .53*CH3CO3 + [MACROOH_OH] MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.30e-11, 200. + [MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.30e-12, 360. + [MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.00e-12 + [MCO3_HO2] MCO3 + HO2 -> .25 * O3 + .25 * CH3COOH + .75 * CH3COOOH ; 4.30e-13, 1040. + + .75 * O2 + [MCO3_CH3O2] MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.00e-12, 500. + [MCO3_CH3CO3] MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.60e-12, 530. + [MCO3_MCO3] MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.30e-12, 530. + [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M + [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M + [MPAN_OH_M] MPAN + OH + M -> .5 * HYAC + .5 * NO3 + .5 * CH2O ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5 + + .5 *HO2 + 0.5 * CO2 + M + +* -------------------------------------------------------------- +* C-5 Degradation +* +* ISOP = C5H8 +* ISOPO2 = HOCH2COOCH3CHCH2 +* ISOPNO3 = CH2CHCCH3OOCH2ONO2 +* ISOPOOH = HOCH2COOHCH3CHCH2 +* BIGALK = C5H12, +* ALKO2 = C5H11O2 +* ALKOOH = C5H12O2 +* ONITR = CH2CCH3CHONO2CH2OH +* XO2 = HOCH2COOCH3CHOHCHO +* XOOH = HOCH2COOHCH3CHOHCHO +* -------------------------------------------------------------- + [ISOP_OH] ISOP + OH -> ISOPO2 ; 2.54e-11, 410. + [ISOP_O3] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000. + + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3 + + .2 * MCO3 + .2 * CH3COOH + [ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446. + [ISOPO2_NO] ISOPO2 + NO -> .08*ONITR + .92*NO2 + .23*MACR + .32*MVK ; 4.40e-12, 180. + + .33*HYDRALD + .02*GLYOXAL + .02*GLYALD + + .02*CH3COCHO + .02*HYAC + .55*CH2O + .92*HO2 + [ISOPO2_NO3] ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.40e-12 + + .35 * MVK + .4 * HYDRALD + [ISOPO2_HO2] ISOPO2 + HO2 -> ISOPOOH ; 8.00e-13, 700. + [ISOPOOH_OH] ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200. + [ISOPO2_CH3O2] ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.00e-13, 400. + + .19 * MACR + .26 * MVK + .3 * HYDRALD + [ISOPO2_CH3CO3] ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.40e-11 + + .25 * MACR + .35 * MVK + .4 * HYDRALD + [ISOPNO3_NO] ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O ; 2.70e-12, 360. + + .167 * MACR + .039 * MVK + .794 * ONITR + [ISOPNO3_NO3] ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR ; 2.40e-12 + + .039 * MVK + .794 * ONITR + .794 * HO2 + [ISOPNO3_HO2] ISOPNO3 + HO2 -> .206*NO2 + .206*CH2O +.206*OH ; 8.00e-13, 700. + + .167 * MACR + .039 * MVK + .794 * ONITR + [BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.50e-12 + [ONITR_OH] ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.50e-11 + [ONITR_NO3] ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.40e-12, -1860. + [HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175. + [ALKO2_NO] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 ; 4.20e-12, 180. + + .9*HO2 + .8*MEK + .9*NO2 + .1*ONIT + [ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.50e-13, 700. + [ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.80e-12, 200. + [XO2_NO] XO2 + NO -> NO2 + HO2 + .25*CO + .25*CH2O + .25*GLYOXAL ; 2.7e-12, 360. + + .25*CH3COCHO + .25*HYAC + .25*GLYALD + [XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12 + + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD + [XO2_HO2] XO2 + HO2 -> XOOH ; 8.00e-13, 700. + [XO2_CH3O2] XO2 + CH3O2 -> .3*CH3OH + .8*HO2 + .8*CH2O + .2*CO ; 5.e-13, 400. + + .1*GLYOXAL + .1*CH3COCHO + .1*HYAC + .1*GLYALD + [XO2_CH3CO3] XO2 + CH3CO3 -> .25*CO + .25*CH2O + .25*GLYOXAL + CH3O2 ; 1.3e-12, 640. + + HO2 + .25*CH3COCHO + .25*HYAC + .25*GLYALD + CO2 + [XOOH_OHa] XOOH + OH -> H2O + XO2 ; 1.90e-12, 190. + [usr_XOOH_OH] XOOH + OH -> H2O + OH + +* -------------------------------------------------------------- +* C-7 degradation +* +* TOLUENE = C7H8 +* CRESOL = C7H8O +* TOLO2 = C7H9O5 +* TOLOOH = C7H10O5 +* XOH = C7H10O6 +* -------------------------------------------------------------- + [TOLUENE_OH] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.70e-12, 352. + [TOLO2_NO] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.20e-12, 180. + + .9*NO2 + .9*HO2 + [TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.50e-13, 700. + [TOLO2_OH] TOLOOH + OH -> TOLO2 ; 3.80e-12, 200. + [CRESOL_OH] CRESOL + OH -> XOH ; 3.00e-12 + [XOH_NO2] XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.00e-11 + [BENZENE_OH] BENZENE + OH -> BENO2 ; 2.3e-12, -193 + [BENO2_HO2] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700 + [BENO2_NO] BENO2 + NO -> 0.9*GLYOXAL + 0.9*BIGALD + 0.9*NO2 + 0.9*HO2 ; 2.6e-12, 350 + [XYLENE_OH] XYLENE + OH -> XYLO2 ; 2.3e-11 + [XYLO2_HO2] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700 + [XYLO2_NO] XYLO2 + NO -> 0.62*BIGALD + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.9*NO2 + 0.9*HO2 ; 2.6e-12, 350 +* -------------------------------------------------------------- +* C-10 degradation +* +* TERPO2 = C10H17O3 +* TERPOOH = C10H18O3 +* -------------------------------------------------------------- + [C10H16_OH] C10H16 + OH -> TERPO2 ; 1.2e-11, 444. + [C10H16_O3] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732. + [C10H16_NO3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490. + [TERPO2_NO] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180. + [TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700. + [TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.8e-12, 200. + +* -------------------------------------------------------------- +* Tropospheric Heterogeneous Reactions +* -------------------------------------------------------------- + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + [CB1_CB2] CB1 -> CB2 ; 7.10e-6 + [OC1_OC2] OC1 -> OC2 ; 7.10e-6 + [usr_HO2_aer] HO2 -> 0.5*H2O2 + +* -------------------------------------------------------------- +* Stratospheric removal rates for BAM aerosols +* -------------------------------------------------------------- + [usr_CB1_strat_tau] CB1 -> ; 6.34e-8 + [usr_CB2_strat_tau] CB2 -> ; 6.34e-8 + [usr_OC1_strat_tau] OC1 -> ; 6.34e-8 + [usr_OC2_strat_tau] OC2 -> ; 6.34e-8 + [usr_SO4_strat_tau] SO4 -> ; 6.34e-8 + [usr_SOAM_strat_tau] SOAM-> ; 6.34e-8 + [usr_SOAI_strat_tau] SOAI-> ; 6.34e-8 + [usr_SOAB_strat_tau] SOAB-> ; 6.34e-8 + [usr_SOAT_strat_tau] SOAT-> ; 6.34e-8 + [usr_SOAX_strat_tau] SOAX-> ; 6.34e-8 + [usr_NH4_strat_tau] NH4 -> ; 6.34e-8 + [usr_NH4NO3_strat_tau] NH4NO3 -> ; 6.34e-8 + [usr_SSLT01_strat_tau] SSLT01 -> ; 6.34e-8 + [usr_SSLT02_strat_tau] SSLT02 -> ; 6.34e-8 + [usr_SSLT03_strat_tau] SSLT03 -> ; 6.34e-8 + [usr_SSLT04_strat_tau] SSLT04 -> ; 6.34e-8 + [usr_DST01_strat_tau] DST01 -> ; 6.34e-8 + [usr_DST02_strat_tau] DST02 -> ; 6.34e-8 + [usr_DST03_strat_tau] DST03 -> ; 6.34e-8 + [usr_DST04_strat_tau] DST04 -> ; 6.34e-8 + +* -------------------------------------------------------------- +* Sulfur Reactions +* -------------------------------------------------------------- + [OCS_O] OCS + O -> SO + CO ; 2.10E-11, -2200.0 + [OCS_OH] OCS + OH -> SO2 + CO + H ; 1.10E-13, -1200.0 + [S_OH] S + OH -> SO + H ; 6.60E-11 + [S_O2] S + O2 -> SO + O ; 2.30E-12 + [S_O3] S + O3 -> SO + O2 ; 1.20E-11 + [SO_OH] SO + OH -> SO2 + H ; 2.70E-11, 335 + [SO_O2] SO + O2 -> SO2 + O ; 1.25E-13, -2190.0 + [SO_O3] SO + O3 -> SO2 + O2 ; 3.40E-12, -1100.0 + [SO_NO2] SO + NO2 -> SO2 + NO ; 1.40E-11 + [SO_CLO] SO + CLO -> SO2 + CL ; 2.80E-11 + [SO_BRO] SO + BRO -> SO2 + BR ; 5.70E-11 + [SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.90E-12 + [usr_SO2_OH] SO2 + OH -> SO3 + HO2 + [usr_SO3_H2O] SO3 + H2O -> H2SO4 + [DMS_OHa] DMS + OH -> SO2 ; 9.60e-12, -234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.90e-13, 520. + +* -------------------------------------------------------------- +* Sulfate aerosol reactions +* -------------------------------------------------------------- + [het1] N2O5 -> 2*HNO3 + [het2] CLONO2 -> HOCL + HNO3 + [het3] BRONO2 -> HOBR + HNO3 + [het4] CLONO2 + HCL -> CL2 + HNO3 + [het5] HOCL + HCL -> CL2 + H2O + [het6] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Nitric acid Di-hydrate reactions +* -------------------------------------------------------------- + [het7] N2O5 -> 2*HNO3 + [het8] CLONO2 -> HOCL + HNO3 + [het9] CLONO2 + HCL -> CL2 + HNO3 + [het10] HOCL + HCL -> CL2 + H2O + [het11] BRONO2 -> HOBR + HNO3 + +* -------------------------------------------------------------- +* Ice aerosol reactions +* -------------------------------------------------------------- + [het12] N2O5 -> 2*HNO3 + [het13] CLONO2 -> HOCL + HNO3 + [het14] BRONO2 -> HOBR + HNO3 + [het15] CLONO2 + HCL -> CL2 + HNO3 + [het16] HOCL + HCL -> CL2 + H2O + [het17] HOBR + HCL -> BRCL + H2O + +* -------------------------------------------------------------- +* Ion reactions +* -------------------------------------------------------------- + [ion_Op_O2,cph=150.11] Op + O2 -> O2p + O + [ion_Op_N2,cph=105.04] Op + N2 -> NOp + N + [ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D + [ion_N2p_Ob] N2p + O -> Op + N2 + [ion_Op_CO2] Op + CO2 -> O2p + CO ; 9.0e-10 + [ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1.0e-10 + [ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 + [ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4.0e-10 + [ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2.0e-10 + [ion_Np_O,cph=95.55] Np + O -> Op + N ; 1.0e-12 + [ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6.0e-11 + [ion_O2p_N2] O2p + N2 -> NOp + NO ; 5.0e-16 + [elec1,cph=82.389] NOp + e -> .2*N + .8*N2D + O + [elec2,cph=508.95] O2p + e -> 1.15*O + .85*O1D + [elec3,cph=354.83] N2p + e -> 1.1*N + .9*N2D + End Reactions + + Ext Forcing + NO <-dataset + NO2 <-dataset + CO <-dataset + SO2 <- dataset + SO4 <- dataset + CB1 <- dataset + Op, O2p, Np, N2p, N2D, N, e, OH + End Ext Forcing + + END Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = intel + model = cam + model_architecture = SCALAR + architecture = hybrid +* vec_ftns = on + namemod = on + End Version Options + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 new file mode 100644 index 0000000000..a3aaa66cdc --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 117, & ! number of photolysis reactions + rxntot = 477, & ! number of total reactions + gascnt = 360, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 174, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 1555, & ! number of non-zero matrix entries + extcnt = 14, & ! number of species with external forcing + clscnt1 = 23, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 151, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 477, & + enthalpy_cnt = 41, & + nslvd = 0 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 new file mode 100644 index 0000000000..c3123fdf7f --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/m_rxt_id.F90 @@ -0,0 +1,480 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jo2_a = 1 + integer, parameter :: rid_jo2_b = 2 + integer, parameter :: rid_jo3_a = 3 + integer, parameter :: rid_jo3_b = 4 + integer, parameter :: rid_jn2o = 5 + integer, parameter :: rid_jno = 6 + integer, parameter :: rid_jno_i = 7 + integer, parameter :: rid_jno2 = 8 + integer, parameter :: rid_jn2o5_a = 9 + integer, parameter :: rid_jn2o5_b = 10 + integer, parameter :: rid_jhno3 = 11 + integer, parameter :: rid_jno3_a = 12 + integer, parameter :: rid_jno3_b = 13 + integer, parameter :: rid_jho2no2_a = 14 + integer, parameter :: rid_jho2no2_b = 15 + integer, parameter :: rid_jch3ooh = 16 + integer, parameter :: rid_jch2o_a = 17 + integer, parameter :: rid_jch2o_b = 18 + integer, parameter :: rid_jh2o_a = 19 + integer, parameter :: rid_jh2o_b = 20 + integer, parameter :: rid_jh2o_c = 21 + integer, parameter :: rid_jh2o2 = 22 + integer, parameter :: rid_jcl2 = 23 + integer, parameter :: rid_jclo = 24 + integer, parameter :: rid_joclo = 25 + integer, parameter :: rid_jcl2o2 = 26 + integer, parameter :: rid_jhocl = 27 + integer, parameter :: rid_jhcl = 28 + integer, parameter :: rid_jclono2_a = 29 + integer, parameter :: rid_jclono2_b = 30 + integer, parameter :: rid_jbrcl = 31 + integer, parameter :: rid_jbro = 32 + integer, parameter :: rid_jhobr = 33 + integer, parameter :: rid_jhbr = 34 + integer, parameter :: rid_jbrono2_a = 35 + integer, parameter :: rid_jbrono2_b = 36 + integer, parameter :: rid_jch3cl = 37 + integer, parameter :: rid_jccl4 = 38 + integer, parameter :: rid_jch3ccl3 = 39 + integer, parameter :: rid_jcfcl3 = 40 + integer, parameter :: rid_jcf2cl2 = 41 + integer, parameter :: rid_jcfc113 = 42 + integer, parameter :: rid_jcfc114 = 43 + integer, parameter :: rid_jcfc115 = 44 + integer, parameter :: rid_jhcfc22 = 45 + integer, parameter :: rid_jhcfc141b = 46 + integer, parameter :: rid_jhcfc142b = 47 + integer, parameter :: rid_jch3br = 48 + integer, parameter :: rid_jcf3br = 49 + integer, parameter :: rid_jcf2clbr = 50 + integer, parameter :: rid_jchbr3 = 51 + integer, parameter :: rid_jch2br2 = 52 + integer, parameter :: rid_jh1202 = 53 + integer, parameter :: rid_jh2402 = 54 + integer, parameter :: rid_jcof2 = 55 + integer, parameter :: rid_jcofcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jco2 = 58 + integer, parameter :: rid_jch4_a = 59 + integer, parameter :: rid_jch4_b = 60 + integer, parameter :: rid_jch3cho = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jch3co3h = 63 + integer, parameter :: rid_jpan = 64 + integer, parameter :: rid_jmpan = 65 + integer, parameter :: rid_jmacr_a = 66 + integer, parameter :: rid_jmacr_b = 67 + integer, parameter :: rid_jmvk = 68 + integer, parameter :: rid_jc2h5ooh = 69 + integer, parameter :: rid_jeooh = 70 + integer, parameter :: rid_jc3h7ooh = 71 + integer, parameter :: rid_jrooh = 72 + integer, parameter :: rid_jacet = 73 + integer, parameter :: rid_jmgly = 74 + integer, parameter :: rid_jxooh = 75 + integer, parameter :: rid_jonitr = 76 + integer, parameter :: rid_jisopooh = 77 + integer, parameter :: rid_jhyac = 78 + integer, parameter :: rid_jglyald = 79 + integer, parameter :: rid_jmek = 80 + integer, parameter :: rid_jbigald = 81 + integer, parameter :: rid_jglyoxal = 82 + integer, parameter :: rid_jalkooh = 83 + integer, parameter :: rid_jmekooh = 84 + integer, parameter :: rid_jtolooh = 85 + integer, parameter :: rid_jterpooh = 86 + integer, parameter :: rid_jh2so4 = 87 + integer, parameter :: rid_jso2 = 88 + integer, parameter :: rid_jso3 = 89 + integer, parameter :: rid_jocs = 90 + integer, parameter :: rid_jso = 91 + integer, parameter :: rid_jeuv_1 = 92 + integer, parameter :: rid_jeuv_2 = 93 + integer, parameter :: rid_jeuv_3 = 94 + integer, parameter :: rid_jeuv_4 = 95 + integer, parameter :: rid_jeuv_5 = 96 + integer, parameter :: rid_jeuv_6 = 97 + integer, parameter :: rid_jeuv_7 = 98 + integer, parameter :: rid_jeuv_8 = 99 + integer, parameter :: rid_jeuv_9 = 100 + integer, parameter :: rid_jeuv_10 = 101 + integer, parameter :: rid_jeuv_11 = 102 + integer, parameter :: rid_jeuv_12 = 103 + integer, parameter :: rid_jeuv_13 = 104 + integer, parameter :: rid_jeuv_14 = 105 + integer, parameter :: rid_jeuv_15 = 106 + integer, parameter :: rid_jeuv_16 = 107 + integer, parameter :: rid_jeuv_17 = 108 + integer, parameter :: rid_jeuv_18 = 109 + integer, parameter :: rid_jeuv_19 = 110 + integer, parameter :: rid_jeuv_20 = 111 + integer, parameter :: rid_jeuv_21 = 112 + integer, parameter :: rid_jeuv_22 = 113 + integer, parameter :: rid_jeuv_23 = 114 + integer, parameter :: rid_jeuv_24 = 115 + integer, parameter :: rid_jeuv_25 = 116 + integer, parameter :: rid_jeuv_26 = 117 + integer, parameter :: rid_usr_O_O2 = 118 + integer, parameter :: rid_O_O3 = 119 + integer, parameter :: rid_usr_O_O = 120 + integer, parameter :: rid_O2_1S_O = 121 + integer, parameter :: rid_O2_1S_O2 = 122 + integer, parameter :: rid_O2_1S_N2 = 123 + integer, parameter :: rid_O2_1S_O3 = 124 + integer, parameter :: rid_O2_1S_CO2 = 125 + integer, parameter :: rid_ag2 = 126 + integer, parameter :: rid_O2_1D_O = 127 + integer, parameter :: rid_O2_1D_O2 = 128 + integer, parameter :: rid_O2_1D_N2 = 129 + integer, parameter :: rid_ag1 = 130 + integer, parameter :: rid_O1D_N2 = 131 + integer, parameter :: rid_O1D_O2 = 132 + integer, parameter :: rid_O1D_O2b = 133 + integer, parameter :: rid_O1D_H2O = 134 + integer, parameter :: rid_O1D_N2Oa = 135 + integer, parameter :: rid_O1D_N2Ob = 136 + integer, parameter :: rid_O1D_O3 = 137 + integer, parameter :: rid_O1D_CFC11 = 138 + integer, parameter :: rid_O1D_CFC12 = 139 + integer, parameter :: rid_O1D_CFC113 = 140 + integer, parameter :: rid_O1D_CFC114 = 141 + integer, parameter :: rid_O1D_CFC115 = 142 + integer, parameter :: rid_O1D_HCFC22 = 143 + integer, parameter :: rid_O1D_HCFC141B = 144 + integer, parameter :: rid_O1D_HCFC142B = 145 + integer, parameter :: rid_O1D_CCL4 = 146 + integer, parameter :: rid_O1D_CH3BR = 147 + integer, parameter :: rid_O1D_CF2CLBR = 148 + integer, parameter :: rid_O1D_CF3BR = 149 + integer, parameter :: rid_O1D_H1202 = 150 + integer, parameter :: rid_O1D_H2402 = 151 + integer, parameter :: rid_O1D_CHBR3 = 152 + integer, parameter :: rid_O1D_CH2BR2 = 153 + integer, parameter :: rid_O1D_COF2 = 154 + integer, parameter :: rid_O1D_COFCL = 155 + integer, parameter :: rid_O1D_CH4a = 156 + integer, parameter :: rid_O1D_CH4b = 157 + integer, parameter :: rid_O1D_CH4c = 158 + integer, parameter :: rid_O1D_H2 = 159 + integer, parameter :: rid_O1D_HCL = 160 + integer, parameter :: rid_O1D_HBR = 161 + integer, parameter :: rid_O1D_HCN = 162 + integer, parameter :: rid_H_O2 = 163 + integer, parameter :: rid_H_O3 = 164 + integer, parameter :: rid_H_HO2a = 165 + integer, parameter :: rid_H_HO2 = 166 + integer, parameter :: rid_H_HO2b = 167 + integer, parameter :: rid_OH_O = 168 + integer, parameter :: rid_OH_O3 = 169 + integer, parameter :: rid_OH_HO2 = 170 + integer, parameter :: rid_OH_OH = 171 + integer, parameter :: rid_OH_OH_M = 172 + integer, parameter :: rid_OH_H2 = 173 + integer, parameter :: rid_OH_H2O2 = 174 + integer, parameter :: rid_H2_O = 175 + integer, parameter :: rid_HO2_O = 176 + integer, parameter :: rid_HO2_O3 = 177 + integer, parameter :: rid_usr_HO2_HO2 = 178 + integer, parameter :: rid_H2O2_O = 179 + integer, parameter :: rid_HCN_OH = 180 + integer, parameter :: rid_CH3CN_OH = 181 + integer, parameter :: rid_N2D_O2 = 182 + integer, parameter :: rid_N2D_O = 183 + integer, parameter :: rid_N_OH = 184 + integer, parameter :: rid_N_O2 = 185 + integer, parameter :: rid_N_NO = 186 + integer, parameter :: rid_N_NO2a = 187 + integer, parameter :: rid_N_NO2b = 188 + integer, parameter :: rid_N_NO2c = 189 + integer, parameter :: rid_NO_O_M = 190 + integer, parameter :: rid_NO_HO2 = 191 + integer, parameter :: rid_NO_O3 = 192 + integer, parameter :: rid_NO2_O = 193 + integer, parameter :: rid_NO2_O_M = 194 + integer, parameter :: rid_NO2_O3 = 195 + integer, parameter :: rid_tag_NO2_NO3 = 196 + integer, parameter :: rid_usr_N2O5_M = 197 + integer, parameter :: rid_tag_NO2_OH = 198 + integer, parameter :: rid_usr_HNO3_OH = 199 + integer, parameter :: rid_NO3_NO = 200 + integer, parameter :: rid_NO3_O = 201 + integer, parameter :: rid_NO3_OH = 202 + integer, parameter :: rid_NO3_HO2 = 203 + integer, parameter :: rid_tag_NO2_HO2 = 204 + integer, parameter :: rid_HO2NO2_OH = 205 + integer, parameter :: rid_usr_HO2NO2_M = 206 + integer, parameter :: rid_CL_O3 = 207 + integer, parameter :: rid_CL_H2 = 208 + integer, parameter :: rid_CL_H2O2 = 209 + integer, parameter :: rid_CL_HO2a = 210 + integer, parameter :: rid_CL_HO2b = 211 + integer, parameter :: rid_CL_CH2O = 212 + integer, parameter :: rid_CL_CH4 = 213 + integer, parameter :: rid_CLO_O = 214 + integer, parameter :: rid_CLO_OHa = 215 + integer, parameter :: rid_CLO_OHb = 216 + integer, parameter :: rid_CLO_HO2 = 217 + integer, parameter :: rid_CLO_CH3O2 = 218 + integer, parameter :: rid_CLO_NO = 219 + integer, parameter :: rid_CLO_NO2_M = 220 + integer, parameter :: rid_CLO_CLOa = 221 + integer, parameter :: rid_CLO_CLOb = 222 + integer, parameter :: rid_CLO_CLOc = 223 + integer, parameter :: rid_tag_CLO_CLO_M = 224 + integer, parameter :: rid_usr_CL2O2_M = 225 + integer, parameter :: rid_HCL_OH = 226 + integer, parameter :: rid_HCL_O = 227 + integer, parameter :: rid_HOCL_O = 228 + integer, parameter :: rid_HOCL_CL = 229 + integer, parameter :: rid_HOCL_OH = 230 + integer, parameter :: rid_CLONO2_O = 231 + integer, parameter :: rid_CLONO2_OH = 232 + integer, parameter :: rid_CLONO2_CL = 233 + integer, parameter :: rid_BR_O3 = 234 + integer, parameter :: rid_BR_HO2 = 235 + integer, parameter :: rid_BR_CH2O = 236 + integer, parameter :: rid_BRO_O = 237 + integer, parameter :: rid_BRO_OH = 238 + integer, parameter :: rid_BRO_HO2 = 239 + integer, parameter :: rid_BRO_NO = 240 + integer, parameter :: rid_BRO_NO2_M = 241 + integer, parameter :: rid_BRO_CLOa = 242 + integer, parameter :: rid_BRO_CLOb = 243 + integer, parameter :: rid_BRO_CLOc = 244 + integer, parameter :: rid_BRO_BRO = 245 + integer, parameter :: rid_HBR_OH = 246 + integer, parameter :: rid_HBR_O = 247 + integer, parameter :: rid_HOBR_O = 248 + integer, parameter :: rid_BRONO2_O = 249 + integer, parameter :: rid_F_H2O = 250 + integer, parameter :: rid_F_H2 = 251 + integer, parameter :: rid_F_CH4 = 252 + integer, parameter :: rid_F_HNO3 = 253 + integer, parameter :: rid_CH3CL_CL = 254 + integer, parameter :: rid_CH3CL_OH = 255 + integer, parameter :: rid_CH3CCL3_OH = 256 + integer, parameter :: rid_HCFC22_OH = 257 + integer, parameter :: rid_CH3BR_OH = 258 + integer, parameter :: rid_CH3BR_CL = 259 + integer, parameter :: rid_HCFC141B_OH = 260 + integer, parameter :: rid_HCFC142B_OH = 261 + integer, parameter :: rid_CH2BR2_OH = 262 + integer, parameter :: rid_CHBR3_OH = 263 + integer, parameter :: rid_CH2BR2_CL = 264 + integer, parameter :: rid_CHBR3_CL = 265 + integer, parameter :: rid_CH4_OH = 266 + integer, parameter :: rid_usr_CO_OH_b = 267 + integer, parameter :: rid_CO_OH_M = 268 + integer, parameter :: rid_CH2O_NO3 = 269 + integer, parameter :: rid_CH2O_OH = 270 + integer, parameter :: rid_CH2O_O = 271 + integer, parameter :: rid_CH2O_HO2 = 272 + integer, parameter :: rid_CH3O2_NO = 273 + integer, parameter :: rid_CH3O2_HO2 = 274 + integer, parameter :: rid_CH3O2_CH3O2a = 275 + integer, parameter :: rid_CH3O2_CH3O2b = 276 + integer, parameter :: rid_CH3OH_OH = 277 + integer, parameter :: rid_CH3OOH_OH = 278 + integer, parameter :: rid_HCOOH_OH = 279 + integer, parameter :: rid_HOCH2OO_M = 280 + integer, parameter :: rid_HOCH2OO_NO = 281 + integer, parameter :: rid_HOCH2OO_HO2 = 282 + integer, parameter :: rid_C2H2_CL_M = 283 + integer, parameter :: rid_C2H4_CL_M = 284 + integer, parameter :: rid_C2H6_CL = 285 + integer, parameter :: rid_C2H2_OH_M = 286 + integer, parameter :: rid_C2H6_OH = 287 + integer, parameter :: rid_tag_C2H4_OH = 288 + integer, parameter :: rid_EO2_NO = 289 + integer, parameter :: rid_EO2_HO2 = 290 + integer, parameter :: rid_EO_O2 = 291 + integer, parameter :: rid_EO_M = 292 + integer, parameter :: rid_C2H4_O3 = 293 + integer, parameter :: rid_CH3COOH_OH = 294 + integer, parameter :: rid_C2H5O2_NO = 295 + integer, parameter :: rid_C2H5O2_HO2 = 296 + integer, parameter :: rid_C2H5O2_CH3O2 = 297 + integer, parameter :: rid_C2H5O2_C2H5O2 = 298 + integer, parameter :: rid_C2H5OOH_OH = 299 + integer, parameter :: rid_CH3CHO_OH = 300 + integer, parameter :: rid_CH3CHO_NO3 = 301 + integer, parameter :: rid_CH3CO3_NO = 302 + integer, parameter :: rid_tag_CH3CO3_NO2 = 303 + integer, parameter :: rid_CH3CO3_HO2 = 304 + integer, parameter :: rid_CH3CO3_CH3O2 = 305 + integer, parameter :: rid_CH3CO3_CH3CO3 = 306 + integer, parameter :: rid_CH3COOOH_OH = 307 + integer, parameter :: rid_GLYALD_OH = 308 + integer, parameter :: rid_GLYOXAL_OH = 309 + integer, parameter :: rid_C2H5OH_OH = 310 + integer, parameter :: rid_usr_PAN_M = 311 + integer, parameter :: rid_PAN_OH = 312 + integer, parameter :: rid_tag_C3H6_OH = 313 + integer, parameter :: rid_C3H6_O3 = 314 + integer, parameter :: rid_C3H6_NO3 = 315 + integer, parameter :: rid_C3H7O2_NO = 316 + integer, parameter :: rid_C3H7O2_HO2 = 317 + integer, parameter :: rid_CH3H7O2_CH3O2 = 318 + integer, parameter :: rid_CH3H7OOH_OH = 319 + integer, parameter :: rid_C3H8_OH = 320 + integer, parameter :: rid_PO2_NO = 321 + integer, parameter :: rid_PO2_HO2 = 322 + integer, parameter :: rid_POOH_OH = 323 + integer, parameter :: rid_usr_CH3COCH3_OH = 324 + integer, parameter :: rid_RO2_NO = 325 + integer, parameter :: rid_RO2_HO2 = 326 + integer, parameter :: rid_RO2_CH3O2 = 327 + integer, parameter :: rid_ROOH_OH = 328 + integer, parameter :: rid_HYAC_OH = 329 + integer, parameter :: rid_CH3COCHO_OH = 330 + integer, parameter :: rid_CH3COCHO_NO3 = 331 + integer, parameter :: rid_ONIT_OH = 332 + integer, parameter :: rid_BIGENE_OH = 333 + integer, parameter :: rid_ENEO2_NO = 334 + integer, parameter :: rid_MVK_OH = 335 + integer, parameter :: rid_MVK_O3 = 336 + integer, parameter :: rid_MEK_OH = 337 + integer, parameter :: rid_MEKO2_NO = 338 + integer, parameter :: rid_MEKO2_HO2 = 339 + integer, parameter :: rid_MEKOOH_OH = 340 + integer, parameter :: rid_MACR_OH = 341 + integer, parameter :: rid_MACR_O3 = 342 + integer, parameter :: rid_MACRO2_NOa = 343 + integer, parameter :: rid_MACRO2_NOb = 344 + integer, parameter :: rid_MACRO2_NO3 = 345 + integer, parameter :: rid_MACRO2_HO2 = 346 + integer, parameter :: rid_MACRO2_CH3O2 = 347 + integer, parameter :: rid_MACRO2_CH3CO3 = 348 + integer, parameter :: rid_MACROOH_OH = 349 + integer, parameter :: rid_MCO3_NO = 350 + integer, parameter :: rid_MCO3_NO3 = 351 + integer, parameter :: rid_MCO3_HO2 = 352 + integer, parameter :: rid_MCO3_CH3O2 = 353 + integer, parameter :: rid_MCO3_CH3CO3 = 354 + integer, parameter :: rid_MCO3_MCO3 = 355 + integer, parameter :: rid_usr_MCO3_NO2 = 356 + integer, parameter :: rid_usr_MPAN_M = 357 + integer, parameter :: rid_MPAN_OH_M = 358 + integer, parameter :: rid_ISOP_OH = 359 + integer, parameter :: rid_ISOP_O3 = 360 + integer, parameter :: rid_ISOP_NO3 = 361 + integer, parameter :: rid_ISOPO2_NO = 362 + integer, parameter :: rid_ISOPO2_NO3 = 363 + integer, parameter :: rid_ISOPO2_HO2 = 364 + integer, parameter :: rid_ISOPOOH_OH = 365 + integer, parameter :: rid_ISOPO2_CH3O2 = 366 + integer, parameter :: rid_ISOPO2_CH3CO3 = 367 + integer, parameter :: rid_ISOPNO3_NO = 368 + integer, parameter :: rid_ISOPNO3_NO3 = 369 + integer, parameter :: rid_ISOPNO3_HO2 = 370 + integer, parameter :: rid_BIGALK_OH = 371 + integer, parameter :: rid_ONITR_OH = 372 + integer, parameter :: rid_ONITR_NO3 = 373 + integer, parameter :: rid_HYDRALD_OH = 374 + integer, parameter :: rid_ALKO2_NO = 375 + integer, parameter :: rid_ALKO2_HO2 = 376 + integer, parameter :: rid_ALKOOH_OH = 377 + integer, parameter :: rid_XO2_NO = 378 + integer, parameter :: rid_XO2_NO3 = 379 + integer, parameter :: rid_XO2_HO2 = 380 + integer, parameter :: rid_XO2_CH3O2 = 381 + integer, parameter :: rid_XO2_CH3CO3 = 382 + integer, parameter :: rid_XOOH_OHa = 383 + integer, parameter :: rid_usr_XOOH_OH = 384 + integer, parameter :: rid_TOLUENE_OH = 385 + integer, parameter :: rid_TOLO2_NO = 386 + integer, parameter :: rid_TOLO2_HO2 = 387 + integer, parameter :: rid_TOLO2_OH = 388 + integer, parameter :: rid_CRESOL_OH = 389 + integer, parameter :: rid_XOH_NO2 = 390 + integer, parameter :: rid_BENZENE_OH = 391 + integer, parameter :: rid_BENO2_HO2 = 392 + integer, parameter :: rid_BENO2_NO = 393 + integer, parameter :: rid_XYLENE_OH = 394 + integer, parameter :: rid_XYLO2_HO2 = 395 + integer, parameter :: rid_XYLO2_NO = 396 + integer, parameter :: rid_C10H16_OH = 397 + integer, parameter :: rid_C10H16_O3 = 398 + integer, parameter :: rid_C10H16_NO3 = 399 + integer, parameter :: rid_TERPO2_NO = 400 + integer, parameter :: rid_TERPO2_HO2 = 401 + integer, parameter :: rid_TERPOOH_OH = 402 + integer, parameter :: rid_usr_N2O5_aer = 403 + integer, parameter :: rid_usr_NO3_aer = 404 + integer, parameter :: rid_usr_NO2_aer = 405 + integer, parameter :: rid_CB1_CB2 = 406 + integer, parameter :: rid_OC1_OC2 = 407 + integer, parameter :: rid_usr_HO2_aer = 408 + integer, parameter :: rid_usr_CB1_strat_tau = 409 + integer, parameter :: rid_usr_CB2_strat_tau = 410 + integer, parameter :: rid_usr_OC1_strat_tau = 411 + integer, parameter :: rid_usr_OC2_strat_tau = 412 + integer, parameter :: rid_usr_SO4_strat_tau = 413 + integer, parameter :: rid_usr_SOAM_strat_tau = 414 + integer, parameter :: rid_usr_SOAI_strat_tau = 415 + integer, parameter :: rid_usr_SOAB_strat_tau = 416 + integer, parameter :: rid_usr_SOAT_strat_tau = 417 + integer, parameter :: rid_usr_SOAX_strat_tau = 418 + integer, parameter :: rid_usr_NH4_strat_tau = 419 + integer, parameter :: rid_usr_NH4NO3_strat_tau = 420 + integer, parameter :: rid_usr_SSLT01_strat_tau = 421 + integer, parameter :: rid_usr_SSLT02_strat_tau = 422 + integer, parameter :: rid_usr_SSLT03_strat_tau = 423 + integer, parameter :: rid_usr_SSLT04_strat_tau = 424 + integer, parameter :: rid_usr_DST01_strat_tau = 425 + integer, parameter :: rid_usr_DST02_strat_tau = 426 + integer, parameter :: rid_usr_DST03_strat_tau = 427 + integer, parameter :: rid_usr_DST04_strat_tau = 428 + integer, parameter :: rid_OCS_O = 429 + integer, parameter :: rid_OCS_OH = 430 + integer, parameter :: rid_S_OH = 431 + integer, parameter :: rid_S_O2 = 432 + integer, parameter :: rid_S_O3 = 433 + integer, parameter :: rid_SO_OH = 434 + integer, parameter :: rid_SO_O2 = 435 + integer, parameter :: rid_SO_O3 = 436 + integer, parameter :: rid_SO_NO2 = 437 + integer, parameter :: rid_SO_CLO = 438 + integer, parameter :: rid_SO_BRO = 439 + integer, parameter :: rid_SO_OCLO = 440 + integer, parameter :: rid_usr_SO2_OH = 441 + integer, parameter :: rid_usr_SO3_H2O = 442 + integer, parameter :: rid_DMS_OHa = 443 + integer, parameter :: rid_usr_DMS_OH = 444 + integer, parameter :: rid_DMS_NO3 = 445 + integer, parameter :: rid_het1 = 446 + integer, parameter :: rid_het2 = 447 + integer, parameter :: rid_het3 = 448 + integer, parameter :: rid_het4 = 449 + integer, parameter :: rid_het5 = 450 + integer, parameter :: rid_het6 = 451 + integer, parameter :: rid_het7 = 452 + integer, parameter :: rid_het8 = 453 + integer, parameter :: rid_het9 = 454 + integer, parameter :: rid_het10 = 455 + integer, parameter :: rid_het11 = 456 + integer, parameter :: rid_het12 = 457 + integer, parameter :: rid_het13 = 458 + integer, parameter :: rid_het14 = 459 + integer, parameter :: rid_het15 = 460 + integer, parameter :: rid_het16 = 461 + integer, parameter :: rid_het17 = 462 + integer, parameter :: rid_ion_Op_O2 = 463 + integer, parameter :: rid_ion_Op_N2 = 464 + integer, parameter :: rid_ion_N2p_Oa = 465 + integer, parameter :: rid_ion_N2p_Ob = 466 + integer, parameter :: rid_ion_Op_CO2 = 467 + integer, parameter :: rid_ion_O2p_N = 468 + integer, parameter :: rid_ion_O2p_NO = 469 + integer, parameter :: rid_ion_Np_O2a = 470 + integer, parameter :: rid_ion_Np_O2b = 471 + integer, parameter :: rid_ion_Np_O = 472 + integer, parameter :: rid_ion_N2p_O2 = 473 + integer, parameter :: rid_ion_O2p_N2 = 474 + integer, parameter :: rid_elec1 = 475 + integer, parameter :: rid_elec2 = 476 + integer, parameter :: rid_elec3 = 477 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 new file mode 100644 index 0000000000..d8a72dc9a5 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/m_spc_id.F90 @@ -0,0 +1,177 @@ + module m_spc_id + implicit none + integer, parameter :: id_O3 = 1 + integer, parameter :: id_O = 2 + integer, parameter :: id_O1D = 3 + integer, parameter :: id_O2 = 4 + integer, parameter :: id_O2_1S = 5 + integer, parameter :: id_O2_1D = 6 + integer, parameter :: id_N2O = 7 + integer, parameter :: id_N = 8 + integer, parameter :: id_NO = 9 + integer, parameter :: id_NO2 = 10 + integer, parameter :: id_NO3 = 11 + integer, parameter :: id_HNO3 = 12 + integer, parameter :: id_HO2NO2 = 13 + integer, parameter :: id_N2O5 = 14 + integer, parameter :: id_CH4 = 15 + integer, parameter :: id_CH3O2 = 16 + integer, parameter :: id_CH3OOH = 17 + integer, parameter :: id_CH3OH = 18 + integer, parameter :: id_CH2O = 19 + integer, parameter :: id_CO = 20 + integer, parameter :: id_H2 = 21 + integer, parameter :: id_H = 22 + integer, parameter :: id_OH = 23 + integer, parameter :: id_HO2 = 24 + integer, parameter :: id_H2O2 = 25 + integer, parameter :: id_CLY = 26 + integer, parameter :: id_BRY = 27 + integer, parameter :: id_CL = 28 + integer, parameter :: id_CL2 = 29 + integer, parameter :: id_CLO = 30 + integer, parameter :: id_OCLO = 31 + integer, parameter :: id_CL2O2 = 32 + integer, parameter :: id_HCL = 33 + integer, parameter :: id_HOCL = 34 + integer, parameter :: id_CLONO2 = 35 + integer, parameter :: id_BRCL = 36 + integer, parameter :: id_BR = 37 + integer, parameter :: id_BRO = 38 + integer, parameter :: id_HBR = 39 + integer, parameter :: id_HOBR = 40 + integer, parameter :: id_BRONO2 = 41 + integer, parameter :: id_HCN = 42 + integer, parameter :: id_CH3CN = 43 + integer, parameter :: id_C2H4 = 44 + integer, parameter :: id_C2H6 = 45 + integer, parameter :: id_C2H5O2 = 46 + integer, parameter :: id_C2H5OOH = 47 + integer, parameter :: id_CH3CO3 = 48 + integer, parameter :: id_CH3COOH = 49 + integer, parameter :: id_CH3CHO = 50 + integer, parameter :: id_C2H5OH = 51 + integer, parameter :: id_GLYALD = 52 + integer, parameter :: id_GLYOXAL = 53 + integer, parameter :: id_CH3COOOH = 54 + integer, parameter :: id_EO2 = 55 + integer, parameter :: id_EO = 56 + integer, parameter :: id_EOOH = 57 + integer, parameter :: id_PAN = 58 + integer, parameter :: id_C3H6 = 59 + integer, parameter :: id_C3H8 = 60 + integer, parameter :: id_C3H7O2 = 61 + integer, parameter :: id_C3H7OOH = 62 + integer, parameter :: id_CH3COCH3 = 63 + integer, parameter :: id_PO2 = 64 + integer, parameter :: id_POOH = 65 + integer, parameter :: id_HYAC = 66 + integer, parameter :: id_RO2 = 67 + integer, parameter :: id_CH3COCHO = 68 + integer, parameter :: id_ROOH = 69 + integer, parameter :: id_BIGENE = 70 + integer, parameter :: id_BIGALK = 71 + integer, parameter :: id_MEK = 72 + integer, parameter :: id_ENEO2 = 73 + integer, parameter :: id_MEKO2 = 74 + integer, parameter :: id_MEKOOH = 75 + integer, parameter :: id_MCO3 = 76 + integer, parameter :: id_MVK = 77 + integer, parameter :: id_MACR = 78 + integer, parameter :: id_MACRO2 = 79 + integer, parameter :: id_MACROOH = 80 + integer, parameter :: id_MPAN = 81 + integer, parameter :: id_ONIT = 82 + integer, parameter :: id_ISOP = 83 + integer, parameter :: id_ALKO2 = 84 + integer, parameter :: id_ALKOOH = 85 + integer, parameter :: id_BIGALD = 86 + integer, parameter :: id_HYDRALD = 87 + integer, parameter :: id_ISOPO2 = 88 + integer, parameter :: id_ISOPNO3 = 89 + integer, parameter :: id_ONITR = 90 + integer, parameter :: id_XO2 = 91 + integer, parameter :: id_XOOH = 92 + integer, parameter :: id_ISOPOOH = 93 + integer, parameter :: id_TOLUENE = 94 + integer, parameter :: id_CRESOL = 95 + integer, parameter :: id_TOLO2 = 96 + integer, parameter :: id_TOLOOH = 97 + integer, parameter :: id_XOH = 98 + integer, parameter :: id_BENZENE = 99 + integer, parameter :: id_BENO2 = 100 + integer, parameter :: id_BENOOH = 101 + integer, parameter :: id_XYLENE = 102 + integer, parameter :: id_XYLO2 = 103 + integer, parameter :: id_XYLOOH = 104 + integer, parameter :: id_C10H16 = 105 + integer, parameter :: id_TERPO2 = 106 + integer, parameter :: id_TERPOOH = 107 + integer, parameter :: id_CH3CL = 108 + integer, parameter :: id_CH3BR = 109 + integer, parameter :: id_CFC11 = 110 + integer, parameter :: id_CFC12 = 111 + integer, parameter :: id_CFC113 = 112 + integer, parameter :: id_HCFC22 = 113 + integer, parameter :: id_CCL4 = 114 + integer, parameter :: id_CH3CCL3 = 115 + integer, parameter :: id_CF3BR = 116 + integer, parameter :: id_CF2CLBR = 117 + integer, parameter :: id_HCFC141B = 118 + integer, parameter :: id_HCFC142B = 119 + integer, parameter :: id_CFC114 = 120 + integer, parameter :: id_CFC115 = 121 + integer, parameter :: id_H1202 = 122 + integer, parameter :: id_H2402 = 123 + integer, parameter :: id_CHBR3 = 124 + integer, parameter :: id_CH2BR2 = 125 + integer, parameter :: id_CO2 = 126 + integer, parameter :: id_N2p = 127 + integer, parameter :: id_O2p = 128 + integer, parameter :: id_Np = 129 + integer, parameter :: id_Op = 130 + integer, parameter :: id_NOp = 131 + integer, parameter :: id_e = 132 + integer, parameter :: id_N2D = 133 + integer, parameter :: id_H2O = 134 + integer, parameter :: id_C2H2 = 135 + integer, parameter :: id_HCOOH = 136 + integer, parameter :: id_HOCH2OO = 137 + integer, parameter :: id_COF2 = 138 + integer, parameter :: id_COFCL = 139 + integer, parameter :: id_HF = 140 + integer, parameter :: id_F = 141 + integer, parameter :: id_CB1 = 142 + integer, parameter :: id_CB2 = 143 + integer, parameter :: id_OC1 = 144 + integer, parameter :: id_OC2 = 145 + integer, parameter :: id_SOAM = 146 + integer, parameter :: id_SOAI = 147 + integer, parameter :: id_SOAT = 148 + integer, parameter :: id_SOAB = 149 + integer, parameter :: id_SOAX = 150 + integer, parameter :: id_SOGM = 151 + integer, parameter :: id_SOGI = 152 + integer, parameter :: id_SOGT = 153 + integer, parameter :: id_SOGB = 154 + integer, parameter :: id_SOGX = 155 + integer, parameter :: id_SO2 = 156 + integer, parameter :: id_DMS = 157 + integer, parameter :: id_SO4 = 158 + integer, parameter :: id_NH3 = 159 + integer, parameter :: id_NH4 = 160 + integer, parameter :: id_NH4NO3 = 161 + integer, parameter :: id_OCS = 162 + integer, parameter :: id_S = 163 + integer, parameter :: id_SO = 164 + integer, parameter :: id_SO3 = 165 + integer, parameter :: id_H2SO4 = 166 + integer, parameter :: id_SSLT01 = 167 + integer, parameter :: id_SSLT02 = 168 + integer, parameter :: id_SSLT03 = 169 + integer, parameter :: id_SSLT04 = 170 + integer, parameter :: id_DST01 = 171 + integer, parameter :: id_DST02 = 172 + integer, parameter :: id_DST03 = 173 + integer, parameter :: id_DST04 = 174 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 new file mode 100644 index 0000000000..aed60ed439 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_adjrxt.F90 @@ -0,0 +1,360 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:,118) = rate(:,:,118) * inv(:,:, 1) + rate(:,:,120) = rate(:,:,120) * inv(:,:, 1) + rate(:,:,123) = rate(:,:,123) * inv(:,:, 2) + rate(:,:,129) = rate(:,:,129) * inv(:,:, 2) + rate(:,:,131) = rate(:,:,131) * inv(:,:, 2) + rate(:,:,163) = rate(:,:,163) * inv(:,:, 1) + rate(:,:,172) = rate(:,:,172) * inv(:,:, 1) + rate(:,:,180) = rate(:,:,180) * inv(:,:, 1) + rate(:,:,190) = rate(:,:,190) * inv(:,:, 1) + rate(:,:,194) = rate(:,:,194) * inv(:,:, 1) + rate(:,:,196) = rate(:,:,196) * inv(:,:, 1) + rate(:,:,197) = rate(:,:,197) * inv(:,:, 1) + rate(:,:,198) = rate(:,:,198) * inv(:,:, 1) + rate(:,:,204) = rate(:,:,204) * inv(:,:, 1) + rate(:,:,206) = rate(:,:,206) * inv(:,:, 1) + rate(:,:,220) = rate(:,:,220) * inv(:,:, 1) + rate(:,:,224) = rate(:,:,224) * inv(:,:, 1) + rate(:,:,225) = rate(:,:,225) * inv(:,:, 1) + rate(:,:,241) = rate(:,:,241) * inv(:,:, 1) + rate(:,:,268) = rate(:,:,268) * inv(:,:, 1) + rate(:,:,283) = rate(:,:,283) * inv(:,:, 1) + rate(:,:,284) = rate(:,:,284) * inv(:,:, 1) + rate(:,:,286) = rate(:,:,286) * inv(:,:, 1) + rate(:,:,288) = rate(:,:,288) * inv(:,:, 1) + rate(:,:,303) = rate(:,:,303) * inv(:,:, 1) + rate(:,:,311) = rate(:,:,311) * inv(:,:, 1) + rate(:,:,313) = rate(:,:,313) * inv(:,:, 1) + rate(:,:,356) = rate(:,:,356) * inv(:,:, 1) + rate(:,:,357) = rate(:,:,357) * inv(:,:, 1) + rate(:,:,358) = rate(:,:,358) * inv(:,:, 1) + rate(:,:,464) = rate(:,:,464) * inv(:,:, 2) + rate(:,:,474) = rate(:,:,474) * inv(:,:, 2) + rate(:,:,118) = rate(:,:,118) * m(:,:) + rate(:,:,119) = rate(:,:,119) * m(:,:) + rate(:,:,120) = rate(:,:,120) * m(:,:) + rate(:,:,121) = rate(:,:,121) * m(:,:) + rate(:,:,122) = rate(:,:,122) * m(:,:) + rate(:,:,124) = rate(:,:,124) * m(:,:) + rate(:,:,125) = rate(:,:,125) * m(:,:) + rate(:,:,127) = rate(:,:,127) * m(:,:) + rate(:,:,128) = rate(:,:,128) * m(:,:) + rate(:,:,132) = rate(:,:,132) * m(:,:) + rate(:,:,133) = rate(:,:,133) * m(:,:) + rate(:,:,134) = rate(:,:,134) * m(:,:) + rate(:,:,135) = rate(:,:,135) * m(:,:) + rate(:,:,136) = rate(:,:,136) * m(:,:) + rate(:,:,137) = rate(:,:,137) * m(:,:) + rate(:,:,138) = rate(:,:,138) * m(:,:) + rate(:,:,139) = rate(:,:,139) * m(:,:) + rate(:,:,140) = rate(:,:,140) * m(:,:) + rate(:,:,141) = rate(:,:,141) * m(:,:) + rate(:,:,142) = rate(:,:,142) * m(:,:) + rate(:,:,143) = rate(:,:,143) * m(:,:) + rate(:,:,144) = rate(:,:,144) * m(:,:) + rate(:,:,145) = rate(:,:,145) * m(:,:) + rate(:,:,146) = rate(:,:,146) * m(:,:) + rate(:,:,147) = rate(:,:,147) * m(:,:) + rate(:,:,148) = rate(:,:,148) * m(:,:) + rate(:,:,149) = rate(:,:,149) * m(:,:) + rate(:,:,150) = rate(:,:,150) * m(:,:) + rate(:,:,151) = rate(:,:,151) * m(:,:) + rate(:,:,152) = rate(:,:,152) * m(:,:) + rate(:,:,153) = rate(:,:,153) * m(:,:) + rate(:,:,154) = rate(:,:,154) * m(:,:) + rate(:,:,155) = rate(:,:,155) * m(:,:) + rate(:,:,156) = rate(:,:,156) * m(:,:) + rate(:,:,157) = rate(:,:,157) * m(:,:) + rate(:,:,158) = rate(:,:,158) * m(:,:) + rate(:,:,159) = rate(:,:,159) * m(:,:) + rate(:,:,160) = rate(:,:,160) * m(:,:) + rate(:,:,161) = rate(:,:,161) * m(:,:) + rate(:,:,162) = rate(:,:,162) * m(:,:) + rate(:,:,163) = rate(:,:,163) * m(:,:) + rate(:,:,164) = rate(:,:,164) * m(:,:) + rate(:,:,165) = rate(:,:,165) * m(:,:) + rate(:,:,166) = rate(:,:,166) * m(:,:) + rate(:,:,167) = rate(:,:,167) * m(:,:) + rate(:,:,168) = rate(:,:,168) * m(:,:) + rate(:,:,169) = rate(:,:,169) * m(:,:) + rate(:,:,170) = rate(:,:,170) * m(:,:) + rate(:,:,171) = rate(:,:,171) * m(:,:) + rate(:,:,172) = rate(:,:,172) * m(:,:) + rate(:,:,173) = rate(:,:,173) * m(:,:) + rate(:,:,174) = rate(:,:,174) * m(:,:) + rate(:,:,175) = rate(:,:,175) * m(:,:) + rate(:,:,176) = rate(:,:,176) * m(:,:) + rate(:,:,177) = rate(:,:,177) * m(:,:) + rate(:,:,178) = rate(:,:,178) * m(:,:) + rate(:,:,179) = rate(:,:,179) * m(:,:) + rate(:,:,180) = rate(:,:,180) * m(:,:) + rate(:,:,181) = rate(:,:,181) * m(:,:) + rate(:,:,182) = rate(:,:,182) * m(:,:) + rate(:,:,183) = rate(:,:,183) * m(:,:) + rate(:,:,184) = rate(:,:,184) * m(:,:) + rate(:,:,185) = rate(:,:,185) * m(:,:) + rate(:,:,186) = rate(:,:,186) * m(:,:) + rate(:,:,187) = rate(:,:,187) * m(:,:) + rate(:,:,188) = rate(:,:,188) * m(:,:) + rate(:,:,189) = rate(:,:,189) * m(:,:) + rate(:,:,190) = rate(:,:,190) * m(:,:) + rate(:,:,191) = rate(:,:,191) * m(:,:) + rate(:,:,192) = rate(:,:,192) * m(:,:) + rate(:,:,193) = rate(:,:,193) * m(:,:) + rate(:,:,194) = rate(:,:,194) * m(:,:) + rate(:,:,195) = rate(:,:,195) * m(:,:) + rate(:,:,196) = rate(:,:,196) * m(:,:) + rate(:,:,198) = rate(:,:,198) * m(:,:) + rate(:,:,199) = rate(:,:,199) * m(:,:) + rate(:,:,200) = rate(:,:,200) * m(:,:) + rate(:,:,201) = rate(:,:,201) * m(:,:) + rate(:,:,202) = rate(:,:,202) * m(:,:) + rate(:,:,203) = rate(:,:,203) * m(:,:) + rate(:,:,204) = rate(:,:,204) * m(:,:) + rate(:,:,205) = rate(:,:,205) * m(:,:) + rate(:,:,207) = rate(:,:,207) * m(:,:) + rate(:,:,208) = rate(:,:,208) * m(:,:) + rate(:,:,209) = rate(:,:,209) * m(:,:) + rate(:,:,210) = rate(:,:,210) * m(:,:) + rate(:,:,211) = rate(:,:,211) * m(:,:) + rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:,213) = rate(:,:,213) * m(:,:) + rate(:,:,214) = rate(:,:,214) * m(:,:) + rate(:,:,215) = rate(:,:,215) * m(:,:) + rate(:,:,216) = rate(:,:,216) * m(:,:) + rate(:,:,217) = rate(:,:,217) * m(:,:) + rate(:,:,218) = rate(:,:,218) * m(:,:) + rate(:,:,219) = rate(:,:,219) * m(:,:) + rate(:,:,220) = rate(:,:,220) * m(:,:) + rate(:,:,221) = rate(:,:,221) * m(:,:) + rate(:,:,222) = rate(:,:,222) * m(:,:) + rate(:,:,223) = rate(:,:,223) * m(:,:) + rate(:,:,224) = rate(:,:,224) * m(:,:) + rate(:,:,226) = rate(:,:,226) * m(:,:) + rate(:,:,227) = rate(:,:,227) * m(:,:) + rate(:,:,228) = rate(:,:,228) * m(:,:) + rate(:,:,229) = rate(:,:,229) * m(:,:) + rate(:,:,230) = rate(:,:,230) * m(:,:) + rate(:,:,231) = rate(:,:,231) * m(:,:) + rate(:,:,232) = rate(:,:,232) * m(:,:) + rate(:,:,233) = rate(:,:,233) * m(:,:) + rate(:,:,234) = rate(:,:,234) * m(:,:) + rate(:,:,235) = rate(:,:,235) * m(:,:) + rate(:,:,236) = rate(:,:,236) * m(:,:) + rate(:,:,237) = rate(:,:,237) * m(:,:) + rate(:,:,238) = rate(:,:,238) * m(:,:) + rate(:,:,239) = rate(:,:,239) * m(:,:) + rate(:,:,240) = rate(:,:,240) * m(:,:) + rate(:,:,241) = rate(:,:,241) * m(:,:) + rate(:,:,242) = rate(:,:,242) * m(:,:) + rate(:,:,243) = rate(:,:,243) * m(:,:) + rate(:,:,244) = rate(:,:,244) * m(:,:) + rate(:,:,245) = rate(:,:,245) * m(:,:) + rate(:,:,246) = rate(:,:,246) * m(:,:) + rate(:,:,247) = rate(:,:,247) * m(:,:) + rate(:,:,248) = rate(:,:,248) * m(:,:) + rate(:,:,249) = rate(:,:,249) * m(:,:) + rate(:,:,250) = rate(:,:,250) * m(:,:) + rate(:,:,251) = rate(:,:,251) * m(:,:) + rate(:,:,252) = rate(:,:,252) * m(:,:) + rate(:,:,253) = rate(:,:,253) * m(:,:) + rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:,255) = rate(:,:,255) * m(:,:) + rate(:,:,256) = rate(:,:,256) * m(:,:) + rate(:,:,257) = rate(:,:,257) * m(:,:) + rate(:,:,258) = rate(:,:,258) * m(:,:) + rate(:,:,259) = rate(:,:,259) * m(:,:) + rate(:,:,260) = rate(:,:,260) * m(:,:) + rate(:,:,261) = rate(:,:,261) * m(:,:) + rate(:,:,262) = rate(:,:,262) * m(:,:) + rate(:,:,263) = rate(:,:,263) * m(:,:) + rate(:,:,264) = rate(:,:,264) * m(:,:) + rate(:,:,265) = rate(:,:,265) * m(:,:) + rate(:,:,266) = rate(:,:,266) * m(:,:) + rate(:,:,267) = rate(:,:,267) * m(:,:) + rate(:,:,268) = rate(:,:,268) * m(:,:) + rate(:,:,269) = rate(:,:,269) * m(:,:) + rate(:,:,270) = rate(:,:,270) * m(:,:) + rate(:,:,271) = rate(:,:,271) * m(:,:) + rate(:,:,272) = rate(:,:,272) * m(:,:) + rate(:,:,273) = rate(:,:,273) * m(:,:) + rate(:,:,274) = rate(:,:,274) * m(:,:) + rate(:,:,275) = rate(:,:,275) * m(:,:) + rate(:,:,276) = rate(:,:,276) * m(:,:) + rate(:,:,277) = rate(:,:,277) * m(:,:) + rate(:,:,278) = rate(:,:,278) * m(:,:) + rate(:,:,279) = rate(:,:,279) * m(:,:) + rate(:,:,281) = rate(:,:,281) * m(:,:) + rate(:,:,282) = rate(:,:,282) * m(:,:) + rate(:,:,283) = rate(:,:,283) * m(:,:) + rate(:,:,284) = rate(:,:,284) * m(:,:) + rate(:,:,285) = rate(:,:,285) * m(:,:) + rate(:,:,286) = rate(:,:,286) * m(:,:) + rate(:,:,287) = rate(:,:,287) * m(:,:) + rate(:,:,288) = rate(:,:,288) * m(:,:) + rate(:,:,289) = rate(:,:,289) * m(:,:) + rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:,291) = rate(:,:,291) * m(:,:) + rate(:,:,293) = rate(:,:,293) * m(:,:) + rate(:,:,294) = rate(:,:,294) * m(:,:) + rate(:,:,295) = rate(:,:,295) * m(:,:) + rate(:,:,296) = rate(:,:,296) * m(:,:) + rate(:,:,297) = rate(:,:,297) * m(:,:) + rate(:,:,298) = rate(:,:,298) * m(:,:) + rate(:,:,299) = rate(:,:,299) * m(:,:) + rate(:,:,300) = rate(:,:,300) * m(:,:) + rate(:,:,301) = rate(:,:,301) * m(:,:) + rate(:,:,302) = rate(:,:,302) * m(:,:) + rate(:,:,303) = rate(:,:,303) * m(:,:) + rate(:,:,304) = rate(:,:,304) * m(:,:) + rate(:,:,305) = rate(:,:,305) * m(:,:) + rate(:,:,306) = rate(:,:,306) * m(:,:) + rate(:,:,307) = rate(:,:,307) * m(:,:) + rate(:,:,308) = rate(:,:,308) * m(:,:) + rate(:,:,309) = rate(:,:,309) * m(:,:) + rate(:,:,310) = rate(:,:,310) * m(:,:) + rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:,313) = rate(:,:,313) * m(:,:) + rate(:,:,314) = rate(:,:,314) * m(:,:) + rate(:,:,315) = rate(:,:,315) * m(:,:) + rate(:,:,316) = rate(:,:,316) * m(:,:) + rate(:,:,317) = rate(:,:,317) * m(:,:) + rate(:,:,318) = rate(:,:,318) * m(:,:) + rate(:,:,319) = rate(:,:,319) * m(:,:) + rate(:,:,320) = rate(:,:,320) * m(:,:) + rate(:,:,321) = rate(:,:,321) * m(:,:) + rate(:,:,322) = rate(:,:,322) * m(:,:) + rate(:,:,323) = rate(:,:,323) * m(:,:) + rate(:,:,324) = rate(:,:,324) * m(:,:) + rate(:,:,325) = rate(:,:,325) * m(:,:) + rate(:,:,326) = rate(:,:,326) * m(:,:) + rate(:,:,327) = rate(:,:,327) * m(:,:) + rate(:,:,328) = rate(:,:,328) * m(:,:) + rate(:,:,329) = rate(:,:,329) * m(:,:) + rate(:,:,330) = rate(:,:,330) * m(:,:) + rate(:,:,331) = rate(:,:,331) * m(:,:) + rate(:,:,332) = rate(:,:,332) * m(:,:) + rate(:,:,333) = rate(:,:,333) * m(:,:) + rate(:,:,334) = rate(:,:,334) * m(:,:) + rate(:,:,335) = rate(:,:,335) * m(:,:) + rate(:,:,336) = rate(:,:,336) * m(:,:) + rate(:,:,337) = rate(:,:,337) * m(:,:) + rate(:,:,338) = rate(:,:,338) * m(:,:) + rate(:,:,339) = rate(:,:,339) * m(:,:) + rate(:,:,340) = rate(:,:,340) * m(:,:) + rate(:,:,341) = rate(:,:,341) * m(:,:) + rate(:,:,342) = rate(:,:,342) * m(:,:) + rate(:,:,343) = rate(:,:,343) * m(:,:) + rate(:,:,344) = rate(:,:,344) * m(:,:) + rate(:,:,345) = rate(:,:,345) * m(:,:) + rate(:,:,346) = rate(:,:,346) * m(:,:) + rate(:,:,347) = rate(:,:,347) * m(:,:) + rate(:,:,348) = rate(:,:,348) * m(:,:) + rate(:,:,349) = rate(:,:,349) * m(:,:) + rate(:,:,350) = rate(:,:,350) * m(:,:) + rate(:,:,351) = rate(:,:,351) * m(:,:) + rate(:,:,352) = rate(:,:,352) * m(:,:) + rate(:,:,353) = rate(:,:,353) * m(:,:) + rate(:,:,354) = rate(:,:,354) * m(:,:) + rate(:,:,355) = rate(:,:,355) * m(:,:) + rate(:,:,356) = rate(:,:,356) * m(:,:) + rate(:,:,358) = rate(:,:,358) * m(:,:) + rate(:,:,359) = rate(:,:,359) * m(:,:) + rate(:,:,360) = rate(:,:,360) * m(:,:) + rate(:,:,361) = rate(:,:,361) * m(:,:) + rate(:,:,362) = rate(:,:,362) * m(:,:) + rate(:,:,363) = rate(:,:,363) * m(:,:) + rate(:,:,364) = rate(:,:,364) * m(:,:) + rate(:,:,365) = rate(:,:,365) * m(:,:) + rate(:,:,366) = rate(:,:,366) * m(:,:) + rate(:,:,367) = rate(:,:,367) * m(:,:) + rate(:,:,368) = rate(:,:,368) * m(:,:) + rate(:,:,369) = rate(:,:,369) * m(:,:) + rate(:,:,370) = rate(:,:,370) * m(:,:) + rate(:,:,371) = rate(:,:,371) * m(:,:) + rate(:,:,372) = rate(:,:,372) * m(:,:) + rate(:,:,373) = rate(:,:,373) * m(:,:) + rate(:,:,374) = rate(:,:,374) * m(:,:) + rate(:,:,375) = rate(:,:,375) * m(:,:) + rate(:,:,376) = rate(:,:,376) * m(:,:) + rate(:,:,377) = rate(:,:,377) * m(:,:) + rate(:,:,378) = rate(:,:,378) * m(:,:) + rate(:,:,379) = rate(:,:,379) * m(:,:) + rate(:,:,380) = rate(:,:,380) * m(:,:) + rate(:,:,381) = rate(:,:,381) * m(:,:) + rate(:,:,382) = rate(:,:,382) * m(:,:) + rate(:,:,383) = rate(:,:,383) * m(:,:) + rate(:,:,384) = rate(:,:,384) * m(:,:) + rate(:,:,385) = rate(:,:,385) * m(:,:) + rate(:,:,386) = rate(:,:,386) * m(:,:) + rate(:,:,387) = rate(:,:,387) * m(:,:) + rate(:,:,388) = rate(:,:,388) * m(:,:) + rate(:,:,389) = rate(:,:,389) * m(:,:) + rate(:,:,390) = rate(:,:,390) * m(:,:) + rate(:,:,391) = rate(:,:,391) * m(:,:) + rate(:,:,392) = rate(:,:,392) * m(:,:) + rate(:,:,393) = rate(:,:,393) * m(:,:) + rate(:,:,394) = rate(:,:,394) * m(:,:) + rate(:,:,395) = rate(:,:,395) * m(:,:) + rate(:,:,396) = rate(:,:,396) * m(:,:) + rate(:,:,397) = rate(:,:,397) * m(:,:) + rate(:,:,398) = rate(:,:,398) * m(:,:) + rate(:,:,399) = rate(:,:,399) * m(:,:) + rate(:,:,400) = rate(:,:,400) * m(:,:) + rate(:,:,401) = rate(:,:,401) * m(:,:) + rate(:,:,402) = rate(:,:,402) * m(:,:) + rate(:,:,429) = rate(:,:,429) * m(:,:) + rate(:,:,430) = rate(:,:,430) * m(:,:) + rate(:,:,431) = rate(:,:,431) * m(:,:) + rate(:,:,432) = rate(:,:,432) * m(:,:) + rate(:,:,433) = rate(:,:,433) * m(:,:) + rate(:,:,434) = rate(:,:,434) * m(:,:) + rate(:,:,435) = rate(:,:,435) * m(:,:) + rate(:,:,436) = rate(:,:,436) * m(:,:) + rate(:,:,437) = rate(:,:,437) * m(:,:) + rate(:,:,438) = rate(:,:,438) * m(:,:) + rate(:,:,439) = rate(:,:,439) * m(:,:) + rate(:,:,440) = rate(:,:,440) * m(:,:) + rate(:,:,441) = rate(:,:,441) * m(:,:) + rate(:,:,442) = rate(:,:,442) * m(:,:) + rate(:,:,443) = rate(:,:,443) * m(:,:) + rate(:,:,444) = rate(:,:,444) * m(:,:) + rate(:,:,445) = rate(:,:,445) * m(:,:) + rate(:,:,449) = rate(:,:,449) * m(:,:) + rate(:,:,450) = rate(:,:,450) * m(:,:) + rate(:,:,451) = rate(:,:,451) * m(:,:) + rate(:,:,454) = rate(:,:,454) * m(:,:) + rate(:,:,455) = rate(:,:,455) * m(:,:) + rate(:,:,460) = rate(:,:,460) * m(:,:) + rate(:,:,461) = rate(:,:,461) * m(:,:) + rate(:,:,462) = rate(:,:,462) * m(:,:) + rate(:,:,463) = rate(:,:,463) * m(:,:) + rate(:,:,465) = rate(:,:,465) * m(:,:) + rate(:,:,466) = rate(:,:,466) * m(:,:) + rate(:,:,467) = rate(:,:,467) * m(:,:) + rate(:,:,468) = rate(:,:,468) * m(:,:) + rate(:,:,469) = rate(:,:,469) * m(:,:) + rate(:,:,470) = rate(:,:,470) * m(:,:) + rate(:,:,471) = rate(:,:,471) * m(:,:) + rate(:,:,472) = rate(:,:,472) * m(:,:) + rate(:,:,473) = rate(:,:,473) * m(:,:) + rate(:,:,475) = rate(:,:,475) * m(:,:) + rate(:,:,476) = rate(:,:,476) * m(:,:) + rate(:,:,477) = rate(:,:,477) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol,nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 new file mode 100644 index 0000000000..42506f295f --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_indprd.F90 @@ -0,0 +1,232 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) =.080_r8*rxt(:,:,314)*y(:,:,59)*y(:,:,1) + prod(:,:,2) =rxt(:,:,187)*y(:,:,10)*y(:,:,8) + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = (rxt(:,:,267)*y(:,:,20) +rxt(:,:,268)*y(:,:,20) + & + rxt(:,:,279)*y(:,:,136) +rxt(:,:,294)*y(:,:,49) + & + .500_r8*rxt(:,:,307)*y(:,:,54) +.800_r8*rxt(:,:,308)*y(:,:,52) + & + rxt(:,:,309)*y(:,:,53) +.500_r8*rxt(:,:,358)*y(:,:,81))*y(:,:,23) & + + (rxt(:,:,302)*y(:,:,9) +.900_r8*rxt(:,:,305)*y(:,:,16) + & + 2.000_r8*rxt(:,:,306)*y(:,:,48) +2.000_r8*rxt(:,:,354)*y(:,:,76) + & + rxt(:,:,382)*y(:,:,91))*y(:,:,48) + (rxt(:,:,353)*y(:,:,16) + & + 2.000_r8*rxt(:,:,355)*y(:,:,76))*y(:,:,76) +rxt(:,:,63)*y(:,:,54) & + +.400_r8*rxt(:,:,64)*y(:,:,58) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,140) = 0._r8 + prod(:,:,139) = (rxt(:,:,58) +rxt(:,:,117))*y(:,:,126) +.180_r8*rxt(:,:,60) & + *y(:,:,15) + prod(:,:,141) =rxt(:,:,5)*y(:,:,7) + prod(:,:,136) = 0._r8 + prod(:,:,41) = 0._r8 + prod(:,:,40) = 0._r8 + prod(:,:,124) =1.440_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,119) = (rxt(:,:,58) +rxt(:,:,117))*y(:,:,126) +.380_r8*rxt(:,:,60) & + *y(:,:,15) + extfrc(:,:,3) + prod(:,:,108) = (rxt(:,:,101) +.800_r8*rxt(:,:,104) +rxt(:,:,113) + & + .800_r8*rxt(:,:,116)) + extfrc(:,:,12) + prod(:,:,138) = + extfrc(:,:,1) + prod(:,:,142) = + extfrc(:,:,2) + prod(:,:,150) =.330_r8*rxt(:,:,60)*y(:,:,15) + extfrc(:,:,14) + prod(:,:,147) = 0._r8 + prod(:,:,137) = 0._r8 + prod(:,:,74) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,135) =rxt(:,:,59)*y(:,:,15) +rxt(:,:,37)*y(:,:,108) +rxt(:,:,48) & + *y(:,:,109) + prod(:,:,69) = 0._r8 + prod(:,:,46) = 0._r8 + prod(:,:,34) = 0._r8 + prod(:,:,144) =.180_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,145) = (rxt(:,:,59) +.330_r8*rxt(:,:,60))*y(:,:,15) + prod(:,:,146) = 0._r8 + prod(:,:,90) = 0._r8 + prod(:,:,148) =.050_r8*rxt(:,:,60)*y(:,:,15) + prod(:,:,149) =rxt(:,:,37)*y(:,:,108) +2.000_r8*rxt(:,:,40)*y(:,:,110) & + +2.000_r8*rxt(:,:,41)*y(:,:,111) +2.000_r8*rxt(:,:,42)*y(:,:,112) & + +rxt(:,:,45)*y(:,:,113) +4.000_r8*rxt(:,:,38)*y(:,:,114) & + +3.000_r8*rxt(:,:,39)*y(:,:,115) +rxt(:,:,50)*y(:,:,117) & + +rxt(:,:,46)*y(:,:,118) +rxt(:,:,47)*y(:,:,119) & + +2.000_r8*rxt(:,:,43)*y(:,:,120) +rxt(:,:,44)*y(:,:,121) + prod(:,:,43) = 0._r8 + prod(:,:,151) = 0._r8 + prod(:,:,56) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,133) = 0._r8 + prod(:,:,110) = 0._r8 + prod(:,:,117) = 0._r8 + prod(:,:,48) = 0._r8 + prod(:,:,134) =rxt(:,:,48)*y(:,:,109) +rxt(:,:,49)*y(:,:,116) +rxt(:,:,50) & + *y(:,:,117) +2.000_r8*rxt(:,:,53)*y(:,:,122) +2.000_r8*rxt(:,:,54) & + *y(:,:,123) +3.000_r8*rxt(:,:,51)*y(:,:,124) +2.000_r8*rxt(:,:,52) & + *y(:,:,125) + prod(:,:,143) = 0._r8 + prod(:,:,107) = 0._r8 + prod(:,:,100) = 0._r8 + prod(:,:,86) = 0._r8 + prod(:,:,94) = (rxt(:,:,97) +rxt(:,:,109)) + extfrc(:,:,10) + prod(:,:,102) = + extfrc(:,:,8) + prod(:,:,76) = (rxt(:,:,101) +rxt(:,:,102) +rxt(:,:,113) +rxt(:,:,114)) & + + extfrc(:,:,9) + prod(:,:,91) = + extfrc(:,:,7) + prod(:,:,103) = 0._r8 + prod(:,:,77) = (rxt(:,:,102) +1.200_r8*rxt(:,:,104) +rxt(:,:,114) + & + 1.200_r8*rxt(:,:,116)) + extfrc(:,:,11) + prod(:,:,104) = (rxt(:,:,97) +rxt(:,:,101) +rxt(:,:,102) +rxt(:,:,109) + & + rxt(:,:,113) +rxt(:,:,114)) + extfrc(:,:,13) + prod(:,:,118) = 0._r8 + prod(:,:,113) = 0._r8 + prod(:,:,106) = 0._r8 + prod(:,:,120) = 0._r8 + prod(:,:,89) = 0._r8 + prod(:,:,87) = 0._r8 + prod(:,:,131) = 0._r8 + prod(:,:,78) = 0._r8 + prod(:,:,75) = 0._r8 + prod(:,:,65) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,82) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,81) = 0._r8 + prod(:,:,31) = 0._r8 + prod(:,:,57) = 0._r8 + prod(:,:,95) = 0._r8 + prod(:,:,92) = 0._r8 + prod(:,:,70) = 0._r8 + prod(:,:,93) = 0._r8 + prod(:,:,58) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,79) = 0._r8 + prod(:,:,63) = 0._r8 + prod(:,:,44) = 0._r8 + prod(:,:,116) = 0._r8 + prod(:,:,72) = 0._r8 + prod(:,:,80) = 0._r8 + prod(:,:,98) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,64) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,73) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,127) = 0._r8 + prod(:,:,129) = 0._r8 + prod(:,:,123) = 0._r8 + prod(:,:,128) = 0._r8 + prod(:,:,59) = 0._r8 + prod(:,:,130) = 0._r8 + prod(:,:,109) = 0._r8 + prod(:,:,60) = 0._r8 + prod(:,:,88) = 0._r8 + prod(:,:,35) = 0._r8 + prod(:,:,111) = 0._r8 + prod(:,:,66) = 0._r8 + prod(:,:,96) = 0._r8 + prod(:,:,67) = 0._r8 + prod(:,:,84) = 0._r8 + prod(:,:,49) = 0._r8 + prod(:,:,112) = 0._r8 + prod(:,:,122) = 0._r8 + prod(:,:,99) = 0._r8 + prod(:,:,71) = 0._r8 + prod(:,:,38) = 0._r8 + prod(:,:,61) = 0._r8 + prod(:,:,121) = 0._r8 + prod(:,:,125) = 0._r8 + prod(:,:,105) = 0._r8 + prod(:,:,114) = 0._r8 + prod(:,:,126) = 0._r8 + prod(:,:,50) = 0._r8 + prod(:,:,85) = 0._r8 + prod(:,:,53) = 0._r8 + prod(:,:,83) = 0._r8 + prod(:,:,68) = 0._r8 + prod(:,:,39) =rxt(:,:,41)*y(:,:,111) +rxt(:,:,42)*y(:,:,112) +rxt(:,:,45) & + *y(:,:,113) +rxt(:,:,49)*y(:,:,116) +rxt(:,:,50)*y(:,:,117) & + +rxt(:,:,47)*y(:,:,119) +2.000_r8*rxt(:,:,43)*y(:,:,120) & + +2.000_r8*rxt(:,:,44)*y(:,:,121) +rxt(:,:,53)*y(:,:,122) & + +2.000_r8*rxt(:,:,54)*y(:,:,123) + prod(:,:,45) =rxt(:,:,40)*y(:,:,110) +rxt(:,:,42)*y(:,:,112) +rxt(:,:,46) & + *y(:,:,118) + prod(:,:,47) = 0._r8 + prod(:,:,101) =rxt(:,:,49)*y(:,:,116) +rxt(:,:,44)*y(:,:,121) + prod(:,:,115) = + extfrc(:,:,4) + prod(:,:,54) = 0._r8 + prod(:,:,3) = + extfrc(:,:,5) + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,62) = 0._r8 + prod(:,:,97) = 0._r8 + prod(:,:,132) = 0._r8 + prod(:,:,51) = 0._r8 + prod(:,:,42) = 0._r8 + prod(:,:,17) = + extfrc(:,:,6) + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,28) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 new file mode 100644 index 0000000000..ff4ca12628 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lin_matrix.F90 @@ -0,0 +1,471 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1107) = -( rxt(3) + rxt(4) + het_rates(1) ) + mat(1061) = -( rxt(92) + rxt(93) + rxt(94) + rxt(105) + rxt(106) + rxt(107) & + + het_rates(2) ) + mat(942) = rxt(1) + 2.000_r8*rxt(2) + rxt(98) + rxt(99) + rxt(100) & + + 2.000_r8*rxt(103) + rxt(110) + rxt(111) + rxt(112) & + + 2.000_r8*rxt(115) + mat(1106) = rxt(4) + mat(1020) = rxt(6) + mat(1169) = rxt(8) + mat(129) = rxt(10) + mat(1354) = rxt(12) + mat(1380) = rxt(21) + mat(1543) = rxt(24) + mat(135) = rxt(25) + mat(1193) = rxt(32) + mat(589) = rxt(88) + mat(106) = rxt(89) + mat(846) = rxt(91) + mat(1132) = rxt(131) + mat(1134) = -( rxt(131) + rxt(135)*y(7) + rxt(136)*y(7) + rxt(138)*y(110) & + + rxt(139)*y(111) + rxt(140)*y(112) + rxt(141)*y(120) & + + rxt(142)*y(121) + rxt(143)*y(113) + rxt(144)*y(118) & + + rxt(145)*y(119) + rxt(146)*y(114) + rxt(147)*y(109) & + + rxt(148)*y(117) + rxt(149)*y(116) + rxt(150)*y(122) & + + rxt(151)*y(123) + rxt(152)*y(124) + rxt(153)*y(125) & + + rxt(156)*y(15) + rxt(157)*y(15) + rxt(158)*y(15) + het_rates(3) ) + mat(944) = rxt(1) + mat(1108) = rxt(3) + mat(1382) = rxt(20) + mat(940) = -( rxt(1) + rxt(2) + rxt(96) + rxt(98) + rxt(99) + rxt(100) + rxt(103) & + + rxt(108) + rxt(110) + rxt(111) + rxt(112) + rxt(115) & + + het_rates(4) ) + mat(1103) = rxt(4) + mat(1351) = rxt(13) + mat(71) = rxt(126) + mat(68) = rxt(129) + rxt(130) + mat(1129) = rxt(136)*y(7) + mat(70) = -( rxt(123) + rxt(126) + rxt(125)*y(126) + het_rates(5) ) + mat(67) = -( rxt(129) + rxt(130) + het_rates(6) ) + mat(1074) = rxt(3) + mat(69) = rxt(123) + rxt(125)*y(126) + mat(684) = -( het_rates(21) ) + mat(1210) = rxt(18) + mat(1372) = rxt(20) + mat(1125) = rxt(158)*y(15) + mat(636) = -( het_rates(20) ) + mat(1209) = rxt(17) + rxt(18) + mat(640) = rxt(61) + mat(670) = 1.340_r8*rxt(67) + mat(772) = .700_r8*rxt(68) + mat(695) = rxt(74) + mat(579) = rxt(76) + mat(554) = rxt(79) + mat(279) = .450_r8*rxt(81) + mat(418) = 2.000_r8*rxt(82) + mat(165) = rxt(90) + mat(1405) = rxt(254)*y(108) + mat(355) = rxt(467)*y(126) + mat(509) = -( rxt(95) + het_rates(8) ) + mat(997) = rxt(6) + mat(354) = rxt(464) + mat(1019) = -( rxt(6) + rxt(7) + het_rates(9) ) + mat(1168) = rxt(8) + .500_r8*rxt(405) + mat(128) = rxt(10) + mat(1353) = rxt(13) + mat(454) = rxt(474) + mat(1131) = 2.000_r8*rxt(135)*y(7) + mat(1172) = -( rxt(8) + rxt(405) + het_rates(10) ) + mat(130) = rxt(9) + rxt(197) + mat(966) = rxt(11) + mat(1357) = rxt(12) + mat(238) = rxt(15) + rxt(206) + mat(612) = rxt(30) + mat(320) = rxt(36) + mat(246) = .600_r8*rxt(64) + rxt(311) + mat(286) = rxt(65) + rxt(357) + mat(581) = rxt(76) + mat(1527) = -( rxt(255)*y(108) + rxt(256)*y(115) + rxt(257)*y(113) & + + rxt(258)*y(109) + rxt(260)*y(118) + rxt(261)*y(119) & + + rxt(262)*y(125) + rxt(263)*y(124) + rxt(266)*y(15) + het_rates(23) & + ) + mat(974) = rxt(11) + mat(242) = rxt(14) + mat(210) = rxt(16) + mat(1391) = rxt(19) + mat(350) = 2.000_r8*rxt(22) + mat(536) = rxt(27) + mat(439) = rxt(33) + mat(330) = rxt(62) + mat(267) = rxt(63) + mat(158) = rxt(69) + mat(63) = rxt(70) + mat(192) = rxt(71) + mat(198) = rxt(72) + mat(102) = rxt(75) + mat(368) = rxt(83) + mat(148) = rxt(84) + mat(175) = rxt(85) + mat(227) = rxt(86) + mat(1180) = .500_r8*rxt(405) + mat(1143) = rxt(156)*y(15) + mat(1362) = -( rxt(12) + rxt(13) + rxt(404) + het_rates(11) ) + mat(131) = rxt(9) + rxt(10) + rxt(197) + mat(240) = rxt(14) + mat(613) = rxt(29) + mat(322) = rxt(35) + mat(248) = .400_r8*rxt(64) + mat(961) = -( rxt(11) + het_rates(12) ) + mat(127) = 2.000_r8*rxt(403) + 2.000_r8*rxt(446) + 2.000_r8*rxt(452) & + + 2.000_r8*rxt(457) + mat(1352) = rxt(404) + mat(1167) = .500_r8*rxt(405) + mat(610) = rxt(447) + rxt(453) + rxt(458) + mat(318) = rxt(448) + rxt(456) + rxt(459) + mat(236) = -( rxt(14) + rxt(15) + rxt(206) + het_rates(13) ) + mat(126) = -( rxt(9) + rxt(10) + rxt(197) + rxt(403) + rxt(446) + rxt(452) & + + rxt(457) + het_rates(14) ) + mat(909) = -( het_rates(16) ) + mat(643) = rxt(61) + mat(264) = rxt(63) + mat(245) = .400_r8*rxt(64) + mat(780) = .300_r8*rxt(68) + mat(407) = rxt(73) + mat(1128) = rxt(156)*y(15) + mat(1411) = rxt(213)*y(15) + mat(443) = rxt(252)*y(15) + mat(1512) = rxt(266)*y(15) + mat(205) = -( rxt(16) + het_rates(17) ) + mat(85) = -( het_rates(42) ) + mat(46) = -( het_rates(43) ) + mat(1222) = -( rxt(17) + rxt(18) + het_rates(19) ) + mat(207) = rxt(16) + mat(327) = rxt(62) + mat(677) = 1.340_r8*rxt(66) + mat(196) = rxt(72) + mat(582) = rxt(76) + mat(312) = .690_r8*rxt(77) + mat(667) = rxt(78) + mat(555) = rxt(79) + mat(366) = .100_r8*rxt(83) + mat(203) = rxt(280) + mat(219) = 2.000_r8*rxt(292) + mat(1137) = rxt(157)*y(15) + rxt(158)*y(15) + mat(1243) = -( het_rates(22) ) + mat(208) = rxt(16) + mat(1223) = 2.000_r8*rxt(17) + mat(1386) = rxt(19) + 2.000_r8*rxt(21) + mat(868) = rxt(28) + mat(501) = rxt(34) + mat(91) = rxt(57) + mat(1138) = rxt(157)*y(15) + mat(1317) = -( rxt(408) + het_rates(24) ) + mat(239) = rxt(15) + rxt(206) + mat(646) = rxt(61) + mat(328) = rxt(62) + mat(679) = 1.340_r8*rxt(66) + .660_r8*rxt(67) + mat(157) = rxt(69) + mat(190) = rxt(71) + mat(700) = rxt(74) + mat(583) = rxt(76) + mat(313) = rxt(77) + mat(668) = rxt(78) + mat(556) = 2.000_r8*rxt(79) + mat(282) = .560_r8*rxt(81) + mat(419) = 2.000_r8*rxt(82) + mat(367) = .900_r8*rxt(83) + mat(226) = rxt(86) + mat(204) = rxt(280) + mat(220) = rxt(292) + mat(1139) = rxt(157)*y(15) + mat(1422) = rxt(254)*y(108) + rxt(259)*y(109) + mat(1523) = rxt(255)*y(108) + rxt(258)*y(109) + mat(344) = -( rxt(22) + het_rates(25) ) + mat(1274) = .500_r8*rxt(408) + mat(1389) = -( rxt(19) + rxt(20) + rxt(21) + het_rates(134) ) + mat(74) = rxt(87) + mat(1525) = rxt(255)*y(108) + rxt(256)*y(115) + rxt(257)*y(113) + rxt(258)*y(109) & + + rxt(262)*y(125) + rxt(266)*y(15) + mat(1425) = -( rxt(213)*y(15) + rxt(254)*y(108) + rxt(259)*y(109) & + + rxt(264)*y(125) + rxt(265)*y(124) + het_rates(28) ) + mat(76) = 2.000_r8*rxt(23) + mat(1553) = rxt(24) + mat(32) = 2.000_r8*rxt(26) + mat(535) = rxt(27) + mat(871) = rxt(28) + mat(615) = rxt(29) + mat(94) = rxt(31) + mat(84) = rxt(56) + mat(1142) = 2.000_r8*rxt(138)*y(110) + 2.000_r8*rxt(139)*y(111) & + + 2.000_r8*rxt(140)*y(112) + 2.000_r8*rxt(141)*y(120) & + + rxt(142)*y(121) + rxt(143)*y(113) + rxt(144)*y(118) & + + rxt(145)*y(119) + 4.000_r8*rxt(146)*y(114) + rxt(148)*y(117) + mat(1526) = rxt(255)*y(108) + 3.000_r8*rxt(256)*y(115) + rxt(257)*y(113) & + + rxt(260)*y(118) + rxt(261)*y(119) + mat(75) = -( rxt(23) + het_rates(29) ) + mat(1555) = -( rxt(24) + het_rates(30) ) + mat(136) = rxt(25) + mat(617) = rxt(30) + mat(33) = 2.000_r8*rxt(225) + mat(132) = -( rxt(25) + het_rates(31) ) + mat(31) = -( rxt(26) + rxt(225) + het_rates(32) ) + end subroutine linmat01 + subroutine linmat02( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(861) = -( rxt(28) + het_rates(33) ) + mat(1409) = rxt(213)*y(15) + 2.000_r8*rxt(254)*y(108) + rxt(259)*y(109) & + + rxt(264)*y(125) + rxt(265)*y(124) + mat(531) = -( rxt(27) + het_rates(34) ) + mat(607) = rxt(447) + rxt(453) + rxt(458) + mat(608) = -( rxt(29) + rxt(30) + rxt(447) + rxt(453) + rxt(458) + het_rates(35) & + ) + mat(92) = -( rxt(31) + het_rates(36) ) + mat(876) = -( het_rates(37) ) + mat(93) = rxt(31) + mat(1189) = rxt(32) + mat(434) = rxt(33) + mat(498) = rxt(34) + mat(317) = rxt(35) + mat(1127) = rxt(147)*y(109) + rxt(148)*y(117) + rxt(149)*y(116) & + + 2.000_r8*rxt(150)*y(122) + 2.000_r8*rxt(151)*y(123) & + + 3.000_r8*rxt(152)*y(124) + 2.000_r8*rxt(153)*y(125) + mat(1511) = rxt(258)*y(109) + 2.000_r8*rxt(262)*y(125) + 3.000_r8*rxt(263)*y(124) + mat(1410) = rxt(259)*y(109) + 2.000_r8*rxt(264)*y(125) + 3.000_r8*rxt(265)*y(124) + mat(1197) = -( rxt(32) + het_rates(38) ) + mat(321) = rxt(36) + mat(497) = -( rxt(34) + het_rates(39) ) + mat(432) = -( rxt(33) + het_rates(40) ) + mat(316) = rxt(448) + rxt(456) + rxt(459) + mat(315) = -( rxt(35) + rxt(36) + rxt(448) + rxt(456) + rxt(459) + het_rates(41) & + ) + mat(379) = -( het_rates(127) ) + mat(449) = -( rxt(474) + het_rates(128) ) + mat(931) = rxt(96) + rxt(108) + mat(352) = rxt(467)*y(126) + mat(250) = -( het_rates(129) ) + mat(504) = rxt(95) + mat(351) = -( rxt(464) + rxt(467)*y(126) + het_rates(130) ) + mat(1040) = rxt(92) + rxt(93) + rxt(94) + rxt(105) + rxt(106) + rxt(107) + mat(928) = rxt(98) + rxt(99) + rxt(100) + rxt(110) + rxt(111) + rxt(112) + mat(458) = -( het_rates(131) ) + mat(993) = rxt(7) + mat(353) = rxt(464) + mat(450) = rxt(474) + mat(257) = -( het_rates(133) ) + mat(469) = -( het_rates(132) ) + mat(994) = rxt(7) + mat(1046) = rxt(92) + rxt(93) + rxt(94) + rxt(105) + rxt(106) + rxt(107) + mat(508) = rxt(95) + mat(933) = rxt(96) + rxt(98) + rxt(99) + rxt(100) + rxt(108) + rxt(110) & + + rxt(111) + rxt(112) + mat(621) = -( het_rates(59) ) + mat(771) = .700_r8*rxt(68) + mat(560) = -( het_rates(83) ) + mat(487) = -( het_rates(64) ) + mat(641) = -( rxt(61) + het_rates(50) ) + mat(325) = rxt(62) + mat(156) = rxt(69) + mat(364) = .400_r8*rxt(83) + mat(146) = rxt(84) + mat(340) = -( het_rates(49) ) + mat(323) = -( rxt(62) + het_rates(65) ) + mat(826) = -( het_rates(48) ) + mat(244) = .600_r8*rxt(64) + rxt(311) + mat(675) = 1.340_r8*rxt(66) + mat(779) = .300_r8*rxt(68) + mat(195) = rxt(72) + mat(406) = rxt(73) + mat(697) = rxt(74) + mat(666) = rxt(78) + mat(214) = rxt(80) + mat(281) = .130_r8*rxt(81) + mat(147) = rxt(84) + mat(262) = -( rxt(63) + het_rates(54) ) + mat(243) = -( rxt(64) + rxt(311) + het_rates(58) ) + mat(183) = -( het_rates(82) ) + mat(108) = -( het_rates(45) ) + mat(291) = -( het_rates(44) ) + mat(34) = -( het_rates(71) ) + mat(283) = -( rxt(65) + rxt(357) + het_rates(81) ) + mat(37) = -( het_rates(70) ) + mat(137) = -( het_rates(73) ) + mat(393) = -( het_rates(84) ) + mat(359) = -( rxt(83) + het_rates(85) ) + mat(211) = -( rxt(80) + het_rates(72) ) + mat(358) = .800_r8*rxt(83) + mat(370) = -( het_rates(74) ) + mat(144) = -( rxt(84) + het_rates(75) ) + mat(53) = -( het_rates(94) ) + mat(58) = -( het_rates(95) ) + mat(269) = -( het_rates(96) ) + mat(170) = -( rxt(85) + het_rates(97) ) + mat(77) = -( het_rates(98) ) + mat(595) = -( het_rates(106) ) + mat(221) = -( rxt(86) + het_rates(107) ) + mat(277) = -( rxt(81) + het_rates(86) ) + mat(172) = .900_r8*rxt(85) + mat(417) = -( rxt(82) + het_rates(53) ) + mat(278) = .130_r8*rxt(81) + mat(173) = .450_r8*rxt(85) + mat(40) = -( het_rates(99) ) + mat(177) = -( het_rates(100) ) + mat(1) = -( het_rates(101) ) + mat(43) = -( het_rates(102) ) + mat(229) = -( het_rates(103) ) + mat(2) = -( het_rates(104) ) + mat(734) = -( het_rates(88) ) + mat(777) = -( rxt(68) + het_rates(77) ) + mat(311) = .402_r8*rxt(77) + mat(225) = rxt(86) + mat(671) = -( rxt(66) + rxt(67) + het_rates(78) ) + mat(308) = .288_r8*rxt(77) + mat(224) = rxt(86) + mat(758) = -( het_rates(79) ) + mat(149) = -( het_rates(80) ) + mat(797) = -( het_rates(76) ) + mat(285) = rxt(65) + rxt(357) + mat(674) = .660_r8*rxt(66) + mat(521) = -( het_rates(46) ) + mat(213) = rxt(80) + mat(154) = -( rxt(69) + het_rates(47) ) + mat(331) = -( het_rates(105) ) + mat(49) = -( het_rates(60) ) + mat(540) = -( het_rates(61) ) + mat(187) = -( rxt(71) + het_rates(62) ) + mat(404) = -( rxt(73) + het_rates(63) ) + mat(188) = .820_r8*rxt(71) + mat(362) = .250_r8*rxt(83) + mat(222) = .100_r8*rxt(86) + mat(193) = -( rxt(72) + het_rates(69) ) + mat(303) = -( het_rates(18) ) + mat(95) = -( het_rates(51) ) + mat(553) = -( rxt(79) + het_rates(52) ) + mat(664) = -( rxt(78) + het_rates(66) ) + mat(423) = -( het_rates(55) ) + mat(216) = -( rxt(292) + het_rates(56) ) + mat(62) = rxt(70) + mat(61) = -( rxt(70) + het_rates(57) ) + mat(159) = -( het_rates(87) ) + mat(652) = -( het_rates(67) ) + mat(696) = -( rxt(74) + het_rates(68) ) + mat(280) = .180_r8*rxt(81) + mat(174) = .450_r8*rxt(85) + mat(476) = -( het_rates(89) ) + mat(578) = -( rxt(76) + het_rates(90) ) + mat(711) = -( het_rates(91) ) + mat(99) = -( rxt(75) + het_rates(92) ) + mat(307) = -( rxt(77) + het_rates(93) ) + mat(114) = -( het_rates(135) ) + mat(299) = -( het_rates(136) ) + mat(199) = -( rxt(280) + het_rates(137) ) + mat(64) = -( rxt(55) + het_rates(138) ) + mat(1119) = rxt(139)*y(111) + rxt(140)*y(112) + 2.000_r8*rxt(141)*y(120) & + + 2.000_r8*rxt(142)*y(121) + rxt(143)*y(113) + rxt(145)*y(119) & + + rxt(148)*y(117) + rxt(149)*y(116) + rxt(150)*y(122) & + + 2.000_r8*rxt(151)*y(123) + mat(1436) = rxt(257)*y(113) + rxt(261)*y(119) + mat(81) = -( rxt(56) + het_rates(139) ) + mat(1121) = rxt(138)*y(110) + rxt(140)*y(112) + rxt(144)*y(118) + mat(1438) = rxt(260)*y(118) + mat(89) = -( rxt(57) + het_rates(140) ) + mat(440) = rxt(252)*y(15) + mat(441) = -( rxt(252)*y(15) + het_rates(141) ) + mat(65) = 2.000_r8*rxt(55) + mat(82) = rxt(56) + mat(90) = rxt(57) + mat(1123) = rxt(142)*y(121) + rxt(149)*y(116) + mat(587) = -( rxt(88) + het_rates(156) ) + mat(105) = rxt(89) + mat(120) = -( het_rates(157) ) + mat(3) = -( rxt(413) + het_rates(158) ) + mat(4) = -( het_rates(159) ) + mat(5) = -( rxt(419) + het_rates(160) ) + mat(6) = -( rxt(420) + het_rates(161) ) + mat(7) = -( rxt(414) + het_rates(146) ) + mat(8) = -( rxt(415) + het_rates(147) ) + mat(9) = -( rxt(417) + het_rates(148) ) + mat(10) = -( rxt(416) + het_rates(149) ) + mat(11) = -( rxt(418) + het_rates(150) ) + mat(12) = -( het_rates(151) ) + mat(13) = -( het_rates(152) ) + mat(14) = -( het_rates(153) ) + mat(15) = -( het_rates(154) ) + mat(16) = -( het_rates(155) ) + mat(162) = -( rxt(90) + het_rates(162) ) + mat(410) = -( het_rates(163) ) + mat(163) = rxt(90) + mat(840) = rxt(91) + mat(842) = -( rxt(91) + het_rates(164) ) + mat(588) = rxt(88) + mat(104) = -( rxt(89) + het_rates(165) ) + mat(73) = rxt(87) + mat(72) = -( rxt(87) + het_rates(166) ) + mat(17) = -( rxt(406) + rxt(409) + het_rates(142) ) + mat(19) = -( rxt(410) + het_rates(143) ) + mat(18) = rxt(406) + mat(20) = -( rxt(407) + rxt(411) + het_rates(144) ) + mat(22) = -( rxt(412) + het_rates(145) ) + mat(21) = rxt(407) + mat(23) = -( rxt(421) + het_rates(167) ) + mat(24) = -( rxt(422) + het_rates(168) ) + mat(25) = -( rxt(423) + het_rates(169) ) + mat(26) = -( rxt(424) + het_rates(170) ) + mat(27) = -( rxt(425) + het_rates(171) ) + mat(28) = -( rxt(426) + het_rates(172) ) + mat(29) = -( rxt(427) + het_rates(173) ) + end subroutine linmat02 + subroutine linmat03( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(30) = -( rxt(428) + het_rates(174) ) + end subroutine linmat03 + subroutine linmat( mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) + call linmat03( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 new file mode 100644 index 0000000000..809a8064d3 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_factor.F90 @@ -0,0 +1,5864 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) + lu(7) = 1._r8 / lu(7) + lu(8) = 1._r8 / lu(8) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = 1._r8 / lu(13) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = lu(18) * lu(17) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = lu(21) * lu(20) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(25) = 1._r8 / lu(25) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) + lu(31) = 1._r8 / lu(31) + lu(32) = lu(32) * lu(31) + lu(33) = lu(33) * lu(31) + lu(1553) = lu(1553) - lu(32) * lu(1529) + lu(1555) = lu(1555) - lu(33) * lu(1529) + lu(34) = 1._r8 / lu(34) + lu(35) = lu(35) * lu(34) + lu(36) = lu(36) * lu(34) + lu(1477) = lu(1477) - lu(35) * lu(1428) + lu(1527) = lu(1527) - lu(36) * lu(1428) + lu(37) = 1._r8 / lu(37) + lu(38) = lu(38) * lu(37) + lu(39) = lu(39) * lu(37) + lu(1446) = lu(1446) - lu(38) * lu(1429) + lu(1527) = lu(1527) - lu(39) * lu(1429) + lu(40) = 1._r8 / lu(40) + lu(41) = lu(41) * lu(40) + lu(42) = lu(42) * lu(40) + lu(1453) = lu(1453) - lu(41) * lu(1430) + lu(1527) = lu(1527) - lu(42) * lu(1430) + lu(43) = 1._r8 / lu(43) + lu(44) = lu(44) * lu(43) + lu(45) = lu(45) * lu(43) + lu(1460) = lu(1460) - lu(44) * lu(1431) + lu(1527) = lu(1527) - lu(45) * lu(1431) + lu(46) = 1._r8 / lu(46) + lu(47) = lu(47) * lu(46) + lu(48) = lu(48) * lu(46) + lu(1523) = lu(1523) - lu(47) * lu(1432) + lu(1527) = lu(1527) - lu(48) * lu(1432) + lu(49) = 1._r8 / lu(49) + lu(50) = lu(50) * lu(49) + lu(51) = lu(51) * lu(49) + lu(52) = lu(52) * lu(49) + lu(1488) = lu(1488) - lu(50) * lu(1433) + lu(1525) = lu(1525) - lu(51) * lu(1433) + lu(1527) = lu(1527) - lu(52) * lu(1433) + end subroutine lu_fac01 + subroutine lu_fac02( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(53) = 1._r8 / lu(53) + lu(54) = lu(54) * lu(53) + lu(55) = lu(55) * lu(53) + lu(56) = lu(56) * lu(53) + lu(57) = lu(57) * lu(53) + lu(1435) = lu(1435) - lu(54) * lu(1434) + lu(1464) = lu(1464) - lu(55) * lu(1434) + lu(1523) = lu(1523) - lu(56) * lu(1434) + lu(1527) = lu(1527) - lu(57) * lu(1434) + lu(58) = 1._r8 / lu(58) + lu(59) = lu(59) * lu(58) + lu(60) = lu(60) * lu(58) + lu(1437) = lu(1437) - lu(59) * lu(1435) + lu(1527) = lu(1527) - lu(60) * lu(1435) + lu(61) = 1._r8 / lu(61) + lu(62) = lu(62) * lu(61) + lu(63) = lu(63) * lu(61) + lu(422) = lu(422) - lu(62) * lu(421) + lu(430) = - lu(63) * lu(421) + lu(1263) = - lu(62) * lu(1252) + lu(1321) = lu(1321) - lu(63) * lu(1252) + lu(64) = 1._r8 / lu(64) + lu(65) = lu(65) * lu(64) + lu(66) = lu(66) * lu(64) + lu(1123) = lu(1123) - lu(65) * lu(1119) + lu(1134) = lu(1134) - lu(66) * lu(1119) + lu(1482) = - lu(65) * lu(1436) + lu(1518) = - lu(66) * lu(1436) + lu(67) = 1._r8 / lu(67) + lu(68) = lu(68) * lu(67) + lu(71) = lu(71) - lu(68) * lu(69) + lu(940) = lu(940) - lu(68) * lu(923) + lu(1058) = lu(1058) - lu(68) * lu(1033) + lu(1103) = lu(1103) - lu(68) * lu(1074) + lu(70) = 1._r8 / lu(70) + lu(71) = lu(71) * lu(70) + lu(940) = lu(940) - lu(71) * lu(924) + lu(1058) = lu(1058) - lu(71) * lu(1034) + lu(1103) = lu(1103) - lu(71) * lu(1075) + lu(1129) = lu(1129) - lu(71) * lu(1120) + lu(72) = 1._r8 / lu(72) + lu(73) = lu(73) * lu(72) + lu(74) = lu(74) * lu(72) + lu(104) = lu(104) - lu(73) * lu(103) + lu(107) = lu(107) - lu(74) * lu(103) + lu(1369) = lu(1369) - lu(73) * lu(1367) + lu(1389) = lu(1389) - lu(74) * lu(1367) + lu(75) = 1._r8 / lu(75) + lu(76) = lu(76) * lu(75) + lu(535) = lu(535) - lu(76) * lu(530) + lu(615) = lu(615) - lu(76) * lu(606) + lu(871) = lu(871) - lu(76) * lu(856) + lu(1425) = lu(1425) - lu(76) * lu(1393) + lu(1553) = lu(1553) - lu(76) * lu(1530) + lu(77) = 1._r8 / lu(77) + lu(78) = lu(78) * lu(77) + lu(79) = lu(79) * lu(77) + lu(80) = lu(80) * lu(77) + lu(1149) = lu(1149) - lu(78) * lu(1145) + lu(1172) = lu(1172) - lu(79) * lu(1145) + lu(1176) = lu(1176) - lu(80) * lu(1145) + lu(1465) = - lu(78) * lu(1437) + lu(1519) = lu(1519) - lu(79) * lu(1437) + lu(1523) = lu(1523) - lu(80) * lu(1437) + lu(81) = 1._r8 / lu(81) + lu(82) = lu(82) * lu(81) + lu(83) = lu(83) * lu(81) + lu(84) = lu(84) * lu(81) + lu(1123) = lu(1123) - lu(82) * lu(1121) + lu(1134) = lu(1134) - lu(83) * lu(1121) + lu(1142) = lu(1142) - lu(84) * lu(1121) + lu(1482) = lu(1482) - lu(82) * lu(1438) + lu(1518) = lu(1518) - lu(83) * lu(1438) + lu(1526) = lu(1526) - lu(84) * lu(1438) + lu(85) = 1._r8 / lu(85) + lu(86) = lu(86) * lu(85) + lu(87) = lu(87) * lu(85) + lu(88) = lu(88) * lu(85) + lu(1134) = lu(1134) - lu(86) * lu(1122) + lu(1139) = lu(1139) - lu(87) * lu(1122) + lu(1143) = lu(1143) - lu(88) * lu(1122) + lu(1518) = lu(1518) - lu(86) * lu(1439) + lu(1523) = lu(1523) - lu(87) * lu(1439) + lu(1527) = lu(1527) - lu(88) * lu(1439) + lu(89) = 1._r8 / lu(89) + lu(90) = lu(90) * lu(89) + lu(91) = lu(91) * lu(89) + lu(441) = lu(441) - lu(90) * lu(440) + lu(445) = lu(445) - lu(91) * lu(440) + lu(683) = lu(683) - lu(90) * lu(682) + lu(690) = lu(690) - lu(91) * lu(682) + lu(955) = lu(955) - lu(90) * lu(954) + lu(969) = - lu(91) * lu(954) + lu(1370) = lu(1370) - lu(90) * lu(1368) + lu(1386) = lu(1386) - lu(91) * lu(1368) + lu(92) = 1._r8 / lu(92) + lu(93) = lu(93) * lu(92) + lu(94) = lu(94) * lu(92) + lu(434) = lu(434) - lu(93) * lu(431) + lu(438) = - lu(94) * lu(431) + lu(862) = - lu(93) * lu(857) + lu(871) = lu(871) - lu(94) * lu(857) + lu(1189) = lu(1189) - lu(93) * lu(1182) + lu(1203) = lu(1203) - lu(94) * lu(1182) + lu(1538) = lu(1538) - lu(93) * lu(1531) + lu(1553) = lu(1553) - lu(94) * lu(1531) + lu(95) = 1._r8 / lu(95) + lu(96) = lu(96) * lu(95) + lu(97) = lu(97) * lu(95) + lu(98) = lu(98) * lu(95) + lu(522) = lu(522) - lu(96) * lu(518) + lu(528) = lu(528) - lu(97) * lu(518) + lu(529) = - lu(98) * lu(518) + lu(898) = lu(898) - lu(96) * lu(887) + lu(917) = lu(917) - lu(97) * lu(887) + lu(921) = - lu(98) * lu(887) + lu(1497) = lu(1497) - lu(96) * lu(1440) + lu(1523) = lu(1523) - lu(97) * lu(1440) + lu(1527) = lu(1527) - lu(98) * lu(1440) + end subroutine lu_fac02 + subroutine lu_fac03( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(99) = 1._r8 / lu(99) + lu(100) = lu(100) * lu(99) + lu(101) = lu(101) * lu(99) + lu(102) = lu(102) * lu(99) + lu(711) = lu(711) - lu(100) * lu(704) + lu(721) = - lu(101) * lu(704) + lu(722) = - lu(102) * lu(704) + lu(1298) = lu(1298) - lu(100) * lu(1253) + lu(1319) = lu(1319) - lu(101) * lu(1253) + lu(1321) = lu(1321) - lu(102) * lu(1253) + lu(1503) = lu(1503) - lu(100) * lu(1441) + lu(1525) = lu(1525) - lu(101) * lu(1441) + lu(1527) = lu(1527) - lu(102) * lu(1441) + lu(104) = 1._r8 / lu(104) + lu(105) = lu(105) * lu(104) + lu(106) = lu(106) * lu(104) + lu(107) = lu(107) * lu(104) + lu(587) = lu(587) - lu(105) * lu(586) + lu(589) = lu(589) - lu(106) * lu(586) + lu(591) = - lu(107) * lu(586) + lu(1371) = - lu(105) * lu(1369) + lu(1380) = lu(1380) - lu(106) * lu(1369) + lu(1389) = lu(1389) - lu(107) * lu(1369) + lu(1492) = lu(1492) - lu(105) * lu(1442) + lu(1516) = lu(1516) - lu(106) * lu(1442) + lu(1525) = lu(1525) - lu(107) * lu(1442) + lu(108) = 1._r8 / lu(108) + lu(109) = lu(109) * lu(108) + lu(110) = lu(110) * lu(108) + lu(111) = lu(111) * lu(108) + lu(112) = lu(112) * lu(108) + lu(113) = lu(113) * lu(108) + lu(1401) = lu(1401) - lu(109) * lu(1394) + lu(1409) = lu(1409) - lu(110) * lu(1394) + lu(1424) = - lu(111) * lu(1394) + lu(1425) = lu(1425) - lu(112) * lu(1394) + lu(1426) = lu(1426) - lu(113) * lu(1394) + lu(1486) = lu(1486) - lu(109) * lu(1443) + lu(1510) = lu(1510) - lu(110) * lu(1443) + lu(1525) = lu(1525) - lu(111) * lu(1443) + lu(1526) = lu(1526) - lu(112) * lu(1443) + lu(1527) = lu(1527) - lu(113) * lu(1443) + lu(114) = 1._r8 / lu(114) + lu(115) = lu(115) * lu(114) + lu(116) = lu(116) * lu(114) + lu(117) = lu(117) * lu(114) + lu(118) = lu(118) * lu(114) + lu(119) = lu(119) * lu(114) + lu(1397) = - lu(115) * lu(1395) + lu(1399) = - lu(116) * lu(1395) + lu(1405) = lu(1405) - lu(117) * lu(1395) + lu(1422) = lu(1422) - lu(118) * lu(1395) + lu(1426) = lu(1426) - lu(119) * lu(1395) + lu(1468) = lu(1468) - lu(115) * lu(1444) + lu(1480) = lu(1480) - lu(116) * lu(1444) + lu(1496) = lu(1496) - lu(117) * lu(1444) + lu(1523) = lu(1523) - lu(118) * lu(1444) + lu(1527) = lu(1527) - lu(119) * lu(1444) + lu(120) = 1._r8 / lu(120) + lu(121) = lu(121) * lu(120) + lu(122) = lu(122) * lu(120) + lu(123) = lu(123) * lu(120) + lu(124) = lu(124) * lu(120) + lu(125) = lu(125) * lu(120) + lu(1333) = lu(1333) - lu(121) * lu(1323) + lu(1352) = lu(1352) - lu(122) * lu(1323) + lu(1361) = lu(1361) - lu(123) * lu(1323) + lu(1362) = lu(1362) - lu(124) * lu(1323) + lu(1365) = lu(1365) - lu(125) * lu(1323) + lu(1492) = lu(1492) - lu(121) * lu(1445) + lu(1514) = lu(1514) - lu(122) * lu(1445) + lu(1523) = lu(1523) - lu(123) * lu(1445) + lu(1524) = lu(1524) - lu(124) * lu(1445) + lu(1527) = lu(1527) - lu(125) * lu(1445) + lu(126) = 1._r8 / lu(126) + lu(127) = lu(127) * lu(126) + lu(128) = lu(128) * lu(126) + lu(129) = lu(129) * lu(126) + lu(130) = lu(130) * lu(126) + lu(131) = lu(131) * lu(126) + lu(1167) = lu(1167) - lu(127) * lu(1146) + lu(1168) = lu(1168) - lu(128) * lu(1146) + lu(1169) = lu(1169) - lu(129) * lu(1146) + lu(1172) = lu(1172) - lu(130) * lu(1146) + lu(1177) = lu(1177) - lu(131) * lu(1146) + lu(1352) = lu(1352) - lu(127) * lu(1324) + lu(1353) = lu(1353) - lu(128) * lu(1324) + lu(1354) = lu(1354) - lu(129) * lu(1324) + lu(1357) = lu(1357) - lu(130) * lu(1324) + lu(1362) = lu(1362) - lu(131) * lu(1324) + lu(132) = 1._r8 / lu(132) + lu(133) = lu(133) * lu(132) + lu(134) = lu(134) * lu(132) + lu(135) = lu(135) * lu(132) + lu(136) = lu(136) * lu(132) + lu(841) = lu(841) - lu(133) * lu(839) + lu(842) = lu(842) - lu(134) * lu(839) + lu(846) = lu(846) - lu(135) * lu(839) + lu(855) = lu(855) - lu(136) * lu(839) + lu(1186) = lu(1186) - lu(133) * lu(1183) + lu(1187) = lu(1187) - lu(134) * lu(1183) + lu(1193) = lu(1193) - lu(135) * lu(1183) + lu(1205) = lu(1205) - lu(136) * lu(1183) + lu(1534) = lu(1534) - lu(133) * lu(1532) + lu(1536) = lu(1536) - lu(134) * lu(1532) + lu(1543) = lu(1543) - lu(135) * lu(1532) + lu(1555) = lu(1555) - lu(136) * lu(1532) + lu(137) = 1._r8 / lu(137) + lu(138) = lu(138) * lu(137) + lu(139) = lu(139) * lu(137) + lu(140) = lu(140) * lu(137) + lu(141) = lu(141) * lu(137) + lu(142) = lu(142) * lu(137) + lu(143) = lu(143) * lu(137) + lu(989) = lu(989) - lu(138) * lu(976) + lu(1004) = lu(1004) - lu(139) * lu(976) + lu(1019) = lu(1019) - lu(140) * lu(976) + lu(1023) = lu(1023) - lu(141) * lu(976) + lu(1025) = lu(1025) - lu(142) * lu(976) + lu(1027) = lu(1027) - lu(143) * lu(976) + lu(1478) = lu(1478) - lu(138) * lu(1446) + lu(1497) = lu(1497) - lu(139) * lu(1446) + lu(1515) = lu(1515) - lu(140) * lu(1446) + lu(1519) = lu(1519) - lu(141) * lu(1446) + lu(1521) = lu(1521) - lu(142) * lu(1446) + lu(1523) = lu(1523) - lu(143) * lu(1446) + end subroutine lu_fac03 + subroutine lu_fac04( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(144) = 1._r8 / lu(144) + lu(145) = lu(145) * lu(144) + lu(146) = lu(146) * lu(144) + lu(147) = lu(147) * lu(144) + lu(148) = lu(148) * lu(144) + lu(370) = lu(370) - lu(145) * lu(369) + lu(371) = lu(371) - lu(146) * lu(369) + lu(372) = lu(372) - lu(147) * lu(369) + lu(376) = - lu(148) * lu(369) + lu(1276) = lu(1276) - lu(145) * lu(1254) + lu(1292) = - lu(146) * lu(1254) + lu(1303) = lu(1303) - lu(147) * lu(1254) + lu(1321) = lu(1321) - lu(148) * lu(1254) + lu(1476) = lu(1476) - lu(145) * lu(1447) + lu(1497) = lu(1497) - lu(146) * lu(1447) + lu(1508) = lu(1508) - lu(147) * lu(1447) + lu(1527) = lu(1527) - lu(148) * lu(1447) + lu(149) = 1._r8 / lu(149) + lu(150) = lu(150) * lu(149) + lu(151) = lu(151) * lu(149) + lu(152) = lu(152) * lu(149) + lu(153) = lu(153) * lu(149) + lu(758) = lu(758) - lu(150) * lu(750) + lu(759) = - lu(151) * lu(750) + lu(767) = lu(767) - lu(152) * lu(750) + lu(770) = - lu(153) * lu(750) + lu(1300) = lu(1300) - lu(150) * lu(1255) + lu(1302) = lu(1302) - lu(151) * lu(1255) + lu(1317) = lu(1317) - lu(152) * lu(1255) + lu(1321) = lu(1321) - lu(153) * lu(1255) + lu(1505) = lu(1505) - lu(150) * lu(1448) + lu(1507) = lu(1507) - lu(151) * lu(1448) + lu(1523) = lu(1523) - lu(152) * lu(1448) + lu(1527) = lu(1527) - lu(153) * lu(1448) + lu(154) = 1._r8 / lu(154) + lu(155) = lu(155) * lu(154) + lu(156) = lu(156) * lu(154) + lu(157) = lu(157) * lu(154) + lu(158) = lu(158) * lu(154) + lu(521) = lu(521) - lu(155) * lu(519) + lu(522) = lu(522) - lu(156) * lu(519) + lu(528) = lu(528) - lu(157) * lu(519) + lu(529) = lu(529) - lu(158) * lu(519) + lu(1285) = lu(1285) - lu(155) * lu(1256) + lu(1292) = lu(1292) - lu(156) * lu(1256) + lu(1317) = lu(1317) - lu(157) * lu(1256) + lu(1321) = lu(1321) - lu(158) * lu(1256) + lu(1486) = lu(1486) - lu(155) * lu(1449) + lu(1497) = lu(1497) - lu(156) * lu(1449) + lu(1523) = lu(1523) - lu(157) * lu(1449) + lu(1527) = lu(1527) - lu(158) * lu(1449) + lu(159) = 1._r8 / lu(159) + lu(160) = lu(160) * lu(159) + lu(161) = lu(161) * lu(159) + lu(580) = - lu(160) * lu(577) + lu(585) = lu(585) - lu(161) * lu(577) + lu(733) = - lu(160) * lu(723) + lu(749) = - lu(161) * lu(723) + lu(821) = lu(821) - lu(160) * lu(811) + lu(838) = - lu(161) * lu(811) + lu(903) = lu(903) - lu(160) * lu(888) + lu(921) = lu(921) - lu(161) * lu(888) + lu(1009) = lu(1009) - lu(160) * lu(977) + lu(1031) = lu(1031) - lu(161) * lu(977) + lu(1342) = lu(1342) - lu(160) * lu(1325) + lu(1365) = lu(1365) - lu(161) * lu(1325) + lu(1503) = lu(1503) - lu(160) * lu(1450) + lu(1527) = lu(1527) - lu(161) * lu(1450) + lu(162) = 1._r8 / lu(162) + lu(163) = lu(163) * lu(162) + lu(164) = lu(164) * lu(162) + lu(165) = lu(165) * lu(162) + lu(166) = lu(166) * lu(162) + lu(167) = lu(167) * lu(162) + lu(168) = lu(168) * lu(162) + lu(169) = lu(169) * lu(162) + lu(1042) = - lu(163) * lu(1035) + lu(1050) = - lu(164) * lu(1035) + lu(1052) = lu(1052) - lu(165) * lu(1035) + lu(1054) = lu(1054) - lu(166) * lu(1035) + lu(1061) = lu(1061) - lu(167) * lu(1035) + lu(1067) = lu(1067) - lu(168) * lu(1035) + lu(1072) = lu(1072) - lu(169) * lu(1035) + lu(1479) = lu(1479) - lu(163) * lu(1451) + lu(1492) = lu(1492) - lu(164) * lu(1451) + lu(1496) = lu(1496) - lu(165) * lu(1451) + lu(1509) = lu(1509) - lu(166) * lu(1451) + lu(1516) = lu(1516) - lu(167) * lu(1451) + lu(1522) = lu(1522) - lu(168) * lu(1451) + lu(1527) = lu(1527) - lu(169) * lu(1451) + lu(170) = 1._r8 / lu(170) + lu(171) = lu(171) * lu(170) + lu(172) = lu(172) * lu(170) + lu(173) = lu(173) * lu(170) + lu(174) = lu(174) * lu(170) + lu(175) = lu(175) * lu(170) + lu(269) = lu(269) - lu(171) * lu(268) + lu(270) = lu(270) - lu(172) * lu(268) + lu(271) = lu(271) - lu(173) * lu(268) + lu(272) = lu(272) - lu(174) * lu(268) + lu(276) = - lu(175) * lu(268) + lu(1268) = lu(1268) - lu(171) * lu(1257) + lu(1269) = - lu(172) * lu(1257) + lu(1279) = - lu(173) * lu(1257) + lu(1297) = - lu(174) * lu(1257) + lu(1321) = lu(1321) - lu(175) * lu(1257) + lu(1464) = lu(1464) - lu(171) * lu(1452) + lu(1465) = lu(1465) - lu(172) * lu(1452) + lu(1480) = lu(1480) - lu(173) * lu(1452) + lu(1502) = lu(1502) - lu(174) * lu(1452) + lu(1527) = lu(1527) - lu(175) * lu(1452) + lu(177) = 1._r8 / lu(177) + lu(178) = lu(178) * lu(177) + lu(179) = lu(179) * lu(177) + lu(180) = lu(180) * lu(177) + lu(181) = lu(181) * lu(177) + lu(182) = lu(182) * lu(177) + lu(985) = lu(985) - lu(178) * lu(978) + lu(990) = lu(990) - lu(179) * lu(978) + lu(1019) = lu(1019) - lu(180) * lu(978) + lu(1023) = lu(1023) - lu(181) * lu(978) + lu(1027) = lu(1027) - lu(182) * lu(978) + lu(1269) = lu(1269) - lu(178) * lu(1258) + lu(1279) = lu(1279) - lu(179) * lu(1258) + lu(1309) = lu(1309) - lu(180) * lu(1258) + lu(1313) = lu(1313) - lu(181) * lu(1258) + lu(1317) = lu(1317) - lu(182) * lu(1258) + lu(1465) = lu(1465) - lu(178) * lu(1453) + lu(1480) = lu(1480) - lu(179) * lu(1453) + lu(1515) = lu(1515) - lu(180) * lu(1453) + lu(1519) = lu(1519) - lu(181) * lu(1453) + lu(1523) = lu(1523) - lu(182) * lu(1453) + end subroutine lu_fac04 + subroutine lu_fac05( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(183) = 1._r8 / lu(183) + lu(184) = lu(184) * lu(183) + lu(185) = lu(185) * lu(183) + lu(186) = lu(186) * lu(183) + lu(397) = - lu(184) * lu(389) + lu(400) = lu(400) - lu(185) * lu(389) + lu(403) = - lu(186) * lu(389) + lu(625) = - lu(184) * lu(618) + lu(630) = - lu(185) * lu(618) + lu(635) = lu(635) - lu(186) * lu(618) + lu(1008) = lu(1008) - lu(184) * lu(979) + lu(1023) = lu(1023) - lu(185) * lu(979) + lu(1031) = lu(1031) - lu(186) * lu(979) + lu(1341) = lu(1341) - lu(184) * lu(1326) + lu(1357) = lu(1357) - lu(185) * lu(1326) + lu(1365) = lu(1365) - lu(186) * lu(1326) + lu(1502) = lu(1502) - lu(184) * lu(1454) + lu(1519) = lu(1519) - lu(185) * lu(1454) + lu(1527) = lu(1527) - lu(186) * lu(1454) + lu(187) = 1._r8 / lu(187) + lu(188) = lu(188) * lu(187) + lu(189) = lu(189) * lu(187) + lu(190) = lu(190) * lu(187) + lu(191) = lu(191) * lu(187) + lu(192) = lu(192) * lu(187) + lu(539) = lu(539) - lu(188) * lu(538) + lu(540) = lu(540) - lu(189) * lu(538) + lu(549) = lu(549) - lu(190) * lu(538) + lu(550) = - lu(191) * lu(538) + lu(551) = - lu(192) * lu(538) + lu(1278) = - lu(188) * lu(1259) + lu(1287) = lu(1287) - lu(189) * lu(1259) + lu(1317) = lu(1317) - lu(190) * lu(1259) + lu(1319) = lu(1319) - lu(191) * lu(1259) + lu(1321) = lu(1321) - lu(192) * lu(1259) + lu(1478) = lu(1478) - lu(188) * lu(1455) + lu(1488) = lu(1488) - lu(189) * lu(1455) + lu(1523) = lu(1523) - lu(190) * lu(1455) + lu(1525) = lu(1525) - lu(191) * lu(1455) + lu(1527) = lu(1527) - lu(192) * lu(1455) + lu(193) = 1._r8 / lu(193) + lu(194) = lu(194) * lu(193) + lu(195) = lu(195) * lu(193) + lu(196) = lu(196) * lu(193) + lu(197) = lu(197) * lu(193) + lu(198) = lu(198) * lu(193) + lu(652) = lu(652) - lu(194) * lu(650) + lu(655) = lu(655) - lu(195) * lu(650) + lu(660) = lu(660) - lu(196) * lu(650) + lu(662) = - lu(197) * lu(650) + lu(663) = - lu(198) * lu(650) + lu(1293) = lu(1293) - lu(194) * lu(1260) + lu(1303) = lu(1303) - lu(195) * lu(1260) + lu(1315) = lu(1315) - lu(196) * lu(1260) + lu(1319) = lu(1319) - lu(197) * lu(1260) + lu(1321) = lu(1321) - lu(198) * lu(1260) + lu(1498) = lu(1498) - lu(194) * lu(1456) + lu(1508) = lu(1508) - lu(195) * lu(1456) + lu(1521) = lu(1521) - lu(196) * lu(1456) + lu(1525) = lu(1525) - lu(197) * lu(1456) + lu(1527) = lu(1527) - lu(198) * lu(1456) + lu(199) = 1._r8 / lu(199) + lu(200) = lu(200) * lu(199) + lu(201) = lu(201) * lu(199) + lu(202) = lu(202) * lu(199) + lu(203) = lu(203) * lu(199) + lu(204) = lu(204) * lu(199) + lu(986) = lu(986) - lu(200) * lu(980) + lu(1019) = lu(1019) - lu(201) * lu(980) + lu(1023) = lu(1023) - lu(202) * lu(980) + lu(1025) = lu(1025) - lu(203) * lu(980) + lu(1027) = lu(1027) - lu(204) * lu(980) + lu(1207) = - lu(200) * lu(1206) + lu(1216) = - lu(201) * lu(1206) + lu(1220) = - lu(202) * lu(1206) + lu(1222) = lu(1222) - lu(203) * lu(1206) + lu(1224) = lu(1224) - lu(204) * lu(1206) + lu(1270) = lu(1270) - lu(200) * lu(1261) + lu(1309) = lu(1309) - lu(201) * lu(1261) + lu(1313) = lu(1313) - lu(202) * lu(1261) + lu(1315) = lu(1315) - lu(203) * lu(1261) + lu(1317) = lu(1317) - lu(204) * lu(1261) + lu(205) = 1._r8 / lu(205) + lu(206) = lu(206) * lu(205) + lu(207) = lu(207) * lu(205) + lu(208) = lu(208) * lu(205) + lu(209) = lu(209) * lu(205) + lu(210) = lu(210) * lu(205) + lu(909) = lu(909) - lu(206) * lu(889) + lu(915) = lu(915) - lu(207) * lu(889) + lu(916) = - lu(208) * lu(889) + lu(919) = - lu(209) * lu(889) + lu(921) = lu(921) - lu(210) * lu(889) + lu(1306) = lu(1306) - lu(206) * lu(1262) + lu(1315) = lu(1315) - lu(207) * lu(1262) + lu(1316) = lu(1316) - lu(208) * lu(1262) + lu(1319) = lu(1319) - lu(209) * lu(1262) + lu(1321) = lu(1321) - lu(210) * lu(1262) + lu(1512) = lu(1512) - lu(206) * lu(1457) + lu(1521) = lu(1521) - lu(207) * lu(1457) + lu(1522) = lu(1522) - lu(208) * lu(1457) + lu(1525) = lu(1525) - lu(209) * lu(1457) + lu(1527) = lu(1527) - lu(210) * lu(1457) + lu(211) = 1._r8 / lu(211) + lu(212) = lu(212) * lu(211) + lu(213) = lu(213) * lu(211) + lu(214) = lu(214) * lu(211) + lu(215) = lu(215) * lu(211) + lu(360) = - lu(212) * lu(358) + lu(363) = - lu(213) * lu(358) + lu(365) = - lu(214) * lu(358) + lu(368) = lu(368) - lu(215) * lu(358) + lu(392) = - lu(212) * lu(390) + lu(395) = - lu(213) * lu(390) + lu(398) = - lu(214) * lu(390) + lu(403) = lu(403) - lu(215) * lu(390) + lu(987) = lu(987) - lu(212) * lu(981) + lu(998) = lu(998) - lu(213) * lu(981) + lu(1014) = lu(1014) - lu(214) * lu(981) + lu(1031) = lu(1031) - lu(215) * lu(981) + lu(1476) = lu(1476) - lu(212) * lu(1458) + lu(1486) = lu(1486) - lu(213) * lu(1458) + lu(1508) = lu(1508) - lu(214) * lu(1458) + lu(1527) = lu(1527) - lu(215) * lu(1458) + end subroutine lu_fac05 + subroutine lu_fac06( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(216) = 1._r8 / lu(216) + lu(217) = lu(217) * lu(216) + lu(218) = lu(218) * lu(216) + lu(219) = lu(219) * lu(216) + lu(220) = lu(220) * lu(216) + lu(424) = - lu(217) * lu(422) + lu(425) = - lu(218) * lu(422) + lu(428) = lu(428) - lu(219) * lu(422) + lu(429) = lu(429) - lu(220) * lu(422) + lu(935) = lu(935) - lu(217) * lu(925) + lu(940) = lu(940) - lu(218) * lu(925) + lu(947) = - lu(219) * lu(925) + lu(949) = lu(949) - lu(220) * lu(925) + lu(1000) = lu(1000) - lu(217) * lu(982) + lu(1017) = lu(1017) - lu(218) * lu(982) + lu(1025) = lu(1025) - lu(219) * lu(982) + lu(1027) = lu(1027) - lu(220) * lu(982) + lu(1288) = - lu(217) * lu(1263) + lu(1307) = lu(1307) - lu(218) * lu(1263) + lu(1315) = lu(1315) - lu(219) * lu(1263) + lu(1317) = lu(1317) - lu(220) * lu(1263) + lu(221) = 1._r8 / lu(221) + lu(222) = lu(222) * lu(221) + lu(223) = lu(223) * lu(221) + lu(224) = lu(224) * lu(221) + lu(225) = lu(225) * lu(221) + lu(226) = lu(226) * lu(221) + lu(227) = lu(227) * lu(221) + lu(594) = lu(594) - lu(222) * lu(593) + lu(595) = lu(595) - lu(223) * lu(593) + lu(597) = lu(597) - lu(224) * lu(593) + lu(598) = lu(598) - lu(225) * lu(593) + lu(603) = lu(603) - lu(226) * lu(593) + lu(605) = - lu(227) * lu(593) + lu(1278) = lu(1278) - lu(222) * lu(1264) + lu(1290) = lu(1290) - lu(223) * lu(1264) + lu(1295) = lu(1295) - lu(224) * lu(1264) + lu(1301) = lu(1301) - lu(225) * lu(1264) + lu(1317) = lu(1317) - lu(226) * lu(1264) + lu(1321) = lu(1321) - lu(227) * lu(1264) + lu(1478) = lu(1478) - lu(222) * lu(1459) + lu(1493) = lu(1493) - lu(223) * lu(1459) + lu(1500) = lu(1500) - lu(224) * lu(1459) + lu(1506) = lu(1506) - lu(225) * lu(1459) + lu(1523) = lu(1523) - lu(226) * lu(1459) + lu(1527) = lu(1527) - lu(227) * lu(1459) + lu(229) = 1._r8 / lu(229) + lu(230) = lu(230) * lu(229) + lu(231) = lu(231) * lu(229) + lu(232) = lu(232) * lu(229) + lu(233) = lu(233) * lu(229) + lu(234) = lu(234) * lu(229) + lu(235) = lu(235) * lu(229) + lu(985) = lu(985) - lu(230) * lu(983) + lu(990) = lu(990) - lu(231) * lu(983) + lu(1008) = lu(1008) - lu(232) * lu(983) + lu(1019) = lu(1019) - lu(233) * lu(983) + lu(1023) = lu(1023) - lu(234) * lu(983) + lu(1027) = lu(1027) - lu(235) * lu(983) + lu(1269) = lu(1269) - lu(230) * lu(1265) + lu(1279) = lu(1279) - lu(231) * lu(1265) + lu(1297) = lu(1297) - lu(232) * lu(1265) + lu(1309) = lu(1309) - lu(233) * lu(1265) + lu(1313) = lu(1313) - lu(234) * lu(1265) + lu(1317) = lu(1317) - lu(235) * lu(1265) + lu(1465) = lu(1465) - lu(230) * lu(1460) + lu(1480) = lu(1480) - lu(231) * lu(1460) + lu(1502) = lu(1502) - lu(232) * lu(1460) + lu(1515) = lu(1515) - lu(233) * lu(1460) + lu(1519) = lu(1519) - lu(234) * lu(1460) + lu(1523) = lu(1523) - lu(235) * lu(1460) + lu(236) = 1._r8 / lu(236) + lu(237) = lu(237) * lu(236) + lu(238) = lu(238) * lu(236) + lu(239) = lu(239) * lu(236) + lu(240) = lu(240) * lu(236) + lu(241) = lu(241) * lu(236) + lu(242) = lu(242) * lu(236) + lu(1166) = lu(1166) - lu(237) * lu(1147) + lu(1172) = lu(1172) - lu(238) * lu(1147) + lu(1176) = lu(1176) - lu(239) * lu(1147) + lu(1177) = lu(1177) - lu(240) * lu(1147) + lu(1178) = - lu(241) * lu(1147) + lu(1180) = lu(1180) - lu(242) * lu(1147) + lu(1307) = lu(1307) - lu(237) * lu(1266) + lu(1313) = lu(1313) - lu(238) * lu(1266) + lu(1317) = lu(1317) - lu(239) * lu(1266) + lu(1318) = lu(1318) - lu(240) * lu(1266) + lu(1319) = lu(1319) - lu(241) * lu(1266) + lu(1321) = lu(1321) - lu(242) * lu(1266) + lu(1513) = lu(1513) - lu(237) * lu(1461) + lu(1519) = lu(1519) - lu(238) * lu(1461) + lu(1523) = lu(1523) - lu(239) * lu(1461) + lu(1524) = lu(1524) - lu(240) * lu(1461) + lu(1525) = lu(1525) - lu(241) * lu(1461) + lu(1527) = lu(1527) - lu(242) * lu(1461) + lu(243) = 1._r8 / lu(243) + lu(244) = lu(244) * lu(243) + lu(245) = lu(245) * lu(243) + lu(246) = lu(246) * lu(243) + lu(247) = lu(247) * lu(243) + lu(248) = lu(248) * lu(243) + lu(249) = lu(249) * lu(243) + lu(826) = lu(826) - lu(244) * lu(812) + lu(827) = lu(827) - lu(245) * lu(812) + lu(832) = lu(832) - lu(246) * lu(812) + lu(833) = lu(833) - lu(247) * lu(812) + lu(836) = - lu(248) * lu(812) + lu(838) = lu(838) - lu(249) * lu(812) + lu(1161) = lu(1161) - lu(244) * lu(1148) + lu(1165) = - lu(245) * lu(1148) + lu(1172) = lu(1172) - lu(246) * lu(1148) + lu(1174) = - lu(247) * lu(1148) + lu(1177) = lu(1177) - lu(248) * lu(1148) + lu(1180) = lu(1180) - lu(249) * lu(1148) + lu(1508) = lu(1508) - lu(244) * lu(1462) + lu(1512) = lu(1512) - lu(245) * lu(1462) + lu(1519) = lu(1519) - lu(246) * lu(1462) + lu(1521) = lu(1521) - lu(247) * lu(1462) + lu(1524) = lu(1524) - lu(248) * lu(1462) + lu(1527) = lu(1527) - lu(249) * lu(1462) + lu(250) = 1._r8 / lu(250) + lu(251) = lu(251) * lu(250) + lu(252) = lu(252) * lu(250) + lu(253) = lu(253) * lu(250) + lu(254) = lu(254) * lu(250) + lu(255) = lu(255) * lu(250) + lu(256) = lu(256) * lu(250) + lu(505) = - lu(251) * lu(504) + lu(506) = lu(506) - lu(252) * lu(504) + lu(507) = lu(507) - lu(253) * lu(504) + lu(509) = lu(509) - lu(254) * lu(504) + lu(511) = lu(511) - lu(255) * lu(504) + lu(513) = lu(513) - lu(256) * lu(504) + lu(928) = lu(928) - lu(251) * lu(926) + lu(931) = lu(931) - lu(252) * lu(926) + lu(932) = lu(932) - lu(253) * lu(926) + lu(934) = lu(934) - lu(254) * lu(926) + lu(940) = lu(940) - lu(255) * lu(926) + lu(942) = lu(942) - lu(256) * lu(926) + lu(1040) = lu(1040) - lu(251) * lu(1036) + lu(1044) = - lu(252) * lu(1036) + lu(1045) = lu(1045) - lu(253) * lu(1036) + lu(1048) = lu(1048) - lu(254) * lu(1036) + lu(1058) = lu(1058) - lu(255) * lu(1036) + lu(1061) = lu(1061) - lu(256) * lu(1036) + end subroutine lu_fac06 + subroutine lu_fac07( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(257) = 1._r8 / lu(257) + lu(258) = lu(258) * lu(257) + lu(259) = lu(259) * lu(257) + lu(260) = lu(260) * lu(257) + lu(261) = lu(261) * lu(257) + lu(383) = lu(383) - lu(258) * lu(377) + lu(385) = lu(385) - lu(259) * lu(377) + lu(386) = - lu(260) * lu(377) + lu(388) = - lu(261) * lu(377) + lu(460) = lu(460) - lu(258) * lu(457) + lu(461) = - lu(259) * lu(457) + lu(462) = - lu(260) * lu(457) + lu(464) = - lu(261) * lu(457) + lu(470) = lu(470) - lu(258) * lu(465) + lu(472) = - lu(259) * lu(465) + lu(473) = - lu(260) * lu(465) + lu(475) = lu(475) - lu(261) * lu(465) + lu(934) = lu(934) - lu(258) * lu(927) + lu(940) = lu(940) - lu(259) * lu(927) + lu(941) = lu(941) - lu(260) * lu(927) + lu(944) = lu(944) - lu(261) * lu(927) + lu(1048) = lu(1048) - lu(258) * lu(1037) + lu(1058) = lu(1058) - lu(259) * lu(1037) + lu(1060) = lu(1060) - lu(260) * lu(1037) + lu(1063) = - lu(261) * lu(1037) + lu(262) = 1._r8 / lu(262) + lu(263) = lu(263) * lu(262) + lu(264) = lu(264) * lu(262) + lu(265) = lu(265) * lu(262) + lu(266) = lu(266) * lu(262) + lu(267) = lu(267) * lu(262) + lu(798) = lu(798) - lu(263) * lu(792) + lu(799) = lu(799) - lu(264) * lu(792) + lu(805) = lu(805) - lu(265) * lu(792) + lu(809) = - lu(266) * lu(792) + lu(810) = - lu(267) * lu(792) + lu(826) = lu(826) - lu(263) * lu(813) + lu(827) = lu(827) - lu(264) * lu(813) + lu(833) = lu(833) - lu(265) * lu(813) + lu(837) = - lu(266) * lu(813) + lu(838) = lu(838) - lu(267) * lu(813) + lu(1303) = lu(1303) - lu(263) * lu(1267) + lu(1306) = lu(1306) - lu(264) * lu(1267) + lu(1315) = lu(1315) - lu(265) * lu(1267) + lu(1319) = lu(1319) - lu(266) * lu(1267) + lu(1321) = lu(1321) - lu(267) * lu(1267) + lu(1508) = lu(1508) - lu(263) * lu(1463) + lu(1512) = lu(1512) - lu(264) * lu(1463) + lu(1521) = lu(1521) - lu(265) * lu(1463) + lu(1525) = lu(1525) - lu(266) * lu(1463) + lu(1527) = lu(1527) - lu(267) * lu(1463) + lu(269) = 1._r8 / lu(269) + lu(270) = lu(270) * lu(269) + lu(271) = lu(271) * lu(269) + lu(272) = lu(272) * lu(269) + lu(273) = lu(273) * lu(269) + lu(274) = lu(274) * lu(269) + lu(275) = lu(275) * lu(269) + lu(276) = lu(276) * lu(269) + lu(985) = lu(985) - lu(270) * lu(984) + lu(990) = lu(990) - lu(271) * lu(984) + lu(1008) = lu(1008) - lu(272) * lu(984) + lu(1019) = lu(1019) - lu(273) * lu(984) + lu(1023) = lu(1023) - lu(274) * lu(984) + lu(1027) = lu(1027) - lu(275) * lu(984) + lu(1031) = lu(1031) - lu(276) * lu(984) + lu(1269) = lu(1269) - lu(270) * lu(1268) + lu(1279) = lu(1279) - lu(271) * lu(1268) + lu(1297) = lu(1297) - lu(272) * lu(1268) + lu(1309) = lu(1309) - lu(273) * lu(1268) + lu(1313) = lu(1313) - lu(274) * lu(1268) + lu(1317) = lu(1317) - lu(275) * lu(1268) + lu(1321) = lu(1321) - lu(276) * lu(1268) + lu(1465) = lu(1465) - lu(270) * lu(1464) + lu(1480) = lu(1480) - lu(271) * lu(1464) + lu(1502) = lu(1502) - lu(272) * lu(1464) + lu(1515) = lu(1515) - lu(273) * lu(1464) + lu(1519) = lu(1519) - lu(274) * lu(1464) + lu(1523) = lu(1523) - lu(275) * lu(1464) + lu(1527) = lu(1527) - lu(276) * lu(1464) + lu(277) = 1._r8 / lu(277) + lu(278) = lu(278) * lu(277) + lu(279) = lu(279) * lu(277) + lu(280) = lu(280) * lu(277) + lu(281) = lu(281) * lu(277) + lu(282) = lu(282) * lu(277) + lu(990) = lu(990) - lu(278) * lu(985) + lu(1003) = lu(1003) - lu(279) * lu(985) + lu(1008) = lu(1008) - lu(280) * lu(985) + lu(1014) = lu(1014) - lu(281) * lu(985) + lu(1027) = lu(1027) - lu(282) * lu(985) + lu(1152) = - lu(278) * lu(1149) + lu(1157) = - lu(279) * lu(1149) + lu(1159) = - lu(280) * lu(1149) + lu(1161) = lu(1161) - lu(281) * lu(1149) + lu(1176) = lu(1176) - lu(282) * lu(1149) + lu(1279) = lu(1279) - lu(278) * lu(1269) + lu(1291) = - lu(279) * lu(1269) + lu(1297) = lu(1297) - lu(280) * lu(1269) + lu(1303) = lu(1303) - lu(281) * lu(1269) + lu(1317) = lu(1317) - lu(282) * lu(1269) + lu(1480) = lu(1480) - lu(278) * lu(1465) + lu(1496) = lu(1496) - lu(279) * lu(1465) + lu(1502) = lu(1502) - lu(280) * lu(1465) + lu(1508) = lu(1508) - lu(281) * lu(1465) + lu(1523) = lu(1523) - lu(282) * lu(1465) + lu(283) = 1._r8 / lu(283) + lu(284) = lu(284) * lu(283) + lu(285) = lu(285) * lu(283) + lu(286) = lu(286) * lu(283) + lu(287) = lu(287) * lu(283) + lu(288) = lu(288) * lu(283) + lu(289) = lu(289) * lu(283) + lu(290) = lu(290) * lu(283) + lu(795) = - lu(284) * lu(793) + lu(797) = lu(797) - lu(285) * lu(793) + lu(804) = lu(804) - lu(286) * lu(793) + lu(805) = lu(805) - lu(287) * lu(793) + lu(807) = lu(807) - lu(288) * lu(793) + lu(808) = lu(808) - lu(289) * lu(793) + lu(810) = lu(810) - lu(290) * lu(793) + lu(1158) = - lu(284) * lu(1150) + lu(1160) = lu(1160) - lu(285) * lu(1150) + lu(1172) = lu(1172) - lu(286) * lu(1150) + lu(1174) = lu(1174) - lu(287) * lu(1150) + lu(1176) = lu(1176) - lu(288) * lu(1150) + lu(1177) = lu(1177) - lu(289) * lu(1150) + lu(1180) = lu(1180) - lu(290) * lu(1150) + lu(1499) = lu(1499) - lu(284) * lu(1466) + lu(1507) = lu(1507) - lu(285) * lu(1466) + lu(1519) = lu(1519) - lu(286) * lu(1466) + lu(1521) = lu(1521) - lu(287) * lu(1466) + lu(1523) = lu(1523) - lu(288) * lu(1466) + lu(1524) = lu(1524) - lu(289) * lu(1466) + lu(1527) = lu(1527) - lu(290) * lu(1466) + lu(291) = 1._r8 / lu(291) + lu(292) = lu(292) * lu(291) + lu(293) = lu(293) * lu(291) + lu(294) = lu(294) * lu(291) + lu(295) = lu(295) * lu(291) + lu(296) = lu(296) * lu(291) + lu(297) = lu(297) * lu(291) + lu(298) = lu(298) * lu(291) + lu(1077) = lu(1077) - lu(292) * lu(1076) + lu(1081) = - lu(293) * lu(1076) + lu(1088) = lu(1088) - lu(294) * lu(1076) + lu(1107) = lu(1107) - lu(295) * lu(1076) + lu(1111) = lu(1111) - lu(296) * lu(1076) + lu(1113) = lu(1113) - lu(297) * lu(1076) + lu(1117) = lu(1117) - lu(298) * lu(1076) + lu(1397) = lu(1397) - lu(292) * lu(1396) + lu(1400) = - lu(293) * lu(1396) + lu(1405) = lu(1405) - lu(294) * lu(1396) + lu(1416) = lu(1416) - lu(295) * lu(1396) + lu(1420) = lu(1420) - lu(296) * lu(1396) + lu(1422) = lu(1422) - lu(297) * lu(1396) + lu(1426) = lu(1426) - lu(298) * lu(1396) + lu(1468) = lu(1468) - lu(292) * lu(1467) + lu(1481) = lu(1481) - lu(293) * lu(1467) + lu(1496) = lu(1496) - lu(294) * lu(1467) + lu(1517) = lu(1517) - lu(295) * lu(1467) + lu(1521) = lu(1521) - lu(296) * lu(1467) + lu(1523) = lu(1523) - lu(297) * lu(1467) + lu(1527) = lu(1527) - lu(298) * lu(1467) + end subroutine lu_fac07 + subroutine lu_fac08( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(299) = 1._r8 / lu(299) + lu(300) = lu(300) * lu(299) + lu(301) = lu(301) * lu(299) + lu(302) = lu(302) * lu(299) + lu(1027) = lu(1027) - lu(300) * lu(986) + lu(1029) = - lu(301) * lu(986) + lu(1031) = lu(1031) - lu(302) * lu(986) + lu(1113) = lu(1113) - lu(300) * lu(1077) + lu(1115) = - lu(301) * lu(1077) + lu(1117) = lu(1117) - lu(302) * lu(1077) + lu(1224) = lu(1224) - lu(300) * lu(1207) + lu(1226) = lu(1226) - lu(301) * lu(1207) + lu(1228) = lu(1228) - lu(302) * lu(1207) + lu(1317) = lu(1317) - lu(300) * lu(1270) + lu(1319) = lu(1319) - lu(301) * lu(1270) + lu(1321) = lu(1321) - lu(302) * lu(1270) + lu(1422) = lu(1422) - lu(300) * lu(1397) + lu(1424) = lu(1424) - lu(301) * lu(1397) + lu(1426) = lu(1426) - lu(302) * lu(1397) + lu(1523) = lu(1523) - lu(300) * lu(1468) + lu(1525) = lu(1525) - lu(301) * lu(1468) + lu(1527) = lu(1527) - lu(302) * lu(1468) + lu(303) = 1._r8 / lu(303) + lu(304) = lu(304) * lu(303) + lu(305) = lu(305) * lu(303) + lu(306) = lu(306) * lu(303) + lu(527) = lu(527) - lu(304) * lu(520) + lu(528) = lu(528) - lu(305) * lu(520) + lu(529) = lu(529) - lu(306) * lu(520) + lu(660) = lu(660) - lu(304) * lu(651) + lu(661) = lu(661) - lu(305) * lu(651) + lu(663) = lu(663) - lu(306) * lu(651) + lu(717) = lu(717) - lu(304) * lu(705) + lu(719) = lu(719) - lu(305) * lu(705) + lu(722) = lu(722) - lu(306) * lu(705) + lu(744) = lu(744) - lu(304) * lu(724) + lu(746) = lu(746) - lu(305) * lu(724) + lu(749) = lu(749) - lu(306) * lu(724) + lu(765) = lu(765) - lu(304) * lu(751) + lu(767) = lu(767) - lu(305) * lu(751) + lu(770) = lu(770) - lu(306) * lu(751) + lu(915) = lu(915) - lu(304) * lu(890) + lu(917) = lu(917) - lu(305) * lu(890) + lu(921) = lu(921) - lu(306) * lu(890) + lu(1521) = lu(1521) - lu(304) * lu(1469) + lu(1523) = lu(1523) - lu(305) * lu(1469) + lu(1527) = lu(1527) - lu(306) * lu(1469) + lu(307) = 1._r8 / lu(307) + lu(308) = lu(308) * lu(307) + lu(309) = lu(309) * lu(307) + lu(310) = lu(310) * lu(307) + lu(311) = lu(311) * lu(307) + lu(312) = lu(312) * lu(307) + lu(313) = lu(313) * lu(307) + lu(314) = lu(314) * lu(307) + lu(731) = lu(731) - lu(308) * lu(725) + lu(733) = lu(733) - lu(309) * lu(725) + lu(734) = lu(734) - lu(310) * lu(725) + lu(736) = lu(736) - lu(311) * lu(725) + lu(744) = lu(744) - lu(312) * lu(725) + lu(746) = lu(746) - lu(313) * lu(725) + lu(749) = lu(749) - lu(314) * lu(725) + lu(1295) = lu(1295) - lu(308) * lu(1271) + lu(1298) = lu(1298) - lu(309) * lu(1271) + lu(1299) = lu(1299) - lu(310) * lu(1271) + lu(1301) = lu(1301) - lu(311) * lu(1271) + lu(1315) = lu(1315) - lu(312) * lu(1271) + lu(1317) = lu(1317) - lu(313) * lu(1271) + lu(1321) = lu(1321) - lu(314) * lu(1271) + lu(1500) = lu(1500) - lu(308) * lu(1470) + lu(1503) = lu(1503) - lu(309) * lu(1470) + lu(1504) = lu(1504) - lu(310) * lu(1470) + lu(1506) = lu(1506) - lu(311) * lu(1470) + lu(1521) = lu(1521) - lu(312) * lu(1470) + lu(1523) = lu(1523) - lu(313) * lu(1470) + lu(1527) = lu(1527) - lu(314) * lu(1470) + lu(315) = 1._r8 / lu(315) + lu(316) = lu(316) * lu(315) + lu(317) = lu(317) * lu(315) + lu(318) = lu(318) * lu(315) + lu(319) = lu(319) * lu(315) + lu(320) = lu(320) * lu(315) + lu(321) = lu(321) * lu(315) + lu(322) = lu(322) * lu(315) + lu(1043) = lu(1043) - lu(316) * lu(1038) + lu(1056) = lu(1056) - lu(317) * lu(1038) + lu(1059) = - lu(318) * lu(1038) + lu(1061) = lu(1061) - lu(319) * lu(1038) + lu(1064) = lu(1064) - lu(320) * lu(1038) + lu(1065) = lu(1065) - lu(321) * lu(1038) + lu(1069) = lu(1069) - lu(322) * lu(1038) + lu(1153) = - lu(316) * lu(1151) + lu(1164) = - lu(317) * lu(1151) + lu(1167) = lu(1167) - lu(318) * lu(1151) + lu(1169) = lu(1169) - lu(319) * lu(1151) + lu(1172) = lu(1172) - lu(320) * lu(1151) + lu(1173) = lu(1173) - lu(321) * lu(1151) + lu(1177) = lu(1177) - lu(322) * lu(1151) + lu(1185) = lu(1185) - lu(316) * lu(1184) + lu(1189) = lu(1189) - lu(317) * lu(1184) + lu(1191) = - lu(318) * lu(1184) + lu(1193) = lu(1193) - lu(319) * lu(1184) + lu(1196) = lu(1196) - lu(320) * lu(1184) + lu(1197) = lu(1197) - lu(321) * lu(1184) + lu(1201) = - lu(322) * lu(1184) + lu(323) = 1._r8 / lu(323) + lu(324) = lu(324) * lu(323) + lu(325) = lu(325) * lu(323) + lu(326) = lu(326) * lu(323) + lu(327) = lu(327) * lu(323) + lu(328) = lu(328) * lu(323) + lu(329) = lu(329) * lu(323) + lu(330) = lu(330) * lu(323) + lu(487) = lu(487) - lu(324) * lu(486) + lu(488) = lu(488) - lu(325) * lu(486) + lu(489) = - lu(326) * lu(486) + lu(493) = lu(493) - lu(327) * lu(486) + lu(494) = lu(494) - lu(328) * lu(486) + lu(495) = - lu(329) * lu(486) + lu(496) = - lu(330) * lu(486) + lu(1283) = lu(1283) - lu(324) * lu(1272) + lu(1292) = lu(1292) - lu(325) * lu(1272) + lu(1294) = - lu(326) * lu(1272) + lu(1315) = lu(1315) - lu(327) * lu(1272) + lu(1317) = lu(1317) - lu(328) * lu(1272) + lu(1319) = lu(1319) - lu(329) * lu(1272) + lu(1321) = lu(1321) - lu(330) * lu(1272) + lu(1483) = lu(1483) - lu(324) * lu(1471) + lu(1497) = lu(1497) - lu(325) * lu(1471) + lu(1499) = lu(1499) - lu(326) * lu(1471) + lu(1521) = lu(1521) - lu(327) * lu(1471) + lu(1523) = lu(1523) - lu(328) * lu(1471) + lu(1525) = lu(1525) - lu(329) * lu(1471) + lu(1527) = lu(1527) - lu(330) * lu(1471) + lu(331) = 1._r8 / lu(331) + lu(332) = lu(332) * lu(331) + lu(333) = lu(333) * lu(331) + lu(334) = lu(334) * lu(331) + lu(335) = lu(335) * lu(331) + lu(336) = lu(336) * lu(331) + lu(337) = lu(337) * lu(331) + lu(338) = lu(338) * lu(331) + lu(339) = lu(339) * lu(331) + lu(1086) = - lu(332) * lu(1078) + lu(1092) = lu(1092) - lu(333) * lu(1078) + lu(1097) = lu(1097) - lu(334) * lu(1078) + lu(1107) = lu(1107) - lu(335) * lu(1078) + lu(1109) = lu(1109) - lu(336) * lu(1078) + lu(1113) = lu(1113) - lu(337) * lu(1078) + lu(1114) = lu(1114) - lu(338) * lu(1078) + lu(1117) = lu(1117) - lu(339) * lu(1078) + lu(1334) = lu(1334) - lu(332) * lu(1327) + lu(1340) = lu(1340) - lu(333) * lu(1327) + lu(1345) = lu(1345) - lu(334) * lu(1327) + lu(1355) = - lu(335) * lu(1327) + lu(1357) = lu(1357) - lu(336) * lu(1327) + lu(1361) = lu(1361) - lu(337) * lu(1327) + lu(1362) = lu(1362) - lu(338) * lu(1327) + lu(1365) = lu(1365) - lu(339) * lu(1327) + lu(1493) = lu(1493) - lu(332) * lu(1472) + lu(1500) = lu(1500) - lu(333) * lu(1472) + lu(1506) = lu(1506) - lu(334) * lu(1472) + lu(1517) = lu(1517) - lu(335) * lu(1472) + lu(1519) = lu(1519) - lu(336) * lu(1472) + lu(1523) = lu(1523) - lu(337) * lu(1472) + lu(1524) = lu(1524) - lu(338) * lu(1472) + lu(1527) = lu(1527) - lu(339) * lu(1472) + end subroutine lu_fac08 + subroutine lu_fac09( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(340) = 1._r8 / lu(340) + lu(341) = lu(341) * lu(340) + lu(342) = lu(342) * lu(340) + lu(343) = lu(343) * lu(340) + lu(568) = - lu(341) * lu(558) + lu(575) = - lu(342) * lu(558) + lu(576) = lu(576) - lu(343) * lu(558) + lu(626) = lu(626) - lu(341) * lu(619) + lu(634) = - lu(342) * lu(619) + lu(635) = lu(635) - lu(343) * lu(619) + lu(799) = lu(799) - lu(341) * lu(794) + lu(809) = lu(809) - lu(342) * lu(794) + lu(810) = lu(810) - lu(343) * lu(794) + lu(827) = lu(827) - lu(341) * lu(814) + lu(837) = lu(837) - lu(342) * lu(814) + lu(838) = lu(838) - lu(343) * lu(814) + lu(909) = lu(909) - lu(341) * lu(891) + lu(919) = lu(919) - lu(342) * lu(891) + lu(921) = lu(921) - lu(343) * lu(891) + lu(1102) = lu(1102) - lu(341) * lu(1079) + lu(1115) = lu(1115) - lu(342) * lu(1079) + lu(1117) = lu(1117) - lu(343) * lu(1079) + lu(1306) = lu(1306) - lu(341) * lu(1273) + lu(1319) = lu(1319) - lu(342) * lu(1273) + lu(1321) = lu(1321) - lu(343) * lu(1273) + lu(1512) = lu(1512) - lu(341) * lu(1473) + lu(1525) = lu(1525) - lu(342) * lu(1473) + lu(1527) = lu(1527) - lu(343) * lu(1473) + lu(344) = 1._r8 / lu(344) + lu(345) = lu(345) * lu(344) + lu(346) = lu(346) * lu(344) + lu(347) = lu(347) * lu(344) + lu(348) = lu(348) * lu(344) + lu(349) = lu(349) * lu(344) + lu(350) = lu(350) * lu(344) + lu(1055) = lu(1055) - lu(345) * lu(1039) + lu(1061) = lu(1061) - lu(346) * lu(1039) + lu(1068) = lu(1068) - lu(347) * lu(1039) + lu(1070) = - lu(348) * lu(1039) + lu(1071) = lu(1071) - lu(349) * lu(1039) + lu(1072) = lu(1072) - lu(350) * lu(1039) + lu(1304) = lu(1304) - lu(345) * lu(1274) + lu(1310) = lu(1310) - lu(346) * lu(1274) + lu(1317) = lu(1317) - lu(347) * lu(1274) + lu(1319) = lu(1319) - lu(348) * lu(1274) + lu(1320) = lu(1320) - lu(349) * lu(1274) + lu(1321) = lu(1321) - lu(350) * lu(1274) + lu(1409) = lu(1409) - lu(345) * lu(1398) + lu(1415) = - lu(346) * lu(1398) + lu(1422) = lu(1422) - lu(347) * lu(1398) + lu(1424) = lu(1424) - lu(348) * lu(1398) + lu(1425) = lu(1425) - lu(349) * lu(1398) + lu(1426) = lu(1426) - lu(350) * lu(1398) + lu(1510) = lu(1510) - lu(345) * lu(1474) + lu(1516) = lu(1516) - lu(346) * lu(1474) + lu(1523) = lu(1523) - lu(347) * lu(1474) + lu(1525) = lu(1525) - lu(348) * lu(1474) + lu(1526) = lu(1526) - lu(349) * lu(1474) + lu(1527) = lu(1527) - lu(350) * lu(1474) + lu(351) = 1._r8 / lu(351) + lu(352) = lu(352) * lu(351) + lu(353) = lu(353) * lu(351) + lu(354) = lu(354) * lu(351) + lu(355) = lu(355) * lu(351) + lu(356) = lu(356) * lu(351) + lu(357) = lu(357) * lu(351) + lu(380) = lu(380) - lu(352) * lu(378) + lu(381) = lu(381) - lu(353) * lu(378) + lu(383) = lu(383) - lu(354) * lu(378) + lu(384) = - lu(355) * lu(378) + lu(385) = lu(385) - lu(356) * lu(378) + lu(387) = lu(387) - lu(357) * lu(378) + lu(506) = lu(506) - lu(352) * lu(505) + lu(507) = lu(507) - lu(353) * lu(505) + lu(509) = lu(509) - lu(354) * lu(505) + lu(510) = - lu(355) * lu(505) + lu(511) = lu(511) - lu(356) * lu(505) + lu(513) = lu(513) - lu(357) * lu(505) + lu(931) = lu(931) - lu(352) * lu(928) + lu(932) = lu(932) - lu(353) * lu(928) + lu(934) = lu(934) - lu(354) * lu(928) + lu(937) = - lu(355) * lu(928) + lu(940) = lu(940) - lu(356) * lu(928) + lu(942) = lu(942) - lu(357) * lu(928) + lu(1044) = lu(1044) - lu(352) * lu(1040) + lu(1045) = lu(1045) - lu(353) * lu(1040) + lu(1048) = lu(1048) - lu(354) * lu(1040) + lu(1052) = lu(1052) - lu(355) * lu(1040) + lu(1058) = lu(1058) - lu(356) * lu(1040) + lu(1061) = lu(1061) - lu(357) * lu(1040) + lu(359) = 1._r8 / lu(359) + lu(360) = lu(360) * lu(359) + lu(361) = lu(361) * lu(359) + lu(362) = lu(362) * lu(359) + lu(363) = lu(363) * lu(359) + lu(364) = lu(364) * lu(359) + lu(365) = lu(365) * lu(359) + lu(366) = lu(366) * lu(359) + lu(367) = lu(367) * lu(359) + lu(368) = lu(368) * lu(359) + lu(392) = lu(392) - lu(360) * lu(391) + lu(393) = lu(393) - lu(361) * lu(391) + lu(394) = lu(394) - lu(362) * lu(391) + lu(395) = lu(395) - lu(363) * lu(391) + lu(396) = lu(396) - lu(364) * lu(391) + lu(398) = lu(398) - lu(365) * lu(391) + lu(401) = lu(401) - lu(366) * lu(391) + lu(402) = lu(402) - lu(367) * lu(391) + lu(403) = lu(403) - lu(368) * lu(391) + lu(1276) = lu(1276) - lu(360) * lu(1275) + lu(1277) = lu(1277) - lu(361) * lu(1275) + lu(1278) = lu(1278) - lu(362) * lu(1275) + lu(1285) = lu(1285) - lu(363) * lu(1275) + lu(1292) = lu(1292) - lu(364) * lu(1275) + lu(1303) = lu(1303) - lu(365) * lu(1275) + lu(1315) = lu(1315) - lu(366) * lu(1275) + lu(1317) = lu(1317) - lu(367) * lu(1275) + lu(1321) = lu(1321) - lu(368) * lu(1275) + lu(1476) = lu(1476) - lu(360) * lu(1475) + lu(1477) = lu(1477) - lu(361) * lu(1475) + lu(1478) = lu(1478) - lu(362) * lu(1475) + lu(1486) = lu(1486) - lu(363) * lu(1475) + lu(1497) = lu(1497) - lu(364) * lu(1475) + lu(1508) = lu(1508) - lu(365) * lu(1475) + lu(1521) = lu(1521) - lu(366) * lu(1475) + lu(1523) = lu(1523) - lu(367) * lu(1475) + lu(1527) = lu(1527) - lu(368) * lu(1475) + lu(370) = 1._r8 / lu(370) + lu(371) = lu(371) * lu(370) + lu(372) = lu(372) * lu(370) + lu(373) = lu(373) * lu(370) + lu(374) = lu(374) * lu(370) + lu(375) = lu(375) * lu(370) + lu(376) = lu(376) * lu(370) + lu(396) = lu(396) - lu(371) * lu(392) + lu(398) = lu(398) - lu(372) * lu(392) + lu(399) = lu(399) - lu(373) * lu(392) + lu(400) = lu(400) - lu(374) * lu(392) + lu(402) = lu(402) - lu(375) * lu(392) + lu(403) = lu(403) - lu(376) * lu(392) + lu(1004) = lu(1004) - lu(371) * lu(987) + lu(1014) = lu(1014) - lu(372) * lu(987) + lu(1019) = lu(1019) - lu(373) * lu(987) + lu(1023) = lu(1023) - lu(374) * lu(987) + lu(1027) = lu(1027) - lu(375) * lu(987) + lu(1031) = lu(1031) - lu(376) * lu(987) + lu(1292) = lu(1292) - lu(371) * lu(1276) + lu(1303) = lu(1303) - lu(372) * lu(1276) + lu(1309) = lu(1309) - lu(373) * lu(1276) + lu(1313) = lu(1313) - lu(374) * lu(1276) + lu(1317) = lu(1317) - lu(375) * lu(1276) + lu(1321) = lu(1321) - lu(376) * lu(1276) + lu(1497) = lu(1497) - lu(371) * lu(1476) + lu(1508) = lu(1508) - lu(372) * lu(1476) + lu(1515) = lu(1515) - lu(373) * lu(1476) + lu(1519) = lu(1519) - lu(374) * lu(1476) + lu(1523) = lu(1523) - lu(375) * lu(1476) + lu(1527) = lu(1527) - lu(376) * lu(1476) + lu(379) = 1._r8 / lu(379) + lu(380) = lu(380) * lu(379) + lu(381) = lu(381) * lu(379) + lu(382) = lu(382) * lu(379) + lu(383) = lu(383) * lu(379) + lu(384) = lu(384) * lu(379) + lu(385) = lu(385) * lu(379) + lu(386) = lu(386) * lu(379) + lu(387) = lu(387) * lu(379) + lu(388) = lu(388) * lu(379) + lu(467) = lu(467) - lu(380) * lu(466) + lu(468) = lu(468) - lu(381) * lu(466) + lu(469) = lu(469) - lu(382) * lu(466) + lu(470) = lu(470) - lu(383) * lu(466) + lu(471) = - lu(384) * lu(466) + lu(472) = lu(472) - lu(385) * lu(466) + lu(473) = lu(473) - lu(386) * lu(466) + lu(474) = lu(474) - lu(387) * lu(466) + lu(475) = lu(475) - lu(388) * lu(466) + lu(931) = lu(931) - lu(380) * lu(929) + lu(932) = lu(932) - lu(381) * lu(929) + lu(933) = lu(933) - lu(382) * lu(929) + lu(934) = lu(934) - lu(383) * lu(929) + lu(937) = lu(937) - lu(384) * lu(929) + lu(940) = lu(940) - lu(385) * lu(929) + lu(941) = lu(941) - lu(386) * lu(929) + lu(942) = lu(942) - lu(387) * lu(929) + lu(944) = lu(944) - lu(388) * lu(929) + lu(1044) = lu(1044) - lu(380) * lu(1041) + lu(1045) = lu(1045) - lu(381) * lu(1041) + lu(1046) = lu(1046) - lu(382) * lu(1041) + lu(1048) = lu(1048) - lu(383) * lu(1041) + lu(1052) = lu(1052) - lu(384) * lu(1041) + lu(1058) = lu(1058) - lu(385) * lu(1041) + lu(1060) = lu(1060) - lu(386) * lu(1041) + lu(1061) = lu(1061) - lu(387) * lu(1041) + lu(1063) = lu(1063) - lu(388) * lu(1041) + end subroutine lu_fac09 + subroutine lu_fac10( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(393) = 1._r8 / lu(393) + lu(394) = lu(394) * lu(393) + lu(395) = lu(395) * lu(393) + lu(396) = lu(396) * lu(393) + lu(397) = lu(397) * lu(393) + lu(398) = lu(398) * lu(393) + lu(399) = lu(399) * lu(393) + lu(400) = lu(400) * lu(393) + lu(401) = lu(401) * lu(393) + lu(402) = lu(402) * lu(393) + lu(403) = lu(403) * lu(393) + lu(989) = lu(989) - lu(394) * lu(988) + lu(998) = lu(998) - lu(395) * lu(988) + lu(1004) = lu(1004) - lu(396) * lu(988) + lu(1008) = lu(1008) - lu(397) * lu(988) + lu(1014) = lu(1014) - lu(398) * lu(988) + lu(1019) = lu(1019) - lu(399) * lu(988) + lu(1023) = lu(1023) - lu(400) * lu(988) + lu(1025) = lu(1025) - lu(401) * lu(988) + lu(1027) = lu(1027) - lu(402) * lu(988) + lu(1031) = lu(1031) - lu(403) * lu(988) + lu(1278) = lu(1278) - lu(394) * lu(1277) + lu(1285) = lu(1285) - lu(395) * lu(1277) + lu(1292) = lu(1292) - lu(396) * lu(1277) + lu(1297) = lu(1297) - lu(397) * lu(1277) + lu(1303) = lu(1303) - lu(398) * lu(1277) + lu(1309) = lu(1309) - lu(399) * lu(1277) + lu(1313) = lu(1313) - lu(400) * lu(1277) + lu(1315) = lu(1315) - lu(401) * lu(1277) + lu(1317) = lu(1317) - lu(402) * lu(1277) + lu(1321) = lu(1321) - lu(403) * lu(1277) + lu(1478) = lu(1478) - lu(394) * lu(1477) + lu(1486) = lu(1486) - lu(395) * lu(1477) + lu(1497) = lu(1497) - lu(396) * lu(1477) + lu(1502) = lu(1502) - lu(397) * lu(1477) + lu(1508) = lu(1508) - lu(398) * lu(1477) + lu(1515) = lu(1515) - lu(399) * lu(1477) + lu(1519) = lu(1519) - lu(400) * lu(1477) + lu(1521) = lu(1521) - lu(401) * lu(1477) + lu(1523) = lu(1523) - lu(402) * lu(1477) + lu(1527) = lu(1527) - lu(403) * lu(1477) + lu(404) = 1._r8 / lu(404) + lu(405) = lu(405) * lu(404) + lu(406) = lu(406) * lu(404) + lu(407) = lu(407) * lu(404) + lu(408) = lu(408) * lu(404) + lu(409) = lu(409) * lu(404) + lu(542) = - lu(405) * lu(539) + lu(543) = - lu(406) * lu(539) + lu(544) = lu(544) - lu(407) * lu(539) + lu(550) = lu(550) - lu(408) * lu(539) + lu(551) = lu(551) - lu(409) * lu(539) + lu(596) = - lu(405) * lu(594) + lu(599) = - lu(406) * lu(594) + lu(600) = - lu(407) * lu(594) + lu(604) = - lu(408) * lu(594) + lu(605) = lu(605) - lu(409) * lu(594) + lu(899) = lu(899) - lu(405) * lu(892) + lu(908) = lu(908) - lu(406) * lu(892) + lu(909) = lu(909) - lu(407) * lu(892) + lu(919) = lu(919) - lu(408) * lu(892) + lu(921) = lu(921) - lu(409) * lu(892) + lu(1005) = lu(1005) - lu(405) * lu(989) + lu(1014) = lu(1014) - lu(406) * lu(989) + lu(1016) = lu(1016) - lu(407) * lu(989) + lu(1029) = lu(1029) - lu(408) * lu(989) + lu(1031) = lu(1031) - lu(409) * lu(989) + lu(1293) = lu(1293) - lu(405) * lu(1278) + lu(1303) = lu(1303) - lu(406) * lu(1278) + lu(1306) = lu(1306) - lu(407) * lu(1278) + lu(1319) = lu(1319) - lu(408) * lu(1278) + lu(1321) = lu(1321) - lu(409) * lu(1278) + lu(1498) = lu(1498) - lu(405) * lu(1478) + lu(1508) = lu(1508) - lu(406) * lu(1478) + lu(1512) = lu(1512) - lu(407) * lu(1478) + lu(1525) = lu(1525) - lu(408) * lu(1478) + lu(1527) = lu(1527) - lu(409) * lu(1478) + lu(410) = 1._r8 / lu(410) + lu(411) = lu(411) * lu(410) + lu(412) = lu(412) * lu(410) + lu(413) = lu(413) * lu(410) + lu(414) = lu(414) * lu(410) + lu(415) = lu(415) * lu(410) + lu(416) = lu(416) * lu(410) + lu(842) = lu(842) - lu(411) * lu(840) + lu(844) = lu(844) - lu(412) * lu(840) + lu(846) = lu(846) - lu(413) * lu(840) + lu(847) = lu(847) - lu(414) * lu(840) + lu(850) = lu(850) - lu(415) * lu(840) + lu(854) = lu(854) - lu(416) * lu(840) + lu(938) = lu(938) - lu(411) * lu(930) + lu(940) = lu(940) - lu(412) * lu(930) + lu(942) = lu(942) - lu(413) * lu(930) + lu(943) = lu(943) - lu(414) * lu(930) + lu(948) = lu(948) - lu(415) * lu(930) + lu(952) = - lu(416) * lu(930) + lu(1054) = lu(1054) - lu(411) * lu(1042) + lu(1058) = lu(1058) - lu(412) * lu(1042) + lu(1061) = lu(1061) - lu(413) * lu(1042) + lu(1062) = lu(1062) - lu(414) * lu(1042) + lu(1067) = lu(1067) - lu(415) * lu(1042) + lu(1072) = lu(1072) - lu(416) * lu(1042) + lu(1100) = lu(1100) - lu(411) * lu(1080) + lu(1103) = lu(1103) - lu(412) * lu(1080) + lu(1106) = lu(1106) - lu(413) * lu(1080) + lu(1107) = lu(1107) - lu(414) * lu(1080) + lu(1112) = lu(1112) - lu(415) * lu(1080) + lu(1117) = lu(1117) - lu(416) * lu(1080) + lu(1509) = lu(1509) - lu(411) * lu(1479) + lu(1513) = lu(1513) - lu(412) * lu(1479) + lu(1516) = lu(1516) - lu(413) * lu(1479) + lu(1517) = lu(1517) - lu(414) * lu(1479) + lu(1522) = lu(1522) - lu(415) * lu(1479) + lu(1527) = lu(1527) - lu(416) * lu(1479) + lu(417) = 1._r8 / lu(417) + lu(418) = lu(418) * lu(417) + lu(419) = lu(419) * lu(417) + lu(420) = lu(420) * lu(417) + lu(554) = lu(554) - lu(418) * lu(552) + lu(556) = lu(556) - lu(419) * lu(552) + lu(557) = lu(557) - lu(420) * lu(552) + lu(708) = lu(708) - lu(418) * lu(706) + lu(719) = lu(719) - lu(419) * lu(706) + lu(722) = lu(722) - lu(420) * lu(706) + lu(729) = - lu(418) * lu(726) + lu(746) = lu(746) - lu(419) * lu(726) + lu(749) = lu(749) - lu(420) * lu(726) + lu(817) = lu(817) - lu(418) * lu(815) + lu(835) = lu(835) - lu(419) * lu(815) + lu(838) = lu(838) - lu(420) * lu(815) + lu(897) = lu(897) - lu(418) * lu(893) + lu(917) = lu(917) - lu(419) * lu(893) + lu(921) = lu(921) - lu(420) * lu(893) + lu(1003) = lu(1003) - lu(418) * lu(990) + lu(1027) = lu(1027) - lu(419) * lu(990) + lu(1031) = lu(1031) - lu(420) * lu(990) + lu(1157) = lu(1157) - lu(418) * lu(1152) + lu(1176) = lu(1176) - lu(419) * lu(1152) + lu(1180) = lu(1180) - lu(420) * lu(1152) + lu(1291) = lu(1291) - lu(418) * lu(1279) + lu(1317) = lu(1317) - lu(419) * lu(1279) + lu(1321) = lu(1321) - lu(420) * lu(1279) + lu(1336) = lu(1336) - lu(418) * lu(1328) + lu(1361) = lu(1361) - lu(419) * lu(1328) + lu(1365) = lu(1365) - lu(420) * lu(1328) + lu(1405) = lu(1405) - lu(418) * lu(1399) + lu(1422) = lu(1422) - lu(419) * lu(1399) + lu(1426) = lu(1426) - lu(420) * lu(1399) + lu(1496) = lu(1496) - lu(418) * lu(1480) + lu(1523) = lu(1523) - lu(419) * lu(1480) + lu(1527) = lu(1527) - lu(420) * lu(1480) + lu(423) = 1._r8 / lu(423) + lu(424) = lu(424) * lu(423) + lu(425) = lu(425) * lu(423) + lu(426) = lu(426) * lu(423) + lu(427) = lu(427) * lu(423) + lu(428) = lu(428) * lu(423) + lu(429) = lu(429) * lu(423) + lu(430) = lu(430) * lu(423) + lu(1000) = lu(1000) - lu(424) * lu(991) + lu(1017) = lu(1017) - lu(425) * lu(991) + lu(1019) = lu(1019) - lu(426) * lu(991) + lu(1023) = lu(1023) - lu(427) * lu(991) + lu(1025) = lu(1025) - lu(428) * lu(991) + lu(1027) = lu(1027) - lu(429) * lu(991) + lu(1031) = lu(1031) - lu(430) * lu(991) + lu(1082) = - lu(424) * lu(1081) + lu(1103) = lu(1103) - lu(425) * lu(1081) + lu(1105) = lu(1105) - lu(426) * lu(1081) + lu(1109) = lu(1109) - lu(427) * lu(1081) + lu(1111) = lu(1111) - lu(428) * lu(1081) + lu(1113) = lu(1113) - lu(429) * lu(1081) + lu(1117) = lu(1117) - lu(430) * lu(1081) + lu(1288) = lu(1288) - lu(424) * lu(1280) + lu(1307) = lu(1307) - lu(425) * lu(1280) + lu(1309) = lu(1309) - lu(426) * lu(1280) + lu(1313) = lu(1313) - lu(427) * lu(1280) + lu(1315) = lu(1315) - lu(428) * lu(1280) + lu(1317) = lu(1317) - lu(429) * lu(1280) + lu(1321) = lu(1321) - lu(430) * lu(1280) + lu(1403) = - lu(424) * lu(1400) + lu(1412) = lu(1412) - lu(425) * lu(1400) + lu(1414) = - lu(426) * lu(1400) + lu(1418) = - lu(427) * lu(1400) + lu(1420) = lu(1420) - lu(428) * lu(1400) + lu(1422) = lu(1422) - lu(429) * lu(1400) + lu(1426) = lu(1426) - lu(430) * lu(1400) + lu(1489) = lu(1489) - lu(424) * lu(1481) + lu(1513) = lu(1513) - lu(425) * lu(1481) + lu(1515) = lu(1515) - lu(426) * lu(1481) + lu(1519) = lu(1519) - lu(427) * lu(1481) + lu(1521) = lu(1521) - lu(428) * lu(1481) + lu(1523) = lu(1523) - lu(429) * lu(1481) + lu(1527) = lu(1527) - lu(430) * lu(1481) + lu(432) = 1._r8 / lu(432) + lu(433) = lu(433) * lu(432) + lu(434) = lu(434) * lu(432) + lu(435) = lu(435) * lu(432) + lu(436) = lu(436) * lu(432) + lu(437) = lu(437) * lu(432) + lu(438) = lu(438) * lu(432) + lu(439) = lu(439) * lu(432) + lu(861) = lu(861) - lu(433) * lu(858) + lu(862) = lu(862) - lu(434) * lu(858) + lu(864) = lu(864) - lu(435) * lu(858) + lu(867) = - lu(436) * lu(858) + lu(870) = lu(870) - lu(437) * lu(858) + lu(871) = lu(871) - lu(438) * lu(858) + lu(872) = lu(872) - lu(439) * lu(858) + lu(1055) = lu(1055) - lu(433) * lu(1043) + lu(1056) = lu(1056) - lu(434) * lu(1043) + lu(1061) = lu(1061) - lu(435) * lu(1043) + lu(1065) = lu(1065) - lu(436) * lu(1043) + lu(1070) = lu(1070) - lu(437) * lu(1043) + lu(1071) = lu(1071) - lu(438) * lu(1043) + lu(1072) = lu(1072) - lu(439) * lu(1043) + lu(1163) = - lu(433) * lu(1153) + lu(1164) = lu(1164) - lu(434) * lu(1153) + lu(1169) = lu(1169) - lu(435) * lu(1153) + lu(1173) = lu(1173) - lu(436) * lu(1153) + lu(1178) = lu(1178) - lu(437) * lu(1153) + lu(1179) = - lu(438) * lu(1153) + lu(1180) = lu(1180) - lu(439) * lu(1153) + lu(1188) = - lu(433) * lu(1185) + lu(1189) = lu(1189) - lu(434) * lu(1185) + lu(1193) = lu(1193) - lu(435) * lu(1185) + lu(1197) = lu(1197) - lu(436) * lu(1185) + lu(1202) = - lu(437) * lu(1185) + lu(1203) = lu(1203) - lu(438) * lu(1185) + lu(1204) = lu(1204) - lu(439) * lu(1185) + lu(1304) = lu(1304) - lu(433) * lu(1281) + lu(1305) = lu(1305) - lu(434) * lu(1281) + lu(1310) = lu(1310) - lu(435) * lu(1281) + lu(1314) = lu(1314) - lu(436) * lu(1281) + lu(1319) = lu(1319) - lu(437) * lu(1281) + lu(1320) = lu(1320) - lu(438) * lu(1281) + lu(1321) = lu(1321) - lu(439) * lu(1281) + end subroutine lu_fac10 + subroutine lu_fac11( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(441) = 1._r8 / lu(441) + lu(442) = lu(442) * lu(441) + lu(443) = lu(443) * lu(441) + lu(444) = lu(444) * lu(441) + lu(445) = lu(445) * lu(441) + lu(446) = lu(446) * lu(441) + lu(447) = lu(447) * lu(441) + lu(448) = lu(448) * lu(441) + lu(684) = lu(684) - lu(442) * lu(683) + lu(686) = - lu(443) * lu(683) + lu(687) = - lu(444) * lu(683) + lu(690) = lu(690) - lu(445) * lu(683) + lu(691) = - lu(446) * lu(683) + lu(692) = lu(692) - lu(447) * lu(683) + lu(694) = lu(694) - lu(448) * lu(683) + lu(956) = - lu(442) * lu(955) + lu(959) = - lu(443) * lu(955) + lu(961) = lu(961) - lu(444) * lu(955) + lu(969) = lu(969) - lu(445) * lu(955) + lu(971) = lu(971) - lu(446) * lu(955) + lu(972) = lu(972) - lu(447) * lu(955) + lu(974) = lu(974) - lu(448) * lu(955) + lu(1125) = lu(1125) - lu(442) * lu(1123) + lu(1128) = lu(1128) - lu(443) * lu(1123) + lu(1130) = - lu(444) * lu(1123) + lu(1138) = lu(1138) - lu(445) * lu(1123) + lu(1140) = - lu(446) * lu(1123) + lu(1141) = lu(1141) - lu(447) * lu(1123) + lu(1143) = lu(1143) - lu(448) * lu(1123) + lu(1372) = lu(1372) - lu(442) * lu(1370) + lu(1376) = - lu(443) * lu(1370) + lu(1378) = - lu(444) * lu(1370) + lu(1386) = lu(1386) - lu(445) * lu(1370) + lu(1388) = - lu(446) * lu(1370) + lu(1389) = lu(1389) - lu(447) * lu(1370) + lu(1391) = lu(1391) - lu(448) * lu(1370) + lu(1501) = lu(1501) - lu(442) * lu(1482) + lu(1512) = lu(1512) - lu(443) * lu(1482) + lu(1514) = lu(1514) - lu(444) * lu(1482) + lu(1522) = lu(1522) - lu(445) * lu(1482) + lu(1524) = lu(1524) - lu(446) * lu(1482) + lu(1525) = lu(1525) - lu(447) * lu(1482) + lu(1527) = lu(1527) - lu(448) * lu(1482) + lu(449) = 1._r8 / lu(449) + lu(450) = lu(450) * lu(449) + lu(451) = lu(451) * lu(449) + lu(452) = lu(452) * lu(449) + lu(453) = lu(453) * lu(449) + lu(454) = lu(454) * lu(449) + lu(455) = lu(455) * lu(449) + lu(456) = lu(456) * lu(449) + lu(468) = lu(468) - lu(450) * lu(467) + lu(469) = lu(469) - lu(451) * lu(467) + lu(470) = lu(470) - lu(452) * lu(467) + lu(472) = lu(472) - lu(453) * lu(467) + lu(473) = lu(473) - lu(454) * lu(467) + lu(474) = lu(474) - lu(455) * lu(467) + lu(475) = lu(475) - lu(456) * lu(467) + lu(507) = lu(507) - lu(450) * lu(506) + lu(508) = lu(508) - lu(451) * lu(506) + lu(509) = lu(509) - lu(452) * lu(506) + lu(511) = lu(511) - lu(453) * lu(506) + lu(512) = lu(512) - lu(454) * lu(506) + lu(513) = lu(513) - lu(455) * lu(506) + lu(514) = - lu(456) * lu(506) + lu(932) = lu(932) - lu(450) * lu(931) + lu(933) = lu(933) - lu(451) * lu(931) + lu(934) = lu(934) - lu(452) * lu(931) + lu(940) = lu(940) - lu(453) * lu(931) + lu(941) = lu(941) - lu(454) * lu(931) + lu(942) = lu(942) - lu(455) * lu(931) + lu(944) = lu(944) - lu(456) * lu(931) + lu(993) = lu(993) - lu(450) * lu(992) + lu(994) = lu(994) - lu(451) * lu(992) + lu(997) = lu(997) - lu(452) * lu(992) + lu(1017) = lu(1017) - lu(453) * lu(992) + lu(1019) = lu(1019) - lu(454) * lu(992) + lu(1020) = lu(1020) - lu(455) * lu(992) + lu(1022) = - lu(456) * lu(992) + lu(1045) = lu(1045) - lu(450) * lu(1044) + lu(1046) = lu(1046) - lu(451) * lu(1044) + lu(1048) = lu(1048) - lu(452) * lu(1044) + lu(1058) = lu(1058) - lu(453) * lu(1044) + lu(1060) = lu(1060) - lu(454) * lu(1044) + lu(1061) = lu(1061) - lu(455) * lu(1044) + lu(1063) = lu(1063) - lu(456) * lu(1044) + lu(458) = 1._r8 / lu(458) + lu(459) = lu(459) * lu(458) + lu(460) = lu(460) * lu(458) + lu(461) = lu(461) * lu(458) + lu(462) = lu(462) * lu(458) + lu(463) = lu(463) * lu(458) + lu(464) = lu(464) * lu(458) + lu(469) = lu(469) - lu(459) * lu(468) + lu(470) = lu(470) - lu(460) * lu(468) + lu(472) = lu(472) - lu(461) * lu(468) + lu(473) = lu(473) - lu(462) * lu(468) + lu(474) = lu(474) - lu(463) * lu(468) + lu(475) = lu(475) - lu(464) * lu(468) + lu(508) = lu(508) - lu(459) * lu(507) + lu(509) = lu(509) - lu(460) * lu(507) + lu(511) = lu(511) - lu(461) * lu(507) + lu(512) = lu(512) - lu(462) * lu(507) + lu(513) = lu(513) - lu(463) * lu(507) + lu(514) = lu(514) - lu(464) * lu(507) + lu(933) = lu(933) - lu(459) * lu(932) + lu(934) = lu(934) - lu(460) * lu(932) + lu(940) = lu(940) - lu(461) * lu(932) + lu(941) = lu(941) - lu(462) * lu(932) + lu(942) = lu(942) - lu(463) * lu(932) + lu(944) = lu(944) - lu(464) * lu(932) + lu(994) = lu(994) - lu(459) * lu(993) + lu(997) = lu(997) - lu(460) * lu(993) + lu(1017) = lu(1017) - lu(461) * lu(993) + lu(1019) = lu(1019) - lu(462) * lu(993) + lu(1020) = lu(1020) - lu(463) * lu(993) + lu(1022) = lu(1022) - lu(464) * lu(993) + lu(1046) = lu(1046) - lu(459) * lu(1045) + lu(1048) = lu(1048) - lu(460) * lu(1045) + lu(1058) = lu(1058) - lu(461) * lu(1045) + lu(1060) = lu(1060) - lu(462) * lu(1045) + lu(1061) = lu(1061) - lu(463) * lu(1045) + lu(1063) = lu(1063) - lu(464) * lu(1045) + lu(469) = 1._r8 / lu(469) + lu(470) = lu(470) * lu(469) + lu(471) = lu(471) * lu(469) + lu(472) = lu(472) * lu(469) + lu(473) = lu(473) * lu(469) + lu(474) = lu(474) * lu(469) + lu(475) = lu(475) * lu(469) + lu(509) = lu(509) - lu(470) * lu(508) + lu(510) = lu(510) - lu(471) * lu(508) + lu(511) = lu(511) - lu(472) * lu(508) + lu(512) = lu(512) - lu(473) * lu(508) + lu(513) = lu(513) - lu(474) * lu(508) + lu(514) = lu(514) - lu(475) * lu(508) + lu(934) = lu(934) - lu(470) * lu(933) + lu(937) = lu(937) - lu(471) * lu(933) + lu(940) = lu(940) - lu(472) * lu(933) + lu(941) = lu(941) - lu(473) * lu(933) + lu(942) = lu(942) - lu(474) * lu(933) + lu(944) = lu(944) - lu(475) * lu(933) + lu(997) = lu(997) - lu(470) * lu(994) + lu(1003) = lu(1003) - lu(471) * lu(994) + lu(1017) = lu(1017) - lu(472) * lu(994) + lu(1019) = lu(1019) - lu(473) * lu(994) + lu(1020) = lu(1020) - lu(474) * lu(994) + lu(1022) = lu(1022) - lu(475) * lu(994) + lu(1048) = lu(1048) - lu(470) * lu(1046) + lu(1052) = lu(1052) - lu(471) * lu(1046) + lu(1058) = lu(1058) - lu(472) * lu(1046) + lu(1060) = lu(1060) - lu(473) * lu(1046) + lu(1061) = lu(1061) - lu(474) * lu(1046) + lu(1063) = lu(1063) - lu(475) * lu(1046) + lu(476) = 1._r8 / lu(476) + lu(477) = lu(477) * lu(476) + lu(478) = lu(478) * lu(476) + lu(479) = lu(479) * lu(476) + lu(480) = lu(480) * lu(476) + lu(481) = lu(481) * lu(476) + lu(482) = lu(482) * lu(476) + lu(483) = lu(483) * lu(476) + lu(484) = lu(484) * lu(476) + lu(485) = lu(485) * lu(476) + lu(561) = - lu(477) * lu(559) + lu(564) = lu(564) - lu(478) * lu(559) + lu(566) = lu(566) - lu(479) * lu(559) + lu(569) = - lu(480) * lu(559) + lu(571) = - lu(481) * lu(559) + lu(572) = lu(572) - lu(482) * lu(559) + lu(573) = lu(573) - lu(483) * lu(559) + lu(574) = lu(574) - lu(484) * lu(559) + lu(576) = lu(576) - lu(485) * lu(559) + lu(1001) = lu(1001) - lu(477) * lu(995) + lu(1007) = lu(1007) - lu(478) * lu(995) + lu(1012) = lu(1012) - lu(479) * lu(995) + lu(1019) = lu(1019) - lu(480) * lu(995) + lu(1023) = lu(1023) - lu(481) * lu(995) + lu(1025) = lu(1025) - lu(482) * lu(995) + lu(1027) = lu(1027) - lu(483) * lu(995) + lu(1028) = lu(1028) - lu(484) * lu(995) + lu(1031) = lu(1031) - lu(485) * lu(995) + lu(1289) = lu(1289) - lu(477) * lu(1282) + lu(1295) = lu(1295) - lu(478) * lu(1282) + lu(1301) = lu(1301) - lu(479) * lu(1282) + lu(1309) = lu(1309) - lu(480) * lu(1282) + lu(1313) = lu(1313) - lu(481) * lu(1282) + lu(1315) = lu(1315) - lu(482) * lu(1282) + lu(1317) = lu(1317) - lu(483) * lu(1282) + lu(1318) = lu(1318) - lu(484) * lu(1282) + lu(1321) = lu(1321) - lu(485) * lu(1282) + lu(1332) = lu(1332) - lu(477) * lu(1329) + lu(1340) = lu(1340) - lu(478) * lu(1329) + lu(1345) = lu(1345) - lu(479) * lu(1329) + lu(1353) = lu(1353) - lu(480) * lu(1329) + lu(1357) = lu(1357) - lu(481) * lu(1329) + lu(1359) = lu(1359) - lu(482) * lu(1329) + lu(1361) = lu(1361) - lu(483) * lu(1329) + lu(1362) = lu(1362) - lu(484) * lu(1329) + lu(1365) = lu(1365) - lu(485) * lu(1329) + end subroutine lu_fac11 + subroutine lu_fac12( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(487) = 1._r8 / lu(487) + lu(488) = lu(488) * lu(487) + lu(489) = lu(489) * lu(487) + lu(490) = lu(490) * lu(487) + lu(491) = lu(491) * lu(487) + lu(492) = lu(492) * lu(487) + lu(493) = lu(493) * lu(487) + lu(494) = lu(494) * lu(487) + lu(495) = lu(495) * lu(487) + lu(496) = lu(496) * lu(487) + lu(623) = lu(623) - lu(488) * lu(620) + lu(624) = - lu(489) * lu(620) + lu(627) = - lu(490) * lu(620) + lu(628) = - lu(491) * lu(620) + lu(630) = lu(630) - lu(492) * lu(620) + lu(631) = lu(631) - lu(493) * lu(620) + lu(632) = lu(632) - lu(494) * lu(620) + lu(634) = lu(634) - lu(495) * lu(620) + lu(635) = lu(635) - lu(496) * lu(620) + lu(1004) = lu(1004) - lu(488) * lu(996) + lu(1006) = lu(1006) - lu(489) * lu(996) + lu(1017) = lu(1017) - lu(490) * lu(996) + lu(1019) = lu(1019) - lu(491) * lu(996) + lu(1023) = lu(1023) - lu(492) * lu(996) + lu(1025) = lu(1025) - lu(493) * lu(996) + lu(1027) = lu(1027) - lu(494) * lu(996) + lu(1029) = lu(1029) - lu(495) * lu(996) + lu(1031) = lu(1031) - lu(496) * lu(996) + lu(1292) = lu(1292) - lu(488) * lu(1283) + lu(1294) = lu(1294) - lu(489) * lu(1283) + lu(1307) = lu(1307) - lu(490) * lu(1283) + lu(1309) = lu(1309) - lu(491) * lu(1283) + lu(1313) = lu(1313) - lu(492) * lu(1283) + lu(1315) = lu(1315) - lu(493) * lu(1283) + lu(1317) = lu(1317) - lu(494) * lu(1283) + lu(1319) = lu(1319) - lu(495) * lu(1283) + lu(1321) = lu(1321) - lu(496) * lu(1283) + lu(1497) = lu(1497) - lu(488) * lu(1483) + lu(1499) = lu(1499) - lu(489) * lu(1483) + lu(1513) = lu(1513) - lu(490) * lu(1483) + lu(1515) = lu(1515) - lu(491) * lu(1483) + lu(1519) = lu(1519) - lu(492) * lu(1483) + lu(1521) = lu(1521) - lu(493) * lu(1483) + lu(1523) = lu(1523) - lu(494) * lu(1483) + lu(1525) = lu(1525) - lu(495) * lu(1483) + lu(1527) = lu(1527) - lu(496) * lu(1483) + lu(497) = 1._r8 / lu(497) + lu(498) = lu(498) * lu(497) + lu(499) = lu(499) * lu(497) + lu(500) = lu(500) * lu(497) + lu(501) = lu(501) * lu(497) + lu(502) = lu(502) * lu(497) + lu(503) = lu(503) * lu(497) + lu(876) = lu(876) - lu(498) * lu(874) + lu(878) = - lu(499) * lu(874) + lu(880) = - lu(500) * lu(874) + lu(883) = - lu(501) * lu(874) + lu(885) = - lu(502) * lu(874) + lu(886) = - lu(503) * lu(874) + lu(1056) = lu(1056) - lu(498) * lu(1047) + lu(1061) = lu(1061) - lu(499) * lu(1047) + lu(1063) = lu(1063) - lu(500) * lu(1047) + lu(1067) = lu(1067) - lu(501) * lu(1047) + lu(1070) = lu(1070) - lu(502) * lu(1047) + lu(1072) = lu(1072) - lu(503) * lu(1047) + lu(1127) = lu(1127) - lu(498) * lu(1124) + lu(1132) = lu(1132) - lu(499) * lu(1124) + lu(1134) = lu(1134) - lu(500) * lu(1124) + lu(1138) = lu(1138) - lu(501) * lu(1124) + lu(1141) = lu(1141) - lu(502) * lu(1124) + lu(1143) = lu(1143) - lu(503) * lu(1124) + lu(1212) = lu(1212) - lu(498) * lu(1208) + lu(1217) = lu(1217) - lu(499) * lu(1208) + lu(1219) = - lu(500) * lu(1208) + lu(1223) = lu(1223) - lu(501) * lu(1208) + lu(1226) = lu(1226) - lu(502) * lu(1208) + lu(1228) = lu(1228) - lu(503) * lu(1208) + lu(1305) = lu(1305) - lu(498) * lu(1284) + lu(1310) = lu(1310) - lu(499) * lu(1284) + lu(1312) = - lu(500) * lu(1284) + lu(1316) = lu(1316) - lu(501) * lu(1284) + lu(1319) = lu(1319) - lu(502) * lu(1284) + lu(1321) = lu(1321) - lu(503) * lu(1284) + lu(1511) = lu(1511) - lu(498) * lu(1484) + lu(1516) = lu(1516) - lu(499) * lu(1484) + lu(1518) = lu(1518) - lu(500) * lu(1484) + lu(1522) = lu(1522) - lu(501) * lu(1484) + lu(1525) = lu(1525) - lu(502) * lu(1484) + lu(1527) = lu(1527) - lu(503) * lu(1484) + lu(509) = 1._r8 / lu(509) + lu(510) = lu(510) * lu(509) + lu(511) = lu(511) * lu(509) + lu(512) = lu(512) * lu(509) + lu(513) = lu(513) * lu(509) + lu(514) = lu(514) * lu(509) + lu(515) = lu(515) * lu(509) + lu(516) = lu(516) * lu(509) + lu(517) = lu(517) * lu(509) + lu(937) = lu(937) - lu(510) * lu(934) + lu(940) = lu(940) - lu(511) * lu(934) + lu(941) = lu(941) - lu(512) * lu(934) + lu(942) = lu(942) - lu(513) * lu(934) + lu(944) = lu(944) - lu(514) * lu(934) + lu(945) = - lu(515) * lu(934) + lu(948) = lu(948) - lu(516) * lu(934) + lu(952) = lu(952) - lu(517) * lu(934) + lu(1003) = lu(1003) - lu(510) * lu(997) + lu(1017) = lu(1017) - lu(511) * lu(997) + lu(1019) = lu(1019) - lu(512) * lu(997) + lu(1020) = lu(1020) - lu(513) * lu(997) + lu(1022) = lu(1022) - lu(514) * lu(997) + lu(1023) = lu(1023) - lu(515) * lu(997) + lu(1026) = - lu(516) * lu(997) + lu(1031) = lu(1031) - lu(517) * lu(997) + lu(1052) = lu(1052) - lu(510) * lu(1048) + lu(1058) = lu(1058) - lu(511) * lu(1048) + lu(1060) = lu(1060) - lu(512) * lu(1048) + lu(1061) = lu(1061) - lu(513) * lu(1048) + lu(1063) = lu(1063) - lu(514) * lu(1048) + lu(1064) = lu(1064) - lu(515) * lu(1048) + lu(1067) = lu(1067) - lu(516) * lu(1048) + lu(1072) = lu(1072) - lu(517) * lu(1048) + lu(1157) = lu(1157) - lu(510) * lu(1154) + lu(1166) = lu(1166) - lu(511) * lu(1154) + lu(1168) = lu(1168) - lu(512) * lu(1154) + lu(1169) = lu(1169) - lu(513) * lu(1154) + lu(1171) = - lu(514) * lu(1154) + lu(1172) = lu(1172) - lu(515) * lu(1154) + lu(1175) = - lu(516) * lu(1154) + lu(1180) = lu(1180) - lu(517) * lu(1154) + lu(1496) = lu(1496) - lu(510) * lu(1485) + lu(1513) = lu(1513) - lu(511) * lu(1485) + lu(1515) = lu(1515) - lu(512) * lu(1485) + lu(1516) = lu(1516) - lu(513) * lu(1485) + lu(1518) = lu(1518) - lu(514) * lu(1485) + lu(1519) = lu(1519) - lu(515) * lu(1485) + lu(1522) = lu(1522) - lu(516) * lu(1485) + lu(1527) = lu(1527) - lu(517) * lu(1485) + lu(521) = 1._r8 / lu(521) + lu(522) = lu(522) * lu(521) + lu(523) = lu(523) * lu(521) + lu(524) = lu(524) * lu(521) + lu(525) = lu(525) * lu(521) + lu(526) = lu(526) * lu(521) + lu(527) = lu(527) * lu(521) + lu(528) = lu(528) * lu(521) + lu(529) = lu(529) * lu(521) + lu(898) = lu(898) - lu(522) * lu(894) + lu(909) = lu(909) - lu(523) * lu(894) + lu(910) = lu(910) - lu(524) * lu(894) + lu(912) = lu(912) - lu(525) * lu(894) + lu(914) = lu(914) - lu(526) * lu(894) + lu(915) = lu(915) - lu(527) * lu(894) + lu(917) = lu(917) - lu(528) * lu(894) + lu(921) = lu(921) - lu(529) * lu(894) + lu(1004) = lu(1004) - lu(522) * lu(998) + lu(1016) = lu(1016) - lu(523) * lu(998) + lu(1017) = lu(1017) - lu(524) * lu(998) + lu(1019) = lu(1019) - lu(525) * lu(998) + lu(1023) = lu(1023) - lu(526) * lu(998) + lu(1025) = lu(1025) - lu(527) * lu(998) + lu(1027) = lu(1027) - lu(528) * lu(998) + lu(1031) = lu(1031) - lu(529) * lu(998) + lu(1292) = lu(1292) - lu(522) * lu(1285) + lu(1306) = lu(1306) - lu(523) * lu(1285) + lu(1307) = lu(1307) - lu(524) * lu(1285) + lu(1309) = lu(1309) - lu(525) * lu(1285) + lu(1313) = lu(1313) - lu(526) * lu(1285) + lu(1315) = lu(1315) - lu(527) * lu(1285) + lu(1317) = lu(1317) - lu(528) * lu(1285) + lu(1321) = lu(1321) - lu(529) * lu(1285) + lu(1406) = - lu(522) * lu(1401) + lu(1411) = lu(1411) - lu(523) * lu(1401) + lu(1412) = lu(1412) - lu(524) * lu(1401) + lu(1414) = lu(1414) - lu(525) * lu(1401) + lu(1418) = lu(1418) - lu(526) * lu(1401) + lu(1420) = lu(1420) - lu(527) * lu(1401) + lu(1422) = lu(1422) - lu(528) * lu(1401) + lu(1426) = lu(1426) - lu(529) * lu(1401) + lu(1497) = lu(1497) - lu(522) * lu(1486) + lu(1512) = lu(1512) - lu(523) * lu(1486) + lu(1513) = lu(1513) - lu(524) * lu(1486) + lu(1515) = lu(1515) - lu(525) * lu(1486) + lu(1519) = lu(1519) - lu(526) * lu(1486) + lu(1521) = lu(1521) - lu(527) * lu(1486) + lu(1523) = lu(1523) - lu(528) * lu(1486) + lu(1527) = lu(1527) - lu(529) * lu(1486) + lu(531) = 1._r8 / lu(531) + lu(532) = lu(532) * lu(531) + lu(533) = lu(533) * lu(531) + lu(534) = lu(534) * lu(531) + lu(535) = lu(535) * lu(531) + lu(536) = lu(536) * lu(531) + lu(537) = lu(537) * lu(531) + lu(609) = lu(609) - lu(532) * lu(607) + lu(611) = lu(611) - lu(533) * lu(607) + lu(614) = - lu(534) * lu(607) + lu(615) = lu(615) - lu(535) * lu(607) + lu(616) = lu(616) - lu(536) * lu(607) + lu(617) = lu(617) - lu(537) * lu(607) + lu(861) = lu(861) - lu(532) * lu(859) + lu(864) = lu(864) - lu(533) * lu(859) + lu(870) = lu(870) - lu(534) * lu(859) + lu(871) = lu(871) - lu(535) * lu(859) + lu(872) = lu(872) - lu(536) * lu(859) + lu(873) = - lu(537) * lu(859) + lu(1055) = lu(1055) - lu(532) * lu(1049) + lu(1061) = lu(1061) - lu(533) * lu(1049) + lu(1070) = lu(1070) - lu(534) * lu(1049) + lu(1071) = lu(1071) - lu(535) * lu(1049) + lu(1072) = lu(1072) - lu(536) * lu(1049) + lu(1073) = lu(1073) - lu(537) * lu(1049) + lu(1304) = lu(1304) - lu(532) * lu(1286) + lu(1310) = lu(1310) - lu(533) * lu(1286) + lu(1319) = lu(1319) - lu(534) * lu(1286) + lu(1320) = lu(1320) - lu(535) * lu(1286) + lu(1321) = lu(1321) - lu(536) * lu(1286) + lu(1322) = lu(1322) - lu(537) * lu(1286) + lu(1409) = lu(1409) - lu(532) * lu(1402) + lu(1415) = lu(1415) - lu(533) * lu(1402) + lu(1424) = lu(1424) - lu(534) * lu(1402) + lu(1425) = lu(1425) - lu(535) * lu(1402) + lu(1426) = lu(1426) - lu(536) * lu(1402) + lu(1427) = lu(1427) - lu(537) * lu(1402) + lu(1510) = lu(1510) - lu(532) * lu(1487) + lu(1516) = lu(1516) - lu(533) * lu(1487) + lu(1525) = lu(1525) - lu(534) * lu(1487) + lu(1526) = lu(1526) - lu(535) * lu(1487) + lu(1527) = lu(1527) - lu(536) * lu(1487) + lu(1528) = lu(1528) - lu(537) * lu(1487) + lu(1537) = lu(1537) - lu(532) * lu(1533) + lu(1543) = lu(1543) - lu(533) * lu(1533) + lu(1552) = - lu(534) * lu(1533) + lu(1553) = lu(1553) - lu(535) * lu(1533) + lu(1554) = lu(1554) - lu(536) * lu(1533) + lu(1555) = lu(1555) - lu(537) * lu(1533) + end subroutine lu_fac12 + subroutine lu_fac13( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(540) = 1._r8 / lu(540) + lu(541) = lu(541) * lu(540) + lu(542) = lu(542) * lu(540) + lu(543) = lu(543) * lu(540) + lu(544) = lu(544) * lu(540) + lu(545) = lu(545) * lu(540) + lu(546) = lu(546) * lu(540) + lu(547) = lu(547) * lu(540) + lu(548) = lu(548) * lu(540) + lu(549) = lu(549) * lu(540) + lu(550) = lu(550) * lu(540) + lu(551) = lu(551) * lu(540) + lu(898) = lu(898) - lu(541) * lu(895) + lu(899) = lu(899) - lu(542) * lu(895) + lu(908) = lu(908) - lu(543) * lu(895) + lu(909) = lu(909) - lu(544) * lu(895) + lu(910) = lu(910) - lu(545) * lu(895) + lu(912) = lu(912) - lu(546) * lu(895) + lu(914) = lu(914) - lu(547) * lu(895) + lu(915) = lu(915) - lu(548) * lu(895) + lu(917) = lu(917) - lu(549) * lu(895) + lu(919) = lu(919) - lu(550) * lu(895) + lu(921) = lu(921) - lu(551) * lu(895) + lu(1004) = lu(1004) - lu(541) * lu(999) + lu(1005) = lu(1005) - lu(542) * lu(999) + lu(1014) = lu(1014) - lu(543) * lu(999) + lu(1016) = lu(1016) - lu(544) * lu(999) + lu(1017) = lu(1017) - lu(545) * lu(999) + lu(1019) = lu(1019) - lu(546) * lu(999) + lu(1023) = lu(1023) - lu(547) * lu(999) + lu(1025) = lu(1025) - lu(548) * lu(999) + lu(1027) = lu(1027) - lu(549) * lu(999) + lu(1029) = lu(1029) - lu(550) * lu(999) + lu(1031) = lu(1031) - lu(551) * lu(999) + lu(1292) = lu(1292) - lu(541) * lu(1287) + lu(1293) = lu(1293) - lu(542) * lu(1287) + lu(1303) = lu(1303) - lu(543) * lu(1287) + lu(1306) = lu(1306) - lu(544) * lu(1287) + lu(1307) = lu(1307) - lu(545) * lu(1287) + lu(1309) = lu(1309) - lu(546) * lu(1287) + lu(1313) = lu(1313) - lu(547) * lu(1287) + lu(1315) = lu(1315) - lu(548) * lu(1287) + lu(1317) = lu(1317) - lu(549) * lu(1287) + lu(1319) = lu(1319) - lu(550) * lu(1287) + lu(1321) = lu(1321) - lu(551) * lu(1287) + lu(1497) = lu(1497) - lu(541) * lu(1488) + lu(1498) = lu(1498) - lu(542) * lu(1488) + lu(1508) = lu(1508) - lu(543) * lu(1488) + lu(1512) = lu(1512) - lu(544) * lu(1488) + lu(1513) = lu(1513) - lu(545) * lu(1488) + lu(1515) = lu(1515) - lu(546) * lu(1488) + lu(1519) = lu(1519) - lu(547) * lu(1488) + lu(1521) = lu(1521) - lu(548) * lu(1488) + lu(1523) = lu(1523) - lu(549) * lu(1488) + lu(1525) = lu(1525) - lu(550) * lu(1488) + lu(1527) = lu(1527) - lu(551) * lu(1488) + lu(553) = 1._r8 / lu(553) + lu(554) = lu(554) * lu(553) + lu(555) = lu(555) * lu(553) + lu(556) = lu(556) * lu(553) + lu(557) = lu(557) * lu(553) + lu(708) = lu(708) - lu(554) * lu(707) + lu(717) = lu(717) - lu(555) * lu(707) + lu(719) = lu(719) - lu(556) * lu(707) + lu(722) = lu(722) - lu(557) * lu(707) + lu(729) = lu(729) - lu(554) * lu(727) + lu(744) = lu(744) - lu(555) * lu(727) + lu(746) = lu(746) - lu(556) * lu(727) + lu(749) = lu(749) - lu(557) * lu(727) + lu(754) = lu(754) - lu(554) * lu(752) + lu(765) = lu(765) - lu(555) * lu(752) + lu(767) = lu(767) - lu(556) * lu(752) + lu(770) = lu(770) - lu(557) * lu(752) + lu(817) = lu(817) - lu(554) * lu(816) + lu(833) = lu(833) - lu(555) * lu(816) + lu(835) = lu(835) - lu(556) * lu(816) + lu(838) = lu(838) - lu(557) * lu(816) + lu(897) = lu(897) - lu(554) * lu(896) + lu(915) = lu(915) - lu(555) * lu(896) + lu(917) = lu(917) - lu(556) * lu(896) + lu(921) = lu(921) - lu(557) * lu(896) + lu(937) = lu(937) - lu(554) * lu(935) + lu(947) = lu(947) - lu(555) * lu(935) + lu(949) = lu(949) - lu(556) * lu(935) + lu(952) = lu(952) - lu(557) * lu(935) + lu(1003) = lu(1003) - lu(554) * lu(1000) + lu(1025) = lu(1025) - lu(555) * lu(1000) + lu(1027) = lu(1027) - lu(556) * lu(1000) + lu(1031) = lu(1031) - lu(557) * lu(1000) + lu(1088) = lu(1088) - lu(554) * lu(1082) + lu(1111) = lu(1111) - lu(555) * lu(1082) + lu(1113) = lu(1113) - lu(556) * lu(1082) + lu(1117) = lu(1117) - lu(557) * lu(1082) + lu(1291) = lu(1291) - lu(554) * lu(1288) + lu(1315) = lu(1315) - lu(555) * lu(1288) + lu(1317) = lu(1317) - lu(556) * lu(1288) + lu(1321) = lu(1321) - lu(557) * lu(1288) + lu(1336) = lu(1336) - lu(554) * lu(1330) + lu(1359) = lu(1359) - lu(555) * lu(1330) + lu(1361) = lu(1361) - lu(556) * lu(1330) + lu(1365) = lu(1365) - lu(557) * lu(1330) + lu(1405) = lu(1405) - lu(554) * lu(1403) + lu(1420) = lu(1420) - lu(555) * lu(1403) + lu(1422) = lu(1422) - lu(556) * lu(1403) + lu(1426) = lu(1426) - lu(557) * lu(1403) + lu(1496) = lu(1496) - lu(554) * lu(1489) + lu(1521) = lu(1521) - lu(555) * lu(1489) + lu(1523) = lu(1523) - lu(556) * lu(1489) + lu(1527) = lu(1527) - lu(557) * lu(1489) + lu(560) = 1._r8 / lu(560) + lu(561) = lu(561) * lu(560) + lu(562) = lu(562) * lu(560) + lu(563) = lu(563) * lu(560) + lu(564) = lu(564) * lu(560) + lu(565) = lu(565) * lu(560) + lu(566) = lu(566) * lu(560) + lu(567) = lu(567) * lu(560) + lu(568) = lu(568) * lu(560) + lu(569) = lu(569) * lu(560) + lu(570) = lu(570) * lu(560) + lu(571) = lu(571) * lu(560) + lu(572) = lu(572) * lu(560) + lu(573) = lu(573) * lu(560) + lu(574) = lu(574) * lu(560) + lu(575) = lu(575) * lu(560) + lu(576) = lu(576) * lu(560) + lu(1084) = - lu(561) * lu(1083) + lu(1087) = lu(1087) - lu(562) * lu(1083) + lu(1088) = lu(1088) - lu(563) * lu(1083) + lu(1092) = lu(1092) - lu(564) * lu(1083) + lu(1095) = - lu(565) * lu(1083) + lu(1097) = lu(1097) - lu(566) * lu(1083) + lu(1098) = lu(1098) - lu(567) * lu(1083) + lu(1102) = lu(1102) - lu(568) * lu(1083) + lu(1105) = lu(1105) - lu(569) * lu(1083) + lu(1107) = lu(1107) - lu(570) * lu(1083) + lu(1109) = lu(1109) - lu(571) * lu(1083) + lu(1111) = lu(1111) - lu(572) * lu(1083) + lu(1113) = lu(1113) - lu(573) * lu(1083) + lu(1114) = lu(1114) - lu(574) * lu(1083) + lu(1115) = lu(1115) - lu(575) * lu(1083) + lu(1117) = lu(1117) - lu(576) * lu(1083) + lu(1332) = lu(1332) - lu(561) * lu(1331) + lu(1335) = lu(1335) - lu(562) * lu(1331) + lu(1336) = lu(1336) - lu(563) * lu(1331) + lu(1340) = lu(1340) - lu(564) * lu(1331) + lu(1343) = lu(1343) - lu(565) * lu(1331) + lu(1345) = lu(1345) - lu(566) * lu(1331) + lu(1346) = lu(1346) - lu(567) * lu(1331) + lu(1350) = - lu(568) * lu(1331) + lu(1353) = lu(1353) - lu(569) * lu(1331) + lu(1355) = lu(1355) - lu(570) * lu(1331) + lu(1357) = lu(1357) - lu(571) * lu(1331) + lu(1359) = lu(1359) - lu(572) * lu(1331) + lu(1361) = lu(1361) - lu(573) * lu(1331) + lu(1362) = lu(1362) - lu(574) * lu(1331) + lu(1363) = - lu(575) * lu(1331) + lu(1365) = lu(1365) - lu(576) * lu(1331) + lu(1491) = lu(1491) - lu(561) * lu(1490) + lu(1495) = lu(1495) - lu(562) * lu(1490) + lu(1496) = lu(1496) - lu(563) * lu(1490) + lu(1500) = lu(1500) - lu(564) * lu(1490) + lu(1504) = lu(1504) - lu(565) * lu(1490) + lu(1506) = lu(1506) - lu(566) * lu(1490) + lu(1507) = lu(1507) - lu(567) * lu(1490) + lu(1512) = lu(1512) - lu(568) * lu(1490) + lu(1515) = lu(1515) - lu(569) * lu(1490) + lu(1517) = lu(1517) - lu(570) * lu(1490) + lu(1519) = lu(1519) - lu(571) * lu(1490) + lu(1521) = lu(1521) - lu(572) * lu(1490) + lu(1523) = lu(1523) - lu(573) * lu(1490) + lu(1524) = lu(1524) - lu(574) * lu(1490) + lu(1525) = lu(1525) - lu(575) * lu(1490) + lu(1527) = lu(1527) - lu(576) * lu(1490) + lu(578) = 1._r8 / lu(578) + lu(579) = lu(579) * lu(578) + lu(580) = lu(580) * lu(578) + lu(581) = lu(581) * lu(578) + lu(582) = lu(582) * lu(578) + lu(583) = lu(583) * lu(578) + lu(584) = lu(584) * lu(578) + lu(585) = lu(585) * lu(578) + lu(729) = lu(729) - lu(579) * lu(728) + lu(733) = lu(733) - lu(580) * lu(728) + lu(743) = lu(743) - lu(581) * lu(728) + lu(744) = lu(744) - lu(582) * lu(728) + lu(746) = lu(746) - lu(583) * lu(728) + lu(747) = lu(747) - lu(584) * lu(728) + lu(749) = lu(749) - lu(585) * lu(728) + lu(754) = lu(754) - lu(579) * lu(753) + lu(757) = - lu(580) * lu(753) + lu(764) = lu(764) - lu(581) * lu(753) + lu(765) = lu(765) - lu(582) * lu(753) + lu(767) = lu(767) - lu(583) * lu(753) + lu(768) = lu(768) - lu(584) * lu(753) + lu(770) = lu(770) - lu(585) * lu(753) + lu(1003) = lu(1003) - lu(579) * lu(1001) + lu(1009) = lu(1009) - lu(580) * lu(1001) + lu(1023) = lu(1023) - lu(581) * lu(1001) + lu(1025) = lu(1025) - lu(582) * lu(1001) + lu(1027) = lu(1027) - lu(583) * lu(1001) + lu(1028) = lu(1028) - lu(584) * lu(1001) + lu(1031) = lu(1031) - lu(585) * lu(1001) + lu(1088) = lu(1088) - lu(579) * lu(1084) + lu(1094) = - lu(580) * lu(1084) + lu(1109) = lu(1109) - lu(581) * lu(1084) + lu(1111) = lu(1111) - lu(582) * lu(1084) + lu(1113) = lu(1113) - lu(583) * lu(1084) + lu(1114) = lu(1114) - lu(584) * lu(1084) + lu(1117) = lu(1117) - lu(585) * lu(1084) + lu(1291) = lu(1291) - lu(579) * lu(1289) + lu(1298) = lu(1298) - lu(580) * lu(1289) + lu(1313) = lu(1313) - lu(581) * lu(1289) + lu(1315) = lu(1315) - lu(582) * lu(1289) + lu(1317) = lu(1317) - lu(583) * lu(1289) + lu(1318) = lu(1318) - lu(584) * lu(1289) + lu(1321) = lu(1321) - lu(585) * lu(1289) + lu(1336) = lu(1336) - lu(579) * lu(1332) + lu(1342) = lu(1342) - lu(580) * lu(1332) + lu(1357) = lu(1357) - lu(581) * lu(1332) + lu(1359) = lu(1359) - lu(582) * lu(1332) + lu(1361) = lu(1361) - lu(583) * lu(1332) + lu(1362) = lu(1362) - lu(584) * lu(1332) + lu(1365) = lu(1365) - lu(585) * lu(1332) + lu(1496) = lu(1496) - lu(579) * lu(1491) + lu(1503) = lu(1503) - lu(580) * lu(1491) + lu(1519) = lu(1519) - lu(581) * lu(1491) + lu(1521) = lu(1521) - lu(582) * lu(1491) + lu(1523) = lu(1523) - lu(583) * lu(1491) + lu(1524) = lu(1524) - lu(584) * lu(1491) + lu(1527) = lu(1527) - lu(585) * lu(1491) + lu(587) = 1._r8 / lu(587) + lu(588) = lu(588) * lu(587) + lu(589) = lu(589) * lu(587) + lu(590) = lu(590) * lu(587) + lu(591) = lu(591) * lu(587) + lu(592) = lu(592) * lu(587) + lu(842) = lu(842) - lu(588) * lu(841) + lu(846) = lu(846) - lu(589) * lu(841) + lu(851) = - lu(590) * lu(841) + lu(852) = - lu(591) * lu(841) + lu(854) = lu(854) - lu(592) * lu(841) + lu(938) = lu(938) - lu(588) * lu(936) + lu(942) = lu(942) - lu(589) * lu(936) + lu(949) = lu(949) - lu(590) * lu(936) + lu(950) = - lu(591) * lu(936) + lu(952) = lu(952) - lu(592) * lu(936) + lu(1054) = lu(1054) - lu(588) * lu(1050) + lu(1061) = lu(1061) - lu(589) * lu(1050) + lu(1068) = lu(1068) - lu(590) * lu(1050) + lu(1070) = lu(1070) - lu(591) * lu(1050) + lu(1072) = lu(1072) - lu(592) * lu(1050) + lu(1100) = lu(1100) - lu(588) * lu(1085) + lu(1106) = lu(1106) - lu(589) * lu(1085) + lu(1113) = lu(1113) - lu(590) * lu(1085) + lu(1115) = lu(1115) - lu(591) * lu(1085) + lu(1117) = lu(1117) - lu(592) * lu(1085) + lu(1162) = lu(1162) - lu(588) * lu(1155) + lu(1169) = lu(1169) - lu(589) * lu(1155) + lu(1176) = lu(1176) - lu(590) * lu(1155) + lu(1178) = lu(1178) - lu(591) * lu(1155) + lu(1180) = lu(1180) - lu(592) * lu(1155) + lu(1187) = lu(1187) - lu(588) * lu(1186) + lu(1193) = lu(1193) - lu(589) * lu(1186) + lu(1200) = lu(1200) - lu(590) * lu(1186) + lu(1202) = lu(1202) - lu(591) * lu(1186) + lu(1204) = lu(1204) - lu(592) * lu(1186) + lu(1348) = - lu(588) * lu(1333) + lu(1354) = lu(1354) - lu(589) * lu(1333) + lu(1361) = lu(1361) - lu(590) * lu(1333) + lu(1363) = lu(1363) - lu(591) * lu(1333) + lu(1365) = lu(1365) - lu(592) * lu(1333) + lu(1373) = - lu(588) * lu(1371) + lu(1380) = lu(1380) - lu(589) * lu(1371) + lu(1387) = - lu(590) * lu(1371) + lu(1389) = lu(1389) - lu(591) * lu(1371) + lu(1391) = lu(1391) - lu(592) * lu(1371) + lu(1509) = lu(1509) - lu(588) * lu(1492) + lu(1516) = lu(1516) - lu(589) * lu(1492) + lu(1523) = lu(1523) - lu(590) * lu(1492) + lu(1525) = lu(1525) - lu(591) * lu(1492) + lu(1527) = lu(1527) - lu(592) * lu(1492) + lu(1536) = lu(1536) - lu(588) * lu(1534) + lu(1543) = lu(1543) - lu(589) * lu(1534) + lu(1550) = lu(1550) - lu(590) * lu(1534) + lu(1552) = lu(1552) - lu(591) * lu(1534) + lu(1554) = lu(1554) - lu(592) * lu(1534) + end subroutine lu_fac13 + subroutine lu_fac14( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(595) = 1._r8 / lu(595) + lu(596) = lu(596) * lu(595) + lu(597) = lu(597) * lu(595) + lu(598) = lu(598) * lu(595) + lu(599) = lu(599) * lu(595) + lu(600) = lu(600) * lu(595) + lu(601) = lu(601) * lu(595) + lu(602) = lu(602) * lu(595) + lu(603) = lu(603) * lu(595) + lu(604) = lu(604) * lu(595) + lu(605) = lu(605) * lu(595) + lu(1005) = lu(1005) - lu(596) * lu(1002) + lu(1007) = lu(1007) - lu(597) * lu(1002) + lu(1012) = lu(1012) - lu(598) * lu(1002) + lu(1014) = lu(1014) - lu(599) * lu(1002) + lu(1016) = lu(1016) - lu(600) * lu(1002) + lu(1019) = lu(1019) - lu(601) * lu(1002) + lu(1023) = lu(1023) - lu(602) * lu(1002) + lu(1027) = lu(1027) - lu(603) * lu(1002) + lu(1029) = lu(1029) - lu(604) * lu(1002) + lu(1031) = lu(1031) - lu(605) * lu(1002) + lu(1090) = - lu(596) * lu(1086) + lu(1092) = lu(1092) - lu(597) * lu(1086) + lu(1097) = lu(1097) - lu(598) * lu(1086) + lu(1099) = - lu(599) * lu(1086) + lu(1102) = lu(1102) - lu(600) * lu(1086) + lu(1105) = lu(1105) - lu(601) * lu(1086) + lu(1109) = lu(1109) - lu(602) * lu(1086) + lu(1113) = lu(1113) - lu(603) * lu(1086) + lu(1115) = lu(1115) - lu(604) * lu(1086) + lu(1117) = lu(1117) - lu(605) * lu(1086) + lu(1293) = lu(1293) - lu(596) * lu(1290) + lu(1295) = lu(1295) - lu(597) * lu(1290) + lu(1301) = lu(1301) - lu(598) * lu(1290) + lu(1303) = lu(1303) - lu(599) * lu(1290) + lu(1306) = lu(1306) - lu(600) * lu(1290) + lu(1309) = lu(1309) - lu(601) * lu(1290) + lu(1313) = lu(1313) - lu(602) * lu(1290) + lu(1317) = lu(1317) - lu(603) * lu(1290) + lu(1319) = lu(1319) - lu(604) * lu(1290) + lu(1321) = lu(1321) - lu(605) * lu(1290) + lu(1338) = - lu(596) * lu(1334) + lu(1340) = lu(1340) - lu(597) * lu(1334) + lu(1345) = lu(1345) - lu(598) * lu(1334) + lu(1347) = lu(1347) - lu(599) * lu(1334) + lu(1350) = lu(1350) - lu(600) * lu(1334) + lu(1353) = lu(1353) - lu(601) * lu(1334) + lu(1357) = lu(1357) - lu(602) * lu(1334) + lu(1361) = lu(1361) - lu(603) * lu(1334) + lu(1363) = lu(1363) - lu(604) * lu(1334) + lu(1365) = lu(1365) - lu(605) * lu(1334) + lu(1498) = lu(1498) - lu(596) * lu(1493) + lu(1500) = lu(1500) - lu(597) * lu(1493) + lu(1506) = lu(1506) - lu(598) * lu(1493) + lu(1508) = lu(1508) - lu(599) * lu(1493) + lu(1512) = lu(1512) - lu(600) * lu(1493) + lu(1515) = lu(1515) - lu(601) * lu(1493) + lu(1519) = lu(1519) - lu(602) * lu(1493) + lu(1523) = lu(1523) - lu(603) * lu(1493) + lu(1525) = lu(1525) - lu(604) * lu(1493) + lu(1527) = lu(1527) - lu(605) * lu(1493) + lu(608) = 1._r8 / lu(608) + lu(609) = lu(609) * lu(608) + lu(610) = lu(610) * lu(608) + lu(611) = lu(611) * lu(608) + lu(612) = lu(612) * lu(608) + lu(613) = lu(613) * lu(608) + lu(614) = lu(614) * lu(608) + lu(615) = lu(615) * lu(608) + lu(616) = lu(616) * lu(608) + lu(617) = lu(617) * lu(608) + lu(861) = lu(861) - lu(609) * lu(860) + lu(863) = lu(863) - lu(610) * lu(860) + lu(864) = lu(864) - lu(611) * lu(860) + lu(866) = - lu(612) * lu(860) + lu(869) = - lu(613) * lu(860) + lu(870) = lu(870) - lu(614) * lu(860) + lu(871) = lu(871) - lu(615) * lu(860) + lu(872) = lu(872) - lu(616) * lu(860) + lu(873) = lu(873) - lu(617) * lu(860) + lu(1055) = lu(1055) - lu(609) * lu(1051) + lu(1059) = lu(1059) - lu(610) * lu(1051) + lu(1061) = lu(1061) - lu(611) * lu(1051) + lu(1064) = lu(1064) - lu(612) * lu(1051) + lu(1069) = lu(1069) - lu(613) * lu(1051) + lu(1070) = lu(1070) - lu(614) * lu(1051) + lu(1071) = lu(1071) - lu(615) * lu(1051) + lu(1072) = lu(1072) - lu(616) * lu(1051) + lu(1073) = lu(1073) - lu(617) * lu(1051) + lu(1163) = lu(1163) - lu(609) * lu(1156) + lu(1167) = lu(1167) - lu(610) * lu(1156) + lu(1169) = lu(1169) - lu(611) * lu(1156) + lu(1172) = lu(1172) - lu(612) * lu(1156) + lu(1177) = lu(1177) - lu(613) * lu(1156) + lu(1178) = lu(1178) - lu(614) * lu(1156) + lu(1179) = lu(1179) - lu(615) * lu(1156) + lu(1180) = lu(1180) - lu(616) * lu(1156) + lu(1181) = lu(1181) - lu(617) * lu(1156) + lu(1409) = lu(1409) - lu(609) * lu(1404) + lu(1413) = - lu(610) * lu(1404) + lu(1415) = lu(1415) - lu(611) * lu(1404) + lu(1418) = lu(1418) - lu(612) * lu(1404) + lu(1423) = lu(1423) - lu(613) * lu(1404) + lu(1424) = lu(1424) - lu(614) * lu(1404) + lu(1425) = lu(1425) - lu(615) * lu(1404) + lu(1426) = lu(1426) - lu(616) * lu(1404) + lu(1427) = lu(1427) - lu(617) * lu(1404) + lu(1510) = lu(1510) - lu(609) * lu(1494) + lu(1514) = lu(1514) - lu(610) * lu(1494) + lu(1516) = lu(1516) - lu(611) * lu(1494) + lu(1519) = lu(1519) - lu(612) * lu(1494) + lu(1524) = lu(1524) - lu(613) * lu(1494) + lu(1525) = lu(1525) - lu(614) * lu(1494) + lu(1526) = lu(1526) - lu(615) * lu(1494) + lu(1527) = lu(1527) - lu(616) * lu(1494) + lu(1528) = lu(1528) - lu(617) * lu(1494) + lu(1537) = lu(1537) - lu(609) * lu(1535) + lu(1541) = - lu(610) * lu(1535) + lu(1543) = lu(1543) - lu(611) * lu(1535) + lu(1546) = lu(1546) - lu(612) * lu(1535) + lu(1551) = - lu(613) * lu(1535) + lu(1552) = lu(1552) - lu(614) * lu(1535) + lu(1553) = lu(1553) - lu(615) * lu(1535) + lu(1554) = lu(1554) - lu(616) * lu(1535) + lu(1555) = lu(1555) - lu(617) * lu(1535) + lu(621) = 1._r8 / lu(621) + lu(622) = lu(622) * lu(621) + lu(623) = lu(623) * lu(621) + lu(624) = lu(624) * lu(621) + lu(625) = lu(625) * lu(621) + lu(626) = lu(626) * lu(621) + lu(627) = lu(627) * lu(621) + lu(628) = lu(628) * lu(621) + lu(629) = lu(629) * lu(621) + lu(630) = lu(630) * lu(621) + lu(631) = lu(631) * lu(621) + lu(632) = lu(632) * lu(621) + lu(633) = lu(633) * lu(621) + lu(634) = lu(634) * lu(621) + lu(635) = lu(635) * lu(621) + lu(772) = lu(772) - lu(622) * lu(771) + lu(773) = lu(773) - lu(623) * lu(771) + lu(774) = - lu(624) * lu(771) + lu(775) = lu(775) - lu(625) * lu(771) + lu(780) = lu(780) - lu(626) * lu(771) + lu(781) = - lu(627) * lu(771) + lu(783) = - lu(628) * lu(771) + lu(784) = lu(784) - lu(629) * lu(771) + lu(785) = - lu(630) * lu(771) + lu(786) = lu(786) - lu(631) * lu(771) + lu(788) = lu(788) - lu(632) * lu(771) + lu(789) = - lu(633) * lu(771) + lu(790) = - lu(634) * lu(771) + lu(791) = lu(791) - lu(635) * lu(771) + lu(1088) = lu(1088) - lu(622) * lu(1087) + lu(1089) = lu(1089) - lu(623) * lu(1087) + lu(1091) = - lu(624) * lu(1087) + lu(1093) = lu(1093) - lu(625) * lu(1087) + lu(1102) = lu(1102) - lu(626) * lu(1087) + lu(1103) = lu(1103) - lu(627) * lu(1087) + lu(1105) = lu(1105) - lu(628) * lu(1087) + lu(1107) = lu(1107) - lu(629) * lu(1087) + lu(1109) = lu(1109) - lu(630) * lu(1087) + lu(1111) = lu(1111) - lu(631) * lu(1087) + lu(1113) = lu(1113) - lu(632) * lu(1087) + lu(1114) = lu(1114) - lu(633) * lu(1087) + lu(1115) = lu(1115) - lu(634) * lu(1087) + lu(1117) = lu(1117) - lu(635) * lu(1087) + lu(1336) = lu(1336) - lu(622) * lu(1335) + lu(1337) = lu(1337) - lu(623) * lu(1335) + lu(1339) = lu(1339) - lu(624) * lu(1335) + lu(1341) = lu(1341) - lu(625) * lu(1335) + lu(1350) = lu(1350) - lu(626) * lu(1335) + lu(1351) = lu(1351) - lu(627) * lu(1335) + lu(1353) = lu(1353) - lu(628) * lu(1335) + lu(1355) = lu(1355) - lu(629) * lu(1335) + lu(1357) = lu(1357) - lu(630) * lu(1335) + lu(1359) = lu(1359) - lu(631) * lu(1335) + lu(1361) = lu(1361) - lu(632) * lu(1335) + lu(1362) = lu(1362) - lu(633) * lu(1335) + lu(1363) = lu(1363) - lu(634) * lu(1335) + lu(1365) = lu(1365) - lu(635) * lu(1335) + lu(1496) = lu(1496) - lu(622) * lu(1495) + lu(1497) = lu(1497) - lu(623) * lu(1495) + lu(1499) = lu(1499) - lu(624) * lu(1495) + lu(1502) = lu(1502) - lu(625) * lu(1495) + lu(1512) = lu(1512) - lu(626) * lu(1495) + lu(1513) = lu(1513) - lu(627) * lu(1495) + lu(1515) = lu(1515) - lu(628) * lu(1495) + lu(1517) = lu(1517) - lu(629) * lu(1495) + lu(1519) = lu(1519) - lu(630) * lu(1495) + lu(1521) = lu(1521) - lu(631) * lu(1495) + lu(1523) = lu(1523) - lu(632) * lu(1495) + lu(1524) = lu(1524) - lu(633) * lu(1495) + lu(1525) = lu(1525) - lu(634) * lu(1495) + lu(1527) = lu(1527) - lu(635) * lu(1495) + end subroutine lu_fac14 + subroutine lu_fac15( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(636) = 1._r8 / lu(636) + lu(637) = lu(637) * lu(636) + lu(638) = lu(638) * lu(636) + lu(639) = lu(639) * lu(636) + lu(645) = - lu(637) * lu(640) + lu(646) = lu(646) - lu(638) * lu(640) + lu(649) = lu(649) - lu(639) * lu(640) + lu(678) = - lu(637) * lu(670) + lu(679) = lu(679) - lu(638) * lu(670) + lu(681) = lu(681) - lu(639) * lu(670) + lu(699) = - lu(637) * lu(695) + lu(700) = lu(700) - lu(638) * lu(695) + lu(703) = lu(703) - lu(639) * lu(695) + lu(718) = - lu(637) * lu(708) + lu(719) = lu(719) - lu(638) * lu(708) + lu(722) = lu(722) - lu(639) * lu(708) + lu(745) = - lu(637) * lu(729) + lu(746) = lu(746) - lu(638) * lu(729) + lu(749) = lu(749) - lu(639) * lu(729) + lu(766) = - lu(637) * lu(754) + lu(767) = lu(767) - lu(638) * lu(754) + lu(770) = lu(770) - lu(639) * lu(754) + lu(787) = - lu(637) * lu(772) + lu(788) = lu(788) - lu(638) * lu(772) + lu(791) = lu(791) - lu(639) * lu(772) + lu(834) = - lu(637) * lu(817) + lu(835) = lu(835) - lu(638) * lu(817) + lu(838) = lu(838) - lu(639) * lu(817) + lu(883) = lu(883) - lu(637) * lu(875) + lu(884) = lu(884) - lu(638) * lu(875) + lu(886) = lu(886) - lu(639) * lu(875) + lu(916) = lu(916) - lu(637) * lu(897) + lu(917) = lu(917) - lu(638) * lu(897) + lu(921) = lu(921) - lu(639) * lu(897) + lu(948) = lu(948) - lu(637) * lu(937) + lu(949) = lu(949) - lu(638) * lu(937) + lu(952) = lu(952) - lu(639) * lu(937) + lu(1026) = lu(1026) - lu(637) * lu(1003) + lu(1027) = lu(1027) - lu(638) * lu(1003) + lu(1031) = lu(1031) - lu(639) * lu(1003) + lu(1067) = lu(1067) - lu(637) * lu(1052) + lu(1068) = lu(1068) - lu(638) * lu(1052) + lu(1072) = lu(1072) - lu(639) * lu(1052) + lu(1112) = lu(1112) - lu(637) * lu(1088) + lu(1113) = lu(1113) - lu(638) * lu(1088) + lu(1117) = lu(1117) - lu(639) * lu(1088) + lu(1175) = lu(1175) - lu(637) * lu(1157) + lu(1176) = lu(1176) - lu(638) * lu(1157) + lu(1180) = lu(1180) - lu(639) * lu(1157) + lu(1223) = lu(1223) - lu(637) * lu(1209) + lu(1224) = lu(1224) - lu(638) * lu(1209) + lu(1228) = lu(1228) - lu(639) * lu(1209) + lu(1316) = lu(1316) - lu(637) * lu(1291) + lu(1317) = lu(1317) - lu(638) * lu(1291) + lu(1321) = lu(1321) - lu(639) * lu(1291) + lu(1360) = - lu(637) * lu(1336) + lu(1361) = lu(1361) - lu(638) * lu(1336) + lu(1365) = lu(1365) - lu(639) * lu(1336) + lu(1421) = lu(1421) - lu(637) * lu(1405) + lu(1422) = lu(1422) - lu(638) * lu(1405) + lu(1426) = lu(1426) - lu(639) * lu(1405) + lu(1522) = lu(1522) - lu(637) * lu(1496) + lu(1523) = lu(1523) - lu(638) * lu(1496) + lu(1527) = lu(1527) - lu(639) * lu(1496) + lu(641) = 1._r8 / lu(641) + lu(642) = lu(642) * lu(641) + lu(643) = lu(643) * lu(641) + lu(644) = lu(644) * lu(641) + lu(645) = lu(645) * lu(641) + lu(646) = lu(646) * lu(641) + lu(647) = lu(647) * lu(641) + lu(648) = lu(648) * lu(641) + lu(649) = lu(649) * lu(641) + lu(779) = lu(779) - lu(642) * lu(773) + lu(780) = lu(780) - lu(643) * lu(773) + lu(782) = - lu(644) * lu(773) + lu(787) = lu(787) - lu(645) * lu(773) + lu(788) = lu(788) - lu(646) * lu(773) + lu(789) = lu(789) - lu(647) * lu(773) + lu(790) = lu(790) - lu(648) * lu(773) + lu(791) = lu(791) - lu(649) * lu(773) + lu(908) = lu(908) - lu(642) * lu(898) + lu(909) = lu(909) - lu(643) * lu(898) + lu(911) = - lu(644) * lu(898) + lu(916) = lu(916) - lu(645) * lu(898) + lu(917) = lu(917) - lu(646) * lu(898) + lu(918) = - lu(647) * lu(898) + lu(919) = lu(919) - lu(648) * lu(898) + lu(921) = lu(921) - lu(649) * lu(898) + lu(1014) = lu(1014) - lu(642) * lu(1004) + lu(1016) = lu(1016) - lu(643) * lu(1004) + lu(1018) = - lu(644) * lu(1004) + lu(1026) = lu(1026) - lu(645) * lu(1004) + lu(1027) = lu(1027) - lu(646) * lu(1004) + lu(1028) = lu(1028) - lu(647) * lu(1004) + lu(1029) = lu(1029) - lu(648) * lu(1004) + lu(1031) = lu(1031) - lu(649) * lu(1004) + lu(1099) = lu(1099) - lu(642) * lu(1089) + lu(1102) = lu(1102) - lu(643) * lu(1089) + lu(1104) = - lu(644) * lu(1089) + lu(1112) = lu(1112) - lu(645) * lu(1089) + lu(1113) = lu(1113) - lu(646) * lu(1089) + lu(1114) = lu(1114) - lu(647) * lu(1089) + lu(1115) = lu(1115) - lu(648) * lu(1089) + lu(1117) = lu(1117) - lu(649) * lu(1089) + lu(1303) = lu(1303) - lu(642) * lu(1292) + lu(1306) = lu(1306) - lu(643) * lu(1292) + lu(1308) = - lu(644) * lu(1292) + lu(1316) = lu(1316) - lu(645) * lu(1292) + lu(1317) = lu(1317) - lu(646) * lu(1292) + lu(1318) = lu(1318) - lu(647) * lu(1292) + lu(1319) = lu(1319) - lu(648) * lu(1292) + lu(1321) = lu(1321) - lu(649) * lu(1292) + lu(1347) = lu(1347) - lu(642) * lu(1337) + lu(1350) = lu(1350) - lu(643) * lu(1337) + lu(1352) = lu(1352) - lu(644) * lu(1337) + lu(1360) = lu(1360) - lu(645) * lu(1337) + lu(1361) = lu(1361) - lu(646) * lu(1337) + lu(1362) = lu(1362) - lu(647) * lu(1337) + lu(1363) = lu(1363) - lu(648) * lu(1337) + lu(1365) = lu(1365) - lu(649) * lu(1337) + lu(1408) = - lu(642) * lu(1406) + lu(1411) = lu(1411) - lu(643) * lu(1406) + lu(1413) = lu(1413) - lu(644) * lu(1406) + lu(1421) = lu(1421) - lu(645) * lu(1406) + lu(1422) = lu(1422) - lu(646) * lu(1406) + lu(1423) = lu(1423) - lu(647) * lu(1406) + lu(1424) = lu(1424) - lu(648) * lu(1406) + lu(1426) = lu(1426) - lu(649) * lu(1406) + lu(1508) = lu(1508) - lu(642) * lu(1497) + lu(1512) = lu(1512) - lu(643) * lu(1497) + lu(1514) = lu(1514) - lu(644) * lu(1497) + lu(1522) = lu(1522) - lu(645) * lu(1497) + lu(1523) = lu(1523) - lu(646) * lu(1497) + lu(1524) = lu(1524) - lu(647) * lu(1497) + lu(1525) = lu(1525) - lu(648) * lu(1497) + lu(1527) = lu(1527) - lu(649) * lu(1497) + lu(652) = 1._r8 / lu(652) + lu(653) = lu(653) * lu(652) + lu(654) = lu(654) * lu(652) + lu(655) = lu(655) * lu(652) + lu(656) = lu(656) * lu(652) + lu(657) = lu(657) * lu(652) + lu(658) = lu(658) * lu(652) + lu(659) = lu(659) * lu(652) + lu(660) = lu(660) * lu(652) + lu(661) = lu(661) * lu(652) + lu(662) = lu(662) * lu(652) + lu(663) = lu(663) * lu(652) + lu(900) = lu(900) - lu(653) * lu(899) + lu(902) = lu(902) - lu(654) * lu(899) + lu(908) = lu(908) - lu(655) * lu(899) + lu(909) = lu(909) - lu(656) * lu(899) + lu(910) = lu(910) - lu(657) * lu(899) + lu(912) = lu(912) - lu(658) * lu(899) + lu(914) = lu(914) - lu(659) * lu(899) + lu(915) = lu(915) - lu(660) * lu(899) + lu(917) = lu(917) - lu(661) * lu(899) + lu(919) = lu(919) - lu(662) * lu(899) + lu(921) = lu(921) - lu(663) * lu(899) + lu(1006) = lu(1006) - lu(653) * lu(1005) + lu(1008) = lu(1008) - lu(654) * lu(1005) + lu(1014) = lu(1014) - lu(655) * lu(1005) + lu(1016) = lu(1016) - lu(656) * lu(1005) + lu(1017) = lu(1017) - lu(657) * lu(1005) + lu(1019) = lu(1019) - lu(658) * lu(1005) + lu(1023) = lu(1023) - lu(659) * lu(1005) + lu(1025) = lu(1025) - lu(660) * lu(1005) + lu(1027) = lu(1027) - lu(661) * lu(1005) + lu(1029) = lu(1029) - lu(662) * lu(1005) + lu(1031) = lu(1031) - lu(663) * lu(1005) + lu(1091) = lu(1091) - lu(653) * lu(1090) + lu(1093) = lu(1093) - lu(654) * lu(1090) + lu(1099) = lu(1099) - lu(655) * lu(1090) + lu(1102) = lu(1102) - lu(656) * lu(1090) + lu(1103) = lu(1103) - lu(657) * lu(1090) + lu(1105) = lu(1105) - lu(658) * lu(1090) + lu(1109) = lu(1109) - lu(659) * lu(1090) + lu(1111) = lu(1111) - lu(660) * lu(1090) + lu(1113) = lu(1113) - lu(661) * lu(1090) + lu(1115) = lu(1115) - lu(662) * lu(1090) + lu(1117) = lu(1117) - lu(663) * lu(1090) + lu(1294) = lu(1294) - lu(653) * lu(1293) + lu(1297) = lu(1297) - lu(654) * lu(1293) + lu(1303) = lu(1303) - lu(655) * lu(1293) + lu(1306) = lu(1306) - lu(656) * lu(1293) + lu(1307) = lu(1307) - lu(657) * lu(1293) + lu(1309) = lu(1309) - lu(658) * lu(1293) + lu(1313) = lu(1313) - lu(659) * lu(1293) + lu(1315) = lu(1315) - lu(660) * lu(1293) + lu(1317) = lu(1317) - lu(661) * lu(1293) + lu(1319) = lu(1319) - lu(662) * lu(1293) + lu(1321) = lu(1321) - lu(663) * lu(1293) + lu(1339) = lu(1339) - lu(653) * lu(1338) + lu(1341) = lu(1341) - lu(654) * lu(1338) + lu(1347) = lu(1347) - lu(655) * lu(1338) + lu(1350) = lu(1350) - lu(656) * lu(1338) + lu(1351) = lu(1351) - lu(657) * lu(1338) + lu(1353) = lu(1353) - lu(658) * lu(1338) + lu(1357) = lu(1357) - lu(659) * lu(1338) + lu(1359) = lu(1359) - lu(660) * lu(1338) + lu(1361) = lu(1361) - lu(661) * lu(1338) + lu(1363) = lu(1363) - lu(662) * lu(1338) + lu(1365) = lu(1365) - lu(663) * lu(1338) + lu(1499) = lu(1499) - lu(653) * lu(1498) + lu(1502) = lu(1502) - lu(654) * lu(1498) + lu(1508) = lu(1508) - lu(655) * lu(1498) + lu(1512) = lu(1512) - lu(656) * lu(1498) + lu(1513) = lu(1513) - lu(657) * lu(1498) + lu(1515) = lu(1515) - lu(658) * lu(1498) + lu(1519) = lu(1519) - lu(659) * lu(1498) + lu(1521) = lu(1521) - lu(660) * lu(1498) + lu(1523) = lu(1523) - lu(661) * lu(1498) + lu(1525) = lu(1525) - lu(662) * lu(1498) + lu(1527) = lu(1527) - lu(663) * lu(1498) + lu(664) = 1._r8 / lu(664) + lu(665) = lu(665) * lu(664) + lu(666) = lu(666) * lu(664) + lu(667) = lu(667) * lu(664) + lu(668) = lu(668) * lu(664) + lu(669) = lu(669) * lu(664) + lu(710) = lu(710) - lu(665) * lu(709) + lu(712) = lu(712) - lu(666) * lu(709) + lu(717) = lu(717) - lu(667) * lu(709) + lu(719) = lu(719) - lu(668) * lu(709) + lu(722) = lu(722) - lu(669) * lu(709) + lu(732) = lu(732) - lu(665) * lu(730) + lu(738) = lu(738) - lu(666) * lu(730) + lu(744) = lu(744) - lu(667) * lu(730) + lu(746) = lu(746) - lu(668) * lu(730) + lu(749) = lu(749) - lu(669) * lu(730) + lu(756) = lu(756) - lu(665) * lu(755) + lu(760) = lu(760) - lu(666) * lu(755) + lu(765) = lu(765) - lu(667) * lu(755) + lu(767) = lu(767) - lu(668) * lu(755) + lu(770) = lu(770) - lu(669) * lu(755) + lu(775) = lu(775) - lu(665) * lu(774) + lu(779) = lu(779) - lu(666) * lu(774) + lu(786) = lu(786) - lu(667) * lu(774) + lu(788) = lu(788) - lu(668) * lu(774) + lu(791) = lu(791) - lu(669) * lu(774) + lu(796) = - lu(665) * lu(795) + lu(798) = lu(798) - lu(666) * lu(795) + lu(805) = lu(805) - lu(667) * lu(795) + lu(807) = lu(807) - lu(668) * lu(795) + lu(810) = lu(810) - lu(669) * lu(795) + lu(820) = lu(820) - lu(665) * lu(818) + lu(826) = lu(826) - lu(666) * lu(818) + lu(833) = lu(833) - lu(667) * lu(818) + lu(835) = lu(835) - lu(668) * lu(818) + lu(838) = lu(838) - lu(669) * lu(818) + lu(902) = lu(902) - lu(665) * lu(900) + lu(908) = lu(908) - lu(666) * lu(900) + lu(915) = lu(915) - lu(667) * lu(900) + lu(917) = lu(917) - lu(668) * lu(900) + lu(921) = lu(921) - lu(669) * lu(900) + lu(1008) = lu(1008) - lu(665) * lu(1006) + lu(1014) = lu(1014) - lu(666) * lu(1006) + lu(1025) = lu(1025) - lu(667) * lu(1006) + lu(1027) = lu(1027) - lu(668) * lu(1006) + lu(1031) = lu(1031) - lu(669) * lu(1006) + lu(1093) = lu(1093) - lu(665) * lu(1091) + lu(1099) = lu(1099) - lu(666) * lu(1091) + lu(1111) = lu(1111) - lu(667) * lu(1091) + lu(1113) = lu(1113) - lu(668) * lu(1091) + lu(1117) = lu(1117) - lu(669) * lu(1091) + lu(1159) = lu(1159) - lu(665) * lu(1158) + lu(1161) = lu(1161) - lu(666) * lu(1158) + lu(1174) = lu(1174) - lu(667) * lu(1158) + lu(1176) = lu(1176) - lu(668) * lu(1158) + lu(1180) = lu(1180) - lu(669) * lu(1158) + lu(1297) = lu(1297) - lu(665) * lu(1294) + lu(1303) = lu(1303) - lu(666) * lu(1294) + lu(1315) = lu(1315) - lu(667) * lu(1294) + lu(1317) = lu(1317) - lu(668) * lu(1294) + lu(1321) = lu(1321) - lu(669) * lu(1294) + lu(1341) = lu(1341) - lu(665) * lu(1339) + lu(1347) = lu(1347) - lu(666) * lu(1339) + lu(1359) = lu(1359) - lu(667) * lu(1339) + lu(1361) = lu(1361) - lu(668) * lu(1339) + lu(1365) = lu(1365) - lu(669) * lu(1339) + lu(1502) = lu(1502) - lu(665) * lu(1499) + lu(1508) = lu(1508) - lu(666) * lu(1499) + lu(1521) = lu(1521) - lu(667) * lu(1499) + lu(1523) = lu(1523) - lu(668) * lu(1499) + lu(1527) = lu(1527) - lu(669) * lu(1499) + lu(671) = 1._r8 / lu(671) + lu(672) = lu(672) * lu(671) + lu(673) = lu(673) * lu(671) + lu(674) = lu(674) * lu(671) + lu(675) = lu(675) * lu(671) + lu(676) = lu(676) * lu(671) + lu(677) = lu(677) * lu(671) + lu(678) = lu(678) * lu(671) + lu(679) = lu(679) * lu(671) + lu(680) = lu(680) * lu(671) + lu(681) = lu(681) * lu(671) + lu(732) = lu(732) - lu(672) * lu(731) + lu(735) = - lu(673) * lu(731) + lu(737) = - lu(674) * lu(731) + lu(738) = lu(738) - lu(675) * lu(731) + lu(742) = - lu(676) * lu(731) + lu(744) = lu(744) - lu(677) * lu(731) + lu(745) = lu(745) - lu(678) * lu(731) + lu(746) = lu(746) - lu(679) * lu(731) + lu(748) = - lu(680) * lu(731) + lu(749) = lu(749) - lu(681) * lu(731) + lu(820) = lu(820) - lu(672) * lu(819) + lu(823) = lu(823) - lu(673) * lu(819) + lu(825) = lu(825) - lu(674) * lu(819) + lu(826) = lu(826) - lu(675) * lu(819) + lu(831) = lu(831) - lu(676) * lu(819) + lu(833) = lu(833) - lu(677) * lu(819) + lu(834) = lu(834) - lu(678) * lu(819) + lu(835) = lu(835) - lu(679) * lu(819) + lu(837) = lu(837) - lu(680) * lu(819) + lu(838) = lu(838) - lu(681) * lu(819) + lu(902) = lu(902) - lu(672) * lu(901) + lu(905) = lu(905) - lu(673) * lu(901) + lu(907) = lu(907) - lu(674) * lu(901) + lu(908) = lu(908) - lu(675) * lu(901) + lu(913) = - lu(676) * lu(901) + lu(915) = lu(915) - lu(677) * lu(901) + lu(916) = lu(916) - lu(678) * lu(901) + lu(917) = lu(917) - lu(679) * lu(901) + lu(919) = lu(919) - lu(680) * lu(901) + lu(921) = lu(921) - lu(681) * lu(901) + lu(1008) = lu(1008) - lu(672) * lu(1007) + lu(1011) = lu(1011) - lu(673) * lu(1007) + lu(1013) = lu(1013) - lu(674) * lu(1007) + lu(1014) = lu(1014) - lu(675) * lu(1007) + lu(1021) = lu(1021) - lu(676) * lu(1007) + lu(1025) = lu(1025) - lu(677) * lu(1007) + lu(1026) = lu(1026) - lu(678) * lu(1007) + lu(1027) = lu(1027) - lu(679) * lu(1007) + lu(1029) = lu(1029) - lu(680) * lu(1007) + lu(1031) = lu(1031) - lu(681) * lu(1007) + lu(1093) = lu(1093) - lu(672) * lu(1092) + lu(1096) = - lu(673) * lu(1092) + lu(1098) = lu(1098) - lu(674) * lu(1092) + lu(1099) = lu(1099) - lu(675) * lu(1092) + lu(1107) = lu(1107) - lu(676) * lu(1092) + lu(1111) = lu(1111) - lu(677) * lu(1092) + lu(1112) = lu(1112) - lu(678) * lu(1092) + lu(1113) = lu(1113) - lu(679) * lu(1092) + lu(1115) = lu(1115) - lu(680) * lu(1092) + lu(1117) = lu(1117) - lu(681) * lu(1092) + lu(1297) = lu(1297) - lu(672) * lu(1295) + lu(1300) = lu(1300) - lu(673) * lu(1295) + lu(1302) = lu(1302) - lu(674) * lu(1295) + lu(1303) = lu(1303) - lu(675) * lu(1295) + lu(1311) = lu(1311) - lu(676) * lu(1295) + lu(1315) = lu(1315) - lu(677) * lu(1295) + lu(1316) = lu(1316) - lu(678) * lu(1295) + lu(1317) = lu(1317) - lu(679) * lu(1295) + lu(1319) = lu(1319) - lu(680) * lu(1295) + lu(1321) = lu(1321) - lu(681) * lu(1295) + lu(1341) = lu(1341) - lu(672) * lu(1340) + lu(1344) = lu(1344) - lu(673) * lu(1340) + lu(1346) = lu(1346) - lu(674) * lu(1340) + lu(1347) = lu(1347) - lu(675) * lu(1340) + lu(1355) = lu(1355) - lu(676) * lu(1340) + lu(1359) = lu(1359) - lu(677) * lu(1340) + lu(1360) = lu(1360) - lu(678) * lu(1340) + lu(1361) = lu(1361) - lu(679) * lu(1340) + lu(1363) = lu(1363) - lu(680) * lu(1340) + lu(1365) = lu(1365) - lu(681) * lu(1340) + lu(1502) = lu(1502) - lu(672) * lu(1500) + lu(1505) = lu(1505) - lu(673) * lu(1500) + lu(1507) = lu(1507) - lu(674) * lu(1500) + lu(1508) = lu(1508) - lu(675) * lu(1500) + lu(1517) = lu(1517) - lu(676) * lu(1500) + lu(1521) = lu(1521) - lu(677) * lu(1500) + lu(1522) = lu(1522) - lu(678) * lu(1500) + lu(1523) = lu(1523) - lu(679) * lu(1500) + lu(1525) = lu(1525) - lu(680) * lu(1500) + lu(1527) = lu(1527) - lu(681) * lu(1500) + end subroutine lu_fac15 + subroutine lu_fac16( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(684) = 1._r8 / lu(684) + lu(685) = lu(685) * lu(684) + lu(686) = lu(686) * lu(684) + lu(687) = lu(687) * lu(684) + lu(688) = lu(688) * lu(684) + lu(689) = lu(689) * lu(684) + lu(690) = lu(690) * lu(684) + lu(691) = lu(691) * lu(684) + lu(692) = lu(692) * lu(684) + lu(693) = lu(693) * lu(684) + lu(694) = lu(694) * lu(684) + lu(957) = - lu(685) * lu(956) + lu(959) = lu(959) - lu(686) * lu(956) + lu(961) = lu(961) - lu(687) * lu(956) + lu(963) = - lu(688) * lu(956) + lu(965) = - lu(689) * lu(956) + lu(969) = lu(969) - lu(690) * lu(956) + lu(971) = lu(971) - lu(691) * lu(956) + lu(972) = lu(972) - lu(692) * lu(956) + lu(973) = - lu(693) * lu(956) + lu(974) = lu(974) - lu(694) * lu(956) + lu(1055) = lu(1055) - lu(685) * lu(1053) + lu(1057) = - lu(686) * lu(1053) + lu(1059) = lu(1059) - lu(687) * lu(1053) + lu(1061) = lu(1061) - lu(688) * lu(1053) + lu(1063) = lu(1063) - lu(689) * lu(1053) + lu(1067) = lu(1067) - lu(690) * lu(1053) + lu(1069) = lu(1069) - lu(691) * lu(1053) + lu(1070) = lu(1070) - lu(692) * lu(1053) + lu(1071) = lu(1071) - lu(693) * lu(1053) + lu(1072) = lu(1072) - lu(694) * lu(1053) + lu(1126) = lu(1126) - lu(685) * lu(1125) + lu(1128) = lu(1128) - lu(686) * lu(1125) + lu(1130) = lu(1130) - lu(687) * lu(1125) + lu(1132) = lu(1132) - lu(688) * lu(1125) + lu(1134) = lu(1134) - lu(689) * lu(1125) + lu(1138) = lu(1138) - lu(690) * lu(1125) + lu(1140) = lu(1140) - lu(691) * lu(1125) + lu(1141) = lu(1141) - lu(692) * lu(1125) + lu(1142) = lu(1142) - lu(693) * lu(1125) + lu(1143) = lu(1143) - lu(694) * lu(1125) + lu(1211) = lu(1211) - lu(685) * lu(1210) + lu(1213) = - lu(686) * lu(1210) + lu(1215) = lu(1215) - lu(687) * lu(1210) + lu(1217) = lu(1217) - lu(688) * lu(1210) + lu(1219) = lu(1219) - lu(689) * lu(1210) + lu(1223) = lu(1223) - lu(690) * lu(1210) + lu(1225) = lu(1225) - lu(691) * lu(1210) + lu(1226) = lu(1226) - lu(692) * lu(1210) + lu(1227) = lu(1227) - lu(693) * lu(1210) + lu(1228) = lu(1228) - lu(694) * lu(1210) + lu(1231) = - lu(685) * lu(1230) + lu(1233) = - lu(686) * lu(1230) + lu(1235) = - lu(687) * lu(1230) + lu(1237) = lu(1237) - lu(688) * lu(1230) + lu(1239) = - lu(689) * lu(1230) + lu(1243) = lu(1243) - lu(690) * lu(1230) + lu(1245) = - lu(691) * lu(1230) + lu(1246) = lu(1246) - lu(692) * lu(1230) + lu(1247) = - lu(693) * lu(1230) + lu(1248) = lu(1248) - lu(694) * lu(1230) + lu(1304) = lu(1304) - lu(685) * lu(1296) + lu(1306) = lu(1306) - lu(686) * lu(1296) + lu(1308) = lu(1308) - lu(687) * lu(1296) + lu(1310) = lu(1310) - lu(688) * lu(1296) + lu(1312) = lu(1312) - lu(689) * lu(1296) + lu(1316) = lu(1316) - lu(690) * lu(1296) + lu(1318) = lu(1318) - lu(691) * lu(1296) + lu(1319) = lu(1319) - lu(692) * lu(1296) + lu(1320) = lu(1320) - lu(693) * lu(1296) + lu(1321) = lu(1321) - lu(694) * lu(1296) + lu(1374) = - lu(685) * lu(1372) + lu(1376) = lu(1376) - lu(686) * lu(1372) + lu(1378) = lu(1378) - lu(687) * lu(1372) + lu(1380) = lu(1380) - lu(688) * lu(1372) + lu(1382) = lu(1382) - lu(689) * lu(1372) + lu(1386) = lu(1386) - lu(690) * lu(1372) + lu(1388) = lu(1388) - lu(691) * lu(1372) + lu(1389) = lu(1389) - lu(692) * lu(1372) + lu(1390) = - lu(693) * lu(1372) + lu(1391) = lu(1391) - lu(694) * lu(1372) + lu(1409) = lu(1409) - lu(685) * lu(1407) + lu(1411) = lu(1411) - lu(686) * lu(1407) + lu(1413) = lu(1413) - lu(687) * lu(1407) + lu(1415) = lu(1415) - lu(688) * lu(1407) + lu(1417) = - lu(689) * lu(1407) + lu(1421) = lu(1421) - lu(690) * lu(1407) + lu(1423) = lu(1423) - lu(691) * lu(1407) + lu(1424) = lu(1424) - lu(692) * lu(1407) + lu(1425) = lu(1425) - lu(693) * lu(1407) + lu(1426) = lu(1426) - lu(694) * lu(1407) + lu(1510) = lu(1510) - lu(685) * lu(1501) + lu(1512) = lu(1512) - lu(686) * lu(1501) + lu(1514) = lu(1514) - lu(687) * lu(1501) + lu(1516) = lu(1516) - lu(688) * lu(1501) + lu(1518) = lu(1518) - lu(689) * lu(1501) + lu(1522) = lu(1522) - lu(690) * lu(1501) + lu(1524) = lu(1524) - lu(691) * lu(1501) + lu(1525) = lu(1525) - lu(692) * lu(1501) + lu(1526) = lu(1526) - lu(693) * lu(1501) + lu(1527) = lu(1527) - lu(694) * lu(1501) + lu(696) = 1._r8 / lu(696) + lu(697) = lu(697) * lu(696) + lu(698) = lu(698) * lu(696) + lu(699) = lu(699) * lu(696) + lu(700) = lu(700) * lu(696) + lu(701) = lu(701) * lu(696) + lu(702) = lu(702) * lu(696) + lu(703) = lu(703) * lu(696) + lu(712) = lu(712) - lu(697) * lu(710) + lu(714) = - lu(698) * lu(710) + lu(718) = lu(718) - lu(699) * lu(710) + lu(719) = lu(719) - lu(700) * lu(710) + lu(720) = lu(720) - lu(701) * lu(710) + lu(721) = lu(721) - lu(702) * lu(710) + lu(722) = lu(722) - lu(703) * lu(710) + lu(738) = lu(738) - lu(697) * lu(732) + lu(740) = - lu(698) * lu(732) + lu(745) = lu(745) - lu(699) * lu(732) + lu(746) = lu(746) - lu(700) * lu(732) + lu(747) = lu(747) - lu(701) * lu(732) + lu(748) = lu(748) - lu(702) * lu(732) + lu(749) = lu(749) - lu(703) * lu(732) + lu(760) = lu(760) - lu(697) * lu(756) + lu(762) = - lu(698) * lu(756) + lu(766) = lu(766) - lu(699) * lu(756) + lu(767) = lu(767) - lu(700) * lu(756) + lu(768) = lu(768) - lu(701) * lu(756) + lu(769) = - lu(702) * lu(756) + lu(770) = lu(770) - lu(703) * lu(756) + lu(779) = lu(779) - lu(697) * lu(775) + lu(782) = lu(782) - lu(698) * lu(775) + lu(787) = lu(787) - lu(699) * lu(775) + lu(788) = lu(788) - lu(700) * lu(775) + lu(789) = lu(789) - lu(701) * lu(775) + lu(790) = lu(790) - lu(702) * lu(775) + lu(791) = lu(791) - lu(703) * lu(775) + lu(798) = lu(798) - lu(697) * lu(796) + lu(801) = - lu(698) * lu(796) + lu(806) = - lu(699) * lu(796) + lu(807) = lu(807) - lu(700) * lu(796) + lu(808) = lu(808) - lu(701) * lu(796) + lu(809) = lu(809) - lu(702) * lu(796) + lu(810) = lu(810) - lu(703) * lu(796) + lu(826) = lu(826) - lu(697) * lu(820) + lu(829) = - lu(698) * lu(820) + lu(834) = lu(834) - lu(699) * lu(820) + lu(835) = lu(835) - lu(700) * lu(820) + lu(836) = lu(836) - lu(701) * lu(820) + lu(837) = lu(837) - lu(702) * lu(820) + lu(838) = lu(838) - lu(703) * lu(820) + lu(908) = lu(908) - lu(697) * lu(902) + lu(911) = lu(911) - lu(698) * lu(902) + lu(916) = lu(916) - lu(699) * lu(902) + lu(917) = lu(917) - lu(700) * lu(902) + lu(918) = lu(918) - lu(701) * lu(902) + lu(919) = lu(919) - lu(702) * lu(902) + lu(921) = lu(921) - lu(703) * lu(902) + lu(1014) = lu(1014) - lu(697) * lu(1008) + lu(1018) = lu(1018) - lu(698) * lu(1008) + lu(1026) = lu(1026) - lu(699) * lu(1008) + lu(1027) = lu(1027) - lu(700) * lu(1008) + lu(1028) = lu(1028) - lu(701) * lu(1008) + lu(1029) = lu(1029) - lu(702) * lu(1008) + lu(1031) = lu(1031) - lu(703) * lu(1008) + lu(1099) = lu(1099) - lu(697) * lu(1093) + lu(1104) = lu(1104) - lu(698) * lu(1093) + lu(1112) = lu(1112) - lu(699) * lu(1093) + lu(1113) = lu(1113) - lu(700) * lu(1093) + lu(1114) = lu(1114) - lu(701) * lu(1093) + lu(1115) = lu(1115) - lu(702) * lu(1093) + lu(1117) = lu(1117) - lu(703) * lu(1093) + lu(1161) = lu(1161) - lu(697) * lu(1159) + lu(1167) = lu(1167) - lu(698) * lu(1159) + lu(1175) = lu(1175) - lu(699) * lu(1159) + lu(1176) = lu(1176) - lu(700) * lu(1159) + lu(1177) = lu(1177) - lu(701) * lu(1159) + lu(1178) = lu(1178) - lu(702) * lu(1159) + lu(1180) = lu(1180) - lu(703) * lu(1159) + lu(1303) = lu(1303) - lu(697) * lu(1297) + lu(1308) = lu(1308) - lu(698) * lu(1297) + lu(1316) = lu(1316) - lu(699) * lu(1297) + lu(1317) = lu(1317) - lu(700) * lu(1297) + lu(1318) = lu(1318) - lu(701) * lu(1297) + lu(1319) = lu(1319) - lu(702) * lu(1297) + lu(1321) = lu(1321) - lu(703) * lu(1297) + lu(1347) = lu(1347) - lu(697) * lu(1341) + lu(1352) = lu(1352) - lu(698) * lu(1341) + lu(1360) = lu(1360) - lu(699) * lu(1341) + lu(1361) = lu(1361) - lu(700) * lu(1341) + lu(1362) = lu(1362) - lu(701) * lu(1341) + lu(1363) = lu(1363) - lu(702) * lu(1341) + lu(1365) = lu(1365) - lu(703) * lu(1341) + lu(1508) = lu(1508) - lu(697) * lu(1502) + lu(1514) = lu(1514) - lu(698) * lu(1502) + lu(1522) = lu(1522) - lu(699) * lu(1502) + lu(1523) = lu(1523) - lu(700) * lu(1502) + lu(1524) = lu(1524) - lu(701) * lu(1502) + lu(1525) = lu(1525) - lu(702) * lu(1502) + lu(1527) = lu(1527) - lu(703) * lu(1502) + lu(711) = 1._r8 / lu(711) + lu(712) = lu(712) * lu(711) + lu(713) = lu(713) * lu(711) + lu(714) = lu(714) * lu(711) + lu(715) = lu(715) * lu(711) + lu(716) = lu(716) * lu(711) + lu(717) = lu(717) * lu(711) + lu(718) = lu(718) * lu(711) + lu(719) = lu(719) * lu(711) + lu(720) = lu(720) * lu(711) + lu(721) = lu(721) * lu(711) + lu(722) = lu(722) * lu(711) + lu(738) = lu(738) - lu(712) * lu(733) + lu(739) = lu(739) - lu(713) * lu(733) + lu(740) = lu(740) - lu(714) * lu(733) + lu(741) = lu(741) - lu(715) * lu(733) + lu(743) = lu(743) - lu(716) * lu(733) + lu(744) = lu(744) - lu(717) * lu(733) + lu(745) = lu(745) - lu(718) * lu(733) + lu(746) = lu(746) - lu(719) * lu(733) + lu(747) = lu(747) - lu(720) * lu(733) + lu(748) = lu(748) - lu(721) * lu(733) + lu(749) = lu(749) - lu(722) * lu(733) + lu(760) = lu(760) - lu(712) * lu(757) + lu(761) = lu(761) - lu(713) * lu(757) + lu(762) = lu(762) - lu(714) * lu(757) + lu(763) = lu(763) - lu(715) * lu(757) + lu(764) = lu(764) - lu(716) * lu(757) + lu(765) = lu(765) - lu(717) * lu(757) + lu(766) = lu(766) - lu(718) * lu(757) + lu(767) = lu(767) - lu(719) * lu(757) + lu(768) = lu(768) - lu(720) * lu(757) + lu(769) = lu(769) - lu(721) * lu(757) + lu(770) = lu(770) - lu(722) * lu(757) + lu(826) = lu(826) - lu(712) * lu(821) + lu(827) = lu(827) - lu(713) * lu(821) + lu(829) = lu(829) - lu(714) * lu(821) + lu(830) = lu(830) - lu(715) * lu(821) + lu(832) = lu(832) - lu(716) * lu(821) + lu(833) = lu(833) - lu(717) * lu(821) + lu(834) = lu(834) - lu(718) * lu(821) + lu(835) = lu(835) - lu(719) * lu(821) + lu(836) = lu(836) - lu(720) * lu(821) + lu(837) = lu(837) - lu(721) * lu(821) + lu(838) = lu(838) - lu(722) * lu(821) + lu(908) = lu(908) - lu(712) * lu(903) + lu(909) = lu(909) - lu(713) * lu(903) + lu(911) = lu(911) - lu(714) * lu(903) + lu(912) = lu(912) - lu(715) * lu(903) + lu(914) = lu(914) - lu(716) * lu(903) + lu(915) = lu(915) - lu(717) * lu(903) + lu(916) = lu(916) - lu(718) * lu(903) + lu(917) = lu(917) - lu(719) * lu(903) + lu(918) = lu(918) - lu(720) * lu(903) + lu(919) = lu(919) - lu(721) * lu(903) + lu(921) = lu(921) - lu(722) * lu(903) + lu(1014) = lu(1014) - lu(712) * lu(1009) + lu(1016) = lu(1016) - lu(713) * lu(1009) + lu(1018) = lu(1018) - lu(714) * lu(1009) + lu(1019) = lu(1019) - lu(715) * lu(1009) + lu(1023) = lu(1023) - lu(716) * lu(1009) + lu(1025) = lu(1025) - lu(717) * lu(1009) + lu(1026) = lu(1026) - lu(718) * lu(1009) + lu(1027) = lu(1027) - lu(719) * lu(1009) + lu(1028) = lu(1028) - lu(720) * lu(1009) + lu(1029) = lu(1029) - lu(721) * lu(1009) + lu(1031) = lu(1031) - lu(722) * lu(1009) + lu(1099) = lu(1099) - lu(712) * lu(1094) + lu(1102) = lu(1102) - lu(713) * lu(1094) + lu(1104) = lu(1104) - lu(714) * lu(1094) + lu(1105) = lu(1105) - lu(715) * lu(1094) + lu(1109) = lu(1109) - lu(716) * lu(1094) + lu(1111) = lu(1111) - lu(717) * lu(1094) + lu(1112) = lu(1112) - lu(718) * lu(1094) + lu(1113) = lu(1113) - lu(719) * lu(1094) + lu(1114) = lu(1114) - lu(720) * lu(1094) + lu(1115) = lu(1115) - lu(721) * lu(1094) + lu(1117) = lu(1117) - lu(722) * lu(1094) + lu(1303) = lu(1303) - lu(712) * lu(1298) + lu(1306) = lu(1306) - lu(713) * lu(1298) + lu(1308) = lu(1308) - lu(714) * lu(1298) + lu(1309) = lu(1309) - lu(715) * lu(1298) + lu(1313) = lu(1313) - lu(716) * lu(1298) + lu(1315) = lu(1315) - lu(717) * lu(1298) + lu(1316) = lu(1316) - lu(718) * lu(1298) + lu(1317) = lu(1317) - lu(719) * lu(1298) + lu(1318) = lu(1318) - lu(720) * lu(1298) + lu(1319) = lu(1319) - lu(721) * lu(1298) + lu(1321) = lu(1321) - lu(722) * lu(1298) + lu(1347) = lu(1347) - lu(712) * lu(1342) + lu(1350) = lu(1350) - lu(713) * lu(1342) + lu(1352) = lu(1352) - lu(714) * lu(1342) + lu(1353) = lu(1353) - lu(715) * lu(1342) + lu(1357) = lu(1357) - lu(716) * lu(1342) + lu(1359) = lu(1359) - lu(717) * lu(1342) + lu(1360) = lu(1360) - lu(718) * lu(1342) + lu(1361) = lu(1361) - lu(719) * lu(1342) + lu(1362) = lu(1362) - lu(720) * lu(1342) + lu(1363) = lu(1363) - lu(721) * lu(1342) + lu(1365) = lu(1365) - lu(722) * lu(1342) + lu(1508) = lu(1508) - lu(712) * lu(1503) + lu(1512) = lu(1512) - lu(713) * lu(1503) + lu(1514) = lu(1514) - lu(714) * lu(1503) + lu(1515) = lu(1515) - lu(715) * lu(1503) + lu(1519) = lu(1519) - lu(716) * lu(1503) + lu(1521) = lu(1521) - lu(717) * lu(1503) + lu(1522) = lu(1522) - lu(718) * lu(1503) + lu(1523) = lu(1523) - lu(719) * lu(1503) + lu(1524) = lu(1524) - lu(720) * lu(1503) + lu(1525) = lu(1525) - lu(721) * lu(1503) + lu(1527) = lu(1527) - lu(722) * lu(1503) + end subroutine lu_fac16 + subroutine lu_fac17( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(734) = 1._r8 / lu(734) + lu(735) = lu(735) * lu(734) + lu(736) = lu(736) * lu(734) + lu(737) = lu(737) * lu(734) + lu(738) = lu(738) * lu(734) + lu(739) = lu(739) * lu(734) + lu(740) = lu(740) * lu(734) + lu(741) = lu(741) * lu(734) + lu(742) = lu(742) * lu(734) + lu(743) = lu(743) * lu(734) + lu(744) = lu(744) * lu(734) + lu(745) = lu(745) * lu(734) + lu(746) = lu(746) * lu(734) + lu(747) = lu(747) * lu(734) + lu(748) = lu(748) * lu(734) + lu(749) = lu(749) * lu(734) + lu(823) = lu(823) - lu(735) * lu(822) + lu(824) = lu(824) - lu(736) * lu(822) + lu(825) = lu(825) - lu(737) * lu(822) + lu(826) = lu(826) - lu(738) * lu(822) + lu(827) = lu(827) - lu(739) * lu(822) + lu(829) = lu(829) - lu(740) * lu(822) + lu(830) = lu(830) - lu(741) * lu(822) + lu(831) = lu(831) - lu(742) * lu(822) + lu(832) = lu(832) - lu(743) * lu(822) + lu(833) = lu(833) - lu(744) * lu(822) + lu(834) = lu(834) - lu(745) * lu(822) + lu(835) = lu(835) - lu(746) * lu(822) + lu(836) = lu(836) - lu(747) * lu(822) + lu(837) = lu(837) - lu(748) * lu(822) + lu(838) = lu(838) - lu(749) * lu(822) + lu(905) = lu(905) - lu(735) * lu(904) + lu(906) = lu(906) - lu(736) * lu(904) + lu(907) = lu(907) - lu(737) * lu(904) + lu(908) = lu(908) - lu(738) * lu(904) + lu(909) = lu(909) - lu(739) * lu(904) + lu(911) = lu(911) - lu(740) * lu(904) + lu(912) = lu(912) - lu(741) * lu(904) + lu(913) = lu(913) - lu(742) * lu(904) + lu(914) = lu(914) - lu(743) * lu(904) + lu(915) = lu(915) - lu(744) * lu(904) + lu(916) = lu(916) - lu(745) * lu(904) + lu(917) = lu(917) - lu(746) * lu(904) + lu(918) = lu(918) - lu(747) * lu(904) + lu(919) = lu(919) - lu(748) * lu(904) + lu(921) = lu(921) - lu(749) * lu(904) + lu(1011) = lu(1011) - lu(735) * lu(1010) + lu(1012) = lu(1012) - lu(736) * lu(1010) + lu(1013) = lu(1013) - lu(737) * lu(1010) + lu(1014) = lu(1014) - lu(738) * lu(1010) + lu(1016) = lu(1016) - lu(739) * lu(1010) + lu(1018) = lu(1018) - lu(740) * lu(1010) + lu(1019) = lu(1019) - lu(741) * lu(1010) + lu(1021) = lu(1021) - lu(742) * lu(1010) + lu(1023) = lu(1023) - lu(743) * lu(1010) + lu(1025) = lu(1025) - lu(744) * lu(1010) + lu(1026) = lu(1026) - lu(745) * lu(1010) + lu(1027) = lu(1027) - lu(746) * lu(1010) + lu(1028) = lu(1028) - lu(747) * lu(1010) + lu(1029) = lu(1029) - lu(748) * lu(1010) + lu(1031) = lu(1031) - lu(749) * lu(1010) + lu(1096) = lu(1096) - lu(735) * lu(1095) + lu(1097) = lu(1097) - lu(736) * lu(1095) + lu(1098) = lu(1098) - lu(737) * lu(1095) + lu(1099) = lu(1099) - lu(738) * lu(1095) + lu(1102) = lu(1102) - lu(739) * lu(1095) + lu(1104) = lu(1104) - lu(740) * lu(1095) + lu(1105) = lu(1105) - lu(741) * lu(1095) + lu(1107) = lu(1107) - lu(742) * lu(1095) + lu(1109) = lu(1109) - lu(743) * lu(1095) + lu(1111) = lu(1111) - lu(744) * lu(1095) + lu(1112) = lu(1112) - lu(745) * lu(1095) + lu(1113) = lu(1113) - lu(746) * lu(1095) + lu(1114) = lu(1114) - lu(747) * lu(1095) + lu(1115) = lu(1115) - lu(748) * lu(1095) + lu(1117) = lu(1117) - lu(749) * lu(1095) + lu(1300) = lu(1300) - lu(735) * lu(1299) + lu(1301) = lu(1301) - lu(736) * lu(1299) + lu(1302) = lu(1302) - lu(737) * lu(1299) + lu(1303) = lu(1303) - lu(738) * lu(1299) + lu(1306) = lu(1306) - lu(739) * lu(1299) + lu(1308) = lu(1308) - lu(740) * lu(1299) + lu(1309) = lu(1309) - lu(741) * lu(1299) + lu(1311) = lu(1311) - lu(742) * lu(1299) + lu(1313) = lu(1313) - lu(743) * lu(1299) + lu(1315) = lu(1315) - lu(744) * lu(1299) + lu(1316) = lu(1316) - lu(745) * lu(1299) + lu(1317) = lu(1317) - lu(746) * lu(1299) + lu(1318) = lu(1318) - lu(747) * lu(1299) + lu(1319) = lu(1319) - lu(748) * lu(1299) + lu(1321) = lu(1321) - lu(749) * lu(1299) + lu(1344) = lu(1344) - lu(735) * lu(1343) + lu(1345) = lu(1345) - lu(736) * lu(1343) + lu(1346) = lu(1346) - lu(737) * lu(1343) + lu(1347) = lu(1347) - lu(738) * lu(1343) + lu(1350) = lu(1350) - lu(739) * lu(1343) + lu(1352) = lu(1352) - lu(740) * lu(1343) + lu(1353) = lu(1353) - lu(741) * lu(1343) + lu(1355) = lu(1355) - lu(742) * lu(1343) + lu(1357) = lu(1357) - lu(743) * lu(1343) + lu(1359) = lu(1359) - lu(744) * lu(1343) + lu(1360) = lu(1360) - lu(745) * lu(1343) + lu(1361) = lu(1361) - lu(746) * lu(1343) + lu(1362) = lu(1362) - lu(747) * lu(1343) + lu(1363) = lu(1363) - lu(748) * lu(1343) + lu(1365) = lu(1365) - lu(749) * lu(1343) + lu(1505) = lu(1505) - lu(735) * lu(1504) + lu(1506) = lu(1506) - lu(736) * lu(1504) + lu(1507) = lu(1507) - lu(737) * lu(1504) + lu(1508) = lu(1508) - lu(738) * lu(1504) + lu(1512) = lu(1512) - lu(739) * lu(1504) + lu(1514) = lu(1514) - lu(740) * lu(1504) + lu(1515) = lu(1515) - lu(741) * lu(1504) + lu(1517) = lu(1517) - lu(742) * lu(1504) + lu(1519) = lu(1519) - lu(743) * lu(1504) + lu(1521) = lu(1521) - lu(744) * lu(1504) + lu(1522) = lu(1522) - lu(745) * lu(1504) + lu(1523) = lu(1523) - lu(746) * lu(1504) + lu(1524) = lu(1524) - lu(747) * lu(1504) + lu(1525) = lu(1525) - lu(748) * lu(1504) + lu(1527) = lu(1527) - lu(749) * lu(1504) + lu(758) = 1._r8 / lu(758) + lu(759) = lu(759) * lu(758) + lu(760) = lu(760) * lu(758) + lu(761) = lu(761) * lu(758) + lu(762) = lu(762) * lu(758) + lu(763) = lu(763) * lu(758) + lu(764) = lu(764) * lu(758) + lu(765) = lu(765) * lu(758) + lu(766) = lu(766) * lu(758) + lu(767) = lu(767) * lu(758) + lu(768) = lu(768) * lu(758) + lu(769) = lu(769) * lu(758) + lu(770) = lu(770) * lu(758) + lu(778) = - lu(759) * lu(776) + lu(779) = lu(779) - lu(760) * lu(776) + lu(780) = lu(780) - lu(761) * lu(776) + lu(782) = lu(782) - lu(762) * lu(776) + lu(783) = lu(783) - lu(763) * lu(776) + lu(785) = lu(785) - lu(764) * lu(776) + lu(786) = lu(786) - lu(765) * lu(776) + lu(787) = lu(787) - lu(766) * lu(776) + lu(788) = lu(788) - lu(767) * lu(776) + lu(789) = lu(789) - lu(768) * lu(776) + lu(790) = lu(790) - lu(769) * lu(776) + lu(791) = lu(791) - lu(770) * lu(776) + lu(825) = lu(825) - lu(759) * lu(823) + lu(826) = lu(826) - lu(760) * lu(823) + lu(827) = lu(827) - lu(761) * lu(823) + lu(829) = lu(829) - lu(762) * lu(823) + lu(830) = lu(830) - lu(763) * lu(823) + lu(832) = lu(832) - lu(764) * lu(823) + lu(833) = lu(833) - lu(765) * lu(823) + lu(834) = lu(834) - lu(766) * lu(823) + lu(835) = lu(835) - lu(767) * lu(823) + lu(836) = lu(836) - lu(768) * lu(823) + lu(837) = lu(837) - lu(769) * lu(823) + lu(838) = lu(838) - lu(770) * lu(823) + lu(907) = lu(907) - lu(759) * lu(905) + lu(908) = lu(908) - lu(760) * lu(905) + lu(909) = lu(909) - lu(761) * lu(905) + lu(911) = lu(911) - lu(762) * lu(905) + lu(912) = lu(912) - lu(763) * lu(905) + lu(914) = lu(914) - lu(764) * lu(905) + lu(915) = lu(915) - lu(765) * lu(905) + lu(916) = lu(916) - lu(766) * lu(905) + lu(917) = lu(917) - lu(767) * lu(905) + lu(918) = lu(918) - lu(768) * lu(905) + lu(919) = lu(919) - lu(769) * lu(905) + lu(921) = lu(921) - lu(770) * lu(905) + lu(1013) = lu(1013) - lu(759) * lu(1011) + lu(1014) = lu(1014) - lu(760) * lu(1011) + lu(1016) = lu(1016) - lu(761) * lu(1011) + lu(1018) = lu(1018) - lu(762) * lu(1011) + lu(1019) = lu(1019) - lu(763) * lu(1011) + lu(1023) = lu(1023) - lu(764) * lu(1011) + lu(1025) = lu(1025) - lu(765) * lu(1011) + lu(1026) = lu(1026) - lu(766) * lu(1011) + lu(1027) = lu(1027) - lu(767) * lu(1011) + lu(1028) = lu(1028) - lu(768) * lu(1011) + lu(1029) = lu(1029) - lu(769) * lu(1011) + lu(1031) = lu(1031) - lu(770) * lu(1011) + lu(1098) = lu(1098) - lu(759) * lu(1096) + lu(1099) = lu(1099) - lu(760) * lu(1096) + lu(1102) = lu(1102) - lu(761) * lu(1096) + lu(1104) = lu(1104) - lu(762) * lu(1096) + lu(1105) = lu(1105) - lu(763) * lu(1096) + lu(1109) = lu(1109) - lu(764) * lu(1096) + lu(1111) = lu(1111) - lu(765) * lu(1096) + lu(1112) = lu(1112) - lu(766) * lu(1096) + lu(1113) = lu(1113) - lu(767) * lu(1096) + lu(1114) = lu(1114) - lu(768) * lu(1096) + lu(1115) = lu(1115) - lu(769) * lu(1096) + lu(1117) = lu(1117) - lu(770) * lu(1096) + lu(1302) = lu(1302) - lu(759) * lu(1300) + lu(1303) = lu(1303) - lu(760) * lu(1300) + lu(1306) = lu(1306) - lu(761) * lu(1300) + lu(1308) = lu(1308) - lu(762) * lu(1300) + lu(1309) = lu(1309) - lu(763) * lu(1300) + lu(1313) = lu(1313) - lu(764) * lu(1300) + lu(1315) = lu(1315) - lu(765) * lu(1300) + lu(1316) = lu(1316) - lu(766) * lu(1300) + lu(1317) = lu(1317) - lu(767) * lu(1300) + lu(1318) = lu(1318) - lu(768) * lu(1300) + lu(1319) = lu(1319) - lu(769) * lu(1300) + lu(1321) = lu(1321) - lu(770) * lu(1300) + lu(1346) = lu(1346) - lu(759) * lu(1344) + lu(1347) = lu(1347) - lu(760) * lu(1344) + lu(1350) = lu(1350) - lu(761) * lu(1344) + lu(1352) = lu(1352) - lu(762) * lu(1344) + lu(1353) = lu(1353) - lu(763) * lu(1344) + lu(1357) = lu(1357) - lu(764) * lu(1344) + lu(1359) = lu(1359) - lu(765) * lu(1344) + lu(1360) = lu(1360) - lu(766) * lu(1344) + lu(1361) = lu(1361) - lu(767) * lu(1344) + lu(1362) = lu(1362) - lu(768) * lu(1344) + lu(1363) = lu(1363) - lu(769) * lu(1344) + lu(1365) = lu(1365) - lu(770) * lu(1344) + lu(1507) = lu(1507) - lu(759) * lu(1505) + lu(1508) = lu(1508) - lu(760) * lu(1505) + lu(1512) = lu(1512) - lu(761) * lu(1505) + lu(1514) = lu(1514) - lu(762) * lu(1505) + lu(1515) = lu(1515) - lu(763) * lu(1505) + lu(1519) = lu(1519) - lu(764) * lu(1505) + lu(1521) = lu(1521) - lu(765) * lu(1505) + lu(1522) = lu(1522) - lu(766) * lu(1505) + lu(1523) = lu(1523) - lu(767) * lu(1505) + lu(1524) = lu(1524) - lu(768) * lu(1505) + lu(1525) = lu(1525) - lu(769) * lu(1505) + lu(1527) = lu(1527) - lu(770) * lu(1505) + lu(777) = 1._r8 / lu(777) + lu(778) = lu(778) * lu(777) + lu(779) = lu(779) * lu(777) + lu(780) = lu(780) * lu(777) + lu(781) = lu(781) * lu(777) + lu(782) = lu(782) * lu(777) + lu(783) = lu(783) * lu(777) + lu(784) = lu(784) * lu(777) + lu(785) = lu(785) * lu(777) + lu(786) = lu(786) * lu(777) + lu(787) = lu(787) * lu(777) + lu(788) = lu(788) * lu(777) + lu(789) = lu(789) * lu(777) + lu(790) = lu(790) * lu(777) + lu(791) = lu(791) * lu(777) + lu(825) = lu(825) - lu(778) * lu(824) + lu(826) = lu(826) - lu(779) * lu(824) + lu(827) = lu(827) - lu(780) * lu(824) + lu(828) = - lu(781) * lu(824) + lu(829) = lu(829) - lu(782) * lu(824) + lu(830) = lu(830) - lu(783) * lu(824) + lu(831) = lu(831) - lu(784) * lu(824) + lu(832) = lu(832) - lu(785) * lu(824) + lu(833) = lu(833) - lu(786) * lu(824) + lu(834) = lu(834) - lu(787) * lu(824) + lu(835) = lu(835) - lu(788) * lu(824) + lu(836) = lu(836) - lu(789) * lu(824) + lu(837) = lu(837) - lu(790) * lu(824) + lu(838) = lu(838) - lu(791) * lu(824) + lu(907) = lu(907) - lu(778) * lu(906) + lu(908) = lu(908) - lu(779) * lu(906) + lu(909) = lu(909) - lu(780) * lu(906) + lu(910) = lu(910) - lu(781) * lu(906) + lu(911) = lu(911) - lu(782) * lu(906) + lu(912) = lu(912) - lu(783) * lu(906) + lu(913) = lu(913) - lu(784) * lu(906) + lu(914) = lu(914) - lu(785) * lu(906) + lu(915) = lu(915) - lu(786) * lu(906) + lu(916) = lu(916) - lu(787) * lu(906) + lu(917) = lu(917) - lu(788) * lu(906) + lu(918) = lu(918) - lu(789) * lu(906) + lu(919) = lu(919) - lu(790) * lu(906) + lu(921) = lu(921) - lu(791) * lu(906) + lu(1013) = lu(1013) - lu(778) * lu(1012) + lu(1014) = lu(1014) - lu(779) * lu(1012) + lu(1016) = lu(1016) - lu(780) * lu(1012) + lu(1017) = lu(1017) - lu(781) * lu(1012) + lu(1018) = lu(1018) - lu(782) * lu(1012) + lu(1019) = lu(1019) - lu(783) * lu(1012) + lu(1021) = lu(1021) - lu(784) * lu(1012) + lu(1023) = lu(1023) - lu(785) * lu(1012) + lu(1025) = lu(1025) - lu(786) * lu(1012) + lu(1026) = lu(1026) - lu(787) * lu(1012) + lu(1027) = lu(1027) - lu(788) * lu(1012) + lu(1028) = lu(1028) - lu(789) * lu(1012) + lu(1029) = lu(1029) - lu(790) * lu(1012) + lu(1031) = lu(1031) - lu(791) * lu(1012) + lu(1098) = lu(1098) - lu(778) * lu(1097) + lu(1099) = lu(1099) - lu(779) * lu(1097) + lu(1102) = lu(1102) - lu(780) * lu(1097) + lu(1103) = lu(1103) - lu(781) * lu(1097) + lu(1104) = lu(1104) - lu(782) * lu(1097) + lu(1105) = lu(1105) - lu(783) * lu(1097) + lu(1107) = lu(1107) - lu(784) * lu(1097) + lu(1109) = lu(1109) - lu(785) * lu(1097) + lu(1111) = lu(1111) - lu(786) * lu(1097) + lu(1112) = lu(1112) - lu(787) * lu(1097) + lu(1113) = lu(1113) - lu(788) * lu(1097) + lu(1114) = lu(1114) - lu(789) * lu(1097) + lu(1115) = lu(1115) - lu(790) * lu(1097) + lu(1117) = lu(1117) - lu(791) * lu(1097) + lu(1302) = lu(1302) - lu(778) * lu(1301) + lu(1303) = lu(1303) - lu(779) * lu(1301) + lu(1306) = lu(1306) - lu(780) * lu(1301) + lu(1307) = lu(1307) - lu(781) * lu(1301) + lu(1308) = lu(1308) - lu(782) * lu(1301) + lu(1309) = lu(1309) - lu(783) * lu(1301) + lu(1311) = lu(1311) - lu(784) * lu(1301) + lu(1313) = lu(1313) - lu(785) * lu(1301) + lu(1315) = lu(1315) - lu(786) * lu(1301) + lu(1316) = lu(1316) - lu(787) * lu(1301) + lu(1317) = lu(1317) - lu(788) * lu(1301) + lu(1318) = lu(1318) - lu(789) * lu(1301) + lu(1319) = lu(1319) - lu(790) * lu(1301) + lu(1321) = lu(1321) - lu(791) * lu(1301) + lu(1346) = lu(1346) - lu(778) * lu(1345) + lu(1347) = lu(1347) - lu(779) * lu(1345) + lu(1350) = lu(1350) - lu(780) * lu(1345) + lu(1351) = lu(1351) - lu(781) * lu(1345) + lu(1352) = lu(1352) - lu(782) * lu(1345) + lu(1353) = lu(1353) - lu(783) * lu(1345) + lu(1355) = lu(1355) - lu(784) * lu(1345) + lu(1357) = lu(1357) - lu(785) * lu(1345) + lu(1359) = lu(1359) - lu(786) * lu(1345) + lu(1360) = lu(1360) - lu(787) * lu(1345) + lu(1361) = lu(1361) - lu(788) * lu(1345) + lu(1362) = lu(1362) - lu(789) * lu(1345) + lu(1363) = lu(1363) - lu(790) * lu(1345) + lu(1365) = lu(1365) - lu(791) * lu(1345) + lu(1507) = lu(1507) - lu(778) * lu(1506) + lu(1508) = lu(1508) - lu(779) * lu(1506) + lu(1512) = lu(1512) - lu(780) * lu(1506) + lu(1513) = lu(1513) - lu(781) * lu(1506) + lu(1514) = lu(1514) - lu(782) * lu(1506) + lu(1515) = lu(1515) - lu(783) * lu(1506) + lu(1517) = lu(1517) - lu(784) * lu(1506) + lu(1519) = lu(1519) - lu(785) * lu(1506) + lu(1521) = lu(1521) - lu(786) * lu(1506) + lu(1522) = lu(1522) - lu(787) * lu(1506) + lu(1523) = lu(1523) - lu(788) * lu(1506) + lu(1524) = lu(1524) - lu(789) * lu(1506) + lu(1525) = lu(1525) - lu(790) * lu(1506) + lu(1527) = lu(1527) - lu(791) * lu(1506) + lu(797) = 1._r8 / lu(797) + lu(798) = lu(798) * lu(797) + lu(799) = lu(799) * lu(797) + lu(800) = lu(800) * lu(797) + lu(801) = lu(801) * lu(797) + lu(802) = lu(802) * lu(797) + lu(803) = lu(803) * lu(797) + lu(804) = lu(804) * lu(797) + lu(805) = lu(805) * lu(797) + lu(806) = lu(806) * lu(797) + lu(807) = lu(807) * lu(797) + lu(808) = lu(808) * lu(797) + lu(809) = lu(809) * lu(797) + lu(810) = lu(810) * lu(797) + lu(826) = lu(826) - lu(798) * lu(825) + lu(827) = lu(827) - lu(799) * lu(825) + lu(828) = lu(828) - lu(800) * lu(825) + lu(829) = lu(829) - lu(801) * lu(825) + lu(830) = lu(830) - lu(802) * lu(825) + lu(831) = lu(831) - lu(803) * lu(825) + lu(832) = lu(832) - lu(804) * lu(825) + lu(833) = lu(833) - lu(805) * lu(825) + lu(834) = lu(834) - lu(806) * lu(825) + lu(835) = lu(835) - lu(807) * lu(825) + lu(836) = lu(836) - lu(808) * lu(825) + lu(837) = lu(837) - lu(809) * lu(825) + lu(838) = lu(838) - lu(810) * lu(825) + lu(908) = lu(908) - lu(798) * lu(907) + lu(909) = lu(909) - lu(799) * lu(907) + lu(910) = lu(910) - lu(800) * lu(907) + lu(911) = lu(911) - lu(801) * lu(907) + lu(912) = lu(912) - lu(802) * lu(907) + lu(913) = lu(913) - lu(803) * lu(907) + lu(914) = lu(914) - lu(804) * lu(907) + lu(915) = lu(915) - lu(805) * lu(907) + lu(916) = lu(916) - lu(806) * lu(907) + lu(917) = lu(917) - lu(807) * lu(907) + lu(918) = lu(918) - lu(808) * lu(907) + lu(919) = lu(919) - lu(809) * lu(907) + lu(921) = lu(921) - lu(810) * lu(907) + lu(1014) = lu(1014) - lu(798) * lu(1013) + lu(1016) = lu(1016) - lu(799) * lu(1013) + lu(1017) = lu(1017) - lu(800) * lu(1013) + lu(1018) = lu(1018) - lu(801) * lu(1013) + lu(1019) = lu(1019) - lu(802) * lu(1013) + lu(1021) = lu(1021) - lu(803) * lu(1013) + lu(1023) = lu(1023) - lu(804) * lu(1013) + lu(1025) = lu(1025) - lu(805) * lu(1013) + lu(1026) = lu(1026) - lu(806) * lu(1013) + lu(1027) = lu(1027) - lu(807) * lu(1013) + lu(1028) = lu(1028) - lu(808) * lu(1013) + lu(1029) = lu(1029) - lu(809) * lu(1013) + lu(1031) = lu(1031) - lu(810) * lu(1013) + lu(1099) = lu(1099) - lu(798) * lu(1098) + lu(1102) = lu(1102) - lu(799) * lu(1098) + lu(1103) = lu(1103) - lu(800) * lu(1098) + lu(1104) = lu(1104) - lu(801) * lu(1098) + lu(1105) = lu(1105) - lu(802) * lu(1098) + lu(1107) = lu(1107) - lu(803) * lu(1098) + lu(1109) = lu(1109) - lu(804) * lu(1098) + lu(1111) = lu(1111) - lu(805) * lu(1098) + lu(1112) = lu(1112) - lu(806) * lu(1098) + lu(1113) = lu(1113) - lu(807) * lu(1098) + lu(1114) = lu(1114) - lu(808) * lu(1098) + lu(1115) = lu(1115) - lu(809) * lu(1098) + lu(1117) = lu(1117) - lu(810) * lu(1098) + lu(1161) = lu(1161) - lu(798) * lu(1160) + lu(1165) = lu(1165) - lu(799) * lu(1160) + lu(1166) = lu(1166) - lu(800) * lu(1160) + lu(1167) = lu(1167) - lu(801) * lu(1160) + lu(1168) = lu(1168) - lu(802) * lu(1160) + lu(1170) = lu(1170) - lu(803) * lu(1160) + lu(1172) = lu(1172) - lu(804) * lu(1160) + lu(1174) = lu(1174) - lu(805) * lu(1160) + lu(1175) = lu(1175) - lu(806) * lu(1160) + lu(1176) = lu(1176) - lu(807) * lu(1160) + lu(1177) = lu(1177) - lu(808) * lu(1160) + lu(1178) = lu(1178) - lu(809) * lu(1160) + lu(1180) = lu(1180) - lu(810) * lu(1160) + lu(1303) = lu(1303) - lu(798) * lu(1302) + lu(1306) = lu(1306) - lu(799) * lu(1302) + lu(1307) = lu(1307) - lu(800) * lu(1302) + lu(1308) = lu(1308) - lu(801) * lu(1302) + lu(1309) = lu(1309) - lu(802) * lu(1302) + lu(1311) = lu(1311) - lu(803) * lu(1302) + lu(1313) = lu(1313) - lu(804) * lu(1302) + lu(1315) = lu(1315) - lu(805) * lu(1302) + lu(1316) = lu(1316) - lu(806) * lu(1302) + lu(1317) = lu(1317) - lu(807) * lu(1302) + lu(1318) = lu(1318) - lu(808) * lu(1302) + lu(1319) = lu(1319) - lu(809) * lu(1302) + lu(1321) = lu(1321) - lu(810) * lu(1302) + lu(1347) = lu(1347) - lu(798) * lu(1346) + lu(1350) = lu(1350) - lu(799) * lu(1346) + lu(1351) = lu(1351) - lu(800) * lu(1346) + lu(1352) = lu(1352) - lu(801) * lu(1346) + lu(1353) = lu(1353) - lu(802) * lu(1346) + lu(1355) = lu(1355) - lu(803) * lu(1346) + lu(1357) = lu(1357) - lu(804) * lu(1346) + lu(1359) = lu(1359) - lu(805) * lu(1346) + lu(1360) = lu(1360) - lu(806) * lu(1346) + lu(1361) = lu(1361) - lu(807) * lu(1346) + lu(1362) = lu(1362) - lu(808) * lu(1346) + lu(1363) = lu(1363) - lu(809) * lu(1346) + lu(1365) = lu(1365) - lu(810) * lu(1346) + lu(1508) = lu(1508) - lu(798) * lu(1507) + lu(1512) = lu(1512) - lu(799) * lu(1507) + lu(1513) = lu(1513) - lu(800) * lu(1507) + lu(1514) = lu(1514) - lu(801) * lu(1507) + lu(1515) = lu(1515) - lu(802) * lu(1507) + lu(1517) = lu(1517) - lu(803) * lu(1507) + lu(1519) = lu(1519) - lu(804) * lu(1507) + lu(1521) = lu(1521) - lu(805) * lu(1507) + lu(1522) = lu(1522) - lu(806) * lu(1507) + lu(1523) = lu(1523) - lu(807) * lu(1507) + lu(1524) = lu(1524) - lu(808) * lu(1507) + lu(1525) = lu(1525) - lu(809) * lu(1507) + lu(1527) = lu(1527) - lu(810) * lu(1507) + end subroutine lu_fac17 + subroutine lu_fac18( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(826) = 1._r8 / lu(826) + lu(827) = lu(827) * lu(826) + lu(828) = lu(828) * lu(826) + lu(829) = lu(829) * lu(826) + lu(830) = lu(830) * lu(826) + lu(831) = lu(831) * lu(826) + lu(832) = lu(832) * lu(826) + lu(833) = lu(833) * lu(826) + lu(834) = lu(834) * lu(826) + lu(835) = lu(835) * lu(826) + lu(836) = lu(836) * lu(826) + lu(837) = lu(837) * lu(826) + lu(838) = lu(838) * lu(826) + lu(909) = lu(909) - lu(827) * lu(908) + lu(910) = lu(910) - lu(828) * lu(908) + lu(911) = lu(911) - lu(829) * lu(908) + lu(912) = lu(912) - lu(830) * lu(908) + lu(913) = lu(913) - lu(831) * lu(908) + lu(914) = lu(914) - lu(832) * lu(908) + lu(915) = lu(915) - lu(833) * lu(908) + lu(916) = lu(916) - lu(834) * lu(908) + lu(917) = lu(917) - lu(835) * lu(908) + lu(918) = lu(918) - lu(836) * lu(908) + lu(919) = lu(919) - lu(837) * lu(908) + lu(921) = lu(921) - lu(838) * lu(908) + lu(1016) = lu(1016) - lu(827) * lu(1014) + lu(1017) = lu(1017) - lu(828) * lu(1014) + lu(1018) = lu(1018) - lu(829) * lu(1014) + lu(1019) = lu(1019) - lu(830) * lu(1014) + lu(1021) = lu(1021) - lu(831) * lu(1014) + lu(1023) = lu(1023) - lu(832) * lu(1014) + lu(1025) = lu(1025) - lu(833) * lu(1014) + lu(1026) = lu(1026) - lu(834) * lu(1014) + lu(1027) = lu(1027) - lu(835) * lu(1014) + lu(1028) = lu(1028) - lu(836) * lu(1014) + lu(1029) = lu(1029) - lu(837) * lu(1014) + lu(1031) = lu(1031) - lu(838) * lu(1014) + lu(1102) = lu(1102) - lu(827) * lu(1099) + lu(1103) = lu(1103) - lu(828) * lu(1099) + lu(1104) = lu(1104) - lu(829) * lu(1099) + lu(1105) = lu(1105) - lu(830) * lu(1099) + lu(1107) = lu(1107) - lu(831) * lu(1099) + lu(1109) = lu(1109) - lu(832) * lu(1099) + lu(1111) = lu(1111) - lu(833) * lu(1099) + lu(1112) = lu(1112) - lu(834) * lu(1099) + lu(1113) = lu(1113) - lu(835) * lu(1099) + lu(1114) = lu(1114) - lu(836) * lu(1099) + lu(1115) = lu(1115) - lu(837) * lu(1099) + lu(1117) = lu(1117) - lu(838) * lu(1099) + lu(1165) = lu(1165) - lu(827) * lu(1161) + lu(1166) = lu(1166) - lu(828) * lu(1161) + lu(1167) = lu(1167) - lu(829) * lu(1161) + lu(1168) = lu(1168) - lu(830) * lu(1161) + lu(1170) = lu(1170) - lu(831) * lu(1161) + lu(1172) = lu(1172) - lu(832) * lu(1161) + lu(1174) = lu(1174) - lu(833) * lu(1161) + lu(1175) = lu(1175) - lu(834) * lu(1161) + lu(1176) = lu(1176) - lu(835) * lu(1161) + lu(1177) = lu(1177) - lu(836) * lu(1161) + lu(1178) = lu(1178) - lu(837) * lu(1161) + lu(1180) = lu(1180) - lu(838) * lu(1161) + lu(1306) = lu(1306) - lu(827) * lu(1303) + lu(1307) = lu(1307) - lu(828) * lu(1303) + lu(1308) = lu(1308) - lu(829) * lu(1303) + lu(1309) = lu(1309) - lu(830) * lu(1303) + lu(1311) = lu(1311) - lu(831) * lu(1303) + lu(1313) = lu(1313) - lu(832) * lu(1303) + lu(1315) = lu(1315) - lu(833) * lu(1303) + lu(1316) = lu(1316) - lu(834) * lu(1303) + lu(1317) = lu(1317) - lu(835) * lu(1303) + lu(1318) = lu(1318) - lu(836) * lu(1303) + lu(1319) = lu(1319) - lu(837) * lu(1303) + lu(1321) = lu(1321) - lu(838) * lu(1303) + lu(1350) = lu(1350) - lu(827) * lu(1347) + lu(1351) = lu(1351) - lu(828) * lu(1347) + lu(1352) = lu(1352) - lu(829) * lu(1347) + lu(1353) = lu(1353) - lu(830) * lu(1347) + lu(1355) = lu(1355) - lu(831) * lu(1347) + lu(1357) = lu(1357) - lu(832) * lu(1347) + lu(1359) = lu(1359) - lu(833) * lu(1347) + lu(1360) = lu(1360) - lu(834) * lu(1347) + lu(1361) = lu(1361) - lu(835) * lu(1347) + lu(1362) = lu(1362) - lu(836) * lu(1347) + lu(1363) = lu(1363) - lu(837) * lu(1347) + lu(1365) = lu(1365) - lu(838) * lu(1347) + lu(1411) = lu(1411) - lu(827) * lu(1408) + lu(1412) = lu(1412) - lu(828) * lu(1408) + lu(1413) = lu(1413) - lu(829) * lu(1408) + lu(1414) = lu(1414) - lu(830) * lu(1408) + lu(1416) = lu(1416) - lu(831) * lu(1408) + lu(1418) = lu(1418) - lu(832) * lu(1408) + lu(1420) = lu(1420) - lu(833) * lu(1408) + lu(1421) = lu(1421) - lu(834) * lu(1408) + lu(1422) = lu(1422) - lu(835) * lu(1408) + lu(1423) = lu(1423) - lu(836) * lu(1408) + lu(1424) = lu(1424) - lu(837) * lu(1408) + lu(1426) = lu(1426) - lu(838) * lu(1408) + lu(1512) = lu(1512) - lu(827) * lu(1508) + lu(1513) = lu(1513) - lu(828) * lu(1508) + lu(1514) = lu(1514) - lu(829) * lu(1508) + lu(1515) = lu(1515) - lu(830) * lu(1508) + lu(1517) = lu(1517) - lu(831) * lu(1508) + lu(1519) = lu(1519) - lu(832) * lu(1508) + lu(1521) = lu(1521) - lu(833) * lu(1508) + lu(1522) = lu(1522) - lu(834) * lu(1508) + lu(1523) = lu(1523) - lu(835) * lu(1508) + lu(1524) = lu(1524) - lu(836) * lu(1508) + lu(1525) = lu(1525) - lu(837) * lu(1508) + lu(1527) = lu(1527) - lu(838) * lu(1508) + lu(842) = 1._r8 / lu(842) + lu(843) = lu(843) * lu(842) + lu(844) = lu(844) * lu(842) + lu(845) = lu(845) * lu(842) + lu(846) = lu(846) * lu(842) + lu(847) = lu(847) * lu(842) + lu(848) = lu(848) * lu(842) + lu(849) = lu(849) * lu(842) + lu(850) = lu(850) * lu(842) + lu(851) = lu(851) * lu(842) + lu(852) = lu(852) * lu(842) + lu(853) = lu(853) * lu(842) + lu(854) = lu(854) * lu(842) + lu(855) = lu(855) * lu(842) + lu(939) = - lu(843) * lu(938) + lu(940) = lu(940) - lu(844) * lu(938) + lu(941) = lu(941) - lu(845) * lu(938) + lu(942) = lu(942) - lu(846) * lu(938) + lu(943) = lu(943) - lu(847) * lu(938) + lu(945) = lu(945) - lu(848) * lu(938) + lu(946) = - lu(849) * lu(938) + lu(948) = lu(948) - lu(850) * lu(938) + lu(949) = lu(949) - lu(851) * lu(938) + lu(950) = lu(950) - lu(852) * lu(938) + lu(951) = - lu(853) * lu(938) + lu(952) = lu(952) - lu(854) * lu(938) + lu(953) = - lu(855) * lu(938) + lu(1056) = lu(1056) - lu(843) * lu(1054) + lu(1058) = lu(1058) - lu(844) * lu(1054) + lu(1060) = lu(1060) - lu(845) * lu(1054) + lu(1061) = lu(1061) - lu(846) * lu(1054) + lu(1062) = lu(1062) - lu(847) * lu(1054) + lu(1064) = lu(1064) - lu(848) * lu(1054) + lu(1065) = lu(1065) - lu(849) * lu(1054) + lu(1067) = lu(1067) - lu(850) * lu(1054) + lu(1068) = lu(1068) - lu(851) * lu(1054) + lu(1070) = lu(1070) - lu(852) * lu(1054) + lu(1071) = lu(1071) - lu(853) * lu(1054) + lu(1072) = lu(1072) - lu(854) * lu(1054) + lu(1073) = lu(1073) - lu(855) * lu(1054) + lu(1101) = lu(1101) - lu(843) * lu(1100) + lu(1103) = lu(1103) - lu(844) * lu(1100) + lu(1105) = lu(1105) - lu(845) * lu(1100) + lu(1106) = lu(1106) - lu(846) * lu(1100) + lu(1107) = lu(1107) - lu(847) * lu(1100) + lu(1109) = lu(1109) - lu(848) * lu(1100) + lu(1110) = lu(1110) - lu(849) * lu(1100) + lu(1112) = lu(1112) - lu(850) * lu(1100) + lu(1113) = lu(1113) - lu(851) * lu(1100) + lu(1115) = lu(1115) - lu(852) * lu(1100) + lu(1116) = lu(1116) - lu(853) * lu(1100) + lu(1117) = lu(1117) - lu(854) * lu(1100) + lu(1118) = lu(1118) - lu(855) * lu(1100) + lu(1164) = lu(1164) - lu(843) * lu(1162) + lu(1166) = lu(1166) - lu(844) * lu(1162) + lu(1168) = lu(1168) - lu(845) * lu(1162) + lu(1169) = lu(1169) - lu(846) * lu(1162) + lu(1170) = lu(1170) - lu(847) * lu(1162) + lu(1172) = lu(1172) - lu(848) * lu(1162) + lu(1173) = lu(1173) - lu(849) * lu(1162) + lu(1175) = lu(1175) - lu(850) * lu(1162) + lu(1176) = lu(1176) - lu(851) * lu(1162) + lu(1178) = lu(1178) - lu(852) * lu(1162) + lu(1179) = lu(1179) - lu(853) * lu(1162) + lu(1180) = lu(1180) - lu(854) * lu(1162) + lu(1181) = lu(1181) - lu(855) * lu(1162) + lu(1189) = lu(1189) - lu(843) * lu(1187) + lu(1190) = lu(1190) - lu(844) * lu(1187) + lu(1192) = lu(1192) - lu(845) * lu(1187) + lu(1193) = lu(1193) - lu(846) * lu(1187) + lu(1194) = - lu(847) * lu(1187) + lu(1196) = lu(1196) - lu(848) * lu(1187) + lu(1197) = lu(1197) - lu(849) * lu(1187) + lu(1199) = - lu(850) * lu(1187) + lu(1200) = lu(1200) - lu(851) * lu(1187) + lu(1202) = lu(1202) - lu(852) * lu(1187) + lu(1203) = lu(1203) - lu(853) * lu(1187) + lu(1204) = lu(1204) - lu(854) * lu(1187) + lu(1205) = lu(1205) - lu(855) * lu(1187) + lu(1349) = - lu(843) * lu(1348) + lu(1351) = lu(1351) - lu(844) * lu(1348) + lu(1353) = lu(1353) - lu(845) * lu(1348) + lu(1354) = lu(1354) - lu(846) * lu(1348) + lu(1355) = lu(1355) - lu(847) * lu(1348) + lu(1357) = lu(1357) - lu(848) * lu(1348) + lu(1358) = - lu(849) * lu(1348) + lu(1360) = lu(1360) - lu(850) * lu(1348) + lu(1361) = lu(1361) - lu(851) * lu(1348) + lu(1363) = lu(1363) - lu(852) * lu(1348) + lu(1364) = - lu(853) * lu(1348) + lu(1365) = lu(1365) - lu(854) * lu(1348) + lu(1366) = - lu(855) * lu(1348) + lu(1375) = - lu(843) * lu(1373) + lu(1377) = - lu(844) * lu(1373) + lu(1379) = - lu(845) * lu(1373) + lu(1380) = lu(1380) - lu(846) * lu(1373) + lu(1381) = - lu(847) * lu(1373) + lu(1383) = - lu(848) * lu(1373) + lu(1384) = - lu(849) * lu(1373) + lu(1386) = lu(1386) - lu(850) * lu(1373) + lu(1387) = lu(1387) - lu(851) * lu(1373) + lu(1389) = lu(1389) - lu(852) * lu(1373) + lu(1390) = lu(1390) - lu(853) * lu(1373) + lu(1391) = lu(1391) - lu(854) * lu(1373) + lu(1392) = - lu(855) * lu(1373) + lu(1511) = lu(1511) - lu(843) * lu(1509) + lu(1513) = lu(1513) - lu(844) * lu(1509) + lu(1515) = lu(1515) - lu(845) * lu(1509) + lu(1516) = lu(1516) - lu(846) * lu(1509) + lu(1517) = lu(1517) - lu(847) * lu(1509) + lu(1519) = lu(1519) - lu(848) * lu(1509) + lu(1520) = lu(1520) - lu(849) * lu(1509) + lu(1522) = lu(1522) - lu(850) * lu(1509) + lu(1523) = lu(1523) - lu(851) * lu(1509) + lu(1525) = lu(1525) - lu(852) * lu(1509) + lu(1526) = lu(1526) - lu(853) * lu(1509) + lu(1527) = lu(1527) - lu(854) * lu(1509) + lu(1528) = lu(1528) - lu(855) * lu(1509) + lu(1538) = lu(1538) - lu(843) * lu(1536) + lu(1540) = lu(1540) - lu(844) * lu(1536) + lu(1542) = lu(1542) - lu(845) * lu(1536) + lu(1543) = lu(1543) - lu(846) * lu(1536) + lu(1544) = - lu(847) * lu(1536) + lu(1546) = lu(1546) - lu(848) * lu(1536) + lu(1547) = lu(1547) - lu(849) * lu(1536) + lu(1549) = - lu(850) * lu(1536) + lu(1550) = lu(1550) - lu(851) * lu(1536) + lu(1552) = lu(1552) - lu(852) * lu(1536) + lu(1553) = lu(1553) - lu(853) * lu(1536) + lu(1554) = lu(1554) - lu(854) * lu(1536) + lu(1555) = lu(1555) - lu(855) * lu(1536) + lu(861) = 1._r8 / lu(861) + lu(862) = lu(862) * lu(861) + lu(863) = lu(863) * lu(861) + lu(864) = lu(864) * lu(861) + lu(865) = lu(865) * lu(861) + lu(866) = lu(866) * lu(861) + lu(867) = lu(867) * lu(861) + lu(868) = lu(868) * lu(861) + lu(869) = lu(869) * lu(861) + lu(870) = lu(870) * lu(861) + lu(871) = lu(871) * lu(861) + lu(872) = lu(872) * lu(861) + lu(873) = lu(873) * lu(861) + lu(958) = - lu(862) * lu(957) + lu(961) = lu(961) - lu(863) * lu(957) + lu(963) = lu(963) - lu(864) * lu(957) + lu(965) = lu(965) - lu(865) * lu(957) + lu(966) = lu(966) - lu(866) * lu(957) + lu(967) = - lu(867) * lu(957) + lu(969) = lu(969) - lu(868) * lu(957) + lu(971) = lu(971) - lu(869) * lu(957) + lu(972) = lu(972) - lu(870) * lu(957) + lu(973) = lu(973) - lu(871) * lu(957) + lu(974) = lu(974) - lu(872) * lu(957) + lu(975) = - lu(873) * lu(957) + lu(1056) = lu(1056) - lu(862) * lu(1055) + lu(1059) = lu(1059) - lu(863) * lu(1055) + lu(1061) = lu(1061) - lu(864) * lu(1055) + lu(1063) = lu(1063) - lu(865) * lu(1055) + lu(1064) = lu(1064) - lu(866) * lu(1055) + lu(1065) = lu(1065) - lu(867) * lu(1055) + lu(1067) = lu(1067) - lu(868) * lu(1055) + lu(1069) = lu(1069) - lu(869) * lu(1055) + lu(1070) = lu(1070) - lu(870) * lu(1055) + lu(1071) = lu(1071) - lu(871) * lu(1055) + lu(1072) = lu(1072) - lu(872) * lu(1055) + lu(1073) = lu(1073) - lu(873) * lu(1055) + lu(1127) = lu(1127) - lu(862) * lu(1126) + lu(1130) = lu(1130) - lu(863) * lu(1126) + lu(1132) = lu(1132) - lu(864) * lu(1126) + lu(1134) = lu(1134) - lu(865) * lu(1126) + lu(1135) = - lu(866) * lu(1126) + lu(1136) = - lu(867) * lu(1126) + lu(1138) = lu(1138) - lu(868) * lu(1126) + lu(1140) = lu(1140) - lu(869) * lu(1126) + lu(1141) = lu(1141) - lu(870) * lu(1126) + lu(1142) = lu(1142) - lu(871) * lu(1126) + lu(1143) = lu(1143) - lu(872) * lu(1126) + lu(1144) = - lu(873) * lu(1126) + lu(1164) = lu(1164) - lu(862) * lu(1163) + lu(1167) = lu(1167) - lu(863) * lu(1163) + lu(1169) = lu(1169) - lu(864) * lu(1163) + lu(1171) = lu(1171) - lu(865) * lu(1163) + lu(1172) = lu(1172) - lu(866) * lu(1163) + lu(1173) = lu(1173) - lu(867) * lu(1163) + lu(1175) = lu(1175) - lu(868) * lu(1163) + lu(1177) = lu(1177) - lu(869) * lu(1163) + lu(1178) = lu(1178) - lu(870) * lu(1163) + lu(1179) = lu(1179) - lu(871) * lu(1163) + lu(1180) = lu(1180) - lu(872) * lu(1163) + lu(1181) = lu(1181) - lu(873) * lu(1163) + lu(1189) = lu(1189) - lu(862) * lu(1188) + lu(1191) = lu(1191) - lu(863) * lu(1188) + lu(1193) = lu(1193) - lu(864) * lu(1188) + lu(1195) = - lu(865) * lu(1188) + lu(1196) = lu(1196) - lu(866) * lu(1188) + lu(1197) = lu(1197) - lu(867) * lu(1188) + lu(1199) = lu(1199) - lu(868) * lu(1188) + lu(1201) = lu(1201) - lu(869) * lu(1188) + lu(1202) = lu(1202) - lu(870) * lu(1188) + lu(1203) = lu(1203) - lu(871) * lu(1188) + lu(1204) = lu(1204) - lu(872) * lu(1188) + lu(1205) = lu(1205) - lu(873) * lu(1188) + lu(1212) = lu(1212) - lu(862) * lu(1211) + lu(1215) = lu(1215) - lu(863) * lu(1211) + lu(1217) = lu(1217) - lu(864) * lu(1211) + lu(1219) = lu(1219) - lu(865) * lu(1211) + lu(1220) = lu(1220) - lu(866) * lu(1211) + lu(1221) = - lu(867) * lu(1211) + lu(1223) = lu(1223) - lu(868) * lu(1211) + lu(1225) = lu(1225) - lu(869) * lu(1211) + lu(1226) = lu(1226) - lu(870) * lu(1211) + lu(1227) = lu(1227) - lu(871) * lu(1211) + lu(1228) = lu(1228) - lu(872) * lu(1211) + lu(1229) = - lu(873) * lu(1211) + lu(1232) = - lu(862) * lu(1231) + lu(1235) = lu(1235) - lu(863) * lu(1231) + lu(1237) = lu(1237) - lu(864) * lu(1231) + lu(1239) = lu(1239) - lu(865) * lu(1231) + lu(1240) = - lu(866) * lu(1231) + lu(1241) = - lu(867) * lu(1231) + lu(1243) = lu(1243) - lu(868) * lu(1231) + lu(1245) = lu(1245) - lu(869) * lu(1231) + lu(1246) = lu(1246) - lu(870) * lu(1231) + lu(1247) = lu(1247) - lu(871) * lu(1231) + lu(1248) = lu(1248) - lu(872) * lu(1231) + lu(1249) = - lu(873) * lu(1231) + lu(1305) = lu(1305) - lu(862) * lu(1304) + lu(1308) = lu(1308) - lu(863) * lu(1304) + lu(1310) = lu(1310) - lu(864) * lu(1304) + lu(1312) = lu(1312) - lu(865) * lu(1304) + lu(1313) = lu(1313) - lu(866) * lu(1304) + lu(1314) = lu(1314) - lu(867) * lu(1304) + lu(1316) = lu(1316) - lu(868) * lu(1304) + lu(1318) = lu(1318) - lu(869) * lu(1304) + lu(1319) = lu(1319) - lu(870) * lu(1304) + lu(1320) = lu(1320) - lu(871) * lu(1304) + lu(1321) = lu(1321) - lu(872) * lu(1304) + lu(1322) = lu(1322) - lu(873) * lu(1304) + lu(1375) = lu(1375) - lu(862) * lu(1374) + lu(1378) = lu(1378) - lu(863) * lu(1374) + lu(1380) = lu(1380) - lu(864) * lu(1374) + lu(1382) = lu(1382) - lu(865) * lu(1374) + lu(1383) = lu(1383) - lu(866) * lu(1374) + lu(1384) = lu(1384) - lu(867) * lu(1374) + lu(1386) = lu(1386) - lu(868) * lu(1374) + lu(1388) = lu(1388) - lu(869) * lu(1374) + lu(1389) = lu(1389) - lu(870) * lu(1374) + lu(1390) = lu(1390) - lu(871) * lu(1374) + lu(1391) = lu(1391) - lu(872) * lu(1374) + lu(1392) = lu(1392) - lu(873) * lu(1374) + lu(1410) = lu(1410) - lu(862) * lu(1409) + lu(1413) = lu(1413) - lu(863) * lu(1409) + lu(1415) = lu(1415) - lu(864) * lu(1409) + lu(1417) = lu(1417) - lu(865) * lu(1409) + lu(1418) = lu(1418) - lu(866) * lu(1409) + lu(1419) = - lu(867) * lu(1409) + lu(1421) = lu(1421) - lu(868) * lu(1409) + lu(1423) = lu(1423) - lu(869) * lu(1409) + lu(1424) = lu(1424) - lu(870) * lu(1409) + lu(1425) = lu(1425) - lu(871) * lu(1409) + lu(1426) = lu(1426) - lu(872) * lu(1409) + lu(1427) = lu(1427) - lu(873) * lu(1409) + lu(1511) = lu(1511) - lu(862) * lu(1510) + lu(1514) = lu(1514) - lu(863) * lu(1510) + lu(1516) = lu(1516) - lu(864) * lu(1510) + lu(1518) = lu(1518) - lu(865) * lu(1510) + lu(1519) = lu(1519) - lu(866) * lu(1510) + lu(1520) = lu(1520) - lu(867) * lu(1510) + lu(1522) = lu(1522) - lu(868) * lu(1510) + lu(1524) = lu(1524) - lu(869) * lu(1510) + lu(1525) = lu(1525) - lu(870) * lu(1510) + lu(1526) = lu(1526) - lu(871) * lu(1510) + lu(1527) = lu(1527) - lu(872) * lu(1510) + lu(1528) = lu(1528) - lu(873) * lu(1510) + lu(1538) = lu(1538) - lu(862) * lu(1537) + lu(1541) = lu(1541) - lu(863) * lu(1537) + lu(1543) = lu(1543) - lu(864) * lu(1537) + lu(1545) = - lu(865) * lu(1537) + lu(1546) = lu(1546) - lu(866) * lu(1537) + lu(1547) = lu(1547) - lu(867) * lu(1537) + lu(1549) = lu(1549) - lu(868) * lu(1537) + lu(1551) = lu(1551) - lu(869) * lu(1537) + lu(1552) = lu(1552) - lu(870) * lu(1537) + lu(1553) = lu(1553) - lu(871) * lu(1537) + lu(1554) = lu(1554) - lu(872) * lu(1537) + lu(1555) = lu(1555) - lu(873) * lu(1537) + end subroutine lu_fac18 + subroutine lu_fac19( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(876) = 1._r8 / lu(876) + lu(877) = lu(877) * lu(876) + lu(878) = lu(878) * lu(876) + lu(879) = lu(879) * lu(876) + lu(880) = lu(880) * lu(876) + lu(881) = lu(881) * lu(876) + lu(882) = lu(882) * lu(876) + lu(883) = lu(883) * lu(876) + lu(884) = lu(884) * lu(876) + lu(885) = lu(885) * lu(876) + lu(886) = lu(886) * lu(876) + lu(940) = lu(940) - lu(877) * lu(939) + lu(942) = lu(942) - lu(878) * lu(939) + lu(943) = lu(943) - lu(879) * lu(939) + lu(944) = lu(944) - lu(880) * lu(939) + lu(946) = lu(946) - lu(881) * lu(939) + lu(947) = lu(947) - lu(882) * lu(939) + lu(948) = lu(948) - lu(883) * lu(939) + lu(949) = lu(949) - lu(884) * lu(939) + lu(950) = lu(950) - lu(885) * lu(939) + lu(952) = lu(952) - lu(886) * lu(939) + lu(960) = - lu(877) * lu(958) + lu(963) = lu(963) - lu(878) * lu(958) + lu(964) = - lu(879) * lu(958) + lu(965) = lu(965) - lu(880) * lu(958) + lu(967) = lu(967) - lu(881) * lu(958) + lu(968) = - lu(882) * lu(958) + lu(969) = lu(969) - lu(883) * lu(958) + lu(970) = - lu(884) * lu(958) + lu(972) = lu(972) - lu(885) * lu(958) + lu(974) = lu(974) - lu(886) * lu(958) + lu(1017) = lu(1017) - lu(877) * lu(1015) + lu(1020) = lu(1020) - lu(878) * lu(1015) + lu(1021) = lu(1021) - lu(879) * lu(1015) + lu(1022) = lu(1022) - lu(880) * lu(1015) + lu(1024) = lu(1024) - lu(881) * lu(1015) + lu(1025) = lu(1025) - lu(882) * lu(1015) + lu(1026) = lu(1026) - lu(883) * lu(1015) + lu(1027) = lu(1027) - lu(884) * lu(1015) + lu(1029) = lu(1029) - lu(885) * lu(1015) + lu(1031) = lu(1031) - lu(886) * lu(1015) + lu(1058) = lu(1058) - lu(877) * lu(1056) + lu(1061) = lu(1061) - lu(878) * lu(1056) + lu(1062) = lu(1062) - lu(879) * lu(1056) + lu(1063) = lu(1063) - lu(880) * lu(1056) + lu(1065) = lu(1065) - lu(881) * lu(1056) + lu(1066) = lu(1066) - lu(882) * lu(1056) + lu(1067) = lu(1067) - lu(883) * lu(1056) + lu(1068) = lu(1068) - lu(884) * lu(1056) + lu(1070) = lu(1070) - lu(885) * lu(1056) + lu(1072) = lu(1072) - lu(886) * lu(1056) + lu(1103) = lu(1103) - lu(877) * lu(1101) + lu(1106) = lu(1106) - lu(878) * lu(1101) + lu(1107) = lu(1107) - lu(879) * lu(1101) + lu(1108) = lu(1108) - lu(880) * lu(1101) + lu(1110) = lu(1110) - lu(881) * lu(1101) + lu(1111) = lu(1111) - lu(882) * lu(1101) + lu(1112) = lu(1112) - lu(883) * lu(1101) + lu(1113) = lu(1113) - lu(884) * lu(1101) + lu(1115) = lu(1115) - lu(885) * lu(1101) + lu(1117) = lu(1117) - lu(886) * lu(1101) + lu(1129) = lu(1129) - lu(877) * lu(1127) + lu(1132) = lu(1132) - lu(878) * lu(1127) + lu(1133) = lu(1133) - lu(879) * lu(1127) + lu(1134) = lu(1134) - lu(880) * lu(1127) + lu(1136) = lu(1136) - lu(881) * lu(1127) + lu(1137) = lu(1137) - lu(882) * lu(1127) + lu(1138) = lu(1138) - lu(883) * lu(1127) + lu(1139) = lu(1139) - lu(884) * lu(1127) + lu(1141) = lu(1141) - lu(885) * lu(1127) + lu(1143) = lu(1143) - lu(886) * lu(1127) + lu(1166) = lu(1166) - lu(877) * lu(1164) + lu(1169) = lu(1169) - lu(878) * lu(1164) + lu(1170) = lu(1170) - lu(879) * lu(1164) + lu(1171) = lu(1171) - lu(880) * lu(1164) + lu(1173) = lu(1173) - lu(881) * lu(1164) + lu(1174) = lu(1174) - lu(882) * lu(1164) + lu(1175) = lu(1175) - lu(883) * lu(1164) + lu(1176) = lu(1176) - lu(884) * lu(1164) + lu(1178) = lu(1178) - lu(885) * lu(1164) + lu(1180) = lu(1180) - lu(886) * lu(1164) + lu(1190) = lu(1190) - lu(877) * lu(1189) + lu(1193) = lu(1193) - lu(878) * lu(1189) + lu(1194) = lu(1194) - lu(879) * lu(1189) + lu(1195) = lu(1195) - lu(880) * lu(1189) + lu(1197) = lu(1197) - lu(881) * lu(1189) + lu(1198) = - lu(882) * lu(1189) + lu(1199) = lu(1199) - lu(883) * lu(1189) + lu(1200) = lu(1200) - lu(884) * lu(1189) + lu(1202) = lu(1202) - lu(885) * lu(1189) + lu(1204) = lu(1204) - lu(886) * lu(1189) + lu(1214) = - lu(877) * lu(1212) + lu(1217) = lu(1217) - lu(878) * lu(1212) + lu(1218) = - lu(879) * lu(1212) + lu(1219) = lu(1219) - lu(880) * lu(1212) + lu(1221) = lu(1221) - lu(881) * lu(1212) + lu(1222) = lu(1222) - lu(882) * lu(1212) + lu(1223) = lu(1223) - lu(883) * lu(1212) + lu(1224) = lu(1224) - lu(884) * lu(1212) + lu(1226) = lu(1226) - lu(885) * lu(1212) + lu(1228) = lu(1228) - lu(886) * lu(1212) + lu(1234) = lu(1234) - lu(877) * lu(1232) + lu(1237) = lu(1237) - lu(878) * lu(1232) + lu(1238) = lu(1238) - lu(879) * lu(1232) + lu(1239) = lu(1239) - lu(880) * lu(1232) + lu(1241) = lu(1241) - lu(881) * lu(1232) + lu(1242) = - lu(882) * lu(1232) + lu(1243) = lu(1243) - lu(883) * lu(1232) + lu(1244) = lu(1244) - lu(884) * lu(1232) + lu(1246) = lu(1246) - lu(885) * lu(1232) + lu(1248) = lu(1248) - lu(886) * lu(1232) + lu(1307) = lu(1307) - lu(877) * lu(1305) + lu(1310) = lu(1310) - lu(878) * lu(1305) + lu(1311) = lu(1311) - lu(879) * lu(1305) + lu(1312) = lu(1312) - lu(880) * lu(1305) + lu(1314) = lu(1314) - lu(881) * lu(1305) + lu(1315) = lu(1315) - lu(882) * lu(1305) + lu(1316) = lu(1316) - lu(883) * lu(1305) + lu(1317) = lu(1317) - lu(884) * lu(1305) + lu(1319) = lu(1319) - lu(885) * lu(1305) + lu(1321) = lu(1321) - lu(886) * lu(1305) + lu(1351) = lu(1351) - lu(877) * lu(1349) + lu(1354) = lu(1354) - lu(878) * lu(1349) + lu(1355) = lu(1355) - lu(879) * lu(1349) + lu(1356) = - lu(880) * lu(1349) + lu(1358) = lu(1358) - lu(881) * lu(1349) + lu(1359) = lu(1359) - lu(882) * lu(1349) + lu(1360) = lu(1360) - lu(883) * lu(1349) + lu(1361) = lu(1361) - lu(884) * lu(1349) + lu(1363) = lu(1363) - lu(885) * lu(1349) + lu(1365) = lu(1365) - lu(886) * lu(1349) + lu(1377) = lu(1377) - lu(877) * lu(1375) + lu(1380) = lu(1380) - lu(878) * lu(1375) + lu(1381) = lu(1381) - lu(879) * lu(1375) + lu(1382) = lu(1382) - lu(880) * lu(1375) + lu(1384) = lu(1384) - lu(881) * lu(1375) + lu(1385) = - lu(882) * lu(1375) + lu(1386) = lu(1386) - lu(883) * lu(1375) + lu(1387) = lu(1387) - lu(884) * lu(1375) + lu(1389) = lu(1389) - lu(885) * lu(1375) + lu(1391) = lu(1391) - lu(886) * lu(1375) + lu(1412) = lu(1412) - lu(877) * lu(1410) + lu(1415) = lu(1415) - lu(878) * lu(1410) + lu(1416) = lu(1416) - lu(879) * lu(1410) + lu(1417) = lu(1417) - lu(880) * lu(1410) + lu(1419) = lu(1419) - lu(881) * lu(1410) + lu(1420) = lu(1420) - lu(882) * lu(1410) + lu(1421) = lu(1421) - lu(883) * lu(1410) + lu(1422) = lu(1422) - lu(884) * lu(1410) + lu(1424) = lu(1424) - lu(885) * lu(1410) + lu(1426) = lu(1426) - lu(886) * lu(1410) + lu(1513) = lu(1513) - lu(877) * lu(1511) + lu(1516) = lu(1516) - lu(878) * lu(1511) + lu(1517) = lu(1517) - lu(879) * lu(1511) + lu(1518) = lu(1518) - lu(880) * lu(1511) + lu(1520) = lu(1520) - lu(881) * lu(1511) + lu(1521) = lu(1521) - lu(882) * lu(1511) + lu(1522) = lu(1522) - lu(883) * lu(1511) + lu(1523) = lu(1523) - lu(884) * lu(1511) + lu(1525) = lu(1525) - lu(885) * lu(1511) + lu(1527) = lu(1527) - lu(886) * lu(1511) + lu(1540) = lu(1540) - lu(877) * lu(1538) + lu(1543) = lu(1543) - lu(878) * lu(1538) + lu(1544) = lu(1544) - lu(879) * lu(1538) + lu(1545) = lu(1545) - lu(880) * lu(1538) + lu(1547) = lu(1547) - lu(881) * lu(1538) + lu(1548) = lu(1548) - lu(882) * lu(1538) + lu(1549) = lu(1549) - lu(883) * lu(1538) + lu(1550) = lu(1550) - lu(884) * lu(1538) + lu(1552) = lu(1552) - lu(885) * lu(1538) + lu(1554) = lu(1554) - lu(886) * lu(1538) + lu(909) = 1._r8 / lu(909) + lu(910) = lu(910) * lu(909) + lu(911) = lu(911) * lu(909) + lu(912) = lu(912) * lu(909) + lu(913) = lu(913) * lu(909) + lu(914) = lu(914) * lu(909) + lu(915) = lu(915) * lu(909) + lu(916) = lu(916) * lu(909) + lu(917) = lu(917) * lu(909) + lu(918) = lu(918) * lu(909) + lu(919) = lu(919) * lu(909) + lu(920) = lu(920) * lu(909) + lu(921) = lu(921) * lu(909) + lu(922) = lu(922) * lu(909) + lu(960) = lu(960) - lu(910) * lu(959) + lu(961) = lu(961) - lu(911) * lu(959) + lu(962) = - lu(912) * lu(959) + lu(964) = lu(964) - lu(913) * lu(959) + lu(966) = lu(966) - lu(914) * lu(959) + lu(968) = lu(968) - lu(915) * lu(959) + lu(969) = lu(969) - lu(916) * lu(959) + lu(970) = lu(970) - lu(917) * lu(959) + lu(971) = lu(971) - lu(918) * lu(959) + lu(972) = lu(972) - lu(919) * lu(959) + lu(973) = lu(973) - lu(920) * lu(959) + lu(974) = lu(974) - lu(921) * lu(959) + lu(975) = lu(975) - lu(922) * lu(959) + lu(1017) = lu(1017) - lu(910) * lu(1016) + lu(1018) = lu(1018) - lu(911) * lu(1016) + lu(1019) = lu(1019) - lu(912) * lu(1016) + lu(1021) = lu(1021) - lu(913) * lu(1016) + lu(1023) = lu(1023) - lu(914) * lu(1016) + lu(1025) = lu(1025) - lu(915) * lu(1016) + lu(1026) = lu(1026) - lu(916) * lu(1016) + lu(1027) = lu(1027) - lu(917) * lu(1016) + lu(1028) = lu(1028) - lu(918) * lu(1016) + lu(1029) = lu(1029) - lu(919) * lu(1016) + lu(1030) = lu(1030) - lu(920) * lu(1016) + lu(1031) = lu(1031) - lu(921) * lu(1016) + lu(1032) = lu(1032) - lu(922) * lu(1016) + lu(1058) = lu(1058) - lu(910) * lu(1057) + lu(1059) = lu(1059) - lu(911) * lu(1057) + lu(1060) = lu(1060) - lu(912) * lu(1057) + lu(1062) = lu(1062) - lu(913) * lu(1057) + lu(1064) = lu(1064) - lu(914) * lu(1057) + lu(1066) = lu(1066) - lu(915) * lu(1057) + lu(1067) = lu(1067) - lu(916) * lu(1057) + lu(1068) = lu(1068) - lu(917) * lu(1057) + lu(1069) = lu(1069) - lu(918) * lu(1057) + lu(1070) = lu(1070) - lu(919) * lu(1057) + lu(1071) = lu(1071) - lu(920) * lu(1057) + lu(1072) = lu(1072) - lu(921) * lu(1057) + lu(1073) = lu(1073) - lu(922) * lu(1057) + lu(1103) = lu(1103) - lu(910) * lu(1102) + lu(1104) = lu(1104) - lu(911) * lu(1102) + lu(1105) = lu(1105) - lu(912) * lu(1102) + lu(1107) = lu(1107) - lu(913) * lu(1102) + lu(1109) = lu(1109) - lu(914) * lu(1102) + lu(1111) = lu(1111) - lu(915) * lu(1102) + lu(1112) = lu(1112) - lu(916) * lu(1102) + lu(1113) = lu(1113) - lu(917) * lu(1102) + lu(1114) = lu(1114) - lu(918) * lu(1102) + lu(1115) = lu(1115) - lu(919) * lu(1102) + lu(1116) = lu(1116) - lu(920) * lu(1102) + lu(1117) = lu(1117) - lu(921) * lu(1102) + lu(1118) = lu(1118) - lu(922) * lu(1102) + lu(1129) = lu(1129) - lu(910) * lu(1128) + lu(1130) = lu(1130) - lu(911) * lu(1128) + lu(1131) = lu(1131) - lu(912) * lu(1128) + lu(1133) = lu(1133) - lu(913) * lu(1128) + lu(1135) = lu(1135) - lu(914) * lu(1128) + lu(1137) = lu(1137) - lu(915) * lu(1128) + lu(1138) = lu(1138) - lu(916) * lu(1128) + lu(1139) = lu(1139) - lu(917) * lu(1128) + lu(1140) = lu(1140) - lu(918) * lu(1128) + lu(1141) = lu(1141) - lu(919) * lu(1128) + lu(1142) = lu(1142) - lu(920) * lu(1128) + lu(1143) = lu(1143) - lu(921) * lu(1128) + lu(1144) = lu(1144) - lu(922) * lu(1128) + lu(1166) = lu(1166) - lu(910) * lu(1165) + lu(1167) = lu(1167) - lu(911) * lu(1165) + lu(1168) = lu(1168) - lu(912) * lu(1165) + lu(1170) = lu(1170) - lu(913) * lu(1165) + lu(1172) = lu(1172) - lu(914) * lu(1165) + lu(1174) = lu(1174) - lu(915) * lu(1165) + lu(1175) = lu(1175) - lu(916) * lu(1165) + lu(1176) = lu(1176) - lu(917) * lu(1165) + lu(1177) = lu(1177) - lu(918) * lu(1165) + lu(1178) = lu(1178) - lu(919) * lu(1165) + lu(1179) = lu(1179) - lu(920) * lu(1165) + lu(1180) = lu(1180) - lu(921) * lu(1165) + lu(1181) = lu(1181) - lu(922) * lu(1165) + lu(1214) = lu(1214) - lu(910) * lu(1213) + lu(1215) = lu(1215) - lu(911) * lu(1213) + lu(1216) = lu(1216) - lu(912) * lu(1213) + lu(1218) = lu(1218) - lu(913) * lu(1213) + lu(1220) = lu(1220) - lu(914) * lu(1213) + lu(1222) = lu(1222) - lu(915) * lu(1213) + lu(1223) = lu(1223) - lu(916) * lu(1213) + lu(1224) = lu(1224) - lu(917) * lu(1213) + lu(1225) = lu(1225) - lu(918) * lu(1213) + lu(1226) = lu(1226) - lu(919) * lu(1213) + lu(1227) = lu(1227) - lu(920) * lu(1213) + lu(1228) = lu(1228) - lu(921) * lu(1213) + lu(1229) = lu(1229) - lu(922) * lu(1213) + lu(1234) = lu(1234) - lu(910) * lu(1233) + lu(1235) = lu(1235) - lu(911) * lu(1233) + lu(1236) = - lu(912) * lu(1233) + lu(1238) = lu(1238) - lu(913) * lu(1233) + lu(1240) = lu(1240) - lu(914) * lu(1233) + lu(1242) = lu(1242) - lu(915) * lu(1233) + lu(1243) = lu(1243) - lu(916) * lu(1233) + lu(1244) = lu(1244) - lu(917) * lu(1233) + lu(1245) = lu(1245) - lu(918) * lu(1233) + lu(1246) = lu(1246) - lu(919) * lu(1233) + lu(1247) = lu(1247) - lu(920) * lu(1233) + lu(1248) = lu(1248) - lu(921) * lu(1233) + lu(1249) = lu(1249) - lu(922) * lu(1233) + lu(1307) = lu(1307) - lu(910) * lu(1306) + lu(1308) = lu(1308) - lu(911) * lu(1306) + lu(1309) = lu(1309) - lu(912) * lu(1306) + lu(1311) = lu(1311) - lu(913) * lu(1306) + lu(1313) = lu(1313) - lu(914) * lu(1306) + lu(1315) = lu(1315) - lu(915) * lu(1306) + lu(1316) = lu(1316) - lu(916) * lu(1306) + lu(1317) = lu(1317) - lu(917) * lu(1306) + lu(1318) = lu(1318) - lu(918) * lu(1306) + lu(1319) = lu(1319) - lu(919) * lu(1306) + lu(1320) = lu(1320) - lu(920) * lu(1306) + lu(1321) = lu(1321) - lu(921) * lu(1306) + lu(1322) = lu(1322) - lu(922) * lu(1306) + lu(1351) = lu(1351) - lu(910) * lu(1350) + lu(1352) = lu(1352) - lu(911) * lu(1350) + lu(1353) = lu(1353) - lu(912) * lu(1350) + lu(1355) = lu(1355) - lu(913) * lu(1350) + lu(1357) = lu(1357) - lu(914) * lu(1350) + lu(1359) = lu(1359) - lu(915) * lu(1350) + lu(1360) = lu(1360) - lu(916) * lu(1350) + lu(1361) = lu(1361) - lu(917) * lu(1350) + lu(1362) = lu(1362) - lu(918) * lu(1350) + lu(1363) = lu(1363) - lu(919) * lu(1350) + lu(1364) = lu(1364) - lu(920) * lu(1350) + lu(1365) = lu(1365) - lu(921) * lu(1350) + lu(1366) = lu(1366) - lu(922) * lu(1350) + lu(1377) = lu(1377) - lu(910) * lu(1376) + lu(1378) = lu(1378) - lu(911) * lu(1376) + lu(1379) = lu(1379) - lu(912) * lu(1376) + lu(1381) = lu(1381) - lu(913) * lu(1376) + lu(1383) = lu(1383) - lu(914) * lu(1376) + lu(1385) = lu(1385) - lu(915) * lu(1376) + lu(1386) = lu(1386) - lu(916) * lu(1376) + lu(1387) = lu(1387) - lu(917) * lu(1376) + lu(1388) = lu(1388) - lu(918) * lu(1376) + lu(1389) = lu(1389) - lu(919) * lu(1376) + lu(1390) = lu(1390) - lu(920) * lu(1376) + lu(1391) = lu(1391) - lu(921) * lu(1376) + lu(1392) = lu(1392) - lu(922) * lu(1376) + lu(1412) = lu(1412) - lu(910) * lu(1411) + lu(1413) = lu(1413) - lu(911) * lu(1411) + lu(1414) = lu(1414) - lu(912) * lu(1411) + lu(1416) = lu(1416) - lu(913) * lu(1411) + lu(1418) = lu(1418) - lu(914) * lu(1411) + lu(1420) = lu(1420) - lu(915) * lu(1411) + lu(1421) = lu(1421) - lu(916) * lu(1411) + lu(1422) = lu(1422) - lu(917) * lu(1411) + lu(1423) = lu(1423) - lu(918) * lu(1411) + lu(1424) = lu(1424) - lu(919) * lu(1411) + lu(1425) = lu(1425) - lu(920) * lu(1411) + lu(1426) = lu(1426) - lu(921) * lu(1411) + lu(1427) = lu(1427) - lu(922) * lu(1411) + lu(1513) = lu(1513) - lu(910) * lu(1512) + lu(1514) = lu(1514) - lu(911) * lu(1512) + lu(1515) = lu(1515) - lu(912) * lu(1512) + lu(1517) = lu(1517) - lu(913) * lu(1512) + lu(1519) = lu(1519) - lu(914) * lu(1512) + lu(1521) = lu(1521) - lu(915) * lu(1512) + lu(1522) = lu(1522) - lu(916) * lu(1512) + lu(1523) = lu(1523) - lu(917) * lu(1512) + lu(1524) = lu(1524) - lu(918) * lu(1512) + lu(1525) = lu(1525) - lu(919) * lu(1512) + lu(1526) = lu(1526) - lu(920) * lu(1512) + lu(1527) = lu(1527) - lu(921) * lu(1512) + lu(1528) = lu(1528) - lu(922) * lu(1512) + lu(1540) = lu(1540) - lu(910) * lu(1539) + lu(1541) = lu(1541) - lu(911) * lu(1539) + lu(1542) = lu(1542) - lu(912) * lu(1539) + lu(1544) = lu(1544) - lu(913) * lu(1539) + lu(1546) = lu(1546) - lu(914) * lu(1539) + lu(1548) = lu(1548) - lu(915) * lu(1539) + lu(1549) = lu(1549) - lu(916) * lu(1539) + lu(1550) = lu(1550) - lu(917) * lu(1539) + lu(1551) = lu(1551) - lu(918) * lu(1539) + lu(1552) = lu(1552) - lu(919) * lu(1539) + lu(1553) = lu(1553) - lu(920) * lu(1539) + lu(1554) = lu(1554) - lu(921) * lu(1539) + lu(1555) = lu(1555) - lu(922) * lu(1539) + lu(940) = 1._r8 / lu(940) + lu(941) = lu(941) * lu(940) + lu(942) = lu(942) * lu(940) + lu(943) = lu(943) * lu(940) + lu(944) = lu(944) * lu(940) + lu(945) = lu(945) * lu(940) + lu(946) = lu(946) * lu(940) + lu(947) = lu(947) * lu(940) + lu(948) = lu(948) * lu(940) + lu(949) = lu(949) * lu(940) + lu(950) = lu(950) * lu(940) + lu(951) = lu(951) * lu(940) + lu(952) = lu(952) * lu(940) + lu(953) = lu(953) * lu(940) + lu(962) = lu(962) - lu(941) * lu(960) + lu(963) = lu(963) - lu(942) * lu(960) + lu(964) = lu(964) - lu(943) * lu(960) + lu(965) = lu(965) - lu(944) * lu(960) + lu(966) = lu(966) - lu(945) * lu(960) + lu(967) = lu(967) - lu(946) * lu(960) + lu(968) = lu(968) - lu(947) * lu(960) + lu(969) = lu(969) - lu(948) * lu(960) + lu(970) = lu(970) - lu(949) * lu(960) + lu(972) = lu(972) - lu(950) * lu(960) + lu(973) = lu(973) - lu(951) * lu(960) + lu(974) = lu(974) - lu(952) * lu(960) + lu(975) = lu(975) - lu(953) * lu(960) + lu(1019) = lu(1019) - lu(941) * lu(1017) + lu(1020) = lu(1020) - lu(942) * lu(1017) + lu(1021) = lu(1021) - lu(943) * lu(1017) + lu(1022) = lu(1022) - lu(944) * lu(1017) + lu(1023) = lu(1023) - lu(945) * lu(1017) + lu(1024) = lu(1024) - lu(946) * lu(1017) + lu(1025) = lu(1025) - lu(947) * lu(1017) + lu(1026) = lu(1026) - lu(948) * lu(1017) + lu(1027) = lu(1027) - lu(949) * lu(1017) + lu(1029) = lu(1029) - lu(950) * lu(1017) + lu(1030) = lu(1030) - lu(951) * lu(1017) + lu(1031) = lu(1031) - lu(952) * lu(1017) + lu(1032) = lu(1032) - lu(953) * lu(1017) + lu(1060) = lu(1060) - lu(941) * lu(1058) + lu(1061) = lu(1061) - lu(942) * lu(1058) + lu(1062) = lu(1062) - lu(943) * lu(1058) + lu(1063) = lu(1063) - lu(944) * lu(1058) + lu(1064) = lu(1064) - lu(945) * lu(1058) + lu(1065) = lu(1065) - lu(946) * lu(1058) + lu(1066) = lu(1066) - lu(947) * lu(1058) + lu(1067) = lu(1067) - lu(948) * lu(1058) + lu(1068) = lu(1068) - lu(949) * lu(1058) + lu(1070) = lu(1070) - lu(950) * lu(1058) + lu(1071) = lu(1071) - lu(951) * lu(1058) + lu(1072) = lu(1072) - lu(952) * lu(1058) + lu(1073) = lu(1073) - lu(953) * lu(1058) + lu(1105) = lu(1105) - lu(941) * lu(1103) + lu(1106) = lu(1106) - lu(942) * lu(1103) + lu(1107) = lu(1107) - lu(943) * lu(1103) + lu(1108) = lu(1108) - lu(944) * lu(1103) + lu(1109) = lu(1109) - lu(945) * lu(1103) + lu(1110) = lu(1110) - lu(946) * lu(1103) + lu(1111) = lu(1111) - lu(947) * lu(1103) + lu(1112) = lu(1112) - lu(948) * lu(1103) + lu(1113) = lu(1113) - lu(949) * lu(1103) + lu(1115) = lu(1115) - lu(950) * lu(1103) + lu(1116) = lu(1116) - lu(951) * lu(1103) + lu(1117) = lu(1117) - lu(952) * lu(1103) + lu(1118) = lu(1118) - lu(953) * lu(1103) + lu(1131) = lu(1131) - lu(941) * lu(1129) + lu(1132) = lu(1132) - lu(942) * lu(1129) + lu(1133) = lu(1133) - lu(943) * lu(1129) + lu(1134) = lu(1134) - lu(944) * lu(1129) + lu(1135) = lu(1135) - lu(945) * lu(1129) + lu(1136) = lu(1136) - lu(946) * lu(1129) + lu(1137) = lu(1137) - lu(947) * lu(1129) + lu(1138) = lu(1138) - lu(948) * lu(1129) + lu(1139) = lu(1139) - lu(949) * lu(1129) + lu(1141) = lu(1141) - lu(950) * lu(1129) + lu(1142) = lu(1142) - lu(951) * lu(1129) + lu(1143) = lu(1143) - lu(952) * lu(1129) + lu(1144) = lu(1144) - lu(953) * lu(1129) + lu(1168) = lu(1168) - lu(941) * lu(1166) + lu(1169) = lu(1169) - lu(942) * lu(1166) + lu(1170) = lu(1170) - lu(943) * lu(1166) + lu(1171) = lu(1171) - lu(944) * lu(1166) + lu(1172) = lu(1172) - lu(945) * lu(1166) + lu(1173) = lu(1173) - lu(946) * lu(1166) + lu(1174) = lu(1174) - lu(947) * lu(1166) + lu(1175) = lu(1175) - lu(948) * lu(1166) + lu(1176) = lu(1176) - lu(949) * lu(1166) + lu(1178) = lu(1178) - lu(950) * lu(1166) + lu(1179) = lu(1179) - lu(951) * lu(1166) + lu(1180) = lu(1180) - lu(952) * lu(1166) + lu(1181) = lu(1181) - lu(953) * lu(1166) + lu(1192) = lu(1192) - lu(941) * lu(1190) + lu(1193) = lu(1193) - lu(942) * lu(1190) + lu(1194) = lu(1194) - lu(943) * lu(1190) + lu(1195) = lu(1195) - lu(944) * lu(1190) + lu(1196) = lu(1196) - lu(945) * lu(1190) + lu(1197) = lu(1197) - lu(946) * lu(1190) + lu(1198) = lu(1198) - lu(947) * lu(1190) + lu(1199) = lu(1199) - lu(948) * lu(1190) + lu(1200) = lu(1200) - lu(949) * lu(1190) + lu(1202) = lu(1202) - lu(950) * lu(1190) + lu(1203) = lu(1203) - lu(951) * lu(1190) + lu(1204) = lu(1204) - lu(952) * lu(1190) + lu(1205) = lu(1205) - lu(953) * lu(1190) + lu(1216) = lu(1216) - lu(941) * lu(1214) + lu(1217) = lu(1217) - lu(942) * lu(1214) + lu(1218) = lu(1218) - lu(943) * lu(1214) + lu(1219) = lu(1219) - lu(944) * lu(1214) + lu(1220) = lu(1220) - lu(945) * lu(1214) + lu(1221) = lu(1221) - lu(946) * lu(1214) + lu(1222) = lu(1222) - lu(947) * lu(1214) + lu(1223) = lu(1223) - lu(948) * lu(1214) + lu(1224) = lu(1224) - lu(949) * lu(1214) + lu(1226) = lu(1226) - lu(950) * lu(1214) + lu(1227) = lu(1227) - lu(951) * lu(1214) + lu(1228) = lu(1228) - lu(952) * lu(1214) + lu(1229) = lu(1229) - lu(953) * lu(1214) + lu(1236) = lu(1236) - lu(941) * lu(1234) + lu(1237) = lu(1237) - lu(942) * lu(1234) + lu(1238) = lu(1238) - lu(943) * lu(1234) + lu(1239) = lu(1239) - lu(944) * lu(1234) + lu(1240) = lu(1240) - lu(945) * lu(1234) + lu(1241) = lu(1241) - lu(946) * lu(1234) + lu(1242) = lu(1242) - lu(947) * lu(1234) + lu(1243) = lu(1243) - lu(948) * lu(1234) + lu(1244) = lu(1244) - lu(949) * lu(1234) + lu(1246) = lu(1246) - lu(950) * lu(1234) + lu(1247) = lu(1247) - lu(951) * lu(1234) + lu(1248) = lu(1248) - lu(952) * lu(1234) + lu(1249) = lu(1249) - lu(953) * lu(1234) + lu(1309) = lu(1309) - lu(941) * lu(1307) + lu(1310) = lu(1310) - lu(942) * lu(1307) + lu(1311) = lu(1311) - lu(943) * lu(1307) + lu(1312) = lu(1312) - lu(944) * lu(1307) + lu(1313) = lu(1313) - lu(945) * lu(1307) + lu(1314) = lu(1314) - lu(946) * lu(1307) + lu(1315) = lu(1315) - lu(947) * lu(1307) + lu(1316) = lu(1316) - lu(948) * lu(1307) + lu(1317) = lu(1317) - lu(949) * lu(1307) + lu(1319) = lu(1319) - lu(950) * lu(1307) + lu(1320) = lu(1320) - lu(951) * lu(1307) + lu(1321) = lu(1321) - lu(952) * lu(1307) + lu(1322) = lu(1322) - lu(953) * lu(1307) + lu(1353) = lu(1353) - lu(941) * lu(1351) + lu(1354) = lu(1354) - lu(942) * lu(1351) + lu(1355) = lu(1355) - lu(943) * lu(1351) + lu(1356) = lu(1356) - lu(944) * lu(1351) + lu(1357) = lu(1357) - lu(945) * lu(1351) + lu(1358) = lu(1358) - lu(946) * lu(1351) + lu(1359) = lu(1359) - lu(947) * lu(1351) + lu(1360) = lu(1360) - lu(948) * lu(1351) + lu(1361) = lu(1361) - lu(949) * lu(1351) + lu(1363) = lu(1363) - lu(950) * lu(1351) + lu(1364) = lu(1364) - lu(951) * lu(1351) + lu(1365) = lu(1365) - lu(952) * lu(1351) + lu(1366) = lu(1366) - lu(953) * lu(1351) + lu(1379) = lu(1379) - lu(941) * lu(1377) + lu(1380) = lu(1380) - lu(942) * lu(1377) + lu(1381) = lu(1381) - lu(943) * lu(1377) + lu(1382) = lu(1382) - lu(944) * lu(1377) + lu(1383) = lu(1383) - lu(945) * lu(1377) + lu(1384) = lu(1384) - lu(946) * lu(1377) + lu(1385) = lu(1385) - lu(947) * lu(1377) + lu(1386) = lu(1386) - lu(948) * lu(1377) + lu(1387) = lu(1387) - lu(949) * lu(1377) + lu(1389) = lu(1389) - lu(950) * lu(1377) + lu(1390) = lu(1390) - lu(951) * lu(1377) + lu(1391) = lu(1391) - lu(952) * lu(1377) + lu(1392) = lu(1392) - lu(953) * lu(1377) + lu(1414) = lu(1414) - lu(941) * lu(1412) + lu(1415) = lu(1415) - lu(942) * lu(1412) + lu(1416) = lu(1416) - lu(943) * lu(1412) + lu(1417) = lu(1417) - lu(944) * lu(1412) + lu(1418) = lu(1418) - lu(945) * lu(1412) + lu(1419) = lu(1419) - lu(946) * lu(1412) + lu(1420) = lu(1420) - lu(947) * lu(1412) + lu(1421) = lu(1421) - lu(948) * lu(1412) + lu(1422) = lu(1422) - lu(949) * lu(1412) + lu(1424) = lu(1424) - lu(950) * lu(1412) + lu(1425) = lu(1425) - lu(951) * lu(1412) + lu(1426) = lu(1426) - lu(952) * lu(1412) + lu(1427) = lu(1427) - lu(953) * lu(1412) + lu(1515) = lu(1515) - lu(941) * lu(1513) + lu(1516) = lu(1516) - lu(942) * lu(1513) + lu(1517) = lu(1517) - lu(943) * lu(1513) + lu(1518) = lu(1518) - lu(944) * lu(1513) + lu(1519) = lu(1519) - lu(945) * lu(1513) + lu(1520) = lu(1520) - lu(946) * lu(1513) + lu(1521) = lu(1521) - lu(947) * lu(1513) + lu(1522) = lu(1522) - lu(948) * lu(1513) + lu(1523) = lu(1523) - lu(949) * lu(1513) + lu(1525) = lu(1525) - lu(950) * lu(1513) + lu(1526) = lu(1526) - lu(951) * lu(1513) + lu(1527) = lu(1527) - lu(952) * lu(1513) + lu(1528) = lu(1528) - lu(953) * lu(1513) + lu(1542) = lu(1542) - lu(941) * lu(1540) + lu(1543) = lu(1543) - lu(942) * lu(1540) + lu(1544) = lu(1544) - lu(943) * lu(1540) + lu(1545) = lu(1545) - lu(944) * lu(1540) + lu(1546) = lu(1546) - lu(945) * lu(1540) + lu(1547) = lu(1547) - lu(946) * lu(1540) + lu(1548) = lu(1548) - lu(947) * lu(1540) + lu(1549) = lu(1549) - lu(948) * lu(1540) + lu(1550) = lu(1550) - lu(949) * lu(1540) + lu(1552) = lu(1552) - lu(950) * lu(1540) + lu(1553) = lu(1553) - lu(951) * lu(1540) + lu(1554) = lu(1554) - lu(952) * lu(1540) + lu(1555) = lu(1555) - lu(953) * lu(1540) + end subroutine lu_fac19 + subroutine lu_fac20( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(961) = 1._r8 / lu(961) + lu(962) = lu(962) * lu(961) + lu(963) = lu(963) * lu(961) + lu(964) = lu(964) * lu(961) + lu(965) = lu(965) * lu(961) + lu(966) = lu(966) * lu(961) + lu(967) = lu(967) * lu(961) + lu(968) = lu(968) * lu(961) + lu(969) = lu(969) * lu(961) + lu(970) = lu(970) * lu(961) + lu(971) = lu(971) * lu(961) + lu(972) = lu(972) * lu(961) + lu(973) = lu(973) * lu(961) + lu(974) = lu(974) * lu(961) + lu(975) = lu(975) * lu(961) + lu(1019) = lu(1019) - lu(962) * lu(1018) + lu(1020) = lu(1020) - lu(963) * lu(1018) + lu(1021) = lu(1021) - lu(964) * lu(1018) + lu(1022) = lu(1022) - lu(965) * lu(1018) + lu(1023) = lu(1023) - lu(966) * lu(1018) + lu(1024) = lu(1024) - lu(967) * lu(1018) + lu(1025) = lu(1025) - lu(968) * lu(1018) + lu(1026) = lu(1026) - lu(969) * lu(1018) + lu(1027) = lu(1027) - lu(970) * lu(1018) + lu(1028) = lu(1028) - lu(971) * lu(1018) + lu(1029) = lu(1029) - lu(972) * lu(1018) + lu(1030) = lu(1030) - lu(973) * lu(1018) + lu(1031) = lu(1031) - lu(974) * lu(1018) + lu(1032) = lu(1032) - lu(975) * lu(1018) + lu(1060) = lu(1060) - lu(962) * lu(1059) + lu(1061) = lu(1061) - lu(963) * lu(1059) + lu(1062) = lu(1062) - lu(964) * lu(1059) + lu(1063) = lu(1063) - lu(965) * lu(1059) + lu(1064) = lu(1064) - lu(966) * lu(1059) + lu(1065) = lu(1065) - lu(967) * lu(1059) + lu(1066) = lu(1066) - lu(968) * lu(1059) + lu(1067) = lu(1067) - lu(969) * lu(1059) + lu(1068) = lu(1068) - lu(970) * lu(1059) + lu(1069) = lu(1069) - lu(971) * lu(1059) + lu(1070) = lu(1070) - lu(972) * lu(1059) + lu(1071) = lu(1071) - lu(973) * lu(1059) + lu(1072) = lu(1072) - lu(974) * lu(1059) + lu(1073) = lu(1073) - lu(975) * lu(1059) + lu(1105) = lu(1105) - lu(962) * lu(1104) + lu(1106) = lu(1106) - lu(963) * lu(1104) + lu(1107) = lu(1107) - lu(964) * lu(1104) + lu(1108) = lu(1108) - lu(965) * lu(1104) + lu(1109) = lu(1109) - lu(966) * lu(1104) + lu(1110) = lu(1110) - lu(967) * lu(1104) + lu(1111) = lu(1111) - lu(968) * lu(1104) + lu(1112) = lu(1112) - lu(969) * lu(1104) + lu(1113) = lu(1113) - lu(970) * lu(1104) + lu(1114) = lu(1114) - lu(971) * lu(1104) + lu(1115) = lu(1115) - lu(972) * lu(1104) + lu(1116) = lu(1116) - lu(973) * lu(1104) + lu(1117) = lu(1117) - lu(974) * lu(1104) + lu(1118) = lu(1118) - lu(975) * lu(1104) + lu(1131) = lu(1131) - lu(962) * lu(1130) + lu(1132) = lu(1132) - lu(963) * lu(1130) + lu(1133) = lu(1133) - lu(964) * lu(1130) + lu(1134) = lu(1134) - lu(965) * lu(1130) + lu(1135) = lu(1135) - lu(966) * lu(1130) + lu(1136) = lu(1136) - lu(967) * lu(1130) + lu(1137) = lu(1137) - lu(968) * lu(1130) + lu(1138) = lu(1138) - lu(969) * lu(1130) + lu(1139) = lu(1139) - lu(970) * lu(1130) + lu(1140) = lu(1140) - lu(971) * lu(1130) + lu(1141) = lu(1141) - lu(972) * lu(1130) + lu(1142) = lu(1142) - lu(973) * lu(1130) + lu(1143) = lu(1143) - lu(974) * lu(1130) + lu(1144) = lu(1144) - lu(975) * lu(1130) + lu(1168) = lu(1168) - lu(962) * lu(1167) + lu(1169) = lu(1169) - lu(963) * lu(1167) + lu(1170) = lu(1170) - lu(964) * lu(1167) + lu(1171) = lu(1171) - lu(965) * lu(1167) + lu(1172) = lu(1172) - lu(966) * lu(1167) + lu(1173) = lu(1173) - lu(967) * lu(1167) + lu(1174) = lu(1174) - lu(968) * lu(1167) + lu(1175) = lu(1175) - lu(969) * lu(1167) + lu(1176) = lu(1176) - lu(970) * lu(1167) + lu(1177) = lu(1177) - lu(971) * lu(1167) + lu(1178) = lu(1178) - lu(972) * lu(1167) + lu(1179) = lu(1179) - lu(973) * lu(1167) + lu(1180) = lu(1180) - lu(974) * lu(1167) + lu(1181) = lu(1181) - lu(975) * lu(1167) + lu(1192) = lu(1192) - lu(962) * lu(1191) + lu(1193) = lu(1193) - lu(963) * lu(1191) + lu(1194) = lu(1194) - lu(964) * lu(1191) + lu(1195) = lu(1195) - lu(965) * lu(1191) + lu(1196) = lu(1196) - lu(966) * lu(1191) + lu(1197) = lu(1197) - lu(967) * lu(1191) + lu(1198) = lu(1198) - lu(968) * lu(1191) + lu(1199) = lu(1199) - lu(969) * lu(1191) + lu(1200) = lu(1200) - lu(970) * lu(1191) + lu(1201) = lu(1201) - lu(971) * lu(1191) + lu(1202) = lu(1202) - lu(972) * lu(1191) + lu(1203) = lu(1203) - lu(973) * lu(1191) + lu(1204) = lu(1204) - lu(974) * lu(1191) + lu(1205) = lu(1205) - lu(975) * lu(1191) + lu(1216) = lu(1216) - lu(962) * lu(1215) + lu(1217) = lu(1217) - lu(963) * lu(1215) + lu(1218) = lu(1218) - lu(964) * lu(1215) + lu(1219) = lu(1219) - lu(965) * lu(1215) + lu(1220) = lu(1220) - lu(966) * lu(1215) + lu(1221) = lu(1221) - lu(967) * lu(1215) + lu(1222) = lu(1222) - lu(968) * lu(1215) + lu(1223) = lu(1223) - lu(969) * lu(1215) + lu(1224) = lu(1224) - lu(970) * lu(1215) + lu(1225) = lu(1225) - lu(971) * lu(1215) + lu(1226) = lu(1226) - lu(972) * lu(1215) + lu(1227) = lu(1227) - lu(973) * lu(1215) + lu(1228) = lu(1228) - lu(974) * lu(1215) + lu(1229) = lu(1229) - lu(975) * lu(1215) + lu(1236) = lu(1236) - lu(962) * lu(1235) + lu(1237) = lu(1237) - lu(963) * lu(1235) + lu(1238) = lu(1238) - lu(964) * lu(1235) + lu(1239) = lu(1239) - lu(965) * lu(1235) + lu(1240) = lu(1240) - lu(966) * lu(1235) + lu(1241) = lu(1241) - lu(967) * lu(1235) + lu(1242) = lu(1242) - lu(968) * lu(1235) + lu(1243) = lu(1243) - lu(969) * lu(1235) + lu(1244) = lu(1244) - lu(970) * lu(1235) + lu(1245) = lu(1245) - lu(971) * lu(1235) + lu(1246) = lu(1246) - lu(972) * lu(1235) + lu(1247) = lu(1247) - lu(973) * lu(1235) + lu(1248) = lu(1248) - lu(974) * lu(1235) + lu(1249) = lu(1249) - lu(975) * lu(1235) + lu(1309) = lu(1309) - lu(962) * lu(1308) + lu(1310) = lu(1310) - lu(963) * lu(1308) + lu(1311) = lu(1311) - lu(964) * lu(1308) + lu(1312) = lu(1312) - lu(965) * lu(1308) + lu(1313) = lu(1313) - lu(966) * lu(1308) + lu(1314) = lu(1314) - lu(967) * lu(1308) + lu(1315) = lu(1315) - lu(968) * lu(1308) + lu(1316) = lu(1316) - lu(969) * lu(1308) + lu(1317) = lu(1317) - lu(970) * lu(1308) + lu(1318) = lu(1318) - lu(971) * lu(1308) + lu(1319) = lu(1319) - lu(972) * lu(1308) + lu(1320) = lu(1320) - lu(973) * lu(1308) + lu(1321) = lu(1321) - lu(974) * lu(1308) + lu(1322) = lu(1322) - lu(975) * lu(1308) + lu(1353) = lu(1353) - lu(962) * lu(1352) + lu(1354) = lu(1354) - lu(963) * lu(1352) + lu(1355) = lu(1355) - lu(964) * lu(1352) + lu(1356) = lu(1356) - lu(965) * lu(1352) + lu(1357) = lu(1357) - lu(966) * lu(1352) + lu(1358) = lu(1358) - lu(967) * lu(1352) + lu(1359) = lu(1359) - lu(968) * lu(1352) + lu(1360) = lu(1360) - lu(969) * lu(1352) + lu(1361) = lu(1361) - lu(970) * lu(1352) + lu(1362) = lu(1362) - lu(971) * lu(1352) + lu(1363) = lu(1363) - lu(972) * lu(1352) + lu(1364) = lu(1364) - lu(973) * lu(1352) + lu(1365) = lu(1365) - lu(974) * lu(1352) + lu(1366) = lu(1366) - lu(975) * lu(1352) + lu(1379) = lu(1379) - lu(962) * lu(1378) + lu(1380) = lu(1380) - lu(963) * lu(1378) + lu(1381) = lu(1381) - lu(964) * lu(1378) + lu(1382) = lu(1382) - lu(965) * lu(1378) + lu(1383) = lu(1383) - lu(966) * lu(1378) + lu(1384) = lu(1384) - lu(967) * lu(1378) + lu(1385) = lu(1385) - lu(968) * lu(1378) + lu(1386) = lu(1386) - lu(969) * lu(1378) + lu(1387) = lu(1387) - lu(970) * lu(1378) + lu(1388) = lu(1388) - lu(971) * lu(1378) + lu(1389) = lu(1389) - lu(972) * lu(1378) + lu(1390) = lu(1390) - lu(973) * lu(1378) + lu(1391) = lu(1391) - lu(974) * lu(1378) + lu(1392) = lu(1392) - lu(975) * lu(1378) + lu(1414) = lu(1414) - lu(962) * lu(1413) + lu(1415) = lu(1415) - lu(963) * lu(1413) + lu(1416) = lu(1416) - lu(964) * lu(1413) + lu(1417) = lu(1417) - lu(965) * lu(1413) + lu(1418) = lu(1418) - lu(966) * lu(1413) + lu(1419) = lu(1419) - lu(967) * lu(1413) + lu(1420) = lu(1420) - lu(968) * lu(1413) + lu(1421) = lu(1421) - lu(969) * lu(1413) + lu(1422) = lu(1422) - lu(970) * lu(1413) + lu(1423) = lu(1423) - lu(971) * lu(1413) + lu(1424) = lu(1424) - lu(972) * lu(1413) + lu(1425) = lu(1425) - lu(973) * lu(1413) + lu(1426) = lu(1426) - lu(974) * lu(1413) + lu(1427) = lu(1427) - lu(975) * lu(1413) + lu(1515) = lu(1515) - lu(962) * lu(1514) + lu(1516) = lu(1516) - lu(963) * lu(1514) + lu(1517) = lu(1517) - lu(964) * lu(1514) + lu(1518) = lu(1518) - lu(965) * lu(1514) + lu(1519) = lu(1519) - lu(966) * lu(1514) + lu(1520) = lu(1520) - lu(967) * lu(1514) + lu(1521) = lu(1521) - lu(968) * lu(1514) + lu(1522) = lu(1522) - lu(969) * lu(1514) + lu(1523) = lu(1523) - lu(970) * lu(1514) + lu(1524) = lu(1524) - lu(971) * lu(1514) + lu(1525) = lu(1525) - lu(972) * lu(1514) + lu(1526) = lu(1526) - lu(973) * lu(1514) + lu(1527) = lu(1527) - lu(974) * lu(1514) + lu(1528) = lu(1528) - lu(975) * lu(1514) + lu(1542) = lu(1542) - lu(962) * lu(1541) + lu(1543) = lu(1543) - lu(963) * lu(1541) + lu(1544) = lu(1544) - lu(964) * lu(1541) + lu(1545) = lu(1545) - lu(965) * lu(1541) + lu(1546) = lu(1546) - lu(966) * lu(1541) + lu(1547) = lu(1547) - lu(967) * lu(1541) + lu(1548) = lu(1548) - lu(968) * lu(1541) + lu(1549) = lu(1549) - lu(969) * lu(1541) + lu(1550) = lu(1550) - lu(970) * lu(1541) + lu(1551) = lu(1551) - lu(971) * lu(1541) + lu(1552) = lu(1552) - lu(972) * lu(1541) + lu(1553) = lu(1553) - lu(973) * lu(1541) + lu(1554) = lu(1554) - lu(974) * lu(1541) + lu(1555) = lu(1555) - lu(975) * lu(1541) + lu(1019) = 1._r8 / lu(1019) + lu(1020) = lu(1020) * lu(1019) + lu(1021) = lu(1021) * lu(1019) + lu(1022) = lu(1022) * lu(1019) + lu(1023) = lu(1023) * lu(1019) + lu(1024) = lu(1024) * lu(1019) + lu(1025) = lu(1025) * lu(1019) + lu(1026) = lu(1026) * lu(1019) + lu(1027) = lu(1027) * lu(1019) + lu(1028) = lu(1028) * lu(1019) + lu(1029) = lu(1029) * lu(1019) + lu(1030) = lu(1030) * lu(1019) + lu(1031) = lu(1031) * lu(1019) + lu(1032) = lu(1032) * lu(1019) + lu(1061) = lu(1061) - lu(1020) * lu(1060) + lu(1062) = lu(1062) - lu(1021) * lu(1060) + lu(1063) = lu(1063) - lu(1022) * lu(1060) + lu(1064) = lu(1064) - lu(1023) * lu(1060) + lu(1065) = lu(1065) - lu(1024) * lu(1060) + lu(1066) = lu(1066) - lu(1025) * lu(1060) + lu(1067) = lu(1067) - lu(1026) * lu(1060) + lu(1068) = lu(1068) - lu(1027) * lu(1060) + lu(1069) = lu(1069) - lu(1028) * lu(1060) + lu(1070) = lu(1070) - lu(1029) * lu(1060) + lu(1071) = lu(1071) - lu(1030) * lu(1060) + lu(1072) = lu(1072) - lu(1031) * lu(1060) + lu(1073) = lu(1073) - lu(1032) * lu(1060) + lu(1106) = lu(1106) - lu(1020) * lu(1105) + lu(1107) = lu(1107) - lu(1021) * lu(1105) + lu(1108) = lu(1108) - lu(1022) * lu(1105) + lu(1109) = lu(1109) - lu(1023) * lu(1105) + lu(1110) = lu(1110) - lu(1024) * lu(1105) + lu(1111) = lu(1111) - lu(1025) * lu(1105) + lu(1112) = lu(1112) - lu(1026) * lu(1105) + lu(1113) = lu(1113) - lu(1027) * lu(1105) + lu(1114) = lu(1114) - lu(1028) * lu(1105) + lu(1115) = lu(1115) - lu(1029) * lu(1105) + lu(1116) = lu(1116) - lu(1030) * lu(1105) + lu(1117) = lu(1117) - lu(1031) * lu(1105) + lu(1118) = lu(1118) - lu(1032) * lu(1105) + lu(1132) = lu(1132) - lu(1020) * lu(1131) + lu(1133) = lu(1133) - lu(1021) * lu(1131) + lu(1134) = lu(1134) - lu(1022) * lu(1131) + lu(1135) = lu(1135) - lu(1023) * lu(1131) + lu(1136) = lu(1136) - lu(1024) * lu(1131) + lu(1137) = lu(1137) - lu(1025) * lu(1131) + lu(1138) = lu(1138) - lu(1026) * lu(1131) + lu(1139) = lu(1139) - lu(1027) * lu(1131) + lu(1140) = lu(1140) - lu(1028) * lu(1131) + lu(1141) = lu(1141) - lu(1029) * lu(1131) + lu(1142) = lu(1142) - lu(1030) * lu(1131) + lu(1143) = lu(1143) - lu(1031) * lu(1131) + lu(1144) = lu(1144) - lu(1032) * lu(1131) + lu(1169) = lu(1169) - lu(1020) * lu(1168) + lu(1170) = lu(1170) - lu(1021) * lu(1168) + lu(1171) = lu(1171) - lu(1022) * lu(1168) + lu(1172) = lu(1172) - lu(1023) * lu(1168) + lu(1173) = lu(1173) - lu(1024) * lu(1168) + lu(1174) = lu(1174) - lu(1025) * lu(1168) + lu(1175) = lu(1175) - lu(1026) * lu(1168) + lu(1176) = lu(1176) - lu(1027) * lu(1168) + lu(1177) = lu(1177) - lu(1028) * lu(1168) + lu(1178) = lu(1178) - lu(1029) * lu(1168) + lu(1179) = lu(1179) - lu(1030) * lu(1168) + lu(1180) = lu(1180) - lu(1031) * lu(1168) + lu(1181) = lu(1181) - lu(1032) * lu(1168) + lu(1193) = lu(1193) - lu(1020) * lu(1192) + lu(1194) = lu(1194) - lu(1021) * lu(1192) + lu(1195) = lu(1195) - lu(1022) * lu(1192) + lu(1196) = lu(1196) - lu(1023) * lu(1192) + lu(1197) = lu(1197) - lu(1024) * lu(1192) + lu(1198) = lu(1198) - lu(1025) * lu(1192) + lu(1199) = lu(1199) - lu(1026) * lu(1192) + lu(1200) = lu(1200) - lu(1027) * lu(1192) + lu(1201) = lu(1201) - lu(1028) * lu(1192) + lu(1202) = lu(1202) - lu(1029) * lu(1192) + lu(1203) = lu(1203) - lu(1030) * lu(1192) + lu(1204) = lu(1204) - lu(1031) * lu(1192) + lu(1205) = lu(1205) - lu(1032) * lu(1192) + lu(1217) = lu(1217) - lu(1020) * lu(1216) + lu(1218) = lu(1218) - lu(1021) * lu(1216) + lu(1219) = lu(1219) - lu(1022) * lu(1216) + lu(1220) = lu(1220) - lu(1023) * lu(1216) + lu(1221) = lu(1221) - lu(1024) * lu(1216) + lu(1222) = lu(1222) - lu(1025) * lu(1216) + lu(1223) = lu(1223) - lu(1026) * lu(1216) + lu(1224) = lu(1224) - lu(1027) * lu(1216) + lu(1225) = lu(1225) - lu(1028) * lu(1216) + lu(1226) = lu(1226) - lu(1029) * lu(1216) + lu(1227) = lu(1227) - lu(1030) * lu(1216) + lu(1228) = lu(1228) - lu(1031) * lu(1216) + lu(1229) = lu(1229) - lu(1032) * lu(1216) + lu(1237) = lu(1237) - lu(1020) * lu(1236) + lu(1238) = lu(1238) - lu(1021) * lu(1236) + lu(1239) = lu(1239) - lu(1022) * lu(1236) + lu(1240) = lu(1240) - lu(1023) * lu(1236) + lu(1241) = lu(1241) - lu(1024) * lu(1236) + lu(1242) = lu(1242) - lu(1025) * lu(1236) + lu(1243) = lu(1243) - lu(1026) * lu(1236) + lu(1244) = lu(1244) - lu(1027) * lu(1236) + lu(1245) = lu(1245) - lu(1028) * lu(1236) + lu(1246) = lu(1246) - lu(1029) * lu(1236) + lu(1247) = lu(1247) - lu(1030) * lu(1236) + lu(1248) = lu(1248) - lu(1031) * lu(1236) + lu(1249) = lu(1249) - lu(1032) * lu(1236) + lu(1310) = lu(1310) - lu(1020) * lu(1309) + lu(1311) = lu(1311) - lu(1021) * lu(1309) + lu(1312) = lu(1312) - lu(1022) * lu(1309) + lu(1313) = lu(1313) - lu(1023) * lu(1309) + lu(1314) = lu(1314) - lu(1024) * lu(1309) + lu(1315) = lu(1315) - lu(1025) * lu(1309) + lu(1316) = lu(1316) - lu(1026) * lu(1309) + lu(1317) = lu(1317) - lu(1027) * lu(1309) + lu(1318) = lu(1318) - lu(1028) * lu(1309) + lu(1319) = lu(1319) - lu(1029) * lu(1309) + lu(1320) = lu(1320) - lu(1030) * lu(1309) + lu(1321) = lu(1321) - lu(1031) * lu(1309) + lu(1322) = lu(1322) - lu(1032) * lu(1309) + lu(1354) = lu(1354) - lu(1020) * lu(1353) + lu(1355) = lu(1355) - lu(1021) * lu(1353) + lu(1356) = lu(1356) - lu(1022) * lu(1353) + lu(1357) = lu(1357) - lu(1023) * lu(1353) + lu(1358) = lu(1358) - lu(1024) * lu(1353) + lu(1359) = lu(1359) - lu(1025) * lu(1353) + lu(1360) = lu(1360) - lu(1026) * lu(1353) + lu(1361) = lu(1361) - lu(1027) * lu(1353) + lu(1362) = lu(1362) - lu(1028) * lu(1353) + lu(1363) = lu(1363) - lu(1029) * lu(1353) + lu(1364) = lu(1364) - lu(1030) * lu(1353) + lu(1365) = lu(1365) - lu(1031) * lu(1353) + lu(1366) = lu(1366) - lu(1032) * lu(1353) + lu(1380) = lu(1380) - lu(1020) * lu(1379) + lu(1381) = lu(1381) - lu(1021) * lu(1379) + lu(1382) = lu(1382) - lu(1022) * lu(1379) + lu(1383) = lu(1383) - lu(1023) * lu(1379) + lu(1384) = lu(1384) - lu(1024) * lu(1379) + lu(1385) = lu(1385) - lu(1025) * lu(1379) + lu(1386) = lu(1386) - lu(1026) * lu(1379) + lu(1387) = lu(1387) - lu(1027) * lu(1379) + lu(1388) = lu(1388) - lu(1028) * lu(1379) + lu(1389) = lu(1389) - lu(1029) * lu(1379) + lu(1390) = lu(1390) - lu(1030) * lu(1379) + lu(1391) = lu(1391) - lu(1031) * lu(1379) + lu(1392) = lu(1392) - lu(1032) * lu(1379) + lu(1415) = lu(1415) - lu(1020) * lu(1414) + lu(1416) = lu(1416) - lu(1021) * lu(1414) + lu(1417) = lu(1417) - lu(1022) * lu(1414) + lu(1418) = lu(1418) - lu(1023) * lu(1414) + lu(1419) = lu(1419) - lu(1024) * lu(1414) + lu(1420) = lu(1420) - lu(1025) * lu(1414) + lu(1421) = lu(1421) - lu(1026) * lu(1414) + lu(1422) = lu(1422) - lu(1027) * lu(1414) + lu(1423) = lu(1423) - lu(1028) * lu(1414) + lu(1424) = lu(1424) - lu(1029) * lu(1414) + lu(1425) = lu(1425) - lu(1030) * lu(1414) + lu(1426) = lu(1426) - lu(1031) * lu(1414) + lu(1427) = lu(1427) - lu(1032) * lu(1414) + lu(1516) = lu(1516) - lu(1020) * lu(1515) + lu(1517) = lu(1517) - lu(1021) * lu(1515) + lu(1518) = lu(1518) - lu(1022) * lu(1515) + lu(1519) = lu(1519) - lu(1023) * lu(1515) + lu(1520) = lu(1520) - lu(1024) * lu(1515) + lu(1521) = lu(1521) - lu(1025) * lu(1515) + lu(1522) = lu(1522) - lu(1026) * lu(1515) + lu(1523) = lu(1523) - lu(1027) * lu(1515) + lu(1524) = lu(1524) - lu(1028) * lu(1515) + lu(1525) = lu(1525) - lu(1029) * lu(1515) + lu(1526) = lu(1526) - lu(1030) * lu(1515) + lu(1527) = lu(1527) - lu(1031) * lu(1515) + lu(1528) = lu(1528) - lu(1032) * lu(1515) + lu(1543) = lu(1543) - lu(1020) * lu(1542) + lu(1544) = lu(1544) - lu(1021) * lu(1542) + lu(1545) = lu(1545) - lu(1022) * lu(1542) + lu(1546) = lu(1546) - lu(1023) * lu(1542) + lu(1547) = lu(1547) - lu(1024) * lu(1542) + lu(1548) = lu(1548) - lu(1025) * lu(1542) + lu(1549) = lu(1549) - lu(1026) * lu(1542) + lu(1550) = lu(1550) - lu(1027) * lu(1542) + lu(1551) = lu(1551) - lu(1028) * lu(1542) + lu(1552) = lu(1552) - lu(1029) * lu(1542) + lu(1553) = lu(1553) - lu(1030) * lu(1542) + lu(1554) = lu(1554) - lu(1031) * lu(1542) + lu(1555) = lu(1555) - lu(1032) * lu(1542) + lu(1061) = 1._r8 / lu(1061) + lu(1062) = lu(1062) * lu(1061) + lu(1063) = lu(1063) * lu(1061) + lu(1064) = lu(1064) * lu(1061) + lu(1065) = lu(1065) * lu(1061) + lu(1066) = lu(1066) * lu(1061) + lu(1067) = lu(1067) * lu(1061) + lu(1068) = lu(1068) * lu(1061) + lu(1069) = lu(1069) * lu(1061) + lu(1070) = lu(1070) * lu(1061) + lu(1071) = lu(1071) * lu(1061) + lu(1072) = lu(1072) * lu(1061) + lu(1073) = lu(1073) * lu(1061) + lu(1107) = lu(1107) - lu(1062) * lu(1106) + lu(1108) = lu(1108) - lu(1063) * lu(1106) + lu(1109) = lu(1109) - lu(1064) * lu(1106) + lu(1110) = lu(1110) - lu(1065) * lu(1106) + lu(1111) = lu(1111) - lu(1066) * lu(1106) + lu(1112) = lu(1112) - lu(1067) * lu(1106) + lu(1113) = lu(1113) - lu(1068) * lu(1106) + lu(1114) = lu(1114) - lu(1069) * lu(1106) + lu(1115) = lu(1115) - lu(1070) * lu(1106) + lu(1116) = lu(1116) - lu(1071) * lu(1106) + lu(1117) = lu(1117) - lu(1072) * lu(1106) + lu(1118) = lu(1118) - lu(1073) * lu(1106) + lu(1133) = lu(1133) - lu(1062) * lu(1132) + lu(1134) = lu(1134) - lu(1063) * lu(1132) + lu(1135) = lu(1135) - lu(1064) * lu(1132) + lu(1136) = lu(1136) - lu(1065) * lu(1132) + lu(1137) = lu(1137) - lu(1066) * lu(1132) + lu(1138) = lu(1138) - lu(1067) * lu(1132) + lu(1139) = lu(1139) - lu(1068) * lu(1132) + lu(1140) = lu(1140) - lu(1069) * lu(1132) + lu(1141) = lu(1141) - lu(1070) * lu(1132) + lu(1142) = lu(1142) - lu(1071) * lu(1132) + lu(1143) = lu(1143) - lu(1072) * lu(1132) + lu(1144) = lu(1144) - lu(1073) * lu(1132) + lu(1170) = lu(1170) - lu(1062) * lu(1169) + lu(1171) = lu(1171) - lu(1063) * lu(1169) + lu(1172) = lu(1172) - lu(1064) * lu(1169) + lu(1173) = lu(1173) - lu(1065) * lu(1169) + lu(1174) = lu(1174) - lu(1066) * lu(1169) + lu(1175) = lu(1175) - lu(1067) * lu(1169) + lu(1176) = lu(1176) - lu(1068) * lu(1169) + lu(1177) = lu(1177) - lu(1069) * lu(1169) + lu(1178) = lu(1178) - lu(1070) * lu(1169) + lu(1179) = lu(1179) - lu(1071) * lu(1169) + lu(1180) = lu(1180) - lu(1072) * lu(1169) + lu(1181) = lu(1181) - lu(1073) * lu(1169) + lu(1194) = lu(1194) - lu(1062) * lu(1193) + lu(1195) = lu(1195) - lu(1063) * lu(1193) + lu(1196) = lu(1196) - lu(1064) * lu(1193) + lu(1197) = lu(1197) - lu(1065) * lu(1193) + lu(1198) = lu(1198) - lu(1066) * lu(1193) + lu(1199) = lu(1199) - lu(1067) * lu(1193) + lu(1200) = lu(1200) - lu(1068) * lu(1193) + lu(1201) = lu(1201) - lu(1069) * lu(1193) + lu(1202) = lu(1202) - lu(1070) * lu(1193) + lu(1203) = lu(1203) - lu(1071) * lu(1193) + lu(1204) = lu(1204) - lu(1072) * lu(1193) + lu(1205) = lu(1205) - lu(1073) * lu(1193) + lu(1218) = lu(1218) - lu(1062) * lu(1217) + lu(1219) = lu(1219) - lu(1063) * lu(1217) + lu(1220) = lu(1220) - lu(1064) * lu(1217) + lu(1221) = lu(1221) - lu(1065) * lu(1217) + lu(1222) = lu(1222) - lu(1066) * lu(1217) + lu(1223) = lu(1223) - lu(1067) * lu(1217) + lu(1224) = lu(1224) - lu(1068) * lu(1217) + lu(1225) = lu(1225) - lu(1069) * lu(1217) + lu(1226) = lu(1226) - lu(1070) * lu(1217) + lu(1227) = lu(1227) - lu(1071) * lu(1217) + lu(1228) = lu(1228) - lu(1072) * lu(1217) + lu(1229) = lu(1229) - lu(1073) * lu(1217) + lu(1238) = lu(1238) - lu(1062) * lu(1237) + lu(1239) = lu(1239) - lu(1063) * lu(1237) + lu(1240) = lu(1240) - lu(1064) * lu(1237) + lu(1241) = lu(1241) - lu(1065) * lu(1237) + lu(1242) = lu(1242) - lu(1066) * lu(1237) + lu(1243) = lu(1243) - lu(1067) * lu(1237) + lu(1244) = lu(1244) - lu(1068) * lu(1237) + lu(1245) = lu(1245) - lu(1069) * lu(1237) + lu(1246) = lu(1246) - lu(1070) * lu(1237) + lu(1247) = lu(1247) - lu(1071) * lu(1237) + lu(1248) = lu(1248) - lu(1072) * lu(1237) + lu(1249) = lu(1249) - lu(1073) * lu(1237) + lu(1311) = lu(1311) - lu(1062) * lu(1310) + lu(1312) = lu(1312) - lu(1063) * lu(1310) + lu(1313) = lu(1313) - lu(1064) * lu(1310) + lu(1314) = lu(1314) - lu(1065) * lu(1310) + lu(1315) = lu(1315) - lu(1066) * lu(1310) + lu(1316) = lu(1316) - lu(1067) * lu(1310) + lu(1317) = lu(1317) - lu(1068) * lu(1310) + lu(1318) = lu(1318) - lu(1069) * lu(1310) + lu(1319) = lu(1319) - lu(1070) * lu(1310) + lu(1320) = lu(1320) - lu(1071) * lu(1310) + lu(1321) = lu(1321) - lu(1072) * lu(1310) + lu(1322) = lu(1322) - lu(1073) * lu(1310) + lu(1355) = lu(1355) - lu(1062) * lu(1354) + lu(1356) = lu(1356) - lu(1063) * lu(1354) + lu(1357) = lu(1357) - lu(1064) * lu(1354) + lu(1358) = lu(1358) - lu(1065) * lu(1354) + lu(1359) = lu(1359) - lu(1066) * lu(1354) + lu(1360) = lu(1360) - lu(1067) * lu(1354) + lu(1361) = lu(1361) - lu(1068) * lu(1354) + lu(1362) = lu(1362) - lu(1069) * lu(1354) + lu(1363) = lu(1363) - lu(1070) * lu(1354) + lu(1364) = lu(1364) - lu(1071) * lu(1354) + lu(1365) = lu(1365) - lu(1072) * lu(1354) + lu(1366) = lu(1366) - lu(1073) * lu(1354) + lu(1381) = lu(1381) - lu(1062) * lu(1380) + lu(1382) = lu(1382) - lu(1063) * lu(1380) + lu(1383) = lu(1383) - lu(1064) * lu(1380) + lu(1384) = lu(1384) - lu(1065) * lu(1380) + lu(1385) = lu(1385) - lu(1066) * lu(1380) + lu(1386) = lu(1386) - lu(1067) * lu(1380) + lu(1387) = lu(1387) - lu(1068) * lu(1380) + lu(1388) = lu(1388) - lu(1069) * lu(1380) + lu(1389) = lu(1389) - lu(1070) * lu(1380) + lu(1390) = lu(1390) - lu(1071) * lu(1380) + lu(1391) = lu(1391) - lu(1072) * lu(1380) + lu(1392) = lu(1392) - lu(1073) * lu(1380) + lu(1416) = lu(1416) - lu(1062) * lu(1415) + lu(1417) = lu(1417) - lu(1063) * lu(1415) + lu(1418) = lu(1418) - lu(1064) * lu(1415) + lu(1419) = lu(1419) - lu(1065) * lu(1415) + lu(1420) = lu(1420) - lu(1066) * lu(1415) + lu(1421) = lu(1421) - lu(1067) * lu(1415) + lu(1422) = lu(1422) - lu(1068) * lu(1415) + lu(1423) = lu(1423) - lu(1069) * lu(1415) + lu(1424) = lu(1424) - lu(1070) * lu(1415) + lu(1425) = lu(1425) - lu(1071) * lu(1415) + lu(1426) = lu(1426) - lu(1072) * lu(1415) + lu(1427) = lu(1427) - lu(1073) * lu(1415) + lu(1517) = lu(1517) - lu(1062) * lu(1516) + lu(1518) = lu(1518) - lu(1063) * lu(1516) + lu(1519) = lu(1519) - lu(1064) * lu(1516) + lu(1520) = lu(1520) - lu(1065) * lu(1516) + lu(1521) = lu(1521) - lu(1066) * lu(1516) + lu(1522) = lu(1522) - lu(1067) * lu(1516) + lu(1523) = lu(1523) - lu(1068) * lu(1516) + lu(1524) = lu(1524) - lu(1069) * lu(1516) + lu(1525) = lu(1525) - lu(1070) * lu(1516) + lu(1526) = lu(1526) - lu(1071) * lu(1516) + lu(1527) = lu(1527) - lu(1072) * lu(1516) + lu(1528) = lu(1528) - lu(1073) * lu(1516) + lu(1544) = lu(1544) - lu(1062) * lu(1543) + lu(1545) = lu(1545) - lu(1063) * lu(1543) + lu(1546) = lu(1546) - lu(1064) * lu(1543) + lu(1547) = lu(1547) - lu(1065) * lu(1543) + lu(1548) = lu(1548) - lu(1066) * lu(1543) + lu(1549) = lu(1549) - lu(1067) * lu(1543) + lu(1550) = lu(1550) - lu(1068) * lu(1543) + lu(1551) = lu(1551) - lu(1069) * lu(1543) + lu(1552) = lu(1552) - lu(1070) * lu(1543) + lu(1553) = lu(1553) - lu(1071) * lu(1543) + lu(1554) = lu(1554) - lu(1072) * lu(1543) + lu(1555) = lu(1555) - lu(1073) * lu(1543) + lu(1107) = 1._r8 / lu(1107) + lu(1108) = lu(1108) * lu(1107) + lu(1109) = lu(1109) * lu(1107) + lu(1110) = lu(1110) * lu(1107) + lu(1111) = lu(1111) * lu(1107) + lu(1112) = lu(1112) * lu(1107) + lu(1113) = lu(1113) * lu(1107) + lu(1114) = lu(1114) * lu(1107) + lu(1115) = lu(1115) * lu(1107) + lu(1116) = lu(1116) * lu(1107) + lu(1117) = lu(1117) * lu(1107) + lu(1118) = lu(1118) * lu(1107) + lu(1134) = lu(1134) - lu(1108) * lu(1133) + lu(1135) = lu(1135) - lu(1109) * lu(1133) + lu(1136) = lu(1136) - lu(1110) * lu(1133) + lu(1137) = lu(1137) - lu(1111) * lu(1133) + lu(1138) = lu(1138) - lu(1112) * lu(1133) + lu(1139) = lu(1139) - lu(1113) * lu(1133) + lu(1140) = lu(1140) - lu(1114) * lu(1133) + lu(1141) = lu(1141) - lu(1115) * lu(1133) + lu(1142) = lu(1142) - lu(1116) * lu(1133) + lu(1143) = lu(1143) - lu(1117) * lu(1133) + lu(1144) = lu(1144) - lu(1118) * lu(1133) + lu(1171) = lu(1171) - lu(1108) * lu(1170) + lu(1172) = lu(1172) - lu(1109) * lu(1170) + lu(1173) = lu(1173) - lu(1110) * lu(1170) + lu(1174) = lu(1174) - lu(1111) * lu(1170) + lu(1175) = lu(1175) - lu(1112) * lu(1170) + lu(1176) = lu(1176) - lu(1113) * lu(1170) + lu(1177) = lu(1177) - lu(1114) * lu(1170) + lu(1178) = lu(1178) - lu(1115) * lu(1170) + lu(1179) = lu(1179) - lu(1116) * lu(1170) + lu(1180) = lu(1180) - lu(1117) * lu(1170) + lu(1181) = lu(1181) - lu(1118) * lu(1170) + lu(1195) = lu(1195) - lu(1108) * lu(1194) + lu(1196) = lu(1196) - lu(1109) * lu(1194) + lu(1197) = lu(1197) - lu(1110) * lu(1194) + lu(1198) = lu(1198) - lu(1111) * lu(1194) + lu(1199) = lu(1199) - lu(1112) * lu(1194) + lu(1200) = lu(1200) - lu(1113) * lu(1194) + lu(1201) = lu(1201) - lu(1114) * lu(1194) + lu(1202) = lu(1202) - lu(1115) * lu(1194) + lu(1203) = lu(1203) - lu(1116) * lu(1194) + lu(1204) = lu(1204) - lu(1117) * lu(1194) + lu(1205) = lu(1205) - lu(1118) * lu(1194) + lu(1219) = lu(1219) - lu(1108) * lu(1218) + lu(1220) = lu(1220) - lu(1109) * lu(1218) + lu(1221) = lu(1221) - lu(1110) * lu(1218) + lu(1222) = lu(1222) - lu(1111) * lu(1218) + lu(1223) = lu(1223) - lu(1112) * lu(1218) + lu(1224) = lu(1224) - lu(1113) * lu(1218) + lu(1225) = lu(1225) - lu(1114) * lu(1218) + lu(1226) = lu(1226) - lu(1115) * lu(1218) + lu(1227) = lu(1227) - lu(1116) * lu(1218) + lu(1228) = lu(1228) - lu(1117) * lu(1218) + lu(1229) = lu(1229) - lu(1118) * lu(1218) + lu(1239) = lu(1239) - lu(1108) * lu(1238) + lu(1240) = lu(1240) - lu(1109) * lu(1238) + lu(1241) = lu(1241) - lu(1110) * lu(1238) + lu(1242) = lu(1242) - lu(1111) * lu(1238) + lu(1243) = lu(1243) - lu(1112) * lu(1238) + lu(1244) = lu(1244) - lu(1113) * lu(1238) + lu(1245) = lu(1245) - lu(1114) * lu(1238) + lu(1246) = lu(1246) - lu(1115) * lu(1238) + lu(1247) = lu(1247) - lu(1116) * lu(1238) + lu(1248) = lu(1248) - lu(1117) * lu(1238) + lu(1249) = lu(1249) - lu(1118) * lu(1238) + lu(1312) = lu(1312) - lu(1108) * lu(1311) + lu(1313) = lu(1313) - lu(1109) * lu(1311) + lu(1314) = lu(1314) - lu(1110) * lu(1311) + lu(1315) = lu(1315) - lu(1111) * lu(1311) + lu(1316) = lu(1316) - lu(1112) * lu(1311) + lu(1317) = lu(1317) - lu(1113) * lu(1311) + lu(1318) = lu(1318) - lu(1114) * lu(1311) + lu(1319) = lu(1319) - lu(1115) * lu(1311) + lu(1320) = lu(1320) - lu(1116) * lu(1311) + lu(1321) = lu(1321) - lu(1117) * lu(1311) + lu(1322) = lu(1322) - lu(1118) * lu(1311) + lu(1356) = lu(1356) - lu(1108) * lu(1355) + lu(1357) = lu(1357) - lu(1109) * lu(1355) + lu(1358) = lu(1358) - lu(1110) * lu(1355) + lu(1359) = lu(1359) - lu(1111) * lu(1355) + lu(1360) = lu(1360) - lu(1112) * lu(1355) + lu(1361) = lu(1361) - lu(1113) * lu(1355) + lu(1362) = lu(1362) - lu(1114) * lu(1355) + lu(1363) = lu(1363) - lu(1115) * lu(1355) + lu(1364) = lu(1364) - lu(1116) * lu(1355) + lu(1365) = lu(1365) - lu(1117) * lu(1355) + lu(1366) = lu(1366) - lu(1118) * lu(1355) + lu(1382) = lu(1382) - lu(1108) * lu(1381) + lu(1383) = lu(1383) - lu(1109) * lu(1381) + lu(1384) = lu(1384) - lu(1110) * lu(1381) + lu(1385) = lu(1385) - lu(1111) * lu(1381) + lu(1386) = lu(1386) - lu(1112) * lu(1381) + lu(1387) = lu(1387) - lu(1113) * lu(1381) + lu(1388) = lu(1388) - lu(1114) * lu(1381) + lu(1389) = lu(1389) - lu(1115) * lu(1381) + lu(1390) = lu(1390) - lu(1116) * lu(1381) + lu(1391) = lu(1391) - lu(1117) * lu(1381) + lu(1392) = lu(1392) - lu(1118) * lu(1381) + lu(1417) = lu(1417) - lu(1108) * lu(1416) + lu(1418) = lu(1418) - lu(1109) * lu(1416) + lu(1419) = lu(1419) - lu(1110) * lu(1416) + lu(1420) = lu(1420) - lu(1111) * lu(1416) + lu(1421) = lu(1421) - lu(1112) * lu(1416) + lu(1422) = lu(1422) - lu(1113) * lu(1416) + lu(1423) = lu(1423) - lu(1114) * lu(1416) + lu(1424) = lu(1424) - lu(1115) * lu(1416) + lu(1425) = lu(1425) - lu(1116) * lu(1416) + lu(1426) = lu(1426) - lu(1117) * lu(1416) + lu(1427) = lu(1427) - lu(1118) * lu(1416) + lu(1518) = lu(1518) - lu(1108) * lu(1517) + lu(1519) = lu(1519) - lu(1109) * lu(1517) + lu(1520) = lu(1520) - lu(1110) * lu(1517) + lu(1521) = lu(1521) - lu(1111) * lu(1517) + lu(1522) = lu(1522) - lu(1112) * lu(1517) + lu(1523) = lu(1523) - lu(1113) * lu(1517) + lu(1524) = lu(1524) - lu(1114) * lu(1517) + lu(1525) = lu(1525) - lu(1115) * lu(1517) + lu(1526) = lu(1526) - lu(1116) * lu(1517) + lu(1527) = lu(1527) - lu(1117) * lu(1517) + lu(1528) = lu(1528) - lu(1118) * lu(1517) + lu(1545) = lu(1545) - lu(1108) * lu(1544) + lu(1546) = lu(1546) - lu(1109) * lu(1544) + lu(1547) = lu(1547) - lu(1110) * lu(1544) + lu(1548) = lu(1548) - lu(1111) * lu(1544) + lu(1549) = lu(1549) - lu(1112) * lu(1544) + lu(1550) = lu(1550) - lu(1113) * lu(1544) + lu(1551) = lu(1551) - lu(1114) * lu(1544) + lu(1552) = lu(1552) - lu(1115) * lu(1544) + lu(1553) = lu(1553) - lu(1116) * lu(1544) + lu(1554) = lu(1554) - lu(1117) * lu(1544) + lu(1555) = lu(1555) - lu(1118) * lu(1544) + end subroutine lu_fac20 + subroutine lu_fac21( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1134) = 1._r8 / lu(1134) + lu(1135) = lu(1135) * lu(1134) + lu(1136) = lu(1136) * lu(1134) + lu(1137) = lu(1137) * lu(1134) + lu(1138) = lu(1138) * lu(1134) + lu(1139) = lu(1139) * lu(1134) + lu(1140) = lu(1140) * lu(1134) + lu(1141) = lu(1141) * lu(1134) + lu(1142) = lu(1142) * lu(1134) + lu(1143) = lu(1143) * lu(1134) + lu(1144) = lu(1144) * lu(1134) + lu(1172) = lu(1172) - lu(1135) * lu(1171) + lu(1173) = lu(1173) - lu(1136) * lu(1171) + lu(1174) = lu(1174) - lu(1137) * lu(1171) + lu(1175) = lu(1175) - lu(1138) * lu(1171) + lu(1176) = lu(1176) - lu(1139) * lu(1171) + lu(1177) = lu(1177) - lu(1140) * lu(1171) + lu(1178) = lu(1178) - lu(1141) * lu(1171) + lu(1179) = lu(1179) - lu(1142) * lu(1171) + lu(1180) = lu(1180) - lu(1143) * lu(1171) + lu(1181) = lu(1181) - lu(1144) * lu(1171) + lu(1196) = lu(1196) - lu(1135) * lu(1195) + lu(1197) = lu(1197) - lu(1136) * lu(1195) + lu(1198) = lu(1198) - lu(1137) * lu(1195) + lu(1199) = lu(1199) - lu(1138) * lu(1195) + lu(1200) = lu(1200) - lu(1139) * lu(1195) + lu(1201) = lu(1201) - lu(1140) * lu(1195) + lu(1202) = lu(1202) - lu(1141) * lu(1195) + lu(1203) = lu(1203) - lu(1142) * lu(1195) + lu(1204) = lu(1204) - lu(1143) * lu(1195) + lu(1205) = lu(1205) - lu(1144) * lu(1195) + lu(1220) = lu(1220) - lu(1135) * lu(1219) + lu(1221) = lu(1221) - lu(1136) * lu(1219) + lu(1222) = lu(1222) - lu(1137) * lu(1219) + lu(1223) = lu(1223) - lu(1138) * lu(1219) + lu(1224) = lu(1224) - lu(1139) * lu(1219) + lu(1225) = lu(1225) - lu(1140) * lu(1219) + lu(1226) = lu(1226) - lu(1141) * lu(1219) + lu(1227) = lu(1227) - lu(1142) * lu(1219) + lu(1228) = lu(1228) - lu(1143) * lu(1219) + lu(1229) = lu(1229) - lu(1144) * lu(1219) + lu(1240) = lu(1240) - lu(1135) * lu(1239) + lu(1241) = lu(1241) - lu(1136) * lu(1239) + lu(1242) = lu(1242) - lu(1137) * lu(1239) + lu(1243) = lu(1243) - lu(1138) * lu(1239) + lu(1244) = lu(1244) - lu(1139) * lu(1239) + lu(1245) = lu(1245) - lu(1140) * lu(1239) + lu(1246) = lu(1246) - lu(1141) * lu(1239) + lu(1247) = lu(1247) - lu(1142) * lu(1239) + lu(1248) = lu(1248) - lu(1143) * lu(1239) + lu(1249) = lu(1249) - lu(1144) * lu(1239) + lu(1313) = lu(1313) - lu(1135) * lu(1312) + lu(1314) = lu(1314) - lu(1136) * lu(1312) + lu(1315) = lu(1315) - lu(1137) * lu(1312) + lu(1316) = lu(1316) - lu(1138) * lu(1312) + lu(1317) = lu(1317) - lu(1139) * lu(1312) + lu(1318) = lu(1318) - lu(1140) * lu(1312) + lu(1319) = lu(1319) - lu(1141) * lu(1312) + lu(1320) = lu(1320) - lu(1142) * lu(1312) + lu(1321) = lu(1321) - lu(1143) * lu(1312) + lu(1322) = lu(1322) - lu(1144) * lu(1312) + lu(1357) = lu(1357) - lu(1135) * lu(1356) + lu(1358) = lu(1358) - lu(1136) * lu(1356) + lu(1359) = lu(1359) - lu(1137) * lu(1356) + lu(1360) = lu(1360) - lu(1138) * lu(1356) + lu(1361) = lu(1361) - lu(1139) * lu(1356) + lu(1362) = lu(1362) - lu(1140) * lu(1356) + lu(1363) = lu(1363) - lu(1141) * lu(1356) + lu(1364) = lu(1364) - lu(1142) * lu(1356) + lu(1365) = lu(1365) - lu(1143) * lu(1356) + lu(1366) = lu(1366) - lu(1144) * lu(1356) + lu(1383) = lu(1383) - lu(1135) * lu(1382) + lu(1384) = lu(1384) - lu(1136) * lu(1382) + lu(1385) = lu(1385) - lu(1137) * lu(1382) + lu(1386) = lu(1386) - lu(1138) * lu(1382) + lu(1387) = lu(1387) - lu(1139) * lu(1382) + lu(1388) = lu(1388) - lu(1140) * lu(1382) + lu(1389) = lu(1389) - lu(1141) * lu(1382) + lu(1390) = lu(1390) - lu(1142) * lu(1382) + lu(1391) = lu(1391) - lu(1143) * lu(1382) + lu(1392) = lu(1392) - lu(1144) * lu(1382) + lu(1418) = lu(1418) - lu(1135) * lu(1417) + lu(1419) = lu(1419) - lu(1136) * lu(1417) + lu(1420) = lu(1420) - lu(1137) * lu(1417) + lu(1421) = lu(1421) - lu(1138) * lu(1417) + lu(1422) = lu(1422) - lu(1139) * lu(1417) + lu(1423) = lu(1423) - lu(1140) * lu(1417) + lu(1424) = lu(1424) - lu(1141) * lu(1417) + lu(1425) = lu(1425) - lu(1142) * lu(1417) + lu(1426) = lu(1426) - lu(1143) * lu(1417) + lu(1427) = lu(1427) - lu(1144) * lu(1417) + lu(1519) = lu(1519) - lu(1135) * lu(1518) + lu(1520) = lu(1520) - lu(1136) * lu(1518) + lu(1521) = lu(1521) - lu(1137) * lu(1518) + lu(1522) = lu(1522) - lu(1138) * lu(1518) + lu(1523) = lu(1523) - lu(1139) * lu(1518) + lu(1524) = lu(1524) - lu(1140) * lu(1518) + lu(1525) = lu(1525) - lu(1141) * lu(1518) + lu(1526) = lu(1526) - lu(1142) * lu(1518) + lu(1527) = lu(1527) - lu(1143) * lu(1518) + lu(1528) = lu(1528) - lu(1144) * lu(1518) + lu(1546) = lu(1546) - lu(1135) * lu(1545) + lu(1547) = lu(1547) - lu(1136) * lu(1545) + lu(1548) = lu(1548) - lu(1137) * lu(1545) + lu(1549) = lu(1549) - lu(1138) * lu(1545) + lu(1550) = lu(1550) - lu(1139) * lu(1545) + lu(1551) = lu(1551) - lu(1140) * lu(1545) + lu(1552) = lu(1552) - lu(1141) * lu(1545) + lu(1553) = lu(1553) - lu(1142) * lu(1545) + lu(1554) = lu(1554) - lu(1143) * lu(1545) + lu(1555) = lu(1555) - lu(1144) * lu(1545) + lu(1172) = 1._r8 / lu(1172) + lu(1173) = lu(1173) * lu(1172) + lu(1174) = lu(1174) * lu(1172) + lu(1175) = lu(1175) * lu(1172) + lu(1176) = lu(1176) * lu(1172) + lu(1177) = lu(1177) * lu(1172) + lu(1178) = lu(1178) * lu(1172) + lu(1179) = lu(1179) * lu(1172) + lu(1180) = lu(1180) * lu(1172) + lu(1181) = lu(1181) * lu(1172) + lu(1197) = lu(1197) - lu(1173) * lu(1196) + lu(1198) = lu(1198) - lu(1174) * lu(1196) + lu(1199) = lu(1199) - lu(1175) * lu(1196) + lu(1200) = lu(1200) - lu(1176) * lu(1196) + lu(1201) = lu(1201) - lu(1177) * lu(1196) + lu(1202) = lu(1202) - lu(1178) * lu(1196) + lu(1203) = lu(1203) - lu(1179) * lu(1196) + lu(1204) = lu(1204) - lu(1180) * lu(1196) + lu(1205) = lu(1205) - lu(1181) * lu(1196) + lu(1221) = lu(1221) - lu(1173) * lu(1220) + lu(1222) = lu(1222) - lu(1174) * lu(1220) + lu(1223) = lu(1223) - lu(1175) * lu(1220) + lu(1224) = lu(1224) - lu(1176) * lu(1220) + lu(1225) = lu(1225) - lu(1177) * lu(1220) + lu(1226) = lu(1226) - lu(1178) * lu(1220) + lu(1227) = lu(1227) - lu(1179) * lu(1220) + lu(1228) = lu(1228) - lu(1180) * lu(1220) + lu(1229) = lu(1229) - lu(1181) * lu(1220) + lu(1241) = lu(1241) - lu(1173) * lu(1240) + lu(1242) = lu(1242) - lu(1174) * lu(1240) + lu(1243) = lu(1243) - lu(1175) * lu(1240) + lu(1244) = lu(1244) - lu(1176) * lu(1240) + lu(1245) = lu(1245) - lu(1177) * lu(1240) + lu(1246) = lu(1246) - lu(1178) * lu(1240) + lu(1247) = lu(1247) - lu(1179) * lu(1240) + lu(1248) = lu(1248) - lu(1180) * lu(1240) + lu(1249) = lu(1249) - lu(1181) * lu(1240) + lu(1314) = lu(1314) - lu(1173) * lu(1313) + lu(1315) = lu(1315) - lu(1174) * lu(1313) + lu(1316) = lu(1316) - lu(1175) * lu(1313) + lu(1317) = lu(1317) - lu(1176) * lu(1313) + lu(1318) = lu(1318) - lu(1177) * lu(1313) + lu(1319) = lu(1319) - lu(1178) * lu(1313) + lu(1320) = lu(1320) - lu(1179) * lu(1313) + lu(1321) = lu(1321) - lu(1180) * lu(1313) + lu(1322) = lu(1322) - lu(1181) * lu(1313) + lu(1358) = lu(1358) - lu(1173) * lu(1357) + lu(1359) = lu(1359) - lu(1174) * lu(1357) + lu(1360) = lu(1360) - lu(1175) * lu(1357) + lu(1361) = lu(1361) - lu(1176) * lu(1357) + lu(1362) = lu(1362) - lu(1177) * lu(1357) + lu(1363) = lu(1363) - lu(1178) * lu(1357) + lu(1364) = lu(1364) - lu(1179) * lu(1357) + lu(1365) = lu(1365) - lu(1180) * lu(1357) + lu(1366) = lu(1366) - lu(1181) * lu(1357) + lu(1384) = lu(1384) - lu(1173) * lu(1383) + lu(1385) = lu(1385) - lu(1174) * lu(1383) + lu(1386) = lu(1386) - lu(1175) * lu(1383) + lu(1387) = lu(1387) - lu(1176) * lu(1383) + lu(1388) = lu(1388) - lu(1177) * lu(1383) + lu(1389) = lu(1389) - lu(1178) * lu(1383) + lu(1390) = lu(1390) - lu(1179) * lu(1383) + lu(1391) = lu(1391) - lu(1180) * lu(1383) + lu(1392) = lu(1392) - lu(1181) * lu(1383) + lu(1419) = lu(1419) - lu(1173) * lu(1418) + lu(1420) = lu(1420) - lu(1174) * lu(1418) + lu(1421) = lu(1421) - lu(1175) * lu(1418) + lu(1422) = lu(1422) - lu(1176) * lu(1418) + lu(1423) = lu(1423) - lu(1177) * lu(1418) + lu(1424) = lu(1424) - lu(1178) * lu(1418) + lu(1425) = lu(1425) - lu(1179) * lu(1418) + lu(1426) = lu(1426) - lu(1180) * lu(1418) + lu(1427) = lu(1427) - lu(1181) * lu(1418) + lu(1520) = lu(1520) - lu(1173) * lu(1519) + lu(1521) = lu(1521) - lu(1174) * lu(1519) + lu(1522) = lu(1522) - lu(1175) * lu(1519) + lu(1523) = lu(1523) - lu(1176) * lu(1519) + lu(1524) = lu(1524) - lu(1177) * lu(1519) + lu(1525) = lu(1525) - lu(1178) * lu(1519) + lu(1526) = lu(1526) - lu(1179) * lu(1519) + lu(1527) = lu(1527) - lu(1180) * lu(1519) + lu(1528) = lu(1528) - lu(1181) * lu(1519) + lu(1547) = lu(1547) - lu(1173) * lu(1546) + lu(1548) = lu(1548) - lu(1174) * lu(1546) + lu(1549) = lu(1549) - lu(1175) * lu(1546) + lu(1550) = lu(1550) - lu(1176) * lu(1546) + lu(1551) = lu(1551) - lu(1177) * lu(1546) + lu(1552) = lu(1552) - lu(1178) * lu(1546) + lu(1553) = lu(1553) - lu(1179) * lu(1546) + lu(1554) = lu(1554) - lu(1180) * lu(1546) + lu(1555) = lu(1555) - lu(1181) * lu(1546) + lu(1197) = 1._r8 / lu(1197) + lu(1198) = lu(1198) * lu(1197) + lu(1199) = lu(1199) * lu(1197) + lu(1200) = lu(1200) * lu(1197) + lu(1201) = lu(1201) * lu(1197) + lu(1202) = lu(1202) * lu(1197) + lu(1203) = lu(1203) * lu(1197) + lu(1204) = lu(1204) * lu(1197) + lu(1205) = lu(1205) * lu(1197) + lu(1222) = lu(1222) - lu(1198) * lu(1221) + lu(1223) = lu(1223) - lu(1199) * lu(1221) + lu(1224) = lu(1224) - lu(1200) * lu(1221) + lu(1225) = lu(1225) - lu(1201) * lu(1221) + lu(1226) = lu(1226) - lu(1202) * lu(1221) + lu(1227) = lu(1227) - lu(1203) * lu(1221) + lu(1228) = lu(1228) - lu(1204) * lu(1221) + lu(1229) = lu(1229) - lu(1205) * lu(1221) + lu(1242) = lu(1242) - lu(1198) * lu(1241) + lu(1243) = lu(1243) - lu(1199) * lu(1241) + lu(1244) = lu(1244) - lu(1200) * lu(1241) + lu(1245) = lu(1245) - lu(1201) * lu(1241) + lu(1246) = lu(1246) - lu(1202) * lu(1241) + lu(1247) = lu(1247) - lu(1203) * lu(1241) + lu(1248) = lu(1248) - lu(1204) * lu(1241) + lu(1249) = lu(1249) - lu(1205) * lu(1241) + lu(1315) = lu(1315) - lu(1198) * lu(1314) + lu(1316) = lu(1316) - lu(1199) * lu(1314) + lu(1317) = lu(1317) - lu(1200) * lu(1314) + lu(1318) = lu(1318) - lu(1201) * lu(1314) + lu(1319) = lu(1319) - lu(1202) * lu(1314) + lu(1320) = lu(1320) - lu(1203) * lu(1314) + lu(1321) = lu(1321) - lu(1204) * lu(1314) + lu(1322) = lu(1322) - lu(1205) * lu(1314) + lu(1359) = lu(1359) - lu(1198) * lu(1358) + lu(1360) = lu(1360) - lu(1199) * lu(1358) + lu(1361) = lu(1361) - lu(1200) * lu(1358) + lu(1362) = lu(1362) - lu(1201) * lu(1358) + lu(1363) = lu(1363) - lu(1202) * lu(1358) + lu(1364) = lu(1364) - lu(1203) * lu(1358) + lu(1365) = lu(1365) - lu(1204) * lu(1358) + lu(1366) = lu(1366) - lu(1205) * lu(1358) + lu(1385) = lu(1385) - lu(1198) * lu(1384) + lu(1386) = lu(1386) - lu(1199) * lu(1384) + lu(1387) = lu(1387) - lu(1200) * lu(1384) + lu(1388) = lu(1388) - lu(1201) * lu(1384) + lu(1389) = lu(1389) - lu(1202) * lu(1384) + lu(1390) = lu(1390) - lu(1203) * lu(1384) + lu(1391) = lu(1391) - lu(1204) * lu(1384) + lu(1392) = lu(1392) - lu(1205) * lu(1384) + lu(1420) = lu(1420) - lu(1198) * lu(1419) + lu(1421) = lu(1421) - lu(1199) * lu(1419) + lu(1422) = lu(1422) - lu(1200) * lu(1419) + lu(1423) = lu(1423) - lu(1201) * lu(1419) + lu(1424) = lu(1424) - lu(1202) * lu(1419) + lu(1425) = lu(1425) - lu(1203) * lu(1419) + lu(1426) = lu(1426) - lu(1204) * lu(1419) + lu(1427) = lu(1427) - lu(1205) * lu(1419) + lu(1521) = lu(1521) - lu(1198) * lu(1520) + lu(1522) = lu(1522) - lu(1199) * lu(1520) + lu(1523) = lu(1523) - lu(1200) * lu(1520) + lu(1524) = lu(1524) - lu(1201) * lu(1520) + lu(1525) = lu(1525) - lu(1202) * lu(1520) + lu(1526) = lu(1526) - lu(1203) * lu(1520) + lu(1527) = lu(1527) - lu(1204) * lu(1520) + lu(1528) = lu(1528) - lu(1205) * lu(1520) + lu(1548) = lu(1548) - lu(1198) * lu(1547) + lu(1549) = lu(1549) - lu(1199) * lu(1547) + lu(1550) = lu(1550) - lu(1200) * lu(1547) + lu(1551) = lu(1551) - lu(1201) * lu(1547) + lu(1552) = lu(1552) - lu(1202) * lu(1547) + lu(1553) = lu(1553) - lu(1203) * lu(1547) + lu(1554) = lu(1554) - lu(1204) * lu(1547) + lu(1555) = lu(1555) - lu(1205) * lu(1547) + lu(1222) = 1._r8 / lu(1222) + lu(1223) = lu(1223) * lu(1222) + lu(1224) = lu(1224) * lu(1222) + lu(1225) = lu(1225) * lu(1222) + lu(1226) = lu(1226) * lu(1222) + lu(1227) = lu(1227) * lu(1222) + lu(1228) = lu(1228) * lu(1222) + lu(1229) = lu(1229) * lu(1222) + lu(1243) = lu(1243) - lu(1223) * lu(1242) + lu(1244) = lu(1244) - lu(1224) * lu(1242) + lu(1245) = lu(1245) - lu(1225) * lu(1242) + lu(1246) = lu(1246) - lu(1226) * lu(1242) + lu(1247) = lu(1247) - lu(1227) * lu(1242) + lu(1248) = lu(1248) - lu(1228) * lu(1242) + lu(1249) = lu(1249) - lu(1229) * lu(1242) + lu(1316) = lu(1316) - lu(1223) * lu(1315) + lu(1317) = lu(1317) - lu(1224) * lu(1315) + lu(1318) = lu(1318) - lu(1225) * lu(1315) + lu(1319) = lu(1319) - lu(1226) * lu(1315) + lu(1320) = lu(1320) - lu(1227) * lu(1315) + lu(1321) = lu(1321) - lu(1228) * lu(1315) + lu(1322) = lu(1322) - lu(1229) * lu(1315) + lu(1360) = lu(1360) - lu(1223) * lu(1359) + lu(1361) = lu(1361) - lu(1224) * lu(1359) + lu(1362) = lu(1362) - lu(1225) * lu(1359) + lu(1363) = lu(1363) - lu(1226) * lu(1359) + lu(1364) = lu(1364) - lu(1227) * lu(1359) + lu(1365) = lu(1365) - lu(1228) * lu(1359) + lu(1366) = lu(1366) - lu(1229) * lu(1359) + lu(1386) = lu(1386) - lu(1223) * lu(1385) + lu(1387) = lu(1387) - lu(1224) * lu(1385) + lu(1388) = lu(1388) - lu(1225) * lu(1385) + lu(1389) = lu(1389) - lu(1226) * lu(1385) + lu(1390) = lu(1390) - lu(1227) * lu(1385) + lu(1391) = lu(1391) - lu(1228) * lu(1385) + lu(1392) = lu(1392) - lu(1229) * lu(1385) + lu(1421) = lu(1421) - lu(1223) * lu(1420) + lu(1422) = lu(1422) - lu(1224) * lu(1420) + lu(1423) = lu(1423) - lu(1225) * lu(1420) + lu(1424) = lu(1424) - lu(1226) * lu(1420) + lu(1425) = lu(1425) - lu(1227) * lu(1420) + lu(1426) = lu(1426) - lu(1228) * lu(1420) + lu(1427) = lu(1427) - lu(1229) * lu(1420) + lu(1522) = lu(1522) - lu(1223) * lu(1521) + lu(1523) = lu(1523) - lu(1224) * lu(1521) + lu(1524) = lu(1524) - lu(1225) * lu(1521) + lu(1525) = lu(1525) - lu(1226) * lu(1521) + lu(1526) = lu(1526) - lu(1227) * lu(1521) + lu(1527) = lu(1527) - lu(1228) * lu(1521) + lu(1528) = lu(1528) - lu(1229) * lu(1521) + lu(1549) = lu(1549) - lu(1223) * lu(1548) + lu(1550) = lu(1550) - lu(1224) * lu(1548) + lu(1551) = lu(1551) - lu(1225) * lu(1548) + lu(1552) = lu(1552) - lu(1226) * lu(1548) + lu(1553) = lu(1553) - lu(1227) * lu(1548) + lu(1554) = lu(1554) - lu(1228) * lu(1548) + lu(1555) = lu(1555) - lu(1229) * lu(1548) + lu(1243) = 1._r8 / lu(1243) + lu(1244) = lu(1244) * lu(1243) + lu(1245) = lu(1245) * lu(1243) + lu(1246) = lu(1246) * lu(1243) + lu(1247) = lu(1247) * lu(1243) + lu(1248) = lu(1248) * lu(1243) + lu(1249) = lu(1249) * lu(1243) + lu(1317) = lu(1317) - lu(1244) * lu(1316) + lu(1318) = lu(1318) - lu(1245) * lu(1316) + lu(1319) = lu(1319) - lu(1246) * lu(1316) + lu(1320) = lu(1320) - lu(1247) * lu(1316) + lu(1321) = lu(1321) - lu(1248) * lu(1316) + lu(1322) = lu(1322) - lu(1249) * lu(1316) + lu(1361) = lu(1361) - lu(1244) * lu(1360) + lu(1362) = lu(1362) - lu(1245) * lu(1360) + lu(1363) = lu(1363) - lu(1246) * lu(1360) + lu(1364) = lu(1364) - lu(1247) * lu(1360) + lu(1365) = lu(1365) - lu(1248) * lu(1360) + lu(1366) = lu(1366) - lu(1249) * lu(1360) + lu(1387) = lu(1387) - lu(1244) * lu(1386) + lu(1388) = lu(1388) - lu(1245) * lu(1386) + lu(1389) = lu(1389) - lu(1246) * lu(1386) + lu(1390) = lu(1390) - lu(1247) * lu(1386) + lu(1391) = lu(1391) - lu(1248) * lu(1386) + lu(1392) = lu(1392) - lu(1249) * lu(1386) + lu(1422) = lu(1422) - lu(1244) * lu(1421) + lu(1423) = lu(1423) - lu(1245) * lu(1421) + lu(1424) = lu(1424) - lu(1246) * lu(1421) + lu(1425) = lu(1425) - lu(1247) * lu(1421) + lu(1426) = lu(1426) - lu(1248) * lu(1421) + lu(1427) = lu(1427) - lu(1249) * lu(1421) + lu(1523) = lu(1523) - lu(1244) * lu(1522) + lu(1524) = lu(1524) - lu(1245) * lu(1522) + lu(1525) = lu(1525) - lu(1246) * lu(1522) + lu(1526) = lu(1526) - lu(1247) * lu(1522) + lu(1527) = lu(1527) - lu(1248) * lu(1522) + lu(1528) = lu(1528) - lu(1249) * lu(1522) + lu(1550) = lu(1550) - lu(1244) * lu(1549) + lu(1551) = lu(1551) - lu(1245) * lu(1549) + lu(1552) = lu(1552) - lu(1246) * lu(1549) + lu(1553) = lu(1553) - lu(1247) * lu(1549) + lu(1554) = lu(1554) - lu(1248) * lu(1549) + lu(1555) = lu(1555) - lu(1249) * lu(1549) + lu(1317) = 1._r8 / lu(1317) + lu(1318) = lu(1318) * lu(1317) + lu(1319) = lu(1319) * lu(1317) + lu(1320) = lu(1320) * lu(1317) + lu(1321) = lu(1321) * lu(1317) + lu(1322) = lu(1322) * lu(1317) + lu(1362) = lu(1362) - lu(1318) * lu(1361) + lu(1363) = lu(1363) - lu(1319) * lu(1361) + lu(1364) = lu(1364) - lu(1320) * lu(1361) + lu(1365) = lu(1365) - lu(1321) * lu(1361) + lu(1366) = lu(1366) - lu(1322) * lu(1361) + lu(1388) = lu(1388) - lu(1318) * lu(1387) + lu(1389) = lu(1389) - lu(1319) * lu(1387) + lu(1390) = lu(1390) - lu(1320) * lu(1387) + lu(1391) = lu(1391) - lu(1321) * lu(1387) + lu(1392) = lu(1392) - lu(1322) * lu(1387) + lu(1423) = lu(1423) - lu(1318) * lu(1422) + lu(1424) = lu(1424) - lu(1319) * lu(1422) + lu(1425) = lu(1425) - lu(1320) * lu(1422) + lu(1426) = lu(1426) - lu(1321) * lu(1422) + lu(1427) = lu(1427) - lu(1322) * lu(1422) + lu(1524) = lu(1524) - lu(1318) * lu(1523) + lu(1525) = lu(1525) - lu(1319) * lu(1523) + lu(1526) = lu(1526) - lu(1320) * lu(1523) + lu(1527) = lu(1527) - lu(1321) * lu(1523) + lu(1528) = lu(1528) - lu(1322) * lu(1523) + lu(1551) = lu(1551) - lu(1318) * lu(1550) + lu(1552) = lu(1552) - lu(1319) * lu(1550) + lu(1553) = lu(1553) - lu(1320) * lu(1550) + lu(1554) = lu(1554) - lu(1321) * lu(1550) + lu(1555) = lu(1555) - lu(1322) * lu(1550) + end subroutine lu_fac21 + subroutine lu_fac22( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1362) = 1._r8 / lu(1362) + lu(1363) = lu(1363) * lu(1362) + lu(1364) = lu(1364) * lu(1362) + lu(1365) = lu(1365) * lu(1362) + lu(1366) = lu(1366) * lu(1362) + lu(1389) = lu(1389) - lu(1363) * lu(1388) + lu(1390) = lu(1390) - lu(1364) * lu(1388) + lu(1391) = lu(1391) - lu(1365) * lu(1388) + lu(1392) = lu(1392) - lu(1366) * lu(1388) + lu(1424) = lu(1424) - lu(1363) * lu(1423) + lu(1425) = lu(1425) - lu(1364) * lu(1423) + lu(1426) = lu(1426) - lu(1365) * lu(1423) + lu(1427) = lu(1427) - lu(1366) * lu(1423) + lu(1525) = lu(1525) - lu(1363) * lu(1524) + lu(1526) = lu(1526) - lu(1364) * lu(1524) + lu(1527) = lu(1527) - lu(1365) * lu(1524) + lu(1528) = lu(1528) - lu(1366) * lu(1524) + lu(1552) = lu(1552) - lu(1363) * lu(1551) + lu(1553) = lu(1553) - lu(1364) * lu(1551) + lu(1554) = lu(1554) - lu(1365) * lu(1551) + lu(1555) = lu(1555) - lu(1366) * lu(1551) + lu(1389) = 1._r8 / lu(1389) + lu(1390) = lu(1390) * lu(1389) + lu(1391) = lu(1391) * lu(1389) + lu(1392) = lu(1392) * lu(1389) + lu(1425) = lu(1425) - lu(1390) * lu(1424) + lu(1426) = lu(1426) - lu(1391) * lu(1424) + lu(1427) = lu(1427) - lu(1392) * lu(1424) + lu(1526) = lu(1526) - lu(1390) * lu(1525) + lu(1527) = lu(1527) - lu(1391) * lu(1525) + lu(1528) = lu(1528) - lu(1392) * lu(1525) + lu(1553) = lu(1553) - lu(1390) * lu(1552) + lu(1554) = lu(1554) - lu(1391) * lu(1552) + lu(1555) = lu(1555) - lu(1392) * lu(1552) + lu(1425) = 1._r8 / lu(1425) + lu(1426) = lu(1426) * lu(1425) + lu(1427) = lu(1427) * lu(1425) + lu(1527) = lu(1527) - lu(1426) * lu(1526) + lu(1528) = lu(1528) - lu(1427) * lu(1526) + lu(1554) = lu(1554) - lu(1426) * lu(1553) + lu(1555) = lu(1555) - lu(1427) * lu(1553) + lu(1527) = 1._r8 / lu(1527) + lu(1528) = lu(1528) * lu(1527) + lu(1555) = lu(1555) - lu(1528) * lu(1554) + lu(1555) = 1._r8 / lu(1555) + end subroutine lu_fac22 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + call lu_fac12( lu ) + call lu_fac13( lu ) + call lu_fac14( lu ) + call lu_fac15( lu ) + call lu_fac16( lu ) + call lu_fac17( lu ) + call lu_fac18( lu ) + call lu_fac19( lu ) + call lu_fac20( lu ) + call lu_fac21( lu ) + call lu_fac22( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 new file mode 100644 index 0000000000..892badcc93 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_lu_solve.F90 @@ -0,0 +1,1709 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(18) = b(18) - lu(18) * b(17) + b(20) = b(20) - lu(21) * b(19) + b(149) = b(149) - lu(32) * b(29) + b(151) = b(151) - lu(33) * b(29) + b(95) = b(95) - lu(35) * b(30) + b(150) = b(150) - lu(36) * b(30) + b(57) = b(57) - lu(38) * b(31) + b(150) = b(150) - lu(39) * b(31) + b(64) = b(64) - lu(41) * b(32) + b(150) = b(150) - lu(42) * b(32) + b(73) = b(73) - lu(44) * b(33) + b(150) = b(150) - lu(45) * b(33) + b(146) = b(146) - lu(47) * b(34) + b(150) = b(150) - lu(48) * b(34) + b(111) = b(111) - lu(50) * b(35) + b(148) = b(148) - lu(51) * b(35) + b(150) = b(150) - lu(52) * b(35) + b(37) = b(37) - lu(54) * b(36) + b(79) = b(79) - lu(55) * b(36) + b(146) = b(146) - lu(56) * b(36) + b(150) = b(150) - lu(57) * b(36) + b(44) = b(44) - lu(59) * b(37) + b(150) = b(150) - lu(60) * b(37) + b(71) = b(71) - lu(62) * b(38) + b(150) = b(150) - lu(63) * b(38) + b(101) = b(101) - lu(65) * b(39) + b(141) = b(141) - lu(66) * b(39) + b(136) = b(136) - lu(68) * b(40) + b(136) = b(136) - lu(71) * b(41) + b(51) = b(51) - lu(73) * b(42) + b(148) = b(148) - lu(74) * b(42) + b(149) = b(149) - lu(76) * b(43) + b(80) = b(80) - lu(78) * b(44) + b(142) = b(142) - lu(79) * b(44) + b(146) = b(146) - lu(80) * b(44) + b(101) = b(101) - lu(82) * b(45) + b(141) = b(141) - lu(83) * b(45) + b(149) = b(149) - lu(84) * b(45) + b(141) = b(141) - lu(86) * b(46) + b(146) = b(146) - lu(87) * b(46) + b(150) = b(150) - lu(88) * b(46) + b(101) = b(101) - lu(90) * b(47) + b(145) = b(145) - lu(91) * b(47) + b(134) = b(134) - lu(93) * b(48) + b(149) = b(149) - lu(94) * b(48) + b(120) = b(120) - lu(96) * b(49) + b(146) = b(146) - lu(97) * b(49) + b(150) = b(150) - lu(98) * b(49) + b(126) = b(126) - lu(100) * b(50) + b(148) = b(148) - lu(101) * b(50) + b(150) = b(150) - lu(102) * b(50) + b(115) = b(115) - lu(105) * b(51) + b(139) = b(139) - lu(106) * b(51) + b(148) = b(148) - lu(107) * b(51) + b(109) = b(109) - lu(109) * b(52) + b(133) = b(133) - lu(110) * b(52) + b(148) = b(148) - lu(111) * b(52) + b(149) = b(149) - lu(112) * b(52) + b(150) = b(150) - lu(113) * b(52) + b(83) = b(83) - lu(115) * b(53) + b(98) = b(98) - lu(116) * b(53) + b(119) = b(119) - lu(117) * b(53) + b(146) = b(146) - lu(118) * b(53) + b(150) = b(150) - lu(119) * b(53) + b(115) = b(115) - lu(121) * b(54) + b(137) = b(137) - lu(122) * b(54) + b(146) = b(146) - lu(123) * b(54) + b(147) = b(147) - lu(124) * b(54) + b(150) = b(150) - lu(125) * b(54) + b(137) = b(137) - lu(127) * b(55) + b(138) = b(138) - lu(128) * b(55) + b(139) = b(139) - lu(129) * b(55) + b(142) = b(142) - lu(130) * b(55) + b(147) = b(147) - lu(131) * b(55) + b(115) = b(115) - lu(133) * b(56) + b(132) = b(132) - lu(134) * b(56) + b(139) = b(139) - lu(135) * b(56) + b(151) = b(151) - lu(136) * b(56) + b(96) = b(96) - lu(138) * b(57) + b(120) = b(120) - lu(139) * b(57) + b(138) = b(138) - lu(140) * b(57) + b(142) = b(142) - lu(141) * b(57) + b(144) = b(144) - lu(142) * b(57) + b(146) = b(146) - lu(143) * b(57) + b(93) = b(93) - lu(145) * b(58) + b(120) = b(120) - lu(146) * b(58) + b(131) = b(131) - lu(147) * b(58) + b(150) = b(150) - lu(148) * b(58) + b(128) = b(128) - lu(150) * b(59) + b(130) = b(130) - lu(151) * b(59) + b(146) = b(146) - lu(152) * b(59) + b(150) = b(150) - lu(153) * b(59) + b(109) = b(109) - lu(155) * b(60) + b(120) = b(120) - lu(156) * b(60) + b(146) = b(146) - lu(157) * b(60) + b(150) = b(150) - lu(158) * b(60) + b(126) = b(126) - lu(160) * b(61) + b(150) = b(150) - lu(161) * b(61) + b(97) = b(97) - lu(163) * b(62) + b(115) = b(115) - lu(164) * b(62) + b(119) = b(119) - lu(165) * b(62) + b(132) = b(132) - lu(166) * b(62) + b(139) = b(139) - lu(167) * b(62) + b(145) = b(145) - lu(168) * b(62) + b(150) = b(150) - lu(169) * b(62) + b(79) = b(79) - lu(171) * b(63) + b(80) = b(80) - lu(172) * b(63) + b(98) = b(98) - lu(173) * b(63) + b(125) = b(125) - lu(174) * b(63) + b(150) = b(150) - lu(175) * b(63) + b(80) = b(80) - lu(178) * b(64) + b(98) = b(98) - lu(179) * b(64) + b(138) = b(138) - lu(180) * b(64) + b(142) = b(142) - lu(181) * b(64) + b(146) = b(146) - lu(182) * b(64) + b(125) = b(125) - lu(184) * b(65) + b(142) = b(142) - lu(185) * b(65) + b(150) = b(150) - lu(186) * b(65) + b(96) = b(96) - lu(188) * b(66) + b(111) = b(111) - lu(189) * b(66) + b(146) = b(146) - lu(190) * b(66) + b(148) = b(148) - lu(191) * b(66) + b(150) = b(150) - lu(192) * b(66) + b(121) = b(121) - lu(194) * b(67) + b(131) = b(131) - lu(195) * b(67) + b(144) = b(144) - lu(196) * b(67) + b(148) = b(148) - lu(197) * b(67) + b(150) = b(150) - lu(198) * b(67) + b(83) = b(83) - lu(200) * b(68) + b(138) = b(138) - lu(201) * b(68) + b(142) = b(142) - lu(202) * b(68) + b(144) = b(144) - lu(203) * b(68) + b(146) = b(146) - lu(204) * b(68) + b(135) = b(135) - lu(206) * b(69) + b(144) = b(144) - lu(207) * b(69) + b(145) = b(145) - lu(208) * b(69) + b(148) = b(148) - lu(209) * b(69) + b(150) = b(150) - lu(210) * b(69) + b(93) = b(93) - lu(212) * b(70) + b(109) = b(109) - lu(213) * b(70) + b(131) = b(131) - lu(214) * b(70) + b(150) = b(150) - lu(215) * b(70) + b(112) = b(112) - lu(217) * b(71) + b(136) = b(136) - lu(218) * b(71) + b(144) = b(144) - lu(219) * b(71) + b(146) = b(146) - lu(220) * b(71) + b(96) = b(96) - lu(222) * b(72) + b(116) = b(116) - lu(223) * b(72) + b(123) = b(123) - lu(224) * b(72) + b(129) = b(129) - lu(225) * b(72) + b(146) = b(146) - lu(226) * b(72) + b(150) = b(150) - lu(227) * b(72) + b(80) = b(80) - lu(230) * b(73) + b(98) = b(98) - lu(231) * b(73) + b(125) = b(125) - lu(232) * b(73) + b(138) = b(138) - lu(233) * b(73) + b(142) = b(142) - lu(234) * b(73) + b(146) = b(146) - lu(235) * b(73) + b(136) = b(136) - lu(237) * b(74) + b(142) = b(142) - lu(238) * b(74) + b(146) = b(146) - lu(239) * b(74) + b(147) = b(147) - lu(240) * b(74) + b(148) = b(148) - lu(241) * b(74) + b(150) = b(150) - lu(242) * b(74) + b(131) = b(131) - lu(244) * b(75) + b(135) = b(135) - lu(245) * b(75) + b(142) = b(142) - lu(246) * b(75) + b(144) = b(144) - lu(247) * b(75) + b(147) = b(147) - lu(248) * b(75) + b(150) = b(150) - lu(249) * b(75) + b(91) = b(91) - lu(251) * b(76) + b(102) = b(102) - lu(252) * b(76) + b(103) = b(103) - lu(253) * b(76) + b(108) = b(108) - lu(254) * b(76) + b(136) = b(136) - lu(255) * b(76) + b(139) = b(139) - lu(256) * b(76) + b(108) = b(108) - lu(258) * b(77) + b(136) = b(136) - lu(259) * b(77) + b(138) = b(138) - lu(260) * b(77) + b(141) = b(141) - lu(261) * b(77) + b(131) = b(131) - lu(263) * b(78) + b(135) = b(135) - lu(264) * b(78) + b(144) = b(144) - lu(265) * b(78) + b(148) = b(148) - lu(266) * b(78) + b(150) = b(150) - lu(267) * b(78) + b(80) = b(80) - lu(270) * b(79) + b(98) = b(98) - lu(271) * b(79) + b(125) = b(125) - lu(272) * b(79) + b(138) = b(138) - lu(273) * b(79) + b(142) = b(142) - lu(274) * b(79) + b(146) = b(146) - lu(275) * b(79) + b(150) = b(150) - lu(276) * b(79) + b(98) = b(98) - lu(278) * b(80) + b(119) = b(119) - lu(279) * b(80) + b(125) = b(125) - lu(280) * b(80) + b(131) = b(131) - lu(281) * b(80) + b(146) = b(146) - lu(282) * b(80) + b(122) = b(122) - lu(284) * b(81) + b(130) = b(130) - lu(285) * b(81) + b(142) = b(142) - lu(286) * b(81) + b(144) = b(144) - lu(287) * b(81) + b(146) = b(146) - lu(288) * b(81) + b(147) = b(147) - lu(289) * b(81) + b(150) = b(150) - lu(290) * b(81) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(83) = b(83) - lu(292) * b(82) + b(99) = b(99) - lu(293) * b(82) + b(119) = b(119) - lu(294) * b(82) + b(140) = b(140) - lu(295) * b(82) + b(144) = b(144) - lu(296) * b(82) + b(146) = b(146) - lu(297) * b(82) + b(150) = b(150) - lu(298) * b(82) + b(146) = b(146) - lu(300) * b(83) + b(148) = b(148) - lu(301) * b(83) + b(150) = b(150) - lu(302) * b(83) + b(144) = b(144) - lu(304) * b(84) + b(146) = b(146) - lu(305) * b(84) + b(150) = b(150) - lu(306) * b(84) + b(123) = b(123) - lu(308) * b(85) + b(126) = b(126) - lu(309) * b(85) + b(127) = b(127) - lu(310) * b(85) + b(129) = b(129) - lu(311) * b(85) + b(144) = b(144) - lu(312) * b(85) + b(146) = b(146) - lu(313) * b(85) + b(150) = b(150) - lu(314) * b(85) + b(100) = b(100) - lu(316) * b(86) + b(134) = b(134) - lu(317) * b(86) + b(137) = b(137) - lu(318) * b(86) + b(139) = b(139) - lu(319) * b(86) + b(142) = b(142) - lu(320) * b(86) + b(143) = b(143) - lu(321) * b(86) + b(147) = b(147) - lu(322) * b(86) + b(106) = b(106) - lu(324) * b(87) + b(120) = b(120) - lu(325) * b(87) + b(122) = b(122) - lu(326) * b(87) + b(144) = b(144) - lu(327) * b(87) + b(146) = b(146) - lu(328) * b(87) + b(148) = b(148) - lu(329) * b(87) + b(150) = b(150) - lu(330) * b(87) + b(116) = b(116) - lu(332) * b(88) + b(123) = b(123) - lu(333) * b(88) + b(129) = b(129) - lu(334) * b(88) + b(140) = b(140) - lu(335) * b(88) + b(142) = b(142) - lu(336) * b(88) + b(146) = b(146) - lu(337) * b(88) + b(147) = b(147) - lu(338) * b(88) + b(150) = b(150) - lu(339) * b(88) + b(135) = b(135) - lu(341) * b(89) + b(148) = b(148) - lu(342) * b(89) + b(150) = b(150) - lu(343) * b(89) + b(133) = b(133) - lu(345) * b(90) + b(139) = b(139) - lu(346) * b(90) + b(146) = b(146) - lu(347) * b(90) + b(148) = b(148) - lu(348) * b(90) + b(149) = b(149) - lu(349) * b(90) + b(150) = b(150) - lu(350) * b(90) + b(102) = b(102) - lu(352) * b(91) + b(103) = b(103) - lu(353) * b(91) + b(108) = b(108) - lu(354) * b(91) + b(119) = b(119) - lu(355) * b(91) + b(136) = b(136) - lu(356) * b(91) + b(139) = b(139) - lu(357) * b(91) + b(93) = b(93) - lu(360) * b(92) + b(95) = b(95) - lu(361) * b(92) + b(96) = b(96) - lu(362) * b(92) + b(109) = b(109) - lu(363) * b(92) + b(120) = b(120) - lu(364) * b(92) + b(131) = b(131) - lu(365) * b(92) + b(144) = b(144) - lu(366) * b(92) + b(146) = b(146) - lu(367) * b(92) + b(150) = b(150) - lu(368) * b(92) + b(120) = b(120) - lu(371) * b(93) + b(131) = b(131) - lu(372) * b(93) + b(138) = b(138) - lu(373) * b(93) + b(142) = b(142) - lu(374) * b(93) + b(146) = b(146) - lu(375) * b(93) + b(150) = b(150) - lu(376) * b(93) + b(102) = b(102) - lu(380) * b(94) + b(103) = b(103) - lu(381) * b(94) + b(104) = b(104) - lu(382) * b(94) + b(108) = b(108) - lu(383) * b(94) + b(119) = b(119) - lu(384) * b(94) + b(136) = b(136) - lu(385) * b(94) + b(138) = b(138) - lu(386) * b(94) + b(139) = b(139) - lu(387) * b(94) + b(141) = b(141) - lu(388) * b(94) + b(96) = b(96) - lu(394) * b(95) + b(109) = b(109) - lu(395) * b(95) + b(120) = b(120) - lu(396) * b(95) + b(125) = b(125) - lu(397) * b(95) + b(131) = b(131) - lu(398) * b(95) + b(138) = b(138) - lu(399) * b(95) + b(142) = b(142) - lu(400) * b(95) + b(144) = b(144) - lu(401) * b(95) + b(146) = b(146) - lu(402) * b(95) + b(150) = b(150) - lu(403) * b(95) + b(121) = b(121) - lu(405) * b(96) + b(131) = b(131) - lu(406) * b(96) + b(135) = b(135) - lu(407) * b(96) + b(148) = b(148) - lu(408) * b(96) + b(150) = b(150) - lu(409) * b(96) + b(132) = b(132) - lu(411) * b(97) + b(136) = b(136) - lu(412) * b(97) + b(139) = b(139) - lu(413) * b(97) + b(140) = b(140) - lu(414) * b(97) + b(145) = b(145) - lu(415) * b(97) + b(150) = b(150) - lu(416) * b(97) + b(119) = b(119) - lu(418) * b(98) + b(146) = b(146) - lu(419) * b(98) + b(150) = b(150) - lu(420) * b(98) + b(112) = b(112) - lu(424) * b(99) + b(136) = b(136) - lu(425) * b(99) + b(138) = b(138) - lu(426) * b(99) + b(142) = b(142) - lu(427) * b(99) + b(144) = b(144) - lu(428) * b(99) + b(146) = b(146) - lu(429) * b(99) + b(150) = b(150) - lu(430) * b(99) + b(133) = b(133) - lu(433) * b(100) + b(134) = b(134) - lu(434) * b(100) + b(139) = b(139) - lu(435) * b(100) + b(143) = b(143) - lu(436) * b(100) + b(148) = b(148) - lu(437) * b(100) + b(149) = b(149) - lu(438) * b(100) + b(150) = b(150) - lu(439) * b(100) + b(124) = b(124) - lu(442) * b(101) + b(135) = b(135) - lu(443) * b(101) + b(137) = b(137) - lu(444) * b(101) + b(145) = b(145) - lu(445) * b(101) + b(147) = b(147) - lu(446) * b(101) + b(148) = b(148) - lu(447) * b(101) + b(150) = b(150) - lu(448) * b(101) + b(103) = b(103) - lu(450) * b(102) + b(104) = b(104) - lu(451) * b(102) + b(108) = b(108) - lu(452) * b(102) + b(136) = b(136) - lu(453) * b(102) + b(138) = b(138) - lu(454) * b(102) + b(139) = b(139) - lu(455) * b(102) + b(141) = b(141) - lu(456) * b(102) + b(104) = b(104) - lu(459) * b(103) + b(108) = b(108) - lu(460) * b(103) + b(136) = b(136) - lu(461) * b(103) + b(138) = b(138) - lu(462) * b(103) + b(139) = b(139) - lu(463) * b(103) + b(141) = b(141) - lu(464) * b(103) + b(108) = b(108) - lu(470) * b(104) + b(119) = b(119) - lu(471) * b(104) + b(136) = b(136) - lu(472) * b(104) + b(138) = b(138) - lu(473) * b(104) + b(139) = b(139) - lu(474) * b(104) + b(141) = b(141) - lu(475) * b(104) + b(114) = b(114) - lu(477) * b(105) + b(123) = b(123) - lu(478) * b(105) + b(129) = b(129) - lu(479) * b(105) + b(138) = b(138) - lu(480) * b(105) + b(142) = b(142) - lu(481) * b(105) + b(144) = b(144) - lu(482) * b(105) + b(146) = b(146) - lu(483) * b(105) + b(147) = b(147) - lu(484) * b(105) + b(150) = b(150) - lu(485) * b(105) + b(120) = b(120) - lu(488) * b(106) + b(122) = b(122) - lu(489) * b(106) + b(136) = b(136) - lu(490) * b(106) + b(138) = b(138) - lu(491) * b(106) + b(142) = b(142) - lu(492) * b(106) + b(144) = b(144) - lu(493) * b(106) + b(146) = b(146) - lu(494) * b(106) + b(148) = b(148) - lu(495) * b(106) + b(150) = b(150) - lu(496) * b(106) + b(134) = b(134) - lu(498) * b(107) + b(139) = b(139) - lu(499) * b(107) + b(141) = b(141) - lu(500) * b(107) + b(145) = b(145) - lu(501) * b(107) + b(148) = b(148) - lu(502) * b(107) + b(150) = b(150) - lu(503) * b(107) + b(119) = b(119) - lu(510) * b(108) + b(136) = b(136) - lu(511) * b(108) + b(138) = b(138) - lu(512) * b(108) + b(139) = b(139) - lu(513) * b(108) + b(141) = b(141) - lu(514) * b(108) + b(142) = b(142) - lu(515) * b(108) + b(145) = b(145) - lu(516) * b(108) + b(150) = b(150) - lu(517) * b(108) + b(120) = b(120) - lu(522) * b(109) + b(135) = b(135) - lu(523) * b(109) + b(136) = b(136) - lu(524) * b(109) + b(138) = b(138) - lu(525) * b(109) + b(142) = b(142) - lu(526) * b(109) + b(144) = b(144) - lu(527) * b(109) + b(146) = b(146) - lu(528) * b(109) + b(150) = b(150) - lu(529) * b(109) + b(133) = b(133) - lu(532) * b(110) + b(139) = b(139) - lu(533) * b(110) + b(148) = b(148) - lu(534) * b(110) + b(149) = b(149) - lu(535) * b(110) + b(150) = b(150) - lu(536) * b(110) + b(151) = b(151) - lu(537) * b(110) + b(120) = b(120) - lu(541) * b(111) + b(121) = b(121) - lu(542) * b(111) + b(131) = b(131) - lu(543) * b(111) + b(135) = b(135) - lu(544) * b(111) + b(136) = b(136) - lu(545) * b(111) + b(138) = b(138) - lu(546) * b(111) + b(142) = b(142) - lu(547) * b(111) + b(144) = b(144) - lu(548) * b(111) + b(146) = b(146) - lu(549) * b(111) + b(148) = b(148) - lu(550) * b(111) + b(150) = b(150) - lu(551) * b(111) + end subroutine lu_slv02 + subroutine lu_slv03( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(119) = b(119) - lu(554) * b(112) + b(144) = b(144) - lu(555) * b(112) + b(146) = b(146) - lu(556) * b(112) + b(150) = b(150) - lu(557) * b(112) + b(114) = b(114) - lu(561) * b(113) + b(118) = b(118) - lu(562) * b(113) + b(119) = b(119) - lu(563) * b(113) + b(123) = b(123) - lu(564) * b(113) + b(127) = b(127) - lu(565) * b(113) + b(129) = b(129) - lu(566) * b(113) + b(130) = b(130) - lu(567) * b(113) + b(135) = b(135) - lu(568) * b(113) + b(138) = b(138) - lu(569) * b(113) + b(140) = b(140) - lu(570) * b(113) + b(142) = b(142) - lu(571) * b(113) + b(144) = b(144) - lu(572) * b(113) + b(146) = b(146) - lu(573) * b(113) + b(147) = b(147) - lu(574) * b(113) + b(148) = b(148) - lu(575) * b(113) + b(150) = b(150) - lu(576) * b(113) + b(119) = b(119) - lu(579) * b(114) + b(126) = b(126) - lu(580) * b(114) + b(142) = b(142) - lu(581) * b(114) + b(144) = b(144) - lu(582) * b(114) + b(146) = b(146) - lu(583) * b(114) + b(147) = b(147) - lu(584) * b(114) + b(150) = b(150) - lu(585) * b(114) + b(132) = b(132) - lu(588) * b(115) + b(139) = b(139) - lu(589) * b(115) + b(146) = b(146) - lu(590) * b(115) + b(148) = b(148) - lu(591) * b(115) + b(150) = b(150) - lu(592) * b(115) + b(121) = b(121) - lu(596) * b(116) + b(123) = b(123) - lu(597) * b(116) + b(129) = b(129) - lu(598) * b(116) + b(131) = b(131) - lu(599) * b(116) + b(135) = b(135) - lu(600) * b(116) + b(138) = b(138) - lu(601) * b(116) + b(142) = b(142) - lu(602) * b(116) + b(146) = b(146) - lu(603) * b(116) + b(148) = b(148) - lu(604) * b(116) + b(150) = b(150) - lu(605) * b(116) + b(133) = b(133) - lu(609) * b(117) + b(137) = b(137) - lu(610) * b(117) + b(139) = b(139) - lu(611) * b(117) + b(142) = b(142) - lu(612) * b(117) + b(147) = b(147) - lu(613) * b(117) + b(148) = b(148) - lu(614) * b(117) + b(149) = b(149) - lu(615) * b(117) + b(150) = b(150) - lu(616) * b(117) + b(151) = b(151) - lu(617) * b(117) + b(119) = b(119) - lu(622) * b(118) + b(120) = b(120) - lu(623) * b(118) + b(122) = b(122) - lu(624) * b(118) + b(125) = b(125) - lu(625) * b(118) + b(135) = b(135) - lu(626) * b(118) + b(136) = b(136) - lu(627) * b(118) + b(138) = b(138) - lu(628) * b(118) + b(140) = b(140) - lu(629) * b(118) + b(142) = b(142) - lu(630) * b(118) + b(144) = b(144) - lu(631) * b(118) + b(146) = b(146) - lu(632) * b(118) + b(147) = b(147) - lu(633) * b(118) + b(148) = b(148) - lu(634) * b(118) + b(150) = b(150) - lu(635) * b(118) + b(145) = b(145) - lu(637) * b(119) + b(146) = b(146) - lu(638) * b(119) + b(150) = b(150) - lu(639) * b(119) + b(131) = b(131) - lu(642) * b(120) + b(135) = b(135) - lu(643) * b(120) + b(137) = b(137) - lu(644) * b(120) + b(145) = b(145) - lu(645) * b(120) + b(146) = b(146) - lu(646) * b(120) + b(147) = b(147) - lu(647) * b(120) + b(148) = b(148) - lu(648) * b(120) + b(150) = b(150) - lu(649) * b(120) + b(122) = b(122) - lu(653) * b(121) + b(125) = b(125) - lu(654) * b(121) + b(131) = b(131) - lu(655) * b(121) + b(135) = b(135) - lu(656) * b(121) + b(136) = b(136) - lu(657) * b(121) + b(138) = b(138) - lu(658) * b(121) + b(142) = b(142) - lu(659) * b(121) + b(144) = b(144) - lu(660) * b(121) + b(146) = b(146) - lu(661) * b(121) + b(148) = b(148) - lu(662) * b(121) + b(150) = b(150) - lu(663) * b(121) + b(125) = b(125) - lu(665) * b(122) + b(131) = b(131) - lu(666) * b(122) + b(144) = b(144) - lu(667) * b(122) + b(146) = b(146) - lu(668) * b(122) + b(150) = b(150) - lu(669) * b(122) + b(125) = b(125) - lu(672) * b(123) + b(128) = b(128) - lu(673) * b(123) + b(130) = b(130) - lu(674) * b(123) + b(131) = b(131) - lu(675) * b(123) + b(140) = b(140) - lu(676) * b(123) + b(144) = b(144) - lu(677) * b(123) + b(145) = b(145) - lu(678) * b(123) + b(146) = b(146) - lu(679) * b(123) + b(148) = b(148) - lu(680) * b(123) + b(150) = b(150) - lu(681) * b(123) + b(133) = b(133) - lu(685) * b(124) + b(135) = b(135) - lu(686) * b(124) + b(137) = b(137) - lu(687) * b(124) + b(139) = b(139) - lu(688) * b(124) + b(141) = b(141) - lu(689) * b(124) + b(145) = b(145) - lu(690) * b(124) + b(147) = b(147) - lu(691) * b(124) + b(148) = b(148) - lu(692) * b(124) + b(149) = b(149) - lu(693) * b(124) + b(150) = b(150) - lu(694) * b(124) + b(131) = b(131) - lu(697) * b(125) + b(137) = b(137) - lu(698) * b(125) + b(145) = b(145) - lu(699) * b(125) + b(146) = b(146) - lu(700) * b(125) + b(147) = b(147) - lu(701) * b(125) + b(148) = b(148) - lu(702) * b(125) + b(150) = b(150) - lu(703) * b(125) + b(131) = b(131) - lu(712) * b(126) + b(135) = b(135) - lu(713) * b(126) + b(137) = b(137) - lu(714) * b(126) + b(138) = b(138) - lu(715) * b(126) + b(142) = b(142) - lu(716) * b(126) + b(144) = b(144) - lu(717) * b(126) + b(145) = b(145) - lu(718) * b(126) + b(146) = b(146) - lu(719) * b(126) + b(147) = b(147) - lu(720) * b(126) + b(148) = b(148) - lu(721) * b(126) + b(150) = b(150) - lu(722) * b(126) + b(128) = b(128) - lu(735) * b(127) + b(129) = b(129) - lu(736) * b(127) + b(130) = b(130) - lu(737) * b(127) + b(131) = b(131) - lu(738) * b(127) + b(135) = b(135) - lu(739) * b(127) + b(137) = b(137) - lu(740) * b(127) + b(138) = b(138) - lu(741) * b(127) + b(140) = b(140) - lu(742) * b(127) + b(142) = b(142) - lu(743) * b(127) + b(144) = b(144) - lu(744) * b(127) + b(145) = b(145) - lu(745) * b(127) + b(146) = b(146) - lu(746) * b(127) + b(147) = b(147) - lu(747) * b(127) + b(148) = b(148) - lu(748) * b(127) + b(150) = b(150) - lu(749) * b(127) + b(130) = b(130) - lu(759) * b(128) + b(131) = b(131) - lu(760) * b(128) + b(135) = b(135) - lu(761) * b(128) + b(137) = b(137) - lu(762) * b(128) + b(138) = b(138) - lu(763) * b(128) + b(142) = b(142) - lu(764) * b(128) + b(144) = b(144) - lu(765) * b(128) + b(145) = b(145) - lu(766) * b(128) + b(146) = b(146) - lu(767) * b(128) + b(147) = b(147) - lu(768) * b(128) + b(148) = b(148) - lu(769) * b(128) + b(150) = b(150) - lu(770) * b(128) + b(130) = b(130) - lu(778) * b(129) + b(131) = b(131) - lu(779) * b(129) + b(135) = b(135) - lu(780) * b(129) + b(136) = b(136) - lu(781) * b(129) + b(137) = b(137) - lu(782) * b(129) + b(138) = b(138) - lu(783) * b(129) + b(140) = b(140) - lu(784) * b(129) + b(142) = b(142) - lu(785) * b(129) + b(144) = b(144) - lu(786) * b(129) + b(145) = b(145) - lu(787) * b(129) + b(146) = b(146) - lu(788) * b(129) + b(147) = b(147) - lu(789) * b(129) + b(148) = b(148) - lu(790) * b(129) + b(150) = b(150) - lu(791) * b(129) + b(131) = b(131) - lu(798) * b(130) + b(135) = b(135) - lu(799) * b(130) + b(136) = b(136) - lu(800) * b(130) + b(137) = b(137) - lu(801) * b(130) + b(138) = b(138) - lu(802) * b(130) + b(140) = b(140) - lu(803) * b(130) + b(142) = b(142) - lu(804) * b(130) + b(144) = b(144) - lu(805) * b(130) + b(145) = b(145) - lu(806) * b(130) + b(146) = b(146) - lu(807) * b(130) + b(147) = b(147) - lu(808) * b(130) + b(148) = b(148) - lu(809) * b(130) + b(150) = b(150) - lu(810) * b(130) + b(135) = b(135) - lu(827) * b(131) + b(136) = b(136) - lu(828) * b(131) + b(137) = b(137) - lu(829) * b(131) + b(138) = b(138) - lu(830) * b(131) + b(140) = b(140) - lu(831) * b(131) + b(142) = b(142) - lu(832) * b(131) + b(144) = b(144) - lu(833) * b(131) + b(145) = b(145) - lu(834) * b(131) + b(146) = b(146) - lu(835) * b(131) + b(147) = b(147) - lu(836) * b(131) + b(148) = b(148) - lu(837) * b(131) + b(150) = b(150) - lu(838) * b(131) + b(134) = b(134) - lu(843) * b(132) + b(136) = b(136) - lu(844) * b(132) + b(138) = b(138) - lu(845) * b(132) + b(139) = b(139) - lu(846) * b(132) + b(140) = b(140) - lu(847) * b(132) + b(142) = b(142) - lu(848) * b(132) + b(143) = b(143) - lu(849) * b(132) + b(145) = b(145) - lu(850) * b(132) + b(146) = b(146) - lu(851) * b(132) + b(148) = b(148) - lu(852) * b(132) + b(149) = b(149) - lu(853) * b(132) + b(150) = b(150) - lu(854) * b(132) + b(151) = b(151) - lu(855) * b(132) + end subroutine lu_slv03 + subroutine lu_slv04( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(134) = b(134) - lu(862) * b(133) + b(137) = b(137) - lu(863) * b(133) + b(139) = b(139) - lu(864) * b(133) + b(141) = b(141) - lu(865) * b(133) + b(142) = b(142) - lu(866) * b(133) + b(143) = b(143) - lu(867) * b(133) + b(145) = b(145) - lu(868) * b(133) + b(147) = b(147) - lu(869) * b(133) + b(148) = b(148) - lu(870) * b(133) + b(149) = b(149) - lu(871) * b(133) + b(150) = b(150) - lu(872) * b(133) + b(151) = b(151) - lu(873) * b(133) + b(136) = b(136) - lu(877) * b(134) + b(139) = b(139) - lu(878) * b(134) + b(140) = b(140) - lu(879) * b(134) + b(141) = b(141) - lu(880) * b(134) + b(143) = b(143) - lu(881) * b(134) + b(144) = b(144) - lu(882) * b(134) + b(145) = b(145) - lu(883) * b(134) + b(146) = b(146) - lu(884) * b(134) + b(148) = b(148) - lu(885) * b(134) + b(150) = b(150) - lu(886) * b(134) + b(136) = b(136) - lu(910) * b(135) + b(137) = b(137) - lu(911) * b(135) + b(138) = b(138) - lu(912) * b(135) + b(140) = b(140) - lu(913) * b(135) + b(142) = b(142) - lu(914) * b(135) + b(144) = b(144) - lu(915) * b(135) + b(145) = b(145) - lu(916) * b(135) + b(146) = b(146) - lu(917) * b(135) + b(147) = b(147) - lu(918) * b(135) + b(148) = b(148) - lu(919) * b(135) + b(149) = b(149) - lu(920) * b(135) + b(150) = b(150) - lu(921) * b(135) + b(151) = b(151) - lu(922) * b(135) + b(138) = b(138) - lu(941) * b(136) + b(139) = b(139) - lu(942) * b(136) + b(140) = b(140) - lu(943) * b(136) + b(141) = b(141) - lu(944) * b(136) + b(142) = b(142) - lu(945) * b(136) + b(143) = b(143) - lu(946) * b(136) + b(144) = b(144) - lu(947) * b(136) + b(145) = b(145) - lu(948) * b(136) + b(146) = b(146) - lu(949) * b(136) + b(148) = b(148) - lu(950) * b(136) + b(149) = b(149) - lu(951) * b(136) + b(150) = b(150) - lu(952) * b(136) + b(151) = b(151) - lu(953) * b(136) + b(138) = b(138) - lu(962) * b(137) + b(139) = b(139) - lu(963) * b(137) + b(140) = b(140) - lu(964) * b(137) + b(141) = b(141) - lu(965) * b(137) + b(142) = b(142) - lu(966) * b(137) + b(143) = b(143) - lu(967) * b(137) + b(144) = b(144) - lu(968) * b(137) + b(145) = b(145) - lu(969) * b(137) + b(146) = b(146) - lu(970) * b(137) + b(147) = b(147) - lu(971) * b(137) + b(148) = b(148) - lu(972) * b(137) + b(149) = b(149) - lu(973) * b(137) + b(150) = b(150) - lu(974) * b(137) + b(151) = b(151) - lu(975) * b(137) + b(139) = b(139) - lu(1020) * b(138) + b(140) = b(140) - lu(1021) * b(138) + b(141) = b(141) - lu(1022) * b(138) + b(142) = b(142) - lu(1023) * b(138) + b(143) = b(143) - lu(1024) * b(138) + b(144) = b(144) - lu(1025) * b(138) + b(145) = b(145) - lu(1026) * b(138) + b(146) = b(146) - lu(1027) * b(138) + b(147) = b(147) - lu(1028) * b(138) + b(148) = b(148) - lu(1029) * b(138) + b(149) = b(149) - lu(1030) * b(138) + b(150) = b(150) - lu(1031) * b(138) + b(151) = b(151) - lu(1032) * b(138) + b(140) = b(140) - lu(1062) * b(139) + b(141) = b(141) - lu(1063) * b(139) + b(142) = b(142) - lu(1064) * b(139) + b(143) = b(143) - lu(1065) * b(139) + b(144) = b(144) - lu(1066) * b(139) + b(145) = b(145) - lu(1067) * b(139) + b(146) = b(146) - lu(1068) * b(139) + b(147) = b(147) - lu(1069) * b(139) + b(148) = b(148) - lu(1070) * b(139) + b(149) = b(149) - lu(1071) * b(139) + b(150) = b(150) - lu(1072) * b(139) + b(151) = b(151) - lu(1073) * b(139) + b(141) = b(141) - lu(1108) * b(140) + b(142) = b(142) - lu(1109) * b(140) + b(143) = b(143) - lu(1110) * b(140) + b(144) = b(144) - lu(1111) * b(140) + b(145) = b(145) - lu(1112) * b(140) + b(146) = b(146) - lu(1113) * b(140) + b(147) = b(147) - lu(1114) * b(140) + b(148) = b(148) - lu(1115) * b(140) + b(149) = b(149) - lu(1116) * b(140) + b(150) = b(150) - lu(1117) * b(140) + b(151) = b(151) - lu(1118) * b(140) + b(142) = b(142) - lu(1135) * b(141) + b(143) = b(143) - lu(1136) * b(141) + b(144) = b(144) - lu(1137) * b(141) + b(145) = b(145) - lu(1138) * b(141) + b(146) = b(146) - lu(1139) * b(141) + b(147) = b(147) - lu(1140) * b(141) + b(148) = b(148) - lu(1141) * b(141) + b(149) = b(149) - lu(1142) * b(141) + b(150) = b(150) - lu(1143) * b(141) + b(151) = b(151) - lu(1144) * b(141) + b(143) = b(143) - lu(1173) * b(142) + b(144) = b(144) - lu(1174) * b(142) + b(145) = b(145) - lu(1175) * b(142) + b(146) = b(146) - lu(1176) * b(142) + b(147) = b(147) - lu(1177) * b(142) + b(148) = b(148) - lu(1178) * b(142) + b(149) = b(149) - lu(1179) * b(142) + b(150) = b(150) - lu(1180) * b(142) + b(151) = b(151) - lu(1181) * b(142) + b(144) = b(144) - lu(1198) * b(143) + b(145) = b(145) - lu(1199) * b(143) + b(146) = b(146) - lu(1200) * b(143) + b(147) = b(147) - lu(1201) * b(143) + b(148) = b(148) - lu(1202) * b(143) + b(149) = b(149) - lu(1203) * b(143) + b(150) = b(150) - lu(1204) * b(143) + b(151) = b(151) - lu(1205) * b(143) + b(145) = b(145) - lu(1223) * b(144) + b(146) = b(146) - lu(1224) * b(144) + b(147) = b(147) - lu(1225) * b(144) + b(148) = b(148) - lu(1226) * b(144) + b(149) = b(149) - lu(1227) * b(144) + b(150) = b(150) - lu(1228) * b(144) + b(151) = b(151) - lu(1229) * b(144) + b(146) = b(146) - lu(1244) * b(145) + b(147) = b(147) - lu(1245) * b(145) + b(148) = b(148) - lu(1246) * b(145) + b(149) = b(149) - lu(1247) * b(145) + b(150) = b(150) - lu(1248) * b(145) + b(151) = b(151) - lu(1249) * b(145) + b(147) = b(147) - lu(1318) * b(146) + b(148) = b(148) - lu(1319) * b(146) + b(149) = b(149) - lu(1320) * b(146) + b(150) = b(150) - lu(1321) * b(146) + b(151) = b(151) - lu(1322) * b(146) + b(148) = b(148) - lu(1363) * b(147) + b(149) = b(149) - lu(1364) * b(147) + b(150) = b(150) - lu(1365) * b(147) + b(151) = b(151) - lu(1366) * b(147) + b(149) = b(149) - lu(1390) * b(148) + b(150) = b(150) - lu(1391) * b(148) + b(151) = b(151) - lu(1392) * b(148) + b(150) = b(150) - lu(1426) * b(149) + b(151) = b(151) - lu(1427) * b(149) + b(151) = b(151) - lu(1528) * b(150) + end subroutine lu_slv04 + subroutine lu_slv05( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(151) = b(151) * lu(1555) + b(150) = b(150) - lu(1554) * b(151) + b(149) = b(149) - lu(1553) * b(151) + b(148) = b(148) - lu(1552) * b(151) + b(147) = b(147) - lu(1551) * b(151) + b(146) = b(146) - lu(1550) * b(151) + b(145) = b(145) - lu(1549) * b(151) + b(144) = b(144) - lu(1548) * b(151) + b(143) = b(143) - lu(1547) * b(151) + b(142) = b(142) - lu(1546) * b(151) + b(141) = b(141) - lu(1545) * b(151) + b(140) = b(140) - lu(1544) * b(151) + b(139) = b(139) - lu(1543) * b(151) + b(138) = b(138) - lu(1542) * b(151) + b(137) = b(137) - lu(1541) * b(151) + b(136) = b(136) - lu(1540) * b(151) + b(135) = b(135) - lu(1539) * b(151) + b(134) = b(134) - lu(1538) * b(151) + b(133) = b(133) - lu(1537) * b(151) + b(132) = b(132) - lu(1536) * b(151) + b(117) = b(117) - lu(1535) * b(151) + b(115) = b(115) - lu(1534) * b(151) + b(110) = b(110) - lu(1533) * b(151) + b(56) = b(56) - lu(1532) * b(151) + b(48) = b(48) - lu(1531) * b(151) + b(43) = b(43) - lu(1530) * b(151) + b(29) = b(29) - lu(1529) * b(151) + b(150) = b(150) * lu(1527) + b(149) = b(149) - lu(1526) * b(150) + b(148) = b(148) - lu(1525) * b(150) + b(147) = b(147) - lu(1524) * b(150) + b(146) = b(146) - lu(1523) * b(150) + b(145) = b(145) - lu(1522) * b(150) + b(144) = b(144) - lu(1521) * b(150) + b(143) = b(143) - lu(1520) * b(150) + b(142) = b(142) - lu(1519) * b(150) + b(141) = b(141) - lu(1518) * b(150) + b(140) = b(140) - lu(1517) * b(150) + b(139) = b(139) - lu(1516) * b(150) + b(138) = b(138) - lu(1515) * b(150) + b(137) = b(137) - lu(1514) * b(150) + b(136) = b(136) - lu(1513) * b(150) + b(135) = b(135) - lu(1512) * b(150) + b(134) = b(134) - lu(1511) * b(150) + b(133) = b(133) - lu(1510) * b(150) + b(132) = b(132) - lu(1509) * b(150) + b(131) = b(131) - lu(1508) * b(150) + b(130) = b(130) - lu(1507) * b(150) + b(129) = b(129) - lu(1506) * b(150) + b(128) = b(128) - lu(1505) * b(150) + b(127) = b(127) - lu(1504) * b(150) + b(126) = b(126) - lu(1503) * b(150) + b(125) = b(125) - lu(1502) * b(150) + b(124) = b(124) - lu(1501) * b(150) + b(123) = b(123) - lu(1500) * b(150) + b(122) = b(122) - lu(1499) * b(150) + b(121) = b(121) - lu(1498) * b(150) + b(120) = b(120) - lu(1497) * b(150) + b(119) = b(119) - lu(1496) * b(150) + b(118) = b(118) - lu(1495) * b(150) + b(117) = b(117) - lu(1494) * b(150) + b(116) = b(116) - lu(1493) * b(150) + b(115) = b(115) - lu(1492) * b(150) + b(114) = b(114) - lu(1491) * b(150) + b(113) = b(113) - lu(1490) * b(150) + b(112) = b(112) - lu(1489) * b(150) + b(111) = b(111) - lu(1488) * b(150) + b(110) = b(110) - lu(1487) * b(150) + b(109) = b(109) - lu(1486) * b(150) + b(108) = b(108) - lu(1485) * b(150) + b(107) = b(107) - lu(1484) * b(150) + b(106) = b(106) - lu(1483) * b(150) + b(101) = b(101) - lu(1482) * b(150) + b(99) = b(99) - lu(1481) * b(150) + b(98) = b(98) - lu(1480) * b(150) + b(97) = b(97) - lu(1479) * b(150) + b(96) = b(96) - lu(1478) * b(150) + b(95) = b(95) - lu(1477) * b(150) + b(93) = b(93) - lu(1476) * b(150) + b(92) = b(92) - lu(1475) * b(150) + b(90) = b(90) - lu(1474) * b(150) + b(89) = b(89) - lu(1473) * b(150) + b(88) = b(88) - lu(1472) * b(150) + b(87) = b(87) - lu(1471) * b(150) + b(85) = b(85) - lu(1470) * b(150) + b(84) = b(84) - lu(1469) * b(150) + b(83) = b(83) - lu(1468) * b(150) + b(82) = b(82) - lu(1467) * b(150) + b(81) = b(81) - lu(1466) * b(150) + b(80) = b(80) - lu(1465) * b(150) + b(79) = b(79) - lu(1464) * b(150) + b(78) = b(78) - lu(1463) * b(150) + b(75) = b(75) - lu(1462) * b(150) + b(74) = b(74) - lu(1461) * b(150) + b(73) = b(73) - lu(1460) * b(150) + b(72) = b(72) - lu(1459) * b(150) + b(70) = b(70) - lu(1458) * b(150) + b(69) = b(69) - lu(1457) * b(150) + b(67) = b(67) - lu(1456) * b(150) + b(66) = b(66) - lu(1455) * b(150) + b(65) = b(65) - lu(1454) * b(150) + b(64) = b(64) - lu(1453) * b(150) + b(63) = b(63) - lu(1452) * b(150) + b(62) = b(62) - lu(1451) * b(150) + b(61) = b(61) - lu(1450) * b(150) + b(60) = b(60) - lu(1449) * b(150) + b(59) = b(59) - lu(1448) * b(150) + b(58) = b(58) - lu(1447) * b(150) + b(57) = b(57) - lu(1446) * b(150) + b(54) = b(54) - lu(1445) * b(150) + b(53) = b(53) - lu(1444) * b(150) + b(52) = b(52) - lu(1443) * b(150) + b(51) = b(51) - lu(1442) * b(150) + b(50) = b(50) - lu(1441) * b(150) + b(49) = b(49) - lu(1440) * b(150) + b(46) = b(46) - lu(1439) * b(150) + b(45) = b(45) - lu(1438) * b(150) + b(44) = b(44) - lu(1437) * b(150) + b(39) = b(39) - lu(1436) * b(150) + b(37) = b(37) - lu(1435) * b(150) + b(36) = b(36) - lu(1434) * b(150) + b(35) = b(35) - lu(1433) * b(150) + b(34) = b(34) - lu(1432) * b(150) + b(33) = b(33) - lu(1431) * b(150) + b(32) = b(32) - lu(1430) * b(150) + b(31) = b(31) - lu(1429) * b(150) + b(30) = b(30) - lu(1428) * b(150) + b(149) = b(149) * lu(1425) + b(148) = b(148) - lu(1424) * b(149) + b(147) = b(147) - lu(1423) * b(149) + b(146) = b(146) - lu(1422) * b(149) + b(145) = b(145) - lu(1421) * b(149) + b(144) = b(144) - lu(1420) * b(149) + b(143) = b(143) - lu(1419) * b(149) + b(142) = b(142) - lu(1418) * b(149) + b(141) = b(141) - lu(1417) * b(149) + b(140) = b(140) - lu(1416) * b(149) + b(139) = b(139) - lu(1415) * b(149) + b(138) = b(138) - lu(1414) * b(149) + b(137) = b(137) - lu(1413) * b(149) + b(136) = b(136) - lu(1412) * b(149) + b(135) = b(135) - lu(1411) * b(149) + b(134) = b(134) - lu(1410) * b(149) + b(133) = b(133) - lu(1409) * b(149) + b(131) = b(131) - lu(1408) * b(149) + b(124) = b(124) - lu(1407) * b(149) + b(120) = b(120) - lu(1406) * b(149) + b(119) = b(119) - lu(1405) * b(149) + b(117) = b(117) - lu(1404) * b(149) + b(112) = b(112) - lu(1403) * b(149) + b(110) = b(110) - lu(1402) * b(149) + b(109) = b(109) - lu(1401) * b(149) + b(99) = b(99) - lu(1400) * b(149) + b(98) = b(98) - lu(1399) * b(149) + b(90) = b(90) - lu(1398) * b(149) + b(83) = b(83) - lu(1397) * b(149) + b(82) = b(82) - lu(1396) * b(149) + b(53) = b(53) - lu(1395) * b(149) + b(52) = b(52) - lu(1394) * b(149) + b(43) = b(43) - lu(1393) * b(149) + b(148) = b(148) * lu(1389) + b(147) = b(147) - lu(1388) * b(148) + b(146) = b(146) - lu(1387) * b(148) + b(145) = b(145) - lu(1386) * b(148) + b(144) = b(144) - lu(1385) * b(148) + b(143) = b(143) - lu(1384) * b(148) + b(142) = b(142) - lu(1383) * b(148) + b(141) = b(141) - lu(1382) * b(148) + b(140) = b(140) - lu(1381) * b(148) + b(139) = b(139) - lu(1380) * b(148) + b(138) = b(138) - lu(1379) * b(148) + b(137) = b(137) - lu(1378) * b(148) + b(136) = b(136) - lu(1377) * b(148) + b(135) = b(135) - lu(1376) * b(148) + b(134) = b(134) - lu(1375) * b(148) + b(133) = b(133) - lu(1374) * b(148) + b(132) = b(132) - lu(1373) * b(148) + b(124) = b(124) - lu(1372) * b(148) + b(115) = b(115) - lu(1371) * b(148) + b(101) = b(101) - lu(1370) * b(148) + b(51) = b(51) - lu(1369) * b(148) + b(47) = b(47) - lu(1368) * b(148) + b(42) = b(42) - lu(1367) * b(148) + b(147) = b(147) * lu(1362) + b(146) = b(146) - lu(1361) * b(147) + b(145) = b(145) - lu(1360) * b(147) + b(144) = b(144) - lu(1359) * b(147) + b(143) = b(143) - lu(1358) * b(147) + b(142) = b(142) - lu(1357) * b(147) + b(141) = b(141) - lu(1356) * b(147) + b(140) = b(140) - lu(1355) * b(147) + b(139) = b(139) - lu(1354) * b(147) + b(138) = b(138) - lu(1353) * b(147) + b(137) = b(137) - lu(1352) * b(147) + b(136) = b(136) - lu(1351) * b(147) + b(135) = b(135) - lu(1350) * b(147) + b(134) = b(134) - lu(1349) * b(147) + b(132) = b(132) - lu(1348) * b(147) + b(131) = b(131) - lu(1347) * b(147) + b(130) = b(130) - lu(1346) * b(147) + b(129) = b(129) - lu(1345) * b(147) + b(128) = b(128) - lu(1344) * b(147) + b(127) = b(127) - lu(1343) * b(147) + b(126) = b(126) - lu(1342) * b(147) + b(125) = b(125) - lu(1341) * b(147) + b(123) = b(123) - lu(1340) * b(147) + b(122) = b(122) - lu(1339) * b(147) + b(121) = b(121) - lu(1338) * b(147) + b(120) = b(120) - lu(1337) * b(147) + b(119) = b(119) - lu(1336) * b(147) + b(118) = b(118) - lu(1335) * b(147) + b(116) = b(116) - lu(1334) * b(147) + b(115) = b(115) - lu(1333) * b(147) + b(114) = b(114) - lu(1332) * b(147) + b(113) = b(113) - lu(1331) * b(147) + b(112) = b(112) - lu(1330) * b(147) + b(105) = b(105) - lu(1329) * b(147) + b(98) = b(98) - lu(1328) * b(147) + b(88) = b(88) - lu(1327) * b(147) + b(65) = b(65) - lu(1326) * b(147) + b(61) = b(61) - lu(1325) * b(147) + b(55) = b(55) - lu(1324) * b(147) + b(54) = b(54) - lu(1323) * b(147) + end subroutine lu_slv05 + subroutine lu_slv06( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(146) = b(146) * lu(1317) + b(145) = b(145) - lu(1316) * b(146) + b(144) = b(144) - lu(1315) * b(146) + b(143) = b(143) - lu(1314) * b(146) + b(142) = b(142) - lu(1313) * b(146) + b(141) = b(141) - lu(1312) * b(146) + b(140) = b(140) - lu(1311) * b(146) + b(139) = b(139) - lu(1310) * b(146) + b(138) = b(138) - lu(1309) * b(146) + b(137) = b(137) - lu(1308) * b(146) + b(136) = b(136) - lu(1307) * b(146) + b(135) = b(135) - lu(1306) * b(146) + b(134) = b(134) - lu(1305) * b(146) + b(133) = b(133) - lu(1304) * b(146) + b(131) = b(131) - lu(1303) * b(146) + b(130) = b(130) - lu(1302) * b(146) + b(129) = b(129) - lu(1301) * b(146) + b(128) = b(128) - lu(1300) * b(146) + b(127) = b(127) - lu(1299) * b(146) + b(126) = b(126) - lu(1298) * b(146) + b(125) = b(125) - lu(1297) * b(146) + b(124) = b(124) - lu(1296) * b(146) + b(123) = b(123) - lu(1295) * b(146) + b(122) = b(122) - lu(1294) * b(146) + b(121) = b(121) - lu(1293) * b(146) + b(120) = b(120) - lu(1292) * b(146) + b(119) = b(119) - lu(1291) * b(146) + b(116) = b(116) - lu(1290) * b(146) + b(114) = b(114) - lu(1289) * b(146) + b(112) = b(112) - lu(1288) * b(146) + b(111) = b(111) - lu(1287) * b(146) + b(110) = b(110) - lu(1286) * b(146) + b(109) = b(109) - lu(1285) * b(146) + b(107) = b(107) - lu(1284) * b(146) + b(106) = b(106) - lu(1283) * b(146) + b(105) = b(105) - lu(1282) * b(146) + b(100) = b(100) - lu(1281) * b(146) + b(99) = b(99) - lu(1280) * b(146) + b(98) = b(98) - lu(1279) * b(146) + b(96) = b(96) - lu(1278) * b(146) + b(95) = b(95) - lu(1277) * b(146) + b(93) = b(93) - lu(1276) * b(146) + b(92) = b(92) - lu(1275) * b(146) + b(90) = b(90) - lu(1274) * b(146) + b(89) = b(89) - lu(1273) * b(146) + b(87) = b(87) - lu(1272) * b(146) + b(85) = b(85) - lu(1271) * b(146) + b(83) = b(83) - lu(1270) * b(146) + b(80) = b(80) - lu(1269) * b(146) + b(79) = b(79) - lu(1268) * b(146) + b(78) = b(78) - lu(1267) * b(146) + b(74) = b(74) - lu(1266) * b(146) + b(73) = b(73) - lu(1265) * b(146) + b(72) = b(72) - lu(1264) * b(146) + b(71) = b(71) - lu(1263) * b(146) + b(69) = b(69) - lu(1262) * b(146) + b(68) = b(68) - lu(1261) * b(146) + b(67) = b(67) - lu(1260) * b(146) + b(66) = b(66) - lu(1259) * b(146) + b(64) = b(64) - lu(1258) * b(146) + b(63) = b(63) - lu(1257) * b(146) + b(60) = b(60) - lu(1256) * b(146) + b(59) = b(59) - lu(1255) * b(146) + b(58) = b(58) - lu(1254) * b(146) + b(50) = b(50) - lu(1253) * b(146) + b(38) = b(38) - lu(1252) * b(146) + b(2) = b(2) - lu(1251) * b(146) + b(1) = b(1) - lu(1250) * b(146) + b(145) = b(145) * lu(1243) + b(144) = b(144) - lu(1242) * b(145) + b(143) = b(143) - lu(1241) * b(145) + b(142) = b(142) - lu(1240) * b(145) + b(141) = b(141) - lu(1239) * b(145) + b(140) = b(140) - lu(1238) * b(145) + b(139) = b(139) - lu(1237) * b(145) + b(138) = b(138) - lu(1236) * b(145) + b(137) = b(137) - lu(1235) * b(145) + b(136) = b(136) - lu(1234) * b(145) + b(135) = b(135) - lu(1233) * b(145) + b(134) = b(134) - lu(1232) * b(145) + b(133) = b(133) - lu(1231) * b(145) + b(124) = b(124) - lu(1230) * b(145) + b(144) = b(144) * lu(1222) + b(143) = b(143) - lu(1221) * b(144) + b(142) = b(142) - lu(1220) * b(144) + b(141) = b(141) - lu(1219) * b(144) + b(140) = b(140) - lu(1218) * b(144) + b(139) = b(139) - lu(1217) * b(144) + b(138) = b(138) - lu(1216) * b(144) + b(137) = b(137) - lu(1215) * b(144) + b(136) = b(136) - lu(1214) * b(144) + b(135) = b(135) - lu(1213) * b(144) + b(134) = b(134) - lu(1212) * b(144) + b(133) = b(133) - lu(1211) * b(144) + b(124) = b(124) - lu(1210) * b(144) + b(119) = b(119) - lu(1209) * b(144) + b(107) = b(107) - lu(1208) * b(144) + b(83) = b(83) - lu(1207) * b(144) + b(68) = b(68) - lu(1206) * b(144) + b(143) = b(143) * lu(1197) + b(142) = b(142) - lu(1196) * b(143) + b(141) = b(141) - lu(1195) * b(143) + b(140) = b(140) - lu(1194) * b(143) + b(139) = b(139) - lu(1193) * b(143) + b(138) = b(138) - lu(1192) * b(143) + b(137) = b(137) - lu(1191) * b(143) + b(136) = b(136) - lu(1190) * b(143) + b(134) = b(134) - lu(1189) * b(143) + b(133) = b(133) - lu(1188) * b(143) + b(132) = b(132) - lu(1187) * b(143) + b(115) = b(115) - lu(1186) * b(143) + b(100) = b(100) - lu(1185) * b(143) + b(86) = b(86) - lu(1184) * b(143) + b(56) = b(56) - lu(1183) * b(143) + b(48) = b(48) - lu(1182) * b(143) + b(142) = b(142) * lu(1172) + b(141) = b(141) - lu(1171) * b(142) + b(140) = b(140) - lu(1170) * b(142) + b(139) = b(139) - lu(1169) * b(142) + b(138) = b(138) - lu(1168) * b(142) + b(137) = b(137) - lu(1167) * b(142) + b(136) = b(136) - lu(1166) * b(142) + b(135) = b(135) - lu(1165) * b(142) + b(134) = b(134) - lu(1164) * b(142) + b(133) = b(133) - lu(1163) * b(142) + b(132) = b(132) - lu(1162) * b(142) + b(131) = b(131) - lu(1161) * b(142) + b(130) = b(130) - lu(1160) * b(142) + b(125) = b(125) - lu(1159) * b(142) + b(122) = b(122) - lu(1158) * b(142) + b(119) = b(119) - lu(1157) * b(142) + b(117) = b(117) - lu(1156) * b(142) + b(115) = b(115) - lu(1155) * b(142) + b(108) = b(108) - lu(1154) * b(142) + b(100) = b(100) - lu(1153) * b(142) + b(98) = b(98) - lu(1152) * b(142) + b(86) = b(86) - lu(1151) * b(142) + b(81) = b(81) - lu(1150) * b(142) + b(80) = b(80) - lu(1149) * b(142) + b(75) = b(75) - lu(1148) * b(142) + b(74) = b(74) - lu(1147) * b(142) + b(55) = b(55) - lu(1146) * b(142) + b(44) = b(44) - lu(1145) * b(142) + b(141) = b(141) * lu(1134) + b(140) = b(140) - lu(1133) * b(141) + b(139) = b(139) - lu(1132) * b(141) + b(138) = b(138) - lu(1131) * b(141) + b(137) = b(137) - lu(1130) * b(141) + b(136) = b(136) - lu(1129) * b(141) + b(135) = b(135) - lu(1128) * b(141) + b(134) = b(134) - lu(1127) * b(141) + b(133) = b(133) - lu(1126) * b(141) + b(124) = b(124) - lu(1125) * b(141) + b(107) = b(107) - lu(1124) * b(141) + b(101) = b(101) - lu(1123) * b(141) + b(46) = b(46) - lu(1122) * b(141) + b(45) = b(45) - lu(1121) * b(141) + b(41) = b(41) - lu(1120) * b(141) + b(39) = b(39) - lu(1119) * b(141) + b(140) = b(140) * lu(1107) + b(139) = b(139) - lu(1106) * b(140) + b(138) = b(138) - lu(1105) * b(140) + b(137) = b(137) - lu(1104) * b(140) + b(136) = b(136) - lu(1103) * b(140) + b(135) = b(135) - lu(1102) * b(140) + b(134) = b(134) - lu(1101) * b(140) + b(132) = b(132) - lu(1100) * b(140) + b(131) = b(131) - lu(1099) * b(140) + b(130) = b(130) - lu(1098) * b(140) + b(129) = b(129) - lu(1097) * b(140) + b(128) = b(128) - lu(1096) * b(140) + b(127) = b(127) - lu(1095) * b(140) + b(126) = b(126) - lu(1094) * b(140) + b(125) = b(125) - lu(1093) * b(140) + b(123) = b(123) - lu(1092) * b(140) + b(122) = b(122) - lu(1091) * b(140) + b(121) = b(121) - lu(1090) * b(140) + b(120) = b(120) - lu(1089) * b(140) + b(119) = b(119) - lu(1088) * b(140) + b(118) = b(118) - lu(1087) * b(140) + b(116) = b(116) - lu(1086) * b(140) + b(115) = b(115) - lu(1085) * b(140) + b(114) = b(114) - lu(1084) * b(140) + b(113) = b(113) - lu(1083) * b(140) + b(112) = b(112) - lu(1082) * b(140) + b(99) = b(99) - lu(1081) * b(140) + b(97) = b(97) - lu(1080) * b(140) + b(89) = b(89) - lu(1079) * b(140) + b(88) = b(88) - lu(1078) * b(140) + b(83) = b(83) - lu(1077) * b(140) + b(82) = b(82) - lu(1076) * b(140) + b(41) = b(41) - lu(1075) * b(140) + b(40) = b(40) - lu(1074) * b(140) + b(139) = b(139) * lu(1061) + b(138) = b(138) - lu(1060) * b(139) + b(137) = b(137) - lu(1059) * b(139) + b(136) = b(136) - lu(1058) * b(139) + b(135) = b(135) - lu(1057) * b(139) + b(134) = b(134) - lu(1056) * b(139) + b(133) = b(133) - lu(1055) * b(139) + b(132) = b(132) - lu(1054) * b(139) + b(124) = b(124) - lu(1053) * b(139) + b(119) = b(119) - lu(1052) * b(139) + b(117) = b(117) - lu(1051) * b(139) + b(115) = b(115) - lu(1050) * b(139) + b(110) = b(110) - lu(1049) * b(139) + b(108) = b(108) - lu(1048) * b(139) + b(107) = b(107) - lu(1047) * b(139) + b(104) = b(104) - lu(1046) * b(139) + b(103) = b(103) - lu(1045) * b(139) + b(102) = b(102) - lu(1044) * b(139) + b(100) = b(100) - lu(1043) * b(139) + b(97) = b(97) - lu(1042) * b(139) + b(94) = b(94) - lu(1041) * b(139) + b(91) = b(91) - lu(1040) * b(139) + b(90) = b(90) - lu(1039) * b(139) + b(86) = b(86) - lu(1038) * b(139) + b(77) = b(77) - lu(1037) * b(139) + b(76) = b(76) - lu(1036) * b(139) + b(62) = b(62) - lu(1035) * b(139) + b(41) = b(41) - lu(1034) * b(139) + b(40) = b(40) - lu(1033) * b(139) + end subroutine lu_slv06 + subroutine lu_slv07( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(138) = b(138) * lu(1019) + b(137) = b(137) - lu(1018) * b(138) + b(136) = b(136) - lu(1017) * b(138) + b(135) = b(135) - lu(1016) * b(138) + b(134) = b(134) - lu(1015) * b(138) + b(131) = b(131) - lu(1014) * b(138) + b(130) = b(130) - lu(1013) * b(138) + b(129) = b(129) - lu(1012) * b(138) + b(128) = b(128) - lu(1011) * b(138) + b(127) = b(127) - lu(1010) * b(138) + b(126) = b(126) - lu(1009) * b(138) + b(125) = b(125) - lu(1008) * b(138) + b(123) = b(123) - lu(1007) * b(138) + b(122) = b(122) - lu(1006) * b(138) + b(121) = b(121) - lu(1005) * b(138) + b(120) = b(120) - lu(1004) * b(138) + b(119) = b(119) - lu(1003) * b(138) + b(116) = b(116) - lu(1002) * b(138) + b(114) = b(114) - lu(1001) * b(138) + b(112) = b(112) - lu(1000) * b(138) + b(111) = b(111) - lu(999) * b(138) + b(109) = b(109) - lu(998) * b(138) + b(108) = b(108) - lu(997) * b(138) + b(106) = b(106) - lu(996) * b(138) + b(105) = b(105) - lu(995) * b(138) + b(104) = b(104) - lu(994) * b(138) + b(103) = b(103) - lu(993) * b(138) + b(102) = b(102) - lu(992) * b(138) + b(99) = b(99) - lu(991) * b(138) + b(98) = b(98) - lu(990) * b(138) + b(96) = b(96) - lu(989) * b(138) + b(95) = b(95) - lu(988) * b(138) + b(93) = b(93) - lu(987) * b(138) + b(83) = b(83) - lu(986) * b(138) + b(80) = b(80) - lu(985) * b(138) + b(79) = b(79) - lu(984) * b(138) + b(73) = b(73) - lu(983) * b(138) + b(71) = b(71) - lu(982) * b(138) + b(70) = b(70) - lu(981) * b(138) + b(68) = b(68) - lu(980) * b(138) + b(65) = b(65) - lu(979) * b(138) + b(64) = b(64) - lu(978) * b(138) + b(61) = b(61) - lu(977) * b(138) + b(57) = b(57) - lu(976) * b(138) + b(137) = b(137) * lu(961) + b(136) = b(136) - lu(960) * b(137) + b(135) = b(135) - lu(959) * b(137) + b(134) = b(134) - lu(958) * b(137) + b(133) = b(133) - lu(957) * b(137) + b(124) = b(124) - lu(956) * b(137) + b(101) = b(101) - lu(955) * b(137) + b(47) = b(47) - lu(954) * b(137) + b(136) = b(136) * lu(940) + b(134) = b(134) - lu(939) * b(136) + b(132) = b(132) - lu(938) * b(136) + b(119) = b(119) - lu(937) * b(136) + b(115) = b(115) - lu(936) * b(136) + b(112) = b(112) - lu(935) * b(136) + b(108) = b(108) - lu(934) * b(136) + b(104) = b(104) - lu(933) * b(136) + b(103) = b(103) - lu(932) * b(136) + b(102) = b(102) - lu(931) * b(136) + b(97) = b(97) - lu(930) * b(136) + b(94) = b(94) - lu(929) * b(136) + b(91) = b(91) - lu(928) * b(136) + b(77) = b(77) - lu(927) * b(136) + b(76) = b(76) - lu(926) * b(136) + b(71) = b(71) - lu(925) * b(136) + b(41) = b(41) - lu(924) * b(136) + b(40) = b(40) - lu(923) * b(136) + b(135) = b(135) * lu(909) + b(131) = b(131) - lu(908) * b(135) + b(130) = b(130) - lu(907) * b(135) + b(129) = b(129) - lu(906) * b(135) + b(128) = b(128) - lu(905) * b(135) + b(127) = b(127) - lu(904) * b(135) + b(126) = b(126) - lu(903) * b(135) + b(125) = b(125) - lu(902) * b(135) + b(123) = b(123) - lu(901) * b(135) + b(122) = b(122) - lu(900) * b(135) + b(121) = b(121) - lu(899) * b(135) + b(120) = b(120) - lu(898) * b(135) + b(119) = b(119) - lu(897) * b(135) + b(112) = b(112) - lu(896) * b(135) + b(111) = b(111) - lu(895) * b(135) + b(109) = b(109) - lu(894) * b(135) + b(98) = b(98) - lu(893) * b(135) + b(96) = b(96) - lu(892) * b(135) + b(89) = b(89) - lu(891) * b(135) + b(84) = b(84) - lu(890) * b(135) + b(69) = b(69) - lu(889) * b(135) + b(61) = b(61) - lu(888) * b(135) + b(49) = b(49) - lu(887) * b(135) + b(134) = b(134) * lu(876) + b(119) = b(119) - lu(875) * b(134) + b(107) = b(107) - lu(874) * b(134) + b(133) = b(133) * lu(861) + b(117) = b(117) - lu(860) * b(133) + b(110) = b(110) - lu(859) * b(133) + b(100) = b(100) - lu(858) * b(133) + b(48) = b(48) - lu(857) * b(133) + b(43) = b(43) - lu(856) * b(133) + b(132) = b(132) * lu(842) + b(115) = b(115) - lu(841) * b(132) + b(97) = b(97) - lu(840) * b(132) + b(56) = b(56) - lu(839) * b(132) + b(131) = b(131) * lu(826) + b(130) = b(130) - lu(825) * b(131) + b(129) = b(129) - lu(824) * b(131) + b(128) = b(128) - lu(823) * b(131) + b(127) = b(127) - lu(822) * b(131) + b(126) = b(126) - lu(821) * b(131) + b(125) = b(125) - lu(820) * b(131) + b(123) = b(123) - lu(819) * b(131) + b(122) = b(122) - lu(818) * b(131) + b(119) = b(119) - lu(817) * b(131) + b(112) = b(112) - lu(816) * b(131) + b(98) = b(98) - lu(815) * b(131) + b(89) = b(89) - lu(814) * b(131) + b(78) = b(78) - lu(813) * b(131) + b(75) = b(75) - lu(812) * b(131) + b(61) = b(61) - lu(811) * b(131) + b(130) = b(130) * lu(797) + b(125) = b(125) - lu(796) * b(130) + b(122) = b(122) - lu(795) * b(130) + b(89) = b(89) - lu(794) * b(130) + b(81) = b(81) - lu(793) * b(130) + b(78) = b(78) - lu(792) * b(130) + b(129) = b(129) * lu(777) + b(128) = b(128) - lu(776) * b(129) + b(125) = b(125) - lu(775) * b(129) + b(122) = b(122) - lu(774) * b(129) + b(120) = b(120) - lu(773) * b(129) + b(119) = b(119) - lu(772) * b(129) + b(118) = b(118) - lu(771) * b(129) + b(128) = b(128) * lu(758) + b(126) = b(126) - lu(757) * b(128) + b(125) = b(125) - lu(756) * b(128) + b(122) = b(122) - lu(755) * b(128) + b(119) = b(119) - lu(754) * b(128) + b(114) = b(114) - lu(753) * b(128) + b(112) = b(112) - lu(752) * b(128) + b(84) = b(84) - lu(751) * b(128) + b(59) = b(59) - lu(750) * b(128) + b(127) = b(127) * lu(734) + b(126) = b(126) - lu(733) * b(127) + b(125) = b(125) - lu(732) * b(127) + b(123) = b(123) - lu(731) * b(127) + b(122) = b(122) - lu(730) * b(127) + b(119) = b(119) - lu(729) * b(127) + b(114) = b(114) - lu(728) * b(127) + b(112) = b(112) - lu(727) * b(127) + b(98) = b(98) - lu(726) * b(127) + b(85) = b(85) - lu(725) * b(127) + b(84) = b(84) - lu(724) * b(127) + b(61) = b(61) - lu(723) * b(127) + b(126) = b(126) * lu(711) + b(125) = b(125) - lu(710) * b(126) + b(122) = b(122) - lu(709) * b(126) + b(119) = b(119) - lu(708) * b(126) + b(112) = b(112) - lu(707) * b(126) + b(98) = b(98) - lu(706) * b(126) + b(84) = b(84) - lu(705) * b(126) + b(50) = b(50) - lu(704) * b(126) + b(125) = b(125) * lu(696) + b(119) = b(119) - lu(695) * b(125) + b(124) = b(124) * lu(684) + b(101) = b(101) - lu(683) * b(124) + b(47) = b(47) - lu(682) * b(124) + b(123) = b(123) * lu(671) + b(119) = b(119) - lu(670) * b(123) + b(122) = b(122) * lu(664) + b(121) = b(121) * lu(652) + b(84) = b(84) - lu(651) * b(121) + b(67) = b(67) - lu(650) * b(121) + b(120) = b(120) * lu(641) + b(119) = b(119) - lu(640) * b(120) + b(119) = b(119) * lu(636) + b(118) = b(118) * lu(621) + b(106) = b(106) - lu(620) * b(118) + b(89) = b(89) - lu(619) * b(118) + b(65) = b(65) - lu(618) * b(118) + b(117) = b(117) * lu(608) + b(110) = b(110) - lu(607) * b(117) + b(43) = b(43) - lu(606) * b(117) + b(116) = b(116) * lu(595) + b(96) = b(96) - lu(594) * b(116) + b(72) = b(72) - lu(593) * b(116) + b(115) = b(115) * lu(587) + b(51) = b(51) - lu(586) * b(115) + b(114) = b(114) * lu(578) + b(61) = b(61) - lu(577) * b(114) + b(113) = b(113) * lu(560) + b(105) = b(105) - lu(559) * b(113) + b(89) = b(89) - lu(558) * b(113) + b(112) = b(112) * lu(553) + b(98) = b(98) - lu(552) * b(112) + b(111) = b(111) * lu(540) + b(96) = b(96) - lu(539) * b(111) + b(66) = b(66) - lu(538) * b(111) + b(110) = b(110) * lu(531) + b(43) = b(43) - lu(530) * b(110) + end subroutine lu_slv07 + subroutine lu_slv08( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(109) = b(109) * lu(521) + b(84) = b(84) - lu(520) * b(109) + b(60) = b(60) - lu(519) * b(109) + b(49) = b(49) - lu(518) * b(109) + b(108) = b(108) * lu(509) + b(104) = b(104) - lu(508) * b(108) + b(103) = b(103) - lu(507) * b(108) + b(102) = b(102) - lu(506) * b(108) + b(91) = b(91) - lu(505) * b(108) + b(76) = b(76) - lu(504) * b(108) + b(107) = b(107) * lu(497) + b(106) = b(106) * lu(487) + b(87) = b(87) - lu(486) * b(106) + b(105) = b(105) * lu(476) + b(104) = b(104) * lu(469) + b(103) = b(103) - lu(468) * b(104) + b(102) = b(102) - lu(467) * b(104) + b(94) = b(94) - lu(466) * b(104) + b(77) = b(77) - lu(465) * b(104) + b(103) = b(103) * lu(458) + b(77) = b(77) - lu(457) * b(103) + b(102) = b(102) * lu(449) + b(101) = b(101) * lu(441) + b(47) = b(47) - lu(440) * b(101) + b(100) = b(100) * lu(432) + b(48) = b(48) - lu(431) * b(100) + b(99) = b(99) * lu(423) + b(71) = b(71) - lu(422) * b(99) + b(38) = b(38) - lu(421) * b(99) + b(98) = b(98) * lu(417) + b(97) = b(97) * lu(410) + b(96) = b(96) * lu(404) + b(95) = b(95) * lu(393) + b(93) = b(93) - lu(392) * b(95) + b(92) = b(92) - lu(391) * b(95) + b(70) = b(70) - lu(390) * b(95) + b(65) = b(65) - lu(389) * b(95) + b(94) = b(94) * lu(379) + b(91) = b(91) - lu(378) * b(94) + b(77) = b(77) - lu(377) * b(94) + b(93) = b(93) * lu(370) + b(58) = b(58) - lu(369) * b(93) + b(92) = b(92) * lu(359) + b(70) = b(70) - lu(358) * b(92) + b(91) = b(91) * lu(351) + b(90) = b(90) * lu(344) + b(89) = b(89) * lu(340) + b(88) = b(88) * lu(331) + b(87) = b(87) * lu(323) + b(86) = b(86) * lu(315) + b(85) = b(85) * lu(307) + b(84) = b(84) * lu(303) + b(83) = b(83) * lu(299) + b(82) = b(82) * lu(291) + b(81) = b(81) * lu(283) + b(80) = b(80) * lu(277) + b(79) = b(79) * lu(269) + b(63) = b(63) - lu(268) * b(79) + b(78) = b(78) * lu(262) + b(77) = b(77) * lu(257) + b(76) = b(76) * lu(250) + b(75) = b(75) * lu(243) + b(74) = b(74) * lu(236) + b(73) = b(73) * lu(229) + b(2) = b(2) - lu(228) * b(73) + b(72) = b(72) * lu(221) + b(71) = b(71) * lu(216) + b(70) = b(70) * lu(211) + b(69) = b(69) * lu(205) + b(68) = b(68) * lu(199) + b(67) = b(67) * lu(193) + b(66) = b(66) * lu(187) + b(65) = b(65) * lu(183) + b(64) = b(64) * lu(177) + b(1) = b(1) - lu(176) * b(64) + b(63) = b(63) * lu(170) + b(62) = b(62) * lu(162) + b(61) = b(61) * lu(159) + b(60) = b(60) * lu(154) + b(59) = b(59) * lu(149) + b(58) = b(58) * lu(144) + b(57) = b(57) * lu(137) + b(56) = b(56) * lu(132) + b(55) = b(55) * lu(126) + b(54) = b(54) * lu(120) + b(53) = b(53) * lu(114) + b(52) = b(52) * lu(108) + b(51) = b(51) * lu(104) + b(42) = b(42) - lu(103) * b(51) + b(50) = b(50) * lu(99) + b(49) = b(49) * lu(95) + b(48) = b(48) * lu(92) + b(47) = b(47) * lu(89) + b(46) = b(46) * lu(85) + b(45) = b(45) * lu(81) + b(44) = b(44) * lu(77) + b(43) = b(43) * lu(75) + b(42) = b(42) * lu(72) + b(41) = b(41) * lu(70) + b(40) = b(40) - lu(69) * b(41) + b(40) = b(40) * lu(67) + b(39) = b(39) * lu(64) + b(38) = b(38) * lu(61) + b(37) = b(37) * lu(58) + b(36) = b(36) * lu(53) + b(35) = b(35) * lu(49) + b(34) = b(34) * lu(46) + b(33) = b(33) * lu(43) + b(32) = b(32) * lu(40) + b(31) = b(31) * lu(37) + b(30) = b(30) * lu(34) + b(29) = b(29) * lu(31) + b(28) = b(28) * lu(30) + b(27) = b(27) * lu(29) + b(26) = b(26) * lu(28) + b(25) = b(25) * lu(27) + b(24) = b(24) * lu(26) + b(23) = b(23) * lu(25) + b(22) = b(22) * lu(24) + b(21) = b(21) * lu(23) + b(20) = b(20) * lu(22) + b(19) = b(19) * lu(20) + b(18) = b(18) * lu(19) + b(17) = b(17) * lu(17) + b(16) = b(16) * lu(16) + b(15) = b(15) * lu(15) + b(14) = b(14) * lu(14) + b(13) = b(13) * lu(13) + b(12) = b(12) * lu(12) + b(11) = b(11) * lu(11) + b(10) = b(10) * lu(10) + b(9) = b(9) * lu(9) + b(8) = b(8) * lu(8) + b(7) = b(7) * lu(7) + b(6) = b(6) * lu(6) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv08 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + call lu_slv05( lu, b ) + call lu_slv06( lu, b ) + call lu_slv07( lu, b ) + call lu_slv08( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 new file mode 100644 index 0000000000..bf495d9d93 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_nln_matrix.F90 @@ -0,0 +1,2450 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat01( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1107) = -(rxt(119)*y(2) + rxt(137)*y(3) + rxt(164)*y(22) + rxt(169)*y(23) & + + rxt(177)*y(24) + rxt(192)*y(9) + rxt(195)*y(10) + rxt(207) & + *y(28) + rxt(234)*y(37) + rxt(293)*y(44) + rxt(314)*y(59) & + + rxt(336)*y(77) + rxt(342)*y(78) + rxt(360)*y(83) + rxt(398) & + *y(105) + rxt(433)*y(163) + rxt(436)*y(164)) + mat(1062) = -rxt(119)*y(1) + mat(1133) = -rxt(137)*y(1) + mat(1238) = -rxt(164)*y(1) + mat(1517) = -rxt(169)*y(1) + mat(1311) = -rxt(177)*y(1) + mat(1021) = -rxt(192)*y(1) + mat(1170) = -rxt(195)*y(1) + mat(1416) = -rxt(207)*y(1) + mat(879) = -rxt(234)*y(1) + mat(295) = -rxt(293)*y(1) + mat(629) = -rxt(314)*y(1) + mat(784) = -rxt(336)*y(1) + mat(676) = -rxt(342)*y(1) + mat(570) = -rxt(360)*y(1) + mat(335) = -rxt(398)*y(1) + mat(414) = -rxt(433)*y(1) + mat(847) = -rxt(436)*y(1) + mat(1107) = mat(1107) + .100_r8*rxt(360)*y(83) + .200_r8*rxt(336)*y(77) & + + .200_r8*rxt(342)*y(78) + mat(1062) = mat(1062) + rxt(118)*y(4) + mat(943) = rxt(118)*y(2) + mat(1311) = mat(1311) + .250_r8*rxt(304)*y(48) + .250_r8*rxt(352)*y(76) + mat(570) = mat(570) + .100_r8*rxt(360)*y(1) + mat(831) = .250_r8*rxt(304)*y(24) + mat(784) = mat(784) + .200_r8*rxt(336)*y(1) + mat(676) = mat(676) + .200_r8*rxt(342)*y(1) + mat(803) = .250_r8*rxt(352)*y(24) + mat(1061) = -(rxt(118)*y(4) + rxt(119)*y(1) + 4._r8*rxt(120)*y(2) + rxt(168) & + *y(23) + rxt(175)*y(21) + rxt(176)*y(24) + rxt(179)*y(25) & + + rxt(190)*y(9) + (rxt(193) + rxt(194)) * y(10) + rxt(201)*y(11) & + + rxt(214)*y(30) + rxt(227)*y(33) + rxt(228)*y(34) + rxt(231) & + *y(35) + rxt(237)*y(38) + rxt(247)*y(39) + rxt(248)*y(40) & + + rxt(249)*y(41) + rxt(271)*y(19) + rxt(429)*y(162) + (rxt(465) & + + rxt(466)) * y(127) + rxt(472)*y(129)) + mat(942) = -rxt(118)*y(2) + mat(1106) = -rxt(119)*y(2) + mat(1516) = -rxt(168)*y(2) + mat(688) = -rxt(175)*y(2) + mat(1310) = -rxt(176)*y(2) + mat(346) = -rxt(179)*y(2) + mat(1020) = -rxt(190)*y(2) + mat(1169) = -(rxt(193) + rxt(194)) * y(2) + mat(1354) = -rxt(201)*y(2) + mat(1543) = -rxt(214)*y(2) + mat(864) = -rxt(227)*y(2) + mat(533) = -rxt(228)*y(2) + mat(611) = -rxt(231)*y(2) + mat(1193) = -rxt(237)*y(2) + mat(499) = -rxt(247)*y(2) + mat(435) = -rxt(248)*y(2) + mat(319) = -rxt(249)*y(2) + mat(1217) = -rxt(271)*y(2) + mat(167) = -rxt(429)*y(2) + mat(387) = -(rxt(465) + rxt(466)) * y(2) + mat(256) = -rxt(472)*y(2) + mat(1132) = (rxt(132)+rxt(133))*y(4) + mat(942) = mat(942) + (rxt(132)+rxt(133))*y(3) + rxt(185)*y(8) + rxt(471) & + *y(129) + rxt(463)*y(130) + rxt(432)*y(163) + rxt(435)*y(164) + mat(513) = rxt(185)*y(4) + rxt(186)*y(9) + rxt(187)*y(10) + rxt(468)*y(128) + mat(1020) = mat(1020) + rxt(186)*y(8) + mat(1169) = mat(1169) + rxt(187)*y(8) + mat(1516) = mat(1516) + 2.000_r8*rxt(171)*y(23) + mat(1237) = rxt(167)*y(24) + mat(1310) = mat(1310) + rxt(167)*y(22) + mat(455) = rxt(468)*y(8) + 1.150_r8*rxt(476)*y(132) + mat(256) = mat(256) + rxt(471)*y(4) + mat(357) = rxt(463)*y(4) + mat(463) = rxt(475)*y(132) + mat(474) = 1.150_r8*rxt(476)*y(128) + rxt(475)*y(131) + mat(413) = rxt(432)*y(4) + mat(846) = rxt(435)*y(4) + mat(1134) = -((rxt(132) + rxt(133)) * y(4) + rxt(134)*y(134) + rxt(137)*y(1) & + + rxt(154)*y(138) + rxt(155)*y(139) + rxt(159)*y(21) + rxt(160) & + *y(33) + rxt(161)*y(39) + rxt(162)*y(42)) + mat(944) = -(rxt(132) + rxt(133)) * y(3) + mat(1382) = -rxt(134)*y(3) + mat(1108) = -rxt(137)*y(3) + mat(66) = -rxt(154)*y(3) + mat(83) = -rxt(155)*y(3) + mat(689) = -rxt(159)*y(3) + mat(865) = -rxt(160)*y(3) + mat(500) = -rxt(161)*y(3) + mat(86) = -rxt(162)*y(3) + mat(944) = mat(944) + rxt(182)*y(133) + mat(456) = .850_r8*rxt(476)*y(132) + mat(261) = rxt(182)*y(4) + mat(475) = .850_r8*rxt(476)*y(128) + mat(940) = -(rxt(118)*y(2) + rxt(128)*y(6) + rxt(132)*y(3) + rxt(163)*y(22) & + + rxt(182)*y(133) + rxt(185)*y(8) + rxt(291)*y(56) + rxt(432) & + *y(163) + rxt(435)*y(164) + rxt(463)*y(130) + (rxt(470) + rxt(471) & + ) * y(129) + rxt(473)*y(127)) + mat(1058) = -rxt(118)*y(4) + mat(68) = -rxt(128)*y(4) + mat(1129) = -rxt(132)*y(4) + mat(1234) = -rxt(163)*y(4) + mat(259) = -rxt(182)*y(4) + mat(511) = -rxt(185)*y(4) + mat(218) = -rxt(291)*y(4) + mat(412) = -rxt(432)*y(4) + mat(844) = -rxt(435)*y(4) + mat(356) = -rxt(463)*y(4) + mat(255) = -(rxt(470) + rxt(471)) * y(4) + mat(385) = -rxt(473)*y(4) + mat(1103) = 2.000_r8*rxt(119)*y(2) + 2.000_r8*rxt(137)*y(3) + rxt(192)*y(9) & + + rxt(195)*y(10) + rxt(169)*y(23) + rxt(164)*y(22) & + + 2.000_r8*rxt(177)*y(24) + rxt(207)*y(28) + rxt(234)*y(37) & + + rxt(433)*y(163) + rxt(436)*y(164) + mat(1058) = mat(1058) + 2.000_r8*rxt(119)*y(1) + 2.000_r8*rxt(120)*y(2) & + + rxt(127)*y(6) + rxt(193)*y(10) + rxt(168)*y(23) + rxt(201) & + *y(11) + rxt(176)*y(24) + rxt(214)*y(30) + rxt(237)*y(38) + mat(1129) = mat(1129) + 2.000_r8*rxt(137)*y(1) + mat(940) = mat(940) + 2.000_r8*rxt(128)*y(6) + mat(68) = mat(68) + rxt(127)*y(2) + 2.000_r8*rxt(128)*y(4) + mat(511) = mat(511) + rxt(189)*y(10) + mat(1017) = rxt(192)*y(1) + rxt(469)*y(128) + mat(1166) = rxt(195)*y(1) + rxt(193)*y(2) + rxt(189)*y(8) + mat(1513) = rxt(169)*y(1) + rxt(168)*y(2) + rxt(205)*y(13) + rxt(170)*y(24) & + + rxt(216)*y(30) + mat(1351) = rxt(201)*y(2) + rxt(203)*y(24) + mat(237) = rxt(205)*y(23) + mat(910) = rxt(274)*y(24) + mat(1234) = mat(1234) + rxt(164)*y(1) + rxt(166)*y(24) + mat(1307) = 2.000_r8*rxt(177)*y(1) + rxt(176)*y(2) + rxt(170)*y(23) & + + rxt(203)*y(11) + rxt(274)*y(16) + rxt(166)*y(22) & + + 2.000_r8*rxt(178)*y(24) + rxt(210)*y(28) + rxt(217)*y(30) & + + rxt(235)*y(37) + rxt(239)*y(38) + rxt(322)*y(64) & + + .750_r8*rxt(352)*y(76) + rxt(296)*y(46) + rxt(317)*y(61) & + + rxt(326)*y(67) + mat(1412) = rxt(207)*y(1) + rxt(210)*y(24) + mat(1540) = rxt(214)*y(2) + rxt(216)*y(23) + rxt(217)*y(24) + ( & + + 2.000_r8*rxt(221)+2.000_r8*rxt(222))*y(30) + (rxt(243) & + +rxt(244))*y(38) + mat(877) = rxt(234)*y(1) + rxt(235)*y(24) + mat(1190) = rxt(237)*y(2) + rxt(239)*y(24) + (rxt(243)+rxt(244))*y(30) & + + 2.000_r8*rxt(245)*y(38) + mat(453) = rxt(469)*y(9) + mat(490) = rxt(322)*y(24) + mat(800) = .750_r8*rxt(352)*y(24) + mat(524) = rxt(296)*y(24) + mat(545) = rxt(317)*y(24) + mat(657) = rxt(326)*y(24) + mat(412) = mat(412) + rxt(433)*y(1) + mat(844) = mat(844) + rxt(436)*y(1) + mat(70) = -(rxt(121)*y(2) + rxt(122)*y(4) + rxt(124)*y(1)) + mat(1034) = -rxt(121)*y(5) + mat(924) = -rxt(122)*y(5) + mat(1075) = -rxt(124)*y(5) + mat(1120) = rxt(132)*y(4) + mat(924) = mat(924) + rxt(132)*y(3) + mat(67) = -(rxt(127)*y(2) + rxt(128)*y(4)) + mat(1033) = -rxt(127)*y(6) + mat(923) = -rxt(128)*y(6) + mat(1074) = rxt(124)*y(5) + mat(1033) = mat(1033) + rxt(121)*y(5) + mat(923) = mat(923) + rxt(122)*y(5) + mat(69) = rxt(124)*y(1) + rxt(121)*y(2) + rxt(122)*y(4) + mat(684) = -(rxt(159)*y(3) + rxt(173)*y(23) + rxt(175)*y(2) + rxt(208)*y(28) & + + rxt(251)*y(141)) + mat(1125) = -rxt(159)*y(21) + mat(1501) = -rxt(173)*y(21) + mat(1053) = -rxt(175)*y(21) + mat(1407) = -rxt(208)*y(21) + mat(442) = -rxt(251)*y(21) + mat(1230) = rxt(166)*y(24) + mat(1296) = rxt(166)*y(22) + mat(636) = -((rxt(267) + rxt(268)) * y(23)) + mat(1496) = -(rxt(267) + rxt(268)) * y(20) + mat(1088) = .560_r8*rxt(314)*y(59) + .300_r8*rxt(360)*y(83) & + + .500_r8*rxt(293)*y(44) + .050_r8*rxt(336)*y(77) & + + .200_r8*rxt(342)*y(78) + mat(1052) = rxt(271)*y(19) + rxt(429)*y(162) + mat(1003) = .220_r8*rxt(343)*y(79) + .250_r8*rxt(378)*y(91) + mat(1496) = mat(1496) + rxt(270)*y(19) + rxt(309)*y(53) + rxt(330)*y(68) & + + .350_r8*rxt(286)*y(135) + rxt(430)*y(162) + mat(1336) = rxt(269)*y(19) + .220_r8*rxt(345)*y(79) + rxt(331)*y(68) & + + .500_r8*rxt(379)*y(91) + mat(897) = .110_r8*rxt(347)*y(79) + .200_r8*rxt(381)*y(91) + mat(1209) = rxt(271)*y(2) + rxt(270)*y(23) + rxt(269)*y(11) + rxt(212)*y(28) & + + rxt(236)*y(37) + mat(1405) = rxt(212)*y(19) + mat(875) = rxt(236)*y(19) + mat(622) = .560_r8*rxt(314)*y(1) + mat(563) = .300_r8*rxt(360)*y(1) + mat(817) = .220_r8*rxt(348)*y(79) + .250_r8*rxt(382)*y(91) + mat(294) = .500_r8*rxt(293)*y(1) + mat(418) = rxt(309)*y(23) + mat(772) = .050_r8*rxt(336)*y(1) + mat(670) = .200_r8*rxt(342)*y(1) + mat(754) = .220_r8*rxt(343)*y(9) + .220_r8*rxt(345)*y(11) + .110_r8*rxt(347) & + *y(16) + .220_r8*rxt(348)*y(48) + mat(695) = rxt(330)*y(23) + rxt(331)*y(11) + mat(708) = .250_r8*rxt(378)*y(9) + .500_r8*rxt(379)*y(11) + .200_r8*rxt(381) & + *y(16) + .250_r8*rxt(382)*y(48) + mat(117) = .350_r8*rxt(286)*y(23) + mat(165) = rxt(429)*y(2) + rxt(430)*y(23) + mat(509) = -(rxt(184)*y(23) + rxt(185)*y(4) + rxt(186)*y(9) + (rxt(187) & + + rxt(188) + rxt(189)) * y(10) + rxt(468)*y(128)) + mat(1485) = -rxt(184)*y(8) + mat(934) = -rxt(185)*y(8) + mat(997) = -rxt(186)*y(8) + mat(1154) = -(rxt(187) + rxt(188) + rxt(189)) * y(8) + mat(452) = -rxt(468)*y(8) + mat(1048) = rxt(472)*y(129) + rxt(183)*y(133) + mat(934) = mat(934) + rxt(470)*y(129) + mat(383) = 1.100_r8*rxt(477)*y(132) + mat(254) = rxt(472)*y(2) + rxt(470)*y(4) + mat(460) = .200_r8*rxt(475)*y(132) + mat(258) = rxt(183)*y(2) + mat(470) = 1.100_r8*rxt(477)*y(127) + .200_r8*rxt(475)*y(131) + end subroutine nlnmat01 + subroutine nlnmat02( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1019) = -(rxt(186)*y(8) + rxt(190)*y(2) + rxt(191)*y(24) + rxt(192)*y(1) & + + rxt(200)*y(11) + rxt(219)*y(30) + rxt(240)*y(38) + rxt(273) & + *y(16) + rxt(281)*y(137) + rxt(289)*y(55) + rxt(295)*y(46) & + + rxt(302)*y(48) + rxt(316)*y(61) + rxt(321)*y(64) + rxt(325) & + *y(67) + rxt(334)*y(73) + rxt(338)*y(74) + (rxt(343) + rxt(344) & + ) * y(79) + rxt(350)*y(76) + rxt(362)*y(88) + rxt(368)*y(89) & + + rxt(375)*y(84) + rxt(378)*y(91) + rxt(386)*y(96) + rxt(393) & + *y(100) + rxt(396)*y(103) + rxt(400)*y(106) + rxt(469)*y(128)) + mat(512) = -rxt(186)*y(9) + mat(1060) = -rxt(190)*y(9) + mat(1309) = -rxt(191)*y(9) + mat(1105) = -rxt(192)*y(9) + mat(1353) = -rxt(200)*y(9) + mat(1542) = -rxt(219)*y(9) + mat(1192) = -rxt(240)*y(9) + mat(912) = -rxt(273)*y(9) + mat(201) = -rxt(281)*y(9) + mat(426) = -rxt(289)*y(9) + mat(525) = -rxt(295)*y(9) + mat(830) = -rxt(302)*y(9) + mat(546) = -rxt(316)*y(9) + mat(491) = -rxt(321)*y(9) + mat(658) = -rxt(325)*y(9) + mat(140) = -rxt(334)*y(9) + mat(373) = -rxt(338)*y(9) + mat(763) = -(rxt(343) + rxt(344)) * y(9) + mat(802) = -rxt(350)*y(9) + mat(741) = -rxt(362)*y(9) + mat(480) = -rxt(368)*y(9) + mat(399) = -rxt(375)*y(9) + mat(715) = -rxt(378)*y(9) + mat(273) = -rxt(386)*y(9) + mat(180) = -rxt(393)*y(9) + mat(233) = -rxt(396)*y(9) + mat(601) = -rxt(400)*y(9) + mat(454) = -rxt(469)*y(9) + mat(1060) = mat(1060) + rxt(193)*y(10) + mat(941) = rxt(185)*y(8) + rxt(182)*y(133) + mat(512) = mat(512) + rxt(185)*y(4) + 2.000_r8*rxt(188)*y(10) + rxt(184) & + *y(23) + mat(1168) = rxt(193)*y(2) + 2.000_r8*rxt(188)*y(8) + rxt(437)*y(164) + mat(1515) = rxt(184)*y(8) + mat(260) = rxt(182)*y(4) + mat(845) = rxt(437)*y(10) + mat(1172) = -((rxt(187) + rxt(188) + rxt(189)) * y(8) + (rxt(193) + rxt(194) & + ) * y(2) + rxt(195)*y(1) + rxt(196)*y(11) + rxt(198)*y(23) & + + rxt(204)*y(24) + rxt(220)*y(30) + rxt(241)*y(38) + rxt(303) & + *y(48) + rxt(356)*y(76) + rxt(390)*y(98) + rxt(437)*y(164)) + mat(515) = -(rxt(187) + rxt(188) + rxt(189)) * y(10) + mat(1064) = -(rxt(193) + rxt(194)) * y(10) + mat(1109) = -rxt(195)*y(10) + mat(1357) = -rxt(196)*y(10) + mat(1519) = -rxt(198)*y(10) + mat(1313) = -rxt(204)*y(10) + mat(1546) = -rxt(220)*y(10) + mat(1196) = -rxt(241)*y(10) + mat(832) = -rxt(303)*y(10) + mat(804) = -rxt(356)*y(10) + mat(79) = -rxt(390)*y(10) + mat(848) = -rxt(437)*y(10) + mat(1109) = mat(1109) + rxt(192)*y(9) + mat(1064) = mat(1064) + rxt(190)*y(9) + rxt(201)*y(11) + mat(1023) = rxt(192)*y(1) + rxt(190)*y(2) + 2.000_r8*rxt(200)*y(11) & + + rxt(273)*y(16) + rxt(191)*y(24) + rxt(219)*y(30) + rxt(240) & + *y(38) + rxt(321)*y(64) + rxt(302)*y(48) + rxt(334)*y(73) & + + .900_r8*rxt(375)*y(84) + rxt(338)*y(74) + .900_r8*rxt(386) & + *y(96) + rxt(400)*y(106) + .900_r8*rxt(393)*y(100) & + + .900_r8*rxt(396)*y(103) + .920_r8*rxt(362)*y(88) + rxt(343) & + *y(79) + rxt(350)*y(76) + rxt(295)*y(46) + rxt(316)*y(61) & + + rxt(289)*y(55) + rxt(325)*y(67) + 1.206_r8*rxt(368)*y(89) & + + rxt(378)*y(91) + rxt(281)*y(137) + mat(1172) = mat(1172) + .700_r8*rxt(390)*y(98) + mat(1519) = mat(1519) + rxt(202)*y(11) + rxt(205)*y(13) + rxt(332)*y(82) & + + .400_r8*rxt(372)*y(90) + mat(1357) = mat(1357) + rxt(201)*y(2) + 2.000_r8*rxt(200)*y(9) + rxt(202) & + *y(23) + rxt(203)*y(24) + rxt(363)*y(88) + rxt(345)*y(79) & + + rxt(351)*y(76) + rxt(399)*y(105) + 1.206_r8*rxt(369)*y(89) & + + rxt(373)*y(90) + rxt(379)*y(91) + mat(238) = rxt(205)*y(23) + mat(914) = rxt(273)*y(9) + mat(1313) = mat(1313) + rxt(191)*y(9) + rxt(203)*y(11) + .206_r8*rxt(370) & + *y(89) + mat(1546) = mat(1546) + rxt(219)*y(9) + mat(1196) = mat(1196) + rxt(240)*y(9) + mat(492) = rxt(321)*y(9) + mat(832) = mat(832) + rxt(302)*y(9) + mat(185) = rxt(332)*y(23) + mat(141) = rxt(334)*y(9) + mat(400) = .900_r8*rxt(375)*y(9) + mat(374) = rxt(338)*y(9) + mat(274) = .900_r8*rxt(386)*y(9) + mat(79) = mat(79) + .700_r8*rxt(390)*y(10) + mat(602) = rxt(400)*y(9) + mat(181) = .900_r8*rxt(393)*y(9) + mat(234) = .900_r8*rxt(396)*y(9) + mat(743) = .920_r8*rxt(362)*y(9) + rxt(363)*y(11) + mat(764) = rxt(343)*y(9) + rxt(345)*y(11) + mat(804) = mat(804) + rxt(350)*y(9) + rxt(351)*y(11) + mat(526) = rxt(295)*y(9) + mat(336) = rxt(399)*y(11) + mat(547) = rxt(316)*y(9) + mat(427) = rxt(289)*y(9) + mat(659) = rxt(325)*y(9) + mat(481) = 1.206_r8*rxt(368)*y(9) + 1.206_r8*rxt(369)*y(11) & + + .206_r8*rxt(370)*y(24) + mat(581) = .400_r8*rxt(372)*y(23) + rxt(373)*y(11) + mat(716) = rxt(378)*y(9) + rxt(379)*y(11) + mat(202) = rxt(281)*y(9) + mat(1527) = -(rxt(168)*y(2) + rxt(169)*y(1) + rxt(170)*y(24) + (4._r8*rxt(171) & + + 4._r8*rxt(172)) * y(23) + rxt(173)*y(21) + rxt(174)*y(25) & + + rxt(180)*y(42) + rxt(181)*y(43) + rxt(184)*y(8) + rxt(198) & + *y(10) + rxt(199)*y(12) + rxt(202)*y(11) + rxt(205)*y(13) & + + (rxt(215) + rxt(216)) * y(30) + rxt(226)*y(33) + rxt(230) & + *y(34) + rxt(232)*y(35) + rxt(238)*y(38) + rxt(246)*y(39) & + + (rxt(267) + rxt(268)) * y(20) + rxt(270)*y(19) + rxt(277) & + *y(18) + rxt(278)*y(17) + rxt(279)*y(136) + rxt(286)*y(135) & + + rxt(287)*y(45) + rxt(288)*y(44) + rxt(294)*y(49) + rxt(299) & + *y(47) + rxt(300)*y(50) + rxt(307)*y(54) + rxt(308)*y(52) & + + rxt(309)*y(53) + rxt(310)*y(51) + rxt(312)*y(58) + rxt(313) & + *y(59) + rxt(319)*y(62) + rxt(320)*y(60) + rxt(323)*y(65) & + + rxt(324)*y(63) + rxt(328)*y(69) + rxt(329)*y(66) + rxt(330) & + *y(68) + rxt(332)*y(82) + rxt(333)*y(70) + rxt(335)*y(77) & + + rxt(337)*y(72) + rxt(340)*y(75) + rxt(341)*y(78) + rxt(349) & + *y(80) + rxt(358)*y(81) + rxt(359)*y(83) + rxt(365)*y(93) & + + rxt(371)*y(71) + rxt(372)*y(90) + rxt(374)*y(87) + rxt(377) & + *y(85) + rxt(383)*y(92) + rxt(385)*y(94) + rxt(388)*y(97) & + + rxt(389)*y(95) + rxt(391)*y(99) + rxt(394)*y(102) + rxt(397) & + *y(105) + rxt(402)*y(107) + rxt(430)*y(162) + rxt(431)*y(163) & + + rxt(434)*y(164) + rxt(441)*y(156) + (rxt(443) + rxt(444) & + ) * y(157)) + mat(1072) = -rxt(168)*y(23) + mat(1117) = -rxt(169)*y(23) + mat(1321) = -rxt(170)*y(23) + mat(694) = -rxt(173)*y(23) + mat(350) = -rxt(174)*y(23) + mat(88) = -rxt(180)*y(23) + mat(48) = -rxt(181)*y(23) + mat(517) = -rxt(184)*y(23) + mat(1180) = -rxt(198)*y(23) + mat(974) = -rxt(199)*y(23) + mat(1365) = -rxt(202)*y(23) + mat(242) = -rxt(205)*y(23) + mat(1554) = -(rxt(215) + rxt(216)) * y(23) + mat(872) = -rxt(226)*y(23) + mat(536) = -rxt(230)*y(23) + mat(616) = -rxt(232)*y(23) + mat(1204) = -rxt(238)*y(23) + mat(503) = -rxt(246)*y(23) + mat(639) = -(rxt(267) + rxt(268)) * y(23) + mat(1228) = -rxt(270)*y(23) + mat(306) = -rxt(277)*y(23) + mat(210) = -rxt(278)*y(23) + mat(302) = -rxt(279)*y(23) + mat(119) = -rxt(286)*y(23) + mat(113) = -rxt(287)*y(23) + mat(298) = -rxt(288)*y(23) + mat(343) = -rxt(294)*y(23) + mat(158) = -rxt(299)*y(23) + mat(649) = -rxt(300)*y(23) + mat(267) = -rxt(307)*y(23) + mat(557) = -rxt(308)*y(23) + mat(420) = -rxt(309)*y(23) + mat(98) = -rxt(310)*y(23) + mat(249) = -rxt(312)*y(23) + mat(635) = -rxt(313)*y(23) + mat(192) = -rxt(319)*y(23) + mat(52) = -rxt(320)*y(23) + mat(330) = -rxt(323)*y(23) + mat(409) = -rxt(324)*y(23) + mat(198) = -rxt(328)*y(23) + mat(669) = -rxt(329)*y(23) + mat(703) = -rxt(330)*y(23) + mat(186) = -rxt(332)*y(23) + mat(39) = -rxt(333)*y(23) + mat(791) = -rxt(335)*y(23) + mat(215) = -rxt(337)*y(23) + mat(148) = -rxt(340)*y(23) + mat(681) = -rxt(341)*y(23) + mat(153) = -rxt(349)*y(23) + mat(290) = -rxt(358)*y(23) + mat(576) = -rxt(359)*y(23) + mat(314) = -rxt(365)*y(23) + mat(36) = -rxt(371)*y(23) + mat(585) = -rxt(372)*y(23) + mat(161) = -rxt(374)*y(23) + mat(368) = -rxt(377)*y(23) + mat(102) = -rxt(383)*y(23) + mat(57) = -rxt(385)*y(23) + mat(175) = -rxt(388)*y(23) + mat(60) = -rxt(389)*y(23) + mat(42) = -rxt(391)*y(23) + mat(45) = -rxt(394)*y(23) + mat(339) = -rxt(397)*y(23) + mat(227) = -rxt(402)*y(23) + mat(169) = -rxt(430)*y(23) + mat(416) = -rxt(431)*y(23) + mat(854) = -rxt(434)*y(23) + mat(592) = -rxt(441)*y(23) + mat(125) = -(rxt(443) + rxt(444)) * y(23) + mat(1117) = mat(1117) + rxt(164)*y(22) + rxt(177)*y(24) + .330_r8*rxt(314) & + *y(59) + .270_r8*rxt(360)*y(83) + .120_r8*rxt(293)*y(44) & + + .080_r8*rxt(336)*y(77) + .215_r8*rxt(342)*y(78) & + + .700_r8*rxt(398)*y(105) + mat(1072) = mat(1072) + rxt(175)*y(21) + rxt(271)*y(19) + rxt(176)*y(24) & + + rxt(179)*y(25) + rxt(227)*y(33) + rxt(228)*y(34) + rxt(247) & + *y(39) + rxt(248)*y(40) + mat(1143) = rxt(159)*y(21) + rxt(162)*y(42) + 2.000_r8*rxt(134)*y(134) & + + rxt(160)*y(33) + rxt(161)*y(39) + mat(694) = mat(694) + rxt(175)*y(2) + rxt(159)*y(3) + mat(1031) = rxt(191)*y(24) + mat(1527) = mat(1527) + .300_r8*rxt(278)*y(17) + .500_r8*rxt(323)*y(65) & + + .100_r8*rxt(349)*y(80) + .500_r8*rxt(299)*y(47) & + + .650_r8*rxt(286)*y(135) + mat(1365) = mat(1365) + rxt(203)*y(24) + mat(210) = mat(210) + .300_r8*rxt(278)*y(23) + mat(88) = mat(88) + rxt(162)*y(3) + mat(1228) = mat(1228) + rxt(271)*y(2) + mat(1248) = rxt(164)*y(1) + 2.000_r8*rxt(165)*y(24) + mat(1321) = mat(1321) + rxt(177)*y(1) + rxt(176)*y(2) + rxt(191)*y(9) & + + rxt(203)*y(11) + 2.000_r8*rxt(165)*y(22) + rxt(211)*y(28) & + + .206_r8*rxt(370)*y(89) + mat(350) = mat(350) + rxt(179)*y(2) + mat(1391) = 2.000_r8*rxt(134)*y(3) + rxt(250)*y(141) + mat(1426) = rxt(211)*y(24) + mat(872) = mat(872) + rxt(227)*y(2) + rxt(160)*y(3) + mat(536) = mat(536) + rxt(228)*y(2) + mat(503) = mat(503) + rxt(247)*y(2) + rxt(161)*y(3) + mat(439) = rxt(248)*y(2) + mat(635) = mat(635) + .330_r8*rxt(314)*y(1) + mat(576) = mat(576) + .270_r8*rxt(360)*y(1) + mat(330) = mat(330) + .500_r8*rxt(323)*y(23) + mat(298) = mat(298) + .120_r8*rxt(293)*y(1) + mat(791) = mat(791) + .080_r8*rxt(336)*y(1) + mat(681) = mat(681) + .215_r8*rxt(342)*y(1) + mat(153) = mat(153) + .100_r8*rxt(349)*y(23) + mat(158) = mat(158) + .500_r8*rxt(299)*y(23) + mat(339) = mat(339) + .700_r8*rxt(398)*y(1) + mat(485) = .206_r8*rxt(370)*y(24) + mat(119) = mat(119) + .650_r8*rxt(286)*y(23) + mat(448) = rxt(250)*y(134) + end subroutine nlnmat02 + subroutine nlnmat03( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(1362) = -(rxt(196)*y(10) + rxt(200)*y(9) + rxt(201)*y(2) + rxt(202)*y(23) & + + rxt(203)*y(24) + rxt(269)*y(19) + rxt(301)*y(50) + rxt(315) & + *y(59) + rxt(331)*y(68) + rxt(345)*y(79) + rxt(351)*y(76) & + + rxt(361)*y(83) + rxt(363)*y(88) + rxt(369)*y(89) + rxt(373) & + *y(90) + rxt(379)*y(91) + rxt(399)*y(105) + rxt(445)*y(157)) + mat(1177) = -rxt(196)*y(11) + mat(1028) = -rxt(200)*y(11) + mat(1069) = -rxt(201)*y(11) + mat(1524) = -rxt(202)*y(11) + mat(1318) = -rxt(203)*y(11) + mat(1225) = -rxt(269)*y(11) + mat(647) = -rxt(301)*y(11) + mat(633) = -rxt(315)*y(11) + mat(701) = -rxt(331)*y(11) + mat(768) = -rxt(345)*y(11) + mat(808) = -rxt(351)*y(11) + mat(574) = -rxt(361)*y(11) + mat(747) = -rxt(363)*y(11) + mat(484) = -rxt(369)*y(11) + mat(584) = -rxt(373)*y(11) + mat(720) = -rxt(379)*y(11) + mat(338) = -rxt(399)*y(11) + mat(124) = -rxt(445)*y(11) + mat(1114) = rxt(195)*y(10) + mat(1069) = mat(1069) + rxt(194)*y(10) + rxt(231)*y(35) + rxt(249)*y(41) + mat(1177) = mat(1177) + rxt(195)*y(1) + rxt(194)*y(2) + mat(1524) = mat(1524) + rxt(199)*y(12) + rxt(232)*y(35) + rxt(312)*y(58) & + + .500_r8*rxt(358)*y(81) + mat(971) = rxt(199)*y(23) + rxt(253)*y(141) + mat(1423) = rxt(233)*y(35) + mat(613) = rxt(231)*y(2) + rxt(232)*y(23) + rxt(233)*y(28) + mat(322) = rxt(249)*y(2) + mat(248) = rxt(312)*y(23) + mat(289) = .500_r8*rxt(358)*y(23) + mat(446) = rxt(253)*y(12) + mat(961) = -(rxt(199)*y(23) + rxt(253)*y(141)) + mat(1514) = -rxt(199)*y(12) + mat(444) = -rxt(253)*y(12) + mat(1167) = rxt(198)*y(23) + mat(1514) = mat(1514) + rxt(198)*y(10) + mat(1352) = rxt(269)*y(19) + rxt(301)*y(50) + rxt(331)*y(68) + rxt(445) & + *y(157) + mat(1215) = rxt(269)*y(11) + mat(863) = (rxt(449)+rxt(454)+rxt(460))*y(35) + mat(610) = (rxt(449)+rxt(454)+rxt(460))*y(33) + mat(644) = rxt(301)*y(11) + mat(698) = rxt(331)*y(11) + mat(122) = rxt(445)*y(11) + mat(236) = -(rxt(205)*y(23)) + mat(1461) = -rxt(205)*y(13) + mat(1147) = rxt(204)*y(24) + mat(1266) = rxt(204)*y(10) + mat(1146) = rxt(196)*y(11) + mat(1324) = rxt(196)*y(10) + mat(909) = -(rxt(218)*y(30) + rxt(273)*y(9) + rxt(274)*y(24) + (4._r8*rxt(275) & + + 4._r8*rxt(276)) * y(16) + rxt(297)*y(46) + rxt(305)*y(48) & + + rxt(318)*y(61) + rxt(327)*y(67) + rxt(347)*y(79) + rxt(353) & + *y(76) + rxt(366)*y(88) + rxt(381)*y(91)) + mat(1539) = -rxt(218)*y(16) + mat(1016) = -rxt(273)*y(16) + mat(1306) = -rxt(274)*y(16) + mat(523) = -rxt(297)*y(16) + mat(827) = -rxt(305)*y(16) + mat(544) = -rxt(318)*y(16) + mat(656) = -rxt(327)*y(16) + mat(761) = -rxt(347)*y(16) + mat(799) = -rxt(353)*y(16) + mat(739) = -rxt(366)*y(16) + mat(713) = -rxt(381)*y(16) + mat(1102) = .310_r8*rxt(314)*y(59) + mat(1016) = mat(1016) + rxt(302)*y(48) + mat(1512) = .700_r8*rxt(278)*y(17) + rxt(294)*y(49) + mat(909) = mat(909) + .900_r8*rxt(305)*y(48) + mat(206) = .700_r8*rxt(278)*y(23) + mat(626) = .310_r8*rxt(314)*y(1) + mat(341) = rxt(294)*y(23) + mat(827) = mat(827) + rxt(302)*y(9) + .900_r8*rxt(305)*y(16) & + + 4.000_r8*rxt(306)*y(48) + rxt(367)*y(88) + rxt(348)*y(79) & + + rxt(354)*y(76) + rxt(382)*y(91) + mat(739) = mat(739) + rxt(367)*y(48) + mat(761) = mat(761) + rxt(348)*y(48) + mat(799) = mat(799) + rxt(354)*y(48) + mat(713) = mat(713) + rxt(382)*y(48) + mat(205) = -(rxt(278)*y(23)) + mat(1457) = -rxt(278)*y(17) + mat(889) = rxt(274)*y(24) + mat(1262) = rxt(274)*y(16) + mat(85) = -(rxt(162)*y(3) + rxt(180)*y(23)) + mat(1122) = -rxt(162)*y(42) + mat(1439) = -rxt(180)*y(42) + mat(46) = -(rxt(181)*y(23)) + mat(1432) = -rxt(181)*y(43) + mat(1222) = -(rxt(212)*y(28) + rxt(236)*y(37) + rxt(269)*y(11) + rxt(270) & + *y(23) + rxt(271)*y(2) + rxt(272)*y(24)) + mat(1420) = -rxt(212)*y(19) + mat(882) = -rxt(236)*y(19) + mat(1359) = -rxt(269)*y(19) + mat(1521) = -rxt(270)*y(19) + mat(1066) = -rxt(271)*y(19) + mat(1315) = -rxt(272)*y(19) + mat(1111) = .540_r8*rxt(314)*y(59) + .600_r8*rxt(360)*y(83) + rxt(293)*y(44) & + + .800_r8*rxt(336)*y(77) + .700_r8*rxt(342)*y(78) + mat(1025) = rxt(273)*y(16) + rxt(321)*y(64) + .500_r8*rxt(334)*y(73) & + + .100_r8*rxt(375)*y(84) + .550_r8*rxt(362)*y(88) & + + .250_r8*rxt(343)*y(79) + rxt(350)*y(76) + .500_r8*rxt(289) & + *y(55) + rxt(325)*y(67) + .072_r8*rxt(368)*y(89) & + + .250_r8*rxt(378)*y(91) + mat(1521) = mat(1521) + .300_r8*rxt(278)*y(17) + .500_r8*rxt(307)*y(54) & + + rxt(312)*y(58) + .500_r8*rxt(358)*y(81) + rxt(277)*y(18) & + + .800_r8*rxt(308)*y(52) + mat(1359) = mat(1359) + .600_r8*rxt(363)*y(88) + .250_r8*rxt(345)*y(79) & + + rxt(351)*y(76) + .072_r8*rxt(369)*y(89) + mat(915) = rxt(273)*y(9) + (4.000_r8*rxt(275)+2.000_r8*rxt(276))*y(16) & + + rxt(218)*y(30) + rxt(305)*y(48) + 1.200_r8*rxt(366)*y(88) & + + .880_r8*rxt(347)*y(79) + 2.000_r8*rxt(353)*y(76) & + + .700_r8*rxt(297)*y(46) + rxt(318)*y(61) + .800_r8*rxt(327) & + *y(67) + .800_r8*rxt(381)*y(91) + mat(207) = .300_r8*rxt(278)*y(23) + mat(1315) = mat(1315) + .206_r8*rxt(370)*y(89) + mat(1548) = rxt(218)*y(16) + mat(631) = .540_r8*rxt(314)*y(1) + mat(572) = .600_r8*rxt(360)*y(1) + mat(493) = rxt(321)*y(9) + mat(833) = rxt(305)*y(16) + .600_r8*rxt(367)*y(88) + .250_r8*rxt(348)*y(79) & + + rxt(354)*y(76) + .250_r8*rxt(382)*y(91) + mat(265) = .500_r8*rxt(307)*y(23) + mat(247) = rxt(312)*y(23) + mat(296) = rxt(293)*y(1) + mat(287) = .500_r8*rxt(358)*y(23) + mat(142) = .500_r8*rxt(334)*y(9) + mat(401) = .100_r8*rxt(375)*y(9) + mat(744) = .550_r8*rxt(362)*y(9) + .600_r8*rxt(363)*y(11) + 1.200_r8*rxt(366) & + *y(16) + .600_r8*rxt(367)*y(48) + mat(786) = .800_r8*rxt(336)*y(1) + mat(677) = .700_r8*rxt(342)*y(1) + mat(765) = .250_r8*rxt(343)*y(9) + .250_r8*rxt(345)*y(11) + .880_r8*rxt(347) & + *y(16) + .250_r8*rxt(348)*y(48) + mat(805) = rxt(350)*y(9) + rxt(351)*y(11) + 2.000_r8*rxt(353)*y(16) & + + rxt(354)*y(48) + 4.000_r8*rxt(355)*y(76) + mat(527) = .700_r8*rxt(297)*y(16) + mat(548) = rxt(318)*y(16) + mat(304) = rxt(277)*y(23) + mat(555) = .800_r8*rxt(308)*y(23) + mat(428) = .500_r8*rxt(289)*y(9) + mat(660) = rxt(325)*y(9) + .800_r8*rxt(327)*y(16) + mat(482) = .072_r8*rxt(368)*y(9) + .072_r8*rxt(369)*y(11) + .206_r8*rxt(370) & + *y(24) + mat(717) = .250_r8*rxt(378)*y(9) + .800_r8*rxt(381)*y(16) + .250_r8*rxt(382) & + *y(48) + mat(1243) = -(rxt(163)*y(4) + rxt(164)*y(1) + (rxt(165) + rxt(166) + rxt(167) & + ) * y(24)) + mat(948) = -rxt(163)*y(22) + mat(1112) = -rxt(164)*y(22) + mat(1316) = -(rxt(165) + rxt(166) + rxt(167)) * y(22) + mat(1067) = rxt(175)*y(21) + rxt(168)*y(23) + mat(1138) = rxt(159)*y(21) + mat(690) = rxt(175)*y(2) + rxt(159)*y(3) + rxt(173)*y(23) + rxt(208)*y(28) & + + rxt(251)*y(141) + mat(637) = rxt(267)*y(23) + mat(516) = rxt(184)*y(23) + mat(1522) = rxt(168)*y(2) + rxt(173)*y(21) + rxt(267)*y(20) + rxt(184)*y(8) & + + rxt(270)*y(19) + rxt(430)*y(162) + rxt(431)*y(163) + rxt(434) & + *y(164) + mat(1223) = rxt(270)*y(23) + mat(1421) = rxt(208)*y(21) + mat(445) = rxt(251)*y(21) + mat(168) = rxt(430)*y(23) + mat(415) = rxt(431)*y(23) + mat(850) = rxt(434)*y(23) + mat(1317) = -((rxt(165) + rxt(166) + rxt(167)) * y(22) + rxt(170)*y(23) & + + rxt(176)*y(2) + rxt(177)*y(1) + 4._r8*rxt(178)*y(24) + rxt(191) & + *y(9) + rxt(203)*y(11) + rxt(204)*y(10) + (rxt(210) + rxt(211) & + ) * y(28) + rxt(217)*y(30) + rxt(235)*y(37) + rxt(239)*y(38) & + + rxt(272)*y(19) + rxt(274)*y(16) + rxt(282)*y(137) + rxt(290) & + *y(55) + rxt(296)*y(46) + rxt(304)*y(48) + rxt(317)*y(61) & + + rxt(322)*y(64) + rxt(326)*y(67) + rxt(339)*y(74) + rxt(346) & + *y(79) + rxt(352)*y(76) + rxt(364)*y(88) + rxt(370)*y(89) & + + rxt(376)*y(84) + rxt(380)*y(91) + rxt(387)*y(96) + rxt(392) & + *y(100) + rxt(395)*y(103) + rxt(401)*y(106)) + mat(1244) = -(rxt(165) + rxt(166) + rxt(167)) * y(24) + mat(1523) = -rxt(170)*y(24) + mat(1068) = -rxt(176)*y(24) + mat(1113) = -rxt(177)*y(24) + mat(1027) = -rxt(191)*y(24) + mat(1361) = -rxt(203)*y(24) + mat(1176) = -rxt(204)*y(24) + mat(1422) = -(rxt(210) + rxt(211)) * y(24) + mat(1550) = -rxt(217)*y(24) + mat(884) = -rxt(235)*y(24) + mat(1200) = -rxt(239)*y(24) + mat(1224) = -rxt(272)*y(24) + mat(917) = -rxt(274)*y(24) + mat(204) = -rxt(282)*y(24) + mat(429) = -rxt(290)*y(24) + mat(528) = -rxt(296)*y(24) + mat(835) = -rxt(304)*y(24) + mat(549) = -rxt(317)*y(24) + mat(494) = -rxt(322)*y(24) + mat(661) = -rxt(326)*y(24) + mat(375) = -rxt(339)*y(24) + mat(767) = -rxt(346)*y(24) + mat(807) = -rxt(352)*y(24) + mat(746) = -rxt(364)*y(24) + mat(483) = -rxt(370)*y(24) + mat(402) = -rxt(376)*y(24) + mat(719) = -rxt(380)*y(24) + mat(275) = -rxt(387)*y(24) + mat(182) = -rxt(392)*y(24) + mat(235) = -rxt(395)*y(24) + mat(603) = -rxt(401)*y(24) + mat(1113) = mat(1113) + rxt(169)*y(23) + .190_r8*rxt(314)*y(59) & + + .060_r8*rxt(360)*y(83) + .120_r8*rxt(293)*y(44) & + + .060_r8*rxt(336)*y(77) + .275_r8*rxt(342)*y(78) + rxt(398) & + *y(105) + mat(1068) = mat(1068) + rxt(271)*y(19) + rxt(179)*y(25) + mat(949) = rxt(163)*y(22) + rxt(291)*y(56) + mat(638) = rxt(268)*y(23) + mat(1027) = mat(1027) + rxt(273)*y(16) + rxt(321)*y(64) + rxt(334)*y(73) & + + .900_r8*rxt(375)*y(84) + .900_r8*rxt(386)*y(96) + rxt(400) & + *y(106) + .900_r8*rxt(393)*y(100) + .900_r8*rxt(396)*y(103) & + + .920_r8*rxt(362)*y(88) + .470_r8*rxt(343)*y(79) + rxt(295) & + *y(46) + rxt(316)*y(61) + .250_r8*rxt(289)*y(55) & + + .794_r8*rxt(368)*y(89) + rxt(378)*y(91) + rxt(281)*y(137) + mat(1176) = mat(1176) + .700_r8*rxt(390)*y(98) + mat(1523) = mat(1523) + rxt(169)*y(1) + rxt(268)*y(20) + rxt(202)*y(11) & + + rxt(180)*y(42) + rxt(181)*y(43) + rxt(174)*y(25) + rxt(215) & + *y(30) + rxt(238)*y(38) + .500_r8*rxt(358)*y(81) & + + .250_r8*rxt(385)*y(94) + rxt(309)*y(53) + .200_r8*rxt(349) & + *y(80) + rxt(277)*y(18) + rxt(310)*y(51) + rxt(308)*y(52) & + + rxt(329)*y(66) + rxt(372)*y(90) + .350_r8*rxt(286)*y(135) & + + rxt(279)*y(136) + rxt(441)*y(156) + .500_r8*rxt(444)*y(157) + mat(1361) = mat(1361) + rxt(202)*y(23) + rxt(269)*y(19) + rxt(363)*y(88) & + + .470_r8*rxt(345)*y(79) + .794_r8*rxt(369)*y(89) + rxt(373) & + *y(90) + rxt(379)*y(91) + mat(917) = mat(917) + rxt(273)*y(9) + 4.000_r8*rxt(275)*y(16) + rxt(218) & + *y(30) + .900_r8*rxt(305)*y(48) + rxt(366)*y(88) & + + .730_r8*rxt(347)*y(79) + rxt(353)*y(76) + rxt(297)*y(46) & + + rxt(318)*y(61) + .300_r8*rxt(327)*y(67) + .800_r8*rxt(381) & + *y(91) + mat(87) = rxt(180)*y(23) + mat(47) = rxt(181)*y(23) + mat(1224) = mat(1224) + rxt(271)*y(2) + rxt(269)*y(11) + rxt(212)*y(28) & + + rxt(236)*y(37) + mat(1244) = mat(1244) + rxt(163)*y(4) + mat(347) = rxt(179)*y(2) + rxt(174)*y(23) + rxt(209)*y(28) + mat(1422) = mat(1422) + rxt(212)*y(19) + rxt(209)*y(25) + mat(1550) = mat(1550) + rxt(215)*y(23) + rxt(218)*y(16) + mat(884) = mat(884) + rxt(236)*y(19) + mat(1200) = mat(1200) + rxt(238)*y(23) + mat(632) = .190_r8*rxt(314)*y(1) + mat(573) = .060_r8*rxt(360)*y(1) + mat(494) = mat(494) + rxt(321)*y(9) + mat(835) = mat(835) + .900_r8*rxt(305)*y(16) + rxt(367)*y(88) & + + .470_r8*rxt(348)*y(79) + rxt(382)*y(91) + mat(297) = .120_r8*rxt(293)*y(1) + mat(288) = .500_r8*rxt(358)*y(23) + mat(143) = rxt(334)*y(9) + mat(402) = mat(402) + .900_r8*rxt(375)*y(9) + mat(56) = .250_r8*rxt(385)*y(23) + mat(275) = mat(275) + .900_r8*rxt(386)*y(9) + mat(80) = .700_r8*rxt(390)*y(10) + mat(603) = mat(603) + rxt(400)*y(9) + mat(419) = rxt(309)*y(23) + mat(182) = mat(182) + .900_r8*rxt(393)*y(9) + mat(235) = mat(235) + .900_r8*rxt(396)*y(9) + mat(746) = mat(746) + .920_r8*rxt(362)*y(9) + rxt(363)*y(11) + rxt(366)*y(16) & + + rxt(367)*y(48) + mat(788) = .060_r8*rxt(336)*y(1) + mat(679) = .275_r8*rxt(342)*y(1) + mat(767) = mat(767) + .470_r8*rxt(343)*y(9) + .470_r8*rxt(345)*y(11) & + + .730_r8*rxt(347)*y(16) + .470_r8*rxt(348)*y(48) + mat(152) = .200_r8*rxt(349)*y(23) + mat(807) = mat(807) + rxt(353)*y(16) + mat(528) = mat(528) + rxt(295)*y(9) + rxt(297)*y(16) + 2.400_r8*rxt(298) & + *y(46) + mat(337) = rxt(398)*y(1) + mat(549) = mat(549) + rxt(316)*y(9) + rxt(318)*y(16) + mat(305) = rxt(277)*y(23) + mat(97) = rxt(310)*y(23) + mat(556) = rxt(308)*y(23) + mat(668) = rxt(329)*y(23) + mat(429) = mat(429) + .250_r8*rxt(289)*y(9) + mat(220) = rxt(291)*y(4) + mat(661) = mat(661) + .300_r8*rxt(327)*y(16) + mat(483) = mat(483) + .794_r8*rxt(368)*y(9) + .794_r8*rxt(369)*y(11) + mat(583) = rxt(372)*y(23) + rxt(373)*y(11) + mat(719) = mat(719) + rxt(378)*y(9) + rxt(379)*y(11) + .800_r8*rxt(381)*y(16) & + + rxt(382)*y(48) + mat(118) = .350_r8*rxt(286)*y(23) + mat(300) = rxt(279)*y(23) + mat(204) = mat(204) + rxt(281)*y(9) + mat(590) = rxt(441)*y(23) + mat(123) = .500_r8*rxt(444)*y(23) + end subroutine nlnmat03 + subroutine nlnmat04( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(344) = -(rxt(174)*y(23) + rxt(179)*y(2) + rxt(209)*y(28)) + mat(1474) = -rxt(174)*y(25) + mat(1039) = -rxt(179)*y(25) + mat(1398) = -rxt(209)*y(25) + mat(1474) = mat(1474) + 2.000_r8*rxt(172)*y(23) + mat(1274) = 2.000_r8*rxt(178)*y(24) + mat(1389) = -(rxt(134)*y(3) + rxt(250)*y(141) + rxt(442)*y(165)) + mat(1141) = -rxt(134)*y(134) + mat(447) = -rxt(250)*y(134) + mat(107) = -rxt(442)*y(134) + mat(692) = rxt(173)*y(23) + mat(1525) = rxt(173)*y(21) + 2.000_r8*rxt(171)*y(23) + rxt(199)*y(12) & + + rxt(205)*y(13) + rxt(278)*y(17) + rxt(270)*y(19) + rxt(170) & + *y(24) + rxt(174)*y(25) + rxt(226)*y(33) + rxt(230)*y(34) & + + rxt(246)*y(39) + rxt(300)*y(50) + rxt(294)*y(49) + rxt(323) & + *y(65) + rxt(307)*y(54) + rxt(287)*y(45) + .500_r8*rxt(341) & + *y(78) + rxt(320)*y(60) + rxt(319)*y(62) + rxt(324)*y(63) & + + rxt(328)*y(69) + rxt(330)*y(68) + (rxt(383)+rxt(384))*y(92) & + + rxt(279)*y(136) + mat(972) = rxt(199)*y(23) + mat(241) = rxt(205)*y(23) + mat(209) = rxt(278)*y(23) + mat(1226) = rxt(270)*y(23) + mat(1246) = rxt(167)*y(24) + mat(1319) = rxt(170)*y(23) + rxt(167)*y(22) + mat(348) = rxt(174)*y(23) + mat(870) = rxt(226)*y(23) + (rxt(450)+rxt(455)+rxt(461))*y(34) + (rxt(451) & + +rxt(462))*y(40) + mat(534) = rxt(230)*y(23) + (rxt(450)+rxt(455)+rxt(461))*y(33) + mat(502) = rxt(246)*y(23) + mat(437) = (rxt(451)+rxt(462))*y(33) + mat(648) = rxt(300)*y(23) + mat(342) = rxt(294)*y(23) + mat(329) = rxt(323)*y(23) + mat(266) = rxt(307)*y(23) + mat(111) = rxt(287)*y(23) + mat(680) = .500_r8*rxt(341)*y(23) + mat(51) = rxt(320)*y(23) + mat(191) = rxt(319)*y(23) + mat(408) = rxt(324)*y(23) + mat(197) = rxt(328)*y(23) + mat(702) = rxt(330)*y(23) + mat(101) = (rxt(383)+rxt(384))*y(23) + mat(301) = rxt(279)*y(23) + mat(1425) = -(rxt(207)*y(1) + rxt(208)*y(21) + rxt(209)*y(25) + (rxt(210) & + + rxt(211)) * y(24) + rxt(212)*y(19) + rxt(229)*y(34) + rxt(233) & + *y(35) + rxt(285)*y(45)) + mat(1116) = -rxt(207)*y(28) + mat(693) = -rxt(208)*y(28) + mat(349) = -rxt(209)*y(28) + mat(1320) = -(rxt(210) + rxt(211)) * y(28) + mat(1227) = -rxt(212)*y(28) + mat(535) = -rxt(229)*y(28) + mat(615) = -rxt(233)*y(28) + mat(112) = -rxt(285)*y(28) + mat(1071) = rxt(214)*y(30) + rxt(227)*y(33) + mat(1142) = rxt(160)*y(33) + rxt(155)*y(139) + mat(1030) = rxt(219)*y(30) + mat(1526) = rxt(215)*y(30) + rxt(226)*y(33) + mat(920) = rxt(218)*y(30) + mat(1553) = rxt(214)*y(2) + rxt(219)*y(9) + rxt(215)*y(23) + rxt(218)*y(16) + ( & + + 4.000_r8*rxt(221)+2.000_r8*rxt(223))*y(30) + rxt(243)*y(38) & + + rxt(438)*y(164) + mat(871) = rxt(227)*y(2) + rxt(160)*y(3) + rxt(226)*y(23) + mat(1203) = rxt(243)*y(30) + mat(84) = rxt(155)*y(3) + mat(853) = rxt(438)*y(30) + mat(1393) = rxt(233)*y(35) + mat(1530) = 2.000_r8*rxt(222)*y(30) + mat(856) = (rxt(450)+rxt(455)+rxt(461))*y(34) + (rxt(449)+rxt(454)+rxt(460)) & + *y(35) + mat(530) = (rxt(450)+rxt(455)+rxt(461))*y(33) + mat(606) = rxt(233)*y(28) + (rxt(449)+rxt(454)+rxt(460))*y(33) + mat(1555) = -(rxt(214)*y(2) + (rxt(215) + rxt(216)) * y(23) + rxt(217)*y(24) & + + rxt(218)*y(16) + rxt(219)*y(9) + rxt(220)*y(10) + (4._r8*rxt(221) & + + 4._r8*rxt(222) + 4._r8*rxt(223) + 4._r8*rxt(224)) * y(30) & + + (rxt(242) + rxt(243) + rxt(244)) * y(38) + rxt(438)*y(164)) + mat(1073) = -rxt(214)*y(30) + mat(1528) = -(rxt(215) + rxt(216)) * y(30) + mat(1322) = -rxt(217)*y(30) + mat(922) = -rxt(218)*y(30) + mat(1032) = -rxt(219)*y(30) + mat(1181) = -rxt(220)*y(30) + mat(1205) = -(rxt(242) + rxt(243) + rxt(244)) * y(30) + mat(855) = -rxt(438)*y(30) + mat(1118) = rxt(207)*y(28) + mat(1073) = mat(1073) + rxt(228)*y(34) + rxt(231)*y(35) + mat(1528) = mat(1528) + rxt(230)*y(34) + mat(1322) = mat(1322) + rxt(211)*y(28) + mat(1427) = rxt(207)*y(1) + rxt(211)*y(24) + rxt(229)*y(34) + mat(136) = rxt(440)*y(164) + mat(537) = rxt(228)*y(2) + rxt(230)*y(23) + rxt(229)*y(28) + mat(617) = rxt(231)*y(2) + mat(855) = mat(855) + rxt(440)*y(31) + mat(132) = -(rxt(440)*y(164)) + mat(839) = -rxt(440)*y(31) + mat(1532) = 2.000_r8*rxt(223)*y(30) + rxt(242)*y(38) + mat(1183) = rxt(242)*y(30) + mat(1529) = 2.000_r8*rxt(224)*y(30) + mat(861) = -(rxt(160)*y(3) + rxt(226)*y(23) + rxt(227)*y(2) + (rxt(449) & + + rxt(454) + rxt(460)) * y(35) + (rxt(450) + rxt(455) + rxt(461) & + ) * y(34) + (rxt(451) + rxt(462)) * y(40)) + mat(1126) = -rxt(160)*y(33) + mat(1510) = -rxt(226)*y(33) + mat(1055) = -rxt(227)*y(33) + mat(609) = -(rxt(449) + rxt(454) + rxt(460)) * y(33) + mat(532) = -(rxt(450) + rxt(455) + rxt(461)) * y(33) + mat(433) = -(rxt(451) + rxt(462)) * y(33) + mat(685) = rxt(208)*y(28) + mat(1510) = mat(1510) + rxt(216)*y(30) + mat(1211) = rxt(212)*y(28) + mat(1304) = rxt(210)*y(28) + mat(345) = rxt(209)*y(28) + mat(1409) = rxt(208)*y(21) + rxt(212)*y(19) + rxt(210)*y(24) + rxt(209)*y(25) & + + rxt(229)*y(34) + rxt(285)*y(45) + mat(1537) = rxt(216)*y(23) + mat(532) = mat(532) + rxt(229)*y(28) + mat(110) = rxt(285)*y(28) + mat(531) = -(rxt(228)*y(2) + rxt(229)*y(28) + rxt(230)*y(23) + (rxt(450) & + + rxt(455) + rxt(461)) * y(33)) + mat(1049) = -rxt(228)*y(34) + mat(1402) = -rxt(229)*y(34) + mat(1487) = -rxt(230)*y(34) + mat(859) = -(rxt(450) + rxt(455) + rxt(461)) * y(34) + mat(1487) = mat(1487) + rxt(232)*y(35) + mat(1286) = rxt(217)*y(30) + mat(1533) = rxt(217)*y(24) + mat(607) = rxt(232)*y(23) + mat(608) = -(rxt(231)*y(2) + rxt(232)*y(23) + rxt(233)*y(28) + (rxt(449) & + + rxt(454) + rxt(460)) * y(33)) + mat(1051) = -rxt(231)*y(35) + mat(1494) = -rxt(232)*y(35) + mat(1404) = -rxt(233)*y(35) + mat(860) = -(rxt(449) + rxt(454) + rxt(460)) * y(35) + mat(1156) = rxt(220)*y(30) + mat(1535) = rxt(220)*y(10) + mat(1531) = rxt(244)*y(38) + mat(857) = (rxt(451)+rxt(462))*y(40) + mat(1182) = rxt(244)*y(30) + mat(431) = (rxt(451)+rxt(462))*y(33) + mat(876) = -(rxt(234)*y(1) + rxt(235)*y(24) + rxt(236)*y(19)) + mat(1101) = -rxt(234)*y(37) + mat(1305) = -rxt(235)*y(37) + mat(1212) = -rxt(236)*y(37) + mat(1056) = rxt(237)*y(38) + rxt(247)*y(39) + mat(1127) = rxt(161)*y(39) + mat(1015) = rxt(240)*y(38) + mat(1511) = rxt(238)*y(38) + rxt(246)*y(39) + mat(1538) = (rxt(242)+rxt(243))*y(38) + mat(1189) = rxt(237)*y(2) + rxt(240)*y(9) + rxt(238)*y(23) + (rxt(242) & + +rxt(243))*y(30) + 4.000_r8*rxt(245)*y(38) + rxt(439)*y(164) + mat(498) = rxt(247)*y(2) + rxt(161)*y(3) + rxt(246)*y(23) + mat(843) = rxt(439)*y(38) + mat(1197) = -(rxt(237)*y(2) + rxt(238)*y(23) + rxt(239)*y(24) + rxt(240)*y(9) & + + rxt(241)*y(10) + (rxt(242) + rxt(243) + rxt(244)) * y(30) & + + 4._r8*rxt(245)*y(38) + rxt(439)*y(164)) + mat(1065) = -rxt(237)*y(38) + mat(1520) = -rxt(238)*y(38) + mat(1314) = -rxt(239)*y(38) + mat(1024) = -rxt(240)*y(38) + mat(1173) = -rxt(241)*y(38) + mat(1547) = -(rxt(242) + rxt(243) + rxt(244)) * y(38) + mat(849) = -rxt(439)*y(38) + mat(1110) = rxt(234)*y(37) + mat(1065) = mat(1065) + rxt(248)*y(40) + rxt(249)*y(41) + mat(881) = rxt(234)*y(1) + mat(436) = rxt(248)*y(2) + mat(321) = rxt(249)*y(2) + mat(497) = -(rxt(161)*y(3) + rxt(246)*y(23) + rxt(247)*y(2)) + mat(1124) = -rxt(161)*y(39) + mat(1484) = -rxt(246)*y(39) + mat(1047) = -rxt(247)*y(39) + mat(1208) = rxt(236)*y(37) + mat(1284) = rxt(235)*y(37) + mat(874) = rxt(236)*y(19) + rxt(235)*y(24) + mat(432) = -(rxt(248)*y(2) + (rxt(451) + rxt(462)) * y(33)) + mat(1043) = -rxt(248)*y(40) + mat(858) = -(rxt(451) + rxt(462)) * y(40) + mat(1281) = rxt(239)*y(38) + mat(1185) = rxt(239)*y(24) + mat(315) = -(rxt(249)*y(2)) + mat(1038) = -rxt(249)*y(41) + mat(1151) = rxt(241)*y(38) + mat(1184) = rxt(241)*y(10) + mat(379) = -((rxt(465) + rxt(466)) * y(2) + rxt(473)*y(4) + rxt(477)*y(132)) + mat(1041) = -(rxt(465) + rxt(466)) * y(127) + mat(929) = -rxt(473)*y(127) + mat(466) = -rxt(477)*y(127) + mat(449) = -(rxt(468)*y(8) + rxt(469)*y(9) + rxt(476)*y(132)) + mat(506) = -rxt(468)*y(128) + mat(992) = -rxt(469)*y(128) + mat(467) = -rxt(476)*y(128) + mat(931) = rxt(473)*y(127) + rxt(470)*y(129) + rxt(463)*y(130) + mat(380) = rxt(473)*y(4) + mat(252) = rxt(470)*y(4) + mat(352) = rxt(463)*y(4) + mat(250) = -((rxt(470) + rxt(471)) * y(4) + rxt(472)*y(2)) + mat(926) = -(rxt(470) + rxt(471)) * y(129) + mat(1036) = -rxt(472)*y(129) + mat(351) = -(rxt(463)*y(4)) + mat(928) = -rxt(463)*y(130) + mat(1040) = rxt(466)*y(127) + rxt(472)*y(129) + mat(378) = rxt(466)*y(2) + mat(251) = rxt(472)*y(2) + end subroutine nlnmat04 + subroutine nlnmat05( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(458) = -(rxt(475)*y(132)) + mat(468) = -rxt(475)*y(131) + mat(1045) = rxt(465)*y(127) + mat(932) = rxt(471)*y(129) + mat(507) = rxt(468)*y(128) + mat(993) = rxt(469)*y(128) + mat(381) = rxt(465)*y(2) + mat(450) = rxt(468)*y(8) + rxt(469)*y(9) + mat(253) = rxt(471)*y(4) + mat(257) = -(rxt(182)*y(4) + rxt(183)*y(2)) + mat(927) = -rxt(182)*y(133) + mat(1037) = -rxt(183)*y(133) + mat(1037) = mat(1037) + rxt(465)*y(127) + mat(377) = rxt(465)*y(2) + .900_r8*rxt(477)*y(132) + mat(457) = .800_r8*rxt(475)*y(132) + mat(465) = .900_r8*rxt(477)*y(127) + .800_r8*rxt(475)*y(131) + mat(469) = -(rxt(475)*y(131) + rxt(476)*y(128) + rxt(477)*y(127)) + mat(459) = -rxt(475)*y(132) + mat(451) = -rxt(476)*y(132) + mat(382) = -rxt(477)*y(132) + mat(621) = -(rxt(313)*y(23) + rxt(314)*y(1) + rxt(315)*y(11)) + mat(1495) = -rxt(313)*y(59) + mat(1087) = -rxt(314)*y(59) + mat(1335) = -rxt(315)*y(59) + mat(1087) = mat(1087) + .070_r8*rxt(360)*y(83) + mat(562) = .070_r8*rxt(360)*y(1) + mat(560) = -(rxt(359)*y(23) + rxt(360)*y(1) + rxt(361)*y(11)) + mat(1490) = -rxt(359)*y(83) + mat(1083) = -rxt(360)*y(83) + mat(1331) = -rxt(361)*y(83) + mat(487) = -(rxt(321)*y(9) + rxt(322)*y(24)) + mat(996) = -rxt(321)*y(64) + mat(1283) = -rxt(322)*y(64) + mat(1483) = rxt(313)*y(59) + .500_r8*rxt(323)*y(65) + mat(620) = rxt(313)*y(23) + mat(324) = .500_r8*rxt(323)*y(23) + mat(641) = -(rxt(300)*y(23) + rxt(301)*y(11)) + mat(1497) = -rxt(300)*y(50) + mat(1337) = -rxt(301)*y(50) + mat(1089) = .500_r8*rxt(314)*y(59) + .040_r8*rxt(336)*y(77) + mat(1004) = rxt(321)*y(64) + rxt(334)*y(73) + .400_r8*rxt(375)*y(84) & + + rxt(338)*y(74) + rxt(295)*y(46) + .270_r8*rxt(316)*y(61) + mat(1497) = mat(1497) + .500_r8*rxt(299)*y(47) + rxt(310)*y(51) + mat(898) = .800_r8*rxt(297)*y(46) + mat(623) = .500_r8*rxt(314)*y(1) + mat(488) = rxt(321)*y(9) + mat(139) = rxt(334)*y(9) + mat(396) = .400_r8*rxt(375)*y(9) + mat(371) = rxt(338)*y(9) + mat(773) = .040_r8*rxt(336)*y(1) + mat(522) = rxt(295)*y(9) + .800_r8*rxt(297)*y(16) + 3.200_r8*rxt(298)*y(46) + mat(156) = .500_r8*rxt(299)*y(23) + mat(541) = .270_r8*rxt(316)*y(9) + mat(96) = rxt(310)*y(23) + mat(340) = -(rxt(294)*y(23)) + mat(1473) = -rxt(294)*y(49) + mat(1079) = .250_r8*rxt(314)*y(59) + .200_r8*rxt(360)*y(83) + mat(891) = .100_r8*rxt(305)*y(48) + mat(1273) = .250_r8*rxt(304)*y(48) + .250_r8*rxt(352)*y(76) + mat(619) = .250_r8*rxt(314)*y(1) + mat(558) = .200_r8*rxt(360)*y(1) + mat(814) = .100_r8*rxt(305)*y(16) + .250_r8*rxt(304)*y(24) + mat(794) = .250_r8*rxt(352)*y(24) + mat(323) = -(rxt(323)*y(23)) + mat(1471) = -rxt(323)*y(65) + mat(1272) = rxt(322)*y(64) + mat(486) = rxt(322)*y(24) + mat(826) = -(rxt(302)*y(9) + rxt(303)*y(10) + rxt(304)*y(24) + rxt(305)*y(16) & + + 4._r8*rxt(306)*y(48) + rxt(348)*y(79) + rxt(367)*y(88) + rxt(382) & + *y(91)) + mat(1014) = -rxt(302)*y(48) + mat(1161) = -rxt(303)*y(48) + mat(1303) = -rxt(304)*y(48) + mat(908) = -rxt(305)*y(48) + mat(760) = -rxt(348)*y(48) + mat(738) = -rxt(367)*y(48) + mat(712) = -rxt(382)*y(48) + mat(1014) = mat(1014) + rxt(338)*y(74) + .530_r8*rxt(343)*y(79) + rxt(350) & + *y(76) + rxt(325)*y(67) + mat(1508) = rxt(300)*y(50) + .500_r8*rxt(307)*y(54) + rxt(330)*y(68) + mat(1347) = rxt(301)*y(50) + .530_r8*rxt(345)*y(79) + rxt(351)*y(76) & + + rxt(331)*y(68) + mat(908) = mat(908) + .260_r8*rxt(347)*y(79) + rxt(353)*y(76) & + + .300_r8*rxt(327)*y(67) + mat(642) = rxt(300)*y(23) + rxt(301)*y(11) + mat(826) = mat(826) + .530_r8*rxt(348)*y(79) + mat(263) = .500_r8*rxt(307)*y(23) + mat(372) = rxt(338)*y(9) + mat(760) = mat(760) + .530_r8*rxt(343)*y(9) + .530_r8*rxt(345)*y(11) & + + .260_r8*rxt(347)*y(16) + .530_r8*rxt(348)*y(48) + mat(798) = rxt(350)*y(9) + rxt(351)*y(11) + rxt(353)*y(16) & + + 4.000_r8*rxt(355)*y(76) + mat(655) = rxt(325)*y(9) + .300_r8*rxt(327)*y(16) + mat(697) = rxt(330)*y(23) + rxt(331)*y(11) + mat(262) = -(rxt(307)*y(23)) + mat(1463) = -rxt(307)*y(54) + mat(1267) = .750_r8*rxt(304)*y(48) + .750_r8*rxt(352)*y(76) + mat(813) = .750_r8*rxt(304)*y(24) + mat(792) = .750_r8*rxt(352)*y(24) + mat(243) = -(rxt(312)*y(23)) + mat(1462) = -rxt(312)*y(58) + mat(1148) = rxt(303)*y(48) + mat(812) = rxt(303)*y(10) + mat(183) = -(rxt(332)*y(23)) + mat(1454) = -rxt(332)*y(82) + mat(979) = .100_r8*rxt(375)*y(84) + mat(1326) = rxt(315)*y(59) + mat(618) = rxt(315)*y(11) + mat(389) = .100_r8*rxt(375)*y(9) + mat(108) = -(rxt(285)*y(28) + rxt(287)*y(23)) + mat(1394) = -rxt(285)*y(45) + mat(1443) = -rxt(287)*y(45) + mat(291) = -(rxt(284)*y(28) + rxt(288)*y(23) + rxt(293)*y(1)) + mat(1396) = -rxt(284)*y(44) + mat(1467) = -rxt(288)*y(44) + mat(1076) = -rxt(293)*y(44) + mat(34) = -(rxt(371)*y(23)) + mat(1428) = -rxt(371)*y(71) + mat(283) = -(rxt(358)*y(23)) + mat(1466) = -rxt(358)*y(81) + mat(1150) = rxt(356)*y(76) + mat(793) = rxt(356)*y(10) + mat(37) = -(rxt(333)*y(23)) + mat(1429) = -rxt(333)*y(70) + mat(137) = -(rxt(334)*y(9)) + mat(976) = -rxt(334)*y(73) + mat(1446) = rxt(333)*y(70) + mat(38) = rxt(333)*y(23) + mat(393) = -(rxt(375)*y(9) + rxt(376)*y(24)) + mat(988) = -rxt(375)*y(84) + mat(1277) = -rxt(376)*y(84) + mat(1477) = rxt(371)*y(71) + rxt(377)*y(85) + mat(35) = rxt(371)*y(23) + mat(361) = rxt(377)*y(23) + mat(359) = -(rxt(377)*y(23)) + mat(1475) = -rxt(377)*y(85) + mat(1275) = rxt(376)*y(84) + mat(391) = rxt(376)*y(24) + mat(211) = -(rxt(337)*y(23)) + mat(1458) = -rxt(337)*y(72) + mat(981) = .800_r8*rxt(375)*y(84) + mat(390) = .800_r8*rxt(375)*y(9) + mat(370) = -(rxt(338)*y(9) + rxt(339)*y(24)) + mat(987) = -rxt(338)*y(74) + mat(1276) = -rxt(339)*y(74) + mat(1476) = rxt(337)*y(72) + rxt(340)*y(75) + mat(212) = rxt(337)*y(23) + mat(145) = rxt(340)*y(23) + mat(144) = -(rxt(340)*y(23)) + mat(1447) = -rxt(340)*y(75) + mat(1254) = rxt(339)*y(74) + mat(369) = rxt(339)*y(24) + mat(53) = -(rxt(385)*y(23)) + mat(1434) = -rxt(385)*y(94) + mat(58) = -(rxt(389)*y(23)) + mat(1435) = -rxt(389)*y(95) + mat(1435) = mat(1435) + .250_r8*rxt(385)*y(94) + mat(54) = .250_r8*rxt(385)*y(23) + mat(269) = -(rxt(386)*y(9) + rxt(387)*y(24)) + mat(984) = -rxt(386)*y(96) + mat(1268) = -rxt(387)*y(96) + mat(1464) = .700_r8*rxt(385)*y(94) + rxt(388)*y(97) + mat(55) = .700_r8*rxt(385)*y(23) + mat(171) = rxt(388)*y(23) + mat(170) = -(rxt(388)*y(23)) + mat(1452) = -rxt(388)*y(97) + mat(1257) = rxt(387)*y(96) + mat(268) = rxt(387)*y(24) + mat(77) = -(rxt(390)*y(10)) + mat(1145) = -rxt(390)*y(98) + mat(1437) = rxt(389)*y(95) + mat(59) = rxt(389)*y(23) + mat(595) = -(rxt(400)*y(9) + rxt(401)*y(24)) + mat(1002) = -rxt(400)*y(106) + mat(1290) = -rxt(401)*y(106) + mat(1493) = rxt(402)*y(107) + rxt(397)*y(105) + mat(1334) = rxt(399)*y(105) + mat(223) = rxt(402)*y(23) + mat(332) = rxt(397)*y(23) + rxt(399)*y(11) + mat(221) = -(rxt(402)*y(23)) + mat(1459) = -rxt(402)*y(107) + mat(1264) = rxt(401)*y(106) + mat(593) = rxt(401)*y(24) + mat(985) = .900_r8*rxt(386)*y(96) + .900_r8*rxt(393)*y(100) & + + .620_r8*rxt(396)*y(103) + mat(1149) = .700_r8*rxt(390)*y(98) + mat(270) = .900_r8*rxt(386)*y(9) + mat(78) = .700_r8*rxt(390)*y(10) + mat(178) = .900_r8*rxt(393)*y(9) + mat(230) = .620_r8*rxt(396)*y(9) + mat(417) = -(rxt(309)*y(23)) + mat(1480) = -rxt(309)*y(53) + mat(990) = .450_r8*rxt(386)*y(96) + .900_r8*rxt(393)*y(100) & + + .340_r8*rxt(396)*y(103) + .020_r8*rxt(362)*y(88) & + + .250_r8*rxt(378)*y(91) + mat(1480) = mat(1480) + .200_r8*rxt(308)*y(52) + .650_r8*rxt(286)*y(135) + mat(1328) = .250_r8*rxt(379)*y(91) + mat(893) = .100_r8*rxt(381)*y(91) + mat(815) = .250_r8*rxt(382)*y(91) + mat(271) = .450_r8*rxt(386)*y(9) + mat(179) = .900_r8*rxt(393)*y(9) + mat(231) = .340_r8*rxt(396)*y(9) + mat(726) = .020_r8*rxt(362)*y(9) + mat(552) = .200_r8*rxt(308)*y(23) + mat(706) = .250_r8*rxt(378)*y(9) + .250_r8*rxt(379)*y(11) + .100_r8*rxt(381) & + *y(16) + .250_r8*rxt(382)*y(48) + mat(116) = .650_r8*rxt(286)*y(23) + end subroutine nlnmat05 + subroutine nlnmat06( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(40) = -(rxt(391)*y(23)) + mat(1430) = -rxt(391)*y(99) + mat(177) = -(rxt(392)*y(24) + rxt(393)*y(9)) + mat(1258) = -rxt(392)*y(100) + mat(978) = -rxt(393)*y(100) + mat(1453) = rxt(391)*y(99) + mat(41) = rxt(391)*y(23) + mat(1250) = rxt(392)*y(100) + mat(176) = rxt(392)*y(24) + mat(43) = -(rxt(394)*y(23)) + mat(1431) = -rxt(394)*y(102) + mat(229) = -(rxt(395)*y(24) + rxt(396)*y(9)) + mat(1265) = -rxt(395)*y(103) + mat(983) = -rxt(396)*y(103) + mat(1460) = rxt(394)*y(102) + mat(44) = rxt(394)*y(23) + mat(1251) = rxt(395)*y(103) + mat(228) = rxt(395)*y(24) + mat(734) = -(rxt(362)*y(9) + rxt(363)*y(11) + rxt(364)*y(24) + rxt(366)*y(16) & + + rxt(367)*y(48)) + mat(1010) = -rxt(362)*y(88) + mat(1343) = -rxt(363)*y(88) + mat(1299) = -rxt(364)*y(88) + mat(904) = -rxt(366)*y(88) + mat(822) = -rxt(367)*y(88) + mat(1504) = rxt(359)*y(83) + .200_r8*rxt(365)*y(93) + mat(565) = rxt(359)*y(23) + mat(310) = .200_r8*rxt(365)*y(23) + mat(777) = -(rxt(335)*y(23) + rxt(336)*y(1)) + mat(1506) = -rxt(335)*y(77) + mat(1097) = -rxt(336)*y(77) + mat(1097) = mat(1097) + .200_r8*rxt(360)*y(83) + rxt(398)*y(105) + mat(1012) = rxt(400)*y(106) + .320_r8*rxt(362)*y(88) + .039_r8*rxt(368)*y(89) + mat(1345) = .350_r8*rxt(363)*y(88) + .039_r8*rxt(369)*y(89) + mat(906) = .260_r8*rxt(366)*y(88) + mat(1301) = .039_r8*rxt(370)*y(89) + mat(566) = .200_r8*rxt(360)*y(1) + mat(824) = .350_r8*rxt(367)*y(88) + mat(598) = rxt(400)*y(9) + mat(736) = .320_r8*rxt(362)*y(9) + .350_r8*rxt(363)*y(11) + .260_r8*rxt(366) & + *y(16) + .350_r8*rxt(367)*y(48) + mat(334) = rxt(398)*y(1) + mat(479) = .039_r8*rxt(368)*y(9) + .039_r8*rxt(369)*y(11) + .039_r8*rxt(370) & + *y(24) + mat(671) = -(rxt(341)*y(23) + rxt(342)*y(1)) + mat(1500) = -rxt(341)*y(78) + mat(1092) = -rxt(342)*y(78) + mat(1092) = mat(1092) + .400_r8*rxt(360)*y(83) + rxt(398)*y(105) + mat(1007) = rxt(400)*y(106) + .230_r8*rxt(362)*y(88) + .167_r8*rxt(368)*y(89) + mat(1340) = .250_r8*rxt(363)*y(88) + .167_r8*rxt(369)*y(89) + mat(901) = .190_r8*rxt(366)*y(88) + mat(1295) = .167_r8*rxt(370)*y(89) + mat(564) = .400_r8*rxt(360)*y(1) + mat(819) = .250_r8*rxt(367)*y(88) + mat(597) = rxt(400)*y(9) + mat(731) = .230_r8*rxt(362)*y(9) + .250_r8*rxt(363)*y(11) + .190_r8*rxt(366) & + *y(16) + .250_r8*rxt(367)*y(48) + mat(333) = rxt(398)*y(1) + mat(478) = .167_r8*rxt(368)*y(9) + .167_r8*rxt(369)*y(11) + .167_r8*rxt(370) & + *y(24) + mat(758) = -((rxt(343) + rxt(344)) * y(9) + rxt(345)*y(11) + rxt(346)*y(24) & + + rxt(347)*y(16) + rxt(348)*y(48)) + mat(1011) = -(rxt(343) + rxt(344)) * y(79) + mat(1344) = -rxt(345)*y(79) + mat(1300) = -rxt(346)*y(79) + mat(905) = -rxt(347)*y(79) + mat(823) = -rxt(348)*y(79) + mat(1505) = rxt(335)*y(77) + .500_r8*rxt(341)*y(78) + .200_r8*rxt(349)*y(80) + mat(776) = rxt(335)*y(23) + mat(673) = .500_r8*rxt(341)*y(23) + mat(150) = .200_r8*rxt(349)*y(23) + mat(149) = -(rxt(349)*y(23)) + mat(1448) = -rxt(349)*y(80) + mat(1255) = rxt(346)*y(79) + mat(750) = rxt(346)*y(24) + mat(797) = -(rxt(350)*y(9) + rxt(351)*y(11) + rxt(352)*y(24) + rxt(353)*y(16) & + + rxt(354)*y(48) + 4._r8*rxt(355)*y(76) + rxt(356)*y(10)) + mat(1013) = -rxt(350)*y(76) + mat(1346) = -rxt(351)*y(76) + mat(1302) = -rxt(352)*y(76) + mat(907) = -rxt(353)*y(76) + mat(825) = -rxt(354)*y(76) + mat(1160) = -rxt(356)*y(76) + mat(1098) = .200_r8*rxt(360)*y(83) + mat(1507) = .500_r8*rxt(341)*y(78) + .500_r8*rxt(349)*y(80) + mat(567) = .200_r8*rxt(360)*y(1) + mat(674) = .500_r8*rxt(341)*y(23) + mat(151) = .500_r8*rxt(349)*y(23) + mat(521) = -(rxt(295)*y(9) + rxt(296)*y(24) + rxt(297)*y(16) + 4._r8*rxt(298) & + *y(46)) + mat(998) = -rxt(295)*y(46) + mat(1285) = -rxt(296)*y(46) + mat(894) = -rxt(297)*y(46) + mat(1486) = rxt(287)*y(45) + .500_r8*rxt(299)*y(47) + mat(1401) = rxt(285)*y(45) + mat(109) = rxt(287)*y(23) + rxt(285)*y(28) + mat(155) = .500_r8*rxt(299)*y(23) + mat(154) = -(rxt(299)*y(23)) + mat(1449) = -rxt(299)*y(47) + mat(1256) = rxt(296)*y(46) + mat(519) = rxt(296)*y(24) + mat(331) = -(rxt(397)*y(23) + rxt(398)*y(1) + rxt(399)*y(11)) + mat(1472) = -rxt(397)*y(105) + mat(1078) = -rxt(398)*y(105) + mat(1327) = -rxt(399)*y(105) + mat(49) = -(rxt(320)*y(23)) + mat(1433) = -rxt(320)*y(60) + mat(540) = -(rxt(316)*y(9) + rxt(317)*y(24) + rxt(318)*y(16)) + mat(999) = -rxt(316)*y(61) + mat(1287) = -rxt(317)*y(61) + mat(895) = -rxt(318)*y(61) + mat(1488) = rxt(320)*y(60) + rxt(319)*y(62) + mat(50) = rxt(320)*y(23) + mat(189) = rxt(319)*y(23) + mat(187) = -(rxt(319)*y(23)) + mat(1455) = -rxt(319)*y(62) + mat(1259) = rxt(317)*y(61) + mat(538) = rxt(317)*y(24) + mat(404) = -(rxt(324)*y(23)) + mat(1478) = -rxt(324)*y(63) + mat(989) = .500_r8*rxt(334)*y(73) + .250_r8*rxt(375)*y(84) + .100_r8*rxt(400) & + *y(106) + .820_r8*rxt(316)*y(61) + mat(892) = .820_r8*rxt(318)*y(61) + mat(138) = .500_r8*rxt(334)*y(9) + mat(394) = .250_r8*rxt(375)*y(9) + mat(594) = .100_r8*rxt(400)*y(9) + mat(539) = .820_r8*rxt(316)*y(9) + .820_r8*rxt(318)*y(16) + mat(193) = -(rxt(328)*y(23)) + mat(1456) = -rxt(328)*y(69) + mat(1260) = rxt(326)*y(67) + mat(650) = rxt(326)*y(24) + mat(303) = -(rxt(277)*y(23)) + mat(1469) = -rxt(277)*y(18) + mat(890) = 2.000_r8*rxt(276)*y(16) + .250_r8*rxt(366)*y(88) & + + .250_r8*rxt(347)*y(79) + .300_r8*rxt(297)*y(46) & + + .500_r8*rxt(327)*y(67) + .300_r8*rxt(381)*y(91) + mat(724) = .250_r8*rxt(366)*y(16) + mat(751) = .250_r8*rxt(347)*y(16) + mat(520) = .300_r8*rxt(297)*y(16) + mat(651) = .500_r8*rxt(327)*y(16) + mat(705) = .300_r8*rxt(381)*y(16) + mat(95) = -(rxt(310)*y(23)) + mat(1440) = -rxt(310)*y(51) + mat(887) = .200_r8*rxt(297)*y(46) + mat(518) = .200_r8*rxt(297)*y(16) + .800_r8*rxt(298)*y(46) + mat(553) = -(rxt(308)*y(23)) + mat(1489) = -rxt(308)*y(52) + mat(935) = rxt(291)*y(56) + mat(1000) = .020_r8*rxt(362)*y(88) + .530_r8*rxt(343)*y(79) & + + .250_r8*rxt(378)*y(91) + mat(1330) = .530_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(896) = .260_r8*rxt(347)*y(79) + .100_r8*rxt(381)*y(91) + mat(816) = .530_r8*rxt(348)*y(79) + .250_r8*rxt(382)*y(91) + mat(727) = .020_r8*rxt(362)*y(9) + mat(752) = .530_r8*rxt(343)*y(9) + .530_r8*rxt(345)*y(11) + .260_r8*rxt(347) & + *y(16) + .530_r8*rxt(348)*y(48) + mat(217) = rxt(291)*y(4) + mat(707) = .250_r8*rxt(378)*y(9) + .250_r8*rxt(379)*y(11) + .100_r8*rxt(381) & + *y(16) + .250_r8*rxt(382)*y(48) + mat(664) = -(rxt(329)*y(23)) + mat(1499) = -rxt(329)*y(66) + mat(1006) = .020_r8*rxt(362)*y(88) + .220_r8*rxt(343)*y(79) & + + .250_r8*rxt(378)*y(91) + mat(1499) = mat(1499) + .500_r8*rxt(323)*y(65) + .500_r8*rxt(358)*y(81) + mat(1339) = .220_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(900) = .230_r8*rxt(347)*y(79) + .200_r8*rxt(327)*y(67) + .100_r8*rxt(381) & + *y(91) + mat(326) = .500_r8*rxt(323)*y(23) + mat(818) = .220_r8*rxt(348)*y(79) + .250_r8*rxt(382)*y(91) + mat(284) = .500_r8*rxt(358)*y(23) + mat(730) = .020_r8*rxt(362)*y(9) + mat(755) = .220_r8*rxt(343)*y(9) + .220_r8*rxt(345)*y(11) + .230_r8*rxt(347) & + *y(16) + .220_r8*rxt(348)*y(48) + mat(653) = .200_r8*rxt(327)*y(16) + mat(709) = .250_r8*rxt(378)*y(9) + .250_r8*rxt(379)*y(11) + .100_r8*rxt(381) & + *y(16) + .250_r8*rxt(382)*y(48) + mat(423) = -(rxt(289)*y(9) + rxt(290)*y(24)) + mat(991) = -rxt(289)*y(55) + mat(1280) = -rxt(290)*y(55) + mat(1481) = rxt(288)*y(44) + mat(293) = rxt(288)*y(23) + mat(216) = -(rxt(291)*y(4)) + mat(925) = -rxt(291)*y(56) + mat(982) = .750_r8*rxt(289)*y(55) + mat(422) = .750_r8*rxt(289)*y(9) + mat(1252) = rxt(290)*y(55) + mat(421) = rxt(290)*y(24) + mat(159) = -(rxt(374)*y(23)) + mat(1450) = -rxt(374)*y(87) + mat(977) = .330_r8*rxt(362)*y(88) + mat(1450) = mat(1450) + rxt(372)*y(90) + mat(1325) = .400_r8*rxt(363)*y(88) + rxt(373)*y(90) + mat(888) = .300_r8*rxt(366)*y(88) + mat(811) = .400_r8*rxt(367)*y(88) + mat(723) = .330_r8*rxt(362)*y(9) + .400_r8*rxt(363)*y(11) + .300_r8*rxt(366) & + *y(16) + .400_r8*rxt(367)*y(48) + mat(577) = rxt(372)*y(23) + rxt(373)*y(11) + mat(652) = -(rxt(325)*y(9) + rxt(326)*y(24) + rxt(327)*y(16)) + mat(1005) = -rxt(325)*y(67) + mat(1293) = -rxt(326)*y(67) + mat(899) = -rxt(327)*y(67) + mat(1498) = rxt(324)*y(63) + rxt(328)*y(69) + mat(405) = rxt(324)*y(23) + mat(194) = rxt(328)*y(23) + end subroutine nlnmat06 + subroutine nlnmat07( mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat(696) = -(rxt(330)*y(23) + rxt(331)*y(11)) + mat(1502) = -rxt(330)*y(68) + mat(1341) = -rxt(331)*y(68) + mat(1093) = .950_r8*rxt(336)*y(77) + .800_r8*rxt(342)*y(78) + mat(1008) = .450_r8*rxt(386)*y(96) + .540_r8*rxt(396)*y(103) & + + .020_r8*rxt(362)*y(88) + .250_r8*rxt(343)*y(79) & + + .250_r8*rxt(378)*y(91) + mat(1502) = mat(1502) + rxt(332)*y(82) + rxt(329)*y(66) + mat(1341) = mat(1341) + .250_r8*rxt(345)*y(79) + .250_r8*rxt(379)*y(91) + mat(902) = .240_r8*rxt(347)*y(79) + .500_r8*rxt(327)*y(67) + .100_r8*rxt(381) & + *y(91) + mat(820) = .250_r8*rxt(348)*y(79) + .250_r8*rxt(382)*y(91) + mat(184) = rxt(332)*y(23) + mat(272) = .450_r8*rxt(386)*y(9) + mat(232) = .540_r8*rxt(396)*y(9) + mat(732) = .020_r8*rxt(362)*y(9) + mat(775) = .950_r8*rxt(336)*y(1) + mat(672) = .800_r8*rxt(342)*y(1) + mat(756) = .250_r8*rxt(343)*y(9) + .250_r8*rxt(345)*y(11) + .240_r8*rxt(347) & + *y(16) + .250_r8*rxt(348)*y(48) + mat(665) = rxt(329)*y(23) + mat(654) = .500_r8*rxt(327)*y(16) + mat(710) = .250_r8*rxt(378)*y(9) + .250_r8*rxt(379)*y(11) + .100_r8*rxt(381) & + *y(16) + .250_r8*rxt(382)*y(48) + mat(476) = -(rxt(368)*y(9) + rxt(369)*y(11) + rxt(370)*y(24)) + mat(995) = -rxt(368)*y(89) + mat(1329) = -rxt(369)*y(89) + mat(1282) = -rxt(370)*y(89) + mat(1329) = mat(1329) + rxt(361)*y(83) + mat(559) = rxt(361)*y(11) + mat(578) = -(rxt(372)*y(23) + rxt(373)*y(11)) + mat(1491) = -rxt(372)*y(90) + mat(1332) = -rxt(373)*y(90) + mat(1001) = .080_r8*rxt(362)*y(88) + .800_r8*rxt(344)*y(79) & + + .794_r8*rxt(368)*y(89) + mat(1332) = mat(1332) + .794_r8*rxt(369)*y(89) + mat(1289) = .794_r8*rxt(370)*y(89) + mat(728) = .080_r8*rxt(362)*y(9) + mat(753) = .800_r8*rxt(344)*y(9) + mat(477) = .794_r8*rxt(368)*y(9) + .794_r8*rxt(369)*y(11) + .794_r8*rxt(370) & + *y(24) + mat(711) = -(rxt(378)*y(9) + rxt(379)*y(11) + rxt(380)*y(24) + rxt(381)*y(16) & + + rxt(382)*y(48)) + mat(1009) = -rxt(378)*y(91) + mat(1342) = -rxt(379)*y(91) + mat(1298) = -rxt(380)*y(91) + mat(903) = -rxt(381)*y(91) + mat(821) = -rxt(382)*y(91) + mat(1503) = rxt(374)*y(87) + rxt(383)*y(92) + .800_r8*rxt(365)*y(93) + mat(160) = rxt(374)*y(23) + mat(100) = rxt(383)*y(23) + mat(309) = .800_r8*rxt(365)*y(23) + mat(99) = -((rxt(383) + rxt(384)) * y(23)) + mat(1441) = -(rxt(383) + rxt(384)) * y(92) + mat(1253) = rxt(380)*y(91) + mat(704) = rxt(380)*y(24) + mat(307) = -(rxt(365)*y(23)) + mat(1470) = -rxt(365)*y(93) + mat(1271) = rxt(364)*y(88) + mat(725) = rxt(364)*y(24) + mat(114) = -(rxt(283)*y(28) + rxt(286)*y(23)) + mat(1395) = -rxt(283)*y(135) + mat(1444) = -rxt(286)*y(135) + mat(299) = -(rxt(279)*y(23)) + mat(1468) = -rxt(279)*y(136) + mat(1077) = .500_r8*rxt(293)*y(44) + mat(986) = rxt(281)*y(137) + mat(1468) = mat(1468) + .350_r8*rxt(286)*y(135) + mat(1270) = rxt(282)*y(137) + mat(292) = .500_r8*rxt(293)*y(1) + mat(115) = .350_r8*rxt(286)*y(23) + mat(200) = rxt(281)*y(9) + rxt(282)*y(24) + mat(199) = -(rxt(281)*y(9) + rxt(282)*y(24)) + mat(980) = -rxt(281)*y(137) + mat(1261) = -rxt(282)*y(137) + mat(1206) = rxt(272)*y(24) + mat(1261) = mat(1261) + rxt(272)*y(19) + mat(64) = -(rxt(154)*y(3)) + mat(1119) = -rxt(154)*y(138) + mat(81) = -(rxt(155)*y(3)) + mat(1121) = -rxt(155)*y(139) + mat(682) = rxt(251)*y(141) + mat(954) = rxt(253)*y(141) + mat(1368) = rxt(250)*y(141) + mat(440) = rxt(251)*y(21) + rxt(253)*y(12) + rxt(250)*y(134) + mat(441) = -(rxt(250)*y(134) + rxt(251)*y(21) + rxt(253)*y(12)) + mat(1370) = -rxt(250)*y(141) + mat(683) = -rxt(251)*y(141) + mat(955) = -rxt(253)*y(141) + mat(1123) = 2.000_r8*rxt(154)*y(138) + rxt(155)*y(139) + mat(65) = 2.000_r8*rxt(154)*y(3) + mat(82) = rxt(155)*y(3) + mat(587) = -(rxt(441)*y(23)) + mat(1492) = -rxt(441)*y(156) + mat(1085) = rxt(436)*y(164) + mat(936) = rxt(435)*y(164) + mat(1155) = rxt(437)*y(164) + mat(1492) = mat(1492) + (rxt(443)+.500_r8*rxt(444))*y(157) + rxt(430)*y(162) & + + rxt(434)*y(164) + mat(1333) = rxt(445)*y(157) + mat(1534) = rxt(438)*y(164) + mat(133) = rxt(440)*y(164) + mat(1186) = rxt(439)*y(164) + mat(121) = (rxt(443)+.500_r8*rxt(444))*y(23) + rxt(445)*y(11) + mat(164) = rxt(430)*y(23) + mat(841) = rxt(436)*y(1) + rxt(435)*y(4) + rxt(437)*y(10) + rxt(434)*y(23) & + + rxt(438)*y(30) + rxt(440)*y(31) + rxt(439)*y(38) + mat(120) = -((rxt(443) + rxt(444)) * y(23) + rxt(445)*y(11)) + mat(1445) = -(rxt(443) + rxt(444)) * y(157) + mat(1323) = -rxt(445)*y(157) + mat(162) = -(rxt(429)*y(2) + rxt(430)*y(23)) + mat(1035) = -rxt(429)*y(162) + mat(1451) = -rxt(430)*y(162) + mat(410) = -(rxt(431)*y(23) + rxt(432)*y(4) + rxt(433)*y(1)) + mat(1479) = -rxt(431)*y(163) + mat(930) = -rxt(432)*y(163) + mat(1080) = -rxt(433)*y(163) + mat(842) = -(rxt(434)*y(23) + rxt(435)*y(4) + rxt(436)*y(1) + rxt(437)*y(10) & + + rxt(438)*y(30) + rxt(439)*y(38) + rxt(440)*y(31)) + mat(1509) = -rxt(434)*y(164) + mat(938) = -rxt(435)*y(164) + mat(1100) = -rxt(436)*y(164) + mat(1162) = -rxt(437)*y(164) + mat(1536) = -rxt(438)*y(164) + mat(1187) = -rxt(439)*y(164) + mat(134) = -rxt(440)*y(164) + mat(1100) = mat(1100) + rxt(433)*y(163) + mat(1054) = rxt(429)*y(162) + mat(938) = mat(938) + rxt(432)*y(163) + mat(1509) = mat(1509) + rxt(431)*y(163) + mat(166) = rxt(429)*y(2) + mat(411) = rxt(433)*y(1) + rxt(432)*y(4) + rxt(431)*y(23) + mat(104) = -(rxt(442)*y(134)) + mat(1369) = -rxt(442)*y(165) + mat(1442) = rxt(441)*y(156) + mat(586) = rxt(441)*y(23) + mat(1367) = rxt(442)*y(165) + mat(103) = rxt(442)*y(134) + end subroutine nlnmat07 + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = lmat( 33) + mat( 34) = mat( 34) + lmat( 34) + mat( 37) = mat( 37) + lmat( 37) + mat( 40) = mat( 40) + lmat( 40) + mat( 43) = mat( 43) + lmat( 43) + mat( 46) = mat( 46) + lmat( 46) + mat( 49) = mat( 49) + lmat( 49) + mat( 53) = mat( 53) + lmat( 53) + mat( 58) = mat( 58) + lmat( 58) + mat( 61) = lmat( 61) + mat( 62) = lmat( 62) + mat( 63) = lmat( 63) + mat( 64) = mat( 64) + lmat( 64) + mat( 65) = mat( 65) + lmat( 65) + mat( 67) = mat( 67) + lmat( 67) + mat( 68) = mat( 68) + lmat( 68) + mat( 69) = mat( 69) + lmat( 69) + mat( 70) = mat( 70) + lmat( 70) + mat( 71) = lmat( 71) + mat( 72) = lmat( 72) + mat( 73) = lmat( 73) + mat( 74) = lmat( 74) + mat( 75) = lmat( 75) + mat( 76) = lmat( 76) + mat( 77) = mat( 77) + lmat( 77) + mat( 81) = mat( 81) + lmat( 81) + mat( 82) = mat( 82) + lmat( 82) + mat( 84) = mat( 84) + lmat( 84) + mat( 85) = mat( 85) + lmat( 85) + mat( 89) = lmat( 89) + mat( 90) = lmat( 90) + mat( 91) = lmat( 91) + mat( 92) = lmat( 92) + mat( 93) = lmat( 93) + mat( 94) = lmat( 94) + mat( 95) = mat( 95) + lmat( 95) + mat( 99) = mat( 99) + lmat( 99) + mat( 102) = mat( 102) + lmat( 102) + mat( 104) = mat( 104) + lmat( 104) + mat( 105) = lmat( 105) + mat( 106) = lmat( 106) + mat( 108) = mat( 108) + lmat( 108) + mat( 114) = mat( 114) + lmat( 114) + mat( 120) = mat( 120) + lmat( 120) + mat( 126) = lmat( 126) + mat( 127) = lmat( 127) + mat( 128) = lmat( 128) + mat( 129) = lmat( 129) + mat( 130) = lmat( 130) + mat( 131) = lmat( 131) + mat( 132) = mat( 132) + lmat( 132) + mat( 135) = lmat( 135) + mat( 136) = mat( 136) + lmat( 136) + mat( 137) = mat( 137) + lmat( 137) + mat( 144) = mat( 144) + lmat( 144) + mat( 146) = lmat( 146) + mat( 147) = lmat( 147) + mat( 148) = mat( 148) + lmat( 148) + mat( 149) = mat( 149) + lmat( 149) + mat( 154) = mat( 154) + lmat( 154) + mat( 156) = mat( 156) + lmat( 156) + mat( 157) = lmat( 157) + mat( 158) = mat( 158) + lmat( 158) + mat( 159) = mat( 159) + lmat( 159) + mat( 162) = mat( 162) + lmat( 162) + mat( 163) = lmat( 163) + mat( 165) = mat( 165) + lmat( 165) + mat( 170) = mat( 170) + lmat( 170) + mat( 172) = lmat( 172) + mat( 173) = lmat( 173) + mat( 174) = lmat( 174) + mat( 175) = mat( 175) + lmat( 175) + mat( 177) = mat( 177) + lmat( 177) + mat( 183) = mat( 183) + lmat( 183) + mat( 187) = mat( 187) + lmat( 187) + mat( 188) = lmat( 188) + mat( 190) = lmat( 190) + mat( 192) = mat( 192) + lmat( 192) + mat( 193) = mat( 193) + lmat( 193) + mat( 195) = lmat( 195) + mat( 196) = lmat( 196) + mat( 198) = mat( 198) + lmat( 198) + mat( 199) = mat( 199) + lmat( 199) + mat( 203) = lmat( 203) + mat( 204) = mat( 204) + lmat( 204) + mat( 205) = mat( 205) + lmat( 205) + mat( 207) = mat( 207) + lmat( 207) + mat( 208) = lmat( 208) + mat( 210) = mat( 210) + lmat( 210) + mat( 211) = mat( 211) + lmat( 211) + mat( 213) = lmat( 213) + mat( 214) = lmat( 214) + mat( 216) = mat( 216) + lmat( 216) + mat( 219) = lmat( 219) + mat( 220) = mat( 220) + lmat( 220) + mat( 221) = mat( 221) + lmat( 221) + mat( 222) = lmat( 222) + mat( 224) = lmat( 224) + mat( 225) = lmat( 225) + mat( 226) = lmat( 226) + mat( 227) = mat( 227) + lmat( 227) + mat( 229) = mat( 229) + lmat( 229) + mat( 236) = mat( 236) + lmat( 236) + mat( 238) = mat( 238) + lmat( 238) + mat( 239) = lmat( 239) + mat( 240) = lmat( 240) + mat( 242) = mat( 242) + lmat( 242) + mat( 243) = mat( 243) + lmat( 243) + mat( 244) = lmat( 244) + mat( 245) = lmat( 245) + mat( 246) = lmat( 246) + mat( 248) = mat( 248) + lmat( 248) + mat( 250) = mat( 250) + lmat( 250) + mat( 257) = mat( 257) + lmat( 257) + mat( 262) = mat( 262) + lmat( 262) + mat( 264) = lmat( 264) + mat( 267) = mat( 267) + lmat( 267) + mat( 269) = mat( 269) + lmat( 269) + mat( 277) = lmat( 277) + mat( 278) = lmat( 278) + mat( 279) = lmat( 279) + mat( 280) = lmat( 280) + mat( 281) = lmat( 281) + mat( 282) = lmat( 282) + mat( 283) = mat( 283) + lmat( 283) + mat( 285) = lmat( 285) + mat( 286) = lmat( 286) + mat( 291) = mat( 291) + lmat( 291) + mat( 299) = mat( 299) + lmat( 299) + mat( 303) = mat( 303) + lmat( 303) + mat( 307) = mat( 307) + lmat( 307) + mat( 308) = lmat( 308) + mat( 311) = lmat( 311) + mat( 312) = lmat( 312) + mat( 313) = lmat( 313) + mat( 315) = mat( 315) + lmat( 315) + mat( 316) = lmat( 316) + mat( 317) = lmat( 317) + mat( 318) = lmat( 318) + mat( 320) = lmat( 320) + mat( 321) = mat( 321) + lmat( 321) + mat( 322) = mat( 322) + lmat( 322) + mat( 323) = mat( 323) + lmat( 323) + mat( 325) = lmat( 325) + mat( 327) = lmat( 327) + mat( 328) = lmat( 328) + mat( 330) = mat( 330) + lmat( 330) + mat( 331) = mat( 331) + lmat( 331) + mat( 340) = mat( 340) + lmat( 340) + mat( 344) = mat( 344) + lmat( 344) + mat( 350) = mat( 350) + lmat( 350) + mat( 351) = mat( 351) + lmat( 351) + mat( 352) = mat( 352) + lmat( 352) + mat( 353) = lmat( 353) + mat( 354) = lmat( 354) + mat( 355) = lmat( 355) + mat( 358) = lmat( 358) + mat( 359) = mat( 359) + lmat( 359) + mat( 362) = lmat( 362) + mat( 364) = lmat( 364) + mat( 366) = lmat( 366) + mat( 367) = lmat( 367) + mat( 368) = mat( 368) + lmat( 368) + mat( 370) = mat( 370) + lmat( 370) + mat( 379) = mat( 379) + lmat( 379) + mat( 393) = mat( 393) + lmat( 393) + mat( 404) = mat( 404) + lmat( 404) + mat( 406) = lmat( 406) + mat( 407) = lmat( 407) + mat( 410) = mat( 410) + lmat( 410) + mat( 417) = mat( 417) + lmat( 417) + mat( 418) = mat( 418) + lmat( 418) + mat( 419) = mat( 419) + lmat( 419) + mat( 423) = mat( 423) + lmat( 423) + mat( 432) = mat( 432) + lmat( 432) + mat( 434) = lmat( 434) + mat( 439) = mat( 439) + lmat( 439) + mat( 440) = mat( 440) + lmat( 440) + mat( 441) = mat( 441) + lmat( 441) + mat( 443) = lmat( 443) + mat( 449) = mat( 449) + lmat( 449) + mat( 450) = mat( 450) + lmat( 450) + mat( 454) = mat( 454) + lmat( 454) + mat( 458) = mat( 458) + lmat( 458) + mat( 469) = mat( 469) + lmat( 469) + mat( 476) = mat( 476) + lmat( 476) + mat( 487) = mat( 487) + lmat( 487) + mat( 497) = mat( 497) + lmat( 497) + mat( 498) = mat( 498) + lmat( 498) + mat( 501) = lmat( 501) + mat( 504) = lmat( 504) + mat( 508) = lmat( 508) + mat( 509) = mat( 509) + lmat( 509) + mat( 521) = mat( 521) + lmat( 521) + mat( 531) = mat( 531) + lmat( 531) + mat( 535) = mat( 535) + lmat( 535) + mat( 536) = mat( 536) + lmat( 536) + mat( 540) = mat( 540) + lmat( 540) + mat( 553) = mat( 553) + lmat( 553) + mat( 554) = lmat( 554) + mat( 555) = mat( 555) + lmat( 555) + mat( 556) = mat( 556) + lmat( 556) + mat( 560) = mat( 560) + lmat( 560) + mat( 578) = mat( 578) + lmat( 578) + mat( 579) = lmat( 579) + mat( 581) = mat( 581) + lmat( 581) + mat( 582) = lmat( 582) + mat( 583) = mat( 583) + lmat( 583) + mat( 587) = mat( 587) + lmat( 587) + mat( 588) = lmat( 588) + mat( 589) = lmat( 589) + mat( 595) = mat( 595) + lmat( 595) + mat( 607) = mat( 607) + lmat( 607) + mat( 608) = mat( 608) + lmat( 608) + mat( 610) = mat( 610) + lmat( 610) + mat( 612) = lmat( 612) + mat( 613) = mat( 613) + lmat( 613) + mat( 615) = mat( 615) + lmat( 615) + mat( 617) = mat( 617) + lmat( 617) + mat( 621) = mat( 621) + lmat( 621) + mat( 636) = mat( 636) + lmat( 636) + mat( 640) = lmat( 640) + mat( 641) = mat( 641) + lmat( 641) + mat( 643) = lmat( 643) + mat( 646) = lmat( 646) + mat( 652) = mat( 652) + lmat( 652) + mat( 664) = mat( 664) + lmat( 664) + mat( 666) = lmat( 666) + mat( 667) = lmat( 667) + mat( 668) = mat( 668) + lmat( 668) + mat( 670) = mat( 670) + lmat( 670) + mat( 671) = mat( 671) + lmat( 671) + mat( 674) = mat( 674) + lmat( 674) + mat( 675) = lmat( 675) + mat( 677) = mat( 677) + lmat( 677) + mat( 679) = mat( 679) + lmat( 679) + mat( 684) = mat( 684) + lmat( 684) + mat( 695) = mat( 695) + lmat( 695) + mat( 696) = mat( 696) + lmat( 696) + mat( 697) = mat( 697) + lmat( 697) + mat( 700) = lmat( 700) + mat( 711) = mat( 711) + lmat( 711) + mat( 734) = mat( 734) + lmat( 734) + mat( 758) = mat( 758) + lmat( 758) + mat( 771) = lmat( 771) + mat( 772) = mat( 772) + lmat( 772) + mat( 777) = mat( 777) + lmat( 777) + mat( 779) = lmat( 779) + mat( 780) = lmat( 780) + mat( 797) = mat( 797) + lmat( 797) + mat( 826) = mat( 826) + lmat( 826) + mat( 840) = lmat( 840) + mat( 842) = mat( 842) + lmat( 842) + mat( 846) = mat( 846) + lmat( 846) + mat( 861) = mat( 861) + lmat( 861) + mat( 868) = lmat( 868) + mat( 871) = mat( 871) + lmat( 871) + mat( 876) = mat( 876) + lmat( 876) + mat( 909) = mat( 909) + lmat( 909) + mat( 928) = mat( 928) + lmat( 928) + mat( 931) = mat( 931) + lmat( 931) + mat( 933) = lmat( 933) + mat( 940) = mat( 940) + lmat( 940) + mat( 942) = mat( 942) + lmat( 942) + mat( 944) = mat( 944) + lmat( 944) + mat( 961) = mat( 961) + lmat( 961) + mat( 966) = lmat( 966) + mat( 974) = mat( 974) + lmat( 974) + mat( 993) = mat( 993) + lmat( 993) + mat( 994) = lmat( 994) + mat( 997) = mat( 997) + lmat( 997) + mat(1019) = mat(1019) + lmat(1019) + mat(1020) = mat(1020) + lmat(1020) + mat(1040) = mat(1040) + lmat(1040) + mat(1046) = lmat(1046) + mat(1061) = mat(1061) + lmat(1061) + mat(1074) = mat(1074) + lmat(1074) + mat(1103) = mat(1103) + lmat(1103) + mat(1106) = mat(1106) + lmat(1106) + mat(1107) = mat(1107) + lmat(1107) + mat(1108) = mat(1108) + lmat(1108) + mat(1119) = mat(1119) + lmat(1119) + mat(1121) = mat(1121) + lmat(1121) + mat(1123) = mat(1123) + lmat(1123) + mat(1125) = mat(1125) + lmat(1125) + mat(1127) = mat(1127) + lmat(1127) + mat(1128) = lmat(1128) + mat(1129) = mat(1129) + lmat(1129) + mat(1131) = lmat(1131) + mat(1132) = mat(1132) + lmat(1132) + mat(1134) = mat(1134) + lmat(1134) + mat(1137) = lmat(1137) + mat(1138) = mat(1138) + lmat(1138) + mat(1139) = lmat(1139) + mat(1142) = mat(1142) + lmat(1142) + mat(1143) = mat(1143) + lmat(1143) + mat(1167) = mat(1167) + lmat(1167) + mat(1168) = mat(1168) + lmat(1168) + mat(1169) = mat(1169) + lmat(1169) + mat(1172) = mat(1172) + lmat(1172) + mat(1180) = mat(1180) + lmat(1180) + mat(1189) = mat(1189) + lmat(1189) + mat(1193) = mat(1193) + lmat(1193) + mat(1197) = mat(1197) + lmat(1197) + mat(1209) = mat(1209) + lmat(1209) + mat(1210) = lmat(1210) + mat(1222) = mat(1222) + lmat(1222) + mat(1223) = mat(1223) + lmat(1223) + mat(1243) = mat(1243) + lmat(1243) + mat(1274) = mat(1274) + lmat(1274) + mat(1317) = mat(1317) + lmat(1317) + mat(1351) = mat(1351) + lmat(1351) + mat(1352) = mat(1352) + lmat(1352) + mat(1353) = mat(1353) + lmat(1353) + mat(1354) = mat(1354) + lmat(1354) + mat(1357) = mat(1357) + lmat(1357) + mat(1362) = mat(1362) + lmat(1362) + mat(1372) = lmat(1372) + mat(1380) = lmat(1380) + mat(1382) = mat(1382) + lmat(1382) + mat(1386) = lmat(1386) + mat(1389) = mat(1389) + lmat(1389) + mat(1391) = mat(1391) + lmat(1391) + mat(1405) = mat(1405) + lmat(1405) + mat(1409) = mat(1409) + lmat(1409) + mat(1410) = lmat(1410) + mat(1411) = lmat(1411) + mat(1422) = mat(1422) + lmat(1422) + mat(1425) = mat(1425) + lmat(1425) + mat(1436) = lmat(1436) + mat(1438) = lmat(1438) + mat(1511) = mat(1511) + lmat(1511) + mat(1512) = mat(1512) + lmat(1512) + mat(1523) = mat(1523) + lmat(1523) + mat(1525) = mat(1525) + lmat(1525) + mat(1526) = mat(1526) + lmat(1526) + mat(1527) = mat(1527) + lmat(1527) + mat(1543) = mat(1543) + lmat(1543) + mat(1553) = mat(1553) + lmat(1553) + mat(1555) = mat(1555) + lmat(1555) + mat( 276) = 0._r8 + mat( 360) = 0._r8 + mat( 363) = 0._r8 + mat( 365) = 0._r8 + mat( 376) = 0._r8 + mat( 384) = 0._r8 + mat( 386) = 0._r8 + mat( 388) = 0._r8 + mat( 392) = 0._r8 + mat( 395) = 0._r8 + mat( 397) = 0._r8 + mat( 398) = 0._r8 + mat( 403) = 0._r8 + mat( 424) = 0._r8 + mat( 425) = 0._r8 + mat( 430) = 0._r8 + mat( 438) = 0._r8 + mat( 461) = 0._r8 + mat( 462) = 0._r8 + mat( 464) = 0._r8 + mat( 471) = 0._r8 + mat( 472) = 0._r8 + mat( 473) = 0._r8 + mat( 489) = 0._r8 + mat( 495) = 0._r8 + mat( 496) = 0._r8 + mat( 505) = 0._r8 + mat( 510) = 0._r8 + mat( 514) = 0._r8 + mat( 529) = 0._r8 + mat( 542) = 0._r8 + mat( 543) = 0._r8 + mat( 550) = 0._r8 + mat( 551) = 0._r8 + mat( 561) = 0._r8 + mat( 568) = 0._r8 + mat( 569) = 0._r8 + mat( 571) = 0._r8 + mat( 575) = 0._r8 + mat( 580) = 0._r8 + mat( 591) = 0._r8 + mat( 596) = 0._r8 + mat( 599) = 0._r8 + mat( 600) = 0._r8 + mat( 604) = 0._r8 + mat( 605) = 0._r8 + mat( 614) = 0._r8 + mat( 624) = 0._r8 + mat( 625) = 0._r8 + mat( 627) = 0._r8 + mat( 628) = 0._r8 + mat( 630) = 0._r8 + mat( 634) = 0._r8 + mat( 645) = 0._r8 + mat( 662) = 0._r8 + mat( 663) = 0._r8 + mat( 678) = 0._r8 + mat( 686) = 0._r8 + mat( 687) = 0._r8 + mat( 691) = 0._r8 + mat( 699) = 0._r8 + mat( 714) = 0._r8 + mat( 718) = 0._r8 + mat( 721) = 0._r8 + mat( 722) = 0._r8 + mat( 729) = 0._r8 + mat( 733) = 0._r8 + mat( 735) = 0._r8 + mat( 737) = 0._r8 + mat( 740) = 0._r8 + mat( 742) = 0._r8 + mat( 745) = 0._r8 + mat( 748) = 0._r8 + mat( 749) = 0._r8 + mat( 757) = 0._r8 + mat( 759) = 0._r8 + mat( 762) = 0._r8 + mat( 766) = 0._r8 + mat( 769) = 0._r8 + mat( 770) = 0._r8 + mat( 774) = 0._r8 + mat( 778) = 0._r8 + mat( 781) = 0._r8 + mat( 782) = 0._r8 + mat( 783) = 0._r8 + mat( 785) = 0._r8 + mat( 787) = 0._r8 + mat( 789) = 0._r8 + mat( 790) = 0._r8 + mat( 795) = 0._r8 + mat( 796) = 0._r8 + mat( 801) = 0._r8 + mat( 806) = 0._r8 + mat( 809) = 0._r8 + mat( 810) = 0._r8 + mat( 828) = 0._r8 + mat( 829) = 0._r8 + mat( 834) = 0._r8 + mat( 836) = 0._r8 + mat( 837) = 0._r8 + mat( 838) = 0._r8 + mat( 851) = 0._r8 + mat( 852) = 0._r8 + mat( 862) = 0._r8 + mat( 866) = 0._r8 + mat( 867) = 0._r8 + mat( 869) = 0._r8 + mat( 873) = 0._r8 + mat( 878) = 0._r8 + mat( 880) = 0._r8 + mat( 883) = 0._r8 + mat( 885) = 0._r8 + mat( 886) = 0._r8 + mat( 911) = 0._r8 + mat( 913) = 0._r8 + mat( 916) = 0._r8 + mat( 918) = 0._r8 + mat( 919) = 0._r8 + mat( 921) = 0._r8 + mat( 937) = 0._r8 + mat( 939) = 0._r8 + mat( 945) = 0._r8 + mat( 946) = 0._r8 + mat( 947) = 0._r8 + mat( 950) = 0._r8 + mat( 951) = 0._r8 + mat( 952) = 0._r8 + mat( 953) = 0._r8 + mat( 956) = 0._r8 + mat( 957) = 0._r8 + mat( 958) = 0._r8 + mat( 959) = 0._r8 + mat( 960) = 0._r8 + mat( 962) = 0._r8 + mat( 963) = 0._r8 + mat( 964) = 0._r8 + mat( 965) = 0._r8 + mat( 967) = 0._r8 + mat( 968) = 0._r8 + mat( 969) = 0._r8 + mat( 970) = 0._r8 + mat( 973) = 0._r8 + mat( 975) = 0._r8 + mat(1018) = 0._r8 + mat(1022) = 0._r8 + mat(1026) = 0._r8 + mat(1029) = 0._r8 + mat(1042) = 0._r8 + mat(1044) = 0._r8 + mat(1050) = 0._r8 + mat(1057) = 0._r8 + mat(1059) = 0._r8 + mat(1063) = 0._r8 + mat(1070) = 0._r8 + mat(1081) = 0._r8 + mat(1082) = 0._r8 + mat(1084) = 0._r8 + mat(1086) = 0._r8 + mat(1090) = 0._r8 + mat(1091) = 0._r8 + mat(1094) = 0._r8 + mat(1095) = 0._r8 + mat(1096) = 0._r8 + mat(1099) = 0._r8 + mat(1104) = 0._r8 + mat(1115) = 0._r8 + mat(1130) = 0._r8 + mat(1135) = 0._r8 + mat(1136) = 0._r8 + mat(1140) = 0._r8 + mat(1144) = 0._r8 + mat(1152) = 0._r8 + mat(1153) = 0._r8 + mat(1157) = 0._r8 + mat(1158) = 0._r8 + mat(1159) = 0._r8 + mat(1163) = 0._r8 + mat(1164) = 0._r8 + mat(1165) = 0._r8 + mat(1171) = 0._r8 + mat(1174) = 0._r8 + mat(1175) = 0._r8 + mat(1178) = 0._r8 + mat(1179) = 0._r8 + mat(1188) = 0._r8 + mat(1191) = 0._r8 + mat(1194) = 0._r8 + mat(1195) = 0._r8 + mat(1198) = 0._r8 + mat(1199) = 0._r8 + mat(1201) = 0._r8 + mat(1202) = 0._r8 + mat(1207) = 0._r8 + mat(1213) = 0._r8 + mat(1214) = 0._r8 + mat(1216) = 0._r8 + mat(1218) = 0._r8 + mat(1219) = 0._r8 + mat(1220) = 0._r8 + mat(1221) = 0._r8 + mat(1229) = 0._r8 + mat(1231) = 0._r8 + mat(1232) = 0._r8 + mat(1233) = 0._r8 + mat(1235) = 0._r8 + mat(1236) = 0._r8 + mat(1239) = 0._r8 + mat(1240) = 0._r8 + mat(1241) = 0._r8 + mat(1242) = 0._r8 + mat(1245) = 0._r8 + mat(1247) = 0._r8 + mat(1249) = 0._r8 + mat(1263) = 0._r8 + mat(1269) = 0._r8 + mat(1278) = 0._r8 + mat(1279) = 0._r8 + mat(1288) = 0._r8 + mat(1291) = 0._r8 + mat(1292) = 0._r8 + mat(1294) = 0._r8 + mat(1297) = 0._r8 + mat(1308) = 0._r8 + mat(1312) = 0._r8 + mat(1338) = 0._r8 + mat(1348) = 0._r8 + mat(1349) = 0._r8 + mat(1350) = 0._r8 + mat(1355) = 0._r8 + mat(1356) = 0._r8 + mat(1358) = 0._r8 + mat(1360) = 0._r8 + mat(1363) = 0._r8 + mat(1364) = 0._r8 + mat(1366) = 0._r8 + mat(1371) = 0._r8 + mat(1373) = 0._r8 + mat(1374) = 0._r8 + mat(1375) = 0._r8 + mat(1376) = 0._r8 + mat(1377) = 0._r8 + mat(1378) = 0._r8 + mat(1379) = 0._r8 + mat(1381) = 0._r8 + mat(1383) = 0._r8 + mat(1384) = 0._r8 + mat(1385) = 0._r8 + mat(1387) = 0._r8 + mat(1388) = 0._r8 + mat(1390) = 0._r8 + mat(1392) = 0._r8 + mat(1397) = 0._r8 + mat(1399) = 0._r8 + mat(1400) = 0._r8 + mat(1403) = 0._r8 + mat(1406) = 0._r8 + mat(1408) = 0._r8 + mat(1413) = 0._r8 + mat(1414) = 0._r8 + mat(1415) = 0._r8 + mat(1417) = 0._r8 + mat(1418) = 0._r8 + mat(1419) = 0._r8 + mat(1424) = 0._r8 + mat(1465) = 0._r8 + mat(1482) = 0._r8 + mat(1518) = 0._r8 + mat(1541) = 0._r8 + mat(1544) = 0._r8 + mat(1545) = 0._r8 + mat(1549) = 0._r8 + mat(1551) = 0._r8 + mat(1552) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti + mat( 7) = mat( 7) - dti + mat( 8) = mat( 8) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 13) = mat( 13) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 25) = mat( 25) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti + mat( 31) = mat( 31) - dti + mat( 34) = mat( 34) - dti + mat( 37) = mat( 37) - dti + mat( 40) = mat( 40) - dti + mat( 43) = mat( 43) - dti + mat( 46) = mat( 46) - dti + mat( 49) = mat( 49) - dti + mat( 53) = mat( 53) - dti + mat( 58) = mat( 58) - dti + mat( 61) = mat( 61) - dti + mat( 64) = mat( 64) - dti + mat( 67) = mat( 67) - dti + mat( 70) = mat( 70) - dti + mat( 72) = mat( 72) - dti + mat( 75) = mat( 75) - dti + mat( 77) = mat( 77) - dti + mat( 81) = mat( 81) - dti + mat( 85) = mat( 85) - dti + mat( 89) = mat( 89) - dti + mat( 92) = mat( 92) - dti + mat( 95) = mat( 95) - dti + mat( 99) = mat( 99) - dti + mat( 104) = mat( 104) - dti + mat( 108) = mat( 108) - dti + mat( 114) = mat( 114) - dti + mat( 120) = mat( 120) - dti + mat( 126) = mat( 126) - dti + mat( 132) = mat( 132) - dti + mat( 137) = mat( 137) - dti + mat( 144) = mat( 144) - dti + mat( 149) = mat( 149) - dti + mat( 154) = mat( 154) - dti + mat( 159) = mat( 159) - dti + mat( 162) = mat( 162) - dti + mat( 170) = mat( 170) - dti + mat( 177) = mat( 177) - dti + mat( 183) = mat( 183) - dti + mat( 187) = mat( 187) - dti + mat( 193) = mat( 193) - dti + mat( 199) = mat( 199) - dti + mat( 205) = mat( 205) - dti + mat( 211) = mat( 211) - dti + mat( 216) = mat( 216) - dti + mat( 221) = mat( 221) - dti + mat( 229) = mat( 229) - dti + mat( 236) = mat( 236) - dti + mat( 243) = mat( 243) - dti + mat( 250) = mat( 250) - dti + mat( 257) = mat( 257) - dti + mat( 262) = mat( 262) - dti + mat( 269) = mat( 269) - dti + mat( 277) = mat( 277) - dti + mat( 283) = mat( 283) - dti + mat( 291) = mat( 291) - dti + mat( 299) = mat( 299) - dti + mat( 303) = mat( 303) - dti + mat( 307) = mat( 307) - dti + mat( 315) = mat( 315) - dti + mat( 323) = mat( 323) - dti + mat( 331) = mat( 331) - dti + mat( 340) = mat( 340) - dti + mat( 344) = mat( 344) - dti + mat( 351) = mat( 351) - dti + mat( 359) = mat( 359) - dti + mat( 370) = mat( 370) - dti + mat( 379) = mat( 379) - dti + mat( 393) = mat( 393) - dti + mat( 404) = mat( 404) - dti + mat( 410) = mat( 410) - dti + mat( 417) = mat( 417) - dti + mat( 423) = mat( 423) - dti + mat( 432) = mat( 432) - dti + mat( 441) = mat( 441) - dti + mat( 449) = mat( 449) - dti + mat( 458) = mat( 458) - dti + mat( 469) = mat( 469) - dti + mat( 476) = mat( 476) - dti + mat( 487) = mat( 487) - dti + mat( 497) = mat( 497) - dti + mat( 509) = mat( 509) - dti + mat( 521) = mat( 521) - dti + mat( 531) = mat( 531) - dti + mat( 540) = mat( 540) - dti + mat( 553) = mat( 553) - dti + mat( 560) = mat( 560) - dti + mat( 578) = mat( 578) - dti + mat( 587) = mat( 587) - dti + mat( 595) = mat( 595) - dti + mat( 608) = mat( 608) - dti + mat( 621) = mat( 621) - dti + mat( 636) = mat( 636) - dti + mat( 641) = mat( 641) - dti + mat( 652) = mat( 652) - dti + mat( 664) = mat( 664) - dti + mat( 671) = mat( 671) - dti + mat( 684) = mat( 684) - dti + mat( 696) = mat( 696) - dti + mat( 711) = mat( 711) - dti + mat( 734) = mat( 734) - dti + mat( 758) = mat( 758) - dti + mat( 777) = mat( 777) - dti + mat( 797) = mat( 797) - dti + mat( 826) = mat( 826) - dti + mat( 842) = mat( 842) - dti + mat( 861) = mat( 861) - dti + mat( 876) = mat( 876) - dti + mat( 909) = mat( 909) - dti + mat( 940) = mat( 940) - dti + mat( 961) = mat( 961) - dti + mat(1019) = mat(1019) - dti + mat(1061) = mat(1061) - dti + mat(1107) = mat(1107) - dti + mat(1134) = mat(1134) - dti + mat(1172) = mat(1172) - dti + mat(1197) = mat(1197) - dti + mat(1222) = mat(1222) - dti + mat(1243) = mat(1243) - dti + mat(1317) = mat(1317) - dti + mat(1362) = mat(1362) - dti + mat(1389) = mat(1389) - dti + mat(1425) = mat(1425) - dti + mat(1527) = mat(1527) - dti + mat(1555) = mat(1555) - dti + end subroutine nlnmat_finit + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat05( mat, y, rxt ) + call nlnmat06( mat, y, rxt ) + call nlnmat07( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 new file mode 100644 index 0000000000..ec1a523e73 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 97) = p_rate(:,k, 97) * inv(:,k, 2) * im(:,k) + p_rate(:,k,101) = p_rate(:,k,101) * inv(:,k, 2) * im(:,k) + p_rate(:,k,102) = p_rate(:,k,102) * inv(:,k, 2) * im(:,k) + p_rate(:,k,104) = p_rate(:,k,104) * inv(:,k, 2) * im(:,k) + p_rate(:,k,109) = p_rate(:,k,109) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + p_rate(:,k,114) = p_rate(:,k,114) * inv(:,k, 2) * im(:,k) + p_rate(:,k,116) = p_rate(:,k,116) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 new file mode 100644 index 0000000000..56faca3d1a --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_prod_loss.F90 @@ -0,0 +1,816 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = ((rxt(:,:,156) +rxt(:,:,157) +rxt(:,:,158))* y(:,:,3) & + +rxt(:,:,266)* y(:,:,23) +rxt(:,:,213)* y(:,:,28) +rxt(:,:,252) & + * y(:,:,141) + rxt(:,:,59) + rxt(:,:,60) + het_rates(:,:,15)) & + * y(:,:,15) + prod(:,:,1) = 0._r8 + loss(:,:,2) = ((rxt(:,:,135) +rxt(:,:,136))* y(:,:,3) + rxt(:,:,5) & + + het_rates(:,:,7))* y(:,:,7) + prod(:,:,2) = 0._r8 + loss(:,:,3) = (rxt(:,:,255)* y(:,:,23) +rxt(:,:,254)* y(:,:,28) + rxt(:,:,37) & + + het_rates(:,:,108))* y(:,:,108) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,147)* y(:,:,3) +rxt(:,:,258)* y(:,:,23) +rxt(:,:,259) & + * y(:,:,28) + rxt(:,:,48) + het_rates(:,:,109))* y(:,:,109) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,138)* y(:,:,3) + rxt(:,:,40) + het_rates(:,:,110)) & + * y(:,:,110) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,139)* y(:,:,3) + rxt(:,:,41) + het_rates(:,:,111)) & + * y(:,:,111) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,140)* y(:,:,3) + rxt(:,:,42) + het_rates(:,:,112)) & + * y(:,:,112) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,141)* y(:,:,3) + rxt(:,:,43) + het_rates(:,:,120)) & + * y(:,:,120) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,142)* y(:,:,3) + rxt(:,:,44) + het_rates(:,:,121)) & + * y(:,:,121) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,143)* y(:,:,3) +rxt(:,:,257)* y(:,:,23) + rxt(:,:,45) & + + het_rates(:,:,113))* y(:,:,113) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,144)* y(:,:,3) +rxt(:,:,260)* y(:,:,23) + rxt(:,:,46) & + + het_rates(:,:,118))* y(:,:,118) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,145)* y(:,:,3) +rxt(:,:,261)* y(:,:,23) + rxt(:,:,47) & + + het_rates(:,:,119))* y(:,:,119) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,146)* y(:,:,3) + rxt(:,:,38) + het_rates(:,:,114)) & + * y(:,:,114) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,256)* y(:,:,23) + rxt(:,:,39) + het_rates(:,:,115)) & + * y(:,:,115) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,149)* y(:,:,3) + rxt(:,:,49) + het_rates(:,:,116)) & + * y(:,:,116) + prod(:,:,15) = 0._r8 + loss(:,:,16) = (rxt(:,:,148)* y(:,:,3) + rxt(:,:,50) + het_rates(:,:,117)) & + * y(:,:,117) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,150)* y(:,:,3) + rxt(:,:,53) + het_rates(:,:,122)) & + * y(:,:,122) + prod(:,:,17) = 0._r8 + loss(:,:,18) = (rxt(:,:,151)* y(:,:,3) + rxt(:,:,54) + het_rates(:,:,123)) & + * y(:,:,123) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,152)* y(:,:,3) +rxt(:,:,263)* y(:,:,23) +rxt(:,:,265) & + * y(:,:,28) + rxt(:,:,51) + het_rates(:,:,124))* y(:,:,124) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,153)* y(:,:,3) +rxt(:,:,262)* y(:,:,23) +rxt(:,:,264) & + * y(:,:,28) + rxt(:,:,52) + het_rates(:,:,125))* y(:,:,125) + prod(:,:,20) = 0._r8 + loss(:,:,21) = (rxt(:,:,467)* y(:,:,130) + rxt(:,:,58) + rxt(:,:,117) & + + het_rates(:,:,126))* y(:,:,126) + prod(:,:,21) =.440_r8*rxt(:,:,60)*y(:,:,15) + loss(:,:,22) = ( + het_rates(:,:,26))* y(:,:,26) + prod(:,:,22) = 0._r8 + loss(:,:,23) = ( + het_rates(:,:,27))* y(:,:,27) + prod(:,:,23) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(140) = (rxt(119)* y(2) +rxt(137)* y(3) +rxt(192)* y(9) +rxt(195)* y(10) & + +rxt(164)* y(22) +rxt(169)* y(23) +rxt(177)* y(24) +rxt(207)* y(28) & + +rxt(234)* y(37) +rxt(293)* y(44) +rxt(314)* y(59) +rxt(336)* y(77) & + +rxt(342)* y(78) +rxt(360)* y(83) +rxt(398)* y(105) +rxt(433) & + * y(163) +rxt(436)* y(164) + rxt(3) + rxt(4) + het_rates(1))* y(1) + prod(140) = (.200_r8*rxt(336)*y(77) +.200_r8*rxt(342)*y(78) + & + .100_r8*rxt(360)*y(83))*y(1) + (.250_r8*rxt(304)*y(48) + & + .250_r8*rxt(352)*y(76))*y(24) +rxt(118)*y(4)*y(2) + loss(139) = (rxt(119)* y(1) + 2._r8*rxt(120)* y(2) +rxt(118)* y(4) +rxt(190) & + * y(9) + (rxt(193) +rxt(194))* y(10) +rxt(201)* y(11) +rxt(271) & + * y(19) +rxt(175)* y(21) +rxt(168)* y(23) +rxt(176)* y(24) +rxt(179) & + * y(25) +rxt(214)* y(30) +rxt(227)* y(33) +rxt(228)* y(34) +rxt(231) & + * y(35) +rxt(237)* y(38) +rxt(247)* y(39) +rxt(248)* y(40) +rxt(249) & + * y(41) + (rxt(465) +rxt(466))* y(127) +rxt(472)* y(129) +rxt(429) & + * y(162) + rxt(92) + rxt(93) + rxt(94) + rxt(105) + rxt(106) & + + rxt(107) + het_rates(2))* y(2) + prod(139) = (rxt(1) +2.000_r8*rxt(2) +rxt(98) +rxt(99) +rxt(100) + & + 2.000_r8*rxt(103) +rxt(110) +rxt(111) +rxt(112) +2.000_r8*rxt(115) + & + rxt(132)*y(3) +rxt(133)*y(3) +rxt(185)*y(8) +rxt(432)*y(163) + & + rxt(435)*y(164) +rxt(463)*y(130) +rxt(471)*y(129))*y(4) & + + (rxt(186)*y(9) +rxt(187)*y(10) +rxt(468)*y(128))*y(8) & + + (rxt(475)*y(131) +1.150_r8*rxt(476)*y(128))*y(132) +rxt(4)*y(1) & + +rxt(131)*y(3) +rxt(6)*y(9) +rxt(8)*y(10) +rxt(12)*y(11) +rxt(10) & + *y(14) +rxt(167)*y(24)*y(22) +rxt(171)*y(23)*y(23) +rxt(24)*y(30) & + +rxt(25)*y(31) +rxt(32)*y(38) +rxt(21)*y(134) +rxt(88)*y(156) & + +rxt(91)*y(164) +rxt(89)*y(165) + loss(141) = (rxt(137)* y(1) + (rxt(132) +rxt(133))* y(4) + (rxt(135) + & + rxt(136))* y(7) + (rxt(156) +rxt(157) +rxt(158))* y(15) +rxt(159) & + * y(21) +rxt(160)* y(33) +rxt(161)* y(39) +rxt(162)* y(42) +rxt(147) & + * y(109) +rxt(138)* y(110) +rxt(139)* y(111) +rxt(140)* y(112) & + +rxt(143)* y(113) +rxt(146)* y(114) +rxt(149)* y(116) +rxt(148) & + * y(117) +rxt(144)* y(118) +rxt(145)* y(119) +rxt(141)* y(120) & + +rxt(142)* y(121) +rxt(150)* y(122) +rxt(151)* y(123) +rxt(152) & + * y(124) +rxt(153)* y(125) +rxt(134)* y(134) +rxt(154)* y(138) & + +rxt(155)* y(139) + rxt(131) + het_rates(3))* y(3) + prod(141) = (rxt(1) +rxt(182)*y(133))*y(4) +rxt(3)*y(1) & + +.850_r8*rxt(476)*y(132)*y(128) +rxt(20)*y(134) + loss(136) = (rxt(118)* y(2) +rxt(132)* y(3) +rxt(128)* y(6) +rxt(185)* y(8) & + +rxt(163)* y(22) +rxt(291)* y(56) +rxt(473)* y(127) + (rxt(470) + & + rxt(471))* y(129) +rxt(463)* y(130) +rxt(182)* y(133) +rxt(432) & + * y(163) +rxt(435)* y(164) + rxt(1) + rxt(2) + rxt(96) + rxt(98) & + + rxt(99) + rxt(100) + rxt(103) + rxt(108) + rxt(110) + rxt(111) & + + rxt(112) + rxt(115) + het_rates(4))* y(4) + prod(136) = (rxt(166)*y(22) +rxt(170)*y(23) +rxt(176)*y(2) + & + 2.000_r8*rxt(177)*y(1) +rxt(178)*y(24) +rxt(203)*y(11) + & + rxt(210)*y(28) +rxt(217)*y(30) +rxt(235)*y(37) +rxt(239)*y(38) + & + rxt(274)*y(16) +rxt(296)*y(46) +rxt(317)*y(61) +rxt(322)*y(64) + & + rxt(326)*y(67) +.750_r8*rxt(352)*y(76))*y(24) + (rxt(4) + & + 2.000_r8*rxt(119)*y(2) +2.000_r8*rxt(137)*y(3) +rxt(164)*y(22) + & + rxt(169)*y(23) +rxt(192)*y(9) +rxt(195)*y(10) +rxt(207)*y(28) + & + rxt(234)*y(37) +rxt(433)*y(163) +rxt(436)*y(164))*y(1) & + + (rxt(120)*y(2) +rxt(127)*y(6) +rxt(168)*y(23) +rxt(193)*y(10) + & + rxt(201)*y(11) +rxt(214)*y(30) +rxt(237)*y(38))*y(2) & + + (rxt(216)*y(23) +rxt(221)*y(30) +rxt(222)*y(30) +rxt(243)*y(38) + & + rxt(244)*y(38))*y(30) + (rxt(129) +rxt(130) +2.000_r8*rxt(128)*y(4)) & + *y(6) +rxt(136)*y(7)*y(3) +rxt(126)*y(5) +rxt(189)*y(10)*y(8) & + +rxt(469)*y(128)*y(9) +rxt(13)*y(11) +rxt(205)*y(23)*y(13) & + +rxt(245)*y(38)*y(38) + loss(41) = (rxt(124)* y(1) +rxt(121)* y(2) +rxt(122)* y(4) +rxt(125)* y(126) & + + rxt(123) + rxt(126) + het_rates(5))* y(5) + prod(41) =rxt(132)*y(4)*y(3) + loss(40) = (rxt(127)* y(2) +rxt(128)* y(4) + rxt(129) + rxt(130) & + + het_rates(6))* y(6) + prod(40) = (rxt(123) +rxt(125)*y(126) +rxt(121)*y(2) +rxt(122)*y(4) + & + rxt(124)*y(1))*y(5) +rxt(3)*y(1) + loss(124) = (rxt(175)* y(2) +rxt(159)* y(3) +rxt(173)* y(23) +rxt(208)* y(28) & + +rxt(251)* y(141) + het_rates(21))* y(21) + prod(124) =rxt(158)*y(15)*y(3) +rxt(18)*y(19) +rxt(166)*y(24)*y(22) +rxt(20) & + *y(134) + loss(119) = ((rxt(267) +rxt(268))* y(23) + het_rates(20))* y(20) + prod(119) = (rxt(17) +rxt(18) +rxt(212)*y(28) +rxt(236)*y(37) + & + rxt(269)*y(11) +rxt(270)*y(23) +rxt(271)*y(2))*y(19) & + + (.500_r8*rxt(293)*y(44) +.560_r8*rxt(314)*y(59) + & + .050_r8*rxt(336)*y(77) +.200_r8*rxt(342)*y(78) + & + .300_r8*rxt(360)*y(83))*y(1) + (.350_r8*rxt(286)*y(135) + & + rxt(309)*y(53) +rxt(330)*y(68) +rxt(430)*y(162))*y(23) & + + (.220_r8*rxt(343)*y(9) +.220_r8*rxt(345)*y(11) + & + .110_r8*rxt(347)*y(16) +.220_r8*rxt(348)*y(48))*y(79) & + + (.250_r8*rxt(378)*y(9) +.500_r8*rxt(379)*y(11) + & + .200_r8*rxt(381)*y(16) +.250_r8*rxt(382)*y(48))*y(91) + (rxt(74) + & + rxt(331)*y(11))*y(68) + (rxt(90) +rxt(429)*y(2))*y(162) & + +rxt(254)*y(108)*y(28) +rxt(61)*y(50) +rxt(79)*y(52) & + +2.000_r8*rxt(82)*y(53) +.700_r8*rxt(68)*y(77) +1.340_r8*rxt(67) & + *y(78) +.450_r8*rxt(81)*y(86) +rxt(76)*y(90) +rxt(467)*y(130)*y(126) + loss(108) = (rxt(185)* y(4) +rxt(186)* y(9) + (rxt(187) +rxt(188) +rxt(189)) & + * y(10) +rxt(184)* y(23) +rxt(468)* y(128) + rxt(95) + het_rates(8)) & + * y(8) + prod(108) = (rxt(183)*y(133) +rxt(472)*y(129))*y(2) & + + (.200_r8*rxt(475)*y(131) +1.100_r8*rxt(477)*y(127))*y(132) & + +rxt(470)*y(129)*y(4) +rxt(6)*y(9) +rxt(464)*y(130) + loss(138) = (rxt(192)* y(1) +rxt(190)* y(2) +rxt(186)* y(8) +rxt(200)* y(11) & + +rxt(273)* y(16) +rxt(191)* y(24) +rxt(219)* y(30) +rxt(240)* y(38) & + +rxt(295)* y(46) +rxt(302)* y(48) +rxt(289)* y(55) +rxt(316)* y(61) & + +rxt(321)* y(64) +rxt(325)* y(67) +rxt(334)* y(73) +rxt(338)* y(74) & + +rxt(350)* y(76) + (rxt(343) +rxt(344))* y(79) +rxt(375)* y(84) & + +rxt(362)* y(88) +rxt(368)* y(89) +rxt(378)* y(91) +rxt(386)* y(96) & + +rxt(393)* y(100) +rxt(396)* y(103) +rxt(400)* y(106) +rxt(469) & + * y(128) +rxt(281)* y(137) + rxt(6) + rxt(7) + het_rates(9))* y(9) + prod(138) = (rxt(8) +.500_r8*rxt(405) +2.000_r8*rxt(188)*y(8) + & + rxt(193)*y(2) +rxt(437)*y(164))*y(10) + (rxt(182)*y(133) + & + rxt(185)*y(8))*y(4) +2.000_r8*rxt(135)*y(7)*y(3) +rxt(184)*y(23)*y(8) & + +rxt(13)*y(11) +rxt(10)*y(14) +rxt(474)*y(128) + loss(142) = (rxt(195)* y(1) + (rxt(193) +rxt(194))* y(2) + (rxt(187) + & + rxt(188) +rxt(189))* y(8) +rxt(196)* y(11) +rxt(198)* y(23) +rxt(204) & + * y(24) +rxt(220)* y(30) +rxt(241)* y(38) +rxt(303)* y(48) +rxt(356) & + * y(76) +rxt(390)* y(98) +rxt(437)* y(164) + rxt(8) + rxt(405) & + + het_rates(10))* y(10) + prod(142) = (rxt(190)*y(2) +rxt(191)*y(24) +rxt(192)*y(1) + & + 2.000_r8*rxt(200)*y(11) +rxt(219)*y(30) +rxt(240)*y(38) + & + rxt(273)*y(16) +rxt(281)*y(137) +rxt(289)*y(55) +rxt(295)*y(46) + & + rxt(302)*y(48) +rxt(316)*y(61) +rxt(321)*y(64) +rxt(325)*y(67) + & + rxt(334)*y(73) +rxt(338)*y(74) +rxt(343)*y(79) +rxt(350)*y(76) + & + .920_r8*rxt(362)*y(88) +1.206_r8*rxt(368)*y(89) + & + .900_r8*rxt(375)*y(84) +rxt(378)*y(91) +.900_r8*rxt(386)*y(96) + & + .900_r8*rxt(393)*y(100) +.900_r8*rxt(396)*y(103) +rxt(400)*y(106)) & + *y(9) + (rxt(12) +rxt(201)*y(2) +rxt(202)*y(23) +rxt(203)*y(24) + & + rxt(345)*y(79) +rxt(351)*y(76) +rxt(363)*y(88) + & + 1.206_r8*rxt(369)*y(89) +rxt(373)*y(90) +rxt(379)*y(91) + & + rxt(399)*y(105))*y(11) + (rxt(15) +rxt(206) +rxt(205)*y(23))*y(13) & + + (rxt(9) +rxt(197))*y(14) + (rxt(332)*y(82) + & + .400_r8*rxt(372)*y(90))*y(23) + (.600_r8*rxt(64) +rxt(311))*y(58) & + + (rxt(65) +rxt(357))*y(81) +.700_r8*rxt(390)*y(98)*y(10) +rxt(11) & + *y(12) +.206_r8*rxt(370)*y(89)*y(24) +rxt(30)*y(35) +rxt(36)*y(41) & + +rxt(76)*y(90) + loss(150) = (rxt(169)* y(1) +rxt(168)* y(2) +rxt(184)* y(8) +rxt(198)* y(10) & + +rxt(202)* y(11) +rxt(199)* y(12) +rxt(205)* y(13) +rxt(266)* y(15) & + +rxt(278)* y(17) +rxt(277)* y(18) +rxt(270)* y(19) + (rxt(267) + & + rxt(268))* y(20) +rxt(173)* y(21) + 2._r8*(rxt(171) +rxt(172))* y(23) & + +rxt(170)* y(24) +rxt(174)* y(25) + (rxt(215) +rxt(216))* y(30) & + +rxt(226)* y(33) +rxt(230)* y(34) +rxt(232)* y(35) +rxt(238)* y(38) & + +rxt(246)* y(39) +rxt(180)* y(42) +rxt(181)* y(43) +rxt(288)* y(44) & + +rxt(287)* y(45) +rxt(299)* y(47) +rxt(294)* y(49) +rxt(300)* y(50) & + +rxt(310)* y(51) +rxt(308)* y(52) +rxt(309)* y(53) +rxt(307)* y(54) & + +rxt(312)* y(58) +rxt(313)* y(59) +rxt(320)* y(60) +rxt(319)* y(62) & + +rxt(324)* y(63) +rxt(323)* y(65) +rxt(329)* y(66) +rxt(330)* y(68) & + +rxt(328)* y(69) +rxt(333)* y(70) +rxt(371)* y(71) +rxt(337)* y(72) & + +rxt(340)* y(75) +rxt(335)* y(77) +rxt(341)* y(78) +rxt(349)* y(80) & + +rxt(358)* y(81) +rxt(332)* y(82) +rxt(359)* y(83) +rxt(377)* y(85) & + +rxt(374)* y(87) +rxt(372)* y(90) +rxt(383)* y(92) +rxt(365)* y(93) & + +rxt(385)* y(94) +rxt(389)* y(95) +rxt(388)* y(97) +rxt(391)* y(99) & + +rxt(394)* y(102) +rxt(397)* y(105) +rxt(402)* y(107) +rxt(255) & + * y(108) +rxt(258)* y(109) +rxt(257)* y(113) +rxt(256)* y(115) & + +rxt(260)* y(118) +rxt(261)* y(119) +rxt(263)* y(124) +rxt(262) & + * y(125) +rxt(286)* y(135) +rxt(279)* y(136) +rxt(441)* y(156) & + + (rxt(443) +rxt(444))* y(157) +rxt(430)* y(162) +rxt(431)* y(163) & + +rxt(434)* y(164) + het_rates(23))* y(23) + prod(150) = (rxt(164)*y(22) +rxt(177)*y(24) +.120_r8*rxt(293)*y(44) + & + .330_r8*rxt(314)*y(59) +.080_r8*rxt(336)*y(77) + & + .215_r8*rxt(342)*y(78) +.270_r8*rxt(360)*y(83) + & + .700_r8*rxt(398)*y(105))*y(1) + (rxt(175)*y(21) +rxt(176)*y(24) + & + rxt(179)*y(25) +rxt(227)*y(33) +rxt(228)*y(34) +rxt(247)*y(39) + & + rxt(248)*y(40) +rxt(271)*y(19))*y(2) + (rxt(156)*y(15) + & + 2.000_r8*rxt(134)*y(134) +rxt(159)*y(21) +rxt(160)*y(33) + & + rxt(161)*y(39) +rxt(162)*y(42))*y(3) + (.300_r8*rxt(278)*y(17) + & + .650_r8*rxt(286)*y(135) +.500_r8*rxt(299)*y(47) + & + .500_r8*rxt(323)*y(65) +.100_r8*rxt(349)*y(80))*y(23) & + + (2.000_r8*rxt(165)*y(22) +rxt(191)*y(9) +rxt(203)*y(11) + & + rxt(211)*y(28) +.206_r8*rxt(370)*y(89))*y(24) + (rxt(19) + & + rxt(250)*y(141))*y(134) +.500_r8*rxt(405)*y(10) +rxt(11)*y(12) & + +rxt(14)*y(13) +rxt(16)*y(17) +2.000_r8*rxt(22)*y(25) +rxt(27)*y(34) & + +rxt(33)*y(40) +rxt(69)*y(47) +rxt(63)*y(54) +rxt(70)*y(57) +rxt(71) & + *y(62) +rxt(62)*y(65) +rxt(72)*y(69) +rxt(84)*y(75) +rxt(83)*y(85) & + +rxt(75)*y(92) +rxt(85)*y(97) +rxt(86)*y(107) + loss(147) = (rxt(201)* y(2) +rxt(200)* y(9) +rxt(196)* y(10) +rxt(269)* y(19) & + +rxt(202)* y(23) +rxt(203)* y(24) +rxt(301)* y(50) +rxt(315)* y(59) & + +rxt(331)* y(68) +rxt(351)* y(76) +rxt(345)* y(79) +rxt(361)* y(83) & + +rxt(363)* y(88) +rxt(369)* y(89) +rxt(373)* y(90) +rxt(379)* y(91) & + +rxt(399)* y(105) +rxt(445)* y(157) + rxt(12) + rxt(13) + rxt(404) & + + het_rates(11))* y(11) + prod(147) = (rxt(199)*y(12) +rxt(232)*y(35) +rxt(312)*y(58) + & + .500_r8*rxt(358)*y(81))*y(23) + (rxt(194)*y(10) +rxt(231)*y(35) + & + rxt(249)*y(41))*y(2) + (rxt(9) +rxt(10) +rxt(197))*y(14) + (rxt(29) + & + rxt(233)*y(28))*y(35) +rxt(195)*y(10)*y(1) +rxt(253)*y(141)*y(12) & + +rxt(14)*y(13) +rxt(35)*y(41) +.400_r8*rxt(64)*y(58) + loss(137) = (rxt(199)* y(23) +rxt(253)* y(141) + rxt(11) + het_rates(12)) & + * y(12) + prod(137) = (rxt(447) +rxt(453) +rxt(458) +rxt(449)*y(33) +rxt(454)*y(33) + & + rxt(460)*y(33))*y(35) + (rxt(404) +rxt(269)*y(19) +rxt(301)*y(50) + & + rxt(331)*y(68) +rxt(445)*y(157))*y(11) + (2.000_r8*rxt(403) + & + 2.000_r8*rxt(446) +2.000_r8*rxt(452) +2.000_r8*rxt(457))*y(14) & + + (rxt(448) +rxt(456) +rxt(459))*y(41) + (.500_r8*rxt(405) + & + rxt(198)*y(23))*y(10) + loss(74) = (rxt(205)* y(23) + rxt(14) + rxt(15) + rxt(206) + het_rates(13)) & + * y(13) + prod(74) =rxt(204)*y(24)*y(10) + loss(55) = ( + rxt(9) + rxt(10) + rxt(197) + rxt(403) + rxt(446) + rxt(452) & + + rxt(457) + het_rates(14))* y(14) + prod(55) =rxt(196)*y(11)*y(10) + loss(135) = (rxt(273)* y(9) + 2._r8*(rxt(275) +rxt(276))* y(16) +rxt(274) & + * y(24) +rxt(218)* y(30) +rxt(297)* y(46) +rxt(305)* y(48) +rxt(318) & + * y(61) +rxt(327)* y(67) +rxt(353)* y(76) +rxt(347)* y(79) +rxt(366) & + * y(88) +rxt(381)* y(91) + het_rates(16))* y(16) + prod(135) = (rxt(302)*y(9) +.900_r8*rxt(305)*y(16) +2.000_r8*rxt(306)*y(48) + & + rxt(348)*y(79) +rxt(354)*y(76) +rxt(367)*y(88) +rxt(382)*y(91))*y(48) & + + (rxt(156)*y(3) +rxt(213)*y(28) +rxt(252)*y(141) +rxt(266)*y(23)) & + *y(15) + (.700_r8*rxt(278)*y(17) +rxt(294)*y(49))*y(23) & + +.310_r8*rxt(314)*y(59)*y(1) +rxt(61)*y(50) +rxt(63)*y(54) & + +.400_r8*rxt(64)*y(58) +rxt(73)*y(63) +.300_r8*rxt(68)*y(77) + loss(69) = (rxt(278)* y(23) + rxt(16) + het_rates(17))* y(17) + prod(69) =rxt(274)*y(24)*y(16) + loss(46) = (rxt(162)* y(3) +rxt(180)* y(23) + het_rates(42))* y(42) + prod(46) = 0._r8 + loss(34) = (rxt(181)* y(23) + het_rates(43))* y(43) + prod(34) = 0._r8 + loss(144) = (rxt(271)* y(2) +rxt(269)* y(11) +rxt(270)* y(23) +rxt(272) & + * y(24) +rxt(212)* y(28) +rxt(236)* y(37) + rxt(17) + rxt(18) & + + het_rates(19))* y(19) + prod(144) = (rxt(218)*y(30) +rxt(273)*y(9) +2.000_r8*rxt(275)*y(16) + & + rxt(276)*y(16) +.700_r8*rxt(297)*y(46) +rxt(305)*y(48) + & + rxt(318)*y(61) +.800_r8*rxt(327)*y(67) +.880_r8*rxt(347)*y(79) + & + 2.000_r8*rxt(353)*y(76) +1.200_r8*rxt(366)*y(88) + & + .800_r8*rxt(381)*y(91))*y(16) + (.500_r8*rxt(289)*y(55) + & + rxt(321)*y(64) +rxt(325)*y(67) +.500_r8*rxt(334)*y(73) + & + .250_r8*rxt(343)*y(79) +rxt(350)*y(76) +.550_r8*rxt(362)*y(88) + & + .072_r8*rxt(368)*y(89) +.100_r8*rxt(375)*y(84) + & + .250_r8*rxt(378)*y(91))*y(9) + (rxt(277)*y(18) + & + .300_r8*rxt(278)*y(17) +.500_r8*rxt(307)*y(54) + & + .800_r8*rxt(308)*y(52) +rxt(312)*y(58) +.500_r8*rxt(358)*y(81))*y(23) & + + (rxt(293)*y(44) +.540_r8*rxt(314)*y(59) +.800_r8*rxt(336)*y(77) + & + .700_r8*rxt(342)*y(78) +.600_r8*rxt(360)*y(83))*y(1) & + + (.250_r8*rxt(345)*y(79) +rxt(351)*y(76) +.600_r8*rxt(363)*y(88) + & + .072_r8*rxt(369)*y(89))*y(11) + (.250_r8*rxt(348)*y(79) + & + rxt(354)*y(76) +.600_r8*rxt(367)*y(88) +.250_r8*rxt(382)*y(91))*y(48) & + + (rxt(157)*y(15) +rxt(158)*y(15))*y(3) +rxt(16)*y(17) & + +.206_r8*rxt(370)*y(89)*y(24) +rxt(79)*y(52) +2.000_r8*rxt(292) & + *y(56) +rxt(62)*y(65) +rxt(78)*y(66) +rxt(72)*y(69) & + +2.000_r8*rxt(355)*y(76)*y(76) +1.340_r8*rxt(66)*y(78) & + +.100_r8*rxt(83)*y(85) +rxt(76)*y(90) +.690_r8*rxt(77)*y(93) & + +rxt(280)*y(137) + loss(145) = (rxt(164)* y(1) +rxt(163)* y(4) + (rxt(165) +rxt(166) +rxt(167)) & + * y(24) + het_rates(22))* y(22) + prod(145) = (rxt(168)*y(2) +rxt(173)*y(21) +rxt(184)*y(8) +rxt(267)*y(20) + & + rxt(270)*y(19) +rxt(430)*y(162) +rxt(431)*y(163) +rxt(434)*y(164)) & + *y(23) + (rxt(159)*y(3) +rxt(175)*y(2) +rxt(208)*y(28) + & + rxt(251)*y(141))*y(21) + (rxt(19) +2.000_r8*rxt(21))*y(134) & + +rxt(157)*y(15)*y(3) +rxt(16)*y(17) +2.000_r8*rxt(17)*y(19) +rxt(28) & + *y(33) +rxt(34)*y(39) +rxt(57)*y(140) + loss(146) = (rxt(177)* y(1) +rxt(176)* y(2) +rxt(191)* y(9) +rxt(204)* y(10) & + +rxt(203)* y(11) +rxt(274)* y(16) +rxt(272)* y(19) + (rxt(165) + & + rxt(166) +rxt(167))* y(22) +rxt(170)* y(23) + 2._r8*rxt(178)* y(24) & + + (rxt(210) +rxt(211))* y(28) +rxt(217)* y(30) +rxt(235)* y(37) & + +rxt(239)* y(38) +rxt(296)* y(46) +rxt(304)* y(48) +rxt(290)* y(55) & + +rxt(317)* y(61) +rxt(322)* y(64) +rxt(326)* y(67) +rxt(339)* y(74) & + +rxt(352)* y(76) +rxt(346)* y(79) +rxt(376)* y(84) +rxt(364)* y(88) & + +rxt(370)* y(89) +rxt(380)* y(91) +rxt(387)* y(96) +rxt(392)* y(100) & + +rxt(395)* y(103) +rxt(401)* y(106) +rxt(282)* y(137) + rxt(408) & + + het_rates(24))* y(24) + prod(146) = (rxt(255)*y(108) +rxt(258)*y(109) +rxt(169)*y(1) + & + rxt(174)*y(25) +rxt(180)*y(42) +rxt(181)*y(43) +rxt(202)*y(11) + & + rxt(215)*y(30) +rxt(238)*y(38) +rxt(268)*y(20) +rxt(277)*y(18) + & + rxt(279)*y(136) +.350_r8*rxt(286)*y(135) +rxt(308)*y(52) + & + rxt(309)*y(53) +rxt(310)*y(51) +rxt(329)*y(66) + & + .200_r8*rxt(349)*y(80) +.500_r8*rxt(358)*y(81) +rxt(372)*y(90) + & + .250_r8*rxt(385)*y(94) +rxt(441)*y(156) +.500_r8*rxt(444)*y(157)) & + *y(23) + (rxt(273)*y(16) +rxt(281)*y(137) +.250_r8*rxt(289)*y(55) + & + rxt(295)*y(46) +rxt(316)*y(61) +rxt(321)*y(64) +rxt(334)*y(73) + & + .470_r8*rxt(343)*y(79) +.920_r8*rxt(362)*y(88) + & + .794_r8*rxt(368)*y(89) +.900_r8*rxt(375)*y(84) +rxt(378)*y(91) + & + .900_r8*rxt(386)*y(96) +.900_r8*rxt(393)*y(100) + & + .900_r8*rxt(396)*y(103) +rxt(400)*y(106))*y(9) + (rxt(218)*y(30) + & + 2.000_r8*rxt(275)*y(16) +rxt(297)*y(46) +.900_r8*rxt(305)*y(48) + & + rxt(318)*y(61) +.300_r8*rxt(327)*y(67) +.730_r8*rxt(347)*y(79) + & + rxt(353)*y(76) +rxt(366)*y(88) +.800_r8*rxt(381)*y(91))*y(16) & + + (.120_r8*rxt(293)*y(44) +.190_r8*rxt(314)*y(59) + & + .060_r8*rxt(336)*y(77) +.275_r8*rxt(342)*y(78) + & + .060_r8*rxt(360)*y(83) +rxt(398)*y(105))*y(1) + (rxt(269)*y(19) + & + .470_r8*rxt(345)*y(79) +rxt(363)*y(88) +.794_r8*rxt(369)*y(89) + & + rxt(373)*y(90) +rxt(379)*y(91))*y(11) + (rxt(254)*y(108) + & + rxt(259)*y(109) +rxt(209)*y(25) +rxt(212)*y(19))*y(28) & + + (.470_r8*rxt(348)*y(79) +rxt(367)*y(88) +rxt(382)*y(91))*y(48) & + + (rxt(179)*y(25) +rxt(271)*y(19))*y(2) + (rxt(163)*y(22) + & + rxt(291)*y(56))*y(4) + (rxt(15) +rxt(206))*y(13) & + + (1.340_r8*rxt(66) +.660_r8*rxt(67))*y(78) +rxt(157)*y(15)*y(3) & + +.700_r8*rxt(390)*y(98)*y(10) +rxt(236)*y(37)*y(19) & + +1.200_r8*rxt(298)*y(46)*y(46) +rxt(69)*y(47) +rxt(61)*y(50) & + +2.000_r8*rxt(79)*y(52) +2.000_r8*rxt(82)*y(53) +rxt(292)*y(56) & + +rxt(71)*y(62) +rxt(62)*y(65) +rxt(78)*y(66) +rxt(74)*y(68) & + +.900_r8*rxt(83)*y(85) +.560_r8*rxt(81)*y(86) +rxt(76)*y(90) & + +rxt(77)*y(93) +rxt(86)*y(107) +rxt(280)*y(137) + loss(90) = (rxt(179)* y(2) +rxt(174)* y(23) +rxt(209)* y(28) + rxt(22) & + + het_rates(25))* y(25) + prod(90) = (.500_r8*rxt(408) +rxt(178)*y(24))*y(24) +rxt(172)*y(23)*y(23) + loss(148) = (rxt(134)* y(3) +rxt(250)* y(141) +rxt(442)* y(165) + rxt(19) & + + rxt(20) + rxt(21) + het_rates(134))* y(134) + prod(148) = (rxt(255)*y(108) +rxt(256)*y(115) +rxt(257)*y(113) + & + rxt(258)*y(109) +rxt(262)*y(125) +rxt(266)*y(15) +rxt(170)*y(24) + & + rxt(171)*y(23) +rxt(173)*y(21) +rxt(174)*y(25) +rxt(199)*y(12) + & + rxt(205)*y(13) +rxt(226)*y(33) +rxt(230)*y(34) +rxt(246)*y(39) + & + rxt(270)*y(19) +rxt(278)*y(17) +rxt(279)*y(136) +rxt(287)*y(45) + & + rxt(294)*y(49) +rxt(300)*y(50) +rxt(307)*y(54) +rxt(319)*y(62) + & + rxt(320)*y(60) +rxt(323)*y(65) +rxt(324)*y(63) +rxt(328)*y(69) + & + rxt(330)*y(68) +.500_r8*rxt(341)*y(78) +rxt(383)*y(92) + & + rxt(384)*y(92))*y(23) + (rxt(450)*y(34) +rxt(451)*y(40) + & + rxt(455)*y(34) +rxt(461)*y(34) +rxt(462)*y(40))*y(33) +rxt(167)*y(24) & + *y(22) +rxt(87)*y(166) + loss(149) = (rxt(207)* y(1) +rxt(213)* y(15) +rxt(212)* y(19) +rxt(208) & + * y(21) + (rxt(210) +rxt(211))* y(24) +rxt(209)* y(25) +rxt(229) & + * y(34) +rxt(233)* y(35) +rxt(285)* y(45) +rxt(254)* y(108) +rxt(259) & + * y(109) +rxt(265)* y(124) +rxt(264)* y(125) + het_rates(28))* y(28) + prod(149) = (2.000_r8*rxt(138)*y(110) +2.000_r8*rxt(139)*y(111) + & + 2.000_r8*rxt(140)*y(112) +2.000_r8*rxt(141)*y(120) +rxt(142)*y(121) + & + rxt(143)*y(113) +rxt(144)*y(118) +rxt(145)*y(119) + & + 4.000_r8*rxt(146)*y(114) +rxt(148)*y(117) +rxt(155)*y(139) + & + rxt(160)*y(33))*y(3) + (rxt(24) +rxt(214)*y(2) +rxt(215)*y(23) + & + rxt(218)*y(16) +rxt(219)*y(9) +2.000_r8*rxt(221)*y(30) + & + rxt(223)*y(30) +rxt(243)*y(38) +rxt(438)*y(164))*y(30) & + + (rxt(255)*y(108) +3.000_r8*rxt(256)*y(115) +rxt(257)*y(113) + & + rxt(260)*y(118) +rxt(261)*y(119) +rxt(226)*y(33))*y(23) + (rxt(28) + & + rxt(227)*y(2))*y(33) +2.000_r8*rxt(23)*y(29) +2.000_r8*rxt(26)*y(32) & + +rxt(27)*y(34) +rxt(29)*y(35) +rxt(31)*y(36) +rxt(56)*y(139) + loss(43) = ( + rxt(23) + het_rates(29))* y(29) + prod(43) = (rxt(449)*y(35) +rxt(450)*y(34) +rxt(454)*y(35) +rxt(455)*y(34) + & + rxt(460)*y(35) +rxt(461)*y(34))*y(33) +rxt(233)*y(35)*y(28) & + +rxt(222)*y(30)*y(30) + loss(151) = (rxt(214)* y(2) +rxt(219)* y(9) +rxt(220)* y(10) +rxt(218)* y(16) & + + (rxt(215) +rxt(216))* y(23) +rxt(217)* y(24) + 2._r8*(rxt(221) + & + rxt(222) +rxt(223) +rxt(224))* y(30) + (rxt(242) +rxt(243) +rxt(244)) & + * y(38) +rxt(438)* y(164) + rxt(24) + het_rates(30))* y(30) + prod(151) = (rxt(207)*y(1) +rxt(211)*y(24) +rxt(229)*y(34))*y(28) & + + (rxt(228)*y(34) +rxt(231)*y(35))*y(2) + (rxt(25) +rxt(440)*y(164)) & + *y(31) +rxt(230)*y(34)*y(23) +2.000_r8*rxt(225)*y(32) +rxt(30)*y(35) + loss(56) = (rxt(440)* y(164) + rxt(25) + het_rates(31))* y(31) + prod(56) = (rxt(223)*y(30) +rxt(242)*y(38))*y(30) + loss(29) = ( + rxt(26) + rxt(225) + het_rates(32))* y(32) + prod(29) =rxt(224)*y(30)*y(30) + loss(133) = (rxt(227)* y(2) +rxt(160)* y(3) +rxt(226)* y(23) + (rxt(450) + & + rxt(455) +rxt(461))* y(34) + (rxt(449) +rxt(454) +rxt(460))* y(35) & + + (rxt(451) +rxt(462))* y(40) + rxt(28) + het_rates(33))* y(33) + prod(133) = (rxt(213)*y(15) +2.000_r8*rxt(254)*y(108) +rxt(259)*y(109) + & + rxt(264)*y(125) +rxt(265)*y(124) +rxt(208)*y(21) +rxt(209)*y(25) + & + rxt(210)*y(24) +rxt(212)*y(19) +rxt(229)*y(34) +rxt(285)*y(45))*y(28) & + +rxt(216)*y(30)*y(23) + loss(110) = (rxt(228)* y(2) +rxt(230)* y(23) +rxt(229)* y(28) + (rxt(450) + & + rxt(455) +rxt(461))* y(33) + rxt(27) + het_rates(34))* y(34) + prod(110) = (rxt(447) +rxt(453) +rxt(458) +rxt(232)*y(23))*y(35) & + +rxt(217)*y(30)*y(24) + loss(117) = (rxt(231)* y(2) +rxt(232)* y(23) +rxt(233)* y(28) + (rxt(449) + & + rxt(454) +rxt(460))* y(33) + rxt(29) + rxt(30) + rxt(447) + rxt(453) & + + rxt(458) + het_rates(35))* y(35) + prod(117) =rxt(220)*y(30)*y(10) + loss(48) = ( + rxt(31) + het_rates(36))* y(36) + prod(48) = (rxt(451)*y(40) +rxt(462)*y(40))*y(33) +rxt(244)*y(38)*y(30) + loss(134) = (rxt(234)* y(1) +rxt(236)* y(19) +rxt(235)* y(24) & + + het_rates(37))* y(37) + prod(134) = (rxt(147)*y(109) +rxt(148)*y(117) +rxt(149)*y(116) + & + 2.000_r8*rxt(150)*y(122) +2.000_r8*rxt(151)*y(123) + & + 3.000_r8*rxt(152)*y(124) +2.000_r8*rxt(153)*y(125) +rxt(161)*y(39)) & + *y(3) + (rxt(32) +rxt(237)*y(2) +rxt(238)*y(23) +rxt(240)*y(9) + & + rxt(242)*y(30) +rxt(243)*y(30) +2.000_r8*rxt(245)*y(38) + & + rxt(439)*y(164))*y(38) + (rxt(258)*y(109) +2.000_r8*rxt(262)*y(125) + & + 3.000_r8*rxt(263)*y(124) +rxt(246)*y(39))*y(23) + (rxt(259)*y(109) + & + 2.000_r8*rxt(264)*y(125) +3.000_r8*rxt(265)*y(124))*y(28) & + + (rxt(34) +rxt(247)*y(2))*y(39) +rxt(31)*y(36) +rxt(33)*y(40) & + +rxt(35)*y(41) + loss(143) = (rxt(237)* y(2) +rxt(240)* y(9) +rxt(241)* y(10) +rxt(238)* y(23) & + +rxt(239)* y(24) + (rxt(242) +rxt(243) +rxt(244))* y(30) & + + 2._r8*rxt(245)* y(38) +rxt(439)* y(164) + rxt(32) + het_rates(38)) & + * y(38) + prod(143) = (rxt(248)*y(40) +rxt(249)*y(41))*y(2) +rxt(234)*y(37)*y(1) & + +rxt(36)*y(41) + loss(107) = (rxt(247)* y(2) +rxt(161)* y(3) +rxt(246)* y(23) + rxt(34) & + + het_rates(39))* y(39) + prod(107) = (rxt(235)*y(24) +rxt(236)*y(19))*y(37) + loss(100) = (rxt(248)* y(2) + (rxt(451) +rxt(462))* y(33) + rxt(33) & + + het_rates(40))* y(40) + prod(100) = (rxt(448) +rxt(456) +rxt(459))*y(41) +rxt(239)*y(38)*y(24) + loss(86) = (rxt(249)* y(2) + rxt(35) + rxt(36) + rxt(448) + rxt(456) & + + rxt(459) + het_rates(41))* y(41) + prod(86) =rxt(241)*y(38)*y(10) + loss(94) = ((rxt(465) +rxt(466))* y(2) +rxt(473)* y(4) +rxt(477)* y(132) & + + het_rates(127))* y(127) + prod(94) = 0._r8 + loss(102) = (rxt(468)* y(8) +rxt(469)* y(9) +rxt(476)* y(132) + rxt(474) & + + het_rates(128))* y(128) + prod(102) = (rxt(96) +rxt(108) +rxt(463)*y(130) +rxt(470)*y(129) + & + rxt(473)*y(127))*y(4) +rxt(467)*y(130)*y(126) + loss(76) = (rxt(472)* y(2) + (rxt(470) +rxt(471))* y(4) + het_rates(129)) & + * y(129) + prod(76) =rxt(95)*y(8) + loss(91) = (rxt(463)* y(4) +rxt(467)* y(126) + rxt(464) + het_rates(130)) & + * y(130) + prod(91) = (rxt(92) +rxt(93) +rxt(94) +rxt(105) +rxt(106) +rxt(107) + & + rxt(466)*y(127) +rxt(472)*y(129))*y(2) + (rxt(98) +rxt(99) + & + rxt(100) +rxt(110) +rxt(111) +rxt(112))*y(4) + loss(103) = (rxt(475)* y(132) + het_rates(131))* y(131) + prod(103) = (rxt(474) +rxt(468)*y(8) +rxt(469)*y(9))*y(128) +rxt(465)*y(127) & + *y(2) +rxt(471)*y(129)*y(4) +rxt(7)*y(9) +rxt(464)*y(130) + loss(77) = (rxt(183)* y(2) +rxt(182)* y(4) + het_rates(133))* y(133) + prod(77) = (rxt(465)*y(2) +.900_r8*rxt(477)*y(132))*y(127) & + +.800_r8*rxt(475)*y(132)*y(131) + loss(104) = (rxt(477)* y(127) +rxt(476)* y(128) +rxt(475)* y(131) & + + het_rates(132))* y(132) + prod(104) = (rxt(96) +rxt(98) +rxt(99) +rxt(100) +rxt(108) +rxt(110) + & + rxt(111) +rxt(112))*y(4) + (rxt(92) +rxt(93) +rxt(94) +rxt(105) + & + rxt(106) +rxt(107))*y(2) +rxt(95)*y(8) +rxt(7)*y(9) + loss(118) = (rxt(314)* y(1) +rxt(315)* y(11) +rxt(313)* y(23) & + + het_rates(59))* y(59) + prod(118) =.070_r8*rxt(360)*y(83)*y(1) +.700_r8*rxt(68)*y(77) + loss(113) = (rxt(360)* y(1) +rxt(361)* y(11) +rxt(359)* y(23) & + + het_rates(83))* y(83) + prod(113) = 0._r8 + loss(106) = (rxt(321)* y(9) +rxt(322)* y(24) + het_rates(64))* y(64) + prod(106) = (rxt(313)*y(59) +.500_r8*rxt(323)*y(65))*y(23) + loss(120) = (rxt(301)* y(11) +rxt(300)* y(23) + rxt(61) + het_rates(50)) & + * y(50) + prod(120) = (rxt(295)*y(46) +.270_r8*rxt(316)*y(61) +rxt(321)*y(64) + & + rxt(334)*y(73) +rxt(338)*y(74) +.400_r8*rxt(375)*y(84))*y(9) & + + (.500_r8*rxt(314)*y(59) +.040_r8*rxt(336)*y(77))*y(1) & + + (.500_r8*rxt(299)*y(47) +rxt(310)*y(51))*y(23) & + + (.800_r8*rxt(297)*y(16) +1.600_r8*rxt(298)*y(46))*y(46) +rxt(69) & + *y(47) +rxt(62)*y(65) +rxt(84)*y(75) +.400_r8*rxt(83)*y(85) + loss(89) = (rxt(294)* y(23) + het_rates(49))* y(49) + prod(89) = (.250_r8*rxt(314)*y(59) +.200_r8*rxt(360)*y(83))*y(1) & + + (.250_r8*rxt(304)*y(48) +.250_r8*rxt(352)*y(76))*y(24) & + +.100_r8*rxt(305)*y(48)*y(16) + loss(87) = (rxt(323)* y(23) + rxt(62) + het_rates(65))* y(65) + prod(87) =rxt(322)*y(64)*y(24) + loss(131) = (rxt(302)* y(9) +rxt(303)* y(10) +rxt(305)* y(16) +rxt(304) & + * y(24) + 2._r8*rxt(306)* y(48) +rxt(348)* y(79) +rxt(367)* y(88) & + +rxt(382)* y(91) + het_rates(48))* y(48) + prod(131) = (rxt(325)*y(67) +rxt(338)*y(74) +.530_r8*rxt(343)*y(79) + & + rxt(350)*y(76))*y(9) + (rxt(301)*y(50) +rxt(331)*y(68) + & + .530_r8*rxt(345)*y(79) +rxt(351)*y(76))*y(11) & + + (.300_r8*rxt(327)*y(67) +.260_r8*rxt(347)*y(79) +rxt(353)*y(76)) & + *y(16) + (rxt(300)*y(50) +.500_r8*rxt(307)*y(54) +rxt(330)*y(68)) & + *y(23) + (.600_r8*rxt(64) +rxt(311))*y(58) +.530_r8*rxt(348)*y(79) & + *y(48) +rxt(73)*y(63) +rxt(78)*y(66) +rxt(74)*y(68) +rxt(72)*y(69) & + +rxt(80)*y(72) +rxt(84)*y(75) +2.000_r8*rxt(355)*y(76)*y(76) & + +.300_r8*rxt(68)*y(77) +1.340_r8*rxt(66)*y(78) +.130_r8*rxt(81) & + *y(86) + loss(78) = (rxt(307)* y(23) + rxt(63) + het_rates(54))* y(54) + prod(78) = (.750_r8*rxt(304)*y(48) +.750_r8*rxt(352)*y(76))*y(24) + loss(75) = (rxt(312)* y(23) + rxt(64) + rxt(311) + het_rates(58))* y(58) + prod(75) =rxt(303)*y(48)*y(10) + loss(65) = (rxt(332)* y(23) + het_rates(82))* y(82) + prod(65) =.100_r8*rxt(375)*y(84)*y(9) +rxt(315)*y(59)*y(11) + loss(52) = (rxt(287)* y(23) +rxt(285)* y(28) + het_rates(45))* y(45) + prod(52) = 0._r8 + loss(82) = (rxt(293)* y(1) +rxt(288)* y(23) +rxt(284)* y(28) + het_rates(44)) & + * y(44) + prod(82) = 0._r8 + loss(30) = (rxt(371)* y(23) + het_rates(71))* y(71) + prod(30) = 0._r8 + loss(81) = (rxt(358)* y(23) + rxt(65) + rxt(357) + het_rates(81))* y(81) + prod(81) =rxt(356)*y(76)*y(10) + loss(31) = (rxt(333)* y(23) + het_rates(70))* y(70) + prod(31) = 0._r8 + loss(57) = (rxt(334)* y(9) + het_rates(73))* y(73) + prod(57) =rxt(333)*y(70)*y(23) + loss(95) = (rxt(375)* y(9) +rxt(376)* y(24) + het_rates(84))* y(84) + prod(95) = (rxt(371)*y(71) +rxt(377)*y(85))*y(23) + loss(92) = (rxt(377)* y(23) + rxt(83) + het_rates(85))* y(85) + prod(92) =rxt(376)*y(84)*y(24) + loss(70) = (rxt(337)* y(23) + rxt(80) + het_rates(72))* y(72) + prod(70) =.800_r8*rxt(375)*y(84)*y(9) +.800_r8*rxt(83)*y(85) + loss(93) = (rxt(338)* y(9) +rxt(339)* y(24) + het_rates(74))* y(74) + prod(93) = (rxt(337)*y(72) +rxt(340)*y(75))*y(23) + loss(58) = (rxt(340)* y(23) + rxt(84) + het_rates(75))* y(75) + prod(58) =rxt(339)*y(74)*y(24) + loss(36) = (rxt(385)* y(23) + het_rates(94))* y(94) + prod(36) = 0._r8 + loss(37) = (rxt(389)* y(23) + het_rates(95))* y(95) + prod(37) =.250_r8*rxt(385)*y(94)*y(23) + loss(79) = (rxt(386)* y(9) +rxt(387)* y(24) + het_rates(96))* y(96) + prod(79) = (.700_r8*rxt(385)*y(94) +rxt(388)*y(97))*y(23) + loss(63) = (rxt(388)* y(23) + rxt(85) + het_rates(97))* y(97) + prod(63) =rxt(387)*y(96)*y(24) + loss(44) = (rxt(390)* y(10) + het_rates(98))* y(98) + prod(44) =rxt(389)*y(95)*y(23) + loss(116) = (rxt(400)* y(9) +rxt(401)* y(24) + het_rates(106))* y(106) + prod(116) = (rxt(397)*y(105) +rxt(402)*y(107))*y(23) +rxt(399)*y(105)*y(11) + loss(72) = (rxt(402)* y(23) + rxt(86) + het_rates(107))* y(107) + prod(72) =rxt(401)*y(106)*y(24) + loss(80) = ( + rxt(81) + het_rates(86))* y(86) + prod(80) = (.900_r8*rxt(386)*y(96) +.900_r8*rxt(393)*y(100) + & + .620_r8*rxt(396)*y(103))*y(9) +.700_r8*rxt(390)*y(98)*y(10) & + +.900_r8*rxt(85)*y(97) + loss(98) = (rxt(309)* y(23) + rxt(82) + het_rates(53))* y(53) + prod(98) = (.020_r8*rxt(362)*y(88) +.250_r8*rxt(378)*y(91) + & + .450_r8*rxt(386)*y(96) +.900_r8*rxt(393)*y(100) + & + .340_r8*rxt(396)*y(103))*y(9) + (.250_r8*rxt(379)*y(11) + & + .100_r8*rxt(381)*y(16) +.250_r8*rxt(382)*y(48))*y(91) & + + (.650_r8*rxt(286)*y(135) +.200_r8*rxt(308)*y(52))*y(23) & + +.130_r8*rxt(81)*y(86) +.450_r8*rxt(85)*y(97) + loss(32) = (rxt(391)* y(23) + het_rates(99))* y(99) + prod(32) = 0._r8 + loss(64) = (rxt(393)* y(9) +rxt(392)* y(24) + het_rates(100))* y(100) + prod(64) =rxt(391)*y(99)*y(23) + loss(1) = ( + het_rates(101))* y(101) + prod(1) =rxt(392)*y(100)*y(24) + loss(33) = (rxt(394)* y(23) + het_rates(102))* y(102) + prod(33) = 0._r8 + loss(73) = (rxt(396)* y(9) +rxt(395)* y(24) + het_rates(103))* y(103) + prod(73) =rxt(394)*y(102)*y(23) + loss(2) = ( + het_rates(104))* y(104) + prod(2) =rxt(395)*y(103)*y(24) + loss(127) = (rxt(362)* y(9) +rxt(363)* y(11) +rxt(366)* y(16) +rxt(364) & + * y(24) +rxt(367)* y(48) + het_rates(88))* y(88) + prod(127) = (rxt(359)*y(83) +.200_r8*rxt(365)*y(93))*y(23) + loss(129) = (rxt(336)* y(1) +rxt(335)* y(23) + rxt(68) + het_rates(77)) & + * y(77) + prod(129) = (.320_r8*rxt(362)*y(9) +.350_r8*rxt(363)*y(11) + & + .260_r8*rxt(366)*y(16) +.350_r8*rxt(367)*y(48))*y(88) & + + (.039_r8*rxt(368)*y(9) +.039_r8*rxt(369)*y(11) + & + .039_r8*rxt(370)*y(24))*y(89) + (.200_r8*rxt(360)*y(83) + & + rxt(398)*y(105))*y(1) +rxt(400)*y(106)*y(9) +.402_r8*rxt(77)*y(93) & + +rxt(86)*y(107) + loss(123) = (rxt(342)* y(1) +rxt(341)* y(23) + rxt(66) + rxt(67) & + + het_rates(78))* y(78) + prod(123) = (.230_r8*rxt(362)*y(9) +.250_r8*rxt(363)*y(11) + & + .190_r8*rxt(366)*y(16) +.250_r8*rxt(367)*y(48))*y(88) & + + (.167_r8*rxt(368)*y(9) +.167_r8*rxt(369)*y(11) + & + .167_r8*rxt(370)*y(24))*y(89) + (.400_r8*rxt(360)*y(83) + & + rxt(398)*y(105))*y(1) +rxt(400)*y(106)*y(9) +.288_r8*rxt(77)*y(93) & + +rxt(86)*y(107) + loss(128) = ((rxt(343) +rxt(344))* y(9) +rxt(345)* y(11) +rxt(347)* y(16) & + +rxt(346)* y(24) +rxt(348)* y(48) + het_rates(79))* y(79) + prod(128) = (rxt(335)*y(77) +.500_r8*rxt(341)*y(78) +.200_r8*rxt(349)*y(80)) & + *y(23) + loss(59) = (rxt(349)* y(23) + het_rates(80))* y(80) + prod(59) =rxt(346)*y(79)*y(24) + loss(130) = (rxt(350)* y(9) +rxt(356)* y(10) +rxt(351)* y(11) +rxt(353) & + * y(16) +rxt(352)* y(24) +rxt(354)* y(48) + 2._r8*rxt(355)* y(76) & + + het_rates(76))* y(76) + prod(130) = (.500_r8*rxt(341)*y(78) +.500_r8*rxt(349)*y(80))*y(23) & + + (rxt(65) +rxt(357))*y(81) +.200_r8*rxt(360)*y(83)*y(1) & + +.660_r8*rxt(66)*y(78) + loss(109) = (rxt(295)* y(9) +rxt(297)* y(16) +rxt(296)* y(24) & + + 2._r8*rxt(298)* y(46) + het_rates(46))* y(46) + prod(109) = (rxt(287)*y(45) +.500_r8*rxt(299)*y(47))*y(23) +rxt(285)*y(45) & + *y(28) +rxt(80)*y(72) + loss(60) = (rxt(299)* y(23) + rxt(69) + het_rates(47))* y(47) + prod(60) =rxt(296)*y(46)*y(24) + loss(88) = (rxt(398)* y(1) +rxt(399)* y(11) +rxt(397)* y(23) & + + het_rates(105))* y(105) + prod(88) = 0._r8 + loss(35) = (rxt(320)* y(23) + het_rates(60))* y(60) + prod(35) = 0._r8 + loss(111) = (rxt(316)* y(9) +rxt(318)* y(16) +rxt(317)* y(24) & + + het_rates(61))* y(61) + prod(111) = (rxt(319)*y(62) +rxt(320)*y(60))*y(23) + loss(66) = (rxt(319)* y(23) + rxt(71) + het_rates(62))* y(62) + prod(66) =rxt(317)*y(61)*y(24) + loss(96) = (rxt(324)* y(23) + rxt(73) + het_rates(63))* y(63) + prod(96) = (.820_r8*rxt(316)*y(61) +.500_r8*rxt(334)*y(73) + & + .250_r8*rxt(375)*y(84) +.100_r8*rxt(400)*y(106))*y(9) & + +.820_r8*rxt(318)*y(61)*y(16) +.820_r8*rxt(71)*y(62) & + +.250_r8*rxt(83)*y(85) +.100_r8*rxt(86)*y(107) + loss(67) = (rxt(328)* y(23) + rxt(72) + het_rates(69))* y(69) + prod(67) =rxt(326)*y(67)*y(24) + loss(84) = (rxt(277)* y(23) + het_rates(18))* y(18) + prod(84) = (rxt(276)*y(16) +.300_r8*rxt(297)*y(46) +.500_r8*rxt(327)*y(67) + & + .250_r8*rxt(347)*y(79) +.250_r8*rxt(366)*y(88) + & + .300_r8*rxt(381)*y(91))*y(16) + loss(49) = (rxt(310)* y(23) + het_rates(51))* y(51) + prod(49) = (.200_r8*rxt(297)*y(16) +.400_r8*rxt(298)*y(46))*y(46) + loss(112) = (rxt(308)* y(23) + rxt(79) + het_rates(52))* y(52) + prod(112) = (.530_r8*rxt(343)*y(9) +.530_r8*rxt(345)*y(11) + & + .260_r8*rxt(347)*y(16) +.530_r8*rxt(348)*y(48))*y(79) & + + (.250_r8*rxt(378)*y(9) +.250_r8*rxt(379)*y(11) + & + .100_r8*rxt(381)*y(16) +.250_r8*rxt(382)*y(48))*y(91) +rxt(291)*y(56) & + *y(4) +.020_r8*rxt(362)*y(88)*y(9) + loss(122) = (rxt(329)* y(23) + rxt(78) + het_rates(66))* y(66) + prod(122) = (.220_r8*rxt(343)*y(9) +.220_r8*rxt(345)*y(11) + & + .230_r8*rxt(347)*y(16) +.220_r8*rxt(348)*y(48))*y(79) & + + (.250_r8*rxt(378)*y(9) +.250_r8*rxt(379)*y(11) + & + .100_r8*rxt(381)*y(16) +.250_r8*rxt(382)*y(48))*y(91) & + + (.500_r8*rxt(323)*y(65) +.500_r8*rxt(358)*y(81))*y(23) & + +.020_r8*rxt(362)*y(88)*y(9) +.200_r8*rxt(327)*y(67)*y(16) + loss(99) = (rxt(289)* y(9) +rxt(290)* y(24) + het_rates(55))* y(55) + prod(99) =rxt(288)*y(44)*y(23) + loss(71) = (rxt(291)* y(4) + rxt(292) + het_rates(56))* y(56) + prod(71) =.750_r8*rxt(289)*y(55)*y(9) +rxt(70)*y(57) + loss(38) = ( + rxt(70) + het_rates(57))* y(57) + prod(38) =rxt(290)*y(55)*y(24) + loss(61) = (rxt(374)* y(23) + het_rates(87))* y(87) + prod(61) = (.330_r8*rxt(362)*y(9) +.400_r8*rxt(363)*y(11) + & + .300_r8*rxt(366)*y(16) +.400_r8*rxt(367)*y(48))*y(88) & + + (rxt(372)*y(23) +rxt(373)*y(11))*y(90) + loss(121) = (rxt(325)* y(9) +rxt(327)* y(16) +rxt(326)* y(24) & + + het_rates(67))* y(67) + prod(121) = (rxt(324)*y(63) +rxt(328)*y(69))*y(23) + loss(125) = (rxt(331)* y(11) +rxt(330)* y(23) + rxt(74) + het_rates(68)) & + * y(68) + prod(125) = (.250_r8*rxt(343)*y(79) +.020_r8*rxt(362)*y(88) + & + .250_r8*rxt(378)*y(91) +.450_r8*rxt(386)*y(96) + & + .540_r8*rxt(396)*y(103))*y(9) + (.500_r8*rxt(327)*y(67) + & + .240_r8*rxt(347)*y(79) +.100_r8*rxt(381)*y(91))*y(16) & + + (.950_r8*rxt(336)*y(77) +.800_r8*rxt(342)*y(78))*y(1) & + + (.250_r8*rxt(345)*y(79) +.250_r8*rxt(379)*y(91))*y(11) & + + (rxt(329)*y(66) +rxt(332)*y(82))*y(23) + (.250_r8*rxt(348)*y(79) + & + .250_r8*rxt(382)*y(91))*y(48) +.180_r8*rxt(81)*y(86) +.450_r8*rxt(85) & + *y(97) + loss(105) = (rxt(368)* y(9) +rxt(369)* y(11) +rxt(370)* y(24) & + + het_rates(89))* y(89) + prod(105) =rxt(361)*y(83)*y(11) + loss(114) = (rxt(373)* y(11) +rxt(372)* y(23) + rxt(76) + het_rates(90)) & + * y(90) + prod(114) = (.800_r8*rxt(344)*y(79) +.080_r8*rxt(362)*y(88) + & + .794_r8*rxt(368)*y(89))*y(9) + (.794_r8*rxt(369)*y(11) + & + .794_r8*rxt(370)*y(24))*y(89) + loss(126) = (rxt(378)* y(9) +rxt(379)* y(11) +rxt(381)* y(16) +rxt(380) & + * y(24) +rxt(382)* y(48) + het_rates(91))* y(91) + prod(126) = (.800_r8*rxt(365)*y(93) +rxt(374)*y(87) +rxt(383)*y(92))*y(23) + loss(50) = ((rxt(383) +rxt(384))* y(23) + rxt(75) + het_rates(92))* y(92) + prod(50) =rxt(380)*y(91)*y(24) + loss(85) = (rxt(365)* y(23) + rxt(77) + het_rates(93))* y(93) + prod(85) =rxt(364)*y(88)*y(24) + loss(53) = (rxt(286)* y(23) +rxt(283)* y(28) + het_rates(135))* y(135) + prod(53) = 0._r8 + loss(83) = (rxt(279)* y(23) + het_rates(136))* y(136) + prod(83) = (rxt(281)*y(9) +rxt(282)*y(24))*y(137) +.500_r8*rxt(293)*y(44) & + *y(1) +.350_r8*rxt(286)*y(135)*y(23) + loss(68) = (rxt(281)* y(9) +rxt(282)* y(24) + rxt(280) + het_rates(137)) & + * y(137) + prod(68) =rxt(272)*y(24)*y(19) + loss(39) = (rxt(154)* y(3) + rxt(55) + het_rates(138))* y(138) + prod(39) = (rxt(139)*y(111) +rxt(140)*y(112) +2.000_r8*rxt(141)*y(120) + & + 2.000_r8*rxt(142)*y(121) +rxt(143)*y(113) +rxt(145)*y(119) + & + rxt(148)*y(117) +rxt(149)*y(116) +rxt(150)*y(122) + & + 2.000_r8*rxt(151)*y(123))*y(3) + (rxt(257)*y(113) +rxt(261)*y(119)) & + *y(23) + loss(45) = (rxt(155)* y(3) + rxt(56) + het_rates(139))* y(139) + prod(45) = (rxt(138)*y(110) +rxt(140)*y(112) +rxt(144)*y(118))*y(3) & + +rxt(260)*y(118)*y(23) + loss(47) = ( + rxt(57) + het_rates(140))* y(140) + prod(47) = (rxt(252)*y(15) +rxt(250)*y(134) +rxt(251)*y(21) +rxt(253)*y(12)) & + *y(141) + loss(101) = (rxt(253)* y(12) +rxt(252)* y(15) +rxt(251)* y(21) +rxt(250) & + * y(134) + het_rates(141))* y(141) + prod(101) = (rxt(142)*y(121) +rxt(149)*y(116) +2.000_r8*rxt(154)*y(138) + & + rxt(155)*y(139))*y(3) +2.000_r8*rxt(55)*y(138) +rxt(56)*y(139) & + +rxt(57)*y(140) + loss(115) = (rxt(441)* y(23) + rxt(88) + het_rates(156))* y(156) + prod(115) = (rxt(434)*y(23) +rxt(435)*y(4) +rxt(436)*y(1) +rxt(437)*y(10) + & + rxt(438)*y(30) +rxt(439)*y(38) +rxt(440)*y(31))*y(164) & + + (rxt(430)*y(162) +rxt(443)*y(157) +.500_r8*rxt(444)*y(157))*y(23) & + +rxt(445)*y(157)*y(11) +rxt(89)*y(165) + loss(54) = (rxt(445)* y(11) + (rxt(443) +rxt(444))* y(23) + het_rates(157)) & + * y(157) + prod(54) = 0._r8 + loss(3) = ( + rxt(413) + het_rates(158))* y(158) + prod(3) = 0._r8 + loss(4) = ( + het_rates(159))* y(159) + prod(4) = 0._r8 + loss(5) = ( + rxt(419) + het_rates(160))* y(160) + prod(5) = 0._r8 + loss(6) = ( + rxt(420) + het_rates(161))* y(161) + prod(6) = 0._r8 + loss(7) = ( + rxt(414) + het_rates(146))* y(146) + prod(7) = 0._r8 + loss(8) = ( + rxt(415) + het_rates(147))* y(147) + prod(8) = 0._r8 + loss(9) = ( + rxt(417) + het_rates(148))* y(148) + prod(9) = 0._r8 + loss(10) = ( + rxt(416) + het_rates(149))* y(149) + prod(10) = 0._r8 + loss(11) = ( + rxt(418) + het_rates(150))* y(150) + prod(11) = 0._r8 + loss(12) = ( + het_rates(151))* y(151) + prod(12) = 0._r8 + loss(13) = ( + het_rates(152))* y(152) + prod(13) = 0._r8 + loss(14) = ( + het_rates(153))* y(153) + prod(14) = 0._r8 + loss(15) = ( + het_rates(154))* y(154) + prod(15) = 0._r8 + loss(16) = ( + het_rates(155))* y(155) + prod(16) = 0._r8 + loss(62) = (rxt(429)* y(2) +rxt(430)* y(23) + rxt(90) + het_rates(162)) & + * y(162) + prod(62) = 0._r8 + loss(97) = (rxt(433)* y(1) +rxt(432)* y(4) +rxt(431)* y(23) + het_rates(163)) & + * y(163) + prod(97) =rxt(90)*y(162) +rxt(91)*y(164) + loss(132) = (rxt(436)* y(1) +rxt(435)* y(4) +rxt(437)* y(10) +rxt(434)* y(23) & + +rxt(438)* y(30) +rxt(440)* y(31) +rxt(439)* y(38) + rxt(91) & + + het_rates(164))* y(164) + prod(132) = (rxt(431)*y(23) +rxt(432)*y(4) +rxt(433)*y(1))*y(163) & + +rxt(429)*y(162)*y(2) +rxt(88)*y(156) + loss(51) = (rxt(442)* y(134) + rxt(89) + het_rates(165))* y(165) + prod(51) =rxt(441)*y(156)*y(23) +rxt(87)*y(166) + loss(42) = ( + rxt(87) + het_rates(166))* y(166) + prod(42) =rxt(442)*y(165)*y(134) + loss(17) = ( + rxt(406) + rxt(409) + het_rates(142))* y(142) + prod(17) = 0._r8 + loss(18) = ( + rxt(410) + het_rates(143))* y(143) + prod(18) =rxt(406)*y(142) + loss(19) = ( + rxt(407) + rxt(411) + het_rates(144))* y(144) + prod(19) = 0._r8 + loss(20) = ( + rxt(412) + het_rates(145))* y(145) + prod(20) =rxt(407)*y(144) + loss(21) = ( + rxt(421) + het_rates(167))* y(167) + prod(21) = 0._r8 + loss(22) = ( + rxt(422) + het_rates(168))* y(168) + prod(22) = 0._r8 + loss(23) = ( + rxt(423) + het_rates(169))* y(169) + prod(23) = 0._r8 + loss(24) = ( + rxt(424) + het_rates(170))* y(170) + prod(24) = 0._r8 + loss(25) = ( + rxt(425) + het_rates(171))* y(171) + prod(25) = 0._r8 + loss(26) = ( + rxt(426) + het_rates(172))* y(172) + prod(26) = 0._r8 + loss(27) = ( + rxt(427) + het_rates(173))* y(173) + prod(27) = 0._r8 + loss(28) = ( + rxt(428) + het_rates(174))* y(174) + prod(28) = 0._r8 + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..427b3ce262 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_rxt_rates_conv.F90 @@ -0,0 +1,489 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 1) ! rate_const*O3 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 7) ! rate_const*N2O + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 9) ! rate_const*NO + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 12) ! rate_const*HNO3 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 13) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 17) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 19) ! rate_const*CH2O + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 134) ! rate_const*H2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 25) ! rate_const*H2O2 + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 29) ! rate_const*CL2 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 30) ! rate_const*CLO + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 31) ! rate_const*OCLO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 32) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 34) ! rate_const*HOCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 33) ! rate_const*HCL + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 36) ! rate_const*BRCL + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 38) ! rate_const*BRO + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 40) ! rate_const*HOBR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 39) ! rate_const*HBR + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 108) ! rate_const*CH3CL + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 114) ! rate_const*CCL4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 115) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 110) ! rate_const*CFC11 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 111) ! rate_const*CFC12 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 112) ! rate_const*CFC113 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 120) ! rate_const*CFC114 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 121) ! rate_const*CFC115 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 113) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 118) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 119) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 109) ! rate_const*CH3BR + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 116) ! rate_const*CF3BR + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 117) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 124) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 125) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 122) ! rate_const*H1202 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 123) ! rate_const*H2402 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 138) ! rate_const*COF2 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 139) ! rate_const*COFCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 140) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 126) ! rate_const*CO2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 15) ! rate_const*CH4 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 50) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 65) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 54) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 58) ! rate_const*PAN + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 81) ! rate_const*MPAN + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 78) ! rate_const*MACR + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 78) ! rate_const*MACR + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 77) ! rate_const*MVK + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 47) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 57) ! rate_const*EOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 62) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 69) ! rate_const*ROOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 63) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 68) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 92) ! rate_const*XOOH + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*ONITR + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 93) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 66) ! rate_const*HYAC + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 52) ! rate_const*GLYALD + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 72) ! rate_const*MEK + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 86) ! rate_const*BIGALD + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 53) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 85) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 75) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 97) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 107) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 166) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 156) ! rate_const*SO2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 165) ! rate_const*SO3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 162) ! rate_const*OCS + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 164) ! rate_const*SO + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 8) ! rate_const*N + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 2) ! rate_const*O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 4) ! rate_const*O2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 4) ! rate_const*O2 + ! rate_const*N2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 126) ! rate_const*CO2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 2)*sol(:ncol,:, 4) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*O*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*M*O*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 5)*sol(:ncol,:, 2) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 5) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 5)*sol(:ncol,:, 1) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 5)*sol(:ncol,:, 126) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 5) ! rate_const*O2_1S + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 6)*sol(:ncol,:, 2) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 6) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 6) ! rate_const*O2_1D + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 3) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 3)*sol(:ncol,:, 134) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 3)*sol(:ncol,:, 7) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 3)*sol(:ncol,:, 110) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 3)*sol(:ncol,:, 111) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 3)*sol(:ncol,:, 112) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 3)*sol(:ncol,:, 120) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 3)*sol(:ncol,:, 121) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 3)*sol(:ncol,:, 113) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 3)*sol(:ncol,:, 118) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 3)*sol(:ncol,:, 119) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 3)*sol(:ncol,:, 114) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 3)*sol(:ncol,:, 109) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 3)*sol(:ncol,:, 117) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 3)*sol(:ncol,:, 116) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 3)*sol(:ncol,:, 122) ! rate_const*O1D*H1202 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 3)*sol(:ncol,:, 123) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 3)*sol(:ncol,:, 124) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 3)*sol(:ncol,:, 125) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 3)*sol(:ncol,:, 138) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 3)*sol(:ncol,:, 139) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 3)*sol(:ncol,:, 15) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 3)*sol(:ncol,:, 21) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 3)*sol(:ncol,:, 33) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 3)*sol(:ncol,:, 39) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 3)*sol(:ncol,:, 42) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 22)*sol(:ncol,:, 4) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 22)*sol(:ncol,:, 1) ! rate_const*H*O3 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 22)*sol(:ncol,:, 24) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 23)*sol(:ncol,:, 2) ! rate_const*OH*O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 23)*sol(:ncol,:, 1) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 23)*sol(:ncol,:, 24) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*OH*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 23)*sol(:ncol,:, 25) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*H2*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 24)*sol(:ncol,:, 2) ! rate_const*HO2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 24)*sol(:ncol,:, 1) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 25)*sol(:ncol,:, 2) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 42)*sol(:ncol,:, 23) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 43)*sol(:ncol,:, 23) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 133)*sol(:ncol,:, 4) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 133)*sol(:ncol,:, 2) ! rate_const*N2D*O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 8)*sol(:ncol,:, 23) ! rate_const*N*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 8)*sol(:ncol,:, 4) ! rate_const*N*O2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 8)*sol(:ncol,:, 9) ! rate_const*N*NO + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 8)*sol(:ncol,:, 10) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 9)*sol(:ncol,:, 2) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 9)*sol(:ncol,:, 24) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 9)*sol(:ncol,:, 1) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*NO2*O + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 10)*sol(:ncol,:, 2) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 10)*sol(:ncol,:, 1) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 10)*sol(:ncol,:, 11) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 14) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 10)*sol(:ncol,:, 23) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 12)*sol(:ncol,:, 23) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 11)*sol(:ncol,:, 9) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 11)*sol(:ncol,:, 2) ! rate_const*NO3*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 11)*sol(:ncol,:, 23) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 11)*sol(:ncol,:, 24) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 10)*sol(:ncol,:, 24) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 13)*sol(:ncol,:, 23) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 13) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 28)*sol(:ncol,:, 1) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 28)*sol(:ncol,:, 25) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 28)*sol(:ncol,:, 24) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 28)*sol(:ncol,:, 24) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 28)*sol(:ncol,:, 19) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 28)*sol(:ncol,:, 15) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 30)*sol(:ncol,:, 2) ! rate_const*CLO*O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 30)*sol(:ncol,:, 23) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 30)*sol(:ncol,:, 24) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 30)*sol(:ncol,:, 16) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 30)*sol(:ncol,:, 9) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 30)*sol(:ncol,:, 10) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 32) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 33)*sol(:ncol,:, 23) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 33)*sol(:ncol,:, 2) ! rate_const*HCL*O + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 34)*sol(:ncol,:, 2) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 34)*sol(:ncol,:, 28) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 34)*sol(:ncol,:, 23) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 35)*sol(:ncol,:, 2) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 35)*sol(:ncol,:, 23) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 35)*sol(:ncol,:, 28) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 37)*sol(:ncol,:, 1) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 37)*sol(:ncol,:, 24) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 37)*sol(:ncol,:, 19) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 38)*sol(:ncol,:, 2) ! rate_const*BRO*O + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 38)*sol(:ncol,:, 23) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 38)*sol(:ncol,:, 24) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 38)*sol(:ncol,:, 9) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 38)*sol(:ncol,:, 10) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 38)*sol(:ncol,:, 30) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 38)*sol(:ncol,:, 38) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 39)*sol(:ncol,:, 2) ! rate_const*HBR*O + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 40)*sol(:ncol,:, 2) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 41)*sol(:ncol,:, 2) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 141)*sol(:ncol,:, 134) ! rate_const*F*H2O + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 141)*sol(:ncol,:, 21) ! rate_const*F*H2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 141)*sol(:ncol,:, 15) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 141)*sol(:ncol,:, 12) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 108)*sol(:ncol,:, 28) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 108)*sol(:ncol,:, 23) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 115)*sol(:ncol,:, 23) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 113)*sol(:ncol,:, 23) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 109)*sol(:ncol,:, 23) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 109)*sol(:ncol,:, 28) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 118)*sol(:ncol,:, 23) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 119)*sol(:ncol,:, 23) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 125)*sol(:ncol,:, 23) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 124)*sol(:ncol,:, 23) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 125)*sol(:ncol,:, 28) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 124)*sol(:ncol,:, 28) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 15)*sol(:ncol,:, 23) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 20)*sol(:ncol,:, 23) ! rate_const*CO*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 20)*sol(:ncol,:, 23) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 19)*sol(:ncol,:, 11) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 19)*sol(:ncol,:, 23) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 19)*sol(:ncol,:, 2) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 19)*sol(:ncol,:, 24) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 16)*sol(:ncol,:, 9) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 16)*sol(:ncol,:, 24) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 16)*sol(:ncol,:, 16) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 16)*sol(:ncol,:, 16) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 18)*sol(:ncol,:, 23) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 17)*sol(:ncol,:, 23) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 136)*sol(:ncol,:, 23) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 137) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 137)*sol(:ncol,:, 9) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 137)*sol(:ncol,:, 24) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 135)*sol(:ncol,:, 28) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 44)*sol(:ncol,:, 28) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 45)*sol(:ncol,:, 28) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 135)*sol(:ncol,:, 23) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 45)*sol(:ncol,:, 23) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 44)*sol(:ncol,:, 23) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 55)*sol(:ncol,:, 9) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 55)*sol(:ncol,:, 24) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 56)*sol(:ncol,:, 4) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 56) ! rate_const*EO + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 44)*sol(:ncol,:, 1) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 49)*sol(:ncol,:, 23) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 46)*sol(:ncol,:, 9) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 46)*sol(:ncol,:, 24) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 46)*sol(:ncol,:, 16) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 46)*sol(:ncol,:, 46) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 47)*sol(:ncol,:, 23) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 50)*sol(:ncol,:, 23) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 50)*sol(:ncol,:, 11) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 48)*sol(:ncol,:, 9) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 48)*sol(:ncol,:, 10) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 48)*sol(:ncol,:, 24) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 48)*sol(:ncol,:, 16) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 48)*sol(:ncol,:, 48) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 54)*sol(:ncol,:, 23) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 52)*sol(:ncol,:, 23) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 53)*sol(:ncol,:, 23) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 51)*sol(:ncol,:, 23) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 58) ! rate_const*M*PAN + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 58)*sol(:ncol,:, 23) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 59)*sol(:ncol,:, 23) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 59)*sol(:ncol,:, 1) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 59)*sol(:ncol,:, 11) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 61)*sol(:ncol,:, 9) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 61)*sol(:ncol,:, 24) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 61)*sol(:ncol,:, 16) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 62)*sol(:ncol,:, 23) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 60)*sol(:ncol,:, 23) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 64)*sol(:ncol,:, 9) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 64)*sol(:ncol,:, 24) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 65)*sol(:ncol,:, 23) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 63)*sol(:ncol,:, 23) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 67)*sol(:ncol,:, 9) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 67)*sol(:ncol,:, 24) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 67)*sol(:ncol,:, 16) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 69)*sol(:ncol,:, 23) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 66)*sol(:ncol,:, 23) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 68)*sol(:ncol,:, 23) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 68)*sol(:ncol,:, 11) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 82)*sol(:ncol,:, 23) ! rate_const*ONIT*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 70)*sol(:ncol,:, 23) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 73)*sol(:ncol,:, 9) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 77)*sol(:ncol,:, 23) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 77)*sol(:ncol,:, 1) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 72)*sol(:ncol,:, 23) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 74)*sol(:ncol,:, 9) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 74)*sol(:ncol,:, 24) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 75)*sol(:ncol,:, 23) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 78)*sol(:ncol,:, 23) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 78)*sol(:ncol,:, 1) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 79)*sol(:ncol,:, 9) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 79)*sol(:ncol,:, 9) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 79)*sol(:ncol,:, 11) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 79)*sol(:ncol,:, 24) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 79)*sol(:ncol,:, 16) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 79)*sol(:ncol,:, 48) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 80)*sol(:ncol,:, 23) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 76)*sol(:ncol,:, 9) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 76)*sol(:ncol,:, 11) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 76)*sol(:ncol,:, 24) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 76)*sol(:ncol,:, 16) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 76)*sol(:ncol,:, 48) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 76)*sol(:ncol,:, 76) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 76)*sol(:ncol,:, 10) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 81) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 81)*sol(:ncol,:, 23) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 83)*sol(:ncol,:, 23) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 83)*sol(:ncol,:, 1) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 83)*sol(:ncol,:, 11) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 88)*sol(:ncol,:, 9) ! rate_const*ISOPO2*NO + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 88)*sol(:ncol,:, 11) ! rate_const*ISOPO2*NO3 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 88)*sol(:ncol,:, 24) ! rate_const*ISOPO2*HO2 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 93)*sol(:ncol,:, 23) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 88)*sol(:ncol,:, 16) ! rate_const*ISOPO2*CH3O2 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 88)*sol(:ncol,:, 48) ! rate_const*ISOPO2*CH3CO3 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 89)*sol(:ncol,:, 9) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 89)*sol(:ncol,:, 11) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 89)*sol(:ncol,:, 24) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 71)*sol(:ncol,:, 23) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 90)*sol(:ncol,:, 23) ! rate_const*ONITR*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 90)*sol(:ncol,:, 11) ! rate_const*ONITR*NO3 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 87)*sol(:ncol,:, 23) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 84)*sol(:ncol,:, 9) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 84)*sol(:ncol,:, 24) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 85)*sol(:ncol,:, 23) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 91)*sol(:ncol,:, 9) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 91)*sol(:ncol,:, 11) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 91)*sol(:ncol,:, 24) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 91)*sol(:ncol,:, 16) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 91)*sol(:ncol,:, 48) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 94)*sol(:ncol,:, 23) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 96)*sol(:ncol,:, 9) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 96)*sol(:ncol,:, 24) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 97)*sol(:ncol,:, 23) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 95)*sol(:ncol,:, 23) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 98)*sol(:ncol,:, 10) ! rate_const*XOH*NO2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 99)*sol(:ncol,:, 23) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 100)*sol(:ncol,:, 24) ! rate_const*BENO2*HO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 100)*sol(:ncol,:, 9) ! rate_const*BENO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 102)*sol(:ncol,:, 23) ! rate_const*XYLENE*OH + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 103)*sol(:ncol,:, 24) ! rate_const*XYLO2*HO2 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 103)*sol(:ncol,:, 9) ! rate_const*XYLO2*NO + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 105)*sol(:ncol,:, 23) ! rate_const*C10H16*OH + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 105)*sol(:ncol,:, 1) ! rate_const*C10H16*O3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 105)*sol(:ncol,:, 11) ! rate_const*C10H16*NO3 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 106)*sol(:ncol,:, 9) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 106)*sol(:ncol,:, 24) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 107)*sol(:ncol,:, 23) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 11) ! rate_const*NO3 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 10) ! rate_const*NO2 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 142) ! rate_const*CB1 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 144) ! rate_const*OC1 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 24) ! rate_const*HO2 + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 142) ! rate_const*CB1 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 143) ! rate_const*CB2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 144) ! rate_const*OC1 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 145) ! rate_const*OC2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 158) ! rate_const*SO4 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 146) ! rate_const*SOAM + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 147) ! rate_const*SOAI + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 149) ! rate_const*SOAB + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 148) ! rate_const*SOAT + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 150) ! rate_const*SOAX + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 160) ! rate_const*NH4 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 161) ! rate_const*NH4NO3 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 167) ! rate_const*SSLT01 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 168) ! rate_const*SSLT02 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 169) ! rate_const*SSLT03 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 170) ! rate_const*SSLT04 + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 171) ! rate_const*DST01 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 172) ! rate_const*DST02 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 173) ! rate_const*DST03 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 174) ! rate_const*DST04 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 162)*sol(:ncol,:, 2) ! rate_const*OCS*O + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 162)*sol(:ncol,:, 23) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 163)*sol(:ncol,:, 23) ! rate_const*S*OH + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 163)*sol(:ncol,:, 4) ! rate_const*S*O2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 163)*sol(:ncol,:, 1) ! rate_const*S*O3 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 164)*sol(:ncol,:, 23) ! rate_const*SO*OH + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 164)*sol(:ncol,:, 4) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 164)*sol(:ncol,:, 1) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 164)*sol(:ncol,:, 10) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 164)*sol(:ncol,:, 30) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 164)*sol(:ncol,:, 38) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 164)*sol(:ncol,:, 31) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 156)*sol(:ncol,:, 23) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 165)*sol(:ncol,:, 134) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 157)*sol(:ncol,:, 23) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 157)*sol(:ncol,:, 23) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 157)*sol(:ncol,:, 11) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 14) ! rate_const*N2O5 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 35) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 41) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 35)*sol(:ncol,:, 33) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 34)*sol(:ncol,:, 33) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 40)*sol(:ncol,:, 33) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 130)*sol(:ncol,:, 4) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 130) ! rate_const*N2*Op + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 127)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 127)*sol(:ncol,:, 2) ! rate_const*N2p*O + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 130)*sol(:ncol,:, 126) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 128)*sol(:ncol,:, 8) ! rate_const*O2p*N + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 128)*sol(:ncol,:, 9) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 129)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 129)*sol(:ncol,:, 4) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 129)*sol(:ncol,:, 2) ! rate_const*Np*O + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 127)*sol(:ncol,:, 4) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 128) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 131)*sol(:ncol,:, 132) ! rate_const*NOp*e + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 128)*sol(:ncol,:, 132) ! rate_const*O2p*e + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 127)*sol(:ncol,:, 132) ! rate_const*N2p*e + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 new file mode 100644 index 0000000000..70299848b9 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_setrxt.F90 @@ -0,0 +1,600 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,121) = 8.00e-14_r8 + rate(:,:,122) = 3.90e-17_r8 + rate(:,:,125) = 4.20e-13_r8 + rate(:,:,126) = 8.50e-2_r8 + rate(:,:,127) = 1.30e-16_r8 + rate(:,:,129) = 1.00e-20_r8 + rate(:,:,130) = 2.58e-04_r8 + rate(:,:,137) = 1.20e-10_r8 + rate(:,:,138) = 2.02e-10_r8 + rate(:,:,139) = 1.204e-10_r8 + rate(:,:,140) = 1.50e-10_r8 + rate(:,:,141) = 9.75e-11_r8 + rate(:,:,142) = 1.50e-11_r8 + rate(:,:,143) = 7.20e-11_r8 + rate(:,:,144) = 1.794e-10_r8 + rate(:,:,145) = 1.628e-10_r8 + rate(:,:,146) = 2.84e-10_r8 + rate(:,:,147) = 1.674e-10_r8 + rate(:,:,148) = 9.60e-11_r8 + rate(:,:,149) = 4.10e-11_r8 + rate(:,:,150) = 1.012e-10_r8 + rate(:,:,151) = 1.20e-10_r8 + rate(:,:,152) = 4.49e-10_r8 + rate(:,:,153) = 2.57e-10_r8 + rate(:,:,154) = 2.14e-11_r8 + rate(:,:,155) = 1.90e-10_r8 + rate(:,:,156) = 1.31e-10_r8 + rate(:,:,157) = 3.50e-11_r8 + rate(:,:,158) = 9.00e-12_r8 + rate(:,:,159) = 1.20e-10_r8 + rate(:,:,160) = 1.50e-10_r8 + rate(:,:,161) = 1.20e-10_r8 + rate(:,:,165) = 7.20e-11_r8 + rate(:,:,166) = 6.90e-12_r8 + rate(:,:,167) = 1.60e-12_r8 + rate(:,:,171) = 1.80e-12_r8 + rate(:,:,174) = 1.80e-12_r8 + rate(:,:,182) = 5.00e-12_r8 + rate(:,:,183) = 7.00e-13_r8 + rate(:,:,184) = 5.00e-11_r8 + rate(:,:,201) = 1.00e-11_r8 + rate(:,:,202) = 2.20e-11_r8 + rate(:,:,203) = 3.50e-12_r8 + rate(:,:,228) = 1.70e-13_r8 + rate(:,:,279) = 4.50e-13_r8 + rate(:,:,291) = 1.00e-14_r8 + rate(:,:,294) = 7.00e-13_r8 + rate(:,:,297) = 2.00e-13_r8 + rate(:,:,298) = 6.80e-14_r8 + rate(:,:,307) = 1.00e-12_r8 + rate(:,:,308) = 1.00e-11_r8 + rate(:,:,309) = 1.15e-11_r8 + rate(:,:,312) = 4.00e-14_r8 + rate(:,:,329) = 3.00e-12_r8 + rate(:,:,332) = 6.80e-13_r8 + rate(:,:,333) = 5.40e-11_r8 + rate(:,:,345) = 2.40e-12_r8 + rate(:,:,348) = 1.40e-11_r8 + rate(:,:,351) = 5.00e-12_r8 + rate(:,:,363) = 2.40e-12_r8 + rate(:,:,367) = 1.40e-11_r8 + rate(:,:,369) = 2.40e-12_r8 + rate(:,:,371) = 3.50e-12_r8 + rate(:,:,372) = 4.50e-11_r8 + rate(:,:,379) = 2.40e-12_r8 + rate(:,:,389) = 3.00e-12_r8 + rate(:,:,390) = 1.00e-11_r8 + rate(:,:,394) = 2.3e-11_r8 + rate(:,:,406) = 7.10e-6_r8 + rate(:,:,407) = 7.10e-6_r8 + rate(:,:,409) = 6.34e-8_r8 + rate(:,:,410) = 6.34e-8_r8 + rate(:,:,411) = 6.34e-8_r8 + rate(:,:,412) = 6.34e-8_r8 + rate(:,:,413) = 6.34e-8_r8 + rate(:,:,414) = 6.34e-8_r8 + rate(:,:,415) = 6.34e-8_r8 + rate(:,:,416) = 6.34e-8_r8 + rate(:,:,417) = 6.34e-8_r8 + rate(:,:,418) = 6.34e-8_r8 + rate(:,:,419) = 6.34e-8_r8 + rate(:,:,420) = 6.34e-8_r8 + rate(:,:,421) = 6.34e-8_r8 + rate(:,:,422) = 6.34e-8_r8 + rate(:,:,423) = 6.34e-8_r8 + rate(:,:,424) = 6.34e-8_r8 + rate(:,:,425) = 6.34e-8_r8 + rate(:,:,426) = 6.34e-8_r8 + rate(:,:,427) = 6.34e-8_r8 + rate(:,:,428) = 6.34e-8_r8 + rate(:,:,431) = 6.60E-11_r8 + rate(:,:,432) = 2.30E-12_r8 + rate(:,:,433) = 1.20E-11_r8 + rate(:,:,437) = 1.40E-11_r8 + rate(:,:,438) = 2.80E-11_r8 + rate(:,:,439) = 5.70E-11_r8 + rate(:,:,440) = 1.90E-12_r8 + rate(:,:,467) = 9.0e-10_r8 + rate(:,:,468) = 1.0e-10_r8 + rate(:,:,469) = 4.4e-10_r8 + rate(:,:,470) = 4.0e-10_r8 + rate(:,:,471) = 2.0e-10_r8 + rate(:,:,472) = 1.0e-12_r8 + rate(:,:,473) = 6.0e-11_r8 + rate(:,:,474) = 5.0e-16_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,119) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,123) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,124) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,128) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,131) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,132) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:,133) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:,134) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,135) = 7.25e-11_r8 * exp_fac(:,:) + rate(:,:,136) = 4.63e-11_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 100._r8 * itemp(:,:) ) + rate(:,:,162) = 7.70e-11_r8 * exp_fac(:,:) + rate(:,:,186) = 2.10e-11_r8 * exp_fac(:,:) + rate(:,:,164) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 180._r8 * itemp(:,:) ) + rate(:,:,168) = 1.80e-11_r8 * exp_fac(:,:) + rate(:,:,289) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,316) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,321) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,334) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,338) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,362) = 4.40e-12_r8 * exp_fac(:,:) + rate(:,:,375) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,386) = 4.20e-12_r8 * exp_fac(:,:) + rate(:,:,400) = 4.2e-12_r8 * exp_fac(:,:) + rate(:,:,169) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,170) = 4.80e-11_r8 * exp_fac(:,:) + rate(:,:,238) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,173) = 2.80e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + rate(:,:,175) = 1.60e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,176) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,246) = 5.50e-12_r8 * exp_fac(:,:) + rate(:,:,278) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,299) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,319) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,323) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,328) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,340) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,349) = 2.30e-11_r8 * exp_fac(:,:) + rate(:,:,365) = 1.52e-11_r8 * exp_fac(:,:) + rate(:,:,377) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,388) = 3.80e-12_r8 * exp_fac(:,:) + rate(:,:,402) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,177) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2000._r8 * itemp(:,:) ) + rate(:,:,179) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,360) = 1.05e-14_r8 * exp_fac(:,:) + rate(:,:,181) = 7.80e-13_r8 * exp( -1050._r8 * itemp(:,:) ) + rate(:,:,185) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,187) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,188) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,189) = 1.45e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,191) = 3.30e-12_r8 * exp_fac(:,:) + rate(:,:,210) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,215) = 7.40e-12_r8 * exp_fac(:,:) + rate(:,:,302) = 8.10e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,192) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,247) = 5.80e-12_r8 * exp_fac(:,:) + rate(:,:,193) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,195) = 1.20e-13_r8 * exp_fac(:,:) + rate(:,:,221) = 3.00e-11_r8 * exp_fac(:,:) + rate(:,:,200) = 1.50e-11_r8 * exp( 170._r8 * itemp(:,:) ) + rate(:,:,205) = 1.30e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,207) = 2.30e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,208) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,209) = 1.10e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,211) = 3.60e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,212) = 8.10e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,213) = 7.30e-12_r8 * exp( -1280._r8 * itemp(:,:) ) + rate(:,:,214) = 2.80e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,216) = 6.00e-13_r8 * exp_fac(:,:) + rate(:,:,237) = 1.90e-11_r8 * exp_fac(:,:) + rate(:,:,245) = 1.50e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,217) = 2.60e-12_r8 * exp_fac(:,:) + rate(:,:,219) = 6.40e-12_r8 * exp_fac(:,:) + rate(:,:,244) = 4.10e-13_r8 * exp_fac(:,:) + rate(:,:,218) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,222) = 1.00e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,223) = 3.50e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + rate(:,:,226) = 1.80e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,227) = 1.00e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,229) = 3.40e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,230) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,251) = 1.40e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,231) = 3.60e-12_r8 * exp_fac(:,:) + rate(:,:,262) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,232) = 1.20e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,233) = 6.50e-12_r8 * exp( 135._r8 * itemp(:,:) ) + rate(:,:,234) = 1.60e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,235) = 4.80e-12_r8 * exp( -310._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,236) = 1.70e-11_r8 * exp_fac(:,:) + rate(:,:,264) = 6.30e-12_r8 * exp_fac(:,:) + rate(:,:,239) = 4.50e-12_r8 * exp( 460._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,240) = 8.80e-12_r8 * exp_fac(:,:) + rate(:,:,243) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,242) = 9.50e-13_r8 * exp( 550._r8 * itemp(:,:) ) + rate(:,:,248) = 1.20e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,249) = 1.90e-11_r8 * exp( 215._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,250) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,279) = 4.50e-13_r8 * exp_fac(:,:) + rate(:,:,291) = 1.00e-14_r8 * exp_fac(:,:) + rate(:,:,294) = 7.00e-13_r8 * exp_fac(:,:) + rate(:,:,297) = 2.00e-13_r8 * exp_fac(:,:) + rate(:,:,298) = 6.80e-14_r8 * exp_fac(:,:) + rate(:,:,307) = 1.00e-12_r8 * exp_fac(:,:) + rate(:,:,308) = 1.00e-11_r8 * exp_fac(:,:) + rate(:,:,309) = 1.15e-11_r8 * exp_fac(:,:) + rate(:,:,312) = 4.00e-14_r8 * exp_fac(:,:) + rate(:,:,329) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,332) = 6.80e-13_r8 * exp_fac(:,:) + rate(:,:,333) = 5.40e-11_r8 * exp_fac(:,:) + rate(:,:,345) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,348) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,351) = 5.00e-12_r8 * exp_fac(:,:) + rate(:,:,363) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,367) = 1.40e-11_r8 * exp_fac(:,:) + rate(:,:,369) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,371) = 3.50e-12_r8 * exp_fac(:,:) + rate(:,:,372) = 4.50e-11_r8 * exp_fac(:,:) + rate(:,:,379) = 2.40e-12_r8 * exp_fac(:,:) + rate(:,:,389) = 3.00e-12_r8 * exp_fac(:,:) + rate(:,:,390) = 1.00e-11_r8 * exp_fac(:,:) + rate(:,:,394) = 2.3e-11_r8 * exp_fac(:,:) + rate(:,:,406) = 7.10e-6_r8 * exp_fac(:,:) + rate(:,:,407) = 7.10e-6_r8 * exp_fac(:,:) + rate(:,:,409) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,410) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,411) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,412) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,413) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,414) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,415) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,416) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,417) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,418) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,419) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,420) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,421) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,422) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,423) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,424) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,425) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,426) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,427) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,428) = 6.34e-8_r8 * exp_fac(:,:) + rate(:,:,431) = 6.60E-11_r8 * exp_fac(:,:) + rate(:,:,432) = 2.30E-12_r8 * exp_fac(:,:) + rate(:,:,433) = 1.20E-11_r8 * exp_fac(:,:) + rate(:,:,437) = 1.40E-11_r8 * exp_fac(:,:) + rate(:,:,438) = 2.80E-11_r8 * exp_fac(:,:) + rate(:,:,439) = 5.70E-11_r8 * exp_fac(:,:) + rate(:,:,440) = 1.90E-12_r8 * exp_fac(:,:) + rate(:,:,467) = 9.0e-10_r8 * exp_fac(:,:) + rate(:,:,468) = 1.0e-10_r8 * exp_fac(:,:) + rate(:,:,469) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,470) = 4.0e-10_r8 * exp_fac(:,:) + rate(:,:,471) = 2.0e-10_r8 * exp_fac(:,:) + rate(:,:,472) = 1.0e-12_r8 * exp_fac(:,:) + rate(:,:,473) = 6.0e-11_r8 * exp_fac(:,:) + rate(:,:,474) = 5.0e-16_r8 * exp_fac(:,:) + rate(:,:,252) = 1.60e-10_r8 * exp( -260._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 400._r8 * itemp(:,:) ) + rate(:,:,253) = 6.00e-12_r8 * exp_fac(:,:) + rate(:,:,347) = 5.00e-13_r8 * exp_fac(:,:) + rate(:,:,366) = 5.00e-13_r8 * exp_fac(:,:) + rate(:,:,381) = 5.e-13_r8 * exp_fac(:,:) + rate(:,:,254) = 2.17e-11_r8 * exp( -1130._r8 * itemp(:,:) ) + rate(:,:,255) = 2.40e-12_r8 * exp( -1250._r8 * itemp(:,:) ) + rate(:,:,256) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,257) = 1.05e-12_r8 * exp_fac(:,:) + rate(:,:,260) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,271) = 3.40e-11_r8 * exp_fac(:,:) + rate(:,:,258) = 2.35e-12_r8 * exp( -1300._r8 * itemp(:,:) ) + rate(:,:,259) = 1.40e-11_r8 * exp( -1030._r8 * itemp(:,:) ) + rate(:,:,261) = 1.30e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,263) = 1.35e-12_r8 * exp( -600._r8 * itemp(:,:) ) + rate(:,:,265) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,266) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + rate(:,:,269) = 6.00e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,270) = 5.50e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,272) = 9.7e-15_r8 * exp( 625._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 300._r8 * itemp(:,:) ) + rate(:,:,273) = 2.80e-12_r8 * exp_fac(:,:) + rate(:,:,325) = 2.90e-12_r8 * exp_fac(:,:) + rate(:,:,274) = 4.10e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,275) = 5.00e-13_r8 * exp( -424._r8 * itemp(:,:) ) + rate(:,:,276) = 1.90e-14_r8 * exp( 706._r8 * itemp(:,:) ) + rate(:,:,277) = 2.90e-12_r8 * exp( -345._r8 * itemp(:,:) ) + rate(:,:,280) = 2.40e12_r8 * exp( -7000._r8 * itemp(:,:) ) + rate(:,:,281) = 2.60e-12_r8 * exp( 265._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 700._r8 * itemp(:,:) ) + rate(:,:,282) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,290) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,296) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,317) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,322) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,326) = 8.60e-13_r8 * exp_fac(:,:) + rate(:,:,339) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,346) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,364) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,370) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,376) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,380) = 8.00e-13_r8 * exp_fac(:,:) + rate(:,:,387) = 7.50e-13_r8 * exp_fac(:,:) + rate(:,:,392) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,395) = 1.4e-12_r8 * exp_fac(:,:) + rate(:,:,401) = 7.5e-13_r8 * exp_fac(:,:) + rate(:,:,285) = 7.20e-11_r8 * exp( -70._r8 * itemp(:,:) ) + rate(:,:,287) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:,:) ) + rate(:,:,292) = 1.60e11_r8 * exp( -4150._r8 * itemp(:,:) ) + rate(:,:,293) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:,:) ) + rate(:,:,295) = 2.60e-12_r8 * exp( 365._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 350._r8 * itemp(:,:) ) + rate(:,:,300) = 4.63e-12_r8 * exp_fac(:,:) + rate(:,:,393) = 2.6e-12_r8 * exp_fac(:,:) + rate(:,:,396) = 2.6e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1900._r8 * itemp(:,:) ) + rate(:,:,301) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,314) = 6.50e-15_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 1040._r8 * itemp(:,:) ) + rate(:,:,304) = 4.30e-13_r8 * exp_fac(:,:) + rate(:,:,352) = 4.30e-13_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 500._r8 * itemp(:,:) ) + rate(:,:,305) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,306) = 2.50e-12_r8 * exp_fac(:,:) + rate(:,:,327) = 7.10e-13_r8 * exp_fac(:,:) + rate(:,:,353) = 2.00e-12_r8 * exp_fac(:,:) + rate(:,:,310) = 6.90e-12_r8 * exp( -230._r8 * itemp(:,:) ) + rate(:,:,315) = 4.60e-13_r8 * exp( -1156._r8 * itemp(:,:) ) + rate(:,:,318) = 3.75e-13_r8 * exp( -40._r8 * itemp(:,:) ) + rate(:,:,320) = 8.70e-12_r8 * exp( -615._r8 * itemp(:,:) ) + rate(:,:,330) = 8.40e-13_r8 * exp( 830._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1860._r8 * itemp(:,:) ) + rate(:,:,331) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,373) = 1.40e-12_r8 * exp_fac(:,:) + rate(:,:,335) = 4.13e-12_r8 * exp( 452._r8 * itemp(:,:) ) + rate(:,:,336) = 7.52e-16_r8 * exp( -1521._r8 * itemp(:,:) ) + rate(:,:,337) = 2.30e-12_r8 * exp( -170._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 175._r8 * itemp(:,:) ) + rate(:,:,341) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,374) = 1.86e-11_r8 * exp_fac(:,:) + rate(:,:,342) = 4.40e-15_r8 * exp( -2500._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 360._r8 * itemp(:,:) ) + rate(:,:,343) = 2.70e-12_r8 * exp_fac(:,:) + rate(:,:,344) = 1.30e-13_r8 * exp_fac(:,:) + rate(:,:,350) = 5.30e-12_r8 * exp_fac(:,:) + rate(:,:,368) = 2.70e-12_r8 * exp_fac(:,:) + rate(:,:,378) = 2.7e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 530._r8 * itemp(:,:) ) + rate(:,:,354) = 4.60e-12_r8 * exp_fac(:,:) + rate(:,:,355) = 2.30e-12_r8 * exp_fac(:,:) + rate(:,:,359) = 2.54e-11_r8 * exp( 410._r8 * itemp(:,:) ) + rate(:,:,361) = 3.03e-12_r8 * exp( -446._r8 * itemp(:,:) ) + rate(:,:,382) = 1.3e-12_r8 * exp( 640._r8 * itemp(:,:) ) + rate(:,:,383) = 1.90e-12_r8 * exp( 190._r8 * itemp(:,:) ) + rate(:,:,385) = 1.70e-12_r8 * exp( 352._r8 * itemp(:,:) ) + rate(:,:,391) = 2.3e-12_r8 * exp( -193._r8 * itemp(:,:) ) + rate(:,:,397) = 1.2e-11_r8 * exp( 444._r8 * itemp(:,:) ) + rate(:,:,398) = 1.e-15_r8 * exp( -732._r8 * itemp(:,:) ) + rate(:,:,399) = 1.2e-12_r8 * exp( 490._r8 * itemp(:,:) ) + rate(:,:,429) = 2.10E-11_r8 * exp( -2200.0_r8 * itemp(:,:) ) + rate(:,:,430) = 1.10E-13_r8 * exp( -1200.0_r8 * itemp(:,:) ) + rate(:,:,434) = 2.70E-11_r8 * exp( 335._r8 * itemp(:,:) ) + rate(:,:,435) = 1.25E-13_r8 * exp( -2190.0_r8 * itemp(:,:) ) + rate(:,:,436) = 3.40E-12_r8 * exp( -1100.0_r8 * itemp(:,:) ) + rate(:,:,443) = 9.60e-12_r8 * exp( -234._r8 * itemp(:,:) ) + rate(:,:,445) = 1.90e-13_r8 * exp( 520._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,163), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.90e-31_r8 * itemp(:,:)**1.0_r8 + kinf(:,:) = 2.60e-11_r8 + call jpl( rate(1,1,172), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 4.28e-33_r8 + kinf(:,:) = 9.30e-15_r8 * itemp(:,:)**(-4.42_r8) + call jpl( rate(1,1,180), m, 0.8_r8, ko, kinf, n ) + + ko(:,:) = 9.00e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3.0e-11_r8 + call jpl( rate(1,1,190), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.50e-31_r8 * itemp(:,:)**1.8_r8 + kinf(:,:) = 2.2e-11_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,194), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-30_r8 * itemp(:,:)**4.4_r8 + kinf(:,:) = 1.4e-12_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,196), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-30_r8 * itemp(:,:)**3.0_r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,198), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 2.00e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 2.9e-12_r8 * itemp(:,:)**1.1_r8 + call jpl( rate(1,1,204), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.80e-31_r8 * itemp(:,:)**3.4_r8 + kinf(:,:) = 1.5e-11_r8 * itemp(:,:)**1.9_r8 + call jpl( rate(1,1,220), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-32_r8 * itemp(:,:)**4.5_r8 + kinf(:,:) = 3.0e-12_r8 * itemp(:,:)**2.0_r8 + call jpl( rate(1,1,224), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-31_r8 * itemp(:,:)**3.2_r8 + kinf(:,:) = 6.9e-12_r8 * itemp(:,:)**2.9_r8 + call jpl( rate(1,1,241), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.90e-33_r8 * itemp(:,:)**1.4_r8 + kinf(:,:) = 1.10e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,268), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.20e-30_r8 * itemp(:,:)**2.4_r8 + kinf(:,:) = 2.2e-10_r8 * itemp(:,:)**0.7_r8 + call jpl( rate(1,1,283), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.60e-29_r8 * itemp(:,:)**3.3_r8 + kinf(:,:) = 3.1e-10_r8 * itemp(:,:) + call jpl( rate(1,1,284), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.50e-30_r8 + kinf(:,:) = 8.3e-13_r8 * itemp(:,:)**(-2.0_r8) + call jpl( rate(1,1,286), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 8.60e-29_r8 * itemp(:,:)**3.1_r8 + kinf(:,:) = 9.00e-12_r8 * itemp(:,:)**0.85_r8 + call jpl( rate(1,1,288), m, 0.48_r8, ko, kinf, n ) + + ko(:,:) = 9.70e-29_r8 * itemp(:,:)**5.6_r8 + kinf(:,:) = 9.30e-12_r8 * itemp(:,:)**1.5_r8 + call jpl( rate(1,1,303), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 8.00e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.00e-11_r8 + call jpl( rate(1,1,313), m, 0.5_r8, ko, kinf, n ) + + ko(:,:) = 8.00e-27_r8 * itemp(:,:)**3.5_r8 + kinf(:,:) = 3.00e-11_r8 + call jpl( rate(1,1,358), m, 0.5_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,kbot) + real(r8) :: exp_fac(ncol,kbot) + real(r8) :: ko(ncol,kbot) + real(r8) :: kinf(ncol,kbot) + real(r8) :: wrk(ncol,kbot) + + rate(:,:kbot,121) = 8.00e-14_r8 + rate(:,:kbot,122) = 3.90e-17_r8 + rate(:,:kbot,127) = 1.30e-16_r8 + rate(:,:kbot,129) = 1.00e-20_r8 + rate(:,:kbot,166) = 6.90e-12_r8 + rate(:,:kbot,182) = 5.00e-12_r8 + rate(:,:kbot,183) = 7.00e-13_r8 + rate(:,:kbot,468) = 1.0e-10_r8 + rate(:,:kbot,469) = 4.4e-10_r8 + rate(:,:kbot,470) = 4.0e-10_r8 + rate(:,:kbot,471) = 2.0e-10_r8 + rate(:,:kbot,472) = 1.0e-12_r8 + rate(:,:kbot,473) = 6.0e-11_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) + n = ncol*kbot + rate(:,:kbot,119) = 8.00e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,123) = 1.80e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,124) = 3.50e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,128) = 3.60e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,131) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,132) = 3.135e-11_r8 * exp_fac(:,:) + rate(:,:kbot,133) = 1.65e-12_r8 * exp_fac(:,:) + rate(:,:kbot,164) = 1.40e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,168) = 1.80e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,169) = 1.70e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,170) = 4.80e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,176) = 3.00e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,177) = 1.00e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,185) = 1.50e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,186) = 2.10e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,191) = 3.30e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,192) = 3.00e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + rate(:,:kbot,193) = 5.10e-12_r8 * exp( 210._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 4.40e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:,:kbot,163) = wrk(:,:) + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 new file mode 100644 index 0000000000..481e3e6ba2 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_sulfur/mo_sim_dat.F90 @@ -0,0 +1,712 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .true. + is_vector = .false. + + clscnt(:) = (/ 23, 0, 0, 151, 0 /) + + cls_rxt_cnt(:,1) = (/ 19, 60, 0, 23 /) + cls_rxt_cnt(:,4) = (/ 31, 173, 273, 151 /) + + solsym(:174) = (/ 'O3 ','O ','O1D ','O2 ','O2_1S ', & + 'O2_1D ','N2O ','N ','NO ','NO2 ', & + 'NO3 ','HNO3 ','HO2NO2 ','N2O5 ','CH4 ', & + 'CH3O2 ','CH3OOH ','CH3OH ','CH2O ','CO ', & + 'H2 ','H ','OH ','HO2 ','H2O2 ', & + 'CLY ','BRY ','CL ','CL2 ','CLO ', & + 'OCLO ','CL2O2 ','HCL ','HOCL ','CLONO2 ', & + 'BRCL ','BR ','BRO ','HBR ','HOBR ', & + 'BRONO2 ','HCN ','CH3CN ','C2H4 ','C2H6 ', & + 'C2H5O2 ','C2H5OOH ','CH3CO3 ','CH3COOH ','CH3CHO ', & + 'C2H5OH ','GLYALD ','GLYOXAL ','CH3COOOH ','EO2 ', & + 'EO ','EOOH ','PAN ','C3H6 ','C3H8 ', & + 'C3H7O2 ','C3H7OOH ','CH3COCH3 ','PO2 ','POOH ', & + 'HYAC ','RO2 ','CH3COCHO ','ROOH ','BIGENE ', & + 'BIGALK ','MEK ','ENEO2 ','MEKO2 ','MEKOOH ', & + 'MCO3 ','MVK ','MACR ','MACRO2 ','MACROOH ', & + 'MPAN ','ONIT ','ISOP ','ALKO2 ','ALKOOH ', & + 'BIGALD ','HYDRALD ','ISOPO2 ','ISOPNO3 ','ONITR ', & + 'XO2 ','XOOH ','ISOPOOH ','TOLUENE ','CRESOL ', & + 'TOLO2 ','TOLOOH ','XOH ','BENZENE ','BENO2 ', & + 'BENOOH ','XYLENE ','XYLO2 ','XYLOOH ','C10H16 ', & + 'TERPO2 ','TERPOOH ','CH3CL ','CH3BR ','CFC11 ', & + 'CFC12 ','CFC113 ','HCFC22 ','CCL4 ','CH3CCL3 ', & + 'CF3BR ','CF2CLBR ','HCFC141B ','HCFC142B ','CFC114 ', & + 'CFC115 ','H1202 ','H2402 ','CHBR3 ','CH2BR2 ', & + 'CO2 ','N2p ','O2p ','Np ','Op ', & + 'NOp ','e ','N2D ','H2O ','C2H2 ', & + 'HCOOH ','HOCH2OO ','COF2 ','COFCL ','HF ', & + 'F ','CB1 ','CB2 ','OC1 ','OC2 ', & + 'SOAM ','SOAI ','SOAT ','SOAB ','SOAX ', & + 'SOGM ','SOGI ','SOGT ','SOGB ','SOGX ', & + 'SO2 ','DMS ','SO4 ','NH3 ','NH4 ', & + 'NH4NO3 ','OCS ','S ','SO ','SO3 ', & + 'H2SO4 ','SSLT01 ','SSLT02 ','SSLT03 ','SSLT04 ', & + 'DST01 ','DST02 ','DST03 ','DST04 ' /) + + adv_mass(:174) = (/ 47.998200_r8, 15.999400_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, & + 31.998800_r8, 44.012880_r8, 14.006740_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 63.012340_r8, 79.011740_r8, 108.010480_r8, 16.040600_r8, & + 47.032000_r8, 48.039400_r8, 32.040000_r8, 30.025200_r8, 28.010400_r8, & + 2.014800_r8, 1.007400_r8, 17.006800_r8, 33.006200_r8, 34.013600_r8, & + 100.916850_r8, 99.716850_r8, 35.452700_r8, 70.905400_r8, 51.452100_r8, & + 67.451500_r8, 102.904200_r8, 36.460100_r8, 52.459500_r8, 97.457640_r8, & + 115.356700_r8, 79.904000_r8, 95.903400_r8, 80.911400_r8, 96.910800_r8, & + 141.908940_r8, 27.025140_r8, 41.050940_r8, 28.051600_r8, 30.066400_r8, & + 61.057800_r8, 62.065200_r8, 75.042400_r8, 60.050400_r8, 44.051000_r8, & + 46.065800_r8, 60.050400_r8, 58.035600_r8, 76.049800_r8, 77.057200_r8, & + 61.057800_r8, 78.064600_r8, 121.047940_r8, 42.077400_r8, 44.092200_r8, & + 75.083600_r8, 76.091000_r8, 58.076800_r8, 91.083000_r8, 92.090400_r8, & + 74.076200_r8, 89.068200_r8, 72.061400_r8, 90.075600_r8, 56.103200_r8, & + 72.143800_r8, 72.102600_r8, 105.108800_r8, 103.094000_r8, 104.101400_r8, & + 101.079200_r8, 70.087800_r8, 70.087800_r8, 119.093400_r8, 120.100800_r8, & + 147.084740_r8, 119.074340_r8, 68.114200_r8, 103.135200_r8, 104.142600_r8, & + 98.098200_r8, 100.113000_r8, 117.119800_r8, 162.117940_r8, 147.125940_r8, & + 149.118600_r8, 150.126000_r8, 118.127200_r8, 92.136200_r8, 108.135600_r8, & + 173.140600_r8, 174.148000_r8, 190.147400_r8, 78.110400_r8, 127.116000_r8, & + 128.123400_r8, 106.162000_r8, 155.167600_r8, 156.175000_r8, 136.228400_r8, & + 185.234000_r8, 186.241400_r8, 50.485900_r8, 94.937200_r8, 137.367503_r8, & + 120.913206_r8, 187.375310_r8, 86.467906_r8, 153.821800_r8, 133.402300_r8, & + 148.910210_r8, 165.364506_r8, 116.948003_r8, 100.493706_r8, 170.921013_r8, & + 154.466716_r8, 209.815806_r8, 259.823613_r8, 252.730400_r8, 173.833800_r8, & + 44.009800_r8, 28.013480_r8, 31.998800_r8, 14.006740_r8, 15.999400_r8, & + 30.006140_r8, 0.548567E-03_r8, 14.006740_r8, 18.014200_r8, 26.036800_r8, & + 46.024600_r8, 63.031400_r8, 66.007206_r8, 82.461503_r8, 20.005803_r8, & + 18.998403_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 200.226000_r8, 136.141400_r8, 141.141800_r8, 127.116000_r8, 155.167600_r8, & + 200.226000_r8, 136.141400_r8, 141.141800_r8, 127.116000_r8, 155.167600_r8, & + 64.064800_r8, 62.132400_r8, 96.063600_r8, 17.028940_r8, 18.036340_r8, & + 80.041280_r8, 60.076400_r8, 32.066000_r8, 48.065400_r8, 80.064200_r8, & + 98.078400_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8 /) + + crb_mass(:174) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 48.044000_r8, & + 60.055000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 84.077000_r8, 84.077000_r8, & + 84.077000_r8, 84.077000_r8, 84.077000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 120.110000_r8, 60.055000_r8, 84.077000_r8, 72.066000_r8, 96.088000_r8, & + 120.110000_r8, 60.055000_r8, 84.077000_r8, 72.066000_r8, 96.088000_r8, & + 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 23,1) = (/ 15, 7, 108, 109, 110, 111, 112, 120, 121, 113, & + 118, 119, 114, 115, 116, 117, 122, 123, 124, 125, & + 126, 26, 27 /) + clsmap(:151,4) = (/ 1, 2, 3, 4, 5, 6, 21, 20, 8, 9, & + 10, 23, 11, 12, 13, 14, 16, 17, 42, 43, & + 19, 22, 24, 25, 134, 28, 29, 30, 31, 32, & + 33, 34, 35, 36, 37, 38, 39, 40, 41, 127, & + 128, 129, 130, 131, 133, 132, 59, 83, 64, 50, & + 49, 65, 48, 54, 58, 82, 45, 44, 71, 81, & + 70, 73, 84, 85, 72, 74, 75, 94, 95, 96, & + 97, 98, 106, 107, 86, 53, 99, 100, 101, 102, & + 103, 104, 88, 77, 78, 79, 80, 76, 46, 47, & + 105, 60, 61, 62, 63, 69, 18, 51, 52, 66, & + 55, 56, 57, 87, 67, 68, 89, 90, 91, 92, & + 93, 135, 136, 137, 138, 139, 140, 141, 156, 157, & + 158, 159, 160, 161, 146, 147, 148, 149, 150, 151, & + 152, 153, 154, 155, 162, 163, 164, 165, 166, 142, & + 143, 144, 145, 167, 168, 169, 170, 171, 172, 173, & + 174 /) + + permute(:151,4) = (/ 140, 139, 141, 136, 41, 40, 124, 119, 108, 138, & + 142, 150, 147, 137, 74, 55, 135, 69, 46, 34, & + 144, 145, 146, 90, 148, 149, 43, 151, 56, 29, & + 133, 110, 117, 48, 134, 143, 107, 100, 86, 94, & + 102, 76, 91, 103, 77, 104, 118, 113, 106, 120, & + 89, 87, 131, 78, 75, 65, 52, 82, 30, 81, & + 31, 57, 95, 92, 70, 93, 58, 36, 37, 79, & + 63, 44, 116, 72, 80, 98, 32, 64, 1, 33, & + 73, 2, 127, 129, 123, 128, 59, 130, 109, 60, & + 88, 35, 111, 66, 96, 67, 84, 49, 112, 122, & + 99, 71, 38, 61, 121, 125, 105, 114, 126, 50, & + 85, 53, 83, 68, 39, 45, 47, 101, 115, 54, & + 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, & + 13, 14, 15, 16, 62, 97, 132, 51, 42, 17, & + 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, & + 28 /) + + diag_map(:151) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 19, 20, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 31, 34, & + 37, 40, 43, 46, 49, 53, 58, 61, 64, 67, & + 70, 72, 75, 77, 81, 85, 89, 92, 95, 99, & + 104, 108, 114, 120, 126, 132, 137, 144, 149, 154, & + 159, 162, 170, 177, 183, 187, 193, 199, 205, 211, & + 216, 221, 229, 236, 243, 250, 257, 262, 269, 277, & + 283, 291, 299, 303, 307, 315, 323, 331, 340, 344, & + 351, 359, 370, 379, 393, 404, 410, 417, 423, 432, & + 441, 449, 458, 469, 476, 487, 497, 509, 521, 531, & + 540, 553, 560, 578, 587, 595, 608, 621, 636, 641, & + 652, 664, 671, 684, 696, 711, 734, 758, 777, 797, & + 826, 842, 861, 876, 909, 940, 961,1019,1061,1107, & + 1134,1172,1197,1222,1243,1317,1362,1389,1425,1527, & + 1555 /) + + extfrc_lst(: 14) = (/ 'NO ','NO2 ','CO ','SO2 ','SO4 ', & + 'CB1 ','Op ','O2p ','Np ','N2p ', & + 'N2D ','N ','e ','OH ' /) + + frc_from_dataset(: 14) = (/ .true., .true., .true., .true., .true., & + .true., .false., .false., .false., .false., & + .false., .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jn2o ', 'jno ', & + 'jno_i ', 'jno2 ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jhno3 ', 'jno3_a ', & + 'jno3_b ', 'jho2no2_a ', & + 'jho2no2_b ', 'jch3ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jh2o_a ', 'jh2o_b ', & + 'jh2o_c ', 'jh2o2 ', & + 'jcl2 ', 'jclo ', & + 'joclo ', 'jcl2o2 ', & + 'jhocl ', 'jhcl ', & + 'jclono2_a ', 'jclono2_b ', & + 'jbrcl ', 'jbro ', & + 'jhobr ', 'jhbr ', & + 'jbrono2_a ', 'jbrono2_b ', & + 'jch3cl ', 'jccl4 ', & + 'jch3ccl3 ', 'jcfcl3 ', & + 'jcf2cl2 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jhcfc22 ', 'jhcfc141b ', & + 'jhcfc142b ', 'jch3br ', & + 'jcf3br ', 'jcf2clbr ', & + 'jchbr3 ', 'jch2br2 ', & + 'jh1202 ', 'jh2402 ', & + 'jcof2 ', 'jcofcl ', & + 'jhf ', 'jco2 ', & + 'jch4_a ', 'jch4_b ', & + 'jch3cho ', 'jpooh ', & + 'jch3co3h ', 'jpan ', & + 'jmpan ', 'jmacr_a ', & + 'jmacr_b ', 'jmvk ', & + 'jc2h5ooh ', 'jeooh ', & + 'jc3h7ooh ', 'jrooh ', & + 'jacet ', 'jmgly ', & + 'jxooh ', 'jonitr ', & + 'jisopooh ', 'jhyac ', & + 'jglyald ', 'jmek ', & + 'jbigald ', 'jglyoxal ', & + 'jalkooh ', 'jmekooh ', & + 'jtolooh ', 'jterpooh ', & + 'jh2so4 ', 'jso2 ', & + 'jso3 ', 'jocs ', & + 'jso ', 'jeuv_1 ', & + 'jeuv_2 ', 'jeuv_3 ', & + 'jeuv_4 ', 'jeuv_5 ', & + 'jeuv_6 ', 'jeuv_7 ', & + 'jeuv_8 ', 'jeuv_9 ', & + 'jeuv_10 ', 'jeuv_11 ', & + 'jeuv_12 ', 'jeuv_13 ', & + 'jeuv_14 ', 'jeuv_15 ', & + 'jeuv_16 ', 'jeuv_17 ', & + 'jeuv_18 ', 'jeuv_19 ', & + 'jeuv_20 ', 'jeuv_21 ', & + 'jeuv_22 ', 'jeuv_23 ', & + 'jeuv_24 ', 'jeuv_25 ', & + 'jeuv_26 ', 'usr_O_O2 ', & + 'O_O3 ', 'usr_O_O ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_N2 ', 'O2_1S_O3 ', & + 'O2_1S_CO2 ', 'ag2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1D_N2 ', 'ag1 ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_H2O ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'O1D_O3 ', 'O1D_CFC11 ', & + 'O1D_CFC12 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_HCFC22 ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_CCL4 ', & + 'O1D_CH3BR ', 'O1D_CF2CLBR ', & + 'O1D_CF3BR ', 'O1D_H1202 ', & + 'O1D_H2402 ', 'O1D_CHBR3 ', & + 'O1D_CH2BR2 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_H2 ', 'O1D_HCL ', & + 'O1D_HBR ', 'O1D_HCN ', & + 'H_O2 ', 'H_O3 ', & + 'H_HO2a ', 'H_HO2 ', & + 'H_HO2b ', 'OH_O ', & + 'OH_O3 ', 'OH_HO2 ', & + 'OH_OH ', 'OH_OH_M ', & + 'OH_H2 ', 'OH_H2O2 ', & + 'H2_O ', 'HO2_O ', & + 'HO2_O3 ', 'usr_HO2_HO2 ', & + 'H2O2_O ', 'HCN_OH ', & + 'CH3CN_OH ', 'N2D_O2 ', & + 'N2D_O ', 'N_OH ', & + 'N_O2 ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'NO_O_M ', & + 'NO_HO2 ', 'NO_O3 ', & + 'NO2_O ', 'NO2_O_M ', & + 'NO2_O3 ', 'tag_NO2_NO3 ', & + 'usr_N2O5_M ', 'tag_NO2_OH ', & + 'usr_HNO3_OH ', 'NO3_NO ' /) + rxt_tag_lst( 201: 400) = (/ 'NO3_O ', 'NO3_OH ', & + 'NO3_HO2 ', 'tag_NO2_HO2 ', & + 'HO2NO2_OH ', 'usr_HO2NO2_M ', & + 'CL_O3 ', 'CL_H2 ', & + 'CL_H2O2 ', 'CL_HO2a ', & + 'CL_HO2b ', 'CL_CH2O ', & + 'CL_CH4 ', 'CLO_O ', & + 'CLO_OHa ', 'CLO_OHb ', & + 'CLO_HO2 ', 'CLO_CH3O2 ', & + 'CLO_NO ', 'CLO_NO2_M ', & + 'CLO_CLOa ', 'CLO_CLOb ', & + 'CLO_CLOc ', 'tag_CLO_CLO_M ', & + 'usr_CL2O2_M ', 'HCL_OH ', & + 'HCL_O ', 'HOCL_O ', & + 'HOCL_CL ', 'HOCL_OH ', & + 'CLONO2_O ', 'CLONO2_OH ', & + 'CLONO2_CL ', 'BR_O3 ', & + 'BR_HO2 ', 'BR_CH2O ', & + 'BRO_O ', 'BRO_OH ', & + 'BRO_HO2 ', 'BRO_NO ', & + 'BRO_NO2_M ', 'BRO_CLOa ', & + 'BRO_CLOb ', 'BRO_CLOc ', & + 'BRO_BRO ', 'HBR_OH ', & + 'HBR_O ', 'HOBR_O ', & + 'BRONO2_O ', 'F_H2O ', & + 'F_H2 ', 'F_CH4 ', & + 'F_HNO3 ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CH3CCL3_OH ', & + 'HCFC22_OH ', 'CH3BR_OH ', & + 'CH3BR_CL ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'CH2BR2_OH ', & + 'CHBR3_OH ', 'CH2BR2_CL ', & + 'CHBR3_CL ', 'CH4_OH ', & + 'usr_CO_OH_b ', 'CO_OH_M ', & + 'CH2O_NO3 ', 'CH2O_OH ', & + 'CH2O_O ', 'CH2O_HO2 ', & + 'CH3O2_NO ', 'CH3O2_HO2 ', & + 'CH3O2_CH3O2a ', 'CH3O2_CH3O2b ', & + 'CH3OH_OH ', 'CH3OOH_OH ', & + 'HCOOH_OH ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'HOCH2OO_HO2 ', & + 'C2H2_CL_M ', 'C2H4_CL_M ', & + 'C2H6_CL ', 'C2H2_OH_M ', & + 'C2H6_OH ', 'tag_C2H4_OH ', & + 'EO2_NO ', 'EO2_HO2 ', & + 'EO_O2 ', 'EO_M ', & + 'C2H4_O3 ', 'CH3COOH_OH ', & + 'C2H5O2_NO ', 'C2H5O2_HO2 ', & + 'C2H5O2_CH3O2 ', 'C2H5O2_C2H5O2 ', & + 'C2H5OOH_OH ', 'CH3CHO_OH ', & + 'CH3CHO_NO3 ', 'CH3CO3_NO ', & + 'tag_CH3CO3_NO2 ', 'CH3CO3_HO2 ', & + 'CH3CO3_CH3O2 ', 'CH3CO3_CH3CO3 ', & + 'CH3COOOH_OH ', 'GLYALD_OH ', & + 'GLYOXAL_OH ', 'C2H5OH_OH ', & + 'usr_PAN_M ', 'PAN_OH ', & + 'tag_C3H6_OH ', 'C3H6_O3 ', & + 'C3H6_NO3 ', 'C3H7O2_NO ', & + 'C3H7O2_HO2 ', 'CH3H7O2_CH3O2 ', & + 'CH3H7OOH_OH ', 'C3H8_OH ', & + 'PO2_NO ', 'PO2_HO2 ', & + 'POOH_OH ', 'usr_CH3COCH3_OH ', & + 'RO2_NO ', 'RO2_HO2 ', & + 'RO2_CH3O2 ', 'ROOH_OH ', & + 'HYAC_OH ', 'CH3COCHO_OH ', & + 'CH3COCHO_NO3 ', 'ONIT_OH ', & + 'BIGENE_OH ', 'ENEO2_NO ', & + 'MVK_OH ', 'MVK_O3 ', & + 'MEK_OH ', 'MEKO2_NO ', & + 'MEKO2_HO2 ', 'MEKOOH_OH ', & + 'MACR_OH ', 'MACR_O3 ', & + 'MACRO2_NOa ', 'MACRO2_NOb ', & + 'MACRO2_NO3 ', 'MACRO2_HO2 ', & + 'MACRO2_CH3O2 ', 'MACRO2_CH3CO3 ', & + 'MACROOH_OH ', 'MCO3_NO ', & + 'MCO3_NO3 ', 'MCO3_HO2 ', & + 'MCO3_CH3O2 ', 'MCO3_CH3CO3 ', & + 'MCO3_MCO3 ', 'usr_MCO3_NO2 ', & + 'usr_MPAN_M ', 'MPAN_OH_M ', & + 'ISOP_OH ', 'ISOP_O3 ', & + 'ISOP_NO3 ', 'ISOPO2_NO ', & + 'ISOPO2_NO3 ', 'ISOPO2_HO2 ', & + 'ISOPOOH_OH ', 'ISOPO2_CH3O2 ', & + 'ISOPO2_CH3CO3 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNO3_HO2 ', & + 'BIGALK_OH ', 'ONITR_OH ', & + 'ONITR_NO3 ', 'HYDRALD_OH ', & + 'ALKO2_NO ', 'ALKO2_HO2 ', & + 'ALKOOH_OH ', 'XO2_NO ', & + 'XO2_NO3 ', 'XO2_HO2 ', & + 'XO2_CH3O2 ', 'XO2_CH3CO3 ', & + 'XOOH_OHa ', 'usr_XOOH_OH ', & + 'TOLUENE_OH ', 'TOLO2_NO ', & + 'TOLO2_HO2 ', 'TOLO2_OH ', & + 'CRESOL_OH ', 'XOH_NO2 ', & + 'BENZENE_OH ', 'BENO2_HO2 ', & + 'BENO2_NO ', 'XYLENE_OH ', & + 'XYLO2_HO2 ', 'XYLO2_NO ', & + 'C10H16_OH ', 'C10H16_O3 ', & + 'C10H16_NO3 ', 'TERPO2_NO ' /) + rxt_tag_lst( 401: 477) = (/ 'TERPO2_HO2 ', 'TERPOOH_OH ', & + 'usr_N2O5_aer ', 'usr_NO3_aer ', & + 'usr_NO2_aer ', 'CB1_CB2 ', & + 'OC1_OC2 ', 'usr_HO2_aer ', & + 'usr_CB1_strat_tau ', 'usr_CB2_strat_tau ', & + 'usr_OC1_strat_tau ', 'usr_OC2_strat_tau ', & + 'usr_SO4_strat_tau ', 'usr_SOAM_strat_tau ', & + 'usr_SOAI_strat_tau ', 'usr_SOAB_strat_tau ', & + 'usr_SOAT_strat_tau ', 'usr_SOAX_strat_tau ', & + 'usr_NH4_strat_tau ', 'usr_NH4NO3_strat_tau ', & + 'usr_SSLT01_strat_tau ', 'usr_SSLT02_strat_tau ', & + 'usr_SSLT03_strat_tau ', 'usr_SSLT04_strat_tau ', & + 'usr_DST01_strat_tau ', 'usr_DST02_strat_tau ', & + 'usr_DST03_strat_tau ', 'usr_DST04_strat_tau ', & + 'OCS_O ', 'OCS_OH ', & + 'S_OH ', 'S_O2 ', & + 'S_O3 ', 'SO_OH ', & + 'SO_O2 ', 'SO_O3 ', & + 'SO_NO2 ', 'SO_CLO ', & + 'SO_BRO ', 'SO_OCLO ', & + 'usr_SO2_OH ', 'usr_SO3_H2O ', & + 'DMS_OHa ', 'usr_DMS_OH ', & + 'DMS_NO3 ', 'het1 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'ion_Op_O2 ', 'ion_Op_N2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Op_CO2 ', 'ion_O2p_N ', & + 'ion_O2p_NO ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_Np_O ', & + 'ion_N2p_O2 ', 'ion_O2p_N2 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', 'jh2o2 ', ' ', & + 'jpan ', ' ', ' ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', 'jch3ooh ', 'jch3cho ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jno2 ', 'jmgly ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 0.28_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 0.2_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 118, 119, 120, 121, 122, & + 123, 124, 127, 128, 129, & + 131, 132, 133, 163, 164, & + 166, 168, 169, 170, 176, & + 177, 178, 182, 183, 185, & + 186, 191, 192, 193, 463, & + 464, 465, 468, 469, 470, & + 471, 472, 473, 475, 476, & + 477 /) + cph_enthalpy(:) = (/ 101.390000_r8, 392.190000_r8, 493.580000_r8, 62.600000_r8, 62.600000_r8, & + 62.600000_r8, 62.600000_r8, 94.300000_r8, 94.300000_r8, 94.300000_r8, & + 189.810000_r8, 32.910000_r8, 189.810000_r8, 203.400000_r8, 194.710000_r8, & + 232.590000_r8, 67.670000_r8, 165.300000_r8, 293.620000_r8, 226.580000_r8, & + 120.100000_r8, 165.510000_r8, 177.510000_r8, 229.610000_r8, 133.750000_r8, & + 313.750000_r8, 34.470000_r8, 199.170000_r8, 193.020000_r8, 150.110000_r8, & + 105.040000_r8, 67.530000_r8, 406.160000_r8, 271.380000_r8, 239.840000_r8, & + 646.280000_r8, 95.550000_r8, 339.590000_r8, 82.389000_r8, 508.950000_r8, & + 354.830000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 3, 2, 3, 2, 2, 2, 2, 2, 1, 2, & + 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 3, 2, 3, 2, & + 3, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 2, 2, 3, 3, 2, 3, 2, & + 3, 2, 2, 2, 1, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 1, 1, & + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/utils/aerodep_flx.F90 b/src/chemistry/utils/aerodep_flx.F90 new file mode 100644 index 0000000000..0f934e3b97 --- /dev/null +++ b/src/chemistry/utils/aerodep_flx.F90 @@ -0,0 +1,502 @@ +!------------------------------------------------------------------- +! Manages reading and interpolation of prescribed aerosol deposition +! fluxes. These are the deposition fluxes sent to the surface. +! +! Created by: Francis Vitt +!------------------------------------------------------------------- +module aerodep_flx + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + use ppgrid, only : pcols, pver, begchunk, endchunk + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: aerodep_flx_init + public :: aerodep_flx_adv + public :: aerodep_flx_readnl + public :: aerodep_flx_prescribed + + logical :: has_aerodep_flx = .false. + integer, parameter, public :: N_BULK = 14 + integer, parameter, public :: N_MODAL = 22 + integer :: number_flds + + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = ' ' + character(len=256) :: datapath = ' ' + character(len=32) :: datatype = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + character(len=32) :: specifier(N_MODAL) = ' ' + + ! for bulk aerosol fluxes + + character(len=12), parameter :: bulk_names(N_BULK) = (/ & + 'BCDEPWET ', 'BCPHODRY ', 'BCPHIDRY ', & + 'OCDEPWET ', 'OCPHODRY ', 'OCPHIDRY ', & + 'DSTX01DD ', 'DSTX02DD ', 'DSTX03DD ', 'DSTX04DD ', & + 'DSTX01WD ', 'DSTX02WD ', 'DSTX03WD ', 'DSTX04WD ' /) + + integer :: index_bulk_map(N_BULK) + + integer :: ibcphiwet,ibcphidry,ibcphodry + integer :: iocphiwet,iocphidry,iocphodry + + integer :: idstdry1,idstdry2,idstdry3,idstdry4 + integer :: idstwet1,idstwet2,idstwet3,idstwet4 + + ! for modal aerosol fluxes + + character(len=12), parameter :: modal_names(N_MODAL) = (/ & + 'bc_a1DDF ', 'bc_c1DDF ', 'pom_a1DDF ', 'pom_c1DDF ', & + 'soa_a1DDF ', 'soa_c1DDF ', 'soa_a2DDF ', 'soa_c2DDF ', & + 'dst_a1DDF ', 'dst_c1DDF ', 'dst_a3DDF ', 'dst_c3DDF ', & + 'bc_a1SFWET ', 'bc_c1SFWET ', 'pom_a1SFWET ', 'pom_c1SFWET ', & + 'soa_a1SFWET ', 'soa_c1SFWET ', 'dst_a1SFWET ', 'dst_c1SFWET ', & + 'dst_a3SFWET ', 'dst_c3SFWET ' /) + + integer :: index_modal_map(N_MODAL) + + integer, parameter :: idx_bc1 = 1 + integer, parameter :: idx_pom1 = 2 + integer, parameter :: idx_soa1 = 3 + integer, parameter :: idx_soa2 = 4 + integer, parameter :: idx_dst1 = 5 + integer, parameter :: idx_dst3 = 6 + integer, parameter :: idx_ncl3 = 7 + integer, parameter :: idx_so43 = 8 + + integer, parameter :: nmodal_idxs = 8 + + integer :: idx_bc1_dryis = -1 + integer :: idx_bc1_drycw = -1 + integer :: idx_pom1_dryis = -1 + integer :: idx_pom1_drycw = -1 + integer :: idx_soa1_dryis = -1 + integer :: idx_soa1_drycw = -1 + integer :: idx_soa2_dryis = -1 + integer :: idx_soa2_drycw = -1 + integer :: idx_dst1_dryis = -1 + integer :: idx_dst1_drycw = -1 + integer :: idx_dst3_dryis = -1 + integer :: idx_dst3_drycw = -1 + + integer :: idx_bc1_wetis = -1 + integer :: idx_bc1_wetcw = -1 + integer :: idx_pom1_wetis = -1 + integer :: idx_pom1_wetcw = -1 + integer :: idx_soa1_wetis = -1 + integer :: idx_soa1_wetcw = -1 + integer :: idx_dst1_wetis = -1 + integer :: idx_dst1_wetcw = -1 + integer :: idx_dst3_wetis = -1 + integer :: idx_dst3_wetcw = -1 + + logical :: modal_fluxes = .false. + +contains + +!------------------------------------------------------------------- +! parses the list of dep fluxes specified in aerodep_flx_specifier namelist +! variable and sets up index variables +!------------------------------------------------------------------- + subroutine aerodep_flx_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld, horiz_only + use physics_buffer, only : physics_buffer_desc + use modal_aero_deposition, only : modal_aero_deposition_init + + implicit none + + integer :: ndx, istat, i + + if ( has_aerodep_flx ) then + if ( masterproc ) then + write(iulog,*) 'aero dep fluxes are prescribed in :'//trim(filename) + endif + else + return + endif + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + number_flds = 0 + if (associated(fields)) number_flds = size( fields ) + + if( number_flds < 1 ) then + has_aerodep_flx = .false. + if (masterproc) then + write(iulog,*) 'aerodep_flx_init: no aerosol deposition fluxes have been specified' + endif + return + end if + + index_bulk_map(:) = -1 + index_modal_map(:) = -1 + + do i = 1,number_flds + + ndx = get_ndx( fields(i)%fldnam, bulk_names ) + if (ndx >0) then + index_bulk_map(ndx) = i + else + ndx = get_ndx( fields(i)%fldnam, modal_names ) + if (ndx >0) then + index_modal_map(ndx) = i + endif + endif + if (ndx>0) then + call addfld(trim(fields(i)%fldnam)//'_D', horiz_only, 'A',fields(i)%units, 'prescribed aero dep' ) + else + call endrun('aerodep_flx_init: aerosol flux name not recognized: '//trim(fields(i)%fldnam)) + endif + enddo + + modal_fluxes = any(index_modal_map(:)>0) + + if (modal_fluxes) then + + idx_bc1_dryis = index_modal_map(1) + idx_bc1_drycw = index_modal_map(2) + idx_pom1_dryis = index_modal_map(3) + idx_pom1_drycw = index_modal_map(4) + idx_soa1_dryis = index_modal_map(5) + idx_soa1_drycw = index_modal_map(6) + idx_soa2_dryis = index_modal_map(7) + idx_soa2_drycw = index_modal_map(8) + idx_dst1_dryis = index_modal_map(9) + idx_dst1_drycw = index_modal_map(10) + idx_dst3_dryis = index_modal_map(11) + idx_dst3_drycw = index_modal_map(12) + + idx_bc1_wetis = index_modal_map(13) + idx_bc1_wetcw = index_modal_map(14) + idx_pom1_wetis = index_modal_map(15) + idx_pom1_wetcw = index_modal_map(16) + idx_soa1_wetis = index_modal_map(17) + idx_soa1_wetcw = index_modal_map(18) + idx_dst1_wetis = index_modal_map(19) + idx_dst1_wetcw = index_modal_map(20) + idx_dst3_wetis = index_modal_map(21) + idx_dst3_wetcw = index_modal_map(22) + + call modal_aero_deposition_init( bcphi_indices=(/idx_bc1/), & + ocphi_indices=(/idx_pom1,idx_soa1/), & + ocpho_indices=(/idx_soa2/), & + fine_dust_indices=(/idx_dst1/),& + crse_dust_indices=(/idx_dst3/) ) + + else + + ibcphiwet = index_bulk_map(1) + ibcphodry = index_bulk_map(2) + ibcphidry = index_bulk_map(3) + iocphiwet = index_bulk_map(4) + iocphodry = index_bulk_map(5) + iocphidry = index_bulk_map(6) + idstdry1 = index_bulk_map(7) + idstdry2 = index_bulk_map(8) + idstdry3 = index_bulk_map(9) + idstdry4 = index_bulk_map(10) + idstwet1 = index_bulk_map(11) + idstwet2 = index_bulk_map(12) + idstwet3 = index_bulk_map(13) + idstwet4 = index_bulk_map(14) + + endif + + end subroutine aerodep_flx_init + +!------------------------------------------------------------------- +! sets namelist options +!------------------------------------------------------------------- +subroutine aerodep_flx_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aerodep_flx_readnl' + + character(len=32) :: aerodep_flx_specifier(N_MODAL) + character(len=256) :: aerodep_flx_file + character(len=256) :: aerodep_flx_filelist + character(len=256) :: aerodep_flx_datapath + character(len=32) :: aerodep_flx_type + logical :: aerodep_flx_rmfile + integer :: aerodep_flx_cycle_yr + integer :: aerodep_flx_fixed_ymd + integer :: aerodep_flx_fixed_tod + + namelist /aerodep_flx_nl/ & + aerodep_flx_specifier, & + aerodep_flx_file, & + aerodep_flx_filelist, & + aerodep_flx_datapath, & + aerodep_flx_type, & + aerodep_flx_rmfile, & + aerodep_flx_cycle_yr, & + aerodep_flx_fixed_ymd, & + aerodep_flx_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + aerodep_flx_specifier= specifier + aerodep_flx_file = filename + aerodep_flx_filelist = filelist + aerodep_flx_datapath = datapath + aerodep_flx_type = datatype + aerodep_flx_rmfile = rmv_file + aerodep_flx_cycle_yr = cycle_yr + aerodep_flx_fixed_ymd= fixed_ymd + aerodep_flx_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerodep_flx_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerodep_flx_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(aerodep_flx_specifier,len(aerodep_flx_specifier(1))*N_MODAL, mpichar, 0, mpicom) + call mpibcast(aerodep_flx_file, len(aerodep_flx_file), mpichar, 0, mpicom) + call mpibcast(aerodep_flx_filelist, len(aerodep_flx_filelist), mpichar, 0, mpicom) + call mpibcast(aerodep_flx_datapath, len(aerodep_flx_datapath), mpichar, 0, mpicom) + call mpibcast(aerodep_flx_type, len(aerodep_flx_type), mpichar, 0, mpicom) + call mpibcast(aerodep_flx_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(aerodep_flx_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(aerodep_flx_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(aerodep_flx_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier = aerodep_flx_specifier + filename = aerodep_flx_file + filelist = aerodep_flx_filelist + datapath = aerodep_flx_datapath + datatype = aerodep_flx_type + rmv_file = aerodep_flx_rmfile + cycle_yr = aerodep_flx_cycle_yr + fixed_ymd = aerodep_flx_fixed_ymd + fixed_tod = aerodep_flx_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE' ) has_aerodep_flx = .true. + +end subroutine aerodep_flx_readnl + +!------------------------------------------------------------------- +! sets the aerosol deposition fluxes in the cam_out structure +! to be sent to the surface models +!------------------------------------------------------------------- + subroutine aerodep_flx_set( cam_out, ncol, lchnk ) + use camsrfexch, only : cam_out_t + + type(cam_out_t), intent(inout) :: cam_out + integer, intent(in) :: ncol, lchnk + + if( .not. has_aerodep_flx ) return + + if (modal_fluxes) then + call set_modal_fluxes( cam_out, ncol, lchnk ) + else + call set_bulk_fluxes( cam_out, ncol, lchnk ) + endif + + end subroutine aerodep_flx_set + +!------------------------------------------------------------------- +! advances the prescribed fluxes to the current time step +!------------------------------------------------------------------- + subroutine aerodep_flx_adv( state, pbuf2d, cam_out ) + + use tracer_data, only : advance_trcdata + use physics_types, only : physics_state + use camsrfexch, only : cam_out_t + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: c, ncol + + if( .not. has_aerodep_flx ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + +!$OMP PARALLEL DO PRIVATE (C, NCOL) + do c = begchunk, endchunk + ncol = state(c)%ncol + call aerodep_flx_set( cam_out(c), ncol, c ) + enddo + + end subroutine aerodep_flx_adv + +!------------------------------------------------------------------- +! returns true if aerosol dep fluxes are prescribed from dataset +!------------------------------------------------------------------- + function aerodep_flx_prescribed() + logical :: aerodep_flx_prescribed + aerodep_flx_prescribed = has_aerodep_flx + endfunction aerodep_flx_prescribed + +! private methods +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine set_bulk_fluxes( cam_out, ncol, lchnk ) + use camsrfexch, only : cam_out_t + + ! Arguments + type(cam_out_t), intent(inout) :: cam_out + integer, intent(in) :: ncol, lchnk + + call set_fluxes( cam_out%bcphiwet, ibcphiwet, ncol, lchnk ) + call set_fluxes( cam_out%bcphidry, ibcphidry, ncol, lchnk ) + call set_fluxes( cam_out%bcphodry, ibcphodry, ncol, lchnk ) + + call set_fluxes( cam_out%ocphiwet, iocphiwet, ncol, lchnk ) + call set_fluxes( cam_out%ocphidry, iocphidry, ncol, lchnk ) + call set_fluxes( cam_out%ocphodry, iocphodry, ncol, lchnk ) + + call set_fluxes( cam_out%dstdry1, idstdry1, ncol, lchnk ) + call set_fluxes( cam_out%dstdry2, idstdry2, ncol, lchnk ) + call set_fluxes( cam_out%dstdry3, idstdry3, ncol, lchnk ) + call set_fluxes( cam_out%dstdry4, idstdry4, ncol, lchnk ) + + call set_fluxes( cam_out%dstwet1, idstwet1, ncol, lchnk ) + call set_fluxes( cam_out%dstwet2, idstwet2, ncol, lchnk ) + call set_fluxes( cam_out%dstwet3, idstwet3, ncol, lchnk ) + call set_fluxes( cam_out%dstwet4, idstwet4, ncol, lchnk ) + + end subroutine set_bulk_fluxes + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine set_modal_fluxes( cam_out, ncol, lchnk ) + use camsrfexch, only : cam_out_t + use modal_aero_deposition, only : set_srf_drydep, set_srf_wetdep + + ! Arguments + type(cam_out_t), intent(inout) :: cam_out + integer, intent(in) :: ncol, lchnk + + ! local vars + integer :: i + real(r8) :: aerdepdryis(pcols,nmodal_idxs) + real(r8) :: aerdepdrycw(pcols,nmodal_idxs) + real(r8) :: aerdepwetis(pcols,nmodal_idxs) + real(r8) :: aerdepwetcw(pcols,nmodal_idxs) + + ! bin the fluxes as using modal_aero_deposition... + + aerdepdryis(:,:) = 0._r8 + aerdepdrycw(:,:) = 0._r8 + aerdepwetis(:,:) = 0._r8 + aerdepwetcw(:,:) = 0._r8 + + call set_fluxes( aerdepwetis(:ncol,idx_bc1 ), idx_bc1_wetis , ncol, lchnk ) + call set_fluxes( aerdepwetcw(:ncol,idx_bc1 ), idx_bc1_wetcw , ncol, lchnk ) + call set_fluxes( aerdepwetis(:ncol,idx_pom1), idx_pom1_wetis, ncol, lchnk ) + call set_fluxes( aerdepwetcw(:ncol,idx_pom1), idx_pom1_wetcw, ncol, lchnk ) + call set_fluxes( aerdepwetis(:ncol,idx_soa1), idx_soa1_wetis, ncol, lchnk ) + call set_fluxes( aerdepwetcw(:ncol,idx_soa1), idx_soa1_wetcw, ncol, lchnk ) + call set_fluxes( aerdepwetis(:ncol,idx_dst1), idx_dst1_wetis, ncol, lchnk ) + call set_fluxes( aerdepwetcw(:ncol,idx_dst1), idx_dst1_wetcw, ncol, lchnk ) + call set_fluxes( aerdepwetis(:ncol,idx_dst3), idx_dst3_wetis, ncol, lchnk ) + call set_fluxes( aerdepwetcw(:ncol,idx_dst3), idx_dst3_wetcw, ncol, lchnk ) + + call set_fluxes( aerdepdryis(:ncol,idx_bc1 ), idx_bc1_dryis , ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_bc1 ), idx_bc1_drycw , ncol, lchnk ) + call set_fluxes( aerdepdryis(:ncol,idx_pom1), idx_pom1_dryis, ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_pom1), idx_pom1_drycw, ncol, lchnk ) + call set_fluxes( aerdepdryis(:ncol,idx_soa1), idx_soa1_dryis, ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_soa1), idx_soa1_drycw, ncol, lchnk ) + call set_fluxes( aerdepdryis(:ncol,idx_soa2), idx_soa2_dryis, ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_soa2), idx_soa2_drycw, ncol, lchnk ) + call set_fluxes( aerdepdryis(:ncol,idx_dst1), idx_dst1_dryis, ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_dst1), idx_dst1_drycw, ncol, lchnk ) + call set_fluxes( aerdepdryis(:ncol,idx_dst3), idx_dst3_dryis, ncol, lchnk ) + call set_fluxes( aerdepdrycw(:ncol,idx_dst3), idx_dst3_drycw, ncol, lchnk ) + + call set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out) + call set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out) + + end subroutine set_modal_fluxes + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine set_fluxes( fluxes, fld_indx, ncol, lchnk ) + use cam_history, only : outfld + + real(r8), intent(inout) :: fluxes(:) + integer, intent(in) :: fld_indx, ncol, lchnk + + integer :: i + + if (fld_indx<1) return + + do i = 1,ncol + ! modal aero wet dep history fields are negative + fluxes(i) = fields(fld_indx)%data(i,1,lchnk) + enddo + + call outfld(trim(fields(fld_indx)%fldnam)//'_D', fluxes(:ncol), ncol, lchnk ) + + endsubroutine set_fluxes + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + integer function get_ndx( name, list ) + + implicit none + character(len=*), intent(in) :: name + character(len=*), intent(in) :: list(:) + + integer :: i + integer :: maxnum + + maxnum = size(list) + + get_ndx = -1 + do i = 1, maxnum + if ( trim(name) == trim(list(i)) ) then + get_ndx = i + return + endif + enddo + + end function get_ndx + +end module aerodep_flx diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 new file mode 100644 index 0000000000..773bf26a19 --- /dev/null +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -0,0 +1,423 @@ +module aircraft_emit +!----------------------------------------------------------------------- +! +! Purpose: +! Manages reading and interpolation of aircraft aerosols +! +! Authors: Chih-Chieh (Jack) Chen and Cheryl Craig -- February 2010 +! +!----------------------------------------------------------------------- + use perf_mod, only : t_startf, t_stopf + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + + implicit none + private + save + + public :: aircraft_emit_init + public :: aircraft_emit_adv + public :: aircraft_emit_register + public :: aircraft_emit_readnl + + type :: forcing_air + real(r8) :: mw + character(len=256) :: filelist + character(len=256) :: filename + real(r8), pointer :: times(:) + real(r8), pointer :: levi(:) + character(len=11) :: species + character(len=8) :: units + integer :: nsectors + character(len=32),pointer :: sectors(:) + type(trfld),pointer :: fields(:) + type(trfile) :: file + end type forcing_air + + type(forcing_air),allocatable :: forcings_air(:) + + integer, parameter :: N_AERO = 10 + character(len=11) :: aero_names(N_AERO) = (/'ac_HC ','ac_NOX ','ac_PMNV ',& + 'ac_PMSO ','ac_PMFO ','ac_FUELBURN','ac_CO2 ','ac_H2O ',& + 'ac_SOX ','ac_CO '/) + + real(r8), parameter :: molmass(N_AERO) = 1._r8 + + logical :: advective_tracer(N_AERO) = (/.false., .false., .false., .false., .false., & + .false., .false., .false., .false.,.false./) + character(len=3) :: mixtype(N_AERO) = (/'wet','wet','wet','wet','wet','wet','wet','wet','wet','wet'/) + + real(r8) :: cptmp = 666.0_r8 + real(r8) :: qmin = 0.0_r8 + logical :: cam_outfld = .false. + + integer :: index_map(N_AERO) + character(len=256) :: air_specifier(N_AERO)='' + character(len=24) :: air_type = 'CYCLICAL_LIST' ! 'CYCLICAL_LIST' + + character(len=256) :: datapath = '' + + logical :: rmv_file = .false. + + integer :: number_flds + + integer :: aircraft_cnt = 0 + character(len=16) :: spc_name_list(N_AERO) + character(len=256) :: spc_flist(N_AERO),spc_fname(N_AERO) + +contains + + subroutine aircraft_emit_register() + +!------------------------------------------------------------------ +! **** Add the aircraft aerosol data to the physics buffer **** +!------------------------------------------------------------------ + use ppgrid, only: pver,pcols + use physics_buffer, only : pbuf_add_field, dtype_r8 + use tracer_data, only: incr_filename + use constituents, only: cnst_add + + integer :: i,idx, mm, ind, n + character(len=16) :: spc_name + character(len=256) :: filelist, curr_filename + character(len=128) :: long_name + logical :: has_fixed_ubc=.false. + logical :: read_iv=.false. + + !------------------------------------------------------------------ + ! Return if air_specifier is blank (no aircraft data to process) + !------------------------------------------------------------------ + if (air_specifier(1) == "") return + +! count aircraft emission species used in the simulation + count_emis: do n=1,N_AERO + + if( len_trim(air_specifier(n) ) == 0 ) then + exit count_emis + endif + + i = scan(air_specifier(n),'->') + spc_name = trim(adjustl(air_specifier(n)(:i-1))) + filelist = trim(adjustl(air_specifier(n)(i+2:))) + + mm = get_aircraft_ndx(spc_name) + if( mm < 1 ) then + call endrun('aircraft_emit_register: '//trim(spc_name)//' is not in the aircraft emission dataset') + endif + + aircraft_cnt = aircraft_cnt + 1 + call pbuf_add_field(aero_names(mm),'physpkg',dtype_r8,(/pcols,pver/),idx) + + spc_flist(aircraft_cnt) = filelist + spc_name_list(aircraft_cnt) = spc_name + index_map(aircraft_cnt) = mm + + curr_filename='' + datapath='' + spc_fname(aircraft_cnt) = incr_filename( curr_filename, filenames_list=spc_flist(aircraft_cnt), datapath=datapath) + + if( advective_tracer(mm) ) then + long_name = 'aircraft_'//trim(spc_name) + call cnst_add(aero_names(mm),molmass(mm),cptmp,qmin,ind,longname=long_name,readiv=read_iv, & + mixtype=mixtype(mm),cam_outfld=cam_outfld,fixed_ubc=has_fixed_ubc) + endif + + enddo count_emis +! count aircraft emission species used in the simulation + + endsubroutine aircraft_emit_register + + subroutine aircraft_emit_init() +!------------------------------------------------------------------- +! **** Initialize the aircraft aerosol data handling **** +!------------------------------------------------------------------- + use cam_history, only: addfld, add_default + use tracer_data, only: trcdata_init + use phys_control, only: phys_getopts + + implicit none + + character(len=16) :: spc_name + + integer :: astat, m + + logical :: history_chemistry + + call phys_getopts(history_chemistry_out=history_chemistry) + + !------------------------------------------------------------------ + ! Return if aircraft_cnt is zero (no aircraft data to process) + !------------------------------------------------------------------ + if (aircraft_cnt == 0 ) return + + if (masterproc) write(iulog,*) ' ' + + !----------------------------------------------------------------------- + ! allocate forcings type array + !----------------------------------------------------------------------- + allocate( forcings_air(aircraft_cnt), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air array; error = ',astat + call endrun + end if + + !----------------------------------------------------------------------- + ! setup the forcings_air type array + !----------------------------------------------------------------------- + species_loop : do m = 1,aircraft_cnt + + allocate( forcings_air(m)%sectors(1), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air%sectors array; error = ',astat + call endrun + end if + + allocate( forcings_air(m)%fields(1), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air%fields array; error = ',astat + call endrun + end if + + spc_name = spc_name_list(m) + !----------------------------------------------------------------------- + ! default settings + !----------------------------------------------------------------------- + forcings_air(m)%file%stepTime = .true. ! Aircraft data is not to be interpolated in time + forcings_air(m)%file%cyclical_list = .true. ! Aircraft data cycles over the filename list + forcings_air(m)%file%weight_by_lat = .true. ! Aircraft data - interpolated with latitude weighting + forcings_air(m)%file%conserve_column = .true. ! Aircraft data - vertically interpolated to conserve the total column + forcings_air(m)%species = spc_name + forcings_air(m)%sectors = spc_name ! Only one species per file for aircraft data + forcings_air(m)%nsectors = 1 + forcings_air(m)%filelist = spc_flist(m) +! forcings_air(m)%file%curr_filename = spc_fname(m) + forcings_air(m)%filename = spc_fname(m) + call addfld( trim(spc_name), (/ 'lev' /), 'A', '1/s', & + 'aircraft emission '//trim(spc_name) ) + if (history_chemistry) then + call add_default( trim(spc_name), 1, ' ' ) + end if + end do species_loop + + if (masterproc) then + !----------------------------------------------------------------------- + ! diagnostics + !----------------------------------------------------------------------- + write(iulog,*) ' ' + write(iulog,*) 'aircraft_emit_init: diagnostics' + write(iulog,*) ' ' + write(iulog,*) 'aircraft_emit timing specs' + write(iulog,*) 'type = ',air_type + write(iulog,*) ' ' + write(iulog,*) 'there are ',aircraft_cnt,' species of aircraft emission' + do m = 1,aircraft_cnt + write(iulog,*) ' ' + write(iulog,*) 'forcing type ',m + write(iulog,*) 'species = ',trim(forcings_air(m)%species) + write(iulog,*) 'filelist= ',trim(forcings_air(m)%filelist) + end do + write(iulog,*) ' ' + endif + + !------------------------------------------------------------------ + ! Initialize the aircraft file processing + !------------------------------------------------------------------ + do m=1,aircraft_cnt + + allocate (forcings_air(m)%file%in_pbuf(size(forcings_air(m)%sectors))) + forcings_air(m)%file%in_pbuf(:) = .true. + call trcdata_init( forcings_air(m)%sectors, forcings_air(m)%filename, forcings_air(m)%filelist, datapath, & + forcings_air(m)%fields, forcings_air(m)%file, rmv_file, 0, 0, 0, air_type) + + + number_flds = 0 + if (associated(forcings_air(m)%fields)) number_flds = size( forcings_air(m)%fields ) + + if( number_flds < 1 ) then + if ( masterproc ) then + write(iulog,*) 'There are no aircraft aerosols' + write(iulog,*) ' ' + call endrun + endif + end if + end do + + + end subroutine aircraft_emit_init + + + + subroutine aircraft_emit_adv( state, pbuf2d) +!------------------------------------------------------------------- +! **** Advance to the next aircraft data **** +!------------------------------------------------------------------- + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz ! J/K/molecule +! C.-C. Chen +! use physconst, only : gravit, rearth + use phys_grid, only : get_wght_all_p + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + integer :: ind,c,ncol,i,caseid,m,n + real(r8) :: to_mmr(pcols,pver) + real(r8),pointer :: tmpptr(:,:) + +! C.-C. Chen + real(r8) :: wght(pcols) + + !------------------------------------------------------------------ + ! Return if aircraft_cnt is zero (no aircraft data to process) + !------------------------------------------------------------------ + if (aircraft_cnt == 0 ) return + call t_startf('All_aircraft_emit_adv') + + !------------------------------------------------------------------- + ! For each field, read more data if needed and interpolate it to the current model time + !------------------------------------------------------------------- + do m = 1, aircraft_cnt + call advance_trcdata( forcings_air(m)%fields, forcings_air(m)%file, state, pbuf2d) + + !------------------------------------------------------------------- + ! set the tracer fields with the correct units + !------------------------------------------------------------------- + do i = 1,number_flds + +! C.-C. Chen, adding case 4 for kg/sec + select case ( to_lower(trim(forcings_air(m)%fields(i)%units(:GLC(forcings_air(m)%fields(i)%units)))) ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + caseid = 1 + case ('kg/kg','mmr') + caseid = 2 + case ('mol/mol','mole/mole','vmr','fraction') + caseid = 3 + case ('kg/kg/sec') + caseid = 4 + case default + print*, 'aircraft_emit_adv: units = ',trim(forcings_air(m)%fields(i)%units) ,' are not recognized' + call endrun('aircraft_emit_adv: units are not recognized') + end select + + ind = index_map(i) + +!$OMP PARALLEL DO PRIVATE (C, NCOL, TO_MMR, tmpptr, pbuf_chnk) + do c = begchunk,endchunk + ncol = state(c)%ncol + +! C.-C. Chen, turning emission data to mixing ratio + call get_wght_all_p(c,ncol,wght(:ncol)) + + if (caseid == 1) then + to_mmr(:ncol,:) = (molmass(ind)*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) + elseif (caseid == 2) then + to_mmr(:ncol,:) = 1._r8 + elseif (caseid == 4) then +! do n=1,ncol +! to_mmr(n,:) = 1.0_r8/(rearth*rearth*wght(n)*state(c)%pdel(n,:)/gravit) +! end do + to_mmr(:ncol,:) = 1.0_r8 + else + to_mmr(:ncol,:) = molmass(ind)/mwdry + endif + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + call pbuf_get_field(pbuf_chnk, forcings_air(m)%fields(i)%pbuf_ndx, tmpptr ) + + tmpptr(:ncol,:) = tmpptr(:ncol,:)*to_mmr(:ncol,:) + + call outfld( forcings_air(m)%fields(i)%fldnam, & + tmpptr, ncol, state(c)%lchnk ) + + enddo + enddo + enddo + + call t_stopf('All_aircraft_emit_adv') + end subroutine aircraft_emit_adv + + subroutine aircraft_emit_readnl(nlfile) +!------------------------------------------------------------------- +! **** Read in the aircraft_emit namelist ***** +!------------------------------------------------------------------- + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aircraft_emit_readnl' + + character(len=256) :: aircraft_specifier(N_AERO) + character(len=24) :: aircraft_type + + namelist /aircraft_emit_nl/ aircraft_specifier, aircraft_type + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + aircraft_specifier= air_specifier + aircraft_type = air_type + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aircraft_emit_nl', status=ierr) + if (ierr == 0) then + read(unitn, aircraft_emit_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(aircraft_specifier,len(aircraft_specifier(1))*N_AERO, mpichar, 0, mpicom) + call mpibcast(aircraft_type, len(aircraft_type), mpichar, 0, mpicom) +#endif + + ! Update module variables with user settings. + air_specifier = aircraft_specifier + air_type = aircraft_type + + end subroutine aircraft_emit_readnl + + integer function get_aircraft_ndx( name ) + + implicit none + character(len=*), intent(in) :: name + + integer :: i + + get_aircraft_ndx = 0 + do i = 1,N_AERO + if ( trim(name) == trim(aero_names(i)) ) then + get_aircraft_ndx = i + return + endif + enddo + + end function get_aircraft_ndx + +end module aircraft_emit diff --git a/src/chemistry/utils/apex.F90 b/src/chemistry/utils/apex.F90 new file mode 100644 index 0000000000..6e24ec9dd4 --- /dev/null +++ b/src/chemistry/utils/apex.F90 @@ -0,0 +1,2274 @@ +module apex +! +! April, 2013: B. Foster (NCAR/HAO) +! +! This is a refactored version of the legacy apex code, originally written +! by Art Richmond and Roy Barnes, and others in the 1995-2000 timeframe. +! This new version is written in free-format fortran90. Subroutines and +! module data may be use-associated from this module. +! +! Original reference for the legacy code: +! Richmond, A. D., Ionospheric Electrodynamics Using Magnetic Apex +! Coordinates, J. Geomag. Geoelectr., 47, 191-212, 1995. +! +! This code should produce near-identical results as the legacy code, altho +! the refactored version does not provide all subroutines and options available +! in the old code, notably the ability to write and read-back an external file. +! +! A typical calling sequence for a code calling this module is as follows: +! +! subroutine ggrid (legacy SUBROUTINE GGRID): +! Make a global lat,lon,alt grid for use in later calls (optional) +! +! subroutine apex_mka (legacy SUBROUTINE APXMKA): +! Make magnetic arrays x,y,z,v for use in later routines +! (geographic lat,lon grid and altitudes are input) +! (This must be called before apex_mall and apex_q2g) +! +! subroutine apex_mall (legacy ENTRY APXMALL): +! Calculate modified Apex coordinates and other magnetic field parameters +! (usually called from lat,lon,alt nested loop) +! +! subroutine apex_q2g (legacy ENTRY APXQ2G): +! Convert from quasi-dipole to geodetic coordinates +! (usually called from lat,lon,alt nested loop) +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use cam_abortutils,only : endrun + + implicit none + + private + public :: apex_set_igrf + public :: apex_mka + public :: apex_mall + public :: apex_dypol + public :: apex_subsol + public :: apex_magloctm + public :: apex_beg_yr + public :: apex_end_yr + public :: apex_q2g + + real(r8),parameter :: re = 6371.2_r8, eps = 1.e-5_r8 + + real(r8),allocatable,save :: & + xarray(:,:,:), & ! cos(quasi-dipole latitude)*cos(apex longitude) + yarray(:,:,:), & ! cos(quasi-dipole latitude)*sin(apex longitude) + zarray(:,:,:), & ! sin(quasi-dipole latitude) + varray(:,:,:) ! (VMP/VP)*((RE+ALT)/RE)**2 +! +! This grid (geolat,geolon,geoalt is equivalent to gdlat,gdlon,gdalt, +! as passed to apex_mka. +! + integer :: nglat,nglon,ngalt + real(r8),allocatable,save :: geolat(:), geolon(:), geoalt(:) + + integer,parameter :: nmax=13 + integer,parameter :: ncoef = nmax*nmax + 2*nmax + 1 ! 196 + real(r8),dimension(ncoef) :: & + gb, & ! Coefficients for magnetic field calculation + gv ! Coefficients for magnetic potential calculation +! + real(r8) :: & + rtd, & ! radians to degrees + dtr, & ! degrees to radians + pola ! pole angle (deg); when geographic lat is poleward of pola, + ! x,y,z,v arrays are forced to be constant (pola=89.995) + + real(r8),parameter :: & ! Formerly common /APXCON/ + req = 6378.160_r8, & ! Equatorial earth radius + precise = 7.6e-11_r8, & ! Precision factor + glatlim = 89.9_r8, & ! Limit above which gradients are recalculated + xmiss = -32767._r8 +! +! colat,elon,vp,ctp,stp were in two commons in legacy code: +! /APXDIPL/ and /DIPOLE/. Need to check if these need to be separated. +! + real(r8) :: & ! Formerly /APXDIPL/ and /DIPOLE/ + colat, & ! Geocentric colatitude of geomagnetic dipole north pole (deg) + elon, & ! East longitude of geomagnetic dipole north pole (deg) + vp, & ! Magnitude, in T.m, of dipole component of magnetic + ! potential at geomagnetic pole and geocentric radius re + ctp,stp +! + real(r8) :: & ! Formerly /FLDCOMD/ + bx, & ! X comp. of field vector at the current tracing point (Gauss) + by, & ! Y comp. of field vector at the current tracing point (Gauss) + bz, & ! Z comp. of field vector at the current tracing point (Gauss) + bb ! Magnitude of field vector at the current tracing point (Gauss) + + real(r8) :: & ! Formerly /APXIN/ + yapx(3,3) ! Matrix of cartesian coordinates (loaded columnwise) +! +! /ITRA/ was only in subs linapx and itrace, so can probably be removed from module data +! + integer :: & ! Formerly /ITRA/ + nstp ! Step count. Incremented in sub linapx. + real(r8) :: & + y(3), & ! Array containing current tracing point cartesian coordinates. + yp(3), & ! Array containing previous tracing point cartesian coordinates. + sgn, & ! Determines direction of trace. Set in subprogram linapx + ds ! Step size (Km) Computed in subprogram linapx. + + real(r8) :: & ! limits beyond which east-west gradients are computed + glatmn,glatmx ! differently to avoid potential underflow (apex_mka) + + ! IGRF coefficients + real(r8), allocatable :: g1(:,:), g2(:,:) + integer :: n1, n2, ncn1, ncn2, year1, year2 + integer, protected :: apex_beg_yr + integer, protected :: apex_end_yr + + logical :: igrf_set = .false. + +contains +!----------------------------------------------------------------------- +subroutine ggrid(nvert,glatmin,glatmax,glonmin,glonmax,altmin,altmax, & + gplat,gplon,gpalt,mxlat,mxlon,mxalt,nlat,nlon,nalt) +! +! Given desired range of geographic latitude, longitude and altitude, +! choose an appropriate grid that can be used in subsequent calls to +! subs apex_mka, apex_mall, apex_q2g. +! +! Input args: + integer,intent(in) :: nvert,mxlat,mxlon,mxalt + real(r8),intent(in) :: glatmin,glatmax,glonmin,glonmax,altmin,altmax +! +! Output args: + integer,intent(out) :: nlat,nlon,nalt + real(r8),intent(out) :: gplat(mxlat),gplon(mxlon),gpalt(mxalt) +! +! Local: + real(r8) :: dlon,dlat,diht,dnv,glonmaxx,x + integer :: nlatmin,nlatmax,nlonmin,nlonmax,naltmin,naltmax + integer :: i,j,k,kk + character(len=128) :: errmsg +! +! Check inputs: + if (glatmin > glatmax) then + write(errmsg,"('>>> ggrid: glatmin=',f9.2,' must be <= glatmax=',f9.2)") glatmin,glatmax + write(iulog,*) errmsg + call endrun( trim(errmsg) ) + endif + if (glonmin > glonmax) then + write(errmsg,"('>>> ggrid: glonmin=',f9.2,' must be <= glonmax=',f9.2)") glonmin,glonmax + write(iulog,*) errmsg + call endrun( trim(errmsg) ) + endif + if (altmin > altmax) then + write(errmsg,"('>>> ggrid: altmin=',f9.2,' must be <= altmax=',f9.2)") altmin,altmax + write(iulog,*) errmsg + call endrun( trim(errmsg) ) + endif +! +! Init outputs: + nlat = 0 ; nlon = 0 ; nalt = 0 + gplat = 0._r8 ; gplon = 0._r8 ; gpalt = 0._r8 +! + dnv = dble(nvert) + dlon = 360._r8 / (5._r8*dnv) + dlat = 180._r8 / (3._r8*dnv) + diht = 1._r8 / dnv + + nlatmin = max(int((glatmin+90._r8)/dlat),0) + nlatmax = min(int((glatmax+90._r8)/dlat+1._r8),3*nvert) + nlonmin = max(int((glonmin+180._r8)/dlon),0) + + glonmaxx = min(glonmax,glonmin+360._r8) + nlonmax = min(int((glonmaxx+180._r8)/dlon+1._r8),10*nvert) + + x = re/(re+altmax)/diht-eps + naltmin = max(x,1._r8) + naltmin = min(naltmin,nvert-1) + x = re/(re+altmin)/diht+eps + i = x + 1._r8 + naltmax = min(i,nvert) + + nlat = nlatmax - nlatmin + 1 + nlon = nlonmax - nlonmin + 1 + nlon = min(nlon,5*nvert+1) + nalt = naltmax - naltmin + 1 + + do j=1,nlat + gplat(j) = dlat*dble(nlatmin+j-1) - 90._r8 + enddo + do i=1,nlon + gplon(i) = dlon*dble(nlonmin+i-1) - 180._r8 + enddo + do k=1,nalt + kk = naltmax - k +1 + gpalt(k) = re*(dble(nvert-kk) - eps) / (dble(kk)+eps) + enddo + if (gplon(nlon-1) >= glonmax) nlon = nlon-1 + gpalt(1) = max(gpalt(1),0._r8) + + write(iulog,"('ggrid: nlat=',i4,' gplat=',/,(6f9.2))") nlat,gplat + write(iulog,"('ggrid: nlon=',i4,' gplon=',/,(6f9.2))") nlon,gplon + write(iulog,"('ggrid: nalt=',i4,' gpalt=',/,(6f9.2))") nalt,gpalt + +end subroutine ggrid + + +!----------------------------------------------------------------------- +subroutine apex_set_igrf(coefs_file) + use ioFileMod, only : getfil + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_get_var, pio_closefile, pio_nowrite, pio_inq_varid, pio_inq_dimid, pio_inq_dimlen + + character(len=*), intent(in) :: coefs_file + + integer :: ierr + integer :: dim_id, var_id + type(file_desc_t) :: ncid + character(len=256) :: locfn + + if (igrf_set) return + + !---------------------------------------------------------------------- + ! ... open the netcdf file + !---------------------------------------------------------------------- + call getfil(coefs_file, locfn, 0) + call cam_pio_openfile( ncid, trim(locfn), PIO_NOWRITE) + + !---------------------------------------------------------------------- + ! ... read the snoe dimensions + !---------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'n1', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, n1 ) + ierr = pio_inq_dimid( ncid, 'ncn1', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, ncn1 ) + + ierr = pio_inq_dimid( ncid, 'n2', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, n2 ) + ierr = pio_inq_dimid( ncid, 'ncn2', dim_id ) + ierr = pio_inq_dimlen( ncid, dim_id, ncn2 ) + + allocate( g1(n1,ncn1), g2(n2,ncn2) ) + + ierr = pio_inq_varid( ncid, 'g1', var_id ) + ierr = pio_get_var( ncid, var_id, g1 ) + + ierr = pio_inq_varid( ncid, 'g2', var_id ) + ierr = pio_get_var( ncid, var_id, g2 ) + + ierr = pio_inq_varid( ncid, 'era1_year', var_id ) + ierr = pio_get_var( ncid, var_id, year1 ) + + ierr = pio_inq_varid( ncid, 'era2_year', var_id ) + ierr = pio_get_var( ncid, var_id, year2 ) + + call pio_closefile(ncid) + + apex_beg_yr = year1 + apex_end_yr = year2+5*(ncn2-1) + + igrf_set = .true. + +end subroutine apex_set_igrf + +!----------------------------------------------------------------------- +subroutine apex_mka(date,gplat,gplon,gpalt,nlat,nlon,nalt,ier) +! +! Given a 3d lat,lon,altitude grid, calculate x,y,z,v arrays in module +! data above. These arrays are used later for calculating quantities +! involving gradients of Apex coordinates, such as base vectors in the +! Modified-Apex and Quasi-Dipole systems. +! +! This defines module 3d data xarray,yarray,zarray,varray +! +! Input args: + real(r8),intent(in) :: date ! year and fraction + integer, intent(in) :: nlat,nlon,nalt ! dimensions of 3d grid + real(r8),intent(inout) :: gplat(nlat),gplon(nlon),gpalt(nalt) +! +! Output args: + integer,intent(out) :: ier +! +! Local: + integer :: i,j,k,kpol,istat + real(r8) :: reqore,rqorm1,cp,ct,st,sp,stmcpm,stmspm,ctm + real(r8) :: aht,alat,phia,bmag,xmag,ymag,zdown,vmp ! apex_sub output + real(r8) :: vnor,rp,reqam1,slp,clp,phiar + + ier = 0 +! +! Some parts of the legacy apex code use constants to set dtr,rtd, +! other parts use rtd=45./atan(1.), dtr=1./rtd. Differences are +! on the order of 1.e-18 to 1.e-14. Here, the atan method is used. +! +! rtd = 5.72957795130823E1 +! dtr = 1.745329251994330E-2 +! + rtd = 45._r8/atan(1._r8) + dtr = 1._r8/rtd +! +! pola: +! Pole angle (deg); when the geographic latitude is poleward of POLA, +! X,Y,Z,V are forced to be constant for all longitudes at each altitude. +! This makes POLA = 89.995 +! + pola = 90._r8-sqrt(precise)*rtd ! Pole angle (deg) + +! +! Allocate 3d x,y,z,v arrays: +! These are not deallocated by this module. They can be deallocated +! by the calling program following the last call to the apex subs. +! + if (.not.allocated(xarray)) then + allocate(xarray(nlat,nlon,nalt),stat=istat) + if (istat /= 0) call endrun( 'allocate xarray' ) + xarray = 0._r8 + endif + if (.not.allocated(yarray)) then + allocate(yarray(nlat,nlon,nalt),stat=istat) + if (istat /= 0) call endrun( 'allocate yarray' ) + yarray = 0._r8 + endif + if (.not.allocated(zarray)) then + allocate(zarray(nlat,nlon,nalt),stat=istat) + if (istat /= 0) call endrun( 'allocate zarray' ) + zarray = 0._r8 + endif + if (.not.allocated(varray)) then + allocate(varray(nlat,nlon,nalt),stat=istat) + if (istat /= 0) call endrun( 'allocate varray' ) + varray = 0._r8 + endif +! +! Set geographic grid in module data for later reference: +! (these also are not deallocated by this module) +! + nglon=nlon ; nglat=nlat ; ngalt=nalt + if (.not.allocated(geolat)) allocate(geolat(nglat),stat=istat) + if (.not.allocated(geolon)) allocate(geolon(nglon),stat=istat) + if (.not.allocated(geoalt)) allocate(geoalt(ngalt),stat=istat) + geolat(:) = gplat(:) + geolon(:) = gplon(:) + geoalt(:) = gpalt(:) +! +! Set coefficients gb,gv (module data) for requested year: +! + call cofrm(date) + +! write(iulog,"('apex_mka after cofrm: ncoef=',i4,' gb=',/,(6f12.3))") ncoef,gb +! write(iulog,"('apex_mka after cofrm: ncoef=',i4,' gv=',/,(6f12.3))") ncoef,gv + + call apex_dypol(colat,elon,vp) + + ctp = cos(colat*dtr) + stp = sin(colat*dtr) + + reqore = req/re + rqorm1 = reqore-1._r8 + + do j=1,nlat + ct = sin(gplat(j)*dtr) + st = cos(gplat(j)*dtr) + kpol = 0 + if (abs(gplat(j)) > pola) kpol = 1 + do i=1,nlon + if (kpol==1.and.i > 1) then + xarray(j,i,:) = xarray(j,1,:) + yarray(j,i,:) = yarray(j,1,:) + zarray(j,i,:) = zarray(j,1,:) + varray(j,i,:) = varray(j,1,:) + cycle + endif + cp = cos((gplon(i)-elon)*dtr) + sp = sin((gplon(i)-elon)*dtr) +! +! ctm is pseudodipole component of z +! -ctm is pseudodipole component of v +! stmcpm is pseudodipole component of x +! stmspm is pseudodipole component of y +! + ctm = ctp*ct + stp*st*cp + stmcpm = st*ctp*cp - ct*stp + stmspm = st*sp + do k=1,nalt + call apex_sub(date,gplat(j),gplon(i),gpalt(k),& + aht,alat,phia,bmag,xmag,ymag,zdown,vmp) + + vnor = vmp/vp + rp = 1._r8 + gpalt(k)/re + varray(j,i,k) = vnor*rp*rp + ctm + reqam1 = req*(aht-1._r8) + slp = sqrt(max(reqam1-gpalt(k),0._r8)/(reqam1+re)) +! +! Reverse sign of slp in southern magnetic hemisphere +! + if (zdown.lt.0._r8) slp = -slp + clp = sqrt (rp/(reqore*aht-rqorm1)) + phiar = phia*dtr + xarray(j,i,k) = clp*cos (phiar) - stmcpm + yarray(j,i,k) = clp*sin (phiar) - stmspm + zarray(j,i,k) = slp - ctm + enddo ! k=1,nalt + enddo ! i=1,nlon + enddo ! j=1,nlat +! +! Establish for this grid polar latitude limits beyond which east-west +! gradients are computed differently to avoid potential underflow +! (glatmx,glatmn are in module data, glatlim is parameter constant) +! + glatmx = max( glatlim,gplat(nlat-2)) + glatmn = min(-glatlim,gplat(2)) + +end subroutine apex_mka +!----------------------------------------------------------------------- +subroutine apex_mall(glat,glon,alt,hr, b,bhat,bmag,si,alon,xlatm,vmp,w,& + d,be3,sim,d1,d2,d3,e1,e2,e3,xlatqd,f,f1,f2,ier) +! +! Compute Modified Apex coordinates, quasi-dipole coordinates, +! base vectors and other parameters by interpolation from +! precalculated arrays. Subroutine apex_mka must be called +! before calling this subroutine. +! +! Args: + real(r8),intent(in) :: & ! Input + glat ,& ! Geographic (geodetic) latitude (deg) + glon ,& ! Geographic (geodetic) longitude (deg) + alt ,& ! Altitude (km) + hr ! Reference altitude (km) + + real(r8),intent(out) :: & ! Output + b(3) ,& ! Magnetic field components (east, north, up), in nT + bhat(3) ,& ! components (east, north, up) of unit vector along + ! geomagnetic field direction + bmag ,& ! Magnitude of magnetic field (nT) + si ,& ! sin(i) + alon ,& ! Apex longitude = modified apex longitude = + ! quasi-dipole longitude (deg) + xlatm ,& ! Modified Apex latitude (deg) + vmp ,& ! Magnetic potential (T.m) + w ,& ! W of Richmond reference above, in km**2 /nT (i.e., 10**15 m**2 /T) + d ,& ! D of Richmond reference above + be3 ,& ! B_e3 of reference above (= Bmag/D), in nT + sim ,& ! sin(I_m) described in Richmond reference above + xlatqd ,& ! Quasi-dipole latitude (deg) + f ,& ! F described in ref above for quasi-dipole coordinates + f1(2),f2(2) ! Components (east, north) of base vectors +! + real(r8),dimension(3),intent(out) :: d1,d2,d3,e1,e2,e3 ! Components of base vectors + integer,intent(out) :: ier ! error return +! +! Local: + real(r8) :: glonloc,cth,sth,glatx,clm,r3_2 + real(r8) :: fx,fy,fz,fv + real(r8) :: dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh ,dfydh ,dfzdh ,dfvdh + real(r8),dimension(3) :: gradx,grady,gradz,gradv, grclm,clmgrp,rgrlp + real(r8) :: & ! dummies for polar calls to intrp + fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth, & + dmxdh,dmydh,dmzdh,dmvdh +! +! Init: +! + ier = 0 + glonloc = glon + + call intrp (glat,glonloc,alt, geolat,geolon,geoalt,nglat,nglon,ngalt, & + fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh ,dfydh ,dfzdh ,dfvdh, ier) + + if (ier /= 0) then + call setmiss(xmiss,xlatm,alon,vmp,b,bmag,be3,sim,si,f,d,w, & + bhat,d1,d2,d3,e1,e2,e3,f1,f2) + write(iulog,"('apex_mall called setmiss: glat,glon,alt=',3f12.3)") & + glat,glon,alt + return + endif + + call adpl(glat,glonloc,cth,sth,fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth,dfxdln,dfydln,dfzdln,dfvdln) + + call gradxyzv(alt,cth,sth, & + dfxdth,dfydth,dfzdth,dfvdth,dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh,dfydh,dfzdh,dfvdh,gradx,grady,gradz,gradv) +! +! If the point is very close to either the North or South +! geographic pole, recompute the east-west gradients after +! stepping a small distance from the pole. +! + if (glat > glatmx .or. glat < glatmn) then + glatx = glatmx + if (glat < 0._r8) glatx = glatmn + + call intrp (glatx,glonloc,alt, geolat,geolon,geoalt,nglat,nglon,ngalt, & + fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth,dfxdln,dfydln,dfzdln, & + dfvdln,dmxdh,dmydh,dmzdh,dmvdh, ier) + + call adpl(glatx,glonloc,cth,sth,fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth,dfxdln,dfydln,dfzdln,dfvdln) + + call grapxyzv(alt,cth,sth,dfxdln,dfydln,dfzdln,dfvdln, & + gradx,grady,gradz,gradv) + endif + + call gradlpv(hr,alt,fx,fy,fz,fv,gradx,grady,gradz,gradv, & + xlatm,alon,vmp,grclm,clmgrp,xlatqd,rgrlp,b,clm,r3_2) + + call basevec(hr,xlatm,grclm,clmgrp,rgrlp,b,clm,r3_2, & + bmag,sim,si,f,d,w,bhat,d1,d2,d3,e1,e2,e3,f1,f2) + + be3 = bmag/d + ier = 0 + +end subroutine apex_mall +!----------------------------------------------------------------------- +subroutine apex_q2g(qdlat,qdlon,alt,gdlat,gdlon,ier) +! +! Convert from quasi-dipole to geodetic coordinates. This subroutine +! (input magnetic, output geodetic) is the functional inverse of +! subroutine apex_mall (input geodetic, output magnetic). Sub apex_mka +! must be called before this routine. +! +! Args: + real(r8),intent(in) :: & ! inputs + qdlat, & ! quasi-dipole latitude (deg) + qdlon, & ! quasi-dipole longitude (deg) + alt ! altitude (km) + + real(r8),intent(out) :: & ! outputs + gdlat, & ! geodetic latitude (deg) + gdlon ! geodetic longitude (deg) + integer,intent(out) :: ier ! error return +! +! Local: + real(r8) :: x0,y0,z0,xnorm,xdif,ydif,zdif,dist2,hgrd2e,hgrd2n,hgrd2,& + angdist,distlon,glatx,cal,sal,coslm,slm,cad,sad,slp,clm2,slm2,& + sad2,cal2,clp2,clp,dylon + real(r8) :: ylat,ylon ! first guess output by gm2gc, input to intrp + integer :: iter + integer,parameter :: niter=20 + real(r8) :: & ! output of sub intrp + fx,fy,fz,fv, & ! interpolated values of x,y,z,v + dfxdth,dfydth,dfzdth,dfvdth, & ! derivatives of x,y,z,v wrt colatitude + dfxdln,dfydln,dfzdln,dfvdln, & ! derivatives of x,y,z,v wrt longitude + dfxdh ,dfydh ,dfzdh ,dfvdh ! derivatives of x,y,z,v wrt altitude + real(r8) :: & ! dummies for polar calls to intrp + fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth, & + dmxdh,dmydh,dmzdh,dmvdh + real(r8) :: cth,sth ! output of adpl + character(len=5) :: edge + + ier = 0 ; gdlat = 0._r8 ; gdlon = 0._r8 +! +! Determine quasi-cartesian coordinates on a unit sphere of the +! desired magnetic lat,lon in quasi-dipole coordinates. +! + x0 = cos (qdlat*dtr) * cos (qdlon*dtr) + y0 = cos (qdlat*dtr) * sin (qdlon*dtr) + z0 = sin (qdlat*dtr) +! +! Initial guess: use centered dipole, convert to geocentric coords +! + call gm2gc (qdlat,qdlon,ylat,ylon) +! +! Iterate until (angular distance)**2 (units: radians) is within +! precise of location (qdlat,qdlon) on a unit sphere. +! (precise is a parameter in module data) +! + do iter=1,niter +! +! geolat,lon,alt and nglat,lon,alt are in module data (set by apex_mka) +! + call intrp (ylat,ylon,alt, geolat,geolon,geoalt,nglat,nglon,ngalt, & + fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh ,dfydh ,dfzdh ,dfvdh, ier) + if (ier /= 0) then + write(iulog,"('>>> apex_q2g error from intrp')") + call endrun( 'qpex_q2g intrp' ) + endif +! +! Add-back of pseudodipole component to x,y,z,v and their derivatives. +! + call adpl(ylat,ylon,cth,sth,fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth,dfxdln,dfydln,dfzdln,dfvdln) + distlon = cos(ylat*dtr) + + if (ylat > glatmx .or. ylat < glatmn) then ! glatmx,glatmn are module data + glatx = glatmx + if (ylat.lt.0._r8) glatx = glatmn + distlon = cos (glatx*dtr) + call intrp (glatx,ylon,alt, geolat,geolon,geoalt,nglat,nglon,ngalt, & + fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth,dfxdln,dfydln,dfzdln, & + dfvdln,dmxdh,dmydh,dmzdh,dmvdh, ier) + if (ier /= 0) then + write(iulog,"('>>> apex_q2g error from polar intrp')") + call endrun( 'qpex_q2g intrp' ) + endif + + call adpl(glatx,ylon,cth,sth,fxdum,fydum,fzdum,fvdum, & + dmxdth,dmydth,dmzdth,dmvdth,dfxdln,dfydln,dfzdln,dfvdln) + endif +! +! At this point, FX,FY,FZ are approximate quasi-cartesian +! coordinates on a unit sphere for the quasi-dipole coordinates +! corresponding to the geodetic coordinates YLAT, YLON. +! Normalize the vector length of (FX,FY,FZ) to unity using XNORM +! so that the resultant vector can be directly compared with the +! target vector (X0,Y0,Z0). +! + xnorm = sqrt(fx*fx + fy*fy + fz*fz) + xdif = fx/xnorm - x0 + ydif = fy/xnorm - y0 + zdif = fz/xnorm - z0 +! +! dist2 = square of distance between normalized (fx,fy,fz) and x0,y0,z0. +! + dist2 = xdif*xdif + ydif*ydif + zdif*zdif + + if (dist2 <= precise) then + ier = 0 + gdlat = ylat + gdlon = ylon + return + endif +! +! hgrd2* = one-half of east or north gradient of dist2 on unit sphere. +! + hgrd2e = (xdif*dfxdln + ydif*dfydln + zdif*dfzdln)/distlon + hgrd2n = -(xdif*dfxdth + ydif*dfydth + zdif*dfzdth) + hgrd2 = sqrt(hgrd2e*hgrd2e + hgrd2n*hgrd2n) +! +! angdist = magnitude of angular distance to be moved for new guess +! of ylat, ylon. +! + angdist = dist2/hgrd2 +! +! Following spherical trigonometry moves ylat,ylon to new location, +! in direction of grad(dist2), by amount angdist. +! + cal = -hgrd2n/hgrd2 + sal = -hgrd2e/hgrd2 + coslm = cos(ylat*dtr) + slm = sin(ylat*dtr) + cad = cos(angdist) + sad = sin(angdist) + slp = slm*cad + coslm*sad*cal + + clm2 = coslm*coslm + slm2 = slm*slm + sad2 = sad*sad + cal2 = cal*caL + clp2 = clm2 + slm2*sad2 - 2._r8*slm*cad*coslm*sad*cal -clm2*sad2*cal2 + clp = sqrt (max(0._r8,clp2)) + ylat = atan2(slp,clp)*rtd +! +! Restrict latitude iterations to stay within the interpolation grid +! limits, but let intrp find any longitude exceedence. This is only +! an issue when the interpolation grid does not cover the entire +! magnetic pole region. +! + ylat = min(ylat,geolat(nglat)) + ylat = max(ylat,geolat(1)) + dylon = atan2 (sad*sal,cad*coslm-sad*slm*cal)*rtd + ylon = ylon + dylon + if (ylon > geolon(nglon)) ylon = ylon - 360._r8 + if (ylon < geolon(1)) ylon = ylon + 360._r8 + + enddo ! iter=1,niter + + write(iulog,"('>>> apex_q2g: ',i3,' iterations only reduced the angular')") niter + write(iulog,"(' difference to ',f10.5,' degrees, where test criterion')") & + sqrt(dist2)*rtd + write(iulog,"(' is ',f10.5,' degrees.')") sqrt(precise)*rtd + edge = ' ' + if (ylat == geolat(nglat)) edge = 'north' + if (ylat == geolat(1)) edge = 'south' + if (edge /= ' ') then + write(iulog,"('Coordinates are on the ',a,' edge of the interpolation grid ')") edge + write(iulog,"('and latitude is constrained to stay within grid limits when iterating.')") + endif + ier = 1 + +end subroutine apex_q2g +!----------------------------------------------------------------------- +subroutine gradxyzv(alt,cth,sth, & + dfxdth,dfydth,dfzdth,dfvdth,dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh,dfydh,dfzdh,dfvdh,gradx,grady,gradz,gradv) +! +! Calculates east,north,up components of gradients of x,y,z,v in +! geodetic coordinates. All gradients are in inverse km. Assumes +! flatness of 1/298.25 and equatorial radius (REQ) of 6378.16 km. +! 940803 A. D. Richmond +! +! Args: + real(r8),intent(in) :: alt,cth,sth + real(r8),dimension(3),intent(out) :: gradx,grady,gradz,gradv + real(r8),intent(in) :: & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh,dfydh,dfzdh,dfvdh +! +! Local: + real(r8) :: d,d2,rho,dddthod,drhodth,dzetdth,ddisdth + +! +! 40680925. = req**2 (rounded off) +! 272340. = req**2 * E2, where E2 = (2. - 1./298.25)/298.25 +! is square of eccentricity of ellipsoid. +! + d2 = 40680925.e0_r8 - 272340.e0_r8*cth*cth + d = sqrt(d2) + rho = sth*(alt + 40680925.e0_r8/d) + dddthod = 272340.e0_r8*cth*sth/d2 + drhodth = alt*cth + (40680925.e0_r8/d)*(cth-sth*dddthod) + dzetdth =-alt*sth - (40408585.e0_r8/d)*(sth+cth*dddthod) + ddisdth = sqrt(drhodth*drhodth + dzetdth*dzetdth) + + gradx(1) = dfxdln/rho + grady(1) = dfydln/rho + gradz(1) = dfzdln/rho + gradv(1) = dfvdln/rho + + gradx(2) = -dfxdth/ddisdth + grady(2) = -dfydth/ddisdth + gradz(2) = -dfzdth/ddisdth + gradv(2) = -dfvdth/ddisdth + + gradx(3) = dfxdh + grady(3) = dfydh + gradz(3) = dfzdh + gradv(3) = dfvdh + +end subroutine gradxyzv +!----------------------------------------------------------------------- +subroutine grapxyzv(alt,cth,sth, & + dfxdln,dfydln,dfzdln,dfvdln,gradx,grady,gradz,gradv) +! +! Calculates east component of gradient near pole. +! +! Args: + real(r8),intent(in) :: alt,cth,sth + real(r8),intent(in) :: dfxdln,dfydln,dfzdln,dfvdln + real(r8),dimension(3),intent(inout) :: gradx,grady,gradz,gradv +! +! Local: + real(r8) :: d,d2,rho +! +! 40680925. = req**2 (rounded off) +! 272340. = req**2 * E2, where E2 = (2. - 1./298.25)/298.25 +! is square of eccentricity of ellipsoid. +! + d2 = 40680925.e0_r8 - 272340.e0_r8*cth*cth + d = sqrt(d2) + rho = sth*(alt + 40680925.e0_r8/d) + + gradx(1) = dfxdln/rho + grady(1) = dfydln/rho + gradz(1) = dfzdln/rho + gradv(1) = dfvdln/rho + +end subroutine grapxyzv +!----------------------------------------------------------------------- +subroutine gradlpv(hr,alt,fx,fy,fz,fv,gradx,grady,gradz,gradv, & + xlatm,xlonm,vmp,grclm,clmgrp,qdlat,rgrlp,b,clm,r3_2) +! +! Uses gradients of x,y,z,v to compute geomagnetic field and +! gradients of apex latitude, longitude. +! +! Args: + real(r8),intent(in) :: & ! scalar inputs + hr, & ! reference altitude (km) + alt, & ! altitude (km) + fx,fy,fz,fv ! interpolated values of x,y,z,v, plus + ! pseudodipole component + real(r8),dimension(3),intent(in) :: & ! 3-component inputs + gradx,grady,gradz,gradv ! interpolated gradients of x,y,z,v, + ! including pseudodipole components (east,north,up) +! +! Local: + integer :: i + real(r8) :: rr,r,rn,sqrror,cpm,spm,bo,rn2,x2py2,xlp,slp,clp,grclp + + real(r8),intent(out) :: & ! scalar outputs + xlatm, & ! modified apex latitude (lambda_m), degrees + xlonm, & ! apex longitude (phi_a), degrees + vmp, & ! magnetic potential, in T.m. + qdlat, & ! quasi-dipole latitude, degrees + clm, & ! cos(lambda_m) + r3_2 ! ((re + alt)/(re + hr))**(3/2) + + real(r8),dimension(3),intent(out) :: & ! 3-component outputs + grclm, & ! grad(cos(lambda_m)), in km-1 + clmgrp, & ! cos(lambda_m)*grad(phi_a), in km-1 + rgrlp, & ! (re + alt)*grad(lambda') + b ! magnetic field, in nT + + xlatm=0._r8 ; xlonm=0._r8 ; vmp=0._r8 ; grclm=0._r8 ; clmgrp=0._r8 + rgrlp = 0._r8 ; b=0._r8 ; clm=0._r8 ; r3_2=0._r8 ; qdlat=0._r8 + + rr = re + hr + r = re + alt + rn = r/re + sqrror = sqrt(rr/r) + r3_2 = 1._r8/sqrror/sqrror/sqrror + xlonm = atan2(fy,fx) + cpm = cos(xlonm) + spm = sin(xlonm) + xlonm = rtd*xlonm ! output + bo = vp*1.e6_r8 ! vp is module data; 1.e6 converts T to nT and km-1 to m-1 + rn2 = rn*rn + vmp = vp*fv/rn2 ! output + b(1) = -bo*gradv(1)/rn2 + b(2) = -bo*gradv(2)/rn2 + b(3) = -bo*(gradv(3)-2._r8*fv/r)/rn2 + + x2py2 = fx*fx + fy*fy + xlp = atan2(fz,sqrt(x2py2)) + slp = sin(xlp) + clp = cos(xlp) + qdlat = xlp*rtd ! output + clm = sqrror*clp ! output + if (clm > 1._r8) then + write(iulog,"('>>> gradlpv: hr=',f12.3,' alt=',f12.3)") hr,alt + write(iulog,"(' Point lies below field line that peaks at reference height.')") + call endrun( 'gradlpv' ) + endif + xlatm = rtd*acos(clm) +! +! If southern magnetic hemisphere, reverse sign of xlatm +! + if (slp < 0._r8) xlatm = -xlatm + do i=1,3 + grclp = cpm*gradx(i) + spm*grady(i) + rgrlp(i) = r*(clp*gradz(i) - slp*grclp) + grclm(i) = sqrror*grclp + clmgrp(i) = sqrror*(cpm*grady(i)-spm*gradx(i)) + enddo + grclm(3) = grclm(3) - sqrror*clp/(2._r8*r) + +end subroutine gradlpv +!----------------------------------------------------------------------- +subroutine basevec(hr,xlatm,grclm,clmgrp,rgrlp,b,clm,r3_2, & + bmag,sim,si,f,d,w,bhat,d1,d2,d3,e1,e2,e3,f1,f2) +! +! Computes base vectors and other parameters for apex coordinates. +! Vector components: east, north, up +! +! Args: + real(r8),intent(in) :: & ! scalar inputs + hr, & ! reference altitude + xlatm, & ! modified apex latitude (deg) + clm, & ! cos(lambda_m) + r3_2 ! ((re + altitude)/(re + hr))**(3/2) + + real(r8),dimension(3),intent(in) :: & ! 3-component inputs + grclm, & ! grad(cos(lambda_m)), in km-1 + clmgrp, & ! cos(lambda_m)*grad(phi_a), in km-1 + rgrlp, & ! (re + altitude)*grad(lambda') + b ! ((re + altitude)/(re + hr))**(3/2) + + real(r8),intent(out) :: & ! scalar output + bmag, & ! magnitude of magnetic field, in nT + sim, & ! sin(I_m) of Richmond reference + si, & ! sin(I) + f, & ! F of Richmond reference + d, & ! D of Richmond reference + w ! W of Richmond reference + + real(r8),dimension(3),intent(out) :: & ! 3-component outputs + bhat, & ! unit vector along geomagnetic field direction + d1,d2,d3,e1,e2,e3 ! base vectors of Richmond reference + real(r8),dimension(2),intent(out) :: & ! 2-component outputs + f1,f2 ! base vectors of Richmond reference +! +! Local: + integer :: i + real(r8) :: rr,simoslm,d1db,d2db + + rr = re + hr + simoslm = 2._r8/sqrt(4._r8 - 3._r8*clm*clm) + sim = simoslm*sin(xlatm*dtr) + bmag = sqrt(b(1)*b(1) + b(2)*b(2) + b(3)*b(3)) + d1db = 0._r8 + d2db = 0._r8 + do i=1,3 + bhat(i) = b(i)/bmag + d1(i) = rr*clmgrp(i) + d1db = d1db + d1(i)*bhat(i) + d2(i) = rr*simoslm*grclm(i) + d2db = d2db + d2(i)*bhat(i) + enddo +! +! Ensure that d1,d2 are exactly perpendicular to B: +! + do i=1,3 + d1(i) = d1(i) - d1db*bhat(i) + d2(i) = d2(i) - d2db*bhat(i) + enddo + e3(1) = d1(2)*d2(3) - d1(3)*d2(2) + e3(2) = d1(3)*d2(1) - d1(1)*d2(3) + e3(3) = d1(1)*d2(2) - d1(2)*d2(1) + d = bhat(1)*e3(1) + bhat(2)*e3(2) + bhat(3)*e3(3) + do i=1,3 + d3(i) = bhat(i)/d + e3(i) = bhat(i)*d ! Ensure that e3 lies along bhat. + enddo + e1(1) = d2(2)*d3(3) - d2(3)*d3(2) + e1(2) = d2(3)*d3(1) - d2(1)*d3(3) + e1(3) = d2(1)*d3(2) - d2(2)*d3(1) + e2(1) = d3(2)*d1(3) - d3(3)*d1(2) + e2(2) = d3(3)*d1(1) - d3(1)*d1(3) + e2(3) = d3(1)*d1(2) - d3(2)*d1(1) + w = rr*rr*clm*abs(sim)/(bmag*d) + si = -bhat(3) + f1(1) = rgrlp(2) + f1(2) = -rgrlp(1) + f2(1) = -d1(2)*r3_2 + f2(2) = d1(1)*r3_2 + f = f1(1)*f2(2) - f1(2)*f2(1) + +end subroutine basevec +!----------------------------------------------------------------------- +subroutine apex_dypol(colat,elon,vp) +! +! Output args: + real(r8),intent(out) :: & + colat, & ! Geocentric colatitude of geomagnetic dipole north pole (deg) + elon, & ! East longitude of geomagnetic dipole north pole (deg) + vp ! Magnitude, in T.m, of dipole component of magnetic + ! potential at geomagnetic pole and geocentric radius re +! +! Local: + real(r8) :: gpl,ctp +! +! Compute geographic colatitude and longitude of the north pole of +! earth centered dipole +! + gpl = sqrt( gb(2 )**2+ gb(3 )**2+ gb(4 )**2) + ctp = gb(2 )/gpl + + colat = (acos(ctp))*rtd + elon = atan2( gb(4 ), gb(3 ))*rtd +! +! Compute magnitude of magnetic potential at pole, radius Re. +! .2 = 2*(10**-4 T/gauss)*(1000 m/km) (2 comes through f0 in COFRM). +! + vp = .2_r8*gpl*re + +end subroutine apex_dypol +!----------------------------------------------------------------------- +subroutine apex_sub(date,dlat,dlon,alt,aht,alat,alon,bmag,xmag,ymag,zmag,vmp) +! +! Args: + real(r8),intent(in) :: date + real(r8),intent(inout) :: dlat,dlon,alt + real(r8),intent(out) :: aht,alat,alon,bmag,xmag,ymag,zmag,vmp +! +! Local: + real(r8) :: clatp,polon,vpol,x,y,z,xre,yre,zre + integer :: iflag + + call cofrm(date) + call apex_dypol(clatp,polon,vpol) +! +! colat,ctp,stp,elon,vp are in module data. +! + colat = clatp + ctp = cos(clatp*dtr) + stp = sqrt(1._r8-ctp*ctp) + + elon = polon + vp = vpol + + vmp = 0._r8 +! +! Last 7 args of linapx are output: +! + call linapx(dlat,dlon,alt, aht,alat,alon,xmag,ymag,zmag,bmag) + + xmag = xmag*1.e5_r8 + ymag = ymag*1.e5_r8 + zmag = zmag*1.e5_r8 + bmag = bmag*1.e5_r8 + call gd2cart (dlat,dlon,alt,x,y,z) + iflag = 3 + xre = x/re ; yre = y/re ; zre = z/re + call feldg(iflag,xre,yre,zre,bx,by,bz,vmp) + +end subroutine apex_sub +!----------------------------------------------------------------------- +subroutine linapx(gdlat,glon,alt,aht,alat,alon,xmag,ymag,zmag,fmag) +! +! Input Args: +! + real(r8),intent(inout) :: & ! These may be changed by convrt, depending on iflag + gdlat, & ! latitude of starting point (deg) + glon, & ! longitude of starting point (deg) + alt ! height of starting point (km) +! +! Output Args: +! + real(r8),intent(out) :: & + aht, & ! (Apex height+req)/req, where req is equatorial earth radius + alat, & ! Apex latitude (deg) + alon, & ! Apex longitude (deg) + xmag, & ! North component of magnetic field at starting point + ymag, & ! East component of magnetic field at starting point + zmag, & ! Down component of magnetic field at starting point + fmag ! Magnetic field magnitude at starting point +! +! Local: +! + real(r8) :: gclat,r,singml,cgml2,rho,xlat,xlon,ht + real(r8) :: bnrth,beast,bdown,babs,y1,y2,y3 + integer :: iflag,iapx + integer,parameter :: maxs = 200 +! +! Determine step size as a function of geomagnetic dipole +! coordinates of the starting point +! + iflag = 2 ! gclat,r are returned + call convrt(iflag,gdlat,alt,gclat,r) + + singml = ctp*sin(gclat*dtr) + stp*cos(gclat*dtr)*cos((glon-elon)*dtr) + cgml2 = max(0.25_r8,1._r8-singml*singml) + ds = .06_r8*r/cgml2 - 370._r8 ! ds is in module data + + yapx = 0._r8 ! init (module data) +! +! Convert from geodetic to earth centered cartesian coordinates: +! + call gd2cart(gdlat,glon,alt,y(1),y(2),y(3)) + nstp = 0 +! +! Get magnetic field components to determine the direction for tracing field line: +! + iflag = 1 + call feldg(iflag,gdlat,glon,alt,xmag,ymag,zmag,fmag) + + sgn = sign(1._r8,-zmag) +! +! Use cartesian coordinates to get magnetic field components +! (from which gradients steer the tracing) +! +100 continue + iflag = 2 ! module data bx,by,bz,bb are returned + y1 = y(1)/re ; y2 = y(2)/re ; y3 = y(3)/re + call feldg(iflag,y1,y2,y3,bx,by,bz,bb) + nstp = nstp + 1 +! +! Quit if too many steps. +! + if (nstp >= maxs) then + rho = sqrt(y(1)*y(1) + y(2)*y(2)) + iflag = 3 ! xlat and ht are returned + call convrt(iflag,xlat,ht,rho,y(3)) + xlon = rtd*atan2(y(2),y(1)) + iflag = 1 + call feldg(iflag,xlat,xlon,ht,bnrth,beast,bdown,babs) + call dipapx(xlat,xlon,ht,bnrth,beast,bdown,aht,alon) + alat = -sgn*rtd*acos(sqrt(1._r8/aht)) + return + endif +! +! Find next point using adams algorithm after 7 points +! + call itrace(iapx) + if (iapx == 1) goto 100 +! +! Maximum radius just passed. Find apex coords +! + call fndapx(alt,zmag,aht,alat,alon) + +end subroutine linapx +!----------------------------------------------------------------------- +subroutine convrt(iflag,gdlat,alt,x1,x2) +! +! Convert space point from geodetic to geocentric or vice versa. +! +! iflag = 1: Convert from geodetic to cylindrical +! Input: gdlat = Geodetic latitude (deg) +! alt = Altitude above reference ellipsoid (km) +! Output: x1 = Distance from Earth's rotation axis (km) +! x2 = Distance above (north of) Earth's equatorial plane (km) +! +! iflag = 2: Convert from geodetic to geocentric spherical +! Input: gdlat = Geodetic latitude (deg) +! alt = Altitude above reference ellipsoid (km) +! Output: x1 = Geocentric latitude (deg) +! x2 = Geocentric distance (km) +! +! iflag = 3: Convert from cylindrical to geodetic +! Input: x1 = Distance from Earth's rotation axis (km) +! x2 = Distance from Earth's equatorial plane (km) +! Output: gdlat = Geodetic latitude (deg) +! alt = Altitude above reference ellipsoid (km) +! +! iflag = 4: Convert from geocentric spherical to geodetic +! Input: x1 = Geocentric latitude (deg) +! x2 = Geocentric distance (km) +! Output: gdlat = Geodetic latitude (deg) +! alt = Altitude above reference ellipsoid (km) +! +! Args: + integer,intent(in) :: iflag + real(r8),intent(inout) :: gdlat,alt + real(r8),intent(inout) :: x1,x2 +! +! Local: + real(r8) :: sinlat,coslat,d,z,rho,rkm,scl,gclat,ri,a2,a4,a6,a8,& + ccl,s2cl,c2cl,s4cl,c4cl,s8cl,s6cl,dltcl,sgl + real(r8),parameter :: & + fltnvrs = 298.25_r8 , & + e2=(2._r8-1._r8/fltnvrs)/fltnvrs , & + e4=e2*e2, e6=e4*e2, e8=e4*e4 , & + ome2req = (1._r8-e2)*req , & + A21 = (512._r8*E2 + 128._r8*E4 + 60._r8*E6 + 35._r8*E8)/1024._r8 , & + A22 = ( E6 + E8)/ 32._r8 , & + A23 = -3._r8*( 4._r8*E6 + 3._r8*E8)/ 256._r8 , & + A41 = -( 64._r8*E4 + 48._r8*E6 + 35._r8*E8)/1024._r8 , & + A42 = ( 4._r8*E4 + 2._r8*E6 + E8)/ 16._r8 , & + A43 = 15._r8*E8 / 256._r8 , & + A44 = -E8 / 16._r8 , & + A61 = 3._r8*( 4._r8*E6 + 5._r8*E8)/1024._r8 , & + A62 = -3._r8*( E6 + E8)/ 32._r8 , & + A63 = 35._r8*( 4._r8*E6 + 3._r8*E8)/ 768._r8 , & + A81 = -5._r8*E8 /2048._r8 , & + A82 = 64._r8*E8 /2048._r8 , & + A83 = -252._r8*E8 /2048._r8 , & + A84 = 320._r8*E8 /2048._r8 + + if (iflag < 3) then ! geodetic to geocentric +! +! Compute rho,z + sinlat = sin(gdlat*dtr) + coslat = sqrt(1._r8-sinlat*sinlat) + d = sqrt(1._r8-e2*sinlat*sinlat) + z = (alt+ome2req/d)*sinlat + rho = (alt+req/d)*coslat + x1 = rho + x2 = z + if (iflag == 1) return +! +! Compute gclat,rkm + rkm = sqrt(z*z+rho*rho) + gclat = rtd*atan2(z,rho) + x1 = gclat + x2 = rkm + return ! iflag == 2 + endif ! iflag < 3 +! +! Geocentric to geodetic: + if (iflag == 3) then + rho = x1 + z = x2 + rkm = sqrt(z*z+rho*rho) + scl = z/rkm + gclat = asin(scl)*rtd + elseif (iflag == 4) then + gclat = x1 + rkm = x2 + scl = sin(gclat*dtr) + else + return + endif +! +! iflag == 3 or 4: +! + ri = req/rkm + a2 = ri*(a21+ri*(a22+ri* a23)) + a4 = ri*(a41+ri*(a42+ri*(a43+ri*a44))) + a6 = ri*(a61+ri*(a62+ri* a63)) + a8 = ri*(a81+ri*(a82+ri*(a83+ri*a84))) + ccl = sqrt(1._r8-scl*scl) + s2cl = 2._r8*scl*ccL + c2cl = 2._r8*ccl*ccl-1._r8 + s4cl = 2._r8*s2cl*c2cl + c4cl = 2._r8*c2cl*c2cl-1._r8 + s8cl = 2._r8*s4cl*c4cl + s6cl = s2cl*c4cl+c2cl*s4cl + dltcl = s2cl*a2+s4cl*a4+s6cl*a6+s8cl*a8 + gdlat = dltcl*rtd+gclat + sgl = sin(gdlat*dtr) + alt = rkm*cos(dltcl)-req*sqrt(1._r8-e2*sgl*sgl) + +end subroutine convrt +!----------------------------------------------------------------------- +subroutine gd2cart(gdlat,glon,alt,x,y,z) +! +! Arg: + real(r8),intent(inout) :: gdlat,alt,z + real(r8),intent(in) :: glon + real(r8),intent(out) :: x,y +! +! Local: + real(r8) :: ang,rho + integer :: iflag + + iflag = 1 ! Convert from geodetic to cylindrical (rho,z are output) + call convrt(iflag,gdlat,alt,rho,z) + + ang = glon*dtr + x = rho*cos(ang) + y = rho*sin(ang) + +end subroutine gd2cart +!----------------------------------------------------------------------- +subroutine feldg(iflag,glat,glon,alt,bnrth,beast,bdown,babs) +! +! Compute the DGRF/IGRF field components at the point glat,glon,alt. +! cofrm must be called to establish coefficients for correct date +! prior to calling FELDG. +! +! iflag = 1: +! Inputs: +! glat = Latitude of point (deg) +! glon = Longitude of point (deg) +! alt = Height of point (km) +! Outputs: +! bnrth = North component of field vector (Gauss) +! beast = East component of field vector (Gauss) +! bdown = Downward component of field vector (Gauss) +! babs = Magnitude of field vector (Gauss) +! +! iflag = 2: +! Inputs: +! glat = x coordinate (in units of earth radii 6371.2 km) +! glon = y coordinate (in units of earth radii 6371.2 km) +! alt = z coordinate (in units of earth radii 6371.2 km) +! Outputs: +! bnrth = x component of field vector (Gauss) +! beast = y component of field vector (Gauss) +! bdown = z component of field vector (Gauss) +! babs = Magnitude of field vector (Gauss) +! +! iflag = 3: +! Inputs: +! glat = x coordinate (in units of earth radii 6371.2 km) +! glon = y coordinate (in units of earth radii 6371.2 km) +! alt = z coordinate (in units of earth radii 6371.2 km) +! Outputs: +! bnrth = Dummy variable +! beast = Dummy variable +! babs = Legacy code had "Dummy variable" here, but its +! set at the end if iflag==3. +! +! Args: + integer,intent(in) :: iflag + real(r8),intent(in) :: glon + real(r8),intent(inout) :: glat + real(r8),intent(inout) :: alt + real(r8),intent(out) :: bnrth,beast,bdown,babs +! +! Local: + integer :: i,is,ihmax,last,imax,mk,k,ih,m,il,ihm,ilm + real(r8) :: rlat,ct,st,rlon,cp,sp,xxx,yyy,zzz,rq,f,x,y,z + real(r8) :: xi(3),h(ncoef),g(ncoef) + real(r8) :: s,t,bxxx,byyy,bzzz,brho + + if (iflag == 1) then + is = 1 + rlat = glat*dtr + ct = sin(rlat) + st = cos(rlat) + rlon = glon*dtr + cp = cos(rlon) + sp = sin(rlon) + call gd2cart(glat,glon,alt,xxx,yyy,zzz) + xxx = xxx/re + yyy = yyy/re + zzz = zzz/re + else + is = 2 + xxx = glat + yyy = glon + zzz = alt + endif + rq = 1._r8/(xxx**2+yyy**2+zzz**2) + xi(1) = xxx*rq + xi(2) = yyy*rq + xi(3) = zzz*rq + ihmax = nmax*nmax+1 + last = ihmax+nmax+nmax + imax = nmax+nmax-1 +! +! Legacy code checks here to see if iflag or last call to cofrm have changed. +! For now, just do it anyway: +! + if (iflag /= 3) then + do i=1,last + g(i) = gb(i) ! gb is module data from cofrm + enddo + else + do i=1,last + g(i) = gv(i) ! gv is module data from cofrm + enddo + endif + + do i=ihmax,last + h(i) = g(i) + enddo + + mk = 3 + if (imax == 1) mk = 1 + + do k=1,mk,2 + i = imax + ih = ihmax + +100 continue + il = ih-i + f = 2._r8/dble(i-k+2) + x = xi(1)*f + y = xi(2)*f + z = xi(3)*(f+f) + + i = i-2 + if (i < 1) then + h(il) = g(il) + z*h(ih) + 2._r8*(x*h(ih+1)+y*h(ih+2)) + elseif (i == 1) then + h(il+2) = g(il+2) + z*h(ih+2) + x*h(ih+4) - y*(h(ih+3)+h(ih)) + h(il+1) = g(il+1) + z*h(ih+1) + y*h(ih+4) + x*(h(ih+3)-h(ih)) + h(il) = g(il) + z*h(ih) + 2._r8*(x*h(ih+1)+y*h(ih+2)) + else + do m=3,i,2 + ihm = ih+m + ilm = il+m + h(ilm+1) = g(ilm+1)+ z*h(ihm+1) + x*(h(ihm+3)-h(ihm-1))- & + y*(h(ihm+2)+h(ihm-2)) + h(ilm) = g(ilm) + z*h(ihm) + x*(h(ihm+2)-h(ihm-2))+ & + y*(h(ihm+3)+h(ihm-1)) + enddo + h(il+2) = g(il+2) + z*h(ih+2) + x*h(ih+4) - y*(h(ih+3)+h(ih)) + h(il+1) = g(il+1) + z*h(ih+1) + y*h(ih+4) + x*(h(ih+3)-h(ih)) + h(il) = g(il) + z*h(ih) + 2._r8*(x*h(ih+1)+y*h(ih+2)) + endif + + ih = il + if (i >= k) goto 100 + enddo ! k=1,mk,2 + + s = .5_r8*h(1)+2._r8*(h(2)*xi(3)+h(3)*xi(1)+h(4)*xi(2)) + t = (rq+rq)*sqrt(rq) + bxxx = t*(h(3)-s*xxx) + byyy = t*(h(4)-s*yyy) + bzzz = t*(h(2)-s*zzz) + babs = sqrt(bxxx**2+byyy**2+bzzz**2) + if (is .eq. 1) then ! (convert back to geodetic) + beast = byyy*cp-bxxx*sp + brho = byyy*sp+bxxx*cp + bnrth = bzzz*st-brho*ct + bdown = -bzzz*ct-brho*st + elseif (is .eq. 2) then ! (leave in earth centered cartesian) + bnrth = bxxx + beast = byyy + bdown = bzzz + endif +! +! Magnetic potential computation makes use of the fact that the +! calculation of V is identical to that for r*Br, if coefficients +! in the latter calculation have been divided by (n+1) (coefficients +! GV). Factor .1 converts km to m and gauss to tesla. +! + if (iflag == 3) babs = (bxxx*xxx + byyy*yyy + bzzz*zzz)*re*.1_r8 + +end subroutine feldg +!----------------------------------------------------------------------- +subroutine dipapx(gdlat,gdlon,alt,bnorth,beast,bdown,a,alon) +! +! Compute a, alon from local magnetic field using dipole and spherical approx. +! Reference from legacy code: 940501 A. D. Richmond +! +! Input: +! gdlat = geodetic latitude, degrees +! gdlon = geodetic longitude, degrees +! alt = altitude, km +! bnorth = geodetic northward magnetic field component (any units) +! beast = eastward magnetic field component +! bdown = geodetic downward magnetic field component +! Output: +! a = apex radius, 1 + h_A/R_eq +! alon = apex longitude, degrees +! +! Algorithm: +! Use spherical coordinates. +! Let GP be geographic pole. +! Let GM be geomagnetic pole (colatitude COLAT, east longitude ELON). +! Let G be point at GDLAT,GDLON. +! Let E be point on sphere below apex of dipolar field line passing through G. +! Let TD be dipole colatitude of point G, found by applying dipole formula +! for dip angle to actual dip angle. +! Let B be Pi plus local declination angle. B is in the direction +! from G to E. +! Let TG be colatitude of G. +! Let ANG be longitude angle from GM to G. +! Let TE be colatitude of E. +! Let TP be colatitude of GM. +! Let A be longitude angle from G to E. +! Let APANG = A + ANG +! Let PA be geomagnetic longitude, i.e., Pi minus angle measured +! counterclockwise from arc GM-E to arc GM-GP. +! Let TF be arc length between GM and E. +! Then, using notation C=cos, S=sin, COT=cot, spherical-trigonometry formulas +! for the functions of the angles are as shown below. Note: STFCPA, +! STFSPA are sin(TF) times cos(PA), sin(PA), respectively. +! + real(r8),intent(in) :: gdlat,gdlon,alt,bnorth,beast,bdown + real(r8),intent(out) :: a,alon +! +! Local: + real(r8) :: bhor,std,ctd,sb,cb,ctg,stg,ang,sang,cang,cte,ste,sa,ca, & + cottd,capang,sapang,stfcpa,stfspa,ha,r + + bhor = sqrt(bnorth*bnorth + beast*beast) + if (bhor == 0._r8) then + alon = 0._r8 + a = 1.e34_r8 + return + endif + + cottd = bdown*.5_r8/bhor + std = 1._r8/sqrt(1._r8+cottd*cottd) + ctd = cottd*std + sb = -beast/bhor + cb = -bnorth/bhor + ctg = sin(gdlat*dtr) + stg = cos(gdlat*dtr) + ang = (gdlon-elon)*dtr + sang = sin(ang) + cang = cos(ang) + cte = ctg*std + stg*ctd*cb + ste = sqrt(1._r8 - cte*cte) + sa = sb*ctd/ste + ca = (std*stg - ctd*ctg*cb)/ste + capang = ca*cang - sa*sang + sapang = ca*sang + sa*cang + stfcpa = ste*ctp*capang - cte*stp + stfspa = sapang*ste + alon = atan2(stfspa,stfcpa)*rtd + r = alt + re + ha = alt + r*cottd*cottd + a = 1._r8 + ha/req + +end subroutine dipapx +!----------------------------------------------------------------------- +subroutine itrace(iapx) + save +! +! Uses 4-point ADAMS formula after initialization. +! First 7 iterations advance point by 3 steps. +! +! y(3), yp(3), yapx(3,3), sgn and nstp are in module data +! yploc(3,4) is local +! +! Arg: + integer,intent(out) :: iapx +! +! Local: + integer :: i,j + real(r8) :: yploc(3,4) ! local yp (i.e., not module data yp) + real(r8) :: term,d2,d6,d12,d24,rc,rp + + iapx = 1 +! +! Field line is defined by the following differential equations +! in cartesian coordinates. +! (yapx,yp,y are module data) +! + yploc(1,4) = sgn*bx/bb + yploc(2,4) = sgn*by/bb + yploc(3,4) = sgn*bz/bb + + if (nstp > 7) then + do i=1,3 + yapx(i,1) = yapx(i,2) + yapx(i,2) = y(i) + yp(i) = y(i) + term = 55._r8*yploc(i,4)-59._r8*yploc(i,3)+37._r8*yploc(i,2)-9._r8*yploc(i,1) + y(i) = yp(i) + d24*term + yapx(i,3) = y(i) + do j=1,3 + yploc(i,j) = yploc(i,j+1) + enddo + enddo + rc = rdus ( y(1), y(2), y(3)) + rp = rdus (yp(1), yp(2), yp(3)) + if (rc < rp) iapx=2 + return + endif + + do i=1,3 + select case (nstp) + case (1) + d2 = ds/2._r8 + d6 = ds/6._r8 + d12 = ds/12._r8 + d24 = ds/24._r8 + yploc(i,1)= yploc(i,4) + yp(i) = y(i) + yapx(i,1) = y(i) + y(i) = yp(i) + ds*yploc(i,1) + case (2) + yploc(i,2) = yploc(i,4) + y(i) = yp(i) + d2*(yploc(i,2)+yploc(i,1)) + case (3) + y(i) = yp(i) + d6*(2._r8*yploc(i,4)+yploc(i,2)+3._r8*yploc(i,1)) + case (4) + yploc(i,2) = yploc(i,4) + yapx(i,2) = y(i) + yp(i) = y(i) + y(i) = yp(i) + d2*(3._r8*yploc(i,2)-yploc(i,1)) + case (5) + y(i) = yp(i) + d12*(5._r8*yploc(i,4)+8._r8*yploc(i,2)-yploc(i,1)) + case (6) + yploc(i,3) = yploc(i,4) + yp(i) = y(i) + yapx(i,3) = y(i) + y(i) = yp(i) + d12*(23._r8*yploc(i,3)-16._r8*yploc(i,2)+5._r8*yploc(i,1)) + case (7) + yapx(i,1) = yapx(i,2) + yapx(i,2) = yapx(i,3) + y(i) = yp(i) + d24*(9._r8*yploc(i,4)+19._r8*yploc(i,3)-5._r8*yploc(i,2)+yploc(i,1)) + yapx(i,3) = y(i) + case default + write(iulog,"('>>> itrace: unresolved case nstp=',i4)") nstp + call endrun( 'itrace' ) + end select + enddo +! +! Signal if apex passed: +! + if (nstp == 6 .or. nstp == 7) then + rc = rdus( yapx(1,3), yapx(2,3), yapx(3,3)) + rp = rdus( yapx(1,2), yapx(2,2), yapx(3,2)) + if (rc < rp) iapx=2 + endif + +end subroutine itrace +!----------------------------------------------------------------------- +real(r8) function rdus(d,e,f) + real(r8),intent(in) :: d,e,f + rdus = sqrt(d**2 + e**2 + f**2) +end function rdus +!----------------------------------------------------------------------- +subroutine fndapx(alt,zmag,a,alat,alon) +! +! Find apex coords once tracing has signalled that the apex has been passed. +! +! Args: + real(r8),intent(in) :: alt,zmag + real(r8),intent(out) :: a,alat,alon +! +! Local: + integer :: i,iflag_convrt, iflag_feldg + real(r8) :: z(3),ht(3),yloc(3),gdlt,gdln,x,ydum,f,rho,xinter,rasq,xlon,ang,& + cang,sang,r,cte,ste,stfcpa,stfspa +! +! Get geodetic field components. +! + iflag_feldg = 1 + iflag_convrt = 3 + do i=1,3 + rho = sqrt(yapx(1,i)**2+yapx(2,i)**2) + call convrt(iflag_convrt,gdlt,ht(i),rho,yapx(3,i)) + gdln = rtd*atan2(yapx(2,i),yapx(1,i)) + call feldg(iflag_feldg,gdlt,gdln,ht(i),x,ydum,z(i),f) + enddo +! +! Find cartesian coordinates at dip equator by interpolation +! + do i=1,3 + call fint(z(1),z(2),z(3),yapx(i,1),yapx(i,2),yapx(i,3),0._r8,yloc(i)) + enddo +! +! Find apex height by interpolation +! + call fint(z(1),z(2),z(3),ht(1),ht(2),ht(3),0._r8,xinter) +! +! Ensure that XINTER is not less than original starting altitude: + xinter = max(alt,xinter) + a = (req+xinter)/req +! +! Find apex coordinates , giving alat sign of dip at starting point. +! Alon is the value of the geomagnetic longitude at the apex. +! + if (a < 1._r8) then + write(iulog,"('>>> fndapx: a=',e12.4,' < 1.')") a + call endrun( 'fndapx' ) + endif + + rasq = rtd*acos(sqrt(1._r8/a)) + alat = sign(rasq,zmag) +! +! Algorithm for ALON: +! Use spherical coordinates. +! Let GP be geographic pole. +! Let GM be geomagnetic pole (colatitude COLAT, east longitude ELON). +! Let XLON be longitude of apex. +! Let TE be colatitude of apex. +! Let ANG be longitude angle from GM to apex. +! Let TP be colatitude of GM. +! Let TF be arc length between GM and apex. +! Let PA = ALON be geomagnetic longitude, i.e., Pi minus angle measured +! counterclockwise from arc GM-apex to arc GM-GP. +! Then, using notation C=cos, S=sin, spherical-trigonometry formulas +! for the functions of the angles are as shown below. Note: STFCPA, +! STFSPA are sin(TF) times cos(PA), sin(PA), respectively. +! + xlon = atan2(yloc(2),yloc(1)) + ang = xlon-elon*dtr + cang = cos(ang) + sang = sin(ang) + r = sqrt(yloc(1)**2+yloc(2)**2+yloc(3)**2) + cte = yloc(3)/r + ste = sqrt(1._r8-cte*cte) + stfcpa = ste*ctp*cang - cte*stp + stfspa = sang*ste + alon = atan2(stfspa,stfcpa)*rtd + +end subroutine fndapx +!----------------------------------------------------------------------- +subroutine fint(a1,a2,a3,a4,a5,a6,a7,result) +! +! Second degree interpolation +! +! Args: + real(r8),intent(in) :: a1,a2,a3,a4,a5,a6,a7 + real(r8),intent(out) :: result + + result = ((a2-a3)*(a7-a2)*(a7-a3)*a4-(a1-a3)*(a7-a1)*(a7-a3)*a5+ & + (a1-a2)*(a7-a1)*(a7-a2)*a6)/((a1-a2)*(a1-a3)*(a2-a3)) + +end subroutine fint +!----------------------------------------------------------------------- +subroutine gm2gc(gmlat,gmlon,gclat,gclon) +! +! Args: + real(r8),intent(in) :: gmlat,gmlon + real(r8),intent(out) :: gclat,gclon +! +! Local: + real(r8) :: stm,ctm,ctc + + stm = cos(gmlat*dtr) + ctm = sin(gmlat*dtr) + ctc = ctp*ctm - stp*stm*cos(gmlon*dtr) ! ctp,stp are module data + ctc = min(ctc,1._r8) + ctc = max(ctc,-1._r8) + gclat = asin(ctc)*rtd + gclon = atan2(stp*stm*sin(gmlon*dtr),ctm-ctp*ctc) +! +! elon is in module data, and was set by dypol (called from apex_mka) +! + gclon = gclon*rtd + elon + if (gclon < -180._r8) gclon = gclon + 360._r8 + +end subroutine gm2gc +!----------------------------------------------------------------------- +subroutine intrp(glat,glon,alt, gplat,gplon,gpalt, nlat,nlon,nalt, & + fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh ,dfydh ,dfzdh ,dfvdh, ier) +! +! Args: +! + real(r8),intent(in) :: glat,glon,alt + integer,intent(in) :: nlat,nlon,nalt + real(r8),intent(in) :: gplat(nlat),gplon(nlon),gpalt(nalt) + real(r8),intent(out) :: & + fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln, & + dfxdh ,dfydh ,dfzdh ,dfvdh + integer,intent(out) :: ier +! +! Local: +! + integer :: i,j,k,i0,j0,k0 + real(r8) :: glonloc,xi,dlon,yj,dlat,hti,diht,zk,fac,omfac + real(r8) :: dfxdn,dfxde,dfxdd, & + dfydn,dfyde,dfydd, & + dfzdn,dfzde,dfzdd, & + dfvdn,dfvde,dfvdd, & + dmf,dmdfdn,dmdfde,dmdfdd + + ier = 0 + glonloc = glon + if (glonloc < gplon(1)) glonloc = glonloc + 360._r8 + if (glonloc > gplon(nlon)) glonloc = glonloc - 360._r8 +! + i0 = 0 + do i=1,nlat-1 + if (glat >= gplat(i).and.glat <= gplat(i+1)) then + i0 = i + dlat = gplat(i+1)-gplat(i) + xi = (glat - gplat(i)) / dlat + exit + endif + enddo + if (i0==0) then + write(iulog,"('>>> intrp: could not bracket glat=',f9.3,' in gplat=',/,(6f9.2))") & + glat,gplat + ier = 1 + return + endif + + j0 = 0 + do j=1,nlon-1 + if (glon >= gplon(j).and.glon <= gplon(j+1)) then + j0 = j + dlon = gplon(j+1)-gplon(j) + yj = (glon - gplon(j)) / dlon + exit + endif + enddo + if (j0==0) then + write(iulog,"('>>> intrp: could not bracket glon=',f9.3,' in gplon=',/,(6f9.2))") & + glon,gplon + ier = 1 + return + endif + + k0 = 0 + do k=1,nalt-1 + if (alt >= gpalt(k).and.alt <= gpalt(k+1)) then + k0 = k + hti = re/(re+alt) + diht = re/(re+gpalt(k+1)) - re/(re+gpalt(k)) + zk = (hti - re/(re+gpalt(k))) / diht + exit + endif + enddo + if (k0==0) then + write(iulog,"('>>> intrp: could not bracket alt=',f12.3,' in gpalt=',/,(6f12.2))") & + alt,gpalt + ier = 1 + return + endif + + call trilin(xarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,fx,dfxdn,dfxde,dfxdd) + dfxdth = -dfxdn*rtd/dlat + dfxdln = dfxde*rtd/dlon + dfxdh = -hti*hti*dfxdd/(re*diht) + + call trilin(yarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,fy,dfydn,dfyde,dfydd) + dfydth = -dfydn*rtd/dlat + dfydln = dfyde*rtd/dlon + dfydh = -hti*hti*dfydd/(re*diht) + + call trilin(zarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,fz,dfzdn,dfzde,dfzdd) + dfzdth = -dfzdn*rtd/dlat + dfzdln = dfzde*rtd/dlon + dfzdh = -hti*hti*dfzdd/(re*diht) + + call trilin(varray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,fv,dfvdn,dfvde,dfvdd) + dfvdth = -dfvdn*rtd/dlat + dfvdln = dfvde*rtd/dlon + dfvdh = -hti*hti*dfvdd/(re*diht) + + if (nlat < 3) return +! +! Improve calculation of longitudinal derivatives near poles +! + if (glat < dlat-90._r8) then + fac = .5_r8*xi + omfac = 1._r8 - fac + xi = xi - 1._r8 + i0 = i0 + 1 + call trilin (xarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfxdln = dfxdln*omfac + fac*dmdfde*rtd/dlon + call trilin (yarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfydln = dfydln*omfac + fac*dmdfde*rtd/dlon + call trilin (varray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfvdln = dfvdln*omfac + fac*dmdfde*rtd/dlon + endif + + if (glat > 90._r8-dlat) then + fac = .5_r8*(1._r8-xi) + omfac = 1._r8 - fac + xi = xi + 1._r8 + i0 = i0 - 1 + call trilin (xarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfxdln = dfxdln*omfac + fac*dmdfde*rtd/dlon + call trilin (yarray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfydln = dfydln*omfac + fac*dmdfde*rtd/dlon + call trilin (varray(i0:i0+1,j0:j0+1,k0:k0+1),xi,yj,zk,dmf,dmdfdn,dmdfde,dmdfdd) + dfvdln = dfvdln*omfac + fac*dmdfde*rtd/dlon + endif + +end subroutine intrp +!----------------------------------------------------------------------- +subroutine trilin(u,xi,yj,zk,fu,dfudx,dfudy,dfudz) +! +! Args: + real(r8),intent(in) :: & + u(1:2,1:2,1:2), & ! u(1,1,1) is address of lower corner of interpolation box + xi, & ! fractional distance across box in x direction + yj, & ! fractional distance across box in y direction + zk ! fractional distance across box in z direction + real(r8),intent(out) :: & + fu, & ! interpolated value of u + dfudx, & ! interpolated derivative of u with respect to i (x direction) + dfudy, & ! interpolated derivative of u with respect to j (y direction) + dfudz ! interpolated derivative of u with respect to k (z direction) +! +! Local: + real(r8) :: omxi,omyj,omzk + +! write(iulog,"('Enter trilin: xi,yj,zk=',3e12.4)") xi,yj,zk +! write(iulog,"('Enter trilin: u(1,1,1),u(1,2,1),u(1,1,2),u(1,2,2)=',4e12.4)") & +! u(1,1,1),u(1,2,1),u(1,1,2),u(1,2,2) +! write(iulog,"('Enter trilin: u(2,1,1),u(2,2,1),u(2,1,2),u(2,2,2)=',4e12.4)") & +! u(2,1,1),u(2,2,1),u(2,1,2),u(2,2,2) + + omxi = 1._r8 - xi + omyj = 1._r8 - yj + omzk = 1._r8 - zk + + fu = u(1,1,1)*omxi*omyj*omzk & + + u(2,1,1)*xi*omyj*omzk & + + u(1,2,1)*omxi*yj*omzk & + + u(1,1,2)*omxi*omyj*zk & + + u(2,2,1)*xi*yj*omzk & + + u(2,1,2)*xi*omyj*zk & + + u(1,2,2)*omxi*yj*zk & + + u(2,2,2)*xi*yj*zk + + dfudx = (u(2,1,1)-u(1,1,1))*omyj*omzk & + + (u(2,2,1)-u(1,2,1))*yj*omzk & + + (u(2,1,2)-u(1,1,2))*omyj*zk & + + (u(2,2,2)-u(1,2,2))*yj*zk + dfudy = (u(1,2,1)-u(1,1,1))*omxi*omzk & + + (u(2,2,1)-u(2,1,1))*xi*omzk & + + (u(1,2,2)-u(1,1,2))*omxi*zk & + + (u(2,2,2)-u(2,1,2))*xi*zk + dfudz = (u(1,1,2)-u(1,1,1))*omxi*omyj & + + (u(2,1,2)-u(2,1,1))*xi*omyj & + + (u(1,2,2)-u(1,2,1))*omxi*yj & + + (u(2,2,2)-u(2,2,1))*xi*yj + +end subroutine trilin +!----------------------------------------------------------------------- +subroutine adpl(glat,glon,cth,sth,fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth,dfxdln,dfydln,dfzdln,dfvdln) +! +! Add-back of pseudodipole component to x,y,z,v and their derivatives. +! +! Args: + real(r8),intent(in) :: glat,glon + real(r8),intent(out) :: cth,sth + real(r8),intent(inout) :: & + fx,fy,fz,fv, & + dfxdth,dfydth,dfzdth,dfvdth, & + dfxdln,dfydln,dfzdln,dfvdln +! +! Local: + real(r8) :: cph,sph,ctm + + cph = cos((glon-elon)*dtr) + sph = sin((glon-elon)*dtr) + cth = sin(glat*dtr) + sth = cos(glat*dtr) + ctm = ctp*cth + stp*sth*cph + fx = fx + sth*ctp*cph - cth*stp + fy = fy + sth*sph + fz = fz + ctm + fv = fv - ctm + + dfxdth = dfxdth + ctp*cth*cph + stp*sth + dfydth = dfydth + cth*sph + dfzdth = dfzdth - ctp*sth + stp*cth*cph + dfvdth = dfvdth + ctp*sth - stp*cth*cph + + dfxdln = dfxdln - ctp*sth*sph + dfydln = dfydln + sth*cph + dfzdln = dfzdln - stp*sth*sph + dfvdln = dfvdln + stp*sth*sph + +end subroutine adpl +!----------------------------------------------------------------------- +subroutine setmiss(xmiss,xlatm,alon,vmp,b,bmag,be3,sim,si,f,d,w, & + bhat,d1,d2,d3,e1,e2,e3,f1,f2) +! +! Args: + real(r8),intent(in) :: xmiss + real(r8),intent(out) :: xlatm,alon,vmp,bmag,be3,sim,si,f,d,w + real(r8),dimension(3),intent(out) :: bhat,d1,d2,d3,e1,e2,e3,b + real(r8),dimension(2),intent(out) :: f1,f2 + + xlatm = xmiss + alon = xmiss + vmp = xmiss + bmag = xmiss + be3 = xmiss + sim = xmiss + si = xmiss + f = xmiss + d = xmiss + w = xmiss + bhat = xmiss + d1 = xmiss + d2 = xmiss + d3 = xmiss + e1 = xmiss + e2 = xmiss + e3 = xmiss + b = xmiss + f1 = xmiss + f2 = xmiss + +end subroutine setmiss +!----------------------------------------------------------------------- +subroutine cofrm(date) + implicit none +! +! Input arg: + real(r8),intent(in) :: date +! +! Local: + integer :: m,n,i,l,ll,lm,nmx,nc,kmx,k,nn + real(r8) :: t,one,tc,f,f0 + + integer :: ngh ! = n1*ncn1 + n2*ncn2 + 1 + real(r8) :: gh(n1*ncn1 + n2*ncn2 + 1) + + real(r8),parameter :: alt = 0._r8 + integer, parameter :: isv=0 + + ngh = n1*ncn1 + n2*ncn2 + 1 ! not sure why the extra +1 + + if (date < apex_beg_yr .or. date > apex_end_yr) then + write(iulog,"('>>> cofrm: date=',f8.2,' Date must be >= ',I4,' and <= ',I4)") date,apex_beg_yr,apex_end_yr+5 + call endrun( 'cofrm' ) + endif + if (date > apex_end_yr-5) then + write(iulog,"('>>> WARNING cofrm:')") + write(iulog,"(/,' This version of IGRF is intended for use up to ')") + write(iulog,"(' 2020. Values for ',f9.3,' will be computed but')") date + write(iulog,"(' may be of reduced accuracy.',/)") + endif +! +! Set gh from g1,g2: +! + do n=1,ncn1 + i = (n-1)*n1 + gh(i+1:i+n1) = g1(:,n) +! write(iulog,"('cofrm: n=',i3,' i+1:i+n1=',i4,':',i4)") n,i+1,i+n1 + enddo + do n=1,ncn2 + i = n1*ncn1 + (n-1)*n2 + gh(i+1:i+n2) = g2(:,n) +! write(iulog,"('cofrm: n=',i3,' i+1:i+n2=',i4,':',i4)") n,i+1,i+n2 + enddo + gh(ngh) = 0._r8 ! not sure why gh is dimensioned with the extra element, so set it to 0. + + if (date < apex_end_yr-10) then + t = 0.2_r8*(date - year1) + ll = t + one = ll + t = t - one + if (date < year2-5) then + nmx = 10 + nc = nmx*(nmx+2) + ll = nc*ll + kmx = (nmx+1)*(nmx+2)/2 + else + nmx = 13 + nc = nmx*(nmx+2) + ll = 0.2_r8*(date - (year2-5)) + ll = 120*19 + nc*ll + kmx = (nmx+1)*(nmx+2)/2 + endif + tc = 1.0_r8 - t + if (isv.eq.1) then + tc = -0.2_r8 + t = 0.2_r8 + endif + else ! date >= apex_end_yr-10 + t = date - (apex_end_yr-10) + tc = 1.0_r8 + if (isv.eq.1) then + t = 1.0_r8 + tc = 0.0_r8 + end if + ll = n1*ncn1 + n2*(ncn2-2) ! corresponds to apex_end_yr-10 + nmx = 13 + nc = nmx*(nmx+2) + kmx = (nmx+1)*(nmx+2)/2 + endif ! date < apex_end_yr-10 + l = 1 + m = 1 + n = 0 +! +! Set outputs gb(ncoef) and gv(ncoef) +! These are module data above. +! + gb(1) = 0._r8 + gv(1) = 0._r8 + f0 = -1.e-5_r8 + do k=2,kmx + if (n < m) then + m = 0 + n = n+1 + endif ! n < m + lm = ll + l + if (m == 0) f0 = f0 * dble(n)/2._r8 + if (m == 0) f = f0 / sqrt(2.0_r8) + nn = n+1 + + if (m /= 0) then + f = f / sqrt(dble(n-m+1) / dble(n+m) ) + gb(l+1) = (tc*gh(lm) + t*gh(lm+nc))* f + else + gb(l+1) = (tc*gh(lm) + t*gh(lm+nc))* f0 + endif + gv(l+1) = gb(l+1)/dble(nn) + if (m /= 0) then + gb(l+2) = (tc*gh(lm+1) + t*gh(lm+nc+1))*f + gv(l+2) = gb(l+2)/dble(nn) + l = l+2 + else + l = l+1 + endif + m = m+1 + enddo + +! write(iulog,"('cofrm: ncoef=',i4,' gb=',/,(6f12.3))") ncoef,gb +! write(iulog,"('cofrm: ncoef=',i4,' gv=',/,(6f12.3))") ncoef,gv + +end subroutine cofrm +!----------------------------------------------------------------------- +subroutine apex_subsol(iyr,iday,ihr,imn,sec,sbsllat,sbsllon) +! +! Find subsolar geographic latitude and longitude given the +! date and time (Universal Time). +! +! This is based on formulas in Astronomical Almanac for the +! year 1996, p. C24. (U.S. Government Printing Office, +! 1994). According to the Almanac, results are good to at +! least 0.01 degree latitude and 0.025 degree longitude +! between years 1950 and 2050. Accuracy for other years has +! not been tested although the algorithm has been designed to +! accept input dates from 1601 to 2100. Every day is assumed +! to have exactly 86400 seconds; thus leap seconds that +! sometimes occur on June 30 and December 31 are ignored: +! their effect is below the accuracy threshold of the algorithm. +! +! 961026 A. D. Richmond, NCAR +! +! Input Args: + integer,intent(in) :: & + iyr, & ! Year (e.g., 1994). IYR must be in the range: 1601 to 2100. + iday, & ! Day number of year (e.g., IDAY = 32 for Feb 1) + ihr, & ! Hour of day (e.g., 13 for 13:49) + imn ! Minute of hour (e.g., 49 for 13:49) + real(r8),intent(in) :: sec ! Second and fraction after the hour/minute. +! +! Output Args: + real(r8),intent(out) :: & + sbsllat, & ! geographic latitude of subsolar point (degrees) + sbsllon ! geographic longitude of subsolar point (-180 to +180) +! +! Local: + integer,parameter :: minyear=1601, maxyear = 2100 + real(r8),parameter :: & ! Use local params for compatability w/ legacy code, + ! but probably would be ok to use module data dtr,rtd + d2r=0.0174532925199432957692369076847_r8, & + r2d=57.2957795130823208767981548147_r8 + real(r8) :: yr,l0,g0,ut,df,lf,gf,l,g,grad,n,epsilon,epsrad,alpha,delta,& + etdeg,aptime,lambda,lamrad,sinlam + integer :: nleap,ncent,nrot + + sbsllat=0._r8 ; sbsllon=0._r8 + + yr = iyr-2000 +! +! nleap (final) = number of leap days from (2000 January 1) to (IYR January 1) +! (negative if iyr is before 1997) + nleap = (iyr-1601)/4 + nleap = nleap - 99 + if (iyr <= year1) then + if (iyr < minyear) then + write(iulog,*) 'subsolr invalid before ',minyear,': input year = ',iyr + call endrun( 'subsolr' ) + endif + ncent = (iyr-minyear)/100 + ncent = 3 - ncent + nleap = nleap + ncent + endif + if (iyr > maxyear) then + write(iulog,*) 'subsolr invalid after ',maxyear,': input year = ',iyr + call endrun( 'subsolr' ) + endif +! +! L0 = Mean longitude of Sun at 12 UT on January 1 of IYR: +! L0 = 280.461 + .9856474*(365*(YR-NLEAP) + 366*NLEAP) +! - (ARBITRARY INTEGER)*360. +! = 280.461 + .9856474*(365*(YR-4*NLEAP) + (366+365*3)*NLEAP) +! - (ARBITRARY INTEGER)*360. +! = (280.461 - 360.) + (.9856474*365 - 360.)*(YR-4*NLEAP) +! + (.9856474*(366+365*3) - 4*360.)*NLEAP, +! where ARBITRARY INTEGER = YR+1. This gives: +! + l0 = -79.549_r8 + (-.238699_r8*(yr-4*nleap) + 3.08514e-2_r8*nleap) +! +! G0 = Mean anomaly at 12 UT on January 1 of IYR: +! G0 = 357.528 + .9856003*(365*(YR-NLEAP) + 366*NLEAP) +! - (ARBITRARY INTEGER)*360. +! = 357.528 + .9856003*(365*(YR-4*NLEAP) + (366+365*3)*NLEAP) +! - (ARBITRARY INTEGER)*360. +! = (357.528 - 360.) + (.9856003*365 - 360.)*(YR-4*NLEAP) +! + (.9856003*(366+365*3) - 4*360.)*NLEAP, +! where ARBITRARY INTEGER = YR+1. This gives: +! + g0 = -2.472_r8 + (-.2558905_r8*(yr-4*nleap) - 3.79617e-2_r8*nleap) +! +! Universal time in seconds: + ut = dble(ihr*3600 + imn*60) + sec +! +! Days (including fraction) since 12 UT on January 1 of IYR: + df = (ut/86400._r8 - 1.5_r8) + iday +! +! Addition to Mean longitude of Sun since January 1 of IYR: + lf = .9856474_r8*df +! +! Addition to Mean anomaly since January 1 of IYR: + gf = .9856003_r8*df +! +! Mean longitude of Sun: + l = l0 + lf +! +! Mean anomaly: + g = g0 + gf + grad = g*d2r +! +! Ecliptic longitude: + lambda = l + 1.915_r8*sin(grad) + .020_r8*sin(2._r8*grad) + lamrad = lambda*d2r + sinlam = sin(lamrad) +! +! Days (including fraction) since 12 UT on January 1 of 2000: + n = df + 365._r8*yr + dble(nleap) +! +! Obliquity of ecliptic: + epsilon = 23.439_r8 - 4.e-7_r8*n + epsrad = epsilon*d2r +! +! Right ascension: + alpha = atan2(cos(epsrad)*sinlam,cos(lamrad))*r2d +! +! Declination: + delta = asin(sin(epsrad)*sinlam)*r2d +! +! Subsolar latitude (output argument): + sbsllat = delta +! +! Equation of time (degrees): + etdeg = l - alpha + nrot = nint(etdeg/360._r8) + etdeg = etdeg - dble(360*nrot) +! +! Apparent time (degrees): +! Earth rotates one degree every 240 s. + aptime = ut/240._r8 + etdeg +! +! Subsolar longitude (output argument): + sbsllon = 180._r8 - aptime + nrot = nint(sbsllon/360._r8) + sbsllon = sbsllon - dble(360*nrot) + +end subroutine apex_subsol + +!----------------------------------------------------------------------- +subroutine solgmlon(xlat,xlon,colat,elon,mlon) +! +! Compute geomagnetic longitude of the point with geocentric spherical +! latitude and longitude of XLAT and XLON, respectively. +! 940719 A. D. Richmond, NCAR +! +! Algorithm: +! Use spherical coordinates. +! Let GP be geographic pole. +! Let GM be geomagnetic pole (colatitude COLAT, east longitude ELON). +! Let XLON be longitude of point P. +! Let TE be colatitude of point P. +! Let ANG be longitude angle from GM to P. +! Let TP be colatitude of GM. +! Let TF be arc length between GM and P. +! Let PA = MLON be geomagnetic longitude, i.e., Pi minus angle measured +! counterclockwise from arc GM-P to arc GM-GP. +! Then, using notation C=cos, S=sin, spherical-trigonometry formulas +! for the functions of the angles are as shown below. Note: STFCPA, +! STFSPA are sin(TF) times cos(PA), sin(PA), respectively. +! +! Input Args: + real(r8),intent(in) :: xlat,xlon,colat,elon +! +! Output Arg: Geomagnetic dipole longitude of the point (deg, -180. to 180.) + real(r8),intent(out) :: mlon +! +! Local: + real(r8),parameter :: & + rtod=5.72957795130823e1_r8, & + dtor=1.745329251994330e-2_r8 + real(r8) :: ctp,stp,ang,cang,sang,cte,ste,stfcpa,stfspa + + ctp = cos(colat*dtor) + stp = sqrt(1._r8 - ctp*ctp) + ang = (xlon-elon)*dtor + cang = cos(ang) + sang = sin(ang) + cte = sin(xlat*dtor) + ste = sqrt(1._r8-cte*cte) + stfcpa = ste*ctp*cang - cte*stp + stfspa = sang*ste + mlon = atan2(stfspa,stfcpa)*rtod + +end subroutine solgmlon +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +subroutine apex_magloctm (alon,sbsllat,sbsllon,clatp,polon,mlt) + ! + !----------------------------------------------------------------------- + ! Computes magnetic local time from magnetic longitude, subsolar coordinates, + ! and geomagnetic pole coordinates. + ! 950302 A. D. Richmond, NCAR + ! Algorithm: MLT is calculated from the difference of the apex longitude, + ! alon, and the geomagnetic dipole longitude of the subsolar point. + ! + ! Inputs: + ! alon = apex magnetic longitude of the point (deg) + ! sbsllat = geographic latitude of subsolar point (degrees) + ! sbsllon = geographic longitude of subsolar point (degrees) + ! clatp = Geocentric colatitude of geomagnetic dipole north pole (deg) + ! polon = East longitude of geomagnetic dipole north pole (deg) + ! + ! Output: + ! mlt (real) = magnetic local time for the apex longitude alon (hours) + ! + !----------------------------------------------------------------------- + ! + !------------------------------Arguments-------------------------------- + ! + REAL(r8) alon, sbsllat, sbsllon, clatp, polon, MLT + ! + !---------------------------Local variables----------------------------- + ! + real(r8) smlon + ! + !----------------------------------------------------------------------- + ! + call solgmlon (sbsllat,sbsllon,clatp,polon,smlon) + mlt = (alon - smlon)/15.0_r8 + 12.0_r8 + if (mlt .ge. 24.0_r8) mlt = mlt - 24.0_r8 + if (mlt .lt. 0._r8) mlt = mlt + 24.0_r8 + return +end subroutine apex_magloctm + +!----------------------------------------------------------------------- +end module apex diff --git a/src/chemistry/utils/horizontal_interpolate.F90 b/src/chemistry/utils/horizontal_interpolate.F90 new file mode 100644 index 0000000000..4021ffebae --- /dev/null +++ b/src/chemistry/utils/horizontal_interpolate.F90 @@ -0,0 +1,246 @@ +module horizontal_interpolate + +! +! Modules Used: +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_PI + use cam_abortutils, only: endrun + use scamMod, only: single_column + use cam_logfile, only: iulog + implicit none + private + save + + real(r8) :: gw1(1000), gw2(1000) + + public :: xy_interp_init, xy_interp + +contains + subroutine xy_interp_init(im1,jm1,lon0,lat0,im2,jm2,weight_x,weight_y) +!------------------------------------------------------------------------------------------------------------ +! This program computes weighting functions to map a variable of (im1,jm1) resolution to (im2,jm2) resolution +! weight_x(im2,im1) is the weighting function for zonal interpolation +! weight_y(jm2,jm1) is the weighting function for meridional interpolation +! +! Author: Chih-Chieh (Jack) Chen -- May 2010 +! +!------------------------------------------------------------------------------------------------------------ + implicit none + integer, intent(in) :: im1, jm1, im2, jm2 + real(r8), intent(in) :: lon0(im1), lat0(jm1) + real(r8), intent(out) :: weight_x(im2,im1), weight_y(jm2,jm1) + + real(r8) :: lon1(im1), lat1(jm1) + real(r8) :: lon2(im2), lat2(jm2) + real(r8) :: slon1(im1+1), slon2(im2+1), slat1(jm1+1), slat2(jm2+1) + real(r8) :: x1_west, x1_east, x2_west, x2_east + real(r8) :: y1_south, y1_north, y2_south, y2_north + integer :: i1, j1, i2, j2 + + weight_x(:,:) = 0.0_r8 + weight_y(:,:) = 0.0_r8 + +! lon0 & lat0 are longitude & latitude on the source mesh in radians +! convert lon1, lat1 from radians to degrees + lon1(:) = lon0(:)/SHR_CONST_PI*180.0_r8 + lat1(:) = lat0(:)/SHR_CONST_PI*180.0_r8 + +! set up lon2, lat2 (target mesh), in CAM convention + do i2=1,im2 + lon2(i2) = (float(i2)-1.0_r8)*360.0_r8/float(im2) + enddo + do j2=1,jm2 + lat2(j2) = -90.0_r8+(float(j2)-1.0_r8)*180.0_r8/(float(jm2)-1.0_r8) + enddo + + +! set up staggered longitudes (cell edges in x) + do i1=2,im1 + slon1(i1) = (lon1(i1-1)+lon1(i1))/2.0_r8 + enddo + slon1(1) = lon1(1)-(lon1(2)-lon1(1))/2.0_r8 + slon1(im1+1) = lon1(im1)+(lon1(im1)-lon1(im1-1))/2.0_r8 + + do i2=2,im2 + slon2(i2) = (lon2(i2-1)+lon2(i2))/2.0_r8 + enddo + slon2(1) = lon2(1)-(lon2(2)-lon2(1))/2.0_r8 + slon2(im2+1) = lon2(im2)+(lon2(im2)-lon2(im2-1))/2.0_r8 + +! set up staggered lattiudes (cell edges in y) + slat1(1)=-90.0_r8 + do j1=2,jm1 + slat1(j1) = (lat1(j1-1)+lat1(j1))/2.0_r8 + enddo + slat1(jm1+1)=90.0_r8 + + slat2(1)=-90.0_r8 + do j2=2,jm2 + slat2(j2)=(lat2(j2-1)+lat2(j2))/2.0_r8 + enddo + slat2(jm2+1)=90.0_r8 + +! compute Guassian weight for two meshes (discrete form of cos(lat).) + do j1=1,jm1 + gw1(j1) = sin(slat1(j1+1)/180.0_r8*SHR_CONST_PI)-sin(slat1(j1)/180.0_r8*SHR_CONST_PI) + enddo + + do j2=1,jm2 + gw2(j2) = sin(slat2(j2+1)/180.0_r8*SHR_CONST_PI)-sin(slat2(j2)/180.0_r8*SHR_CONST_PI) + enddo + + +! add 360 to slon1 and slon2 + slon1(:) = slon1(:)+360.0_r8 + slon2(:) = slon2(:)+360.0_r8 + + do i2=1,im2 + +! target grid east-west boundaries + x2_west=slon2(i2) + x2_east=slon2(i2+1) + + do i1=1,im1 + +! source grid east-west boundaries + x1_west=slon1(i1) + x1_east=slon1(i1+1) + +! check if there is any overlap between the source grid and the target grid +! if no overlap, then weighting is zero +! there are three scenarios overlaps can take place + if( (x1_west.ge.x2_west).and.(x1_east.le.x2_east) ) then +! case 1: +! x1_west x1_east +! |-------------------| +! |---------------------------------| +! x2_west x2_east + weight_x(i2,i1) = (x1_east-x1_west)/(x2_east-x2_west) + elseif ( (x1_west.ge.x2_west).and.(x1_west.lt.x2_east) ) then +! case 2: +! x1_west x1_east +! |--------------------------------| +! |---------------------------------| +! x2_west x2_east + weight_x(i2,i1) = (x2_east-x1_west)/(x2_east-x2_west) + elseif ( (x1_east>x2_west).and.(x1_east.le.x2_east) ) then +! case 3: +! x1_west x1_east +! |--------------------------------| +! |---------------------------------| +! x2_west x2_east + weight_x(i2,i1) = (x1_east-x2_west)/(x2_east-x2_west) + endif + + enddo + enddo + + +! consider end points + if(slon1(im1+1).gt.slon2(im2+1)) then +! case 1: +! slon1(im1) slon1(im1+1) <--- end point +! |-------------------------| +! |----------------|......................| +! slon2(im2) slon2(im2+1) slon2(2) (note: slon2(im2+1) = slon2(1)) + weight_x(1,im1)= weight_x(1,im1)+(slon1(im1+1)-slon2(im2+1))/(slon2(2)-slon2(1)) + endif + + if(slon1(im1+1).lt.slon2(im2+1)) then +! case 1: +! slon1(im1) slon1(im1+1) slon1(2) (note: slon1(im1+1) = slon1(1)) +! |-------------------------|.............................| +! |-------------------------------| +! slon2(im2) slon2(im2+1) <--- end point + weight_x(im2,1) = weight_x(im2,1)+(slon2(1)-slon1(1))/(slon2(2)-slon2(1)) + endif + + + + do j2=1,jm2 +! target grid north-south boundaries + y2_south=slat2(j2) + y2_north=slat2(j2+1) + + do j1=1,jm1 + +! source grid north-south boundaries + y1_south=slat1(j1) + y1_north=slat1(j1+1) + +! check if there is any overlap between the source grid and the target grid +! if no overlap, then weighting is zero +! there are three scenarios overlaps can take place +! note: there is Guassian weight to consider in the meridional direction! + + if( (y1_south.ge.y2_south).and.(y1_north.le.y2_north) ) then +! case 1: +! y1_south y1_north +! |-------------------| +! |---------------------------------| +! y2_south y2_north + weight_y(j2,j1) = gw1(j1)/gw2(j2) + elseif ( (y1_south.ge.y2_south).and.(y1_south.lt.y2_north) ) then +! case 2: +! y1_south y1_north +! |--------------------------------| +! |---------------------------------| +! y2_south y2_north + weight_y(j2,j1) = (y2_north-y1_south)/(y1_north-y1_south)*gw1(j1)/gw2(j2) + elseif ( (y1_north.gt.y2_south).and.(y1_north.le.y2_north) ) then +! case 3: +! y1_south y1_north +! |--------------------------------| +! |---------------------------------| +! y2_south y2_north + weight_y(j2,j1) = (y1_north-y2_south)/(y1_north-y1_south)*gw1(j1)/gw2(j2) + endif + + enddo + enddo + + end subroutine xy_interp_init + + subroutine xy_interp(im1,jm1,km1,im2,jm2,pcols,ncols,weight_x,weight_y,var_src,var_trg,lons,lats,count_x,count_y,index_x,index_y) +!------------------------------------------------------------------------------------------------------------- +! This program interpolates var_src(im1,jm1,km1) to var_trg(im2,jm2,km1) based on weighting functions weight_x & weight_y. +!------------------------------------------------------------------------------------------------------------- + implicit none + integer, intent(in) :: im1 ! source number of longitudes + integer, intent(in) :: jm1 ! source number of latitudes + integer, intent(in) :: km1 ! source/target number of levels + integer, intent(in) :: im2 ! target number of longitudes + integer, intent(in) :: jm2 ! target number of latitudes + integer, intent(in) :: pcols + integer, intent(in) :: ncols + real(r8), intent(in) :: weight_x(im2,im1), weight_y(jm2,jm1) + real(r8), intent(in) :: var_src(im1,jm1,km1) + integer, intent(in) :: lons(pcols), lats(pcols) + integer, intent(in) :: count_x(im2), count_y(jm2) + integer, intent(in) :: index_x(im2,im1), index_y(jm2,jm1) + real(r8), intent(out) :: var_trg(pcols,km1) + integer :: n, i1, j1, k1, i2, j2, ii, jj + real(r8) :: sum_x + + var_trg(:,:) = 0.0_r8 + + + do k1=1,km1 + do n=1,ncols +! interpolate in x + do jj=1,count_y(lats(n)) + sum_x = 0.0_r8 + do ii=1,count_x(lons(n)) + sum_x = sum_x + var_src(index_x(lons(n),ii),index_y(lats(n),jj),k1)* & + weight_x(lons(n),index_x(lons(n),ii)) + enddo + var_trg(n,k1) = var_trg(n,k1)+sum_x*weight_y(lats(n),index_y(lats(n),jj)) + enddo + enddo + enddo + + end subroutine xy_interp + + +end module horizontal_interpolate diff --git a/src/chemistry/utils/input_data_utils.F90 b/src/chemistry/utils/input_data_utils.F90 new file mode 100644 index 0000000000..4218cb4d8c --- /dev/null +++ b/src/chemistry/utils/input_data_utils.F90 @@ -0,0 +1,474 @@ +!-------------------------------------------------------------------------------- +! module where input data utility classes reside +! +! classes: +! time_coordinate -- manages the time coordinate of input data sets +!-------------------------------------------------------------------------------- +module input_data_utils + use shr_kind_mod, only : r8 => shr_kind_r8, cs => shr_kind_cs, cl=> shr_kind_cl + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use pio, only : file_desc_t, pio_inq_dimid, pio_inq_dimlen, pio_get_att + use pio, only : pio_seterrorhandling, pio_get_var, pio_inq_varid + use pio, only : PIO_NOWRITE, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_NOERR + use time_manager, only : timemgr_get_calendar_cf, set_time_float_from_date, get_curr_date + use spmd_utils, only : masterproc + + implicit none + + private + public :: time_coordinate + + type :: time_coordinate + integer :: ntimes + real(r8) :: wghts(2) + integer :: indxs(2) + real(r8), allocatable :: times(:) + real(r8), allocatable :: time_bnds(:,:) + logical :: time_interp = .true. + logical :: fixed = .false. + integer :: fixed_ymd, fixed_tod + character(len=cl) :: filename + real(r8) :: dtime ! time shift in interpolation point (days) + contains + procedure :: initialize + procedure :: advance + procedure :: read_more + procedure :: copy + procedure :: destroy + end type time_coordinate + +contains + + !----------------------------------------------------------------------------- + ! initializer + !----------------------------------------------------------------------------- + subroutine initialize( this, filepath, fixed, fixed_ymd, fixed_tod, force_time_interp, set_weights, try_dates, delta_days ) + use ioFileMod, only : getfil + use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile + use string_utils, only : to_upper + + class(time_coordinate), intent(inout) :: this + character(len=*), intent(in) :: filepath + logical, optional,intent(in) :: fixed + integer, optional,intent(in) :: fixed_ymd + integer, optional,intent(in) :: fixed_tod + logical, optional,intent(in) :: force_time_interp + logical, optional,intent(in) :: set_weights + logical, optional,intent(in) :: try_dates + real(r8), optional,intent(in) :: delta_days ! time shift in interpolation point (days) -- for previous day set this to -1. + + character(len=cl) :: filen + character(len=cl) :: time_units, err_str + character(len=cs) :: time_calendar, model_calendar + character(len=4) :: yr_str + character(len=2) :: mon_str, day_str, hr_str, min_str, sec_str + integer :: ref_yr, ref_mon, ref_day, ref_hr, ref_min, ref_sec, tod + integer :: varid, ierr + real(r8) :: ref_time + + integer, allocatable :: dates(:) + integer, allocatable :: datesecs(:) + real(r8), allocatable :: times_file(:) + real(r8), allocatable :: times_modl(:) + real(r8), allocatable :: time_bnds_file(:,:) + type(file_desc_t) :: fileid + logical :: force_interp + logical :: set_wghts + logical :: use_time, adj_times, use_time_bnds + integer :: i + + if (present(fixed)) this%fixed = fixed + if (present(fixed_ymd)) this%fixed_ymd = fixed_ymd + if (present(fixed_tod)) this%fixed_tod = fixed_tod + + this%dtime = 0._r8 + if (present(delta_days)) this%dtime = delta_days + + if (present(force_time_interp)) then + force_interp = force_time_interp + else + force_interp = .false. + endif + + if (present(set_weights)) then + set_wghts = set_weights + else + set_wghts = .true. + endif + + this%filename = trim(filepath) + + call getfil( filepath, filen, 0 ) + call cam_pio_openfile( fileid, filen, PIO_NOWRITE ) + + call pio_seterrorhandling( fileid, PIO_BCAST_ERROR) + + call get_dimension( fileid, 'time', this%ntimes ) + allocate ( times_file( this%ntimes ) ) + allocate ( times_modl( this%ntimes ) ) + allocate ( this%times( this%ntimes ) ) + + ierr = pio_inq_varid( fileid, 'time', varid ) + use_time = ierr.eq.PIO_NOERR + ierr = pio_get_att( fileid, varid, 'calendar', time_calendar) + use_time = ierr.eq.PIO_NOERR .and. use_time + ierr = pio_get_att( fileid, varid, 'units', time_units) + use_time = ierr.eq.PIO_NOERR .and. use_time + if (use_time) then + use_time = time_units(1:10).eq.'days since' + endif + + if (present(try_dates)) then + if (try_dates) then + ierr = pio_inq_varid( fileid, 'date', varid ) + use_time = ierr .ne. PIO_NOERR + endif + endif + + adj_times = .false. + use_time_bnds = .false. + + time_var_use: if (use_time) then + + ! check the calendar attribute - must match model calendar + model_calendar = timemgr_get_calendar_cf() + + if (this%ntimes>2) then + ! if only 2 time records then it is assumed that the input has 2 identical time records + ! -- climatological or solar-cycle avaraged + + adj_times = (to_upper(time_calendar(1:6)) .ne. to_upper(model_calendar(1:6))) + + if (adj_times .and. masterproc) then + write(iulog,*) 'time_coordinate%initialize: model calendar '//trim(model_calendar)// & + ' does not match input data calendar '//trim(time_calendar) + write(iulog,*) ' -- will try to use date and datesec in the input file to adjust the time coordinate.' + end if + end if + + ! parse out ref date and time + ! time:units = "days since YYYY-MM-DD hh:mm:ss" ; + + yr_str = time_units(12:15) + mon_str = time_units(17:18) + day_str = time_units(20:21) + hr_str = time_units(23:24) + min_str = time_units(26:27) + + read( yr_str, * ) ref_yr + read( mon_str, * ) ref_mon + read( day_str, * ) ref_day + read( hr_str, * ) ref_hr + read( min_str, * ) ref_min + if (len_trim(time_units).ge.30) then + sec_str = time_units(29:30) + read( sec_str, * ) ref_sec + else + ref_sec = 0 + endif + + tod = ref_hr*3600 + ref_min*60 + ref_sec + call set_time_float_from_date( ref_time, ref_yr, ref_mon, ref_day, tod ) + + ierr = pio_get_var( fileid, varid, times_file ) + if (ierr.ne.PIO_NOERR) then + call endrun('time_coordinate%initialize: not able to read times') + endif + + times_file = times_file + ref_time + + ierr = pio_inq_varid( fileid, 'time_bnds', varid ) + + use_time_bnds = (ierr==PIO_NOERR .and. .not.force_interp) + + if (use_time_bnds) then + allocate ( this%time_bnds( 2, this%ntimes ) ) + allocate ( time_bnds_file( 2, this%ntimes ) ) + ierr = pio_get_var( fileid, varid, time_bnds_file ) + time_bnds_file = time_bnds_file + ref_time + this%time_interp = .false. + do i = 1,this%ntimes + if (.not. (time_bnds_file(1,i)times_file(i)) ) then + write(err_str,*) 'incorrect time_bnds -- time index: ',i,' file: '//trim(filepath) + call endrun(err_str) + endif + enddo + else + this%time_interp = .true. + endif + else + this%time_interp = .true. + endif time_var_use + + read_dates: if (adj_times .or. .not.use_time) then + + ! try using date and datesec + allocate(dates(this%ntimes), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'time_coordinate%initialize: failed to allocate dates; error = ',ierr + call endrun('time_coordinate%initialize: failed to allocate dates') + end if + + allocate(datesecs(this%ntimes), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'time_coordinate%initialize: failed to allocate datesecs; error = ',ierr + call endrun('time_coordinate%initialize: failed to allocate datesecs') + end if + + ierr = pio_inq_varid( fileid, 'date', varid ) + if (ierr/=PIO_NOERR) then + call endrun('time_coordinate%initialize: input file must contain time or date variable '//trim(filepath)) + endif + ierr = pio_get_var( fileid, varid, dates ) + ierr = pio_inq_varid( fileid, 'datesec', varid ) + if (ierr==PIO_NOERR) then + ierr = pio_get_var( fileid, varid, datesecs ) + else + datesecs(:) = 0 + endif + + call convert_dates( dates, datesecs, times_modl ) + + deallocate( dates, datesecs ) + + endif read_dates + + if (adj_times) then + ! time_bnds_modl - time_bnds_file = times_modl - times_file + ! time_bnds_modl = time_bnds_file + times_modl - times_file + this%times(:) = times_modl(:) + if (use_time_bnds) then + this%time_bnds(1,:) = time_bnds_file(1,:) + times_modl(:) - times_file(:) + this%time_bnds(2,:) = time_bnds_file(2,:) + times_modl(:) - times_file(:) + endif + else if (use_time) then + this%times(:) = times_file(:) + if (use_time_bnds) then + this%time_bnds(1,:) = time_bnds_file(1,:) + this%time_bnds(2,:) = time_bnds_file(2,:) + endif + else + this%times(:) = times_modl(:) + endif + + deallocate( times_modl, times_file ) + if (use_time_bnds) deallocate(time_bnds_file) + + call pio_seterrorhandling(fileid, PIO_INTERNAL_ERROR) + + call cam_pio_closefile(fileid) + + this%indxs(1)=1 + if (set_wghts) call set_wghts_indices(this) + + end subroutine initialize + + !----------------------------------------------------------------------------- + ! advance the time coordinate + !----------------------------------------------------------------------------- + subroutine advance( this ) + class(time_coordinate) :: this + + if (.not.this%fixed) call set_wghts_indices(this) + + end subroutine advance + + !----------------------------------------------------------------------------- + ! determine if need to read more data from input data set + !----------------------------------------------------------------------------- + function read_more(this) result(check) + class(time_coordinate), intent(in) :: this + logical :: check + + real(r8) :: model_time + + model_time = get_model_time() + this%dtime + + if (.not.this%fixed) then + if (allocated(this%time_bnds)) then + check = model_time > this%time_bnds(2,this%indxs(1)) + else + check = model_time > this%times(this%indxs(2)) + endif + else + check = .false. + endif + + end function read_more + + !----------------------------------------------------------------------------- + ! destroy method -- deallocate memory and revert to default settings + !----------------------------------------------------------------------------- + subroutine destroy( this ) + class(time_coordinate), intent(inout) :: this + + if (allocated(this%times)) deallocate(this%times) + if (allocated(this%time_bnds)) deallocate(this%time_bnds) + this%ntimes = 0 + this%filename='NONE' + + end subroutine destroy + + !----------------------------------------------------------------------------- + ! produce a duplicate time coordinate object + !----------------------------------------------------------------------------- + subroutine copy( this, obj ) + class(time_coordinate), intent(inout) :: this + class(time_coordinate), intent(in) :: obj + + call this%destroy() + + this%ntimes = obj%ntimes + this%fixed = obj%fixed + this%fixed_ymd = obj%fixed_ymd + this%fixed_tod = obj%fixed_tod + + allocate ( this%times( this%ntimes ) ) + this%times = obj%times + + if (allocated( obj%time_bnds )) then + allocate ( this%time_bnds( 2, this%ntimes ) ) + this%time_bnds = obj%time_bnds + endif + this%filename = obj%filename + + end subroutine copy + +! private methods + + !----------------------------------------------------------------------- + ! set time interpolation weights + !----------------------------------------------------------------------- + subroutine set_wghts_indices(obj) + + class(time_coordinate), intent(inout) :: obj + + real(r8) :: model_time + real(r8) :: datatm, datatp + integer :: yr, mon, day + integer :: index, i + character(len=cl) :: errmsg + + ! set time indices and time-interpolation weights + fixed_time: if (obj%fixed) then + yr = obj%fixed_ymd/10000 + mon = (obj%fixed_ymd-yr*10000) / 100 + day = obj%fixed_ymd-yr*10000-mon*100 + call set_time_float_from_date( model_time, yr, mon, day, obj%fixed_tod ) + model_time = model_time + obj%dtime + else + model_time = get_model_time() + obj%dtime + endif fixed_time + + index = -1 + + findtimes: do i = obj%indxs(1), obj%ntimes + if (allocated(obj%time_bnds)) then + datatm = obj%time_bnds(1,i) + datatp = obj%time_bnds(2,i) + else + if (i .ge. obj%ntimes) then + errmsg = 'input_data_utils::set_wghts_indices cannot not find model time in: '& + // trim(obj%filename) + write(iulog,*) trim(errmsg) + call endrun(trim(errmsg)) + endif + datatm = obj%times(i) + datatp = obj%times(i+1) + endif + if ( model_time .lt. datatm ) then + errmsg = 'input_data_utils::set_wghts_indices cannot not find model time in: '& + // trim(obj%filename) + write(iulog,*) trim(errmsg) + call endrun(trim(errmsg)) + endif + if ( model_time .ge. datatm .and. model_time .le. datatp ) then + index = i + obj%indxs(1) = i + obj%indxs(2) = i+1 + exit findtimes + endif + enddo findtimes + + if ((allocated(obj%time_bnds)) .and. (i obj%time_bnds(1,i))) then + obj%indxs = obj%indxs+1 ! skip 29 Feb when calendar is noleap + endif + endif + + if (.not.(index>0.and.index shr_kind_r8 + use physconst, only : gravity => gravit,& + rearth,& + avogadro_kmol => avogad,& + rgas_kmol => r_universal,& + boltz,& + pi,& + rgrav=>rga,& + rhoh2o + + implicit none + + save + + real(r8), parameter :: dayspy = 365._r8 ! days per year + ! The following are converted from kmol to mol. + real(r8), parameter :: avogadro = avogadro_kmol*1.e-3_r8 ! Avogadro numb - molecules/mole + real(r8), parameter :: rgas = rgas_kmol*1.e-3_r8 ! Gas constant (J/K/mol) + + ! Call out cgs units via explicit naming. + real(r8), parameter :: rgas_cgs = rgas*1.e7_r8 ! erg/K/mol + real(r8), parameter :: boltz_cgs = boltz*1.e7_r8 ! erg/K + real(r8), parameter :: rhoh2o_cgs = rhoh2o*1.e-3_r8 ! g/ml + + ! Not a compile-time constant. + real(r8) :: gravity_cgs = huge(1._r8) ! cm/s^2 + + real(r8), parameter :: d2r = pi/180._r8 ! radians to degrees + real(r8), parameter :: r2d = 180._r8/pi ! degrees to radians + + real(r8), parameter :: seasalt_density = 2.2e+3_r8 ! [kg m-3] Aerosol density + real(r8), parameter :: dust_density = 2.5e+3_r8 ! [kg m-3] Aerosol density +contains + + subroutine mo_constants_inti + + gravity_cgs = gravity*1.e2_r8 + + end subroutine mo_constants_inti + +end module mo_constants diff --git a/src/chemistry/utils/mo_flbc.F90 b/src/chemistry/utils/mo_flbc.F90 new file mode 100644 index 0000000000..15ff5685fc --- /dev/null +++ b/src/chemistry/utils/mo_flbc.F90 @@ -0,0 +1,834 @@ +module mo_flbc + !--------------------------------------------------------------- + ! ... lower boundary module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use m_types, only : time_ramp + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use ioFileMod, only : getfil + use ppgrid, only : pcols, begchunk, endchunk, pver + use time_manager, only : get_curr_date + use time_utils, only : flt_date + use cam_logfile, only : iulog + use constituents, only : pcnst + + implicit none + + type :: flbc + integer :: spc_ndx = -1 + real(r8), pointer :: vmr(:,:,:) + character(len=16) :: species = ' ' + logical :: has_mean + real(r8), pointer :: vmr_mean(:) + end type flbc + + private + public :: flbc_inti, flbc_set, flbc_chk, has_flbc + public :: flbc_gmean_vmr + public :: flbc_get_cfc11eq, flbc_has_cfc11eq + + save + + integer, parameter :: time_span = 1 + + integer :: ntimes + integer :: flbc_cnt + integer :: tim_ndx(2) + integer, allocatable :: dates(:) + real(r8), allocatable :: times(:) + logical, protected :: has_flbc(pcnst) + character(len=256) :: filename + + type(time_ramp) :: flbc_timing + integer :: ncdate, ncsec + + integer, parameter :: nghg = 6 + integer, parameter :: max_nflbc = pcnst+nghg + + integer, parameter :: co2_ndx = 1 + integer, parameter :: ch4_ndx = 2 + integer, parameter :: n2o_ndx = 3 + integer, parameter :: f11_ndx = 4 + integer, parameter :: f12_ndx = 5 + integer, parameter :: f11eq_ndx = 6 + character(len=8) :: ghg_names(nghg) = (/ 'CO2 ','CH4 ','N2O ','CFC11 ','CFC12 ','CFC11eq ' /) + integer :: ghg_indices(nghg) = -1 + + type(flbc) :: flbcs(max_nflbc) + + logical, parameter :: debug = .false. + logical, protected :: flbc_has_cfc11eq = .false. + +contains + + subroutine flbc_inti( flbc_file, flbc_list, flbc_timing_in, co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr ) + !----------------------------------------------------------------------- + ! ... initialize the fixed lower bndy cond + !----------------------------------------------------------------------- + + use string_utils, only : to_upper + use constituents, only : cnst_get_ind + use cam_pio_utils, only : cam_pio_openfile + use pio, only : pio_get_var,pio_inq_varid,pio_inq_dimid, pio_inq_dimlen + use pio, only : file_desc_t, pio_closefile, pio_nowrite + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: flbc_file + character(len=*), intent(in) :: flbc_list(:) + type(time_ramp), intent(in) :: flbc_timing_in + real(r8), intent(in) :: co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: astat + integer :: m, n ! Indices + integer :: t1, t2 + type(file_desc_t) :: ncid + integer :: dimid + integer :: varid + integer :: yr, mon, day, wrk_date, wrk_sec + real(r8) :: wrk_time + character(len=8) :: time_type + integer :: ierr + + if ( len_trim( flbc_file ) == 0 .or. flbc_file.eq.'NONE') return + + call get_curr_date( yr, mon, day, ncsec ) + ncdate = yr*10000 + mon*100 + day + + !----------------------------------------------------------------------- + ! ... check timing + !----------------------------------------------------------------------- + flbc_timing = flbc_timing_in + time_type = to_upper(flbc_timing%type) + flbc_timing%type = time_type + if( time_type /= 'SERIAL' .and. time_type /= 'CYCLICAL' & + .and. time_type /= 'FIXED' ) then + write(iulog,*) 'flbc_inti: time type ',trim(time_type),' is not SERIAL,CYCLICAL, or FIXED' + call endrun('flbc_inti: invalid time type ') + end if + + if ( (flbc_timing%cycle_yr>0) .and. (time_type/='CYCLICAL') ) then + call endrun('flbc_inti: cannot specify flbc_cycle_yr if flbc_type is not CYCLICAL') + endif + if ( ((flbc_timing%fixed_ymd>0).or.(flbc_timing%fixed_tod>0)).and.(time_type/='FIXED') ) then + call endrun('flbc_inti: cannot specify flbc_fixed_ymd or flbc_fixed_tod if flbc_type is not FIXED') + endif + + wrk_sec = ncsec + if( time_type == 'SERIAL' ) then + wrk_date = ncdate + else if( time_type == 'CYCLICAL' ) then + + ! If this is a leap-day, we have to avoid asking for a non-leap-year + ! on a cyclical dataset. When this happens, just use Feb 28 instead + if (( mon .eq. 2 ) .and. ( day.eq.29 )) then + ncdate = yr*10000 + mon*100 + (day-1) + write(iulog,*)'WARNING: flbc_inti using Feb 28 instead of Feb 29 for cyclical dataset' + endif + wrk_date = flbc_timing%cycle_yr*10000 + mod(ncdate,10000) + else + wrk_date = flbc_timing%fixed_ymd + wrk_sec = flbc_timing%fixed_tod + end if + wrk_time = flt_date( wrk_date, wrk_sec ) + if (masterproc) write(iulog,*) 'flbc_inti: wrk_date,wrk_sec,wrk_time = ',wrk_date,wrk_sec,wrk_time + + !----------------------------------------------------------------------- + ! ... species with fixed lbc ? + !----------------------------------------------------------------------- + has_flbc(:) = .false. + flbc_cnt = 0 + + do m = 1,max_nflbc + + if ( len_trim(flbc_list(m))==0 ) exit + + flbc_cnt = flbc_cnt + 1 + + call cnst_get_ind (flbc_list(m), n, abort=.false.) + + if (n > 0) then + has_flbc(n) = .true. + flbcs(flbc_cnt)%spc_ndx = n + else ! must be one of the GHGs which is not prognosted + if( .not. any( ghg_names(:) == flbc_list(m) ) ) then + call endrun('flbc_inti: flbc_list member '// trim(flbc_list(m)) //' is not allowed') + endif + flbcs(flbc_cnt)%spc_ndx = -1 + endif + + flbcs(flbc_cnt)%species = trim( flbc_list(m) ) + + where( ghg_names(:) == flbc_list(m) ) + ghg_indices = m + endwhere + + if( trim(flbcs(flbc_cnt)%species) == 'CFC11' ) then + flbcs(flbc_cnt)%species = 'CFCL3' + elseif( trim(flbcs(flbc_cnt)%species) == 'CFC12' ) then + flbcs(flbc_cnt)%species = 'CF2CL2' + endif + + if ( trim(flbc_list(m)) .eq. trim(ghg_names(f11eq_ndx)) ) then + flbc_has_cfc11eq = .true. + endif + + enddo + + ! check that user has not set vmr namelist values... + if ( ghg_indices(co2_ndx) > 0 .and. co2vmr>1.e-6_r8) then + call endrun('flbc_inti: cannot specify both co2vmr and CO2 in flbc_file') + endif + if ( ghg_indices(ch4_ndx) > 0 .and. ch4vmr > 0._r8) then + call endrun('flbc_inti: cannot specify both ch4vmr and CH4 in flbc_file') + endif + if ( ghg_indices(n2o_ndx) > 0 .and. n2ovmr > 0._r8) then + call endrun('flbc_inti: cannot specify both n2ovmr and N2O in flbc_file') + endif + if ( ghg_indices(f11_ndx) > 0 .and. f11vmr > 0._r8) then + call endrun('flbc_inti: cannot specify both f11vmr and CFC11 in flbc_file') + endif + if ( ghg_indices(f12_ndx) > 0 .and. f12vmr > 0._r8) then + call endrun('flbc_inti: cannot specify both f12vmr and CFC12 in flbc_file') + endif + + if( flbc_cnt == 0 ) then + return + end if + + if(masterproc) then + write(iulog,*) ' ' + if( flbc_cnt > 0 ) then + write(iulog,*) 'flbc_inti: Species with specified lower boundary values' + do n = 1,flbc_cnt + write(iulog,*) trim(flbcs(n)%species) + enddo + else + write(iulog,*) 'There are no species with specified lower boundary values' + end if + write(iulog,*) ' ' + + !----------------------------------------------------------------------- + ! ... diagnostics + !----------------------------------------------------------------------- + write(iulog,*) ' ' + write(iulog,*) 'flbc_inti: diagnostics' + write(iulog,*) ' ' + write(iulog,*) 'lower bndy timing specs' + write(iulog,*) 'type = ',flbc_timing%type + if( time_type == 'CYCLICAL' ) then + write(iulog,*) 'cycle year = ',flbc_timing%cycle_yr + else + write(iulog,*) 'fixed date = ',flbc_timing%fixed_ymd + write(iulog,*) 'fixed time = ',flbc_timing%fixed_tod + end if + write(iulog,*) ' ' + write(iulog,*) 'there are ',flbc_cnt,' species with specified lower bndy values' + write(iulog,*) ' ' + end if + !----------------------------------------------------------------------- + ! ... get timing information, allocate arrays, and read in dates + !----------------------------------------------------------------------- + call getfil ( flbc_file, filename, 0) + call cam_pio_openfile (ncid, trim(filename), PIO_NOWRITE) + ierr = pio_inq_dimid( ncid, 'time', dimid ) + ierr = pio_inq_dimlen( ncid, dimid, ntimes ) + + allocate( dates(ntimes),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_inti: failed to allocate dates array; error = ',astat + call endrun + end if + allocate( times(ntimes),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_inti: failed to allocate times array; error = ',astat + call endrun + end if + + ierr = pio_inq_varid( ncid, 'date', varid ) + ierr = pio_get_var( ncid, varid, dates ) + + do n = 1,ntimes + times(n) = flt_date( dates(n), 0 ) + end do + if( time_type /= 'CYCLICAL' ) then + if( wrk_time < times(1) .or. wrk_time > times(ntimes) ) then + write(iulog,*) 'flbc_inti: time out of bounds for dataset = ',trim(filename) + call endrun + end if + do n = 2,ntimes + if( wrk_time <= times(n) ) then + exit + end if + end do + tim_ndx(1) = n - 1 + else + yr = flbc_timing%cycle_yr + do n = 1,ntimes + if( yr == dates(n)/10000 ) then + exit + end if + end do + if( n >= ntimes ) then + write(iulog,*) 'flbc_inti: time out of bounds for dataset = ',trim(filename) + call endrun + end if + tim_ndx(1) = n + end if + select case( time_type ) + case( 'FIXED' ) + tim_ndx(2) = n + case( 'CYCLICAL' ) + do n = tim_ndx(1),ntimes + if( yr /= dates(n)/10000 ) then + exit + end if + end do + tim_ndx(2) = n - 1 + if( (tim_ndx(2) - tim_ndx(1)) < 2 ) then + write(iulog,*) 'flbc_inti: cyclical lb conds require at least two time points' + call endrun + end if + case( 'SERIAL' ) + tim_ndx(2) = min( ntimes,tim_ndx(1) + time_span ) + end select + t1 = tim_ndx(1) + t2 = tim_ndx(2) + + if( masterproc .and. debug ) then + write(iulog,*) ' ' + write(iulog,*) 'flbc time cnt = ',ntimes + write(iulog,*) 'flbc times' + write(iulog,'(10i10)') dates(:) + write(iulog,'(1p,5g15.7)') times(:) + write(iulog,*) 'flbc time indicies = ',tim_ndx(:) + write(iulog,'(10i10)') dates(tim_ndx(1):tim_ndx(2)) + write(iulog,*) ' ' + endif + + do m = 1,flbc_cnt + !----------------------------------------------------------------------- + ! ... allocate array + !----------------------------------------------------------------------- + allocate( flbcs(m)%vmr(pcols,begchunk:endchunk,t1:t2),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_inti: failed to allocate lbc vmr; error = ',astat + call endrun + end if + flbcs(m)%has_mean = file_has_gmean(ncid,flbcs(m)%species) + if ( flbcs(m)%has_mean) then + allocate( flbcs(m)%vmr_mean(t1:t2),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_inti: failed to allocate lbc vmr_mean; error = ',astat + call endrun + end if + endif + !----------------------------------------------------------------------- + ! ... readin the flbc vmr + !----------------------------------------------------------------------- + call flbc_get( ncid, flbcs(m), .true., read_gmean=flbcs(m)%has_mean ) + end do + + !----------------------------------------------------------------------- + ! ... close the file + !----------------------------------------------------------------------- + call pio_closefile( ncid ) + + end subroutine flbc_inti + + subroutine flbc_chk( ) + use cam_pio_utils, only : cam_pio_openfile + use pio, only : file_desc_t, pio_closefile, pio_nowrite + !----------------------------------------------------------------------- + ! ... check serial case for time span + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + integer :: t1, t2, tcnt + integer :: astat + type(file_desc_t) :: ncid + real(r8) :: wrk_time + integer :: yr, mon, day + + call get_curr_date( yr, mon, day, ncsec ) + ncdate = yr*10000 + mon*100 + day + + if( flbc_cnt > 0 .and. flbc_timing%type == 'SERIAL' ) then + wrk_time = flt_date( ncdate, ncsec ) + if( wrk_time > times(tim_ndx(2)) ) then + tcnt = tim_ndx(2) - tim_ndx(1) + tim_ndx(1) = tim_ndx(2) + tim_ndx(2) = min( ntimes,tim_ndx(1) + time_span ) + t1 = tim_ndx(1) + t2 = tim_ndx(2) +!!$ if( tcnt /= (t2 - t1) ) then + !----------------------------------------------------------------------- + ! ... allocate array + !----------------------------------------------------------------------- + do m = 1,flbc_cnt + if( associated( flbcs(m)%vmr ) ) then + deallocate( flbcs(m)%vmr,stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_chk: failed to deallocate flbc vmr; error = ',astat + call endrun + end if + end if + allocate( flbcs(m)%vmr(pcols,begchunk:endchunk,t1:t2),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_chk: failed to allocate flbc vmr; error = ',astat + call endrun + end if + + if (flbcs(m)%has_mean) then + if( associated( flbcs(m)%vmr_mean ) ) then + deallocate( flbcs(m)%vmr_mean,stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_chk: failed to deallocate flbc vmr; error = ',astat + call endrun + end if + end if + allocate( flbcs(m)%vmr_mean(t1:t2),stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'flbc_chk: failed to allocate flbc vmr; error = ',astat + call endrun + end if + + endif + end do +!!$ end if + + call cam_pio_openfile (ncid, trim(filename), PIO_NOWRITE) + !----------------------------------------------------------------------- + ! ... readin the lb concentrations + !----------------------------------------------------------------------- + do m = 1,flbc_cnt + call flbc_get( ncid, flbcs(m), .true., read_gmean=flbcs(m)%has_mean ) + end do + + !----------------------------------------------------------------------- + ! ... close the file + !----------------------------------------------------------------------- + call pio_closefile( ncid ) + + end if + end if + + end subroutine flbc_chk + + ! checks for global mean in input file + function file_has_gmean(ncid,species) + use pio, only : file_desc_t, pio_inq_varid, pio_noerr, pio_seterrorhandling, & + pio_bcast_error, pio_internal_error + implicit none + + type(file_desc_t), intent(inout) :: ncid + character(*), intent(in) :: species + logical :: file_has_gmean + + integer :: varid, ierr + + ! Allow pio to return the potential error and handle it locally + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_inq_varid( ncid, trim(species)//'_LBC_mean', varid) + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + + file_has_gmean = (ierr==PIO_NOERR) + + endfunction file_has_gmean + + subroutine flbc_get( ncid, lbcs, initial, read_gmean ) + !----------------------------------------------------------------------- + ! ... read lower bndy values + !----------------------------------------------------------------------- + use mo_constants, only : d2r, pi + use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p + use pio, only: file_desc_t, pio_get_var, pio_inq_varndims + use pio, only: pio_max_name, pio_inq_varid, pio_inq_dimlen, pio_inq_dimid + use pio, only: pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_NOERR + use interpolate_data, only : interp_type, lininterp_init, lininterp_finish, lininterp + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type(file_desc_t), intent(inout) :: ncid + logical, intent(in) :: initial + type(flbc), intent(inout) :: lbcs + + logical, intent(in), optional :: read_gmean + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: j, m ! Indices + integer :: t1, t2, tcnt + integer :: ierr + integer :: vid, nlat, nlon + integer :: dimid_lat, dimid_lon + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8), allocatable :: wrk(:,:,:), wrk_zonal(:,:) + character(len=pio_max_name) :: varname + real(r8), allocatable :: locl_vmr(:,:,:) + integer :: ndims, t, c, ncols + type(interp_type) :: lon_wgts, lat_wgts + real(r8) :: to_lats(pcols), to_lons(pcols) + real(r8), parameter :: twopi=2._r8*pi, zero=0._r8 + + t1 = tim_ndx(1) + t2 = tim_ndx(2) + tcnt = t2 - t1 + 1 + allocate( locl_vmr(pcols,begchunk:endchunk,tcnt), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'srf_emis_get: locl_emis allocation error = ',ierr + call endrun + end if + + locl_vmr(:,:,:) = 0._r8 + + initialization : if( initial ) then + !----------------------------------------------------------------------- + ! ... get grid dimensions from file + !----------------------------------------------------------------------- + ! latitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( ncid, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( ncid, dimid_lat, nlat ) + allocate( lat(nlat),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: lat allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( ncid, 'lat', vid ) + ierr = pio_get_var( ncid, vid, lat ) + lat(:nlat) = lat(:nlat) * d2r + + !----------------------------------------------------------------------- + ! longitudes + !----------------------------------------------------------------------- + call pio_seterrorhandling( ncid, PIO_BCAST_ERROR ) + ierr = pio_inq_dimid( ncid, 'lon', dimid_lon ) + call pio_seterrorhandling( ncid, PIO_INTERNAL_ERROR ) + if (ierr == PIO_NOERR ) then + ierr = pio_inq_dimlen( ncid, dimid_lon, nlon ) + allocate( lon(nlon),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: lon allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( ncid, 'lon', vid ) + ierr = pio_get_var( ncid, vid, lon ) + lon(:nlon) = lon(:nlon) * d2r + endif + end if initialization + + !----------------------------------------------------------------------- + ! ... read data + !----------------------------------------------------------------------- + varname = trim(lbcs%species) // '_LBC' + ierr = pio_inq_varid( ncid, trim(varname), vid ) + ierr = pio_inq_varndims (ncid, vid, ndims) + + if (ndims==2) then + allocate( wrk_zonal(nlat,tcnt), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: wrk_zonal allocation error = ',ierr + call endrun + end if + else + allocate( wrk(nlon,nlat,tcnt), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: wrk allocation error = ',ierr + call endrun + end if + endif + + if (ndims==2) then + ierr = pio_get_var( ncid, vid, (/ 1, t1/), & + (/ nlat, tcnt /), wrk_zonal ) + else + ierr = pio_get_var( ncid, vid, (/ 1, 1, t1/), & + (/ nlon, nlat, tcnt /), wrk ) + endif + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + + call lininterp_init(lat, nlat, to_lats, ncols, 1, lat_wgts) + if (ndims==2) then + do m = 1,tcnt + call lininterp(wrk_zonal(:,m), nlat, locl_vmr(:,c,m), ncols, lat_wgts) + end do + else + call lininterp_init(lon, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + + do m = 1,tcnt + call lininterp(wrk(:,:,m), nlon, nlat, locl_vmr(:,c,m), ncols, lon_wgts, lat_wgts) + end do + + + call lininterp_finish(lon_wgts) + end if + call lininterp_finish(lat_wgts) + + end do + + if (ndims==2) then + deallocate( wrk_zonal,stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: Failed to deallocate wrk_zonal, ierr = ',ierr + call endrun + end if + else + deallocate(wrk, stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: Failed to deallocate wrk, ierr = ',ierr + call endrun + end if + end if + if (read_gmean) then + varname = trim(lbcs%species) // '_LBC_mean' + ierr = pio_inq_varid( ncid, trim(varname), vid ) + ierr = pio_get_var( ncid, vid, (/t1/), (/tcnt/), lbcs%vmr_mean(t1:t2) ) + endif + + + do m = t1,t2 + lbcs%vmr(:,:,m) = locl_vmr(:,:,m-t1+1) + enddo + + deallocate(locl_vmr, stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'flbc_get: Failed to deallocate locl_vmr; ierr = ',ierr + call endrun + end if + + end subroutine flbc_get + + subroutine flbc_set( vmr, ncol, lchnk, map ) + !-------------------------------------------------------- + ! ... set the lower bndy values + !-------------------------------------------------------- + + implicit none + + !-------------------------------------------------------- + ! ... dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + integer, intent(in) :: map(:) + real(r8), intent(inout) :: vmr(:,:,:) ! lower bndy concentrations( mol/mol ) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: m, n + integer :: last, next + real(r8) :: dels + + if( flbc_cnt < 1 ) then + return + end if + + call get_dels( dels, last, next ) + + do m = 1,flbc_cnt + if ( flbcs(m)%spc_ndx > 0 ) then + n = map( flbcs(m)%spc_ndx ) + vmr(:ncol,pver,n) = flbcs(m)%vmr(:ncol,lchnk,last) & + + dels * (flbcs(m)%vmr(:ncol,lchnk,next) - flbcs(m)%vmr(:ncol,lchnk,last)) + endif + end do + + end subroutine flbc_set + + subroutine flbc_get_cfc11eq( lbc_vmr, ncol, lchnk ) + + !-------------------------------------------------------- + ! return the lower of cfclleq + !-------------------------------------------------------- + + !-------------------------------------------------------- + ! dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + real(r8), intent(out) :: lbc_vmr(:) ! lower bndy concentrations( mol/mol ) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: m, last, next + real(r8) :: dels + + lbc_vmr(:) = 0._r8 + + if (flbc_has_cfc11eq) then + call get_dels( dels, last, next ) + m = ghg_indices(f11eq_ndx) + lbc_vmr(:ncol) = flbcs(m)%vmr(:ncol,lchnk,last) & + + dels * (flbcs(m)%vmr(:ncol,lchnk,next) - flbcs(m)%vmr(:ncol,lchnk,last)) + endif + + end subroutine flbc_get_cfc11eq + + subroutine get_dels( dels, last, next ) + + use intp_util, only: findplb + + implicit none + + real(r8), intent(out) :: dels + integer, intent(out) :: last + integer, intent(out) :: next + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: wrk_date, wrk_sec + integer :: tcnt, n + real(r8) :: wrk_time + + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + wrk_sec = ncsec + select case( flbc_timing%type ) + case( 'SERIAL' ) + wrk_date = ncdate + case( 'CYCLICAL' ) + wrk_date = flbc_timing%cycle_yr*10000 + mod( ncdate,10000 ) + case( 'FIXED' ) + wrk_date = flbc_timing%fixed_ymd + wrk_sec = flbc_timing%fixed_tod + end select + + wrk_time = flt_date( wrk_date, wrk_sec ) + + !-------------------------------------------------------- + ! ... set time interpolation factor + !-------------------------------------------------------- + if( flbc_timing%type /= 'CYCLICAL' ) then + do n = tim_ndx(1)+1,tim_ndx(2) + if( wrk_time <= times(n) ) then + last = n - 1 + next = n + exit + end if + end do + if( n > ntimes ) then + write(iulog,*) 'flbc_set: interp time is out of bounds' + call endrun + end if + dels = (wrk_time - times(last))/(times(next) - times(last)) + ! write(iulog,*) ' ' + ! write(iulog,*) 'flbc_set: last,next,dels,ncdate,ncsec = ',last,next,dels,ncdate,ncsec + else + tcnt = tim_ndx(2) - tim_ndx(1) + 1 + call findplb( times(tim_ndx(1)), tcnt, wrk_time, n ) + if( n < tcnt ) then + last = tim_ndx(1) + n - 1 + next = last + 1 + dels = (wrk_time - times(last))/(times(next) - times(last)) + else + next = tim_ndx(1) + last = tim_ndx(2) + dels = wrk_time - times(last) + if( dels < 0._r8 ) then + dels = 365._r8 + dels + end if + dels = dels/(365._r8 + times(next) - times(last)) + end if + ! write(iulog,*) ' ' + ! write(iulog,*) 'flbc_set: last,next,dels,ncdate,ncsec = ',last,next,dels,ncdate,ncsec + end if + + dels = max( min( 1._r8,dels ),0._r8 ) + + end subroutine get_dels + + subroutine flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + + implicit none + + real(r8), intent(inout) :: co2vmr + real(r8), intent(inout) :: ch4vmr + real(r8), intent(inout) :: n2ovmr + real(r8), intent(inout) :: f11vmr + real(r8), intent(inout) :: f12vmr + + integer :: last, next + real(r8) :: dels + + if( flbc_cnt < 1 ) return + + call get_dels( dels, last, next ) + + if (ghg_indices(co2_ndx)>0) & + co2vmr = global_mean_vmr(flbcs(ghg_indices(co2_ndx)), dels, last, next ) + if (ghg_indices(ch4_ndx)>0) & + ch4vmr = global_mean_vmr(flbcs(ghg_indices(ch4_ndx)), dels, last, next ) + if (ghg_indices(n2o_ndx)>0) & + n2ovmr = global_mean_vmr(flbcs(ghg_indices(n2o_ndx)), dels, last, next ) + if (ghg_indices(f11_ndx)>0) then + f11vmr = global_mean_vmr(flbcs(ghg_indices(f11_ndx)), dels, last, next ) + elseif (ghg_indices(f11eq_ndx)>0) then + f11vmr = global_mean_vmr(flbcs(ghg_indices(f11eq_ndx)), dels, last, next ) + endif + if (ghg_indices(f12_ndx)>0) & + f12vmr = global_mean_vmr(flbcs(ghg_indices(f12_ndx)), dels, last, next ) + + end subroutine flbc_gmean_vmr + + function global_mean_vmr( flbcs, dels, last, next ) + use gmean_mod, only: gmean + use phys_grid, only: get_ncols_p + + implicit none + + type(flbc), intent(in) :: flbcs + real(r8), intent(in) :: dels + integer, intent(in) :: last + integer, intent(in) :: next + real(r8) :: global_mean_vmr + real(r8) :: vmr_arr(pcols,begchunk:endchunk) + + integer :: lchnk, ncol !, n + + if (flbcs%has_mean) then + global_mean_vmr = flbcs%vmr_mean(last) & + + dels * (flbcs%vmr_mean(next) - flbcs%vmr_mean(last)) + else + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + vmr_arr(:ncol,lchnk) = flbcs%vmr(:ncol,lchnk,last) & + + dels * (flbcs%vmr(:ncol,lchnk,next) - flbcs%vmr(:ncol,lchnk,last)) + enddo + call gmean (vmr_arr, global_mean_vmr) + endif + + endfunction global_mean_vmr + +end module mo_flbc diff --git a/src/chemistry/utils/mo_msis_ubc.F90 b/src/chemistry/utils/mo_msis_ubc.F90 new file mode 100644 index 0000000000..e0b46c2c2c --- /dev/null +++ b/src/chemistry/utils/mo_msis_ubc.F90 @@ -0,0 +1,284 @@ + + + module mo_msis_ubc +!--------------------------------------------------------------- +! ... msis upper bndy values +!--------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst + + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_history, only: addfld, horiz_only, outfld + + implicit none + + private + public :: msis_ubc_inti, get_msis_ubc, msis_timestep_init + + save + + integer :: ndx_n, ndx_h, ndx_o, ndx_o2 ! n, h, o, o2 spc indicies + integer :: msis_cnt = 0 ! count of msis species in simulation + integer :: ndx(pcnst) = -1 + real(r8), allocatable :: msis_ubc(:,:,:) ! module array for msis ub values (kg/kg) + + logical :: zonal_average = .false. ! use zonal averaged tgcm values + + contains + + subroutine msis_ubc_inti( zonal_avg ) +!------------------------------------------------------------------ +! ... initialize upper boundary values +!------------------------------------------------------------------ + + use ppgrid, only : pcols, begchunk, endchunk + use constituents, only : cnst_get_ind, cnst_fixed_ubc + + implicit none + +!------------------------------------------------------------------ +! ... dummy args +!------------------------------------------------------------------ + logical, intent(in) :: & + zonal_avg ! zonal averaging switch + +!------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------ + integer :: astat + real(r8) :: msis_switches(25) = 1._r8 + + zonal_average = zonal_avg +!------------------------------------------------------------------ +! ... check for msis species in simuation +!------------------------------------------------------------------ + call cnst_get_ind( 'H', ndx_h, abort=.false. ) + if( ndx_h > 0 ) then + if( cnst_fixed_ubc(ndx_h) ) then + ndx(ndx_h) = ndx_h + end if + end if + call cnst_get_ind( 'N', ndx_n, abort=.false. ) + if( ndx_n > 0 ) then + if( cnst_fixed_ubc(ndx_n) ) then + ndx(ndx_n) = ndx_n + end if + end if + call cnst_get_ind( 'O', ndx_o, abort=.false. ) + if( ndx_o > 0 ) then + if( cnst_fixed_ubc(ndx_o) ) then + ndx(ndx_o) = ndx_o + end if + end if + call cnst_get_ind( 'O2', ndx_o2, abort=.false. ) + if( ndx_o2 > 0 ) then + if( cnst_fixed_ubc(ndx_o2) ) then + ndx(ndx_o2) = ndx_o2 + end if + end if + +!------------------------------------------------------------------ +! ... allocate msis ubc array +!------------------------------------------------------------------ + msis_cnt = count( ndx(:) /= -1 ) + allocate( msis_ubc(pcols,6,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'msis_ubc_inti: failed to allocate msis_ubc; error = ',astat + call endrun + end if + + if( zonal_average ) then + msis_switches(7:8) = 0._r8 + msis_switches(10:14) = 0._r8 + end if + +!------------------------------------------------------------------ +! ... initialize msis switches +!------------------------------------------------------------------ + call tselec( msis_switches ) + + call addfld( 'MSIS_T', horiz_only, 'A', 'K', 'T upper boundary condition from MSIS') + call addfld( 'MSIS_H', horiz_only, 'A', 'kg/kg', 'H upper boundary condition from MSIS') + call addfld( 'MSIS_O', horiz_only, 'A', 'kg/kg', 'O upper boundary condition from MSIS') + call addfld( 'MSIS_O2',horiz_only, 'A', 'kg/kg', 'O2 upper boundary condition from MSIS') + + end subroutine msis_ubc_inti + + subroutine msis_timestep_init( ap, f107p_in, f107a_in ) +!-------------------------------------------------------------------- +! ... get the upper boundary values for h, n, o, o2 and temp +!-------------------------------------------------------------------- + + use ppgrid, only : pcols, begchunk, endchunk + use constituents, only : cnst_mw + use time_manager, only : get_curr_date, get_calday, get_curr_calday + use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p + use ref_pres, only : ptop_ref + use spmd_utils, only : masterproc + use physconst, only : pi + use cam_control_mod,only : lambm0, eccen, mvelpp, obliqr + use shr_orb_mod, only : shr_orb_decl + + implicit none + +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), intent(in) :: ap + real(r8), intent(in) :: f107p_in ! previous day + real(r8), intent(in) :: f107a_in + +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8), parameter :: mass_switch = 48._r8 + real(r8), parameter :: pa2mb = 1.e-2_r8 ! pascal to mb + real(r8), parameter :: amu_fac = 1.65979e-24_r8 ! g/amu + real(r8), parameter :: r2d = 180._r8/pi + integer :: i, c, ncol + integer :: yr, mon, day, tod + integer :: yrday + integer :: date + real(r8) :: alt, solar_time, ut, rtod, doy + real(r8) :: msis_press + real(r8) :: msis_ap(7) + real(r8) :: msis_temp(2) + real(r8) :: msis_conc(9) + real(r8) :: rlons(pcols) + real(r8) :: rlats(pcols) + real(r8) :: dnom(pcols) + real(r8) :: pint(pcols) ! top interface pressure (Pa) + real(r8) :: calday, delta, esfact + real(r8) :: f107p, f107a + + !-------------------------------------------------------------------- + ! ... get values from msis + !-------------------------------------------------------------------- + + call get_curr_date( yr, mon, day, tod ) + tod = 0 + rtod = tod + ut = rtod/3600._r8 + date = 10000*yr + 100*mon + day + doy = get_calday( date, tod ) + msis_ap(:) = 0._r8 + msis_ap(1) = ap + pint(:) = ptop_ref + + calday = get_curr_calday() + + esfact = 1._r8 + call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, delta, esfact ) + + f107p = esfact*f107p_in + f107a = esfact*f107a_in + +#ifdef MSIS_DIAGS + if( masterproc ) then + write(iulog,*) '====================================' + write(iulog,*) 'msis_timestep_init: diagnostics' + write(iulog,*) 'yr,mon,day,tod,date,ut,doy,esfact = ', yr, mon, day, tod, date, ut, doy, esfact + write(iulog,*) '====================================' + end if +#endif + chunk_loop : do c = begchunk,endchunk + ncol = get_ncols_p( c ) + call get_rlat_all_p( c, ncol, rlats ) + call get_rlon_all_p( c, ncol, rlons ) + rlons(:ncol) = r2d * rlons(:ncol) + rlats(:ncol) = r2d * rlats(:ncol) + yrday = mod( yr,100 ) * 1000 + int( doy ) + column_loop : do i = 1,ncol + solar_time = ut + rlons(i)/15._r8 + msis_press = pint(i)*pa2mb + call ghp7( yrday, rtod, alt, rlats(i), rlons(i), & + solar_time, f107a, f107p, msis_ap, msis_conc, & + msis_temp, msis_press ) + msis_ubc(i,1,c) = msis_temp(2) ! temp (K) +#ifdef MSIS_DIAGS + write(iulog,*) '====================================' + write(iulog,*) 'msis_timestep_init: diagnostics for col,chnk = ',i,c + write(iulog,*) 'yrday, rtod, alt,press = ',yrday,rtod,alt,msis_press + write(iulog,*) 'msis_temp = ',msis_temp(2) +#endif + if( msis_cnt > 0 ) then + msis_ubc(i,2,c) = msis_conc(7) ! h (molec/cm^3) + msis_ubc(i,3,c) = msis_conc(8) ! n (molec/cm^3) + msis_ubc(i,4,c) = msis_conc(2) ! o (molec/cm^3) + msis_ubc(i,5,c) = msis_conc(4) ! o2 (molec/cm^3) + msis_ubc(i,6,c) = msis_conc(6) ! total atm dens (g/cm^3) + end if +#ifdef MSIS_DIAGS + write(iulog,*) 'msis h,n,o,o2,m = ',msis_ubc(i,2:6,c) + write(iulog,*) '====================================' +#endif + end do column_loop + !-------------------------------------------------------------------- + ! ... transform from molecular density to mass mixing ratio + !-------------------------------------------------------------------- + if( msis_cnt > 0 ) then + dnom(:ncol) = amu_fac/msis_ubc(:ncol,6,c) + if( ndx(ndx_h) > 0 ) then + msis_ubc(:ncol,2,c) = cnst_mw(ndx_h)*msis_ubc(:ncol,2,c)*dnom(:ncol) + end if + if( ndx(ndx_n) > 0 ) then + msis_ubc(:ncol,3,c) = cnst_mw(ndx_n)*msis_ubc(:ncol,3,c)*dnom(:ncol) + end if + if( ndx(ndx_o) > 0 ) then + msis_ubc(:ncol,4,c) = cnst_mw(ndx_o)*msis_ubc(:ncol,4,c)*dnom(:ncol) + end if + if( ndx(ndx_o2) > 0 ) then + msis_ubc(:ncol,5,c) = cnst_mw(ndx_o2)*msis_ubc(:ncol,5,c)*dnom(:ncol) + end if + end if + end do chunk_loop + + end subroutine msis_timestep_init + + subroutine get_msis_ubc( lchunk, ncol, temp, mmr ) +!-------------------------------------------------------------------- +! ... get the upper boundary values for h, n, o, o2 and temp +!-------------------------------------------------------------------- + + use ppgrid, only : pcols + + implicit none + +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: lchunk ! chunk id + integer, intent(in) :: ncol ! columns in chunk + real(r8), intent(inout) :: temp(pcols) ! msis temperature at top interface (K) + real(r8), intent(inout) :: mmr(pcols,pcnst) ! msis concentrations at top interface (kg/kg) + +!-------------------------------------------------------------------- +! ... set model ubc values from msis +!-------------------------------------------------------------------- + temp(:ncol) = msis_ubc(:ncol,1,lchunk) + + call outfld( 'MSIS_T', msis_ubc(:ncol,1,lchunk), ncol, lchunk) + call outfld( 'MSIS_H', msis_ubc(:ncol,2,lchunk), ncol, lchunk) + call outfld( 'MSIS_O', msis_ubc(:ncol,3,lchunk), ncol, lchunk) + call outfld( 'MSIS_O2',msis_ubc(:ncol,4,lchunk), ncol, lchunk) + + if( msis_cnt > 0 ) then + if( ndx(ndx_h) > 0 ) then + mmr(:ncol,ndx_h) = msis_ubc(:ncol,2,lchunk) + end if + if( ndx(ndx_n) > 0 ) then + mmr(:ncol,ndx_n) = msis_ubc(:ncol,3,lchunk) + end if + if( ndx(ndx_o) > 0 ) then + mmr(:ncol,ndx_o) = msis_ubc(:ncol,4,lchunk) + end if + if( ndx(ndx_o2) > 0 ) then + mmr(:ncol,ndx_o2) = msis_ubc(:ncol,5,lchunk) + end if + end if + + end subroutine get_msis_ubc + + end module mo_msis_ubc diff --git a/src/chemistry/utils/mo_util.F90 b/src/chemistry/utils/mo_util.F90 new file mode 100644 index 0000000000..42ea6f4097 --- /dev/null +++ b/src/chemistry/utils/mo_util.F90 @@ -0,0 +1,81 @@ +module mo_util + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: rebin + +contains + + subroutine rebin( nsrc, ntrg, src_x, trg_x, src, trg ) + !--------------------------------------------------------------- + ! ... rebin src to trg + !--------------------------------------------------------------- + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: trg_x(ntrg+1) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + integer :: i, l + integer :: si, si1 + integer :: sil, siu + real(r8) :: y + real(r8) :: sl, su + real(r8) :: tl, tu + + !--------------------------------------------------------------- + ! ... check interval overlap + !--------------------------------------------------------------- + ! if( trg_x(1) < src_x(1) .or. trg_x(ntrg+1) > src_x(nsrc+1) ) then + ! write(iulog,*) 'rebin: target grid is outside source grid' + ! write(iulog,*) ' target grid from ',trg_x(1),' to ',trg_x(ntrg+1) + ! write(iulog,*) ' source grid from ',src_x(1),' to ',src_x(nsrc+1) + ! call endrun + ! end if + + do i = 1,ntrg + tl = trg_x(i) + if( tl < src_x(nsrc+1) ) then + do sil = 1,nsrc+1 + if( tl <= src_x(sil) ) then + exit + end if + end do + tu = trg_x(i+1) + do siu = 1,nsrc+1 + if( tu <= src_x(siu) ) then + exit + end if + end do + y = 0._r8 + sil = max( sil,2 ) + siu = min( siu,nsrc+1 ) + do si = sil,siu + si1 = si - 1 + sl = max( tl,src_x(si1) ) + su = min( tu,src_x(si) ) + y = y + (su - sl)*src(si1) + end do + trg(i) = y/(trg_x(i+1) - trg_x(i)) + else + trg(i) = 0._r8 + end if + end do + + end subroutine rebin + + +end module mo_util diff --git a/src/chemistry/utils/modal_aero_calcsize.F90 b/src/chemistry/utils/modal_aero_calcsize.F90 new file mode 100644 index 0000000000..7fcb00390e --- /dev/null +++ b/src/chemistry/utils/modal_aero_calcsize.F90 @@ -0,0 +1,1589 @@ +module modal_aero_calcsize + +! RCE 07.04.13: Adapted from MIRAGE2 code + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use physconst, only: pi, rhoh2o, gravit + +use ppgrid, only: pcols, pver +use physics_types, only: physics_state, physics_ptend +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field + +use phys_control, only: phys_getopts +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & + rad_cnst_get_mode_props, rad_cnst_get_mode_num + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use cam_history, only: addfld, add_default, fieldname_len, horiz_only, outfld +use constituents, only: pcnst, cnst_name +use modal_aero_wateruptake, only: modal_strat_sulfate + +use ref_pres, only: top_lev => clim_modal_aero_top_lev + +#ifdef MODAL_AERO + +! these are the variables needed for the diagnostic calculation of dry radius +use modal_aero_data, only: ntot_amode, nspec_amode, nspec_max, & + numptr_amode, & + alnsg_amode, & + voltonumbhi_amode, voltonumblo_amode, & + dgnum_amode, dgnumhi_amode, dgnumlo_amode + + +! these variables are needed for the prognostic calculations to exchange mass +! between modes +use modal_aero_data, only: numptrcw_amode, mprognum_amode, qqcw_get_field, lmassptrcw_amode, & + lmassptr_amode, modeptr_accum, modeptr_aitken, & + specmw_amode, specdens_amode, voltonumb_amode, & + cnst_name_cw + +use modal_aero_rename, only: lspectooa_renamexf, lspecfrma_renamexf, lspectooc_renamexf, lspecfrmc_renamexf, & + modetoo_renamexf, nspecfrm_renamexf, npair_renamexf, modefrm_renamexf + + +#endif + + +implicit none +private +save + +public modal_aero_calcsize_init, modal_aero_calcsize_sub, modal_aero_calcsize_diag +public :: modal_aero_calcsize_reg + +logical :: do_adjust_default +logical :: do_aitacc_transfer_default + +integer :: dgnum_idx = -1 +integer :: hygro_idx = -1 +integer :: dryvol_idx = -1 +integer :: dryrad_idx = -1 +integer :: drymass_idx = -1 +integer :: so4dryvol_idx = -1 +integer :: naer_idx = -1 +integer :: sulfeq_idx = -1 + + +!=============================================================================== +contains +!=============================================================================== + +subroutine modal_aero_calcsize_reg() + use physics_buffer, only: pbuf_add_field, dtype_r8 + use rad_constituents, only: rad_cnst_get_info + + integer :: nmodes + + call rad_cnst_get_info(0, nmodes=nmodes) + + call pbuf_add_field('DGNUM', 'global', dtype_r8, (/pcols, pver, nmodes/), dgnum_idx) + + call pbuf_add_field('HYGRO', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), hygro_idx) + call pbuf_add_field('DRYVOL', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), dryvol_idx) + call pbuf_add_field('DRYRAD', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), dryrad_idx) + call pbuf_add_field('DRYMASS', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), drymass_idx) + call pbuf_add_field('SO4DRYVOL', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), so4dryvol_idx) + call pbuf_add_field('NAER', 'phys_pkg', dtype_r8, (/pcols,pver,nmodes/), naer_idx) + +end subroutine modal_aero_calcsize_reg + +!=============================================================================== +!=============================================================================== + +subroutine modal_aero_calcsize_init(pbuf2d) + use time_manager, only: is_first_step + use physics_buffer,only: pbuf_set_field + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! set do_adjust_default and do_aitacc_transfer_default flags + ! create history fields for column tendencies associated with + ! modal_aero_calcsize + ! + ! Author: R. Easter + ! + !----------------------------------------------------------------------- + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local + integer :: ipair, iq + integer :: jac + integer :: lsfrm, lstoo + integer :: n, nacc, nait + logical :: history_aerosol + + character(len=fieldname_len) :: tmpnamea, tmpnameb + character(len=fieldname_len+3) :: fieldname + character(128) :: long_name + character(8) :: unit + !----------------------------------------------------------------------- + + call phys_getopts(history_aerosol_out=history_aerosol) + + ! init entities required for both prescribed and prognostic modes + + if (is_first_step()) then + ! initialize fields in physics buffer + call pbuf_set_field(pbuf2d, dgnum_idx, 0.0_r8) + endif + +#ifndef MODAL_AERO + do_adjust_default = .false. + do_aitacc_transfer_default = .false. +#else + ! do_adjust_default allows adjustment to be turned on/off + do_adjust_default = .true. + + ! do_aitacc_transfer_default allows aitken <--> accum mode transfer to be turned on/off + ! *** it can only be true when aitken & accum modes are both present + ! and have prognosed number and diagnosed surface/sigmag + nait = modeptr_aitken + nacc = modeptr_accum + do_aitacc_transfer_default = .false. + if ((modeptr_aitken > 0) .and. & + (modeptr_accum > 0) .and. & + (modeptr_aitken /= modeptr_accum)) then + do_aitacc_transfer_default = .true. + if (mprognum_amode(nait) <= 0) do_aitacc_transfer_default = .false. + if (mprognum_amode(nacc) <= 0) do_aitacc_transfer_default = .false. + end if + + if ( .not. do_adjust_default ) return + + ! define history fields for number-adjust source-sink for all modes + do n = 1, ntot_amode + if (mprognum_amode(n) <= 0) cycle + + do jac = 1, 2 + if (jac == 1) then + tmpnamea = cnst_name(numptr_amode(n)) + else + tmpnamea = cnst_name_cw(numptrcw_amode(n)) + end if + unit = '#/m2/s' + fieldname = trim(tmpnamea) // '_sfcsiz1' + long_name = trim(tmpnamea) // ' calcsize number-adjust column source' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + + fieldname = trim(tmpnamea) // '_sfcsiz2' + long_name = trim(tmpnamea) // ' calcsize number-adjust column sink' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + end do ! jac = ... + end do ! n = ... + + if ( .not. do_aitacc_transfer_default ) return + + ! check that renaming ipair=1 is aitken-->accum + ipair = 1 + if ((modefrm_renamexf(ipair) .ne. nait) .or. & + (modetoo_renamexf(ipair) .ne. nacc)) then + write( 6, '(//2a//)' ) & + '*** modal_aero_calcaersize_init error -- ', & + 'modefrm/too_renamexf(1) are wrong' + call endrun( 'modal_aero_calcaersize_init error' ) + end if + + ! define history fields for aitken-accum transfer + do iq = 1, nspecfrm_renamexf(ipair) + + ! jac=1 does interstitial ("_a"); jac=2 does activated ("_c"); + do jac = 1, 2 + + ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species + ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species + if (jac .eq. 1) then + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + else + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + end if + if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle + + if (jac .eq. 1) then + tmpnamea = cnst_name(lsfrm) + tmpnameb = cnst_name(lstoo) + else + tmpnamea = cnst_name_cw(lsfrm) + tmpnameb = cnst_name_cw(lstoo) + end if + + unit = 'kg/m2/s' + if ((tmpnamea(1:3) == 'num') .or. & + (tmpnamea(1:3) == 'NUM')) unit = '#/m2/s' + fieldname = trim(tmpnamea) // '_sfcsiz3' + long_name = trim(tmpnamea) // ' calcsize aitken-to-accum adjust column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + + fieldname = trim(tmpnameb) // '_sfcsiz3' + long_name = trim(tmpnameb) // ' calcsize aitken-to-accum adjust column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + + fieldname = trim(tmpnamea) // '_sfcsiz4' + long_name = trim(tmpnamea) // ' calcsize accum-to-aitken adjust column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + + fieldname = trim(tmpnameb) // '_sfcsiz4' + long_name = trim(tmpnameb) // ' calcsize accum-to-aitken adjust column tendency' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if (history_aerosol) then + call add_default(fieldname, 1, ' ') + end if + if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname + + end do ! jac = ... + end do ! iq = ... + +#endif + +end subroutine modal_aero_calcsize_init + +!=============================================================================== + +subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, & + do_aitacc_transfer_in) + + !----------------------------------------------------------------------- + ! + ! Calculates aerosol size distribution parameters + ! mprognum_amode > 0 + ! calculate Dgnum from mass, number, and fixed sigmag + ! mprognum_amode <= 0 + ! calculate number from mass, fixed Dgnum, and fixed sigmag + ! + ! Also (optionally) adjusts prognostic number to + ! be within bounds determined by mass, Dgnum bounds, and sigma bounds + ! + ! Author: R. Easter + ! + !----------------------------------------------------------------------- + + ! arguments + type(physics_state), target, intent(in) :: state ! Physics state variables + + type(physics_ptend), target, intent(inout) :: ptend ! indivdual parameterization tendencies + + real(r8), intent(in) :: deltat ! model time-step size (s) + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + logical, optional :: do_adjust_in + logical, optional :: do_aitacc_transfer_in + +#ifdef MODAL_AERO + + ! local + + logical :: do_adjust + logical :: do_aitacc_transfer + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns + + real(r8), pointer :: t(:,:) ! Temperature in Kelvin + real(r8), pointer :: pmid(:,:) ! pressure at model levels (Pa) + real(r8), pointer :: pdel(:,:) ! pressure thickness of levels + real(r8), pointer :: q(:,:,:) ! Tracer MR array + + logical, pointer :: dotend(:) ! flag for doing tendency + real(r8), pointer :: dqdt(:,:,:) ! TMR tendency array + + real(r8), pointer :: dgncur_a(:,:,:) + + integer :: i, icol_diag, iduma, ipair, iq + integer :: ixfer_acc2ait, ixfer_ait2acc + integer :: ixfer_acc2ait_sv(pcols,pver), ixfer_ait2acc_sv(pcols,pver) + integer :: j, jac, jsrflx, k + integer :: l, l1, la, lc, lna, lnc, lsfrm, lstoo + integer :: n, nacc, nait + + integer, save :: idiagaa = 1 + + logical :: dotendqqcw(pcnst) + logical :: noxf_acc2ait(nspec_max) + + character(len=fieldname_len) :: tmpnamea, tmpnameb + character(len=fieldname_len+3) :: fieldname + + real(r8), parameter :: third = 1.0_r8/3.0_r8 + real(r8), pointer :: fldcw(:,:) + real(r8) :: delnum_a2, delnum_c2 ! work variables + real(r8) :: delnum_a3, delnum_c3, delnum_t3 ! work variables + real(r8) :: deltatinv ! 1/deltat + real(r8) :: dgncur_c(pcols,pver,ntot_amode) + real(r8) :: dgnyy, dgnxx ! dgnumlo/hi of current mode + real(r8) :: dqqcwdt(pcols,pver,pcnst) ! cloudborne TMR tendency array + real(r8) :: drv_a, drv_c, drv_t ! dry volume (cm3/mol_air) + real(r8) :: drv_t0 + real(r8) :: drv_a_noxf, drv_c_noxf, drv_t_noxf + real(r8) :: drv_a_acc, drv_c_acc + real(r8) :: drv_a_accsv(pcols,pver), drv_c_accsv(pcols,pver) + real(r8) :: drv_a_aitsv(pcols,pver), drv_c_aitsv(pcols,pver) + real(r8) :: drv_a_sv(pcols,pver,ntot_amode), drv_c_sv(pcols,pver,ntot_amode) + real(r8) :: dryvol_a(pcols,pver) ! interstital aerosol dry + ! volume (cm^3/mol_air) + real(r8) :: dryvol_c(pcols,pver) ! activated aerosol dry volume + real(r8) :: duma, dumb, dumc, dumd ! work variables + real(r8) :: dumfac, dummwdens ! work variables + real(r8) :: frelaxadj ! relaxation factor applied + ! to size bounds + real(r8) :: fracadj ! deltat/tadj + real(r8) :: num_a0, num_c0, num_t0 ! initial number (#/mol_air) + real(r8) :: num_a1, num_c1 ! working number (#/mol_air) + real(r8) :: num_a2, num_c2, num_t2 ! working number (#/mol_air) + real(r8) :: num_a, num_c, num_t ! final number (#/mol_air) + real(r8) :: num_t_noxf + real(r8) :: numbnd ! bounded number + real(r8) :: num_a_acc, num_c_acc + real(r8) :: num_a_accsv(pcols,pver), num_c_accsv(pcols,pver) + real(r8) :: num_a_aitsv(pcols,pver), num_c_aitsv(pcols,pver) + real(r8) :: num_a_sv(pcols,pver,ntot_amode), num_c_sv(pcols,pver,ntot_amode) + real(r8) :: pdel_fac ! + real(r8) :: tadj ! adjustment time scale + real(r8) :: tadjinv ! 1/tadj + real(r8) :: v2ncur_a(pcols,pver,ntot_amode) + real(r8) :: v2ncur_c(pcols,pver,ntot_amode) + real(r8) :: v2nyy, v2nxx, v2nzz ! voltonumblo/hi of current mode + real(r8) :: v2nyyrl, v2nxxrl ! relaxed voltonumblo/hi + real(r8) :: xfercoef + real(r8) :: xfercoef_num_acc2ait, xfercoef_vol_acc2ait + real(r8) :: xfercoef_num_ait2acc, xfercoef_vol_ait2acc + real(r8) :: xferfrac_num_acc2ait, xferfrac_vol_acc2ait + real(r8) :: xferfrac_num_ait2acc, xferfrac_vol_ait2acc + real(r8) :: xfertend, xfertend_num(2,2) + + integer, parameter :: nsrflx = 4 ! last dimension of qsrflx + real(r8) :: qsrflx(pcols,pcnst,nsrflx,2) + ! process-specific column tracer tendencies + ! 3rd index -- + ! 1="standard" number adjust gain; + ! 2="standard" number adjust loss; + ! 3=aitken-->accum renaming; 4=accum-->aitken) + ! 4th index -- + ! 1="a" species; 2="c" species + !----------------------------------------------------------------------- + + if (present(do_adjust_in)) then + do_adjust = do_adjust_in + else + do_adjust = do_adjust_default + end if + + if (present(do_aitacc_transfer_in)) then + do_aitacc_transfer = do_aitacc_transfer_in + else + do_aitacc_transfer = do_aitacc_transfer_default + end if + + lchnk = state%lchnk + ncol = state%ncol + + t => state%t + pmid => state%pmid + pdel => state%pdel + q => state%q + + dotend => ptend%lq + dqdt => ptend%q + + call pbuf_get_field(pbuf, dgnum_idx, dgncur_a) + + dotendqqcw(:) = .false. + dqqcwdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:,:) = 0.0_r8 + + nait = modeptr_aitken + nacc = modeptr_accum + + deltatinv = 1.0_r8/(deltat*(1.0_r8 + 1.0e-15_r8)) + ! tadj = adjustment time scale for number, surface when they are prognosed + ! currently set to deltat + tadj = deltat + tadj = 86400 + tadj = max( tadj, deltat ) + tadjinv = 1.0_r8/(tadj*(1.0_r8 + 1.0e-15_r8)) + fracadj = deltat*tadjinv + fracadj = max( 0.0_r8, min( 1.0_r8, fracadj ) ) + + + ! + ! + ! the "do 40000" loop does the original (pre jan-2006) + ! number adjustment, one mode at a time + ! this artificially adjusts number when mean particle size is too large + ! or too small + ! + ! + do n = 1, ntot_amode + + + ! initialize all parameters to the default values for the mode + do k=top_lev,pver + do i=1,ncol + ! sgcur_a(i,k,n) = sigmag_amode(n) + ! sgcur_c(i,k,n) = sigmag_amode(n) + dgncur_a(i,k,n) = dgnum_amode(n) + dgncur_c(i,k,n) = dgnum_amode(n) + v2ncur_a(i,k,n) = voltonumb_amode(n) + v2ncur_c(i,k,n) = voltonumb_amode(n) + dryvol_a(i,k) = 0.0_r8 + dryvol_c(i,k) = 0.0_r8 + end do + end do + + ! compute dry volume mixrats = + ! sum_over_components{ component_mass mixrat / density } + do l1 = 1, nspec_amode(n) + ! need qmass*dummwdens = (kg/kg-air) * [1/(kg/m3)] = m3/kg-air + dummwdens = 1.0_r8 / specdens_amode(l1,n) + la = lmassptr_amode(l1,n) + do k=top_lev,pver + do i=1,ncol + dryvol_a(i,k) = dryvol_a(i,k) & + + max(0.0_r8,q(i,k,la))*dummwdens + end do + end do + + fldcw => qqcw_get_field(pbuf,lmassptrcw_amode(l1,n),lchnk) + do k=top_lev,pver + do i=1,ncol + dryvol_c(i,k) = dryvol_c(i,k) & + + max(0.0_r8,fldcw(i,k))*dummwdens + end do + end do + end do + + ! set "short-hand" number pointers + lna = numptr_amode(n) + lnc = numptrcw_amode(n) + fldcw => qqcw_get_field(pbuf,numptrcw_amode(n),lchnk,.true.) + + + ! go to section for appropriate number/surface diagnosed/prognosed options + if (mprognum_amode(n) <= 0) then + + ! option 1 -- number diagnosed (fixed dgnum and sigmag) + ! compute number tendencies that will bring numbers to their + ! current diagnosed values + ! + if (lna > 0) then + dotend(lna) = .true. + do k=top_lev,pver + do i=1,ncol + dqdt(i,k,lna) = (dryvol_a(i,k)*voltonumb_amode(n) & + - q(i,k,lna)) * deltatinv + end do + end do + end if + if (lnc > 0) then + dotendqqcw(lnc) = .true. + do k=top_lev,pver + do i=1,ncol + dqqcwdt(i,k,lnc) = (dryvol_c(i,k)*voltonumb_amode(n) & + - fldcw(i,k)) * deltatinv + end do + end do + end if + else + + + ! + ! option 2 -- number prognosed (variable dgnum, fixed sigmag) + ! Compute number tendencies to adjust numbers if they are outside + ! the limits determined by current volume and dgnumlo/hi + ! The interstitial and activated aerosol fractions can, at times, + ! be the lower or upper tail of the "total" distribution. Thus they + ! can be expected to have a greater range of size parameters than + ! what is specified for the total distribution (via dgnumlo/hi) + ! When both the interstitial and activated dry volumes are positive, + ! the adjustment strategy is to (1) adjust the interstitial and activated + ! numbers towards relaxed bounds, then (2) adjust the total/combined + ! number towards the primary bounds. + ! + ! note + ! v2nyy = voltonumblo_amode is proportional to dgnumlo**(-3), + ! and produces the maximum allowed number for a given volume + ! v2nxx = voltonumbhi_amode is proportional to dgnumhi**(-3), + ! and produces the minimum allowed number for a given volume + ! v2nxxrl and v2nyyrl are their "relaxed" equivalents. + ! Setting frelaxadj=27=3**3 means that + ! dgnumlo_relaxed = dgnumlo/3 and dgnumhi_relaxed = dgnumhi*3 + ! + ! if do_aitacc_transfer is .true., then + ! for n=nacc, multiply v2nyy by 1.0e6 to effectively turn off the + ! adjustment when number is too big (size is too small) + ! for n=nait, divide v2nxx by 1.0e6 to effectively turn off the + ! adjustment when number is too small (size is too big) + !OLD however, do not change the v2nyyrl/v2nxxrl so that + !OLD the interstitial<-->activated adjustment is not changed + !NEW also change the v2nyyrl/v2nxxrl so that + !NEW the interstitial<-->activated adjustment is turned off + ! + end if + frelaxadj = 27.0_r8 + dumfac = exp(4.5_r8*alnsg_amode(n)**2)*pi/6.0_r8 + v2nxx = voltonumbhi_amode(n) + v2nyy = voltonumblo_amode(n) + v2nxxrl = v2nxx/frelaxadj + v2nyyrl = v2nyy*frelaxadj + dgnxx = dgnumhi_amode(n) + dgnyy = dgnumlo_amode(n) + if ( do_aitacc_transfer ) then + if (n == nait) v2nxx = v2nxx/1.0e6_r8 + if (n == nacc) v2nyy = v2nyy*1.0e6_r8 + v2nxxrl = v2nxx/frelaxadj ! NEW + v2nyyrl = v2nyy*frelaxadj ! NEW + end if + + if (do_adjust) then + dotend(lna) = .true. + dotendqqcw(lnc) = .true. + end if + + do k = top_lev, pver + do i = 1, ncol + + drv_a = dryvol_a(i,k) + num_a0 = q(i,k,lna) + num_a = max( 0.0_r8, num_a0 ) + drv_c = dryvol_c(i,k) + num_c0 = fldcw(i,k) + num_c = max( 0.0_r8, num_c0 ) + + if ( do_adjust) then + + ! + ! do number adjustment for interstitial and activated particles + ! adjustments that (1) make numbers non-negative or (2) make numbers + ! zero when volume is zero are applied over time-scale deltat + ! adjustments that bring numbers to within specified bounds are + ! applied over time-scale tadj + ! + if ((drv_a <= 0.0_r8) .and. (drv_c <= 0.0_r8)) then + ! both interstitial and activated volumes are zero + ! adjust both numbers to zero + num_a = 0.0_r8 + dqdt(i,k,lna) = -num_a0*deltatinv + num_c = 0.0_r8 + dqqcwdt(i,k,lnc) = -num_c0*deltatinv + else if (drv_c <= 0.0_r8) then + ! activated volume is zero, so interstitial number/volume == total/combined + ! apply step 1 and 3, but skip the relaxed adjustment (step 2, see below) + num_c = 0.0_r8 + dqqcwdt(i,k,lnc) = -num_c0*deltatinv + num_a1 = num_a + numbnd = max( drv_a*v2nxx, min( drv_a*v2nyy, num_a1 ) ) + num_a = num_a1 + (numbnd - num_a1)*fracadj + dqdt(i,k,lna) = (num_a - num_a0)*deltatinv + + else if (drv_a <= 0.0_r8) then + ! interstitial volume is zero, treat similar to above + num_a = 0.0_r8 + dqdt(i,k,lna) = -num_a0*deltatinv + num_c1 = num_c + numbnd = max( drv_c*v2nxx, min( drv_c*v2nyy, num_c1 ) ) + num_c = num_c1 + (numbnd - num_c1)*fracadj + dqqcwdt(i,k,lnc) = (num_c - num_c0)*deltatinv + else + ! both volumes are positive + ! apply 3 adjustment steps + ! step1: num_a,c0 --> num_a,c1 forces non-negative values + num_a1 = num_a + num_c1 = num_c + ! step2: num_a,c1 --> num_a,c2 applies relaxed bounds to the interstitial + ! and activated number (individually) + ! if only only a or c changes, adjust the other in the opposite direction + ! as much as possible to conserve a+c + numbnd = max( drv_a*v2nxxrl, min( drv_a*v2nyyrl, num_a1 ) ) + delnum_a2 = (numbnd - num_a1)*fracadj + num_a2 = num_a1 + delnum_a2 + numbnd = max( drv_c*v2nxxrl, min( drv_c*v2nyyrl, num_c1 ) ) + delnum_c2 = (numbnd - num_c1)*fracadj + num_c2 = num_c1 + delnum_c2 + if ((delnum_a2 == 0.0_r8) .and. (delnum_c2 /= 0.0_r8)) then + num_a2 = max( drv_a*v2nxxrl, min( drv_a*v2nyyrl, & + num_a1-delnum_c2 ) ) + else if ((delnum_a2 /= 0.0_r8) .and. (delnum_c2 == 0.0_r8)) then + num_c2 = max( drv_c*v2nxxrl, min( drv_c*v2nyyrl, & + num_c1-delnum_a2 ) ) + end if + ! step3: num_a,c2 --> num_a,c3 applies stricter bounds to the + ! combined/total number + drv_t = drv_a + drv_c + num_t2 = num_a2 + num_c2 + delnum_a3 = 0.0_r8 + delnum_c3 = 0.0_r8 + if (num_t2 < drv_t*v2nxx) then + delnum_t3 = (drv_t*v2nxx - num_t2)*fracadj + ! if you are here then (num_a2 < drv_a*v2nxx) and/or + ! (num_c2 < drv_c*v2nxx) must be true + if ((num_a2 < drv_a*v2nxx) .and. (num_c2 < drv_c*v2nxx)) then + delnum_a3 = delnum_t3*(num_a2/num_t2) + delnum_c3 = delnum_t3*(num_c2/num_t2) + else if (num_c2 < drv_c*v2nxx) then + delnum_c3 = delnum_t3 + else if (num_a2 < drv_a*v2nxx) then + delnum_a3 = delnum_t3 + end if + else if (num_t2 > drv_t*v2nyy) then + delnum_t3 = (drv_t*v2nyy - num_t2)*fracadj + ! if you are here then (num_a2 > drv_a*v2nyy) and/or + ! (num_c2 > drv_c*v2nyy) must be true + if ((num_a2 > drv_a*v2nyy) .and. (num_c2 > drv_c*v2nyy)) then + delnum_a3 = delnum_t3*(num_a2/num_t2) + delnum_c3 = delnum_t3*(num_c2/num_t2) + else if (num_c2 > drv_c*v2nyy) then + delnum_c3 = delnum_t3 + else if (num_a2 > drv_a*v2nyy) then + delnum_a3 = delnum_t3 + end if + end if + num_a = num_a2 + delnum_a3 + dqdt(i,k,lna) = (num_a - num_a0)*deltatinv + num_c = num_c2 + delnum_c3 + dqqcwdt(i,k,lnc) = (num_c - num_c0)*deltatinv + end if + + end if ! do_adjust + + ! + ! now compute current dgn and v2n + ! + if (drv_a > 0.0_r8) then + if (num_a <= drv_a*v2nxx) then + dgncur_a(i,k,n) = dgnxx + v2ncur_a(i,k,n) = v2nxx + else if (num_a >= drv_a*v2nyy) then + dgncur_a(i,k,n) = dgnyy + v2ncur_a(i,k,n) = v2nyy + else + dgncur_a(i,k,n) = (drv_a/(dumfac*num_a))**third + v2ncur_a(i,k,n) = num_a/drv_a + end if + end if + pdel_fac = pdel(i,k)/gravit ! = rho*dz + jac = 1 + qsrflx(i,lna,1,jac) = qsrflx(i,lna,1,jac) + max(0.0_r8,dqdt(i,k,lna))*pdel_fac + qsrflx(i,lna,2,jac) = qsrflx(i,lna,2,jac) + min(0.0_r8,dqdt(i,k,lna))*pdel_fac + + if (drv_c > 0.0_r8) then + if (num_c <= drv_c*v2nxx) then + dgncur_c(i,k,n) = dgnumhi_amode(n) + v2ncur_c(i,k,n) = v2nxx + else if (num_c >= drv_c*v2nyy) then + dgncur_c(i,k,n) = dgnumlo_amode(n) + v2ncur_c(i,k,n) = v2nyy + else + dgncur_c(i,k,n) = (drv_c/(dumfac*num_c))**third + v2ncur_c(i,k,n) = num_c/drv_c + end if + end if + jac = 2 + qsrflx(i,lnc,1,jac) = qsrflx(i,lnc,1,jac) + max(0.0_r8,dqqcwdt(i,k,lnc))*pdel_fac + qsrflx(i,lnc,2,jac) = qsrflx(i,lnc,2,jac) + min(0.0_r8,dqqcwdt(i,k,lnc))*pdel_fac + + + ! save number and dryvol for aitken <--> accum renaming + if ( do_aitacc_transfer ) then + if (n == nait) then + drv_a_aitsv(i,k) = drv_a + num_a_aitsv(i,k) = num_a + drv_c_aitsv(i,k) = drv_c + num_c_aitsv(i,k) = num_c + else if (n == nacc) then + drv_a_accsv(i,k) = drv_a + num_a_accsv(i,k) = num_a + drv_c_accsv(i,k) = drv_c + num_c_accsv(i,k) = num_c + end if + end if + drv_a_sv(i,k,n) = drv_a + num_a_sv(i,k,n) = num_a + drv_c_sv(i,k,n) = drv_c + num_c_sv(i,k,n) = num_c + + end do + end do + + + ! + ! option 3 -- number and surface prognosed (variable dgnum and sigmag) + ! this is not implemented + ! + end do ! do n = 1, ntot_amode + + + ! + ! + ! the following section (from here to label 49000) + ! does aitken <--> accum mode transfer + ! + ! when the aitken mode mean size is too big, the largest + ! aitken particles are transferred into the accum mode + ! to reduce the aitken mode mean size + ! when the accum mode mean size is too small, the smallest + ! accum particles are transferred into the aitken mode + ! to increase the accum mode mean size + ! + ! + ixfer_ait2acc_sv(:,:) = 0 + ixfer_acc2ait_sv(:,:) = 0 + if ( do_aitacc_transfer ) then + + ! old - on time first step, npair_renamexf will be <= 0, + ! in which case need to do modal_aero_rename_init + ! new - init is now done through chem_init and things below it + if (npair_renamexf .le. 0) then + npair_renamexf = 0 + ! call modal_aero_rename_init + if (npair_renamexf .le. 0) then + write( 6, '(//a//)' ) & + '*** modal_aero_calcaersize_sub error -- npair_renamexf <= 0' + call endrun( 'modal_aero_calcaersize_sub error' ) + end if + end if + + ! check that renaming ipair=1 is aitken-->accum + ipair = 1 + if ((modefrm_renamexf(ipair) .ne. nait) .or. & + (modetoo_renamexf(ipair) .ne. nacc)) then + write( 6, '(//2a//)' ) & + '*** modal_aero_calcaersize_sub error -- ', & + 'modefrm/too_renamexf(1) are wrong' + call endrun( 'modal_aero_calcaersize_sub error' ) + end if + + ! set dotend() for species that will be transferred + do iq = 1, nspecfrm_renamexf(ipair) + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + if ((lsfrm > 0) .and. (lstoo > 0)) then + dotend(lsfrm) = .true. + dotend(lstoo) = .true. + end if + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + if ((lsfrm > 0) .and. (lstoo > 0)) then + dotendqqcw(lsfrm) = .true. + dotendqqcw(lstoo) = .true. + end if + end do + + ! identify accum species cannot be transferred to aitken mode + noxf_acc2ait(:) = .true. + do l1 = 1, nspec_amode(nacc) + la = lmassptr_amode(l1,nacc) + do iq = 1, nspecfrm_renamexf(ipair) + if (lspectooa_renamexf(iq,ipair) == la) then + noxf_acc2ait(l1) = .false. + end if + end do + end do + + ! v2nzz is voltonumb at the "geometrically-defined" mid-point + ! between the aitken and accum modes + v2nzz = sqrt(voltonumb_amode(nait)*voltonumb_amode(nacc)) + + ! loop over columns and levels + do k = top_lev, pver + do i = 1, ncol + + pdel_fac = pdel(i,k)/gravit ! = rho*dz + xfertend_num(:,:) = 0.0_r8 + + ! compute aitken --> accum transfer rates + ixfer_ait2acc = 0 + xfercoef_num_ait2acc = 0.0_r8 + xfercoef_vol_ait2acc = 0.0_r8 + + drv_t = drv_a_aitsv(i,k) + drv_c_aitsv(i,k) + num_t = num_a_aitsv(i,k) + num_c_aitsv(i,k) + if (drv_t > 0.0_r8) then + if (num_t < drv_t*v2nzz) then + ixfer_ait2acc = 1 + if (num_t < drv_t*voltonumb_amode(nacc)) then + xferfrac_num_ait2acc = 1.0_r8 + xferfrac_vol_ait2acc = 1.0_r8 + else + xferfrac_vol_ait2acc = ((num_t/drv_t) - v2nzz)/ & + (voltonumb_amode(nacc) - v2nzz) + xferfrac_num_ait2acc = xferfrac_vol_ait2acc* & + (drv_t*voltonumb_amode(nacc)/num_t) + if ((xferfrac_num_ait2acc <= 0.0_r8) .or. & + (xferfrac_vol_ait2acc <= 0.0_r8)) then + xferfrac_num_ait2acc = 0.0_r8 + xferfrac_vol_ait2acc = 0.0_r8 + else if ((xferfrac_num_ait2acc >= 1.0_r8) .or. & + (xferfrac_vol_ait2acc >= 1.0_r8)) then + xferfrac_num_ait2acc = 1.0_r8 + xferfrac_vol_ait2acc = 1.0_r8 + end if + end if + xfercoef_num_ait2acc = xferfrac_num_ait2acc*tadjinv + xfercoef_vol_ait2acc = xferfrac_vol_ait2acc*tadjinv + xfertend_num(1,1) = num_a_aitsv(i,k)*xfercoef_num_ait2acc + xfertend_num(1,2) = num_c_aitsv(i,k)*xfercoef_num_ait2acc + end if + end if + + ! compute accum --> aitken transfer rates + ! accum may have some species (seasalt, dust, poa, lll) that are + ! not in aitken mode + ! so first divide the accum drv & num into not-transferred (noxf) species + ! and transferred species, and use the transferred-species + ! portion in what follows + ixfer_acc2ait = 0 + xfercoef_num_acc2ait = 0.0_r8 + xfercoef_vol_acc2ait = 0.0_r8 + + drv_t = drv_a_accsv(i,k) + drv_c_accsv(i,k) + num_t = num_a_accsv(i,k) + num_c_accsv(i,k) + drv_a_noxf = 0.0_r8 + drv_c_noxf = 0.0_r8 + if (drv_t > 0.0_r8) then + if (num_t > drv_t*v2nzz) then + do l1 = 1, nspec_amode(nacc) + + if ( noxf_acc2ait(l1) ) then + ! need qmass*dummwdens = (kg/kg-air) * [1/(kg/m3)] = m3/kg-air + dummwdens = 1.0_r8 / specdens_amode(l1,nacc) + la = lmassptr_amode(l1,nacc) + drv_a_noxf = drv_a_noxf & + + max(0.0_r8,q(i,k,la))*dummwdens + lc = lmassptrcw_amode(l1,nacc) + + fldcw => qqcw_get_field(pbuf,lmassptrcw_amode(l1,nacc),lchnk) + drv_c_noxf = drv_c_noxf & + + max(0.0_r8,fldcw(i,k))*dummwdens + end if + end do + drv_t_noxf = drv_a_noxf + drv_c_noxf + num_t_noxf = drv_t_noxf*voltonumblo_amode(nacc) + num_t0 = num_t + drv_t0 = drv_t + num_t = max( 0.0_r8, num_t - num_t_noxf ) + drv_t = max( 0.0_r8, drv_t - drv_t_noxf ) + end if + end if + + if (drv_t > 0.0_r8) then + if (num_t > drv_t*v2nzz) then + ixfer_acc2ait = 1 + if (num_t > drv_t*voltonumb_amode(nait)) then + xferfrac_num_acc2ait = 1.0_r8 + xferfrac_vol_acc2ait = 1.0_r8 + else + xferfrac_vol_acc2ait = ((num_t/drv_t) - v2nzz)/ & + (voltonumb_amode(nait) - v2nzz) + xferfrac_num_acc2ait = xferfrac_vol_acc2ait* & + (drv_t*voltonumb_amode(nait)/num_t) + if ((xferfrac_num_acc2ait <= 0.0_r8) .or. & + (xferfrac_vol_acc2ait <= 0.0_r8)) then + xferfrac_num_acc2ait = 0.0_r8 + xferfrac_vol_acc2ait = 0.0_r8 + else if ((xferfrac_num_acc2ait >= 1.0_r8) .or. & + (xferfrac_vol_acc2ait >= 1.0_r8)) then + xferfrac_num_acc2ait = 1.0_r8 + xferfrac_vol_acc2ait = 1.0_r8 + end if + end if + duma = 1.0e-37_r8 + xferfrac_num_acc2ait = xferfrac_num_acc2ait* & + num_t/max( duma, num_t0 ) + xfercoef_num_acc2ait = xferfrac_num_acc2ait*tadjinv + xfercoef_vol_acc2ait = xferfrac_vol_acc2ait*tadjinv + xfertend_num(2,1) = num_a_accsv(i,k)*xfercoef_num_acc2ait + xfertend_num(2,2) = num_c_accsv(i,k)*xfercoef_num_acc2ait + end if + end if + + ! jump to end-of-loop if no transfer is needed at current i,k + if (ixfer_ait2acc+ixfer_acc2ait > 0) then + ixfer_ait2acc_sv(i,k) = ixfer_ait2acc + ixfer_acc2ait_sv(i,k) = ixfer_acc2ait + + ! + ! compute new dgncur & v2ncur for aitken & accum modes + ! + ! currently inactive + do n = nait, nacc, (nacc-nait) + if (n .eq. nait) then + duma = (xfertend_num(1,1) - xfertend_num(2,1))*deltat + num_a = max( 0.0_r8, num_a_aitsv(i,k) - duma ) + num_a_acc = max( 0.0_r8, num_a_accsv(i,k) + duma ) + duma = (drv_a_aitsv(i,k)*xfercoef_vol_ait2acc - & + (drv_a_accsv(i,k)-drv_a_noxf)*xfercoef_vol_acc2ait)*deltat + drv_a = max( 0.0_r8, drv_a_aitsv(i,k) - duma ) + drv_a_acc = max( 0.0_r8, drv_a_accsv(i,k) + duma ) + duma = (xfertend_num(1,2) - xfertend_num(2,2))*deltat + num_c = max( 0.0_r8, num_c_aitsv(i,k) - duma ) + num_c_acc = max( 0.0_r8, num_c_accsv(i,k) + duma ) + duma = (drv_c_aitsv(i,k)*xfercoef_vol_ait2acc - & + (drv_c_accsv(i,k)-drv_c_noxf)*xfercoef_vol_acc2ait)*deltat + drv_c = max( 0.0_r8, drv_c_aitsv(i,k) - duma ) + drv_c_acc = max( 0.0_r8, drv_c_accsv(i,k) + duma ) + else + num_a = num_a_acc + drv_a = drv_a_acc + num_c = num_c_acc + drv_c = drv_c_acc + end if + + if (drv_a > 0.0_r8) then + if (num_a <= drv_a*voltonumbhi_amode(n)) then + dgncur_a(i,k,n) = dgnumhi_amode(n) + v2ncur_a(i,k,n) = voltonumbhi_amode(n) + else if (num_a >= drv_a*voltonumblo_amode(n)) then + dgncur_a(i,k,n) = dgnumlo_amode(n) + v2ncur_a(i,k,n) = voltonumblo_amode(n) + else + dgncur_a(i,k,n) = (drv_a/(dumfac*num_a))**third + v2ncur_a(i,k,n) = num_a/drv_a + end if + else + dgncur_a(i,k,n) = dgnum_amode(n) + v2ncur_a(i,k,n) = voltonumb_amode(n) + end if + + if (drv_c > 0.0_r8) then + if (num_c <= drv_c*voltonumbhi_amode(n)) then + dgncur_c(i,k,n) = dgnumhi_amode(n) + v2ncur_c(i,k,n) = voltonumbhi_amode(n) + else if (num_c >= drv_c*voltonumblo_amode(n)) then + dgncur_c(i,k,n) = dgnumlo_amode(n) + v2ncur_c(i,k,n) = voltonumblo_amode(n) + else + dgncur_c(i,k,n) = (drv_c/(dumfac*num_c))**third + v2ncur_c(i,k,n) = num_c/drv_c + end if + else + dgncur_c(i,k,n) = dgnum_amode(n) + v2ncur_c(i,k,n) = voltonumb_amode(n) + end if + + end do + + + ! + ! compute tendency amounts for aitken <--> accum transfer + ! + + if ( masterproc ) then + if (idiagaa > 0) then + do j = 1, 2 + do iq = 1, nspecfrm_renamexf(ipair) + do jac = 1, 2 + if (j .eq. 1) then + if (jac .eq. 1) then + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + else + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + end if + else + if (jac .eq. 1) then + lsfrm = lspectooa_renamexf(iq,ipair) + lstoo = lspecfrma_renamexf(iq,ipair) + else + lsfrm = lspectooc_renamexf(iq,ipair) + lstoo = lspecfrmc_renamexf(iq,ipair) + end if + end if + write( 6, '(a,3i3,2i4)' ) 'calcsize j,iq,jac, lsfrm,lstoo', & + j,iq,jac, lsfrm,lstoo + end do + end do + end do + end if + end if + idiagaa = -1 + + + ! j=1 does aitken-->accum; j=2 does accum-->aitken + do j = 1, 2 + + if ((j .eq. 1 .and. ixfer_ait2acc > 0) .or. & + (j .eq. 2 .and. ixfer_acc2ait > 0)) then + + jsrflx = j+2 + if (j .eq. 1) then + xfercoef = xfercoef_vol_ait2acc + else + xfercoef = xfercoef_vol_acc2ait + end if + + do iq = 1, nspecfrm_renamexf(ipair) + + ! jac=1 does interstitial ("_a"); jac=2 does activated ("_c"); + do jac = 1, 2 + + ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species + ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species + ! for j=1, want lsfrm=aitken species, lstoo=accum species + ! for j=2, want lsfrm=accum species, lstoo=aitken species + if (j .eq. 1) then + if (jac .eq. 1) then + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + else + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + end if + else + if (jac .eq. 1) then + lsfrm = lspectooa_renamexf(iq,ipair) + lstoo = lspecfrma_renamexf(iq,ipair) + else + lsfrm = lspectooc_renamexf(iq,ipair) + lstoo = lspecfrmc_renamexf(iq,ipair) + end if + end if + + if ((lsfrm > 0) .and. (lstoo > 0)) then + if (jac .eq. 1) then + if (iq .eq. 1) then + xfertend = xfertend_num(j,jac) + else + xfertend = max(0.0_r8,q(i,k,lsfrm))*xfercoef + end if + dqdt(i,k,lsfrm) = dqdt(i,k,lsfrm) - xfertend + dqdt(i,k,lstoo) = dqdt(i,k,lstoo) + xfertend + else + if (iq .eq. 1) then + xfertend = xfertend_num(j,jac) + else + fldcw => qqcw_get_field(pbuf,lsfrm,lchnk) + xfertend = max(0.0_r8,fldcw(i,k))*xfercoef + end if + dqqcwdt(i,k,lsfrm) = dqqcwdt(i,k,lsfrm) - xfertend + dqqcwdt(i,k,lstoo) = dqqcwdt(i,k,lstoo) + xfertend + end if + qsrflx(i,lsfrm,jsrflx,jac) = qsrflx(i,lsfrm,jsrflx,jac) - xfertend*pdel_fac + qsrflx(i,lstoo,jsrflx,jac) = qsrflx(i,lstoo,jsrflx,jac) + xfertend*pdel_fac + end if + + end do + end do + end if + end do + + end if + end do + end do + + + end if ! do_aitacc_transfer + lsfrm = -123456789 ! executable statement for debugging + + + ! + ! apply tendencies to cloud-borne species MRs + ! + do l = 1, pcnst + lc = l + if ( lc>0 .and. dotendqqcw(lc) ) then + fldcw=> qqcw_get_field(pbuf,l,lchnk) + do k = top_lev, pver + do i = 1, ncol + fldcw(i,k) = max( 0.0_r8, & + (fldcw(i,k) + dqqcwdt(i,k,lc)*deltat) ) + end do + end do + end if + end do + + ! + ! do outfld calls + ! + + ! history fields for number-adjust source-sink for all modes + if ( .not. do_adjust ) return + + do n = 1, ntot_amode + if (mprognum_amode(n) <= 0) cycle + + do jac = 1, 2 + if (jac == 1) then + l = numptr_amode(n) + tmpnamea = cnst_name(l) + else + l = numptrcw_amode(n) + tmpnamea = cnst_name_cw(l) + end if + fieldname = trim(tmpnamea) // '_sfcsiz1' + call outfld( fieldname, qsrflx(:,l,1,jac), pcols, lchnk) + + fieldname = trim(tmpnamea) // '_sfcsiz2' + call outfld( fieldname, qsrflx(:,l,2,jac), pcols, lchnk) + end do ! jac = ... + + end do ! n = ... + + + ! history fields for aitken-accum transfer + if ( .not. do_aitacc_transfer ) return + + do iq = 1, nspecfrm_renamexf(ipair) + + ! jac=1 does interstitial ("_a"); jac=2 does activated ("_c"); + do jac = 1, 2 + + ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species + ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species + if (jac .eq. 1) then + lsfrm = lspecfrma_renamexf(iq,ipair) + lstoo = lspectooa_renamexf(iq,ipair) + else + lsfrm = lspecfrmc_renamexf(iq,ipair) + lstoo = lspectooc_renamexf(iq,ipair) + end if + if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle + + if (jac .eq. 1) then + tmpnamea = cnst_name(lsfrm) + tmpnameb = cnst_name(lstoo) + else + tmpnamea = cnst_name_cw(lsfrm) + tmpnameb = cnst_name_cw(lstoo) + end if + if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle + + fieldname = trim(tmpnamea) // '_sfcsiz3' + call outfld( fieldname, qsrflx(:,lsfrm,3,jac), pcols, lchnk) + + fieldname = trim(tmpnameb) // '_sfcsiz3' + call outfld( fieldname, qsrflx(:,lstoo,3,jac), pcols, lchnk) + + fieldname = trim(tmpnamea) // '_sfcsiz4' + call outfld( fieldname, qsrflx(:,lsfrm,4,jac), pcols, lchnk) + + fieldname = trim(tmpnameb) // '_sfcsiz4' + call outfld( fieldname, qsrflx(:,lstoo,4,jac), pcols, lchnk) + + end do ! jac = ... + end do ! iq = ... + + call modal_aero_calcdry(state, pbuf) + +#endif + +end subroutine modal_aero_calcsize_sub + + +!---------------------------------------------------------------------- + + +subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m, & + hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + + !----------------------------------------------------------------------- + ! + ! Calculate aerosol size distribution parameters + ! + ! ***N.B.*** DGNUM for the modes in the climate list are put directly into + ! the physics buffer. For diagnostic list calculations use the + ! optional list_idx and dgnum args. + !----------------------------------------------------------------------- + + ! arguments + type(physics_state), intent(in), target :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + integer, optional, intent(in) :: list_idx_in ! diagnostic list index + real(r8), optional, pointer :: dgnum_m(:,:,:) ! interstital aerosol dry number mode radius (m) + real(r8), optional, pointer :: hygro_m(:,:,:) + real(r8), optional, pointer :: dryvol_m(:,:,:) + real(r8), optional, pointer :: dryrad_m(:,:,:) + real(r8), optional, pointer :: drymass_m(:,:,:) + real(r8), optional, pointer :: so4dryvol_m(:,:,:) + real(r8), optional, pointer :: naer_m(:,:,:) + + + ! local + integer :: i, k, l1, n + integer :: lchnk, ncol + integer :: list_idx, stat + integer :: nmodes + integer :: nspec + + real(r8), pointer :: dgncur_a(:,:) ! (pcols,pver) + + + real(r8), parameter :: third = 1.0_r8/3.0_r8 + + real(r8), pointer :: mode_num(:,:) ! mode number mixing ratio + real(r8), pointer :: specmmr(:,:) ! specie mmr + real(r8) :: specdens ! specie density + + real(r8) :: dryvol_a(pcols,pver) ! interstital aerosol dry volume (cm^3/mol_air) + + real(r8) :: dgnum, dgnumhi, dgnumlo + real(r8) :: dgnyy, dgnxx ! dgnumlo/hi of current mode + real(r8) :: drv_a ! dry volume (cm3/mol_air) + real(r8) :: dumfac, dummwdens ! work variables + real(r8) :: num_a0 ! initial number (#/mol_air) + real(r8) :: num_a ! final number (#/mol_air) + real(r8) :: voltonumbhi, voltonumblo + real(r8) :: v2nyy, v2nxx ! voltonumblo/hi of current mode + real(r8) :: sigmag, alnsg + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + list_idx = 0 ! climate list by default + if (present(list_idx_in)) list_idx = list_idx_in + + call rad_cnst_get_info(list_idx, nmodes=nmodes) + + if (list_idx /= 0) then + if (.not. present(dgnum_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dgnum_m pointer not present') + end if + if (.not. associated(dgnum_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dgnum_m not associated') + end if + + if (.not. present(hygro_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but hygro_m pointer not present') + end if + if (.not. associated(hygro_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but hygro_m not associated') + end if + + if (.not. present(dryvol_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dryvol_m pointer not present') + end if + if (.not. associated(dryvol_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dryvol_m not associated') + end if + + if (.not. present(dryrad_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dryrad_m pointer not present') + end if + if (.not. associated(dryrad_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but dryrad_m not associated') + end if + + if (.not. present(drymass_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but drymass_m pointer not present') + end if + if (.not. associated(drymass_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but drymass_m not associated') + end if + + if (.not. present(so4dryvol_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but so4dryvol_m pointer not present') + end if + if (.not. associated(so4dryvol_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but so4dryvol_m not associated') + end if + + if (.not. present(naer_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but naer_m pointer not present') + end if + if (.not. associated(naer_m)) then + call endrun('modal_aero_calcsize_diag called for'// & + 'diagnostic list but naer_m not associated') + end if + + end if + + do n = 1, nmodes + + if (list_idx == 0) then + call pbuf_get_field(pbuf, dgnum_idx, dgncur_a, start=(/1,1,n/), kount=(/pcols,pver,1/)) + else + dgncur_a => dgnum_m(:,:,n) + end if + + ! get mode properties + call rad_cnst_get_mode_props(list_idx, n, dgnum=dgnum, dgnumhi=dgnumhi, dgnumlo=dgnumlo, & + sigmag=sigmag) + + ! get mode number mixing ratio + call rad_cnst_get_mode_num(list_idx, n, 'a', state, pbuf, mode_num) + + dgncur_a(:,:) = dgnum + dryvol_a(:,:) = 0.0_r8 + + ! compute dry volume mixrats = + ! sum_over_components{ component_mass mixrat / density } + call rad_cnst_get_info(list_idx, n, nspec=nspec) + do l1 = 1, nspec + + call rad_cnst_get_aer_mmr(list_idx, n, l1, 'a', state, pbuf, specmmr) + call rad_cnst_get_aer_props(list_idx, n, l1, density_aer=specdens) + + ! need qmass*dummwdens = (kg/kg-air) * [1/(kg/m3)] = m3/kg-air + dummwdens = 1.0_r8 / specdens + + do k=top_lev,pver + do i=1,ncol + dryvol_a(i,k) = dryvol_a(i,k) & + + max(0.0_r8, specmmr(i,k))*dummwdens + end do + end do + end do + + alnsg = log( sigmag ) + dumfac = exp(4.5_r8*alnsg**2)*pi/6.0_r8 + voltonumblo = 1._r8 / ( (pi/6._r8)*(dgnumlo**3)*exp(4.5_r8*alnsg**2) ) + voltonumbhi = 1._r8 / ( (pi/6._r8)*(dgnumhi**3)*exp(4.5_r8*alnsg**2) ) + v2nxx = voltonumbhi + v2nyy = voltonumblo + dgnxx = dgnumhi + dgnyy = dgnumlo + + do k = top_lev, pver + do i = 1, ncol + + drv_a = dryvol_a(i,k) + num_a0 = mode_num(i,k) + num_a = max( 0.0_r8, num_a0 ) + + if (drv_a > 0.0_r8) then + if (num_a <= drv_a*v2nxx) then + dgncur_a(i,k) = dgnxx + else if (num_a >= drv_a*v2nyy) then + dgncur_a(i,k) = dgnyy + else + dgncur_a(i,k) = (drv_a/(dumfac*num_a))**third + end if + end if + + end do + end do + + end do ! nmodes + + call modal_aero_calcdry(state, pbuf, list_idx_in, dgnum_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + +end subroutine modal_aero_calcsize_diag + +subroutine modal_aero_calcdry(state, pbuf, list_idx_in, dgnumdry_m, hygro_m, dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + + type(physics_state), target, intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + integer, optional, intent(in) :: list_idx_in ! diagnostic list index + real(r8), optional, pointer :: dgnumdry_m(:,:,:) + real(r8), optional, pointer :: hygro_m(:,:,:) + real(r8), optional, pointer :: dryvol_m(:,:,:) + real(r8), optional, pointer :: dryrad_m(:,:,:) + real(r8), optional, pointer :: drymass_m(:,:,:) + real(r8), optional, pointer :: so4dryvol_m(:,:,:) + real(r8), optional, pointer :: naer_m(:,:,:) + + real(r8), parameter :: third = 1._r8/3._r8 + real(r8), parameter :: pi43 = pi*4.0_r8/3.0_r8 + + real(r8), pointer :: maer(:,:) ! aerosol wet mass MR (including water) (kg/kg-air) + real(r8), pointer :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) + real(r8), pointer :: dryvol(:,:,:) ! single-particle-mean dry volume (m3) + real(r8), pointer :: dryrad(:,:,:) ! dry volume mean radius of aerosol (m) + real(r8), pointer :: drymass(:,:,:) ! single-particle-mean dry mass (kg) + real(r8), pointer :: so4dryvol(:,:,:) ! single-particle-mean so4 dry volume (m3) + real(r8), pointer :: naer(:,:,:) ! aerosol number MR (bounded!) (#/kg-air) + + real(r8), pointer :: dgncur_a(:,:,:) + real(r8), pointer :: raer(:,:) ! aerosol species MRs (kg/kg and #/kg) + + real(r8), pointer :: sulfeq(:,:,:) ! H2SO4 equilibrium mixing ratios over particles (mol/mol) + + real(r8) :: dryvolmr(pcols,pver) ! volume MR for aerosol mode (m3/kg) + real(r8) :: so4dryvolmr(pcols,pver) ! volume MR for sulfate aerosol in mode (m3/kg) + + real(r8) :: specdens + real(r8) :: spechygro, spechygro_1 + real(r8) :: sigmag + real(r8) :: duma, dumb + real(r8) :: alnsg + + real(r8) :: v2ncur_a + real(r8) :: drydens ! dry particle density (kg/m^3) + + character(len=fieldname_len+3) :: fieldname + character(len=32) :: spectype + + integer :: nmodes, lchnk, ncol, list_idx, i, k, l, m + integer :: nspec + + + lchnk = state%lchnk + ncol = state%ncol + + list_idx = 0 + if (present(list_idx_in)) then + list_idx = list_idx_in + + ! check that all optional args are present + if (.not. present(dgnumdry_m)) then + call endrun('modal_aero_calcdry called for'// & + 'diagnostic list but required args not present') + end if + + ! arrays for diagnostic calculations must be associated + if (.not. associated(dgnumdry_m)) then + call endrun('modal_aero_calcdry called for'// & + 'diagnostic list but required args not associated') + end if + end if + + ! loop over all aerosol modes + call rad_cnst_get_info(list_idx, nmodes=nmodes) + + allocate( maer(pcols,pver)) + + if (list_idx == 0) then + call pbuf_get_field(pbuf, dgnum_idx, dgncur_a ) + call pbuf_get_field(pbuf, hygro_idx, hygro) + call pbuf_get_field(pbuf, dryvol_idx, dryvol) + call pbuf_get_field(pbuf, dryrad_idx, dryrad) + call pbuf_get_field(pbuf, drymass_idx, drymass) + call pbuf_get_field(pbuf, so4dryvol_idx, so4dryvol) + call pbuf_get_field(pbuf, naer_idx, naer) + else + dgncur_a => dgnumdry_m + hygro => hygro_m + dryvol => dryvol_m + dryrad => dryrad_m + drymass => drymass_m + so4dryvol => so4dryvol_m + naer => naer_m + end if + + hygro(:,:,:) = 0._r8 + so4dryvol(:,:,:) = 0._r8 + + do m = 1, nmodes + + maer(:,:) = 0._r8 + dryvolmr(:,:) = 0._r8 + so4dryvolmr(:,:) = 0._r8 + + ! get mode properties + call rad_cnst_get_mode_props(list_idx, m, sigmag=sigmag) + + ! get mode info + call rad_cnst_get_info(list_idx, m, nspec=nspec) + + do l = 1, nspec + + ! get species interstitial mixing ratio ('a') + call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, raer) + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + hygro_aer=spechygro, spectype=spectype) + + if (l == 1) then + ! save off these values to be used as defaults + spechygro_1 = spechygro + end if + + do k = top_lev, pver + do i = 1, ncol + duma = raer(i,k) ! kg/kg air + maer(i,k) = maer(i,k) + duma + dumb = duma/specdens ! m3/kg air + dryvolmr(i,k) = dryvolmr(i,k) + dumb + if (modal_strat_sulfate .and. (trim(spectype).eq.'sulfate')) then + so4dryvolmr(i,k) = so4dryvolmr(i,k) + dumb + end if + hygro(i,k,m) = hygro(i,k,m) + dumb*spechygro + end do + end do + end do + + alnsg = log(sigmag) + + do k = top_lev, pver + do i = 1, ncol + + if (dryvolmr(i,k) > 1.0e-30_r8) then + hygro(i,k,m) = hygro(i,k,m)/dryvolmr(i,k) + else + hygro(i,k,m) = spechygro_1 + end if + + ! dry aerosol properties + + v2ncur_a = 1._r8 / ( (pi/6._r8)*(dgncur_a(i,k,m)**3._r8)*exp(4.5_r8*alnsg**2._r8) ) + ! naer = aerosol number (#/kg) + naer(i,k,m) = dryvolmr(i,k)*v2ncur_a + + ! compute mean (1 particle) dry volume and mass for each mode + ! old coding is replaced because the new (1/v2ncur_a) is equal to + ! the mean particle volume + ! also moletomass forces maer >= 1.0e-30, so (maer/dryvolmr) + ! should never cause problems (but check for maer < 1.0e-31 anyway) + if (maer(i,k) .gt. 1.0e-31_r8) then + drydens = maer(i,k)/dryvolmr(i,k) ! kg/m3 aerosol + else + drydens = 1.0_r8 + end if + dryvol(i,k,m) = 1.0_r8/v2ncur_a ! m3/particle + drymass(i,k,m) = drydens*dryvol(i,k,m) ! kg/particle + dryrad(i,k,m) = (dryvol(i,k,m)/pi43)**third ! m + end do ! i = 1, ncol + end do ! k = top_lev, pver + + + if (modal_strat_sulfate) then + do k = top_lev, pver + do i = 1, ncol + if (so4dryvolmr(i,k) .gt. 1.0e-31_r8) then + so4dryvol(i,k,m) = dryvol(i,k,m)*so4dryvolmr(i,k)/dryvolmr(i,k) + else + so4dryvol(i,k,m) = 0.0_r8 + end if + + end do ! i = 1, ncol + end do ! k = top_lev, pver + + end if + + end do ! m = 1, nmodes + + deallocate( maer) + + +end subroutine modal_aero_calcdry +!---------------------------------------------------------------------- + +end module modal_aero_calcsize diff --git a/src/chemistry/utils/modal_aero_deposition.F90 b/src/chemistry/utils/modal_aero_deposition.F90 new file mode 100644 index 0000000000..6f6f854d7e --- /dev/null +++ b/src/chemistry/utils/modal_aero_deposition.F90 @@ -0,0 +1,330 @@ +module modal_aero_deposition + +!------------------------------------------------------------------------------------------------ +! Purpose: +! +! Partition the contributions from modal components of wet and dry +! deposition at the surface into the fields passed to the coupler. +! +! *** N.B. *** Currently only a simple scheme for the 3-mode version +! of MAM has been implemented. +! +! Revision history: +! Feb 2009 M. Flanner, B. Eaton Original version for trop_mam3. +! Jul 2011 F Vitt -- made avaliable to be used in a prescribed modal aerosol mode (no prognostic MAM) +! Mar 2012 F Vitt -- made changes for to prevent abort when 7-mode aeroslol model is used +! some of the needed consituents do not exist in 7-mode so bin_fluxes will be false +! May 2014 F Vitt -- included contributions from MAM4 aerosols and added soa_a2 to the ocphiwet fluxes +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use camsrfexch, only: cam_out_t +use constituents, only: cnst_get_ind, pcnst +use cam_abortutils, only: endrun +use rad_constituents, only: rad_cnst_get_info + +implicit none +private +save + +public :: & + modal_aero_deposition_init, & + set_srf_drydep, & + set_srf_wetdep + +! Private module data + +logical :: initialized = .false. +integer :: bcphi_ndx( pcnst ) = -1 +integer :: bcpho_ndx( pcnst ) = -1 +integer :: ocphi_ndx( pcnst ) = -1 +integer :: ocpho_ndx( pcnst ) = -1 +integer :: crse_dust_ndx( pcnst ) = -1 +integer :: fine_dust_ndx( pcnst ) = -1 +integer :: bcphi_cnt = 0 +integer :: ocphi_cnt = 0 +integer :: bcpho_cnt = 0 +integer :: ocpho_cnt = 0 +integer :: crse_dust_cnt = 0 +integer :: fine_dust_cnt = 0 + +!============================================================================== +contains +!============================================================================== + +subroutine modal_aero_deposition_init( bcphi_indices, bcpho_indices, ocphi_indices, & + ocpho_indices, fine_dust_indices, crse_dust_indices ) + + ! set aerosol indices for re-mapping surface deposition fluxes: + ! *_a1 = accumulation mode + ! *_a2 = aitken mode + ! *_a3 = coarse mode + + ! can be initialized with user specified indices + ! if called from aerodep_flx module (for prescribed modal aerosol fluxes) then these indices are specified + integer, optional, intent(in) :: bcphi_indices(:) ! hydrophilic black carbon + integer, optional, intent(in) :: bcpho_indices(:) ! hydrophobic black carbon + integer, optional, intent(in) :: ocphi_indices(:) ! hydrophilic organic carbon + integer, optional, intent(in) :: ocpho_indices(:) ! hydrophobic organic carbon + integer, optional, intent(in) :: fine_dust_indices(:) ! fine dust + integer, optional, intent(in) :: crse_dust_indices(:) ! coarse dust + + ! local vars + integer :: i, pcnt, scnt + + character(len=16), parameter :: fine_dust_modes(2) = (/ 'accum ', 'fine_dust '/) + character(len=16), parameter :: crse_dust_modes(2) = (/ 'coarse ', 'coarse_dust '/) + character(len=16), parameter :: hydrophilic_carbon_modes(1) = (/'accum '/) + character(len=16), parameter :: hydrophobic_carbon_modes(3) = (/'aitken ', 'coarse ', 'primary_carbon '/) + + ! if already initialized abort the run + if (initialized) then + call endrun('modal_aero_deposition is already initialized') + endif + + if (present(bcphi_indices)) then + bcphi_cnt = size(bcphi_indices) + bcphi_ndx(1:bcphi_cnt) = bcphi_indices (1:bcphi_cnt) + else + call get_indices( type='black-c', modes=hydrophilic_carbon_modes, indices=bcphi_ndx, count=bcphi_cnt ) + endif + if (present(bcpho_indices)) then + bcpho_cnt = size(bcpho_indices) + bcpho_ndx(1:bcpho_cnt) = bcpho_indices (1:bcpho_cnt) + else + call get_indices( type='black-c', modes=hydrophobic_carbon_modes, indices=bcpho_ndx, count=bcpho_cnt ) + endif + + if (present(ocphi_indices)) then + ocphi_cnt = size(ocphi_indices) + ocphi_ndx(1:ocphi_cnt) = ocphi_indices (1:ocphi_cnt) + else + call get_indices( type='s-organic', modes=hydrophilic_carbon_modes, indices=ocphi_ndx, count=pcnt ) + call get_indices( type='p-organic', modes=hydrophilic_carbon_modes, indices=ocphi_ndx(pcnt+1:), count=scnt ) + ocphi_cnt = pcnt+scnt + endif + if (present(ocpho_indices)) then + ocpho_cnt = size(ocpho_indices) + ocpho_ndx(1:ocpho_cnt) = ocpho_indices (1:ocpho_cnt) + else + call get_indices( type='s-organic', modes=hydrophobic_carbon_modes, indices=ocpho_ndx, count=pcnt ) + call get_indices( type='p-organic', modes=hydrophobic_carbon_modes, indices=ocpho_ndx(pcnt+1:), count=scnt ) + ocpho_cnt = pcnt+scnt + endif + + if (present(fine_dust_indices)) then + fine_dust_cnt = size(fine_dust_indices) + fine_dust_ndx(1:fine_dust_cnt) = fine_dust_indices(1:fine_dust_cnt) + else + call get_indices( type='dust', modes=fine_dust_modes, indices=fine_dust_ndx, count=fine_dust_cnt ) + endif + if (present(crse_dust_indices)) then + crse_dust_cnt = size(crse_dust_indices) + crse_dust_ndx(1:crse_dust_cnt) = crse_dust_indices(1:crse_dust_cnt) + else + call get_indices( type='dust', modes=crse_dust_modes, indices=crse_dust_ndx, count=crse_dust_cnt ) + endif + + initialized = .true. + +end subroutine modal_aero_deposition_init + +!============================================================================== +subroutine set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out) + +! Set surface wet deposition fluxes passed to coupler. + + ! Arguments: + real(r8), intent(in) :: aerdepwetis(:,:) ! aerosol wet deposition (interstitial) + real(r8), intent(in) :: aerdepwetcw(:,:) ! aerosol wet deposition (cloud water) + type(cam_out_t), intent(inout) :: cam_out ! cam export state + + ! Local variables: + integer :: i, ispec, idx + integer :: ncol ! number of columns + + real(r8) :: bcphiwet_sum, ocphiwet_sum + !---------------------------------------------------------------------------- + + if (.not.initialized) call endrun('set_srf_wetdep: modal_aero_deposition has not been initialized') + + ncol = cam_out%ncol + + cam_out%bcphiwet(:) = 0._r8 + cam_out%ocphiwet(:) = 0._r8 + + ! derive cam_out variables from deposition fluxes + ! note: wet deposition fluxes are negative into surface, + ! dry deposition fluxes are positive into surface. + ! srf models want positive definite fluxes. + do i = 1, ncol + + ! black carbon fluxes + do ispec=1,bcphi_cnt + cam_out%bcphiwet(i) = cam_out%bcphiwet(i) & + - (aerdepwetis(i,bcphi_ndx(ispec))+aerdepwetcw(i,bcphi_ndx(ispec))) + enddo + do ispec=1,bcpho_cnt + cam_out%bcphiwet(i) = cam_out%bcphiwet(i) & + - (aerdepwetis(i,bcpho_ndx(ispec))+aerdepwetcw(i,bcpho_ndx(ispec))) + enddo + + ! organic carbon fluxes + do ispec=1,ocphi_cnt + cam_out%ocphiwet(i) = cam_out%ocphiwet(i) & + - (aerdepwetis(i,ocphi_ndx(ispec))+aerdepwetcw(i,ocphi_ndx(ispec))) + enddo + do ispec=1,ocpho_cnt + cam_out%ocphiwet(i) = cam_out%ocphiwet(i) & + - (aerdepwetis(i,ocpho_ndx(ispec))+aerdepwetcw(i,ocpho_ndx(ispec))) + enddo + + ! dust fluxes + cam_out%dstwet1(i) = 0._r8 + cam_out%dstwet2(i) = 0._r8 + cam_out%dstwet3(i) = 0._r8 + cam_out%dstwet4(i) = 0._r8 + + ! bulk bin1 (fine) dust deposition equals accumulation mode deposition: + do ispec=1,fine_dust_cnt + cam_out%dstwet1(i) = cam_out%dstwet1(i) & + -(aerdepwetis(i,fine_dust_ndx(ispec))+aerdepwetcw(i,fine_dust_ndx(ispec))) + enddo + + ! Assign all coarse-mode dust to bulk size bin 3: + do ispec=1,crse_dust_cnt + cam_out%dstwet3(i) = cam_out%dstwet3(i) & + -(aerdepwetis(i,crse_dust_ndx(ispec))+aerdepwetcw(i,crse_dust_ndx(ispec))) + enddo + + ! in rare cases, integrated deposition tendency is upward + if (cam_out%bcphiwet(i) .lt. 0._r8) cam_out%bcphiwet(i) = 0._r8 + if (cam_out%ocphiwet(i) .lt. 0._r8) cam_out%ocphiwet(i) = 0._r8 + if (cam_out%dstwet1(i) .lt. 0._r8) cam_out%dstwet1(i) = 0._r8 + if (cam_out%dstwet3(i) .lt. 0._r8) cam_out%dstwet3(i) = 0._r8 + enddo + +end subroutine set_srf_wetdep + +!============================================================================== + +subroutine set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out) + +! Set surface dry deposition fluxes passed to coupler. + + ! Arguments: + real(r8), intent(in) :: aerdepdryis(:,:) ! aerosol dry deposition (interstitial) + real(r8), intent(in) :: aerdepdrycw(:,:) ! aerosol dry deposition (cloud water) + type(cam_out_t), intent(inout) :: cam_out ! cam export state + + ! Local variables: + integer :: i, ispec, idx + integer :: ncol ! number of columns + real(r8):: bcphidry_sum, ocphidry_sum, ocphodry_sum + !---------------------------------------------------------------------------- + + if (.not.initialized) call endrun('set_srf_drydep: modal_aero_deposition has not been initialized') + + ncol = cam_out%ncol + + cam_out%bcphidry(:) = 0._r8 + cam_out%bcphodry(:) = 0._r8 + cam_out%ocphidry(:) = 0._r8 + cam_out%ocphodry(:) = 0._r8 + + ! derive cam_out variables from deposition fluxes + ! note: wet deposition fluxes are negative into surface, + ! dry deposition fluxes are positive into surface. + ! srf models want positive definite fluxes. + do i = 1, ncol + + ! black carbon fluxes + do ispec=1,bcphi_cnt + cam_out%bcphidry(i) = cam_out%bcphidry(i) & + + (aerdepdryis(i,bcphi_ndx(ispec))+aerdepdrycw(i,bcphi_ndx(ispec))) + enddo + do ispec=1,bcpho_cnt + cam_out%bcphodry(i) = cam_out%bcphodry(i) & + + (aerdepdryis(i,bcpho_ndx(ispec))+aerdepdrycw(i,bcpho_ndx(ispec))) + enddo + + ! organic carbon fluxes + do ispec=1,ocphi_cnt + cam_out%ocphidry(i) = cam_out%ocphidry(i) & + + (aerdepdryis(i,ocphi_ndx(ispec))+aerdepdrycw(i,ocphi_ndx(ispec))) + enddo + do ispec=1,ocpho_cnt + cam_out%ocphodry(i) = cam_out%ocphodry(i) & + + (aerdepdryis(i,ocpho_ndx(ispec))+aerdepdrycw(i,ocpho_ndx(ispec))) + enddo + + ! dust fluxes + cam_out%dstdry1(i) = 0._r8 + cam_out%dstdry2(i) = 0._r8 + cam_out%dstdry3(i) = 0._r8 + cam_out%dstdry4(i) = 0._r8 + ! bulk bin1 (fine) dust deposition equals accumulation mode deposition: + do ispec=1,fine_dust_cnt + cam_out%dstdry1(i) = cam_out%dstdry1(i) & + + (aerdepdryis(i,fine_dust_ndx(ispec))+aerdepdrycw(i,fine_dust_ndx(ispec))) + enddo + ! Assign all coarse-mode dust to bulk size bin 3: + do ispec=1,crse_dust_cnt + cam_out%dstdry3(i) = cam_out%dstdry3(i) & + + (aerdepdryis(i,crse_dust_ndx(ispec))+aerdepdrycw(i,crse_dust_ndx(ispec))) + enddo + + ! in rare cases, integrated deposition tendency is upward + if (cam_out%bcphidry(i) .lt. 0._r8) cam_out%bcphidry(i) = 0._r8 + if (cam_out%bcphodry(i) .lt. 0._r8) cam_out%bcphodry(i) = 0._r8 + if (cam_out%ocphidry(i) .lt. 0._r8) cam_out%ocphidry(i) = 0._r8 + if (cam_out%ocphodry(i) .lt. 0._r8) cam_out%ocphodry(i) = 0._r8 + if (cam_out%dstdry1(i) .lt. 0._r8) cam_out%dstdry1(i) = 0._r8 + if (cam_out%dstdry3(i) .lt. 0._r8) cam_out%dstdry3(i) = 0._r8 + enddo + +end subroutine set_srf_drydep + +!============================================================================== +subroutine get_indices( type, modes, indices, count ) + + character(len=*), intent(in) :: type + character(len=*), intent(in) :: modes(:) + integer, intent(out) :: indices(:) + integer, intent(out) :: count + + integer :: l, n, ndx, nmodes, nspec + character(len=32) :: spec_type, spec_name, mode_type + + call rad_cnst_get_info(0, nmodes=nmodes) + + count = 0 + indices(:) = -1 + + if (nmodes==7) return ! historically turned off for mam7 + + do n = 1, nmodes + + call rad_cnst_get_info(0, n, mode_type=mode_type, nspec=nspec) + + if ( any(modes==trim(mode_type)) ) then + + do l = 1,nspec + call rad_cnst_get_info(0, n, l, spec_type=spec_type, spec_name=spec_name) + call cnst_get_ind(spec_name, ndx, abort=.false.) + if (ndx>0) then + if (trim(spec_type) == trim(type)) then + count = count+1 + indices(count) = ndx + endif + endif + enddo + + endif + + enddo + +end subroutine get_indices +!============================================================================== + +end module modal_aero_deposition diff --git a/src/chemistry/utils/modal_aero_wateruptake.F90 b/src/chemistry/utils/modal_aero_wateruptake.F90 new file mode 100644 index 0000000000..0277318cf0 --- /dev/null +++ b/src/chemistry/utils/modal_aero_wateruptake.F90 @@ -0,0 +1,1088 @@ +module modal_aero_wateruptake + +! RCE 07.04.13: Adapted from MIRAGE2 code + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: pi, rhoh2o +use ppgrid, only: pcols, pver +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field + +use wv_saturation, only: qsat_water +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & + rad_cnst_get_mode_props +use cam_history, only: addfld, add_default, outfld +use cam_logfile, only: iulog +use ref_pres, only: top_lev => clim_modal_aero_top_lev +use phys_control, only: phys_getopts +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + modal_aero_wateruptake_init, & + modal_aero_wateruptake_dr, & + modal_aero_wateruptake_sub, & + modal_aero_kohler + +public :: modal_aero_wateruptake_reg + +real(r8), parameter :: third = 1._r8/3._r8 +real(r8), parameter :: pi43 = pi*4.0_r8/3.0_r8 + + +! Physics buffer indices +integer :: cld_idx = 0 +integer :: dgnum_idx = 0 +integer :: dgnumwet_idx = 0 +integer :: sulfeq_idx = 0 +integer :: wetdens_ap_idx = 0 +integer :: qaerwat_idx = 0 +integer :: hygro_idx = 0 +integer :: dryvol_idx = 0 +integer :: dryrad_idx = 0 +integer :: drymass_idx = 0 +integer :: so4dryvol_idx = 0 +integer :: naer_idx = 0 + + +logical, public :: modal_strat_sulfate = .false. ! If .true. then MAM sulfate surface area density used in stratospheric heterogeneous chemistry + +!=============================================================================== +contains +!=============================================================================== + +subroutine modal_aero_wateruptake_reg() + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use rad_constituents, only: rad_cnst_get_info + + integer :: nmodes + + call rad_cnst_get_info(0, nmodes=nmodes) + call pbuf_add_field('DGNUMWET', 'global', dtype_r8, (/pcols, pver, nmodes/), dgnumwet_idx) + call pbuf_add_field('WETDENS_AP', 'physpkg', dtype_r8, (/pcols, pver, nmodes/), wetdens_ap_idx) + + ! 1st order rate for direct conversion of strat. cloud water to precip (1/s) + call pbuf_add_field('QAERWAT', 'physpkg', dtype_r8, (/pcols, pver, nmodes/), qaerwat_idx) + + if (modal_strat_sulfate) then + call pbuf_add_field('MAMH2SO4EQ', 'global', dtype_r8, (/pcols, pver, nmodes/), sulfeq_idx) + end if + + +end subroutine modal_aero_wateruptake_reg + +!=============================================================================== +!=============================================================================== + +subroutine modal_aero_wateruptake_init(pbuf2d) + use time_manager, only: is_first_step + use physics_buffer,only: pbuf_set_field + use infnan, only : nan, assignment(=) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + real(r8) :: real_nan + + integer :: m, nmodes + logical :: history_aerosol ! Output the MAM aerosol variables and tendencies + + character(len=3) :: trnum ! used to hold mode number (as characters) + !---------------------------------------------------------------------------- + + real_nan = nan + + cld_idx = pbuf_get_index('CLD') + dgnum_idx = pbuf_get_index('DGNUM') + + hygro_idx = pbuf_get_index('HYGRO') + dryvol_idx = pbuf_get_index('DRYVOL') + dryrad_idx = pbuf_get_index('DRYRAD') + drymass_idx = pbuf_get_index('DRYMASS') + so4dryvol_idx = pbuf_get_index('SO4DRYVOL') + naer_idx = pbuf_get_index('NAER') + + ! assume for now that will compute wateruptake for climate list modes only + + call rad_cnst_get_info(0, nmodes=nmodes) + + do m = 1, nmodes + write(trnum, '(i3.3)') m + call addfld('dgnd_a'//trnum(2:3), (/ 'lev' /), 'A', 'm', & + 'dry dgnum, interstitial, mode '//trnum(2:3)) + call addfld('dgnw_a'//trnum(2:3), (/ 'lev' /), 'A', 'm', & + 'wet dgnum, interstitial, mode '//trnum(2:3)) + call addfld('wat_a'//trnum(3:3), (/ 'lev' /), 'A', 'm', & + 'aerosol water, interstitial, mode '//trnum(2:3)) + + ! determine default variables + call phys_getopts(history_aerosol_out = history_aerosol) + + if (history_aerosol) then + call add_default('dgnd_a'//trnum(2:3), 1, ' ') + call add_default('dgnw_a'//trnum(2:3), 1, ' ') + call add_default('wat_a'//trnum(3:3), 1, ' ') + endif + + end do + + if (is_first_step()) then + ! initialize fields in physics buffer + call pbuf_set_field(pbuf2d, dgnumwet_idx, 0.0_r8) + if (modal_strat_sulfate) then + ! initialize fields in physics buffer to NaN (not a number) + ! so model will crash if used before initialization + call pbuf_set_field(pbuf2d, sulfeq_idx, real_nan) + endif + endif + +end subroutine modal_aero_wateruptake_init + +!=============================================================================== + + +subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, drymass_m,& + so4dryvol_m, naer_m) +!----------------------------------------------------------------------- +! +! CAM specific driver for modal aerosol water uptake code. +! +! *** N.B. *** The calculation has been enabled for diagnostic mode lists +! via optional arguments. If the list_idx arg is present then +! all the optional args must be present. +! +!----------------------------------------------------------------------- + + use time_manager, only: is_first_step + use cam_history, only: outfld, fieldname_len + use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + ! Arguments + type(physics_state), target, intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + integer, optional, intent(in) :: list_idx_in + real(r8), optional, pointer :: dgnumdry_m(:,:,:) + real(r8), optional, pointer :: dgnumwet_m(:,:,:) + real(r8), optional, pointer :: qaerwat_m(:,:,:) + real(r8), optional, pointer :: wetdens_m(:,:,:) + real(r8), optional, pointer :: hygro_m(:,:,:) + real(r8), optional, pointer :: dryvol_m(:,:,:) + real(r8), optional, pointer :: dryrad_m(:,:,:) + real(r8), optional, pointer :: drymass_m(:,:,:) + real(r8), optional, pointer :: so4dryvol_m(:,:,:) + real(r8), optional, pointer :: naer_m(:,:,:) + + ! local variables + + integer :: lchnk ! chunk index + integer :: ncol ! number of columns + integer :: list_idx ! radiative constituents list index + integer :: stat + + integer :: i, k, l, m + integer :: itim_old + integer :: nmodes + integer :: nspec + integer :: tropLev(pcols) + + character(len=fieldname_len+3) :: fieldname + + real(r8), pointer :: h2ommr(:,:) ! specific humidity + real(r8), pointer :: t(:,:) ! temperatures (K) + real(r8), pointer :: pmid(:,:) ! layer pressure (Pa) + + real(r8), pointer :: cldn(:,:) ! layer cloud fraction (0-1) + real(r8), pointer :: dgncur_a(:,:,:) + real(r8), pointer :: dgncur_awet(:,:,:) + real(r8), pointer :: wetdens(:,:,:) + real(r8), pointer :: qaerwat(:,:,:) + + real(r8), pointer :: maer(:,:,:) ! aerosol wet mass MR (including water) (kg/kg-air) + real(r8), pointer :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) + real(r8), pointer :: naer(:,:,:) ! aerosol number MR (bounded!) (#/kg-air) + real(r8), pointer :: dryvol(:,:,:) ! single-particle-mean dry volume (m3) + real(r8), pointer :: so4dryvol(:,:,:) ! single-particle-mean so4 dry volume (m3) + real(r8), pointer :: drymass(:,:,:) ! single-particle-mean dry mass (kg) + real(r8), pointer :: dryrad(:,:,:) ! dry volume mean radius of aerosol (m) + + real(r8), allocatable :: wetrad(:,:,:) ! wet radius of aerosol (m) + real(r8), allocatable :: wetvol(:,:,:) ! single-particle-mean wet volume (m3) + real(r8), allocatable :: wtrvol(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) + + real(r8), allocatable :: rhcrystal(:) + real(r8), allocatable :: rhdeliques(:) + real(r8), allocatable :: specdens_1(:) + + real(r8), pointer :: sulfeq(:,:,:) ! H2SO4 equilibrium mixing ratios over particles (mol/mol) + real(r8), allocatable :: wtpct(:,:,:) ! sulfate aerosol composition, weight % H2SO4 + real(r8), allocatable :: sulden(:,:,:) ! sulfate aerosol mass density (g/cm3) + + real(r8) :: specdens, so4specdens + real(r8) :: sigmag + real(r8) :: alnsg + real(r8) :: rh(pcols,pver) ! relative humidity (0-1) + real(r8) :: dmean, qh2so4_equilib, wtpct_mode, sulden_mode + + real(r8) :: es(pcols) ! saturation vapor pressure + real(r8) :: qs(pcols) ! saturation specific humidity + + character(len=3) :: trnum ! used to hold mode number (as characters) + character(len=32) :: spectype + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + list_idx = 0 + if (present(list_idx_in)) then + list_idx = list_idx_in + + ! check that all optional args are present + if (.not. present(dgnumdry_m) .or. .not. present(dgnumwet_m) .or. & + .not. present(qaerwat_m) .or. .not. present(wetdens_m)) then + call endrun('modal_aero_wateruptake_dr called for'// & + 'diagnostic list but required args not present') + end if + + ! arrays for diagnostic calculations must be associated + if (.not. associated(dgnumdry_m) .or. .not. associated(dgnumwet_m) .or. & + .not. associated(qaerwat_m) .or. .not. associated(wetdens_m)) then + call endrun('modal_aero_wateruptake_dr called for'// & + 'diagnostic list but required args not associated') + end if + + if (modal_strat_sulfate) then + call endrun('modal_aero_wateruptake_dr cannot be called with optional arguments and'// & + ' having modal_strat_sulfate set to true') + end if + end if + + ! loop over all aerosol modes + call rad_cnst_get_info(list_idx, nmodes=nmodes) + + if (modal_strat_sulfate) then + call pbuf_get_field(pbuf, sulfeq_idx, sulfeq ) + endif + + allocate( & + wetrad(pcols,pver,nmodes), & + wetvol(pcols,pver,nmodes), & + wtrvol(pcols,pver,nmodes), & + wtpct(pcols,pver,nmodes), & + sulden(pcols,pver,nmodes), & + rhcrystal(nmodes), & + rhdeliques(nmodes), & + specdens_1(nmodes) ) + + wtpct(:,:,:) = 75._r8 + sulden(:,:,:) = 1.923_r8 + + if (list_idx == 0) then + call pbuf_get_field(pbuf, dgnum_idx, dgncur_a ) + call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet ) + call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat) + call pbuf_get_field(pbuf, hygro_idx, hygro) + call pbuf_get_field(pbuf, dryvol_idx, dryvol) + call pbuf_get_field(pbuf, dryrad_idx, dryrad) + call pbuf_get_field(pbuf, drymass_idx, drymass) + call pbuf_get_field(pbuf, so4dryvol_idx, so4dryvol) + call pbuf_get_field(pbuf, naer_idx, naer) + + if (is_first_step()) then + dgncur_awet(:,:,:) = dgncur_a(:,:,:) + end if + else + dgncur_a => dgnumdry_m + dgncur_awet => dgnumwet_m + qaerwat => qaerwat_m + wetdens => wetdens_m + hygro => hygro_m + dryvol => dryvol_m + dryrad => dryrad_m + drymass => drymass_m + so4dryvol => so4dryvol_m + naer => naer_m + end if + + if (modal_strat_sulfate) then + ! get tropopause level + call tropopause_find(state, tropLev, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + endif + + h2ommr => state%q(:,:,1) + t => state%t + pmid => state%pmid + + do m = 1, nmodes + + call rad_cnst_get_mode_props(list_idx, m, sigmag=sigmag, & + rhcrystal=rhcrystal(m), rhdeliques=rhdeliques(m)) + + ! get mode info + call rad_cnst_get_info(list_idx, m, nspec=nspec) + + do l = 1, nspec + + ! get species interstitial mixing ratio ('a') + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + spectype=spectype) + + if (modal_strat_sulfate .and. (trim(spectype).eq.'sulfate')) then + so4specdens=specdens + end if + + if (l == 1) then + ! save off these values to be used as defaults + specdens_1(m) = specdens + end if + + end do + + alnsg = log(sigmag) + + if (modal_strat_sulfate) then + do k = top_lev, pver + do i = 1, ncol + dmean = dgncur_awet(i,k,m)*exp(1.5_r8*alnsg**2) + call calc_h2so4_equilib_mixrat( t(i,k), pmid(i,k), h2ommr(i,k), dmean, & + qh2so4_equilib, wtpct_mode, sulden_mode ) + sulfeq(i,k,m) = qh2so4_equilib + wtpct(i,k,m) = wtpct_mode + sulden(i,k,m) = sulden_mode + end do ! i = 1, ncol + end do ! k = top_lev, pver + + fieldname = ' ' + write(fieldname,fmt='(a,i1)') 'wtpct_a',m + call outfld(fieldname,wtpct(1:ncol,1:pver,m), ncol, lchnk ) + + fieldname = ' ' + write(fieldname,fmt='(a,i1)') 'sulfeq_a',m + call outfld(fieldname,sulfeq(1:ncol,1:pver,m), ncol, lchnk ) + + fieldname = ' ' + write(fieldname,fmt='(a,i1)') 'sulden_a',m + call outfld(fieldname,sulden(1:ncol,1:pver,m), ncol, lchnk ) + + end if + + end do ! m = 1, nmodes + + ! relative humidity calc + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + do k = top_lev, pver + call qsat_water(t(:ncol,k), pmid(:ncol,k), es(:ncol), qs(:ncol)) + do i = 1, ncol + if (qs(i) > h2ommr(i,k)) then + rh(i,k) = h2ommr(i,k)/qs(i) + else + rh(i,k) = 0.98_r8 + endif + rh(i,k) = max(rh(i,k), 0.0_r8) + rh(i,k) = min(rh(i,k), 0.98_r8) + if (cldn(i,k) .lt. 1.0_r8) then + rh(i,k) = (rh(i,k) - cldn(i,k)) / (1.0_r8 - cldn(i,k)) ! clear portion + end if + rh(i,k) = max(rh(i,k), 0.0_r8) + end do + end do + + call modal_aero_wateruptake_sub( & + ncol, nmodes, rhcrystal, rhdeliques, dryrad, & + hygro, rh, dryvol, so4dryvol, so4specdens, tropLev, & + wetrad, wetvol, wtrvol, sulden, wtpct) + + qaerwat = 0.0_r8 + + do m = 1, nmodes + + do k = top_lev, pver + do i = 1, ncol + + dgncur_awet(i,k,m) = dgncur_a(i,k,m) * (wetrad(i,k,m)/dryrad(i,k,m)) + qaerwat(i,k,m) = rhoh2o*naer(i,k,m)*wtrvol(i,k,m) + + ! compute aerosol wet density (kg/m3) + if (wetvol(i,k,m) > 1.0e-30_r8) then + wetdens(i,k,m) = (drymass(i,k,m) + rhoh2o*wtrvol(i,k,m))/wetvol(i,k,m) + else + wetdens(i,k,m) = specdens_1(m) + end if + end do + end do + + end do ! modes + + if (list_idx == 0) then + + do m = 1, nmodes + ! output to history + write( trnum, '(i3.3)' ) m + call outfld( 'wat_a'//trnum(3:3), qaerwat(:,:,m), pcols, lchnk) + call outfld( 'dgnd_a'//trnum(2:3), dgncur_a(:,:,m), pcols, lchnk) + call outfld( 'dgnw_a'//trnum(2:3), dgncur_awet(:,:,m), pcols, lchnk) + end do + + end if + + deallocate( & + wetrad, wetvol, wtrvol, wtpct, sulden, rhcrystal, rhdeliques, specdens_1 ) +end subroutine modal_aero_wateruptake_dr + +!=============================================================================== + +subroutine modal_aero_wateruptake_sub( & + ncol, nmodes, rhcrystal, rhdeliques, dryrad, & + hygro, rh, dryvol, so4dryvol, so4specdens, troplev, & + wetrad, wetvol, wtrvol, sulden, wtpct) + +!----------------------------------------------------------------------- +! +! Purpose: Compute aerosol wet radius +! +! Method: Kohler theory +! +! Author: S. Ghan +! +!----------------------------------------------------------------------- + + + ! Arguments + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nmodes + integer, intent(in) :: troplev(:) + + real(r8), intent(in) :: rhcrystal(:) + real(r8), intent(in) :: rhdeliques(:) + real(r8), intent(in) :: dryrad(:,:,:) ! dry volume mean radius of aerosol (m) + real(r8), intent(in) :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) + real(r8), intent(in) :: rh(:,:) ! relative humidity (0-1) + real(r8), intent(in) :: dryvol(:,:,:) ! dry volume of single aerosol (m3) + real(r8), intent(in) :: so4dryvol(:,:,:) ! dry volume of sulfate in single aerosol (m3) + real(r8), intent(in) :: so4specdens ! mass density sulfate in single aerosol (kg/m3) + real(r8), intent(in) :: wtpct(:,:,:) ! sulfate aerosol composition, weight % H2SO4 + real(r8), intent(in) :: sulden(:,:,:) ! sulfate aerosol mass density (g/cm3) + + real(r8), intent(out) :: wetrad(:,:,:) ! wet radius of aerosol (m) + real(r8), intent(out) :: wetvol(:,:,:) ! single-particle-mean wet volume (m3) + real(r8), intent(out) :: wtrvol(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) + + ! local variables + + integer :: i, k, m + + real(r8) :: hystfac ! working variable for hysteresis + !----------------------------------------------------------------------- + + + ! loop over all aerosol modes + do m = 1, nmodes + + hystfac = 1.0_r8 / max(1.0e-5_r8, (rhdeliques(m) - rhcrystal(m))) + + do k = top_lev, pver + do i = 1, ncol + + if ( modal_strat_sulfate .and. (k Pa + sulfequil = sulfequil * 1.01325e5_r8 + + ! Convert Pa ==> mol/mol + sulfequil = sulfequil / pres + + ! Calculate Kelvin curvature factor for H2SO4 interactively with temperature: + ! (g/mol)*(erg/cm2)/(K * g/cm3 * erg/mol/K) = cm + akelvin = 2._r8 * wtmol_h2so4 * surf_tens_mode / (t * sulden * RGAS) + + expon = akelvin / r ! divide by mode radius (cm) + expon = max(-100._r8, expon) + expon = min(100._r8, expon) + akas = exp( expon ) + qh2so4_equilib = sulfequil * akas ! reduce H2SO4 equilibrium mixing ratio by Kelvin curvature factor + + return + end subroutine calc_h2so4_equilib_mixrat + + +!---------------------------------------------------------------------- + subroutine calc_h2so4_wtpct( temp, pres, qh2o, wtpct ) + + !! This function calculates the weight % H2SO4 composition of + !! sulfate aerosol, using Tabazadeh et. al. (GRL, 1931, 1997). + !! Rated for T=185-260K, activity=0.01-1.0 + !! + !! Argument list input: + !! temp = temperature (K) + !! pres = atmospheric pressure (Pa) + !! qh2o = water specific humidity (kg/kg) + !! + !! Output: + !! wtpct = weight % H2SO4 in H2O/H2SO4 particle (0-100) + !! + !! @author Mike Mills + !! @ version October 2013 + + use wv_saturation, only: qsat_water + + implicit none + + real(r8), intent(in) :: temp ! temperature (K) + real(r8), intent(in) :: pres ! pressure (Pa) + real(r8), intent(in) :: qh2o ! water vapor specific humidity (kg/kg) + real(r8), intent(out) :: wtpct ! sulfate weight % H2SO4 composition + + ! Local declarations + real(r8) :: atab1,btab1,ctab1,dtab1,atab2,btab2,ctab2,dtab2 + real(r8) :: contl, conth, contt, conwtp + real(r8) :: activ + real(r8) :: es ! saturation vapor pressure over water (Pa) (dummy) + real(r8) :: qs ! saturation specific humidity over water (kg/kg) + + ! calculate saturation specific humidity over pure water, qs (kg/kg) + call qsat_water(temp, pres, es, qs) + + ! Activity = water specific humidity (kg/kg) / equilibrium water (kg/kg) + activ = qh2o/qs + + if (activ.lt.0.05_r8) then + activ = max(activ,1.e-6_r8) ! restrict minimum activity + atab1 = 12.37208932_r8 + btab1 = -0.16125516114_r8 + ctab1 = -30.490657554_r8 + dtab1 = -2.1133114241_r8 + atab2 = 13.455394705_r8 + btab2 = -0.1921312255_r8 + ctab2 = -34.285174607_r8 + dtab2 = -1.7620073078_r8 + elseif (activ.ge.0.05_r8.and.activ.le.0.85_r8) then + atab1 = 11.820654354_r8 + btab1 = -0.20786404244_r8 + ctab1 = -4.807306373_r8 + dtab1 = -5.1727540348_r8 + atab2 = 12.891938068_r8 + btab2 = -0.23233847708_r8 + ctab2 = -6.4261237757_r8 + dtab2 = -4.9005471319_r8 + elseif (activ.gt.0.85_r8) then + activ = min(activ,1._r8) ! restrict maximum activity + atab1 = -180.06541028_r8 + btab1 = -0.38601102592_r8 + ctab1 = -93.317846778_r8 + dtab1 = 273.88132245_r8 + atab2 = -176.95814097_r8 + btab2 = -0.36257048154_r8 + ctab2 = -90.469744201_r8 + dtab2 = 267.45509988_r8 + else + write(iulog,*) 'calc_h2so4_wtpct: invalid activity: activ,qh2o,qs,temp,pres=',activ,qh2o,qs,temp,pres + call endrun( 'calc_h2so4_wtpct error' ) + return + endif + + contl = atab1*(activ**btab1)+ctab1*activ+dtab1 + conth = atab2*(activ**btab2)+ctab2*activ+dtab2 + + contt = contl + (conth-contl) * ((temp -190._r8)/70._r8) + conwtp = (contt*98._r8) + 1000._r8 + + wtpct = (100._r8*contt*98._r8)/conwtp + wtpct = min(max(wtpct,25._r8),100._r8) ! restrict between 1 and 100 % + + return + end subroutine calc_h2so4_wtpct + + +!---------------------------------------------------------------------- + + end module modal_aero_wateruptake + + diff --git a/src/chemistry/utils/msise00.F90 b/src/chemistry/utils/msise00.F90 new file mode 100644 index 0000000000..f49330d221 --- /dev/null +++ b/src/chemistry/utils/msise00.F90 @@ -0,0 +1,3052 @@ + SUBROUTINE GTD7(IYD,SEC,ALT,GLAT,GLONG,STL,F107A,F107,AP,MASS,D,T) +! +!----------------------------------------------------------------------- +! NRLMSISE-00 +! ----------- +! Neutral Atmosphere Empirical Model from the surface to lower +! exosphere +! +! NEW FEATURES: +! *Extensive satellite drag database used in model generation +! *Revised O2 (and O) in lower thermosphere +! *Additional nonlinear solar activity term +! *"ANOMALOUS OXYGEN" NUMBER DENSITY, OUTPUT D(9) +! At high altitudes (> 500 km), hot atomic oxygen or ionized +! oxygen can become appreciable for some ranges of subroutine +! inputs, thereby affecting drag on satellites and debris. We +! group these species under the term "anomalous oxygen," since +! their individual variations are not presently separable with +! the drag data used to define this model component. +! +! SUBROUTINES FOR SPECIAL OUTPUTS: +! +! HIGH ALTITUDE DRAG: EFFECTIVE TOTAL MASS DENSITY +! (SUBROUTINE GTD7D, OUTPUT D(6)) +! For atmospheric drag calculations at altitudes above 500 km, +! call SUBROUTINE GTD7D to compute the "effective total mass +! density" by including contributions from "anomalous oxygen." +! See "NOTES ON OUTPUT VARIABLES" below on D(6). +! +! PRESSURE GRID (SUBROUTINE GHP7) +! See subroutine GHP7 to specify outputs at a pressure level +! rather than at an altitude. +! +! OUTPUT IN M-3 and KG/M3: CALL METERS(.TRUE.) +! +! INPUT VARIABLES: +! IYD - YEAR AND DAY AS YYDDD (day of year from 1 to 365 (or 366)) +! (Year ignored in current model) +! SEC - UT(SEC) +! ALT - ALTITUDE(KM) +! GLAT - GEODETIC LATITUDE(DEG) +! GLONG - GEODETIC LONGITUDE(DEG) +! STL - LOCAL APPARENT SOLAR TIME(HRS; see Note below) +! F107A - 81 day AVERAGE OF F10.7 FLUX (centered on day DDD) +! F107 - DAILY F10.7 FLUX FOR PREVIOUS DAY +! AP - MAGNETIC INDEX(DAILY) OR WHEN SW(9)=-1. : +! - ARRAY CONTAINING: +! (1) DAILY AP +! (2) 3 HR AP INDEX FOR CURRENT TIME +! (3) 3 HR AP INDEX FOR 3 HRS BEFORE CURRENT TIME +! (4) 3 HR AP INDEX FOR 6 HRS BEFORE CURRENT TIME +! (5) 3 HR AP INDEX FOR 9 HRS BEFORE CURRENT TIME +! (6) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 12 TO 33 HRS PRIOR +! TO CURRENT TIME +! (7) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 36 TO 57 HRS PRIOR +! TO CURRENT TIME +! MASS - MASS NUMBER (ONLY DENSITY FOR SELECTED GAS IS +! CALCULATED. MASS 0 IS TEMPERATURE. MASS 48 FOR ALL. +! MASS 17 IS Anomalous O ONLY.) +! +! NOTES ON INPUT VARIABLES: +! UT, Local Time, and Longitude are used independently in the +! model and are not of equal importance for every situation. +! For the most physically realistic calculation these three +! variables should be consistent (STL=SEC/3600+GLONG/15). +! The Equation of Time departures from the above formula +! for apparent local time can be included if available but +! are of minor importance. +! +! F107 and F107A values used to generate the model correspond +! to the 10.7 cm radio flux at the actual distance of the Earth +! from the Sun rather than the radio flux at 1 AU. The following +! site provides both classes of values: +! ftp://ftp.ngdc.noaa.gov/STP/SOLAR_DATA/SOLAR_RADIO/FLUX/ +! +! F107, F107A, and AP effects are neither large nor well +! established below 80 km and these parameters should be set to +! 150., 150., and 4. respectively. +! +! OUTPUT VARIABLES: +! D(1) - HE NUMBER DENSITY(CM-3) +! D(2) - O NUMBER DENSITY(CM-3) +! D(3) - N2 NUMBER DENSITY(CM-3) +! D(4) - O2 NUMBER DENSITY(CM-3) +! D(5) - AR NUMBER DENSITY(CM-3) +! D(6) - TOTAL MASS DENSITY(GM/CM3) +! D(7) - H NUMBER DENSITY(CM-3) +! D(8) - N NUMBER DENSITY(CM-3) +! D(9) - Anomalous oxygen NUMBER DENSITY(CM-3) +! T(1) - EXOSPHERIC TEMPERATURE +! T(2) - TEMPERATURE AT ALT +! +! NOTES ON OUTPUT VARIABLES: +! TO GET OUTPUT IN M-3 and KG/M3: CALL METERS(.TRUE.) +! +! O, H, and N are set to zero below 72.5 km +! +! T(1), Exospheric temperature, is set to global average for +! altitudes below 120 km. The 120 km gradient is left at global +! average value for altitudes below 72 km. +! +! D(6), TOTAL MASS DENSITY, is NOT the same for subroutines GTD7 +! and GTD7D +! +! SUBROUTINE GTD7 -- D(6) is the sum of the mass densities of the +! species labeled by indices 1-5 and 7-8 in output variable D. +! This includes He, O, N2, O2, Ar, H, and N but does NOT include +! anomalous oxygen (species index 9). +! +! SUBROUTINE GTD7D -- D(6) is the "effective total mass density +! for drag" and is the sum of the mass densities of all species +! in this model, INCLUDING anomalous oxygen. +! +! SWITCHES: The following is for test and special purposes: +! +! TO TURN ON AND OFF PARTICULAR VARIATIONS CALL TSELEC(SW), +! WHERE SW IS A 25 ELEMENT ARRAY CONTAINING 0. FOR OFF, 1. +! FOR ON, OR 2. FOR MAIN EFFECTS OFF BUT CROSS TERMS ON +! FOR THE FOLLOWING VARIATIONS +! 1 - F10.7 EFFECT ON MEAN 2 - TIME INDEPENDENT +! 3 - SYMMETRICAL ANNUAL 4 - SYMMETRICAL SEMIANNUAL +! 5 - ASYMMETRICAL ANNUAL 6 - ASYMMETRICAL SEMIANNUAL +! 7 - DIURNAL 8 - SEMIDIURNAL +! 9 - DAILY AP 10 - ALL UT/LONG EFFECTS +! 11 - LONGITUDINAL 12 - UT AND MIXED UT/LONG +! 13 - MIXED AP/UT/LONG 14 - TERDIURNAL +! 15 - DEPARTURES FROM DIFFUSIVE EQUILIBRIUM +! 16 - ALL TINF VAR 17 - ALL TLB VAR +! 18 - ALL TN1 VAR 19 - ALL S VAR +! 20 - ALL TN2 VAR 21 - ALL NLB VAR +! 22 - ALL TN3 VAR 23 - TURBO SCALE HEIGHT VAR +! +! To get current values of SW: CALL TRETRV(SW) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-------------------------------Commons--------------------------------- +! + real(r8) tlb, s, db04, db16, db28, db32, db40, db48, db01, & + za, t0, z0, g0, rl, dd, db14, tr12 + COMMON/GTS3C/TLB,S,DB04,DB16,DB28,DB32,DB40,DB48,DB01,ZA,T0,Z0 & + ,G0,RL,DD,DB14,TR12 + + real(r8) tn1, tn2, tn3, tgn1, tgn2, tgn3 + COMMON/MESO7/TN1(5),TN2(4),TN3(5),TGN1(2),TGN2(2),TGN3(2) + + real(r8) ptm, pdm + COMMON/LOWER7/PTM(10),PDM(10,8) + + real(r8) pt, pd, ps, pdl, ptl, pma, sam + COMMON/PARM7/PT(150),PD(150,9),PS(150),PDL(25,2),PTL(100,4), & + PMA(100,10),SAM(100) + + character*4 isd, ist, nam + COMMON/DATIM7/ISD(3),IST(2),NAM(2) + + character*4 ISDATE, ISTIME, NAME + COMMON/DATIME/ISDATE(3),ISTIME(2),NAME(2) + + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW + + real(r8) pavgm + COMMON/MAVG7/PAVGM(10) + + real(r8) dm04, dm16, dm28, dm32, dm40, dm01, dm14 + COMMON/DMIX/DM04,DM16,DM28,DM32,DM40,DM01,DM14 + + real(r8) gsurf, re + COMMON/PARMB/GSURF,RE + + integer imr + COMMON/METSEL/IMR +! +!------------------------------Arguments-------------------------------- +! + integer iyd, mass + real(r8) sec, alt, glat, glong, stl, f107a, f107 + real(r8) D(9),T(2),AP(7) +! +!---------------------------Local variables----------------------------- +! + integer i, j, mssx + real(r8) dmc, dm28m, tz, dz28, dmr, v1 + real(r8) altt, xlat, xmm + real(r8) DS(9),TS(2) + + integer mn3 + real(r8) ZN3(5) + DATA MN3/5/,ZN3/32.5_r8,20._r8,15._r8,10._r8,0._r8/ + + integer mn2 + real(r8) ZN2(4) + DATA MN2/4/,ZN2/72.5_r8,55._r8,45._r8,32.5_r8/ + + integer mssl + real(r8) zmix, alast + DATA ZMIX/62.5_r8/,ALAST/99999._r8/,MSSL/-999/ + + real(r8) SV(25) + DATA SV/25*1._r8/ + + SAVE +! +!-------------------------External Functions---------------------------- +! + EXTERNAL GTD7BK + + real(r8) densm, glob7s, vtst7 + external densm, glob7s, vtst7 +! +!----------------------------------------------------------------------- +! + IF(ISW.NE.64999) CALL TSELEC(SV) +! Put identification data into common/datime/ + DO 1 I=1,3 + ISDATE(I)=ISD(I) + 1 CONTINUE + DO 2 I=1,2 + ISTIME(I)=IST(I) + NAME(I)=NAM(I) + 2 CONTINUE +! +! Test for changed input + V1=VTST7(IYD,SEC,GLAT,GLONG,STL,F107A,F107,AP,1) +! Latitude variation of gravity (none for SW(2)=0) + XLAT=GLAT + IF(SW(2).EQ.0) XLAT=45._r8 + CALL GLATF(XLAT,GSURF,RE) +! + XMM=PDM(5,3) +! +! THERMOSPHERE/MESOSPHERE (above ZN2(1)) + ALTT=MAX(ALT,ZN2(1)) + MSSX=MASS +! Only calculate N2 in thermosphere if alt in mixed region + IF(ALT.LT.ZMIX.AND.MASS.GT.0) MSSX=28 +! Only calculate thermosphere if input parameters changed +! or altitude above ZN2(1) in mesosphere + IF(V1.EQ.1._r8.OR.ALT.GT.ZN2(1).OR.ALAST.GT.ZN2(1).OR.MSSX.NE.MSSL) & + THEN + CALL GTS7(IYD,SEC,ALTT,GLAT,GLONG,STL,F107A,F107,AP,MSSX,DS,TS) + DM28M=DM28 +! metric adjustment + IF(IMR.EQ.1) DM28M=DM28*1.E6_r8 + MSSL=MSSX + ENDIF + T(1)=TS(1) + T(2)=TS(2) + IF(ALT.GE.ZN2(1)) THEN + DO 5 J=1,9 + D(J)=DS(J) + 5 CONTINUE + GOTO 10 + ENDIF +! +! LOWER MESOSPHERE/UPPER STRATOSPHERE [between ZN3(1) and ZN2(1)] +! Temperature at nodes and gradients at end nodes +! Inverse temperature a linear function of spherical harmonics +! Only calculate nodes if input changed + IF(V1.EQ.1._r8.OR.ALAST.GE.ZN2(1)) THEN + TGN2(1)=TGN1(2) + TN2(1)=TN1(5) + TN2(2)=PMA(1,1)*PAVGM(1)/(1._r8-SW(20)*GLOB7S(PMA(1,1))) + TN2(3)=PMA(1,2)*PAVGM(2)/(1._r8-SW(20)*GLOB7S(PMA(1,2))) + TN2(4)=PMA(1,3)*PAVGM(3)/(1._r8-SW(20)*SW(22)*GLOB7S(PMA(1,3))) + TGN2(2)=PAVGM(9)*PMA(1,10)*(1._r8+SW(20)*SW(22)*GLOB7S(PMA(1,10))) & + *TN2(4)*TN2(4)/(PMA(1,3)*PAVGM(3))**2 + TN3(1)=TN2(4) + ENDIF + IF(ALT.GE.ZN3(1)) GOTO 6 +! +! LOWER STRATOSPHERE AND TROPOSPHERE [below ZN3(1)] +! Temperature at nodes and gradients at end nodes +! Inverse temperature a linear function of spherical harmonics +! Only calculate nodes if input changed + IF(V1.EQ.1._r8.OR.ALAST.GE.ZN3(1)) THEN + TGN3(1)=TGN2(2) + TN3(2)=PMA(1,4)*PAVGM(4)/(1._r8-SW(22)*GLOB7S(PMA(1,4))) + TN3(3)=PMA(1,5)*PAVGM(5)/(1._r8-SW(22)*GLOB7S(PMA(1,5))) + TN3(4)=PMA(1,6)*PAVGM(6)/(1._r8-SW(22)*GLOB7S(PMA(1,6))) + TN3(5)=PMA(1,7)*PAVGM(7)/(1._r8-SW(22)*GLOB7S(PMA(1,7))) + TGN3(2)=PMA(1,8)*PAVGM(8)*(1._r8+SW(22)*GLOB7S(PMA(1,8))) & + *TN3(5)*TN3(5)/(PMA(1,7)*PAVGM(7))**2 + ENDIF + 6 CONTINUE + IF(MASS.EQ.0) GOTO 50 +! LINEAR TRANSITION TO FULL MIXING BELOW ZN2(1) + DMC=0 + IF(ALT.GT.ZMIX) DMC=1._r8-(ZN2(1)-ALT)/(ZN2(1)-ZMIX) + DZ28=DS(3) +! ***** N2 DENSITY **** + DMR=DS(3)/DM28M-1._r8 + D(3)=DENSM(ALT,DM28M,XMM,TZ,MN3,ZN3,TN3,TGN3,MN2,ZN2,TN2,TGN2) + D(3)=D(3)*(1._r8+DMR*DMC) +! ***** HE DENSITY **** + D(1)=0 + IF(MASS.NE.4.AND.MASS.NE.48) GOTO 204 + DMR=DS(1)/(DZ28*PDM(2,1))-1._r8 + D(1)=D(3)*PDM(2,1)*(1._r8+DMR*DMC) + 204 CONTINUE +! **** O DENSITY **** + D(2)=0 + D(9)=0 + 216 CONTINUE +! ***** O2 DENSITY **** + D(4)=0 + IF(MASS.NE.32.AND.MASS.NE.48) GOTO 232 + DMR=DS(4)/(DZ28*PDM(2,4))-1._r8 + D(4)=D(3)*PDM(2,4)*(1._r8+DMR*DMC) + 232 CONTINUE +! ***** AR DENSITY **** + D(5)=0 + IF(MASS.NE.40.AND.MASS.NE.48) GOTO 240 + DMR=DS(5)/(DZ28*PDM(2,5))-1._r8 + D(5)=D(3)*PDM(2,5)*(1._r8+DMR*DMC) + 240 CONTINUE +! ***** HYDROGEN DENSITY **** + D(7)=0 +! ***** ATOMIC NITROGEN DENSITY **** + D(8)=0 +! +! TOTAL MASS DENSITY +! + IF(MASS.EQ.48) THEN + D(6) = 1.66E-24_r8*(4._r8*D(1)+16._r8*D(2)+28._r8*D(3)+32._r8*D(4)+40._r8*D(5)+ & + D(7)+14._r8*D(8)) + IF(IMR.EQ.1) D(6)=D(6)/1000._r8 + ENDIF + T(2)=TZ + 10 CONTINUE + GOTO 90 + 50 CONTINUE + DD=DENSM(ALT,1._r8,0._r8,TZ,MN3,ZN3,TN3,TGN3,MN2,ZN2,TN2,TGN2) + T(2)=TZ + 90 CONTINUE + ALAST=ALT + RETURN + END SUBROUTINE GTD7 + +!================================================================================================ + + SUBROUTINE GTD7D(IYD,SEC,ALT,GLAT,GLONG,STL,F107A,F107,AP,MASS, & + D,T) +! +!----------------------------------------------------------------------- +! NRLMSISE-00 +! ----------- +! This subroutine provides Effective Total Mass Density for +! output D(6) which includes contributions from "anomalous +! oxygen" which can affect satellite drag above 500 km. This +! subroutine is part of the distribution package for the +! Neutral Atmosphere Empirical Model from the surface to lower +! exosphere. See subroutine GTD7 for more extensive comments. +! +! INPUT VARIABLES: +! IYD - YEAR AND DAY AS YYDDD (day of year from 1 to 365 (or 366)) +! (Year ignored in current model) +! SEC - UT(SEC) +! ALT - ALTITUDE(KM) +! GLAT - GEODETIC LATITUDE(DEG) +! GLONG - GEODETIC LONGITUDE(DEG) +! STL - LOCAL APPARENT SOLAR TIME(HRS; see Note below) +! F107A - 81 day AVERAGE OF F10.7 FLUX (centered on day DDD) +! F107 - DAILY F10.7 FLUX FOR PREVIOUS DAY +! AP - MAGNETIC INDEX(DAILY) OR WHEN SW(9)=-1. : +! - ARRAY CONTAINING: +! (1) DAILY AP +! (2) 3 HR AP INDEX FOR CURRENT TIME +! (3) 3 HR AP INDEX FOR 3 HRS BEFORE CURRENT TIME +! (4) 3 HR AP INDEX FOR 6 HRS BEFORE CURRENT TIME +! (5) 3 HR AP INDEX FOR 9 HRS BEFORE CURRENT TIME +! (6) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 12 TO 33 HRS PRIOR +! TO CURRENT TIME +! (7) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 36 TO 57 HRS PRIOR +! TO CURRENT TIME +! MASS - MASS NUMBER (ONLY DENSITY FOR SELECTED GAS IS +! CALCULATED. MASS 0 IS TEMPERATURE. MASS 48 FOR ALL. +! MASS 17 IS Anomalous O ONLY.) +! +! NOTES ON INPUT VARIABLES: +! UT, Local Time, and Longitude are used independently in the +! model and are not of equal importance for every situation. +! For the most physically realistic calculation these three +! variables should be consistent (STL=SEC/3600+GLONG/15). +! The Equation of Time departures from the above formula +! for apparent local time can be included if available but +! are of minor importance. +! +! F107 and F107A values used to generate the model correspond +! to the 10.7 cm radio flux at the actual distance of the Earth +! from the Sun rather than the radio flux at 1 AU. +! +! OUTPUT VARIABLES: +! D(1) - HE NUMBER DENSITY(CM-3) +! D(2) - O NUMBER DENSITY(CM-3) +! D(3) - N2 NUMBER DENSITY(CM-3) +! D(4) - O2 NUMBER DENSITY(CM-3) +! D(5) - AR NUMBER DENSITY(CM-3) +! D(6) - TOTAL MASS DENSITY(GM/CM3) [includes anomalous oxygen] +! D(7) - H NUMBER DENSITY(CM-3) +! D(8) - N NUMBER DENSITY(CM-3) +! D(9) - Anomalous oxygen NUMBER DENSITY(CM-3) +! T(1) - EXOSPHERIC TEMPERATURE +! T(2) - TEMPERATURE AT ALT +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-------------------------------Commons--------------------------------- +! + integer imr + COMMON/METSEL/IMR +! +!------------------------------Arguments-------------------------------- +! + integer iyd, mass + real(r8) sec, alt, glat, glong, stl, f107a, f107 + real(r8) D(9),T(2),AP(7) +! +!---------------------------Local variables----------------------------- +! + real(r8) DS(9),TS(2) +! +!----------------------------------------------------------------------- +! + CALL GTD7(IYD,SEC,ALT,GLAT,GLONG,STL,F107A,F107,AP,MASS,D,T) +! TOTAL MASS DENSITY +! + IF(MASS.EQ.48) THEN + D(6) = 1.66E-24_r8*(4._r8*D(1)+16._r8*D(2)+28._r8*D(3)+32._r8*D(4)+40._r8*D(5)+ & + D(7)+14._r8*D(8)+16._r8*D(9)) + IF(IMR.EQ.1) D(6)=D(6)/1000._r8 + ENDIF + RETURN + END SUBROUTINE GTD7D + +!================================================================================================ + + SUBROUTINE GHP7(IYD,SEC,ALT,GLAT,GLONG,STL,F107A,F107,AP, & + D,T,PRESS) +! +!----------------------------------------------------------------------- +! FIND ALTITUDE OF PRESSURE SURFACE (PRESS) FROM GTD7 +! INPUT: +! IYD - YEAR AND DAY AS YYDDD +! SEC - UT(SEC) +! GLAT - GEODETIC LATITUDE(DEG) +! GLONG - GEODETIC LONGITUDE(DEG) +! STL - LOCAL APPARENT SOLAR TIME(HRS) +! F107A - 3 MONTH AVERAGE OF F10.7 FLUX +! F107 - DAILY F10.7 FLUX FOR PREVIOUS DAY +! AP - MAGNETIC INDEX(DAILY) OR WHEN SW(9)=-1. : +! - ARRAY CONTAINING: +! (1) DAILY AP +! (2) 3 HR AP INDEX FOR CURRENT TIME +! (3) 3 HR AP INDEX FOR 3 HRS BEFORE CURRENT TIME +! (4) 3 HR AP INDEX FOR 6 HRS BEFORE CURRENT TIME +! (5) 3 HR AP INDEX FOR 9 HRS BEFORE CURRENT TIME +! (6) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 12 TO 33 HRS PRIOR +! TO CURRENT TIME +! (7) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 36 TO 59 HRS PRIOR +! TO CURRENT TIME +! PRESS - PRESSURE LEVEL(MB) +! OUTPUT: +! ALT - ALTITUDE(KM) +! D(1) - HE NUMBER DENSITY(CM-3) +! D(2) - O NUMBER DENSITY(CM-3) +! D(3) - N2 NUMBER DENSITY(CM-3) +! D(4) - O2 NUMBER DENSITY(CM-3) +! D(5) - AR NUMBER DENSITY(CM-3) +! D(6) - TOTAL MASS DENSITY(GM/CM3) +! D(7) - H NUMBER DENSITY(CM-3) +! D(8) - N NUMBER DENSITY(CM-3) +! D(9) - HOT O NUMBER DENSITY(CM-3) +! T(1) - EXOSPHERIC TEMPERATURE +! T(2) - TEMPERATURE AT ALT +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none +! +!-------------------------------Commons--------------------------------- +! + real(r8) gsurf, re + COMMON/PARMB/GSURF,RE + + integer imr + COMMON/METSEL/IMR +! +!------------------------------Arguments-------------------------------- +! + integer iyd + real(r8) sec, alt, glat, glong, stl, f107a, f107, press + real(r8) D(9),T(2),AP(7) +! +!---------------------------Local variables----------------------------- +! + integer l, iday + real(r8) p, xn, diff, sh, g, xm, z, zi, pl, cl, ca, cd, cl2 + + real(r8) bm, rgas + DATA BM/1.3806E-19_r8/,RGAS/831.4_r8/ + + integer ltest + real(r8) test + DATA TEST/.00043_r8/,LTEST/12/ + + SAVE +! +!----------------------------------------------------------------------- +! + PL=LOG10(PRESS) +! Initial altitude estimate + IF(PL.GE.-5._r8) THEN + IF(PL.GT.2.5_r8) ZI=18.06_r8*(3.00_r8-PL) + IF(PL.GT..75_r8.AND.PL.LE.2.5_r8) ZI=14.98_r8*(3.08_r8-PL) + IF(PL.GT.-1._r8.AND.PL.LE..75_r8) ZI=17.8_r8*(2.72_r8-PL) + IF(PL.GT.-2._r8.AND.PL.LE.-1._r8) ZI=14.28_r8*(3.64_r8-PL) + IF(PL.GT.-4._r8.AND.PL.LE.-2._r8) ZI=12.72_r8*(4.32_r8-PL) + IF(PL.LE.-4._r8) ZI=25.3_r8*(.11_r8-PL) + IDAY=MOD(IYD,1000) + CL=GLAT/90._r8 + CL2=CL*CL + IF(IDAY.LT.182) CD=1._r8-IDAY/91.25_r8 + IF(IDAY.GE.182) CD=IDAY/91.25_r8-3._r8 + CA=0 + IF(PL.GT.-1.11_r8.AND.PL.LE.-.23_r8) CA=1.0_r8 + IF(PL.GT.-.23_r8) CA=(2.79_r8-PL)/(2.79_r8+.23_r8) + IF(PL.LE.-1.11_r8.AND.PL.GT.-3._r8) CA=(-2.93_r8-PL)/(-2.93_r8+1.11_r8) + Z=ZI-4.87_r8*CL*CD*CA-1.64_r8*CL2*CA+.31_r8*CA*CL + ENDIF + IF(PL.LT.-5._r8) Z=22._r8*(PL+4._r8)**2+110 +! ITERATION LOOP + L=0 + 10 CONTINUE + L=L+1 + CALL GTD7(IYD,SEC,Z,GLAT,GLONG,STL,F107A,F107,AP,48,D,T) + XN=D(1)+D(2)+D(3)+D(4)+D(5)+D(7)+D(8) + P=BM*XN*T(2) + IF(IMR.EQ.1) P=P*1.E-6_r8 + DIFF=PL-LOG10(P) + IF(ABS(DIFF).LT.TEST .OR. L.EQ.LTEST) GOTO 20 + XM=D(6)/XN/1.66E-24_r8 + IF(IMR.EQ.1) XM = XM*1.E3_r8 + G=GSURF/(1._r8+Z/RE)**2 + SH=RGAS*T(2)/(XM*G) +! New altitude estimate using scale height + IF(L.LT.6) THEN + Z=Z-SH*DIFF*2.302_r8 + ELSE + Z=Z-SH*DIFF + ENDIF + GOTO 10 + 20 CONTINUE + IF(L.EQ.LTEST) write(iulog,100) PRESS,DIFF + 100 FORMAT(1X,29HGHP7 NOT CONVERGING FOR PRESS, 1PE12.2,E12.2) + ALT=Z + RETURN + END SUBROUTINE GHP7 + +!================================================================================================ + + SUBROUTINE GLATF(LAT,GV,REFF) +! +!----------------------------------------------------------------------- +! CALCULATE LATITUDE VARIABLE GRAVITY (GV) AND EFFECTIVE +! RADIUS (REFF) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + REAL(r8) LAT + real(r8) gv, reff +! +!---------------------------Local variables----------------------------- +! + real(r8) c2 + + real(r8) dgtr + DATA DGTR/1.74533E-2_r8/ + + SAVE +! +!----------------------------------------------------------------------- +! + C2 = COS(2._r8*DGTR*LAT) + GV = 980.616_r8*(1._r8-.0026373_r8*C2) + REFF = 2._r8*GV/(3.085462E-6_r8 + 2.27E-9_r8*C2)*1.E-5_r8 + RETURN + END SUBROUTINE GLATF + +!================================================================================================ + + FUNCTION VTST7(IYD,SEC,GLAT,GLONG,STL,F107A,F107,AP,IC) +! +!----------------------------------------------------------------------- +! Test if geophysical variables or switches changed and save +! Return 0 if unchanged and 1 if changed +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) vtst7 +! +!-------------------------------Commons--------------------------------- +! + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW +! +!------------------------------Arguments-------------------------------- +! + integer iyd, ic + real(r8) sec, glat, glong, stl, f107a, f107 + real(r8) AP(7) +! +!---------------------------Local variables----------------------------- +! + integer i + + integer IYDL(2) + real(r8) SECL(2),GLATL(2),GLL(2) + DATA IYDL/2*-999/,SECL/2*-999._r8/,GLATL/2*-999._r8/,GLL/2*-999._r8/ + + real(r8) STLL(2),FAL(2),FL(2),APL(7,2) + DATA STLL/2*-999._r8/,FAL/2*-999._r8/,FL/2*-999._r8/,APL/14*-999._r8/ + + real(r8) SWL(25,2),SWCL(25,2) + DATA SWL/50*-999._r8/,SWCL/50*-999._r8/ + + SAVE +! +!----------------------------------------------------------------------- +! + VTST7=0 + IF(IYD.NE.IYDL(IC)) GOTO 10 + IF(SEC.NE.SECL(IC)) GOTO 10 + IF(GLAT.NE.GLATL(IC)) GOTO 10 + IF(GLONG.NE.GLL(IC)) GOTO 10 + IF(STL.NE.STLL(IC)) GOTO 10 + IF(F107A.NE.FAL(IC)) GOTO 10 + IF(F107.NE.FL(IC)) GOTO 10 + DO 5 I=1,7 + IF(AP(I).NE.APL(I,IC)) GOTO 10 + 5 CONTINUE + DO 7 I=1,25 + IF(SW(I).NE.SWL(I,IC)) GOTO 10 + IF(SWC(I).NE.SWCL(I,IC)) GOTO 10 + 7 CONTINUE + GOTO 20 + 10 CONTINUE + VTST7=1 + IYDL(IC)=IYD + SECL(IC)=SEC + GLATL(IC)=GLAT + GLL(IC)=GLONG + STLL(IC)=STL + FAL(IC)=F107A + FL(IC)=F107 + DO 15 I=1,7 + APL(I,IC)=AP(I) + 15 CONTINUE + DO 16 I=1,25 + SWL(I,IC)=SW(I) + SWCL(I,IC)=SWC(I) + 16 CONTINUE + 20 CONTINUE + RETURN + END FUNCTION VTST7 + +!================================================================================================ + + SUBROUTINE GTS7(IYD,SEC,ALT,GLAT,GLONG,STL,F107A,F107,AP,MASS,D,T) +! +!----------------------------------------------------------------------- +! Thermospheric portion of NRLMSISE-00 +! See GTD7 for more extensive comments +! +! OUTPUT IN M-3 and KG/M3: CALL METERS(.TRUE.) +! +! INPUT VARIABLES: +! IYD - YEAR AND DAY AS YYDDD (day of year from 1 to 365 (or 366)) +! (Year ignored in current model) +! SEC - UT(SEC) +! ALT - ALTITUDE(KM) (>72.5 km) +! GLAT - GEODETIC LATITUDE(DEG) +! GLONG - GEODETIC LONGITUDE(DEG) +! STL - LOCAL APPARENT SOLAR TIME(HRS; see Note below) +! F107A - 81 day AVERAGE OF F10.7 FLUX (centered on day DDD) +! F107 - DAILY F10.7 FLUX FOR PREVIOUS DAY +! AP - MAGNETIC INDEX(DAILY) OR WHEN SW(9)=-1. : +! - ARRAY CONTAINING: +! (1) DAILY AP +! (2) 3 HR AP INDEX FOR CURRENT TIME +! (3) 3 HR AP INDEX FOR 3 HRS BEFORE CURRENT TIME +! (4) 3 HR AP INDEX FOR 6 HRS BEFORE CURRENT TIME +! (5) 3 HR AP INDEX FOR 9 HRS BEFORE CURRENT TIME +! (6) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 12 TO 33 HRS PRIOR +! TO CURRENT TIME +! (7) AVERAGE OF EIGHT 3 HR AP INDICIES FROM 36 TO 57 HRS PRIOR +! TO CURRENT TIME +! MASS - MASS NUMBER (ONLY DENSITY FOR SELECTED GAS IS +! CALCULATED. MASS 0 IS TEMPERATURE. MASS 48 FOR ALL. +! MASS 17 IS Anomalous O ONLY.) +! +! NOTES ON INPUT VARIABLES: +! UT, Local Time, and Longitude are used independently in the +! model and are not of equal importance for every situation. +! For the most physically realistic calculation these three +! variables should be consistent (STL=SEC/3600+GLONG/15). +! The Equation of Time departures from the above formula +! for apparent local time can be included if available but +! are of minor importance. +! +! F107 and F107A values used to generate the model correspond +! to the 10.7 cm radio flux at the actual distance of the Earth +! from the Sun rather than the radio flux at 1 AU. The following +! site provides both classes of values: +! ftp://ftp.ngdc.noaa.gov/STP/SOLAR_DATA/SOLAR_RADIO/FLUX/ +! +! F107, F107A, and AP effects are neither large nor well +! established below 80 km and these parameters should be set to +! 150., 150., and 4. respectively. +! +! OUTPUT VARIABLES: +! D(1) - HE NUMBER DENSITY(CM-3) +! D(2) - O NUMBER DENSITY(CM-3) +! D(3) - N2 NUMBER DENSITY(CM-3) +! D(4) - O2 NUMBER DENSITY(CM-3) +! D(5) - AR NUMBER DENSITY(CM-3) +! D(6) - TOTAL MASS DENSITY(GM/CM3) [Anomalous O NOT included] +! D(7) - H NUMBER DENSITY(CM-3) +! D(8) - N NUMBER DENSITY(CM-3) +! D(9) - Anomalous oxygen NUMBER DENSITY(CM-3) +! T(1) - EXOSPHERIC TEMPERATURE +! T(2) - TEMPERATURE AT ALT +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none +! +!-------------------------------Commons--------------------------------- +! + real(r8) tlb, s, db04, db16, db28, db32, db40, db48, db01 + real(r8) za, t0, z0, g0, rl, dd, db14, tr12 + COMMON/GTS3C/TLB,S,DB04,DB16,DB28,DB32,DB40,DB48,DB01,ZA,T0,Z0 & + ,G0,RL,DD,DB14,TR12 + + real(r8) tn1, tn2, tn3, tgn1, tgn2, tgn3 + COMMON/MESO7/TN1(5),TN2(4),TN3(5),TGN1(2),TGN2(2),TGN3(2) + + real(r8) ptm, pdm + COMMON/LOWER7/PTM(10),PDM(10,8) + + real(r8) pt, pd, ps, pdl, ptl, pma, sam + COMMON/PARM7/PT(150),PD(150,9),PS(150),PDL(25,2),PTL(100,4), & + PMA(100,10),SAM(100) + + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW + + real(r8) tinfg, gb, rout, tt + COMMON/TTEST/TINFG,GB,ROUT,TT(15) + + real(r8) dm04, dm16, dm28, dm32, dm40, dm01, dm14 + COMMON/DMIX/DM04,DM16,DM28,DM32,DM40,DM01,DM14 + + integer imr + COMMON/METSEL/IMR +! +!------------------------------Arguments-------------------------------- +! + integer iyd, mass + real(r8) sec, alt, glat, glong, stl, f107a, f107 + real(r8) D(9),T(2),AP(*) +! +!---------------------------Local variables----------------------------- +! + integer i, j + real(r8) zh01, b01, g1, hc40, zc40, hcc01, zcc01, zc01 + real(r8) zhm01, hc01, hcc32, zcc32, zc32, zhm32, hc32 + real(r8) b40, zhm40, zh40, rc32, g40, t2, zsht, tho + real(r8) g16h, db16h, ddum, zmho, zsho, b14, zhm14 + real(r8) zh14, rc01, g14, zcc14, rc14, hcc14, hc14, zc14 + real(r8) b32, xmm, z, zhf, g28, day, xmd, b28, zhm28 + real(r8) zh28, v2 + real(r8) tinf, yrd, hc16, zc16, zhm16, zh16, b16 + real(r8) g32, zh32, rc16, hcc16, zcc16, zh04, b04, g4, tz + real(r8) g16, hc04, zhm04, zc04 + + integer mt(11) + DATA MT/48,0,4,16,28,32,40,1,49,14,17/ + + real(r8) altl(8) + DATA ALTL/200._r8,300._r8,160._r8,250._r8,240._r8,450._r8,320._r8,450._r8/ + + integer mn1 + real(r8) ZN1(5) + DATA MN1/5/,ZN1/120._r8,110._r8,100._r8,90._r8,72.5_r8/ + + real(r8) dgtr, dr, alast + DATA DGTR/1.74533E-2_r8/,DR/1.72142E-2_r8/,ALAST/-999._r8/ + + real(r8) ALPHA(9) + DATA ALPHA/-0.38_r8,0._r8,0._r8,0._r8,0.17_r8,0._r8,-0.38_r8,0._r8,0._r8/ + + SAVE +! +!-------------------------External Functions---------------------------- +! + real(r8) ccor, dnet, densu, globe7, glob7s, scalh, vtst7 + external ccor, dnet, densu, globe7, glob7s, scalh, vtst7 +! +!----------------------------------------------------------------------- +! +! Test for changed input + V2=VTST7(IYD,SEC,GLAT,GLONG,STL,F107A,F107,AP,2) +! + YRD=IYD + ZA=PDL(16,2) + ZN1(1)=ZA + DO 2 J=1,9 + D(J)=0._r8 + 2 CONTINUE +! TINF VARIATIONS NOT IMPORTANT BELOW ZA OR ZN1(1) + IF(ALT.GT.ZN1(1)) THEN + IF(V2.EQ.1._r8.OR.ALAST.LE.ZN1(1)) TINF=PTM(1)*PT(1) & + *(1._r8+SW(16)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PT)) + ELSE + TINF=PTM(1)*PT(1) + ENDIF + T(1)=TINF +! GRADIENT VARIATIONS NOT IMPORTANT BELOW ZN1(5) + IF(ALT.GT.ZN1(5)) THEN + IF(V2.EQ.1.OR.ALAST.LE.ZN1(5)) G0=PTM(4)*PS(1) & + *(1._r8+SW(19)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PS)) + ELSE + G0=PTM(4)*PS(1) + ENDIF +! Calculate these temperatures only if input changed + IF(V2.EQ.1._r8 .OR. ALT.LT.300._r8) & + TLB=PTM(2)*(1._r8+SW(17)*GLOBE7(YRD,SEC,GLAT,GLONG,STL, & + F107A,F107,AP,PD(1,4)))*PD(1,4) + S=G0/(TINF-TLB) +! Lower thermosphere temp variations not significant for +! density above 300 km + IF(ALT.LT.300._r8) THEN + IF(V2.EQ.1._r8.OR.ALAST.GE.300._r8) THEN + TN1(2)=PTM(7)*PTL(1,1)/(1._r8-SW(18)*GLOB7S(PTL(1,1))) + TN1(3)=PTM(3)*PTL(1,2)/(1._r8-SW(18)*GLOB7S(PTL(1,2))) + TN1(4)=PTM(8)*PTL(1,3)/(1._r8-SW(18)*GLOB7S(PTL(1,3))) + TN1(5)=PTM(5)*PTL(1,4)/(1._r8-SW(18)*SW(20)*GLOB7S(PTL(1,4))) + TGN1(2)=PTM(9)*PMA(1,9)*(1._r8+SW(18)*SW(20)*GLOB7S(PMA(1,9))) & + *TN1(5)*TN1(5)/(PTM(5)*PTL(1,4))**2 + ENDIF + ELSE + TN1(2)=PTM(7)*PTL(1,1) + TN1(3)=PTM(3)*PTL(1,2) + TN1(4)=PTM(8)*PTL(1,3) + TN1(5)=PTM(5)*PTL(1,4) + TGN1(2)=PTM(9)*PMA(1,9) & + *TN1(5)*TN1(5)/(PTM(5)*PTL(1,4))**2 + ENDIF +! + Z0=ZN1(4) + T0=TN1(4) + TR12=1._r8 +! + IF(MASS.EQ.0) GO TO 50 +! N2 variation factor at Zlb + G28=SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107, & + AP,PD(1,3)) + DAY=MOD(YRD,1000._r8) +! VARIATION OF TURBOPAUSE HEIGHT + ZHF=PDL(25,2) & + *(1._r8+SW(5)*PDL(25,1)*SIN(DGTR*GLAT)*COS(DR*(DAY-PT(14)))) + YRD=IYD + T(1)=TINF + XMM=PDM(5,3) + Z=ALT +! + DO 10 J = 1,11 + IF(MASS.EQ.MT(J)) GO TO 15 + 10 CONTINUE + write(iulog,100) MASS + GO TO 90 + 15 IF(Z.GT.ALTL(6).AND.MASS.NE.28.AND.MASS.NE.48) GO TO 17 +! +! **** N2 DENSITY **** +! +! Diffusive density at Zlb + DB28 = PDM(1,3)*EXP(G28)*PD(1,3) +! Diffusive density at Alt + D(3)=DENSU(Z,DB28,TINF,TLB, 28._r8,ALPHA(3),T(2),PTM(6),S,MN1,ZN1, & + TN1,TGN1) + DD=D(3) +! Turbopause + ZH28=PDM(3,3)*ZHF + ZHM28=PDM(4,3)*PDL(6,2) + XMD=28._r8-XMM +! Mixed density at Zlb + B28=DENSU(ZH28,DB28,TINF,TLB,XMD,ALPHA(3)-1._r8,TZ,PTM(6),S,MN1, & + ZN1,TN1,TGN1) + IF(Z.GT.ALTL(3).OR.SW(15).EQ.0._r8) GO TO 17 +! Mixed density at Alt + DM28=DENSU(Z,B28,TINF,TLB,XMM,ALPHA(3),TZ,PTM(6),S,MN1, & + ZN1,TN1,TGN1) +! Net density at Alt + D(3)=DNET(D(3),DM28,ZHM28,XMM,28._r8) + 17 CONTINUE + GO TO (20,50,20,25,90,35,40,45,25,48,46), J + 20 CONTINUE +! +! **** HE DENSITY **** +! +! Density variation factor at Zlb + G4 = SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,1)) +! Diffusive density at Zlb + DB04 = PDM(1,1)*EXP(G4)*PD(1,1) +! Diffusive density at Alt + D(1)=DENSU(Z,DB04,TINF,TLB, 4._r8,ALPHA(1),T(2),PTM(6),S,MN1,ZN1, & + TN1,TGN1) + DD=D(1) + IF(Z.GT.ALTL(1).OR.SW(15).EQ.0._r8) GO TO 24 +! Turbopause + ZH04=PDM(3,1) +! Mixed density at Zlb + B04=DENSU(ZH04,DB04,TINF,TLB,4._r8-XMM,ALPHA(1)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM04=DENSU(Z,B04,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM04=ZHM28 +! Net density at Alt + D(1)=DNET(D(1),DM04,ZHM04,XMM,4._r8) +! Correction to specified mixing ratio at ground + RL=LOG(B28*PDM(2,1)/B04) + ZC04=PDM(5,1)*PDL(1,2) + HC04=PDM(6,1)*PDL(2,2) +! Net density corrected at Alt + D(1)=D(1)*CCOR(Z,RL,HC04,ZC04) + 24 CONTINUE + IF(MASS.NE.48) GO TO 90 + 25 CONTINUE +! +! **** O DENSITY **** +! +! Density variation factor at Zlb + G16= SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,2)) +! Diffusive density at Zlb + DB16 = PDM(1,2)*EXP(G16)*PD(1,2) +! Diffusive density at Alt + D(2)=DENSU(Z,DB16,TINF,TLB, 16._r8,ALPHA(2),T(2),PTM(6),S,MN1, & + ZN1,TN1,TGN1) + DD=D(2) + IF(Z.GT.ALTL(2).OR.SW(15).EQ.0._r8) GO TO 34 +! Corrected from PDM(3,1) to PDM(3,2) 12/2/85 +! Turbopause + ZH16=PDM(3,2) +! Mixed density at Zlb + B16=DENSU(ZH16,DB16,TINF,TLB,16-XMM,ALPHA(2)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM16=DENSU(Z,B16,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM16=ZHM28 +! Net density at Alt + D(2)=DNET(D(2),DM16,ZHM16,XMM,16._r8) +! 3/16/99 Change form to match O2 departure from diff equil near 150 +! km and add dependence on F10.7 +! RL=LOG(B28*PDM(2,2)*ABS(PDL(17,2))/B16) + RL=PDM(2,2)*PDL(17,2)*(1._r8+SW(1)*PDL(24,1)*(F107A-150._r8)) + HC16=PDM(6,2)*PDL(4,2) + ZC16=PDM(5,2)*PDL(3,2) + D(2)=D(2)*CCOR(Z,RL,HC16,ZC16) +! Chemistry correction + HCC16=PDM(8,2)*PDL(14,2) + ZCC16=PDM(7,2)*PDL(13,2) + RC16=PDM(4,2)*PDL(15,2) +! Net density corrected at Alt + D(2)=D(2)*CCOR(Z,RC16,HCC16,ZCC16) + 34 CONTINUE + IF(MASS.NE.48.AND.MASS.NE.49) GO TO 90 + 35 CONTINUE +! +! **** O2 DENSITY **** +! +! Density variation factor at Zlb + G32= SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,5)) +! Diffusive density at Zlb + DB32 = PDM(1,4)*EXP(G32)*PD(1,5) +! Diffusive density at Alt + D(4)=DENSU(Z,DB32,TINF,TLB, 32._r8,ALPHA(4),T(2),PTM(6),S,MN1, & + ZN1,TN1,TGN1) + IF(MASS.EQ.49) THEN + DD=DD+2._r8*D(4) + ELSE + DD=D(4) + ENDIF + IF(SW(15).EQ.0._r8) GO TO 39 + IF(Z.GT.ALTL(4)) GO TO 38 +! Turbopause + ZH32=PDM(3,4) +! Mixed density at Zlb + B32=DENSU(ZH32,DB32,TINF,TLB,32._r8-XMM,ALPHA(4)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM32=DENSU(Z,B32,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM32=ZHM28 +! Net density at Alt + D(4)=DNET(D(4),DM32,ZHM32,XMM,32._r8) +! Correction to specified mixing ratio at ground + RL=LOG(B28*PDM(2,4)/B32) + HC32=PDM(6,4)*PDL(8,2) + ZC32=PDM(5,4)*PDL(7,2) + D(4)=D(4)*CCOR(Z,RL,HC32,ZC32) + 38 CONTINUE +! Correction for general departure from diffusive equilibrium above Zlb + HCC32=PDM(8,4)*PDL(23,2) + ZCC32=PDM(7,4)*PDL(22,2) + RC32=PDM(4,4)*PDL(24,2)*(1._r8+SW(1)*PDL(24,1)*(F107A-150._r8)) +! Net density corrected at Alt + D(4)=D(4)*CCOR(Z,RC32,HCC32,ZCC32) + 39 CONTINUE + IF(MASS.NE.48) GO TO 90 + 40 CONTINUE +! +! **** AR DENSITY **** +! +! Density variation factor at Zlb + G40= SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,6)) +! Diffusive density at Zlb + DB40 = PDM(1,5)*EXP(G40)*PD(1,6) +! Diffusive density at Alt + D(5)=DENSU(Z,DB40,TINF,TLB, 40._r8,ALPHA(5),T(2),PTM(6),S,MN1, & + ZN1,TN1,TGN1) + DD=D(5) + IF(Z.GT.ALTL(5).OR.SW(15).EQ.0._r8) GO TO 44 +! Turbopause + ZH40=PDM(3,5) +! Mixed density at Zlb + B40=DENSU(ZH40,DB40,TINF,TLB,40._r8-XMM,ALPHA(5)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM40=DENSU(Z,B40,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM40=ZHM28 +! Net density at Alt + D(5)=DNET(D(5),DM40,ZHM40,XMM,40._r8) +! Correction to specified mixing ratio at ground + RL=LOG(B28*PDM(2,5)/B40) + HC40=PDM(6,5)*PDL(10,2) + ZC40=PDM(5,5)*PDL(9,2) +! Net density corrected at Alt + D(5)=D(5)*CCOR(Z,RL,HC40,ZC40) + 44 CONTINUE + IF(MASS.NE.48) GO TO 90 + 45 CONTINUE +! +! **** HYDROGEN DENSITY **** +! +! Density variation factor at Zlb + G1 = SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,7)) +! Diffusive density at Zlb + DB01 = PDM(1,6)*EXP(G1)*PD(1,7) +! Diffusive density at Alt + D(7)=DENSU(Z,DB01,TINF,TLB,1._r8,ALPHA(7),T(2),PTM(6),S,MN1, & + ZN1,TN1,TGN1) + DD=D(7) + IF(Z.GT.ALTL(7).OR.SW(15).EQ.0._r8) GO TO 47 +! Turbopause + ZH01=PDM(3,6) +! Mixed density at Zlb + B01=DENSU(ZH01,DB01,TINF,TLB,1._r8-XMM,ALPHA(7)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM01=DENSU(Z,B01,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM01=ZHM28 +! Net density at Alt + D(7)=DNET(D(7),DM01,ZHM01,XMM,1._r8) +! Correction to specified mixing ratio at ground + RL=LOG(B28*PDM(2,6)*ABS(PDL(18,2))/B01) + HC01=PDM(6,6)*PDL(12,2) + ZC01=PDM(5,6)*PDL(11,2) + D(7)=D(7)*CCOR(Z,RL,HC01,ZC01) +! Chemistry correction + HCC01=PDM(8,6)*PDL(20,2) + ZCC01=PDM(7,6)*PDL(19,2) + RC01=PDM(4,6)*PDL(21,2) +! Net density corrected at Alt + D(7)=D(7)*CCOR(Z,RC01,HCC01,ZCC01) + 47 CONTINUE + IF(MASS.NE.48) GO TO 90 + 48 CONTINUE +! +! **** ATOMIC NITROGEN DENSITY **** +! +! Density variation factor at Zlb + G14 = SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,8)) +! Diffusive density at Zlb + DB14 = PDM(1,7)*EXP(G14)*PD(1,8) +! Diffusive density at Alt + D(8)=DENSU(Z,DB14,TINF,TLB,14._r8,ALPHA(8),T(2),PTM(6),S,MN1, & + ZN1,TN1,TGN1) + DD=D(8) + IF(Z.GT.ALTL(8).OR.SW(15).EQ.0._r8) GO TO 49 +! Turbopause + ZH14=PDM(3,7) +! Mixed density at Zlb + B14=DENSU(ZH14,DB14,TINF,TLB,14._r8-XMM,ALPHA(8)-1._r8, & + T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) +! Mixed density at Alt + DM14=DENSU(Z,B14,TINF,TLB,XMM,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + ZHM14=ZHM28 +! Net density at Alt + D(8)=DNET(D(8),DM14,ZHM14,XMM,14._r8) +! Correction to specified mixing ratio at ground + RL=LOG(B28*PDM(2,7)*ABS(PDL(3,1))/B14) + HC14=PDM(6,7)*PDL(2,1) + ZC14=PDM(5,7)*PDL(1,1) + D(8)=D(8)*CCOR(Z,RL,HC14,ZC14) +! Chemistry correction + HCC14=PDM(8,7)*PDL(5,1) + ZCC14=PDM(7,7)*PDL(4,1) + RC14=PDM(4,7)*PDL(6,1) +! Net density corrected at Alt + D(8)=D(8)*CCOR(Z,RC14,HCC14,ZCC14) + 49 CONTINUE + IF(MASS.NE.48) GO TO 90 + 46 CONTINUE +! +! **** Anomalous OXYGEN DENSITY **** +! + G16H = SW(21)*GLOBE7(YRD,SEC,GLAT,GLONG,STL,F107A,F107,AP,PD(1,9)) + DB16H = PDM(1,8)*EXP(G16H)*PD(1,9) + THO=PDM(10,8)*PDL(7,1) + DD=DENSU(Z,DB16H,THO,THO,16._r8,ALPHA(9),T2,PTM(6),S,MN1, & + ZN1,TN1,TGN1) + ZSHT=PDM(6,8) + ZMHO=PDM(5,8) + ZSHO=SCALH(ZMHO,16._r8,THO) + D(9)=DD*EXP(-ZSHT/ZSHO*(EXP(-(Z-ZMHO)/ZSHT)-1._r8)) + IF(MASS.NE.48) GO TO 90 +! +! TOTAL MASS DENSITY +! + D(6) = 1.66E-24_r8*(4._r8*D(1)+16._r8*D(2)+28._r8*D(3)+32._r8*D(4)+40._r8*D(5)+ & + D(7)+14._r8*D(8)) + DB48=1.66E-24_r8*(4._r8*DB04+16._r8*DB16+28._r8*DB28+32._r8*DB32+40._r8*DB40+DB01+ & + 14._r8*DB14) + GO TO 90 +! TEMPERATURE AT ALTITUDE + 50 CONTINUE + Z=ABS(ALT) + DDUM = DENSU(Z,1._r8, TINF,TLB,0._r8,0._r8,T(2),PTM(6),S,MN1,ZN1,TN1,TGN1) + 90 CONTINUE +! ADJUST DENSITIES FROM CGS TO KGM + IF(IMR.EQ.1) THEN + DO 95 I=1,9 + D(I)=D(I)*1.E6_r8 + 95 CONTINUE + D(6)=D(6)/1000._r8 + ENDIF + ALAST=ALT + RETURN + 100 FORMAT(1X,'MASS', I5, ' NOT VALID') + END SUBROUTINE GTS7 + +!================================================================================================ + + SUBROUTINE METERS(METER) +! +!----------------------------------------------------------------------- +! Convert outputs to Kg & Meters if METER true +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-------------------------------Commons--------------------------------- +! + integer imr + COMMON/METSEL/IMR +! +!------------------------------Arguments-------------------------------- +! + LOGICAL METER + + SAVE +! +!----------------------------------------------------------------------- +! + IMR=0 + IF(METER) IMR=1 + END SUBROUTINE METERS + +!================================================================================================ + + FUNCTION SCALH(ALT,XM,TEMP) +! +!----------------------------------------------------------------------- +! Calculate scale height (km) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) scalh +! +!-------------------------------Commons--------------------------------- +! + real(r8) gsurf, re + COMMON/PARMB/GSURF,RE +! +!------------------------------Arguments-------------------------------- +! + real(r8) alt, xm, temp +! +!---------------------------Local variables----------------------------- +! + real(r8) g + + real(r8) rgas + DATA RGAS/831.4_r8/ + + SAVE +! +!----------------------------------------------------------------------- +! + G=GSURF/(1._r8+ALT/RE)**2 + SCALH=RGAS*TEMP/(G*XM) + RETURN + END FUNCTION SCALH + +!================================================================================================ + + FUNCTION GLOBE7(YRD,SEC,LAT,LONG,TLOC,F107A,F107,AP,P) +! +!----------------------------------------------------------------------- +! CALCULATE G(L) FUNCTION +! Upper Thermosphere Parameters +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) globe7 +! +!-------------------------------Commons--------------------------------- +! + real(r8) tinf, gb, rout, t + COMMON/TTEST/TINF,GB,ROUT,T(15) + + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW + + integer iyr + real(r8) plg, ctloc, stloc, c2tloc, s2tloc, c3tloc, s3tloc + real(r8) day, df, dfa, apd, apdf, apt, xlong + COMMON/LPOLY/PLG(9,4),CTLOC,STLOC,C2TLOC,S2TLOC,C3TLOC,S3TLOC, & + DAY,DF,DFA,APD,APDF,APT(4),XLONG,IYR +! +!------------------------------Arguments-------------------------------- +! + real(r8) yrd, sec, tloc, f107a, f107 + REAL(r8) LAT, LONG + real(r8) P(*),AP(*) +! +!---------------------------Local variables----------------------------- +! + integer i, j + real(r8) t72, t81, t71, f1, f2, exp1, p45, t82, p44, c2, c4, s, c + real(r8) cd32, cd39, cd18, s2, cd14 + + real(r8) dgtr, dr, xl, tll + DATA DGTR/1.74533E-2_r8/,DR/1.72142E-2_r8/, XL/1000._r8/,TLL/1000._r8/ + + real(r8) sw9, dayl, p14, p18, p32 + DATA SW9/1._r8/,DAYL/-1._r8/,P14/-1000._r8/,P18/-1000._r8/,P32/-1000._r8/ + + integer nsw + real(r8) hr, sr, sv(25), p39 + DATA HR/.2618_r8/,SR/7.2722E-5_r8/,SV/25*1._r8/,NSW/14/,P39/-1000._r8/ + + SAVE +! +!-------------------------Statement Functions---------------------------- +! + real(r8) g0, sumex, sg0, a, ex +! 3hr Magnetic activity functions +! Eq. A24d + G0(A)=(A-4._r8+(P(26)-1._r8)*(A-4._r8+(EXP(-ABS(P(25))*(A-4._r8))-1._r8)/ABS(P(25 & + )))) + +! Eq. A24c + SUMEX(EX)=1._r8+(1._r8-EX**19)/(1._r8-EX)*EX**(.5_r8) +! Eq. A24a + SG0(EX)=(G0(AP(2))+(G0(AP(3))*EX+G0(AP(4))*EX*EX+G0(AP(5))*EX**3 & + +(G0(AP(6))*EX**4+G0(AP(7))*EX**12)*(1._r8-EX**8)/(1._r8-EX)) & + )/SUMEX(EX) +! +!----------------------------------------------------------------------- +! + IF(ISW.NE.64999) CALL TSELEC(SV) + DO 10 J=1,14 + T(J)=0 + 10 CONTINUE + IF(SW(9).GT.0) SW9=1._r8 + IF(SW(9).LT.0) SW9=-1._r8 + IYR = YRD/1000._r8 + DAY = YRD - IYR*1000._r8 + XLONG=LONG +! Eq. A22 (remainder of code) + IF(XL.EQ.LAT) GO TO 15 +! CALCULATE LEGENDRE POLYNOMIALS + C = SIN(LAT*DGTR) + S = COS(LAT*DGTR) + C2 = C*C + C4 = C2*C2 + S2 = S*S + PLG(2,1) = C + PLG(3,1) = 0.5_r8*(3._r8*C2 -1._r8) + PLG(4,1) = 0.5_r8*(5._r8*C*C2-3._r8*C) + PLG(5,1) = (35._r8*C4 - 30._r8*C2 + 3._r8)/8._r8 + PLG(6,1) = (63._r8*C2*C2*C - 70._r8*C2*C + 15._r8*C)/8._r8 + PLG(7,1) = (11._r8*C*PLG(6,1) - 5._r8*PLG(5,1))/6._r8 +! PLG(8,1) = (13.*C*PLG(7,1) - 6.*PLG(6,1))/7. + PLG(2,2) = S + PLG(3,2) = 3._r8*C*S + PLG(4,2) = 1.5_r8*(5._r8*C2-1._r8)*S + PLG(5,2) = 2.5_r8*(7._r8*C2*C-3._r8*C)*S + PLG(6,2) = 1.875_r8*(21._r8*C4 - 14._r8*C2 +1._r8)*S + PLG(7,2) = (11._r8*C*PLG(6,2)-6._r8*PLG(5,2))/5._r8 +! PLG(8,2) = (13.*C*PLG(7,2)-7.*PLG(6,2))/6. +! PLG(9,2) = (15.*C*PLG(8,2)-8.*PLG(7,2))/7. + PLG(3,3) = 3._r8*S2 + PLG(4,3) = 15._r8*S2*C + PLG(5,3) = 7.5_r8*(7._r8*C2 -1._r8)*S2 + PLG(6,3) = 3._r8*C*PLG(5,3)-2._r8*PLG(4,3) + PLG(7,3)=(11._r8*C*PLG(6,3)-7._r8*PLG(5,3))/4._r8 + PLG(8,3)=(13._r8*C*PLG(7,3)-8._r8*PLG(6,3))/5._r8 + PLG(4,4) = 15._r8*S2*S + PLG(5,4) = 105._r8*S2*S*C + PLG(6,4)=(9._r8*C*PLG(5,4)-7._r8*PLG(4,4))/2._r8 + PLG(7,4)=(11._r8*C*PLG(6,4)-8._r8*PLG(5,4))/3._r8 + XL=LAT + 15 CONTINUE + IF(TLL.EQ.TLOC) GO TO 16 + IF(SW(7).EQ.0.AND.SW(8).EQ.0.AND.SW(14).EQ.0) GOTO 16 + STLOC = SIN(HR*TLOC) + CTLOC = COS(HR*TLOC) + S2TLOC = SIN(2._r8*HR*TLOC) + C2TLOC = COS(2._r8*HR*TLOC) + S3TLOC = SIN(3._r8*HR*TLOC) + C3TLOC = COS(3._r8*HR*TLOC) + TLL = TLOC + 16 CONTINUE + IF(DAY.NE.DAYL.OR.P(14).NE.P14) CD14=COS(DR*(DAY-P(14))) + IF(DAY.NE.DAYL.OR.P(18).NE.P18) CD18=COS(2._r8*DR*(DAY-P(18))) + IF(DAY.NE.DAYL.OR.P(32).NE.P32) CD32=COS(DR*(DAY-P(32))) + IF(DAY.NE.DAYL.OR.P(39).NE.P39) CD39=COS(2._r8*DR*(DAY-P(39))) + DAYL = DAY + P14 = P(14) + P18 = P(18) + P32 = P(32) + P39 = P(39) +! F10.7 EFFECT + DF = F107 - F107A + DFA=F107A-150._r8 + T(1) = P(20)*DF*(1._r8+P(60)*DFA) + P(21)*DF*DF + P(22)*DFA & + + P(30)*DFA**2 + F1 = 1._r8 + (P(48)*DFA +P(20)*DF+P(21)*DF*DF)*SWC(1) + F2 = 1._r8 + (P(50)*DFA+P(20)*DF+P(21)*DF*DF)*SWC(1) +! TIME INDEPENDENT + T(2) = & + (P(2)*PLG(3,1) + P(3)*PLG(5,1)+P(23)*PLG(7,1)) & + +(P(15)*PLG(3,1))*DFA*SWC(1) & + +P(27)*PLG(2,1) +! SYMMETRICAL ANNUAL + T(3) = & + (P(19) )*CD32 +! SYMMETRICAL SEMIANNUAL + T(4) = & + (P(16)+P(17)*PLG(3,1))*CD18 +! ASYMMETRICAL ANNUAL + T(5) = F1* & + (P(10)*PLG(2,1)+P(11)*PLG(4,1))*CD14 +! ASYMMETRICAL SEMIANNUAL + T(6) = P(38)*PLG(2,1)*CD39 +! DIURNAL + IF(SW(7).EQ.0) GOTO 200 + T71 = (P(12)*PLG(3,2))*CD14*SWC(5) + T72 = (P(13)*PLG(3,2))*CD14*SWC(5) + T(7) = F2* & + ((P(4)*PLG(2,2) + P(5)*PLG(4,2) + P(28)*PLG(6,2) & + + T71)*CTLOC & + + (P(7)*PLG(2,2) + P(8)*PLG(4,2) +P(29)*PLG(6,2) & + + T72)*STLOC) + 200 CONTINUE +! SEMIDIURNAL + IF(SW(8).EQ.0) GOTO 210 + T81 = (P(24)*PLG(4,3)+P(36)*PLG(6,3))*CD14*SWC(5) + T82 = (P(34)*PLG(4,3)+P(37)*PLG(6,3))*CD14*SWC(5) + T(8) = F2* & + ((P(6)*PLG(3,3) + P(42)*PLG(5,3) + T81)*C2TLOC & + +(P(9)*PLG(3,3) + P(43)*PLG(5,3) + T82)*S2TLOC) + 210 CONTINUE +! TERDIURNAL + IF(SW(14).EQ.0) GOTO 220 + T(14) = F2* & + ((P(40)*PLG(4,4)+(P(94)*PLG(5,4)+P(47)*PLG(7,4))*CD14*SWC(5))* & + S3TLOC & + +(P(41)*PLG(4,4)+(P(95)*PLG(5,4)+P(49)*PLG(7,4))*CD14*SWC(5))* & + C3TLOC) + 220 CONTINUE +! MAGNETIC ACTIVITY BASED ON DAILY AP + + IF(SW9.EQ.-1._r8) GO TO 30 + APD=(AP(1)-4._r8) + P44=P(44) + P45=P(45) + IF(P44.LT.0) P44=1.E-5_r8 + APDF = APD+(P45-1._r8)*(APD+(EXP(-P44 *APD)-1._r8)/P44) + IF(SW(9).EQ.0) GOTO 40 + T(9)=APDF*(P(33)+P(46)*PLG(3,1)+P(35)*PLG(5,1)+ & + (P(101)*PLG(2,1)+P(102)*PLG(4,1)+P(103)*PLG(6,1))*CD14*SWC(5)+ & + (P(122)*PLG(2,2)+P(123)*PLG(4,2)+P(124)*PLG(6,2))*SWC(7)* & + COS(HR*(TLOC-P(125)))) + GO TO 40 + 30 CONTINUE + IF(P(52).EQ.0) GO TO 40 + EXP1 = EXP(-10800._r8*ABS(P(52))/(1._r8+P(139)*(45._r8-ABS(LAT)))) + IF(EXP1.GT..99999_r8) EXP1=.99999_r8 + IF(P(25).LT.1.E-4_r8) P(25)=1.E-4_r8 + APT(1)=SG0(EXP1) +! APT(2)=SG2(EXP1) +! APT(3)=SG0(EXP2) +! APT(4)=SG2(EXP2) + IF(SW(9).EQ.0) GOTO 40 + T(9) = APT(1)*(P(51)+P(97)*PLG(3,1)+P(55)*PLG(5,1)+ & + (P(126)*PLG(2,1)+P(127)*PLG(4,1)+P(128)*PLG(6,1))*CD14*SWC(5)+ & + (P(129)*PLG(2,2)+P(130)*PLG(4,2)+P(131)*PLG(6,2))*SWC(7)* & + COS(HR*(TLOC-P(132)))) + 40 CONTINUE + IF(SW(10).EQ.0.OR.LONG.LE.-1000._r8) GO TO 49 +! LONGITUDINAL + IF(SW(11).EQ.0) GOTO 230 + T(11)= (1._r8+P(81)*DFA*SWC(1))* & + ((P(65)*PLG(3,2)+P(66)*PLG(5,2)+P(67)*PLG(7,2) & + +P(104)*PLG(2,2)+P(105)*PLG(4,2)+P(106)*PLG(6,2) & + +SWC(5)*(P(110)*PLG(2,2)+P(111)*PLG(4,2)+P(112)*PLG(6,2))*CD14)* & + COS(DGTR*LONG) & + +(P(91)*PLG(3,2)+P(92)*PLG(5,2)+P(93)*PLG(7,2) & + +P(107)*PLG(2,2)+P(108)*PLG(4,2)+P(109)*PLG(6,2) & + +SWC(5)*(P(113)*PLG(2,2)+P(114)*PLG(4,2)+P(115)*PLG(6,2))*CD14)* & + SIN(DGTR*LONG)) + 230 CONTINUE +! UT AND MIXED UT,LONGITUDE + IF(SW(12).EQ.0) GOTO 240 + T(12)=(1._r8+P(96)*PLG(2,1))*(1._r8+P(82)*DFA*SWC(1))* & + (1._r8+P(120)*PLG(2,1)*SWC(5)*CD14)* & + ((P(69)*PLG(2,1)+P(70)*PLG(4,1)+P(71)*PLG(6,1))* & + COS(SR*(SEC-P(72)))) + T(12)=T(12)+SWC(11)* & + (P(77)*PLG(4,3)+P(78)*PLG(6,3)+P(79)*PLG(8,3))* & + COS(SR*(SEC-P(80))+2._r8*DGTR*LONG)*(1._r8+P(138)*DFA*SWC(1)) + 240 CONTINUE +! UT,LONGITUDE MAGNETIC ACTIVITY + IF(SW(13).EQ.0) GOTO 48 + IF(SW9.EQ.-1._r8) GO TO 45 + T(13)= APDF*SWC(11)*(1._r8+P(121)*PLG(2,1))* & + ((P( 61)*PLG(3,2)+P( 62)*PLG(5,2)+P( 63)*PLG(7,2))* & + COS(DGTR*(LONG-P( 64)))) & + +APDF*SWC(11)*SWC(5)* & + (P(116)*PLG(2,2)+P(117)*PLG(4,2)+P(118)*PLG(6,2))* & + CD14*COS(DGTR*(LONG-P(119))) & + + APDF*SWC(12)* & + (P( 84)*PLG(2,1)+P( 85)*PLG(4,1)+P( 86)*PLG(6,1))* & + COS(SR*(SEC-P( 76))) + GOTO 48 + 45 CONTINUE + IF(P(52).EQ.0) GOTO 48 + T(13)=APT(1)*SWC(11)*(1._r8+P(133)*PLG(2,1))* & + ((P(53)*PLG(3,2)+P(99)*PLG(5,2)+P(68)*PLG(7,2))* & + COS(DGTR*(LONG-P(98)))) & + +APT(1)*SWC(11)*SWC(5)* & + (P(134)*PLG(2,2)+P(135)*PLG(4,2)+P(136)*PLG(6,2))* & + CD14*COS(DGTR*(LONG-P(137))) & + +APT(1)*SWC(12)* & + (P(56)*PLG(2,1)+P(57)*PLG(4,1)+P(58)*PLG(6,1))* & + COS(SR*(SEC-P(59))) + 48 CONTINUE +! PARMS NOT USED: 83, 90,100,140-150 + 49 CONTINUE + TINF=P(31) + DO 50 I = 1,NSW + 50 TINF = TINF + ABS(SW(I))*T(I) + GLOBE7 = TINF + RETURN + END FUNCTION GLOBE7 + +!================================================================================================ + + SUBROUTINE TSELEC(SV) +! +!----------------------------------------------------------------------- +! SET SWITCHES +! Output in COMMON/CSW/SW(25),SWC(25),ISW +! SW FOR MAIN TERMS, SWC FOR CROSS TERMS +! +! TO TURN ON AND OFF PARTICULAR VARIATIONS CALL TSELEC(SV), +! WHERE SV IS A 25 ELEMENT ARRAY CONTAINING 0. FOR OFF, 1. +! FOR ON, OR 2. FOR MAIN EFFECTS OFF BUT CROSS TERMS ON +! +! To get current values of SW: CALL TRETRV(SW) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-------------------------------Commons--------------------------------- +! + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW +! +!------------------------------Arguments-------------------------------- +! + real(r8) SV(*), SVV(*) +! +!---------------------------Local variables----------------------------- +! + integer i + real(r8) SAV(25) + + SAVE +! +!----------------------------------------------------------------------- +! + DO 100 I = 1,25 + SAV(I)=SV(I) + SW(I)=MOD(SV(I),2._r8) + IF(ABS(SV(I)).EQ.1.OR.ABS(SV(I)).EQ.2._r8) THEN + SWC(I)=1._r8 + ELSE + SWC(I)=0._r8 + ENDIF + 100 CONTINUE + ISW=64999 + RETURN + ENTRY TRETRV(SVV) + DO 200 I=1,25 + SVV(I)=SAV(I) + 200 CONTINUE + END SUBROUTINE TSELEC + +!================================================================================================ + + FUNCTION GLOB7S(P) +! +!----------------------------------------------------------------------- +! VERSION OF GLOBE FOR LOWER ATMOSPHERE 10/26/99 +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) glob7s +! +!-------------------------------Commons--------------------------------- +! + integer iyr + real(r8) plg, ctloc, stloc, c2tloc, s2tloc, c3tloc, s3tloc + real(r8) day, df, dfa, apd, apdf, apt + REAL(r8) LONG + COMMON/LPOLY/PLG(9,4),CTLOC,STLOC,C2TLOC,S2TLOC,C3TLOC,S3TLOC, & + DAY,DF,DFA,APD,APDF,APT(4),LONG,IYR + + integer isw + real(r8) sw, swc + COMMON/CSW/SW(25),SWC(25),ISW +! +!------------------------------Arguments-------------------------------- +! + real(r8) P(*) +! +!---------------------------Local variables----------------------------- +! + integer i, j + real(r8) t81, cd32, cd14, cd18, t72, cd39, t71, tt, t82 + real(r8) T(14) + + real(r8) dr, dgtr, pset + DATA DR/1.72142E-2_r8/,DGTR/1.74533E-2_r8/,PSET/2._r8/ + + real(r8) dayl, p32, p18, p14, p39 + DATA DAYL/-1._r8/,P32,P18,P14,P39/4*-1000._r8/ + + SAVE +! +!----------------------------------------------------------------------- +! +! CONFIRM PARAMETER SET + IF(P(100).EQ.0) P(100)=PSET + IF(P(100).NE.PSET) THEN + write(iulog,900) PSET,P(100) + 900 FORMAT(1X,'WRONG PARAMETER SET FOR GLOB7S',3F10.1) + STOP + ENDIF + DO 10 J=1,14 + T(J)=0._r8 + 10 CONTINUE + IF(DAY.NE.DAYL.OR.P32.NE.P(32)) CD32=COS(DR*(DAY-P(32))) + IF(DAY.NE.DAYL.OR.P18.NE.P(18)) CD18=COS(2._r8*DR*(DAY-P(18))) + IF(DAY.NE.DAYL.OR.P14.NE.P(14)) CD14=COS(DR*(DAY-P(14))) + IF(DAY.NE.DAYL.OR.P39.NE.P(39)) CD39=COS(2._r8*DR*(DAY-P(39))) + DAYL=DAY + P32=P(32) + P18=P(18) + P14=P(14) + P39=P(39) +! +! F10.7 + T(1)=P(22)*DFA +! TIME INDEPENDENT + T(2)=P(2)*PLG(3,1)+P(3)*PLG(5,1)+P(23)*PLG(7,1) & + +P(27)*PLG(2,1)+P(15)*PLG(4,1)+P(60)*PLG(6,1) +! SYMMETRICAL ANNUAL + T(3)=(P(19)+P(48)*PLG(3,1)+P(30)*PLG(5,1))*CD32 +! SYMMETRICAL SEMIANNUAL + T(4)=(P(16)+P(17)*PLG(3,1)+P(31)*PLG(5,1))*CD18 +! ASYMMETRICAL ANNUAL + T(5)=(P(10)*PLG(2,1)+P(11)*PLG(4,1)+P(21)*PLG(6,1))*CD14 +! ASYMMETRICAL SEMIANNUAL + T(6)=(P(38)*PLG(2,1))*CD39 +! DIURNAL + IF(SW(7).EQ.0) GOTO 200 + T71 = P(12)*PLG(3,2)*CD14*SWC(5) + T72 = P(13)*PLG(3,2)*CD14*SWC(5) + T(7) = & + ((P(4)*PLG(2,2) + P(5)*PLG(4,2) & + + T71)*CTLOC & + + (P(7)*PLG(2,2) + P(8)*PLG(4,2) & + + T72)*STLOC) + 200 CONTINUE +! SEMIDIURNAL + IF(SW(8).EQ.0) GOTO 210 + T81 = (P(24)*PLG(4,3)+P(36)*PLG(6,3))*CD14*SWC(5) + T82 = (P(34)*PLG(4,3)+P(37)*PLG(6,3))*CD14*SWC(5) + T(8) = & + ((P(6)*PLG(3,3) + P(42)*PLG(5,3) + T81)*C2TLOC & + +(P(9)*PLG(3,3) + P(43)*PLG(5,3) + T82)*S2TLOC) + 210 CONTINUE +! TERDIURNAL + IF(SW(14).EQ.0) GOTO 220 + T(14) = P(40)*PLG(4,4)*S3TLOC & + +P(41)*PLG(4,4)*C3TLOC + 220 CONTINUE +! MAGNETIC ACTIVITY + IF(SW(9).EQ.0) GOTO 40 + IF(SW(9).EQ.1) & + T(9)=APDF*(P(33)+P(46)*PLG(3,1)*SWC(2)) + IF(SW(9).EQ.-1) & + T(9)=(P(51)*APT(1)+P(97)*PLG(3,1)*APT(1)*SWC(2)) + 40 CONTINUE + IF(SW(10).EQ.0.OR.SW(11).EQ.0.OR.LONG.LE.-1000._r8) GO TO 49 +! LONGITUDINAL + T(11)= (1._r8+PLG(2,1)*(P(81)*SWC(5)*COS(DR*(DAY-P(82))) & + +P(86)*SWC(6)*COS(2._r8*DR*(DAY-P(87)))) & + +P(84)*SWC(3)*COS(DR*(DAY-P(85))) & + +P(88)*SWC(4)*COS(2._r8*DR*(DAY-P(89)))) & + *((P(65)*PLG(3,2)+P(66)*PLG(5,2)+P(67)*PLG(7,2) & + +P(75)*PLG(2,2)+P(76)*PLG(4,2)+P(77)*PLG(6,2) & + )*COS(DGTR*LONG) & + +(P(91)*PLG(3,2)+P(92)*PLG(5,2)+P(93)*PLG(7,2) & + +P(78)*PLG(2,2)+P(79)*PLG(4,2)+P(80)*PLG(6,2) & + )*SIN(DGTR*LONG)) + 49 CONTINUE + TT=0._r8 + DO 50 I=1,14 + 50 TT=TT+ABS(SW(I))*T(I) + GLOB7S=TT + RETURN + END FUNCTION GLOB7S + +!================================================================================================ + + FUNCTION DENSU(ALT,DLB,TINF,TLB,XM,ALPHA,TZ,ZLB,S2, & + MN1,ZN1,TN1,TGN1) +! +!----------------------------------------------------------------------- +! Calculate Temperature and Density Profiles for MSIS models +! New lower thermo polynomial 10/30/89 +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) densu +! +!-------------------------------Commons--------------------------------- +! + real(r8) gsurf, re + COMMON/PARMB/GSURF,RE + + integer mp, ii, jg, lt, ierr, ifun, n, j + real(r8) qpb, dv + COMMON/LSQV/MP,II,JG,LT,QPB(50),IERR,IFUN,N,J,DV(60) +! +!------------------------------Arguments-------------------------------- +! + integer mn1 + real(r8) alt, dlb, tinf, tlb, xm, alpha, tz, zlb, s2 + real(r8) ZN1(MN1),TN1(MN1),TGN1(2) +! +!---------------------------Local variables----------------------------- +! + integer k, mn + real(r8) densa, dta, expl, gamm, gamma, glb, ta, tt, t1, t2 + real(r8) x, y, yd1, yd2, yi, z, za, zg, zg2, zgdif, z1, z2 + real(r8) XS(5),YS(5),Y2OUT(5) + + real(r8) rgas + DATA RGAS/831.4_r8/ + + SAVE +! +!-------------------------Statement Functions---------------------------- +! + real(r8) zeta, zz, zl + ZETA(ZZ,ZL)=(ZZ-ZL)*(RE+ZL)/(RE+ZZ) +! +!----------------------------------------------------------------------- +! +!CCCCCwrite(iulog,*) 'DB',ALT,DLB,TINF,TLB,XM,ALPHA,ZLB,S2,MN1,ZN1,TN1 + DENSU=1._r8 +! Joining altitude of Bates and spline + ZA=ZN1(1) + Z=MAX(ALT,ZA) +! Geopotential altitude difference from ZLB + ZG2=ZETA(Z,ZLB) +! Bates temperature + TT=TINF-(TINF-TLB)*EXP(-S2*ZG2) + TA=TT + TZ=TT + DENSU=TZ + IF(ALT.GE.ZA) GO TO 10 +! +! CALCULATE TEMPERATURE BELOW ZA +! Temperature gradient at ZA from Bates profile + DTA=(TINF-TA)*S2*((RE+ZLB)/(RE+ZA))**2 + TGN1(1)=DTA + TN1(1)=TA + Z=MAX(ALT,ZN1(MN1)) + MN=MN1 + Z1=ZN1(1) + Z2=ZN1(MN) + T1=TN1(1) + T2=TN1(MN) +! Geopotental difference from Z1 + ZG=ZETA(Z,Z1) + ZGDIF=ZETA(Z2,Z1) +! Set up spline nodes + DO 20 K=1,MN + XS(K)=ZETA(ZN1(K),Z1)/ZGDIF + YS(K)=1._r8/TN1(K) + 20 CONTINUE +! End node derivatives + YD1=-TGN1(1)/(T1*T1)*ZGDIF + YD2=-TGN1(2)/(T2*T2)*ZGDIF*((RE+Z2)/(RE+Z1))**2 +! Calculate spline coefficients + CALL SPLINE(XS,YS,MN,YD1,YD2,Y2OUT) + X=ZG/ZGDIF + CALL SPLINT(XS,YS,Y2OUT,MN,X,Y) +! temperature at altitude + TZ=1._r8/Y + DENSU=TZ + 10 IF(XM.EQ.0._r8) GO TO 50 +! +! CALCULATE DENSITY ABOVE ZA + GLB=GSURF/(1._r8+ZLB/RE)**2 + GAMMA=XM*GLB/(S2*RGAS*TINF) + EXPL=EXP(-S2*GAMMA*ZG2) + IF(EXPL.GT.50.OR.TT.LE.0._r8) THEN + EXPL=50._r8 + ENDIF +! Density at altitude + DENSA=DLB*(TLB/TT)**(1._r8+ALPHA+GAMMA)*EXPL + DENSU=DENSA + IF(ALT.GE.ZA) GO TO 50 +! +! CALCULATE DENSITY BELOW ZA + GLB=GSURF/(1._r8+Z1/RE)**2 + GAMM=XM*GLB*ZGDIF/RGAS +! integrate spline temperatures + CALL SPLINI(XS,YS,Y2OUT,MN,X,YI) + EXPL=GAMM*YI + IF(EXPL.GT.50._r8.OR.TZ.LE.0._r8) THEN + EXPL=50._r8 + ENDIF +! Density at altitude + DENSU=DENSU*(T1/TZ)**(1._r8+ALPHA)*EXP(-EXPL) + 50 CONTINUE + RETURN + END FUNCTION DENSU + +!================================================================================================ + + FUNCTION DENSM(ALT,D0,XM,TZ,MN3,ZN3,TN3,TGN3,MN2,ZN2,TN2,TGN2) +! +!----------------------------------------------------------------------- +! Calculate Temperature and Density Profiles for lower atmos. +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) densm +! +!-------------------------------Commons--------------------------------- +! + real(r8) gsurf, pe + COMMON/PARMB/GSURF,RE + + real(r8) taf + COMMON/FIT/TAF + + integer mp, ii, jg, ierr, ifun, n, j + real(r8) qpb, dv + COMMON/LSQV/MP,II,JG,LT,QPB(50),IERR,IFUN,N,J,DV(60) +! +!------------------------------Arguments-------------------------------- +! + integer mn3, mn2 + real(r8) alt, d0, xm, tz + real(r8) ZN3(MN3),TN3(MN3),TGN3(2) + real(r8) ZN2(MN2),TN2(MN2),TGN2(2) +! +!---------------------------Local variables----------------------------- +! + integer k, lt, mn + real(r8) x, yd1, yd2, y, yi, expl, glb, gamm, zgdif, z + real(r8) re, z1, z2, zg, t1, t2 + real(r8) XS(10),YS(10),Y2OUT(10) + + real(r8) rgas + DATA RGAS/831.4_r8/ + + SAVE +! +!-------------------------Statement Functions---------------------------- +! + real(r8) zeta, zz, zl + ZETA(ZZ,ZL)=(ZZ-ZL)*(RE+ZL)/(RE+ZZ) +! +!----------------------------------------------------------------------- +! + DENSM=D0 + IF(ALT.GT.ZN2(1)) GOTO 50 +! STRATOSPHERE/MESOSPHERE TEMPERATURE + Z=MAX(ALT,ZN2(MN2)) + MN=MN2 + Z1=ZN2(1) + Z2=ZN2(MN) + T1=TN2(1) + T2=TN2(MN) + ZG=ZETA(Z,Z1) + ZGDIF=ZETA(Z2,Z1) +! Set up spline nodes + DO 210 K=1,MN + XS(K)=ZETA(ZN2(K),Z1)/ZGDIF + YS(K)=1._r8/TN2(K) + 210 CONTINUE + YD1=-TGN2(1)/(T1*T1)*ZGDIF + YD2=-TGN2(2)/(T2*T2)*ZGDIF*((RE+Z2)/(RE+Z1))**2 +! Calculate spline coefficients + CALL SPLINE(XS,YS,MN,YD1,YD2,Y2OUT) + X=ZG/ZGDIF + CALL SPLINT(XS,YS,Y2OUT,MN,X,Y) +! Temperature at altitude + TZ=1._r8/Y + IF(XM.EQ.0._r8) GO TO 20 +! +! CALCULATE STRATOSPHERE/MESOSPHERE DENSITY + GLB=GSURF/(1._r8+Z1/RE)**2 + GAMM=XM*GLB*ZGDIF/RGAS +! Integrate temperature profile + CALL SPLINI(XS,YS,Y2OUT,MN,X,YI) + EXPL=GAMM*YI + IF(EXPL.GT.50._r8) EXPL=50._r8 +! Density at altitude + DENSM=DENSM*(T1/TZ)*EXP(-EXPL) + 20 CONTINUE + IF(ALT.GT.ZN3(1)) GOTO 50 +! +! TROPOSPHERE/STRATOSPHERE TEMPERATURE + Z=ALT + MN=MN3 + Z1=ZN3(1) + Z2=ZN3(MN) + T1=TN3(1) + T2=TN3(MN) + ZG=ZETA(Z,Z1) + ZGDIF=ZETA(Z2,Z1) +! Set up spline nodes + DO 220 K=1,MN + XS(K)=ZETA(ZN3(K),Z1)/ZGDIF + YS(K)=1._r8/TN3(K) + 220 CONTINUE + YD1=-TGN3(1)/(T1*T1)*ZGDIF + YD2=-TGN3(2)/(T2*T2)*ZGDIF*((RE+Z2)/(RE+Z1))**2 +! Calculate spline coefficients + CALL SPLINE(XS,YS,MN,YD1,YD2,Y2OUT) + X=ZG/ZGDIF + CALL SPLINT(XS,YS,Y2OUT,MN,X,Y) +! temperature at altitude + TZ=1._r8/Y + IF(XM.EQ.0._r8) GO TO 30 +! +! CALCULATE TROPOSPHERIC/STRATOSPHERE DENSITY +! + GLB=GSURF/(1._r8+Z1/RE)**2 + GAMM=XM*GLB*ZGDIF/RGAS +! Integrate temperature profile + CALL SPLINI(XS,YS,Y2OUT,MN,X,YI) + EXPL=GAMM*YI + IF(EXPL.GT.50._r8) EXPL=50._r8 +! Density at altitude + DENSM=DENSM*(T1/TZ)*EXP(-EXPL) + 30 CONTINUE + 50 CONTINUE + IF(XM.EQ.0) DENSM=TZ + RETURN + END FUNCTION DENSM + +!================================================================================================ + + SUBROUTINE SPLINE(X,Y,N,YP1,YPN,Y2) +! +!----------------------------------------------------------------------- +! CALCULATE 2ND DERIVATIVES OF CUBIC SPLINE INTERP FUNCTION +! ADAPTED FROM NUMERICAL RECIPES BY PRESS ET AL +! X,Y: ARRAYS OF TABULATED FUNCTION IN ASCENDING ORDER BY X +! N: SIZE OF ARRAYS X,Y +! YP1,YPN: SPECIFIED DERIVATIVES AT X(1) AND X(N); VALUES +! >= 1E30 SIGNAL SIGNAL SECOND DERIVATIVE ZERO +! Y2: OUTPUT ARRAY OF SECOND DERIVATIVES +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer n + real(r8) X(N),Y(N),Y2(N) + real(r8) yp1, ypn +! +!-----------------------------Parameters------------------------------ +! + integer nmax + PARAMETER (NMAX=100) +! +!---------------------------Local variables----------------------------- +! + integer i, k + real(r8) qn, un, sig, p, U(NMAX) + + SAVE +! +!----------------------------------------------------------------------- +! + IF(YP1.GT..99E30_r8) THEN + Y2(1)=0 + U(1)=0 + ELSE + Y2(1)=-.5_r8 + U(1)=(3._r8/(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1) + ENDIF + DO 11 I=2,N-1 + SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1)) + P=SIG*Y2(I-1)+2._r8 + Y2(I)=(SIG-1._r8)/P + U(I)=(6._r8*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1)) & + /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*U(I-1))/P + 11 CONTINUE + IF(YPN.GT..99E30_r8) THEN + QN=0 + UN=0 + ELSE + QN=.5_r8 + UN=(3._r8/(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1))) + ENDIF + Y2(N)=(UN-QN*U(N-1))/(QN*Y2(N-1)+1._r8) + DO 12 K=N-1,1,-1 + Y2(K)=Y2(K)*Y2(K+1)+U(K) + 12 CONTINUE + RETURN + END SUBROUTINE SPLINE + +!================================================================================================ + + SUBROUTINE SPLINT(XA,YA,Y2A,N,X,Y) +! +!----------------------------------------------------------------------- +! CALCULATE CUBIC SPLINE INTERP VALUE +! ADAPTED FROM NUMERICAL RECIPES BY PRESS ET AL. +! XA,YA: ARRAYS OF TABULATED FUNCTION IN ASCENDING ORDER BY X +! Y2A: ARRAY OF SECOND DERIVATIVES +! N: SIZE OF ARRAYS XA,YA,Y2A +! X: ABSCISSA FOR INTERPOLATION +! Y: OUTPUT VALUE +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer n + real(r8) XA(N),YA(N),Y2A(N) + real(r8) x, y +! +!---------------------------Local variables----------------------------- +! + integer k, klo, khi + real(r8) a, b, h + + SAVE +! +!----------------------------------------------------------------------- +! + KLO=1 + KHI=N + 1 CONTINUE + IF(KHI-KLO.GT.1) THEN + K=(KHI+KLO)/2 + IF(XA(K).GT.X) THEN + KHI=K + ELSE + KLO=K + ENDIF + GOTO 1 + ENDIF + H=XA(KHI)-XA(KLO) + IF(H.EQ.0) write(iulog,*) 'BAD XA INPUT TO SPLINT' + A=(XA(KHI)-X)/H + B=(X-XA(KLO))/H + Y=A*YA(KLO)+B*YA(KHI)+ & + ((A*A*A-A)*Y2A(KLO)+(B*B*B-B)*Y2A(KHI))*H*H/6._r8 + RETURN + END SUBROUTINE SPLINT + +!================================================================================================ + + SUBROUTINE SPLINI(XA,YA,Y2A,N,X,YI) +! +!----------------------------------------------------------------------- +! INTEGRATE CUBIC SPLINE FUNCTION FROM XA(1) TO X +! XA,YA: ARRAYS OF TABULATED FUNCTION IN ASCENDING ORDER BY X +! Y2A: ARRAY OF SECOND DERIVATIVES +! N: SIZE OF ARRAYS XA,YA,Y2A +! X: ABSCISSA ENDPOINT FOR INTEGRATION +! Y: OUTPUT VALUE +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer n + real(r8) XA(N),YA(N),Y2A(N) + real(r8) x, yi +! +!---------------------------Local variables----------------------------- +! + integer khi, klo + real(r8) a, b, a2, b2, h, xx + + SAVE +! +!----------------------------------------------------------------------- +! + YI=0 + KLO=1 + KHI=2 + 1 CONTINUE + IF(X.GT.XA(KLO).AND.KHI.LE.N) THEN + XX=X + IF(KHI.LT.N) XX=MIN(X,XA(KHI)) + H=XA(KHI)-XA(KLO) + A=(XA(KHI)-XX)/H + B=(XX-XA(KLO))/H + A2=A*A + B2=B*B + YI=YI+((1._r8-A2)*YA(KLO)/2._r8+B2*YA(KHI)/2._r8+ & + ((-(1._r8+A2*A2)/4._r8+A2/2._r8)*Y2A(KLO)+ & + (B2*B2/4._r8-B2/2._r8)*Y2A(KHI))*H*H/6._r8)*H + KLO=KLO+1 + KHI=KHI+1 + GOTO 1 + ENDIF + RETURN + END SUBROUTINE SPLINI + +!================================================================================================ + + FUNCTION DNET(DD,DM,ZHM,XMM,XM) +! +!----------------------------------------------------------------------- +! TURBOPAUSE CORRECTION FOR MSIS MODELS +! Root mean density +! 8/20/80 +! DD - diffusive density +! DM - full mixed density +! ZHM - transition scale length +! XMM - full mixed molecular weight +! XM - species molecular weight +! DNET - combined density +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) dnet +! +!------------------------------Arguments-------------------------------- +! + real(r8) dd, dm, zhm, xmm, xm +! +!---------------------------Local variables----------------------------- +! + real(r8) a, ylog + + SAVE +! +!----------------------------------------------------------------------- +! + A=ZHM/(XMM-XM) + IF(DM.GT.0.AND.DD.GT.0) GOTO 5 + write(iulog,*) 'DNET LOG ERROR',DM,DD,XM + IF(DD.EQ.0.AND.DM.EQ.0) DD=1._r8 + IF(DM.EQ.0) GOTO 10 + IF(DD.EQ.0) GOTO 20 + 5 CONTINUE + YLOG=A*LOG(DM/DD) + IF(YLOG.LT.-10._r8) GO TO 10 + IF(YLOG.GT.10._r8) GO TO 20 + DNET=DD*(1._r8+EXP(YLOG))**(1/A) + GO TO 50 + 10 CONTINUE + DNET=DD + GO TO 50 + 20 CONTINUE + DNET=DM + GO TO 50 + 50 CONTINUE + RETURN + END FUNCTION DNET + +!================================================================================================ + + FUNCTION CCOR(ALT, R,H1,ZH) +! +!----------------------------------------------------------------------- +! CHEMISTRY/DISSOCIATION CORRECTION FOR MSIS MODELS +! ALT - altitude +! R - target ratio +! H1 - transition scale length +! ZH - altitude of 1/2 R +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-----------------------------Return Value------------------------------ +! + real(r8) ccor +! +!------------------------------Arguments-------------------------------- +! + real(r8) alt, r, h1, zh +! +!---------------------------Local variables----------------------------- +! + real(r8) e, ex + + SAVE +! +!----------------------------------------------------------------------- +! + E=(ALT-ZH)/H1 + IF(E.GT.70._r8) GO TO 20 + IF(E.LT.-70._r8) GO TO 10 + EX=EXP(E) + CCOR=R/(1._r8+EX) + GO TO 50 + 10 CCOR=R + GO TO 50 + 20 CCOR=0._r8 + GO TO 50 + 50 CONTINUE + CCOR=EXP(CCOR) + RETURN + END FUNCTION CCOR + +!================================================================================================ + + BLOCK DATA GTD7BK +! +!----------------------------------------------------------------------- +! NRLMSISE-00 13-APR-00 +!----------------------------------------------------------------------- +! + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +! +!-------------------------------Commons--------------------------------- +! + real(r8) ptm, pdm + COMMON/LOWER7/PTM(10),PDM(10,8) + + real(r8) pavgm + COMMON/MAVG7/PAVGM(10) + + CHARACTER*4 ISDATE, ISTIME, NAME + COMMON/DATIM7/ISDATE(3),ISTIME(2),NAME(2) + DATA ISDATE/'13-A','PR-0','0 '/,ISTIME/'17:4','6:08'/ + DATA NAME/'MSIS','E-00'/ + + integer imr + COMMON/METSEL/IMR + DATA IMR/0/ + + real(r8) pt1, pt2, pt3, pa1, pa2, pa3, & + pb1, pb2, pb3, pc1, pc2, pc3, & + pd1, pd2, pd3, pe1, pe2, pe3, & + pf1, pf2, pf3, pg1, pg2, pg3, & + ph1, ph2, ph3, pi1, pi2, pi3, & + pj1, pj2, pj3, pk1, pl1, pl2, & + pm1, pm2, pn1, pn2, po1, po2, & + pp1, pp2, pq1, pq2, pr1, pr2, & + ps1, ps2, pu1, pu2, pv1, pv2, & + pw1, pw2, px1, px2, py1, py2, & + pz1, pz2, paa1, paa2 + COMMON/PARM7/PT1(50),PT2(50),PT3(50),PA1(50),PA2(50),PA3(50), & + PB1(50),PB2(50),PB3(50),PC1(50),PC2(50),PC3(50), & + PD1(50),PD2(50),PD3(50),PE1(50),PE2(50),PE3(50), & + PF1(50),PF2(50),PF3(50),PG1(50),PG2(50),PG3(50), & + PH1(50),PH2(50),PH3(50),PI1(50),PI2(50),PI3(50), & + PJ1(50),PJ2(50),PJ3(50),PK1(50),PL1(50),PL2(50), & + PM1(50),PM2(50),PN1(50),PN2(50),PO1(50),PO2(50), & + PP1(50),PP2(50),PQ1(50),PQ2(50),PR1(50),PR2(50), & + PS1(50),PS2(50),PU1(50),PU2(50),PV1(50),PV2(50), & + PW1(50),PW2(50),PX1(50),PX2(50),PY1(50),PY2(50), & + PZ1(50),PZ2(50),PAA1(50),PAA2(50) +! TEMPERATURE + DATA PT1/ & + 9.86573E-01_r8, 1.62228E-02_r8, 1.55270E-02_r8,-1.04323E-01_r8,-3.75801E-03_r8, & + -1.18538E-03_r8,-1.24043E-01_r8, 4.56820E-03_r8, 8.76018E-03_r8,-1.36235E-01_r8, & + -3.52427E-02_r8, 8.84181E-03_r8,-5.92127E-03_r8,-8.61650E+00_r8, 0.00000E+00_r8, & + 1.28492E-02_r8, 0.00000E+00_r8, 1.30096E+02_r8, 1.04567E-02_r8, 1.65686E-03_r8, & + -5.53887E-06_r8, 2.97810E-03_r8, 0.00000E+00_r8, 5.13122E-03_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-7.27026E-06_r8, & + 0.00000E+00_r8, 6.74494E+00_r8, 4.93933E-03_r8, 2.21656E-03_r8, 2.50802E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-2.08841E-02_r8,-1.79873E+00_r8, 1.45103E-03_r8, & + 2.81769E-04_r8,-1.44703E-03_r8,-5.16394E-05_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 5.72562E-03_r8, 5.07493E-05_r8, 4.36148E-03_r8, 1.17863E-04_r8, 4.74364E-03_r8/ + DATA PT2/ & + 6.61278E-03_r8, 4.34292E-05_r8, 1.44373E-03_r8, 2.41470E-05_r8, 2.84426E-03_r8, & + 8.56560E-04_r8, 2.04028E-03_r8, 0.00000E+00_r8,-3.15994E+03_r8,-2.46423E-03_r8, & + 1.13843E-03_r8, 4.20512E-04_r8, 0.00000E+00_r8,-9.77214E+01_r8, 6.77794E-03_r8, & + 5.27499E-03_r8, 1.14936E-03_r8, 0.00000E+00_r8,-6.61311E-03_r8,-1.84255E-02_r8, & + -1.96259E-02_r8, 2.98618E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 6.44574E+02_r8, 8.84668E-04_r8, 5.05066E-04_r8, 0.00000E+00_r8, 4.02881E+03_r8, & + -1.89503E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.21407E-04_r8, 2.06780E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -1.20410E-02_r8,-3.63963E-03_r8, 9.92070E-05_r8,-1.15284E-04_r8,-6.33059E-05_r8, & + -6.05545E-01_r8, 8.34218E-03_r8,-9.13036E+01_r8, 3.71042E-04_r8, 0.00000E+00_r8/ + DATA PT3/ & + 4.19000E-04_r8, 2.70928E-03_r8, 3.31507E-03_r8,-4.44508E-03_r8,-4.96334E-03_r8, & + -1.60449E-03_r8, 3.95119E-03_r8, 2.48924E-03_r8, 5.09815E-04_r8, 4.05302E-03_r8, & + 2.24076E-03_r8, 0.00000E+00_r8, 6.84256E-03_r8, 4.66354E-04_r8, 0.00000E+00_r8, & + -3.68328E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.46870E+02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.09501E-03_r8, 4.65156E-04_r8, 5.62583E-04_r8, 3.21596E+00_r8, & + 6.43168E-04_r8, 3.14860E-03_r8, 3.40738E-03_r8, 1.78481E-03_r8, 9.62532E-04_r8, & + 5.58171E-04_r8, 3.43731E+00_r8,-2.33195E-01_r8, 5.10289E-04_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-9.25347E+04_r8, 0.00000E+00_r8,-1.99639E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! HE DENSITY + DATA PA1/ & + 1.09979E+00_r8,-4.88060E-02_r8,-1.97501E-01_r8,-9.10280E-02_r8,-6.96558E-03_r8, & + 2.42136E-02_r8, 3.91333E-01_r8,-7.20068E-03_r8,-3.22718E-02_r8, 1.41508E+00_r8, & + 1.68194E-01_r8, 1.85282E-02_r8, 1.09384E-01_r8,-7.24282E+00_r8, 0.00000E+00_r8, & + 2.96377E-01_r8,-4.97210E-02_r8, 1.04114E+02_r8,-8.61108E-02_r8,-7.29177E-04_r8, & + 1.48998E-06_r8, 1.08629E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.31090E-02_r8, & + 1.12818E-01_r8,-5.75005E-02_r8,-1.29919E-02_r8,-1.78849E-02_r8,-2.86343E-06_r8, & + 0.00000E+00_r8,-1.51187E+02_r8,-6.65902E-03_r8, 0.00000E+00_r8,-2.02069E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 4.32264E-02_r8,-2.80444E+01_r8,-3.26789E-03_r8, & + 2.47461E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 9.82100E-02_r8, 1.22714E-01_r8, & + -3.96450E-02_r8, 0.00000E+00_r8,-2.76489E-03_r8, 0.00000E+00_r8, 1.87723E-03_r8/ + DATA PA2/ & + -8.09813E-03_r8, 4.34428E-05_r8,-7.70932E-03_r8, 0.00000E+00_r8,-2.28894E-03_r8, & + -5.69070E-03_r8,-5.22193E-03_r8, 6.00692E-03_r8,-7.80434E+03_r8,-3.48336E-03_r8, & + -6.38362E-03_r8,-1.82190E-03_r8, 0.00000E+00_r8,-7.58976E+01_r8,-2.17875E-02_r8, & + -1.72524E-02_r8,-9.06287E-03_r8, 0.00000E+00_r8, 2.44725E-02_r8, 8.66040E-02_r8, & + 1.05712E-01_r8, 3.02543E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -6.01364E+03_r8,-5.64668E-03_r8,-2.54157E-03_r8, 0.00000E+00_r8, 3.15611E+02_r8, & + -5.69158E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-4.47216E-03_r8,-4.49523E-03_r8, & + 4.64428E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 4.51236E-02_r8, 2.46520E-02_r8, 6.17794E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -3.62944E-01_r8,-4.80022E-02_r8,-7.57230E+01_r8,-1.99656E-03_r8, 0.00000E+00_r8/ + DATA PA3/ & + -5.18780E-03_r8,-1.73990E-02_r8,-9.03485E-03_r8, 7.48465E-03_r8, 1.53267E-02_r8, & + 1.06296E-02_r8, 1.18655E-02_r8, 2.55569E-03_r8, 1.69020E-03_r8, 3.51936E-02_r8, & + -1.81242E-02_r8, 0.00000E+00_r8,-1.00529E-01_r8,-5.10574E-03_r8, 0.00000E+00_r8, & + 2.10228E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.73255E+02_r8, 5.07833E-01_r8, & + -2.41408E-01_r8, 8.75414E-03_r8, 2.77527E-03_r8,-8.90353E-05_r8,-5.25148E+00_r8, & + -5.83899E-03_r8,-2.09122E-02_r8,-9.63530E-03_r8, 9.77164E-03_r8, 4.07051E-03_r8, & + 2.53555E-04_r8,-5.52875E+00_r8,-3.55993E-01_r8,-2.49231E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.86026E+01_r8, 0.00000E+00_r8, 3.42722E-04_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! O DENSITY + DATA PB1/ & + 1.02315E+00_r8,-1.59710E-01_r8,-1.06630E-01_r8,-1.77074E-02_r8,-4.42726E-03_r8, & + 3.44803E-02_r8, 4.45613E-02_r8,-3.33751E-02_r8,-5.73598E-02_r8, 3.50360E-01_r8, & + 6.33053E-02_r8, 2.16221E-02_r8, 5.42577E-02_r8,-5.74193E+00_r8, 0.00000E+00_r8, & + 1.90891E-01_r8,-1.39194E-02_r8, 1.01102E+02_r8, 8.16363E-02_r8, 1.33717E-04_r8, & + 6.54403E-06_r8, 3.10295E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.38205E-02_r8, & + 1.23910E-01_r8,-1.39831E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.95915E-06_r8, & + 0.00000E+00_r8,-7.14651E-01_r8,-5.01027E-03_r8, 0.00000E+00_r8,-3.24756E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 4.42173E-02_r8,-1.31598E+01_r8,-3.15626E-03_r8, & + 1.24574E-03_r8,-1.47626E-03_r8,-1.55461E-03_r8, 6.40682E-02_r8, 1.34898E-01_r8, & + -2.42415E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 6.13666E-04_r8/ + DATA PB2/ & + -5.40373E-03_r8, 2.61635E-05_r8,-3.33012E-03_r8, 0.00000E+00_r8,-3.08101E-03_r8, & + -2.42679E-03_r8,-3.36086E-03_r8, 0.00000E+00_r8,-1.18979E+03_r8,-5.04738E-02_r8, & + -2.61547E-03_r8,-1.03132E-03_r8, 1.91583E-04_r8,-8.38132E+01_r8,-1.40517E-02_r8, & + -1.14167E-02_r8,-4.08012E-03_r8, 1.73522E-04_r8,-1.39644E-02_r8,-6.64128E-02_r8, & + -6.85152E-02_r8,-1.34414E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 6.07916E+02_r8,-4.12220E-03_r8,-2.20996E-03_r8, 0.00000E+00_r8, 1.70277E+03_r8, & + -4.63015E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.25360E-03_r8,-2.96204E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 3.92786E-02_r8, 1.31186E-02_r8,-1.78086E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -3.90083E-01_r8,-2.84741E-02_r8,-7.78400E+01_r8,-1.02601E-03_r8, 0.00000E+00_r8/ + DATA PB3/ & + -7.26485E-04_r8,-5.42181E-03_r8,-5.59305E-03_r8, 1.22825E-02_r8, 1.23868E-02_r8, & + 6.68835E-03_r8,-1.03303E-02_r8,-9.51903E-03_r8, 2.70021E-04_r8,-2.57084E-02_r8, & + -1.32430E-02_r8, 0.00000E+00_r8,-3.81000E-02_r8,-3.16810E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-9.05762E-04_r8,-2.14590E-03_r8,-1.17824E-03_r8, 3.66732E+00_r8, & + -3.79729E-04_r8,-6.13966E-03_r8,-5.09082E-03_r8,-1.96332E-03_r8,-3.08280E-03_r8, & + -9.75222E-04_r8, 4.03315E+00_r8,-2.52710E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! N2 DENSITY + DATA PC1/ & + 1.16112E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.33725E-02_r8, 0.00000E+00_r8, & + 3.48637E-02_r8,-5.44368E-03_r8, 0.00000E+00_r8,-6.73940E-02_r8, 1.74754E-01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.74712E+02_r8, 0.00000E+00_r8, & + 1.26733E-01_r8, 0.00000E+00_r8, 1.03154E+02_r8, 5.52075E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 8.13525E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-2.50482E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.48894E-03_r8, & + 6.16053E-04_r8,-5.79716E-04_r8, 2.95482E-03_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PC2/ & + 0.00000E+00_r8, 2.47425E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PC3/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! TLB + DATA PD1/ & + 9.44846E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.08617E-02_r8, 0.00000E+00_r8, & + -2.44019E-02_r8, 6.48607E-03_r8, 0.00000E+00_r8, 3.08181E-02_r8, 4.59392E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.74712E+02_r8, 0.00000E+00_r8, & + 2.13260E-02_r8, 0.00000E+00_r8,-3.56958E+02_r8, 0.00000E+00_r8, 1.82278E-04_r8, & + 0.00000E+00_r8, 3.07472E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 3.83054E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -1.93065E-03_r8,-1.45090E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.23493E-03_r8, 1.36736E-03_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 3.71469E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PD2/ & + 5.10250E-03_r8, 2.47425E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 3.68756E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PD3/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! O2 DENSITY + DATA PE1/ & + 1.38720E+00_r8, 1.44816E-01_r8, 0.00000E+00_r8, 6.07767E-02_r8, 0.00000E+00_r8, & + 2.94777E-02_r8, 7.46900E-02_r8, 0.00000E+00_r8,-9.23822E-02_r8, 8.57342E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.38636E+01_r8, 0.00000E+00_r8, & + 7.71653E-02_r8, 0.00000E+00_r8, 8.18751E+01_r8, 1.87736E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.49667E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-3.67874E+02_r8, 5.48158E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 1.22631E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PE2/ & + 8.17187E-03_r8, 3.71617E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.10826E-03_r8, & + -3.13640E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -7.35742E-02_r8,-5.00266E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.94965E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PE3/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! AR DENSITY + DATA PF1/ & + 1.04761E+00_r8, 2.00165E-01_r8, 2.37697E-01_r8, 3.68552E-02_r8, 0.00000E+00_r8, & + 3.57202E-02_r8,-2.14075E-01_r8, 0.00000E+00_r8,-1.08018E-01_r8,-3.73981E-01_r8, & + 0.00000E+00_r8, 3.10022E-02_r8,-1.16305E-03_r8,-2.07596E+01_r8, 0.00000E+00_r8, & + 8.64502E-02_r8, 0.00000E+00_r8, 9.74908E+01_r8, 5.16707E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 3.46193E+02_r8, 1.34297E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.48509E-03_r8, & + -1.54689E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 1.47753E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PF2/ & + 1.89320E-02_r8, 3.68181E-05_r8, 1.32570E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 3.59719E-03_r8, 7.44328E-03_r8,-1.00023E-03_r8,-6.50528E+03_r8, 0.00000E+00_r8, & + 1.03485E-02_r8,-1.00983E-03_r8,-4.06916E-03_r8,-6.60864E+01_r8,-1.71533E-02_r8, & + 1.10605E-02_r8, 1.20300E-02_r8,-5.20034E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -2.62769E+03_r8, 7.13755E-03_r8, 4.17999E-03_r8, 0.00000E+00_r8, 1.25910E+04_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.23595E-03_r8, 4.60217E-03_r8, & + 5.71794E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -3.18353E-02_r8,-2.35526E-02_r8,-1.36189E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.03522E-02_r8,-6.67837E+01_r8,-1.09724E-03_r8, 0.00000E+00_r8/ + DATA PF3/ & + -1.38821E-02_r8, 1.60468E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.51574E-02_r8, & + -5.44470E-04_r8, 0.00000E+00_r8, 7.28224E-02_r8, 6.59413E-02_r8, 0.00000E+00_r8, & + -5.15692E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.70367E+03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.36131E-02_r8, 5.38153E-03_r8, 0.00000E+00_r8, 4.76285E+00_r8, & + -1.75677E-02_r8, 2.26301E-02_r8, 0.00000E+00_r8, 1.76631E-02_r8, 4.77162E-03_r8, & + 0.00000E+00_r8, 5.39354E+00_r8, 0.00000E+00_r8,-7.51710E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-8.82736E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! H DENSITY + DATA PG1/ & + 1.26376E+00_r8,-2.14304E-01_r8,-1.49984E-01_r8, 2.30404E-01_r8, 2.98237E-02_r8, & + 2.68673E-02_r8, 2.96228E-01_r8, 2.21900E-02_r8,-2.07655E-02_r8, 4.52506E-01_r8, & + 1.20105E-01_r8, 3.24420E-02_r8, 4.24816E-02_r8,-9.14313E+00_r8, 0.00000E+00_r8, & + 2.47178E-02_r8,-2.88229E-02_r8, 8.12805E+01_r8, 5.10380E-02_r8,-5.80611E-03_r8, & + 2.51236E-05_r8,-1.24083E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8,-3.48190E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.89885E-05_r8, & + 0.00000E+00_r8, 1.53595E+02_r8,-1.68604E-02_r8, 0.00000E+00_r8, 1.01015E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.84552E-04_r8, & + -1.22181E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + -1.04927E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-5.91313E-03_r8/ + DATA PG2/ & + -2.30501E-02_r8, 3.14758E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.26956E-02_r8, & + 8.35489E-03_r8, 3.10513E-04_r8, 0.00000E+00_r8, 3.42119E+03_r8,-2.45017E-03_r8, & + -4.27154E-04_r8, 5.45152E-04_r8, 1.89896E-03_r8, 2.89121E+01_r8,-6.49973E-03_r8, & + -1.93855E-02_r8,-1.48492E-02_r8, 0.00000E+00_r8,-5.10576E-02_r8, 7.87306E-02_r8, & + 9.51981E-02_r8,-1.49422E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 2.65503E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 6.37110E-03_r8, 3.24789E-04_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 6.14274E-02_r8, 1.00376E-02_r8,-8.41083E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.27099E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PG3/ & + -3.94077E-03_r8,-1.28601E-02_r8,-7.97616E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-6.71465E-03_r8,-1.69799E-03_r8, 1.93772E-03_r8, 3.81140E+00_r8, & + -7.79290E-03_r8,-1.82589E-02_r8,-1.25860E-02_r8,-1.04311E-02_r8,-3.02465E-03_r8, & + 2.43063E-03_r8, 3.63237E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! N DENSITY + DATA PH1/ & + 7.09557E+01_r8,-3.26740E-01_r8, 0.00000E+00_r8,-5.16829E-01_r8,-1.71664E-03_r8, & + 9.09310E-02_r8,-6.71500E-01_r8,-1.47771E-01_r8,-9.27471E-02_r8,-2.30862E-01_r8, & + -1.56410E-01_r8, 1.34455E-02_r8,-1.19717E-01_r8, 2.52151E+00_r8, 0.00000E+00_r8, & + -2.41582E-01_r8, 5.92939E-02_r8, 4.39756E+00_r8, 9.15280E-02_r8, 4.41292E-03_r8, & + 0.00000E+00_r8, 8.66807E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 9.74701E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 6.70217E+01_r8,-1.31660E-03_r8, 0.00000E+00_r8,-1.65317E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 8.50247E-02_r8, 2.77428E+01_r8, 4.98658E-03_r8, & + 6.15115E-03_r8, 9.50156E-03_r8,-2.12723E-02_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + -2.38645E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.37380E-03_r8/ + DATA PH2/ & + -8.41918E-03_r8, 2.80145E-05_r8, 7.12383E-03_r8, 0.00000E+00_r8,-1.66209E-02_r8, & + 1.03533E-04_r8,-1.68898E-02_r8, 0.00000E+00_r8, 3.64526E+03_r8, 0.00000E+00_r8, & + 6.54077E-03_r8, 3.69130E-04_r8, 9.94419E-04_r8, 8.42803E+01_r8,-1.16124E-02_r8, & + -7.74414E-03_r8,-1.68844E-03_r8, 1.42809E-03_r8,-1.92955E-03_r8, 1.17225E-01_r8, & + -2.41512E-02_r8, 1.50521E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 1.60261E+03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.54403E-04_r8,-1.87270E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 2.76439E-02_r8, 6.43207E-03_r8,-3.54300E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-2.80221E-02_r8, 8.11228E+01_r8,-6.75255E-04_r8, 0.00000E+00_r8/ + DATA PH3/ & + -1.05162E-02_r8,-3.48292E-03_r8,-6.97321E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.45546E-03_r8,-1.31970E-02_r8,-3.57751E-03_r8,-1.09021E+00_r8, & + -1.50181E-02_r8,-7.12841E-03_r8,-6.64590E-03_r8,-3.52610E-03_r8,-1.87773E-02_r8, & + -2.22432E-03_r8,-3.93895E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! HOT O DENSITY + DATA PI1/ & + 6.04050E-02_r8, 1.57034E+00_r8, 2.99387E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.51018E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-8.61650E+00_r8, 1.26454E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 5.50878E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 6.23881E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + -9.45934E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PI2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PI3/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! S PARAM + DATA PJ1/ & + 9.56827E-01_r8, 6.20637E-02_r8, 3.18433E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 3.94900E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-9.24882E-03_r8,-7.94023E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.74712E+02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.74677E-03_r8, 0.00000E+00_r8, 1.54951E-02_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-6.99007E-04_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.24362E-02_r8,-5.28756E-03_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PJ2/ & + 0.00000E+00_r8, 2.47425E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PJ3/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! TURBO + DATA PK1/ & + 1.09930E+00_r8, 3.90631E+00_r8, 3.07165E+00_r8, 9.86161E-01_r8, 1.63536E+01_r8, & + 4.63830E+00_r8, 1.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.93318E-02_r8, 1.18339E-01_r8, & + 1.22732E+00_r8, 1.02669E-01_r8, 1.17681E+00_r8, 2.12185E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.08607E+00_r8, 1.34836E+00_r8, 1.10016E+00_r8, 7.34129E-01_r8, & + 1.15241E+00_r8, 2.22784E+00_r8, 7.95907E-01_r8, 4.03601E+00_r8, 4.39732E+00_r8, & + 1.23435E+02_r8,-4.52411E-02_r8, 1.68986E-06_r8, 7.44294E-01_r8, 1.03604E+00_r8, & + 1.72783E+02_r8, 1.17681E+00_r8, 2.12185E+00_r8,-7.83697E-01_r8, 9.49154E-01_r8/ +! LOWER BOUNDARY + DATA PTM/ & + 1.04130E+03_r8, 3.86000E+02_r8, 1.95000E+02_r8, 1.66728E+01_r8, 2.13000E+02_r8, & + 1.20000E+02_r8, 2.40000E+02_r8, 1.87000E+02_r8,-2.00000E+00_r8, 0.00000E+00_r8/ + DATA PDM/ & + 2.45600E+07_r8, 6.71072E-06_r8, 1.00000E+02_r8, 0.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 8.59400E+10_r8, 1.00000E+00_r8, 1.05000E+02_r8,-8.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 9.00000E+01_r8, 2.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 2.81000E+11_r8, 0.00000E+00_r8, 1.05000E+02_r8, 2.80000E+01_r8, 2.89500E+01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 3.30000E+10_r8, 2.68270E-01_r8, 1.05000E+02_r8, 1.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 1.10000E+02_r8,-1.00000E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 1.33000E+09_r8, 1.19615E-02_r8, 1.05000E+02_r8, 0.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 1.76100E+05_r8, 1.00000E+00_r8, 9.50000E+01_r8,-8.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 9.00000E+01_r8, 2.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 1.00000E+07_r8, 1.00000E+00_r8, 1.05000E+02_r8,-8.00000E+00_r8, 1.10000E+02_r8, & + 1.00000E+01_r8, 9.00000E+01_r8, 2.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & +! + 1.00000E+06_r8, 1.00000E+00_r8, 1.05000E+02_r8,-8.00000E+00_r8, 5.50000E+02_r8, & + 7.60000E+01_r8, 9.00000E+01_r8, 2.00000E+00_r8, 0.00000E+00_r8, 4.00000E+03_r8/ +! TN1(2) + DATA PL1/ & + 1.00858E+00_r8, 4.56011E-02_r8,-2.22972E-02_r8,-5.44388E-02_r8, 5.23136E-04_r8, & + -1.88849E-02_r8, 5.23707E-02_r8,-9.43646E-03_r8, 6.31707E-03_r8,-7.80460E-02_r8, & + -4.88430E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-7.60250E+00_r8, 0.00000E+00_r8, & + -1.44635E-02_r8,-1.76843E-02_r8,-1.21517E+02_r8, 2.85647E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 6.31792E-04_r8, 0.00000E+00_r8, 5.77197E-03_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-8.90272E+03_r8, 3.30611E-03_r8, 3.02172E-03_r8, 0.00000E+00_r8, & + -2.13673E-03_r8,-3.20910E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.76034E-03_r8, & + 2.82487E-03_r8,-2.97592E-04_r8,-4.21534E-03_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 8.96456E-03_r8, 0.00000E+00_r8,-1.08596E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PL2/ & + 5.57917E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 9.65405E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN1(3) + DATA PM1/ & + 9.39664E-01_r8, 8.56514E-02_r8,-6.79989E-03_r8, 2.65929E-02_r8,-4.74283E-03_r8, & + 1.21855E-02_r8,-2.14905E-02_r8, 6.49651E-03_r8,-2.05477E-02_r8,-4.24952E-02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.19148E+01_r8, 0.00000E+00_r8, & + 1.18777E-02_r8,-7.28230E-02_r8,-8.15965E+01_r8, 1.73887E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-1.44691E-02_r8, 2.80259E-04_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.16584E+02_r8, 3.18713E-03_r8, 7.37479E-03_r8, 0.00000E+00_r8, & + -2.55018E-03_r8,-3.92806E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.89757E-03_r8, & + -1.33549E-03_r8, 1.02661E-03_r8, 3.53775E-04_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + -9.17497E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PM2/ & + 3.56082E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.00902E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN1(4) + DATA PN1/ & + 9.85982E-01_r8,-4.55435E-02_r8, 1.21106E-02_r8, 2.04127E-02_r8,-2.40836E-03_r8, & + 1.11383E-02_r8,-4.51926E-02_r8, 1.35074E-02_r8,-6.54139E-03_r8, 1.15275E-01_r8, & + 1.28247E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8,-5.30705E+00_r8, 0.00000E+00_r8, & + -3.79332E-02_r8,-6.24741E-02_r8, 7.71062E-01_r8, 2.96315E-02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 6.81051E-03_r8,-4.34767E-03_r8, 8.66784E-02_r8, & + 1.58727E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.07003E+01_r8,-2.76907E-03_r8, 4.32474E-04_r8, 0.00000E+00_r8, & + 1.31497E-03_r8,-6.47517E-04_r8, 0.00000E+00_r8,-2.20621E+01_r8,-1.10804E-03_r8, & + -8.09338E-04_r8, 4.18184E-04_r8, 4.29650E-03_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PN2/ & + -4.04337E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-9.52550E-04_r8, & + 8.56253E-04_r8, 4.33114E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.21223E-03_r8, & + 2.38694E-04_r8, 9.15245E-04_r8, 1.28385E-03_r8, 8.67668E-04_r8,-5.61425E-06_r8, & + 1.04445E+00_r8, 3.41112E+01_r8, 0.00000E+00_r8,-8.40704E-01_r8,-2.39639E+02_r8, & + 7.06668E-01_r8,-2.05873E+01_r8,-3.63696E-01_r8, 2.39245E+01_r8, 0.00000E+00_r8, & + -1.06657E-03_r8,-7.67292E-04_r8, 1.54534E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN1(5) TN2(1) + DATA PO1/ & + 1.00320E+00_r8, 3.83501E-02_r8,-2.38983E-03_r8, 2.83950E-03_r8, 4.20956E-03_r8, & + 5.86619E-04_r8, 2.19054E-02_r8,-1.00946E-02_r8,-3.50259E-03_r8, 4.17392E-02_r8, & + -8.44404E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 4.96949E+00_r8, 0.00000E+00_r8, & + -7.06478E-03_r8,-1.46494E-02_r8, 3.13258E+01_r8,-1.86493E-03_r8, 0.00000E+00_r8, & + -1.67499E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.12686E-04_r8, 8.66784E-02_r8, & + 1.58727E-01_r8,-4.64167E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 4.37353E-03_r8,-1.99069E+02_r8, 0.00000E+00_r8,-5.34884E-03_r8, 0.00000E+00_r8, & + 1.62458E-03_r8, 2.93016E-03_r8, 2.67926E-03_r8, 5.90449E+02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.17266E-03_r8,-3.58890E-04_r8, 8.47001E-02_r8, 1.70147E-01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 1.38673E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PO2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.60571E-03_r8, & + 6.28078E-04_r8, 5.05469E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.57829E-03_r8, & + -4.00855E-04_r8, 5.04077E-05_r8,-1.39001E-03_r8,-2.33406E-03_r8,-4.81197E-04_r8, & + 1.46758E+00_r8, 6.20332E+00_r8, 0.00000E+00_r8, 3.66476E-01_r8,-6.19760E+01_r8, & + 3.09198E-01_r8,-1.98999E+01_r8, 0.00000E+00_r8,-3.29933E+02_r8, 0.00000E+00_r8, & + -1.10080E-03_r8,-9.39310E-05_r8, 1.39638E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN2(2) + DATA PP1/ & + 9.81637E-01_r8,-1.41317E-03_r8, 3.87323E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.58707E-02_r8, & + -8.63658E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.02226E+00_r8, 0.00000E+00_r8, & + -8.69424E-03_r8,-1.91397E-02_r8, 8.76779E+01_r8, 4.52188E-03_r8, 0.00000E+00_r8, & + 2.23760E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-7.07572E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + -4.11210E-03_r8, 3.50060E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-8.36657E-03_r8, 1.61347E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-1.45130E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PP2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.24152E-03_r8, & + 6.43365E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.33255E-03_r8, & + 2.42657E-03_r8, 1.60666E-03_r8,-1.85728E-03_r8,-1.46874E-03_r8,-4.79163E-06_r8, & + 1.22464E+00_r8, 3.53510E+01_r8, 0.00000E+00_r8, 4.49223E-01_r8,-4.77466E+01_r8, & + 4.70681E-01_r8, 8.41861E+00_r8,-2.88198E-01_r8, 1.67854E+02_r8, 0.00000E+00_r8, & + 7.11493E-04_r8, 6.05601E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN2(3) + DATA PQ1/ & + 1.00422E+00_r8,-7.11212E-03_r8, 5.24480E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-5.28914E-02_r8, & + -2.41301E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.12219E+01_r8,-1.03830E-02_r8, & + -3.28077E-03_r8, 1.65727E-02_r8, 1.68564E+00_r8,-6.68154E-03_r8, 0.00000E+00_r8, & + 1.45155E-02_r8, 0.00000E+00_r8, 8.42365E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-4.34645E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.16780E-02_r8, & + 0.00000E+00_r8,-1.38459E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 7.04573E-03_r8,-4.73204E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 1.08767E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PQ2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-8.08279E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.21769E-04_r8, & + -2.27387E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.26769E-03_r8, & + 3.16901E-03_r8, 4.60316E-04_r8,-1.01431E-04_r8, 1.02131E-03_r8, 9.96601E-04_r8, & + 1.25707E+00_r8, 2.50114E+01_r8, 0.00000E+00_r8, 4.24472E-01_r8,-2.77655E+01_r8, & + 3.44625E-01_r8, 2.75412E+01_r8, 0.00000E+00_r8, 7.94251E+02_r8, 0.00000E+00_r8, & + 2.45835E-03_r8, 1.38871E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN2(4) TN3(1) + DATA PR1/ & + 1.01890E+00_r8,-2.46603E-02_r8, 1.00078E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-6.70977E-02_r8, & + -4.02286E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.29466E+01_r8,-7.47019E-03_r8, & + 2.26580E-03_r8, 2.63931E-02_r8, 3.72625E+01_r8,-6.39041E-03_r8, 0.00000E+00_r8, & + 9.58383E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.85291E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 1.39717E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 9.19771E-03_r8,-3.69121E+02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-1.57067E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PR2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-7.07265E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.92953E-03_r8, & + -2.77739E-03_r8,-4.40092E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.47280E-03_r8, & + 2.95035E-04_r8,-1.81246E-03_r8, 2.81945E-03_r8, 4.27296E-03_r8, 9.78863E-04_r8, & + 1.40545E+00_r8,-6.19173E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-7.93632E+01_r8, & + 4.44643E-01_r8,-4.03085E+02_r8, 0.00000E+00_r8, 1.15603E+01_r8, 0.00000E+00_r8, & + 2.25068E-03_r8, 8.48557E-04_r8,-2.98493E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN3(2) + DATA PS1/ & + 9.75801E-01_r8, 3.80680E-02_r8,-3.05198E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.85575E-02_r8, & + 5.04057E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.76046E+02_r8, 1.44594E-02_r8, & + -1.48297E-03_r8,-3.68560E-03_r8, 3.02185E+01_r8,-3.23338E-03_r8, 0.00000E+00_r8, & + 1.53569E-02_r8, 0.00000E+00_r8,-1.15558E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 4.89620E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.00616E-02_r8, & + -8.21324E-03_r8,-1.57757E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 6.63564E-03_r8, 4.58410E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-2.51280E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PS2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 9.91215E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-8.73148E-04_r8, & + -1.29648E-03_r8,-7.32026E-05_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-4.68110E-03_r8, & + -4.66003E-03_r8,-1.31567E-03_r8,-7.39390E-04_r8, 6.32499E-04_r8,-4.65588E-04_r8, & + -1.29785E+00_r8,-1.57139E+02_r8, 0.00000E+00_r8, 2.58350E-01_r8,-3.69453E+01_r8, & + 4.10672E-01_r8, 9.78196E+00_r8,-1.52064E-01_r8,-3.85084E+03_r8, 0.00000E+00_r8, & + -8.52706E-04_r8,-1.40945E-03_r8,-7.26786E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN3(3) + DATA PU1/ & + 9.60722E-01_r8, 7.03757E-02_r8,-3.00266E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.22671E-02_r8, & + 4.10423E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.63070E+02_r8, 1.06073E-02_r8, & + 5.40747E-04_r8, 7.79481E-03_r8, 1.44908E+02_r8, 1.51484E-04_r8, 0.00000E+00_r8, & + 1.97547E-02_r8, 0.00000E+00_r8,-1.41844E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 5.77884E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 9.74319E-03_r8, & + 0.00000E+00_r8,-2.88015E+03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-4.44902E-03_r8,-2.92760E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 2.34419E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PU2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.36685E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-4.65325E-04_r8, & + -5.50628E-04_r8, 3.31465E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.06179E-03_r8, & + -3.08575E-03_r8,-7.93589E-04_r8,-1.08629E-04_r8, 5.95511E-04_r8,-9.05050E-04_r8, & + 1.18997E+00_r8, 4.15924E+01_r8, 0.00000E+00_r8,-4.72064E-01_r8,-9.47150E+02_r8, & + 3.98723E-01_r8, 1.98304E+01_r8, 0.00000E+00_r8, 3.73219E+03_r8, 0.00000E+00_r8, & + -1.50040E-03_r8,-1.14933E-03_r8,-1.56769E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN3(4) + DATA PV1/ & + 1.03123E+00_r8,-7.05124E-02_r8, 8.71615E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-3.82621E-02_r8, & + -9.80975E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.89286E+01_r8, 9.57341E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 8.66153E+01_r8, 7.91938E-04_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 4.68917E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 7.86638E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 9.90827E-03_r8, & + 0.00000E+00_r8, 6.55573E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-4.00200E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 7.07457E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PV2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.72268E-03_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.04970E-04_r8, & + 1.21560E-03_r8,-8.05579E-06_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.49941E-03_r8, & + -4.57256E-04_r8,-1.59311E-04_r8, 2.96481E-04_r8,-1.77318E-03_r8,-6.37918E-04_r8, & + 1.02395E+00_r8, 1.28172E+01_r8, 0.00000E+00_r8, 1.49903E-01_r8,-2.63818E+01_r8, & + 0.00000E+00_r8, 4.70628E+01_r8,-2.22139E-01_r8, 4.82292E-02_r8, 0.00000E+00_r8, & + -8.67075E-04_r8,-5.86479E-04_r8, 5.32462E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TN3(5) SURFACE TEMP TSL + DATA PW1/ & + 1.00828E+00_r8,-9.10404E-02_r8,-2.26549E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-2.32420E-02_r8, & + -9.08925E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.36105E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-1.24957E+01_r8,-5.87939E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.79765E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.01237E+03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-1.75553E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PW2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.29699E-03_r8, & + 1.26659E-03_r8, 2.68402E-04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.17894E-03_r8, & + 1.48746E-03_r8, 1.06478E-04_r8, 1.34743E-04_r8,-2.20939E-03_r8,-6.23523E-04_r8, & + 6.36539E-01_r8, 1.13621E+01_r8, 0.00000E+00_r8,-3.93777E-01_r8, 2.38687E+03_r8, & + 0.00000E+00_r8, 6.61865E+02_r8,-1.21434E-01_r8, 9.27608E+00_r8, 0.00000E+00_r8, & + 1.68478E-04_r8, 1.24892E-03_r8, 1.71345E-03_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TGN3(2) SURFACE GRAD TSLG + DATA PX1/ & + 1.57293E+00_r8,-6.78400E-01_r8, 6.47500E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-7.62974E-02_r8, & + -3.60423E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 1.28358E+02_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 4.68038E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.67898E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.90994E+04_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.15706E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PX2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TGN2(1) TGN1(2) + DATA PY1/ & + 8.60028E-01_r8, 3.77052E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.17570E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 7.77757E-03_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 1.01024E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 6.54251E+02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PY2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.56959E-02_r8, & + 1.91001E-02_r8, 3.15971E-02_r8, 1.00982E-02_r8,-6.71565E-03_r8, 2.57693E-03_r8, & + 1.38692E+00_r8, 2.82132E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.81511E+02_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! TGN3(1) TGN2(2) + DATA PZ1/ & + 1.06029E+00_r8,-5.25231E-02_r8, 3.73034E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.31072E-02_r8, & + -3.88409E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8,-1.65295E+02_r8,-2.13801E-01_r8, & + -4.38916E-02_r8,-3.22716E-01_r8,-8.82393E+01_r8, 1.18458E-01_r8, 0.00000E+00_r8, & + -4.35863E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8,-1.19782E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 2.62229E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8,-5.37443E+01_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8,-4.55788E-01_r8, 0.00000E+00_r8, 0.00000E+00_r8/ + DATA PZ2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 3.84009E-02_r8, & + 3.96733E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 5.05494E-02_r8, & + 7.39617E-02_r8, 1.92200E-02_r8,-8.46151E-03_r8,-1.34244E-02_r8, 1.96338E-02_r8, & + 1.50421E+00_r8, 1.88368E+01_r8, 0.00000E+00_r8, 0.00000E+00_r8,-5.13114E+01_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 5.11923E-02_r8, 3.61225E-02_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 2.00000E+00_r8/ +! SEMIANNUAL MULT SAM + DATA PAA1/ & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, & + 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8, 1.00000E+00_r8/ + DATA PAA2/ & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, & + 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8, 0.00000E+00_r8/ +! MIDDLE ATMOSPHERE AVERAGES + DATA PAVGM/ & + 2.61000E+02_r8, 2.64000E+02_r8, 2.29000E+02_r8, 2.17000E+02_r8, 2.17000E+02_r8, & + 2.23000E+02_r8, 2.86760E+02_r8,-2.93940E+00_r8, 2.50000E+00_r8, 0.00000E+00_r8/ + + END BLOCK DATA GTD7BK + +!================================================================================================ + diff --git a/src/chemistry/utils/prescribed_aero.F90 b/src/chemistry/utils/prescribed_aero.F90 new file mode 100644 index 0000000000..6b5759edff --- /dev/null +++ b/src/chemistry/utils/prescribed_aero.F90 @@ -0,0 +1,668 @@ +!------------------------------------------------------------------- +! Manages reading and interpolation of prescribed aerosol concentrations. +! This places the concentration fields in the physics buffer so that +! radiation package can access them. +! +! This has been generalized so that the field names in the data files +! and the field names in the physics buffer can be arbitrary. +! +! The prescribed_aero_specifier namelist variable specifies a list of +! variable names of the concentration fields in the netCDF dataset (ncdf_fld_name) +! and the corresponding names used in the physics buffer: +! +! prescribed_aero_specifier = 'pbuf_name1:ncdf_fld_name1','pbuf_name2:ncdf_fld_name2', ... +! +! If there is no ":" then the specified name is used as both the +! pbuf_name and ncdf_fld_name +! +! Created by: Francis Vitt +!------------------------------------------------------------------- +module prescribed_aero + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + use pio, only : var_desc_t + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: prescribed_aero_init + public :: prescribed_aero_adv + public :: write_prescribed_aero_restart + public :: read_prescribed_aero_restart + public :: has_prescribed_aero + public :: prescribed_aero_register + public :: init_prescribed_aero_restart + public :: prescribed_aero_readnl + + logical :: has_prescribed_aero = .false. + + ! Decides if its a modal aerosol simulation or not + logical :: clim_modal_aero = .false. + + integer, parameter, public :: N_AERO = 50 + + integer :: number_flds + + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = ' ' + character(len=256) :: datapath = ' ' + character(len=32) :: datatype = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + character(len=32) :: specifier(N_AERO) = '' + + ! prescribed aerosol names + character(len=16), allocatable :: pbuf_names(:) + + integer :: aero_cnt + integer :: aero_cnt_c = 0 ! clound borne species count for modal aerosols (zero otherwise) + + ! Normal random number which persists from one tiemstep to the next + real(r8) :: randn_persists + + ! Following definitions are added to + ! allow randn_persists to persist during restart runs + type(var_desc_t) :: randn_persists_desc + character(len=16), parameter :: randn_persists_name = 'prescraero_randn' + +contains + +!------------------------------------------------------------------- +! registers aerosol fields to the phys buffer +!------------------------------------------------------------------- + subroutine prescribed_aero_register() + + use ppgrid, only: pver,pcols + + use physics_buffer, only : pbuf_add_field, dtype_r8 + integer :: i,idx + + if (has_prescribed_aero) then + do i = 1,aero_cnt + call pbuf_add_field(pbuf_names(i),'physpkg',dtype_r8,(/pcols,pver/),idx) + enddo + endif + + endsubroutine prescribed_aero_register + +!------------------------------------------------------------------- +! parses prescribed_aero_specifier namelist option +!------------------------------------------------------------------- + subroutine prescribed_aero_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld + use ppgrid, only : pver + use error_messages, only: handle_err + use ppgrid, only: pcols, pver, begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + implicit none + + ! local vars + character(len=32) :: spec_a + integer :: ndx, istat, i, i_c, j + + if ( has_prescribed_aero ) then + if ( masterproc ) then + write(iulog,*) 'aero is prescribed in :'//trim(filename) + endif + else + return + endif + + + allocate (file%in_pbuf(size(specifier))) + if (clim_modal_aero) then + file%in_pbuf(:) = .false. + do i = 1,N_AERO + do j=1,aero_cnt + if(specifier(i) .eq. pbuf_names(j)) then + file%in_pbuf(i) = .true. + exit + endif + enddo + enddo + else + file%in_pbuf(:) = .true. + endif + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + number_flds = 0 + if (associated(fields)) number_flds = size( fields ) + + if( number_flds < 1 ) then + if ( masterproc ) then + write(iulog,*) 'There are no prescribed aerosols' + write(iulog,*) ' ' + endif + return + end if + + ! Following loop add fields for output. For modal aerosols, first the cld borne aersols + ! are added and then their interstitial counterparts are added. The loop exits once all the cld borne + ! aerosols (and their interstitial counterparts) are added. Note that the units(fields(i)%units), + ! will be same for both interstitial and cloud borne species. + ! All other aerosol treatments(bulk) are left unchanged + i_c = 0 + fldloop:do i = 1,number_flds + if(clim_modal_aero .and. index(trim(fields(i)%fldnam),'_c') > 1) then ! Only cloud borne species + call addfld(trim(fields(i)%fldnam)//'_D', (/ 'lev' /), 'A',trim(fields(i)%units), 'prescribed aero' ) + call spec_c_to_a(trim(fields(i)%fldnam),spec_a) + call addfld(trim(spec_a)//'_D', (/ 'lev' /), 'A',trim(fields(i)%units), 'prescribed aero' ) + i_c = i_c + 1 + if(i_c >= aero_cnt_c) exit fldloop + else + call addfld(trim(fields(i)%fldnam)//'_D', (/ 'lev' /), 'A',trim(fields(i)%units), 'prescribed aero' ) + endif + enddo fldloop + + end subroutine prescribed_aero_init + +!------------------------------------------------------------------- +! reads namelist options +!------------------------------------------------------------------- +subroutine prescribed_aero_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, nmodes, aero_loop_end + logical :: skip_spec + character(len=*), parameter :: subname = 'prescribed_aero_readnl' + + character(len=32) :: prescribed_aero_specifier(N_AERO) + character(len=256) :: prescribed_aero_file + character(len=256) :: prescribed_aero_filelist + character(len=256) :: prescribed_aero_datapath + character(len=32) :: prescribed_aero_type + logical :: prescribed_aero_rmfile + integer :: prescribed_aero_cycle_yr + integer :: prescribed_aero_fixed_ymd + integer :: prescribed_aero_fixed_tod + integer :: i,k + + namelist /prescribed_aero_nl/ & + prescribed_aero_specifier, & + prescribed_aero_file, & + prescribed_aero_filelist, & + prescribed_aero_datapath, & + prescribed_aero_type, & + prescribed_aero_rmfile, & + prescribed_aero_cycle_yr, & + prescribed_aero_fixed_ymd, & + prescribed_aero_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + prescribed_aero_specifier= specifier + prescribed_aero_file = filename + prescribed_aero_filelist = filelist + prescribed_aero_datapath = datapath + prescribed_aero_type = datatype + prescribed_aero_rmfile = rmv_file + prescribed_aero_cycle_yr = cycle_yr + prescribed_aero_fixed_ymd= fixed_ymd + prescribed_aero_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'prescribed_aero_nl', status=ierr) + if (ierr == 0) then + read(unitn, prescribed_aero_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(prescribed_aero_specifier,len(prescribed_aero_specifier(1))*N_AERO, mpichar, 0, mpicom) + call mpibcast(prescribed_aero_file, len(prescribed_aero_file), mpichar, 0, mpicom) + call mpibcast(prescribed_aero_filelist, len(prescribed_aero_filelist), mpichar, 0, mpicom) + call mpibcast(prescribed_aero_datapath, len(prescribed_aero_datapath), mpichar, 0, mpicom) + call mpibcast(prescribed_aero_type, len(prescribed_aero_type), mpichar, 0, mpicom) + call mpibcast(prescribed_aero_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(prescribed_aero_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(prescribed_aero_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(prescribed_aero_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier = prescribed_aero_specifier + filename = prescribed_aero_file + filelist = prescribed_aero_filelist + datapath = prescribed_aero_datapath + datatype = prescribed_aero_type + rmv_file = prescribed_aero_rmfile + cycle_yr = prescribed_aero_cycle_yr + fixed_ymd = prescribed_aero_fixed_ymd + fixed_tod = prescribed_aero_fixed_tod + + ! Turn on prescribed aerosols if user has specified an input dataset. + has_prescribed_aero = len_trim(filename) > 0 .and. filename.ne.'NONE' + + if ( .not. has_prescribed_aero) return + + ! Determine whether its a 'modal' aerosol simulation or not + call rad_cnst_get_info(0, nmodes=nmodes) + clim_modal_aero = (nmodes > 0) + + ! For modal aerosols, interstitial species(*_a) are diagnosed from + ! their *_logm and *_logv counterparts (e.g. soa_a1 is diagnosed from + ! soa_a1_logm and soa_a1_logv). Therefore, only *_logm and *_logv and cloud + ! borne (*_c) species are specified in the build-namelist. In the following + ! cnt_loop, we will count the cloud borne species and *_logm species(in lieu + ! of *_a species). We will skip *_logv species. This will ensure that aero_cnt + ! variable is the sum of cloud borne and interstitial species (which we will + ! manually add in pbuf_names array later). We are also counting cloud borne + ! (*_c) species which will help adding the same number of interstitial species + ! in pbuf_names array + + ! determine which prescibed aerosols are specified + aero_cnt = 0 + aero_cnt_c = 0 ! cloud borne species count + cnt_loop: do i = 1,N_AERO + if ( len_trim(specifier(i))==0 ) exit cnt_loop + skip_spec = .FALSE. + if(clim_modal_aero) then + ! For modal aerosols, skip counting species ending with *_logv + if(index(specifier(i),'_c') >= 1) aero_cnt_c = aero_cnt_c + 1 + if(index(specifier(i),'_logv') >= 1) skip_spec = .TRUE. + endif + if(.NOT.skip_spec)aero_cnt = aero_cnt+1 + end do cnt_loop + + has_prescribed_aero = aero_cnt>0 + if ( .not. has_prescribed_aero) return + + allocate(pbuf_names(aero_cnt)) + + ! For modal aerosols, the following loop will add the cloud borne + ! species directly and interstitial species through the "add_interstitial_spec" + ! call. Interstitial species are added at the end of the cloud borne species in + ! pbuf_names array. + ! Note that aero_cnt_c should be zero for all other aerosol trearments + ! except the modal aerosols (e.g. bulk) + + if(.NOT. clim_modal_aero) aero_cnt_c = 0 + aero_loop_end = aero_cnt - aero_cnt_c + + do i = 1,aero_loop_end + k = scan( specifier(i),':') + if (k>1) then + pbuf_names(i) = trim(specifier(i)(:k-1)) + if(clim_modal_aero)call add_interstitial_spec(aero_loop_end,i) + else + pbuf_names(i) = trim(specifier(i)) + if(clim_modal_aero)call add_interstitial_spec(aero_loop_end,i) + endif + enddo + +end subroutine prescribed_aero_readnl + +!------------------------------------------------------------------- +! Add interstitial aerosols in pbuf_names array for modal aerosols +!------------------------------------------------------------------- +subroutine add_interstitial_spec(aero_loop_end,i_in) + implicit none + + !Arguments + integer, intent(in) :: i_in, aero_loop_end + + !Local + character(len=32) :: spec_a + + ! Replace 'c' with 'a' in species name + call spec_c_to_a(pbuf_names(i_in), spec_a) + pbuf_names(aero_loop_end+i_in) = spec_a +end subroutine add_interstitial_spec + +!------------------------------------------------------------------- +! A generic subroutine which replaces 'c' in the cloud borne +! species name with 'a' to make it interstital species +!------------------------------------------------------------------- +subroutine spec_c_to_a (spec_c_in,spec_a_out) + implicit none + + !Arguments + character(len=*), intent(in) :: spec_c_in + character(len=*), intent(out) :: spec_a_out + + !Local + character(len=32) :: name + character(len=1000) :: errMsg + integer :: k_c, k_cp1 + + k_c = index(trim(adjustl(spec_c_in)),'_c') + if(k_c >= 1) then + k_cp1 = k_c + 1 + name = trim(adjustl(spec_c_in)) + name(k_cp1:k_cp1) = 'a' + spec_a_out = trim(adjustl(name)) + else + write(errMsg,*) "Input string (",trim(spec_c_in)," is not a cld borne aerosol,", & + "cannot form interstitial species name" + call endrun(trim(errMsg)) + endif +end subroutine spec_c_to_a + +!------------------------------------------------------------------- +! advances the aerosol fields to the current time step +!------------------------------------------------------------------- + subroutine prescribed_aero_adv( state, pbuf2d ) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk, & + pbuf_get_index + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + character(len=32) :: spec_a + integer :: c,ncol, i, i_c, spec_a_ndx, errcode + real(r8),pointer :: outdata(:,:) + logical :: cld_borne_aero = .FALSE. + + if( .not. has_prescribed_aero ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! Diagnose interstital species using random sampling + if ( clim_modal_aero ) then + call rand_sample_prescribed_aero(state, pbuf2d ) + endif + + ! set the tracer fields with the correct units + i_c = 0 + fldloop : do i = 1,number_flds + +!$OMP PARALLEL DO PRIVATE (C, NCOL, OUTDATA,PBUF_CHNK) + do c = begchunk,endchunk + ncol = state(c)%ncol + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + if(clim_modal_aero .and. index(trim(fields(i)%fldnam),'_c') > 1) then ! Only cloud borne species + call pbuf_get_field(pbuf_chnk, fields(i)%pbuf_ndx, outdata) + call outfld( trim(fields(i)%fldnam)//'_D', outdata(:ncol,:), ncol, state(c)%lchnk ) + + call spec_c_to_a(trim(fields(i)%fldnam),spec_a) + spec_a_ndx = pbuf_get_index(trim(fields(i)%fldnam),errcode) + call pbuf_get_field(pbuf_chnk, spec_a_ndx, outdata) + call outfld( trim(spec_a)//'_D', outdata(:ncol,:), ncol, state(c)%lchnk ) + cld_borne_aero = .TRUE. + else + call pbuf_get_field(pbuf_chnk, fields(i)%pbuf_ndx, outdata) + call outfld( trim(fields(i)%fldnam)//'_D', outdata(:ncol,:), ncol, state(c)%lchnk ) + endif + enddo + if(cld_borne_aero)then + i_c = i_c + 1 + cld_borne_aero = .FALSE. + if(i_c >= aero_cnt_c) exit fldloop + endif + enddo fldloop + + end subroutine prescribed_aero_adv + +!------------------------------------------------------------------- + subroutine rand_sample_prescribed_aero(state, pbuf2d) + + !Purpose: Generates log normal distribution for the interstitial species. + !Note that only the interstitial aerosols are diagnosed here + ! + !Written by Balwinder Singh (12/14/2012) + !Adapted from Jin-Ho Yoon + ! + !Update log: + + use physics_types, only : physics_state + use ppgrid, only : begchunk, endchunk, pver + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk, & + pbuf_get_index + use ppgrid, only : pcols, pver + + !Arguments + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !Local + real(r8), parameter :: mean_max_val = 5.0_r8 + real(r8), parameter :: std_max_val = 3.0_r8 + + integer :: c, ncol, i, kc, klog, logv_ndx, logm_ndx, a_ndx, icol, kpver + real(r8) :: logm2, variance, std, mean_max, std_max, randn + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + real(r8), pointer :: data(:,:) + real(r8) :: logm_data(pcols,pver),logv_data(pcols,pver) + + randn = randn_prescribed_aero() + do i = 1, aero_cnt + !Species with '_a' are updated using random sampling. + !Cloud borne species (ends with _c1,_c2, etc.) have to be skipped + kc = index(pbuf_names(i),'_c') + ! if kc>1, species is cloud borne species + if( kc > 1) cycle + + !If species is ending with _a1, a2 etc., then find indicies of their + !logv and lom conterparts + logv_ndx = logvm_get_index(pbuf_names(i),'v') + logm_ndx = logvm_get_index(pbuf_names(i),'m') + a_ndx = pbuf_get_index(trim(adjustl(pbuf_names(i)))) + + do c = begchunk, endchunk + ncol = state(c)%ncol + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + + !Get the species mixing ratio nad its logv and logm values + call pbuf_get_field(pbuf_chnk, a_ndx, data) + logv_data = fields(logv_ndx)%data(:,:,c) + logm_data = fields(logm_ndx)%data(:,:,c) + + do icol = 1, ncol + do kpver = 1, pver + logm2 = logm_data(icol,kpver) * logm_data(icol,kpver) + + !Compute variance + variance = max( 0.0_r8, (logv_data(icol,kpver) - logm2) ) + + !Standard deviation + std = sqrt(variance) + + !Bounds to keep mixing ratios from going unphysical + mean_max = exp(logm_data(icol,kpver)) * mean_max_val + std_max = exp(logm_data(icol,kpver) + std_max_val * std ) + + data(icol,kpver) = min(exp(logm_data(icol,kpver)+randn*std),mean_max,std_max) + + enddo !pver + enddo !col + enddo !chunk + enddo !flds + + end subroutine rand_sample_prescribed_aero +!------------------------------------------------------------------- + function randn_prescribed_aero() + !Pupose: This function generates a new normally distributed random + ! number at end end of each day. This random number then stays the same + ! for the whole day + ! + !Written by Balwinder Singh (12/14/2012) + !Adapted from Jin-Ho Yoon + ! + !Update log: + + use time_manager, only : is_end_curr_day, is_first_step, get_nstep + + integer, parameter :: rconst1_1 = 5000000 + integer, parameter :: rconst1_2 = 50 + integer, parameter :: rconst2_1 = 10000000 + integer, parameter :: rconst2_2 = 10 + + integer :: i, seed_size, nstep + integer, allocatable :: seed(:) + + real(r8) :: randn_prescribed_aero + real(r8) :: randu1, randu2 + + !Use same random number for the entire day and generate a new normally + !distributed random number at the start of the new day + if(is_first_step() .or. is_end_curr_day()) then + !Generate two uniformly distributed random numbers (between 0 and 1) + call random_seed(size=seed_size) + allocate(seed(seed_size)) + + ! Using nstep as a seed to generate same sequence + nstep = get_nstep() + do i = 1, seed_size + seed(i) = rconst1_1*nstep + rconst1_2*(i-1) + end do + call random_seed(put=seed) + call random_number (randu1) + + do i = 1, seed_size + seed(i) = rconst2_1*nstep + rconst2_2*(i-1) + end do + call random_seed(put=seed) + call random_number (randu2) + deallocate(seed) + + !Normal distribution (Mean = 0, standard dev = 1) + randn_prescribed_aero = boxMuller(randu1,randu2) + randn_persists = randn_prescribed_aero + else + !Use the previously generated random number + randn_prescribed_aero = randn_persists + endif + end function randn_prescribed_aero +!------------------------------------------------------------------- + function logvm_get_index(name,type) result(index) + implicit none + + !Args + character(len=*), intent(in) :: name, type + + !Loc + character(len=64) :: tmp_name + character(len=1000) :: msgStr + integer :: index, i + + + index = -1 + tmp_name = trim(adjustl(name))//'_log'//trim(adjustl(type)) + + fldloop: do i = 1, number_flds + if(fields(i)%fldnam == tmp_name) then + index = i + exit fldloop + endif + enddo fldloop + + if(index == -1) then + write(msgStr,*) "Prescribed_aero.F90: ",tmp_name," doesn't exist in the fields%fldnam" + call endrun(msgStr) + endif + + end function logvm_get_index +!------------------------------------------------------------------- + function boxMuller(ru1,ru2) result(rn) + use physconst, only : pi + implicit none + + !Args + real(r8), intent(in) :: ru1, ru2 + + !Loc + real(r8), parameter :: pi2 = 2._r8 * pi + real(r8) :: ur, theta, rn + + !Based on Box Muller Method, generate normally distributed random numbers + ur = sqrt(-2._r8 * log(ru1)) + theta = pi2 * ru2 + + !Normal distribution (Mean = 0, standard dev = 1) + rn = ur * cos(theta) + + end function boxMuller + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine init_prescribed_aero_restart( piofile ) + use pio, only : file_desc_t, pio_def_var, pio_double + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + integer :: ierr + + ! For allowing randn_persists to persist during reststarts + ierr = pio_def_var(piofile, randn_persists_name, pio_double, randn_persists_desc) + + call init_trc_restart( 'prescribed_aero', piofile, file ) + + end subroutine init_prescribed_aero_restart +!------------------------------------------------------------------- + subroutine write_prescribed_aero_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t, pio_put_var + implicit none + + type(file_desc_t) :: piofile + integer :: ierr + + ! For allowing randn_persists to persist during reststarts + ierr = pio_put_var(piofile, randn_persists_desc, (/randn_persists/)) + + call write_trc_restart( piofile, file ) + + end subroutine write_prescribed_aero_restart + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine read_prescribed_aero_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t, pio_inq_varid, pio_get_var + implicit none + + type(file_desc_t) :: piofile + integer :: ierr + + ! For allowing randn_persists to persist during reststarts + ierr = pio_inq_varid(pioFile, randn_persists_name, randn_persists_desc) + ierr = pio_get_var(pioFile, randn_persists_desc, randn_persists) + + call read_trc_restart( 'prescribed_aero', piofile, file ) + + end subroutine read_prescribed_aero_restart + +end module prescribed_aero diff --git a/src/chemistry/utils/prescribed_ghg.F90 b/src/chemistry/utils/prescribed_ghg.F90 new file mode 100644 index 0000000000..7046704544 --- /dev/null +++ b/src/chemistry/utils/prescribed_ghg.F90 @@ -0,0 +1,326 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of prescribed ghg tracers +! Created by: Francis Vitt +!------------------------------------------------------------------- +module prescribed_ghg + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: prescribed_ghg_init + public :: prescribed_ghg_adv + public :: write_prescribed_ghg_restart + public :: read_prescribed_ghg_restart + public :: has_prescribed_ghg + public :: prescribed_ghg_register + public :: init_prescribed_ghg_restart + public :: prescribed_ghg_readnl + + logical :: has_prescribed_ghg = .false. + integer, parameter, public :: N_GHG = 5 + integer :: number_flds + + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: datatype = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + character(len=16) :: specifier(N_GHG) = '' + + character(len=8) :: ghg_names(N_GHG) = (/ 'prsd_co2', 'prsd_ch4', 'prsd_n2o', 'prsd_f11', 'prsd_f12' /) + real(r8), parameter :: molmass(N_GHG) = (/ 44.00980_r8, 16.04060_r8, 44.01288_r8, 137.3675_r8, 120.9132_r8 /) + + integer :: index_map(N_GHG) + +contains + + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +subroutine prescribed_ghg_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'prescribed_ghg_readnl' + + character(len=16) :: prescribed_ghg_specifier(N_GHG) + character(len=256) :: prescribed_ghg_file + character(len=256) :: prescribed_ghg_filelist + character(len=256) :: prescribed_ghg_datapath + character(len=32) :: prescribed_ghg_type + logical :: prescribed_ghg_rmfile + integer :: prescribed_ghg_cycle_yr + integer :: prescribed_ghg_fixed_ymd + integer :: prescribed_ghg_fixed_tod + + namelist /prescribed_ghg_nl/ & + prescribed_ghg_specifier, & + prescribed_ghg_file, & + prescribed_ghg_filelist, & + prescribed_ghg_datapath, & + prescribed_ghg_type, & + prescribed_ghg_rmfile, & + prescribed_ghg_cycle_yr, & + prescribed_ghg_fixed_ymd, & + prescribed_ghg_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + prescribed_ghg_specifier= specifier + prescribed_ghg_file = filename + prescribed_ghg_filelist = filelist + prescribed_ghg_datapath = datapath + prescribed_ghg_type = datatype + prescribed_ghg_rmfile = rmv_file + prescribed_ghg_cycle_yr = cycle_yr + prescribed_ghg_fixed_ymd= fixed_ymd + prescribed_ghg_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'prescribed_ghg_nl', status=ierr) + if (ierr == 0) then + read(unitn, prescribed_ghg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(prescribed_ghg_specifier,len(prescribed_ghg_specifier(1))*N_GHG, mpichar, 0, mpicom) + call mpibcast(prescribed_ghg_file, len(prescribed_ghg_file), mpichar, 0, mpicom) + call mpibcast(prescribed_ghg_filelist, len(prescribed_ghg_filelist), mpichar, 0, mpicom) + call mpibcast(prescribed_ghg_datapath, len(prescribed_ghg_datapath), mpichar, 0, mpicom) + call mpibcast(prescribed_ghg_type, len(prescribed_ghg_type), mpichar, 0, mpicom) + call mpibcast(prescribed_ghg_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(prescribed_ghg_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(prescribed_ghg_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(prescribed_ghg_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier = prescribed_ghg_specifier + filename = prescribed_ghg_file + filelist = prescribed_ghg_filelist + datapath = prescribed_ghg_datapath + datatype = prescribed_ghg_type + rmv_file = prescribed_ghg_rmfile + cycle_yr = prescribed_ghg_cycle_yr + fixed_ymd = prescribed_ghg_fixed_ymd + fixed_tod = prescribed_ghg_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_prescribed_ghg = .true. + +end subroutine prescribed_ghg_readnl + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ghg_register() + use ppgrid, only: pver, pcols + use physics_buffer, only : pbuf_add_field, dtype_r8 + + integer :: i,idx + + if (has_prescribed_ghg) then + do i = 1,N_GHG + call pbuf_add_field(ghg_names(i),'physpkg',dtype_r8,(/pcols,pver/),idx) + enddo + endif + + endsubroutine prescribed_ghg_register +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ghg_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld + + implicit none + + integer :: ndx, istat, i + + if ( has_prescribed_ghg ) then + if ( masterproc ) then + write(iulog,*) 'ghg is prescribed in :'//trim(filename) + endif + else + return + endif + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .true. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + number_flds = 0 + if (associated(fields)) number_flds = size( fields ) + + if( number_flds < 1 ) then + if ( masterproc ) then + write(iulog,*) 'There are no prescribed ghg tracers' + write(iulog,*) ' ' + endif + return + end if + + do i = 1,number_flds + ndx = get_ndx( fields(i)%fldnam ) + index_map(i) = ndx + + if (ndx < 1) then + call endrun('prescribed_ghg_init: '//trim(fields(i)%fldnam)//' is not one of the named ghg fields in pbuf2d') + endif + call addfld( fields(i)%fldnam, (/ 'lev' /), 'I','kg/kg', 'prescribed ghg' ) + enddo + + end subroutine prescribed_ghg_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ghg_adv( state, pbuf2d) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz ! J/K/molecule + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field, pbuf_get_chunk + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + integer :: ind,c,ncol,i + real(r8) :: to_mmr(pcols,pver) + real(r8) :: outdata(pcols,pver) + real(r8),pointer :: tmpptr(:,:) + + character(len=32) :: units_str + + if( .not. has_prescribed_ghg ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! set the correct units and invoke history outfld + do i = 1,number_flds + ind = index_map(i) + + units_str = trim(to_lower(trim(fields(i)%units(:GLC(fields(i)%units))))) + +!$OMP PARALLEL DO PRIVATE (C, NCOL, OUTDATA, TO_MMR, tmpptr, pbuf_chnk) + do c = begchunk,endchunk + ncol = state(c)%ncol + + select case ( units_str ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_mmr(:ncol,:) = (molmass(ind)*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr') + to_mmr(:ncol,:) = 1._r8 + case ('mol/mol','mole/mole','vmr','fraction') + to_mmr(:ncol,:) = molmass(ind)/mwdry + case default + print*, 'prescribed_ghg_adv: units = ',trim(fields(i)%units) ,' are not recognized' + call endrun('prescribed_ghg_adv: units are not recognized') + end select + + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + call pbuf_get_field(pbuf_chnk, fields(i)%pbuf_ndx, tmpptr ) + + tmpptr(:ncol,:) = tmpptr(:ncol,:)*to_mmr(:ncol,:) + + outdata(:ncol,:) = tmpptr(:ncol,:) + call outfld( fields(1)%fldnam, outdata(:ncol,:), ncol, state(c)%lchnk ) + + enddo + enddo + + end subroutine prescribed_ghg_adv + +!------------------------------------------------------------------- + +!------------------------------------------------------------------- + subroutine init_prescribed_ghg_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'prescribed_ghg', piofile, file ) + + end subroutine init_prescribed_ghg_restart +!------------------------------------------------------------------- + subroutine write_prescribed_ghg_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_prescribed_ghg_restart + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine read_prescribed_ghg_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call read_trc_restart( 'prescribed_ghg', piofile, file ) + + end subroutine read_prescribed_ghg_restart +!------------------------------------------------------------------- + integer function get_ndx( name ) + + implicit none + character(len=*), intent(in) :: name + + integer :: i + + get_ndx = 0 + do i = 1,N_GHG + if ( trim(name) == trim(ghg_names(i)) ) then + get_ndx = i + return + endif + enddo + + end function get_ndx + +end module prescribed_ghg diff --git a/src/chemistry/utils/prescribed_ozone.F90 b/src/chemistry/utils/prescribed_ozone.F90 new file mode 100644 index 0000000000..92a4ac84b4 --- /dev/null +++ b/src/chemistry/utils/prescribed_ozone.F90 @@ -0,0 +1,293 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of prescribed ozone +! Created by: Francis Vitt +!------------------------------------------------------------------- +module prescribed_ozone + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: prescribed_ozone_init + public :: prescribed_ozone_adv + public :: write_prescribed_ozone_restart + public :: read_prescribed_ozone_restart + public :: has_prescribed_ozone + public :: prescribed_ozone_register + public :: init_prescribed_ozone_restart + public :: prescribed_ozone_readnl + + logical :: has_prescribed_ozone = .false. + character(len=8), parameter :: ozone_name = 'ozone' + + character(len=16) :: fld_name = 'ozone' + character(len=256) :: filename = ' ' + character(len=256) :: filelist = ' ' + character(len=256) :: datapath = ' ' + character(len=32) :: data_type = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ozone_register() + use ppgrid, only: pver, pcols + use physics_buffer, only : pbuf_add_field, dtype_r8 + + integer :: oz_idx + + if (has_prescribed_ozone) then + call pbuf_add_field(ozone_name,'physpkg',dtype_r8,(/pcols,pver/),oz_idx) + + endif + + endsubroutine prescribed_ozone_register + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ozone_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld + + implicit none + + integer :: ndx, istat + character(len=32) :: specifier(1) + + if ( has_prescribed_ozone ) then + if ( masterproc ) then + write(iulog,*) 'ozone is prescribed in :'//trim(filename) + endif + else + return + endif + + specifier(1) = trim(ozone_name)//':'//trim(fld_name) + + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .true. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type) + + call addfld(ozone_name, (/ 'lev' /), & + 'I','mol/mol', 'prescribed ozone' ) + + end subroutine prescribed_ozone_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +subroutine prescribed_ozone_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'prescribed_ozone_readnl' + + character(len=16) :: prescribed_ozone_name + character(len=256) :: prescribed_ozone_file + character(len=256) :: prescribed_ozone_filelist + character(len=256) :: prescribed_ozone_datapath + character(len=32) :: prescribed_ozone_type + logical :: prescribed_ozone_rmfile + integer :: prescribed_ozone_cycle_yr + integer :: prescribed_ozone_fixed_ymd + integer :: prescribed_ozone_fixed_tod + + namelist /prescribed_ozone_nl/ & + prescribed_ozone_name, & + prescribed_ozone_file, & + prescribed_ozone_filelist, & + prescribed_ozone_datapath, & + prescribed_ozone_type, & + prescribed_ozone_rmfile, & + prescribed_ozone_cycle_yr, & + prescribed_ozone_fixed_ymd, & + prescribed_ozone_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + prescribed_ozone_name = fld_name + prescribed_ozone_file = filename + prescribed_ozone_filelist = filelist + prescribed_ozone_datapath = datapath + prescribed_ozone_type = data_type + prescribed_ozone_rmfile = rmv_file + prescribed_ozone_cycle_yr = cycle_yr + prescribed_ozone_fixed_ymd= fixed_ymd + prescribed_ozone_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'prescribed_ozone_nl', status=ierr) + if (ierr == 0) then + read(unitn, prescribed_ozone_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(prescribed_ozone_name, len(prescribed_ozone_name), mpichar, 0, mpicom) + call mpibcast(prescribed_ozone_file, len(prescribed_ozone_file), mpichar, 0, mpicom) + call mpibcast(prescribed_ozone_filelist, len(prescribed_ozone_filelist), mpichar, 0, mpicom) + call mpibcast(prescribed_ozone_datapath, len(prescribed_ozone_datapath), mpichar, 0, mpicom) + call mpibcast(prescribed_ozone_type, len(prescribed_ozone_type), mpichar, 0, mpicom) + call mpibcast(prescribed_ozone_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(prescribed_ozone_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(prescribed_ozone_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(prescribed_ozone_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + fld_name = prescribed_ozone_name + filename = prescribed_ozone_file + filelist = prescribed_ozone_filelist + datapath = prescribed_ozone_datapath + data_type = prescribed_ozone_type + rmv_file = prescribed_ozone_rmfile + cycle_yr = prescribed_ozone_cycle_yr + fixed_ymd = prescribed_ozone_fixed_ymd + fixed_tod = prescribed_ozone_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_prescribed_ozone = .true. + +end subroutine prescribed_ozone_readnl + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_ozone_adv( state, pbuf2d) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use cam_control_mod, only: aqua_planet + use phys_control, only : cam_physpkg_is + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz ! J/K/molecule + + use physics_buffer, only : physics_buffer_desc, pbuf_get_chunk, pbuf_get_field, pbuf_set_field + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + integer :: c,ncol + real(r8) :: to_mmr(pcols,pver) + real(r8) :: molmass + real(r8) :: amass + real(r8) :: outdata(pcols,pver) + real(r8),pointer :: tmpptr(:,:) + + character(len=32) :: units_str + + if( .not. has_prescribed_ozone ) return + + if( cam_physpkg_is('cam3') .and. aqua_planet ) then + molmass = 48._r8 + amass = 28.9644_r8 + else + molmass = 47.9981995_r8 + amass = mwdry + end if + + call advance_trcdata( fields, file, state, pbuf2d ) + + units_str = trim(to_lower(trim(fields(1)%units(:GLC(fields(1)%units))))) + + ! set the correct units and invoke history outfld +!$OMP PARALLEL DO PRIVATE (C, NCOL, OUTDATA, TO_MMR, TMPPTR, PBUF_CHNK) + do c = begchunk,endchunk + ncol = state(c)%ncol + + select case ( units_str ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_mmr(:ncol,:) = (molmass*1.e6_r8*boltz*state(c)%t(:ncol,:))/(amass*state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr') + to_mmr(:ncol,:) = 1._r8 + case ('mol/mol','mole/mole','vmr','fraction') + to_mmr(:ncol,:) = molmass/amass + case default + write(iulog,*) 'prescribed_ozone_adv: units = ',trim(fields(1)%units) ,' are not recognized' + call endrun('prescribed_ozone_adv: units are not recognized') + end select + + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + call pbuf_get_field(pbuf_chnk, fields(1)%pbuf_ndx, tmpptr ) + + tmpptr(:ncol,:) = tmpptr(:ncol,:)*to_mmr(:ncol,:) + + outdata(:ncol,:) = (amass/molmass)* tmpptr(:ncol,:) ! vmr + call outfld( fields(1)%fldnam, outdata(:ncol,:), ncol, state(c)%lchnk ) + enddo + + end subroutine prescribed_ozone_adv + +!------------------------------------------------------------------- + + subroutine init_prescribed_ozone_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'prescribed_ozone', piofile, file ) + + end subroutine init_prescribed_ozone_restart +!------------------------------------------------------------------- + subroutine write_prescribed_ozone_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_prescribed_ozone_restart + +!------------------------------------------------------------------- + subroutine read_prescribed_ozone_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call read_trc_restart( 'prescribed_ozone', piofile, file ) + + end subroutine read_prescribed_ozone_restart + +end module prescribed_ozone diff --git a/src/chemistry/utils/prescribed_strataero.F90 b/src/chemistry/utils/prescribed_strataero.F90 new file mode 100644 index 0000000000..658fc6df62 --- /dev/null +++ b/src/chemistry/utils/prescribed_strataero.F90 @@ -0,0 +1,507 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of prescribed stratospheric aerosols +! Created by: Francis Vitt +!------------------------------------------------------------------- +module prescribed_strataero + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: prescribed_strataero_readnl + public :: prescribed_strataero_register + public :: prescribed_strataero_init + public :: prescribed_strataero_adv + public :: write_prescribed_strataero_restart + public :: read_prescribed_strataero_restart + public :: has_prescribed_strataero + public :: init_prescribed_strataero_restart + + logical :: has_prescribed_strataero = .false. + character(len=16), parameter :: mmr_name = 'VOLC_MMR' + character(len=16), parameter :: rad_name = 'VOLC_RAD_GEOM' + character(len=16), parameter :: sad_name = 'VOLC_SAD' + character(len=16), parameter :: mass_name = 'VOLC_MASS' + character(len=16), parameter :: mass_column_name = 'VOLC_MASS_C' + character(len=16), parameter :: dens_name = 'VOLC_DENS' + + character(len=16), parameter :: mmr_name1 = 'VOLC_MMR1' + character(len=16), parameter :: mmr_name2 = 'VOLC_MMR2' + character(len=16), parameter :: mmr_name3 = 'VOLC_MMR3' + character(len=16), parameter :: rad_name1 = 'VOLC_RAD_GEOM1' + character(len=16), parameter :: rad_name2 = 'VOLC_RAD_GEOM2' + character(len=16), parameter :: rad_name3 = 'VOLC_RAD_GEOM3' + character(len=16), parameter :: mass_name1 = 'VOLC_MASS1' + character(len=16), parameter :: mass_name2 = 'VOLC_MASS2' + character(len=16), parameter :: mass_name3 = 'VOLC_MASS3' + character(len=16), parameter :: mass_column_name1 = 'VOLC_MASS_C1' + character(len=16), parameter :: mass_column_name2 = 'VOLC_MASS_C2' + character(len=16), parameter :: mass_column_name3 = 'VOLC_MASS_C3' + character(len=16), parameter :: dens_name1 = 'VOLC_DENS1' + character(len=16), parameter :: dens_name2 = 'VOLC_DENS2' + character(len=16), parameter :: dens_name3 = 'VOLC_DENS3' + + ! These variables are settable via the namelist (with longer names) + character(len=32) :: specifier(7) = ' ' + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: data_type = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + integer :: rad_ndx1 = -1 + integer :: rad_ndx2 = -1 + integer :: rad_ndx3 = -1 + integer :: sad_ndx = -1 + integer :: mmr_ndx1 = -1 + integer :: mmr_ndx2 = -1 + integer :: mmr_ndx3 = -1 + + logical :: prescribed_strataero_use_chemtrop = .false. + logical :: three_mode = .true. + integer :: rad_fld_no=-1, sad_fld_no=-1 + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +subroutine prescribed_strataero_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'prescribed_strataero_readnl' + + character(len=32) :: prescribed_strataero_specifier(7) + character(len=256) :: prescribed_strataero_file + character(len=256) :: prescribed_strataero_filelist + character(len=256) :: prescribed_strataero_datapath + character(len=32) :: prescribed_strataero_type + logical :: prescribed_strataero_rmfile + integer :: prescribed_strataero_cycle_yr + integer :: prescribed_strataero_fixed_ymd + integer :: prescribed_strataero_fixed_tod + + namelist /prescribed_strataero_nl/ & + prescribed_strataero_specifier, & + prescribed_strataero_file, & + prescribed_strataero_filelist, & + prescribed_strataero_datapath, & + prescribed_strataero_type, & + prescribed_strataero_rmfile, & + prescribed_strataero_cycle_yr, & + prescribed_strataero_fixed_ymd, & + prescribed_strataero_fixed_tod, & + prescribed_strataero_use_chemtrop + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + prescribed_strataero_specifier= specifier + prescribed_strataero_file = filename + prescribed_strataero_filelist = filelist + prescribed_strataero_datapath = datapath + prescribed_strataero_type = data_type + prescribed_strataero_rmfile = rmv_file + prescribed_strataero_cycle_yr = cycle_yr + prescribed_strataero_fixed_ymd= fixed_ymd + prescribed_strataero_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'prescribed_strataero_nl', status=ierr) + if (ierr == 0) then + read(unitn, prescribed_strataero_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(prescribed_strataero_specifier,len(prescribed_strataero_specifier)*7, mpichar, 0, mpicom) + call mpibcast(prescribed_strataero_file, len(prescribed_strataero_file), mpichar, 0, mpicom) + call mpibcast(prescribed_strataero_filelist, len(prescribed_strataero_filelist), mpichar, 0, mpicom) + call mpibcast(prescribed_strataero_datapath, len(prescribed_strataero_datapath), mpichar, 0, mpicom) + call mpibcast(prescribed_strataero_type, len(prescribed_strataero_type), mpichar, 0, mpicom) + call mpibcast(prescribed_strataero_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(prescribed_strataero_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(prescribed_strataero_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(prescribed_strataero_fixed_tod,1, mpiint, 0, mpicom) + call mpibcast(prescribed_strataero_use_chemtrop, 1, mpilog, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier(:) = prescribed_strataero_specifier(:) + filename = prescribed_strataero_file + filelist = prescribed_strataero_filelist + datapath = prescribed_strataero_datapath + data_type = prescribed_strataero_type + rmv_file = prescribed_strataero_rmfile + cycle_yr = prescribed_strataero_cycle_yr + fixed_ymd = prescribed_strataero_fixed_ymd + fixed_tod = prescribed_strataero_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_prescribed_strataero = .true. + +end subroutine prescribed_strataero_readnl + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_strataero_register() + use ppgrid, only: pver,pcols + use physics_buffer, only: pbuf_add_field, dtype_r8 + use pio, only: var_desc_t, file_desc_t, pio_closefile, pio_inq_varid, pio_seterrorhandling, & + PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR + use cam_pio_utils, only: cam_pio_openfile + use ioFileMod, only : getfil + + type(var_desc_t) :: varid + type(file_desc_t) :: file_handle + character(len=256) :: filepath, filen + integer :: ierr + + if (has_prescribed_strataero) then + + filepath = trim(datapath)//'/'//trim(filename) + + call getfil( filepath, filen, 0 ) + call cam_pio_openfile( file_handle, filen, 0 ) + + call pio_seterrorhandling(file_handle, PIO_BCAST_ERROR) + + ierr = pio_inq_varid( file_handle, 'so4mass_a1', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + ierr = pio_inq_varid( file_handle, 'so4mass_a2', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + ierr = pio_inq_varid( file_handle, 'so4mass_a3', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + ierr = pio_inq_varid( file_handle, 'diamwet_a1', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + ierr = pio_inq_varid( file_handle, 'diamwet_a2', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + ierr = pio_inq_varid( file_handle, 'diamwet_a3', varid ) + three_mode = three_mode .and. (ierr.eq.PIO_NOERR) + + call pio_seterrorhandling(file_handle, PIO_INTERNAL_ERROR) + + call pio_closefile( file_handle ) + + if (three_mode) then + call pbuf_add_field(mmr_name1, 'physpkg', dtype_r8,(/pcols,pver/), mmr_ndx1) + call pbuf_add_field(mmr_name2, 'physpkg', dtype_r8,(/pcols,pver/), mmr_ndx2) + call pbuf_add_field(mmr_name3, 'physpkg', dtype_r8,(/pcols,pver/), mmr_ndx3) + call pbuf_add_field(rad_name1, 'physpkg', dtype_r8,(/pcols,pver/), rad_ndx1) + call pbuf_add_field(rad_name2, 'physpkg', dtype_r8,(/pcols,pver/), rad_ndx2) + call pbuf_add_field(rad_name3, 'physpkg', dtype_r8,(/pcols,pver/), rad_ndx3) + call pbuf_add_field(sad_name, 'physpkg', dtype_r8,(/pcols,pver/), sad_ndx) + specifier(1:7) = (/'VOLC_MMR1:so4mass_a1 ', & + 'VOLC_MMR2:so4mass_a2 ', & + 'VOLC_MMR3:so4mass_a3 ', & + 'VOLC_RAD_GEOM1:diamwet_a1 ', & + 'VOLC_RAD_GEOM2:diamwet_a2 ', & + 'VOLC_RAD_GEOM3:diamwet_a3 ', & + 'VOLC_SAD:SAD_AERO ' /) + rad_fld_no = 4 + sad_fld_no = 7 + else + if (masterproc) then + write(iulog, *) ' pbuf add mmr_name = '//trim(mmr_name) + end if + call pbuf_add_field(mmr_name, 'physpkg', dtype_r8,(/pcols,pver/), mmr_ndx1) + call pbuf_add_field(rad_name, 'physpkg', dtype_r8,(/pcols,pver/), rad_ndx1) + call pbuf_add_field(sad_name, 'physpkg', dtype_r8,(/pcols,pver/), sad_ndx) + specifier(1:3) = (/'VOLC_MMR:H2SO4_mass ', & + 'VOLC_RAD_GEOM:rmode ', & + 'VOLC_SAD:sad ' /) + rad_fld_no = 2 + sad_fld_no = 3 + endif + endif + + endsubroutine prescribed_strataero_register + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_strataero_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld, horiz_only + use error_messages, only: handle_err + + if ( has_prescribed_strataero ) then + if ( masterproc ) then + write(iulog,*) 'stratospheric aerosol is prescribed in :'//trim(filename) + endif + else + return + endif + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .true. + file%geop_alt = .true. + + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type) + + if (three_mode) then + call addfld(dens_name1, (/ 'lev' /), 'I','molecules/cm3', 'prescribed volcanic aerosol number density in Mode 1' ) + call addfld(dens_name2, (/ 'lev' /), 'I','molecules/cm3', 'prescribed volcanic aerosol number density in Mode 2' ) + call addfld(dens_name3, (/ 'lev' /), 'I','molecules/cm3', 'prescribed volcanic aerosol number density in Mode 3' ) + call addfld(mmr_name1, (/ 'lev' /), 'I','kg/kg', 'prescribed volcanic aerosol dry mass mixing ratio in Mode 1' ) + call addfld(mmr_name2, (/ 'lev' /), 'I','kg/kg', 'prescribed volcanic aerosol dry mass mixing ratio in Mode 2' ) + call addfld(mmr_name3, (/ 'lev' /), 'I','kg/kg', 'prescribed volcanic aerosol dry mass mixing ratio in Mode 3' ) + call addfld(rad_name1, (/ 'lev' /), 'I','m', 'volcanic aerosol geometric-mode radius in Mode 1' ) + call addfld(rad_name2, (/ 'lev' /), 'I','m', 'volcanic aerosol geometric-mode radius in Mode 2' ) + call addfld(rad_name3, (/ 'lev' /), 'I','m', 'volcanic aerosol geometric-mode radius in Mode 3' ) + call addfld(mass_name1, (/ 'lev' /), 'I','kg/m^2', 'volcanic aerosol vertical mass path in layer in Mode 1' ) + call addfld(mass_name2, (/ 'lev' /), 'I','kg/m^2', 'volcanic aerosol vertical mass path in layer in Mode 2' ) + call addfld(mass_name3, (/ 'lev' /), 'I','kg/m^2', 'volcanic aerosol vertical mass path in layer in Mode 3' ) + call addfld(mass_column_name1, horiz_only, 'I','kg/m^2', 'volcanic aerosol column mass in Mode 1' ) + call addfld(mass_column_name2, horiz_only, 'I','kg/m^2', 'volcanic aerosol column mass in Mode 2' ) + call addfld(mass_column_name3, horiz_only, 'I','kg/m^2', 'volcanic aerosol column mass IN Mode 3' ) + else + call addfld(dens_name, (/ 'lev' /), 'I','molecules/cm3', 'prescribed volcanic aerosol number density' ) + call addfld(mmr_name, (/ 'lev' /), 'I','kg/kg', 'prescribed volcanic aerosol dry mass mixing ratio' ) + call addfld(rad_name, (/ 'lev' /), 'I','m', 'volcanic aerosol geometric-mode radius' ) + call addfld(mass_name, (/ 'lev' /), 'I','kg/m^2', 'volcanic aerosol vertical mass path in layer' ) + call addfld(mass_column_name, horiz_only, 'I','kg/m^2', 'volcanic aerosol column mass' ) + endif + call addfld(sad_name, (/ 'lev' /), 'I','cm2/cm3', 'stratospheric aerosol surface area density' ) + + end subroutine prescribed_strataero_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_strataero_adv( state, pbuf2d) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz, gravit ! J/K/molecule + use tropopause, only : tropopause_findChemTrop + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use physconst, only : pi + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + integer :: c,ncol,i,k + real(r8) :: to_mmr(pcols,pver) + real(r8), parameter :: molmass = 4._r8/3._r8*98.0_r8 !convert dry mass to wet mass of h2so4 + real(r8) :: volcmass1(pcols,pver) + real(r8) :: volcmass2(pcols,pver) + real(r8) :: volcmass3(pcols,pver) + real(r8) :: columnmass1(pcols) + real(r8) :: columnmass2(pcols) + real(r8) :: columnmass3(pcols) + integer :: tropLev(pcols) + real(r8) :: area_fact, radius_fact + + real(r8), pointer :: mass1(:,:) + real(r8), pointer :: mass2(:,:) + real(r8), pointer :: mass3(:,:) + real(r8), pointer :: area(:,:) + real(r8), pointer :: radius1(:,:) + real(r8), pointer :: radius2(:,:) + real(r8), pointer :: radius3(:,:) + + !WACCM-derived relation between mass concentration and wet aerosol radius in meters + real(r8),parameter :: radius_conversion = 1.9e-4_r8 + + logical :: zero_aerosols + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + + if( .not. has_prescribed_strataero ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! copy prescribed tracer fields into state svariable with the correct units + do c = begchunk,endchunk + + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + + ncol = state(c)%ncol + + select case ( to_lower(trim(fields(1)%units(:GLC(fields(1)%units)))) ) + case ("molecules/cm3air", "molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_mmr(:ncol,:) = (molmass*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr','kg kg-1') + to_mmr(:ncol,:) = 1._r8 ! input file must have converted to wet sulfate mass (=4/3*dry mass) + case ('mol/mol','mole/mole','vmr','fraction') + to_mmr(:ncol,:) = molmass/mwdry + case default + write(iulog,*) 'prescribed_strataero_adv: mass units = ',trim(fields(1)%units) ,' are not recognized' + call endrun('prescribed_strataero_adv: mass units are not recognized') + end select + + if (mmr_ndx1>0) call pbuf_get_field(pbuf_chnk, mmr_ndx1, mass1) + if (mmr_ndx2>0) call pbuf_get_field(pbuf_chnk, mmr_ndx2, mass2) + if (mmr_ndx3>0) call pbuf_get_field(pbuf_chnk, mmr_ndx3, mass3) + + if (three_mode) then + call outfld( dens_name1, mass1(:,:), pcols, state(c)%lchnk) + call outfld( dens_name2, mass2(:,:), pcols, state(c)%lchnk) + call outfld( dens_name3, mass3(:,:), pcols, state(c)%lchnk) + else + call outfld( dens_name, mass1(:,:), pcols, state(c)%lchnk) + endif + + if (mmr_ndx1>0) mass1(:ncol,:) = to_mmr(:ncol,:) * mass1(:ncol,:) ! mmr + if (mmr_ndx2>0) mass2(:ncol,:) = to_mmr(:ncol,:) * mass2(:ncol,:) ! mmr + if (mmr_ndx3>0) mass3(:ncol,:) = to_mmr(:ncol,:) * mass3(:ncol,:) ! mmr + + if (rad_ndx1>0) call pbuf_get_field(pbuf_chnk, rad_ndx1, radius1) + if (rad_ndx2>0) call pbuf_get_field(pbuf_chnk, rad_ndx2, radius2) + if (rad_ndx3>0) call pbuf_get_field(pbuf_chnk, rad_ndx3, radius3) + + select case ( to_lower(trim(fields(rad_fld_no)%units(:GLC(fields(rad_fld_no)%units)))) ) + case ("m","meters") + radius_fact = 1._r8 + case ("cm","centimeters") + radius_fact = 1.e-2_r8 + case default + write(iulog,*) 'prescribed_strataero_adv: radius units = ',trim(fields(rad_fld_no)%units) ,' are not recognized' + call endrun('prescribed_strataero_adv: radius units are not recognized') + end select + + !MAM output is diamter so we need to half the value + if (three_mode) then + radius1(:ncol,:) = radius_fact*radius1(:ncol,:)*0.5_r8 + radius2(:ncol,:) = radius_fact*radius2(:ncol,:)*0.5_r8 + radius3(:ncol,:) = radius_fact*radius3(:ncol,:)*0.5_r8 + else + radius1(:ncol,:) = radius_fact*radius1(:ncol,:) + endif + + call pbuf_get_field(pbuf_chnk, sad_ndx, area) + + select case ( to_lower(trim(fields(sad_fld_no)%units(:7))) ) + case ("um2/cm3") + area_fact = 1.e-8_r8 + case ("cm2/cm3") + area_fact = 1._r8 + case default + write(iulog,*) 'prescribed_strataero_adv: surface area density units = ',& + trim(fields(rad_fld_no)%units) ,' are not recognized' + call endrun('prescribed_strataero_adv: surface area density units are not recognized') + end select + area(:ncol,:) = area_fact*area(:ncol,:) + + ! this definition of tropopause is consistent with what is used in chemistry + call tropopause_findChemTrop(state(c), tropLev) + + do i = 1,ncol + do k = 1,pver + zero_aerosols = k >= tropLev(i) + if ( .not.prescribed_strataero_use_chemtrop .and. abs( state(c)%lat(i)*rad2deg ) > 50._r8 ) then + zero_aerosols = state(c)%pmid(i,k) >= 30000._r8 + endif + ! set to zero at and below tropopause + if ( zero_aerosols ) then + if (mmr_ndx1>0) mass1(i,k) = 0._r8 + if (mmr_ndx2>0) mass2(i,k) = 0._r8 + if (mmr_ndx3>0) mass3(i,k) = 0._r8 + if (rad_ndx1>0) radius1(i,k) = 0._r8 + if (rad_ndx2>0) radius2(i,k) = 0._r8 + if (rad_ndx3>0) radius3(i,k) = 0._r8 + area(i,k) = 0._r8 + endif + enddo + enddo + + volcmass1(:ncol,:) = mass1(:ncol,:)*state(c)%pdel(:ncol,:)/gravit + columnmass1(:ncol) = sum(volcmass1(:ncol,:), 2) + + if (three_mode) then + volcmass2(:ncol,:) = mass2(:ncol,:)*state(c)%pdel(:ncol,:)/gravit + volcmass3(:ncol,:) = mass3(:ncol,:)*state(c)%pdel(:ncol,:)/gravit + columnmass2(:ncol) = sum(volcmass2(:ncol,:), 2) + columnmass3(:ncol) = sum(volcmass3(:ncol,:), 2) + call outfld( mmr_name1, mass1(:,:), pcols, state(c)%lchnk) + call outfld( mmr_name2, mass2(:,:), pcols, state(c)%lchnk) + call outfld( mmr_name3, mass3(:,:), pcols, state(c)%lchnk) + call outfld( mass_name1, volcmass1(:,:), pcols, state(c)%lchnk) + call outfld( mass_name2, volcmass2(:,:), pcols, state(c)%lchnk) + call outfld( mass_name3, volcmass3(:,:), pcols, state(c)%lchnk) + call outfld( mass_column_name1, columnmass1(:), pcols, state(c)%lchnk) + call outfld( mass_column_name2, columnmass2(:), pcols, state(c)%lchnk) + call outfld( mass_column_name3, columnmass3(:), pcols, state(c)%lchnk) + call outfld( rad_name1, radius1(:,:), pcols, state(c)%lchnk) + call outfld( rad_name2, radius2(:,:), pcols, state(c)%lchnk) + call outfld( rad_name3, radius3(:,:), pcols, state(c)%lchnk) + else + call outfld( mmr_name, mass1(:,:), pcols, state(c)%lchnk) + call outfld( mass_name, volcmass1(:,:), pcols, state(c)%lchnk) + call outfld( mass_column_name, columnmass1(:), pcols, state(c)%lchnk) + call outfld( rad_name, radius1(:,:), pcols, state(c)%lchnk) + endif + + call outfld( sad_name, area(:,:), pcols, state(c)%lchnk) + + enddo + + end subroutine prescribed_strataero_adv + +!------------------------------------------------------------------- + subroutine init_prescribed_strataero_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'prescribed_strataero', piofile, file ) + + end subroutine init_prescribed_strataero_restart +!------------------------------------------------------------------- + subroutine write_prescribed_strataero_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_prescribed_strataero_restart +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine read_prescribed_strataero_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + + type(file_desc_t) :: piofile + + call read_trc_restart( 'prescribed_strataero', piofile, file ) + + end subroutine read_prescribed_strataero_restart + +end module prescribed_strataero diff --git a/src/chemistry/utils/prescribed_volcaero.F90 b/src/chemistry/utils/prescribed_volcaero.F90 new file mode 100644 index 0000000000..092310a7b9 --- /dev/null +++ b/src/chemistry/utils/prescribed_volcaero.F90 @@ -0,0 +1,324 @@ +!------------------------------------------------------------------- +! manages reading and interpolation of prescribed volcanic aerosol +! Created by: Francis Vitt +!------------------------------------------------------------------- +module prescribed_volcaero + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use spmd_utils, only : masterproc + use tracer_data, only : trfld, trfile + use cam_logfile, only : iulog + + implicit none + private + save + + type(trfld), pointer :: fields(:) + type(trfile) :: file + + public :: prescribed_volcaero_readnl + public :: prescribed_volcaero_register + public :: prescribed_volcaero_init + public :: prescribed_volcaero_adv + public :: write_prescribed_volcaero_restart + public :: read_prescribed_volcaero_restart + public :: has_prescribed_volcaero + public :: init_prescribed_volcaero_restart + + + logical :: has_prescribed_volcaero = .false. + character(len=8), parameter :: volcaero_name = 'VOLC_MMR' + character(len=13), parameter :: volcrad_name = 'VOLC_RAD_GEOM' + character(len=9), parameter :: volcmass_name = 'VOLC_MASS' + character(len=11), parameter :: volcmass_column_name = 'VOLC_MASS_C' + + ! These variables are settable via the namelist (with longer names) + character(len=16) :: fld_name = 'MMRVOLC' + character(len=256) :: filename = 'NONE' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: data_type = 'SERIAL' + logical :: rmv_file = .false. + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + integer :: radius_ndx + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +subroutine prescribed_volcaero_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'prescribed_volcaero_readnl' + + character(len=16) :: prescribed_volcaero_name + character(len=256) :: prescribed_volcaero_file + character(len=256) :: prescribed_volcaero_filelist + character(len=256) :: prescribed_volcaero_datapath + character(len=32) :: prescribed_volcaero_type + logical :: prescribed_volcaero_rmfile + integer :: prescribed_volcaero_cycle_yr + integer :: prescribed_volcaero_fixed_ymd + integer :: prescribed_volcaero_fixed_tod + + namelist /prescribed_volcaero_nl/ & + prescribed_volcaero_name, & + prescribed_volcaero_file, & + prescribed_volcaero_filelist, & + prescribed_volcaero_datapath, & + prescribed_volcaero_type, & + prescribed_volcaero_rmfile, & + prescribed_volcaero_cycle_yr, & + prescribed_volcaero_fixed_ymd, & + prescribed_volcaero_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + prescribed_volcaero_name = fld_name + prescribed_volcaero_file = filename + prescribed_volcaero_filelist = filelist + prescribed_volcaero_datapath = datapath + prescribed_volcaero_type = data_type + prescribed_volcaero_rmfile = rmv_file + prescribed_volcaero_cycle_yr = cycle_yr + prescribed_volcaero_fixed_ymd= fixed_ymd + prescribed_volcaero_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'prescribed_volcaero_nl', status=ierr) + if (ierr == 0) then + read(unitn, prescribed_volcaero_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(prescribed_volcaero_name, len(prescribed_volcaero_name), mpichar, 0, mpicom) + call mpibcast(prescribed_volcaero_file, len(prescribed_volcaero_file), mpichar, 0, mpicom) + call mpibcast(prescribed_volcaero_filelist, len(prescribed_volcaero_filelist), mpichar, 0, mpicom) + call mpibcast(prescribed_volcaero_datapath, len(prescribed_volcaero_datapath), mpichar, 0, mpicom) + call mpibcast(prescribed_volcaero_type, len(prescribed_volcaero_type), mpichar, 0, mpicom) + call mpibcast(prescribed_volcaero_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(prescribed_volcaero_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(prescribed_volcaero_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(prescribed_volcaero_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + fld_name = prescribed_volcaero_name + filename = prescribed_volcaero_file + filelist = prescribed_volcaero_filelist + datapath = prescribed_volcaero_datapath + data_type = prescribed_volcaero_type + rmv_file = prescribed_volcaero_rmfile + cycle_yr = prescribed_volcaero_cycle_yr + fixed_ymd = prescribed_volcaero_fixed_ymd + fixed_tod = prescribed_volcaero_fixed_tod + + ! Turn on prescribed volcanics if user has specified an input dataset. + if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_prescribed_volcaero = .true. + +end subroutine prescribed_volcaero_readnl + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_volcaero_register() + use ppgrid, only: pver,pcols + use physics_buffer, only : pbuf_add_field, dtype_r8 + + integer :: idx + + if (has_prescribed_volcaero) then + call pbuf_add_field(volcaero_name,'physpkg',dtype_r8,(/pcols,pver/),idx) + call pbuf_add_field(volcrad_name, 'physpkg',dtype_r8,(/pcols,pver/),idx) + + endif + + endsubroutine prescribed_volcaero_register + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_volcaero_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld, horiz_only + use physics_buffer, only : pbuf_get_index + + implicit none + + integer :: ndx, istat + integer :: errcode + character(len=32) :: specifier(1) + + if ( has_prescribed_volcaero ) then + if ( masterproc ) then + write(iulog,*) 'volcanic aerosol is prescribed in :'//trim(filename) + endif + else + return + endif + + specifier(1) = trim(volcaero_name)//':'//trim(fld_name) + + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .true. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type) + + + call addfld(volcaero_name, (/ 'lev' /), 'I','kg/kg', 'prescribed volcanic aerosol dry mass mixing ratio' ) + call addfld(volcrad_name, (/ 'lev' /), 'I','m', 'volcanic aerosol geometric-mean radius' ) + call addfld(volcmass_name, (/ 'lev' /), 'I','kg/m^2', 'volcanic aerosol vertical mass path in layer' ) + call addfld(volcmass_column_name, horiz_only, 'I','kg/m^2', 'volcanic aerosol column mass' ) + + radius_ndx = pbuf_get_index(volcrad_name, errcode) + + end subroutine prescribed_volcaero_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine prescribed_volcaero_adv( state, pbuf2d) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use ppgrid, only : pcols, pver + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz, gravit ! J/K/molecule + use tropopause, only : tropopause_find, TROP_ALG_TWMO, TROP_ALG_CLIMATE + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + integer :: c,ncol,i,k + real(r8) :: to_mmr(pcols,pver) + real(r8), parameter :: molmass = 47.9981995_r8 + real(r8) :: ptrop + real(r8) :: concvolc ! micrograms of wetted aerosol per cubic centimeter + real(r8) :: volcmass(pcols,pver) + real(r8) :: columnmass(pcols) + real(r8) :: mmrvolc + integer :: tropLev(pcols) + + real(r8) :: outdata(pcols,pver) + real(r8), pointer :: data(:,:) + real(r8), pointer :: radius(:,:) + + !WACCM-derived relation between mass concentration and wet aerosol radius in meters + real(r8),parameter :: radius_conversion = 1.9e-4_r8 + + if( .not. has_prescribed_volcaero ) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! copy prescribed tracer fields into state svariable with the correct units + do c = begchunk,endchunk + pbuf_chnk => pbuf_get_chunk(pbuf2d, c) + call pbuf_get_field(pbuf_chnk, radius_ndx, radius) + radius(:,:) = 0._r8 + ncol = state(c)%ncol + select case ( to_lower(trim(fields(1)%units(:GLC(fields(1)%units)))) ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_mmr(:ncol,:) = (molmass*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr','kg kg-1') + to_mmr(:ncol,:) = 1._r8 + case ('mol/mol','mole/mole','vmr','fraction') + to_mmr(:ncol,:) = molmass/mwdry + case default + write(iulog,*) 'prescribed_volcaero_adv: units = ',trim(fields(1)%units) ,' are not recognized' + call endrun('prescribed_volcaero_adv: units are not recognized') + end select + + call pbuf_get_field(pbuf_chnk, fields(1)%pbuf_ndx, data) + data(:ncol,:) = to_mmr(:ncol,:) * data(:ncol,:) ! mmr + + call tropopause_find(state(c), tropLev, primary=TROP_ALG_TWMO, backup=TROP_ALG_CLIMATE) + do i = 1,ncol + do k = 1,pver + ! set to zero below tropopause + if ( k >= tropLev(i) ) then + data(i,k) = 0._r8 + endif + mmrvolc = data(i,k) + if (mmrvolc > 0._r8) then + concvolc = (mmrvolc * state(c)%pdel(i,k))/(gravit * state(c)%zm(i,k)) + radius(i,k) = radius_conversion*(concvolc**(1._r8/3._r8)) + endif + enddo + enddo + + volcmass(:ncol,:) = data(:ncol,:)*state(c)%pdel(:ncol,:)/gravit + columnmass(:ncol) = sum(volcmass(:ncol,:), 2) + + call outfld( volcaero_name, data(:,:), pcols, state(c)%lchnk) + call outfld( volcrad_name, radius(:,:), pcols, state(c)%lchnk) + call outfld( volcmass_name, volcmass(:,:), pcols, state(c)%lchnk) + call outfld( volcmass_column_name, columnmass(:), pcols, state(c)%lchnk) + + enddo + + end subroutine prescribed_volcaero_adv + +!------------------------------------------------------------------- + subroutine init_prescribed_volcaero_restart( piofile ) + use pio, only : file_desc_t + use tracer_data, only : init_trc_restart + implicit none + type(file_desc_t),intent(inout) :: pioFile ! pio File pointer + + call init_trc_restart( 'prescribed_volcaero', piofile, file ) + + end subroutine init_prescribed_volcaero_restart +!------------------------------------------------------------------- + subroutine write_prescribed_volcaero_restart( piofile ) + use tracer_data, only : write_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call write_trc_restart( piofile, file ) + + end subroutine write_prescribed_volcaero_restart +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine read_prescribed_volcaero_restart( pioFile ) + use tracer_data, only : read_trc_restart + use pio, only : file_desc_t + implicit none + + type(file_desc_t) :: piofile + + call read_trc_restart( 'prescribed_volcaero', piofile, file ) + + end subroutine read_prescribed_volcaero_restart + +end module prescribed_volcaero diff --git a/src/chemistry/utils/solar_data.F90 b/src/chemistry/utils/solar_data.F90 new file mode 100644 index 0000000000..51b2e2fb1d --- /dev/null +++ b/src/chemistry/utils/solar_data.F90 @@ -0,0 +1,134 @@ +module solar_data + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: shr_kind_cl + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use phys_control, only: use_simple_phys + + implicit none + + save + private + public :: solar_data_readnl + public :: solar_data_init + public :: solar_data_advance + + character(len=shr_kind_cl) :: solar_irrad_data_file = 'NONE' + character(len=shr_kind_cl) :: solar_parms_data_file = 'NONE' + character(len=shr_kind_cl) :: solar_euv_data_file = 'NONE' + character(len=shr_kind_cl) :: solar_wind_data_file = 'NONE' + + character(len=8) :: solar_data_type = 'SERIAL' ! "FIXED" or "SERIAL" + integer :: solar_data_ymd = -99999999 ! YYYYMMDD for "FIXED" type + integer :: solar_data_tod = 0 ! seconds of day for "FIXED" type + real(r8) :: solar_const = -9999._r8 ! constant TSI (W/m2) + logical :: solar_htng_spctrl_scl = .false. ! do rad heating spectral scaling + + contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine solar_data_readnl( nlfile ) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_integer, mpi_logical, mpi_real8 + use solar_parms_data,only: solar_parms_on + + ! arguments + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + integer :: unitn, ierr + + namelist /solar_data_opts/ & + solar_irrad_data_file, solar_parms_data_file, solar_euv_data_file, solar_wind_data_file, & + solar_data_type, solar_data_ymd, solar_data_tod, solar_const, solar_htng_spctrl_scl + + if (use_simple_phys) return + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'solar_data_opts', status=ierr) + if (ierr == 0) then + read(unitn, solar_data_opts, iostat=ierr) + if (ierr /= 0) then + call endrun('solar_data_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! broadcast the options to all MPI tasks + call mpi_bcast(solar_irrad_data_file, len(solar_irrad_data_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(solar_parms_data_file, len(solar_parms_data_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(solar_euv_data_file, len(solar_euv_data_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(solar_wind_data_file, len(solar_wind_data_file), mpi_character, masterprocid, mpicom, ierr) + + call mpi_bcast(solar_data_type, len(solar_data_type), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(solar_data_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(solar_data_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(solar_const, 1, mpi_real8 , masterprocid, mpicom, ierr) + call mpi_bcast(solar_htng_spctrl_scl,1, mpi_logical, masterprocid, mpicom, ierr) + + if ( (solar_irrad_data_file.ne.'NONE') .and. (solar_const>0._r8) ) then + call endrun('solar_data_readnl: ERROR cannot specify both solar_irrad_data_file and solar_const') + endif + + if ( (solar_data_ymd>0 .or. solar_data_tod>0) .and. trim(solar_data_type)=='SERIAL' ) then + call endrun('solar_data_readnl: ERROR cannot set solar_data_ymd or solar_data_tod with solar_data_type=SERIAL') + endif + + if (masterproc) then + write(iulog,*) 'solar_data_readnl: solar_const (W/m2) = ', solar_const + write(iulog,*) 'solar_data_readnl: solar_irrad_data_file = ',trim(solar_irrad_data_file) + write(iulog,*) 'solar_data_readnl: solar_parms_data_file = ',trim(solar_parms_data_file) + write(iulog,*) 'solar_data_readnl: solar_euv_data_file = ',trim(solar_euv_data_file) + write(iulog,*) 'solar_data_readnl: solar_wind_data_file = ',trim(solar_wind_data_file) + write(iulog,*) 'solar_data_readnl: solar_data_type = ',trim(solar_data_type) + write(iulog,*) 'solar_data_readnl: solar_data_ymd = ',solar_data_ymd + write(iulog,*) 'solar_data_readnl: solar_data_tod = ',solar_data_tod + endif + + solar_parms_on = solar_parms_data_file.ne.'NONE' + + end subroutine solar_data_readnl + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine solar_data_init() + use solar_irrad_data, only: solar_irrad_init + use solar_parms_data, only: solar_parms_init + use solar_wind_data, only: solar_wind_init + use solar_euv_data, only: solar_euv_init + + logical :: fixed_solar + fixed_solar = trim(solar_data_type) == 'FIXED' + + call solar_irrad_init( solar_irrad_data_file, fixed_solar, solar_data_ymd, solar_data_tod, & + solar_const, solar_htng_spctrl_scl ) + call solar_parms_init( solar_parms_data_file, fixed_solar, solar_data_ymd, solar_data_tod ) + call solar_wind_init( solar_wind_data_file, fixed_solar, solar_data_ymd, solar_data_tod ) + call solar_euv_init( solar_euv_data_file, fixed_solar, solar_data_ymd, solar_data_tod ) + + end subroutine solar_data_init + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine solar_data_advance() + + use solar_irrad_data, only: solar_irrad_advance + use solar_parms_data, only: solar_parms_advance + use solar_wind_data, only: solar_wind_advance + use solar_euv_data, only: solar_euv_advance + + call solar_irrad_advance() + call solar_parms_advance() + call solar_wind_advance() + call solar_euv_advance() + + end subroutine solar_data_advance + +end module solar_data diff --git a/src/chemistry/utils/solar_euv_data.F90 b/src/chemistry/utils/solar_euv_data.F90 new file mode 100644 index 0000000000..26c3b171fb --- /dev/null +++ b/src/chemistry/utils/solar_euv_data.F90 @@ -0,0 +1,158 @@ +!----------------------------------------------------------------------- +! Solar EUV irradiance data +!----------------------------------------------------------------------- +module solar_euv_data + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_pio_utils, only: cam_pio_openfile + use cam_logfile, only: iulog + use pio, only: pio_get_var, pio_inq_varid, pio_inq_dimid, pio_inq_dimlen, & + file_desc_t + use input_data_utils, only : time_coordinate + + implicit none + + save + private + public :: solar_euv_init + public :: solar_euv_advance + public :: solar_euv_data_etf + public :: solar_euv_data_active + + real(r8), target, allocatable :: solar_euv_data_etf(:) + logical, protected :: solar_euv_data_active = .false. + + integer :: nbins + real(r8), allocatable :: irradi(:,:) + + type(file_desc_t) :: file_id + integer :: ssi_vid + + logical :: initialized = .false. + + real(r8), allocatable :: dellam(:) + real(r8), allocatable :: lambda(:) + real(r8), allocatable :: we(:) + + integer, parameter :: nrecords = 2 + logical, parameter :: debug = .false. + + type(time_coordinate) :: time_coord + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine solar_euv_init(filepath, fixed, fixed_ymd, fixed_tod) + + use ioFileMod, only : getfil + + ! arguments + character(len=*), intent(in) :: filepath + logical, intent(in) :: fixed + integer, intent(in) :: fixed_ymd + integer, intent(in) :: fixed_tod + + ! local variables + integer :: astat, dimid, vid + character(len=256) :: filen + + integer :: ierr + + solar_euv_data_active = (filepath.ne.'NONE') + if ( .not.solar_euv_data_active ) return + + call time_coord%initialize( filepath, fixed=fixed, fixed_ymd=fixed_ymd, fixed_tod=fixed_tod ) + + call getfil( filepath, filen, 0 ) + call cam_pio_openfile( file_id, filen, 0 ) + + if(masterproc) write(iulog,*)'solar_euv_data_init: data file = ',trim(filen) + + ierr = pio_inq_varid( file_id, 'ssi', ssi_vid ) + ierr = pio_inq_dimid( file_id, 'bin', dimid ) + ierr = pio_inq_dimlen( file_id, dimid, nbins ) + + allocate(irradi(nbins,nrecords), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_euv_data_init: failed to allocate irradi; error = ',astat + call endrun('solar_data_init') + end if + + allocate(lambda(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_euv_data_init: failed to allocate lambda; error = ',astat + call endrun('solar_euv_data_init') + end if + allocate(dellam(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_euv_data_init: failed to allocate dellam; error = ',astat + call endrun('solar_euv_data_init') + end if + allocate(solar_euv_data_etf(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_euv_data_init: failed to allocate solar_euv_data_etf; error = ',astat + call endrun('solar_euv_data_init') + end if + + ierr = pio_inq_varid( file_id, 'wavelength', vid ) + ierr = pio_get_var( file_id, vid, lambda ) + ierr = pio_inq_varid( file_id, 'band_width', vid ) + ierr = pio_get_var( file_id, vid, dellam ) + + allocate(we(nbins+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_euv_data_init: failed to allocate we; error = ',astat + call endrun('solar_euv_data_init') + end if + + we(:nbins) = lambda(:nbins) - 0.5_r8*dellam(:nbins) + we(nbins+1) = lambda(nbins) + 0.5_r8*dellam(nbins) + + deallocate(lambda) + deallocate(dellam) + + ! need to force data loading when the model starts at a time =/ 00:00:00.000 + ! -- may occur in restarts also + call solar_euv_advance() + initialized = .true. + + end subroutine solar_euv_init + +!----------------------------------------------------------------------- +! Reads in the ETF data for the current date. +!----------------------------------------------------------------------- + subroutine solar_euv_advance() + + integer :: index + logical :: read_data + integer :: ierr + integer :: offset(2), count(2) + real(r8) :: delt + + if (.not.solar_euv_data_active) return + + index = -1 + + read_data = time_coord%read_more() .or. .not.initialized + call time_coord%advance() + + if ( read_data ) then + + index = time_coord%indxs(1) + + ! get the surrounding time slices + offset = (/ 1, index /) + count = (/ nbins, nrecords /) + + ierr = pio_get_var( file_id, ssi_vid, offset, count, irradi ) + endif + + delt = time_coord%wghts(2) + + solar_euv_data_etf(:) = irradi(:,1) + delt*( irradi(:,2) - irradi(:,1) ) + + end subroutine solar_euv_advance + +end module solar_euv_data diff --git a/src/chemistry/utils/solar_irrad_data.F90 b/src/chemistry/utils/solar_irrad_data.F90 new file mode 100644 index 0000000000..4f78ace165 --- /dev/null +++ b/src/chemistry/utils/solar_irrad_data.F90 @@ -0,0 +1,272 @@ +!----------------------------------------------------------------------- +! Solar irradiance / photon flux data +!----------------------------------------------------------------------- +module solar_irrad_data + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use pio, only: file_desc_t,pio_inq_dimid,pio_inq_varid,pio_inq_dimlen, pio_noerr,pio_internal_error,pio_bcast_error + use pio, only: pio_get_var, pio_seterrorhandling + use cam_pio_utils, only: cam_pio_openfile + use cam_logfile, only: iulog + use infnan, only: nan, assignment(=) + use input_data_utils, only: time_coordinate + + implicit none + + save + private + public :: solar_irrad_init + public :: solar_irrad_advance + + integer, public, protected :: nbins ! number of wavelength samples of spectrum, wavelength endpoints + real(r8), public, protected, allocatable :: we(:) + real(r8), public, protected, allocatable :: sol_etf(:) + real(r8), public, protected, allocatable :: ssi_ref(:) ! a reference spectrum constructed from 3 solar cycles of data + real(r8), public, protected, allocatable :: sol_irrad(:) + real(r8), public, protected :: sol_tsi = -1.0_r8 + real(r8), public, protected :: ref_tsi + logical, public, protected :: do_spctrl_scaling = .false. + logical, public, protected :: has_spectrum = .false. + logical, public, protected :: has_ref_spectrum = .false. + + type(file_desc_t) :: file_id + integer :: ssi_vid + integer :: tsi_vid + integer :: ref_vid + integer :: tsi_ref_vid + + logical :: initialized = .false. + logical :: has_tsi = .false. + real(r8) :: itsi(2) + real(r8), allocatable :: irradi(:,:) + real(r8), allocatable :: irrad_fac(:) + real(r8), allocatable :: etf_fac(:) + real(r8), allocatable :: dellam(:) + + logical :: fixed_scon + + type(time_coordinate) :: time_coord + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine solar_irrad_init(filepath, fixed, fixed_ymd, fixed_tod, const_tsi, heatng_spctrl_scl ) + + use ioFileMod, only : getfil + use physconst, only : c0, planck + + !--------------------------------------------------------------- + ! arguments + !--------------------------------------------------------------- + character(len=*), intent(in) :: filepath + logical, intent(in) :: fixed + integer, intent(in) :: fixed_ymd + integer, intent(in) :: fixed_tod + real(r8), intent(in) :: const_tsi + logical, intent(in) :: heatng_spctrl_scl + + !--------------------------------------------------------------- + ! local vars + !--------------------------------------------------------------- + integer :: astat, dimid, vid + character(len=256) :: filen + real(r8), allocatable :: lambda(:) + integer :: i, wvl_vid + real(r8), parameter :: c = c0 ! speed of light (m/s) + real(r8), parameter :: h = planck ! Planck's constant (Joule sec) + real(r8), parameter :: fac = 1._r8/(h*c) + integer :: ierr + + has_spectrum = .false. + + if ( filepath.ne.'NONE' ) then + fixed_scon = .false. + else + fixed_scon = .true. + endif + + if ( const_tsi>0._r8 ) then + sol_tsi = const_tsi + endif + ref_tsi = nan + + if ( fixed_scon ) return + + call time_coord%initialize( filepath, fixed=fixed, fixed_ymd=fixed_ymd, fixed_tod=fixed_tod, & + force_time_interp=.true., try_dates=.true. ) + + call getfil( filepath, filen, 0 ) + call cam_pio_openfile( file_id, filen, 0 ) + if(masterproc) write(iulog,*)'solar_data_init: data file = ',trim(filen) + call pio_seterrorhandling(file_id, pio_bcast_error) + ierr = pio_inq_varid( file_id, 'ssi', ssi_vid ) + has_spectrum = ierr==PIO_NOERR + + ierr = pio_inq_varid( file_id, 'tsi', tsi_vid ) + has_tsi = ierr==PIO_NOERR .and. const_tsi<0._r8 + + ierr = pio_inq_varid( file_id, 'ssi_ref', ref_vid ) + has_ref_spectrum = ierr==PIO_NOERR + call pio_seterrorhandling(file_id, pio_internal_error) + + if ( has_spectrum ) then + call pio_seterrorhandling(file_id, pio_bcast_error) + ierr = pio_inq_varid( file_id, 'wavelength', wvl_vid ) + call pio_seterrorhandling(file_id, pio_internal_error) + + if ( ierr==PIO_NOERR ) then + ierr = pio_inq_dimid( file_id, 'wavelength', dimid ) + else ! for backwards compatibility + ierr = pio_inq_varid( file_id, 'wvl', wvl_vid ) + ierr = pio_inq_dimid( file_id, 'wvl', dimid ) + endif + ierr = pio_inq_dimlen( file_id, dimid, nbins ) + if ( has_ref_spectrum ) then + ierr = pio_inq_varid( file_id, 'tsi_ref', tsi_ref_vid ) + endif + endif + + do_spctrl_scaling = has_spectrum .and. heatng_spctrl_scl + + allocate(lambda(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate lambda; error = ',astat + call endrun('solar_data_init') + end if + allocate(dellam(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate dellam; error = ',astat + call endrun('solar_data_init') + end if + allocate(irrad_fac(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate irrad_fac; error = ',astat + call endrun('solar_data_init') + end if + allocate(etf_fac(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate etf_fac; error = ',astat + call endrun('solar_data_init') + end if + allocate(sol_irrad(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate sol_irrad; error = ',astat + call endrun('solar_data_init') + end if + allocate(ssi_ref(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate ssi_ref; error = ',astat + call endrun('solar_data_init') + end if + ssi_ref(:) = nan + + if (has_spectrum) then + ierr = pio_get_var( file_id, wvl_vid, lambda ) + ierr = pio_inq_varid( file_id, 'band_width', vid ) + ierr = pio_get_var( file_id, vid, dellam ) + endif + + if(masterproc) write(iulog,*)'solar_data_init: has_ref_spectrum',has_ref_spectrum + if ( has_ref_spectrum ) then + ierr = pio_inq_varid( file_id, 'ssi_ref', vid ) + ierr = pio_get_var( file_id, vid, ssi_ref ) + ierr = pio_get_var( file_id, tsi_ref_vid, ref_tsi ) + endif + + if ( has_spectrum ) then + allocate(sol_etf(nbins), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate sol_etf; error = ',astat + call endrun('solar_data_init') + end if + allocate(irradi(nbins,2), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate irradi; error = ',astat + call endrun('solar_data_init') + end if + + allocate(we(nbins+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'solar_data_init: failed to allocate we; error = ',astat + call endrun('solar_data_init') + end if + + we(:nbins) = lambda(:nbins) - 0.5_r8*dellam(:nbins) + we(nbins+1) = lambda(nbins) + 0.5_r8*dellam(nbins) + do i = 1,nbins + irrad_fac(i) = 1.e-3_r8 ! mW/m2/nm --> W/m2/nm + etf_fac(i) = 1.e-16_r8*lambda(i)*fac ! mW/m2/nm --> photons/cm2/sec/nm + enddo + if(has_ref_spectrum) then + ssi_ref = ssi_ref * 1.e-3_r8 ! mW/m2/nm --> W/m2/nm + endif + endif + + deallocate(lambda) + deallocate(dellam) + + ! need to force data loading when the model starts at a time =/ 00:00:00.000 + ! -- may occur in restarts also + call solar_irrad_advance() + initialized = .true. + + end subroutine solar_irrad_init + +!----------------------------------------------------------------------- +! Reads in the ETF data for the current date. +!----------------------------------------------------------------------- + subroutine solar_irrad_advance( ) + + integer :: i, index, nt + integer :: offset(2), count(2) + logical :: read_data + real(r8) :: data(nbins) + integer :: ierr + real(r8) :: delt + + if ( fixed_scon ) return + if ( time_coord%fixed .and. initialized ) return + + index = -1 + + read_data = time_coord%read_more() .or. .not.initialized + call time_coord%advance() + + if ( read_data ) then + nt = 2 + index = time_coord%indxs(1) + + ! get the surrounding time slices + offset = (/ 1, index /) + count = (/ nbins, nt /) + + if (has_spectrum) then + ierr = pio_get_var( file_id, ssi_vid, offset, count, irradi ) + endif + if (has_tsi .and. (.not.do_spctrl_scaling)) then + ierr = pio_get_var( file_id, tsi_vid, (/index/), (/nt/), itsi ) + if ( any(itsi(:nt) < 0._r8) ) then + call endrun( 'solar_data_advance: invalid or missing tsi data ' ) + endif + endif + endif + + delt = time_coord%wghts(2) + + if (has_spectrum) then + data(:) = irradi(:,1) + delt*( irradi(:,2) - irradi(:,1) ) + + do i = 1,nbins + sol_irrad(i) = data(i)*irrad_fac(i) ! W/m2/nm + sol_etf(i) = data(i)*etf_fac(i) ! photons/cm2/sec/nm + enddo + endif + if (has_tsi .and. (.not.do_spctrl_scaling)) then + sol_tsi = itsi(1) + delt*( itsi(2) - itsi(1) ) + endif + + end subroutine solar_irrad_advance + +end module solar_irrad_data diff --git a/src/chemistry/utils/solar_parms_data.F90 b/src/chemistry/utils/solar_parms_data.F90 new file mode 100644 index 0000000000..327f5a43b5 --- /dev/null +++ b/src/chemistry/utils/solar_parms_data.F90 @@ -0,0 +1,143 @@ +!------------------------------------------------------------------------------- +! solar variability parameters -- space weather indices +!------------------------------------------------------------------------------- +module solar_parms_data + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use input_data_utils, only : time_coordinate + use infnan, only : nan, assignment(=) + + implicit none + + private + save + + ! public interface + + public :: solar_parms_init + public :: solar_parms_advance + + logical, public :: solar_parms_on = .false. + + ! time-interpolated quantities + + real(r8), public, protected :: solar_parms_f107 + real(r8), public, protected :: solar_parms_f107a + real(r8), public, protected :: solar_parms_f107p ! previous day + real(r8), public, protected :: solar_parms_kp + real(r8), public, protected :: solar_parms_ap + + ! private data + + real(r8), allocatable :: f107_in(:) + real(r8), allocatable :: f107a_in(:) + real(r8), allocatable :: kp_in(:) + real(r8), allocatable :: ap_in(:) + + type(time_coordinate) :: time_coord_curr ! for current model time interpolation + type(time_coordinate) :: time_coord_prev ! for previous day time interpolation + +contains + + subroutine solar_parms_init(filepath, fixed, fixed_ymd, fixed_tod) + !--------------------------------------------------------------- + ! ... initialize solar parmaters + !--------------------------------------------------------------- + + use ioFileMod + use error_messages, only: alloc_err + use cam_pio_utils, only: cam_pio_openfile + use pio, only: file_desc_t, var_desc_t, pio_get_var, & + pio_inq_varid, pio_closefile, pio_nowrite + + !--------------------------------------------------------------- + ! arguments + !--------------------------------------------------------------- + character(len=*), intent(in) :: filepath + logical, intent(in) :: fixed + integer, intent(in) :: fixed_ymd + integer, intent(in) :: fixed_tod + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + type(file_desc_t) :: ncid + type(var_desc_t) :: varid + integer :: astat + character(len=shr_kind_cl) :: locfn + integer :: ierr + + solar_parms_f107 = nan + solar_parms_f107a = nan + solar_parms_f107p = nan + solar_parms_kp = nan + solar_parms_ap = nan + + solar_parms_on = (filepath.ne.'NONE') + + if (.not.solar_parms_on) return + + !----------------------------------------------------------------------- + ! ... readin the solar parms dataset + !----------------------------------------------------------------------- + + call getfil(filepath, locfn, 0) + call cam_pio_openfile ( ncid, locfn, PIO_NOWRITE) + + call time_coord_prev%initialize( filepath, fixed=fixed, fixed_ymd=fixed_ymd, fixed_tod=fixed_tod, & + force_time_interp=.true., try_dates=.true., delta_days=-1._r8 ) + + call time_coord_curr%initialize( filepath, fixed=fixed, fixed_ymd=fixed_ymd, fixed_tod=fixed_tod, & + force_time_interp=.true., try_dates=.true. ) + + !--------------------------------------------------------------- + ! ... allocate and read solar parms + !--------------------------------------------------------------- + allocate( f107_in(time_coord_curr%ntimes), f107a_in(time_coord_curr%ntimes), & + kp_in(time_coord_curr%ntimes), ap_in(time_coord_curr%ntimes), stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'solar_parms_init', 'f107_in ... ap_in ', time_coord_curr%ntimes ) + end if + ierr = pio_inq_varid( ncid, 'f107', varid ) + ierr = pio_get_var( ncid, varid, f107_in ) + ierr = pio_inq_varid( ncid, 'f107a', varid ) + ierr = pio_get_var( ncid, varid, f107a_in ) + ierr = pio_inq_varid( ncid, 'kp', varid ) + ierr = pio_get_var( ncid, varid, kp_in ) + ierr = pio_inq_varid( ncid, 'ap', varid ) + ierr = pio_get_var( ncid, varid, ap_in ) + + call pio_closefile( ncid ) + +end subroutine solar_parms_init + +subroutine solar_parms_advance + !--------------------------------------------------------------- + ! time interpolate space wx indices + !--------------------------------------------------------------- + + integer :: ndx1, ndx2 + real(r8) :: wgt1, wgt2 + + if (solar_parms_on) then + call time_coord_curr%advance() + ndx1=time_coord_curr%indxs(1) + ndx2=time_coord_curr%indxs(2) + wgt1=time_coord_curr%wghts(1) + wgt2=time_coord_curr%wghts(2) + solar_parms_f107 = wgt1*f107_in(ndx1) + wgt2*f107_in(ndx2) + solar_parms_f107a = wgt1*f107a_in(ndx1) + wgt2*f107a_in(ndx2) + solar_parms_kp = wgt1*kp_in(ndx1) + wgt2*kp_in(ndx2) + solar_parms_ap = wgt1*ap_in(ndx1) + wgt2*ap_in(ndx2) + + call time_coord_prev%advance() + ndx1=time_coord_prev%indxs(1) + ndx2=time_coord_prev%indxs(2) + wgt1=time_coord_prev%wghts(1) + wgt2=time_coord_prev%wghts(2) + solar_parms_f107p = wgt1*f107_in(ndx1) + wgt2*f107_in(ndx2) + endif + +end subroutine solar_parms_advance + +end module solar_parms_data diff --git a/src/chemistry/utils/solar_wind_data.F90 b/src/chemistry/utils/solar_wind_data.F90 new file mode 100644 index 0000000000..b845af91ad --- /dev/null +++ b/src/chemistry/utils/solar_wind_data.F90 @@ -0,0 +1,131 @@ +!------------------------------------------------------------------------------- +! solar wind data -- IMF components, wind velocity and density +!------------------------------------------------------------------------------- +module solar_wind_data + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use input_data_utils, only : time_coordinate + use infnan, only : nan, assignment(=) + + implicit none + + private + save + + ! public interface + + public :: solar_wind_init + public :: solar_wind_advance + + logical :: solar_wind_on = .false. + + ! time-interpolated quantities + + real(r8), public, protected :: solar_wind_byimf + real(r8), public, protected :: solar_wind_bzimf + real(r8), public, protected :: solar_wind_swvel + real(r8), public, protected :: solar_wind_swden + + ! private data + + real(r8), allocatable :: byimf_in(:) + real(r8), allocatable :: bzimf_in(:) + real(r8), allocatable :: swvel_in(:) + real(r8), allocatable :: swden_in(:) + + type(time_coordinate) :: time_coord + +contains + + subroutine solar_wind_init(filepath, fixed, fixed_ymd, fixed_tod) + !--------------------------------------------------------------- + ! ... initialize solar parmaters + !--------------------------------------------------------------- + + use ioFileMod + use error_messages, only: alloc_err + use cam_pio_utils, only: cam_pio_openfile + use pio, only: file_desc_t, var_desc_t, pio_get_var, & + pio_inq_varid, pio_closefile, pio_nowrite + + !--------------------------------------------------------------- + ! arguments + !--------------------------------------------------------------- + character(len=*), intent(in) :: filepath + logical, intent(in) :: fixed + integer, intent(in) :: fixed_ymd + integer, intent(in) :: fixed_tod + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + type(file_desc_t) :: ncid + type(var_desc_t) :: varid + integer :: astat + character(len=shr_kind_cl) :: locfn + integer :: ierr + + solar_wind_byimf = nan + solar_wind_bzimf = nan + solar_wind_swvel = nan + solar_wind_swden = nan + + solar_wind_on = (trim(filepath).ne.'NONE' .and. len_trim(filepath)>0) + + if (.not.solar_wind_on) return + + !----------------------------------------------------------------------- + ! ... readin the solar parms dataset + !----------------------------------------------------------------------- + + call getfil(filepath, locfn, 0) + call cam_pio_openfile ( ncid, locfn, PIO_NOWRITE) + + call time_coord%initialize( filepath, fixed=fixed, fixed_ymd=fixed_ymd, & + fixed_tod=fixed_tod, force_time_interp=.true. ) + + !--------------------------------------------------------------- + ! ... allocate and read solar parms + !--------------------------------------------------------------- + allocate( byimf_in(time_coord%ntimes), bzimf_in(time_coord%ntimes), & + swvel_in(time_coord%ntimes), swden_in(time_coord%ntimes), & + stat=astat ) + if( astat /= 0 ) then + call alloc_err( astat, 'solar_wind_init', 'byimf_in ... swden_in ', & + time_coord%ntimes ) + end if + + ierr = pio_inq_varid( ncid, 'by', varid ) + ierr = pio_get_var( ncid, varid, byimf_in ) + ierr = pio_inq_varid( ncid, 'bz', varid ) + ierr = pio_get_var( ncid, varid, bzimf_in ) + ierr = pio_inq_varid( ncid, 'swvel', varid ) + ierr = pio_get_var( ncid, varid, swvel_in ) + ierr = pio_inq_varid( ncid, 'swden', varid ) + ierr = pio_get_var( ncid, varid, swden_in ) + + call pio_closefile( ncid ) + +end subroutine solar_wind_init + +subroutine solar_wind_advance + !--------------------------------------------------------------- + ! time interpolate space wx indices + !--------------------------------------------------------------- + + if (solar_wind_on) then + call time_coord%advance() + ! time interpolate + solar_wind_byimf = time_coord%wghts(1)*byimf_in(time_coord%indxs(1)) & + + time_coord%wghts(2)*byimf_in(time_coord%indxs(2)) + solar_wind_bzimf = time_coord%wghts(1)*bzimf_in(time_coord%indxs(1)) & + + time_coord%wghts(2)*bzimf_in(time_coord%indxs(2)) + solar_wind_swvel = time_coord%wghts(1)*swvel_in(time_coord%indxs(1)) & + + time_coord%wghts(2)*swvel_in(time_coord%indxs(2)) + solar_wind_swden = time_coord%wghts(1)*swden_in(time_coord%indxs(1)) & + + time_coord%wghts(2)*swden_in(time_coord%indxs(2)) + endif + +end subroutine solar_wind_advance + +end module solar_wind_data diff --git a/src/chemistry/utils/time_utils.F90 b/src/chemistry/utils/time_utils.F90 new file mode 100644 index 0000000000..6d79c97f80 --- /dev/null +++ b/src/chemistry/utils/time_utils.F90 @@ -0,0 +1,71 @@ +module time_utils + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + private + public :: flt_date, moz_findplb + +contains + + subroutine moz_findplb( x, nx, xval, index ) + !----------------------------------------------------------------------- + ! ... find periodic lower bound + ! search the input array for the lower bound of the interval that + ! contains the input value. the returned index satifies: + ! x(index) .le. xval .lt. x(index+1) + ! assume the array represents values in one cycle of a periodic coordinate. + ! so, if xval .lt. x(1), then index=nx. + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: nx + integer, intent(out) :: index + real(r8), intent(in) :: x(nx) ! strictly increasing array + real(r8), intent(in) :: xval + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i + + if( xval < x(1) .or. xval >= x(nx) ) then + index = nx + return + end if + + do i = 2,nx + if( xval < x(i) ) then + index = i - 1 + exit + end if + end do + + end subroutine moz_findplb + + real(r8) function flt_date( ncdate, ncsec ) + !----------------------------------------------------------------------- + ! Purpose: Convert date and seconds of day to floating point days since + ! 0001/01/01 + !----------------------------------------------------------------------- + use time_manager, only : timemgr_datediff + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncdate ! Current date as yyyymmdd + integer, intent(in) :: ncsec ! Seconds of day for current date + + integer :: refymd = 00010101 + integer :: reftod = 0 + + call timemgr_datediff(refymd, reftod, ncdate, ncsec, flt_date) + end function flt_date + +end module time_utils diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 new file mode 100644 index 0000000000..35a28110f4 --- /dev/null +++ b/src/chemistry/utils/tracer_data.F90 @@ -0,0 +1,2400 @@ +module tracer_data +!----------------------------------------------------------------------- +! module used to read (and interpolate) offline tracer data (sources and +! mixing ratios) +! Created by: Francis Vitt -- 2 May 2006 +! Modified by : Jim Edwards -- 10 March 2009 +! Modified by : Cheryl Craig and Chih-Chieh (Jack) Chen -- February 2010 +!----------------------------------------------------------------------- + + use perf_mod, only : t_startf, t_stopf + use shr_kind_mod, only : r8 => shr_kind_r8,r4 => shr_kind_r4, shr_kind_cl, SHR_KIND_CS + use time_manager, only : get_curr_date, get_step_size, get_curr_calday + use spmd_utils, only : masterproc + use ppgrid, only : pcols, pver, pverp, begchunk, endchunk + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_index + use time_manager, only : set_time_float_from_date, set_date_from_time_float + use pio, only : file_desc_t, var_desc_t, & + pio_seterrorhandling, pio_internal_error, pio_bcast_error, & + pio_setdebuglevel, & + pio_char, pio_noerr, & + pio_inq_dimid, pio_inq_varid, & + pio_def_dim, pio_def_var, & + pio_put_att, pio_put_var, & + pio_get_var, pio_get_att, pio_nowrite, pio_inq_dimlen, & + pio_inq_vardimid, pio_inq_dimlen, pio_closefile, & + pio_inquire_variable + + implicit none + + private ! all unless made public + save + + public :: trfld, input3d, input2d, trfile + public :: trcdata_init + public :: advance_trcdata + public :: get_fld_data + public :: get_fld_ndx + public :: write_trc_restart + public :: read_trc_restart + public :: init_trc_restart + public :: incr_filename + + + ! !PUBLIC MEMBERS + + type input3d + real(r8), dimension(:,:,:), pointer :: data => null() + endtype input3d + + type input2d + real(r8), dimension(:,:), pointer :: data => null() + endtype input2d + + type trfld + real(r8), dimension(:,:,:), pointer :: data => null() + type(input3d), dimension(4) :: input + character(len=32) :: srcnam + character(len=32) :: fldnam + character(len=32) :: units + type(var_desc_t) :: var_id + integer :: coords(4) ! LATDIM | LONDIM | LEVDIM | TIMDIM + integer :: order(4) ! LATDIM | LONDIM | LEVDIM | TIMDIM + logical :: srf_fld = .false. + integer :: pbuf_ndx = -1 + endtype trfld + + type trfile + type(input2d), dimension(4) :: ps_in + character(len=shr_kind_cl) :: pathname = ' ' + character(len=shr_kind_cl) :: curr_filename = ' ' + character(len=shr_kind_cl) :: next_filename = ' ' + type(file_desc_t) :: curr_fileid + type(file_desc_t) :: next_fileid + + type(var_desc_t), pointer :: currfnameid => null() ! pio restart file var id + type(var_desc_t), pointer :: nextfnameid => null() ! pio restart file var id + + character(len=shr_kind_cl) :: filenames_list = '' + real(r8) :: datatimem = -1.e36_r8 ! time of prv. values read in + real(r8) :: datatimep = -1.e36_r8 ! time of nxt. values read in + real(r8) :: datatimes(4) + integer :: interp_recs + real(r8), pointer, dimension(:) :: curr_data_times => null() + real(r8), pointer, dimension(:) :: next_data_times => null() + logical :: remove_trc_file = .false. ! delete file when finished with it + real(r8) :: offset_time + integer :: cyc_ndx_beg + integer :: cyc_ndx_end + integer :: cyc_yr = 0 + real(r8) :: one_yr = 0 + real(r8) :: curr_mod_time ! model time - calendar day + real(r8) :: next_mod_time ! model time - calendar day - next time step + integer :: nlon + integer :: nlat + integer :: nlev + integer :: nilev + integer :: ps_coords(3) ! LATDIM | LONDIM | TIMDIM + integer :: ps_order(3) ! LATDIM | LONDIM | TIMDIM + real(r8), pointer, dimension(:) :: lons => null() + real(r8), pointer, dimension(:) :: lats => null() + real(r8), pointer, dimension(:) :: levs => null() + real(r8), pointer, dimension(:) :: ilevs => null() + real(r8), pointer, dimension(:) :: hyam => null() + real(r8), pointer, dimension(:) :: hybm => null() + real(r8), pointer, dimension(:,:) :: ps => null() + real(r8), pointer, dimension(:) :: hyai => null() + real(r8), pointer, dimension(:) :: hybi => null() + real(r8), pointer, dimension(:,:) :: weight_x => null(), weight_y => null() + integer, pointer, dimension(:) :: count_x => null(), count_y => null() + integer, pointer, dimension(:,:) :: index_x => null(), index_y => null() + real(r8) :: p0 + type(var_desc_t) :: ps_id + logical, allocatable, dimension(:) :: in_pbuf + logical :: has_ps = .false. + logical :: zonal_ave = .false. + logical :: alt_data = .false. + logical :: geop_alt = .false. + logical :: cyclical = .false. + logical :: cyclical_list = .false. + logical :: weight_by_lat = .false. + logical :: conserve_column = .false. + logical :: fill_in_months = .false. + logical :: fixed = .false. + logical :: initialized = .false. + logical :: top_bndry = .false. + logical :: stepTime = .false. ! Do not interpolate in time, but use stepwise times + endtype trfile + + integer, public, parameter :: MAXTRCRS = 100 + + integer, parameter :: LONDIM = 1 + integer, parameter :: LATDIM = 2 + integer, parameter :: LEVDIM = 3 + integer, parameter :: TIMDIM = 4 + + integer, parameter :: PS_TIMDIM = 3 + + integer, parameter :: ZA_LATDIM = 1 + integer, parameter :: ZA_LEVDIM = 2 + integer, parameter :: ZA_TIMDIM = 3 + + integer, parameter :: nm=1 ! array index for previous (minus) data + integer, parameter :: np=2 ! array index for next (plus) data + + integer :: plon, plat + +contains + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & + rmv_file, data_cycle_yr, data_fixed_ymd, data_fixed_tod, data_type ) + + use mo_constants, only : d2r + use dyn_grid, only : get_dyn_grid_parm + use string_utils, only : to_upper + use horizontal_interpolate, only : xy_interp_init +#if ( defined SPMD ) + use mpishorthand, only: mpicom, mpir8, mpiint +#endif + + implicit none + + character(len=*), intent(in) :: specifier(:) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: filelist + character(len=*), intent(in) :: datapath + type(trfld), dimension(:), pointer :: flds + type(trfile), intent(inout) :: file + logical, intent(in) :: rmv_file + integer, intent(in) :: data_cycle_yr + integer, intent(in) :: data_fixed_ymd + integer, intent(in) :: data_fixed_tod + character(len=*), intent(in) :: data_type + + integer :: f, mxnflds, astat + integer :: str_yr, str_mon, str_day + integer :: lon_dimid, lat_dimid, lev_dimid, tim_dimid, old_dimid + integer :: dimids(4), did + type(var_desc_t) :: varid + integer :: idx + integer :: ierr + integer :: errcode + real(r8) :: start_time, time1, time2 + integer :: i1,i2,j1,j2 + integer :: nvardims, vardimids(4) + + character(len=256) :: data_units + + call specify_fields( specifier, flds ) + + file%datatimep=-1.e36_r8 + file%datatimem=-1.e36_r8 + + mxnflds = 0 + if (associated(flds)) mxnflds = size( flds ) + + if (mxnflds < 1) return + + file%remove_trc_file = rmv_file + file%pathname = trim(datapath) + file%filenames_list = trim(filelist) + + file%fill_in_months = .false. + file%cyclical = .false. + file%cyclical_list = .false. + +! does not work when compiled with pathf90 +! select case ( to_upper(data_type) ) + select case ( data_type ) + case( 'FIXED' ) + file%fixed = .true. + case( 'INTERP_MISSING_MONTHS' ) + file%fill_in_months = .true. + case( 'CYCLICAL' ) + file%cyclical = .true. + file%cyc_yr = data_cycle_yr + case( 'CYCLICAL_LIST' ) + file%cyclical_list = .true. + file%cyc_yr = data_cycle_yr + case( 'SERIAL' ) + case default + write(iulog,*) 'trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename) + write(iulog,*) 'trcdata_init: valid data types: SERIAL | CYCLICAL | CYCLICAL_LIST | FIXED | INTERP_MISSING_MONTHS ' + call endrun('trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename)) + endselect + + if ( (.not.file%fixed) .and. ((data_fixed_ymd>0._r8) .or.(data_fixed_tod>0._r8))) then + call endrun('trcdata_init: Cannot specify data_fixed_ymd or data_fixed_tod if data type is not FIXED') + endif + if ( (.not.file%cyclical) .and. (data_cycle_yr>0._r8) ) then + call endrun('trcdata_init: Cannot specify data_cycle_yr if data type is not CYCLICAL') + endif + + if (masterproc) then + write(iulog,*) 'trcdata_init: data type: '//trim(data_type)//' file: '//trim(filename) + endif + + ! if there is no list of files (len_trim(file%filenames_list)<1) then + ! -> set curr_filename from namelist rather from restart data + if ( len_trim(file%curr_filename)<1 .or. len_trim(file%filenames_list)<1 .or. file%fixed ) then ! initial run + file%curr_filename = trim(filename) + + call get_model_time(file) + + if ( file%fixed ) then + str_yr = data_fixed_ymd/10000 + str_mon = (data_fixed_ymd - str_yr*10000)/100 + str_day = data_fixed_ymd - str_yr*10000 - str_mon*100 + call set_time_float_from_date( start_time, str_yr, str_mon, str_day, data_fixed_tod ) + file%offset_time = start_time - file%curr_mod_time + else + file%offset_time = 0 + endif + endif + + call set_time_float_from_date( time2, 2, 1, 1, 0 ) + call set_time_float_from_date( time1, 1, 1, 1, 0 ) + file%one_yr = time2-time1 + + if ( file%cyclical .or. file%cyclical_list) then + file%cyc_ndx_beg = -1 + file%cyc_ndx_end = -1 + if ( file%cyc_yr /= 0 ) then + call set_time_float_from_date( time1, file%cyc_yr , 1, 1, 0 ) + call set_time_float_from_date( time2, file%cyc_yr+1, 1, 1, 0 ) + file%one_yr = time2-time1 + endif + + call open_trc_datafile( file%curr_filename, file%pathname, file%curr_fileid, file%curr_data_times, & + cyc_ndx_beg=file%cyc_ndx_beg, cyc_ndx_end=file%cyc_ndx_end, cyc_yr=file%cyc_yr ) + else + call open_trc_datafile( file%curr_filename, file%pathname, file%curr_fileid, file%curr_data_times ) + file%curr_data_times = file%curr_data_times - file%offset_time + endif + + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + ierr = pio_inq_dimid( file%curr_fileid, 'lon', idx ) + call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + + file%zonal_ave = (ierr/=PIO_NOERR) + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + + if ( file%zonal_ave ) then + + file%nlon = 1 + + else + + call get_dimension( file%curr_fileid, 'lon', file%nlon, dimid=old_dimid, data=file%lons ) + + file%lons = file%lons * d2r + + lon_dimid = old_dimid + + endif + + ierr = pio_inq_dimid( file%curr_fileid, 'time', old_dimid) + + ! Hack to work with weird netCDF and old gcc or NAG bug. + tim_dimid = old_dimid + + call get_dimension( file%curr_fileid, 'lat', file%nlat, dimid=old_dimid, data=file%lats ) + file%lats = file%lats * d2r + + lat_dimid = old_dimid + + allocate( file%ps(file%nlon,file%nlat), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%ps allocation error = ',astat + call endrun('trcdata_init: failed to allocate x array') + end if + + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + ierr = pio_inq_varid( file%curr_fileid, 'PS', file%ps_id ) + file%has_ps = (ierr==PIO_NOERR) + ierr = pio_inq_dimid( file%curr_fileid, 'altitude', idx ) + file%alt_data = (ierr==PIO_NOERR) + + call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + + if ( file%has_ps) then + if ( file%zonal_ave ) then + ierr = pio_inq_vardimid (file%curr_fileid, file%ps_id, dimids(1:2)) + do did = 1,2 + if ( dimids(did) == lat_dimid ) then + file%ps_coords(LATDIM) = did + file%ps_order(did) = LATDIM + else if ( dimids(did) == tim_dimid ) then + file%ps_coords(PS_TIMDIM) = did + file%ps_order(did) = PS_TIMDIM + endif + enddo + else + ierr = pio_inq_vardimid (file%curr_fileid, file%ps_id, dimids(1:3)) + do did = 1,3 + if ( dimids(did) == lon_dimid ) then + file%ps_coords(LONDIM) = did + file%ps_order(did) = LONDIM + else if ( dimids(did) == lat_dimid ) then + file%ps_coords(LATDIM) = did + file%ps_order(did) = LATDIM + else if ( dimids(did) == tim_dimid ) then + file%ps_coords(PS_TIMDIM) = did + file%ps_order(did) = PS_TIMDIM + endif + enddo + end if + endif + + if (masterproc) then + write(iulog,*) 'trcdata_init: file%has_ps = ' , file%has_ps + endif ! masterproc + + if (file%alt_data) then + call get_dimension( file%curr_fileid, 'altitude_int', file%nilev, data=file%ilevs ) + call get_dimension( file%curr_fileid, 'altitude', file%nlev, dimid=old_dimid, data=file%levs ) + else + call get_dimension( file%curr_fileid, 'lev', file%nlev, dimid=old_dimid, data=file%levs ) + if (old_dimid>0) then + file%levs = file%levs*100._r8 ! mbar->pascals + endif + endif + + ! For some bizarre reason, netCDF with older gcc is keeping a pointer to the dimid, and overwriting it later! + ! Hackish workaround is to make a copy... + lev_dimid = old_dimid + + if (file%has_ps) then + + allocate( file%hyam(file%nlev), file%hybm(file%nlev), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%hyam,file%hybm allocation error = ',astat + call endrun('trcdata_init: failed to allocate file%hyam and file%hybm arrays') + end if + + allocate( file%hyai(file%nlev+1), file%hybi(file%nlev+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%hyai,file%hybi allocation error = ',astat + call endrun('trcdata_init: failed to allocate file%hyai and file%hybi arrays') + end if + + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + ierr = pio_inq_varid( file%curr_fileid, 'P0', varid) + call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + + if ( ierr == PIO_NOERR ) then + ierr = pio_get_var( file%curr_fileid, varid, file%p0 ) + else + file%p0 = 100000._r8 + endif + ierr = pio_inq_varid( file%curr_fileid, 'hyam', varid ) + ierr = pio_get_var( file%curr_fileid, varid, file%hyam ) + ierr = pio_inq_varid( file%curr_fileid, 'hybm', varid ) + ierr = pio_get_var( file%curr_fileid, varid, file%hybm ) + if (file%conserve_column) then + ierr = pio_inq_varid( file%curr_fileid, 'hyai', varid ) + ierr = pio_get_var( file%curr_fileid, varid, file%hyai ) + ierr = pio_inq_varid( file%curr_fileid, 'hybi', varid ) + ierr = pio_get_var( file%curr_fileid, varid, file%hybi ) + endif + + allocate( file %ps (pcols,begchunk:endchunk), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate file%ps array; error = ',astat + call endrun + end if + allocate( file%ps_in(1)%data(pcols,begchunk:endchunk), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat + call endrun + end if + allocate( file%ps_in(2)%data(pcols,begchunk:endchunk), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(2)%data array; error = ',astat + call endrun + end if + if( file%fill_in_months ) then + allocate( file%ps_in(3)%data(pcols,begchunk:endchunk), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(3)%data array; error = ',astat + call endrun + end if + allocate( file%ps_in(4)%data(pcols,begchunk:endchunk), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(4)%data array; error = ',astat + call endrun + end if + end if + endif + + + flds_loop: do f = 1,mxnflds + + ! get netcdf variable id for the field + ierr = pio_inq_varid( file%curr_fileid, flds(f)%srcnam, flds(f)%var_id ) + + ! determine if the field has a vertical dimension + + if (lev_dimid>0) then + ierr = pio_inquire_variable( file%curr_fileid, flds(f)%var_id, ndims=nvardims ) + ierr = pio_inquire_variable( file%curr_fileid, flds(f)%var_id, dimids=vardimids(:nvardims) ) + flds(f)%srf_fld = .not.any(vardimids(:nvardims)==lev_dimid) + else + flds(f)%srf_fld = .true. + endif + + ! allocate memory only if not already in pbuf2d + + if ( .not. file%in_pbuf(f) ) then + if ( flds(f)%srf_fld .or. file%top_bndry ) then + allocate( flds(f) %data(pcols,1,begchunk:endchunk), stat=astat ) + else + allocate( flds(f) %data(pcols,pver,begchunk:endchunk), stat=astat ) + endif + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate flds(f)%data array; error = ',astat + call endrun + end if + else + flds(f)%pbuf_ndx = pbuf_get_index(flds(f)%fldnam,errcode) + endif + + if (flds(f)%srf_fld) then + allocate( flds(f)%input(1)%data(pcols,1,begchunk:endchunk), stat=astat ) + else + allocate( flds(f)%input(1)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + endif + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(1)%data array; error = ',astat + call endrun + end if + if (flds(f)%srf_fld) then + allocate( flds(f)%input(2)%data(pcols,1,begchunk:endchunk), stat=astat ) + else + allocate( flds(f)%input(2)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + endif + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(2)%data array; error = ',astat + call endrun + end if + + if( file%fill_in_months ) then + if (flds(f)%srf_fld) then + allocate( flds(f)%input(3)%data(pcols,1,begchunk:endchunk), stat=astat ) + else + allocate( flds(f)%input(3)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + endif + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(3)%data array; error = ',astat + call endrun + end if + if (flds(f)%srf_fld) then + allocate( flds(f)%input(4)%data(pcols,1,begchunk:endchunk), stat=astat ) + else + allocate( flds(f)%input(4)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + endif + if( astat/= 0 ) then + write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(4)%data array; error = ',astat + call endrun + end if + endif + + if ( file%zonal_ave ) then + ierr = pio_inq_vardimid (file%curr_fileid, flds(f)%var_id, dimids(1:3)) + do did = 1,3 + if ( dimids(did) == lat_dimid ) then + flds(f)%coords(ZA_LATDIM) = did + flds(f)%order(did) = ZA_LATDIM + else if ( dimids(did) == lev_dimid ) then + flds(f)%coords(ZA_LEVDIM) = did + flds(f)%order(did) = ZA_LEVDIM + else if ( dimids(did) == tim_dimid ) then + flds(f)%coords(ZA_TIMDIM) = did + flds(f)%order(did) = ZA_TIMDIM + endif + enddo + else if ( flds(f)%srf_fld ) then + ierr = pio_inq_vardimid (file%curr_fileid, flds(f)%var_id, dimids(1:3)) + do did = 1,3 + if ( dimids(did) == lon_dimid ) then + flds(f)%coords(LONDIM) = did + flds(f)%order(did) = LONDIM + else if ( dimids(did) == lat_dimid ) then + flds(f)%coords(LATDIM) = did + flds(f)%order(did) = LATDIM + else if ( dimids(did) == tim_dimid ) then + flds(f)%coords(PS_TIMDIM) = did + flds(f)%order(did) = PS_TIMDIM + endif + enddo + else + ierr = pio_inq_vardimid (file%curr_fileid, flds(f)%var_id, dimids) + do did = 1,4 + if ( dimids(did) == lon_dimid ) then + flds(f)%coords(LONDIM) = did + flds(f)%order(did) = LONDIM + else if ( dimids(did) == lat_dimid ) then + flds(f)%coords(LATDIM) = did + flds(f)%order(did) = LATDIM + else if ( dimids(did) == lev_dimid ) then + flds(f)%coords(LEVDIM) = did + flds(f)%order(did) = LEVDIM + else if ( dimids(did) == tim_dimid ) then + flds(f)%coords(TIMDIM) = did + flds(f)%order(did) = TIMDIM + endif + enddo + endif + + ierr = pio_get_att( file%curr_fileid, flds(f)%var_id, 'units', data_units) + flds(f)%units = trim(data_units(1:32)) + + enddo flds_loop + +! if weighting by latitude, compute weighting for horizontal interpolation + if( file%weight_by_lat ) then +! get dimensions of CAM resolution + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + +! weight_x & weight_y are weighting function for x & y interpolation + allocate(file%weight_x(plon,file%nlon)) + allocate(file%weight_y(plat,file%nlat)) + allocate(file%count_x(plon)) + allocate(file%count_y(plat)) + allocate(file%index_x(plon,file%nlon)) + allocate(file%index_y(plat,file%nlat)) + file%weight_x(:,:) = 0.0_r8 + file%weight_y(:,:) = 0.0_r8 + file%count_x(:) = 0 + file%count_y(:) = 0 + file%index_x(:,:) = 0 + file%index_y(:,:) = 0 + + if(masterproc) then +! compute weighting + call xy_interp_init(file%nlon,file%nlat,file%lons,file%lats,plon,plat,file%weight_x,file%weight_y) + + do i2=1,plon + file%count_x(i2) = 0 + do i1=1,file%nlon + if(file%weight_x(i2,i1).gt.0.0_r8 ) then + file%count_x(i2) = file%count_x(i2) + 1 + file%index_x(i2,file%count_x(i2)) = i1 + endif + enddo + enddo + + do j2=1,plat + file%count_y(j2) = 0 + do j1=1,file%nlat + if(file%weight_y(j2,j1).gt.0.0_r8 ) then + file%count_y(j2) = file%count_y(j2) + 1 + file%index_y(j2,file%count_y(j2)) = j1 + endif + enddo + enddo + endif + +#if ( defined SPMD) + call mpibcast(file%weight_x, plon*file%nlon, mpir8 , 0, mpicom) + call mpibcast(file%weight_y, plat*file%nlat, mpir8 , 0, mpicom) + call mpibcast(file%count_x, plon, mpiint , 0, mpicom) + call mpibcast(file%count_y, plat, mpiint , 0, mpicom) + call mpibcast(file%index_x, plon*file%nlon, mpiint , 0, mpicom) + call mpibcast(file%index_y, plat*file%nlat, mpiint , 0, mpicom) +#endif + endif + + end subroutine trcdata_init + +!----------------------------------------------------------------------- +! Reads more data if needed and interpolates data to current model time +!----------------------------------------------------------------------- + subroutine advance_trcdata( flds, file, state, pbuf2d ) + use physics_types,only : physics_state + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(trfile), intent(inout) :: file + type(trfld), intent(inout) :: flds(:) + type(physics_state), intent(in) :: state(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + real(r8) :: data_time + + call t_startf('advance_trcdata') + if ( .not.( file%fixed .and. file%initialized ) ) then + + call get_model_time(file) + + data_time = file%datatimep + + if ( file%cyclical .or. file%cyclical_list ) then + ! wrap around + if ( (file%datatimepfile%datatimem) ) then + data_time = data_time + file%one_yr + endif + endif + + ! For stepTime need to advance if the times are equal + ! Should not impact other runs? + if ( file%curr_mod_time >= data_time ) then + call t_startf('read_next_trcdata') + call read_next_trcdata( flds, file ) + call t_stopf('read_next_trcdata') + if(masterproc) write(iulog,*) 'READ_NEXT_TRCDATA ', flds%fldnam + end if + + endif + + ! need to interpolate the data, regardless + ! each mpi task needs to interpolate + call t_startf('interpolate_trcdata') + call interpolate_trcdata( state, flds, file, pbuf2d ) + call t_stopf('interpolate_trcdata') + + file%initialized = .true. + + call t_stopf('advance_trcdata') + + end subroutine advance_trcdata + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_fld_data( flds, field_name, data, ncol, lchnk, pbuf ) + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + type(trfld), intent(inout) :: flds(:) + character(len=*), intent(in) :: field_name + real(r8), intent(out) :: data(:,:) + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + + integer :: f, nflds + real(r8),pointer :: tmpptr(:,:) + + data(:,:) = 0._r8 + nflds = size(flds) + + do f = 1, nflds + if ( trim(flds(f)%fldnam) == trim(field_name) ) then + if ( flds(f)%pbuf_ndx>0 ) then + call pbuf_get_field(pbuf, flds(f)%pbuf_ndx, tmpptr) + data(:ncol,:) = tmpptr(:ncol,:) + else + data(:ncol,:) = flds(f)%data(:ncol,:,lchnk) + endif + endif + enddo + + end subroutine get_fld_data + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_fld_ndx( flds, field_name, idx ) + + implicit none + + type(trfld), intent(in) :: flds(:) + character(len=*), intent(in) :: field_name + integer, intent(out) :: idx + integer :: f, nflds + + idx = -1 + nflds = size(flds) + + do f = 1, nflds + if ( trim(flds(f)%fldnam) == trim(field_name) ) then + idx = f + return + endif + enddo + + end subroutine get_fld_ndx + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine get_model_time(file) + implicit none + type(trfile), intent(inout) :: file + + integer yr, mon, day, ncsec ! components of a date + + call get_curr_date(yr, mon, day, ncsec) + + if ( file%cyclical .or. file%cyclical_list) yr = file%cyc_yr + call set_time_float_from_date( file%curr_mod_time, yr, mon, day, ncsec ) + file%next_mod_time = file%curr_mod_time + get_step_size()/86400._r8 + + end subroutine get_model_time + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine check_files( file, fids, itms, times_found) + + implicit none + + type(trfile), intent(inout) :: file + type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs + integer, optional, intent(out) :: itms(2) + logical, optional, intent(inout) :: times_found + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + logical :: list_cycled + + list_cycled = .false. + + !----------------------------------------------------------------------- + ! If next time beyond the end of the time list, + ! then increment the filename and move on to the next file + !----------------------------------------------------------------------- + if ((file%next_mod_time > file%curr_data_times(size(file%curr_data_times))).or.file%cyclical_list) then + if (file%cyclical_list) then + if ( associated(file%next_data_times) ) then + if ((file%curr_mod_time > file%datatimep)) then + + call advance_file(file) + + endif + endif + + endif + if ( .not. associated(file%next_data_times) ) then + ! open next file if not already opened... + if (file%cyclical_list) then + file%next_filename = incr_filename( file%curr_filename, filenames_list=file%filenames_list, datapath=file%pathname ,& + cyclical_list=file%cyclical_list, list_cycled=list_cycled) + else + file%next_filename = incr_filename( file%curr_filename, filenames_list=file%filenames_list, datapath=file%pathname) + endif + call open_trc_datafile( file%next_filename, file%pathname, file%next_fileid, file%next_data_times ) + file%next_data_times = file%next_data_times - file%offset_time + endif + endif + + !----------------------------------------------------------------------- + ! If using next_data_times and the current is greater than or equal to the next, then + ! close the current file, and set up for next file. + !----------------------------------------------------------------------- + if ( associated(file%next_data_times) ) then + if (file%cyclical_list .and. list_cycled) then ! special case - list cycled + + file%datatimem = file%curr_data_times(size(file%curr_data_times)) + itms(1)=size(file%curr_data_times) + fids(1)=file%curr_fileid + + file%datatimep = file%next_data_times(1) + itms(2)=1 + fids(2) = file%next_fileid + + times_found = .true. + + else if (file%curr_mod_time >= file%next_data_times(1)) then + + call advance_file(file) + + endif + endif + + end subroutine check_files + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + function incr_filename( filename, filenames_list, datapath, cyclical_list, list_cycled, abort ) + + !----------------------------------------------------------------------- + ! ... Increment or decrement a date string withing a filename + ! the filename date section is assumed to be of the form + ! yyyy-dd-mm + !----------------------------------------------------------------------- + + use string_utils, only : incstr + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + + implicit none + + character(len=*), intent(in) :: filename ! present dynamical dataset filename + character(len=*), optional, intent(in) :: filenames_list + character(len=*), optional, intent(in) :: datapath + logical , optional, intent(in) :: cyclical_list ! If true, allow list to cycle + logical , optional, intent(out) :: list_cycled + logical , optional, intent(in) :: abort + + character(len=shr_kind_cl) :: incr_filename ! next filename in the sequence + + ! set new next_filename ... + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: pos, pos1, istat + character(len=shr_kind_cl) :: fn_new, line, filepath + character(len=6) :: seconds + character(len=5) :: num + integer :: ios,unitnumber + logical :: abort_run + + if (present(abort)) then + abort_run = abort + else + abort_run = .true. + endif + + if (present(list_cycled)) list_cycled = .false. + + if (( .not. present(filenames_list)) .or.(len_trim(filenames_list) == 0)) then + !----------------------------------------------------------------------- + ! ... ccm type filename + !----------------------------------------------------------------------- + pos = len_trim( filename ) + fn_new = filename(:pos) + if ( masterproc ) write(iulog,*) 'incr_flnm: old filename = ',trim(fn_new) + if( fn_new(pos-2:) == '.nc' ) then + pos = pos - 3 + end if + istat = incstr( fn_new(:pos), 1 ) + if( istat /= 0 ) then + write(iulog,*) 'incr_flnm: incstr returned ', istat + write(iulog,*) ' while trying to decrement ',trim( fn_new ) + call endrun + end if + + else + + !------------------------------------------------------------------- + ! ... open filenames_list + !------------------------------------------------------------------- + if ( masterproc ) write(iulog,*) 'incr_flnm: old filename = ',trim(filename) + if ( masterproc ) write(iulog,*) 'incr_flnm: open filenames_list : ',trim(filenames_list) + unitnumber = shr_file_getUnit() + if ( present(datapath) ) then + filepath = trim(datapath) //'/'// trim(filenames_list) + else + filepath = trim(filenames_list) + endif + + open( unit=unitnumber, file=filepath, iostat=ios, status="OLD") + if (ios /= 0) then + call endrun('not able to open file: '//trim(filepath)) + endif + + !------------------------------------------------------------------- + ! ... read file names + !------------------------------------------------------------------- + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + if (ios /= 0) then + if (abort_run) then + call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) + else + fn_new = 'NOT_FOUND' + incr_filename = trim(fn_new) + return + endif + endif + + !------------------------------------------------------------------- + ! If current filename is '', then initialize with the first filename read in + ! and skip this section. + !------------------------------------------------------------------- + if (filename /= '') then + + !------------------------------------------------------------------- + ! otherwise read until find current filename + !------------------------------------------------------------------- + do while( trim(line) /= trim(filename) ) + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + if (ios /= 0) then + if (abort_run) then + call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) + else + fn_new = 'NOT_FOUND' + incr_filename = trim(fn_new) + return + endif + endif + enddo + + !------------------------------------------------------------------- + ! Read next filename + !------------------------------------------------------------------- + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + + !--------------------------------------------------------------------------------- + ! If cyclical_list, then an end of file is not an error, but rather + ! a signal to rewind and start over + !--------------------------------------------------------------------------------- + + if (ios /= 0) then + if (present(cyclical_list)) then + if (cyclical_list) then + list_cycled=.true. + rewind(unitnumber) + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + ! Error here should never happen, but check just in case + if (ios /= 0) then + call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) + endif + else + call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) + endif + else + if (abort_run) then + call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) + else + fn_new = 'NOT_FOUND' + incr_filename = trim(fn_new) + return + endif + endif + endif + + endif + + !--------------------------------------------------------------------------------- + ! Assign the current filename and close the filelist + !--------------------------------------------------------------------------------- + fn_new = trim(line) + + close(unit=unitnumber) + call shr_file_freeUnit(unitnumber) + endif + + !--------------------------------------------------------------------------------- + ! return the current filename + !--------------------------------------------------------------------------------- + incr_filename = trim(fn_new) + if ( masterproc ) write(iulog,*) 'incr_flnm: new filename = ',trim(incr_filename) + + end function incr_filename + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found ) + + use intp_util, only: findplb + + implicit none + + type(trfile), intent(in) :: file + real(r8), intent(out) :: datatimem, datatimep + + integer, intent(out) :: itms(2) ! record numbers that bracket time + type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs + + real(r8), intent(in) :: time ! time of interest + logical, intent(inout) :: times_found + + integer :: np1 ! current forward time index of dataset + integer :: n,i ! + integer :: curr_tsize, next_tsize, all_tsize + integer :: astat + integer :: cyc_tsize + + real(r8), allocatable, dimension(:):: all_data_times + + curr_tsize = size(file%curr_data_times) + next_tsize = 0 + if ( associated(file%next_data_times)) next_tsize = size(file%next_data_times) + + all_tsize = curr_tsize + next_tsize + + allocate( all_data_times( all_tsize ), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'find_times: failed to allocate all_data_times array; error = ',astat + call endrun + end if + + all_data_times(:curr_tsize) = file%curr_data_times(:) + if (next_tsize > 0) all_data_times(curr_tsize+1:all_tsize) = file%next_data_times(:) + + if ( .not. file%cyclical ) then + if ( all( all_data_times(:) > time ) ) then + write(iulog,*) 'FIND_TIMES: ALL data times are after ', time + write(iulog,*) 'FIND_TIMES: file: ', trim(file%curr_filename) + write(iulog,*) 'FIND_TIMES: time: ', time + call endrun('find_times: all(all_data_times(:) > time) '// trim(file%curr_filename) ) + endif + + ! find bracketing times + find_times_loop : do n=1, all_tsize-1 + np1 = n + 1 + datatimem = all_data_times(n) !+ file%offset_time + datatimep = all_data_times(np1) !+ file%offset_time + ! When stepTime, datatimep may not equal the time (as only datatimem is used) + ! Should not break other runs? + if ( (time .ge. datatimem) .and. (time .lt. datatimep) ) then + times_found = .true. + exit find_times_loop + endif + enddo find_times_loop + + else ! file%cyclical + + cyc_tsize = file%cyc_ndx_end - file%cyc_ndx_beg + 1 + + if ( cyc_tsize > 1 ) then + + call findplb(all_data_times(file%cyc_ndx_beg:file%cyc_ndx_end),cyc_tsize, time, n ) + + if (n == cyc_tsize) then + np1 = 1 + else + np1 = n+1 + endif + + datatimem = all_data_times(n +file%cyc_ndx_beg-1) + datatimep = all_data_times(np1+file%cyc_ndx_beg-1) + times_found = .true. + + endif + endif + + if ( .not. times_found ) then + if (masterproc) then + write(iulog,*)'FIND_TIMES: Failed to find dates bracketing desired time =', time + write(iulog,*) 'filename = '//trim(file%curr_filename) + write(iulog,*)' datatimem = ',file%datatimem + write(iulog,*)' datatimep = ',file%datatimep + endif + return + endif + + deallocate( all_data_times, stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'find_times: failed to deallocate all_data_times array; error = ',astat + call endrun + end if + + if ( .not. file%cyclical ) then + itms(1) = n + itms(2) = np1 + else + itms(1) = n +file%cyc_ndx_beg-1 + itms(2) = np1 +file%cyc_ndx_beg-1 + endif + + fids(:) = file%curr_fileid + + do i=1,2 + if ( itms(i) > curr_tsize ) then + itms(i) = itms(i) - curr_tsize + fids(i) = file%next_fileid + endif + enddo + + end subroutine find_times + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ + subroutine read_next_trcdata( flds, file ) + implicit none + + type (trfile), intent(inout) :: file + type (trfld),intent(inout) :: flds(:) + + integer :: recnos(4),i,f,nflds ! + integer :: cnt4(4) ! array of counts for each dimension + integer :: strt4(4) ! array of starting indices + integer :: cnt3(3) ! array of counts for each dimension + integer :: strt3(3) ! array of starting indices + type(file_desc_t) :: fids(4) + logical :: times_found + + integer :: cur_yr, cur_mon, cur_day, cur_sec, yr1, yr2, mon, date, sec + real(r8) :: series1_time, series2_time + type(file_desc_t) :: fid1, fid2 + + nflds = size(flds) + times_found = .false. + + do while( .not. times_found ) + call find_times( recnos, fids, file%curr_mod_time, file,file%datatimem, file%datatimep, times_found ) + if ( .not. times_found ) then + call check_files( file, fids, recnos, times_found ) + endif + enddo + + !-------------------------------------------------------------- + ! If stepTime, then no time interpolation is to be done + !-------------------------------------------------------------- + if (file%stepTime) then + file%interp_recs = 1 + else + file%interp_recs = 2 + end if + + if ( file%fill_in_months ) then + + if( file%datatimep-file%datatimem > file%one_yr ) then + + call get_curr_date(cur_yr, cur_mon, cur_day, cur_sec) + + call set_date_from_time_float(file%datatimem, yr1, mon, date, sec ) + call set_date_from_time_float(file%datatimep, yr2, mon, date, sec ) + + call set_time_float_from_date( series1_time, yr1, cur_mon, cur_day, cur_sec ) + call set_time_float_from_date( series2_time, yr2, cur_mon, cur_day, cur_sec ) + + fid1 = fids(1) + fid2 = fids(2) + file%cyclical = .true. + call set_cycle_indices( fid1, file%cyc_ndx_beg, file%cyc_ndx_end, yr1) + call find_times( recnos(1:2), fids(1:2), series1_time, file, file%datatimes(1), file%datatimes(2), times_found ) + + if ( .not. times_found ) then + call endrun('read_next_trcdata: time not found for series1_time') + endif + call set_cycle_indices( fid2, file%cyc_ndx_beg, file%cyc_ndx_end, yr2) + + if ( fid1%fh /= fid2%fh ) then + file%cyc_ndx_beg = file%cyc_ndx_beg + size(file%curr_data_times) + file%cyc_ndx_end = file%cyc_ndx_end + size(file%curr_data_times) + endif + call find_times( recnos(3:4), fids(3:4), series2_time, file, file%datatimes(3), file%datatimes(4), times_found ) + if ( .not. times_found ) then + call endrun('read_next_trcdata: time not found for series2_time') + endif + file%cyclical = .false. + file%interp_recs = 4 + + call set_date_from_time_float( file%datatimes(1), yr1, mon, date, sec ) + call set_time_float_from_date( file%datatimem, cur_yr, mon, date, sec ) + if (file%datatimes(1) > file%datatimes(2) ) then ! wrap around + if ( cur_mon == 1 ) then + call set_time_float_from_date( file%datatimem, cur_yr-1, mon, date, sec ) + endif + endif + + call set_date_from_time_float( file%datatimes(2), yr1, mon, date, sec ) + call set_time_float_from_date( file%datatimep, cur_yr, mon, date, sec ) + if (file%datatimes(1) > file%datatimes(2) ) then ! wrap around + if ( cur_mon == 12 ) then + call set_time_float_from_date( file%datatimep, cur_yr+1, mon, date, sec ) + endif + endif + + endif + + endif + + ! + ! Set up hyperslab corners + ! + + do i=1,file%interp_recs + + strt4(:) = 1 + strt3(:) = 1 + + do f = 1,nflds + if ( file%zonal_ave ) then + cnt3(flds(f)%coords(ZA_LATDIM)) = file%nlat + if (flds(f)%srf_fld) then + cnt3(flds(f)%coords(ZA_LEVDIM)) = 1 + else + cnt3(flds(f)%coords(ZA_LEVDIM)) = file%nlev + endif + cnt3(flds(f)%coords(ZA_TIMDIM)) = 1 + strt3(flds(f)%coords(ZA_TIMDIM)) = recnos(i) + call read_za_trc( fids(i), flds(f)%var_id, flds(f)%input(i)%data, strt3, cnt3, file, & + (/ flds(f)%order(ZA_LATDIM),flds(f)%order(ZA_LEVDIM) /) ) + else if ( flds(f)%srf_fld ) then + cnt3( flds(f)%coords(LONDIM)) = file%nlon + cnt3( flds(f)%coords(LATDIM)) = file%nlat + cnt3( flds(f)%coords(PS_TIMDIM)) = 1 + strt3(flds(f)%coords(PS_TIMDIM)) = recnos(i) + call read_2d_trc( fids(i), flds(f)%var_id, flds(f)%input(i)%data(:,1,:), strt3, cnt3, file, & + (/ flds(f)%order(LONDIM),flds(f)%order(LATDIM) /) ) + else + cnt4(flds(f)%coords(LONDIM)) = file%nlon + cnt4(flds(f)%coords(LATDIM)) = file%nlat + cnt4(flds(f)%coords(LEVDIM)) = file%nlev + cnt4(flds(f)%coords(TIMDIM)) = 1 + strt4(flds(f)%coords(TIMDIM)) = recnos(i) + call read_3d_trc( fids(i), flds(f)%var_id, flds(f)%input(i)%data, strt4, cnt4, file, & + (/ flds(f)%order(LONDIM),flds(f)%order(LATDIM),flds(f)%order(LEVDIM) /)) + + endif + + enddo + + if ( file%has_ps ) then + cnt3 = 1 + strt3 = 1 + if (.not. file%zonal_ave) then + cnt3(file%ps_coords(LONDIM)) = file%nlon + end if + cnt3(file%ps_coords(LATDIM)) = file%nlat + cnt3(file%ps_coords(PS_TIMDIM)) = 1 + strt3(file%ps_coords(PS_TIMDIM)) = recnos(i) + if (file%zonal_ave) then + call read_2d_trc( fids(i), file%ps_id, file%ps_in(i)%data, strt3(1:2), cnt3(1:2), file, & + (/ 1, 2 /) ) + else + call read_2d_trc( fids(i), file%ps_id, file%ps_in(i)%data, strt3, cnt3, file, & + (/ file%ps_order(LONDIM),file%ps_order(LATDIM) /) ) + end if + endif + + enddo + + end subroutine read_next_trcdata + +!------------------------------------------------------------------------ + + + subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + + use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p, get_rlon_all_p, get_lon_all_p, get_lat_all_p + use mo_constants, only : pi + use dycore, only: dycore_is + use polar_avg, only: polar_average + use horizontal_interpolate, only : xy_interp + + implicit none + type(file_desc_t), intent(in) :: fid + type(var_desc_t), intent(in) :: vid + integer, intent(in) :: strt(:), cnt(:), order(2) + real(r8),intent(out) :: loc_arr(:,:) + type (trfile), intent(in) :: file + + real(r8) :: to_lats(pcols), to_lons(pcols), wrk(pcols) + real(r8), allocatable, target :: wrk2d(:,:) + real(r8), pointer :: wrk2d_in(:,:) + + integer :: tsize, c, i, ierr, ncols + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi + type(interp_type) :: lon_wgts, lat_wgts + integer :: lons(pcols), lats(pcols) + real(r8) :: file_lats(file%nlat) + + nullify(wrk2d_in) + allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'read_2d_trc: wrk2d allocation error = ',ierr + call endrun + end if + + if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlon .or. cnt(2)/=file%nlat) then + allocate( wrk2d_in(file%nlon, file%nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'read_2d_trc: wrk2d_in allocation error = ',ierr + call endrun + end if + end if + + + ierr = pio_get_var( fid, vid, strt, cnt, wrk2d ) + if(associated(wrk2d_in)) then + wrk2d_in = reshape( wrk2d(:,:),(/file%nlon,file%nlat/), order=order ) + deallocate(wrk2d) + else + wrk2d_in => wrk2d + end if + + ! PGI 13.9 bug workaround. + file_lats = file%lats + + ! For zonal average, only interpolate along latitude. + if (file%zonal_ave) then + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + + call lininterp_init(file_lats, file%nlat, to_lats, ncols, 1, lat_wgts) + + call lininterp(wrk2d_in(1,:), file%nlat, loc_arr(1:ncols,c-begchunk+1), ncols, lat_wgts) + + call lininterp_finish(lat_wgts) + end do + + else + ! if weighting by latitude, the perform horizontal interpolation by using weight_x, weight_y + + if(file%weight_by_lat) then + + call t_startf('xy_interp') + + do c = begchunk,endchunk + ncols = get_ncols_p(c) + call get_lon_all_p(c,ncols,lons) + call get_lat_all_p(c,ncols,lats) + + call xy_interp(file%nlon,file%nlat,1,plon,plat,pcols,ncols, & + file%weight_x,file%weight_y,wrk2d_in,loc_arr(:,c-begchunk+1), & + lons,lats,file%count_x,file%count_y,file%index_x,file%index_y) + enddo + + call t_stopf('xy_interp') + + else + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + + call lininterp_init(file%lons, file%nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(file%lats, file%nlat, to_lats, ncols, 1, lat_wgts) + + call lininterp(wrk2d_in, file%nlon, file%nlat, loc_arr(1:ncols,c-begchunk+1), ncols, lon_wgts, lat_wgts) + + call lininterp_finish(lon_wgts) + call lininterp_finish(lat_wgts) + end do + endif + + end if + + if(allocated(wrk2d)) then + deallocate(wrk2d) + else + deallocate(wrk2d_in) + end if + if(dycore_is('LR')) call polar_average(loc_arr) + end subroutine read_2d_trc + +!------------------------------------------------------------------------ + + subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p, get_rlon_all_p + use mo_constants, only : pi +! use dycore, only : dycore_is + use polar_avg, only : polar_average + + implicit none + type(file_desc_t), intent(in) :: fid + type(var_desc_t), intent(in) :: vid + integer, intent(in) :: strt(:), cnt(:) + integer, intent(in) :: order(2) + real(r8), intent(out):: loc_arr(:,:,:) + type (trfile), intent(in) :: file + + type(interp_type) :: lat_wgts + real(r8) :: to_lats(pcols), to_lons(pcols), wrk(pcols) + real(r8), allocatable, target :: wrk2d(:,:) + real(r8), pointer :: wrk2d_in(:,:) + integer :: c, k, ierr, ncols + + nullify(wrk2d_in) + allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'read_2d_trc: wrk2d allocation error = ',ierr + call endrun + end if + + if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlat .or. cnt(2)/=file%nlev) then + allocate( wrk2d_in(file%nlat, file%nlev), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'read_2d_trc: wrk2d_in allocation error = ',ierr + call endrun + end if + end if + + + ierr = pio_get_var( fid, vid, strt, cnt, wrk2d ) + if(associated(wrk2d_in)) then + wrk2d_in = reshape( wrk2d(:,:),(/file%nlat,file%nlev/), order=order ) + deallocate(wrk2d) + else + wrk2d_in => wrk2d + end if + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + + call lininterp_init(file%lats, file%nlat, to_lats, ncols, 1, lat_wgts) + do k=1,file%nlev + call lininterp(wrk2d_in(:,k), file%nlat, wrk(1:ncols), ncols, lat_wgts) + loc_arr(1:ncols,k,c-begchunk+1) = wrk(1:ncols) + end do + call lininterp_finish(lat_wgts) + end do + + if(allocated(wrk2d)) then + deallocate(wrk2d) + else + deallocate(wrk2d_in) + end if +! if(dycore_is('LR')) call polar_average(loc_arr) + end subroutine read_za_trc + +!------------------------------------------------------------------------ + + subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p, get_rlon_all_p, get_lon_all_p,& + get_lat_all_p + use mo_constants, only : pi + use dycore, only : dycore_is + use polar_avg, only : polar_average + use horizontal_interpolate, only : xy_interp + + implicit none + + type(file_desc_t), intent(in) :: fid + type(var_desc_t), intent(in) :: vid + integer, intent(in) :: strt(:), cnt(:), order(3) + real(r8),intent(out) :: loc_arr(:,:,:) + + type (trfile), intent(in) :: file + + integer :: i,j,k, astat, c, ncols + integer :: lons(pcols), lats(pcols) + + integer :: jlim(2), jl, ju, ierr + integer :: gndx + + real(r8), allocatable, target :: wrk3d(:,:,:) + real(r8), pointer :: wrk3d_in(:,:,:) + real(r8) :: to_lons(pcols), to_lats(pcols) + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi + type(interp_type) :: lon_wgts, lat_wgts + + loc_arr(:,:,:) = 0._r8 + nullify(wrk3d_in) + allocate(wrk3d(cnt(1),cnt(2),cnt(3)), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'read_3d_trc: wrk3d allocation error = ',ierr + call endrun + end if + + ierr = pio_get_var( fid, vid, strt, cnt, wrk3d ) + + if(order(1)/=1 .or. order(2)/=2 .or. order(3)/=3 .or. & + cnt(1)/=file%nlon.or.cnt(2)/=file%nlat.or.cnt(3)/=file%nlev) then + allocate(wrk3d_in(file%nlon,file%nlat,file%nlev),stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'read_3d_trc: wrk3d allocation error = ',ierr + call endrun + end if + wrk3d_in = reshape( wrk3d(:,:,:),(/file%nlon,file%nlat,file%nlev/), order=order ) + deallocate(wrk3d) + else + wrk3d_in => wrk3d + end if + + j=1 + +! If weighting by latitude, then perform horizontal interpolation by using weight_x, weight_y + + if(file%weight_by_lat) then + + call t_startf('xy_interp') + + do c = begchunk,endchunk + ncols = get_ncols_p(c) + call get_lon_all_p(c,ncols,lons) + call get_lat_all_p(c,ncols,lats) + + call xy_interp(file%nlon,file%nlat,file%nlev,plon,plat,pcols,ncols,file%weight_x,file%weight_y,wrk3d_in, & + loc_arr(:,:,c-begchunk+1), lons,lats,file%count_x,file%count_y,file%index_x,file%index_y) + enddo + + call t_stopf('xy_interp') + + else + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + + call lininterp_init(file%lons, file%nlon, to_lons(1:ncols), ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(file%lats, file%nlat, to_lats(1:ncols), ncols, 1, lat_wgts) + + + call lininterp(wrk3d_in, file%nlon, file%nlat, file%nlev, loc_arr(:,:,c-begchunk+1), ncols, pcols, lon_wgts, lat_wgts) + + + call lininterp_finish(lon_wgts) + call lininterp_finish(lat_wgts) + end do + endif + + if(allocated(wrk3d)) then + deallocate( wrk3d, stat=astat ) + else + deallocate( wrk3d_in, stat=astat ) + end if + if( astat/= 0 ) then + write(iulog,*) 'read_3d_trc: failed to deallocate wrk3d array; error = ',astat + call endrun + endif + if(dycore_is('LR')) call polar_average(file%nlev, loc_arr) + end subroutine read_3d_trc + +!------------------------------------------------------------------------------ + + subroutine interpolate_trcdata( state, flds, file, pbuf2d ) + use mo_util, only : rebin + use physics_types,only : physics_state + use physconst, only : cday, rga + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + type(physics_state), intent(in) :: state(begchunk:endchunk) + type (trfld), intent(inout) :: flds(:) + type (trfile), intent(inout) :: file + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + real(r8) :: fact1, fact2 + real(r8) :: deltat + integer :: f,nflds,c,ncol, i,k + real(r8) :: ps(pcols) + real(r8) :: datain(pcols,file%nlev) + real(r8) :: pin(pcols,file%nlev) + real(r8) :: model_z(pverp) + real(r8), parameter :: m2km = 1.e-3_r8 + real(r8), pointer :: data_out3d(:,:,:) + real(r8), pointer :: data_out(:,:) + integer :: chnk_offset + real(r8) :: data_col(pver) + + nflds = size(flds) + + if ( file%interp_recs == 4 ) then + deltat = file%datatimes(3) - file%datatimes(1) + fact1 = (file%datatimes(3) - file%datatimem)/deltat + fact2 = 1._r8-fact1 +!$OMP PARALLEL DO PRIVATE (C, NCOL, F) + do c = begchunk,endchunk + ncol = state(c)%ncol + if ( file%has_ps ) then + file%ps_in(1)%data(:ncol,c) = fact1*file%ps_in(1)%data(:ncol,c) + fact2*file%ps_in(3)%data(:ncol,c) + endif + do f = 1,nflds + flds(f)%input(1)%data(:ncol,:,c) = fact1*flds(f)%input(1)%data(:ncol,:,c) + fact2*flds(f)%input(3)%data(:ncol,:,c) + enddo + enddo + + deltat = file%datatimes(4) - file%datatimes(2) + fact1 = (file%datatimes(4) - file%datatimep)/deltat + fact2 = 1._r8-fact1 + +!$OMP PARALLEL DO PRIVATE (C, NCOL, F) + do c = begchunk,endchunk + ncol = state(c)%ncol + if ( file%has_ps ) then + file%ps_in(2)%data(:ncol,c) = fact1*file%ps_in(2)%data(:ncol,c) + fact2*file%ps_in(4)%data(:ncol,c) + endif + do f = 1,nflds + flds(f)%input(2)%data(:ncol,:,c) = fact1*flds(f)%input(2)%data(:ncol,:,c) + fact2*flds(f)%input(4)%data(:ncol,:,c) + enddo + enddo + + endif + !------------------------------------------------------------------------- + ! If file%interp_recs=1 then no time interpolation -- set + ! fact1=1 and fact2=0 and will just use first value unmodified + !------------------------------------------------------------------------- + + if (file%interp_recs == 1) then + fact1=1._r8 + fact2=0._r8 + else + file%interp_recs = 2 + + deltat = file%datatimep - file%datatimem + + if ( file%cyclical .and. (deltat < 0._r8) ) then + deltat = deltat+file%one_yr + if ( file%datatimep >= file%curr_mod_time ) then + fact1 = (file%datatimep - file%curr_mod_time)/deltat + else + fact1 = (file%datatimep+file%one_yr - file%curr_mod_time)/deltat + endif + else + fact1 = (file%datatimep - file%curr_mod_time)/deltat + endif + + ! this assures that FIXED data are b4b on restarts + if ( file%fixed ) then + fact1 = dble(int(fact1*cday+.5_r8))/dble(cday) + endif + fact2 = 1._r8-fact1 + endif + + chnk_offset=-begchunk+1 + + fld_loop: do f = 1,nflds + + if (flds(f)%pbuf_ndx<=0) then + data_out3d => flds(f)%data(:,:,:) + endif + +!$OMP PARALLEL DO PRIVATE (C, NCOL, PS, I, K, PIN, DATAIN, MODEL_Z, DATA_OUT, DATA_COL) + do c = begchunk,endchunk + if (flds(f)%pbuf_ndx>0) then + call pbuf_get_field(pbuf2d, c, flds(f)%pbuf_ndx, data_out) + else + data_out => data_out3d(:,:,c+chnk_offset) + endif + ncol = state(c)%ncol + if (file%alt_data) then + + if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) + datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + else + datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + fact2*flds(f)%input(np)%data(:ncol,:,c) + end if + do i = 1,ncol + model_z(1:pverp) = m2km * state(c)%zi(i,pverp:1:-1) + if (file%geop_alt) then + model_z(1:pverp) = model_z(1:pverp) + m2km * state(c)%phis(i)*rga + endif + call rebin( file%nlev, pver, file%ilevs, model_z, datain(i,:), data_col(:) ) + data_out(i,:) = data_col(pver:1:-1) + enddo + + else + + if ( file%nlev>1 ) then + if ( file%has_ps ) then + if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) + ps(:ncol) = fact1*file%ps_in(nm)%data(:ncol,c) + else + ps(:ncol) = fact1*file%ps_in(nm)%data(:ncol,c) + fact2*file%ps_in(np)%data(:ncol,c) + end if + do i = 1,ncol + do k = 1,file%nlev + pin(i,k) = file%p0*file%hyam(k) + ps(i)*file%hybm(k) + enddo + enddo + else + do k = 1,file%nlev + pin(:,k) = file%levs(k) + enddo + endif + endif + + if (flds(f)%srf_fld) then + do i = 1,ncol + if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) + data_out(i,1) = & + fact1*flds(f)%input(nm)%data(i,1,c) + else + data_out(i,1) = & + fact1*flds(f)%input(nm)%data(i,1,c) + fact2*flds(f)%input(np)%data(i,1,c) + endif + enddo + else + if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) + datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + else + datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + fact2*flds(f)%input(np)%data(:ncol,:,c) + end if + if ( file%top_bndry ) then + call vert_interp_ub(ncol, file%nlev, file%levs, datain(:ncol,:), data_out(:ncol,:) ) + else if(file%conserve_column) then + call vert_interp_mixrat(ncol,file%nlev,pver,state(c)%pint, & + datain, data_out(:,:), & + file%p0,ps,file%hyai,file%hybi) + else + call vert_interp(ncol, file%nlev, pin, state(c)%pmid, datain, data_out(:,:) ) + endif + endif + + endif + enddo + + enddo fld_loop + + end subroutine interpolate_trcdata + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine get_dimension( fid, dname, dsize, dimid, data ) + implicit none + type(file_desc_t), intent(inout) :: fid + character(*), intent(in) :: dname + integer, intent(out) :: dsize + + integer, optional, intent(out) :: dimid + real(r8), optional, pointer, dimension(:) :: data + + integer :: vid, ierr, id + + call pio_seterrorhandling( fid, PIO_BCAST_ERROR) + ierr = pio_inq_dimid( fid, dname, id ) + call pio_seterrorhandling( fid, PIO_INTERNAL_ERROR) + + if ( ierr==PIO_NOERR ) then + + ierr = pio_inq_dimlen( fid, id, dsize ) + + if ( present(dimid) ) then + dimid = id + endif + + if ( present(data) ) then + if ( associated(data) ) then + deallocate(data, stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'get_dimension: data deallocation error = ',ierr + call endrun('get_dimension: failed to deallocate data array') + end if + endif + allocate( data(dsize), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'get_dimension: data allocation error = ',ierr + call endrun('get_dimension: failed to allocate data array') + end if + + ierr = pio_inq_varid( fid, dname, vid ) + ierr = pio_get_var( fid, vid, data ) + endif + else + dsize = 1 + if ( present(dimid) ) then + dimid = -1 + endif + endif + + end subroutine get_dimension + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine set_cycle_indices( fileid, cyc_ndx_beg, cyc_ndx_end, cyc_yr ) + + implicit none + + type(file_desc_t), intent(inout) :: fileid + integer, intent(out) :: cyc_ndx_beg + integer, intent(out) :: cyc_ndx_end + integer, intent(in) :: cyc_yr + + integer, allocatable , dimension(:) :: dates, datesecs + integer :: timesize, i, astat, year, ierr + type(var_desc_T) :: dateid + call get_dimension( fileid, 'time', timesize ) + cyc_ndx_beg=-1 + + allocate( dates(timesize), stat=astat ) + if( astat/= 0 ) then + write(*,*) 'set_cycle_indices: failed to allocate dates array; error = ',astat + call endrun + end if + + ierr = pio_inq_varid( fileid, 'date', dateid ) + ierr = pio_get_var( fileid, dateid, dates ) + + do i=1,timesize + year = dates(i) / 10000 + if ( year == cyc_yr ) then + if (cyc_ndx_beg < 0) then + cyc_ndx_beg = i + endif + cyc_ndx_end = i + endif + enddo + deallocate( dates, stat=astat ) + if( astat/= 0 ) then + write(*,*) 'set_cycle_indices: failed to deallocate dates array; error = ',astat + call endrun + end if + if (cyc_ndx_beg < 0) then + write(*,*) 'set_cycle_indices: cycle year not found : ' , cyc_yr + call endrun('set_cycle_indices: cycle year not found') + endif + + end subroutine set_cycle_indices +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_end, cyc_yr ) + + use ioFileMod, only: getfil + use cam_pio_utils, only: cam_pio_openfile + + implicit none + + character(*), intent(in) :: fname + character(*), intent(in) :: path + type(file_desc_t), intent(inout) :: piofile + real(r8), pointer :: times(:) + + integer, optional, intent(out) :: cyc_ndx_beg + integer, optional, intent(out) :: cyc_ndx_end + integer, optional, intent(in) :: cyc_yr + + character(len=shr_kind_cl) :: filen, filepath + integer :: year, month, day, dsize, i, timesize + integer :: dateid,secid + integer, allocatable , dimension(:) :: dates, datesecs + integer :: astat, ierr + logical :: need_first_ndx + + if (len_trim(path) == 0) then + filepath = trim(fname) + else + filepath = trim(path) // '/' // trim(fname) + end if + ! + ! open file and get fileid + ! + call getfil( filepath, filen, 0 ) + call cam_pio_openfile( piofile, filen, PIO_NOWRITE) + if(masterproc) write(iulog,*)'open_trc_datafile: ',trim(filen) + + call get_dimension(piofile, 'time', timesize) + + if ( associated(times) ) then + deallocate(times, stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'open_trc_datafile: data deallocation error = ',ierr + call endrun('open_trc_datafile: failed to deallocate data array') + end if + endif + allocate( times(timesize), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'open_trc_datafile: data allocation error = ',ierr + call endrun('open_trc_datafile: failed to allocate data array') + end if + + allocate( dates(timesize), stat=astat ) + if( astat/= 0 ) then + if(masterproc) write(iulog,*) 'open_trc_datafile: failed to allocate dates array; error = ',astat + call endrun + end if + allocate( datesecs(timesize), stat=astat ) + if( astat/= 0 ) then + if(masterproc) write(iulog,*) 'open_trc_datafile: failed to allocate datesec array; error = ',astat + call endrun + end if + + ierr = pio_inq_varid( piofile, 'date', dateid ) + call pio_seterrorhandling( piofile, PIO_BCAST_ERROR) + ierr = pio_inq_varid( piofile, 'datesec', secid ) + call pio_seterrorhandling( piofile, PIO_INTERNAL_ERROR) + + if(ierr==PIO_NOERR) then + ierr = pio_get_var( piofile, secid, datesecs ) + else + datesecs=0 + end if + + ierr = pio_get_var( piofile, dateid, dates ) + need_first_ndx=.true. + + do i=1,timesize + year = dates(i) / 10000 + month = mod(dates(i),10000)/100 + day = mod(dates(i),100) + call set_time_float_from_date( times(i), year, month, day, datesecs(i) ) + if ( present(cyc_yr) ) then + if ( year == cyc_yr ) then + if ( present(cyc_ndx_beg) .and. need_first_ndx ) then + cyc_ndx_beg = i + need_first_ndx = .false. + endif + if ( present(cyc_ndx_end) ) then + cyc_ndx_end = i + endif + endif + endif + enddo + + deallocate( dates, stat=astat ) + if( astat/= 0 ) then + if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate dates array; error = ',astat + call endrun + end if + deallocate( datesecs, stat=astat ) + if( astat/= 0 ) then + if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate datesec array; error = ',astat + call endrun + end if + + if ( present(cyc_yr) .and. present(cyc_ndx_beg) ) then + if (cyc_ndx_beg < 0) then + write(iulog,*) 'open_trc_datafile: cycle year not found : ' , cyc_yr + call endrun('open_trc_datafile: cycle year not found '//trim(filepath)) + endif + endif + + end subroutine open_trc_datafile + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + subroutine specify_fields( specifier, fields ) + + implicit none + + character(len=*), intent(in) :: specifier(:) + type(trfld), pointer, dimension(:) :: fields + + integer :: fld_cnt, astat + integer :: i,j + character(len=shr_kind_cl) :: str1, str2 + character(len=32), allocatable, dimension(:) :: fld_name, src_name + integer :: nflds + + nflds = size(specifier) + + allocate(fld_name(nflds), src_name(nflds), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'specify_fields: failed to allocate fld_name, src_name arrays; error = ',astat + call endrun + end if + + fld_cnt = 0 + + count_cnst: do i = 1, nflds + + if ( len_trim( specifier(i) ) == 0 ) then + exit count_cnst + endif + + j = scan( specifier(i),':') + + if (j > 0) then + str1 = trim(adjustl( specifier(i)(:j-1) )) + str2 = trim(adjustl( specifier(i)(j+1:) )) + fld_name(i) = trim(adjustl( str1 )) + src_name(i) = trim(adjustl( str2 )) + else + fld_name(i) = trim(adjustl( specifier(i) )) + src_name(i) = trim(adjustl( specifier(i) )) + endif + + fld_cnt = fld_cnt + 1 + + enddo count_cnst + + if( fld_cnt < 1 ) then + nullify(fields) + return + end if + + !----------------------------------------------------------------------- + ! ... allocate field type array + !----------------------------------------------------------------------- + allocate( fields(fld_cnt), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'specify_fields: failed to allocate fields array; error = ',astat + call endrun + end if + + do i = 1,fld_cnt + fields(i)%fldnam = fld_name(i) + fields(i)%srcnam = src_name(i) + enddo + + deallocate(fld_name, src_name) + + end subroutine specify_fields + +!------------------------------------------------------------------------------ + + subroutine init_trc_restart( whence, piofile, tr_file ) + + implicit none + character(len=*), intent(in) :: whence + type(file_desc_t), intent(inout) :: piofile + type(trfile), intent(inout) :: tr_file + + character(len=32) :: name + integer :: ioerr, mcdimid, maxlen + + + ! Dimension should already be defined in restart file + call pio_seterrorhandling(pioFile, PIO_BCAST_ERROR) + ioerr = pio_inq_dimid(pioFile,'max_chars', mcdimid) + call pio_seterrorhandling(pioFile, PIO_INTERNAL_ERROR) + ! but define it if nessasary + if(ioerr/= PIO_NOERR) then + ioerr = pio_def_dim(pioFile, 'max_chars', SHR_KIND_CL, mcdimid) + end if + + if(len_trim(tr_file%curr_filename)>1) then + allocate(tr_file%currfnameid) + name = trim(whence)//'_curr_fname' + ioerr = pio_def_var(pioFile, name,pio_char, (/mcdimid/), tr_file%currfnameid) + ioerr = pio_put_att(pioFile, tr_file%currfnameid, 'offset_time', tr_file%offset_time) + maxlen = len_trim(tr_file%curr_filename) + ioerr = pio_put_att(pioFile, tr_file%currfnameid, 'actual_len', maxlen) + else + nullify(tr_file%currfnameid) + end if + + if(len_trim(tr_file%next_filename)>1) then + allocate(tr_file%nextfnameid) + name = trim(whence)//'_next_fname' + ioerr = pio_def_var(pioFile, name,pio_char, (/mcdimid/), tr_file%nextfnameid) + maxlen = len_trim(tr_file%next_filename) + ioerr = pio_put_att(pioFile, tr_file%nextfnameid, 'actual_len', maxlen) + else + nullify(tr_file%nextfnameid) + end if + end subroutine init_trc_restart +!------------------------------------------------------------------------- +! writes file names to restart file +!------------------------------------------------------------------------- + subroutine write_trc_restart( piofile, tr_file ) + + implicit none + + type(file_desc_t), intent(inout) :: piofile + type(trfile), intent(inout) :: tr_file + + integer :: ioerr, slen ! error status + if(associated(tr_file%currfnameid)) then + ioerr = pio_put_var(pioFile, tr_file%currfnameid, tr_file%curr_filename) + deallocate(tr_file%currfnameid) + nullify(tr_file%currfnameid) + end if + if(associated(tr_file%nextfnameid)) then + ioerr = pio_put_var(pioFile, tr_file%nextfnameid, tr_file%next_filename) + deallocate(tr_file%nextfnameid) + nullify(tr_file%nextfnameid) + end if + end subroutine write_trc_restart + +!------------------------------------------------------------------------- +! reads file names from restart file +!------------------------------------------------------------------------- + subroutine read_trc_restart( whence, piofile, tr_file ) + + implicit none + + character(len=*), intent(in) :: whence + type(file_desc_t), intent(inout) :: piofile + type(trfile), intent(inout) :: tr_file + type(var_desc_t) :: vdesc + character(len=64) :: name + integer :: ioerr ! error status + integer :: slen + + call PIO_SetErrorHandling(piofile, PIO_BCAST_ERROR) + name = trim(whence)//'_curr_fname' + ioerr = pio_inq_varid(piofile, name, vdesc) + if(ioerr==PIO_NOERR) then + tr_file%curr_filename=' ' + ioerr = pio_get_att(piofile, vdesc, 'offset_time', tr_file%offset_time) + ioerr = pio_get_att(piofile, vdesc, 'actual_len', slen) + ioerr = pio_get_var(piofile, vdesc, tr_file%curr_filename) + if(slen= plevs(nlevs) ) then + kl = nlevs + ku = nlevs + delp = 0._r8 + else + + do kk = 2,nlevs + if( pinterp <= plevs(kk) ) then + ku = kk + kl = kk - 1 + delp = log( pinterp/plevs(kk) ) / log( plevs(kk-1)/plevs(kk) ) + exit + end if + end do + + end if + + do i = 1,ncol + dataout(i) = datain(i,kl) + delp * (datain(i,ku) - datain(i,kl)) + end do + + end subroutine vert_interp_ub +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine advance_file(file) + + !------------------------------------------------------------------------------ + ! This routine advances to the next file + !------------------------------------------------------------------------------ + + use shr_sys_mod, only: shr_sys_system + use ioFileMod, only: getfil + + implicit none + + type(trfile), intent(inout) :: file + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + character(len=shr_kind_cl) :: ctmp + character(len=shr_kind_cl) :: loc_fname + integer :: istat, astat + + !----------------------------------------------------------------------- + ! close current file ... + !----------------------------------------------------------------------- + call pio_closefile( file%curr_fileid ) + + !----------------------------------------------------------------------- + ! remove if requested + !----------------------------------------------------------------------- + if( file%remove_trc_file ) then + call getfil( file%curr_filename, loc_fname, 0 ) + write(iulog,*) 'advance_file: removing file = ',trim(loc_fname) + ctmp = 'rm -f ' // trim(loc_fname) + write(iulog,*) 'advance_file: fsystem issuing command - ' + write(iulog,*) trim(ctmp) + call shr_sys_system( ctmp, istat ) + end if + + !----------------------------------------------------------------------- + ! Advance the filename and file id + !----------------------------------------------------------------------- + file%curr_filename = file%next_filename + file%curr_fileid = file%next_fileid + + !----------------------------------------------------------------------- + ! Advance the curr_data_times + !----------------------------------------------------------------------- + deallocate( file%curr_data_times, stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'advance_file: failed to deallocate file%curr_data_times array; error = ',astat + call endrun + end if + allocate( file%curr_data_times( size( file%next_data_times ) ), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'advance_file: failed to allocate file%curr_data_times array; error = ',astat + call endrun + end if + file%curr_data_times(:) = file%next_data_times(:) + + !----------------------------------------------------------------------- + ! delete information about next file (as was just assigned to current) + !----------------------------------------------------------------------- + file%next_filename = '' + + deallocate( file%next_data_times, stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'advance_file: failed to deallocate file%next_data_times array; error = ',astat + call endrun + end if + nullify( file%next_data_times ) + + end subroutine advance_file + +end module tracer_data diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 new file mode 100644 index 0000000000..1d8cb92aa9 --- /dev/null +++ b/src/control/cam_comp.F90 @@ -0,0 +1,473 @@ +module cam_comp +!----------------------------------------------------------------------- +! +! Community Atmosphere Model (CAM) component interfaces. +! +! This interface layer is CAM specific, i.e., it deals entirely with CAM +! specific data structures. It is the layer above this, either atm_comp_mct +! or atm_comp_esmf, which translates between CAM and either MCT or ESMF +! data structures in order to interface with the driver/coupler. +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => SHR_KIND_R8, cl=>SHR_KIND_CL, cs=>SHR_KIND_CS +use shr_sys_mod, only: shr_sys_flush + +use ESMF, only: esmf_clock +use seq_timemgr_mod, only: seq_timemgr_EClockGetData + +use spmd_utils, only: masterproc, mpicom +use cam_control_mod, only: cam_ctrl_init, cam_ctrl_set_orbit, initial_run +use runtime_opts, only: read_namelist +use time_manager, only: timemgr_init, get_step_size, & + get_nstep, is_first_step, is_first_restart_step + +use camsrfexch, only: cam_out_t, cam_in_t +use ppgrid, only: begchunk, endchunk +use physics_types, only: physics_state, physics_tend +use dyn_comp, only: dyn_import_t, dyn_export_t + +use physics_buffer, only: physics_buffer_desc +use offline_driver, only: offline_driver_init, offline_driver_dorun, offline_driver_run + +use perf_mod +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +public cam_init ! First phase of CAM initialization +public cam_run1 ! CAM run method phase 1 +public cam_run2 ! CAM run method phase 2 +public cam_run3 ! CAM run method phase 3 +public cam_run4 ! CAM run method phase 4 +public cam_final ! CAM Finalization + +type(dyn_import_t) :: dyn_in ! Dynamics import container +type(dyn_export_t) :: dyn_out ! Dynamics export container + +type(physics_state), pointer :: phys_state(:) => null() +type(physics_tend ), pointer :: phys_tend(:) => null() +type(physics_buffer_desc), pointer :: pbuf2d(:,:) => null() + +real(r8) :: dtime_phys ! Time step for physics tendencies. Set by call to + ! stepon_run1, then passed to the phys_run* + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +subroutine cam_init(EClock, & + caseid, ctitle, start_type, dart_mode, & + brnch_retain_casename, aqua_planet, & + single_column, scmlat, scmlon, & + eccen, obliqr, lambm0, mvelpp, & + perpetual_run, perpetual_ymd, model_doi_url, & + cam_out, cam_in) + + !----------------------------------------------------------------------- + ! + ! CAM component initialization. + ! + !----------------------------------------------------------------------- + + use history_defaults, only: bldfld + use cam_initfiles, only: cam_initfiles_open + use dyn_grid, only: dyn_grid_init + use phys_grid, only: phys_grid_init + use physpkg, only: phys_register, phys_init + use chem_surfvals, only: chem_surfvals_init + use dyn_comp, only: dyn_init + use cam_restart, only: cam_read_restart + use stepon, only: stepon_init + use ionosphere_interface, only: ionosphere_init + +#if (defined BFB_CAM_SCAM_IOP) + use history_defaults, only: initialize_iop_history +#endif + + use camsrfexch, only: hub2atm_alloc, atm2hub_alloc + use cam_history, only: intht + use history_scam, only: scm_intht + use cam_pio_utils, only: init_pio_subsystem + use cam_instance, only: inst_suffix + + ! Arguments + type(ESMF_Clock), intent(in) :: EClock + + character(len=cl), intent(in) :: caseid ! case ID + character(len=cl), intent(in) :: ctitle ! case title + character(len=cs), intent(in) :: start_type ! start type: initial, restart, or branch + logical, intent(in) :: dart_mode ! enables DART mode + logical, intent(in) :: brnch_retain_casename ! Flag to allow a branch to use the same + ! caseid as the run being branched from. + logical, intent(in) :: aqua_planet ! Flag to run model in "aqua planet" mode + + logical, intent(in) :: single_column + real(r8), intent(in) :: scmlat + real(r8), intent(in) :: scmlon + + real(r8), intent(in) :: eccen + real(r8), intent(in) :: obliqr + real(r8), intent(in) :: lambm0 + real(r8), intent(in) :: mvelpp + + logical, intent(in) :: perpetual_run ! true => perpetual mode enabled + integer, intent(in) :: perpetual_ymd ! Perpetual date (YYYYMMDD) + character(len=cl), intent(in) :: model_doi_url ! CESM model DOI + + type(cam_out_t), pointer :: cam_out(:) ! Output from CAM to surface + type(cam_in_t) , pointer :: cam_in(:) ! Merged input state to CAM + + ! Local variables + character(len=cs) :: filein ! Input namelist filename + character(len=cs) :: calendar ! Calendar type + integer :: dtime ! model timestep (sec) + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (sec) + integer :: curr_ymd ! Start date (YYYYMMDD) + integer :: curr_tod ! Start time of day (sec) + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! Reference time of day (sec) + !----------------------------------------------------------------------- + + call init_pio_subsystem() + + ! Initializations using data passed from coupler. + call cam_ctrl_init( & + caseid, ctitle, start_type, dart_mode, & + aqua_planet, brnch_retain_casename) + + call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + + ! Extract info from the eclock passed from coupler to initialize + ! the local time manager + call seq_timemgr_EClockGetData(EClock, & + start_ymd=start_ymd, start_tod=start_tod, & + ref_ymd=ref_ymd, ref_tod=ref_tod, & + stop_ymd=stop_ymd, stop_tod=stop_tod, & + curr_ymd=curr_ymd, curr_tod=curr_tod, & + dtime=dtime, calendar=calendar ) + + call timemgr_init( & + dtime, calendar, start_ymd, start_tod, ref_ymd, & + ref_tod, stop_ymd, stop_tod, curr_ymd, curr_tod, & + perpetual_run, perpetual_ymd, initial_run) + + ! Read CAM namelists. + filein = "atm_in" // trim(inst_suffix) + call read_namelist(filein, single_column, scmlat, scmlon) + + ! Open initial or restart file, and topo file if specified. + call cam_initfiles_open() + + ! Initialize grids and dynamics grid decomposition + call dyn_grid_init() + + ! Initialize physics grid decomposition + call phys_grid_init() + + ! Register advected tracers and physics buffer fields + call phys_register () + + ! Initialize ghg surface values before default initial distributions + ! are set in dyn_init + call chem_surfvals_init() + + ! initialize ionosphere + call ionosphere_init() + + if (initial_run) then + + call dyn_init(dyn_in, dyn_out) + + ! Allocate and setup surface exchange data + call atm2hub_alloc(cam_out) + call hub2atm_alloc(cam_in) + + else + + call cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, stop_ymd, stop_tod) + +#if (defined BFB_CAM_SCAM_IOP) + call initialize_iop_history() +#endif + end if + + call phys_init( phys_state, phys_tend, pbuf2d, cam_out ) + + call bldfld () ! master field list (if branch, only does hash tables) + + call stepon_init(dyn_in, dyn_out) + + call offline_driver_init() + + if (single_column) call scm_intht() + call intht(model_doi_url) + +end subroutine cam_init + +! +!----------------------------------------------------------------------- +! +subroutine cam_run1(cam_in, cam_out) +!----------------------------------------------------------------------- +! +! Purpose: First phase of atmosphere model run method. +! Runs first phase of dynamics and first phase of +! physics (before surface model updates). +! +!----------------------------------------------------------------------- + + use physpkg, only: phys_run1 + use stepon, only: stepon_run1 + use ionosphere_interface,only: ionosphere_run1 + + type(cam_in_t) :: cam_in(begchunk:endchunk) + type(cam_out_t) :: cam_out(begchunk:endchunk) + + !----------------------------------------------------------------------- + + if (offline_driver_dorun) return + + !---------------------------------------------------------- + ! First phase of dynamics (at least couple from dynamics to physics) + ! Return time-step for physics from dynamics. + !---------------------------------------------------------- + call t_barrierf ('sync_stepon_run1', mpicom) + call t_startf ('stepon_run1') + call stepon_run1( dtime_phys, phys_state, phys_tend, pbuf2d, dyn_in, dyn_out ) + call t_stopf ('stepon_run1') + + !---------------------------------------------------------- + ! first phase of ionosphere -- write to IC file if needed + !---------------------------------------------------------- + call ionosphere_run1(pbuf2d) + + ! + !---------------------------------------------------------- + ! PHYS_RUN Call the Physics package + !---------------------------------------------------------- + ! + call t_barrierf ('sync_phys_run1', mpicom) + call t_startf ('phys_run1') + call phys_run1(phys_state, dtime_phys, phys_tend, pbuf2d, cam_in, cam_out) + call t_stopf ('phys_run1') + +end subroutine cam_run1 + +! +!----------------------------------------------------------------------- +! + +subroutine cam_run2( cam_out, cam_in ) +!----------------------------------------------------------------------- +! +! Purpose: Second phase of atmosphere model run method. +! Run the second phase physics, run methods that +! require the surface model updates. And run the +! second phase of dynamics that at least couples +! between physics to dynamics. +! +!----------------------------------------------------------------------- + + use physpkg, only: phys_run2 + use stepon, only: stepon_run2 + use ionosphere_interface, only: ionosphere_run2 + + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + + if (offline_driver_dorun) then + call offline_driver_run( phys_state, pbuf2d, cam_out, cam_in ) + return + endif + + ! + ! Second phase of physics (after surface model update) + ! + call t_barrierf ('sync_phys_run2', mpicom) + call t_startf ('phys_run2') + call phys_run2(phys_state, dtime_phys, phys_tend, pbuf2d, cam_out, cam_in ) + call t_stopf ('phys_run2') + + ! + ! Second phase of dynamics (at least couple from physics to dynamics) + ! + call t_barrierf ('sync_stepon_run2', mpicom) + call t_startf ('stepon_run2') + call stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) + call t_stopf ('stepon_run2') + + ! + ! Ion transport + ! + call t_startf('ionosphere_run2') + call ionosphere_run2( phys_state, dyn_in, pbuf2d ) + call t_stopf ('ionosphere_run2') + + if (is_first_step() .or. is_first_restart_step()) then + call t_startf ('cam_run2_memusage') + call t_stopf ('cam_run2_memusage') + end if +end subroutine cam_run2 + +! +!----------------------------------------------------------------------- +! + +subroutine cam_run3( cam_out ) +!----------------------------------------------------------------------- +! +! Purpose: Third phase of atmosphere model run method. This consists +! of the third phase of the dynamics. For some dycores +! this will be the actual dynamics run, for others the +! dynamics happens before physics in phase 1. +! +!----------------------------------------------------------------------- + use stepon, only: stepon_run3 + + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) +!----------------------------------------------------------------------- + + if (offline_driver_dorun) return + + ! + ! Third phase of dynamics + ! + call t_barrierf ('sync_stepon_run3', mpicom) + call t_startf ('stepon_run3') + call stepon_run3( dtime_phys, cam_out, phys_state, dyn_in, dyn_out ) + + call t_stopf ('stepon_run3') + + if (is_first_step() .or. is_first_restart_step()) then + call t_startf ('cam_run3_memusage') + call t_stopf ('cam_run3_memusage') + end if +end subroutine cam_run3 + +! +!----------------------------------------------------------------------- +! + +subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & + yr_spec, mon_spec, day_spec, sec_spec ) + +!----------------------------------------------------------------------- +! +! Purpose: Final phase of atmosphere model run method. This consists +! of all the restart output, history writes, and other +! file output. +! +!----------------------------------------------------------------------- + use cam_history, only: wshist, wrapup + use cam_restart, only: cam_write_restart + use qneg_module, only: qneg_print_summary + use time_manager, only: is_last_step + + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t) , intent(inout) :: cam_in(begchunk:endchunk) + logical , intent(in) :: rstwr ! true => write restart file + logical , intent(in) :: nlend ! true => this is final timestep + integer , intent(in), optional :: yr_spec ! Simulation year + integer , intent(in), optional :: mon_spec ! Simulation month + integer , intent(in), optional :: day_spec ! Simulation day + integer , intent(in), optional :: sec_spec ! Seconds into current simulation day + + !---------------------------------------------------------- + ! History and restart logic: Write and/or dispose history tapes if required + !---------------------------------------------------------- + ! + call t_barrierf ('sync_wshist', mpicom) + call t_startf ('wshist') + call wshist () + call t_stopf ('wshist') + + ! + ! Write restart files + ! + if (rstwr) then + call t_startf ('cam_write_restart') + if (present(yr_spec).and.present(mon_spec).and.present(day_spec).and.present(sec_spec)) then + call cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + else + call cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d ) + end if + call t_stopf ('cam_write_restart') + end if + + call t_startf ('cam_run4_wrapup') + call wrapup(rstwr, nlend) + call t_stopf ('cam_run4_wrapup') + + call qneg_print_summary(is_last_step()) + + call shr_sys_flush(iulog) + +end subroutine cam_run4 + +! +!----------------------------------------------------------------------- +! + +subroutine cam_final( cam_out, cam_in ) +!----------------------------------------------------------------------- +! +! Purpose: CAM finalization. +! +!----------------------------------------------------------------------- + use stepon, only: stepon_final + use physpkg, only: phys_final + use cam_initfiles, only: cam_initfiles_close + use camsrfexch, only: atm2hub_deallocate, hub2atm_deallocate + use ionosphere_interface, only: ionosphere_final + + ! + ! Arguments + ! + type(cam_out_t), pointer :: cam_out(:) ! Output from CAM to surface + type(cam_in_t), pointer :: cam_in(:) ! Input from merged surface to CAM + + ! Local variables + integer :: nstep ! Current timestep number. + !----------------------------------------------------------------------- + + call phys_final( phys_state, phys_tend , pbuf2d) + call stepon_final(dyn_in, dyn_out) + call ionosphere_final() + + if (initial_run) then + call cam_initfiles_close() + end if + + call hub2atm_deallocate(cam_in) + call atm2hub_deallocate(cam_out) + + ! This flush attempts to ensure that asynchronous diagnostic prints from all + ! processes do not get mixed up with the "END OF MODEL RUN" message printed + ! by masterproc below. The test-model script searches for this message in the + ! output log to figure out if CAM completed successfully. + call shr_sys_flush( 0 ) ! Flush all output to standard error + call shr_sys_flush( iulog ) ! Flush all output to the CAM log file + + if (masterproc) then + nstep = get_nstep() + write(iulog,9300) nstep-1,nstep +9300 format (//'Number of completed timesteps:',i6,/,'Time step ',i6, & + ' partially done to provide convectively adjusted and ', & + 'time filtered values for history tape.') + write(iulog,*)' ' + write(iulog,*)'******* END OF MODEL RUN *******' + end if + +end subroutine cam_final + +!----------------------------------------------------------------------- + +end module cam_comp diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 new file mode 100644 index 0000000000..d26413c466 --- /dev/null +++ b/src/control/cam_control_mod.F90 @@ -0,0 +1,175 @@ +module cam_control_mod +!------------------------------------------------------------------------------------------------ +! +! High level control variables. Information received from the driver/coupler is +! stored here. +! +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8=>shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl +use seq_infodata_mod, only: seq_infodata_start_type_start, seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch + +use spmd_utils, only: masterproc +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +public +save + +! Public Routines: +! +! cam_ctrl_init +! cam_ctrl_set_orbit +! cam_ctrl_set_physics_type + +character(len=cl), protected :: caseid ! case ID +character(len=cl), protected :: ctitle ! case title + +logical, protected :: initial_run ! startup mode which only requires a minimal initial file +logical, protected :: restart_run ! continue a previous run; requires a restart file +logical, protected :: branch_run ! branch from a previous run; requires a restart file + +logical, protected :: adiabatic ! true => no physics +logical, protected :: ideal_phys ! true => run Held-Suarez (1994) physics +logical, protected :: kessler_phys ! true => run Kessler physics +logical, protected :: aqua_planet ! Flag to run model in "aqua planet" mode +logical, protected :: moist_physics ! true => moist physics enabled, i.e., + ! (.not. ideal_phys) .and. (.not. adiabatic) +logical, protected :: dart_mode ! Flag to run model with DART + +logical, protected :: brnch_retain_casename ! true => branch run may use same caseid as + ! the run being branched from + +real(r8), protected :: eccen ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) +real(r8), protected :: obliqr ! Earth's obliquity in radians +real(r8), protected :: lambm0 ! Mean longitude of perihelion at the + ! vernal equinox (radians) +real(r8), protected :: mvelpp ! Earth's moving vernal equinox longitude + ! of perihelion plus pi (radians) + +!================================================================================================ +contains +!================================================================================================ + +subroutine cam_ctrl_init( & + caseid_in, ctitle_in, start_type, dart_mode_in, & + aqua_planet_in, brnch_retain_casename_in) + + character(len=cl), intent(in) :: caseid_in ! case ID + character(len=cl), intent(in) :: ctitle_in ! case title + character(len=cs), intent(in) :: start_type ! start type: initial, restart, or branch + logical, intent(in) :: dart_mode_in ! Flag to run model with DART + logical, intent(in) :: aqua_planet_in ! Flag to run model in "aqua planet" mode + logical, intent(in) :: brnch_retain_casename_in ! Flag to allow a branch to use the same + ! caseid as the run being branched from. + + integer :: unitn, ierr + + character(len=*), parameter :: sub='cam_ctrl_init' + character(len=128) :: errmsg + !--------------------------------------------------------------------------------------------- + + caseid = caseid_in + ctitle = ctitle_in + dart_mode = dart_mode_in + + initial_run = .false. + restart_run = .false. + branch_run = .false. + if (dart_mode) then + initial_run = .true. + else + select case (trim(start_type)) + case (seq_infodata_start_type_start) + initial_run = .true. + case (seq_infodata_start_type_cont) + restart_run = .true. + case (seq_infodata_start_type_brnch) + branch_run = .true. + case default + write(errmsg,*) sub // ': FATAL: unknown start type: ', trim(start_type) + call endrun(errmsg) + end select + end if + + aqua_planet = aqua_planet_in + + brnch_retain_casename = brnch_retain_casename_in + + if (masterproc) then + write(iulog,*)' ' + write(iulog,*)' ------------------------------------------' + write(iulog,*)' *********** CAM LOG OUTPUT ***************' + write(iulog,*)' ------------------------------------------' + if (restart_run) then + write(iulog,*) ' Restart of an earlier run' + else if (branch_run) then + write(iulog,*) ' Branch of an earlier run' + else + if (dart_mode) then + write(iulog,*) ' DART run using CAM initial mode' + else + write(iulog,*) ' Initial run' + end if + end if + write(iulog,*) ' ********** CASE = ',trim(caseid),' **********' + write(iulog,'(1x,a)') ctitle + + + if (aqua_planet) write(iulog,*) 'Run model in "AQUA_PLANET" mode' + + end if + +end subroutine cam_ctrl_init + +!-------------------------------------------------------------------------------------------------- + +subroutine cam_ctrl_set_orbit(eccen_in, obliqr_in, lambm0_in, mvelpp_in) + + real(r8), intent(in) :: eccen_in + real(r8), intent(in) :: obliqr_in + real(r8), intent(in) :: lambm0_in + real(r8), intent(in) :: mvelpp_in + + eccen = eccen_in + obliqr = obliqr_in + lambm0 = lambm0_in + mvelpp = mvelpp_in + +end subroutine cam_ctrl_set_orbit + +subroutine cam_ctrl_set_physics_type(phys_package) + ! Dummy argument + character(len=*), intent(in) :: phys_package + ! Local variable + character(len=*), parameter :: subname = 'cam_ctrl_set_physics_type' + + adiabatic = trim(phys_package) == 'adiabatic' + ideal_phys = trim(phys_package) == 'held_suarez' + kessler_phys = trim(phys_package) == 'kessler' + moist_physics = .not. (adiabatic .or. ideal_phys) + if (adiabatic .and. ideal_phys) then + call endrun (subname//': FATAL: Only one of ADIABATIC or HELD_SUAREZ can be .true.') + end if + + if ((.not. moist_physics) .and. aqua_planet) then + call endrun (subname//': FATAL: AQUA_PLANET not compatible with dry physics package, ('//trim(phys_package)//')') + end if + + if (masterproc) then + if (adiabatic) then + write(iulog,*) 'Run model ADIABATICALLY (i.e. no physics)' + end if + if (ideal_phys) then + write(iulog,*) 'Run model with Held-Suarez physics forcing' + end if + if (kessler_phys) then + write(iulog,*) 'Run model with Kessler physics forcing' + end if + end if + +end subroutine cam_ctrl_set_physics_type + +end module cam_control_mod diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 new file mode 100644 index 0000000000..354ee2fdd1 --- /dev/null +++ b/src/control/cam_history.F90 @@ -0,0 +1,5863 @@ +module cam_history + !------------------------------------------------------------------------------------------- + ! + ! The cam_history module provides the user interface for CAM's history output capabilities. + ! It maintains the lists of fields that are written to each history file, and the associated + ! metadata for those fields such as descriptive names, physical units, time axis properties, + ! etc. It also contains the programmer interface which provides routines that are called from + ! the physics and dynamics initialization routines to define the fields that are produced by + ! the model and are available for output, and the routine that is called from the corresponding + ! run method to add the field values into a history buffer so that they may be output to disk. + ! + ! There are two special history files. The initial file and the satellite track file. + ! + ! Public functions/subroutines: + ! addfld, add_default + ! intht + ! history_initialized + ! write_restart_history + ! read_restart_history + ! outfld + ! wshist + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use shr_kind_mod, only: cl=>SHR_KIND_CL + use shr_sys_mod, only: shr_sys_flush + use spmd_utils, only: masterproc + use ppgrid, only: pcols, psubcols + use cam_instance, only: inst_suffix + use cam_control_mod, only: caseid, ctitle + use filenames, only: interpret_filename_spec + use cam_initfiles, only: ncdata, bnd_topo + use cam_abortutils, only: endrun + + use pio, only: file_desc_t, var_desc_t, pio_setframe, pio_write, & + pio_noerr, pio_bcast_error, pio_internal_error, & + pio_seterrorhandling, pio_get_var, pio_clobber, & + pio_int, pio_real, pio_double, pio_char, & + pio_offset_kind, pio_unlimited, pio_global, & + pio_inq_dimlen, pio_def_var, pio_enddef, & + pio_put_att, pio_put_var, pio_get_att + + + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + use cam_history_support, only: max_fieldname_len, fieldname_suffix_len, & + max_chars, ptapes, fieldname_len, & + max_string_len, date2yyyymmdd, pflds, & + fieldname_lenp2, sec2hms, & + field_info, active_entry, hentry, & + horiz_only, write_hist_coord_attrs, & + write_hist_coord_vars, interp_info_t, & + lookup_hist_coord_indices, get_hist_coord_index + use sat_hist, only: is_satfile + use solar_parms_data, only: solar_parms_on, kp=>solar_parms_kp, ap=>solar_parms_ap + use solar_parms_data, only: f107=>solar_parms_f107, f107a=>solar_parms_f107a, f107p=>solar_parms_f107p + + implicit none + private + save + + ! Forward common parameters to present unified interface to cam_history + public :: fieldname_len, horiz_only + + ! + ! master_entry: elements of an entry in the master field list + ! + type master_entry + type (field_info) :: field ! field information + character(len=max_fieldname_len) :: meridional_field = '' ! for vector fields + character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields + character(len=1) :: avgflag(ptapes) ! averaging flag + character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) + logical :: act_sometape ! Field is active on some tape + logical :: actflag(ptapes) ! Per tape active/inactive flag + integer :: htapeindx(ptapes)! This field's index on particular history tape + type(master_entry), pointer :: next_entry => null() ! The next master entry + end type master_entry + + type (master_entry), pointer :: masterlinkedlist => null() ! master field linkedlist top + + type master_list + type(master_entry), pointer :: thisentry => null() + end type master_list + + type (master_list), pointer :: masterlist(:) => null() ! master field array for hash lookup of field + + ! history tape info + type (active_entry), pointer :: tape(:) => null() ! history tapes + type (active_entry), target,allocatable :: history_tape(:) ! history tapes + type (active_entry), target, allocatable :: restarthistory_tape(:) ! restart history tapes + + type rvar_id + type(var_desc_t), pointer :: vdesc => null() + integer :: type + integer :: ndims + integer :: dims(4) + character(len=fieldname_lenp2) :: name + end type rvar_id + type rdim_id + integer :: len + integer :: dimid + character(len=fieldname_lenp2) :: name + end type rdim_id + ! + ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below + ! + integer, parameter :: restartvarcnt = 38 + integer, parameter :: restartdimcnt = 10 + type(rvar_id) :: restartvars(restartvarcnt) + type(rdim_id) :: restartdims(restartdimcnt) + integer, parameter :: ptapes_dim_ind = 1 + integer, parameter :: max_string_len_dim_ind = 2 + integer, parameter :: fieldname_lenp2_dim_ind = 3 + integer, parameter :: pflds_dim_ind = 4 + integer, parameter :: max_chars_dim_ind = 5 + integer, parameter :: max_fieldname_len_dim_ind = 6 + integer, parameter :: maxnflds_dim_ind = 7 + integer, parameter :: maxvarmdims_dim_ind = 8 + integer, parameter :: registeredmdims_dim_ind = 9 + integer, parameter :: max_hcoordname_len_dim_ind = 10 + + integer :: nfmaster = 0 ! number of fields in master field list + integer :: nflds(ptapes) ! number of fields per tape + + ! per tape sampling frequency (0=monthly avg) + + integer :: idx ! index for nhtfrq initialization + integer :: nhtfrq(ptapes) = (/0, (-24, idx=2,ptapes)/) ! history write frequency (0 = monthly) + integer :: mfilt(ptapes) = 30 ! number of time samples per tape + integer :: nfils(ptapes) ! Array of no. of files on current h-file + integer :: ndens(ptapes) = 2 ! packing density (double (1) or real (2)) + integer :: ncprec(ptapes) = -999 ! netcdf packing parameter based on ndens + real(r8) :: beg_time(ptapes) ! time at beginning of an averaging interval + + logical :: rgnht(ptapes) = .false. ! flag array indicating regeneration volumes + logical :: hstwr(ptapes) = .false. ! Flag for history writes + logical :: empty_htapes = .false. ! Namelist flag indicates no default history fields + logical :: htapes_defined = .false. ! flag indicates history contents have been defined + + character(len=cl) :: model_doi_url = '' ! Model DOI + ! NB: This name must match the group name in namelist_definition.xml + character(len=*), parameter :: history_namelist = 'cam_history_nl' + character(len=max_string_len) :: hrestpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Full history restart pathnames + character(len=max_string_len) :: nfpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Array of first pathnames, for header + character(len=max_string_len) :: cpath(ptapes) ! Array of current pathnames + character(len=max_string_len) :: nhfil(ptapes) ! Array of current file names + character(len=1) :: avgflag_pertape(ptapes) = (/(' ',idx=1,ptapes)/) ! per tape averaging flag + character(len=16) :: logname ! user name + character(len=16) :: host ! host name + character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or + ! 'YEARLY' then write IC file + logical :: inithist_all = .false. ! Flag to indicate set of fields to be + ! included on IC file + ! .false. include only required fields + ! .true. include required *and* optional fields + character(len=fieldname_lenp2) :: fincl(pflds,ptapes) ! List of fields to add to primary h-file + character(len=max_chars) :: fincllonlat(pflds,ptapes) ! List of fields to add to primary h-file + character(len=fieldname_lenp2) :: fexcl(pflds,ptapes) ! List of fields to rm from primary h-file + character(len=fieldname_lenp2) :: fwrtpr(pflds,ptapes) ! List of fields to change default history output prec + character(len=fieldname_suffix_len ) :: fieldname_suffix = '&IC' ! Suffix appended to field names for IC file + + ! Parameters for interpolated output tapes + logical, public :: interpolate_output(ptapes) = .false. + ! The last two history files are not supported for interpolation + type(interp_info_t) :: interpolate_info(ptapes - 2) + + ! Allowed history averaging flags + ! This should match namelist_definition.xml => avgflag_pertape (+ ' ') + ! The presence of 'ABI' and 'XML' in this string is a coincidence + character(len=7), parameter :: HIST_AVG_FLAGS = ' ABIXML' + character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description + logical :: collect_column_output(ptapes) + + integer :: maxvarmdims=1 + ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Hashing. + ! + ! Accelerate outfld processing by using a hash function of the field name + ! to index masterlist and determine whehter the particular field is to + ! be written to any history tape. + ! + ! + ! Note: the outfld hashing logic will fail if any of the following are true: + ! + ! 1) The lower bound on the dimension of 'masterlist' is less than 1. + ! + ! 2) 'outfld' is called with field names that are not defined on + ! masterlist. This applies to both initial/branch and restart + ! runs. + ! + ! 3) An inconsistency between a field's tape active flag + ! 'masterlist(ff)%actflag(t)' and active fields read from + ! restart files. + ! + ! 4) Invoking function 'gen_hash_key' before the primary and secondary + ! hash tables have been created (routine bld_outfld_hash_tbls). + ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! + ! User definable constants for hash and overflow tables. + ! Define size of primary hash table (specified as 2**size). + ! + integer, parameter :: tbl_hash_pri_sz_lg2 = 16 + ! + ! Define size of overflow hash table % of primary hash table. + ! + integer, parameter :: tbl_hash_oflow_percent = 20 + ! + ! Do *not* modify the parameters below. + ! + integer, parameter :: tbl_hash_pri_sz = 2**tbl_hash_pri_sz_lg2 + integer, parameter :: tbl_hash_oflow_sz = tbl_hash_pri_sz * (tbl_hash_oflow_percent/100.0_r8) + ! + ! The primary and overflow tables are organized to mimimize space (read: + ! try to maximimze cache line usage). + ! + ! gen_hash_key(fieldname) will return an index on the interval + ! [0 ... tbl_hash_pri_sz-1]. + ! + ! + ! Primary: + ! gen_hash_key(fieldname)-------+ +----------+ + ! | | -ii | 1 ------>tbl_hash_oflow(ii) + ! | +----------+ + ! +--> | ff | 2 ------>masterlist(ff) + ! +----------+ + ! | | ... + ! +----------+ + ! | | tbl_hash_pri_sz + ! +----------+ + ! + ! Overflow (if tbl_hash_pri() < 0): + ! tbl_hash_pri(gen_hash_key(fieldname)) + ! | + ! | +----------+ + ! | | 1 | 1 (one entry on O.F. chain) + ! | +----------+ + ! | | ff_m | 2 + ! | +----------+ + ! +---------> | 3 | 3 (three entries on chain) + ! +----------+ + ! | ff_x | 4 + ! +----------+ + ! | ff_y | 5 + ! +----------+ + ! | ff_z | 6 + ! +----------+ + ! | | ... + ! +----------+ + ! | | tbl_hash_oflow_sz + ! +----------+ + ! + ! + integer, dimension(0:tbl_hash_pri_sz-1) :: tbl_hash_pri ! Primary hash table + integer, dimension(tbl_hash_oflow_sz) :: tbl_hash_oflow ! Overflow hash table + ! + ! Constants used in hashing function gen_hash_key. + ! Note: if the constants in table 'tbl_gen_hash_key' below are modified, + ! changes are required to routine 'gen_hash_key' because of specific + ! logic in the routine that optimizes character strings of length 8. + ! + + integer, parameter :: gen_hash_key_offset = z'000053db' + + integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 + integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = & + (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) + + ! + ! Filename specifiers for history, initial files and restart history files + ! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = tape number) + ! + character(len=max_string_len) :: rhfilename_spec = '%c.cam.rh%t.%y-%m-%d-%s.nc' ! history restart + character(len=max_string_len) :: hfilename_spec(ptapes) = (/ (' ', idx=1, ptapes) /) ! filename specifyer + + + interface addfld + module procedure addfld_1d + module procedure addfld_nd + end interface + + ! Needed by cam_diagnostics + public :: inithist_all + + integer :: lcltod_start(ptapes) ! start time of day for local time averaging (sec) + integer :: lcltod_stop(ptapes) ! stop time of day for local time averaging, stop > start is wrap around (sec) + + ! Needed by stepon and cam_restart + public :: hstwr + public :: nfils, mfilt + + ! Functions + public :: history_readnl ! Namelist reader for CAM history + public :: init_restart_history ! Write restart history data + public :: write_restart_history ! Write restart history data + public :: read_restart_history ! Read restart history data + public :: wshist ! Write files out + public :: outfld ! Output a field + public :: intht ! Initialization + public :: history_initialized ! .true. iff cam history initialized + public :: wrapup ! process history files at end of run + public :: write_inithist ! logical flag to allow dump of IC history buffer to IC file + public :: addfld ! Add a field to history file + public :: add_default ! Add the default fields + public :: register_vector_field ! Register vector field set for interpolated output + public :: get_hfilepath ! Return history filename + public :: get_ptapes ! Return the number of tapes being used + public :: get_hist_restart_filepath ! Return the full filepath to the history restart file + public :: hist_fld_active ! Determine if a field is active on any history file + public :: hist_fld_col_active ! Determine if a field is active on any history file at + ! each column in a chunk + +CONTAINS + + subroutine intht (model_doi_url_in) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Initialize history file handler for initial or continuation run. + ! For example, on an initial run, this routine initializes "ptapes" + ! history files. On a restart or regeneration run, this routine + ! only initializes history files declared beyond what existed on the + ! previous run. Files which already existed on the previous run have + ! already been initialized (i.e. named and opened) in routine RESTRT. + ! + ! Method: Loop over tapes and fields per tape setting appropriate variables and + ! calling appropriate routines + ! + ! Author: CCM Core Group + ! + !----------------------------------------------------------------------- + use shr_sys_mod, only: shr_sys_getenv + use time_manager, only: get_prev_time, get_curr_time + use cam_control_mod, only: restart_run, branch_run + use sat_hist, only: sat_hist_init + use spmd_utils, only: mpicom, masterprocid, mpi_character + ! + !----------------------------------------------------------------------- + ! + ! Dummy argument + ! + character(len=cl), intent(in) :: model_doi_url_in + ! + ! Local workspace + ! + integer :: t, f ! tape, field indices + integer :: begdim1 ! on-node dim1 start index + integer :: enddim1 ! on-node dim1 end index + integer :: begdim2 ! on-node dim2 start index + integer :: enddim2 ! on-node dim2 end index + integer :: begdim3 ! on-node chunk or lat start index + integer :: enddim3 ! on-node chunk or lat end index + integer :: day, sec ! day and seconds from base date + integer :: rcode ! shr_sys_getenv return code + type(master_entry), pointer :: listentry + character(len=32) :: fldname ! temp variable used to produce a left justified field name + ! in the formatted logfile output + + ! + ! Save the DOI + ! + model_doi_url = trim(model_doi_url_in) + + ! + ! Print master field list + ! + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*)' ******* MASTER FIELD LIST *******' + end if + listentry=>masterlinkedlist + f=0 + do while(associated(listentry)) + f=f+1 + if(masterproc) then + fldname = listentry%field%name + write(iulog,9000) f, fldname, listentry%field%units, listentry%field%numlev, & + listentry%avgflag(1), trim(listentry%field%long_name) +9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, a) + end if + listentry=>listentry%next_entry + end do + nfmaster = f + if(masterproc) write(iulog,*)'intht:nfmaster=',nfmaster + + ! + ! Now that masterlinkedlist is defined and we are performing a restart run + ! (after all addfld calls), construct primary and secondary hashing tables. + ! + if (restart_run) then + call print_active_fldlst() + call bld_outfld_hash_tbls() + call bld_htapefld_indices() + return + end if + ! + ! Get users logname and machine hostname + ! + if ( masterproc )then + logname = ' ' + call shr_sys_getenv ('LOGNAME',logname,rcode) + host = ' ' + call shr_sys_getenv ('HOST',host,rcode) + end if + ! PIO requires netcdf attributes have consistant values on all tasks + call mpi_bcast(logname, len(logname), mpi_character, masterprocid, mpicom, rcode) + call mpi_bcast(host, len(host), mpi_character, masterprocid, mpicom, rcode) + ! + ! Override averaging flag for all fields on a particular tape if namelist input so specifies + ! + do t=1,ptapes + if (avgflag_pertape(t) /= ' ') then + call h_override (t) + end if + end do + ! + ! Define field list information for all history files. + ! + call fldlst () + ! + ! Loop over max. no. of history files permitted + ! + if (branch_run) then + call get_prev_time(day, sec) ! elapased time since reference date + else + call get_curr_time(day, sec) ! elapased time since reference date + end if + do t=1,ptapes + nfils(t) = 0 ! no. of time samples in hist. file no. t + + ! Time at beginning of current averaging interval. + + beg_time(t) = day + sec/86400._r8 + end do + + ! + ! Initialize history variables + ! + do t=1,ptapes + do f=1,nflds(t) + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(f)%hbuf = 0._r8 + if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(f)%sbuf = 0._r8 + endif + if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then + allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + else + allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + end if + tape(t)%hlist(f)%nacs(:,:) = 0 + tape(t)%hlist(f)%field%meridional_complement = -1 + tape(t)%hlist(f)%field%zonal_complement = -1 + end do + end do + ! Setup vector pairs for unstructured grid interpolation + call setup_interpolation_and_define_vector_complements() + ! Initialize the sat following history subsystem + call sat_hist_init() + + return + end subroutine intht + + logical function history_initialized() + history_initialized = associated(masterlist) + end function history_initialized + + subroutine history_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character + use shr_string_mod, only: shr_string_toUpper + use time_manager, only: get_step_size + use sat_hist, only: sat_hist_readnl + + ! Dummy argument + character(len=*), intent(in) :: nlfile ! filepath of namelist input file + + ! + ! Local variables + integer :: dtime ! Step time in seconds + integer :: unitn, ierr, f, t + character(len=8) :: ctemp ! Temporary character string + + character(len=fieldname_lenp2) :: fincl1(pflds) + character(len=fieldname_lenp2) :: fincl2(pflds) + character(len=fieldname_lenp2) :: fincl3(pflds) + character(len=fieldname_lenp2) :: fincl4(pflds) + character(len=fieldname_lenp2) :: fincl5(pflds) + character(len=fieldname_lenp2) :: fincl6(pflds) + character(len=fieldname_lenp2) :: fincl7(pflds) + character(len=fieldname_lenp2) :: fincl8(pflds) + character(len=fieldname_lenp2) :: fincl9(pflds) + character(len=fieldname_lenp2) :: fincl10(pflds) + + character(len=max_chars) :: fincl1lonlat(pflds) + character(len=max_chars) :: fincl2lonlat(pflds) + character(len=max_chars) :: fincl3lonlat(pflds) + character(len=max_chars) :: fincl4lonlat(pflds) + character(len=max_chars) :: fincl5lonlat(pflds) + character(len=max_chars) :: fincl6lonlat(pflds) + character(len=max_chars) :: fincl7lonlat(pflds) + character(len=max_chars) :: fincl8lonlat(pflds) + character(len=max_chars) :: fincl9lonlat(pflds) + character(len=max_chars) :: fincl10lonlat(pflds) + + character(len=fieldname_len) :: fexcl1(pflds) + character(len=fieldname_len) :: fexcl2(pflds) + character(len=fieldname_len) :: fexcl3(pflds) + character(len=fieldname_len) :: fexcl4(pflds) + character(len=fieldname_len) :: fexcl5(pflds) + character(len=fieldname_len) :: fexcl6(pflds) + character(len=fieldname_len) :: fexcl7(pflds) + character(len=fieldname_len) :: fexcl8(pflds) + character(len=fieldname_len) :: fexcl9(pflds) + character(len=fieldname_len) :: fexcl10(pflds) + + character(len=fieldname_lenp2) :: fwrtpr1(pflds) + character(len=fieldname_lenp2) :: fwrtpr2(pflds) + character(len=fieldname_lenp2) :: fwrtpr3(pflds) + character(len=fieldname_lenp2) :: fwrtpr4(pflds) + character(len=fieldname_lenp2) :: fwrtpr5(pflds) + character(len=fieldname_lenp2) :: fwrtpr6(pflds) + character(len=fieldname_lenp2) :: fwrtpr7(pflds) + character(len=fieldname_lenp2) :: fwrtpr8(pflds) + character(len=fieldname_lenp2) :: fwrtpr9(pflds) + character(len=fieldname_lenp2) :: fwrtpr10(pflds) + + integer :: interpolate_nlat(size(interpolate_info)) + integer :: interpolate_nlon(size(interpolate_info)) + integer :: interpolate_gridtype(size(interpolate_info)) + integer :: interpolate_type(size(interpolate_info)) + + ! History namelist items + namelist /cam_history_nl/ ndens, nhtfrq, mfilt, inithist, inithist_all, & + avgflag_pertape, empty_htapes, lcltod_start, lcltod_stop, & + fincl1lonlat, fincl2lonlat, fincl3lonlat, fincl4lonlat, fincl5lonlat, & + fincl6lonlat, fincl7lonlat, fincl8lonlat, fincl9lonlat, & + fincl10lonlat, collect_column_output, hfilename_spec, & + fincl1, fincl2, fincl3, fincl4, fincl5, & + fincl6, fincl7, fincl8, fincl9, fincl10, & + fexcl1, fexcl2, fexcl3, fexcl4, fexcl5, & + fexcl6, fexcl7, fexcl8, fexcl9, fexcl10, & + fwrtpr1, fwrtpr2, fwrtpr3, fwrtpr4, fwrtpr5, & + fwrtpr6, fwrtpr7, fwrtpr8, fwrtpr9, fwrtpr10, & + interpolate_nlat, interpolate_nlon, & + interpolate_gridtype, interpolate_type, interpolate_output + + ! Set namelist defaults (these should match initial values if given) + fincl(:,:) = ' ' + fincllonlat(:,:) = ' ' + fexcl(:,:) = ' ' + fwrtpr(:,:) = ' ' + collect_column_output(:) = .false. + avgflag_pertape(:) = ' ' + ndens = 2 + nhtfrq(1) = 0 + nhtfrq(2:) = -24 + mfilt = 30 + inithist = 'YEARLY' + inithist_all = .false. + empty_htapes = .false. + lcltod_start(:) = 0 + lcltod_stop(:) = 0 + hfilename_spec(:) = ' ' + interpolate_nlat(:) = 0 + interpolate_nlon(:) = 0 + interpolate_gridtype(:) = 1 + interpolate_type(:) = 1 + interpolate_output(:) = .false. + + ! Initialize namelist 'temporary variables' + do f = 1, pflds + fincl1(f) = ' ' + fincl2(f) = ' ' + fincl3(f) = ' ' + fincl4(f) = ' ' + fincl5(f) = ' ' + fincl6(f) = ' ' + fincl7(f) = ' ' + fincl8(f) = ' ' + fincl9(f) = ' ' + fincl10(f) = ' ' + fincl1lonlat(f) = ' ' + fincl2lonlat(f) = ' ' + fincl3lonlat(f) = ' ' + fincl4lonlat(f) = ' ' + fincl5lonlat(f) = ' ' + fincl6lonlat(f) = ' ' + fincl7lonlat(f) = ' ' + fincl8lonlat(f) = ' ' + fincl9lonlat(f) = ' ' + fincl10lonlat(f) = ' ' + fexcl1(f) = ' ' + fexcl2(f) = ' ' + fexcl3(f) = ' ' + fexcl4(f) = ' ' + fexcl5(f) = ' ' + fexcl6(f) = ' ' + fexcl7(f) = ' ' + fexcl8(f) = ' ' + fexcl9(f) = ' ' + fexcl10(f) = ' ' + fwrtpr1(f) = ' ' + fwrtpr2(f) = ' ' + fwrtpr3(f) = ' ' + fwrtpr4(f) = ' ' + fwrtpr5(f) = ' ' + fwrtpr6(f) = ' ' + fwrtpr7(f) = ' ' + fwrtpr8(f) = ' ' + fwrtpr9(f) = ' ' + fwrtpr10(f) = ' ' + end do + + if (trim(history_namelist) /= 'cam_history_nl') then + call endrun('HISTORY_READNL: CAM history namelist mismatch') + end if + if (masterproc) then + write(iulog, *) 'Read in ',history_namelist,' namelist from: ',trim(nlfile) + unitn = getunit() + open(unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, history_namelist, status=ierr) + if (ierr == 0) then + read(unitn, cam_history_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('history_readnl: ERROR reading namelist, '//trim(history_namelist)) + end if + end if + close(unitn) + call freeunit(unitn) + + do f = 1, pflds + fincl(f, 1) = fincl1(f) + fincl(f, 2) = fincl2(f) + fincl(f, 3) = fincl3(f) + fincl(f, 4) = fincl4(f) + fincl(f, 5) = fincl5(f) + fincl(f, 6) = fincl6(f) + fincl(f, 7) = fincl7(f) + fincl(f, 8) = fincl8(f) + fincl(f, 9) = fincl9(f) + fincl(f,10) = fincl10(f) + + fincllonlat(f, 1) = fincl1lonlat(f) + fincllonlat(f, 2) = fincl2lonlat(f) + fincllonlat(f, 3) = fincl3lonlat(f) + fincllonlat(f, 4) = fincl4lonlat(f) + fincllonlat(f, 5) = fincl5lonlat(f) + fincllonlat(f, 6) = fincl6lonlat(f) + fincllonlat(f, 7) = fincl7lonlat(f) + fincllonlat(f, 8) = fincl8lonlat(f) + fincllonlat(f, 9) = fincl9lonlat(f) + fincllonlat(f,10) = fincl10lonlat(f) + + fexcl(f, 1) = fexcl1(f) + fexcl(f, 2) = fexcl2(f) + fexcl(f, 3) = fexcl3(f) + fexcl(f, 4) = fexcl4(f) + fexcl(f, 5) = fexcl5(f) + fexcl(f, 6) = fexcl6(f) + fexcl(f, 7) = fexcl7(f) + fexcl(f, 8) = fexcl8(f) + fexcl(f, 9) = fexcl9(f) + fexcl(f,10) = fexcl10(f) + + fwrtpr(f, 1) = fwrtpr1(f) + fwrtpr(f, 2) = fwrtpr2(f) + fwrtpr(f, 3) = fwrtpr3(f) + fwrtpr(f, 4) = fwrtpr4(f) + fwrtpr(f, 5) = fwrtpr5(f) + fwrtpr(f, 6) = fwrtpr6(f) + fwrtpr(f, 7) = fwrtpr7(f) + fwrtpr(f, 8) = fwrtpr8(f) + fwrtpr(f, 9) = fwrtpr9(f) + fwrtpr(f,10) = fwrtpr10(f) + end do + + ! + ! If generate an initial conditions history file as an auxillary tape: + ! + ctemp = shr_string_toUpper(inithist) + inithist = trim(ctemp) + if ( (inithist /= '6-HOURLY') .and. (inithist /= 'DAILY') .and. & + (inithist /= 'MONTHLY') .and. (inithist /= 'YEARLY') .and. & + (inithist /= 'CAMIOP') .and. (inithist /= 'ENDOFRUN')) then + inithist = 'NONE' + end if + ! + ! History file write times + ! Convert write freq. of hist files from hours to timesteps if necessary. + ! + dtime = get_step_size() + do t = 1, ptapes + if (nhtfrq(t) < 0) then + nhtfrq(t) = nint((-nhtfrq(t) * 3600._r8) / dtime) + end if + end do + ! + ! Initialize the filename specifier if not already set + ! This is the format for the history filenames: + ! %c= caseid, %t=tape no., %y=year, %m=month, %d=day, %s=second, %%=% + ! See the filenames module for more information + ! + do t = 1, ptapes + if ( len_trim(hfilename_spec(t)) == 0 )then + if ( nhtfrq(t) == 0 )then + ! Monthly files + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m.nc' + else + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m-%d-%s.nc' + end if + end if + ! + ! Only one time sample allowed per monthly average file + ! + if (nhtfrq(t) == 0) then + mfilt(t) = 1 + end if + end do + end if ! masterproc + + ! Print per-tape averaging flags + if (masterproc) then + do t = 1, ptapes + if (avgflag_pertape(t) /= ' ') then + write(iulog,*)'Unless overridden by namelist input on a per-field basis (FINCL),' + write(iulog,*)'All fields on history file ',t,' will have averaging flag ',avgflag_pertape(t) + end if + ! Enforce no interpolation for satellite files + if (is_satfile(t) .and. interpolate_output(t)) then + write(iulog, *) 'WARNING: Interpolated output not supported for a satellite history file, ignored' + interpolate_output(t) = .false. + end if + ! Enforce no interpolation for IC files + if (is_initfile(t) .and. interpolate_output(t)) then + write(iulog, *) 'WARNING: Interpolated output not supported for an initial data (IC) history file, ignored' + interpolate_output(t) = .false. + end if + end do + end if + + ! Write out inithist info + if (masterproc) then + if (inithist == '6-HOURLY' ) then + write(iulog,*)'Initial conditions history files will be written 6-hourly.' + else if (inithist == 'DAILY' ) then + write(iulog,*)'Initial conditions history files will be written daily.' + else if (inithist == 'MONTHLY' ) then + write(iulog,*)'Initial conditions history files will be written monthly.' + else if (inithist == 'YEARLY' ) then + write(iulog,*)'Initial conditions history files will be written yearly.' + else if (inithist == 'CAMIOP' ) then + write(iulog,*)'Initial conditions history files will be written for IOP.' + else if (inithist == 'ENDOFRUN' ) then + write(iulog,*)'Initial conditions history files will be written at end of run.' + else + write(iulog,*)'Initial conditions history files will not be created' + end if + end if + + ! Print out column-output information + do t = 1, size(fincllonlat, 2) + if (ANY(len_trim(fincllonlat(:,t)) > 0)) then + if (collect_column_output(t)) then + write(iulog, '(a,i2,a)') 'History file, ',t,', has patch output, columns will be collected into ncol dimension' + else + write(iulog, '(a,i2,a)') 'History file, ',t,', has patch output, patches will be written to individual variables' + end if + end if + end do + + ! Broadcast namelist variables + call mpi_bcast(ndens, ptapes, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(nhtfrq, ptapes, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(mfilt, ptapes, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(inithist,len(inithist), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(inithist_all,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(lcltod_start, ptapes, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(lcltod_stop, ptapes, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(collect_column_output, ptapes, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(empty_htapes,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(avgflag_pertape, ptapes, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(hfilename_spec, len(hfilename_spec(1))*ptapes, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(fincl, len(fincl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(fexcl, len(fexcl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) + + call mpi_bcast(fincllonlat, len(fincllonlat (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) + + call mpi_bcast(fwrtpr, len(fwrtpr(1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) + t = size(interpolate_nlat, 1) + call mpi_bcast(interpolate_nlat, t, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(interpolate_nlon, t, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(interpolate_gridtype, t, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(interpolate_type, t, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(interpolate_output, ptapes, mpi_logical, masterprocid, mpicom, ierr) + + ! Setup the interpolate_info structures + do t = 1, size(interpolate_info) + interpolate_info(t)%interp_type = interpolate_type(t) + interpolate_info(t)%interp_gridtype = interpolate_gridtype(t) + interpolate_info(t)%interp_nlat = interpolate_nlat(t) + interpolate_info(t)%interp_nlon = interpolate_nlon(t) + end do + + ! separate namelist reader for the satellite history file + call sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) + + end subroutine history_readnl + +!================================================================================================== + + subroutine set_field_dimensions(field) + use cam_history_support, only: hist_coord_size + use cam_grid_support, only: cam_grid_get_array_bounds, cam_grid_is_block_indexed + ! Dummy arguments + type(field_info), intent(inout) :: field + + ! Local variables + integer :: i + integer :: msize + integer :: dimbounds(2,2) + + call cam_grid_get_array_bounds(field%decomp_type, dimbounds) + field%begdim1 = dimbounds(1,1) + field%enddim1 = dimbounds(1,2) + field%begdim2 = 1 + if (associated(field%mdims)) then + if (size(field%mdims) > 0) then + field%enddim2 = 1 + do i = 1, size(field%mdims) + msize = hist_coord_size(field%mdims(i)) + if (msize <= 0) then + call endrun('set_field_dimensions: mdim size must be > 0') + end if + field%enddim2 = field%enddim2 * msize + end do + else + if (field%numlev < 1) then + if (masterproc) then + write(iulog, *) 'SET_FIELD_DIMENSIONS WARNING: illegal numlev for ', trim(field%name) + end if + field%numlev = 1 + end if + field%enddim2 = field%numlev + end if + else + if (field%numlev < 1) then + if (masterproc) then + write(iulog, *) 'SET_FIELD_DIMENSIONS WARNING: illegal numlev for ', trim(field%name) + end if + field%numlev = 1 + end if + field%enddim2 = field%numlev + end if + field%begdim3 = dimbounds(2,1) + field%enddim3 = dimbounds(2,2) + field%colperchunk = cam_grid_is_block_indexed(field%decomp_type) + + end subroutine set_field_dimensions + + subroutine setup_interpolation_and_define_vector_complements() + use interp_mod, only: setup_history_interpolation + + ! Local variables + integer :: hf, f, ff + logical :: interp_ok + character(len=max_fieldname_len) :: mname + character(len=max_fieldname_len) :: zname + character(len=*), parameter :: subname='setup_interpolation_and_define_vector_complements' + + ! Do not interpolate IC history and sat hist files + if (any(interpolate_output)) then + call setup_history_interpolation(interp_ok, ptapes-2, & + interpolate_output, interpolate_info) + do hf = 1, ptapes - 2 + if((.not. is_satfile(hf)) .and. (.not. is_initfile(hf))) then + do f = 1, nflds(hf) + if (field_part_of_vector(trim(tape(hf)%hlist(f)%field%name), & + mname, zname)) then + if (len_trim(mname) > 0) then + ! This field is a zonal part of a set, find the meridional partner + do ff = 1, nflds(hf) + if (trim(mname) == trim(tape(hf)%hlist(ff)%field%name)) then + tape(hf)%hlist(f)%field%meridional_complement = ff + tape(hf)%hlist(ff)%field%zonal_complement = f + exit + end if + if (ff == nflds(hf)) then + call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(f)%field%name)) + end if + end do + else if (len_trim(zname) > 0) then + ! This field is a meridional part of a set, find the zonal partner + do ff = 1, nflds(hf) + if (trim(zname) == trim(tape(hf)%hlist(ff)%field%name)) then + tape(hf)%hlist(f)%field%zonal_complement = ff + tape(hf)%hlist(ff)%field%meridional_complement = f + exit + end if + if (ff == nflds(hf)) then + call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(f)%field%name)) + end if + end do + else + call endrun(trim(subname)//': INTERNAL ERROR, bad vector field') + end if + end if + end do + end if + end do + end if + end subroutine setup_interpolation_and_define_vector_complements + + subroutine restart_vars_setnames() + + ! Local variable + integer :: rvindex + + rvindex = 1 + restartvars(rvindex)%name = 'rgnht' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'nhtfrq' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'nflds' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'nfils' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'mfilt' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'nfpath' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = max_string_len_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'cpath' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = max_string_len_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'nhfil' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = max_string_len_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'ndens' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'fincllonlat' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = pflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'ncprec' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'beg_time' + restartvars(rvindex)%type = pio_double + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'fincl' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = fieldname_lenp2_dim_ind + restartvars(rvindex)%dims(2) = pflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'fexcl' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = fieldname_lenp2_dim_ind + restartvars(rvindex)%dims(2) = pflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'field_name' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'decomp_type' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'numlev' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'hrestpath' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = max_string_len_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'hwrt_prec' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'avgflag' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'sampling_seq' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'cell_methods' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'long_name' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'units' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'xyfill' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'lcltod_start' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'lcltod_stop' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'fillvalue' + restartvars(rvindex)%type = pio_double + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'mdims' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = maxvarmdims_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'mdimnames' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = max_hcoordname_len_dim_ind + restartvars(rvindex)%dims(2) = registeredmdims_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'is_subcol' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'interpolate_output' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'interpolate_type' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'interpolate_gridtype' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'interpolate_nlat' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'interpolate_nlon' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 1 + restartvars(rvindex)%dims(1) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'meridional_complement' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'zonal_complement' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + + end subroutine restart_vars_setnames + + subroutine restart_dims_setnames() + use cam_grid_support, only: max_hcoordname_len + use cam_history_support, only: registeredmdims + + restartdims(ptapes_dim_ind)%name = 'ptapes' + restartdims(ptapes_dim_ind)%len = ptapes + + restartdims(max_string_len_dim_ind)%name = 'max_string_len' + restartdims(max_string_len_dim_ind)%len = max_string_len + + restartdims(fieldname_lenp2_dim_ind)%name = 'fieldname_lenp2' + restartdims(fieldname_lenp2_dim_ind)%len = fieldname_lenp2 + + restartdims(pflds_dim_ind)%name = 'pflds' + restartdims(pflds_dim_ind)%len = pflds + + restartdims(max_chars_dim_ind)%name = 'max_chars' + restartdims(max_chars_dim_ind)%len = max_chars + + restartdims(max_fieldname_len_dim_ind)%name = 'max_fieldname_len' + restartdims(max_fieldname_len_dim_ind)%len = max_fieldname_len + + restartdims(maxnflds_dim_ind)%name = 'maxnflds' + restartdims(maxnflds_dim_ind)%len = maxval(nflds) + + restartdims(maxvarmdims_dim_ind)%name = 'maxvarmdims' + restartdims(maxvarmdims_dim_ind)%len = maxvarmdims + + restartdims(registeredmdims_dim_ind)%name = 'registeredmdims' + restartdims(registeredmdims_dim_ind)%len = registeredmdims + + restartdims(max_hcoordname_len_dim_ind)%name = 'max_hcoordname_len' + restartdims(max_hcoordname_len_dim_ind)%len = max_hcoordname_len + + end subroutine restart_dims_setnames + + + subroutine init_restart_history (File) + use cam_pio_utils, only: cam_pio_def_dim + use cam_pio_utils, only: cam_pio_handle_error + + !--------------------------------------------------------------------------- + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: File ! Pio file Handle + ! + ! Local + ! + integer :: dimids(4), ndims + integer :: ierr, i, k + + ! Don't need to write restart data if we have written the file this step + where (hstwr(:)) + rgnht(:) = .false. + elsewhere + rgnht(:) = .true. + end where + + if(maxval(nflds)>0) then + call restart_vars_setnames() + call restart_dims_setnames() + + do i=1,restartdimcnt + ! it's possible that one or more of these have been defined elsewhere + call cam_pio_def_dim(File, restartdims(i)%name, restartdims(i)%len, & + restartdims(i)%dimid, existOK=.true.) + end do + + do i=1,restartvarcnt + ndims= restartvars(i)%ndims + do k=1,ndims + dimids(k)=restartdims(restartvars(i)%dims(k))%dimid + end do + allocate(restartvars(i)%vdesc) + ierr = pio_def_var(File, restartvars(i)%name, restartvars(i)%type, dimids(1:ndims), restartvars(i)%vdesc) + call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error defining '//trim(restartvars(i)%name)) + + end do + end if + end subroutine init_restart_history + + function restartvar_getdesc(name) result(vdesc) + character(len=*), intent(in) :: name + type(var_desc_t), pointer :: vdesc + character(len=max_chars) :: errmsg + integer :: i + + nullify(vdesc) + do i=1,restartvarcnt + if(name .eq. restartvars(i)%name) then + vdesc=>restartvars(i)%vdesc + exit + end if + end do + if(.not.associated(vdesc)) then + errmsg = 'Could not find restart variable '//name + call endrun(errmsg) + end if + end function restartvar_getdesc + + + !####################################################################### + + subroutine write_restart_history ( File, & + yr_spec, mon_spec, day_spec, sec_spec ) + use cam_history_support, only: hist_coord_name, registeredmdims + + implicit none + !-------------------------------------------------------------------------------------------------- + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: file ! PIO restart file pointer + integer, intent(in), optional :: yr_spec ! Simulation year + integer, intent(in), optional :: mon_spec ! Simulation month + integer, intent(in), optional :: day_spec ! Simulation day + integer, intent(in), optional :: sec_spec ! Seconds into current simulation day + ! + ! Local workspace + ! + integer :: ierr, t, f + integer :: rgnht_int(ptapes), start(2), startc(3) + type(var_desc_t), pointer :: vdesc + + ! PIO variable descriptors + type(var_desc_t), pointer :: field_name_desc ! Restart field names + type(var_desc_t), pointer :: decomp_type_desc + type(var_desc_t), pointer :: numlev_desc + type(var_desc_t), pointer :: avgflag_desc + type(var_desc_t), pointer :: sseq_desc + type(var_desc_t), pointer :: cm_desc + type(var_desc_t), pointer :: longname_desc + type(var_desc_t), pointer :: units_desc + type(var_desc_t), pointer :: hwrt_prec_desc + type(var_desc_t), pointer :: xyfill_desc + type(var_desc_t), pointer :: mdims_desc ! mdim name indices + type(var_desc_t), pointer :: mdimname_desc ! mdim names + type(var_desc_t), pointer :: issubcol_desc + type(var_desc_t), pointer :: fillval_desc + type(var_desc_t), pointer :: interpolate_output_desc + type(var_desc_t), pointer :: interpolate_type_desc + type(var_desc_t), pointer :: interpolate_gridtype_desc + type(var_desc_t), pointer :: interpolate_nlat_desc + type(var_desc_t), pointer :: interpolate_nlon_desc + type(var_desc_t), pointer :: meridional_complement_desc + type(var_desc_t), pointer :: zonal_complement_desc + + integer, allocatable :: allmdims(:,:,:) + integer, allocatable :: xyfill(:,:) + integer, allocatable :: is_subcol(:,:) + integer, allocatable :: interp_output(:) + + integer :: maxnflds + + + maxnflds = maxval(nflds) + allocate(xyfill(maxnflds, ptapes)) + xyfill = 0 + allocate(is_subcol(maxnflds, ptapes)) + is_subcol = 0 + allocate(interp_output(ptapes)) + interp_output = 0 + + ! + !----------------------------------------------------------------------- + ! Write the history restart data if necessary + !----------------------------------------------------------------------- + + rgnht_int(:) = 0 + + if(.not.allocated(restarthistory_tape)) allocate(restarthistory_tape(ptapes)) + + do t=1,ptapes + ! No need to write history IC restart because it is always instantaneous + if (is_initfile(file_index=t)) rgnht(t) = .false. + ! No need to write restart data for empty files + if (nflds(t) == 0) rgnht(t) = .false. + if(rgnht(t)) then + rgnht_int(t) = 1 + restarthistory_tape(t)%hlist => history_tape(t)%hlist + + if(associated(history_tape(t)%grid_ids)) then + restarthistory_tape(t)%grid_ids => history_tape(t)%grid_ids + end if + if(associated(history_tape(t)%patches)) then + restarthistory_tape(t)%patches => history_tape(t)%patches + end if + end if + end do + + if(maxval(nflds)<=0) return + + call wshist(rgnht) + + vdesc => restartvar_getdesc('fincl') + ierr= pio_put_var(File, vdesc, fincl(:,1:ptapes)) + + vdesc => restartvar_getdesc('fincllonlat') + ierr= pio_put_var(File, vdesc, fincllonlat(:,1:ptapes)) + + vdesc => restartvar_getdesc('fexcl') + ierr= pio_put_var(File, vdesc, fexcl(:,1:ptapes)) + + vdesc => restartvar_getdesc('rgnht') + ierr= pio_put_var(File, vdesc, rgnht_int(1:ptapes)) + + vdesc => restartvar_getdesc('nhtfrq') + ierr= pio_put_var(File, vdesc, nhtfrq(1:ptapes)) + + vdesc => restartvar_getdesc('nflds') + ierr= pio_put_var(File, vdesc, nflds(1:ptapes)) + + vdesc => restartvar_getdesc('nfils') + ierr= pio_put_var(File, vdesc, nfils(1:ptapes)) + + vdesc => restartvar_getdesc('mfilt') + ierr= pio_put_var(File, vdesc, mfilt(1:ptapes)) + + vdesc => restartvar_getdesc('nfpath') + ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) + + vdesc => restartvar_getdesc('cpath') + ierr= pio_put_var(File, vdesc, cpath(1:ptapes)) + + vdesc => restartvar_getdesc('nhfil') + ierr= pio_put_var(File, vdesc, nhfil(1:ptapes)) + + vdesc => restartvar_getdesc('ndens') + ierr= pio_put_var(File, vdesc, ndens(1:ptapes)) + vdesc => restartvar_getdesc('ncprec') + ierr= pio_put_var(File, vdesc, ncprec(1:ptapes)) + vdesc => restartvar_getdesc('beg_time') + ierr= pio_put_var(File, vdesc, beg_time(1:ptapes)) + + vdesc => restartvar_getdesc('hrestpath') + ierr = pio_put_var(File, vdesc, hrestpath(1:ptapes)) + + vdesc => restartvar_getdesc('lcltod_start') + ierr = pio_put_var(File, vdesc, lcltod_start(1:ptapes)) + + vdesc => restartvar_getdesc('lcltod_stop') + ierr = pio_put_var(File, vdesc, lcltod_stop(1:ptapes)) + + field_name_desc => restartvar_getdesc('field_name') + decomp_type_desc => restartvar_getdesc('decomp_type') + numlev_desc => restartvar_getdesc('numlev') + hwrt_prec_desc => restartvar_getdesc('hwrt_prec') + + sseq_desc => restartvar_getdesc('sampling_seq') + cm_desc => restartvar_getdesc('cell_methods') + longname_desc => restartvar_getdesc('long_name') + units_desc => restartvar_getdesc('units') + avgflag_desc => restartvar_getdesc('avgflag') + xyfill_desc => restartvar_getdesc('xyfill') + issubcol_desc => restartvar_getdesc('is_subcol') + + interpolate_output_desc => restartvar_getdesc('interpolate_output') + interpolate_type_desc => restartvar_getdesc('interpolate_type') + interpolate_gridtype_desc => restartvar_getdesc('interpolate_gridtype') + interpolate_nlat_desc => restartvar_getdesc('interpolate_nlat') + interpolate_nlon_desc => restartvar_getdesc('interpolate_nlon') + + meridional_complement_desc => restartvar_getdesc('meridional_complement') + zonal_complement_desc => restartvar_getdesc('zonal_complement') + + mdims_desc => restartvar_getdesc('mdims') + mdimname_desc => restartvar_getdesc('mdimnames') + fillval_desc => restartvar_getdesc('fillvalue') + + tape=>history_tape + + ! allmdims specifies the mdim indices for each field + allocate(allmdims(maxvarmdims,maxval(nflds),ptapes)) + allmdims=-1 + + startc(1)=1 + do t = 1,ptapes + start(2)=t + startc(3)=t + do f=1,nflds(t) + start(1)=f + startc(2)=f + ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(f)%field%name) + ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(f)%field%decomp_type) + ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) + + ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) + ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) + ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) + ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) + ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(f)%field%units) + ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(f)%avgflag) + + ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) + ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) + ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) + if(associated(tape(t)%hlist(f)%field%mdims)) then + allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims + else + end if + if(tape(t)%hlist(f)%field%flag_xyfill) then + xyfill(f,t) = 1 + end if + if(tape(t)%hlist(f)%field%is_subcol) then + is_subcol(f,t) = 1 + end if + end do + if (interpolate_output(t)) then + interp_output(t) = 1 + end if + end do + ierr = pio_put_var(File, xyfill_desc, xyfill) + ierr = pio_put_var(File, mdims_desc, allmdims) + ierr = pio_put_var(File, issubcol_desc, is_subcol) + !! Interpolated output variables + ierr = pio_put_var(File, interpolate_output_desc, interp_output) + interp_output = 1 + do t = 1, size(interpolate_info) + interp_output(t) = interpolate_info(t)%interp_type + end do + ierr = pio_put_var(File, interpolate_type_desc, interp_output) + interp_output = 1 + do t = 1, size(interpolate_info) + interp_output(t) = interpolate_info(t)%interp_gridtype + end do + ierr = pio_put_var(File, interpolate_gridtype_desc, interp_output) + interp_output = 0 + do t = 1, size(interpolate_info) + interp_output(t) = interpolate_info(t)%interp_nlat + end do + ierr = pio_put_var(File, interpolate_nlat_desc, interp_output) + interp_output = 0 + do t = 1, size(interpolate_info) + interp_output(t) = interpolate_info(t)%interp_nlon + end do + ierr = pio_put_var(File, interpolate_nlon_desc, interp_output) + ! Registered history coordinates + start(1) = 1 + do f = 1, registeredmdims + start(2) = f + ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(f)) + end do + + deallocate(xyfill, allmdims) + return + + end subroutine write_restart_history + + + !####################################################################### + + subroutine read_restart_history (File) + use pio, only: pio_inq_dimid + use pio, only: pio_inq_varid, pio_inq_dimname + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + use cam_pio_utils, only: cam_pio_var_info + use ioFileMod, only: getfil + use sat_hist, only: sat_hist_define, sat_hist_init + use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_num_grids + use cam_history_support, only: get_hist_coord_index, add_hist_coord + + use shr_sys_mod, only: shr_sys_getenv + use spmd_utils, only: mpicom, mpi_character, masterprocid + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: File ! unit number + ! + ! Local workspace + ! + integer t, f, ff ! tape, field indices + integer begdim2 ! on-node vert start index + integer enddim2 ! on-node vert end index + integer begdim1 ! on-node dim1 start index + integer enddim1 ! on-node dim1 end index + integer begdim3 ! on-node chunk or lat start index + integer enddim3 ! on-node chunk or lat end index + + + integer rgnht_int(ptapes) + integer :: ierr + + character(len=max_string_len) :: locfn ! Local filename + character(len=max_fieldname_len), allocatable :: tmpname(:,:) + integer, allocatable :: decomp(:,:), tmpnumlev(:,:) + integer, pointer :: nacs(:,:) ! accumulation counter + character(len=max_fieldname_len) :: fname_tmp ! local copy of field name + character(len=max_fieldname_len) :: dname_tmp ! local copy of dim name + + integer :: i, ptapes_dimid + + type(var_desc_t) :: vdesc + type(var_desc_t) :: longname_desc + type(var_desc_t) :: units_desc + type(var_desc_t) :: avgflag_desc + type(var_desc_t) :: sseq_desc + type(var_desc_t) :: cm_desc + type(var_desc_t) :: fillval_desc + type(var_desc_t) :: meridional_complement_desc + type(var_desc_t) :: zonal_complement_desc + integer, allocatable :: tmpprec(:,:) + integer, allocatable :: xyfill(:,:) + integer, allocatable :: allmdims(:,:,:) + integer, allocatable :: is_subcol(:,:) + integer, allocatable :: interp_output(:) + integer :: nacsdimcnt, nacsval + integer :: maxnflds, dimid + + ! List of active grids (first dim) for each tape (second dim) + ! An active grid is one for which there is a least one field being output + ! on that grid. + integer, allocatable :: gridsontape(:,:) + + character(len=16), allocatable :: mdimnames(:) ! Names of all hist coords (inc. vertical) + integer :: ndims, dimids(8) + integer :: tmpdims(8), dimcnt + integer :: dimlens(7) + integer :: mtapes, mdimcnt + integer :: fdims(3) ! Field dims + integer :: nfdims ! 2 or 3 (for 2D,3D) + integer :: fdecomp ! Grid ID for field + + ! + ! Get users logname and machine hostname + ! + if ( masterproc )then + logname = ' ' + call shr_sys_getenv ('LOGNAME',logname,ierr) + host = ' ' + call shr_sys_getenv ('HOST',host,ierr) + end if + ! PIO requires netcdf attributes have consistant values on all tasks + call mpi_bcast(logname, len(logname), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(host, len(host), mpi_character, masterprocid, mpicom, ierr) + + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + + ierr = pio_inq_dimid(File, 'ptapes', ptapes_dimid) + if(ierr/= PIO_NOERR) then + if(masterproc) write(iulog,*) 'Not reading history info from restart file', ierr + return ! no history info in restart file + end if + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + ierr = pio_inq_dimlen(File, ptapes_dimid, mtapes) + + ierr = pio_inq_dimid(File, 'maxnflds', dimid) + ierr = pio_inq_dimlen(File, dimid, maxnflds) + + ierr = pio_inq_dimid(File, 'maxvarmdims', dimid) + ierr = pio_inq_dimlen(File, dimid, maxvarmdims) + + ierr = pio_inq_varid(File, 'rgnht', vdesc) + ierr = pio_get_var(File, vdesc, rgnht_int(1:mtapes)) + + ierr = pio_inq_varid(File, 'nhtfrq', vdesc) + ierr = pio_get_var(File, vdesc, nhtfrq(1:mtapes)) + + ierr = pio_inq_varid(File, 'nflds', vdesc) + ierr = pio_get_var(File, vdesc, nflds(1:mtapes)) + ierr = pio_inq_varid(File, 'nfils', vdesc) + ierr = pio_get_var(File, vdesc, nfils(1:mtapes)) + ierr = pio_inq_varid(File, 'mfilt', vdesc) + ierr = pio_get_var(File, vdesc, mfilt(1:mtapes)) + + ierr = pio_inq_varid(File, 'nfpath', vdesc) + ierr = pio_get_var(File, vdesc, nfpath(1:mtapes)) + ierr = pio_inq_varid(File, 'cpath', vdesc) + ierr = pio_get_var(File, vdesc, cpath(1:mtapes)) + ierr = pio_inq_varid(File, 'nhfil', vdesc) + ierr = pio_get_var(File, vdesc, nhfil(1:mtapes)) + ierr = pio_inq_varid(File, 'hrestpath', vdesc) + ierr = pio_get_var(File, vdesc, hrestpath(1:mtapes)) + + + ierr = pio_inq_varid(File, 'ndens', vdesc) + ierr = pio_get_var(File, vdesc, ndens(1:mtapes)) + ierr = pio_inq_varid(File, 'ncprec', vdesc) + ierr = pio_get_var(File, vdesc, ncprec(1:mtapes)) + ierr = pio_inq_varid(File, 'beg_time', vdesc) + ierr = pio_get_var(File, vdesc, beg_time(1:mtapes)) + + + ierr = pio_inq_varid(File, 'fincl', vdesc) + ierr = pio_get_var(File, vdesc, fincl(:,1:mtapes)) + + ierr = pio_inq_varid(File, 'fincllonlat', vdesc) + ierr = pio_get_var(File, vdesc, fincllonlat(:,1:mtapes)) + + ierr = pio_inq_varid(File, 'fexcl', vdesc) + ierr = pio_get_var(File, vdesc, fexcl(:,1:mtapes)) + + ierr = pio_inq_varid(File, 'lcltod_start', vdesc) + ierr = pio_get_var(File, vdesc, lcltod_start(1:mtapes)) + + ierr = pio_inq_varid(File, 'lcltod_stop', vdesc) + ierr = pio_get_var(File, vdesc, lcltod_stop(1:mtapes)) + + + + + allocate(tmpname(maxnflds, mtapes), decomp(maxnflds, mtapes), tmpnumlev(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'field_name', vdesc) + ierr = pio_get_var(File, vdesc, tmpname) + + ierr = pio_inq_varid(File, 'decomp_type', vdesc) + ierr = pio_get_var(File, vdesc, decomp) + ierr = pio_inq_varid(File, 'numlev', vdesc) + ierr = pio_get_var(File, vdesc, tmpnumlev) + + allocate(tmpprec(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) + ierr = pio_get_var(File, vdesc, tmpprec(:,:)) + + allocate(xyfill(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'xyfill', vdesc) + ierr = pio_get_var(File, vdesc, xyfill) + + allocate(is_subcol(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'is_subcol', vdesc) + ierr = pio_get_var(File, vdesc, is_subcol) + + !! interpolated output + allocate(interp_output(mtapes)) + ierr = pio_inq_varid(File, 'interpolate_output', vdesc) + ierr = pio_get_var(File, vdesc, interp_output) + interpolate_output(1:mtapes) = interp_output(1:mtapes) > 0 + if (ptapes > mtapes) then + interpolate_output(mtapes+1:ptapes) = .false. + end if + ierr = pio_inq_varid(File, 'interpolate_type', vdesc) + ierr = pio_get_var(File, vdesc, interp_output) + do t = 1, mtapes + if (interpolate_output(t)) then + interpolate_info(t)%interp_type = interp_output(t) + end if + end do + ierr = pio_inq_varid(File, 'interpolate_gridtype', vdesc) + ierr = pio_get_var(File, vdesc, interp_output) + do t = 1, mtapes + if (interpolate_output(t)) then + interpolate_info(t)%interp_gridtype = interp_output(t) + end if + end do + ierr = pio_inq_varid(File, 'interpolate_nlat', vdesc) + ierr = pio_get_var(File, vdesc, interp_output) + do t = 1, mtapes + if (interpolate_output(t)) then + interpolate_info(t)%interp_nlat = interp_output(t) + end if + end do + ierr = pio_inq_varid(File, 'interpolate_nlon', vdesc) + ierr = pio_get_var(File, vdesc, interp_output) + do t = 1, mtapes + if (interpolate_output(t)) then + interpolate_info(t)%interp_nlon = interp_output(t) + end if + end do + + !! mdim indices + allocate(allmdims(maxvarmdims,maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'mdims', vdesc) + ierr = pio_get_var(File, vdesc, allmdims) + + !! mdim names + ! Read the hist coord names to make sure they are all registered + ierr = pio_inq_varid(File, 'mdimnames', vdesc) + call cam_pio_var_info(File, vdesc, ndims, dimids, dimlens) + mdimcnt = dimlens(2) + allocate(mdimnames(mdimcnt)) + ierr = pio_get_var(File, vdesc, mdimnames) + do f = 1, mdimcnt + ! Check to see if the mdim is registered + if (get_hist_coord_index(trim(mdimnames(f))) <= 0) then + ! We need to register this mdim (hist_coord) + call add_hist_coord(trim(mdimnames(f))) + end if + end do + + ierr = pio_inq_varid(File, 'avgflag', avgflag_desc) + + ierr = pio_inq_varid(File, 'long_name', longname_desc) + ierr = pio_inq_varid(File, 'units', units_desc) + ierr = pio_inq_varid(File, 'sampling_seq', sseq_desc) + ierr = pio_inq_varid(File, 'cell_methods', cm_desc) + + ierr = pio_inq_varid(File, 'fillvalue', fillval_desc) + ierr = pio_inq_varid(File, 'meridional_complement', meridional_complement_desc) + ierr = pio_inq_varid(File, 'zonal_complement', zonal_complement_desc) + + rgnht(:)=.false. + + allocate(history_tape(mtapes)) + + tape => history_tape + + do t=1,mtapes + + if(rgnht_int(t)==1) rgnht(t)=.true. + + + call strip_null(nfpath(t)) + call strip_null(cpath(t)) + call strip_null(hrestpath(t)) + allocate(tape(t)%hlist(nflds(t))) + + do f=1,nflds(t) + if (associated(tape(t)%hlist(f)%field%mdims)) then + deallocate(tape(t)%hlist(f)%field%mdims) + end if + nullify(tape(t)%hlist(f)%field%mdims) + ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) + ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) + ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) + ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) + ierr = pio_get_var(File,longname_desc, (/1,f,t/), tape(t)%hlist(f)%field%long_name) + ierr = pio_get_var(File,units_desc, (/1,f,t/), tape(t)%hlist(f)%field%units) + tape(t)%hlist(f)%field%sampling_seq(1:max_chars) = ' ' + ierr = pio_get_var(File,sseq_desc, (/1,f,t/), tape(t)%hlist(f)%field%sampling_seq) + call strip_null(tape(t)%hlist(f)%field%sampling_seq) + tape(t)%hlist(f)%field%cell_methods(1:max_chars) = ' ' + ierr = pio_get_var(File,cm_desc, (/1,f,t/), tape(t)%hlist(f)%field%cell_methods) + call strip_null(tape(t)%hlist(f)%field%cell_methods) + if(xyfill(f,t) ==1) then + tape(t)%hlist(f)%field%flag_xyfill=.true. + else + tape(t)%hlist(f)%field%flag_xyfill=.false. + end if + if(is_subcol(f,t) ==1) then + tape(t)%hlist(f)%field%is_subcol=.true. + else + tape(t)%hlist(f)%field%is_subcol=.false. + end if + call strip_null(tmpname(f,t)) + tape(t)%hlist(f)%field%name = tmpname(f,t) + tape(t)%hlist(f)%field%decomp_type = decomp(f,t) + tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) + tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) + + mdimcnt = count(allmdims(:,f,t) > 0) + if(mdimcnt > 0) then + allocate(tape(t)%hlist(f)%field%mdims(mdimcnt)) + do i = 1, mdimcnt + tape(t)%hlist(f)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,f,t))) + end do + end if + + end do + end do + deallocate(tmpname, tmpnumlev, tmpprec, decomp, xyfill, is_subcol) + deallocate(mdimnames) + + allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) + gridsontape = -1 + do t = 1, ptapes + do f = 1, nflds(t) + call set_field_dimensions(tape(t)%hlist(f)%field) + + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + + allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + endif + + if (associated(tape(t)%hlist(f)%varid)) then + deallocate(tape(t)%hlist(f)%varid) + end if + nullify(tape(t)%hlist(f)%varid) + if (associated(tape(t)%hlist(f)%nacs)) then + deallocate(tape(t)%hlist(f)%nacs) + end if + nullify(tape(t)%hlist(f)%nacs) + if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then + allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + else + allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + end if + ! initialize all buffers to zero - this will be overwritten later by the + ! data in the history restart file if it exists. + call h_zero(f,t) + + ! Make sure this field's decomp is listed on the tape + fdecomp = tape(t)%hlist(f)%field%decomp_type + do ff = 1, size(gridsontape, 1) + if (fdecomp == gridsontape(ff, t)) then + exit + else if (gridsontape(ff, t) < 0) then + gridsontape(ff, t) = fdecomp + exit + end if + end do + + end do + end do + ! + !----------------------------------------------------------------------- + ! Read history restart files + !----------------------------------------------------------------------- + ! + ! Loop over the total number of history files declared and + ! read the pathname for any history restart files + ! that are present (if any). Test to see if the run is a restart run + ! AND if any history buffer regen files exist (rgnht=.T.). Note, rgnht + ! is preset to false, reset to true in routine WSDS if hbuf restart files + ! are written and saved in the master restart file. Each history buffer + ! restart file is then obtained. + ! Note: some f90 compilers (e.g. SGI) complain about I/O of + ! derived types which have pointer components, so explicitly read each one. + ! + do t=1,mtapes + if (rgnht(t)) then + ! + ! Open history restart file + ! + call getfil (hrestpath(t), locfn) + call cam_pio_openfile(tape(t)%File, locfn, 0) + ! + ! Read history restart file + ! + do f = 1, nflds(t) + + fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp + ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) + + call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) + if(.not. associated(tape(t)%hlist(f)%field%mdims)) then + dimcnt = 0 + do i=1,ndims + ierr = pio_inq_dimname(tape(t)%File, dimids(i), dname_tmp) + dimid = get_hist_coord_index(dname_tmp) + if(dimid >= 1) then + dimcnt = dimcnt + 1 + tmpdims(dimcnt) = dimid + ! No else, just looking for mdims (grid dims won't be hist coords) + end if + end do + if(dimcnt > 0) then + allocate(tape(t)%hlist(f)%field%mdims(dimcnt)) + tape(t)%hlist(f)%field%mdims(:) = tmpdims(1:dimcnt) + if(dimcnt > maxvarmdims) maxvarmdims=dimcnt + end if + end if + call set_field_dimensions(tape(t)%hlist(f)%field) + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + fdims(1) = enddim1 - begdim1 + 1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + fdims(2) = enddim2 - begdim2 + 1 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + fdims(3) = enddim3 - begdim3 + 1 + if (fdims(2) > 1) then + nfdims = 3 + else + nfdims = 2 + fdims(2) = fdims(3) + end if + fdecomp = tape(t)%hlist(f)%field%decomp_type + if (nfdims > 2) then + call cam_grid_read_dist_array(tape(t)%File, fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf, vdesc) + else + call cam_grid_read_dist_array(tape(t)%File, fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf(:,1,:), vdesc) + end if + + if ( associated(tape(t)%hlist(f)%sbuf) ) then + ! read in variance for standard deviation + ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_var', vdesc) + if (nfdims > 2) then + call cam_grid_read_dist_array(tape(t)%File, fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf, vdesc) + else + call cam_grid_read_dist_array(tape(t)%File, fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf(:,1,:), vdesc) + end if + endif + + ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) + + if(nacsdimcnt > 0) then + if (nfdims > 2) then + ! nacs only has 2 dims (no levels) + fdims(2) = fdims(3) + end if + allocate(tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + nacs => tape(t)%hlist(f)%nacs(:,:) + call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & + dimlens(1:nacsdimcnt), nacs, vdesc) + else + allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + ierr = pio_get_var(tape(t)%File, vdesc, nacsval) + tape(t)%hlist(f)%nacs(1,:)= nacsval + end if + + end do + ! + ! Done reading this history restart file + ! + call cam_pio_closefile(tape(t)%File) + + end if ! rgnht(t) + + ! (re)create the master list of grid IDs + ff = 0 + do f = 1, size(gridsontape, 1) + if (gridsontape(f, t) > 0) then + ff = ff + 1 + end if + end do + allocate(tape(t)%grid_ids(ff)) + ff = 1 + do f = 1, size(gridsontape, 1) + if (gridsontape(f, t) > 0) then + tape(t)%grid_ids(ff) = gridsontape(f, t) + ff = ff + 1 + end if + end do + call patch_init(t) + end do ! end of do mtapes loop + + ! + ! If the history files are partially complete (contain less than + ! mfilt(t) time samples, then get the files and open them.) + ! + ! NOTE: No need to perform this operation for IC history files or empty files + ! + + do t=1,mtapes + if (is_initfile(file_index=t)) then + ! Initialize filename specifier for IC file + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' + nfils(t) = 0 + else if (nflds(t) == 0) then + nfils(t) = 0 + else + if (nfils(t) > 0) then + call getfil (cpath(t), locfn) + call cam_pio_openfile(tape(t)%File, locfn, PIO_WRITE) + call h_inquire (t) + if(is_satfile(t)) then + ! Initialize the sat following history subsystem + call sat_hist_init() + call sat_hist_define(tape(t)%File) + end if + end if + ! + ! If the history file is full, close the current unit + ! + if (nfils(t) >= mfilt(t)) then + if (masterproc) then + write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t), mfilt(t) + end if + do f=1,nflds(t) + deallocate(tape(t)%hlist(f)%varid) + nullify(tape(t)%hlist(f)%varid) + end do + call cam_pio_closefile(tape(t)%File) + nfils(t) = 0 + end if + end if + end do + + ! Setup vector pairs for unstructured grid interpolation + call setup_interpolation_and_define_vector_complements() + + if(mtapes/=ptapes .and. masterproc) then + write(iulog,*) ' WARNING: Restart file ptapes setting ',mtapes,' not equal to model setting ',ptapes + end if + + return + end subroutine read_restart_history + + !####################################################################### + + character(len=max_string_len) function get_hfilepath( tape ) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Return full filepath of history file for given tape number + ! This allows public read access to the filenames without making + ! the filenames public data. + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: tape ! Tape number + + get_hfilepath = cpath( tape ) + end function get_hfilepath + + !####################################################################### + + character(len=max_string_len) function get_hist_restart_filepath( tape ) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Return full filepath of restart file for given tape number + ! This allows public read access to the filenames without making + ! the filenames public data. + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: tape ! Tape number + + get_hist_restart_filepath = hrestpath( tape ) + end function get_hist_restart_filepath + + !####################################################################### + + integer function get_ptapes( ) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Return the number of tapes being used. + ! This allows public read access to the number of tapes without making + ! ptapes public data. + ! + !----------------------------------------------------------------------- + ! + get_ptapes = ptapes + end function get_ptapes + + !####################################################################### + + recursive function get_entry_by_name(listentry, name) result(entry) + type(master_entry), pointer :: listentry + character(len=*), intent(in) :: name ! variable name + type(master_entry), pointer :: entry + + if(associated(listentry)) then + if(listentry%field%name .eq. name) then + entry => listentry + else + entry=>get_entry_by_name(listentry%next_entry, name) + end if + else + nullify(entry) + end if + end function get_entry_by_name + + !####################################################################### + + subroutine AvgflagToString(avgflag, time_op) + ! Dummy arguments + character(len=1), intent(in) :: avgflag ! averaging flag + character(len=max_chars), intent(out) :: time_op ! time op (e.g. max) + + ! Local variable + character(len=*), parameter :: subname = 'AvgflagToString' + + select case (avgflag) + case ('A') + time_op(:) = 'mean' + case ('B') + time_op(:) = 'mean00z' + case ('I') + time_op(:) = ' ' + case ('X') + time_op(:) = 'maximum' + case ('M') + time_op(:) = 'minimum' + case('L') + time_op(:) = LT_DESC + case ('S') + time_op(:) = 'standard_deviation' + case default + call endrun(subname//': unknown avgflag = '//avgflag) + end select + end subroutine AvgflagToString + + !####################################################################### + + subroutine fldlst () + + use cam_grid_support, only: cam_grid_num_grids + use spmd_utils, only: mpicom + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Define the contents of each history file based on namelist input for initial or branch + ! run, and restart data if a restart run. + ! + ! Method: Use arrays fincl and fexcl to modify default history tape contents. + ! Then sort the result alphanumerically for later use by OUTFLD to + ! allow an n log n search time. + ! + !---------------------------Local variables----------------------------- + ! + integer t, f ! tape, field indices + integer ff ! index into include, exclude and fprec list + character(len=fieldname_len) :: name ! field name portion of fincl (i.e. no avgflag separator) + character(len=max_fieldname_len) :: mastername ! name from masterlist field + character(len=max_chars) :: errormsg ! error output field + character(len=1) :: avgflag ! averaging flag + character(len=1) :: prec_wrt ! history buffer write precision flag + + type (hentry) :: tmp ! temporary used for swapping + + type(master_entry), pointer :: listentry + logical :: fieldontape ! .true. iff field on tape + integer :: errors_found + + ! List of active grids (first dim) for each tape (second dim) + ! An active grid is one for which there is a least one field being output + ! on that grid. + integer, allocatable :: gridsontape(:,:) + + ! + ! First ensure contents of fincl, fexcl, and fwrtpr are all valid names + ! + errors_found = 0 + do t=1,ptapes + f = 1 + do while (f < pflds .and. fincl(f,t) /= ' ') + name = getname (fincl(f,t)) + mastername='' + listentry => get_entry_by_name(masterlinkedlist, name) + if(associated(listentry)) mastername = listentry%field%name + if (name /= mastername) then + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', f,', ',t, ') not found' + if (masterproc) then + write(iulog,*) trim(errormsg) + call shr_sys_flush(iulog) + end if + errors_found = errors_found + 1 + end if + f = f + 1 + end do + + f = 1 + do while (f < pflds .and. fexcl(f,t) /= ' ') + mastername='' + listentry => get_entry_by_name(masterlinkedlist, fexcl(f,t)) + if(associated(listentry)) mastername = listentry%field%name + + if (fexcl(f,t) /= mastername) then + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(f,t)), ' in fexcl(', f,', ',t, ') not found' + if (masterproc) then + write(iulog,*) trim(errormsg) + call shr_sys_flush(iulog) + end if + errors_found = errors_found + 1 + end if + f = f + 1 + end do + + f = 1 + do while (f < pflds .and. fwrtpr(f,t) /= ' ') + name = getname (fwrtpr(f,t)) + mastername='' + listentry => get_entry_by_name(masterlinkedlist, name) + if(associated(listentry)) mastername = listentry%field%name + if (name /= mastername) then + write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', f, ') not found' + if (masterproc) then + write(iulog,*) trim(errormsg) + call shr_sys_flush(iulog) + end if + errors_found = errors_found + 1 + end if + do ff=1,f-1 ! If duplicate entry is found, stop + if (trim(name) == trim(getname(fwrtpr(ff,t)))) then + write(errormsg,'(3a)')'FLDLST: Duplicate field ', trim(name), ' in fwrtpr' + if (masterproc) then + write(iulog,*) trim(errormsg) + call shr_sys_flush(iulog) + end if + errors_found = errors_found + 1 + end if + end do + f = f + 1 + end do + end do + + if (errors_found > 0) then + ! Give masterproc a chance to write all the log messages + call mpi_barrier(mpicom, t) + write(errormsg, '(a,i0,a)') 'FLDLST: ',errors_found,' errors found, see log' + call endrun(trim(errormsg)) + end if + + nflds(:) = 0 + ! IC history file is to be created, set properties + if(is_initfile()) then + hfilename_spec(ptapes) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' + + ncprec(ptapes) = pio_double + ndens (ptapes) = 1 + mfilt (ptapes) = 1 + end if + + + + allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) + gridsontape = -1 + do t=1,ptapes + ! + ! Add the field to the tape if specified via namelist (FINCL[1-ptapes]), or if + ! it is on by default and was not excluded via namelist (FEXCL[1-ptapes]). + ! Also set history buffer accumulation and output precision values according + ! to the values specified via namelist (FWRTPR[1-ptapes]) + ! or, if not on the list, to the default values given by ndens(t). + ! + listentry => masterlinkedlist + do while(associated(listentry)) + mastername = listentry%field%name + call list_index (fincl(1,t), mastername, ff) + + fieldontape = .false. + if (ff > 0) then + fieldontape = .true. + else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then + call list_index (fexcl(1,t), mastername, ff) + if (ff == 0 .and. listentry%actflag(t)) then + fieldontape = .true. + end if + end if + if (fieldontape) then + ! The field is active so increment the number fo fields and add + ! its decomp type to the list of decomp types on this tape + nflds(t) = nflds(t) + 1 + do ff = 1, size(gridsontape, 1) + if (listentry%field%decomp_type == gridsontape(ff, t)) then + exit + else if (gridsontape(ff, t) < 0) then + gridsontape(ff, t) = listentry%field%decomp_type + exit + end if + end do + end if + listentry=>listentry%next_entry + end do + end do + ! + ! Determine total number of active history tapes + ! + if (masterproc) then + do t=1,ptapes + if (nflds(t) == 0) then + write(iulog,*)'FLDLST: Tape ',t,' is empty' + end if + end do + endif + allocate(history_tape(ptapes)) + tape=>history_tape + + + do t=1,ptapes + nullify(tape(t)%hlist) + ! Now we have a field count and can allocate + if(nflds(t) > 0) then + ! Allocate the correct number of hentry slots + allocate(tape(t)%hlist(nflds(t))) + ! Count up the number of grids output on this tape + ff = 0 + do f = 1, size(gridsontape, 1) + if (gridsontape(f, t) > 0) then + ff = ff + 1 + end if + end do + allocate(tape(t)%grid_ids(ff)) + ff = 1 + do f = 1, size(gridsontape, 1) + if (gridsontape(f, t) > 0) then + tape(t)%grid_ids(ff) = gridsontape(f, t) + ff = ff + 1 + end if + end do + end if + do ff=1,nflds(t) + nullify(tape(t)%hlist(ff)%hbuf) + nullify(tape(t)%hlist(ff)%sbuf) + nullify(tape(t)%hlist(ff)%nacs) + nullify(tape(t)%hlist(ff)%varid) + end do + + + nflds(t) = 0 ! recount to support array based method + listentry => masterlinkedlist + do while(associated(listentry)) + mastername = listentry%field%name + + call list_index (fwrtpr(1,t), mastername, ff) + if (ff > 0) then + prec_wrt = getflag(fwrtpr(ff,t)) + else + prec_wrt = ' ' + end if + + call list_index (fincl(1,t), mastername, ff) + + if (ff > 0) then + avgflag = getflag (fincl(ff,t)) + call inifld (t, listentry, avgflag, prec_wrt) + else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then + call list_index (fexcl(1,t), mastername, ff) + if (ff == 0 .and. listentry%actflag(t)) then + call inifld (t, listentry, ' ', prec_wrt) + else + listentry%actflag(t) = .false. + end if + else + listentry%actflag(t) = .false. + end if + listentry=>listentry%next_entry + + end do + ! + ! If column output is specified make sure there are some fields defined + ! for that tape + ! + if (nflds(t) .eq. 0 .and. fincllonlat(1,t) .ne. ' ') then + write(errormsg,'(a,i2,a)') 'FLDLST: Column output is specified for tape ',t,' but no fields defined for that tape.' + call endrun(errormsg) + else + call patch_init(t) + end if + ! + ! Specification of tape contents now complete. Sort each list of active + ! entries for efficiency in OUTFLD. Simple bubble sort. + ! +!!XXgoldyXX: v In the future, we will sort according to decomp to speed I/O + do f=nflds(t)-1,1,-1 + do ff=1,f + + if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then + + tmp = tape(t)%hlist(ff) + tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) + tape(t)%hlist(ff+1) = tmp + + else if (tape(t)%hlist(ff )%field%name == tape(t)%hlist(ff+1)%field%name) then + + write(errormsg,'(2a,2(a,i3))') 'FLDLST: Duplicate field: ', & + trim(tape(t)%hlist(ff)%field%name),', tape = ', t, ', ff = ', ff + call endrun(errormsg) + + end if + + end do + end do + + end do ! do t=1,ptapes + deallocate(gridsontape) + + call print_active_fldlst() + + ! + ! Packing density, ndens: With netcdf, only 1 (nf_double) and 2 (pio_real) + ! are allowed + ! + do t=1,ptapes + if (ndens(t) == 1) then + ncprec(t) = pio_double + else if (ndens(t) == 2) then + ncprec(t) = pio_real + else + call endrun ('FLDLST: ndens must be 1 or 2') + end if + + end do + ! + ! Now that masterlinkedlist is defined, construct primary and secondary hashing + ! tables. + ! + call bld_outfld_hash_tbls() + call bld_htapefld_indices() + + return + end subroutine fldlst + +!######################################################################################### + +subroutine print_active_fldlst() + + integer :: f, ff, i, t + integer :: num_patches + + character(len=6) :: prec_str + character(len=max_chars) :: fldname, fname_tmp + + type(active_entry), pointer :: hfile(:) => null() ! history files + + if (masterproc) then + + hfile=>history_tape + + do t=1,ptapes + + if (nflds(t) > 0) then + write(iulog,*) ' ' + write(iulog,*)'FLDLST: History file ', t, ' contains ', nflds(t), ' fields' + + if (is_initfile(file_index=t)) then + write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' + else + if (nhtfrq(t) == 0) then + write(iulog,*) ' Write frequency: MONTHLY' + else + write(iulog,*) ' Write frequency: ',nhtfrq(t) + end if + end if + + write(iulog,*) ' Filename specifier: ', trim(hfilename_spec(t)) + + prec_str = 'double' + if (ndens(t) == 2) prec_str = 'single' + write(iulog,*) ' Output precision: ', prec_str + write(iulog,*) ' Number of time samples per file: ', mfilt(t) + + ! grid info + if (associated(hfile(t)%patches)) then + write(iulog,*) ' Fields are represented on columns (FIELD_LON_LAT)' + else if (associated(hfile(t)%grid_ids)) then + write(iulog,*) ' Fields are represented on global grids:' + do i = 1, size(hfile(t)%grid_ids) + write(iulog,*) ' ', hfile(t)%grid_ids(i) + end do + else + call endrun('print_active_fldlst: error in active_entry object') + end if + + write(iulog,*)' Included fields are:' + + end if + + do f = 1, nflds(t) + if (associated(hfile(t)%patches)) then + num_patches = size(hfile(t)%patches) + fldname = strip_suffix(hfile(t)%hlist(f)%field%name) + do i = 1, num_patches + ff = (f-1)*num_patches + i + fname_tmp = trim(fldname) + call hfile(t)%patches(i)%field_name(fname_tmp) + write(iulog,9000) ff, fname_tmp, hfile(t)%hlist(f)%field%units, & + hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & + trim(hfile(t)%hlist(f)%field%long_name) + end do + else + fldname = hfile(t)%hlist(f)%field%name + write(iulog,9000) f, fldname, hfile(t)%hlist(f)%field%units, & + hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & + trim(hfile(t)%hlist(f)%field%long_name) + end if + + end do + + end do + + end if + +9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, 256a) + +end subroutine print_active_fldlst + +!######################################################################################### + + subroutine inifld (t, listentry, avgflag, prec_wrt) + use cam_grid_support, only: cam_grid_is_zonal + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add a field to the active list for a history tape + ! + ! Method: Copy the data from the master field list to the active list for the tape + ! Also: define mapping arrays from (col,chunk) -> (lon,lat) + ! + ! Author: CCM Core Group + ! + !----------------------------------------------------------------------- + + + ! + ! Arguments + ! + integer, intent(in) :: t ! history tape index + + type(master_entry), pointer :: listentry + + character(len=1), intent(in) :: avgflag ! averaging flag + character(len=1), intent(in) :: prec_wrt ! history output precision flag + ! + ! Local workspace + ! + integer :: n ! field index on defined tape + + + ! + ! Ensure that it is not to late to add a field to the history tape + ! + if (htapes_defined) then + call endrun ('INIFLD: Attempt to add field '//listentry%field%name//' after history files set') + end if + + nflds(t) = nflds(t) + 1 + n = nflds(t) + ! + ! Copy field info. + ! + if(n > size(tape(t)%hlist)) then + write(iulog,*) 'tape field miscount error ', n, size(tape(t)%hlist) + call endrun() + end if + + tape(t)%hlist(n)%field = listentry%field + + select case (prec_wrt) + case (' ') + if (ndens(t) == 1) then + tape(t)%hlist(n)%hwrt_prec = 8 + else + tape(t)%hlist(n)%hwrt_prec = 4 + end if + case ('4') + tape(t)%hlist(n)%hwrt_prec = 4 + if (masterproc) then + write(iulog,*) 'INIFLD: Output data type for ', tape(t)%hlist(n)%field%name, & + ' is real*4' + end if + case ('8') + tape(t)%hlist(n)%hwrt_prec = 8 + if (masterproc) then + write(iulog,*) 'INIFLD: Output data type for ', tape(t)%hlist(n)%field%name, & + ' is real*8' + end if + case default + call endrun ('INIFLD: unknown prec_wrt='//prec_wrt) + end select + ! + ! Override the default averaging (masterlist) averaging flag if non-blank + ! + if (avgflag == ' ') then + tape(t)%hlist(n)%avgflag = listentry%avgflag(t) + tape(t)%hlist(n)%time_op = listentry%time_op(t) + else + tape(t)%hlist(n)%avgflag = avgflag + call AvgflagToString(avgflag, tape(t)%hlist(n)%time_op) + end if + + ! Some things can't be done with zonal fields + if (cam_grid_is_zonal(listentry%field%decomp_type)) then + if (tape(t)%hlist(n)%avgflag == 'L') then + call endrun("Cannot perform local time processing on zonal data ("//trim(listentry%field%name)//")") + else if (is_satfile(t)) then + call endrun("Zonal data not valid for satellite history ("//trim(listentry%field%name)//")") + end if + end if + +#ifdef HDEBUG + if (masterproc) then + write(iulog,'(a,i0,3a,i0,a,i2)')'HDEBUG: ',__LINE__,' field ', & + trim(tape(t)%hlist(n)%field%name), ' added as field number ', n, & + ' on tape ', t + write(iulog,'(2a)')' units = ',trim(tape(t)%hlist(n)%field%units) + write(iulog,'(a,i0)')' numlev = ',tape(t)%hlist(n)%field%numlev + write(iulog,'(2a)')' avgflag = ',tape(t)%hlist(n)%avgflag + write(iulog,'(3a)')' time_op = "',trim(tape(t)%hlist(n)%time_op),'"' + write(iulog,'(a,i0)')' hwrt_prec = ',tape(t)%hlist(n)%hwrt_prec + end if +#endif + + return + end subroutine inifld + + + subroutine patch_init(t) + use cam_history_support, only: history_patch_t + use cam_grid_support, only: cam_grid_compute_patch + + ! Dummy arguments + integer, intent(in) :: t ! Current tape + + ! Local variables + integer :: ff ! Loop over fincllonlat entries + integer :: i ! General loop index + integer :: npatches + type(history_patch_t), pointer :: patchptr + + character(len=max_chars) :: errormsg + character(len=max_chars) :: lonlatname(pflds) + real(r8) :: beglon, beglat, endlon, endlat + + ! + ! Setup column information if this field will be written as group + ! First verify the column information in the namelist + ! Duplicates are an error, but we can just ignore them + ! + + ! I know, this shouldn't happen . . . yet: (better safe than sorry) + if (associated(tape(t)%patches)) then + do i = 1, size(tape(t)%patches) + call tape(t)%patches(i)%deallocate() + end do + deallocate(tape(t)%patches) + nullify(tape(t)%patches) + end if + + ! First, count the number of patches and check for duplicates + ff = 1 ! Index of fincllonlat entry + npatches = 0 ! Number of unique patches in namelist entry + do while (len_trim(fincllonlat(ff, t)) > 0) + npatches = npatches + 1 + lonlatname(npatches) = trim(fincllonlat(ff, t)) + ! Check for duplicates + do i = 1, npatches - 1 + if (trim(lonlatname(i)) == trim(lonlatname(npatches))) then + write(errormsg, '(a,i0,3a)') 'Duplicate fincl', t, 'lonlat entry.', & + 'Duplicate entry is ', trim(lonlatname(i)) + write(iulog, *) 'patch_init: WARNING: '//errormsg + ! Remove the new entry + lonlatname(npatches) = '' + npatches = npatches - 1 + exit + end if + end do + ff = ff + 1 + end do + + ! Now we know how many patches, allocate space + if (npatches > 0) then + if (collect_column_output(t)) then + allocate(tape(t)%patches(1)) + else + allocate(tape(t)%patches(npatches)) + end if + + ! For each lat/lon specification, parse and create a patch for each grid + do ff = 1, npatches + if (collect_column_output(t)) then + ! For colleccted column output, we only have one patch + patchptr => tape(t)%patches(1) + else + patchptr => tape(t)%patches(ff) + patchptr%namelist_entry = trim(lonlatname(ff)) + end if + ! We need to set up one patch per (active) grid + patchptr%collected_output = collect_column_output(t) + call parseLonLat(lonlatname(ff), & + beglon, endlon, patchptr%lon_axis_name, & + beglat, endlat, patchptr%lat_axis_name) + if (associated(patchptr%patches)) then + ! One last sanity check + if (.not. collect_column_output(t)) then + write(errormsg, '(a,i0,2a)') 'Attempt to overwrite fincl', t, & + 'lonlat entry, ', trim(patchptr%namelist_entry) + call endrun('patch_init: '//errormsg) + end if + else + allocate(patchptr%patches(size(tape(t)%grid_ids))) + end if + do i = 1, size(tape(t)%grid_ids) + call cam_grid_compute_patch(tape(t)%grid_ids(i), patchptr%patches(i),& + beglon, endlon, beglat, endlat, collect_column_output(t)) + end do + nullify(patchptr) + end do + end if + ! We are done processing this tape's fincl#lonlat entries. Now, + ! compact each patch so that the output variables have no holes + ! We wait until now for when collect_column_output(t) is .true. since + ! all the fincl#lonlat entries are concatenated + if (associated(tape(t)%patches)) then + do ff = 1, size(tape(t)%patches) + call tape(t)%patches(ff)%compact() + end do + end if + + end subroutine patch_init + + !####################################################################### + + subroutine strip_null(str) + character(len=*), intent(inout) :: str + integer :: i + do i=1,len(str) + if(ichar(str(i:i))==0) str(i:i)=' ' + end do + end subroutine strip_null + + character(len=max_fieldname_len) function strip_suffix (name) + ! + !---------------------------------------------------------- + ! + ! Purpose: Strip "&IC" suffix from fieldnames if it exists + ! + !---------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: name + ! + ! Local workspace + ! + integer :: n + ! + !----------------------------------------------------------------------- + ! + strip_suffix = ' ' + + do n = 1,fieldname_len + strip_suffix(n:n) = name(n:n) + if(name(n+1:n+1 ) == ' ' ) return + if(name(n+1:n+fieldname_suffix_len) == fieldname_suffix) return + end do + + strip_suffix(fieldname_len+1:max_fieldname_len) = name(fieldname_len+1:max_fieldname_len) + + return + + end function strip_suffix + + !####################################################################### + + character(len=fieldname_len) function getname (inname) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: retrieve name portion of inname + ! + ! Method: If an averaging flag separater character is present (":") in inname, + ! lop it off + ! + !------------------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: inname + ! + ! Local workspace + ! + integer :: length + integer :: i + + length = len (inname) + + if (length < fieldname_len .or. length > fieldname_lenp2) then + write(iulog,*) 'GETNAME: bad length=',length + call endrun + end if + + getname = ' ' + do i=1,fieldname_len + if (inname(i:i) == ':') exit + getname(i:i) = inname(i:i) + end do + + return + end function getname + + !####################################################################### + + ! parseRangeString: Parse either a coordinate descriptor (e.g., 10S) or a + ! coordinate range (e.g., 10e:20e) + ! chars represents the allowed coordinate character. + ! NB: Does not validate numerical values (e.g., lat <= 90) + subroutine parseRangeString(rangestr, chars, begval, begchar, begname, endval, endchar, endname) + + ! Dummy arguments + character(len=*), intent(in) :: rangestr + character(len=*), intent(in) :: chars + real(r8), intent(out) :: begval + character, intent(out) :: begchar + character(len=*), intent(out) :: begname + real(r8), intent(out) :: endval + character, intent(out) :: endchar + character(len=*), intent(out) :: endname + + ! Local variables + character(len=128) :: errormsg + integer :: colonpos + integer :: beglen, endlen + + ! First, see if we have a position or a range + colonpos = scan(rangestr, ':') + if (colonpos == 0) then + begname = trim(rangestr) + beglen = len_trim(begname) + endname = trim(begname) + else + beglen = colonpos - 1 + begname = rangestr(1:beglen) + endname = trim(rangestr(colonpos+1:)) + endlen = len_trim(endname) + end if + ! begname should be a number (integer or real) followed by a character + if (verify(begname, '0123456789.') /= beglen) then + write(errormsg, *) 'Coordinate range must begin with number, ', begname + call endrun('parseRangeString: '//errormsg) + end if + if (verify(begname(beglen:beglen), chars) /= 0) then + write(errormsg, *) 'Coordinate range must end with character in the ', & + 'set [', trim(chars), '] ', begname + call endrun('parseRangeString: '//errormsg) + end if + ! begname parses so collect the values + read(begname(1:beglen-1), *) begval + begchar = begname(beglen:beglen) + if (colonpos /= 0) then + ! endname should be a number (integer or real) followed by a character + if (verify(endname, '0123456789.') /= endlen) then + write(errormsg, *) 'Coordinate range must begin with number, ', endname + call endrun('parseRangeString: '//errormsg) + end if + if (verify(endname(endlen:endlen), chars) /= 0) then + write(errormsg, *) 'Coordinate range must end with character in the ',& + 'set [', trim(chars), '] ', endname + call endrun('parseRangeString: '//errormsg) + end if + ! endname parses so collect the values + read(endname(1:endlen-1), *) endval + endchar = endname(endlen:endlen) + else + endval = begval + endchar = begchar + end if + + end subroutine parseRangeString + + ! parseLonLat: Parse a lon_lat description allowed by the fincllonlat(n) + ! namelist entries. Returns the starting and ending values of + ! the point or range specified. + ! NB: Does not validate the range against any particular grid + subroutine parseLonLat(lonlatname, beglon, endlon, lonname, beglat, endlat, latname) + + ! Dummy arguments + character(len=*), intent(in) :: lonlatname + real(r8), intent(out) :: beglon + real(r8), intent(out) :: endlon + character(len=*), intent(out) :: lonname + real(r8), intent(out) :: beglat + real(r8), intent(out) :: endlat + character(len=*), intent(out) :: latname + + ! Local variables + character(len=128) :: errormsg + character(len=MAX_CHARS) :: lonstr, latstr + character(len=MAX_CHARS) :: begname, endname + character :: begchar, endchar + integer :: underpos + + ! + ! make sure _ separator is present + ! + underpos = scan(lonlatname, '_') + if (underpos == 0) then + write(errormsg,*) 'Improperly formatted fincllonlat string. ', & + 'Missing underscore character (xxxE_yyyS) ', lonlatname + call endrun('parseLonLat: '//errormsg) + end if + + ! Break out the longitude and latitude sections + lonstr = lonlatname(:underpos-1) + latstr = trim(lonlatname(underpos+1:)) + + ! Parse the longitude section + call parseRangeString(lonstr, 'eEwW', beglon, begchar, begname, endlon, endchar, endname) + ! Convert longitude to degrees East + if ((begchar == 'w') .or. (begchar == 'W')) then + if (beglon > 0.0_r8) then + beglon = 360._r8 - beglon + end if + end if + if ((beglon < 0._r8) .or. (beglon > 360._r8)) then + write(errormsg, *) 'Longitude specification out of range, ', trim(begname) + call endrun('parseLonLat: '//errormsg) + end if + if ((endchar == 'w') .or. (endchar == 'W')) then + if (endlon > 0.0_r8) then + endlon = 360._r8 - endlon + end if + end if + if ((endlon < 0._r8) .or. (endlon > 360._r8)) then + write(errormsg, *) 'Longitude specification out of range, ', trim(endname) + call endrun('parseLonLat: '//errormsg) + end if + if (beglon == endlon) then + lonname = trim(begname) + else + lonname = trim(begname)//'_to_'//trim(endname) + end if + + ! Parse the latitude section + call parseRangeString(latstr, 'nNsS', beglat, begchar, begname, endlat, endchar, endname) + ! Convert longitude to degrees East + if ((begchar == 's') .or. (begchar == 'S')) then + beglat = (-1._r8) * beglat + end if + if ((beglat < -90._r8) .or. (beglat > 90._r8)) then + write(errormsg, *) 'Latitude specification out of range, ', trim(begname) + call endrun('parseLonLat: '//errormsg) + end if + if ((endchar == 's') .or. (endchar == 'S')) then + endlat = (-1._r8) * endlat + end if + if ((endlat < -90._r8) .or. (endlat > 90._r8)) then + write(errormsg, *) 'Latitude specification out of range, ', trim(endname) + call endrun('parseLonLat: '//errormsg) + end if + if (beglat == endlat) then + latname = trim(begname) + else + latname = trim(begname)//'_to_'//trim(endname) + end if + + end subroutine parseLonLat + + + !####################################################################### + + character(len=1) function getflag (inname) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: retrieve flag portion of inname + ! + ! Method: If an averaging flag separater character is present (":") in inname, + ! return the character after it as the flag + ! + !------------------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: inname ! character string + ! + ! Local workspace + ! + integer :: length ! length of inname + integer :: i ! loop index + + length = len (inname) + + if (length /= fieldname_lenp2) then + write(iulog,*) 'GETFLAG: bad length=',length + call endrun + end if + + getflag = ' ' + do i=1,fieldname_lenp2-1 + if (inname(i:i) == ':') then + getflag = inname(i+1:i+1) + exit + end if + end do + + return + end function getflag + + !####################################################################### + + subroutine list_index (list, name, index) + ! + ! Input arguments + ! + character(len=*), intent(in) :: list(pflds) ! input list of names, possibly ":" delimited + character(len=max_fieldname_len), intent(in) :: name ! name to be searched for + ! + ! Output arguments + ! + integer, intent(out) :: index ! index of "name" in "list" + ! + ! Local workspace + ! + character(len=fieldname_len) :: listname ! input name with ":" stripped off. + integer f ! field index + + index = 0 + do f=1,pflds + ! + ! Only list items + ! + listname = getname (list(f)) + if (listname == ' ') exit + if (listname == name) then + index = f + exit + end if + end do + + return + end subroutine list_index + + !####################################################################### + + recursive subroutine outfld (fname, field, idim, c, avg_subcol_field) + use cam_history_buffers, only: hbuf_accum_inst, hbuf_accum_add, hbuf_accum_variance, & + hbuf_accum_add00z, hbuf_accum_max, hbuf_accum_min, & + hbuf_accum_addlcltime + use cam_history_support, only: dim_index_2d + use subcol_pack_mod, only: subcol_unpack + use cam_grid_support, only: cam_grid_id + + interface + subroutine subcol_field_avg_handler(idim, field_in, c, field_out) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: idim + real(r8), intent(in) :: field_in(idim, *) + integer, intent(in) :: c + real(r8), intent(out) :: field_out(:,:) + end subroutine subcol_field_avg_handler + end interface + + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Accumulate (or take min, max, etc. as appropriate) input field + ! into its history buffer for appropriate tapes + ! + ! Method: Check 'masterlist' whether the requested field 'fname' is active + ! on one or more history tapes, and if so do the accumulation. + ! If not found, return silently. + ! subcol_field_avg_handler: + ! An interface into subcol_field_avg without creating a dependency as + ! this would cause a dependency loop. See subcol.F90 + ! Note: We cannot know a priori if field is a grid average field or a subcolumn + ! field because many fields passed to outfld are defined on ncol rather + ! than pcols or psetcols. Therefore, we use the avg_subcol_field input + ! to determine whether to average the field input before accumulation. + ! NB: If output is on a subcolumn grid (requested in addfle), it is + ! an error to use avg_subcol_field. A subcolumn field is assumed and + ! subcol_unpack is called before accumulation. + ! + ! Author: CCM Core Group + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: fname ! Field name--should be 8 chars long + + ! For structured grids, idim is the local longitude dimension. + ! For unstructured grids, idim is the local column dimension + ! For phys_decomp, it should be pcols or pcols*psubcols + integer, intent(in) :: idim + real(r8), intent(in) :: field(idim,*) ! Array containing field values + integer, intent(in) :: c ! chunk (physics) or latitude (dynamics) index + logical, optional, intent(in) :: avg_subcol_field + ! + ! Local variables + ! + integer :: t, f ! tape, field indices + + character*1 :: avgflag ! averaging flag + + type (active_entry), pointer :: otape(:) ! Local history_tape pointer + real(r8),pointer :: hbuf(:,:) ! history buffer + real(r8),pointer :: sbuf(:,:) ! variance buffer + integer, pointer :: nacs(:) ! accumulation counter + integer :: begdim2, enddim2, endi + integer :: phys_decomp + type (dim_index_2d) :: dimind ! 2-D dimension index + logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8) :: fillvalue + real(r8), allocatable :: afield(:,:) ! Averaged field values + real(r8), allocatable :: ufield(:,:,:) ! Unpacked field values + integer :: ff ! masterlist index pointer + integer :: i, j + logical :: found + logical :: avg_subcols ! average subcols before accum + !----------------------------------------------------------------------- + + call get_field_properties(fname, found, tape_out=otape, ff_out=ff) + phys_decomp = cam_grid_id('physgrid') + + ! If this field is not active, return now + if (.not. found) then + return + end if + + ! + ! Note, the field may be on any or all of the history files (primary + ! and auxiliary). + ! + ! write(iulog,*)'fname_loc=',fname_loc + do t = 1, ptapes + if ( .not. masterlist(ff)%thisentry%actflag(t)) cycle + f = masterlist(ff)%thisentry%htapeindx(t) + ! + ! Update history buffer + ! + flag_xyfill = otape(t)%hlist(f)%field%flag_xyfill + fillvalue = otape(t)%hlist(f)%field%fillvalue + avgflag = otape(t)%hlist(f)%avgflag + nacs => otape(t)%hlist(f)%nacs(:,c) + hbuf => otape(t)%hlist(f)%hbuf(:,:,c) + if (associated(tape(t)%hlist(f)%sbuf)) then + sbuf => otape(t)%hlist(f)%sbuf(:,:,c) + endif + dimind = otape(t)%hlist(f)%field%get_dims(c) + + ! See notes above about validity of avg_subcol_field + if (otape(t)%hlist(f)%field%is_subcol) then + if (present(avg_subcol_field)) then + call endrun('OUTFLD: Cannot average '//trim(fname)//', subcolumn output was requested in addfld') + end if + avg_subcols = .false. + else if (otape(t)%hlist(f)%field%decomp_type == phys_decomp) then + if (present(avg_subcol_field)) then + avg_subcols = avg_subcol_field + else + avg_subcols = .false. + end if + else ! Any dynamics decomposition + if (present(avg_subcol_field)) then + call endrun('OUTFLD: avg_subcol_field only valid for physgrid') + else + avg_subcols = .false. + end if + end if + + begdim2 = otape(t)%hlist(f)%field%begdim2 + enddim2 = otape(t)%hlist(f)%field%enddim2 + if (avg_subcols) then + allocate(afield(pcols, begdim2:enddim2)) + call subcol_field_avg_handler(idim, field, c, afield) + ! Hack! Avoid duplicating select statement below + call outfld(fname, afield, pcols, c) + deallocate(afield) + else if (otape(t)%hlist(f)%field%is_subcol) then + ! We have to assume that using mdimnames (e.g., psubcols) is + ! incompatible with the begdimx, enddimx usage (checked in addfld) + ! Since psubcols is included in levels, take that out + endi = (enddim2 - begdim2 + 1) / psubcols + allocate(ufield(pcols, psubcols, endi)) + allocate(afield(pcols*psubcols, endi)) + do j = 1, endi + do i = 1, idim + afield(i, j) = field(i, j) + end do + end do + ! Initialize unused aray locations. + if (idim < pcols*psubcols) then + if (flag_xyfill) then + afield(idim+1:pcols*psubcols, :) = fillvalue + else + afield(idim+1:pcols*psubcols, :) = 0.0_r8 + end if + end if + if (flag_xyfill) then + call subcol_unpack(c, afield, ufield, fillvalue) + else + call subcol_unpack(c, afield, ufield) + end if + deallocate(afield) + select case (avgflag) + + case ('I') ! Instantaneous + call hbuf_accum_inst(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + + case ('A') ! Time average + call hbuf_accum_add(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + + case ('B') ! Time average only 00z values + call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + + case ('X') ! Maximum over time + call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + + case ('M') ! Minimum over time + call hbuf_accum_min(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + + case ('L') + call hbuf_accum_addlcltime(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue, c, & + otape(t)%hlist(f)%field%decomp_type, & + lcltod_start(t), lcltod_stop(t)) + + case ('S') ! Standard deviation + call hbuf_accum_variance(hbuf, sbuf, ufield, nacs, dimind, pcols,& + flag_xyfill, fillvalue) + + case default + call endrun ('OUTFLD: invalid avgflag='//avgflag) + + end select + deallocate(ufield) + else + select case (avgflag) + + case ('I') ! Instantaneous + call hbuf_accum_inst(hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + + case ('A') ! Time average + call hbuf_accum_add(hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + + case ('B') ! Time average only 00z values + call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + + case ('X') ! Maximum over time + call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + + case ('M') ! Minimum over time + call hbuf_accum_min(hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + + case ('L') + call hbuf_accum_addlcltime(hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue, c, & + otape(t)%hlist(f)%field%decomp_type, & + lcltod_start(t), lcltod_stop(t)) + + case ('S') ! Standard deviation + call hbuf_accum_variance(hbuf, sbuf, field, nacs, dimind, idim,& + flag_xyfill, fillvalue) + + case default + call endrun ('OUTFLD: invalid avgflag='//avgflag) + + end select + end if + + end do + + return + end subroutine outfld + + !####################################################################### + + subroutine get_field_properties(fname, found, tape_out, ff_out) + + implicit none + ! + !----------------------------------------------------------------------- + ! + ! Purpose: If fname is active, lookup and return field information + ! + ! Method: Check 'masterlist' whether the requested field 'fname' is active + ! on one or more history tapes, and if so, return the requested + ! field information + ! + ! Author: goldy + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: fname ! Field name--should be 8 chars long + logical, intent(out) :: found ! Set to true if fname is active + type(active_entry), pointer, optional :: tape_out(:) + integer, intent(out), optional :: ff_out + + ! + ! Local variables + ! + character*(max_fieldname_len) :: fname_loc ! max-char equivalent of fname + integer :: t, ff ! tape, masterindex indices + !----------------------------------------------------------------------- + + ! Need to re-cast the field name so that the hashing works #hackalert + fname_loc = fname + ff = get_masterlist_indx(fname_loc) + + ! Set found to .false. so we can return early if fname is not active + found = .false. + if (present(tape_out)) then + nullify(tape_out) + end if + if (present(ff_out)) then + ff_out = -1 + end if + + ! + ! If ( ff < 0 ), the field is not defined on the masterlist. This check + ! is necessary because of coding errors calling outfld without first defining + ! the field on masterlist. + ! + if ( ff < 0 ) then + return + end if + ! + ! Next, check to see whether this field is active on one or more history + ! tapes. + ! + if ( .not. masterlist(ff)%thisentry%act_sometape ) then + return + end if + ! + ! Note, the field may be on any or all of the history files (primary + ! and auxiliary). + ! + + do t=1, ptapes + if (masterlist(ff)%thisentry%actflag(t)) then + found = .true. + if (present(tape_out)) then + tape_out => history_tape + end if + if (present(ff_out)) then + ff_out = ff + end if + ! We found the info so we are done with the loop + exit + end if + end do + + end subroutine get_field_properties + + !####################################################################### + + logical function is_initfile (file_index) + ! + !------------------------------------------------------------------------ + ! + ! Purpose: to determine: + ! + ! a) if an IC file is active in this model run at all + ! OR, + ! b) if it is active, is the current file index referencing the IC file + ! (IC file is always at ptapes) + ! + !------------------------------------------------------------------------ + ! + ! Arguments + ! + integer, intent(in), optional :: file_index ! index of file in question + + is_initfile = .false. + + if (present(file_index)) then + if (inithist /= 'NONE' .and. file_index == ptapes) is_initfile = .true. + else + if (inithist /= 'NONE' ) is_initfile = .true. + end if + + return + + end function is_initfile + + !####################################################################### + + integer function strcmpf (name1, name2) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Return the lexical difference between two strings + ! + ! Method: Use ichar() intrinsic as we loop through the names + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=max_fieldname_len), intent(in) :: name1, name2 ! strings to compare + integer n ! loop index + + do n=1,max_fieldname_len + strcmpf = ichar(name1(n:n)) - ichar(name2(n:n)) + if (strcmpf /= 0) exit + end do + + return + end function strcmpf + + !####################################################################### + + subroutine h_inquire (t) + use pio, only: pio_inq_varid, pio_inq_attlen + use cam_pio_utils, only: cam_pio_handle_error + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Ensure that the proper variables are on a history file + ! + ! Method: Issue the appropriate netcdf wrapper calls + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + integer :: f ! field index + integer :: ierr + integer :: i + integer :: num_patches + integer(pio_offset_kind) :: mdimsize + character(len=max_chars) :: fldname, fname_tmp, basename + + ! + ! + ! Dimension id's + ! + tape => history_tape + + + + ! + ! Create variables for model timing and header information + ! + if(.not. is_satfile(t)) then + ierr=pio_inq_varid (tape(t)%File,'ndcur ', tape(t)%ndcurid) + ierr=pio_inq_varid (tape(t)%File,'nscur ', tape(t)%nscurid) + ierr=pio_inq_varid (tape(t)%File,'nsteph ', tape(t)%nstephid) + + ierr=pio_inq_varid (tape(t)%File,'time_bnds', tape(t)%tbndid) + ierr=pio_inq_varid (tape(t)%File,'date_written',tape(t)%date_writtenid) + ierr=pio_inq_varid (tape(t)%File,'time_written',tape(t)%time_writtenid) +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) + ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) +#endif + if (.not. is_initfile(file_index=t) ) then + ! Don't write the GHG/Solar forcing data to the IC file. It is never + ! read from that file so it's confusing to have it there. + ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) + ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) + ierr=pio_inq_varid (tape(t)%File,'n2ovmr ', tape(t)%n2ovmrid) + ierr=pio_inq_varid (tape(t)%File,'f11vmr ', tape(t)%f11vmrid) + ierr=pio_inq_varid (tape(t)%File,'f12vmr ', tape(t)%f12vmrid) + ierr=pio_inq_varid (tape(t)%File,'sol_tsi ', tape(t)%sol_tsiid) + if (solar_parms_on) then + ierr=pio_inq_varid (tape(t)%File,'f107 ', tape(t)%f107id) + ierr=pio_inq_varid (tape(t)%File,'f107a ', tape(t)%f107aid) + ierr=pio_inq_varid (tape(t)%File,'f107p ', tape(t)%f107pid) + ierr=pio_inq_varid (tape(t)%File,'kp ', tape(t)%kpid) + ierr=pio_inq_varid (tape(t)%File,'ap ', tape(t)%apid) + endif + end if + end if + ierr=pio_inq_varid (tape(t)%File,'date ', tape(t)%dateid) + ierr=pio_inq_varid (tape(t)%File,'datesec ', tape(t)%datesecid) + ierr=pio_inq_varid (tape(t)%File,'time ', tape(t)%timeid) + + + ! + ! Obtain variable name from ID which was read from restart file + ! + do f=1,nflds(t) + if(.not. associated(tape(t)%hlist(f)%varid)) then + if (associated(tape(t)%patches)) then + allocate(tape(t)%hlist(f)%varid(size(tape(t)%patches))) + else + allocate(tape(t)%hlist(f)%varid(1)) + end if + end if + ! + ! If this field will be put out as columns then get column names for field + ! + if (associated(tape(t)%patches)) then + num_patches = size(tape(t)%patches) + fldname = strip_suffix(tape(t)%hlist(f)%field%name) + do i = 1, num_patches + fname_tmp = trim(fldname) + call tape(t)%patches(i)%field_name(fname_tmp) + ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp), tape(t)%hlist(f)%varid(i)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) + ierr = pio_get_att(tape(t)%File, tape(t)%hlist(f)%varid(i), 'basename', basename) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) + if (trim(fldname) /= trim(basename)) then + call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') + end if + end do + else + fldname = tape(t)%hlist(f)%field%name + ierr = pio_inq_varid(tape(t)%File, trim(fldname), tape(t)%hlist(f)%varid(1)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) + end if + if(tape(t)%hlist(f)%field%numlev>1) then + ierr = pio_inq_attlen(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', mdimsize) + if(.not. associated(tape(t)%hlist(f)%field%mdims)) then + allocate(tape(t)%hlist(f)%field%mdims(mdimsize)) + end if + ierr=pio_get_att(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', & + tape(t)%hlist(f)%field%mdims(1:mdimsize)) + if(mdimsize>maxvarmdims) maxvarmdims=mdimsize + end if + + end do + + if(masterproc) then + write(iulog,*)'H_INQUIRE: Successfully opened netcdf file ' + end if + + return + end subroutine h_inquire + + !####################################################################### + + subroutine add_default (name, tindex, flag) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add a field to the default "on" list for a given history file + ! + ! Method: + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: name ! field name + character(len=1), intent(in) :: flag ! averaging flag + + integer, intent(in) :: tindex ! history tape index + ! + ! Local workspace + ! + integer :: t ! file index + type(master_entry), pointer :: listentry + + if (htapes_defined) then + call endrun ('ADD_DEFAULT: Attempt to add hist default '//trim(name)//' after history files set') + end if + ! + ! Check validity of input arguments + ! + if (tindex > ptapes) then + write(iulog,*)'ADD_DEFAULT: tape index=', tindex, ' is too big' + call endrun + end if + + ! Add to IC file if tindex = 0, reset to ptapes + if (tindex == 0) then + t = ptapes + if ( .not. is_initfile(file_index=t) ) return + else + t = tindex + end if + + if (verify(flag, HIST_AVG_FLAGS) /= 0) then + call endrun ('ADD_DEFAULT: unknown averaging flag='//flag) + end if + ! + ! Look through master list for input field name. When found, set active + ! flag for that tape to true. Also set averaging flag if told to use other + ! than default. + ! + listentry => get_entry_by_name(masterlinkedlist, trim(name)) + if(.not.associated(listentry)) then + call endrun ('ADD_DEFAULT: field = "'//trim(name)//'" not found') + end if + listentry%actflag(t) = .true. + if (flag /= ' ') then + listentry%avgflag(t) = flag + call AvgflagToString(flag, listentry%time_op(t)) + end if + + return + end subroutine add_default + + !####################################################################### + + subroutine h_override (t) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Override default history tape contents for a specific tape + ! + ! Method: Copy the flag into the master field list + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: t ! history tape index + ! + ! Local workspace + ! + character(len=1) :: avgflg ! lcl equiv of avgflag_pertape(t) (to address xlf90 compiler bug) + + type(master_entry), pointer :: listentry + + + avgflg = avgflag_pertape(t) + + + listentry=>masterlinkedlist + do while(associated(listentry)) + call AvgflagToString(avgflg, listentry%time_op(t)) + listentry%avgflag(t) = avgflag_pertape(t) + listentry=>listentry%next_entry + end do + + end subroutine h_override + + !####################################################################### + + subroutine h_define (t, restart) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Define contents of history file t + ! + ! Method: Issue the required netcdf wrapper calls to define the history file contents + ! + !----------------------------------------------------------------------- + use cam_grid_support, only: cam_grid_header_info_t + use cam_grid_support, only: cam_grid_write_attr, cam_grid_write_var + use time_manager, only: get_step_size, get_ref_date, timemgr_get_calendar_cf + use cam_abortutils, only: endrun + use cam_pio_utils, only: vdesc_ptr, cam_pio_handle_error, cam_pio_def_dim + use cam_pio_utils, only: cam_pio_createfile, cam_pio_def_var + use sat_hist, only: sat_hist_define + + !----------------------------------------------------------------------- + + ! + ! Input arguments + ! + integer, intent(in) :: t ! tape index + logical, intent(in) :: restart + ! + ! Local workspace + ! + integer :: i, j ! longitude, latitude indices + integer :: grd ! indices for looping through grids + integer :: f ! field index + integer :: ncreal ! real data type for output + integer :: dtime ! timestep size + integer :: sec_nhtfrq ! nhtfrq converted to seconds + integer :: ndbase = 0 ! days component of base time + integer :: nsbase = 0 ! seconds component of base time + integer :: nbdate ! base date in yyyymmdd format + integer :: nbsec ! time of day component of base date [seconds] + integer :: yr, mon, day ! year, month, day components of a date + + character(len=max_chars) :: str ! character temporary + character(len=max_chars) :: fname_tmp ! local copy of field name + character(len=max_chars) :: calendar ! Calendar type + character(len=max_chars) :: cell_methods ! For cell_methods attribute + character(len=16) :: time_per_freq + character(len=128) :: errormsg + + integer :: ret ! function return value + + ! + ! netcdf dimensions + ! + integer :: chardim ! character dimension id + integer :: dimenchar(2) ! character dimension ids + integer :: nacsdims(2) ! dimension ids for nacs (used in restart file) + integer :: bnddim ! bounds dimension id + integer :: timdim ! unlimited dimension id + + integer :: dimindex(8) ! dimension ids for variable declaration + integer :: dimids_tmp(8) ! dimension ids for variable declaration + + ! + ! netcdf variables + ! + ! A structure to hold the horizontal dimension and coordinate info + type(cam_grid_header_info_t), allocatable :: header_info(:) + ! For satellite files and column output + type(vdesc_ptr), allocatable :: latvar(:) ! latitude variable ids + type(vdesc_ptr), allocatable :: lonvar(:) ! longitude variable ids + + type(var_desc_t), pointer :: varid => NULL() ! temporary variable descriptor + integer :: num_hdims, fdims + integer :: num_patches ! How many entries for a field on this tape? + integer, pointer :: mdims(:) => NULL() + integer :: mdimsize + integer :: ierr + integer, allocatable :: mdimids(:) + integer :: amode + logical :: interpolate + logical :: patch_output + + if(restart) then + tape => restarthistory_tape + if(masterproc) write(iulog,*)'Opening netcdf history restart file ', trim(hrestpath(t)) + else + tape => history_tape + if(masterproc) write(iulog,*)'Opening netcdf history file ', trim(nhfil(t)) + end if + + amode = PIO_CLOBBER + + if(restart) then + call cam_pio_createfile (tape(t)%File, hrestpath(t), amode) + else + call cam_pio_createfile (tape(t)%File, nhfil(t), amode) + end if + if(is_satfile(t)) then + interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? + patch_output = .false. + call cam_pio_def_dim(tape(t)%File, 'ncol', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim) + + allocate(latvar(1), lonvar(1)) + allocate(latvar(1)%vd, lonvar(1)%vd) + call cam_pio_def_var(tape(t)%File, 'lat', pio_double, (/timdim/), & + latvar(1)%vd) + ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'long_name', 'latitude') + ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'units', 'degrees_north') + + call cam_pio_def_var(tape(t)%File, 'lon', pio_double, (/timdim/), & + lonvar(1)%vd) + ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'long_name','longitude') + ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'units','degrees_east') + + else + ! + ! Setup netcdf file - create the dimensions of lat,lon,time,level + ! + ! interpolate is only supported for unstructured dycores + interpolate = (interpolate_output(t) .and. (.not. restart)) + patch_output = (associated(tape(t)%patches) .and. (.not. restart)) + + ! First define the horizontal grid dims + ! Interpolation is special in that we ignore the native grids + if(interpolate) then + allocate(header_info(1)) + call cam_grid_write_attr(tape(t)%File, interpolate_info(t)%grid_id, header_info(1)) + else if (patch_output) then + ! We are doing patch (column) output + if (allocated(header_info)) then + ! We shouldn't have any header_info yet + call endrun('H_DEFINE: header_info should not be allocated for patch output') + end if + do i = 1, size(tape(t)%patches) + call tape(t)%patches(i)%write_attrs(tape(t)%File) + end do + else + allocate(header_info(size(tape(t)%grid_ids))) + do i = 1, size(tape(t)%grid_ids) + call cam_grid_write_attr(tape(t)%File, tape(t)%grid_ids(i), header_info(i)) + end do + end if ! interpolate + + ! Define the unlimited time dim + call cam_pio_def_dim(tape(t)%File, 'time', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim, existOK=.true.) + call cam_pio_def_dim(tape(t)%File, 'chars', 8, chardim) + end if ! is satfile + + ! Populate the history coordinate (well, mdims anyway) attributes + ! This routine also allocates the mdimids array + call write_hist_coord_attrs(tape(t)%File, bnddim, mdimids, restart) + + call get_ref_date(yr, mon, day, nbsec) + nbdate = yr*10000 + mon*100 + day + ierr=pio_def_var (tape(t)%File,'time',pio_double,(/timdim/),tape(t)%timeid) + ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'long_name', 'time') + str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) + ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'units', trim(str)) + + calendar = timemgr_get_calendar_cf() + ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'calendar', trim(calendar)) + + + ierr=pio_def_var (tape(t)%File,'date ',pio_int,(/timdim/),tape(t)%dateid) + str = 'current date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%File, tape(t)%dateid, 'long_name', trim(str)) + + + ierr=pio_def_var (tape(t)%File,'datesec ',pio_int,(/timdim/), tape(t)%datesecid) + str = 'current seconds of current date' + ierr=pio_put_att (tape(t)%File, tape(t)%datesecid, 'long_name', trim(str)) + + ! + ! Character header information + ! + str = 'CF-1.0' + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'Conventions', trim(str)) + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'source', 'CAM') +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') +#endif + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'case',caseid) + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'logname',logname) + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'host', host) + +! Put these back in when they are filled properly +! ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'title',ctitle) +! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'Version', & +! '$Name$') +! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'revision_Id', & +! '$Id$') + + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'initial_file', ncdata) + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'topography_file', bnd_topo) + if (len_trim(model_doi_url) > 0) then + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'model_doi_url', model_doi_url) + end if + + ! Determine what time period frequency is being output for each file + ! Note that nhtfrq is now in timesteps + + sec_nhtfrq = nhtfrq(t) + + ! If nhtfrq is in hours, convert to seconds + if (nhtfrq(t) < 0) then + sec_nhtfrq = abs(nhtfrq(t))*3600 + end if + + dtime = get_step_size() + if (sec_nhtfrq == 0) then !month + time_per_freq = 'month_1' + else if (mod(sec_nhtfrq*dtime,86400) == 0) then ! day + write(time_per_freq,999) 'day_',sec_nhtfrq*dtime/86400 + else if (mod(sec_nhtfrq*dtime,3600) == 0) then ! hour + write(time_per_freq,999) 'hour_',(sec_nhtfrq*dtime)/3600 + else if (mod(sec_nhtfrq*dtime,60) == 0) then ! minute + write(time_per_freq,999) 'minute_',(sec_nhtfrq*dtime)/60 + else ! second + write(time_per_freq,999) 'second_',sec_nhtfrq*dtime + end if +999 format(a,i0) + + ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) + + if(.not. is_satfile(t)) then + + ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'bounds', 'time_bnds') + + ierr=pio_def_var (tape(t)%File,'time_bnds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) + ierr=pio_put_att (tape(t)%File, tape(t)%tbndid, 'long_name', 'time interval endpoints') + ! + ! Character + ! + dimenchar(1) = chardim + dimenchar(2) = timdim + ierr=pio_def_var (tape(t)%File,'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) + ierr=pio_def_var (tape(t)%File,'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) + ! + ! Integer Header + ! + + ierr=pio_def_var (tape(t)%File,'ndbase',PIO_INT,tape(t)%ndbaseid) + str = 'base day' + ierr=pio_put_att (tape(t)%File, tape(t)%ndbaseid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'nsbase',PIO_INT,tape(t)%nsbaseid) + str = 'seconds of base day' + ierr=pio_put_att (tape(t)%File, tape(t)%nsbaseid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'nbdate',PIO_INT,tape(t)%nbdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%File, tape(t)%nbdateid, 'long_name', trim(str)) + +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_def_var (tape(t)%File,'bdate',PIO_INT,tape(t)%bdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%File, tape(t)%bdateid, 'long_name', trim(str)) +#endif + ierr=pio_def_var (tape(t)%File,'nbsec',PIO_INT,tape(t)%nbsecid) + str = 'seconds of base date' + ierr=pio_put_att (tape(t)%File, tape(t)%nbsecid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'mdt',PIO_INT,tape(t)%mdtid) + ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'long_name', 'timestep') + ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'units', 's') + + ! + ! Create variables for model timing and header information + ! + + ierr=pio_def_var (tape(t)%File,'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) + str = 'current day (from base day)' + ierr=pio_put_att (tape(t)%File, tape(t)%ndcurid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'nscur ',pio_int,(/timdim/),tape(t)%nscurid) + str = 'current seconds of current day' + ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) + + + if (.not. is_initfile(file_index=t)) then + ! Don't write the GHG/Solar forcing data to the IC file. + ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) + str = 'co2 volume mixing ratio' + ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) + str = 'ch4 volume mixing ratio' + ierr=pio_put_att (tape(t)%File, tape(t)%ch4vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) + str = 'n2o volume mixing ratio' + ierr=pio_put_att (tape(t)%File, tape(t)%n2ovmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) + str = 'f11 volume mixing ratio' + ierr=pio_put_att (tape(t)%File, tape(t)%f11vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) + str = 'f12 volume mixing ratio' + ierr=pio_put_att (tape(t)%File, tape(t)%f12vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) + str = 'total solar irradiance' + ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'long_name', trim(str)) + str = 'W/m2' + ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'units', trim(str)) + + if (solar_parms_on) then + ! solar / geomagetic activity indices... + ierr=pio_def_var (tape(t)%File,'f107',pio_double,(/timdim/),tape(t)%f107id) + str = '10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'long_name', trim(str)) + str = '10^-22 W m^-2 Hz^-1' + ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%File,'f107a',pio_double,(/timdim/),tape(t)%f107aid) + str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%File, tape(t)%f107aid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'f107p',pio_double,(/timdim/),tape(t)%f107pid) + str = 'Pervious day 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%File, tape(t)%f107pid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'kp',pio_double,(/timdim/),tape(t)%kpid) + str = 'Daily planetary K geomagnetic index' + ierr=pio_put_att (tape(t)%File, tape(t)%kpid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%File,'ap',pio_double,(/timdim/),tape(t)%apid) + str = 'Daily planetary A geomagnetic index' + ierr=pio_put_att (tape(t)%File, tape(t)%apid, 'long_name', trim(str)) + endif + end if + + +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_def_var (tape(t)%File,'tsec ',pio_int,(/timdim/), tape(t)%tsecid) + str = 'current seconds of current date needed for scam' + ierr=pio_put_att (tape(t)%File, tape(t)%tsecid, 'long_name', trim(str)) +#endif + ierr=pio_def_var (tape(t)%File,'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) + str = 'current timestep' + ierr=pio_put_att (tape(t)%File, tape(t)%nstephid, 'long_name', trim(str)) + end if ! .not. is_satfile + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Create variables and attributes for field list + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do f = 1, nflds(t) + + !! Collect some field properties + call AvgflagToString(tape(t)%hlist(f)%avgflag, tape(t)%hlist(f)%time_op) + + if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then + ncreal = pio_double + else + ncreal = pio_real + end if + + if(associated(tape(t)%hlist(f)%field%mdims)) then + mdims => tape(t)%hlist(f)%field%mdims + mdimsize = size(mdims) + else if(tape(t)%hlist(f)%field%numlev > 1) then + call endrun('mdims not defined for variable '//trim(tape(t)%hlist(f)%field%name)) + else + mdimsize=0 + end if + + ! num_patches will loop through the number of patches (or just one + ! for the whole grid) for this field for this tape + if (patch_output) then + num_patches = size(tape(t)%patches) + else + num_patches = 1 + end if + if(.not.associated(tape(t)%hlist(f)%varid)) then + allocate(tape(t)%hlist(f)%varid(num_patches)) + end if + fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + call sat_hist_define(tape(t)%File) + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + dimindex(i) = header_info(1)%get_hdimid(i) + nacsdims(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(f)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(f)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(f)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + dimindex(i) = header_info(grd)%get_hdimid(i) + nacsdims(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile + + ! + ! Create variables and atributes for fields written out as columns + ! + + do i = 1, num_patches + fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + varid => tape(t)%hlist(f)%varid(i) + dimids_tmp = dimindex + ! Figure the dimension ID array for this field + ! We have defined the horizontal grid dimensions in dimindex + fdims = num_hdims + do j = 1, mdimsize + fdims = fdims + 1 + dimids_tmp(fdims) = mdimids(mdims(j)) + end do + if(.not. restart) then + ! Only add time dimension if this is not a restart history tape + fdims = fdims + 1 + dimids_tmp(fdims) = timdim + end if + if (patch_output) then + ! For patch output, we need new dimension IDs and a different name + call tape(t)%patches(i)%get_var_data(fname_tmp, & + dimids_tmp(1:fdims), tape(t)%hlist(f)%field%decomp_type) + end if + ! Define the variable + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), ncreal, & + dimids_tmp(1:fdims), varid) + if (mdimsize > 0) then + ierr = pio_put_att(tape(t)%File, varid, 'mdims', mdims(1:mdimsize)) + call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) + end if + str = tape(t)%hlist(f)%field%sampling_seq + if (len_trim(str) > 0) then + ierr = pio_put_att(tape(t)%File, varid, 'Sampling_Sequence', trim(str)) + call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) + end if + + if (tape(t)%hlist(f)%field%flag_xyfill) then + ! Add both _FillValue and missing_value to cover expectations + ! of various applications. + ! The attribute type must match the data type. + if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then + ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & + tape(t)%hlist(f)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & + tape(t)%hlist(f)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + else + ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & + REAL(tape(t)%hlist(f)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & + REAL(tape(t)%hlist(f)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + end if + end if + + str = tape(t)%hlist(f)%field%units + if (len_trim(str) > 0) then + ierr=pio_put_att (tape(t)%File, varid, 'units', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define units for '//trim(fname_tmp)) + end if + + str = tape(t)%hlist(f)%field%long_name + ierr=pio_put_att (tape(t)%File, varid, 'long_name', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define long_name for '//trim(fname_tmp)) + ! + ! Assign field attributes defining valid levels and averaging info + ! + cell_methods = '' + if (len_trim(tape(t)%hlist(f)%field%cell_methods) > 0) then + if (len_trim(cell_methods) > 0) then + cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(f)%field%cell_methods) + else + cell_methods = trim(cell_methods)//trim(tape(t)%hlist(f)%field%cell_methods) + end if + end if + ! Time cell methods is after field method because time averaging is + ! applied later (just before output) than field method which is applied + ! before outfld call. + str = tape(t)%hlist(f)%time_op + select case (str) + case ('mean', 'maximum', 'minimum', 'standard_deviation') + if (len_trim(cell_methods) > 0) then + cell_methods = trim(cell_methods)//' '//'time: '//str + else + cell_methods = trim(cell_methods)//'time: '//str + end if + end select + if (len_trim(cell_methods) > 0) then + ierr = pio_put_att(tape(t)%File, varid, 'cell_methods', trim(cell_methods)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define cell_methods for '//trim(fname_tmp)) + end if + if (patch_output) then + ierr = pio_put_att(tape(t)%File, varid, 'basename', & + tape(t)%hlist(f)%field%name) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define basename for '//trim(fname_tmp)) + end if + + if (restart) then + ! For restart history files, we need to save accumulation counts + fname_tmp = trim(fname_tmp)//'_nacs' + if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then + allocate(tape(t)%hlist(f)%nacs_varid) + end if + if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & + nacsdims(1:num_hdims), tape(t)%hlist(f)%nacs_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & + tape(t)%hlist(f)%nacs_varid) + end if + ! for standard deviation + if (associated(tape(t)%hlist(f)%sbuf)) then + fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + fname_tmp = trim(fname_tmp)//'_var' + if ( .not.associated(tape(t)%hlist(f)%sbuf_varid)) then + allocate(tape(t)%hlist(f)%sbuf_varid) + endif + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_double, & + dimids_tmp(1:fdims), tape(t)%hlist(f)%sbuf_varid) + endif + end if + end do ! Loop over output patches + end do ! Loop over fields + ! + deallocate(mdimids) + ret = pio_enddef(tape(t)%File) + + if(masterproc) then + write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' + endif + ! + ! Write time-invariant portion of history header + ! + if(.not. is_satfile(t)) then + if(interpolate) then + call cam_grid_write_var(tape(t)%File, interpolate_info(t)%grid_id) + else if((.not. patch_output) .or. restart) then + do i = 1, size(tape(t)%grid_ids) + call cam_grid_write_var(tape(t)%File, tape(t)%grid_ids(i)) + end do + else + ! Patch output + do i = 1, size(tape(t)%patches) + call tape(t)%patches(i)%write_vals(tape(t)%File) + end do + end if ! interpolate + if (allocated(lonvar)) then + deallocate(lonvar) + end if + if (allocated(latvar)) then + deallocate(latvar) + end if + + dtime = get_step_size() + ierr = pio_put_var(tape(t)%File, tape(t)%mdtid, (/dtime/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') + ! + ! Model date info + ! + ierr = pio_put_var(tape(t)%File, tape(t)%ndbaseid, (/ndbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') + ierr = pio_put_var(tape(t)%File, tape(t)%nsbaseid, (/nsbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') + + ierr = pio_put_var(tape(t)%File, tape(t)%nbdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') +#if ( defined BFB_CAM_SCAM_IOP ) + ierr = pio_put_var(tape(t)%File, tape(t)%bdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') +#endif + ierr = pio_put_var(tape(t)%File, tape(t)%nbsecid, (/nbsec/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') + ! + ! Reduced grid info + ! + + end if ! .not. is_satfile + + if (allocated(header_info)) then + do i = 1, size(header_info) + call header_info(i)%deallocate() + end do + deallocate(header_info) + end if + + ! Write the mdim variable data + call write_hist_coord_vars(tape(t)%File, restart) + + end subroutine h_define + + !####################################################################### + + subroutine h_normalize (f, t) + + use cam_history_support, only: dim_index_2d + + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Normalize fields on a history file by the number of accumulations + ! + ! Method: Loop over fields on the tape. Need averaging flag and number of + ! accumulations to perform normalization. + ! + !----------------------------------------------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: f ! field index + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: c ! chunk (or lat) index + integer :: ib, ie ! beginning and ending indices of first dimension + integer :: jb, je ! beginning and ending indices of second dimension + integer :: begdim3, enddim3 ! Chunk or block bounds + integer :: k ! level + integer :: i, ii + real(r8) :: variance, tmpfill + + logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue + character*1 :: avgflag ! averaging flag + + call t_startf ('h_normalize') + + call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + + ! + ! normalize by number of accumulations for averaged case + ! + flag_xyfill = tape(t)%hlist(f)%field%flag_xyfill + avgflag = tape(t)%hlist(f)%avgflag + + do c = begdim3, enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + + ib = dimind%beg1 + ie = dimind%end1 + jb = dimind%beg2 + je = dimind%end2 + + if (flag_xyfill) then + do k = jb, je + where (tape(t)%hlist(f)%nacs(ib:ie, c) == 0) + tape(t)%hlist(f)%hbuf(ib:ie,k,c) = tape(t)%hlist(f)%field%fillvalue + endwhere + end do + end if + + if (avgflag == 'A' .or. avgflag == 'B' .or. avgflag == 'L') then + if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + do k = jb, je + where (tape(t)%hlist(f)%nacs(ib:ie,c) /= 0) + tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(f)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(f)%nacs(ib:ie,c) + endwhere + end do + else if(tape(t)%hlist(f)%nacs(1,c) > 0) then + do k=jb,je + tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(f)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(f)%nacs(1,c) + end do + end if + end if + if (avgflag == 'S') then + ! standard deviation ... + ! from http://www.johndcook.com/blog/standard_deviation/ + tmpfill = merge(tape(t)%hlist(f)%field%fillvalue,0._r8,flag_xyfill) + do k=jb,je + do i = ib,ie + ii = merge(i,1,flag_xyfill) + if (tape(t)%hlist(f)%nacs(ii,c) > 1) then + variance = tape(t)%hlist(f)%sbuf(i,k,c)/(tape(t)%hlist(f)%nacs(ii,c)-1) + tape(t)%hlist(f)%hbuf(i,k,c) = sqrt(variance) + else + tape(t)%hlist(f)%hbuf(i,k,c) = tmpfill + endif + end do + end do + endif + end do + + call t_stopf ('h_normalize') + + return + end subroutine h_normalize + + !####################################################################### + + subroutine h_zero (f, t) + use cam_history_support, only: dim_index_2d + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Zero out accumulation buffers for a tape + ! + ! Method: Loop through fields on the tape + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: f ! field index + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: c ! chunk index + integer :: begdim3 ! on-node chunk or lat start index + integer :: enddim3 ! on-node chunk or lat end index + + call t_startf ('h_zero') + + call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + + do c = begdim3, enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + if (associated(tape(t)%hlist(f)%sbuf)) then ! zero out variance buffer for standard deviation + tape(t)%hlist(f)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + endif + end do + tape(t)%hlist(f)%nacs(:,:) = 0 + + call t_stopf ('h_zero') + + return + end subroutine h_zero + + !####################################################################### + + subroutine dump_field (f, t, restart) + use cam_history_support, only: history_patch_t, dim_index_3d + use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_dimensions + use interp_mod, only : write_interpolated + + ! Dummy arguments + integer, intent(in) :: f + integer, intent(in) :: t + logical, intent(in) :: restart + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Write a variable to a history tape using PIO + ! For restart tapes, also write the accumulation buffer (nacs) + ! + !----------------------------------------------------------------------- + ! Local variables + integer :: ierr + type(var_desc_t), pointer :: varid ! PIO ID for var + type(var_desc_t), pointer :: compid ! PIO ID for vector comp. + integer :: compind ! index of vector comp. + integer :: fdims(8) ! Field file dim sizes + integer :: frank ! Field file rank + integer :: nacsrank ! Field file rank for nacs + type(dim_index_3d) :: dimind ! 3-D dimension index + integer :: adims(3) ! Field array dim sizes + integer :: nadims ! # of used adims + integer :: fdecomp + integer :: num_patches + integer :: mdimsize ! Total # on-node elements + logical :: interpolate + logical :: patch_output + type(history_patch_t), pointer :: patchptr + integer :: i + + interpolate = (interpolate_output(t) .and. (.not. restart)) + patch_output = (associated(tape(t)%patches) .and. (.not. restart)) + + !!! Get the field's shape and decomposition + + ! Shape on disk + call tape(t)%hlist(f)%field%get_shape(fdims, frank) + + ! Shape of array + dimind = tape(t)%hlist(f)%field%get_dims() + call dimind%dim_sizes(adims) + if (adims(2) <= 1) then + adims(2) = adims(3) + nadims = 2 + else + nadims = 3 + end if + fdecomp = tape(t)%hlist(f)%field%decomp_type + + ! num_patches will loop through the number of patches (or just one + ! for the whole grid) for this field for this tape + if (patch_output) then + num_patches = size(tape(t)%patches) + else + num_patches = 1 + end if + + do i = 1, num_patches + varid => tape(t)%hlist(f)%varid(i) + + if (restart) then + call pio_setframe(tape(t)%File, varid, int(-1,kind=PIO_OFFSET_KIND)) + else + call pio_setframe(tape(t)%File, varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + end if + if (patch_output) then + ! We are outputting patches + patchptr => tape(t)%patches(i) + if (interpolate) then + call endrun('dump_field: interpolate incompatible with regional output') + end if + call patchptr%write_var(tape(t)%File, fdecomp, adims(1:nadims), & + pio_double, tape(t)%hlist(f)%hbuf, varid) + else + ! We are doing output via the field's grid + if (interpolate) then + mdimsize = tape(t)%hlist(f)%field%enddim2 - tape(t)%hlist(f)%field%begdim2 + 1 + if (mdimsize == 0) then + mdimsize = tape(t)%hlist(f)%field%numlev + end if + if (tape(t)%hlist(f)%field%meridional_complement > 0) then + compind = tape(t)%hlist(f)%field%meridional_complement + compid => tape(t)%hlist(compind)%varid(i) + ! We didn't call set frame on the meridional complement field + call pio_setframe(tape(t)%File, compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + call write_interpolated(tape(t)%File, varid, compid, & + tape(t)%hlist(f)%hbuf, tape(t)%hlist(compind)%hbuf, & + mdimsize, PIO_DOUBLE, fdecomp) + else if (tape(t)%hlist(f)%field%zonal_complement > 0) then + ! We don't want to double write so do nothing here +! compind = tape(t)%hlist(f)%field%zonal_complement +! compid => tape(t)%hlist(compind)%varid(i) +! call write_interpolated(tape(t)%File, compid, varid, & +! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & +! mdimsize, PIO_DOUBLE, fdecomp) + else + ! Scalar field + call write_interpolated(tape(t)%File, varid, & + tape(t)%hlist(f)%hbuf, mdimsize, PIO_DOUBLE, fdecomp) + end if + else if (nadims == 2) then + ! Special case for 2D field (no levels) due to hbuf structure + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:frank), tape(t)%hlist(f)%hbuf(:,1,:), varid) + else + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + fdims(1:frank), tape(t)%hlist(f)%hbuf, varid) + end if + end if + end do + !! write accumulation counter and variance to hist restart file + if(restart) then + if (associated(tape(t)%hlist(f)%sbuf) ) then + ! write variance data to restart file for standard deviation calc + if (nadims == 2) then + ! Special case for 2D field (no levels) due to sbuf structure + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & + fdims(1:frank), tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) + else + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + fdims(1:frank), tape(t)%hlist(f)%sbuf, tape(t)%hlist(f)%sbuf_varid) + endif + endif + !! NACS + if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + if (nadims > 2) then + adims(2) = adims(3) + nadims = 2 + end if + call cam_grid_dimensions(fdecomp, fdims(1:2), nacsrank) + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & + fdims(1:nacsrank), tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) + else + ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & + tape(t)%hlist(f)%nacs(:, tape(t)%hlist(f)%field%begdim3:tape(t)%hlist(f)%field%enddim3)) + end if + end if + + return + end subroutine dump_field + + !####################################################################### + + logical function write_inithist () + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Set flags that will initiate dump to IC file when OUTFLD and + ! WSHIST are called + ! + !----------------------------------------------------------------------- + ! + use time_manager, only: get_nstep, get_curr_date, get_step_size, is_last_step + ! + ! Local workspace + ! + integer :: yr, mon, day ! year, month, and day components of + ! a date + integer :: nstep ! current timestep number + integer :: ncsec ! current time of day [seconds] + integer :: dtime ! timestep size + + !----------------------------------------------------------------------- + + write_inithist = .false. + + if(is_initfile()) then + + nstep = get_nstep() + call get_curr_date(yr, mon, day, ncsec) + + if (inithist == '6-HOURLY') then + dtime = get_step_size() + write_inithist = nstep /= 0 .and. mod( nstep, nint((6._r8*3600._r8)/dtime) ) == 0 + elseif(inithist == 'DAILY' ) then + write_inithist = nstep /= 0 .and. ncsec == 0 + elseif(inithist == 'MONTHLY' ) then + write_inithist = nstep /= 0 .and. ncsec == 0 .and. day == 1 + elseif(inithist == 'YEARLY' ) then + write_inithist = nstep /= 0 .and. ncsec == 0 .and. day == 1 .and. mon == 1 + elseif(inithist == 'CAMIOP' ) then + write_inithist = nstep == 0 + elseif(inithist == 'ENDOFRUN' ) then + write_inithist = nstep /= 0 .and. is_last_step() + end if + end if + + return + end function write_inithist + + !####################################################################### + + subroutine wshist (rgnht_in) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Driver routine to write fields on history tape t + ! + ! + !----------------------------------------------------------------------- + use time_manager, only: get_nstep, get_curr_date, get_curr_time, get_step_size + use chem_surfvals, only: chem_surfvals_get, chem_surfvals_co2_rad + use solar_irrad_data, only: sol_tsi + use sat_hist, only: sat_hist_write + use interp_mod, only: set_interp_hfile + use datetime_mod, only: datetime + use cam_pio_utils, only: cam_pio_closefile + + logical, intent(in), optional :: rgnht_in(ptapes) + ! + ! Local workspace + ! + character(len=8) :: cdate ! system date + character(len=8) :: ctime ! system time + + logical :: rgnht(ptapes), restart + integer t, f ! tape, field indices + integer start ! starting index required by nf_put_vara + integer count1 ! count values required by nf_put_vara + integer startc(2) ! start values required by nf_put_vara (character) + integer countc(2) ! count values required by nf_put_vara (character) +#ifdef HDEBUG + ! integer begdim3 + ! integer enddim3 +#endif + + integer :: yr, mon, day ! year, month, and day components of a date + integer :: nstep ! current timestep number + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + integer :: ndcur ! day component of current time + integer :: nscur ! seconds component of current time + real(r8) :: time ! current time + real(r8) :: tdata(2) ! time interval boundaries + character(len=max_string_len) :: fname ! Filename + logical :: prev ! Label file with previous date rather than current + integer :: ierr +#if ( defined BFB_CAM_SCAM_IOP ) + integer :: tsec ! day component of current time + integer :: dtime ! seconds component of current time +#endif + + if(present(rgnht_in)) then + rgnht=rgnht_in + restart=.true. + tape => restarthistory_tape + else + rgnht=.false. + restart=.false. + tape => history_tape + end if + + nstep = get_nstep() + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + call get_curr_time(ndcur, nscur) + ! + ! Write time-varying portion of history file header + ! + do t=1,ptapes + if (nflds(t) == 0 .or. (restart .and.(.not.rgnht(t)))) cycle + ! + ! Check if this is the IC file and if it's time to write. + ! Else, use "nhtfrq" to determine if it's time to write + ! the other history files. + ! + if((.not. restart) .or. rgnht(t)) then + if( is_initfile(file_index=t) ) then + hstwr(t) = write_inithist() + prev = .false. + else + if (nhtfrq(t) == 0) then + hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 + prev = .true. + else + hstwr(t) = mod(nstep,nhtfrq(t)) == 0 + prev = .false. + end if + end if + end if + if (hstwr(t) .or. (restart .and. rgnht(t))) then + if(masterproc) then + if(is_initfile(file_index=t)) then + write(iulog,100) yr,mon,day,ncsec +100 format('WSHIST: writing time sample to Initial Conditions h-file', & + ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + else if(is_satfile(t)) then + write(iulog,150) nfils(t),t,yr,mon,day,ncsec +150 format('WSHIST: writing sat columns ',i6,' to h-file ', & + i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + else if(hstwr(t)) then + write(iulog,200) nfils(t),t,yr,mon,day,ncsec +200 format('WSHIST: writing time sample ',i3,' to h-file ', & + i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + else if(restart .and. rgnht(t)) then + write(iulog,300) nfils(t),t,yr,mon,day,ncsec +300 format('WSHIST: writing history restart ',i3,' to hr-file ', & + i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + end if + write(iulog,*) + end if + ! + ! Starting a new volume => define the metadata + ! + if (nfils(t)==0 .or. (restart.and.rgnht(t))) then + if(restart) then + rhfilename_spec = '%c.cam' // trim(inst_suffix) // '.rh%t.%y-%m-%d-%s.nc' + fname = interpret_filename_spec( rhfilename_spec, number=(t-1)) + hrestpath(t)=fname + else if(is_initfile(file_index=t)) then + fname = interpret_filename_spec( hfilename_spec(t) ) + else + fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & + prev=prev ) + end if + ! + ! Check that this new filename isn't the same as a previous or current filename + ! + do f = 1, ptapes + if (masterproc.and. trim(fname) == trim(nhfil(f)) )then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + write(iulog,*)'Is there an error in your filename specifiers?' + write(iulog,*)'hfilename_spec(', t, ') = ', hfilename_spec(t) + if ( t /= f )then + write(iulog,*)'hfilename_spec(', f, ') = ', hfilename_spec(f) + end if + call endrun + end if + end do + if(.not. restart) then + nhfil(t) = fname + if(masterproc) write(iulog,*)'WSHIST: nhfil(',t,')=',trim(nhfil(t)) + cpath(t) = nhfil(t) + if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) + end if + call h_define (t, restart) + end if + + if(is_satfile(t)) then + call sat_hist_write( tape(t), nflds(t), nfils(t)) + else + if(restart) then + start=1 + else + nfils(t) = nfils(t) + 1 + start = nfils(t) + end if + count1 = 1 + ! Setup interpolation data if history file is interpolated + if (interpolate_output(t) .and. (.not. restart)) then + call set_interp_hfile(t, interpolate_info) + end if + + ierr = pio_put_var (tape(t)%File, tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) + ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) + ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) + + if (.not. is_initfile(file_index=t)) then + ! Don't write the GHG/Solar forcing data to the IC file. + ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) + ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) + ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) + ierr=pio_put_var (tape(t)%File, tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) + ierr=pio_put_var (tape(t)%File, tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) + ierr=pio_put_var (tape(t)%File, tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) + + if (solar_parms_on) then + ierr=pio_put_var (tape(t)%File, tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) + ierr=pio_put_var (tape(t)%File, tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) + ierr=pio_put_var (tape(t)%File, tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) + ierr=pio_put_var (tape(t)%File, tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) + ierr=pio_put_var (tape(t)%File, tape(t)%apid, (/start/), (/count1/),(/ ap /) ) + endif + + end if + + ierr = pio_put_var (tape(t)%File, tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) +#if ( defined BFB_CAM_SCAM_IOP ) + dtime = get_step_size() + tsec=dtime*nstep + ierr = pio_put_var (tape(t)%File, tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) +#endif + ierr = pio_put_var (tape(t)%File, tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) + time = ndcur + nscur/86400._r8 + ierr=pio_put_var (tape(t)%File, tape(t)%timeid, (/start/),(/count1/),(/time/)) + + startc(1) = 1 + startc(2) = start + countc(1) = 2 + countc(2) = 1 + if (is_initfile(file_index=t)) then + tdata = time ! Inithist file is always instantanious data + else + tdata(1) = beg_time(t) + tdata(2) = time + end if + ierr=pio_put_var (tape(t)%File, tape(t)%tbndid, startc, countc, tdata) + if(.not.restart) beg_time(t) = time ! update beginning time of next interval + startc(1) = 1 + startc(2) = start + countc(1) = 8 + countc(2) = 1 + call datetime (cdate, ctime) + ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) + ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) + + if(.not. restart) then + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) + ! Normalized averaged fields + if (tape(t)%hlist(f)%avgflag /= 'I') then + call h_normalize (f, t) + end if + end do + end if + ! + ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations + ! + call t_startf ('dump_field') + do f=1,nflds(t) + call dump_field(f, t, restart) + end do + call t_stopf ('dump_field') + ! + ! Zero history buffers and accumulators now that the fields have been written. + ! + + + + if(restart) then + do f=1,nflds(t) + if(associated(tape(t)%hlist(f)%varid)) then + deallocate(tape(t)%hlist(f)%varid) + nullify(tape(t)%hlist(f)%varid) + end if + end do + call cam_pio_closefile(tape(t)%File) + else + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) + call h_zero (f, t) + end do + end if + end if + end if + + end do + + return + end subroutine wshist + + !####################################################################### + + subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & + gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add a field to the master field list + ! + ! Method: Put input arguments of field name, units, number of levels, + ! averaging flag, and long name into a type entry in the global + ! master field list (masterlist). + ! + !----------------------------------------------------------------------- + + ! + ! Arguments + ! + character(len=*), intent(in) :: fname ! field name (max_fieldname_len) + character(len=*), intent(in) :: vdim_name ! NetCDF dimension name (or scalar coordinate) + character(len=1), intent(in) :: avgflag ! averaging flag + character(len=*), intent(in) :: units ! units of fname (max_chars) + character(len=*), intent(in) :: long_name ! long name of field (max_chars) + + character(len=*), intent(in), optional :: gridname ! decomposition type + logical, intent(in), optional :: flag_xyfill ! non-applicable xy points flagged with fillvalue + character(len=*), intent(in), optional :: sampling_seq ! sampling sequence - if not every timestep, + ! how often field is sampled: + ! every other; only during LW/SW radiation calcs, etc. + character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) + real(r8), intent(in), optional :: fill_value + + ! + ! Local workspace + ! + character(len=max_chars), allocatable :: dimnames(:) + integer :: index + + if (trim(vdim_name) == trim(horiz_only)) then + allocate(dimnames(0)) + else + index = get_hist_coord_index(trim(vdim_name)) + if (index < 1) then + call endrun('ADDFLD: Invalid coordinate, '//trim(vdim_name)) + end if + allocate(dimnames(1)) + dimnames(1) = trim(vdim_name) + end if + call addfld(fname, dimnames, avgflag, units, long_name, gridname, & + flag_xyfill, sampling_seq, standard_name, fill_value) + + end subroutine addfld_1d + + subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & + gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add a field to the master field list + ! + ! Method: Put input arguments of field name, units, number of levels, + ! averaging flag, and long name into a type entry in the global + ! master field list (masterlist). + ! + !----------------------------------------------------------------------- + use cam_history_support, only: fillvalue, hist_coord_find_levels + use cam_grid_support, only: cam_grid_id, cam_grid_is_zonal + use cam_grid_support, only: cam_grid_get_coord_names + + ! + ! Arguments + ! + character(len=*), intent(in) :: fname ! field name (max_fieldname_len) + character(len=*), intent(in) :: dimnames(:) ! NetCDF dimension names (except grid dims) + character(len=1), intent(in) :: avgflag ! averaging flag + character(len=*), intent(in) :: units ! units of fname (max_chars) + character(len=*), intent(in) :: long_name ! long name of field (max_chars) + + character(len=*), intent(in), optional :: gridname ! decomposition type + logical, intent(in), optional :: flag_xyfill ! non-applicable xy points flagged with fillvalue + character(len=*), intent(in), optional :: sampling_seq ! sampling sequence - if not every timestep, + ! how often field is sampled: + ! every other; only during LW/SW radiation calcs, etc. + character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) + real(r8), intent(in), optional :: fill_value + + ! + ! Local workspace + ! + character(len=max_fieldname_len) :: fname_tmp ! local copy of fname + character(len=max_fieldname_len) :: coord_name ! for cell_methods + character(len=128) :: errormsg + type(master_entry), pointer :: listentry + + integer :: dimcnt + + if (htapes_defined) then + call endrun ('ADDFLD: Attempt to add field '//trim(fname)//' after history files set') + end if + + ! + ! Ensure that new field name is not all blanks + ! + if (len_trim(fname)==0) then + call endrun('ADDFLD: blank field name not allowed') + end if + ! + ! Ensure that new field name is not longer than allowed + ! (strip "&IC" suffix if it exists) + ! + fname_tmp = fname + fname_tmp = strip_suffix(fname_tmp) + + if (len_trim(fname_tmp) > fieldname_len) then + write(iulog,*)'ADDFLD: field name cannot be longer than ',fieldname_len,' characters long' + write(iulog,*)'Field name: ',fname + write(errormsg, *) 'Field name, "', trim(fname), '" is too long' + call endrun('ADDFLD: '//trim(errormsg)) + end if + ! + ! Ensure that new field doesn't already exist + ! + listentry => get_entry_by_name(masterlinkedlist, fname) + if(associated(listentry)) then + call endrun ('ADDFLD: '//fname//' already on list') + end if + + ! + ! Add field to Master Field List arrays fieldn and iflds + ! + allocate(listentry) + listentry%field%name = fname + listentry%field%long_name = long_name + listentry%field%numlev = 1 ! Will change if lev or ilev in shape + listentry%field%units = units + listentry%field%meridional_complement = -1 + listentry%field%zonal_complement = -1 + listentry%htapeindx(:) = -1 + listentry%act_sometape = .false. + listentry%actflag(:) = .false. + + ! Make sure we have a valid gridname + if (present(gridname)) then + listentry%field%decomp_type = cam_grid_id(trim(gridname)) + else + listentry%field%decomp_type = cam_grid_id('physgrid') + end if + if (listentry%field%decomp_type < 0) then + write(errormsg, *) 'Invalid grid name, "', trim(gridname), '" for ', & + trim(fname) + call endrun('ADDFLD: '//trim(errormsg)) + end if + + ! + ! Indicate sampling sequence of field (i.e., how often "outfld" is called) + ! If not every timestep (default), then give a descriptor indicating the + ! sampling pattern. Currently, the only valid value is "rad_lwsw" for sampling + ! during LW/SW radiation timesteps only + ! + if (present(sampling_seq)) then + listentry%field%sampling_seq = sampling_seq + else + listentry%field%sampling_seq = ' ' + end if + ! Indicate if some field pre-processing occurred (e.g., zonal mean) + if (cam_grid_is_zonal(listentry%field%decomp_type)) then + call cam_grid_get_coord_names(listentry%field%decomp_type, coord_name, errormsg) + ! Zonal method currently hardcoded to 'mean'. + listentry%field%cell_methods = trim(coord_name)//': mean' + else + listentry%field%cell_methods = '' + end if + ! + ! Whether to apply xy fillvalue: default is false + ! + if (present(flag_xyfill)) then + listentry%field%flag_xyfill = flag_xyfill + else + listentry%field%flag_xyfill = .false. + end if + + ! + ! Allow external packages to have fillvalues different than default + ! + + if(present(fill_value)) then + listentry%field%fillvalue = fill_value + else + listentry%field%fillvalue = fillvalue + endif + + ! + ! Process shape + ! + + if (associated(listentry%field%mdims)) then + deallocate(listentry%field%mdims) + end if + nullify(listentry%field%mdims) + dimcnt = size(dimnames) + allocate(listentry%field%mdims(dimcnt)) + call lookup_hist_coord_indices(dimnames, listentry%field%mdims) + if(dimcnt > maxvarmdims) then + maxvarmdims = dimcnt + end if + ! Check for subcols (currently limited to first dimension) + listentry%field%is_subcol = .false. + if (size(dimnames) > 0) then + if (trim(dimnames(1)) == 'psubcols') then + if (listentry%field%decomp_type /= cam_grid_id('physgrid')) then + write(errormsg, *) "Cannot add ", trim(fname), & + "Subcolumn history output only allowed on physgrid" + call endrun("ADDFLD: "//errormsg) + listentry%field%is_subcol = .true. + end if + end if + end if + ! Levels + listentry%field%numlev = hist_coord_find_levels(dimnames) + if (listentry%field%numlev <= 0) then + listentry%field%numlev = 1 + end if + + ! + ! Dimension history info based on decomposition type (grid) + ! + call set_field_dimensions(listentry%field) + + ! + ! These 2 fields are used only in master field list, not runtime field list + ! + listentry%avgflag(:) = avgflag + listentry%actflag(:) = .false. + + do dimcnt = 1, ptapes + call AvgflagToString(avgflag, listentry%time_op(dimcnt)) + end do + + nullify(listentry%next_entry) + + call add_entry_to_master(listentry) + return + end subroutine addfld_nd + + !####################################################################### + + ! field_part_of_vector: Determinie if fname is part of a vector set + ! Optionally fill in the names of the vector set fields + logical function field_part_of_vector(fname, meridional_name, zonal_name) + + ! Dummy arguments + character(len=*), intent(in) :: fname + character(len=*), optional, intent(out) :: meridional_name + character(len=*), optional, intent(out) :: zonal_name + + ! Local variables + type(master_entry), pointer :: listentry + + listentry => get_entry_by_name(masterlinkedlist, fname) + if (associated(listentry)) then + if ( (len_trim(listentry%meridional_field) > 0) .or. & + (len_trim(listentry%zonal_field) > 0)) then + field_part_of_vector = .true. + if (present(meridional_name)) then + meridional_name = listentry%meridional_field + end if + if (present(zonal_name)) then + zonal_name = listentry%zonal_field + end if + else + field_part_of_vector = .false. + end if + else + field_part_of_vector = .false. + end if + if (.not. field_part_of_vector) then + if (present(meridional_name)) then + meridional_name = '' + end if + if (present(zonal_name)) then + zonal_name = '' + end if + end if + + end function field_part_of_vector + + + ! register_vector_field: Register a pair of history field names as + ! being a vector complement set. + ! This information is used to set up interpolated history output. + ! NB: register_vector_field must be called after both fields are defined + ! with addfld + subroutine register_vector_field(zonal_field_name, meridional_field_name) + + ! Dummy arguments + character(len=*), intent(in) :: zonal_field_name + character(len=*), intent(in) :: meridional_field_name + + ! Local variables + type(master_entry), pointer :: mlistentry + type(master_entry), pointer :: zlistentry + character(len=*), parameter :: subname = 'REGISTER_VECTOR_FIELD' + character(len=max_chars) :: errormsg + + if (htapes_defined) then + write(errormsg, '(5a)') ': Attempt to register vector field (', & + trim(zonal_field_name), ', ', trim(meridional_field_name), & + ') after history files set' + call endrun (trim(subname)//errormsg) + end if + + ! Look for the field IDs + zlistentry => get_entry_by_name(masterlinkedlist, zonal_field_name) + mlistentry => get_entry_by_name(masterlinkedlist, meridional_field_name) + ! Has either of these fields been previously registered? + if (associated(mlistentry)) then + if (len_trim(mlistentry%meridional_field) > 0) then + write(errormsg, '(9a)') ': ERROR attempting to register vector ', & + 'field (', trim(zonal_field_name), ', ', & + trim(meridional_field_name), '), ', trim(meridional_field_name), & + ' has been registered as part of a vector field with ', & + trim(mlistentry%meridional_field) + call endrun (trim(subname)//errormsg) + else if (len_trim(mlistentry%zonal_field) > 0) then + write(errormsg, '(9a)') ': ERROR attempting to register vector ', & + 'field (', trim(zonal_field_name), ', ', & + trim(meridional_field_name), '), ', trim(meridional_field_name), & + ' has been registered as part of a vector field with ', & + trim(mlistentry%zonal_field) + call endrun (trim(subname)//errormsg) + end if + end if + if (associated(zlistentry)) then + if (len_trim(zlistentry%meridional_field) > 0) then + write(errormsg, '(9a)') ': ERROR attempting to register vector ', & + 'field (', trim(zonal_field_name), ', ', & + trim(meridional_field_name), '), ', trim(zonal_field_name), & + ' has been registered as part of a vector field with ', & + trim(zlistentry%meridional_field) + call endrun (trim(subname)//errormsg) + else if (len_trim(zlistentry%zonal_field) > 0) then + write(errormsg, '(9a)') ': ERROR attempting to register vector ', & + 'field (', trim(zonal_field_name), ', ', & + trim(meridional_field_name), '), ', trim(zonal_field_name), & + ' has been registered as part of a vector field with ', & + trim(zlistentry%meridional_field) + call endrun (trim(subname)//errormsg) + end if + end if + if(associated(mlistentry) .and. associated(zlistentry)) then + zlistentry%meridional_field = mlistentry%field%name + zlistentry%zonal_field = '' + mlistentry%meridional_field = '' + mlistentry%zonal_field = zlistentry%field%name + else if (associated(mlistentry)) then + write(errormsg, '(7a)') ': ERROR attempting to register vector field (',& + trim(zonal_field_name), ', ', trim(meridional_field_name), & + '), ', trim(zonal_field_name), ' is not defined' + call endrun (trim(subname)//errormsg) + else if (associated(zlistentry)) then + write(errormsg, '(7a)') ': ERROR attempting to register vector field (',& + trim(zonal_field_name), ', ', trim(meridional_field_name), & + '), ', trim(meridional_field_name), ' is not defined' + call endrun (trim(subname)//errormsg) + else + write(errormsg, '(5a)') ': ERROR attempting to register vector field (',& + trim(zonal_field_name), ', ', trim(meridional_field_name), & + '), neither field is defined' + call endrun (trim(subname)//errormsg) + end if + end subroutine register_vector_field + + subroutine add_entry_to_master( newentry) + type(master_entry), target, intent(in) :: newentry + type(master_entry), pointer :: listentry + + if(associated(masterlinkedlist)) then + listentry => masterlinkedlist + do while(associated(listentry%next_entry)) + listentry=>listentry%next_entry + end do + listentry%next_entry=>newentry + else + masterlinkedlist=>newentry + end if + + end subroutine add_entry_to_master + + !####################################################################### + + subroutine wrapup (rstwr, nlend) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Close history files. + ! + ! Method: + ! This routine will close any full hist. files + ! or any hist. file that has data on it when restart files are being + ! written. + ! If a partially full history file was disposed (for restart + ! purposes), then wrapup will open that unit back up and position + ! it for appending new data. + ! + ! Original version: CCM2 + ! + !----------------------------------------------------------------------- + ! + use pio, only : pio_file_is_open + use shr_kind_mod, only: r8 => shr_kind_r8 + use ioFileMod + use time_manager, only: get_nstep, get_curr_date, get_curr_time + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + + ! + ! Input arguments + ! + logical, intent(in) :: rstwr ! true => restart files are written this timestep + logical, intent(in) :: nlend ! Flag if time to end + + ! + ! Local workspace + ! + integer :: nstep ! current timestep number + integer :: ncsec ! time of day relative to current date [secs] + integer :: ndcur ! days component of current time + integer :: nscur ! seconds component of current time + integer :: yr, mon, day ! year, month, day components of a date + + logical :: lfill (ptapes) ! Is history file ready to dispose? + logical :: lhdisp ! true => history file is disposed + logical :: lhfill ! true => history file is full + + integer :: t ! History file number + integer :: f + real(r8) :: tday ! Model day number for printout + !----------------------------------------------------------------------- + + tape => history_tape + + nstep = get_nstep() + call get_curr_date(yr, mon, day, ncsec) + call get_curr_time(ndcur, nscur) + ! + !----------------------------------------------------------------------- + ! Dispose history files. + !----------------------------------------------------------------------- + ! + ! Begin loop over ptapes (the no. of declared history files - primary + ! and auxiliary). This loop disposes a history file to Mass Store + ! when appropriate. + ! + do t=1,ptapes + if (nflds(t) == 0) cycle + + lfill(t) = .false. + ! + ! Find out if file is full + ! + if (hstwr(t) .and. nfils(t) >= mfilt(t)) then + lfill(t) = .true. + endif + ! + ! Dispose history file if + ! 1) file is filled or + ! 2) this is the end of run and file has data on it or + ! 3) restarts are being put out and history file has data on it + ! + if (lfill(t) .or. (nlend .and. nfils(t) >= 1) .or. (rstwr .and. nfils(t) >= 1)) then + ! + ! Dispose history file + ! + ! + ! Is this the 0 timestep data of a monthly run? + ! If so, just close primary unit do not dispose. + ! + if (masterproc) write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t)) + if(pio_file_is_open(tape(t)%File)) then + if (nlend .or. lfill(t)) then + do f=1,nflds(t) + if (associated(tape(t)%hlist(f)%varid)) then + deallocate(tape(t)%hlist(f)%varid) + nullify(tape(t)%hlist(f)%varid) + end if + end do + end if + call cam_pio_closefile(tape(t)%File) + end if + if (nhtfrq(t) /= 0 .or. nstep > 0) then + + ! + ! Print information concerning model output. + ! Model day number = iteration number of history file data * delta-t / (seconds per day) + ! + tday = ndcur + nscur/86400._r8 + if(masterproc) then + if (t==1) then + write(iulog,*)' Primary history file' + else + write(iulog,*)' Auxiliary history file number ', t-1 + end if + write(iulog,9003)nstep,nfils(t),tday + write(iulog,9004) + end if + ! + ! Auxilary files may have been closed and saved off without being full. + ! We must reopen the files and position them for more data. + ! Must position auxiliary files if not full + ! + if (.not.nlend .and. .not.lfill(t)) then + call cam_PIO_openfile (tape(t)%File, nhfil(t), PIO_WRITE) + call h_inquire(t) + end if + endif ! if 0 timestep of montly run**** + end if ! if time dispose history fiels*** + end do ! do ptapes + ! + ! Reset number of files on each history tape + ! + do t=1,ptapes + if (nflds(t) == 0) cycle + lhfill = hstwr(t) .and. nfils(t) >= mfilt(t) + lhdisp = lhfill .or. (nlend .and. nfils(t) >= 1) .or. & + (rstwr .and. nfils(t) >= 1) + if (lhfill.and.lhdisp) then + nfils(t) = 0 + endif + end do + return +9003 format(' Output at NSTEP = ',i10,/, & + ' Number of time samples on this file = ',i10,/, & + ' Model Day = ',f10.2) +9004 format('---------------------------------------') + end subroutine wrapup + + + integer function gen_hash_key(string) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Generate a hash key on the interval [0 .. tbl_hash_pri_sz-1] + ! given a character string. + ! + ! Algorithm is a variant of perl's internal hashing function. + ! + !----------------------------------------------------------------------- + ! + implicit none + ! + ! Arguments: + ! + character(len=*), intent(in) :: string + ! + ! Local. + ! + integer :: hash + integer :: i + + hash = gen_hash_key_offset + + if ( len(string) /= 19 ) then + ! + ! Process arbitrary string length. + ! + do i = 1, len(string) + hash = ieor(hash, (ichar(string(i:i)) * tbl_gen_hash_key(iand(i-1,tbl_max_idx)))) + end do + else + ! + ! Special case string length = 19 + ! + hash = ieor(hash , ichar(string(1:1)) * 61) + hash = ieor(hash , ichar(string(2:2)) * 59) + hash = ieor(hash , ichar(string(3:3)) * 53) + hash = ieor(hash , ichar(string(4:4)) * 47) + hash = ieor(hash , ichar(string(5:5)) * 43) + hash = ieor(hash , ichar(string(6:6)) * 41) + hash = ieor(hash , ichar(string(7:7)) * 37) + hash = ieor(hash , ichar(string(8:8)) * 31) + hash = ieor(hash , ichar(string(9:9)) * 29) + hash = ieor(hash , ichar(string(10:10)) * 23) + hash = ieor(hash , ichar(string(11:11)) * 17) + hash = ieor(hash , ichar(string(12:12)) * 13) + hash = ieor(hash , ichar(string(13:13)) * 11) + hash = ieor(hash , ichar(string(14:14)) * 7) + hash = ieor(hash , ichar(string(15:15)) * 3) + hash = ieor(hash , ichar(string(16:16)) * 1) + hash = ieor(hash , ichar(string(17:17)) * 61) + hash = ieor(hash , ichar(string(18:18)) * 59) + hash = ieor(hash , ichar(string(19:19)) * 53) + end if + + gen_hash_key = iand(hash, tbl_hash_pri_sz-1) + + return + + end function gen_hash_key + + !####################################################################### + + integer function get_masterlist_indx(fldname) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Return the the index of the field's name on the master file list. + ! + ! If the field is not found on the masterlist, return -1. + ! + !----------------------------------------------------------------------- + ! + ! Arguments: + ! + character(len=*), intent(in) :: fldname + ! + ! Local. + ! + integer :: hash_key + integer :: ff + integer :: ii + integer :: io ! Index of overflow chain in overflow table + integer :: in ! Number of entries on overflow chain + + hash_key = gen_hash_key(fldname) + ff = tbl_hash_pri(hash_key) + if ( ff < 0 ) then + io = abs(ff) + in = tbl_hash_oflow(io) + do ii = 1, in + ff = tbl_hash_oflow(io+ii) + if ( masterlist(ff)%thisentry%field%name == fldname ) exit + end do + end if + + if (ff == 0) then + ! fldname generated a hash key that doesn't have an entry in tbl_hash_pri. + ! This means that fldname isn't in the masterlist + call endrun ('GET_MASTERLIST_INDX: attemping to output field '//fldname//' not on master list') + end if + + if (associated(masterlist(ff)%thisentry) .and. masterlist(ff)%thisentry%field%name /= fldname ) then + call endrun ('GET_MASTERLIST_INDX: error finding field '//fldname//' on master list') + end if + + get_masterlist_indx = ff + return + end function get_masterlist_indx + !####################################################################### + + subroutine bld_outfld_hash_tbls() + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Build primary and overflow hash tables for outfld processing. + ! + ! Steps: + ! 1) Foreach field on masterlist, find all collisions. + ! 2) Given the number of collisions, verify overflow table has sufficient + ! space. + ! 3) Build primary and overflow indices. + ! + !----------------------------------------------------------------------- + ! + ! Local. + ! + integer :: ff + integer :: ii + integer :: itemp + integer :: ncollisions + integer :: hash_key + type(master_entry), pointer :: listentry + ! + ! 1) Find all collisions. + ! + tbl_hash_pri = 0 + + ff=0 + allocate(masterlist(nfmaster)) + listentry=>masterlinkedlist + do while(associated(listentry)) + ff=ff+1 + masterlist(ff)%thisentry=>listentry + listentry=>listentry%next_entry + end do + if(ff /= nfmaster) then + write(iulog,*) 'nfmaster = ',nfmaster, ' ff=',ff + call endrun('mismatch in expected size of nfmaster') + end if + + + do ff = 1, nfmaster + hash_key = gen_hash_key(masterlist(ff)%thisentry%field%name) + tbl_hash_pri(hash_key) = tbl_hash_pri(hash_key) + 1 + end do + + ! + ! 2) Count number of collisions and define start of a individual + ! collision's chain in overflow table. A collision is defined to be any + ! location in tbl_hash_pri that has a value > 1. + ! + ncollisions = 0 + do ii = 0, tbl_hash_pri_sz-1 + if ( tbl_hash_pri(ii) > 1 ) then ! Define start of chain in O.F. table + itemp = tbl_hash_pri(ii) + tbl_hash_pri(ii) = -(ncollisions + 1) + ncollisions = ncollisions + itemp + 1 + end if + end do + + if ( ncollisions > tbl_hash_oflow_sz ) then + write(iulog,*) 'BLD_OUTFLD_HASH_TBLS: ncollisions > tbl_hash_oflow_sz', & + ncollisions, tbl_hash_oflow_sz + call endrun() + end if + + ! + ! 3) Build primary and overflow tables. + ! i - set collisions in tbl_hash_pri to point to their respective + ! chain in the overflow table. + ! + tbl_hash_oflow = 0 + + do ff = 1, nfmaster + hash_key = gen_hash_key(masterlist(ff)%thisentry%field%name) + if ( tbl_hash_pri(hash_key) < 0 ) then + ii = abs(tbl_hash_pri(hash_key)) + tbl_hash_oflow(ii) = tbl_hash_oflow(ii) + 1 + tbl_hash_oflow(ii+tbl_hash_oflow(ii)) = ff + else + tbl_hash_pri(hash_key) = ff + end if + end do + + ! + ! Dump out primary and overflow hashing tables. + ! + ! if ( masterproc ) then + ! do ii = 0, tbl_hash_pri_sz-1 + ! if ( tbl_hash_pri(ii) /= 0 ) write(iulog,666) 'tbl_hash_pri', ii, tbl_hash_pri(ii) + ! end do + ! + ! do ii = 1, tbl_hash_oflow_sz + ! if ( tbl_hash_oflow(ii) /= 0 ) write(iulog,666) 'tbl_hash_oflow', ii, tbl_hash_oflow(ii) + ! end do + ! + ! itemp = 0 + ! ii = 1 + ! do + ! if ( tbl_hash_oflow(ii) == 0 ) exit + ! itemp = itemp + 1 + ! write(iulog,*) 'Overflow chain ', itemp, ' has ', tbl_hash_oflow(ii), ' entries:' + ! do ff = 1, tbl_hash_oflow(ii) ! dump out colliding names on this chain + ! write(iulog,*) ' ', ff, ' = ', tbl_hash_oflow(ii+ff), & + ! ' ', masterlist(tbl_hash_oflow(ii+ff))%thisentry%field%name + ! end do + ! ii = ii + tbl_hash_oflow(ii) +1 !advance pointer to start of next chain + ! end do + ! end if + + return +666 format(1x, a, '(', i4, ')', 1x, i6) + + end subroutine bld_outfld_hash_tbls + + !####################################################################### + + subroutine bld_htapefld_indices + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Set history tape field indicies in masterlist for each + ! field defined on every tape. + ! + ! Note: because of restart processing, the actflag field is cleared and + ! then set only for active output fields on the different history + ! tapes. + ! + !----------------------------------------------------------------------- + ! + ! Arguments: + ! + + ! + ! Local. + ! + integer :: f + integer :: t + + ! + ! Initialize htapeindx to an invalid value. + ! + type(master_entry), pointer :: listentry + + ! reset all the active flags to false + ! this is needed so that restarts work properly -- fvitt + listentry=>masterlinkedlist + do while(associated(listentry)) + listentry%actflag(:) = .false. + listentry%act_sometape = .false. + listentry=>listentry%next_entry + end do + + do t = 1, ptapes + do f = 1, nflds(t) + listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(f)%field%name) + if(.not.associated(listentry)) then + write(iulog,*) 'BLD_HTAPEFLD_INDICES: something wrong, field not found on masterlist' + write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, f + write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(f)%field%name + call endrun + end if + listentry%act_sometape = .true. + listentry%actflag(t) = .true. + listentry%htapeindx(t) = f + end do + end do + + ! + ! set flag indicating h-tape contents are now defined (needed by addfld) + ! + htapes_defined = .true. + + return + end subroutine bld_htapefld_indices + + !####################################################################### + + logical function hist_fld_active(fname) + ! + !------------------------------------------------------------------------ + ! + ! Purpose: determine if a field is active on any history file + ! + !------------------------------------------------------------------------ + ! + ! Arguments + ! + character(len=*), intent(in) :: fname ! Field name + ! + ! Local variables + ! + character*(max_fieldname_len) :: fname_loc ! max-char equivalent of fname + integer :: ff ! masterlist index pointer + !----------------------------------------------------------------------- + + fname_loc = fname + ff = get_masterlist_indx(fname_loc) + if ( ff < 0 ) then + hist_fld_active = .false. + else + hist_fld_active = masterlist(ff)%thisentry%act_sometape + end if + + end function hist_fld_active + + !####################################################################### + + function hist_fld_col_active(fname, lchnk, numcols) + use cam_history_support, only: history_patch_t + + ! Determine whether each column in a field is active on any history file. + ! The purpose of this routine is to provide information which would allow + ! a diagnostic physics parameterization to only be run on a subset of + ! columns in the case when only column or regional output is requested. + ! + ! **N.B.** The field is assumed to be using the physics decomposition. + + ! Arguments + character(len=*), intent(in) :: fname ! Field name + integer, intent(in) :: lchnk ! chunk ID + integer, intent(in) :: numcols ! Size of return array + + ! Return value + logical :: hist_fld_col_active(numcols) + + ! Local variables + integer :: ff ! masterlist index pointer + integer :: i + integer :: t ! history file (tape) index + integer :: f ! field index + integer :: decomp + logical :: activeloc(numcols) + integer :: num_patches + logical :: patch_output + logical :: found + type(history_patch_t), pointer :: patchptr + + type (active_entry), pointer :: tape(:) + + !----------------------------------------------------------------------- + + ! Initialize to false. Then look to see if and where active. + hist_fld_col_active = .false. + + ! Check for name in the master list. + call get_field_properties(fname, found, tape_out=tape, ff_out=ff) + + ! If not in master list then return. + if (.not. found) return + + ! If in master list, but not active on any file then return + if (.not. masterlist(ff)%thisentry%act_sometape) return + + ! Loop over history files and check for the field/column in each one + do t = 1, ptapes + + ! Is the field active in this file? If not the cycle to next file. + if (.not. masterlist(ff)%thisentry%actflag(t)) cycle + + f = masterlist(ff)%thisentry%htapeindx(t) + decomp = tape(t)%hlist(f)%field%decomp_type + patch_output = associated(tape(t)%patches) + + ! Check whether this file has patch (column) output. + if (patch_output) then + num_patches = size(tape(t)%patches) + + do i = 1, num_patches + patchptr => tape(t)%patches(i) + activeloc = .false. + call patchptr%active_cols(decomp, lchnk, activeloc) + hist_fld_col_active = hist_fld_col_active .or. activeloc + end do + else + + ! No column output has been requested. In that case the field has + ! global output which implies all columns are active. No need to + ! check any other history files. + hist_fld_col_active = .true. + exit + + end if + + end do ! history files + + end function hist_fld_col_active + +end module cam_history diff --git a/src/control/cam_history_buffers.F90 b/src/control/cam_history_buffers.F90 new file mode 100644 index 0000000000..f9a141247a --- /dev/null +++ b/src/control/cam_history_buffers.F90 @@ -0,0 +1,543 @@ +module cam_history_buffers + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_history_support, only: max_chars, field_info, hentry, dim_index_2d + use cam_abortutils, only: endrun + use pio, only: var_desc_t + + implicit none + + +contains + subroutine hbuf_accum_inst (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Accumulate instantaneous values of field in 2-D hbuf. + ! Set accumulation counter to 1. + ! + !----------------------------------------------------------------------- + ! + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i, k ! loop indices + + logical :: bad ! flag indicates input field fillvalues not applied consistently + ! with vertical level + + call dimind%dim_sizes(ieu, jeu) + + do k=1,jeu + do i=1,ieu + buf8(i,k) = field(i,k) + end do + end do + + if (flag_xyfill) then + do i=1,ieu + if (field(i,1) == fillvalue) then + nacs(i) = 0 + else + nacs(i) = 1 + end if + end do + else + nacs(1) = 1 + end if + + return + end subroutine hbuf_accum_inst + !####################################################################### + + subroutine hbuf_accum_add (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add the values of field to 2-D hbuf. + ! Increment accumulation counter by 1. + ! + !----------------------------------------------------------------------- + ! + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i,k ! indices + + call dimind%dim_sizes(ieu, jeu) + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (field(i,k) /= fillvalue) then + buf8(i,k) = buf8(i,k) + field(i,k) + end if + end do + end do + ! + ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs + ! + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = nacs(i) + 1 + end if + end do + else + do k=1,jeu + do i=1,ieu + buf8(i,k) = buf8(i,k) + field(i,k) + end do + end do + nacs(1) = nacs(1) + 1 + end if + + return + end subroutine hbuf_accum_add + + !####################################################################### + subroutine hbuf_accum_variance (hbuf, sbuf, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: accumulate a running variance for standard deviations + ! + ! The method of computing variance is from http://www.johndcook.com/blog/standard_deviation/ + ! and + ! 1962 paper by B. P. Welford and is presented in Donald Knuth's Art of + ! Computer Programming, Vol 2, page 232, 3rd edition. + !----------------------------------------------------------------------- + ! + real(r8), pointer :: hbuf(:,:) ! 2-D history buffer + real(r8), pointer :: sbuf(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i,k ! indices + real(r8) :: tmp + + call dimind%dim_sizes(ieu, jeu) + + if (flag_xyfill) then + + ! + ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs + ! + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = nacs(i) + 1 + end if + end do + + do k=1,jeu + do i=1,ieu + if (field(i,k) /= fillvalue) then + if (nacs(i)==1) then + hbuf(i,k) = field(i,k) + sbuf(i,k) = 0._r8 + else + tmp = hbuf(i,k) + hbuf(i,k) = hbuf(i,k) + (field(i,k)-hbuf(i,k))/nacs(i) + sbuf(i,k) = sbuf(i,k) + (field(i,k)-hbuf(i,k))*(field(i,k)-tmp) + endif + end if + end do + end do + + else + + ! increment counter before variance calculation + nacs(1) = nacs(1) + 1 + + do k=1,jeu + do i=1,ieu + if (nacs(1)==1) then + hbuf(i,k) = field(i,k) + sbuf(i,k) = 0._r8 + else + tmp = hbuf(i,k) + hbuf(i,k) = hbuf(i,k) + (field(i,k)-hbuf(i,k))/nacs(1) + sbuf(i,k) = sbuf(i,k) + (field(i,k)-hbuf(i,k))*(field(i,k)-tmp) + endif + end do + end do + + end if + + end subroutine hbuf_accum_variance + + !####################################################################### + + subroutine hbuf_accum_add00z (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add the values of field to 2-D hbuf, only if time is 00z. + ! Increment accumulation counter by 1. + ! + !----------------------------------------------------------------------- + ! + use time_manager, only: get_curr_date + + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i,k ! indices + integer :: yr, mon, day, tod + + ! get the time of day, return if not 00z + call get_curr_date (yr,mon,day,tod) + if (tod /= 0) return + + call dimind%dim_sizes(ieu, jeu) + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (field(i,k) /= fillvalue) then + buf8(i,k) = buf8(i,k) + field(i,k) + end if + end do + end do + ! + ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs + ! + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = nacs(i) + 1 + end if + end do + else + do k=1,jeu + do i=1,ieu + buf8(i,k) = buf8(i,k) + field(i,k) + end do + end do + nacs(1) = nacs(1) + 1 + end if + + return + end subroutine hbuf_accum_add00z + + !####################################################################### + + subroutine hbuf_accum_max (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Accumulate the maximum values of field in 2-D hbuf + ! Set accumulation counter to 1. + ! + !----------------------------------------------------------------------- + ! + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i, k + + call dimind%dim_sizes(ieu, jeu) + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (nacs(i) == 0) then + buf8(i,k) = -huge (buf8) + end if + if (field(i,k) > buf8(i,k) .and. field(i,k) /= fillvalue) then + buf8(i,k) = field(i,k) + end if + end do + end do + else + do k=1,jeu + do i=1,ieu + if (nacs(1) == 0) then + buf8(i,k) = -huge (buf8) + end if + if (field(i,k) > buf8(i,k)) then + buf8(i,k) = field(i,k) + end if + end do + end do + end if + + if (flag_xyfill) then + call check_accum (field, idim, ieu, jeu,fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = 1 + end if + end do + else + nacs(1) = 1 + end if + + return + end subroutine hbuf_accum_max + + !####################################################################### + + subroutine hbuf_accum_min (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Accumulate the minimum values of field in 2-D hbuf + ! Set accumulation counter to 1. + ! + !----------------------------------------------------------------------- + ! + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i, k + + call dimind%dim_sizes(ieu, jeu) + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (nacs(i) == 0) then + buf8(i,k) = +huge (buf8) + end if + if (field(i,k) < buf8(i,k) .and. field(i,k) /= fillvalue) then + buf8(i,k) = field(i,k) + end if + end do + end do + else + do k=1,jeu + do i=1,ieu + if (nacs(1) == 0) then + buf8(i,k) = +huge (buf8) + end if + if (field(i,k) < buf8(i,k)) then + buf8(i,k) = field(i,k) + end if + end do + end do + end if + + if (flag_xyfill) then + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = 1 + end if + end do + else + nacs(1) = 1 + end if + + return + end subroutine hbuf_accum_min + + subroutine hbuf_accum_addlcltime (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue, c , decomp_type,& + lcltod_start, lcltod_stop) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add the values of field to 2-D hbuf, only if the local time + ! is in the range specified. + ! Increment accumulation counter by 1. + ! + !----------------------------------------------------------------------- + ! + use time_manager, only: get_curr_date + use phys_grid, only: get_rlon_all_p, phys_decomp + use physconst, only: pi + use phys_grid, only: get_ncols_p + use dyn_grid, only: dyn_grid_get_elem_coords + + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in) :: field(idim,*) ! real*8 array + integer, intent(in) :: c ! chunk (physics) or latitude (dynamics) index + + integer, intent(in) :: decomp_type, lcltod_start, lcltod_stop + real(r8), intent(in) :: fillvalue + + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i,k ! indices + integer :: yr, mon, day, tod + integer :: ncols + + integer, allocatable :: lcltod(:) ! local time of day (secs) + logical, allocatable :: inavg(:) ! is the column in the desired local time range? + real(r8), allocatable :: rlon(:) ! column longitude (radians) + integer, allocatable :: cdex(:) ! global column index + + call dimind%dim_sizes(ieu, jeu) + + allocate( inavg(1:ieu) , lcltod(1:ieu) ) + lcltod(:) = 0 + + ! + ! Get the time of day and longitude and compute the local time. + ! + call get_curr_date (yr,mon,day,tod) + + if ( decomp_type == phys_decomp ) then + + ncols = get_ncols_p(c) + ieu = ncols + allocate( rlon(ncols) ) + call get_rlon_all_p(c, ncols, rlon) + lcltod(1:ncols) = mod((tod) + (nint(86400._r8 * rlon(1:ncols) / 2._r8 / pi)), 86400) + + else + + ncols = ieu + allocate(rlon(ncols),cdex(ncols)) + call dyn_grid_get_elem_coords( c, rlon=rlon, cdex=cdex ) + lcltod(:) = -999999 + where( cdex(:)>0 ) lcltod(1:ieu) = mod((tod) + (nint(86400._r8 * rlon(1:ncols) / 2._r8 / pi)), 86400) + + endif + + + + ! + ! Set a flag to indicate that the column is in the requested local time range. + ! If lcltod_stop is less than lcltod_start, then the time is wrapping around 24 hours. + ! + inavg(:) = .false. + + if (lcltod_stop < lcltod_start) then + ! the ".and.(lcltod(:)>0" condition was added to exclude the undefined (-999999) columns + where((lcltod(:) >= lcltod_start) .or. ((lcltod(:) < lcltod_stop).and.(lcltod(:)>0))) inavg(:) = .true. + else if (lcltod_stop == lcltod_start) then + where(lcltod(1:ieu) == lcltod_start) inavg(1:ieu) = .true. + else + where((lcltod(:) >= lcltod_start) .and. (lcltod(:) < lcltod_stop)) inavg(:) = .true. + end if + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (inavg(i) .and. (field(i,k) /= fillvalue)) then + buf8(i,k) = buf8(i,k) + field(i,k) + end if + end do + end do + ! + ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs + ! + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (inavg(i) .and. (field(i,1) /= fillvalue)) then + nacs(i) = nacs(i) + 1 + end if + end do + else + do k=1,jeu + do i=1,ieu + if (inavg(i)) then + buf8(i,k) = buf8(i,k) + field(i,k) + end if + end do + end do + ! + ! NOTE: Because of the local time, some columns in the chunk may not be used in the + ! average, so nacs need to be dimension with the number of columns unlike the other + ! averaging techniques. + ! + do i=1,ieu + if (inavg(i)) nacs(i) = nacs(i) + 1 + end do + end if + + deallocate( inavg , rlon, lcltod ) + if (allocated(cdex)) deallocate(cdex) + + return + end subroutine hbuf_accum_addlcltime + +!####################################################################### + + + !####################################################################### + + subroutine check_accum (field, idim, ieu, jeu, fillvalue) + ! + integer, intent(in) :: idim + real(r8), intent(in) :: field(idim,*) ! real*8 array + integer, intent(in) :: ieu,jeu ! loop ranges + + logical :: bad + integer :: i,k + real(r8), intent(in) :: fillvalue + ! + ! For multilevel fields ensure that all levels have fillvalue applied consistently + ! + bad = .false. + do k=2,jeu + do i=1,ieu + if (field(i,1) == fillvalue .and. field(i,k) /= fillvalue .or. & + field(i,1) /= fillvalue .and. field(i,k) == fillvalue) then + bad = .true. + end if + end do + end do + + if (bad) then + call endrun ('CHECK_ACCUM: inconsistent level values') + end if + + return + end subroutine check_accum + +end module cam_history_buffers diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 new file mode 100644 index 0000000000..fdc185d5d6 --- /dev/null +++ b/src/control/cam_history_support.F90 @@ -0,0 +1,1987 @@ +module cam_history_support + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! +!! cam_history_support is used by cam_history as well as by the dycores +!! (for vertical coordinate and "mdim" support). Some parameters are +!! also referenced by cam_grid_support (although those could be copied +!! if necessary). +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl + use shr_sys_mod, only: shr_sys_flush + use pio, only: var_desc_t, file_desc_t + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_grid_support, only: cam_grid_patch_t, cam_grid_header_info_t + use cam_grid_support, only: max_hcoordname_len + use cam_pio_utils, only: cam_pio_handle_error + + implicit none + private + save + + integer, parameter, public :: max_string_len = 256 ! Length of strings + integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables + integer, parameter, public :: fieldname_len = 24 ! max chars for field name + integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") + integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters + ! max_fieldname_len = max chars for field name (including suffix) + integer, parameter, public :: max_fieldname_len = fieldname_len + fieldname_suffix_len + + integer, parameter, public :: pflds = 1000 ! max number of fields for namelist entries fincl and fexcl + ! also used in write restart + integer, parameter, public :: ptapes = 12 ! max number of tapes + + ! A special symbol for declaring a field which has no vertical or + ! non-grid dimensions. It is here (rather than cam_history) so that it + ! be checked by add_hist_coord + character(len=10), parameter, public :: horiz_only = 'horiz_only' + + type, public :: history_patch_t + character(len=max_chars) :: namelist_entry = '' + ! lon_axis_name and lat_axis_name are not used if collected_output = .true. + character(len=max_fieldname_len) :: lon_axis_name = '' + character(len=max_fieldname_len) :: lat_axis_name = '' + logical :: collected_output + ! There is one patch for every grid and one header_info for every patch + type(cam_grid_patch_t), pointer :: patches(:) => NULL() + type (cam_grid_header_info_t), pointer :: header_info(:) => NULL() + contains + procedure :: write_attrs => history_patch_write_attrs + procedure :: write_vals => history_patch_write_vals + procedure :: field_name => history_patch_field_name + procedure :: num_hdims => history_patch_num_hdims + procedure :: get_var_data => history_patch_get_var_data + procedure :: write_var => history_patch_write_var + procedure :: compact => history_patch_compact + procedure :: active_cols => history_patch_active_cols + procedure :: deallocate => history_patch_deallocate + end type history_patch_t + +! +! dim_index_2d, dim_index_3d: 2-D & 3-D dimension index lower & upper bounds +! + type, public :: dim_index_2d ! 2-D dimension index + integer :: beg1, end1 ! lower & upper bounds of 1st dimension + integer :: beg2, end2 ! lower & upper bounds of 2nd dimension + contains + procedure :: dim_sizes_2d => dim_index_2d_dim_sizes_2d + procedure :: dim_sizes_arr => dim_index_2d_dim_size_arr + generic :: dim_sizes => dim_sizes_arr, dim_sizes_2d + end type dim_index_2d + + type, public :: dim_index_3d ! 3-D dimension index + integer :: beg1, end1 ! lower & upper bounds of 1st dimension + integer :: beg2, end2 ! lower & upper bounds of 2nd dimension + integer :: beg3, end3 ! lower & upper bounds of 3rd dimension + contains + procedure :: dim_sizes_3d => dim_index_3d_dim_sizes_3d + procedure :: dim_sizes_arr => dim_index_3d_dim_size_arr + generic :: dim_sizes => dim_sizes_arr, dim_sizes_3d + end type dim_index_3d + + !--------------------------------------------------------------------------- + ! + ! field_info: A derived type containing information in an addfld call. + ! + !--------------------------------------------------------------------------- + type, public :: field_info + + logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue + logical :: is_subcol ! .true. iff field output as subcol + integer, pointer :: mdims(:) => NULL() ! indicies into hist_coords list + integer, pointer :: shape(:) => NULL() ! shape of field on file + + real(r8) :: fillvalue ! fillvalue for this variable, set to default if not explicit in addfld + + integer :: numlev ! vertical dimension (.nc file and internal arr) + + integer :: begdim1 ! on-node dim1 start index + integer :: enddim1 ! on-node dim1 end index + + integer :: begdim2 ! on-node dim2 start index + integer :: enddim2 ! on-node dim2 end index + + integer :: begdim3 ! on-node chunk or lat start index + integer :: enddim3 ! on-node chunk or lat end index + + logical :: colperchunk ! .true. iff ncols /= chunksize + + integer :: decomp_type ! type of decomposition (e.g., physics or dynamics) + + ! meridional and zonal complements are for fields defined as part of a + ! 2-D vector. These IDs are used to facilitate interpolated history output + ! At most one of these will be a positive field ID. + integer :: meridional_complement ! meridional field id or -1 + integer :: zonal_complement ! zonal field id or -1 + + character(len=max_fieldname_len) :: name ! field name + character(len=max_chars) :: long_name ! long name + character(len=max_chars) :: units ! units + character(len=max_chars) :: sampling_seq ! sampling sequence - if not every timestep, how often field is sampled + ! (i.e., how often "outfld" is called): every other; only during LW/SW + ! radiation calcs; etc. + character(len=max_chars) :: cell_methods ! optional cell_methods attribute + contains + procedure :: get_shape => field_info_get_shape + procedure :: get_bounds => field_info_get_bounds + procedure :: get_dims_2d => field_info_get_dims_2d + procedure :: get_dims_3d => field_info_get_dims_3d + generic :: get_dims => get_dims_2d, get_dims_3d + end type field_info + + real(r8), parameter, public :: fillvalue = 1.e36_r8 ! fill value for netcdf fields + + + !--------------------------------------------------------------------------- + ! + ! hentry: elements of an entry in the list of active fields on a single + ! history file + ! nacs is an accumulation counter which normally counts an entire + ! chunk (physics) or block (dynamics) as accumulated as a single + ! entity. The per-chunk counting avoids counting multiple outfld + ! calls as multiple accumulations. Only the value of the first chunk + ! or block is written to or read from a history restart file. + ! For certain actions (e.g., only accumulating on + ! non-fillvalue or accumulating based on local time), nacs has an + ! entry for every column. + ! nacs does not keep track of levels + ! + !--------------------------------------------------------------------------- + type, public:: hentry + type (field_info) :: field ! field information + character(len=1) :: avgflag ! averaging flag + character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) + + integer :: hwrt_prec ! history output precision + real(r8), pointer :: hbuf(:,:,:) => NULL() + real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation + type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids + integer, pointer :: nacs(:,:) => NULL() ! accumulation counter + type(var_desc_t), pointer :: nacs_varid => NULL() + type(var_desc_t), pointer :: sbuf_varid => NULL() + end type hentry + + !--------------------------------------------------------------------------- + ! + ! active_entry: derived type containing information for a history tape + ! + !--------------------------------------------------------------------------- + type, public:: active_entry + + type(hentry), pointer :: hlist(:) + + integer, pointer :: grid_ids(:) => NULL() + type(history_patch_t), pointer :: patches(:) => NULL() + + ! + ! PIO ids + ! + + type(file_desc_t) :: File ! PIO file id + + type(var_desc_t) :: mdtid ! var id for timestep + type(var_desc_t) :: ndbaseid ! var id for base day + type(var_desc_t) :: nsbaseid ! var id for base seconds of base day + type(var_desc_t) :: nbdateid ! var id for base date + type(var_desc_t) :: nbsecid ! var id for base seconds of base date + type(var_desc_t) :: ndcurid ! var id for current day + type(var_desc_t) :: nscurid ! var id for current seconds of current day + type(var_desc_t) :: dateid ! var id for current date + type(var_desc_t) :: co2vmrid ! var id for co2 volume mixing ratio + type(var_desc_t) :: ch4vmrid ! var id for ch4 volume mixing ratio + type(var_desc_t) :: n2ovmrid ! var id for n2o volume mixing ratio + type(var_desc_t) :: f11vmrid ! var id for f11 volume mixing ratio + type(var_desc_t) :: f12vmrid ! var id for f12 volume mixing ratio + type(var_desc_t) :: sol_tsiid ! var id for total solar irradiance (W/m2) + type(var_desc_t) :: datesecid ! var id for curent seconds of current date +#if ( defined BFB_CAM_SCAM_IOP ) + type(var_desc_t) :: bdateid ! var id for base date + type(var_desc_t) :: tsecid ! var id for curent seconds of current date +#endif + type(var_desc_t) :: nstephid ! var id for current timestep + type(var_desc_t) :: timeid ! var id for time + type(var_desc_t) :: tbndid ! var id for time_bnds + type(var_desc_t) :: date_writtenid ! var id for date time sample written + type(var_desc_t) :: time_writtenid ! var id for time time sample written + type(var_desc_t) :: f107id ! var id for f107 + type(var_desc_t) :: f107aid ! var id for f107a + type(var_desc_t) :: f107pid ! var id for f107p + type(var_desc_t) :: kpid ! var id for kp + type(var_desc_t) :: apid ! var id for ap + + end type active_entry + + !--------------------------------------------------------------------------- + ! + ! formula_terms_t: Information for formula terms (CF convention) variables + ! Used to add a formula-terms variable to the history file + ! Also adds a string, ': ' to the parent + ! mdim's 'formula_terms' attribute. + ! + !--------------------------------------------------------------------------- + type, public :: formula_terms_t + character(len=max_fieldname_len) :: a_name = '' ! 'A' term variable name + character(len=max_string_len) :: a_long_name = '' ! 'A' long name + real(r8), pointer :: a_values(:) => null() ! 'A' variable values + character(len=max_fieldname_len) :: b_name = '' ! 'B' term variable name + character(len=max_string_len) :: b_long_name = '' ! 'B' long name + real(r8), pointer :: b_values(:) => null() ! 'B' variable values + character(len=max_fieldname_len) :: p0_name = '' ! 'p0' term variable name + character(len=max_string_len) :: p0_long_name = '' ! 'p0' long name + character(len=max_chars) :: p0_units = '' ! 'p0' variable units + real(r8) :: p0_value = fillvalue ! 'p0' variable values + character(len=max_fieldname_len) :: ps_name = '' ! 'ps' term variable name + end type formula_terms_t + + !--------------------------------------------------------------------------- + ! + ! hist_coord_t: Information for history variable dimension attributes + ! + !--------------------------------------------------------------------------- + type, public :: hist_coord_t + character(len=max_hcoordname_len) :: name = '' ! coordinate name + integer :: dimsize = 0 ! size of dimension + character(len=max_hcoordname_len) :: dimname = '' ! optional dimension name + character(len=max_chars) :: long_name = '' ! 'long_name' attribute + character(len=max_chars) :: units = '' ! 'units' attribute + character(len=max_chars) :: bounds_name = '' ! 'bounds' attribute (& name of bounds variable) + character(len=max_chars) :: standard_name = ''! 'standard_name' attribute + character(len=4) :: positive = '' ! 'positive' attribute ('up' or 'down') + integer, pointer :: integer_values(:) => null() ! dim values if integral + real(r8), pointer :: real_values(:) => null() ! dim values if real + real(r8), pointer :: bounds(:,:) => null() ! dim bounds + type(formula_terms_t) :: formula_terms ! vars for formula terms + logical :: integer_dim ! .true. iff dim has integral values + logical :: vertical_coord ! .true. iff dim is vertical + end type hist_coord_t + + ! Some parameters for use with interpolated output namelist items + integer, parameter, public :: interp_type_native = 0 + integer, parameter, public :: interp_type_bilinear = 1 + integer, parameter, public :: interp_gridtype_equal_poles = 1 + integer, parameter, public :: interp_gridtype_gauss = 2 + integer, parameter, public :: interp_gridtype_equal_nopoles = 3 + + !--------------------------------------------------------------------------- + ! + ! interp_info_t: Information for lat/lon interpolated history output + ! + !--------------------------------------------------------------------------- + type, public :: interp_info_t + ! store the lat-lon grid information + character(len=28) :: gridname = '' + integer :: grid_id = -1 + ! gridtype = 1 equally spaced, including poles (FV scalars output grid) + ! gridtype = 2 Gauss grid (CAM Eulerian) + ! gridtype = 3 equally spaced, no poles (FV staggered velocity) + integer :: interp_gridtype = interp_gridtype_equal_poles + ! interpolate_type = 0: native high order interpolation + ! interpolate_type = 1: bilinear interpolation + integer :: interp_type = interp_type_bilinear + integer :: interp_nlat = 0 + integer :: interp_nlon = 0 + real(r8), pointer :: interp_lat(:) => NULL() + real(r8), pointer :: interp_lon(:) => NULL() + real(r8), pointer :: interp_gweight(:) => NULL() + end type interp_info_t + + !! Coordinate variables + integer, public :: registeredmdims = 0 + integer, public :: maxvarmdims = 1 + character(len=9), parameter, public :: mdim_var_name = 'mdimnames' + integer, parameter :: maxmdims = 25 ! arbitrary limit + type(hist_coord_t), public :: hist_coords(maxmdims) + + public :: add_hist_coord, add_vert_coord + public :: write_hist_coord_attrs, write_hist_coord_vars + public :: lookup_hist_coord_indices, hist_coord_find_levels + public :: get_hist_coord_index, hist_coord_name, hist_coord_size + public :: sec2hms, date2yyyymmdd + + interface add_hist_coord + module procedure add_hist_coord_regonly + module procedure add_hist_coord_int + module procedure add_hist_coord_r8 + end interface + + interface hist_coord_size + module procedure hist_coord_size_char + module procedure hist_coord_size_int + end interface + + interface assignment(=) + module procedure field_copy + module procedure formula_terms_copy + end interface + + interface check_hist_coord + ! NB: This is supposed to be a private interface + ! check_hist_coord: returns 0 if is not registered as an mdim + ! returns i if is registered with compatible values + ! calls endrun if is registered with incompatible values + ! Versions without the argument return .true. or .false. + module procedure check_hist_coord_char + module procedure check_hist_coord_int + module procedure check_hist_coord_int1 + module procedure check_hist_coord_r8 + module procedure check_hist_coord_r81 + module procedure check_hist_coord_r82 + module procedure check_hist_coord_ft + module procedure check_hist_coord_all + end interface + +!!--------------------------------------------------------------------------- + +contains + + subroutine dim_index_2d_dim_sizes_2d(this, dim1, dim2) + + ! Dummy arguments + class(dim_index_2d) :: this + integer, intent(out) :: dim1 + integer, intent(out) :: dim2 + + dim1 = MAX(0, this%end1 - this%beg1 + 1) + dim2 = MAX(0, this%end2 - this%beg2 + 1) + + end subroutine dim_index_2d_dim_sizes_2d + + subroutine dim_index_2d_dim_size_arr(this, dims) + + ! Dummy arguments + class(dim_index_2d) :: this + integer, intent(out) :: dims(:) + + if (size(dims) < 2) then + call endrun('dim_index_2d_dim_sizes: dims must have at least two elements') + end if + + call this%dim_sizes(dims(1), dims(2)) + + end subroutine dim_index_2d_dim_size_arr + + subroutine dim_index_3d_dim_sizes_3d(this, dim1, dim2, dim3) + + ! Dummy arguments + class(dim_index_3d) :: this + integer, intent(out) :: dim1 + integer, intent(out) :: dim2 + integer, intent(out) :: dim3 + + dim1 = MAX(0, this%end1 - this%beg1 + 1) + dim2 = MAX(0, this%end2 - this%beg2 + 1) + dim3 = MAX(0, this%end3 - this%beg3 + 1) + + end subroutine dim_index_3d_dim_sizes_3d + + subroutine dim_index_3d_dim_size_arr(this, dims) + + ! Dummy arguments + class(dim_index_3d) :: this + integer, intent(out) :: dims(:) + + if (size(dims) < 3) then + call endrun('dim_index_3d_dim_sizes: dims must have at least three elements') + end if + + call this%dim_sizes(dims(1), dims(2), dims(3)) + + end subroutine dim_index_3d_dim_size_arr + + ! field_info_get_dims_2d: Retrieve bounds for stepping through a chunk + type(dim_index_2d) function field_info_get_dims_2d(this, col) result(dims) + use cam_grid_support, only: cam_grid_get_block_count + + ! Dummy argument + class(field_info) :: this + integer, intent(in) :: col + + ! Local variable + integer :: endi + + if (this%colperchunk) then + endi = this%begdim1 + cam_grid_get_block_count(this%decomp_type, col) - 1 + dims = dim_index_2d(this%begdim1, endi, this%begdim2, this%enddim2) + else + dims = dim_index_2d(this%begdim1, this%enddim1, this%begdim2, this%enddim2) + end if + end function field_info_get_dims_2d + + ! field_info_get_dims_3d: Retrieve grid decomp bounds + type(dim_index_3d) function field_info_get_dims_3d(this) result(dims) + + ! Dummy argument + class(field_info) :: this + + dims = dim_index_3d(this%begdim1, this%enddim1, this%begdim2, this%enddim2,& + this%begdim3, this%enddim3) + + end function field_info_get_dims_3d + + ! field_info_get_shape: Return a pointer to the field's global shape. + ! Calculate it first if necessary + subroutine field_info_get_shape(this, shape_out, rank_out) + use cam_grid_support, only: cam_grid_dimensions + + ! Dummy arguments + class(field_info) :: this + integer, intent(out) :: shape_out(:) + integer, intent(out) :: rank_out + + ! Local arguments + integer :: rank, i, pos + integer :: gdims(2) + + if (.not. associated(this%shape)) then + ! Calculate field's global shape + call cam_grid_dimensions(this%decomp_type, gdims, rank) + pos = rank + if (associated(this%mdims)) then + rank = rank + size(this%mdims) + end if + allocate(this%shape(rank)) + this%shape(1:pos) = gdims(1:pos) + if (rank > pos) then + do i = 1, size(this%mdims) + pos = pos + 1 + this%shape(pos) = hist_coords(this%mdims(i))%dimsize + end do + end if + end if + + rank_out = size(this%shape) + + if (size(shape_out) < rank_out) then + call endrun('field_info_get_shape: shape_out too small') + end if + + shape_out(1:rank_out) = this%shape(1:rank_out) + if (size(shape_out) > rank_out) then + shape_out(rank_out+1:) = 1 + end if + + end subroutine field_info_get_shape + + subroutine field_info_get_bounds(this, dim, beg, end) + + ! Dummy arguments + class(field_info) :: this + integer, intent(in) :: dim + integer, intent(out) :: beg + integer, intent(out) :: end + + select case(dim) + case (1) + beg = this%begdim1 + end = this%enddim1 + case (2) + beg = this%begdim2 + end = this%enddim2 + case (3) + beg = this%begdim3 + end = this%enddim3 + case default + call endrun('field_info_get_bounds: dim must be 1, 2, or 3') + end select + + end subroutine field_info_get_bounds + + ! history_patch_write_attrs: Define coordinate variables and attributes + ! for a patch + subroutine history_patch_write_attrs(this, File) + use cam_grid_support, only: cam_grid_is_unstructured + use pio, only: file_desc_t, var_desc_t, pio_put_att, pio_double + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var, cam_pio_handle_error + + ! Dummy arguments + class(history_patch_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variable + type(cam_grid_patch_t), pointer :: patchptr + type(var_desc_t), pointer :: vardesc_lat => NULL() + type(var_desc_t), pointer :: vardesc_lon => NULL() + character(len=128) :: errormsg + character(len=max_chars) :: lat_name + character(len=max_chars) :: lon_name + character(len=max_chars) :: col_name + character(len=max_chars) :: temp_str + integer :: dimid1, dimid2 ! PIO dim IDs + integer :: num_patches + integer :: temp1, temp2 + integer :: latid, lonid ! Coordinate dims + integer :: i, ierr + logical :: col_only + logical :: unstruct + character(len=*), parameter :: subname = 'history_patch_write_attrs' + + num_patches = size(this%patches) + if (associated(this%header_info)) then + ! Make sure header_info is the right size + if (size(this%header_info) /= num_patches) then + write(errormsg, '(a,2(i0,a))') 'Size mismatch between header_info (', & + size(this%header_info), ') and patches (', num_patches, ')' + call endrun(subname//': '//errormsg) + end if + else + allocate(this%header_info(num_patches)) + end if + + ! Write attributes for each patch + do i = 1, num_patches + patchptr => this%patches(i) + call this%header_info(i)%set_gridid(patchptr%gridid()) + unstruct = cam_grid_is_unstructured(patchptr%gridid()) + ! What are the dimension(s) for this patch? + col_only = this%collected_output + if (num_patches == 1) then + ! Backwards compatibility + if (unstruct .or. col_only) then + col_name = 'ncol' + else + col_name = '' + end if + lat_name = 'lat' + lon_name = 'lon' + else + call patchptr%get_axis_names(lat_name, lon_name, col_name, col_only) + end if + ! Define the dimensions (latx/lonx or ncolx) + ! col_name is set for unstructured output or collected columns (ncolx) + if (len_trim(col_name) > 0) then + call patchptr%get_global_size(gsize=temp1) + if (temp1 <= 0) then + call endrun(subname//': col dimsize must be positive') + end if + if (unstruct .and. (.not. col_only)) then + ! For the case of unstructured output without collected column + ! output, we need to make sure that the ncolx dimension is unique + col_name = trim(col_name)//'_'//trim(this%lon_axis_name)//'_'//trim(this%lat_axis_name) + end if + call cam_pio_def_dim(File, trim(col_name), temp1, dimid1, existOK=.false.) + call this%header_info(i)%set_hdims(dimid1) + latid = dimid1 + lonid = dimid1 + else + lat_name = trim(lat_name)//'_'//trim(this%lat_axis_name) + call patchptr%get_global_size(temp1, temp2) + if (temp1 <= 0) then + call endrun(subname//': lat dimsize must be positive') + end if + call cam_pio_def_dim(File, trim(lat_name), temp1, dimid1, existOK=.true.) + latid = dimid1 + lon_name = trim(lon_name)//'_'//trim(this%lon_axis_name) + if (temp2 <= 0) then + call endrun(subname//': lon dimsize must be positive') + end if + call cam_pio_def_dim(File, trim(lon_name), temp2, dimid2, existOK=.true.) + lonid = dimid2 + call this%header_info(i)%set_hdims(lonid, latid) + end if + !! Define the latx (coordinate) variable + if (unstruct .and. (.not. col_only)) then + ! We need to make sure the latx name is unique + lat_name = trim(lat_name)//'_'//trim(this%lon_axis_name)//'_'//trim(this%lat_axis_name) + end if + allocate(vardesc_lat) + call cam_pio_def_var(File, trim(lat_name), pio_double, (/latid/), & + vardesc_lat, existOK=.true.) + ! Coordinate attributes + call patchptr%get_coord_long_name('lat', temp_str) + if (len_trim(temp_str) > 0) then + ierr = pio_put_att(File, vardesc_lat, 'long_name', trim(temp_str)) + call cam_pio_handle_error(ierr, subname//': Unable to define long_name') + end if + call patchptr%get_coord_units('lat', temp_str) + if (len_trim(temp_str) > 0) then + ierr = pio_put_att(File, vardesc_lat, 'units', trim(temp_str)) + call cam_pio_handle_error(ierr, subname//': Unable to define units') + end if + !! Define the lonx (coordinate) variable + if (unstruct .and. (.not. col_only)) then + ! We need to make sure the lonx name is unique + lon_name = trim(lon_name)//'_'//trim(this%lon_axis_name)//'_'//trim(this%lat_axis_name) + end if + allocate(vardesc_lon) + call cam_pio_def_var(File, trim(lon_name), pio_double, (/lonid/), & + vardesc_lon, existOK=.true.) + ! Coordinate attributes + call patchptr%get_coord_long_name('lon', temp_str) + if (len_trim(temp_str) > 0) then + ierr = pio_put_att(File, vardesc_lon, 'long_name', trim(temp_str)) + call cam_pio_handle_error(ierr, subname//': Unable to define long_name') + end if + call patchptr%get_coord_units('lon', temp_str) + if (len_trim(temp_str) > 0) then + ierr = pio_put_att(File, vardesc_lon, 'units', trim(temp_str)) + call cam_pio_handle_error(ierr, subname//': Unable to define units') + end if + call this%header_info(i)%set_varids(vardesc_lon, vardesc_lat) + nullify(vardesc_lat, vardesc_lon) ! They belong to the header_info now + end do + + end subroutine history_patch_write_attrs + + ! history_patch_write_vals: Write coordinate variable values for a patch + subroutine history_patch_write_vals(this, File) + use pio, only: file_desc_t, var_desc_t + + ! Dummy arguments + class(history_patch_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variable + type(cam_grid_patch_t), pointer :: patchptr + type(var_desc_t), pointer :: vardesc => NULL() ! PIO var desc + character(len=128) :: errormsg + character(len=max_chars) :: lat_name + character(len=max_chars) :: lon_name + character(len=max_chars) :: col_name + character(len=max_chars) :: temp_str + integer :: dimid ! PIO dimension ID + integer :: num_patches + integer :: temp1, temp2 + integer :: latid, lonid ! Coordinate dims + integer :: i + logical :: col_only + + num_patches = size(this%patches) + if (.not. associated(this%header_info)) then + ! We need this for dim and coord variable descriptors + write(errormsg, '(2a)') 'No header info for ', trim(this%namelist_entry) + call endrun('history_patch_write_vals: '//errormsg) + end if + + ! Write attributes for each patch + do i = 1, num_patches + patchptr => this%patches(i) + ! Write the coordinate variables (or just lat/lon for column output) + call patchptr%write_coord_vals(File, this%header_info(i)) + end do + + end subroutine history_patch_write_vals + + ! history_patch_field_name: Add patch description to field name + subroutine history_patch_field_name(this, name) + ! Dummy arguments + class(history_patch_t) :: this + character(len=*), intent(inout) :: name + + if (.not. this%collected_output) then + ! Add patch description info to the variable name + name = trim(name)//'_'//trim(this%lon_axis_name)//'_'//trim(this%lat_axis_name) + end if + end subroutine history_patch_field_name + + ! history_patch_num_hdims: Find the number of horizontal dimensions for + ! the indicated grid + integer function history_patch_num_hdims(this, gridid) + ! Dummy arguments + class(history_patch_t) :: this + integer, intent(in) :: gridid ! The field's grid + + ! Local variables + type(cam_grid_patch_t), pointer :: patchptr + character(len=128) :: errormsg + integer :: i + integer :: num_patches + + ! Basic sanity checks, is this patch OK? + num_patches = size(this%patches) + if (associated(this%header_info)) then + ! Make sure header_info is the right size + if (size(this%header_info) /= num_patches) then + write(errormsg, '(a,2(i0,a))') 'Size mismatch between header_info (', & + size(this%header_info), ') and patches (', num_patches, ')' + call endrun('history_patch_num_hdims: '//errormsg) + end if + else + write(errormsg, *) 'No header info for patch, ', trim(this%namelist_entry) + call endrun('history_patch_num_hdims: '//errormsg) + end if + + ! Find the correct patch by matching grid ID + history_patch_num_hdims = -1 + do i = 1, num_patches + patchptr => this%patches(i) + if (patchptr%gridid() == gridid) then + ! This is the right patch, set the return val and quit loop + history_patch_num_hdims = this%header_info(i)%num_hdims() + exit + else if (i >= num_patches) then + write(errormsg, '(3a,i0)') 'No grid found for patch, ', & + trim(this%namelist_entry), '. Was looking for decomp ', gridid + call endrun('history_patch_num_hdims: '//errormsg) + ! No else needed + end if + end do + if (history_patch_num_hdims <= 0) then + write(errormsg, '(2a,2(a,i0))') 'INTERNAL: No grid patch for ', & + trim(this%namelist_entry), ', num_patches = ',num_patches, & + ', gridid = ', gridid + call endrun('history_patch_num_hdims: '//errormsg) + end if + + end function history_patch_num_hdims + + ! history_patch_get_var_data: Calculate data relevant to history variable + ! on a patch by substituting patch dimension ids for the horiz. ids + ! and adding patch information to the variable name + subroutine history_patch_get_var_data(this, name, dimids, gridid) + ! Dummy arguments + class(history_patch_t) :: this + character(len=*), intent(inout) :: name + integer, intent(inout) :: dimids(:) ! Grid dimids + integer, intent(in) :: gridid ! The field's grid + + ! Local variables + type(cam_grid_patch_t), pointer :: patchptr + type (cam_grid_header_info_t), pointer :: histptr + character(len=128) :: errormsg + integer :: num_patches + integer :: i + + ! Basic sanity checks, is this patch OK? + num_patches = size(this%patches) + if (associated(this%header_info)) then + ! Make sure header_info is the right size + if (size(this%header_info) /= num_patches) then + write(errormsg, '(a,2(i0,a))') 'Size mismatch between header_info (', & + size(this%header_info), ') and patches (', num_patches, ')' + call endrun('history_patch_get_var_data: '//errormsg) + end if + else + write(errormsg, *) 'No header info for patch, ', trim(this%namelist_entry) + call endrun('history_patch_get_var_data: '//errormsg) + end if + + ! Find the correct patch by matching grid ID + do i = 1, num_patches + patchptr => this%patches(i) + if (patchptr%gridid() == gridid) then + ! This is the right patch, quit loop + histptr => this%header_info(i) + exit + else if (i >= num_patches) then + write(errormsg, '(3a,i0)') 'No grid found for patch, ', & + trim(this%namelist_entry), '. Was looking for decomp ', gridid + call endrun('history_patch_get_var_data: '//errormsg) + ! No else needed + end if + end do + + ! We have the correct patch, replace the horizontal dimension ids + do i = 1, histptr%num_hdims() + dimids(i) = histptr%get_hdimid(i) + end do + ! Re-define the variable name + call this%field_name(name) + + end subroutine history_patch_get_var_data + + subroutine history_patch_compact(this) + + ! Dummy arguments + class(history_patch_t) :: this + + ! Local variables + integer :: num_patches + integer :: i + + num_patches = size(this%patches) + + ! Find the correct patch by matching grid ID + do i = 1, num_patches + call this%patches(i)%compact(this%collected_output) + end do + + end subroutine history_patch_compact + + subroutine history_patch_write_var(this, File, gridid, adims, dtype, hbuf, varid) + use pio, only: file_desc_t, var_desc_t, io_desc_t + use pio, only: pio_write_darray + use cam_pio_utils, only: cam_pio_handle_error, cam_pio_var_info + + ! Dummy arguments + class(history_patch_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: gridid + integer, intent(in) :: adims(:) + integer, intent(in) :: dtype + real(r8), intent(in) :: hbuf(:,:,:) + type(var_desc_t), pointer :: varid + + ! Local variables + type(cam_grid_patch_t), pointer :: patchptr + character(len=128) :: errormsg + integer :: num_patches + integer :: i, idx + integer :: uid ! unlimited dim ID + type(io_desc_t), pointer :: iodesc + integer :: ierr, nfdims + integer :: fdimlens(7), dimids(7) + + num_patches = size(this%patches) + + ! Find the correct patch by matching grid ID + do i = 1, num_patches + patchptr => this%patches(i) + if (patchptr%gridid() == gridid) then + ! This is the right patch, quit loop + exit + else if (i >= num_patches) then + write(errormsg, '(3a,i0)') 'No grid found for patch, ', & + trim(this%namelist_entry), '. Was looking for decomp ', gridid + call endrun('history_patch_write_var: '//trim(errormsg)) + ! No else needed + end if + end do + + ! We have the right grid, write the hbuf + call cam_pio_var_info(File, varid, nfdims, dimids, fdimlens, unlimDimID=uid) + idx = 1 + do i = 1, nfdims + if (i > idx) then + dimids(idx) = dimids(i) + end if + if (dimids(i) /= uid) then + idx = idx + 1 + end if + end do + nfdims = nfdims - COUNT(dimids(1:nfdims) == uid) + call patchptr%get_decomp(adims, fdimlens(1:nfdims), dtype, iodesc) + if (size(adims) == 2) then + call pio_write_darray(File, varid, iodesc, hbuf(:,1,:), ierr) + else if (size(adims) == 3) then + call pio_write_darray(File, varid, iodesc, hbuf, ierr) + else + call endrun("history_patch_write_var: adims must be rank 2 or 3") + end if + call cam_pio_handle_error(ierr, 'history_patch_write_var: Error writing variable') + + end subroutine history_patch_write_var + + subroutine history_patch_active_cols(this, gridid, lchnk, active) + ! Dummy arguments + class(history_patch_t) :: this + integer, intent(in) :: gridid ! desired grid + integer, intent(in) :: lchnk ! chunk or block number + logical, intent(out) :: active(:) + + ! Local variables + type(cam_grid_patch_t), pointer :: patchptr + character(len=128) :: errormsg + integer :: num_patches + integer :: i + + num_patches = size(this%patches) + + ! Find the correct patch by matching grid ID + do i = 1, num_patches + patchptr => this%patches(i) + if (patchptr%gridid() == gridid) then + ! This is the right patch, quit loop + exit + else if (i >= num_patches) then + write(errormsg, '(3a,i0)') 'No grid found for patch, ', & + trim(this%namelist_entry), '. Was looking for decomp ', gridid + call endrun('history_patch_active_cols: '//errormsg) + ! No else needed + end if + end do + + ! If we get here, patchptr is the grid patch we want + call patchptr%active_cols(lchnk, active) + + end subroutine history_patch_active_cols + + subroutine history_patch_deallocate(this) + ! Dummy argument + class(history_patch_t) :: this + ! Local variable + integer :: i + + this%lon_axis_name = '' + this%lat_axis_name = '' + + if (associated(this%patches)) then + do i = 1, size(this%patches) + call this%patches(i)%deallocate() + end do + deallocate(this%patches) + nullify(this%patches) + end if + + if (associated(this%header_info)) then + do i = 1, size(this%header_info) + call this%header_info(i)%deallocate() + end do + deallocate(this%header_info) + nullify(this%header_info) + end if + + end subroutine history_patch_deallocate + + subroutine field_copy(f_out, f_in) + type(field_info), intent(in) :: f_in + type(field_info), intent(out) :: f_out + + f_out%flag_xyfill= f_in%flag_xyfill + f_out%is_subcol = f_in%is_subcol + f_out%fillvalue= f_in%fillvalue + f_out%numlev = f_in%numlev ! vertical dimension (.nc file and internal arr) + f_out%begdim1 = f_in%begdim1 ! on-node dim1 start index + f_out%enddim1 = f_in%enddim1 ! on-node dim1 end index + f_out%begdim2 = f_in%begdim2 ! on-node dim2 start index + f_out%enddim2 = f_in%enddim2 ! on-node dim2 end index + f_out%begdim3 = f_in%begdim3 ! on-node chunk or lat start index + f_out%enddim3 = f_in%enddim3 ! on-node chunk or lat end index + f_out%decomp_type = f_in%decomp_type ! type of decomposition (physics or dynamics) + + f_out%meridional_complement = f_in%meridional_complement ! id or -1 + f_out%zonal_complement = f_in%zonal_complement ! id or -1 + + f_out%name = f_in%name ! field name + f_out%long_name = f_in%long_name ! long name + f_out%units = f_in%units ! units + f_out%sampling_seq = f_in%sampling_seq ! sampling sequence - if not every timestep, how often field is sampled + f_out%cell_methods = f_in%cell_methods + + if(associated(f_in%mdims)) then + f_out%mdims=>f_in%mdims + else + nullify(f_out%mdims) + end if + + end subroutine field_copy + + subroutine formula_terms_copy(f_out, f_in) + type(formula_terms_t), intent(in) :: f_in + type(formula_terms_t), intent(out) :: f_out + + f_out%a_name = f_in%a_name + f_out%a_long_name = f_in%a_long_name + f_out%a_values => f_in%a_values + f_out%b_name = f_in%b_name + f_out%b_long_name = f_in%b_long_name + f_out%b_values => f_in%b_values + f_out%p0_name = f_in%p0_name + f_out%p0_long_name = f_in%p0_long_name + f_out%p0_units = f_in%p0_units + f_out%p0_value = f_in%p0_value + f_out%ps_name = f_in%ps_name + end subroutine formula_terms_copy + + integer function get_hist_coord_index(mdimname) + ! Input variables + character(len=*), intent(in) :: mdimname + ! Local variable + integer :: i + + get_hist_coord_index = -1 + do i = 1, registeredmdims + if(trim(mdimname) == trim(hist_coords(i)%name)) then + get_hist_coord_index = i + exit + end if + end do + + end function get_hist_coord_index + + character(len=max_hcoordname_len) function hist_coord_name(index) + ! Input variables + integer, intent(in) :: index + + if ((index > 0) .and. (index <= registeredmdims)) then + hist_coord_name = hist_coords(index)%name + else + call endrun('hist_coord_name: index out of range') + end if + + end function hist_coord_name + + integer function hist_coord_size_int(index) + ! Input variables + integer, intent(in) :: index + + if (index > 0) then + hist_coord_size_int = hist_coords(index)%dimsize + else + hist_coord_size_int = -1 + end if + + end function hist_coord_size_int + + integer function hist_coord_size_char(mdimname) + ! Input variables + character(len=*), intent(in) :: mdimname + ! Local variable + integer :: i + + i = get_hist_coord_index(mdimname) + hist_coord_size_char = hist_coord_size(i) + + end function hist_coord_size_char + + ! Functions to check consistent term definition for hist coords + logical function check_hist_coord_char(defined, input) + + ! Input variables + character(len=*), intent(in) :: defined + character(len=*), intent(in), optional :: input + + if (len_trim(defined) == 0) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_char = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_char = (trim(input) == trim(defined)) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_char = .false. + end if + end function check_hist_coord_char + + logical function check_hist_coord_int(defined, input) + + ! Input variables + integer, intent(in) :: defined + integer, intent(in), optional :: input + + if (defined == 0) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_int = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_int = (input == defined) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_int = .false. + end if + end function check_hist_coord_int + + logical function check_hist_coord_int1(defined, input) + + ! Input variables + integer, pointer :: defined(:) + integer, intent(in), optional :: input(:) + + ! Local variables + integer :: i + + if (.not. associated(defined)) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_int1 = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_int1 = (size(input) == size(defined)) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_int1 = .false. + end if + if (check_hist_coord_int1 .and. associated(defined)) then + ! Need to check the values + do i = 1, size(defined) + if (defined(i) /= input(i)) then + check_hist_coord_int1 = .false. + exit + end if + end do + end if + end function check_hist_coord_int1 + + logical function check_hist_coord_r8(defined, input) + + ! Input variables + real(r8), intent(in) :: defined + real(r8), intent(in), optional :: input + + if (defined == fillvalue) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_r8 = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_r8 = (input == defined) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_r8 = .false. + end if + end function check_hist_coord_r8 + + logical function check_hist_coord_r81(defined, input) + + ! Input variables + real(r8), pointer :: defined(:) + real(r8), intent(in), optional :: input(:) + + ! Local variables + integer :: i + + if (.not. associated(defined)) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_r81 = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_r81 = (size(input) == size(defined)) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_r81 = .false. + end if + if (check_hist_coord_r81 .and. associated(defined)) then + ! Need to check the values + do i = 1, size(defined) + if (defined(i) /= input(i)) then + check_hist_coord_r81 = .false. + exit + end if + end do + end if + end function check_hist_coord_r81 + + logical function check_hist_coord_r82(defined, input) + + ! Input variables + real(r8), pointer :: defined(:,:) + real(r8), intent(in), optional :: input(:,:) + + ! Local variables + integer :: i, j + + if (.not. associated(defined)) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_r82 = .true. + else if (present(input)) then + ! We have to match definitions + check_hist_coord_r82 = ((size(input, 1) == size(defined, 1)) .and. & + (size(input, 2) == size(defined, 2))) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_r82 = .false. + end if + if (check_hist_coord_r82 .and. associated(defined)) then + ! Need to check the values + do j = 1, size(defined, 2) + do i = 1, size(defined, 1) + if (defined(i, j) /= input(i, j)) then + check_hist_coord_r82 = .false. + exit + end if + end do + end do + end if + end function check_hist_coord_r82 + + logical function check_hist_coord_ft(defined, input) + + ! Input variables + type(formula_terms_t), intent(in) :: defined + type(formula_terms_t), intent(in), optional :: input + + ! We will assume that if formula_terms has been defined, a_name has a value + if (len_trim(defined%a_name) == 0) then + ! In this case, we assume the current value is undefined so any input OK + check_hist_coord_ft = .true. + else if (present(input)) then + ! We have to match definitions + ! Need to check the values + check_hist_coord_ft = & + check_hist_coord(defined%a_name, input%a_name) .and. & + check_hist_coord(defined%a_long_name, input%a_long_name) .and. & + check_hist_coord(defined%a_values, input%a_values) .and. & + check_hist_coord(defined%b_name, input%b_name) .and. & + check_hist_coord(defined%b_long_name, input%b_long_name) .and. & + check_hist_coord(defined%b_values, input%b_values) .and. & + check_hist_coord(defined%p0_name, input%p0_name) .and. & + check_hist_coord(defined%p0_long_name, input%p0_long_name) .and. & + check_hist_coord(defined%p0_units, input%p0_units) .and. & + check_hist_coord(defined%p0_value, input%p0_value) .and. & + check_hist_coord(defined%ps_name, input%ps_name) + else + ! Not sure here. We have a value and are redefining without one? + check_hist_coord_ft = .false. + end if + end function check_hist_coord_ft + + ! check_hist_coord: returns 0 if is not registered as a hist coord + ! returns i if is registered with compatible values + ! calls endrun if is registered with incompatible values + integer function check_hist_coord_all(name, vlen, long_name, units, bounds, & + i_values, r_values, bounds_name, positive, standard_name, formula_terms) + + ! Input variables + character(len=*), intent(in) :: name + integer, intent(in) :: vlen + character(len=*), intent(in), optional :: long_name + character(len=*), intent(in), optional :: units + character(len=*), intent(in), optional :: bounds_name + integer, intent(in), optional :: i_values(:) + real(r8), intent(in), optional :: r_values(:) + real(r8), intent(in), optional :: bounds(:,:) + character(len=*), intent(in), optional :: positive + character(len=*), intent(in), optional :: standard_name + type(formula_terms_t), intent(in), optional :: formula_terms + + ! Local variables + character(len=120) :: errormsg + integer :: i + + i = get_hist_coord_index(trim(name)) + ! If i > 0, this mdim has already been registered + if (i > 0) then + check_hist_coord_all = i + if (.not. check_hist_coord(hist_coords(i)%dimsize, vlen)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, '//trim(name)//' with incompatible size' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%long_name, long_name)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with a different long_name' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%units, units)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with different units' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%bounds_name, bounds_name)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with a different bounds_name' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%standard_name, standard_name)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with a different standard_name' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%positive, positive)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with a different value of positive' + call endrun(errormsg) + end if + ! Since the integer_dim defaults to .true., double check which to check + if ((.not. hist_coords(i)%integer_dim) .or. & + associated(hist_coords(i)%real_values)) then + if (.not. check_hist_coord(hist_coords(i)%real_values, r_values)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with different values' + call endrun(errormsg) + else if (present(i_values)) then + write(errormsg, *) 'ERROR: Attempt to register integer values for real dimension' + call endrun(errormsg) + end if + else + if (.not. check_hist_coord(hist_coords(i)%integer_values, i_values)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with different values' + call endrun(errormsg) + else if (present(i_values) .and. present(r_values)) then + write(errormsg, *) 'ERROR: Attempt to register real values for integer dimension' + call endrun(errormsg) + end if + end if + if (.not. check_hist_coord(hist_coords(i)%bounds, bounds)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with different bounds' + call endrun(errormsg) + end if + if (.not. check_hist_coord(hist_coords(i)%formula_terms, formula_terms)) then + write(errormsg, *) 'ERROR: Attempt to register dimension, ',trim(name),' with different formula_terms' + call endrun(errormsg) + end if + else + check_hist_coord_all = 0 + end if + end function check_hist_coord_all + + subroutine add_hist_coord_regonly(name, index) + + ! Input variable + character(len=*), intent(in) :: name + integer, optional, intent(out) :: index + + ! Local variables + character(len=120) :: errormsg + integer :: i + + if ((trim(name) == trim(horiz_only)) .or. (len_trim(name) == 0)) then + call endrun('ADD_HIST_COORD: '//trim(name)//' is not a valid coordinate name') + end if + i = get_hist_coord_index(trim(name)) + ! If i > 0, this mdim has already been registered + if (i <= 0) then + registeredmdims = registeredmdims + 1 + if (registeredmdims > maxmdims) then + call endrun('Too many dimensions in add_hist_coord.') + end if + if (len_trim(name) > max_hcoordname_len) then + write(errormsg,'(a,i3,a)') 'History coord name exceeds the ', & + max_hcoordname_len, ' character length limit' + call endrun(errormsg) + end if + hist_coords(registeredmdims)%name = trim(name) + hist_coords(registeredmdims)%dimsize = 0 + hist_coords(registeredmdims)%long_name = '' + hist_coords(registeredmdims)%units = '' + hist_coords(registeredmdims)%integer_dim = .true. + hist_coords(registeredmdims)%positive = '' + hist_coords(registeredmdims)%standard_name = '' + if (present(index)) then + index = registeredmdims + end if + else + if (present(index)) then + index = i + end if + end if + + end subroutine add_hist_coord_regonly + + subroutine add_hist_coord_int(name, vlen, long_name, units, values, & + positive, standard_name, dimname) + + ! Input variables + character(len=*), intent(in) :: name + integer, intent(in) :: vlen + character(len=*), intent(in) :: long_name + character(len=*), intent(in), optional :: units + integer, intent(in), target, optional :: values(:) + character(len=*), intent(in), optional :: positive + character(len=*), intent(in), optional :: standard_name + character(len=*), intent(in), optional :: dimname + + ! Local variables + integer :: i + + ! First, check to see if it is OK to add this coord + i = check_hist_coord(name, vlen=vlen, long_name=long_name, units=units, & + i_values=values, positive=positive, standard_name=standard_name) + ! Register the name if necessary + if (i == 0) then + call add_hist_coord(trim(name), i) + ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + end if + + ! Set the coord's values + hist_coords(i)%dimsize = vlen + if (len_trim(long_name) > max_chars) then + if(masterproc) then + write(iulog,*) 'WARNING: long_name for ',trim(name),' too long' + end if + end if + hist_coords(i)%long_name = trim(long_name) + if (present(units)) then + hist_coords(i)%units = trim(units) + else + hist_coords(i)%units = '' + end if + hist_coords(i)%integer_dim = .true. + if (present(values)) then + hist_coords(i)%integer_values => values + endif + if (present(positive)) then + hist_coords(i)%positive = trim(positive) + end if + if (present(standard_name)) then + hist_coords(i)%standard_name = trim(standard_name) + end if + hist_coords(i)%vertical_coord = .false. + if (present(dimname)) then + hist_coords(i)%dimname = trim(dimname) + else + hist_coords(i)%dimname = '' + end if + + end subroutine add_hist_coord_int + + subroutine add_hist_coord_r8(name, vlen, long_name, units, values, & + bounds_name, bounds, positive, standard_name, vertical_coord, dimname) + + ! Input variables + character(len=*), intent(in) :: name + integer, intent(in) :: vlen + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + real(r8), intent(in), target :: values(:) + character(len=*), intent(in), optional :: bounds_name + real(r8), intent(in), target, optional :: bounds(:,:) + character(len=*), intent(in), optional :: positive + character(len=*), intent(in), optional :: standard_name + logical, intent(in), optional :: vertical_coord + character(len=*), intent(in), optional :: dimname + + ! Local variables + character(len=120) :: errormsg + integer :: i + + ! First, check to see if it is OK to add this coord + i = check_hist_coord(name, vlen=vlen, long_name=long_name, units=units, & + r_values=values, positive=positive, standard_name=standard_name, & + bounds_name=bounds_name, bounds=bounds) + ! Register the name if necessary + if (i == 0) then + call add_hist_coord(trim(name), i) + ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + end if + + ! Set the coord's size + hist_coords(i)%dimsize = vlen + if (len_trim(long_name) > max_chars) then + if(masterproc) then + write(iulog,*) 'WARNING: long_name for ',trim(name),' too long' + end if + end if + hist_coords(i)%long_name = trim(long_name) + if (len_trim(units) > 0) then + hist_coords(i)%units = trim(units) + else + hist_coords(i)%units = '1' + end if + hist_coords(i)%integer_dim = .false. + hist_coords(i)%real_values => values + if (present(positive)) then + hist_coords(i)%positive = trim(positive) + end if + if (present(standard_name)) then + hist_coords(i)%standard_name = trim(standard_name) + end if + if (present(bounds_name)) then + hist_coords(i)%bounds_name = trim(bounds_name) + if (.not. present(bounds)) then + write(errormsg,*) 'bounds must be present for ',trim(bounds_name) + call endrun(errormsg) + end if + hist_coords(i)%bounds => bounds + else if (present(bounds)) then + write(errormsg,*) 'bounds_name must be present for bounds values' + call endrun(errormsg) + else + hist_coords(i)%bounds_name = '' + end if + if (present(vertical_coord)) then + hist_coords(i)%vertical_coord = vertical_coord + else + hist_coords(i)%vertical_coord = .false. + end if + if (present(dimname)) then + hist_coords(i)%dimname = trim(dimname) + else + hist_coords(i)%dimname = '' + end if + + end subroutine add_hist_coord_r8 + + subroutine add_vert_coord(name, vlen, long_name, units, values, & + positive, standard_name, formula_terms) + + ! Input variables + character(len=*), intent(in) :: name + integer, intent(in) :: vlen + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + real(r8), intent(in), target :: values(:) + character(len=*), intent(in), optional :: positive + character(len=*), intent(in), optional :: standard_name + type(formula_terms_t), intent(in), optional :: formula_terms + + ! Local variable + integer :: i + + ! First, check to see if it is OK to add this coord + i = check_hist_coord(name, vlen=vlen, long_name=long_name, units=units, & + r_values=values, positive=positive, standard_name=standard_name, & + formula_terms=formula_terms) + ! Register the name and hist_coord values if necessary + if (i == 0) then + call add_hist_coord(trim(name), vlen, long_name, units, values, & + positive=positive, standard_name=standard_name, & + vertical_coord=.true.) + i = get_hist_coord_index(trim(name)) + ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + end if + + if (present(formula_terms)) then + hist_coords(i)%formula_terms = formula_terms + end if + + end subroutine add_vert_coord + + subroutine write_hist_coord_attr(File, mdimind, boundsdim, dimonly, mdimid) + use pio, only: file_desc_t, var_desc_t, pio_put_att, pio_noerr, & + pio_int, pio_double, pio_inq_varid, pio_def_var + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + + ! Input variables + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, intent(in) :: mdimind ! Internal dim index + integer, intent(in) :: boundsdim ! Bounds dimension ID + logical, intent(in) :: dimonly ! No def_var if .true. + integer, optional, intent(out) :: mdimid + + ! Local variables + integer :: dimid ! PIO dimension ID + type(var_desc_t) :: vardesc ! PIO variable descriptor + character(len=120) :: errormsg + character(len=max_chars) :: formula_terms ! Constructed string + integer :: ierr + integer :: dtype + logical :: defvar ! True if var exists + + ! Create or check dimension for this coordinate + if (len_trim(hist_coords(mdimind)%dimname) > 0) then + ! Dim can already exist if different from coord name + call cam_pio_def_dim(File, trim(hist_coords(mdimind)%dimname), & + hist_coords(mdimind)%dimsize, dimid, & + existOK=(trim(hist_coords(mdimind)%dimname) /= & + trim(hist_coords(mdimind)%name))) + else + ! The dimension has the same name as the coord -- must be new dim + call cam_pio_def_dim(File, trim(hist_coords(mdimind)%name), & + hist_coords(mdimind)%dimsize, dimid, existOK=.false.) + end if + ! If the caller wants to know the NetCDF dimension ID, set it here + if (present(mdimid)) then + mdimid = dimid + end if + if (.not. dimonly) then + ! Time to define the variable (only if there are values) + if (hist_coords(mdimind)%integer_dim) then + dtype = pio_int + defvar = associated(hist_coords(mdimind)%integer_values) + else + dtype = pio_double + defvar = associated(hist_coords(mdimind)%real_values) + end if + if (defvar) then + call cam_pio_def_var(File, trim(hist_coords(mdimind)%name), dtype, & + (/dimid/), vardesc, existOK=.false.) + ! long_name + ierr=pio_put_att(File, vardesc, 'long_name', trim(hist_coords(mdimind)%long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_hist_coord_attr') + ! units + if(len_trim(hist_coords(mdimind)%units) > 0) then + ierr=pio_put_att(File, vardesc, 'units', & + trim(hist_coords(mdimind)%units)) + call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_hist_coord_attr') + end if + ! positive + if(len_trim(hist_coords(mdimind)%positive) > 0) then + ierr=pio_put_att(File, vardesc, 'positive', & + trim(hist_coords(mdimind)%positive)) + call cam_pio_handle_error(ierr, 'Error writing "positive" attr in write_hist_coord_attr') + end if + ! standard_name + if(len_trim(hist_coords(mdimind)%standard_name) > 0) then + ierr=pio_put_att(File, vardesc, 'standard_name', & + trim(hist_coords(mdimind)%standard_name)) + call cam_pio_handle_error(ierr, 'Error writing "standard_name" attr in write_hist_coord_attr') + end if + ! formula_terms + if(len_trim(hist_coords(mdimind)%formula_terms%a_name) > 0) then + write(formula_terms, '("a: ",a," b: ",a," p0: ",a," ps: ",a)') & + trim(hist_coords(mdimind)%formula_terms%a_name), & + trim(hist_coords(mdimind)%formula_terms%b_name), & + trim(hist_coords(mdimind)%formula_terms%p0_name), & + trim(hist_coords(mdimind)%formula_terms%ps_name) + ierr=pio_put_att(File, vardesc, 'formula_terms', trim(formula_terms)) + call cam_pio_handle_error(ierr, 'Error writing "formula_terms" attr in write_hist_coord_attr') + end if + ! bounds + if (associated(hist_coords(mdimind)%bounds)) then + ! Write name of the bounds variable + ierr=pio_put_att(File, vardesc, 'bounds', trim(hist_coords(mdimind)%bounds_name)) + call cam_pio_handle_error(ierr, 'Error writing "bounds" attr in write_hist_coord_attr') + end if + end if + + ! Now, we need to define and populate the associated bounds variable + ! NB: Reusing vardesc, no longer assocated with main variable + if (associated(hist_coords(mdimind)%bounds)) then + if (size(hist_coords(mdimind)%bounds,2) /= hist_coords(mdimind)%dimsize) then + ! If anyone hits this check, add a new dimension for this case + write(errormsg, *) 'The bounds variable, ', & + trim(hist_coords(mdimind)%bounds_name), & + ', needs to have dimension (2,', hist_coords(mdimind)%dimsize + call endrun(errormsg) + end if + call cam_pio_def_var(File, trim(hist_coords(mdimind)%bounds_name), & + pio_double, (/boundsdim,dimid/), vardesc, existOK=.false.) + end if + + ! See if we have formula_terms variables to define + ! Define the "a" variable name + ! NB: Reusing vardesc, no longer assocated with previous variables + if (associated(hist_coords(mdimind)%formula_terms%a_values)) then + if (size(hist_coords(mdimind)%formula_terms%a_values) /= hist_coords(mdimind)%dimsize) then + write(errormsg, *) 'The forumla_terms variable, ', & + trim(hist_coords(mdimind)%formula_terms%a_name), & + ', needs to have dimension', hist_coords(mdimind)%dimsize + call endrun(errormsg) + end if + call cam_pio_def_var(File, trim(hist_coords(mdimind)%formula_terms%a_name), & + pio_double, (/dimid/), vardesc, existOK=.false.) + ierr = pio_put_att(File, vardesc, 'long_name', trim(hist_coords(mdimind)%formula_terms%a_long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr for "a" formula_term in write_hist_coord_attr') + end if + ! Define the "b" variable name + ! NB: Reusing vardesc, no longer assocated with previous variables + if (associated(hist_coords(mdimind)%formula_terms%b_values)) then + if (size(hist_coords(mdimind)%formula_terms%b_values) /= hist_coords(mdimind)%dimsize) then + write(errormsg, *) 'The forumla_terms variable, ', & + trim(hist_coords(mdimind)%formula_terms%b_name), & + ', needs to have dimension', hist_coords(mdimind)%dimsize + call endrun(errormsg) + end if + call cam_pio_def_var(File, trim(hist_coords(mdimind)%formula_terms%b_name), & + pio_double, (/dimid/), vardesc, existOK=.false.) + ierr = pio_put_att(File, vardesc, 'long_name', trim(hist_coords(mdimind)%formula_terms%b_long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr for "b" formula_term in write_hist_coord_attr') + end if + ! Maybe define the p0 variable (this may be defined already which is OK) + ! NB: Reusing vardesc, no longer assocated with previous variables + if (hist_coords(mdimind)%formula_terms%p0_value /= fillvalue) then + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%formula_terms%p0_name), vardesc) + if (ierr /= PIO_NOERR) then + ierr = pio_def_var(File, trim(hist_coords(mdimind)%formula_terms%p0_name), & + pio_double, vardesc) + call cam_pio_handle_error(ierr, 'Unable to define "p0" formula_terms variable in write_hist_coord_attr') + ierr = pio_put_att(File, vardesc, 'long_name', trim(hist_coords(mdimind)%formula_terms%p0_long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr for "p0" formula_term in write_hist_coord_attr') + ierr = pio_put_att(File, vardesc, 'units', trim(hist_coords(mdimind)%formula_terms%p0_units)) + call cam_pio_handle_error(ierr, 'Error writing "units" attr for "p0" formula_term in write_hist_coord_attr') + end if + end if + ! PS is not our responsibility + end if ! (.not. dimonly) + + end subroutine write_hist_coord_attr + + !--------------------------------------------------------------------------- + ! + ! write_hist_coord_attrs + ! + ! Write the dimension and coordinate attributes for the defined history + ! coordinates. + ! + !--------------------------------------------------------------------------- + subroutine write_hist_coord_attrs(File, boundsdim, mdimids, writemdims_in) + use pio, only: file_desc_t, var_desc_t, pio_put_att, & + pio_bcast_error, pio_internal_error, pio_seterrorhandling, & + pio_char + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + + ! Input variables + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, intent(in) :: boundsdim ! Bounds dimension ID + integer, optional, allocatable, intent(out) :: mdimids(:) ! NetCDF dim IDs + logical, optional, intent(in) :: writemdims_in ! Write mdim variable + + ! Local variables + integer :: i + integer :: ierr + integer :: dimids(2) ! PIO dimension IDs + logical :: writemdims ! Define an mdim variable + type(var_desc_t) :: vardesc ! PIO variable descriptor + + if (present(mdimids)) then + allocate(mdimids(registeredmdims)) + end if + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + + if (present(writemdims_in)) then + writemdims = writemdims_in + else + writemdims = .false. + end if + + ! NB: Currently, writemdims is for restart and we don't need to write + ! these out in a history-restart file. This could change in the future. + ! which would require a change to the function of the fourth argument + ! Fill in the attribute information for each mdim + do i = 1, registeredmdims + if (present(mdimids)) then + call write_hist_coord_attr(File, i, boundsdim, writemdims, mdimids(i)) + else + call write_hist_coord_attr(File, i, boundsdim, writemdims) + end if + end do + + if (writemdims) then + call cam_pio_def_dim(File, 'mdimslen', max_hcoordname_len, dimids(1), & + existOK=.true.) + call cam_pio_def_dim(File, 'num_mdims', registeredmdims, dimids(2), & + existOK=.true.) + call cam_pio_def_var(File, mdim_var_name, pio_char, dimids, vardesc, & + existOK=.false.) + ierr = pio_put_att(File, vardesc, 'long_name', 'mdim dimension names') + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr for mdimnames in write_hist_coord_attrs') + + end if + + ! Back to I/O or die trying + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + end subroutine write_hist_coord_attrs + + subroutine write_hist_coord_var(File, mdimind) + use pio, only: file_desc_t, var_desc_t, pio_put_var, pio_inq_varid + + ! Input variables + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, intent(in) :: mdimind ! Internal dim index + + ! Local variables + type(var_desc_t) :: vardesc ! PIO variable descriptor + integer :: ierr + + if ((hist_coords(mdimind)%integer_dim .and. & + associated(hist_coords(mdimind)%integer_values)) .or. & + ((.not. hist_coords(mdimind)%integer_dim) .and. & + associated(hist_coords(mdimind)%real_values))) then + ! Check to make sure the variable already exists in the file + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%name), vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent dimension variable write_hist_coord_var') + ! Write out the values for this dimension variable + if (hist_coords(mdimind)%integer_dim) then + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%integer_values) + else + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%real_values) + end if + call cam_pio_handle_error(ierr, 'Error writing variable values in write_hist_coord_var') + end if + + ! Now, we need to possibly write values for the associated bounds variable + if (associated(hist_coords(mdimind)%bounds)) then + ! Check to make sure the variable already exists in the file + ! NB: Reusing vardesc, no longer assocated with previous variables + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%bounds_name), vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent bounds variable write_hist_coord_var') + ! Write out the values for this bounds variable + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%bounds) + call cam_pio_handle_error(ierr, 'Error writing bounds values in write_hist_coord_var') + end if + + ! Write values for the "a" variable name + if (associated(hist_coords(mdimind)%formula_terms%a_values)) then + ! Check to make sure the variable already exists in the file + ! NB: Reusing vardesc, no longer assocated with previous variables + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%formula_terms%a_name), vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent "a" formula_terms variable write_hist_coord_var') + ! Write out the values for this "a" formula_terms variable + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%formula_terms%a_values) + call cam_pio_handle_error(ierr, 'Error writing "a" formula_terms values in write_hist_coord_var') + end if + ! Write values for the "b" variable name + if (associated(hist_coords(mdimind)%formula_terms%b_values)) then + ! Check to make sure the variable already exists in the file + ! NB: Reusing vardesc, no longer assocated with previous variables + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%formula_terms%b_name), vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent "b" formula_terms variable write_hist_coord_var') + ! Write out the values for this "b" formula_terms variable + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%formula_terms%b_values) + call cam_pio_handle_error(ierr, 'Error writing "b" formula_terms values in write_hist_coord_var') + end if + ! Write values for the "p0" variable name (this may be an overwrite, too bad) + if (hist_coords(mdimind)%formula_terms%p0_value /= fillvalue) then + ! Check to make sure the variable already exists in the file + ! NB: Reusing vardesc, no longer assocated with previous variables + ierr = pio_inq_varid(File, trim(hist_coords(mdimind)%formula_terms%p0_name), vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent "p0" formula_terms variable write_hist_coord_var') + ! Write out the values for this "p0" formula_terms variable + ierr = pio_put_var(File, vardesc, hist_coords(mdimind)%formula_terms%p0_value) + call cam_pio_handle_error(ierr, 'Error writing "p0" formula_terms values in write_hist_coord_var') + end if + + end subroutine write_hist_coord_var + + subroutine write_hist_coord_vars(File, writemdims_in) + use pio, only: file_desc_t, var_desc_t, pio_put_var, & + pio_bcast_error, pio_internal_error, & + pio_seterrorhandling, pio_inq_varid + + ! Input variables + type(file_desc_t), intent(inout) :: File ! PIO file Handle + logical, optional, intent(in) :: writemdims_in ! Write mdim variable + + ! Local variables + integer :: i + integer :: ierr + logical :: writemdims ! Define an mdim variable + type(var_desc_t) :: vardesc ! PIO variable descriptor + character(len=max_hcoordname_len), allocatable :: mdimnames(:) + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + + if (present(writemdims_in)) then + writemdims = writemdims_in + else + writemdims = .false. + end if + + if (writemdims) then + allocate(mdimnames(registeredmdims)) + end if + + ! Write out the variable values for each mdim + do i = 1, registeredmdims + if (.not. writemdims) then + ! NB: Currently, writemdims is for restart and we don't need to write + ! these out in a history-restart file. This could change in the future + ! which is why it is a separate if block + ! Fill in the attribute information for each mdim + call write_hist_coord_var(File, i) + end if + if (writemdims) then + mdimnames(i) = trim(hist_coords(i)%name) + end if + end do + + if (writemdims) then + ierr = pio_inq_varid(File, mdim_var_name, vardesc) + call cam_pio_handle_error(ierr, 'Error writing values for nonexistent mdimnames variable in write_hist_coord_vars') + ! Write out the values for mdim names + ierr = pio_put_var(File, vardesc, mdimnames) + call cam_pio_handle_error(ierr, 'Error writing values for mdimnames variable in write_hist_coord_vars') + deallocate(mdimnames) + end if + + ! Back to I/O or die trying + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + end subroutine write_hist_coord_vars + + subroutine lookup_hist_coord_indices(mdimnames, mdimindicies) + ! Dummy arguments + character(len=*), intent(in) :: mdimnames(:) + integer, intent(out) :: mdimindicies(:) + + ! Local variables + integer :: i, j + integer :: cnt + character(len=120) :: errormsg + character(len=16) :: name + + + cnt = size(mdimnames) + mdimindicies = -1 + + + do j=1,cnt + name = mdimnames(j) + do i = 1, registeredmdims + if(name .eq. hist_coords(i)%name) then + mdimindicies(j)=i + end if + end do + end do + do j = 1, cnt + if(mdimindicies(j) < 0) then + do i = 1, registeredmdims + print *,__FILE__,__LINE__,i,hist_coords(i)%name + end do + write(errormsg,*) 'Name ',mdimnames(j),' is not a registered history coordinate' + call endrun(errormsg) + end if + end do + + end subroutine lookup_hist_coord_indices + + ! Find the vertical dimension (if present) in dimnames and return its size + ! (which is the number of levels). Return -1 if not found + ! If dimnames is not present, search all of the registered history coords + integer function hist_coord_find_levels(dimnames) result(levels) + ! Dummy argument + character(len=*), optional, intent(in) :: dimnames(:) + + ! Local variables + integer i, index, dimcnt + + levels = -1 ! Error return value + + if (present(dimnames)) then + dimcnt = size(dimnames) + else + dimcnt = registeredmdims + end if + + do i = 1, dimcnt + if (present(dimnames)) then + index = get_hist_coord_index(trim(dimnames(i))) + if (i < 0) then + call endrun('hist_coord_find_levels: '//trim(dimnames(i))//' is not a registred history coordinate') + end if + else + index = i ! Just cycle through all the registered mdims + end if + + if (hist_coords(index)%vertical_coord) then + levels = hist_coords(index)%dimsize + exit + end if + end do + + end function hist_coord_find_levels + + !####################################################################### + + character(len=8) function sec2hms (seconds) + + ! Input arguments + + integer, intent(in) :: seconds + + ! Local workspace + + integer :: hours ! hours of hh:mm:ss + integer :: minutes ! minutes of hh:mm:ss + integer :: secs ! seconds of hh:mm:ss + + if (seconds < 0 .or. seconds > 86400) then + write(iulog,*)'SEC2HRS: bad input seconds:', seconds + call endrun () + end if + + hours = seconds / 3600 + minutes = (seconds - hours*3600) / 60 + secs = (seconds - hours*3600 - minutes*60) + + if (minutes < 0 .or. minutes > 60) then + write(iulog,*)'SEC2HRS: bad minutes = ',minutes + call endrun () + end if + + if (secs < 0 .or. secs > 60) then + write(iulog,*)'SEC2HRS: bad secs = ',secs + call endrun () + end if + + write(sec2hms,80) hours, minutes, secs +80 format(i2.2,':',i2.2,':',i2.2) + return + end function sec2hms + character(len=10) function date2yyyymmdd (date) + + ! Input arguments + + integer, intent(in) :: date + + ! Local workspace + + integer :: year ! year of yyyy-mm-dd + integer :: month ! month of yyyy-mm-dd + integer :: day ! day of yyyy-mm-dd + + if (date < 0) then + call endrun ('DATE2YYYYMMDD: negative date not allowed') + end if + + year = date / 10000 + month = (date - year*10000) / 100 + day = date - year*10000 - month*100 + + write(date2yyyymmdd,80) year, month, day +80 format(i4.4,'-',i2.2,'-',i2.2) + return + end function date2yyyymmdd + + !####################################################################### + + +end module cam_history_support diff --git a/src/control/cam_initfiles.F90 b/src/control/cam_initfiles.F90 new file mode 100644 index 0000000000..e2ed25d353 --- /dev/null +++ b/src/control/cam_initfiles.F90 @@ -0,0 +1,307 @@ +module cam_initfiles +!--------------------------------------------------------------------------------------- +! +! Open, close, and provide access to the initial, topography, and primary restart files. +! +!--------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl +use spmd_utils, only: masterproc +use cam_control_mod, only: initial_run, restart_run, branch_run, caseid, brnch_retain_casename +use ioFileMod, only: getfil, opnfil +use cam_pio_utils, only: cam_pio_openfile +use pio, only: file_desc_t, pio_offset_kind, pio_global, & + pio_inq_att, pio_get_att, pio_nowrite, & + pio_closefile +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +! Public methods + +public :: & + cam_initfiles_readnl, &! read namelist + cam_initfiles_open, &! open initial and topo files + initial_file_get_id, &! returns filehandle for initial file + topo_file_get_id, &! returns filehandle for topo file + cam_initfiles_get_caseid, &! return caseid from initial restart file + cam_initfiles_get_restdir, &! return caseid from initial restart file + cam_initfiles_close ! close initial and topo files + +! Namelist inputs +logical :: use_topo_file = .true. +character(len=cl), public, protected :: ncdata = 'ncdata' ! full pathname for initial dataset +character(len=cl), public, protected :: bnd_topo = 'bnd_topo' ! full pathname for topography dataset + +real(r8), public, protected :: pertlim = 0.0_r8 ! maximum abs value of scale factor used to perturb + ! initial values +character(len=cl) :: cam_branch_file = ' ' ! Filepath of primary restart file for a branch run + +! The restart pointer file contains name of most recently written primary restart file. +! The contents of this file are updated by cam_write_restart as new restart files are written. +character(len=cl), public, protected :: rest_pfile + +! Filename for initial restart file. +character(len=cl) :: restart_file = ' ' + +! case name read from initial restart file. This case name matches the caseid +! which is embedded in the filename. +character(len=cl) :: caseid_prev = ' ' + +type(file_desc_t), pointer :: fh_ini => null() +type(file_desc_t), pointer :: fh_topo => null() +type(file_desc_t), target :: fh_restart + +!======================================================================================== +contains +!======================================================================================== + +subroutine cam_initfiles_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpir8=>mpi_real8, & + mpichar=>mpi_character, mpi_logical + use cam_instance, only: inst_suffix + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + character(len=cl) :: locfn + logical :: filefound + integer :: xtype + integer(pio_offset_kind) :: slen + + character(len=*), parameter :: sub = 'cam_initfiles_readnl' + + namelist /cam_initfiles_nl/ ncdata, use_topo_file, bnd_topo, pertlim, & + cam_branch_file + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cam_initfiles_nl', status=ierr) + if (ierr == 0) then + read(unitn, cam_initfiles_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ': ERROR: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(ncdata, len(ncdata), mpichar, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: ncdata") + call mpi_bcast(use_topo_file, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: use_topo_file") + call mpi_bcast(bnd_topo, len(bnd_topo), mpichar, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: bnd_topo") + call mpi_bcast(pertlim, 1, mpir8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: pertlim") + call mpi_bcast(cam_branch_file, len(cam_branch_file), mpichar, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: cam_branch_file") + + ! Set pointer file name based on instance suffix + rest_pfile = './rpointer.atm' // trim(inst_suffix) + + ! Set name of primary restart file + if (restart_run) then + ! Read name of restart file from pointer file + if (masterproc) then + unitn = getunit() + call opnfil(rest_pfile, unitn, 'f', status="old") + read (unitn, '(a)', iostat=ierr) restart_file + if (ierr /= 0) then + call endrun(sub // ': ERROR: reading rpointer file') + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(restart_file, len(restart_file), mpichar, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: restart_file") + + else if (branch_run) then + ! use namelist input + restart_file = trim(cam_branch_file) + end if + + ! Get caseid from restart or branch file. + if (restart_run .or. branch_run) then + + call getfil(restart_file, locfn) + inquire(file=trim(locfn), exist=filefound) + if (.not.filefound) then + call endrun(sub//': ERROR: could not find restart file '//trim(locfn)) + end if + + call cam_pio_openfile(fh_restart, trim(locfn), pio_nowrite) + + ierr = pio_inq_att(fh_restart, pio_global, 'caseid', xtype, slen) + ierr = pio_get_att(fh_restart, pio_global, 'caseid', caseid_prev) + caseid_prev(slen+1:len(caseid_prev)) = ' ' + + if (branch_run .and. caseid_prev==caseid .and. .not.brnch_retain_casename) then + write(iulog,*) sub//': Must change case name on branch run' + write(iulog,*) 'Prev case = ',caseid_prev,' current case = ',caseid + call endrun(sub//': ERROR: Must change case name on branch run') + end if + end if + + if (masterproc) then + write(iulog,*) sub//' options:' + + if (initial_run) then + + write(iulog,*)' Initial run will start from: ', trim(ncdata) + + if (use_topo_file) then + write(iulog,*) ' Topography dataset is: ', trim(bnd_topo) + else + write(iulog,*) ' Topography dataset not used: PHIS, SGH, SGH30, LANDM_COSLAT set to zero' + end if + + else if (restart_run) then + write(iulog,*)' Continuation of case: ', trim(caseid_prev) + write(iulog,*)' Restart run will start from file: ', trim(restart_file) + else if (branch_run) then + write(iulog,*)' Continuation of case: ', trim(caseid_prev) + write(iulog,*)' Branch run will start from file: ', trim(restart_file) + end if + + write(iulog,*) & + ' Maximum abs value of scale factor used to perturb initial conditions, pertlim= ', pertlim + +#ifdef PERGRO + write(iulog,*)' The PERGRO CPP token is defined.' +#endif + + end if + +end subroutine cam_initfiles_readnl + +!======================================================================= + +subroutine cam_initfiles_open() + + ! Open the initial conditions and topography files. + + character(len=256) :: ncdata_loc ! filepath of initial file on local disk + character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + !----------------------------------------------------------------------- + + ! Open initial dataset + + if (initial_run) then + + call getfil(ncdata, ncdata_loc) + allocate(fh_ini) + call cam_pio_openfile(fh_ini, ncdata_loc, pio_nowrite) + + else + fh_ini => fh_restart + end if + + ! Open topography dataset if used. + + if (use_topo_file) then + + if (trim(bnd_topo) /= 'bnd_topo' .and. len_trim(bnd_topo) > 0) then + allocate(fh_topo) + call getfil(bnd_topo, bnd_topo_loc) + call cam_pio_openfile(fh_topo, bnd_topo_loc, pio_nowrite) + else + ! Allow topography data to be read from the initial file if topo file name + ! is not provided. + fh_topo => fh_ini + end if + else + nullify(fh_topo) + end if + +end subroutine cam_initfiles_open + +!======================================================================= + +function initial_file_get_id() + type(file_desc_t), pointer :: initial_file_get_id + initial_file_get_id => fh_ini +end function initial_file_get_id + +!======================================================================= + +function topo_file_get_id() + type(file_desc_t), pointer :: topo_file_get_id + topo_file_get_id => fh_topo +end function topo_file_get_id + +!======================================================================= + +subroutine cam_initfiles_close() + + if (associated(fh_ini)) then + + if (associated(fh_topo)) then + + if (.not. associated(fh_ini, target=fh_topo)) then + ! if fh_ini and fh_topo point to different objects then close fh_topo + call pio_closefile(fh_topo) + deallocate(fh_topo) + end if + ! if fh_topo is associated, but points to the same object as fh_ini + ! then it just needs to be nullified. + nullify(fh_topo) + end if + + call pio_closefile(fh_ini) + deallocate(fh_ini) + nullify(fh_ini) + + end if +end subroutine cam_initfiles_close + +!======================================================================= + +character(len=cl) function cam_initfiles_get_caseid() + + ! Return the caseid of the previous case (i.e., the one read from the restart file) + + character(len=*), parameter :: sub = 'cam_initfiles_get_caseid' + !--------------------------------------------------------------------------- + + if (initial_run) then + call endrun (sub//': ERROR: caseid not read from restart file?') + end if + cam_initfiles_get_caseid = caseid_prev + +end function cam_initfiles_get_caseid + +!======================================================================= + +character(len=cl) function cam_initfiles_get_restdir() + + ! Return directory containing initial restart file + + use filenames, only: get_dir + + character(len=*), parameter :: sub = 'cam_initfiles_get_restdir' + !--------------------------------------------------------------------------- + + if (initial_run) then + call endrun (sub//': ERROR: No restart file available') + end if + + cam_initfiles_get_restdir = get_dir(restart_file) + +end function cam_initfiles_get_restdir + +!========================================================================================= + +end module cam_initfiles diff --git a/src/control/cam_instance.F90 b/src/control/cam_instance.F90 new file mode 100644 index 0000000000..35289032f1 --- /dev/null +++ b/src/control/cam_instance.F90 @@ -0,0 +1,31 @@ +module cam_instance + +use seq_comm_mct, only: seq_comm_suffix, seq_comm_inst, seq_comm_name + +implicit none +private +save + +public :: cam_instance_init + +integer, public :: atm_id +integer, public :: inst_index +character(len=16), public :: inst_name +character(len=16), public :: inst_suffix + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine cam_instance_init(in_atm_id) + + integer, intent(in) :: in_atm_id + + atm_id = in_atm_id + inst_name = seq_comm_name(atm_id) + inst_index = seq_comm_inst(atm_id) + inst_suffix = seq_comm_suffix(atm_id) + +end subroutine cam_instance_init + +end module cam_instance diff --git a/src/control/cam_logfile.F90 b/src/control/cam_logfile.F90 new file mode 100644 index 0000000000..ee50d885f5 --- /dev/null +++ b/src/control/cam_logfile.F90 @@ -0,0 +1,37 @@ + +module cam_logfile + +!----------------------------------------------------------------------- +! +! Purpose: This module is responsible for managing the logical unit +! of CAM's output log +! +! Author: mvr, Sep 2007 +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!- use statements ------------------------------------------------------ +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Public data ---------------------------------------------------------- +!----------------------------------------------------------------------- + integer :: iulog = 6 + +!----------------------------------------------------------------------- +! Private data --------------------------------------------------------- +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Subroutines and functions -------------------------------------------- +!----------------------------------------------------------------------- + +end module cam_logfile + diff --git a/src/control/cam_restart.F90 b/src/control/cam_restart.F90 new file mode 100644 index 0000000000..4aefd92c68 --- /dev/null +++ b/src/control/cam_restart.F90 @@ -0,0 +1,186 @@ +module cam_restart + +! Coordinate reading and writing of restart files. + +use shr_kind_mod, only: cl=>shr_kind_cl +use spmd_utils, only: masterproc +use cam_control_mod, only: restart_run, caseid +use ioFileMod, only: opnfil +use camsrfexch, only: cam_in_t, cam_out_t +use dyn_comp, only: dyn_import_t, dyn_export_t +use physics_buffer, only: physics_buffer_desc +use units, only: getunit, freeunit +use pio, only: file_desc_t, pio_global, pio_enddef, & + pio_put_att, pio_closefile + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use ionosphere_interface, only: ionosphere_init_restart, ionosphere_write_restart, ionosphere_read_restart + +implicit none +private +save + +public :: & + cam_write_restart, & ! Driver for writing restart files + cam_read_restart ! Driver for reading restart files + +!========================================================================================= +contains +!========================================================================================= + +subroutine cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, & + stop_ymd, stop_tod) + + use cam_initfiles, only: initial_file_get_id + use restart_dynamics, only: read_restart_dynamics + use restart_physics, only: read_restart_physics + use camsrfexch, only: atm2hub_alloc, hub2atm_alloc + use cam_history, only: read_restart_history + use cam_pio_utils, only: clean_iodesc_list + + ! Arguments + type(cam_in_t), pointer :: cam_in(:) + type(cam_out_t), pointer :: cam_out(:) + type(dyn_import_t), intent(inout) :: dyn_in + type(dyn_export_t), intent(inout) :: dyn_out + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: stop_ymd ! Stop date (YYYYMMDD) + integer, intent(in) :: stop_tod ! Stop time of day (sec) + + ! Local workspace + type(file_desc_t), pointer :: fh_ini + + character(len=*), parameter :: sub = 'cam_read_restart' + !--------------------------------------------------------------------------- + + ! get filehandle pointer to primary restart file + fh_ini => initial_file_get_id() + + call read_restart_dynamics(fh_ini, dyn_in, dyn_out) + call ionosphere_read_restart(fh_ini) + + call hub2atm_alloc(cam_in) + call atm2hub_alloc(cam_out) + + call read_restart_physics(fh_ini, cam_in, cam_out, pbuf2d) + + if (restart_run) then + call read_restart_history (fh_ini) + end if + + call clean_iodesc_list() + +end subroutine cam_read_restart + +!========================================================================================= + +subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & + yr_spec, mon_spec, day_spec, sec_spec ) + + use filenames, only: interpret_filename_spec + use cam_pio_utils, only: cam_pio_createfile + use restart_dynamics, only: write_restart_dynamics, init_restart_dynamics + use restart_physics, only: write_restart_physics, init_restart_physics + use cam_history, only: write_restart_history, init_restart_history + use cam_instance, only: inst_suffix + + ! Arguments + type(cam_in_t), intent(in) :: cam_in(:) + type(cam_out_t), intent(in) :: cam_out(:) + type(dyn_export_t), intent(in) :: dyn_out + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, optional, intent(in) :: yr_spec ! Simulation year + integer, optional, intent(in) :: mon_spec ! Simulation month + integer, optional, intent(in) :: day_spec ! Simulation day + integer, optional, intent(in) :: sec_spec ! Seconds into current simulation day + + ! Local workspace + character(len=cl) :: rfilename_spec ! filename specifier for primary restart file + character(len=cl) :: fname ! Restart filename + type(file_desc_t) :: fh + integer :: ierr + !----------------------------------------------------------------------- + + ! Set template for primary restart filename based on instance suffix + ! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = number) + rfilename_spec = '%c.cam' // trim(inst_suffix) //'.r.%y-%m-%d-%s.nc' + + if (present(yr_spec).and.present(mon_spec).and.present(day_spec).and.present(sec_spec)) then + fname = interpret_filename_spec( rfilename_spec, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + else + fname = interpret_filename_spec( rfilename_spec ) + end if + + call cam_pio_createfile(fh, trim(fname), 0) + + call init_restart_dynamics(fh, dyn_out) + call ionosphere_init_restart(fh) + call init_restart_physics(fh, pbuf2d) + call init_restart_history(fh) + + ierr = pio_put_att(fh, pio_global, 'caseid', caseid) + + ierr = pio_enddef(fh) + + !----------------------------------------------------------------------- + ! Dynamics, physics, History + !----------------------------------------------------------------------- + + call write_restart_dynamics(fh, dyn_out) + call ionosphere_write_restart(fh) + call write_restart_physics(fh, cam_in, cam_out, pbuf2d) + + if (present(yr_spec).and.present(mon_spec).and.& + present(day_spec).and.present(sec_spec)) then + call write_restart_history(fh, yr_spec=yr_spec, mon_spec=mon_spec, & + day_spec=day_spec, sec_spec= sec_spec ) + else + call write_restart_history(fh) + end if + + ! Close the primary restart file + call pio_closefile(fh) + + ! Update the restart pointer file + call write_rest_pfile(fname) + +end subroutine cam_write_restart + +!======================================================================================== + +subroutine write_rest_pfile(restart_file) + + ! Write the restart pointer file + + use cam_initfiles, only: rest_pfile + + character(len=*), intent(in) :: restart_file + + integer :: nsds, ierr + character(len=*), parameter :: sub='write_rest_pfile' + !--------------------------------------------------------------------------- + + if (masterproc) then + + nsds = getunit() + call opnfil(rest_pfile, nsds, 'f') + rewind nsds + write(nsds, '(a)', iostat=ierr) trim(restart_file) + if (ierr /= 0) then + call endrun(sub//': ERROR: writing rpointer file') + end if + close(nsds) + call freeunit(nsds) + + write(iulog,*)'(WRITE_REST_PFILE): successfully wrote local restart pointer file ',& + trim(rest_pfile) + write(iulog,'("---------------------------------------")') + end if + +end subroutine write_rest_pfile + +!======================================================================================== + +end module cam_restart diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 new file mode 100644 index 0000000000..f2862fad71 --- /dev/null +++ b/src/control/camsrfexch.F90 @@ -0,0 +1,579 @@ +module camsrfexch +!----------------------------------------------------------------------- +! +! Module to handle data that is exchanged between the CAM atmosphere +! model and the surface models (land, sea-ice, and ocean). +! +!----------------------------------------------------------------------- +! +! USES: +! + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use constituents, only: pcnst + use ppgrid, only: pcols, begchunk, endchunk + use phys_grid, only: get_ncols_p, phys_grid_initialized + use infnan, only: posinf, assignment(=) + use cam_abortutils,only: endrun + use cam_logfile, only: iulog + + implicit none + +!----------------------------------------------------------------------- +! PRIVATE: Make default data and interfaces private +!----------------------------------------------------------------------- + private ! By default all data is private to this module +! +! Public interfaces +! + public atm2hub_alloc ! Atmosphere to surface data allocation method + public hub2atm_alloc ! Merged hub surface to atmosphere data allocation method + public atm2hub_deallocate + public hub2atm_deallocate + public cam_export +! +! Public data types +! + public cam_out_t ! Data from atmosphere + public cam_in_t ! Merged surface data + +!--------------------------------------------------------------------------- +! This is the data that is sent from the atmosphere to the surface models +!--------------------------------------------------------------------------- + + type cam_out_t + integer :: lchnk ! chunk index + integer :: ncol ! number of columns in chunk + real(r8) :: tbot(pcols) ! bot level temperature + real(r8) :: zbot(pcols) ! bot level height above surface + real(r8) :: topo(pcols) ! surface topographic height (m) + real(r8) :: ubot(pcols) ! bot level u wind + real(r8) :: vbot(pcols) ! bot level v wind + real(r8) :: qbot(pcols,pcnst) ! bot level specific humidity + real(r8) :: pbot(pcols) ! bot level pressure + real(r8) :: rho(pcols) ! bot level density + real(r8) :: netsw(pcols) ! + real(r8) :: flwds(pcols) ! + real(r8) :: precsc(pcols) ! + real(r8) :: precsl(pcols) ! + real(r8) :: precc(pcols) ! + real(r8) :: precl(pcols) ! + real(r8) :: soll(pcols) ! + real(r8) :: sols(pcols) ! + real(r8) :: solld(pcols) ! + real(r8) :: solsd(pcols) ! + real(r8) :: thbot(pcols) ! + real(r8) :: co2prog(pcols) ! prognostic co2 + real(r8) :: co2diag(pcols) ! diagnostic co2 + real(r8) :: psl(pcols) + real(r8) :: bcphiwet(pcols) ! wet deposition of hydrophilic black carbon + real(r8) :: bcphidry(pcols) ! dry deposition of hydrophilic black carbon + real(r8) :: bcphodry(pcols) ! dry deposition of hydrophobic black carbon + real(r8) :: ocphiwet(pcols) ! wet deposition of hydrophilic organic carbon + real(r8) :: ocphidry(pcols) ! dry deposition of hydrophilic organic carbon + real(r8) :: ocphodry(pcols) ! dry deposition of hydrophobic organic carbon + real(r8) :: dstwet1(pcols) ! wet deposition of dust (bin1) + real(r8) :: dstdry1(pcols) ! dry deposition of dust (bin1) + real(r8) :: dstwet2(pcols) ! wet deposition of dust (bin2) + real(r8) :: dstdry2(pcols) ! dry deposition of dust (bin2) + real(r8) :: dstwet3(pcols) ! wet deposition of dust (bin3) + real(r8) :: dstdry3(pcols) ! dry deposition of dust (bin3) + real(r8) :: dstwet4(pcols) ! wet deposition of dust (bin4) + real(r8) :: dstdry4(pcols) ! dry deposition of dust (bin4) + real(r8), pointer, dimension(:) :: nhx_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s) + real(r8), pointer, dimension(:) :: noy_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s) + end type cam_out_t + +!--------------------------------------------------------------------------- +! This is the merged state of sea-ice, land and ocean surface parameterizations +!--------------------------------------------------------------------------- + + type cam_in_t + integer :: lchnk ! chunk index + integer :: ncol ! number of active columns + real(r8) :: asdir(pcols) ! albedo: shortwave, direct + real(r8) :: asdif(pcols) ! albedo: shortwave, diffuse + real(r8) :: aldir(pcols) ! albedo: longwave, direct + real(r8) :: aldif(pcols) ! albedo: longwave, diffuse + real(r8) :: lwup(pcols) ! longwave up radiative flux + real(r8) :: lhf(pcols) ! latent heat flux + real(r8) :: shf(pcols) ! sensible heat flux + real(r8) :: wsx(pcols) ! surface u-stress (N) + real(r8) :: wsy(pcols) ! surface v-stress (N) + real(r8) :: tref(pcols) ! ref height surface air temp + real(r8) :: qref(pcols) ! ref height specific humidity + real(r8) :: u10(pcols) ! 10m wind speed + real(r8) :: ts(pcols) ! merged surface temp + real(r8) :: sst(pcols) ! sea surface temp + real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land + real(r8) :: snowhice(pcols) ! snow depth over ice + real(r8) :: fco2_lnd(pcols) ! co2 flux from lnd + real(r8) :: fco2_ocn(pcols) ! co2 flux from ocn + real(r8) :: fdms(pcols) ! dms flux + real(r8) :: landfrac(pcols) ! land area fraction + real(r8) :: icefrac(pcols) ! sea-ice areal fraction + real(r8) :: ocnfrac(pcols) ! ocean areal fraction + real(r8), pointer, dimension(:) :: ram1 !aerodynamical resistance (s/m) (pcols) + real(r8), pointer, dimension(:) :: fv !friction velocity (m/s) (pcols) + real(r8), pointer, dimension(:) :: soilw !volumetric soil water (m3/m3) + real(r8) :: cflx(pcols,pcnst) ! constituent flux (emissions) + real(r8) :: ustar(pcols) ! atm/ocn saved version of ustar + real(r8) :: re(pcols) ! atm/ocn saved version of re + real(r8) :: ssq(pcols) ! atm/ocn saved version of ssq + real(r8), pointer, dimension(:,:) :: depvel ! deposition velocities + real(r8), pointer, dimension(:,:) :: dstflx ! dust fluxes + real(r8), pointer, dimension(:,:) :: meganflx ! MEGAN fluxes + real(r8), pointer, dimension(:,:) :: fireflx ! wild fire emissions + real(r8), pointer, dimension(:) :: fireztop ! wild fire emissions vert distribution top + end type cam_in_t + +!=============================================================================== +CONTAINS +!=============================================================================== + +!----------------------------------------------------------------------- +! +! BOP +! +! !IROUTINE: hub2atm_alloc +! +! !DESCRIPTION: +! +! Allocate space for the surface to atmosphere data type. And initialize +! the values. +! +!----------------------------------------------------------------------- +! +! !INTERFACE +! + subroutine hub2atm_alloc( cam_in ) + use seq_drydep_mod, only: lnd_drydep, n_drydep + use cam_cpl_indices, only: index_x2a_Sl_ram1, index_x2a_Sl_fv, index_x2a_Sl_soilw, index_x2a_Fall_flxdst1 + use cam_cpl_indices, only: index_x2a_Fall_flxvoc + use shr_megan_mod, only: shr_megan_mechcomps_n + use cam_cpl_indices, only: index_x2a_Fall_flxfire + use shr_fire_emis_mod,only: shr_fire_emis_mechcomps_n +! +!!ARGUMENTS: +! + type(cam_in_t), pointer :: cam_in(:) ! Merged surface state +! +!!LOCAL VARIABLES: +! + integer :: c ! chunk index + integer :: ierror ! Error code +!----------------------------------------------------------------------- +! +! EOP +! + if ( .not. phys_grid_initialized() ) call endrun( "HUB2ATM_ALLOC error: phys_grid not called yet" ) + allocate (cam_in(begchunk:endchunk), stat=ierror) + if ( ierror /= 0 )then + write(iulog,*) 'Allocation error: ', ierror + call endrun('HUB2ATM_ALLOC error: allocation error') + end if + + do c = begchunk,endchunk + nullify(cam_in(c)%ram1) + nullify(cam_in(c)%fv) + nullify(cam_in(c)%soilw) + nullify(cam_in(c)%depvel) + nullify(cam_in(c)%dstflx) + nullify(cam_in(c)%meganflx) + nullify(cam_in(c)%fireflx) + nullify(cam_in(c)%fireztop) + enddo + do c = begchunk,endchunk + if (index_x2a_Sl_ram1>0) then + allocate (cam_in(c)%ram1(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error ram1') + endif + if (index_x2a_Sl_fv>0) then + allocate (cam_in(c)%fv(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error fv') + endif + if (index_x2a_Sl_soilw /= 0) then + allocate (cam_in(c)%soilw(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error soilw') + end if + if (index_x2a_Fall_flxdst1>0) then + ! Assume 4 bins from surface model .... + allocate (cam_in(c)%dstflx(pcols,4), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error dstflx') + endif + if ( index_x2a_Fall_flxvoc>0 .and. shr_megan_mechcomps_n>0 ) then + allocate (cam_in(c)%meganflx(pcols,shr_megan_mechcomps_n), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error meganflx') + endif + end do + + if (lnd_drydep .and. n_drydep>0) then + do c = begchunk,endchunk + allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error depvel') + end do + endif + + if ( index_x2a_Fall_flxfire>0 .and. shr_fire_emis_mechcomps_n>0 ) then + do c = begchunk,endchunk + allocate(cam_in(c)%fireflx(pcols,shr_fire_emis_mechcomps_n), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error fireflx') + allocate(cam_in(c)%fireztop(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error fireztop') + enddo + endif + + do c = begchunk,endchunk + cam_in(c)%lchnk = c + cam_in(c)%ncol = get_ncols_p(c) + cam_in(c)%asdir (:) = 0._r8 + cam_in(c)%asdif (:) = 0._r8 + cam_in(c)%aldir (:) = 0._r8 + cam_in(c)%aldif (:) = 0._r8 + cam_in(c)%lwup (:) = 0._r8 + cam_in(c)%lhf (:) = 0._r8 + cam_in(c)%shf (:) = 0._r8 + cam_in(c)%wsx (:) = 0._r8 + cam_in(c)%wsy (:) = 0._r8 + cam_in(c)%tref (:) = 0._r8 + cam_in(c)%qref (:) = 0._r8 + cam_in(c)%u10 (:) = 0._r8 + cam_in(c)%ts (:) = 0._r8 + cam_in(c)%sst (:) = 0._r8 + cam_in(c)%snowhland(:) = 0._r8 + cam_in(c)%snowhice (:) = 0._r8 + cam_in(c)%fco2_lnd (:) = 0._r8 + cam_in(c)%fco2_ocn (:) = 0._r8 + cam_in(c)%fdms (:) = 0._r8 + cam_in(c)%landfrac (:) = posinf + cam_in(c)%icefrac (:) = posinf + cam_in(c)%ocnfrac (:) = posinf + + if (associated(cam_in(c)%ram1)) & + cam_in(c)%ram1 (:) = 0.1_r8 + if (associated(cam_in(c)%fv)) & + cam_in(c)%fv (:) = 0.1_r8 + if (associated(cam_in(c)%soilw)) & + cam_in(c)%soilw (:) = 0.0_r8 + if (associated(cam_in(c)%dstflx)) & + cam_in(c)%dstflx(:,:) = 0.0_r8 + if (associated(cam_in(c)%meganflx)) & + cam_in(c)%meganflx(:,:) = 0.0_r8 + + cam_in(c)%cflx (:,:) = 0._r8 + cam_in(c)%ustar (:) = 0._r8 + cam_in(c)%re (:) = 0._r8 + cam_in(c)%ssq (:) = 0._r8 + if (lnd_drydep .and. n_drydep>0) then + cam_in(c)%depvel (:,:) = 0._r8 + endif + if ( index_x2a_Fall_flxfire>0 .and. shr_fire_emis_mechcomps_n>0 ) then + cam_in(c)%fireflx(:,:) = 0._r8 + cam_in(c)%fireztop(:) = 0._r8 + endif + end do + + end subroutine hub2atm_alloc + +! +!=============================================================================== +! + +!----------------------------------------------------------------------- +! +! BOP +! +! !IROUTINE: atm2hub_alloc +! +! !DESCRIPTION: +! +! Allocate space for the atmosphere to surface data type. And initialize +! the values. +! +!----------------------------------------------------------------------- +! +! !INTERFACE +! + subroutine atm2hub_alloc( cam_out ) +! +!!USES: +! + use cam_cpl_indices, only: index_a2x_Faxa_nhx, index_a2x_Faxa_noy +! +!!ARGUMENTS: +! + type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input +! +!!LOCAL VARIABLES: +! + integer :: c ! chunk index + integer :: ierror ! Error code + !----------------------------------------------------------------------- + + if ( .not. phys_grid_initialized() ) call endrun( "ATM2HUB_ALLOC error: phys_grid not called yet" ) + allocate (cam_out(begchunk:endchunk), stat=ierror) + if ( ierror /= 0 )then + write(iulog,*) 'Allocation error: ', ierror + call endrun('ATM2HUB_ALLOC error: allocation error') + end if + + do c = begchunk,endchunk + cam_out(c)%lchnk = c + cam_out(c)%ncol = get_ncols_p(c) + cam_out(c)%tbot(:) = 0._r8 + cam_out(c)%zbot(:) = 0._r8 + cam_out(c)%topo(:) = 0._r8 + cam_out(c)%ubot(:) = 0._r8 + cam_out(c)%vbot(:) = 0._r8 + cam_out(c)%qbot(:,:) = 0._r8 + cam_out(c)%pbot(:) = 0._r8 + cam_out(c)%rho(:) = 0._r8 + cam_out(c)%netsw(:) = 0._r8 + cam_out(c)%flwds(:) = 0._r8 + cam_out(c)%precsc(:) = 0._r8 + cam_out(c)%precsl(:) = 0._r8 + cam_out(c)%precc(:) = 0._r8 + cam_out(c)%precl(:) = 0._r8 + cam_out(c)%soll(:) = 0._r8 + cam_out(c)%sols(:) = 0._r8 + cam_out(c)%solld(:) = 0._r8 + cam_out(c)%solsd(:) = 0._r8 + cam_out(c)%thbot(:) = 0._r8 + cam_out(c)%co2prog(:) = 0._r8 + cam_out(c)%co2diag(:) = 0._r8 + cam_out(c)%psl(:) = 0._r8 + cam_out(c)%bcphidry(:) = 0._r8 + cam_out(c)%bcphodry(:) = 0._r8 + cam_out(c)%bcphiwet(:) = 0._r8 + cam_out(c)%ocphidry(:) = 0._r8 + cam_out(c)%ocphodry(:) = 0._r8 + cam_out(c)%ocphiwet(:) = 0._r8 + cam_out(c)%dstdry1(:) = 0._r8 + cam_out(c)%dstwet1(:) = 0._r8 + cam_out(c)%dstdry2(:) = 0._r8 + cam_out(c)%dstwet2(:) = 0._r8 + cam_out(c)%dstdry3(:) = 0._r8 + cam_out(c)%dstwet3(:) = 0._r8 + cam_out(c)%dstdry4(:) = 0._r8 + cam_out(c)%dstwet4(:) = 0._r8 + + nullify(cam_out(c)%nhx_nitrogen_flx) + nullify(cam_out(c)%noy_nitrogen_flx) + + if (index_a2x_Faxa_nhx>0) then + allocate (cam_out(c)%nhx_nitrogen_flx(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('atm2hub_alloc error: allocation error nhx_nitrogen_flx') + cam_out(c)%nhx_nitrogen_flx(:) = 0._r8 + endif + if (index_a2x_Faxa_noy>0) then + allocate (cam_out(c)%noy_nitrogen_flx(pcols), stat=ierror) + if ( ierror /= 0 ) call endrun('atm2hub_alloc error: allocation error noy_nitrogen_flx') + cam_out(c)%noy_nitrogen_flx(:) = 0._r8 + endif + end do + + end subroutine atm2hub_alloc + + subroutine atm2hub_deallocate(cam_out) + type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input + if(associated(cam_out)) then + deallocate(cam_out) + end if + nullify(cam_out) + + end subroutine atm2hub_deallocate + subroutine hub2atm_deallocate(cam_in) + type(cam_in_t), pointer :: cam_in(:) ! Atmosphere to surface input + integer :: c + + if(associated(cam_in)) then + do c=begchunk,endchunk + if(associated(cam_in(c)%ram1)) then + deallocate(cam_in(c)%ram1) + nullify(cam_in(c)%ram1) + end if + if(associated(cam_in(c)%fv)) then + deallocate(cam_in(c)%fv) + nullify(cam_in(c)%fv) + end if + if(associated(cam_in(c)%soilw)) then + deallocate(cam_in(c)%soilw) + nullify(cam_in(c)%soilw) + end if + if(associated(cam_in(c)%dstflx)) then + deallocate(cam_in(c)%dstflx) + nullify(cam_in(c)%dstflx) + end if + if(associated(cam_in(c)%meganflx)) then + deallocate(cam_in(c)%meganflx) + nullify(cam_in(c)%meganflx) + end if + if(associated(cam_in(c)%depvel)) then + deallocate(cam_in(c)%depvel) + nullify(cam_in(c)%depvel) + end if + + enddo + + deallocate(cam_in) + end if + nullify(cam_in) + + end subroutine hub2atm_deallocate + + +!====================================================================== + +subroutine cam_export(state,cam_out,pbuf) + +!----------------------------------------------------------------------- +! +! Purpose: +! Transfer atmospheric fields into necessary surface data structures +! +! Author: L. Bath CMS Contact: M. Vertenstein +! +!----------------------------------------------------------------------- + use physics_types, only: physics_state + use ppgrid, only: pver + use cam_history, only: outfld + use chem_surfvals, only: chem_surfvals_get + use co2_cycle, only: co2_transport, c_i + use physconst, only: rair, mwdry, mwco2, gravit + use constituents, only: pcnst + use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc + implicit none + + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + type(physics_state), intent(in) :: state + type (cam_out_t), intent(inout) :: cam_out + type(physics_buffer_desc), pointer :: pbuf(:) + + ! + !---------------------------Local variables----------------------------- + ! + integer :: i ! Longitude index + integer :: m ! constituent index + integer :: lchnk ! Chunk index + integer :: ncol + integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx + integer :: prec_sed_idx,snow_sed_idx,prec_pcw_idx,snow_pcw_idx + + real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection + real(r8), pointer :: snow_dp(:) ! snow from ZM convection + real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection + real(r8), pointer :: snow_sh(:) ! snow from Hack convection + real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection + real(r8), pointer :: snow_sed(:) ! snow from ZM convection + real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection + real(r8), pointer :: snow_pcw(:) ! snow from Hack convection + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + prec_dp_idx = pbuf_get_index('PREC_DP', errcode=i) + snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=i) + prec_sh_idx = pbuf_get_index('PREC_SH', errcode=i) + snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=i) + prec_sed_idx = pbuf_get_index('PREC_SED', errcode=i) + snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=i) + prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=i) + snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=i) + + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp) + end if + if (snow_dp_idx > 0) then + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh) + end if + if (snow_sh_idx > 0) then + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh) + end if + if (prec_sed_idx > 0) then + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed) + end if + if (snow_sed_idx > 0) then + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed) + end if + if (prec_pcw_idx > 0) then + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw) + end if + if (snow_pcw_idx > 0) then + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw) + end if + + do i=1,ncol + cam_out%tbot(i) = state%t(i,pver) + cam_out%thbot(i) = state%t(i,pver) * state%exner(i,pver) + cam_out%zbot(i) = state%zm(i,pver) + cam_out%topo(i) = state%phis(i) / gravit + cam_out%ubot(i) = state%u(i,pver) + cam_out%vbot(i) = state%v(i,pver) + cam_out%pbot(i) = state%pmid(i,pver) + cam_out%rho(i) = cam_out%pbot(i)/(rair*cam_out%tbot(i)) + end do + do m = 1, pcnst + do i = 1, ncol + cam_out%qbot(i,m) = state%q(i,pver,m) + end do + end do + + cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8 + if (co2_transport()) then + do i=1,ncol + cam_out%co2prog(i) = state%q(i,pver,c_i(4)) * 1.0e+6_r8 *mwdry/mwco2 + end do + end if + ! + ! Precipation and snow rates from shallow convection, deep convection and stratiform processes. + ! Compute total convective and stratiform precipitation and snow rates + ! + do i=1,ncol + cam_out%precc (i) = 0._r8 + cam_out%precl (i) = 0._r8 + cam_out%precsc(i) = 0._r8 + cam_out%precsl(i) = 0._r8 + if (prec_dp_idx > 0) then + cam_out%precc (i) = cam_out%precc (i) + prec_dp(i) + end if + if (prec_sh_idx > 0) then + cam_out%precc (i) = cam_out%precc (i) + prec_sh(i) + end if + if (prec_sed_idx > 0) then + cam_out%precl (i) = cam_out%precl (i) + prec_sed(i) + end if + if (prec_pcw_idx > 0) then + cam_out%precl (i) = cam_out%precl (i) + prec_pcw(i) + end if + if (snow_dp_idx > 0) then + cam_out%precsc(i) = cam_out%precsc(i) + snow_dp(i) + end if + if (snow_sh_idx > 0) then + cam_out%precsc(i) = cam_out%precsc(i) + snow_sh(i) + end if + if (snow_sed_idx > 0) then + cam_out%precsl(i) = cam_out%precsl(i) + snow_sed(i) + end if + if (snow_pcw_idx > 0) then + cam_out%precsl(i) = cam_out%precsl(i) + snow_pcw(i) + end if + + ! jrm These checks should not be necessary if they exist in the parameterizations + if (cam_out%precc(i) .lt.0._r8) cam_out%precc(i)=0._r8 + if (cam_out%precl(i) .lt.0._r8) cam_out%precl(i)=0._r8 + if (cam_out%precsc(i).lt.0._r8) cam_out%precsc(i)=0._r8 + if (cam_out%precsl(i).lt.0._r8) cam_out%precsl(i)=0._r8 + if (cam_out%precsc(i).gt.cam_out%precc(i)) cam_out%precsc(i)=cam_out%precc(i) + if (cam_out%precsl(i).gt.cam_out%precl(i)) cam_out%precsl(i)=cam_out%precl(i) + ! end jrm + end do + +end subroutine cam_export + +end module camsrfexch diff --git a/src/control/filenames.F90 b/src/control/filenames.F90 new file mode 100644 index 0000000000..71166c4b07 --- /dev/null +++ b/src/control/filenames.F90 @@ -0,0 +1,205 @@ +module filenames + +! Module and methods to handle filenames needed for the model. This +! includes input filenames, and most output filenames that the model +! uses. All filenames that the model uses will use methods or data +! constructed by this module. In some cases (such as the cam_history module) +! other modules or routines will store the actual filenames used, but +! this module is used to determine the names. + +use time_manager, only: get_curr_date, get_prev_date +use shr_kind_mod, only: cl=>shr_kind_cl +use cam_control_mod, only: caseid +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public get_dir ! Get the directory name from a full path +public interpret_filename_spec ! Interpret a filename specifier + +!=============================================================================== +CONTAINS +!=============================================================================== + +character(len=cl) function get_dir( filepath ) + +! Return the directory from a filename with a full path + + ! arguments + character(len=*), intent(in) :: filepath ! Full path for a filename + + ! local variables + integer :: filenameposition ! Character position for last character of directory + !----------------------------------------------------------------------------- + + ! Get the directory name of the input dataset + filenameposition = index( filepath, '/', back=.true. ) + if ( filenameposition == 0 )then + get_dir = './' + else + get_dir = filepath(1:filenameposition) + end if + +end function get_dir + +!=============================================================================== + +character(len=cl) function interpret_filename_spec( filename_spec, number, prev, case, & + yr_spec, mon_spec, day_spec, sec_spec ) + +! Create a filename from a filename specifier. The +! filename specifyer includes codes for setting things such as the +! year, month, day, seconds in day, caseid, and tape number. This +! routine is private to filenames.F90 +! +! Interpret filename specifyer string with: +! +! %c for case, +! %t for optional number argument sent into function +! %y for year +! %m for month +! %d for day +! %s for second +! %% for the "%" character +! +! If the filename specifyer has spaces " ", they will be trimmed out +! of the resulting filename. + + ! arguments + character(len=*), intent(in) :: filename_spec ! Filename specifier to use + integer , intent(in), optional :: number ! Number to use for %t field + logical , intent(in), optional :: prev ! If should label with previous time-step + character(len=*), intent(in), optional :: case ! Optional casename + integer , intent(in), optional :: yr_spec ! Simulation year + integer , intent(in), optional :: mon_spec ! Simulation month + integer , intent(in), optional :: day_spec ! Simulation day + integer , intent(in), optional :: sec_spec ! Seconds into current simulation day + + ! Local variables + integer :: year ! Simulation year + integer :: month ! Simulation month + integer :: day ! Simulation day + integer :: ncsec ! Seconds into current simulation day + character(len=cl) :: string ! Temporary character string + character(len=cl) :: format ! Format character string + integer :: i, n ! Loop variables + logical :: previous ! If should label with previous time-step + logical :: done + !----------------------------------------------------------------------------- + + if ( len_trim(filename_spec) == 0 )then + call endrun ('INTERPRET_FILENAME_SPEC: filename specifier is empty') + end if + if ( index(trim(filename_spec)," ") /= 0 )then + call endrun ('INTERPRET_FILENAME_SPEC: filename specifier can not contain a space:'//trim(filename_spec)) + end if + ! + ! Determine year, month, day and sec to put in filename + ! + if (present(yr_spec) .and. present(mon_spec) .and. present(day_spec) .and. present(sec_spec)) then + year = yr_spec + month = mon_spec + day = day_spec + ncsec = sec_spec + else + if ( .not. present(prev) ) then + previous = .false. + else + previous = prev + end if + if ( previous ) then + call get_prev_date(year, month, day, ncsec) + else + call get_curr_date(year, month, day, ncsec) + end if + end if + ! + ! Go through each character in the filename specifyer and interpret if special string + ! + i = 1 + interpret_filename_spec = '' + do while ( i <= len_trim(filename_spec) ) + ! + ! If following is an expansion string + ! + if ( filename_spec(i:i) == "%" )then + i = i + 1 + select case( filename_spec(i:i) ) + case( 'c' ) ! caseid + if ( present(case) )then + string = trim(case) + else + string = trim(caseid) + end if + case( 't' ) ! number + if ( .not. present(number) )then + write(iulog,*) 'INTERPRET_FILENAME_SPEC: number needed in filename_spec' & + , ', but not provided to subroutine' + write(iulog,*) 'filename_spec = ', filename_spec + call endrun + end if + if ( number > 999 ) then + format = '(i4.4)' + if ( number > 9999 ) then + write(iulog,*) 'INTERPRET_FILENAME_SPEC: number is too large: ', number + call endrun + end if + else if ( number > 99 ) then + format = '(i3.3)' + else if ( number > 9 ) then + format = '(i2.2)' + else + format = '(i1.1)' + end if + write(string,format) number + case( 'y' ) ! year + if ( year > 99999 ) then + format = '(i6.6)' + else if ( year > 9999 ) then + format = '(i5.5)' + else + format = '(i4.4)' + end if + write(string,format) year + case( 'm' ) ! month + write(string,'(i2.2)') month + case( 'd' ) ! day + write(string,'(i2.2)') day + case( 's' ) ! second + write(string,'(i5.5)') ncsec + case( '%' ) ! percent character + string = "%" + case default + call endrun ('INTERPRET_FILENAME_SPEC: Invalid expansion character: '//filename_spec(i:i)) + end select + ! + ! Otherwise take normal text up to the next "%" character + ! + else + n = index( filename_spec(i:), "%" ) + if ( n == 0 ) n = len_trim( filename_spec(i:) ) + 1 + if ( n == 0 ) exit + string = filename_spec(i:n+i-2) + i = n + i - 2 + end if + if ( len_trim(interpret_filename_spec) == 0 )then + interpret_filename_spec = trim(string) + else + if ( (len_trim(interpret_filename_spec)+len_trim(string)) >= cl )then + call endrun ('INTERPRET_FILENAME_SPEC: Resultant filename too long') + end if + interpret_filename_spec = trim(interpret_filename_spec) // trim(string) + end if + i = i + 1 + + end do + if ( len_trim(interpret_filename_spec) == 0 )then + call endrun ('INTERPRET_FILENAME_SPEC: Resulting filename is empty') + end if + +end function interpret_filename_spec + +end module filenames diff --git a/src/control/history_defaults.F90 b/src/control/history_defaults.F90 new file mode 100644 index 0000000000..73e5554e14 --- /dev/null +++ b/src/control/history_defaults.F90 @@ -0,0 +1,143 @@ +module history_defaults +!----------------------------------------------------------------------- +! +! Purpose: contains calls to setup default history stuff that has not found +! a proper home yet. Shouldn't really exist. +! +! Public functions/subroutines: +! bldfld +! +! Author: B.A. Boville from code in cam_history.F90 +!----------------------------------------------------------------------- + use constituents, only: pcnst, cnst_name + + use cam_history, only: addfld, add_default, horiz_only + implicit none + + PRIVATE + + public :: bldfld + +#if ( defined BFB_CAM_SCAM_IOP ) + public :: initialize_iop_history +#endif + +CONTAINS + + +!####################################################################### + subroutine bldfld () +! +!----------------------------------------------------------------------- +! +! Purpose: +! +! Build Master Field List of all possible fields in a history file. Each field has +! associated with it a "long_name" netcdf attribute that describes what the field is, +! and a "units" attribute. +! +! Method: Call a subroutine to add each field +! +! Author: CCM Core Group +! +!----------------------------------------------------------------------- +! +! Local workspace +! + integer m ! Index + +!jt +!jt Maybe add this to scam specific initialization +!jt + +#if ( defined BFB_CAM_SCAM_IOP ) + call addfld ('CLAT1&IC', horiz_only, 'I', ' ','cos lat for bfb testing', gridname='gauss_grid') + call add_default ('CLAT1&IC',0,'I') + call addfld ('CLON1&IC', horiz_only, 'I', ' ','cos lon for bfb testing', gridname='gauss_grid') + call add_default ('CLON1&IC',0,'I') + call addfld ('PHI&IC', horiz_only, 'I', ' ','lat for bfb testing', gridname='gauss_grid') + call add_default ('PHI&IC',0, 'I') + call addfld ('LAM&IC', horiz_only, 'I', ' ','lon for bfb testing', gridname='gauss_grid') + call add_default ('LAM&IC',0, 'I') +#endif + + call addfld ('DQP', (/ 'lev' /), 'A', 'kg/kg/s','Specific humidity tendency due to precipitation', & + gridname='physgrid') + + end subroutine bldfld + +!####################################################################### +#if ( defined BFB_CAM_SCAM_IOP ) + subroutine initialize_iop_history() +! +! !DESCRIPTION: +! !USES: + use iop + use phys_control, only: phys_getopts +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer m +!----------------------------------------------------------------------- + call addfld ('CLAT', horiz_only, 'A', ' ', 'cos lat for bfb testing', gridname='gauss_grid') + call add_default ('CLAT',2,' ') + call addfld ('q', (/ 'lev' /), 'A', 'kg/kg', 'Q for scam',gridname='gauss_grid') + call add_default ('q',2, ' ') + call addfld ('u', (/ 'lev' /), 'A', 'm/s', 'U for scam',gridname='gauss_grid') + call add_default ('u',2,' ') + call addfld ('v', (/ 'lev' /), 'A', 'm/s', 'V for scam',gridname='gauss_grid') + call add_default ('v',2,' ') + call addfld ('t', (/ 'lev' /), 'A', 'K', 'Temperature for scam',gridname='gauss_grid') + call add_default ('t',2,' ') + call addfld ('Tg', horiz_only, 'A', 'K', 'Surface temperature (radiative) for scam',gridname='physgrid') + call add_default ('Tg',2,' ') + call addfld ('Ps', horiz_only, 'A', 'Pa', 'Ps for scam',gridname='gauss_grid') + call add_default ('Ps',2,' ') + call addfld ('divT3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for T',gridname='gauss_grid') + call add_default ('divT3d',2,' ') + call addfld ('divU3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for U',gridname='gauss_grid') + call add_default ('divU3d',2,' ') + call addfld ('divV3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for V',gridname='gauss_grid') + call add_default ('divV3d',2,' ') + call addfld ('fixmas', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') + call add_default ('fixmas',2,' ') + call addfld ('beta', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') + call add_default ('beta',2,' ') + do m=1,pcnst + call addfld (trim(cnst_name(m))//'_dten', (/ 'lev' /), 'A', 'kg/kg', & + trim(cnst_name(m))//' IOP Dynamics Residual for '//trim(cnst_name(m)),gridname='gauss_grid') + call add_default (trim(cnst_name(m))//'_dten',2,' ') + call addfld (trim(cnst_name(m))//'_alph', horiz_only, 'A', 'kg/kg',trim(cnst_name(m))//' alpha constituent fixer', & + gridname='gauss_grid') + call add_default (trim(cnst_name(m))//'_alph',2,' ') + call addfld (trim(cnst_name(m))//'_dqfx', (/ 'lev' /), 'A', 'kg/kg',trim(cnst_name(m))//' dqfx3 fixer', & + gridname='gauss_grid') + call add_default (trim(cnst_name(m))//'_dqfx',2,' ') + end do + call addfld ('shflx', horiz_only, 'A', 'W/m2', 'Surface sensible heat flux for scam',gridname='physgrid') + call add_default ('shflx',2,' ') + call addfld ('lhflx', horiz_only, 'A', 'W/m2', 'Surface latent heat flux for scam',gridname='physgrid') + call add_default ('lhflx',2,' ') + call addfld ('trefht', horiz_only, 'A', 'K', 'Reference height temperature',gridname='physgrid') + call add_default ('trefht',2,' ') + call addfld ('Tsair', horiz_only, 'A', 'K', 'Reference height temperature for scam',gridname='physgrid') + call add_default ('Tsair',2,' ') + call addfld ('phis', horiz_only, 'I', 'm2/s2','Surface geopotential for scam',gridname='physgrid') + call add_default ('phis',2,' ') + call addfld ('Prec', horiz_only, 'A', 'm/s', 'Total (convective and large-scale) precipitation rate for scam', & + gridname='physgrid') + call add_default ('Prec',2,' ') + call addfld ('omega', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)',gridname='physgrid') + call add_default ('omega',2,' ') + + end subroutine initialize_iop_history +#endif + +end module history_defaults diff --git a/src/control/history_scam.F90 b/src/control/history_scam.F90 new file mode 100644 index 0000000000..2c81ce1a78 --- /dev/null +++ b/src/control/history_scam.F90 @@ -0,0 +1,106 @@ +module history_scam +!----------------------------------------------------------------------- +! +! Purpose: SCAM specific history code. +! +! Public functions/subroutines: +! bldfld, h_default +! +! Author: anonymous from code in cam_history.F90 +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + +PRIVATE + + public :: scm_intht + +!####################################################################### +CONTAINS + subroutine scm_intht() +!----------------------------------------------------------------------- +! +! Purpose: +! +! add master list fields to scm +! +! Method: Call a subroutine to add each field +! +! Author: CCM Core Group +! +!----------------------------------------------------------------------- + use cam_history, only: addfld, add_default, horiz_only +!----------------------------------------------------------------------- +! +!----------------------------------------------------------------------- +! Local variables +! + integer m,j ! Indices + real(r8) dummy +! +! Call addfld to add each field to the Master Field List. +! + call addfld ('TDIFF', (/ 'lev' /), 'A', 'K','difference from observed temp', gridname='gauss_grid') + call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname='gauss_grid') + call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname='gauss_grid') + + call addfld ('TOBS', (/ 'lev' /), 'A', 'K','observed temp') + call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname='gauss_grid') + + call addfld ('QOBS', (/ 'lev' /), 'A', 'kg/kg','observed water', gridname='physgrid') + call addfld ('PRECOBS', (/ 'lev' /), 'A', 'mm/day','Total (convective and large-scale) precipitation rate', & + gridname='physgrid') + call addfld ('DIVQ', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horizontal)', gridname='physgrid') + call addfld ('DIVQ3D', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVV', (/ 'lev' /), 'A', 'm/s2','V advection tendency (horizontal)', gridname='physgrid') + call addfld ('DIVU', (/ 'lev' /), 'A', 'm/s2','U advection tendency (horizontal)', gridname='physgrid') + call addfld ('DIVT', (/ 'lev' /), 'A', 'K/s','T advection tendency (horizontal)', gridname='physgrid') + call addfld ('DIVT3D', (/ 'lev' /), 'A', 'K/s','T advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVU3D', (/ 'lev' /), 'A', 'K/s','U advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVV3D', (/ 'lev' /), 'A', 'K/s','V advection tendency (horiz/vert combined)', gridname='gauss_grid') + + call addfld ('SHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface sensible heat flux', gridname='physgrid') + call addfld ('LHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface latent heat flux', gridname='physgrid') + call addfld ('TRELAX', (/ 'lev' /), 'A', 'K','t relaxation amount', gridname='gauss_grid') + call addfld ('QRELAX', (/ 'lev' /), 'A', 'kg/kg','q relaxation amount', gridname='gauss_grid') + call addfld ('TAURELAX', (/ 'lev' /), 'A', 'seconds','relaxation time constant', gridname='gauss_grid') + call add_default ('TDIFF', 1, ' ') + call add_default ('QDIFF', 1, ' ') + + ! Vertical advective forcing of 'T,u,v,qv,ql,qi,nl,ni' in forecast.F90 + + call addfld ('TTEN_XYADV', (/ 'lev' /), 'I', 'K/s', 'T horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('UTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'U horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('VTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'V horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('QVTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QV horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('QLTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QL horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('QITEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QI horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('NLTEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NL horizontal advective forcing', gridname='gauss_grid' ) + call addfld ('NITEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NI horizontal advective forcing', gridname='gauss_grid' ) + +! call addfld ('T3D_ADV_SLT', 'K/s' , pver, 'I', 'T 3d slt advective forcing', gridname='physgrid') +! call addfld ('U3D_ADV_SLT', 'm/s^2' , pver, 'I', 'U 3d slt advective forcing', gridname='physgrid') +! call addfld ('V3D_ADV_SLT', 'm/s^2' , pver, 'I', 'V 3d slt advective forcing', gridname='physgrid') + call addfld ('TTEN_ZADV', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) + call addfld ('UTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) + call addfld ('VTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QVTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QLTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QITEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) + call addfld ('NLTEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) + call addfld ('NITEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) + + call addfld ('TTEN_PHYS', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) + call addfld ('UTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) + call addfld ('VTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QVTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QLTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) + call addfld ('QITEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) + call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) + call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) + + end subroutine scm_intht + +!####################################################################### + end module history_scam diff --git a/src/control/ncdio_atm.F90 b/src/control/ncdio_atm.F90 new file mode 100644 index 0000000000..7f1e3364c4 --- /dev/null +++ b/src/control/ncdio_atm.F90 @@ -0,0 +1,903 @@ +module ncdio_atm + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: ncdio_atm + ! + ! !DESCRIPTION: + ! Generic interfaces to write fields to PIO files + ! + ! !USES: + + use pio, only: pio_offset_kind, file_desc_t, var_desc_t, pio_double, & + pio_inq_dimid, pio_max_var_dims, io_desc_t, pio_setframe + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod, only: shr_sys_flush ! Standardized system subroutines + use shr_scam_mod, only: shr_scam_getCloseLatLon ! Standardized system subroutines + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use scamMod, only: scmlat,scmlon,single_column + use cam_logfile, only: iulog + ! + ! !PUBLIC TYPES: + implicit none + + PRIVATE + + save + + logical :: debug = .false. + + ! + !EOP + ! + interface infld + module procedure infld_real_1d_2d + module procedure infld_real_2d_2d + module procedure infld_real_2d_3d + module procedure infld_real_3d_3d + end interface + + + public :: infld + + integer STATUS + real(r8) surfdat + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: infld_real_1d_2d + ! + ! !INTERFACE: + subroutine infld_real_1d_2d(varname, ncid, dimname1, & + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel) + ! + ! !DESCRIPTION: + ! Netcdf I/O of initial real field from netCDF file + ! Read a 1-D field (or slice) into a 2-D variable + ! + ! !USES + ! + + use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & + cam_grid_dimensions + use cam_pio_utils, only: cam_pio_check_var + + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + type(file_desc_t), intent(inout) :: ncid ! input unit + character(len=*), intent(in) :: dimname1 ! name of 1st array dimensions of field on file (array order) + integer, intent(in) :: dim1b ! start of first dimension of array to be returned + integer, intent(in) :: dim1e ! end of first dimension of array to be returned + integer, intent(in) :: dim2b ! start of second dimension of array to be returned + integer, intent(in) :: dim2e ! end of second dimension of array to be returned + real(r8), target, intent(out) :: field(dim1b:dim1e,dim2b:dim2e) ! array to be returned (decomposed or global) + logical, intent(out) :: readvar ! true => variable is on initial dataset + character(len=*), optional, intent(in) :: gridname ! Name of variable's grid + integer, optional, intent(in) :: timelevel + ! + !EOP + ! + ! !LOCAL VARIABLES: + type(io_desc_t), pointer :: iodesc + integer :: grid_id ! grid ID for data mapping + integer :: i, j ! indices + integer :: ierr ! error status + type(var_desc_t) :: varid ! variable id + + integer :: arraydimsize(2) ! field dimension lengths + + integer :: ndims ! number of dimensions + integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims + integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape + integer :: grid_dimlens(2) + + ! Offsets for reading global variables + integer :: strt(1) = 1 ! start ncol index for netcdf 1-d + integer :: cnt (1) = 1 ! ncol count for netcdf 1-d + character(len=PIO_MAX_NAME) :: tmpname + character(len=128) :: errormsg + + logical :: readvar_tmp ! if true, variable is on tape + character(len=*), parameter :: subname='INFLD_REAL_1D_2D' ! subroutine name + + ! For SCAM + real(r8) :: closelat, closelon + integer :: lonidx, latidx + + nullify(iodesc) + + ! + !----------------------------------------------------------------------- + ! + ! call pio_setdebuglevel(3) + + ! + ! Error conditions + ! + if (present(gridname)) then + grid_id = cam_grid_id(trim(gridname)) + else + grid_id = cam_grid_id('physgrid') + end if + if (.not. cam_grid_check(grid_id)) then + if(masterproc) then + if (present(gridname)) then + write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) + else + write(errormsg, *)': Internal error, no "physgrid" gridname' + end if + end if + call endrun(trim(subname)//errormsg) + end if + + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) + + if (debug .and. masterproc) then + if (present(gridname)) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) + else + write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + end if + call shr_sys_flush(iulog) + end if + ! + ! Read netCDF file + ! + ! + ! Check if field is on file; get netCDF variable id + ! + call cam_pio_check_var(ncid, varname, varid, ndims, dimids, dimlens, readvar_tmp) + ! + ! If field is on file: + ! + if (readvar_tmp) then + if (debug .and. masterproc) then + write(iulog, '(2a,5(i0,a))') trim(subname),': field(', & + dim1b,':',dim1e,',',dim2b,':',dim2e, '), file(',dimlens(1),')' + call shr_sys_flush(iulog) + end if + ! + ! Get array dimension id's and sizes + ! + arraydimsize(1) = (dim1e - dim1b + 1) + arraydimsize(2) = (dim2e - dim2b + 1) + do j = 1, 2 + if (arraydimsize(j) /= size(field, j)) then + write(errormsg, *) ': Mismatch between array bounds and field size for ', & + trim(varname), ', dimension', j + call endrun(trim(subname)//errormsg) + end if + end do + + if (ndims > 2) then + call endrun(trim(subname)//': too many dimensions for '//trim(varname)) + else if (ndims < 1) then + call endrun(trim(subname)//': too few dimensions for '//trim(varname)) + else + ! Check that the number of columns in the file matches the number of + ! columns in the grid object. + if (dimlens(1) /= grid_dimlens(1)) then + readvar = .false. + return + end if + + ! Check to make sure that the second dimension is time + if (ndims == 2) then + ierr = pio_inq_dimname(ncid, dimids(2), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + end if + end if + end if + + if(ndims == 2) then + if(present(timelevel)) then + call pio_setframe(ncid, varid, int(timelevel,kind=pio_offset_kind)) + else + call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind)) + end if + end if + + ! NB: strt and cnt were initialized to 1 + if (single_column) then + !!XXgoldyXX: Clearly, this will not work for an unstructured dycore + call endrun(trim(subname)//': SCAM not supported in this configuration') + else + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & + pio_double, iodesc) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + end if + + if (masterproc) write(iulog,*) subname//': read field '//trim(varname) + + end if ! end of readvar_tmp + + readvar = readvar_tmp + + return + + end subroutine infld_real_1d_2d + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: infld_real_2d_2d + ! + ! !INTERFACE: + subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel) + ! + ! !DESCRIPTION: + ! Netcdf I/O of initial real field from netCDF file + ! Read a 2-D field (or slice) into a 2-D variable + ! + ! !USES + ! + + use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + type(file_desc_t), intent(inout) :: ncid ! input unit + character(len=*), intent(in) :: dimname1 ! name of 1st array dimensions of field on file (array order) + character(len=*), intent(in) :: dimname2 ! name of 2nd array dimensions of field on file (array order) + integer, intent(in) :: dim1b ! start of first dimension of array to be returned + integer, intent(in) :: dim1e ! end of first dimension of array to be returned + integer, intent(in) :: dim2b ! start of second dimension of array to be returned + integer, intent(in) :: dim2e ! end of second dimension of array to be returned + real(r8), target, intent(out) :: field(dim1b:dim1e,dim2b:dim2e) ! array to be returned (decomposed or global) + logical, intent(out) :: readvar ! true => variable is on initial dataset + character(len=*), optional, intent(in) :: gridname ! Name of variable's grid + integer, optional, intent(in) :: timelevel + ! + !EOP + ! + ! !LOCAL VARIABLES: + type(io_desc_t), pointer :: iodesc + integer :: grid_id ! grid ID for data mapping + integer :: i, j ! indices + integer :: ierr ! error status + type(var_desc_t) :: varid ! variable id + + integer :: arraydimsize(2) ! field dimension lengths + integer :: arraydimids(2) ! Dimension IDs + integer :: permutation(2) + logical :: ispermuted + + integer :: ndims ! number of dimensions on file + integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims + integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape + + ! Offsets for reading global variables + integer :: strt(2) ! start lon, lat indices for netcdf 2-d + integer :: cnt (2) ! lon, lat counts for netcdf 2-d + character(len=PIO_MAX_NAME) :: tmpname + character(len=128) :: errormsg + + real(r8), pointer :: tmp2d(:,:) ! input data for permutation + + logical :: readvar_tmp ! if true, variable is on tape + character(len=*), parameter :: subname='INFLD_REAL_2D_2D' ! subroutine name + character(len=PIO_MAX_NAME) :: field_dnames(2) + + ! For SCAM + real(r8) :: closelat, closelon + integer :: lonidx, latidx + + nullify(iodesc) + + ! + !----------------------------------------------------------------------- + ! + ! call pio_setdebuglevel(3) + + ! Should we be using a different interface? + if ((trim(dimname1) == trim(dimname2)) .or. (len_trim(dimname2) == 0)) then + call infld(varname, ncid, dimname1, dim1b, dim1e, dim2b, dim2e, & + field, readvar, gridname, timelevel) + else + + ! + ! Error conditions + ! + if (present(gridname)) then + grid_id = cam_grid_id(trim(gridname)) + else + grid_id = cam_grid_id('physgrid') + end if + if (.not. cam_grid_check(grid_id)) then + if(masterproc) then + if (present(gridname)) then + write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) + else + write(errormsg, *)': Internal error, no "physgrid" gridname' + end if + end if + call endrun(trim(subname)//errormsg) + end if + + if (debug .and. masterproc) then + if (present(gridname)) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) + else + write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + end if + call shr_sys_flush(iulog) + end if + + ! + ! Read netCDF file + ! + ! + ! Check if field is on file; get netCDF variable id + ! + call cam_pio_check_var(ncid, varname, varid, ndims, dimids, dimlens, readvar_tmp) + ! + ! If field is on file: + ! + if (readvar_tmp) then + if (debug .and. masterproc) then + write(iulog, '(2a,6(i0,a))') trim(subname),': field(', & + dim1b,':',dim1e,',',dim2b,':',dim2e, & + '), file(',dimlens(1),',',dimlens(2),')' + call shr_sys_flush(iulog) + end if + ! + ! Get array dimension id's and sizes + ! + ierr = PIO_inq_dimid(ncid, dimname1, arraydimids(1)) + ierr = PIO_inq_dimid(ncid, dimname2, arraydimids(2)) + arraydimsize(1) = (dim1e - dim1b + 1) + arraydimsize(2) = (dim2e - dim2b + 1) + do j = 1, 2 + if (arraydimsize(j) /= size(field, j)) then + write(errormsg, *) ': Mismatch between array bounds and field size for ', & + trim(varname), ', dimension', j + call endrun(trim(subname)//errormsg) + end if + end do + + if (ndims > 3) then + call endrun(trim(subname)//': too many dimensions for '//trim(varname)) + else if (ndims < 2) then + call endrun(trim(subname)//': too few dimensions for '//trim(varname)) + else + ! Check to make sure that the third dimension is time + if (ndims == 3) then + ierr = pio_inq_dimname(ncid, dimids(3), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + end if + end if + end if + + if(ndims == 3) then + if(present(timelevel)) then + call pio_setframe(ncid, varid, int(timelevel,kind=pio_offset_kind)) + else + call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind)) + end if + end if + + field_dnames(1) = dimname1 + field_dnames(2) = dimname2 + if (single_column) then + ! This could be generalized but for now only handles a single point + strt(1) = dim1b + strt(2) = dim2b + cnt = arraydimsize + call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + if (trim(field_dnames(1)) == 'lon') then + strt(1) = lonidx ! First dim always lon for Eulerian dycore + else + call endrun(trim(subname)//': lon should be first dimension for '//trim(varname)) + end if + if (trim(field_dnames(2)) == 'lat') then + strt(2) = latidx + else + call endrun(trim(subname)//': lat dimension not found for '//trim(varname)) + end if + + ! Check for permuted dimensions ('out of order' array) + call calc_permutation(dimids, arraydimids, permutation, ispermuted) + if (ispermuted) then + call cam_permute_array(strt, permutation) + call cam_permute_array(cnt, permutation) + allocate(tmp2d(1:cnt(1), 1:cnt(2))) + ierr = pio_get_var(ncid, varid, strt, cnt, tmp2d) + do j = dim2b, dim2e + do i = dim1b, dim1e + ! We don't need strt anymore, reuse it + strt(1) = i - dim1b + 1 + strt(2) = j - dim2b + 1 + call cam_permute_array(strt, permutation) + field(i,j) = tmp2d(strt(1), strt(2)) + end do + end do + deallocate(tmp2d) + else + ierr = pio_get_var(ncid, varid, strt, cnt, field) + end if + else + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & + pio_double, iodesc, field_dnames=field_dnames) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + end if + + if (masterproc) write(iulog,*) subname//': read field '//trim(varname) + + end if ! end of readvar_tmp + + readvar = readvar_tmp + + end if ! end of call infld_real_1d_2d instead + + end subroutine infld_real_2d_2d + + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: infld_real_2d_3d + ! + ! !INTERFACE: + subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & + dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & + field, readvar, gridname, timelevel) + ! + ! !DESCRIPTION: + ! Netcdf I/O of initial real field from netCDF file + ! Read a 2-D field (or slice) into a 3-D variable + ! + ! !USES + ! + + use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & + cam_grid_dimensions + use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + type(file_desc_t), intent(inout) :: ncid ! input unit + character(len=*), intent(in) :: dimname1 ! name of 1st array dimensions of field on file (array order) + character(len=*), intent(in) :: dimname2 ! name of 2nd array dimensions of field on file (array order) + integer, intent(in) :: dim1b ! start of first dimension of array to be returned + integer, intent(in) :: dim1e ! end of first dimension of array to be returned + integer, intent(in) :: dim2b ! start of second dimension of array to be returned + integer, intent(in) :: dim2e ! end of second dimension of array to be returned + integer, intent(in) :: dim3b ! start of third dimension of array to be returned + integer, intent(in) :: dim3e ! end of third dimension of array to be returned + real(r8), target, intent(out) :: field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e) ! array to be returned (decomposed or global) + logical, intent(out) :: readvar ! true => variable is on initial dataset + character(len=*), optional, intent(in) :: gridname ! Name of variable's grid + integer, optional, intent(in) :: timelevel + ! + !EOP + ! + ! !LOCAL VARIABLES: + type(io_desc_t), pointer :: iodesc + integer :: grid_id ! grid ID for data mapping + integer :: i, j, k ! indices + integer :: ierr ! error status + type(var_desc_t) :: varid ! variable id + + integer :: arraydimsize(3) ! field dimension lengths + integer :: arraydimids(2) ! Dimension IDs + integer :: permutation(2) + logical :: ispermuted + + integer :: ndims ! number of dimensions + integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims + integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape + integer :: grid_dimlens(2) + + ! Offsets for reading global variables + integer :: strt(3) = 1 ! start ncol, lev indices for netcdf 2-d + integer :: cnt (3) = 1 ! ncol, lev counts for netcdf 2-d + character(len=PIO_MAX_NAME) :: tmpname + + real(r8), pointer :: tmp3d(:,:,:) ! input data for permutation + + logical :: readvar_tmp ! if true, variable is on tape + character(len=*), parameter :: subname='INFLD_REAL_2D_3D' ! subroutine name + character(len=128) :: errormsg + character(len=PIO_MAX_NAME) :: field_dnames(2) + + ! For SCAM + real(r8) :: closelat, closelon + integer :: lonidx, latidx + + nullify(iodesc) + + ! + !----------------------------------------------------------------------- + ! + ! call pio_setdebuglevel(3) + + ! + ! Error conditions + ! + if (present(gridname)) then + grid_id = cam_grid_id(trim(gridname)) + else + grid_id = cam_grid_id('physgrid') + end if + if (.not. cam_grid_check(grid_id)) then + if(masterproc) then + if (present(gridname)) then + write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) + else + write(errormsg, *)': Internal error, no "physgrid" gridname' + end if + end if + call endrun(trim(subname)//errormsg) + end if + + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) + + if (debug .and. masterproc) then + if (present(gridname)) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) + else + write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + end if + call shr_sys_flush(iulog) + end if + + ! + ! Read netCDF file + ! + ! + ! Check if field is on file; get netCDF variable id + ! + call cam_pio_check_var(ncid, varname, varid, ndims, dimids, dimlens, readvar_tmp) + + ! If field is on file: + ! + if (readvar_tmp) then + if (debug .and. masterproc) then + write(iulog, '(2a,8(i0,a))') trim(subname),': field(', & + dim1b,':',dim1e,',',dim2b,':',dim2e,',',dim3b,':',dim3e, & + '), file(',dimlens(1),',',dimlens(2),')' + call shr_sys_flush(iulog) + end if + ! + ! Get array dimension id's and sizes + ! + arraydimsize(1) = (dim1e - dim1b + 1) + arraydimsize(2) = (dim2e - dim2b + 1) + arraydimsize(3) = (dim3e - dim3b + 1) + do j = 1, 3 + if (arraydimsize(j) /= size(field, j)) then + write(errormsg, *) ': Mismatch between array bounds and field size for ', & + trim(varname), ', dimension', j + call endrun(trim(subname)//errormsg) + end if + end do + + if (ndims > 3) then + call endrun(trim(subname)//': too many dimensions for '//trim(varname)) + else if (ndims < 2) then + call endrun(trim(subname)//': too few dimensions for '//trim(varname)) + else + ! Check that the number of columns in the file matches the number of + ! columns in the grid object. + if (dimlens(1) /= grid_dimlens(1)) then + readvar = .false. + return + end if + + ! Check to make sure that the 3rd dimension is time + if (ndims == 3) then + ierr = pio_inq_dimname(ncid, dimids(3), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + end if + end if + end if + + if(ndims == 3) then + if(present(timelevel)) then + call pio_setframe(ncid, varid, int(timelevel,kind=pio_offset_kind)) + else + call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind)) + end if + end if + + field_dnames(1) = dimname1 + field_dnames(2) = dimname2 + ! NB: strt and cnt were initialized to 1 + if (single_column) then + !!XXgoldyXX: Clearly, this will not work for an unstructured dycore + ! Check for permuted dimensions ('out of order' array) +! call calc_permutation(dimids(1:2), arraydimids, permutation, ispermuted) + call endrun(trim(subname)//': SCAM not supported in this configuration') + else + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & + pio_double, iodesc, field_dnames=field_dnames) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + end if + + if (masterproc) write(iulog,*) subname//': read field '//trim(varname) + + end if ! end of readvar_tmp + + readvar = readvar_tmp + + return + + end subroutine infld_real_2d_3d + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: infld_real_3d_3d + ! + ! !INTERFACE: + subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & + dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & + field, readvar, gridname, timelevel) + ! + ! !DESCRIPTION: + ! Netcdf I/O of initial real field from netCDF file + ! Read a 3-D field (or slice) into a 3-D variable + ! + ! !USES + ! + + use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + type(file_desc_t), intent(inout) :: ncid ! input unit + character(len=*), intent(in) :: dimname1 ! name of 1st array dimensions of field on file (array order) + character(len=*), intent(in) :: dimname2 ! name of 2nd array dimensions of field on file (array order) + character(len=*), intent(in) :: dimname3 ! name of 3rd array dimensions of field on file (array order) + integer, intent(in) :: dim1b ! start of first dimension of array to be returned + integer, intent(in) :: dim1e ! end of first dimension of array to be returned + integer, intent(in) :: dim2b ! start of second dimension of array to be returned + integer, intent(in) :: dim2e ! end of second dimension of array to be returned + integer, intent(in) :: dim3b ! start of third dimension of array to be returned + integer, intent(in) :: dim3e ! end of third dimension of array to be returned + real(r8), target, intent(out) :: field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e) ! array to be returned (decomposed or global) + logical, intent(out) :: readvar ! true => variable is on initial dataset + character(len=*), optional, intent(in) :: gridname ! Name of variable's grid + integer, optional, intent(in) :: timelevel + ! + !EOP + ! + ! !LOCAL VARIABLES: + type(io_desc_t), pointer :: iodesc + integer :: grid_id ! grid ID for data mapping + integer :: i, j, k ! indices + integer :: ierr ! error status + type(var_desc_t) :: varid ! variable id + + integer :: arraydimsize(3) ! field dimension lengths + integer :: arraydimids(3) ! Dimension IDs + integer :: permutation(3) + logical :: ispermuted + + integer :: ndims ! number of dimensions + integer :: pdims ! number of dimensions w/o timeslice + integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims + integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape + + ! Offsets for reading global variables + integer :: strt(3) ! start lon, lev, lat indices for netcdf 3-d + integer :: cnt (3) ! lon, lat counts for netcdf 3-d + character(len=PIO_MAX_NAME) :: tmpname + + real(r8), pointer :: tmp3d(:,:,:) ! input data for permutation + + logical :: readvar_tmp ! if true, variable is on tape + character(len=*), parameter :: subname='INFLD_REAL_3D_3D' ! subroutine name + character(len=128) :: errormsg + character(len=PIO_MAX_NAME) :: field_dnames(3) + character(len=PIO_MAX_NAME) :: file_dnames(4) + + ! For SCAM + real(r8) :: closelat, closelon + integer :: lonidx, latidx + + nullify(iodesc) + + ! + !----------------------------------------------------------------------- + ! + ! call pio_setdebuglevel(3) + + ! Should we be using a different interface? + if ((trim(dimname1) == trim(dimname2)) .or. (len_trim(dimname2) == 0)) then + call infld(varname, ncid, dimname1, dimname3, & + dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & + field, readvar, gridname, timelevel) + else if ((trim(dimname1) == trim(dimname3)) .or. (len_trim(dimname3) == 0)) then + call infld(varname, ncid, dimname1, dimname2, & + dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & + field, readvar, gridname, timelevel) + else + + ! + ! Error conditions + ! + if (present(gridname)) then + grid_id = cam_grid_id(trim(gridname)) + else + grid_id = cam_grid_id('physgrid') + end if + if (.not. cam_grid_check(grid_id)) then + if(masterproc) then + if (present(gridname)) then + write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) + else + write(errormsg, *)': Internal error, no "physgrid" gridname' + end if + end if + call endrun(trim(subname)//errormsg) + end if + + if (debug .and. masterproc) then + if (present(gridname)) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) + else + write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + end if + call shr_sys_flush(iulog) + end if + + ! + ! Read netCDF file + ! + ! + ! Check if field is on file; get netCDF variable id + ! + call cam_pio_check_var(ncid, varname, varid, ndims, dimids, dimlens, & + readvar_tmp, dimnames=file_dnames) + ! + ! If field is on file: + ! + if (readvar_tmp) then + if (debug .and. masterproc) then + write(iulog, '(2a,9(i0,a))') trim(subname),': field(', & + dim1b,':',dim1e,',',dim2b,':',dim2e,',',dim3b,':',dim3e, & + '), file(',dimlens(1),',',dimlens(2),',',dimlens(3),')' + call shr_sys_flush(iulog) + end if + ! + ! Get array dimension id's and sizes + ! + ierr = PIO_inq_dimid(ncid, dimname1, arraydimids(1)) + ierr = PIO_inq_dimid(ncid, dimname2, arraydimids(2)) + ierr = PIO_inq_dimid(ncid, dimname3, arraydimids(3)) + arraydimsize(1) = (dim1e - dim1b + 1) + arraydimsize(2) = (dim2e - dim2b + 1) + arraydimsize(3) = (dim3e - dim3b + 1) + + do j = 1, 3 + if (arraydimsize(j) /= size(field, j)) then + write(errormsg, *) ': Mismatch between array bounds and field size for ', & + trim(varname), ', dimension', j + call endrun(trim(subname)//errormsg) + end if + end do + + pdims = ndims + if (ndims > 4) then + call endrun(trim(subname)//': too many dimensions for '//trim(varname)) + else if (ndims < 3) then + call endrun(trim(subname)//': too few dimensions for '//trim(varname)) + else + ! Check to make sure that the fourth dimension is time + if (ndims == 4) then + ierr = pio_inq_dimname(ncid, dimids(4), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + end if + pdims = 3 + end if + end if + + if(ndims == 4) then + if(present(timelevel)) then + call pio_setframe(ncid, varid, int(timelevel,kind=pio_offset_kind)) + else + call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind)) + end if + end if + + field_dnames(1) = dimname1 + field_dnames(2) = dimname2 + field_dnames(3) = dimname3 + + if (single_column) then + ! This could be generalized but for now only handles a single point + strt(1) = dim1b + strt(2) = dim2b + strt(3) = dim3b + cnt = arraydimsize + call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + if (trim(field_dnames(1)) == 'lon') then + strt(1) = lonidx ! First dim always lon for Eulerian dycore + else + call endrun(trim(subname)//': lon should be first dimension for '//trim(varname)) + end if + if (trim(field_dnames(2)) == 'lat') then + strt(2) = latidx + else if (trim(field_dnames(3)) == 'lat') then + strt(3) = latidx + else + call endrun(trim(subname)//': lat dimension not found for '//trim(varname)) + end if + + ! Check for permuted dimensions ('out of order' array) + call calc_permutation(dimids, arraydimids, permutation, ispermuted) + if (ispermuted) then + call cam_permute_array(strt, permutation) + call cam_permute_array(cnt, permutation) + allocate(tmp3d(1:cnt(1), 1:cnt(2), 1:cnt(3))) + ierr = pio_get_var(ncid, varid, strt, cnt, tmp3d) + do k = dim3b, dim3e + do j = dim2b, dim2e + do i = dim1b, dim1e + ! We don't need strt anymore, reuse it + strt(1) = i - dim1b + 1 + strt(2) = j - dim2b + 1 + strt(3) = k - dim3b + 1 + call cam_permute_array(strt, permutation) + field(i,j,k) = tmp3d(strt(1), strt(2), strt(3)) + end do + end do + end do + deallocate(tmp3d) + else + ierr = pio_get_var(ncid, varid, strt, cnt, field) + end if + else + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:pdims), & + pio_double, iodesc, field_dnames=field_dnames, file_dnames=file_dnames(1:3)) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + end if ! end of single column + + if (masterproc) write(iulog,*) subname//': read field '//trim(varname) + + end if ! end of readvar_tmp + + readvar = readvar_tmp + + end if ! end of call infld_real_2d_3d instead + + end subroutine infld_real_3d_3d + + +end module ncdio_atm diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 new file mode 100644 index 0000000000..66c805eb59 --- /dev/null +++ b/src/control/runtime_opts.F90 @@ -0,0 +1,194 @@ +module runtime_opts + +!----------------------------------------------------------------------- +! +! Provide driver level routine for making calls to the namelist readers +! for the infrastructure and the dycore and physics parameterizations. +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 + +implicit none +private +save + +public :: read_namelist + +!======================================================================= +contains +!======================================================================= + +subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) + + use cam_initfiles, only: cam_initfiles_readnl + use constituents, only: cnst_readnl + + use phys_grid, only: phys_grid_readnl + + use chem_surfvals, only: chem_surfvals_readnl + use check_energy, only: check_energy_readnl + use radiation, only: radiation_readnl + use carma_flags_mod, only: carma_readnl + use co2_cycle, only: co2_cycle_readnl + use scamMod, only: scam_readnl + + use spmd_utils, only: spmd_utils_readnl + use cam_history, only: history_readnl + use physconst, only: physconst_readnl + use physics_buffer, only: pbuf_readnl + use phys_control, only: phys_ctl_readnl + use wv_saturation, only: wv_sat_readnl + use ref_pres, only: ref_pres_readnl + use cam3_aero_data, only: cam3_aero_data_readnl + use cam3_ozone_data, only: cam3_ozone_data_readnl + use dadadj_cam, only: dadadj_readnl + use macrop_driver, only: macrop_driver_readnl + use microp_driver, only: microp_driver_readnl + use microp_aero, only: microp_aero_readnl + use subcol, only: subcol_readnl + use cloud_fraction, only: cldfrc_readnl + use cldfrc2m, only: cldfrc2m_readnl + use rk_stratiform, only: rk_stratiform_readnl + use unicon_cam, only: unicon_cam_readnl + use zm_conv_intr, only: zm_conv_readnl + use hk_conv, only: hkconv_readnl + use uwshcu, only: uwshcu_readnl + use pkg_cld_sediment, only: cld_sediment_readnl + use gw_drag, only: gw_drag_readnl + use qbo, only: qbo_readnl + use iondrag, only: iondrag_readnl + use phys_debug_util, only: phys_debug_readnl + use conv_water, only: conv_water_readnl + use rad_constituents, only: rad_cnst_readnl + use radiation_data, only: rad_data_readnl + use modal_aer_opt, only: modal_aer_opt_readnl + use clubb_intr, only: clubb_readnl + use chemistry, only: chem_readnl + use prescribed_volcaero, only: prescribed_volcaero_readnl + use prescribed_strataero,only: prescribed_strataero_readnl + use aerodep_flx, only: aerodep_flx_readnl + use solar_data, only: solar_data_readnl + use tropopause, only: tropopause_readnl + use aoa_tracers, only: aoa_tracers_readnl + use prescribed_ozone, only: prescribed_ozone_readnl + use prescribed_aero, only: prescribed_aero_readnl + use prescribed_ghg, only: prescribed_ghg_readnl + use aircraft_emit, only: aircraft_emit_readnl + use cospsimulator_intr, only: cospsimulator_intr_readnl + use vertical_diffusion, only: vd_readnl + use rayleigh_friction, only: rayleigh_friction_readnl + + use cam_diagnostics, only: diag_readnl + use radheat, only: radheat_readnl +#if ( defined OFFLINE_DYN ) + use metdata, only: metdata_readnl +#endif + use offline_driver, only: offline_driver_readnl + use inic_analytic_utils, only: analytic_ic_readnl + use rate_diags, only: rate_diags_readnl + use tracers, only: tracers_readnl + + use dyn_comp, only: dyn_readnl + use ionosphere_interface,only: ionosphere_readnl + use qneg_module, only: qneg_readnl + + !---------------------------Arguments----------------------------------- + + character(len=*), intent(in) :: nlfilename + logical, intent(in) :: single_column + real(r8), intent(in) :: scmlat + real(r8), intent(in) :: scmlon + + !---------------------------Local variables----------------------------- + character(len=*), parameter :: subname = "read_namelist" + + !----------------------------------------------------------------------- + + ! Call subroutines for modules to read their own namelist. + ! In some cases namelist default values may depend on settings from + ! other modules, so there may be an order dependence in the following + ! calls. + ! ***N.B.*** In particular, physconst_readnl should be called before + ! the other readnl methods in case that method is used to set + ! physical constants, some of which are set at runtime + ! by the physconst_readnl method. + ! Modules that read their own namelist are responsible for making sure + ! all processes receive the values. + + call spmd_utils_readnl(nlfilename) + call phys_grid_readnl(nlfilename) + call physconst_readnl(nlfilename) +!++bee 13 Oct 2015, need to fix the pbuf_global_allocate functionality, then +! can uncomment the pbuf_readnl line +! call pbuf_readnl(nlfilename) + call cam_initfiles_readnl(nlfilename) + call cnst_readnl(nlfilename) + call history_readnl(nlfilename) + call chem_surfvals_readnl(nlfilename) + call phys_ctl_readnl(nlfilename) + call wv_sat_readnl(nlfilename) + call ref_pres_readnl(nlfilename) + call cam3_aero_data_readnl(nlfilename) + call cam3_ozone_data_readnl(nlfilename) + call dadadj_readnl(nlfilename) + call macrop_driver_readnl(nlfilename) + call microp_driver_readnl(nlfilename) + call microp_aero_readnl(nlfilename) + call clubb_readnl(nlfilename) + call subcol_readnl(nlfilename) + call cldfrc_readnl(nlfilename) + call cldfrc2m_readnl(nlfilename) + call unicon_cam_readnl(nlfilename) + call zm_conv_readnl(nlfilename) + call rk_stratiform_readnl(nlfilename) + call hkconv_readnl(nlfilename) + call uwshcu_readnl(nlfilename) + call cld_sediment_readnl(nlfilename) + call gw_drag_readnl(nlfilename) + call qbo_readnl(nlfilename) + call iondrag_readnl(nlfilename) + call phys_debug_readnl(nlfilename) + call conv_water_readnl(nlfilename) + call radiation_readnl(nlfilename) + call rad_cnst_readnl(nlfilename) + call rad_data_readnl(nlfilename) + call modal_aer_opt_readnl(nlfilename) + call chem_readnl(nlfilename) + call prescribed_volcaero_readnl(nlfilename) + call prescribed_strataero_readnl(nlfilename) + call solar_data_readnl(nlfilename) + call carma_readnl(nlfilename) + call tropopause_readnl(nlfilename) + call aoa_tracers_readnl(nlfilename) + call tracers_readnl(nlfilename) + call aerodep_flx_readnl(nlfilename) + call prescribed_ozone_readnl(nlfilename) + call prescribed_aero_readnl(nlfilename) + call prescribed_ghg_readnl(nlfilename) + call co2_cycle_readnl(nlfilename) + call aircraft_emit_readnl(nlfilename) + call cospsimulator_intr_readnl(nlfilename) + call diag_readnl(nlfilename) + call check_energy_readnl(nlfilename) + call radheat_readnl(nlfilename) + call vd_readnl(nlfilename) + call rayleigh_friction_readnl(nlfilename) +#if ( defined OFFLINE_DYN ) + call metdata_readnl(nlfilename) +#endif + call offline_driver_readnl(nlfilename) + call analytic_ic_readnl(nlfilename) + call rate_diags_readnl(nlfilename) + call scam_readnl(nlfilename, single_column, scmlat, scmlon) + + call dyn_readnl(nlfilename) + call ionosphere_readnl(nlfilename) + call qneg_readnl(nlfilename) + +end subroutine read_namelist + + +!======================================================================= + +end module runtime_opts diff --git a/src/control/sat_hist.F90 b/src/control/sat_hist.F90 new file mode 100644 index 0000000000..e59b8935db --- /dev/null +++ b/src/control/sat_hist.F90 @@ -0,0 +1,1220 @@ +!------------------------------------------------------------------------------- +! Outputs history field columns as specified by a satellite track data file +! +!------------------------------------------------------------------------------- +module sat_hist + + use perf_mod, only: t_startf, t_stopf + use shr_kind_mod, only: r8 => shr_kind_r8, cl=>shr_kind_cl + use cam_logfile, only: iulog + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use cam_history_support, only: fieldname_lenp2, max_string_len, ptapes + use spmd_utils, only: masterproc, iam + use cam_abortutils, only: endrun + + use pio, only: file_desc_t, iosystem_desc_t, var_desc_t, io_desc_t + use pio, only: pio_inq_dimid, pio_inq_varid + use pio, only: pio_seterrorhandling, pio_def_var + use pio, only: pio_inq_dimlen, pio_get_att, pio_put_att, pio_get_var, pio_put_var, pio_write_darray + use pio, only: pio_real, pio_double + use pio, only: PIO_NOWRITE, PIO_NOERR, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_GLOBAL + use spmd_utils, only: mpicom +#ifdef SPMD + use mpishorthand, only: mpichar, mpiint +#endif + use physconst, only: pi + + implicit none + + private + save + + public :: sat_hist_readnl + public :: sat_hist_init + public :: sat_hist_write + public :: sat_hist_define + public :: is_satfile + + character(len=max_string_len) :: sathist_track_infile + type(file_desc_t) :: infile + + integer :: half_step + logical :: has_sat_hist = .false. + + integer :: sathist_nclosest + integer :: sathist_ntimestep + + real(r8), allocatable :: obs_lats(:) + real(r8), allocatable :: obs_lons(:) + + logical :: doy_format + real(r8) :: first_datetime + real(r8) :: last_datetime + integer :: last_start_index + integer :: time_ndx + integer :: t_buffer_size + integer, allocatable :: date_buffer(:), time_buffer(:) + integer :: sat_tape_num=ptapes-1 + + + ! input file + integer :: n_profiles + integer :: time_vid, date_vid, lat_vid, lon_vid, instr_vid, orbit_vid, prof_vid, zenith_vid + + integer :: in_julian_vid + integer :: in_localtime_vid + integer :: in_doy_vid + integer :: in_occ_type_vid + + integer :: in_start_col + + + ! output file + type(var_desc_t) :: out_latid, out_lonid, out_dstid, out_instrid, out_zenithid, out_orbid, out_profid + type(var_desc_t) :: out_instr_lat_vid, out_instr_lon_vid + type(var_desc_t) :: out_obs_date_vid, out_obs_time_vid + type(var_desc_t) :: out_julian_vid + type(var_desc_t) :: out_localtime_vid + type(var_desc_t) :: out_doy_vid + type(var_desc_t) :: out_occ_type_vid + + logical, parameter :: debug = .false. + + real(r8), parameter :: rad2deg = 180._r8/pi ! degrees per radian + + logical :: flds_scanned = .false. + logical :: has_phys_srf_flds = .false. + logical :: has_phys_lev_flds = .false. + logical :: has_phys_ilev_flds = .false. + logical :: has_dyn_srf_flds = .false. + logical :: has_dyn_lev_flds = .false. + logical :: has_dyn_ilev_flds = .false. + +contains + +!------------------------------------------------------------------------------- + + logical function is_satfile (file_index) + integer, intent(in) :: file_index ! index of file in question + is_satfile = file_index == sat_tape_num + end function is_satfile + +!------------------------------------------------------------------------------- + subroutine sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cam_history_support, only: pflds + use cam_instance, only: inst_suffix + + implicit none + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + character(len=*), intent(inout) :: hfilename_spec(:) + character(len=*), intent(inout) :: fincl(:,:) + character(len=1), intent(inout) :: avgflag_pertape(:) + integer, intent(inout) :: mfilt(:), nhtfrq(:) + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'sat_hist_readnl' + integer :: f, fcnt + + character(len=fieldname_lenp2) :: sathist_fincl(pflds) + character(len=max_string_len) :: sathist_hfilename_spec + integer :: sathist_mfilt, sat_tape_num + + namelist /satellite_options_nl/ sathist_track_infile, sathist_hfilename_spec, sathist_fincl, & + sathist_mfilt, sathist_nclosest, sathist_ntimestep + + ! set defaults + + sathist_track_infile = ' ' + sathist_hfilename_spec = '%c.cam' // trim(inst_suffix) // '.hs.%y-%m-%d-%s.nc' + sathist_fincl(:) = ' ' + sathist_mfilt = 100000 + sathist_nclosest = 1 + sathist_ntimestep = 1 + + !read namelist options + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'satellite_options_nl', status=ierr) + if (ierr == 0) then + read(unitn, satellite_options_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! broadcast the options to all MPI tasks + call mpibcast(sathist_track_infile, len(sathist_track_infile), mpichar, 0, mpicom) + call mpibcast(sathist_hfilename_spec, len(sathist_hfilename_spec), mpichar, 0, mpicom) + call mpibcast(sathist_fincl, pflds*len(sathist_fincl(1)), mpichar, 0, mpicom) + call mpibcast(sathist_mfilt, 1, mpiint, 0, mpicom) + call mpibcast(sathist_nclosest, 1, mpiint, 0, mpicom) + call mpibcast(sathist_ntimestep, 1, mpiint, 0, mpicom) +#endif + + has_sat_hist = len_trim(sathist_track_infile) > 0 + + if (.not.has_sat_hist) return + + sat_tape_num=ptapes-1 + hfilename_spec(sat_tape_num) = sathist_hfilename_spec + mfilt(sat_tape_num) = sathist_mfilt + fcnt=0 + do f=1, pflds + fincl(f,sat_tape_num) = sathist_fincl(f) + if(len_trim(sathist_fincl(f)) > 0) then + fcnt=fcnt+1 + end if + enddo + + nhtfrq(sat_tape_num) = 1 + avgflag_pertape(sat_tape_num) = 'I' + + if(masterproc) then + write(iulog,*) 'sathist_track_infile: ',trim(sathist_track_infile) + write(iulog,*) 'sathist_hfilename_spec: ',trim(sathist_hfilename_spec) + write(iulog,*) 'sathist_fincl: ',(trim(sathist_fincl(f))//' ', f=1,fcnt) + write(iulog,*) 'max columns per file sathist_mfilt: ',sathist_mfilt + write(iulog,*) 'sathist_nclosest: ',sathist_nclosest + write(iulog,*) 'sathist_ntimestep: ',sathist_ntimestep + end if + + end subroutine sat_hist_readnl + + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine sat_hist_init + use cam_pio_utils, only: cam_pio_openfile + use ioFileMod, only: getfil + use time_manager, only: get_step_size + use string_utils, only: to_lower, GLC + + implicit none + + character(len=max_string_len) :: locfn ! Local filename + integer :: ierr, dimid + + character(len=128) :: date_format + + if (.not.has_sat_hist) return + + call getfil (sathist_track_infile, locfn) + call cam_pio_openfile(infile, locfn, PIO_NOWRITE) + + ierr = pio_inq_dimid(infile,'profs',dimid) + ierr = pio_inq_dimlen(infile, dimid, n_profiles) + + ierr = pio_inq_varid( infile, 'time', time_vid ) + ierr = pio_inq_varid( infile, 'date', date_vid ) + + ierr = pio_get_att( infile, date_vid, 'long_name', date_format) + date_format = to_lower(trim( date_format(:GLC(date_format)))) + + if ( index( date_format, 'yyyymmdd') > 0 ) then + doy_format = .false. + else if ( index( date_format, 'yyyyddd') > 0 ) then + doy_format = .true. + else + call endrun('sat_hist_init: date_format not recognized : '//trim(date_format)) + endif + + ierr = pio_inq_varid( infile, 'lat', lat_vid ) + ierr = pio_inq_varid( infile, 'lon', lon_vid ) + + call pio_seterrorhandling(infile, PIO_BCAST_ERROR) + ierr = pio_inq_varid( infile, 'instr_num', instr_vid ) + if(ierr/=PIO_NOERR) instr_vid=-1 + + ierr = pio_inq_varid( infile, 'orbit_num', orbit_vid ) + if(ierr/=PIO_NOERR) orbit_vid=-1 + + ierr = pio_inq_varid( infile, 'prof_num', prof_vid ) + if(ierr/=PIO_NOERR) prof_vid=-1 + + ierr = pio_inq_varid( infile, 'instr_sza', zenith_vid ) + if(ierr/=PIO_NOERR) zenith_vid=-1 + + ierr = pio_inq_varid( infile, 'julian', in_julian_vid ) + if(ierr/=PIO_NOERR) in_julian_vid=-1 + + ierr = pio_inq_varid( infile, 'local_time', in_localtime_vid ) + if(ierr/=PIO_NOERR) in_localtime_vid=-1 + + ierr = pio_inq_varid( infile, 'doy', in_doy_vid ) + if(ierr/=PIO_NOERR) in_doy_vid=-1 + + ierr = pio_inq_varid( infile, 'occ_type', in_occ_type_vid ) + if(ierr/=PIO_NOERR) in_occ_type_vid=-1 + + call pio_seterrorhandling(infile, PIO_INTERNAL_ERROR) + + call read_datetime( first_datetime, 1 ) + call read_datetime( last_datetime, n_profiles ) + last_start_index = -1 + t_buffer_size = min(1000,n_profiles) + allocate( date_buffer(t_buffer_size), time_buffer(t_buffer_size) ) + if (masterproc) write(iulog,*) "sathist_init:", n_profiles, first_datetime, last_datetime + if ( last_datetime= (last_start_index + t_buffer_size))) then + + start = (index - 1) / t_buffer_size * t_buffer_size + 1 + if ( start+t_buffer_size-1 <= n_profiles ) then + cnt = t_buffer_size + else + cnt = n_profiles-start+1 + endif + ierr = pio_get_var( infile, time_vid, (/ start /), (/ cnt /), time_buffer(1:cnt) ) + ierr = pio_get_var( infile, date_vid, (/ start /), (/ cnt /), date_buffer(1:cnt) ) + + last_start_index = start + endif + + ii = mod( index - 1, t_buffer_size ) + 1 + time = time_buffer(ii) + date = date_buffer(ii) + datetime = convert_date_time( date,time ) + + end subroutine read_buffered_datetime + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + function convert_date_time( date,time ) + use time_manager, only: set_time_float_from_date + + integer, intent(in) :: date,time + real(r8) :: convert_date_time + + real(r8) :: datetime + integer :: yr, doy, mon, dom + + if ( doy_format ) then + yr = date/1000 + doy = date - yr*1000 + call set_time_float_from_date( datetime, yr, 1, doy, time ) + else + yr = date/10000 + mon = (date - yr*10000)/100 + dom = date - yr*10000 - mon*100 + call set_time_float_from_date( datetime, yr, mon, dom, time ) + endif + convert_date_time = datetime + + end function convert_date_time +!------------------------------------------------------------------------------- + subroutine sat_hist_define(outfile) + use pio, only : pio_inquire + type(file_desc_t), intent(inout) :: outfile + + integer :: coldim + integer :: ierr + + ierr = pio_inquire(outfile, unlimitedDimId=coldim) + + call pio_seterrorhandling(outfile, PIO_BCAST_ERROR) + ierr = define_var( 'instr_lat', coldim, infile, lat_vid, outfile, out_instr_lat_vid ) + ierr = define_var( 'instr_lon', coldim, infile, lon_vid, outfile, out_instr_lon_vid ) + ierr = define_var( 'obs_time', coldim, infile, time_vid, outfile, out_obs_time_vid ) + ierr = define_var( 'obs_date', coldim, infile, date_vid, outfile, out_obs_date_vid ) + + ierr = pio_inq_varid( outfile, 'distance', out_dstid ) + if (ierr /= PIO_NOERR) then + ierr = pio_def_var ( outfile, 'distance', PIO_REAL, (/coldim/), out_dstid ) + ierr = pio_put_att ( outfile, out_dstid, "long_name", "distance from midpoint to observation") + ierr = pio_put_att ( outfile, out_dstid, "units", "km") + end if + + if (orbit_vid>0) then + ierr = define_var( 'orbit_num', coldim, infile, orbit_vid, outfile, out_orbid ) + endif + if (prof_vid>0) then + ierr = define_var( 'prof_num', coldim, infile, prof_vid, outfile, out_profid ) + endif + if (instr_vid>0) then + ierr = define_var( 'instr_num', coldim, infile, instr_vid, outfile, out_instrid ) + endif + if (zenith_vid>0) then + ierr = define_var( 'instr_sza', coldim, infile, zenith_vid, outfile, out_zenithid ) + endif + if (in_occ_type_vid>0) then + ierr = define_var( 'occ_type', coldim, infile, in_occ_type_vid, outfile, out_occ_type_vid ) + endif + if (in_julian_vid>0) then + ierr = define_var( 'julian', coldim, infile, in_julian_vid, outfile, out_julian_vid ) + endif + if (in_localtime_vid>0) then + ierr = define_var( 'local_time', coldim, infile, in_localtime_vid, outfile, out_localtime_vid ) + endif + if (in_doy_vid>0) then + ierr = define_var( 'doy', coldim, infile, in_doy_vid, outfile, out_doy_vid ) + endif + + call pio_seterrorhandling(outfile, PIO_INTERNAL_ERROR) + ierr=pio_put_att (outfile, PIO_GLOBAL, 'satellite_track_file', sathist_track_infile) + end subroutine sat_hist_define + +!------------------------------------------------------------------------------- + subroutine sat_hist_write( tape , nflds, nfils) + + use phys_grid, only: phys_decomp + use dyn_grid, only: dyn_decomp + use cam_history_support, only : active_entry + use pio, only : pio_file_is_open + implicit none + type(active_entry) :: tape + integer, intent(in) :: nflds + integer, intent(inout) :: nfils + + integer :: ncols, nocols + integer :: ierr + + integer, allocatable :: col_ndxs(:) + integer, allocatable :: chk_ndxs(:) + integer, allocatable :: fdyn_ndxs(:) + integer, allocatable :: ldyn_ndxs(:) + integer, allocatable :: phs_owners(:) + integer, allocatable :: dyn_owners(:) + real(r8),allocatable :: mlats(:) + real(r8),allocatable :: mlons(:) + real(r8),allocatable :: phs_dists(:) + + integer :: coldim + logical :: has_dyn_flds + + if (.not.has_sat_hist) return + + call read_next_position( ncols ) + + if ( ncols < 1 ) return + + call t_startf ('sat_hist_write') + + ! The n closest columns to the observation will be output, + ! so increase the size of the columns used for output/ + nocols = ncols * sathist_nclosest + + allocate( col_ndxs(nocols) ) + allocate( chk_ndxs(nocols) ) + allocate( fdyn_ndxs(nocols) ) + allocate( ldyn_ndxs(nocols) ) + allocate( phs_owners(nocols) ) + allocate( dyn_owners(nocols) ) + allocate( mlats(nocols) ) + allocate( mlons(nocols) ) + allocate( phs_dists(nocols) ) + + call scan_flds( tape, nflds ) + has_dyn_flds = has_dyn_srf_flds .or. has_dyn_lev_flds .or. has_dyn_ilev_flds + + call get_indices( obs_lats, obs_lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_ndxs, & + fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners, mlats, mlons, phs_dists ) + + if ( .not. pio_file_is_open(tape%File) ) then + call endrun('sat file not open') + endif + + + ierr = pio_inq_dimid(tape%File,'ncol',coldim ) + + ierr = pio_inq_varid(tape%File, 'lat', out_latid ) + ierr = pio_inq_varid(tape%File, 'lon', out_lonid ) + ierr = pio_inq_varid(tape%File, 'distance', out_dstid ) + + call write_record_coord( tape, mlats(:), mlons(:), phs_dists(:), ncols, nfils ) + + ! dump columns of 2D fields + if (has_phys_srf_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + col_ndxs, chk_ndxs, phs_owners, phys_decomp ) + endif + if (has_dyn_srf_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) + endif + + ! dump columns of 3D fields defined on mid pres levels + if (has_phys_lev_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + col_ndxs, chk_ndxs, phs_owners, phys_decomp ) + endif + if (has_dyn_lev_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) + endif + + ! dump columns of 3D fields defined on interface pres levels + if (has_phys_ilev_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + col_ndxs, chk_ndxs, phs_owners, phys_decomp ) + endif + if (has_dyn_ilev_flds) then + call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) + endif + + deallocate( col_ndxs, chk_ndxs, fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners ) + deallocate( mlons, mlats, phs_dists ) + deallocate( obs_lons, obs_lats ) + + nfils = nfils + nocols + + call t_stopf ('sat_hist_write') + + end subroutine sat_hist_write + +!------------------------------------------------------------------------------- + subroutine dump_columns( File, hitems, nflds, ncols, nlevs, nfils, fdims, ldims, owners, decomp ) + use cam_history_support, only: field_info, hentry, fillvalue + use pio, only: pio_setframe, pio_offset_kind + + type(File_desc_t),intent(inout) :: File + type(hentry), intent(in), target :: hitems(:) + integer, intent(in) :: nflds + integer, intent(in) :: ncols + integer, intent(in) :: nlevs + integer, intent(in) :: nfils + integer, intent(in) :: fdims(:) + integer, intent(in) :: ldims(:) + integer, intent(in) :: owners(:) + integer, intent(in) :: decomp + + + type(field_info), pointer :: field + type(var_desc_t) :: vardesc + type(iosystem_desc_t), pointer :: sat_iosystem + integer :: ierr + + type(io_desc_t), pointer :: iodesc + real(r8), allocatable :: buf(:) + integer :: i,k,f, cnt + + call t_startf ('sat_hist::dump_columns') + + sat_iosystem => File%iosystem + + cnt = 0 + + do i = 1,ncols + do k = 1,nlevs + if ( iam == owners(i) ) then + cnt = cnt+1 + endif + enddo + enddo + allocate( buf(cnt) ) + + iodesc => create_iodesc( File, ncols, nlevs, owners ) + + do f = 1,nflds + field => hitems(f)%field + + if (field%numlev==nlevs .and. field%decomp_type==decomp) then + vardesc = hitems(f)%varid(1) + + cnt = 0 + buf = fillvalue + do i = 1,ncols + do k = 1,nlevs + if ( iam == owners(i) ) then + cnt = cnt+1 + buf(cnt) = hitems(f)%hbuf( fdims(i), k, ldims(i) ) + endif + enddo + enddo + + call pio_setframe(File, vardesc, int(nfils,kind=pio_offset_kind)) ! sets varsesc -- correct offset + call pio_write_darray(File, vardesc, iodesc, buf, ierr, fillval=fillvalue) + endif + + enddo + + call destroy_iodesc( File, iodesc ) + + deallocate( buf ) + + call t_stopf ('sat_hist::dump_columns') + + end subroutine dump_columns + +!------------------------------------------------------------------------------- +! creates an iodesc object +!------------------------------------------------------------------------------- + function create_iodesc( File, ncols, nlevs, owners ) result(iodesc) + use pio, only: pio_initdecomp, PIO_REARR_SUBSET + + ! args + type(File_desc_t),intent(inout) :: File + integer, intent(in) :: ncols + integer, intent(in) :: nlevs + integer, intent(in) :: owners(:) + + ! returned pointer + type(io_desc_t), pointer :: iodesc + + ! local vars + integer :: i,k, cnt + integer, allocatable :: dof(:) + integer, allocatable :: dimlens(:) + integer :: ndims + + if (nlevs >1) then + ndims = 2 + else + ndims = 1 + endif + allocate (dimlens(ndims)) + dimlens(:) = ncols + if (nlevs >1) then + dimlens(1) = nlevs + endif + + cnt = 0 + + do i = 1,ncols + do k = 1,nlevs + if ( iam == owners(i) ) then + cnt = cnt+1 + endif + enddo + enddo + allocate(dof(cnt)) + dof = 0 + cnt = 0 + do i = 1,ncols + do k = 1,nlevs + if ( iam == owners(i) ) then + cnt = cnt+1 + dof(cnt) = k + (i-1)*nlevs + endif + enddo + enddo + + allocate(iodesc) + call pio_initdecomp(File%iosystem, pio_double, dimlens, dof, iodesc, rearr=PIO_REARR_SUBSET ) + + deallocate( dof ) + deallocate( dimlens ) + + end function create_iodesc + +!------------------------------------------------------------------------------- +! cleans up iodesc obj +!------------------------------------------------------------------------------- + subroutine destroy_iodesc( File, iodesc ) + use pio, only: pio_freedecomp + + type(File_desc_t),intent(inout) :: File + type(io_desc_t), pointer :: iodesc + + call pio_freedecomp(File, iodesc) + deallocate(iodesc) + end subroutine destroy_iodesc + +!------------------------------------------------------------------------------- +! scan the fields for possible different decompositions +!------------------------------------------------------------------------------- + subroutine scan_flds( tape, nflds ) + use cam_history_support, only : active_entry + use phys_grid, only: phys_decomp + use dyn_grid, only: dyn_decomp + + type(active_entry), intent(in) :: tape + integer, intent(in) :: nflds + + integer :: f + character(len=cl) :: msg1, msg2 + + if (flds_scanned) return + + do f = 1,nflds + if ( tape%hlist(f)%field%decomp_type == phys_decomp ) then + if ( tape%hlist(f)%field%numlev == 1 ) then + has_phys_srf_flds = .true. + elseif ( tape%hlist(f)%field%numlev == pver ) then + has_phys_lev_flds = .true. + elseif ( tape%hlist(f)%field%numlev == pverp ) then + has_phys_ilev_flds = .true. + else + call endrun('sat_hist::scan_flds numlev error : '//tape%hlist(f)%field%name) + endif + elseif ( tape%hlist(f)%field%decomp_type == dyn_decomp ) then + if ( tape%hlist(f)%field%numlev == 1 ) then + has_dyn_srf_flds = .true. + elseif ( tape%hlist(f)%field%numlev == pver ) then + has_dyn_lev_flds = .true. + elseif ( tape%hlist(f)%field%numlev == pverp ) then + has_dyn_ilev_flds = .true. + else + call endrun('sat_hist::scan_flds numlev error : '//tape%hlist(f)%field%name) + endif + else + call endrun('sat_hist::scan_flds decomp_type error : '//tape%hlist(f)%field%name) + endif + + ! Check that the only "mdim" is the vertical coordinate. + if (has_phys_srf_flds .or. has_phys_lev_flds .or. has_phys_ilev_flds .or. & + has_dyn_srf_flds .or. has_dyn_lev_flds .or. has_dyn_ilev_flds) then + ! The mdims pointer is unassociated on a restart. The restart initialization + ! should be fixed rather than requiring the check to make sure it is associated. + if (associated(tape%hlist(f)%field%mdims)) then + if (size(tape%hlist(f)%field%mdims) > 1) then + msg1 = 'sat_hist::scan_flds mdims error :'//tape%hlist(f)%field%name + msg2 = trim(msg1)//' has mdims in addition to the vertical coordinate.'//& + new_line('a')//' This is not currently supported.' + write(iulog,*) msg2 + call endrun(msg1) + end if + end if + end if + + enddo + + flds_scanned = .true. + end subroutine scan_flds + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine read_next_position( ncols ) + use time_manager, only: get_curr_date + use time_manager, only: set_time_float_from_date + + implicit none + + integer, intent(out) :: ncols + + integer :: ierr + integer :: yr, mon, day, tod + real(r8) :: begdatetime, enddatetime + integer :: beg_ndx, end_ndx, i + + real(r8) :: datetime + + call get_curr_date(yr, mon, day, tod) + call set_time_float_from_date(begdatetime, yr, mon, day, tod-half_step*sathist_ntimestep) + call set_time_float_from_date(enddatetime, yr, mon, day, tod+half_step*sathist_ntimestep) + + ncols = 0 + + if ( first_datetime > enddatetime ) then + if (masterproc) write(iulog,'(a,2f16.6)') & + 'sat_hist->read_next_position: all of the satellite date times are after the time window', first_datetime, enddatetime + return + endif + if ( last_datetime < begdatetime ) then + if (masterproc) write(iulog,'(a,2f16.6)') & + 'sat_hist->read_next_position: all of the satellite date times are before the time window', begdatetime, last_datetime + return + endif + + call t_startf ('sat_hist::read_next_position') + + beg_ndx = -99 + end_ndx = -99 + + bnds_loop: do i = time_ndx,n_profiles + + call read_buffered_datetime( datetime, i ) + + if ( datetime>begdatetime .and. beg_ndx<0 ) beg_ndx = i + if ( datetime>enddatetime ) exit bnds_loop + end_ndx = i + enddo bnds_loop + + if (beg_ndx == -99 .and. end_ndx== -99) then + if (masterproc) write(iulog,'(a)') 'sat_hist->read_next_position: must be beyond last position -- returning.' + return + endif + + ! Advance the search forward, but because of ntimesteps, it is possible + ! for observations used here to be used again. However, we should not go + ! back before the previous beginning time. + if (beg_ndx>0) time_ndx = beg_ndx + + ncols = end_ndx-beg_ndx+1 + if (ncols > 0) then + allocate( obs_lats(ncols), obs_lons(ncols) ) + in_start_col = beg_ndx + + ierr = pio_get_var( infile, lat_vid, (/beg_ndx/), (/ncols/), obs_lats ) + ierr = pio_get_var( infile, lon_vid, (/beg_ndx/), (/ncols/), obs_lons ) + + endif + + call t_stopf ('sat_hist::read_next_position') + end subroutine read_next_position + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine write_record_coord( tape, mod_lats, mod_lons, mod_dists, ncols, nfils ) + + use time_manager, only: get_curr_date, get_curr_time + use cam_history_support, only : active_entry + implicit none + type(active_entry), intent(inout) :: tape + + integer, intent(in) :: ncols + real(r8), intent(in) :: mod_lats(ncols * sathist_nclosest) + real(r8), intent(in) :: mod_lons(ncols * sathist_nclosest) + real(r8), intent(in) :: mod_dists(ncols * sathist_nclosest) + integer, intent(in) :: nfils + + integer :: ierr, i + integer :: yr, mon, day ! year, month, and day components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + integer :: ndcur ! day component of current time + integer :: nscur ! seconds component of current time + real(r8) :: time ! current time + integer, allocatable :: itmp(:) + real(r8), allocatable :: rtmp(:) + real(r8), allocatable :: out_lats(:) + real(r8), allocatable :: out_lons(:) + + call t_startf ('sat_hist::write_record_coord') + + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + call get_curr_time(ndcur, nscur) + + + time = ndcur + nscur/86400._r8 + + allocate( itmp(ncols * sathist_nclosest) ) + allocate( rtmp(ncols * sathist_nclosest) ) + + itmp(:) = ncdate + ierr = pio_put_var(tape%File, tape%dateid,(/nfils/), (/ncols * sathist_nclosest/),itmp) + itmp(:) = ncsec + ierr = pio_put_var(tape%File, tape%datesecid,(/nfils/),(/ncols * sathist_nclosest/),itmp) + rtmp(:) = time + ierr = pio_put_var(tape%File, tape%timeid, (/nfils/),(/ncols * sathist_nclosest/),rtmp) + + deallocate(itmp) + deallocate(rtmp) + + ! output model column coordinates + ierr = pio_put_var(tape%File, out_latid, (/nfils/),(/ncols * sathist_nclosest/), mod_lats) + ierr = pio_put_var(tape%File, out_lonid, (/nfils/),(/ncols * sathist_nclosest/), mod_lons) + ierr = pio_put_var(tape%File, out_dstid, (/nfils/),(/ncols * sathist_nclosest/), mod_dists / 1000._r8) + + ! output instrument location + allocate( out_lats(ncols * sathist_nclosest) ) + allocate( out_lons(ncols * sathist_nclosest) ) + + do i = 1, ncols + out_lats(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = obs_lats(i) + out_lons(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = obs_lons(i) + enddo + + ierr = pio_put_var(tape%File, out_instr_lat_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lats) + ierr = pio_put_var(tape%File, out_instr_lon_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lons) + + deallocate(out_lats) + deallocate(out_lons) + + + ierr = copy_data( infile, date_vid, tape%File, out_obs_date_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, time_vid, tape%File, out_obs_time_vid, in_start_col, nfils, ncols ) + + ! output observation identifiers + if (instr_vid>0) then + ierr = copy_data( infile, instr_vid, tape%File, out_instrid, in_start_col, nfils, ncols ) + endif + if (orbit_vid>0) then + ierr = copy_data( infile, orbit_vid, tape%File, out_orbid, in_start_col, nfils, ncols ) + endif + if (prof_vid>0) then + ierr = copy_data( infile, prof_vid, tape%File, out_profid, in_start_col, nfils, ncols ) + endif + if (zenith_vid>0) then + ierr = copy_data( infile, zenith_vid, tape%File, out_zenithid, in_start_col, nfils, ncols ) + endif + if (in_julian_vid>0) then + ierr = copy_data( infile, in_julian_vid, tape%File, out_julian_vid, in_start_col, nfils, ncols ) + endif + if (in_occ_type_vid>0) then + ierr = copy_data( infile, in_occ_type_vid, tape%File, out_occ_type_vid, in_start_col, nfils, ncols ) + endif + if (in_localtime_vid>0) then + ierr = copy_data( infile, in_localtime_vid, tape%File, out_localtime_vid, in_start_col, nfils, ncols ) + endif + if (in_doy_vid>0) then + ierr = copy_data( infile, in_doy_vid, tape%File, out_doy_vid, in_start_col, nfils, ncols ) + endif + + call t_stopf ('sat_hist::write_record_coord') + end subroutine write_record_coord + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine get_indices( lats, lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_ndxs, & + fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners, mlats, mlons, phs_dists ) + + use dyn_grid, only : dyn_grid_get_colndx + + integer, intent(in) :: ncols + real(r8), intent(in) :: lats(ncols) + real(r8), intent(in) :: lons(ncols) + integer, intent(in) :: nocols + logical, intent(in) :: has_dyn_flds + integer, intent(out) :: col_ndxs(nocols) + integer, intent(out) :: chk_ndxs(nocols) + integer, intent(out) :: fdyn_ndxs(nocols) + integer, intent(out) :: ldyn_ndxs(nocols) + integer, intent(out) :: phs_owners(nocols) + integer, intent(out) :: dyn_owners(nocols) + real(r8), intent(out) :: mlats(nocols) + real(r8), intent(out) :: mlons(nocols) + real(r8), intent(out) :: phs_dists(nocols) + + integer :: i, j, ndx + real(r8) :: lat, lon + + integer, allocatable :: ichks(:),icols(:),idyn1s(:),idyn2s(:), iphs_owners(:), idyn_owners(:) + real(r8), allocatable :: rlats(:), rlons(:), plats(:), plons(:), iphs_dists(:) + + integer :: gcols(sathist_nclosest) + + call t_startf ('sat_hist::get_indices') + + allocate(ichks(sathist_nclosest),icols(sathist_nclosest),idyn1s(sathist_nclosest), & + idyn2s(sathist_nclosest),iphs_owners(sathist_nclosest),idyn_owners(sathist_nclosest)) + allocate(rlats(sathist_nclosest), rlons(sathist_nclosest), plats(sathist_nclosest), & + plons(sathist_nclosest), iphs_dists(sathist_nclosest) ) + + col_ndxs = -1 + chk_ndxs = -1 + fdyn_ndxs = -1 + ldyn_ndxs = -1 + phs_owners = -1 + dyn_owners = -1 + phs_dists = -1 + + ndx = 0 + do i = 1,ncols + + lat = lats(i) + lon = lons(i) + + if ( lon >= 360._r8) then + lon = lon-360._r8 + endif + if ( lon < 0._r8) then + lon = lon+360._r8 + endif + if (lat<-90._r8 .or. lat>90._r8) then + write(iulog,*) 'sat_hist::get_indices lat = ',lat + call endrun('sat_hist::get_indices : lat must be between -90 and 90 degrees (-90<=lat<=90)') + endif + if (lon<0._r8 .or. lon>=360._r8) then + write(iulog,*) 'sat_hist::get_indices lon = ',lon + call endrun('sat_hist::get_indices : lon must be between 0 and 360 degrees (0<=lon<360)') + endif + + call find_cols( lat, lon, sathist_nclosest, iphs_owners, ichks, icols, & + gcols, iphs_dists, plats, plons ) + + if (has_dyn_flds) then + call dyn_grid_get_colndx( gcols, sathist_nclosest, idyn_owners, idyn1s, idyn2s ) + endif + + do j = 1, sathist_nclosest + + if (debug .and. iam==iphs_owners(j) ) then + if ( abs(plats(j)-rlats(j))>1.e-3_r8 ) then + write(*,'(a,3f20.12)') ' lat, plat, rlat = ', lat, plats(j), rlats(j) + write(*,'(a,3f20.12)') ' lon, plon, rlon = ', lon, plons(j), rlons(j) + call endrun('sat_hist::get_indices: dyn lat is different than phys lat ') + endif + if ( abs(plons(j)-rlons(j))>1.e-3_r8 ) then + write(*,'(a,3f20.12)') ' lat, plat, rlat = ', lat, plats(j), rlats(j) + write(*,'(a,3f20.12)') ' lon, plon, rlon = ', lon, plons(j), rlons(j) + call endrun('sat_hist::get_indices: dyn lon is different than phys lon ') + endif + endif + + ndx = ndx+1 + + chk_ndxs(ndx) = ichks(j) + col_ndxs(ndx) = icols(j) + fdyn_ndxs(ndx) = idyn1s(j) + ldyn_ndxs(ndx) = idyn2s(j) + mlats(ndx) = plats(j) + mlons(ndx) = plons(j) + phs_owners(ndx) = iphs_owners(j) + dyn_owners(ndx) = idyn_owners(j) + phs_dists(ndx) = iphs_dists(j) + enddo + enddo + + deallocate(ichks, icols, idyn1s, idyn2s, iphs_owners, idyn_owners) + deallocate(rlats, rlons, plats, plons, iphs_dists ) + + call t_stopf ('sat_hist::get_indices') + end subroutine get_indices + +!------------------------------------------------------------------------------- +! utility function +!------------------------------------------------------------------------------- + integer function define_var( var_name, coldim, infile, in_vid, outfile, out_id ) result(res) + + use pio, only: pio_inq_vartype + + character(len=*), intent(in) :: var_name + integer, intent(in) :: coldim + type(File_desc_t),intent(inout) :: infile + type(File_desc_t),intent(inout) :: outfile + integer, intent(in) :: in_vid + type(var_desc_t), intent(out):: out_id + + integer :: type + + res = pio_inq_varid( outfile, var_name, out_id ) + if(res/=PIO_NOERR) then + + res = pio_inq_vartype( infile, in_vid, type ) + + res = pio_def_var ( outfile, var_name, type, (/coldim/), out_id ) + + res = copy_att( infile, in_vid, 'long_name', outfile, out_id ) + res = copy_att( infile, in_vid, 'units', outfile, out_id ) + + endif + + end function define_var + +!------------------------------------------------------------------------------- +! utility function +!------------------------------------------------------------------------------- + integer function copy_data( infile, in_vid, outfile, out_id, instart, outstart, ncols ) result(res) + + type(File_desc_t),intent(in) :: infile + type(File_desc_t),intent(inout) :: outfile + integer, intent(in) :: in_vid + type(var_desc_t), intent(in) :: out_id + integer, intent(in) :: instart, outstart, ncols + + real(r8), allocatable :: data(:) + real(r8), allocatable :: outdata(:) + integer :: i + + allocate( data(ncols) ) + + res = pio_get_var( infile, in_vid, (/instart/), (/ncols/), data ) + + allocate( outdata(ncols * sathist_nclosest) ) + + do i = 1, ncols + outdata(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = data(i) + enddo + + res = pio_put_var( outfile, out_id, (/outstart/), (/ncols * sathist_nclosest/), outdata ) + + deallocate(outdata) + deallocate(data) + + end function copy_data + +!------------------------------------------------------------------------------- +! utility function +! -- should be able to use pio_copy_att which does not seem to work +!------------------------------------------------------------------------------- + integer function copy_att( infile, in_vid, att_name, outfile, out_id ) result(res) + + type(File_desc_t),intent(inout) :: infile + type(File_desc_t),intent(inout) :: outfile + character(len=*), intent(in) :: att_name + integer, intent(in) :: in_vid + type(var_desc_t), intent(in) :: out_id + + character(len=1024) :: att + + + res = pio_get_att( infile, in_vid, trim(att_name), att ) + if (res==PIO_NOERR) then + res = pio_put_att ( outfile, out_id, trim(att_name), trim(att)) + endif + + + end function copy_att + + !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats, mlons) + use physconst, only: rearth + use phys_grid, only: get_rlon_all_p, get_rlat_all_p, get_gcol_p, get_ncols_p + use spmd_utils, only: iam, npes, mpi_integer, mpi_real8, mpicom + + real(r8),intent(in) :: lat, lon ! requested location in degrees + integer, intent(in) :: nclosest ! number of closest points to find + integer, intent(out) :: owner(nclosest) ! rank of chunk owner + integer, intent(out) :: lcid(nclosest) ! local chunk index + integer, intent(out) :: icol(nclosest) ! column index within the chunk + integer, intent(out) :: gcol(nclosest) ! global column index + real(r8),intent(out) :: distmin(nclosest) ! the distance (m) of the closest column(s) + real(r8),intent(out) :: mlats(nclosest) ! the latitude of the closest column(s) + real(r8),intent(out) :: mlons(nclosest) ! the longitude of the closest column(s) + + real(r8) :: dist + real(r8) :: rlats(pcols), rlons(pcols) + real(r8) :: latr, lonr + + integer :: my_owner(nclosest) + integer :: my_lcid(nclosest) + integer :: my_icol(nclosest) + integer :: my_gcol(nclosest) + real(r8) :: my_distmin(nclosest) + real(r8) :: my_mlats(nclosest) + real(r8) :: my_mlons(nclosest) + + integer :: c, i, j, k, ierr, ncols, mindx(1) + real(r8) :: sendbufr(3) + real(r8) :: recvbufr(3,npes) + integer :: sendbufi(4) + integer :: recvbufi(4,npes) + + call t_startf ('sat_hist::find_cols') + + latr = lat/rad2deg ! to radians + lonr = lon/rad2deg ! to radians + + my_owner(:) = -999 + my_lcid(:) = -999 + my_icol(:) = -999 + my_gcol(:) = -999 + my_mlats(:) = -999 + my_mlons(:) = -999 + my_distmin(:) = 1.e10_r8 + + chk_loop: do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, rlats) + call get_rlon_all_p(c, pcols, rlons) + + col_loop: do i = 1,ncols + ! Use the Spherical Law of Cosines to find the great-circle distance. + dist = acos(sin(latr) * sin(rlats(i)) + cos(latr) * cos(rlats(i)) * cos(rlons(i) - lonr)) * rearth + + closest_loop: do j = nclosest, 1, -1 + if (dist < my_distmin(j)) then + + if (j < nclosest) then + my_distmin(j+1) = my_distmin(j) + my_owner(j+1) = my_owner(j) + my_lcid(j+1) = my_lcid(j) + my_icol(j+1) = my_icol(j) + my_gcol(j+1) = my_gcol(j) + my_mlats(j+1) = my_mlats(j) + my_mlons(j+1) = my_mlons(j) + end if + + my_distmin(j) = dist + my_owner(j) = iam + my_lcid(j) = c + my_icol(j) = i + my_gcol(j) = get_gcol_p(c,i) + my_mlats(j) = rlats(i) * rad2deg + my_mlons(j) = rlons(i) * rad2deg + else + exit + end if + enddo closest_loop + + enddo col_loop + enddo chk_loop + + k = 1 + + do j = 1, nclosest + + sendbufr(1) = my_distmin(k) + sendbufr(2) = my_mlats(k) + sendbufr(3) = my_mlons(k) + + call mpi_allgather( sendbufr, 3, mpi_real8, recvbufr, 3, mpi_real8, mpicom, ierr ) + + mindx = minloc(recvbufr(1,:)) + distmin(j) = recvbufr(1,mindx(1)) + mlats(j) = recvbufr(2,mindx(1)) + mlons(j) = recvbufr(3,mindx(1)) + + sendbufi(1) = my_owner(k) + sendbufi(2) = my_lcid(k) + sendbufi(3) = my_icol(k) + sendbufi(4) = my_gcol(k) + + call mpi_allgather( sendbufi, 4, mpi_integer, recvbufi, 4, mpi_integer, mpicom, ierr ) + + owner(j) = recvbufi(1,mindx(1)) + lcid(j) = recvbufi(2,mindx(1)) + icol(j) = recvbufi(3,mindx(1)) + gcol(j) = recvbufi(4,mindx(1)) + + if ( iam == owner(j) ) then + k = k+1 + endif + + enddo + + call t_stopf ('sat_hist::find_cols') + + end subroutine find_cols + +end module sat_hist diff --git a/src/control/scamMod.F90 b/src/control/scamMod.F90 new file mode 100644 index 0000000000..b3676b02b1 --- /dev/null +++ b/src/control/scamMod.F90 @@ -0,0 +1,312 @@ +module scamMod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use pmgrid, only: plon, plat, plev, plevp +use constituents, only: pcnst +use shr_scam_mod, only: shr_scam_getCloseLatLon +use dycore, only: dycore_is +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private + +! PUBLIC INTERFACES: + +public scam_readnl ! read SCAM namelist options + +! PUBLIC MODULE DATA: + +real(r8), public :: pressure_levels(plev) +real(r8), public :: scmlat ! input namelist latitude for scam +real(r8), public :: scmlon ! input namelist longitude for scam + + +integer, parameter :: num_switches = 20 +integer, parameter :: max_path_len = 128 + +logical, public :: single_column ! Using IOP file or not +logical, public :: use_iop ! Using IOP file or not +logical, public :: use_analysis +logical, public :: use_saveinit +logical, public :: use_pert_init ! perturb initial values +logical, public :: use_pert_frc ! perturb forcing +logical, public :: switch(num_switches) ! Logical flag settings from GUI +logical, public :: l_uvphys ! If true, update u/v after TPHYS +logical, public :: l_uvadvect ! If true, T, U & V will be passed to SLT +logical, public :: l_conv ! use flux divergence terms for T and q? +logical, public :: l_divtr ! use flux divergence terms for constituents? +logical, public :: l_diag ! do we want available diagnostics? + +integer, public :: error_code ! Error code from netCDF reads +integer, public :: initTimeIdx +integer, public :: seedval + +character*(max_path_len), public :: modelfile +character*(max_path_len), public :: analysisfile +character*(max_path_len), public :: sicfile +character*(max_path_len), public :: userfile +character*(max_path_len), public :: sstfile +character*(max_path_len), public :: lsmpftfile +character*(max_path_len), public :: pressfile +character*(max_path_len), public :: topofile +character*(max_path_len), public :: ozonefile +character*(max_path_len), public :: iopfile +character*(max_path_len), public :: absemsfile +character*(max_path_len), public :: aermassfile +character*(max_path_len), public :: aeropticsfile +character*(max_path_len), public :: timeinvfile +character*(max_path_len), public :: lsmsurffile +character*(max_path_len), public :: lsminifile + +! note that scm_zadv_q is set to slt to be consistent with CAM BFB testing + + +character(len=16), public :: scm_zadv_T = 'eulc ' +character(len=16), public :: scm_zadv_q = 'slt ' +character(len=16), public :: scm_zadv_uv = 'eulc ' + +real(r8), public :: fixmascam +real(r8), public :: betacam +real(r8), public :: alphacam(pcnst) +real(r8), public :: dqfxcam(plon,plev,pcnst) + +real(r8), public :: divq3d(plev,pcnst) ! 3D q advection +real(r8), public :: divt3d(plev) ! 3D T advection +real(r8), public :: divu3d(plev) ! 3D U advection +real(r8), public :: divv3d(plev) ! 3D V advection +real(r8), public :: vertdivq(plev,pcnst)! vertical q advection +real(r8), public :: vertdivt(plev) ! vertical T advection +real(r8), public :: vertdivu(plev) ! vertical T advection +real(r8), public :: vertdivv(plev) ! vertical T advection +real(r8), public :: ptend ! surface pressure tendency +real(r8), public :: qdiff(plev) ! model minus observed humidity +real(r8), public :: qobs(plev) ! actual W.V. Mixing ratio +real(r8), public :: qinitobs(plev,pcnst)! initial tracer field +real(r8), public :: cldliqobs(plev) ! actual W.V. Mixing ratio +real(r8), public :: cldiceobs(plev) ! actual W.V. Mixing ratio +real(r8), public :: numliqobs(plev) ! actual +real(r8), public :: numiceobs(plev) ! actual +real(r8), public :: precobs(1) ! observed precipitation +real(r8), public :: lhflxobs(1) ! observed surface latent heat flux +real(r8), public :: shflxobs(1) ! observed surface sensible heat flux +real(r8), public :: q1obs(plev) ! observed apparent heat source +real(r8), public :: q2obs(plev) ! observed apparent heat sink +real(r8), public :: tdiff(plev) ! model minus observed temp +real(r8), public :: tground(1) ! ground temperature +real(r8), public :: tobs(plev) ! actual temperature +real(r8), public :: tsair(1) ! air temperature at the surface +real(r8), public :: udiff(plev) ! model minus observed uwind +real(r8), public :: uobs(plev) ! actual u wind +real(r8), public :: vdiff(plev) ! model minus observed vwind +real(r8), public :: vobs(plev) ! actual v wind +real(r8), public :: cldobs(plev) ! observed cld +real(r8), public :: clwpobs(plev) ! observed clwp +real(r8), public :: aldirobs(1) ! observed aldir +real(r8), public :: aldifobs(1) ! observed aldif +real(r8), public :: asdirobs(1) ! observed asdir +real(r8), public :: asdifobs(1) ! observed asdif + +real(r8), public :: wfld(plev) ! Vertical motion (slt) +real(r8), public :: wfldh(plevp) ! Vertical motion (slt) +real(r8), public :: divq(plev,pcnst) ! Divergence of moisture +real(r8), public :: divt(plev) ! Divergence of temperature +real(r8), public :: divu(plev) ! Horiz Divergence of E/W +real(r8), public :: divv(plev) ! Horiz Divergence of N/S + ! mo_drydep algorithm +real(r8), public, pointer :: loniop(:) +real(r8), public, pointer :: latiop(:) + +integer, public :: iopTimeIdx ! index into iop dataset +integer, public :: steplength ! Length of time-step +integer, public :: base_date ! Date in (yyyymmdd) of start time +integer, public :: base_secs ! Time of day of start time (sec) + +! SCAM public data defaults + +logical, public :: doiopupdate = .false. ! do we need to read next iop timepoint +logical, public :: have_lhflx = .false. ! dataset contains lhflx +logical, public :: have_shflx = .false. ! dataset contains shflx +logical, public :: have_tg = .false. ! dataset contains tg +logical, public :: have_tsair = .false. ! dataset contains tsair +logical, public :: have_divq = .false. ! dataset contains divq +logical, public :: have_divt = .false. ! dataset contains divt +logical, public :: have_divq3d = .false. ! dataset contains divq3d +logical, public :: have_vertdivu = .false. ! dataset contains vertdivu +logical, public :: have_vertdivv = .false. ! dataset contains vertdivv +logical, public :: have_vertdivt = .false. ! dataset contains vertdivt +logical, public :: have_vertdivq = .false. ! dataset contains vertdivq +logical, public :: have_divt3d = .false. ! dataset contains divt3d +logical, public :: have_divu3d = .false. ! dataset contains divu3d +logical, public :: have_divv3d = .false. ! dataset contains divv3d +logical, public :: have_divu = .false. ! dataset contains divu +logical, public :: have_divv = .false. ! dataset contains divv +logical, public :: have_omega = .false. ! dataset contains omega +logical, public :: have_phis = .false. ! dataset contains phis +logical, public :: have_ptend = .false. ! dataset contains ptend +logical, public :: have_ps = .false. ! dataset contains ps +logical, public :: have_q = .false. ! dataset contains q +logical, public :: have_q1 = .false. ! dataset contains Q1 +logical, public :: have_q2 = .false. ! dataset contains Q2 +logical, public :: have_prec = .false. ! dataset contains prec +logical, public :: have_t = .false. ! dataset contains t +logical, public :: have_u = .false. ! dataset contains u +logical, public :: have_v = .false. ! dataset contains v +logical, public :: have_cld = .false. ! dataset contains cld +logical, public :: have_cldliq = .false. ! dataset contains cldliq +logical, public :: have_cldice = .false. ! dataset contains cldice +logical, public :: have_numliq = .false. ! dataset contains numliq +logical, public :: have_numice = .false. ! dataset contains numice +logical, public :: have_clwp = .false. ! dataset contains clwp +logical, public :: have_aldir = .false. ! dataset contains aldir +logical, public :: have_aldif = .false. ! dataset contains aldif +logical, public :: have_asdir = .false. ! dataset contains asdir +logical, public :: have_asdif = .false. ! dataset contains asdif +logical, public :: use_camiop = .false. ! use cam generated forcing +logical, public :: use_3dfrc = .false. ! use 3d forcing +logical, public :: use_userdata = .false. +logical, public :: isrestart = .false. ! If this is a restart step or not + +! SCAM namelist defaults + +logical, public :: scm_relaxation = .false. ! Use relaxation +logical, public :: scm_crm_mode = .false. ! Use column radiation mode +logical, public :: scm_cambfb_mode = .false. ! Use extra CAM IOP fields to assure bit for bit match with CAM run +logical, public :: scm_use_obs_T = .false. ! Use the SCAM-IOP specified observed T at each time step instead of forecasting. +logical, public :: scm_force_latlon = .false. ! force scam to use the lat lon fields specified in the scam namelist not what is closest to iop avail lat lon +real*8, public :: scm_relax_top_p = 1.e36_r8 ! upper bound for scm relaxation +real*8, public :: scm_relax_bot_p = -1.e36_r8 ! lower bound for scm relaxation +real*8, public :: scm_relax_tau_sec = 10800._r8 ! relaxation time constant (sec) + +! +++BPM: +! modification... allow a linear ramp in relaxation time scale: +logical, public :: scm_relax_linear = .false. +real*8, public :: scm_relax_tau_bot_sec = 10800._r8 +real*8, public :: scm_relax_tau_top_sec = 10800._r8 +character(len=26), public :: scm_relax_fincl(pcnst) + +! +! note that scm_use_obs_uv is set to true to be consistent with CAM BFB testing +! + +logical, public :: scm_use_obs_uv = .true. ! Use the SCAM-IOP specified observed u,v at each time step instead of forecasting. + +logical, public :: scm_use_obs_qv = .false. ! Use the SCAM-IOP specified observed qv at each time step instead of forecasting. +logical, public :: scm_iop_lhflxshflxTg = .false. !turn off LW rad +logical, public :: scm_iop_Tg = .false. !turn off LW rad + +character(len=200), public :: scm_clubb_iop_name ! IOP name for CLUBB + +!======================================================================= +contains +!======================================================================= + +subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use dycore, only: dycore_is + use wrap_nf, only: wrap_open + use spmd_utils, only : masterproc,npes + use netcdf, only : nf90_inquire_attribute,NF90_NOERR,NF90_GLOBAL,NF90_NOWRITE + + +!---------------------------Arguments----------------------------------- + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in) + logical, intent(in) :: single_column_in + real(r8), intent(in) :: scmlat_in + real(r8), intent(in) :: scmlon_in + + ! Local variables + character(len=*), parameter :: sub = 'scam_readnl' + integer :: unitn, ierr + integer :: ncid + integer :: latdimid, londimid + integer :: latsiz, lonsiz + integer :: latid, lonid + integer :: iatt + integer :: ret + integer :: latidx, lonidx + real(r8) :: ioplat,ioplon + +! this list should include any variable that you might want to include in the namelist + namelist /scam_nl/ iopfile, scm_iop_lhflxshflxTg, scm_iop_Tg, scm_relaxation, & + scm_relax_top_p,scm_relax_bot_p,scm_relax_tau_sec, & + scm_cambfb_mode,scm_crm_mode,scm_zadv_uv,scm_zadv_T,scm_zadv_q,& + scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, & + scm_relax_linear, scm_relax_tau_top_sec, & + scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl + + single_column=single_column_in + + iopfile = ' ' + scm_clubb_iop_name = ' ' + scm_relax_fincl(:) = ' ' + + if( single_column ) then + if( npes.gt.1) call endrun('SCAM_READNL: SCAM doesnt support using more than 1 pe.') + + if (.not. dycore_is('EUL') .or. plon /= 1 .or. plat /=1 ) then + call endrun('SCAM_SETOPTS: must compile model for SCAM mode when namelist parameter single_column is .true.') + endif + + scmlat=scmlat_in + scmlon=scmlon_in + + if( scmlat .lt. -90._r8 .or. scmlat .gt. 90._r8 ) then + call endrun('SCAM_READNL: SCMLAT must be between -90. and 90. degrees.') + elseif( scmlon .lt. 0._r8 .or. scmlon .gt. 360._r8 ) then + call endrun('SCAM_READNL: SCMLON must be between 0. and 360. degrees.') + end if + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'scam_nl', status=ierr) + if (ierr == 0) then + read(unitn, scam_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Error checking: + + iopfile = trim(iopfile) + if( iopfile .ne. "" ) then + use_iop = .true. + else + call endrun('SCAM_READNL: must specify IOP file for single column mode') + endif + + call wrap_open( iopfile, NF90_NOWRITE, ncid ) + + if( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', iatt ) .EQ. NF90_NOERR ) then + use_camiop = .true. + else + use_camiop = .false. + endif + + ! If we are not forcing the lat and lon from the namelist use the closest lat and lon that is found in the IOP file. + if (.not.scm_force_latlon) then + call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, ioplat, ioplon, latidx, lonidx ) + write(iulog,*) 'SCAM_READNL: using closest IOP column to lat/lon specified in drv_in' + write(iulog,*) ' requested lat,lon =',scmlat,', ',scmlon + write(iulog,*) ' closest IOP lat,lon =',ioplat,', ',ioplon + + scmlat = ioplat + scmlon = ioplon + end if + + end if + +end subroutine scam_readnl + +!=============================================================================== + +end module scamMod diff --git a/src/cpl/atm_comp_mct.F90 b/src/cpl/atm_comp_mct.F90 new file mode 100644 index 0000000000..3ed6828f00 --- /dev/null +++ b/src/cpl/atm_comp_mct.F90 @@ -0,0 +1,849 @@ +module atm_comp_mct + + use pio , only: file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, & + pio_put_att, pio_enddef, pio_initdecomp, pio_read_darray, pio_freedecomp, & + pio_closefile, pio_write_darray, pio_def_var, pio_inq_varid, & + pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling + use mct_mod + use seq_cdata_mod + use esmf + + use seq_comm_mct, only: num_inst_atm + use seq_flds_mod + use seq_infodata_mod + use seq_timemgr_mod + + use shr_kind_mod , only: r8 => shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl + use shr_file_mod , only: shr_file_getunit, & + shr_file_setLogUnit, shr_file_setLogLevel, & + shr_file_getLogUnit, shr_file_getLogLevel, & + shr_file_setIO + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + + use cam_cpl_indices + use atm_import_export + use cam_comp, only: cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final + use cam_instance , only: cam_instance_init, inst_suffix, inst_index + use cam_control_mod , only: initial_run, dart_mode, cam_ctrl_set_orbit + use radiation , only: radiation_nextsw_cday + use phys_grid , only: get_ncols_p, ngcols, get_gcol_p, get_rlat_all_p, & + get_rlon_all_p, get_area_all_p + use ppgrid , only: pcols, begchunk, endchunk + use dyn_grid , only: get_horiz_grid_dim_d + use camsrfexch , only: cam_out_t, cam_in_t + use cam_initfiles , only: cam_initfiles_get_caseid, cam_initfiles_get_restdir + use cam_abortutils , only: endrun + use filenames , only: interpret_filename_spec + use spmd_utils , only: spmdinit, masterproc, iam + use time_manager , only: get_curr_calday, advance_timestep, get_curr_date, get_nstep, & + get_step_size + use ioFileMod + use perf_mod + use cam_logfile , only: iulog + + implicit none + save + private + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public :: atm_init_mct + public :: atm_run_mct + public :: atm_final_mct + +!-------------------------------------------------------------------------- +! Private interfaces +!-------------------------------------------------------------------------- + + private :: atm_setgsmap_mct + private :: atm_domain_mct + private :: atm_read_srfrest_mct + private :: atm_write_srfrest_mct + +!-------------------------------------------------------------------------- +! Private data +!-------------------------------------------------------------------------- + + type(cam_in_t) , pointer :: cam_in(:) + type(cam_out_t), pointer :: cam_out(:) + + ! Filename specifier for restart surface file + character(len=cl) :: rsfilename_spec_cam + + integer, pointer :: dof(:) ! needed for pio_init decomp for restarts + type(seq_infodata_type), pointer :: infodata + +!================================================================================ +CONTAINS +!================================================================================ + + subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(ESMF_Clock),intent(inout) :: EClock + type(seq_cdata), intent(inout) :: cdata_a + type(mct_aVect), intent(inout) :: x2a_a + type(mct_aVect), intent(inout) :: a2x_a + character(len=*), optional, intent(IN) :: NLFilename ! Namelist filename + ! + ! Locals + ! + type(mct_gsMap), pointer :: gsMap_atm + type(mct_gGrid), pointer :: dom_a + integer :: ATMID + integer :: mpicom_atm + integer :: lsize + + logical :: first_time = .true. + logical :: exists + + integer :: shrlogunit, shrloglev ! save values, restore on return + + character(len=cs) :: starttype ! infodata start type + character(len=cl) :: caseid ! case ID + character(len=cl) :: ctitle ! case title + character(len=cl) :: model_doi_url ! DOI for CESM model run + + logical :: aqua_planet ! Flag to run model in "aqua planet" mode + logical :: brnch_retain_casename ! true => branch run may use same caseid as + ! the run being branched from + logical :: single_column + real(r8):: scmlat + real(r8):: scmlon + + real(r8) :: eccen + real(r8) :: obliqr + real(r8) :: lambm0 + real(r8) :: mvelpp + + logical :: perpetual_run ! If in perpetual mode or not + integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) + + logical :: dart_mode_in + character(len=cl) :: atm_resume_all_inst(num_inst_atm) ! atm resume file + + real(r8):: nextsw_cday ! calendar of next atm shortwave + integer :: stepno ! time step + + integer :: dtime ! time step increment (sec) + integer :: atm_cpl_dt ! driver atm coupling time step + integer :: nstep ! CAM nstep + + real(r8):: caldayp1 ! CAM calendar day for for next cam time step + + integer :: lbnum + + integer :: hdim1_d, hdim2_d ! dimensions of rectangular horizontal grid + ! data structure, If 1D data structure, then + ! hdim2_d == 1. + !----------------------------------------------------------------------- + ! + ! Determine cdata points + ! + call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & + gsMap=gsMap_atm, dom=dom_a, infodata=infodata) + + if (first_time) then + + call cam_instance_init(ATMID) + + ! Set filename specifier for restart surface file + ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day) + rsfilename_spec_cam = '%c.cam' // trim(inst_suffix) // '.rs.%y-%m-%d-%s.nc' + + ! Determine attribute vector indices + + call cam_cpl_indices_set() + + ! Initialize atm use of MPI + call spmdinit(mpicom_atm) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_init_mct:start::',lbnum) + endif +#endif + + ! Redirect share output to cam log + + if (masterproc) then + inquire(file='atm_modelio.nml'//trim(inst_suffix), exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('atm_modelio.nml'//trim(inst_suffix), iulog) + endif + + write(iulog,*) "CAM atmosphere model initialization" + endif + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + ! + ! Get data from infodata object + ! + call seq_infodata_GetData( infodata, & + case_name=caseid, case_desc=ctitle, model_doi_url=model_doi_url, & + start_type=starttype, & + atm_resume=atm_resume_all_inst, & + aqua_planet=aqua_planet, & + brnch_retain_casename=brnch_retain_casename, & + single_column=single_column, scmlat=scmlat, scmlon=scmlon, & + orb_eccen=eccen, orb_mvelpp=mvelpp, orb_lambm0=lambm0, orb_obliqr=obliqr, & + perpetual=perpetual_run, perpetual_ymd=perpetual_ymd) + + dart_mode_in = .false. + if (trim(atm_resume_all_inst(inst_index)) == 'TRUE') dart_mode_in = .true. + + ! Initialize CAM, allocate cam_in and cam_out and determine + ! atm decomposition (needed to initialize gsmap) + ! for an initial run, cam_in and cam_out are allocated in cam_init + ! for a restart/branch run, cam_in and cam_out are allocated in restart + ! + call cam_init(EClock, & + caseid, ctitle, starttype, dart_mode_in, & + brnch_retain_casename, aqua_planet, & + single_column, scmlat, scmlon, & + eccen, obliqr, lambm0, mvelpp, & + perpetual_run, perpetual_ymd, model_doi_url, & + cam_out, cam_in) + + ! + ! Initialize MCT gsMap, domain and attribute vectors (and dof) + ! + call atm_SetgsMap_mct( mpicom_atm, ATMID, gsMap_atm ) + lsize = mct_gsMap_lsize(gsMap_atm, mpicom_atm) + + ! Set dof (module variable, needed for pio for restarts) + call mct_gsmap_orderedpoints(gsmap_atm, iam, dof) + ! + ! Initialize MCT domain + ! + call atm_domain_mct( lsize, gsMap_atm, dom_a ) + ! + ! Initialize MCT attribute vectors + ! + call mct_aVect_init(a2x_a, rList=seq_flds_a2x_fields, lsize=lsize) + call mct_aVect_zero(a2x_a) + + call mct_aVect_init(x2a_a, rList=seq_flds_x2a_fields, lsize=lsize) + call mct_aVect_zero(x2a_a) + ! + ! Create initial atm export state + ! + call atm_export( cam_out, a2x_a%rattr ) + ! + ! Set flag to specify that an extra albedo calculation is to be done (i.e. specify active) + ! + call seq_infodata_PutData(infodata, atm_prognostic=.true.) + call get_horiz_grid_dim_d(hdim1_d, hdim2_d) + call seq_infodata_PutData(infodata, atm_nx=hdim1_d, atm_ny=hdim2_d) + + ! Set flag to indicate that CAM will provide carbon and dust deposition fluxes. + ! This is now hardcoded to .true. since the ability of CICE to read these + ! fluxes from a file has been removed. + call seq_infodata_PutData(infodata, atm_aero=.true.) + + ! + ! Set time step of radiation computation as the current calday + ! This will only be used on the first timestep of an initial run + ! + if (initial_run) then + nextsw_cday = get_curr_calday() + call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) + end if + + ! End redirection of share output to cam log + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + + first_time = .false. + + else + + ! For initial run, run cam radiation/clouds and return + ! For restart run, read restart x2a_a + ! Note - a2x_a is computed upon the completion of the previous run - cam_run1 is called + ! only for the purposes of finishing the flux averaged calculation to compute a2x_a + ! Note - cam_run1 is called on restart only to have cam internal state consistent with the + ! a2x_a state sent to the coupler + + ! Redirect share output to cam log + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + call seq_timemgr_EClockGetData(EClock, StepNo=StepNo) + if (StepNo == 0) then + call atm_import( x2a_a%rattr, cam_in ) + call cam_run1 ( cam_in, cam_out ) + call atm_export( cam_out, a2x_a%rattr ) + else + call atm_read_srfrest_mct( EClock, x2a_a, a2x_a ) + call atm_import( x2a_a%rattr, cam_in, restart_init=.true. ) + call cam_run1 ( cam_in, cam_out ) + end if + + ! Compute time of next radiation computation, like in run method for exact restart + + call seq_timemgr_EClockGetData(Eclock,dtime=atm_cpl_dt) + dtime = get_step_size() + nstep = get_nstep() + if (nstep < 1 .or. dtime < atm_cpl_dt) then + nextsw_cday = radiation_nextsw_cday() + else if (dtime == atm_cpl_dt) then + caldayp1 = get_curr_calday(offset=int(dtime)) + nextsw_cday = radiation_nextsw_cday() + if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 + else + call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') + end if + call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) + + ! End redirection of share output to cam log + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + + end if + +#if (defined _MEMTRACE ) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_init_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + call shr_sys_flush(iulog) + + end subroutine atm_init_mct + + !================================================================================ + + subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata_a + type(mct_aVect) ,intent(inout) :: x2a_a + type(mct_aVect) ,intent(inout) :: a2x_a + ! + ! Local variables + ! + integer :: shrlogunit, shrloglev ! save values, restore on exit + + real(r8) :: eccen + real(r8) :: obliqr + real(r8) :: lambm0 + real(r8) :: mvelpp + + logical :: dosend ! true => send data back to driver + integer :: dtime ! time step increment (sec) + integer :: atm_cpl_dt ! driver atm coupling time step + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CAM current date (YYYYMMDD) + integer :: yr ! CAM current year + integer :: mon ! CAM current month + integer :: day ! CAM current day + integer :: tod ! CAM current time of day (sec) + + real(r8):: caldayp1 ! CAM calendar day for for next cam time step + real(r8):: nextsw_cday ! calendar of next atm shortwave + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! Flag signaling last time-step + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + logical :: first_time = .true. + integer :: lbnum + character(len=*), parameter :: subname="atm_run_mct" + !----------------------------------------------------------------------- + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out',SubName //':start::',lbnum) + endif +#endif + + ! Redirect share output to cam log + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Note that sync clock time should match cam time at end of time step/loop not beginning + + call seq_timemgr_EClockGetData(EClock,curr_ymd=ymd_sync,curr_tod=tod_sync, & + curr_yr=yr_sync,curr_mon=mon_sync,curr_day=day_sync) + + nlend_sync = seq_timemgr_StopAlarmIsOn(EClock) + rstwr_sync = seq_timemgr_RestartAlarmIsOn(EClock) + + ! load orbital parameters + call seq_infodata_GetData( infodata, & + orb_eccen=eccen, orb_mvelpp=mvelpp, orb_lambm0=lambm0, orb_obliqr=obliqr) + call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + + ! Map input from mct to cam data structure + + call t_startf ('CAM_import') + call atm_import( x2a_a%rattr, cam_in ) + call t_stopf ('CAM_import') + + ! Cycle over all time steps in the atm coupling interval + + dosend = .false. + do while (.not. dosend) + + ! Determine if dosend + ! When time is not updated at the beginning of the loop - then return only if + ! are in sync with clock before time is updated + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run CAM (run2, run3, run4) + + call t_startf ('CAM_run2') + call cam_run2( cam_out, cam_in ) + call t_stopf ('CAM_run2') + + call t_startf ('CAM_run3') + call cam_run3( cam_out ) + call t_stopf ('CAM_run3') + + call t_startf ('CAM_run4') + call cam_run4( cam_out, cam_in, rstwr, nlend, & + yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) + call t_stopf ('CAM_run4') + + ! Advance cam time step + + call t_startf ('CAM_adv_timestep') + call advance_timestep() + call t_stopf ('CAM_adv_timestep') + + ! Run cam radiation/clouds (run1) + + call t_startf ('CAM_run1') + call cam_run1 ( cam_in, cam_out ) + call t_stopf ('CAM_run1') + + ! Map output from cam to mct data structures + + call t_startf ('CAM_export') + call atm_export( cam_out, a2x_a%rattr ) + call t_stopf ('CAM_export') + + end do + + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + + call seq_timemgr_EClockGetData(Eclock,dtime=atm_cpl_dt) + dtime = get_step_size() + if (dtime < atm_cpl_dt) then + nextsw_cday = radiation_nextsw_cday() + else if (dtime == atm_cpl_dt) then + caldayp1 = get_curr_calday(offset=int(dtime)) + nextsw_cday = radiation_nextsw_cday() + if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 + else + call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') + end if + + call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) + + ! Write merged surface data restart file if appropriate + + if (rstwr_sync) then + call atm_write_srfrest_mct( x2a_a, a2x_a, & + yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) + end if + + ! Check for consistency of internal cam clock with master sync clock + + dtime = get_step_size() + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EClockGetData(EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' cam ymd=',ymd ,' cam tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call shr_sys_abort( subname//': CAM clock is not in sync with master Sync Clock' ) + end if + + ! End redirection of share output to cam log + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out',SubName //':end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine atm_run_mct + + !================================================================================ + + subroutine atm_final_mct( EClock, cdata_a, x2a_a, a2x_a) + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata_a + type(mct_aVect) ,intent(inout) :: x2a_a + type(mct_aVect) ,intent(inout) :: a2x_a + + call cam_final( cam_out, cam_in ) + + end subroutine atm_final_mct + + !================================================================================ + + subroutine atm_SetgsMap_mct( mpicom_atm, ATMID, GSMap_atm ) + + !------------------------------------------------------------------- + use phys_grid, only : get_nlcols_p + ! + ! Arguments + ! + integer , intent(in) :: mpicom_atm + integer , intent(in) :: ATMID + type(mct_gsMap), intent(out) :: GSMap_atm + ! + ! Local variables + ! + integer, allocatable :: gindex(:) + integer :: i, n, c, ncols, sizebuf, nlcols + integer :: ier ! error status + !------------------------------------------------------------------- + + ! Build the atmosphere grid numbering for MCT + ! NOTE: Numbering scheme is: West to East and South to North + ! starting at south pole. Should be the same as what's used in SCRIP + + ! Determine global seg map + + sizebuf=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + sizebuf = sizebuf+1 + end do + end do + + allocate(gindex(sizebuf)) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + n=n+1 + gindex(n) = get_gcol_p(c,i) + end do + end do + + nlcols = get_nlcols_p() + call mct_gsMap_init( gsMap_atm, gindex, mpicom_atm, ATMID, nlcols, ngcols) + + deallocate(gindex) + + end subroutine atm_SetgsMap_mct + + !=============================================================================== + + subroutine atm_domain_mct( lsize, gsMap_a, dom_a ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: lsize + type(mct_gsMap), intent(in) :: gsMap_a + type(mct_ggrid), intent(inout):: dom_a + ! + ! Local Variables + ! + integer :: n,i,c,ncols ! indices + real(r8) :: lats(pcols) ! array of chunk latitudes + real(r8) :: lons(pcols) ! array of chunk longitude + real(r8) :: area(pcols) ! area in radians squared for each grid point + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI + !------------------------------------------------------------------- + ! + ! Initialize mct atm domain + ! + call mct_gGrid_init( GGrid=dom_a, CoordChars=trim(seq_flds_dom_coord), OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Initialize attribute vector with special value + ! + call mct_gsMap_orderedPoints(gsMap_a, iam, idata) + call mct_gGrid_importIAttr(dom_a,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_a,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_a,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_a,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_a,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_a,"mask" ,data,lsize) + data(:) = 1.0_R8 + call mct_gGrid_importRAttr(dom_a,"frac" ,data,lsize) + ! + ! Fill in correct values for domain components + ! + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, ncols, lats) + do i=1,ncols + n = n+1 + data(n) = lats(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_a,"lat",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlon_all_p(c, ncols, lons) + do i=1,ncols + n = n+1 + data(n) = lons(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_a,"lon",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_area_all_p(c, ncols, area) + do i=1,ncols + n = n+1 + data(n) = area(i) + end do + end do + call mct_gGrid_importRAttr(dom_a,"area",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + n = n+1 + data(n) = 1._r8 ! mask + end do + end do + call mct_gGrid_importRAttr(dom_a,"mask" ,data,lsize) + deallocate(data) + + end subroutine atm_domain_mct + + !=========================================================================================== + + subroutine atm_read_srfrest_mct( EClock, x2a_a, a2x_a) + + !----------------------------------------------------------------------- + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile, pio_subsystem + ! + ! Arguments + ! + type(ESMF_Clock),intent(inout) :: EClock + type(mct_aVect), intent(inout) :: x2a_a + type(mct_aVect), intent(inout) :: a2x_a + + ! Local variables + character(len=cl) :: fname_srf_cam ! surface restart filename + character(len=cl) :: pname_srf_cam ! surface restart full pathname + integer :: rcode ! return error code + integer :: yr_spec ! Current year + integer :: mon_spec ! Current month + integer :: day_spec ! Current day + integer :: sec_spec ! Current time of day (sec) + integer :: nf_x2a, nf_a2x, k + real(r8), allocatable :: tmp(:) + type(file_desc_t) :: file + type(io_desc_t) :: iodesc + type(var_desc_t) :: varid + character(CL) :: itemc ! string converted to char + type(mct_string) :: mstring ! mct char type + !----------------------------------------------------------------------- + + ! Determine and open surface restart dataset + + call seq_timemgr_EClockGetData( EClock, curr_yr=yr_spec,curr_mon=mon_spec, & + curr_day=day_spec, curr_tod=sec_spec ) + + if (dart_mode) then + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec=sec_spec ) + pname_srf_cam = fname_srf_cam + else + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, & + case=cam_initfiles_get_caseid(), yr_spec=yr_spec, & + mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + pname_srf_cam = trim(cam_initfiles_get_restdir() )//fname_srf_cam + end if + call getfil(pname_srf_cam, fname_srf_cam) + + call cam_pio_openfile(File, fname_srf_cam, 0) + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + allocate(tmp(size(dof))) + + nf_x2a = mct_aVect_nRattr(x2a_a) + do k=1,nf_x2a + call mct_aVect_getRList(mstring,k,x2a_a) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + + call pio_seterrorhandling(File, pio_bcast_error) + rcode = pio_inq_varid(File,'x2a_'//trim(itemc) ,varid) + if (rcode == pio_noerr) then + call pio_read_darray(File, varid, iodesc, tmp, rcode) + x2a_a%rattr(k,:) = tmp(:) + else + if (masterproc) then + write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' + end if + x2a_a%rattr(k,:) = 0._r8 + end if + call pio_seterrorhandling(File, pio_internal_error) + end do + + nf_a2x = mct_aVect_nRattr(a2x_a) + do k=1,nf_a2x + call mct_aVect_getRList(mstring,k,a2x_a) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + + rcode = pio_inq_varid(File,'a2x_'//trim(itemc) ,varid) + call pio_read_darray(File, varid, iodesc, tmp, rcode) + a2x_a%rattr(k,:) = tmp(:) + end do + + call pio_freedecomp(File,iodesc) + call cam_pio_closefile(File) + deallocate(tmp) + + end subroutine atm_read_srfrest_mct + + !=========================================================================================== + + subroutine atm_write_srfrest_mct( x2a_a, a2x_a, & + yr_spec, mon_spec, day_spec, sec_spec) + + !----------------------------------------------------------------------- + use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile, pio_subsystem + use cam_history_support, only: fillvalue + ! + ! Arguments + ! + type(mct_aVect), intent(in) :: x2a_a + type(mct_aVect), intent(in) :: a2x_a + integer , intent(in) :: yr_spec ! Simulation year + integer , intent(in) :: mon_spec ! Simulation month + integer , intent(in) :: day_spec ! Simulation day + integer , intent(in) :: sec_spec ! Seconds into current simulation day + ! + ! Local variables + ! + character(len=cl) :: fname_srf_cam ! surface restart filename + integer :: rcode ! return error code + integer :: nf_x2a, nf_a2x, dimid(1), k + type(file_desc_t) :: file + type(var_desc_t), pointer :: varid_x2a(:), varid_a2x(:) + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + type(mct_string) :: mstring ! mct char type + !----------------------------------------------------------------------- + + ! Determine and open surface restart dataset + + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + + call cam_pio_createfile(File, fname_srf_cam, 0) + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + + nf_x2a = mct_aVect_nRattr(x2a_a) + allocate(varid_x2a(nf_x2a)) + + rcode = pio_def_dim(File,'x2a_nx',ngcols,dimid(1)) + do k = 1,nf_x2a + call mct_aVect_getRList(mstring,k,x2a_a) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + rcode = pio_def_var(File,'x2a_'//trim(itemc),PIO_DOUBLE,dimid,varid_x2a(k)) + rcode = pio_put_att(File,varid_x2a(k),"_fillvalue",fillvalue) + enddo + + nf_a2x = mct_aVect_nRattr(a2x_a) + allocate(varid_a2x(nf_a2x)) + + rcode = pio_def_dim(File,'a2x_nx',ngcols,dimid(1)) + do k = 1,nf_a2x + call mct_aVect_getRList(mstring,k,a2x_a) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + rcode = PIO_def_var(File,'a2x_'//trim(itemc),PIO_DOUBLE,dimid,varid_a2x(k)) + rcode = PIO_put_att(File,varid_a2x(k),"_fillvalue",fillvalue) + enddo + + rcode = pio_enddef(File) ! don't check return code, might be enddef already + + + do k=1,nf_x2a + call pio_write_darray(File, varid_x2a(k), iodesc, x2a_a%rattr(k,:), rcode) + end do + + do k=1,nf_a2x + call pio_write_darray(File, varid_a2x(k), iodesc, a2x_a%rattr(k,:), rcode) + end do + + deallocate(varid_x2a, varid_a2x) + + call pio_freedecomp(File,iodesc) + call cam_pio_closefile(file) + + + end subroutine atm_write_srfrest_mct + +end module atm_comp_mct diff --git a/src/cpl/atm_import_export.F90 b/src/cpl/atm_import_export.F90 new file mode 100644 index 0000000000..8ff1839da6 --- /dev/null +++ b/src/cpl/atm_import_export.F90 @@ -0,0 +1,284 @@ +module atm_import_export + + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + implicit none + +contains + + subroutine atm_import( x2a, cam_in, restart_init ) + + !----------------------------------------------------------------------- + use cam_cpl_indices + use camsrfexch, only: cam_in_t + use phys_grid , only: get_ncols_p + use ppgrid , only: begchunk, endchunk + use shr_const_mod, only: shr_const_stebol + use seq_drydep_mod, only: n_drydep + use shr_fire_emis_mod, only: shr_fire_emis_mechcomps_n + use co2_cycle , only: c_i, co2_readFlux_ocn, co2_readFlux_fuel + use co2_cycle , only: co2_transport, co2_time_interp_ocn, co2_time_interp_fuel + use co2_cycle , only: data_flux_ocn, data_flux_fuel + use physconst , only: mwco2 + use time_manager , only: is_first_step + ! + ! Arguments + ! + real(r8) , intent(in) :: x2a(:,:) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + logical, optional, intent(in) :: restart_init + ! + ! Local variables + ! + integer :: i,lat,n,c,ig ! indices + integer :: ncols ! number of columns + logical, save :: first_time = .true. + integer, parameter :: ndst = 2 + integer, target :: spc_ndx(ndst) + integer, pointer :: dst_a5_ndx, dst_a7_ndx + integer, pointer :: dst_a1_ndx, dst_a3_ndx + logical :: overwrite_flds + !----------------------------------------------------------------------- + overwrite_flds = .true. + ! don't overwrite fields if invoked during the initialization phase + ! of a 'continue' or 'branch' run type with data from .rs file + if (present(restart_init)) overwrite_flds = .not. restart_init + + ! ccsm sign convention is that fluxes are positive downward + + ig=1 + do c=begchunk,endchunk + ncols = get_ncols_p(c) + + do i =1,ncols + if (overwrite_flds) then + cam_in(c)%wsx(i) = -x2a(index_x2a_Faxx_taux,ig) + cam_in(c)%wsy(i) = -x2a(index_x2a_Faxx_tauy,ig) + cam_in(c)%shf(i) = -x2a(index_x2a_Faxx_sen, ig) + cam_in(c)%cflx(i,1) = -x2a(index_x2a_Faxx_evap,ig) + endif + cam_in(c)%lhf(i) = -x2a(index_x2a_Faxx_lat, ig) + cam_in(c)%lwup(i) = -x2a(index_x2a_Faxx_lwup,ig) + cam_in(c)%asdir(i) = x2a(index_x2a_Sx_avsdr, ig) + cam_in(c)%aldir(i) = x2a(index_x2a_Sx_anidr, ig) + cam_in(c)%asdif(i) = x2a(index_x2a_Sx_avsdf, ig) + cam_in(c)%aldif(i) = x2a(index_x2a_Sx_anidf, ig) + cam_in(c)%ts(i) = x2a(index_x2a_Sx_t, ig) + cam_in(c)%sst(i) = x2a(index_x2a_So_t, ig) + cam_in(c)%snowhland(i) = x2a(index_x2a_Sl_snowh, ig) + cam_in(c)%snowhice(i) = x2a(index_x2a_Si_snowh, ig) + cam_in(c)%tref(i) = x2a(index_x2a_Sx_tref, ig) + cam_in(c)%qref(i) = x2a(index_x2a_Sx_qref, ig) + cam_in(c)%u10(i) = x2a(index_x2a_Sx_u10, ig) + cam_in(c)%icefrac(i) = x2a(index_x2a_Sf_ifrac, ig) + cam_in(c)%ocnfrac(i) = x2a(index_x2a_Sf_ofrac, ig) + cam_in(c)%landfrac(i) = x2a(index_x2a_Sf_lfrac, ig) + if ( associated(cam_in(c)%ram1) ) & + cam_in(c)%ram1(i) = x2a(index_x2a_Sl_ram1 , ig) + if ( associated(cam_in(c)%fv) ) & + cam_in(c)%fv(i) = x2a(index_x2a_Sl_fv , ig) + if ( associated(cam_in(c)%soilw) ) & + cam_in(c)%soilw(i) = x2a(index_x2a_Sl_soilw, ig) + if ( associated(cam_in(c)%dstflx) ) then + cam_in(c)%dstflx(i,1) = x2a(index_x2a_Fall_flxdst1, ig) + cam_in(c)%dstflx(i,2) = x2a(index_x2a_Fall_flxdst2, ig) + cam_in(c)%dstflx(i,3) = x2a(index_x2a_Fall_flxdst3, ig) + cam_in(c)%dstflx(i,4) = x2a(index_x2a_Fall_flxdst4, ig) + endif + if ( associated(cam_in(c)%meganflx) ) then + cam_in(c)%meganflx(i,1:shr_megan_mechcomps_n) = & + x2a(index_x2a_Fall_flxvoc:index_x2a_Fall_flxvoc+shr_megan_mechcomps_n-1, ig) + endif + + ! Fire emission fluxes + if ( associated(cam_in(c)%fireflx) .and. associated(cam_in(c)%fireztop) ) then + cam_in(c)%fireflx(i,:shr_fire_emis_mechcomps_n) = & + x2a(index_x2a_Fall_flxfire:index_x2a_Fall_flxfire+shr_fire_emis_mechcomps_n-1, ig) + cam_in(c)%fireztop(i) = x2a(index_x2a_Sl_ztopfire, ig) + endif + + ! dry dep velocities + if ( index_x2a_Sl_ddvel/=0 .and. n_drydep>0 ) then + cam_in(c)%depvel(i,:n_drydep) = & + x2a(index_x2a_Sl_ddvel:index_x2a_Sl_ddvel+n_drydep-1, ig) + endif + ! + ! fields needed to calculate water isotopes to ocean evaporation processes + ! + cam_in(c)%ustar(i) = x2a(index_x2a_So_ustar,ig) + cam_in(c)%re(i) = x2a(index_x2a_So_re ,ig) + cam_in(c)%ssq(i) = x2a(index_x2a_So_ssq ,ig) + ! + ! bgc scenarios + ! + if (index_x2a_Fall_fco2_lnd /= 0) then + cam_in(c)%fco2_lnd(i) = -x2a(index_x2a_Fall_fco2_lnd,ig) + end if + if (index_x2a_Faoo_fco2_ocn /= 0) then + cam_in(c)%fco2_ocn(i) = -x2a(index_x2a_Faoo_fco2_ocn,ig) + end if + if (index_x2a_Faoo_fdms_ocn /= 0) then + cam_in(c)%fdms(i) = -x2a(index_x2a_Faoo_fdms_ocn,ig) + end if + + ig=ig+1 + + end do + end do + + ! Get total co2 flux from components, + ! Note - co2_transport determines if cam_in(c)%cflx(i,c_i(1:4)) is allocated + + if (co2_transport().and.overwrite_flds) then + + ! Interpolate in time for flux data read in + if (co2_readFlux_ocn) then + call co2_time_interp_ocn + end if + if (co2_readFlux_fuel) then + call co2_time_interp_fuel + end if + + ! from ocn : data read in or from coupler or zero + ! from fuel: data read in or zero + ! from lnd : through coupler or zero + do c=begchunk,endchunk + ncols = get_ncols_p(c) + do i=1,ncols + + ! all co2 fluxes in unit kgCO2/m2/s ! co2 flux from ocn + if (index_x2a_Faoo_fco2_ocn /= 0) then + cam_in(c)%cflx(i,c_i(1)) = cam_in(c)%fco2_ocn(i) + else if (co2_readFlux_ocn) then + ! convert from molesCO2/m2/s to kgCO2/m2/s + cam_in(c)%cflx(i,c_i(1)) = & + -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in(c)%landfrac(i)) & + *mwco2*1.0e-3_r8 + else + cam_in(c)%cflx(i,c_i(1)) = 0._r8 + end if + + ! co2 flux from fossil fuel + if (co2_readFlux_fuel) then + cam_in(c)%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,c) + else + cam_in(c)%cflx(i,c_i(2)) = 0._r8 + end if + + ! co2 flux from land (cpl already multiplies flux by land fraction) + if (index_x2a_Fall_fco2_lnd /= 0) then + cam_in(c)%cflx(i,c_i(3)) = cam_in(c)%fco2_lnd(i) + else + cam_in(c)%cflx(i,c_i(3)) = 0._r8 + end if + + ! merged co2 flux + cam_in(c)%cflx(i,c_i(4)) = cam_in(c)%cflx(i,c_i(1)) + & + cam_in(c)%cflx(i,c_i(2)) + & + cam_in(c)%cflx(i,c_i(3)) + end do + end do + end if + ! + ! if first step, determine longwave up flux from the surface temperature + ! + if (first_time) then + if (is_first_step()) then + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + cam_in(c)%lwup(i) = shr_const_stebol*(cam_in(c)%ts(i)**4) + end do + end do + end if + first_time = .false. + end if + + end subroutine atm_import + + !=============================================================================== + + subroutine atm_export( cam_out, a2x ) + + !------------------------------------------------------------------- + use camsrfexch, only: cam_out_t + use phys_grid , only: get_ncols_p + use ppgrid , only: begchunk, endchunk + use cam_cpl_indices + ! + ! Arguments + ! + type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) + real(r8) , intent(inout) :: a2x(:,:) + ! + ! Local variables + ! + integer :: avsize, avnat + integer :: i,m,c,n,ig ! indices + integer :: ncols ! Number of columns + !----------------------------------------------------------------------- + + ! Copy from component arrays into chunk array data structure + ! Rearrange data from chunk structure into lat-lon buffer and subsequently + ! create attribute vector + + ig=1 + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + a2x(index_a2x_Sa_pslv ,ig) = cam_out(c)%psl(i) + a2x(index_a2x_Sa_z ,ig) = cam_out(c)%zbot(i) + a2x(index_a2x_Sa_topo ,ig) = cam_out(c)%topo(i) + a2x(index_a2x_Sa_u ,ig) = cam_out(c)%ubot(i) + a2x(index_a2x_Sa_v ,ig) = cam_out(c)%vbot(i) + a2x(index_a2x_Sa_tbot ,ig) = cam_out(c)%tbot(i) + a2x(index_a2x_Sa_ptem ,ig) = cam_out(c)%thbot(i) + a2x(index_a2x_Sa_pbot ,ig) = cam_out(c)%pbot(i) + a2x(index_a2x_Sa_shum ,ig) = cam_out(c)%qbot(i,1) + a2x(index_a2x_Sa_dens ,ig) = cam_out(c)%rho(i) + a2x(index_a2x_Faxa_swnet,ig) = cam_out(c)%netsw(i) + a2x(index_a2x_Faxa_lwdn ,ig) = cam_out(c)%flwds(i) + a2x(index_a2x_Faxa_rainc,ig) = (cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 + a2x(index_a2x_Faxa_rainl,ig) = (cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 + a2x(index_a2x_Faxa_snowc,ig) = cam_out(c)%precsc(i)*1000._r8 + a2x(index_a2x_Faxa_snowl,ig) = cam_out(c)%precsl(i)*1000._r8 + a2x(index_a2x_Faxa_swndr,ig) = cam_out(c)%soll(i) + a2x(index_a2x_Faxa_swvdr,ig) = cam_out(c)%sols(i) + a2x(index_a2x_Faxa_swndf,ig) = cam_out(c)%solld(i) + a2x(index_a2x_Faxa_swvdf,ig) = cam_out(c)%solsd(i) + + ! aerosol deposition fluxes + a2x(index_a2x_Faxa_bcphidry,ig) = cam_out(c)%bcphidry(i) + a2x(index_a2x_Faxa_bcphodry,ig) = cam_out(c)%bcphodry(i) + a2x(index_a2x_Faxa_bcphiwet,ig) = cam_out(c)%bcphiwet(i) + a2x(index_a2x_Faxa_ocphidry,ig) = cam_out(c)%ocphidry(i) + a2x(index_a2x_Faxa_ocphodry,ig) = cam_out(c)%ocphodry(i) + a2x(index_a2x_Faxa_ocphiwet,ig) = cam_out(c)%ocphiwet(i) + a2x(index_a2x_Faxa_dstwet1,ig) = cam_out(c)%dstwet1(i) + a2x(index_a2x_Faxa_dstdry1,ig) = cam_out(c)%dstdry1(i) + a2x(index_a2x_Faxa_dstwet2,ig) = cam_out(c)%dstwet2(i) + a2x(index_a2x_Faxa_dstdry2,ig) = cam_out(c)%dstdry2(i) + a2x(index_a2x_Faxa_dstwet3,ig) = cam_out(c)%dstwet3(i) + a2x(index_a2x_Faxa_dstdry3,ig) = cam_out(c)%dstdry3(i) + a2x(index_a2x_Faxa_dstwet4,ig) = cam_out(c)%dstwet4(i) + a2x(index_a2x_Faxa_dstdry4,ig) = cam_out(c)%dstdry4(i) + + if (index_a2x_Sa_co2prog /= 0) then + a2x(index_a2x_Sa_co2prog,ig) = cam_out(c)%co2prog(i) ! atm prognostic co2 + end if + if (index_a2x_Sa_co2diag /= 0) then + a2x(index_a2x_Sa_co2diag,ig) = cam_out(c)%co2diag(i) ! atm diagnostic co2 + end if + if (index_a2x_Faxa_nhx > 0 ) then + a2x(index_a2x_Faxa_nhx,ig) = cam_out(c)%nhx_nitrogen_flx(i) + endif + if (index_a2x_Faxa_noy > 0 ) then + a2x(index_a2x_Faxa_noy,ig) = cam_out(c)%noy_nitrogen_flx(i) + endif + + ig=ig+1 + end do + end do + + end subroutine atm_export + +end module atm_import_export diff --git a/src/cpl/cam_cpl_indices.F90 b/src/cpl/cam_cpl_indices.F90 new file mode 100644 index 0000000000..ec6d7a1546 --- /dev/null +++ b/src/cpl/cam_cpl_indices.F90 @@ -0,0 +1,209 @@ +module cam_cpl_indices + + use seq_flds_mod + use mct_mod + use seq_drydep_mod, only: drydep_fields_token, lnd_drydep + use shr_megan_mod, only: shr_megan_fields_token, shr_megan_mechcomps_n + use shr_fire_emis_mod, only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n + + implicit none + + SAVE + public ! By default make data private + + integer :: index_a2x_Sa_z ! bottom atm level height + integer :: index_a2x_Sa_topo ! surface topographic height + integer :: index_a2x_Sa_u ! bottom atm level zon wind + integer :: index_a2x_Sa_v ! bottom atm level mer wind + integer :: index_a2x_Sa_tbot ! bottom atm level temp + integer :: index_a2x_Sa_ptem ! bottom atm level pot temp + integer :: index_a2x_Sa_shum ! bottom atm level spec hum + integer :: index_a2x_Sa_dens ! bottom atm level air den + integer :: index_a2x_Sa_pbot ! bottom atm level pressure + integer :: index_a2x_Sa_pslv ! sea level atm pressure + integer :: index_a2x_Faxa_lwdn ! downward lw heat flux + integer :: index_a2x_Faxa_rainc ! prec: liquid "convective" + integer :: index_a2x_Faxa_rainl ! prec: liquid "large scale" + integer :: index_a2x_Faxa_snowc ! prec: frozen "convective" + integer :: index_a2x_Faxa_snowl ! prec: frozen "large scale" + integer :: index_a2x_Faxa_swndr ! sw: nir direct downward + integer :: index_a2x_Faxa_swvdr ! sw: vis direct downward + integer :: index_a2x_Faxa_swndf ! sw: nir diffuse downward + integer :: index_a2x_Faxa_swvdf ! sw: vis diffuse downward + integer :: index_a2x_Faxa_swnet ! sw: net + integer :: index_a2x_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition + integer :: index_a2x_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition + integer :: index_a2x_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition + integer :: index_a2x_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition + integer :: index_a2x_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition + integer :: index_a2x_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition + integer :: index_a2x_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition + integer :: index_a2x_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition + integer :: index_a2x_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition + integer :: index_a2x_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition + integer :: index_a2x_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition + integer :: index_a2x_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition + integer :: index_a2x_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition + integer :: index_a2x_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition + integer :: index_a2x_Sa_co2prog ! bottom atm level prognostic co2 + integer :: index_a2x_Sa_co2diag ! bottom atm level diagnostic co2 + integer :: index_a2x_Faxa_nhx ! flux: Nitrogen deposition + integer :: index_a2x_Faxa_noy ! flux: Nitrogen deposition + + integer :: index_x2a_Sx_t ! surface temperature + integer :: index_x2a_So_t ! sea surface temperature + integer :: index_x2a_Sf_lfrac ! surface land fraction + integer :: index_x2a_Sf_ifrac ! surface ice fraction + integer :: index_x2a_Sf_ofrac ! surface ocn fraction + integer :: index_x2a_Sx_tref ! 2m reference temperature + integer :: index_x2a_Sx_qref ! 2m reference specific humidity + integer :: index_x2a_Sx_avsdr ! albedo, visible, direct + integer :: index_x2a_Sx_anidr ! albedo, near-ir, direct + integer :: index_x2a_Sx_avsdf ! albedo, visible, diffuse + integer :: index_x2a_Sx_anidf ! albedo, near-ir, diffuse + integer :: index_x2a_Sl_snowh ! surface snow depth over land + integer :: index_x2a_Si_snowh ! surface snow depth over ice + integer :: index_x2a_Sl_fv ! friction velocity + integer :: index_x2a_Sl_ram1 ! aerodynamical resistance + integer :: index_x2a_Sl_soilw ! volumetric soil water + integer :: index_x2a_Faxx_taux ! wind stress, zonal + integer :: index_x2a_Faxx_tauy ! wind stress, meridional + integer :: index_x2a_Faxx_lat ! latent heat flux + integer :: index_x2a_Faxx_sen ! sensible heat flux + integer :: index_x2a_Faxx_lwup ! upward longwave heat flux + integer :: index_x2a_Faxx_evap ! evaporation water flux + integer :: index_x2a_Fall_flxdst1 ! dust flux size bin 1 + integer :: index_x2a_Fall_flxdst2 ! dust flux size bin 2 + integer :: index_x2a_Fall_flxdst3 ! dust flux size bin 3 + integer :: index_x2a_Fall_flxdst4 ! dust flux size bin 4 + integer :: index_x2a_Fall_flxvoc ! MEGAN emissions fluxes + integer :: index_x2a_Fall_flxfire ! Fire emissions fluxes + integer :: index_x2a_Sl_ztopfire ! Fire emissions fluxes top of vert distribution + integer :: index_x2a_Fall_fco2_lnd ! co2 flux from land + integer :: index_x2a_Faoo_fco2_ocn ! co2 flux from ocean + integer :: index_x2a_Faoo_fdms_ocn ! dms flux from ocean + integer :: index_x2a_So_ustar ! surface friction velocity in ocean + integer :: index_x2a_So_re ! square of atm/ocn exch. coeff + integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean + integer :: index_x2a_Sl_ddvel ! dry deposition velocities from land + integer :: index_x2a_Sx_u10 ! 10m wind + +contains + + subroutine cam_cpl_indices_set( ) + + type(mct_aVect) :: a2x ! temporary + type(mct_aVect) :: x2a ! temporary + + ! Determine attribute vector indices + + ! create temporary attribute vectors + call mct_aVect_init(x2a, rList=seq_flds_x2a_fields, lsize=1) + call mct_aVect_init(a2x, rList=seq_flds_a2x_fields, lsize=1) + + ! Initialize av indices + index_x2a_Sx_avsdr = mct_avect_indexra(x2a,'Sx_avsdr') + index_x2a_Sx_anidr = mct_avect_indexra(x2a,'Sx_anidr') + index_x2a_Sx_avsdf = mct_avect_indexra(x2a,'Sx_avsdf') + index_x2a_Sx_anidf = mct_avect_indexra(x2a,'Sx_anidf') + index_x2a_Sx_t = mct_avect_indexra(x2a,'Sx_t') + index_x2a_So_t = mct_avect_indexra(x2a,'So_t') + index_x2a_Sl_snowh = mct_avect_indexra(x2a,'Sl_snowh') + index_x2a_Si_snowh = mct_avect_indexra(x2a,'Si_snowh') + + index_x2a_Sl_fv = mct_avect_indexra(x2a,'Sl_fv') + index_x2a_Sl_ram1 = mct_avect_indexra(x2a,'Sl_ram1') + index_x2a_Sl_soilw = mct_avect_indexra(x2a,'Sl_soilw',perrWith='quiet') + + index_x2a_Sx_tref = mct_avect_indexra(x2a,'Sx_tref') + index_x2a_Sx_qref = mct_avect_indexra(x2a,'Sx_qref') + + index_x2a_Sf_ifrac = mct_avect_indexra(x2a,'Sf_ifrac') + index_x2a_Sf_ofrac = mct_avect_indexra(x2a,'Sf_ofrac') + index_x2a_Sf_lfrac = mct_avect_indexra(x2a,'Sf_lfrac') + + index_x2a_Sx_u10 = mct_avect_indexra(x2a,'Sx_u10') + index_x2a_Faxx_taux = mct_avect_indexra(x2a,'Faxx_taux') + index_x2a_Faxx_tauy = mct_avect_indexra(x2a,'Faxx_tauy') + index_x2a_Faxx_lat = mct_avect_indexra(x2a,'Faxx_lat') + index_x2a_Faxx_sen = mct_avect_indexra(x2a,'Faxx_sen') + index_x2a_Faxx_lwup = mct_avect_indexra(x2a,'Faxx_lwup') + index_x2a_Faxx_evap = mct_avect_indexra(x2a,'Faxx_evap') + index_x2a_So_ustar = mct_avect_indexra(x2a,'So_ustar') + index_x2a_So_re = mct_avect_indexra(x2a,'So_re') + index_x2a_So_ssq = mct_avect_indexra(x2a,'So_ssq') + index_x2a_Sl_fv = mct_avect_indexra(x2a,'Sl_fv') + index_x2a_Sl_ram1 = mct_avect_indexra(x2a,'Sl_ram1') + index_x2a_Fall_flxdst1 = mct_avect_indexra(x2a,'Fall_flxdst1') + index_x2a_Fall_flxdst2 = mct_avect_indexra(x2a,'Fall_flxdst2') + index_x2a_Fall_flxdst3 = mct_avect_indexra(x2a,'Fall_flxdst3') + index_x2a_Fall_flxdst4 = mct_avect_indexra(x2a,'Fall_flxdst4') + index_x2a_Fall_fco2_lnd = mct_avect_indexra(x2a,'Fall_fco2_lnd',perrWith='quiet') + index_x2a_Faoo_fco2_ocn = mct_avect_indexra(x2a,'Faoo_fco2_ocn',perrWith='quiet') + index_x2a_Faoo_fdms_ocn = mct_avect_indexra(x2a,'Faoo_fdms_ocn',perrWith='quiet') + + if (shr_megan_mechcomps_n>0) then + index_x2a_Fall_flxvoc = mct_avect_indexra(x2a,trim(shr_megan_fields_token)) + else + index_x2a_Fall_flxvoc = 0 + endif + + if (shr_fire_emis_mechcomps_n>0) then + index_x2a_Fall_flxfire = mct_avect_indexra(x2a,trim(shr_fire_emis_fields_token)) + index_x2a_Sl_ztopfire = mct_avect_indexra(x2a,trim(shr_fire_emis_ztop_token)) + else + index_x2a_Fall_flxfire = 0 + index_x2a_Sl_ztopfire = 0 + endif + + if ( lnd_drydep )then + index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) + else + index_x2a_Sl_ddvel = 0 + end if + + index_a2x_Sa_z = mct_avect_indexra(a2x,'Sa_z') + index_a2x_Sa_topo = mct_avect_indexra(a2x,'Sa_topo') + index_a2x_Sa_u = mct_avect_indexra(a2x,'Sa_u') + index_a2x_Sa_v = mct_avect_indexra(a2x,'Sa_v') + index_a2x_Sa_tbot = mct_avect_indexra(a2x,'Sa_tbot') + index_a2x_Sa_ptem = mct_avect_indexra(a2x,'Sa_ptem') + index_a2x_Sa_pbot = mct_avect_indexra(a2x,'Sa_pbot') + index_a2x_Sa_pslv = mct_avect_indexra(a2x,'Sa_pslv') + index_a2x_Sa_shum = mct_avect_indexra(a2x,'Sa_shum') + index_a2x_Sa_dens = mct_avect_indexra(a2x,'Sa_dens') + index_a2x_Faxa_swnet = mct_avect_indexra(a2x,'Faxa_swnet') + index_a2x_Faxa_lwdn = mct_avect_indexra(a2x,'Faxa_lwdn') + index_a2x_Faxa_rainc = mct_avect_indexra(a2x,'Faxa_rainc') + index_a2x_Faxa_rainl = mct_avect_indexra(a2x,'Faxa_rainl') + index_a2x_Faxa_snowc = mct_avect_indexra(a2x,'Faxa_snowc') + index_a2x_Faxa_snowl = mct_avect_indexra(a2x,'Faxa_snowl') + index_a2x_Faxa_swndr = mct_avect_indexra(a2x,'Faxa_swndr') + index_a2x_Faxa_swvdr = mct_avect_indexra(a2x,'Faxa_swvdr') + index_a2x_Faxa_swndf = mct_avect_indexra(a2x,'Faxa_swndf') + index_a2x_Faxa_swvdf = mct_avect_indexra(a2x,'Faxa_swvdf') + index_a2x_Faxa_bcphidry = mct_avect_indexra(a2x,'Faxa_bcphidry') + index_a2x_Faxa_bcphodry = mct_avect_indexra(a2x,'Faxa_bcphodry') + index_a2x_Faxa_bcphiwet = mct_avect_indexra(a2x,'Faxa_bcphiwet') + index_a2x_Faxa_ocphidry = mct_avect_indexra(a2x,'Faxa_ocphidry') + index_a2x_Faxa_ocphodry = mct_avect_indexra(a2x,'Faxa_ocphodry') + index_a2x_Faxa_ocphiwet = mct_avect_indexra(a2x,'Faxa_ocphiwet') + index_a2x_Faxa_dstdry1 = mct_avect_indexra(a2x,'Faxa_dstdry1') + index_a2x_Faxa_dstdry2 = mct_avect_indexra(a2x,'Faxa_dstdry2') + index_a2x_Faxa_dstdry3 = mct_avect_indexra(a2x,'Faxa_dstdry3') + index_a2x_Faxa_dstdry4 = mct_avect_indexra(a2x,'Faxa_dstdry4') + index_a2x_Faxa_dstwet1 = mct_avect_indexra(a2x,'Faxa_dstwet1') + index_a2x_Faxa_dstwet2 = mct_avect_indexra(a2x,'Faxa_dstwet2') + index_a2x_Faxa_dstwet3 = mct_avect_indexra(a2x,'Faxa_dstwet3') + index_a2x_Faxa_dstwet4 = mct_avect_indexra(a2x,'Faxa_dstwet4') + index_a2x_Sa_co2prog = mct_avect_indexra(a2x,'Sa_co2prog',perrWith='quiet') + index_a2x_Sa_co2diag = mct_avect_indexra(a2x,'Sa_co2diag',perrWith='quiet') + index_a2x_Faxa_nhx = mct_avect_indexra(a2x,'Faxa_nhx',perrWith='quiet') + index_a2x_Faxa_noy = mct_avect_indexra(a2x,'Faxa_noy',perrWith='quiet') + + call mct_aVect_clean(x2a) + call mct_aVect_clean(a2x) + + end subroutine cam_cpl_indices_set + +end module cam_cpl_indices diff --git a/src/dynamics/eul/bndexch.F90 b/src/dynamics/eul/bndexch.F90 new file mode 100644 index 0000000000..95b6a04cb5 --- /dev/null +++ b/src/dynamics/eul/bndexch.F90 @@ -0,0 +1,248 @@ + +subroutine bndexch( adv_state ) + +!----------------------------------------------------------------------- +! +! Purpose: Pack and Exchange initial prognostic information among all the +! processors +! +! Method: +! +! Author: +! +!----------------------------------------------------------------------- +! $Id$ +! $Author$ +! +!----------------------------Parameters--------------------------------- + +#ifdef SPMD + use spmd_dyn, only: cut, cutex, neighs, neighs_proc, & + neighn, neighn_proc, dyn_npes + use spmd_utils, only: iam +#endif + use scanslt, only: advection_state + + implicit none +! +! Arguments +! + type(advection_state), intent(inout) :: adv_state ! Advection state data +! +! Local workspace +! +#ifdef SPMD + integer ns, nn + integer inreg( 2 ) + integer outreg( 2 ) + integer others,othern ! Other node +! +! Return if number of processors is less than 2 +! + if (dyn_npes .lt. 2) return +! +! For each partition (south and north) communicate boundaries +! on each side of partition among however many neighbors necessary +! +! send south, receive north +! + ns = 1 + nn = 1 + do while (ns .le. neighs .or. nn .le. neighn) + if (ns .le. neighs) then + others = neighs_proc(ns) +! +! Intersection of my cuts and neighbor processor's extended +! cuts tells if this node needs to send data to neighbor +! + call intersct(cut(1,iam),cutex(1,others),outreg) + ns = ns + 1 + else + others = -1 + outreg(1) = 0 + outreg(2) = 0 + end if + + if (nn .le. neighn) then + othern = neighn_proc(nn) +! +! Intersection of neighbor cuts and this node's extended +! cut tells if this node receives data from neighbor +! + call intersct(cut(1,othern),cutex(1,iam),inreg) + nn = nn + 1 + else + othern = -1 + inreg(1) = 0 + inreg(2) = 0 + end if + + call bndexch_mpi(others,outreg,othern,inreg,adv_state) + end do + +! +! send north, receive south +! + ns = 1 + nn = 1 + do while (ns .le. neighs .or. nn .le. neighn) + if (nn .le. neighn) then + othern = neighn_proc(nn) +! +! Intersection of my cuts and neighbor processor's extended +! cuts tells if this node needs to send data to neighbor +! + call intersct(cut(1,iam),cutex(1,othern),outreg) + nn = nn + 1 + else + othern = -1 + outreg(1) = 0 + outreg(2) = 0 + end if + + if (ns .le. neighs) then + others = neighs_proc(ns) +! +! Intersection of neighbor cuts and this node's extended +! cut tells if this node receives data from neighbor +! + call intersct(cut(1,others),cutex(1,iam),inreg) + ns = ns + 1 + else + others = -1 + inreg(1) = 0 + inreg(2) = 0 + end if + + call bndexch_mpi(othern,outreg,others,inreg, adv_state) + end do +#endif + return +end subroutine bndexch + +#ifdef SPMD +subroutine bndexch_mpi(othero,outreg,otheri,inreg, adv_state) +!----------------------------------------------------------------------- +! Send initial prognostic information to my peer process +!----------------------------------------------------------------------- + use scanslt, only: plndlv, j1 + use pmgrid, only: plat + use constituents, only: pcnst + use scanslt, only: advection_state + use mpishorthand + + implicit none +! +! Arguments +! + integer othero,outreg(2),otheri,inreg(2) + type(advection_state), intent(inout) :: adv_state ! Advection state data +! +! Local variables +! + integer, parameter :: msgtype = 6000 + integer, parameter :: j1m = j1 - 1 + integer, parameter :: siz = (2 + pcnst)*plndlv + integer num + integer msg + + integer reqs(3*(plat+1)) + integer stats(MPI_STATUS_SIZE, 3*(plat+1)) + + integer reqr(3*(plat+1)) + integer statr(MPI_STATUS_SIZE, 3*(plat+1)) + + integer i,j + integer reqs_i,reqr_i + + reqr_i = 0 + if (otheri .ne. -1) then + do i = inreg(1), inreg(2) + j = 3*(i-inreg(1)) + msg = msgtype + j + reqr_i = reqr_i + 1 + call mpiirecv (adv_state%u3(1,1,j1m+i),plndlv,mpir8, otheri,msg,mpicom,reqr(reqr_i)) + + msg = msgtype + j + 1 + reqr_i = reqr_i + 1 + call mpiirecv (adv_state%v3(1,1,j1m+i),plndlv,mpir8, otheri,msg,mpicom,reqr(reqr_i)) + + msg = msgtype + j + 2 + reqr_i = reqr_i + 1 + num = pcnst*plndlv + call mpiirecv (adv_state%qminus(1,1,1,j1m+i),num,mpir8, otheri,msg,mpicom,reqr(reqr_i)) + + end do + end if + + reqs_i = 0 + if (othero .ne. -1) then + do i = outreg(1), outreg(2) + j = 3*(i-outreg(1)) + + msg = msgtype + j + reqs_i = reqs_i + 1 + call mpiisend (adv_state%u3(1,1,j1m+i),plndlv,mpir8, othero,msg,mpicom,reqs(reqs_i)) + + msg = msgtype + j + 1 + reqs_i = reqs_i + 1 + call mpiisend (adv_state%v3(1,1,j1m+i),plndlv,mpir8, othero,msg,mpicom,reqs(reqs_i)) + + msg = msgtype + j + 2 + reqs_i = reqs_i + 1 + num = pcnst*plndlv + call mpiisend (adv_state%qminus(1,1,1,j1m+i),num,mpir8, othero,msg,mpicom,reqs(reqs_i)) + + end do + end if + + if (reqs_i .ne. 0) then + call mpiwaitall(reqs_i,reqs,stats) + end if + + if (reqr_i .ne. 0) then + call mpiwaitall(reqr_i,reqr,statr) + end if + + return +end subroutine bndexch_mpi + +subroutine intersct (regiona, regionb, regionc) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Given two regions (a,b) output the intersection (common latitudes) +! of these two sets. The routine is used in bndexch to determine which +! latitudes need to be communicated to neighboring processors. Typically +! this routine is invoked as the intersection of the set of resident +! latitudes on processor A with the set of extended latitudes (needed for +! the SLT) of processor B. Any common latitudes will need to be +! communicated to B to complete SLT processing. +! +! Author: +! Original version: CCM2 +! Standardized: J. Rosinski, Oct 1995 +! J. Truesdale, Feb. 1996 +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------Commons------------------------------------ + implicit none +! +!---------------------------Local workspace----------------------------- +! + integer regiona( 2 ),regionb( 2 ),regionc( 2 ) +! +!----------------------------------------------------------------------- +! + regionc( 1 ) = max( regiona( 1 ), regionb( 1 ) ) + regionc( 2 ) = min( regiona( 2 ), regionb( 2 ) ) + + return +end subroutine intersct +#endif diff --git a/src/dynamics/eul/commap.F90 b/src/dynamics/eul/commap.F90 new file mode 100644 index 0000000000..a47acecbb5 --- /dev/null +++ b/src/dynamics/eul/commap.F90 @@ -0,0 +1,23 @@ +module commap + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plat, plon + use pspect, only: pmmax, pnmax + + real(r8) :: bps(plev) ! coefficient for ln(ps) term in divergence eqn + real(r8) :: sq(pnmax) ! n(n+1)/a^2 (del^2 response function) + real(r8) :: rsq(pnmax) ! a^2/(n(n+1)) + real(r8) :: slat((plat+1)/2) ! |sine latitude| (hemisphere) + real(r8), target :: w(plat) ! gaussian weights (hemisphere) + real(r8) :: cs((plat+1)/2) ! cosine squared latitude (hemisphere) + real(r8) :: href(plev,plev) ! reference hydrostatic equation matrix + real(r8) :: ecref(plev,plev) ! reference energy conversion matrix + real(r8), target :: clat(plat) ! model latitudes (radians) + real(r8), target :: clon(plon,plat) ! model longitudes (radians) + real(r8), target :: latdeg(plat) ! model latitudes (degrees) + real(r8) :: bm1(plev,plev,pnmax) ! transpose of right eigenvectors of semi-implicit matrix + real(r8) :: tau(plev,plev ) ! matrix for reference d term in thermodynamic eqn + real(r8), target :: londeg(plon,plat) ! model longitudes (degrees) + real(r8) :: t0(plev) ! Reference temperature for t-prime computations + real(r8) :: xm(pmmax) ! m (longitudinal wave number) +end module commap diff --git a/src/dynamics/eul/comspe.F90 b/src/dynamics/eul/comspe.F90 new file mode 100644 index 0000000000..f33933d445 --- /dev/null +++ b/src/dynamics/eul/comspe.F90 @@ -0,0 +1,43 @@ +module comspe + +! Spectral space arrays + +use shr_kind_mod, only: r8 => shr_kind_r8 +use pmgrid, only: plev, plat +use pspect, only: pmmax, pspt + +implicit none + +real(r8), dimension(:,:), allocatable :: vz ! Vorticity spectral coefficients +real(r8), dimension(:,:), allocatable :: d ! Divergence spectral coefficients +real(r8), dimension(:,:), allocatable :: t ! Temperature spectral coefficients +real(r8), dimension(:), allocatable :: alps ! Log-pressure spectral coefficients + +#if ( defined SPMD ) +integer :: maxm = huge(1) ! max number of Fourier wavenumbers per MPI task +integer :: lpspt = huge(1) ! number of local spectral coefficients +integer, dimension(:), allocatable :: numm + ! number of Fourier wavenumbers owned per task +integer, dimension(:,:), allocatable :: locm, locrm + ! assignment of wavenumbers to MPI tasks +integer, dimension(:), allocatable :: lnstart + ! Starting indices for local spectral arrays (real) +#else +integer :: numm(0:0) = pmmax +integer :: maxm = pmmax +integer :: lpspt = pspt +integer :: locm(1:pmmax, 0:0) = huge(1) +integer :: locrm(1:2*pmmax, 0:0) = huge(1) +integer :: lnstart(1:pmmax) = huge(1) +#endif + +integer :: nstart(pmmax) = huge(1) ! Starting indices for spectral arrays (real) +integer :: nlen(pmmax) = huge(1) ! Length vectors for spectral arrays + +real(r8), dimension(:,:), allocatable :: alp ! Legendre polynomials (pspt,plat/2) +real(r8), dimension(:,:), allocatable :: dalp ! Legendre polynomial derivatives (pspt,plat/2) + +real(r8), dimension(:,:), allocatable :: lalp ! local Legendre polynomials +real(r8), dimension(:,:), allocatable :: ldalp ! local Legendre polynomial derivatives + +end module comspe diff --git a/src/dynamics/eul/comsta.h b/src/dynamics/eul/comsta.h new file mode 100644 index 0000000000..70393bcc47 --- /dev/null +++ b/src/dynamics/eul/comsta.h @@ -0,0 +1,15 @@ +! +! $Id$ +! $Author$ +! +! +! Diagnostic statistics integrals +! + common/comsta/rmsz(plat) ,rmsd(plat) ,rmst(plat) ,stq(plat), & + psurf(plat) +! + real(r8) rmsz ! lambda/p sum of w*dp/ps times square vorticity + real(r8) rmsd ! lambda/p sum of w*dp/ps times square divergence + real(r8) rmst ! lambda/p sum of w*dp/ps times square temperature + real(r8) stq ! lambda/p sum of w*dp/ps times square moisture + real(r8) psurf ! lambda/p sum of w*dp/ps times square surface press diff --git a/src/dynamics/eul/courlim.F90 b/src/dynamics/eul/courlim.F90 new file mode 100644 index 0000000000..f1a84853f2 --- /dev/null +++ b/src/dynamics/eul/courlim.F90 @@ -0,0 +1,170 @@ + +subroutine courlim (vmax2d, vmax2dt, vcour) + +!----------------------------------------------------------------------- +! +! Purpose: +! Find out whether Courant limiter needs to be applied +! +! Method: +! +! Author: +! Original version: CCM2 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use physconst, only: rga + use time_manager, only: get_nstep, is_first_step + use eul_control_mod +#ifdef SPMD + use mpishorthand +#endif + use spmd_utils, only: masterproc + use perf_mod + use cam_logfile, only: iulog + + implicit none + +#include + +! +! Arguments +! + real(r8), intent(inout) :: vmax2d(plev,plat) ! Max. wind at each level, latitude + real(r8), intent(inout) :: vmax2dt(plev,plat) ! Max. truncated wind at each lvl,lat + real(r8), intent(inout) :: vcour(plev,plat) ! Maximum Courant number in slice +! +!--------------------------Local Variables------------------------------ +! + integer k,lat ! Indices + integer latarr(1) ! Output from maxloc (needs to be array for conformability) + integer :: nstep ! Current timestep number + + real(r8) vcourmax ! Max courant number in the vertical wind field + real(r8) vmax1d(plev) ! Sqrt of max wind speed + real(r8) vmax1dt(plev) ! Sqrt of max wind speed + real(r8) cn ! Estimate of truncated Courant number + real(r8) cnmax ! Max. courant no. horiz. wind field + real(r8) psurfsum ! Summing variable - global mass + real(r8) stqsum ! Summing variable - global moisture + real(r8) rmszsum ! Summing variable - global vorticity + real(r8) rmsdsum ! Summing variable - global divergence + real(r8) rmstsum ! Summing variable - global temperature + real(r8) stps ! Global Mass integral + real(r8) stqf ! Global Moisture integral + real(r8) rmszf ! Global RMS Vorticity + real(r8) rmsdf ! Global RMS Divergence + real(r8) rmstf ! Global RMS Temperature +! +!----------------------------------------------------------------------- +! +#if ( defined SPMD ) + call t_barrierf ('sync_realloc7', mpicom) + call t_startf ('realloc7') + call realloc7 (vmax2d, vmax2dt, vcour) + call t_stopf ('realloc7') +#endif + + nstep = get_nstep() +! +! Compute maximum wind speed for each level +! + do k=1,plev + vmax1d(k) = sqrt (maxval (vmax2d(k,:))) + vmax1dt(k) = sqrt (maxval (vmax2dt(k,:))) + end do +! +! Compute max. vertical Courant number (k is index to Model interfaces) +! + vcourmax = maxval (vcour(2:,:)) +! +! Determine whether the CFL limit has been exceeded for each level +! within the specified range (k<=kmxhdc). Set the truncation wave number +! (for each level independently) so that the CFL limit will not be +! violated and print a message (information only). The trunc wavenumber +! is used later in "hordif" to adjust the diffusion coefficients for +! waves beyond the limit. Store the maximum Courant number for printing +! on the stats line. Note that the max Courant number is not computed +! for the entire vertical domain, just the portion for which the limiter +! is actually applied. +! + cnmax = 0._r8 + do k=1,kmxhdc + cn = vmax1dt(k)*cnfac ! estimate of truncated Courant number + cnmax = max(cnmax,cn) + if (cn .gt. cnlim) then + nindex(k) = int(nmaxhd*cnlim/cn + 1._r8) + latarr = maxloc (vmax2dt(k,:)) + if (masterproc) write(iulog,800)k,latarr,cn,nindex(k)-1 + else + nindex(k) = 2*nmaxhd + endif + end do +! +! Write out estimate of original Courant number if limit is exceeded +! + do k=1,kmxhdc + cn = vmax1d(k)*cnfac ! estimate of original Courant number + if (cn .gt. cnlim) then + latarr = maxloc (vmax2d(k,:)) + if (masterproc) write(iulog,805) k,latarr,cn + end if + end do +! +! Compute Max Courant # for whole atmosphere for diagnostic output +! + cnmax = 0._r8 + do k=1,plev-1 + cn = vmax1dt(k)*cnfac ! estimate of Courant number + cnmax = max(cnmax,cn) + end do +! +! Write out statisitics to standard output +! + psurfsum = 0._r8 + stqsum = 0._r8 + rmszsum = 0._r8 + rmsdsum = 0._r8 + rmstsum = 0._r8 + + do lat=1,plat + psurfsum = psurfsum + psurf(lat) + stqsum = stqsum + stq(lat) + rmszsum = rmszsum + rmsz(lat) + rmsdsum = rmsdsum + rmsd(lat) + rmstsum = rmstsum + rmst(lat) + end do + + stps = 0.5_r8*psurfsum + stqf = 0.5_r8*rga*stqsum + rmszf = sqrt(0.5_r8*rmszsum) + rmsdf = sqrt(0.5_r8*rmsdsum) + rmstf = sqrt(0.5_r8*rmstsum) + if (masterproc) then + if (is_first_step()) write(iulog,810) + write(iulog,820) nstep, rmszf, rmsdf, rmstf, stps, stqf, cnmax, vcourmax + end if +! + return +! +! Formats +! +800 format('COURLIM: *** Courant limit exceeded at k,lat=',2i3, & + ' (estimate = ',f6.3, '), solution has been truncated to ', & + 'wavenumber ',i3,' ***') +805 format(' *** Original Courant limit exceeded at k,lat=',2i3, & + ' (estimate = ',f6.3,')',' ***') +810 format(/109x,'COURANT'/10x,'NSTEP',4x,'RMSZ',19x,'RMSD',19x, & + 'RMST',4x,'STPS',9x,'STQ',19x,'HOR VERT') +820 format(' NSTEP =',i8,1x,1p,2e23.15,0p,1f8.3,1p,1e13.5,e23.15, & + 0p,1f5.2,f6.2) +end subroutine courlim + diff --git a/src/dynamics/eul/cubxdr.F90 b/src/dynamics/eul/cubxdr.F90 new file mode 100644 index 0000000000..bcfcb6987b --- /dev/null +++ b/src/dynamics/eul/cubxdr.F90 @@ -0,0 +1,80 @@ +subroutine cubxdr(pidim ,ibeg ,len ,dx ,f , & + fxl ,fxr ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute Lagrangian cubic derivative estimates for data on an equally +! spaced grid. +! +! Method: +! Compute Lagrangian cubic derivative estimates for data on an equally +! spaced grid. Suppose grid interval i is centered in a 4 point +! stencil consisting of grid points i-1, i, i+1, and i+2. Then the +! derivative at the left edge of the interval (i.e., grid point i) +! is stored in fxl(i), and the derivative at the right edge of the +! interval (i.e., grid point i+1) is stored in fxr(i). Note that +! fxl(i) is not necessarily equal to fxr(i-1) even though both of +! these values are estimates of the derivative at grid point i. +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pidim ! dimension + integer, intent(in) :: ibeg ! starting index to perform computation + integer, intent(in) :: len ! length over which to perform comp. +! + real(r8), intent(in) :: dx ! grid interval + real(r8), intent(in) :: f(pidim) ! input field values +! +! Output arguments +! + real(r8), intent(out) :: fxl(pidim) ! left derivative of interval i in "f" + real(r8), intent(out) :: fxr(pidim) ! right derivative of interval i in "f" +!----------------------------------------------------------------------- +! +! pidim Length of f, fxl, and fxr. +! ibeg First interval of grid for which derivatives are computed. +! len Number of grid intervals for which derivatives are computed. +! (There are pidim - 1 intervals between the pidim gridpoints +! represented in f, fxl, and fxr.) +! dx Value of grid spacing. +! f Values on equally spaced grid for which derivatives are +! computed. +! fxl fxl(i) is the derivative at the left edge of interval i. +! fxr fxr(i) is the derivative at the right edge of interval i. +! +!---------------------------Local variables----------------------------- +! + integer i ! index + integer iend ! index denoting end of computation +! + real(r8) rdx6 ! normalization weight +! +!----------------------------------------------------------------------- +! + iend = ibeg + len - 1 + rdx6 = 1._r8/(6._r8*dx) +! + do i = ibeg,iend + fxl(i) = ( -2._r8*f(i-1) - 3._r8*f(i) + 6._r8*f(i+1) - f(i+2) )*rdx6 + fxr(i) = ( f(i-1) - 6._r8*f(i) + 3._r8*f(i+1) + 2._r8*f(i+2) )*rdx6 + end do +! + return +end subroutine cubxdr + diff --git a/src/dynamics/eul/cubydr.F90 b/src/dynamics/eul/cubydr.F90 new file mode 100644 index 0000000000..b20ccc6f86 --- /dev/null +++ b/src/dynamics/eul/cubydr.F90 @@ -0,0 +1,130 @@ +subroutine cubydr(pf ,fint ,wdy ,jdp ,jcen , & + fyb ,fyt ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute Lagrangian cubic derivative estimates at both ends of the +! intervals in the y coordinate (unequally spaced) containing the +! departure points for the latitude slice being forecasted. +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: platd + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if ( ! defined UNICOSMP ) + use srchutil, only: whenieq +#endif +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! number of constituent fields +! + real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! constituent x- interpolants + real(r8), intent(in) :: wdy(4,2,platd) ! latitude interpolation weights +! + integer, intent(in) :: jdp(plon,plev) ! indices of latitude intervals + integer, intent(in) :: jcen ! current latitude index + integer, intent(in) :: nlon +! +! Output arguments +! + real(r8), intent(out) :: fyb(plon,plev,pf) ! Derivative at south end of interval + real(r8), intent(out) :: fyt(plon,plev,pf) ! Derivative at north end of interval +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! fint (fint(i,k,j,m),j=1,ppdy) contains the x interpolants at each +! latitude needed for the y derivative estimates at the +! endpoints of the interval that contains the departure point +! for grid point (i,k). The last index of fint allows for +! interpolation of multiple fields. fint is generated by a +! call to herxin. +! wdy Weights for Lagrange cubic derivative estimates on the +! unequally spaced latitude grid. If grid interval j (in +! extended array) is surrounded by a 4 point stencil, then +! the derivative at the "bottom" of the interval uses the +! weights wdy(1,1,j),wdy(2,1,j), wdy(3,1,j), and wdy(4,1,j). +! The derivative at the "top" of the interval uses wdy(1,2,j), +! wdy(2,2,j), wdy(3,2,j), and wdy(4,2,j). +! jdp jdp(i,k) is the index of the y-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Suppose yb contains the y-coordinates of the extended array +! and ydp(i,k) is the y-coordinate of the departure point +! corresponding to grid point (i,k). Then, +! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . +! fyb fyb(i,k,.) is the derivative at the bottom of the y interval +! that contains the departure point of global grid point (i,k). +! fyt fyt(i,k,.) is the derivative at the top of the y interval +! that contains the departure point of global grid point (i,k). +! +!---------------------------Local variables----------------------------- +! + integer i,k ! index + integer m ! index + integer jdpval ! index + integer icount ! counter + integer ii ! index + integer indx(plon) ! set of indices for indirect addressing + integer nval(plev) ! number of indices for given "jdpval" +! +!----------------------------------------------------------------------- +! + icount = 0 + do jdpval=jcen-2,jcen+1 +!$OMP PARALLEL DO PRIVATE (K, INDX, M, II, I) + do k=1,plev + call whenieq(nlon,jdp(1,k),1,jdpval,indx,nval(k)) + do m=1,pf + do ii=1,nval(k) + i=indx(ii) + fyb(i,k,m) = wdy(1,1,jdpval)*fint(i,k,1,m) + & + wdy(2,1,jdpval)*fint(i,k,2,m) + & + wdy(3,1,jdpval)*fint(i,k,3,m) + & + wdy(4,1,jdpval)*fint(i,k,4,m) +! + fyt(i,k,m) = wdy(1,2,jdpval)*fint(i,k,1,m) + & + wdy(2,2,jdpval)*fint(i,k,2,m) + & + wdy(3,2,jdpval)*fint(i,k,3,m) + & + wdy(4,2,jdpval)*fint(i,k,4,m) + end do + end do + end do + do k=1,plev + icount = icount + nval(k) + enddo + if (icount.eq.nlon*plev) return + end do + if (icount.ne.nlon*plev) then + write(iulog,*)'CUBYDR: Departure point out of bounds: jcen,icount,nlon*plev=',jcen,icount,nlon*plev + write(iulog,*)' ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun () + end if +! + return +end subroutine cubydr diff --git a/src/dynamics/eul/cubzdr.F90 b/src/dynamics/eul/cubzdr.F90 new file mode 100644 index 0000000000..c5760249ce --- /dev/null +++ b/src/dynamics/eul/cubzdr.F90 @@ -0,0 +1,99 @@ + +subroutine cubzdr(nlon ,pkdim ,f ,lbasdz ,dfz1 , & + dfz2 ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Vertical derivative estimates for a vertical slice using Lagrangian +! cubic formulas. +! +! Method: +! Derivatives are set to zero at the top and bottom. +! At the "inner nodes" of the top and bottom intervals, a "one sided" +! estimate is used. +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon +!----------------------------------------------------------------------- + implicit none +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: nlon ! number of longitudes + integer, intent(in) :: pkdim ! vertical dimension +! + real(r8), intent(in) :: f(plon,pkdim) ! constituent field + real(r8), intent(in) :: lbasdz(4,2,pkdim) ! vertical interpolation weights +! +! Output arguments +! + real(r8), intent(out) :: dfz1(plon,pkdim) ! derivative at top of interval + real(r8), intent(out) :: dfz2(plon,pkdim) ! derivative at bot of interval +!----------------------------------------------------------------------- +! +! nlon Number of longitudes +! pkdim Vertical dimension of arrays. +! f Vertical slice of data for which derivative estimates are +! made +! lbasdz Lagrangian cubic basis functions for evaluating the +! derivatives on the unequally spaced vertical grid. +! dfz1 dfz1 contains derivative estimates at the "top" edges of the +! intervals in the f array. +! dfz2 dfz2 contains derivative estimates at the "bottom" edges of +! the intervals in the f array. +! +!---------------------------Local variables----------------------------- +! + integer i,k ! indices +! +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=2,pkdim-2 + do i=1,nlon +! +! Lagrangian derivative estimates (cubic) for the two center nodes in a +! four node stencil. +! + dfz1(i,k) = lbasdz(1,1,k)*f(i,k-1) + & + lbasdz(2,1,k)*f(i,k) + & + lbasdz(3,1,k)*f(i,k+1) + & + lbasdz(4,1,k)*f(i,k+2) +! + dfz2(i,k) = lbasdz(1,2,k)*f(i,k-1) + & + lbasdz(2,2,k)*f(i,k) + & + lbasdz(3,2,k)*f(i,k+1) + & + lbasdz(4,2,k)*f(i,k+2) + end do + end do +! +! Constrain derivatives to zero at top and bottom of vertical grid. +! At the interior nodes of the intervals at the top and bottom of the +! vertical grid, use the derivative estimate at that same node for the +! adjacent interval. (This is a "one-sided" estimate for that node.) +! + do i=1,nlon + dfz1(i,1) = 0.0_r8 + dfz2(i,1) = dfz1(i,2) + dfz1(i,pkdim-1) = dfz2(i,pkdim-2) + dfz2(i,pkdim-1) = 0.0_r8 + end do +! + return +end subroutine cubzdr + diff --git a/src/dynamics/eul/diag_dynvar_ic.F90 b/src/dynamics/eul/diag_dynvar_ic.F90 new file mode 100644 index 0000000000..c963605fe6 --- /dev/null +++ b/src/dynamics/eul/diag_dynvar_ic.F90 @@ -0,0 +1,67 @@ + + subroutine diag_dynvar_ic(phis, ps, t3, u3, v3, q3) +! +!----------------------------------------------------------------------- +! +! Purpose: record state variables to IC file +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use cam_history , only: outfld, write_inithist + use constituents, only: pcnst, cnst_name + use commap, only:clat,clon + use dyn_grid, only : get_horiz_grid_d + implicit none +! +!----------------------------------------------------------------------- +! +! Arguments +! + real(r8), intent(in) :: phis(plon, beglat:endlat) ! Surface geopotential + real(r8), intent(in) :: ps (plon, beglat:endlat) ! surface pressure + real(r8), intent(in) :: t3 (plon, plev, beglat:endlat) ! temperature + real(r8), intent(in) :: u3 (plon, plev, beglat:endlat) ! u-wind component + real(r8), intent(in) :: v3 (plon, plev, beglat:endlat) ! v-wind component + real(r8), intent(in) :: q3 (plon, plev, pcnst, beglat:endlat) ! constituents + real(r8) :: clat_plon(plon) ! constituents + real(r8) :: phi(plat) ! constituents + real(r8) :: lam(plon) ! constituents +! +!---------------------------Local workspace----------------------------- +! + integer lat, m ! indices +! +!----------------------------------------------------------------------- +! + if( write_inithist() ) then + +!$OMP PARALLEL DO PRIVATE (LAT, M) + do lat=beglat,endlat + + call outfld('PS&IC ' , ps (1 ,lat), plon, lat) + call outfld('T&IC ' , t3 (1,1,lat), plon, lat) + call outfld('U&IC ' , u3 (1,1,lat), plon, lat) + call outfld('V&IC ' , v3 (1,1,lat), plon, lat) +#if (defined BFB_CAM_SCAM_IOP) + clat_plon(:)=clat(lat) + call outfld('CLAT1&IC ', clat_plon, plon, lat) + call outfld('CLON1&IC ', clon, plon, lat) + call get_horiz_grid_d(plat, clat_d_out=phi) + call get_horiz_grid_d(plon, clon_d_out=lam) + clat_plon(:)=phi(lat) + call outfld('LAM&IC ', lam, plon, lat) + call outfld('PHI&IC ', clat_plon, plon, lat) +#endif + + do m=1,pcnst + call outfld(trim(cnst_name(m))//'&IC', q3(1,1,m,lat), plon, lat) + end do + + end do + + end if + + return + end subroutine diag_dynvar_ic diff --git a/src/dynamics/eul/dp_coupling.F90 b/src/dynamics/eul/dp_coupling.F90 new file mode 100644 index 0000000000..661b66a953 --- /dev/null +++ b/src/dynamics/eul/dp_coupling.F90 @@ -0,0 +1,474 @@ + +!------------------------------------------------------------------------------- +! dynamics - physics coupling module +!------------------------------------------------------------------------------- +module dp_coupling + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use pmgrid, only: plev, beglat, endlat, plon + + use phys_grid + use physics_types, only: physics_state, physics_tend + use constituents, only: pcnst + use physconst, only: cpair, gravit, rair, zvir, rairv + use geopotential, only: geopotential_t + use check_energy, only: check_energy_timestep_init +#if (defined SPMD) + use spmd_dyn, only: buf1, buf1win, buf2, buf2win, & + spmdbuf_siz, local_dp_map, & + block_buf_nrecs, chunk_buf_nrecs + use mpishorthand, only: mpicom +#endif + use cam_abortutils, only: endrun + use perf_mod + + implicit none + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== + subroutine d_p_coupling(ps, t3, u3, v3, q3, & + omga, phis, phys_state, phys_tend, pbuf2d, pdeld) +!------------------------------------------------------------------------------ +! Coupler for converting dynamics output variables into physics input variables +! also writes dynamics variables (on physics grid) to history file +!------------------------------------------------------------------------------ + use physconst, only: cappa + use constituents, only: cnst_get_type_byind, qmin + use physics_types, only: set_state_pdry + use physics_buffer, only: pbuf_get_chunk, physics_buffer_desc + use qneg_module, only: qneg3 + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: ps (plon, beglat:endlat) ! surface pressure + real(r8), intent(in) :: t3 (plon, plev, beglat:endlat) ! temperature + real(r8), intent(in) :: u3 (plon, plev, beglat:endlat) ! u-wind component + real(r8), intent(in) :: v3 (plon, plev, beglat:endlat) ! v-wind component + real(r8), intent(in) :: q3 (plon, plev, pcnst, beglat:endlat) ! constituents + real(r8), intent(in) :: omga(plon, plev, beglat:endlat) ! vertical velocity + real(r8), intent(in) :: phis(plon, beglat:endlat) ! Surface geopotential + real(r8), intent(in) :: pdeld (:,:,beglat:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + +! +!---------------------------Local workspace----------------------------- +#if (! defined SPMD) + real(r8) :: buf1(1), buf2(1) ! transpose buffers + integer :: buf1win, buf2win ! MPI-2 window ids + integer :: spmdbuf_siz = 0 + integer :: block_buf_nrecs = 0 + integer :: chunk_buf_nrecs = 0 + integer :: mpicom = 0 + logical :: local_dp_map=.true. +#endif + + integer :: i,k,j,m,lchnk ! indices + integer :: ncol ! number of columns in current chunk + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: tsize ! amount of data per grid point passed to physics + integer :: bpter(plon,0:plev) ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + logical :: wetq(pcnst) ! 'moist-type' constituent flag + real(r8) :: rlat(pcols) ! array of latitudes (radians) + real(r8) :: rlon(pcols) ! array of longitudes (radians) + real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + +!----------------------------------------------------------------------- + +! Determine which constituents are wet and which are dry + do m=2,pcnst + if (cnst_get_type_byind(m).eq.'wet') then + wetq(m) = .true. + else + wetq(m) = .false. + endif + enddo + +!----------------------------------------------------------------------- +! copy data from dynamics data structure to physics data structure +!----------------------------------------------------------------------- + if (local_dp_map) then + +!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS) + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + + do i=1,ncol + phys_state(lchnk)%ps (i) = ps (lons(i),lats(i)) + phys_state(lchnk)%phis (i) = phis(lons(i),lats(i)) + end do + + do k=1,plev + do i=1,ncol + phys_state(lchnk)%t (i,k) = t3 (lons(i),k,lats(i)) + phys_state(lchnk)%u (i,k) = u3 (lons(i),k,lats(i)) + phys_state(lchnk)%v (i,k) = v3 (lons(i),k,lats(i)) + phys_state(lchnk)%omega(i,k) = omga(lons(i),k,lats(i)) + phys_state(lchnk)%q(i,k,1) = q3 (lons(i),k,1,lats(i)) + end do + end do + + do k=1,plev + do i=1,ncol + phys_state(lchnk)%pdeldry(i,k) = pdeld(lons(i),k,lats(i)) + end do + end do + + ! convert moist-type constituents from dry to moist mixing ratio + + do m=2,pcnst + if (wetq(m)) then + do k=1,plev + do i=1,ncol + phys_state(lchnk)%q(i,k,m) = q3(lons(i),k,m,lats(i))*(1._r8 - q3(lons(i),k,1,lats(i))) + end do + end do + else + do k=1,plev + do i=1,ncol + phys_state(lchnk)%q(i,k,m) = q3(lons(i),k,m,lats(i)) + end do + end do + endif + end do + + end do + + else + + tsize = 5 + pcnst + + if (tsize*max(block_buf_nrecs,chunk_buf_nrecs) > spmdbuf_siz) then + call endrun ('p_d_coupling: communication buffers (spmdbuf_siz) too small') + endif + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (J, BPTER, I, K, M) +#endif + do j=beglat,endlat + + call block_to_chunk_send_pters(j,plon,plev+1,tsize,bpter) + + do i=1,plon + buf1(bpter(i,0)) = ps (i,j) + buf1(bpter(i,0)+1) = phis(i,j) + end do + +!$OMP PARALLEL DO PRIVATE (K, I, M) + do k=1,plev + + do i=1,plon + + buf1(bpter(i,k)) = t3 (i,k,j) + buf1(bpter(i,k)+1) = u3 (i,k,j) + buf1(bpter(i,k)+2) = v3 (i,k,j) + buf1(bpter(i,k)+3) = omga(i,k,j) + buf1(bpter(i,k)+4) = q3 (i,k,1,j) + + ! convert moist-type constituents from dry to moist mixing ratio + + do m=2,pcnst + if (wetq(m)) then + buf1(bpter(i,k)+3+m) = q3(i,k,m,j)*(1._r8 - q3(i,k,1,j)) + else + buf1(bpter(i,k)+3+m) = q3(i,k,m,j) + endif + end do + + buf1(bpter(i,k)+4+pcnst) = pdeld(i,k,j) + + end do + + end do + + end do + + call t_barrierf ('sync_blk_to_chk', mpicom) + call t_startf ('block_to_chunk') + call transpose_block_to_chunk(tsize, buf1, buf2, buf2win) + call t_stopf ('block_to_chunk') + +!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, CPTER, I, K, M) + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + + call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) + + do i=1,ncol + phys_state(lchnk)%ps (i) = buf2(cpter(i,0)) + phys_state(lchnk)%phis (i) = buf2(cpter(i,0)+1) + end do + + do k=1,plev + + do i=1,ncol + + phys_state(lchnk)%t (i,k) = buf2(cpter(i,k)) + phys_state(lchnk)%u (i,k) = buf2(cpter(i,k)+1) + phys_state(lchnk)%v (i,k) = buf2(cpter(i,k)+2) + phys_state(lchnk)%omega (i,k) = buf2(cpter(i,k)+3) + + do m=1,pcnst + phys_state(lchnk)%q (i,k,m) = buf2(cpter(i,k)+3+m) + end do + + phys_state(lchnk)%pdeldry(i,k) = buf2(cpter(i,k)+4+pcnst) + + end do + + end do + + end do + + endif + +!----------------------------------------------------------------------- +! Fill auxilliary arrays in physics data structure +!----------------------------------------------------------------------- +!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS, ZVIRV, pbuf_chnk) + + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + +! pressure arrays + call plevs0(ncol, pcols, pver, & + phys_state(lchnk)%ps, phys_state(lchnk)%pint, & + phys_state(lchnk)%pmid, phys_state(lchnk)%pdel) + +! log(pressure) arrays and Exner function + do k=1,pver+1 + do i=1,ncol + phys_state(lchnk)%lnpint(i,k) = log(phys_state(lchnk)%pint(i,k)) + end do + end do + do k=1,pver + do i=1,ncol + phys_state(lchnk)%rpdel(i,k) = 1._r8/phys_state(lchnk)%pdel(i,k) + phys_state(lchnk)%lnpmid(i,k) = log(phys_state(lchnk)%pmid(i,k)) + phys_state(lchnk)%exner (i,k) = (phys_state(lchnk)%pint(i,pver+1) & + / phys_state(lchnk)%pmid(i,k))**cappa + end do + end do + +!----------------------------------------------------------------------------------- +! Need to fill zvirv 2D variable to be compatible with geopotential_t interface +!----------------------------------------------------------------------------------- + zvirv(:,:) = zvir + +! Compute initial geopotential heights + call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & + phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) + +! Compute initial dry static energy, include surface geopotential + do k = 1, pver + do i=1,ncol + phys_state(lchnk)%s(i,k) = cpair*phys_state(lchnk)%t(i,k) & + + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) + end do + end do + +! Compute other dry fields in phys_state, using pdeld copied from dynamics above + call set_state_pdry(phys_state(lchnk),pdeld_calc=.false.) + +! +! Ensure tracers are all positive +! + call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,phys_state(lchnk)%q) + +! Compute energy and water integrals of input state + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk ) + + end do + + return + end subroutine d_p_coupling + +!=============================================================================== + subroutine p_d_coupling(phys_state, phys_tend, t2, fu, fv, flx_net, qminus) +!------------------------------------------------------------------------------ +! Coupler for converting physics output variables into dynamics input variables +!------------------------------Arguments-------------------------------- + use constituents, only: cnst_get_type_byind + + type(physics_state),intent(in), dimension(begchunk:endchunk) :: phys_state + type(physics_tend), intent(in), dimension(begchunk:endchunk) :: phys_tend + + real(r8), intent(out) :: t2(plon, plev, beglat:endlat) ! temp tendency + real(r8), intent(out) :: fu(plon, plev, beglat:endlat) ! u wind tendency + real(r8), intent(out) :: fv(plon, plev, beglat:endlat) ! v wind tendency + real(r8), intent(out) :: flx_net(plon,beglat:endlat) ! net flux + real(r8), intent(out) :: qminus(plon, plev, pcnst, beglat:endlat) ! constituents +! +!---------------------------Local workspace----------------------------- +#if (! defined SPMD) + real(r8) :: buf1(1), buf2(1) ! transpose buffers + integer :: buf1win, buf2win ! MPI-2 window ids + integer :: spmdbuf_siz = 0 + integer :: block_buf_nrecs = 0 + integer :: chunk_buf_nrecs = 0 + integer :: mpicom = 0 + logical :: local_dp_map=.true. +#endif + + integer :: i,j,k,m,lchnk ! indices + integer :: ncol ! number of columns in current chunk + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: tsize ! amount of data per grid point passed to physics + integer :: bpter(plon,0:plev) ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + logical :: wetq(pcnst) ! 'wet' constituent flag +!----------------------------------------------------------------------- + +! Determine which constituents are wet and which are dry + do m=2,pcnst + if (cnst_get_type_byind(m).eq.'wet') then + wetq(m) = .true. + else + wetq(m) = .false. + endif + enddo +!----------------------------------------------------------------------- +! copy data from physics data structure to dynamics data structure +!----------------------------------------------------------------------- + if (local_dp_map) then + +!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS) + + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + + do k=1,plev + do i=1,ncol + t2(lons(i),k,lats(i)) = phys_tend(lchnk)%dTdt (i,k) + fu(lons(i),k,lats(i)) = phys_tend(lchnk)%dudt (i,k) + fv(lons(i),k,lats(i)) = phys_tend(lchnk)%dvdt (i,k) + qminus(lons(i),k,1,lats(i)) = phys_state(lchnk)%q(i,k,1) + end do + end do + + do i=1,ncol + flx_net(lons(i),lats(i)) = phys_tend(lchnk)%flx_net(i) + end do + + ! convert moist-type constituents from moist to dry mixing ratio + + do m=2,pcnst + if (wetq(m)) then + do k=1,plev + do i=1,ncol + qminus(lons(i),k,m,lats(i)) = phys_state(lchnk)%q(i,k,m) / & + (1._r8 - phys_state(lchnk)%q(i,k,1)) + end do + end do + else + do k=1,plev + do i=1,ncol + qminus(lons(i),k,m,lats(i)) = phys_state(lchnk)%q(i,k,m) + end do + end do + endif + end do + + end do + + else + + tsize = 3 + pcnst + + if (tsize*max(block_buf_nrecs,chunk_buf_nrecs) > spmdbuf_siz) then + call endrun ('d_p_coupling: communication buffers (spmdbuf_siz) too small') + endif + +!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, CPTER, I, K, M) + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + call chunk_to_block_send_pters(lchnk,pcols,pver+1,tsize,cpter) + + do i=1,ncol + buf2(cpter(i,0)) = phys_tend(lchnk)%flx_net(i) + end do + + do k=1,plev + + do i=1,ncol + + buf2(cpter(i,k)) = phys_tend(lchnk)%dTdt (i,k) + buf2(cpter(i,k)+1) = phys_tend(lchnk)%dudt (i,k) + buf2(cpter(i,k)+2) = phys_tend(lchnk)%dvdt (i,k) + buf2(cpter(i,k)+3) = phys_state(lchnk)%q(i,k,1) + + ! convert moist-type constituents from moist to dry mixing ratio + + do m=2,pcnst + if (wetq(m)) then + buf2(cpter(i,k)+2+m) = phys_state(lchnk)%q(i,k,m) / & + (1._r8 - phys_state(lchnk)%q(i,k,1)) + else + buf2(cpter(i,k)+2+m) = phys_state(lchnk)%q(i,k,m) + endif + end do + + end do + + end do + + end do + + call t_barrierf ('sync_chk_to_blk', mpicom) + call t_startf ('chunk_to_block') + call transpose_chunk_to_block(tsize, buf2, buf1, buf1win) + call t_stopf ('chunk_to_block') + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (J, BPTER, I, K, M) +#endif + do j=beglat,endlat + + call chunk_to_block_recv_pters(j,plon,plev+1,tsize,bpter) + + do i=1,plon + flx_net(i,j) = buf1(bpter(i,0)) + end do + +!$OMP PARALLEL DO PRIVATE (K, I, M) + do k=1,plev + + do i=1,plon + + t2(i,k,j) = buf1(bpter(i,k)) + fu(i,k,j) = buf1(bpter(i,k)+1) + fv(i,k,j) = buf1(bpter(i,k)+2) + + do m=1,pcnst + qminus(i,k,m,j) = buf1(bpter(i,k)+2+m) + end do + + end do + + end do + + end do + + endif + + return + end subroutine p_d_coupling +end module dp_coupling diff --git a/src/dynamics/eul/dycore.F90 b/src/dynamics/eul/dycore.F90 new file mode 100644 index 0000000000..726396e9a4 --- /dev/null +++ b/src/dynamics/eul/dycore.F90 @@ -0,0 +1,28 @@ +module dycore + +implicit none +private + +public :: dycore_is + +!========================================================================================= +CONTAINS +!========================================================================================= + +logical function dycore_is(name) + + character(len=*), intent(in) :: name + + if (name == 'eul' .or. name == 'EUL') then + dycore_is = .true. + else + dycore_is = .false. + end if + +end function dycore_is + +!========================================================================================= + +end module dycore + + diff --git a/src/dynamics/eul/dyn.F90 b/src/dynamics/eul/dyn.F90 new file mode 100644 index 0000000000..be70698c4e --- /dev/null +++ b/src/dynamics/eul/dyn.F90 @@ -0,0 +1,124 @@ + subroutine dyn(irow ,grlps1 ,grt1 ,grz1 ,grd1 , & + grfu1 ,grfv1 ,grut1 ,grvt1 ,grrh1 , & + grlps2 ,grt2 ,grz2 ,grd2 ,grfu2 , & + grfv2 ,grut2 ,grvt2 ,grrh2, ztodt ) +!----------------------------------------------------------------------- +! +! Combine undifferentiated and longitudinally differentiated Fourier +! coefficient terms for later use in the Gaussian quadrature +! +! Computational note: Index "2*m-1" refers to the real part of the +! complex coefficient, and "2*m" to the imaginary. +! +! The naming convention is as follows: +! - t, q, d, z refer to temperature, specific humidity, divergence +! and vorticity +! - "1" suffix to an array => symmetric component of current latitude pair +! - "2" suffix to an array => antisymmetric component +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, B. Boville, J. Hack, August 1992 +! Reviewed: D. Williamson, March 1996 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use physconst, only: rearth + use time_manager, only: get_step_size, is_first_step + use spmd_utils, only: iam + implicit none + +! +! Input arguments +! + integer irow ! latitude pair index +! +! Input/output arguments +! + real(r8) grlps1(2*maxm) ! sym. surface pressure equation term + real(r8) grt1(2*maxm,plev) ! sym. undifferentiated term in t eqn. + real(r8) grz1(2*maxm,plev) ! sym. undifferentiated term in z eqn. + real(r8) grd1(2*maxm,plev) ! sym. undifferentiated term in d eqn. + real(r8) grfu1(2*maxm,plev) ! sym. nonlinear terms in u eqn. + real(r8) grfv1(2*maxm,plev) ! sym. nonlinear terms in v eqn. + real(r8) grut1(2*maxm,plev) ! sym. lambda derivative term in t eqn. + real(r8) grvt1(2*maxm,plev) ! sym. mu derivative term in t eqn. + real(r8) grrh1(2*maxm,plev) ! sym. RHS of divergence eqn (del^2 term) + real(r8) grlps2(2*maxm) ! antisym. surface pressure equation term + real(r8) grt2(2*maxm,plev) ! antisym. undifferentiated term in t eqn. + real(r8) grz2(2*maxm,plev) ! antisym. undifferentiated term in z eqn. + real(r8) grd2(2*maxm,plev) ! antisym. undifferentiated term in d eqn. + real(r8) grfu2(2*maxm,plev) ! antisym. nonlinear terms in u eqn. + real(r8) grfv2(2*maxm,plev) ! antisym. nonlinear terms in v eqn. + real(r8) grut2(2*maxm,plev) ! antisym. lambda derivative term in t eqn. + real(r8) grvt2(2*maxm,plev) ! antisym. mu derivative term in t eqn. + real(r8) grrh2(2*maxm,plev) ! antisym. RHS of divergence eqn (del^2 term) + real(r8) ztodt +! +!---------------------------Local workspace----------------------------- +! + real(r8) tmp1,tmp2 ! temporaries + real(r8) zxm(pmmax) ! m*2dt/(a*cos(lat)**2) + real(r8) zrcsj ! 1./(a*cos(lat)**2) +! real(r8) dtime ! timestep size [seconds] + real(r8) ztdtrc ! 2dt/(a*cos(lat)**2) 1dt/..... at nstep=0 + integer lm, mlength ! local Fourier wavenumber index + ! and number of local indices + integer k ! level index +! +! Set constants +! + mlength = numm(iam) +! dtime = get_step_size() + + zrcsj = 1._r8/(cs(irow)*rearth) + ztdtrc = ztodt*zrcsj + +! if (is_first_step()) then +! ztdtrc = dtime*zrcsj +! else +! ztdtrc = 2.0_r8*dtime*zrcsj +! end if +! +! Combine constants with Fourier wavenumber m +! + do lm=1,mlength + zxm(lm) = ztdtrc*xm(locm(lm,iam)) + end do +! +! Combine undifferentiated and longitudinal derivative terms for +! later use in Gaussian quadrature +! + do k=1,plev + do lm=1,mlength + grt1(2*lm-1,k) = grt1(2*lm-1,k) + zxm(lm)*grut1(2*lm,k) + grt1(2*lm,k) = grt1(2*lm,k) - zxm(lm)*grut1(2*lm-1,k) + grd1(2*lm-1,k) = grd1(2*lm-1,k) - zxm(lm)*grfu1(2*lm,k) + grd1(2*lm,k) = grd1(2*lm,k) + zxm(lm)*grfu1(2*lm-1,k) + grz1(2*lm-1,k) = grz1(2*lm-1,k) - zxm(lm)*grfv1(2*lm,k) + grz1(2*lm,k) = grz1(2*lm,k) + zxm(lm)*grfv1(2*lm-1,k) +! + grt2(2*lm-1,k) = grt2(2*lm-1,k) + zxm(lm)*grut2(2*lm,k) + grt2(2*lm,k) = grt2(2*lm,k) - zxm(lm)*grut2(2*lm-1,k) + grd2(2*lm-1,k) = grd2(2*lm-1,k) - zxm(lm)*grfu2(2*lm,k) + grd2(2*lm,k) = grd2(2*lm,k) + zxm(lm)*grfu2(2*lm-1,k) + grz2(2*lm-1,k) = grz2(2*lm-1,k) - zxm(lm)*grfv2(2*lm,k) + grz2(2*lm,k) = grz2(2*lm,k) + zxm(lm)*grfv2(2*lm-1,k) + end do + end do + + return + end subroutine dyn + diff --git a/src/dynamics/eul/dyn_comp.F90 b/src/dynamics/eul/dyn_comp.F90 new file mode 100644 index 0000000000..d50ef6df21 --- /dev/null +++ b/src/dynamics/eul/dyn_comp.F90 @@ -0,0 +1,1113 @@ +module dyn_comp +!----------------------------------------------------------------------- +! +! Eulerian dycore interface module +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 + +use spmd_utils, only: masterproc, npes, mpicom, mpir8 + +use physconst, only: pi +use pmgrid, only: plon, plat, plev, plevp, plnlv, beglat, endlat +use dyn_grid, only: ptimelevels + +use prognostics, only: n3, ps, u3, v3, t3, q3, phis, pdeld, dpsm, dpsl, div, vort + +use cam_control_mod, only: initial_run, ideal_phys, moist_physics, adiabatic +use phys_control, only: phys_getopts +use constituents, only: pcnst, cnst_name, cnst_longname, sflxnam, tendnam, & + fixcnam, tottnam, hadvnam, vadvnam, cnst_get_ind, & + cnst_read_iv, qmin +use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim +use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic +use cam_history, only: addfld, add_default, horiz_only + +use eul_control_mod, only: dif2, hdif_order, kmnhdn, hdif_coef, divdampn, eps, & + kmxhdc, eul_nsplit + +use scamMod, only: single_column, use_camiop, have_u, have_v, & + have_cldliq, have_cldice, loniop, latiop, scmlat, scmlon, & + qobs,tobs,scm_cambfb_mode + +use cam_pio_utils, only: clean_iodesc_list +use pio, only: file_desc_t, pio_noerr, pio_inq_varid, pio_get_att, & + pio_inq_attlen, pio_inq_dimid, pio_inq_dimlen, & + pio_get_var,var_desc_t, pio_seterrorhandling, & + pio_bcast_error, pio_internal_error, pio_offset_kind + +#if (defined SPMD) +use spmd_dyn, only: spmd_readnl +#endif + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + dyn_import_t, & + dyn_export_t, & + dyn_readnl, & + dyn_register, & + dyn_init + +! these structures are not used in this dycore, but are included +! for interface compatibility. +type dyn_import_t + integer :: placeholder +end type dyn_import_t + +type dyn_export_t + integer :: placeholder +end type dyn_export_t + + +real(r8), allocatable :: ps_tmp (:,: ) +real(r8), allocatable :: phis_tmp(:,: ) +real(r8), allocatable :: q3_tmp (:,:,:) +real(r8), allocatable :: t3_tmp (:,:,:) +real(r8), allocatable :: arr3d_a (:,:,:) +real(r8), allocatable :: arr3d_b (:,:,:) + +logical readvar ! inquiry flag: true => variable exists on netCDF file + +!========================================================================================= +CONTAINS +!========================================================================================= + +subroutine dyn_readnl(nlfile) + + ! Read dynamics namelist group. + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8 + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + integer :: unitn, ierr + + real(r8) :: eul_dif2_coef ! del2 horizontal diffusion coeff. + integer :: eul_hdif_order ! Order of horizontal diffusion operator + integer :: eul_hdif_kmnhdn ! Nth order horizontal diffusion operator top level. + real(r8) :: eul_hdif_coef ! Nth order horizontal diffusion coefficient. + real(r8) :: eul_divdampn ! Number of days to invoke divergence damper + real(r8) :: eul_tfilt_eps ! Time filter coefficient. Defaults to 0.06. + integer :: eul_kmxhdc ! Number of levels to apply Courant limiter + + namelist /dyn_eul_inparm/ eul_dif2_coef, eul_hdif_order, eul_hdif_kmnhdn, & + eul_hdif_coef, eul_divdampn, eul_tfilt_eps, eul_kmxhdc, eul_nsplit + + character(len=*), parameter :: sub = 'dyn_readnl' + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'dyn_eul_inparm', status=ierr) + if (ierr == 0) then + read(unitn, dyn_eul_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(eul_dif2_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_dif2_coef") + + call mpi_bcast(eul_hdif_order, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_order") + + call mpi_bcast(eul_hdif_kmnhdn, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_kmnhdn") + + call mpi_bcast(eul_hdif_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_coef") + + call mpi_bcast(eul_divdampn, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_divdampn") + + call mpi_bcast(eul_tfilt_eps, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_tfilt_eps") + + call mpi_bcast(eul_kmxhdc, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_kmxhdc") + + call mpi_bcast(eul_nsplit, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_nsplit") + + dif2 = eul_dif2_coef + hdif_order = eul_hdif_order + kmnhdn = eul_hdif_kmnhdn + hdif_coef = eul_hdif_coef + divdampn = eul_divdampn + eps = eul_tfilt_eps + kmxhdc = eul_kmxhdc + + ! Write namelist variables to logfile + if (masterproc) then + + write(iulog,*) 'Eulerian Dycore Parameters:' + + + ! Order of diffusion + if (hdif_order < 2 .or. mod(hdif_order, 2) /= 0) then + write(iulog,*) sub//': Order of diffusion must be greater than 0 and multiple of 2' + write(iulog,*) 'hdif_order = ', hdif_order + call endrun(sub//': ERROR: invalid eul_hdif_order specified') + end if + + if (divdampn > 0._r8) then + write(iulog,*) ' Divergence damper for spectral dycore invoked for days 0. to ',divdampn,' of this case' + elseif (divdampn < 0._r8) then + call endrun (sub//': divdampn must be non-negative') + else + write(iulog,*) ' Divergence damper for spectral dycore NOT invoked' + endif + + if (kmxhdc >= plev .or. kmxhdc < 0) then + call endrun (sub//': ERROR: KMXHDC must be between 0 and plev-1') + end if + + write(iulog,9108) eps, hdif_order, kmnhdn, hdif_coef, kmxhdc, eul_nsplit + + if (kmnhdn > 1) then + write(iulog,9109) dif2 + end if + + end if + +#if (defined SPMD) + call spmd_readnl(nlfile) +#endif + +9108 format(' Time filter coefficient (EPS) ',f10.3,/,& + ' Horizontal diffusion order (N) ',i10/, & + ' Top layer for Nth order horizontal diffusion ',i10/, & + ' Nth order horizontal diffusion coefficient ',e10.3/, & + ' Number of levels Courant limiter applied ',i10/, & + ' Dynamics Subcycling ',i10) + +9109 format(' DEL2 horizontal diffusion applied above Nth order diffusion',/,& + ' DEL2 Horizontal diffusion coefficient (DIF2) ',e10.3) + + +end subroutine dyn_readnl + +!========================================================================================= + +subroutine dyn_register() +end subroutine dyn_register + +!========================================================================================= + +subroutine dyn_init(dyn_in, dyn_out) + + use prognostics, only: initialize_prognostics + use scanslt, only: scanslt_alloc + + use scamMod, only: single_column +#if (defined SPMD) + use spmd_dyn, only: spmdbuf +#endif +#if (defined BFB_CAM_SCAM_IOP ) + use history_defaults, only: initialize_iop_history +#endif + + ! Arguments are not used in this dycore, included for compatibility + type(dyn_import_t), intent(out) :: dyn_in + type(dyn_export_t), intent(out) :: dyn_out + + ! Local workspace + integer :: m + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + logical :: history_amwg ! output for AMWG diagnostics + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + !---------------------------------------------------------------------------- + + ! Initialize prognostics variables + call initialize_prognostics + call scanslt_alloc() + +#if (defined SPMD) + ! Allocate communication buffers for collective communications in realloc + ! routines and in dp_coupling. Call must come after phys_grid_init. + call spmdbuf () +#endif + + if (initial_run) then + +#if (defined BFB_CAM_SCAM_IOP ) + call initialize_iop_history() +#endif + call read_inidat() + call clean_iodesc_list() + end if + + call addfld ('ETADOT',(/ 'ilev' /),'A', '1/s','Vertical (eta) velocity', gridname='gauss_grid') + call addfld ('U&IC', (/ 'lev' /), 'I', 'm/s','Zonal wind', gridname='gauss_grid' ) + call addfld ('V&IC', (/ 'lev' /), 'I', 'm/s','Meridional wind', gridname='gauss_grid' ) + call add_default ('U&IC',0, 'I') + call add_default ('V&IC',0, 'I') + + call addfld ('PS&IC',horiz_only,'I', 'Pa','Surface pressure', gridname='gauss_grid' ) + call addfld ('T&IC',(/ 'lev' /),'I', 'K','Temperature', gridname='gauss_grid' ) + call add_default ('PS&IC',0, 'I') + call add_default ('T&IC',0, 'I') + + do m = 1, pcnst + call addfld (trim(cnst_name(m))//'&IC',(/ 'lev' /),'I', 'kg/kg',cnst_longname(m), gridname='gauss_grid' ) + call add_default(trim(cnst_name(m))//'&IC',0, 'I') + call addfld (hadvnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' horizontal advection tendency', & + gridname='gauss_grid') + call addfld (vadvnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' vertical advection tendency', & + gridname='gauss_grid') + call addfld (tendnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' total tendency', & + gridname='gauss_grid') + call addfld (tottnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' horz + vert + fixer tendency', & + gridname='gauss_grid') + call addfld (fixcnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to slt fixer', & + gridname='gauss_grid') + end do + + call addfld ('DUH ',(/ 'lev' /),'A', 'K/s ','U horizontal diffusive heating', gridname='gauss_grid') + call addfld ('DVH ',(/ 'lev' /),'A', 'K/s ','V horizontal diffusive heating', gridname='gauss_grid') + call addfld ('DTH ',(/ 'lev' /),'A', 'K/s ','T horizontal diffusive heating', gridname='gauss_grid') + + call addfld ('ENGYCORR',(/ 'lev' /),'A', 'W/m2 ','Energy correction for over-all conservation', gridname='gauss_grid') + call addfld ('TFIX ',horiz_only ,'A', 'K/s ','T fixer (T equivalent of Energy correction)', gridname='gauss_grid') + + call addfld ('FU ',(/ 'lev' /),'A', 'm/s2 ','Zonal wind forcing term', gridname='gauss_grid') + call addfld ('FV ',(/ 'lev' /),'A', 'm/s2 ','Meridional wind forcing term', gridname='gauss_grid') + call addfld ('UTEND ',(/ 'lev' /),'A', 'm/s2 ','U tendency', gridname='gauss_grid') + call addfld ('VTEND ',(/ 'lev' /),'A', 'm/s2 ','V tendency', gridname='gauss_grid') + call addfld ('TTEND ',(/ 'lev' /),'A', 'K/s ','T tendency', gridname='gauss_grid') + call addfld ('LPSTEN ',horiz_only ,'A', 'Pa/s ','Surface pressure tendency', gridname='gauss_grid') + call addfld ('VAT ',(/ 'lev' /),'A', 'K/s ','Vertical advective tendency of T',gridname='gauss_grid') + call addfld ('KTOOP ',(/ 'lev' /),'A', 'K/s ','(Kappa*T)*(omega/P)', gridname='gauss_grid') + + call phys_getopts(history_amwg_out=history_amwg, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + if (history_amwg) then + call add_default ('DTH ', 1, ' ') + end if + + if ( history_budget ) then + if (.not.adiabatic) then + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + end if + ! The following variables are not defined for single column + if (.not. single_column) then + call add_default(hadvnam( 1), history_budget_histfile_num, ' ') + call add_default(vadvnam( 1), history_budget_histfile_num, ' ') + if (.not.adiabatic) then + call add_default(hadvnam(ixcldliq), history_budget_histfile_num, ' ') + call add_default(hadvnam(ixcldice), history_budget_histfile_num, ' ') + call add_default(vadvnam(ixcldliq), history_budget_histfile_num, ' ') + call add_default(vadvnam(ixcldice), history_budget_histfile_num, ' ') + end if + end if + call add_default(fixcnam( 1), history_budget_histfile_num, ' ') + call add_default(tottnam( 1), history_budget_histfile_num, ' ') + call add_default(tendnam( 1), history_budget_histfile_num, ' ') + if (.not.adiabatic) then + call add_default(fixcnam(ixcldliq), history_budget_histfile_num, ' ') + call add_default(fixcnam(ixcldice), history_budget_histfile_num, ' ') + call add_default(tottnam(ixcldliq), history_budget_histfile_num, ' ') + call add_default(tottnam(ixcldice), history_budget_histfile_num, ' ') + call add_default(tendnam(ixcldliq), history_budget_histfile_num, ' ') + call add_default(tendnam(ixcldice), history_budget_histfile_num, ' ') + end if + call add_default('TTEND', history_budget_histfile_num, ' ') + call add_default('TFIX', history_budget_histfile_num, ' ') + call add_default('KTOOP', history_budget_histfile_num, ' ') + call add_default('VAT', history_budget_histfile_num, ' ') + call add_default('DTH', history_budget_histfile_num, ' ') + end if + +end subroutine dyn_init + +!========================================================================================= +! Private routines +!========================================================================================= + +subroutine read_inidat() + ! Read initial dataset and spectrally truncate as appropriate. + ! Read and process the fields one at a time to minimize + ! memory usage. + + use ppgrid, only: begchunk, endchunk, pcols + use phys_grid, only: clat_p, clon_p + use commap, only: clat, clon + use comspe, only: alp, dalp + + use ncdio_atm, only: infld + use cam_pio_utils, only: cam_pio_get_var + use dyn_tests_utils, only: vc_moist_pressure + + use iop, only: setiopupdate,readiopdata + + ! Local variables + + integer i,c,m,n,lat ! indices + integer ncol + integer ixcldice, ixcldliq ! indices into q3 array for cloud liq and cloud ice + + integer :: ierr, pio_errtype + integer :: lonid, latid + integer :: mlon, morec ! lon/lat dimension lengths from IC file + + type(file_desc_t), pointer :: fh_ini, fh_topo + + real(r8), pointer, dimension(:,:,:) :: convptr_2d + real(r8), pointer, dimension(:,:,:,:) :: convptr_3d + real(r8), pointer, dimension(:,:,:,:) :: cldptr + real(r8), pointer, dimension(:,: ) :: arr2d_tmp + real(r8), pointer, dimension(:,: ) :: arr2d + character*16 fieldname ! field name + + real(r8) :: clat2d(plon,plat),clon2d(plon,plat) + + ! variables for analytic initial conditions + integer, allocatable :: glob_ind(:) + integer :: m_cnst(1) + real(r8), allocatable :: q4_tmp(:,:,:,:) + + integer londimid,dimlon,latdimid,dimlat,latvarid,lonvarid + integer strt(3),cnt(3) + character(len=3), parameter :: arraydims3(3) = (/ 'lon', 'lev', 'lat' /) + character(len=3), parameter :: arraydims2(2) = (/ 'lon', 'lat' /) + type(var_desc_t) :: varid + real(r8), allocatable :: tmp2d(:,:) + + character(len=*), parameter :: sub='read_inidat' + !---------------------------------------------------------------------------- + + fh_ini => initial_file_get_id() + fh_topo => topo_file_get_id() + + allocate ( ps_tmp (plon,plat ) ) + allocate ( phis_tmp(plon,plat ) ) + allocate ( q3_tmp (plon,plev,plat) ) + allocate ( t3_tmp (plon,plev,plat) ) + allocate ( arr3d_a (plon,plev,plat) ) + allocate ( arr3d_b (plon,plev,plat) ) + + if (analytic_ic_active()) then + allocate(glob_ind(plon * plat)) + m = 1 + do c = 1, plat + do i = 1, plon + ! Create a global column index + glob_ind(m) = i + (c-1)*plon + m = m + 1 + end do + end do + call analytic_ic_set_ic(vc_moist_pressure, clat(:), clon(:,1), & + glob_ind(:), U=arr3d_a, V=arr3d_b, T=t3_tmp, PS=ps_tmp, PHIS=phis_tmp) + readvar = .false. + call process_inidat('PS') + call process_inidat('UV') + call process_inidat('T') + call process_inidat('PHIS') + allocate(q4_tmp(plon,plev,plat,1)) + do m = 1, pcnst + m_cnst(1) = m + call analytic_ic_set_ic(vc_moist_pressure, clat(:), clon(:,1), & + glob_ind(:), Q=q4_tmp, m_cnst=m_cnst) + arr3d_a(:,:,:) = q4_tmp(:,:,:,1) + call process_inidat('CONSTS', m_cnst=m, fh=fh_ini) + end do + deallocate(q4_tmp) + deallocate(glob_ind) + deallocate ( arr3d_a ) + deallocate ( arr3d_b ) + else + !--------------------- + ! Read required fields + !--------------------- + + call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, pio_errtype) + + ierr = pio_inq_dimid(fh_ini, 'lon', lonid) + ierr = pio_inq_dimid(fh_ini, 'lat', latid) + ierr = pio_inq_dimlen(fh_ini, lonid, mlon) + ierr = pio_inq_dimlen(fh_ini, latid, morec) + if (.not. single_column .and. (mlon /= plon .or. morec /= plat)) then + write(iulog,*) sub//': ERROR: model parameters do not match initial dataset parameters' + write(iulog,*)'Model Parameters: plon = ',plon,' plat = ',plat + write(iulog,*)'Dataset Parameters: dlon = ',mlon,' dlat = ',morec + call endrun(sub//': ERROR: model parameters do not match initial dataset parameters') + end if + + call pio_seterrorhandling(fh_ini, pio_errtype) + !----------- + ! 3-D fields + !----------- + + fieldname = 'U' + call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_a, found=readvar) + if (.not. readvar) then + call endrun(sub//': ERROR: reading '//trim(fieldname)) + end if + + fieldname = 'V' + call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_b, found=readvar) + if (.not. readvar) then + call endrun(sub//': ERROR: reading '//trim(fieldname)) + end if + + call process_inidat('UV') + + fieldname = 'T' + call cam_pio_get_var(fieldname, fh_ini, arraydims3, t3_tmp, found=readvar) + if (.not. readvar) then + call endrun(sub//': ERROR: reading '//trim(fieldname)) + end if + + call process_inidat('T') + + ! Constituents (read and process one at a time) + + do m = 1,pcnst + + readvar = .false. + fieldname = cnst_name(m) + if (cnst_read_iv(m)) then + call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_a, found=readvar) + end if + call process_inidat('CONSTS', m_cnst=m, fh=fh_ini) + + end do + + deallocate ( arr3d_a ) + deallocate ( arr3d_b ) + + !----------- + ! 2-D fields + !----------- + + fieldname = 'PS' + call cam_pio_get_var(fieldname, fh_ini, arraydims2, ps_tmp, found=readvar) + if (.not. readvar) then + call endrun(sub//': ERROR: reading '//trim(fieldname)) + end if + call process_inidat('PS') + end if + + ! PHIS processing. This code allows an analytic specification of PHIS to be + ! overridden by one from a specified topo file. + fieldname = 'PHIS' + readvar = .false. + if (associated(fh_topo)) then + call cam_pio_get_var(fieldname, fh_topo, arraydims2, phis_tmp, found=readvar) + if (.not. readvar) then + call endrun(sub//': ERROR: reading '//trim(fieldname)) + end if + call process_inidat('PHIS', fh=fh_topo) + else if (.not. analytic_ic_active()) then + phis_tmp(:,:) = 0._r8 + call process_inidat('PHIS') + end if + + if (single_column) then + ps(:,:,1) = ps_tmp(:,:) + else + ! Integrals of mass, moisture and geopotential height + ! (fix mass of moisture as well) + call global_int + end if + + deallocate ( ps_tmp ) + deallocate ( phis_tmp ) + + if (single_column) then + if ( scm_cambfb_mode ) then + + fieldname = 'CLAT1' + call infld(fieldname, fh_ini, 'lon', 'lat', 1, pcols, begchunk, endchunk, & + clat2d, readvar, gridname='physgrid') + if (.not. readvar) then + call endrun('CLAT not on iop initial file') + else + clat(:) = clat2d(1,:) + clat_p(:)=clat(:) + end if + + fieldname = 'CLON1' + call infld(fieldname, fh_ini, 'lon', 'lat', 1, pcols, begchunk, endchunk, & + clon2d, readvar, gridname='physgrid') + if (.not. readvar) then + call endrun('CLON not on iop initial file') + else + clon = clon2d + clon_p(:)=clon(:,1) + end if + + ! Get latdeg/londeg from initial file for bfb calculations + ! needed for dyn_grid to determine bounding area and verticies + ierr = pio_inq_dimid (fh_ini, 'lon' , londimid) + ierr = pio_inq_dimlen (fh_ini, londimid, dimlon) + ierr = pio_inq_dimid (fh_ini, 'lat' , latdimid) + ierr = pio_inq_dimlen (fh_ini, latdimid, dimlat) + strt(:)=1 + cnt(1)=dimlon + cnt(2)=dimlat + cnt(3)=1 + allocate(latiop(dimlat)) + allocate(loniop(dimlon)) + allocate(tmp2d(dimlon,dimlat)) + ierr = pio_inq_varid (fh_ini,'CLAT1', varid) + ierr = pio_get_var(fh_ini,varid,strt,cnt,tmp2d) + latiop(:)=tmp2d(1,:) + ierr = pio_inq_varid (fh_ini,'CLON1', varid) + ierr = pio_get_var(fh_ini,varid,strt,cnt,tmp2d) + loniop(:)=tmp2d(:,1) + deallocate(tmp2d) + else + + ! Using a standard iop - make the default grid size is + ! 4x4 degree square for mo_drydep deposition.(standard ARM IOP area) + allocate(latiop(2)) + allocate(loniop(2)) + latiop(1)=(scmlat-2._r8)*pi/180_r8 + latiop(2)=(scmlat+2._r8)*pi/180_r8 + loniop(1)=(mod(scmlon-2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 + loniop(2)=(mod(scmlon+2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 + call setiopupdate() + ! readiopdata will set all n1 level prognostics to iop value timestep 0 + call readiopdata(timelevel=1) + ! set t3, and q3(n1) values from iop on timestep 0 + t3(1,:,1,1) = tobs + q3(1,:,1,1,1) = qobs + end if + end if + + deallocate ( q3_tmp ) + deallocate ( t3_tmp ) + + if (.not. single_column) then + deallocate ( alp ) + deallocate ( dalp ) + end if + + call copytimelevels() + +end subroutine read_inidat + +!========================================================================================= + +subroutine process_inidat(fieldname, m_cnst, fh) + +! Post-process input fields + + use commap + use comspe + use spetru + use dyn_grid, only: get_horiz_grid_dim_d + use const_init, only: cnst_init_default + use qneg_module, only: qneg3 + +#if ( defined SPMD ) + use spmd_dyn, only: compute_gsfactors +#endif + + ! arguments + character(len=*), intent(in) :: fieldname ! fields to be processed + integer, intent(in), optional :: m_cnst ! constituent index + type(file_desc_t), intent(inout), optional :: fh ! pio file handle + + !---------------------------Local workspace----------------------------- + + integer i,j,k,n,lat,irow ! grid and constituent indices + integer :: nglon, nglat, rndm_seed_sz ! For pertlim + integer, allocatable :: rndm_seed(:) ! For pertlim + real(r8) pertval ! perturbation value + integer varid ! netCDF variable id + integer ret + integer(pio_offset_kind) :: attlen ! netcdf return values + logical phis_hires ! true => PHIS came from hi res topo + character*256 text + character*256 trunits ! tracer untis + + real(r8), pointer, dimension(:,:,:) :: q_tmp + real(r8), pointer, dimension(:,:,:) :: tmp3d_a, tmp3d_b, tmp3d_extend + real(r8), pointer, dimension(:,: ) :: tmp2d_a, tmp2d_b + +#if ( defined BFB_CAM_SCAM_IOP ) + real(r8), allocatable :: ps_sav(:,:) + real(r8), allocatable :: u3_sav(:,:,:) + real(r8), allocatable :: v3_sav(:,:,:) +#endif + +#if ( defined SPMD ) + integer :: numperlat ! number of values per latitude band + integer :: numsend(0:npes-1) ! number of items to be sent + integer :: numrecv ! number of items to be received + integer :: displs(0:npes-1) ! displacement array +#endif + character(len=*), parameter :: sub='process_inidat' + !---------------------------------------------------------------------------- + + select case (fieldname) + + !------------ + ! Process U/V + !------------ + + case ('UV') + + allocate ( tmp3d_a(plon,plev,plat) ) + allocate ( tmp3d_b(plon,plev,plat) ) + + ! Spectral truncation + + if (single_column) then + tmp3d_a(:,:,:) = 0._r8 + tmp3d_b(:,:,:) = 0._r8 + else +#if (( defined BFB_CAM_SCAM_IOP ) && ( ! defined DO_SPETRU )) + allocate ( u3_sav (plon,plev,plat) ) + allocate ( v3_sav (plon,plev,plat) ) + u3_sav(:plon,:plev,:plat) = arr3d_a(:plon,:plev,:plat) + v3_sav(:plon,:plev,:plat) = arr3d_b(:plon,:plev,:plat) + call spetru_uv(u3_sav ,v3_sav ,vort=tmp3d_a, div=tmp3d_b) + deallocate ( u3_sav ) + deallocate ( v3_sav ) +#else + call spetru_uv(arr3d_a ,arr3d_b ,vort=tmp3d_a, div=tmp3d_b) +#endif + end if + +#if ( defined SPMD ) + numperlat = plnlv + call compute_gsfactors (numperlat, numrecv, numsend, displs) + + call mpiscatterv (arr3d_a ,numsend, displs, mpir8,u3 (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) + call mpiscatterv (arr3d_b ,numsend, displs, mpir8,v3 (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) + call mpiscatterv (tmp3d_a ,numsend, displs, mpir8,vort(:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) + call mpiscatterv (tmp3d_b ,numsend, displs, mpir8,div (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) +#else + u3 (:,:,:,1) = arr3d_a(:plon,:plev,:plat) + v3 (:,:,:,1) = arr3d_b(:plon,:plev,:plat) + vort (:,:,:,1) = tmp3d_a(:,:,:) + div (:,:,:,1) = tmp3d_b(:,:,:) +#endif + deallocate ( tmp3d_a ) + deallocate ( tmp3d_b ) + + !---------- + ! Process T + !---------- + + case ('T') + + ! Add random perturbation to temperature if required + + if (pertlim .ne. 0.0_r8) then + if (masterproc) write(iulog,*) sub//': INFO: Adding random perturbation bounded by +/-', & + pertlim,' to initial temperature field' + + call get_horiz_grid_dim_d(nglon, nglat) + call random_seed(size=rndm_seed_sz) + allocate(rndm_seed(rndm_seed_sz)) + + do lat = 1, plat + do i = 1, plon + ! seed random_number generator based on global column index + rndm_seed = i + (lat-1)*nglon + call random_seed(put=rndm_seed) + do k = 1, plev + call random_number (pertval) + pertval = 2._r8*pertlim*(0.5_r8 - pertval) + t3_tmp(i,k,lat) = t3_tmp(i,k,lat)*(1._r8 + pertval) + end do + end do + end do + deallocate(rndm_seed) + end if + + ! Spectral truncation + + if (.not. single_column) then +#if ( ( ! defined BFB_CAM_SCAM_IOP ) || ( defined DO_SPETRU ) ) + call spetru_3d_scalar(t3_tmp) +#endif + end if + +#if ( defined SPMD ) + numperlat = plnlv + call compute_gsfactors (numperlat, numrecv, numsend, displs) + call mpiscatterv (t3_tmp ,numsend, displs, mpir8,t3(:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) +#else + t3 (:,:,:,1) = t3_tmp(:plon,:plev,:plat) +#endif + + !--------------------- + ! Process Constituents + !--------------------- + + case ('CONSTS') + + if (.not. present(m_cnst)) then + call endrun(sub//': ERROR: m_cnst needs to be present in the'// & + ' argument list') + end if + + allocate(tmp3d_extend(plon,plev,beglat:endlat)) + + if (readvar) then + ! Check that all tracer units are in mass mixing ratios + ret = pio_inq_varid(fh, cnst_name(m_cnst), varid) + ret = pio_get_att(fh, varid, 'units', trunits) + if (trunits(1:5) .ne. 'KG/KG' .and. trunits(1:5) .ne. 'kg/kg') then + call endrun(sub//': ERROR: Units for tracer ' & + //trim(cnst_name(m_cnst))//' must be in KG/KG') + end if + + else if (.not. analytic_ic_active()) then + + ! Constituents not read from initial file are initialized by the + ! package that implements them. Note that the analytic IC code calls + ! cnst_init_default internally + + if (m_cnst == 1 .and. moist_physics) then + call endrun(sub//': ERROR: Q must be on Initial File') + end if + + call cnst_init_default(m_cnst, clat, clon(:,1), arr3d_a) + end if + +!$omp parallel do private(lat) + do lat = 1,plat + call qneg3(sub, lat, plon, plon, plev , & + m_cnst, m_cnst, qmin(m_cnst) ,arr3d_a(1,1,lat)) + end do + + ! if "Q", "CLDLIQ", or "CLDICE", save off for later use + if (m_cnst == 1) q3_tmp(:plon,:,:) = arr3d_a(:plon,:,:) + +#if ( defined SPMD ) + numperlat = plnlv + call compute_gsfactors(numperlat, numrecv, numsend, displs) + call mpiscatterv(arr3d_a, numsend, displs, mpir8, tmp3d_extend, numrecv, mpir8,0,mpicom) + q3(:,:,m_cnst,:,1) = tmp3d_extend(:,:,beglat:endlat) +#else + q3(:,:plev,m_cnst,:,1) = arr3d_a(:plon,:plev,:plat) +#endif + deallocate ( tmp3d_extend ) + + !----------- + ! Process PS + !----------- + + case ('PS') + + allocate ( tmp2d_a(plon,plat) ) + allocate ( tmp2d_b(plon,plat) ) + + ! Spectral truncation + + if (single_column) then + tmp2d_a(:,:) = 0._r8 + tmp2d_b(:,:) = 0._r8 + else +#if (( defined BFB_CAM_SCAM_IOP ) && ( ! defined DO_SPETRU )) + allocate ( ps_sav(plon,plat) ) + ps_sav(:plon,:plat)=ps_tmp(:plon,:plat) + call spetru_ps(ps_sav, tmp2d_a, tmp2d_b) + deallocate ( ps_sav ) +#else + call spetru_ps(ps_tmp, tmp2d_a, tmp2d_b) +#endif + end if + +#if ( defined SPMD ) + numperlat = plon + call compute_gsfactors (numperlat, numrecv, numsend, displs) + call mpiscatterv (tmp2d_a ,numsend, displs, mpir8,dpsl ,numrecv, mpir8,0,mpicom) + call mpiscatterv (tmp2d_b ,numsend, displs, mpir8,dpsm ,numrecv, mpir8,0,mpicom) +#else + dpsl(:,:) = tmp2d_a(:,:) + dpsm(:,:) = tmp2d_b(:,:) +#endif + deallocate ( tmp2d_a ) + deallocate ( tmp2d_b ) + + !------------- + ! Process PHIS + !------------- + + case ('PHIS') + + ! Check for presence of 'from_hires' attribute to decide whether to filter + if (readvar) then + ret = pio_inq_varid (fh, 'PHIS', varid) + ! Allow pio to return errors in case from_hires doesn't exist + call pio_seterrorhandling(fh, PIO_BCAST_ERROR) + ret = pio_inq_attlen (fh, varid, 'from_hires', attlen) + if (ret.eq.PIO_NOERR .and. attlen.gt.256) then + call endrun(sub//': ERROR: from_hires attribute length is too long') + end if + ret = pio_get_att(fh, varid, 'from_hires', text) + + if (ret.eq.PIO_NOERR .and. text(1:4).eq.'true') then + phis_hires = .true. + if(masterproc) write(iulog,*) sub//': INFO: Will filter input PHIS: attribute from_hires is true' + else + phis_hires = .false. + if(masterproc) write(iulog,*) sub//': INFO: Will not filter input PHIS: attribute ', & + 'from_hires is either false or not present' + end if + call pio_seterrorhandling(fh, PIO_INTERNAL_ERROR) + + else + phis_hires = .false. + + end if + + ! Spectral truncation + + if (.not. single_column) then +#if (( ! defined BFB_CAM_SCAM_IOP ) || ( defined DO_SPETRU )) + call spetru_phis(phis_tmp, phis_hires) +#endif + end if + +#if ( defined SPMD ) + numperlat = plon + call compute_gsfactors (numperlat, numrecv, numsend, displs) + call mpiscatterv (phis_tmp ,numsend, displs, mpir8,phis ,numrecv, mpir8,0,mpicom) +#else + phis = phis_tmp +#endif + + end select + +end subroutine process_inidat + +!========================================================================================= + +subroutine global_int() + + ! Compute global integrals of mass, moisture and geopotential height + ! and fix mass of atmosphere + + use commap + use physconst, only: gravit +#if ( defined SPMD ) + use mpishorthand + use spmd_dyn, only: compute_gsfactors + use spmd_utils, only: npes +#endif + use hycoef, only: hyai, ps0 + use eul_control_mod, only: pdela, qmass1, tmassf, fixmas, & + tmass0, zgsint, qmass2, qmassf + + !---------------------------Local workspace----------------------------- + + integer i,k,lat,ihem,irow ! grid indices + real(r8) pdelb(plon,plev) ! pressure diff between interfaces + ! using "B" part of hybrid grid only + real(r8) pssum ! surface pressure sum + real(r8) dotproda ! dot product + real(r8) dotprodb ! dot product + real(r8) zgssum ! partial sums of phis + real(r8) hyad (plev) ! del (A) + real(r8) tmassf_tmp ! Global mass integral + real(r8) qmass1_tmp ! Partial Global moisture mass integral + real(r8) qmass2_tmp ! Partial Global moisture mass integral + real(r8) qmassf_tmp ! Global moisture mass integral + real(r8) zgsint_tmp ! Geopotential integral + + integer platov2 ! plat/2 or plat (if in scm mode) +#if ( defined SPMD ) + integer :: numperlat ! number of values per latitude band + integer :: numsend(0:npes-1) ! number of items to be sent + integer :: numrecv ! number of items to be received + integer :: displs(0:npes-1) ! displacement array +#endif + + type(file_desc_t), pointer :: fh_topo + + character(len=*), parameter :: sub='global_int' + !----------------------------------------------------------------------- + + fh_topo => topo_file_get_id() + + if (masterproc) then + + ! Initialize mass and moisture integrals for summation + ! in a third calculation loop (assures bit-for-bit compare + ! with non-random history tape). + + tmassf_tmp = 0._r8 + qmass1_tmp = 0._r8 + qmass2_tmp = 0._r8 + zgsint_tmp = 0._r8 + + ! Compute pdel from "A" portion of hybrid vertical grid for later use in global integrals + do k = 1,plev + hyad(k) = hyai(k+1) - hyai(k) + end do + do k = 1,plev + do i = 1,plon + pdela(i,k) = hyad(k)*ps0 + end do + end do + + ! Compute integrals of mass, moisture, and geopotential height + if (single_column) then + platov2 = 1 + else + platov2 = plat/2 + endif + do irow = 1,platov2 + do ihem = 1,2 + if (ihem.eq.1) then + lat = irow + else + lat = plat - irow + 1 + end if + + ! Accumulate average mass of atmosphere + call pdelb0 (ps_tmp(1,lat), pdelb, plon) + pssum = 0._r8 + do i = 1, plon + pssum = pssum + ps_tmp (i,lat) + end do + tmassf_tmp = tmassf_tmp + w(irow)*pssum/plon + + zgssum = 0._r8 + do i = 1, plon + zgssum = zgssum + phis_tmp(i,lat) + end do + zgsint_tmp = zgsint_tmp + w(irow)*zgssum/plon + + ! Calculate global integrals needed for water vapor adjustment + do k = 1,plev + dotproda = 0._r8 + dotprodb = 0._r8 + do i = 1, plon + dotproda = dotproda + q3_tmp(i,k,lat)*pdela(i,k) + dotprodb = dotprodb + q3_tmp(i,k,lat)*pdelb(i,k) + end do + qmass1_tmp = qmass1_tmp + w(irow)*dotproda/plon + qmass2_tmp = qmass2_tmp + w(irow)*dotprodb/plon + end do + end do + end do ! end of latitude loop + + ! Normalize average mass, height + tmassf_tmp = tmassf_tmp*.5_r8/gravit + qmass1_tmp = qmass1_tmp*.5_r8/gravit + qmass2_tmp = qmass2_tmp*.5_r8/gravit + zgsint_tmp = zgsint_tmp*.5_r8/gravit + qmassf_tmp = qmass1_tmp + qmass2_tmp + + ! Globally avgd sfc. partial pressure of dry air (i.e. global dry mass): + tmass0 = 98222._r8/gravit + if (.not. associated(fh_topo)) tmass0 = (101325._r8-245._r8)/gravit + if (adiabatic) tmass0 = tmassf_tmp + if (ideal_phys ) tmass0 = 100000._r8/gravit + + if (masterproc) then + write(iulog,*) sub//': INFO:' + write(iulog,*) ' Mass of initial data before correction = ', tmassf_tmp + write(iulog,*) ' Dry mass will be held at = ', tmass0 + write(iulog,*) ' Mass of moisture after removal of negatives = ', qmassf_tmp + write(iulog,*) ' Globally averaged geopotential height (m) = ', zgsint_tmp + end if + + ! Compute and apply an initial mass fix factor which preserves horizontal + ! gradients of ln(ps). + if (.not. moist_physics) then + fixmas = tmass0/tmassf_tmp + else + fixmas = (tmass0 + qmass1_tmp)/(tmassf_tmp - qmass2_tmp) + end if + ps_tmp = ps_tmp*fixmas + + ! Global integerals + tmassf = tmassf_tmp + qmass1 = qmass1_tmp + qmass2 = qmass2_tmp + qmassf = qmassf_tmp + zgsint = zgsint_tmp + + end if ! end of if-masterproc + +#if ( defined SPMD ) + call mpibcast (tmass0,1,mpir8,0,mpicom) + call mpibcast (tmassf,1,mpir8,0,mpicom) + call mpibcast (qmass1,1,mpir8,0,mpicom) + call mpibcast (qmass2,1,mpir8,0,mpicom) + call mpibcast (qmassf,1,mpir8,0,mpicom) + call mpibcast (zgsint,1,mpir8,0,mpicom) + + numperlat = plon + call compute_gsfactors(numperlat, numrecv, numsend, displs) + call mpiscatterv(ps_tmp, numsend, displs, mpir8, ps(:,beglat:endlat,1), numrecv, & + mpir8, 0, mpicom) +#else + ps(:,:,1) = ps_tmp(:,:) +#endif + +end subroutine global_int + +!========================================================================================= + +subroutine copytimelevels() + + !---------------------------Local variables----------------------------- + + integer n,i,k,lat ! index + real(r8) pdel(plon,plev) ! pressure arrays needed to calculate + real(r8) pint(plon,plevp) ! pdeld + real(r8) pmid(plon,plev) ! + + ! If dry-type tracers are present, initialize pdeld + ! First, set current time pressure arrays for model levels etc. to get pdel + do lat = beglat, endlat + call plevs0(plon, plon, plev, ps(:,lat,1), pint, pmid, pdel) + do k = 1, plev + do i = 1, plon + pdeld(i,k,lat,1) = pdel(i,k)*(1._r8-q3(i,k,1,lat,1)) + end do + end do + end do + + ! Make all time levels of prognostics contain identical data. + ! Fields to be convectively adjusted only *require* n3 time + ! level since copy gets done in linems. + do n = 2, ptimelevels + ps(:,:,n) = ps(:,:,1) + u3(:,:,:,n) = u3(:,:,:,1) + v3(:,:,:,n) = v3(:,:,:,1) + t3(:,:,:,n) = t3(:,:,:,1) + q3(1:plon,:,:,:,n) = q3(1:plon,:,:,:,1) + vort(:,:,:,n) = vort(:,:,:,1) + div(:,:,:,n) = div(:,:,:,1) + pdeld(1:plon,:,:,n) = pdeld(1:plon,:,:,1) + end do + +end subroutine copytimelevels + +!========================================================================================= + +end module dyn_comp diff --git a/src/dynamics/eul/dyn_grid.F90 b/src/dynamics/eul/dyn_grid.F90 new file mode 100644 index 0000000000..e8cd67b0a0 --- /dev/null +++ b/src/dynamics/eul/dyn_grid.F90 @@ -0,0 +1,1198 @@ +module dyn_grid +!----------------------------------------------------------------------- +! +! Define grid and decomposition for Eulerian spectral dynamics. +! +! Original code: John Drake and Patrick Worley +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use pmgrid, only: plat, plev, plon, plevp +use physconst, only: rair, rearth, ra +use spmd_utils, only: masterproc, iam + +use pio, only: file_desc_t +use cam_initfiles, only: initial_file_get_id + +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +#if (defined SPMD) +use spmd_dyn, only: spmdinit_dyn +#endif + +implicit none +private +save + +public :: & + dyn_grid_init, & + dyn_grid_find_gcols, &! find nearest column for given lat/lon + dyn_grid_get_colndx, &! global lat and lon coordinate and MPI process indices + ! corresponding to a specified global column index + dyn_grid_get_elem_coords, &! coordinates of a specified element (latitude) + ! of the dynamics grid (lat slice of the block) + get_block_bounds_d, &! first and last indices in global block ordering + get_block_gcol_d, &! global column indices for given block + get_block_gcol_cnt_d, &! number of columns in given block + get_block_levels_d, &! vertical levels in column + get_block_lvl_cnt_d, &! number of vertical levels in column + get_block_owner_d, &! process "owning" given block + get_dyn_grid_parm, & + get_dyn_grid_parm_real1d, & + get_gcol_block_d, &! global block indices and local columns + ! index for given global column index + get_gcol_block_cnt_d, &! number of blocks containing data + ! from a given global column index + get_horiz_grid_d, &! horizontal grid coordinates + get_horiz_grid_dim_d, &! horizontal dimensions of dynamics grid + physgrid_copy_attributes_d + +! The Eulerian dynamics grids +integer, parameter, public :: dyn_decomp = 101 + +integer, parameter, public :: ptimelevels = 3 ! number of time levels in the dycore + +integer :: ngcols_d = 0 ! number of dynamics columns + +!======================================================================================== +contains +!======================================================================================== + +subroutine dyn_grid_init + + ! Initialize dynamics grid + + use pspect, only: ptrm, ptrn, ptrk, pnmax, pmmax, pspt + use comspe, only: lpspt, numm, locm, lnstart, nstart, nlen, & + alp, dalp, lalp, ldalp + use scanslt, only: nlonex, platd, j1 + use gauaw_mod, only: gauaw + use commap, only: sq, rsq, slat, w, cs, href, ecref, clat, clon, & + latdeg, londeg, xm + use time_manager, only: get_step_size + use scamMod, only: scmlat, scmlon, single_column + use hycoef, only: hycoef_init, hypi, hypm, hypd, nprlev + use ref_pres, only: ref_pres_init + use eul_control_mod, only: ifax, trig, eul_nsplit + + ! Local variables + type(file_desc_t), pointer :: fh_ini + + real(r8) zsi(plat) ! sine of latitudes + real(r8) zw(plat) ! Gaussian weights + real(r8) zra2 ! ra squared + real(r8) zalp(2*pspt) ! Legendre function array + real(r8) zdalp(2*pspt) ! Derivative array + real(r8) zslat ! sin of lat and cosine of colatitude + + integer i ! longitude index + integer j ! Latitude index + integer k ! Level index + integer kk ! Level index + integer kkk ! Level index + integer m,lm,mr,lmr ! Indices for legendre array + integer n ! Index for legendre array + integer nkk ! Print control variables + integer ik1 ! Print index temporary variable + integer ik2 ! Print index temporary variable + integer itmp ! Dimension of polynomial arrays temporary. + integer iter ! Iteration index + real(r8) :: zdt ! Time step for settau + + integer :: irow ! Latitude pair index + integer :: lat ! Latitude index + + real(r8) :: xlat ! Latitude (radians) + real(r8) :: pi ! Mathematical pi (3.14...) + real(r8) :: dtime ! timestep size [seconds] + + character(len=*), parameter :: sub='dyn_grid_init' + !----------------------------------------------------------------------- + + ! File handle for initial file. Needed for vertical coordinate data. + fh_ini => initial_file_get_id() + + ! Compute truncation parameters + call trunc() + +#if (defined SPMD) + call spmdinit_dyn() +#endif + + ! Initialize hybrid coordinate arrays + call hycoef_init(fh_ini) + + ! Initialize reference pressures + call ref_pres_init(hypi, hypm, nprlev) + + + dtime = get_step_size() + zdt = dtime/eul_nsplit + + ! Initialize horizontal diffusion coefficients + call hdinti(rearth, zdt) + + if (.not. single_column) then + + if (pmmax > plon/2) then + call endrun (sub//': ERROR: mmax=ptrm+1 .gt. plon/2') + end if + end if + + ! NMAX dependent arrays + zra2 = ra*ra + do j = 2, pnmax + sq(j) = j*(j-1)*zra2 + rsq(j) = 1._r8/sq(j) + end do + sq(1) = 0._r8 + rsq(1) = 0._r8 + + ! MMAX dependent arrays + do j = 1, pmmax + xm(j) = j-1 + end do + + ! Integration matrices of hydrostatic equation(href) and conversion + ! term(a). href computed as in ccm0 but isothermal bottom ecref + ! calculated to conserve energy + + do k = 1, plev + do kk = 1, plev + href(kk,k) = 0._r8 + ecref(kk,k) = 0._r8 + end do + end do + + ! Mean atmosphere energy conversion term is consistent with continiuty + ! Eq. In ecref, 1st index = column; 2nd index = row of matrix. + ! Mean atmosphere energy conversion term is energy conserving + + do k = 1, plev + ecref(k,k) = 0.5_r8/hypm(k) * hypd(k) + do kk = 1, k-1 + ecref(kk,k) = 1._r8/hypm(k) * hypd(kk) + end do + end do + + ! Reference hydrostatic integration matrix consistent with conversion + ! term for energy conservation. In href, 1st index = column; + ! 2nd index = row of matrix. + + do k = 1, plev + do kk = k, plev + href(kk,k) = ecref(k,kk)*hypd(kk)/hypd(k) + end do + end do + + href = href*rair + + if (single_column) then + + do j = 1, plat + slat(j) = 1.0_r8 * sin(4.0_r8*atan(1.0_r8)*scmlat/180._r8) + w(j) = 2.0_r8/plat + cs(j) = 10._r8 - slat(j)*slat(j) + end do + + xlat = asin(slat(1)) + clat(1) = xlat + + clat(1)=scmlat*atan(1._r8)/45._r8 + latdeg(1) = clat(1)*45._r8/atan(1._r8) + clon(1,1) = 4.0_r8*atan(1._r8)*mod((scmlon+360._r8),360._r8)/180._r8 + londeg(1,1) = mod((scmlon+360._r8),360._r8) + + else + + ! Gaussian latitude dependent arrays + call gauaw(zsi, zw, plat) + do irow = 1, plat/2 + slat(irow) = zsi(irow) + w(irow) = zw(irow) + w(plat-irow+1) = zw(irow) + cs(irow) = 1._r8 - zsi(irow)*zsi(irow) + xlat = asin(slat(irow)) + clat(irow) = -xlat + clat(plat-irow+1) = xlat + end do + + do lat = 1, plat + latdeg(lat) = clat(lat)*45._r8/atan(1._r8) + end do + + ! Compute constants related to Legendre transforms + ! Compute and reorder ALP and DALP + + allocate(alp(pspt,plat/2)) + allocate(dalp(pspt,plat/2)) + + do j = 1, plat/2 + zslat = slat(j) + itmp = 2*pspt - 1 + call phcs(zalp, zdalp, itmp, zslat) + call reordp(j, itmp, zalp, zdalp) + end do + + ! Copy and save local ALP and DALP + + allocate(lalp(lpspt,plat/2)) + allocate(ldalp(lpspt,plat/2)) + + do j = 1, plat/2 + do lm = 1, numm(iam) + m = locm(lm,iam) + mr = nstart(m) + lmr = lnstart(lm) + do n = 1, nlen(m) + lalp(lmr+n,j) = alp(mr+n,j) + ldalp(lmr+n,j) = dalp(mr+n,j) + end do + end do + end do + + ! Mirror latitudes south of south pole + + lat = 1 + do j = j1-2, 1, -1 + nlonex(j) = plon + lat = lat + 1 + end do + nlonex(j1-1) = plon ! south pole + + ! Real latitudes + + j = j1 + do lat = 1, plat + nlonex(j) = plon + j = j + 1 + end do + nlonex(j1+plat) = plon ! north pole + + ! Mirror latitudes north of north pole + + lat = plat + do j = j1+plat+1, platd + nlonex(j) = plon + lat = lat - 1 + end do + + ! Longitude array + + pi = 4.0_r8*atan(1.0_r8) + do lat = 1, plat + do i = 1, plon + londeg(i,lat) = (i-1)*360._r8/plon + clon(i,lat) = (i-1)*2.0_r8*pi/plon + end do + end do + + ! Set up trigonometric tables for fft + + do j = 1, plat + call set99(trig(1,j), ifax(1,j), plon) + end do + end if + + ! Define the CAM grids (must be before addfld calls) + call define_cam_grids() + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'EULERIAN dycore -- Done grid and decomposition initialization' + write(iulog,*) ' Truncation Parameters: M =',ptrm,' N =',ptrn,' K =',ptrk + write(iulog,*) ' zdt, dtime=', zdt, dtime + write(iulog,*) ' ' + end if + +end subroutine dyn_grid_init + +!======================================================================================== + + subroutine get_block_bounds_d(block_first,block_last) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return first and last indices used in global block ordering +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plat + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(out) :: block_first ! first (global) index used for blocks + integer, intent(out) :: block_last ! last (global) index used for blocks + +!----------------------------------------------------------------------- +! latitude slice block + block_first = 1 + block_last = plat + + return + end subroutine get_block_bounds_d + +! +!======================================================================== +! + subroutine get_block_gcol_d(blockid,size,cdex) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return list of dynamics column indices in given block +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plat, plon + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: size ! array size + + integer, intent(out):: cdex(size) ! global column indices +!---------------------------Local workspace----------------------------- +! + integer i,j ! loop indices + integer n ! column index +!----------------------------------------------------------------------- +! block == latitude slice + if (size < plon) then + write(iulog,*)'GET_BLOCK_GCOL_D: array not large enough (', & + size,' < ',plon,' ) ' + call endrun + else + n = (blockid-1)*plon + do i = 1,plon + n = n + 1 + cdex(i) = n + end do + end if +! + return + end subroutine get_block_gcol_d +! +!======================================================================== +! + integer function get_block_gcol_cnt_d(blockid) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return number of dynamics columns in indicated block +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plon + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + +!----------------------------------------------------------------------- +! latitude slice block + get_block_gcol_cnt_d = plon + + return + end function get_block_gcol_cnt_d + +! +!======================================================================== +! + integer function get_block_lvl_cnt_d(blockid,bcid) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return number of levels in indicated column. If column +! includes surface fields, then it is defined to also +! include level 0. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + +!----------------------------------------------------------------------- +! latitude slice block + get_block_lvl_cnt_d = plev + 1 + + return + end function get_block_lvl_cnt_d +! +!======================================================================== +! + subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return level indices in indicated column. If column +! includes surface fields, then it is defined to also +! include level 0. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + integer, intent(in) :: lvlsiz ! dimension of levels array + + integer, intent(out) :: levels(lvlsiz) ! levels indices for block + +!---------------------------Local workspace----------------------------- +! + integer k ! loop index +!----------------------------------------------------------------------- +! latitude slice block + if (lvlsiz < plev + 1) then + write(iulog,*)'GET_BLOCK_LEVELS_D: levels array not large enough (', & + lvlsiz,' < ',plev + 1,' ) ' + call endrun + else + do k=0,plev + levels(k+1) = k + end do + do k=plev+2,lvlsiz + levels(k) = -1 + end do + end if + + return + end subroutine get_block_levels_d + +! +!======================================================================== +! + subroutine get_gcol_block_d(gcol,cnt,blockid,bcid,localblockid) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return global block index and local column index +! for global column index +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plat, plon + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: gcol ! global column index + integer, intent(in) :: cnt ! size of blockid and bcid arrays + + integer, intent(out) :: blockid(cnt) ! block index + integer, intent(out) :: bcid(cnt) ! column index within block + integer, intent(out), optional :: localblockid(cnt) +!---------------------------Local workspace----------------------------- +! + integer jb ! loop index +!----------------------------------------------------------------------- +! latitude slice block + if (cnt < 1) then + write(iulog,*)'GET_GCOL_BLOCK_D: arrays not large enough (', & + cnt,' < ',1,' ) ' + call endrun + else + blockid(1) = (gcol-1)/plon + 1 + bcid(1) = gcol - (blockid(1)-1)*plon + do jb=2,cnt + blockid(jb) = -1 + bcid(jb) = -1 + end do + end if +! + return + end subroutine get_gcol_block_d +! +!======================================================================== +! + integer function get_gcol_block_cnt_d(gcol) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return number of blocks contain data for the vertical column +! with the given global column index +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: gcol ! global column index +!----------------------------------------------------------------------- +! latitude slice block + get_gcol_block_cnt_d = 1 + + return + end function get_gcol_block_cnt_d +! +!======================================================================== +! + integer function get_block_owner_d(blockid) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return id of processor that "owns" the indicated block +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) + use spmd_dyn, only: proc +#endif + + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + +!----------------------------------------------------------------------- +! latitude slice block +#if (defined SPMD) + get_block_owner_d = proc(blockid) +#else + get_block_owner_d = 0 +#endif + + return + end function get_block_owner_d +! +!======================================================================== +! + subroutine get_horiz_grid_dim_d(hdim1_d,hdim2_d) + +!----------------------------------------------------------------------- +! +! +! Purpose: Returns declared horizontal dimensions of computational grid. +! Note that global column ordering is assumed to be compatible +! with the first dimension major ordering of the 2D array. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plat, plon + +!------------------------------Arguments-------------------------------- + integer, intent(out) :: hdim1_d ! first horizontal dimension + integer, intent(out) :: hdim2_d ! second horizontal dimension +!----------------------------------------------------------------------- + if (ngcols_d == 0) then + ngcols_d = plat*plon + end if + hdim1_d = plon + hdim2_d = plat + + return + end subroutine get_horiz_grid_dim_d +! +!======================================================================== +! + subroutine get_horiz_grid_d(size,clat_d_out,clon_d_out,area_d_out, & + wght_d_out,lat_d_out,lon_d_out) + +!----------------------------------------------------------------------- +! +! +! Purpose: Return latitude and longitude (in radians), column surface +! area (in radians squared) and surface integration weights +! for global column indices that will be passed to/from physics +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plat, plon + use commap, only: clat, clon, londeg, latdeg, w + use physconst, only: pi, spval + implicit none +!------------------------------Arguments-------------------------------- + integer, intent(in) :: size ! array sizes + + real(r8), intent(out), optional :: clat_d_out(size) ! column latitudes + real(r8), intent(out), optional :: clon_d_out(size) ! column longitudes + real(r8), intent(out), optional :: area_d_out(size) ! column surface + ! area + real(r8), intent(out), optional :: wght_d_out(size) ! column integration + ! weight + real(r8), intent(out), optional :: lat_d_out(size) ! column deg latitudes + real(r8), intent(out), optional :: lon_d_out(size) ! column deg longitudes +!---------------------------Local workspace----------------------------- +! + integer i,j ! loop indices + integer n ! column index + real(r8) :: ns_vert(2,plon) ! latitude grid vertices + real(r8) :: ew_vert(2,plon) ! longitude grid vertices + real(r8) :: del_theta ! difference in latitude at a grid point + real(r8) :: del_phi ! difference in longitude at a grid point + real(r8), parameter :: degtorad=pi/180_r8 +!----------------------------------------------------------------------- + if(present(clon_d_out)) then + if(size == ngcols_d) then + n = 0 + do j = 1,plat + do i = 1, plon + n = n + 1 + clon_d_out(n) = clon(i,j) + end do + end do + else if(size == plon) then + clon_d_out(:) = clon(:,1) + else + write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & + size,' < ',ngcols_d,' ) ' + call endrun + end if + end if + if(present(clat_d_out)) then + if(size == ngcols_d) then + n = 0 + do j = 1,plat + do i = 1, plon + n = n + 1 + clat_d_out(n) = clat(j) + end do + end do + else if(size == plat) then + clat_d_out(:) = clat(:) + else + write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & + size,' < ',ngcols_d,' ) ' + call endrun + end if + end if + if ( ( present(wght_d_out) ) ) then + + if(size==plat) then + wght_d_out(:) = (0.5_r8*w(:)/plon)* (4.0_r8*pi) + else if(size == ngcols_d) then + n = 0 + do j = 1,plat + do i = 1, plon + n = n + 1 + wght_d_out(n) = ( 0.5_r8*w(j)/plon ) * (4.0_r8*pi) + end do + end do + end if + end if + if ( present(area_d_out) ) then + if(size < ngcols_d) then + write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & + size,' < ',ngcols_d,' ) ' + call endrun + end if + n = 0 + do j = 1,plat + + ! First, determine vertices of each grid point. + ! Verticies are ordered as follows: + ! ns_vert: 1=lower left, 2 = upper left + ! ew_vert: 1=lower left, 2 = lower right + + ! Latitude vertices + ns_vert(:,:) = spval + if (j .eq. 1) then + ns_vert(1,:plon) = -90.0_r8 + else + ns_vert(1,:plon) = (latdeg(j) + latdeg(j-1) )*0.5_r8 + end if + + if (j .eq. plat) then + ns_vert(2,:plon) = 90.0_r8 + else + ns_vert(2,:plon) = (latdeg(j) + latdeg(j+1) )*0.5_r8 + end if + + ! Longitude vertices + ew_vert(:,:) = spval + ew_vert(1,1) = (londeg(1,j) - 360.0_r8 + londeg(plon,j))*0.5_r8 + ew_vert(1,2:plon) = (londeg(1:plon-1,j)+ londeg(2:plon,j))*0.5_r8 + ew_vert(2,:plon-1) = ew_vert(1,2:plon) + ew_vert(2,plon) = (londeg(plon,j) + (360.0_r8 + londeg(1,j)))*0.5_r8 + + do i = 1, plon + n = n + 1 + del_phi = sin( ns_vert(2,i)*degtorad ) - sin( ns_vert(1,i)*degtorad ) + del_theta = ( ew_vert(2,i) - ew_vert(1,i) )*degtorad + area_d_out(n) = del_theta*del_phi + end do + + end do + end if + if(present(lon_d_out)) then + if(size == ngcols_d) then + n = 0 + do j = 1,plat + do i = 1, plon + n = n + 1 + lon_d_out(n) = londeg(i,j) + end do + end do + else if(size == plon) then + lon_d_out(:) = londeg(:,1) + else + write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & + size,' < ',ngcols_d,' ) ' + call endrun + end if + end if + if(present(lat_d_out)) then + if(size == ngcols_d) then + n = 0 + do j = 1,plat + do i = 1, plon + n = n + 1 + lat_d_out(n) = latdeg(j) + end do + end do + else if(size == plat) then + lat_d_out(:) = latdeg(:) + else + write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & + size,' < ',ngcols_d,' ) ' + call endrun + end if + end if +! + return + end subroutine get_horiz_grid_d + + +!####################################################################### + function get_dyn_grid_parm_real2d(name) result(rval) + use commap, only : londeg, clon + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:,:) + + if(name.eq.'clon') then + rval => clon + else if(name.eq.'londeg') then + rval => londeg + else + nullify(rval) + end if + end function get_dyn_grid_parm_real2d + +!####################################################################### + function get_dyn_grid_parm_real1d(name) result(rval) + use commap, only : latdeg, clat, w + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:) + + if(name.eq.'clat') then + rval => clat + else if(name.eq.'latdeg') then + rval => latdeg + else if(name.eq.'w') then + rval => w + else + nullify(rval) + end if + end function get_dyn_grid_parm_real1d + + + + + integer function get_dyn_grid_parm(name) result(ival) + use pmgrid, only : beglat, endlat, plat, plon, plev, plevp + character(len=*), intent(in) :: name + + if(name.eq.'beglat' .or. name .eq. 'beglatxy') then + ival = beglat + else if(name.eq.'endlat' .or. name .eq. 'endlatxy') then + ival = endlat + else if(name.eq.'plat') then + ival = plat + else if(name.eq.'plon' .or. name .eq. 'endlonxy') then + ival = plon + else if(name.eq.'plev') then + ival = plev + else if(name.eq.'plevp') then + ival = plevp + else if(name .eq. 'beglonxy') then + ival = 1 + else + ival = -1 + end if + + + end function get_dyn_grid_parm + +!####################################################################### + +!------------------------------------------------------------------------------- +! This returns the lat/lon information (and corresponding MPI task numbers (owners)) +! of the global model grid columns nearest to the input satellite coordinate (lat,lon) +!------------------------------------------------------------------------------- +subroutine dyn_grid_find_gcols( lat, lon, nclosest, owners, indx, jndx, rlat, rlon, idyn_dists ) + use spmd_utils, only: iam + use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_REARTH + use pmgrid, only: plon, plat + + real(r8), intent(in) :: lat + real(r8), intent(in) :: lon + integer, intent(in) :: nclosest + integer, intent(out) :: owners(nclosest) + integer, intent(out) :: indx(nclosest) + integer, intent(out) :: jndx(nclosest) + + real(r8),optional, intent(out) :: rlon(nclosest) + real(r8),optional, intent(out) :: rlat(nclosest) + real(r8),optional, intent(out) :: idyn_dists(nclosest) + + real(r8) :: dist ! the distance (in radians**2 from lat, lon) + real(r8) :: latr, lonr ! lat, lon inputs converted to radians + integer :: ngcols + integer :: i, j + + integer :: blockid(1), bcid(1), lclblockid(1) + + real(r8), allocatable :: clat_d(:), clon_d(:), distmin(:) + integer, allocatable :: igcol(:) + real(r8), parameter :: rad2deg = 180._r8/SHR_CONST_PI + + latr = lat/rad2deg + lonr = lon/rad2deg + + ngcols = plon*plat + allocate( clat_d(1:ngcols) ) + allocate( clon_d(1:ngcols) ) + allocate( igcol(nclosest) ) + allocate( distmin(nclosest) ) + + call get_horiz_grid_d(ngcols, clat_d_out=clat_d, clon_d_out=clon_d) + + igcol(:) = -999 + distmin(:) = 1.e10_r8 + + do i = 1,ngcols + + ! Use the Spherical Law of Cosines to find the great-circle distance. + dist = acos(sin(latr) * sin(clat_d(i)) + cos(latr) * cos(clat_d(i)) * cos(clon_d(i) - lonr)) * SHR_CONST_REARTH + do j = nclosest, 1, -1 + if (dist < distmin(j)) then + + if (j < nclosest) then + distmin(j+1) = distmin(j) + igcol(j+1) = igcol(j) + end if + + distmin(j) = dist + igcol(j) = i + else + exit + end if + end do + + end do + + do i = 1,nclosest + + call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) + owners(i) = get_block_owner_d(blockid(1)) + + if ( iam==owners(i) ) then + ! get global lat and lon coordinate indices from global column index + ! -- plon is global number of longitude grid points + jndx(i) = (igcol(i)-1)/plon + 1 + indx(i) = igcol(i) - (jndx(i)-1)*plon + else + jndx(i) = -1 + indx(i) = -1 + end if + + if ( present(rlat) ) rlat(i) = clat_d(igcol(i)) * rad2deg + if ( present(rlon) ) rlon(i) = clon_d(igcol(i)) * rad2deg + + if (present(idyn_dists)) then + idyn_dists(i) = distmin(i) + end if + + end do + + deallocate( clat_d ) + deallocate( clon_d ) + deallocate( igcol ) + deallocate( distmin ) + +end subroutine dyn_grid_find_gcols + +!####################################################################### +subroutine dyn_grid_get_colndx( igcol, nclosest, owners, indx, jndx ) + use spmd_utils, only: iam + use pmgrid, only: plon + + integer, intent(in) :: nclosest + integer, intent(in) :: igcol(nclosest) + integer, intent(out) :: owners(nclosest) + integer, intent(out) :: indx(nclosest) + integer, intent(out) :: jndx(nclosest) + + integer :: i + integer :: blockid(1), bcid(1), lclblockid(1) + + do i = 1,nclosest + + call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) + owners(i) = get_block_owner_d(blockid(1)) + + if ( iam==owners(i) ) then + ! get global lat and lon coordinate indices from global column index + ! -- plon is global number of longitude grid points + jndx(i) = (igcol(i)-1)/plon + 1 + indx(i) = igcol(i) - (jndx(i)-1)*plon + else + jndx(i) = -1 + indx(i) = -1 + endif + + end do + +end subroutine dyn_grid_get_colndx +!####################################################################### + +! this returns coordinates of a latitude slice of the block corresponding +! to latitude index latndx + +subroutine dyn_grid_get_elem_coords( latndx, rlon, rlat, cdex ) + use commap, only : clat, clon + use pmgrid, only : plon + + integer, intent(in) :: latndx ! lat index + + real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the latndx slice + real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the latndx slice + integer, optional, intent(out) :: cdex(:) ! global column index + + integer :: i,ii,j + + if (present(cdex)) cdex(:) = -1 + if (present(rlat)) rlat(:) = -999._r8 + if (present(rlon)) rlon(:) = -999._r8 + + j = latndx + ii=0 + do i = 1,plon + ii = ii+1 + if (present(cdex)) cdex(ii) = i + (j-1)*plon + if (present(rlat)) rlat(ii) = clat(j) + if (present(rlon)) rlon(ii) = clon(i,1) + end do + +end subroutine dyn_grid_get_elem_coords + +!####################################################################### + +subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) + use cam_grid_support, only: max_hcoordname_len + + ! Dummy arguments + character(len=max_hcoordname_len), intent(out) :: gridname + character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) + + gridname = 'gauss_grid' + allocate(grid_attribute_names(4)) + grid_attribute_names(1) = 'gw' + grid_attribute_names(2) = 'ntrm' + grid_attribute_names(3) = 'ntrn' + grid_attribute_names(4) = 'ntrk' + +end subroutine physgrid_copy_attributes_d + +!======================================================================================== +! Private Methods +!======================================================================================== + + +subroutine trunc() +!----------------------------------------------------------------------- +! +! Purpose: +! Check consistency of truncation parameters and evaluate pointers +! and displacements for spectral arrays +! +! Method: +! +! Author: +! Original version: CCM1 +! Standardized: L. Bath, June 1992 +! T. Acker, March 1996 +! Reviewed: J. Hack, D. Williamson, August 1992 +! Reviewed: J. Hack, D. Williamson, April 1996 +!----------------------------------------------------------------------- + + use pspect, only: ptrm, ptrn, ptrk, pmmax + use comspe, only: nstart, nlen, locm, lnstart + +!---------------------------Local variables----------------------------- +! + integer m ! loop index +! +!----------------------------------------------------------------------- +! +! trunc first evaluates truncation parameters for a general pentagonal +! truncation for which the following parameter relationships are true +! +! 0 .le. |m| .le. ptrm +! +! |m| .le. n .le. |m|+ptrn for |m| .le. ptrk-ptrn +! +! |m| .le. n .le. ptrk for (ptrk-ptrn) .le. |m| .le. ptrm +! +! Most commonly utilized truncations include: +! 1: triangular truncation for which ptrk=ptrm=ptrn +! 2: rhomboidal truncation for which ptrk=ptrm+ptrn +! 3: trapezoidal truncation for which ptrn=ptrk .gt. ptrm +! +! Simple sanity check +! It is necessary that ptrm .ge. ptrk-ptrn .ge. 0 +! + if (ptrm.lt.(ptrk-ptrn)) then + call endrun ('TRUNC: Error in truncation parameters. ntrm < (ptrk-ptrn)') + end if + if (ptrk.lt.ptrn) then + call endrun ('TRUNC: Error in truncation parameters. ptrk < ptrn') + end if +! +! Evaluate pointers and displacement info based on truncation params +! + nstart(1) = 0 + nlen(1) = ptrn + 1 + do m=2,pmmax + nstart(m) = nstart(m-1) + nlen(m-1) + nlen(m) = min0(ptrn+1,ptrk+2-m) + end do +! +! Assign wavenumbers and spectral offsets if not SPMD +! +#if ( ! defined SPMD ) + do m=1,pmmax + locm(m,0) = m + lnstart(m) = nstart(m) + enddo +#endif + +end subroutine trunc + +!======================================================================================== + +subroutine define_cam_grids() + use pspect, only: ptrm, ptrn, ptrk + use pmgrid, only: beglat, endlat, plon, plat + use commap, only: londeg, latdeg, w + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap + use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + + ! Local variables + integer :: i, j, ind + integer(iMap), pointer :: grid_map(:,:) + integer(iMap) :: latmap(endlat - beglat + 1) + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + real(r8), pointer :: rattval(:) + + nullify(grid_map) + nullify(lat_coord) + nullify(lon_coord) + nullify(rattval) + + ! Dynamics Grid + ! Make grid and lat maps (need to do this because lat indices are distributed) + ! Note that for this dycore, some pes may be inactive + if(endlat >= beglat) then + allocate(grid_map(4, (plon * (endlat - beglat + 1)))) + ind = 0 + do i = beglat, endlat + do j = 1, plon + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + ! Do we need a lat map? + if ((beglat /= 1) .or. (endlat /= plat)) then + do i = beglat, endlat + latmap(i - beglat + 1) = i + end do + end if + else + allocate(grid_map(4, 0)) + end if + + ! Create the lat coordinate + if ((beglat /= 1) .or. (endlat /= plat)) then + lat_coord => horiz_coord_create('lat', '', plat, 'latitude', & + 'degrees_north', beglat, endlat, latdeg(beglat:endlat), map=latmap) + else + lat_coord => horiz_coord_create('lat', '', plat, 'latitude', & + 'degrees_north', beglat, endlat, latdeg(beglat:endlat)) + end if + + ! Create the lon coordinate + lon_coord => horiz_coord_create('lon', '', plon, 'longitude', & + 'degrees_east', 1, plon, londeg(1:plon, 1)) + + call cam_grid_register('gauss_grid', dyn_decomp, lat_coord, lon_coord, & + grid_map, unstruct=.false.) + + allocate(rattval(size(w))) + rattval = w + call cam_grid_attribute_register('gauss_grid', 'gw', 'gauss weights', 'lat', rattval) + nullify(rattval) ! belongs to attribute + + ! Scalar variable 'attributes' + call cam_grid_attribute_register('gauss_grid', 'ntrm', & + 'spectral truncation parameter M', ptrm) + call cam_grid_attribute_register('gauss_grid', 'ntrn', & + 'spectral truncation parameter N', ptrn) + call cam_grid_attribute_register('gauss_grid', 'ntrk', & + 'spectral truncation parameter K', ptrk) + ! These belong to the grid now + nullify(grid_map) + nullify(lat_coord) + nullify(lon_coord) + +end subroutine define_cam_grids + +!======================================================================================== + +end module dyn_grid diff --git a/src/dynamics/eul/dyndrv.F90 b/src/dynamics/eul/dyndrv.F90 new file mode 100644 index 0000000000..b3afd7adc6 --- /dev/null +++ b/src/dynamics/eul/dyndrv.F90 @@ -0,0 +1,142 @@ +subroutine dyndrv(grlps1, grt1, grz1, grd1, grfu1, & + grfv1, grut1, grvt1, grrh1, grlps2, & + grt2, grz2, grd2, grfu2, grfv2, & + grut2, grvt2, grrh2, vmax2d, vmax2dt, & + vcour, ztodt ) +!----------------------------------------------------------------------- +! +! Driving routine for Gaussian quadrature, semi-implicit equation +! solution and linear part of horizontal diffusion. +! The need for this interface routine is to have a multitasking +! driver for the spectral space routines it invokes. +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, B. Boville, J. Hack, August 1992 +! Reviewed: D. Williamson, March 1996 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap +! use time_manager, only: get_step_size, is_first_step + use spmd_utils, only: iam + use perf_mod + + implicit none + +! +! Input arguments +! + real(r8), intent(in) :: grlps1(2*maxm,(plat+1)/2) ! ---------------------------- + real(r8), intent(inout) :: grt1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(inout) :: grz1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(inout) :: grd1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grfu1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grfv1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grut1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grvt1(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grrh1(2*maxm,plev,(plat+1)/2) ! |- see linems and quad for + real(r8), intent(in) :: grlps2(2*maxm,(plat+1)/2) ! | definitions: these variables are + real(r8), intent(inout) :: grt2(2*maxm,plev,(plat+1)/2) ! | declared here for data scoping + real(r8), intent(inout) :: grz2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(inout) :: grd2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grfu2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grfv2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grut2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grvt2(2*maxm,plev,(plat+1)/2) ! | + real(r8), intent(in) :: grrh2(2*maxm,plev,(plat+1)/2) ! ---------------------------- + real(r8), intent(inout) :: vmax2d(plev,plat) ! max. wind at each level, latitude + real(r8), intent(inout) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat + real(r8), intent(inout) :: vcour(plev,plat) ! maximum Courant number in slice + real(r8), intent(in) :: ztodt +! +!---------------------------Local workspace----------------------------- +! + real(r8) ztdtsq(pnmax) ! 2dt*(n(n+1)/a^2) + real(r8) zdt ! dt unless nstep = 0 + real(r8) ztdt ! 2*zdt (2dt) + integer irow ! latitude pair index + integer lm ! local longitudinal wavenumber index + integer n ! total wavenumber index + integer k ! level index + + call t_startf('dyn') + +!$OMP PARALLEL DO PRIVATE (IROW) + do irow=1,plat/2 + call dyn(irow, grlps1(:,irow), grt1(:,:,irow), & + grz1(:,:,irow), grd1(:,:,irow), & + grfu1(:,:,irow), grfv1(:,:,irow), & + grut1(:,:,irow), grvt1(:,:,irow), & + grrh1(:,:,irow), & + grlps2(:,irow), grt2(:,:,irow), & + grz2(:,:,irow), grd2(:,:,irow), & + grfu2(:,:,irow), & + grfv2(:,:,irow), grut2(:,:,irow), & + grvt2(:,:,irow), grrh2(:,:,irow),ztodt ) + end do + + call t_stopf('dyn') +! +!----------------------------------------------------------------------- +! +! Build vector with del^2 response function +! + + ztdt = ztodt + zdt = ztdt/2 +! zdt = get_step_size() +! if (is_first_step()) zdt = .5_r8*zdt +! ztdt = 2._r8*zdt + + + do n=1,pnmax + ztdtsq(n) = ztdt*sq(n) + end do + + call t_startf ('quad-tstep') + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE(LM) +#endif + do lm=1,numm(iam) +! +! Perform Gaussian quadrature +! + call quad(lm, zdt, ztdtsq, grlps1, grlps2, & + grt1, grz1, grd1, grfu1, grfv1, & + grvt1, grrh1, grt2, grz2, grd2, & + grfu2, grfv2, grvt2, grrh2 ) +! +! Complete time advance, solve vertically coupled semi-implicit system +! + call tstep(lm,zdt,ztdtsq) + end do + call t_stopf ('quad-tstep') +! +! Find out if courant limit has been exceeded. If so, the limiter will be +! applied in HORDIF +! + call t_startf('courlim') + call courlim(vmax2d, vmax2dt, vcour ) + call t_stopf('courlim') +! +! Linear part of horizontal diffusion +! + call t_startf('hordif') + +!$OMP PARALLEL DO PRIVATE(K) + do k=1,plev + call hordif(k,ztdt) + end do + + call t_stopf('hordif') + + return +end subroutine dyndrv diff --git a/src/dynamics/eul/dynpkg.F90 b/src/dynamics/eul/dynpkg.F90 new file mode 100644 index 0000000000..94fcec48f9 --- /dev/null +++ b/src/dynamics/eul/dynpkg.F90 @@ -0,0 +1,153 @@ + +subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & + cwava ,detam ,flx_net ,ztodt ) +!----------------------------------------------------------------------- +! +! Purpose: +! Driving routines for dynamics and transport. +! +! Method: +! +! Author: +! Original version: CCM3 +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plev, plevp, beglat, endlat + use pspect + use comspe + use scanslt, only: scanslt_run, plond, platd, advection_state + use scan2, only: scan2run + use scamMod, only: single_column,scm_crm_mode,switch,wfldh +#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only: t2sav,fusav,fvsav +#endif + use perf_mod +!----------------------------------------------------------------------- + implicit none + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + type(advection_state), intent(inout) :: adv_state ! Advection state data + real(r8), intent(inout) :: t2(plon,plev,beglat:endlat) ! temp tendency + real(r8), intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tendency + real(r8), intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tendency + + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(inout) :: cwava(plat) ! weight applied to global integrals + real(r8), intent(inout) :: detam(plev) ! intervals between vert full levs. + real(r8), intent(in) :: flx_net(plon,beglat:endlat) ! net flux from physics + real(r8), intent(in) :: ztodt ! twice time step unless nstep=0 +! +!---------------------------Local workspace----------------------------- +! + real(r8) etadot(plon,plevp,beglat:endlat) ! Vertical motion (slt) +! +! Fourier coefficient arrays which have a latitude index on them for +! multitasking. These arrays are defined in LINEMSAC and used in QUAD +! to compute spectral coefficients. They contain a latitude index so +! that the sums over latitude can be performed in a specified order. +! + real(r8) grlps1(2*maxm,plat/2) ! ------------------------------ + real(r8) grlps2(2*maxm,plat/2) ! | + real(r8) grt1(2*maxm,plev,plat/2) ! | + real(r8) grt2(2*maxm,plev,plat/2) ! | + real(r8) grz1(2*maxm,plev,plat/2) ! | + real(r8) grz2(2*maxm,plev,plat/2) ! | + real(r8) grd1(2*maxm,plev,plat/2) ! | + real(r8) grd2(2*maxm,plev,plat/2) ! | + real(r8) grfu1(2*maxm,plev,plat/2) ! |- see quad for definitions + real(r8) grfu2(2*maxm,plev,plat/2) ! | + real(r8) grfv1(2*maxm,plev,plat/2) ! | + real(r8) grfv2(2*maxm,plev,plat/2) ! | + real(r8) grut1(2*maxm,plev,plat/2) ! | + real(r8) grut2(2*maxm,plev,plat/2) ! | + real(r8) grvt1(2*maxm,plev,plat/2) ! | + real(r8) grvt2(2*maxm,plev,plat/2) ! | + real(r8) grrh1(2*maxm,plev,plat/2) ! | + real(r8) grrh2(2*maxm,plev,plat/2) ! ------------------------------ + real(r8) :: vcour(plev,plat) ! maximum Courant number in slice + real(r8) :: vmax2d(plev,plat) ! max. wind at each level, latitude + real(r8) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat + integer c + + call settau(ztodt/2) + if(single_column.and.scm_crm_mode) return +!---------------------------------------------------------- +! SCANDYN Dynamics scan +!---------------------------------------------------------- +! +#if ( defined BFB_CAM_SCAM_IOP ) +do c=beglat,endlat + t2sav(:plon,:,c)= t2(:plon,:,c) + fusav(:plon,:,c)= fu(:plon,:,c) + fvsav(:plon,:,c)= fv(:plon,:,c) +enddo +#endif + +if ( single_column ) then + etadot(1,:,1)=wfldh(:) +else + call t_startf('scandyn') + call scandyn(ztodt ,etadot ,etamid ,grlps1 ,grt1 , & + grz1 ,grd1 ,grfu1 ,grfv1 ,grut1 , & + grvt1 ,grrh1 ,grlps2 ,grt2 ,grz2 , & + grd2 ,grfu2 ,grfv2 ,grut2 ,grvt2 , & + grrh2 ,vcour ,vmax2d, vmax2dt ,detam , & + cwava ,flx_net ,t2 ,fu ,fv ) + call t_stopf('scandyn') +endif +! +!---------------------------------------------------------- +! SLT scan from south to north +!---------------------------------------------------------- +! + call t_startf('sltrun') + call scanslt_run(adv_state, ztodt ,etadot , detam, etamid, cwava ) + call t_stopf('sltrun') + + if ( single_column ) then + call scan2run (ztodt, cwava, etamid ,t2 ,fu ,fv ) + else +! +!---------------------------------------------------------- +! Accumulate spectral coefficients +!---------------------------------------------------------- +! + call t_startf('dynpkg_alloc') + allocate( vz (2*lpspt,plev) ) + allocate( d (2*lpspt,plev) ) + allocate( t (2*lpspt,plev) ) + allocate( alps(2*lpspt) ) + call t_stopf('dynpkg_alloc') + + call t_startf('dyndrv') + call dyndrv(grlps1 ,grt1 ,grz1 ,grd1 ,grfu1 , & + grfv1 ,grut1 ,grvt1 ,grrh1 ,grlps2 , & + grt2 ,grz2 ,grd2 ,grfu2 ,grfv2 , & + grut2 ,grvt2 ,grrh2 ,vmax2d ,vmax2dt , & + vcour, ztodt ) + call t_stopf('dyndrv') +! +!---------------------------------------------------------- +! Second gaussian scan (spectral -> grid) +!---------------------------------------------------------- +! + call t_startf('scan2') + call scan2run (ztodt, cwava, etamid) + call t_stopf('scan2') + + call t_startf('dynpkg_dealloc') + deallocate( vz ) + deallocate( d ) + deallocate( t ) + deallocate( alps ) + call t_stopf('dynpkg_dealloc') +endif + + return +end subroutine dynpkg + diff --git a/src/dynamics/eul/eul_control_mod.F90 b/src/dynamics/eul/eul_control_mod.F90 new file mode 100644 index 0000000000..d484ba33b8 --- /dev/null +++ b/src/dynamics/eul/eul_control_mod.F90 @@ -0,0 +1,55 @@ +module eul_control_mod + +! Eulerian dynamics shared data + +use shr_kind_mod, only: r8=>shr_kind_r8 +use pmgrid, only: plat, plon, plev +use spmd_utils, only: masterproc +use pspect, only: pnmax + +implicit none +private +save + +real(r8) ,public :: tmass(plat) ! Mass integral for each latitude pair +real(r8) ,public :: tmass0 ! Specified dry mass of atmosphere +real(r8) ,public :: tmassf ! Global mass integral +real(r8) ,public :: qmassf ! Global moisture integral +real(r8) ,public :: fixmas ! Proportionality factor for ps in dry mass fixer +real(r8) ,public :: qmass1 ! Contribution to global moisture integral (mass + ! weighting is based upon the "A" part of the hybrid grid) +real(r8) ,public :: qmass2 ! Contribution to global moisture integral (mass + ! weighting is based upon the "B" part of the hybrid grid) +real(r8) ,public :: pdela(plon,plev)! pressure difference between interfaces (pressure + ! defined using the "A" part of hybrid grid only) +real(r8) ,public :: zgsint ! global integral of geopotential height + +integer ,public :: pcray ! length of vector register (words) for FFT workspace +parameter (pcray=64) + +real(r8) ,public :: trig (3*plon/2+1,plat) ! trigonometric funct values used by fft +integer ,public :: ifax(19,plat) ! fft factorization of plon/2 +real(r8), public :: cnfac ! Courant num factor(multiply by max |V|) +real(r8), public :: cnlim ! Maximum allowable courant number +real(r8), public :: hdfsd2(pnmax) ! Del^2 mult. for each wave (vort-div) +real(r8), public :: hdfst2(pnmax) ! Del^2 multiplier for each wave (t-q) +real(r8), public :: hdfsdn(pnmax) ! Del^N mult. for each wave (vort-div) +real(r8), public :: hdfstn(pnmax) ! Del^N multiplier for each wave (t-q) +real(r8), public :: hdiftq(pnmax,plev) ! Temperature-tracer diffusion factors +real(r8), public :: hdifzd(pnmax,plev) ! Vorticity-divergence diffusion factors +integer, parameter, public :: kmxhd2 = 2 ! Bottom level for increased del^2 diffusion +integer, public :: nindex(plev) ! Starting index for spectral truncation +integer, public :: nmaxhd ! Maximum two dimensional wave number + +! Variables set by namelist +real(r8), public :: dif2 ! del2 horizontal diffusion coeff. +integer, public :: hdif_order ! Order of horizontal diffusion operator +integer, public :: kmnhdn ! Nth order diffusion applied at and below layer kmnhdn. + ! 2nd order diffusion is applied above layer kmnhdn. +real(r8), public :: hdif_coef ! Nth order horizontal diffusion coefficient. +real(r8), public :: divdampn ! Number of days (from nstep 0) to run divergence +real(r8), public :: eps ! time filter coefficient. Defaults to 0.06. +integer, public :: kmxhdc ! number of levels (starting from model top) to apply Courant limiter. +integer, public :: eul_nsplit ! Intended number of dynamics timesteps per physics timestep + +end module eul_control_mod diff --git a/src/dynamics/eul/getinterpnetcdfdata.F90 b/src/dynamics/eul/getinterpnetcdfdata.F90 new file mode 100644 index 0000000000..a86ae52621 --- /dev/null +++ b/src/dynamics/eul/getinterpnetcdfdata.F90 @@ -0,0 +1,358 @@ +module getinterpnetcdfdata + +! Description: +! Routines for extracting a column from a netcdf file +! +! Author: +! +! Modules Used: +! + use cam_abortutils, only: endrun + use pmgrid, only: plev + use scamMod, only: scm_crm_mode + use cam_logfile, only: iulog + + implicit none + private +! +! Public Methods: +! + public getinterpncdata + +contains + +subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & + varName, have_surfdat, surfdat, fill_ends, & + press, npress, ps, outData, STATUS ) + +! getinterpncdata: extracts the entire level dimension for a +! particular lat,lon,time from a netCDF file +! and interpolates it onto the input pressure levels, placing +! result in outData, and the error status inx STATUS + + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use netcdf + implicit none +!----------------------------------------------------------------------- + + +! ---------- inputs ------------ + + integer, intent(in) :: NCID ! NetCDF ID + integer, intent(in) :: TimeIdx ! time index + real(r8), intent(in) :: camlat,camlon ! target lat and lon to be extracted + logical, intent(in) :: have_surfdat ! is surfdat provided + logical, intent(in) :: fill_ends ! extrapolate the end values + integer, intent(in) :: npress ! number of dataset pressure levels + real(r8), intent(in) :: press(npress) ! dataset pressure levels + real(r8), intent(in) :: ps ! dataset pressure levels + +! ---------- outputs ---------- + + real(r8), intent(inout) :: outData(:) ! interpolated output data + integer, intent(out) :: STATUS ! return status of netcdf calls + +! ------- locals --------- + + real(r8) surfdat ! surface value to be added before interpolation + integer nlev ! number of levels in dataset + integer latIdx ! latitude index + integer lonIdx ! longitude index + real(r8),allocatable :: tmp(:) + real(r8) closelat,closelon + real(r8) dx, dy, m ! slope for interpolation of surfdat + integer varID + integer var_ndims + integer dims_set + integer i + integer var_dimIDs( NF90_MAX_VAR_DIMS ) + integer start( NF90_MAX_VAR_DIMS ) + integer count( NF90_MAX_VAR_DIMS ) + + character varName*(*) + character dim_name*( 256 ) + real(r8) missing_val + logical usable_var + +! ------- code --------- + + call shr_scam_GetCloseLatLon(ncid,camlat,camlon,closelat,closelon,latidx,lonidx) + +! +! Check mode: double or single precision +! + +! +! Get var ID. Check to make sure it's there. +! + STATUS = NF90_INQ_VARID( NCID, varName, varID ) + + if ( STATUS .NE. NF90_NOERR ) return + +! +! Check the var variable's information with what we are expecting +! it to be. +! + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, ndims=var_ndims ) + if ( var_ndims .GT. 4 ) then + write(iulog,* ) 'ERROR - extractdata.F: The input var',varName, & + 'has', var_ndims, 'dimensions' + STATUS = -1 + endif + +! +! surface variables +! + if ( var_ndims .EQ. 0 ) then + STATUS = NF90_GET_VAR( NCID, varID, outData ) + return + endif + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, dimids=var_dimIDs ) + if ( STATUS .NE. NF90_NOERR ) then + write(iulog,* ) 'ERROR - extractdata.F:Cant get dimension IDs for', varName + return + endif +! +! Initialize the start and count arrays +! + dims_set = 0 + nlev = 1 + do i = var_ndims, 1, -1 + + usable_var = .false. + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), dim_name ) + + if ( dim_name .EQ. 'lat' ) then + start( i ) = latIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( dim_name .EQ. 'lon' ) then + start( i ) = lonIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( dim_name .EQ. 'lev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( dim_name .EQ. 'ilev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( dim_name .EQ. 'time' .OR. dim_name .EQ. 'tsec' ) then + start( i ) = TimeIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( usable_var .EQV. .false. ) then + write(iulog,* )'ERROR - extractdata.F: The input var ',varName, & + ' has an unusable dimension ', dim_name + STATUS = 1 + endif + end do + + if ( dims_set .NE. var_ndims ) then + write(iulog,* )'ERROR - extractdata.F: Could not find all the', & + ' dimensions for input var ', varName + write(iulog,* )'Found ',dims_set, ' of ',var_ndims + STATUS = 1 + endif + + allocate(tmp(nlev+1)) + + STATUS = NF90_GET_VAR( NCID, varID, tmp, start, count ) + + if ( STATUS .NE. NF90_NOERR ) then + write(iulog,* )'ERROR - extractdata.F: Could not get data for input var ', varName + return + endif + + if ( nlev .eq. 1 ) then + outdata(1) = tmp(1) + return ! no need to do interpolation + endif +! if ( use_camiop .and. nlev.eq.plev) then + if ( nlev.eq.plev .or. nlev.eq.plev+1) then + outData(:nlev)= tmp(:nlev)! no need to do interpolation + else +! +! add the surface data if available, else +! fill in missing surface data by extrapolation +! + if(.not.scm_crm_mode) then + if ( have_surfdat ) then + tmp(npress) = surfdat + else + dy = press(npress-1) - press(npress-2) + dx = tmp(npress-1) - tmp(npress-2) + if ( dx .ne. 0.0_r8 ) then + m = dy/dx + tmp(npress) = ((press(npress) - press(npress-1)) / m ) + tmp(npress-1) + else + tmp(npress) = tmp(npress-1) + endif + surfdat = tmp(npress) + endif + endif + +#if DEBUG > 1 +! +! check data for missing values +! + + STATUS = NF90_GET_ATT( NCID, varID, 'missing_value', missing_val ) + if ( STATUS .NE. NF90_NOERR ) then + missing_val = -9999999.0_r8 + endif +! +! reset status to zero +! + STATUS = 0 +! + do i=1, npress + if ( tmp(i) .eq. missing_val ) then + write(iulog,*) 'ERROR - missing value found in ', varname + write(iulog,*) 'time,lat,lon,lev = ' ,timeidx, latidx, lonidx, i + stop + endif + enddo +#endif +! + call interplevs( tmp(:npress), press, npress, ps, fill_ends,outdata ) + + endif + + deallocate(tmp) + return + end subroutine getinterpncdata + +subroutine interplevs( inputdata, dplevs, nlev, & + ps, fill_ends, outdata) + + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use hycoef, only: hyam, hybm + use interpolate_data, only: lininterp + implicit none + +! +! WARNING: ps, siga and sigb must be initialized before calling this routine +! + +!------------------------------Commons---------------------------------- + +!----------------------------------------------------------------------- + + +! ------- inputs ----------- + integer, intent(in) :: nlev ! num press levels in dataset + + real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: inputdata(nlev) ! data from netcdf dataset + real(r8), intent(in) :: dplevs(nlev) ! input data pressure levels + + logical, intent(in) :: fill_ends ! fill in missing end values(used for + ! global model datasets) + + +! ------- outputs ---------- + real(r8), intent(inout) :: outdata(:) ! interpolated column data + +! ------- locals ----------- + + real(r8) mplevs( PLEV ) + real(r8) interpdata( PLEV ) + + + integer dstart_lev, dend_lev + integer mstart_lev, mend_lev + integer data_nlevs, model_nlevs, i + integer STATUS + +! +! Initialize model_pressure_levels. ps should be set in the calling +! routine to the value in the dataset +! + do i = 1, plev + mplevs( i ) = 1000.0_r8 * hyam( i ) + ps * hybm( i ) / 100.0_r8 + end do +! +! the following algorithm assumes that pressures are increasing in the +! arrays +! +! +! Find the data pressure levels that are just outside the range +! of the model pressure levels, and that contain valid values +! + dstart_lev = 1 + do i= 1, nlev + if ( dplevs(i) .LE. mplevs(1) ) dstart_lev = i + end do + + dend_lev = nlev + do i= nlev, 1, -1 + if ( dplevs(i) .GE. mplevs(plev) ) then + dend_lev = i + endif + end do +! +! Find the model pressure levels that are just inside the range +! of the data pressure levels +! + mstart_lev = 1 + do i=plev, 1, -1 + if ( mplevs( i ) .GE. dplevs( dstart_lev ) ) mstart_lev = i + end do + + mend_lev = plev + do i=1,plev + if ( mplevs( i ) .LE. dplevs( dend_lev ) ) mend_lev = i + end do + + data_nlevs = dend_lev - dstart_lev +1 + model_nlevs = mend_lev - mstart_lev +1 + + call lininterp (inputdata(dstart_lev:dend_lev),dplevs(dstart_lev:dend_lev),data_nlevs, & + interpdata,mplevs(mstart_lev:mend_lev),model_nlevs) +! +! interpolate data onto the model pressure levels +! +!!$ call lininterp (inputdata,dplevs,nlev, & +!!$ outdata(:plev),mplevs,plev) + do i=1 , model_nlevs + outdata( i+mstart_lev-1 ) = interpdata( i ) + end do +! +! fill in the missing end values +! (usually done if this is global model dataset) +! + if ( fill_ends ) then + do i=1, mstart_lev + outdata(i) = inputdata(1) + end do + do i= mend_lev, plev + outdata(i) = inputdata(nlev) + end do + end if + + return +end subroutine interplevs +end module getinterpnetcdfdata + diff --git a/src/dynamics/eul/grcalc.F90 b/src/dynamics/eul/grcalc.F90 new file mode 100644 index 0000000000..6219a1c69b --- /dev/null +++ b/src/dynamics/eul/grcalc.F90 @@ -0,0 +1,513 @@ + +subroutine grcalcs (irow ,ztodt ,grts ,grths ,grds ,& + grzs ,grus ,gruhs ,grvs ,grvhs ,& + grpss ,grdpss ,grpms ,grpls ,tmpSPEcoef) +!----------------------------------------------------------------------- +! +! Complete inverse Legendre transforms from spectral to Fourier space at +! the the given latitude. Only positive latitudes are considered and +! symmetric and antisymmetric (about equator) components are computed. +! The sum and difference of these components give the actual fourier +! coefficients for the latitude circle in the northern and southern +! hemispheres respectively. +! +! The naming convention is as follows: +! - The fourier coefficient arrays all begin with "gr"; +! - "t, q, d, z, ps" refer to temperature, specific humidity, +! divergence, vorticity, and surface pressure; +! - "h" refers to the horizontal diffusive tendency for the field. +! - "s" suffix to an array => symmetric component; +! - "a" suffix to an array => antisymmetric component. +! Thus "grts" contains the symmetric Fourier coeffs of temperature and +! "grtha" contains the antisymmetric Fourier coeffs of the temperature +! tendency due to horizontal diffusion. +! Three additional surface pressure related quantities are returned: +! 1. "grdpss" and "grdpsa" contain the surface pressure factor +! (proportional to del^4 ps) used for the partial correction of +! the horizontal diffusion to pressure surfaces. +! 2. "grpms" and "grpma" contain the longitudinal component of the +! surface pressure gradient. +! 3. "grpls" and "grpla" contain the latitudinal component of the +! surface pressure gradient. +! +!---------------------------Code history-------------------------------- +! +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 +! Reviewed: B. Boville, D. Williamson, April 1996 +! Modified: P. Worley, October 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use physconst, only: ez, ra + use eul_control_mod + use spmd_utils, only : iam + implicit none + +! +! Input arguments +! + integer, intent(in) :: irow ! latitude pair index + real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 + real(r8), intent(in) :: tmpSPEcoef(plev*24,pnmax,maxm) ! rearranged variables array +! +! Output arguments: symmetric fourier coefficients +! + real(r8), intent(out) :: grts(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) + real(r8), intent(out) :: grths(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8), intent(out) :: grds(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) + real(r8), intent(out) :: grzs(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) + real(r8), intent(out) :: grus(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: gruhs(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grvs(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grvhs(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grpss(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) + real(r8), intent(out) :: grdpss(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8), intent(out) :: grpms(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) + real(r8), intent(out) :: grpls(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a +! +!---------------------------Local workspace----------------------------- +! + real(r8) dalpn(pspt) ! (a/(n(n+1)))*derivative of Legendre functions (complex) + real(r8) zurcor ! conversion term relating abs. & rel. vort. + real(r8) tmpGRcoef(plev*24,maxm) ! temporal storage for Fourier coeffs + + integer k ! level index + integer lm, m ! local and global Fourier wavenumber indices of spectral array + integer mlength ! number of local wavenumbers + integer n ! meridional wavenumber index + integer ir,ii ! spectral indices + integer lmr,lmc ! spectral indices + integer lmwave0 ! local index for wavenumber 0 + integer lmrwave0 ! local offset for wavenumber 0 + integer kv ! level x variable index +! +!----------------------------------------------------------------------- +! +! Compute alpn and dalpn +! + lmwave0 = -1 + lmrwave0 = 0 + dalpn(2) = 0.0_r8 + mlength = numm(iam) + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + if (m .eq. 1) then + lmwave0 = lm + lmrwave0 = lmr + endif + do n=1,nlen(m) + dalpn(lmr+n) = ldalp(lmr+n,irow)*rsq(m+n-1)*ra + end do + end do + zurcor = ez*dalpn(lmrwave0 + 2) +! +! Initialize sums +! + grpss (:) = 0._r8 + grpls (:) = 0._r8 + grpms (:) = 0._r8 + grdpss(:) = 0._r8 + tmpGRcoef (:,:) = 0._r8 +! +! Loop over n for t,q,d,and end of u and v +! + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + do n=2,nlen(m),2 + do kv=1,plev*8 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*dalpn(lmr+n) + end do + end do + end do +! + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + do n=1,nlen(m),2 + do kv=plev*8+1,plev*24 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*lalp(lmr+n,irow) + end do + end do + end do +! +! Combine the two parts of u(m) and v(m) +! + do lm=1,mlength + do kv=1,plev*8 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpGRcoef(kv+plev*16,lm) + end do + end do +! +! Save accumulated results to gr* arrays +! + do lm=1,mlength + do k=1,plev + grus (2*lm-1,k) = tmpGRcoef(k ,lm) + grus (2*lm ,k) = tmpGRcoef(k+plev ,lm) + grvs (2*lm-1,k) = tmpGRcoef(k+plev*2 ,lm) + grvs (2*lm ,k) = tmpGRcoef(k+plev*3 ,lm) + gruhs(2*lm-1,k) = tmpGRcoef(k+plev*4 ,lm) + gruhs(2*lm ,k) = tmpGRcoef(k+plev*5 ,lm) + grvhs(2*lm-1,k) = tmpGRcoef(k+plev*6 ,lm) + grvhs(2*lm ,k) = tmpGRcoef(k+plev*7 ,lm) + + grts (2*lm-1,k) = tmpGRcoef(k+plev*8 ,lm) + grts (2*lm ,k) = tmpGRcoef(k+plev*9 ,lm) + grths(2*lm-1,k) = tmpGRcoef(k+plev*10,lm) + grths(2*lm ,k) = tmpGRcoef(k+plev*11,lm) + grds (2*lm-1,k) = tmpGRcoef(k+plev*12,lm) + grds (2*lm ,k) = tmpGRcoef(k+plev*13,lm) + grzs (2*lm-1,k) = tmpGRcoef(k+plev*14,lm) + grzs (2*lm ,k) = tmpGRcoef(k+plev*15,lm) + end do + end do +! +! Remove Coriolis contribution to absolute vorticity from u(m) +! Correction for u:zeta=vz-ez=(zeta+f)-f +! + if (lmwave0 .ne. -1) then + do k=1,plev +! grus(1,k) = grus(1,k) - zurcor + grus(2*lmwave0-1,k) = grus(2*lmwave0-1,k) - zurcor + end do + endif +! +!----------------------------------------------------------------------- +! +! Computation for 1-level variables (ln(p*) and derivatives). +! + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=1,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 +! + grpss (2*lm-1) = grpss (2*lm-1) + alps(ir)*lalp(lmr+n,irow) + grpss (2*lm ) = grpss (2*lm ) + alps(ii)*lalp(lmr+n,irow) +! + grdpss(2*lm-1) = grdpss(2*lm-1) + alps(ir)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt + grdpss(2*lm ) = grdpss(2*lm ) + alps(ii)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt + end do + end do + + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=2,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 +! + grpms(2*lm-1) = grpms(2*lm-1) + alps(ir)*ldalp(lmr+n,irow)*ra + grpms(2*lm ) = grpms(2*lm ) + alps(ii)*ldalp(lmr+n,irow)*ra + end do +! +! Multiply by m/a to get d(ln(p*))/dlamda +! and by 1/a to get (1-mu**2)d(ln(p*))/dmu +! + grpls(2*lm-1) = -grpss(2*lm )*ra*xm(m) + grpls(2*lm ) = grpss(2*lm-1)*ra*xm(m) + end do +! + return +end subroutine grcalcs + +subroutine grcalca (irow ,ztodt ,grta ,grtha ,grda ,& + grza ,grua ,gruha ,grva ,grvha ,& + grpsa ,grdpsa ,grpma ,grpla ,tmpSPEcoef) + +!----------------------------------------------------------------------- +! +! Complete inverse Legendre transforms from spectral to Fourier space at +! the the given latitude. Only positive latitudes are considered and +! symmetric and antisymmetric (about equator) components are computed. +! The sum and difference of these components give the actual fourier +! coefficients for the latitude circle in the northern and southern +! hemispheres respectively. +! +! The naming convention is as follows: +! - The fourier coefficient arrays all begin with "gr"; +! - "t, q, d, z, ps" refer to temperature, specific humidity, +! divergence, vorticity, and surface pressure; +! - "h" refers to the horizontal diffusive tendency for the field. +! - "s" suffix to an array => symmetric component; +! - "a" suffix to an array => antisymmetric component. +! Thus "grts" contains the symmetric Fourier coeffs of temperature and +! "grtha" contains the antisymmetric Fourier coeffs of the temperature +! tendency due to horizontal diffusion. +! Three additional surface pressure related quantities are returned: +! 1. "grdpss" and "grdpsa" contain the surface pressure factor +! (proportional to del^4 ps) used for the partial correction of +! the horizontal diffusion to pressure surfaces. +! 2. "grpms" and "grpma" contain the longitudinal component of the +! surface pressure gradient. +! 3. "grpls" and "grpla" contain the latitudinal component of the +! surface pressure gradient. +! +!---------------------------Code history-------------------------------- +! +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 +! Reviewed: B. Boville, D. Williamson, April 1996 +! Modified: P. Worley, October 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use physconst, only: ra + use eul_control_mod + use spmd_utils, only : iam + implicit none + +! +! Input arguments +! + integer, intent(in) :: irow ! latitude pair index + real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 + real(r8), intent(in) :: tmpSPEcoef(plev*24,pnmax,maxm) ! array for rearranged variables +! +! +! Output arguments: antisymmetric fourier coefficients +! + real(r8), intent(out) :: grta(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) + real(r8), intent(out) :: grtha(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8), intent(out) :: grda(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) + real(r8), intent(out) :: grza(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) + real(r8), intent(out) :: grua(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: gruha(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grva(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grvha(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(out) :: grpsa(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) + real(r8), intent(out) :: grdpsa(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8), intent(out) :: grpma(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) + real(r8), intent(out) :: grpla(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a +! +!---------------------------Local workspace----------------------------- +! + real(r8) dalpn(pspt) ! (a/(n(n+1)))*derivative of Legendre functions (complex) + real(r8) tmpGRcoef(plev*24,maxm) ! temporal storage for Fourier coefficients + + integer k ! level index + integer lm, m ! local and global Fourier wavenumber indices of spectral array + integer mlength ! number of local wavenumbers + integer n ! meridional wavenumber index + integer ir,ii ! spectral indices + integer lmr,lmc ! spectral indices + integer kv ! level x variable index +! +!----------------------------------------------------------------------- +! +! Compute alpn and dalpn +! + mlength = numm(iam) + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + do n=1,nlen(m) + dalpn(lmr+n) = ldalp(lmr+n,irow)*rsq(m+n-1)*ra + end do + end do +! +! Initialize sums +! + grpsa (:) = 0._r8 + grpla (:) = 0._r8 + grpma (:) = 0._r8 + grdpsa(:) = 0._r8 + tmpGRcoef(:,:) = 0._r8 +! +! Loop over n for t,q,d,and end of u and v +! + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + do n=1,nlen(m),2 + do kv=1,plev*8 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*dalpn(lmr+n) + end do + end do + end do + + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + do n=2,nlen(m),2 + do kv=plev*8+1,plev*24 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*lalp(lmr+n,irow) + end do + end do + end do +! +! Combine the two parts of u(m) and v(m) +! + do lm=1,mlength + do kv=1,plev*8 + tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpGRcoef(kv+plev*16,lm) + end do + end do +! +! Save accumulated results to gr* arrays +! + do lm=1,mlength + do k=1,plev + grua (2*lm-1,k) = tmpGRcoef(k ,lm) + grua (2*lm ,k) = tmpGRcoef(k+plev ,lm) + grva (2*lm-1,k) = tmpGRcoef(k+plev*2 ,lm) + grva (2*lm ,k) = tmpGRcoef(k+plev*3 ,lm) + gruha(2*lm-1,k) = tmpGRcoef(k+plev*4 ,lm) + gruha(2*lm ,k) = tmpGRcoef(k+plev*5 ,lm) + grvha(2*lm-1,k) = tmpGRcoef(k+plev*6 ,lm) + grvha(2*lm ,k) = tmpGRcoef(k+plev*7 ,lm) + + grta (2*lm-1,k) = tmpGRcoef(k+plev*8 ,lm) + grta (2*lm ,k) = tmpGRcoef(k+plev*9 ,lm) + grtha(2*lm-1,k) = tmpGRcoef(k+plev*10,lm) + grtha(2*lm ,k) = tmpGRcoef(k+plev*11,lm) + grda (2*lm-1,k) = tmpGRcoef(k+plev*12,lm) + grda (2*lm ,k) = tmpGRcoef(k+plev*13,lm) + grza (2*lm-1,k) = tmpGRcoef(k+plev*14,lm) + grza (2*lm ,k) = tmpGRcoef(k+plev*15,lm) + end do + end do +! +!----------------------------------------------------------------------- +! +! Computation for 1-level variables (ln(p*) and derivatives). +! + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=1,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 + + grpma(2*lm-1) = grpma(2*lm-1) + alps(ir)*ldalp(lmr+n,irow)*ra + grpma(2*lm ) = grpma(2*lm ) + alps(ii)*ldalp(lmr+n,irow)*ra + end do + end do + + do lm=1,mlength + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=2,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 +! + grpsa (2*lm-1) = grpsa (2*lm-1) + alps(ir)*lalp(lmr+n,irow) + grpsa (2*lm ) = grpsa (2*lm ) + alps(ii)*lalp(lmr+n,irow) +! + grdpsa(2*lm-1) = grdpsa(2*lm-1) + alps(ir)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt + grdpsa(2*lm ) = grdpsa(2*lm ) + alps(ii)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt + end do +! +! Multiply by m/a to get d(ln(p*))/dlamda +! and by 1/a to get (1-mu**2)d(ln(p*))/dmu +! + grpla(2*lm-1) = -grpsa(2*lm )*ra*xm(m) + grpla(2*lm ) = grpsa(2*lm-1)*ra*xm(m) + end do +! + return +end subroutine grcalca + +subroutine prepGRcalc(tmpSPEcoef) + +!----------------------------------------------------------------------- +! +! Rearrange multi-level spectral coefficients for vectorization. +! The results are saved to "tmpSPEcoef" and will be used in +! "grcalcs" and "grcalca". +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use physconst, only: ra + use eul_control_mod, only: hdiftq, hdifzd + use spmd_utils, only : iam +! + implicit none +! +! +!---------------------------Output argument----------------------------- +! + real(r8), intent(out) :: tmpSPEcoef(plev*24,pnmax,maxm) ! array for rearranged variables +! +!---------------------------Local workspace----------------------------- +! + real(r8) raxm +! + integer lm, m, n, k + integer lmr, lmc + integer ir ,ii +! +!----------------------------------------------------------------------- +! + do lm=1,numm(iam) + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + raxm = ra*xm(m) + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + do k=1,plev + tmpSPEcoef(k ,n,lm) = vz(ir,k) + tmpSPEcoef(k+plev ,n,lm) = vz(ii,k) + tmpSPEcoef(k+plev*2 ,n,lm) = -d(ir,k) + tmpSPEcoef(k+plev*3 ,n,lm) = -d(ii,k) + tmpSPEcoef(k+plev*4 ,n,lm) = -vz(ir,k)*hdifzd(n+m-1,k) + tmpSPEcoef(k+plev*5 ,n,lm) = -vz(ii,k)*hdifzd(n+m-1,k) + tmpSPEcoef(k+plev*6 ,n,lm) = d(ir,k)*hdifzd(n+m-1,k) + tmpSPEcoef(k+plev*7 ,n,lm) = d(ii,k)*hdifzd(n+m-1,k) + + tmpSPEcoef(k+plev*8 ,n,lm) = t(ir,k) + tmpSPEcoef(k+plev*9 ,n,lm) = t(ii,k) + tmpSPEcoef(k+plev*10,n,lm) = -t(ir,k)*hdiftq(n+m-1,k) + tmpSPEcoef(k+plev*11,n,lm) = -t(ii,k)*hdiftq(n+m-1,k) + tmpSPEcoef(k+plev*12,n,lm) = d(ir,k) + tmpSPEcoef(k+plev*13,n,lm) = d(ii,k) + tmpSPEcoef(k+plev*14,n,lm) = vz(ir,k) + tmpSPEcoef(k+plev*15,n,lm) = vz(ii,k) + + tmpSPEcoef(k+plev*16,n,lm) = d (ii,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*17,n,lm) = -d (ir,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*18,n,lm) = vz(ii,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*19,n,lm) = -vz(ir,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*20,n,lm) = -d (ii,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*21,n,lm) = d (ir,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*22,n,lm) = -vz(ii,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm + tmpSPEcoef(k+plev*23,n,lm) = vz(ir,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm + end do + end do + end do +! + return +end subroutine prepGRcalc diff --git a/src/dynamics/eul/grmult.F90 b/src/dynamics/eul/grmult.F90 new file mode 100644 index 0000000000..11f8136bd5 --- /dev/null +++ b/src/dynamics/eul/grmult.F90 @@ -0,0 +1,322 @@ + +subroutine grmult(rcoslat ,d ,qm1 ,tm1 ,um1 ,& + vm1 ,z ,tm2 ,phis ,dpsl ,& + dpsm ,omga ,pdel ,pbot ,logpsm2 ,& + logpsm1 ,rpmid ,rpdel ,fu ,fv ,& + t2 ,ut ,vt ,drhs ,pmid ,& + etadot ,etamid ,engy ,ddpn ,vpdsn ,& + dpslon ,dpslat ,vat ,ktoop ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Non-linear dynamics calculations in grid point space +! +! Method: +! +! Author: +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 +! Reviewed: B. Boville, D. Williamson, April 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, plevp, plon + use pspect + use commap + use physconst, only: rair, cappa, cpvir, zvir + use hycoef, only : hybi, hybm, hybd, nprlev + + implicit none + +! +! Input arguments +! + real(r8), intent(in) :: rcoslat ! 1./cosine(latitude) + real(r8), intent(in) :: d(plon,plev) ! divergence + real(r8), intent(in) :: qm1(plon,plev) ! specific humidity + real(r8), intent(in) :: tm1(plon,plev) ! temperature + real(r8), intent(in) :: um1(plon,plev) ! zonal wind * cos(lat) + real(r8), intent(in) :: vm1(plon,plev) ! meridional wind * cos(lat) + real(r8), intent(in) :: z(plon,plev) ! vorticity + real(r8), intent(in) :: phis(plon) ! surface geopotential + real(r8), intent(in) :: dpsl(plon) ! longitudinal component of grad ln(ps) + real(r8), intent(in) :: dpsm(plon) ! latitudinal component of grad ln(ps) + real(r8), intent(in) :: omga(plon,plev) ! vertical pressure velocity + real(r8), intent(in) :: pdel(plon,plev) ! layer thicknesses (pressure) + real(r8), intent(in) :: pbot(plon) ! bottom interface pressure + real(r8), intent(in) :: logpsm2(plon) ! log(psm2) + real(r8), intent(in) :: logpsm1(plon) ! log(ps) + real(r8), intent(in) :: rpmid(plon,plev) ! 1./pmid + real(r8), intent(in) :: rpdel(plon,plev) ! 1./pdel + real(r8), intent(in) :: tm2(plon,plev) ! temperature at previous time step + integer, intent(in) :: nlon +! +! Input/Output arguments +! + real(r8), intent(inout) :: fu(plon,plev) ! nonlinear term - u momentum eqn + real(r8), intent(inout) :: fv(plon,plev) ! nonlinear term - v momentum eqn + real(r8), intent(inout) :: t2(plon,plev) ! nonlinear term - temperature + real(r8), intent(inout) :: ut(plon,plev) ! (u*TM1) - heat flux - zonal + real(r8), intent(inout) :: vt(plon,plev) ! (u*TM1) - heat flux - meridional + real(r8), intent(inout) :: drhs(plon,plev) ! RHS of divergence eqn (del^2 term) + real(r8), intent(inout) :: pmid(plon,plev) ! pressure at full levels + real(r8), intent(inout) :: etadot(plon,plevp) ! vertical velocity in eta coordinates + real(r8), intent(in) :: etamid(plev) ! midpoint values of eta (a+b) + real(r8), intent(inout) :: engy(plon,plev) ! kinetic energy +! +! Output arguments +! + real(r8), intent(out) :: ddpn(plon) ! complete sum of d*delta p + real(r8), intent(out) :: vpdsn(plon) ! complete sum V dot grad(ln(ps)) delta b + real(r8), intent(out) :: dpslat(plon,plev) ! ln(ps) component of lon press gradient + real(r8), intent(out) :: dpslon(plon,plev) ! ln(ps) component of lat press gradient + real(r8), intent(out) :: vat (plon,plev) ! Vertical advection of temperature + real(r8), intent(out) :: ktoop (plon,plev) ! (Kappa*T)*(omega/P) + +! +!---------------------------Local workspace----------------------------- +! + real(r8) tv(plon,plev) ! virtual temperature + real(r8) ddpk(plon) ! partial sum of d*delta p + real(r8) vkdp ! V dot grad(ln(ps)) + real(r8) vpdsk(plon) ! partial sum V dot grad(ln(ps)) delta b + real(r8) tk0(plon) ! tm1 at phony level 0 + real(r8) uk0(plon) ! u at phony level 0 + real(r8) vk0(plon) ! v at phone level 0 + real(r8) rtv(plon,plev) ! rair*tv + real(r8) pterm(plon,plev) ! intermediate term for hydrostatic eqn + real(r8) tterm(plon,plev) ! intermediate term for hydrostatic eqn + real(r8) tmp ! temporary workspace + real(r8) tmpk ! temporary workspace + real(r8) tmpkp1 ! temporary workspace + real(r8) edotdpde(plon,plevp) ! etadot*dp/deta + real(r8) udel(plon,0:plev-1) ! vertical u difference + real(r8) vdel(plon,0:plev-1) ! vertical v difference + real(r8) tdel(plon,0:plev-1) ! vertical TM1 difference + + integer i,k,kk ! longitude, level indices +! +! Initialize arrays which represent vertical sums (ddpk, ddpn, vpdsk, +! vpdsn). Set upper boundary condition arrays (k=0: tk0, uk0, vk0). +! + ddpk = 0.0_r8 + ddpn = 0.0_r8 + vpdsk = 0.0_r8 + vpdsn = 0.0_r8 + tk0 = 0.0_r8 + uk0 = 0.0_r8 + vk0 = 0.0_r8 +! +! Virtual temperature +! +tv(:nlon,:) = tm1(:nlon,:) * (1.0_r8 + zvir * qm1(:nlon,:)) + +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + rtv(i,k) = rair*tv(i,k) + end do + end do +! +!$OMP PARALLEL DO PRIVATE (I, K, VKDP) + do i=1,nlon +! +! sum(plev)(d(k)*dp(k)) +! + do k=1,plev + ddpn(i) = ddpn(i) + d(i,k)*pdel(i,k) + end do +! +! sum(plev)(v(k)*grad(lnps)*db(k)) +! + do k=nprlev,plev + vkdp = rcoslat*(um1(i,k)*dpsl(i) + vm1(i,k)*dpsm(i))*pbot(i) + vpdsn(i) = vpdsn(i) + vkdp*hybd(k) + end do +! +! Compute etadot (dp/deta) (k+1/2). Note: sum(k)(d(j)*dp(j)) required in +! pressure region. sum(k)(d(j)*dp(j)) and sum(k)(v(j)*grad(ps)*db(j)) +! required in hybrid region +! + edotdpde(i,1) = 0._r8 + do k=1,nprlev-1 + ddpk(i) = ddpk(i) + d(i,k)*pdel(i,k) + edotdpde(i,k+1) = -ddpk(i) + end do +! + do k=nprlev,plev-1 + ddpk(i) = ddpk(i) + d(i,k)*pdel(i,k) + vkdp = rcoslat*(um1(i,k)*dpsl(i) + vm1(i,k)*dpsm(i))*pbot(i) + vpdsk(i) = vpdsk(i) + vkdp*hybd(k) + edotdpde(i,k+1) = -ddpk(i) - vpdsk(i) + hybi(k+1)*(ddpn(i)+vpdsn(i)) + end do + edotdpde(i,plevp) = 0._r8 +! +! + end do + +! +! Nonlinear advection terms. u*tm1, v*tm1, kinetic energy first +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + ut(i,k) = um1(i,k)*tm1(i,k) + vt(i,k) = vm1(i,k)*tm1(i,k) + engy(i,k) = 0.5_r8*(um1(i,k)**2 + vm1(i,k)**2) + end do + end do +! +! Compute workspace arrays for delta-u, delta-v, delta-tm1 (k) +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=0,plev-1 + if (k == 0) then + do i=1,nlon + udel(i,0) = um1(i,1) - uk0(i) + vdel(i,0) = vm1(i,1) - vk0(i) + tdel(i,0) = tm1(i,1) - tk0(i) + end do + else + do i=1,nlon + udel(i,k) = um1(i,k+1) - um1(i,k) + vdel(i,k) = vm1(i,k+1) - vm1(i,k) + tdel(i,k) = tm1(i,k+1) - tm1(i,k) + end do + endif + end do +! +!$OMP PARALLEL DO PRIVATE (K, I, TMPK, TMPKP1, TMP) + do k=1,plev +! + if (k < nprlev) then +! +! Horizontal advection: u*z, v*z, energy conversion term (omega/p), +! vertical advection for interface above. Pure pressure region first. +! + do i=1,nlon + dpslat(i,k) = 0._r8 + dpslon(i,k) = 0._r8 + tmpk = 0.5_r8*rpdel(i,k)*edotdpde(i,k ) + tmpkp1 = 0.5_r8*rpdel(i,k)*edotdpde(i,k+1) + fu(i,k) = fu(i,k) + vm1(i,k)*z(i,k) - udel(i,k-1)*tmpk - udel(i,k )*tmpkp1 + fv(i,k) = fv(i,k) - um1(i,k)*z(i,k) - vdel(i,k-1)*tmpk - vdel(i,k )*tmpkp1 + vat (i,k) = - (tdel(i,k-1)*tmpk + tdel(i,k)*tmpkp1) + ktoop(i,k) = cappa*tv(i,k)/(1._r8 + cpvir*qm1(i,k))* & + omga(i,k)*rpmid(i,k) + t2 (i,k) = t2(i,k) + d(i,k)*tm1(i,k) - tdel(i,k-1)*tmpk + & + ktoop(i,k) - tdel(i,k)*tmpkp1 + end do +! + else if (k < plev) then +! +! Hybrid region above bottom level: Computations are the same as in pure +! pressure region, except that pressure gradient terms are added to +! momentum tendencies. +! + do i=1,nlon + tmpk = 0.5_r8*rpdel(i,k)*edotdpde(i,k ) + tmpkp1 = 0.5_r8*rpdel(i,k)*edotdpde(i,k+1) + tmp = rtv(i,k)*hybm(k)*rpmid(i,k)*pbot(i) + dpslon(i,k) = rcoslat*tmp*dpsl(i) + dpslat(i,k) = rcoslat*tmp*dpsm(i) + fu(i,k) = fu(i,k) + vm1(i,k)*z(i,k) - udel(i,k-1)*tmpk - & + udel(i,k )*tmpkp1 - dpslon(i,k) + fv(i,k) = fv(i,k) - um1(i,k)*z(i,k) - vdel(i,k-1)*tmpk - & + vdel(i,k )*tmpkp1 - dpslat(i,k) + vat (i,k) = - (tdel(i,k-1)*tmpk + tdel(i,k)*tmpkp1) + ktoop(i,k) = cappa*tv(i,k)/(1._r8 + cpvir*qm1(i,k))* & + omga(i,k)*rpmid(i,k) + t2 (i,k) = t2(i,k) + d(i,k)*tm1(i,k) - tdel(i,k-1)*tmpk + & + ktoop(i,k) - tdel(i,k)*tmpkp1 + end do +! + else +! +! Bottom level +! + do i=1,nlon + tmpk = 0.5_r8*rpdel(i,plev)*edotdpde(i,plev ) + tmp = rtv(i,plev)*hybm(plev)*rpmid(i,plev)*pbot(i) + dpslon(i,plev) = rcoslat*tmp*dpsl(i) + dpslat(i,plev) = rcoslat*tmp*dpsm(i) + fu(i,plev) = fu(i,plev) + vm1(i,plev)*z(i,plev) - & + udel(i,plev-1)*tmpk - dpslon(i,plev) + fv(i,plev) = fv(i,plev) - um1(i,plev)*z(i,plev) - & + vdel(i,plev-1)*tmpk - dpslat(i,plev) + vat (i,plev) = -(tdel(i,plev-1)*tmpk) + ktoop(i,plev) = cappa*tv(i,plev)/(1._r8 + cpvir*qm1(i,plev))* & + omga(i,plev)*rpmid(i,plev) + t2 (i,plev) = t2(i,plev) + d(i,plev)*tm1(i,plev) - & + tdel(i,plev-1)*tmpk + ktoop(i,plev) + end do +! + end if +! + enddo +! +! Convert eta-dot(dp/deta) to eta-dot (top and bottom = 0.) +! + etadot(:,1) = 0._r8 + etadot(:,plevp) = 0._r8 +!$OMP PARALLEL DO PRIVATE (K, TMP, I) + do k=2,plev + tmp = etamid(k) - etamid(k-1) + do i=1,nlon + etadot(i,k) = edotdpde(i,k)*tmp/(pmid(i,k) - pmid(i,k-1)) + end do + end do +! +!----------------------------------------------------------------------- +! +! Divergence and hydrostatic equations +! +! Del squared part of RHS of divergence equation. +! Kinetic energy and diagonal term of hydrostatic equation. +! Total temperature as opposed to perturbation temperature is acceptable +! since del-square operator will operate on this term. +! (Also store some temporary terms.) +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + tterm(i,k) = 0.5_r8*tm2(i,k) - tm1(i,k) + pterm(i,k) = rtv(i,k)*rpmid(i,k)*pdel(i,k) + drhs(i,k) = phis(i) + engy(i,k) + rtv(i,k)*0.5_r8* & + rpmid(i,k)*pdel(i,k) + href(k,k)*tterm(i,k) + & + bps(k)*(0.5_r8*logpsm2(i) - logpsm1(i)) + end do + end do + +! +! Bottom level term of hydrostatic equation +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev-1 + do i=1,nlon + drhs(i,k) = drhs(i,k) + rtv(i,plev)* & + rpmid(i,plev)*pdel(i,plev) + & + href(plev,k)*tterm(i,plev) + end do + end do +! +! Interior terms of hydrostatic equation +! +!$OMP PARALLEL DO PRIVATE (K, KK, I) + do k=1,plev-2 + do kk=k+1,plev-1 + do i=1,nlon + drhs(i,k) = drhs(i,k) + pterm(i,kk) + href(kk,k)*tterm(i,kk) + end do + end do + end do +! + return +end subroutine grmult diff --git a/src/dynamics/eul/hdinti.F90 b/src/dynamics/eul/hdinti.F90 new file mode 100644 index 0000000000..67a4110fa4 --- /dev/null +++ b/src/dynamics/eul/hdinti.F90 @@ -0,0 +1,80 @@ + +subroutine hdinti(rearth, deltat) + +!----------------------------------------------------------------------- +! +! Purpose: +! Time independent initialization for the horizontal diffusion. +! +! Method: +! +! Author: +! Original version: D. Williamson +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Reviewed: B. Boville, April 1996 +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_abortutils, only: endrun + use pmgrid + use pspect + use eul_control_mod + use cam_logfile, only: iulog + implicit none + +!------------------------------Arguments-------------------------------- + + real(r8), intent(in) :: rearth ! radius of the earth + real(r8), intent(in) :: deltat ! time step + +!---------------------------Local workspace----------------------------- + + integer :: k ! level index + integer :: n ! n-wavenumber index + integer :: iexpon + real(r8) :: fn +! +!----------------------------------------------------------------------- +! +! Initialize physical constants for courant number based spect truncation +! + nmaxhd = ptrk + cnlim = 0.999_r8 ! maximum allowable Courant number + cnfac = deltat*real(nmaxhd,r8)/rearth +! +! Initialize arrays used for courant number based spectral truncation +! + do k=1,plev + nindex(k) = 2*nmaxhd + end do +! +! Set the Del^2 and Del^N diffusion coefficients for each wavenumber +! + hdfst2(1) = 0._r8 + hdfsd2(1) = 0._r8 +! + hdfstn(1) = 0._r8 + hdfsdn(1) = 0._r8 + + iexpon = hdif_order/2 + + do n=2,pnmax + + hdfst2(n) = dif2 * (n*(n-1) ) / rearth**2 + hdfsd2(n) = dif2 * (n*(n-1)-2) / rearth**2 + + fn = n*(n-1) + fn = fn/rearth**2 + fn = fn**iexpon + + hdfstn(n) = hdif_coef * fn + fn = 2._r8/rearth**2 + hdfsdn(n) = hdfstn(n) - hdif_coef * fn**iexpon + + end do +! + return +end subroutine hdinti + diff --git a/src/dynamics/eul/herxin.F90 b/src/dynamics/eul/herxin.F90 new file mode 100644 index 0000000000..afed4de04f --- /dev/null +++ b/src/dynamics/eul/herxin.F90 @@ -0,0 +1,143 @@ + +subroutine herxin(pf ,pkcnst ,fb ,fxl ,fxr , & + x ,xdp ,idp ,jdp ,fint , & + nlon ,nlonex ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! For each departure point in the latitude slice being forecast, +! interpolate (using equally spaced Hermite cubic formulas) to its +! x value at each latitude required for later interpolation in the y +! direction. +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use scanslt, only: plond, beglatex, endlatex, platd, nxpt + use cam_abortutils, only: endrun +!----------------------------------------------------------------------- + implicit none +!------------------------------Parameters------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! dimension (number of fields) + integer, intent(in) :: pkcnst ! dimension,=p3d +! + real(r8), intent(in) :: fb (plond,plev,pkcnst,beglatex:endlatex) ! field + real(r8), intent(in) :: fxl(plond,plev,pf,beglatex:endlatex) ! left x derivative + real(r8), intent(in) :: fxr(plond,plev,pf,beglatex:endlatex) ! right x derivative + real(r8), intent(in) :: x(plond,platd) ! longitudinal grid coordinates + real(r8), intent(in) :: xdp(plon,plev) ! departure point coordinates +! + integer, intent(in) :: idp(plon,plev,4) ! longitude index of dep pt. + integer, intent(in) :: jdp(plon,plev) ! latitude index of dep pt. + integer, intent(in) :: nlon + integer, intent(in) :: nlonex(platd) +! +! Output arguments +! + real(r8), intent(out) :: fint(plon,plev,ppdy,pf) ! x-interpolants +! +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! pkcnst Dimensioning construct for 3-D arrays. +! fb extended array of data to be interpolated. +! fxl x derivatives at the left edge of each interval containing +! the departure point +! fxr x derivatives at the right edge of each interval containing +! the departure point +! x Equally spaced x grid values in extended arrays. +! xdp xdp(i,k) is the x-coordinate (extended grid) of the +! departure point that corresponds to global grid point (i,k) +! in the latitude slice being forecasted. +! idp idp(i,k) is the index of the x-interval (extended grid) that +! contains the departure point corresponding to global grid +! point (i,k) in the latitude slice being forecasted. +! Note that +! x(idp(i,k)) .le. xdp(i,k) .lt. x(idp(i,k)+1) . +! jdp jdp(i,k) is the index of the y-interval (extended grid) that +! contains the departure point corresponding to global grid +! point (i,k) in the latitude slice being forecasted. +! Suppose yb contains the y-coordinates of the extended array +! and ydp(i,k) is the y-coordinate of the departure point +! corresponding to grid point (i,k). Then, +! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . +! fint (fint(i,k,j,n),j=1,ppdy) contains the x interpolants at each +! latitude needed for the y derivative estimates at the +! endpoints of the interval that contains the departure point +! for grid point (i,k). The last index of fint allows for +! interpolation of multiple fields. +! +!---------------------------Local workspace----------------------------- +! + integer i,j,k,m ! indices +! + real(r8) dx (platd) ! x-increment + real(r8) rdx(platd) ! 1./dx + real(r8) xl ! | + real(r8) xr ! | + real(r8) hl (plon,plev) ! | --interpolation coeffs + real(r8) hr (plon,plev) ! | + real(r8) dhl(plon,plev) ! | + real(r8) dhr(plon,plev) ! | + + integer n + +! +!----------------------------------------------------------------------- +! + if(ppdy .ne. 4) then + call endrun ('HERXIN:Fatal error: ppdy must be set to 4') + end if + + dx (1) = x(nxpt+2,1) - x(nxpt+1,1) + rdx(1) = 1._r8/dx(1) +!$OMP PARALLEL DO PRIVATE (K, I, XL, XR) + do k=1,plev + do i=1,nlon + xl = ( x(idp(i,k,1)+1,1) - xdp(i,k) )*rdx(1) + xr = 1._r8 - xl + hl (i,k) = ( 3.0_r8 - 2.0_r8*xl)*xl**2 + hr (i,k) = ( 3.0_r8 - 2.0_r8*xr )*xr**2 + dhl(i,k) = -dx(1)*( xl - 1._r8 )*xl**2 + dhr(i,k) = dx(1)*( xr - 1._r8 )*xr**2 + end do + end do + + ! x interpolation at each latitude needed for y interpolation. + ! Once for each field. + + do m = 1,pf +!$OMP PARALLEL DO PRIVATE (N, K, I) + do n=1,4 + do k = 1,plev + do i = 1,nlon + fint(i,k,n,m) = & + fb (idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*hl (i,k) + & + fb (idp(i,k,1)+1,k,m,jdp(i,k)+(n-2))*hr (i,k) + & + fxl(idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*dhl(i,k) + & + fxr(idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*dhr(i,k) + enddo + enddo + enddo + enddo + +end subroutine herxin diff --git a/src/dynamics/eul/heryin.F90 b/src/dynamics/eul/heryin.F90 new file mode 100644 index 0000000000..69a378ed88 --- /dev/null +++ b/src/dynamics/eul/heryin.F90 @@ -0,0 +1,129 @@ + +subroutine heryin(pf ,fint ,fyb ,fyt ,y , & + dy ,ydp ,jdp ,fdp ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! For each departure point in the latitude slice to be forecast, +! interpolate (using unequally spaced Hermite cubic formulas) the +! x interpolants to the y value of the departure point. +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: platd +!----------------------------------------------------------------------- + implicit none +!------------------------------Parameters------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! dimension (number of fields) +! + real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants + real(r8), intent(in) :: fyb (plon,plev,pf) ! y-derivatives at bottom of interval + real(r8), intent(in) :: fyt (plon,plev,pf) ! y-derivatives at top of interval + real(r8), intent(in) :: y (platd) ! latitude grid coordinates + real(r8), intent(in) :: dy (platd) ! intervals between latitude grid pts. + real(r8), intent(in) :: ydp (plon,plev) ! lat. coord of departure point. +! + integer, intent(in) :: jdp (plon,plev) ! lat. index of departure point. + integer, intent(in) :: nlon +! +! Output arguments +! + real(r8), intent(out) :: fdp (plon,plev,pf) ! y-interpolants + +! +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! fint (fint(i,k,j,m),j=ppdy/2,ppdy/2 + 1) contains the x +! interpolants at the endpoints of the y-interval that +! contains the departure point for grid point (i,k). The last +! index of fint allows for interpolation of multiple fields. +! fint is generated by a call to herxin. +! fyb fyb(i,k,.) is the derivative at the "bottom" of the +! y-interval that contains the departure point of grid +! point (i,k). fyb is generated by a call to cubydr. +! fyt fyt(i,k,.) is the derivative at the "top" of the y-interval +! that contains the departure point of grid point (i,k). +! fyt is generated by a call to cubydr. +! y y-coordinate (latitude) values in the extended array. +! dy Increment in the y-coordinate value for each interval in the +! extended array. +! ydp ydp(i,k) is the y-coordinate of the departure point that +! corresponds to global grid point (i,k) in the latitude slice +! being forecasted. +! jdp jdp(i,k) is the index of the y-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Note that +! y(jdp(i,k)) .le. ydp(i,k) .lt. y(jdp(i,k)+1) . +! fdp Horizontally interpolated field values at the departure point +! for the latitude slice being forecasted. +! +!---------------------------Local variables----------------------------- +! + integer i,k ! index + integer jb ! index corresponding to bot of interval + integer jt ! index corresponding to top of interval + integer m ! index +! + real(r8) dyj(plon,plev) ! latitude interval containing dep. pt. + real(r8) yb (plon,plev) ! | + real(r8) yt (plon,plev) ! | + real(r8) hb (plon,plev) ! | -- interpolation coefficients + real(r8) ht (plon,plev) ! | + real(r8) dhb(plon,plev) ! | + real(r8) dht(plon,plev) ! | +! +!----------------------------------------------------------------------- +! + jb = ppdy/2 + jt = jb + 1 +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + dyj(i,k) = dy(jdp(i,k)) + yb (i,k) = ( y(jdp(i,k)+1) - ydp(i,k) )/dyj(i,k) + yt (i,k) = 1._r8 - yb(i,k) + hb (i,k) = ( 3.0_r8 - 2.0_r8*yb(i,k) )*yb(i,k)**2 + ht (i,k) = ( 3.0_r8 - 2.0_r8*yt(i,k) )*yt(i,k)**2 + dhb(i,k) = -dyj(i,k)*( yb(i,k) - 1._r8 )*yb(i,k)**2 + dht(i,k) = dyj(i,k)*( yt(i,k) - 1._r8 )*yt(i,k)**2 + end do + end do +! +! Loop over fields. +! + do m = 1,pf +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + fdp(i,k,m) = fint(i,k,jb,m)*hb(i,k) + fyb(i,k,m)*dhb(i,k) + & + fint(i,k,jt,m)*ht(i,k) + fyt(i,k,m)*dht(i,k) + end do + end do + end do +! + return +end subroutine heryin diff --git a/src/dynamics/eul/herzin.F90 b/src/dynamics/eul/herzin.F90 new file mode 100644 index 0000000000..d56a3d0fe0 --- /dev/null +++ b/src/dynamics/eul/herzin.F90 @@ -0,0 +1,107 @@ + +subroutine herzin(pkdim ,pf ,f ,fst ,fsb , & + sig ,dsig ,sigdp ,kdp ,fdp , & + nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Interpolate field on vertical slice to vertical departure point using +! Hermite cubic interpolation. +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev +!----------------------------------------------------------------------- + implicit none +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pkdim ! vertical dimension + integer, intent(in) :: pf ! dimension (number of fields) +! + real(r8), intent(in) :: f (plon,pkdim,pf) ! fields + real(r8), intent(in) :: fst (plon,pkdim,pf) ! z-derivatives at top edge of interval + real(r8), intent(in) :: fsb (plon,pkdim,pf) ! z-derivatives at bot edge of interval + real(r8), intent(in) :: sig (pkdim) ! vertical grid coordinates + real(r8), intent(in) :: dsig (pkdim) ! intervals between vertical grid pts. + real(r8), intent(in) :: sigdp(plon,plev) ! vertical coord. of departure point +! + integer, intent(in) :: kdp (plon,plev) ! vertical index of departure point + integer, intent(in) :: nlon +! +! Output arguments +! + real(r8), intent(out) :: fdp(plon,plev,pf) ! z-interpolants +! +!----------------------------------------------------------------------- +! +! pkdim Vertical dimension of vertical slice arrays. +! pf Number of fields being interpolated. +! f Vertical slice of data to be interpolated. +! fst z-derivatives at the top edge of each interval contained in f +! fsb z-derivatives at the bot edge of each interval contained in f +! sig Sigma values corresponding to the vertical grid +! dsig Increment in sigma value for each interval in vertical grid. +! sigdp Sigma value at the trajectory midpoint or endpoint for each +! gridpoint in a vertical slice from the global grid. +! kdp Vertical index for each gridpoint. This index points into a +! vertical slice array whose vertical grid is given by sig. +! E.g., sig(kdp(i,j)) .le. sigdp(i,j) .lt. sig(kdp(i,j)+1) . +! fdp Value of field at the trajectory midpoints or endpoints. +! +!---------------------------Local variables----------------------------- +! + integer i,k,m ! indices +! + real(r8) dzk ! vert interval containing the dep. pt. + real(r8) zt ! | + real(r8) zb ! | + real(r8) ht (plon) ! | -- interpolation coefficients + real(r8) hb (plon) ! | + real(r8) dht(plon) ! | + real(r8) dhb(plon) ! | +! +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I, DZK, ZT, ZB, HT, HB, DHT, DHB, M) + do k=1,plev + do i=1,nlon + dzk = dsig(kdp(i,k)) + zt = ( sig(kdp(i,k)+1) - sigdp(i,k) )/dzk + zb = 1._r8 - zt + ht (i) = ( 3.0_r8 - 2.0_r8*zt )*zt**2 + hb (i) = ( 3.0_r8 - 2.0_r8*zb )*zb**2 + dht(i) = -dzk*( zt - 1._r8 )*zt**2 + dhb(i) = dzk*( zb - 1._r8 )*zb**2 + end do +! +! Loop over fields. +! + do m=1,pf + do i=1,nlon + fdp(i,k,m) = f(i,kdp(i,k) ,m)* ht(i) + & + fst(i,kdp(i,k),m)*dht(i) + & + f(i,kdp(i,k)+1,m)* hb(i) + & + fsb(i,kdp(i,k),m)*dhb(i) + end do + end do + end do +! + return +end subroutine herzin diff --git a/src/dynamics/eul/hordif.F90 b/src/dynamics/eul/hordif.F90 new file mode 100644 index 0000000000..c745b562cc --- /dev/null +++ b/src/dynamics/eul/hordif.F90 @@ -0,0 +1,154 @@ +subroutine hordif(k,ztdt) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Horizontal diffusion of z,d,t,q +! 1. implicit del**2 form above level kmnhdn +! 2. implicit del**N form at level kmnhdn and below +! 3. courant number based truncation at level kmxhdc and above +! 4. increased del**2 coefficient at level kmxhd2 and above +! +! Computational note: this routine is multitasked by level, hence it +! is called once for each k +! +! Author: +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Reviewed: B. Boville, April 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use time_manager, only: get_step_size, is_first_step, get_nstep + use eul_control_mod + use spmd_utils, only : iam +!----------------------------------------------------------------------- + implicit none +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: k ! level index + + real(r8), intent(in) :: ztdt ! 2 times time step unless nstep=0 +! +!---------------------------Local workspace----------------------------- +! + integer ir,ii ! spectral indices + integer lmr,lmc ! spectral indices + real(r8) dfac ! large coefficient on del^n multipliers to +! strongly damp waves req'd by Courant limiter + integer lm,m,n ! spectral indices + real(r8) ztodt ! 2 delta t + real(r8) zdt ! model time step + real(r8) dmpini ! used to compute divergence damp rate + real(r8) dmptim ! used to compute divergence damp rate + real(r8) dmprat ! divergence damping rate + real(r8) coef ! coeff. used to apply damping rate to divergence + real(r8) two +! +!----------------------------------------------------------------------- + two=2._r8 +! +! Set the horizontal diffusion factors for each wavenumer at this level +! depending on: whether del^2 or del^N diffusion is to be applied; and +! whether the courant number limit is to be applied. +! + if (k .ge. kmnhdn) then ! Del^N diffusion factors + do n=1,pnmax + hdiftq(n,k) = hdfstn(n) + hdifzd(n,k) = hdfsdn(n) + end do +! +! Spectrally truncate selected levels (if courant number too large) +! + if (k.le. kmxhdc .and. nindex(k).le.pnmax) then + dfac = 1000._r8 + do n=nindex(k),pnmax + hdiftq(n,k) = dfac*hdfstn(n) + hdifzd(n,k) = dfac*hdfsdn(n) + end do + end if + else ! Del^2 diffusion factors + if (k.le.kmxhd2) then +! +! Buggy sun compiler gives wrong answer for following line when +! using -Qoption f90comp -r8const flags +! dfac = 2.**(real(kmxhd2-k+1,r8)) + dfac = two**(real(kmxhd2-k+1,r8)) + else + dfac = 1.0_r8 + end if + do n=1,pnmax + hdiftq(n,k) = dfac*hdfst2(n) + hdifzd(n,k) = dfac*hdfsd2(n) + end do +! +! Spectrally truncate selected levels (if courant number too large) +! + if ((k.le.kmxhdc).and.(nindex(k).le.pnmax)) then + dfac = 1000._r8 + do n=nindex(k),pnmax + hdiftq(n,k) = dfac*hdfst2(n) + hdifzd(n,k) = dfac*hdfsd2(n) + end do + end if + end if +! +! Define damping rate for divergence damper +! + zdt = get_step_size() + +! ztodt = 2._r8*zdt +! if (is_first_step()) ztodt = .5_r8*ztodt + ztodt = ztdt +! +! Initial damping rate (e-folding time = zdt) and then linearly decrease +! to 0. over number of days specified by "divdampn". +! + coef = 1._r8 + if (divdampn .gt. 0.0_r8) then + dmpini = 1._r8/(zdt) + dmptim = divdampn*86400._r8 + dmprat = dmpini * (dmptim - real(get_nstep(),r8)*zdt) / dmptim + if (dmprat .gt. 0.0_r8) coef = 1.0_r8 / (1.0_r8+ztodt*dmprat) + endif +! +! Compute time-split implicit factors for this level +! + do lm=1,numm(iam) + m=locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 +! +! time-split implicit factors +! + t(ir,k) = t(ir,k)/(1._r8 + ztdt*hdiftq(n+m-1,k)) + t(ii,k) = t(ii,k)/(1._r8 + ztdt*hdiftq(n+m-1,k)) +! + d(ir,k) = d(ir,k)*coef/(1._r8 + ztdt*hdifzd(n+m-1,k)) + d(ii,k) = d(ii,k)*coef/(1._r8 + ztdt*hdifzd(n+m-1,k)) +! + vz(ir,k) = vz(ir,k)/(1._r8 + ztdt*hdifzd(n+m-1,k)) + vz(ii,k) = vz(ii,k)/(1._r8 + ztdt*hdifzd(n+m-1,k)) + end do + end do +! + return +end subroutine hordif + diff --git a/src/dynamics/eul/hrintp.F90 b/src/dynamics/eul/hrintp.F90 new file mode 100644 index 0000000000..84ab7668b0 --- /dev/null +++ b/src/dynamics/eul/hrintp.F90 @@ -0,0 +1,139 @@ + +subroutine hrintp(pf ,pkcnst ,fb ,fxl ,fxr , & + x ,y ,dy ,wdy ,xdp , & + ydp ,idp ,jdp ,jcen ,limitd , & + fint ,fyb ,fyt ,fdp ,nlon , & + nlonex ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Interpolate 2-d field to departure point using tensor product +! Hermite cubic interpolation. +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon + use scanslt, only: plond, platd, beglatex, endlatex +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! dimension (number of fields) + integer, intent(in) :: pkcnst ! dimension (see ext. document) +! + real(r8), intent(in) :: fb (plond,plev,pkcnst,beglatex:endlatex) ! input fields + real(r8), intent(in) :: fxl(plond,plev,pf ,beglatex:endlatex) ! left x-derivs + real(r8), intent(in) :: fxr(plond,plev,pf ,beglatex:endlatex) ! right x-derivs + real(r8), intent(in) :: x (plond,platd) ! long. grid coordinates + real(r8), intent(in) :: y (platd) ! lat. grid coordinates + real(r8), intent(in) :: dy (platd) ! intervals betwn lat grid pts. + real(r8), intent(in) :: wdy(4,2,platd) ! lat. derivative weights + real(r8), intent(in) :: xdp(plon,plev) ! x-coord of dep. pt. + real(r8), intent(in) :: ydp(plon,plev) ! y-coord of dep. pt. +! + integer, intent(in) :: idp(plon,plev,4) ! i index of dep. pt. + integer, intent(in) :: jdp(plon,plev) ! j index of dep. pt. + integer, intent(in) :: jcen +! + logical, intent(in) :: limitd ! flag for shape-preservation +! +! Output arguments +! + real(r8), intent(out) :: fint(plon,plev,ppdy,pf) ! x interpolants + real(r8), intent(out) :: fyb (plon,plev,pf) ! y-derivatives at bot of int. + real(r8), intent(out) :: fyt (plon,plev,pf) ! y-derivatives at top of int. + real(r8), intent(out) :: fdp (plon,plev,pf) ! horizontal interpolants + + integer, intent(in) :: nlon + integer, intent(in) :: nlonex(platd) +! +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! pkcnst dimensioning construct for 3-D arrays. (see ext. document) +! fb Extended array of data to be interpolated. +! fxl x-derivatives at the left edge of each interval containing +! the departure point. +! fxr x-derivatives at the right edge of each interval containing +! the departure point. +! x Equally spaced x grid values in extended arrays. +! y y-coordinate (latitude) values in the extended array. +! dy Increment in the y-coordinate value for each interval in the +! extended array. +! wdy Weights for Lagrange cubic derivative estimates on the +! unequally spaced y-grid. If grid interval j (in extended +! array is surrounded by a 4 point stencil, then the +! derivative at the "bottom" of the interval uses the weights +! wdy(1,1,j),wdy(2,1,j), wdy(3,1,j), and wdy(4,1,j). The +! derivative at the "top" of the interval uses wdy(1,2,j), +! wdy(2,2,j), wdy(3,2,j) and wdy(4,2,j). +! xdp xdp(i,k) is the x-coordinate of the departure point that +! corresponds to global grid point (i,k) in the latitude slice +! being forecasted. +! ydp ydp(i,k) is the y-coordinate of the departure point that +! corresponds to global grid point (i,k) in the latitude slice +! being forecasted. +! idp idp(i,k) is the index of the x-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Note that +! x(idp(i,k)) .le. xdp(i,k) .lt. x(idp(i,k)+1) . +! jdp jdp(i,k) is the index of the y-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Suppose yb contains the y-coordinates of the extended array +! and ydp(i,k) is the y-coordinate of the departure point +! corresponding to grid point (i,k). Then, +! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . +! limitd Logical flag to specify whether or not the y-derivatives will +! be limited. +! fint WORK ARRAY, results not used on return +! fyb WORK ARRAY, results not used on return +! fyt WORK ARRAY, results not used on return +! fdp Value of field at the horizontal departure points. +! +!----------------------------------------------------------------------- +! +! Hermite cubic interpolation to the x-coordinate of each +! departure point at each y-coordinate required to compute the +! y-derivatives. +! + call herxin(pf ,pkcnst ,fb ,fxl ,fxr , & + x ,xdp ,idp ,jdp ,fint , & + nlon ,nlonex ) +! +! Compute y-derivatives. +! + call cubydr(pf ,fint ,wdy ,jdp ,jcen , & + fyb ,fyt ,nlon ) + if( limitd )then + call limdy(pf ,fint ,dy ,jdp ,fyb , & + fyt ,nlon ) + end if +! +! Hermite cubic interpolation in the y-coordinate. +! + call heryin(pf ,fint ,fyb ,fyt ,y , & + dy ,ydp ,jdp ,fdp ,nlon ) +! + return +end subroutine hrintp diff --git a/src/dynamics/eul/interp_mod.F90 b/src/dynamics/eul/interp_mod.F90 new file mode 100644 index 0000000000..a36f01d731 --- /dev/null +++ b/src/dynamics/eul/interp_mod.F90 @@ -0,0 +1,65 @@ +module interp_mod + use shr_kind_mod, only : r8=>shr_kind_r8 + use cam_abortutils, only : endrun + + implicit none + private + save + + public :: setup_history_interpolation + public :: set_interp_hfile + public :: write_interpolated + + interface write_interpolated + module procedure write_interpolated_scalar + module procedure write_interpolated_vector + end interface + integer, parameter :: nlat=0, nlon=0 +contains + + subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & + interp_info) + use cam_history_support, only: interp_info_t + + ! Dummy arguments + logical, intent(inout) :: interp_ok + integer, intent(in) :: mtapes + logical, intent(in) :: interp_output(:) + type(interp_info_t), intent(inout) :: interp_info(:) + + interp_ok = .false. + + end subroutine setup_history_interpolation + + subroutine set_interp_hfile(hfilenum, interp_info) + use cam_history_support, only: interp_info_t + + ! Dummy arguments + integer, intent(in) :: hfilenum + type(interp_info_t), intent(inout) :: interp_info(:) + end subroutine set_interp_hfile + + subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) + use pio, only : file_desc_t, var_desc_t + use shr_kind_mod, only : r8=>shr_kind_r8 + implicit none + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(inout) :: varid + real(r8), intent(in) :: fld(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + call endrun('This routine is a stub, you shouldnt get here') + + end subroutine write_interpolated_scalar + + subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) + use pio, only : file_desc_t, var_desc_t + implicit none + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(inout) :: varidu, varidv + real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + call endrun('This routine is a stub, you shouldnt get here') + + end subroutine write_interpolated_vector + +end module interp_mod diff --git a/src/dynamics/eul/iop.F90 b/src/dynamics/eul/iop.F90 new file mode 100644 index 0000000000..602512c471 --- /dev/null +++ b/src/dynamics/eul/iop.F90 @@ -0,0 +1,1153 @@ +module iop +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: iop +! +! !DESCRIPTION: +! iop specific routines +! +! !USES: +! + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use constituents, only: readtrace, cnst_get_ind, pcnst, cnst_name + use eul_control_mod, only: eul_nsplit + use netcdf, only: NF90_NOERR,NF90_CLOSE,NF90_GET_VAR,NF90_INQUIRE_DIMENSION, & + NF90_INQ_DIMID, NF90_INQ_VARID, NF90_NOWRITE, NF90_OPEN, & + NF90_GET_ATT,NF90_GLOBAL,NF90_INQUIRE_ATTRIBUTE + use phys_control, only: phys_getopts + use pmgrid, only: beglat,endlat,plon,plev,plevp + use prognostics, only: n3,t3,q3,u3,v3,ps + use scamMod, only: use_camiop, ioptimeidx, have_ps, use_userdata, have_tsair, & + tobs, have_t, tground, have_tg, qobs, have_q, have_cld, & + have_clwp, divq, have_divq, vertdivq, have_vertdivq, divq3d, & + have_divq3d, dqfxcam, have_numliq, have_cldliq, have_cldice, & + have_numice, have_divu, have_divv, divt, have_divt, vertdivt, & + have_vertdivt, divt3d, have_divt3d, have_divu3d, have_divv3d, & + have_ptend, ptend, wfld, uobs, have_u, uobs, vobs, have_v, & + vobs, have_prec, have_q1, have_q2, have_lhflx, have_shflx, & + use_3dfrc, betacam, fixmascam, alphacam, ioptimeidx,doiopupdate, & + use_userdata, cldiceobs, cldliqobs, cldobs, clwpobs, divu, & + divu3d, divv, divv3d, iopfile, lhflxobs, numiceobs, numliqobs, & + precobs, q1obs, scmlat, scmlon, shflxobs, tsair, have_omega, wfldh,qinitobs + use shr_kind_mod, only: r8 => shr_kind_r8, max_chars=>shr_kind_cl + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use spmd_utils, only: masterproc + use string_utils, only: to_lower + use time_manager, only: timemgr_init, get_curr_date, get_curr_calday,& + get_nstep,is_first_step,get_start_date,timemgr_time_inc + use wrap_nf, only: wrap_inq_dimid,wrap_get_vara_realx +! +! !PUBLIC TYPES: + implicit none + + + private + + real(r8), allocatable,target :: dqfx3sav(:,:,:,:) + real(r8), allocatable,target :: t2sav(:,:,:) + real(r8), allocatable,target :: fusav(:,:,:) + real(r8), allocatable,target :: fvsav(:,:,:) + real(r8), allocatable,target :: divq3dsav(:,:,:,:) + real(r8), allocatable,target :: divt3dsav(:,:,:) + real(r8), allocatable,target :: divu3dsav(:,:,:) + real(r8), allocatable,target :: divv3dsav(:,:,:) + real(r8), allocatable,target :: betasav(:) + + integer :: closelatidx,closelonidx,latid,lonid,levid,timeid + + real(r8):: closelat,closelon + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_iop_fields + public :: readiopdata ! read iop boundary data + public :: setiopupdate ! find index in iopboundary data for current time +! public :: scam_use_iop_srf +! !PUBLIC DATA: + public betasav, & + dqfx3sav, divq3dsav, divt3dsav,divu3dsav,divv3dsav,t2sav,fusav,fvsav + +! +! !REVISION HISTORY: +! Created by John Truesdale +! +!EOP +! +! !PRIVATE MEMBER FUNCTIONS: +!----------------------------------------------------------------------- + +contains + subroutine init_iop_fields() +!------------------------------------------------------------------------------ +! Coupler for converting dynamics output variables into physics input variables +! also writes dynamics variables (on physics grid) to history file +!------------------------------------------------------------------------------ + implicit none + character(len=*), parameter :: sub = "init_iop_fields" +!----------------------------------------------------------------------- + if (eul_nsplit>1) then + call endrun('iop module cannot be used with eul_nsplit>1') + endif + + if(.not.allocated(betasav)) then + allocate (betasav(beglat:endlat)) + betasav(:)=0._r8 + endif + + if(.not.allocated(dqfx3sav)) then + allocate (dqfx3sav(plon,plev,pcnst,beglat:endlat)) + dqfx3sav(:,:,:,:)=0._r8 + endif + if(.not.allocated(divq3dsav)) then + allocate (divq3dsav(plon,plev,pcnst,beglat:endlat)) + divq3dsav(:,:,:,:)=0._r8 + endif + if(.not.allocated(divt3dsav)) then + allocate (divt3dsav(plon,plev,beglat:endlat)) + divt3dsav(:,:,:)=0._r8 + endif + if(.not.allocated(divu3dsav)) then + allocate (divu3dsav(plon,plev,beglat:endlat)) + divu3dsav(:,:,:)=0._r8 + endif + if(.not.allocated(divv3dsav)) then + allocate (divv3dsav(plon,plev,beglat:endlat)) + divv3dsav(:,:,:)=0._r8 + endif + if(.not.allocated(t2sav)) then + allocate (t2sav(plon,plev,beglat:endlat)) ! temp tendency + t2sav(:,:,:)=0._r8 + endif + if(.not.allocated(fusav)) then + allocate (fusav(plon,plev,beglat:endlat)) ! U wind tendency + fusav(:,:,:)=0._r8 + endif + if(.not.allocated(fvsav)) then + allocate (fvsav(plon,plev,beglat:endlat)) ! v wind tendency + fvsav(:,:,:)=0._r8 + endif + end subroutine init_iop_fields + +subroutine readiopdata(timelevel) + + +!----------------------------------------------------------------------- +! +! Open and read netCDF file containing initial IOP conditions +! +!---------------------------Code history-------------------------------- +! +! Written by J. Truesdale August, 1996, revised January, 1998 +! +!----------------------------------------------------------------------- + use ppgrid, only: begchunk, endchunk + use phys_grid, only: clat_p + use commap, only: latdeg, clat + use getinterpnetcdfdata, only: getinterpncdata + use shr_sys_mod, only: shr_sys_flush + use hycoef, only: hyam, hybm + use error_messages, only: handle_ncerr +!----------------------------------------------------------------------- + implicit none +#if ( defined RS6000 ) + implicit automatic ( a-z ) +#endif + + character(len=*), parameter :: sub = "read_iop_data" + +!------------------------------Input Arguments-------------------------- +! +integer, optional, intent(in) :: timelevel + +!------------------------------Locals----------------------------------- +! + integer ntimelevel + integer NCID, status + integer time_dimID, lev_dimID, lev_varID + integer tsec_varID, bdate_varID,varid + integer i,j + integer nlev + integer total_levs + integer u_attlen + + integer bdate, ntime,nstep + integer, allocatable :: tsec(:) + integer k, m + integer icldliq,icldice + integer inumliq,inumice,idx + + logical have_srf ! value at surface is available + logical fill_ends ! + logical have_cnst(pcnst) + real(r8) dummy + real(r8) lat,xlat + real(r8) srf(1) ! value at surface + real(r8) pmid(plev) ! pressure at model levels (time n) + real(r8) pint(plevp) ! pressure at model interfaces (n ) + real(r8) pdel(plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) weight + real(r8) tmpdata(1) + real(r8) coldata(plev) + real(r8), allocatable :: dplevs( : ) + integer strt4(4),cnt4(4),strt5(4),cnt5(4) + character(len=16) :: lowername + character(len=max_chars) :: units ! Units + + nstep = get_nstep() + fill_ends= .false. + + if (present(timelevel)) then + ntimelevel=timelevel + else + ntimelevel=n3 + end if + +! +! Open IOP dataset +! + call handle_ncerr( nf90_open (iopfile, 0, ncid),& + 'readiopdata.F90', __LINE__) + +! +! if the dataset is a CAM generated dataset set use_camiop to true +! CAM IOP datasets have a global attribute called CAM_GENERATED_IOP +! + if ( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', attnum=i )== NF90_NOERR ) then + use_camiop = .true. + else + use_camiop = .false. + endif + +!===================================================================== +! +! Read time variables + + + status = nf90_inq_dimid (ncid, 'time', time_dimID ) + if (status /= NF90_NOERR) then + status = nf90_inq_dimid (ncid, 'tsec', time_dimID ) + if (status /= NF90_NOERR) then + if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find dimension ID for time/tsec' + status = NF90_CLOSE ( ncid ) + call endrun + end if + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, time_dimID, len=ntime ),& + 'readiopdata.F90', __LINE__) + + allocate(tsec(ntime)) + + status = nf90_inq_varid (ncid, 'tsec', tsec_varID ) + call handle_ncerr( nf90_get_var (ncid, tsec_varID, tsec),& + 'readiopdata.F90', __LINE__) + + status = nf90_inq_varid (ncid, 'nbdate', bdate_varID ) + if (status /= NF90_NOERR) then + status = nf90_inq_varid (ncid, 'bdate', bdate_varID ) + if (status /= NF90_NOERR) then + if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for bdate' + status = NF90_CLOSE ( ncid ) + call endrun + end if + end if + call handle_ncerr( nf90_get_var (ncid, bdate_varID, bdate),& + 'readiopdata.F90', __LINE__) + +! +!====================================================== +! read level data +! + status = NF90_INQ_DIMID( ncid, 'lev', lev_dimID ) + if ( status .ne. nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable dim ID for lev' + status = NF90_CLOSE ( ncid ) + return + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, lev_dimID, len=nlev ),& + 'readiopdata.F90', __LINE__) + + allocate(dplevs(nlev+1)) + + status = NF90_INQ_VARID( ncid, 'lev', lev_varID ) + if ( status .ne. nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for lev' + status = NF90_CLOSE ( ncid ) + return + end if + + call handle_ncerr( nf90_get_var (ncid, lev_varID, dplevs(:nlev)),& + 'readiopdata.F90', __LINE__) +! +!CAM generated forcing already has pressure on millibars convert standard IOP if needed. +! + call handle_ncerr(nf90_inquire_attribute(ncid, lev_varID, 'units', len=u_attlen),& + 'readiopdata.F90', __LINE__) + call handle_ncerr(nf90_get_att(ncid, lev_varID, 'units', units),& + 'readiopdata.F90', __LINE__) + units=trim(to_lower(units(1:u_attlen))) + + if ( units=='pa' .or. units=='pascal' .or. units=='pascals' ) then +! +! convert pressure from Pascals to Millibars ( lev is expressed in pascals in iop datasets ) +! + do i=1,nlev + dplevs( i ) = dplevs( i )/100._r8 + end do + endif + + + call shr_scam_GetCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) + + lonid = 0 + latid = 0 + levid = 0 + timeid = 0 + + call wrap_inq_dimid(ncid, 'lat', latid) + call wrap_inq_dimid(ncid, 'lon', lonid) + call wrap_inq_dimid(ncid, 'lev', levid) + call wrap_inq_dimid(ncid, 'time', timeid) + + strt4(1) = closelonidx + strt4(2) = closelatidx + strt4(3) = iopTimeIdx + strt4(4) = 1 + cnt4(1) = 1 + cnt4(2) = 1 + cnt4(3) = 1 + cnt4(4) = 1 + + status = nf90_inq_varid( ncid, 'Ps', varid ) + if ( status .ne. nf90_noerr ) then + have_ps = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ps' + if ( .not. use_userdata ) then + status = NF90_CLOSE( ncid ) + return + else + if ( is_first_step() .and. masterproc) write(iulog,*) 'Using pressure value from Analysis Dataset' + endif + else + status = nf90_get_var(ncid, varid, ps(1,1,ntimelevel), strt4) + have_ps = .true. + endif + + +! If the IOP dataset has hyam,hybm,etc it is assumed to be a hybrid level +! dataset. + + status = nf90_inq_varid( ncid, 'hyam', varid ) + if ( status == nf90_noerr ) then + do i = 1, plev + dplevs( i ) = 1000.0_r8 * hyam( i ) + ps(1,1,ntimelevel) * hybm( i ) / 100.0_r8 + end do + endif + +! add the surface pressure to the pressure level data, so that +! surface boundary condition will be set properly, +! making sure that it is the highest pressure in the array. +! + + total_levs = nlev+1 + dplevs(nlev+1) = ps(1,1,ntimelevel)/100.0_r8 ! ps is expressed in pascals + do i= nlev, 1, -1 + if ( dplevs(i) > ps(1,1,ntimelevel)/100.0_r8) then + total_levs = i + dplevs(i) = ps(1,1,ntimelevel)/100.0_r8 + end if + end do + if (.not. use_camiop ) then + nlev = total_levs + endif + if ( nlev == 1 ) then + if (masterproc) write(iulog,*) sub//':Error - Readiopdata.F: Ps too low!' + return + endif + +!===================================================================== + + + status = nf90_inq_varid( ncid, 'Tsair', varid ) + if ( status .ne. nf90_noerr ) then + have_tsair = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tsair) + have_tsair = .true. + endif + +! +! read in Tobs For cam generated iop readin small t to avoid confusion +! with capital T defined in cam +! + + tobs(:)= t3(1,:,1,ntimelevel) + + if ( use_camiop ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'t', have_tsair, & + tsair(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel),tobs, status ) + else + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'T', have_tsair, & + tsair(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), tobs, status ) + endif + if ( status .ne. nf90_noerr ) then + have_t = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable T' + if ( .not. use_userdata ) then + status = NF90_CLOSE( ncid ) + return + else + if (masterproc) write(iulog,*) sub//':Using value from Analysis Dataset' + endif +! +! set T3 to Tobs on first time step +! + else + have_t = .true. + endif + + status = nf90_inq_varid( ncid, 'Tg', varid ) + if (status .ne. nf90_noerr) then + if (masterproc) write(iulog,*) sub//':Could not find variable Tg on IOP dataset' + if ( have_tsair ) then + if (masterproc) write(iulog,*) sub//':Using Tsair' + tground = tsair ! use surface value from T field + else + if (masterproc) write(iulog,*) sub//':Using T at lowest level from IOP dataset' + tground = tobs(plev) + endif + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tground) + have_Tg = .true. + endif + + status = nf90_inq_varid( ncid, 'qsrf', varid ) + + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + if (is_first_step()) then + qinitobs(:,:)=q3(1,:,:,1,ntimelevel) + end if + + qobs(:)= q3(1,:,1,1,ntimelevel) + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'q', have_srf, & + srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), qobs, status ) + if ( status .ne. nf90_noerr ) then + have_q = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable q' + if ( .not. use_userdata ) then + status = nf90_close( ncid ) + return + else + if (masterproc) write(iulog,*) sub//':Using values from Analysis Dataset' + endif + else + have_q = .true. + endif + + cldobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'cld', .false., & + dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), cldobs, status ) + if ( status .ne. nf90_noerr ) then + have_cld = .false. + else + have_cld = .true. + endif + + clwpobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'clwp', .false., & + dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), clwpobs, status ) + if ( status .ne. nf90_noerr ) then + have_clwp = .false. + else + have_clwp = .true. + endif + +! +! read divq (horizontal advection) +! + status = nf90_inq_varid( ncid, 'divqsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divq(:,:)=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divq', have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divq(:,1), status ) + if ( status .ne. nf90_noerr ) then + have_divq = .false. + else + have_divq = .true. + endif + +! +! read vertdivq if available +! + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivq=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivq', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), vertdivq(:,1), status ) + if ( status .ne. nf90_noerr ) then + have_vertdivq = .false. + else + have_vertdivq = .true. + endif + + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + +! +! add calls to get dynamics tendencies for all prognostic consts +! + divq3d=0._r8 + + do m = 1, pcnst + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dten', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divq3d(:,m), status ) + if ( status .ne. nf90_noerr ) then + have_cnst(m) = .false. + divq3d(1:,m)=0._r8 + else + if (m==1) have_divq3d = .true. + have_cnst(m) = .true. + endif + + coldata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dqfx', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), coldata, status ) + if ( STATUS .NE. NF90_NOERR ) then + dqfxcam(1,:,m)=0._r8 + else + dqfxcam(1,:,m)=coldata(:) + endif + + tmpdata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_alph', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), tmpdata, status ) + if ( status .ne. nf90_noerr ) then +! have_cnst(m) = .false. + alphacam(m)=0._r8 + else + alphacam(m)=tmpdata(1) +! have_cnst(m) = .true. + endif + + end do + + + numliqobs = 0._r8 + call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) + if ( inumliq > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMLIQ', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), numliqobs, status ) + if ( status .ne. nf90_noerr ) then + have_numliq = .false. + else + have_numliq = .true. + do i=1, PLEV + q3(1,i,inumliq,1,ntimelevel)=numliqobs(i) + end do + endif + else + have_numliq = .false. + end if + + have_srf = .false. + + cldliqobs = 0._r8 + call cnst_get_ind('CLDLIQ', icldliq, abort=.false.) + if ( icldliq > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDLIQ', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), cldliqobs, status ) + if ( status .ne. nf90_noerr ) then + have_cldliq = .false. + else + have_cldliq = .true. + do i=1, PLEV + q3(1,i,icldliq,1,ntimelevel)=cldliqobs(i) + end do + endif + else + have_cldliq = .false. + endif + + cldiceobs = 0._r8 + call cnst_get_ind('CLDICE', icldice, abort=.false.) + if ( icldice > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDICE', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), cldiceobs, status ) + if ( status .ne. nf90_noerr ) then + have_cldice = .false. + else + have_cldice = .true. + do i=1, PLEV + q3(1,i,icldice,1,ntimelevel)=cldiceobs(i) + end do + endif + else + have_cldice = .false. + endif + + numiceobs = 0._r8 + call cnst_get_ind('NUMICE', inumice, abort=.false.) + if ( inumice > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMICE', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), numiceobs, status ) + if ( status .ne. nf90_noerr ) then + have_numice = .false. + else + have_numice = .true. + do i=1, PLEV + q3(1,i,inumice,1,ntimelevel)=numiceobs(i) + end do + endif + else + have_numice = .false. + end if + +! +! read divu (optional field) +! + status = nf90_inq_varid( ncid, 'divusrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divu = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divu', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divu, status ) + if ( status .ne. nf90_noerr ) then + have_divu = .false. + else + have_divu = .true. + endif +! +! read divv (optional field) +! + status = nf90_inq_varid( ncid, 'divvsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divv = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divv', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divv, status ) + if ( status .ne. nf90_noerr ) then + have_divv = .false. + else + have_divv = .true. + endif +! +! read divt (optional field) +! + status = nf90_inq_varid( ncid, 'divtsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divt=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divT', have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divt, status ) + if ( status .ne. nf90_noerr ) then + have_divt = .false. + else + have_divt = .true. + endif + +! +! read vertdivt if available +! + status = nf90_inq_varid( ncid, 'vertdivTsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivt=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivT', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), vertdivt, status ) + if ( status .ne. nf90_noerr ) then + have_vertdivt = .false. + else + have_vertdivt = .true. + endif +! +! read divt3d (combined vertical/horizontal advection) +! (optional field) + + status = nf90_inq_varid( ncid, 'divT3dsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divT3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divT3d', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divt3d, status ) + if ( status .ne. nf90_noerr ) then + have_divt3d = .false. + else + have_divt3d = .true. + endif + + divU3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divU3d', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divu3d, status ) + if ( status .ne. nf90_noerr ) then + have_divu3d = .false. + else + have_divu3d = .true. + endif + + divV3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divV3d', & + have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), divv3d, status ) + if ( status .ne. nf90_noerr ) then + have_divv3d = .false. + else + have_divv3d = .true. + endif + + status = nf90_inq_varid( ncid, 'Ptend', varid ) + if ( status .ne. nf90_noerr ) then + have_ptend = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ptend. Setting to zero' + ptend = 0.0_r8 + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_ptend = .true. + ptend= srf(1) + endif + + wfld=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'omega', .true., ptend, fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), wfld, status ) + if ( status .ne. nf90_noerr ) then + have_omega = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable omega' + if ( .not. use_userdata ) then + status = nf90_close( ncid ) + return + else + if (masterproc) write(iulog,*) sub//'Using value from Analysis Dataset' + endif + else + have_omega = .true. + endif + call plevs0(1 ,plon ,plev ,ps(1,1,ntimelevel) ,pint,pmid ,pdel) + call shr_sys_flush( iulog ) +! +! Build interface vector for the specified omega profile +! (weighted average in pressure of specified level values) +! + wfldh(:) = 0.0_r8 + + do k=2,plev + weight = (pint(k) - pmid(k-1))/(pmid(k) - pmid(k-1)) + wfldh(k) = (1.0_r8 - weight)*wfld(k-1) + weight*wfld(k) + end do + + status = nf90_inq_varid( ncid, 'usrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + uobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'u', have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), uobs, status ) + if ( status .ne. nf90_noerr ) then + have_u = .false. + else + have_u = .true. + do i=1, PLEV + u3(1,i,1,ntimelevel) = uobs(i) ! set u to uobs at first time step + end do + endif + + status = nf90_inq_varid( ncid, 'vsrf', varid ) + if ( status .ne. nf90_noerr ) then + have_srf = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + vobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'v', have_srf, srf(1), fill_ends, & + dplevs, nlev,ps(1,1,ntimelevel), vobs, status ) + if ( status .ne. nf90_noerr ) then + have_v = .false. + else + have_v = .true. + do i=1, PLEV + v3(1,i,1,ntimelevel) = vobs(i) ! set u to uobs at first time step + end do + endif + call shr_sys_flush( iulog ) + + status = nf90_inq_varid( ncid, 'Prec', varid ) + if ( status .ne. nf90_noerr ) then + have_prec = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,precobs) + have_prec = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q1', & + .false., dummy, fill_ends, & ! datasets don't contain Q1 at surface + dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) + if ( status .ne. nf90_noerr ) then + have_q1 = .false. + else + have_q1 = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q2', & + .false., dummy, fill_ends, & ! datasets don't contain Q2 at surface + dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) + if ( status .ne. nf90_noerr ) then + have_q2 = .false. + else + have_q2 = .true. + endif + +! Test for BOTH 'lhflx' and 'lh' without overwriting 'have_lhflx'. +! Analagous changes made for the surface heat flux + + status = nf90_inq_varid( ncid, 'lhflx', varid ) + if ( status .ne. nf90_noerr ) then + status = nf90_inq_varid( ncid, 'lh', varid ) + if ( status .ne. nf90_noerr ) then + have_lhflx = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + + status = nf90_inq_varid( ncid, 'shflx', varid ) + if ( status .ne. nf90_noerr ) then + status = nf90_inq_varid( ncid, 'sh', varid ) + if ( status .ne. nf90_noerr ) then + have_shflx = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + + call shr_sys_flush( iulog ) + +! +! fill in 3d forcing variables if we have both horizontal +! and vertical components, but not the 3d +! + if ( .not. have_cnst(1) .and. have_divq .and. have_vertdivq ) then + do k=1,plev + do m=1,pcnst + divq3d(k,m) = divq(k,m) + vertdivq(k,m) + enddo + enddo + have_divq3d = .true. + endif + + if ( .not. have_divt3d .and. have_divt .and. have_vertdivt ) then + if (masterproc) write(iulog,*) sub//'Don''t have divt3d - using divt and vertdivt' + do k=1,plev + divt3d(k) = divt(k) + vertdivt(k) + enddo + have_divt3d = .true. + endif +! +! make sure that use_3dfrc flag is set to true if we only have +! 3d forcing available +! + if ( .not. have_divt .or. .not. have_divq ) then + use_3dfrc = .true. + endif + call shr_sys_flush( iulog ) + + status = nf90_inq_varid( ncid, 'CLAT', varid ) + if ( status == nf90_noerr ) then + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,clat) + clat_p(1)=clat(1) + latdeg(1) = clat(1)*45._r8/atan(1._r8) + endif + + status = nf90_inq_varid( ncid, 'beta', varid ) + if ( status .ne. nf90_noerr ) then + betacam = 0._r8 + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + betacam=srf(1) + endif + + status = nf90_inq_varid( ncid, 'fixmas', varid ) + if ( status .ne. nf90_noerr ) then + fixmascam=1.0_r8 + else + status = nf90_get_var(ncid, varid, srf(1), strt4) + fixmascam=srf(1) + endif + + call shr_sys_flush( iulog ) + + status = nf90_close( ncid ) + call shr_sys_flush( iulog ) + + deallocate(dplevs,tsec) + + return +end subroutine readiopdata + +subroutine setiopupdate + +!----------------------------------------------------------------------- +! +! Open and read netCDF file to extract time information +! +!---------------------------Code history-------------------------------- +! +! Written by John Truesdale August, 1996 +! +!----------------------------------------------------------------------- + implicit none +#if ( defined RS6000 ) + implicit automatic (a-z) +#endif + character(len=*), parameter :: sub = "setiopupdate" + +!------------------------------Locals----------------------------------- + + integer NCID,i + integer tsec_varID, time_dimID + integer, allocatable :: tsec(:) + integer ntime + integer bdate, bdate_varID + integer STATUS + integer next_date, next_sec, last_date, last_sec + integer :: ncsec,ncdate ! current time of day,date + integer :: yr, mon, day ! year, month, and day component + integer :: start_ymd,start_tod + save tsec, ntime, bdate + save last_date, last_sec +!------------------------------------------------------------------------------ + + if ( is_first_step() ) then +! +! Open IOP dataset +! + STATUS = NF90_OPEN( iopfile, NF90_NOWRITE, NCID ) +! +! Read time (tsec) variable +! + STATUS = NF90_INQ_VARID( NCID, 'tsec', tsec_varID ) + if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & + sub//':ERROR - setiopupdate.F:', & + 'Cant get variable ID for tsec' + + STATUS = NF90_INQ_VARID( NCID, 'bdate', bdate_varID ) + if ( STATUS .NE. NF90_NOERR ) then + STATUS = NF90_INQ_VARID( NCID, 'basedate', bdate_varID ) + if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & + sub//':ERROR - setiopupdate.F:Cant get variable ID for bdate' + endif + + STATUS = NF90_INQ_DIMID( NCID, 'time', time_dimID ) + if ( STATUS .NE. NF90_NOERR ) then + STATUS = NF90_INQ_DIMID( NCID, 'tsec', time_dimID ) + if ( STATUS .NE. NF90_NOERR ) then + write(iulog,* )'ERROR - setiopupdate.F:Could not find variable dim ID for time' + STATUS = NF90_CLOSE ( NCID ) + return + end if + end if + + if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & + sub//':ERROR - setiopupdate.F:Cant get variable dim ID for time' + + STATUS = NF90_INQUIRE_DIMENSION( NCID, time_dimID, len=ntime ) + if ( STATUS .NE. NF90_NOERR ) then + if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get time dimlen' + endif + + if (.not.allocated(tsec)) allocate(tsec(ntime)) + + STATUS = NF90_GET_VAR( NCID, tsec_varID, tsec ) + if ( STATUS .NE. NF90_NOERR )then + if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable tsec' + endif + STATUS = NF90_GET_VAR( NCID, bdate_varID, bdate ) + if ( STATUS .NE. NF90_NOERR )then + if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable bdate' + endif +! Close the netCDF file + STATUS = NF90_CLOSE( NCID ) +! +! determine the last date in the iop dataset +! + call timemgr_time_inc(bdate, 0, last_date, last_sec, inc_s=tsec(ntime)) +! +! set the iop dataset index +! + iopTimeIdx=0 + do i=1,ntime ! set the first ioptimeidx + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(i)) + call get_start_date(yr,mon,day,start_tod) + start_ymd = yr*10000 + mon*100 + day + + if ( start_ymd > next_date .or. (start_ymd == next_date & + .and. start_tod >= next_sec)) then + iopTimeIdx = i + endif + enddo + + call get_curr_date(yr,mon,day,ncsec) + ncdate=yr*10000 + mon*100 + day + + if (iopTimeIdx == 0.or.iopTimeIdx >= ntime) then + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(1)) + if (masterproc) then + write(iulog,*) 'Error::setiopupdate: Current model time does not fall within IOP period' + write(iulog,*) ' Current CAM Date is ',ncdate,' and ',ncsec,' seconds' + write(iulog,*) ' IOP start is ',next_date,' and ',next_sec,' seconds' + write(iulog,*) ' IOP end is ',last_date,' and ',last_sec,' seconds' + end if + call endrun + endif + + doiopupdate = .true. + +!------------------------------------------------------------------------------ +! Check if iop data needs to be updated and set doiopupdate accordingly +!------------------------------------------------------------------------------ + else ! endstep > 1 + + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) + + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + + if ( ncdate > next_date .or. (ncdate == next_date & + .and. ncsec >= next_sec)) then + iopTimeIdx = iopTimeIdx + 1 + doiopupdate = .true. +#if DEBUG > 2 + if (masterproc) write(iulog,*) sub//'nstep = ',get_nstep() + if (masterproc) write(iulog,*) sub//'ncdate=',ncdate,' ncsec=',ncsec + if (masterproc) write(iulog,*) sub//'next_date=',next_date,' next_sec=',next_sec + if (masterproc) write(iulog,*) sub//':******* do iop update' +#endif + else + doiopupdate = .false. + end if + endif ! if (endstep == 0 ) +! +! make sure we're +! not going past end of iop data +! + if ( ncdate > last_date .or. (ncdate == last_date & + .and. ncsec > last_sec)) then + if ( .not. use_userdata ) then + call endrun(sub//':ERROR - setiopupdate.c:Reached the end of the time varient dataset') + else + doiopupdate = .false. + end if + endif + +#if DEBUG > 1 + if (masterproc) write(iulog,*) sub//':iop time index = ' , ioptimeidx +#endif + + return + +end subroutine setiopupdate + +end module iop + diff --git a/src/dynamics/eul/lagyin.F90 b/src/dynamics/eul/lagyin.F90 new file mode 100644 index 0000000000..faaa5f10b3 --- /dev/null +++ b/src/dynamics/eul/lagyin.F90 @@ -0,0 +1,151 @@ + +subroutine lagyin(pf ,fint ,wdy ,ydp ,jdp , & + jcen ,fdp ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! For each departure point in the latitude slice to be forecast, +! interpolate (using unequally spaced Lagrange cubic formulas) the +! x interpolants to the y value of the departure point. +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: platd + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if (!defined UNICOSMP) + use srchutil, only: whenieq +#endif +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! dimension (number of fields) +! + real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants + real(r8), intent(in) :: wdy(4,2,platd) ! y-interpolation weights + real(r8), intent(in) :: ydp(plon,plev) ! y-coordinates of departure pts. +! + integer, intent(in) :: jdp(plon,plev) ! j-index of departure point coord. + integer, intent(in) :: jcen ! current latitude + integer, intent(in) :: nlon +! +! Output arguments +! + real(r8), intent(out) :: fdp(plon,plev,pf) ! interpolants at the horiz. depart. pt. +! +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! fint (fint(i,k,j,m),j=ppdy/2,ppdy/2 + 1) contains the x +! interpolants at the endpoints of the y-interval that contains +! the departure point for grid point (i,k). The last index of +! fint allows for interpolation of multiple fields. fint is +! generated by a call to herxin. +! wdy Grid values and weights for Lagrange cubic interpolation on +! the unequally spaced y-grid. +! ydp ydp(i,k) is the y-coordinate of the departure point that +! corresponds to global grid point (i,k) in the latitude slice +! being forecasted. +! jdp jdp(i,k) is the index of the y-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Note that +! y(jdp(i,k)) .le. ydp(i,k) .lt. y(jdp(i,k)+1) . +! fdp Horizontally interpolated field values at the departure point +! for the latitude slice being forecasted. +! +!---------------------------Local variables----------------------------- +! + integer i,m ! indices +! + real(r8) ymy1 ! | + real(r8) ymy2 ! | + real(r8) ymy3 ! | + real(r8) ymy4 ! | + real(r8) coef12 ! | + real(r8) coef34 ! | -- interpolation weights/coeffs. + real(r8) term1(plon,plev) ! | + real(r8) term2(plon,plev) ! | + real(r8) term3(plon,plev) ! | + real(r8) term4(plon,plev) ! | +! + integer jdpval,icount,ii,indx(plon),nval(plev) + integer k +! +!----------------------------------------------------------------------- +! + if( ppdy .ne. 4) then + call endrun ('LAGYIN:Error: ppdy .ne. 4') + end if + icount = 0 + do jdpval=jcen-2,jcen+1 + if (icount.lt.nlon*plev) then +!$OMP PARALLEL DO PRIVATE (K, INDX, II, I, YMY3, YMY4, COEF12, YMY2, YMY1, COEF34) + do k=1,plev + call whenieq(nlon,jdp(1,k),1,jdpval,indx,nval(k)) +! + do ii = 1,nval(k) + i=indx(ii) + ymy3 = ydp(i,k) - wdy(3,1,jdpval) + ymy4 = ydp(i,k) - wdy(4,1,jdpval) + coef12 = ymy3*ymy4 + ymy2 = ydp(i,k) - wdy(2,1,jdpval) + term1(i,k) = coef12*ymy2*wdy(1,2,jdpval) + ymy1 = ydp(i,k) - wdy(1,1,jdpval) + term2(i,k) = coef12*ymy1*wdy(2,2,jdpval) + coef34 = ymy1*ymy2 + term3(i,k) = coef34*ymy4*wdy(3,2,jdpval) + term4(i,k) = coef34*ymy3*wdy(4,2,jdpval) + end do + end do + do k=1,plev + icount = icount + nval(k) + enddo + end if + end do + if (icount.ne.nlon*plev) then + write(iulog,*)'LAGYIN: Departure pt out of bounds: jcen,icount,nlon*plev=',jcen,icount,nlon*plev + write(iulog,*)' ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun + end if +! +! Loop over fields. +! + do m = 1,pf +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + fdp(i,k,m) = fint(i,k,1,m)*term1(i,k) + & + fint(i,k,2,m)*term2(i,k) + & + fint(i,k,3,m)*term3(i,k) + & + fint(i,k,4,m)*term4(i,k) + end do + end do + end do +! + return +end subroutine lagyin diff --git a/src/dynamics/eul/limdx.F90 b/src/dynamics/eul/limdx.F90 new file mode 100644 index 0000000000..7d9ab9aa40 --- /dev/null +++ b/src/dynamics/eul/limdx.F90 @@ -0,0 +1,100 @@ + +subroutine limdx(pidim ,ibeg ,len ,dx ,f ,& + fxl ,fxr ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Limit the derivative estimates for data on an equally spaced grid +! so they satisfy the SCM0 condition, that is, the spline will be +! monotonic, but only C0 continuous on the domain +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use scanslt, only: plond + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + +!----------------------------------------------------------------------- + implicit none +!---------------------------Local parameters---------------------------- +! + integer pbpts ! (length of latitude slice)*fields + parameter(pbpts = plond) +! +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pidim ! vector dimension + integer, intent(in) :: ibeg ! index of vector to begin computation + integer, intent(in) :: len ! length of vector to compute +! + real(r8), intent(in) :: dx ! length of grid inteval + real(r8), intent(in) :: f(pidim) ! field +! +! Input/output arguments +! + real(r8), intent(inout) :: fxl(pidim) ! x-derivs at left edge of interval + real(r8), intent(inout) :: fxr(pidim) ! x-derivs at right edge of interval +! +!----------------------------------------------------------------------- +! +! pidim Length of f, fxl, and fxr. +! ibeg First interval of grid for which derivatives are computed. +! len Number of grid intervals for which derivatives are computed. +! (There are pidim - 1 intervals between the pidim gridpoints +! represented in f, fxl, and fxr.) +! dx Value of grid spacing. +! f Values on equally spaced grid from which derivatives fxl and +! fxr were computed. +! fxl fxl(i) is the limited derivative at the left edge of +! interval +! fxr fxr(i) is the limited derivative at the right edge of +! interval +! +!---------------------------Local variables----------------------------- +! + integer i ! index + integer iend ! index to end work on vector +! + real(r8) rdx ! 1./dx + real(r8) deli(pbpts) ! simple linear derivative +! +!----------------------------------------------------------------------- +! + if(pidim .gt. pbpts) then + write(iulog,9000) pidim + call endrun + end if +! + iend = ibeg + len - 1 + rdx = 1._r8/dx +! + do i = ibeg,iend + deli(i) = ( f(i+1) - f(i) )*rdx + end do +! +! Limiter +! + call scm0(len ,deli(ibeg),fxl(ibeg),fxr(ibeg)) +! + return +9000 format('LIMDX: Local work array DELI not dimensioned large enough' & + ,/' Increase local parameter pbpts to ',i5) +end subroutine limdx + diff --git a/src/dynamics/eul/limdy.F90 b/src/dynamics/eul/limdy.F90 new file mode 100644 index 0000000000..abcb526b35 --- /dev/null +++ b/src/dynamics/eul/limdy.F90 @@ -0,0 +1,126 @@ + +subroutine limdy(pf ,fint ,dy ,jdp ,fyb ,& + fyt ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Limit the y-derivative estimates so they satisy the SCM0 for the +! x-interpolated data corresponding to the departure points of a single +! latitude slice in the global grid, that is, they are monotonic, but +! spline has only C0 continuity +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996! +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: platd +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: pf ! dimension (number of fields) +! + real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants + real(r8), intent(in) :: dy(platd) ! interval lengths in lat grid +! + integer, intent(in) :: jdp(plon,plev) ! j-index of coord. of dep. pt. + integer, intent(in) :: nlon +! +! Input/output arguments +! + real(r8), intent(inout) :: fyb(plon,plev,pf) ! y-derivatives at bot of interval + real(r8), intent(inout) :: fyt(plon,plev,pf) ! y-derivatives at top of interval +! +!----------------------------------------------------------------------- +! +! pf Number of fields being interpolated. +! fint (fint(i,k,j,m),j=1,ppdy) contains the x interpolants at each +! latitude needed for the y derivative estimates at the +! endpoints of the interval that contains the departure point +! for grid point (i,k). The last index of fint allows for +! interpolation of multiple fields. fint is generated by a +! call to herxin. +! dy Increment in the y-coordinate value for each interval in the +! extended array. +! jdp jdp(i,k) is the index of the y-interval that contains the +! departure point corresponding to global grid point (i,k) in +! the latitude slice being forecasted. +! Suppose yb contains the y-coordinates of the extended array +! and ydp(i,k) is the y-coordinate of the departure point +! corresponding to grid point (i,k). Then, +! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . +! fyb fyb(i,k,.) is the limited derivative at the bot of the y +! interval that contains the departure point of global grid +! point (i,k). +! fyt fyt(i,k,.) is the limited derivative at the top of the y +! interval that contains the departure point of global grid +! point (i,k). +! +!---------------------------Local variables----------------------------- +! + integer i,k,m ! indices + integer jb ! index for bottom of interval + integer jt ! index for top of interval +! + real(r8) rdy (plon,plev) ! 1./dy + real(r8) deli(plon) ! simple linear derivative + +!GRCJR + real(r8) fac,tmp1,tmp2 + fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) +! +!----------------------------------------------------------------------- +! + jb = ppdy/2 + jt = jb + 1 +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + rdy(i,k) = 1._r8/dy(jdp(i,k)) + end do + end do +! +! Loop over fields. +! + do m = 1,pf +!$OMP PARALLEL DO PRIVATE (K, I, DELI, TMP1, TMP2) + do k = 1,plev + do i = 1,nlon + deli(i) = ( fint(i,k,jt,m) - fint(i,k,jb,m) )*rdy(i,k) +! end do +! +! Limiter +! +!GRCJR call scm0(nlon,deli,fyb(1,k,m),fyt(1,k,m)) +! do i = 1,nlon + tmp1 = fac*deli(i) + tmp2 = abs( tmp1 ) + if( deli(i)*fyb(i,k,m) <= 0.0_r8 ) fyb(i,k,m) = 0._r8 + if( deli(i)*fyt(i,k,m) <= 0.0_r8 ) fyt(i,k,m) = 0._r8 + if( abs( fyb(i,k,m) ) > tmp2 ) fyb(i,k,m) = tmp1 + if( abs( fyt(i,k,m) ) > tmp2 ) fyt(i,k,m) = tmp1 + end do + end do + end do +! + return +end subroutine limdy diff --git a/src/dynamics/eul/limdz.F90 b/src/dynamics/eul/limdz.F90 new file mode 100644 index 0000000000..d13eb4ce33 --- /dev/null +++ b/src/dynamics/eul/limdz.F90 @@ -0,0 +1,96 @@ + +subroutine limdz(f ,dsig ,fst ,fsb ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Apply SCMO limiter to vertical derivative estimates on a vertical +! slice. +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use constituents, only: pcnst +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- + integer plevm1 + parameter( plevm1 = plev - 1 ) +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: f(plon,plev,pcnst) ! input field + real(r8), intent(in) :: dsig(plev) ! size of vertical interval + + integer, intent(in) :: nlon +! +! Input/output arguments +! + real(r8), intent(inout) :: fst(plon,plev,pcnst) ! z-derivative at top of interval + real(r8), intent(inout) :: fsb(plon,plev,pcnst) ! z-derivative at bot of interval +! +!----------------------------------------------------------------------- +! +! f Field values used to compute the discrete differences for +! each interval in the vertical grid. +! dsig Increment in the sigma-coordinate value for each interval. +! fst Limited derivative at the top of each interval. +! fsb Limited derivative at the bottom of each interval. +! +!---------------------------Local variables----------------------------- +! + integer i ! longitude index + integer k ! vertical index + integer m ! constituent index +! + real(r8) rdsig ! 1./dsig + real(r8) deli(plon) ! simple linear derivative + +!GRCJR + real(r8) fac,tmp1,tmp2 + fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) + +! +!------------------------------Externals-------------------------------- +! +!GRCJR external scm0 +! +!----------------------------------------------------------------------- +! +! Loop over fields. +! + do m = 1,pcnst +!$OMP PARALLEL DO PRIVATE (K, RDSIG, I, DELI, TMP1, TMP2) + do k = 1,plev-1 + rdsig = 1.0_r8/dsig(k) + do i = 1,nlon + deli(i) = ( f(i,k+1,m) - f(i,k,m) )*rdsig +!GRCJR end do +!GRCJR call scm0(nlon,deli,fst(1,k,m),fsb(1,k,m) ) +!GRCJR do i=1,nlon + tmp1 = fac*deli(i) + tmp2 = abs( tmp1 ) + if( deli(i)*fst(i,k,m) <= 0.0_r8 ) fst(i,k,m) = 0._r8 + if( deli(i)*fsb(i,k,m) <= 0.0_r8 ) fsb(i,k,m) = 0._r8 + if( abs( fst(i,k,m) ) > tmp2 ) fst(i,k,m) = tmp1 + if( abs( fsb(i,k,m) ) > tmp2 ) fsb(i,k,m) = tmp1 + end do + end do + end do +! + return +end subroutine limdz diff --git a/src/dynamics/eul/linemsdyn.F90 b/src/dynamics/eul/linemsdyn.F90 new file mode 100644 index 0000000000..1ec5104f8b --- /dev/null +++ b/src/dynamics/eul/linemsdyn.F90 @@ -0,0 +1,563 @@ + +module linemsdyn + +!----------------------------------------------------------------------- +! +! Purpose: +! Control non-linear dynamical terms, FFT and combine terms +! in preparation for Fourier -> spectral quadrature. +! +! Method: +! The naming convention is as follows: +! - prefix gr contains grid point values before FFT and Fourier +! coefficients after +! - t, q, d, z and ps refer to temperature, specific humidity, +! divergence, vorticity and surface pressure +! - "1" suffix to an array => symmetric component current latitude pair +! - "2" suffix to an array => antisymmetric component. +! +! Author: +! Original version: CCM3 +! Modified: P. Worley, October 2002 +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, plevp, plat, beglat, endlat + use spmd_utils, only: iam + use perf_mod + implicit none + + private +! +! Public interfaces +! + public linemsdyn_bft ! Before FFT + public linemsdyn_fft ! FFT + public linemsdyn_aft ! After FFT +! +! Public data +! + integer, public, parameter :: plondfft = plon + 2 ! Length needed for FFT + integer, public, parameter :: plndlvfft = plondfft*plev ! Length of multilevel 3-d field slice + +! +!----------------------------------------------------------------------- +! + +contains + +!----------------------------------------------------------------------- + +subroutine linemsdyn_bft( & + lat ,nlon ,nlon_fft, & + psm1 ,psm2 ,u3m1 , & + u3m2 ,v3m1 ,v3m2 ,t3m1 ,t3m2 , & + q3m1 ,etadot ,etamid , & + ztodt , vcour ,vmax ,vmaxt , & + detam ,t2 ,fu ,fv , & + divm1 ,vortm2 ,divm2 ,vortm1 ,phis , & + dpsl ,dpsm ,omga ,cwava ,flx_net , & + fftbuf ) +!----------------------------------------------------------------------- +! +! Purpose: +! Control non-linear dynamical terms and fill FFT buffer +! in preparation for Fourier -> spectral quadrature. +! +! Author: +! Original version: CCM3 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ + + use constituents, only: pcnst + use pspect, only: ptrm, ptrn + use scanslt, only: engy1lat + use commap, only: clat, tau, w + use cam_history, only: outfld + use time_manager, only: get_step_size + use hycoef, only : hypd, hypi + use cam_control_mod, only : adiabatic + use eul_control_mod, only : eul_nsplit +! +! Input arguments +! + integer lat ! latitude index for S->N storage + integer nlon + integer, intent(in) :: nlon_fft ! first dimension of FFT work array + + real(r8), intent(in) :: psm1(plon) ! surface pressure (time n) + real(r8), intent(in) :: psm2(plon) ! surface pressure (time n-1) + real(r8), intent(in) :: u3m1(plon,plev) ! u-wind (time n) + real(r8), intent(in) :: u3m2(plon,plev) ! u-wind (time n-1) + real(r8), intent(in) :: v3m1(plon,plev) ! v-wind (time n) + real(r8), intent(in) :: v3m2(plon,plev) ! v-wind (time n-1) + real(r8), intent(in) :: t3m1(plon,plev) ! temperature (time n) + real(r8), intent(in) :: q3m1(plon,plev,pcnst) ! constituent conc(time n: h2o first) + real(r8), intent(inout) :: etadot(plon,plevp) ! vertical motion (3-d used by slt) + real(r8), intent(in) :: etamid(plev) ! midpoint values of eta (a+b) + real(r8), intent(in) :: ztodt ! 2*timestep unless nstep = 0 + real(r8), intent(in) :: detam(plev) ! maximum Courant number in vert. +! +! Input/Output arguments +! + real(r8), intent(inout) :: t2(plon,plev) ! t tend + real(r8), intent(inout) :: fu(plon,plev) ! nonlinear term - u momentum eqn. + real(r8), intent(inout) :: fv(plon,plev) ! nonlinear term - v momentum eqn. + real(r8), intent(inout) :: divm1(plon,plev) + real(r8), intent(inout) :: vortm2(plon,plev) + real(r8), intent(inout) :: divm2(plon,plev) + real(r8), intent(inout) :: vortm1(plon,plev) + real(r8), intent(inout) :: phis(plon) + real(r8), intent(inout) :: dpsl(plon) + real(r8), intent(inout) :: dpsm(plon) + real(r8), intent(inout) :: omga(plon,plev) + real(r8), intent(inout) :: t3m2(plon,plev) ! temperature (time n-1) + real(r8), intent(in) :: cwava ! weight for global water vapor int. + real(r8), intent(in) :: flx_net(plon) ! net flux from physics +! +! Output arguments +! + real(r8), intent(out) :: fftbuf(nlon_fft,9,plev) ! buffer used for in-place FFTs + real(r8), intent(out) :: vcour(plev) ! maximum Courant number in vert. + real(r8), intent(out) :: vmax(plev) ! maximum wind speed squared (m^2/s^2) + real(r8), intent(out) :: vmaxt(plev) ! maximum truncated wind speed (m^2/s^2) +! +!---------------------------Local workspace----------------------------- +! + real(r8) :: dtime ! timestep size + real(r8) :: bpstr(plon) ! + real(r8) pmid(plon,plev) ! pressure at model levels (time n) + real(r8) rpmid(plon,plev) ! 1./pmid + real(r8) pint(plon,plevp) ! pressure at model interfaces (n ) + real(r8) pdel(plon,plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) rpdel(plon,plev) ! 1./pdel + real(r8) tdyn(plon,plev) ! temperature for dynamics + real(r8) logpsm1(plon) ! log(psm1) + real(r8) logpsm2(plon) ! log(psm2) + real(r8) engy(plon,plev) ! kinetic energy + real(r8) vat (plon,plev) ! Vertical advection of temperature + real(r8) ktoop(plon,plev) ! (Kappa*T)*(omega/P) + real(r8) ut(plon,plev) ! (u*T) - heat flux - zonal + real(r8) vt(plon,plev) ! (v*T) - heat flux - meridional + real(r8) drhs(plon,plev) ! RHS of divergence eqn. (del^2 term) + real(r8) lvcour ! local vertical courant number + real(r8) dtdz ! dt/detam(k) + real(r8) ddivdt(plon,plev) ! temporary workspace + real(r8) ddpn(plon) ! complete sum of d*delta p + real(r8) vpdsn(plon) ! complete sum V dot grad(ln(ps)) delta b + real(r8) dpslat(plon,plev) ! Pressure gradient term + real(r8) dpslon(plon,plev) ! Pressure gradient term + real(r8) coslat ! cosine(latitude) + real(r8) rcoslat ! 1./cosine(latitude) + real(r8) rhypi ! 1./hypi(plevp) + + real(r8) wind ! u**2 + v**2 (m/s) + real(r8) utfac ! asymmetric truncation factor for courant calculation + real(r8) vtfac ! asymmetric truncation factor for courant calculation + + real(r8) tmp ! accumulator + integer i,k,kk ! longitude,level,constituent indices + integer, parameter :: tdyndex = 1 ! indices into fftbuf + integer, parameter :: fudex = 2 + integer, parameter :: fvdex = 3 + integer, parameter :: utdex = 4 + integer, parameter :: vtdex = 5 + integer, parameter :: drhsdex = 6 + integer, parameter :: vortdyndex = 7 + integer, parameter :: divdyndex = 8 + integer, parameter :: bpstrdex = 9 +! +! This group of arrays are glued together via equivalence to exbuf for +! communication from LINEMSBC. +! +! +!----------------------------------------------------------------------- +! +! +! Compute maximum wind speed this latitude (used in Courant number estimate) +! + if (ptrm .lt. ptrn) then + utfac = real(ptrm,r8)/real(ptrn,r8) + vtfac = 1._r8 + else if (ptrn .lt. ptrm) then + utfac = 1._r8 + vtfac = real(ptrn,r8)/real(ptrm,r8) + else if (ptrn .eq. ptrm) then + utfac = 1._r8 + vtfac = 1._r8 + end if + +!$OMP PARALLEL DO PRIVATE (K, I, WIND) + do k=1,plev + vmax(k) = 0._r8 + vmaxt(k) = 0._r8 + do i=1,nlon + wind = u3m2(i,k)**2 + v3m2(i,k)**2 + vmax(k) = max(wind,vmax(k)) +! +! Change to Courant limiter for non-triangular truncations. +! + wind = utfac*u3m2(i,k)**2 + vtfac*v3m2(i,k)**2 + vmaxt(k) = max(wind,vmaxt(k)) + end do + end do +! +! Variables needed in tphysac +! + coslat = cos(clat(lat)) + rcoslat = 1._r8/coslat +! +! Set current time pressure arrays for model levels etc. +! + call plevs0(nlon,plon,plev,psm1,pint,pmid,pdel) +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + rpmid(i,k) = 1._r8/pmid(i,k) + rpdel(i,k) = 1._r8/pdel(i,k) + end do + end do +! +! Accumulate statistics for diagnostic print +! + call stats(lat, pint, pdel, psm1, & + vortm1, divm1, t3m1, q3m1(:,:,1), nlon ) +! +! Compute log(surface pressure) for use by grmult and when adding tendency. +! +!$OMP PARALLEL DO PRIVATE (I) + do i=1,nlon + logpsm1(i) = log(psm1(i)) + logpsm2(i) = log(psm2(i)) + end do +! +! Compute integrals +! + call plevs0(nlon,plon,plev,psm2,pint,pmid,pdel) + call engy_te (cwava,w(lat),t3m2,u3m2,v3m2,phis ,pdel, psm2, tmp ,nlon) + engy1lat(lat) = tmp + call plevs0(nlon,plon,plev,psm1,pint,pmid,pdel) +! +! Include top/bottom flux integral to energy integral +! + call flxint (w(lat) ,flx_net ,tmp ,nlon ) + engy1lat(lat) = engy1lat(lat) + tmp *ztodt +! +! Calculate non-linear terms in tendencies +! + if (adiabatic) t2(:,:) = 0._r8 + call outfld('FU ',fu ,plon,lat) + call outfld('FV ',fv ,plon,lat) + call grmult(rcoslat ,divm1 ,q3m1(1,1,1),t3m1 ,u3m1 , & + v3m1 ,vortm1 ,t3m2 ,phis ,dpsl , & + dpsm ,omga ,pdel ,pint(1,plevp),logpsm2, & + logpsm1 ,rpmid ,rpdel ,fu ,fv , & + t2 ,ut ,vt ,drhs ,pmid , & + etadot ,etamid ,engy ,ddpn ,vpdsn , & + dpslon ,dpslat ,vat ,ktoop ,nlon ) +! +! Add tendencies to previous timestep values of surface pressure, +! temperature, and (if spectral transport) moisture. Store *log* surface +! pressure in bpstr array for transform to spectral space. +! + rhypi = 1._r8/hypi(plevp) +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + ddivdt(i,k) = ztodt*(0.5_r8*divm2(i,k) - divm1(i,k)) + tdyn(i,k) = t3m2(i,k) + ztodt*t2(i,k) + end do + end do + +!$OMP PARALLEL DO PRIVATE (I, K) + do i=1,nlon + bpstr(i) = logpsm2(i) - ztodt*(vpdsn(i)+ddpn(i))/psm1(i) + do k=1,plev + bpstr(i) = bpstr(i) - ddivdt(i,k)*hypd(k)*rhypi + end do + end do + +!$OMP PARALLEL DO PRIVATE (K, KK, I) + do k=1,plev + do kk=1,plev + do i=1,nlon + tdyn(i,k) = tdyn(i,k) - ddivdt(i,kk)*tau(kk,k) + end do + end do + end do + +! +! Compute maximum vertical Courant number this latitude. +! + dtime = get_step_size()/eul_nsplit + vcour(:) = 0._r8 +!$OMP PARALLEL DO PRIVATE (K, DTDZ, I, LVCOUR) + do k=2,plev + dtdz = dtime/detam(k-1) + do i=1,nlon + lvcour = abs(etadot(i,k))*dtdz + vcour(k) = max(lvcour,vcour(k)) + end do + end do + + call outfld('ETADOT ',etadot,plon,lat) + call outfld('VAT ',vat ,plon,lat) + call outfld('KTOOP ',ktoop ,plon,lat) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! Apply cos(lat) to momentum terms before fft +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + fu(i,k) = coslat*fu(i,k) + fv(i,k) = coslat*fv(i,k) + ut(i,k) = coslat*ut(i,k) + vt(i,k) = coslat*vt(i,k) + end do + end do + +! +! Copy fields into FFT buffer +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon +! +! undifferentiated terms + fftbuf(i,tdyndex,k) = tdyn(i,k) +! longitudinally and latitudinally differentiated terms + fftbuf(i,fudex,k) = fu(i,k) + fftbuf(i,fvdex,k) = fv(i,k) + fftbuf(i,utdex,k) = ut(i,k) + fftbuf(i,vtdex,k) = vt(i,k) + fftbuf(i,drhsdex,k) = drhs(i,k) +! vort,div + fftbuf(i,vortdyndex,k) = vortm2(i,k) + fftbuf(i,divdyndex,k) = divm2(i,k) +! + enddo + enddo +! ps + do i=1,nlon + fftbuf(i,bpstrdex,1) = bpstr(i) + enddo + + return +end subroutine linemsdyn_bft + +!----------------------------------------------------------------------- + +subroutine linemsdyn_fft(nlon_fft,nlon_fft2,fftbuf,fftbuf2) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute FFT of non-linear dynamical terms +! in preparation for Fourier -> spectral quadrature. +! +! Author: +! Original version: CCM3 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ + + use pmgrid, only: plon, plat + use eul_control_mod, only : trig, ifax +#if (defined SPMD) + use mpishorthand, only: mpicom +#endif + +! +! Input arguments +! + integer, intent(in) :: nlon_fft ! first dimension of first FFT work array + integer, intent(in) :: nlon_fft2 ! first dimension of second FFT work array +! +! Input/Output arguments +! + real(r8), intent(inout) :: fftbuf(nlon_fft,9,plev,beglat:endlat) + ! buffer used for in-place FFTs +! +! Output arguments +! +#if (defined SPMD) + real(r8), intent(out) :: fftbuf2(nlon_fft2,9,plev,plat) + ! buffer for returning reorderd Fourier coefficients +#else + real(r8), intent(in) :: fftbuf2(1) + ! buffer unused +#endif +! +!---------------------------Local workspace----------------------------- +! +! The "work" array has a different size requirement depending upon whether +! the proprietary Cray assembly language version of the FFT library +! routines, or the all-Fortran version, is being used. +! +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*plev*9) +#else + real(r8) work((plon+1)*pcray) ! workspace array for fft991 +#endif + integer lat ! latitude index + integer inc ! increment for fft991 + integer isign ! flag indicates transform direction + integer ntr ! number of transforms to perform + integer k ! vertical level index +! + inc = 1 + isign = -1 +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT, NTR, K, WORK) +#endif + do lat=beglat,endlat + ntr = 8 +!$OMP PARALLEL DO PRIVATE (K, WORK) + do k=1,plev + fftbuf(plon+1:nlon_fft,:,k,lat) = 0.0_r8 + call fft991(fftbuf(1,1,k,lat) ,work ,trig(1,lat),ifax(1,lat),inc ,& + nlon_fft ,plon ,ntr ,isign ) + enddo + ntr = 1 + fftbuf(plon+1:nlon_fft,9,1,lat) = 0.0_r8 + call fft991(fftbuf(1,9,1,lat) ,work ,trig(1,lat),ifax(1,lat),inc ,& + nlon_fft ,plon ,ntr ,isign ) + enddo +! +#if ( defined SPMD ) +! +! reorder Fourier coefficients +! + call t_barrierf ('sync_realloc4a', mpicom) + call t_startf('realloc4a') + call realloc4a(nlon_fft, nlon_fft2, fftbuf, fftbuf2) + call t_stopf('realloc4a') +#endif + + return +end subroutine linemsdyn_fft + +!----------------------------------------------------------------------- + +subroutine linemsdyn_aft( & + irow ,nlon_fft,fftbufs ,fftbufn , & + grlps1 ,grt1 ,grz1 ,grd1 , & + grfu1 ,grfv1 ,grut1 ,grvt1 ,grrh1 , & + grlps2 ,grt2 ,grz2 ,grd2 ,grfu2 , & + grfv2 ,grut2 ,grvt2 ,grrh2 ) +!----------------------------------------------------------------------- +! +! Purpose: +! Combine terms in preparation for Fourier -> spectral quadrature. +! +! Author: +! Original version: CCM3 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ + + use pspect, only: pmmax +#if (defined SPMD) + use comspe, only: numm, maxm +#else + use comspe, only: maxm +#endif +! Input arguments +! + integer, intent(in) :: irow ! latitude pair index + integer, intent(in) :: nlon_fft ! first dimension of FFT work arrays + + real(r8), intent(in) :: fftbufs(nlon_fft,9,plev) ! southern latitude Fourier coefficients + real(r8), intent(in) :: fftbufn(nlon_fft,9,plev) ! northern latitude Fourier coefficients +! +! Output arguments +! + real(r8), intent(out) :: grlps1(2*maxm) ! sym. undiff. term in lnps eqn. + real(r8), intent(out) :: grlps2(2*maxm) ! antisym undiff. term in lnps eqn. + real(r8), intent(out) :: grt1(2*maxm,plev) ! sym. undiff. term in t eqn. + real(r8), intent(out) :: grt2(2*maxm,plev) ! antisym. undiff. term in t eqn. + real(r8), intent(out) :: grz1(2*maxm,plev) ! sym. undiff. term in z eqn. + real(r8), intent(out) :: grz2(2*maxm,plev) ! antisym. undiff. term in z eqn. + real(r8), intent(out) :: grd1(2*maxm,plev) ! sym. undiff. term in d eqn. + real(r8), intent(out) :: grd2(2*maxm,plev) ! antisym. undiff. term in d eqn. + real(r8), intent(out) :: grfu1(2*maxm,plev) ! sym. nonlinear terms in u eqn. + real(r8), intent(out) :: grfu2(2*maxm,plev) ! antisym. nonlinear terms in u eqn. + real(r8), intent(out) :: grfv1(2*maxm,plev) ! sym. nonlinear terms in v eqn. + real(r8), intent(out) :: grfv2(2*maxm,plev) ! antisym. nonlinear terms in v eqn. + real(r8), intent(out) :: grut1(2*maxm,plev) ! sym. lambda deriv. term in t eqn. + real(r8), intent(out) :: grut2(2*maxm,plev) ! antisym. lambda deriv. term in t eqn. + real(r8), intent(out) :: grvt1(2*maxm,plev) ! sym. mu derivative term in t eqn. + real(r8), intent(out) :: grvt2(2*maxm,plev) ! antisym. mu deriv. term in t eqn. + real(r8), intent(out) :: grrh1(2*maxm,plev) ! sym. del**2 term in d eqn. + real(r8), intent(out) :: grrh2(2*maxm,plev) ! antisym. del**2 term in d eqn. +! +!---------------------------Local workspace----------------------------- +! + integer i,k ! longitude,level indices + integer mlength ! number of wavenumbers + integer, parameter :: tdyndex = 1 ! indices into fftbuf + integer, parameter :: fudex = 2 + integer, parameter :: fvdex = 3 + integer, parameter :: utdex = 4 + integer, parameter :: vtdex = 5 + integer, parameter :: drhsdex = 6 + integer, parameter :: vortdyndex = 7 + integer, parameter :: divdyndex = 8 + integer, parameter :: bpstrdex = 9 +! +#if (defined SPMD) + mlength = numm(iam) +#else + mlength = pmmax +#endif + do k=1,plev + do i=1,2*mlength + + grt1(i,k) = 0.5_r8*(fftbufn(i,tdyndex,k)+fftbufs(i,tdyndex,k)) + grt2(i,k) = 0.5_r8*(fftbufn(i,tdyndex,k)-fftbufs(i,tdyndex,k)) + + grz1(i,k) = 0.5_r8*(fftbufn(i,vortdyndex,k)+fftbufs(i,vortdyndex,k)) + grz2(i,k) = 0.5_r8*(fftbufn(i,vortdyndex,k)-fftbufs(i,vortdyndex,k)) + + grd1(i,k) = 0.5_r8*(fftbufn(i,divdyndex,k)+fftbufs(i,divdyndex,k)) + grd2(i,k) = 0.5_r8*(fftbufn(i,divdyndex,k)-fftbufs(i,divdyndex,k)) + + grfu1(i,k) = 0.5_r8*(fftbufn(i,fudex,k)+fftbufs(i,fudex,k)) + grfu2(i,k) = 0.5_r8*(fftbufn(i,fudex,k)-fftbufs(i,fudex,k)) + + grfv1(i,k) = 0.5_r8*(fftbufn(i,fvdex,k)+fftbufs(i,fvdex,k)) + grfv2(i,k) = 0.5_r8*(fftbufn(i,fvdex,k)-fftbufs(i,fvdex,k)) + + grut1(i,k) = 0.5_r8*(fftbufn(i,utdex,k)+fftbufs(i,utdex,k)) + grut2(i,k) = 0.5_r8*(fftbufn(i,utdex,k)-fftbufs(i,utdex,k)) + + grvt1(i,k) = 0.5_r8*(fftbufn(i,vtdex,k)+fftbufs(i,vtdex,k)) + grvt2(i,k) = 0.5_r8*(fftbufn(i,vtdex,k)-fftbufs(i,vtdex,k)) + + grrh1(i,k) = 0.5_r8*(fftbufn(i,drhsdex,k)+fftbufs(i,drhsdex,k)) + grrh2(i,k) = 0.5_r8*(fftbufn(i,drhsdex,k)-fftbufs(i,drhsdex,k)) + + end do + end do + + do i=1,2*mlength + grlps1(i) = 0.5_r8*(fftbufn(i,bpstrdex,1)+fftbufs(i,bpstrdex,1)) + grlps2(i) = 0.5_r8*(fftbufn(i,bpstrdex,1)-fftbufs(i,bpstrdex,1)) + end do + + return +end subroutine linemsdyn_aft + +!----------------------------------------------------------------------- + +end module linemsdyn diff --git a/src/dynamics/eul/massfix.F90 b/src/dynamics/eul/massfix.F90 new file mode 100644 index 0000000000..f701e18a87 --- /dev/null +++ b/src/dynamics/eul/massfix.F90 @@ -0,0 +1,37 @@ +!----------------------------------------------------------------------- +module massfix +!----------------------------------------------------------------------- +! +! Purpose: Module for mass fixer, contains global integrals +! +!----------------------------------------------------------------------- +! +! Written by: Dani Bundy Coleman, Oct 2004 +! +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst + +!----------------------------------------------------------------------- + implicit none +! +! By default everything is private to this module +! + private +! +! Public interfaces +! + + public hw1, hw2, hw3, alpha ! Needs to be public for restart + +! +! Module data +! + real(r8) :: hw1(pcnst) ! Pre-SLT global integral of constituent + real(r8) :: hw2(pcnst) ! Post-SLT global integral of const. + real(r8) :: hw3(pcnst) ! Global integral for denom. of expr. for alpha + real(r8) :: alpha(pcnst) ! alpha(m) = ( hw1(m) - hw2(m) )/hw3(m) + + +end module massfix diff --git a/src/dynamics/eul/parslt.h b/src/dynamics/eul/parslt.h new file mode 100644 index 0000000000..5d9d96c317 --- /dev/null +++ b/src/dynamics/eul/parslt.h @@ -0,0 +1,13 @@ +! +! $Id$ +! $Author$ +! +! +! Parameters common to many SLT routines +! + integer ppdy ! length of interpolation grid stencil + logical plimdr ! flag to limit derivatives +! + parameter(ppdy = 4, plimdr = .true.) +! + diff --git a/src/dynamics/eul/pmgrid.F90 b/src/dynamics/eul/pmgrid.F90 new file mode 100644 index 0000000000..1a9eccc8a6 --- /dev/null +++ b/src/dynamics/eul/pmgrid.F90 @@ -0,0 +1,29 @@ +module pmgrid + +! Parameters and variables related to the dynamics grid + + implicit none + + public + + integer, parameter :: plon = PLON ! number of longitudes + integer, parameter :: plev = PLEV ! number of vertical levels + integer, parameter :: plat = PLAT ! number of latitudes + integer, parameter :: plevp = plev + 1 ! plev + 1 + integer, parameter :: plnlv = plon*plev ! Length of multilevel field slice + + integer :: beglat ! beg. index for latitudes owned by a given proc + integer :: endlat ! end. index for latitudes owned by a given proc + integer :: begirow ! beg. index for latitude pairs owned by a given proc + integer :: endirow ! end. index for latitude pairs owned by a given proc + integer :: numlats ! number of latitudes owned by a given proc + +#if ( ! defined SPMD ) + parameter (beglat = 1) + parameter (endlat = plat) + parameter (begirow = 1) + parameter (endirow = plat/2) + parameter (numlats = plat) +#endif + +end module pmgrid diff --git a/src/dynamics/eul/prognostics.F90 b/src/dynamics/eul/prognostics.F90 new file mode 100644 index 0000000000..275635031e --- /dev/null +++ b/src/dynamics/eul/prognostics.F90 @@ -0,0 +1,113 @@ + +module prognostics + +!----------------------------------------------------------------------- +! +! Purpose: +! Prognostic variables held in-core for convenient access. +! q3 is specific humidity (water vapor) and other constituents. +! +! Author: G. Grant +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, beglat, endlat + use infnan, only: posinf, assignment(=) + use constituents, only: pcnst + + + implicit none + + private + + public ps, u3, v3, t3, q3, qminus, vort, div, dpsl, dpsm, dps, omga, phis, hadv, pdeld + public n3, n3m1, n3m2, ptimelevels + public initialize_prognostics + public shift_time_indices + + integer, parameter :: ptimelevels = 3 ! number of time levels in the dycore + integer :: n3 = 3 + integer :: n3m1 = 2 + integer :: n3m2 = 1 + + real(r8), allocatable, target :: ps(:,:,:) + real(r8), allocatable, target :: u3(:,:,:,:) + real(r8), allocatable, target :: v3(:,:,:,:) + real(r8), allocatable, target :: t3(:,:,:,:) + real(r8), allocatable, target :: pdeld(:,:,:,:) + real(r8), allocatable, target :: q3(:,:,:,:,:) + real(r8), allocatable :: qminus(:,:,:,:) + real(r8), allocatable :: hadv (:,:,:,:) + + real(r8), allocatable, target :: vort(:,:,:,:) ! vorticity + real(r8), allocatable, target :: div(:,:,:,:) ! divergence + + real(r8), allocatable, target :: dpsl(:,:) ! longitudinal pressure gradient + real(r8), allocatable, target :: dpsm(:,:) ! meridional pressure gradient + real(r8), allocatable, target :: dps(:,:) ! pressure gradient + real(r8), allocatable, target :: phis(:,:) ! surface geopotential + real(r8), allocatable, target :: omga(:,:,:) ! vertical velocity + +CONTAINS + + subroutine initialize_prognostics +! +! Purpose: Allocate and initialize the prognostic arrays. +! + + allocate (ps (plon ,beglat:endlat ,ptimelevels)) + allocate (u3 (plon,plev ,beglat:endlat,ptimelevels)) + allocate (v3 (plon,plev ,beglat:endlat,ptimelevels)) + allocate (t3 (plon,plev ,beglat:endlat,ptimelevels)) + allocate (q3 (plon,plev,pcnst,beglat:endlat,ptimelevels)) + allocate (qminus(plon,plev,pcnst,beglat:endlat )) + allocate (hadv (plon,plev,pcnst,beglat:endlat )) + + allocate (vort (plon,plev,beglat:endlat,ptimelevels)) + allocate (div (plon,plev,beglat:endlat,ptimelevels)) + + allocate (dpsl (plon,beglat:endlat)) + allocate (dpsm (plon,beglat:endlat)) + allocate (dps (plon,beglat:endlat)) + allocate (phis (plon,beglat:endlat)) + allocate (omga (plon,plev,beglat:endlat)) + allocate (pdeld (plon,plev,beglat:endlat,ptimelevels)) + + ps(:,:,:) = posinf + u3(:,:,:,:) = posinf + v3(:,:,:,:) = posinf + t3(:,:,:,:) = posinf + pdeld(:,:,:,:) = posinf + q3(:,:,:,:,:) = posinf + qminus(:,:,:,:) = posinf + hadv (:,:,:,:) = posinf + + vort(:,:,:,:) = posinf + div (:,:,:,:) = posinf + + dpsl (:,:) = posinf + dpsm (:,:) = posinf + dps (:,:) = posinf + phis (:,:) = posinf + omga (:,:,:) = posinf + + return + end subroutine initialize_prognostics + + subroutine shift_time_indices +! +! Purpose: +! Shift the indices that keep track of which index stores +! the relative times (current time, previous, time before previous etc). +! + integer :: itmp + + itmp = n3m2 + + n3m2 = n3m1 + n3m1 = n3 + n3 = itmp + end subroutine shift_time_indices + +end module prognostics diff --git a/src/dynamics/eul/pspect.F90 b/src/dynamics/eul/pspect.F90 new file mode 100644 index 0000000000..f428af14fc --- /dev/null +++ b/src/dynamics/eul/pspect.F90 @@ -0,0 +1,18 @@ +module pspect + +! Parameters related to spectral domain + +integer, parameter :: ptrm = PTRM ! M truncation parameter +integer, parameter :: ptrn = PTRN ! N truncation parameter +integer, parameter :: ptrk = PTRK ! K truncation parameter + +integer, parameter :: pmax = ptrn+1 ! number of diagonals +integer, parameter :: pmaxp = pmax+1 ! Number of diagonals plus 1 +integer, parameter :: pnmax = ptrk+1 ! Number of values of N +integer, parameter :: pmmax = ptrm+1 ! Number of values of M +integer, parameter :: par0 = ptrm+ptrn-ptrk ! intermediate parameter +integer, parameter :: par2 = par0*(par0+1)/2 ! intermediate parameter +integer, parameter :: pspt = (ptrn+1)*pmmax-par2 ! Total num complex spectral coeffs retained +integer, parameter :: psp = 2*pspt ! 2*pspt (real) size of coeff array per level + +end module pspect diff --git a/src/dynamics/eul/quad.F90 b/src/dynamics/eul/quad.F90 new file mode 100644 index 0000000000..0402a96623 --- /dev/null +++ b/src/dynamics/eul/quad.F90 @@ -0,0 +1,278 @@ + +subroutine quad(lm ,zdt ,ztdtsq ,grlps1 ,grlps2 ,& + grt1 ,grz1 ,grd1 ,grfu1 ,grfv1 ,& + grvt1 ,grrh1 ,grt2 ,grz2 ,grd2 ,& + grfu2 ,grfv2 ,grvt2 ,grrh2 ) +!----------------------------------------------------------------------- +! +! Perform gaussian quadrature for 1 Fourier wavenumber (m) to obtain the +! spectral coefficients of ln(ps), temperature, vorticity, and divergence. +! Add the tendency terms requiring meridional derivatives during the +! transform. +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 +! Reviewed: B. Boville, D. Williamson, April 1996 +! Modified: P. Worley, September 2002 +! Modified: NEC, April 2004 +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use physconst, only: rearth + use spmd_utils, only : iam + implicit none +! +! Input arguments +! + integer, intent(in) :: lm ! local Fourier wavenumber index + real(r8), intent(in) :: zdt ! timestep(dt) unless nstep = 0 + real(r8), intent(in) :: ztdtsq(pnmax) ! 2*zdt*n(n+1)/(a^2) +! where n IS the 2-d wavenumber +! +! Fourier coefficient arrays which have a latitude index on them for +! multitasking. These arrays are defined in LINEMS and and in QUAD +! to compute spectral coefficients. They contain a latitude index so +! that the sums over latitude can be performed in a specified order. +! +! Suffixes 1 and 2 refer to symmetric and antisymmetric components +! respectively. +! + real(r8), intent(in) :: grlps1(2*maxm,(plat+1)/2) ! ln(ps) - symmetric + real(r8), intent(in) :: grlps2(2*maxm,(plat+1)/2) ! ln(ps) - antisymmetric +! +! symmetric components +! + real(r8), intent(in) :: grt1(2*maxm,plev,(plat+1)/2) ! temperature + real(r8), intent(in) :: grz1(2*maxm,plev,(plat+1)/2) ! vorticity + real(r8), intent(in) :: grd1(2*maxm,plev,(plat+1)/2) ! divergence + real(r8), intent(in) :: grfu1(2*maxm,plev,(plat+1)/2) ! partial u momentum tendency (fu) + real(r8), intent(in) :: grfv1(2*maxm,plev,(plat+1)/2) ! partial v momentum tendency (fv) + real(r8), intent(in) :: grvt1(2*maxm,plev,(plat+1)/2) ! heat flux + real(r8), intent(in) :: grrh1(2*maxm,plev,(plat+1)/2) ! rhs of div eqn (del^2 term) +! +! antisymmetric components +! + real(r8), intent(in) :: grt2(2*maxm,plev,(plat+1)/2) ! temperature + real(r8), intent(in) :: grz2(2*maxm,plev,(plat+1)/2) ! vorticity + real(r8), intent(in) :: grd2(2*maxm,plev,(plat+1)/2) ! divergence + real(r8), intent(in) :: grfu2(2*maxm,plev,(plat+1)/2) ! partial u momentum tend (fu) + real(r8), intent(in) :: grfv2(2*maxm,plev,(plat+1)/2) ! partial v momentum tend (fv) + real(r8), intent(in) :: grvt2(2*maxm,plev,(plat+1)/2) ! heat flux + real(r8), intent(in) :: grrh2(2*maxm,plev,(plat+1)/2) ! rhs of div eqn (del^2 term) +! +!---------------------------Local workspace----------------------------- +! + integer j ! latitude pair index + integer m ! global wavenumber index + integer n ! total wavenumber index + integer ir,ii ! spectral indices + integer lmr,lmc ! spectral indices + integer k ! level index + integer kv ! index for vectorization + + real(r8) zcsj ! cos**2(lat)*radius of earth + real(r8) zrcsj ! 1./(a*cos^2(lat)) + real(r8) zdtrc ! dt/(a*cos^2(lat)) + real(r8) ztdtrc ! 2dt/(a*cos^2(lat)) + real(r8) zw((plat+1)/2) ! 2*w + real(r8) ztdtrw((plat+1)/2) ! 2w*2dt/(a*cos^2(lat)) + real(r8) zwalp ! zw*alp + real(r8) zwdalp ! zw*dalp + real(r8) sqzwalp ! ztdtsq*zw*alp + + real(r8) tmpGR1odd(plev*6,(plat+1)/2) ! temporary space for Fourier coeffs + real(r8) tmpGR2odd(plev*6,(plat+1)/2) ! + real(r8) tmpGR3odd(plev*6,(plat+1)/2) ! + real(r8) tmpGR1evn(plev*6,(plat+1)/2) ! + real(r8) tmpGR2evn(plev*6,(plat+1)/2) ! + real(r8) tmpGR3evn(plev*6,(plat+1)/2) ! + + real(r8) tmpSPEodd(plev*6,2*ptrn) ! temporary space for spectral coeffs + real(r8) tmpSPEevn(plev*6,2*ptrn) ! +! +!----------------------------------------------------------------------- +! +! Compute constants +! +!$OMP PARALLEL DO PRIVATE(J, ZCSJ, ZRCSJ, ZDTRC, ZTDTRC) + do j=1,plat/2 + zcsj = cs(j)*rearth + zrcsj = 1._r8/zcsj + zdtrc = zdt*zrcsj + ztdtrc = 2._r8*zdtrc + zw(j) = w(j)*2._r8 + ztdtrw(j) = ztdtrc*zw(j) + end do +! +! Accumulate contributions to spectral coefficients of ln(p*), the only +! single level field. Use symmetric or antisymmetric fourier cofficients +! depending on whether the total wavenumber is even or odd. +! + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr + do n=1,2*nlen(m) + alps(lmc+n) = 0._r8 + end do +!$OMP PARALLEL DO PRIVATE(N, J, IR, II, ZWALP) + do n=1,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 + do j=1,plat/2 + zwalp = zw(j)*lalp(lmr+n,j) + alps(ir) = alps(ir) + grlps1(2*lm-1,j)*zwalp + alps(ii) = alps(ii) + grlps1(2*lm ,j)*zwalp + end do + end do +!$OMP PARALLEL DO PRIVATE(N, J, IR, II, ZWALP) + do n=2,nlen(m),2 + ir = lmc + 2*n - 1 + ii = ir + 1 + do j=1,plat/2 + zwalp = zw(j)*lalp(lmr+n,j) + alps(ir) = alps(ir) + grlps2(2*lm-1,j)*zwalp + alps(ii) = alps(ii) + grlps2(2*lm ,j)*zwalp + end do + end do +! +! Accumulate contributions to spectral coefficients of the multilevel fields. +! Use symmetric or antisymmetric fourier coefficients depending on whether +! the total wavenumber is even or odd. +! +! +! Initialize temporary storage for spectral coefficients +! + do n=1,nlen(m) + do kv=1,plev*6 + tmpSPEodd(kv,n) = 0._r8 + tmpSPEevn(kv,n) = 0._r8 + end do + end do +! +! Rearrange Fourier coefficients to temporal storage +! +!$OMP PARALLEL DO PRIVATE(J, K) + do j = 1,plat/2 + do k=1,plev + + tmpGR1odd(k ,j) = grt1 (2*lm-1,k,j) ! first term for odd n + tmpGR1odd(k+plev ,j) = grt1 (2*lm ,k,j) + tmpGR1odd(k+plev*2,j) = grd1 (2*lm-1,k,j) + tmpGR1odd(k+plev*3,j) = grd1 (2*lm ,k,j) + tmpGR1odd(k+plev*4,j) = grz1 (2*lm-1,k,j) + tmpGR1odd(k+plev*5,j) = grz1 (2*lm ,k,j) + + tmpGR2odd(k ,j) = grvt2(2*lm-1,k,j) ! second term for odd n + tmpGR2odd(k+plev ,j) = grvt2(2*lm ,k,j) + tmpGR2odd(k+plev*2,j) = -grfv2(2*lm-1,k,j) + tmpGR2odd(k+plev*3,j) = -grfv2(2*lm ,k,j) + tmpGR2odd(k+plev*4,j) = grfu2(2*lm-1,k,j) + tmpGR2odd(k+plev*5,j) = grfu2(2*lm ,k,j) + + tmpGR3odd(k+plev*2,j) = grrh1(2*lm-1,k,j) ! additional term for odd n + tmpGR3odd(k+plev*3,j) = grrh1(2*lm ,k,j) + + tmpGR1evn(k ,j) = grt2 (2*lm-1,k,j) ! first term for even n + tmpGR1evn(k+plev ,j) = grt2 (2*lm ,k,j) + tmpGR1evn(k+plev*2,j) = grd2 (2*lm-1,k,j) + tmpGR1evn(k+plev*3,j) = grd2 (2*lm ,k,j) + tmpGR1evn(k+plev*4,j) = grz2 (2*lm-1,k,j) + tmpGR1evn(k+plev*5,j) = grz2 (2*lm ,k,j) + + tmpGR2evn(k ,j) = grvt1(2*lm-1,k,j) ! first term for even n + tmpGR2evn(k+plev ,j) = grvt1(2*lm ,k,j) + tmpGR2evn(k+plev*2,j) = -grfv1(2*lm-1,k,j) + tmpGR2evn(k+plev*3,j) = -grfv1(2*lm ,k,j) + tmpGR2evn(k+plev*4,j) = grfu1(2*lm-1,k,j) + tmpGR2evn(k+plev*5,j) = grfu1(2*lm ,k,j) + + tmpGR3evn(k+plev*2,j) = grrh2(2*lm-1,k,j) ! additional term for even n + tmpGR3evn(k+plev*3,j) = grrh2(2*lm ,k,j) + + end do + end do +! +! Accumulate first and second terms +! +!$OMP PARALLEL DO PRIVATE(N, J, ZWDALP, ZWALP, KV) + do n=1,nlen(m),2 + do j=1,plat/2 + zwdalp = ztdtrw(j)*ldalp(lmr+n,j) + zwalp = zw(j) *lalp (lmr+n,j) + do kv=1,plev*6 + tmpSPEodd(kv,n) = tmpSPEodd(kv,n) + & + zwalp*tmpGR1odd(kv,j) + zwdalp*tmpGR2odd(kv,j) + end do + end do + end do +!$OMP PARALLEL DO PRIVATE(N, J, ZWDALP, ZWALP, KV) + do n=2,nlen(m),2 + do j=1,plat/2 + zwdalp = ztdtrw(j)*ldalp(lmr+n,j) + zwalp = zw(j) *lalp (lmr+n,j) + do kv=1,plev*6 + tmpSPEevn(kv,n) = tmpSPEevn(kv,n) + & + zwalp*tmpGR1evn(kv,j) + zwdalp*tmpGR2evn(kv,j) + end do + end do + end do +! +! Add additional term for divergence +! +!$OMP PARALLEL DO PRIVATE(N, J, SQZWALP, KV) + do n=1,nlen(m),2 + do j=1,plat/2 + sqzwalp = ztdtsq(n+m-1)*zw(j)*lalp (lmr+n,j) + do kv=plev*2+1,plev*4 + tmpSPEodd(kv,n) = tmpSPEodd(kv,n) + sqzwalp*tmpGR3odd(kv,j) + end do + end do + end do +!$OMP PARALLEL DO PRIVATE(N, J, SQZWALP, KV) + do n=2,nlen(m),2 + do j=1,plat/2 + sqzwalp = ztdtsq(n+m-1)*zw(j)*lalp (lmr+n,j) + do kv=plev*2+1,plev*4 + tmpSPEevn(kv,n) = tmpSPEevn(kv,n) + sqzwalp*tmpGR3evn(kv,j) + end do + end do + end do +! +! Save accumulated results +! +!$OMP PARALLEL DO PRIVATE(N, IR, II, K) + do n=1,nlen(m),2 + ir = lmc+2*n-1 + ii = ir+1 + do k=1,plev + t (ir,k) = tmpSPEodd(k ,n) + t (ii,k) = tmpSPEodd(k+plev ,n) + d (ir,k) = tmpSPEodd(k+plev*2,n) + d (ii,k) = tmpSPEodd(k+plev*3,n) + vz(ir,k) = tmpSPEodd(k+plev*4,n) + vz(ii,k) = tmpSPEodd(k+plev*5,n) + end do + end do +!$OMP PARALLEL DO PRIVATE(N, IR, II, K) + do n=2,nlen(m),2 + ir = lmc+2*n-1 + ii = ir+1 + do k=1,plev + t (ir,k) = tmpSPEevn(k ,n) + t (ii,k) = tmpSPEevn(k+plev ,n) + d (ir,k) = tmpSPEevn(k+plev*2,n) + d (ii,k) = tmpSPEevn(k+plev*3,n) + vz(ir,k) = tmpSPEevn(k+plev*4,n) + vz(ii,k) = tmpSPEevn(k+plev*5,n) + end do + end do +! + return +end subroutine quad diff --git a/src/dynamics/eul/realloc4.F90 b/src/dynamics/eul/realloc4.F90 new file mode 100644 index 0000000000..3a76a1272f --- /dev/null +++ b/src/dynamics/eul/realloc4.F90 @@ -0,0 +1,423 @@ + +!----------------------------------------------------------------------- +! +! Purpose: +! Reallocation routines for the Fourier coefficients +! +! Method: +! 1) After FFT preceding Legendre analysis, reallocate fftbuf +! to decompose over wavenumber, recombining latitudes. +! 2) Before FFT following Legendre synthesis, reallocate fftbuf +! to recombine wavenumbers, decomposing over latitude. +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- +subroutine realloc4a(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Reallocation routines for the Fourier coefficients +! +! Method: +! After FFT preceding Legendre analysis, reallocate fftbuf +! to decompose over wavenumber, combining latitudes. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, Oct 1995 +! J. Truesdale, Feb. 1996 +! Modified: P. Worley, September 2002, December 2003, +! October 2004, April 2007 +! +!----------------------------------------------------------------------- + +#ifdef SPMD + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use spmd_dyn + use mpishorthand + use spmd_utils, only : iam, npes, altalltoallv +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Parameters------------------------------- +! + integer, parameter :: msgtag = 1000 +!---------------------------Input arguments----------------------------- +! + integer, intent(in) :: nlon_fft_in ! first dimension of input array + integer, intent(in) :: nlon_fft_out ! first dimension of output array + real(r8), intent(in) :: fftbuf_in(nlon_fft_in,9,plev,beglat:endlat) + ! buffer used for in-place FFTs + real(r8), intent(out) :: fftbuf_out(nlon_fft_out,9,plev,plat) + ! buffer used for reordered Fourier coefficients +! +!---------------------------Local workspace----------------------------- +! +! xxx_l: local decomposition +! xxx_r: remote decomposition + integer :: procid + integer :: length_r, length_l + integer :: bpos + integer :: step, ifld, k, i + integer :: lat_l, lat_r, beglat_r, endlat_r +! + logical, save :: first = .true. + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: sndcnts_act(:), sdispls_act(:) + integer, allocatable, save :: rcvcnts_act(:), rdispls_act(:) + integer, allocatable, save :: pdispls(:) +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv/put counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! + sndcnts(:) = 0 + do step=1,realloc4_steps + procid = realloc4_proc(step) + length_r = 2*numm(procid) + sndcnts(procid) = length_r*(plev*8 + 1)*numlats + enddo +! + sdispls(0) = 0 + do procid=1,npes-1 + sdispls(procid) = sdispls(procid-1) + sndcnts(procid-1) + enddo +! + length_l = 2*numm(iam) + rcvcnts(:) = 0 + do step=1,realloc4_steps + procid = realloc4_proc(step) + rcvcnts(procid) = length_l*(plev*8 + 1)*nlat_p(procid) + enddo +! + rdispls(0) = 0 + do procid=1,npes-1 + rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) + enddo +! + pdispls(:) = 0 + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! + allocate(sndcnts_act(0:dyn_npes-1)) + allocate(sdispls_act(0:dyn_npes-1)) + allocate(rcvcnts_act(0:dyn_npes-1)) + allocate(rdispls_act(0:dyn_npes-1)) +! + do procid=0,dyn_npes-1 + sndcnts_act(procid) = sndcnts(procid*dyn_npes_stride) + sdispls_act(procid) = sdispls(procid*dyn_npes_stride) + enddo +! + do procid=0,dyn_npes-1 + rcvcnts_act(procid) = rcvcnts(procid*dyn_npes_stride) + rdispls_act(procid) = rdispls(procid*dyn_npes_stride) + enddo +! + first = .false. + endif +! +! Copy local data to new location + length_l = 2*numm(iam) + do lat_l=beglat,endlat +!$OMP PARALLEL DO PRIVATE(K, IFLD, I) + do k=1,plev + do ifld=1,8 + do i=1,length_l + fftbuf_out(i,ifld,k,lat_l) = fftbuf_in(locrm(i,iam),ifld,k,lat_l) + enddo + enddo + enddo + do i=1,length_l + fftbuf_out(i,9,1,lat_l) = fftbuf_in(locrm(i,iam),9,1,lat_l) + enddo + enddo +! +! Fill message buffer +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, LENGTH_R, BPOS, LAT_L, IFLD, K, I) + do step=1,realloc4_steps + procid = realloc4_proc(step) + length_r = 2*numm(procid) +! + bpos = sdispls(procid) + do lat_l=beglat,endlat + do k=1,plev + do ifld=1,8 + do i=1,length_r + buf1(bpos+i) = fftbuf_in(locrm(i,procid),ifld,k,lat_l) + enddo + bpos = bpos+length_r + enddo + enddo + do i=1,length_r + buf1(bpos+i) = fftbuf_in(locrm(i,procid),9,1,lat_l) + enddo + bpos = bpos+length_r + enddo + enddo +! +! Get remote data +! + if (dyn_alltoall .eq. 0) then + if (beglat <= endlat) then + call mpialltoallv(buf1, sndcnts_act, sdispls_act, mpir8, & + buf2, rcvcnts_act, rdispls_act, mpir8, & + mpicom_dyn_active) + endif + else + call altalltoallv(dyn_alltoall, iam, npes, & + realloc4_steps, realloc4_proc, & + buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & + buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, buf2win, mpicom) + endif +! +! Copy out of message buffers +! +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_R, ENDLAT_R, BPOS, LAT_R, IFLD, K, I) + do step=1,realloc4_steps + procid = realloc4_proc(step) + beglat_r = cut(1,procid) + endlat_r = cut(2,procid) + bpos = rdispls(procid) + do lat_r=beglat_r,endlat_r + do k=1,plev + do ifld=1,8 + do i=1,length_l + fftbuf_out(i,ifld,k,lat_r) = buf2(bpos+i) + enddo + bpos = bpos+length_l + enddo + enddo + do i=1,length_l + fftbuf_out(i,9,1,lat_r) = buf2(bpos+i) + enddo + bpos = bpos+length_l + enddo +! + end do +#endif + return + end subroutine realloc4a + +subroutine realloc4b(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Reallocation routines for the Fourier coefficients +! +! Method: +! Before FFT following Legendre synthesis, reallocate fftbuf +! to combine wavenumbers, decomposing over latitude. +! +! Author: P. Worley, September 2002 +! Modified: P. Worley, December 2003, October 2004 +! +!----------------------------------------------------------------------- + +#ifdef SPMD + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use spmd_dyn + use mpishorthand + use spmd_utils, only : iam, npes, altalltoallv + +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Parameters------------------------------- +! + integer, parameter :: msgtag = 2000 +!---------------------------Input arguments-------------------------- +! + integer, intent(in) :: nlon_fft_in ! first dimension of input array + integer, intent(in) :: nlon_fft_out ! first dimension of output array + real(r8), intent(in) :: fftbuf_in(nlon_fft_in,8,plevp,plat) + ! buffer of Fourier coefficients to be reordered + real(r8), intent(out) :: fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) + ! buffer used for in-place FFTs +! +!---------------------------Local workspace----------------------------- +! +! xxx_l: local decomposition +! xxx_r: remote decomposition + integer :: procid + integer :: length_r, length_l + integer :: bpos + integer :: step, ifld, k, i + integer :: lat_l, lat_r + integer :: beglat_r, endlat_r +! + logical, save :: first = .true. + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: sndcnts_act(:), sdispls_act(:) + integer, allocatable, save :: rcvcnts_act(:), rdispls_act(:) + integer, allocatable, save :: pdispls(:) +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! + length_l = 2*numm(iam) + sndcnts(:) = 0 + do step=1,realloc4_steps + procid = realloc4_proc(step) + sndcnts(procid) = length_l*(8*plev + 4)*nlat_p(procid) + enddo +! + sdispls(0) = 0 + do procid=1,npes-1 + sdispls(procid) = sdispls(procid-1) + sndcnts(procid-1) + enddo +! + rcvcnts(:) = 0 + do step=1,realloc4_steps + procid = realloc4_proc(step) + length_r = 2*numm(procid) + rcvcnts(procid) = length_r*(8*plev + 4)*numlats + enddo +! + rdispls(0) = 0 + do procid=1,npes-1 + rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) + enddo +! + pdispls(:) = 0 + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! + allocate(sndcnts_act(0:dyn_npes-1)) + allocate(sdispls_act(0:dyn_npes-1)) + allocate(rcvcnts_act(0:dyn_npes-1)) + allocate(rdispls_act(0:dyn_npes-1)) +! + do procid=0,dyn_npes-1 + sndcnts_act(procid) = sndcnts(procid*dyn_npes_stride) + sdispls_act(procid) = sdispls(procid*dyn_npes_stride) + enddo +! + do procid=0,dyn_npes-1 + rcvcnts_act(procid) = rcvcnts(procid*dyn_npes_stride) + rdispls_act(procid) = rdispls(procid*dyn_npes_stride) + enddo +! + first = .false. + endif +! +! Copy local data to new location + length_l = 2*numm(iam) + do lat_l=beglat,endlat +!$OMP PARALLEL DO PRIVATE(K, IFLD, I) + do k=1,plev + do ifld=1,8 + do i=1,length_l + fftbuf_out(locrm(i,iam),ifld,k,lat_l) = fftbuf_in(i,ifld,k,lat_l) + enddo + enddo + enddo +! +!$OMP PARALLEL DO PRIVATE(IFLD, I) + do ifld=1,4 + do i=1,length_l + fftbuf_out(locrm(i,iam),ifld,plevp,lat_l) = fftbuf_in(i,ifld,plevp,lat_l) + enddo + enddo + enddo +! +! Fill message buffer +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_R, ENDLAT_R, BPOS, LAT_R, K, IFLD, I) + do step=1,realloc4_steps + procid = realloc4_proc(step) + beglat_r = cut(1,procid) + endlat_r = cut(2,procid) + bpos = sdispls(procid) +! + do lat_r=beglat_r,endlat_r + do k=1,plev + do ifld=1,8 + do i=1,length_l + buf1(bpos+i) = fftbuf_in(i,ifld,k,lat_r) + enddo + bpos = bpos+length_l + enddo + enddo + do ifld=1,4 + do i=1,length_l + buf1(bpos+i) = fftbuf_in(i,ifld,plevp,lat_r) + enddo + bpos = bpos+length_l + enddo + enddo + enddo +! +! Get remote data +! + if (dyn_alltoall .eq. 0) then + if (beglat <= endlat) then + call mpialltoallv(buf1, sndcnts_act, sdispls_act, mpir8, & + buf2, rcvcnts_act, rdispls_act, mpir8, & + mpicom_dyn_active) + endif + else + call altalltoallv(dyn_alltoall, iam, npes, & + realloc4_steps, realloc4_proc, & + buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & + buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, buf2win, mpicom) + endif +! +! Copy out of message buffers +! +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, LENGTH_R, BPOS, LAT_L, K, IFLD, I) + do step=1,realloc4_steps + procid = realloc4_proc(step) + length_r = 2*numm(procid) + bpos = rdispls(procid) + + do lat_l=beglat,endlat + do k=1,plev + do ifld=1,8 + do i=1,length_r + fftbuf_out(locrm(i,procid),ifld,k,lat_l) = buf2(bpos+i) + enddo + bpos = bpos+length_r + enddo + enddo + + do ifld=1,4 + do i=1,length_r + fftbuf_out(locrm(i,procid),ifld,plevp,lat_l) = buf2(bpos+i) + enddo + bpos = bpos+length_r + enddo + + enddo +! + end do +#endif + return + end subroutine realloc4b + diff --git a/src/dynamics/eul/realloc7.F90 b/src/dynamics/eul/realloc7.F90 new file mode 100644 index 0000000000..1adc399b9f --- /dev/null +++ b/src/dynamics/eul/realloc7.F90 @@ -0,0 +1,213 @@ + +subroutine realloc7 (vmax2d, vmax2dt, vcour) + +!----------------------------------------------------------------------- +! +! Purpose: Reallocation routine for energy and log stats +! +! Method: MPI_Allgatherv (or point-to-point implementation) +! +! Author: J. Rosinski +! Modified: P. Worley, September 2002, December 2003, October 2004 +! +!----------------------------------------------------------------------- + +#ifdef SPMD + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, numlats, beglat, endlat + use mpishorthand + use spmd_dyn + use spmd_utils, only : iam, npes, altalltoallv +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +#include +!------------------------------Parameters------------------------------- +! + integer, parameter :: msgtag = 3000 +!---------------------------Input arguments----------------------------- +! + real(r8), intent(inout) :: vmax2d(plev,plat) ! Max. wind at each lvl, lat + real(r8), intent(inout) :: vmax2dt(plev,plat) ! Max. truncated wind at each lvl, lat + real(r8), intent(inout) :: vcour(plev,plat) ! Max. Courant number at each lvl, lat +! +!---------------------------Local workspace----------------------------- +! + integer procid + integer bufpos + integer procj + integer step, j, k, jstrt + integer beglat_p, endlat_p, numlats_p, jstrt_p +! + logical, save :: first = .true. + integer, save :: sndcnt + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: pdispls(:) +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv/put counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! +! Compute send count + sndcnt = (plev*3 + 5)*numlats + sndcnts(:) = 0 + do step=1,allgather_steps + procid = allgather_proc(step) + sndcnts(procid) = sndcnt + enddo +! + sdispls(0) = 0 + do procid=1,npes-1 + sdispls(procid) = 0 + enddo +! +! Compute recv counts and displacements + rcvcnts(:) = 0 + do step=1,allgather_steps + procid = allgather_proc(step) + rcvcnts(procid) = (plev*3 + 5)*nlat_p(procid) + enddo + rcvcnts(iam) = (plev*3 + 5)*numlats +! + rdispls(0) = 0 + do procid=1,npes-1 + rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) + enddo +! + pdispls(:) = 0 + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! + first = .false. + endif +! +! Fill send buffer + jstrt = beglat - 1 + bufpos = 0 +! psurf + do j=1,numlats + buf1(bufpos+j) = psurf(jstrt+j) + enddo + bufpos = bufpos + numlats +! stq + do j=1,numlats + buf1(bufpos+j) = stq(jstrt+j) + enddo + bufpos = bufpos + numlats +! rmst + do j=1,numlats + buf1(bufpos+j) = rmst(jstrt+j) + enddo + bufpos = bufpos + numlats +! rmsd + do j=1,numlats + buf1(bufpos+j) = rmsd(jstrt+j) + enddo + bufpos = bufpos + numlats +! rmsz + do j=1,numlats + buf1(bufpos+j) = rmsz(jstrt+j) + enddo + bufpos = bufpos + numlats +!vmax2d + do j=beglat,endlat + do k=1,plev + buf1(bufpos+k) = vmax2d(k,j) + enddo + bufpos = bufpos + plev + enddo +! vmax2dt + do j=beglat,endlat + do k=1,plev + buf1(bufpos+k) = vmax2dt(k,j) + enddo + bufpos = bufpos + plev + enddo +! vcour + do j=beglat,endlat + do k=1,plev + buf1(bufpos+k) = vcour(k,j) + enddo + bufpos = bufpos + plev + enddo +! +! Gather the data +! + if (dyn_allgather .eq. 0) then + call mpiallgatherv(buf1, sndcnt, mpir8, & + buf2, rcvcnts, rdispls, mpir8, & + mpicom) + else + call altalltoallv(dyn_allgather, iam, npes, & + allgather_steps, allgather_proc, & + buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & + buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, buf2win, mpicom) + endif +! +! Copy out of message buffers +! +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_P, ENDLAT_P, NUMLATS_P, JSTRT_P, BUFPOS, J, K) + do step=1,allgather_steps + procid = allgather_proc(step) + beglat_p = cut(1,procid) + endlat_p = cut(2,procid) + numlats_p = nlat_p(procid) + bufpos = rdispls(procid) +! psurf + jstrt_p = beglat_p - 1 + do j=1,numlats_p + psurf(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! stq + do j=1,numlats_p + stq(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! rmst + do j=1,numlats_p + rmst(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! rmsd + do j=1,numlats_p + rmsd(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! rmsz + do j=1,numlats_p + rmsz(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! vmax2d + do j=beglat_p,endlat_p + do k=1,plev + vmax2d(k,j) = buf2(bufpos+k) + enddo + bufpos = bufpos + plev + enddo +! vmax2dt + do j=beglat_p,endlat_p + do k=1,plev + vmax2dt(k,j) = buf2(bufpos+k) + enddo + bufpos = bufpos + plev + enddo +! vcour + do j=beglat_p,endlat_p + do k=1,plev + vcour(k,j) = buf2(bufpos+k) + enddo + bufpos = bufpos + plev + enddo +! + enddo +#endif + return +end subroutine realloc7 + diff --git a/src/dynamics/eul/restart_dynamics.F90 b/src/dynamics/eul/restart_dynamics.F90 new file mode 100644 index 0000000000..348c2aa26c --- /dev/null +++ b/src/dynamics/eul/restart_dynamics.F90 @@ -0,0 +1,557 @@ +module restart_dynamics + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pio, only : var_desc_t, file_desc_t, pio_double, pio_unlimited, pio_def_var, & + pio_def_dim, io_desc_t, pio_offset_kind, pio_put_var, pio_write_darray, & + pio_setdebuglevel,pio_setframe, pio_initdecomp, pio_freedecomp, & + pio_read_darray, pio_inq_varid, pio_get_var + use prognostics, only: u3, v3, t3, q3, & + pdeld, ps, vort, div, & + dps, phis, dpsl, dpsm, omga, ptimelevels + use scanslt, only: lammp, phimp, sigmp, qfcst +#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only: dqfx3sav,divq3dsav,divt3dsav,t2sav,betasav,fusav,fvsav +#endif + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + implicit none + private + save + public :: read_restart_dynamics, init_restart_dynamics, write_restart_dynamics + + integer, parameter :: namlen=16 + + type restart_var_t + real(r8), pointer :: v1d(:) => null() + real(r8), pointer :: v2d(:,:) => null() + real(r8), pointer :: v3d(:, :, :) => null() + real(r8), pointer :: v4d(:, :, :, :) => null() + real(r8), pointer :: v5d(:, :, :, :, :) => null() + + type(var_desc_t), pointer :: vdesc => null() + integer :: ndims + integer :: timelevels + character(len=namlen) :: name + end type restart_var_t +#if ( defined BFB_CAM_SCAM_IOP ) + integer, parameter :: restartvarcnt = 24 +#else + integer, parameter :: restartvarcnt = 17 +#endif + type(var_desc_t) :: timedesc, tmass0desc, fixmasdesc, hw1desc, hw2desc, hw3desc, alphadesc + + type(restart_var_t) :: restartvars(restartvarcnt) + logical :: restart_varlist_initialized=.false. + +CONTAINS + + subroutine set_r_var(name, timelevels, index, v1, v2, v3, v4, v5) + use cam_abortutils, only: endrun + + character(len=*), intent(in) :: name + integer, intent(in) :: timelevels, index + real(r8), target, optional :: v1(:), v2(:,:), v3(:,:,:), v4(:,:,:,:), v5(:,:,:,:,:) + + restartvars(index)%name=name + restartvars(index)%timelevels = timelevels + if(present(v1)) then + restartvars(index)%ndims = 1 + restartvars(index)%v1d => v1 + else if(present(v2)) then + restartvars(index)%ndims = 2 + restartvars(index)%v2d => v2 + else if(present(v3)) then + restartvars(index)%ndims = 3 + restartvars(index)%v3d => v3 + else if(present(v4)) then + restartvars(index)%ndims = 4 + restartvars(index)%v4d => v4 + else if(present(v5)) then + restartvars(index)%ndims = 5 + restartvars(index)%v5d => v5 + else + call endrun('bad ndims in call to set_r_var') + end if + allocate(restartvars(index)%vdesc) + + end subroutine set_r_var + + subroutine init_restart_varlist() + use cam_abortutils, only: endrun + + + integer :: vcnt=1 + integer :: i + + +! Should only be called once + if(restart_varlist_initialized) return + restart_varlist_initialized=.true. + call set_r_var('VORT', ptimelevels, vcnt, v4=vort) + + vcnt=vcnt+1 + call set_r_var('DIV', ptimelevels, vcnt, v4=div) + + vcnt=vcnt+1 + call set_r_var('DPSL', 1, vcnt, v2=dpsl) + + vcnt=vcnt+1 + call set_r_var('DPSM', 1, vcnt, v2=dpsm) + + vcnt=vcnt+1 + call set_r_var('DPS', 1, vcnt, v2=dps) + + vcnt=vcnt+1 + call set_r_var('PHIS', 1, vcnt, v2=phis) + + vcnt=vcnt+1 + call set_r_var('OMEGA', 1, vcnt, v3=omga) + + vcnt=vcnt+1 + call set_r_var('U', ptimelevels, vcnt, v4=u3) + + vcnt=vcnt+1 + call set_r_var('V', ptimelevels, vcnt, v4=v3) + + vcnt=vcnt+1 + call set_r_var('T', ptimelevels, vcnt, v4=t3) + + vcnt=vcnt+1 + call set_r_var('PS', ptimelevels, vcnt, v3=ps) + + vcnt=vcnt+1 + call set_r_var( 'Q', ptimelevels, vcnt, v5=Q3 ) + + vcnt=vcnt+1 + call set_r_var('PDELD', ptimelevels, vcnt, v4=pdeld ) + + + vcnt=vcnt+1 + call set_r_var('LAMMP', 1, vcnt, v3=lammp ) + vcnt=vcnt+1 + call set_r_var('PHIMP', 1, vcnt, v3=phimp ) + vcnt=vcnt+1 + call set_r_var('SIGMP', 1, vcnt, v3=sigmp ) + + vcnt=vcnt+1 + call set_r_var('Q_fcst', 1, vcnt, v4=qfcst ) + + +#if ( defined BFB_CAM_SCAM_IOP ) +! +! Write scam values +! + vcnt=vcnt+1 + call set_r_var('DQFX', 1, vcnt, v4=dqfx3sav ) + + vcnt=vcnt+1 + call set_r_var('DIVQ', 1, vcnt, v4=divq3dsav ) + + vcnt=vcnt+1 + call set_r_var('DIVT', 1, vcnt, v3=divt3dsav ) + + vcnt=vcnt+1 + call set_r_var('T2', 1, vcnt, v3=t2sav ) + + vcnt=vcnt+1 + call set_r_var('FU', 1, vcnt, v3=fusav ) + + vcnt=vcnt+1 + call set_r_var('FV', 1, vcnt, v3=fvsav ) + + vcnt=vcnt+1 + call set_r_var('BETA', 1, vcnt, v1=betasav ) + +#endif + + if(vcnt.ne.restartvarcnt) then + write(iulog,*) 'vcnt= ',vcnt, ' restartvarcnt=',restartvarcnt + call endrun('bad restartvarcnt') + end if + + end subroutine init_restart_varlist + + + +subroutine init_restart_dynamics(File, dyn_out) + + use dyn_comp, only: dyn_export_t + use constituents, only: pcnst + use hycoef, only: init_restart_hycoef + use cam_grid_support, only: cam_grid_write_attr, cam_grid_id + use cam_grid_support, only: cam_grid_header_info_t + + ! Input arguments + type(File_desc_t), intent(inout) :: File + type(Dyn_export_t), intent(in) :: dyn_out + + integer :: hdimids(2) + integer :: vdimids(2) + character(len=namlen) :: name + + integer :: alldims(4), alldims2d(3), qdims(5) + integer :: timelevels_dimid, i, ierr + type(var_desc_t), pointer :: vdesc + integer :: grid_id + integer :: ndims, timelevels + type(cam_grid_header_info_t) :: info + + call init_restart_hycoef(File, vdimids) + + ! Grid attributes + grid_id = cam_grid_id('gauss_grid') + call cam_grid_write_attr(File, grid_id, info) + hdimids(1) = info%get_hdimid(1) + hdimids(2) = info%get_hdimid(2) + + ierr = PIO_Def_Dim(File,'timelevels',PIO_UNLIMITED,timelevels_dimid) + + ierr = PIO_Def_Dim(File,'pcnst',pcnst, qdims(4)) + + ierr = PIO_Def_Var(File, 'time', pio_double, (/timelevels_dimid/), timedesc) + + ierr = PIO_Def_var(File, 'tmass0', pio_double, tmass0desc) + ierr = PIO_Def_var(File, 'fixmas', pio_double, fixmasdesc) + ierr = PIO_Def_var(File, 'hw1', pio_double, qdims(4:4), hw1desc) + ierr = PIO_Def_var(File, 'hw2', pio_double, qdims(4:4), hw2desc) + ierr = PIO_Def_var(File, 'hw3', pio_double, qdims(4:4), hw3desc) + ierr = PIO_Def_var(File, 'alpha', pio_double, qdims(4:4), alphadesc) + + + + + alldims(1:2) = hdimids(1:2) + alldims(3) = vdimids(1) + alldims(4) = timelevels_dimid + + alldims2d(1:2) = hdimids(1:2) + alldims2d(3) = timelevels_dimid + + qdims(1:2) = hdimids(1:2) + qdims(3) = vdimids(1) + qdims(5) = timelevels_dimid + + call init_restart_varlist() + + do i=1,restartvarcnt + + call get_restart_var(i, name, timelevels, ndims, vdesc) + if(timelevels>1) then + if(ndims==3) then + ierr = PIO_Def_Var(File, name, pio_double, alldims2d, vdesc) + else if(ndims==4) then + ierr = PIO_Def_Var(File, name, pio_double, alldims, vdesc) + else if(ndims==5) then + ierr = PIO_Def_Var(File, name, pio_double, qdims, vdesc) + end if + else + if(ndims==1) then +! broken i think + ierr = PIO_Def_Var(File, name, pio_double, hdimids(2:2), vdesc) + else if(ndims==2) then + ierr = PIO_Def_Var(File, name, pio_double, alldims2d(1:2), vdesc) + else if(ndims==3) then + ierr = PIO_Def_Var(File, name, pio_double, alldims(1:3), vdesc) + else if(ndims==4) then + ierr = PIO_Def_Var(File, name, pio_double, qdims(1:4), vdesc) + end if + end if + end do + + + end subroutine init_restart_dynamics + + + subroutine write_restart_dynamics (File, dyn_out) + use cam_pio_utils, only : pio_subsystem + use dyn_comp, only : dyn_export_t + use time_manager, only: get_curr_time, get_step_size + use prognostics, only: ptimelevels, n3m2, n3m1, n3 + use pmgrid, only: plon, plat + use ppgrid, only: pver + use massfix, only: alpha, hw1, hw2, hw3 + use constituents, only: pcnst + use eul_control_mod, only: fixmas, tmass0 + use hycoef, only: write_restart_hycoef + use cam_grid_support, only: cam_grid_write_var + use dyn_grid, only: dyn_decomp + + + ! + ! Input arguments + ! + type(File_desc_t), intent(inout) :: File ! Unit number + type(Dyn_export_t), intent(in) :: dyn_out ! Not used in eul dycore + + ! + ! Local workspace + ! + integer :: ierr ! error status + integer :: ndcur, nscur + real(r8) :: time, dtime, mold(1) + integer :: i, s3d(1), s2d(1), ct + integer(kind=pio_offset_kind) :: t + type(io_desc_t) :: iodesc4d, iodesc3d, iodesc2d + integer, pointer :: ldof(:) + integer :: ndims, timelevels + type(var_desc_t), pointer :: vdesc + character(len=namlen) :: name + ! + + ! Write grid vars + call cam_grid_write_var(File, dyn_decomp) + + call write_restart_hycoef(File) + + call get_curr_time(ndcur, nscur) + dtime = get_step_size() + + ldof => get_restart_decomp(plon, plat, pver) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver/), ldof, iodesc3d) + deallocate(ldof) + + ldof => get_restart_decomp(plon, plat, pver*pcnst) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver,pcnst/), ldof, iodesc4d) + deallocate(ldof) + + ldof => get_restart_decomp(plon, plat, 1) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat/), ldof, iodesc2d) + deallocate(ldof) + + ierr = pio_put_var(File, tmass0desc, (/tmass0/)) + ierr = pio_put_var(File, fixmasdesc, (/fixmas/)) + + ierr = pio_put_var(File, hw1desc, hw1) + ierr = pio_put_var(File, hw2desc, hw2) + ierr = pio_put_var(File, hw3desc, hw3) + ierr = pio_put_var(File, alphadesc, alpha) + + + do t=1,ptimelevels + time = ndcur+(real(nscur,kind=r8)+ (t-2)*dtime)/86400._r8 + ierr = pio_put_var(File,timedesc%varid, (/int(t)/), time) + end do + do i=1,restartvarcnt + call get_restart_var(i, name, timelevels, ndims, vdesc) + if(timelevels==1) then + if(ndims==2) then + call pio_write_darray(File, vdesc, iodesc2d, transfer(restartvars(i)%v2d(:,:), mold), ierr) + else if(ndims==3) then + call pio_write_darray(File, vdesc, iodesc3d, transfer(restartvars(i)%v3d(:,:,:), mold), ierr) + else if(ndims==4) then + call pio_write_darray(File, vdesc, iodesc4d, transfer(restartvars(i)%v4d(:,:,:,:), mold), ierr) + end if + else + do t=1,timelevels + if(t==1) ct=n3m2 + if(t==2) ct=n3m1 + if(t==3) ct=n3 + + call pio_setframe(File, vdesc, t) + if(ndims==3) then + call pio_write_darray(File, vdesc, iodesc2d, transfer(restartvars(i)%v3d(:,:,ct), mold), ierr) + else if(ndims==4) then + call pio_write_darray(File, vdesc, iodesc3d, transfer(restartvars(i)%v4d(:,:,:,ct), mold), ierr) + else if(ndims==5) then + call pio_write_darray(File, vdesc, iodesc4d, transfer(restartvars(i)%v5d(:,:,:,:,ct), mold), ierr) + end if + + end do + + end if + end do + call pio_freedecomp(File, iodesc2d) + call pio_freedecomp(File, iodesc3d) + call pio_freedecomp(File, iodesc4d) + + return + end subroutine write_restart_dynamics + + subroutine get_restart_var(i,name, timelevels, ndims, vdesc) + integer, intent(in) :: i + character(len=namlen), intent(out) :: name + integer, intent(out) :: ndims, timelevels + type(var_desc_t), pointer :: vdesc + + name = restartvars(i)%name + timelevels = restartvars(i)%timelevels + ndims = restartvars(i)%ndims + if(.not.associated(restartvars(i)%vdesc)) then + allocate(restartvars(i)%vdesc) + end if + vdesc => restartvars(i)%vdesc + + end subroutine get_restart_var + + !####################################################################### + + subroutine read_restart_dynamics (File, dyn_in, dyn_out) + + use dyn_comp, only : dyn_init, dyn_import_t, dyn_export_t + use cam_pio_utils, only : pio_subsystem + + use pmgrid, only: plon, plat, beglat, endlat + use ppgrid, only: pver + +#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only: init_iop_fields +#endif + use massfix, only: alpha, hw1, hw2, hw3 + use prognostics, only: n3m2, n3m1, n3 + + use constituents, only: pcnst + use eul_control_mod, only: fixmas, tmass0 + + ! + ! Input arguments + ! + type(file_desc_t), intent(inout) :: File ! PIO file handle + type(dyn_import_t), intent(out) :: dyn_in + type(dyn_export_t), intent(out) :: dyn_out + ! + ! Local workspace + ! + type(io_desc_t) :: iodesc4d, iodesc3d, iodesc2d + integer, pointer :: ldof(:) + integer :: ioerr ! error status + real(r8), allocatable :: tmp(:) + ! + integer :: dims3d(3), dims2d(2), dims4d(4) + integer :: ierr, ct + integer(kind=pio_offset_kind) :: t + character(len=namlen) :: name + integer :: ndims, timelevels, i, s2d, s3d, s4d + type(var_desc_t), pointer :: vdesc + + call dyn_init(dyn_in, dyn_out) + + dims4d(1) = plon + dims4d(2) = pver + dims4d(3) = pcnst + dims4d(4) = endlat-beglat+1 + s4d=dims4d(1)*dims4d(2)*dims4d(3)*dims4d(4) + dims3d(1) = plon + dims3d(2) = pver + dims3d(3) = endlat-beglat+1 + s3d=dims3d(1)*dims3d(2)*dims3d(3) + dims2d(1) = plon + dims2d(2) = dims3d(3) + s2d=dims2d(1)*dims2d(2) + + allocate(tmp(s4d)) + + ldof => get_restart_decomp(plon, plat, pver*pcnst) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver,pcnst/), ldof, iodesc4d) + deallocate(ldof) + ldof => get_restart_decomp(plon, plat, pver) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver/), ldof, iodesc3d) + deallocate(ldof) + ldof => get_restart_decomp(plon, plat, 1) + call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat/), ldof, iodesc2d) + deallocate(ldof) + + ierr = PIO_Inq_varid(File, 'tmass0', tmass0desc) + ierr = pio_get_var(File, tmass0desc, tmass0) + ierr = PIO_Inq_varid(File,'fixmas', fixmasdesc) + ierr = pio_get_var(File, fixmasdesc, fixmas) + + ierr = PIO_Inq_varid(File, 'hw1', hw1desc) + ierr = pio_get_var(File, hw1desc, hw1) + ierr = PIO_Inq_varid(File, 'hw2', hw2desc) + ierr = pio_get_var(File, hw2desc, hw2) + ierr = PIO_Inq_varid(File, 'hw3', hw3desc) + ierr = pio_get_var(File, hw3desc, hw3) + ierr = PIO_Inq_varid(File,'alpha', alphadesc) + ierr = pio_get_var(File, alphadesc, alpha) + + call init_restart_varlist() + +#if ( defined BFB_CAM_SCAM_IOP ) + call init_iop_fields() +#endif + do i=1,restartvarcnt + call get_restart_var(i, name, timelevels, ndims, vdesc) + + + ierr = PIO_Inq_varid(File, name, vdesc) + if(timelevels == 1) then + if(ndims==2) then + call pio_read_darray(File, vdesc, iodesc2d, tmp(1:s2d), ierr) + restartvars(i)%v2d(:,:) = reshape(tmp(1:s2d), dims2d) + else if(ndims==3) then + call pio_read_darray(File, restartvars(i)%vdesc, iodesc3d, tmp(1:s3d), ierr) + restartvars(i)%v3d(:,:,:) = reshape(tmp(1:s3d), dims3d) + else if(ndims==4) then + call pio_read_darray(File, restartvars(i)%vdesc, iodesc4d, tmp, ierr) + restartvars(i)%v4d(:,:,:,:) = reshape(tmp, dims4d) + end if + + else + do t=1,timelevels + if(t==1) ct=n3m2 + if(t==2) ct=n3m1 + if(t==3) ct=n3 + call pio_setframe(File, vdesc, t) + if(ndims==3) then + call pio_read_darray(File, vdesc, iodesc2d, tmp(1:s2d), ierr) + restartvars(i)%v3d(:,:,ct) = reshape(tmp(1:s2d), dims2d) + else if(ndims==4) then + call pio_read_darray(File, vdesc, iodesc3d, tmp(1:s3d), ierr) + restartvars(i)%v4d(:,:,:,ct) = reshape(tmp(1:s3d), dims3d) + else if(ndims==5) then + call pio_read_darray(File, vdesc, iodesc4d, tmp, ierr) + restartvars(i)%v5d(:,:,:,:,ct) = reshape(tmp, dims4d) + end if + + end do + end if + end do + deallocate(tmp) + call pio_freedecomp(File, iodesc2d) + call pio_freedecomp(File, iodesc3d) + call pio_freedecomp(File, iodesc4d) + + return + + end subroutine read_restart_dynamics + function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) + use dyn_grid, only : get_dyn_grid_parm + + integer, intent(in) :: hdim1, hdim2, nlev + integer, pointer :: ldof(:) + integer :: i, k, j + integer :: lcnt + integer, allocatable :: gcols(:) + + integer :: beglatxy, beglonxy, endlatxy, endlonxy, plat + + + beglonxy = get_dyn_grid_parm('beglonxy') + endlonxy = get_dyn_grid_parm('endlonxy') + beglatxy = get_dyn_grid_parm('beglatxy') + endlatxy = get_dyn_grid_parm('endlatxy') + + plat = get_dyn_grid_parm('plat') + + + lcnt=(endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) + + allocate(ldof(lcnt)) + lcnt=0 + ldof(:)=0 + do j=beglatxy,endlatxy + do k=1,nlev + do i=beglonxy, endlonxy + lcnt=lcnt+1 + ldof(lcnt)=i+(j-(plat-hdim2+1))*hdim1+(k-1)*hdim1*hdim2 + end do + end do + end do + + end function get_restart_decomp + + + + +end module restart_dynamics diff --git a/src/dynamics/eul/scan2.F90 b/src/dynamics/eul/scan2.F90 new file mode 100644 index 0000000000..a282a92058 --- /dev/null +++ b/src/dynamics/eul/scan2.F90 @@ -0,0 +1,774 @@ +!----------------------------------------------------------------------- +module scan2 +!----------------------------------------------------------------------- +! +! Purpose: Module for second gaussian latitude scan, to convert from +! spectral coefficients to grid point values. +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon, beglat, endlat, plevp + use constituents, only: pcnst + use scmforecast, only: forecast + use perf_mod +!----------------------------------------------------------------------- + implicit none +! +! By default everything is private to this module +! + private +! +! Public interfaces +! + public scan2run ! Public run method + +! +! Private module data +! + integer, parameter :: plondfft = plon + 2 + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +! +!----------------------------------------------------------------------- +! + +subroutine scan2run (ztodt, cwava, etamid,t2 ,fu ,fv ) +!----------------------------------------------------------------------- +! +! Purpose: +! Second gaussian latitude scan, converts from spectral coefficients to +! grid point values, from poles to equator, with read/calculate/write cycle. +! +! Method: +! The latitude pair loop in this routine is multitasked. +! +! The grid point values of ps, t, u, v, z (vorticity), and d (divergence) +! are calculated and stored for each latitude from the spectral coefficients. +! In addition, the pressure-surface corrections to the horizontal diffusion +! are applied and the global integrals of the constituent fields are +! computed for the mass fixer. +! +! Author: +! Original version: CCM1 +! +!----------------------------------------------------------------------- + use prognostics, only: ps, u3, v3, q3, t3, dps, dpsl, dpsm, vort, & + qminus, div, n3, n3m1, n3m2, phis, omga, & + shift_time_indices, hadv, pdeld + use comspe, only: maxm + use scanslt, only: hw1lat, engy1lat, qfcst +#ifdef SPMD + use mpishorthand, only: mpicom, mpir8 +#endif + use physconst, only: cpair + use scamMod, only: fixmascam,alphacam,betacam, single_column, scm_cambfb_mode + use pspect, only: pnmax + use tfilt_massfix, only: tfilt_massfixrun + use massfix, only: hw1,hw2,hw3,alpha + use cam_control_mod, only: ideal_phys, adiabatic + use eul_control_mod, only: qmassf, tmass, tmass0, fixmas, tmassf + +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 + real(r8), intent(in) :: cwava(plat) ! weight applied to global integrals + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), optional, intent(inout) :: t2(plon,plev,beglat:endlat) ! tot dT/dt to to physics + real(r8), optional, intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tend + real(r8), optional, intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tend +! +!---------------------------Local workspace----------------------------- +! + real(r8) engy1 ! component of global energy integral (for time step n) + real(r8) engy2 ! component of global energy integral (for time step n+1) + real(r8) engy2a ! component of global energy integral (for time step n+1) + real(r8) engy2b ! component of global energy integral (for time step n+1) + real(r8) difft ! component of global delta-temp integral ( (n+1) - n ) + real(r8) diffta ! component of global delta-temp integral ( (n+1) - n ) + real(r8) difftb ! component of global delta-temp integral ( (n+1) - n ) + real(r8) hw2a(pcnst) ! component of constituent global mass integral (mass weighting is + ! based upon the "A" portion of the hybrid grid) + real(r8) hw2b(pcnst) ! component of constituent global mass integral (mass weighting is + ! based upon the "B" portion of the hybrid grid) + real(r8) hw3a(pcnst) ! component of constituent global mass integral (mass weighting is + ! based upon the "A" portion of the hybrid grid) + real(r8) hw3b(pcnst) ! component of constituent global mass integral (mass weighting is + ! based upon the "B" portion of the hybrid grid) + real(r8) hwxa(pcnst,4) + real(r8) hwxb(pcnst,4) + real(r8) engy2alat(plat) ! lat contribution to total energy integral + real(r8) engy2blat(plat) ! lat contribution to total energy integral + real(r8) difftalat(plat) ! lat contribution to delta-temperature integral + real(r8) difftblat(plat) ! lat contribution to delta-temperature integral + real(r8) hw2al(pcnst,plat) ! |------------------------------------ + real(r8) hw2bl(pcnst,plat) ! | latitudinal contributions to the + real(r8) hw3al(pcnst,plat) ! | components of global mass integrals + real(r8) hw3bl(pcnst,plat) ! | + real(r8) hwxal(pcnst,4,plat) ! | + real(r8) hwxbl(pcnst,4,plat) ! |----------------------------------- +! +! Symmetric fourier coefficient arrays for all variables transformed +! from spherical harmonics (see subroutine grcalc) +! + real(r8) grdpss(2*maxm,(plat+1)/2) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8) grzs(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*P(n,m) + real(r8) grds(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*P(n,m) + real(r8) gruhs(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grvhs(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grths(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8) grpss(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m) + real(r8) grus(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grvs(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grts(2*maxm,plev,(plat+1)/2) ! sum(n) of t(n,m)*P(n,m) + real(r8) grpls(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m)*m/a + real(r8) grpms(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*H(n,m) +! +! Antisymmetric fourier coefficient arrays for all variables transformed +! from spherical harmonics (see grcalc) +! + real(r8) grdpsa(2*maxm,(plat+1)/2) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8) grza(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*P(n,m) + real(r8) grda(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*P(n,m) + real(r8) gruha(2*maxm,plev,(plat+1)/2) ! sum(n)K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grvha(2*maxm,plev,(plat+1)/2) ! sum(n)K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grtha(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8) grpsa(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m) + real(r8) grua(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grva(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8) grta(2*maxm,plev,(plat+1)/2) ! sum(n) of t(n,m)*P(n,m) + real(r8) grpla(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m)*m/a + real(r8) grpma(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*H(n,m) + real(r8) residual ! residual energy integral + real(r8) beta ! energy fixer coefficient +! + integer m,n ! indices + integer lat,j,irow ! latitude indices + integer nlon_fft_in ! FFT work array inner dimension + integer nlon_fft_out ! FFT work array inner dimension +! +! FFT buffers +! + real(r8), allocatable:: fftbuf_in(:,:,:,:) ! fftbuf_in(nlon_fft_in,8,plevp,plat) + real(r8), allocatable:: fftbuf_out(:,:,:,:) ! fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) +! +! Temporal space for rearranged spectral coeffs. The rearrangement will +! be made in prepGRcalc and the rearranged coeffs will be transformed +! to Fourier coeffs in grcalca and grcalcs. +! + real(r8) tmpSPEcoef(plev*24,pnmax,maxm) + +! +!----------------------------------------------------------------------- + if (.not. single_column) then + + call t_startf ('grcalc') + + call prepGRcalc(tmpSPEcoef) + +#if ( defined SPMD ) + +!$OMP PARALLEL DO PRIVATE (J) + do j=1,plat/2 + call grcalcs (j, ztodt, grts(1,1,j), grths(1,1,j), grds(1,1,j), & + grzs(1,1,j), grus(1,1,j), gruhs(1,1,j), grvs(1,1,j), grvhs(1,1,j), & + grpss(1,j), grdpss(1,j), grpms(1,j), grpls(1,j), tmpSPEcoef) + + call grcalca (j, ztodt, grta(1,1,j), grtha(1,1,j), grda(1,1,j), & + grza(1,1,j), grua(1,1,j), gruha(1,1,j), grva(1,1,j), grvha(1,1,j), & + grpsa(1,j), grdpsa(1,j), grpma(1,j), grpla(1,j), tmpSPEcoef) + end do + +#else + +!$OMP PARALLEL DO PRIVATE (LAT, J) + do lat=beglat,endlat + if (lat > plat/2) then + j = plat - lat + 1 + call grcalcs (j, ztodt, grts(1,1,j), grths(1,1,j), grds(1,1,j), & + grzs(1,1,j), grus(1,1,j), gruhs(1,1,j), grvs(1,1,j), grvhs(1,1,j), & + grpss(1,j), grdpss(1,j), grpms(1,j), grpls(1,j), tmpSPEcoef) + else + j = lat + call grcalca (j, ztodt, grta(1,1,j), grtha(1,1,j), grda(1,1,j), & + grza(1,1,j), grua(1,1,j), gruha(1,1,j), grva(1,1,j), grvha(1,1,j), & + grpsa(1,j), grdpsa(1,j), grpma(1,j), grpla(1,j), tmpSPEcoef) + end if + end do + +#endif + + call t_stopf ('grcalc') + + call t_startf('spegrd_alloc') +#if ( defined SPMD ) + nlon_fft_in = 2*maxm + allocate(fftbuf_in(nlon_fft_in,8,plevp,plat)) +#else + nlon_fft_in = 1 + allocate(fftbuf_in(1,1,1,1)) +#endif + + nlon_fft_out = plondfft + allocate(fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat)) + call t_stopf('spegrd_alloc') +! + call t_startf('spegrd_bft') +!$OMP PARALLEL DO PRIVATE (LAT, IROW) + do lat=1,plat + irow = lat + if (lat > plat/2) irow = plat - lat + 1 +#if ( defined SPMD ) + call spegrd_bft (lat, nlon_fft_in, & + grdpss(1,irow), grzs(1,1,irow), grds(1,1,irow), gruhs(1,1,irow), grvhs(1,1,irow), & + grths(1,1,irow), grpss(1,irow), grus(1,1,irow), grvs(1,1,irow), grts(1,1,irow), & + grpls(1,irow), grpms(1,irow), grdpsa(1,irow), grza(1,1,irow), grda(1,1,irow), & + gruha(1,1,irow), grvha(1,1,irow), grtha(1,1,irow), grpsa(1,irow), grua(1,1,irow), & + grva(1,1,irow), grta(1,1,irow), grpla(1,irow), grpma(1,irow), fftbuf_in(1,1,1,lat) ) +#else + call spegrd_bft (lat, nlon_fft_out, & + grdpss(1,irow), grzs(1,1,irow), grds(1,1,irow), gruhs(1,1,irow), grvhs(1,1,irow), & + grths(1,1,irow), grpss(1,irow), grus(1,1,irow), grvs(1,1,irow), grts(1,1,irow), & + grpls(1,irow), grpms(1,irow), grdpsa(1,irow), grza(1,1,irow), grda(1,1,irow), & + gruha(1,1,irow), grvha(1,1,irow), grtha(1,1,irow), grpsa(1,irow), grua(1,1,irow), & + grva(1,1,irow), grta(1,1,irow), grpla(1,irow), grpma(1,irow), fftbuf_out(1,1,1,lat) ) +#endif + end do + call t_stopf('spegrd_bft') + + call t_startf('spegrd_ift') + call spegrd_ift ( nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) + call t_stopf('spegrd_ift') + + call t_startf('spegrd_aft') +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT) +#endif + do lat=beglat,endlat + call spegrd_aft (ztodt, lat, plon, nlon_fft_out, & + cwava(lat), qfcst(1,1,1,lat), etamid, ps(1,lat,n3), & + u3(1,1,lat,n3), v3(1,1,lat,n3), t3(1,1,lat,n3), & + qminus(1,1,1,lat), vort(1,1,lat,n3), div(1,1,lat,n3), hw2al(1,lat), hw2bl(1,lat), & + hw3al(1,lat), hw3bl(1,lat), hwxal(1,1,lat), hwxbl(1,1,lat), q3(1,1,1,lat,n3m1), & + dps(1,lat), dpsl(1,lat), dpsm(1,lat), t3(1,1,lat,n3m2) ,engy2alat(lat), engy2blat(lat), & + difftalat(lat), difftblat(lat), phis(1,lat), fftbuf_out(1,1,1,lat) ) + + end do + call t_stopf('spegrd_aft') +! + call t_startf('spegrd_dealloc') + deallocate(fftbuf_in) + deallocate(fftbuf_out) + call t_stopf('spegrd_dealloc') +! +#ifdef SPMD + call t_barrierf ('sync_realloc5', mpicom) + call t_startf('realloc5') + call realloc5 (hw2al ,hw2bl ,hw3al ,hw3bl ,tmass , & + hw1lat ,hwxal ,hwxbl ,engy1lat,engy2alat, & + engy2blat, difftalat, difftblat) + call t_stopf('realloc5') +#endif + +! +! Accumulate and normalize global integrals for mass fixer (dry mass of +! atmosphere is held constant). +! + call t_startf ('scan2_single') + tmassf = 0._r8 + do lat=1,plat + tmassf = tmassf + tmass(lat) + end do + tmassf = tmassf*.5_r8 +! +! Initialize moisture, mass, energy, and temperature integrals +! + hw1(1) = 0._r8 + engy1 = 0._r8 + engy2a = 0._r8 + engy2b = 0._r8 + diffta = 0._r8 + difftb = 0._r8 + do m=1,pcnst + hw2a(m) = 0._r8 + hw2b(m) = 0._r8 + hw3a(m) = 0._r8 + hw3b(m) = 0._r8 + do n=1,4 + hwxa(m,n) = 0._r8 + hwxb(m,n) = 0._r8 + end do + end do +! +! Sum water and energy integrals over latitudes +! + do lat=1,plat + engy1 = engy1 + engy1lat (lat) + engy2a = engy2a + engy2alat(lat) + engy2b = engy2b + engy2blat(lat) + diffta = diffta + difftalat(lat) + difftb = difftb + difftblat(lat) + hw1(1) = hw1(1) + hw1lat(1,lat) + hw2a(1) = hw2a(1) + hw2al(1,lat) + hw2b(1) = hw2b(1) + hw2bl(1,lat) + hw3a(1) = hw3a(1) + hw3al(1,lat) + hw3b(1) = hw3b(1) + hw3bl(1,lat) + end do +! +! Compute atmospheric mass fixer coefficient +! + qmassf = hw1(1) + if (adiabatic .or. ideal_phys) then + fixmas = tmass0/tmassf + else + fixmas = (tmass0 + qmassf)/tmassf + end if +! +! Compute alpha for water ONLY +! + hw2(1) = hw2a(1) + fixmas*hw2b(1) + hw3(1) = hw3a(1) + fixmas*hw3b(1) + if(hw3(1) .ne. 0._r8) then + alpha(1) = ( hw1(1) - hw2(1) )/hw3(1) + else + alpha(1) = 1._r8 + endif +! +! Compute beta for energy +! + engy2 = engy2a + fixmas*engy2b + difft = diffta + fixmas*difftb + residual = (engy2 - engy1)/ztodt + if(difft .ne. 0._r8) then + beta = -residual*ztodt/(cpair*difft) + else + beta = 0._r8 + endif +!! write(iulog,125) residual,beta +!!125 format(' resid, beta = ',25x,2f25.15) +! +! Compute alpha for non-water constituents +! + do m = 2,pcnst + hw1(m) = 0._r8 + do lat=1,plat + hw1(m) = hw1(m) + hw1lat(m,lat) + end do + do n = 1,4 + do lat=1,plat + hwxa(m,n) = hwxa(m,n) + hwxal(m,n,lat) + hwxb(m,n) = hwxb(m,n) + hwxbl(m,n,lat) + end do + end do + hw2a(m) = hwxa(m,1) - alpha(1)*hwxa(m,2) + hw2b(m) = hwxb(m,1) - alpha(1)*hwxb(m,2) + hw3a(m) = hwxa(m,3) - alpha(1)*hwxa(m,4) + hw3b(m) = hwxb(m,3) - alpha(1)*hwxb(m,4) + hw2 (m) = hw2a(m) + fixmas*hw2b(m) + hw3 (m) = hw3a(m) + fixmas*hw3b(m) + if(hw3(m) .ne. 0._r8) then + alpha(m) = ( hw1(m) - hw2(m) )/hw3(m) + else + alpha(m) = 1._r8 + end if + end do + + call t_stopf ('scan2_single') + + +else + + do lat=beglat,endlat + j = lat + irow = lat + if (lat > plat/2) irow = plat - lat + 1 + call forecast( lat , plon , ztodt , & + ps(1,lat,n3m1) , ps(1,lat,n3m2) , ps(1,lat,n3) , & + u3(1,1,j,n3) , u3(1,1,j,n3m1) , u3(1,1,j,n3m2) , & + v3(1,1,j,n3) , v3(1,1,j,n3m1) , v3(1,1,j,n3m2) , & + t3(1,1,j,n3) , t3(1,1,j,n3m1) , t3(1,1,j,n3m2) , & + q3(1,1,1,j,n3) , q3(1,1,1,j,n3m1) , q3(1,1,1,j,n3m2) , & + t2(1,1,lat) , fu(1,1,lat) , fv(1,1,lat) , & + qminus(1,1,1,j) , qfcst(1,1,1,lat) ) + end do +! +! Initialize fixer variables for routines not called in scam version of +! model +! + engy2alat=0._r8 + engy2blat=0._r8 + difftalat=0._r8 + difftblat=0._r8 + engy2b=0._r8 + +! +! read in fixer for scam +! + if ( scm_cambfb_mode ) then + fixmas=fixmascam + beta=betacam + do m = 1, pcnst + alpha(m)=alphacam(m) + end do + else + fixmas=1._r8 + beta=0._r8 + alpha(:)=0._r8 + endif +endif ! if not SCAM + +call t_startf ('tfilt_massfix') + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT) +#endif + do lat=beglat,endlat + + call tfilt_massfixrun (ztodt, lat, u3(1,1,lat,n3m1),u3(1,1,lat,n3), & + v3(1,1,lat,n3m1), v3(1,1,lat,n3), t3(1,1,lat,n3m1), t3(1,1,lat,n3), & + q3(1,1,1,lat,n3m1), & + q3(1,1,1,lat,n3), ps(1,lat,n3m1), ps(1,lat,n3), alpha, & + etamid, qfcst(1,1,1,lat), vort(1,1,lat,n3), div(1,1,lat,n3), & + vort(1,1,lat,n3m2), & + div(1,1,lat,n3m2), qminus(1,1,1,lat), ps(1,lat,n3m2), & + u3(1,1,lat,n3m2), & + v3(1,1,lat,n3m2), t3(1,1,lat,n3m2), q3(1,1,1,lat,n3m2), vort(1,1,lat,n3m1), & + div(1,1,lat,n3m1), & + omga(1,1,lat), dpsl(1,lat), dpsm(1,lat), beta, hadv(1,1,1,lat) ,plon, & + pdeld(:,:,lat,n3), pdeld(:,:,lat,n3m1), pdeld(:,:,lat,n3m2)) + + end do + call t_stopf ('tfilt_massfix') +! +! Shift time pointers +! + call shift_time_indices () + + return +end subroutine scan2run + +! +!----------------------------------------------------------------------- +! + +#ifdef SPMD +subroutine realloc5 (hw2al ,hw2bl ,hw3al ,hw3bl ,tmass , & + hw1lat ,hwxal ,hwxbl ,engy1lat,engy2alat, & + engy2blat,difftalat,difftblat ) +!----------------------------------------------------------------------- +! +! Purpose: Reallocation routine for slt variables. +! +! Method: MPI_Allgatherv (or point-to-point implementation) +! +! Author: J. Rosinski +! Standardized: J. Rosinski, Oct 1995 +! J. Truesdale, Feb. 1996 +! Modified: P. Worley, December 2003, October 2004 +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use pmgrid, only: numlats, plat + use mpishorthand, only: mpicom, mpir8 + use spmd_dyn + use spmd_utils, only : iam, npes, altalltoallv +!---------------------------------Parameters---------------------------------- + integer, parameter :: msgtag = 5000 +!---------------------------------Commons------------------------------------- +#include +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(inout) :: hw2al(pcnst,plat) + real(r8), intent(inout) :: hw2bl(pcnst,plat) + real(r8), intent(inout) :: hw3al(pcnst,plat) + real(r8), intent(inout) :: hw3bl(pcnst,plat) + real(r8), intent(inout) :: tmass (plat) + real(r8), intent(inout) :: hw1lat(pcnst,plat) + real(r8), intent(inout) :: hwxal(pcnst,4,plat) + real(r8), intent(inout) :: hwxbl(pcnst,4,plat) +! ! - + real(r8), intent(inout) :: engy1lat (plat) ! lat contribution to total energy (n) + real(r8), intent(inout) :: engy2alat(plat) ! lat contribution to total energy (n+1) + real(r8), intent(inout) :: engy2blat(plat) ! lat contribution to total energy (n+1) + real(r8), intent(inout) :: difftalat(plat) ! lat contribution to delta-T integral + real(r8), intent(inout) :: difftblat(plat) ! lat contribution to delta-T integral +! +!---------------------------Local workspace----------------------------- +! + integer procid + integer bufpos + integer procj + integer step, i, j, m, jstrt + integer beglat_p, endlat_p, numlats_p, jstrt_p +! + logical, save :: first = .true. + integer, save :: sndcnt + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: pdispls(:) +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv/put counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! +! Compute send count + sndcnt = (pcnst*(5 + 2*4) + 6)*numlats + sndcnts(:) = 0 + do step=1,allgather_steps + procid = allgather_proc(step) + sndcnts(procid) = sndcnt + enddo +! + sdispls(0) = 0 + do procid=1,npes-1 + sdispls(procid) = 0 + enddo +! +! Compute recv counts and displacements + rcvcnts(:) = 0 + do step=1,allgather_steps + procid = allgather_proc(step) + rcvcnts(procid) = (pcnst*(5 + 2*4) + 6)*nlat_p(procid) + enddo + rcvcnts(iam) = (pcnst*(5 + 2*4) + 6)*numlats +! + rdispls(0) = 0 + do procid=1,npes-1 + rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) + enddo +! + pdispls(:) = 0 + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! + first = .false. + endif +! +! Fill send buffer + jstrt = beglat - 1 + bufpos = 0 +! tmass + do j=1,numlats + buf1(bufpos+j) = tmass(jstrt+j) + enddo + bufpos = bufpos + numlats +! engy1lat + do j=1,numlats + buf1(bufpos+j) = engy1lat(jstrt+j) + enddo + bufpos = bufpos + numlats +! engy2alat + do j=1,numlats + buf1(bufpos+j) = engy2alat(jstrt+j) + enddo + bufpos = bufpos + numlats +! engy2blat + do j=1,numlats + buf1(bufpos+j) = engy2blat(jstrt+j) + enddo + bufpos = bufpos + numlats +! difftalat + do j=1,numlats + buf1(bufpos+j) = difftalat(jstrt+j) + enddo + bufpos = bufpos + numlats +! difftblat + do j=1,numlats + buf1(bufpos+j) = difftblat(jstrt+j) + enddo + bufpos = bufpos + numlats +!hw1lat + do j=beglat,endlat + do m=1,pcnst + buf1(bufpos+m) = hw1lat(m,j) + enddo + bufpos = bufpos + pcnst + enddo +!hw2al + do j=beglat,endlat + do m=1,pcnst + buf1(bufpos+m) = hw2al(m,j) + enddo + bufpos = bufpos + pcnst + enddo +!hw2bl + do j=beglat,endlat + do m=1,pcnst + buf1(bufpos+m) = hw2bl(m,j) + enddo + bufpos = bufpos + pcnst + enddo +!hw3al + do j=beglat,endlat + do m=1,pcnst + buf1(bufpos+m) = hw3al(m,j) + enddo + bufpos = bufpos + pcnst + enddo +!hw3bl + do j=beglat,endlat + do m=1,pcnst + buf1(bufpos+m) = hw3bl(m,j) + enddo + bufpos = bufpos + pcnst + enddo +!hwxal + do j=beglat,endlat + do i=1,4 + do m=1,pcnst + buf1(bufpos+m) = hwxal(m,i,j) + enddo + bufpos = bufpos + pcnst + enddo + enddo +!hwxbl + do j=beglat,endlat + do i=1,4 + do m=1,pcnst + buf1(bufpos+m) = hwxbl(m,i,j) + enddo + bufpos = bufpos + pcnst + enddo + enddo +! +! Gather the data +! + if (dyn_allgather .eq. 0) then + call mpiallgatherv(buf1, sndcnt, mpir8, & + buf2, rcvcnts, rdispls, mpir8, & + mpicom) + else + call altalltoallv(dyn_allgather, iam, npes, & + allgather_steps, allgather_proc, & + buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & + buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, buf2win, mpicom) + endif +! +! Copy out of message buffers +! +!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_P, ENDLAT_P, NUMLATS_P, BUFPOS, JSTRT_P, I, J, M) + do step=1,allgather_steps + procid = allgather_proc(step) + beglat_p = cut(1,procid) + endlat_p = cut(2,procid) + numlats_p = nlat_p(procid) + bufpos = rdispls(procid) +! tmass + jstrt_p = beglat_p - 1 + do j=1,numlats_p + tmass(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! engy1lat + jstrt_p = beglat_p - 1 + do j=1,numlats_p + engy1lat(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! engy2alat + jstrt_p = beglat_p - 1 + do j=1,numlats_p + engy2alat(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! engy2blat + jstrt_p = beglat_p - 1 + do j=1,numlats_p + engy2blat(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! difftalat + jstrt_p = beglat_p - 1 + do j=1,numlats_p + difftalat(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! difftblat + jstrt_p = beglat_p - 1 + do j=1,numlats_p + difftblat(jstrt_p+j) = buf2(bufpos+j) + enddo + bufpos = bufpos + numlats_p +! hw1lat + do j=beglat_p,endlat_p + do m=1,pcnst + hw1lat(m,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo +! hw2al + do j=beglat_p,endlat_p + do m=1,pcnst + hw2al(m,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo +! hw2bl + do j=beglat_p,endlat_p + do m=1,pcnst + hw2bl(m,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo +! hw3al + do j=beglat_p,endlat_p + do m=1,pcnst + hw3al(m,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo +! hw3bl + do j=beglat_p,endlat_p + do m=1,pcnst + hw3bl(m,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo +! hwxal + do j=beglat_p,endlat_p + do i=1,4 + do m=1,pcnst + hwxal(m,i,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo + enddo +! hwxbl + do j=beglat_p,endlat_p + do i=1,4 + do m=1,pcnst + hwxbl(m,i,j) = buf2(bufpos+m) + enddo + bufpos = bufpos + pcnst + enddo + enddo +! + end do +! + return +end subroutine realloc5 +#endif + +! +!----------------------------------------------------------------------- +! + + +end module scan2 diff --git a/src/dynamics/eul/scandyn.F90 b/src/dynamics/eul/scandyn.F90 new file mode 100644 index 0000000000..1165957729 --- /dev/null +++ b/src/dynamics/eul/scandyn.F90 @@ -0,0 +1,207 @@ + +subroutine scandyn (ztodt, etadot, etamid, grlps1, grt1, & + grz1, grd1, grfu1, grfv1, grut1, & + grvt1, grrh1, grlps2, grt2, grz2, & + grd2, grfu2, grfv2, grut2, grvt2, & + grrh2, vcour, vmax2d, vmax2dt, detam, & + cwava, flx_net, t2, fu, fv) +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! "After coupling" gaussian latitude scan for which some of the physics +! and nonlinear dynamics calculations are completed. The main loop over +! latitude in this routine is multitasked. +! +! Note: the "ifdef" constructs in this routine are associated with the +! message-passing version of CAM. Messages are sent which +! have no relevance to the shared-memory case. +! +! Author: +! Original version: CCM3 +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plev, beglat, endlat, plevp + use prognostics, only: u3, v3, q3, t3, div, vort, phis, omga, dpsl, & + dpsm, ps, n3m1, n3, n3m2, qminus, pdeld + use constituents, only: pcnst + use scanslt, only: hw1lat + use comspe, only: maxm + use linemsdyn, only: linemsdyn_bft, linemsdyn_fft, linemsdyn_aft, & + plondfft + use commap, only: w + use qmassa, only: qmassarun + use perf_mod +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: ztodt ! two delta t unless nstep =0 + real(r8), intent(inout) :: etadot(plon,plevp,beglat:endlat) ! vertical motion (slt) + real(r8), intent(in) :: etamid(plev) ! hybrd coord value at levels + real(r8), intent(in) :: detam(plev) +! +! Fourier coefficient arrays which have a latitude index on them for +! multitasking. These arrays are defined in LINEMSDYN and and used in QUAD +! to compute spectral coefficients. They contain a latitude index so +! that the sums over latitude can be performed in a specified order. +! + real(r8), intent(in) :: cwava(plat) ! weight applied to global integrals + real(r8), intent(in) :: flx_net(plon,beglat:endlat) ! net flx from physics + real(r8), intent(inout) :: t2(plon,plev,beglat:endlat) ! tot dT/dt to to physics + real(r8), intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tend + real(r8), intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tend +! +! Output arguments +! + real(r8), intent(out) :: grlps1(2*maxm,(plat+1)/2) ! sym. undiff. term in lnps eqn. + real(r8), intent(out) :: grlps2(2*maxm,(plat+1)/2) ! antisym undiff. term in lnps eqn. + real(r8), intent(out) :: grt1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in t eqn. + real(r8), intent(out) :: grt2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in t eqn. + real(r8), intent(out) :: grz1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in z eqn. + real(r8), intent(out) :: grz2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in z eqn. + real(r8), intent(out) :: grd1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in d eqn. + real(r8), intent(out) :: grd2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in d eqn. + real(r8), intent(out) :: grfu1(2*maxm,plev,(plat+1)/2) ! sym. nonlinear terms in u eqn. + real(r8), intent(out) :: grfu2(2*maxm,plev,(plat+1)/2) ! antisym. nonlinear terms in u eqn. + real(r8), intent(out) :: grfv1(2*maxm,plev,(plat+1)/2) ! sym. nonlinear terms in v eqn. + real(r8), intent(out) :: grfv2(2*maxm,plev,(plat+1)/2) ! antisym. nonlinear terms in v eqn. + real(r8), intent(out) :: grut1(2*maxm,plev,(plat+1)/2) ! sym. lambda deriv. term in t eqn. + real(r8), intent(out) :: grut2(2*maxm,plev,(plat+1)/2) ! antisym. lambda deriv. term in t eqn. + real(r8), intent(out) :: grvt1(2*maxm,plev,(plat+1)/2) ! sym. mu derivative term in t eqn. + real(r8), intent(out) :: grvt2(2*maxm,plev,(plat+1)/2) ! antisym. mu deriv. term in t eqn. + real(r8), intent(out) :: grrh1(2*maxm,plev,(plat+1)/2) ! sym. del**2 term in d eqn. + real(r8), intent(out) :: grrh2(2*maxm,plev,(plat+1)/2) ! antisym. del**2 term in d eqn. + real(r8), intent(out) :: vcour(plev,plat) ! maximum Courant number in vert. + real(r8), intent(out) :: vmax2d(plev,plat) ! max. wind at each level, latitude + real(r8), intent(out) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat + +! Local variables + + integer irow ! latitude pair index + integer lat,latn,lats ! latitude indices + integer nlon_fft_in ! FFT work array inner dimension + integer nlon_fft_out ! FFT work array inner dimension + real(r8) pmid(plon,plev) ! pressure at model levels + real(r8) pint(plon,plevp) ! pressure at interfaces + real(r8) pdel(plon,plev) ! pressure difference between + integer :: m ! constituent index +! +! FFT buffers +! + real(r8), allocatable:: fftbuf_in(:,:,:,:) ! fftbuf_in(nlon_fft_in,9,plev,beglat:endlat) + real(r8), allocatable:: fftbuf_out(:,:,:,:) ! fftbuf_out(nlon_fft_out,9,plev,plat) +! + call t_startf ('scandyn_alloc') + nlon_fft_in = plondfft + allocate(fftbuf_in(nlon_fft_in,9,plev,beglat:endlat)) + +#if ( defined SPMD ) +#ifdef NEC_SX + nlon_fft_out = 2*maxm + 1 +#else + nlon_fft_out = 2*maxm +#endif + allocate(fftbuf_out(nlon_fft_out,9,plev,plat)) +#else + nlon_fft_out = 1 + allocate(fftbuf_out(1,1,1,1)) +#endif + call t_stopf ('scandyn_alloc') +! + call t_startf ('linemsdyn_bft') +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT) +#endif + do lat=beglat,endlat + + call linemsdyn_bft (lat, plon, nlon_fft_in, & + ps(1,lat,n3m1), ps(1,lat,n3m2), u3(1,1,lat,n3m1), & + u3(1,1,lat,n3m2), v3(1,1,lat,n3m1), v3(1,1,lat,n3m2), t3(1,1,lat,n3m1), t3(1,1,lat,n3m2), & + q3(1,1,1,lat,n3m1), etadot(1,1,lat), etamid, & + ztodt, vcour(1,lat), vmax2d(1,lat), vmax2dt(1,lat), & + detam, t2(1,1,lat), fu(1,1,lat), fv(1,1,lat), & + div(1,1,lat,n3m1), vort(1,1,lat,n3m2), div(1,1,lat,n3m2), vort(1,1,lat,n3m1), & + phis(1,lat), dpsl(1,lat), dpsm(1,lat), omga(1,1,lat), & + cwava(lat), flx_net(1,lat), fftbuf_in(1,1,1,lat) ) + end do + call t_stopf ('linemsdyn_bft') + + call t_startf ('linemsdyn_fft') + call linemsdyn_fft (nlon_fft_in,nlon_fft_out,fftbuf_in,fftbuf_out) + call t_stopf ('linemsdyn_fft') + + call t_startf ('linemsdyn_aft') +!$OMP PARALLEL DO PRIVATE (IROW, LATN, LATS) + do irow=1,plat/2 + + lats = irow + latn = plat - irow + 1 +#if ( defined SPMD ) + call linemsdyn_aft (irow, nlon_fft_out, fftbuf_out(1,1,1,lats), fftbuf_out(1,1,1,latn), & + grlps1(1,irow), grt1(1,1,irow), grz1(1,1,irow), grd1(1,1,irow), & + grfu1(1,1,irow), grfv1(1,1,irow), & + grut1(1,1,irow), grvt1(1,1,irow), grrh1(1,1,irow), grlps2(1,irow),grt2(1,1,irow), & + grz2(1,1,irow), grd2(1,1,irow), grfu2(1,1,irow), grfv2(1,1,irow), grut2(1,1,irow), & + grvt2(1,1,irow), grrh2(1,1,irow) ) +#else + call linemsdyn_aft (irow, nlon_fft_in, fftbuf_in(1,1,1,lats), fftbuf_in(1,1,1,latn), & + grlps1(1,irow), grt1(1,1,irow), grz1(1,1,irow), grd1(1,1,irow), & + grfu1(1,1,irow), grfv1(1,1,irow), & + grut1(1,1,irow), grvt1(1,1,irow), grrh1(1,1,irow), grlps2(1,irow),grt2(1,1,irow), & + grz2(1,1,irow), grd2(1,1,irow), grfu2(1,1,irow), grfv2(1,1,irow), grut2(1,1,irow), & + grvt2(1,1,irow), grrh2(1,1,irow) ) +#endif + end do + call t_stopf ('linemsdyn_aft') +! + call t_startf ('scandyn_dealloc') + deallocate(fftbuf_in) + deallocate(fftbuf_out) + call t_stopf ('scandyn_dealloc') + +! + call t_startf ('moisture_mass') +! +! Initialize moisture mass integrals. +! + hw1lat = 0.0_r8 +! +! Calculate total mass of moisture in fields advected +! +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT, IROW) +#endif + do lat=beglat,endlat + if(lat.le.plat/2) then + irow = lat + else + irow = plat + 1 - lat + end if +! +! Only pdel is needed pint and pmid are not. +! + call plevs0 (plon,plon,plev,ps(1,lat,n3m2), pint, pmid, pdel) +! +! Calculate mass of moisture in field being advected +! + +! q3 is plon,plev,pcnst,beglat:endlat,ptimelevs +! qminus is plon,plev,pcnst,beglat:endlat + call qmassarun (cwava(lat),w(irow) ,qminus(1,1,1,lat),pdel , & + hw1lat(1,lat),plon, q3(1,1,1,lat,n3m2), lat, & + pdeld(:,:,lat,n3m2 )) + end do + call t_stopf ('moisture_mass') + + return +end subroutine scandyn + diff --git a/src/dynamics/eul/scanslt.F90 b/src/dynamics/eul/scanslt.F90 new file mode 100644 index 0000000000..40390729a0 --- /dev/null +++ b/src/dynamics/eul/scanslt.F90 @@ -0,0 +1,1430 @@ +module scanslt +!----------------------------------------------------------------------- +! +! Module to handle Semi-Lagrangian transport in the context of +! Eulerian Spectral dynamics. +! +!----------------------------------------------------------------------- +! +! $Id$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plev, beglat, endlat, plevp + use constituents, only: pcnst + use cam_abortutils, only: endrun + use scamMod, only: single_column + use perf_mod +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- + private +! +! Public interfaces +! + public scanslt_initial ! Advection initialization method + public scanslt_run ! Advection run method + public scanslt_final ! Advection finalization method + public scanslt_alloc ! Allocate some slt data needed for restarting +! +! Public extended grid parameters +! + integer, public, parameter :: nxpt = 1 ! no. of pts outside active domain of interpolant + integer, public, parameter :: jintmx = 2 ! number of extra latitudes in polar region + integer, public, parameter :: i1 = 1 + nxpt ! model starting longitude index + integer, public, parameter :: j1 = 1 + nxpt + jintmx ! model starting latitude index + integer, public, parameter :: plond = plon + 1 + 2*nxpt ! slt extended domain longitude + integer, public, parameter :: plond1 = plond - i1 +1 ! slt extended domain longitude starting at i1 + integer, public, parameter :: platd = plat + 2*nxpt + 2*jintmx ! slt extended domain lat. + integer, public, parameter :: numbnd = nxpt + jintmx ! no.of lats passed N and S of forecast lat + integer, public, parameter :: plndlv = plond*plev ! Length of multilevel 3-d field slice + + integer, public :: beglatex ! extended grid beglat + integer, public :: endlatex ! extended grid endlat + integer, public :: numlatsex ! number of latitudes owned by a given proc extended grid + +#if ( ! defined SPMD ) + parameter (beglatex = 1) + parameter (endlatex = platd) + parameter (numlatsex= platd) +#endif + + public engy1lat ! For calculation of total energy + public hw1lat ! For calculation of total moisture +! +! Public data structures +! + public advection_state + + ! advection data structure of data that will be on the extended grid for SLT + type advection_state + real(r8), pointer :: u3(:,:,:) => null() ! u-wind + real(r8), pointer :: v3(:,:,:) => null() ! v-wind + real(r8), pointer :: qminus(:,:,:,:) => null() ! constituents on previous step + end type advection_state + + public lammp, phimp, sigmp, qfcst ! Needed for restart +! + integer, public :: nlonex(platd) = huge(1) ! num longitudes per lat (extended grid) + real(r8) :: hw1lat (pcnst,plat) ! lat contribution to const. mass integral + real(r8) :: engy1lat(plat) ! lat contribution to total energy integral + real(r8), allocatable, target :: lammp(:,:,:) ! Lamda midpoint coordinate + real(r8), allocatable, target :: phimp(:,:,:) ! Phi midpoint coordinate + real(r8), allocatable, target :: sigmp(:,:,:) ! Sigma midpoint coordinate + real(r8), allocatable, target :: qfcst(:,:,:,:) ! slt forecast of moisture and constituents +! +! Private data +! + integer, parameter :: pmap = 20000 +! ! max dimension of evenly spaced vert. +! ! grid used by SLT code to map the departure pts into true +! ! model levels. +! + real(r8) :: etaint(plevp) ! vertical coords at interfaces + real(r8) :: dlam(platd) ! longitudinal grid interval (radians) + real(r8) :: lam(plond,platd) ! longitude coords of extended grid + real(r8) :: phi(platd) ! latitude coords of extended grid + real(r8) :: dphi(platd) ! latitude intervals (radians) + real(r8) :: sinlam(plond,platd) ! sin(lam) model domain only + real(r8) :: coslam(plond,platd) ! cos(lam) model domain only + real(r8) :: lbasdy(4,2,platd) ! latitude derivative weights + real(r8) :: lbasdz(4,2,plev) ! vert (full levels) deriv wghts + real(r8) :: lbassd(4,2,plevp) ! vert (half levels) deriv wghts + real(r8) :: lbasiy(4,2,platd) ! Lagrange cubic interp wghts (lat.) + real(r8) :: detai(plevp) ! intervals between vert half levs. + integer :: kdpmpf(pmap) ! artificial full vert grid indices + integer :: kdpmph(pmap) ! artificial half vert grid indices + real(r8) :: gravit ! gravitational constant + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +! +!----------------------------------------------------------------------- +! + +subroutine scanslt_alloc() +!----------------------------------------------------------------------- +! +! Purpose: +! Allocate some scanslt data +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- + use infnan, only: nan, assignment(=) + + allocate (lammp(plon,plev,beglat:endlat)) + allocate (phimp(plon,plev,beglat:endlat)) + allocate (sigmp(plon,plev,beglat:endlat)) + allocate (qfcst(plon,plev,pcnst,beglat:endlat)) + + lammp (:,:,:) = nan + phimp (:,:,:) = nan + sigmp (:,:,:) = nan + qfcst (:,:,:,:) = nan +end subroutine scanslt_alloc + +! +!----------------------------------------------------------------------- +! +subroutine scanslt_initial( adv_state, etamid, gravit_in, detam, cwava ) +!----------------------------------------------------------------------- +! +! Purpose: +! SLT initialization for Eulerian dynamics +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- + use commap, only: clat + use prognostics, only: ps, n3 + use time_manager, only: is_first_step + use hycoef, only: hyam, hybm, hyai, hybi, ps0 + use eul_control_mod, only : pdela +! +! Input arguments +! + real(r8), intent(out) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: gravit_in ! Gravitational constant +! +! Output arguments +! + real(r8), intent(out) :: detam(plev) ! intervals between vert full levs. + real(r8), intent(out) :: cwava(plat) ! weight applied to global integrals + type(advection_state), intent(out) :: adv_state ! Advection state data + +! +! Local variables +! + integer :: i, j, k, lat ! indices + real(r8) :: hyad (plev) ! del (A) + real(r8) :: pmid(plon,plev) ! pressure at model levels + real(r8) :: pint(plon,plevp) ! pressure at interfaces + real(r8) :: pdel(plon,plev) ! pressure difference between + real(r8) :: gw(plat) ! Gaussian weights needed for SCAM grdini call +! +! Allocate memory for scanslt variables +! + call adv_state_alloc( adv_state ) + + do k = 1, plev + etamid(k) = hyam(k) + hybm(k) + etaint(k) = hyai(k) + hybi(k) + end do + etaint(plevp) = hyai(plevp) + hybi(plevp) +! +! For SCAM compute pressure levels to use for eta interface +! + if (single_column) then + lat = beglat + call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) + etamid(:) = pmid(lat,:) + etaint(:) = pint(lat,:) + if ( any(etamid == 0.0_r8) ) call endrun('etamid == 0') + if ( any(etaint == 0.0_r8) ) call endrun('etaint == 0') + endif +! +! Set slt module variables +! + gravit = gravit_in + call grdini(pmap ,etamid ,etaint ,gravit ,dlam , & + lam ,phi ,dphi ,gw ,sinlam , & + coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & + detam ,detai ,kdpmpf ,kdpmph ,cwava ) +! +! Initial guess for trajectory midpoints in spherical coords. +! nstep = 0: use arrival points as initial guess for trajectory midpoints. +! nstep > 0: use calculated trajectory midpoints from previous time +! step as first guess. +! NOTE: reduce number of iters necessary for convergence after nstep = 1. +! + if (is_first_step()) then + do lat=beglat,endlat + j = j1 - 1 + lat +! +! Set current time pressure arrays for model levels etc. +! + call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) + + do k=1,plev + do i=1,plon + if (single_column) then + sigmp(i,k,lat) = pmid(i,k) + else + lammp(i,k,lat) = real(i-1,r8)*dlam(j1-1+lat) + phimp(i,k,lat) = clat(lat) + sigmp(i,k,lat) = etamid(k) + endif + end do + end do + end do + end if +! +! Compute pdel from "A" portion of hybrid vertical grid +! + do k=1,plev + hyad(k) = hyai(k+1) - hyai(k) + end do + do k=1,plev + do i=1,plon + pdela(i,k) = hyad(k)*ps0 + end do + end do + +end subroutine scanslt_initial + +! +!----------------------------------------------------------------------- +! + +subroutine scanslt_run(adv_state, ztodt ,etadot ,detam, etamid, cwava ) +!----------------------------------------------------------------------- +! +! Purpose: +! Driving routine for semi-lagrangian transport. +! +! Method: +! The latitude loop in this routine is multitasked. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- + use physconst, only: ra + use prognostics, only: hadv + use time_manager, only: get_nstep + use pmgrid, only: plon, plat +#if (defined SPMD) + use mpishorthand, only: mpicom +#endif +!------------------------------Parameters------------------------------- + integer itermx ! number of iterations to be used in departure +! ! point calculation for nstep = 0 and 1 + integer itermn ! number of iterations to be used in departure +! ! point calculation for nstep > 1 + parameter(itermx=4,itermn=1) +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: ztodt ! twice the time step unless nstep = 0 + real(r8), intent(in) :: etadot(plon,plevp,beglat:endlat)! vertical motion (slt) + real(r8), intent(in) :: etamid(plev) ! eta at levels +! +! In/Output arguments +! + real(r8), intent(inout) :: detam(plev) ! delta eta at levels + ! needs intent(out) because of SCAM + real(r8), intent(inout) :: cwava(plat) ! weight for global water vapor int. + ! needs intent(out) because of SCAM + type(advection_state), intent(inout) :: adv_state ! Advection state data +! +!---------------------------Local workspace----------------------------- +! + integer iter ! number of iterations for +! ! departure point calculation + integer m + integer lat ! latitude index + integer irow ! N/S latitude pair index + integer jcen ! lat index (extended grid) of forecast + integer :: nstep ! current timestep number + real(r8) :: pmid(plon,plev) ! pressure at model levels + real(r8) :: pint(plon,plevp)! pressure at interfaces + real(r8) :: pdel(plon,plev) ! pressure difference between +! +! Dynamic (SPMD) vs stack (shared memory) +! + real(r8) uxl(plond,plev,beglatex:endlatex) ! left x-deriv of u/v + real(r8) uxr(plond,plev,beglatex:endlatex) ! left x-deriv of u/v + real(r8) vxl(plond,plev,beglatex:endlatex) ! left x-deriv of u/v + real(r8) vxr(plond,plev,beglatex:endlatex) ! left x-deriv of u/v + real(r8) qxl(plond,plev,pcnst,beglatex:endlatex) ! left x-deriv of constituents + real(r8) qxr(plond,plev,pcnst,beglatex:endlatex) ! right x-deriv of constituents + real(r8) :: gw(plat) ! Gaussian weights needed for SCAM grdini call + integer :: k ! Vertical index needed for SCAM +! +!----------------------------------------------------------------------- +! +! Copy dynamics data into SLT advection structure +! + call t_startf ('scanslt_da_coup') + call da_coupling( cwava, adv_state ) + call t_stopf ('scanslt_da_coup') +! +! For SCAM reset vertical grid +! + if (single_column) then +! +! IF surface pressure changes with time we need to remap the vertical +! coordinate for the slt advection process. It has been empirically +! determined that we can get away with 500 for pmap (instead of 20000) +! This is necessary to make the procedure computationally feasible +! + call grdini(pmap ,etamid ,etaint ,gravit ,dlam , & + lam ,phi ,dphi ,gw ,sinlam , & + coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & + detam ,detai ,kdpmpf ,kdpmph ,cwava ) +! +! Initial guess for trajectory midpoints in spherical coords. +! nstep = 0: use arrival points as initial guess for trajectory midpoints. +! nstep > 0: use calculated trajectory midpoints from previous time +! step as first guess. +! NOTE: reduce number of iters necessary for convergence after nstep = 1. +! + do k=1,plev + sigmp(1,k,beglat) = etamid(k) + end do + + else +! +! Mpi barrier +! +#if ( defined SPMD ) +! +! Communicate boundary information +! + call t_barrierf ('sync_bndexch', mpicom) + call t_startf ('bndexch') + call bndexch( adv_state ) + call t_stopf ('bndexch') +#endif + + nstep = get_nstep() +! +! Initialize extended arrays +! + call t_startf('sltini') + call sltini (dlam, sinlam, coslam, uxl, uxr, & + vxl, vxr, qxl, qxr, adv_state ) + call t_stopf('sltini') + endif + nstep = get_nstep() + if (nstep .le. 1) then + iter = itermx + else + iter = itermn + end if +! +! Loop through latitudes producing forecast +! + call t_startf ('sltb1') +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT, IROW, JCEN) +#endif + do lat=beglat,endlat + if(lat.le.plat/2) then + irow = lat + else + irow = plat + 1 - lat + end if + jcen = j1 - 1 + lat +! +! Call slt interface routine. +! + call sltb1 (pmap ,jcen ,lat ,ztodt ,ra , & + iter ,uxl ,uxr ,vxl ,vxr , & + etadot(1,1,lat) ,qxl ,qxr ,lam , & + phi ,dphi ,etamid ,etaint ,detam , & + detai ,lbasdy ,lbasdz ,lbassd ,lbasiy , & + kdpmpf ,kdpmph ,lammp(1,1,lat), phimp(1,1,lat), sigmp(1,1,lat), & + qfcst(1,1,1,lat) ,adv_state, plon, hadv, nlonex ) + end do + call t_stopf ('sltb1') +! +! Copy SLT advection structure data back into dynamics data +! + call t_startf ('scanslt_ad_coup') + call ad_coupling( adv_state ) + call t_stopf ('scanslt_ad_coup') + return +end subroutine scanslt_run + +! +!----------------------------------------------------------------------- +! +subroutine scanslt_final( adv_state ) +!----------------------------------------------------------------------- +! +! Purpose: +! SLT finalization for Eulerian dynamics +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- +! +! Arguments +! + type(advection_state), intent(inout) :: adv_state ! Advection state data + + call adv_state_dealloc( adv_state ) +end subroutine scanslt_final + +! +!----------------------------------------------------------------------- +! + +subroutine ad_coupling( adv_state ) +!----------------------------------------------------------------------- +! +! Purpose: +! Copy advection data into dynamics state. +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- + use prognostics, only: u3, v3, qminus, n3m1 +! +! Arguments +! + type(advection_state), intent(in) :: adv_state ! Advection state data + + integer :: i, j, k, c ! Indices + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (J,K,I,C) +#endif + do j = beglat, endlat +!$OMP PARALLEL DO PRIVATE (K,I,C) + do k = 1, plev + do i = 1, plon + u3(i,k,j,n3m1) = adv_state%u3(i+i1-1,k,j+beglatex+numbnd-beglat) + v3(i,k,j,n3m1) = adv_state%v3(i+i1-1,k,j+beglatex+numbnd-beglat) + do c = 1, pcnst + qminus(i,k,c,j) = adv_state%qminus(i+i1-1,k,c,j+beglatex+numbnd-beglat) + end do + end do + end do + end do + +end subroutine ad_coupling + +! +!----------------------------------------------------------------------- +! + +subroutine da_coupling( cwava, adv_state ) +!----------------------------------------------------------------------- +! +! Purpose: +! Copy dynamics data into advection state +! Also find the total moisture mass before SLT. +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- + use prognostics, only: u3, v3, qminus, n3m1, ps, n3m2, q3, pdeld + use commap, only: w + use qmassa, only: qmassarun + +! +! Arguments +! + real(r8), intent(in) :: cwava(plat) ! weight for global water vapor int. + type(advection_state), intent(inout) :: adv_state ! Advection state data +! +! Local variables +! + integer :: i, j, k, c, irow, lat ! Indices + + real(r8) :: pmid(plon,plev) ! pressure at model levels + real(r8) :: pint(plon,plevp) ! pressure at interfaces + real(r8) :: pdel(plon,plev) ! pressure difference between +! +! Initialize moisture mass integrals. +! + hw1lat = 0.0_r8 +! +! Find moisture mass before SLT +! +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT, IROW, PINT, PMID, PDEL) +#endif + do lat=beglat,endlat + if(lat.le.plat/2) then + irow = lat + else + irow = plat + 1 - lat + end if +! +! Only pdel is needed inside SLT. pint and pmid are not. +! + call plevs0 (plon,plon,plev,ps(1,lat,n3m2), pint, pmid, pdel) +! +! Calculate mass of moisture in field being advected by slt. (hw1lat) +! + +! q3 is plon,plev,pcnst,beglat:endlat,ptimelevs +! qminus is plon,plev,pcnst,beglat:endlat + call qmassarun (cwava(lat),w(irow) ,qminus(1,1,1,lat),pdel , & + hw1lat(1,lat),plon, q3(1,1,1,lat,n3m2), lat, pdeld(:,:,lat,n3m2 )) + end do + +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (J,K,I,C) +#endif + do j = beglat, endlat +!$OMP PARALLEL DO PRIVATE (K,I,C) + do k = 1, plev + do i = 1, plon + adv_state%u3(i+i1-1,k,j+beglatex+numbnd-beglat) = u3(i,k,j,n3m1) + adv_state%v3(i+i1-1,k,j+beglatex+numbnd-beglat) = v3(i,k,j,n3m1) + do c = 1, pcnst + adv_state%qminus(i+i1-1,k,c,j+beglatex+numbnd-beglat) = qminus(i,k,c,j) + end do + end do + end do + end do + +end subroutine da_coupling + +! +!----------------------------------------------------------------------- +! + +subroutine adv_state_alloc( adv_state ) +!----------------------------------------------------------------------- +! +! Purpose: +! Allocate advection state data +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- + use infnan, only: posinf, assignment(=) +! +! Arguments +! + type(advection_state), intent(out) :: adv_state ! Advection state data + + allocate (adv_state%u3 (plond,plev ,beglatex:endlatex) ) + allocate (adv_state%v3 (plond,plev ,beglatex:endlatex) ) + allocate (adv_state%qminus(plond,plev,pcnst ,beglatex:endlatex) ) + adv_state%u3 (:,:, beglatex:endlatex) = posinf + adv_state%v3 (:,:, beglatex:endlatex) = posinf + adv_state%qminus(:,:,:,beglatex:endlatex) = posinf + +end subroutine adv_state_alloc + +! +!----------------------------------------------------------------------- +! + +subroutine adv_state_dealloc( adv_state ) +!----------------------------------------------------------------------- +! +! Purpose: +! De-allocate advection state data +! +! Author: +! +! Erik Kluzek +! +!----------------------------------------------------------------------- +! +! Arguments +! + type(advection_state), intent(inout) :: adv_state ! Advection state data + + deallocate (adv_state%u3 ) + deallocate (adv_state%v3 ) + deallocate (adv_state%qminus) + +end subroutine adv_state_dealloc + +! +!----------------------------------------------------------------------- +! + +subroutine grdini(pmap ,etamid ,etaint ,gravit ,dlam , & + lam ,phi ,dphi ,gw ,sinlam , & + coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & + detam ,detai ,kdpmpf ,kdpmph ,cwava ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize model and extended grid parameters +! Initialize weights for Lagrange cubic derivative estimates +! Initialize weights for Lagrange cubic interpolant +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- + use vrtmap_mod, only: vrtmap +!------------------------------Parameters------------------------------- +! +! Input arguments +! + integer, intent(in) :: pmap ! dimension of artificial vert. grid +! + real(r8), intent(in) :: etamid(plev) ! full-level model vertical grid + real(r8), intent(in) :: etaint(plevp) ! half-level model vertical grid + real(r8), intent(in) :: gravit ! gravitational constant +! +! Output arguments +! + real(r8), intent(out) :: dlam(platd) ! longitudinal grid interval (radians) + real(r8), intent(out) :: lam (plond,platd) ! longitudinal coords of extended grid + real(r8), intent(out) :: phi (platd) ! latitudinal coords of extended grid + real(r8), intent(out) :: dphi (platd) ! latitude intervals (radians) + real(r8), intent(out) :: gw (plat) ! Gaussian weights + real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) model domain only + real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) model domain only + real(r8), intent(out) :: lbasdy(4,2,platd) ! latitude derivative weights + real(r8), intent(out) :: lbasdz(4,2,plev) ! vertical (full levels) deriv weights + real(r8), intent(out) :: lbassd(4,2,plevp) ! vertical (half levels) deriv weights + real(r8), intent(out) :: lbasiy(4,2,platd) ! Lagrange cubic interp weights (lat.) + real(r8), intent(out) :: detam (plev) ! intervals between vertical full levs. + real(r8), intent(out) :: detai (plevp) ! intervals between vertical half levs. +! + integer, intent(out) :: kdpmpf(pmap) ! artificial full vertical grid indices + integer, intent(out) :: kdpmph(pmap) ! artificial half vertical grid indices +! + real(r8), intent(out) :: cwava(plat) ! weight applied to global integrals +! +!----------------------------------------------------------------------- +! +! pmap Dimension of artificial evenly spaced vertical grid arrays +! etamid Full-index hybrid-levels in vertical grid. +! etaint Half-index hybrid-levels from sig(1/2) = etaint(1) = 0. to +! sig(plev+1/2) = etaint(plevp) = 1. +! gravit Gravitational constant. +! dlam Length of increment in longitude grid. +! lam Longitude values in the extended grid. +! phi Latitude values in the extended grid. +! dphi Interval between latitudes in the extended grid +! gw Gauss weights for latitudes in the global grid. (These sum +! to 2.0.) +! sinlam Sine of longitudes in global grid (no extension points). +! coslam Cosine of longitudes in global grid (no extension points). +! lbasdy Weights for Lagrange cubic derivative estimates on the +! unequally spaced latitude grid +! lbasdz Weights for Lagrange cubic derivative estimates on the +! unequally spaced vertical grid (corresponding to model +! full levels). +! lbassd Weights for Lagrange cubic derivative estimates on the +! unequally spaced vertical grid (corresponding to model +! half levels). +! lbasiy Weights for Lagrange cubic interpolation on the +! unequally spaced latitude grid +! detam Increment between model mid-levels ("full" levels) +! detai Increment between model interfaces ("half" levels). +! kdpmpf Array of indicies of the model full levels which are mapped +! into an artificial evenly spaced vertical grid. Used to aid +! in search for vertical position of departure point +! kdpmph Array of indicies of the model half levels which are mapped +! into an artificial evenly spaced vertical grid. Used to aid +! in search for vertical position of departure point +! cwava 1./(plon*gravit) +! +!---------------------------Local variables----------------------------- +! + integer j ! index + integer k ! index +! + real(r8) etamln(plev) ! log(etamid) + real(r8) etailn(plevp) ! log(etaint) + real(r8) detamln(plev) ! dlog(etamid) + real(r8) detailn(plevp) ! dlog(etaint) +! +!----------------------------------------------------------------------- + if (single_column) then + + dlam(:)=0._r8 + lam(:,:)=0._r8 + phi(:)=0._r8 + dphi(:)=0._r8 + sinlam(:,:)=0._r8 + coslam(:,:)=0._r8 + detai(:)=0._r8 + kdpmpf(:)=0._r8 + kdpmph(:)=0._r8 + gw(:)=1._r8 + call basdz(plev ,etamid ,lbasdz ) + call basdz(plevp ,etaint ,lbassd ) + + else + ! + ! Initialize extended horizontal grid coordinates. + ! + call grdxy(dlam ,lam ,phi ,gw ,sinlam , & + coslam ) + ! + ! Basis functions for computing Lagrangian cubic derivatives + ! on unequally spaced latitude and vertical grids. + ! + call basdy(phi ,lbasdy ) + + call basdz(plev ,etamid ,lbasdz ) + call basdz(plevp ,etaint ,lbassd ) + + + ! + ! Basis functions for computing weights for Lagrangian cubic + ! interpolation on unequally spaced latitude grids. + ! + call basiy(phi ,lbasiy ) + ! + ! Compute interval lengths in latitudinal grid + ! + do j = 1,platd-1 + dphi(j) = phi(j+1) - phi(j) + end do + + endif +! +! Compute interval lengths in vertical grids. +! + do k = 1,plev + etamln(k) = log(etamid(k)) + end do + do k = 1,plevp + etailn(k) = log(etaint(k)) + end do + do k = 1,plev-1 + detam (k) = etamid(k+1) - etamid(k) + detamln(k) = etamln(k+1) - etamln(k) + end do + do k = 1,plev + detai (k) = etaint(k+1) - etaint(k) + detailn(k) = etailn(k+1) - etailn(k) + end do +! +! Build artificial evenly spaced vertical grid for use in determining +! vertical position of departure point. +! Build one grid for full model levels and one for half levels. +! + call vrtmap(plev ,pmap ,etamln ,detamln ,kdpmpf ) + call vrtmap(plevp ,pmap ,etailn ,detailn ,kdpmph ) +! +! Compute moisture integration constant +! +if (single_column) then + cwava = 1._r8 +else + do j=1,plat + cwava(j) = 1._r8/(plon*gravit) + end do +endif +! + return +end subroutine grdini + +! +!----------------------------------------------------------------------- +! + +subroutine grdxy(dlam ,lam ,phi ,w ,sinlam , & + coslam ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Define the "extended" grid used in the semi-Lagrangian transport +! scheme. The longitudes are equally spaced and the latitudes are +! Gaussian. The global grid is extended to include "wraparound" points +! on all sides. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- + use gauaw_mod, only: gauaw +!------------------------------Parameters------------------------------- + integer, parameter :: istart = nxpt+1 ! index for first model long. + integer, parameter :: jstart = nxpt+jintmx+1 ! index for first model lat. + integer, parameter :: jstop = jstart-1+plat ! index for last model lat. +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + real(r8), intent(out) :: dlam(platd) ! longitudinal increment + real(r8), intent(out) :: lam (plond,platd) ! long. coords. in extended grid + real(r8), intent(out) :: phi (platd) ! lat. coords. in extended grid + real(r8), intent(out) :: w (plat) ! Gaussian weights + real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) + real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) +! +! dlam Length of increment in longitude grid. +! lam Longitude values in the extended grid. +! phi Latitude values in the extended grid. +! w Gauss weights for latitudes in the global grid. (These sum +! to 2.0 like the ones in CCM1.) +! sinlam Sine of longitudes in global grid (no extension points). +! coslam Cosine of longitudes in global grid (no extension points). +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,j,ig ! indices + integer nlond ! extended long dim + real(r8) lam0 ! lamda = 0 + real(r8) pi ! 3.14... + real(r8) wrk(platd) ! work space +!----------------------------------------------------------------------- +! + lam0 = 0.0_r8 + pi = 4._r8*atan(1._r8) +! +! Interval length in equally spaced longitude grid. +! + do j=1,platd + dlam(j) = 2._r8*pi/real(nlonex(j),r8) +! +! Longitude values on extended grid. +! + nlond = nlonex(j) + 1 + 2*nxpt + do i = 1,nlond + lam(i,j) = real(i-istart,r8)*dlam(j) + lam0 + end do + end do +! +! Compute Gauss latitudes and weights. On return; phi contains the +! sine of the latitudes starting closest to the north pole and going +! toward the south; w contains the corresponding Gauss weights. +! + call gauaw(phi ,w ,plat ) +! +! Reorder and compute latitude values. +! + do j = jstart,jstop + wrk(j) = asin( phi(jstop-j+1) ) + end do + phi(jstart:jstop) = wrk(jstart:jstop) +! +! North and south poles. +! + phi(jstart-1) = -pi/2.0_r8 + phi(jstop +1) = pi/2.0_r8 +! +! Extend Gauss latitudes below south pole so that the spacing above +! the pole is symmetric, and phi is decreasing, i.e., phi < -pi/2 +! + if( jstart > 2 )then + do j = 1,jstart-2 + phi(j) = -pi - phi(2*jstart-2-j) + end do + end if +! +! Analogously for Northern Hemisphere +! + if( platd > jstop+1 )then + do j = jstop+2,platd + phi(j) = pi - phi(2*jstop+2-j) + end do + end if +! +! Sine and cosine of longitude. +! + do j=1,platd + ig = 0 + do i = istart,nlonex(j)+nxpt + ig = ig + 1 + sinlam(ig,j) = sin( lam(i,j) ) + coslam(ig,j) = cos( lam(i,j) ) + end do + end do + + return +end subroutine grdxy + +! +!----------------------------------------------------------------------- +! + +subroutine sltb1(pmap ,jcen ,jgc ,dt ,ra , & + iterdp ,uxl ,uxr ,vxl ,vxr , & + wb ,fxl ,fxr ,lam ,phib , & + dphib ,sig ,sigh ,dsig ,dsigh , & + lbasdy ,lbasdz ,lbassd ,lbasiy ,kdpmpf , & + kdpmph ,lammp ,phimp ,sigmp ,fbout , & + adv_state ,nlon ,hadv ,nlonex ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Drive the slt algorithm on a given latitude slice in the extended +! data arrays using information from the entire latitudinal extent +! of the arrays. +! +! Method: +! Compute departure points and corresponding indices. +! Poleward of latitude phigs (radians), perform the computation in +! local geodesic coordinates. +! Equatorward of latitude phigs, perform the computation in global +! spherical coordinates +! +! Author: J. Olson +! +!----------------------------------------------------------------------- + +#include + +!------------------------------Parameters------------------------------- + real(r8), parameter :: phigs = 1.221730_r8 ! cut-off latitude: about 70 degrees +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + integer , intent(in) :: nlonex(platd) ! extended longitude dimension + integer , intent(in) :: pmap ! artificial vert grid dim. + integer , intent(in) :: jcen ! index of lat slice(extend) + integer , intent(in) :: jgc ! index of lat slice (model) + real(r8), intent(in) :: dt ! time step (seconds) + real(r8), intent(in) :: ra ! 1./(radius of earth) + integer , intent(in) :: iterdp ! iteration count + real(r8), intent(in) :: uxl(plond,plev,beglatex:endlatex) ! left x-deriv of ub + real(r8), intent(in) :: uxr(plond,plev,beglatex:endlatex) ! right x-deriv of ub + real(r8), intent(in) :: vxl(plond,plev,beglatex:endlatex) ! left x-deriv of vb + real(r8), intent(in) :: vxr(plond,plev,beglatex:endlatex) ! right x-deriv of vb + real(r8), intent(in) :: wb(plon,plevp) ! eta-dot + real(r8), intent(in) :: fxl(plond,plev, pcnst,beglatex:endlatex) ! left fb x-deriv + real(r8), intent(in) :: fxr(plond,plev, pcnst,beglatex:endlatex) ! right fb x-deriv + real(r8), intent(in) :: lam (plond,platd) ! long. coord of model grid + real(r8), intent(in) :: phib (platd) ! lat. coord of model grid + real(r8), intent(in) :: dphib(platd) ! increment between lats. + real(r8), intent(in) :: sig (plev) ! vertical full levels + real(r8), intent(in) :: sigh (plevp) ! vertical half levels + real(r8), intent(in) :: dsig (plev) ! inc. between full levs + real(r8), intent(in) :: dsigh(plevp) ! inc. between half levs + real(r8), intent(in) :: lbasdy(4,2,platd) ! lat deriv weights + real(r8), intent(in) :: lbasdz(4,2,plev) ! vert full level deriv wts + real(r8), intent(in) :: lbassd(4,2,plevp) ! vert half level deriv wts + real(r8), intent(in) :: lbasiy(4,2,platd) ! lat interp wts(lagrng) + integer , intent(in) :: kdpmpf(pmap) ! artificial vert grid index + integer , intent(in) :: kdpmph(pmap) ! artificial vert grid index + real(r8), intent(inout) :: hadv (plon, plev, pcnst, beglat:endlat) ! horizontal advection tendency + real(r8), intent(inout) :: lammp(plon,plev) ! long coord of mid-point + real(r8), intent(inout) :: phimp(plon,plev) ! lat coord of mid-point + real(r8), intent(inout) :: sigmp(plon,plev) ! vert coord of mid-point + real(r8), intent(out) :: fbout(plon,plev,pcnst) ! advected constituents + type(advection_state), intent(in) :: adv_state ! Advection state +! +! pmap Dimension of kdpmpX arrays +! jcen Latitude index in extended grid corresponding to lat slice +! being forecasted. +! jgc Latitude index in model grid corresponding to lat slice +! being forecasted. +! dt Time interval that parameterizes the parcel trajectory. +! ra Reciprocal of radius of earth. +! iterdp Number of iterations used for departure point calculation. +! uxl x-derivatives of u at the left (west) edge of given interval +! vxl x-derivatives of v at the left (west) edge of given interval +! uxr x-derivatives of u at the right (east) edge of given interval +! vxr x-derivatives of v at the right (east) edge of given interval +! wb z-velocity component (eta-dot). +! fxl x-derivatives at the left edge of each interval containing +! the departure point. +! fxr x-derivatives at the right edge of each interval containing +! the departure point. +! lam Longitude values for the extended grid. +! phib Latitude values for the extended grid. +! dphib Interval between latitudes in the extended grid. +! sig Hybrid eta values at the "full-index" levels. +! sigh Half-index eta-levels including sigh(i,1) = eta(1/2) = 0.0 +! and sigh(i,plev+1) = eta(plev+1/2) = 1. Note that in general +! sigh(i,k) .lt. sig(i,k) where sig(i,k) is the hybrid value +! at the k_th full-index level. +! dsig Interval lengths in full-index hybrid level grid. +! dsigh Interval lengths in half-index hybrid level grid. +! lbasdy Weights for Lagrange cubic derivative estimates on the +! unequally spaced latitude grid. +! lbasdz Weights for Lagrange cubic derivative estimates on the +! unequally spaced vertical grid (full levels). +! lbassd Weights for Lagrange cubic derivative estimates on the +! unequally spaced vertical grid (half levels). +! lbasiy Weights for Lagrange cubic interpolation on the unequally +! spaced latitude grid. +! kdpmpf indices of artificial grid mapped into the full level grid +! kdpmph indices of artificial grid mapped into the half level grid +! lammp Longitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecasted. On entry lammp +! is an initial guess. +! phimp Latitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecasted. On entry phimp +! is an initial guess. +! sigmp Hybrid value at the trajectory midpoint for each gridpoint +! in a vertical slice from the global grid. On entry sigmp is +! an initial guess. +! fbout Extended array only one latitude of which, however, is filled +! with forecasted (transported) values. This routine must be +! called multiple times to fill the entire array. This is +! done to facilitate multi-tasking. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer m ! constituent index + integer idp(plon,plev,4) ! zonal dep point index + integer jdp(plon,plev) ! meridional dep point index + integer kdp(plon,plev) ! vertical dep point index + real(r8) fhr(plon,plev,pcnst) ! horizontal interpolants + real(r8) lamdp(plon,plev) ! zonal departure pt. coord. + real(r8) phidp(plon,plev) ! meridional departure pt. coord. + real(r8) sigdp(plon,plev) ! vertical departure pt. coord. + real(r8) fhst(plon,plev,pcnst) ! derivative at top of interval + real(r8) fhsb(plon,plev,pcnst) ! derivative at bot of interval + real(r8) wst(plon,plevp) ! w derivative at top of interval + real(r8) wsb(plon,plevp) ! w derivative at bot of interval + real(r8) fint(plon,plev,ppdy,pcnst) ! work space + real(r8) fyb(plon,plev,pcnst) ! work space + real(r8) fyt(plon,plev,pcnst) ! work space + logical locgeo ! flag indicating coordinate sys + integer :: k,i ! indices (needed for SCAM) +!----------------------------------------------------------------------- + if (.not. single_column) then + +! +! Horizontal interpolation +! + locgeo = abs(phib(jcen))>=phigs +! + call sphdep(jcen ,jgc ,dt ,ra ,iterdp , & + locgeo ,adv_state%u3 ,uxl ,uxr ,lam , & + phib ,lbasiy ,lammp ,phimp ,lamdp , & + phidp ,idp ,jdp ,adv_state%v3, & + vxl ,vxr ,nlon ,nlonex ) +! +! Interpolate scalar fields to the departure points. +! + call hrintp(pcnst ,pcnst ,adv_state%qminus, fxl ,fxr , & + lam ,phib ,dphib ,lbasdy ,lamdp , & + phidp ,idp ,jdp ,jcen ,plimdr , & + fint ,fyb ,fyt ,fhr ,nlon , & + nlonex ) + + do m = 1,pcnst +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + hadv(i,k,m,jgc) = (fhr(i,k,m) - adv_state%qminus(i1-1+i,k,m,jcen))/dt + end do + end do + end do +else +! +! fill in fhr in leiu of horizontal interpolation +! + do m = 1,pcnst + do k = 1,plev + do i = 1,nlon + fhr(i,k,m) = adv_state%qminus(i1+i-1,k,m,jcen) + hadv(i,k,m,jgc) = 0._r8 + end do + end do + end do +endif +! +! Vertical interpolation. +! Compute vertical derivatives of vertical wind +! + call cubzdr(nlon ,plevp ,wb ,lbassd ,wst , & + wsb ) +! +! Compute departure points and corresponding indices. +! + call vrtdep(pmap ,dt ,iterdp ,wb ,wst , & + wsb ,sig ,sigh ,dsigh ,kdpmpf , & + kdpmph ,sigmp ,sigdp ,kdp ,nlon ) +! +! Vertical derivatives of scalar fields. +! Loop over constituents. +! + do m = 1,pcnst + call cubzdr(nlon ,plev ,fhr(:,:,m), lbasdz ,fhst(:,:,m), & + fhsb(:,:,m) ) + end do + if( plimdr )then + call limdz(fhr ,dsig ,fhst ,fhsb ,nlon ) + end if +! +! Vertical interpolation of scalar fields. +! + call herzin(plev ,pcnst ,fhr ,fhst ,fhsb , & + sig ,dsig ,sigdp ,kdp ,fbout , & + nlon ) + + return +end subroutine sltb1 + +! +!============================================================================================ +! + +subroutine vrtdep(pmap ,dt ,iterdp ,wb ,wst , & + wsb ,sig ,sigh ,dsigh ,kdpmpf , & + kdpmph ,sigmp ,sigdp ,kdp ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute vertical departure point and departure point index. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + integer , intent(in) :: pmap ! dimension of artificial vert grid + real(r8), intent(in) :: dt ! time step (seconds) + integer , intent(in) :: iterdp ! number of iterations + real(r8), intent(in) :: wb (plon,plevp) ! vertical velocity + real(r8), intent(in) :: wst(plon,plevp) ! z-derivative of wb at top of interval + real(r8), intent(in) :: wsb(plon,plevp) ! z-derivative of wb at bot of interval + real(r8), intent(in) :: sig (plev ) ! sigma values of model full levels + real(r8), intent(in) :: sigh (plevp) ! sigma values of model half levels + real(r8), intent(in) :: dsigh(plevp) ! increment between half levels + integer , intent(in) :: kdpmpf(pmap) ! artificial grid indices + integer , intent(in) :: kdpmph(pmap) ! artificial grid indices + real(r8), intent(inout) :: sigmp(plon,plev) ! vert coords of traj mid-points + real(r8), intent(out) :: sigdp(plon,plev) ! vert coords of traj departure points + integer , intent(out) :: kdp(plon,plev) ! vertical departure point indices +! +! pmap Dimension of kdpmap arrays +! dt Time interval that parameterizes the parcel trajectory. +! iterdp Number of iterations used for departure point calculation. +! wb Vertical velocity component (sigma dot). +! wst z-derivs at the top edge of each interval contained in wb +! wsb z-derivs at the bot edge of each interval contained in wb +! sig Sigma values at the full-index levels. +! sigh Half-index sigma levels including sigh(1) = sigma(1/2) = 0.0 +! sigh(plev+1) = sigma(plev+1/2) = 1.0 . Note that in general +! sigh(k) .lt. sig(k) where sig(k) is the sigma value at the +! k_th full-index level. +! dsigh Increment in half-index sigma levels. +! kdpmpf Array of indices of the model full levels which are mapped +! into an artificial evenly spaced vertical grid. Used to aid +! in search for vertical position of departure point +! kdpmph Array of indices of the model half levels which are mapped +! into an artificial evenly spaced vertical grid. Used to aid +! in search for vertical position of departure point +! sigmp Sigma value at the trajectory midpoint for each gridpoint +! in a vertical slice from the global grid. On entry sigmp is +! an initial guess. +! sigdp Sigma value at the trajectory endpoint for each gridpoint +! in a vertical slice from the global grid. +! kdp Vertical index for each gridpoint. This index points into a +! vertical slice array whose vertical grid is given by sig. +! E.g., sig(kdp(i,k)) .le. sigdp(i,k) .lt. sig(kdp(i,k)+1). +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i ! | + integer iter ! |-- indices + integer k ! | + real(r8) wmp(plon,plev) ! vert vel. at midpoint +!----------------------------------------------------------------------- +! +! Loop over departure point iterates. +! + do iter = 1,iterdp +! +! Compute midpoint indices in half-index sigma-level arrays (use kdp +! as temporary storage). +! + call kdpfnd(plevp ,pmap ,sigh ,sigmp ,kdpmph , & + kdp ,nlon ) +! +! Interpolate sigma dot field to trajectory midpoints using Hermite +! cubic interpolant. +! + call herzin(plevp ,1 ,wb ,wst ,wsb , & + sigh ,dsigh ,sigmp ,kdp ,wmp , & + nlon ) +! +! Update estimate of trajectory midpoint. +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + sigmp(i,k) = sig(k) - .5_r8*dt*wmp(i,k) + end do + end do +! +! Restrict vertical midpoints to be between the top and bottom half- +! index sigma levels. +! + call vdplim(plevp ,sigh ,sigmp ,nlon) + end do +! +! Compute trajectory endpoints. +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + sigdp(i,k) = sig(k) - dt*wmp(i,k) + end do + end do +! +! Restrict vertical departure points to be between the top and bottom +! full-index sigma levels. +! + call vdplim(plev ,sig ,sigdp ,nlon) +! +! Vertical indices for trajectory endpoints that point into full-index +! sigma level arrays. +! + call kdpfnd(plev ,pmap ,sig ,sigdp ,kdpmpf , & + kdp ,nlon ) +! + return +end subroutine vrtdep + +! +!============================================================================================ +! + +subroutine vdplim(pkdim ,sig ,sigdp ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Restrict vertical departure points to be between the top and bottom +! sigma levels of the "full-" or "half-" level grid +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +!---------------------- Arguments -------------------------------------- + integer , intent(in) :: nlon ! longitude dimension + integer , intent(in) :: pkdim ! vertical dimension + real(r8), intent(in) :: sig(pkdim) ! vertical coordinate of model grid + real(r8), intent(inout) :: sigdp(plon,plev) ! vertical coords. of departure points. +! pkdim Vertical dimension of "sig" +! sig Sigma values at the "full" or "half" model levels +! sigdp Sigma value at the trajectory endpoint or midpoint for each +! gridpoint in a vertical slice from the global grid. This +! routine restricts those departure points to within the +! model's vertical grid. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k ! index +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + if (sigdp(i,k) < sig(1)) then + sigdp(i,k) = sig(1) + end if + if (sigdp(i,k) >= sig(pkdim)) then + sigdp(i,k) = sig(pkdim)*(1._r8 - 10._r8*epsilon(sigdp)) + end if + end do + end do + + return +end subroutine vdplim + +! +!----------------------------------------------------------------------- +! + +subroutine sltini(dlam, sinlam, coslam, uxl, uxr, & + vxl, vxr, qxl, qxr, adv_state ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Prepare the extended arrays for use in the SLT routines +! +! 1) Fill latitude extensions. +! 2) Fill longitude extensions. +! 3) Compute x-derivatives +! +! Method: +! Computational note: The latitude loop in this routine is multitasked +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +#include +!---------------------------Local parameters---------------------------- +! + integer puvpts ! number of u/v pts in lat slice + integer pqpts ! number of constituent pts in lat slice +! + parameter(puvpts = plond*plev, pqpts = plond*plev*pcnst) +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: dlam(platd) ! increment in x-direction + real(r8), intent(in) :: sinlam(plond,platd) ! sin(lamda) + real(r8), intent(in) :: coslam(plond,platd) ! cos(lamda) + real(r8), intent(inout) :: uxl (plond,plev, beglatex:endlatex) + real(r8), intent(inout) :: uxr (plond,plev, beglatex:endlatex) + real(r8), intent(inout) :: vxl (plond,plev, beglatex:endlatex) + real(r8), intent(inout) :: vxr (plond,plev, beglatex:endlatex) + real(r8), intent(inout) :: qxl (plond,plev,pcnst,beglatex:endlatex) + real(r8), intent(inout) :: qxr (plond,plev,pcnst,beglatex:endlatex) + type(advection_state), intent(inout) :: adv_state ! Advection data state +! +! +!----------------------------------------------------------------------- +! +! dlam Length of increment in longitude grid. +! sinlam Sin of longitudes in global grid (model grid pts only). +! coslam Cos of longitudes in global grid (model grid pts only). +! uxl x-derivatives of u at the left (west) edge of given interval +! vxl x-derivatives of v at the left (west) edge of given interval +! uxr x-derivatives of u at the right (east) edge of given interval +! vxr x-derivatives of v at the right (east) edge of given interval +! qxl x-derivatives of scalar species at the left (west) edge +! of given interval +! qxr x-derivatives of scalar species at the right (east) edge +! of given interval +! +!---------------------------Local variables----------------------------- +! + integer m,j,k ! index + integer nlond +! +!------------------------------Externals-------------------------------- +! + external cubxdr,extx,extys,extyv,limdx +! +!----------------------------------------------------------------------- +! +! Fill latitude extensions beyond the southern- and northern-most +! latitudes in the global grid +! + call t_startf ('slt_single') + if (beglatex .le. endlatex) then + call extyv(1, plev, coslam, sinlam, adv_state%u3, adv_state%v3) + call extys(pcnst, plev ,adv_state%qminus, pcnst) +! +! Fill longitude extensions +! + call extx(1 ,plev ,adv_state%u3, 1) + call extx(1 ,plev ,adv_state%v3, 1) + call extx(pcnst, plev ,adv_state%qminus, pcnst) + endif + call t_stopf ('slt_single') +! +! Compute x-derivatives. +! +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (J, NLOND, K, M) +#endif + do j = beglatex, endlatex + nlond = 1 + 2*nxpt + nlonex(j) +!$OMP PARALLEL DO PRIVATE (K, M) + do k=1,plev + call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%u3(1:nlond,k,j), & + uxl(1:nlond,k,j), uxr(1:nlond,k,j)) + call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%v3(1:nlond,k,j), & + vxl(1:nlond,k,j), vxr(1:nlond,k,j)) + do m=1,pcnst + call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%qminus(1:nlond,k,m,j), & + qxl(1:nlond,k,m,j), qxr(1:nlond,k,m,j)) + if( plimdr )then + call limdx (nlond, 2, nlond-3, dlam(j), adv_state%qminus(1:nlond,k,m,j), & + qxl(1:nlond,k,m,j), qxr(1:nlond,k,m,j)) + end if + end do + end do + end do + + return +end subroutine sltini + +! +!----------------------------------------------------------------------- +! + +end module scanslt diff --git a/src/dynamics/eul/scmforecast.F90 b/src/dynamics/eul/scmforecast.F90 new file mode 100644 index 0000000000..f9c0cbc6a8 --- /dev/null +++ b/src/dynamics/eul/scmforecast.F90 @@ -0,0 +1,562 @@ +module scmforecast + ! --------------------------------------------------------------------------- ! + ! ! + ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! + ! --------------------------------------------------------------------------- ! + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_control_mod, only: adiabatic + + implicit none + private + save + + public forecast +! +! Private module data +! + +!======================================================================= +contains +!======================================================================= + + + subroutine forecast( lat , nlon , ztodt , & + psm1 , psm2 , ps , & + u3 , u3m1 , u3m2 , & + v3 , v3m1 , v3m2 , & + t3 , t3m1 , t3m2 , & + q3 , q3m1 , q3m2 , & + tten_phys , uten_phys , vten_phys , & + qminus , qfcst ) + + ! --------------------------------------------------------------------------- ! + ! ! + ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! + ! Author : Sungsu Park. 2010. Sep. ! + ! ! + ! --------------------------------------------------------------------------- ! + + use shr_kind_mod, only : r8 => shr_kind_r8, i8 => shr_kind_i8 + use pmgrid, only : plev, plat, plevp, plon + use cam_history, only : outfld + use constituents, only : pcnst, cnst_get_ind, cnst_name + use physconst, only : rair, cpair, gravit, rga + use scammod, only : divq,divq3d,divt,divu,divt3d,divu3d,have_divv, & + divv,divv3d,have_aldif,have_aldir,have_asdif,have_asdir, & + have_cld,have_cldice,have_cldliq,have_clwp,have_divq,have_divq3d, & + have_divt,have_divt3d,have_divu,have_divu3d,have_divv3d,have_numice, & + have_numliq,have_omega,have_phis,have_prec,have_ps,have_ptend, & + have_q,have_q1,have_q2,have_t,have_u,have_v, & + have_vertdivq,have_vertdivt,have_vertdivu,have_vertdivv,qdiff,qobs, & + scm_relax_bot_p,scm_relax_linear,scm_relax_tau_bot_sec, & + scm_relax_tau_sec,scm_relax_tau_top_sec,scm_relax_top_p, & + scm_relaxation,scm_use_obs_qv,scm_use_obs_t,scm_use_obs_uv,scm_zadv_q,scm_zadv_t, & + scm_zadv_uv,tdiff,tobs,uobs,use_3dfrc,use_camiop,vertdivq, & + vertdivt,vertdivu,vertdivv,vobs,wfld,qinitobs,scm_relax_fincl + use time_manager, only : get_curr_calday, get_nstep, get_step_size, is_first_step + use cam_abortutils, only : endrun + use string_utils, only: to_upper + + implicit none + + ! ---------------------- ! + ! Parameters ! + ! ---------------------- ! + + character(len=*), parameter :: subname = "forecast" + + ! --------------------------------------------------- ! + ! x = t, u, v, q ! + ! x3m1 : state variable used for computing 'forcing' ! + ! x3m2 : initial state variable before time-marching ! + ! x3 : final state variable after time-marching ! + ! --------------------------------------------------- ! + + integer, intent(in) :: lat + integer, intent(in) :: nlon + real(r8), intent(in) :: ztodt ! Twice time step unless nstep = 0 [ s ] + + real(r8), intent(in) :: ps(plon) ! Surface pressure [ Pa ] + real(r8), intent(in) :: psm1(plon) ! Surface pressure [ Pa ] + real(r8), intent(in) :: psm2(plon) ! Surface pressure [ Pa ] + + real(r8), intent(in) :: t3m1(plev) ! Temperature [ K ] + real(r8), intent(in) :: t3m2(plev) ! Temperature [ K ] + real(r8), intent(in) :: u3m1(plev) ! Zonal wind [ m/s ] + real(r8), intent(in) :: u3m2(plev) ! Zonal wind [ m/s ] + real(r8), intent(in) :: v3m1(plev) ! Meridional wind [ m/s ] + real(r8), intent(in) :: v3m2(plev) ! Meridional wind [ m/s ] + real(r8), intent(inout) :: q3m1(plev,pcnst) ! Tracers [ kg/kg, #/kg ] + real(r8), intent(inout) :: q3m2(plev,pcnst) ! Tracers [ kg/kg, #/kg ] + + real(r8), intent(inout) :: tten_phys(plev) ! Tendency of T by the 'physics' [ K/s ] + real(r8), intent(inout) :: uten_phys(plev) ! Tendency of u by the sum of 'physics + geostrophic forcing' [ m/s/s ] + real(r8), intent(inout) :: vten_phys(plev) ! Tendency of v by the sum of 'physics + geostrophic forcing' [ m/s/s ] + real(r8) qten_phys(plev,pcnst) ! Tendency of q by the 'physics' [ #/kg/s, kg/kg/s ] + real(r8), intent(in) :: qminus(plon,plev,pcnst) ! ( qminus - q3m2 ) / ztodt = Tendency of tracers by the 'physics' [ #/kg/s, kg/kg/s ] + + real(r8), intent(out) :: t3(plev) ! Temperature [ K ] + real(r8), intent(out) :: u3(plev) ! Zonal wind [ m/s ] + real(r8), intent(out) :: v3(plev) ! Meridional wind [ m/s ] + real(r8), intent(inout) :: q3(plev,pcnst) ! Tracers [ #/kg, kg/kg ] + real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! ( Input qfcst - q3m2 ) / ztodt = Tendency of q by the sum of 'physics' + 'SLT vertical advection' [ #/kg/s, kg/kg/s ] + + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer dummy + integer dummy_dyndecomp + integer i, k, m + integer ixcldliq, ixcldice, ixnumliq, ixnumice + real(r8) weight, fac + real(r8) pmidm1(plev) + real(r8) pintm1(plevp) + real(r8) pdelm1(plev) + real(r8) wfldint(plevp) + real(r8) pdelb(plon,plev) + real(r8) tfcst(plev) ! ( tfcst - t3m2 ) / ztodt = Tendency of T by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ K/s ] + real(r8) ufcst(plev) ! ( ufcst - u3m2 ) / ztodt = Tendency of u by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] + real(r8) vfcst(plev) ! ( vfcst - u3m2 ) / ztodt = Tendency of v by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] + logical scm_fincl_empty + ! ----------------------------------------------- ! + ! Centered Eulerian vertical advective tendencies ! + ! ----------------------------------------------- ! + + real(r8) tten_zadv_EULc(plev) ! Vertical advective forcing of t [ K/s ] + real(r8) uten_zadv_EULc(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv_EULc(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) qten_zadv_EULc(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] + + ! --------------------------------- ! + ! SLT vertical advective tendencies ! + ! --------------------------------- ! + real(r8) qten_zadv_SLT(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] + + ! ---------------------------- ! + ! Eulerian compression heating ! + ! ---------------------------- ! + + real(r8) tten_comp_EUL(plev) ! Compression heating by vertical advection [ K/s ] + + ! ----------------------------------- ! + ! Final vertical advective tendencies ! + ! ----------------------------------- ! + + real(r8) tten_zadv(plev) ! Vertical advective forcing of t [ K/s ] + real(r8) uten_zadv(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) qten_zadv(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] + + ! --------------------------- ! + ! For 'scm_relaxation' switch ! + ! --------------------------- ! + + real(r8) rtau(plev) + real(r8) relax_T(plev) + real(r8) relax_u(plev) + real(r8) relax_v(plev) + real(r8) relax_q(plev,pcnst) + ! +++BPM: allow linear relaxation profile + real(r8) rslope ! [optional] slope for linear relaxation profile + real(r8) rycept ! [optional] y-intercept for linear relaxtion profile + +!+++ BPM check what we have: + if (masterproc .and. is_first_step()) write(iulog,*) 'SCAM FORECAST REPORT: ' , & + 'have_divq ', have_divq , & + 'have_divt ', have_divt , & + 'have_divq3d ', have_divq3d , & + 'have_vertdivt ', have_vertdivt , & + 'have_vertdivu ', have_vertdivu , & + 'have_vertdivv ', have_vertdivv , & + 'have_vertdivq ', have_vertdivq , & + 'have_divt3d ', have_divt3d , & + 'have_divu3d ', have_divu3d , & + 'have_divv3d ', have_divv3d , & + 'have_divu ', have_divu , & + 'have_divv ', have_divv , & + 'have_omega ', have_omega , & + 'have_phis ', have_phis , & + 'have_ptend ', have_ptend , & + 'have_ps ', have_ps , & + 'have_q ', have_q , & + 'have_q1 ', have_q1 , & + 'have_q2 ', have_q2 , & + 'have_prec ', have_prec , & + 'have_t ', have_t , & + 'have_u ', have_u , & + 'have_v ', have_v , & + 'have_cld ', have_cld , & + 'have_cldliq ', have_cldliq , & + 'have_cldice ', have_cldice , & + 'have_numliq ', have_numliq , & + 'have_numice ', have_numice , & + 'have_clwp ', have_clwp , & + 'have_aldir ', have_aldir , & + 'have_aldif ', have_aldif , & + 'have_asdir ', have_asdir , & + 'have_asdif ', have_asdif , & + 'use_camiop ', use_camiop , & + 'use_obs_uv ', scm_use_obs_uv , & + 'use_obs_qv ', scm_use_obs_qv , & + 'use_obs_T ', scm_use_obs_T , & + 'relaxation ', scm_relaxation , & + 'use_3dfrc ', use_3dfrc + + !---BPM + + + ! ---------------------------- ! + ! ! + ! Main Computation Begins Here ! + ! ! + ! ---------------------------- ! + + dummy = 2 + dummy_dyndecomp = 1 + + + ! ------------------------------------------------------------ ! + ! Calculate midpoint pressure levels ! + ! ------------------------------------------------------------ ! + call plevs0( nlon, plon, plev, psm1, pintm1, pmidm1, pdelm1 ) + + call cnst_get_ind( 'CLDLIQ', ixcldliq, abort=.false. ) + call cnst_get_ind( 'CLDICE', ixcldice, abort=.false. ) + call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. ) + call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. ) + + ! ------------------------------------------------------------ ! + ! Extract physical tendencies of tracers q. ! + ! Note 'tten_phys, uten_phys, vten_phys' are already input. ! + ! ------------------------------------------------------------ ! + + qten_phys(:plev,:pcnst) = ( qminus(1,:plev,:pcnst) - q3m2(:plev,:pcnst) ) / ztodt + + ! ----------------------------------------------------- ! + ! Extract SLT-transported vertical advective tendencies ! + ! TODO : Add in SLT transport of t u v as well ! + ! ----------------------------------------------------- ! + + qten_zadv_SLT(:plev,:pcnst) = ( qfcst(1,:plev,:pcnst) - qminus(1,:plev,:pcnst) ) / ztodt + + ! ------------------------------------------------------- ! + ! use_camiop = .true. : Use CAM-generated 3D IOP file ! + ! = .false. : Use User-generated SCAM IOP file ! + ! ------------------------------------------------------- ! + + + if( use_camiop ) then + do k = 1, plev + tfcst(k) = t3m2(k) + ztodt * tten_phys(k) + ztodt * divt3d(k) + ufcst(k) = u3m2(k) + ztodt * uten_phys(k) + ztodt * divu3d(k) + vfcst(k) = v3m2(k) + ztodt * vten_phys(k) + ztodt * divv3d(k) + do m = 1, pcnst + ! Below two lines are identical but in order to reproduce the bit-by-bit results + ! of CAM-3D simulation, I simply rewrite the 'original' into the 'expanded' one. + ! Below is the 'original' one. + ! qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq3d(k,m) ) + ! Below is the 'expanded' one. + qfcst(1,k,m) = qminus(1,k,m) + ztodt * divq3d(k,m) + enddo + enddo + + else + + ! ---------------------------------------------------------------------------- ! + ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! + ! SCAM-IOP file must provide omega at the mid-point not at the interface. ! + ! ---------------------------------------------------------------------------- ! + + wfldint(1) = 0._r8 + do k = 2, plev + weight = ( pintm1(k) - pmidm1(k-1) ) / ( pmidm1(k) - pmidm1(k-1) ) + wfldint(k) = ( 1._r8 - weight ) * wfld(k-1) + weight * wfld(k) + enddo + wfldint(plevp) = 0._r8 + + ! ------------------------------------------------------------ ! + ! Compute Eulerian compression heating due to vertical motion. ! + ! ------------------------------------------------------------ ! + + do k = 1, plev + tten_comp_EUL(k) = wfld(k) * t3m1(k) * rair / ( cpair * pmidm1(k) ) + enddo + + ! ---------------------------------------------------------------------------- ! + ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! + ! ---------------------------------------------------------------------------- ! + + do k = 2, plev - 1 + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) + wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) + vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) + wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) + uten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( u3m1(k+1) - u3m1(k) ) + wfldint(k) * ( u3m1(k) - u3m1(k-1) ) ) + do m = 1, pcnst + qten_zadv_EULc(k,m) = -fac * ( wfldint(k+1) * ( q3m1(k+1,m) - q3m1(k,m) ) + wfldint(k) * ( q3m1(k,m) - q3m1(k-1,m) ) ) + end do + end do + + k = 1 + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) ) + vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) ) + uten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( u3m1(k+1) - u3m1(k) ) ) + do m = 1, pcnst + qten_zadv_EULc(k,m) = -fac * ( wfldint(k+1) * ( q3m1(k+1,m) - q3m1(k,m) ) ) + end do + + k = plev + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) + vten_zadv_EULc(k) = -fac * ( wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) + uten_zadv_EULc(k) = -fac * ( wfldint(k) * ( u3m1(k) - u3m1(k-1) ) ) + do m = 1, pcnst + qten_zadv_EULc(k,m) = -fac * ( wfldint(k) * ( q3m1(k,m) - q3m1(k-1,m) ) ) + end do + + ! ------------------------------------- ! + ! Manupulate individual forcings before ! + ! computing the final forecasted state ! + ! ------------------------------------- ! + + ! -------------------------------------------------------------- ! + ! Select the type of vertical advection : EULc,IOP,OFF supported! + ! -------------------------------------------------------------- ! + + select case (scm_zadv_T) + case ('iop') + if (have_vertdivt) then + tten_zadv(:plev) = vertdivt(:plev) + else + call endrun( subname//':: user set scm_zadv_tten to iop but vertdivt not on file') + end if + case ('eulc') + tten_zadv(:) = tten_zadv_EULc(:) + tten_comp_EUL(:) + case ('off') + tten_zadv(:) = 0._r8 + end select + + select case (scm_zadv_uv) + case ('iop') + if (have_vertdivu .and. have_vertdivv) then + uten_zadv(:) = vertdivu(:) + vten_zadv(:) = vertdivv(:) + else + call endrun( subname//':: user set scm_zadv_uv to iop but vertdivu/v not on file') + end if + case ('eulc') + uten_zadv(:) = uten_zadv_EULc(:) + vten_zadv(:) = vten_zadv_EULc(:) + case ('off') + uten_zadv(:) = 0._r8 + vten_zadv(:) = 0._r8 + end select + + select case (scm_zadv_q) + case ('iop') + if (have_vertdivq) then + qten_zadv(:plev,:pcnst) = vertdivq(:plev,:pcnst) + else + call endrun( subname//':: user set scm_zadv_qten to iop but vertdivq not on file') + end if + case ('eulc') + qten_zadv(:plev,:pcnst) = qten_zadv_EULc(:plev,:pcnst) + case ('slt') + qten_zadv = qten_zadv_SLT + case ('off') + qten_zadv = 0._r8 + end select + + ! -------------------------------------------------------------- ! + ! Check horizontal advection u,v,t,q ! + ! -------------------------------------------------------------- ! + if (.not. have_divu) divu=0._r8 + if (.not. have_divv) divv=0._r8 + if (.not. have_divt) divt=0._r8 + if (.not. have_divq) divq=0._r8 + + ! ----------------------------------- ! + ! ! + ! Compute the final forecasted states ! + ! ! + ! ----------------------------------- ! + ! make sure we have everything ! + ! ----------------------------------- ! + + if( .not. scm_use_obs_uv .and. .not. have_divu .and. .not. have_divv ) then + call endrun( subname//':: divu and divv not on the iop Unable to forecast Wind Set & + scm_use_obs_uv=true to use observed u and v') + end if + if( .not. scm_use_obs_T .and. .not. have_divt) then + call endrun( subname//':: divt not on the dataset. Unable to forecast Temperature. Stopping') + end if + if( .not. scm_use_obs_qv .and. .not. have_divq) then + call endrun( subname//':: divq not on the dataset. Unable to forecast Humidity. Stopping') + end if + + do k = 1, plev + tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) + divt(k) + tten_zadv(k) ) + ufcst(k) = u3m2(k) + ztodt * ( uten_phys(k) + divu(k) + uten_zadv(k) ) + vfcst(k) = v3m2(k) + ztodt * ( vten_phys(k) + divv(k) + vten_zadv(k) ) + do m = 1, pcnst + qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) + enddo + enddo + + ! ------------------ ! + ! Diagnostic Outputs ! + ! ------------------ ! + + call outfld( 'TTEN_XYADV' , divt, plon, dummy_dyndecomp ) + call outfld( 'UTEN_XYADV' , divu, plon, dummy_dyndecomp ) + call outfld( 'VTEN_XYADV' , divv, plon, dummy_dyndecomp ) + call outfld( 'QVTEN_XYADV', divq(:,1), plon, dummy_dyndecomp ) + if (.not.adiabatic) then + call outfld( 'QLTEN_XYADV', divq(:,ixcldliq), plon, dummy_dyndecomp ) + call outfld( 'QITEN_XYADV', divq(:,ixcldice), plon, dummy_dyndecomp ) + call outfld( 'NLTEN_XYADV', divq(:,ixnumliq), plon, dummy_dyndecomp ) + call outfld( 'NITEN_XYADV', divq(:,ixnumice), plon, dummy_dyndecomp ) + call outfld( 'QLTEN_ZADV' , qten_zadv(:,ixcldliq), plon, dummy_dyndecomp ) + call outfld( 'QITEN_ZADV' , qten_zadv(:,ixcldice), plon, dummy_dyndecomp ) + call outfld( 'NLTEN_ZADV' , qten_zadv(:,ixnumliq), plon, dummy_dyndecomp ) + call outfld( 'NITEN_ZADV' , qten_zadv(:,ixnumice), plon, dummy_dyndecomp ) + call outfld( 'QLTEN_PHYS' , qten_phys(:,ixcldliq), plon, dummy ) + call outfld( 'QITEN_PHYS' , qten_phys(:,ixcldice), plon, dummy ) + call outfld( 'NLTEN_PHYS' , qten_phys(:,ixnumliq), plon, dummy ) + call outfld( 'NITEN_PHYS' , qten_phys(:,ixnumice), plon, dummy ) + end if + call outfld( 'TTEN_ZADV' , tten_zadv, plon, dummy_dyndecomp ) + call outfld( 'UTEN_ZADV' , uten_zadv, plon, dummy_dyndecomp ) + call outfld( 'VTEN_ZADV' , vten_zadv, plon, dummy_dyndecomp ) + call outfld( 'QVTEN_ZADV' , qten_zadv(:,1), plon, dummy_dyndecomp ) + call outfld( 'TTEN_ZADV' , vertdivt, plon, dummy_dyndecomp ) + call outfld( 'QVTEN_ZADV' , vertdivq(:,1), plon, dummy_dyndecomp ) + + call outfld( 'TTEN_PHYS' , tten_phys, plon, dummy ) + call outfld( 'UTEN_PHYS' , uten_phys, plon, dummy ) + call outfld( 'VTEN_PHYS' , vten_phys, plon, dummy ) + call outfld( 'QVTEN_PHYS' , qten_phys(:,1), plon, dummy ) + + endif + + ! ---------------------------------------------------------------- ! + ! Used the SCAM-IOP-specified state instead of forecasted state ! + ! at each time step if specified by the switch. ! + ! If SCAM-IOP has 't,u,v,q' profile at a single initial time step. ! + ! ---------------------------------------------------------------- ! + + if( scm_use_obs_T .and. have_t ) then + do k = 1, plev + tfcst(k) = tobs(k) + enddo + endif + + if( scm_use_obs_uv .and. have_u .and. have_v ) then + do k = 1, plev + ufcst(k) = uobs(k) + vfcst(k) = vobs(k) + enddo + endif + + if( scm_use_obs_qv .and. have_q ) then + do k = 1, plev + qfcst(1,k,1) = qobs(k) + enddo + endif + + ! ------------------------------------------------------------------- ! + ! Relaxation to the observed or specified state ! + ! We should specify relaxation time scale ( rtau ) and ! + ! target-relaxation state ( in the current case, either 'obs' or 0 ) ! + ! ------------------------------------------------------------------- ! + + relax_T(:) = 0._r8 + relax_u(:) = 0._r8 + relax_v(:) = 0._r8 + relax_q(:plev,:pcnst) = 0._r8 + ! +++BPM: allow linear relaxation profile + ! scm_relaxation is a logical from scamMod + ! scm_relax_tau_top_sec and scm_relax_tau_bot_sec are the relaxation times at top and bottom of layer + ! also defined in scamMod + if ( scm_relaxation.and.scm_relax_linear ) then + rslope = (scm_relax_top_p - scm_relax_bot_p)/(scm_relax_tau_top_sec - scm_relax_tau_bot_sec) + rycept = scm_relax_tau_top_sec - (rslope*scm_relax_top_p) + endif + + ! prepare scm_relax_fincl for comparison in scmforecast.F90 + scm_fincl_empty=.true. + do i=1,pcnst + if (len_trim(scm_relax_fincl(i)) > 0) then + scm_fincl_empty=.false. + scm_relax_fincl(i)=trim(to_upper(scm_relax_fincl(i))) + end if + end do + + do k = 1, plev + if( scm_relaxation ) then + if ( pmidm1(k).le.scm_relax_bot_p.and.pmidm1(k).ge.scm_relax_top_p ) then ! inside layer + if (scm_relax_linear) then + rtau(k) = rslope*pmidm1(k) + rycept ! linear regime + else + rtau(k) = max( ztodt, scm_relax_tau_sec ) ! constant for whole layer / no relax outside + endif + else if (scm_relax_linear .and. pmidm1(k).le.scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value + rtau(k) = scm_relax_tau_top_sec ! above layer keep rtau equal to the top + endif + ! +BPM: this can't be the best way... + ! I put this in because if rtau doesn't get set above, then I don't want to do any relaxation in that layer. + ! maybe the logic of this whole loop needs to be re-thinked. + if (rtau(k).ne.0) then + relax_T(k) = - ( tfcst(k) - tobs(k) ) / rtau(k) + relax_u(k) = - ( ufcst(k) - uobs(k) ) / rtau(k) + relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) + relax_q(k,1) = - ( qfcst(1,k,1) - qobs(k) ) / rtau(k) + do m = 2, pcnst + relax_q(k,m) = - ( qfcst(1,k,m) - qinitobs(k,m) ) / rtau(k) + enddo + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'T')) & + tfcst(k) = tfcst(k) + relax_T(k) * ztodt + if (scm_fincl_empty .or.ANY(scm_relax_fincl(:).eq.'U')) & + ufcst(k) = ufcst(k) + relax_u(k) * ztodt + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'V')) & + vfcst(k) = vfcst(k) + relax_v(k) * ztodt + do m = 1, pcnst + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) .eq. trim(to_upper(cnst_name(m)))) ) then + qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt + end if + enddo + end if + endif + enddo + call outfld( 'TRELAX' , relax_T , plon, dummy ) + call outfld( 'QRELAX' , relax_q(1:plev,1) , plon, dummy ) + call outfld( 'TAURELAX' , rtau , plon, dummy ) + + ! --------------------------------------------------------- ! + ! Assign the final forecasted state to the output variables ! + ! --------------------------------------------------------- ! + + t3(1:plev) = tfcst(1:plev) + u3(1:plev) = ufcst(1:plev) + v3(1:plev) = vfcst(1:plev) + q3(1:plev,1:pcnst) = qfcst(1,1:plev,1:pcnst) + + tdiff(1:plev) = t3(1:plev) - tobs(1:plev) + qdiff(1:plev) = q3(1:plev,1) - qobs(1:plev) + + call outfld( 'QDIFF' , qdiff, plon, dummy_dyndecomp ) + call outfld( 'TDIFF' , tdiff, plon, dummy_dyndecomp ) + + return + + end subroutine forecast + end module scmforecast diff --git a/src/dynamics/eul/settau.F90 b/src/dynamics/eul/settau.F90 new file mode 100644 index 0000000000..80ec456e00 --- /dev/null +++ b/src/dynamics/eul/settau.F90 @@ -0,0 +1,543 @@ +subroutine settau(zdt) + +!----------------------------------------------------------------------- +! +! Purpose: +! Set time invariant hydrostatic matrices, which depend on the reference +! temperature and pressure in the semi-implicit time step. Note that +! this subroutine is actually called twice, because the effective time +! step changes between step 0 and step 1. +! +! Method: +! zdt = delta t for next semi-implicit time step. +! +! Author: CCM1 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use commap + use physconst, only: cappa, rair, gravit + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use hycoef, only : hypi, hybi, hypd + use sgexx, only: dgeco, dgedi + use cam_logfile, only: iulog + + implicit none + + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: zdt ! time step (or dt/2 at time 0) +!---------------------------Local workspace----------------------------- + real(r8) aq(plev,plev) + real(r8) rcond,z(plev),det(2),work(plev) + integer ipvt(plev) + real(r8) zcr(plev) ! gravity wave equivalent depth + real(r8) zci(plev) ! dummy, used to print phase speeds + real(r8) zdt2 ! zdt**2 + real(r8) factor ! intermediate workspace + real(r8) zdt0u ! vertical diff. of ref. temp (above) + real(r8) zshu ! interface "sigma" (above) + real(r8) zr2ds ! 1./(2.*hypd(k)) + real(r8) zdt0d ! vertical diff. of ref. temp (below) + real(r8) zshd ! interface "sigma" (below) + real(r8) ztd ! temporary accumulator + real(r8) zcn ! sq(n) + real(r8) zb(plev,plev) ! semi-implicit matrix in d equation + real(r8), save :: zdt_init=0 ! reinitialize if zdt <> zdt_init + + integer k,kk,kkk ! level indices + integer n ! n-wavenumber index + integer nneg ! number of unstable mean temperatures +!----------------------------------------------------------------------- +! + if (zdt == zdt_init) return + +! save dt for which this code has performed the initialization + zdt_init=zdt + + zdt2 = zdt*zdt +! +! Set mean temperature +! NOTE: Making t0 an actual function of height ***DOES NOT WORK*** +! + do k=1,plev + t0(k) = 300._r8 + end do +! +! Calculate hydrostatic matrix tau +! + zdt0u = 0._r8 + zshu = 0._r8 + do k=1,plev + zr2ds = 1._r8/(2._r8*hypd(k)) + if (k < plev) then + zdt0d = t0(k+1) - t0(k) + zshd = hybi(k+1) + else + zdt0d = 0._r8 + zshd = 0._r8 + end if + + factor = ((zdt0u*zshu + zdt0d*zshd) - (zdt0d + zdt0u))*zr2ds + do kk=1,k-1 + tau(kk,k) = factor*hypd(kk) + cappa*t0(k)*ecref(kk,k) + end do + + factor = (zdt0u*zshu + zdt0d*zshd - zdt0d)*zr2ds + tau(k,k) = factor*hypd(k) + cappa*t0(k)*ecref(k,k) + + factor = (zdt0u*zshu + zdt0d*zshd)*zr2ds + do kk=k+1,plev + tau(kk,k) = factor*hypd(kk) + end do + zdt0u = zdt0d + zshu = zshd + end do +! +! Vector for linear surface pressure term in divergence +! Pressure gradient and diagonal term of hydrostatic components +! + do k=1,plev + bps(k) = t0(k) + bps(k) = bps(k)*rair + end do + do k=1,plev + do kk=1,plev + ztd = bps(k) * hypd(kk)/hypi(plevp) + do kkk=1,plev + ztd = ztd + href(kkk,k)*tau(kk,kkk) + end do + zb(kk,k) = ztd + aq(kk,k) = ztd + end do + end do +! +! Compute and print gravity wave equivalent depths and phase speeds +! + call qreig(zb ,plev ,zcr ) + + do k=1,plev + zci(k) = sign(1._r8,zcr(k))*sqrt(abs(zcr(k))) + zcr(k) = zcr(k) / gravit + end do + + if (masterproc) then + write(iulog,910) (t0(k),k=1,plev) + write(iulog,920) (zci(k),k=1,plev) + write(iulog,930) (zcr(k),k=1,plev) + end if +! +! Test for unstable mean temperatures (negative phase speed and eqivalent +! depth) for at least one gravity wave. +! + nneg = 0 + do k=1,plev + if (zcr(k)<=0._r8) nneg = nneg + 1 + end do + + if (nneg/=0) then + call endrun ('SETTAU: UNSTABLE MEAN TEMPERATURE.') + end if +! +! Compute and invert matrix a(n)=(i+sq*b*delt**2) +! + do k=1,plev + do kk=1,plev + aq(kk,k) = aq(kk,k)*zdt2 + bm1(kk,k,1) = 0._r8 + end do + end do + do n=2,pnmax + zcn = sq(n) + do k=1,plev + do kk=1,plev + zb(kk,k) = zcn*aq(kk,k) + if(kk.eq.k) zb(kk,k) = zb(kk,k) + 1._r8 + end do + end do +! +! Use linpack routines to invert matrix +! + call dgeco(zb,plev,plev,ipvt,rcond,z) + call dgedi(zb,plev,plev,ipvt,det,work,01) + do k=1,plev + do kk=1,plev + bm1(kk,k,n) = zb(kk,k) + end do + end do + end do + +910 format(' REFERENCE TEMPERATURES FOR SEMI-IMPLICIT SCHEME = ', /(1x,12f9.3)) +920 format(' GRAVITY WAVE PHASE SPEEDS (M/S) FOR MEAN STATE = ' /(1x,12f9.3)) +930 format(' GRAVITY WAVE EQUIVALENT DEPTHS (M) FOR MEAN STATE = ' /(1x,12f9.3)) + + return +end subroutine settau + +!============================================================================================ + +subroutine qreig(a ,i ,b ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Create complex matrix P with real part = A and imaginary part = 0 +! Find its eigenvalues and return their real parts. +! +! Method: +! This routine is of unknown lineage. It is only used to provide the +! equivalent depths of the reference atmosphere for a diagnostic print +! in SETTAU and has no effect on the model simulation. Therefore it can +! be replaced at any time with a functionally equivalent, but more +! understandable, procedure. Consequently, the internal commenting has +! not been brought up to CAM standards. +! +! Author: +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: a(*) ! Input real part + integer , intent(in) :: i + real(r8), intent(out) :: b(*) +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + complex(r8) p(plev*plev) + complex(r8) q(plev*plev) + integer l,ij,ik ! indicies +!----------------------------------------------------------------------- +! +! l = 0 +! do ij=1,i +! do ik=1,i +! l = l + 1 +! p(l) = cmplx(a(l),0._r8,r8) +! end do +! end do + + do l = 1, i*i + p(l) = cmplx( a(l), 0.0_r8, r8) + end do + + call cmphes(p ,i ,1 ,i ) + call cmplr(p ,q ,i) + + do ij=1,i + b(ij) = real(q(ij),r8) + end do + + return +end subroutine qreig + +!============================================================================================ + +subroutine cmphes(ac ,nac ,k ,l ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Reduce complex matrix (ac) to upper Hessenburg matrix (ac) +! +! Method: +! This routine is of unknown lineage. It is only used to provide the +! equivalent depths of the reference atmosphere for a diagnostic print +! in SETTAU and has no effect on the model simulation. Therefore it can +! be replaced at any time with a functionally equivalent, but more +! understandable, procedure. Consequently, the internal commenting has +! not been brought up to CCM3 or CAM standards. +! +! Author: +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: nac ! Dimension of one side of matrix ac + integer, intent(in) :: k,l ! + complex(r8), intent(inout) :: ac(nac,nac) ! On input, complex matrix to be converted + ! On output, upper Hessenburg matrix +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + complex(r8) x + complex(r8) y + integer la + integer m1 + integer i,m,j ! Indices + integer j1,i1 ! Loop limits +!----------------------------------------------------------------------- +! + la = l - 1 + m1 = k + 1 + do m=m1,la + i = m + x = (0.0_r8,0.0_r8) + do j=m,l + if (abs(ac(j,m-1))>abs(x)) then + x = ac(j,m-1) + i = j + end if + end do + if (i/=m) then + j1 = m - 1 + do j=j1,nac + y = ac(i,j) + ac(i,j) = ac(m,j) + ac(m,j) = y + end do + do j=1,l + y = ac(j,i) + ac(j,i) = ac(j,m) + ac(j,m) = y + end do + end if + if (x/=(0.0_r8,0.0_r8)) then + i1 = m + 1 + do i=i1,l + y = ac(i,m-1) + if (y/=(0.0_r8,0.0_r8)) then + y = y/x + ac(i,m-1) = y + do j=m,nac + ac(i,j) = ac(i,j) - y*ac(m,j) + end do + do j=1,l + ac(j,m) = ac(j,m) + y*ac(j,i) + end do + end if + end do + end if + end do + + return +end subroutine cmphes + +!============================================================================================ + +subroutine cmplr(hes ,w ,nc) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute w, eigenvalues of upper Hessenburg matrix hes +! +! Method: +! This routine is of unknown lineage. It is only used to provide the +! equivalent depths of the reference atmosphere for a diagnostic print +! in SETTAU and has no effect on the model simulation. Therefore it can +! be replaced at any time with a functionally equivalent, but more +! understandable, procedure. Consequently, the internal commenting has +! not been brought up to CCM3 or CAM standards. +! +! Author: +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nc ! Dimension of input and output matrices + complex(r8), intent(inout) :: hes(nc,nc) ! Upper hessenberg matrix from comhes + complex(r8), intent(out):: w(nc) ! Weights +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer itest + integer nfail ! Limit for number of iterations to convergence + integer ntest + integer n,j,m + integer i ! Eigenvalue + integer its ! Iteration counter + integer l + integer l1,m1,n1,i1 + real(r8) a + real(r8) sr + real(r8) si + real(r8) tr + real(r8) ti + real(r8) xr + real(r8) yr + real(r8) zr + real(r8) xi + real(r8) yi + real(r8) areal + real(r8) eps + complex(r8) s + complex(r8) t + complex(r8) x + complex(r8) y + complex(r8) z + complex(r8) u + + data itest/0/ + save a,eps,sr,itest +!----------------------------------------------------------------------- +! + nfail = 30 + if (itest==0) then + a = 1 +5 continue + eps = a + sr = 1 + a + a = a/2.0_r8 + if (sr/=1.0_r8) go to 5 + itest = 1 + end if + if (nc.le.0) then + write(iulog,*)'CMPLR: Entered with incorrect dimension ' + write(iulog,*)'NC=',NC + call endrun + end if + ntest = 10 + n = nc + t = 0.0_r8 +10 continue + if (n==0) go to 300 + its = 0 +20 continue + if (n/=1) then + do l1=2,n + l = n + 2 - l1 + if (abs(hes(l,l-1)) <= eps*(abs(hes(l-1,l-1))+abs(hes(l,l)))) go to 50 + end do + end if + l = 1 +50 continue + if (l/=n) then + if (its==nfail) then + i = nc - n + 1 + write(iulog,*)'CMPLR: Failed to converge in ',nfail,' iterations' + write(iulog,*)'Eigenvalue=',i + call endrun + end if + if (its==ntest) then + ntest = ntest + 10 + sr = hes(n,n-1) + si = hes(n-1,n-2) + sr = abs(sr)+abs(si) + u = (0.0_r8,-1.0_r8)*hes(n,n-1) + tr = u + u = (0.0_r8,-1.0_r8)*hes(n-1,n-2) + ti = u + tr = abs(tr) + abs(ti) + s = cmplx(sr,tr) + else + s = hes(n,n) + x = hes(n-1,n)*hes(n,n-1) + if (abs(x)/=0.0_r8) then + y = 0.5_r8*(hes(n-1,n-1)-s) + u = y*y + x + z = sqrt(u) + u = conjg(z)*y + areal = u + if (areal<0.0_r8) z = -z + x = x/(y+z) + s = s - x + end if + end if + do i=1,n + hes(i,i) = hes(i,i) - s + end do + t = t + s + its = its + 1 + j = l + 1 + xr = abs(hes(n-1,n-1)) + yr = abs(hes(n,n-1)) + zr = abs(hes(n,n)) + n1 = n - 1 + if ((n1/=1).and.(n1>=j)) then + do m1=j,n1 + m = n1 + j - m1 + yi = yr + yr = abs(hes(m,m-1)) + xi = zr + zr = xr + xr = abs(hes(m-1,m-1)) + if (yr.le.eps*zr/yi*(zr+xr+xi)) go to 100 + end do + end if + m = l +100 continue + m1 = m + 1 + do i=m1,n + x = hes(i-1,i-1) + y = hes(i,i-1) + if (abs(x)0.0_r8) then + do i=l,j + z = hes(i,j-1) + hes(i,j-1) = hes(i,j) + hes(i,j) = z + end do + end if + do i=l,j + hes(i,j-1) = hes(i,j-1) + x*hes(i,j) + end do + end do + go to 20 + end if + w(n) = hes(n,n) + t + n = n - 1 + go to 10 +300 continue + + return +end subroutine cmplr + diff --git a/src/dynamics/eul/spegrd.F90 b/src/dynamics/eul/spegrd.F90 new file mode 100644 index 0000000000..0c89afa941 --- /dev/null +++ b/src/dynamics/eul/spegrd.F90 @@ -0,0 +1,512 @@ + +!----------------------------------------------------------------------- +! +! Purpose: +! Transfrom variables from spherical harmonic coefficients +! to grid point values during second gaussian latitude scan (scan2) +! +! Method: +! Assemble northern and southern hemisphere grid values from the +! symmetric and antisymmetric fourier coefficients. +! 1. Determine the fourier coefficients for the northern or southern +! hemisphere latitude. +! 2. Transform to gridpoint values +! 3. Clean up +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Reviewed: B. Boville, April 1996 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! + +subroutine spegrd_bft (lat ,nlon_fft, & + grdps ,grzs ,grds ,gruhs ,grvhs , & + grths ,grpss ,grus ,grvs ,grts , & + grpls ,grpms ,grdpa ,grza ,grda , & + gruha ,grvha ,grtha ,grpsa ,grua , & + grva ,grta ,grpla ,grpma ,fftbuf ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Preparation for transform of variables from spherical harmonic +! coefficients to grid point values during second gaussian latitude scan +! (scan2) +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Reviewed: B. Boville, April 1996 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plevp + use spmd_utils, only: iam + use comspe, only: maxm, numm +!----------------------------------------------------------------------- + implicit none +!--------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: lat ! latitude index + integer, intent(in) :: nlon_fft ! first dimension of FFT work array +! +! Symmetric fourier coefficient arrays for all variables transformed +! from spherical harmonics (see grcalc) +! + real(r8), intent(in) :: grdps(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8), intent(in) :: grzs(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) + real(r8), intent(in) :: grds(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) + real(r8), intent(in) :: gruhs(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grvhs(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grths(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8), intent(in) :: grpss(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) + real(r8), intent(in) :: grus(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grvs(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grts(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) + real(r8), intent(in) :: grpls(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a + real(r8), intent(in) :: grpms(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) +! +! Antisymmetric fourier coefficient arrays for all variables transformed +! from spherical harmonics (see grcalc) +! + real(r8), intent(in) :: grdpa(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) + real(r8), intent(in) :: grza(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) + real(r8), intent(in) :: grda(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) + real(r8), intent(in) :: gruha(2*maxm,plev) ! sum(n)K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grvha(2*maxm,plev) ! sum(n)K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grtha(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) + real(r8), intent(in) :: grpsa(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) + real(r8), intent(in) :: grua(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grva(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) + real(r8), intent(in) :: grta(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) + real(r8), intent(in) :: grpla(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a + real(r8), intent(in) :: grpma(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) + + real(r8), intent(out) :: fftbuf(nlon_fft,8,plevp) ! buffer used for in-place FFTs + +! +!---------------------------Local workspace----------------------------- +! + integer i,k ! longitude, level indices + integer rmlength ! twice number of local wavenumbers + integer, parameter :: vortdex = 1 ! indices into fftbuf + integer, parameter :: divdex = 2 + integer, parameter :: duhdex = 3 + integer, parameter :: dvhdex = 4 + integer, parameter :: dthdex = 5 + integer, parameter :: u3dex = 6 + integer, parameter :: v3dex = 7 + integer, parameter :: t3dex = 8 + integer, parameter :: dpsdex = 1 + integer, parameter :: psdex = 2 + integer, parameter :: dpsldex = 3 + integer, parameter :: dpsmdex = 4 +! +!----------------------------------------------------------------------- +! +! Assemble northern and southern hemisphere grid values from the +! symmetric and antisymmetric fourier coefficients: pre-FFT +! + rmlength = 2*numm(iam) + if (lat > plat/2) then ! Northern hemisphere + do k=1,plev + do i=1,rmlength + fftbuf(i,vortdex,k) = grzs(i,k) + grza(i,k) + fftbuf(i,divdex,k) = grds(i,k) + grda(i,k) + fftbuf(i,duhdex,k) = gruhs(i,k) + gruha(i,k) + fftbuf(i,dvhdex,k) = grvhs(i,k) + grvha(i,k) + fftbuf(i,dthdex,k) = grths(i,k) + grtha(i,k) + fftbuf(i,u3dex,k) = grus(i,k) + grua(i,k) + fftbuf(i,v3dex,k) = grvs(i,k) + grva(i,k) + fftbuf(i,t3dex,k) = grts(i,k) + grta(i,k) + end do + end do +! + do i=1,rmlength + fftbuf(i,dpsdex,plevp) = grdps(i) + grdpa(i) + fftbuf(i,psdex,plevp) = grpss(i) + grpsa(i) + fftbuf(i,dpsldex,plevp) = grpls(i) + grpla(i) + fftbuf(i,dpsmdex,plevp) = grpms(i) + grpma(i) + end do + + else ! Southern hemisphere + + do k=1,plev + do i=1,rmlength + fftbuf(i,vortdex,k) = grzs(i,k) - grza(i,k) + fftbuf(i,divdex,k) = grds(i,k) - grda(i,k) + fftbuf(i,duhdex,k) = gruhs(i,k) - gruha(i,k) + fftbuf(i,dvhdex,k) = grvhs(i,k) - grvha(i,k) + fftbuf(i,dthdex,k) = grths(i,k) - grtha(i,k) + fftbuf(i,u3dex,k) = grus(i,k) - grua(i,k) + fftbuf(i,v3dex,k) = grvs(i,k) - grva(i,k) + fftbuf(i,t3dex,k) = grts(i,k) - grta(i,k) + end do + end do + + do i=1,rmlength + fftbuf(i,dpsdex,plevp) = grdps(i) - grdpa(i) + fftbuf(i,psdex,plevp) = grpss(i) - grpsa(i) + fftbuf(i,dpsldex,plevp) = grpls(i) - grpla(i) + fftbuf(i,dpsmdex,plevp) = grpms(i) - grpma(i) + end do + + end if + + return +end subroutine spegrd_bft + +subroutine spegrd_ift (nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out) + +!----------------------------------------------------------------------- +! +! Purpose: +! Inverse Fourier transform of variables from spherical harmonic +! coefficients to grid point values during second gaussian latitude scan +! (scan2) +! +! Author: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plevp, beglat, endlat, plev + use comspe, only: maxm + use pspect, only: pmmax +#if ( defined SPMD ) + use mpishorthand +#endif + use eul_control_mod, only : trig, ifax, pcray + use perf_mod +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- + +!--------------------------------------------------------------------- +! +! Arguments +! +! +! Input arguments +! + integer, intent(in) :: nlon_fft_in ! first dimension of first FFT work array + integer, intent(in) :: nlon_fft_out ! first dimension of second FFT work array +#if (defined SPMD) + real(r8), intent(in) :: fftbuf_in(nlon_fft_in,8,plevp,plat) + ! buffer containing fields dcomposed over wavenumbers +#else + real(r8), intent(in) :: fftbuf_in(1,1,1,1) + ! buffer unused +#endif +! +! Input/Output arguments +! + real(r8), intent(inout) :: fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) + ! buffer used for in-place FFTs +! +!---------------------------Local workspace----------------------------- +! +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*8*plevp) +#else + real(r8) work((plon+1)*pcray) ! workspace needed by fft991 +#endif + integer lat ! latitude index + integer isign ! +1 => transform spectral to grid + integer ntr ! number of transforms to perform + integer inc ! distance between transform elements + integer begtrm ! (real) location of first truncated wavenumber + integer k, ifld ! level and field indices +! +!----------------------------------------------------------------------- +! +! +#if ( defined SPMD ) +! +! reorder Fourier coefficients +! + call t_barrierf ('sync_realloc4b', mpicom) + call t_startf('realloc4b') + call realloc4b(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out) + call t_stopf('realloc4b') +#endif +! +! Zero elements corresponding to truncated wavenumbers, then +! transform from fourier coefficients to gridpoint values. +! ps,vort,div,duh,dvh,dth,dpsl,dpsm,dps, +! u,v,t (SLT) [If you want to do spectral transport, do q as well] +! + begtrm = 2*pmmax+1 + inc = 1 + isign = +1 +#ifdef OUTER_OMP +!$OMP PARALLEL DO PRIVATE (LAT, NTR, K, IFLD, WORK) +#endif + do lat=beglat,endlat + ntr = 8 +!$OMP PARALLEL DO PRIVATE (K, WORK) + do k=1,plev + fftbuf_out(begtrm:nlon_fft_out,:,k,lat) = 0.0_r8 + call fft991 (fftbuf_out(1,1,k,lat), work, trig(1,lat), ifax(1,lat), inc, & + nlon_fft_out, plon, ntr, isign) + enddo + ntr = 1 +!$OMP PARALLEL DO PRIVATE (IFLD, WORK) + do ifld=1,4 + fftbuf_out(begtrm:nlon_fft_out,ifld,plevp,lat) = 0.0_r8 + call fft991 (fftbuf_out(1,ifld,plevp,lat), work, trig(1,lat), ifax(1,lat), inc, & + nlon_fft_out, plon, ntr, isign) + enddo + enddo +! + return +end subroutine spegrd_ift + +subroutine spegrd_aft (ztodt ,lat ,nlon ,nlon_fft, & + cwava ,qfcst , & + etamid ,ps ,u3 ,v3 ,t3 , & + qminus ,vort ,div ,hw2al ,hw2bl , & + hw3al ,hw3bl ,hwxal ,hwxbl ,q3m1 , & + dps ,dpsl ,dpsm ,t3m2 ,engy2alat, & + engy2blat,difftalat, difftblat,phis,fftbuf ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Completion of transformation of variables from spherical harmonic +! coefficients to grid point values during second gaussian latitude scan +! (scan2) +! +! Method: +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Reviewed: B. Boville, April 1996 +! Modified: P. Worley, September 2002 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plev, plevp + use pspect + use commap + use cam_history, only: outfld + use physconst, only: rga + use constituents, only: pcnst + use eul_control_mod + use hycoef, only: nprlev +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: lat ! latitude index + integer, intent(in) :: nlon ! number of longitudes + integer, intent(in) :: nlon_fft ! first dimension of FFT work arrays + + real(r8), intent(in) :: ztodt ! twice the timestep unles nstep=0 + real(r8), intent(in) :: cwava ! normalization factor (1/g*plon) + real(r8), intent(in) :: qfcst(plon,plev,pcnst) + real(r8), intent(in) :: qminus(plon,plev,pcnst) + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + + real(r8), intent(inout) :: ps(plon) + real(r8), intent(inout) :: u3(plon,plev) + real(r8), intent(inout) :: v3(plon,plev) + real(r8), intent(inout) :: t3(plon,plev) + real(r8), intent(inout) :: vort(plon,plev) + real(r8), intent(inout) :: div(plon,plev) + real(r8), intent(inout) :: q3m1(plon,plev,pcnst) + + real(r8), intent(out) :: hw2al(pcnst) ! - + real(r8), intent(out) :: hw2bl(pcnst) ! | lat contributions to components + real(r8), intent(out) :: hw3al(pcnst) ! | of slt global mass integrals + real(r8), intent(out) :: hw3bl(pcnst) ! - + real(r8), intent(out) :: hwxal(pcnst,4) + real(r8), intent(out) :: hwxbl(pcnst,4) + + real(r8), intent(out) :: dps(plon) + real(r8), intent(out) :: dpsl(plon) + real(r8), intent(out) :: dpsm(plon) + real(r8), intent(in) :: t3m2(plon,plev) ! temperature + real(r8), intent(out) :: engy2alat + real(r8), intent(out) :: engy2blat + real(r8), intent(out) :: difftalat + real(r8), intent(out) :: difftblat + real(r8), intent(in) :: phis(plon) + real(r8), intent(in) :: fftbuf(nlon_fft,8,plevp) ! buffer used for in-place FFTs +! +!---------------------------Local workspace----------------------------- +! + real(r8) :: duh(plon,plev) ! + real(r8) :: dvh(plon,plev) ! + real(r8) :: dth(plon,plev) ! + real(r8) :: ps_tmp(plon) + + real(r8) pmid(plon,plev) ! pressure at model levels + real(r8) pint(plon,plevp) ! pressure at model interfaces + real(r8) pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) + real(r8) pdelb(plon,plev) ! pressure diff bet intfcs (press defined using the "B" part + ! of the hybrid grid only) + real(r8) hcwavaw ! 0.5*cwava*w(lat) + real(r8) sum +! + real(r8) rcoslat ! 1./cosine(latitude) + real(r8) dotproda ! dot product + real(r8) dotprodb ! dot product + integer i,k,m ! longitude, level, constituent indices + integer klev ! top level where hybrid coordinates apply + integer, parameter :: vortdex = 1 ! indices into fftbuf + integer, parameter :: divdex = 2 + integer, parameter :: duhdex = 3 + integer, parameter :: dvhdex = 4 + integer, parameter :: dthdex = 5 + integer, parameter :: u3dex = 6 + integer, parameter :: v3dex = 7 + integer, parameter :: t3dex = 8 + integer, parameter :: dpsdex = 1 + integer, parameter :: psdex = 2 + integer, parameter :: dpsldex = 3 + integer, parameter :: dpsmdex = 4 +! +!----------------------------------------------------------------------- +! +! Copy 3D fields out of FFT buffer, removing cosine(latitude) from momentum variables +! + rcoslat = 1._r8/cos(clat(lat)) +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + vort(i,k) = fftbuf(i,vortdex,k) + div(i,k) = fftbuf(i,divdex,k) + duh(i,k) = fftbuf(i,duhdex,k)*rcoslat + dvh(i,k) = fftbuf(i,dvhdex,k)*rcoslat + dth(i,k) = fftbuf(i,dthdex,k) + u3(i,k) = fftbuf(i,u3dex,k)*rcoslat + v3(i,k) = fftbuf(i,v3dex,k)*rcoslat + t3(i,k) = fftbuf(i,t3dex,k) + end do + end do +! +! Copy 2D fields out of FFT buffer, converting +! log(ps) to ps. +! +!$OMP PARALLEL DO PRIVATE (I) + do i=1,nlon + dps(i) = fftbuf(i,dpsdex,plevp) + dpsl(i) = fftbuf(i,dpsldex,plevp) + dpsm(i) = fftbuf(i,dpsmdex,plevp) + ps(i) = exp(fftbuf(i,psdex,plevp)) + end do + +! +! Diagnose pressure arrays needed by DIFCOR +! + call plevs0 (nlon, plon, plev, ps, pint, pmid, pdel) + call pdelb0 (ps, pdelb, nlon) +! +! Accumulate mass integrals +! + sum = 0._r8 + do i=1,nlon + sum = sum + ps(i) + end do + tmass(lat) = w(lat)*rga*sum/nlon +! +! Finish horizontal diffusion: add pressure surface correction term to t and +! q diffusions; add kinetic energy dissipation to internal energy (temperature) +! + klev = max(kmnhdn,nprlev) + call difcor (klev, ztodt, dps, u3, v3, & + q3m1(1,1,1), pdel, pint, t3, dth, & + duh, dvh, nlon) +! +! Calculate SLT moisture, constituent, energy, and temperature integrals +! + hcwavaw = 0.5_r8*cwava*w(lat) + engy2alat = 0._r8 + engy2blat = 0._r8 + difftalat = 0._r8 + difftblat = 0._r8 +!$OMP PARALLEL DO PRIVATE (M, K, DOTPRODA, DOTPRODB, I) + do m=1,pcnst + hw2al(m) = 0._r8 + hw2bl(m) = 0._r8 + hw3al(m) = 0._r8 + hw3bl(m) = 0._r8 + hwxal(m,1) = 0._r8 + hwxal(m,2) = 0._r8 + hwxal(m,3) = 0._r8 + hwxal(m,4) = 0._r8 + hwxbl(m,1) = 0._r8 + hwxbl(m,2) = 0._r8 + hwxbl(m,3) = 0._r8 + hwxbl(m,4) = 0._r8 + do k=1,plev + dotproda = 0._r8 + dotprodb = 0._r8 + do i=1,nlon + dotproda = dotproda + qfcst(i,k,m)*pdela(i,k) + dotprodb = dotprodb + qfcst(i,k,m)*pdelb(i,k) + end do + hw2al(m) = hw2al(m) + hcwavaw*dotproda + hw2bl(m) = hw2bl(m) + hcwavaw*dotprodb + end do + end do + + do i=1,nlon + ps_tmp(i) = 0._r8 + end do + +! using do loop and select to enable functional parallelism with OpenMP +!$OMP PARALLEL DO PRIVATE (I) + do i=1,6 + select case (i) + case (1) + call engy_te (cwava ,w(lat) ,t3 ,u3 ,v3 ,phis ,pdela, ps_tmp, engy2alat ,nlon) + case (2) + call engy_te (cwava ,w(lat) ,t3 ,u3 ,v3 ,phis ,pdelb, ps , engy2blat ,nlon) + case (3) + call engy_tdif(cwava ,w(lat) ,t3 ,t3m2 ,pdela, difftalat ,nlon) + case (4) + call engy_tdif(cwava ,w(lat) ,t3 ,t3m2 ,pdelb, difftblat ,nlon) + case (5) + call qmassd (cwava, etamid, w(lat), qminus, qfcst, & + pdela, hw3al, nlon) + case (6) + call qmassd (cwava, etamid, w(lat), qminus, qfcst, & + pdelb, hw3bl, nlon) + end select + end do + + if (pcnst.gt.1) then + call xqmass (cwava, etamid, w(lat), qminus, qfcst, & + qminus, qfcst, pdela, pdelb, hwxal, & + hwxbl, nlon) + end if + + call outfld ('DTH ',dth ,plon ,lat ) + + return +end subroutine spegrd_aft + + diff --git a/src/dynamics/eul/spetru.F90 b/src/dynamics/eul/spetru.F90 new file mode 100644 index 0000000000..abd8c40619 --- /dev/null +++ b/src/dynamics/eul/spetru.F90 @@ -0,0 +1,1287 @@ + +module spetru + +!----------------------------------------------------------------------- +! +! Purpose: Spectrally truncate initial data fields. +! +! Method: Truncate one or a few fields at a time, to minimize the +! memory requirements +! +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Modified to implement processing of subsets of fields: P. Worley, May 2003 +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, plat + use pspect, only: psp, pspt, ptrn, pmmax + use comspe, only: alp, nlen, nstart, dalp + use commap, only: w, xm + use physconst, only: rearth, ra + use eul_control_mod, only: trig, ifax, pcray + implicit none +! +! By default make data and interfaces to this module private +! + private + +! +! Public interfaces +! + public spetru_phis ! Spectrally truncate PHIS + public spetru_ps ! Spectrally truncate PS + public spetru_3d_scalar ! Spectrally truncate 3D scalar fields + public spetru_uv ! Spectrally truncate winds (U and V) +! +! Private module data +! + integer, parameter :: plondfft = plon + 2 ! Size of longitude needed for FFT's + +! +!======================================================================= +contains + +!************************************************************************ +subroutine spetru_phis (phis, phis_hires, phisl, phism, phi_out) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Spectrally truncate PHIS input field. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Modified: P. Worley, May 2003 +! Modified: J. Olson, Apr 2004 +! +!----------------------------------------------------------------------- + + use pmgrid, only: plon, plat + +! +! Input/Output arguments +! + real(r8), intent(inout) :: phis(plon,plat) ! Fourier -> spec. coeffs. for sfc geo. + logical, intent(in) :: phis_hires ! true => PHIS came from hi res topo file + real(r8), intent(out), optional :: phisl(plon,plat) ! Spectrally trunc d(phis)/d(longitude) + real(r8), intent(out), optional :: phism(plon,plat) ! Spectrally trunc d(phis)/d(latitude) + real(r8), intent(out), optional :: phi_out(2,psp/2) ! used in spectral truncation of phis +! +!---------------------------Local workspace----------------------------- +! + real(r8), pointer :: phis_tmp(:,:) ! Temporary to compute Phis of size needed for FFT + real(r8), pointer :: phisl_tmp(:,:) ! Temporary to compute phisl of size needed for FFT + real(r8), pointer :: phism_tmp(:,:) ! Temporary to compute phism of size needed for FFT + real(r8) tmp1 ! vector temporary + real(r8) tmp2 ! vector temporary + real(r8) phialpr,phialpi ! phi*alp (real and imaginary) + real(r8) phdalpr,phdalpi ! phi*dalp (real and imaginary) + real(r8) zwalp ! zw*alp + real(r8) zw ! w**2 + real(r8) filtlim ! filter function + real(r8) ft ! filter multiplier for spectral coefficients + real(r8) phi(2,psp/2) ! used in spectral truncation of phis +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*plev) ! Workspace for fft +#else + real(r8) work((plon+1)*pcray) ! Workspace for fft +#endif + + integer i ! longitude index + integer irow ! latitude pair index + integer latm,latp ! symmetric latitude indices + integer lat + integer m ! longitudinal wavenumber index + integer n ! latitudinal wavenumber index + integer nspec + integer mr ! spectral indices +! +!----------------------------------------------------------------------- +! +! Zero spectral array +! + phi(:,:) = 0._r8 +! +! Transform grid -> fourier +! + allocate(phis_tmp(plondfft,plat)) + phis_tmp(:plon,:) = phis(:plon,:) + do lat=1,plat + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + call fft991(phis_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,-1) + end do ! lat=1,plat +! +! Loop over latitude pairs +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 + zw = w(irow)*2._r8 + do i=1,2*pmmax +! +! Compute symmetric and antisymmetric components +! + tmp1 = 0.5_r8*(phis_tmp(i,latm) - phis_tmp(i,latp)) + tmp2 = 0.5_r8*(phis_tmp(i,latm) + phis_tmp(i,latp)) + phis_tmp(i,latm) = tmp1 + phis_tmp(i,latp) = tmp2 + end do +! +! Compute phi*mn +! + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m),2 + zwalp = zw*alp(mr+n,irow) + phi(1,mr+n) = phi(1,mr+n) + zwalp*phis_tmp(2*m-1,latp) + phi(2,mr+n) = phi(2,mr+n) + zwalp*phis_tmp(2*m ,latp) + end do + + do n=2,nlen(m),2 + zwalp = zw*alp(mr+n,irow) + phi(1,mr+n) = phi(1,mr+n) + zwalp*phis_tmp(2*m-1,latm) + phi(2,mr+n) = phi(2,mr+n) + zwalp*phis_tmp(2*m ,latm) + end do + end do + enddo ! irow=1,plat/2 +! + if (phis_hires) then +! +! Apply spectral filter to phis +! filter is a function of n +! if n < filter limit then +! spectral_coeff = spectral_coeff * (1. - (real(n,r8)/filtlim)**2) +! else +! spectral_coeff = 0. +! endif +! where filter limit = 1.4*PTRN +! + filtlim = real(int(1.4_r8*real(ptrn,r8)),r8) + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m) + nspec=m-1+n + ft = 1._r8 - (real(nspec,r8)/filtlim)**2 + if (real(nspec,r8) .ge. filtlim) ft = 0._r8 + phi(1,mr+n) = phi(1,mr+n)*ft + phi(2,mr+n) = phi(2,mr+n)*ft + end do + end do + call hordif1(rearth,phi) + end if +! +! Compute grid point values of phi*. +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + phis_tmp(:,latm) = 0._r8 + phis_tmp(:,latp) = 0._r8 +! +! Compute(phi*)m +! + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m),2 + phialpr = phi(1,mr+n)*alp(mr+n,irow) + phialpi = phi(2,mr+n)*alp(mr+n,irow) + phis_tmp(2*m-1,latm) = phis_tmp(2*m-1,latm) + phialpr + phis_tmp(2*m ,latm) = phis_tmp(2*m ,latm) + phialpi + end do + end do + + do m=1,pmmax + mr = nstart(m) + do n=2,nlen(m),2 + phialpr = phi(1,mr+n)*alp(mr+n,irow) + phialpi = phi(2,mr+n)*alp(mr+n,irow) + phis_tmp(2*m-1,latp) = phis_tmp(2*m-1,latp) + phialpr + phis_tmp(2*m ,latp) = phis_tmp(2*m ,latp) + phialpi + end do + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = phis_tmp(i,latm) + phis_tmp(i,latp) + tmp2 = phis_tmp(i,latm) - phis_tmp(i,latp) + phis_tmp(i,latm) = tmp1 + phis_tmp(i,latp) = tmp2 + end do + + enddo ! irow=1,plat/2 + + if(present(phisl)) then + allocate(phisl_tmp(plondfft,plat)) + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + phisl_tmp(:,latm) = 0._r8 + phisl_tmp(:,latp) = 0._r8 +! +! Compute(phi*)m +! + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m),2 + phialpr = phi(1,mr+n)*alp(mr+n,irow) + phialpi = phi(2,mr+n)*alp(mr+n,irow) + phisl_tmp(2*m-1,latm) = phisl_tmp(2*m-1,latm) - phialpi*ra + phisl_tmp(2*m ,latm) = phisl_tmp(2*m ,latm) + phialpr*ra + end do + end do + + do m=1,pmmax + mr = nstart(m) + do n=2,nlen(m),2 + phialpr = phi(1,mr+n)*alp(mr+n,irow) + phialpi = phi(2,mr+n)*alp(mr+n,irow) + phisl_tmp(2*m-1,latp) = phisl_tmp(2*m-1,latp) - phialpi*ra + phisl_tmp(2*m ,latp) = phisl_tmp(2*m ,latp) + phialpr*ra + end do + end do +! +! d(Phi)/d(lamda) +! + do m=1,pmmax + phisl_tmp(2*m-1,latm) = xm(m)*phisl_tmp(2*m-1,latm) + phisl_tmp(2*m ,latm) = xm(m)*phisl_tmp(2*m ,latm) + phisl_tmp(2*m-1,latp) = xm(m)*phisl_tmp(2*m-1,latp) + phisl_tmp(2*m ,latp) = xm(m)*phisl_tmp(2*m ,latp) + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = phisl_tmp(i,latm) + phisl_tmp(i,latp) + tmp2 = phisl_tmp(i,latm) - phisl_tmp(i,latp) + phisl_tmp(i,latm) = tmp1 + phisl_tmp(i,latp) = tmp2 + end do + enddo ! irow=1,plat/2 + end if + + if(present(phism)) then + allocate(phism_tmp(plondfft,plat)) + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + phism_tmp(:,latm) = 0._r8 + phism_tmp(:,latp) = 0._r8 +! +! Compute(phi*)m +! + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m),2 + phdalpr = phi(1,mr+n)*dalp(mr+n,irow) + phdalpi = phi(2,mr+n)*dalp(mr+n,irow) + phism_tmp(2*m-1,latp) = phism_tmp(2*m-1,latp) + phdalpr*ra + phism_tmp(2*m ,latp) = phism_tmp(2*m ,latp) + phdalpi*ra + end do + end do + + do m=1,pmmax + mr = nstart(m) + do n=2,nlen(m),2 + phdalpr = phi(1,mr+n)*dalp(mr+n,irow) + phdalpi = phi(2,mr+n)*dalp(mr+n,irow) + phism_tmp(2*m-1,latm) = phism_tmp(2*m-1,latm) + phdalpr*ra + phism_tmp(2*m ,latm) = phism_tmp(2*m ,latm) + phdalpi*ra + end do + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = phism_tmp(i,latm) + phism_tmp(i,latp) + tmp2 = phism_tmp(i,latm) - phism_tmp(i,latp) + phism_tmp(i,latm) = tmp1 + phism_tmp(i,latp) = tmp2 + end do + enddo ! irow=1,plat/2 + end if +! + do lat=1,plat +! +! Transform Fourier -> grid, obtaining spectrally truncated +! grid point values. +! + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + + call fft991(phis_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,+1) + phis(:plon,lat) = phis_tmp(:plon,lat) + if(present(phisl)) then + call fft991 (phisl_tmp(1,lat),work ,trig(1,irow),ifax(1,irow),1 , & + plondfft ,plon,1 ,+1 ) + phisl(:plon,lat) = phisl_tmp(:plon,lat) + end if + if(present(phism)) then + call fft991 (phism_tmp(1,lat),work ,trig(1,irow),ifax(1,irow),1 , & + plondfft ,plon,1 ,+1 ) + phism(:plon,lat) = phism_tmp(:plon,lat) + end if + enddo + deallocate( phis_tmp ) + if ( present(phisl) ) deallocate( phisl_tmp ) + if ( present(phism) ) deallocate( phism_tmp ) + + if(present(phi_out)) then + phi_out(:,:) = phi(:,:) + end if + + return +end subroutine spetru_phis + +!************************************************************************ +subroutine spetru_ps(ps ,dpsl ,dpsm) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Spectrally truncate PS input field. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Modified: P. Worley, May 2003 +! Modified: J. Olson, Apr 2004 +! +!----------------------------------------------------------------------- + + use pmgrid, only: plon, plat + +! +! Input/Output arguments +! + real(r8), intent(inout) :: ps(plon,plat) ! Fourier -> spec. coeffs. for ln(ps) +! +! Output arguments +! + real(r8), intent(out) :: dpsl(plon,plat) ! Spectrally trunc d(ln(ps))/d(longitude) + real(r8), intent(out) :: dpsm(plon,plat) ! Spectrally trunc d(ln(ps))/d(latitude) + +! +!---------------------------Local workspace----------------------------- +! + real(r8), pointer :: log_ps(:,:) ! log(ps) + real(r8), pointer :: dpsm_tmp(:,:) ! Temporary to compute dpsm of size needed for FFT + real(r8), pointer :: dpsl_tmp(:,:) ! Temporary to compute dpsl of size needed for FFT + real(r8) alps_tmp(psp) ! used in spectral truncation of phis + real(r8) tmp1 ! vector temporary + real(r8) tmp2 ! vector temporary + real(r8) zwalp ! zw*alp + real(r8) psdalpr,psdalpi ! alps (real and imaginary)*dalp + real(r8) psalpr,psalpi ! alps (real and imaginary)*alp + real(r8) zw ! w**2 +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*plev) ! Workspace for fft +#else + real(r8) work((plon+1)*pcray) ! Workspace for fft +#endif + + integer ir,ii ! indices complex coeffs. of spec. arrs. + integer i,k ! longitude, level indices + integer irow ! latitude pair index + integer latm,latp ! symmetric latitude indices + integer lat + integer m ! longitudinal wavenumber index + integer n ! latitudinal wavenumber index + integer nspec + integer mr,mc ! spectral indices +! +!----------------------------------------------------------------------- +! +! Zero spectral array +! + alps_tmp(:) = 0._r8 +! +! Compute the 2D quantities which are transformed to spectral space: +! ps= ln(ps). +! + allocate( log_ps(plondfft,plat) ) + do lat=1,plat + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + do i=1,plon + log_ps(i,lat) = log(ps(i,lat)) + end do +! +! Transform grid -> fourier +! + call fft991(log_ps(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,-1) + + end do ! lat=1,plat + allocate( dpsl_tmp(plondfft,plat) ) + allocate( dpsm_tmp(plondfft,plat) ) +! +! Loop over latitude pairs +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 + zw = w(irow)*2._r8 + do i=1,2*pmmax +! +! Compute symmetric and antisymmetric components +! + tmp1 = 0.5_r8*(log_ps(i,latm) - log_ps(i,latp)) + tmp2 = 0.5_r8*(log_ps(i,latm) + log_ps(i,latp)) + log_ps(i,latm) = tmp1 + log_ps(i,latp) = tmp2 + + end do +! +! Compute ln(p*)mn +! + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + zwalp = zw*alp(mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + alps_tmp(ir) = alps_tmp(ir) + zwalp*log_ps(2*m-1,latp) + alps_tmp(ii) = alps_tmp(ii) + zwalp*log_ps(2*m ,latp) + end do + + do n=2,nlen(m),2 + zwalp = zw*alp(mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + alps_tmp(ir) = alps_tmp(ir) + zwalp*log_ps(2*m-1,latm) + alps_tmp(ii) = alps_tmp(ii) + zwalp*log_ps(2*m ,latm) + end do + end do + enddo ! irow=1,plat/2 +! +! Compute grid point values of:ln(p*) and grad(ln(p*)). +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + log_ps(:,latm) = 0._r8 + log_ps(:,latp) = 0._r8 + + dpsl_tmp(:,latm) = 0._r8 + dpsl_tmp(:,latp) = 0._r8 + + dpsm_tmp(:,latm) = 0._r8 + dpsm_tmp(:,latp) = 0._r8 + +! +! Compute(ln(p*),grad(ln(p*)))m +! + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + psalpr = alps_tmp(ir)*alp(mr+n,irow) + psalpi = alps_tmp(ii)*alp(mr+n,irow) +! + log_ps(2*m-1,latm) = log_ps(2*m-1,latm) + psalpr + log_ps(2*m ,latm) = log_ps(2*m ,latm) + psalpi + dpsl_tmp(2*m-1,latm) = dpsl_tmp(2*m-1,latm) - psalpi*ra + dpsl_tmp(2*m ,latm) = dpsl_tmp(2*m ,latm) + psalpr*ra +! + psdalpr = alps_tmp(ir)*dalp(mr+n,irow) + psdalpi = alps_tmp(ii)*dalp(mr+n,irow) +! + dpsm_tmp(2*m-1,latp) = dpsm_tmp(2*m-1,latp) + psdalpr*ra + dpsm_tmp(2*m ,latp) = dpsm_tmp(2*m ,latp) + psdalpi*ra + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + psalpr = alps_tmp(ir)*alp(mr+n,irow) + psalpi = alps_tmp(ii)*alp(mr+n,irow) +! + log_ps(2*m-1,latp) = log_ps(2*m-1,latp) + psalpr + log_ps(2*m ,latp) = log_ps(2*m ,latp) + psalpi + dpsl_tmp(2*m-1,latp) = dpsl_tmp(2*m-1,latp) - psalpi*ra + dpsl_tmp(2*m ,latp) = dpsl_tmp(2*m ,latp) + psalpr*ra +! + psdalpr = alps_tmp(ir)*dalp(mr+n,irow) + psdalpi = alps_tmp(ii)*dalp(mr+n,irow) +! + dpsm_tmp(2*m-1,latm) = dpsm_tmp(2*m-1,latm) + psdalpr*ra + dpsm_tmp(2*m ,latm) = dpsm_tmp(2*m ,latm) + psdalpi*ra + end do + end do + + do m=1,pmmax + dpsl_tmp(2*m-1,latm) = xm(m)*dpsl_tmp(2*m-1,latm) + dpsl_tmp(2*m ,latm) = xm(m)*dpsl_tmp(2*m ,latm) + dpsl_tmp(2*m-1,latp) = xm(m)*dpsl_tmp(2*m-1,latp) + dpsl_tmp(2*m ,latp) = xm(m)*dpsl_tmp(2*m ,latp) + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 +! + tmp1 = log_ps(i,latm) + log_ps(i,latp) + tmp2 = log_ps(i,latm) - log_ps(i,latp) + log_ps(i,latm) = tmp1 + log_ps(i,latp) = tmp2 +! + tmp1 = dpsl_tmp(i,latm) + dpsl_tmp(i,latp) + tmp2 = dpsl_tmp(i,latm) - dpsl_tmp(i,latp) + dpsl_tmp(i,latm) = tmp1 + dpsl_tmp(i,latp) = tmp2 +! + tmp1 = dpsm_tmp(i,latm) + dpsm_tmp(i,latp) + tmp2 = dpsm_tmp(i,latm) - dpsm_tmp(i,latp) + dpsm_tmp(i,latm) = tmp1 + dpsm_tmp(i,latp) = tmp2 + end do +! + enddo ! irow=1,plat/2 +! + do lat=1,plat +! +! Transform Fourier -> grid, obtaining spectrally truncated +! grid point values. +! + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + + call fft991(log_ps(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,+1) + call fft991(dpsl_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,+1) + call fft991(dpsm_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,1,+1) +! +! Convert from ln(ps) to ps, copy temporaries to input arrays +! + do i=1,plon + ps(i,lat) = exp(log_ps(i,lat)) + dpsl(i,lat) = dpsl_tmp(i,lat) + dpsm(i,lat) = dpsm_tmp(i,lat) + end do +! + enddo + deallocate( log_ps ) + deallocate( dpsm_tmp ) + deallocate( dpsl_tmp ) + + return +end subroutine spetru_ps + +!************************************************************************ + +subroutine spetru_3d_scalar(x3, dl, dm) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Spectrally truncate 3-D scalar field. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Modified: P. Worley, May 2003 +! Modified: J. Olson, Apr 2004 +! +!----------------------------------------------------------------------- + + use pmgrid, only: plon, plat + +! +! Input/Output arguments +! + real(r8), intent(inout) :: x3(plon,plev,plat) ! Fourier -> spec. coeffs. for X + real(r8), intent(out), optional :: dl(plon,plev,plat) ! Spectrally trunc d(X)/d(longitude) + real(r8), intent(out), optional :: dm(plon,plev,plat) ! Spectrally trunc d(X)/d(latitude) +! +!---------------------------Local workspace----------------------------- +! + real(r8), pointer :: x3_tmp(:,:,:) ! Temporary to compute x3 of size needed for FFT + real(r8), pointer :: dl_tmp(:,:,:) ! Temporary to compute dl of size needed for FFT + real(r8), pointer :: dm_tmp(:,:,:) ! Temporary to compute dm of size needed for FFT + real(r8) t_tmp(psp) ! used in spectral truncation of t + real(r8) tmp1 ! vector temporary + real(r8) tmp2 ! vector temporary + real(r8) tmpr ! vector temporary (real) + real(r8) tmpi ! vector temporary (imaginary) + real(r8) zwalp ! zw*alp + real(r8) zw ! w**2 +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*plev) ! Workspace for fft +#else + real(r8) work((plon+1)*pcray) ! Workspace for fft +#endif + + integer ir,ii ! indices complex coeffs. of spec. arrs. + integer i,k ! longitude, level indices + integer irow ! latitude pair index + integer latm,latp ! symmetric latitude indices + integer lat + integer m ! longitudinal wavenumber index + integer n ! latitudinal wavenumber index + integer nspec + integer mr,mc ! spectral indices +! +!----------------------------------------------------------------------- +! +! Transform grid -> fourier +! + allocate( x3_tmp(plondfft,plev,plat) ) + if(present(dm)) allocate( dm_tmp(plondfft,plev,plat) ) + if(present(dl)) allocate( dl_tmp(plondfft,plev,plat) ) + do lat=1,plat + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + x3_tmp(:plon,:,lat) = x3(:plon,:,lat) + call fft991(x3_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,-1) + end do ! lat=1,plat +! +! Loop over vertical levels +! + do k=1,plev +! +! Zero spectral array +! + t_tmp(:) = 0._r8 +! +! Loop over latitude pairs +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 + zw = w(irow)*2._r8 +! +! Multi-level field: T +! + do i=1,2*pmmax + tmp1 = 0.5_r8*(x3_tmp(i,k,latm) - x3_tmp(i,k,latp)) + tmp2 = 0.5_r8*(x3_tmp(i,k,latm) + x3_tmp(i,k,latp)) + x3_tmp(i,k,latm) = tmp1 + x3_tmp(i,k,latp) = tmp2 + end do +! +! Compute tmn +! + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + zwalp = zw*alp (mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + t_tmp(ir) = t_tmp(ir) + zwalp*x3_tmp(2*m-1,k,latp) + t_tmp(ii) = t_tmp(ii) + zwalp*x3_tmp(2*m ,k,latp) + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + zwalp = zw*alp (mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + t_tmp(ir) = t_tmp(ir) + zwalp*x3_tmp(2*m-1,k,latm) + t_tmp(ii) = t_tmp(ii) + zwalp*x3_tmp(2*m ,k,latm) + end do + end do + enddo ! irow=1,plat/2 +! +! Compute grid point values of:t. +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + x3_tmp(:,k,latm) = 0._r8 + x3_tmp(:,k,latp) = 0._r8 + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*alp(mr+n,irow) + tmpi = t_tmp(ii)*alp(mr+n,irow) + x3_tmp(2*m-1,k,latm) = x3_tmp(2*m-1,k,latm) + tmpr + x3_tmp(2*m ,k,latm) = x3_tmp(2*m ,k,latm) + tmpi + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*alp(mr+n,irow) + tmpi = t_tmp(ii)*alp(mr+n,irow) + x3_tmp(2*m-1,k,latp) = x3_tmp(2*m-1,k,latp) + tmpr + x3_tmp(2*m ,k,latp) = x3_tmp(2*m ,k,latp) + tmpi + end do + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = x3_tmp(i,k,latm) + x3_tmp(i,k,latp) + tmp2 = x3_tmp(i,k,latm) - x3_tmp(i,k,latp) + x3_tmp(i,k,latm) = tmp1 + x3_tmp(i,k,latp) = tmp2 + end do + enddo ! irow=1,plat/2 + + if(present(dl)) then + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + dl_tmp(:,k,latm) = 0._r8 + dl_tmp(:,k,latp) = 0._r8 + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*alp(mr+n,irow) + tmpi = t_tmp(ii)*alp(mr+n,irow) + dl_tmp(2*m-1,k,latm) = dl_tmp(2*m-1,k,latm) - tmpi*ra + dl_tmp(2*m ,k,latm) = dl_tmp(2*m ,k,latm) + tmpr*ra + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*alp(mr+n,irow) + tmpi = t_tmp(ii)*alp(mr+n,irow) + dl_tmp(2*m-1,k,latp) = dl_tmp(2*m-1,k,latp) - tmpi*ra + dl_tmp(2*m ,k,latp) = dl_tmp(2*m ,k,latp) + tmpr*ra + end do + end do +! +! d(T)/d(lamda) +! + do m=1,pmmax + dl_tmp(2*m-1,k,latm) = xm(m)*dl_tmp(2*m-1,k,latm) + dl_tmp(2*m ,k,latm) = xm(m)*dl_tmp(2*m ,k,latm) + dl_tmp(2*m-1,k,latp) = xm(m)*dl_tmp(2*m-1,k,latp) + dl_tmp(2*m ,k,latp) = xm(m)*dl_tmp(2*m ,k,latp) + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = dl_tmp(i,k,latm) + dl_tmp(i,k,latp) + tmp2 = dl_tmp(i,k,latm) - dl_tmp(i,k,latp) + dl_tmp(i,k,latm) = tmp1 + dl_tmp(i,k,latp) = tmp2 + end do + enddo ! irow=1,plat/2 + end if + + if(present(dm)) then + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 +! +! Zero fourier fields +! + dm_tmp(:,k,latm) = 0._r8 + dm_tmp(:,k,latp) = 0._r8 + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*dalp(mr+n,irow) + tmpi = t_tmp(ii)*dalp(mr+n,irow) + dm_tmp(2*m-1,k,latp) = dm_tmp(2*m-1,k,latp) + tmpr*ra + dm_tmp(2*m ,k,latp) = dm_tmp(2*m ,k,latp) + tmpi*ra + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 + tmpr = t_tmp(ir)*dalp(mr+n,irow) + tmpi = t_tmp(ii)*dalp(mr+n,irow) + dm_tmp(2*m-1,k,latm) = dm_tmp(2*m-1,k,latm) + tmpr*ra + dm_tmp(2*m ,k,latm) = dm_tmp(2*m ,k,latm) + tmpi*ra + end do + end do +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = dm_tmp(i,k,latm) + dm_tmp(i,k,latp) + tmp2 = dm_tmp(i,k,latm) - dm_tmp(i,k,latp) + dm_tmp(i,k,latm) = tmp1 + dm_tmp(i,k,latp) = tmp2 + end do + enddo ! irow=1,plat/2 + end if + + enddo ! k=1,plev +! + do lat=1,plat +! +! Transform Fourier -> grid, obtaining spectrally truncated +! grid point values. + + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + + call fft991(x3_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & + plondfft ,plon,plev ,+1) + x3(:plon,:,lat) = x3_tmp(:plon,:,lat) + if(present(dl)) then + call fft991(dl_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & + plondfft ,plon,plev ,+1 ) + dl(:plon,:,lat) = dl_tmp(:plon,:,lat) + end if + if(present(dm)) then + call fft991(dm_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & + plondfft ,plon,plev ,+1 ) + dm(:plon,:,lat) = dm_tmp(:plon,:,lat) + end if + end do + deallocate( x3_tmp ) + if ( present(dm) ) deallocate( dm_tmp ) + if ( present(dl) ) deallocate( dl_tmp ) + + return +end subroutine spetru_3d_scalar + +!*********************************************************************** + +subroutine spetru_uv(u3 ,v3 ,div ,vort ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! Method: +! Spectrally truncate U, V input fields. +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, J. Hack, August 1992 +! Modified: P. Worley, May 2003 +! Modified: J. Olson, Apr 2004 +! +!----------------------------------------------------------------------- + + use pmgrid, only: plon, plat + use commap, only: rsq, cs + use physconst,only: ez + +! +! Input/Output arguments +! + real(r8), intent(inout) :: u3(plon,plev,plat) ! Fourier -> spec. coeffs. for u-wind + real(r8), intent(inout) :: v3(plon,plev,plat) ! Fourier -> spec. coeffs. for v-wind +! +! Output arguments +! + real(r8), intent(out), optional :: div (plon,plev,plat) ! Spectrally truncated divergence + real(r8), intent(out), optional :: vort(plon,plev,plat) ! Spectrally truncated vorticity + +! +!---------------------------Local workspace----------------------------- +! + real(r8), pointer :: u_cosphi(:,:,:) ! u3*cos(phi) + real(r8), pointer :: v_cosphi(:,:,:) ! v3*cos(phi) + real(r8), pointer :: div_tmp(:,:,:) ! Temporary to compute div of size needed for FFT + real(r8), pointer :: vort_tmp(:,:,:) ! Temporary to compute vort of size needed for FFT + real(r8) d_tmp(psp) ! used in spectral truncation of div + real(r8) vz_tmp(psp) ! used in spectral truncation of vort + real(r8) alpn(pspt) ! alp*rsq*xm*ra + real(r8) dalpn(pspt) ! dalp*rsq*ra + real(r8) tmp1 ! vector temporary + real(r8) tmp2 ! vector temporary + real(r8) tmpr ! vector temporary (real) + real(r8) tmpi ! vector temporary (imaginary) + real(r8) zcor ! correction for absolute vorticity + real(r8) zwalp ! zw*alp + real(r8) zwdalp ! zw*dalp + real(r8) zrcsj ! ra/(cos**2 latitude) + real(r8) zw ! w**2 +#if ( ! defined USEFFTLIB ) + real(r8) work((plon+1)*plev) ! Workspace for fft +#else + real(r8) work((plon+1)*pcray) ! Workspace for fft +#endif + real(r8) zsqcs + + integer ir,ii ! indices complex coeffs. of spec. arrs. + integer i,k ! longitude, level indices + integer irow ! latitude pair index + integer latm,latp ! symmetric latitude indices + integer lat + integer m ! longitudinal wavenumber index + integer n ! latitudinal wavenumber index + integer nspec + integer mr,mc ! spectral indices + +! +!----------------------------------------------------------------------- +! +! Compute the quantities which are transformed to spectral space: +! 1. u = u*sqrt(1-mu*mu), u * cos(phi) +! 2. v = v*sqrt(1-mu*mu), v * cos(phi) +! + allocate( u_cosphi(plondfft,plev,plat) ) + allocate( v_cosphi(plondfft,plev,plat) ) + do lat=1,plat + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + zsqcs = sqrt(cs(irow)) + do k=1,plev + do i=1,plon + u_cosphi(i,k,lat) = u3(i,k,lat)*zsqcs + v_cosphi(i,k,lat) = v3(i,k,lat)*zsqcs + end do + end do +! +! Transform grid -> fourier +! 1st transform: U,V,T: note contiguity assumptions +! 2nd transform: LN(PS). 3rd transform: surface geopotential +! + call fft991(u_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,-1) + call fft991(v_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,-1) + + end do ! lat=1,plat +! +! Multi-level fields: U, V +! + if ( present(div) ) allocate( div_tmp(plondfft,plev,plat) ) + if ( present(vort) ) allocate( vort_tmp(plondfft,plev,plat) ) + do k=1,plev +! +! Zero spectral arrays +! + vz_tmp(:) = 0._r8 + d_tmp(:) = 0._r8 +! +! Loop over latitude pairs +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 + zrcsj = ra/cs(irow) + zw = w(irow)*2._r8 + do i=1,2*pmmax + + tmp1 = 0.5_r8*(u_cosphi(i,k,latm) - u_cosphi(i,k,latp)) + tmp2 = 0.5_r8*(u_cosphi(i,k,latm) + u_cosphi(i,k,latp)) + u_cosphi(i,k,latm) = tmp1 + u_cosphi(i,k,latp) = tmp2 + + tmp1 = 0.5_r8*(v_cosphi(i,k,latm) - v_cosphi(i,k,latp)) + tmp2 = 0.5_r8*(v_cosphi(i,k,latm) + v_cosphi(i,k,latp)) + v_cosphi(i,k,latm) = tmp1 + v_cosphi(i,k,latp) = tmp2 + + end do +! +! Compute vzmn and dmn +! + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + zwdalp = zw*dalp(mr+n,irow) + zwalp = zw*alp (mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + d_tmp(ir) = d_tmp(ir) - (zwdalp*v_cosphi(2*m-1,k,latm) + & + xm(m)*zwalp*u_cosphi(2*m ,k,latp))*zrcsj + d_tmp(ii) = d_tmp(ii) - (zwdalp*v_cosphi(2*m ,k,latm) - & + xm(m)*zwalp*u_cosphi(2*m-1,k,latp))*zrcsj + vz_tmp(ir) = vz_tmp(ir) + (zwdalp*u_cosphi(2*m-1,k,latm) - & + xm(m)*zwalp*v_cosphi(2*m ,k,latp))*zrcsj + vz_tmp(ii) = vz_tmp(ii) + (zwdalp*u_cosphi(2*m ,k,latm) + & + xm(m)*zwalp*v_cosphi(2*m-1,k,latp))*zrcsj + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + zwdalp = zw*dalp(mr+n,irow) + zwalp = zw*alp (mr+n,irow) + ir = mc + 2*n - 1 + ii = ir + 1 + d_tmp(ir) = d_tmp(ir) - (zwdalp*v_cosphi(2*m-1,k,latp) + & + xm(m)*zwalp*u_cosphi(2*m ,k,latm))*zrcsj + d_tmp(ii) = d_tmp(ii) - (zwdalp*v_cosphi(2*m ,k,latp) - & + xm(m)*zwalp*u_cosphi(2*m-1,k,latm))*zrcsj + vz_tmp(ir) = vz_tmp(ir) + (zwdalp*u_cosphi(2*m-1,k,latp) - & + xm(m)*zwalp*v_cosphi(2*m ,k,latm))*zrcsj + vz_tmp(ii) = vz_tmp(ii) + (zwdalp*u_cosphi(2*m ,k,latp) + & + xm(m)*zwalp*v_cosphi(2*m-1,k,latm))*zrcsj + end do + end do + enddo ! irow=1,plat/2 +! +! Compute grid point values of:u,v,vz, and d. +! + do irow=1,plat/2 + latp = irow + latm = plat - irow + 1 + zcor = ez*alp(2,irow) +! +! Compute(u,v,vz,d)m +! + do m=1,pmmax + mr = nstart(m) + do n=1,nlen(m) +! +! These statements will likely not be bfb since xm*ra is now a scalar +! + alpn (mr+n) = alp(mr+n,irow)*rsq(n+m-1)*xm(m)*ra + dalpn(mr+n) = dalp(mr+n,irow)*rsq(n+m-1) *ra + end do + end do +! +! Zero fourier fields +! + u_cosphi(:,k,latm) = 0._r8 + u_cosphi(:,k,latp) = 0._r8 + + v_cosphi(:,k,latm) = 0._r8 + v_cosphi(:,k,latp) = 0._r8 + + if(present(vort)) then + vort_tmp(:,k,latm) = 0._r8 + vort_tmp(:,k,latp) = 0._r8 + end if + + if(present(div)) then + div_tmp(:,k,latm) = 0._r8 + div_tmp(:,k,latp) = 0._r8 + end if + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=1,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 +! + tmpr = d_tmp(ir)*alpn(mr+n) + tmpi = d_tmp(ii)*alpn(mr+n) + u_cosphi(2*m-1,k,latm) = u_cosphi(2*m-1,k,latm) + tmpi + u_cosphi(2*m ,k,latm) = u_cosphi(2*m ,k,latm) - tmpr +! + tmpr = d_tmp(ir)*dalpn(mr+n) + tmpi = d_tmp(ii)*dalpn(mr+n) + v_cosphi(2*m-1,k,latp) = v_cosphi(2*m-1,k,latp) - tmpr + v_cosphi(2*m ,k,latp) = v_cosphi(2*m ,k,latp) - tmpi +! + tmpr = vz_tmp(ir)*dalpn(mr+n) + tmpi = vz_tmp(ii)*dalpn(mr+n) + u_cosphi(2*m-1,k,latp) = u_cosphi(2*m-1,k,latp) + tmpr + u_cosphi(2*m ,k,latp) = u_cosphi(2*m ,k,latp) + tmpi +! + tmpr = vz_tmp(ir)*alpn(mr+n) + tmpi = vz_tmp(ii)*alpn(mr+n) + v_cosphi(2*m-1,k,latm) = v_cosphi(2*m-1,k,latm) + tmpi + v_cosphi(2*m ,k,latm) = v_cosphi(2*m ,k,latm) - tmpr +! + if(present(div)) then + tmpr = d_tmp(ir)*alp(mr+n,irow) + tmpi = d_tmp(ii)*alp(mr+n,irow) + div_tmp(2*m-1,k,latm) = div_tmp(2*m-1,k,latm) + tmpr + div_tmp(2*m ,k,latm) = div_tmp(2*m ,k,latm) + tmpi + end if +! + if(present(vort)) then + tmpr = vz_tmp(ir)*alp(mr+n,irow) + tmpi = vz_tmp(ii)*alp(mr+n,irow) + vort_tmp(2*m-1,k,latm) = vort_tmp(2*m-1,k,latm) + tmpr + vort_tmp(2*m ,k,latm) = vort_tmp(2*m ,k,latm) + tmpi + end if + end do + end do + + do m=1,pmmax + mr = nstart(m) + mc = 2*mr + do n=2,nlen(m),2 + ir = mc + 2*n - 1 + ii = ir + 1 +! + tmpr = d_tmp(ir)*alpn(mr+n) + tmpi = d_tmp(ii)*alpn(mr+n) + u_cosphi(2*m-1,k,latp) = u_cosphi(2*m-1,k,latp) + tmpi + u_cosphi(2*m ,k,latp) = u_cosphi(2*m ,k,latp) - tmpr +! + tmpr = d_tmp(ir)*dalpn(mr+n) + tmpi = d_tmp(ii)*dalpn(mr+n) + v_cosphi(2*m-1,k,latm) = v_cosphi(2*m-1,k,latm) - tmpr + v_cosphi(2*m ,k,latm) = v_cosphi(2*m ,k,latm) - tmpi +! + tmpr = vz_tmp(ir)*dalpn(mr+n) + tmpi = vz_tmp(ii)*dalpn(mr+n) + u_cosphi(2*m-1,k,latm) = u_cosphi(2*m-1,k,latm) + tmpr + u_cosphi(2*m ,k,latm) = u_cosphi(2*m ,k,latm) + tmpi +! + tmpr = vz_tmp(ir)*alpn(mr+n) + tmpi = vz_tmp(ii)*alpn(mr+n) + v_cosphi(2*m-1,k,latp) = v_cosphi(2*m-1,k,latp) + tmpi + v_cosphi(2*m ,k,latp) = v_cosphi(2*m ,k,latp) - tmpr +! + if(present(div)) then + tmpr = d_tmp(ir)*alp(mr+n,irow) + tmpi = d_tmp(ii)*alp(mr+n,irow) + div_tmp(2*m-1,k,latp) = div_tmp(2*m-1,k,latp) + tmpr + div_tmp(2*m ,k,latp) = div_tmp(2*m ,k,latp) + tmpi + end if +! + if(present(vort)) then + tmpr = vz_tmp(ir)*alp(mr+n,irow) + tmpi = vz_tmp(ii)*alp(mr+n,irow) + vort_tmp(2*m-1,k,latp) = vort_tmp(2*m-1,k,latp) + tmpr + vort_tmp(2*m ,k,latp) = vort_tmp(2*m ,k,latp) + tmpi + end if + end do + end do +! +! Correction to get the absolute vorticity. +! + if(present(vort)) then + vort_tmp(1,k,latp) = vort_tmp(1,k,latp) + zcor + end if +! +! Recompute real fields from symmetric and antisymmetric parts +! + do i=1,plon+2 + tmp1 = u_cosphi(i,k,latm) + u_cosphi(i,k,latp) + tmp2 = u_cosphi(i,k,latm) - u_cosphi(i,k,latp) + u_cosphi(i,k,latm) = tmp1 + u_cosphi(i,k,latp) = tmp2 +! + tmp1 = v_cosphi(i,k,latm) + v_cosphi(i,k,latp) + tmp2 = v_cosphi(i,k,latm) - v_cosphi(i,k,latp) + v_cosphi(i,k,latm) = tmp1 + v_cosphi(i,k,latp) = tmp2 +! + if(present(vort)) then + tmp1 = vort_tmp(i,k,latm) + vort_tmp(i,k,latp) + tmp2 = vort_tmp(i,k,latm) - vort_tmp(i,k,latp) + vort_tmp(i,k,latm) = tmp1 + vort_tmp(i,k,latp) = tmp2 + end if +! + if(present(div)) then + tmp1 = div_tmp(i,k,latm) + div_tmp(i,k,latp) + tmp2 = div_tmp(i,k,latm) - div_tmp(i,k,latp) + div_tmp(i,k,latm) = tmp1 + div_tmp(i,k,latp) = tmp2 + end if + end do + enddo ! irow=1,plat/2 + enddo ! k=1,plev +! + do lat=1,plat +! +! Transform Fourier -> grid, obtaining spectrally truncated +! grid point values. +! + irow = lat + if (lat.gt.plat/2) irow = plat - lat + 1 + + call fft991(u_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,+1) + call fft991(v_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,+1) + if(present(vort)) then + call fft991(vort_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1, & + plondfft,plon,plev,+1) + vort(:plon,:,lat) = vort_tmp(:plon,:,lat) + end if + if(present(div)) then + call fft991(div_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & + plon,plev,+1) + div(:plon,:,lat) = div_tmp(:plon,:,lat) + end if +! +! Convert U,V to u,v +! + zsqcs = sqrt(cs(irow)) + do k=1,plev + do i=1,plon + u3(i,k,lat) = u_cosphi(i,k,lat)/zsqcs + v3(i,k,lat) = v_cosphi(i,k,lat)/zsqcs + end do + end do + enddo + deallocate( u_cosphi ) + deallocate( v_cosphi ) + if ( present(div) ) deallocate( div_tmp ) + if ( present(vort) ) deallocate( vort_tmp ) + + return +end subroutine spetru_uv + +end module spetru diff --git a/src/dynamics/eul/sphdep.F90 b/src/dynamics/eul/sphdep.F90 new file mode 100644 index 0000000000..e7ebeeeb73 --- /dev/null +++ b/src/dynamics/eul/sphdep.F90 @@ -0,0 +1,765 @@ + +subroutine sphdep(jcen ,jgc ,dt ,ra ,iterdp , & + locgeo ,ub ,uxl ,uxr ,lam , & + phib ,lbasiy ,lammp ,phimp ,lamdp , & + phidp ,idp ,jdp ,vb ,vxl , & + vxr ,nlon ,nlonex ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute departure points for semi-Lagrangian transport on surface of +! sphere using midpoint quadrature. Computations are done in: +! +! 1) "local geodesic" coordinates for "locgeo" = .true. +! 2) "global spherical" coordinates for "locgeo" = .false. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plon, plat + use scanslt, only: platd, plond, beglatex, endlatex, i1, nxpt, j1 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none +#include + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + integer , intent(in) :: nlonex(platd) ! extended longitude dimension + integer , intent(in) :: jcen ! index of lat slice (extnd) + integer , intent(in) :: jgc ! index of lat slice (model) + real(r8), intent(in) :: dt ! time step (seconds) + real(r8), intent(in) :: ra ! 1./(radius of earth) + integer , intent(in) :: iterdp ! number of iterations + logical , intent(in) :: locgeo ! computation type flag + real(r8), intent(in) :: ub (plond,plev,beglatex:endlatex) ! x-deriv + real(r8), intent(in) :: vb (plond,plev,beglatex:endlatex) ! x-deriv + real(r8), intent(in) :: uxl(plond,plev,beglatex:endlatex) ! left x-deriv (u) + real(r8), intent(in) :: uxr(plond,plev,beglatex:endlatex) ! right x-deriv + real(r8), intent(in) :: vxl(plond,plev,beglatex:endlatex) ! left x-deriv (v) + real(r8), intent(in) :: vxr(plond,plev,beglatex:endlatex) ! right x-deriv + real(r8), intent(in) :: lam(plond,platd) ! long. coord. of model grid + real(r8), intent(in) :: phib(platd) ! lat. coord. of model grid + real(r8), intent(in) :: lbasiy(4,2,platd) ! lat interpolation weights + real(r8), intent(inout) :: lammp(plon,plev) ! long coord of midpoint + real(r8), intent(inout) :: phimp(plon,plev) ! lat coord of midpoint + real(r8), intent(out) :: lamdp(plon,plev) ! long coord of dep. point + real(r8), intent(out) :: phidp(plon,plev) ! lat coord of dep. point + integer , intent(out) :: idp(plon,plev,4) ! long index of dep. point + integer , intent(out) :: jdp(plon,plev) ! lat index of dep. point +! +! jcen Index in extended grid corresponding to latitude being +! forecast. +! jgc Index in model grid corresponding to latitude being +! forecast. +! dt Time interval that parameterizes the parcel trajectory. +! ra Reciprocal of radius of earth. +! iterdp Number of iterations used for departure point calculation. +! locgeo Logical flag to indicate computation in "local geodesic" or +! "global spherical" space. +! ub Longitudinal velocity components in spherical coordinates. +! uxl x-derivatives of u at the left (west) edge of given interval +! vxl x-derivatives of v at the left (west) edge of given interval +! uxr x-derivatives of u at the right (east) edge of given interval +! vxr x-derivatives of v at the right (east) edge of given interval +! lam Longitude values for the extended grid. +! phib Latitude values for the extended grid. +! lbasiy Weights for Lagrange cubic interpolation on the unequally +! spaced latitude grid. +! lammp Longitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecast. On entry lammp +! is an initial guess. +! phimp Latitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecast. On entry phimp +! is an initial guess. +! lamdp Longitude coordinates of the departure points that correspond +! to the global grid points contained in the latitude slice +! being forecast. lamdp is constrained so that +! 0.0 .le. lamdp(i) .lt. 2*pi . +! phidp Latitude coordinates of the departure points that correspond +! to the global grid points contained in the latitude slice +! being forecast. If phidp is computed outside the latitudinal +! domain of the extended grid, then an abort will be called by +! subroutine "trjgl". +! idp Longitude index of departure points. This index points into +! the extended arrays, e.g., +! lam (idp(i,k)) .le. lamdp(i,k) .lt. lam (idp(i,k)+1). +! jdp Latitude index of departure points. This index points into +! the extended arrays, e.g., +! phib(jdp(i,k)) .le. phidp(i,k) .lt. phib(jdp(i,k)+1). +!----------------------------------------------------------------------- + + !------------------------ local variables ------------------------------ + integer iter ! index + integer i, j, k ! indices + integer imax, imin, kmin, kmax ! indices + real(r8) finc ! time step factor + real(r8) dttmp ! time step (seconds) + real(r8) dlam(platd) ! increment of grid in x-direction + real(r8) phicen ! latitude coord of current lat slice + real(r8) cphic ! cos(phicen) + real(r8) sphic ! sin(phicen) + real(r8) upr (plon,plev) ! u in local geodesic coords + real(r8) vpr (plon,plev) ! v in local geodesic coords + real(r8) lampr(plon,plev) ! relative long coord of dep pt + real(r8) phipr(plon,plev) ! relative lat coord of dep pt + real(r8) uvmp (plon,plev,2) ! u/v (spherical) interpltd to dep pt + real(r8) fint (plon,plev,ppdy,2) ! u/v x-interpolants + real(r8) phidpmax + real(r8) phidpmin + real(r8) phimpmax + real(r8) phimpmin +!----------------------------------------------------------------------- +! + do j=1,platd + dlam(j) = lam(nxpt+2,j) - lam(nxpt+1,j) + end do + phicen = phib(jcen) + cphic = cos( phicen ) + sphic = sin( phicen ) +! +! Convert latitude coordinates of trajectory midpoints from spherical +! to local geodesic basis. +! + if( locgeo ) call s2gphi(lam(i1,jcen) ,cphic ,sphic ,lammp ,phimp, & + phipr ,nlon ) +! +! Loop over departure point iterates. +! + do 30 iter = 1,iterdp +! +! Compute midpoint indicies. +! + call bandij(dlam ,phib ,lammp ,phimp ,idp , & + jdp ,nlon ) +! +! Hermite cubic interpolation to the x-coordinate of each +! departure point at each y-coordinate required to compute the +! y-interpolants. +! + call herxin(1 ,1 ,ub ,uxl ,uxr , & + lam ,lammp ,idp ,jdp ,fint(1,1,1,1), & + nlon ,nlonex ) + + call herxin(1 ,1 ,vb ,vxl ,vxr , & + lam ,lammp ,idp ,jdp ,fint(1,1,1,2), & + nlon ,nlonex ) + + call lagyin(2 ,fint ,lbasiy ,phimp ,jdp , & + jcen ,uvmp ,nlon ) +! +! Put u/v on unit sphere +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + uvmp(i,k,1) = uvmp(i,k,1)*ra + uvmp(i,k,2) = uvmp(i,k,2)*ra + end do + end do +! +! For local geodesic: +! +! a) Convert velocity coordinates at trajectory midpoints from +! spherical coordinates to local geodesic coordinates, +! b) Estimate midpoint parcel trajectory, +! c) Convert back to spherical coordinates +! +! Else, for global spherical +! +! Estimate midpoint trajectory with no conversions +! + if ( locgeo ) then + call s2gvel(uvmp(1,1,1),uvmp(1,1,2) ,lam(i1,jcen) ,cphic ,sphic , & + lammp ,phimp ,upr ,vpr ,nlon ) + call trajmp(dt ,upr ,vpr ,phipr ,lampr , & + nlon ) + dttmp = 0.5_r8*dt + call g2spos(dttmp ,lam(i1,jcen) ,phib ,phicen ,cphic , & + sphic ,upr ,vpr ,lampr ,phipr , & + lammp ,phimp ,nlon ) + else + call trjmps(dt ,uvmp(1,1,1) ,uvmp(1,1,2), phimp ,lampr , & + phipr ,nlon ) + finc = 1._r8 + call trjgl (finc ,phicen ,lam(i1,jcen) ,lampr ,phipr , & + lammp ,phimp ,nlon ) + end if +! +! Test that the latitudinal extent of trajectory is NOT over the poles +! Distributed memory case: check that the latitudinal extent of the +! trajectory is not more than "jintmx" gridpoints away. +! + phimpmax = -1.e36_r8 + phimpmin = 1.e36_r8 + do k=1,plev + do i=1,nlon + if (phimp(i,k)>phimpmax) then + phimpmax = phimp(i,k) + imax = i + kmax = k + end if + if (phimp(i,k)= phib(endlatex-nxpt) ) then +#else + if ( phimp(imax,kmax) >= phib(j1+plat) ) then +#endif + write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,9000) imax,kmax,jgc + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun +#if ( defined SPMD ) + else if( phimp(imin,kmin) < phib(beglatex+nxpt) ) then +#else + else if( phimp(imin,kmin) < phib(j1-1) ) then +#endif + write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,9000) imin,kmin,jgc + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun + end if + +30 continue ! End of iter=1,iterdp loop +! +! Compute departure points in geodesic coordinates, and convert back +! to spherical coordinates. +! +! Else, compute departure points directly in spherical coordinates +! + if (locgeo) then +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + lampr(i,k) = 2._r8*lampr(i,k) + phipr(i,k) = 2._r8*phipr(i,k) + end do + end do + dttmp = dt + call g2spos(dttmp ,lam(i1,jcen) ,phib ,phicen ,cphic , & + sphic ,upr ,vpr ,lampr ,phipr , & + lamdp ,phidp ,nlon ) + else + finc = 2._r8 + call trjgl (finc ,phicen ,lam(i1,jcen) ,lampr ,phipr , & + lamdp ,phidp ,nlon ) + end if +! +! Test that the latitudinal extent of trajectory is NOT over the poles +! Distributed memory case: check that the latitudinal extent of the +! trajectory is not more than "jintmx" gridpoints away. +! + phidpmax = -1.e36_r8 + phidpmin = 1.e36_r8 + do k=1,plev + do i=1,nlon + if (phidp(i,k)>phidpmax) then + phidpmax = phidp(i,k) + imax = i + kmax = k + end if + if (phidp(i,k)= phib(endlatex-nxpt) ) then +#else + if ( phidp(imax,kmax) >= phib(j1+plat) ) then +#endif + write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,9000) imax,kmax,jgc + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun +#if ( defined SPMD ) + else if( phidp(imin,kmin) < phib(beglatex+nxpt) ) then +#else + else if( phidp(imin,kmin) < phib(j1-1) ) then +#endif + write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' + write(iulog,9000) imin,kmin,jgc + write(iulog,*)' Possible solutions: a) reduce time step' + write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' + write(iulog,*)' c) modified code may be in error' + call endrun + end if +! +! Compute departure point indicies. +! + call bandij(dlam ,phib ,lamdp ,phidp ,idp , & + jdp ,nlon ) + +9000 format(//'Parcel associated with longitude ',i5,', level ',i5, & + ' and latitude ',i5,' is outside the model domain.') + + return +end subroutine sphdep + +!============================================================================================ + +subroutine g2spos(dttmp ,lam ,phib ,phi ,cosphi , & + sinphi ,upr ,vpr ,lamgc ,phigc , & + lamsc ,phisc ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Transform position coordinates for a set of points, each of which is +! associated with a grid point in a global latitude slice, from local +! geodesic to spherical coordinates. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, plat + use scanslt, only: plond1, platd, j1 + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: dttmp ! time step + real(r8), intent(in) :: lam(plond1) ! model longitude coordinates + real(r8), intent(in) :: phib(platd) ! extended grid latitude coordinates + real(r8), intent(in) :: phi ! current latitude coordinate (radians) + real(r8), intent(in) :: cosphi ! cos of current latitude + real(r8), intent(in) :: sinphi ! sin of current latitude + real(r8), intent(in) :: upr (plon,plev) ! u-wind in geodesic coord + real(r8), intent(in) :: vpr (plon,plev) ! v-wind in geodesic coord + real(r8), intent(in) :: lamgc(plon,plev) ! geodesic long coord. of dep. point + real(r8), intent(in) :: phigc(plon,plev) ! geodesic lat coord. of dep. point + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(out):: lamsc(plon,plev) ! spherical long coord. of dep. point + real(r8), intent(out):: phisc(plon,plev) ! spherical lat coord. of dep. point +! +! +! dttmp Time step over which midpoint/endpoint trajectory is +! calculated (seconds). +! lam Longitude coordinates of the global grid points in spherical +! system. The grid points in the global array are the reference +! points for the local geodesic systems. +! phib Latitude values for the extended grid. +! phi Latitude coordinate (in the global grid) of the current +! latitude slice. +! cosphi cos( phi ) +! sinphi sin( phi ) +! upr zonal velocity at departure point in local geodesic coord +! vpr Meridional velocity at departure point in local geodesic coord +! lamgc Longitude coordinate of points in geodesic coordinates. +! phigc Latitude coordinate of points in geodesic coordinates. +! lamsc Longitude coordinate of points in spherical coordinates. +! phisc Latitude coordinate of points in spherical coordinates. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,ii,k ! indices + integer nval(plev) ! number of values returned from whenfgt + integer indx(plon,plev) ! index holder + real(r8) pi ! 4.*atan(1.) + real(r8) twopi ! 2.*pi + real(r8) pi2 ! pi/2 + real(r8) sgnphi ! holds sign of phi + real(r8) sphigc ! sin(phigc) + real(r8) cphigc ! cos(phigc) + real(r8) clamgc ! cos(lamgc) + real(r8) slam2 ! sin(lamgc)**2 + real(r8) phipi2 ! tmp variable + real(r8) slamgc(plon,plev) ! sin(lamgc) + real(r8) dlam(plon,plev) ! zonal extent of trajectory + real(r8) coeff ! tmp variable + real(r8) distmx ! max distance + real(r8) dist(plon,plev) ! approx. distance traveled along traj. + real(r8) fac ! 1. - 10*eps, eps from mach. precision + integer s_nval +!----------------------------------------------------------------------- +! + fac = 1._r8 - 10._r8*epsilon (fac) + pi = 4._r8*atan(1._r8) + twopi = pi*2._r8 + pi2 = pi/2._r8 + coeff = (1.1_r8*dttmp)**2 + distmx = (sign(pi2,phi) - phi)**2/coeff + sgnphi = sign( 1._r8, phi ) + +!$OMP PARALLEL DO PRIVATE (K, I, SPHIGC, CPHIGC, CLAMGC, S_NVAL) + do k=1,plev + do i=1,nlon + sphigc = sin( phigc(i,k) ) + cphigc = cos( phigc(i,k) ) + slamgc(i,k) = sin( lamgc(i,k) ) + clamgc = cos( lamgc(i,k) ) + phisc(i,k) = asin((sphigc*cosphi + cphigc*sinphi*clamgc)*fac) + if ( abs(phisc(i,k)) .ge. phib(j1+plat)*fac ) then + phisc(i,k) = sign( phib(j1+plat),phisc(i,k) )*fac + end if + dlam(i,k) = asin((slamgc(i,k)*cphigc/cos(phisc(i,k)))*fac) +! +! Compute estimated trajectory distance based upon winds alone +! + dist(i,k) = upr(i,k)**2 + vpr(i,k)**2 + end do +! +! Determine which trajectories may have crossed over pole +! + s_nval = 0 + do i=1,nlon + if (dist(i,k) > distmx) then + s_nval = s_nval + 1 + indx(s_nval,k) = i + end if + end do + nval(k) = s_nval + end do +! +! Check that proper branch of arcsine is used for calculation of +! dlam for those trajectories which may have crossed over pole. +! +!$OMP PARALLEL DO PRIVATE (K, II, I, SLAM2, PHIPI2) + do k=1,plev + do ii=1,nval(k) + i = indx(ii,k) + slam2 = slamgc(i,k)**2 + phipi2 = asin((sqrt((slam2 - 1._r8)/(slam2 - 1._r8/cosphi**2)))*fac) + if (sgnphi*phigc(i,k) > phipi2) then + dlam(i,k) = sign(pi,lamgc(i,k)) - dlam(i,k) + end if + end do + + do i=1,nlon + lamsc(i,k) = lam(i) + dlam(i,k) +! +! Restrict longitude to be in the range [0, twopi). +! + if( lamsc(i,k) >= twopi ) lamsc(i,k) = lamsc(i,k) - twopi + if( lamsc(i,k) < 0.0_r8 ) lamsc(i,k) = lamsc(i,k) + twopi + end do + end do + + return +end subroutine g2spos + +!============================================================================================ + +subroutine s2gphi(lam ,cosphi ,sinphi ,lamsc ,phisc , & + phigc ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate transformed local geodesic latitude coordinates for a set +! of points, each of which is associated with a grid point in a global +! latitude slice. Transformation is spherical to local geodesic. +! (Williamson and Rasch, 1991) +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: plond1 + implicit none + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: lam(plond1) ! long coordinates of model grid + real(r8), intent(in) :: cosphi ! cos(latitude) + real(r8), intent(in) :: sinphi ! sin(latitude) + real(r8), intent(in) :: lamsc(plon,plev) ! spher. long coords of dep points + real(r8), intent(in) :: phisc(plon,plev) ! spher. lat coords of dep points + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(out) :: phigc(plon,plev) ! loc geod. lat coords of dep points +! +! lam longitude coordinates of the global grid points in spherical +! system. The grid points in the global array are the reference +! points for the local geodesic systems. +! cosphi cosine of the latitude of the global latitude slice. +! sinphi sine of the latitude of the global latitude slice. +! lamsc longitude coordinate of dep. points in spherical coordinates. +! phisc latitude coordinate of dep. points in spherical coordinates. +! phigc latitude coordinate of dep. points in local geodesic coords. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k ! longitude, level indices + real(r8) sphisc ! | + real(r8) cphisc ! | -- temporary variables + real(r8) clamsc ! | +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I, SPHISC, CPHISC, CLAMSC) + do k = 1,plev + do i = 1,nlon + sphisc = sin( phisc(i,k) ) + cphisc = cos( phisc(i,k) ) + clamsc = cos( lam(i) - lamsc(i,k) ) + phigc(i,k) = asin( sphisc*cosphi - cphisc*sinphi*clamsc ) + end do + end do + + return +end subroutine s2gphi + +!============================================================================================ + +subroutine s2gvel(udp ,vdp ,lam ,cosphi ,sinphi , & + lamdp ,phidp ,upr ,vpr ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Transform velocity components at departure points associated with a +! single latitude slice from spherical coordinates to local geodesic +! coordinates. (Williamson and Rasch, 1991) +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: plond1 + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: udp(plon,plev) ! u in spherical coords. + real(r8), intent(in) :: vdp(plon,plev) ! v in spherical coords. + real(r8), intent(in) :: lam(plond1) ! x-coordinates of model grid + real(r8), intent(in) :: cosphi ! cos(latitude) + real(r8), intent(in) :: sinphi ! sin(latitude) + real(r8), intent(in) :: lamdp(plon,plev) ! spherical longitude coord of dep pt. + real(r8), intent(in) :: phidp(plon,plev) ! spherical latitude coord of dep pt. + real(r8), intent(out) :: upr(plon,plev) ! u in local geodesic coords. + real(r8), intent(out) :: vpr(plon,plev) ! v in local geodesic coords. +! +! udp u-component of departure point velocity in spherical coords. +! vdp v-component of departure point velocity in spherical coords. +! lam Longitude of arrival point position (model grid point) in spherical coordinates. +! cosphi Cos of latitude of arrival point positions (model grid pt). +! sinphi Sin of latitude of arrival point positions (model grid pt). +! lamdp Longitude of departure point position in spherical coordinates. +! phidp Latitude of departure point position in spherical coordinates. +! upr u-component of departure point velocity in geodesic coords. +! vpr v-component of departure point velocity in geodesic coords. +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k ! longitude, level indices + real(r8) cdlam ! | + real(r8) clamp ! | + real(r8) cphid ! | + real(r8) cphip ! | + real(r8) dlam ! | -- temporary variables + real(r8) sdlam ! | + real(r8) slamp ! | + real(r8) sphid ! | + real(r8) sphip ! | +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I, DLAM, SDLAM, CDLAM, SPHID, CPHID, SPHIP, & +!$OMP CPHIP, SLAMP, CLAMP) + do k = 1,plev + do i = 1,nlon + dlam = lam(i) - lamdp(i,k) + sdlam = sin( dlam ) + cdlam = cos( dlam ) + sphid = sin( phidp(i,k) ) + cphid = cos( phidp(i,k) ) + sphip = sphid*cosphi - cphid*sinphi*cdlam + cphip = cos( asin( sphip ) ) + slamp = -sdlam*cphid/cphip + clamp = cos( asin( slamp ) ) + vpr(i,k) = (vdp(i,k)*(cphid*cosphi + sphid*sinphi*cdlam) - & + udp(i,k)*sinphi*sdlam)/cphip + upr(i,k) = (udp(i,k)*cdlam + vdp(i,k)*sphid*sdlam + & + vpr(i,k)*slamp*sphip)/clamp + end do + end do + + return +end subroutine s2gvel + +!============================================================================================ + +subroutine trajmp(dt ,upr ,vpr ,phipr ,lampr , & + nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Estimate mid-point of parcel trajectory (geodesic coordinates) based +! upon horizontal wind field. +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: dt ! time step (seconds) + real(r8), intent(in) :: upr(plon,plev) ! u-component of wind in local geodesic + real(r8), intent(in) :: vpr(plon,plev) ! v-component of wind in local geodesic + real(r8), intent(inout) :: phipr(plon,plev) ! latitude coord of trajectory mid-point + real(r8), intent(out) :: lampr(plon,plev) ! longitude coord of traj. mid-point +! +! dt Time interval that corresponds to the parcel trajectory. +! upr u-coordinate of velocity corresponding to the most recent +! estimate of the trajectory mid-point (in geodesic system). +! vpr v-coordinate of velocity corresponding to the most recent +! estimate of the trajectory mid-point (in geodesic system). +! phipr Phi value at trajectory mid-point (geodesic coordinates). +! On entry this is the most recent estimate. +! lampr Lambda value at trajectory mid-point (geodesic coordinates). +!----------------------------------------------------------------------- + +!---------------------------Local variables----------------------------- + integer i,k ! index +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + lampr(i,k) = -.5_r8*dt* upr(i,k) / cos( phipr(i,k) ) + phipr(i,k) = -.5_r8*dt* vpr(i,k) + end do + end do + + return +end subroutine trajmp + +!============================================================================================ + +subroutine trjgl(finc ,phicen ,lam ,lampr ,phipr , & + lamp ,phip ,nlon ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Map relative trajectory mid/departure point coordinates to global +! latitude/longitude coordinates and test limits +! +! Method: +! +! Author: J. Olson +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev + use scanslt, only: plond1 + implicit none + +!------------------------------Arguments-------------------------------- + integer , intent(in) :: nlon ! longitude dimension + real(r8), intent(in) :: finc ! number of time increments + real(r8), intent(in) :: phicen ! current latitude value in extnded grid + real(r8), intent(in) :: lam(plond1) ! longitude values for the extended grid + real(r8), intent(in) :: lampr(plon,plev) ! relative x-coordinate of departure pt. + real(r8), intent(in) :: phipr(plon,plev) ! relative y-coordinate of departure pt. + real(r8), intent(out) :: lamp (plon,plev) ! long coords of traj midpoints + real(r8), intent(out) :: phip (plon,plev) ! lat coords of traj midpoints +! +! finc Time step factor (1. for midpoint, 2. for dep. point) +! phicen Latitude value for current latitude being forecast. +! lam Longitude values for the extended grid. +! lampr Longitude coordinates (relative to the arrival point) of the +! trajectory mid-points of the parcels that correspond to the +! global grid points contained in the latitude slice being forecast. +! phipr Latitude coordinates (relative to the arrival point) of the +! trajectory mid-points of the parcels that correspond to the +! global grid points contained in the latitude slice being forecast. +! lamp Longitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecast. +! phip Latitude coordinates of the trajectory mid-points of the +! parcels that correspond to the global grid points contained +! in the latitude slice being forecast. +!----------------------------------------------------------------------- + +!--------------------------Local variables------------------------------ + integer i ! longitude index + integer k ! level index + real(r8) pi ! 3.14....... + real(r8) twopi ! 2*pi +!----------------------------------------------------------------------- +! + pi = 4._r8*atan(1._r8) + twopi = pi*2._r8 +!$OMP PARALLEL DO PRIVATE (K, I) + do k = 1,plev + do i = 1,nlon + lamp(i,k) = lam(i) + finc*lampr(i,k) + phip(i,k) = phicen + finc*phipr(i,k) + if(lamp(i,k) >= twopi) lamp(i,k) = lamp(i,k) - twopi + if(lamp(i,k) < 0.0_r8) lamp(i,k) = lamp(i,k) + twopi + end do + end do + + return +end subroutine trjgl + diff --git a/src/dynamics/eul/spmd_dyn.F90 b/src/dynamics/eul/spmd_dyn.F90 new file mode 100644 index 0000000000..b9928fe43f --- /dev/null +++ b/src/dynamics/eul/spmd_dyn.F90 @@ -0,0 +1,1111 @@ +module spmd_dyn + +!----------------------------------------------------------------------- +! +! Purpose: SPMD implementation of CAM spectral Eulerian dynamics. +! +! Author: CCM Core Group +! Modified: P. Worley, September 2002, November 2003, December 2003, +! November 2004, January 2005, April 2007 +! +!----------------------------------------------------------------------- + +#if (defined SPMD) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, numlats, & + beglat, endlat, begirow, endirow, plev + use spmd_utils, only: iam, masterproc, npes, proc_smp_map + use scamMod, only: single_column + use scanslt, only: beglatex, endlatex, numbnd, numlatsex + use mpishorthand, only: mpir8, mpicom + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + private + save + + public spmdinit_dyn, compute_gsfactors, spmdbuf + public spmd_readnl + + logical, public :: local_dp_map=.false. ! flag indicates that mapping between dynamics + ! and physics decompositions does not require + ! interprocess communication + integer, public :: block_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in dynamics decomposition (including level 0) + integer, public :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in physics decomposition (including level 0) + + integer, public, allocatable :: & + cut(:,:), &! partition for MPI tasks + cutex(:,:) ! extended partition + integer, public :: proc(plat) ! MPI task id associated with a given lat. + integer, public :: neighs ! number of south neighbors to comm guardcells + integer, public, allocatable :: neighs_proc(:) ! sorted south process neighbors + integer, public :: neighn ! number of north neighbors to comm guardcells + integer, public, allocatable :: neighn_proc(:) ! sorted north process neighbors + integer, public :: npessp ! number of MPI tasks in spectral space + integer, public :: maxlats ! max number of lats on any MPI task + integer, public :: maxcols ! max number of columns on any MPI task + integer, public, allocatable :: nlat_p(:) ! number of latitudes per MPI task + integer, public, allocatable :: ncol_p(:) ! number of columns per MPI task + integer, public :: realloc4_steps ! number of swaps in realloc4 algorithms + integer, public, allocatable :: realloc4_proc(:) + ! swap partner in each step of + ! realloc4 algorithms + integer, public, allocatable :: realloc4_step(:) + ! step in realloc4 algorithms + ! in which communicate with a given + ! process + integer, public :: allgather_steps ! number of swaps in allgather algorithm + integer, public, allocatable :: allgather_proc(:) + ! swap partner in each step of + ! allgather (realloc5/7) algorithm + integer, public, allocatable :: allgather_step(:) + ! step in allgather (realloc5/7) algorithm + ! in which communicate with a given + ! process +! + logical, private, parameter :: def_equi_by_col = .true. ! default + logical, private :: dyn_equi_by_col = def_equi_by_col + ! flag indicating whether to assign + ! latitudes to equidistribute columns or + ! latitudes. This only matters when using a + ! reduced grid. +! + logical, private, parameter :: def_mirror = .false. ! default + logical, private :: mirror = def_mirror ! flag indicating whether latitudes and their + ! reflections across the equator should assigned + ! to consecutive processes +! +! Dynamics communication transpose algorithm option: +! 0: use mpi_alltoallv +! 1: use point-to-point MPI-1 two-sided implementation +! 2: use point-to-point MPI-2 one-sided implementation if supported, +! otherwise use MPI-1 implementation +! 3: use Co-Array Fortran implementation if supported, +! otherwise use MPI-1 implementation + integer, private, parameter :: min_alltoall = 0 + integer, private, parameter :: max_alltoall = 3 + integer, private, parameter :: def_alltoall = 0 ! default + integer, public :: dyn_alltoall = def_alltoall +! +! Dynamics communication allgather (realloc5/7) algorithm option: +! 0: use mpi_allgatherv +! 1: use point-to-point MPI-1 two-sided implementation +! 2: use point-to-point MPI-2 one-sided implementation if supported, +! otherwise use MPI-1 implementation +! 3: use Co-Array Fortran implementation if supported, +! otherwise use MPI-1 implementation + integer, private, parameter :: min_allgather = 0 + integer, private, parameter :: max_allgather = 3 + integer, private, parameter :: def_allgather = 0 ! default + integer, public :: dyn_allgather = def_allgather +! +! Dynamics dyn_npes option: +! 1 <= dyn_npes <= min( 2*(npes/2), plat ) + integer, private, parameter :: min_npes = 1 + integer, private, parameter :: max_npes = plat + integer, private, parameter :: def_npes = plat + integer, public :: dyn_npes = def_npes +! +! Dynamics dyn_npes_stride option: +! 1 <= dyn_npes_stride <= npes/dyn_npes + integer, private, parameter :: min_npes_stride = 1 + integer, private, parameter :: max_npes_stride = plat + integer, private, parameter :: def_npes_stride = 1 + integer, public :: dyn_npes_stride = def_npes_stride +! +! MPI communicator for active dynamics processes +! + integer, public :: mpicom_dyn_active +! +! Collective communication send/receive buffers +#if (defined CAF) + real(r8), public, allocatable :: buf1(:)[:],buf2(:)[:] ! buffers for packing MPI msgs +#else + real(r8), public, allocatable :: buf1(:),buf2(:) ! buffers for packing MPI msgs +#endif + integer, public :: spmdbuf_siz = 0 ! buffer size (in r8s) + integer, public :: buf1win ! buf1 Window id + integer, public :: buf2win ! buf2 Window id + +contains + +!---------------------------------------------------------------------- + + subroutine spmd_readnl(nlfilename) + + ! !USES: + use units, only: getunit, freeunit + use namelist_utils, only: find_group_name + use spmd_utils, only: npes, masterproc + use pmgrid, only: plat, plev, plon + use mpishorthand + + implicit none + + ! + ! !PARAMETERS: + character(len=*), intent(in) :: nlfilename + +! !DESCRIPTION: Read in EUL-specific namelist variables. Must be +! performed before dyn\_init +! +! !REVISION HISTORY: +! 2010.05.15 Sawyer Creation +! +!EOP +!========================================================================= +!BOC +! Local variables + integer :: ierr ! error code + integer :: unitn ! namelist unit number + character(len=*), parameter :: subname = "spmd_readnl" + + namelist /spmd_dyn_inparm/ dyn_alltoall, & + dyn_allgather, & + dyn_equi_by_col,& + dyn_npes, & + dyn_npes_stride + + if (masterproc) then + write(iulog,*) 'Read in spmd_dyn_inparm namelist from: ', trim(nlfilename) + unitn = getunit() + open( unitn, file=trim(nlfilename), status='old' ) + + ! Look for dyn_eul_inparm group name in the input file. If found, leave the + ! file positioned at that namelist group. + call find_group_name(unitn, 'spmd_dyn_inparm', status=ierr) + if (ierr == 0) then ! found spmd_dyn_inparm + read(unitn, spmd_dyn_inparm, iostat=ierr) ! read the spmd_dyn_inparm namelist group + if (ierr /= 0) then + call endrun( subname//':: namelist read returns an'// & + ' error condition for spmd_dyn_inparm' ) + end if + end if + close( unitn ) + call freeunit( unitn ) + endif + + call mpibcast (dyn_alltoall ,1,mpiint,0,mpicom) + call mpibcast (dyn_allgather ,1,mpiint,0,mpicom) + call mpibcast (dyn_equi_by_col,1,mpilog,0,mpicom) + call mpibcast (dyn_npes ,1,mpiint,0,mpicom) + call mpibcast (dyn_npes_stride,1,mpiint,0,mpicom) + + if ((dyn_alltoall.lt.min_alltoall).or. & + (dyn_alltoall.gt.max_alltoall)) then + write(iulog,*) & + 'spmd_readnl: ERROR: dyn_alltoall=', & + dyn_alltoall, & + ' is out of range. It must be between ', & + min_alltoall,' and ',max_alltoall + call endrun + endif + + if ((dyn_allgather.lt.min_allgather).or. & + (dyn_allgather.gt.max_allgather)) then + write(iulog,*) & + 'spmd_readnl: ERROR: dyn_allgather=', & + dyn_allgather, & + ' is out of range. It must be between ', & + min_allgather,' and ',max_allgather + call endrun + endif + ! + if ((dyn_npes.lt.min_npes).or. & + (dyn_npes.gt.max_npes)) then + write(iulog,*) & + 'spmd_readnl: ERROR: dyn_npes=', & + dyn_npes, & + ' is out of range. It must be between ', & + min_npes,' and ',max_npes + call endrun + endif + ! + if ((dyn_npes_stride.lt.min_npes_stride).or. & + (dyn_npes_stride.gt.max_npes_stride)) then + write(iulog,*) & + 'spmd_readnl: ERROR: dyn_npes_stride=', & + dyn_npes_stride, & + ' is out of range. It must be between ', & + min_npes_stride,' and ',max_npes_stride + call endrun + endif + + + end subroutine spmd_readnl + + +!======================================================================== + + subroutine spmdinit_dyn () +!----------------------------------------------------------------------- +! +! Purpose: Distribute latitudes among available processes +! +! Method: Distribution is S->N for processes 0->dyn_npes +! +! Author: CCM Core Group +! Modified: P. Worley, November 2003 to improve SMP load balance, and to +! change distribution to +! S->E for processes 0,2,..,dyn_npes-2 +! and +! N->E for processes 1,3,..,dyn_npes-1 +! when mirror flag is set (at request of physics) +! Modified: P. Worley, November 2004 to improve load balance for +! reduced grid by equidistributing columns (not latitudes) +! in latitude decomposition. Used when equi_by_col flag is set. +! On by default, and gives identical decomposition as +! equidistributing by latitude when using a full grid. +! Modified: P. Worley, April 2007 to support idle processes when +! in the dynamics (dyn_npes < npes) +! +!----------------------------------------------------------------------- + use comspe, only: numm + use spmd_utils +#if (defined MODCM_DP_TRANSPOSE) + use parutilitiesmodule, only : parinit +#endif +!----------------------------------------------------------------------- +! +! Local workspace +! + integer i ! loop index + integer tot_cols ! total number of columns in computational grid + integer m2,m3,m5 ! 2, 3, 5 prime factors for problem decomposition + integer tot_nx ! total number of latitudes/columns in + ! computational grid + integer nx_base ! approx. number of latitudes/columns per proc + integer nx_p(0:npes-1) ! number of latitudes/columns per process + integer nx_smp(0:npes-1) ! number of latitudes/columns per SMP + integer nproc_smp(0:npes-1) ! number of MPI processes per SMP + integer workleft ! amount of work still to be parcelled out + + integer smpid ! SMP id + integer smpids ! SMP id for SH process + integer smpidn ! SMP id for NH process + integer procj ! process offset loop index + integer procid ! process id + integer procids ! process id SH + integer procidn ! process id NH + integer procid_s ! strided process id + integer procids_s ! strided process id SH + integer procidn_s ! strided process id NH + + integer max_ncols ! maximum number of columns assigned to a process + integer min_max_ncols ! minmax number of columns assigned + ! to a process over all latitude assignments + integer ncol ! number of columns assigned to current process + integer ncol_curtot ! current total number of columns assigned + integer ncol_curgoal ! target number of columns to be assigned to process + integer lat ! latitude index + integer iend ! ending latitude band of work for a given proc + integer neighn_minlat(plat) ! minimum latitude in north neighbor + integer neighs_maxlat(plat) ! maximum latitude in south neighbor + integer active_proc ! +1 for active dynamics processes + integer ierror ! MPI error return + + real(r8) avgnx_proc(0:npes-1) ! average number of latitudes/columns per + ! MPI process in a given SMP node + real(r8) minavgnx_proc ! minimum average number of + ! latitudes/columns per + ! MPI process over SMP nodes + real(r8) alpha ! slop factor in assigning latitudes to processes + real(r8) opt_alpha! best slop factor in assigning latitudes to processes + + logical done ! exit flag for latitude assignment loop +! +!----------------------------------------------------------------------- +! +! Initialize Pilgrim library +! +#if (defined MODCM_DP_TRANSPOSE) + call parinit(mpicom) +#endif +! +! Initialize mirror flag +! + mirror = phys_mirror_decomp_req +! +! Allocate memory for MPI task partition array +! and extended partition +! + allocate (cut (2,0:npes-1)) + cut(1,0:npes-1) = 1 + cut(2,0:npes-1) = 0 +! + allocate (cutex(2,0:npes-1)) + cutex(1,0:npes-1) = 1 + cutex(2,0:npes-1) = 0 +! +! Allocate memory for number of lats per proc +! + allocate (nlat_p (0:npes-1)) + nlat_p(0:npes-1) = 0 +! +! Allocate memory for number of columns per proc +! + allocate (ncol_p (0:npes-1)) + ncol_p(0:npes-1) = 0 +! +! determine total number of columns +! + tot_cols = 0 + do lat=1,plat + tot_cols = tot_cols + plon + enddo +! +! Make sure number of PEs, latitudes, and columns are kosher +! + call factor (plat, m2, m3, m5) + + if (.not. single_column) then + if (m2 < 1) then + call endrun('SPMDINIT_DYN: Problem size is not divisible by 2') + end if + end if + + + if (masterproc) then + write(iulog,*) 'Problem factors: 2**',m2,' * 3**',m3,' * 5**',m5 + end if + + if (npes > 1) then + if (dyn_npes > min( 2*(npes/2), plat ) ) then + dyn_npes = min( 2*(npes/2), plat ) + endif + if (dyn_npes_stride > npes/dyn_npes) then + dyn_npes_stride = npes/dyn_npes + endif + else + dyn_npes = 1 + dyn_npes_stride = 1 + endif + + if (.not. single_column) then + if ((dyn_equi_by_col) .and. (mod(tot_cols,2) /= 0)) then + write(iulog,*)'SPMDINIT_DYN: Total number of columns(', & + tot_cols,') must be a multiple of 2' + call endrun('SPMDINIT_DYN: number of columns must be multiple of 2') + end if + end if +! +! Initialization for inactive processes +! + beglat = 1 + endlat = 0 + numlats = 0 + begirow = 1 + endirow = 0 + + beglatex = 1 + endlatex = 0 + numlatsex = 0 +! +! Special initialization for dyn_npes == 1 case +! + if (dyn_npes .eq. 1) then +! + nlat_p(0) = plat + cut(1,0) = 1 + cut(2,0) = plat +! + ncol_p(0) = 0 + do lat=1,plat + ncol_p(0) = ncol_p(0) + plon + enddo +! + if (iam .eq. 0) then + beglat = 1 + endlat = plat + numlats = plat + begirow = 1 + endirow = plat/2 + endif +! + else +! +! Determine approximate number of columns or latitudes per process +! + if (dyn_equi_by_col) then + tot_nx = tot_cols + else + tot_nx = plat + endif + nx_base = tot_nx/dyn_npes + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + nx_p(procid_s) = nx_base + enddo +! +! Calculate initial distribution of columns or latitudes and +! distribution of processes by SMP +! + nx_smp(0:npes-1) = 0 + nproc_smp(0:npes-1) = 0 + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + smpid = proc_smp_map(procid_s) + nproc_smp(smpid) = nproc_smp(smpid) + 1 + enddo +! + do smpid=0,nsmps-1 + nx_smp(smpid) = nx_base*nproc_smp(smpid) + avgnx_proc(smpid) = real(nx_base,r8) + enddo +! +! Equi-distribute remaining columns or latitudes across SMPs +! without increasing per process imbalance beyond minimum +! + workleft = tot_nx - dyn_npes*nx_base + do while (workleft > 0) +! +! (a) Find minimun number of columns or latitudes assigned to an SMP +! + minavgnx_proc = avgnx_proc(0) + do smpid=1,nsmps-1 + if (minavgnx_proc > avgnx_proc(smpid)) then + minavgnx_proc = avgnx_proc(smpid) + endif + enddo +! +! (b) Assign an additional column or latitude to processes with +! nx_base latitudes/columns in SMPs with the minimum +! average number of latitudes/columns +! + do procid=dyn_npes/2-1,0,-1 + if (mirror) then + procids = 2*procid + procidn = procids + 1 + else + procids = procid + procidn = dyn_npes - procids - 1 + endif +! + procids_s = dyn_npes_stride*procids + procidn_s = dyn_npes_stride*procidn +! + smpids = proc_smp_map(procids_s) + smpidn = proc_smp_map(procidn_s) + if ((nx_p(procids_s) .eq. nx_base) .and. & + ((avgnx_proc(smpids) .eq. minavgnx_proc) .or. & + (avgnx_proc(smpidn) .eq. minavgnx_proc)) .and. & + (workleft > 0)) then +! + nx_p(procids_s) = nx_p(procids_s) + 1 + nx_smp(smpids) = nx_smp(smpids) + 1 + avgnx_proc(smpids) = & + real(nx_smp(smpids),r8)/real(nproc_smp(smpids),r8) +! + nx_p(procidn_s) = nx_p(procids_s) + nx_smp(smpidn) = nx_smp(smpidn) + 1 + avgnx_proc(smpidn) = & + real(nx_smp(smpidn),r8)/real(nproc_smp(smpidn),r8) +! + workleft = workleft - 2 + endif + enddo + end do +! +! Partition latitudes over processes, equidistributing either +! a) columns, or +! b) latitudes +! + if (dyn_equi_by_col) then +! +! Evaluate different latitude assignments +! + min_max_ncols = tot_cols + do i=0,10 + alpha = .05_r8*i + max_ncols = 0 +! + iend = 0 + ncol_curtot = 0 + ncol_curgoal = 0 + do procid=0,dyn_npes/2-1 + if (mirror) then + procids = 2*procid + else + procids = procid + endif + procids_s = dyn_npes_stride*procids + ncol_curgoal = ncol_curgoal + nx_p(procids_s) + ncol = 0 +! + done = .false. +! +! Add latitudes until near column per process goal for current process +! + do while ((.not. done) .and. & + (ncol_curtot < ncol_curgoal)) + if (iend .ge. plat/2) then + write(iulog,*)'SPMDINIT_DYN: error in assigning latitudes to processes' + call endrun + endif + if (ncol_curtot + plon .le. & + ncol_curgoal + alpha*plon) then + iend = iend + 1 + ncol = ncol + plon + ncol_curtot = ncol_curtot + plon + else + done = .true. + endif + enddo + if (ncol > max_ncols) max_ncols = ncol +! + enddo + if (max_ncols < min_max_ncols) then + min_max_ncols = max_ncols + opt_alpha = alpha + endif + enddo +! +! Determine latitude assignments when equidistributing columns +! + iend = 0 + ncol_curtot = 0 + ncol_curgoal = 0 + do procid=0,dyn_npes/2-1 + if (mirror) then + procids = 2*procid + procidn = procids + 1 + else + procids = procid + procidn = dyn_npes - procids - 1 + endif +! + procids_s = dyn_npes_stride*procids + procidn_s = dyn_npes_stride*procidn +! + ncol_curgoal = ncol_curgoal + nx_p(procids_s) + ncol_p(procids_s) = 0 +! + cut(1,procids_s) = iend + 1 + cut(2,procids_s) = iend + done = .false. +! +! Add latitudes until near column per process goal for current process +! + do while ((.not. done) .and. & + (ncol_curtot < ncol_curgoal)) + if (ncol_curtot + plon .le. & + ncol_curgoal + opt_alpha*plon) then + iend = iend + 1 + cut(2,procids_s) = iend + ncol_p(procids_s) = ncol_p(procids_s) + plon + ncol_curtot = ncol_curtot + plon + nlat_p(procids_s) = nlat_p(procids_s) + 1 + else + done = .true. + endif + enddo +! +! Assign mirror latitudes +! + cut(1,procidn_s) = plat - cut(2,procids_s) + 1 + cut(2,procidn_s) = plat - cut(1,procids_s) + 1 + ncol_p(procidn_s) = ncol_p(procids_s) + nlat_p(procidn_s) = nlat_p(procids_s) +! +! Save local information +! + if (iam == procids_s .or. iam == procidn_s) then + beglat = cut(1,iam) + endlat = cut(2,iam) + numlats = nlat_p(iam) + begirow = cut(1,procids_s) + endirow = cut(2,procids_s) + end if +! + enddo +! + else +! +! Determine latitude assignments when +! equidistributing latitudes +! + iend = 0 + do procid=0,dyn_npes/2-1 + if (mirror) then + procids = 2*procid + procidn = procids + 1 + else + procids = procid + procidn = dyn_npes - procids - 1 + endif +! + procids_s = dyn_npes_stride*procids + procidn_s = dyn_npes_stride*procidn +! + nlat_p(procids_s) = nx_p(procids_s) + cut(1,procids_s) = iend + 1 + cut(2,procids_s) = iend + nlat_p(procids_s) + iend = iend + nlat_p(procids_s) +! + ncol_p(procids_s) = 0 + do lat=cut(1,procids_s),cut(2,procids_s) + ncol_p(procids_s) = ncol_p(procids_s) + plon + enddo +! +! Assign mirror latitudes +! + nlat_p(procidn_s) = nx_p(procidn_s) + cut(1,procidn_s) = plat - cut(2,procids_s) + 1 + cut(2,procidn_s) = plat - cut(1,procids_s) + 1 +! + ncol_p(procidn_s) = 0 + do lat=cut(1,procidn_s),cut(2,procidn_s) + ncol_p(procidn_s) = ncol_p(procidn_s) + plon + enddo +! +! Save local information +! + if (iam == procids_s .or. iam == procidn_s) then + beglat = cut(1,iam) + endlat = cut(2,iam) + numlats = nlat_p(iam) + begirow = cut(1,procids_s) + endirow = cut(2,procids_s) + end if +! + enddo + endif +! + endif +! +! Calculate maximum number of latitudes and columns assigned to a process +! + maxlats = maxval(nlat_p) + maxcols = maxval(ncol_p) +! + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + if (masterproc) then + write(iulog,*)'procid ',procid_s,' assigned ', & + cut(2,procid_s)-cut(1,procid_s)+1,' latitude values from', & + cut(1,procid_s),' through ',cut(2,procid_s),' containing', & + ncol_p(procid_s),' vertical columns' + end if +! +! Determine which process is responsible for the defined latitudes +! + do lat=cut(1,procid_s),cut(2,procid_s) + proc(lat) = procid_s + end do +! +! The extended regions are simply "numbnd" wider at each +! side. The extended region do not go beyond 1 and plat, though +! + cutex(1,procid_s) = cut(1,procid_s) - numbnd + cutex(2,procid_s) = cut(2,procid_s) + numbnd + if (iam == procid_s) then + beglatex = cutex(1,procid_s) + numbnd + endlatex = cutex(2,procid_s) + numbnd + numlatsex = endlatex - beglatex + 1 + end if + end do +! +! Determine neighbor processes needed for boundary communication. +! North first. +! + neighn = 0 + neighn_minlat(:) = -1 + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + if (procid_s /= iam) then + if ((cut(1,procid_s) > cut(2,iam)) .and. & + (cut(1,procid_s) <= cut(2,iam)+numbnd)) then + neighn_minlat(cut(1,procid_s)) = procid_s + neighn = neighn + 1 + endif + endif + enddo +! +! Sort north processes by increasing latitude +! + allocate (neighn_proc (neighn)) + neighn = 0 + do lat=1,plat + if (neighn_minlat(lat) /= -1) then + neighn = neighn + 1 + neighn_proc(neighn) = neighn_minlat(lat) + endif + enddo +! +! South next. +! + neighs = 0 + neighs_maxlat(:) = -1 + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + if (procid_s /= iam) then + if ((cut(2,procid_s) < cut(1,iam)) .and. & + (cut(2,procid_s) >= cut(1,iam)-numbnd)) then + neighs_maxlat(cut(2,procid_s)) = procid_s + neighs = neighs + 1 + endif + endif + enddo +! +! Sort south processes by decreasing latitude +! + allocate (neighs_proc (neighs)) + neighs = 0 + do lat=plat,1,-1 + if (neighs_maxlat(lat) /= -1) then + neighs = neighs + 1 + neighs_proc(neighs) = neighs_maxlat(lat) + endif + enddo +! + if (masterproc) then + write(iulog,*)'-----------------------------------------' + write(iulog,*)'Number of lats passed north & south = ',numbnd + write(iulog,*)'Node Partition Extended Partition' + write(iulog,*)'-----------------------------------------' + do procid=0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + write(iulog,200) procid_s,cut(1,procid_s),cut(2,procid_s) ,cutex(1,procid_s), & + cutex(2,procid_s) +200 format(i3,4x,i3,'-',i3,7x,i3,'-',i3) + end do + end if +! write(iulog,*)'iam=',iam,'Number of south neighbors needed for bndry exchange = ',neighs +! write(iulog,*)'iam=',iam,'Number of north neighbors needed for bndry exchange = ',neighn + + call decomp_wavenumbers () +! +! Make communicator for active dynamics processors (for use in realloc4a/4b) + if (beglat <= endlat) then + active_proc = 1 + else + active_proc = 0 + endif + call mpi_comm_split(mpicom, active_proc, iam, mpicom_dyn_active, ierror) +! +! Precompute swap partners and number of steps in realloc4 alltoall algorithm. +! First, determine number of swaps. +! + realloc4_steps = 0 + do procj=1,ceil2(npes)-1 + procid = pair(npes,procj,iam) + if (procid >= 0) then + if (((numm(iam) > 0) .and. (nlat_p(procid) > 0)) .or. & + ((numm(procid) > 0) .and. (numlats > 0))) then + realloc4_steps = realloc4_steps + 1 + end if + end if + end do +! +! Second, determine swap partners. +! + allocate( realloc4_proc(realloc4_steps) ) + allocate( realloc4_step(0:npes-1) ) + realloc4_step(:) = -1 + realloc4_steps = 0 + do procj=1,ceil2(npes)-1 + procid = pair(npes,procj,iam) + if (procid >= 0) then + if (((numm(iam) > 0) .and. (nlat_p(procid) > 0)) .or. & + ((numm(procid) > 0) .and. (numlats > 0))) then + realloc4_steps = realloc4_steps + 1 + realloc4_proc(realloc4_steps) = procid + realloc4_step(procid) = realloc4_steps + end if + end if + end do +! +! Precompute swap partners in realloc5/7 allgather algorithm. + allocate( allgather_proc(npes-1) ) + allocate( allgather_step(0:npes-1) ) + allgather_step(:) = -1 + allgather_steps = 0 + do procj=1,ceil2(npes)-1 + procid = pair(npes,procj,iam) + if (procid >= 0) then + allgather_steps = allgather_steps + 1 + allgather_proc(allgather_steps) = procid + allgather_step(procid) = allgather_steps + end if + end do +! + return + end subroutine spmdinit_dyn + +!======================================================================== + + subroutine factor (nitems, m2, m3, m5) +!----------------------------------------------------------------------- +! +! Purpose: Factor a given number into powers of 2,3,5 +! +! Method: Brute force application of "mod" function +! +! Author: CCM Core Group +! +!----------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: nitems ! Number to be factored into powers of 2,3,5 + integer, intent(out) :: m2,m3,m5 ! Powers of 2, 3, and 5 respectively +! +! Local workspace +! + integer num ! current number to be factored +! +!----------------------------------------------------------------------- +! + num = nitems + m2 = 0 + m3 = 0 + m5 = 0 + +2 if (mod(num,2) == 0) then + m2 = m2 + 1 + num = num/2 + goto 2 + end if + +3 if (mod(num,3) == 0) then + m3 = m3 + 1 + num = num/3 + goto 3 + end if + +5 if (mod(num,5) == 0) then + m5 = m5 + 1 + num = num/5 + goto 5 + end if + + if (num /= 1) then + write(iulog,*) 'FACTOR: ',nitems,' has a prime factor other than 2, 3, or 5. Aborting...' + call endrun + end if + + return + end subroutine factor + +!======================================================================== + + subroutine decomp_wavenumbers +!----------------------------------------------------------------------- +! +! Purpose: partition the spectral work among the given number of processes +! +! Method: Approximately equidistribute both the number of spectral +! coefficients and the number of wavenumbers assigned to each +! MPI task using a modified version of the mapping due to +! Barros and Kauranne. +! +! Author: P. Worley, September 2002 +! +!----------------------------------------------------------------------- + use pspect, only: pmmax + use comspe, only: numm, maxm, locm, locrm, nlen, lpspt, lnstart +! +! Local workspace +! + integer procid ! process id + integer procid_s ! strided process id + integer m, lm ! global and local fourier wavenumber indices + integer mstride ! Stride over wavenumbers used in decomposition + integer begm1 ! Starting Fourier wavenumbers owned by an MPI task + integer begm2 ! when using Barros & Kauranne decomposition + integer speccount(0:npes-1) + ! number of spectral coefficients assigned to + ! each MPI task +!----------------------------------------------------------------------- +! +! determine upper bound on number of wavenumbers to be assigned to each +! process + if (mod(pmmax,dyn_npes) .eq. 0) then + maxm = pmmax/dyn_npes + else + maxm = (pmmax/dyn_npes) + 1 + endif + allocate ( numm(0:npes-1) ) + allocate ( locm(1:maxm, 0:npes-1) ) + allocate ( locrm(1:2*maxm, 0:npes-1) ) +! +! assign wavenumbers to approximately equidistribute the number +! of spectral coefficients assigned to each process + numm(:) = 0 + locm(:,:) = huge(1) + locrm(:,:) = huge(1) + speccount(:) = 0 + mstride = 2*dyn_npes + npessp = 0 + do procid = 0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + begm1 = procid + 1 + begm2 = mstride - procid + do m=begm1,pmmax,mstride + numm(procid_s) = numm(procid_s) + 1 + locm(numm(procid_s),procid_s) = m + speccount(procid_s) = speccount(procid_s) + nlen(m) + enddo + do m=begm2,pmmax,mstride + numm(procid_s) = numm(procid_s) + 1 + locm(numm(procid_s),procid_s) = m + speccount(procid_s) = speccount(procid_s) + nlen(m) + enddo +! + if (numm(procid_s) .gt. 0) then + npessp = npessp + 1 + endif +! + enddo +! + do procid = 0,dyn_npes-1 + procid_s = dyn_npes_stride*procid + if (masterproc) then + write(iulog,*)'procid ',procid_s,' assigned ', speccount(procid_s), & + ' spectral coefficients and ', numm(procid_s), & + ' m values: ', (locm(lm,procid_s),lm=1,numm(procid_s)) + end if + do lm=1,numm(procid_s) + locrm(2*lm-1,procid_s) = 2*locm(lm,procid_s)-1 + locrm(2*lm ,procid_s) = 2*locm(lm,procid_s) + enddo + enddo +! +! Calculate number of local spectral coefficients + lpspt = 0 + do lm=1,numm(iam) + lpspt = lpspt + nlen(locm(lm,iam)) + enddo +! +! Evaluate displacement info based on truncation params and +! wavenumber assignment + allocate ( lnstart(1:maxm) ) + lnstart(1) = 0 + do lm=2,numm(iam) + lnstart(lm) = lnstart(lm-1) + nlen(locm(lm-1,iam)) + enddo +! + return + end subroutine decomp_wavenumbers + +!======================================================================== + + subroutine spmdbuf +!----------------------------------------------------------------------- +! +! Purpose: allocate spmd pack buffers used in collective communications +! +! Author: CCM Core Group +! +! Note: Call after phys_grid_init +! +!----------------------------------------------------------------------- + use error_messages, only: alloc_err + use comspe, only: maxm + use constituents, only: pcnst +!----------------------------------------------------------------------- +! +! Local workspace +! + integer :: maxcount(5),m + integer :: length,i,lm,istat1,istat2 + integer :: bsiz, glb_bsiz ! buffer size (in bytes) +! +! realloc4a max: 8 2 plev*numm*numlats (e.g. tdyn) +! 1 2 *numm*numlats (bpstr) +! + maxcount(1) = (npes-1)*maxlats*(2*maxm*(plev*8 + 1)) +! +! realloc4b max: 8 2 plev*numm*numlats (e.g. vort) +! 4 2 *numm*numlats (e.g. dps) +! + maxcount(2) = (npes-1)*maxlats*(2*maxm*(plev*8 + 4)) +! +! realloc5 max: 6 numlats (e.g. tmass) +! 5 numlats *pcnst (e.g. hw1lat) +! 2 4*numlats*pcnst (e.g. hw2al) +! + maxcount(3) = npes*maxlats*(6 + (5 + 2*4)*pcnst) +! +! realloc7 max: 3 plev *numlats (e.g. vmax2d) +! 5 *numlats (e.g. psurf) +! + maxcount(4) = npes*maxlats*(3*plev + 5) +! +! dp_coupling max: +! + if (.not. local_dp_map) then + maxcount(5) = (5 + pcnst)*max(block_buf_nrecs,chunk_buf_nrecs) + else + maxcount(5) = 0 + endif +! + m = maxval(maxcount) + call mpipack_size (m, mpir8, mpicom, bsiz) + call mpiallmaxint(bsiz, glb_bsiz, 1, mpicom) + if (masterproc) then + write(iulog,*) 'SPMDBUF: Allocating SPMD buffers of size ',glb_bsiz + endif + spmdbuf_siz = glb_bsiz/8 + 1 +#if (defined CAF) + allocate(buf1(spmdbuf_siz)[*], stat=istat1) + allocate(buf2(spmdbuf_siz)[*], stat=istat2) +#else + allocate(buf1(spmdbuf_siz), stat=istat1) + allocate(buf2(spmdbuf_siz), stat=istat2) +#endif + call alloc_err( istat1, 'spmdbuf', 'buf1', spmdbuf_siz ) + call alloc_err( istat2, 'spmdbuf', 'buf2', spmdbuf_siz ) + call mpiwincreate(buf1,spmdbuf_siz*8,mpicom,buf1win) + call mpiwincreate(buf2,spmdbuf_siz*8,mpicom,buf2win) + buf1 = 0.0_r8 + buf2 = 0.0_r8 + return + end subroutine spmdbuf + +!======================================================================== + + subroutine compute_gsfactors (numperlat, numtot, numperproc, displs) +!----------------------------------------------------------------------- +! +! Purpose: Compute arguments for gatherv, scatterv +! +! Author: CCM Core Group +! +!----------------------------------------------------------------------- +! +! Input arguments +! + integer, intent(in) :: numperlat ! number of elements per latitude +! +! Output arguments +! + integer, intent(out) :: numtot ! total number of elements (to send or recv) + integer, intent(out) :: numperproc(0:npes-1) ! per-PE number of items to receive + integer, intent(out) :: displs(0:npes-1) ! per-PE displacements +! +! Local variables +! + integer :: p ! index + + numtot = numperlat*numlats + + do p=0,npes-1 + numperproc(p) = numperlat*nlat_p(p) + end do + + displs(0) = 0 + do p=1,npes-1 + displs(p) = numperlat*(cut(1,p)-1) + end do + + end subroutine compute_gsfactors + +#endif + +end module spmd_dyn diff --git a/src/dynamics/eul/stats.F90 b/src/dynamics/eul/stats.F90 new file mode 100644 index 0000000000..72df933fc9 --- /dev/null +++ b/src/dynamics/eul/stats.F90 @@ -0,0 +1,110 @@ +subroutine stats(lat ,pint ,pdel ,pstar , & + vort ,div ,t ,q ,nlon ) +!----------------------------------------------------------------------- +! +! Purpose: +! Accumulation of diagnostic statistics for 1 latitude. +! +! Method: +! +! Author: +! Original version: J. Rosinski +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, J. Hack, August 1992 +! Reviewed: D. Williamson, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev, plevp, plat + use pspect + use commap + + implicit none + +#include +! +! Input arguments +! + integer, intent(in) :: lat ! latitude index (S->N) + integer, intent(in) :: nlon + + real(r8), intent(in) :: pint(plon,plevp) ! pressure at model interfaces + real(r8), intent(in) :: pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) + real(r8), intent(in) :: pstar(plon) ! ps + psr (surface pressure) + real(r8), intent(in) :: vort(plon,plev) ! vorticity + real(r8), intent(in) :: div(plon,plev) ! divergence + real(r8), intent(in) :: t(plon,plev) ! temperature + real(r8), intent(in) :: q(plon,plev) ! moisture +! +!---------------------------Local workspace----------------------------- +! + real(r8) prat ! pdel(i,k)/pint(i,plevp) + + integer i,k ! longitude, level indices + integer ifld ! field index +! +!----------------------------------------------------------------------- +! +! Compute statistics for current latitude line +! + psurf(lat) = 0._r8 + do i=1,nlon + psurf(lat) = psurf(lat) + pstar(i) + end do + psurf(lat)= w(lat)*psurf(lat)/nlon + +!$OMP PARALLEL DO PRIVATE (IFLD, K, I, PRAT) + do ifld=1,4 + if (ifld == 1) then + + rmsz (lat) = 0._r8 + do k=1,plev + do i=1,nlon + prat = pdel(i,k)/pint(i,plevp) + rmsz(lat) = rmsz(lat) + vort(i,k)*vort(i,k)*prat + end do + end do + rmsz(lat) = w(lat)*rmsz(lat)/nlon + + elseif (ifld == 2) then + + rmsd (lat) = 0._r8 + do k=1,plev + do i=1,nlon + prat = pdel(i,k)/pint(i,plevp) + rmsd(lat) = rmsd(lat) + div(i,k)*div(i,k)*prat + end do + end do + rmsd(lat) = w(lat)*rmsd(lat)/nlon + + elseif (ifld == 3) then + + rmst (lat) = 0._r8 + do k=1,plev + do i=1,nlon + prat = pdel(i,k)/pint(i,plevp) + rmst(lat) = rmst(lat) + (t(i,k)**2)*prat + end do + end do + rmst(lat) = w(lat)*rmst(lat)/nlon + + else + + stq (lat) = 0._r8 + do k=1,plev + do i=1,nlon + prat = pdel(i,k)/pint(i,plevp) + stq(lat) = stq(lat) + q(i,k)*pdel(i,k) + end do + end do + stq (lat) = w(lat)*stq(lat)/nlon + + endif + enddo +! + return +end subroutine stats diff --git a/src/dynamics/eul/stepon.F90 b/src/dynamics/eul/stepon.F90 new file mode 100644 index 0000000000..4939f8d1c1 --- /dev/null +++ b/src/dynamics/eul/stepon.F90 @@ -0,0 +1,371 @@ +module stepon +!----------------------------------------------------------------------- +! +! Purpose: +! Module for time-stepping of the CAM Eulerian Spectral dynamics. +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod, only: shr_sys_flush + use pmgrid, only: plev, plat, plevp, plon, beglat, endlat + use spmd_utils, only: masterproc + use scanslt, only: advection_state + use prognostics, only: ps, u3, v3, t3, q3, qminus, div, & + dpsl, dpsm, omga, phis, n3, n3m2, n3m1 + use camsrfexch, only: cam_out_t + use ppgrid, only: begchunk, endchunk + use physics_types, only: physics_state, physics_tend + use time_manager, only: is_first_step, get_step_size + use iop, only: setiopupdate, readiopdata + use scamMod, only: use_iop,doiopupdate,use_pert_frc,wfld,wfldh,single_column + use perf_mod + + implicit none + private + save + + public stepon_init ! Initialization + public stepon_run1 ! Run method phase 1 + public stepon_run2 ! Run method phase 2 + public stepon_run3 ! Run method phase 3 + public stepon_final ! Finalization +! +! Private module data +! + type(physics_state), pointer :: phys_state(:) ! Physics state data + type(physics_tend ), pointer :: phys_tend(:) ! Physics tendency data + + real(r8) :: detam(plev) ! intervals between vert full levs. + real(r8) :: cwava(plat) ! weight applied to global integrals + real(r8), allocatable :: t2(:,:,:) ! temp tendency + real(r8), allocatable :: fu(:,:,:) ! u wind tendency + real(r8), allocatable :: fv(:,:,:) ! v wind tendency + real(r8), allocatable :: flx_net(:,:) ! net flux from physics + real(r8), allocatable :: fq(:,:,:,:) ! Q tendencies,for eul_nsplit>1 + real(r8), allocatable :: t2_save(:,:,:) ! temp tendency + real(r8), allocatable :: fu_save(:,:,:) ! u wind tendency + real(r8), allocatable :: fv_save(:,:,:) ! v wind tendency + real(r8) :: coslat(plon) ! cosine of latitude + real(r8) :: rcoslat(plon) ! Inverse of coseine of latitude + real(r8) :: rpmid(plon,plev) ! inverse of midpoint pressure + real(r8) :: pdel(plon,plev) ! Pressure depth of layer + real(r8) :: pint(plon,plevp) ! Pressure at interfaces + real(r8) :: pmid(plon,plev) ! Pressure at midpoint + type(advection_state) :: adv_state ! Advection state data + + real(r8) :: etamid(plev) ! vertical coords at midpoints or pmid if single_column + +!======================================================================= +contains +!======================================================================= + +subroutine stepon_init(dyn_in, dyn_out) +!----------------------------------------------------------------------- +! +! Purpose: Initialization, primarily of dynamics. +! +!----------------------------------------------------------------------- + use dyn_comp, only: dyn_import_t, dyn_export_t + use scanslt, only: scanslt_initial + use commap, only: clat + use constituents, only: pcnst + use physconst, only: gravit + use eul_control_mod,only: eul_nsplit +#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only:init_iop_fields +#endif +!----------------------------------------------------------------------- +! Arguments +! + type(dyn_import_t) :: dyn_in ! included for compatibility + type(dyn_export_t) :: dyn_out ! included for compatibility +!----------------------------------------------------------------------- +! Local variables +! + integer :: k, lat, i + !----------------------------------------------------------------------- + + call t_startf ('stepon_startup') + + call scanslt_initial(adv_state, etamid, gravit, detam, cwava) + ! + ! Initial guess for trajectory midpoints in spherical coords. + ! nstep = 0: use arrival points as initial guess for trajectory midpoints. + ! nstep > 0: use calculated trajectory midpoints from previous time + ! step as first guess. + ! NOTE: reduce number of iters necessary for convergence after nstep = 1. + ! + if (is_first_step()) then + do lat=beglat,endlat + if (.not. single_column) then + do i=1,plon + coslat(i) = cos(clat(lat)) + rcoslat(i) = 1._r8/coslat(i) + end do + endif + ! + ! Set current time pressure arrays for model levels etc. + ! + call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) + ! + do k=1,plev + do i=1,plon + rpmid(i,k) = 1._r8/pmid(i,k) + end do + end do + + if (.not. single_column) then + ! + ! Calculate vertical motion field + ! + call omcalc (rcoslat, div(1,1,lat,n3), u3(1,1,lat,n3), v3(1,1,lat,n3), dpsl(1,lat), & + dpsm(1,lat), pmid, pdel, rpmid ,pint(1,plevp), & + omga(1,1,lat), plon) + else + + omga(1,:,lat)=wfld(:) + endif + end do + end if + + allocate(t2(plon,plev,beglat:endlat)) + allocate(fu(plon,plev,beglat:endlat)) + allocate(fv(plon,plev,beglat:endlat)) + allocate( flx_net(plon,beglat:endlat)) + if (eul_nsplit>1) then + allocate(fq(plon,plev,pcnst,beglat:endlat)) + allocate(t2_save(plon,plev,beglat:endlat)) + allocate(fu_save(plon,plev,beglat:endlat)) + allocate(fv_save(plon,plev,beglat:endlat)) + endif + ! + ! Beginning of basic time step loop + ! + call t_stopf ('stepon_startup') + + +#if ( defined BFB_CAM_SCAM_IOP ) + if (is_first_step()) then + call init_iop_fields() + endif +#endif +end subroutine stepon_init + +! +!======================================================================= +! + +subroutine stepon_run1( ztodt, phys_state, phys_tend , pbuf2d, dyn_in, dyn_out) +!----------------------------------------------------------------------- +! +! Purpose: Phase 1 run method of dynamics. Set the time-step +! to use for physics. And couple from dynamics to physics. +! +!----------------------------------------------------------------------- + use dyn_comp, only: dyn_import_t, dyn_export_t + use time_manager, only: get_nstep + use prognostics, only: pdeld + + use dp_coupling, only: d_p_coupling + use eul_control_mod,only: eul_nsplit + use physics_buffer, only : physics_buffer_desc + real(r8), intent(out) :: ztodt ! twice time step unless nstep=0 + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(dyn_import_t) :: dyn_in ! included for compatibility + type(dyn_export_t) :: dyn_out ! included for compatibility + + real(r8) :: dtime ! timestep size + !----------------------------------------------------------------------- + + dtime = get_step_size() + + ztodt = 2.0_r8*dtime + + ! If initial time step adjust dt + if (is_first_step()) ztodt = dtime + + ! subcycling case, physics dt is always dtime + if (eul_nsplit>1) ztodt = dtime + + ! Dump state variables to IC file + call t_startf ('diag_dynvar_ic') + call diag_dynvar_ic (phis, ps(:,beglat:endlat,n3m1), t3(:,:,beglat:endlat,n3m1), u3(:,:,beglat:endlat,n3m1), & + v3(:,:,beglat:endlat,n3m1), q3(:,:,:,beglat:endlat,n3m1) ) + call t_stopf ('diag_dynvar_ic') + ! + !---------------------------------------------------------- + ! Couple from dynamics to physics + !---------------------------------------------------------- + ! + call t_startf ('d_p_coupling') + call d_p_coupling (ps(:,beglat:endlat,n3m2), t3(:,:,beglat:endlat,n3m2), u3(:,:,beglat:endlat,n3m2), & + v3(:,:,beglat:endlat,n3m2), q3(:,:,:,beglat:endlat,n3m2), & + omga, phis, phys_state, phys_tend, pbuf2d, pdeld(:,:,:,n3m2)) + call t_stopf ('d_p_coupling') +end subroutine stepon_run1 + +! +!======================================================================= +! + +subroutine stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) +!----------------------------------------------------------------------- +! +! Purpose: Phase 2 run method of dynamics. Couple from physics +! to dynamics. +! +!----------------------------------------------------------------------- + use dyn_comp, only: dyn_import_t, dyn_export_t + use dp_coupling, only: p_d_coupling + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_tend), intent(in):: phys_tend(begchunk:endchunk) + type(dyn_import_t) :: dyn_in ! included for compatibility + type(dyn_export_t) :: dyn_out ! included for compatibility + + call t_startf ('p_d_coupling') + call p_d_coupling (phys_state, phys_tend, t2, fu, fv, flx_net, & + qminus ) + call t_stopf ('p_d_coupling') +end subroutine stepon_run2 + +! +!======================================================================= +! + +subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) +!----------------------------------------------------------------------- +! +! Purpose: Final phase of dynamics run method. Run the actual dynamics. +! +!----------------------------------------------------------------------- + use dyn_comp, only: dyn_import_t, dyn_export_t + use eul_control_mod,only: eul_nsplit + real(r8), intent(in) :: ztodt ! twice time step unless nstep=0 + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(dyn_import_t) :: dyn_in ! included for compatibility + type(dyn_export_t) :: dyn_out ! included for compatibility + real(r8) :: dt_dyn0,dt_dyn + integer :: stage + if (single_column) then + + ! Determine whether it is time for an IOP update; + ! doiopupdate set to true if model time step > next available IOP + if (use_iop) then + call setiopupdate + end if + + ! Update IOP properties e.g. omega, divT, divQ + + if (doiopupdate) call readiopdata() + + endif + + !---------------------------------------------------------- + ! DYNPKG Call the Dynamics Package + !---------------------------------------------------------- + call t_startf ('dynpkg') + + if (eul_nsplit==1) then + call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & + cwava ,detam ,flx_net ,ztodt) + else + dt_dyn0 = ztodt/eul_nsplit + dt_dyn = dt_dyn0 + if (is_first_step()) dt_dyn = 2*dt_dyn0 + + ! convert q adjustment to a tendency + fq = (qminus(:,:,:,:) - q3(:,:,:,:,n3m2))/ztodt + ! save a copy of t2,fu,fv + t2_save=t2 + fu_save=fu + fv_save=fv + + call apply_fq(qminus,q3(:,:,:,:,n3m2),fq,dt_dyn0) + call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & + cwava ,detam ,flx_net ,dt_dyn0) + + do stage=2,eul_nsplit + t2=t2_save + fu=fu_save + fv=fv_save + call apply_fq(qminus,q3(:,:,:,:,n3m2),fq,dt_dyn) + call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & + cwava ,detam ,flx_net ,dt_dyn) + enddo + endif + + call t_stopf ('dynpkg') +end subroutine stepon_run3 + + + +subroutine apply_fq(qminus,q3,fq,dt) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plat, plev, plevp, beglat, endlat + use constituents, only: pcnst + + real(r8), intent(in) :: q3(plon,plev,beglat:endlat,pcnst) + real(r8), intent(in) :: fq(plon,plev,beglat:endlat,pcnst) + real(r8), intent(out) :: qminus(plon,plev,beglat:endlat,pcnst) + real(r8), intent(in) :: dt + + !local + real(r8) :: q_tmp,fq_tmp + integer :: q,c,k,i + + do q=1,pcnst + do c=beglat,endlat + do k=1,plev + do i=1,plon + fq_tmp = dt*fq(i,k,c,q) + q_tmp = q3(i,k,c,q) + ! if forcing is > 0, do nothing (it makes q less negative) + if (fq_tmp<0 .and. q_tmp+fq_tmp<0 ) then + ! reduce magnitude of forcing so it wont drive q negative + ! but we only reduce the magnitude of the forcing, dont increase + ! its magnitude or change the sign + + ! if q<=0, then this will set fq=0 (q already negative) + ! if q>0, then we know from above that fq < -q < 0, so we + ! can reduce the magnitive of fq by setting fq = -q: + fq_tmp = min(-q_tmp,0._r8) + endif + qminus(i,k,c,q) = q_tmp + fq_tmp + enddo + enddo + enddo + enddo + +end subroutine + + +! +!======================================================================= +! + +subroutine stepon_final(dyn_in, dyn_out) +!----------------------------------------------------------------------- +! +! Purpose: Stepon finalization. +! +!----------------------------------------------------------------------- + use dyn_comp, only: dyn_import_t, dyn_export_t + use scanslt, only: scanslt_final + type(dyn_import_t) :: dyn_in ! included for compatibility + type(dyn_export_t) :: dyn_out ! included for compatibility + + call scanslt_final( adv_state ) + deallocate(t2) + deallocate(fu) + deallocate(fv) + deallocate(flx_net) + +end subroutine stepon_final +! +!======================================================================= +! + +end module stepon diff --git a/src/dynamics/eul/tfilt_massfix.F90 b/src/dynamics/eul/tfilt_massfix.F90 new file mode 100644 index 0000000000..28af050aa2 --- /dev/null +++ b/src/dynamics/eul/tfilt_massfix.F90 @@ -0,0 +1,489 @@ +module tfilt_massfix +!----------------------------------------------------------------------- +! +! Purpose: +! Time filter (second half of filter for vorticity and divergence only) +! +!----------------------------------------------------------------------- + implicit none + private + save + + public tfilt_massfixrun +! +! Private module data +! + +!======================================================================= +contains +!======================================================================= + +subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & + v3m1, v3, t3m1, t3, q3m1, & + q3, psm1, ps, alpha, & + etamid, qfcst, vort, div, vortm2, & + divm2, qminus, psm2, um2, & + vm2, tm2, qm2, vortm1, divm1, & + omga, dpsl, dpsm, beta, hadv , & + nlon, pdeldry, pdelm1dry, pdelm2dry) +!----------------------------------------------------------------------- +! +! Purpose: +! Time filter (second half of filter for vorticity and divergence only) +! +! Method: +! +! Author: +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_control_mod, only: ideal_phys + use cam_history, only: outfld + use eul_control_mod, only: fixmas,eps + use pmgrid, only: plon, plev, plevp, plat + use commap, only: clat + use constituents, only: pcnst, qmin, cnst_cam_outfld, & + tottnam, tendnam, cnst_get_type_byind, fixcnam, & + hadvnam, vadvnam + use time_manager, only: get_nstep + use physconst, only: cpair, gravit + use scamMod, only: single_column, dqfxcam + use phys_control, only: phys_getopts + use qneg_module, only: qneg3 + +#if ( defined BFB_CAM_SCAM_IOP ) + use iop + use constituents, only: cnst_get_ind, cnst_name +#endif + implicit none + +! +! Input arguments +! + real(r8), intent(in) :: ztodt ! two delta t (unless nstep<2) + + real(r8), intent(inout) :: qfcst(plon,plev,pcnst)! slt moisture forecast + real(r8), intent(in) :: vort(plon,plev) + real(r8), intent(in) :: div(plon,plev) + real(r8), intent(inout) :: vortm2(plon,plev) + real(r8), intent(inout) :: divm2(plon,plev) + real(r8), intent(in) :: qminus(plon,plev,pcnst) + real(r8), intent(inout) :: psm2(plon) + real(r8), intent(inout) :: um2(plon,plev) + real(r8), intent(inout) :: vm2(plon,plev) + real(r8), intent(inout) :: tm2(plon,plev) + real(r8), intent(inout) :: qm2(plon,plev,pcnst) + real(r8), intent(inout) :: omga(plon,plev) + real(r8), intent(in) :: dpsl(plon) + real(r8), intent(in) :: dpsm(plon) + real(r8), intent(in) :: beta ! energy fixer coefficient + real(r8), intent(in) :: hadv(plon,plev,pcnst) ! horizonal q advection tendency + real(r8), intent(in) :: alpha(pcnst) + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: u3(plon,plev) + real(r8), intent(in) :: v3(plon,plev) + real(r8), intent(inout) :: t3(plon,plev) + real(r8), intent(inout) :: pdeldry(:,:) ! dry pressure difference at time n3 + real(r8), intent(inout) :: pdelm1dry(:,:) ! dry pressure difference at time n3m1 + real(r8), intent(in) :: pdelm2dry(:,:) ! dry pressure difference at time n3m2 + + + integer, intent(in) :: lat + integer, intent(in) :: nlon + +! Input/Output arguments + + real(r8), intent(inout) :: q3(plon,plev,pcnst) + real(r8), intent(inout) :: ps(plon) + real(r8), intent(inout) :: vortm1(plon,plev) + real(r8), intent(inout) :: psm1(plon) + real(r8), intent(inout) :: u3m1(plon,plev) + real(r8), intent(inout) :: v3m1(plon,plev) + real(r8), intent(inout) :: t3m1(plon,plev) + real(r8), intent(inout) :: divm1(plon,plev) + real(r8), intent(inout) :: q3m1(plon,plev,pcnst) +! +! Local workspace +! + integer ifcnt ! Counter + integer :: nstep ! current timestep number + integer :: timefiltstep ! + + real(r8) tfix (plon) ! T correction + real(r8) engycorr(plon,plev) ! energy equivalent to T correction + real(r8) rpmid(plon,plev) ! 1./pmid + real(r8) pdel(plon,plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) pint(plon,plevp) ! pressure at model interfaces (n ) + real(r8) pmid(plon,plev) ! pressure at model levels (time n) + real(r8) utend(plon,plev) ! du/dt + real(r8) vtend(plon,plev) ! dv/dt + real(r8) ttend(plon,plev) ! dT/dt + real(r8) qtend(plon,plev,pcnst)! dq/dt + real(r8) pstend(plon) ! d(ps)/dt + real(r8) vadv (plon,plev,pcnst) ! vertical q advection tendency + real(r8) pintm1(plon,plevp) ! pressure at model interfaces (n-1) + real(r8) pmidm1(plon,plev) ! pressure at model levels (time n-1) + real(r8) pdelm1(plon,plev) ! pdelm1(k) = pintm1(k+1)-pintm1(k) + real(r8) om2eps + real(r8) corm + real(r8) wm + real(r8) absf + real(r8) worst + logical lfixlim ! flag to turn on fixer limiter + + real(r8) ta(plon,plev,pcnst) ! total advection of constituents + real(r8) dqfx3(plon,plev,pcnst)! q tendency due to mass adjustment + real(r8) coslat ! cosine(latitude) + real(r8) rcoslat(plon) ! 1./cosine(latitude) +! real(r8) engt ! Thermal energy integral +! real(r8) engk ! Kinetic energy integral +! real(r8) engp ! Potential energy integral + integer i, k, m,j,ixcldliq,ixcldice,ixnumliq,ixnumice +#if ( defined BFB_CAM_SCAM_IOP ) + real(r8) :: u3forecast(plon,plev) + real(r8) :: v3forecast(plon,plev) + real(r8) :: t3forecast(plon,plev),delta_t3(plon,plev) + real(r8) :: q3forecast(plon,plev,pcnst),delta_q3(plon,plev,pcnst) +#endif + real(r8) fixmas_plon(plon) + real(r8) beta_plon(plon) + real(r8) clat_plon(plon) + real(r8) alpha_plon(plon) + +!----------------------------------------------------------------------- + nstep = get_nstep() +#if ( defined BFB_CAM_SCAM_IOP ) +! +! Calculate 3d dynamics term +! + do k=1,plev + do i=1,nlon + divt3dsav(i,k,lat)=(t3(i,k)-tm2(i,k))/ztodt -t2sav(i,k,lat) + divu3dsav(i,k,lat)=(u3(i,k)-um2(i,k))/ztodt -fusav(i,k,lat) + divv3dsav(i,k,lat)=(v3(i,k)-vm2(i,k))/ztodt -fvsav(i,k,lat) + t3forecast(i,k)=tm2(i,k)+ztodt*t2sav(i,k,lat)+ztodt*divt3dsav(i,k,lat) + u3forecast(i,k)=um2(i,k)+ztodt*fusav(i,k,lat)+ztodt*divu3dsav(i,k,lat) + v3forecast(i,k)=vm2(i,k)+ztodt*fvsav(i,k,lat)+ztodt*divv3dsav(i,k,lat) + end do + end do + do i=1,nlon + do m=1,pcnst + do k=1,plev + divq3dsav(i,k,m,lat)= (qfcst(i,k,m)-qminus(i,k,m))/ztodt + q3forecast(i,k,m)=qminus(i,k,m)+divq3dsav(i,k,m,lat)*ztodt + end do + end do + end do + + + q3(:nlon,:,:)=q3forecast(:nlon,:,:) + t3(:nlon,:)=t3forecast(:nlon,:) + qfcst(:nlon,:,:)=q3(:nlon,:,:) + +! +! outflds for iop history tape - to get bit for bit with scam +! the n-1 values are put out. After the fields are written out +! the current time level of info will be buffered for output next +! timestep +! + call outfld('t',t3 ,plon ,lat ) + call outfld('q',q3 ,plon ,lat ) + call outfld('Ps',ps ,plon ,lat ) + call outfld('u',u3 ,plon ,lat ) + call outfld('v',v3 ,plon ,lat ) +! +! read single values into plon arrays for output to history tape +! it would be nice if history tape supported 1 dimensional array variables +! + fixmas_plon(:)=fixmas + beta_plon(:)=beta + clat_plon(:)=clat(lat) + + call outfld('fixmas',fixmas_plon,plon ,lat ) + call outfld('beta',beta_plon ,plon ,lat ) + call outfld('CLAT ',clat_plon ,plon ,lat ) + call outfld('divT3d',divt3dsav(1,1,lat) ,plon ,lat ) + call outfld('divU3d',divu3dsav(1,1,lat) ,plon ,lat ) + call outfld('divV3d',divv3dsav(1,1,lat) ,plon ,lat ) + do m =1,pcnst + call outfld(trim(cnst_name(m))//'_dten',divq3dsav(1,1,m,lat) ,plon ,lat ) + end do +#endif + + + coslat = cos(clat(lat)) + do i=1,nlon + rcoslat(i) = 1._r8/coslat + enddo + lfixlim = .true. + + +! +! Set average dry mass to specified constant preserving horizontal +! gradients of ln(ps). Proportionality factor was calculated in STEPON +! for nstep=0 or SCAN2 otherwise from integrals calculated in INIDAT +! and SCAN2 respectively. +! Set p*. +! + do i=1,nlon + ps(i) = ps(i)*fixmas + end do +! +! Set current time pressure arrays for model levels etc. +! + call plevs0(nlon ,plon ,plev ,ps ,pint ,pmid ,pdel) +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + rpmid(i,k) = 1._r8/pmid(i,k) + enddo + enddo +! +! Add temperature correction for energy conservation +! + if (ideal_phys) then + engycorr(:,:) = 0._r8 + else +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + engycorr(i,k) = (cpair/gravit)*beta*pdel(i,k)/ztodt + t3 (i,k) = t3(i,k) + beta + end do + end do + end if + do i=1,nlon + tfix(i) = beta/ztodt + end do +! +! Output Energy correction term +! +! using do loop and select in order to enable functional parallelism with OpenMP +!$OMP PARALLEL DO PRIVATE (I) + do i=1,2 + select case (i) + case (1) + call outfld ('ENGYCORR',engycorr ,plon ,lat ) + case (2) + call outfld ('TFIX ',tfix ,plon ,lat ) + end select + end do + +! +! Compute q tendency due to mass adjustment +! If LFIXLIM = .T., then: +! Check to see if fixer is exceeding a desired fractional limit of the +! constituent mixing ratio ("corm"). If so, then limit the fixer to +! that specified limit. +! + do m=1,pcnst + if (cnst_get_type_byind(m).eq.'dry' ) then + corm = 1.e36_r8 + else + corm = 0.1_r8 + end if + +!$OMP PARALLEL DO PRIVATE (K, I, IFCNT, WORST, WM, ABSF) + do k=1,plev + do i=1,nlon + if (single_column) then + dqfx3(i,k,m) = dqfxcam(i,k,m) + else + dqfx3(i,k,m) = alpha(m)*etamid(k)*abs(qfcst(i,k,m) - qminus(i,k,m)) +#if ( defined BFB_CAM_SCAM_IOP ) + dqfx3sav(i,k,m,lat) = dqfx3(i,k,m) +#endif + endif + end do + if (lfixlim) then + ifcnt = 0 + worst = 0._r8 + wm = 0._r8 + do i = 1,nlon + absf = abs(dqfx3(i,k,m)) + if (absf.gt.corm) then + ifcnt = ifcnt + 1 + worst = max(absf,worst) + wm = wm + absf + dqfx3(i,k,m) = sign(corm,dqfx3(i,k,m)) + endif + end do + if (ifcnt.gt.0) then + wm = wm/real(ifcnt,r8) + +! TBH: Commented out as of CAM CRB meeting on 6/20/03 +! write(iulog,1000) m,corm,ifcnt,k,lat,wm,worst + + endif + endif + do i=1,nlon + dqfx3(i,k,m) = qfcst(i,k,m)*dqfx3(i,k,m)/ztodt + q3 (i,k,m) = qfcst(i,k,m) + ztodt*dqfx3(i,k,m) + ta (i,k,m) = (q3 (i,k,m) - qminus(i,k,m))/ztodt + vadv (i,k,m) = (qfcst(i,k,m) - qminus(i,k,m))/ztodt - hadv(i,k,m) + end do + end do + end do + +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + pdeldry(i,k) = pdel(i,k)*(1._r8-q3(i,k,1)) + end do ! i + end do ! k + + +#if ( defined BFB_CAM_SCAM_IOP ) + do m=1,pcnst + alpha_plon(:)= alpha(m) + call outfld(trim(cnst_name(m))//'_alph',alpha_plon ,plon ,lat ) + call outfld(trim(cnst_name(m))//'_dqfx',dqfx3sav(1,1,m,lat) ,plon ,lat ) + end do +#endif +! +! Check for and correct invalid constituents +! + call qneg3 ('TFILT_MASSFIX',lat ,nlon ,plon ,plev , & + 1, pcnst, qmin ,q3(1,1,1)) +! +! Send slt tendencies to the history tape +! +!$OMP PARALLEL DO PRIVATE (M) + do m=1,pcnst + if ( cnst_cam_outfld(m) ) then + call outfld(tottnam(m),ta(1,1,m),plon ,lat ) + end if + end do + if (.not. single_column) then +! +! Calculate vertical motion field +! + call omcalc (rcoslat ,div ,u3 ,v3 ,dpsl , & + dpsm ,pmid ,pdel ,rpmid ,pint(1,plevp), & + omga ,nlon ) + + endif + +! write(iulog,*)'tfilt: lat=',lat +! write(iulog,*)'omga=',omga +! +! Time filter (second half of filter for vorticity and divergence only) +! +! if(lat.eq.2) then +! write(iulog,*)'tfilt: ps=',psm2(13),psm1(13),ps(13) +! write(iulog,*)'tfilt: u=',um2(13,18),u3m1(13,18),u3(13,18) +! write(iulog,*)'tfilt: t=',tm2(13,18),t3m1(13,18),t3(13,18) +! write(iulog,*)'tfilt: water=',qm2(13,18,1),q3m1(13,18,1),q3(13,18,1) +! write(iulog,*)'tfilt: cwat=',qm2(13,18,2),q3m1(13,18,2),q3(13,18,2) +! write(iulog,*)'tfilt: vort=',vortm2(13,18),vortm1(13,18),vort(13,18) +! write(iulog,*)'tfilt: div=',divm2(13,18),divm1(13,18),div(13,18) +! end if + + om2eps = 1._r8 - 2._r8*eps + + if (nstep.ge.2) then +!$OMP PARALLEL DO PRIVATE (K, I, M) + do k=1,plev + do i=1,nlon + u3m1(i,k) = om2eps*u3m1(i,k) + eps*um2(i,k) + eps*u3(i,k) + v3m1(i,k) = om2eps*v3m1(i,k) + eps*vm2(i,k) + eps*v3(i,k) + t3m1(i,k) = om2eps*t3m1(i,k) + eps*tm2(i,k) + eps*t3(i,k) + q3m1(i,k,1) = om2eps*q3m1(i,k,1) + eps*qm2(i,k,1) + eps*q3(i,k,1) + vortm1(i,k) = om2eps*vortm1(i,k) + eps*vortm2(i,k) + eps*vort(i,k) + divm1(i,k) = om2eps*divm1(i,k) + eps*divm2(i,k) + eps*div(i,k) + end do + do m=2,pcnst + if (cnst_get_type_byind(m) .eq. 'wet') then + do i=1,nlon + q3m1(i,k,m) = om2eps*q3m1(i,k,m) + eps*qm2(i,k,m) + eps*q3(i,k,m) + end do + endif + end do + do m=2,pcnst + if (cnst_get_type_byind(m) .eq. 'dry') then + do i=1,nlon ! calculate numerator (timefiltered mass * pdeldry) + q3m1(i,k,m) = (om2eps*pdelm1dry(i,k)*q3m1(i,k,m) + & + eps*pdelm2dry(i,k)*qm2(i,k,m) + & + eps*pdeldry(i,k)*q3(i,k,m)) + end do !i + endif !dry + end do !m + do i=1,nlon ! calculate time filtered value of pdeldry + pdelm1dry(i,k) = om2eps*pdelm1dry(i,k) + & + eps*pdelm2dry(i,k) + eps*pdeldry(i,k) + end do !i + ! divide time filtered mass*pdeldry by timefiltered pdeldry + do m=2,pcnst + if (cnst_get_type_byind(m) == 'dry') then + do i=1,nlon + q3m1(i,k,m) = q3m1(i,k,m)/pdelm1dry(i,k) + end do !i + endif ! dry + end do !m + + end do + do i=1,nlon + psm1(i) = om2eps*psm1(i) + eps*psm2(i) + eps*ps(i) + end do + end if + + call plevs0 (nlon ,plon ,plev ,psm1 ,pintm1 ,pmidm1 ,pdelm1) +! +! Compute time tendencies:comment out since currently not on h-t +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i=1,nlon + ttend(i,k) = (t3(i,k)-tm2(i,k))/ztodt + utend(i,k) = (u3(i,k)-um2(i,k))/ztodt + vtend(i,k) = (v3(i,k)-vm2(i,k))/ztodt + end do + end do + +!$OMP PARALLEL DO PRIVATE (M, K, I) + do m=1,pcnst + do k=1,plev + do i=1,nlon + qtend(i,k,m) = (q3(i,k,m) - qm2(i,k,m))/ztodt + end do + end do + end do + + do i=1,nlon + pstend(i) = (ps(i) - psm2(i))/ztodt + end do + +!$OMP PARALLEL DO PRIVATE (M) + do m=1,pcnst + if ( cnst_cam_outfld(m) ) then + call outfld (tendnam(m),qtend(1,1,m),plon,lat) + call outfld (fixcnam(m),dqfx3(1,1,m),plon,lat) + call outfld (hadvnam(m),hadv (1,1,m),plon,lat) + call outfld (vadvnam(m),vadv (1,1,m),plon,lat) + end if + end do + +! using do loop and select in order to enable functional parallelism with OpenMP +!$OMP PARALLEL DO PRIVATE (I) + do i=1,4 + select case (i) + case (1) + call outfld ('UTEND ',utend,plon,lat) + case (2) + call outfld ('VTEND ',vtend,plon,lat) + case (3) + call outfld ('TTEND ',ttend,plon,lat) + case (4) + call outfld ('LPSTEN ',pstend,plon,lat) + end select + end do + + return +1000 format(' TIMEFILTER: WARNING: fixer for tracer ',i3,' exceeded ', & + f8.5,' for ',i5,' points at k,lat = ',2i4, & + ' Avg/Worst = ',1p2e10.2) + +end subroutine tfilt_massfixrun + +end module tfilt_massfix diff --git a/src/dynamics/eul/trjmps.F90 b/src/dynamics/eul/trjmps.F90 new file mode 100644 index 0000000000..9c856e38a9 --- /dev/null +++ b/src/dynamics/eul/trjmps.F90 @@ -0,0 +1,71 @@ +subroutine trjmps(dt ,upr ,vpr ,phimp ,lampr , & + phipr ,nlon ) +!----------------------------------------------------------------------- +! +! Purpose: +! Estimate mid-point interval of parcel trajectory (global spherical +! coordinates). +! +! Method: +! +! Author: +! Original version: J. Olson +! Standardized: J. Rosinski, June 1992 +! Reviewed: D. Williamson, P. Rasch, August 1992 +! Reviewed: D. Williamson, P. Rasch, March 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plon, plev +!----------------------------------------------------------------------- + implicit none +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: dt ! time step (seconds) + real(r8), intent(in) :: upr (plon,plev) ! u-comp of wind at midpoint + real(r8), intent(in) :: vpr (plon,plev) ! v-comp of wind at midpoint + real(r8), intent(in) :: phimp(plon,plev) ! lat coord at midpoint + + integer, intent(in) :: nlon +! +! Output arguments +! + real(r8), intent(out) :: lampr(plon,plev) ! relative long coord of midpoint + real(r8), intent(out) :: phipr(plon,plev) ! relative lat coord of midpoint +! +!----------------------------------------------------------------------- +! +! dt Time interval that corresponds to the parcel trajectory. +! upr u-coordinate of velocity corresponding to the most recent +! estimate of the trajectory mid-point. +! vpr v-coordinate of velocity corresponding to the most recent +! estimate of the trajectory mid-point. +! phimp Phi value of trajectory midpoint (most recent estimate). +! lampr Longitude coordinate of trajectory mid-point relative to the +! arrival point. +! phipr Latitude coordinate of trajectory mid-point relative to the +! arrival point. +! +!---------------------------Local variables----------------------------- +! + integer i,k ! index +! +!----------------------------------------------------------------------- +! +!$OMP PARALLEL DO PRIVATE (K, I) + do k=1,plev + do i = 1,nlon + lampr(i,k) = -.5_r8*dt* upr(i,k) / cos( phimp(i,k) ) + phipr(i,k) = -.5_r8*dt* vpr(i,k) + end do + end do +! + return +end subroutine trjmps diff --git a/src/dynamics/eul/tstep.F90 b/src/dynamics/eul/tstep.F90 new file mode 100644 index 0000000000..53cdfa1d7b --- /dev/null +++ b/src/dynamics/eul/tstep.F90 @@ -0,0 +1,153 @@ + subroutine tstep(lm ,zdt ,ztdtsq ) +!----------------------------------------------------------------------- +! +! Solution of the vertically coupled system of equations arising +! from the semi-impicit equations for each spectral element along +! two dimensional wavenumber n. The inverse matrix depends +! only on two dimensional wavenumber and the reference atmosphere. +! It is precomputed and stored for use during the forecast. The routine +! overwrites the d,T and lnps coefficients with the new values. +! +!---------------------------Code history-------------------------------- +! +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: B. Boville, D. Williamson, August 1992 +! Reviewed: B. Boville, D. Williamson, April 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid + use pspect + use comspe + use commap + use spmd_utils, only : iam + use hycoef, only : hypi, hypd + implicit none + +!----------------------------------------------------------------------- +! +! Input arguments +! + integer, intent(in) :: lm ! local Fourier wavenumber index + + real(r8), intent(in) :: zdt ! timestep, dt (seconds) + real(r8), intent(in) :: ztdtsq(pnmax) ! dt*(n(n+1)/a^2 where n is 2-d wavenumber +! +!---------------------------Local workspace----------------------------- +! + real(r8) z(2*pnmax,plev) ! workspace for computation of spectral array d + real(r8) hhref ! href/2 (reference hydrostatic matrix / 2) + real(r8) hbps ! bps/2 (ref. coeff. for lnps term in div. eq. / 2) + real(r8) ztemp ! temporary workspace + + integer m ! global wavenumber index + integer n,j ! 2-d wavenumber index + integer k,kk ! level indices + integer lmr,lmc ! real and imaginary spectral indices + integer ir,ii ! real and imaginary spectral indices + integer nn ! real and imaginary spectral indices +! +!----------------------------------------------------------------------- +! +! Complete rhs of helmholtz eq. +! + m = locm(lm,iam) + lmr = lnstart(lm) + lmc = 2*lmr +!$OMP PARALLEL DO PRIVATE (K, HHREF, HBPS, N, IR, II, KK) + do k=1,plev +! +! Coefficients for diagonal terms +! + hhref = 0.5_r8*href(k,k) + hbps = 0.5_r8*bps(k) +! +! Loop along total wavenumber index (in spectral space) +! Add lnps and diagonal (vertical space) T terms to d(t-1) +! + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + d(ir,k) = d(ir,k) + ztdtsq(n+m-1)*(hhref*t(ir,k) + hbps*alps(ir)) + d(ii,k) = d(ii,k) + ztdtsq(n+m-1)*(hhref*t(ii,k) + hbps*alps(ii)) + end do + if (k.lt.plev) then + do kk=k+1,plev +! +! Add off-diagonal (vertical space) T terms to d(t-1) +! + hhref = 0.5_r8*href(kk,k) + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + d(ir,k) = d(ir,k) + ztdtsq(n+m-1)*hhref*t(ir,kk) + d(ii,k) = d(ii,k) + ztdtsq(n+m-1)*hhref*t(ii,kk) + end do + end do + end if + end do ! k=1,plev (calculation level) +! +! Solution of helmholtz equation +! First: initialize temporary space for solution +! + z = 0._r8 +! +! Multiply right hand side by inverse matrix +! +!$OMP PARALLEL DO PRIVATE (K, KK, N, IR, II) + do k=1,plev + do kk=1,plev + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + z(2*n-1,k) = z(2*n-1,k) + bm1(kk,k,m+n-1)*d(ir,kk) + z(2*n ,k) = z(2*n ,k) + bm1(kk,k,m+n-1)*d(ii,kk) + end do + end do ! inner loop over levels + end do ! outer loop over levels +! +! Move solution for divergence to d +! +!$OMP PARALLEL DO PRIVATE (K, N, IR, II) + do k=1,plev + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + d(ir,k) = z(2*n-1,k) + d(ii,k) = z(2*n ,k) + end do + end do ! outer loop over levels +! +! Complete ln(pstar) and T forecasts +! Add semi-implicit part to surface pressure (vector multiply) +! + do k=1,plev + ztemp = zdt*hypd(k)/hypi(plevp) + do n=1,nlen(m) + ir = lmc + 2*n - 1 + ii = ir + 1 + alps(ir) = alps(ir) - ztemp*d(ir,k) + alps(ii) = alps(ii) - ztemp*d(ii,k) + end do + end do +! +! Add semi-implicit part to temperature (matrix multiply) +! +!$OMP PARALLEL DO PRIVATE (K, KK, NN) + do k=1,plev + do kk=1,plev + do nn = lmc+1, lmc+2*nlen(m) + t(nn,k) = t(nn,k) - zdt*tau(kk,k)*d(nn,kk) + end do + end do + end do +! + return + end subroutine tstep + diff --git a/src/dynamics/fv/FVperf_module.F90 b/src/dynamics/fv/FVperf_module.F90 new file mode 100644 index 0000000000..fa03c02419 --- /dev/null +++ b/src/dynamics/fv/FVperf_module.F90 @@ -0,0 +1,156 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +!----------------------------------------------------------------------- +! ESMA - Earth System Modeling Applications +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: FVperf_module --- Simple interfaces for performance profiling +! +! !INTERFACE: + +MODULE FVperf_module + +! !USES: + use dynamics_vars, only : T_FVDYCORE_GRID +#if defined(GEOS_MODE) + use GEOS_Mod ! GEOS base class +#elif defined(CAM_MODE) + use perf_mod +#else + use perf_mod +#endif +#if defined( SPMD ) + use mod_comm, only: mp_barrier +#endif + +CONTAINS + +! !DESCRIPTION: A hack to toggle between GEOS5 and CAM profiling +! +! The basic problem solved here is to access GENSTATE in GEOS\_MODE +! without being overly intrusive (e.g. putting GEOS\_MODE in every +! file in which GEOS_GenericStateClockOn is used. If GEOS\_MODE +! is defined, the GENSTATE must be initialized outside this file, +! the various timing markers registered with GenericStateClockAdd, +! and the genstate in this module manual set. If CAM\_MODE is +! defined, the user may use FVstartclock/FVstopclock exactly like +! the CAM utilities t\_startf and t\_stopf. +! +! This module will be removed as soon as there is consensus on a +! unified profiling utility. +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: FVstartclock --- start the clock +! +! !INTERFACE: + subroutine FVstartclock(grid,marker) +! !USES: + implicit none +! !INPUT PARAMETERS: +#if defined(GEOS_MODE) + type (T_FVDYCORE_GRID), intent(inout) :: grid +#else + type (T_FVDYCORE_GRID), intent(in) :: grid +#endif + character(LEN=*) , intent(in) :: marker +!EOP +!----------------------------------------------------------------------- +!BOC +#if defined(GEOS_MODE) + call GEOS_GenericStateClockOn(grid%FVgenstate,marker) +#elif defined(CAM_MODE) + call t_startf(marker) +#else + call t_startf(marker) +#endif +!EOC + end subroutine FVstartclock +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: FVstopclock --- stop the clock +! +! !INTERFACE: + subroutine FVstopclock(grid,marker) +! !USES: + implicit none +! !INPUT PARAMETERS: +#if defined(GEOS_MODE) + type (T_FVDYCORE_GRID), intent(inout) :: grid +#else + type (T_FVDYCORE_GRID), intent(in) :: grid +#endif + character(LEN=*) , intent(in) :: marker +!EOP +!----------------------------------------------------------------------- +!BOC +#if defined(GEOS_MODE) + call GEOS_GenericStateClockOff(grid%FVgenstate,marker) +#elif defined(CAM_MODE) + call t_stopf(marker) +#else + call t_stopf(marker) +#endif +!EOC + end subroutine FVstopclock +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: FVbarrierclock --- instrumented timing barrier +! +! !INTERFACE: + subroutine FVbarrierclock(grid,marker,comm) +! !USES: + implicit none +! !INPUT PARAMETERS: +#if defined(GEOS_MODE) + type (T_FVDYCORE_GRID), intent(inout) :: grid +#else + type (T_FVDYCORE_GRID), intent(in) :: grid +#endif + character(LEN=*) , intent(in) :: marker + integer , intent(in) :: comm +!EOP +!----------------------------------------------------------------------- +!BOC +#if defined(GEOS_MODE) +#if ( defined SPMD ) && ( defined TIMING_BARRIERS ) + call GEOS_GenericStateClockOn(grid%FVgenstate,marker) + call mp_barrier(comm) + call GEOS_GenericStateClockOff(grid%FVgenstate,marker) +#endif +#elif defined(CAM_MODE) +#if ( defined SPMD ) + if (t_profile_onf()) then + if (t_barrier_onf()) then + call t_startf(marker) + call mp_barrier(comm) + call t_stopf(marker) + endif + endif +#endif +#else +#if ( defined SPMD ) + if (t_profile_onf()) then + if (t_barrier_onf()) then + call t_startf(marker) + call mp_barrier(comm) + call t_stopf(marker) + endif + endif +#endif +#endif +!EOC + end subroutine FVbarrierclock +!----------------------------------------------------------------------- + +END MODULE FVperf_module + + diff --git a/src/dynamics/fv/advect_tend.F90 b/src/dynamics/fv/advect_tend.F90 new file mode 100644 index 0000000000..e0f54a6def --- /dev/null +++ b/src/dynamics/fv/advect_tend.F90 @@ -0,0 +1,74 @@ +!---------------------------------------------------------------------- +! this module computes the total advection tendencies of advected +! constituents for the finite volume dycore +!---------------------------------------------------------------------- +module advect_tend + + use shr_kind_mod, only : r8 => shr_kind_r8 + + save + private + + public :: compute_adv_tends_xyz + + real(r8), allocatable :: adv_tendxyz(:,:,:,:) + +contains + + !---------------------------------------------------------------------- + ! computes the total advective tendencies + ! called twice each time step: + ! - first call sets the initial mixing ratios + ! - second call computes and outputs the tendencies + !---------------------------------------------------------------------- + subroutine compute_adv_tends_xyz( grid, tracer ) + use dynamics_vars, only : T_FVDYCORE_GRID + use cam_history, only : outfld + use time_manager, only : get_step_size + use constituents, only : tottnam + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + real (r8) :: tracer(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km, grid%nq ) + + real(r8) :: dt,idt + integer :: iq, idim, i, j,ic + logical :: init + real(r8) :: tmpxy(grid%ifirstxy:grid%ilastxy,grid%km) + + + init = .false. + + if ( .not. allocated( adv_tendxyz ) ) then + init = .true. + allocate( adv_tendxyz(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km, grid%nq ) ) + adv_tendxyz(:,:,:,:) = 0._r8 + endif + +!!$ adv_tendxyz(:,:,:,:grid%nq) = q(:,:,:,:grid%nq) - adv_tendxyz(:,:,:,:grid%nq) + + do ic=1,grid%nq + adv_tendxyz(:,:,:,ic) = tracer(:,:,:,ic) - adv_tendxyz(:,:,:,ic) + enddo + + if ( .not. init ) then + dt = get_step_size() + idt = 1._r8/dt + + do i = 1,grid%nq + ! call outfld + do j = grid%jfirstxy, grid%jlastxy + idim = grid%ilastxy - grid%ifirstxy + 1 + tmpxy(:,:) = adv_tendxyz(:,j,:,i)*idt + + call outfld( tottnam(i), tmpxy, idim, j) + enddo + enddo + + deallocate(adv_tendxyz) + endif + + end subroutine compute_adv_tends_xyz + +end module advect_tend diff --git a/src/dynamics/fv/benergy.F90 b/src/dynamics/fv/benergy.F90 new file mode 100644 index 0000000000..c050f5502e --- /dev/null +++ b/src/dynamics/fv/benergy.F90 @@ -0,0 +1,346 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: benergy --- Calculate the total energy (based on GFDL) +! +! !INTERFACE: + + subroutine benergy(grid, u, v, t3, delp, & + qqq, pe, peln, phis, & + r_vir, cp3v, r3v, tte, te0 ) + +! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only: T_FVDYCORE_GRID + use cam_logfile, only: iulog + use par_vecsum_mod,only: par_vecsum + +#if defined( SPMD ) + use mod_comm, only: mp_send3d, mp_recv3d +#endif + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid ! YZ decomposition + +! U-winds + real(r8), intent(in) :: u(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) +! V-winds + real(r8), intent(in) :: v(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) + +! Temperature (K) + real(r8), intent(in) :: t3(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) + +! Delta pressure + real(r8), intent(in) :: delp(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) + +! Specific humidity + real(r8), intent(in) :: qqq(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) + +! Edge pressure + real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy, & + grid%km+1, & + grid%jfirstxy:grid%jlastxy) + +! Edge pressure + real(r8), intent(in) :: peln(grid%ifirstxy:grid%ilastxy, & + grid%km+1, & + grid%jfirstxy:grid%jlastxy) + +! Surface heights + real(r8), intent(in) :: phis(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) + + real(r8), intent(in) :: r_vir ! Virtual effect constant ( rwv/rg-1 ) + +! C_p + real(r8), intent(in) :: cp3v(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) +! R (gas "constant") + real(r8), intent(in) :: r3v(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km) + +! !OUTPUT PARAMETERS: + +! column integrated Total Energy + real(r8), intent(out) :: tte(grid%jm) +! globally integrated total energy + real(r8), intent(out) :: te0 + +! !DESCRIPTION: +! Determines the column and globally integrated total energy +! +! !REVISION HISTORY: +! +! SJL 99.04.13 : Delivered as release 0.9.8 +! WS 99.05.18 : Added im, jm, km, te, dz as arguments +! WS 99.05.25 : Replaced IMR by IM, JMR by JM-1; removed fvcore.h +! WS 99.10.11 : Ghosted U, now fully limited to jfirst:jlast +! WS 99.11.23 : Pruned te, additional cleaning +! WS 00.05.14 : Renamed ghost indices as per Kevin's definitions +! WS 00.07.13 : Changed PILGRIM API +! WS 00.08.28 : Cosmetic changes +! AAM 00.08.28 : Added kfirst,klast +! WS 00.12.01 : Replaced MPI_ON with SPMD; hs now distributed +! AAM 01.06.15 : Changes for zero diff +! WS 01.12.10 : Ghosted PT +! WS 01.12.31 : Ghosted U,V +! WS 02.07.04 : Fixed 2D decomposition bug dest/src for mp_send3d +! WS 03.10.22 : pmgrid removed (now spmd_dyn) +! WS 03.12.03 : added grid as input argument +! WS 04.10.07 : Removed dependency on spmd_dyn; info now in GRID +! WS 06.05.02 : Rewritten for XY decomposition based on GFDL-code +! WS 06.06.21 : Extensive debugging of revised version +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local + real (r8), parameter :: D0_0 = 0.0_r8 + real (r8), parameter :: D0_25 = 0.25_r8 + real (r8), parameter :: D0_5 = 0.5_r8 + real (r8), parameter :: D1_0 = 1.0_r8 + + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: iam, myidxy_x, myidxy_y, nprxy_x, nprxy_y, dest, src ! SPMD related + integer :: i, j, k, js1g0, js2g0, jn1g0, jn1g1, jn2g0, ktot, jtot, itot + + real (r8) :: u2(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy+1) + real (r8) :: v2(grid%ifirstxy:grid%ilastxy+1,grid%jfirstxy:grid%jlastxy) + + real (r8) :: tm(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real (r8) :: bte(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real (r8) :: te_sp(grid%ifirstxy:grid%ilastxy,grid%km) + real (r8) :: te_np(grid%ifirstxy:grid%ilastxy,grid%km) + real (r8) :: gztop(grid%ifirstxy:grid%ilastxy) + real (r8) :: xsum(grid%jfirstxy:grid%jlastxy) + real (r8) :: sp_sum(grid%km), np_sum(grid%km) + real (r8) :: tm_sp(grid%km), tm_np(grid%km) + real (r8) :: tmp + + real (r8) :: te(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, & + grid%km) + real (r8) :: dz(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, & + grid%km) + real(r8) :: veast(grid%jfirstxy:grid%jlastxy,grid%km) ! East halo + real(r8) :: unorth(grid%ifirstxy:grid%ilastxy,grid%km) ! North halo + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + iam = grid%iam + myidxy_x = grid%myidxy_x + myidxy_y = grid%myidxy_y + nprxy_x = grid%nprxy_x + nprxy_y = grid%nprxy_y + + js1g0 = max(1,jfirstxy) + js2g0 = max(2,jfirstxy) + jn2g0 = min(jm-1,jlastxy) + jn1g0 = min(jm,jlastxy) + jn1g1 = min(jm,jlastxy+1) + + itot = ilastxy - ifirstxy + 1 + jtot = jlastxy - jfirstxy + 1 + +#if defined(SPMD) + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ilastxy, jfirstxy, jfirstxy, 1, km, u ) + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, unorth ) + + if (itot .ne. im) then + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ifirstxy, jfirstxy, jlastxy, 1, km, v ) + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, veast ) + else +!$omp parallel do private(j, k) + do k = 1,km + do j=jfirstxy,jlastxy + veast(j,k) = v(1,j,k) + enddo + enddo + endif +#else + !$omp parallel do private(j, k) + do k = 1,km + do j=1,jm + veast(j,k) = v(1,j,k) + enddo + enddo +#endif + + +!----------------------------------------------------------------------------------------------- + + +!$omp parallel do private(i, j, k, u2, v2, tm) + do k=1,km +! +! Check the poles for consistent values + + do j=js2g0,jlastxy + do i=ifirstxy,ilastxy + u2(i,j) = grid%cose(j) * u(i,j,k)**2 + enddo + enddo + + if ( jlastxy /= jm ) then ! Pull information out of northern halo + do i=ifirstxy,ilastxy + u2(i,jlastxy+1) = grid%cose(jlastxy+1) * unorth(i,k)**2 + enddo + endif + + do j=js2g0,jn2g0 + do i=ifirstxy,ilastxy + v2(i,j) = v(i,j,k)**2 + enddo + v2(ilastxy+1,j) = veast(j,k)**2 ! eastern halo + enddo + + do j=js2g0,jn2g0 + do i=ifirstxy,ilastxy + te(i,j,k) = D0_25*((u2(i,j)+u2(i,j+1))*grid%acosu(j) + & + v2(i,j) + v2(i+1,j)) + enddo + enddo + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + tm(i,j) = t3(i,j,k)*(D1_0+r_vir*qqq(i,j,k)) + enddo + enddo + + do j=js2g0,jn2g0 + do i=ifirstxy, ilastxy + te(i,j,k) = delp(i,j,k) * ( te(i,j,k) + cp3v(i,j,k)*tm(i,j) ) + enddo + enddo + + if ( jfirstxy == 1 ) then + do i=ifirstxy,ilastxy + te_sp(i,k) = D0_5*u2(i,2)/grid%cose(2) + enddo + tm_sp(k) = tm(ifirstxy,1) ! All tm(:,1) should be the same + endif + + if ( jlastxy == jm ) then + do i=ifirstxy,ilastxy + te_np(i,k)= D0_5*u2(i,jm)/grid%cose(jm) + enddo + tm_np(k) = tm(ifirstxy,jm) ! All tm(:,jm) should be the same + endif + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + dz(i,j,k) = r3v(i,j,k)*tm(i,j) + enddo + enddo + enddo + + + if ( jfirstxy == 1 ) then + call par_xsum( grid, te_sp, km, sp_sum ) +!$omp parallel do private(i, k, tmp) + do k=1,km + tmp = delp(ifirstxy,1,k) * (D0_5*sp_sum(k)/real(im,r8) + & + cp3v(ifirstxy,1,k)*tm_sp(k)) + do i=ifirstxy,ilastxy + te(i,1,k) = tmp + enddo + enddo + endif + if ( jlastxy == jm ) then + call par_xsum( grid, te_np, km, np_sum ) +!$omp parallel do private(i, k, tmp) + do k=1,km + tmp = delp(ifirstxy,jm,k) * (D0_5*np_sum(k)/real(im,r8) +& + cp3v(ifirstxy,jm,k)*tm_np(k)) + do i=ifirstxy,ilastxy + te(i,jm,k) = tmp + enddo + enddo + endif + + bte = D0_0 +!$omp parallel do private(i,j,k,gztop) + do j=jfirstxy,jlastxy +! Perform vertical integration + do i=ifirstxy,ilastxy + gztop(i) = phis(i,j) + do k=1,km + gztop(i) = gztop(i) + dz(i,j,k)*(peln(i,k+1,j)-peln(i,k,j)) + enddo + enddo + + if (j == 1) then +! gztop(:) should all have identical values WS 2006.06.22: this checks out +! SP + tte(1) = pe(ifirstxy,km+1,1)*phis(ifirstxy,1) - pe(ifirstxy,1,1)*gztop(ifirstxy) + do k=1,km + tte(1) = tte(1) + te(ifirstxy,1,k) + enddo + tte(1) = grid%acap * tte(1) + elseif (j == jm) then +! gztop(:) should all have identical values WS 2006.06.22: this checks out +! NP + tte(jm) = pe(ifirstxy,km+1,jm)*phis(ifirstxy,jm) - pe(ifirstxy,1,jm)*gztop(ifirstxy) + do k=1,km + tte(jm) = tte(jm) + te(ifirstxy,jm,k) + enddo + tte(jm) = grid%acap * tte(jm) + else +! Interior + + do i=ifirstxy,ilastxy + bte(i,j) = pe(i,km+1,j)*phis(i,j) - pe(i,1,j)*gztop(i) + enddo + + do k=1,km + do i=ifirstxy,ilastxy + bte(i,j) = bte(i,j) + te(i,j,k) + enddo + enddo + endif + enddo + + call par_xsum(grid, bte, jtot, xsum) + +!$omp parallel do private(j) + do j=js2g0,jn2g0 + tte(j) = xsum(j)*grid%cosp(j) + enddo + + call par_vecsum(jm, jfirstxy, jlastxy, tte, te0, grid%commxy_y, grid%nprxy_y) + + write(iulog,*) "myidxy_x/y:", myidxy_x, myidxy_y, "The total energy is", te0 + +!EOC + end subroutine benergy +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/cd_core.F90 b/src/dynamics/fv/cd_core.F90 new file mode 100644 index 0000000000..e679a1d144 --- /dev/null +++ b/src/dynamics/fv/cd_core.F90 @@ -0,0 +1,1967 @@ +subroutine cd_core(grid, nx, u, v, pt, & + delp, pe, pk, ns, dt, & + ptopin, umax, pi, ae, & + cp3vc, cap3vc, cp3v, cap3v, & + iord_c, jord_c, iord_d, jord_d, ipe, & + div24del2flag, del2coef, & + om, hs, cx3 , cy3, mfx, mfy, & + delpf, uc, vc, ptc, dpt, ptk, & + wz3, pxc, wz, hsxy, ptxy, pkxy, & + pexy, pkcc, wzc, wzxy, delpxy, & + pkkp, wzkp, cx_om, cy_om, filtcw, s_trac, & + mlt, ncx, ncy, nmfx, nmfy, iremote, & + cxtag, cytag, mfxtag, mfytag, & + cxreqs, cyreqs, mfxreqs, mfyreqs, & + kmtp, am_correction, am_fixer, dod, don ,high_order_top) + + ! Dynamical core for both C- and D-grid Lagrangian dynamics + ! + ! DESCRIPTION: + ! Perform a dynamical update for one small time step; the small + ! time step is limitted by the fastest wave within the Lagrangian control- + ! volume + + + use shr_kind_mod, only: r8 => shr_kind_r8 + use sw_core, only: d2a2c_winds, c_sw, d_sw + use pft_module, only: pft2d + use dynamics_vars, only: T_FVDYCORE_GRID + use FVperf_module, only: FVstartclock, FVstopclock, FVbarrierclock + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + +#if defined( SPMD ) + use mod_comm, only : mp_send4d_ns, mp_recv4d_ns, & + mp_send2_ns, mp_recv2_ns, & + mp_send3d_2, mp_recv3d_2, & + mp_send3d, mp_recv3d, mp_sendirr, & + mp_recvirr + use mpishorthand +#endif + +#if defined( OFFLINE_DYN ) + use metdata, only : get_met_fields, met_winds_on_walls +#endif + use metdata, only : met_rlx + + implicit none + + ! INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(inout) :: grid! grid (for YZ decomp) + integer, intent(in) :: nx ! # of split pieces in longitude direction + integer, intent(in) :: ipe ! ipe=1: end of cd_core() + ! ipe=-1,-2: start of cd_core() + ! ipe=-2,2: second to last call to cd_core() + ! ipe=0 : + integer, intent(in) :: ns ! Number of internal time steps (splitting) + integer, intent(in) :: iord_c, jord_c ! scheme order on C grid in X and Y dir. + integer, intent(in) :: iord_d, jord_d ! scheme order on D grid in X and Y dir. + integer, intent(in) :: filtcw ! flag for filtering C-grid winds + + ! ct_overlap data + logical, intent(in) :: s_trac ! true to post send for ct_overlap or + ! tracer decomposition information + integer, intent(in) :: mlt ! multiplicity of sends + integer, intent(in) :: ncx, ncy, nmfx, nmfy ! array sizes + integer, intent(in) :: cxtag(mlt), cytag(mlt) ! tags + integer, intent(in) :: mfxtag(mlt), mfytag(mlt) ! tags + integer, intent(in) :: iremote(mlt) ! target tasks + integer, intent(in) :: cxreqs(mlt), cyreqs(mlt) ! mpi requests + integer, intent(in) :: mfxreqs(mlt), mfyreqs(mlt) ! mpi requests + + + real(r8), intent(in) :: pi + real(r8), intent(in) :: ae ! Radius of the Earth (m) + real(r8), intent(in) :: om ! rotation rate + real(r8), intent(in) :: ptopin + real(r8), intent(in) :: umax + real(r8), intent(in) :: dt !small time step in seconds + integer, intent(in) :: div24del2flag + real(r8), intent(in) :: del2coef + integer, intent(in) :: kmtp ! range of levels (1:kmtp) where order is reduced + logical, intent(in) :: am_correction ! logical switch for correction (applied here) + logical, intent(in) :: am_fixer ! logical switch for fixer (generate out args) + logical, intent(in) :: high_order_top ! use uniform 4th order everywhere (incl. model top) + + real(r8), intent(in) :: & + cp3vc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) !C_p on yz + real(r8), intent(in) :: & + cap3vc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) !cappa on yz + real(r8), intent(in) :: & + cp3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! C_p on xy + real(r8), intent(in) :: & + cap3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! cappa on xy -- on "a" grid + + ! Input time independent arrays: + real(r8), intent(in) :: & + hs(grid%im,grid%jfirst:grid%jlast) !surface geopotential + real(r8), intent(in) :: & + hsxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) !surface geopotential XY-decomp. + + ! INPUT/OUTPUT PARAMETERS: + + real(r8), intent(inout) :: & + u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s,grid%kfirst:grid%klast) ! u-Wind (m/s) + real(r8), intent(inout) :: & + v(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! v-Wind (m/s) + + real(r8), intent(inout) :: & + delp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Delta pressure (pascal) + real(r8), intent(inout) :: & + pt(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast)! Scaled-Pot. temp. + + ! Input/output: accumulated winds & mass fluxes on c-grid for large- + ! time-step transport + real(r8), intent(inout) :: & + cx3(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast)! Accum. Courant no. in X + real(r8), intent(inout) :: & + cy3(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Accumulated Courant no. in Y + real(r8), intent(inout) :: & + mfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Mass flux in X (unghosted) + real(r8), intent(inout) :: & + mfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Mass flux in Y + + ! Input/output work arrays: + real(r8), intent(inout) :: & + delpf(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! filtered delp + real(r8), intent(inout) :: & + uc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! u-Winds on C-grid + real(r8), intent(inout) :: & + vc(grid%im,grid%jfirst-2: grid%jlast+2, grid%kfirst:grid%klast) ! v-Winds on C-grid + + real(r8), intent(inout) :: & + dpt(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast) + real(r8), intent(inout) :: & + wz3(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + pxc(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + wz(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + pkcc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + wzc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + wzxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) + real(r8), intent(inout) :: & + delpxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8), intent(inout) :: & + pkkp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real(r8), intent(inout) :: & + wzkp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + + ! OUTPUT PARAMETERS: + real(r8), intent(out) :: & + pe(grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) ! Edge pressure (pascal) + real(r8), intent(out) :: & + pk(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! Pressure to the kappa + real(r8), intent(out) :: & + ptxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! Potential temperature XY decomp + real(r8), intent(out) :: & + pkxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! P-to-the-kappa XY decomp + real(r8), intent(out) :: & + pexy(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! Edge pressure XY decomp + real(r8), intent(out) :: & + ptc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8), intent(out) :: & + ptk(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + +! C.-C. Chen, omega calculation + real(r8), intent(out) :: & + cx_om(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Courant in X + real(r8), intent(out) :: & + cy_om(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Courant in Y + + real(r8), intent(out) :: don(grid%jm,grid%km), & ! num of d(Omega) + dod(grid%jm,grid%km) ! denom of same + + ! Local 2D arrays: + real(r8) :: wk(grid%im+2,grid%jfirst: grid%jlast+2) + real(r8) :: wk1(grid%im,grid%jfirst-1:grid%jlast+1) + real(r8) :: wk2(grid%im+1,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8) :: wk3(grid%im,grid%jfirst-1:grid%jlast+1) + + real(r8) :: p1d(grid%im) + + ! fvitt cell centered u- and v-Winds (m/s) + real(r8) :: u_cen(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) + real(r8) :: v_cen(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) + real(r8) :: ua(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) + real(r8) :: va(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) + + real(r8) :: pec(grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) + + ! Local scalars + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_1 = 0.1_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D4_0 = 4.0_r8 + real(r8), parameter :: D8_0 = 8.0_r8 + real(r8), parameter :: D10_0 = 10.0_r8 + real(r8), parameter :: D128_0 = 128.0_r8 + real(r8), parameter :: D180_0 = 180.0_r8 + real(r8), parameter :: D1E5 = 1.0e5_r8 + + real(r8), parameter :: ratmax = 0.81_r8 + real(r8), parameter :: tiny = 1.0e-10_r8 + + real(r8) :: press + real(r8) :: rat, ycrit + real(r8) :: dt5 + + integer :: im, jm, km ! problem dimensions + integer :: ifirstxy, jfirstxy ! xy-decomp. lat/long ranges + integer :: ng_c ! ghost latitudes on C grid + integer :: ng_d ! ghost lats on D (Max NS dependencies, ng_d >= ng_c) + integer :: ng_s ! max(ng_c+1,ng_d) significant if ng_c = ng_d + + integer :: jfirst + integer :: jlast + integer :: kfirst + integer :: klast + integer :: klastp ! klast, except km+1 when klast=km + + integer :: iam + integer :: npr_y + integer :: npes_yz + + integer i, j, k, ml + integer js1g1, js2g0, js2g1, jn2g1 ,js4g0,jn3g0 + integer jn2g0, jn1g1 + integer iord , jord + + real(r8) :: tau, fac, px4 + real(r8) :: tau4 ! coefficient for 4th-order divergence damping + +#if defined( SPMD ) + integer dest, src +#endif + + logical :: reset_winds = .false. + logical :: everytime = .false. + + ! set damping options: + ! + ! - ldel2: 2nd-order velocity-component damping targetted to top layers, + ! with coefficient del2coef (default 3E5) + ! + ! - ldiv2: 2nd-order divergence damping everywhere and increasing in top layers + ! (default cam3.5 setting) + ! + ! - ldiv4: 4th-order divergence damping everywhere and increasing in top layers + ! + ! - div24del2flag: 2 for ldiv2 (default), 4 for ldiv4, 42 for ldiv4 + ldel2 + ! - ldiv2 and ldel2 cannot coexist + + logical :: ldiv2 = .true. + logical :: ldiv4 = .false. + logical :: ldel2 = .false. + + ! AM correction and fixer + integer :: iord_c_min + integer :: iord_d_min + integer :: iord_d_low + integer :: jord_c_min + integer :: jord_d_min + integer :: jord_d_low + real(r8) :: oma + real(r8) :: xakap + real(r8), pointer :: cosp(:) + real(r8), pointer :: cose(:) + + real(r8), allocatable :: help(:,:,:) + real(r8), allocatable :: kelp(:,:,:) + real(r8), allocatable :: dpn(:,:,:) + real(r8), allocatable :: dpo(:,:,:) + real(r8), allocatable :: dpr(:,:,:) + real(r8), allocatable :: ddpu(:,:,:) + real(r8), allocatable :: dpns(:,:) + real(r8), allocatable :: ddus(:,:) + + ! referenced outside AM conditional even though it's not used + real(r8) :: ddpa(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ) + real(r8) :: ddu( grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ) + real(r8) :: vf( grid%im,grid%jfirst-2:grid%jlast+2,grid%kfirst:grid%klast ) ! v-Winds on U points + + ! Used to allow the same code to execute with or without the AM correction + real(r8) :: ptr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) + + logical :: sw_am_corr + + !****************************************************************** + !****************************************************************** + ! + ! IMPORTANT CODE OPTIONS - SEE BELOW + ! + !****************************************************************** + !****************************************************************** + ! Option for which version of geopk to use with yz decomposition. + ! If geopkdist=false, variables are transposed to/from xy decomposition + ! for use in geopk. + ! If geopkdist=true, either geopk_d or geopk16 is used. Both + ! compute local partial sums in z and then communicate those + ! sums to combine them. geopk_d does not try to parallelize in the + ! z-direction except in a pipeline fashion controlled by the + ! parameter geopkblocks, and is bit-for-bit the same as the + ! transpose-based algorithm. geopk16 exploits z-direction + ! parallelism and requires 16-byte arithmetic (DSIZE=16) + ! to reproduce the same numerics (and to be reproducible with + ! respect to process count). The geopk16 default is to use + ! 8-byte arithmetic (DSIZE=8). This is faster than + ! 16-byte, but also gives up reproducibility. On many systems + ! performance of geopk_d is comparable to geopk16 even with + ! 8-byte numerics. + ! On the last two small timesteps (ipe=1,2 or 1,-2) for D-grid, + ! the version of geopk that uses transposes is called regardless, + ! as some transposed quantities are required for the te_map phase + ! and for the calculation of omega. + ! For non-SPMD mode, geopk_[cd]dist are set to false. + + logical geopk_cdist, geopk_ddist + + ! REVISION HISTORY: + ! SJL 99.01.01: Original SMP version + ! WS 99.04.13: Added jfirst:jlast concept + ! SJL 99.07.15: Merged c_core and d_core to this routine + ! WS 99.09.07: Restructuring, cleaning, documentation + ! WS 99.10.18: Walkthrough corrections; frozen for 1.0.7 + ! WS 99.11.23: Pruning of some 2-D arrays + ! SJL 99.12.23: More comments; general optimization; reduction + ! of redundant computation & communication + ! WS 00.05.14: Modified ghost indices per Kevin's definition + ! WS 00.07.13: Changed PILGRIM API + ! WS 00.08.28: Cosmetic changes: removed old loop limit comments + ! AAM 00.08.30: Introduced kfirst,klast + ! WS 00.12.01: Replaced MPI_ON with SPMD; hs now distributed + ! WS 01.04.11: PILGRIM optimizations for begin/endtransfer + ! WS 01.05.08: Optimizations in the call of c_sw and d_sw + ! AAM 01.06.27: Reinstituted 2D decomposition for use in ccm + ! WS 01.12.10: Ghosted PT, code now uses mod_comm primitives + ! WS 01.12.31: Removed vorticity damping, ghosted U,V,PT + ! WS 02.01.15: Completed transition to mod_comm + ! WS 02.07.04: Fixed 2D decomposition bug dest/src for mp_send3d + ! WS 02.09.04: Integrated fvgcm-1_3_71 zero diff. changes by Lin + ! WS 03.07.22: Removed HIGH_P option; this is outdated + ! WS 03.10.15: Fixed hack of 00.04.13 for JORD>1 JCD=1, in clean way + ! WS 03.12.03: Added grid as argument, some dynamics_vars removed + ! WS 04.08.25: Interface simplified with GRID argument + ! WS 04.10.07: Removed dependency on spmd_dyn; info now in GRID + ! WS 05.05.24: Incorporated OFFLINE_DYN; merge of CAM/GEOS5 + ! PW 05.07.26: Changes for Cray X1 + ! PW 05.10.12: More changes for Cray X1(E), avoiding array segment copying + ! WS 06.09.08: Isolated magic numbers as F90 parameters + ! WS 06.09.15: PI now passed as argument + ! CC 07.01.29: Corrected calculation of OMEGA + ! PW 08.06.29: Added options to call geopk_d and swap-based transposes + ! THT 16.11.18: Add options for AM correction and fixer + !-------------------------------------------------------------------------------------- + + logical :: high_alt + high_alt = grid%high_alt + + geopk_cdist = .false. + geopk_ddist = .false. +#if defined( SPMD ) + if (grid%geopkdist) then + geopk_cdist = .true. + if ((ipe == -1) .or. (ipe == 0)) geopk_ddist = .true. + endif +#endif + + npes_yz = grid%npes_yz + + im = grid%im + jm = grid%jm + km = grid%km + + ng_c = grid%ng_c + ng_d = grid%ng_d + ng_s = grid%ng_s + + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + klastp = grid%klastp + + iam = grid%iam + npr_y = grid%npr_y + + ifirstxy = grid%ifirstxy + jfirstxy = grid%jfirstxy + + if (am_correction .or. am_fixer) then + allocate( & + help(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ), & + kelp(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ), & + dpn(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), & + dpo(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ) ) + endif + if (am_correction) then + allocate( & + dpr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast ), & + ddpu(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), & + dpns(grid%jfirst:grid%jlast,grid%kfirst:grid%klast), & + ddus(grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ) + xakap = 1._r8/cap3vc(1,jfirst,kfirst) + else + xakap = 1._r8 + endif + + ! maintain consistent accuracy (uniform PPM order) over domain + if (high_order_top) then + iord_c_min = iord_c + jord_c_min = jord_c + iord_d_min = iord_d + jord_d_min = jord_d + iord_d_low = iord_d + jord_d_low = jord_d + else + iord_c_min = 1 + jord_c_min = 1 + iord_d_min = 1 + jord_d_min = 1 + iord_d_low = 2 + jord_d_low = 2 + endif + oma = ae*om + don = 0.0_r8 + dod = 0.0_r8 + cosp => grid%cosp + cose => grid%cose + + if (iam .lt. npes_yz) then + + call FVstartclock(grid,'---PRE_C_CORE') + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_C_CORE_COMM') + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_s, u ) + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_s, ng_d, v ) + call FVstopclock(grid,'---PRE_C_CORE_COMM') +#endif + + ! Set general loop limits + ! jfirst >= 1; jlast <= jm + js1g1 = max(1,jfirst-1) + js2g0 = max(2,jfirst) + js2g1 = max(2,jfirst-1) + jn2g0 = min(jm-1,jlast) + jn1g1 = min(jm,jlast+1) + jn2g1 = min(jm-1,jlast+1) + js4g0 = max(4,jfirst) + jn3g0 = min(jm-2,jlast) + + if ( abs(grid%dt0-dt) > D0_1 ) then + + grid%dt0 = dt + dt5 = D0_5*dt + + grid%rdy = D1_0/(ae*grid%dp) + grid%dtdy = dt *grid%rdy + grid%dtdy5 = dt5*grid%rdy + grid%dydt = (ae*grid%dp) / dt + grid%tdy5 = D0_5/grid%dtdy + + do j = 2, jm-1 + grid%dx(j) = grid%dl*ae*grid%cosp(j) + grid%rdx(j) = D1_0 / grid%dx(j) + grid%dtdx(j) = dt /grid% dx(j) + grid%dxdt(j) = grid%dx(j) / dt + grid%dtdx2(j) = D0_5*grid%dtdx(j) + grid%dtdx4(j) = D0_5*grid%dtdx2(j) + grid%dycp(j) = ae*grid%dp/grid%cosp(j) + grid%cy(j) = grid%rdy * grid%acosp(j) + end do + + do j = 2, jm + grid%dxe(j) = ae*grid%dl*grid%cose(j) + grid%rdxe(j) = D1_0 / grid%dxe(j) + grid%dtdxe(j) = dt / grid%dxe(j) + grid%dtxe5(j) = D0_5*grid%dtdxe(j) + grid%txe5(j) = D0_5/grid%dtdxe(j) + grid%cye(j) = D1_0 / (ae*grid%cose(j)*grid%dp) + grid%dyce(j) = ae*grid%dp/grid%cose(j) + end do + + ! C-grid + if (grid%ptop>1._r8) then + grid%zt_c = abs(umax*dt5) / (grid%dl*ae) + else + grid%zt_c = cos( D10_0 * pi / D180_0 ) + end if + + ! D-grid + if (grid%ptop>1._r8) then + grid%zt_d = abs(umax*dt) / (grid%dl*ae) + else + grid%zt_d = cos( D10_0 * pi / D180_0 ) + end if + + if ( ptopin /= grid%ptop) then + write(iulog,*) 'PTOP as input to cd_core != ptop from T_FVDYCORE_GRID' + call endrun('PTOP as input to cd_core != ptop from T_FVDYCORE_GRID') + end if + + ! damping code + + if (div24del2flag == 2) then + + ! cam3.5 default damping setting + ldiv2 = .true. + ldiv4 = .false. + ldel2 = .false. + if (masterproc) write(iulog,*) 'Divergence damping: use 2nd order damping' + + elseif (div24del2flag == 4) then + + ! fourth order divergence damping and no velocity diffusion + ldiv2 = .false. + ldiv4 = .true. + ldel2 = .false. + if (masterproc) write(iulog,*) 'Divergence damping: use 4th order damping' + + elseif (div24del2flag == 42) then + + ! fourth order divergence damping with velocity diffusion + ldiv2 = .false. + ldiv4 = .true. + ldel2 = .true. + if (masterproc) write(iulog,*) 'Divergence damping: use 4th order damping' + if (masterproc) write(iulog,*) 'Velocity del2 damping with coefficient ', del2coef + + else + + ldiv2 = .true. + ldiv4 = .false. + ldel2 = .false. + if (masterproc) write(iulog,*) 'Inadmissable velocity smoothing option - div24del2flag = ', div24del2flag + call endrun('Inadmissable value of div24del2flag') + end if + + do k = kfirst, klast + + if (ldel2) then + + !*********************************** + ! + ! Laplacian on velocity components + ! + !*********************************** + + press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & + (grid%bk(k)+grid%bk(k+1))*D1E5 ) + tau = D8_0 * (D1_0+ tanh(D1_0*log(grid%ptop/press)) ) + + ! tau is strength of damping + if (tau < 0.3_r8) then + + ! no del2 damping at lower levels + tau = 0.0_r8 + end if + + do j = js2g0, jn1g1 + + ! fac must include dt for the momentum equation + ! i.e. diffusion coefficient is fac/dt + ! + ! del2 diffusion coefficient in spectral core is 2.5e5 + fac = tau * dt * del2coef + + ! all these coefficients are necessary because of the staggering of the + ! wind components + grid%cdxde(j,k) = fac/(ae*ae*grid%cose(j)*grid%cose(j)*grid%dl*grid%dl) + grid%cdyde(j,k) = fac/(ae*ae*grid%cose(j)*grid%dp*grid%dp) + end do + + do j = js2g0, jn2g1 + fac = tau * dt * del2coef + grid%cdxdp(j,k) = fac/(ae*ae*grid%cosp(j)*grid%cosp(j)*grid%dl*grid%dl) + grid%cdydp(j,k) = fac/(ae*ae*grid%cosp(j)*grid%dp*grid%dp) + end do + end if + + if (ldiv2) then + + !*********************************************** + ! + ! cam3 default second-order divergence damping + ! + !*********************************************** + press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & + (grid%bk(k)+grid%bk(k+1))*D1E5 ) + tau = D8_0 * (D1_0+ tanh(D1_0*log(grid%ptop/press)) ) + tau = max(D1_0, tau) / (D128_0*abs(dt)) + + do j = js2g0, jn1g1 + + !----------------------------------------- + ! Explanation of divergence damping coeff. + ! ======================================== + ! + ! Divergence damping is added to the momentum + ! equations through a term tau*div where + ! + ! tau = C*L**2/dt + ! + ! where L is the length scale given by + ! + ! L**2 = a**2*dl*dp + ! + ! and divergence is given by + ! + ! div = divx + divy + ! + ! where + ! + ! divx = (1/(a*cos(p)))*du/dl + ! divy = (1/(a*cos(p)))*(d(cos(theta)*v)/dp)) + ! + ! du and (d(cos(theta*v)/dp)) are computed in sw_core + ! + ! The constant terms in divx*tau and divy*tau are + ! + ! cdx = (1/(a*cos(p)))* (1/dl) * C * a**2 * dl * dp / dt = C * (a*dp/(cos(p)))/dt + ! cdy = (1/(a*cos(p)))* (1/dp) * C * a**2 * dl * dp / dt = C * (a*dl/(cos(p)))/dt + ! + !----------------------------------------- + fac = tau * ae / grid%cose(j) !default + grid%cdx(j,k) = fac*grid%dp !default + grid%cdy(j,k) = fac*grid%dl !default + end do + end if + + if (ldiv4) then + + ! 4th-order divergence damping + tau4 = 0.01_r8 / (abs(dt)) + + !************************************** + ! + ! fourth order divergence damping + ! + !************************************** + + do j = 1, jm + + ! divergence computation coefficients + grid%cdxdiv (j,k) = D1_0/(grid%cose(j)*grid%dl) + grid%cdydiv (j,k) = D1_0/(grid%cose(j)*grid%dp) + end do + + do j = js2g0, jn1g1 + + ! div4 coefficients + fac = grid%dl*grid%cose(j)!*ae + grid%cdx4 (j,k) = D1_0/(fac*fac) + fac = grid%dp*grid%dp*grid%cose(j)!*ae*ae + grid%cdy4 (j,k) = D1_0/fac + fac = grid%cose(j)*grid%dp*grid%dl + grid%cdtau4(j,k) = -ae*tau4*fac*fac + end do + end if + + end do ! do k = kfirst, klast + + end if ! if ( abs(grid%dt0-dt) > D0_1 ) + + if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core + call FVstartclock(grid,'---C_DELP_LOOP') +!$omp parallel do private(i, j, k, wk, wk2) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + delpf(i,j,k) = delp(i,j,k) + end do + end do + call pft2d( delpf(1,js2g0,k), grid%sc, & + grid%dc, im, jn2g0-js2g0+1, & + wk, wk2 ) + end do + call FVstopclock(grid,'---C_DELP_LOOP') + + end if + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_C_CORE_COMM') + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_s, u ) + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_s, ng_d, v ) + + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, pt ) + if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, delpf ) + endif ! end if ipe < 0 check + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, pt ) + if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, delpf ) + endif ! end if ipe < 0 check + call FVstopclock(grid,'---PRE_C_CORE_COMM') +#endif + + + ! Get the cell centered winds if needed for the sub-step + +#if ( defined OFFLINE_DYN ) + if ( ( (ipe < 0) .or. (everytime) ) .and. (.not. met_winds_on_walls()) ) then + call get_met_fields( grid, u_cen, v_cen ) + reset_winds = .true. + else + reset_winds = .false. + endif +#endif + + + ! Get D-grid V-wind at the poles and interpolate winds to A- and C-grids; + ! This calculation was formerly done in subroutine c_sw but is being done here to + ! avoid communication in OpenMP loops + +!$omp parallel do private(k, wk, wk2) + do k = kfirst, klast + call d2a2c_winds(grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & + ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), & + uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & + u_cen(1,jfirst-ng_d,k), v_cen(1,jfirst-ng_s,k), & + reset_winds, met_rlx(k), am_correction) + + ! Optionally filter advecting C-grid winds + if (filtcw .gt. 0) then + call pft2d(uc(1,js2g0,k), grid%sc, grid%dc, im, jn2g0-js2g0+1, wk, wk2 ) + call pft2d(vc(1,js2g0,k), grid%se, grid%de, im, jlast-js2g0+1, wk, wk2 ) + end if + + end do + +#if defined( SPMD ) + ! Fill C-grid advecting winds Halo regions + ! vc only needs to be ghosted at jlast+1 + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, uc ) + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, 2, 2, vc ) + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, uc ) + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, 2, 2, vc ) +#endif + + call FVstopclock(grid,'---PRE_C_CORE') + + call FVbarrierclock(grid,'sync_c_core', grid%commyz) + call FVstartclock(grid,'---C_CORE') + +!$omp parallel do private(i, j, k, iord, jord) + do k = kfirst, klast + + if ( k <= kmtp ) then + iord = iord_c_min + jord = jord_c_min + else + iord = iord_c + jord = jord_c + end if + + !----------------------------------------------------------------- + ! Call the vertical independent part of the dynamics on the C-grid + !----------------------------------------------------------------- + + call c_sw( grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & + pt(1,jfirst-ng_d,k), delp(1,jfirst,k), & + ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), & + uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & + ptc(1,jfirst,k), delpf(1,jfirst-ng_d,k), & + ptk(1,jfirst,k), tiny, iord, jord, am_correction) + end do + + call FVstopclock(grid,'---C_CORE') + +! MPI note: uc, vc, ptk, and ptc computed within the above k-look from jfirst to jlast +! Needed by D-core: uc(jfirst-ng_d:jlast+ng_d), vc(jfirst:jlast+1) + + call FVbarrierclock(grid,'sync_c_geop', grid%commyz) + + end if ! (iam .lt. npes_yz) + + + if (geopk_cdist) then + + if (iam .lt. npes_yz) then + + ! Stay in yz space and use z communications + + if (grid%geopk16byte) then + call FVstartclock(grid,'---C_GEOP16') + call geopk16(grid, pe, ptk, pkcc, wzc, hs, ptc, & + 0, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst) ) + else + call FVstartclock(grid,'---C_GEOP_D') + call geopk_d(grid, pe, ptk, pkcc, wzc, hs, ptc, & + 0, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst) ) + end if + + ! Geopk does not need j ghost zones of pkc and wz + + if (.not.high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkcc(i,j,k) + end do + end do + end do + endif + +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzc(i,j,k) + end do + end do + end do + + if (grid%geopk16byte) then + call FVstopclock(grid,'---C_GEOP16') + else + call FVstopclock(grid,'---C_GEOP_D') + end if + + end if ! (iam .lt. npes_yz) + + else + + ! Begin xy geopotential section + + call FVstartclock(grid,'---C_GEOP') + + if (grid%twod_decomp == 1) then + + ! Transpose to xy decomposition + +#if defined( SPMD ) + call FVstartclock(grid,'YZ_TO_XY_C_GEOP') + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & + modc=grid%modc_cdcore ) + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & + modc=grid%modc_cdcore ) + else + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & + ptc, ptxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & + ptc, ptxy, & + modc=grid%modc_cdcore ) + end if + call FVstopclock(grid,'YZ_TO_XY_C_GEOP') +#endif + + else + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + delpxy(i,j,k) = ptk(i,j,k) + ptxy(i,j,k) = ptc(i,j,k) + end do + end do + end do + + end if + + call geopk(grid, pexy, delpxy, pkxy, wzxy, hsxy, ptxy, & + cp3v, cap3v, nx) + + if (grid%twod_decomp == 1) then + + ! Transpose back to yz decomposition. + ! pexy is not output quantity on this call. + ! pkkp and wzkp are holding arrays, whose specific z-dimensions + ! are required by Pilgrim. + ! Z edge ghost points (klast+1) are automatically filled in + +#if defined( SPMD ) + + call FVstartclock(grid,'XY_TO_YZ_C_GEOP') + if (high_alt) then + call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pec, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pec, & + modc=grid%modc_dynrun ) + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + else + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + modc=grid%modc_cdcore ) + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + else + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + wzxy, wzkp, & + modc=grid%modc_cdcore ) + end if + endif + call FVstopclock(grid,'XY_TO_YZ_C_GEOP') + + if (high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = log(pec(i,k,j)) + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkkp(i,j,k) + end do + end do + end do + endif +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzkp(i,j,k) + end do + end do + end do + +#endif + + else + +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzxy(i,j,k) + end do + end do + end do + if (high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pec(i,k,j) = pexy(i,k,j) + pxc(i,j,k) = log(pec(i,k,j)) + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkxy(i,j,k) + end do + end do + end do + endif + + end if + + call FVstopclock(grid,'---C_GEOP') + + ! End xy geopotential section + end if ! geopk_cdist + + if (iam .lt. npes_yz) then + + call FVbarrierclock(grid,'sync_pre_d_core', grid%commyz) + call FVstartclock(grid,'---PRE_D_CORE') + + ! Upon exit from geopk, the quantities pe, pkc and wz will have been + ! updated at klast+1 + +#if defined( SPMD ) + + ! pkc & wz need to be ghosted only at jfirst-1 + + call FVstartclock(grid,'---PRE_D_CORE_COMM') + dest = iam+1 + src = iam-1 + if ( mod(iam+1,npr_y) == 0 ) dest = -1 + if ( mod(iam,npr_y) == 0 ) src = -1 + call mp_send3d_2( grid%commyz, dest, src, im, jm, km+1, & + 1, im, jfirst-1, jlast+1, kfirst, klast+1, & + 1, im, jlast, jlast, kfirst, klast+1, pxc, wz) + call FVstopclock(grid,'---PRE_D_CORE_COMM') +#endif + + call FVstartclock(grid,'---C_U_LOOP') + + +!$omp parallel do private(i, j, k, p1d, wk, wk2, wk1, wk3) + ! Beware k+1 references directly below (AAM) + do k = kfirst, klast + do j = js2g0, jn2g0 + + if (am_correction) then + + do i = 1, im + ! AM fix: ensure interior pressure torque vanishes + wk1(i,j) = pxc(i,j,k )*max(pxc(i,j,k), tiny)**(xakap - 1.0_r8) + wk3(i,j) = pxc(i,j,k+1)**xakap + p1d(i) = wk3(i,j) - wk1(i,j) + enddo + + uc(1,j,k) = uc(1,j,k) + grid%dtdx2(j) * ( & + (wz(im,j,k+1)-wz(1,j,k))*(wk3(1,j)-wk1(im,j)) & + + (wz(im,j,k)-wz(1,j,k+1))*(wk3(im,j)-wk1(1,j))) & + / (p1d(1)+p1d(im)) + do i = 2, im + uc(i,j,k) = uc(i,j,k) + grid%dtdx2(j) * ( & + (wz(i-1,j,k+1)-wz(i,j,k))*(wk3(i,j)-wk1(i-1,j)) & + + (wz(i-1,j,k)-wz(i,j,k+1))*(wk3(i-1,j)-wk1(i,j))) & + / (p1d(i)+p1d(i-1)) + end do + + else + + do i = 1, im + p1d(i) = pxc(i,j,k+1) - pxc(i,j,k) + enddo + + uc(1,j,k) = uc(1,j,k) + grid%dtdx2(j) * ( & + (wz(im,j,k+1)-wz(1,j,k))*(pxc(1,j,k+1)-pxc(im,j,k)) & + + (wz(im,j,k)-wz(1,j,k+1))*(pxc(im,j,k+1)-pxc(1,j,k))) & + / (p1d(1)+p1d(im)) + do i = 2, im + uc(i,j,k) = uc(i,j,k) + grid%dtdx2(j) * ( & + (wz(i-1,j,k+1)-wz(i,j,k))*(pxc(i,j,k+1)-pxc(i-1,j,k)) & + + (wz(i-1,j,k)-wz(i,j,k+1))*(pxc(i-1,j,k+1)-pxc(i,j,k))) & + / (p1d(i)+p1d(i-1)) + end do + + end if ! (am_correction) + + do i = 1, im + cx_om(i,j,k) = grid%dtdx(j)*uc(i,j,k) + end do + + end do + + call pft2d(uc(1,js2g0,k), grid%sc, & + grid%dc, im, jn2g0-js2g0+1, & + wk, wk2 ) + + if ( jfirst == 1 ) then ! Clean up + do i = 1, im + uc(i,1,k) = D0_0 + cx_om(i,1,k) = D0_0 + end do + end if + + if ( jlast == jm ) then ! Clean up + do i = 1, im + uc(i,jm,k) = D0_0 + cx_om(i,jm,k) = D0_0 + end do + end if + + end do + + call FVstopclock(grid,'---C_U_LOOP') + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_D_CORE_COMM') + ! pkc and wz need only to be ghosted jfirst-1 + call mp_recv3d_2( grid%commyz, src, im, jm, km+1, & + 1, im, jfirst-1, jlast+1, kfirst, klast+1, & + 1, im, jfirst-1, jfirst-1, kfirst, klast+1, pxc, wz) + + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, uc ) + call FVstopclock(grid,'---PRE_D_CORE_COMM') +#endif + + call FVstartclock(grid,'---C_V_PGRAD') + + if (am_correction) then +!$omp parallel do private(i, j, k) + ! AM correction (pressure, advective winds): pxc -> ptr + do k = kfirst, klast+1 + do j = js1g1, jlast + do i = 1, im + ptr(i,j,k) = pxc(i,j,k)*max(pxc(i,j,k), tiny)**(xakap - 1.0_r8) + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = js1g1, jlast + do i = 1, im + ptr(i,j,k) = pxc(i,j,k) + end do + end do + end do + end if + +!$omp parallel do private(i, j, k, wk, wk1 ) + ! Beware k+1 references directly below (AAM) + do k = kfirst, klast + do j = js1g1, jlast + do i = 1, im + wk1(i,j) = ptr(i,j,k+1) - ptr(i,j,k) + end do + end do + + do j = js2g0, jlast + do i = 1, im + vc(i,j,k) = vc(i,j,k) + grid%dtdy5/(wk1(i,j)+wk1(i,j-1)) * & + ( (wz(i,j-1,k+1)-wz(i,j,k))*(ptr(i,j,k+1)-ptr(i,j-1,k)) & + + (wz(i,j-1,k)-wz(i,j,k+1))*(ptr(i,j-1,k+1)-ptr(i,j,k)) ) + + cy_om(i,j,k) = grid%dtdy*vc(i,j,k) + end do + end do + + call pft2d(vc(1,js2g0,k), grid%se, & + grid%de, im, jlast-js2g0+1, wk, wk1 ) + end do + + call FVstopclock(grid,'---C_V_PGRAD') + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_D_CORE_COMM') + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, uc ) + + ! vc only needs to be ghosted at jlast+1 + dest = iam-1 + src = iam+1 + if ( mod(iam,npr_y) == 0 ) dest = -1 + if ( mod(iam+1,npr_y) == 0 ) src = -1 + call mp_send3d( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst-2, jlast+2, kfirst, klast, & + 1, im, jfirst, jfirst, kfirst, klast, vc ) + call mp_recv3d( grid%commyz, src, im, jm, km, & + 1, im, jfirst-2, jlast+2, kfirst, klast, & + 1, im, jlast+1, jlast+1, kfirst, klast, vc ) + call FVstopclock(grid,'---PRE_D_CORE_COMM') + + call mp_send3d( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jfirst, jfirst, kfirst, klast, cy_om ) + call mp_recv3d( grid%commyz, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jlast+1, jlast+1, kfirst, klast, cy_om ) +#endif + + call FVstopclock(grid,'---PRE_D_CORE') + + call FVbarrierclock(grid,'sync_d_core', grid%commyz) + call FVstartclock(grid,'---D_CORE') + +!$omp parallel do private(i, j, k, iord, jord) + do k = kfirst, klast + + if( k <= kmtp ) then + if( k == 1 ) then + iord = iord_d_min + jord = jord_d_min + else + iord = min(iord_d_low, iord_d) + jord = min(jord_d_low, jord_d) + end if + else + iord = iord_d + jord = jord_d + end if + + !----------------------------------------------------------------- + ! Call the vertical independent part of the dynamics on the D-grid + !----------------------------------------------------------------- + + if (am_correction .or. am_fixer) then + do j = jfirst, jlast + do i = 1, im + kelp(i,j,k) = delp(i,j,k) ! un-updated delp on A grid + end do + end do + end if + + ! don't apply correction if order is not 4 + sw_am_corr = am_correction .and. iord.eq.iord_d .and. jord.eq.jord_d + + call d_sw( grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & + uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & + pt(1,jfirst-ng_d,k), delp(1,jfirst,k), & + delpf(1,jfirst-ng_d,k), cx3(1,jfirst-ng_d,k), & + cy3(1,jfirst,k), mfx(1,jfirst,k), & + mfy(1,jfirst,k), & + grid%cdx (js2g0:,k),grid%cdy (js2g0:,k), & + grid%cdxde (js2g0:,k),grid%cdxdp (js2g0:,k), & + grid%cdyde(js2g0:,k) ,grid%cdydp(js2g0:,k), & + grid%cdxdiv(:,k),grid%cdydiv(:,k) , & + grid%cdx4 (js2g0:,k),grid%cdy4(js2g0:,k) , & + grid%cdtau4(js2g0:,k), ldiv2, ldiv4, ldel2, & + iord, jord, tiny, sw_am_corr, & + ddpa(1,jfirst,k), ddu(1,jfirst,k), & + vf(1,jfirst-2 ,k) ) + + if (am_correction .or. am_fixer) then + do j = jfirst, jlast + do i = 1, im + help(i,j,k) = delp(i,j,k) ! updated delp on A grid + end do + end do + end if + + end do + + call FVstopclock(grid,'---D_CORE') + + ! AM correction and fixer (main block) + if (am_correction .or. am_fixer) then + + call FVbarrierclock(grid,'sync_dp4corr_1', grid%commyz) + call FVstartclock(grid,'---dp4corr_COMM_1') + +#if defined( SPMD ) + ! only (jfirst-1) halo point required (iam,jlast) -> (iam+1,jfirst-1) + dest = iam+1 + src = iam-1 + if ( mod(iam, npr_y) == 0 ) src = -1 + if ( mod(iam+1,npr_y) == 0 ) dest = -1 + call mp_send3d( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst-1, jlast, kfirst, klast, & + 1, im, jlast , jlast, kfirst, klast, help ) + call mp_recv3d( grid%commyz, src, im, jm, km, & + 1, im, jfirst-1, jlast , kfirst, klast, & + 1, im, jfirst-1, jfirst-1, kfirst, klast, help ) + call mp_send3d( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst-1, jlast, kfirst, klast, & + 1, im, jlast , jlast, kfirst, klast, kelp ) + call mp_recv3d( grid%commyz, src, im, jm, km, & + 1, im, jfirst-1, jlast , kfirst, klast, & + 1, im, jfirst-1, jfirst-1, kfirst, klast, kelp ) + + if (am_correction) then + call mp_send3d( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst-1, jlast, kfirst, klast, & + 1, im, jlast , jlast, kfirst, klast, ddpa ) + call mp_recv3d( grid%commyz, src, im, jm, km, & + 1, im, jfirst-1, jlast , kfirst, klast, & + 1, im, jfirst-1, jfirst-1, kfirst, klast, ddpa ) + end if +#endif + call FVstopclock(grid,'---dp4corr_COMM_1') + + call FVbarrierclock(grid,'sync_dp4corr_2', grid%commyz) + call FVstartclock(grid,'---dp4corr_COMM_2') + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js2g0, jlast + do i = 1, im + dpn(i,j,k)=(help(i,j,k)*cosp(j)+help(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D + dpo(i,j,k)=(kelp(i,j,k)*cosp(j)+kelp(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D + end do + end do + end do + + if (am_correction) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js2g0, jlast + do i = 1, im + ddpu(i,j,k)=(ddpa(i,j,k)*cosp(j)+ddpa(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D + end do + end do + end do + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js2g0, jlast + do i = 1, im + ddu(i,j,k)=ddu(i,j,k)* D0_5*(dpo(i,j,k)+dpn(i,j,k)*3._r8)*D0_5 + end do + end do + end do + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js2g0, jlast + ddus(j,k) = ddu(1,j,k) + (u(1,j,k) + uc(1,j,k)/D4_0)*ddpu(1,j,k) - & + vf(1,j,k)*(dpn(1,j,k) - dpo(1,j,k))*D0_5 + dpns(j,k) = dpn(1,j,k) + do i = 2, im + ddus(j,k) = ddus(j,k) + ddu(i,j,k) +(u(i,j,k)+uc(i,j,k)/D4_0)*ddpu(i,j,k) - & + vf(i,j,k)*(dpn(i,j,k)-dpo(i,j,k))*D0_5 + dpns(j,k) = dpns(j,k) + dpn(i,j,k) + end do + ddus(j,k) = ddus(j,k)/dpns(j,k) + end do + end do + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js4g0, jn3g0 + do i = 1, im !+++++++++++++++++++++++++++++++++++++++++++++ + uc(i,j,k) = uc(i,j,k) + ddus(j,k) ! APPLY AM CORRECTION + enddo !+++++++++++++++++++++++++++++++++++++++++++++ + enddo + enddo + + end if ! (am_correction) + + if (am_fixer) then + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = js2g0, jlast + do i = 1, im + don(j,k) = don(j,k) + (cosp(j) + cosp(j-1))*cose(j) & + *(uc(i,j,k)*dpn(i,j,k) & + + (u(i,j,k) + cose(j)*oma)*(dpn(i,j,k) - dpo(i,j,k))) + dod(j,k) = dod(j,k) + (cosp(j) + cosp(j-1))*cose(j)**2*dpn(i,j,k) + end do + end do + + ! north pole + if (jfirst == 1) then + do i = 1, im + dod(1,k) = dod(1,k) + grid%acap/(D0_5*im)*cose(1)**2*help(i,1,k) + end do + end if + end do + + end if ! (am_fixer) + + call FVstopclock(grid,'---dp4corr_COMM_2') + + endif ! (am_correction .or. am_fixer) + + call FVbarrierclock(grid,'sync_d_geop', grid%commyz) + +#if defined( SPMD ) + if (s_trac) then + ! post sends for ct_overlap or tracer decomposition information + do ml = 1, mlt + call mpiisend(cx3, ncx, mpir8, iremote(ml), cxtag(ml), grid%commnyz, cxreqs(ml)) + call mpiisend(cy3, ncy, mpir8, iremote(ml), cytag(ml), grid%commnyz, cyreqs(ml)) + call mpiisend(mfx, nmfx, mpir8, iremote(ml), mfxtag(ml), grid%commnyz, mfxreqs(ml)) + call mpiisend(mfy, nmfy, mpir8, iremote(ml), mfytag(ml), grid%commnyz, mfyreqs(ml)) + end do + end if +#endif + + end if ! (iam .lt. npes_yz) + + + if (geopk_ddist) then + + if (iam .lt. npes_yz) then + + ! Stay in yz space and use z communications + + if (grid%geopk16byte) then + call FVstartclock(grid,'---D_GEOP16') + call geopk16(grid, pe, delp, pkcc, wzc, hs, pt, & + ng_d, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst)) + else + call FVstartclock(grid,'---D_GEOP_D') + call geopk_d(grid, pe, delp, pkcc, wzc, hs, pt, & + ng_d, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst)) + end if + + ! Geopk does not need j ghost zones of pkc and wz + +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzc(i,j,k) + end do + end do + end do + if (.not.high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkcc(i,j,k) + end do + end do + end do + endif + + if (grid%geopk16byte) then + call FVstopclock(grid,'---D_GEOP16') + else + call FVstopclock(grid,'---D_GEOP_D') + endif + + end if ! (iam .lt. npes_yz) + + else + + ! Begin xy geopotential section + + call FVstartclock(grid,'---D_GEOP') + + if (grid%twod_decomp == 1) then + + ! Transpose to xy decomposition + +#if defined( SPMD ) + +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + ptc(i,j,k) = pt(i,j,k) + end do + end do + end do + + call FVstartclock(grid,'YZ_TO_XY_D_GEOP') + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & + modc=grid%modc_cdcore ) + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & + modc=grid%modc_cdcore ) + else + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & + ptc, ptxy, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & + ptc, ptxy, & + modc=grid%modc_cdcore ) + end if + call FVstopclock(grid,'YZ_TO_XY_D_GEOP') +#endif + + else + +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + delpxy(i,j,k) = delp(i,j,k) + ptxy(i,j,k) = pt(i,j,k) + end do + end do + end do + + end if + + call geopk(grid, pexy, delpxy, pkxy, wzxy, hsxy, ptxy, & + cp3v, cap3v, nx) + + if (grid%twod_decomp == 1) then + + ! Transpose back to yz decomposition + ! Z edge ghost points (klast+1) are automatically filled in + ! pexy is output quantity on last small timestep + +#if defined( SPMD ) + + call FVstartclock(grid,'XY_TO_YZ_D_GEOP') + if (high_alt) then + call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pec, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pec, & + modc=grid%modc_dynrun ) + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + else + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + modc=grid%modc_cdcore ) + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & + modc=grid%modc_cdcore ) + else + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + wzxy, wzkp, & + modc=grid%modc_cdcore ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & + wzxy, wzkp, & + modc=grid%modc_cdcore ) + end if + endif + call FVstopclock(grid,'XY_TO_YZ_D_GEOP') + + if (high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = log(pec(i,k,j)) + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkkp(i,j,k) + end do + end do + end do + endif +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzkp(i,j,k) + end do + end do + end do + +#endif + + else + +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + wz(i,j,k) = wzxy(i,j,k) + end do + end do + end do + if (high_alt) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pec(i,k,j) = pexy(i,k,j) + pxc(i,j,k) = log(pec(i,k,j)) + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pxc(i,j,k) = pkxy(i,j,k) + end do + end do + end do + endif + + end if + + call FVstopclock(grid,'---D_GEOP') + + ! End xy geopotential section + endif ! geopk_ddist + + if (iam .lt. npes_yz) then + + call FVbarrierclock(grid,'sync_pre_d_pgrad', grid%commyz) + + ! Upon exit from geopk, the quantities pe, pkc and wz will have been + ! updated at klast+1 + + call FVstartclock(grid,'---PRE_D_PGRAD') + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_D_PGRAD_COMM_1') + ! Exchange boundary regions on north and south for pkc and wz + call mp_send2_ns( grid%commyz, im, jm, km+1, jfirst, jlast, & + kfirst, klast+1, 1, pxc, wz) + call FVstopclock(grid,'---PRE_D_PGRAD_COMM_1') +#endif + + if ( ipe /= 1 ) then ! not the last call + + ! Perform some work while sending data on the way + call FVstartclock(grid,'---D_DELP_LOOP') + +!$omp parallel do private(i, j, k, wk, wk2) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + delpf(i,j,k) = delp(i,j,k) + end do + end do + call pft2d( delpf(1,js2g0,k), grid%sc, & + grid%dc, im, jn2g0-js2g0+1, & + wk, wk2 ) + end do + call FVstopclock(grid,'---D_DELP_LOOP') + + else ! Last call + +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = jfirst, jlast + do i = 1, im + pk(i,j,k) = pxc(i,j,k) + end do + end do + end do + end if + +#if defined( SPMD ) + call FVstartclock(grid,'---PRE_D_PGRAD_COMM_1') + call mp_recv2_ns( grid%commyz, im, jm, km+1, jfirst, jlast, & + kfirst, klast+1, 1, pxc, wz) + if ( ipe /= 1 ) then ! not the last call + call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, delpf ) + end if + call FVstopclock(grid,'---PRE_D_PGRAD_COMM_1') +#endif + + if (am_correction) then + ! AM correction (pressure, prognostic winds): pkc -> ptr +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = js1g1, jn1g1 ! dpt needed NS + do i = 1,im ! wz, pkc ghosted NS + ptr(i,j,k) = pxc(i,j,k)**xakap + end do + end do + end do + else +!$omp parallel do private(i, j, k) + do k = kfirst, klast+1 + do j = js1g1, jn1g1 + do i = 1,im + ptr(i,j,k) = pxc(i,j,k) + end do + end do + end do + endif + + if (am_correction) then +!$omp parallel do private(i, j, k) + ! Beware k+1 references directly below (AAM) + do k = kfirst, klast + do j = js1g1, jn1g1 + do i = 1, im ! wz, pkc ghosted NS + dpr(i,j,k) = (wz(i,j,k+1) + wz(i,j,k))*(ptr(i,j,k+1) - ptr(i,j,k)) + end do + end do + end do + end if + +!$omp parallel do private(i, j, k) + ! Beware k+1 references directly below (AAM) + do k = kfirst, klast + do j = js1g1, jn1g1 ! dpt needed NS + do i = 1, im ! wz, pkc ghosted NS + dpt(i,j,k) = (wz(i,j,k+1) + wz(i,j,k))*(pxc(i,j,k+1) - pxc(i,j,k)) + end do + end do + end do + + ! GHOSTING: wz (input) NS ; pkc (input) N + ! GHOSTING: dpt (loop 4000) NS ; pkc (loop 4500) N + + call FVstopclock(grid,'---PRE_D_PGRAD') + call FVstartclock(grid,'---D_PGRAD_1') + + if (high_alt) then + px4 = 4.0_r8*log(grid%ptop) + else + px4 = 4.0_r8*grid%ptop**cap3v(ifirstxy,jfirstxy,1) + endif + +!$omp parallel do private(i, j, k, wk3, wk1) + do k = kfirst, klast+1 + + if (k == 1) then + do j = js2g0, jlast + do i = 1, im + wz3(i,j,1) = D0_0 + wz(i,j,1) = D0_0 + end do + end do + do j = js2g0, jn1g1 + do i = 1, im + pxc(i,j,1) = px4 + ptr(i,j,1) = 4.0_r8*grid%ptop + end do + end do + cycle + end if + + if (am_correction) then + do j=js2g1,jn2g0 ! wk3 needed S + wk3(1,j) = (wz(1,j,k)+wz(im,j,k)) * & + (ptr(1,j,k) - ptr(im,j,k)) + do i=2,im + wk3(i,j) = (wz(i,j,k)+wz(i-1,j,k)) * & + (ptr(i,j,k) - ptr(i-1,j,k)) + + enddo + enddo + else + do j=js2g1,jn2g0 ! wk3 needed S + wk3(1,j) = (wz(1,j,k)+wz(im,j,k)) * & + (pxc(1,j,k) - pxc(im,j,k)) + do i=2,im + wk3(i,j) = (wz(i,j,k)+wz(i-1,j,k)) * & + (pxc(i,j,k) - pxc(i-1,j,k)) + + enddo + enddo + end if + + do j=js2g1,jn2g0 + do i=1,im-1 + wk1(i,j) = wk3(i,j) + wk3(i+1,j) + enddo + wk1(im,j) = wk3(im,j) + wk3(1,j) ! wk3 ghosted S + enddo + + if ( jfirst == 1 ) then + do i=1,im + wk1(i, 1) = D0_0 + enddo + endif + + if ( jlast == jm ) then + do i=1,im + wk1(i,jm) = D0_0 + enddo + endif + + do j=js2g0,jlast ! wk1 ghosted S + do i=1,im + wz3(i,j,k) = wk1(i,j) + wk1(i,j-1) + enddo + enddo + +! N-S walls + + do j=js2g0,jn1g1 ! wk1 needed N + if (am_correction) then + do i=1,im + wk1(i,j) = (wz(i,j,k) + wz(i,j-1,k))*(ptr(i,j,k) - ptr(i,j-1,k)) + enddo + else + do i=1,im ! wz, pkc ghosted NS + wk1(i,j) = (wz(i,j,k) + wz(i,j-1,k))*(pxc(i,j,k) - pxc(i,j-1,k)) + enddo + end if + enddo + + do j=js2g0,jn1g1 ! wk3 needed N + wk3(1,j) = wk1(1,j) + wk1(im,j) ! wk1 ghosted N + do i=2,im + wk3(i,j) = wk1(i,j) + wk1(i-1,j) ! wk1 ghosted N + enddo + enddo + + do j=js2g0,jn2g0 + do i=1,im + wz(i,j,k) = wk3(i,j) + wk3(i,j+1) ! wk3 ghosted N + enddo + enddo + + ! preserve this section to leave pkc inchanged in output of cd_core + do j=js1g1,jn1g1 + wk1(1,j) = pxc(1,j,k) + pxc(im,j,k) + do i=2,im + wk1(i,j) = pxc(i,j,k) + pxc(i-1,j,k) + enddo + enddo + + do j=js2g0,jn1g1 + do i=1,im + pxc(i,j,k) = wk1(i,j) + wk1(i,j-1) + enddo + enddo + + if (am_correction) then + + ! use true pressure for wk1, then update it + do j = js1g1, jn1g1 + wk1(1,j) = ptr(1,j,k) + ptr(im,j,k) + do i = 2, im + wk1(i,j) = ptr(i,j,k) + ptr(i-1,j,k) + end do + end do + + ! apply cos-weighted avg'ing + do j = js2g0, jn1g1 + do i = 1, im + ptr(i,j,k) = (wk1(i,j)*cosp(j) + wk1(i,j-1)*cosp(j-1))/(cosp(j) + cosp(j-1))/0.5_r8 + end do + end do + + end if + + end do ! k = kfirst, klast+1 + + call FVstopclock(grid,'---D_PGRAD_1') + call FVstartclock(grid,'---D_PGRAD_2') + +!$omp parallel do private(i, j, k, wk, wk1, wk2, wk3) + do k = kfirst, klast + + if (am_correction) then + do j = js1g1, jn1g1 + wk1(1,j) = dpr(1,j,k) + dpr(im,j,k) + do i = 2, im + wk1(i,j) = dpr(i,j,k) + dpr(i-1,j,k) + end do + end do + + do j = js2g0, jn1g1 + do i = 1, im + wk2(i,j) = wk1(i,j) + wk1(i,j-1) + wk(i,j) = ptr(i,j,k+1) - ptr(i,j,k) + end do + end do + else + do j = js1g1, jn1g1 + wk1(1,j) = dpt(1,j,k) + dpt(im,j,k) + do i = 2, im + wk1(i,j) = dpt(i,j,k) + dpt(i-1,j,k) + end do + end do + + do j = js2g0, jn1g1 + do i = 1, im + wk2(i,j) = wk1(i,j) + wk1(i,j-1) + wk(i,j) = pxc(i,j,k+1) - pxc(i,j,k) + end do + end do + end if + + ! Beware k+1 references directly below (AAM) + do j = js2g0, jlast + do i = 1, im-1 + wk3(i,j) = uc(i,j,k) + grid%dtdxe(j)/(wk(i,j) + wk(i+1,j)) & + * (wk2(i,j)-wk2(i+1,j)+wz3(i,j,k+1)-wz3(i,j,k)) + end do + wk3(im,j) = uc(im,j,k) + grid%dtdxe(j)/(wk(im,j) + wk(1,j)) & + * (wk2(im,j)-wk2(1,j)+wz3(im,j,k+1)-wz3(im,j,k)) + end do + + if (am_correction) then + ! apply cos-weighted avg'ing + do j = js2g0, jn2g0 ! Assumes wk2 ghosted on N + do i = 1, im + wk1(i,j) = vc(i,j,k) + grid%dtdy/(wk(i,j)*cose(j) + wk(i,j+1)*cose(j+1))*cosp(j) * & + (wk2(i,j) - wk2(i,j+1) + wz(i,j,k+1) - wz(i,j,k)) + end do + end do + else + do j = js2g0, jn2g0 ! Assumes wk2 ghosted on N + do i = 1, im + wk1(i,j) = vc(i,j,k) + grid%dtdy/(wk(i,j) + wk(i,j+1)) * & + (wk2(i,j) - wk2(i,j+1) + wz(i,j,k+1) - wz(i,j,k)) + enddo + enddo + endif + + call pft2d( wk3(1,js2g0), grid%se, & + grid%de, im, jlast-js2g0+1, & + wk, wk2 ) + call pft2d( wk1(1,js2g0), grid%sc, & + grid%dc, im, jn2g0-js2g0+1, & + wk, wk2 ) + + do j = js2g0, jn2g0 + do i = 1, im + v(i,j,k) = v(i,j,k) + wk1(i,j) + u(i,j,k) = u(i,j,k) + wk3(i,j) + end do + end do + + if ( jlast == jm ) then + do i = 1, im + u(i,jlast,k) = u(i,jlast,k) + wk3(i,jlast) + end do + end if + + end do ! k = kfirst, klast + call FVstopclock(grid,'---D_PGRAD_2') + +#if defined( SPMD ) + if ( ipe /= 1 ) then + call FVstartclock(grid,'---PRE_D_PGRAD_COMM_2') + call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, delpf ) + call FVstopclock(grid,'---PRE_D_PGRAD_COMM_2') + end if +#endif + + end if ! (iam .lt. npes_yz) + +end subroutine cd_core diff --git a/src/dynamics/fv/commap.F90 b/src/dynamics/fv/commap.F90 new file mode 100644 index 0000000000..4110ae244a --- /dev/null +++ b/src/dynamics/fv/commap.F90 @@ -0,0 +1,17 @@ +module commap + + use shr_kind_mod, only: r8=>shr_kind_r8 + use pmgrid, only: plon, splon, plat + + real(r8), target :: w(plat) ! integration weights for physics grid + real(r8), target :: w_staggered(plat-1) ! integration weights for the staggered wind arrays + + real(r8), target :: clat(plat) ! model latitudes (radians) + real(r8), target :: clat_staggered (plat-1) ! model latitudes on staggered grid (radians) + real(r8), target :: clon(plon,plat) ! model longitudes (radians) + real(r8), target :: latdeg(plat) ! model latitudes (degrees) + real(r8), target :: londeg(plon,plat) ! model longitudes (degrees) + real(r8), target :: latdeg_st(plat-1) ! model staggered latitudes (degrees) + real(r8), target :: londeg_st(splon,plat) ! model staggered longitudes (degrees) +end module commap + diff --git a/src/dynamics/fv/ctem.F90 b/src/dynamics/fv/ctem.F90 new file mode 100644 index 0000000000..4d39bb6105 --- /dev/null +++ b/src/dynamics/fv/ctem.F90 @@ -0,0 +1,606 @@ +!----------------------------------------------------------------------------- +! circulation diagnostics -- terms of the Transformed Eulerian Mean (TEM) equation +!----------------------------------------------------------------------------- +module ctem + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use pmgrid, only: plon, plev, plevp + use cam_logfile, only: iulog + use cam_history, only: addfld, outfld, add_default, horiz_only + use cam_abortutils, only: endrun + + implicit none + private + + public :: ctem_readnl + public :: ctem_init + public :: ctem_diags + public :: do_circulation_diags + + real(r8) :: rplon + real(r8) :: iref_p(plevp) ! interface reference pressure for vertical interpolation + integer :: ip_b ! level index where hybrid levels become purely pressure + integer :: zm_limit + + logical :: do_circulation_diags = .false. + +contains + +!================================================================================ + + subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid) + + use physconst, only : zvir, cappa + use dynamics_vars, only : T_FVDYCORE_GRID + use hycoef, only : ps0 + use interpolate_data, only : vertinterp +#ifdef SPMD + use mpishorthand, only : mpilog, mpiint + use parutilitiesmodule, only : pargatherint +#endif + +!------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------- + type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid + + real(r8), intent(in) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface pressure (pa) + real(r8), intent(in) :: u3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! zonal velocity (m/s) + real(r8), intent(in) :: v3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! meridional velocity (m/s) + real(r8), intent(in) :: omga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pressure velocity + real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interface pressure (pa) + real(r8), intent(in) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! virtual temperature + real(r8), intent(in) :: h2o(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! water constituent (kg/kg) + +!------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------- + real(r8), parameter :: hscale = 7000._r8 ! pressure scale height + real(r8), parameter :: navp = 1.e35_r8 + + real(r8) :: pinterp + real(r8) :: w(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! vertical velocity + real(r8) :: th(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pot. temperature + + real(r8) :: pm(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! mid-point pressure + + real(r8) :: pexf ! Exner function + real(r8) :: psurf + + real(r8) :: ui(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated zonal velocity + real(r8) :: vi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated meridional velocity + real(r8) :: wi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated vertical velocity + real(r8) :: thi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated pot. temperature + + real(r8) :: um(plevp) ! zonal mean zonal velocity + real(r8) :: vm(plevp) ! zonal mean meridional velocity + real(r8) :: wm(plevp) ! zonal mean vertical velocity + real(r8) :: thm(plevp) ! zonal mean pot. temperature + + real(r8) :: ud(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity + real(r8) :: vd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity + real(r8) :: wd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity + real(r8) :: thd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature + + real(r8) :: vthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity + real(r8) :: wthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity + real(r8) :: uvp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity + real(r8) :: uwp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature + + real(r8) :: rdiv(plevp) + + integer :: ip_gm1g(plon,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin + integer :: zm_cnt(plevp) ! counter + integer :: i,j,k + integer :: nlons + + logical :: has_zm(plevp,grid%jfirstxy:grid%jlastxy) ! .true. the (z,y) point is a valid zonal mean + integer :: ip_gm1(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin + + real(r8) :: vth(plevp,grid%jfirstxy:grid%jlastxy) ! VTH flux + real(r8) :: uv(plevp,grid%jfirstxy:grid%jlastxy) ! UV flux + real(r8) :: wth(plevp,grid%jfirstxy:grid%jlastxy) ! WTH flux + real(r8) :: uw(plevp,grid%jfirstxy:grid%jlastxy) ! UW flux + real(r8) :: u2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U + real(r8) :: v2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged V + real(r8) :: th2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged TH + real(r8) :: w2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged W + real(r8) :: thig(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interpolated pot. temperature + + real(r8) :: tmp2(grid%ifirstxy:grid%ilastxy) + real(r8) :: tmp3(grid%ifirstxy:grid%ilastxy,plevp) + + integer :: beglat, endlat ! begin,end latitude indicies + integer :: beglon, endlon ! begin,end longitude indicies + + beglon = grid%ifirstxy + endlon = grid%ilastxy + beglat = grid%jfirstxy + endlat = grid%jlastxy + +!omp parallel do private (i,j,k,pexf,psurf) +lat_loop1 : & + do j = beglat, endlat + do k = 1, plev + do i = beglon, endlon +!------------------------------------------------------------- +! Calculate pressure and Exner function +!------------------------------------------------------------- + pm(i,k,j) = 0.5_r8 * ( pe(i,k,j) + pe(i,k+1,j) ) + pexf = (ps0 / pm(i,k,j))**cappa +!------------------------------------------------------------- +! Convert virtual temperature to temperature and calculate potential temperature +!------------------------------------------------------------- + th(i,k,j) = pt(i,j,k) / (1._r8 + zvir*h2o(i,j,k)) + th(i,k,j) = th(i,k,j) * pexf +!------------------------------------------------------------- +! Calculate vertical velocity +!------------------------------------------------------------- + w(i,k,j) = - hscale * omga(i,k,j) / pm(i,k,j) + end do + end do +!------------------------------------------------------------- +! Keep track of where the bottom is in each column +! (i.e., largest index for which P(k) <= PS) +!------------------------------------------------------------- + ip_gm1(:,j) = plevp + do i = beglon, endlon + psurf = ps(i,j) + do k = ip_b+1, plevp + if( iref_p(k) <= psurf ) then + ip_gm1(i,j) = k + end if + end do + end do + end do lat_loop1 + + nlons = endlon - beglon + 1 + +#ifdef SPMD + if( grid%twod_decomp == 1 ) then + if (grid%iam .lt. grid%npes_xy) then + call pargatherint( grid%commxy_x, 0, ip_gm1, grid%strip2dx, ip_gm1g ) + endif + else + ip_gm1g(:,:) = ip_gm1(:,:) + end if +#else + ip_gm1g(:,:) = ip_gm1(:,:) +#endif +#ifdef CTEM_DIAGS + write(iulog,*) '====================================================' + do j = beglat,endlat + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,'(20i3)') ip_gm1(:,j) + end do + if( grid%myidxy_x == 0 ) then + do j = beglat,endlat + write(iulog,*) '====================================================' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,'(20i3)') ip_gm1g(:,j) + end do + write(iulog,*) '====================================================' +#else +#ifdef SPMD + if( grid%myidxy_x == 0 ) then +#endif +#endif +lat_loop2 : & + do j = beglat, endlat + zm_cnt(:ip_b) = plon + do k = ip_b+1, plevp + zm_cnt(k) = count( ip_gm1g(:,j) >= k ) + end do + has_zm(:ip_b,j) = .true. + do k = ip_b+1, plevp + has_zm(k,j) = zm_cnt(k) >= zm_limit + end do + end do lat_loop2 +#ifdef SPMD + end if + if( grid%twod_decomp == 1 ) then + call mpibcast( has_zm, plevp*(endlat-beglat+1), mpilog, 0, grid%commxy_x ) + call mpibcast( ip_gm1g, plon*(endlat-beglat+1), mpiint, 0, grid%commxy_x ) + end if +#endif + +#ifdef CTEM_DIAGS + if( grid%myidxy_y == 12 ) then + write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,beglat + write(iulog,*) 'has_zm' + write(iulog,'(20l2)') has_zm(:,beglat) + write(iulog,*) 'ip_gm1g' + write(iulog,'(20i4)') ip_gm1g(:,beglat) + write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' + end if +#endif + +lat_loop3 : & + do j = beglat, endlat +!------------------------------------------------------------- +! Vertical interpolation +!------------------------------------------------------------- + do k = 1, plevp + pinterp = iref_p(k) +!------------------------------------------------------------- +! Zonal velocity +!------------------------------------------------------------- + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + u3(beglon,1,j), ui(beglon,k) ) +!------------------------------------------------------------- +! Meridional velocity +!------------------------------------------------------------- + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + v3(beglon,1,j), vi(beglon,k) ) +!------------------------------------------------------------- +! Vertical velocity +!------------------------------------------------------------- + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + w(beglon,1,j), wi(beglon,k) ) +!------------------------------------------------------------- +! Pot. Temperature +!------------------------------------------------------------- + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + th(beglon,1,j), thi(beglon,k) ) + end do +#ifdef CTEM_DIAGS + if( j == endlat ) then + write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,*) 'iref_p' + write(iulog,'(5g15.7)') iref_p(:) + write(iulog,'(''pm(endlon,:,'',i2,'')'')') j + write(iulog,'(5g15.7)') pm(endlon,:,j) + write(iulog,'(''u3(endlon,:,'',i2,'')'')') j + write(iulog,'(5g15.7)') u3(endlon,:,j) + write(iulog,*) 'ui(endlon,:)' + write(iulog,'(5g15.7)') ui(endlon,:) + write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' + end if +#endif + +!------------------------------------------------------------- +! Calculate zonal averages +!------------------------------------------------------------- + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + where( ip_gm1(beglon:endlon,j) < k ) + ui(beglon:endlon,k) = 0._r8 + vi(beglon:endlon,k) = 0._r8 + wi(beglon:endlon,k) = 0._r8 + thi(beglon:endlon,k) = 0._r8 + endwhere + end if + end do + + call par_xsum( grid, ui, plevp, um ) + call par_xsum( grid, vi, plevp, vm ) + call par_xsum( grid, wi, plevp, wm ) + call par_xsum( grid, thi, plevp, thm ) +#ifdef CTEM_DIAGS + if( j == endlat .and. grid%myidxy_y == 12 ) then + write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,*) 'um after par_xsum' + write(iulog,'(5g15.7)') um(:) + write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' + end if +#endif + do k = 1, ip_b + um(k) = um(k) * rplon + vm(k) = vm(k) * rplon + wm(k) = wm(k) * rplon + thm(k) = thm(k) * rplon + u2d(k,j) = um(k) + v2d(k,j) = vm(k) + th2d(k,j) = thm(k) + w2d(k,j) = wm(k) + end do + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + rdiv(k) = 1._r8/count( ip_gm1g(:,j) >= k ) + um(k) = um(k) * rdiv(k) + vm(k) = vm(k) * rdiv(k) + wm(k) = wm(k) * rdiv(k) + thm(k) = thm(k) * rdiv(k) + u2d(k,j) = um(k) + v2d(k,j) = vm(k) + th2d(k,j) = thm(k) + w2d(k,j) = wm(k) + else + u2d(k,j) = navp + v2d(k,j) = navp + th2d(k,j) = navp + w2d(k,j) = navp + end if + end do + +!------------------------------------------------------------- +! Calculate zonal deviations +!------------------------------------------------------------- + do k = 1, ip_b + ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k) + vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k) + wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k) + thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k) + end do + + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + where( ip_gm1g(beglon:endlon,j) >= k ) + ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k) + vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k) + wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k) + thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k) + elsewhere + ud(beglon:endlon,k) = 0._r8 + vd(beglon:endlon,k) = 0._r8 + wd(beglon:endlon,k) = 0._r8 + thd(beglon:endlon,k) = 0._r8 + endwhere + end if + end do + +!------------------------------------------------------------- +! Calculate fluxes +!------------------------------------------------------------- + do k = 1, ip_b + vthp(:,k) = vd(:,k) * thd(:,k) + wthp(:,k) = wd(:,k) * thd(:,k) + uwp(:,k) = wd(:,k) * ud(:,k) + uvp(:,k) = vd(:,k) * ud(:,k) + end do + + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + vthp(:,k) = vd(:,k) * thd(:,k) + wthp(:,k) = wd(:,k) * thd(:,k) + uwp(:,k) = wd(:,k) * ud(:,k) + uvp(:,k) = vd(:,k) * ud(:,k) + else + vthp(:,k) = 0._r8 + wthp(:,k) = 0._r8 + uwp(:,k) = 0._r8 + uvp(:,k) = 0._r8 + end if + end do + +#ifdef CTEM_DIAGS + if( j == endlat .and. grid%myidxy_y == 12 ) then + write(iulog,*) '#################################################' + write(iulog,*) 'DIAGNOSTICS before par_xsum' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,*) 'has_zm' + write(iulog,*) has_zm(:,j) + write(iulog,*) 'rdiv' + write(iulog,'(5g15.7)') rdiv(:) + write(iulog,*) 'wm' + write(iulog,'(5g15.7)') wm(:) + write(iulog,*) 'um' + write(iulog,'(5g15.7)') um(:) + write(iulog,*) 'uw' + write(iulog,'(5g15.7)') uw(:) + write(iulog,*) '#################################################' + end if +#endif + call par_xsum( grid, vthp, plevp, vth(1,j) ) + call par_xsum( grid, wthp, plevp, wth(1,j) ) + call par_xsum( grid, uvp, plevp, uv(1,j) ) + call par_xsum( grid, uwp, plevp, uw(1,j) ) +#ifdef CTEM_DIAGS + if( j == endlat .and. grid%myidxy_y == 12 ) then + write(iulog,*) '#################################################' + write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j + write(iulog,*) 'uw after par_xsum' + write(iulog,'(5g15.7)') uw(:,j) + write(iulog,*) '#################################################' + end if +#endif + do k = 1, ip_b + vth(k,j) = vth(k,j) * rplon + wth(k,j) = wth(k,j) * rplon + uw(k,j) = uw(k,j) * rplon + uv(k,j) = uv(k,j) * rplon + end do + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + vth(k,j) = vth(k,j) * rdiv(k) + wth(k,j) = wth(k,j) * rdiv(k) + uw(k,j) = uw(k,j) * rdiv(k) + uv(k,j) = uv(k,j) * rdiv(k) + else + vth(k,j) = navp + wth(k,j) = navp + uw(k,j) = navp + uv(k,j) = navp + end if + end do + + thig(:,:,j) = thi(:,:) + end do lat_loop3 + +!------------------------------------------------------------- +! Do the output +!------------------------------------------------------------- + latloop: do j = beglat,endlat + +!------------------------------------------------------------- +! zonal-mean output +!------------------------------------------------------------- + do k = 1,plevp + tmp3(grid%ifirstxy,k) = vth(k,j) + enddo + call outfld( 'VTHzm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = wth(k,j) + enddo + call outfld( 'WTHzm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = uv(k,j) + enddo + call outfld( 'UVzm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = uw(k,j) + enddo + call outfld( 'UWzm', tmp3(grid%ifirstxy,:), 1, j ) + do k = 1,plevp + tmp3(grid%ifirstxy,k) = u2d(k,j) + enddo + call outfld( 'Uzm', tmp3(grid%ifirstxy,:), 1, j ) + do k = 1,plevp + tmp3(grid%ifirstxy,k) = v2d(k,j) + enddo + call outfld( 'Vzm', tmp3(grid%ifirstxy,:), 1, j ) + do k = 1,plevp + tmp3(grid%ifirstxy,k) = w2d(k,j) + enddo + call outfld( 'Wzm', tmp3(grid%ifirstxy,:), 1, j ) + do k = 1,plevp + tmp3(grid%ifirstxy,k) = th2d(k,j) + enddo + call outfld( 'THzm', tmp3(grid%ifirstxy,:), 1, j ) + +!------------------------------------------------------------- +! 3D output +!------------------------------------------------------------- + do k = 1,plevp + do i = beglon,endlon + tmp3(i,k) = thig(i,k,j) + enddo + enddo + call outfld( 'TH', tmp3, nlons, j ) + +!------------------------------------------------------------- +! horizontal output +!------------------------------------------------------------- + tmp2(beglon:endlon) = ip_gm1(beglon:endlon,j) + call outfld( 'MSKtem', tmp2, nlons, j ) + + enddo latloop + + end subroutine ctem_diags + +!================================================================================= + + subroutine ctem_init() + + use hycoef, only : hyai, hybi, ps0 + use phys_control, only : phys_getopts + +!------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------- + integer :: k + logical :: history_waccm + + if (.not.do_circulation_diags) return + + rplon = 1._r8/plon + zm_limit = plon/3 + +!------------------------------------------------------------- +! Calculate reference pressure +!------------------------------------------------------------- + do k = 1, plevp + iref_p(k) = (hyai(k) + hybi(k)) * ps0 + end do + if( masterproc ) then + write(iulog,*) 'ctem_inti: iref_p' + write(iulog,'(1p5g15.7)') iref_p(:) + end if + +!------------------------------------------------------------- +! Find level where hybrid levels become purely pressure +!------------------------------------------------------------- + ip_b = -1 + do k = 1,plev + if( hybi(k) == 0._r8 ) ip_b = k + end do + + call phys_getopts( history_waccm_out = history_waccm ) + +!------------------------------------------------------------- +! Initialize output buffer +!------------------------------------------------------------- + call addfld ('VTHzm',(/ 'ilev' /),'A','MK/S','Meridional Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' ) + call addfld ('WTHzm',(/ 'ilev' /),'A','MK/S','Vertical Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' ) + call addfld ('UVzm', (/ 'ilev' /),'A','M2/S2','Meridional Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' ) + call addfld ('UWzm', (/ 'ilev' /),'A','M2/S2','Vertical Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' ) + + call addfld ('Uzm', (/ 'ilev' /),'A','M/S','Zonal-Mean zonal wind - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('Vzm', (/ 'ilev' /),'A','M/S','Zonal-Mean meridional wind - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('Wzm', (/ 'ilev' /),'A','M/S','Zonal-Mean vertical wind - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('THzm', (/ 'ilev' /),'A', 'K','Zonal-Mean potential temp - defined on ilev', gridname='fv_centers_zonal' ) + + call addfld ('TH', (/ 'ilev' /),'A','K', 'Potential Temperature', gridname='fv_centers' ) + call addfld ('MSKtem',horiz_only, 'A','1', 'TEM mask', gridname='fv_centers' ) + +!------------------------------------------------------------- +! primary tapes: 3D fields +!------------------------------------------------------------- + call add_default ('VTHzm', 1, ' ') + call add_default ('WTHzm', 1, ' ') + call add_default ('UVzm' , 1, ' ') + call add_default ('UWzm' , 1, ' ') + call add_default ('TH' , 1, ' ') + call add_default ('MSKtem',1, ' ') + + if (history_waccm) then + call add_default ('MSKtem',7, ' ') + call add_default ('VTHzm', 7, ' ') + call add_default ('UVzm', 7, ' ') + call add_default ('UWzm', 7, ' ') + call add_default ('Uzm', 7, ' ') + call add_default ('Vzm', 7, ' ') + call add_default ('Wzm', 7, ' ') + call add_default ('THzm', 7, ' ') + end if + + if (masterproc) then + write(iulog,*) 'ctem_inti: do_circulation_diags = ',do_circulation_diags + endif + + end subroutine ctem_init + +!================================================================================ + +subroutine ctem_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'ctem_readnl' + + namelist /circ_diag_nl/ do_circulation_diags + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'circ_diag_nl', status=ierr) + if (ierr == 0) then + read(unitn, circ_diag_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(do_circulation_diags, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: do_circulation_diags") + +end subroutine ctem_readnl + +end module ctem diff --git a/src/dynamics/fv/d2a3dijk.F90 b/src/dynamics/fv/d2a3dijk.F90 new file mode 100644 index 0000000000..1dc0119017 --- /dev/null +++ b/src/dynamics/fv/d2a3dijk.F90 @@ -0,0 +1,267 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: d2a3ijk -- Generalized 2nd order D-to-A grid transform (3D) +! Output array is i,j,k +! +! !INTERFACE: + + subroutine d2a3dijk(grid, u, v, ua, va ) + +! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only : T_FVDYCORE_GRID + +#if defined( SPMD ) + use parutilitiesmodule, only : parcollective, sumop + use mod_comm, only: mp_send3d, mp_recv3d +#endif + + implicit none +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: u(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! U-Wind ghosted N1 + real(r8), intent(in) :: v(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! V-Wind + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: ua(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! U-Wind + real(r8), intent(inout) :: va(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! V-Wind + + +! !DESCRIPTION: +! +! This routine performs a second order +! interpolation of three-dimensional wind +! fields on a D grid to an A grid. ! +! +! !REVISION HISTORY: +! WS 00.12.22 : Creation from d2a3d +! AAM 01.06.13 : Generalized to 2D decomposition +! WS 02.04.25 : Newest mod_comm interfaces +! WS 05.07.06 : Simplified interface with grid +! WS 06.09.08 : Isolated magic numbers as F90 parameters +! +!EOP +!----------------------------------------------------------------------- +!BOC + + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + + integer :: imh, i, j, k, itot, jtot, ltot, lbegin, lend, ik + real(r8) :: un(grid%km), vn(grid%km), us(grid%km), vs(grid%km) + real(r8) :: veast(grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) :: unorth(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: uvaglob(grid%im,grid%km,4) + real(r8) :: uvaloc(grid%ifirstxy:grid%ilastxy,grid%km,4) + real(r8) :: uaglob(grid%im),vaglob(grid%im) + + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: myidxy_y, myidxy_x, nprxy_x, iam + + real(r8), pointer :: coslon(:), sinlon(:) + +#if defined( SPMD ) + integer :: dest, src, incount, outcount +#endif + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + myidxy_x = grid%myidxy_x + myidxy_y = grid%myidxy_y + nprxy_x = grid%nprxy_x + iam = grid%iam + + coslon => grid%coslon + sinlon => grid%sinlon + + itot = ilastxy-ifirstxy+1 + jtot = jlastxy-jfirstxy+1 + imh = im/2 + +#if defined( SPMD ) +! Set ua on A-grid + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ilastxy, jfirstxy, jfirstxy, 1, km, u ) + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, unorth ) + + if ( jlastxy .lt. jm ) then +!$omp parallel do private(i, k) + + do k=1,km + do i=ifirstxy,ilastxy + ua(i,jlastxy,k) = D0_5 * ( u(i,jlastxy,k) + unorth(i,k) ) + enddo + enddo + endif +#endif + +!$omp parallel do private(i,j,k) + + do k=1,km + do j=jfirstxy, jlastxy-1 + do i=ifirstxy,ilastxy + ua(i,j,k) = D0_5*(u(i,j,k) + u(i,j+1,k)) + enddo + enddo + enddo + +! Set va on A-grid + +!$omp parallel do private(j,k) + + do k = 1,km + do j=jfirstxy,jlastxy + veast(j,k) = v(ifirstxy,j,k) + enddo + enddo + +#if defined( SPMD ) + if (itot .ne. im) then + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ifirstxy, jfirstxy, jlastxy, 1, km, v ) + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km,& + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, veast ) + endif +#endif + +!$omp parallel do private(i,j,k) + + do k=1,km + do j=jfirstxy, jlastxy + do i=ifirstxy,ilastxy-1 + va(i,j,k) = D0_5*(v(i,j,k) + v(i+1,j,k)) + enddo + va(ilastxy,j,k) = D0_5*(v(ilastxy,j,k) + veast(j,k)) + enddo + enddo + +!$omp parallel do private(i,ik,k) + + do ik=1,4 + do k=1,km + do i=1,im + uvaglob(i,k,ik) = D0_0 + enddo + enddo + enddo + + lbegin = 0 + lend = 0 + if (jfirstxy .eq. 1) then +!$omp parallel do private(i,k) + do k = 1,km + do i=ifirstxy,ilastxy + uvaloc(i,k,1) = ua(i,2,k) + uvaloc(i,k,2) = va(i,2,k) + uvaglob(i,k,1) = ua(i,2,k) + uvaglob(i,k,2) = va(i,2,k) + enddo + enddo + lbegin = 1 + lend = 2 + endif + + if (jlastxy .eq. jm) then +!$omp parallel do private(i,k) + do k = 1,km + do i=ifirstxy,ilastxy + uvaloc(i,k,3) = ua(i,jm-1,k) + uvaloc(i,k,4) = va(i,jm-1,k) + uvaglob(i,k,3) = ua(i,jm-1,k) + uvaglob(i,k,4) = va(i,jm-1,k) + enddo + enddo + lbegin = 3 + lend = 4 + endif + if (jtot .eq. jm) lbegin=1 + +#if defined( SPMD ) + if (itot .ne. im) then + ltot = lend-lbegin+1 + if (jfirstxy .eq. 1 .or. jlastxy .eq. jm) then + call parcollective(grid%commxy_x, sumop, im, km, ltot, & + uvaglob(:,:,lbegin:lend)) + endif + endif +#endif + + if ( jfirstxy .eq. 1 ) then +! Projection at SP +!$omp parallel do private(i,k,uaglob,vaglob) + do k=1,km + us(k) = D0_0 + vs(k) = D0_0 + do i=1,imh + us(k) = us(k) + (uvaglob(i+imh,k,1)-uvaglob(i,k,1))*sinlon(i) & + + (uvaglob(i,k,2)-uvaglob(i+imh,k,2))*coslon(i) + vs(k) = vs(k) + (uvaglob(i+imh,k,1)-uvaglob(i,k,1))*coslon(i) & + + (uvaglob(i+imh,k,2)-uvaglob(i,k,2))*sinlon(i) + enddo + + us(k) = us(k)/im + vs(k) = vs(k)/im + do i=1,imh + uaglob(i) = -us(k)*sinlon(i) - vs(k)*coslon(i) + vaglob(i) = us(k)*coslon(i) - vs(k)*sinlon(i) + uaglob(i+imh) = -uaglob(i) + vaglob(i+imh) = -vaglob(i) + enddo + do i=ifirstxy,ilastxy + ua(i,1,k) = uaglob(i) + va(i,1,k) = vaglob(i) + enddo + enddo + endif + + if ( jlastxy .eq. jm ) then +! Projection at NP +!$omp parallel do private(i,k,uaglob,vaglob) + do k=1,km + un(k) = D0_0 + vn(k) = D0_0 + do i=1,imh + un(k) = un(k) + (uvaglob(i+imh,k,3)-uvaglob(i,k,3))*sinlon(i) & + + (uvaglob(i+imh,k,4)-uvaglob(i,k,4))*coslon(i) + vn(k) = vn(k) + (uvaglob(i,k,3)-uvaglob(i+imh,k,3))*coslon(i) & + + (uvaglob(i+imh,k,4)-uvaglob(i,k,4))*sinlon(i) + enddo + + un(k) = un(k)/im + vn(k) = vn(k)/im + do i=1,imh + uaglob(i) = -un(k)*sinlon(i) + vn(k)*coslon(i) + vaglob(i) = -un(k)*coslon(i) - vn(k)*sinlon(i) + uaglob(i+imh) = -uaglob(i) + vaglob(i+imh) = -vaglob(i) + enddo + do i=ifirstxy,ilastxy + ua(i,jm,k) = uaglob(i) + va(i,jm,k) = vaglob(i) + enddo + enddo + endif + + return +!EOC + end +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/d2a3dikj.F90 b/src/dynamics/fv/d2a3dikj.F90 new file mode 100644 index 0000000000..8df4637f14 --- /dev/null +++ b/src/dynamics/fv/d2a3dikj.F90 @@ -0,0 +1,357 @@ +module d2a3dikj_mod + +implicit none +save +private +public :: d2a3dikj + +contains + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: d2a3ikj -- Generalized 2nd order D-to-A grid transform (3D) +! Output array is i,k,j +! +! !INTERFACE: + + subroutine d2a3dikj(grid, am_correction, u, v, ua, va) + +! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only : t_fvdycore_grid + +#if defined( SPMD ) + use parutilitiesmodule, only : parcollective, sumop + use mod_comm, only: mp_send3d, mp_recv3d +#endif + + use shr_reprosum_mod, only : shr_reprosum_calc, & + shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, & + shr_reprosum_recompute + use cam_logfile, only : iulog + use perf_mod + + implicit none +! !INPUT PARAMETERS: + type (t_fvdycore_grid), intent(in) :: grid + logical, intent(in) :: am_correction + real(r8), intent(in) :: u(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! U-Wind + real(r8), intent(in) :: v(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! V-Wind + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: ua(grid%ifirstxy:grid%ilastxy,grid%km, & + grid%jfirstxy:grid%jlastxy) ! U-Wind + real(r8), intent(inout) :: va(grid%ifirstxy:grid%ilastxy,grid%km, & + grid%jfirstxy:grid%jlastxy) ! V-Wind + +! !DESCRIPTION: +! +! This routine performs a second order +! interpolation of three-dimensional wind +! fields on a D grid to an A grid. ! +! +! !REVISION HISTORY: +! WS 00.12.22 : Creation from d2a3d +! AAM 01.06.13 : Generalized to 2D decomposition +! WS 02.04.25 : New mod_comm interfaces +! WS 03.08.13 : Use unorth for ghosting U (aligned with d2a3dijk) +! WS 05.07.06 : Simplified interface with grid +! WS 06.09.08 : isolated magic numbers as F90 parameters +! PW 08.07.03 : introduced reprosum logic +! SS 12.10.29 : reprosum is now in csm_share +! +!EOP +!----------------------------------------------------------------------- +!BOC + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + + integer :: imh, i, j, k, m, itot, jtot, ltot, ik + real(r8) :: veast(grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) :: unorth(grid%ifirstxy:grid%ilastxy,grid%km) + + real(r8) :: uva(grid%ifirstxy:grid%ilastxy,grid%km,2) + real(r8) :: uvn(grid%km,2), uvs(grid%km,2) + real(r8) :: rel_diff(2,grid%km,2) + real(r8),allocatable :: uva_tmp(:) + + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, im, jm, km + integer :: myidxy_y, myidxy_x, nprxy_x, iam + + logical :: write_warning + + real(r8), pointer :: coslon(:),sinlon(:) ! Sine and cosine in longitude + +#if defined( SPMD ) + integer dest, src, incount, outcount +#endif + + ! for AM correction + real(r8), pointer :: cosp(:), cose(:) + + myidxy_y = grid%myidxy_y + myidxy_x = grid%myidxy_x + nprxy_x = grid%nprxy_x + iam = grid%iam + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + itot = ilastxy-ifirstxy+1 + jtot = jlastxy-jfirstxy+1 + imh = im/2 + + coslon => grid%coslon + sinlon => grid%sinlon + cosp => grid%cosp + cose => grid%cose + +#if defined( SPMD ) +! Set ua on A-grid + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ilastxy, jfirstxy, jfirstxy, 1, km, u ) + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, unorth ) + + if ( jlastxy .lt. jm ) then + + if (am_correction) then +!$omp parallel do private(i, k) + do k = 1, km + do i = ifirstxy, ilastxy + ua(i,k,jlastxy) = 0.5_r8*(u(i,jlastxy,k)*cose(jlastxy) + & + unorth(i,k)*cose(jlastxy+1))/cosp(jlastxy) + end do + end do + else +!$omp parallel do private(i, k) + do k = 1, km + do i = ifirstxy, ilastxy + ua(i,k,jlastxy) = 0.5_r8*(u(i,jlastxy,k) + unorth(i,k)) + end do + end do + end if + end if +#endif + + if (am_correction) then +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirstxy, jlastxy-1 + do i = ifirstxy, ilastxy + if (cosp(j) .ne. 0.0_r8) then + ua(i,k,j) = 0.5_r8*(u(i,j,k)*cose(j) + u(i,j+1,k)*cose(j+1))/cosp(j) ! preserve curl-free flow + else + ua(i,k,j) = (u(i,j,k)*cose(j)+u(i,j+1,k)*cose(j+1))/(cose(j)+cose(j+1)) + end if + end do + end do + end do + else +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirstxy, jlastxy-1 + do i = ifirstxy, ilastxy + ua(i,k,j) = 0.5_r8*(u(i,j,k) + u(i,j+1,k)) ! preserve solid-body flow + end do + end do + end do + end if + +! Set va on A-grid + +!$omp parallel do private(j,k) + + do k = 1,km + do j=jfirstxy,jlastxy + veast(j,k) = v(ifirstxy,j,k) + enddo + enddo + +#if defined( SPMD ) + if (itot .ne. im) then + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ifirstxy, jfirstxy, jlastxy, 1, km, v ) + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, veast ) + endif +#endif + +!$omp parallel do private(i,j,k) + + do k=1,km + do j=jfirstxy, jlastxy + do i=ifirstxy,ilastxy-1 + va(i,k,j) = D0_5*(v(i,j,k) + v(i+1,j,k)) + enddo + va(ilastxy,k,j) = D0_5*(v(ilastxy,j,k) + veast(j,k)) + enddo + enddo + + if (jfirstxy .eq. 1) then +! Was (something like) ... +! do i=1,imh +! us(k) = us(k) + (uvaglob(i+imh,k,1)-uvaglob(i,k,1))*sinlon(i) & +! + (uvaglob(i,k,2)-uvaglob(i+imh,k,2))*coslon(i) +! vs(k) = vs(k) + (uvaglob(i+imh,k,1)-uvaglob(i,k,1))*coslon(i) & +! + (uvaglob(i+imh,k,2)-uvaglob(i,k,2))*sinlon(i) +! enddo + +!$omp parallel do private(i,k) + do k = 1,km + do i=ifirstxy,min(imh,ilastxy) + uva(i,k,1) = -ua(i,k,2)*sinlon(i) + va(i,k,2)*coslon(i) + uva(i,k,2) = -ua(i,k,2)*coslon(i) - va(i,k,2)*sinlon(i) + enddo + do i=max(imh+1,ifirstxy),ilastxy + uva(i,k,1) = ua(i,k,2)*sinlon(i-imh) - va(i,k,2)*coslon(i-imh) + uva(i,k,2) = ua(i,k,2)*coslon(i-imh) + va(i,k,2)*sinlon(i-imh) + enddo + enddo + + call t_startf("d2a3dikj_reprosum") + call shr_reprosum_calc(uva, uvs, itot, itot, 2*km, gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) + call t_stopf("d2a3dikj_reprosum") + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('d2a3dikj/South Pole', 2*km, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call t_startf("d2a3dikj_sumfix") + allocate( uva_tmp(im) ) + do m = 1,2 + do k = 1,km + if (rel_diff(1,k,m) > shr_reprosum_reldiffmax) then + uva_tmp(:) = D0_0 + do i = ifirstxy,ilastxy + uva_tmp(i) = uva(i,k,m) + enddo +#if defined(SPMD) + call parcollective(grid%commxy_x,sumop,im,uva_tmp) +#endif + uvs(k,m) = D0_0 + do i = 1,im + uvs(k,m) = uvs(k,m) + uva_tmp(i) + enddo + endif + enddo + enddo + deallocate( uva_tmp ) + call t_stopf("d2a3dikj_sumfix") + endif + endif + +!$omp parallel do private(i,k) + do k = 1,km + uvs(k,1) = uvs(k,1)/im + uvs(k,2) = uvs(k,2)/im + do i=ifirstxy,min(imh,ilastxy) + ua(i,k,1) = -uvs(k,1)*sinlon(i) - uvs(k,2)*coslon(i) + va(i,k,1) = uvs(k,1)*coslon(i) - uvs(k,2)*sinlon(i) + enddo + do i=max(imh+1,ifirstxy),ilastxy + ua(i,k,1) = uvs(k,1)*sinlon(i-imh) + uvs(k,2)*coslon(i-imh) + va(i,k,1) = -uvs(k,1)*coslon(i-imh) + uvs(k,2)*sinlon(i-imh) + enddo + enddo + + endif + + if (jlastxy .eq. jm) then +! Was (something like) ... +! do i=1,imh +! un(k) = un(k) + (uaglob(i+imh,k,jm-1)-uaglob(i,k,jm-1))*sinlon(i) & +! + (vaglob(i+imh,k,jm-1)-vaglob(i,k,jm-1))*coslon(i) +! vn(k) = vn(k) + (uaglob(i,k,jm-1)-uaglob(i+imh,k,jm-1))*coslon(i) & +! + (vaglob(i+imh,k,jm-1)-vaglob(i,k,jm-1))*sinlon(i) +! enddo + +!$omp parallel do private(i,k) + do k = 1,km + do i=ifirstxy,min(imh,ilastxy) + uva(i,k,1) = -ua(i,k,jm-1)*sinlon(i) - va(i,k,jm-1)*coslon(i) + uva(i,k,2) = ua(i,k,jm-1)*coslon(i) - va(i,k,jm-1)*sinlon(i) + enddo + do i=max(imh+1,ifirstxy),ilastxy + uva(i,k,1) = ua(i,k,jm-1)*sinlon(i-imh) + va(i,k,jm-1)*coslon(i-imh) + uva(i,k,2) = -ua(i,k,jm-1)*coslon(i-imh) + va(i,k,jm-1)*sinlon(i-imh) + enddo + enddo + + call t_startf("d2a3dikj_reprosum") + call shr_reprosum_calc(uva, uvn, itot, itot, 2*km, gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) + call t_stopf("d2a3dikj_reprosum") + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('d2a3dikj/Nouth Pole', 2*km, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call t_startf("d2a3dikj_sumfix") + allocate( uva_tmp(im) ) + do m = 1,2 + do k = 1,km + if (rel_diff(1,k,m) > shr_reprosum_reldiffmax) then + uva_tmp(:) = D0_0 + do i = ifirstxy,ilastxy + uva_tmp(i) = uva(i,k,m) + enddo +#if defined(SPMD) + call parcollective(grid%commxy_x,sumop,im,uva_tmp) +#endif + uvn(k,m) = D0_0 + do i = 1,im + uvn(k,m) = uvn(k,m) + uva_tmp(i) + enddo + endif + enddo + enddo + deallocate( uva_tmp ) + call t_stopf("d2a3dikj_sumfix") + endif + endif + +!$omp parallel do private(i,k) + do k = 1,km + uvn(k,1) = uvn(k,1)/im + uvn(k,2) = uvn(k,2)/im + do i=ifirstxy,min(imh,ilastxy) + ua(i,k,jm) = -uvn(k,1)*sinlon(i) + uvn(k,2)*coslon(i) + va(i,k,jm) = -uvn(k,1)*coslon(i) - uvn(k,2)*sinlon(i) + enddo + do i=max(imh+1,ifirstxy),ilastxy + ua(i,k,jm) = uvn(k,1)*sinlon(i-imh) - uvn(k,2)*coslon(i-imh) + va(i,k,jm) = uvn(k,1)*coslon(i-imh) + uvn(k,2)*sinlon(i-imh) + enddo + enddo + + endif + + return +!EOC + end +!----------------------------------------------------------------------- +end module d2a3dikj_mod diff --git a/src/dynamics/fv/diag_dynvar_ic.F90 b/src/dynamics/fv/diag_dynvar_ic.F90 new file mode 100644 index 0000000000..d568932845 --- /dev/null +++ b/src/dynamics/fv/diag_dynvar_ic.F90 @@ -0,0 +1,110 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: diag_dynvar_ic --- record state variables to IC file +! +! !INTERFACE: + subroutine diag_dynvar_ic(grid, phis, ps, t3, u3s, v3s, tracer) + +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use cam_history , only: outfld, write_inithist + use constituents , only: cnst_name, pcnst + use dynamics_vars, only: T_FVDYCORE_GRID + + implicit none +! +!----------------------------------------------------------------------- +! +! !INPUT PARAMETERS: +! + type (T_FVDYCORE_GRID), intent(in) :: grid +! surface geopotential (grav*zs) + real(r8), intent(in) :: phis(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) +! Surface pressure (pa) + real(r8), intent(in) :: ps (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) +! Temperature (K) + real(r8), intent(in) :: t3 (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, grid%km ) +! u wind velocities, staggered grid + real(r8), intent(in) :: u3s (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, grid%km) +! v wind velocities, staggered grid + real(r8), intent(in) :: v3s (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, grid%km) +! Tracers + real(r8), intent(in) :: tracer (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, & + grid%km,grid%ntotq) + +! !HISTORY: +! 01.01.01 XXXXXX Delivery +! 05.07.12 Sawyer Simplified interface with grid argument, ProTeX +! 06.03.22 Sawyer Rewritten for XY decomposition +! 06.06.28 Sawyer T3 changed from IKJ to IJK indexing +! 06.07.01 Sawyer Transitioned tracers q3 to T_TRACERS +! +!EOP +!----------------------------------------------------------------------- +!BOC +!---------------------------Local workspace----------------------------- + integer :: i, j, k, m ! indices + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km, ntotq, idim + real(r8):: tmp(grid%ifirstxy:grid%ilastxy,grid%km) +! +!----------------------------------------------------------------------- +! + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + ntotq = grid%ntotq + idim = ilastxy - ifirstxy + 1 + + if( write_inithist() ) then + +!$OMP PARALLEL DO PRIVATE (I, J, K, M, TMP) + do j = jfirstxy, jlastxy + + call outfld ('PS&IC ', ps (:,j) , idim, j) + + do k = 1, km + do i = ifirstxy, ilastxy + tmp(i,k) = t3(i,j,k) + enddo + enddo + call outfld ('T&IC ', tmp , idim, j) + + do k = 1, km + do i = ifirstxy, ilastxy + tmp(i,k) = u3s(i,j,k) + enddo + enddo + call outfld ('US&IC ', tmp , idim, j) + + do k = 1, km + do i = ifirstxy, ilastxy + tmp(i,k) = v3s(i,j,k) + enddo + enddo + call outfld ('VS&IC ', tmp , idim, j) + + do m = 1, pcnst + do k = 1, km + do i = ifirstxy, ilastxy + tmp(i,k) = tracer(i,j,k,m) + enddo + enddo + call outfld(trim(cnst_name(m))//'&IC' , tmp , idim, j) + end do + + enddo + + end if + + return +!EOC + end subroutine diag_dynvar_ic diff --git a/src/dynamics/fv/diag_module.F90 b/src/dynamics/fv/diag_module.F90 new file mode 100644 index 0000000000..89d99445f5 --- /dev/null +++ b/src/dynamics/fv/diag_module.F90 @@ -0,0 +1,582 @@ +module diag_module + +! diagnostic calcs +! +! REVISION HISTORY: +! 05.09.10 Rasch Creation of compute_vdot_gradp +! 05.10.18 Sawyer Revisions for 2D decomp, placed in module +! 07.01.29 Chen Removed pft2d calculation for OMGA (is in cd_core) + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use pmgrid, only: plon, plev, plevp +use cam_logfile, only: iulog +use cam_history, only: addfld, outfld, add_default, horiz_only +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + fv_diag_init, & + fv_diag_am_calc, & + compute_vdot_gradp + +real(r8) :: rplon +real(r8) :: iref_p(plevp) ! interface reference pressure for vertical interpolation +integer :: ip_b ! level index where hybrid levels become purely pressure +integer :: zm_limit + +!======================================================================================== +CONTAINS +!======================================================================================== + +subroutine fv_diag_init() + + use hycoef, only : hyai, hybi, ps0 + + ! local variables + integer :: k + logical :: history_waccm + !--------------------------------------------------------------------------- + + rplon = 1._r8/plon + zm_limit = plon/3 + + !------------------------------------------------------------- + ! Calculate reference pressure + !------------------------------------------------------------- + do k = 1, plevp + iref_p(k) = (hyai(k) + hybi(k)) * ps0 + end do + if( masterproc ) then + write(iulog,*) 'fv_diag_inti: iref_p' + write(iulog,'(1p5g15.7)') iref_p(:) + end if + + !------------------------------------------------------------- + ! Find level where hybrid levels become purely pressure + !------------------------------------------------------------- + ip_b = -1 + do k = 1,plev + if( hybi(k) == 0._r8 ) ip_b = k + end do + + ! Fields for diagnosing angular momentum conservation. They are supplemental + ! to the fields computed by do_circulation_diags + + call addfld ('dUzm' ,(/ 'ilev' /),'A','M/S','Zonal-Mean U dyn increm - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('dVzm' ,(/ 'ilev' /),'A','M/S','Zonal-Mean V dyn increm - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('dUazm',(/ 'ilev' /),'A','M/S','Zonal-Mean U adv increm - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('dVazm',(/ 'ilev' /),'A','M/S','Zonal-Mean V adv increm - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('dUfzm',(/ 'ilev' /),'A','M/S','Zonal-Mean U fixer incr - defined on ilev', gridname='fv_centers_zonal' ) + call addfld ('dU', (/ 'lev' /), 'A','K', 'U dyn increm', gridname='fv_centers' ) + call addfld ('dV', (/ 'lev' /), 'A','K', 'V dyn increm', gridname='fv_centers' ) + call addfld ('dUa', (/ 'lev' /), 'A','K', 'U adv increm', gridname='fv_centers' ) + call addfld ('dVa', (/ 'lev' /), 'A','K', 'V adv increm', gridname='fv_centers' ) + call addfld ('dUf', (/ 'lev' /), 'A','K', 'U fixer incr', gridname='fv_centers' ) + + call add_default ('dUzm' ,1, ' ') + call add_default ('dVzm' ,1, ' ') + call add_default ('dUazm' ,1, ' ') + call add_default ('dVazm' ,1, ' ') + call add_default ('dUfzm' ,1, ' ') + call add_default ('dU' , 1, ' ') + call add_default ('dV' , 1, ' ') + call add_default ('dUa', 1, ' ') + call add_default ('dVa', 1, ' ') + call add_default ('dUf', 1, ' ') + +end subroutine fv_diag_init + +!======================================================================================== + +subroutine fv_diag_am_calc(grid, ps, pe, du3, dv3, dua3, dva3, duf3) + + ! Compute fields for diagnosing angular momentum conservation. They are supplemental + ! to the fields computed by do_circulation_diags + + use dynamics_vars, only : T_FVDYCORE_GRID + use interpolate_data, only : vertinterp +#ifdef SPMD + use mpishorthand, only : mpilog, mpiint + use parutilitiesmodule, only : pargatherint +#endif + +!------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------- + type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid + real(r8), intent(in) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface pressure (pa) + real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interface pressure (pa) + real(r8), intent(in) :: du3 (grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! U increment, total (m/s/timestep) + real(r8), intent(in) :: dv3 (grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! V increment, total (m/s/timestep) + real(r8), intent(in) :: dua3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! U increment, advec (m/s/timestep) + real(r8), intent(in) :: dva3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! V increment, advec (m/s/timestep) + real(r8), intent(in) :: duf3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! U increment, fixer (m/s/timestep) + +!------------------------------------------------------------- +! ... local variables +!------------------------------------------------------------- + + real(r8) :: pinterp + real(r8) :: pm(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! mid-point pressure + real(r8) :: psurf + + real(r8) :: dui (grid%ifirstxy:grid%ilastxy,plevp) ! interp. zonal mean U increment, total FV + real(r8) :: dvi (grid%ifirstxy:grid%ilastxy,plevp) ! interp. zonal mean V increment, total FV + real(r8) :: duai(grid%ifirstxy:grid%ilastxy,plevp) ! interp. zonal mean U increment, advection + real(r8) :: dvai(grid%ifirstxy:grid%ilastxy,plevp) ! interp. zonal mean V increment, advection + real(r8) :: dufi(grid%ifirstxy:grid%ilastxy,plevp) ! interp. zonal mean U increment, fixer + + real(r8) :: dum (plevp) ! zonal mean U increment, total FV + real(r8) :: dvm (plevp) ! zonal mean V increment, total FV + real(r8) :: duam(plevp) ! zonal mean U increment, advection + real(r8) :: dvam(plevp) ! zonal mean V increment, advection + real(r8) :: dufm(plevp) ! zonal mean U increment, fixer + + real(r8) :: rdiv(plevp) + + integer :: ip_gm1g(plon,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin + integer :: zm_cnt(plevp) ! counter + integer :: i,j,k + integer :: nlons + + logical :: has_zm(plevp,grid%jfirstxy:grid%jlastxy) ! .true. the (z,y) point is a valid zonal mean + integer :: ip_gm1(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin + + real(r8) :: du2d (plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U dycore increment + real(r8) :: dv2d (plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged V dycore increment + real(r8) :: dua2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U advect increment + real(r8) :: dva2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged V advect increment + real(r8) :: duf2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U fixer increment + + real(r8) :: tmp2(grid%ifirstxy:grid%ilastxy) + real(r8) :: tmp3(grid%ifirstxy:grid%ilastxy,plevp) + real(r8) :: tmph(grid%ifirstxy:grid%ilastxy,plev) + + integer :: beglat, endlat ! begin,end latitude indicies + integer :: beglon, endlon ! begin,end longitude indicies + + beglon = grid%ifirstxy + endlon = grid%ilastxy + beglat = grid%jfirstxy + endlat = grid%jlastxy + +!omp parallel do private (i,j,k,psurf) +lat_loop1 : & + do j = beglat, endlat + do k = 1, plev + do i = beglon, endlon + pm(i,k,j) = 0.5_r8 * ( pe(i,k,j) + pe(i,k+1,j) ) + end do + end do +!------------------------------------------------------------- +! Keep track of where the bottom is in each column +! (i.e., largest index for which P(k) <= PS) +!------------------------------------------------------------- + ip_gm1(:,j) = plevp + do i = beglon, endlon + psurf = ps(i,j) + do k = ip_b+1, plevp + if( iref_p(k) <= psurf ) then + ip_gm1(i,j) = k + end if + end do + end do + end do lat_loop1 + + nlons = endlon - beglon + 1 + +#ifdef SPMD + if( grid%twod_decomp == 1 ) then + if (grid%iam .lt. grid%npes_xy) then + call pargatherint( grid%commxy_x, 0, ip_gm1, grid%strip2dx, ip_gm1g ) + endif + else + ip_gm1g(:,:) = ip_gm1(:,:) + end if +#else + ip_gm1g(:,:) = ip_gm1(:,:) +#endif +#ifdef SPMD + if( grid%myidxy_x == 0 ) then +#endif +lat_loop2 : & + do j = beglat, endlat + zm_cnt(:ip_b) = plon + do k = ip_b+1, plevp + zm_cnt(k) = count( ip_gm1g(:,j) >= k ) + end do + has_zm(:ip_b,j) = .true. + do k = ip_b+1, plevp + has_zm(k,j) = zm_cnt(k) >= zm_limit + end do + end do lat_loop2 +#ifdef SPMD + end if + if( grid%twod_decomp == 1 ) then + call mpibcast( has_zm, plevp*(endlat-beglat+1), mpilog, 0, grid%commxy_x ) + call mpibcast( ip_gm1g, plon*(endlat-beglat+1), mpiint, 0, grid%commxy_x ) + end if +#endif + +lat_loop3 : & + do j = beglat, endlat +!------------------------------------------------------------- +! Vertical interpolation +!------------------------------------------------------------- + do k = 1, plevp + pinterp = iref_p(k) +!------------------------------------------------------------- +! Zonal & meridional velocity increments +!------------------------------------------------------------- + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + du3(beglon,1,j) , dui (beglon,k) ) + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + dv3(beglon,1,j) , dvi (beglon,k) ) + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + dua3(beglon,1,j), duai(beglon,k) ) + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + dva3(beglon,1,j), dvai(beglon,k) ) + call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & + duf3(beglon,1,j), dufi(beglon,k) ) + end do + +!------------------------------------------------------------- +! Calculate zonal averages +!------------------------------------------------------------- + do k = ip_b+1, plevp + where( ip_gm1(beglon:endlon,j) < k ) + dui (beglon:endlon,k)= 0._r8 + dvi (beglon:endlon,k)= 0._r8 + duai(beglon:endlon,k)= 0._r8 + dvai(beglon:endlon,k)= 0._r8 + dufi(beglon:endlon,k)= 0._r8 + endwhere + end do + + call par_xsum(grid, dui, plevp, dum) + call par_xsum(grid, dvi, plevp, dvm) + call par_xsum(grid, duai, plevp, duam) + call par_xsum(grid, dvai, plevp, dvam) + call par_xsum(grid, dufi, plevp, dufm) + + do k = 1, ip_b + du2d(k,j) = dum(k) * rplon + dv2d(k,j) = dvm(k) * rplon + dua2d(k,j)= duam(k)* rplon + dva2d(k,j)= dvam(k)* rplon + duf2d(k,j)= dufm(k)* rplon + end do + + do k = ip_b+1, plevp + if( has_zm(k,j) ) then + rdiv(k) = 1._r8/count( ip_gm1g(:,j) >= k ) + du2d(k,j) = dum(k) * rdiv(k) + dv2d(k,j) = dvm(k) * rdiv(k) + dua2d(k,j)= duam(k)* rdiv(k) + dva2d(k,j)= dvam(k)* rdiv(k) + duf2d(k,j)= dufm(k)* rdiv(k) + else + du2d(k,j) = 0._r8 + dv2d(k,j) = 0._r8 + dua2d(k,j)= 0._r8 + dva2d(k,j)= 0._r8 + duf2d(k,j)= 0._r8 + end if + end do + + end do lat_loop3 + +!------------------------------------------------------------- +! Do the output +!------------------------------------------------------------- + latloop: do j = beglat,endlat + +!------------------------------------------------------------- +! zonal-mean output +!------------------------------------------------------------- + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = du2d(k,j) + enddo + call outfld( 'dUzm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = dv2d(k,j) + enddo + call outfld( 'dVzm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = dua2d(k,j) + enddo + call outfld( 'dUazm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = dva2d(k,j) + enddo + call outfld( 'dVazm', tmp3(grid%ifirstxy,:), 1, j ) + + do k = 1,plevp + tmp3(grid%ifirstxy,k) = duf2d(k,j) + enddo + call outfld( 'dUfzm', tmp3(grid%ifirstxy,:), 1, j ) + +!------------------------------------------------------------- +! 3D output +!------------------------------------------------------------- + + do k = 1,plev + do i = beglon,endlon + tmph(i,k) = du3(i,k,j) + enddo + enddo + call outfld( 'dU', tmph, nlons, j ) + + do k = 1,plev + do i = beglon,endlon + tmph(i,k) = dv3(i,k,j) + enddo + enddo + call outfld( 'dV', tmph, nlons, j ) + + do k = 1,plev + do i = beglon,endlon + tmph(i,k) = dua3(i,k,j) + enddo + enddo + call outfld( 'dUa', tmph, nlons, j ) + + do k = 1,plev + do i = beglon,endlon + tmph(i,k) = dva3(i,k,j) + enddo + enddo + call outfld( 'dVa', tmph, nlons, j ) + + do k = 1,plev + do i = beglon,endlon + tmph(i,k) = duf3(i,k,j) + enddo + enddo + call outfld( 'dUf', tmph, nlons, j ) + + enddo latloop + +end subroutine fv_diag_am_calc + +!======================================================================================== + + subroutine compute_vdot_gradp(grid, dt, frac, cx, cy, pexy, omgaxy ) + + use shr_kind_mod, only : r8 => shr_kind_r8 + use dynamics_vars, only : T_FVDYCORE_GRID +#if defined( SPMD ) + use mod_comm, only: mp_send3d, mp_recv3d, & + mp_sendirr, mp_recvirr +#endif + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in):: dt + real(r8), intent(in):: frac + + real(r8), intent(in):: cx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8), intent(in):: cy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) + real(r8), target, intent(in):: & + pexy(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! P (pascal) at layer edges + real(r8), target, intent(inout):: & + omgaxy(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy) ! vert. press. velocity (pa/sec) + +! Local + integer :: im ! dimension in east-west + integer :: jm ! dimension in North-South + integer :: km ! number of Lagrangian layers + integer :: jfirst ! starting latitude index for MPI + integer :: jlast ! ending latitude index for MPI + integer :: kfirst ! starting level index for MPI + integer :: klast ! ending level index for MPI + integer :: js2g0 ! j==1 not included + integer :: jn2g0 ! j==jm not included + + real(r8) :: pm(grid%im, grid%jfirst-1:grid%jlast+1) + real(r8) :: grad(grid%im, grid%jfirst:grid%jlast+1) + real(r8) :: fac, sum1 + + real(r8), pointer :: pe(:,:,:) ! YZ version of edge pressures + real(r8), pointer :: omga(:,:,:) ! YZ version of vert. vel. + + real(r8), parameter :: half = 0.5_r8 + real(r8), parameter :: zero = 0.0_r8 + + integer :: i,j,k + +#if defined( SPMD ) + integer :: iam, dest, src, npr_y, npes_yz + real(r8) :: penorth(grid%im, grid%kfirst:grid%klast+1) + real(r8) :: pesouth(grid%im, grid%kfirst:grid%klast+1) +#endif + + im = grid%im + jm = grid%jm + km = grid%km + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + js2g0 = grid%js2g0 + jn2g0 = grid%jn2g0 + + fac = half / (dt * frac) + +#if defined( SPMD ) + if ( grid%twod_decomp == 1 ) then + allocate(pe(im,kfirst:klast+1,jfirst:jlast)) + allocate(omga(im,kfirst:klast,jfirst:jlast)) + call mp_sendirr( grid%commxy, grid%ikj_xy_to_yz%SendDesc, & + grid%ikj_xy_to_yz%RecvDesc, omgaxy, omga, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ikj_xy_to_yz%SendDesc, & + grid%ikj_xy_to_yz%RecvDesc, omgaxy, omga, & + modc=grid%modc_dynrun ) + call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) + else + pe => pexy + omga => omgaxy + endif + iam = grid%iam + npes_yz = grid%npes_yz + if (iam .lt. npes_yz) then + npr_y = grid%npr_y + dest = iam+1 + src = iam-1 + if ( mod(iam+1,npr_y) == 0 ) dest = -1 + if ( mod(iam,npr_y) == 0 ) src = -1 + +! +! Have to give more thought to the source and destination for 2D +! + call mp_send3d(grid%commyz, dest, src, im, km+1, jm, & + 1, im, kfirst, klast+1, jfirst, jlast, & + 1, im, kfirst, klast+1, jlast, jlast, pe) + call mp_recv3d(grid%commyz, src, im, km+1, jm, & + 1, im, kfirst, klast+1, jfirst-1, jfirst-1, & + 1, im, kfirst, klast+1, jfirst-1, jfirst-1, pesouth) + call mp_send3d(grid%commyz, src, dest, im, km+1, jm, & + 1, im, kfirst, klast+1, jfirst, jlast, & + 1, im, kfirst, klast+1, jfirst, jfirst, pe) + call mp_recv3d(grid%commyz, dest, im, km+1, jm, & + 1, im, kfirst, klast+1, jlast+1, jlast+1, & + 1, im, kfirst, klast+1, jlast+1, jlast+1, penorth) + end if ! (iam .lt. npes_yz) +#else + pe => pexy + omga => omgaxy +#endif + +!$omp parallel do private(i,j,k,pm,grad, sum1) + do k=kfirst,klast + +! Compute layer mean p + do j=jfirst,jlast + do i=1,im + pm(i,j) = half * ( pe(i,k,j) + pe(i,k+1,j) ) + enddo + enddo + +#if defined( SPMD ) + if ( jfirst/=1 ) then + do i=1,im + pm(i,jfirst-1) = half * ( pesouth(i,k) + pesouth(i,k+1)) + enddo + endif + + if ( jlast/=jm ) then + do i=1,im + pm(i,jlast+1) = half * ( penorth(i,k) + penorth(i,k+1)) + enddo + endif +#endif + + do j=js2g0,jn2g0 + i=1 + grad(i,j) = fac * cx(i,j,k) * (pm(i,j)-pm(im,j)) + do i=2,im + grad(i,j) = fac * cx(i,j,k) * (pm(i,j)-pm(i-1,j)) + enddo + enddo + + do j=js2g0,jn2g0 + do i=1,im-1 + omga(i,k,j) = omga(i,k,j) + grad(i,j) + grad(i+1,j) + enddo + i=im + omga(i,k,j) = omga(i,k,j) + grad(i,j) + grad(1,j) + enddo + + do j=js2g0,min(jm,jlast+1) + do i=1,im + grad(i,j) = fac * cy(i,j,k) * (pm(i,j)-pm(i,j-1)) + enddo + enddo + + do j=js2g0,jn2g0 + do i=1,im + omga(i,k,j) = omga(i,k,j) + grad(i,j) + grad(i,j+1) + enddo + enddo + +! Note: Since V*grad(P) at poles are harder to compute accurately we use the average of sourding points +! to be used as input to physics. + + if ( jfirst==1 ) then + sum1 = zero + do i=1,im + sum1 = sum1 + omga(i,k,2) + enddo + sum1 = sum1 / real(im,r8) + do i=1,im + omga(i,k,1) = sum1 + enddo + endif + + if ( jlast==jm ) then + sum1 = zero + do i=1,im + sum1 = sum1 + omga(i,k,jm-1) + enddo + sum1 = sum1 / real(im,r8) + do i=1,im + omga(i,k,jm) = sum1 + enddo + endif + enddo + +#if defined( SPMD) + if ( grid%twod_decomp == 1 ) then +! +! Transpose back to XY (if 1D, the changes to omgaxy were made in place) +! + call mp_sendirr( grid%commxy, grid%ikj_yz_to_xy%SendDesc, & + grid%ikj_yz_to_xy%RecvDesc, omga, omgaxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ikj_yz_to_xy%SendDesc, & + grid%ikj_yz_to_xy%RecvDesc, omga, omgaxy, & + modc=grid%modc_dynrun ) + deallocate( pe ) + deallocate( omga ) + endif +#endif + + end subroutine compute_vdot_gradp + +end module diag_module diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 new file mode 100644 index 0000000000..4ff175d672 --- /dev/null +++ b/src/dynamics/fv/dp_coupling.F90 @@ -0,0 +1,978 @@ +module dp_coupling +!BOP +! +! !MODULE: dp_coupling --- dynamics-physics coupling module +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use phys_grid + + use physics_types, only: physics_state, physics_tend + use constituents, only: pcnst + use physconst, only: gravit, zvir, cpairv, rairv + use geopotential, only: geopotential_t + use check_energy, only: check_energy_timestep_init + use dynamics_vars, only: T_FVDYCORE_GRID, t_fvdycore_state + use dyn_internal_state,only: get_dyn_state + use dyn_comp, only: dyn_import_t, dyn_export_t, fv_print_dpcoup_warn + use cam_abortutils, only: endrun +#if defined ( SPMD ) + use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs +#endif + use perf_mod + use cam_logfile, only: iulog + +!-------------------------------------------- +! Variables needed for WACCM-X +!-------------------------------------------- + use constituents, only: cnst_get_ind !Needed to access constituent indices +! +! !PUBLIC MEMBER FUNCTIONS: + PUBLIC d_p_coupling, p_d_coupling + +! +! !DESCRIPTION: +! +! This module provides +! +! \begin{tabular}{|l|l|} \hline \hline +! d\_p\_coupling & dynamics output to physics input \\ \hline +! p\_d\_coupling & physics output to dynamics input \\ \hline +! \hline +! \end{tabular} +! +! !REVISION HISTORY: +! 00.06.01 Boville Creation +! 01.10.01 Lin Various revisions +! 01.03.26 Sawyer Added ProTeX documentation +! 01.06.27 Mirin Separate noncoupling coding into new routines +! 01.07.13 Mirin Some support for multi-2D decompositions +! 02.03.01 Worley Support for nontrivial physics remapping +! 03.03.28 Boville set all physics_state elements, add check_energy_timestep_init +! 03.08.13 Sawyer Removed ghost N1 region in u3sxy +! 05.06.28 Sawyer Simplified interfaces -- only XY decomposition +! 05.10.25 Sawyer Extensive refactoring, dyn_interface +! 05.11.10 Sawyer Now using dyn_import/export_t containers +! 06.07.01 Sawyer Transitioned constituents to T_TRACERS +! +!EOP +!----------------------------------------------------------------------- + + private + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + +CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: d_p_coupling --- convert dynamics output to physics input +! +! !INTERFACE: + subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) + +! !USES: + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, & + pbuf_get_field + use constituents, only: qmin + use physics_types, only: set_state_pdry, set_wet_to_dry + + use pmgrid, only: plev + use ctem, only: ctem_diags, do_circulation_diags + use diag_module, only: fv_diag_am_calc + use gravity_waves_sources, only: gws_src_fnct + use physconst, only: physconst_update + use shr_const_mod, only: shr_const_rwv + use dyn_comp, only: frontgf_idx, frontga_idx, uzm_idx + use qbo, only: qbo_use_forcing + use phys_control, only: use_gw_front, use_gw_front_igw, waccmx_is + use zonal_mean, only: zonal_mean_3D + use d2a3dikj_mod, only: d2a3dikj + use qneg_module, only: qneg3 + +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! !INPUT PARAMETERS: +! + type(t_fvdycore_grid), intent(in) :: grid + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(dyn_export_t), intent(in) :: dyn_out ! dynamics export + +! !OUTPUT PARAMETERS: + + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + + +! !DESCRIPTION: +! +! Coupler for converting dynamics output variables into physics +! input variables +! +! !REVISION HISTORY: +! 00.06.01 Boville Creation +! 01.07.13 AAM Some support for multi-2D decompositions +! 02.03.01 Worley Support for nontrivial physics remapping +! 02.05.02 Sawyer u3s made inout due to ghosting in d2a3dikj +! 03.08.05 Sawyer Removed pe11k, pe11kln (for defunct Rayl fric) +! 04.08.29 Eaton Added lat, lon coords to physics_state type +! 05.06.28 Sawyer Simplified interface -- on XY decomp vars. +! 05.07.06 Sawyer Added dyn_state as argument +! 05.10.31 Sawyer Refactoring, replaced dyn_state by dyn_interface +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + + type(t_fvdycore_state), pointer :: dyn_state + +! Variables from dynamics export container + real(r8), pointer :: phisxy(:,:) ! surface geopotential + real(r8), pointer :: psxy (:,:) ! surface pressure + real(r8), pointer :: u3sxy(:,:,:) ! u-wind on d-grid + real(r8), pointer :: v3sxy(:,:,:) ! v-wind on d-grid + real(r8), pointer :: du3sxy(:,:,:) ! u-wind increment on d-grid + real(r8), pointer :: dv3sxy(:,:,:) ! v-wind increment on d-grid + real(r8), pointer :: dua3sxy(:,:,:) ! u-wind adv. inc. on d-grid + real(r8), pointer :: dva3sxy(:,:,:) ! v-wind adv. inc. on d-grid + real(r8), pointer :: duf3sxy(:,:,:) ! u-wind fixer inc.on d-grid + real(r8), pointer :: ptxy (:,:,:) ! Virtual pot temp + real(r8), pointer :: tracer(:,:,:,:) ! constituents + real(r8), pointer :: omgaxy(:,:,:) ! vertical velocity + real(r8), pointer :: pexy (:,:,:) ! edge pressure + real(r8), pointer :: pelnxy(:,:,:) ! log(pe) + real(r8), pointer :: pkxy (:,:,:) ! pe**cappa + real(r8), pointer :: pkzxy (:,:,:) ! f-v mean of pk + + integer :: i,ib,j,k,m,lchnk ! indices + integer :: ncol ! number of columns in current chunk + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: blksiz ! number of columns in 2D block + integer :: tsize ! amount of data per grid point passed to physics + integer, allocatable, dimension(:,:) :: bpter + ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + + real(r8) :: qmavl ! available q at level pver-1 + real(r8) :: dqreq ! q change at pver-1 required to remove q get_dyn_state() + + if (use_gw_front .or. use_gw_front_igw) then + + allocate(frontgf(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'd_p_coupling: failed to allocate frontgf; error = ',astat + call endrun + end if + + allocate(frontga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'd_p_coupling: failed to allocate frontga; error = ',astat + call endrun + end if + + end if + + nullify(pbuf_chnk) + nullify(pbuf_frontgf) + nullify(pbuf_frontga) + nullify(pbuf_uzm) + + fraction = 0.1_r8 + + phisxy => dyn_out%phis + psxy => dyn_out%ps + u3sxy => dyn_out%u3s + v3sxy => dyn_out%v3s + ptxy => dyn_out%pt + tracer => dyn_out%tracer + + omgaxy => dyn_out%omga + pexy => dyn_out%pe + pelnxy => dyn_out%peln + pkxy => dyn_out%pk + pkzxy => dyn_out%pkz + + km = grid%km + kmp1 = km + 1 + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + iam = grid%iam +!----------------------------------------------------------------------- +! Transform dynamics staggered winds to physics grid (D=>A) +!----------------------------------------------------------------------- + + call t_startf ('d2a3dikj') + allocate (u3(ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (v3(ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + + if (iam .lt. grid%npes_xy) then + call d2a3dikj(grid, dyn_state%am_correction, u3sxy, v3sxy, u3, v3) + end if ! (iam .lt. grid%npes_xy) + + call t_stopf ('d2a3dikj') + + if ( do_circulation_diags ) then + call t_startf('DP_CPLN_ctem') + call ctem_diags( u3, v3, omgaxy, ptxy(:,jfirstxy:jlastxy,:), tracer(:,jfirstxy:jlastxy,:,1), & + psxy, pexy, grid) + call t_stopf('DP_CPLN_ctem') + endif + + if (dyn_state%am_diag) then + du3sxy => dyn_out%du3s + dv3sxy => dyn_out%dv3s + dua3sxy => dyn_out%dua3s + dva3sxy => dyn_out%dva3s + duf3sxy => dyn_out%duf3s + allocate (du3 (ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (dv3 (ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (dua3(ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (dva3(ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (duf3(ifirstxy:ilastxy, km, jfirstxy:jlastxy)) + allocate (dummy(ifirstxy:ilastxy,jfirstxy:jlastxy, km)) + du3(:,:,:) = 0._r8 + dv3(:,:,:) = 0._r8 + dua3(:,:,:) = 0._r8 + dva3(:,:,:) = 0._r8 + duf3(:,:,:) = 0._r8 + dummy(:,:,:) = 0._r8 + + if (iam .lt. grid%npes_xy) then + ! (note dummy use of dva3 hence call order matters) + call d2a3dikj(grid, dyn_state%am_correction,duf3sxy, dummy, duf3 ,dva3) + call d2a3dikj(grid, dyn_state%am_correction,dua3sxy, dva3sxy, dua3, dva3) + call d2a3dikj(grid, dyn_state%am_correction, du3sxy, dv3sxy, du3 , dv3 ) + end if ! (iam .lt. grid%npes_xy) + + call t_startf('DP_CPLN_fv_am') + call fv_diag_am_calc(grid, psxy, pexy, du3, dv3, dua3, dva3, duf3) + call t_stopf('DP_CPLN_fv_am') + endif + + if (use_gw_front .or. use_gw_front_igw) then + call t_startf('DP_CPLN_gw_sources') + call gws_src_fnct(grid, u3, v3, ptxy, tracer(:,jfirstxy:jlastxy,:,1), pexy, frontgf, frontga) + call t_stopf('DP_CPLN_gw_sources') + end if + if (qbo_use_forcing) then + call zonal_mean_3D(grid, plev, u3, uzm) + end if + +!----------------------------------------------------------------------- +! Copy data from dynamics data structure to physics data structure +!----------------------------------------------------------------------- +has_local_map : & + if (local_dp_map) then + +! This declaration is too long; this parallel section needs some stuff +! pulled out into routines. +!$omp parallel do private (lchnk, ncol, i, k, m, ic, jc, lons, lats, pic, pbuf_chnk, pbuf_uzm, pbuf_frontgf, pbuf_frontga) +chnk_loop1 : & + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + end if + + if (qbo_use_forcing) then + call pbuf_get_field(pbuf_chnk, uzm_idx, pbuf_uzm) + end if + + do i=1,ncol + ic = lons(i) + jc = lats(i) + phys_state(lchnk)%ps(i) = psxy(ic,jc) + phys_state(lchnk)%phis(i) = phisxy(ic,jc) + pic(i) = pkxy(ic,jc,pver+1) + enddo + do k=1,km + do i=1,ncol + ic = lons(i) + jc = lats(i) + phys_state(lchnk)%u (i,k) = u3(ic,k,jc) + phys_state(lchnk)%v (i,k) = v3(ic,k,jc) + phys_state(lchnk)%omega(i,k) = omgaxy(ic,k,jc) + phys_state(lchnk)%t (i,k) = ptxy(ic,jc,k) / (D1_0 + zvir*tracer(ic,jc,k,1)) + phys_state(lchnk)%exner(i,k) = pic(i) / pkzxy(ic,jc,k) + + if (use_gw_front .or. use_gw_front_igw) then + pbuf_frontgf(i,k) = frontgf(ic,k,jc) + pbuf_frontga(i,k) = frontga(ic,k,jc) + endif + + if (qbo_use_forcing) then + pbuf_uzm(i,k) = uzm(k,jc) + end if + + end do + end do + + do k=1,kmp1 + do i=1,ncol +! +! edge-level pressure arrays: copy from the arrays computed by dynpkg +! + ic = lons(i) + jc = lats(i) + phys_state(lchnk)%pint (i,k) = pexy (ic,k,jc) + phys_state(lchnk)%lnpint(i,k) = pelnxy(ic,k,jc) + end do + end do + +! +! Copy constituents +! Dry types converted from moist to dry m.r. at bottom of this routine +! + do m=1,pcnst + do k=1,km + do i=1,ncol + phys_state(lchnk)%q(i,k,m) = & + tracer(lons(i),lats(i),k,m) + end do + end do + end do + + end do chnk_loop1 + + else has_local_map + + boff = 6 + if (use_gw_front .or. use_gw_front_igw) boff = boff+2 + if (qbo_use_forcing) boff = boff+1 + + tsize = boff + 1 + pcnst + + blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) + allocate( bpter(blksiz,0:km),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'd_p_coupling: failed to allocate bpter; error = ',astat + call endrun + end if + allocate( bbuffer(tsize*block_buf_nrecs),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'd_p_coupling: failed to allocate bbuffer; error = ',astat + call endrun + end if + allocate( cbuffer(tsize*chunk_buf_nrecs),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'd_p_coupling: failed to allocate cbuffer; error = ',astat + call endrun + end if + + if (iam .lt. grid%npes_xy) then + call block_to_chunk_send_pters(iam+1,blksiz,kmp1,tsize,bpter) + endif + +!$omp parallel do private (j, i, ib, k, m) + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) + + bbuffer(bpter(ib,0)+4:bpter(ib,0)+boff+pcnst) = 0.0_r8 + + bbuffer(bpter(ib,0)) = pexy(i,kmp1,j) + bbuffer(bpter(ib,0)+1) = pelnxy(i,kmp1,j) + bbuffer(bpter(ib,0)+2) = psxy(i,j) + bbuffer(bpter(ib,0)+3) = phisxy(i,j) + + do k=1,km + + bbuffer(bpter(ib,k)) = pexy(i,k,j) + bbuffer(bpter(ib,k)+1) = pelnxy(i,k,j) + bbuffer(bpter(ib,k)+2) = u3 (i,k,j) + bbuffer(bpter(ib,k)+3) = v3 (i,k,j) + bbuffer(bpter(ib,k)+4) = omgaxy(i,k,j) + bbuffer(bpter(ib,k)+5) = ptxy(i,j,k) / (D1_0 + zvir*tracer(i,j,k,1)) + bbuffer(bpter(ib,k)+6) = pkxy(i,j,pver+1) / pkzxy(i,j,k) + + if (use_gw_front .or. use_gw_front_igw) then + bbuffer(bpter(ib,k)+7) = frontgf(i,k,j) + bbuffer(bpter(ib,k)+8) = frontga(i,k,j) + end if + + if (qbo_use_forcing) then + bbuffer(bpter(ib,k)+9) = uzm(k,j) + end if + + do m=1,pcnst + bbuffer(bpter(ib,k)+boff+m) = tracer(i,j,k,m) + end do + + end do + end do + end do + + call t_barrierf('sync_blk_to_chk', grid%commxy) + call t_startf ('block_to_chunk') + call transpose_block_to_chunk(tsize, bbuffer, cbuffer) + call t_stopf ('block_to_chunk') + +!$omp parallel do private (lchnk, ncol, i, k, m, cpter, pbuf_chnk, pbuf_uzm, pbuf_frontgf, pbuf_frontga) +chnk_loop2 : & + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + end if + + if (qbo_use_forcing) then + call pbuf_get_field(pbuf_chnk, uzm_idx, pbuf_uzm) + end if + + call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) + + do i=1,ncol + + phys_state(lchnk)%pint (i,pver+1) = cbuffer(cpter(i,0)) + phys_state(lchnk)%lnpint(i,pver+1) = cbuffer(cpter(i,0)+1) + phys_state(lchnk)%ps(i) = cbuffer(cpter(i,0)+2) + phys_state(lchnk)%phis(i) = cbuffer(cpter(i,0)+3) + + do k=1,km + + phys_state(lchnk)%pint (i,k) = cbuffer(cpter(i,k)) + phys_state(lchnk)%lnpint(i,k) = cbuffer(cpter(i,k)+1) + phys_state(lchnk)%u (i,k) = cbuffer(cpter(i,k)+2) + phys_state(lchnk)%v (i,k) = cbuffer(cpter(i,k)+3) + phys_state(lchnk)%omega (i,k) = cbuffer(cpter(i,k)+4) + phys_state(lchnk)%t (i,k) = cbuffer(cpter(i,k)+5) + phys_state(lchnk)%exner (i,k) = cbuffer(cpter(i,k)+6) + + if (use_gw_front .or. use_gw_front_igw) then + pbuf_frontgf(i,k) = cbuffer(cpter(i,k)+7) + pbuf_frontga(i,k) = cbuffer(cpter(i,k)+8) + end if + + if (qbo_use_forcing) then + pbuf_uzm(i,k) = cbuffer(cpter(i,k)+9) + end if + + ! dry type constituents converted from moist to dry at bottom of routine + do m=1,pcnst + phys_state(lchnk)%q(i,k,m) = cbuffer(cpter(i,k)+boff+m) + end do + + end do + end do + + end do chnk_loop2 + + deallocate(bpter) + deallocate(bbuffer) + deallocate(cbuffer) + + endif has_local_map + +!------------------------------------------------------ +! Get indices to access O, O2, H, H2, and N species +!------------------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call cnst_get_ind('O', ixo) + call cnst_get_ind('O2', ixo2) + call cnst_get_ind('H', ixh) + call cnst_get_ind('H2', ixh2) + call cnst_get_ind('N', ixn) + endif +! +! Evaluate derived quantities +! + call t_startf ('derived_fields') +!$omp parallel do private (lchnk, ncol, i, k, m, qmavl, dqreq, qbot, qbotm1, zvirv, pbuf_chnk, mmrSum_O_O2_H) + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + do k=1,km + do i=1,ncol + phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pint(i,k+1) - phys_state(lchnk)%pint(i,k) + phys_state(lchnk)%rpdel(i,k) = D1_0/phys_state(lchnk)%pdel(i,k) + phys_state(lchnk)%pmid (i,k) = D0_5*(phys_state(lchnk)%pint(i,k) + phys_state(lchnk)%pint(i,k+1)) + phys_state(lchnk)%lnpmid(i,k) = log(phys_state(lchnk)%pmid(i,k)) + end do + end do + +! Attempt to remove negative constituents in bottom layer only by moving from next level +! This is a BAB kludge to avoid masses of warning messages for cloud water and ice, since +! the vertical remapping operator currently being used for cam is not strictly monotonic +! at the endpoints. + do m=1,pcnst + do i=1,ncol + if (phys_state(lchnk)%q(i,pver,m) < qmin(m)) then +! available q in 2nd level + qmavl = phys_state(lchnk)%q (i,pver-1,m) - qmin(m) +! required q change in bottom level rescaled to mass fraction in 2nd level + dqreq = (qmin(m) - phys_state(lchnk)%q(i,pver,m)) & + * phys_state(lchnk)%pdel(i,pver) / phys_state(lchnk)%pdel(i,pver-1) + qbot = phys_state(lchnk)%q(i,pver ,m) + qbotm1 = phys_state(lchnk)%q(i,pver-1,m) + if (dqreq < qmavl) then + phys_state(lchnk)%q(i,pver ,m) = qmin(m) + phys_state(lchnk)%q(i,pver-1,m) = phys_state(lchnk)%q(i,pver-1,m) - dqreq + ! Comment out these log messages since they can make the log files so + ! large that they're unusable. + if (dqreq>qmin(m) .and. dqreq>fraction*qbotm1 .and. (trim(fv_print_dpcoup_warn) == "full")) & + write(iulog,*) 'dpcoup dqreq', m, lchnk, i, qbot, qbotm1, dqreq + else + ! Comment out these log messages since they can make the log files so + ! large that they're unusable. + if (dqreq>qmin(m) .and. (trim(fv_print_dpcoup_warn) == "full")) then + write(iulog,*) 'dpcoup cant adjust', m, lchnk, i, qbot, qbotm1, dqreq + end if + end if + end if + end do + end do + +!----------------------------------------------------------------------------------------------------------------- +! Ensure O2 + O + H (N2) mmr greater than one. Check for unusually large H2 values and set to lower value +!----------------------------------------------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + do i=1,ncol + do k=1,pver + + if (phys_state(lchnk)%q(i,k,ixo) < mmrMin) phys_state(lchnk)%q(i,k,ixo) = mmrMin + if (phys_state(lchnk)%q(i,k,ixo2) < mmrMin) phys_state(lchnk)%q(i,k,ixo2) = mmrMin + + mmrSum_O_O2_H = phys_state(lchnk)%q(i,k,ixo)+phys_state(lchnk)%q(i,k,ixo2)+phys_state(lchnk)%q(i,k,ixh) + + if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then + + phys_state(lchnk)%q(i,k,ixo) = phys_state(lchnk)%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + phys_state(lchnk)%q(i,k,ixo2) = phys_state(lchnk)%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + phys_state(lchnk)%q(i,k,ixh) = phys_state(lchnk)%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + endif + + if(phys_state(lchnk)%q(i,k,ixh2) .gt. 6.e-5_r8) then + phys_state(lchnk)%q(i,k,ixh2) = 6.e-5_r8 + endif + + end do + end do + endif + +!----------------------------------------------------------------------------- +! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as constituent dependent variables +! and compute molecular viscosity(kmvis) and conductivity(kmcnd) +!----------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call physconst_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + endif + +!------------------------------------------------------------------------ +! Fill local zvirv variable; calculated for WACCM-X +!------------------------------------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 + else + zvirv(:,:) = zvir + endif +! +! Compute initial geopotential heights + call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & + phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) + +! Compute initial dry static energy, include surface geopotential + do k = 1, pver + do i=1,ncol + phys_state(lchnk)%s(i,k) = cpairv(i,k,lchnk)*phys_state(lchnk)%t(i,k) & + + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) + end do + end do + +! +! Convert dry type constituents from moist to dry mixing ratio +! + call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep + call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry. +! +! Ensure tracers are all positive +! + call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,phys_state(lchnk)%q) + +! Compute energy and water integrals of input state + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) + + end do + call t_stopf('derived_fields') + + deallocate (u3) + deallocate (v3) + if (dyn_state%am_diag) then + deallocate (du3) + deallocate (dv3) + deallocate (dua3) + deallocate (dva3) + deallocate (duf3) + deallocate (dummy) + end if + + end subroutine d_p_coupling +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: p_d_coupling --- convert physics output to dynamics input +! +! !INTERFACE: + subroutine p_d_coupling(grid, phys_state, phys_tend, & + dyn_in, dtime, zvir, cappa, ptop) + +! !USES: +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_fields +#endif + use physics_buffer, only: physics_buffer_desc + use physconst, only: physconst_calc_kappav + +!----------------------------------------------------------------------- + implicit none + +! Variables ending in xy are xy-decomposition instanciations. + + type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid + +! !INPUT PARAMETERS: + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend + type(dyn_import_t), intent(inout) :: dyn_in + + real(r8), intent(in) :: dtime + real(r8), intent(in) :: zvir + real(r8), intent(in) :: cappa + real(r8), intent(in) :: ptop + +! !DESCRIPTION: +! +! Coupler for converting physics output variables into dynamics input variables +! +! !REVISION HISTORY: +! 00.06.01 Boville Creation +! 01.06.08 AAM Compactified +! 01.07.13 AAM Some support for multi-2D decompositions +! 02.03.01 Worley Support for nontrivial physics remapping +! 02.08.06 Sawyer T3 added -- updated to current temperature +! 05.07.12 Sawyer Added dyn_state as argument +! 05.09.23 Sawyer Transitioned to XY decomposition vars. only +! 05.10.31 Sawyer Replaced dyn_state with dyn_interface +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + + type(t_fvdycore_state), pointer :: dyn_state + +! Variables from the dynamics import container + + real(r8), pointer :: psxy(:,:) + real(r8), pointer :: u3sxy(:,:,:) + real(r8), pointer :: v3sxy(:,:,:) + real(r8), pointer :: t3xy(:,:,:) ! Temperature + real(r8), pointer :: ptxy(:,:,:) ! Virt. pot. temp. + real(r8), pointer :: tracer(:,:,:,:) ! Constituents + + real(r8), pointer :: pexy(:,:,:) + real(r8), pointer :: delpxy(:,:,:) + real(r8), pointer :: pkxy(:,:,:) + real(r8), pointer :: pkzxy(:,:,:) + +! Local workspace + + real(r8):: dudtxy(grid%ifirstxy:grid%ilastxy,& + grid%km,grid%jfirstxy:grid%jlastxy) + real(r8):: dvdtxy(grid%ifirstxy:grid%ilastxy,& + grid%km,grid%jfirstxy:grid%jlastxy) + real(r8):: dummy_pelnxy(grid%ifirstxy:grid%ilastxy,grid%km+1, & + grid%jfirstxy:grid%jlastxy) + + integer :: i, ib, k, m, j, lchnk ! indices + integer :: ncol ! number of columns in current chunk + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: blksiz ! number of columns in 2D block + integer :: tsize ! amount of data per grid point passed to physics + integer, allocatable, dimension(:,:) :: bpter + ! offsets into block buffer for unpacking data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for packing data + + real(r8) :: dt5 + real(r8), allocatable, dimension(:) :: & + bbuffer, cbuffer ! transpose buffers +#if (! defined SPMD) + integer :: block_buf_nrecs = 0 + integer :: chunk_buf_nrecs = 0 + logical :: local_dp_map=.true. +#endif + integer :: km, iam + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + + real(r8) :: cappa3v( grid%ifirstxy:grid%ilastxy,& + grid%jfirstxy:grid%jlastxy, grid%km ) + + dyn_state => get_dyn_state() + +! Pull the variables out of the dynamics export container + + psxy => dyn_in%ps + u3sxy => dyn_in%u3s + v3sxy => dyn_in%v3s + t3xy => dyn_in%t3 + ptxy => dyn_in%pt + tracer => dyn_in%tracer + + pexy => dyn_in%pe + delpxy => dyn_in%delp + pkxy => dyn_in%pk + pkzxy => dyn_in%pkz + + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + iam = grid%iam + +!---------------------------End Local workspace------------------------- + +#if ( defined OFFLINE_DYN ) +! +! set the dyn flds to offline meteorological data +! + call get_met_fields( phys_state, phys_tend, dtime ) +#endif +! ------------------------------------------------------------------------- +! Copy temperature, tendencies and constituents to dynamics data structures +! ------------------------------------------------------------------------- + +! ------------------------------------------------------------------------- +! Copy onto xy decomposition, then transpose to yz decomposition +! ------------------------------------------------------------------------- + + if (local_dp_map) then + +!$omp parallel do private(lchnk, i, k, ncol, m, lons, lats) + + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + + do k = 1, km + do i = 1, ncol + dvdtxy(lons(i),k,lats(i)) = phys_tend(lchnk)%dvdt(i,k) + dudtxy(lons(i),k,lats(i)) = phys_tend(lchnk)%dudt(i,k) + ptxy (lons(i),lats(i),k) = phys_state(lchnk)%t(i,k) + delpxy(lons(i),lats(i),k) = phys_state(lchnk)%pdel(i,k) + enddo + enddo + + do m=1,pcnst + do k=1,km + do i=1,ncol + tracer(lons(i),lats(i),k,m) = & + phys_state(lchnk)%q(i,k,m) + end do + end do + end do + + enddo + + else + + tsize = 4 + pcnst + + blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) + allocate(bpter(blksiz,0:km)) + allocate(bbuffer(tsize*block_buf_nrecs)) + allocate(cbuffer(tsize*chunk_buf_nrecs)) + +!$omp parallel do private (lchnk, ncol, i, k, m, cpter) + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + call chunk_to_block_send_pters(lchnk,pcols,km+1,tsize,cpter) + + do i=1,ncol + cbuffer(cpter(i,0):cpter(i,0)+3+pcnst) = 0.0_r8 + end do + + do k=1,km + do i=1,ncol + + cbuffer(cpter(i,k)) = phys_tend(lchnk)%dvdt(i,k) + cbuffer(cpter(i,k)+1) = phys_tend(lchnk)%dudt(i,k) + cbuffer(cpter(i,k)+2) = phys_state(lchnk)%t(i,k) + cbuffer(cpter(i,k)+3) = phys_state(lchnk)%pdel(i,k) + + do m=1,pcnst + cbuffer(cpter(i,k)+3+m) = phys_state(lchnk)%q(i,k,m) + end do + + end do + + end do + + end do + + call t_barrierf('sync_chk_to_blk', grid%commxy) + call t_startf ('chunk_to_block') + call transpose_chunk_to_block(tsize, cbuffer, bbuffer) + call t_stopf ('chunk_to_block') + + if (iam .lt. grid%npes_xy) then + call chunk_to_block_recv_pters(iam+1,blksiz,km+1,tsize,bpter) + endif + +!$omp parallel do private (j, i, ib, k, m) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) + + dvdtxy(i,k,j) = bbuffer(bpter(ib,k)) + dudtxy(i,k,j) = bbuffer(bpter(ib,k)+1) + ptxy (i,j,k) = bbuffer(bpter(ib,k)+2) + delpxy(i,j,k) = bbuffer(bpter(ib,k)+3) + + do m=1,pcnst + tracer(i,j,k,m) = bbuffer(bpter(ib,k)+3+m) + end do + + enddo + enddo + enddo + + deallocate(bpter) + deallocate(bbuffer) + deallocate(cbuffer) + + endif + +! WS: 02.08.06: Update t3 to temperature +!$omp parallel do private(i,j,k) + do k=1,km + do j = jfirstxy,jlastxy + do i = ifirstxy,ilastxy + t3xy(i,j,k) = ptxy(i,j,k) + enddo + enddo + enddo + +! ------------------------------------------------------------------------- +! Update u3s and v3s from tendencies dudt and dvdt. +! ------------------------------------------------------------------------- + dt5 = D0_5*dtime + + call t_barrierf('sync_uv3s_update', grid%commxy) + call t_startf('uv3s_update') + if (iam .lt. grid%npes_xy) then + call uv3s_update(grid, dudtxy, u3sxy, dvdtxy, v3sxy, dt5, & + dyn_state%am_correction) + end if ! (iam .lt. grid%npes_xy) + call t_stopf('uv3s_update') + +! ------------------------------------------------------------------------- +! Compute pt, q3, pe, delp, ps, peln, pkz and pk. +! For 2-D decomposition, delp is transposed to delpxy, pexy is computed +! from delpxy (and ptop), and pexy is transposed back to pe. +! Note that pt, q3, delp and pe are input parameters as well. +! ------------------------------------------------------------------------- + call t_barrierf('sync_p_d_adjust', grid%commxy) + call t_startf ('p_d_adjust') + if (iam .lt. grid%npes_xy) then + if (grid%high_alt) then + call physconst_calc_kappav(ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, tracer, cappa3v ) + else + cappa3v = cappa + endif + call p_d_adjust(grid, tracer, dummy_pelnxy, pkxy, pkzxy, zvir, cappa3v, & + delpxy, ptxy, pexy, psxy, ptop) + end if ! (iam .lt. grid%npes_xy) + call t_stopf ('p_d_adjust') + +!EOC + end subroutine p_d_coupling +!----------------------------------------------------------------------- +end module dp_coupling diff --git a/src/dynamics/fv/dryairm.F90 b/src/dynamics/fv/dryairm.F90 new file mode 100644 index 0000000000..94c8637e6a --- /dev/null +++ b/src/dynamics/fv/dryairm.F90 @@ -0,0 +1,232 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: dryairm --- Check dry air mass; set to a predefined value if +! nlres is false (initialization run) +! +! !INTERFACE: + +subroutine dryairm( grid, moun, ps, tracer, delp, & + pe, nlres_loc ) + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only: T_FVDYCORE_GRID +#if defined( SPMD ) +#define CPP_PRT_PREFIX if( grid%iam == 0 ) +#else +#define CPP_PRT_PREFIX +#endif + +!fvitt + use constituents, only: cnst_type + use mean_module, only: gmeanxy + + use pio, only: file_desc_t + use cam_initfiles, only: topo_file_get_id + + use cam_logfile, only: iulog + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + logical, intent(in):: nlres_loc + logical, intent(in):: moun + + real(r8), intent(inout) :: tracer(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) ! Tracers + real(r8), intent(inout) :: ps(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) ! surface pressure + real(r8), intent(inout) :: delp(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! press. thickness + real(r8), intent(inout) :: pe(grid%ifirstxy:grid%ilastxy,grid%km+1, & + grid%jfirstxy:grid%jlastxy) ! edge pressure + +! !DESCRIPTION: +! Perform adjustment of the total dry-air-mass while preserving total +! tracer mass +! Developer: S.-J. Lin, Aug 2000 +! +! !REVISION HISTORY: +! AAM 01.06.27 Assure agreement thru roundoff for 2D decomp. +! WS 05.07.06 Simplified interface with grid argument +! WS 05.08.26 Modified for XY decomposition +! WS 06.02.21 OMP bug fix (2nd to last DO), removed YZ ver. +! WS 06.07.01 Transitioned tracers q to T_TRACERS +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Use work arrays psdk/psdkg to assure identical answers through roundoff +! for different z decompositions + + real(r8), allocatable :: psdk(:,:,:) ! local work array + real(r8), allocatable :: psdkg(:,:,:) ! global work array +! dry surface pressure + real(r8) psd(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real(r8) drym,drym_loc ! global mean dry air mass in pascals + + integer :: im, jm, km ! Dimensions + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy ! XY slice + integer :: nq ! Number of advective tracers + real(r8):: ptop + +#if defined ( NAVY10 ) + parameter (drym = 98222.0_r8) ! For US NAVY 10-min terrain +#else + parameter (drym = 98288.0_r8) ! For USGS terrain +#endif + real(r8), parameter :: D245_0 = 245._r8 + real(r8), parameter :: D101325_0 = 101325._r8 + + type(file_desc_t), pointer :: fh_topo + + integer i, j, k, ic + real(r8) psm0, psm1 + real(r8) psdry + real(r8) dpd + + fh_topo => topo_file_get_id() + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + nq = grid%nq + ptop = grid%ptop + + drym_loc = drym + if (.not. associated(fh_topo)) then + drym_loc = D101325_0 - D245_0 + end if + +! Check global maximum/minimum + + call gmeanxy( grid, ps, psm0 ) + + allocate (psdk(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + allocate (psdkg(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + +!$omp parallel do private(i,j,k) + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdk(i,j,k) = 0._r8 + enddo + enddo + enddo + +!$omp parallel do private(i,j,k) + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdkg(i,j,k) = 0._r8 + enddo + enddo + enddo + +!$omp parallel do private(i,j) + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdk(i,j,1) = ptop + enddo + enddo + + if( nq .ne. 0 ) then +!$omp parallel do private(i,j,k) + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdk(i,j,k) = psdk(i,j,k) + & + (1._r8-tracer(i,j,k,1))*(pe(i,k+1,j)-pe(i,k,j)) + enddo + enddo + enddo + else + +!$omp parallel do private(i,j,k) + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdk(i,j,k) = psdk(i,j,k) + pe(i,k+1,j) - pe(i,k,j) + enddo + enddo + enddo + + endif + +!$omp parallel do private(i,j,k) + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psdkg(i,j,k) = psdk(i,j,k) + enddo + enddo + enddo + +!$omp parallel do private(i,j) + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psd(i,j) = 0._r8 + enddo + enddo + + !$omp parallel do private(i,j,k) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + psd(i,j) = psd(i,j) + psdkg(i,j,k) + enddo + enddo + enddo + + call gmeanxy( grid, psd, psdry ) + + CPP_PRT_PREFIX write(iulog,*) 'Total Mass=', 0.01_r8*psm0, '(mb), Dry Mass=', 0.01_r8*psdry, '(mb)' + CPP_PRT_PREFIX write(iulog,*) 'Total Precipitable Water =', (psm0-psdry)/9.80616_r8, '(kg/m**2)' + + deallocate (psdk) + deallocate (psdkg) + + if( nlres_loc ) return + + if(moun) then + dpd = drym_loc - psdry + else + dpd = 1000._r8*100._r8 - psdry + endif + CPP_PRT_PREFIX write(iulog,*) 'dry mass to be added =', 0.01_r8*dpd + +!$omp parallel do private(i, j, ic) + + do j=jfirstxy,jlastxy + + do ic=1,nq + do i=ifirstxy,ilastxy + ! fvitt + ! don't want to change the initial dry mixing ratios of tracers + if (cnst_type(ic).ne.'dry') tracer(i,j,km,ic) = & + tracer(i,j,km,ic)*delp(i,j,km)/(delp(i,j,km)+dpd) + enddo + enddo + +! Adjust the lowest Lagrangian layer + do i=ifirstxy,ilastxy + delp(i,j,km) = delp(i,j,km) + dpd + pe(i,km+1,j) = pe(i,km,j) + delp(i,j,km) + ps(i,j) = pe(i,km+1,j) + enddo + enddo + + call gmeanxy( grid, ps, psm1 ) + + CPP_PRT_PREFIX write(iulog,*) 'Total moist surface pressure after adjustment (mb) = ',0.01_r8*psm1 + + return + +!EOC +end subroutine dryairm +!--------------------------------------------------------------------- diff --git a/src/dynamics/fv/dycore.F90 b/src/dynamics/fv/dycore.F90 new file mode 100644 index 0000000000..0a2ebe5656 --- /dev/null +++ b/src/dynamics/fv/dycore.F90 @@ -0,0 +1,30 @@ +module dycore + +implicit none +private +save + +public :: dycore_is + +!========================================================================================= +contains +!========================================================================================= + +logical function dycore_is (name) + + ! Determine the dynamical core in use. + + character(len=*) :: name + !----------------------------------------------------------------------- + + if (name == 'lr' .or. name == 'LR') then + dycore_is = .true. + else + dycore_is = .false. + end if + +end function dycore_is + +!========================================================================================= + +end module dycore diff --git a/src/dynamics/fv/dyn_comp.F90 b/src/dynamics/fv/dyn_comp.F90 new file mode 100644 index 0000000000..a16f0672e0 --- /dev/null +++ b/src/dynamics/fv/dyn_comp.F90 @@ -0,0 +1,3187 @@ +module dyn_comp + +!---------------------------------------------------------------------- +! This module contains the interfaces for the Finite-Volume +! Dynamical Core used in the Community Atmospheric Model +! (FVCAM). This component will hereafter be referred +! to as the ``FVdycore'' gridded component. FVdycore +! consists of four sub-components, +! +! cd_core: The C/D-grid dycore component +! te_map: Vertical remapping algorithm +! trac2d: Tracer advection +! benergy: Energy balance +! +! FVdycore maintains an internal state consisting of the +! following fields: control variables +! +! U: U winds on a D-grid (m/s) +! V: V winds on a D-grid (m/s) +! PT: Scaled Virtual Potential Temperature (T_v/PKZ) +! PE: Edge pressures +! Q: Tracers +! PKZ: Consistent mean for p^kappa +! +! as well as a GRID and same additional run-specific variables +! (dt, iord, jord, nsplit, nspltrac, nspltvrm) +! +! Note: PT is not updated if the flag CONVT is true. +! +! The internal state is updated each time FVdycore is called. +! +! REVISION HISTORY: +! +! WS 05.06.10: Adapted from FVdycore_GridCompMod +! WS 05.09.20: Renamed dyn_comp +! WS 05.11.10: Now using dyn_import/export_t containers +! WS 06.03.01: Removed tracertrans-related variables +! WS 06.04.13: dyn_state moved here from prognostics +! CC 07.01.29: Corrected calculation of OMGA +! AM 07.10.31: Supports overlap of trac2d and cd_core subcycles +!---------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc, iam + +use pmgrid, only: plon, plat +use constituents, only: cnst_name, cnst_read_iv, qmin + +use time_manager, only: get_step_size + +use dynamics_vars, only: t_fvdycore_grid, & + t_fvdycore_state, t_fvdycore_constants +use dyn_internal_state, only: get_dyn_state, get_dyn_state_grid + +use dyn_grid, only: get_horiz_grid_dim_d +use spmd_dyn, only: spmd_readnl + +use cam_control_mod, only: initial_run, moist_physics +use phys_control, only: phys_setopts + +use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim +use cam_pio_utils, only: clean_iodesc_list +use ncdio_atm, only: infld +use pio, only: pio_inq_varid, pio_get_att + + +use perf_mod, only: t_startf, t_stopf, t_barrierf +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use pio, only: file_desc_t, pio_inq_dimid, pio_inq_dimlen +use par_vecsum_mod, only: par_vecsum +use te_map_mod, only: te_map + +implicit none +private +save + +public :: & + dyn_readnl, & + dyn_register, & + dyn_init, & + dyn_run, & + dyn_final, & + dyn_import_t, & + dyn_export_t, & + dyn_state, & + frontgf_idx, & + frontga_idx, & + uzm_idx + +type (t_fvdycore_state), target :: dyn_state + +type dyn_import_t + real(r8), dimension(:,: ), pointer :: phis ! Surface geopotential + real(r8), dimension(:,: ), pointer :: ps ! Surface pressure + real(r8), dimension(:,:,:), pointer :: u3s ! U-winds (staggered) + real(r8), dimension(:,:,:), pointer :: v3s ! V-winds (staggered) + real(r8), dimension(:,:,:), pointer :: pe ! Pressure + real(r8), dimension(:,:,:), pointer :: pt ! Potential temperature + real(r8), dimension(:,:,:), pointer :: t3 ! Temperatures + real(r8), dimension(:,:,:), pointer :: pk ! Pressure to the kappa + real(r8), dimension(:,:,:), pointer :: pkz ! Pressure to the kappa offset + real(r8), dimension(:,:,:), pointer :: delp ! Delta pressure + real(r8), dimension(:,:,:,:), pointer :: tracer ! Tracers +end type dyn_import_t + +type dyn_export_t + real(r8), dimension(:,: ), pointer :: phis ! Surface geopotential + real(r8), dimension(:,: ), pointer :: ps ! Surface pressure + real(r8), dimension(:,:,:), pointer :: u3s ! U-winds (staggered) + real(r8), dimension(:,:,:), pointer :: v3s ! V-winds (staggered) + real(r8), dimension(:,:,:), pointer :: pe ! Pressure + real(r8), dimension(:,:,:), pointer :: pt ! Potential temperature + real(r8), dimension(:,:,:), pointer :: t3 ! Temperatures + real(r8), dimension(:,:,:), pointer :: pk ! Pressure to the kappa + real(r8), dimension(:,:,:), pointer :: pkz ! Pressure to the kappa offset + real(r8), dimension(:,:,:), pointer :: delp ! Delta pressure + real(r8), dimension(:,:,:,:), pointer :: tracer ! Tracers + real(r8), dimension(:,:,:), pointer :: peln ! + real(r8), dimension(:,:,:), pointer :: omga ! Vertical velocity + real(r8), dimension(:,:,:), pointer :: mfx ! Mass flux in X + real(r8), dimension(:,:,:), pointer :: mfy ! Mass flux in Y + real(r8), dimension(:,:,:), pointer :: du3s ! U-wind tend. from dycore (staggered) + real(r8), dimension(:,:,:), pointer :: dv3s ! V-wind tend. from dycore (staggered) + real(r8), dimension(:,:,:), pointer :: dua3s ! U-wind tend. from advection (stagg) + real(r8), dimension(:,:,:), pointer :: dva3s ! V-wind tend. from advection (stagg) + real(r8), dimension(:,:,:), pointer :: duf3s ! U-wind tend. from fixer (staggered) +end type dyn_export_t + +! The FV core is always called in its "full physics" mode. We don't want +! the dycore to know what physics package is responsible for the forcing. +logical, parameter :: convt = .true. + +! Indices for fields that are computed in the dynamics and passed to the physics +! via the physics buffer +integer, protected :: frontgf_idx = -1 +integer, protected :: frontga_idx = -1 +integer, protected :: uzm_idx = -1 + +logical :: readvar ! inquiry flag: true => variable exists on netCDF file + +character(len=8) :: fv_print_dpcoup_warn = "off" +public :: fv_print_dpcoup_warn + +!============================================================================================= +CONTAINS +!============================================================================================= + +subroutine dyn_readnl(nlfilename) + + ! Read dynamics namelist group. + use units, only: getunit, freeunit + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, & + mpi_logical, mpi_character + use ctem, only: ctem_readnl + use fill_module, only: fill_readnl + + ! args + character(len=*), intent(in) :: nlfilename + + ! Local variables + integer :: ierr + integer :: unitn + character(len=*), parameter :: sub="dyn_readnl" + + integer :: fv_nsplit = 0 ! Lagrangian time splits + integer :: fv_nspltrac = 0 ! Tracer time splits + integer :: fv_nspltvrm = 0 ! Vertical re-mapping time splits + integer :: fv_iord = 4 ! scheme to be used in E-W direction + integer :: fv_jord = 4 ! scheme to be used in N-S direction + integer :: fv_kord = 4 ! scheme to be used for vertical mapping + ! _ord = 1: first order upwind + ! _ord = 2: 2nd order van Leer (Lin et al 1994) + ! _ord = 3: standard PPM + ! _ord = 4: enhanced PPM (default) + logical :: fv_conserve = .false. ! Flag indicating whether the dynamics is conservative + integer :: fv_filtcw = 0 ! flag for filtering c-grid winds + integer :: fv_fft_flt = 1 ! 0 => FFT/algebraic filter; 1 => FFT filter + integer :: fv_div24del2flag = 2 ! 2 for 2nd order div damping, 4 for 4th order div damping, + ! 42 for 4th order div damping plus 2nd order velocity damping + real(r8):: fv_del2coef = 3.e5_r8 ! strength of 2nd order velocity damping + logical :: fv_high_altitude = .false. ! switch to apply variables appropriate for high-altitude physics + + logical :: fv_am_correction = .false. ! apply correction for angular momentum (AM) + ! conservation in SW eqns + logical :: fv_am_fixer = .false. ! apply global fixer to conserve AM + logical :: fv_am_fix_lbl = .false. ! apply global AM fixer level by level + logical :: fv_am_diag = .false. ! turns on an AM diagnostic calculation written to log file + + namelist /dyn_fv_inparm/ fv_nsplit, fv_nspltrac, fv_nspltvrm, fv_iord, fv_jord, & + fv_kord, fv_conserve, fv_filtcw, fv_fft_flt, & + fv_div24del2flag, fv_del2coef, fv_am_correction, & + fv_am_fixer, fv_am_fix_lbl, fv_am_diag, fv_high_altitude, & + fv_print_dpcoup_warn + + type(t_fvdycore_state), pointer :: dyn_state + + real(r8) :: dt + !----------------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Read in dyn_fv_inparm namelist from: ', trim(nlfilename) + unitn = getunit() + open( unitn, file=trim(nlfilename), status='old' ) + + ! Look for dyn_fv_inparm group name in the input file. If found, leave the + ! file positioned at that namelist group. + call find_group_name(unitn, 'dyn_fv_inparm', status=ierr) + if (ierr == 0) then ! found dyn_fv_inparm + read(unitn, dyn_fv_inparm, iostat=ierr) ! read the dyn_fv_inparm namelist group + if (ierr /= 0) then + call endrun(sub//': ERROR reading dyn_fv_inparm') + end if + else + call endrun(sub//': can''t find dyn_fv_inparm in file '//trim(nlfilename)) + end if + close( unitn ) + call freeunit( unitn ) + endif + + call mpi_bcast(fv_nsplit, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_nsplit") + + call mpi_bcast(fv_nspltrac, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_nspltrac") + + call mpi_bcast(fv_nspltvrm, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_nspltvrm") + + call mpi_bcast(fv_iord, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_iord") + + call mpi_bcast(fv_jord, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_jord") + + call mpi_bcast(fv_kord, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_kord") + + call mpi_bcast(fv_conserve, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_conserve") + + call mpi_bcast(fv_filtcw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_filtcw") + + call mpi_bcast(fv_fft_flt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_fft_flt") + + call mpi_bcast(fv_div24del2flag, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_div24del2flag") + + call mpi_bcast(fv_del2coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_del2coef") + + call mpi_bcast(fv_am_correction, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_correction") + + ! if fv_am_fix_lbl is true then fv_am_fixer must also be true. + if (fv_am_fix_lbl .and. .not. fv_am_fixer) then + fv_am_fixer = .true. + end if + + call mpi_bcast(fv_am_fixer, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_fixer") + + call mpi_bcast(fv_am_fix_lbl, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_fix_lbl") + + call mpi_bcast(fv_am_diag, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_diag") + + call mpi_bcast(fv_high_altitude, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_high_altitude") + + call mpi_bcast(fv_print_dpcoup_warn, len(fv_print_dpcoup_warn), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_print_dpcoup_warn") + + ! Store namelist settings in fv state object + dyn_state => get_dyn_state() + + dyn_state%grid%high_alt = fv_high_altitude + + ! Calculate nsplit if it was specified as 0 + if ( fv_nsplit <= 0 ) then + dt = get_step_size() + dyn_state%nsplit= init_nsplit(dt, plon, plat) + else + dyn_state%nsplit= fv_nsplit + end if + + ! Calculate nspltrac if it was specified as 0 + if (fv_nspltrac <= 0) then + dyn_state%nspltrac = max (1, dyn_state%nsplit/4) + else + dyn_state%nspltrac = fv_nspltrac + end if + + ! Set nspltvrm to 1 if it was specified as 0 + if (fv_nspltvrm <= 0) then + dyn_state%nspltvrm = 1 + else + dyn_state%nspltvrm = fv_nspltvrm + end if + + dyn_state%iord = fv_iord + dyn_state%jord = fv_jord + dyn_state%kord = fv_kord + + ! Calculation of orders for the C grid is fixed by D-grid IORD, JORD + if( fv_iord <= 2 ) then + dyn_state%icd = 1 + else + dyn_state%icd = -2 + end if + + if( fv_jord <= 2 ) then + dyn_state%jcd = 1 + else + dyn_state%jcd = -2 + end if + + dyn_state%consv = fv_conserve + dyn_state%filtcw = fv_filtcw + dyn_state%fft_flt = fv_fft_flt + dyn_state%div24del2flag = fv_div24del2flag + dyn_state%del2coef = fv_del2coef + + dyn_state%am_correction = fv_am_correction + dyn_state%am_fixer = fv_am_fixer + dyn_state%am_fix_lbl = fv_am_fix_lbl + dyn_state%am_diag = fv_am_diag + + + ! There is a mod for the AM correction in the vertical diffusion code. Make use + ! of the physics control module to communicate whether correction is to be applied there. + call phys_setopts(fv_am_correction_in=fv_am_correction) + + if (masterproc) then + write(iulog,*)'FV dycore configuration:' + write(iulog,*)' Lagrangian time splits (fv_nsplit) = ', fv_nsplit + write(iulog,*)' Tracer time splits (fv_nslptrac) = ', fv_nspltrac + write(iulog,*)' Vertical re-mapping time splits (fv_nspltvrm) = ', fv_nspltvrm + write(iulog,*)' Scheme in E-W direction (fv_iord) = ', fv_iord + write(iulog,*)' Scheme in N-S direction (fv_jord) = ', fv_jord + write(iulog,*)' Scheme for vertical mapping (fv_kord) = ', fv_kord + write(iulog,*)' Conservative dynamics (fv_conserve) = ', fv_conserve + write(iulog,*)' Filtering c-grid winds (fv_filcw) = ', fv_filtcw + write(iulog,*)' FFT filter (fv_fft_flt) = ', fv_fft_flt + write(iulog,*)' Divergence/velocity damping (fv_div24del2flag) = ', fv_div24del2flag + write(iulog,*)' Coef for 2nd order velocity damping (fv_del2coef) = ', fv_del2coef + write(iulog,*)' ' + write(iulog,*)' Angular momentum (AM) correction (fv_am_correction) = ', fv_am_correction + write(iulog,*)' Apply AM fixer (fv_am_fixer) = ', fv_am_fixer + write(iulog,*)' Level by level AM fixer (fv_am_fix_lbl) = ', fv_am_fix_lbl + write(iulog,*)' Enable AM diagnostics (fv_am_diag) = ', fv_am_diag + write(iulog,*)' ' + end if + + call spmd_readnl(nlfilename) + + call ctem_readnl(nlfilename) + call fill_readnl(nlfilename) + + !--------------------------------------------------------------------------- + contains + !--------------------------------------------------------------------------- + + integer function init_nsplit(dtime, im, jm) + + !----------------------------------------------------------------------- + ! find proper value for nsplit if not specified + ! + ! If nsplit=0 (module variable) then determine a good value + ! for ns (used in dynpkg) based on resolution and the large-time-step + ! (pdt). The user may have to set this manually if instability occurs. + ! + ! REVISION HISTORY: + ! 00.10.19 Lin Creation + ! 01.06.10 Sawyer Modified for dynamics_init framework + ! 03.12.04 Sawyer Moved here from dynamics_vars. Now a function + !----------------------------------------------------------------------- + + ! arguments + real (r8), intent(in) :: dtime ! time step + integer, intent(in) :: im, jm ! Global horizontal resolution + + ! LOCAL VARIABLES: + real (r8) pdt ! Time-step in seconds + real (r8) dim + real (r8) dim0 ! base dimension + real (r8) dt0 ! base time step + real (r8) ns0 ! base nsplit for base dimension + real (r8) ns ! final value to be returned + + parameter ( dim0 = 191._r8 ) + parameter ( dt0 = 1800._r8 ) + parameter ( ns0 = 4._r8 ) + !----------------------------------------------------------------------- + + pdt = int(dtime) ! dtime is a variable internal to this module + dim = max ( im, 2*(jm-1) ) + ns = int ( ns0*abs(pdt)*dim/(dt0*dim0) + 0.75_r8 ) + ns = max ( 1._r8, ns ) ! for cases in which dt or dim is too small + + init_nsplit = ns + + end function init_nsplit + !--------------------------------------------------------------------------- + +end subroutine dyn_readnl + +!============================================================================================= + +subroutine dyn_register() + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use ppgrid, only: pcols, pver + use phys_control, only: use_gw_front, use_gw_front_igw + use qbo, only: qbo_use_forcing + + ! These fields are computed by the dycore and passed to the physics via the + ! physics buffer. + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_add_field("FRONTGF", "global", dtype_r8, (/pcols,pver/), & + frontgf_idx) + call pbuf_add_field("FRONTGA", "global", dtype_r8, (/pcols,pver/), & + frontga_idx) + end if + + if (qbo_use_forcing) then + call pbuf_add_field("UZM", "global", dtype_r8, (/pcols,pver/), & + uzm_idx) + end if + +end subroutine dyn_register + +!============================================================================================= + +subroutine dyn_init(dyn_in, dyn_out) + + ! Initialize FV dynamical core state variables + + use physconst, only: pi, omega, rearth, rair, cpair, zvir + use infnan, only: inf, assignment(=) + + use constituents, only: pcnst, cnst_name, cnst_longname, tottnam, cnst_get_ind + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + +#if ( defined OFFLINE_DYN ) + use metdata, only: metdata_dyn_init +#endif + use ctem, only: ctem_init + use diag_module, only: fv_diag_init + + ! arguments: + type (dyn_import_t), intent(out) :: dyn_in + type (dyn_export_t), intent(out) :: dyn_out + + ! Local variables + type (t_fvdycore_state), pointer :: dyn_state + type (t_fvdycore_grid), pointer :: grid + type (t_fvdycore_constants), pointer :: constants + + real(r8) :: dt + + integer :: ifirstxy, ilastxy + integer :: jfirstxy, jlastxy + integer :: km + integer :: ierr + + integer :: m, ixcldice, ixcldliq + logical :: history_budget ! output tendencies and state variables for budgets + integer :: budget_hfile_num + + character(len=*), parameter :: sub='dyn_init' + !---------------------------------------------------------------------------- + + dyn_state => get_dyn_state() + grid => dyn_state%grid + constants => dyn_state%constants + + if (grid%high_alt) then + grid%ntotq = grid%ntotq + 1 ! advect Kappa + grid%kthi = grid%kthi + 1 + grid%kthia(:) = grid%kthia(:) + 1 + endif + + ! Set constants + constants%pi = pi + constants%omega = omega + constants%ae = rearth + constants%rair = rair + constants%cp = cpair + constants%cappa = rair/cpair + constants%zvir = zvir + + dt = get_step_size() + dyn_state%dt = dt ! Should this be part of state?? + + dyn_state%check_dt = 21600.0_r8 ! Check max and min every 6 hours. + + ! Create the dynamics import and export state objects + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + + allocate(dyn_in%phis( ifirstxy:ilastxy,jfirstxy:jlastxy), & + dyn_in%ps( ifirstxy:ilastxy,jfirstxy:jlastxy), & + dyn_in%u3s( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%v3s( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%pe( ifirstxy:ilastxy,km+1,jfirstxy:jlastxy), & + dyn_in%pt( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%t3( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%pk( ifirstxy:ilastxy,jfirstxy:jlastxy,km+1), & + dyn_in%pkz( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%delp( ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_in%tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,km, grid%ntotq ), & + stat=ierr) + + if ( ierr /= 0 ) then + write(iulog,*) sub//': ERROR: allocating components of dyn_in. ierr=', ierr + call endrun(sub//': ERROR: allocating components of dyn_in') + end if + + dyn_in%phis = inf + dyn_in%ps = inf + dyn_in%u3s = inf + dyn_in%v3s = inf + dyn_in%pe = inf + dyn_in%pt = inf + dyn_in%t3 = inf + dyn_in%pk = inf + dyn_in%pkz = inf + dyn_in%delp = inf + dyn_in%tracer = inf + + ! Export object has all of these except phis + dyn_out%phis => dyn_in%phis + dyn_out%ps => dyn_in%ps + dyn_out%u3s => dyn_in%u3s + dyn_out%v3s => dyn_in%v3s + dyn_out%pe => dyn_in%pe + dyn_out%pt => dyn_in%pt + dyn_out%t3 => dyn_in%t3 + dyn_out%pk => dyn_in%pk + dyn_out%pkz => dyn_in%pkz + dyn_out%delp => dyn_in%delp + dyn_out%tracer => dyn_in%tracer + + ! And several more which are not in the import container + allocate(dyn_out%peln (ifirstxy:ilastxy,km+1,jfirstxy:jlastxy),& + dyn_out%omga (ifirstxy:ilastxy,km,jfirstxy:jlastxy), & + dyn_out%mfx (ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_out%mfy (ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + stat=ierr) + if ( ierr /= 0 ) then + write(iulog,*) sub//': ERROR: allocating components of dyn_out. ierr=', ierr + call endrun(sub//': ERROR: allocating components of dyn_out') + end if + + if (dyn_state%am_fixer .or. dyn_state%am_diag) then + + allocate( & + dyn_out%duf3s(ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + stat=ierr) + if ( ierr /= 0 ) then + write(iulog,*) sub//': ERROR: allocating duf3s components of dyn_out. ierr=', ierr + call endrun(sub//': ERROR: allocating duf3s components of dyn_out') + end if + dyn_out%duf3s= inf + end if + + if (dyn_state%am_diag) then + allocate( & + dyn_out%du3s (ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_out%dv3s (ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_out%dua3s(ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + dyn_out%dva3s(ifirstxy:ilastxy,jfirstxy:jlastxy,km), & + stat=ierr) + if ( ierr /= 0 ) then + write(iulog,*) sub//': ERROR: allocating du3s components of dyn_out. ierr=', ierr + call endrun(sub//': ERROR: allocating du3s components of dyn_out') + end if + dyn_out%du3s = inf + dyn_out%dv3s = inf + dyn_out%dua3s= inf + dyn_out%dva3s= inf + end if + + dyn_out%peln = inf + dyn_out%omga = inf + dyn_out%mfx = inf + dyn_out%mfy = inf + +#if ( defined OFFLINE_DYN ) + call metdata_dyn_init(grid) +#endif + + ! Setup circulation diagnostics + call ctem_init() + + ! Diagnostics for AM + if (dyn_state%am_diag) call fv_diag_init() + + if (initial_run) then + + ! Read in initial data + call read_inidat(dyn_in) + call clean_iodesc_list() + + end if + + ! History output + + call addfld('US', (/ 'lev' /),'A','m/s','Zonal wind, staggered', gridname='fv_u_stagger') + call addfld('VS', (/ 'lev' /),'A','m/s','Meridional wind, staggered', gridname='fv_v_stagger') + call addfld('US&IC', (/ 'lev' /),'I','m/s','Zonal wind, staggered', gridname='fv_u_stagger') + call addfld('VS&IC', (/ 'lev' /),'I','m/s','Meridional wind, staggered', gridname='fv_v_stagger') + call addfld('PS&IC', horiz_only, 'I','Pa', 'Surface pressure', gridname='fv_centers') + call addfld('T&IC', (/ 'lev' /),'I','K', 'Temperature', gridname='fv_centers') + do m = 1, pcnst + call addfld(trim(cnst_name(m))//'&IC',(/ 'lev' /),'I','kg/kg', cnst_longname(m), gridname='fv_centers') + end do + do m = 1, pcnst + call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert + fixer tendency ', & + gridname='fv_centers') + end do + + call add_default('US&IC ', 0, 'I') + call add_default('VS&IC ', 0, 'I') + call add_default('PS&IC ',0, 'I') + call add_default('T&IC ',0, 'I') + do m = 1, pcnst + call add_default(trim(cnst_name(m))//'&IC',0, 'I') + end do + + call addfld('DUH', (/ 'lev' /), 'A','K/s','U horizontal diffusive heating', gridname='fv_centers') + call addfld('DVH', (/ 'lev' /), 'A','K/s','V horizontal diffusive heating', gridname='fv_centers') + call addfld('ENGYCORR', (/ 'lev' /), 'A','W/m2','Energy correction for over-all conservation', & + gridname='fv_centers') + + call addfld('FU', (/ 'lev' /), 'A','m/s2','Zonal wind forcing term', gridname='fv_centers') + call addfld('FV', (/ 'lev' /), 'A','m/s2','Meridional wind forcing term', gridname='fv_centers') + call addfld('FU_S', (/ 'lev' /), 'A','m/s2','Zonal wind forcing term on staggered grid', & + gridname='fv_u_stagger') + call addfld('FV_S', (/ 'lev' /), 'A','m/s2','Meridional wind forcing term on staggered grid', & + gridname='fv_v_stagger') + call addfld('TTEND', (/ 'lev' /), 'A','K/s','Total T tendency (all processes)', gridname='fv_centers') + call addfld('LPSTEN', horiz_only, 'A','Pa/s','Surface pressure tendency', gridname='fv_centers') + call addfld('VAT', (/ 'lev' /), 'A','K/s','Vertical advective tendency of T', gridname='fv_centers') + call addfld('KTOOP', (/ 'lev' /), 'A','K/s','(Kappa*T)*(omega/P)', gridname='fv_centers') + + call phys_getopts(history_budget_out=history_budget, history_budget_histfile_num_out=budget_hfile_num) + if ( history_budget ) then + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + call add_default(tottnam( 1), budget_hfile_num, ' ') + call add_default(tottnam(ixcldliq), budget_hfile_num, ' ') + call add_default(tottnam(ixcldice), budget_hfile_num, ' ') + call add_default('TTEND ' , budget_hfile_num, ' ') + end if + +end subroutine dyn_init + +!============================================================================================= + +subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc) + + ! Driver for the NASA finite-volume dynamical core + ! + ! Developer: Shian-Jiann Lin, NASA/GSFC; email: lin@dao.gsfc.nasa.gov + ! + ! Top view of D-grid prognostatic variables: u, v, and delp (and other scalars) + ! + ! u(i,j+1) + ! | + ! v(i,j)---delp(i,j)---v(i+1,j) + ! | + ! u(i,j) + ! + ! External routine required: + ! + ! The user needs to supply a subroutine to set up + ! Eulerian vertical coordinate" for remapping purpose. + ! Currently this routine is named as set_eta() + ! In principle any terrian following vertical + ! coordinate can be used. The input to fvcore + ! need not be on the same vertical coordinate + ! as the output. + ! If SPMD is defined the Pilgrim communication + ! library developed by Will Sawyer will be needed. + ! + ! Remarks: + ! + ! Values at poles for both u and v need not be defined; but values for + ! all other scalars needed to be defined at both poles (as polar cap mean + ! quantities). Tracer advection is done "off-line" using the + ! large time step. Consistency is maintained by using the time accumulated + ! Courant numbers and horizontal mass fluxes for the FFSL algorithm. + ! The input "pt" can be either dry potential temperature + ! defined as T/pkz (adiabatic case) or virtual potential temperature + ! defined as T*/pkz (full phys case). IF convt is true, pt is not updated. + ! Instead, virtual temperature is ouput. + ! ipt is updated if convt is false. + ! The user may set the value of nx to optimize the SMP performance + ! The optimal valuse of nx depends on the total number of available + ! shared memory CPUs per node (NS). Assuming the maximm MPI + ! decomposition is used in the y-direction, set nx=1 if the + ! NS <=4; nx=4 if NS=16. + ! + ! A 2D xy decomposition is used for handling the Lagrangian surface + ! remapping, the ideal physics, and (optionally) the geopotential + ! calculation. + ! + ! The transpose from yz to xy decomposition takes place within dynpkg. + ! The xy decomposed variables are then transposed directly to the + ! physics decomposition within d_p_coupling. + ! + ! The xy decomposed variables have names corresponding to the + ! yz decomposed variables: simply append "xy". Thus, "uxy" is the + ! xy decomposed version of "u". + ! + ! This version supports overlap of trac2d and cd_core subcycles (Art Mirin, November 2007). + ! This refers to the subcycles described by the "do n=1,n2" loop and has nothing to + ! do with the "do it=1,nsplit" lower-level subcycling. Each trac2d call (n), other than the last, + ! is overlapped with the subsequent cd_core 'series' (n+1). The controlling namelist variable + ! is ct_overlap. The overlapping trac2d calls are carried out on the second set of + ! npes_yz processes (npes_yz <= iam < 2*npes_yz). The tracer arrays are sent to the + ! auxiliary processes prior to the do n=1,n2 loop. During each subcycle (other than the last), + ! the dp0 array is sent prior to the cd_core series; arrays cx, cy, mfx, mfy are sent directly + ! from cd_core during the last call in the series (it=nsplit). At the completion of the last + ! auxiliary trac2d subcycle (n=n2-1), the updated tracer values are returned to the + ! primary processes; the last tracer subcycle (n=n2) is carried out on the primary processes. + ! Communication calls are nonblocking, with attempt to overlap computation to the extent + ! possible. The CCSM mpi layer (wrap_mpi) is used. Tags with values greater than npes_xy + ! are chosen to avoid possible interference between the messages sent from cd_core and + ! the geopk-related transpose messages called from cd_core thereafter. The auxiliary + ! processes must use values of jfirst, jlast, kfirst, klast corresponding to their primary + ! process antecedents, whereas by design those values are (1,0,1,0), resp. (set in spmdinit_dyn). + ! We therefore add auxiliary subdomain limits to the grid datatype: jfirstct, jlastct, + ! kfirstct, klastct. For the primary processes, these are identical to the actual subdomain + ! limits; for the secondary processes, these correspond to the subdomain limits of the + ! antecedent primary process. These values are communicated to the auxiliary processes + ! during initialization (spmd_vars_init). During the auxiliary calculations (and allocations) + ! we temporarily set jfirst equal to jfirstct (etc.) and when done, restore to the original + ! values. Other information needed by the auxiliary processes is obtained through the grid + ! datatype. + ! + ! This version supports tracer decomposition with trac2d (Art Mirin, January 2008). + ! This option is mutually exclusive with ct_overlap. Variable "trac_decomp" is the size of the + ! decomposition. The tracers are divided into trac_decomp groups, and the kth group is solved + ! on the kth set of npes_yz processes. Much of the methodology is similar to that for ct_overlap. + ! + ! REVISION HISTORY: + ! SJL 99.04.13: Initial SMP version delivered to Will Sawyer + ! WS 99.10.03: 1D MPI completed and tested; + ! WS 99.10.11: Additional documentation + ! WS 99.10.28: benergy and te_map added; arrays pruned + ! SJL 00.01.01: SMP and MPI enhancements; documentation + ! WS 00.07.13: Changed PILGRIM API + ! WS 00.08.28: SPMD instead of MPI_ON + ! AAM 00.08.10: Add kfirst:klast + ! WS 00.12.19: phis now distr., LLNL2DModule initialized here + ! WS 01.02.02: bug fix: parsplit only called for FIRST time + ! WS 01.04.09: Added initialization of ghost regions + ! WS 01.06.10: Removed if(first) section; use module + ! AAM 01.06.27: Extract te_map call into separate routine + ! AAM 01.07.13: Get rid of dynpkg2; recombine te_map; + ! perform forward transposes for 2D decomposition + ! WS 01.12.10: Ghosted PT (changes benergy, cd_core, te_map, hswf) + ! WS 03.08.05: removed vars dcaf, rayf, ideal, call to hswf + ! (idealized physics is now in physics package) + ! WS 03.08.13: Removed ghost region from UXY + ! WS 05.06.11: Inserted into FVCAM_GridCompMod + ! WS 06.03.03: Added dyn_state as argument (for reentrancy) + ! WS 06.06.28: Using new version of benergy + ! TT 16.12.11: AM conservation options + ! TT 17.30.01: dynamic wind increments diagnostic + !----------------------------------------------------------------------- + + + use diag_module, only : compute_vdot_gradp + +#if defined( SPMD ) + use mpishorthand, only: mpir8 + use mod_comm, only: mp_sendirr, mp_recvirr, mp_send4d_ns, & + mp_send3d, mp_recv3d, & + mp_recv4d_ns, mp_sendtrirr, mp_recvtrirr +#endif +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_fields, advance_met, get_us_vs, met_rlx + use pfixer, only: adjust_press +#endif + use metdata, only: met_fix_mass + + use shr_reprosum_mod, only: shr_reprosum_calc + use physconst, only: physconst_calc_kappav + +#if defined( SPMD ) +#include "mpif.h" +#endif + + ! arguments + real(r8), intent(in) :: ptop ! Pressure at model top (interface pres) + integer, intent(in) :: ndt ! the large time step in seconds + ! Also the mapping time step in this setup + + real(r8), intent(out) :: te0 ! Total energy before dynamics + type (T_FVDYCORE_STATE), target :: dyn_state ! Internal state + type (dyn_import_t) :: dyn_in ! Import container + type (dyn_export_t) :: dyn_out ! Export container + + integer, intent(out) :: rc ! Return code + + integer, parameter :: DYN_RUN_SUCCESS = 0 + integer, parameter :: DYN_RUN_FAILURE = -1 + integer, parameter :: DYN_RUN_R4_NOT_SUPPORTED = -10 + integer, parameter :: DYN_RUN_MUST_BE_2D_DECOMP = -20 + real(r8), parameter :: D1_0 = 1.0_r8 + + ! Variables from the dynamics interface (import or export) + + real(r8), pointer :: phisxy(:,:) ! surface geopotential (grav*zs) + real(r8), pointer :: psxy(:,:) ! Surface pressure (pa) + real(r8), pointer :: t3xy(:,:,:) ! temperature (K) + real(r8), pointer :: ptxy(:,:,:) ! scaled (virtual) potential temperature + real(r8), pointer :: delpxy(:,:,:) ! Pressure thickness + real(r8), pointer :: tracer(:,:,:,:) ! Tracers + real(r8), pointer :: uxy(:,:,:) ! u wind velocities, staggered grid + real(r8), pointer :: vxy(:,:,:) ! v wind velocities, staggered grid + + !-------------------------------------------------------------------------------------- + ! The arrays pexy, pkxy, pkzxy must be pre-computed as input to benergy(). + ! They are NOT needed if dyn_state%consv=.F.; updated on output (to be used + ! by physdrv) Please refer to routine pkez on the algorithm for computing pkz + ! from pe and pk + !-------------------------------------------------------------------------------------- + + real(r8), pointer :: pexy(:,:,:) ! Pres at layer edges + real(r8), pointer :: pkxy(:,:,:) ! pe**cappa + real(r8), pointer :: pkzxy(:,:,:) ! finite-volume mean of pk + + ! Export state only variables + real(r8), pointer :: pelnxy(:,:,:) ! Natural logarithm of pe + real(r8), pointer :: omgaxy(:,:,:) ! vertical pressure velocity (pa/sec) + real(r8), pointer :: mfxxy(:,:,:) ! mass flux in X (Pa m^\2 / s) + real(r8), pointer :: mfyxy(:,:,:) ! mass flux in Y (Pa m^\2 / s) + real(r8), pointer :: duxy(:,:,:) ! u tot. tend. from dycore, staggered grid + real(r8), pointer :: dvxy(:,:,:) ! v tot. tend. from dycore, staggered grid + real(r8), pointer :: ucxy(:,:,:) ! u tend. from advection only, staggd grid + real(r8), pointer :: vcxy(:,:,:) ! v tend. from advection only, staggd grid + real(r8), pointer :: dufix_xy(:,:,:) ! u tend. from AM fixer, staggered grid + + ! Other pointers (for convenience) + type (T_FVDYCORE_GRID) , pointer :: GRID ! For convenience + type (T_FVDYCORE_CONSTANTS) , pointer :: CONSTANTS ! For convenience + + ! YZ variables currently allocated on stack... should they be on the heap? + + real(r8) :: ps(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast) + real(r8) :: phis(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast) + real(r8) :: pe(dyn_state%grid%im, & + dyn_state%grid%kfirst:dyn_state%grid%klast+1,& + dyn_state%grid%jfirst:dyn_state%grid%jlast) + real(r8) :: delp(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast,& + dyn_state%grid%kfirst:dyn_state%grid%klast) + real(r8) :: pk(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast,& + dyn_state%grid%kfirst:dyn_state%grid%klast+1) + real(r8) :: pkz(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast, & + dyn_state%grid%kfirst:dyn_state%grid%klast) + real(r8) :: u(dyn_state%grid%im, & + dyn_state%grid%jfirst-dyn_state%grid%ng_d:dyn_state%grid%jlast+dyn_state%grid%ng_s,& + dyn_state%grid%kfirst:dyn_state%grid%klast) + real(r8) :: v(dyn_state%grid%im, & + dyn_state%grid%jfirst-dyn_state%grid%ng_s:dyn_state%grid%jlast+dyn_state%grid%ng_d,& + dyn_state%grid%kfirst:dyn_state%grid%klast) + real(r8) :: pt(dyn_state%grid%im, & + dyn_state%grid%jfirst-dyn_state%grid%ng_d:dyn_state%grid%jlast+dyn_state%grid%ng_d,& + dyn_state%grid%kfirst:dyn_state%grid%klast) + + real(r8) :: pi + real(r8) :: om ! angular velocity of earth's rotation + real(r8) :: cp ! heat capacity of air at constant pressure + real(r8) :: ae ! radius of the earth (m) + + real(r8) :: rair ! Gas constant of the air + real(r8) :: cappa ! R/Cp + real(r8) :: zvir ! Virtual effect constant ( = rwv/rair-1 ) + + logical :: consv ! Energy conserved? + + integer :: im ! dimension in east-west + integer :: jm ! dimension in North-South + integer :: km ! number of Lagrangian layers + integer :: jfirst ! starting latitude index for MPI + integer :: jlast ! ending latitude index for MPI + integer :: kfirst ! starting vertical index for MPI + integer :: klast ! ending vertical index for MPI + integer :: ntotq ! total # of tracers to be advected + integer :: iord ! parameter controlling monotonicity in E-W + ! recommendation: iord=4 + integer :: jord ! parameter controlling monotonicity in N-S + ! recommendation: jord=4 + integer :: kord ! parameter controlling monotonicity in mapping + ! recommendation: kord=4 + integer :: icd ! X algorithm order on C-grid + integer :: jcd ! Y algorithm order on C-grid + integer :: ng_d ! Ghosting width on D-grid + integer :: ng_s ! Ghosting width (staggered, for winds) + integer :: ns ! overall split + integer :: div24del2flag + real(r8):: del2coef + + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy ! xy decomposition + integer :: npr_z + + logical :: cd_penul + + real(r8), allocatable, target :: q_internal(:,:,:,:) ! Pointers to tracers + integer i, j, k, iq ! Loop indicies + real(r8) umax ! Maximum winds, m/s + parameter (umax = 300.0_r8) + + integer nx ! # of split pieces in x-direction; for performance, the +#if defined( UNICOSMP ) + parameter (nx = 1) +#else + parameter (nx = 4) ! user may set nx=1 if there is NO shared memory multitasking +#endif + integer :: ipe, it, iv + integer :: nsplit, n, n2, nv + integer :: mq + + ! Move the following 3D arrays to an initialization routine? + real(r8), allocatable :: worka(:,:,:),workb(:,:,:),dp0(:,:,:),cx(:,:,:),cy(:,:,:) + real(r8), allocatable :: mfx(:,:,:), mfy(:,:,:) + real(r8), allocatable :: delpf(:,:,:), uc(:,:,:), vc(:,:,:) + real(r8), allocatable :: dwz(:,:,:), pkc(:,:,:), wz(:,:,:) + real(r8), allocatable :: dpt(:,:,:) + real(r8), allocatable :: pkcc(:,:,:), wzc(:,:,:) + + ! The following variables are work arrays for xy=>yz transpose + real(r8), allocatable :: pkkp(:,:,:), wzkp(:,:,:) + + ! The following variables are xy instantiations + real(r8), allocatable :: tempxy(:,:,:), dp0xy(:,:,:), wzxy(:,:,:) + + ! psxy3 is dummy 3d variant of psxy + real(r8), allocatable :: psxy3(:,:,:) + + ! phisxy3 is dummy 3d variant of phisxy + real(r8), allocatable :: phisxy3(:,:,:) + real(r8), pointer :: q3xypt(:,:,:) + real(r8), pointer :: q3yzpt(:,:,:) + real(r8) :: tte(dyn_state%grid%jm) + real(r8) :: XXX(dyn_state%grid%km) + +#if ( defined OFFLINE_DYN ) + real(r8), allocatable :: ps_obs(:,:) + real(r8), allocatable :: ps_mod(:,:) + real(r8), allocatable :: u_tmp(:,:,:) + real(r8), allocatable :: v_tmp(:,:,:) +#endif + + logical :: fill + + real(r8) :: dt + real(r8) :: bdt + integer :: filtcw + integer :: ct_overlap + integer :: trac_decomp + + integer modc_tracers, mlast + + ! cd_core / trac2d overlap and tracer decomposition data (AAM) + integer :: commnyz ! n*npes_yz communicator + integer :: jfirstct, jlastct, kfirstct, klastct ! primary subdomain limits + integer :: jkstore(4) ! storage for subdomain limits + integer :: iamlocal ! task number (global indexing) + integer :: iremotea(dyn_state%grid%trac_decomp) ! source/target; id array + integer :: iremote ! source/target; working id + integer :: ndp0, ncx, ncy, nmfx, nmfy, ntrac ! message sizes + integer :: dp0tag, cxtag, cytag, mfxtag, mfytag, tractag ! message tags + integer :: cxtaga(dyn_state%grid%trac_decomp) ! tag arrays for cd_core + integer :: cytaga(dyn_state%grid%trac_decomp) ! tag arrays for cd_core + integer :: mfxtaga(dyn_state%grid%trac_decomp) ! tag arrays for cd_core + integer :: mfytaga(dyn_state%grid%trac_decomp) ! tag arrays for cd_core + logical :: ct_aux ! true if auxiliary process + logical :: s_trac ! true for cd_core posting tracer-related sends + integer, allocatable :: ctreq(:,:) ! used for nonblocking receive + integer, allocatable :: ctstat(:,:,:) ! used for nonblocking receive + integer, allocatable :: ctreqs(:,:) ! used for nonblocking send + integer, allocatable :: ctstats(:,:,:) ! used for nonblocking send + integer, allocatable :: cdcreqs(:,:) ! used for nonblocking send in cd_core + integer, pointer :: ktloa(:) ! lower limit of tracer decomposition (global) + integer, pointer :: kthia(:) ! upper limit of tracer decomposition (global) + integer ktlo ! lower limit of tracer decomposition (local) + integer kthi ! upper limit of tracer decomposition (local) + integer kt, tagu, naux, kaux, ntg0 + + logical :: print_subcycling = .true. + logical :: c_dotrac, t_dotrac + logical :: convt_local + + data fill /.true./ ! perform a simple filling algorithm + ! in case negatives were found + + ! C.-C. Chen, omega calculation + real(r8) :: cx_om(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast, & + dyn_state%grid%kfirst:dyn_state%grid%klast) ! Courant no. in X + real(r8) :: cy_om(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast+1, & + dyn_state%grid%kfirst:dyn_state%grid%klast) ! Courant no. in Y + real(r8) :: pexy_om(dyn_state%grid%ifirstxy:dyn_state%grid%ilastxy,dyn_state%grid%km+1, & + dyn_state%grid%jfirstxy:dyn_state%grid%jlastxy) + + ! Non-constant air properties for high top models (waccmx). + real(r8) :: cap3vi(dyn_state%grid%ifirstxy:dyn_state%grid%ilastxy,& + dyn_state%grid%jfirstxy:dyn_state%grid%jlastxy,dyn_state%grid%km+1) + real(r8) :: cp3vc (dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast,& + dyn_state%grid%kfirst:dyn_state%grid%klast) !C_p on yz + real(r8) :: cap3vc(dyn_state%grid%im,dyn_state%grid%jfirst:dyn_state%grid%jlast,& + dyn_state%grid%kfirst:dyn_state%grid%klast) !cappa on yz + + real(r8), dimension(dyn_state%grid%ifirstxy:dyn_state%grid%ilastxy,& + dyn_state%grid%jfirstxy:dyn_state%grid%jlastxy,dyn_state%grid%km) :: & + cp3v,cap3v + logical :: high_alt + + ! angular momentum (AM) conservation + logical :: am_correction ! apply AM correction? + logical :: am_fixer ! apply AM fixer? + logical :: am_fix_lbl ! apply fixer separately on each shallow-water layer? + logical :: am_fix_taper=.false. ! def. no tapering; modified if global fixer applied or high_order_top=.false. + real(r8) :: tmpsum(1,2) + real(r8) :: tmpresult(2) + real(r8) :: am0, am1, me0 + + real(r8) :: don(dyn_state%grid%jm,dyn_state%grid%km), & ! out of cd_core + dod(dyn_state%grid%jm,dyn_state%grid%km) ! out of cd_core + real(r8) :: dons(dyn_state%grid%km), & ! sums over j + dods(dyn_state%grid%km) + + real(r8), allocatable :: zpkck(:,:) + real(r8) :: avgpk(dyn_state%grid%km) + real(r8) :: taper(dyn_state%grid%km) + real(r8) :: ptapk, xdlt2 + real(r8), parameter :: ptap =9000._r8 + real(r8), parameter :: dptap=1000._r8 + real(r8), parameter :: tiny=.1e-10_r8 + + ! AM diagnostics + logical :: am_diag ! enable angular momentum diagnostic output + logical :: am_fix_out + integer :: kmtp ! range of levels (1:kmtp) where order is reduced + real(r8) :: ame(dyn_state%grid%jm) + real(r8) :: zpe(dyn_state%grid%jfirstxy:dyn_state%grid%jlastxy) + real(r8) :: tmp + real(r8) :: du_fix_g + real(r8) :: du_fix(dyn_state%grid%km) + real(r8) :: du_fix_s(dyn_state%grid%km) + real(r8), allocatable :: du_fix_i(:,:,:) + real(r8), allocatable :: du_k (:,:) + real(r8), allocatable :: du_north(:,:) + real(r8), allocatable :: uc_s(:,:,:),vc_s(:,:,:) ! workspace (accumulated uc,vc) + real(r8), allocatable :: uc_i(:,:,:),vc_i(:,:,:) ! workspace (transposed uc_s,vc_s) + + + ! NOTE -- model behaviour with high_order_top=true is still under validation and may require + ! some other form of enhanced damping in the top layer + logical, parameter :: high_order_top=.false. + + !-------------------------------------------------------------------------------------- + kmtp=dyn_state%grid%km/8 + + rc = DYN_RUN_FAILURE ! Set initially to fail + + phisxy => dyn_in%phis + psxy => dyn_in%ps + uxy => dyn_in%u3s + vxy => dyn_in%v3s + t3xy => dyn_in%t3 + ptxy => dyn_in%pt + delpxy => dyn_in%delp + tracer => dyn_in%tracer + pexy => dyn_in%pe + pkxy => dyn_in%pk + pkzxy => dyn_in%pkz + + pelnxy => dyn_out%peln + omgaxy => dyn_out%omga + mfxxy => dyn_out%mfx + mfyxy => dyn_out%mfy + duxy => dyn_out%du3s + dvxy => dyn_out%dv3s + ucxy => dyn_out%dua3s + vcxy => dyn_out%dva3s + dufix_xy => dyn_out%duf3s + + grid => dyn_state%grid ! For convenience + constants => DYN_STATE%CONSTANTS + + ns = dyn_state%nsplit ! large split (will be subdivided later) + n2 = dyn_state%nspltrac ! tracer split(will be subdivided later) + nv = dyn_state%nspltvrm ! vertical re-mapping split + icd = dyn_state%icd + jcd = dyn_state%jcd + iord = dyn_state%iord + jord = dyn_state%jord + kord = dyn_state%kord + div24del2flag = dyn_state%div24del2flag + del2coef = dyn_state%del2coef + filtcw = dyn_state%filtcw + high_alt = grid%high_alt + + consv = dyn_state%consv + am_correction = dyn_state%am_correction + am_fixer = dyn_state%am_fixer + am_fix_lbl = dyn_state%am_fix_lbl + am_diag = dyn_state%am_diag + + pi = constants%pi + om = constants%omega + ae = constants%ae + rair = constants%rair + cp = constants%cp + cappa= constants%cappa + zvir = constants%zvir + + im = grid%im + jm = grid%jm + km = grid%km + + ng_d = grid%ng_d + ng_s = grid%ng_s + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + ntotq = grid%ntotq + modc_tracers = grid%modc_tracers + + npr_z = grid%npr_z + + ! cd_core/trac2d overlap and tracer decomposition + ct_overlap = grid%ct_overlap + trac_decomp = grid%trac_decomp + jfirstct = grid%jfirstct + jlastct = grid%jlastct + kfirstct = grid%kfirstct + klastct = grid%klastct + commnyz = grid%commnyz + iamlocal = grid%iam + + ! kaux is an index describing the set of npes_yz processes; 0 for first set, 1 for second set, etc. + kaux = iamlocal/grid%npes_yz + + ! ct_aux is true if current process is auxiliary, false otherwise + ct_aux = ((ct_overlap .gt. 0 .and. kaux .eq. 1) .or. & + (trac_decomp .gt. 1 .and. kaux .ge. 1 .and. kaux .lt. trac_decomp)) + + ! define message tags to exceed npes_xy so as not to interfere with geopotential transpose tags + ! tags below correspond to communicated variables with ct_overlap and trac_decomp + dp0tag = grid%npes_xy + 5 + cxtag = dp0tag + 1 + cytag = dp0tag + 2 + mfxtag = dp0tag + 3 + mfytag = dp0tag + 4 + tractag = dp0tag + 5 + + ! ntg0 is upper bound on number of needed tags beyond tracer tags for ct_overlap and trac_decomp + ntg0 = 10 + + ! set am_fix tapering parameters + if (am_fixer.and..not.am_fix_lbl) then + am_fix_taper = .true. ! always apply tapering with global fixer + ptapk = ptap**constants%cappa + xdlt2 = 2._r8/(log((ptap+.5_r8*dptap)/(ptap-.5_r8*dptap))*constants%cappa) + end if + +#if ( defined OFFLINE_DYN ) + + ! advance the meteorology data + call advance_met(grid) + + ! set the staggered winds (verticity winds) to offline meteorological data + call get_us_vs( grid, u, v ) +#endif + + if (high_alt) then + call physconst_calc_kappav(ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, tracer, cap3v, cpv=cp3v ) + else + cp3v = cp + cp3vc = cp + cap3v = cappa + cap3vi= cappa + cap3vc= cappa + endif + + if ( km > 1 ) then ! not shallow water equations + + if (consv) then + + if (grid%iam .lt. grid%npes_xy) then + + ! Tests indicate that t3 does not have consistent + ! pole values, e.g. t3(:,1,k) are not all the same. + ! Not clear why this is not the case: it may be that the pole + ! values are not consistent on the restart file. For the time being, + ! perform a parallel sum over t3 and correct the pole values + + if ( jfirstxy == 1 ) then + call par_xsum(grid, t3xy(:,1,:), km, XXX) + do k = 1, km + do i = ifirstxy, ilastxy + t3xy(i,1,k) = XXX(k) / real(im,r8) + end do + end do + end if + + if ( jlastxy == jm ) then + call par_xsum(grid, t3xy(:,jm,:), km, XXX) + do k = 1, km + do i = ifirstxy, ilastxy + t3xy(i,jm,k) = XXX(k) / real(im,r8) + end do + end do + end if + + if (consv) then + ! Compute globally integrated Total Energy (te0) + call t_startf ('benergy') + + call benergy(grid, uxy, vxy, t3xy, delpxy, & + tracer(:,:,:,1), pexy, pelnxy, phisxy, & + zvir, cp, rair, tte, te0) + + call t_stopf('benergy') + end if + + end if + end if + end if + + + ! Allocate temporary work arrays + ! Change later to use pointers for SMP performance??? + ! (prime candidates: uc, vc, delpf) + + call t_startf ('dyn_run_alloc') + + if (ct_aux) then + ! Temporarily set subdomain limits in auxiliary process equal to those of antecedent + ! to allow following arrays to have proper size + ! (Normally, sizes of unneeded arrays for auxiliary processes will be deliberately small.) + jkstore(1) = jfirst + jkstore(2) = jlast + jkstore(3) = kfirst + jkstore(4) = klast + jfirst = jfirstct + jlast = jlastct + kfirst = kfirstct + klast = klastct + endif + + allocate( worka(im,jfirst: jlast, kfirst:klast) ) + allocate( workb(im,jfirst: jlast, kfirst:klast) ) + allocate( dp0(im,jfirst-1: jlast, kfirst:klast) ) + allocate( mfx(im,jfirst: jlast, kfirst:klast) ) + allocate( mfy(im,jfirst: jlast+1, kfirst:klast) ) + allocate( cx(im,jfirst-ng_d:jlast+ng_d,kfirst:klast) ) + allocate( cy(im,jfirst: jlast+1, kfirst:klast) ) + dp0(:,:,:) = 0._r8 + mfx(:,:,:) = 0._r8 + mfy(:,:,:) = 0._r8 + cx(:,:,:) = 0._r8 + cy(:,:,:) = 0._r8 + + if (ct_aux) then + ! Restore subdomain limits in auxiliary process + jfirst = jkstore(1) + jlast = jkstore(2) + kfirst = jkstore(3) + klast = jkstore(4) + endif + + allocate( delpf(im,jfirst-ng_d:jlast+ng_d,kfirst:klast) ) + allocate( uc(im,jfirst-ng_d:jlast+ng_d,kfirst:klast) ) + allocate( vc(im,jfirst-2: jlast+2, kfirst:klast) ) + allocate( dpt(im,jfirst-1: jlast+1, kfirst:klast) ) + allocate( dwz(im,jfirst-1: jlast, kfirst:klast+1) ) + allocate( pkc(im,jfirst-1: jlast+1, kfirst:klast+1) ) + allocate( wz(im,jfirst-1: jlast+1, kfirst:klast+1) ) + allocate( pkcc(im,jfirst : jlast , kfirst:klast+1) ) + allocate( wzc(im,jfirst : jlast , kfirst:klast+1) ) + allocate(pkkp(im,jfirst:jlast,kfirst:klast+1)) + allocate(wzkp(im,jfirst:jlast,kfirst:klast+1)) + allocate(wzxy(ifirstxy:ilastxy,jfirstxy:jlastxy,km+1)) + allocate(tempxy(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + allocate(dp0xy(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + allocate(psxy3(ifirstxy:ilastxy,jfirstxy:jlastxy,npr_z)) + allocate(phisxy3(ifirstxy:ilastxy,jfirstxy:jlastxy,npr_z)) + +#if ( defined OFFLINE_DYN ) + allocate( ps_obs(im,jfirst:jlast) ) + allocate( ps_mod(im,jfirst:jlast) ) + allocate( u_tmp(im,jfirst-ng_d:jlast+ng_s,kfirst:klast) ) + allocate( v_tmp(im,jfirst-ng_s:jlast+ng_d,kfirst:klast) ) +#endif + + + ! Allocation of tracers + + if (ct_aux) then + ! Temporarily set subdomain limits in auxiliary process equal to those of antecedent + ! to allow trac2d temporary storage to have proper size + jfirst = jfirstct + jlast = jlastct + kfirst = kfirstct + klast = klastct + end if + allocate ( q_internal(im, jfirst:jlast, kfirst:klast, ntotq) ) + + ! Trac2d-related mpi quantities for ct_overlap and tracer decomposition + allocate (ctreq(ntotq+ntg0,trac_decomp)) + allocate (ctreqs(ntotq+ntg0,trac_decomp)) + allocate (cdcreqs(trac_decomp,4)) + cdcreqs(:,:) = 0 +#if defined(SPMD) + allocate (ctstat(MPI_STATUS_SIZE,ntotq+ntg0,trac_decomp)) + allocate (ctstats(MPI_STATUS_SIZE,ntotq+ntg0,trac_decomp)) +#endif + + ! Allocate the variables used in tapering + if (am_fix_taper) then + allocate(zpkck(dyn_state%grid%jm,dyn_state%grid%km)) + end if + + ! Allocate fields required for dycore diagnostic + if (am_fixer .or. am_diag) then + allocate(du_fix_i(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + allocate(du_k (ifirstxy:ilastxy,jfirstxy:jlastxy+1)) + allocate(du_north(ifirstxy:ilastxy,km)) + allocate(uc_s(im,jfirst-ng_d:jlast+ng_s,kfirst:klast) ) + allocate(vc_s(im,jfirst-ng_s:jlast+ng_d,kfirst:klast) ) + allocate(uc_i(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + allocate(vc_i(ifirstxy:ilastxy,jfirstxy:jlastxy,km)) + du_fix_i(:,:,:) = 0._r8 + uc_s (:,:,:) = 0._r8 + vc_s (:,:,:) = 0._r8 + end if + + ! Compute i.d.'s of remote processes for ct_overlap or trac_decomp + naux = 0 + if ((ct_overlap .gt. 0 .and. kaux .lt. 2) .or. & + (trac_decomp .gt. 1 .and. kaux .lt. trac_decomp)) then + + ! Identify involved processes + iremotea(:) = -1 + naux = max(1,trac_decomp-1) + + if (kaux .eq. 0) then + + ! Primary process - identify corresponding auxiliary process(es) + do kt = 1, naux + iremotea(kt) = iamlocal + kt*grid%npes_yz + cxtaga(kt) = cxtag + (kt-1)*(ntotq+ntg0) + cytaga(kt) = cytag + (kt-1)*(ntotq+ntg0) + mfxtaga(kt) = mfxtag + (kt-1)*(ntotq+ntg0) + mfytaga(kt) = mfytag + (kt-1)*(ntotq+ntg0) + end do + else + + ! Auxiliary process - identify corresponding primary process + iremotea(1) = iamlocal - kaux*grid%npes_yz + end if + iremote = iremotea(1) + ! Message sizes + ndp0 = im*(jlast-jfirst+2 )*(klast-kfirst+1) + ncx = im*(jlast-jfirst+2*ng_d+1)*(klast-kfirst+1) + ncy = im*(jlast-jfirst+2 )*(klast-kfirst+1) + nmfx = im*(jlast-jfirst+1 )*(klast-kfirst+1) + nmfy = im*(jlast-jfirst+2 )*(klast-kfirst+1) + ntrac = im*(jlast-jfirst+1 )*(klast-kfirst+1) + end if + + if (ct_aux) then + ! Restore subdomain limits in auxiliary process + jfirst = jkstore(1) + jlast = jkstore(2) + kfirst = jkstore(3) + klast = jkstore(4) + end if + + ! Set tracer limits to be supplied to trac2d (needed even without tracer decomposition) + ktloa => grid%ktloa + kthia => grid%kthia + ktlo = grid%ktlo + kthi = grid%kthi + + call t_stopf ('dyn_run_alloc') + + ! Determine splitting + bdt = ndt + + ! Second/third level splitting (nsplit and n2 variables overloaded) + n2 = (n2+nv -1) / nv + nsplit = (ns+n2*nv-1) / (n2*nv) + dt = bdt / real(nsplit*n2*nv,r8) + + if (print_subcycling) then + print_subcycling = .false. + if (masterproc) then + write(iulog,*) 'FV subcycling - nv, n2, nsplit, dt = ', nv, n2, nsplit, dt + if ( (nsplit*n2*nv /= dyn_state%nsplit) .or. (n2*nv /= dyn_state%nspltrac) ) then + write(iulog,*) "ERROR: Because of loop nesting, FV dycore can't use the specified namelist settings for subcycling" + write(iulog,*) ' The original namelist settings were:' + write(iulog,*) ' fv_nsplit = ', dyn_state%nsplit + write(iulog,*) ' fv_nspltrac = ', dyn_state%nspltrac + if( dyn_state%nspltvrm /= 1 ) write(iulog,*) ' fv_nspltvrm = ', dyn_state%nspltvrm + write(iulog,*) + write(iulog,*) ' fv_nsplit needs to be a multiple of fv_nspltrac' + if( dyn_state%nspltvrm /= 1 ) write(iulog,*) ' which in turn needs to be a multiple of fv_nspltvrm.' + write(iulog,*) ' Suggested settings would be:' + write(iulog,*) ' fv_nsplit = ', nsplit*n2*nv + write(iulog,*) ' fv_nspltrac = ', n2*nv + if( dyn_state%nspltvrm /= 1 ) write(iulog,*) ' fv_nspltvrm = ', nv + call endrun("Bad namelist settings for FV subcycling.") + end if + end if + end if + + ! IF convt_local is false, pt is updated for the next iteration of the iv=1,nv loop + ! On the last iteration, convt_local is set to convt + convt_local = .false. + + ! initialise global non-conservation integrals + am1=0._r8 + me0=1._r8 + + if (am_fixer.or.am_diag) then + du_fix_g = 0._r8 + du_fix(:) = 0._r8 + du_fix_s(:) = 0._r8 + dufix_xy(:,:,:) = 0._r8 + end if + + if (am_diag) then + ucxy = 0._r8 + vcxy = 0._r8 + +!$omp parallel do private(i,j,k) + ! store old winds to get total increments + do k = 1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + duxy(i,j,k)=uxy(i,j,k) + dvxy(i,j,k)=vxy(i,j,k) + enddo + enddo + enddo + end if + + ! Begin vertical re-mapping sub-cycle loop + do iv = 1, nv + + if (iv == nv) convt_local = convt + + ! Transpose XY arrays to YZ + call t_barrierf('sync_xy_to_yz_1', grid%commdyn) + call t_startf ('xy_to_yz') + + if (grid%iam .lt. grid%npes_xy) then + + if (grid%twod_decomp .eq. 1) then + +#if defined( SPMD ) + + +!$omp parallel do private(i,j,k) + ! Embed psxy and phisxy in 3D array since transpose machinery cannot handle 2D arrays + do k = 1, npr_z + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + psxy3(i,j,k) = psxy(i,j) + phisxy3(i,j,k) = phisxy(i,j) + end do + end do + end do + + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, psxy3, ps, & + modc=grid%modc_dynrun ) + call mp_recvirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, psxy3, ps, & + modc=grid%modc_dynrun ) + + call mp_sendirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, phisxy3, phis, & + modc=grid%modc_dynrun ) + call mp_recvirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, phisxy3, phis, & + modc=grid%modc_dynrun ) + else + call mp_sendirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, psxy3, ps, & + phisxy3, phis, & + modc=grid%modc_dynrun ) + call mp_recvirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, psxy3, ps, & + phisxy3, phis, & + modc=grid%modc_dynrun ) + end if + + ! if OFFLINE_DYN is defined, u and v are filled at this point + +#if defined( OFFLINE_DYN ) + call mp_sendirr( grid%commxy, grid%uxy_to_u%SendDesc, & + grid%uxy_to_u%RecvDesc, uxy, u_tmp, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%uxy_to_u%SendDesc, & + grid%uxy_to_u%RecvDesc, uxy, u_tmp, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%vxy_to_v%SendDesc, & + grid%vxy_to_v%RecvDesc, vxy, v_tmp, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%vxy_to_v%SendDesc, & + grid%vxy_to_v%RecvDesc, vxy, v_tmp, & + modc=grid%modc_dynrun ) + +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + u(i,j,k) = (1._r8-met_rlx(k))*u_tmp(i,j,k) + met_rlx(k)*u(i,j,k) + v(i,j,k) = (1._r8-met_rlx(k))*v_tmp(i,j,k) + met_rlx(k)*v(i,j,k) + end do + end do + end do +#else + call mp_sendirr( grid%commxy, grid%uxy_to_u%SendDesc, & + grid%uxy_to_u%RecvDesc, uxy, u, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%uxy_to_u%SendDesc, & + grid%uxy_to_u%RecvDesc, uxy, u, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%vxy_to_v%SendDesc, & + grid%vxy_to_v%RecvDesc, vxy, v, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%vxy_to_v%SendDesc, & + grid%vxy_to_v%RecvDesc, vxy, v, & + modc=grid%modc_dynrun ) +#endif + + call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, delpxy, delp, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, delpxy, delp, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pk, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & + grid%pkxy_to_pkc%RecvDesc, pkxy, pk, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%ptxy_to_pt%SendDesc, & + grid%ptxy_to_pt%RecvDesc, ptxy, pt, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ptxy_to_pt%SendDesc, & + grid%ptxy_to_pt%RecvDesc, ptxy, pt, & + modc=grid%modc_dynrun ) + if (high_alt) then + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, cp3v, cp3vc, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, cp3v, cp3vc, & + modc=grid%modc_dynrun ) + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, cap3v, cap3vc, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, cap3v, cap3vc, & + modc=grid%modc_dynrun ) + endif + + if (modc_tracers .eq. 0) then + do mq = 1, ntotq + q3xypt => tracer(:,:,:,mq) + q3yzpt => q_internal(:,:,:,mq) + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, q3xypt, q3yzpt, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, q3xypt, q3yzpt, & + modc=grid%modc_dynrun ) + end do + else + do mq = 1, ntotq, modc_tracers + mlast = min(mq+modc_tracers-1,ntotq) + call mp_sendtrirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, tracer, q_internal, mq, mlast, ntotq, & + grid%ifirstxy, grid%ilastxy, grid%jfirstxy, grid%jlastxy, & + 1, grid%km, & + 1, grid%im, grid%jfirst, grid%jlast, grid%kfirst, grid%klast, & + modc=grid%modc_tracer ) + call mp_recvtrirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, tracer, q_internal, mq, mlast, ntotq, & + grid%ifirstxy, grid%ilastxy, grid%jfirstxy, grid%jlastxy, & + 1, grid%km, & + 1, grid%im, grid%jfirst, grid%jlast, grid%kfirst, grid%klast, & + modc=grid%modc_tracer ) + end do + end if + +#else + write(iulog,*)'DYN_COMP:dyn_run -- SPMD must be defined for 2D decomp -- returning' + rc = DYN_RUN_MUST_BE_2D_DECOMP + return ! Not possible to have 2D decomposition with SPMD undefined +#endif + else ! if not twod_decomp + + do j = jfirst, jlast + do i = 1, im + ps(i,j) = psxy(i,j) + phis(i,j) = phisxy(i,j) + end do + end do + +!$omp parallel do private(i,j,k) + do j = jfirst, jlast + do k = 1, km+1 + do i = 1, im + pe(i,k,j) = pexy(i,k,j) + end do + end do + end do + +!$omp parallel do private(i,j,k) + do k = 1, km+1 + do j = jfirst, jlast + do i = 1, im + pk(i,j,k) = pkxy(i,j,k) + end do + end do + end do + +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirst, jlast + do i = 1, im +#if defined( OFFLINE_DYN ) + u(i,j,k) = (1._r8-met_rlx(k))*uxy(i,j,k) + met_rlx(k)*u(i,j,k) + v(i,j,k) = (1._r8-met_rlx(k))*vxy(i,j,k) + met_rlx(k)*v(i,j,k) +#else + u(i,j,k) = uxy(i,j,k) + v(i,j,k) = vxy(i,j,k) +#endif + delp(i,j,k) = delpxy(i,j,k) + pt(i,j,k) = ptxy(i,j,k) + end do + end do + end do + if (high_alt) then +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirst, jlast + do i = 1, im + cp3vc(i,j,k) = cp3v(i,j,k) + cap3vc(i,j,k) = cap3v(i,j,k) + end do + end do + end do + endif + + do mq = 1, ntotq + + ! For now just copy in the contents of tracer; later, use pointers + ! TODO: q_internal(mq) => tracer(mq) ! Make sure not to allocate q_internal in this case + + q_internal(1:im,jfirst:jlast,kfirst:klast,mq) = & + tracer(1:im,jfirst:jlast,kfirst:klast,mq) + end do + + end if ! (grid%twod_decomp .eq. 1) + + end if ! (grid%iam .lt. grid%npes_xy) + +#if defined(SPMD) + + ! Send tracers to auxiliary processes when overlapping + if (ct_overlap .gt. 0 .and. n2 .gt. 1 .and. kaux .eq. 0) then + do iq = 1, ntotq + call mpiisend(q_internal(:,:,:,iq), ntrac, mpir8, iremote, tractag+iq-1, commnyz, ctreqs(5+iq,1)) + end do + end if + + ! Send tracers to auxiliary processes when decomposing + if (trac_decomp .gt. 1 .and. kaux .eq. 0) then + do kt = 2, trac_decomp + do iq = ktloa(kt), kthia(kt) + tagu = tractag+iq-1 + (kt-2)*(ntotq+ntg0) + call mpiisend(q_internal(:,:,:,iq), ntrac, mpir8, iremotea(kt-1), tagu, commnyz, ctreqs(5+iq,kt-1)) + end do + end do + end if +#endif + + call t_stopf ('xy_to_yz') + + omgaxy(:,:,:) = 0._r8 + + if (am_fixer .or. am_diag) then + du_fix_s (:) = 0._r8 + uc_s (:,:,:) = 0._r8 + vc_s (:,:,:) = 0._r8 + endif + + ! Begin tracer sub-cycle loop + do n = 1, n2 + + if (ntotq > 0) then + + call t_barrierf('sync_small_ts_init', grid%commdyn) + call t_startf('small_ts_init') + +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + ! Save initial delp field before the small-time-step + ! Initialize the CFL number accumulators: (cx, cy) + ! Initialize total mass fluxes: (mfx, mfy) + dp0(i,j,k) = delp(i,j,k) + cx(i,j,k) = 0._r8 + cy(i,j,k) = 0._r8 + mfx(i,j,k) = 0._r8 + mfy(i,j,k) = 0._r8 + end do + end do + end do + +#if defined( SPMD ) + if (grid%iam .lt. grid%npes_yz) then + call mp_send4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, klast, 1, 0, dp0 ) + call mp_recv4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, klast, 1, 0, dp0 ) + end if +#endif + + call t_stopf ('small_ts_init') + + end if ! (ntotq > 0) + +#if defined(SPMD) + + ! Send dp0 to auxiliary processes when overlapping or tracer decomposition + if (kaux .eq. 0) then + if (ct_overlap .gt. 0 .and. n .lt. n2) then + call mpiisend(dp0, ndp0, mpir8, iremote, dp0tag, commnyz, ctreqs(1,1)) + end if + + if (trac_decomp .gt. 1) then + do kt = 2, trac_decomp + tagu = dp0tag + (kt-2)*(ntotq+ntg0) + call mpiisend(dp0, ndp0, mpir8, iremotea(kt-1), tagu, commnyz, ctreqs(1,kt-1)) + end do + end if + end if +#endif + + ! Begin dynamics sub-cycle loop + do it = 1, nsplit + + if (it == nsplit .and. n == n2) then + ipe = 1 ! end of cd_core; output pexy for te_map + else if (it == 1 .and. n == 1) then + ipe = -1 ! start of cd_core + else + ipe = 0 + end if + + ! determine whether this is the second to last call to cd_core or not + cd_penul = .false. + if ( nsplit > 1 ) then + if ( (n == n2) .and. (it == nsplit-1) ) cd_penul = .true. + else if ( n2 > 1 ) then + if ( n == n2-1 ) cd_penul = .true. + end if + + if (cd_penul) then + if (ipe == -1) then + ipe = -2 ! second to last is also the first + else + ipe = 2 + end if + end if + + ! s_trac is true if cd_core is to post sends for ct_overlap or trac_decomp + ! such sends are posted during last inner cd_core subcycle + s_trac = ((ct_overlap .gt. 0 .and. it .eq. nsplit .and. n .lt. n2) .or. & + (trac_decomp .gt. 1 .and. it .eq. nsplit)) + + + if ((it == nsplit) .and. (n == n2) .and. (iv == nv)) then +!$omp parallel do private(j) + do j = jfirstxy, jlastxy + pexy_om(ifirstxy:ilastxy,1:km+1,j) = pexy(ifirstxy:ilastxy,1:km+1,j) + end do + end if + + ! Call the Lagrangian dynamical core using small tme step + + call t_barrierf('sync_cd_core', grid%commdyn) + call t_startf ('cd_core') + + if (grid%iam .lt. grid%npes_yz) then + am_fix_out = am_fixer .or. am_diag + call cd_core(grid, nx, u, v, pt, & + delp, pe, pk, nsplit, dt, & + ptop, umax, pi, ae, & + cp3vc, cap3vc, cp3v, cap3v, & + icd, jcd, iord, jord, ipe, & + div24del2flag, del2coef, & + om, phis, cx , cy, mfx, mfy, & + delpf, uc, vc, pkz, dpt, worka, & + dwz, pkc, wz, phisxy, ptxy, pkxy, & + pexy, pkcc, wzc, wzxy, delpxy, & + pkkp, wzkp, cx_om, cy_om, filtcw, s_trac, & + naux, ncx, ncy, nmfx, nmfy, iremotea, & + cxtaga, cytaga, mfxtaga, mfytaga, cdcreqs(1,1), & + cdcreqs(1,2), cdcreqs(1,3), cdcreqs(1,4), & + kmtp, & + am_correction, am_fix_out, dod, don ,high_order_top) + + ctreqs(2,:) = cdcreqs(:,1) + ctreqs(3,:) = cdcreqs(:,2) + ctreqs(4,:) = cdcreqs(:,3) + ctreqs(5,:) = cdcreqs(:,4) + end if ! (grid%iam .lt. grid%npes_yz) + + call t_stopf ('cd_core') + + ! AM fixer + if (am_fixer.or.am_diag) then + + call t_barrierf('sync_lfix', grid%commdyn) + call t_startf ('lfix') + if (grid%iam .lt. grid%npes_yz) then + + ! option for pressure tapering on AM fixer + if (am_fix_taper) then + zpkck(:,:)=0._r8 +!$omp parallel do private(j, k) + do k=kfirst,klast + do j = jfirst, jlast + zpkck(j,k)=0.25_r8*sum(pkc(:,j,k))*grid%cose(j) + enddo + enddo + do k=kfirst,klast + call par_vecsum(jm, jfirst, jlast, zpkck(1:jm,k), me0, grid%comm_y, grid%npr_y) + avgpk(k)=me0/im/sum(grid%cose) + taper(k)=.5_r8*(1._r8+(1._r8-(ptapk/avgpk(k))**xdlt2)/(1._r8+(ptapk/avgpk(k))**xdlt2)) + enddo + else + do k=kfirst,klast + taper(k)=1._r8 + enddo + endif + + ! always exclude fixer at top levels if top is not high order + if (.not.high_order_top) then + taper(1:kmtp)=0._r8 + endif + + do k = kfirst, klast + call par_vecsum(jm, jfirst, jlast, don(1:jm,k), am1, grid%comm_y, grid%npr_y) + dons(k) = am1 + end do + + do k = kfirst, klast + call par_vecsum(jm, jfirst, jlast, dod(1:jm,k), me0, grid%comm_y, grid%npr_y) + dods(k) = me0 + end do + + if (am_fix_lbl) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + u(i,j,k) = u(i,j,k) - dons(k)/dods(k)*grid%cose(j) * taper(k) + end do + end do + end do + endif + + ! diagnose du_fix + if (am_fix_lbl) then ! output applied increment (tapered) +!$omp parallel do private(k) + do k = kfirst, klast + du_fix_s(k)=du_fix_s(k)-dons(k)/dods(k)*taper(k) + end do + elseif(am_diag) then ! output diagnosed increment (not tapered) +!$omp parallel do private(k) + do k = kfirst, klast + du_fix_s(k)=du_fix_s(k)-dons(k)/dods(k) + end do + endif + +!$omp parallel do private(j, k) + do k=kfirst,klast + do j = jfirst, jlast + don(j,k)=don(j,k)*taper(k) + dod(j,k)=dod(j,k)*taper(k) + enddo + enddo + tmpsum(1,1) = SUM(don) + tmpsum(1,2) = SUM(dod) + call shr_reprosum_calc(tmpsum, tmpresult, 1, 1, 2, commid=grid%commyz) + am1 = tmpresult(1) + me0 = max(tmpresult(2),tiny) + + if (am_fixer.and.(.not.am_fix_lbl)) then +!$omp parallel do private(i, j, k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + u(i,j,k) = u(i,j,k) - am1/me0*grid%cose(j) *taper(k) + end do + end do + end do + +!$omp parallel do private(k) + do k = kfirst, klast + du_fix_s(k)=du_fix_s(k)-am1/me0*taper(k) + end do + end if ! (am_fix_lbl) + + du_fix_g =du_fix_g -am1/me0 + if (masterproc) then + if ((it == nsplit) .and. (n == n2) .and. (iv == nv)) then + write(iulog,'(1x,a21,1x,1x,e25.17)') "AM GLOBAL FIXER: ", du_fix_g + endif + endif + ! the following call is blocking, but probably cheaper than 3D transposition for du_fix + if ((it == nsplit) .and. (n == n2)) then + call par_vecsum(km, kfirst, klast, du_fix_s, tmp, grid%comm_z, grid%npr_z, return_sum_in=.true.) + endif + end if ! (grid%iam .lt. grid%npes_yz) + call t_stopf ('lfix') + +!$omp parallel do private(i,j,k) + do k=kfirst,klast + do j = jfirst, jlast + do i=1,im + uc_s(i,j,k)=uc_s(i,j,k)+uc(i,j,k) + vc_s(i,j,k)=vc_s(i,j,k)+vc(i,j,k) + enddo + enddo + enddo + + end if ! (am_fixer.or.am_diag) + + if ((it == nsplit) .and. (n == n2) .and. (iv == nv)) then +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k) + do j = jfirstxy, jlastxy + do k = 1, km + do i = ifirstxy, ilastxy + omgaxy(i,k,j) = omgaxy(i,k,j) + 0.5_r8*(pexy(i,k,j) + pexy(i,k+1,j) - & + pexy_om(i,k,j) - pexy_om(i,k+1,j))/dt + end do + end do + do k = 1, km+1 + do i = ifirstxy, ilastxy + pexy_om(i,k,j) = 0.5_r8*(pexy_om(i,k,j) + pexy(i,k,j)) + end do + end do + end do + + !----------------------------------------------------- + ! Add the v*grad(p) term to omega (dp/dt) for physics + !----------------------------------------------------- + call t_startf ('vdot_gradp') + if (grid%iam .lt. grid%npes_xy) then + call compute_vdot_gradp( grid, dt, dt/dt, cx_om, cy_om, pexy_om, omgaxy ) + end if + call t_stopf ('vdot_gradp') + + end if + + end do ! it = 1, nsplit - dynamics sub-cycle loop + + if (ntotq .ne. 0) then + +#if ( defined OFFLINE_DYN ) + if (met_fix_mass) then + ps_mod(:,:) = ps(:,:) + ! get the observed PS interpolated to current substep + call get_met_fields(grid, ps_obs, n2, n) + + ! adjust mass fluxes and edge pressures to be consistent with observed PS + call adjust_press(grid, ps_mod, ps_obs, mfx, mfy, pexy) + + if (high_alt) then +!$omp parallel do private(i,j,k) + do k=2,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1) + endif +!$omp parallel do private(i,j,k) + ! make pkxy consistent with the adjusted pexy + do i = ifirstxy, ilastxy + do j = jfirstxy, jlastxy + do k = 1, km+1 + pkxy(i,j,k) = pexy(i,k,j)**cap3vi(i,j,k) + end do + end do + end do + +!$omp parallel do private(i,j,k) + ! adjust courant numbers to be consistent with the adjusted mass fluxes + do i = 1, im + do j = jfirst, jlast + do k = kfirst, klast + if (i .ne. 1) cx(i,j,k) = mfx(i,j,k)/(0.5_r8*(dp0(i-1,j,k)+dp0(i,j,k))) + if (i .eq. 1) cx(i,j,k) = mfx(i,j,k)/(0.5_r8*(dp0(1,j,k)+dp0(im,j,k))) + end do + end do + end do + +!$omp parallel do private(i,j,k) + do i = 1, im + do j = jfirst, jlast + do k = kfirst, klast + if ((j .gt. 1) .and. (j .lt. jm)) cy(i,j,k) = & + mfy(i,j,k)/(0.5_r8*(dp0(i,j-1,k)+dp0(i,j,k)))/grid%cose(j) + end do + end do + end do + end if +#endif + + ! WS 2006-12-04 : this seems like the safest place to preprocess and + ! transpose the C-grid mass-flux and later the + ! Courant numbers for potential output + + ! Horizontal mass fluxes + + if (grid%iam .lt. grid%npes_xy) then + + if (grid%twod_decomp .eq. 1) then +#if defined( SPMD ) +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + worka(i,j,k) = mfx(i,j,k)*(ae*grid%dp)*(grid%dl*ae*grid%cosp(j))/(ndt) ! Pa m^2/s + workb(i,j,k) = mfy(i,j,k)*(grid%dl*ae*grid%cosp(j))*(ae*grid%dp)/(ndt*grid%cose(j)) ! Pa m^2 / s + end do + end do + end do + if (grid%modc_onetwo .eq. 1) then + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, worka, mfxxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, worka, mfxxy, & + modc=grid%modc_dynrun ) + + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, workb, mfyxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, workb, mfyxy, & + modc=grid%modc_dynrun ) + else + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, worka, mfxxy, & + workb, mfyxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, worka, mfxxy, & + workb, mfyxy, & + modc=grid%modc_dynrun ) + end if + +#else + write(iulog,*)'DYN_COMP:dyn_run -- SPMD must be defined for 2D decomp -- returning' + rc = DYN_RUN_MUST_BE_2D_DECOMP + return ! Not possible to have 2D decomposition with SPMD undefined +#endif + else ! if not twod_decomp (1D or sequential) +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + mfxxy(i,j,k) = mfx(i,j,k)*(grid%dl*ae*grid%cosp(j))*(ae*grid%dp)/(ndt*grid%cose(j)) ! Pa m^2 / s + mfyxy(i,j,k) = mfy(i,j,k)*(grid%dl*ae*grid%cosp(j))*(ae*grid%dp)/(ndt*grid%cose(j)) ! Pa m^2 / s + end do + end do + end do + + end if + + end if ! (grid%iam .lt. grid%npes_xy) + + + ! Perform large-tme-step scalar transport using the accumulated CFL and + ! mass fluxes + + call t_barrierf('sync_trac2d', grid%commdyn) + call t_startf ('trac2d') + + ! Overlap trac2d with subsequent cd_core set, or decompose over tracers + + if ((ct_overlap .gt. 0 .and. n .lt. n2 .and. kaux .lt. 2) .or. & + (trac_decomp .gt. 1 .and. kaux .lt. trac_decomp)) then + + if (kaux .eq. 0) then + + ! Primary process + + ! Send data to auxiliary yz decomposition + ! Communicate tracers on first subcycle only + ! Also post receive of new tracer values from aux processes + +#if defined(SPMD) + if (n .eq. 1) then + + ! Block on send of tracers to aux + if (ct_overlap .gt. 0) then + do iq = 1, ntotq + call mpiwait(ctreqs(5+iq,1), ctstats(1,5+iq,1)) + end do + end if + + if (trac_decomp .gt. 1) then + do kt = 2, trac_decomp + do iq = ktloa(kt), kthia(kt) + call mpiwait(ctreqs(5+iq,kt-1), ctstats(1,5+iq,kt-1)) + enddo + enddo + endif + + ! Post receive for updated tracers from aux + if (ct_overlap .gt. 0) then + do iq = 1, ntotq + call mpiirecv(q_internal(:,:,:,iq), ntrac, mpir8, iremote, & + tractag+iq-1, commnyz, ctreq(iq,1)) + end do + end if + + if (trac_decomp .gt. 1) then + do kt = 2, trac_decomp + do iq = ktloa(kt), kthia(kt) + tagu = tractag+iq-1 + (kt-2)*(ntotq+ntg0) + call mpiirecv(q_internal(:,:,:,iq), ntrac, mpir8, iremotea(kt-1), & + tagu, commnyz, ctreq(iq,kt-1)) + end do + end do + end if + end if ! (n .eq. 1) + + if (ct_overlap .gt. 0) then + + ! Block on send of dp0 to aux + call mpiwait(ctreqs(1,1), ctstats(1,1,1)) + ! Block on sends from cd_core to aux + call mpiwait(ctreqs(2,1), ctstats(1,2,1)) + call mpiwait(ctreqs(3,1), ctstats(1,3,1)) + call mpiwait(ctreqs(4,1), ctstats(1,4,1)) + call mpiwait(ctreqs(5,1), ctstats(1,5,1)) + endif + + if (trac_decomp .gt. 1) then + + do kt = 2, trac_decomp + ! Block on send of dp0 to aux + call mpiwait(ctreqs(1,kt-1), ctstats(1,1,kt-1)) + ! Block on sends from cd_core to aux + call mpiwait(ctreqs(2,kt-1), ctstats(1,2,kt-1)) + call mpiwait(ctreqs(3,kt-1), ctstats(1,3,kt-1)) + call mpiwait(ctreqs(4,kt-1), ctstats(1,4,kt-1)) + call mpiwait(ctreqs(5,kt-1), ctstats(1,5,kt-1)) + end do + end if +#endif + + else + + ! Auxiliary process + + ! Temporarily set subdomain limits and process index in auxiliary process equal + ! to those of antecedent + jfirst = jfirstct + jlast = jlastct + kfirst = kfirstct + klast = klastct + grid%jfirst = jfirstct + grid%jlast = jlastct + grid%kfirst = kfirstct + grid%klast = klastct + ! Translate process index to frame of auxiliary yz decomposition for use with auxiliary + ! communication in trac2d + grid%iam = iremote + +#if defined(SPMD) + ! Receive data from primary yz decomposition + ! Include tracers first subcycle only + + if (n .eq. 1) then + do iq = ktlo, kthi + tagu = tractag+iq-1 + (kaux-1)*(ntotq+ntg0) + call mpiirecv(q_internal(:,:,:,iq), ntrac, mpir8, iremote, tagu, commnyz, ctreq(5+iq,1)) + call mpiwait(ctreq(5+iq,1), ctstat(1,5+iq,1)) + end do + end if + tagu = dp0tag + (kaux-1)*(ntotq+ntg0) + call mpiirecv(dp0, ndp0, mpir8, iremote, tagu, commnyz, ctreq(1,1)) + tagu = cxtag + (kaux-1)*(ntotq+ntg0) + call mpiirecv(cx, ncx, mpir8, iremote, tagu, commnyz, ctreq(2,1)) + tagu = cytag + (kaux-1)*(ntotq+ntg0) + call mpiirecv(cy, ncy, mpir8, iremote, tagu, commnyz, ctreq(3,1)) + tagu = mfxtag + (kaux-1)*(ntotq+ntg0) + call mpiirecv(mfx, nmfx, mpir8, iremote, tagu, commnyz, ctreq(4,1)) + tagu = mfytag + (kaux-1)*(ntotq+ntg0) + call mpiirecv(mfy, nmfy, mpir8, iremote, tagu, commnyz, ctreq(5,1)) + call mpiwait(ctreq(1,1), ctstat(1,1,1)) + call mpiwait(ctreq(2,1), ctstat(1,2,1)) + call mpiwait(ctreq(3,1), ctstat(1,3,1)) + call mpiwait(ctreq(4,1), ctstat(1,4,1)) + call mpiwait(ctreq(5,1), ctstat(1,5,1)) +#endif + + end if ! (kaux .eq. 0) + + else + +#if defined(SPMD) + ! Block on receive of updated tracers from aux (last subcycle) + if (ct_overlap .gt. 0 .and. n .eq. n2 .and. n2 .gt. 1 .and. kaux .eq. 0) then + do iq = 1, ntotq + call mpiwait(ctreq(iq,1), ctstat(1,iq,1)) + end do + end if +#endif + + end if ! (ct_overlap .gt. 0 .and. n .lt. n2 .and. kaux .lt. 2) + ! or (trac_decomp .gt. 1 .and. kaux .lt. trac_decomp) + + ! Call tracer advection + + c_dotrac = ct_overlap .gt. 0 .and. & + ((n .lt. n2 .and. kaux .eq. 1) .or. (n .eq. n2 .and. kaux .eq. 0)) + t_dotrac = ct_overlap .eq. 0 .and. kaux .lt. trac_decomp + high_alt1: if (high_alt) then + ! + ! phl: overwrite last tracer with kappa + ! + !$omp parallel do private(i,j,k) + do k=grid%kfirst,grid%klast + do j=grid%jfirst,grid%jlast + do i=1,grid%im + q_internal(i,j,k,ntotq) = cap3vc(i,j,k) + end do + end do + end do + endif high_alt1 + if (c_dotrac .or. t_dotrac) then + call trac2d( grid, dp0(:,jfirst:jlast,:), q_internal, & + cx, cy, mfx, mfy, iord, jord, & + fill, ktlo, kthi, workb, worka ) + endif + +#if defined(SPMD) + ! Return data to primary yz decomposition + ! For overlap, next-to-last subcycle only; for tracer decomp, last subcycle only + if (ct_aux .and. ((ct_overlap .gt. 0 .and. n .eq. n2-1) .or. & + (trac_decomp .gt. 1 .and. n .eq. n2))) then + do iq = ktlo, kthi + tagu = tractag+iq-1 + (kaux-1)*(ntotq+ntg0) + call mpiisend(q_internal(:,:,:,iq), ntrac, mpir8, iremote, tagu, commnyz, ctreqs(5+iq,1)) + call mpiwait(ctreqs(5+iq,1), ctstats(1,5+iq,1)) + end do + end if +#endif + +#if defined(SPMD) + ! For tracer decomposition, block on receive of updated tracers from aux (last subcycle) + if (trac_decomp .gt. 1 .and. n .eq. n2 .and. kaux .eq. 0) then + do kt = 2, trac_decomp + do iq = ktloa(kt), kthia(kt) + call mpiwait(ctreq(iq,kt-1), ctstat(1,iq,kt-1)) + end do + end do + end if +#endif + + ! Restore subdomain limits and process index in auxiliary process + if (ct_aux) then + jfirst = jkstore(1) + jlast = jkstore(2) + kfirst = jkstore(3) + klast = jkstore(4) + grid%jfirst = jkstore(1) + grid%jlast = jkstore(2) + grid%kfirst = jkstore(3) + grid%klast = jkstore(4) + grid%iam = iamlocal + end if + + ! NOTE: for cd_core / trac2d overlap, tracer data is returned to primary processes + ! prior to n=n2 call to trac2d + + call t_stopf('trac2d') + + trans_pexy: if (met_fix_mass .or. high_alt) then + + if (grid%twod_decomp .eq. 1) then + if (grid%iam .lt. grid%npes_yz) then +#if defined( SPMD ) + call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & + grid%pexy_to_pe%RecvDesc, pexy, pe, & + modc=grid%modc_dynrun ) +#endif + endif + else +!$omp parallel do private(i,j,k) + do j = jfirst, jlast + do k = kfirst, klast+1 + do i = 1, im + pe(i,k,j) = pexy(i,k,j) + end do + end do + end do + end if + +#if ( defined OFFLINE_DYN ) + do j = jfirst,jlast + if (klast .eq. km) ps_mod(:,j) = pe(:,km+1,j) + end do +#endif + end if trans_pexy + + high_alt2: if (high_alt) then + + !+hi-waccm: perform potential temperature correction: + ! 1. Update kappa according to new major species + ! 2. calculate the difference between kappa from step 1 and kappa from advection + ! 3. calculate ln(p0/p) from the most recent p + ! 4. update pt, then transpose to ptxy. + + ! Since rairv is not defined on yz decomp, can retrieve it using cp3vc and cap3vc when needed + ! Also will check if mbarv is needed somewhere in dynamics. + ! These updates of cp3vc, cap3vc etc are currently not passed back to physics. + ! This update is put here, after the transpose of pexy to pe, since we need pe (on yz decomp). + + call physconst_calc_kappav(1,im,jfirst,jlast,kfirst,klast, grid%ntotq, q_internal, cap3vc ) + +!$omp parallel do private(i,j,k) + do k = kfirst,klast + do j = jfirst,jlast + do i = 1,im + pt(i,j,k) = pt(i,j,k) * (1._r8 - & + .5_r8*(log(pe(i,k,j))+log(pe(i,k+1,j))) * & + (cap3vc(i,j,k)-q_internal(i,j,k,ntotq))) + enddo + enddo + enddo + + endif high_alt2 + end if ! if (ntotq .ne. 0) then + + end do ! do n=1, n2 - tracer sub-cycle loop + + call t_barrierf('sync_yz_to_xy_1', grid%commdyn) + + if (grid%iam .lt. grid%npes_xy) then + + if (grid%twod_decomp .eq. 1) then + + ! Transpose ps, u, v, and tracer from yz to xy decomposition + ! + ! Note: pt, pe and pk will have already been transposed through + ! call to geopk in cd_core. geopk does not actually require + ! secondary xy decomposition; direct 16-byte technique works just + ! as well, perhaps better. However, transpose method is used on last + ! call to avoid having to compute these three transposes now. + +#if defined (SPMD) + + call t_startf ('yz_to_xy_psuv') + + ! Transpose ps + ! Embed in 3D array since transpose machinery cannot handle 2D arrays + + call mp_sendirr( grid%commxy, grid%yz2d_to_xy2d%SendDesc, & + grid%yz2d_to_xy2d%RecvDesc, ps, psxy3, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%yz2d_to_xy2d%SendDesc, & + grid%yz2d_to_xy2d%RecvDesc, ps, psxy3, & + modc=grid%modc_dynrun ) + +!$omp parallel do private(i,j) + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + psxy(i,j) = psxy3(i,j,1) + end do + end do + + ! Transpose u + call mp_sendirr( grid%commxy, grid%u_to_uxy%SendDesc, & + grid%u_to_uxy%RecvDesc, u, uxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%u_to_uxy%SendDesc, & + grid%u_to_uxy%RecvDesc, u, uxy, & + modc=grid%modc_dynrun ) + + ! Transpose v + call mp_sendirr( grid%commxy, grid%v_to_vxy%SendDesc, & + grid%v_to_vxy%RecvDesc, v, vxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%v_to_vxy%SendDesc, & + grid%v_to_vxy%RecvDesc, v, vxy, & + modc=grid%modc_dynrun ) + + + if (am_fixer.or.am_diag) then + + ! Transpose uc_s + call mp_sendirr( grid%commxy, grid%u_to_uxy%SendDesc, & + grid%u_to_uxy%RecvDesc, uc_s, uc_i, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%u_to_uxy%SendDesc, & + grid%u_to_uxy%RecvDesc, uc_s, uc_i, & + modc=grid%modc_dynrun ) + + ! Transpose vc_s + call mp_sendirr( grid%commxy, grid%v_to_vxy%SendDesc, & + grid%v_to_vxy%RecvDesc, vc_s, vc_i, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%v_to_vxy%SendDesc, & + grid%v_to_vxy%RecvDesc, vc_s, vc_i, & + modc=grid%modc_dynrun ) + end if + + call t_stopf ('yz_to_xy_psuv') + + call t_startf ('yz_to_xy_q') + + if (modc_tracers .eq. 0) then + do mq = 1, ntotq + + + ! Transpose + q3yzpt => q_internal(:,:,:,mq) + q3xypt => dyn_out%tracer(:,:,:,mq) + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, q3yzpt, q3xypt, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, q3yzpt, q3xypt, & + modc=grid%modc_dynrun ) + end do + else + do mq = 1, ntotq, modc_tracers + mlast = min(mq+modc_tracers-1,ntotq) + call mp_sendtrirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, q_internal, dyn_out%tracer, & + mq, mlast, ntotq, 1, grid%im, grid%jfirst, grid%jlast, grid%kfirst, & + grid%klast, grid%ifirstxy, grid%ilastxy, grid%jfirstxy, & + grid%jlastxy, 1, grid%km, & + modc=grid%modc_tracer ) + call mp_recvtrirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, q_internal, dyn_out%tracer, & + mq, mlast, ntotq, 1, grid%im, grid%jfirst, grid%jlast, grid%kfirst, & + grid%klast, grid%ifirstxy, grid%ilastxy, grid%jfirstxy, & + grid%jlastxy, 1, grid%km, & + modc=grid%modc_tracer ) + end do + end if + + call t_stopf ('yz_to_xy_q') + + if (high_alt) then + ! Transpose pt (because pt correction is done after cd_core) + + call t_startf ('yz_to_xy_pt') + call mp_sendirr( grid%commxy, grid%pt_to_ptxy%SendDesc, & + grid%pt_to_ptxy%RecvDesc, pt, ptxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%pt_to_ptxy%SendDesc, & + grid%pt_to_ptxy%RecvDesc, pt, ptxy, & + modc=grid%modc_dynrun ) + call t_stopf ('yz_to_xy_pt') + endif + +#endif + + else + + call t_startf ('yz_to_xy_psuv') + + do j = jfirst, jlast + do i = 1, im + psxy(i,j) = ps(i,j) + end do + end do + +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + uxy(i,j,k) = u(i,j,k) + vxy(i,j,k) = v(i,j,k) + end do + end do + end do + + if (am_fixer.or.am_diag) then +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + uc_i(i,j,k)= uc_s(i,j,k) + vc_i(i,j,k)= vc_s(i,j,k) + end do + end do + end do + end if + + if (high_alt) then +!$omp parallel do private(i,j,k) + do k = kfirst, klast + do j = jfirst, jlast + do i = 1, im + ptxy(i,j,k) = pt(i,j,k) + end do + end do + end do + end if + + call t_stopf ('yz_to_xy_psuv') + + call t_startf ('yz_to_xy_q') + +!$omp parallel do private(i,j,k,mq) + do mq = 1, ntotq + + ! Temporary -- here the pointers will ultimately be set, not the contents copied + do k = 1, km + do j = jfirst, jlast + do i = 1, im + dyn_out%tracer(i,j,k,mq) = q_internal(i,j,k,mq) + end do + end do + end do + end do + + call t_stopf ('yz_to_xy_q') + + end if ! (grid%twod_decomp .eq. 1) + + end if ! (grid%iam .lt. grid%npes_xy) + + if ( km > 1 ) then ! not shallow water equations + + ! Perform vertical remapping from Lagrangian control-volume to + ! the Eulerian coordinate as specified by the routine set_eta. + ! Note that this finite-volume dycore is otherwise independent of the vertical + ! Eulerian coordinate. + + + ! te_map requires uxy, vxy, psxy, pexy, pkxy, phisxy, q3xy, and ptxy + + call t_barrierf('sync_te_map', grid%commdyn) + call t_startf ('te_map') + + if (grid%iam .lt. grid%npes_xy) then + + call te_map(grid, consv, convt_local, psxy, omgaxy, & + pexy, delpxy, pkzxy, pkxy, ndt, & + nx, uxy, vxy, ptxy, dyn_out%tracer, & + phisxy, cp3v, cap3v, kord, pelnxy, & + te0, tempxy, dp0xy, mfxxy, mfyxy, & + uc_i, vc_i, du_fix_s, du_fix_i, & + am_correction, (am_fixer.or.am_diag) ) + + if (am_diag) then +!$omp parallel do private(i,j,k) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + ucxy(i,j,k)=ucxy(i,j,k)+uc_i(i,j,k) + vcxy(i,j,k)=vcxy(i,j,k)+vc_i(i,j,k) + enddo + enddo + enddo + end if + + if (am_fixer .or. am_diag) then +!$omp parallel do private(i,j,k) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + dufix_xy(i,j,k)=dufix_xy(i,j,k)+du_fix_i(i,j,k)*grid%cose(j) + enddo + enddo + enddo + endif + + if ( .not. convt_local ) then +!$omp parallel do private(i,j,k) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + t3xy(i,j,k) = ptxy(i,j,k)*pkzxy(i,j,k)/ & + (D1_0+zvir*dyn_out%tracer(i,j,k,1)) + end do + end do + end do + end if + + end if + + call t_stopf ('te_map') + + end if ! ( km > 1 ) + + ! te_map computes uxy, vxy, psxy, delpxy, pexy, pkxy, pkzxy, + ! pelnxy, omgaxy, tracer, ptxy, mfxxy and mfyxy + + end do ! do iv = 1, nv - vertical re-mapping sub-cycle loop + + ! get total wind increments from dynamics timestep + if (am_diag) then +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + duxy(i,j,k) = uxy(i,j,k) - duxy(i,j,k) + dvxy(i,j,k) = vxy(i,j,k) - dvxy(i,j,k) + enddo + enddo + enddo + end if + + call t_startf ('dyn_run_dealloc') + + deallocate( worka ) + deallocate( workb ) + deallocate( dp0 ) + deallocate( mfx ) + deallocate( mfy ) + deallocate( cx ) + deallocate( cy ) + deallocate( delpf ) + deallocate( uc ) + deallocate( vc ) + deallocate( dpt ) + deallocate( dwz ) + deallocate( pkc ) + deallocate( wz ) + deallocate( pkcc ) + deallocate( wzc ) + deallocate( pkkp ) + deallocate( wzkp ) + deallocate( wzxy ) + deallocate( tempxy ) + deallocate( dp0xy ) + deallocate( psxy3 ) + deallocate( phisxy3 ) + deallocate( q_internal ) + deallocate (ctreq) + deallocate (ctreqs) + deallocate (cdcreqs) +#if defined(SPMD) + deallocate (ctstat) + deallocate (ctstats) +#endif +#if ( defined OFFLINE_DYN ) + deallocate( ps_obs ) + deallocate( ps_mod ) + deallocate( u_tmp ) + deallocate( v_tmp ) +#endif + + if (am_fix_taper) then + deallocate(zpkck) + end if + if (am_fixer.or.am_diag) then + deallocate(du_fix_i) + deallocate(du_k) + deallocate(du_north) + deallocate(uc_s) + deallocate(vc_s) + deallocate(uc_i) + deallocate(vc_i) + end if + + call t_stopf ('dyn_run_dealloc') + + rc = DYN_RUN_SUCCESS + +end subroutine dyn_run + +!============================================================================================= + +subroutine dyn_final(restart_file, dyn_state, dyn_in, dyn_out) + + use dynamics_vars, only: dynamics_clean + + character(LEN=*) , intent(IN ) :: restart_file + type (T_FVDYCORE_STATE), target :: dyn_state + type (dyn_import_t), intent(inout) :: dyn_in + type (dyn_export_t), intent(inout) :: dyn_out + !----------------------------------------------------------------------- + + call dynamics_clean ( dyn_state%grid ) + call dyn_free_interface( dyn_in, dyn_out ) + + !============================================================================================= + contains + !============================================================================================= + + subroutine dyn_free_interface ( dyn_in, dyn_out ) + + ! free the dynamics import and export + + ! arguments + type (dyn_import_t), intent(inout) :: dyn_in + type (dyn_export_t), intent(inout) :: dyn_out + !----------------------------------------------------------------------- + + if ( associated(dyn_in%phis) ) deallocate( dyn_in%phis ) + if ( associated(dyn_in%ps) ) deallocate( dyn_in%ps ) + if ( associated(dyn_in%u3s) ) deallocate( dyn_in%u3s ) + if ( associated(dyn_in%v3s) ) deallocate( dyn_in%v3s ) + if ( associated(dyn_in%pe) ) deallocate( dyn_in%pe ) + if ( associated(dyn_in%pt) ) deallocate( dyn_in%pt ) + if ( associated(dyn_in%t3) ) deallocate( dyn_in%t3 ) + if ( associated(dyn_in%pk) ) deallocate( dyn_in%pk ) + if ( associated(dyn_in%pkz) ) deallocate( dyn_in%pkz ) + if ( associated(dyn_in%delp) ) deallocate( dyn_in%delp ) + if ( associated(dyn_in%tracer) ) deallocate( dyn_in%tracer) + + if ( associated(dyn_out%ps) ) nullify( dyn_out%ps ) + if ( associated(dyn_out%u3s) ) nullify( dyn_out%u3s ) + if ( associated(dyn_out%v3s) ) nullify( dyn_out%v3s ) + if ( associated(dyn_out%pe) ) nullify( dyn_out%pe ) + if ( associated(dyn_out%pt) ) nullify( dyn_out%pt ) + if ( associated(dyn_out%t3) ) nullify( dyn_out%t3 ) + if ( associated(dyn_out%pk) ) nullify( dyn_out%pk ) + if ( associated(dyn_out%pkz) ) nullify( dyn_out%pkz ) + if ( associated(dyn_out%delp) ) nullify( dyn_out%delp ) + if ( associated(dyn_out%tracer) ) nullify( dyn_out%tracer ) + + if ( associated(dyn_out%omga) ) deallocate( dyn_out%omga ) + if ( associated(dyn_out%peln) ) deallocate( dyn_out%peln ) + if ( associated(dyn_out%mfx) ) deallocate( dyn_out%mfx ) + if ( associated(dyn_out%mfy) ) deallocate( dyn_out%mfy ) + + end subroutine dyn_free_interface + +end subroutine dyn_final + +!============================================================================================= +! Private routines +!============================================================================================= + +subroutine read_inidat(dyn_in) + use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic + use dyn_tests_utils, only: vc_moist_pressure + use physconst, only: pi + use dyn_grid, only: get_horiz_grid_dim_d + use commap, only: clat, clon, clat_staggered, londeg_st + use constituents, only: pcnst + + ! Read initial dataset + + ! Arguments + type (dyn_import_t), target, intent(inout) :: dyn_in + + ! Local variables + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km + integer :: m, ntotq + + character(len=16) :: fieldname + + type(file_desc_t), pointer :: fh_ini ! PIO filehandle + type(file_desc_t), pointer :: fh_topo + + type (t_fvdycore_grid), pointer :: grid + ! variables for analytic initial conditions + integer, allocatable :: glob_ind(:) + integer, allocatable :: m_cnst(:) + real(r8), allocatable :: clon_st(:) + integer :: nglon, nglat + integer :: i, j + integer :: jf, gf, uf ! First indices for setting u3s + integer :: ierr + integer :: lonid + integer :: latid + integer :: mlon ! longitude dimension length from dataset + integer :: mlat ! latitude dimension length from dataset + real(r8), parameter :: deg2rad = pi/180._r8 + + character(len=*), parameter :: sub='read_inidat' + !---------------------------------------------------------------------------- + + fh_ini => initial_file_get_id() + fh_topo => topo_file_get_id() + + grid => get_dyn_state_grid() + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + ntotq = grid%ntotq + + if (analytic_ic_active()) then + readvar = .false. + if (jfirstxy == 1) then + jf = 1 + uf = 2 + gf = (ilastxy - ifirstxy + 1) + 1 ! Skip the first block of longitudes + else + jf = jfirstxy-1 + uf = jfirstxy + gf = 1 + end if + allocate(glob_ind((ilastxy - ifirstxy + 1) * (jlastxy - jfirstxy + 1))) + call get_horiz_grid_dim_d(nglon, nglat) + m = 1 + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + ! Create a global column index + glob_ind(m) = i + (j-1)*nglon + m = m + 1 + end do + end do + allocate(m_cnst(ntotq)) + do i = 1, ntotq + m_cnst(i) = i + end do + allocate(clon_st(ifirstxy:ilastxy)) + clon_st(ifirstxy:ilastxy) = londeg_st(ifirstxy:ilastxy,1) * deg2rad + call analytic_ic_set_ic(vc_moist_pressure, clat_staggered(jf:jlastxy-1), & + clon(ifirstxy:ilastxy,1), glob_ind(gf:), U=dyn_in%u3s(:,uf:,:)) + call analytic_ic_set_ic(vc_moist_pressure, clat(jfirstxy:jlastxy), & + clon_st(ifirstxy:ilastxy), glob_ind, V=dyn_in%v3s) + call analytic_ic_set_ic(vc_moist_pressure, clat(jfirstxy:jlastxy), & + clon(ifirstxy:ilastxy,1), glob_ind, T=dyn_in%t3, PS=dyn_in%ps, & + Q=dyn_in%tracer(:,:,:,1:ntotq), m_cnst=m_cnst) + if (.not. associated(fh_topo)) then + call analytic_ic_set_ic(vc_moist_pressure, clat(jfirstxy:jlastxy), & + clon(ifirstxy:ilastxy,1), glob_ind, PHIS=dyn_in%phis) + end if + do m = 1, ntotq + call process_inidat(fh_ini, grid, dyn_in, 'CONSTS', m_cnst=m) + end do + deallocate(glob_ind) + deallocate(m_cnst) + deallocate(clon_st) + else + !----------- + ! Check coord sizes + !----------- + ierr = pio_inq_dimid(fh_ini, 'lon' , lonid) + ierr = pio_inq_dimid(fh_ini, 'lat' , latid) + ierr = pio_inq_dimlen(fh_ini, lonid , mlon) + ierr = pio_inq_dimlen(fh_ini, latid , mlat) + if (mlon /= plon .or. mlat /= plat) then + write(iulog,*) sub//': ERROR: model parameters do not match initial dataset parameters' + write(iulog,*)'Model Parameters: plon = ',plon,' plat = ',plat + write(iulog,*)'Dataset Parameters: dlon = ',mlon,' dlat = ',mlat + call endrun(sub//': ERROR: model parameters do not match initial dataset parameters') + end if + + !----------- + ! 2-D fields + !----------- + + fieldname = 'PS' + call infld(fieldname, fh_ini, 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, & + dyn_in%ps, readvar, gridname='fv_centers') + if (.not. readvar) call endrun(sub//': ERROR: PS not found') + + fieldname = 'PHIS' + readvar = .false. + if (.not. associated(fh_topo)) then + dyn_in%phis(:,:) = 0._r8 + else + call infld(fieldname, fh_topo, 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, & + dyn_in%phis, readvar, gridname='fv_centers') + if (.not. readvar) call endrun(sub//': ERROR: PHIS not found') + end if + + !----------- + ! 3-D fields + !----------- + + fieldname = 'US' + call infld(fieldname, fh_ini, 'lon', 'slat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, dyn_in%u3s, readvar, gridname='fv_u_stagger') + if (.not. readvar) call endrun(sub//': ERROR: US not found') + + fieldname = 'VS' + call infld(fieldname, fh_ini, 'slon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, dyn_in%v3s, readvar, gridname='fv_v_stagger') + if (.not. readvar) call endrun(sub//': ERROR: VS not found') + + fieldname = 'T' + call infld(fieldname, fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, dyn_in%t3, readvar, gridname='fv_centers') + if (.not. readvar) call endrun(sub//': ERROR: T not found') + + ! Constituents (read and process one at a time) + do m = 1, pcnst + readvar = .false. + fieldname = cnst_name(m) + if (cnst_read_iv(m)) then + call infld(fieldname, fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, dyn_in%tracer(:,:,:,m), readvar, gridname='fv_centers') + end if + call process_inidat(fh_ini, grid, dyn_in, 'CONSTS', m_cnst=m) + end do + end if + + ! Set u3s(:,1,:) to zero as it is used in interpolation routines + if ((jfirstxy == 1) .and. (size(dyn_in%u3s) > 0)) then + dyn_in%u3s(ifirstxy:ilastxy,jfirstxy,1:km) = 0.0_r8 + end if + + ! These always happen + call process_inidat(fh_ini, grid, dyn_in, 'PS') + call process_inidat(fh_ini, grid, dyn_in, 'PHIS') + call process_inidat(fh_ini, grid, dyn_in, 'T') + +end subroutine read_inidat + +!========================================================================================= + +subroutine process_inidat(fh_ini, grid, dyn_in, fieldname, m_cnst) + + ! Post-process input fields + use commap, only: clat, clon + use const_init, only: cnst_init_default + use inic_analytic, only: analytic_ic_active + + ! arguments + type(file_desc_t), intent(inout) :: fh_ini + type(t_fvdycore_grid), target, intent(inout) :: grid ! dynamics state grid + type(dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import + character(len=*), intent(in) :: fieldname ! field to be processed + integer, optional, intent(in) :: m_cnst ! constituent index + + ! Local variables + integer :: i, j, k ! grid and constituent indices + integer :: npes_xy + integer :: im, jm, km + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + + integer :: nglon, nglat, rndm_seed_sz + integer, allocatable :: rndm_seed(:) + real(r8) :: pertval ! perturbation value + + real(r8), pointer :: phisxy(:,:), psxy(:,:), t3xy(:,:,:) + real(r8), pointer :: tracer(:,:,:,:) + + real(r8) :: xsum(grid%km) ! temp array for parallel sums + + integer :: varid ! variable id + integer :: ret ! return values + character(len=256) :: trunits ! tracer untis + + character(len=*), parameter :: sub='process_inidat' + !---------------------------------------------------------------------------- + + psxy => dyn_in%ps + phisxy => dyn_in%phis + t3xy => dyn_in%t3 + + npes_xy = grid%npes_xy + im = grid%im + jm = grid%jm + km = grid%km + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + select case (fieldname) + + case ('T') + + if (iam >= npes_xy) return + + ! Add random perturbation to temperature if requested + if ((pertlim /= 0._r8) .and. (.not. analytic_ic_active())) then + + if (masterproc) then + write(iulog,*) sub//': Adding random perturbation bounded by +/-', & + pertlim,' to initial temperature field' + end if + + call get_horiz_grid_dim_d(nglon, nglat) + call random_seed(size=rndm_seed_sz) + allocate(rndm_seed(rndm_seed_sz)) + + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + ! seed random_number generator based on global column index + rndm_seed = i + (j-1)*nglon + call random_seed(put=rndm_seed) + do k = 1, km + call random_number(pertval) + pertval = 2._r8*pertlim*(0.5_r8 - pertval) + t3xy(i,j,k) = t3xy(i,j,k)*(1._r8 + pertval) + end do + end do + end do + + deallocate(rndm_seed) + end if + + ! Average T at the poles. + if (jfirstxy == 1) then + call par_xsum(grid, t3xy(:,1,:), km, xsum) + do k=1, km + do i = ifirstxy, ilastxy + t3xy(i,1,k) = xsum(k) / real(im,r8) + end do + end do + end if + if (jlastxy == jm) then + call par_xsum(grid, t3xy(:,jm,:), km, xsum) + do k = 1, km + do i = ifirstxy, ilastxy + t3xy(i,jm,k) = xsum(k) / real(im,r8) + end do + end do + end if + + case ('CONSTS') + + if (.not. present(m_cnst)) then + call endrun(sub//': ERROR: m_cnst needs to be present in the'// & + ' argument list') + end if + + tracer => dyn_in%tracer + + if (readvar) then + + ! Check that all tracer units are in mass mixing ratios + ret = pio_inq_varid(fh_ini, cnst_name(m_cnst), varid) + ret = pio_get_att (fh_ini, varid, 'units', trunits) + if (trunits(1:5) .ne. 'KG/KG' .and. trunits(1:5) .ne. 'kg/kg') then + call endrun(sub//': ERROR: Units for tracer ' & + //trim(cnst_name(m_cnst))//' must be in KG/KG') + end if + + else if (.not. analytic_ic_active()) then + + ! Constituents not read from initial file are initialized by the + ! package that implements them. Note that the analytic IC code calls + ! cnst_init_default internally. + + if (iam >= npes_xy) return + + if (m_cnst == 1 .and. moist_physics) then + call endrun(sub//': ERROR: Q must be on Initial File') + end if + + call cnst_init_default(m_cnst, clat(jfirstxy:jlastxy), clon(ifirstxy:ilastxy,1), tracer(:,:,:,m_cnst)) + end if + + if (.not. analytic_ic_active()) then + do k = 1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + tracer(i,j,k,m_cnst) = max(tracer(i,j,k,m_cnst), qmin(m_cnst)) + end do + end do + end do + end if + + if (iam >= npes_xy) return + + ! Compute polar average + if (jfirstxy == 1) then + call par_xsum(grid, dyn_in%tracer(:,1,:,m_cnst), km, xsum) + do k = 1, km + do i = ifirstxy, ilastxy + dyn_in%tracer(i,1,k,m_cnst) = xsum(k) / real(im,r8) + end do + end do + end if + if (jlastxy == jm) then + call par_xsum(grid, dyn_in%tracer(:,jm,:,m_cnst), km, xsum) + do k = 1, km + do i = ifirstxy, ilastxy + dyn_in%tracer(i,jm,k,m_cnst) = xsum(k) / real(im,r8) + end do + end do + end if + + case ('PS') + + ! Average PS at the poles. + if (jfirstxy == 1) then + if (size(psxy,2) > 0) then + call par_xsum(grid, psxy(:,1:1), 1, xsum(1:1)) + do i = ifirstxy, ilastxy + psxy(i,1) = xsum(1) / real(im,r8) + end do + end if + end if + if (jlastxy == jm) then + call par_xsum(grid, psxy(:,jm:jm), 1, xsum(1:1)) + do i = ifirstxy, ilastxy + psxy(i,jm) = xsum(1) / real(im,r8) + end do + end if + + case ('PHIS') + + ! Average PHIS at the poles. + if (jfirstxy == 1) then + if (size(phisxy,2) > 0) then + call par_xsum(grid, phisxy(:,1:1), 1, xsum(1:1)) + do i = ifirstxy, ilastxy + phisxy(i,1) = xsum(1) / real(im,r8) + end do + end if + end if + if (jlastxy == jm) then + call par_xsum(grid, phisxy(:,jm:jm), 1, xsum(1:1)) + do i = ifirstxy, ilastxy + phisxy(i,jm) = xsum(1) / real(im,r8) + end do + end if + + end select + +end subroutine process_inidat + + +end module dyn_comp diff --git a/src/dynamics/fv/dyn_grid.F90 b/src/dynamics/fv/dyn_grid.F90 new file mode 100644 index 0000000000..b38fb3769d --- /dev/null +++ b/src/dynamics/fv/dyn_grid.F90 @@ -0,0 +1,1158 @@ +module dyn_grid +!----------------------------------------------------------------------- +! +! Define dynamics computational grid and decomposition. +! +! Original code: John Drake and Patrick Worley +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use pmgrid, only: plon, plat, plev, plevp, splon, spmd_on +use commap, only: w, w_staggered, clat, clat_staggered, clon, & + latdeg, londeg, latdeg_st, londeg_st +use constituents, only: pcnst +use physconst, only: pi, rearth, omega, spval +use spmd_utils, only: iam +use spmd_dyn, only: spmdinit_dyn, proc, lonrangexy, latrangexy +use time_manager, only: get_step_size + +use pio, only: file_desc_t +use cam_initfiles, only: initial_file_get_id + +use dynamics_vars, only: t_fvdycore_state, t_fvdycore_grid, grid_vars_init +use dyn_internal_state, only: get_dyn_state + +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public :: & + dyn_grid_init, & + dyn_grid_find_gcols, &! find nearest column for given lat/lon + dyn_grid_get_colndx, &! global lat and lon coordinate and MPI process indices + ! corresponding to a specified global column index + dyn_grid_get_elem_coords, &! coordinates of a specified element (latitude) + ! of the dynamics grid (lat slice of the block) + get_block_bounds_d, &! first and last indices in global block ordering + get_block_gcol_d, &! global column indices for given block + get_block_gcol_cnt_d, &! number of columns in given block + get_block_levels_d, &! vertical levels in column + get_block_lvl_cnt_d, &! number of vertical levels in column + get_block_owner_d, &! process "owning" given block + get_dyn_grid_parm, & + get_dyn_grid_parm_real1d, & + get_gcol_block_d, &! global block indices and local columns + ! index for given global column index + get_gcol_block_cnt_d, &! number of blocks containing data + ! from a given global column index + get_horiz_grid_d, &! horizontal grid coordinates + get_horiz_grid_dim_d, &! horizontal dimensions of dynamics grid + physgrid_copy_attributes_d + +! The FV dynamics grids +integer, parameter, public :: dyn_decomp = 101 +integer, parameter, public :: dyn_stagger_decomp = 102 !Backward compatibility +integer, parameter, public :: dyn_ustag_decomp = 102 +integer, parameter, public :: dyn_vstag_decomp = 103 +integer, parameter, public :: dyn_zonal_decomp = 104 + +integer, parameter, public :: ptimelevels = 2 ! number of time levels in the dycore + +integer :: ngcols_d = 0 ! number of dynamics columns + +type(t_fvdycore_grid), pointer :: grid + +!======================================================================================== +contains +!======================================================================================== + +subroutine dyn_grid_init() + + ! Initialize FV grid, decomposition, and PILGRIM communications + + use hycoef, only: hycoef_init, hyai, hybi, hypi, hypm, nprlev + use ref_pres, only: ref_pres_init + + ! Local variables + type(t_fvdycore_state), pointer :: state + + type(file_desc_t), pointer :: fh_ini + + integer :: i, k, lat + + real(r8) :: dt + real(r8) :: dp + real(r8) :: sum + + character(len=*), parameter :: sub='dyn_grid_init' + !----------------------------------------------------------------------- + + ! Assign pointer to FV internal state object + state => get_dyn_state() + ! Assign pointer to grid object stored in state object + grid => state%grid + + ! Get file handle for initial file and first consistency check + fh_ini => initial_file_get_id() + + ! Set grid size parameters + grid%im = plon + grid%jm = plat + grid%km = plev + grid%kmax = plev + 1 + grid%nq = pcnst + grid%ntotq = pcnst + + ! Initialize hybrid coordinate arrays + call hycoef_init(fh_ini) + + ! Initialize reference pressures + call ref_pres_init(hypi, hypm, nprlev) + + ! Hybrid coordinate info for FV grid object + allocate(grid%ak(plev+1), grid%bk(plev+1)) + grid%ks = plev + do k = 1, plev+1 + grid%ak(k) = hyai(k) * 1.e5_r8 + grid%bk(k) = hybi(k) + if (grid%bk(k) == 0._r8) grid%ks = k-1 + end do + grid%ptop = grid%ak(1) + grid%pint = grid%ak(grid%ks+1) + + ! Initialize the grid decomposition and PILGRIM communications + call spmdinit_dyn(state%jord, grid) + + ! Initialize FV specific grid object variables + dt = get_step_size() + call grid_vars_init(pi, rearth, omega, dt, state%fft_flt, & + state%am_correction, grid) + + ! initialize commap variables + + ! latitudes for cell centers + dp = 180._r8/(plat-1) + do lat = 1, plat + latdeg(lat) = -90._r8 + (lat-1)*dp + clat(lat) = latdeg(lat)*pi/180._r8 + end do + + ! latitudes for the staggered grid + do lat = 1, plat-1 + clat_staggered(lat) = (clat(lat) + clat(lat+1)) / 2._r8 + latdeg_st (lat) = clat_staggered(lat)*180._r8/pi + end do + + ! Weights are defined as cos(phi)*(delta-phi) + ! For a sanity check, the sum of w across all lats should be 2. + do lat = 2, plat-1 + w(lat) = sin(clat_staggered(lat)) - sin(clat_staggered(lat-1)) + end do + w(1) = sin(clat_staggered(1)) + 1._r8 + w(plat) = w(1) + + sum = 0._r8 + do lat=1,plat + sum = sum + w(lat) + end do + if (abs(sum - 2._r8) > 1.e-8_r8) then + write(iulog,*) sub//': ERROR: weights do not sum to 2. sum=', sum + call endrun(sub//': ERROR: weights do not sum to 2.') + end if + + dp = pi / real(plat-1,r8) + do lat = 1, plat-1 + w_staggered(lat) = sin(clat(lat+1)) - sin(clat(lat)) + end do + + sum = 0._r8 + do lat = 1, plat-1 + sum = sum + w_staggered(lat) + end do + + if (abs(sum - 2._r8) > 1.e-8_r8) then + write(iulog,*) sub//': ERROR: staggered weights do not sum to 2. sum=', sum + call endrun(sub//': ERROR: staggered weights do not sum to 2.') + end if + + ! longitudes for cell centers + do lat = 1, plat + do i = 1, plon + londeg(i,lat) = (i-1)*360._r8/plon + clon(i,lat) = (i-1)*2._r8*pi/plon + end do + end do + + ! longitudes for staggered grid + do lat = 1, plat + do i = 1, splon + londeg_st(i,lat) = (i-1.5_r8)*360._r8/splon + end do + end do + + ! Define the CAM grids + call define_cam_grids() + +end subroutine dyn_grid_init + +!======================================================================================== + +subroutine get_block_bounds_d(block_first, block_last) + + ! Return first and last indices used in global block ordering + + ! Arguments + integer, intent(out) :: block_first ! first (global) index used for blocks + integer, intent(out) :: block_last ! last (global) index used for blocks + !--------------------------------------------------------------------------- + + block_first = 1 + if (spmd_on .eq. 1) then + ! Assume 1 block per subdomain + block_last = grid%nprxy_x*grid%nprxy_y + else + ! latitude slice block + block_last = plat + end if + +end subroutine get_block_bounds_d + +!======================================================================================== + +subroutine get_block_gcol_d(blockid, size, cdex) + + ! Return list of dynamics column indices in given block + + ! Arguments + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: size ! array size + + integer, intent(out):: cdex(size) ! global column indices + + ! Local workspace + integer :: i,j ! block coordinates + integer :: blksiz ! block size + integer :: k,l ! loop indices + integer :: n ! column index + character(len=*), parameter :: sub='get_block_gcol_d' + !--------------------------------------------------------------------------- + + if (spmd_on .eq. 1) then + j = (blockid-1) / grid%nprxy_x + 1 + i = blockid - (j-1) * grid%nprxy_x +#if ( defined SPMD ) + blksiz = (lonrangexy(2,i)-lonrangexy(1,i)+1) * & + (latrangexy(2,j)-latrangexy(1,j)+1) + if (size < blksiz) then + write(iulog,*) sub//': ERROR: array not large enough (', & + size,' < ',blksiz,' ) ' + call endrun(sub//': ERROR: array not large enough') + else + n = 0 + do k=latrangexy(1,j),latrangexy(2,j) + do l=lonrangexy(1,i),lonrangexy(2,i) + n = n + 1 + cdex(n) = l + (k-1)*plon + end do + end do + end if +#endif + else + if (size < plon) then + write(iulog,*)'GET_BLOCK_GCOL_D: array not large enough (', & + size,' < ',plon,' ) ' + call endrun + else + n = (blockid-1)*plon + do i = 1,plon + n = n + 1 + cdex(i) = n + end do + end if + end if + +end subroutine get_block_gcol_d + +!======================================================================================== + +integer function get_block_gcol_cnt_d(blockid) + + ! Return number of dynamics columns in indicated block + + ! Arguments + integer, intent(in) :: blockid ! global block id + + ! Local workspace + integer :: i, j + !--------------------------------------------------------------------------- + + if (spmd_on .eq. 1) then + j = (blockid-1) / grid%nprxy_x + 1 + i = blockid - (j-1) * grid%nprxy_x +#if ( defined SPMD ) + get_block_gcol_cnt_d = (lonrangexy(2,i)-lonrangexy(1,i)+1) * & + (latrangexy(2,j)-latrangexy(1,j)+1) +#endif + else + get_block_gcol_cnt_d = plon + end if + +end function get_block_gcol_cnt_d + +!======================================================================================== + +integer function get_block_lvl_cnt_d(blockid, bcid) + + ! Return number of levels in indicated column. If column + ! includes surface fields, then it is defined to also + ! include level 0. + + ! Arguments + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + !----------------------------------------------------------------------- + + ! latitude slice block + get_block_lvl_cnt_d = plev + 1 + +end function get_block_lvl_cnt_d + +!======================================================================================== + +subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) + + ! Return level indices in indicated column. If column + ! includes surface fields, then it is defined to also + ! include level 0. + + ! Arguments + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + integer, intent(in) :: lvlsiz ! dimension of levels array + + integer, intent(out) :: levels(lvlsiz) ! levels indices for block + + ! Local workspace + integer :: k ! loop index + character(len=*), parameter :: sub='get_block_levels_d' + !----------------------------------------------------------------------- + + ! latitude slice block + if (lvlsiz < plev + 1) then + write(iulog,*) sub//': ERROR: levels array not large enough (', & + lvlsiz,' < ',plev + 1,' ) ' + call endrun(sub//': ERROR: levels array not large enough') + else + do k = 0, plev + levels(k+1) = k + end do + do k = plev+2, lvlsiz + levels(k) = -1 + end do + end if + +end subroutine get_block_levels_d + +!======================================================================================== + +subroutine get_gcol_block_d(gcol, cnt, blockid, bcid, localblockid) + + ! Return global block index and local column index + ! for global column index + + ! Arguments + integer, intent(in) :: gcol ! global column index + integer, intent(in) :: cnt ! size of blockid and bcid arrays + + integer, intent(out) :: blockid(cnt) ! block index + integer, intent(out) :: bcid(cnt) ! column index within block + integer, intent(out), optional :: localblockid(cnt) + + ! Local workspace + integer :: i, j, ii, jj ! loop indices + integer :: glon, glat ! global longitude and latitude indices + integer :: ddlon ! number of longitudes in block + character(len=*), parameter :: sub='get_gcol_block_d' + !--------------------------------------------------------------------------- + + ! lon/lat block + if (cnt < 1) then + write(iulog,*) sub//': ERROR: arrays not large enough (', cnt,' < ',1,' )' + call endrun(sub//': ERROR: arrays not large enough') + else + if (spmd_on == 1) then + ! Determine global latitude and longitude coordinate indices from + ! global column index + glat = (gcol-1)/plon + 1 + glon = gcol - ((glat-1)*plon) + + ! Determine block coordinates (ii,jj), where ii ranges from 1 to + ! nprxy_x and jj ranges from 1 to nprxy_y. +#if ( defined SPMD ) + ii = 0 + do i = 1, grid%nprxy_x + if (lonrangexy(1,i) <= glon .and. glon <= lonrangexy(2,i)) ii=i + end do + jj = 0 + do j = 1, grid%nprxy_y + if (latrangexy(1,j) <= glat .and. glat <= latrangexy(2,j)) jj=j + end do + if (ii == 0 .or. jj == 0) then + write(iulog,*) sub//': ERROR: could not find block indices for (', & + glon,',',glat,' ) ' + call endrun(sub//': ERROR: could not find block indices') + end if + + ! Global block index + blockid(1) = (jj-1)*grid%nprxy_x+ii + + ! Local coordinates in block + j = glat-latrangexy(1,jj)+1 + i = glon-lonrangexy(1,ii)+1 + ddlon = lonrangexy(2,ii)-lonrangexy(1,ii)+1 + + ! Local column index in block + bcid(1) = (j-1)*ddlon+i +#endif + else + glat = (gcol-1)/plon + 1 + glon = gcol - ((glat-1)*plon) + + blockid(1) = glat + bcid(1) = glon + end if + + do j=2,cnt + blockid(j) = -1 + bcid(j) = -1 + end do + + end if + +end subroutine get_gcol_block_d + +!======================================================================================== + +integer function get_gcol_block_cnt_d(gcol) + + ! Return number of blocks contain data for the vertical column + ! with the given global column index + + ! Arguments + integer, intent(in) :: gcol ! global column index + !--------------------------------------------------------------------------- + + ! lon/lat block + get_gcol_block_cnt_d = 1 + +end function get_gcol_block_cnt_d + +!======================================================================================== + +integer function get_block_owner_d(blockid) + + ! Return id of processor that "owns" the indicated block + + ! Arguments + integer, intent(in) :: blockid ! global block id + !--------------------------------------------------------------------------- + + ! latitude slice block +#if (defined SPMD) + if (spmd_on .eq. 1) then + get_block_owner_d = blockid - 1 + else + get_block_owner_d = proc(blockid) + end if +#else + get_block_owner_d = 0 +#endif + +end function get_block_owner_d + +!======================================================================================== + +subroutine get_horiz_grid_dim_d(hdim1_d, hdim2_d) + + ! Returns declared horizontal dimensions of computational grid. + ! Note that global column ordering is assumed to be compatible + ! with the first dimension major ordering of the 2D array. + + ! Arguments + integer, intent(out) :: hdim1_d ! first horizontal dimension + integer, intent(out) :: hdim2_d ! second horizontal dimension + !--------------------------------------------------------------------------- + + if (ngcols_d == 0) then + ngcols_d = plat*plon + end if + hdim1_d = plon + hdim2_d = plat + +end subroutine get_horiz_grid_dim_d + +!======================================================================================== + +subroutine get_horiz_grid_d(size, clat_d_out, clon_d_out, area_d_out, wght_d_out, & + lat_d_out, lon_d_out) + + ! Return latitude and longitude (in radians), column surface + ! area (in radians squared) and surface integration weights + ! for global column indices that will be passed to/from physics + + ! Arguments + integer, intent(in) :: size ! array sizes + + real(r8), intent(out), optional :: clat_d_out(size) ! column latitudes + real(r8), intent(out), optional :: clon_d_out(size) ! column longitudes + + real(r8), intent(out), optional :: area_d_out(size) ! column surface + ! area + real(r8), intent(out), optional :: wght_d_out(size) ! column integration + ! weight + real(r8), intent(out), optional :: lat_d_out(size) ! column deg latitudes + real(r8), intent(out), optional :: lon_d_out(size) ! column deg longitudes + + ! Local workspace + integer :: i, j ! loop indices + integer :: n ! column index + real(r8) :: ns_vert(2,plon) ! latitude grid vertices + real(r8) :: ew_vert(2,plon) ! longitude grid vertices + real(r8) :: del_theta ! difference in latitude at a grid point + real(r8) :: del_phi ! difference in longitude at a grid point + real(r8), parameter :: degtorad=pi/180.0_r8 ! convert degrees to radians + character(len=128) :: errormsg + character(len=*), parameter :: sub='get_horiz_grid_d' + !---------------------------------------------------------------------------- + + if (present(clon_d_out)) then + if (size == ngcols_d) then + n = 0 + do j = 1, plat + do i = 1, plon + n = n + 1 + clon_d_out(n) = clon(i,j) + end do + end do + else if(size == plon) then + clon_d_out(:) = clon(:,1) + else + write(errormsg, '(a,4(i0,a))')'clon_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ' .and. ', size, ' /= ', plon,') ' + call endrun(sub//': ERROR: '//errormsg) + end if + end if + + if (present(clat_d_out)) then + if (size == ngcols_d) then + n = 0 + do j = 1, plat + do i = 1, plon + n = n + 1 + clat_d_out(n) = clat(j) + end do + end do + else if (size == plat) then + clat_d_out(:) = clat(:) + else + write(errormsg, '(a,4(i0,a))')'clat_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ' .and. ', size, ' /= ', plat,') ' + call endrun(sub//': ERROR: '//errormsg) + end if + end if + + if (size==plat .and. present(wght_d_out)) then + wght_d_out(:) = w(:) + return + end if + + if ( ( present(area_d_out) ) .or. ( present(wght_d_out) ) ) then + if ((size < ngcols_d) .and. present(area_d_out)) then + write(errormsg, '(a,2(i0,a))')'area_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ') ' + call endrun(sub//': ERROR: '//errormsg) + else if ((size < ngcols_d) .and. present(area_d_out)) then + write(errormsg, '(a,2(i0,a))')'wght_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ') ' + call endrun(sub//': ERROR: '//errormsg) + end if + + n = 0 + do j = 1, plat + + ! First, determine vertices of each grid point. + ! Verticies are ordered as follows: + ! ns_vert: 1=lower left, 2 = upper left + ! ew_vert: 1=lower left, 2 = lower right + + ! Latitude vertices + ns_vert(:,:) = spval + if (j .eq. 1) then + ns_vert(1,:plon) = -90._r8 + (latdeg(1) - latdeg(2))*0.5_r8 + else + ns_vert(1,:plon) = (latdeg(j) + latdeg(j-1) )*0.5_r8 + end if + + if (j .eq. plat) then + ns_vert(2,:plon) = 90._r8 + (latdeg(plat) - latdeg(plat-1))*0.5_r8 + else + ns_vert(2,:plon) = (latdeg(j) + latdeg(j+1) )*0.5_r8 + end if + + ! Longitude vertices + ew_vert(:,:) = spval + ew_vert(1,1) = (londeg(1,j) - 360._r8 + londeg(plon,j))*0.5_r8 + ew_vert(1,2:plon) = (londeg(1:plon-1,j)+ londeg(2:plon,j))*0.5_r8 + ew_vert(2,:plon-1) = ew_vert(1,2:plon) + ew_vert(2,plon) = (londeg(plon,j) + (360._r8 + londeg(1,j)))*0.5_r8 + + do i = 1,plon + n = n + 1 + + if (j .eq. 1) then + del_phi = -sin( latdeg(j)*degtorad ) + sin( ns_vert(2,i)*degtorad ) + else if (j .eq. plat) then + del_phi = sin( latdeg(j)*degtorad ) - sin( ns_vert(1,i)*degtorad ) + else + del_phi = sin( ns_vert(2,i)*degtorad ) - sin( ns_vert(1,i)*degtorad ) + end if + + del_theta = ( ew_vert(2,i) - ew_vert(1,i) )*degtorad + + if (present(area_d_out)) area_d_out(n) = del_theta*del_phi + if (present(wght_d_out)) wght_d_out(n) = del_theta*del_phi + end do + end do + end if + + if (present(lon_d_out)) then + if (size == ngcols_d) then + n = 0 + do j = 1, plat + do i = 1, plon + n = n + 1 + lon_d_out(n) = londeg(i,j) + end do + end do + else if(size == plon) then + lon_d_out(:) = londeg(:,1) + else + write(errormsg, '(a,4(i0,a))')'lon_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ' .and. ', size, ' /= ', plon,') ' + call endrun(sub//': ERROR: '//errormsg) + end if + end if + + if (present(lat_d_out)) then + if (size == ngcols_d) then + n = 0 + do j = 1, plat + do i = 1, plon + n = n + 1 + lat_d_out(n) = latdeg(j) + end do + end do + else if (size == plat) then + lat_d_out(:) = latdeg(:) + else + write(errormsg, '(a,4(i0,a))')'lat_d_out array size incorrect (', & + size, ' /= ', ngcols_d, ' .and. ', size, ' /= ', plat,') ' + call endrun(sub//': ERROR: '//errormsg) + end if + end if + +end subroutine get_horiz_grid_d + +!======================================================================================== + +function get_dyn_grid_parm_real2d(name) result(rval) + + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:,:) + + if(name.eq.'clon') then + rval => clon + else if(name.eq.'londeg') then + rval => londeg + else if(name.eq.'londeg_st') then + rval => londeg_st + else + nullify(rval) + end if +end function get_dyn_grid_parm_real2d + +!======================================================================================== + +function get_dyn_grid_parm_real1d(name) result(rval) + + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:) + + if(name.eq.'clat') then + rval => clat + else if(name.eq.'latdeg') then + rval => latdeg + else if(name.eq.'latdeg_st') then + rval => latdeg_st + else if(name.eq.'clatdeg_staggered') then + rval => latdeg_st + else if(name.eq.'w') then + rval => w + else if(name.eq.'w_staggered') then + rval => w_staggered + else + nullify(rval) + end if +end function get_dyn_grid_parm_real1d + +!======================================================================================== + +integer function get_dyn_grid_parm(name) result(ival) + + character(len=*), intent(in) :: name + + if (name.eq.'splon') then + ival = splon + else if (name.eq.'beglonxy') then + ival = grid%ifirstxy + else if (name.eq.'endlonxy') then + ival = grid%ilastxy + else if (name.eq.'beglatxy') then + ival = grid%jfirstxy + else if (name.eq.'endlatxy') then + ival = grid%jlastxy + else if (name.eq.'plat') then + ival = plat + else if (name.eq.'plon') then + ival = plon + else if (name.eq.'plev') then + ival = plev + else if (name.eq.'plevp') then + ival = plevp + else + ival = -1 + end if + +end function get_dyn_grid_parm + +!======================================================================================== + +subroutine dyn_grid_find_gcols(lat, lon, nclosest, owners, indx, & + jndx, rlat, rlon, idyn_dists) + + ! Return the lat/lon information (and corresponding MPI task numbers (owners)) + ! of the global model grid columns nearest to the input coordinate (lat,lon) + + ! arguments + real(r8), intent(in) :: lat + real(r8), intent(in) :: lon + integer, intent(in) :: nclosest + integer, intent(out) :: owners(nclosest) + integer, intent(out) :: indx(nclosest) + integer, intent(out) :: jndx(nclosest) + + real(r8),optional, intent(out) :: rlon(nclosest) + real(r8),optional, intent(out) :: rlat(nclosest) + real(r8),optional, intent(out) :: idyn_dists(nclosest) + + ! local variables + real(r8) :: dist ! the distance (in radians**2 from lat, lon) + real(r8) :: latr, lonr ! lat, lon inputs converted to radians + integer :: ngcols + integer :: i, j + + integer :: blockid(1), bcid(1), lclblockid(1) + + real(r8), allocatable :: clat_d(:), clon_d(:), distmin(:) + integer, allocatable :: igcol(:) + real(r8), parameter :: rad2deg = 180._r8/pi + !---------------------------------------------------------------------------- + + latr = lat/rad2deg + lonr = lon/rad2deg + + ngcols = plon*plat + allocate( clat_d(1:ngcols) ) + allocate( clon_d(1:ngcols) ) + allocate( igcol(nclosest) ) + allocate( distmin(nclosest) ) + + call get_horiz_grid_d(ngcols, clat_d_out=clat_d, clon_d_out=clon_d) + + igcol(:) = -999 + distmin(:) = 1.e10_r8 + + do i = 1, ngcols + + ! Use the Spherical Law of Cosines to find the great-circle distance. + dist = acos(sin(latr) * sin(clat_d(i)) + cos(latr) * cos(clat_d(i)) * & + cos(clon_d(i) - lonr)) * rearth + do j = nclosest, 1, -1 + if (dist < distmin(j)) then + + if (j < nclosest) then + distmin(j+1) = distmin(j) + igcol(j+1) = igcol(j) + end if + + distmin(j) = dist + igcol(j) = i + else + exit + end if + end do + end do + + do i = 1,nclosest + + call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) + owners(i) = get_block_owner_d(blockid(1)) + + if ( iam==owners(i) ) then + ! get global lat and lon coordinate indices from global column index + ! -- plon is global number of longitude grid points + jndx(i) = (igcol(i)-1)/plon + 1 + indx(i) = igcol(i) - (jndx(i)-1)*plon + else + jndx(i) = -1 + indx(i) = -1 + endif + + if ( present(rlat) ) rlat(i) = clat_d(igcol(i)) * rad2deg + if ( present(rlon) ) rlon(i) = clon_d(igcol(i)) * rad2deg + + if (present(idyn_dists)) then + idyn_dists(i) = distmin(i) + end if + + end do + + deallocate( clat_d ) + deallocate( clon_d ) + deallocate( igcol ) + deallocate( distmin ) + +end subroutine dyn_grid_find_gcols + +!======================================================================================== + +subroutine dyn_grid_get_colndx(igcol, nclosest, owners, indx, jndx) + + ! arguments + integer, intent(in) :: nclosest + integer, intent(in) :: igcol(nclosest) + integer, intent(out) :: owners(nclosest) + integer, intent(out) :: indx(nclosest) + integer, intent(out) :: jndx(nclosest) + + integer :: i + integer :: blockid(1), bcid(1), lclblockid(1) + + do i = 1,nclosest + + call get_gcol_block_d(igcol(i), 1, blockid, bcid, lclblockid) + owners(i) = get_block_owner_d(blockid(1)) + + if ( iam==owners(i) ) then + ! get global lat and lon coordinate indices from global column index + ! -- plon is global number of longitude grid points + jndx(i) = (igcol(i)-1)/plon + 1 + indx(i) = igcol(i) - (jndx(i)-1)*plon + else + jndx(i) = -1 + indx(i) = -1 + end if + + end do + +end subroutine dyn_grid_get_colndx + +!======================================================================================== + +subroutine dyn_grid_get_elem_coords( latndx, rlon, rlat, cdex ) + + ! return coordinates of a latitude slice of the block corresponding + ! to latitude index latndx + + ! arguments + integer, intent(in) :: latndx ! lat index + + real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the latndx slice + real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the latndx slice + integer, optional, intent(out) :: cdex(:) ! global column index + + integer :: i, ii, j + !---------------------------------------------------------------------------- + + if (present(cdex)) cdex(:) = -1 + if (present(rlat)) rlat(:) = -999._r8 + if (present(rlon)) rlon(:) = -999._r8 + + j = latndx + ii = 0 + do i = grid%ifirstxy, grid%ilastxy + ii = ii+1 + if (present(cdex)) cdex(ii) = i + (j-1)*plon + if (present(rlat)) rlat(ii) = clat(j) + if (present(rlon)) rlon(ii) = clon(i,1) + end do + +end subroutine dyn_grid_get_elem_coords + +!======================================================================================== + +subroutine define_cam_grids() + + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap + use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + use cam_grid_support, only: cam_grid_attribute_copy + + integer :: i, j, ind + integer :: beglonxy, endlonxy + integer :: beglatxy, endlatxy + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + type(horiz_coord_t), pointer :: slat_coord + type(horiz_coord_t), pointer :: slon_coord + type(horiz_coord_t), pointer :: zlon_coord + integer(iMap), pointer :: coord_map(:) + integer(iMap), pointer :: grid_map(:,:) + real(r8) :: zlon_bnds(2,1) + real(r8), allocatable :: latvals(:) + real(r8), pointer :: rattval(:) + logical :: is_lon_distributed + !----------------------------------------------------------------------------- + + ! Note: not using get_horiz_grid_dim_d or get_horiz_grid_d since those + ! are deprecated ('cause I said so' -- goldy) + + nullify(lat_coord) + nullify(lon_coord) + nullify(slat_coord) + nullify(slon_coord) + nullify(zlon_coord) + nullify(coord_map) + nullify(grid_map) + nullify(rattval) + + beglonxy = grid%ifirstxy + endlonxy = grid%ilastxy + beglatxy = grid%jfirstxy + endlatxy = grid%jlastxy + + if (iam >= grid%npes_xy) then + ! NB: On inactive PEs, beglonxy should be one and endlonxy should be zero + if (beglonxy /= 1) then + call endrun("DEFINE_CAM_GRIDS: ERROR: Bad beglonxy") + end if + if (endlonxy /= 0) then + call endrun("DEFINE_CAM_GRIDS: ERROR: Bad endlonxy") + end if + ! NB: On inactive PEs, beglatxy should be one and endlatxy should be zero + if (beglatxy /= 1) then + call endrun("DEFINE_CAM_GRIDS: ERROR: Bad beglatxy") + end if + if (endlatxy /= 0) then + call endrun("DEFINE_CAM_GRIDS: ERROR: Bad endlatxy") + end if + end if + + ! Figure out if lon and slon are distributed dimensions + is_lon_distributed = (grid%nprxy_x > 1) + + ! Grid for cell centers + ! Make a map + allocate(grid_map(4, ((endlonxy - beglonxy + 1) * (endlatxy - beglatxy + 1)))) + ind = 0 + do i = beglatxy, endlatxy + do j = beglonxy, endlonxy + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + ! Cell-centered latitude coordinate + allocate(coord_map(endlatxy - beglatxy + 1)) + if (endlatxy >= beglatxy) then + if (beglonxy == 1) then + coord_map = (/ (i, i = beglatxy, endlatxy) /) + else + coord_map = 0 + end if + end if + lat_coord => horiz_coord_create('lat', '', plat, 'latitude', & + 'degrees_north', beglatxy, endlatxy, latdeg(beglatxy:endlatxy), & + map=coord_map) + nullify(coord_map) + + ! Cell-centered longitude coordinate + if (is_lon_distributed) then + allocate(coord_map(endlonxy - beglonxy + 1)) + if (endlonxy >= beglonxy) then + if (beglatxy == 1) then + coord_map = (/ (i, i = beglonxy, endlonxy) /) + else + coord_map = 0 + end if + end if + lon_coord => horiz_coord_create('lon', '', plon, 'longitude', & + 'degrees_east', beglonxy, endlonxy, londeg(beglonxy:endlonxy,1), & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + else + lon_coord => horiz_coord_create('lon', '', plon, 'longitude', & + 'degrees_east', beglonxy, endlonxy, londeg(beglonxy:endlonxy,1)) + end if + ! Cell-centered grid + call cam_grid_register('fv_centers', dyn_decomp, lat_coord, lon_coord, & + grid_map, unstruct=.false.) + allocate(rattval(size(w))) + rattval = w + call cam_grid_attribute_register('fv_centers', 'gw', 'latitude weights', 'lat', rattval) + nullify(rattval) + nullify(grid_map) ! Belongs to the grid + + ! Staggered grid for U_S + ! Make a map + allocate(grid_map(4, ((endlonxy - beglonxy + 1) * (endlatxy - beglatxy + 1)))) + ind = 0 + do i = beglatxy, endlatxy + do j = beglonxy, endlonxy + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + if ((i == beglatxy) .and. (beglatxy == 1)) then + grid_map(4, ind) = 0 + else + grid_map(4, ind) = i - 1 + end if + end do + end do + + ! Staggered latitudes 'skip' the first one so they are 'off by one' + ! This means we always must have a coordinate map + allocate(coord_map(endlatxy - beglatxy + 1)) + ! NB: coord_map(1) == 0 when beglat == 1, that element is not output + do i = 1, size(coord_map) + if (beglonxy == 1) then + coord_map(i) = i + beglatxy - 2 + else + coord_map(i) = 0 + end if + end do + if (iam .lt. grid%npes_xy) then + allocate(latvals(beglatxy:endlatxy)) + if (beglatxy == 1) then + latvals(1) = 0 + latvals(2:endlatxy) = latdeg_st(1:endlatxy-1) + else + i = beglatxy - 1 ! Stupid NAG 'error' + latvals(beglatxy:endlatxy) = latdeg_st(i:endlatxy-1) + end if + else + allocate(latvals(0)) + end if + slat_coord => horiz_coord_create('slat', '', (plat - 1), & + 'staggered latitude', 'degrees_north', beglatxy, endlatxy, latvals, & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + deallocate(latvals) + + call cam_grid_register('fv_u_stagger', dyn_ustag_decomp, slat_coord, & + lon_coord, grid_map, unstruct=.false.) + call cam_grid_attribute_register('fv_u_stagger', 'w_stag', & + 'staggered latitude weights', 'slat', w_staggered) + nullify(grid_map) ! Belongs to the grid + + ! Staggered grid for V_S + ! Make a map (need to do this because lat indices are distributed) + allocate(grid_map(4, ((endlonxy - beglonxy + 1) * (endlatxy - beglatxy + 1)))) + ind = 0 + do i = beglatxy, endlatxy + do j = beglonxy, endlonxy + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + ! Staggered longitude coordinate + if (is_lon_distributed) then + allocate(coord_map(endlonxy - beglonxy + 1)) + if (endlonxy >= beglonxy) then + if (beglatxy == 1) then + coord_map = (/ (i, i = beglonxy, endlonxy) /) + else + coord_map = 0 + end if + end if + slon_coord => horiz_coord_create('slon', '', plon, 'staggered longitude', & + 'degrees_east', beglonxy, endlonxy, londeg_st(beglonxy:endlonxy,1), & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + else + slon_coord => horiz_coord_create('slon', '', plon, 'staggered longitude', & + 'degrees_east', beglonxy, endlonxy, londeg_st(beglonxy:endlonxy,1)) + end if + call cam_grid_register('fv_v_stagger', dyn_vstag_decomp, lat_coord, & + slon_coord, grid_map, unstruct=.false.) + nullify(grid_map) ! Belongs to the grid + + ! Zonal mean grid + ! Make a map + allocate(grid_map(4, (endlatxy - beglatxy + 1))) + ind = 0 + do i = beglatxy, endlatxy + ind = ind + 1 + grid_map(1, ind) = 1 + grid_map(2, ind) = i + grid_map(3, ind) = 1 + grid_map(4, ind) = i + end do + ! We need a special, size-one "longigude" coordinate + ! NB: This is never a distributed coordinate so calc even on inactive PEs + zlon_bnds(1,1) = minval(londeg) + zlon_bnds(2,1) = maxval(londeg) + allocate(latvals(1)) ! Really for a longitude + latvals(1) = 0._r8 + zlon_coord => horiz_coord_create('zlon', '', 1, 'longitude', & + 'degrees_east', 1, 1, latvals(1:1), bnds=zlon_bnds) + deallocate(latvals) + ! Zonal mean grid + call cam_grid_register('fv_centers_zonal', dyn_zonal_decomp, lat_coord, & + zlon_coord, grid_map, unstruct=.false., zonal_grid=.true.) + ! Make sure 'gw' attribute shows up even if all variables are zonal mean + call cam_grid_attribute_copy('fv_centers', 'fv_centers_zonal', 'gw') + nullify(grid_map) ! Belongs to the grid + +end subroutine define_cam_grids + +!======================================================================================== + +subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) + use cam_grid_support, only: max_hcoordname_len + + ! Dummy arguments + character(len=max_hcoordname_len), intent(out) :: gridname + character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) + + gridname = 'fv_centers' + allocate(grid_attribute_names(1)) + grid_attribute_names(1) = 'gw' + +end subroutine physgrid_copy_attributes_d + +!======================================================================================== + +end module dyn_grid diff --git a/src/dynamics/fv/dyn_internal_state.F90 b/src/dynamics/fv/dyn_internal_state.F90 new file mode 100644 index 0000000000..1f41a88d8e --- /dev/null +++ b/src/dynamics/fv/dyn_internal_state.F90 @@ -0,0 +1,52 @@ +module dyn_internal_state + +! Container for the FV dynamics internal state. + +use dynamics_vars, only : t_fvdycore_state, t_fvdycore_grid, & + t_fvdycore_constants, t_fvdycore_vars + +implicit none +private +save + +public :: & + get_dyn_state, & + get_dyn_state_grid, & + get_dyn_state_vars, & + get_dyn_state_constants + +type (t_fvdycore_state), target :: dyn_state + +!======================================================================================== +contains +!======================================================================================== + +function get_dyn_state() result(dynstate) + type(t_fvdycore_state), pointer :: dynstate + dynstate => dyn_state +end function get_dyn_state + +!======================================================================================== + +function get_dyn_state_grid() result(grid) + type(t_fvdycore_grid), pointer :: grid + grid => dyn_state%grid +end function get_dyn_state_grid + +!======================================================================================== + +function get_dyn_state_vars() result(vars) + type(t_fvdycore_vars), pointer :: vars + vars => dyn_state%vars +end function get_dyn_state_vars + +!======================================================================================== + +function get_dyn_state_constants() result(constants) + type(t_fvdycore_constants), pointer :: constants + constants => dyn_state%constants +end function get_dyn_state_constants + +!======================================================================================== + +end module dyn_internal_state diff --git a/src/dynamics/fv/dynamics_vars.F90 b/src/dynamics/fv/dynamics_vars.F90 new file mode 100644 index 0000000000..3f66fb538a --- /dev/null +++ b/src/dynamics/fv/dynamics_vars.F90 @@ -0,0 +1,1090 @@ +module dynamics_vars + +!----------------------------------------------------------------------- +! CAM fvcore internal variables +! +! !REVISION HISTORY: +! 01.06.06 Sawyer Consolidated from various code snippets +! 03.06.25 Sawyer Cleaned up, used ParPatternCopy (Create) +! 03.08.05 Sawyer Removed rayf_init and hswf_init, related vars +! 03.10.22 Sawyer pmgrid removed (now spmd_dyn) +! 03.11.18 Sawyer Removed set_eta (ak, bk, now read from restart) +! 03.12.04 Sawyer Moved T_FVDYCORE_GRID here (removed some vars) +! 04.08.25 Sawyer Removed all module data members, now GRID only +! 04.10.06 Sawyer Added spmd_dyn vars here; ESMF transpose vars +! 05.04.12 Sawyer Added support for r4/r8 tracers +! 05.05.24 Sawyer CAM/GEOS5 merge (removed GEOS_mod dependencies) +! 05.06.10 Sawyer Scaled down version for CAM (no ESMF) +! 05.11.10 Sawyer Removed dyn_interface (now in dyn_comp) +! 06.03.01 Sawyer Removed m_ttrans, q_to_qxy, qxy_to_q, etc. +! 06.05.09 Sawyer Added CONSV to dyn_state (conserve energy) +! 06.08.27 Sawyer Removed unused ESMF code for RouteHandle +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use pmgrid, only: plon, plat, plev + +use decompmodule, only: decomptype +use ghostmodule, only: ghosttype + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +#if defined(SPMD) +use parutilitiesmodule, only: parpatterntype, REAL4, INT4 +#endif + +implicit none +private +save + +public :: & + t_fvdycore_vars, & + t_fvdycore_grid, & + t_fvdycore_constants, & + t_fvdycore_state, & + grid_vars_init, & + dynamics_clean + +#ifdef SPMD +public :: spmd_vars_init +#endif + +! T_FVDYCORE_VARS contains the prognostic variables for FVdycore + +type T_FVDYCORE_VARS + real(r8), dimension(:,:,: ), pointer :: U ! U winds (D-grid) + real(r8), dimension(:,:,: ), pointer :: V ! V winds (D-grid) + real(r8), dimension(:,:,: ), pointer :: PT ! scaled virtual pot. temp. + real(r8), dimension(:,:,: ), pointer :: PE ! Pressure at layer edges + real(r8), dimension(:,:,: ), pointer :: PKZ ! P^kappa mean + real(r8), dimension(:,:,:,:), pointer :: tracer ! Tracers +end type T_FVDYCORE_VARS + +! T_FVDYCORE_GRID contains information about the horizontal and vertical +! discretization and decompositions. + +type T_FVDYCORE_GRID + + ! PILGRIM communication information + + integer :: twod_decomp = 0 ! 1 for multi-2D decompositions, 0 otherwise + ! To assure that the latitudinal decomposition operates + ! as efficiently as before, a separate parameter "twod_decomp" has + ! been defined; a value of 1 refers to the multi-2D decomposition with + ! transposes; a value of 0 means that the decomposition is effectively + ! one-dimensional, thereby enabling the transpose logic to be skipped; + ! there is an option to force computation of transposes even for case + ! where decomposition is effectively 1-D. + + integer :: npes_xy= 1 ! number of PEs for XY decomposition + integer :: npes_yz= 1 ! number of PEs for YZ decomposition + integer :: myid_y = 0 ! subdomain index (0-based) in latitude (y) + integer :: myid_z = 0 ! subdomain index (0 based) in level (z) + integer :: npr_y = 1 ! number of subdomains in y + integer :: npr_z = 1 ! number of subdomains in z + + integer :: myidxy_x = 0 ! subdomain index (0-based) in longitude (x) (second. decomp.) + integer :: myidxy_y = 0 ! subdomain index (0 based) in latitude (y) (second. decomp.) + integer :: nprxy_x = 1 ! number of subdomains in x (second. decomp.) + integer :: nprxy_y = 1 ! number of subdomains in y (second. decomp.) + integer :: iam = 0 ! + + integer :: mod_method = 0 ! 1 for mpi derived types with transposes, 0 for contiguous buffers + integer :: mod_geopk = 0 ! 1 for mpi derived types with transposes, 0 for contiguous buffers + integer :: mod_gatscat = 0 ! 1 for mpi derived types with transposes, 0 for contiguous buffers + + type(decomptype) :: strip2d, strip2dx, strip3dxyz, strip3dxzy, & + strip3dxyzp, strip3zaty, strip3dxzyp, & + strip3yatz, strip3yatzp, strip3zatypt, & + strip3kxyz, strip3kxzy, strip3kxyzp, strip3kxzyp, & + strip3dyz, checker3kxy + + integer :: commdyn ! communicator for all dynamics + integer :: commxy ! communicator for XY decomposition + integer :: commyz ! communicator for YZ decomposition + integer :: commnyz ! communicator for multiple YZ decomposition + + integer :: comm_y ! communicator in latitude + integer :: comm_z ! communicator in vertical + integer :: commxy_x ! communicator in longitude (xy second. decomp.) + integer :: commxy_y ! communicator in latitude (xy second. decomp.) + logical :: geopkdist ! use distributed method for geopotential calculation + ! with 2D decomp. + logical :: geopk16byte ! use Z-parallel distributed method for geopotential + ! calculation with 2D decomp.; otherwise use Z-serial + ! pipeline algorithm when using distributed algoritm + integer :: geopkblocks ! number of stages to use in Z-serial pipeline + ! (non-transpose) geopotential algorithm + integer :: modc_dynrun(4) ! 1: mod_comm irregular underlying communication method for dyn_run/misc + ! 2: mod_comm irregular communication handshaking for dyn_run/misc + ! 3: mod_comm irregular communication send protocol for dyn_run/misc + ! 4: mod_comm irregular communication nonblocking request throttle for dyn_run/misc + integer :: modc_cdcore(4) ! 1: mod_comm irregular underlying communication method for cd_core/geopk + ! 2: mod_comm irregular communication handshaking for cd_core/geopk + ! 3: geopk_d and mod_comm irregular communication send protocol for cd_core/geopk + ! 4: mod_comm irregular communication nonblocking request throttle for cd_core/geopk + integer :: modc_gather(4) ! 1: mod_comm irregular underlying communication method for gather + ! 2: mod_comm irregular communication handshaking for gather + ! 3: mod_comm irregular communication send protocol for gather + ! 4: mod_comm irregular communication nonblocking request throttle for gather + integer :: modc_scatter(4) ! 1: mod_comm irregular underlying communication method for scatter + ! 2: mod_comm irregular communication handshaking for scatter + ! 3: mod_comm irregular communication send protocol for scatter + ! 4: mod_comm irregular communication nonblocking request throttle for scatter + integer :: modc_tracer(4) ! 1: mod_comm irregular underlying communication method for multiple tracers + ! 2: mod_comm irregular communication handshaking for multiple tracers + ! 3: mod_comm irregular communication send protocol for multiple tracers + ! 4: mod_comm irregular communication nonblocking request throttle for multiple tracers + integer :: modc_onetwo ! one or two simultaneous mod_comm irregular communications (excl. tracers) + integer :: modc_tracers ! max number of tracers for simultaneous mod_comm irregular communications + +#if defined(SPMD) + type (ghosttype) :: ghostu_yz, ghostv_yz, ghostpt_yz, & + ghostpe_yz, ghostpkc_yz + type (parpatterntype) :: u_to_uxy, uxy_to_u, v_to_vxy, vxy_to_v, & + ikj_yz_to_xy, ikj_xy_to_yz, & + ijk_yz_to_xy, ijk_xy_to_yz, & + pe_to_pexy, pexy_to_pe, & + pt_to_ptxy, ptxy_to_pt, pkxy_to_pkc, & + r4_xy_to_yz, r4_yz_to_xy, q3_to_qxy3, qxy3_to_q3, & + xy2d_to_yz2d, yz2d_to_xy2d, scatter_3d, gather_3d, & + g_2dxy_r8, g_2dxy_r4, g_2dxy_i4, & + s_2dxy_r8, s_2dxy_r4, s_2dxy_i4, & + g_3dxyz_r8, g_3dxyz_r4, g_3dxyzp_r8, g_3dxyzp_r4, & + s_3dxyz_r8, s_3dxyz_r4, s_3dxyzp_r8, s_3dxyzp_r4 +#endif + + ! END PILGRIM communication information + + + integer :: JFIRST = 1 ! Start latitude (exclusive) + integer :: JLAST = plat ! End latitude (exclusive) + + integer :: ng_c = 0 ! Ccore ghosting + integer :: ng_d = 0 ! Dcore ghosting + integer :: ng_s = 0 ! Staggered grid ghosting for + ! certain arrays, max(ng_c+1,ng_d) + ! For 2D decomposition + + integer :: IFIRSTXY = 1 ! Start longitude (exclusive) + integer :: ILASTXY = plon ! End longitude (exclusive) + integer :: JFIRSTXY = 1 ! Start latitude (exclusive) + integer :: JLASTXY = plat ! End latitude (exclusive) + + integer :: IM ! Full longitude dim + integer :: JM ! Full latitude dim (including poles) + + real(r8) :: DL + real(r8) :: DP + real(r8) :: ACAP + real(r8) :: RCAP + + real(r8), dimension(:), pointer :: COSP ! Cosine of lat angle -- volume mean + real(r8), dimension(:), pointer :: SINP ! Sine of lat angle -- volume mean + real(r8), dimension(:), pointer :: COSE ! Cosine at finite volume edge + real(r8), dimension(:), pointer :: SINE ! Sine at finite volume edge + real(r8), dimension(:), pointer :: ACOSP ! Reciprocal of cosine of lat angle + + real(r8), dimension(:), pointer :: ACOSU ! Reciprocal of cosine of lat angle (staggered) + + real(r8), dimension(:), pointer :: COSLON ! Cosine of longitudes - volume center + real(r8), dimension(:), pointer :: SINLON ! Sine of longitudes - volume center + real(r8), dimension(:), pointer :: COSL5 ! Cosine of longitudes - volume center + real(r8), dimension(:), pointer :: SINL5 ! Sine of longitudes - volume center + + ! Variables which are used repeatedly in CD_CORE + + integer :: js2g0 + integer :: jn2g0 + integer :: jn1g1 + + real(r8), pointer :: trigs(:) + real(r8), pointer :: fc(:), f0(:) + real(r8), pointer :: dc(:,:), de(:,:), sc(:), se(:) + real(r8), pointer :: cdx(:,:), cdy(:,:) + real(r8), pointer :: cdx4(:,:), cdy4(:,:) ! for div4 damping + real(r8), pointer :: cdxde(:,:), cdxdp(:,:),cdyde(:,:),cdydp(:,:) ! for del2 damping + real(r8), pointer :: cdxdiv(:,:), cdydiv(:,:), cdtau4(:,:) ! for del2 damping + + real(r8), pointer :: dcdiv4(:,:), dediv4(:,:), scdiv4(:), sediv4(:) ! for div4 damping + + real(r8), pointer :: dtdx(:), dtdxe(:), txe5(:), dtxe5(:) + real(r8), pointer :: dyce(:), dx(:) , rdx(:), cy(:) + real(r8), pointer :: dtdx2(:), dtdx4(:), dxdt(:), dxe(:) + real(r8), pointer :: cye(:), dycp(:), rdxe(:) + + real(r8) :: rdy, dtdy, dydt, dtdy5, tdy5 + real(r8) :: dt0 = 0 + + integer :: ifax(13) + + real(r8) :: zt_c + real(r8) :: zt_d + + ! This part refers to the vertical grid + + integer :: KM ! Numer of levels + integer :: KMAX ! KM+1 (?) + + ! For 2D decomposition + + integer :: KFIRST = 1 ! Start level (exclusive) + integer :: KLAST = plev ! End level (exclusive) + integer :: KLASTP = plev+1 ! klast+1, except km+1 when klastp=km+1 + + integer :: KORD ! monotonicity order for mapping (te_map) + integer :: KS ! Number of true pressure levels (out of KM+1) + real(r8) :: PTOP ! pressure at top (ak(1)) + real(r8) :: PINT ! initial pressure (ak(km+1)) + real(r8), dimension(:), pointer :: AK ! Sigma mapping + real(r8), dimension(:), pointer :: BK ! Sigma mapping + + ! Tracers + + integer :: NQ ! Number of advected tracers + integer :: NTOTQ ! Total number of tracers (NQ <= NC) + + integer :: ct_overlap ! nonzero for overlap of cd_core and trac2d, 0 otherwise + integer :: trac_decomp ! size of tracer domain decomposition for trac2d + + ! Extra subdomain bounds for cd_core/trac2d overlap and trac2d decomposition + ! Relevant for secondary yz decomposition only; refers back to primary yz decomposition + integer :: JFIRSTCT ! jfirst + integer :: JLASTCT ! jlast + integer :: KFIRSTCT ! kfirst + integer :: KLASTCT ! klast + + ! Bounds for tracer decomposition + integer, dimension(:), pointer :: ktloa ! lower tracer index (global map) + integer, dimension(:), pointer :: kthia ! upper tracer index (global map) + integer :: ktlo ! lower tracer index (local) + integer :: kthi ! upper tracer index (local) + + logical :: high_alt ! high-altitude physics parameters switch + +end type T_FVDYCORE_GRID + +! Constants used by fvcore +type T_FVDYCORE_CONSTANTS + real(r8) :: pi + real(r8) :: omega ! angular velocity of earth's rotation + real(r8) :: cp ! heat capacity of air at constant pressure + real(r8) :: ae ! radius of the earth (m) + real(r8) :: rair ! Gas constant of the air + real(r8) :: cappa ! Cappa? + real(r8) :: zvir ! RWV/RAIR-1 +end type T_FVDYCORE_CONSTANTS + +type t_fvdycore_state + type (t_fvdycore_vars) :: vars + type (t_fvdycore_grid ) :: grid + type (t_fvdycore_constants) :: constants + real(r8) :: DT ! Large time step + real(r8) :: CHECK_DT ! Time step to check maxmin + integer :: ICD, JCD ! Algorithm orders (C Grid) + integer :: IORD, JORD ! Algorithm orders (D Grid) + integer :: KORD ! Vertical order + integer :: TE_METHOD ! method for total energy mapping (te_map) + logical :: CONSV ! dycore conserves tot. en. + integer :: NSPLIT + integer :: NSPLTRAC + integer :: NSPLTVRM + integer :: FILTCW ! filter c-grid winds if positive + integer :: fft_flt ! 0 => FFT/algebraic filter; 1 => FFT filter + integer :: div24del2flag ! 2 for 2nd order div damping, 4 for 4th order div damping, + ! 42 for 4th order div damping plus 2nd order velocity damping + real(r8) :: del2coef ! strength of 2nd order velocity damping + logical :: am_correction ! apply correction for angular momentum (AM) conservation in SW eqns + logical :: am_fixer ! apply global fixer to conserve AM + logical :: am_fix_lbl ! apply global AM fixer level by level + logical :: am_diag ! turns on an AM diagnostic calculations +end type t_fvdycore_state + +!======================================================================================== +contains +!======================================================================================== + +#if defined(SPMD) + +subroutine spmd_vars_init(imxy, jmxy, jmyz, kmyz, grid) + + ! Initialize SPMD related variables. + ! !REVISION HISTORY: + ! 02.11.08 Sawyer Creation + ! 03.05.07 Sawyer Use ParPatternCopy for q_to_qxy, etc. + ! 03.07.23 Sawyer Removed dependency on constituents module + ! 03.09.10 Sawyer Reactivated u_to_uxy, etc, redefined pe2pexy + ! 03.11.19 Sawyer Merged in CAM code with mod_method + ! 04.08.25 Sawyer Added GRID as argument + + use decompmodule, only: decompcreate, decompfree + use ghostmodule, only : ghostcreate, ghostfree + use parutilitiesmodule, only : gid, parpatterncreate, parsplit + use mpishorthand, only: mpiint + + ! Arguments + + integer, dimension(:), intent(in) :: imxy + integer, dimension(:), intent(in) :: jmxy + integer, dimension(:), intent(in) :: jmyz + integer, dimension(:), intent(in) :: kmyz + + type( t_fvdycore_grid ), intent(inout) :: grid + + ! local variables: + + type(decomptype) :: global2d, local2d + + integer :: im, jm, km ! Global dims + integer :: nq + + integer :: nprxy_x ! XY decomp - Nr in X + integer :: nprxy_y ! XY decomp - Nr in Y + integer :: npryz_y ! YZ decomp - Nr in Y + integer :: npryz_z ! YZ decomp - Nr in Z + integer :: npes_xy ! XY decomp - Total nr + integer :: npes_yz ! YZ decomp - Total nr + + integer :: commxy ! Communicator for XY decomp + integer :: commyz ! Communicator for YZ decomp + integer :: commnyz ! Communicator for multiple YZ decomp + + integer :: jfirstxy, jlastxy + integer :: jfirst, jlast + integer :: kfirst, klast + + integer :: ng_s, ng_d ! Ghost widths + + integer :: rank_y, rank_z, rankxy_x, rankxy_y ! Currently not used + integer :: size_y, size_z, sizexy_x, sizexy_y ! Currently not used + + integer :: xdist(1), ydistk(1), zdist1(1), zdistxy(1) ! non-distributed dims + integer, allocatable :: xdist_global(:), ydist_global(:) + integer, allocatable :: zdist(:) ! number of levels per subdomain + + integer :: ig1, ig2, jg1, jg2 + integer :: jg1d, jg2d, jg1s, jg2s + integer :: kg1, kg2, kg2p + + integer :: ct_overlap + integer :: trac_decomp + integer :: ktmod, ml + integer :: myidmod + integer :: ictstuff(4) + integer :: kquot, krem, krun, kt, mlt + !--------------------------------------------------------------------------- + + im = grid%im + jm = grid%jm + km = grid%km + nq = grid%nq + + nprxy_x = grid%nprxy_x + nprxy_y = grid%nprxy_y + npryz_y = grid%npr_y + npryz_z = grid%npr_z + npes_xy = grid%npes_xy + npes_yz = grid%npes_yz + + commxy = grid%commxy + commyz = grid%commyz + commnyz = grid%commnyz + + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + ng_s = grid%ng_s + ng_d = grid%ng_d + + ! Split communicators + call parsplit(commyz, grid%myid_z, gid, grid%comm_y, rank_y, size_y) + call parsplit(commyz, grid%myid_y, gid, grid%comm_z, rank_z, size_z) + call parsplit(commxy, grid%myidxy_y, gid, grid%commxy_x, rankxy_x, sizexy_x) + call parsplit(commxy, grid%myidxy_x, gid, grid%commxy_y, rankxy_y, sizexy_y) + + + ! create decompositions for CAM data structures + + allocate(xdist_global(nprxy_x)) + allocate(ydist_global(nprxy_y)) + allocate(zdist (npryz_z)) + xdist(1) = im + + ! Create PILGRIM decompositions (see decompmodule) + + if (gid < npes_xy) then + xdist_global = 0 + ydist_global = 0 + xdist_global(1) = im + ydist_global(1) = jm + call decompcreate(nprxy_x, nprxy_y, xdist_global, & + ydist_global, global2d) + call decompcreate(nprxy_x, nprxy_y, imxy, jmxy, local2d ) + + ! Decompositions needed on xy decomposition for parpatterncreate + + call decompcreate( 1, npryz_y, xdist, jmyz, grid%strip2d ) + call decompcreate( 1, npryz_y, npryz_z, xdist, & + jmyz, kmyz, grid%strip3dxyz ) + call decompcreate( "xzy", 1, npryz_z, grid%npr_y, xdist, & + kmyz, jmyz, grid%strip3dxzy ) + + ! For y communication within z subdomain (klast version) + ! Use myidmod to have valid index for inactive processes + ! for smaller yz decomposition + myidmod = mod(grid%myid_z, grid%npr_z) ! = myid_z for active yz process + zdist1(1) = kmyz(myidmod+1) + call decompcreate( 1, npryz_y, 1, xdist, jmyz, zdist1, & + grid%strip3yatz ) + + ! For z communication within y subdomain + + ydistk(1) = jmyz(grid%myid_y+1) + call decompcreate( 1, 1, npryz_z, xdist, ydistk, kmyz, & + grid%strip3zaty ) + + ! Arrays dimensioned plev+1 + + zdist(:) = kmyz(:) + zdist(npryz_z) = kmyz(npryz_z) + 1 + call decompcreate( 1, npryz_y, npryz_z, xdist, jmyz, zdist,& + grid%strip3dxyzp ) + call decompcreate( "xzy", 1, npryz_z, npryz_y, & + xdist, zdist, jmyz, grid%strip3dxzyp ) + + ! Arrays dimensioned plev+1, within y subdomain + + ydistk(1) = jmyz(grid%myid_y+1) + call decompcreate( "xzy", 1, npryz_z, 1, xdist, zdist, ydistk, & + grid%strip3zatypt ) + + ! For y communication within z subdomain (klast+1 version) + ! Use myidmod to have valid index for inactive processes + ! for smaller yz decomposition + myidmod = mod(grid%myid_z, grid%npr_z) ! = myid_z for active yz process + zdist1(1) = kmyz(myidmod+1) + call decompcreate( 1, npryz_y, 1, xdist, jmyz, zdist1, & + grid%strip3yatzp ) + + ! For the 2D XY-YZ data transfer, we need a short 3D array + zdist(:) = 1 ! One copy on each z PE set + call decompcreate( 1, npryz_y, npryz_z, & + xdist, jmyz, zdist, grid%strip3dyz ) + end if + + ! Secondary xy decomposition + + if (grid%twod_decomp == 1) then + if (gid < npes_xy) then + zdistxy(1) = npryz_z ! All npr_z copies on 1 PE + call decompcreate( nprxy_x, nprxy_y, 1, & + imxy, jmxy, zdistxy, grid%checker3kxy ) + zdistxy(1) = km + call decompcreate( nprxy_x, nprxy_y, 1, & + imxy, jmxy, zdistxy, grid%strip3kxyz ) + call decompcreate( "xzy", nprxy_x, 1, nprxy_y, & + imxy, zdistxy, jmxy, grid%strip3kxzy ) + + zdistxy(1) = zdistxy(1) + 1 + call decompcreate( nprxy_x, nprxy_y, 1, & + imxy, jmxy, zdistxy, grid%strip3kxyzp ) + call decompcreate( "xzy", nprxy_x, 1, nprxy_y, & + imxy, zdistxy, jmxy, grid%strip3kxzyp ) + zdistxy(1) = jlastxy - jfirstxy + 1 + call decompcreate( nprxy_x, 1, imxy, zdistxy, grid%strip2dx ) + end if + end if + + deallocate(zdist) + deallocate(ydist_global) + deallocate(xdist_global) + + if ( grid%twod_decomp == 1 ) then + + ! Initialize ghost regions + + ! Set limits for ghostcreate + ig1 = 1 + ig2 = im + jg1 = jfirst + jg2 = jlast + jg1d = jfirst-ng_d + jg1s = jfirst-ng_s + jg2d = jlast+ng_d + jg2s = jlast+ng_s + kg1 = kfirst + kg2 = klast + kg2p = klast+1 + + ! Call ghostcreate with null ranges for non-yz processes + if (gid >= npes_yz) then + ig1 = im/2 + ig2 = ig1 - 1 + jg1 = (jfirst+jlast)/2 + jg2 = jg1 - 1 + jg1d = jg1 + jg1s = jg1 + jg2d = jg2 + jg2s = jg2 + kg1 = (kfirst+klast)/2 + kg2 = kg1 - 1 + kg2p = kg2 + end if + + ! Ghosted decompositions needed on xy decomposition for parpatterncreate + if (gid < npes_xy) then + call ghostcreate( grid%strip3dxyz, gid, im, ig1, ig2, .true., & + jm, jg1d, jg2s, .false., & + km, kg1, kg2, .false., grid%ghostu_yz ) + call ghostcreate( grid%strip3dxyz, gid, im, ig1, ig2, .true., & + jm, jg1s, jg2d, .false., & + km, kg1, kg2, .false., grid%ghostv_yz ) + call ghostcreate( grid%strip3dxyz, gid, im, ig1, ig2, .true., & + jm, jg1d, jg2d, .false., & + km, kg1, kg2, .false., grid%ghostpt_yz ) + call ghostcreate( grid%strip3dxzyp, gid, im, ig1, ig2, .true., & + km+1, kg1, kg2p, .false., & + jm, jg1, jg2, .false., grid%ghostpe_yz) + call ghostcreate( grid%strip3dxyzp, gid, im, ig1, ig2, .true., & + jm, jg1, jg2, .false., & + km+1, kg1, kg2p, .false., grid%ghostpkc_yz) + end if + + ! Initialize transposes + + if (gid < npes_xy) then + call parpatterncreate(commxy, grid%ghostu_yz, grid%strip3kxyz, & + grid%u_to_uxy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxyz,grid%ghostu_yz, & + grid%uxy_to_u, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%ghostv_yz, grid%strip3kxyz, & + grid%v_to_vxy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxyz, grid%ghostv_yz, & + grid%vxy_to_v, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3dxyz, grid%strip3kxyz,& + grid%ijk_yz_to_xy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxyz, grid%strip3dxyz,& + grid%ijk_xy_to_yz, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3dxzy, grid%strip3kxzy,& + grid%ikj_yz_to_xy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxzy, grid%strip3dxzy,& + grid%ikj_xy_to_yz, mod_method=grid%mod_method) + + ! Note PE <-> PEXY has been redefined for PEXY ijk, but PE ikj + + call parpatterncreate(commxy, grid%ghostpe_yz, grid%strip3kxzyp, & + grid%pe_to_pexy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxzyp, grid%ghostpe_yz, & + grid%pexy_to_pe, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%ghostpt_yz, grid%strip3kxyz, & + grid%pt_to_ptxy, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3kxyz, grid%ghostpt_yz, & + grid%ptxy_to_pt, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3dxyz, grid%strip3kxyz, & + grid%r4_yz_to_xy, mod_method=grid%mod_method, & + T = REAL4 ) + call parpatterncreate(commxy, grid%strip3kxyz, grid%strip3dxyz, & + grid%r4_xy_to_yz, mod_method=grid%mod_method, & + T = REAL4 ) + call parpatterncreate(commxy, grid%strip3kxyzp, grid%ghostpkc_yz, & + grid%pkxy_to_pkc, mod_method=grid%mod_method) + + ! These are for 'transposing' 2D arrays from XY YZ + call parpatterncreate(commxy, grid%checker3kxy, grid%strip3dyz, & + grid%xy2d_to_yz2d, mod_method=grid%mod_method) + call parpatterncreate(commxy, grid%strip3dyz, grid%checker3kxy, & + grid%yz2d_to_xy2d, mod_method=grid%mod_method) + end if + + ! Free unneeded decompositions + + call decompfree(grid%strip3dxzyp) + call decompfree(grid%strip3dyz) + call decompfree(grid%strip3yatz) + call decompfree(grid%strip3yatzp) + call decompfree(grid%strip3zaty) + call decompfree(grid%strip3zatypt) + call decompfree(grid%strip3kxyz) + call decompfree(grid%strip3kxzy) + call decompfree(grid%strip3kxyzp) + call decompfree(grid%strip3kxzyp) + call decompfree(grid%checker3kxy) + + call ghostfree(grid%ghostu_yz) + call ghostfree(grid%ghostv_yz) + call ghostfree(grid%ghostpt_yz) + call ghostfree(grid%ghostpe_yz) + call ghostfree(grid%ghostpkc_yz) + + end if + + ! Define scatter and gather patterns for 2D and 3D unghosted arrays + + if (gid < npes_xy) then + call parpatterncreate( commxy, global2d, local2d, grid%s_2dxy_r8, & + mod_method=grid%mod_gatscat ) + call parpatterncreate( commxy, local2d, global2d, grid%g_2dxy_r8, & + mod_method=grid%mod_gatscat ) + + call parpatterncreate( commxy, global2d, local2d, grid%s_2dxy_r4, & + mod_method=grid%mod_gatscat, T = REAL4 ) + call parpatterncreate( commxy, local2d, global2d, grid%g_2dxy_r4, & + mod_method=grid%mod_gatscat, T = REAL4 ) + + call parpatterncreate( commxy, global2d, local2d, grid%s_2dxy_i4, & + mod_method=grid%mod_gatscat, T = INT4 ) + call parpatterncreate( commxy, local2d, global2d, grid%g_2dxy_i4, & + mod_method=grid%mod_gatscat, T = INT4 ) + + ! 3D XYZ patterns, will replace XZY patterns eventually + + call parpatterncreate( commxy, grid%s_2dxy_r8, grid%s_3dxyz_r8, km ) + call parpatterncreate( commxy, grid%g_2dxy_r8, grid%g_3dxyz_r8, km ) + call parpatterncreate( commxy, grid%s_2dxy_r8, grid%s_3dxyzp_r8, km+1 ) + call parpatterncreate( commxy, grid%g_2dxy_r8, grid%g_3dxyzp_r8, km+1 ) + + call parpatterncreate( commxy, grid%s_2dxy_r4, grid%s_3dxyz_r4, km ) + call parpatterncreate( commxy, grid%g_2dxy_r4, grid%g_3dxyz_r4, km ) + call parpatterncreate( commxy, grid%s_2dxy_r4, grid%s_3dxyzp_r4, km+1 ) + call parpatterncreate( commxy, grid%g_2dxy_r4, grid%g_3dxyzp_r4, km+1 ) + + call decompfree( global2d ) + call decompfree( local2d ) + end if + + ! Secondary subdomain limits for cd_core/trac2d overlap and trac2d decomposition + + ct_overlap = grid%ct_overlap + trac_decomp = grid%trac_decomp + grid%jfirstct = grid%jfirst + grid%jlastct = grid%jlast + grid%kfirstct = grid%kfirst + grid%klastct = grid%klast + if (ct_overlap > 0) then + mlt = 2 + elseif (trac_decomp .gt. 1) then + mlt = trac_decomp + else + mlt = 1 + end if + + if (mlt > 1) then + if (gid < npes_yz) then + ictstuff(1) = grid%jfirstct + ictstuff(2) = grid%jlastct + ictstuff(3) = grid%kfirstct + ictstuff(4) = grid%klastct + do ml = 2, mlt + call mpisend(ictstuff, 4, mpiint, gid+(ml-1)*npes_yz, gid+(ml-1)*npes_yz, commnyz) + enddo + elseif (gid < mlt*npes_yz) then + ktmod = gid/npes_yz + call mpirecv(ictstuff, 4, mpiint, gid-ktmod*npes_yz, gid, commnyz) + grid%jfirstct = ictstuff(1) + grid%jlastct = ictstuff(2) + grid%kfirstct = ictstuff(3) + grid%klastct = ictstuff(4) + end if + end if + + if (trac_decomp .gt. 1) then + kquot = nq / trac_decomp + krem = nq - kquot * trac_decomp + krun = 0 + do kt = 1, krem + grid%ktloa(kt) = krun + 1 + krun = krun + kquot + 1 + grid%kthia(kt) = krun + enddo + do kt = krem+1, trac_decomp + grid%ktloa(kt) = krun + 1 + krun = krun + kquot + grid%kthia(kt) = krun + enddo + ktmod = gid/npes_yz + 1 + ktmod = min(ktmod, trac_decomp) + grid%ktlo = grid%ktloa(ktmod) + grid%kthi = grid%kthia(ktmod) + endif + +end subroutine spmd_vars_init + +#endif + +!======================================================================================== + +subroutine grid_vars_init(pi, ae, om, dt, fft_flt, & + am_correction, grid) + + ! Initialize FV specific GRID vars + ! + ! !REVISION HISTORY: + ! 00.01.10 Grant Creation using code from SJ Lin + ! 01.06.06 Sawyer Modified for dynamics_vars + ! 04.08.25 Sawyer Now updates GRID + ! 05.06.30 Sawyer Added initializations from cd_core + ! 06.09.15 Sawyer PI now passed as argument + + use pft_module, only: pftinit, pft_cf + + ! Arguments + real(r8), intent(in) :: pi + real(r8), intent(in) :: ae ! radius of the earth (m) + real(r8), intent(in) :: om ! angular velocity of earth's rotation + real(r8), intent(in) :: dt + integer, intent(in) :: fft_flt + logical, intent(in) :: am_correction + + type( T_FVDYCORE_GRID ), intent(inout) :: grid + + ! local variables: + integer :: im + integer :: jm + + real(r8) :: ph5 ! This is to ensure 64-bit for any choice of r8 + + integer :: i, j, imh + real(r8) :: zam5, zamda + integer :: js2g0, jn2g0, jn1g1, js2gc, jn1gc + integer :: js2gs, jn2gd, jn1gs + + real(r8), pointer :: cosp(:), sinp(:), cose(:), sine(:), acosp(:), acosu(:) + real(r8), pointer :: coslon(:), sinlon(:), cosl5(:), sinl5(:) + + real(r8) :: rat, ycrit + real(r8) :: dt5 + + character(len=*), parameter :: sub='grid_vars_init' + !--------------------------------------------------------------------------- + + im = grid%im + jm = grid%jm + + grid%dl = (pi+pi)/im + grid%dp = pi/(jm-1) + + allocate(grid%cosp(jm)) + allocate(grid%sinp(jm)) + allocate(grid%cose(jm)) + allocate(grid%sine(jm)) + allocate(grid%acosp(jm)) + allocate(grid%acosu(jm)) + + allocate(grid%coslon(im)) + allocate(grid%sinlon(im)) + allocate(grid%cosl5(im)) + allocate(grid%sinl5(im)) + + cosp => grid%cosp + sinp => grid%sinp + cose => grid%cose + sine => grid%sine + acosp => grid%acosp + acosu => grid%acosu + + coslon => grid%coslon + sinlon => grid%sinlon + cosl5 => grid%cosl5 + sinl5 => grid%sinl5 + + ! philosophy below: edge values = local true values; centred values = area averages + + do j = 2, jm + ph5 = -0.5_r8*pi + ((j-1)-0.5_r8)*(pi/(jm-1)) + sine(j) = sin(ph5) + end do + + ! cos(theta) at cell center distretized as + ! + ! cos(theta) = d(sin(theta))/d(theta) + + cosp( 1) = 0._r8 + cosp(jm) = 0._r8 + do j = 2, jm-1 + cosp(j) = (sine(j+1)-sine(j)) / grid%dp + end do + + ! Define cosine at edges.. + + if (am_correction) then + do j = 2, jm + ph5 = -0.5_r8*pi + ((j-1)-0.5_r8)*(pi/(jm-1._r8)) + cose(j) = cos(ph5) + end do + else + do j = 2, jm + cose(j) = 0.5_r8 * (cosp(j-1) + cosp(j)) ! dsine/dpe between j+1 and j-1 + end do + end if + cose(1) = cose(2) + + do j = 2, jm-1 + acosu(j) = 2._r8 / (cose(j) + cose(j+1)) + end do + + sinp( 1) = -1._r8 + sinp(jm) = 1._r8 + if (am_correction) then + do j = 2, jm-1 + sinp(j) = (cose(j) - cose(j+1))/grid%dp ! sqrt(cosp^2+sinp^2)=1 + end do + else + do j = 2, jm-1 + sinp(j) = 0.5_r8 * (sine(j) + sine(j+1)) ! 2*sinp*cosp*dp=d(cose^2) + end do + end if + + ! Pole cap area and inverse + grid%acap = im*(1._r8+sine(2)) / grid%dp + grid%rcap = 1._r8 / grid%acap + + imh = im/2 + if (im /= 2*imh) then + write(iulog,*) sub//': ERROR: im must be an even integer' + call endrun(sub//': ERROR: im must be an even integer') + end if + + ! Define logitude at the center of the volume + ! i=1, Zamda = -pi + + do i = 1, imh + zam5 = ((i-1)-0.5_r8) * grid%dl + cosl5(i) = cos(zam5) + cosl5(i+imh) = -cosl5(i) + sinl5(i) = sin(zam5) + sinl5(i+imh) = -sinl5(i) + zamda = (i-1)*grid%dl + coslon(i) = cos(zamda) + coslon(i+imh) = -coslon(i) + sinlon(i) = sin(zamda) + sinlon(i+imh) = -sinlon(i) + end do + + acosp( 1) = grid%rcap * im + acosp(jm) = grid%rcap * im + do j = 2, jm-1 + acosp(j) = 1._r8 / cosp(j) + enddo + + ! cd_core initializations + + allocate(grid%dtdx(jm)) + allocate(grid%dtdx2(jm)) + allocate(grid%dtdx4(jm)) + allocate(grid%dtdxe(jm)) + allocate(grid%dxdt(jm)) + allocate(grid%dxe(jm)) + allocate(grid%cye(jm)) + allocate(grid%dycp(jm)) + allocate(grid%rdxe(jm)) + allocate(grid%txe5(jm)) + allocate(grid%dtxe5(jm)) + allocate(grid%dyce(jm)) + allocate(grid%dx(jm)) + allocate(grid%rdx(jm)) + allocate(grid%cy(jm)) + + js2g0 = max(2,grid%jfirst) + jn2g0 = min(jm-1,grid%jlast) + jn1g1 = min(jm,grid%jlast+1) + js2gc = max(2,grid%jfirst-grid%ng_c) ! NG lats on S (starting at 2) + jn1gc = min(jm,grid%jlast+grid%ng_c) ! ng_c lats on N (ending at jm) + + grid%js2g0 = js2g0 + grid%jn2g0 = jn2g0 + grid%jn1g1 = jn1g1 + + js2gs = max(2,grid%jfirst-grid%ng_s) + jn2gd = min(jm-1,grid%jlast+grid%ng_d) + jn1gs = min(jm,grid%jlast+grid%ng_s) + + allocate(grid%sc(js2g0:jn2g0)) + allocate(grid%se(js2g0:jn1g1)) + allocate(grid%dc(im,js2g0:jn2g0)) + allocate(grid%de(im,js2g0:jn1g1)) + + allocate(grid%scdiv4(js2gs:jn2gd)) !for filtering of u and v in div4 damping + allocate(grid%sediv4(js2gs:jn1gs)) !for filtering of u and v in div4 damping + allocate(grid%dcdiv4(im,js2gs:jn2gd))!for filtering of u and v in div4 damping + allocate(grid%dediv4(im,js2gs:jn1gs))!for filtering of u and v in div4 damping + + call pftinit(im, fft_flt) + + ! Determine ycrit such that effective DX >= DY + rat = real(im,r8)/real(2*(jm-1),r8) + ycrit = acos( min(0.81_r8, rat) ) * (180._r8/pi) + + call pft_cf(im, jm, js2g0, jn2g0, jn1g1, & + grid%sc, grid%se, grid%dc, grid%de, & + grid%cosp, grid%cose, ycrit) + + !for filtering of u and v in div4 damping + !(needs larger halo than cam3.5 code) + call pft_cf(im, jm, js2gs, jn2gd, jn1gs, & + grid%scdiv4, grid%sediv4, grid%dcdiv4, grid%dediv4, & + grid%cosp, grid%cose, ycrit) + + allocate( grid%cdx (js2g0:jn1g1,grid%kfirst:grid%klast) ) + allocate( grid%cdy (js2g0:jn1g1,grid%kfirst:grid%klast) ) + + allocate( grid%cdx4 (js2g0:jn1g1,grid%kfirst:grid%klast) )!for div4 damping + allocate( grid%cdy4 (js2g0:jn1g1,grid%kfirst:grid%klast) )!for div4 damping + + allocate( grid%cdxde (js2g0:jn1g1,grid%kfirst:grid%klast) )!for del2 damping + allocate( grid%cdxdp (js2g0:jn1g1,grid%kfirst:grid%klast) )!for del2 damping + allocate( grid%cdyde (js2g0:jn1g1,grid%kfirst:grid%klast) )!for del2 damping + allocate( grid%cdydp (js2g0:jn1g1,grid%kfirst:grid%klast) )!for del2 damping + + allocate( grid%cdxdiv(jm,grid%kfirst:grid%klast) )!for div4 damping + allocate( grid%cdydiv(jm,grid%kfirst:grid%klast) )!for div4 damping + allocate( grid%cdtau4(js2g0:jn1g1,grid%kfirst:grid%klast) )!for div4 damping + + allocate( grid%f0(grid%jfirst-grid%ng_s-1:grid%jlast+grid%ng_d) ) + allocate( grid%fc(js2gc:jn1gc) ) + + do j = max(1,grid%jfirst-grid%ng_s-1), min(jm,grid%jlast+grid%ng_d) + grid%f0(j) = (om+om)*grid%sinp(j) + end do + + ! Compute coriolis parameter at cell corners. + + if (am_correction) then + do j = js2gc, jn1gc + grid%fc(j) = (om+om)*grid%sine(j) + end do + else + do j = js2gc, jn1gc ! Not the issue with ng_c = ng_d + grid%fc(j) = 0.5_r8*(grid%f0(j) + grid%f0(j-1)) + end do + end if + + grid%dt0 = 0._r8 + dt5 = 0.5_r8*dt + + grid%rdy = 1._r8/(ae*grid%dp) + grid%dtdy = dt *grid%rdy + grid%dtdy5 = dt5*grid%rdy + grid%dydt = (ae*grid%dp) / dt + grid%tdy5 = 0.5_r8/grid%dtdy + +end subroutine grid_vars_init + +!======================================================================================== + +subroutine dynamics_clean(grid) + + ! Arguments + type(t_fvdycore_grid), intent(inout) :: grid + + ! Temporary data structures + + if(associated(GRID%SINLON )) deallocate(GRID%SINLON) + if(associated(GRID%COSLON )) deallocate(GRID%COSLON) + if(associated(GRID%SINL5 )) deallocate(GRID%SINL5) + if(associated(GRID%COSL5 )) deallocate(GRID%COSL5) + + if(associated(GRID%ACOSP )) deallocate(GRID%ACOSP) + if(associated(GRID%ACOSU )) deallocate(GRID%ACOSU) + if(associated(GRID%SINP )) deallocate(GRID%SINP) + if(associated(GRID%COSP )) deallocate(GRID%COSP) + if(associated(GRID%SINE )) deallocate(GRID%SINE) + if(associated(GRID%COSE )) deallocate(GRID%COSE) + if(associated(GRID%AK )) deallocate(GRID%AK) + if(associated(GRID%BK )) deallocate(GRID%BK) + + ! cd_core variables + + if(associated( grid%dtdx )) deallocate(grid%dtdx) + if(associated( grid%dtdx2 )) deallocate(grid%dtdx2) + if(associated( grid%dtdx4 )) deallocate(grid%dtdx4) + if(associated( grid%dtdxe )) deallocate(grid%dtdxe) + if(associated( grid%dxdt )) deallocate(grid%dxdt) + if(associated( grid%dxe )) deallocate(grid%dxe) + if(associated( grid%cye )) deallocate(grid%cye) + if(associated( grid%dycp )) deallocate(grid%dycp) + if(associated( grid%rdxe )) deallocate(grid%rdxe) + if(associated( grid%txe5 )) deallocate(grid%txe5) + if(associated( grid%dtxe5 )) deallocate(grid%dtxe5) + if(associated( grid%dyce )) deallocate(grid%dyce) + if(associated( grid%dx )) deallocate(grid%dx) + if(associated( grid%rdx )) deallocate(grid%rdx) + if(associated( grid%cy )) deallocate(grid%cy) + + if(associated( grid%sc )) deallocate(grid%sc) + if(associated( grid%se )) deallocate(grid%se) + if(associated( grid%dc )) deallocate(grid%dc) + if(associated( grid%de )) deallocate(grid%de) + + if(associated( grid%cdx )) deallocate(grid%cdx) + if(associated( grid%cdy )) deallocate(grid%cdy) + if(associated( grid%cdx4 )) deallocate(grid%cdx4) + if(associated( grid%cdy4 )) deallocate(grid%cdy4) + if(associated( grid%cdxde )) deallocate(grid%cdxde) + if(associated( grid%cdxdp )) deallocate(grid%cdxdp) + if(associated( grid%cdydp )) deallocate(grid%cdydp) + if(associated( grid%cdyde )) deallocate(grid%cdyde) + if(associated( grid%cdxdiv)) deallocate(grid%cdxdiv) + if(associated( grid%cdydiv)) deallocate(grid%cdydiv) + if(associated( grid%cdtau4)) deallocate(grid%cdtau4) + + if(associated( grid%scdiv4)) deallocate(grid%scdiv4) + if(associated( grid%sediv4)) deallocate(grid%sediv4) + if(associated( grid%dcdiv4)) deallocate(grid%dcdiv4) + if(associated( grid%dediv4)) deallocate(grid%dediv4) + + if(associated( grid%f0 )) deallocate(grid%f0) + if(associated( grid%fc )) deallocate(grid%fc) + +#if defined(SPMD) + call spmd_vars_clean(grid) +#endif + +end subroutine dynamics_clean + +!======================================================================================== + +#if defined(SPMD) +subroutine spmd_vars_clean(grid) + + use parutilitiesmodule, only : parpatternfree + + ! args + type (T_FVDYCORE_GRID), intent(inout) :: grid + !----------------------------------------------------------------------- + + if ( grid%twod_decomp == 1 ) then + + ! Clean transposes + + call parpatternfree(grid%commxy, grid%u_to_uxy) + call parpatternfree(grid%commxy, grid%uxy_to_u) + call parpatternfree(grid%commxy, grid%v_to_vxy) + call parpatternfree(grid%commxy, grid%vxy_to_v) + call parpatternfree(grid%commxy, grid%ijk_yz_to_xy) + call parpatternfree(grid%commxy, grid%ijk_xy_to_yz) + call parpatternfree(grid%commxy, grid%ikj_xy_to_yz) + call parpatternfree(grid%commxy, grid%ikj_yz_to_xy) + call parpatternfree(grid%commxy, grid%pe_to_pexy) + call parpatternfree(grid%commxy, grid%pexy_to_pe) + call parpatternfree(grid%commxy, grid%pt_to_ptxy) + call parpatternfree(grid%commxy, grid%ptxy_to_pt) + call parpatternfree(grid%commxy, grid%r4_xy_to_yz) + call parpatternfree(grid%commxy, grid%r4_yz_to_xy) + call parpatternfree(grid%commxy, grid%pkxy_to_pkc) + call parpatternfree(grid%commxy, grid%xy2d_to_yz2d) + call parpatternfree(grid%commxy, grid%yz2d_to_xy2d) + endif + +end subroutine spmd_vars_clean +#endif + +!======================================================================================== + +end module dynamics_vars + diff --git a/src/dynamics/fv/epvd.F90 b/src/dynamics/fv/epvd.F90 new file mode 100644 index 0000000000..b58e47039a --- /dev/null +++ b/src/dynamics/fv/epvd.F90 @@ -0,0 +1,273 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: epvd --- Calculate absolute potential vorticity +! +! !INTERFACE: + subroutine epvd( grid, u, v, pt, delp, grav, ae, omega, epv ) +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use mapz_module, only : ppme + use dynamics_vars, only : T_FVDYCORE_GRID +#if defined( SPMD ) + use parutilitiesmodule, only: sumop, parcollective + use mod_comm, only : gid, mp_send3d, mp_recv3d +#endif + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid ! grid (for XY decomp) + + real (r8) :: u(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real (r8) :: v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real (r8) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real (r8) :: delp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8), intent(in) :: GRAV ! Constants, passed as arguments to + real(r8), intent(in) :: AE ! ensure portability between + real(r8), intent(in) :: OMEGA ! CAM and GEOS5 + +! !OUTPUT PARAMETERS: + real(r8) epv(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + +! !DESCRIPTION: +! Compute absolute vorticity on the D grid +! epv = -g * (vort+f0)*dpt/dp +! +! !REVISION HISTORY: +! WS 99.11.02 Documentation; indentation; jfirstxy:jlastxy +! WS 00.07.08 Use precision module; Kevin's ghost indices +! WS 05.02.16 Rewritten for FVdycore_GridCompMod, XY decomposition +! WS 05.05.25 Add constants to avoid dependencies on GEOS_Mod +! +! !BUGS: +! Not yet tested... +! +!EOP +!--------------------------------------------------------------------- +!BOC + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + + real(r8) :: te(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) + real(r8) :: te2(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) :: t2(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: delp2(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: fx(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy+1) + real(r8) :: fy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + +! Geometric arrays + real(r8) :: rdx(grid%jfirstxy:grid%jlastxy) ! 1 / ae*cos(\theta)* dtheta + real(r8) :: cy(grid%jfirstxy:grid%jlastxy) ! 1 / ae*cos(\theta)* dlam + + integer :: i, j, k, js2g0, jn2g0 + integer :: iam, myidxy_y, nprxy_x, nprxy_y, dest, src ! SPMD related + integer :: im, jm, km ! problem dimensions + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy ! This PE's intervals + real(r8) :: c1, c2, rdy + + real(r8), allocatable :: veast(:,:) ! East halo + real(r8), allocatable :: unorth(:,:) ! North halo + real(r8), allocatable :: fx_sp(:,:), fx_np(:,:) + real(r8), allocatable :: f0(:) ! Coriolis force + real(r8), allocatable :: vort(:,:) ! Relative vorticity + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + iam = grid%iam + myidxy_y = grid%myidxy_y + nprxy_x = grid%nprxy_x + nprxy_y = grid%nprxy_y + + + js2g0 = max(2,jfirstxy) + jn2g0 = min(jm-1,jlastxy) + + allocate(veast(jfirstxy:jlastxy,km)) ! East halo + allocate(unorth(ifirstxy:ilastxy,km)) ! North halo + allocate(fx_sp(im,km), fx_np(im,km) ) + allocate(f0(jfirstxy:jlastxy)) ! Coriolis force + allocate(vort(ifirstxy:ilastxy,jfirstxy:jlastxy)) ! Relative vorticity + + +! Geometric factors + + do j=jfirstxy,jlastxy + f0(j) = D2_0*omega*grid%sinp(j) + enddo + rdy = D1_0/(ae*grid%dp) + do j=js2g0,jn2g0 + rdx(j) = D1_0/(grid%dl*ae*grid%cosp(j)) + cy(j) = rdy / grid%cosp(j) + enddo + + unorth = D0_0 +! Periodic boundary (for the case of no decomposition in X) + do k=1,km + do j=jfirstxy,jlastxy + veast(j,k) = v(ifirstxy,j,k) + enddo + enddo + +#if defined( SPMD ) + if (nprxy_y > 1) then +! Nontrivial y decomposition + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1, km, & + ifirstxy, ilastxy, jfirstxy, jfirstxy, 1, km, u ) + endif + if (nprxy_x > 1) then +! Nontrivial x decomposition + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirstxy, ilastxy, jfirstxy, jlastxy, 1,km, & + ifirstxy, ifirstxy, jfirstxy, jlastxy, 1, km, v ) + endif +#endif + +! Compute PT at layer edges. + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k,t2,delp2,te2) + + do 1000 j=jfirstxy,jlastxy + + do k=1,km + do i=ifirstxy,ilastxy + t2(i,k) = pt(i,j,k) + delp2(i,k) = delp(i,j,k) + enddo + enddo + + call ppme(t2,te2,delp2,ilastxy-ifirstxy+1,km) + + do k=1,km+1 + do i=ifirstxy,ilastxy + te(i,j,k) = te2(i,k) + enddo + enddo + +1000 continue + + +! +! Prepare sum of U-winds for vorticities at pole +! + fx_sp = D0_0 + fx_np = D0_0 +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,k) + do k=1,km + if ( jfirstxy == 1 ) then ! SP + do i=ifirstxy,ilastxy + fx_sp(i,k) = u(i,2,k)*grid%cose(2) + enddo + endif + if ( jlastxy == jm ) then ! NP + do i=ifirstxy,ilastxy + fx_np(i,k) = u(i,jm,k)*grid%cose(jm) + enddo + endif + enddo + + +#if defined( SPMD ) + if ( nprxy_y > 1 ) then +! Non-trivial Y decomposition + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, & + ifirstxy, ilastxy, jlastxy+1, jlastxy+1, 1, km, unorth ) + endif + if ( nprxy_x > 1 ) then +! Non-trivial X decomposition + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, & + ilastxy+1, ilastxy+1, jfirstxy, jlastxy, 1, km, veast ) + endif +#endif + +#if defined( SPMD ) +! +! Collect on all PETs the weighted U-winds at both poles +! + if (nprxy_x > 1) then + call parcollective(grid%commxy_x, sumop, im, km, fx_sp) + call parcollective(grid%commxy_x, sumop, im, km, fx_np) + endif +#endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k,fx,fy,vort,c1,c2) + + do 2000 k=1,km +! Compute relative vorticity + do j=js2g0,jlastxy + do i=ifirstxy,ilastxy + fx(i,j) = u(i,j,k)*grid%cose(j) + enddo + enddo + if ( jlastxy < jm ) then + do i=ifirstxy,ilastxy + fx(i,jlastxy+1) = unorth(i,k)*grid%cose(jlastxy+1) + enddo + endif + + do j=js2g0,jn2g0 + do i=ifirstxy,ilastxy-1 + fy(i,j) = v(i+1,j,k) - v(i,j,k) + enddo + enddo + do j=js2g0,jn2g0 + fy(ilastxy,j) = veast(j,k) - v(ilastxy,j,k) + enddo + + do j=js2g0,jn2g0 + do i=ifirstxy,ilastxy + vort(i,j) = (fx(i,j)-fx(i,j+1))*cy(j) + fy(i,j)*rdx(j) + enddo + enddo + +! Vort at poles computed by circulation theorem + + if ( jfirstxy == 1 ) then + c1 = -SUM(fx_sp(1:im,k))*rdy*grid%rcap + do i=ifirstxy,ilastxy + vort(i, 1) = c1 + enddo + endif + if ( jlastxy == jm ) then + c2 = SUM(fx_np(1:im,k))*rdy*grid%rcap + do i=ifirstxy,ilastxy + vort(i,jm) = c2 + enddo + endif + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy +! Entropy is the thermodynamic variable in the following formulation. + epv(i,j,k) = grav*(vort(i,j)+f0(j))*(te(i,j,k)-te(i,j,k+1)) & + / (pt(i,j,k)*delp(i,j,k)) + enddo + enddo +!!! write(iulog,*) "k", k, ifirstxy, jfirstxy, "minmax epv", minval(epv(:,:,k)), & +!!! maxval(epv(:,:,k)), minloc(epv(:,:,k)), maxloc(epv(:,:,k)) +2000 continue + + deallocate(veast) + deallocate(unorth) + deallocate(fx_sp,fx_np) + deallocate(f0) + deallocate(vort) + + return + end diff --git a/src/dynamics/fv/fill_module.F90 b/src/dynamics/fv/fill_module.F90 new file mode 100644 index 0000000000..488ba564e1 --- /dev/null +++ b/src/dynamics/fv/fill_module.F90 @@ -0,0 +1,622 @@ +module fill_module +!----------------------------------------------------------------------- +! $Id$ +!BOP +! +! !MODULE: fill_module --- utilities for filling in "bad" data + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + +#ifdef NO_R16 + integer,parameter :: r16= selected_real_kind(12) ! 8 byte real +#else + integer,parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + +! +! !PUBLIC MEMBER FUNCTIONS: + public filew, fillxy, fillz, filns, pfix, fill_readnl + +! +! !DESCRIPTION: +! +! This module provides the basic utilities to fill in regions +! with bad "data", for example slightly negative values in fields +! which must be positive, like mixing ratios. Generally this +! means borrowing positive values from neighboring cells. +! +! !REVISION HISTORY: +! 99.03.01 Lin Creation +! 01.02.14 Lin Routines coalesced into this module +! 01.03.26 Sawyer Added ProTeX documentation +! 05.05.25 Sawyer Merged CAM and GEOS5 versions +! +!EOP +!----------------------------------------------------------------------- + +private + +real(r8), parameter :: D0_0 = 0.0_r8 +real(r8), parameter :: D0_5 = 0.5_r8 +real(r8), parameter :: D1_0 = 1.0_r8 +real(r8), parameter :: D1_5 = 1.5_r8 + +character(len=8) :: print_filew_warn = 'off' + +contains + +subroutine fill_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character, masterproc + ! File containing namelist input. + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'fill_readnl' + + namelist /fill_nl/ print_filew_warn + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'fill_nl', status=ierr) + if (ierr == 0) then + read(unitn, fill_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist fill_nl') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(print_filew_warn, len(print_filew_warn), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: print_filew_warn") + +end subroutine fill_readnl + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: filew --- Fill from east and west neighbors; essentially +! performing local flux adjustment +! +! !INTERFACE: + subroutine filew(q, im, jm, jfirst, jlast, acap, ipx, tiny, cosp2) + +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer im ! Longitudes + integer jm ! Total latitudes + integer jfirst ! Starting latitude + integer jlast ! Finishing latitude + + real(r8) tiny ! A small number to pump up value + real(r8) acap ! 1/(polar cap area) + real(r8) cosp2 ! cosine(lat) at j=2 + +! !INPUT/OUTPUT PARAMETERS: + real(r8) q(im,jfirst:jlast) ! Field to adjust + +! !OUTPUT PARAMETERS: + integer ipx ! Flag: 0 if Q not change, 1 if changed + +! !DESCRIPTION: +! Check for "bad" data and fill from east and west neighbors +! +! !REVISION HISTORY: +! 01.99.10 Lin Creation +! 01.07.30 Lin Improvement +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + real(r8) d0, d1, d2 + real(r8) qtmp(jfirst:jlast,im) + real(r8) tinyl ! local tiny mixing ratio + real(r8) qmin + + integer i, j, jm1, ip2 + integer j1, j2 + integer imin, jmin + + j1 = max( jfirst, 2 ) + j2 = min( jlast, jm-1 ) + jm1 = jm-1 + ipx = 0 + +! Copy & swap direction for vectorization. + do j=j1,j2 + do i=1,im + qtmp(j,i) = q(i,j) + enddo + enddo + + do i=2,im-1 + do j=j1,j2 + if(qtmp(j,i) < D0_0) then + tinyl = max(D0_0,qtmp(j,i-1),qtmp(j,i+1))*tiny + ipx = 1 +! west + d0 = max(D0_0,qtmp(j,i-1)) + d1 = min(-qtmp(j,i),d0) + qtmp(j,i-1) = qtmp(j,i-1) - d1 + qtmp(j,i) = qtmp(j,i) + d1 +! east + d0 = max(D0_0,qtmp(j,i+1)) + d2 = min(-qtmp(j,i),d0) + qtmp(j,i+1) = qtmp(j,i+1) - d2 + qtmp(j,i) = qtmp(j,i) + d2 + tinyl + endif + enddo + enddo + + i=1 + do j=j1,j2 + if(qtmp(j,i) < D0_0) then + ipx = 1 + tinyl = max(D0_0,qtmp(j,im),qtmp(j,i+1))*tiny +! west + d0 = max(D0_0,qtmp(j,im)) + d1 = min(-qtmp(j,i),d0) + qtmp(j,im) = qtmp(j,im) - d1 + qtmp(j,i) = qtmp(j,i) + d1 +! east + d0 = max(D0_0,qtmp(j,i+1)) + d2 = min(-qtmp(j,i),d0) + qtmp(j,i+1) = qtmp(j,i+1) - d2 + qtmp(j,i) = qtmp(j,i) + d2 + tinyl + endif + enddo + + i=im + do j=j1,j2 + if(qtmp(j,i) < D0_0) then + ipx = 1 + tinyl = max(D0_0,qtmp(j,i-1),qtmp(j,1))*tiny +! west + d0 = max(D0_0,qtmp(j,i-1)) + d1 = min(-qtmp(j,i),d0) + qtmp(j,i-1) = qtmp(j,i-1) - d1 + qtmp(j,i) = qtmp(j,i) + d1 +! east + d0 = max(D0_0,qtmp(j,1)) + d2 = min(-qtmp(j,i),d0) + qtmp(j,1) = qtmp(j,1) - d2 + qtmp(j,i) = qtmp(j,i) + d2 + tinyl + endif + enddo + + if(ipx .ne. 0) then + +!----------- +! Final pass +!----------- + do i=1,im-1 + do j=j1,j2 + if (qtmp(j,i) < D0_0 ) then +! Take mass from east (essentially adjusting fx(i+1,j)) + qtmp(j,i+1) = qtmp(j,i+1) + qtmp(j,i) + qtmp(j,i) = D0_0 + endif + enddo + enddo + + do i=im,2,-1 + do j=j1,j2 + if (qtmp(j,i) < D0_0 ) then +! Take mass from west (essentially adjusting fx(i,j)) + qtmp(j,i-1) = qtmp(j,i-1) + qtmp(j,i) + qtmp(j,i) = D0_0 + endif + enddo + enddo + + do j=j1,j2 + + qmin = D0_0 + do i=1, im + if (qtmp(j,i) < qmin) then + qmin = qtmp(j,i) + imin = i + jmin = j + endif + enddo + + if (( qmin < D0_0 ) .and. print_filew_warn == "full") then + write(iulog,*) ' filew failed, worst i, j, qtmp, q = ', imin, jmin, qtmp(jmin,imin), q(imin,jmin) + end if + + do i=1,im + q(i,j) = qtmp(j,i) + enddo + enddo + + endif + +! Check Poles. + + if ( jfirst == 1 ) then + if(q(1,1) < D0_0) then + call pfix(q(1,2),q(1,1),im,ipx,acap,cosp2) + else +! Check j=2 + ip2 = 0 + do i=1,im + if(q(i,2).lt.D0_0) then + ip2 = 1 + go to 322 + endif + enddo +322 continue + if(ip2.ne.0) call pfix(q(1,2),q(1,1),im,ipx,acap,cosp2) + endif + endif + + if ( jlast == jm ) then + if(q(1,jm) < D0_0) then + call pfix(q(1,jm1),q(1,jm),im,ipx,acap,cosp2) + else +! Check j=jm1 + ip2 = 0 + do i=1,im + if(q(i,jm1) < D0_0) then + ip2 = 1 + go to 323 + endif + enddo +323 continue + if(ip2.ne.0) call pfix(q(1,jm1),q(1,jm),im,ipx,acap,cosp2) + endif + endif + +!EOC + end subroutine filew +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fillxy --- Fill from east, west, north and south neighbors +! +! !INTERFACE: + subroutine fillxy(q, im, jm, jfirst, jlast, acap, cosp, acosp) + +! !USES: + + implicit none + + integer im ! Longitudes + integer jm ! Total latitudes + integer jfirst ! Starting latitude + integer jlast ! Finishing latitude + + real(r8) acap ! ??? + real(r8) cosp(jm) ! ??? + real(r8) acosp(jm) ! ??? +! +! !INPUT/OUTPUT PARAMETERS: + real(r8) q(im,jfirst:jlast) ! Field to adjust + +! !DESCRIPTION: +! Check for "bad" data and fill from east and west neighbors +! +! !BUGS: +! Currently this routine only performs the east-west fill algorithm. +! This is because the N-S fill is very hard to do in a reproducible +! fashion when the problem is decomposed by latitudes. +! +! !REVISION HISTORY: +! 99.03.01 Lin Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer ipx, ipy, j1, j2 + real(r8) tiny + parameter( tiny = 1.e-20_r8 ) + + call filew(q,im,jm,jfirst,jlast,acap,ipx,tiny,cosp(2)) + +! WS 99.08.03 : S.-J. can you clean up the j1, j2 stuff here? + if(ipx.ne.0) then + + j1 = max( 2, jfirst ) + j2 = min( jm-1, jlast ) +! +! WS 99.08.03 : see comments in "BUGS" above +!!! call filns(q,im,jm,j1,j2,cosp,acosp,ipy,tiny) + +! if(ipy .ne. 0) then +! do fill zonally +! xfx is problematic +! call xfix(q,IM,JM,tiny,qt) +! endif + + endif + +!EOC + end subroutine fillxy +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fillz --- Fill from neighbors below and above +! +! !INTERFACE: + subroutine fillz(im, i1, i2, km, nq, q, dp) + +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: im ! No. of longitudes + integer, intent(in) :: km ! No. of levels + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + integer, intent(in) :: nq ! Total number of tracers + real(r8), intent(in) :: dp(im,km) ! pressure thickness + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: q(im,km,nq) ! tracer mixing ratio + +! !DESCRIPTION: +! Check for "bad" data and fill from east and west neighbors +! +! !BUGS: +! Currently this routine only performs the east-west fill algorithm. +! This is because the N-S fill is very hard to do in a reproducible +! fashion when the problem is decomposed by latitudes. +! +! !REVISION HISTORY: +! 00.04.01 Lin Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, k, ic + real(r8) qup, qly, dup + + do ic=1,nq +! Top layer + do i=i1,i2 + if( q(i,1,ic) < D0_0) then + q(i,2,ic) = q(i,2,ic) + q(i,1,ic)*dp(i,1)/dp(i,2) + q(i,1,ic) = D0_0 + endif + enddo + +! Interior + do k=2,km-1 + do i=i1,i2 + if( q(i,k,ic) < D0_0 ) then +! Borrow from above + qup = q(i,k-1,ic)*dp(i,k-1) + qly = -q(i,k ,ic)*dp(i,k ) + dup = min( D0_5*qly, qup ) !borrow no more than 50% + q(i,k-1,ic) = q(i,k-1,ic) - dup/dp(i,k-1) +! Borrow from below: q(i,k,ic) is still negative at this stage + q(i,k+1,ic) = q(i,k+1,ic) + (dup-qly)/dp(i,k+1) + q(i,k ,ic) = D0_0 + endif + enddo + enddo + +! Bottom layer + k = km + do i=i1,i2 + if( q(i,k,ic) < D0_0) then +! Borrow from above + qup = q(i,k-1,ic)*dp(i,k-1) + qly = -q(i,k ,ic)*dp(i,k ) + dup = min( qly, qup ) + q(i,k-1,ic) = q(i,k-1,ic) - dup/dp(i,k-1) + q(i,k,ic) = D0_0 + endif + enddo + enddo +!EOC +end subroutine fillz +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: filns --- Fill from north and south neighbors +! +! !INTERFACE: + subroutine filns(q,im,jm,j1,j2,cosp,acosp,ipy,tiny) + +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer im ! Longitudes + integer jm ! Total latitudes + integer j1 ! Starting latitude + integer j2 ! Finishing latitude + + + real(r8) tiny ! A small number to pump up value + real(r8) cosp(*) ! ??? + real(r8) acosp(*) ! ??? + +! !INPUT/OUTPUT PARAMETERS: + real(r8) q(im,*) ! Field to adjust + +! !OUTPUT PARAMETERS: + integer ipy ! Flag: 0 if no fill-in, 1 if fill-in + +! !DESCRIPTION: +! Check for "bad" data and fill from north and south neighbors +! +! !BUGS: +! Currently this routine can only be used performs when the +! problem is *not* distributed in latitude (i.e. j1=1, j2=jm). +! This is because the N-S fill is very hard to do in a reproducible +! fashion when the problem is decomposed by latitudes. +! +! !REVISION HISTORY: +! 99.03.01 Lin Creation +! 05.06.30 Sawyer Removed SAVE attribute for cap1 (recalculated) +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, j +! This definition of PI as opposed to 4._r16*atan(1._r16) does not +! appear to generate non-zero differences in GEOS5 checkpoint files + real(R16),parameter :: pi = 3.1415926535897932384626433832795028841971_R16 + real(r8) :: dp, cap1, dq, dn, ds, d0, d1, d2 + + dp = pi/real(jm-1,r16) + cap1 = im*(D1_0-cos((j1-D1_5)*dp))/dp + + ipy = 0 + do j=j1+1,j2-1 + do i=1,im + if(q(i,j).lt.D0_0) then + ipy = 1 + dq = - q(i,j)*cosp(j) +! North + dn = q(i,j+1)*cosp(j+1) + d0 = max(D0_0,dn) + d1 = min(dq,d0) + q(i,j+1) = (dn - d1)*acosp(j+1) + dq = dq - d1 +! South + ds = q(i,j-1)*cosp(j-1) + d0 = max(D0_0,ds) + d2 = min(dq,d0) + q(i,j-1) = (ds - d2)*acosp(j-1) + q(i,j) = (d2 - dq)*acosp(j) + tiny + endif + enddo + enddo + + do i=1,im + if(q(i,j1).lt.D0_0) then + ipy = 1 + dq = - q(i,j1)*cosp(j1) +! North + dn = q(i,j1+1)*cosp(j1+1) + d0 = max(D0_0,dn) + d1 = min(dq,d0) + q(i,j1+1) = (dn - d1)*acosp(j1+1) + q(i,j1) = (d1 - dq)*acosp(j1) + tiny + endif + enddo + + j = j2 + do i=1,im + if(q(i,j).lt.D0_0) then + ipy = 1 + dq = - q(i,j)*cosp(j) +! South + ds = q(i,j-1)*cosp(j-1) + d0 = max(D0_0,ds) + d2 = min(dq,d0) + q(i,j-1) = (ds - d2)*acosp(j-1) + q(i,j) = (d2 - dq)*acosp(j) + tiny + endif + enddo + +! Check Poles. + if(q(1,1).lt.D0_0) then + dq = q(1,1)*cap1/real(im,r8)*acosp(j1) + do i=1,im + q(i,1) = tiny + q(i,j1) = q(i,j1) + dq + q(i,j1) = max(tiny, q(i,j1) + dq ) + enddo + endif + + if(q(1,jm).lt.D0_0) then + dq = q(1,jm)*cap1/real(im,r8)*acosp(j2) + do i=1,im + q(i,jm) = tiny + q(i,j2) = max(tiny, q(i,j2) + dq ) + enddo + endif +!EOC + end subroutine filns +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: pfix --- fix an individual latitude-level +! +! !INTERFACE: + subroutine pfix(q, qp, im, ipx, acap, cosp2) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im ! Longitudes + real(r8) acap ! ??? + real(r8) cosp2 ! ??? + +! !INPUT/OUTPUT PARAMETERS: + real(r8) q(im) ! Latitude-level field to adjust + real(r8) qp(im) ! Second latitude-level field to adjust (usually pole) + +! !OUTPUT PARAMETERS: + integer ipx ! Flag: 0 if Q not change, 1 if changed + + +! !DESCRIPTION: +! Fill one latitude-level from east and west neighbors +! +! !REVISION HISTORY: +! 99.03.01 Lin Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i + real(r8) summ, sump, pmean + + summ = D0_0 + sump = D0_0 + do i=1,im + summ = summ + q(i) + sump = sump + qp(i) + enddo + + sump = sump/im + pmean = (sump*acap + summ*cosp2) / (acap + cosp2*im) + + do i=1,im + q(i) = pmean + qp(i) = pmean + enddo + + if( qp(1) < D0_0 ) then + ipx = 1 + endif + +!EOC + end subroutine pfix +!----------------------------------------------------------------------- + +end module fill_module diff --git a/src/dynamics/fv/fv_prints.F90 b/src/dynamics/fv/fv_prints.F90 new file mode 100644 index 0000000000..8bec4ce20b --- /dev/null +++ b/src/dynamics/fv/fv_prints.F90 @@ -0,0 +1,441 @@ +module fv_prints +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: fv_prints --- print maxima and minima of dycore varibles +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use perf_mod + use cam_logfile, only: iulog +! !PUBLIC MEMBER FUNCTIONS: + PUBLIC fv_out +! +! !DESCRIPTION: +! +! This module provides basic utilities to evaluate the dynamics state +! +! !REVISION HISTORY: +! 00.08.01 Lin Creation +! 01.01.05 Boville Modifications +! 01.03.26 Sawyer Added ProTex documentation +! 03.04.17 Sawyer Bug fix: pls=pls/2*plon instead of 2*plat (Boville) +! 05.07.06 Sawyer Simplified interface with grid +! 06.02.21 Sawyer Converted to XY decomposition +! 06.07.01 Sawyer Transitioned tracers q3 to T_TRACERS +! 06.09.10 Sawyer Isolated magic numbers with F90 parameters +! 08.07.03 Worley Introduced repro_sum logic +! 12.10.29 Santos repro_sum_mod is now shr_reprosum_mod +! +!EOP +!------------------------------------------------------------------------- + +private + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_01 = 0.01_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + real(r8), parameter :: D864_0 = 864.0_r8 + real(r8), parameter :: G_EARTH = 9.80616_r8 + real(r8), parameter :: SECS_PER_1000_DAYS = 86400000.0_r8 + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! !IROUTINE: fv_out --- Write out maxima and minima of dynamics state +! +! !INTERFACE: + subroutine fv_out( grid, pk, pt, ptop, ps, & + tracer, delp, pe, surf_state, phys_state, & + ncdate, ncsec, full_phys ) + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only : T_FVDYCORE_GRID + use ppgrid, only: begchunk, endchunk, pcols, pver + use phys_grid, only: get_ncols_p + use physics_types, only: physics_state + use camsrfexch, only: cam_out_t + use constituents, only: cnst_name +#if defined( SPMD ) + use parutilitiesmodule, only : sumop, parcollective + use mpishorthand, only: mpicom +#endif + use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded + + use gmean_mod, only : gmean + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + + integer ncdate ! Date + integer ncsec ! Time + + real(r8) :: ptop ! Pressure at top +! Surface pressure + real(r8) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) +! Pe**kappa + real(r8) :: pk(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) +! Potential temperature + real(r8) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) +! Layer thickness (pint(k+1) - pint(k)) + real(r8) :: delp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) +! Tracers + real(r8), intent(inout) :: & + tracer(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) +! Edge pressure + real(r8) :: pe(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) + + type(cam_out_t), intent(in), dimension(begchunk:endchunk) :: surf_state + + type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state + logical full_phys ! Full physics on? + +! +! !DESCRIPTION: +! +! Determine maxima and minima of dynamics state and write them out +! +! !REVISION HISTORY: +! 00.08.01 Lin Creation +! 01.01.05 Boville Modifications +! 01.03.26 Sawyer Added ProTex documentation +! 01.06.27 Mirin Converted to 2D yz decomposition +! 01.12.18 Mirin Calculate average height (htsum) metric +! 02.02.13 Eaton Pass precc and precl via cam_out_t type +! 05.07.06 Sawyer Simplified interface with grid +! 06.02.21 Sawyer Converted to XY decomposition +! 06.07.01 Sawyer Transitioned tracers q3 to T_TRACERS +! 08.07.03 Worley Introduced repro_sum and gmean logic +! 12.10.2= Santos repro_sum is now shr_reprosum_mod +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, ic, nj, lchnk, nck, ncol + real(r8), dimension(begchunk:endchunk) :: pmax, tmax, umax, vmax, wmax + real(r8), dimension(begchunk:endchunk) :: pmin, tmin, umin, vmin, wmin + real(r8), dimension(pcols,begchunk:endchunk,1) :: precc ! convective precip rate + real(r8), dimension(pcols,begchunk:endchunk,1) :: precl ! large-scale precip rate + real(r8), dimension(begchunk:endchunk) :: preccmax, preclmax + real(r8), dimension(begchunk:endchunk) :: preccmin, preclmin + real(r8) :: fac, precmax, precmin + real(r8) :: pcon(1), pls(1) + real(r8) :: p1, p2, dtmp, apcon, htsum(1) + real(r8), pointer :: qtmp(:,:,:) + real(r8) :: htg(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real(r8) :: rel_diff(2) + + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: itot, jtot, ltot + + integer :: ntotq ! No. of total tracers + integer :: iam + + integer n, nhmsf + + logical :: write_warning, exceeded + +! statement function for hour minutes seconds of day + nhmsf(n) = n/3600*10000 + mod(n,3600 )/ 60*100 + mod(n, 60) + +! Initialize variables from grid (for convenience) + + im = grid%im + jm = grid%jm + km = grid%km + ifirstxy= grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy= grid%jfirstxy + jlastxy = grid%jlastxy + ntotq = grid%ntotq + + itot = (ilastxy-ifirstxy) + 1 + jtot = (jlastxy-jfirstxy) + 1 + ltot = itot*jtot + + iam = grid%iam + + if (iam == 0) then + write(iulog,*) ' ' + write(iulog,*) nhmsf(ncsec), ncdate + endif + +! +! Check total air and dry air mass. + + call dryairm( grid, .true., ps, tracer, delp, & + pe, .true.) + +!$omp parallel do private(lchnk, ncol) + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + pmax(lchnk) = maxval(phys_state(lchnk)%ps(1:ncol)) + pmin(lchnk) = minval(phys_state(lchnk)%ps(1:ncol)) + tmax(lchnk) = maxval(phys_state(lchnk)%t(1:ncol,1:pver)) + tmin(lchnk) = minval(phys_state(lchnk)%t(1:ncol,1:pver)) + umax(lchnk) = maxval(phys_state(lchnk)%u(1:ncol,1:pver)) + umin(lchnk) = minval(phys_state(lchnk)%u(1:ncol,1:pver)) + vmax(lchnk) = maxval(phys_state(lchnk)%v(1:ncol,1:pver)) + vmin(lchnk) = minval(phys_state(lchnk)%v(1:ncol,1:pver)) + wmax(lchnk) = maxval(phys_state(lchnk)%omega(1:ncol,1:pver)) + wmin(lchnk) = minval(phys_state(lchnk)%omega(1:ncol,1:pver)) + end do + +#if defined( SPMD ) + nck = endchunk - begchunk + 1 + call pmaxmin2('PS', pmin, pmax, nck, D0_01, mpicom) + call pmaxmin2('U ', umin, umax, nck, D1_0, mpicom) + call pmaxmin2('V ', vmin, vmax, nck, D1_0, mpicom) + call pmaxmin2('T ', tmin, tmax, nck, D1_0, mpicom) + call pmaxmin2('W (mb/day)', wmin, wmax, nck, D864_0, mpicom) +#endif + +#if 0 +! +! This code is currently inactive: the maxima and minima were not +! being used +! + nj = (jlastxy - jfirstxy + 1) * (ilastxy - ifirstxy + 1) + do ic=1,ntotq + qtmp => tracer(:,:,:,ic) + call pmaxmin(cnst_name(ic), qtmp, p1, p2, nj, km, D1_0, grid%commxy) +! +! Do something with p1 and p2? +! + end do +#endif + +! +! Calculate the vertically integrated heights +! + htg(:,:) = D0_0 + apcon = D1_0/G_EARTH + +!$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + htg(i,j) = htg(i,j) + apcon * pt(i,j,k) * (pk(i,j,k+1)-pk(i,j,k)) + enddo + enddo + enddo + +!$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + htg(i,j) = htg(i,j)*grid%cosp(j) + enddo + enddo + + call t_startf("fv_out_reprosum") + call shr_reprosum_calc(htg, htsum, ltot, ltot, 1, gbl_count=im*jm, & + commid=grid%commxy, rel_diff=rel_diff) + call t_stopf("fv_out_reprosum") + + ! check that "fast" reproducible sum is accurate enough. + ! NOTE: not recomputing if difference too large. This + ! value is output only, so does not feed back into the + ! simulation + write_warning = .false. + if (iam == 0) write_warning = .true. + exceeded = shr_reprosum_tolExceeded('fv_out', 1, write_warning, & + iulog, rel_diff) + + if (iam == 0) then + htsum(1) = htsum(1) / (D2_0*im) + write(iulog,*) 'Average Height (geopotential units) = ', htsum(1) + endif + + if ( .not. full_phys ) return + +! Global means: + + fac = SECS_PER_1000_DAYS ! convert to mm/day + +!$omp parallel do private(lchnk, ncol) + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + precc(:ncol,lchnk,1) = surf_state(lchnk)%precc(:ncol) + precl(:ncol,lchnk,1) = surf_state(lchnk)%precl(:ncol) + preccmax(lchnk) = maxval(precc(1:ncol,lchnk,1)) + preccmin(lchnk) = minval(precc(1:ncol,lchnk,1)) + preclmax(lchnk) = maxval(precl(1:ncol,lchnk,1)) + preclmin(lchnk) = minval(precl(1:ncol,lchnk,1)) + end do + +#if defined( SPMD ) + nck = endchunk - begchunk + 1 + call pmaxmin2('PRECC', preccmin, preccmax, nck, fac, mpicom) + call pmaxmin2('PRECL', preclmin, preclmax, nck, fac, mpicom) +#endif + + call gmean(precc,pcon,1) + call gmean(precl,pls,1) + + if (iam == 0) then + pcon(1) = pcon(1) * fac + pls(1) = pls(1) * fac + write(iulog,*) 'Total precp=',pcon(1)+pls(1), & + ' CON=', pcon(1),' LS=',pls(1) + write(iulog,*) ' ' + endif + +!EOC + end subroutine fv_out +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: pmaxmin --- Find and print the maxima and minima of a field +! +! !INTERFACE: + subroutine pmaxmin( qname, a, pmin, pmax, im, jm, fac, commun ) + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +#if defined( SPMD ) +#define CPP_PRT_PREFIX if(gid==0) + use parutilitiesmodule, only : gid, maxop, parcollective +#else +#define CPP_PRT_PREFIX +#endif + implicit none + +! !INPUT PARAMETERS: + character*(*) qname ! Name of field + integer im ! Total longitudes + integer jm ! Total latitudes + integer commun ! Communicator + real(r8) a(im,jm) ! 2D field + real(r8) fac ! multiplication factor + +! !OUTPUT PARAMETERS: + real(r8) pmax ! Field maximum + real(r8) pmin ! Field minimum + +! !DESCRIPTION: +! +! Parallelized utility routine for computing/printing global +! max/min from input lists of max/min's (usually for each latitude). +! +! !REVISION HISTORY: +! 00.03.01 Lin Creation +! 00.05.01 Mirin Coalesce variables to minimize collective ops +! 01.08.05 Sawyer Modified to use parcollective +! 01.03.26 Sawyer Added ProTex documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + + integer i, j + real(r8) qmin(jm), qmax(jm) + real(r8) pm(2) + +!$omp parallel do default(shared) private(i,j, pmax, pmin) + + do j=1,jm + pmax = a(1,j) + pmin = a(1,j) + do i=2,im + pmax = max(pmax, a(i,j)) + pmin = min(pmin, a(i,j)) + enddo + qmax(j) = pmax + qmin(j) = pmin + enddo +! +! Now find max/min of qmax/qmin +! + pmax = qmax(1) + pmin = qmin(1) + do j=2,jm + pmax = max(pmax, qmax(j)) + pmin = min(pmin, qmin(j)) + enddo + +#if defined( SPMD ) + pm(1) = pmax + pm(2) = -pmin + call parcollective( commun, maxop, 2, pm ) + pmax = pm(1) + pmin = -pm(2) +#endif + + CPP_PRT_PREFIX write(iulog,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + + return +!EOC + end subroutine pmaxmin +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: pmaxmin2 --- Find and print the maxima and minima of 1-D array +! +! !INTERFACE: + subroutine pmaxmin2( qname, qmin, qmax, nj, fac, commun ) + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +#if defined( SPMD ) +#define CPP_PRT_PREFIX if(gid==0) + use parutilitiesmodule, only : gid, maxop, parcollective +#else +#define CPP_PRT_PREFIX +#endif + implicit none + +! !INPUT PARAMETERS: + character*(*) qname + integer nj + integer commun + real(r8), intent(in), dimension(nj) :: qmax, qmin ! Fields + real(r8) fac ! multiplication factor + +! !DESCRIPTION: +! +! Parallelized utility routine for computing/printing global max/min from +! input lists of max/min's (usually for each latitude). The primary purpose +! is to allow for the original array and the input max/min arrays to be +! distributed across nodes. +! +! !REVISION HISTORY: +! 00.10.01 Lin Creation from pmaxmin +! 01.03.26 Sawyer Added ProTex documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real(r8) pm(2) + real(r8) pmin, pmax + + pmax = maxval(qmax) + pmin = minval(qmin) + +#if defined( SPMD ) + pm(1) = pmax + pm(2) = -pmin + call parcollective( commun, maxop, 2, pm ) + pmax = pm(1) + pmin = -pm(2) +#endif + + CPP_PRT_PREFIX write(iulog,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + + return +!EOC + end subroutine pmaxmin2 +!----------------------------------------------------------------------- + +end module fv_prints diff --git a/src/dynamics/fv/geopk.F90 b/src/dynamics/fv/geopk.F90 new file mode 100644 index 0000000000..d9964961fe --- /dev/null +++ b/src/dynamics/fv/geopk.F90 @@ -0,0 +1,1053 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: geopk --- Calculate geopotential to the kappa +! +!----------------------------------------------------------------------- +! There are three versions of geopk below. The first is the standard +! version and is typically used with transposes between yz and xy +! space. The second (called geopk16) operates in yz space and performs +! semi-global communication in the z direction (to avoid transposes). +! It also can use 16-byte reals to preserve accuracy through round-off; +! this is accomplished by toggling DSIZE to 16 immediately below. +! The third version (called geopk_d) also operates in yz space +! and implements a ring-pipeline algorithm in the z direction. +! Numerics are identical with the first version without requiring +! 16-byte arithmetic. While less parallel, communication costs are +! smaller, and this is often the fastest option. +! +! Note that the interfaces to the first, second, and third versions are +! slightly different. Also, geopk (the standard version with transposes) +! is called for the D-grid during the last two small timesteps in cd_core. +! Geopk16 uses mod_comm communication calls; one can activate the old +! Pilgrim calls (for debugging) by activating PaREXCH immediately below. + +!#define PAREXCH +!#define DSIZE 16 +#define DSIZE 8 + +#if (DSIZE == 16) +# define DTWO 2 +#else +# define DTWO 1 +#endif +!----------------------------------------------------------------------- +! +! !INTERFACE: + subroutine geopk(grid, pe, delp, pk, wz, hs, pt, cp3v, cap3v, nx) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only: T_FVDYCORE_GRID + + implicit none + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(in) :: grid + integer nx ! # of pieces in longitude direction + real(r8) cp3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) cap3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) hs(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real(r8) pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) delp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + +! !OUTPUT PARAMETERS: + real(r8) wz(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! space N*1 S*1 + real(r8) pk(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! space N*1 S*1 + real(r8) pe(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) + +! !DESCRIPTION: +! Calculates geopotential and pressure to the kappa. This is an expensive +! operation and several out arrays are kept around for future use. +! +! !REVISION HISTORY: +! +! WS 99.10.22: MPIed SJ's original SMP version +! SJL 00.01.01: Merged C-core and D-core computation +! SMP "decmposition" in E-W by combining i and j loops +! WS 00.12.01: Replaced MPI_ON with SPMD; hs now distributed +! AAM 01.06.27: Generalize for 2D decomposition +! AAM 01.07.24: Removed dpcheck +! WS 04.10.07: Simplified interface using Grid as input argument +! WS 05.05.25: Merged CAM and GEOS5 versions (mostly CAM) +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local: + real(r8), parameter :: D0_0 = 0.0_r8 + integer :: im, jm, km, jfirst, jlast, ifirst, ilast + real(r8) :: ptop + + integer i, j, k + integer ixj, jp, it, i1, i2, nxu, itot + real(r8) delpp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) cap3vi(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) + real(r8) peln(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) + + logical :: high_alt + high_alt = grid%high_alt + + ptop = grid%ptop + im = grid%im + jm = grid%jm + km = grid%km + ifirst = grid%ifirstxy + ilast = grid%ilastxy + jfirst = grid%jfirstxy + jlast = grid%jlastxy + + itot = ilast - ifirst + 1 +! nxu = nx + nxu = 1 + it = itot / nxu + jp = nxu * ( jlast - jfirst + 1 ) + + if (grid%high_alt) then +!$omp parallel do private(i,j,k) + do k=2,km + do j=grid%jfirstxy,grid%jlastxy + do i=grid%ifirstxy,grid%ilastxy + cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1) + else + cap3vi(:,:,:) = cap3v(grid%ifirstxy,grid%jfirstxy,1) + endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i1, i2, ixj, i, j, k ) + +! do 2000 j=jfirst,jlast + do 2000 ixj=1, jp + + j = jfirst + (ixj-1)/nxu + i1 = ifirst + it * mod(ixj-1, nxu) + i2 = i1 + it - 1 + + do i=i1,i2 + pe(i,1,j) = D0_0 + wz(i,j,km+1) = D0_0 + enddo + +! Top down + do k=2,km+1 + do i=i1,i2 + pe(i,k,j) = pe(i,k-1,j) + delp(i,j,k-1) + enddo + enddo + do k=1,km+1 + do i=i1,i2 + pe(i,k,j) = pe(i,k,j) + ptop + peln(i,k,j) = log(pe(i,k,j)) + pk(i,j,k) = pe(i,k,j)**cap3vi(i,j,k) + enddo + enddo + +! Bottom up + if (high_alt) then + do k=1,km + do i=i1,i2 + delpp(i,j,k) = cp3v(i,j,k)*cap3v(i,j,k)*pt(i,j,k)*pk(i,j,k)*(peln(i,k+1,j)-peln(i,k,j)) + enddo + enddo + else + do k=1,km + do i=i1,i2 + delpp(i,j,k) = cp3v(i,j,k)*pt(i,j,k)*(pk(i,j,k+1)-pk(i,j,k)) + enddo + enddo + endif + + do k=km,1,-1 + do i=i1,i2 + wz(i,j,k) = wz(i,j,k+1)+delpp(i,j,k) + enddo + enddo + do k=1,km+1 + do i=i1,i2 + wz(i,j,k) = wz(i,j,k)+hs(i,j) + enddo + enddo +2000 continue + + return +!EOC + end subroutine geopk +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: geopk16 --- Calculate geopotential to the kappa +! +! !INTERFACE: + subroutine geopk16(grid, pe, delp, pk, wz, hs, pt, ng, cp, akap ) + + use shr_kind_mod, only : r8 => shr_kind_r8, i8 => shr_kind_i8 + use decompmodule, only : decomptype + use dynamics_vars, only : T_FVDYCORE_GRID + +#if defined( SPMD ) + use parutilitiesmodule, only : parexchangevector + use mod_comm, only : blockdescriptor, get_partneroffset, & + mp_sendirr, mp_recvirr, max_nparcels +#endif + + implicit none + +#if defined ( SPMD ) +#include "mpif.h" +#endif + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in) :: ng ! Halo size (not always = ng_d) + + real(r8) akap, cp + real(r8) hs(1:grid%im,grid%jfirst:grid%jlast) + +! !INPUT PARAMETERS: + real(r8) pt(1:grid%im,grid%jfirst-ng:grid%jlast+ng,grid%kfirst:grid%klast) + real(r8) delp(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + +! !OUTPUT PARAMETERS: + real(r8) wz(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! space N*1 S*1 + real(r8) pk(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! space N*1 S*1 + real(r8) pe(1:grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) ! temporary variable + +! !DESCRIPTION: +! Calculates geopotential and pressure to the kappa. This is an expensive +! operation and several out arrays are kept around for future use. +! To preserve accuracy through round-off, 16-byte reals are used +! for some intermediate data. +! +! !REVISION HISTORY: +! +! AAM 00.12.18: Original version +! AAM 03.01.21: Use mod_comm +! WS 03.11.19: Merged latest CAM version (by AAM) +! WS 04.10.07: Simplified interface using Grid as input argument +! WS 05.05.17: Merged CAM and GEOS5 versions +! +!EOP +!--------------------------------------------------------------------- +!BOC + +#ifndef NO_CRAY_POINTERS + +! Local: + integer :: i, j, k, nk, ijtot, ierror, ione + + integer :: im,jm,km, ifirst, ilast, jfirst, jlast, kfirst, klast + real(r8):: ptop + + integer :: npr_y, npr_z, npes_yz, myid_y, myid_z + integer :: twod_decomp, mod_geopk + +#if (DSIZE == 16) +#ifdef NO_R16 + integer,parameter :: r16= selected_real_kind(12) ! 8 byte real +#else + integer,parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + real(r16), parameter :: DP0_0 = 0.0_r16 + real(r16) delp16(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r16) pe16(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real(r16) inbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) + real(r16) outbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) +#else + real (r8), parameter :: DP0_0 = 0.0_r8 + real (r8) delp16(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real (r8) pe16(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real (r8) inbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) + real (r8) outbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) +#endif + integer sendcount(0:grid%npr_z-1), recvcount(0:grid%npr_z-1) + +#if defined(SPMD) +! +! data structures for mp_sendirr, mp_recvirr +! + type (blockdescriptor), allocatable, save :: sendbl1(:), recvbl1(:) + type (blockdescriptor), allocatable, save :: sendbl2(:), recvbl2(:) + +#endif + + integer first_time_through + data first_time_through / 0 / + +! Arrays inbuf8 and outbuf8 are created to fool the compiler +! into accepting them as calling arguments for parexchangevector. +! The trickery below equivalences them to inbuf and outbuf + real (r8) inbuf8(1), outbuf8(1) + pointer (ptr_inbuf8, inbuf8) + pointer (ptr_outbuf8, outbuf8) + integer (i8) locinbuf, locoutbuf + +! +! Initialize variables from Grid +! + ptop = grid%ptop + + im = grid%im + jm = grid%jm + km = grid%km + + ifirst = 1 ! 2004.10.04 (WS): Now hardwired for 1..im + ilast = grid%im ! Code was always used in this mode + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + myid_y = grid%myid_y + myid_z = grid%myid_z + + npr_y = grid%npr_y + npr_z = grid%npr_z + npes_yz = grid%npes_yz + + twod_decomp = grid%twod_decomp + mod_geopk = grid%mod_geopk + + ijtot = (jlast-jfirst+1) * (ilast-ifirst+1) + +#if defined (SPMD) + if (first_time_through .eq. 0) then + first_time_through = 1 + ione = 1 + if (npr_z .gt. 1) then + allocate( sendbl1(0:npes_yz-1) ) + allocate( recvbl1(0:npes_yz-1) ) + allocate( sendbl2(0:npes_yz-1) ) + allocate( recvbl2(0:npes_yz-1) ) + + do nk = 0,npes_yz-1 + + sendbl1(nk)%method = mod_geopk + sendbl2(nk)%method = mod_geopk + recvbl1(nk)%method = mod_geopk + recvbl2(nk)%method = mod_geopk + +! allocate for either method (safety) + allocate( sendbl1(nk)%blocksizes(1) ) + allocate( sendbl1(nk)%displacements(1) ) + allocate( recvbl1(nk)%blocksizes(1) ) + allocate( recvbl1(nk)%displacements(1) ) + allocate( sendbl2(nk)%blocksizes(1) ) + allocate( sendbl2(nk)%displacements(1) ) + allocate( recvbl2(nk)%blocksizes(1) ) + allocate( recvbl2(nk)%displacements(1) ) + + sendbl1(nk)%type = MPI_DATATYPE_NULL + + if ( (nk/npr_y) > myid_z .and. mod(nk,npr_y) == myid_y ) then + + if (mod_geopk .ne. 0) then + call MPI_TYPE_INDEXED(ione, DTWO*ijtot, & + DTWO*ijtot*(klast-kfirst+1), MPI_DOUBLE_PRECISION, & + sendbl1(nk)%type, ierror) + call MPI_TYPE_COMMIT(sendbl1(nk)%type, ierror) + endif + + sendbl1(nk)%blocksizes(1) = DTWO*ijtot + sendbl1(nk)%displacements(1) = DTWO*ijtot*(klast-kfirst+1) + sendbl1(nk)%partneroffset = myid_z * ijtot * DTWO + + else + + sendbl1(nk)%blocksizes(1) = 0 + sendbl1(nk)%displacements(1) = 0 + sendbl1(nk)%partneroffset = 0 + + endif + sendbl1(nk)%nparcels = size(sendbl1(nk)%displacements) + sendbl1(nk)%tot_size = sum(sendbl1(nk)%blocksizes) + max_nparcels = max(max_nparcels, sendbl1(nk)%nparcels) + + recvbl1(nk)%type = MPI_DATATYPE_NULL + + if ( (nk/npr_y) < myid_z .and. mod(nk,npr_y) == myid_y ) then + + if (mod_geopk .ne. 0) then + call MPI_TYPE_INDEXED(ione, DTWO*ijtot, & + nk/npr_y * ijtot * DTWO, MPI_DOUBLE_PRECISION, & + recvbl1(nk)%type, ierror) + call MPI_TYPE_COMMIT(recvbl1(nk)%type, ierror) + endif + + recvbl1(nk)%blocksizes(1) = DTWO*ijtot + recvbl1(nk)%displacements(1) = nk/npr_y * ijtot * DTWO + recvbl1(nk)%partneroffset = 0 + + else + + recvbl1(nk)%blocksizes(1) = 0 + recvbl1(nk)%displacements(1) = 0 + recvbl1(nk)%partneroffset = 0 + + endif + recvbl1(nk)%nparcels = size(recvbl1(nk)%displacements) + recvbl1(nk)%tot_size = sum(recvbl1(nk)%blocksizes) + max_nparcels = max(max_nparcels, recvbl1(nk)%nparcels) + + if ( (nk/npr_y) < myid_z .and. mod(nk,npr_y) == myid_y ) then + + call MPI_TYPE_INDEXED(ione, DTWO*ijtot, & + 0, MPI_DOUBLE_PRECISION, & + sendbl2(nk)%type, ierror) + call MPI_TYPE_COMMIT(sendbl2(nk)%type, ierror) + + sendbl2(nk)%blocksizes(1) = DTWO*ijtot + sendbl2(nk)%displacements(1) = 0 + sendbl2(nk)%partneroffset = (myid_z-nk/npr_y-1) * ijtot * DTWO + + else + + sendbl2(nk)%type = MPI_DATATYPE_NULL + + sendbl2(nk)%blocksizes(1) = 0 + sendbl2(nk)%displacements(1) = 0 + sendbl2(nk)%partneroffset = 0 + + endif + sendbl2(nk)%nparcels = size(sendbl2(nk)%displacements) + sendbl2(nk)%tot_size = sum(sendbl2(nk)%blocksizes) + max_nparcels = max(max_nparcels, sendbl2(nk)%nparcels) + + if ( (nk/npr_y) > myid_z .and. mod(nk,npr_y) == myid_y ) then + + call MPI_TYPE_INDEXED(ione, DTWO*ijtot, & + nk/npr_y * ijtot * DTWO, MPI_DOUBLE_PRECISION, & + recvbl2(nk)%type, ierror) + call MPI_TYPE_COMMIT(recvbl2(nk)%type, ierror) + + recvbl2(nk)%blocksizes(1) = DTWO*ijtot + recvbl2(nk)%displacements(1) = nk/npr_y * ijtot * DTWO + recvbl2(nk)%partneroffset = 0 + + else + + recvbl2(nk)%type = MPI_DATATYPE_NULL + + recvbl2(nk)%blocksizes(1) = 0 + recvbl2(nk)%displacements(1) = 0 + recvbl2(nk)%partneroffset = 0 + + endif + recvbl2(nk)%nparcels = size(recvbl2(nk)%displacements) + recvbl2(nk)%tot_size = sum(recvbl2(nk)%blocksizes) + max_nparcels = max(max_nparcels, recvbl2(nk)%nparcels) + enddo + + call get_partneroffset(grid%commyz, sendbl1, recvbl1) + call get_partneroffset(grid%commyz, sendbl2, recvbl2) + + endif + endif + +#if (!defined PAREXCH) + locinbuf = loc(pe16) +#else + locinbuf = loc(inbuf) +#endif + locoutbuf = loc(outbuf) + ptr_inbuf8 = locinbuf + ptr_outbuf8 = locoutbuf +#endif + +! Top down + +#if (DSIZE == 16) +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do k = kfirst,klast + do j = jfirst,jlast + do i = ifirst,ilast + delp16(i,j,k) = delp(i,j,k) + enddo + enddo + enddo +#endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j) + do j = jfirst,jlast + do i = ifirst,ilast + pe16(i,j,kfirst) = DP0_0 + enddo + enddo + +! compute partial sums + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do j = jfirst,jlast + do k = kfirst+1,klast+1 + do i = ifirst,ilast +#if (DSIZE == 16) + pe16(i,j,k) = pe16(i,j,k-1) + delp16(i,j,k-1) +#else + pe16(i,j,k) = pe16(i,j,k-1) + delp(i,j,k-1) +#endif + enddo + enddo + enddo + +#if defined( SPMD ) + if (npr_z .gt. 1) then + +! communicate upward + +# if !defined (PAREXCH) + call mp_sendirr(grid%commyz, sendbl1, recvbl1, inbuf8, outbuf8, & + modc=grid%modc_cdcore ) + call mp_recvirr(grid%commyz, sendbl1, recvbl1, inbuf8, outbuf8, & + modc=grid%modc_cdcore ) +# else + + do nk = 0, npr_z-1 + sendcount(nk) = 0 + recvcount(nk) = 0 + enddo + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, nk) + do nk = myid_z+1, npr_z-1 + do j = jfirst,jlast + do i = ifirst,ilast + inbuf(i,j,nk-myid_z-1) = pe16(i,j,klast+1) + enddo + enddo +! Double sendcount since quantities are 16-bytes long + sendcount(nk) = DTWO*ijtot + enddo + + call parexchangevector(grid%comm_z, sendcount, inbuf8, recvcount, outbuf8) + +# endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k, nk) + do k = kfirst,klast+1 + do nk = 0, myid_z-1 + do j = jfirst,jlast + do i = ifirst,ilast + pe16(i,j,k) = pe16(i,j,k) + outbuf(i,j,nk) + enddo + enddo + enddo + enddo + + endif +#endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do k = kfirst,klast+1 + do j = jfirst,jlast + do i = ifirst,ilast + pe(i,k,j) = pe16(i,j,k) + ptop + pk(i,j,k) = pe(i,k,j) ** akap + enddo + enddo + enddo + +! Bottom up + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do k = kfirst,klast + do j = jfirst,jlast + do i = ifirst,ilast + delp16(i,j,k) = cp*pt(i,j,k)*(pk(i,j,k+1)-pk(i,j,k)) + enddo + enddo + enddo + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j) + do j = jfirst,jlast + do i = ifirst,ilast + pe16(i,j,klast+1) = DP0_0 + enddo + enddo + +! compute partial sums + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do j = jfirst,jlast + do k = klast,kfirst,-1 + do i = ifirst,ilast + pe16(i,j,k) = pe16(i,j,k+1) + delp16(i,j,k) + enddo + enddo + enddo + +#if defined( SPMD ) + if (npr_z .gt. 1) then + +! communicate downward + +# if !defined (PAREXCH) + call mp_sendirr(grid%commyz, sendbl2, recvbl2, inbuf8, outbuf8, & + modc=grid%modc_cdcore ) + call mp_recvirr(grid%commyz, sendbl2, recvbl2, inbuf8, outbuf8, & + modc=grid%modc_cdcore ) +# else + + do nk = 0, npr_z-1 + sendcount(nk) = 0 + recvcount(nk) = 0 + enddo + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, nk) + do nk = 0, myid_z-1 + do j = jfirst,jlast + do i = ifirst,ilast + inbuf(i,j,nk) = pe16(i,j,kfirst) + enddo + enddo +! Double sendcount since quantities are 16-bytes long + sendcount(nk) = DTWO*ijtot + enddo + + call parexchangevector(grid%comm_z, sendcount, inbuf8, recvcount, outbuf8) + +# endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k, nk) + do k = kfirst,klast+1 + do nk = myid_z+1, npr_z-1 + do j = jfirst,jlast + do i = ifirst,ilast +# if !defined (PAREXCH) + pe16(i,j,k) = pe16(i,j,k) + outbuf(i,j,nk) +# else + pe16(i,j,k) = pe16(i,j,k) + outbuf(i,j,nk-myid_z-1) +# endif + enddo + enddo + enddo + enddo + + endif +#endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, j, k) + do k = kfirst,klast+1 + do j = jfirst,jlast + do i = ifirst,ilast + wz(i,j,k) = pe16(i,j,k) + hs(i,j) + enddo + enddo + enddo + + return +! endif for NO_CRAY_POINTERS +#endif +!EOC + end subroutine geopk16 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: geopk_d --- Calculate geopotential to the kappa +! +! !INTERFACE: + subroutine geopk_d( grid, pe, delp, pk, wz, hs, pt, ng, cp, akap ) + + use shr_kind_mod, only : r8 => shr_kind_r8, i8 => shr_kind_i8 + use dynamics_vars, only : T_FVDYCORE_GRID + + implicit none + +#if defined ( SPMD ) +#include "mpif.h" +#endif + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in) :: ng ! Halo size (not always = ng_d) + + real(r8) akap, cp + real(r8) hs(1:grid%im,grid%jfirst:grid%jlast) + +! !INPUT PARAMETERS: + real(r8) pt(1:grid%im,grid%jfirst-ng:grid%jlast+ng,grid%kfirst:grid%klast) + real(r8) delp(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + +! !OUTPUT PARAMETERS: + real(r8) wz(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! space N*1 S*1 + real(r8) pk(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! space N*1 S*1 + real(r8) pe(1:grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) ! temporary variable + +! !DESCRIPTION: +! Calculates geopotential and pressure to the kappa. This is an expensive +! operation and several out arrays are kept around for future use. +! To preserve reproducibility, ordering of transposed-based geopk algorithm +! is preserved at the cost of a serialization of computation in the Z-direction. +! +! !REVISION HISTORY: +! +! PW 08.06.27: Original: simple ring r8 version of geopk16 - +! serialized Z-direction but minimized communication overhead +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local: + real(r8):: ptop + integer :: km, ifirst, ilast, jfirst, jlast, kfirst, klast + integer :: npr_z + + integer :: itot, jtot + + integer :: n_blocks + logical :: sendd + + integer :: i, il, ilmax, ib, iblksiz + integer :: j, jl, jlmax, jb, jblksiz + integer :: k, block, ierror + + integer :: klimits(2), klimits_all(2,0:grid%npr_z-1) + integer, save :: k_succ_pid, k_pred_pid + + integer, allocatable :: rcvreq(:), sndreq(:) + + real (r8), parameter :: DP0_0 = 0.0_r8 + real (r8) l_pe(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) + real (r8) l_delp(1:grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + + real (r8) inbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) + real (r8) outbuf(1:grid%im,grid%jfirst:grid%jlast,0:grid%npr_z-1) + integer sendcount(0:grid%npr_z-1), recvcount(0:grid%npr_z-1) + + integer first_time_through + data first_time_through / 0 / + +#if defined ( SPMD ) + integer status (MPI_STATUS_SIZE) ! Status of message +#endif + +! +! Initialize variables from Grid +! + ptop = grid%ptop + + km = grid%km + + ifirst = 1 ! 2004.10.04 (WS): Now hardwired for 1..im + ilast = grid%im ! Code was always used in this mode + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + npr_z = grid%npr_z + + itot = (ilast-ifirst+1) + jtot = (jlast-jfirst+1) + + if (grid%modc_cdcore(3) .eq. 1) then + sendd = .true. + else + sendd = .false. + endif + + n_blocks = max(1,grid%geopkblocks) + + if (n_blocks < jtot) then + jblksiz = ceiling(float(jtot)/float(n_blocks)) + iblksiz = itot + else + jblksiz = 1 + iblksiz = ceiling(float(itot*jtot)/float(n_blocks)) + endif + + block = 0 + do j=jfirst,jlast,jblksiz + do i=ifirst,ilast,iblksiz + block = block + 1 + enddo + enddo + + allocate( sndreq(block) ) + allocate( rcvreq(block) ) + + if (first_time_through .eq. 0) then + first_time_through = 1 + k_pred_pid = -1 + k_succ_pid = -1 +#if defined (SPMD) + klimits(1) = kfirst + klimits(2) = klast + call mpi_allgather (klimits, 2, mpi_integer, & + klimits_all, 2, mpi_integer, & + grid%comm_z, ierror) + do i=0,npr_z-1 + if (klimits_all(2,i) == kfirst-1) k_pred_pid = i + if (klimits_all(1,i) == klast+1) k_succ_pid = i + enddo +#endif + endif + +! Top down + +! prepost first set of receive requests +#if defined (SPMD) + if (k_pred_pid /= -1) then + block = 0 + do j=jfirst,jlast,jblksiz + if (j+jblksiz > jlast) then + jb = jlast-j+1 + else + jb = jblksiz + endif + + do i=ifirst,ilast,iblksiz + if (i+iblksiz > ilast) then + ib = ilast-i+1 + else + ib = iblksiz + endif + + block = block + 1 + call mpi_irecv (l_pe(i,j,kfirst), jb*ib, & + mpi_real8, k_pred_pid, block, & + grid%comm_z, rcvreq(block), ierror) + enddo + enddo + endif +#endif + + block = 0 + do j=jfirst,jlast,jblksiz + + if (j+jblksiz > jlast) then + jb = jlast-j+1 + else + jb = jblksiz + endif + jlmax = j+jb-1 + + do i=ifirst,ilast,iblksiz + if (i+iblksiz > ilast) then + ib = ilast-i+1 + else + ib = iblksiz + endif + ilmax = i+ib-1 + + block = block + 1 + +! get data from k predecessor + if (k_pred_pid /= -1) then +#if defined (SPMD) + call mpi_wait (rcvreq(block), status, ierror) +#endif + else + do jl=j,jlmax + do il = i,ilmax + l_pe(il,jl,kfirst) = DP0_0 + enddo + enddo + endif + +! compute partial sums (note that can not thread over k-loop) + do k = kfirst+1,klast+1 + do jl=j,jlmax + do il = i,ilmax + l_pe(il,jl,k) = l_pe(il,jl,k-1) + delp(il,jl,k-1) + enddo + enddo + enddo + +! send results to k successor +#if defined (SPMD) + if (k_succ_pid /= -1) then + if (sendd) then + call mpi_send (l_pe(i,j,klast+1), jb*ib, mpi_real8, & + k_succ_pid, block, grid%comm_z, & + ierror) + else + call mpi_isend (l_pe(i,j,klast+1), jb*ib, mpi_real8, & + k_succ_pid, block, grid%comm_z, & + sndreq(block), ierror) + endif + endif +#endif +!$omp parallel do & +!$omp default(shared) & +!$omp private(il, jl, k) + do k = kfirst,klast+1 + do jl = j,jlmax + do il = i,ilmax + pe(il,k,jl) = l_pe(il,jl,k) + ptop + pk(il,jl,k) = pe(il,k,jl) ** akap + enddo + enddo + enddo + +#if defined (SPMD) + if (k_succ_pid /= -1) then + if (.not. sendd) then + call mpi_wait (sndreq(block), status, ierror) + endif + endif +#endif + enddo + enddo + +! Bottom up + +! prepost second set of receive requests +#if defined (SPMD) + if (k_succ_pid /= -1) then + block = 0 + do j=jfirst,jlast,jblksiz + if (j+jblksiz > jlast) then + jb = jlast-j+1 + else + jb = jblksiz + endif + + do i=ifirst,ilast,iblksiz + if (i+iblksiz > ilast) then + ib = ilast-i+1 + else + ib = iblksiz + endif + + block = block + 1 + call mpi_irecv (l_pe(i,j,klast+1), jb*ib, & + mpi_real8, k_succ_pid, block, & + grid%comm_z, rcvreq(block), ierror) + enddo + enddo + endif +#endif + + block = 0 + do j=jfirst,jlast,jblksiz + + if (j+jblksiz > jlast) then + jb = jlast-j+1 + else + jb = jblksiz + endif + jlmax = j+jb-1 + + do i=ifirst,ilast,iblksiz + if (i+iblksiz > ilast) then + ib = ilast-i+1 + else + ib = iblksiz + endif + ilmax = i+ib-1 + + block = block + 1 + +!$omp parallel do & +!$omp default(shared) & +!$omp private(il, jl, k) + do k = kfirst,klast + do jl=j,jlmax + do il = i,ilmax + l_delp(il,jl,k) = & + cp*pt(il,jl,k)*(pk(il,jl,k+1)-pk(il,jl,k)) + enddo + enddo + enddo + +! get data from k predecessor + if (k_succ_pid /= -1) then +#if defined (SPMD) + call mpi_wait (rcvreq(block), status, ierror) +#endif + else + do jl=j,jlmax + do il = i,ilmax + l_pe(il,jl,klast+1) = DP0_0 + enddo + enddo + endif + +! compute partial sums (note that can not thread over k-loop) + do k = klast,kfirst,-1 + do jl=j,jlmax + do il = i,ilmax + l_pe(il,jl,k) = l_pe(il,jl,k+1) + l_delp(il,jl,k) + enddo + enddo + enddo + +! send results to k predecessor +#if defined (SPMD) + if (k_pred_pid /= -1) then + if (sendd) then + call mpi_send (l_pe(i,j,kfirst), jb*ib, mpi_real8, & + k_pred_pid, block, & + grid%comm_z, ierror) + else + call mpi_isend (l_pe(i,j,kfirst), jb*ib, mpi_real8, & + k_pred_pid, block, & + grid%comm_z, sndreq(block), ierror) + endif + endif +#endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(il, jl, k) + do k = kfirst,klast+1 + do jl=j,jlmax + do il = i,ilmax + wz(il,jl,k) = l_pe(il,jl,k) + hs(il,jl) + enddo + enddo + enddo + +#if defined (SPMD) + if (k_pred_pid /= -1) then + if (.not. sendd) then + call mpi_wait (sndreq(block), status, ierror) + endif + endif +#endif + + enddo + + enddo + + deallocate( sndreq ) + deallocate( rcvreq ) + + return +!EOC + end subroutine geopk_d +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/gravity_waves_sources.F90 b/src/dynamics/fv/gravity_waves_sources.F90 new file mode 100644 index 0000000000..dac38be64d --- /dev/null +++ b/src/dynamics/fv/gravity_waves_sources.F90 @@ -0,0 +1,297 @@ +module gravity_waves_sources + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plev, plevp + use hycoef, only : hypi + + implicit none + save + private + + public :: gws_src_fnct + + ! ghosting added by Francis Vitt -- 7 July 2008 + ! + ! moved from waccm to fv, changed source of psurf_ref + ! -- S Santos -- 10 Aug 2011 + + contains + + +!================================================================= + + subroutine gws_src_fnct(grid, u3,v3,pt, q3, pe, frontgf, frontga) + + use dynamics_vars, only: t_fvdycore_grid + use physconst, only: zvir, cappa, aearth => rearth + + implicit none + +! Input/Output arguments + type (t_fvdycore_grid), intent(in) :: grid ! grid for XY decomp + real(r8), intent(in) :: u3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! zonal velocity + real(r8), intent(in) :: v3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! meridional velocity + real(r8), intent(in) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! virtual temperature + real(r8), intent(in) :: q3(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! water constituent + real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interface pressure + + real(r8), intent(out) :: frontgf(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! Frontogenesis function + real(r8), intent(out) :: frontga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! Frontogenesis angle + +! Locals + real(r8) :: psurf_ref ! surface reference pressure + + real(r8) :: ptemp(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! temperature + real(r8) :: pm(grid%ifirstxy:grid%ilastxy ,plev,grid%jfirstxy:grid%jlastxy) ! mid-point pressure + real(r8) :: pexf ! Exner function + + real(r8) :: pty(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! temperature meridional gradient + real(r8) :: ptx(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! temperature zonal gradient + + real(r8) :: uy(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! U-wind meridional gradient + real(r8) :: ux(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! U-wind zonal gradient + + real(r8) :: vy(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! V-wind meridional gradient + real(r8) :: vx(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! V-wind zonal gradient + + real(r8) :: ptg(grid%ifirstxy-1:grid%ilastxy+1,plev,grid%jfirstxy-1:grid%jlastxy+1) ! temperature ghosted + real(r8) :: ug(grid%ifirstxy-1:grid%ilastxy+1,plev,grid%jfirstxy-1:grid%jlastxy+1) ! U-wind ghosted + real(r8) :: vg(grid%ifirstxy-1:grid%ilastxy+1,plev,grid%jfirstxy-1:grid%jlastxy+1) ! V-wind ghosted + + real(r8) :: tglat ! tangent-latitude + integer :: i,j,k + integer :: im, ip + integer :: beglatxy, endlatxy, beglonxy, endlonxy +!----------------------------------------------------------------------------------------- + + beglatxy = grid%jfirstxy + endlatxy = grid%jlastxy + beglonxy = grid%ifirstxy + endlonxy = grid%ilastxy + + pty(:,:,:) = 0._r8 + ptx(:,:,:) = 0._r8 + uy(:,:,:) = 0._r8 + ux(:,:,:) = 0._r8 + vy(:,:,:) = 0._r8 + vx(:,:,:) = 0._r8 + frontgf(:,:,:) = 0._r8 + frontga(:,:,:) = 0._r8 + + psurf_ref = hypi(plev+1) + + !$omp parallel do private (i,j,k,pexf) + do j = beglatxy, endlatxy + do k = 1, plev + do i = beglonxy, endlonxy + + ! Calculate pressure and Exner function + pm(i,k,j) = 0.5_r8 * ( pe(i,k,j) + pe(i,k+1,j) ) + pexf = (psurf_ref / pm(i,k,j))**cappa + + ! Convert virtual temperature to temperature and calculate potential temperature + ptemp(i,k,j) = pt(i,j,k) / (1._r8 + zvir*q3(i,j,k)) * pexf + + end do + end do + end do + + call ghost_array(grid, ptemp, ptg) + call ghost_array(grid, u3, ug) + call ghost_array(grid, v3, vg) + + !$omp parallel do private (i,j,k) + do k=1, plev + do i=beglonxy, endlonxy + do j=beglatxy, endlatxy + + ! Pot. Temperature + pty(i,k,j) = ( ptg(i,k,j+1) - ptg(i,k,j-1) ) / (2._r8 * grid%dp) + pty(i,k,j) = pty(i,k,j) / aearth + + ! U-wind + uy(i,k,j) = ( ug(i,k,j+1) - ug(i,k,j-1) ) / (2._r8 * grid%dp) + uy(i,k,j) = uy(i,k,j) / aearth + + ! V-wind + vy(i,k,j) = ( vg(i,k,j+1) - vg(i,k,j-1) ) / (2._r8 * grid%dp) + vy(i,k,j) = vy(i,k,j) / aearth + + end do + end do + end do + + !++rrg use 1.e-3 floor on cosine terms in the denominator of frontgf + + !$omp parallel do private (i,j,k,im,ip) + do k=1, plev + do j=beglatxy, endlatxy + do i=beglonxy, endlonxy + + im = i-1 + ip = i+1 + + ! Pot. Temperature + ptx(i,k,j) = ( ptg(ip,k,j) - ptg(im,k,j) ) / (2._r8 * grid%dl) + ptx(i,k,j) = ptx(i,k,j) / (aearth * (grid%cosp(j)+1.e-3_r8)) + + ! U-wind + ux(i,k,j) = ( ug(ip,k,j) - ug(im,k,j) ) / (2._r8 *grid%dl) + ux(i,k,j) = ux(i,k,j) / (aearth * (grid%cosp(j)+1.e-3_r8)) + + ! V-wind + vx(i,k,j) = ( vg(ip,k,j) - vg(im,k,j) ) / (2._r8 *grid%dl) + vx(i,k,j) = vx(i,k,j) / (aearth * (grid%cosp(j)+1.e-3_r8)) + + end do + end do + end do + + !$omp parallel do private (i,j,k, tglat) + do j=beglatxy, endlatxy + + tglat = grid%sinp(j) / (grid%cosp(j)+1.e-3_r8) + + do k=1, plev + do i=beglonxy, endlonxy + + frontgf(i,k,j) = & + - ptx(i,k,j)**2._r8 * (ux(i,k,j) - v3(i,k,j) * tglat / aearth) & + - pty(i,k,j)**2._r8 * vy(i,k,j) & + - ptx(i,k,j) * pty(i,k,j) * ( vx(i,k,j) + uy(i,k,j) + u3(i,k,j) * tglat / aearth ) + + end do + end do + + end do + + !--rrg use 1.e-3 floor on cosine terms in the denominator of frontgf + + !$omp parallel do private (i,j,k) + do j=beglatxy, endlatxy + do k=1, plev + do i=beglonxy, endlonxy + frontga(i,k,j) = atan2 ( pty(i,k,j) , ptx(i,k,j) + 1.e-10_r8 ) + end do + end do + end do + + return + + end subroutine gws_src_fnct + + subroutine ghost_array(grid, x, xg) + + ! subroutine added by Francis Vitt -- 7 July 2008 + +#if defined( SPMD ) + use mod_comm, only: mp_send3d, mp_recv3d +#endif + use dynamics_vars, only: T_FVDYCORE_GRID + + implicit none + + ! Input/Output arguments + type (T_FVDYCORE_GRID), intent(in) :: grid ! grid for XY decomp + real(r8), intent(in) :: x(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! zonal velocity + real(r8), intent(out) :: xg(grid%ifirstxy-1:grid%ilastxy+1,plev,grid%jfirstxy-1:grid%jlastxy+1) ! zonal velocity + + ! local variables + real(r8) :: north(grid%ifirstxy:grid%ilastxy,plev) + real(r8) :: south(grid%ifirstxy:grid%ilastxy,plev) + real(r8) :: east(plev,grid%jfirstxy:grid%jlastxy) + real(r8) :: west(plev,grid%jfirstxy:grid%jlastxy) + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy, iam, myidxy_y, nprxy_x + integer :: itot, dest, src, j, k + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + iam = grid%iam + myidxy_y = grid%myidxy_y + nprxy_x = grid%nprxy_x + itot = ilastxy-ifirstxy+1 + + xg(ifirstxy:ilastxy,:,jfirstxy:jlastxy) = x(ifirstxy:ilastxy,:,jfirstxy:jlastxy) + +#if defined( SPMD ) + + ! north + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ifirstxy, ilastxy, 1, km, jfirstxy, jfirstxy, x ) + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirstxy, ilastxy, 1, km, jlastxy+1, jlastxy+1, & + ifirstxy, ilastxy, 1, km, jlastxy+1, jlastxy+1, north ) + + ! south + call mp_send3d( grid%commxy, iam+nprxy_x, iam-nprxy_x, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ifirstxy, ilastxy, 1, km, jlastxy, jlastxy, x ) + call mp_recv3d( grid%commxy, iam-nprxy_x, im, jm, km, & + ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, & + ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, south ) + +#endif + + if (itot .ne. im) then +#if defined( SPMD ) + + ! east + + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ifirstxy, ifirstxy, 1, km, jfirstxy, jlastxy, x ) + call mp_recv3d( grid%commxy, src, im, km, jm, & + ilastxy+1, ilastxy+1, 1, km, jfirstxy, jlastxy, & + ilastxy+1, ilastxy+1, 1, km, jfirstxy, jlastxy, east ) + + ! west + + dest = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ilastxy, ilastxy, 1, km, jfirstxy, jlastxy, x ) + call mp_recv3d( grid%commxy, src, im, km, jm, & + ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, & + ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, west ) +#endif + + else +!$omp parallel do private(j, k) + do k = 1,km + do j=jfirstxy,jlastxy + east(k,j) = x(1, k,j) + west(k,j) = x(im,k,j) + enddo + enddo + endif + + if ( jfirstxy == 1 ) then + xg(ifirstxy:ilastxy,:,jfirstxy-1) = xg(ifirstxy:ilastxy,:,jfirstxy) + else + xg(ifirstxy:ilastxy,:,jfirstxy-1) = south + endif + + if ( jlastxy == jm ) then + xg(ifirstxy:ilastxy,:,jlastxy+1) = xg(ifirstxy:ilastxy,:,jlastxy) + else + xg(ifirstxy:ilastxy,:,jlastxy+1) = north + endif + + xg(ifirstxy-1,:,jfirstxy:jlastxy) = west + xg( ilastxy+1,:,jfirstxy:jlastxy) = east + + end subroutine ghost_array +!================================================================= + + end module gravity_waves_sources diff --git a/src/dynamics/fv/interp_mod.F90 b/src/dynamics/fv/interp_mod.F90 new file mode 100644 index 0000000000..a36f01d731 --- /dev/null +++ b/src/dynamics/fv/interp_mod.F90 @@ -0,0 +1,65 @@ +module interp_mod + use shr_kind_mod, only : r8=>shr_kind_r8 + use cam_abortutils, only : endrun + + implicit none + private + save + + public :: setup_history_interpolation + public :: set_interp_hfile + public :: write_interpolated + + interface write_interpolated + module procedure write_interpolated_scalar + module procedure write_interpolated_vector + end interface + integer, parameter :: nlat=0, nlon=0 +contains + + subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & + interp_info) + use cam_history_support, only: interp_info_t + + ! Dummy arguments + logical, intent(inout) :: interp_ok + integer, intent(in) :: mtapes + logical, intent(in) :: interp_output(:) + type(interp_info_t), intent(inout) :: interp_info(:) + + interp_ok = .false. + + end subroutine setup_history_interpolation + + subroutine set_interp_hfile(hfilenum, interp_info) + use cam_history_support, only: interp_info_t + + ! Dummy arguments + integer, intent(in) :: hfilenum + type(interp_info_t), intent(inout) :: interp_info(:) + end subroutine set_interp_hfile + + subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) + use pio, only : file_desc_t, var_desc_t + use shr_kind_mod, only : r8=>shr_kind_r8 + implicit none + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(inout) :: varid + real(r8), intent(in) :: fld(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + call endrun('This routine is a stub, you shouldnt get here') + + end subroutine write_interpolated_scalar + + subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) + use pio, only : file_desc_t, var_desc_t + implicit none + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(inout) :: varidu, varidv + real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + call endrun('This routine is a stub, you shouldnt get here') + + end subroutine write_interpolated_vector + +end module interp_mod diff --git a/src/dynamics/fv/mapz_module.F90 b/src/dynamics/fv/mapz_module.F90 new file mode 100644 index 0000000000..9011b51ce0 --- /dev/null +++ b/src/dynamics/fv/mapz_module.F90 @@ -0,0 +1,1285 @@ +module mapz_module + + use shr_kind_mod, only : r8 => shr_kind_r8 + use FVperf_module, only : FVstartclock, FVstopclock + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + + public map1_cubic_te, map1_ppm, mapn_ppm, mapn_ppm_tracer, ppme + + private + + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D1EM14 = 1.0e-14_r8 + real(r8), parameter :: D0_125 = 0.125_r8 + real(r8), parameter :: D0_1875 = 0.1875_r8 + real(r8), parameter :: D0_25 = 0.25_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D1_5 = 1.5_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + real(r8), parameter :: D3_0 = 3.0_r8 + real(r8), parameter :: D4_0 = 4.0_r8 + real(r8), parameter :: D5_0 = 5.0_r8 + real(r8), parameter :: D8_0 = 8.0_r8 + real(r8), parameter :: D12_0 = 12.0_r8 + +contains + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: map1_cubic_te --- Cubic Interpolation for TE mapping +! +! !INTERFACE: + subroutine map1_cubic_te ( km, pe1, q1, kn, pe2, q2, & + ng_s, ng_n, itot, i1, i2, & + j, jfirst, jlast, iv, kord) + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + integer, intent(in) :: itot ! Total latitudes + integer, intent(in) :: iv ! Mode: 0 == constituents 1 == ??? + integer, intent(in) :: kord ! Method order + integer, intent(in) :: j ! Current latitude + integer, intent(in) :: jfirst ! Starting latitude + integer, intent(in) :: jlast ! Finishing latitude + integer, intent(in) :: ng_s ! Ghosted latitudes south + integer, intent(in) :: ng_n ! Ghosted latitudes north + integer, intent(in) :: km ! Original vertical dimension + integer, intent(in) :: kn ! Target vertical dimension + + real(r8), intent(in) :: pe1(itot,km+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the original vertical coordinate + real(r8), intent(in) :: pe2(itot,kn+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the new vertical coordinate + + real(r8), intent(in) :: q1(itot,jfirst-ng_s:jlast+ng_n,km) ! Field input + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: q2(itot,jfirst-ng_s:jlast+ng_n,kn) ! Field output + +! !DESCRIPTION: +! +! Perform Cubic Interpolation a given latitude +! pe1: pressure at layer edges (from model top to bottom surface) +! in the original vertical coordinate +! pe2: pressure at layer edges (from model top to bottom surface) +! in the new vertical coordinate +! +! !REVISION HISTORY: +! 05.11.14 Takacs Initial Code +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real(r8) qx(i1:i2,km) + real(r8) logpl1(i1:i2,km) + real(r8) logpl2(i1:i2,kn) + real(r8) dlogp1(i1:i2,km) + real(r8) vsum1(i1:i2) + real(r8) vsum2(i1:i2) + real(r8) am2,am1,ap0,ap1,P,PLP1,PLP0,PLM1,PLM2,DLP0,DLM1,DLM2 + + integer i, k, LM2,LM1,LP0,LP1 + +! Initialization +! -------------- + do k=1,km + qx(:,k) = q1(:,j,k) + logpl1(:,k) = log( D0_5*(pe1(:,k)+pe1(:,k+1)) ) + enddo + do k=1,kn + logpl2(:,k) = log( D0_5*(pe2(:,k)+pe2(:,k+1)) ) + enddo + + do k=1,km-1 + dlogp1(:,k) = logpl1(:,k+1)-logpl1(:,k) + enddo + +! Compute vertical integral of Input TE +! ------------------------------------- + vsum1(:) = D0_0 + do i=i1,i2 + do k=1,km + vsum1(i) = vsum1(i) + qx(i,k)*( pe1(i,k+1)-pe1(i,k) ) + enddo + vsum1(i) = vsum1(i) / ( pe1(i,km+1)-pe1(i,1) ) + enddo + +! Interpolate TE onto target Pressures +! ------------------------------------ + do i=i1,i2 + do k=1,kn + LM1 = 1 + LP0 = 1 + do while( logpl1(i,LP0).lt.logpl2(i,k) .and. LP0.le.km ) + LP0 = LP0+1 + enddo + LM1 = max(LP0-1,1) + LP0 = min(LP0, km) + +! Extrapolate Linearly in LogP above first model level +! ---------------------------------------------------- + if( LM1.eq.1 .and. LP0.eq.1 ) then + q2(i,j,k) = qx(i,1) + ( qx(i,2)-qx(i,1) )*( logpl2(i,k)-logpl1(i,1) ) & + /( logpl1(i,2)-logpl1(i,1) ) + +! Extrapolate Linearly in LogP below last model level +! --------------------------------------------------- + else if( LM1.eq.km .and. LP0.eq.km ) then + q2(i,j,k) = qx(i,km) + ( qx(i,km)-qx(i,km-1) )*( logpl2(i,k )-logpl1(i,km ) ) & + /( logpl1(i,km)-logpl1(i,km-1) ) + +! Interpolate Linearly in LogP between levels 1 => 2 and km-1 => km +! ----------------------------------------------------------------- + else if( LM1.eq.1 .or. LP0.eq.km ) then + q2(i,j,k) = qx(i,LP0) + ( qx(i,LM1)-qx(i,LP0) )*( logpl2(i,k )-logpl1(i,LP0) ) & + /( logpl1(i,LM1)-logpl1(i,LP0) ) + +! Interpolate Cubicly in LogP between other model levels +! ------------------------------------------------------ + else + LP1 = LP0+1 + LM2 = LM1-1 + P = logpl2(i,k) + PLP1 = logpl1(i,LP1) + PLP0 = logpl1(i,LP0) + PLM1 = logpl1(i,LM1) + PLM2 = logpl1(i,LM2) + DLP0 = dlogp1(i,LP0) + DLM1 = dlogp1(i,LM1) + DLM2 = dlogp1(i,LM2) + + ap1 = (P-PLP0)*(P-PLM1)*(P-PLM2)/( DLP0*(DLP0+DLM1)*(DLP0+DLM1+DLM2) ) + ap0 = (PLP1-P)*(P-PLM1)*(P-PLM2)/( DLP0* DLM1 *( DLM1+DLM2) ) + am1 = (PLP1-P)*(PLP0-P)*(P-PLM2)/( DLM1* DLM2 *(DLP0+DLM1 ) ) + am2 = (PLP1-P)*(PLP0-P)*(PLM1-P)/( DLM2*(DLM1+DLM2)*(DLP0+DLM1+DLM2) ) + + q2(i,j,k) = ap1*qx(i,LP1) + ap0*qx(i,LP0) + am1*qx(i,LM1) + am2*qx(i,LM2) + + endif + + enddo + enddo + +! Compute vertical integral of Output TE +! -------------------------------------- + vsum2(:) = D0_0 + do i=i1,i2 + do k=1,kn + vsum2(i) = vsum2(i) + q2(i,j,k)*( pe2(i,k+1)-pe2(i,k) ) + enddo + vsum2(i) = vsum2(i) / ( pe2(i,kn+1)-pe2(i,1) ) + enddo + +! Adjust Final TE to conserve +! --------------------------- + do i=i1,i2 + do k=1,kn + q2(i,j,k) = q2(i,j,k) + vsum1(i)-vsum2(i) +! q2(i,j,k) = q2(i,j,k) * vsum1(i)/vsum2(i) + enddo + enddo + + return +!EOC + end subroutine map1_cubic_te +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: map1_ppm --- Piecewise parabolic mapping, variant 1 +! +! !INTERFACE: + subroutine map1_ppm( km, pe1, q1, kn, pe2, q2, & + ng_s, ng_n, itot, i1, i2, & + j, jfirst, jlast, iv, kord) + + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + integer, intent(in) :: itot ! Total latitudes + integer, intent(in) :: iv ! Mode: 0 == constituents 1 == ??? + integer, intent(in) :: kord ! Method order + integer, intent(in) :: j ! Current latitude + integer, intent(in) :: jfirst ! Starting latitude + integer, intent(in) :: jlast ! Finishing latitude + integer, intent(in) :: ng_s ! Ghosted latitudes south + integer, intent(in) :: ng_n ! Ghosted latitudes north + integer, intent(in) :: km ! Original vertical dimension + integer, intent(in) :: kn ! Target vertical dimension + + real(r8), intent(in) :: pe1(itot,km+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the original vertical coordinate + real(r8), intent(in) :: pe2(itot,kn+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the new vertical coordinate + real(r8), intent(in) :: q1(itot,jfirst-ng_s:jlast+ng_n,km) ! Field input + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: q2(itot,jfirst-ng_s:jlast+ng_n,kn) ! Field output + +! !DESCRIPTION: +! +! Perform piecewise parabolic method on a given latitude +! IV = 0: constituents +! pe1: pressure at layer edges (from model top to bottom surface) +! in the original vertical coordinate +! pe2: pressure at layer edges (from model top to bottom surface) +! in the new vertical coordinate +! +! !REVISION HISTORY: +! 00.04.24 Lin Last modification +! 01.03.26 Sawyer Added ProTeX documentation +! 02.04.04 Sawyer incorporated latest FVGCM version +! 02.06.20 Sawyer made Q2 inout since the args for Q1/Q2 same +! 03.07.22 Parks Cleaned main loop, removed gotos +! 05.05.25 Sawyer Merged CAM and GEOS5 versions +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real(r8) r3, r23 + parameter (r3 = D1_0/D3_0, r23 = D2_0/D3_0) + real(r8) dp1(i1:i2,km) + real(r8) q4(4,i1:i2,km) + + integer i, k, kk, kl, k0(i1:i2,0:kn+1), k0found + real(r8) pl, pr, qsum, qsumk(i1:i2,kn), delp, esl + + do k=1,km + do i=i1,i2 + dp1(i,k) = pe1(i,k+1) - pe1(i,k) + q4(1,i,k) = q1(i,j,k) + enddo + enddo + +! Mapping + +! Compute vertical subgrid distribution + call ppm2m( q4, dp1, km, i1, i2, iv, kord ) + +! For each pe2(i,k), determine lowest pe1 interval = smallest k0 (= k0(i,k)) +! such that pe1(i,k0) <= pe2(i,k) <= pe1(i,k0+1) +! Note that pe2(i,1)==pe1(i,1) and pe2(i,kn+1)==pe1(i,kn+1) +! Note also that pe1, pe2 are assumed to be monotonically increasing +#if defined( UNICOSMP ) || defined ( NEC_SX ) + do kk = km, 1, -1 + do k = 1, kn+1 + do i = i1, i2 + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + endif + enddo + enddo + enddo +#else + do i = i1, i2 + k0(i,0) = 1 + do k = 1, kn+1 + k0found = -1 + do kk = k0(i,k-1), km + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + k0found = kk + exit + endif + enddo + if (k0found .lt. 0) then + write(iulog,*) 'mapz error - k0found i j k (kk,pe1,pe2) = ', & + k0found, i, j, k, (kk,pe1(i,kk),pe2(i,kk),kk=1,km+1) + call endrun('MAPZ_MODULE') + return + endif + enddo + enddo +#endif + +! Interpolate + do k = 1, kn + +! Prepare contribution between pe1(i,ko(i,k)+1) and pe1(i,k0(i,k+1)) + qsumk(:,k) = D0_0 + do i = i1, i2 + do kl = k0(i,k)+1, k0(i,k+1)-1 + qsumk(i,k) = qsumk(i,k) + dp1(i,kl)*q4(1,i,kl) + enddo + enddo + + do i = i1, i2 + kk = k0(i,k) +! Consider contribution between pe1(i,kk) and pe2(i,k) + pl = (pe2(i,k)-pe1(i,kk)) / dp1(i,kk) +! Check to see if pe2(i,k+1) and pe2(i,k) are in same pe1 interval + if (k0(i,k+1) == k0(i,k)) then + pr = (pe2(i,k+1)-pe1(i,kk)) / dp1(i,kk) + q2(i,j,k) = q4(2,i,kk) + D0_5*(q4(4,i,kk)+q4(3,i,kk)-q4(2,i,kk)) & + *(pr+pl) - q4(4,i,kk)*r3*(pr*(pr+pl)+pl**2) + else +! Consider contribution between pe2(i,k) and pe1(i,kk+1) + qsum = (pe1(i,kk+1)-pe2(i,k))*(q4(2,i,kk)+D0_5*(q4(4,i,kk)+ & + q4(3,i,kk)-q4(2,i,kk))*(D1_0+pl)-q4(4,i,kk)* & + (r3*(D1_0+pl*(D1_0+pl)))) +! Next consider contribution between pe1(i,kk+1) and pe1(i,k0(i,k+1)) + qsum = qsum + qsumk(i,k) +! Now consider contribution between pe1(i,k0(i,k+1)) and pe2(i,k+1) + kl = k0(i,k+1) + delp = pe2(i,k+1)-pe1(i,kl) + esl = delp / dp1(i,kl) + qsum = qsum + delp*(q4(2,i,kl)+D0_5*esl* & + (q4(3,i,kl)-q4(2,i,kl)+q4(4,i,kl)*(D1_0-r23*esl))) + q2(i,j,k) = qsum / ( pe2(i,k+1) - pe2(i,k) ) + endif + enddo + enddo + + return +!EOC + end subroutine map1_ppm +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: mapn_ppm --- Piecewise parabolic mapping, variant 1 +! +! !INTERFACE: + subroutine mapn_ppm(km, pe1, q1, nq, & + kn, pe2, q2, ng_s, ng_n, & + itot, i1, i2, j, & + jfirst, jlast, iv, kord) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + integer, intent(in) :: itot ! Total latitudes + integer, intent(in) :: iv ! Mode: 0 == constituents 1 == ??? + integer, intent(in) :: kord ! Method order + integer, intent(in) :: j ! Current latitude + integer, intent(in) :: jfirst ! Starting latitude + integer, intent(in) :: jlast ! Finishing latitude + integer, intent(in) :: ng_s ! Ghosted latitudes south + integer, intent(in) :: ng_n ! Ghosted latitudes north + integer, intent(in) :: km ! Original vertical dimension + integer, intent(in) :: kn ! Target vertical dimension + integer, intent(in) :: nq ! Number of tracers + + real(r8), intent(in) :: pe1(itot,km+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the original vertical coordinate + real(r8), intent(in) :: pe2(itot,kn+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the new vertical coordinate + real(r8), intent(in) :: q1(itot,jfirst-ng_s:jlast+ng_n,km,nq) ! Field input +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: q2(itot,jfirst-ng_s:jlast+ng_n,kn,nq) ! Field output + +! !DESCRIPTION: +! +! Perform piecewise parabolic method on a given latitude +! IV = 0: constituents +! pe1: pressure at layer edges (from model top to bottom surface) +! in the original vertical coordinate +! pe2: pressure at layer edges (from model top to bottom surface) +! in the new vertical coordinate +! +! !REVISION HISTORY: +! 02.04.04 Sawyer incorporated latest FVGCM version, ProTeX +! 02.06.20 Sawyer made Q2 inout since the args for Q1/Q2 same +! 03.07.22 Parks Cleaned main loop, removed gotos +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real(r8) r3, r23 + parameter (r3 = D1_0/D3_0, r23 = D2_0/D3_0) + real(r8) dp1(i1:i2,km) + real(r8) q4(4,i1:i2,km) + + integer i, k, kk, kl, k0(i1:i2,0:kn+1), iq + real(r8) pl, pr, qsum, qsumk(i1:i2,kn), delp, esl + + do k=1,km + do i=i1,i2 + dp1(i,k) = pe1(i,k+1) - pe1(i,k) + enddo + enddo + +! Mapping + +! For each pe2(i,k), determine lowest pe1 interval = smallest k0 (= k0(i,k)) +! such that pe1(i,k0) <= pe2(i,k) <= pe1(i,k0+1) +! Note that pe2(i,1)==pe1(i,1) and pe2(i,kn+1)==pe1(i,kn+1) +! Note also that pe1, pe2 are assumed to be monotonically increasing +#if defined( UNICOSMP ) || defined ( NEC_SX ) + do kk = km, 1, -1 + do k = 1, kn+1 + do i = i1, i2 + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + endif + enddo + enddo + enddo +#else + do i = i1, i2 + k0(i,0) = 1 + do k = 1, kn+1 + do kk = k0(i,k-1), km + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + exit + endif + enddo + enddo + enddo +#endif + + do iq=1,nq + + do k=1,km + do i=i1,i2 + q4(1,i,k) = q1(i,j,k,iq) + enddo + enddo + +! Compute vertical subgrid distribution + call ppm2m( q4, dp1, km, i1, i2, iv, kord ) +! Interpolate + do k = 1, kn + +! Prepare contribution between pe1(i,ko(i,k)+1) and pe1(i,k0(i,k+1)) + qsumk(:,k) = D0_0 + do i = i1, i2 + do kl = k0(i,k)+1, k0(i,k+1)-1 + qsumk(i,k) = qsumk(i,k) + dp1(i,kl)*q4(1,i,kl) + enddo + enddo + + do i = i1, i2 + kk = k0(i,k) +! Consider contribution between pe1(i,kk) and pe2(i,k) + pl = (pe2(i,k)-pe1(i,kk)) / dp1(i,kk) +! Check to see if pe2(i,k+1) and pe2(i,k) are in same pe1 interval + if (k0(i,k+1) == k0(i,k)) then + pr = (pe2(i,k+1)-pe1(i,kk)) / dp1(i,kk) + q2(i,j,k,iq) = q4(2,i,kk) + D0_5*(q4(4,i,kk)+q4(3,i,kk)-q4(2,i,kk)) & + *(pr+pl) - q4(4,i,kk)*r3*(pr*(pr+pl)+pl**2) + else +! Consider contribution between pe2(i,k) and pe1(i,kk+1) + qsum = (pe1(i,kk+1)-pe2(i,k))*(q4(2,i,kk)+D0_5*(q4(4,i,kk)+ & + q4(3,i,kk)-q4(2,i,kk))*(D1_0+pl)-q4(4,i,kk)* & + (r3*(D1_0+pl*(D1_0+pl)))) +! Next consider contribution between pe1(i,kk+1) and pe1(i,k0(i,k+1)) + qsum = qsum + qsumk(i,k) +! Now consider contribution between pe1(i,k0(i,k+1)) and pe2(i,k+1) + kl = k0(i,k+1) + delp = pe2(i,k+1)-pe1(i,kl) + esl = delp / dp1(i,kl) + qsum = qsum + delp*(q4(2,i,kl)+D0_5*esl* & + (q4(3,i,kl)-q4(2,i,kl)+q4(4,i,kl)*(D1_0-r23*esl))) + q2(i,j,k,iq) = qsum / ( pe2(i,k+1) - pe2(i,k) ) + endif + enddo + enddo + + enddo + + return +!EOC + end subroutine mapn_ppm +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: mapn_ppm_tracer --- Piecewise parabolic mapping, multiple tracers +! +! !INTERFACE: + subroutine mapn_ppm_tracer(km, pe1, tracer, nq, & + kn, pe2, i1, i2, j, & + ifirst, ilast, jfirst, jlast, iv, kord) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + integer, intent(in) :: iv ! Mode: 0 == constituents 1 == ??? + integer, intent(in) :: kord ! Method order + integer, intent(in) :: j ! Current latitude + integer, intent(in) :: ifirst ! Starting segment + integer, intent(in) :: ilast ! Finishing segment + integer, intent(in) :: jfirst ! Starting latitude + integer, intent(in) :: jlast ! Finishing latitude + integer, intent(in) :: km ! Original vertical dimension + integer, intent(in) :: kn ! Target vertical dimension + integer, intent(in) :: nq ! Number of tracers + + real(r8), intent(in) :: pe1(ifirst:ilast,km+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the original vertical coordinate + real(r8), intent(in) :: pe2(ifirst:ilast,kn+1) ! pressure at layer edges + ! (from model top to bottom surface) + ! in the new vertical coordinate +! !INPUT/OUTPUT PARAMETERS: + real (r8), intent(inout):: tracer(ifirst:ilast,jfirst:jlast,km,nq) ! Field output + +! !DESCRIPTION: +! +! Perform piecewise parabolic method on a given latitude +! IV = 0: constituents +! pe1: pressure at layer edges (from model top to bottom surface) +! in the original vertical coordinate +! pe2: pressure at layer edges (from model top to bottom surface) +! in the new vertical coordinate +! +! !REVISION HISTORY: +! 05.03.20 Sawyer Created from mapn_ppm +! 05.04.04 Sawyer Simplified indexing, removed ifirst +! 05.04.12 Sawyer Added r4/r8 distinction +! 05.10.12 Worley Made mapn_ppm_tracer vector-friendly +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + + real(r8) r3, r23 + parameter (r3 = D1_0/D3_0, r23 = D2_0/D3_0) + + real(r8) dp1(i1:i2,km) + real(r8) q4(4,i1:i2,km) + + integer i, k, kk, kl, k0(i1:i2,0:kn+1), iq + real(r8) pl, pr, qsum, qsumk(i1:i2,kn), delp, esl + + do k=1,km + do i=i1,i2 + dp1(i,k) = pe1(i,k+1) - pe1(i,k) + enddo + enddo + +! Mapping + +! For each pe2(i,k), determine lowest pe1 interval = smallest k0 (= k0(i,k)) +! such that pe1(i,k0) <= pe2(i,k) <= pe1(i,k0+1) +! Note that pe2(i,1)==pe1(i,1) and pe2(i,kn+1)==pe1(i,kn+1) +! Note also that pe1, pe2 are assumed to be monotonically increasing +#if defined( UNICOSMP ) || defined ( NEC_SX ) + do kk = km, 1, -1 + do k = 1, kn+1 + do i = i1, i2 + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + endif + enddo + enddo + enddo +#else + do i = i1, i2 + k0(i,0) = 1 + do k = 1, kn+1 + do kk = k0(i,k-1), km + if (pe2(i,k) <= pe1(i,kk+1)) then + k0(i,k) = kk + exit + endif + enddo + enddo + enddo +#endif + + do iq=1,nq + do k=1,km + do i=i1,i2 + q4(1,i,k) = tracer(i,j,k,iq) + enddo + enddo + +! Compute vertical subgrid distribution + call ppm2m( q4, dp1, km, i1, i2, iv, kord ) + +! Interpolate + do k = 1, kn + +! Prepare contribution between pe1(i,ko(i,k)+1) and pe1(i,k0(i,k+1)) + qsumk(:,k) = D0_0 + do i = i1, i2 + do kl = k0(i,k)+1, k0(i,k+1)-1 + qsumk(i,k) = qsumk(i,k) + dp1(i,kl)*q4(1,i,kl) + enddo + enddo + + do i = i1, i2 + kk = k0(i,k) +! Consider contribution between pe1(i,kk) and pe2(i,k) + pl = (pe2(i,k)-pe1(i,kk)) / dp1(i,kk) +! Check to see if pe2(i,k+1) and pe2(i,k) are in same pe1 interval + if (k0(i,k+1) == k0(i,k)) then + pr = (pe2(i,k+1)-pe1(i,kk)) / dp1(i,kk) + tracer(i,j,k,iq) = q4(2,i,kk) & + + D0_5*(q4(4,i,kk)+q4(3,i,kk)-q4(2,i,kk)) & + *(pr+pl)-q4(4,i,kk)*r3*(pr*(pr+pl)+pl**2) + else +! Consider contribution between pe2(i,k) and pe1(i,kk+1) + qsum = (pe1(i,kk+1)-pe2(i,k))*(q4(2,i,kk)+D0_5*(q4(4,i,kk)+ & + q4(3,i,kk)-q4(2,i,kk))*(D1_0+pl)-q4(4,i,kk)* & + (r3*(D1_0+pl*(D1_0+pl)))) +! Next consider contribution between pe1(i,kk+1) and pe1(i,k0(i,k+1)) + qsum = qsum + qsumk(i,k) +! Now consider contribution between pe1(i,k0(i,k+1)) and pe2(i,k+1) + kl = k0(i,k+1) + delp = pe2(i,k+1)-pe1(i,kl) + esl = delp / dp1(i,kl) + qsum = qsum + delp*(q4(2,i,kl)+D0_5*esl* & + (q4(3,i,kl)-q4(2,i,kl)+q4(4,i,kl)*(D1_0-r23*esl))) + tracer(i,j,k,iq) = qsum / ( pe2(i,k+1) - pe2(i,k) ) + endif + enddo + enddo + + enddo ! do iq=1,nq + + return +!EOC + end subroutine mapn_ppm_tracer +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ppm2m --- Piecewise parabolic method for fields +! +! !INTERFACE: + subroutine ppm2m(a4, delp, km, i1, i2, iv, kord) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer, intent(in):: iv ! iv =-1: winds + ! iv = 0: positive definite scalars + ! iv = 1: others + integer, intent(in):: i1 ! Starting longitude + integer, intent(in):: i2 ! Finishing longitude + integer, intent(in):: km ! vertical dimension + integer, intent(in):: kord ! Order (or more accurately method no.): + ! + real (r8), intent(in):: delp(i1:i2,km) ! layer pressure thickness + +! !INPUT/OUTPUT PARAMETERS: + real (r8), intent(inout):: a4(4,i1:i2,km) ! Interpolated values + +! !DESCRIPTION: +! +! Perform the piecewise parabolic method +! +! !REVISION HISTORY: +! ??.??.?? Lin Creation +! 02.04.04 Sawyer Newest release from FVGCM +! 02.04.23 Sawyer Incorporated minor algorithmic change to +! maintain CAM zero diffs (see comments inline) +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: +! local arrays: + real(r8) dc(i1:i2,km) + real(r8) h2(i1:i2,km) + real(r8) delq(i1:i2,km) + real(r8) df2(i1:i2,km) + real(r8) d4(i1:i2,km) + +! local scalars: + real(r8) fac + real(r8) a1, a2, c1, c2, c3, d1, d2 + real(r8) qmax, qmin, cmax, cmin + real(r8) qm, dq, tmp + + integer i, k, km1, lmt + real(r8) qmp, pmp + real(r8) lac + integer it + + km1 = km - 1 + it = i2 - i1 + 1 + + do k=2,km + do i=i1,i2 + delq(i,k-1) = a4(1,i,k) - a4(1,i,k-1) + d4(i,k ) = delp(i,k-1) + delp(i,k) + enddo + enddo + + do k=2,km1 + do i=i1,i2 + c1 = (delp(i,k-1)+D0_5*delp(i,k))/d4(i,k+1) + c2 = (delp(i,k+1)+D0_5*delp(i,k))/d4(i,k) + tmp = delp(i,k)*(c1*delq(i,k) + c2*delq(i,k-1)) / & + (d4(i,k)+delp(i,k+1)) + qmax = max(a4(1,i,k-1),a4(1,i,k),a4(1,i,k+1)) - a4(1,i,k) + qmin = a4(1,i,k) - min(a4(1,i,k-1),a4(1,i,k),a4(1,i,k+1)) + dc(i,k) = sign(min(abs(tmp),qmax,qmin), tmp) + df2(i,k) = tmp + enddo + enddo + +!****6***0*********0*********0*********0*********0*********0**********72 +! 4th order interpolation of the provisional cell edge value +!****6***0*********0*********0*********0*********0*********0**********72 + + do k=3,km1 + do i=i1,i2 + c1 = delq(i,k-1)*delp(i,k-1) / d4(i,k) + a1 = d4(i,k-1) / (d4(i,k) + delp(i,k-1)) + a2 = d4(i,k+1) / (d4(i,k) + delp(i,k)) + a4(2,i,k) = a4(1,i,k-1) + c1 + D2_0/(d4(i,k-1)+d4(i,k+1)) * & + ( delp(i,k)*(c1*(a1 - a2)+a2*dc(i,k-1)) - & + delp(i,k-1)*a1*dc(i,k ) ) + enddo + enddo + + call steepz(i1, i2, km, a4, df2, dc, delq, delp, d4) + +! Area preserving cubic with 2nd deriv. = 0 at the boundaries +! Top + do i=i1,i2 + d1 = delp(i,1) + d2 = delp(i,2) + qm = (d2*a4(1,i,1)+d1*a4(1,i,2)) / (d1+d2) + dq = D2_0*(a4(1,i,2)-a4(1,i,1)) / (d1+d2) + c1 = D4_0*(a4(2,i,3)-qm-d2*dq) / ( d2*(D2_0*d2*d2+d1*(d2+D3_0*d1)) ) + c3 = dq - D0_5*c1*(d2*(D5_0*d1+d2)-D3_0*d1**2) + a4(2,i,2) = qm - D0_25*c1*d1*d2*(d2+D3_0*d1) + a4(2,i,1) = d1*(D2_0*c1*d1**2-c3) + a4(2,i,2) + dc(i,1) = 0.5_r8*(a4(1,i,1) - a4(2,i,1)) +! No over- and undershoot condition + cmax = max(a4(1,i,1), a4(1,i,2)) + cmin = min(a4(1,i,1), a4(1,i,2)) + a4(2,i,2) = max(cmin,a4(2,i,2)) + a4(2,i,2) = min(cmax,a4(2,i,2)) + enddo + + if( iv == 0 ) then + do i=i1,i2 +! +! WS: 02.04.23 Algorithmic difference with FVGCM. FVGCM does this: +! +!!! a4(2,i,1) = a4(1,i,1) +!!! a4(3,i,1) = a4(1,i,1) +! +! CAM does this: +! + a4(2,i,1) = max(D0_0,a4(2,i,1)) + a4(2,i,2) = max(D0_0,a4(2,i,2)) + enddo + elseif ( iv == -1 ) then +! Winds: + if( km > 32 ) then + do i=i1,i2 +! More dampping: top layer as the sponge + a4(2,i,1) = a4(1,i,1) + a4(3,i,1) = a4(1,i,1) + enddo + else + do i=i1,i2 + if( a4(1,i,1)*a4(2,i,1) <= D0_0 ) then + a4(2,i,1) = D0_0 + else + a4(2,i,1) = sign(min(abs(a4(1,i,1)), & + abs(a4(2,i,1))), & + a4(1,i,1) ) + endif + enddo + endif + endif + +! Bottom +! Area preserving cubic with 2nd deriv. = 0 at the surface + do i=i1,i2 + d1 = delp(i,km) + d2 = delp(i,km1) + qm = (d2*a4(1,i,km)+d1*a4(1,i,km1)) / (d1+d2) + dq = D2_0*(a4(1,i,km1)-a4(1,i,km)) / (d1+d2) + c1 = (a4(2,i,km1)-qm-d2*dq) / (d2*(D2_0*d2*d2+d1*(d2+D3_0*d1))) + c3 = dq - D2_0*c1*(d2*(D5_0*d1+d2)-D3_0*d1**2) + a4(2,i,km) = qm - c1*d1*d2*(d2+D3_0*d1) + a4(3,i,km) = d1*(D8_0*c1*d1**2-c3) + a4(2,i,km) + dc(i,km) = 0.5_r8*(a4(3,i,km) - a4(1,i,km)) +! No over- and under-shoot condition + cmax = max(a4(1,i,km), a4(1,i,km1)) + cmin = min(a4(1,i,km), a4(1,i,km1)) + a4(2,i,km) = max(cmin,a4(2,i,km)) + a4(2,i,km) = min(cmax,a4(2,i,km)) + enddo + +! Enforce constraint at the surface + + if ( iv == 0 ) then +! Positive definite scalars: + do i=i1,i2 + a4(3,i,km) = max(D0_0, a4(3,i,km)) + enddo + elseif ( iv == -1 ) then +! Winds: + do i=i1,i2 + if( a4(1,i,km)*a4(3,i,km) <= D0_0 ) then + a4(3,i,km) = D0_0 + else + a4(3,i,km) = sign( min(abs(a4(1,i,km)), & + abs(a4(3,i,km))), & + a4(1,i,km) ) + endif + enddo + endif + + do k=1,km1 + do i=i1,i2 + a4(3,i,k) = a4(2,i,k+1) + enddo + enddo + +! f(s) = AL + s*[(AR-AL) + A6*(1-s)] ( 0 <= s <= 1 ) + +! Top 2 and bottom 2 layers always use monotonic mapping + do k=1,2 + do i=i1,i2 + a4(4,i,k) = D3_0*(D2_0*a4(1,i,k) - (a4(2,i,k)+a4(3,i,k))) + enddo + call kmppm(dc(i1,k), a4(1,i1,k), it, 0) + enddo + + if(kord >= 7) then +!****6***0*********0*********0*********0*********0*********0**********72 +! Huynh's 2nd constraint +!****6***0*********0*********0*********0*********0*********0**********72 + do k=2, km1 + do i=i1,i2 +! Method#1 +! h2(i,k) = delq(i,k) - delq(i,k-1) +! Method#2 +! h2(i,k) = D2_0*(dc(i,k+1)/delp(i,k+1) - dc(i,k-1)/delp(i,k-1)) +! & / ( delp(i,k)+D0_5*(delp(i,k-1)+delp(i,k+1)) ) +! & * delp(i,k)**2 +! Method#3 + h2(i,k) = dc(i,k+1) - dc(i,k-1) + enddo + enddo + + if( kord == 7 ) then + fac = D1_5 ! original quasi-monotone + else + fac = D0_125 ! full monotone + endif + + do k=3, km-2 + do i=i1,i2 +! Right edges +! qmp = a4(1,i,k) + D2_0*delq(i,k-1) +! lac = a4(1,i,k) + fac*h2(i,k-1) + D0_5*delq(i,k-1) +! + pmp = D2_0*dc(i,k) + qmp = a4(1,i,k) + pmp + lac = a4(1,i,k) + fac*h2(i,k-1) + dc(i,k) + qmin = min(a4(1,i,k), qmp, lac) + qmax = max(a4(1,i,k), qmp, lac) + a4(3,i,k) = min(max(a4(3,i,k), qmin), qmax) +! Left edges +! qmp = a4(1,i,k) - D2_0*delq(i,k) +! lac = a4(1,i,k) + fac*h2(i,k+1) - D0_5*delq(i,k) +! + qmp = a4(1,i,k) - pmp + lac = a4(1,i,k) + fac*h2(i,k+1) - dc(i,k) + qmin = min(a4(1,i,k), qmp, lac) + qmax = max(a4(1,i,k), qmp, lac) + a4(2,i,k) = min(max(a4(2,i,k), qmin), qmax) +! Recompute A6 + a4(4,i,k) = D3_0*(D2_0*a4(1,i,k) - (a4(2,i,k)+a4(3,i,k))) + enddo +! Additional constraint to prevent negatives when kord=7 + if (iv == 0 .and. kord == 7) then + call kmppm(dc(i1,k), a4(1,i1,k), it, 2) + endif + enddo + + else + + lmt = kord - 3 + lmt = max(0, lmt) + if (iv == 0) lmt = min(2, lmt) + + do k=3, km-2 + if( kord /= 4) then + do i=i1,i2 + a4(4,i,k) = D3_0*(D2_0*a4(1,i,k) - (a4(2,i,k)+a4(3,i,k))) + enddo + endif + call kmppm(dc(i1,k), a4(1,i1,k), it, lmt) + enddo + endif + + do k=km1,km + do i=i1,i2 + a4(4,i,k) = D3_0*(D2_0*a4(1,i,k) - (a4(2,i,k)+a4(3,i,k))) + enddo + call kmppm(dc(i1,k), a4(1,i1,k), it, 0) + enddo + + return +!EOC + end subroutine ppm2m +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ppme --- PPM scheme at vertical edges +! +! !INTERFACE: + subroutine ppme(p,qe,delp,im,km) +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8, i4 => shr_kind_i4 + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: im, km + real(r8), intent(in) :: p(im,km), delp(im,km) + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(out) :: qe(im,km+1) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 05.06.13 Sawyer Inserted file ppme.F90 here, added ProTeX +! +!EOP +!----------------------------------------------------------------------- +!BOC + + integer(i4) km1 + integer(i4) i, k +! local arrays. + real(r8) dc(im,km),delq(im,km), a6(im,km) + real(r8) c1, c2, c3, tmp, qmax, qmin + real(r8) a1, a2, s1, s2, s3, s4, ss3, s32, s34, s42 + real(r8) a3, b2, sc, dm, d1, d2, f1, f2, f3, f4 + real(r8) qm, dq + + km1 = km - 1 + + do 500 k=2,km + do 500 i=1,im +500 a6(i,k) = delp(i,k-1) + delp(i,k) + + do 1000 k=1,km1 + do 1000 i=1,im + delq(i,k) = p(i,k+1) - p(i,k) +1000 continue + + do 1220 k=2,km1 + do 1220 i=1,im + c1 = (delp(i,k-1)+D0_5*delp(i,k))/a6(i,k+1) + c2 = (delp(i,k+1)+D0_5*delp(i,k))/a6(i,k) + tmp = delp(i,k)*(c1*delq(i,k) + c2*delq(i,k-1)) / & + (a6(i,k)+delp(i,k+1)) + qmax = max(p(i,k-1),p(i,k),p(i,k+1)) - p(i,k) + qmin = p(i,k) - min(p(i,k-1),p(i,k),p(i,k+1)) + dc(i,k) = sign(min(abs(tmp),qmax,qmin), tmp) +1220 continue + +!****6***0*********0*********0*********0*********0*********0**********72 +! 4th order interpolation of the provisional cell edge value +!****6***0*********0*********0*********0*********0*********0**********72 + + do 12 k=3,km1 + do 12 i=1,im + c1 = delq(i,k-1)*delp(i,k-1) / a6(i,k) + a1 = a6(i,k-1) / (a6(i,k) + delp(i,k-1)) + a2 = a6(i,k+1) / (a6(i,k) + delp(i,k)) + qe(i,k) = p(i,k-1) + c1 + D2_0/(a6(i,k-1)+a6(i,k+1)) * & + ( delp(i,k)*(c1*(a1 - a2)+a2*dc(i,k-1)) - & + delp(i,k-1)*a1*dc(i,k ) ) +12 continue + +! three-cell parabolic subgrid distribution at model top + + do 10 i=1,im +! three-cell PP-distribution +! Compute a,b, and c of q = aP**2 + bP + c using cell averages and delp +! a3 = a / 3 +! b2 = b / 2 + s1 = delp(i,1) + s2 = delp(i,2) + s1 +! + s3 = delp(i,2) + delp(i,3) + s4 = s3 + delp(i,4) + ss3 = s3 + s1 + s32 = s3*s3 + s42 = s4*s4 + s34 = s3*s4 +! model top + a3 = (delq(i,2) - delq(i,1)*s3/s2) / (s3*ss3) +! + if(abs(a3) .gt. D1EM14) then + b2 = delq(i,1)/s2 - a3*(s1+s2) + sc = -b2/(D3_0*a3) + if(sc .lt. D0_0 .or. sc .gt. s1) then + qe(i,1) = p(i,1) - s1*(a3*s1 + b2) + else + qe(i,1) = p(i,1) - delq(i,1)*s1/s2 + endif + else +! Linear + qe(i,1) = p(i,1) - delq(i,1)*s1/s2 + endif + dc(i,1) = p(i,1) - qe(i,1) +! compute coef. for the off-centered area preserving cubic poly. + dm = delp(i,1) / (s34*ss3*(delp(i,2)+s3)*(s4+delp(i,1))) + f1 = delp(i,2)*s34 / ( s2*ss3*(s4+delp(i,1)) ) + f2 = (delp(i,2)+s3) * (ss3*(delp(i,2)*s3+s34+delp(i,2)*s4) & + + s42*(delp(i,2)+s3+s32/s2)) + f3 = -delp(i,2)*( ss3*(s32*(s3+s4)/(s4-delp(i,2)) & + + (delp(i,2)*s3+s34+delp(i,2)*s4)) & + + s42*(delp(i,2)+s3) ) + f4 = ss3*delp(i,2)*s32*(delp(i,2)+s3) / (s4-delp(i,2)) + qe(i,2) = f1*p(i,1)+(f2*p(i,2)+f3*p(i,3)+f4*p(i,4))*dm +10 continue + +! Bottom +! Area preserving cubic with 2nd deriv. = 0 at the surface + do 15 i=1,im + d1 = delp(i,km) + d2 = delp(i,km1) + qm = (d2*p(i,km)+d1*p(i,km1)) / (d1+d2) + dq = D2_0*(p(i,km1)-p(i,km)) / (d1+d2) + c1 = (qe(i,km1)-qm-d2*dq) / (d2*(D2_0*d2*d2+d1*(d2+D3_0*d1))) + c3 = dq - D2_0*c1*(d2*(D5_0*d1+d2)-D3_0*d1**2) + qe(i,km ) = qm - c1*d1*d2*(d2+D3_0*d1) + qe(i,km+1) = d1*(D8_0*c1*d1**2-c3) + qe(i,km) +15 continue + return +!EOC + end subroutine ppme +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: kmppm --- Perform piecewise parabolic method in vertical +! +! !INTERFACE: + subroutine kmppm(dm, a4, itot, lmt) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + real(r8), intent(in):: dm(*) ! ?????? + integer, intent(in) :: itot ! Total Longitudes + integer, intent(in) :: lmt ! 0: Standard PPM constraint + ! 1: Improved full monotonicity constraint (Lin) + ! 2: Positive definite constraint + ! 3: do nothing (return immediately) + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: a4(4,*) ! ??????? + ! AA <-- a4(1,i) + ! AL <-- a4(2,i) + ! AR <-- a4(3,i) + ! A6 <-- a4(4,i) + +! !DESCRIPTION: +! +! Writes a standard set of data to the history buffer. +! +! !REVISION HISTORY: +! 00.04.24 Lin Last modification +! 01.03.26 Sawyer Added ProTeX documentation +! 02.04.04 Sawyer Incorporated newest FVGCM version +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + + real(r8) r12 + parameter (r12 = D1_0/D12_0) + + real(r8) qmp + integer i + real(r8) da1, da2, a6da + real(r8) fmin + +! Developer: S.-J. Lin, NASA-GSFC +! Last modified: Apr 24, 2000 + + if ( lmt == 3 ) return + + if(lmt == 0) then +! Standard PPM constraint + do i=1,itot + if(dm(i) == D0_0) then + a4(2,i) = a4(1,i) + a4(3,i) = a4(1,i) + a4(4,i) = D0_0 + else + da1 = a4(3,i) - a4(2,i) + da2 = da1**2 + a6da = a4(4,i)*da1 + if(a6da < -da2) then + a4(4,i) = D3_0*(a4(2,i)-a4(1,i)) + a4(3,i) = a4(2,i) - a4(4,i) + elseif(a6da > da2) then + a4(4,i) = D3_0*(a4(3,i)-a4(1,i)) + a4(2,i) = a4(3,i) - a4(4,i) + endif + endif + enddo + + elseif (lmt == 1) then + +! Improved full monotonicity constraint (Lin) +! Note: no need to provide first guess of A6 <-- a4(4,i) + do i=1, itot + qmp = D2_0*dm(i) + a4(2,i) = a4(1,i)-sign(min(abs(qmp),abs(a4(2,i)-a4(1,i))), qmp) + a4(3,i) = a4(1,i)+sign(min(abs(qmp),abs(a4(3,i)-a4(1,i))), qmp) + a4(4,i) = D3_0*( D2_0*a4(1,i) - (a4(2,i)+a4(3,i)) ) + enddo + + elseif (lmt == 2) then + +! Positive definite constraint + do i=1,itot + if( abs(a4(3,i)-a4(2,i)) < -a4(4,i) ) then + fmin = a4(1,i)+D0_25*(a4(3,i)-a4(2,i))**2/a4(4,i)+a4(4,i)*r12 + if( fmin < D0_0 ) then + if(a4(1,i) a4(2,i)) then + a4(4,i) = D3_0*(a4(2,i)-a4(1,i)) + a4(3,i) = a4(2,i) - a4(4,i) + else + a4(4,i) = D3_0*(a4(3,i)-a4(1,i)) + a4(2,i) = a4(3,i) - a4(4,i) + endif + endif + endif + enddo + + endif + + return +!EOC + end subroutine kmppm +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: steepz --- Calculate attributes for PPM +! +! !INTERFACE: + subroutine steepz(i1, i2, km, a4, df2, dm, dq, dp, d4) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: km ! Total levels + integer, intent(in) :: i1 ! Starting longitude + integer, intent(in) :: i2 ! Finishing longitude + real(r8), intent(in) :: dp(i1:i2,km) ! grid size + real(r8), intent(in) :: dq(i1:i2,km) ! backward diff of q + real(r8), intent(in) :: d4(i1:i2,km) ! backward sum: dp(k)+ dp(k-1) + real(r8), intent(in) :: df2(i1:i2,km) ! first guess mismatch + real(r8), intent(in) :: dm(i1:i2,km) ! monotonic mismatch + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: a4(4,i1:i2,km) ! first guess/steepened + +! +! !DESCRIPTION: +! This is complicated stuff related to the Piecewise Parabolic Method +! and I need to read the Collela/Woodward paper before documenting +! thoroughly. +! +! !REVISION HISTORY: +! ??.??.?? Lin? Creation +! 01.03.26 Sawyer Added ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, k + real(r8) alfa(i1:i2,km) + real(r8) f(i1:i2,km) + real(r8) rat(i1:i2,km) + real(r8) dg2 + +! Compute ratio of dq/dp + do k=2,km + do i=i1,i2 + rat(i,k) = dq(i,k-1) / d4(i,k) + enddo + enddo + +! Compute F + do k=2,km-1 + do i=i1,i2 + f(i,k) = (rat(i,k+1) - rat(i,k)) & + / ( dp(i,k-1)+dp(i,k)+dp(i,k+1) ) + enddo + enddo + + do k=3,km-2 + do i=i1,i2 + if(f(i,k+1)*f(i,k-1) shr_kind_r8 + use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_recompute + use perf_mod + use cam_logfile, only : iulog + + public gmean, gmeanxy + + private + real(r8), parameter :: D0_0 = 0.0_r8 + +contains +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: gmean --- Calculate the mean of a 2D field +! +! !INTERFACE: + +subroutine gmean(grid, q, qmean) + +! !USES: + use commap, only : w + use dynamics_vars, only : T_FVDYCORE_GRID + +#if defined( SPMD ) + use parutilitiesmodule, only : parcollective, sumop +#endif + + implicit none + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(in) :: grid ! Grid information + real(r8), intent(in) :: q(grid%im,grid%jfirst:grid%jlast) ! 2D field + + real(r8) qmean + +! !DESCRIPTION: +! Calculate the mean of a 2D field +! +! !REVISION HISTORY: +! 00.08.01 Lin Creation +! 01.01.10 Lin Revised +! 01.06.27 Mirin Use y communicator +! 05.07.12 Sawyer Simplified interface with grid argument +! +!EOP +!----------------------------------------------------------------------- +!BOC + + real(r8) :: xsum(grid%jm) + integer :: i, j, im, jm, jfirst, jlast + + im = grid%im + jm = grid%jm + jfirst = grid%jfirst + jlast = grid%jlast + + do j=1,jm + xsum(j) = D0_0 + enddo + do j=jfirst,jlast + do i=1,im + xsum(j) = xsum(j) + q(i,j) + enddo + xsum(j) = xsum(j)*w(j) + enddo + +#if defined( SPMD ) + if (grid%npr_y .ne. 1) then + call parcollective( grid%comm_y, sumop, jm, xsum ) + endif +#endif + + qmean = D0_0 + do j=1,jm + qmean = qmean + xsum(j) + enddo + qmean = qmean / (2*im) + + return +!EOC +end subroutine gmean +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: gmeanxy --- Calculate the mean of a 2D field (XY decomp) +! +! !INTERFACE: + +subroutine gmeanxy(grid, q, qmean) + +! !USES: + use commap, only : w + use dynamics_vars, only : T_FVDYCORE_GRID + +#if defined( SPMD ) + use parutilitiesmodule, only : parcollective, sumop +#endif + + implicit none + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(in) :: grid ! Grid information + real(r8), intent(in), target :: q(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) ! 2D field + + real(r8) qmean + +! !DESCRIPTION: +! Calculate the mean of a 2D field on an XY decomposition +! This is inefficiently programmed (global collective operation), +! and is therefore only intended for initialization phase. +! +! PW: gmeanxy is called in fv_prints, so replaced inefficient algorithm +! with shr_reprosum_calc. +! +! !REVISION HISTORY: +! 00.08.01 Lin Creation +! 01.01.10 Lin Revised +! 01.06.27 Mirin Use y communicator +! 05.07.12 Sawyer Simplified interface with grid argument +! 05.08.26 Sawyer Modified for XY decomposition +! 08.07.03 Worley Introduced repro_sum logic +! 12.10.29 Santos repro_sum is now shr_reprosum +! +!EOP +!----------------------------------------------------------------------- +!BOC + + real(r8) :: q_tmp(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy) + real(r8) :: rel_diff(2), qmean_tmp(1), xsum + real(r8), allocatable :: q_global(:,:) + + integer :: i, j, im, jm, ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: lim, ljm, lijm + + logical :: write_warning + + im = grid%im + jm = grid%jm + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + lim = ilastxy - ifirstxy + 1 + ljm = jlastxy - jfirstxy + 1 + lijm = lim*ljm + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + q_tmp(i,j) = q(i,j)*w(j) + enddo + enddo + + call t_startf("gmeanxy_reprosum") + call shr_reprosum_calc(q_tmp, qmean_tmp, lijm, lijm, 1, gbl_count=im*jm, & + commid=grid%commxy, rel_diff=rel_diff) + qmean = qmean_tmp(1) + call t_stopf("gmeanxy_reprosum") + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (grid%iam == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('gmeanxy', 1, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call t_startf("gmeanxy_sumfix") + allocate( q_global(im,jm) ) + q_global = D0_0 + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + q_global(i,j) = q_tmp(i,j) + enddo + enddo + +#if defined( SPMD ) + call parcollective( grid%commxy, sumop, im, jm, q_global ) +#endif + qmean = D0_0 + do j=1,jm + xsum = D0_0 + do i=1,im + xsum = xsum + q_global(i,j) + enddo + qmean = qmean + xsum + enddo + + deallocate( q_global ) + call t_stopf("gmeanxy_sumfix") + endif + endif + + qmean = qmean / (2*im) + + return +!EOC +end subroutine gmeanxy +!----------------------------------------------------------------------- + +end module mean_module diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 new file mode 100644 index 0000000000..73c9596c9f --- /dev/null +++ b/src/dynamics/fv/metdata.F90 @@ -0,0 +1,1996 @@ +module metdata +!----------------------------------------------------------------------- +! +! BOP +! +! !MODULE: metdata +! +! !DESCRIPTION +! Handles reading and interpolating offline meteorological data which +! is used to drive the dynamics. +! +! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use shr_cal_mod, only: shr_cal_gregorian + use time_manager, only: get_curr_date, get_step_size, timemgr_is_caltype + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, begchunk, endchunk + use time_manager, only: get_curr_calday, get_curr_date, get_step_size + use cam_abortutils, only: endrun + use dynamics_vars, only: T_FVDYCORE_GRID + +#if ( defined SPMD ) + use mpishorthand, only: mpicom, mpir8, mpiint,mpichar + use mod_comm, only: mp_sendirr,mp_recvirr +#endif + use perf_mod + use cam_logfile, only: iulog + use pio, only: file_desc_t, pio_put_att, pio_global, pio_get_att, pio_inq_att, & + pio_inq_dimid, pio_inq_dimlen, pio_closefile, pio_get_var, pio_inq_varid, & + pio_offset_kind + use cam_pio_utils, only: cam_pio_openfile + + + implicit none + + private ! all unless made public + save + +! !PUBLIC MEMBERS + + public :: metdata_dyn_init ! subroutine to open files, allocate blocked arrays, etc + public :: metdata_phys_init ! subroutine to allocate chunked arrays + public :: advance_met ! subroutine to read more data and interpolate + public :: get_met_fields ! interface to set meteorology fields + public :: get_met_srf1 + public :: get_met_srf2 + public :: get_us_vs + public :: metdata_readnl + public :: met_winds_on_walls + public :: write_met_restart + public :: read_met_restart + public :: met_rlx + public :: met_fix_mass + public :: met_srf_feedback + + interface write_met_restart + Module procedure write_met_restart_bin + Module procedure write_met_restart_pio + end interface + + interface read_met_restart + Module procedure read_met_restart_bin + Module procedure read_met_restart_pio + end interface + + + !------------------------------------------------------------------ + ! Interface to access the meteorology fields. Possible invocations + ! are as follows: + ! call get_met_fields( physics_state, us, vs , tend, dt ) + ! call get_met_fields( u, v ) + ! call get_met_fields( cam_in_t ) + !------------------------------------------------------------------ + Interface get_met_fields ! overload accessors + Module Procedure get_dyn_flds + Module Procedure get_uv_centered + Module Procedure get_ps + Module Procedure get_ocn_ice_frcs + End Interface + + real(r8), allocatable :: met_ps_next(:,:) ! PS interpolated to next timestep + real(r8), allocatable :: met_ps_curr(:,:) ! PS interpolated to next timestep + + logical :: met_cell_wall_winds = .false. ! true => met data winds are defined on model grid cell walls + logical :: met_remove_file = .false. ! delete metdata file when finished with it + + character(len=16) :: met_shflx_name = 'SHFLX' + character(len=16) :: met_qflx_name = 'QFLX' + real(r8) :: met_snowh_factor = 1._r8 + real(r8) :: met_shflx_factor = 1._r8 + real(r8) :: met_qflx_factor = 1._r8 + logical :: met_srf_feedback = .true. + logical :: met_srf_nudge_flux = .true. ! wsx, wsy, shf, and cflx nudged rather than forced. + ! This is done primarily to prevent unrealistic + ! surface temperatures. + +! !REVISION HISTORY: +! 31 Oct 2003 Francis Vitt Creation +! 05 Feb 2004 F Vitt Removed reading/inperpolating PS for current timestep +! -- only met_ps_next is needed +! 10 Nov 2004 F Vitt Implemented ability to read from series of files +! 16 Dec 2004 F Vitt Added offline_met_defaultopts and offline_met_setopts +! 14 Jul 2005 W Sawyer Removed pmgrid, spmd_dyn dependencies +! 12 Apr 2006 W Sawyer Removed unneeded ghosting of met_us, met_vs +! 08 Apr 2010 J Edwards Replaced serial netcdf calls with pio interface +! +! EOP +!----------------------------------------------------------------------- +! $Id$ +! $Author$ +!----------------------------------------------------------------------- + + type input2d + real(r8), dimension(:,:), pointer :: data => null() + endtype input2d + + type input3d + real(r8), dimension(:,:,:), pointer :: data => null() + endtype input3d + + real(r8), allocatable :: met_t(:,:,:) ! interpolated temperature + real(r8), allocatable :: met_u(:,:,:) ! interpolated zonal wind + real(r8), allocatable :: met_v(:,:,:) ! interpolated meridional wind + real(r8), allocatable :: met_us(:,:,:) ! interpolated zonal wind -staggered + real(r8), allocatable :: met_vs(:,:,:) ! interpolated meridional wind -staggered + real(r8), allocatable :: met_q(:,:,:) ! interpolated water vapor + + real(r8), allocatable :: met_shflx(:,:)! interpolated surface pressure + real(r8), allocatable :: met_qflx(:,:) ! interpolated water vapor flux + real(r8), allocatable :: met_taux(:,:) ! interpolated + real(r8), allocatable :: met_tauy(:,:) ! interpolated + real(r8), allocatable :: met_snowh(:,:) ! interpolated snow height + + real(r8), allocatable :: met_ts(:,:) ! interpolated + + type(input3d) :: met_ti(2) + type(input3d) :: met_ui(2) + type(input3d) :: met_vi(2) + type(input3d) :: met_usi(2) + type(input3d) :: met_vsi(2) + type(input3d) :: met_qi(2) + + type(input2d) :: met_psi_next(2) + type(input2d) :: met_psi_curr(2) + type(input2d) :: met_shflxi(2) + type(input2d) :: met_qflxi(2) + type(input2d) :: met_tauxi(2) + type(input2d) :: met_tauyi(2) + type(input2d) :: met_tsi(2) + type(input2d) :: met_snowhi(2) + + integer :: dateid ! var id of the date in the netCDF + integer :: secid ! var id of the sec data + real(r8) :: datatimem = -1.e36_r8 ! time of prv. values read in + real(r8) :: datatimep = -1.e36_r8 ! time of nxt. values read in + real(r8) :: datatimemn = -1.e36_r8 ! time of prv. values read in for next timestep + real(r8) :: datatimepn = -1.e36_r8 ! time of nxt. values read in for next timestep + + integer, parameter :: nm=1 ! array index for previous (minus) data + integer, parameter :: np=2 ! array indes for next (plus) data + + real(r8) :: curr_mod_time ! model time - calendar day + real(r8) :: next_mod_time ! model time - calendar day - next time step + + character(len=256) :: curr_filename, next_filename, met_data_file + character(len=256) :: met_filenames_list = '' + character(len=256) :: met_data_path = '' + type(file_desc_t) :: curr_fileid, next_fileid ! the id of the NetCDF file + real(r8), pointer, dimension(:) :: curr_data_times => null() + real(r8), pointer, dimension(:) :: next_data_times => null() + + real(r8) :: alpha = 1.0_r8 ! don't read in water vapor + ! real(r8), private :: alpha = 0.0 ! read in water vaper each time step + + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D0_75 = 0.75_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: days_per_month = 30.6_r8 + real(r8), parameter :: days_per_non_leapyear = 365.0_r8 + real(r8), parameter :: days_per_year = 365.25_r8 + real(r8), parameter :: seconds_per_day = 86400.0_r8 + real(r8), parameter :: fill_value = -9999.0_r8 + + logical :: online_test = .false. + logical :: debug = .false. + + real(r8) :: met_rlx(pver) + integer :: met_levels + integer :: num_met_levels + real(r8) :: met_rlx_top = 60._r8 + real(r8) :: met_rlx_bot = 50._r8 + real(r8) :: met_rlx_time = 0._r8 + +#if ( defined OFFLINE_DYN ) + logical :: met_fix_mass = .true. +#else + logical :: met_fix_mass = .false. +#endif + logical :: has_ts = .false. + +contains + +!------------------------------------------------------------------------- +! meteorology data options +!------------------------------------------------------------------------- + subroutine metdata_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'metdata_readnl' + + namelist /metdata_nl/ & + met_data_file, & + met_data_path, & + met_remove_file, & + met_cell_wall_winds, & + met_filenames_list, & + met_rlx_top, & + met_rlx_bot, & + met_rlx_time, & + met_fix_mass, & + met_shflx_name, & + met_shflx_factor, & + met_snowh_factor, & + met_qflx_name, & + met_qflx_factor, & + met_srf_feedback, & + met_srf_nudge_flux + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'metdata_nl', status=ierr) + if (ierr == 0) then + read(unitn, metdata_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#if ( defined SPMD ) + + ! Broadcast namelist variables + + call mpibcast (met_data_file ,len(met_data_file) ,mpichar,0,mpicom) + call mpibcast (met_data_path ,len(met_data_path) ,mpichar,0,mpicom) + call mpibcast (met_remove_file ,1 ,mpilog, 0, mpicom ) + call mpibcast (met_cell_wall_winds,1 ,mpilog, 0, mpicom ) + call mpibcast (met_filenames_list ,len(met_filenames_list),mpichar,0,mpicom) + call mpibcast (met_rlx_top, 1 ,mpir8, 0, mpicom ) + call mpibcast (met_rlx_bot, 1 ,mpir8, 0, mpicom ) + call mpibcast (met_rlx_time, 1 ,mpir8, 0, mpicom ) + call mpibcast (met_fix_mass, 1 ,mpilog, 0, mpicom ) + call mpibcast (met_qflx_name ,len(met_qflx_name), mpichar,0,mpicom) + call mpibcast (met_shflx_name ,len(met_shflx_name), mpichar,0,mpicom) + call mpibcast (met_qflx_factor ,1, mpir8, 0, mpicom ) + call mpibcast (met_shflx_factor ,1, mpir8, 0, mpicom ) + call mpibcast (met_snowh_factor ,1, mpir8, 0, mpicom ) + call mpibcast (met_srf_feedback ,1 ,mpilog, 0, mpicom ) +#endif + + if (masterproc) then + write(iulog,*)'Time-variant meteorological dataset (met_data_file) is: ', trim(met_data_file) + write(iulog,*)'Meteorological data file will be removed (met_remove_file): ', met_remove_file + write(iulog,*)'Meteorological winds are on cell walls (met_cell_wall_winds): ', met_cell_wall_winds + write(iulog,*)'Meteorological file names list file: ', trim(met_filenames_list) + write(iulog,*)'Meteorological relaxation top is (km): ', met_rlx_top + write(iulog,*)'Meteorological relaxation bottom is (km): ', met_rlx_bot + write(iulog,*)'Meteorological relaxation time (hours): ',met_rlx_time + write(iulog,*)'Offline driver mass fixer is trurned on (met_fix_mass): ',met_fix_mass + write(iulog,*)'Meteorological shflx field name : ', trim(met_shflx_name) + write(iulog,*)'Meteorological shflx multiplication factor : ', met_shflx_factor + write(iulog,*)'Meteorological qflx field name : ', trim(met_qflx_name) + write(iulog,*)'Meteorological qflx multiplication factor : ', met_qflx_factor + write(iulog,*)'Meteorological snowh multiplication factor : ', met_snowh_factor + write(iulog,*)'Meteorological allow srf models feedbacks : ', met_srf_feedback + endif + + end subroutine metdata_readnl + +!-------------------------------------------------------------------------- +! Opens file, allocates arrays +!-------------------------------------------------------------------------- + subroutine metdata_dyn_init(grid) + use infnan, only : nan, assignment(=) + use cam_control_mod, only : restart_run + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + + + integer :: im, km, jfirst, jlast, kfirst, klast + integer :: ng_d, ng_s + + im = grid%im + km = grid%km + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + ng_d = grid%ng_d + ng_s = grid%ng_s + + + if (.not. restart_run) then ! initial run or branch run + curr_filename = met_data_file + next_filename = '' + else + ! restart run + ! curr_filename & next_filename already set by restart_dynamics + endif + + call open_met_datafile( curr_filename, curr_fileid, curr_data_times, met_data_path, check_dims=.true., grid=grid) + + if ( len_trim(next_filename) > 0 ) & + call open_met_datafile( next_filename, next_fileid, next_data_times, met_data_path ) + +! +! allocate space for data arrays ... +! + ! dynamics grid + + allocate( met_psi_next(nm)%data(im, jfirst:jlast) ) + allocate( met_psi_next(np)%data(im, jfirst:jlast) ) + allocate( met_psi_curr(nm)%data(im, jfirst:jlast) ) + allocate( met_psi_curr(np)%data(im, jfirst:jlast) ) + allocate( met_ps_next(im, jfirst:jlast) ) + allocate( met_ps_curr(im, jfirst:jlast) ) + + allocate( met_us(im, jfirst-ng_d:jlast+ng_s, kfirst:klast) ) + allocate( met_vs(im, jfirst-ng_s:jlast+ng_d, kfirst:klast) ) + + met_us = nan + met_vs = nan + + if (met_cell_wall_winds) then + allocate( met_usi(nm)%data(im, jfirst:jlast, kfirst:klast) ) + allocate( met_usi(np)%data(im, jfirst:jlast, kfirst:klast) ) + allocate( met_vsi(nm)%data(im, jfirst:jlast, kfirst:klast) ) + allocate( met_vsi(np)%data(im, jfirst:jlast, kfirst:klast) ) + endif + + if (.not. met_cell_wall_winds) then + + allocate( met_u(im, jfirst-ng_d:jlast+ng_d, kfirst:klast) ) + allocate( met_ui(nm)%data(im, jfirst:jlast, kfirst:klast) ) + allocate( met_ui(np)%data(im, jfirst:jlast, kfirst:klast) ) + + allocate( met_v(im, jfirst-ng_s:jlast+ng_d, kfirst:klast) ) + allocate( met_vi(nm)%data(im, jfirst:jlast, kfirst:klast) ) + allocate( met_vi(np)%data(im, jfirst:jlast, kfirst:klast) ) + + endif + + end subroutine metdata_dyn_init + +!================================================================================= + + subroutine metdata_phys_init + use infnan, only : nan, assignment(=) + use cam_history, only : addfld, horiz_only + + call addfld ('MET_RLX', (/ 'lev' /), 'A', ' ', 'Meteorology relax function', gridname='fv_centers') + call addfld ('MET_TAUX', horiz_only, 'A', ' ', 'Meteorology taux', gridname='physgrid') + call addfld ('MET_TAUY', horiz_only, 'A', ' ', 'Meteorology tauy', gridname='physgrid') + call addfld ('MET_SHFX', horiz_only, 'A', ' ', 'Meteorology shflx', gridname='physgrid') + call addfld ('MET_QFLX', horiz_only, 'A', ' ', 'Meteorology qflx', gridname='physgrid') + call addfld ('MET_PS', horiz_only, 'A', ' ', 'Meteorology PS', gridname='fv_centers') + call addfld ('MET_T', (/ 'lev' /), 'A', ' ', 'Meteorology T', gridname='physgrid') + call addfld ('MET_U', (/ 'lev' /), 'A', ' ', 'Meteorology U', gridname='fv_centers') + call addfld ('MET_V', (/ 'lev' /), 'A', ' ', 'Meteorology V', gridname='fv_centers') + call addfld ('MET_SNOWH', horiz_only, 'A', ' ', 'Meteorology snow height', gridname='physgrid') + + call addfld ('MET_TS', horiz_only, 'A', 'K', 'Meteorology TS', gridname='physgrid') + call addfld ('MET_OCNFRC', horiz_only, 'A', 'fraction', 'Ocean frac derived from met TS', gridname='physgrid') + call addfld ('MET_ICEFRC', horiz_only, 'A', 'fraction', 'Sea ice frac derived from met TS', gridname='physgrid') + +! allocate chunked arrays + + allocate( met_ti(nm)%data(pcols,pver,begchunk:endchunk) ) + allocate( met_ti(np)%data(pcols,pver,begchunk:endchunk) ) + allocate( met_t(pcols,pver,begchunk:endchunk) ) + + allocate( met_qi(nm)%data(pcols,pver,begchunk:endchunk) ) + allocate( met_qi(np)%data(pcols,pver,begchunk:endchunk) ) + allocate( met_q(pcols,pver,begchunk:endchunk) ) + + allocate( met_shflxi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_shflxi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_shflx(pcols,begchunk:endchunk) ) + + allocate( met_qflxi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_qflxi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_qflx(pcols,begchunk:endchunk) ) + + allocate( met_tauxi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_tauxi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_taux(pcols,begchunk:endchunk) ) + + allocate( met_tauyi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_tauyi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_tauy(pcols,begchunk:endchunk) ) + + allocate( met_tsi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_tsi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_ts(pcols,begchunk:endchunk) ) + met_ts(:,:) = nan + + if(.not.met_srf_feedback) then + allocate( met_snowhi(nm)%data(pcols,begchunk:endchunk) ) + allocate( met_snowhi(np)%data(pcols,begchunk:endchunk) ) + allocate( met_snowh(pcols,begchunk:endchunk) ) + met_snowh(:,:) = nan + endif + + call set_met_rlx() + + ! initialize phys surface fields... + call get_model_time() + call check_files() + call read_phys_srf_flds() + call interp_phys_srf_flds() + datatimem = -1.e36_r8 + datatimep = -1.e36_r8 + end subroutine metdata_phys_init + + +!----------------------------------------------------------------------- +! Reads more data if needed and interpolates data to current model time +!----------------------------------------------------------------------- + subroutine advance_met(grid) + use cam_history, only : outfld + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + + real(r8) :: met_rlx_2d(grid%ifirstxy:grid%ilastxy,grid%km) + integer :: i,j,k, idim + + call t_startf('MET__advance') + +! +! + call get_model_time() + + if ( ( curr_mod_time > datatimep ) .or. & + ( next_mod_time > datatimepn ) ) then + call check_files() + endif + + if ( curr_mod_time > datatimep ) then + call read_next_metdata(grid) + end if + + if ( next_mod_time > datatimepn ) then + call read_next_ps(grid) + end if + +! need to inperpolate the data, regardless ! +! each mpi tasks needs to interpolate + call interpolate_metdata(grid) + + call t_stopf('MET__advance') + + idim = grid%ilastxy - grid%ifirstxy + 1 + do j = grid%jfirstxy, grid%jlastxy + do k = 1, grid%km + do i = grid%ifirstxy, grid%ilastxy + met_rlx_2d(i,k) = met_rlx(k) + enddo + enddo + call outfld('MET_RLX',met_rlx_2d, idim, j) + enddo + end subroutine advance_met + +!------------------------------------------------------------------- +! Method to get some the meteorology data. +! Sets the following cam_in_t member fields to the +! meteorology data : +! qflx +! shflx +! taux +! tauy +! snowh +!------------------------------------------------------------------- + subroutine get_met_srf2( cam_in ) + use camsrfexch, only: cam_in_t + use phys_grid, only: get_ncols_p + use cam_history, only: outfld + use shr_const_mod, only: shr_const_stebol + + implicit none + + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + + integer :: c,ncol,i + + if (met_srf_nudge_flux) then + do c=begchunk,endchunk + ncol = get_ncols_p(c) + cam_in(c)%wsx(:ncol) = (1._r8-met_rlx(pver)) * cam_in(c)%wsx(:ncol) + met_rlx(pver) * met_taux(:ncol,c) + cam_in(c)%wsy(:ncol) = (1._r8-met_rlx(pver)) * cam_in(c)%wsy(:ncol) + met_rlx(pver) * met_tauy(:ncol,c) + cam_in(c)%shf(:ncol) = (1._r8-met_rlx(pver)) * cam_in(c)%shf(:ncol) + & + met_rlx(pver) * (met_shflx(:ncol,c) * met_shflx_factor) + cam_in(c)%cflx(:ncol,1) = (1._r8-met_rlx(pver)) * cam_in(c)%cflx(:ncol,1) + & + met_rlx(pver) * (met_qflx(:ncol,c) * met_qflx_factor) + end do ! Chunk loop + else + do c=begchunk,endchunk + ncol = get_ncols_p(c) + cam_in(c)%wsx(:ncol) = met_taux(:ncol,c) + cam_in(c)%wsy(:ncol) = met_tauy(:ncol,c) + cam_in(c)%shf(:ncol) = met_shflx(:ncol,c) * met_shflx_factor + cam_in(c)%cflx(:ncol,1) = met_qflx(:ncol,c) * met_qflx_factor + end do ! Chunk loop + end if + + if (debug) then + if (masterproc) then + write(iulog,*)'METDATA maxval(met_taux),minval(met_taux): ',maxval(met_taux),minval(met_taux) + write(iulog,*)'METDATA maxval(met_tauy),minval(met_tauy): ',maxval(met_tauy),minval(met_tauy) + write(iulog,*)'METDATA maxval(met_shflx),minval(met_shflx): ',maxval(met_shflx),minval(met_shflx) + write(iulog,*)'METDATA maxval(met_qflx),minval(met_qflx): ',maxval(met_qflx),minval(met_qflx) + endif + endif + + do c = begchunk, endchunk + call outfld('MET_TAUX',cam_in(c)%wsx , pcols ,c ) + call outfld('MET_TAUY',cam_in(c)%wsy , pcols ,c ) + call outfld('MET_SHFX',cam_in(c)%shf , pcols ,c ) + call outfld('MET_QFLX',cam_in(c)%cflx(:,1) , pcols ,c ) + enddo + + end subroutine get_met_srf2 + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_met_srf1( cam_in ) + use camsrfexch, only: cam_in_t + use phys_grid, only: get_ncols_p + use cam_history, only: outfld + use shr_const_mod, only: shr_const_stebol + + implicit none + + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + + integer :: c,ncol,i + + if (met_srf_feedback) return + if (.not.has_ts) then + call endrun('The meteorolgy input must have TS to run with met_srf_feedback set to FALSE') + endif + + do c=begchunk,endchunk + ncol = get_ncols_p(c) + cam_in(c)%ts(:ncol) = met_ts(:ncol,c) + do i = 1,ncol + cam_in(c)%snowhland(i) = met_snowh(i,c)*cam_in(c)%landfrac(i) * met_snowh_factor + enddo + end do ! Chunk loop + + if (debug) then + if (masterproc) then + write(iulog,*)'METDATA maxval(met_ts),minval(met_ts): ',maxval(met_ts),minval(met_ts) + write(iulog,*)'METDATA maxval(met_snowh),minval(met_snowh): ',maxval(met_snowh),minval(met_snowh) + endif + endif + + do c = begchunk, endchunk + call outfld('MET_SNOWH',cam_in(c)%snowhland, pcols ,c ) + enddo + + end subroutine get_met_srf1 + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine get_ocn_ice_frcs( lndfrc, ocnfrc, icefrc, lchnk, ncol ) + + use shr_const_mod, only: SHR_CONST_TKFRZSW + use shr_const_mod, only: SHR_CONST_TKFRZ + use cam_history, only: outfld + + ! args + real(r8), intent( in) :: lndfrc (pcols) + real(r8), intent(out) :: ocnfrc (pcols) + real(r8), intent(out) :: icefrc (pcols) + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + + ! local vars + integer :: i + + if (.not.has_ts) then + if (masterproc) then + write(iulog,*) 'get_ocn_ice_frcs: TS is not in the met dataset and cannot set ocnfrc and icefrc' + write(iulog,*) ' try setting drydep_method to xactive_atm or table' + call endrun('get_ocn_ice_frcs: TS is not in the met dataset') + endif + endif + + do i = 1,ncol + + if ( met_ts(i,lchnk) < SHR_CONST_TKFRZ-2._r8 ) then + ocnfrc(i) = 0._r8 + icefrc(i) = 1._r8 - lndfrc(i) + else + icefrc(i) = 0._r8 + ocnfrc(i) = 1._r8 - lndfrc(i) + endif + + enddo + + call outfld('MET_TS', met_ts(:ncol,lchnk) , ncol ,lchnk ) + call outfld('MET_OCNFRC', ocnfrc(:ncol) , ncol ,lchnk ) + call outfld('MET_ICEFRC', icefrc(:ncol) , ncol ,lchnk ) + + endsubroutine get_ocn_ice_frcs + +!------------------------------------------------------------------- +! allows access to physics state fields +! q : water vapor +! ps : surface pressure +! t : temperature +!------------------------------------------------------------------- + subroutine get_dyn_flds( state, tend, dt ) + + use physics_types, only: physics_state, physics_tend, physics_dme_adjust + use ppgrid, only: pcols, pver, begchunk, endchunk + use phys_grid, only: get_ncols_p + use cam_history, only: outfld + + implicit none + + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: tend + real(r8), intent(in ) :: dt ! model physics timestep + + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: c, ncol, i,j,k + real(r8):: qini(pcols,pver) ! initial specific humidity + + real(r8) :: tmp(pcols,pver) + + call t_startf('MET__GET_DYN2') + + do c = begchunk, endchunk + ncol = get_ncols_p(c) + do k=1,pver + do i=1,ncol + state(c)%t(i,k) = (1._r8-met_rlx(k))*state(c)%t(i,k) + met_rlx(k)*met_t(i,k,c) + + qini(i,k) = state(c)%q(i,k,1) + + ! at this point tracer mixing ratios have already been + ! converted from dry to moist +!!$ if ( moist_q_mmr .and. (.not. online_test)) then + state(c)%q(i,k,1) = alpha*state(c)%q(i,k,1) + & + (1-alpha)*met_q(i,k,c) +!!$ else +!!$ ! dry-to-moist conversion +!!$ state(c)%q(i,k,1) = alpha*state(c)%q(i,k,1) + & +!!$ (1.-alpha)*met_q(i,c,k) & +!!$ * state(c)%pdeldry(i,k)/state(c)%pdel(i,k) +!!$ endif + + if ((state(c)%q(i,k,1) < D0_0).and. (alpha .ne. D1_0 )) state(c)%q(i,k,1) = D0_0 + + end do + + end do + + ! now adjust mass of each layer now that water vapor has changed + if (( .not. online_test ) .and. (alpha .ne. D1_0 )) then + call physics_dme_adjust(state(c), tend(c), qini, dt) + endif + + end do + + if (debug) then + if (masterproc) then + write(iulog,*)'METDATA maxval(met_t),minval(met_t): ', maxval(met_t),minval(met_t) + write(iulog,*)'METDATA maxval(met_ps_next),minval(met_ps_next): ', maxval(met_ps_next),minval(met_ps_next) + endif + endif + + do c = begchunk, endchunk + call outfld('MET_T ',state(c)%t , pcols ,c ) + enddo + call t_stopf('MET__GET_DYN2') + + end subroutine get_dyn_flds + +!------------------------------------------------------------------------ +! get the meteorological winds on the grid cell centers (A-grid) +!------------------------------------------------------------------------ + subroutine get_uv_centered( grid, u, v ) + + use cam_history, only: outfld + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(out) :: u(grid%im, grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d, & + grid%kfirst:grid%klast) ! u-wind on A-grid + real(r8), intent(out) :: v(grid%im, grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d, & + grid%kfirst:grid%klast) ! v-wind on A-grid + + integer :: i,j,k + + integer :: jm, jfirst, jlast, jfirstxy, jlastxy, kfirst, klast, ng_d, ng_s, ifirstxy, ilastxy + + real(r8) :: u3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: v3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km) + + jm = grid%jm + jfirstxy= grid%jfirstxy + jlastxy = grid%jlastxy + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + ifirstxy= grid%ifirstxy + ilastxy = grid%ilastxy + + ng_d = grid%ng_d + ng_s = grid%ng_s + + u(:,:,:) = D0_0 + v(:,:,:) = D0_0 + + u( :, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast ) = & + met_u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast ) + + v( :, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast ) = & + met_v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast ) + + if (masterproc) then + if (debug) write(iulog,*)'METDATA maxval(u),minval(u),maxval(v),minval(v) : ',& + maxval(u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast )),& + minval(u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast )),& + maxval(v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast )),& + minval(v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast )) + endif + + if ( grid%twod_decomp .eq. 0 ) then + do j = jfirst, jlast + do k = kfirst, klast + do i = 1, grid%im + u3s_tmp(i,k) = u(i,j,k) + v3s_tmp(i,k) = v(i,j,k) + enddo + enddo + call outfld ('MET_U ', u3s_tmp, grid%im, j ) + call outfld ('MET_V ', v3s_tmp, grid%im, j ) + enddo + endif + + end subroutine get_uv_centered + +!------------------------------------------------------------------------ +! get the meteorological surface pressure interp to dyn substep +!------------------------------------------------------------------------ + subroutine get_ps( grid, ps, nsubsteps, n ) + + use cam_history, only: outfld + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(out) :: ps(grid%im, grid%jfirst:grid%jlast) + integer, intent(in) :: nsubsteps + integer, intent(in) :: n + + real(r8) :: num1, num2 + integer :: j + + num1 = n + num2 = nsubsteps + + ps(:,:) = met_ps_curr(:,:) + num1*(met_ps_next(:,:)-met_ps_curr(:,:))/num2 + + if ( grid%twod_decomp .eq. 0 ) then + do j = grid%jfirst, grid%jlast + call outfld('MET_PS',ps(:,j), grid%im ,j ) + enddo + endif + end subroutine get_ps + +!------------------------------------------------------------------------ +! get the meteorological winds on the grid cell walls (vorticity winds) +! us : staggered zonal wind +! vs : staggered meridional wind +!------------------------------------------------------------------------ + subroutine get_us_vs( grid, us, vs ) + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(inout) :: us(grid%im, grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s, & + grid%kfirst:grid%klast) ! u-wind on d-grid + real(r8), intent(inout) :: vs(grid%im, grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d, & + grid%kfirst:grid%klast) ! v-wind on d-grid + + integer :: i,j,k + + integer :: jm, jfirst, jlast, kfirst, klast, ng_d, ng_s + + jm = grid%jm + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + ng_d = grid%ng_d + ng_s = grid%ng_s + + call t_startf('MET__get_us_vs') + + ! vertical relaxation (blending) occurs in dyn_run (dyn_comp.F90) + + us(:,:,:) = 1.e36_r8 + vs(:,:,:) = 1.e36_r8 + us( :, max(2,jfirst): min(jm,jlast), kfirst:klast) = & + met_us( :, max(2,jfirst): min(jm,jlast), kfirst:klast) + vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast) = & + met_vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast) + if (masterproc) then + if (debug) write(iulog,*)grid%iam,': METDATA maxval(us),minval(us),maxval(vs),minval(vs) : ',& + maxval(us( :, max(2,jfirst): min(jm,jlast), kfirst:klast)),& + minval(us( :, max(2,jfirst): min(jm,jlast), kfirst:klast)),& + maxval(vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast)),& + minval(vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast)) + endif + +!!$ if (debug) then +!!$ u3s_tmp = 1.e36 +!!$ do j = jfirst, jlast +!!$ do k = kfirst, klast +!!$ do i = 1, im +!!$ if (j >= 2) u3s_tmp(i,k) = us(i,j,k) +!!$ v3s_tmp(i,k) = vs(i,j,k) +!!$ enddo +!!$ enddo +!!$ call outfld ('MET_US ', u3s_tmp, im, j ) +!!$ call outfld ('MET_VS ', v3s_tmp, im, j ) +!!$ enddo +!!$ endif +!!$ + call t_stopf('MET__get_us_vs') + + end subroutine get_us_vs + +!------------------------------------------------------------------------- +! writes file names to restart file +!------------------------------------------------------------------------- + + subroutine write_met_restart_pio(File) + type(file_desc_t), intent(inout) :: File + integer :: ierr + ierr = pio_put_att(File, PIO_GLOBAL, 'current_metdata_filename', curr_filename) + ierr = pio_put_att(File, PIO_GLOBAL, 'next_metdata_filename', next_filename) + + end subroutine write_met_restart_pio + subroutine read_met_restart_pio(File) + type(file_desc_t), intent(inout) :: File + + integer :: ierr, xtype + integer(pio_offset_kind) :: slen + + ierr = pio_inq_att(File, PIO_GLOBAL, 'current_metdata_filename',xtype, slen) + ierr = pio_get_att(File, PIO_GLOBAL, 'current_metdata_filename', curr_filename) + curr_filename(slen+1:256) = '' + + ierr = pio_inq_att(File, PIO_GLOBAL, 'next_metdata_filename',xtype, slen) + ierr = pio_get_att(File, PIO_GLOBAL, 'next_metdata_filename', next_filename) + next_filename(slen+1:256) = '' + + end subroutine read_met_restart_pio + + subroutine write_met_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + integer :: ioerr ! error status + + if (masterproc) then + write(nrg, iostat=ioerr) curr_filename + if (ioerr /= 0 ) then + write(iulog,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg + call endrun ('WRITE_RESTART_DYNAMICS') + end if + write(nrg, iostat=ioerr) next_filename + if (ioerr /= 0 ) then + write(iulog,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg + call endrun ('WRITE_RESTART_DYNAMICS') + end if + end if + end subroutine write_met_restart_bin + +!------------------------------------------------------------------------- +! reads file names from restart file +!------------------------------------------------------------------------- + subroutine read_met_restart_bin( nrg ) + implicit none + integer,intent(in) :: nrg ! Unit number + integer :: ioerr ! error status + + if (masterproc) then + read(nrg, iostat=ioerr) curr_filename + if (ioerr /= 0 ) then + write(iulog,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg + call endrun ('READ_RESTART_DYNAMICS') + end if + read(nrg, iostat=ioerr) next_filename + if (ioerr /= 0 ) then + write(iulog,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg + call endrun ('READ_RESTART_DYNAMICS') + end if + end if + +#if ( defined SPMD ) + call mpibcast ( curr_filename ,len(curr_filename) ,mpichar,0,mpicom) + call mpibcast ( next_filename ,len(next_filename) ,mpichar,0,mpicom) +#endif + end subroutine read_met_restart_bin + +!------------------------------------------------------------------------- +! returns true if the met winds are defined on cell walls +!------------------------------------------------------------------------- + function met_winds_on_walls() + logical :: met_winds_on_walls + + met_winds_on_walls = met_cell_wall_winds + end function met_winds_on_walls + +! internal methods : + +!------------------------------------------------------------------------- +! transfers cell-centered winds to cell walls +!------------------------------------------------------------------------- + subroutine transfer_windsToWalls(grid) + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + integer :: i,j,k + integer :: im, jfirst, jlast, kfirst, klast + + im = grid%im + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + call t_startf('MET__transfer_windsToWalls') + +!$omp parallel do private (i, j, k) + do k = kfirst, klast + + do j = jfirst+1,jlast + do i = 1,im + met_us(i,j,k) = ( met_u(i,j,k) + met_u(i,j-1,k) )*D0_5 + end do + end do + +#if defined( SPMD ) + if ( jfirst .gt. 1 ) then + do i = 1, im + ! met_u is alread ghosted at this point + met_us(i,jfirst,k) = ( met_u(i,jfirst,k) + met_u(i,jfirst-1,k) )*D0_5 + enddo + endif +#endif + + do j = jfirst,jlast + met_vs(1,j,k) = ( met_v(1,j,k) + met_v(im,j,k) )*D0_5 + do i = 2,im + met_vs(i,j,k) = ( met_v(i,j,k) + met_v(i-1,j,k) )*D0_5 + end do + end do + end do + + call t_stopf('MET__transfer_windsToWalls') + + end subroutine transfer_windsToWalls + + subroutine get_model_time() + implicit none + integer yr, mon, day, ncsec ! components of a date + + call t_startf('MET__get_model_time') + + call get_curr_date(yr, mon, day, ncsec) + + curr_mod_time = get_time_float( yr, mon, day, ncsec ) + next_mod_time = curr_mod_time + get_step_size()/seconds_per_day + + call t_stopf('MET__get_model_time') + + end subroutine get_model_time + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine check_files() + + use shr_sys_mod, only: shr_sys_system + use ioFileMod, only: getfil + + implicit none + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + character(len=256) :: ctmp + character(len=256) :: loc_fname + integer :: istat + + + if (next_mod_time > curr_data_times(size(curr_data_times))) then + if ( .not. associated(next_data_times) ) then + ! open next file... + next_filename = incr_filename( curr_filename ) + call open_met_datafile( next_filename, next_fileid, next_data_times, met_data_path ) + endif + endif + + if ( associated(next_data_times) ) then + if (curr_mod_time >= next_data_times(1)) then + + ! close current file ... + call pio_closefile( curr_fileid ) + if (masterproc) then + ! remove if requested + if( met_remove_file ) then + call getfil( curr_filename, loc_fname, 0 ) + write(iulog,*) 'check_files: removing file = ',trim(loc_fname) + ctmp = 'rm -f ' // trim(loc_fname) + write(iulog,*) 'check_files: fsystem issuing command - ' + write(iulog,*) trim(ctmp) + call shr_sys_system( ctmp, istat ) + end if + endif + + curr_filename = next_filename + curr_fileid = next_fileid + + deallocate( curr_data_times ) + allocate( curr_data_times( size( next_data_times ) ) ) + curr_data_times(:) = next_data_times(:) + + next_filename = '' + + deallocate( next_data_times ) + nullify( next_data_times ) + + endif + endif + + end subroutine check_files + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + function incr_filename( filename ) + + !----------------------------------------------------------------------- + ! ... Increment or decrement a date string withing a filename + ! the filename date section is assumed to be of the form + ! yyyy-dd-mm + !----------------------------------------------------------------------- + + use string_utils, only : incstr + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + + implicit none + + + character(len=*), intent(in) :: filename ! present dynamical dataset filename + character(len=256) :: incr_filename ! next filename in the sequence + + ! set new next_filename ... + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: pos, pos1, istat + character(len=256) :: fn_new, line + character(len=6) :: seconds + character(len=5) :: num + integer :: ios,unitnumber + + if ( len_trim(met_filenames_list) .eq. 0) then + !----------------------------------------------------------------------- + ! ... ccm type filename + !----------------------------------------------------------------------- + pos = len_trim( filename ) + fn_new = filename(:pos) + write(iulog,*) 'incr_flnm: old filename = ',trim(fn_new) + if( fn_new(pos-2:) == '.nc' ) then + pos = pos - 3 + end if + istat = incstr( fn_new(:pos), 1 ) + if( istat /= 0 ) then + write(iulog,*) 'incr_flnm: incstr returned ', istat + write(iulog,*) ' while trying to decrement ',trim( fn_new ) + call endrun + end if + + else + + ! open met_filenames_list + write(iulog,*) 'incr_flnm: old filename = ',trim(filename) + write(iulog,*) 'incr_flnm: open met_filenames_list : ',met_filenames_list + unitnumber = shr_file_getUnit() + open( unit=unitnumber, file=met_filenames_list, iostat=ios, status="OLD") + if (ios /= 0) then + call endrun('not able to open met_filenames_list file: '//met_filenames_list) + endif + + ! read file names + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + if (ios /= 0) then + call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) + endif + do while( trim(line) /= trim(filename) ) + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + if (ios /= 0) then + call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) + endif + enddo + + read( unit=unitnumber, fmt='(A)', iostat=ios ) line + if (ios /= 0) then + call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) + endif + fn_new = trim(line) + + close(unit=unitnumber) + call shr_file_freeUnit(unitnumber) + endif + incr_filename = trim(fn_new) + write(iulog,*) 'incr_flnm: new filename = ',incr_filename + + end function incr_filename + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine find_times( itms, fids, datatm, datatp, time ) + + implicit none + + integer, intent(out) :: itms(2) ! record numbers that bracket time + type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs + real(r8), intent(in) :: time ! time of interest + real(r8), intent(out):: datatm, datatp + + integer np1 ! current forward time index of dataset + integer n,i ! + integer :: curr_tsize, next_tsize, all_tsize + + real(r8), allocatable, dimension(:):: all_data_times + + curr_tsize = size(curr_data_times) + next_tsize = 0 + if ( associated(next_data_times)) next_tsize = size(next_data_times) + + all_tsize = curr_tsize + next_tsize + + allocate( all_data_times( all_tsize ) ) + + all_data_times(:curr_tsize) = curr_data_times(:) + if (next_tsize > 0) all_data_times(curr_tsize+1:all_tsize) = next_data_times(:) + + ! find bracketing times + do n=1, all_tsize-1 + np1 = n + 1 + datatm = all_data_times(n) + datatp = all_data_times(np1) + if ( (time .ge. datatm) .and. (time .le. datatp) ) then + goto 20 + endif + enddo + + write(iulog,*)'FIND_TIMES: Failed to find dates bracketing desired time =', time + write(iulog,*)' datatm = ',datatm + write(iulog,*)' datatp = ',datatp + write(iulog,*)' all_data_times = ',all_data_times + + call endrun + +20 continue + + deallocate( all_data_times ) + + itms(1) = n + itms(2) = np1 + fids(:) = curr_fileid + + do i=1,2 + if ( itms(i) > curr_tsize ) then + itms(i) = itms(i) - curr_tsize + fids(i) = next_fileid + endif + enddo + + end subroutine find_times + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine read_next_ps(grid) + use ncdio_atm, only: infld + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + + integer :: recnos(2) + type(file_desc_t) :: fids(2) + character(len=8) :: varname + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + + real(r8) :: wrk_xy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy ) + + logical :: readvar + + if(online_test) then + varname='arch_PS' + else + varname='PS' + end if + + jfirstxy= grid%jfirstxy + jlastxy = grid%jlastxy + ifirstxy= grid%ifirstxy + ilastxy = grid%ilastxy + + call find_times( recnos, fids, datatimemn, datatimepn, next_mod_time ) + + call infld(varname, fids(1), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, & + wrk_xy, readvar, gridname='fv_centers', timelevel=recnos(1)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_2d( wrk_xy, met_psi_next(nm)%data, grid ) + + call infld(varname, fids(2), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, & + wrk_xy, readvar, gridname='fv_centers', timelevel=recnos(2)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_2d( wrk_xy, met_psi_next(np)%data, grid ) + + if(masterproc) write(iulog,*)'READ_NEXT_PS: Read meteorological data ' + + end subroutine read_next_ps + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ + subroutine transpose_xy2yz_2d( xy_2d, yz_2d, grid ) + + implicit none + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: xy_2d(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy) + real(r8), intent(out) :: yz_2d(1:grid%im, grid%jfirst:grid%jlast) + + real(r8) :: xy3(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, 1:grid%npr_z ) + integer :: i,j,k + + if (grid%iam .lt. grid%npes_xy) then + if ( grid%twod_decomp .eq. 1 ) then + +#if defined( SPMD ) +!$omp parallel do private(i,j,k) + do k=1,grid%npr_z + do j=grid%jfirstxy,grid%jlastxy + do i=grid%ifirstxy,grid%ilastxy + xy3(i,j,k) = xy_2d(i,j) + enddo + enddo + enddo + + call mp_sendirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, xy3, yz_2d, & + modc=grid%modc_dynrun ) + call mp_recvirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, & + grid%xy2d_to_yz2d%RecvDesc, xy3, yz_2d, & + modc=grid%modc_dynrun ) +#endif + + else + yz_2d(:,:) = xy_2d(:,:) + endif + endif ! (grid%iam .lt. grid%npes_xy) + + end subroutine transpose_xy2yz_2d + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ + subroutine transpose_xy2yz_3d( xy_3d, yz_3d, grid ) + + implicit none + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: xy_3d(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, 1:grid%km ) + real(r8), intent(out) :: yz_3d(1:grid%im, grid%jfirst:grid%jlast, grid%kfirst:grid%klast) + + if (grid%iam .lt. grid%npes_xy) then + if ( grid%twod_decomp .eq. 1 ) then +#if defined( SPMD ) + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, xy_3d, yz_3d, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, xy_3d, yz_3d, & + modc=grid%modc_dynrun ) +#endif + else + yz_3d(:,:,:) = xy_3d(:,:,:) + endif + endif ! (grid%iam .lt. grid%npes_xy) + + end subroutine transpose_xy2yz_3d + + + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ + subroutine read_next_metdata(grid) + use ncdio_atm, only: infld + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + + implicit none + + type (T_FVDYCORE_GRID), intent(in) :: grid + integer recnos(2), i ! + type(file_desc_t) :: fids(2) + + character(len=8) :: Uname, Vname, Tname, Qname, psname + character(len=8) :: dim1name, dim2name + integer :: im, jm, km + logical :: readvar + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + real(r8), allocatable :: wrk2_xy(:,:) + real(r8), allocatable :: wrk3_xy(:,:,:) + real(r8), allocatable :: tmp_data(:,:,:) + integer :: elev1,blev1, elev2,blev2 + integer :: elev3,blev3, elev4,blev4 + integer :: grid_id ! grid ID for data mapping + + call t_startf('MET__read_next_metdata') + + jfirstxy= grid%jfirstxy + jlastxy = grid%jlastxy + ifirstxy= grid%ifirstxy + ilastxy = grid%ilastxy + + im = grid%im + jm = grid%jm + km = grid%km + + call find_times( recnos, fids, datatimem, datatimep, curr_mod_time ) + ! + ! Set up hyperslab corners + ! + + if(online_test) then + Tname='arch_T' + Qname='arch_Q' + PSname='arch_PS' + if(met_cell_wall_winds) then + Uname='arch_US' + Vname='arch_VS' + else + Uname='arch_U' + Vname='arch_V' + end if + else + Tname='T' + Qname='Q' + PSname='PS' + if(met_cell_wall_winds) then + Uname='US' + Vname='VS' + else + Uname='U' + Vname='V' + end if + + end if + + + if ( num_met_levels>km ) then + + blev1 = 1 + elev1 = km + + blev2 = num_met_levels-km+1 + elev2 = num_met_levels + + blev3 = num_met_levels-km+1 + elev3 = num_met_levels + + blev4 = 1 + elev4 = num_met_levels + + else + + blev1 = km-num_met_levels+1 + elev1 = km + + blev2 = 1 + elev2 = num_met_levels + + blev3 = 1 + elev3 = km + + blev4 = km-num_met_levels+1 + elev4 = km + + endif + + allocate(tmp_data(pcols, 1:num_met_levels, begchunk:endchunk)) + allocate(wrk2_xy(ifirstxy:ilastxy, jfirstxy:jlastxy)) + allocate(wrk3_xy(ifirstxy:ilastxy, jfirstxy:jlastxy, 1:max(km,num_met_levels))) + + ! physgrid intput for FV is probably always lon/lat but let's be pedantic + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun('read_next_metdata: Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + do i=1,2 + + met_ti(i)%data = 0._r8 + + call infld(Tname, fids(i), dim1name, 'lev', dim2name, 1, pcols, 1,num_met_levels , & + begchunk, endchunk, tmp_data, readvar, gridname='physgrid',timelevel=recnos(i)) + + met_ti(i)%data(:,blev1:elev1,:) = tmp_data(:, blev2:elev2, :) + + met_qi(i)%data = 0._r8 + + call infld(Qname, fids(i), dim1name, 'lev', dim2name, 1, pcols, 1,num_met_levels, & + begchunk, endchunk, tmp_data, readvar, gridname='physgrid',timelevel=recnos(i)) + + met_qi(i)%data(:,blev1:elev1,:) = tmp_data(:, blev2:elev2, :) + + if (met_cell_wall_winds) then + + wrk3_xy = 0._r8 + met_usi(i)%data(:,:,:) = 0._r8 + call infld(Uname, fids(i), 'lon', 'slat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_u_stagger',timelevel=recnos(i)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_usi(i)%data(:,:,:), grid ) + + wrk3_xy = 0._r8 + met_vsi(i)%data(:,:,:) = 0._r8 + call infld(Vname, fids(i), 'slon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_v_stagger',timelevel=recnos(i)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_vsi(i)%data(:,:,:), grid ) + + else + + ! read into lower portion of the array... + + wrk3_xy = 0._r8 + met_ui(i)%data = 0._r8 + call infld(Uname, fids(i), 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_centers',timelevel=recnos(i)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_ui(i)%data(:,:,:), grid ) + + wrk3_xy = 0._r8 + met_vi(i)%data = 0._r8 + call infld(Vname, fids(i), 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_centers',timelevel=recnos(i)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_vi(i)%data(:,:,:), grid ) + + endif ! met_cell_wall_winds + + call infld(PSname, fids(i), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, & + wrk2_xy, readvar, gridname='fv_centers', timelevel=recnos(i)) + + ! transpose xy -> yz decomposition + call transpose_xy2yz_2d( wrk2_xy, met_psi_curr(i)%data, grid ) + + enddo + + deallocate(tmp_data) + deallocate(wrk3_xy) + deallocate(wrk2_xy) + + ! 2-D feilds + call read_phys_srf_flds( ) + + if(masterproc) write(iulog,*)'READ_NEXT_METDATA: Read meteorological data ' + + call t_stopf('MET__read_next_metdata') + + end subroutine read_next_metdata + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine read_phys_srf_flds( ) + use ncdio_atm, only: infld + + integer :: i, recnos(2) + type(file_desc_t) :: fids(2) + logical :: readvar + + call find_times( recnos, fids, datatimem, datatimep, curr_mod_time ) + do i=1,2 + + call infld(met_shflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_shflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + + call infld(met_qflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_qflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + call infld('TAUX', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_tauxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + call infld('TAUY', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_tauyi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + if ( .not.met_srf_feedback ) then + call infld('SNOWH', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_snowhi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + endif + if (has_ts) then + call infld('TS', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & + met_tsi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + endif + enddo + end subroutine read_phys_srf_flds + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine interp_phys_srf_flds( ) + use phys_grid, only: get_ncols_p + real(r4) :: fact1, fact2 + real(r8) :: deltat + integer :: i, c, ncol + + deltat = datatimep - datatimem + fact1 = (datatimep - curr_mod_time)/deltat + fact2 = D1_0-fact1 + + + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do i=1,ncol + met_shflx(i,c) = fact1*met_shflxi(nm)%data(i,c) + fact2*met_shflxi(np)%data(i,c) + met_qflx(i,c) = fact1*met_qflxi(nm)%data(i,c) + fact2*met_qflxi(np)%data(i,c) + met_taux(i,c) = fact1*met_tauxi(nm)%data(i,c) + fact2*met_tauxi(np)%data(i,c) + met_tauy(i,c) = fact1*met_tauyi(nm)%data(i,c) + fact2*met_tauyi(np)%data(i,c) + enddo + enddo + if ( .not.met_srf_feedback ) then + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do i=1,ncol + met_snowh(i,c) = fact1*met_snowhi(nm)%data(i,c) + fact2*met_snowhi(np)%data(i,c) + enddo + enddo + endif + if (has_ts) then + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do i=1,ncol + met_ts(i,c) = fact1*met_tsi(nm)%data(i,c) + fact2*met_tsi(np)%data(i,c) + enddo + enddo + endif + + end subroutine interp_phys_srf_flds +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine interpolate_metdata(grid) + use phys_grid, only: get_ncols_p +#if defined( SPMD ) + use mod_comm, only : mp_send4d_ns, mp_recv4d_ns +#endif + + implicit none + type (T_FVDYCORE_GRID), intent(in) :: grid + + real(r4) fact1, fact2 + real(r4) nfact1, nfact2 + real(r8) deltat,deltatn + integer :: i,c,k, ncol + integer :: im, jm, km, jfirst, jlast, kfirst, klast, ng_d, ng_s + + im = grid%im + jm = grid%jm + km = grid%km + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + ng_d = grid%ng_d + ng_s = grid%ng_s + + call t_startf('MET__interpolate_metdata') + + deltat = datatimep - datatimem + deltatn = datatimepn - datatimemn + + fact1 = (datatimep - curr_mod_time)/deltat +! fact2 = (curr_mod_time - datatimem)/deltat + fact2 = D1_0-fact1 + + nfact1 = (datatimepn - next_mod_time)/deltatn +! nfact2 = (next_mod_time - datatimemn)/deltatn + nfact2 = D1_0-nfact1 + + met_q = 0.0_r8 + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do k=1,pver + do i=1,ncol + met_t(i,k,c) = fact1*met_ti(nm)%data(i,k,c) + fact2*met_ti(np)%data(i,k,c) + met_q(i,k,c) = fact1*met_qi(nm)%data(i,k,c) + fact2*met_qi(np)%data(i,k,c) + enddo + enddo + enddo + + if (.not. online_test) where (met_q .lt. D0_0) met_q = D0_0 + + met_ps_next(:,:) = nfact1*met_psi_next(nm)%data(:,:) + nfact2*met_psi_next(np)%data(:,:) + met_ps_curr(:,:) = fact1*met_psi_curr(nm)%data(:,:) + fact2*met_psi_curr(np)%data(:,:) + + call interp_phys_srf_flds() + + if (has_ts) then + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do i=1,ncol + met_ts(i,c) = fact1*met_tsi(nm)%data(i,c) + fact2*met_tsi(np)%data(i,c) + enddo + enddo + endif + + if ( .not. met_cell_wall_winds ) then + + met_u(1:im,jfirst:jlast,kfirst:klast) = fact1*met_ui(nm)%data(1:im,jfirst:jlast,kfirst:klast) & + + fact2*met_ui(np)%data(1:im,jfirst:jlast,kfirst:klast) + met_v(1:im,jfirst:jlast,kfirst:klast) = fact1*met_vi(nm)%data(1:im,jfirst:jlast,kfirst:klast) & + + fact2*met_vi(np)%data(1:im,jfirst:jlast,kfirst:klast) + + ! ghost u,v +#if defined( SPMD ) + call mp_send4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, met_u ) + call mp_send4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_s, met_v ) + call mp_recv4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_d, met_u ) + call mp_recv4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, & + kfirst, klast, ng_d, ng_s, met_v ) +#endif + + ! average to cell walls (vorticity winds) + call transfer_windsToWalls(grid) + else + met_us(:,jfirst:jlast,kfirst:klast) = fact1*met_usi(nm)%data(:,jfirst:jlast,kfirst:klast) + & + fact2*met_usi(np)%data(:,jfirst:jlast,kfirst:klast) + met_vs(:,jfirst:jlast,kfirst:klast) = fact1*met_vsi(nm)%data(:,jfirst:jlast,kfirst:klast) + & + fact2*met_vsi(np)%data(:,jfirst:jlast,kfirst:klast) + + endif + + ! ghost staggered u,v + ! WS 2006.04.11: not necessary here since it will be done in cd_core + +! write(iulog,*)'INTERPOLATE_METDATA: complete.' + + call t_stopf('MET__interpolate_metdata') + + end subroutine interpolate_metdata + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine get_dimension( fid, dname, dsize ) + implicit none + type(file_desc_t), intent(in) :: fid + character(*), intent(in) :: dname + integer, intent(out) :: dsize + + integer :: dimid, ierr + + ierr = pio_inq_dimid( fid, dname, dimid ) + ierr = pio_inq_dimlen( fid, dimid, dsize ) + + end subroutine get_dimension + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid ) + + use ioFileMod, only: getfil + use pio, only: pio_seterrorhandling, PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR + + implicit none + + character(*), intent(in) :: fname + type(file_desc_t), intent(inout) :: fileid + real(r8), pointer, intent(inout) :: times(:) + character(*), intent(in) :: datapath + logical, optional, intent(in) :: check_dims + type (T_FVDYCORE_GRID), optional, intent(in) :: grid + + character(len=256) :: filepath + character(len=256) :: filen + integer :: year, month, day, dsize, i, timesize + integer :: dateid,secid + integer, allocatable , dimension(:) :: dates, datesecs + integer :: ierr + integer :: im, jm, km + integer :: varid + + ! + ! open file and get fileid + ! + if (len_trim( datapath )>0) then + filepath = trim(datapath)//'/'//trim(fname) + else + filepath = trim(fname) + endif + call getfil( filepath, filen, 0 ) + + call cam_pio_openfile( fileid, filen, 0 ) + + call pio_seterrorhandling(fileid, PIO_BCAST_ERROR) + + ierr = pio_inq_varid( fileid, 'TS', varid ) + has_ts = ierr==PIO_NOERR + + call pio_seterrorhandling(fileid, PIO_INTERNAL_ERROR) + + if (masterproc) write(iulog,*) 'open_met_datafile: ',trim(filen) + + call get_dimension( fileid, 'time', timesize ) + + if ( associated(times) ) deallocate(times) + allocate( times(timesize) ) + + allocate( dates(timesize) ) + allocate( datesecs(timesize) ) + + ierr = pio_inq_varid( fileid, 'date', dateid ) + ierr = pio_inq_varid( fileid, 'datesec', secid ) + + ierr = pio_get_var( fileid, dateid, dates ) + ierr = pio_get_var( fileid, secid, datesecs ) + + do i=1,timesize + year = dates(i) / 10000 + month = mod(dates(i),10000)/100 + day = mod(dates(i),100) + times(i) = get_time_float( year, month, day, datesecs(i) ) + enddo + + deallocate( dates ) + deallocate( datesecs ) + + +! +! check that the data dim sizes match models dimensions +! + if (present(check_dims) .and. present(grid)) then + im = grid%im + jm = grid%jm + km = grid%km + + if (check_dims) then + + call get_dimension( fileid, 'lon', dsize ) + if (dsize /= im) then + write(iulog,*)'open_met_datafile: lonsiz=',dsize,' must = ',im + call endrun + endif + call get_dimension( fileid, 'lat', dsize ) + if (dsize /= jm) then + write(iulog,*)'open_met_datafile: latsiz=',dsize,' must = ',jm + call endrun + endif + call get_dimension( fileid, 'lev', dsize ) + met_levels = min( dsize, km ) + num_met_levels = dsize + endif + endif + + end subroutine open_met_datafile + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + function get_time_float( year, month, day, sec ) + +! returns float representation of time -- number of days +! since 1 jan 0001 00:00:00.000 + + implicit none + + integer, intent(in) :: year, month, day + integer, intent(in) :: sec + real(r8) :: get_time_float + +! ref date is 1 jan 0001 + + integer :: refyr, refmn, refdy + real(r8) :: refsc, fltdy + integer :: doy(12) + +! jan feb mar apr may jun jul aug sep oct nov dec +! 31 28 31 30 31 30 31 31 31 31 30 31 + data doy / 1, 32, 60, 91,121,152,182,213,244,274,305,335 / + + refyr = 1 + refmn = 1 + refdy = 1 + refsc = D0_0 + + if ( timemgr_is_caltype(trim(shr_cal_gregorian))) then + fltdy = greg2jday(year, month, day) - greg2jday(refyr,refmn,refdy) + else ! assume no_leap (all years are 365 days) + fltdy = (year - refyr)*days_per_non_leapyear + & + (doy(month)-doy(refmn)) + & + (day-refdy) + endif + + get_time_float = fltdy + ((sec-refsc)/seconds_per_day) + + endfunction get_time_float + +!----------------------------------------------------------------------- +! ... Return Julian day number given Gregorian date. +! +! Algorithm from Hatcher,D.A., Simple Formulae for Julian Day Numbers +! and Calendar Dates, Q.Jl.R.astr.Soc. (1984) v25, pp 53-55. +!----------------------------------------------------------------------- + function greg2jday( year, month, day ) + + implicit none + + integer, intent(in) :: year, month, day + integer :: greg2jday + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: ap, mp + integer :: y, d, n, g + + !----------------------------------------------------------------------- + ! ... Modify year and month numbers + !----------------------------------------------------------------------- + ap = year - (12 - month)/10 + mp = MOD( month-3,12 ) + if( mp < 0 ) then + mp = mp + 12 + end if + + !----------------------------------------------------------------------- + ! ... Julian day + !----------------------------------------------------------------------- + y = INT( days_per_year*( ap + 4712 ) ) + d = INT( days_per_month*mp + D0_5 ) + n = y + d + day + 59 + g = INT( D0_75*INT( ap/100 + 49 ) ) - 38 + greg2jday = n - g + + end function greg2jday + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine set_met_rlx( ) + + use pmgrid, only: plev + use hycoef, only: hypm, ps0 + + integer :: k, k_cnt, k_top + real(r8), parameter :: h0 = 7._r8 ! scale height (km) + real(r8), parameter :: hsec = 3600._r8 ! seconds per hour + real(r8) :: p_top, p_bot + real(r8) :: met_max_rlxdt, dtime_hrs + +996 format( 'set_met_rlx: ',a15, I10 ) +997 format( 'set_met_rlx: ',a15, E10.2 ) +998 format( 'set_met_rlx: ',a15, PLEV(E10.2)) +999 format( 'set_met_rlx: ',a15, PLEV(F10.5)) +993 format( 'set_met_rlx: ',a25, E10.2 ) + + met_rlx(:) = 999._r8 + + dtime_hrs = get_step_size()/hsec ! hours + + if (met_rlx_time > dtime_hrs) then + met_max_rlxdt = dtime_hrs/met_rlx_time + elseif (met_rlx_time < 0._r8) then + met_max_rlxdt = 0._r8 + else + met_max_rlxdt = 1._r8 + endif + + if (masterproc) then + write(iulog,fmt=993) ' met_rlx_time in hrs= ', met_rlx_time + write(iulog,fmt=993) ' met_max_rlxdt in % = ', met_max_rlxdt*100._r8 + endif + + p_top = ps0 * exp( - met_rlx_top/h0 ) + p_bot = ps0 * exp( - met_rlx_bot/h0 ) + + if (masterproc) then + write(iulog,fmt=997) 'p_top = ',p_top + write(iulog,fmt=997) 'p_bot = ',p_bot + endif + + if ( p_bot < hypm( pver-met_levels+1 ) .and. ( met_levels < pver ) ) then + call endrun( 'set_met_rlx: met_rlx_bot is too high ' ) + endif + + where( hypm < p_top ) + met_rlx = 0._r8 + endwhere + + where( hypm > p_bot ) + met_rlx = met_max_rlxdt + endwhere + + if ( any( met_rlx(:) /= met_max_rlxdt) ) then + k_top = max(plev - met_levels, 1) + + do while ( met_rlx(k_top) /= 999._r8 ) + k_top = k_top + 1 + if ( k_top == pver ) then + call endrun ( 'set_met_rlx: cannot find ramped region ') + endif + enddo + + met_rlx(1:k_top) = 0._r8 + + k_cnt = count( met_rlx == 999._r8 ) + + if (masterproc) then + write(iulog,fmt=996) 'k_cnt = ',k_cnt + write(iulog,fmt=996) 'k_top = ',k_top + endif + + do k = k_top,k_top+k_cnt + met_rlx(k) = met_max_rlxdt*real( k - k_top ) / real(k_cnt) + enddo + endif + + if (masterproc) then + write(iulog,fmt=996) ' met_levels = ',met_levels + write(iulog,fmt=996) 'non-zero terms:',count( met_rlx /= 0._r8 ) + endif + + if ( met_levels < count( met_rlx /= 0._r8 ) ) then + call endrun('set_met_rlx: met_rlx_top is too high for the meteorology data') + endif + + if (masterproc) then + write(iulog,fmt=998) 'press levels = ',hypm + write(iulog,fmt=999) ' met_rlx = ',met_rlx + endif + + if ( any( (met_rlx > 1._r8) .or. (met_rlx < 0._r8) ) ) then + if (masterproc) then + write(iulog,fmt=993) 'set_met_rlx: dtime_hrs in hrs = ', dtime_hrs + write(iulog,fmt=993) 'set_met_rlx:met_rlx_time in hrs = ', met_rlx_time + write(iulog,fmt=993) 'set_met_rlx: met_max_rlxdt = ', met_max_rlxdt + write(iulog,fmt=999) 'set_met_rlx: met_rlx = ', met_rlx + endif + call endrun('Offline meteorology relaxation function not set correctly.') + endif + + end subroutine set_met_rlx + +end module metdata diff --git a/src/dynamics/fv/p_d_adjust.F90 b/src/dynamics/fv/p_d_adjust.F90 new file mode 100644 index 0000000000..425e95ef26 --- /dev/null +++ b/src/dynamics/fv/p_d_adjust.F90 @@ -0,0 +1,350 @@ +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: p_d_adjust --- complete full physics update +! +! !INTERFACE: + subroutine p_d_adjust(grid, tracer, pelnxy, pkxy, pkzxy, zvir, & + cap3v, delpxy, ptxy, pexy, psxy, ptop) + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use dynamics_vars, only : T_FVDYCORE_GRID +#if defined( SPMD ) + use parutilitiesmodule, only: parcollective, sumop +#endif + use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, & + shr_reprosum_recompute + use cam_logfile, only : iulog + use perf_mod + +!----------------------------------------------------------------------- + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: zvir + real(r8), intent(in) :: ptop + real(r8), intent(in) :: cap3v( grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, grid%km) ! cappa + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: tracer(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) ! constituents + real(r8), intent(inout) :: delpxy(grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy,grid%km) ! pressure difference + real(r8), intent(inout) :: ptxy (grid%ifirstxy:grid%ilastxy, & + grid%jfirstxy:grid%jlastxy, grid%km) ! Virtual pot temp + real(r8), intent(inout) :: pexy(grid%ifirstxy:grid%ilastxy, & + grid%km+1,grid%jfirstxy:grid%jlastxy) + +! !OUTPUT PARAMETERS + real(r8), intent(out) :: psxy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy) ! surf. press + real(r8), intent(out) :: pelnxy(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! interface pres + real(r8), intent(out) :: pkzxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, grid%km) ! Layer-mean value of PK + real(r8), intent(out) :: pkxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, grid%km+1) ! PE**cappa + +! !DESCRIPTION: +! +! Complete adjustment of quantities after physics update +! +! !REVISION HISTORY: +! 00.06.01 Grant? Creation +! 01.06.08 AAM Created from p_d_coupling +! 02.04.24 WS New mod_comm interface +! 02.05.01 WS Fix of S.-J. and Phil to peln, pk update +! 03.03.31 BAB dry mass adjustment moved to dme_adjust, just finish up here +! 05.07.06 WS Use grid argument to get all grid-related data +! 05.09.23 WS Transitioned to XY variables only +! 06.07.01 WS Transitioned tracers q3 to T_TRACERS +! 08.06.25 PW Added call to fixed point reproducible sum +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + + real(r8) :: pole(grid%ifirstxy:grid%ilastxy,grid%km,grid%ntotq+2) + ! Array containing local pole values + real(r8) :: pole_sum(grid%km,grid%ntotq+2) ! Array containing average of all pole values + real(r8) :: rel_diff(2,grid%km,grid%ntotq+2) + + real(r8) :: & + cap3vi(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) + real(r8) :: & + pkln(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) + + real(r8),allocatable :: pole_tmp(:) + + integer :: i, k, m, j ! indices + integer :: im, jm, km, ntotq, lim + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + + logical :: write_warning + logical :: high_alt + +!---------------------------End Local workspace------------------------- + +! +! ---------------------------------------------------- +! Complete update of dynamics variables +! ---------------------------------------------------- +! + high_alt = grid%high_alt + im = grid%im + jm = grid%jm + km = grid%km + ntotq = grid%ntotq + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + lim = (ilastxy-ifirstxy) + 1 + + ! Average the pole values (WS 2006/02/16, bug fix) + + if (jfirstxy==1) then + + !$omp parallel do private(i,k,m) + do k = 1, km + do i = ifirstxy, ilastxy + pole(i,k,1) = delpxy(i,1,k) + pole(i,k,2) = ptxy(i,1,k) + enddo + do m = 1, ntotq + do i = ifirstxy, ilastxy + pole(i,k,m+2) = tracer(i,1,k,m) + enddo + enddo + enddo + + call t_startf("pdadj_reprosum") + call shr_reprosum_calc(pole, pole_sum, lim, lim, km*(ntotq+2), gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) ! South pole + call t_stopf("pdadj_reprosum") + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (grid%myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('p_d_adjust/South Pole', km*(ntotq+2), & + write_warning, iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call t_startf("pdadj_sumfix") + allocate( pole_tmp(im) ) + do m = 1, ntotq+2 + do k = 1, km + if (rel_diff(1,k,m) > shr_reprosum_reldiffmax) then + pole_tmp(:) = D0_0 + do i = ifirstxy, ilastxy + pole_tmp(i) = pole(i,k,m) + enddo +#if defined(SPMD) + call parcollective(grid%commxy_x,sumop,im,pole_tmp) +#endif + pole_sum(k,m) = D0_0 + do i = 1, im + pole_sum(k,m) = pole_sum(k,m) + pole_tmp(i) + enddo + endif + enddo + enddo + deallocate( pole_tmp ) + call t_stopf("pdadj_sumfix") + endif + endif + + ! save results + !$omp parallel do private(i,k,m) + do k = 1, km + ! normalize first + do m = 1, ntotq+2 + pole_sum(k,m) = pole_sum(k,m)/im + enddo + do i = ifirstxy,ilastxy + delpxy(i,1,k) = pole_sum(k,1) + ptxy(i,1,k) = pole_sum(k,2) + enddo + do m = 1, ntotq + do i = ifirstxy,ilastxy + tracer(i,1,k,m) = pole_sum(k,m+2) + enddo + enddo + enddo + + endif ! jfirstxy==1 + + if (jlastxy==jm) then + + !$omp parallel do private(i,k,m) + do k = 1, km + do i = ifirstxy, ilastxy + pole(i,k,1) = delpxy(i,jm,k) + pole(i,k,2) = ptxy(i,jm,k) + enddo + do m = 1, ntotq + do i = ifirstxy, ilastxy + pole(i,k,m+2) = tracer(i,jm,k,m) + enddo + enddo + enddo + + call t_startf("pdadj_reprosum") + call shr_reprosum_calc(pole, pole_sum, lim, lim, km*(ntotq+2), gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) ! North pole + call t_stopf("pdadj_reprosum") + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (grid%myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('p_d_adjust/Nouth Pole', km*(ntotq+2), & + write_warning, iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call t_startf("pdadj_sumfix") + allocate( pole_tmp(im) ) + do m = 1, ntotq+2 + do k = 1, km + if (rel_diff(1,k,m) > shr_reprosum_reldiffmax) then + pole_tmp(:) = D0_0 + do i = ifirstxy, ilastxy + pole_tmp(i) = pole(i,k,m) + enddo +#if defined(SPMD) + call parcollective(grid%commxy_x,sumop,im,pole_tmp) +#endif + pole_sum(k,m) = D0_0 + do i = 1, im + pole_sum(k,m) = pole_sum(k,m) + pole_tmp(i) + enddo + endif + enddo + enddo + deallocate( pole_tmp ) + call t_stopf("pdadj_sumfix") + endif + endif + + ! save results + !$omp parallel do private(i,k,m) + do k = 1, km + ! normalize first + do m = 1, ntotq+2 + pole_sum(k,m) = pole_sum(k,m)/im + enddo + do i = ifirstxy,ilastxy + delpxy(i,jm,k) = pole_sum(k,1) + ptxy(i,jm,k) = pole_sum(k,2) + enddo + do m = 1, ntotq + do i = ifirstxy,ilastxy + tracer(i,jm,k,m) = pole_sum(k,m+2) + enddo + enddo + enddo + + endif ! jlastxy==jm + + ! + ! Fix pe,ps if nontrivial z decomposition + ! Transpose pe - change to better method (16-byte?) later on + ! + + ! + ! Compute pexy + ! + !$omp parallel do private(i, j) + do j = jfirstxy,jlastxy + do i = ifirstxy, ilastxy + pexy(i,1,j) = ptop + enddo + enddo + + !$omp parallel do private(i, j, k) + do j = jfirstxy,jlastxy + do k = 1, km + do i = ifirstxy, ilastxy + pexy(i,k+1,j) = pexy(i,k,j) + delpxy(i,j,k) + enddo + enddo + enddo + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + psxy(i,j) = pexy(i,km+1,j) + enddo + enddo + + if (high_alt) then + !$omp parallel do private(i,j,k) + do k=2,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1) + else + cap3vi(:,:,:) = cap3v(grid%ifirstxy,grid%jfirstxy,1) + endif + + ! + ! Update pelnxy and pkxy + ! + !$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do k = 1, km+1 + do i = ifirstxy, ilastxy + pelnxy(i,k,j) = log( pexy(i,k,j) ) + pkxy (i,j,k) = pexy(i,k,j) ** cap3vi(i,j,k) + pkln(i,k,j) = log(pkxy(i,j,k)) + enddo + enddo + enddo ! jfirstxy:jlastxy loop + ! + ! Update pkzxy + ! + if (high_alt) then + !$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do k = 1,km + do i = ifirstxy,ilastxy + pkzxy(i,j,k) = (pkxy(i,j,k+1)-pkxy(i,j,k))/(pkln(i,k+1,j)-pkln(i,k,j)) + enddo + enddo + enddo + else + !$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do k = 1,km + do i = ifirstxy,ilastxy + pkzxy(i,j,k) = (pkxy(i,j,k+1)-pkxy(i,j,k))/(cap3v(i,j,k)*(pelnxy(i,k+1,j)-pelnxy(i,k,j))) + enddo + enddo + enddo + endif + + ! + ! Calculate virtual potential temperature + ! + + !$omp parallel do private(i, j, k) + do j=jfirstxy,jlastxy + do k = 1,km + do i = ifirstxy,ilastxy + ptxy(i,j,k) = ptxy(i,j,k)* & + (D1_0+zvir*tracer(i,j,k,1)) & + /pkzxy(i,j,k) + enddo + enddo + enddo ! jfirstxy:jlastxy loop + + !EOC + end subroutine p_d_adjust +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/par_vecsum.F90 b/src/dynamics/fv/par_vecsum.F90 new file mode 100644 index 0000000000..38318d5e2c --- /dev/null +++ b/src/dynamics/fv/par_vecsum.F90 @@ -0,0 +1,110 @@ +module par_vecsum_mod + +implicit none +private +save +public :: par_vecsum + +contains +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: par_vecsum --- Calculate vector sum bit-wise consistently +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine par_vecsum(jm, jfirst, jlast, InVector, te0, & + incomm, npryuse, return_sum_in) +!****6***0*********0*********0*********0*********0*********0**********72 +! +! !USES: +#if defined ( SPMD ) + use parutilitiesmodule, only : parexchangevector +#endif + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + +! !INPUT PARAMETERS: + integer jm ! global latitudes + integer jfirst ! first latitude on this PE + integer jlast ! last latitude on this PE + real (r8) InVector(jm) ! input vector to be summed + integer incomm ! communicator + integer npryuse ! number of subdomains + + logical, optional :: return_sum_in + +! !OUTPUT PARAMETERS: + real (r8) te0 ! sum of all vector entries + +! !DESCRIPTION: +! This subroutine calculates the sum of InVector in a reproducible +! (sequentialized) fashion which should give bit-wise identical +! results irrespective of the number of MPI processes. +! +! !CALLED FROM: +! te_map and benergy +! +! !REVISION HISTORY: +! +! BWS 00.01.15 : Created +! WS 00.06.02 : Replaced MPI calls with ParExchangeVector; docu. +! WS 00.08.29 : SPMD instead of MPI_ON +! AM 01.06.15 : general communicator +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! !Local + real(r8), parameter :: D0_0 = 0.0_r8 + real (r8) tte_all(jm) + integer j + logical :: return_sum + +#if defined ( SPMD ) + real (r8) tte_send(npryuse*(jlast-jfirst+1)) + integer sendcount(npryuse) + integer recvcount(npryuse) + integer ipe, icount +#endif + if (present(return_sum_in)) then + return_sum = return_sum_in + else + return_sum = .false. + end if + + te0 = D0_0 +#if defined ( SPMD ) + icount=0 + do ipe=1,npryuse + sendcount(ipe) = jlast-jfirst+1 + do j=jfirst, jlast + icount=icount+1 + tte_send(icount)=InVector(j) + enddo + enddo + call parexchangevector( incomm, sendcount, tte_send, & + recvcount, tte_all ) +#else + do j=1, jm + tte_all(j)=InVector(j) + enddo +#endif + + te0 = D0_0 + te0 = te0 + tte_all(1) !in oder to compare to SMP-only + te0 = te0 + tte_all(jm) !in oder to compare to SMP-only + + do j=2,jm-1 + te0 = te0 + tte_all(j) + enddo + + if (return_sum) InVector(1:jm) = tte_all(1:jm) + + return +!EOC + end +!----------------------------------------------------------------------- + +end module par_vecsum_mod diff --git a/src/dynamics/fv/par_xsum.F90 b/src/dynamics/fv/par_xsum.F90 new file mode 100644 index 0000000000..9f2520a90f --- /dev/null +++ b/src/dynamics/fv/par_xsum.F90 @@ -0,0 +1,238 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: par_xsum --- Calculate x-sum bit-wise consistently +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine par_xsum(grid, a, ltot, sum) +!****6***0*********0*********0*********0*********0*********0**********72 +! +! !USES: +#if defined ( SPMD ) + use parutilitiesmodule, only : parexchangevector +#endif + use dynamics_vars, only : T_FVDYCORE_GRID + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, & + shr_reprosum_recompute + use cam_logfile, only : iulog + use FVperf_module, only : FVstartclock, FVstopclock + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in) :: ltot ! number of quantities to be summed + ! input vector to be summed + real (r8), intent(in) :: a(grid%ifirstxy:grid%ilastxy,ltot) + +! !OUTPUT PARAMETERS: + real (r8) sum(ltot) ! sum of all vector entries + +! !DESCRIPTION: +! This subroutine calculates the sum of "a" in a reproducible +! (sequentialized) fashion which should give bit-wise identical +! results irrespective of the number of MPI processes. +! +! !CALLED FROM: +! te_map +! +! !REVISION HISTORY: +! +! AAM 00.11.01 : Created +! WS 03.10.22 : pmgrid removed (now spmd_dyn) +! WS 04.10.04 : added grid as an argument; removed spmd_dyn +! WS 05.05.25 : removed ifirst, ilast, im as arguments (in grid) +! PW 08.06.25 : added fixed point reproducible sum +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! !Local + real(r8), parameter :: D0_0 = 0.0_r8 + + real(r8) :: rel_diff(2,ltot) + real(r8),allocatable :: l_a(:) + real(r8),allocatable :: a_tmp(:) + + integer :: i,ipe,l,im,lim,nprxy_x,offset + integer :: sendcount(grid%nprxy_x) + integer :: recvcount(grid%nprxy_x) + + logical :: write_warning + + im = grid%im + lim = (grid%ilastxy-grid%ifirstxy) + 1 + nprxy_x = grid%nprxy_x + offset = grid%ifirstxy - 1 + + call FVstartclock(grid,'xsum_reprosum') + call shr_reprosum_calc(a, sum, lim, lim, ltot, gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) + call FVstopclock(grid,'xsum_reprosum') + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (grid%myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('par_xsum', ltot, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call FVstartclock(grid,'xsum_sumfix') + allocate( l_a(lim*nprxy_x) ) + allocate( a_tmp(im) ) + sendcount(:) = lim + + do l=1,ltot + if (rel_diff(1,l) > shr_reprosum_reldiffmax) then + sum(l) = D0_0 +#if defined ( SPMD ) + do ipe=1,nprxy_x + do i=1,lim + l_a(i+(ipe-1)*lim) = a(i+offset,l) + enddo + enddo + call parexchangevector( grid%commxy_x, sendcount, l_a, & + recvcount, a_tmp ) + do i=1,im + sum(l) = sum(l) + a_tmp(i) + enddo +#else + do i=1,im + sum(l) = sum(l) + a(i,l) + enddo +#endif + endif + + enddo + + deallocate( a_tmp ) + deallocate( l_a ) + call FVstopclock(grid,'xsum_sumfix') + endif + endif + + return +!EOC + end subroutine par_xsum +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: par_xsum_r4 --- Calculate x-sum bit-wise consistently (real4) +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine par_xsum_r4(grid, a, ltot, sum) +!****6***0*********0*********0*********0*********0*********0**********72 +! +! !USES: +#if defined ( SPMD ) + use parutilitiesmodule, only : parexchangevector +#endif + use dynamics_vars, only : T_FVDYCORE_GRID + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, & + shr_reprosum_recompute + use cam_logfile, only : iulog + use FVperf_module, only : FVstartclock, FVstopclock + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in) :: ltot ! number of quantities to be summed + real (r4) a(grid%ifirstxy:grid%ilastxy,ltot) ! input vector to be summed + +! !OUTPUT PARAMETERS: + real (r8) sum(ltot) ! sum of all vector entries + +! !DESCRIPTION: +! This subroutine calculates the sum of "a" in a reproducible +! (sequentialized) fashion which should give bit-wise identical +! results irrespective of the number of MPI processes. +! +! !REVISION HISTORY: +! +! WS 05.04.08 : Created from par_xsum +! WS 05.05.25 : removed ifirst, ilast, im as arguments (in grid) +! WS 06.06.28 : Fixed bug in sequential version +! PW 08.06.25 : added fixed point reproducible sum +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! !Local + real(r8), parameter :: D0_0 = 0.0_r8 + + real(r8) :: a8(grid%ifirstxy:grid%ilastxy,ltot) + real(r8) :: rel_diff(2,ltot) + real(r4),allocatable :: l_a(:) + real(r4),allocatable :: a_tmp(:) + + integer i,ipe,l,im,lim,nprxy_x,offset + integer sendcount(grid%nprxy_x) + integer recvcount(grid%nprxy_x) + + logical :: write_warning + + im = grid%im + lim = (grid%ilastxy-grid%ifirstxy) + 1 + nprxy_x = grid%nprxy_x + offset = grid%ifirstxy - 1 + + call FVstartclock(grid,'xsum_r4_reprosum') + a8(:,:) = a(:,:) + call shr_reprosum_calc(a8, sum, lim, lim, ltot, gbl_count=im, & + commid=grid%commxy_x, rel_diff=rel_diff) + call FVstopclock(grid,'xsum_r4_reprosum') + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = .false. + if (grid%myidxy_x == 0) write_warning = .true. + if ( shr_reprosum_tolExceeded('par_xsum_r4', ltot, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + call FVstartclock(grid,'xsum_r4_sumfix') + allocate( l_a(lim*nprxy_x) ) + allocate( a_tmp(im) ) + sendcount(:) = lim + + do l=1,ltot + if (rel_diff(1,l) > shr_reprosum_reldiffmax) then + sum(l) = D0_0 +#if defined ( SPMD ) + do ipe=1,nprxy_x + do i=1,lim + l_a(i+(ipe-1)*lim) = a(i+offset,l) + enddo + enddo + call parexchangevector( grid%commxy_x, sendcount, l_a, & + recvcount, a_tmp ) + do i=1,im + sum(l) = sum(l) + a_tmp(i) + enddo +#else + do i=1,im + sum(l) = sum(l) + a(i,l) + enddo +#endif + endif + + enddo + + deallocate( a_tmp ) + deallocate( l_a ) + call FVstopclock(grid,'xsum_r4_sumfix') + endif + endif + + return +!EOC + end subroutine par_xsum_r4 +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/pfixer.F90 b/src/dynamics/fv/pfixer.F90 new file mode 100644 index 0000000000..b6652860b6 --- /dev/null +++ b/src/dynamics/fv/pfixer.F90 @@ -0,0 +1,577 @@ + +module pfixer + +!----------------------------------------------------------------------- +! +! BOP +! +! !MODULE: pfixer +! +! !DESCRIPTION +! Corrects (or fixes) mass fluxes and edge pressures to be consistent +! with offline surface pressure at next model time step. +! +! !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use dynamics_vars, only: T_FVDYCORE_GRID + use cam_logfile, only: iulog + use metdata, only: met_rlx + +! !PUBLIC MEMBER FUNCTIONS + public :: adjust_press + +! !REVISION HISTORY: +! 04.01.30 Stacy Walters Creation +! 04.02.15 F Vitt Fixed bug in edge pressure corrections +! 04.08.27 F Vitt Added ability to handle 2D decomposition +! 05.07.06 Sawyer Simplified interfaces with grid +! +! EOP +!----------------------------------------------------------------------- + + private + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D100_0 = 100.0_r8 +contains + +!----------------------------------------------------------------------- +! ... adjust mass fluxes and pressures for lin-rood transport +!----------------------------------------------------------------------- + + subroutine adjust_press( grid, ps_mod, ps_obs, mfx, mfy, pexy ) + +#if defined( SPMD ) + use mod_comm, only : mp_send3d, mp_recv3d, & + mp_sendirr, mp_recvirr + use parutilitiesmodule, only: parcollective, SUMOP +#endif + use time_manager, only : get_nstep +!!$ use history, only: outfld + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: ps_obs(grid%im,grid%jfirst:grid%jlast) ! surface pressure at t(n) (Pa) + real(r8), intent(in) :: ps_mod(grid%im,grid%jfirst:grid%jlast) ! surface pressure at t(n) (Pa) + real(r8), intent(inout) :: mfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! zonal mass flux + real(r8), intent(inout) :: mfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! meridional mass flux + real(r8), intent(inout) :: pexy(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer, parameter :: nstep0 = -1 + + integer :: i, j, k, km1 + integer :: nstep +#if defined( SPMD ) + integer :: dest, src +#endif + integer :: ndx(2) + real(r8) :: dpi(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8) :: dpixy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) :: dpi_in(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8) :: dpi_inxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,1:grid%km) + real(r8) :: dpi_c(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8) :: dps (grid%im,grid%jfirst:grid%jlast) + real(r8) :: dps_in(grid%im,grid%jfirst:grid%jlast) + real(r8) :: dps_inxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real(r8) :: ps_diffxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + + real(r8) :: dmfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! original zonnal mass flux + real(r8) :: dmfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! original meridional mass flux + real(r8) :: emfx(grid%im,grid%jfirst:grid%jlast) ! zonal mass flux error + real(r8) :: emfy(grid%im,grid%jfirst:grid%jlast+1) ! meridional mass flux error + + real(r8) :: tmp2d(grid%im,grid%kfirst:grid%klast) + logical :: debug = .false. + logical :: method1 = .true. + + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: jfirst, jlast, kfirst, klast + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + +#if defined( SPMD ) + ! Send one latitude of mfy to the south + if( mod(grid%iam,grid%npr_y) /= 0 ) then + dest = grid%iam-1 + else + dest = -1 + end if + if( mod(grid%iam+1,grid%npr_y) /= 0 ) then + src = grid%iam+1 + else + src = -1 + end if + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jfirst, jfirst, kfirst, klast, mfy) +#endif + + do j = jfirst,jlast + dps(:,j) = ps_obs(:,j) - ps_mod(:,j) + end do + + ! ghost mfy +#if defined( SPMD ) + call mp_recv3d( grid%commxy, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jlast+1, jlast+1, kfirst, klast, mfy) +#endif + + nstep = get_nstep() +!----------------------------------------------------------------------- +! ... store incoming mass fluxes +!----------------------------------------------------------------------- + if (debug) then + do k = kfirst,klast + do j = jfirst,jlast + dmfx(:,j,k) = mfx(:,j,k) + dmfy(:,j,k) = mfy(:,j,k) + end do + if( jlast /= jm ) then + dmfy(:,jlast+1,k) = mfy(:,jlast+1,k) + end if + end do + endif + +!----------------------------------------------------------------------- +! ... incoming mass flux divergence +!----------------------------------------------------------------------- + call calc_divergence( grid, mfx, mfy, dpi_in ) + +!----------------------------------------------------------------------- +! ... surface pressure from mass flux divergence +!----------------------------------------------------------------------- +! Two different methods to compute change in ps give differnt +! results if 2D decomp is used (round off error). Method 1 gives +! identical 1D vs 2D decomposition results. +!----------------------------------------------------------------------- + if (method1) then + + ! xfer dpi_in to dpi_inxy + if (grid%twod_decomp .eq. 1) then +#if defined (SPMD) + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, dpi_in, dpi_inxy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, dpi_in, dpi_inxy, & + modc=grid%modc_dynrun ) +#endif + else + dpi_inxy(:,:,:) = dpi_in(:,:,:) + endif + + ! vertical sum + do j = jfirstxy,jlastxy + do i = ifirstxy,ilastxy + dps_inxy(i,j) = sum( dpi_inxy(i,j,1:km) ) + end do + end do + + ! xfer dps_inxy to dps_in + ! Embed in 3D array since transpose machinery cannot handle 2D arrays + if (grid%twod_decomp .eq. 1) then +#if defined (SPMD) + do k = 1,km + do j = jfirstxy,jlastxy + do i = ifirstxy,ilastxy + dpixy(i,j,k) = dps_inxy(i,j) + enddo + enddo + enddo + + call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, dpixy, dpi, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & + grid%ijk_xy_to_yz%RecvDesc, dpixy, dpi, & + modc=grid%modc_dynrun ) + + do j = jfirst,jlast + do i = 1,im + dps_in(i,j) = dpi(i,j,kfirst) + enddo + enddo +#endif + else + dps_in(:,:) = dps_inxy(:,:) + endif + + else ! method1 + + ! this method does not give identical results as the above method + ! when two dimensional decomposition is used + + do j = jfirst,jlast + do i = 1,im + dps_in(i,j) = sum( dpi_in(i,j,kfirst:klast) ) + end do + end do + +#if ( defined SPMD ) + if (grid%twod_decomp .eq. 1) then + call parcollective( grid%comm_z, SUMOP, im, jlast-jfirst+1, dps_in ) + endif +#endif + + endif ! method1 + +!----------------------------------------------------------------------- +! ... modify (fix) mass fluxes +!----------------------------------------------------------------------- + call do_press_fix_llnl( grid, dps, dps_in, mfx, mfy ) + +!----------------------------------------------------------------------- +! ... modified mass flux divergence +!----------------------------------------------------------------------- + call calc_divergence( grid, mfx, mfy, dpi_c ) + +!----------------------------------------------------------------------- +! ... differential mass flux divergence +!----------------------------------------------------------------------- + do k = kfirst,klast + do j = jfirst,jlast + dpi(:,j,k) = dpi_c(:,j,k) - dpi_in(:,j,k) + end do + end do + + if (grid%twod_decomp .eq. 1) then +#if defined (SPMD) + call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, dpi, dpixy, & + modc=grid%modc_dynrun ) + call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & + grid%ijk_yz_to_xy%RecvDesc, dpi, dpixy, & + modc=grid%modc_dynrun ) +#endif + else + dpixy(:,:,:) = dpi(:,:,:) + endif + + +!----------------------------------------------------------------------- +! ... modify pe +!----------------------------------------------------------------------- + + if (debug) then + write(iulog,*) ' ' + write(iulog,*) 'adjust_press: max pe diff % @ nstep,ifirstxy,ilastxy,jfirstxy,jlastxy = ',& + nstep,ifirstxy,ilastxy,jfirstxy,jlastxy + endif + + do k = 1+1,km+1 + km1 = k - 1 + + if (debug) then + do j = jfirstxy,jlastxy + do i = ifirstxy,ilastxy + ps_diffxy(i,j) = sum( dpixy(i,j,1:km1) )/ pexy(i,k,j ) + end do + end do + endif + + if( nstep > nstep0 ) then + do j = jfirstxy,jlastxy + do i = ifirstxy,ilastxy + pexy(i,k,j) = pexy(i,k,j) + sum( dpixy(i,j,1:km1) ) + end do + end do + end if + if (debug) then + + ndx(:) = maxloc( abs( ps_diffxy(:,:) ) ) + + ndx(1) = ndx(1) + ifirstxy - 1 + ndx(2) = ndx(2) + jfirstxy - 1 + + write(iulog,'("pfixer press change error (% error,press adjmnt,new pe)",1x,3i5,1p,3g15.7)') & + k,ndx(:),D100_0*abs( ps_diffxy(ndx(1),ndx(2)) ), & + dpixy(ndx(1),ndx(2),km1),pexy(ndx(1),k,ndx(2)) + + endif + end do + + if (debug) then + write(iulog,*) ' ' + write(iulog,*) 'adjust_press: max mass flux error @ nstep,jfirst,jlast,kfirst,klast = ',& + nstep,jfirst,jlast,kfirst,klast + + do k = kfirst,klast + + do j=jfirst,jlast + do i=1,im + emfx(i,j) = ( mfx(i,j,k)-dmfx(i,j,k) ) + enddo + enddo + + ndx(:) = maxloc( abs( emfx(:,:) ) ) + ndx(2) = ndx(2) + jfirst - 1 + + write(iulog,'("pfixer max x flux error (diff,fixed,orig) ",1x,3i5,1p,3g15.7)') & + k,ndx(:), emfx( ndx(1),ndx(2) ) , & + mfx(ndx(1),ndx(2),k), dmfx(ndx(1),ndx(2),k) + + do j=jfirst,jlast+1 + do i=1,im + emfy(i,j) = ( mfy(i,j,k)-dmfy(i,j,k) ) + enddo + enddo + + ndx(:) = maxloc( abs( emfy(:,:) ) ) + ndx(2) = ndx(2) + jfirst - 1 + + write(iulog,'("pfixer max y flux error (diff,fixed,orig) ",1x,3i5,1p,3g15.7)') & + k,ndx(:), emfy( ndx(1),ndx(2) ) , & + mfy(ndx(1),ndx(2),k), dmfy(ndx(1),ndx(2),k) + + enddo + endif + + end subroutine adjust_press + +!----------------------------------------------------------------------- +! ... calculate horizontal mass flux divergence +!----------------------------------------------------------------------- + subroutine calc_divergence( grid, mfx, mfy, dpi ) + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type (T_FVDYCORE_GRID), intent(in) :: grid + real(r8), intent(in) :: mfx(grid%im,grid%jfirst:grid%jlast, & + grid%kfirst:grid%klast) ! zonal mass flux + real(r8), intent(in) :: mfy(grid%im,grid%jfirst:grid%jlast+1, & + grid%kfirst:grid%klast) ! meridional mass flux + real(r8), intent(inout) :: dpi(grid%im,grid%jfirst:grid%jlast, & + grid%kfirst:grid%klast) ! horizontal mass flux divergence + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: i, j, k, js2g0, jn2g0 + real(r8) :: sum1 + integer :: im, jm, km, jfirst, jlast, kfirst, klast + + im = grid%im + jm = grid%jm + km = grid%km + jfirst= grid%jfirst + jlast = grid%jlast + kfirst= grid%kfirst + klast = grid%klast + + js2g0 = max( 2,jfirst ) + jn2g0 = min( jm-1,jlast ) + +!$omp parallel do private( j, k, sum1 ) + do k = kfirst,klast +!----------------------------------------------------------------------- +! ... north-south component +!----------------------------------------------------------------------- + do j = js2g0,jn2g0 + dpi(:,j,k) = (mfy(:,j,k) - mfy(:,j+1,k)) * grid%acosp(j) + end do +!----------------------------------------------------------------------- +! ... east-west component +!----------------------------------------------------------------------- + do j = js2g0,jn2g0 + dpi(:im-1,j,k) = dpi(:im-1,j,k) + mfx(:im-1,j,k) - mfx(2:im,j,k) + dpi(im,j,k) = dpi(im,j,k) + mfx(im,j,k) - mfx(1,j,k) + end do +!----------------------------------------------------------------------- +! ... poles +!----------------------------------------------------------------------- + if( jfirst == 1 ) then + sum1 = -sum( mfy(:,2,k) )*grid%rcap + dpi(:,1,k) = sum1 + end if + if( jlast == jm ) then + sum1 = sum( mfy(:,jm,k) ) * grid%rcap + dpi(:,jm,k) = sum1 + end if + end do +!$omp end parallel do + + end subroutine calc_divergence + +!----------------------------------------------------------------------- +! ... fix the mass fluxes to match the met field pressure tendency +! See: http://asd.llnl.gov/pfix/index.html +!----------------------------------------------------------------------- + subroutine do_press_fix_llnl( grid, dps, dps_ctm, mfx, mfy ) + + use commap, only : gw => w +#ifdef SPMD + use mpishorthand, only : mpicom, mpi_double_precision, mpi_success + use spmd_dyn, only : compute_gsfactors +#endif + use spmd_utils, only : npes + use hycoef, only : hybd + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + type (T_FVDYCORE_GRID), intent(in) :: grid +! surface pressure change from met fields + real(r8), intent(in) :: dps(grid%im,grid%jfirst:grid%jlast) +! vert. sum of dpi from original mass fluxes + real(r8), intent(in) :: dps_ctm(grid%im,grid%jfirst:grid%jlast) +! zonal mass flux + real(r8), intent(inout) :: mfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) +! meridional mass flux + real(r8), intent(inout) :: mfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: i, j, jglob, k, astat, ierr + integer :: jn2g0, js2g0, jn2g1 + integer :: cnt +#ifdef SPMD + integer :: numrecv(0:npes-1) + integer :: displs(0:npes-1) +#endif + real(r8) :: dpress_g ! global pressure error + real(r8) :: fxmean, factor + real(r8) :: ddps(grid%im,grid%jfirst:grid%jlast) ! surface pressure change error + real(r8) :: dpresslat(grid%jm) + real(r8) :: mmfd(grid%jm) + real(r8) :: mmf(grid%jm+1) + real(r8) :: fxintegral(grid%im+1) + real(r8) :: xcolmass_fix(grid%im,grid%jfirst:grid%jlast) + real(r8) :: temp(grid%jfirst:grid%jlast) + + integer :: im, jm, km, jfirst, jlast, kfirst, klast + + im = grid%im + jm = grid%jm + km = grid%km + jfirst= grid%jfirst + jlast = grid%jlast + kfirst= grid%kfirst + klast = grid%klast + + js2g0 = max( 2,jfirst ) + jn2g0 = min( jm-1,jlast ) + jn2g1 = min( jm-1,jlast+1 ) + + do j = jfirst,jlast + ddps(:,j) = dps(:,j) - dps_ctm(:,j) + end do + factor = D0_5/im + do j = jfirst,jlast + dpresslat(j) = sum( ddps(:,j) ) * gw(j) * factor + end do + +#ifdef SPMD + call compute_gsfactors( 1, cnt, numrecv, displs ) + temp(jfirst:jlast) = dpresslat(jfirst:jlast) + call mpi_allgatherv( temp(jfirst:jlast), cnt, mpi_double_precision, & + dpresslat, numrecv, displs, mpi_double_precision, mpicom, ierr ) + if( ierr /= mpi_success ) then + write(iulog,*) 'do_press_fix_llnl: mpi_allgatherv failed; error code = ',ierr + call endrun + end if +#endif + + dpress_g = sum( dpresslat(:) ) + if( grid%iam == 0 ) then + write(iulog,*) 'do_press_fix_llnl: dpress_g = ',dpress_g + end if + +!----------------------------------------------------------------------- +! calculate mean meridional flux divergence (df/dy). +! note that mmfd is actually the zonal mean pressure change, +! which is related to df/dy by geometrical factors. +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... handle non-pole regions. +!----------------------------------------------------------------------- + factor = D1_0/im + do j = jfirst,jlast + mmfd(j) = dpress_g - sum( ddps(:,j) ) * factor + end do + +#ifdef SPMD + cnt = jlast - jfirst + 1 + temp(jfirst:jlast) = mmfd(jfirst:jlast) + call mpi_allgatherv( temp(jfirst:jlast), cnt, mpi_double_precision, & + mmfd, numrecv, displs, mpi_double_precision, mpicom, ierr ) + if( ierr /= mpi_success ) then + write(iulog,*) 'do_press_fix_llnl: mpi_allgatherv failed; error code = ',ierr + call endrun + end if +#endif + +!----------------------------------------------------------------------- +! calculate mean meridional fluxes (cosp*fy). +! nb: this calculation is being done for global lats, i.e., (1,jm) +!----------------------------------------------------------------------- + mmf(2) = mmfd(1) / (grid%rcap*im) + do j = 2,jm-1 + mmf(j+1) = mmf(j) + mmfd(j) * grid%cosp(j) + end do + +!----------------------------------------------------------------------- +! fix latitude bands. +! note that we do not need to worry about geometry here because +! all boxes in a latitude band are identical. +! note also that fxintegral(im+1) should equal fxintegral(1), +! i.e., zero. +!----------------------------------------------------------------------- +!$omp parallel do private( i, j, k, fxmean, fxintegral ) + do j = js2g0,jn2g0 + fxintegral(1) = D0_0 + do i = 1,im + fxintegral(i+1) = fxintegral(i) - (ddps(i,j) - dpress_g) - mmfd(j) + end do + fxintegral(1) = fxintegral(im+1) + fxmean = sum( fxintegral(:im) ) * factor + xcolmass_fix(:im,j) = fxintegral(:im) - fxmean + end do +!$omp end parallel do + +!----------------------------------------------------------------------- +! ... distribute colmass_fix in vertical +!----------------------------------------------------------------------- +!$omp parallel do private( j, k ) + do k = kfirst,klast + do j = js2g0,jn2g0 + mfx(:,j,k) = mfx(:,j,k) + met_rlx(k) * xcolmass_fix(:,j) * hybd(k) + end do + do j = js2g0,jn2g1 + mfy(:,j,k) = mfy(:,j,k) + met_rlx(k) * mmf(j) * hybd(k) + end do + if( jlast == jm ) then + mfy(:,jm,k) = mfy(:,jm,k) + met_rlx(k) * mmf(jm) * hybd(k) + end if + end do +!$omp end parallel do + + end subroutine do_press_fix_llnl + +end module pfixer diff --git a/src/dynamics/fv/pft_module.F90 b/src/dynamics/fv/pft_module.F90 new file mode 100644 index 0000000000..ec4071121d --- /dev/null +++ b/src/dynamics/fv/pft_module.F90 @@ -0,0 +1,432 @@ +module pft_module + +! This module provides fast-Fourier transforms +! +! REVISION HISTORY: +! 01.01.30 Lin Integrated into this module +! 05.05.25 Sawyer Merged CAM and GEOS5 versions (CAM vectorization) +! 05.07.26 Worley Revised module using for Cray X1 version + + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +private +save + +#ifdef NO_R16 +integer, parameter :: r16= selected_real_kind(12) ! 8 byte real +#else +integer, parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + +public :: pft2d, pft_cf, fftfax, pftinit, fftrans + +real(r8), parameter :: D0_0 = 0.0_r8 +real(r8), parameter :: D1EM20 = 1.0e-20_r8 +real(r8), parameter :: D0_5 = 0.5_r8 +real(r8), parameter :: D1_0 = 1.0_r8 +real(r8), parameter :: D1_01 = 1.01_r8 +real(r8), parameter :: D2_0 = 2.0_r8 +real(r8), parameter :: D4_0 = 4.0_r8 +real(r8), parameter :: D8_0 = 8.0_r8 +real(r8), parameter :: D180_0 =180.0_r8 + +integer :: ifax(13) !ECMWF fft +real(r8), allocatable :: trigs(:) ! reentrant code?? + +integer :: fft_flt ! 0 => FFT/algebraic filter; 1 => FFT filter + +!========================================================================================= +CONTAINS +!========================================================================================= + +subroutine pftinit(im, fft_flt_in) + + ! Two-dimensional FFT initialization + + ! arguments + integer, intent(in) :: im ! Total X dimension + integer, intent(in) :: fft_flt_in + + ! local variables + integer :: icffta + real(r8) :: rcffta + !---------------------------------------------------------------------------- + + fft_flt = fft_flt_in + +#if defined( LIBSCI_FFT ) + allocate( trigs(2*im+100) ) + icffta = 0 + rcffta = D0_0 + call dzfftm(0, im, icffta, rcffta, rcffta, icffta, & + rcffta, icffta, trigs, rcffta, icffta) +#else + allocate( trigs(3*im/2+1) ) + call fftfax(im, ifax, trigs) +#endif + +end subroutine pftinit + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: pft2d --- Two-dimensional fast Fourier transform +! +! !INTERFACE: + subroutine pft2d(p, s, damp, im, jp, q1, q2) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im ! Total X dimension + integer jp ! Total Y dimension + real(r8) s(jp) ! 3-point algebraic filter + real(r8) damp(im,jp) ! FFT damping coefficients + +! !INPUT/OUTPUT PARAMETERS: + real(r8) q1( im+2, *) ! Work array + real(r8) q2(*) ! Work array + real(r8) p(im,jp) ! Array to be polar filtered + +! !DESCRIPTION: +! +! Perform a two-dimensional fast Fourier transformation. +! +! !REVISION HISTORY: +! 01.01.30 Lin Put into this module +! 01.03.26 Sawyer Added ProTeX documentation +! 02.04.05 Sawyer Integrated newest FVGCM version +! 05.05.17 Sawyer Merged CAM and GEOS-5 +! 05.07.26 Worley Removed ifax, trigs from arg list +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real(r8) rsc, bt + integer i, j, n, nj + +!Local Auto arrays: + real(r8) ptmp(0:im+1) +!!! real(r8) q1( im+2, jp) +!!! real(r8) q2( (im+1)*jp ) + integer jf(jp) + + nj = 0 + + do 200 j=1,jp + + if(s(j) > D1_01 ) then + if(fft_flt .eq. 0 .and. s(j) <= D4_0) then + + rsc = D1_0/s(j) + bt = D0_5*(s(j)-D1_0) + + do i=1,im + ptmp(i) = p(i,j) + enddo + ptmp( 0) = p(im,j) + ptmp(im+1) = p(1 ,j) + + do i=1,im + p(i,j) = rsc * ( ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1)) ) + enddo + + else + +! Packing for FFT + nj = nj + 1 + jf(nj) = j + + do i=1,im + q1(i,nj) = p(i,j) + enddo + q1(im+1,nj) = D0_0 + q1(im+2,nj) = D0_0 + + endif + endif +200 continue + + if( nj == 0) return + + call fftrans(damp, im, jp, nj, jf, q1, q2) + + do n=1,nj + do i=1,im + p(i,jf(n)) = q1(i,n) + enddo + enddo + + return +!EOC + end subroutine pft2d +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fftrans --- Two-dimensional fast Fourier transform +! +! !INTERFACE: + subroutine fftrans(damp, im, jp, nj, jf, q1, q2) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im ! Total X dimension + integer jp ! Total Y dimension + integer nj ! Number of transforms + integer jf(jp) ! J index versus transform number + real(r8) damp(im,jp) ! FFT damping coefficients + +! !INPUT/OUTPUT PARAMETERS: + real(r8) q1( im+2, *) ! Work array + real(r8) q2(*) ! Work array + +! !DESCRIPTION: +! +! Perform a two-dimensional fast Fourier transformation. +! +! !REVISION HISTORY: +! 05.05.15 Mirin Initial combined version +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, n + real (r8) ooim + +!Local Auto arrays: + +#if defined( LIBSCI_FFT ) + real (r8) qwk(2*im+4, jp) + complex(r8) cqf(im/2+1, jp) + integer imo2p +#elif defined( SGI_FFT ) + integer*4 im_4, nj_4, imp2_4 +#endif + +#if defined( LIBSCI_FFT ) + imo2p = im/2 + 1 + ooim = D1_0/real(im,r8) + + call dzfftm(-1, im, nj, D1_0, q1, im+2, cqf, imo2p, & + trigs, qwk, 0) + + do n=1,nj + do i=3,imo2p + cqf(i,n) = cqf(i,n) * damp(2*i-2,jf(n)) + enddo + enddo + + call zdfftm( 1, im, nj, ooim, cqf, imo2p, q1, im+2, & + trigs, qwk, 0) +#elif defined( SGI_FFT ) + im_4 = im + nj_4 = nj + imp2_4 = im+2 + call dzfftm1du (-1, im_4, nj_4, q1, 1, imp2_4, trigs) + do n=1,nj + do i=5,im+2 + q1(i,n) = q1(i,n) * damp(i-2,jf(n)) + enddo + enddo + call dzfftm1du (1, im_4, nj_4, q1, 1, imp2_4, trigs) + ooim = D1_0/real(im,r8) + do n=1,nj + do i=1,im+2 + q1(i,n) = ooim*q1(i,n) + enddo + enddo +#else + call fft991 (q1, q2, trigs, ifax, 1, im+2, im, nj, -1) + do n=1,nj + do i=5,im+2 + q1(i,n) = q1(i,n) * damp(i-2,jf(n)) + enddo + enddo + call fft991 (q1, q2, trigs, ifax, 1, im+2, im, nj, 1) +#endif + + return +!EOC + end subroutine fftrans +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: pft_cf --- Calculate algebraic and FFT polar filters +! +! !INTERFACE: + subroutine pft_cf(im, jm, js2g0, jn2g0, jn1g1, sc, se, dc, de, & + cosp, cose, ycrit) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im ! Total X dimension + integer jm ! Total Y dimension + integer js2g0 ! j south limit ghosted 0 (SP: from 2) + integer jn2g0 ! j north limit ghosted 0 (NP: from jm-1) + integer jn1g1 ! j north limit ghosted 1 (starts jm) + real (r8) cosp(jm) ! cosine array + real (r8) cose(jm) ! cosine array + real (r8) ycrit ! critical value + +! !OUTPUT PARAMETERS: + real (r8) sc(js2g0:jn2g0) ! Algebric filter at center + real (r8) se(js2g0:jn1g1) ! Algebric filter at edge + real (r8) dc(im,js2g0:jn2g0) ! FFT filter at center + real (r8) de(im,js2g0:jn1g1) ! FFT filter at edge + +! !DESCRIPTION: +! +! Compute coefficients for the 3-point algebraic and the FFT +! polar filters. +! +! !REVISION HISTORY: +! +! 99.01.01 Lin Creation +! 99.08.20 Sawyer/Lin Changes for SPMD mode +! 01.01.30 Lin Put into this module +! 01.03.26 Sawyer Added ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real (r8), parameter :: pi = 3.14159265358979323846_R8 + integer i, j + real (r8) dl, coszc, cutoff, phi, damp + + coszc = cos(ycrit*pi/D180_0) + +! INIT fft polar coefficients: + dl = pi/real(im,r8) + cutoff = D1EM20 + + do j=js2g0,jn2g0 + do i=1,im + dc(i,j) = D1_0 + enddo + enddo + + do j=js2g0,jn1g1 + do i=1,im + de(i,j) = D1_0 + enddo + enddo + +! write(iulog,*) '3-point polar filter coefficients:' + +!************ +! Cell center +!************ + do j=js2g0,jn2g0 + sc(j) = (coszc/cosp(j))**2 + + if(sc(j) > D1_0 ) then + if(fft_flt .eq. 0 .and. sc(j) <= D2_0) then + sc(j) = D1_0 + (sc(j)-D1_0)/(sc(j)+D1_0) + elseif(fft_flt .eq. 0 .and. sc(j) <= D4_0) then + sc(j) = D1_0 + sc(j)/(D8_0-sc(j)) + else + +! FFT filter + do i=1,im/2 + phi = dl * i + damp = min((cosp(j)/coszc)/sin(phi),D1_0)**2 + if(damp < cutoff) damp = D0_0 + dc(2*i-1,j) = damp + dc(2*i ,j) = damp + enddo + + endif + endif + enddo + +!************ +! Cell edges +!************ + do j=js2g0,jn1g1 + se(j) = (coszc/cose(j))**2 + + if(se(j) > D1_0 ) then + if(fft_flt .eq. 0 .and. se(j) <= D2_0) then + se(j) = D1_0 + (se(j)-D1_0)/(se(j)+D1_0) + elseif(fft_flt .eq. 0 .and. se(j) <= D4_0) then + se(j) = D1_0 + se(j)/(D8_0-se(j)) + else +! FFT + do i=1,im/2 + phi = dl * i + damp = min((cose(j)/coszc)/sin(phi), D1_0)**2 + if(damp < cutoff) damp = D0_0 + de(2*i-1,j) = damp + de(2*i ,j) = damp + enddo + endif + endif + enddo + return +!EOC + end subroutine pft_cf +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fftfax --- Initialize FFT +! +! !INTERFACE: + subroutine fftfax (n, ifaxx, trigss) + +! !USES: + implicit none + +! !DESCRIPTION: +! +! Initialize the fast Fourier transform. If CPP token SGI_FFT is +! set, SGI libraries will be used. Otherwise the Fortran code +! is inlined. +! +! !REVISION HISTORY: +! +! 99.11.24 Sawyer Added wrappers for SGI +! 01.03.26 Sawyer Added ProTeX documentation +! 05.07.26 Worley Modified version for Cray X1 +! +!EOP +!----------------------------------------------------------------------- +!BOC + + integer n + +#if defined( SGI_FFT ) + real(r8) trigss(1) + integer ifaxx(*) +! local + integer*4 nn + + nn=n + call dzfftm1dui (nn,trigss) +#else + integer ifaxx(13) + real(r8) trigss(3*n/2+1) + call set99(trigss,ifaxx,n) +#endif + return +!EOC + end subroutine fftfax +!----------------------------------------------------------------------- + +end module pft_module diff --git a/src/dynamics/fv/pkez.F90 b/src/dynamics/fv/pkez.F90 new file mode 100644 index 0000000000..640e826ac0 --- /dev/null +++ b/src/dynamics/fv/pkez.F90 @@ -0,0 +1,231 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: pkez --- Calculate solution to hydrostatic equation +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine pkez(nx, im, km, jfirst, jlast, kfirst, klast, & + ifirst, ilast, pe, pk, cap3v, ks, peln, pkz, eta, high_alt) +!****6***0*********0*********0*********0*********0*********0**********72 +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + +! +! This routine may be called assuming either yz or xy decompositions. +! For xy decomposition, the effective "nx" is 1. +! + +! !INPUT PARAMETERS: + integer, intent(in) :: nx ! SMP decomposition in x + integer, intent(in) :: im, km ! Dimensions + integer, intent(in) :: jfirst, jlast ! Latitude strip + integer, intent(in) :: kfirst, klast ! Vertical strip + integer, intent(in) :: ifirst, ilast ! Longitude strip + real (r8), intent(in) :: pe(ifirst:ilast, kfirst:klast+1, jfirst:jlast) ! Edge pressure + integer, intent(in) :: ks + logical, intent(in) :: eta ! Is on ETA coordinate? + ! True: input pe ; output pk, pkz, peln + ! False: input pe, pk; output pkz, peln + real (r8), intent(in) :: cap3v(ifirst:ilast,jfirst:jlast,km) + logical, intent(in) :: high_alt + +! !INPUT/OUTPUT PARAMETERS: + real (r8), intent(inout) :: pk(ifirst:ilast,jfirst:jlast,kfirst:klast+1) + +! !OUTPUT PARAMETERS + real (r8), intent(out) :: pkz(ifirst:ilast,jfirst:jlast,kfirst:klast) + real (r8), intent(out) :: peln(ifirst:ilast, kfirst:klast+1, jfirst:jlast) ! log pressure (pe) at layer edges + +! !DESCRIPTION: +! +! +! !CALLED FROM: +! te_map and fvccm3 +! +! !REVISION HISTORY: +! +! WS 99.05.19 : Removed fvcore.h +! WS 99.07.27 : Limited region to jfirst:jlast +! WS 99.10.22 : Deleted cp as argument (was not used) +! WS 99.11.05 : Documentation; pruning of arguments +! SJL 00.01.02 : SMP decomposition in i +! AAM 00.08.10 : Add kfirst:klast +! AAM 01.06.27 : Add ifirst:ilast +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local + real (r8) pk2(ifirst:ilast, kfirst:klast+1) + real (r8) pek + real (r8) lnp + real (r8) lnpk + real (r8) cap3vi(ifirst:ilast,jfirst:jlast,km+1) + real (r8) pkln(ifirst:ilast,km+1,jfirst:jlast) ! log pk at layer edges + integer i, j, k, itot, nxu + integer ixj, jp, it, i1, i2 + + itot = ilast - ifirst + 1 +! Use smaller block sizes only if operating on full i domain + nxu = 1 + if (itot .eq. im) nxu = nx + + it = itot / nxu + jp = nxu * ( jlast - jfirst + 1 ) + + if ( eta ) then + if (high_alt) then + !$omp parallel do private(i,j,k) + do k=2,km + do j=jfirst,jlast + do i=ifirst,ilast + cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1) + else + cap3vi(:,:,:) = cap3v(ifirst,jfirst,1) + endif + endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(ixj, i1, i2, i, j, k, pek, lnp, pk2) + +! WS 99.07.27 : Limited region to jfirst:jlast + + do 1000 ixj=1,jp + + j = jfirst + (ixj-1) / nxu + i1 = ifirst + it * mod(ixj-1, nxu) + i2 = i1 + it - 1 + + if ( eta ) then + +! <<<<<<<<<<< Eta cordinate Coordinate >>>>>>>>>>>>>>>>>>> + if (kfirst .eq. 1) then + pek = pe(i1,1,j)**cap3vi(i1,j,1) + lnp = log(pe(i1,1,j)) + lnpk = log(pek) + do i=i1,i2 + pk2(i,1) = pek + peln(i,1,j) = lnp + pkln(i,1,j) = lnpk + enddo + endif + + if(ks .ne. 0) then + do k=max(2,kfirst), min(ks+1,klast+1) + pek = pe(i1,k,j)**cap3vi(i1,j,k) + lnp = log(pe(i1,k,j)) + lnpk = log(pek) + do i=i1,i2 + pk2(i,k) = pek + peln(i,k,j) = lnp + pkln(i,k,j) = lnpk + enddo + enddo + + do k=kfirst, min(ks,klast) + pek = ( pk2(i1,k+1) - pk2(i1,k)) / & + (pkln(i1,k+1,j) - pkln(i1,k,j)) + do i=i1,i2 + pkz(i,j,k) = pek + enddo + enddo + endif + + do k=max(ks+2,kfirst), klast+1 +#if !defined( VECTOR_MATH ) + do i=i1,i2 + pk2(i,k) = pe(i,k,j)**cap3vi(i,j,k) + enddo +#else + call vlog(pk2(i1,k), pe(i1,k,j), it) + do i=i1,i2 + pk2(i,k) = cap3vi(i,j,k) * pk2(i,k) + enddo + call vexp(pk2(i1,k), pk2(i1,k), it) +#endif + enddo + + do k=max(ks+2,kfirst), klast+1 + do i=i1,i2 + peln(i,k,j) = log(pe(i,k,j)) + pkln(i,k,j) = log(pk2(i,k)) + enddo + enddo + + do k=max(ks+1,kfirst), klast + do i=i1,i2 + pkz(i,j,k) = (pk2(i,k+1) - pk2(i,k)) / & + (pkln(i,k+1,j) - pkln(i,k,j)) + enddo + enddo + + do k=kfirst, klast+1 + do i=i1,i2 + pk(i,j,k) = pk2(i,k) + enddo + enddo + + else + +! <<<<<<<<<<< General Coordinate >>>>>>>>>>>>>>>>>>> + + if (kfirst .eq. 1) then + lnp = log(pe(i1,1,j)) ! do log only one time at top -- assumes pe is constant at top + + do i=i1,i2 + peln(i,1,j) = lnp + enddo + endif + + do k=max(2,kfirst), klast+1 + do i=i1,i2 + peln(i,k,j) = log(pe(i,k,j)) + enddo + enddo + do k=kfirst, klast+1 ! variable pk at the top interface --> + do i=i1,i2 + pk2(i,k) = pk(i,j,k) + enddo + enddo + if (high_alt) then + do k=kfirst, klast+1 ! variable pk at the top interface --> + do i=i1,i2 + pkln(i,k,j) = log(pk(i,j,k)) + enddo + enddo + endif + + if (high_alt) then + do k=kfirst, klast + do i=i1,i2 + pkz(i,j,k) = ( pk2(i,k+1) - pk2(i,k) ) / & + (pkln(i,k+1,j) - pkln(i,k,j)) + enddo + enddo + else + do k=kfirst, klast + do i=i1,i2 + pkz(i,j,k) = ( pk2(i,k+1) - pk2(i,k) ) / & + (cap3v(i,j,k)*(peln(i,k+1,j) - peln(i,k,j))) + enddo + enddo + endif + + endif + +1000 continue + + return +!EOC + end +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/pmgrid.F90 b/src/dynamics/fv/pmgrid.F90 new file mode 100644 index 0000000000..181e61523e --- /dev/null +++ b/src/dynamics/fv/pmgrid.F90 @@ -0,0 +1,31 @@ +module pmgrid + +! Initialize grid point resolution parameters + +implicit none + +integer, parameter :: plon = PLON ! number of longitudes +integer, parameter :: plev = PLEV ! number of vertical levels +integer, parameter :: plat = PLAT ! number of latitudes + +integer, parameter :: plevp = plev+1 ! plev + 1 +integer, parameter :: plnlv = plon*plev ! Length of multilevel field slice + +integer :: spmd_on = 0 ! 1 for Spmd, 0 for non-Spmd + +! Staggered grid parameters + +integer, parameter :: splon = plon ! Number of longitudes on the staggered grid +integer, parameter :: splat = plat ! Number of latitudes on the staggered grid + +! Note: In reality, the staggered latitude array for Lin-Rood dynamics only +! uses PLAT-1 latitudes, the first one being ignored. So ideally the line +! above should read: +! parameter (splat = plat-1) +! to define the staggered latitude winds with the correct dimension. +! However, the assumption that the staggered latitude grid has one extra +! latitude (making it the same dimension as the non-staggered grid) is +! pervasive throughout the Lin-Rood dynamical core, necessitating the +! extra latitude. + +end module pmgrid diff --git a/src/dynamics/fv/restart_dynamics.F90 b/src/dynamics/fv/restart_dynamics.F90 new file mode 100644 index 0000000000..61afe82263 --- /dev/null +++ b/src/dynamics/fv/restart_dynamics.F90 @@ -0,0 +1,502 @@ +module restart_dynamics + +!----------------------------------------------------------------------- +! +! Read and write dynamics fields to restart file +! +! !HISTORY: +! 2006.04.13 Sawyer Removed dependency on prognostics +! 2006.07.01 Sawyer Transitioned q3 tracers to T_TRACERS +! 2008.10.02 Edwards Added pio support +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4 +use pmgrid, only: plon, plat, plev +use constituents, only: pcnst, cnst_name +use time_manager, only: get_curr_time + +use hycoef, only: init_restart_hycoef, write_restart_hycoef + +use dyn_comp, only: dyn_import_t, dyn_export_t +use dyn_grid, only: get_horiz_grid_dim_d, get_dyn_grid_parm +use dynamics_vars, only: t_fvdycore_state, t_fvdycore_grid +use dyn_internal_state, only: get_dyn_state + +use cam_grid_support, only: cam_grid_write_attr, cam_grid_id +use cam_grid_support, only: cam_grid_header_info_t +use cam_pio_utils, only: pio_subsystem +use pio, only: file_desc_t, io_desc_t, var_desc_t, & + pio_double, pio_unlimited, pio_offset_kind, & + pio_setdebuglevel, pio_setframe, & + pio_def_var, pio_def_dim, & + pio_inq_varid, & + pio_put_var, pio_get_var, & + pio_write_darray, pio_read_darray, & + pio_initdecomp, pio_freedecomp + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +#if ( defined OFFLINE_DYN ) +use metdata, only: write_met_restart, read_met_restart +#endif + +implicit none +private +save + +public :: & + init_restart_dynamics, & + write_restart_dynamics, & + read_restart_dynamics + +integer, parameter :: namlen=16 + +type restart_var_t + real(r8), pointer :: v2d(:,:) + real(r8), pointer :: v3d(:, :, :) + real(r8), pointer :: v4d(:, :, :, :) + real(r8), pointer :: v5d(:, :, :, :, :) + real(r4), pointer :: v2dr4(:,:) + real(r4), pointer :: v3dr4(:, :, :) + real(r4), pointer :: v4dr4(:, :, :, :) + real(r4), pointer :: v5dr4(:, :, :, :, :) + + type(var_desc_t), pointer :: vdesc + integer :: ndims + integer :: timelevels + character(len=namlen) :: name +end type restart_var_t + +integer, parameter :: restartvarcnt = 6+pcnst + +type(var_desc_t) :: timedesc + +type(restart_var_t) :: restartvars(restartvarcnt) +logical :: restart_varlistw_initialized = .false. +logical :: restart_varlistr_initialized = .false. + +!========================================================================================= +contains +!========================================================================================= + +subroutine init_restart_dynamics(File, dyn_out) + + ! Input arguments + type(File_desc_t), intent(inout) :: File + type(Dyn_export_t), intent(in) :: dyn_out + + integer :: vdimids(2) + integer :: ierr + integer :: hdim1, hdim2 + integer :: hdimids(2) + character(len=namlen) :: name + + integer :: alldims(3), alldims2d(2) + integer :: i, timelevels + integer :: ndims + type(var_desc_t), pointer :: vdesc + type(cam_grid_header_info_t) :: info + !---------------------------------------------------------------------------- + + call init_restart_hycoef(File, vdimids) + + call get_horiz_grid_dim_d(hdim1, hdim2) + ierr = PIO_Def_Dim(File, 'lon', hdim1, hdimids(1)) + ierr = PIO_Def_Dim(File, 'lat', hdim2, hdimids(2)) + + ierr = PIO_Def_Var(File, 'time', pio_double, timedesc) + + alldims(1:2) = hdimids(1:2) + alldims(3) = vdimids(1) + + alldims2d(1:2) = hdimids(1:2) + + call init_restart_varlistw(dyn_out) + + do i = 1, restartvarcnt + + call get_restart_var(File, i, name, timelevels, ndims, vdesc) + + if (timelevels > 1) then + call endrun('not expecting timelevels>1 in fv dycore') + else + if (ndims==1) then +! broken i think + ierr = PIO_Def_Var(File, name, pio_double, hdimids(2:2), vdesc) + else if (ndims==2) then + ierr = PIO_Def_Var(File, name, pio_double, alldims2d(1:2), vdesc) + else if (ndims==3) then + ierr = PIO_Def_Var(File, name, pio_double, alldims(1:3), vdesc) + end if + call pio_setframe(File, vdesc, int(-1,kind=pio_offset_kind)) + end if + end do + +#if ( defined OFFLINE_DYN ) + ! This write happens here rather than from write_restart_dynamics because + ! only attributes are written (two filenames) and that should happen during + ! the file definition phase. + call write_met_restart( File ) +#endif + +end subroutine init_restart_dynamics + +!========================================================================================= + +subroutine write_restart_dynamics(File, dyn_out) + + ! arguments + type(File_desc_t), intent(inout) :: File + type(Dyn_export_t), intent(in) :: dyn_out + + ! Local workspace + logical :: use_transfer + integer :: ndcur, nscur + integer :: hdim1, hdim2 + type(io_desc_t) :: iodesc2d, iodesc3d + integer :: ierr + real(r8) :: time, mold(1), null(0) + integer :: i, s3d(1), s2d(1), ct + integer(kind=pio_offset_kind) :: t + integer :: ndims, isize(1), timelevels + type(var_desc_t), pointer :: vdesc + integer, pointer :: ldof(:) + character(len=namlen) :: name + type (T_FVDYCORE_STATE), pointer :: dyn_state + !---------------------------------------------------------------------------- + + call write_restart_hycoef(File) + + ! transfer is the fastest method to flatten the multidimensional arrays into the 1d needed by pio + ! but it doesn't work correctly if the array is zero length... + + use_transfer = .true. +#if ( defined SPMD ) + dyn_state => get_dyn_state() + if (dyn_state%grid%iam >= dyn_state%grid%npes_xy) then + use_transfer = .false. + end if +#endif + + call get_curr_time(ndcur, nscur) + call get_horiz_grid_dim_d(hdim1, hdim2) + + ldof => get_restart_decomp(hdim1, hdim2, plev) + call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2, plev/), ldof, iodesc3d) + deallocate(ldof) + + ldof => get_restart_decomp(hdim1, hdim2, 1) + call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2/), ldof, iodesc2d) + deallocate(ldof) + +!++bee it does not appear that this time variable is read by read_restart_dynamics. is it read somewhere else? + time = ndcur+(real(nscur,kind=r8))/86400._r8 + ierr = pio_put_var(File, timedesc%varid, time) + + do i=1,restartvarcnt + call get_restart_var(File, i, name, timelevels, ndims, vdesc) + if(ndims==2) then + if(use_transfer) then + call pio_write_darray(File, vdesc, iodesc2d, transfer(restartvars(i)%v2d(:,:), mold), ierr) + else + call pio_write_darray(File, vdesc, iodesc2d, null, ierr) + end if + else if(ndims==3) then + if(use_transfer) then + call pio_write_darray(File, vdesc, iodesc3d, transfer(restartvars(i)%v3d(:,:,:), mold), ierr) + else + call pio_write_darray(File, vdesc, iodesc3d, null, ierr) + end if + end if + end do + + call pio_freedecomp(File, iodesc2d) + call pio_freedecomp(File, iodesc3d) + +end subroutine write_restart_dynamics + +!========================================================================================= + +subroutine read_restart_dynamics(File, dyn_in, dyn_out) + + use dyn_comp, only: dyn_init + + ! arguments + type(file_desc_t) :: File + type(dyn_export_t) :: dyn_out + type(dyn_import_t) :: dyn_in + + ! local variables + type(t_fvdycore_state), pointer :: dyn_state + type(t_fvdycore_grid), pointer :: grid + + integer :: beglonxy, endlonxy, beglatxy, endlatxy + integer :: i, s2d, s3d + + real(r8), allocatable :: tmp(:) + integer :: dims3d(3) + integer :: ndims + integer :: ierr + character(len=namlen) :: name + integer, pointer :: ldof(:) + + integer :: timelevels ! not used in fv + type(var_desc_t), pointer :: vdesc + type(io_desc_t) :: iodesc2d, iodesc3d + !---------------------------------------------------------------------------- + +#if ( defined OFFLINE_DYN ) + call read_met_restart(File) +#endif + + dyn_state => get_dyn_state() + grid => dyn_state%grid + + call dyn_init(dyn_in, dyn_out) + + beglonxy = grid%ifirstxy + endlonxy = grid%ilastxy + beglatxy = grid%jfirstxy + endlatxy = grid%jlastxy + + dims3d(1) = endlonxy - beglonxy + 1 + dims3d(2) = endlatxy - beglatxy + 1 + dims3d(3) = plev + + s2d = dims3d(1)*dims3d(2) + s3d = s2d*dims3d(3) + allocate(tmp(s3d)) + + call init_restart_varlistr(dyn_in) + + ldof => get_restart_decomp(plon, plat, plev) + call pio_initdecomp(pio_subsystem, pio_double, (/plon, plat, plev/), ldof, iodesc3d) + deallocate(ldof) + + ldof => get_restart_decomp(plon, plat, 1) + call pio_initdecomp(pio_subsystem, pio_double, (/plon, plat/), ldof, iodesc2d) + deallocate(ldof) + + do i = 1, restartvarcnt + call get_restart_var(File, i, name, timelevels, ndims, vdesc) + ierr = PIO_Inq_varid(File, name, vdesc) + call pio_setframe(File, vdesc, int(-1,kind=pio_offset_kind)) + if(ndims==2) then + call pio_read_darray(File, vdesc, iodesc2d, tmp(1:s2d), ierr) + restartvars(i)%v2d(:,:) = reshape(tmp(1:s2d), dims3d(1:2)) + else if(ndims==3) then + call pio_read_darray(File, restartvars(i)%vdesc, iodesc3d, tmp(1:s3d), ierr) + restartvars(i)%v3d(:,:,:) = reshape(tmp(1:s3d), dims3d) + end if + end do + + deallocate(tmp) + call pio_freedecomp(File, iodesc2d) + call pio_freedecomp(File, iodesc3d) + +end subroutine read_restart_dynamics + +!========================================================================================= +! Private +!========================================================================================= + +subroutine set_r_var(name, timelevels, index, v2, v3, v4, v5, v2r4, v3r4, v4r4, v5r4) + + ! arguments + character(len=*), intent(in) :: name + integer, intent(in) :: timelevels, index + real(r8), target, optional :: v2(:,:), v3(:,:,:), v4(:,:,:,:), v5(:,:,:,:,:) + real(r4), target, optional :: v2r4(:,:), v3r4(:,:,:), v4r4(:,:,:,:), v5r4(:,:,:,:,:) + !---------------------------------------------------------------------------- + + restartvars(index)%name = name + restartvars(index)%timelevels = timelevels + + if (present(v2)) then + restartvars(index)%ndims = 2 + restartvars(index)%v2d => v2 + else if (present(v3)) then + restartvars(index)%ndims = 3 + restartvars(index)%v3d => v3 + else if (present(v4)) then + restartvars(index)%ndims = 4 + restartvars(index)%v4d => v4 + else if (present(v5)) then + restartvars(index)%ndims = 5 + restartvars(index)%v5d => v5 + else if (present(v2r4)) then + restartvars(index)%ndims = 2 + restartvars(index)%v2dr4 => v2r4 + else if (present(v3r4)) then + restartvars(index)%ndims = 3 + restartvars(index)%v3dr4 => v3r4 + else if (present(v4r4)) then + restartvars(index)%ndims = 4 + restartvars(index)%v4dr4 => v4r4 + else if (present(v5r4)) then + restartvars(index)%ndims = 5 + restartvars(index)%v5dr4 => v5r4 + else + call endrun('set_r_var: ERROR: bad ndims') + end if + + allocate(restartvars(index)%vdesc) + +end subroutine set_r_var + +!========================================================================================= + +subroutine init_restart_varlistw(dyn_out) + + type(dyn_export_t) :: dyn_out + + integer :: vcnt=1 + integer :: i, m + !---------------------------------------------------------------------------- + + ! Should only be called once + if (restart_varlistw_initialized) return + + restart_varlistw_initialized = .true. + + call set_r_var('PHIS', 1, vcnt, v2=dyn_out%phis) + + vcnt = vcnt + 1 + call set_r_var('U', 1, vcnt, v3=dyn_out%u3s) + + vcnt = vcnt + 1 + call set_r_var('V', 1, vcnt, v3=dyn_out%v3s) + + vcnt = vcnt + 1 + call set_r_var('DELP', 1, vcnt, v3=dyn_out%delp) + + vcnt = vcnt + 1 + call set_r_var('PT', 1, vcnt, v3=dyn_out%pt) + + do m = 1, pcnst + vcnt = vcnt + 1 + call set_r_var(cnst_name(m), 1, vcnt, v3=dyn_out%tracer(:,:,:,m)) + end do + + vcnt = vcnt + 1 + call set_r_var('PS', 1, vcnt, v2=dyn_out%ps ) + + + if (vcnt /= restartvarcnt) then + write(iulog,*) 'init_restart_varlistw: ERROR: vcnt= ', vcnt, & + ' restartvarcnt=', restartvarcnt + call endrun('init_restart_varlistw: ERROR: bad restartvarcnt') + end if + +end subroutine init_restart_varlistw + +!========================================================================================= + +subroutine init_restart_varlistr(dyn_in) + + type(dyn_import_t) :: dyn_in + + integer :: vcnt=1 + integer :: i, m + !---------------------------------------------------------------------------- + + ! Should only be called once + if (restart_varlistr_initialized) return + + restart_varlistr_initialized = .true. + + call set_r_var('PHIS', 1, vcnt, v2=dyn_in%phis) + + vcnt = vcnt + 1 + call set_r_var('U', 1, vcnt, v3=dyn_in%u3s) + + vcnt = vcnt + 1 + call set_r_var('V', 1, vcnt, v3=dyn_in%v3s) + + vcnt = vcnt + 1 + call set_r_var('DELP', 1, vcnt, v3=dyn_in%delp) + + vcnt = vcnt + 1 + call set_r_var('PT', 1, vcnt, v3=dyn_in%pt) + + do m = 1, pcnst + vcnt = vcnt + 1 + call set_r_var(cnst_name(m), 1, vcnt, v3=dyn_in%tracer(:,:,:,m)) + end do + + vcnt = vcnt + 1 + call set_r_var('PS', 1, vcnt, v2=dyn_in%ps) + + if (vcnt /= restartvarcnt) then + write(iulog,*) 'init_restart_varlistr: ERROR: vcnt= ', vcnt, & + ' restartvarcnt=',restartvarcnt + call endrun('init_restart_varlistr: ERROR: bad restartvarcnt') + end if + +end subroutine init_restart_varlistr + +!========================================================================================= + +function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) + + ! Get the integer mapping of a variable in the dynamics decomp in memory. + ! The canonical ordering is as on the file. A 0 value indicates that the + ! variable is not on the file (eg halo or boundary values) + + ! arguments + integer, intent(in) :: hdim1, hdim2, nlev + integer, pointer :: ldof(:) + + ! local variables + integer :: i, k, j + integer :: lcnt + integer :: beglatxy, beglonxy, endlatxy, endlonxy + !---------------------------------------------------------------------------- + + beglonxy = get_dyn_grid_parm('beglonxy') + endlonxy = get_dyn_grid_parm('endlonxy') + beglatxy = get_dyn_grid_parm('beglatxy') + endlatxy = get_dyn_grid_parm('endlatxy') + + lcnt = (endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) + allocate(ldof(lcnt)) + ldof(:) = 0 + + lcnt = 0 + do k = 1, nlev + do j = beglatxy, endlatxy + do i = beglonxy, endlonxy + lcnt = lcnt + 1 + ldof(lcnt) = i + (j-(plat-hdim2+1))*hdim1+(k-1)*hdim1*hdim2 + end do + end do + end do + +end function get_restart_decomp + +!========================================================================================= + +subroutine get_restart_var(File, i, name, timelevels, ndims, vdesc) + + type(file_desc_t) :: File + integer, intent(in) :: i + character(len=namlen), intent(out) :: name + integer, intent(out) :: timelevels + integer, intent(out) :: ndims + type(var_desc_t), pointer :: vdesc + + name = restartvars(i)%name + timelevels = restartvars(i)%timelevels + ndims = restartvars(i)%ndims + if (.not.associated(restartvars(i)%vdesc)) then + allocate(restartvars(i)%vdesc) + end if + vdesc => restartvars(i)%vdesc + +end subroutine get_restart_var + +!========================================================================================= + +end module restart_dynamics diff --git a/src/dynamics/fv/spmd_dyn.F90 b/src/dynamics/fv/spmd_dyn.F90 new file mode 100644 index 0000000000..5e2cfe1bad --- /dev/null +++ b/src/dynamics/fv/spmd_dyn.F90 @@ -0,0 +1,1044 @@ +module spmd_dyn + +!----------------------------------------------------------------------- +! Subroutines to initialize SPMD implementation of FV +! +! !REVISION HISTORY: +! 00.09.30 Sawyer Alterations for LR SPMD mode +! 01.05.09 Mirin 2-D yz decomposition +! 01.06.27 Mirin Secondary 2-D xy decomposition +! 01.12.20 Sawyer Changed index order of Q3 decomposition +! 03.05.07 Sawyer Removed unneeded decompositions +! 06.03.01 Sawyer Removed tracertrans-related variables +!----------------------------------------------------------------------- + +use spmd_utils, only: iam, masterproc, npes, mpicom + +use pmgrid, only: plat, plon, plev, spmd_on +use constituents, only: pcnst + +use dynamics_vars, only: t_fvdycore_grid +use dyn_internal_state, only: get_dyn_state_grid + +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public :: & + spmd_readnl, & + spmdinit_dyn, & + compute_gsfactors, & + spmdbuf + +public :: & + local_dp_map, & + block_buf_nrecs, & + chunk_buf_nrecs, & + proc, & + lonrangexy, & + latrangexy + +! local_dp_map, block_buf_nrecs, chunk_buf_nrecs belong somewhere else. They are just +! stored here without being set or used +logical :: local_dp_map=.false. ! flag indicates that mapping between dynamics + ! and physics decompositions does not require + ! interprocess communication +integer :: block_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in dynamics decomposition (including level 0) +integer :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in physics decomposition (including level 0) + +! used by dyn_grid::get_block_owner_d +integer :: proc(plat) ! processor id associated with a given lat. + +! used by dyn_grid:: get_gcol_block_d, get_block_gcol_cnt_d, get_block_gcol_d +integer, allocatable :: lonrangexy(:,:) ! global xy-longitude subdomain index +integer, allocatable :: latrangexy(:,:) ! global xy-latitude subdomain index + +integer :: force_2d = 0 !option to force transpose computation for 1D decomp. +integer :: geopkblocks = 1 !number of stages to use in Z-serial non-transpose + ! geopotential method (routine geopk_d) + ! with 2D decomp. +logical :: geopkdist = .false. !use a distributed method for geopotential calculation + ! with 2D decomp. +logical :: geopk16byte = .false. !use Z-parallel distributed method for geopotential + ! calculation with 2D decomp.; otherwise, use Z-serial + ! pipeline algorithm +integer :: geopktrans = 0 +integer :: npr_yz(4) !yz and xy decompositions +integer :: modcomm_transpose = 0 !mod_comm transpose method + ! 0 for temporary contiguous buffers + ! 1 for mpi derived types +integer :: modcomm_geopk = 0 !mod_comm geopk method + ! 0 for temporary contiguous buffers + ! 1 for mpi derived types +integer :: modcomm_gatscat = 0 !mod_comm gather/scatter method + ! 0 for temporary contiguous buffers + ! 1 for mpi derived types +integer :: modc_sw_dynrun = 0 !mod_comm irregular underlying communication method for dyn_run/misc + ! 0 for original mp_sendirr/mp_recvirr + ! 1 for mp_swapirr and point-to-point communications + ! 2 for mp_swapirr and all-to-all communications +logical :: modc_hs_dynrun = .true. !mod_comm irreg comm handshaking for dyn_run/misc +logical :: modc_send_dynrun = .true. ! true for mod_comm irregular communication blocking send for + ! dyn_run/misc, false for nonblocking send +integer :: modc_mxreq_dynrun = -1 !maximum number of nonblocking communication requests to allow + ! when using mp_swapirr and point-to-point communications for + ! dyn_run/misc + ! < 0 implies no limits +integer :: modc_sw_cdcore = 0 !mod_comm irregular underlying communication method for cd_core/geopk + ! 0 for original mp_sendirr/mp_recvirr + ! 1 for mp_swapirr and point-to-point communications + ! 2 for mp_swapirr and all-to-all communications +logical :: modc_hs_cdcore = .true. ! true for mod_comm irregular communication handshaking for cd_core/geopk +logical :: modc_send_cdcore = .true. ! true for geopk_d or mod_comm irregular communication blocking send for + ! cd_core/geopk, false for nonblocking send +integer :: modc_mxreq_cdcore = -1 ! maximum number of nonblocking communication requests to allow + ! when using mp_swapirr and point-to-point communications for + ! cd_core/geopk + ! < 0 implies no limits +integer :: modc_sw_gather = 1 ! mod_comm irregular underlying communication method for gather + ! 0 for original mp_sendirr/mp_recvirr + ! 1 for mp_swapirr and point-to-point communications + ! 2 for mp_swapirr and all-to-all communications +logical :: modc_hs_gather = .true. ! true for mod_comm irregular communication handshaking for gather +logical :: modc_send_gather = .true. ! true for mod_comm irregular communication blocking send for + ! gather, false for nonblocking send +integer :: modc_mxreq_gather = 64 ! maximum number of nonblocking communication requests to allow + ! when using mp_swapirr and point-to-point communications for + ! gather + ! < 0 implies no limits +integer :: modc_sw_scatter = 0 ! mod_comm irregular underlying communication method for scatter + ! 0 for original mp_sendirr/mp_recvirr + ! 1 for mp_swapirr and point-to-point communications + ! 2 for mp_swapirr and all-to-all communications +logical :: modc_hs_scatter = .false. ! true for mod_comm irregular communication handshaking for scatter +logical :: modc_send_scatter = .true. ! true for mod_comm irregular communication blocking send for + ! scatter, false for nonblocking send +integer :: modc_mxreq_scatter = -1 ! maximum number of nonblocking communication requests to allow + ! when using mp_swapirr and point-to-point communications for + ! scatter + ! < 0 implies no limits +integer :: modc_sw_tracer = 0 ! mod_comm irregular underlying communication method for multiple tracers + ! 0 for original mp_sendirr/mp_recvirr + ! 1 for mp_swapirr and point-to-point communications + ! 2 for mp_swapirr and all-to-all communications +logical :: modc_hs_tracer = .true. ! true for mod_comm irregular communication handshaking for multiple tracers +logical :: modc_send_tracer = .true. ! true for mod_comm irregular communication blocking send for + ! multiple tracers, false for nonblocking send +integer :: modc_mxreq_tracer = -1 ! maximum number of nonblocking communication requests to allow + ! when using mp_swapirr and point-to-point communications for + ! multiple tracers + ! < 0 implies no limits +integer :: modc_onetwo = 2 !one or two simultaneous mod_comm irregular communications + ! (excl. tracers) +integer :: modc_tracers = 3 ! max number of tracers for simultaneous mod_comm irregular communications + ! 0 for original mp_sendirr/mp_recvirr communications + ! positive for special tracer routines + +integer :: fv_ct_overlap = 0 ! nonzero for overlap of cd_core and trac2d, 0 otherwise +integer :: fv_trac_decomp = 1 ! size of tracer domain decomposition for trac2d + +! these vars used in beglat and endlat determination, and in compute_gsfactors +integer, allocatable :: nlat_p(:) ! number of latitudes per subdomain in YZ decomp +integer, allocatable :: cut(:,:) ! latitude partition for MPI tasks in YZ decomp + +integer :: npr_y +integer :: npr_z +integer :: nprxy_x +integer :: nprxy_y +integer :: npes_yz +integer :: npes_xy +integer :: myid_y +integer :: myid_z +integer :: myidxy_x +integer :: myidxy_y + +integer :: numlats + +!======================================================================================== +contains +!======================================================================================== + +subroutine spmd_readnl(nlfilename) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mstrid=>masterprocid, mpi_integer, mpi_logical,& + mpi_success + ! args + character(len=*), intent(in) :: nlfilename + + ! Local variables + integer :: ierr ! error code + integer :: unitn ! namelist unit number + + namelist /spmd_fv_inparm/ npr_yz, & + geopktrans, geopkblocks, & + force_2d, modcomm_transpose, & + modcomm_geopk, modcomm_gatscat, & + modc_sw_dynrun, modc_hs_dynrun, & + modc_send_dynrun, modc_mxreq_dynrun, & + modc_sw_cdcore, modc_hs_cdcore, & + modc_send_cdcore, modc_mxreq_cdcore, & + modc_sw_gather, modc_hs_gather, & + modc_send_gather, modc_mxreq_gather, & + modc_sw_scatter, modc_hs_scatter, & + modc_send_scatter, modc_mxreq_scatter, & + modc_sw_tracer, modc_hs_tracer, & + modc_send_tracer, modc_mxreq_tracer, & + modc_onetwo, modc_tracers, & + fv_ct_overlap, fv_trac_decomp + + character(len=*), parameter :: sub = "spmd_readnl" + + type(t_fvdycore_grid), pointer :: grid + + integer :: color, ierror, ntemp + integer :: twod_decomp + integer :: mpicom_yz ! communicator for yz decomposition + integer :: mpicom_nyz ! communicator for multiple yz decomposition + integer :: mpicom_xy ! communicator for xy decomposition + !---------------------------------------------------------------------- + + ! Default 1D domain decomposition + npr_yz(1) = npes + npr_yz(2) = 1 + npr_yz(3) = 1 + npr_yz(4) = npes + + if (masterproc) then + write(iulog,*) sub//': Read in spmd_fv_inparm namelist from: ', trim(nlfilename) + unitn = getunit() + open( unitn, file=trim(nlfilename), status='old' ) + + ! Look for spmd_fv_inparm group name in the input file. If found, leave the + ! file positioned at that namelist group. + call find_group_name(unitn, 'spmd_fv_inparm', status=ierr) + if (ierr == 0) then ! found spmd_fv_inparm + read(unitn, spmd_fv_inparm, iostat=ierr) ! read the spmd_fv_inparm namelist group + if (ierr /= 0) then + call endrun(sub//': ERROR reading namelist spmd_fv_inparm') + end if + end if + close( unitn ) + call freeunit( unitn ) + endif + + call mpi_bcast(npr_yz, 4, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: npr_yz") + + call mpi_bcast(geopktrans, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: geopktrans") + + call mpi_bcast(geopkblocks, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: geopkblocks") + + call mpi_bcast(force_2d, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: force_2d") + + call mpi_bcast(modcomm_transpose, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modcomm_transpose") + + call mpi_bcast(modcomm_geopk, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modcomm_geopk") + + call mpi_bcast(modcomm_gatscat, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modcomm_gatscat") + + call mpi_bcast(modc_sw_dynrun, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_sw_dynrun") + + call mpi_bcast(modc_hs_dynrun, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_hs_dynrun") + + call mpi_bcast(modc_send_dynrun, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_send_dynrun") + + call mpi_bcast(modc_mxreq_dynrun, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_mxreq_dynrun") + + call mpi_bcast(modc_sw_cdcore, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_sw_cdcore") + + call mpi_bcast(modc_hs_cdcore, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_hs_cdcore") + + call mpi_bcast(modc_send_cdcore, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_send_cdcore") + + call mpi_bcast(modc_mxreq_cdcore, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_mxreq_cdcore") + + call mpi_bcast(modc_sw_gather, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_sw_gather") + + call mpi_bcast(modc_hs_gather, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_hs_gather") + + call mpi_bcast(modc_send_gather, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_send_gather") + + call mpi_bcast(modc_mxreq_gather, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_mxreq_gather") + + call mpi_bcast(modc_sw_scatter, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_sw_scatter") + + call mpi_bcast(modc_hs_scatter, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_hs_scatter") + + call mpi_bcast(modc_send_scatter, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_send_scatter") + + call mpi_bcast(modc_mxreq_scatter, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_mxreq_scatter") + + call mpi_bcast(modc_sw_tracer, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_sw_tracer") + + call mpi_bcast(modc_hs_tracer, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_hs_tracer") + + call mpi_bcast(modc_send_tracer, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_send_tracer") + + call mpi_bcast(modc_mxreq_tracer, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_mxreq_tracer") + + call mpi_bcast(modc_onetwo, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_onetwo") + + call mpi_bcast(modc_tracers, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: modc_tracers") + + call mpi_bcast(fv_ct_overlap, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_ct_overlap") + + call mpi_bcast(fv_trac_decomp, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_trac_decomp") + + ! Put namelist input into the grid object + grid => get_dyn_state_grid() + + npr_y = npr_yz(1) + npr_z = npr_yz(2) + nprxy_x = npr_yz(3) + nprxy_y = npr_yz(4) + npes_yz = npr_y*npr_z + npes_xy = nprxy_x*nprxy_y + if (npes_yz < 1) then + call endrun(sub//': ERROR: yz domain decomposition must have at least 1 subdomain') + endif + if (npes_yz > npes) then + call endrun(sub//': ERROR: incorrect yz domain decomposition') + endif + if (npes_xy > npes) then + call endrun(sub//': ERROR: incorrect xy domain decomposition') + endif + + grid%npr_y = npr_y + grid%npr_z = npr_z + grid%nprxy_x = nprxy_x + grid%nprxy_y = nprxy_y + grid%npes_xy = npes_xy + grid%npes_yz = npes_yz + + grid%ct_overlap = fv_ct_overlap + grid%trac_decomp = fv_trac_decomp + + if (fv_ct_overlap .ne. 0 .and. npes .lt. 2*npes_yz) then + call endrun(sub//': ERROR: Not enough processes to overlap cd_core and trac2d') + end if + + if (fv_trac_decomp .le. 0) then + call endrun(sub//': ERROR: fv_trac_decomp improperly initialized') + end if + + if (npes .lt. fv_trac_decomp*npes_yz) then + call endrun(sub//': ERROR: Not enough processes to decompose tracers') + endif + + if (fv_ct_overlap .gt. 0 .and. fv_trac_decomp .gt. 1) then + call endrun(sub//': ERROR: Cannot simultaneously overlap cd_core/trac2d and decompose tracers') + endif + + ! Tracer decomposition limits + allocate(grid%ktloa(fv_trac_decomp), grid%kthia(fv_trac_decomp)) + grid%ktloa(:) = 1 + grid%kthia(:) = pcnst + grid%ktlo = 1 + grid%kthi = pcnst + + grid%commdyn = mpicom + grid%iam = iam + +#ifdef SPMD + myid_z = iam/npr_y + myid_y = iam - myid_z*npr_y + color = iam/npes_yz + call mpi_comm_split(mpicom, color, iam, mpicom_yz, ierror) + if (ierror /= mpi_success) then + write(iulog,*) sub//': ERROR: mpi_comm_split_yz failed with IER=', ierror + call endrun(sub//': ERROR: mpi_comm_split_yz failed') + end if + call mpi_comm_size(mpicom_yz, ntemp, ierror) + if (iam .lt. npes_yz .and. ntemp .ne. npes_yz) then + write(iulog,*) sub//': ERROR: mpicom_yz has incorrect size of ', ntemp + call endrun(sub//': ERROR: mpicom_yz has incorrect size') + end if + + if (fv_ct_overlap .gt. 0 .or. fv_trac_decomp .gt. 1) then + ! These are mutually exclusive options + if ((fv_ct_overlap .gt. 0 .and. iam .lt. 2*npes_yz) .or. & + (fv_trac_decomp .gt. 1 .and. iam .lt. fv_trac_decomp*npes_yz)) then + color = 1 + else + color = 0 + endif + call mpi_comm_split(mpicom, color, iam, mpicom_nyz, ierror) + if (ierror /= mpi_success) then + write (iulog,*) sub//': ERROR: mpi_comm_split_nyz failed with IER=', ierror + call endrun(sub//': ERROR: mpi_comm_split_nyz failed') + endif + else + mpicom_nyz = mpicom_yz + endif + + myidxy_y = iam/nprxy_x + myidxy_x = iam - myidxy_y*nprxy_x + color = iam/npes_xy + call mpi_comm_split(mpicom, color, iam, mpicom_xy, ierror) + if (ierror /= mpi_success) then + write(iulog,*) sub//': ERROR: mpi_comm_split_xy failed with IER=', ierror + call endrun(sub//': ERROR: mpi_comm_split_xy failed') + endif + call mpi_comm_size(mpicom_xy, ntemp, ierror) + if (iam .lt. npes_xy .and. ntemp .ne. npes_xy) then + write(iulog,*) sub//': ERROR: mpicom_xy has incorrect size of ', ntemp + call endrun(sub//': ERROR: mpicom_xy has incorrect size') + endif + + grid%myid_z = myid_z + grid%myid_y = myid_y + grid%myidxy_y = myidxy_y + grid%myidxy_x = myidxy_x + + grid%commyz = mpicom_yz + grid%commnyz = mpicom_nyz + grid%commxy = mpicom_xy +#endif + + twod_decomp = 0 + if (npr_z > 1 .or. nprxy_x > 1 .or. force_2d .eq. 1) then + twod_decomp = 1 + endif + grid%twod_decomp = twod_decomp + + if (geopktrans .ne. 0) geopkdist = .true. + if (geopktrans .eq. 1) geopk16byte = .true. +#ifdef NO_CRAY_POINTERS + if (geopk16byte) then + call endrun (sub//': ERROR: cannot use geopk16 unless compiler supports cray pointers') + end if +#endif + + geopkblocks = max(1,geopkblocks) + + grid%geopkdist = geopkdist + grid%geopk16byte = geopk16byte + grid%geopkblocks = geopkblocks + grid%mod_method = modcomm_transpose + grid%mod_geopk = modcomm_geopk + grid%mod_gatscat = modcomm_gatscat + + if (modc_sw_dynrun > 0 .and. modcomm_transpose > 0) then + call endrun(sub//': ERROR: modc_sw_dynrun and modcomm_transpose are inconsistent') + endif + + grid%modc_dynrun(1) = modc_sw_dynrun + grid%modc_dynrun(2:3) = 0 + if (modc_hs_dynrun) grid%modc_dynrun(2) = 1 + if (modc_send_dynrun) grid%modc_dynrun(3) = 1 + grid%modc_dynrun(4) = modc_mxreq_dynrun + + if (modc_sw_cdcore > 0 .and. (modcomm_transpose > 0 .or. & + (modcomm_geopk > 0 .and. geopk16byte))) then + call endrun(sub//': ERROR: modc_sw_cdcore and modcomm_transpose are inconsistent') + endif + + grid%modc_cdcore(1) = modc_sw_cdcore + grid%modc_cdcore(2:3) = 0 + if (modc_hs_cdcore) grid%modc_cdcore(2) = 1 + if (modc_send_cdcore) grid%modc_cdcore(3) = 1 + grid%modc_cdcore(4) = modc_mxreq_cdcore + + if (modc_sw_gather > 0 .and. modcomm_gatscat > 0) then + call endrun(sub//': ERROR: modc_sw_gather and modcomm_gatscat are inconsistent') + endif + + grid%modc_gather(1) = modc_sw_gather + grid%modc_gather(2:3) = 0 + if (modc_hs_gather) grid%modc_gather(2) = 1 + if (modc_send_gather) grid%modc_gather(3) = 1 + grid%modc_gather(4) = modc_mxreq_gather + + if (modc_sw_scatter > 0 .and. modcomm_gatscat > 0) then + call endrun(sub//': ERROR: modc_sw_scatter and modcomm_gatscat are inconsistent') + endif + + grid%modc_scatter(1) = modc_sw_scatter + grid%modc_scatter(2:3) = 0 + if (modc_hs_scatter) grid%modc_scatter(2) = 1 + if (modc_send_scatter) grid%modc_scatter(3) = 1 + grid%modc_scatter(4) = modc_mxreq_scatter + + if (modc_sw_tracer > 0 .and. modcomm_transpose > 0) then + call endrun(sub//': ERROR: modc_sw_tracer and modcomm_transpose are inconsistent') + endif + + grid%modc_tracer(1) = modc_sw_tracer + grid%modc_tracer(2:3) = 0 + if (modc_hs_tracer) grid%modc_tracer(2) = 1 + if (modc_send_tracer) grid%modc_tracer(3) = 1 + grid%modc_tracer(4) = modc_mxreq_tracer + + if (modc_tracers < 0) then + call endrun(sub//': ERROR: inadmissable value of modc_tracers') + endif + + grid%modc_onetwo = modc_onetwo + grid%modc_tracers = modc_tracers + + if (masterproc) then + write(iulog,*)'FV grid decomposition:' + write(iulog,*)' npr_y = ', npr_y, ' npr_z = ', npr_z + write(iulog,*)' nprxy_x = ', nprxy_x, ' nprxy_y = ', nprxy_y + write(iulog,*)' npes = ', npes, ' npes_yz= ', npes_yz, ' npes_xy = ', npes_xy + + if (npes > 1) then + + if (fv_ct_overlap .ne. 0) then + write(iulog,*)' Overlapping tracer and dynamics subcycles' + endif + + write(iulog,*)' Decomposing tracers into ', fv_trac_decomp, ' groups' + + if (twod_decomp == 0) then + write(iulog,*)' decomposition is effectively 1D - skipping transposes' + else + write(iulog,*)' using multi-2d decomposition methodology' + end if + + write(iulog,*)' non-transpose geopk communication method = ', geopkdist + write(iulog,*)' Z-parallel non-transpose geopk communication method = ', geopk16byte + + if (geopkdist .and. (.not. geopk16byte)) then + write(iulog,*)' number of stages in Z-serial non-transpose geopk method = ', geopkblocks + endif + + write(iulog,*)' modcomm transpose method = ', modcomm_transpose + write(iulog,*)' modcomm geopk method = ', modcomm_geopk + write(iulog,*)' modcomm gatscat method = ', modcomm_gatscat + + write(iulog,*)' modc_sw_dynrun = ', modc_sw_dynrun + write(iulog,*)' modc_hs_dynrun = ', modc_hs_dynrun + write(iulog,*)' modc_send_dynrun = ', modc_send_dynrun + write(iulog,*)' modc_mxreq_dynrun = ', modc_mxreq_dynrun + + write(iulog,*)' modc_sw_cdcore = ', modc_sw_cdcore + write(iulog,*)' modc_hs_cdcore = ', modc_hs_cdcore + write(iulog,*)' modc_send_cdcore = ', modc_send_cdcore + write(iulog,*)' modc_mxreq_cdcore = ', modc_mxreq_cdcore + + write(iulog,*)' modc_sw_gather = ', modc_sw_gather + write(iulog,*)' modc_hs_gather = ', modc_hs_gather + write(iulog,*)' modc_send_gather = ', modc_send_gather + write(iulog,*)' modc_mxreq_gather = ', modc_mxreq_gather + + write(iulog,*)' modc_sw_scatter = ', modc_sw_scatter + write(iulog,*)' modc_hs_scatter = ', modc_hs_scatter + write(iulog,*)' modc_send_scatter = ', modc_send_scatter + write(iulog,*)' modc_mxreq_scatter = ', modc_mxreq_scatter + + write(iulog,*)' modc_sw_tracer = ', modc_sw_tracer + write(iulog,*)' modc_hs_tracer = ', modc_hs_tracer + write(iulog,*)' modc_send_tracer = ', modc_send_tracer + write(iulog,*)' modc_mxreq_tracer = ', modc_mxreq_tracer + + write(iulog,*)' modc_onetwo = ', modc_onetwo + write(iulog,*)' modc_tracers = ', modc_tracers + + end if + + end if + +end subroutine spmd_readnl + +!======================================================================================== + +subroutine spmdinit_dyn(jord, grid) + + !----------------------------------------------------------------------- + ! Initialize grid decomposition. + ! + ! !REVISION HISTORY: + ! 00.09.30 Sawyer Added LR-specific initialization + ! 01.06.27 Mirin Secondary 2-D xy decomposition + ! 01.10.16 Sawyer Added Y at each Z decompositions + ! 03.07.22 Sawyer Removed decomps used by highp2 + !----------------------------------------------------------------------- + +#ifdef SPMD + use parutilitiesmodule, only: parinit, gid, parcollective, maxop + use dynamics_vars, only: spmd_vars_init +#endif + + ! arguments + integer, intent(in) :: jord + type(t_fvdycore_grid), pointer :: grid + + ! local variables: + + integer, parameter :: numbnd = 0 ! no.of latitudes passed N and S of forecast lat + + integer :: beglat + integer :: endlat + integer :: beglev + integer :: endlev + + integer :: mod_maxirr + + integer :: procid ! processor id + integer :: procids ! processor id + integer :: procidn ! processor id + + integer :: j, k + integer :: lat + integer :: vert + integer :: lonn + integer :: workleft ! amount of work still to be parcelled out + + integer :: isum ! running total of work parcelled out + integer :: smostlat ! southern-most latitude index + integer :: nmostlat ! northern-most latitude index + + integer, allocatable :: ydist(:) ! number of lats per subdomain in YZ decomp + integer, allocatable :: zdist(:) ! number of levels per subdomain in YZ decomp + + integer :: beglonxy, endlonxy + integer :: beglatxy, endlatxy + integer, allocatable :: xdistxy(:) ! number of xy-longs per subdomain + integer, allocatable :: ydistxy(:) ! number of xy-lats per subdomain + + integer, allocatable :: tmp(:) + integer, allocatable :: jmyz(:), kmyz(:) ! used for nonblocking receive + integer, allocatable :: imxy(:), jmxy(:) ! used for nonblocking receive + + character(len=*), parameter :: sub = "spmdinit_dyn" + !--------------------------------------------------------------------------- + + ! Default YZ decomposition is 1D + beglev = 1 + endlev = plev + + mod_maxirr = max(modc_onetwo, modc_tracers) + +#ifdef SPMD + + spmd_on = 1 + + ! Initialize PILGRIM library + call parinit(comm=mpicom, & + npryzxy = (/ npr_y, npr_z, nprxy_x, nprxy_y /), & + mod_method = modcomm_transpose, & + mod_geopk = modcomm_geopk, & + mod_maxirr = mod_maxirr, & + mod_gatscat = modcomm_gatscat ) + + ! Compute Y partition for YZ decomposition + + allocate(ydist (npr_y)) + allocate(nlat_p (0:npes-1)) + allocate(cut (2,0:npes-1)) + + ydist(:) = 0 + nlat_p(:) = 0 + cut(1,:) = -1 + cut(2,:) = -2 + + lat = plat / npr_y + workleft = plat - lat * npr_y + if (lat < 3) then + call endrun(sub//': ERROR: less than 3 latitudes per subdomain') + end if + + ! Be careful: ydist is 1-based. CAMs arrays, e.g., cut, are 0-based + + do procid = 1, npr_y + ydist(procid) = lat + end do + + if ( workleft /= 0 ) then + procids = (npr_y+1) / 2 + procidn = procids + 1 + do while ( workleft /= 0 ) + if ( procids == 1 ) procids = npr_y + ydist(procids) = ydist(procids) + 1 + workleft = workleft - 1 + if ( workleft /= 0 ) then + ydist(procidn) = ydist(procidn) + 1 + workleft = workleft - 1 + end if + procidn = procidn + 1 + procids = procids - 1 + end do + end if + + ! Safety checks: + if (sum(ydist) /= plat) then + write(iulog,*) sub//': ERROR: sum(ydist)=', sum(ydist),' not equal to plat' + call endrun(sub//': ERROR: sum(ydist) not equal to plat') + end if + if (workleft/=0) then + write(iulog,*) sub//': ERROR: workleft for ydist not zero. workleft=', workleft + call endrun(sub//': ERROR: workleft for ydist not zero') + end if + + ! Set the CAM data structures + lat = 0 + do procid = 0, npr_y-1 + cut(1,procid) = lat + 1 + lat = lat + ydist(procid+1) + cut(2,procid) = lat + nlat_p(procid) = ydist(procid+1) + + if (masterproc) then + write(iulog,*) 'nlat_p(',procid,') = ', nlat_p(procid) + end if + + if (myid_y == procid) then + beglat = cut(1,myid_y) + endlat = cut(2,myid_y) + numlats = ydist(procid+1) + end if + end do + + do k = 1, npr_z-1 + do j = 0, npr_y-1 + procid = j + k*npr_y + cut(1,procid) = cut(1,j) + cut(2,procid) = cut(2,j) + nlat_p(procid) = nlat_p(j) + end do + end do + + proc(:) = 0 + do procid = 0, npr_y*npr_z-1 + + ! Determine which processor is responsible for the defined latitudes + do lat = cut(1,procid), cut(2,procid) + proc(lat) = procid + end do + end do + + ! Compute Z partition for YZ decomposition + + allocate(zdist((npes-1)/npr_y+1)) + + zdist(:) = 0 + + vert = plev / npr_z + workleft = plev - vert * npr_z + if (vert < 1) then + call endrun(sub//': ERROR: less than 1 vertical levels per subdomain') + end if + + do procid = 1, npr_z + zdist(procid) = vert + end do + + if (workleft /= 0) then + procids = (npr_z+1) / 2 + procidn = procids + 1 + do while ( workleft /= 0 ) + if (procids == 1) procids = npr_z + zdist(procids) = zdist(procids) + 1 + workleft = workleft - 1 + if (workleft /= 0) then + zdist(procidn) = zdist(procidn) + 1 + workleft = workleft - 1 + end if + procidn = procidn + 1 + procids = procids - 1 + end do + end if + + ! Safety checks: + if (sum(zdist) /= plev) then + write(iulog,*) sub//': ERROR: sum(zdist)=', sum(zdist),' not equal to plev' + call endrun(sub//': ERROR: sum(zdist) not equal to plev') + endif + if (workleft/=0) then + write(iulog,*) sub//': ERROR: workleft for zdist not zero. workleft=', workleft + call endrun(sub//': ERROR: workleft for zdist not zero') + end if + + ! Compute local limits + call locallimits(myid_z, zdist, beglev, endlev) + + ! Auxiliary processes only + if (iam >= npes_yz) then + beglat = 1 + endlat = 0 + numlats = 0 + beglev = 1 + endlev = 0 + end if + + grid%jfirst = beglat + grid%jlast = endlat + grid%kfirst = beglev + grid%klast = endlev + if (endlev == plev) then + grid%klastp = plev+1 + else + grid%klastp = endlev + end if + + ! Compute X partition for XY decomposition + + allocate(xdistxy(nprxy_x)) + xdistxy(:) = 0 + + lonn = plon / nprxy_x + workleft = plon - lonn * nprxy_x + if (lonn < 3) then + call endrun(sub//': ERROR: less than 3 longitudes per XY subdomain') + end if + + do procid = 1, nprxy_x + xdistxy(procid) = lonn + enddo + + if (workleft /= 0) then + procids = (nprxy_x+1) / 2 + procidn = procids + 1 + do while (workleft /= 0) + if (procids == 1) procids = nprxy_x + xdistxy(procids) = xdistxy(procids) + 1 + workleft = workleft - 1 + if (workleft /= 0) then + xdistxy(procidn) = xdistxy(procidn) + 1 + workleft = workleft - 1 + end if + procidn = procidn + 1 + procids = procids - 1 + end do + end if + + ! Safety check: + if ( sum(xdistxy) /= plon ) then + write(iulog,*) sub//': ERROR: sum(xdistxy)=', sum(xdistxy),' not equal to plon' + call endrun(sub//': ERROR: sum(xdistxy) not equal to plon ') + end if + if (workleft/=0) then + write(iulog,*) sub//': ERROR: workleft for xdistxy not zero. workleft=',workleft + call endrun(sub//': ERROR: workleft for xdistxy not zero') + end if + + ! Compute local limits + call locallimits(myidxy_x, xdistxy, beglonxy, endlonxy) + + ! Compute global array for use in dyn_grid module + allocate (lonrangexy(2,nprxy_x)) + lonrangexy(1,1) = 1 + lonrangexy(2,1) = xdistxy(1) + do procid = 2, nprxy_x + lonrangexy(1,procid) = lonrangexy(2,procid-1) + 1 + lonrangexy(2,procid) = lonrangexy(1,procid) + xdistxy(procid) - 1 + end do + + ! Compute Y partition for XY decomposition + + allocate(ydistxy((npes-1)/nprxy_x+1)) + ydistxy(:) = 0 + + lat = plat / nprxy_y + workleft = plat - lat * nprxy_y + if (lat < 3) then + call endrun(sub//': ERROR: less than 3 latitudes per XY subdomain') + end if + + do procid = 1, nprxy_y + ydistxy(procid) = lat + end do + + if (workleft /= 0) then + procids = (nprxy_y+1) / 2 + procidn = procids + 1 + do while (workleft /= 0) + if (procids == 1) procids = nprxy_y + ydistxy(procids) = ydistxy(procids) + 1 + workleft = workleft - 1 + if (workleft /= 0) then + ydistxy(procidn) = ydistxy(procidn) + 1 + workleft = workleft - 1 + end if + procidn = procidn + 1 + procids = procids - 1 + end do + end if + + ! Safety check: + if (sum(ydistxy) /= plat) then + write(iulog,*) sub//': ERROR: sum(ydistxy)=', sum(ydistxy),' not equal to plat' + call endrun(sub//': ERROR: sum(ydistxy) not equal to plat') + end if + if (workleft/=0) then + write(iulog,*) sub//': ERROR: workleft for ydistxy not zero. workleft=',workleft + call endrun(sub//': ERROR: workleft for ydistxy not zero') + end if + + ! Compute local limits + call locallimits(myidxy_y, ydistxy, beglatxy, endlatxy) + + ! Auxiliary processes only + if (iam >= npes_xy) then + beglonxy = 1 + endlonxy = 0 + beglatxy = 1 + endlatxy = 0 + end if + + grid%ifirstxy = beglonxy + grid%ilastxy = endlonxy + grid%jfirstxy = beglatxy + grid%jlastxy = endlatxy + + ! Compute global array for use in dyn_grid module + allocate (latrangexy(2,nprxy_y)) + latrangexy(1,1) = 1 + latrangexy(2,1) = ydistxy(1) + do procid = 2, nprxy_y + latrangexy(1,procid) = latrangexy(2,procid-1) + 1 + latrangexy(2,procid) = latrangexy(1,procid) + ydistxy(procid) - 1 + end do + + deallocate(ydist) + deallocate(zdist) + + deallocate(xdistxy) + deallocate(ydistxy) + + ! Calculate the ghost region sizes for the SPMD version (tricky stuff) + grid%ng_c = 2 ! Avoid the case where ng_c = 1 + grid%ng_d = min( abs(jord), 3) ! SJL: number of max ghost latitudes + grid%ng_d = max( grid%ng_d, 2) + grid%ng_s = max( grid%ng_c+1, grid%ng_d ) + + ! Define imxy, jmxy, jmyz, kmyz from beglonxy, endlonxy, etc. + allocate(tmp(npes), imxy(nprxy_x), jmxy(nprxy_y), jmyz(npr_y), kmyz(npr_z)) + + tmp = 0 + tmp(gid+1) = endlonxy - beglonxy + 1 + call parcollective( mpicom, maxop, npes, tmp ) + imxy(1:nprxy_x) = tmp(1:nprxy_x) + + tmp = 0 + tmp(gid+1) = endlatxy - beglatxy + 1 + call parcollective( mpicom, maxop, npes, tmp ) + do k = 1, nprxy_y + jmxy(k) = tmp((k-1)*nprxy_x+1) + end do + + tmp = 0 + tmp(gid+1) = grid%jlast - grid%jfirst + 1 + call parcollective( mpicom, maxop, npes, tmp ) + jmyz(1:grid%npr_y) = tmp(1:grid%npr_y) + + tmp = 0 + tmp(gid+1) = grid%klast - grid%kfirst + 1 + call parcollective( mpicom, maxop, npes, tmp ) + do k = 1, grid%npr_z + kmyz(k) = tmp((k-1)*grid%npr_y+1) + end do + + ! set up the PILGRIM communications + call spmd_vars_init(imxy, jmxy, jmyz, kmyz, grid) + + deallocate(tmp, imxy, jmxy, jmyz, kmyz) + +#endif +end subroutine spmdinit_dyn + +!======================================================================================== + +subroutine spmdbuf + +end subroutine spmdbuf + +!======================================================================================== + +subroutine compute_gsfactors(numperlat, numtot, numperproc, displs) + + ! Compute arguments for gatherv, scatterv + + ! arguments + integer, intent(in) :: numperlat ! number of elements per latitude + integer, intent(out) :: numtot ! total number of elements (to send or recv) + integer, intent(out) :: numperproc(0:npes-1) ! per-PE number of items to receive + integer, intent(out) :: displs(0:npes-1) ! per-PE displacements + +#ifdef SPMD + ! Local variables + integer :: p + !--------------------------------------------------------------------------- + + numtot = numperlat*numlats + + do p = 0, npes-1 + numperproc(p) = numperlat*nlat_p(p) + end do + + displs(:) = 0 + do p = 1, npr_y-1 + displs(p) = displs(p-1) + numperproc(p-1) + end do + + if (npr_z > 1) then + do p = 1, npr_z-1 + displs(p*npr_y:(p+1)*npr_y-1) = displs(0:npr_y-1) + enddo + endif +#endif + +end subroutine compute_gsfactors + +!======================================================================================== + +subroutine locallimits(myidxy, distxy, begdimxy, enddimxy) + + integer, intent(in) :: myidxy + integer, intent(in) :: distxy(:) + integer, intent(out) :: begdimxy + integer, intent(out) :: enddimxy + + integer :: procid + + begdimxy = 1 + enddimxy = distxy(1) + + do procid = 1, myidxy + begdimxy = enddimxy + 1 + enddimxy = begdimxy + distxy(procid+1) - 1 + end do +end subroutine locallimits + +!======================================================================================== + +end module spmd_dyn + diff --git a/src/dynamics/fv/stepon.F90 b/src/dynamics/fv/stepon.F90 new file mode 100644 index 0000000000..d91867bdbe --- /dev/null +++ b/src/dynamics/fv/stepon.F90 @@ -0,0 +1,495 @@ +module stepon + +!---------------------------------------------------------------------- +! stepon provides the interface layer that allows the different dynamical +! cores to be called from different locations in the time loop. It also +! provides a standard interface that is called from the higher level CAM +! component run methods while leaving non-standardized dycore interface +! methods to be called from this layer. Ideally only the run methods +! which allow flexibility in the dynamics/physics calling sequence should +! remain. The init and finalize methods should be removed and their +! functionality incorporated in the dycore init and finalize. +!---------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 + +use spmd_utils, only: mpicom, iam, masterproc +use cam_control_mod, only: initial_run, moist_physics +use ppgrid, only: begchunk, endchunk +use physconst, only: zvir, cappa + +use physics_types, only: physics_state, physics_tend + +use dyn_comp, only: dyn_import_t, dyn_export_t +use dynamics_vars, only: t_fvdycore_state, t_fvdycore_grid +use dyn_internal_state, only: get_dyn_state, get_dyn_state_grid + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use perf_mod, only: t_startf, t_stopf, t_barrierf + +implicit none +private +save + +public :: & + stepon_init, &! Initialization + stepon_run1, &! run method phase 1 + stepon_run2, &! run method phase 2 + stepon_run3, &! run method phase 3 + stepon_final ! Finalization + +integer :: pdt ! Physics time step +real(r8) :: dtime ! Physics time step +real(r8) :: te0 ! Total energy before dynamics + +! for fv_out +logical, parameter :: fv_monitor=.true. ! Monitor Mean/Max/Min fields + ! This is CPU-time comsuming; + ! set it to false for production runs +real (r8) :: ptop + +!========================================================================================= +contains +!========================================================================================= + +subroutine stepon_init(dyn_in, dyn_out) + + use constituents, only: pcnst, cnst_get_type_byind + use time_manager, only: get_step_size + use physconst, only: physconst_calc_kappav, rair, cpair + use inic_analytic, only: analytic_ic_active + + type (dyn_import_t) :: dyn_in ! Dynamics import container + type (dyn_export_t) :: dyn_out ! Dynamics export container + + ! local variables: + type (t_fvdycore_grid), pointer :: grid + + integer :: im, km + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy + integer :: i,k,j,m ! longitude, level, latitude and tracer indices + logical :: nlres = .false. ! true => restart or branch run + + integer :: ks + real (r8), pointer :: ak(:) + real (r8), pointer :: bk(:) + + real(r8), allocatable :: delpdryxy(:,:,:) + real(r8), allocatable :: cap3vi(:,:,:), cappa3v(:,:,:) + !---------------------------------------------------------------------------- + + if (.not. initial_run) nlres=.true. + + grid => get_dyn_state_grid() + im = grid%im + km = grid%km + + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + + ks = grid%ks + ptop = grid%ptop + ak => grid%ak + bk => grid%bk + + pdt = get_step_size() ! Physics time step + dtime = pdt + + do j = jfirstxy, jlastxy + do i=ifirstxy, ilastxy + dyn_in%pe(i,1,j) = ptop + enddo + enddo + + if ( nlres) then ! restart or branch run + ! + ! read_restart_dynamics delivers phis, ps, u3s, v3s, delp, pt + ! in XY decomposition + + ! + ! Do not recalculate delta pressure (delp) if this is a restart run. + ! Re. SJ Lin: The variable "delp" (pressure thikness for a Lagrangian + ! layer) must be in the restart file. This is because delp will be + ! modified "after" the physics update (to account for changes in water + ! vapor), and it can not be reproduced by surface pressure and the + ! ETA coordinate's a's and b's. + +!$omp parallel do private(i,j,k) + do j = jfirstxy, jlastxy + do k=1, km + do i=ifirstxy, ilastxy + dyn_in%pe(i,k+1,j) = dyn_in%pe(i,k,j) + dyn_in%delp(i,j,k) + enddo + enddo + enddo + else + + ! Initial run --> generate pe and delp from the surface pressure + +!$omp parallel do private(i,j,k) + do j = jfirstxy, jlastxy + do k=1,km+1 + do i=ifirstxy, ilastxy + dyn_in%pe(i,k,j) = ak(k) + bk(k) * dyn_in%ps(i,j) + enddo + enddo + enddo + +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirstxy, jlastxy + do i= ifirstxy, ilastxy + dyn_in%delp(i,j,k) = dyn_in%pe(i,k+1,j) - dyn_in%pe(i,k,j) + enddo + enddo + enddo + endif + + !---------------------------------------------------------- + ! Check total dry air mass; set to 982.22 mb if initial run + ! Print out diagnostic message if restart run + !---------------------------------------------------------- + + if ( moist_physics .and. .not. analytic_ic_active()) then + call dryairm( grid, .true., dyn_in%ps, dyn_in%tracer, & + dyn_in%delp, dyn_in%pe, nlres ) + endif + + if (grid%iam < grid%npes_xy) then + + allocate( cappa3v(ifirstxy:ilastxy,jfirstxy:jlastxy,km) ) + allocate( cap3vi(ifirstxy:ilastxy,jfirstxy:jlastxy,km+1) ) + if (grid%high_alt) then + call physconst_calc_kappav( ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, dyn_in%tracer, cappa3v ) + +!$omp parallel do private(i,j,k) + do k=2,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + cap3vi(i,j,k) = 0.5_r8*(cappa3v(i,j,k-1)+cappa3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cappa3v(:,:,1) - 0.5_r8 * cappa3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cappa3v(:,:,km) - 0.5_r8 * cappa3v(:,:,km-1) + else + cappa3v = rair/cpair + cap3vi = rair/cpair + endif + + ! Initialize pk, edge pressure to the cappa power. Do this with constituent dependent cappa + +!$omp parallel do private(i,j,k) + do k = 1, km+1 + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + dyn_in%pk(i,j,k) = dyn_in%pe(i,k,j)**cap3vi(i,j,k) + enddo + enddo + enddo + + ! Generate pkz, the conversion factor betw pt and t3 + + call pkez(1, im, km, jfirstxy, jlastxy, & + 1, km, ifirstxy, ilastxy, dyn_in%pe, & + dyn_in%pk, cappa3v, ks, dyn_out%peln, dyn_out%pkz, .false., grid%high_alt ) + + deallocate( cappa3v, cap3vi ) + + endif + + if (initial_run) then + + ! Compute pt for initial run: scaled virtual potential temperature + ! defined as (virtual temp deg K)/pkz. pt will be written to restart (SJL) + +!$omp parallel do private(i,j,k) + do k = 1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + dyn_in%pt(i,j,k) = dyn_in%t3(i,j,k)* & + (1._r8 + zvir*dyn_in%tracer(i,j,k,1)) & + /dyn_in%pkz(i,j,k) + enddo + enddo + enddo + + !---------------------------------------------------------------- + ! Convert mixing ratios initialized as dry to moist for dynamics + !---------------------------------------------------------------- + + ! on initial time step, dry mixing ratio advected constituents have been + ! initialized to dry mixing ratios. dynpkg expects moist m.r. so convert here. + + ! first calculate delpdry. The set_pdel_state subroutine + ! is called after the dynamics in d_p_coupling to set more variables. + ! This is not in tracers.F90 because it is only used by LR dynamics. + allocate (delpdryxy(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km)) + do k = 1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + delpdryxy(i,j,k) = dyn_in%delp(i,j,k)* & + (1._r8 - dyn_in%tracer(i,j,k,1)) + enddo + enddo + enddo + do m = 1,pcnst + if (cnst_get_type_byind(m).eq.'dry') then + do k=1, km + do j = jfirstxy, jlastxy + do i = ifirstxy, ilastxy + dyn_in%tracer(i,j,k,m) = & + dyn_in%tracer(i,j,k,m)* & + delpdryxy(i,j,k)/dyn_in%delp(i,j,k) + end do + end do + end do + end if + end do + deallocate (delpdryxy) + + end if + +!EOC +end subroutine stepon_init + +!========================================================================================= + +subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & + dyn_in, dyn_out ) + + ! Phase 1 run of FV dynamics. Run the dynamics, and couple to physics. + + use dp_coupling, only: d_p_coupling + use dyn_comp, only: dyn_run + + use physics_buffer, only: physics_buffer_desc + use advect_tend, only: compute_adv_tends_xyz + + ! arguments + real(r8), intent(out) :: dtime_out ! Time-step + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(dyn_import_t) :: dyn_in ! Dynamics import container + type(dyn_export_t) :: dyn_out ! Dynamics export container + + type(T_FVDYCORE_STATE), pointer :: dyn_state + + integer :: rc + + dtime_out = dtime + dyn_state => get_dyn_state() + + ! Dump state variables to IC file + call t_barrierf('sync_diag_dynvar_ic', mpicom) + call t_startf ('diag_dynvar_ic') + call diag_dynvar_ic (dyn_state%grid, dyn_out%phis, dyn_out%ps, & + dyn_out%t3, dyn_out%u3s, dyn_out%v3s, dyn_out%tracer ) + call t_stopf ('diag_dynvar_ic') + + call t_startf ('comp_adv_tends1') + call compute_adv_tends_xyz(dyn_state%grid, dyn_in%tracer ) + call t_stopf ('comp_adv_tends1') + ! + !-------------------------------------------------------------------------- + ! Perform finite-volume dynamics -- this dynamical core contains some + ! yet to be published algorithms. Its use in the CAM is + ! for software development purposes only. + ! Please contact S.-J. Lin (Shian-Jiann.Lin@noaa.gov) + ! if you plan to use this mudule for scientific purposes. Contact S.-J. Lin + ! or Will Sawyer (sawyer@gmao.gsfc.nasa.gov) if you plan to modify the + ! software. + !-------------------------------------------------------------------------- + + !---------------------------------------------------------- + ! For 2-D decomposition, phisxy is input to dynpkg, and the other + ! xy variables are output. Some are computed through direct + ! transposes, and others are derived. + !---------------------------------------------------------- + call t_barrierf('sync_dyn_run', mpicom) + call t_startf ('dyn_run') + call dyn_run(ptop, pdt, te0, & + dyn_state, dyn_in, dyn_out, rc ) + if ( rc /= 0 ) then + write(iulog,*) "STEPON_RUN: dyn_run returned bad error code", rc + write(iulog,*) "Quitting." + call endrun + endif + call t_stopf ('dyn_run') + + call t_startf ('comp_adv_tends2') + call compute_adv_tends_xyz(dyn_state%grid, dyn_out%tracer ) + call t_stopf ('comp_adv_tends2') + + !---------------------------------------------------------- + ! Move data into phys_state structure. + !---------------------------------------------------------- + call t_barrierf('sync_d_p_coupling', mpicom) + call t_startf('d_p_coupling') + call d_p_coupling(dyn_state%grid, phys_state, phys_tend, pbuf2d, dyn_out) + call t_stopf('d_p_coupling') + +!EOC +end subroutine stepon_run1 + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: stepon_run2 -- second phase run method +! +! !INTERFACE: +subroutine stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) +! !USES: + use dp_coupling, only: p_d_coupling +! +! !INPUT/OUTPUT PARAMETERS: +! + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + + type (T_FVDYCORE_GRID), pointer :: grid +! +! !DESCRIPTION: +! +! Second phase run method. Couple from physics to dynamics. +! +!EOP +!----------------------------------------------------------------------- +!BOC + +!----------------------------------------------------------------------- + + !---------------------------------------------------------- + ! Update dynamics variables using phys_state & phys_tend. + ! 2-D decomposition: Compute ptxy and q3xy; for ideal + ! physics, scale ptxy by (old) pkzxy; then transpose to yz variables + ! 1-D decomposition: Compute dudt, dvdt, pt and q3; for ideal physics, + ! scale pt by old pkz. + ! Call uv3s_update to update u3s and v3s from dudt and dvdt. + ! Call p_d_adjust to update pt, q3, pe, delp, ps, piln, pkz and pk. + ! For adiabatic case, transpose to yz variables. + !---------------------------------------------------------- + grid => get_dyn_state_grid() + + call t_barrierf('sync_p_d_coupling', mpicom) + call t_startf ('p_d_coupling') + call p_d_coupling(grid, phys_state, phys_tend, & + dyn_in, dtime, zvir, cappa, ptop) + call t_stopf ('p_d_coupling') + +!EOC +end subroutine stepon_run2 + +!----------------------------------------------------------------------- + +subroutine stepon_run3(dtime, cam_out, phys_state, & + dyn_in, dyn_out ) +! !USES: + use time_manager, only: get_curr_date + use fv_prints, only: fv_out + use camsrfexch, only: cam_out_t +! +! !INPUT PARAMETERS: +! + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + real(r8), intent(in) :: dtime ! Time-step + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container +! +! !INPUT/OUTPUT PARAMETERS: +! + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) +! +! !DESCRIPTION: +! +! Final run phase of dynamics. Some printout and time index updates. +! +! !HISTORY: +! 2005.09.16 Kluzek Creation +! 2006.04.13 Sawyer Removed shift_time_indices (not needed in FV) +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: +! + + type(t_fvdycore_state), pointer :: state + type(t_fvdycore_grid), pointer :: grid + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! time of day relative to current date [seconds] + integer :: yr, mon, day ! year, month, day components of a date + integer :: ncsecp + integer :: freq_diag + + !---------------------------------------------------------- + ! Monitor max/min/mean of selected fields + ! + ! SEE BELOW **** SEE BELOW **** SEE BELOW + + ! Beware that fv_out uses both dynamics and physics instantiations. + ! However, I think that they are used independently, so that the + ! answers are correct. Still, this violates the notion that the + ! physics state is no longer active after p_d_coupling. + !---------------------------------------------------------- + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + ncsecp = ncsec + pdt ! step complete, but nstep not incremented yet + + state => get_dyn_state() + freq_diag = state%check_dt + + if (fv_monitor .and. mod(ncsecp, freq_diag) == 0) then + grid => state%grid + + call t_barrierf('sync_fv_out', mpicom) + call t_startf('fv_out') + call fv_out(grid, dyn_out%pk, dyn_out%pt, & + ptop, dyn_out%ps, dyn_out%tracer, & + dyn_out%delp, dyn_out%pe, cam_out, & + phys_state, ncdate, ncsecp, moist_physics) + call t_stopf('fv_out') + endif + +!EOC +end subroutine stepon_run3 + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: stepon_final --- Dynamics finalization +! +! !INTERFACE: +subroutine stepon_final(dyn_in, dyn_out) + +! !PARAMETERS: + type (dyn_import_t), intent(out) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(out) :: dyn_out ! Dynamics export container +! +! !DESCRIPTION: +! +! Deallocate data needed for dynamics. Finalize any dynamics specific +! files or subroutines. +! +!EOP +!----------------------------------------------------------------------- +!BOC + +!!! Not yet ready for the call to dyn_final +!!! call dyn_final( RESTART_FILE, dyn_state, dyn_in, dyn_out ) +!EOC +end subroutine stepon_final + +!----------------------------------------------------------------------- + +end module stepon diff --git a/src/dynamics/fv/sw_core.F90 b/src/dynamics/fv/sw_core.F90 new file mode 100644 index 0000000000..823e8c9b10 --- /dev/null +++ b/src/dynamics/fv/sw_core.F90 @@ -0,0 +1,1662 @@ +module sw_core +!BOP +! +! !MODULE: sw_core --- Utilities for solving the shallow-water equation +! +! !USES: + use dynamics_vars, only: T_FVDYCORE_GRID + use shr_kind_mod, only : r8 => shr_kind_r8 + +#ifdef NO_R16 + integer,parameter :: r16= selected_real_kind(12) ! 8 byte real +#else + integer,parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + +! +! !PUBLIC MEMBER FUNCTIONS: + public d2a2c_winds, c_sw, d_sw +! +! !DESCRIPTION: +! +! This module contains vertical independent part of the Lagrangian +! dynamics; in simpler terms, it solves the 2D shallow water equation +! (SWE). +! +! \begin{tabular}{|l|l|} \hline \hline +! c_sw & \\ \hline +! d_sw & +! \end{tabular} +! +! !REVISION HISTORY: +! 01.01.15 Lin Routines coalesced into this module +! 03.11.19 Sawyer Merged in CAM changes by Mirin +! 04.10.07 Sawyer ompinner now from dynamics_vars +! 05.03.25 Todling shr_kind_r8 can only be referenced once (MIPSpro-7.4.2) +! 05.05.25 Sawyer Merged CAM and GEOS5 versions (mostly CAM) +! 05.07.26 Worley Changes for Cray X1 +! 05.07.05 Sawyer Interfaces of c_sw and d_sw simplified with grid +! 05.10.12 Worley More changes for Cray X1(E), avoiding array segment copying +! 06.01.18 Putman Allowed Y-dir courant number and mass flux to accumulate +! at jlast+1 +! 06.09.06 Sawyer Isolated magic numbers as F90 parameters +! +!EOP + +! Magic numbers used in this module + + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_125 = 0.125_r8 + real(r8), parameter :: D0_25 = 0.25_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + real(r8), parameter :: D1E30 = 1.0e30_r8 + +contains + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: c_sw --- Solve the SWE on a C grid +! +! !INTERFACE: + subroutine c_sw(grid, u, v, pt, delp, & + u2, v2, & + uc, vc, ptc, delpf, ptk, & + tiny, iord, jord, am_correction) + +! Routine for shallow water dynamics on the C-grid + +! !USES: + + use tp_core + use pft_module, only : pft2d + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in):: iord + integer, intent(in):: jord + logical, intent(in):: am_correction + + real(r8), intent(in):: u2(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent(in):: v2(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + +! Prognostic variables: + real(r8), intent(in):: u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s) + real(r8), intent(in):: v(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + real(r8), intent(in):: pt(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent(in):: delp(grid%im,grid%jfirst:grid%jlast) + real(r8), intent(in):: delpf(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + + real(r8), intent(in):: tiny + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: uc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent(inout):: vc(grid%im,grid%jfirst-2:grid%jlast+2 ) + +! !OUTPUT PARAMETERS: + real(r8), intent(out):: ptc(grid%im,grid%jfirst:grid%jlast) + real(r8), intent(out):: ptk(grid%im,grid%jfirst:grid%jlast) + +! !DESCRIPTION: +! +! Routine for shallow water dynamics on the C-grid +! +! !REVISION HISTORY: +! WS 2003.11.19 Merged in CAM changes by Mirin +! WS 2004.10.07 Added ProTeX documentation +! WS 2005.07.01 Simplified interface by passing grid +! +!EOP +!----------------------------------------------------------------------- +!BOC + + +!-------------------------------------------------------------- +! Local + real(r8) :: zt_c + real(r8) :: dydt + real(r8) :: dtdy5 + real(r8) :: rcap + + real(r8), pointer:: sc(:) + real(r8), pointer:: dc(:,:) + + real(r8), pointer:: cosp(:) + real(r8), pointer:: acosp(:) + real(r8), pointer:: cose(:) + + real(r8), pointer:: dxdt(:) + real(r8), pointer:: dxe(:) + real(r8), pointer:: rdxe(:) + real(r8), pointer:: dtdx2(:) + real(r8), pointer:: dtdx4(:) + real(r8), pointer:: dtxe5(:) + real(r8), pointer:: dycp(:) + real(r8), pointer:: cye(:) + + real(r8), pointer:: fc(:) + + real(r8), pointer:: sinlon(:) + real(r8), pointer:: coslon(:) + real(r8), pointer:: sinl5(:) + real(r8), pointer:: cosl5(:) + + real(r8) :: fx(grid%im,grid%jfirst:grid%jlast) + real(r8) :: xfx(grid%im,grid%jfirst:grid%jlast) + real(r8) :: tm2(grid%im,grid%jfirst:grid%jlast) + + real(r8) :: va(grid%im,grid%jfirst-1:grid%jlast) + + real(r8) :: wk4(grid%im+2,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + + real(r8) :: wk1(grid%im,grid%jfirst-1:grid%jlast+1) + + real(r8) :: cry(grid%im,grid%jfirst-1:grid%jlast+1) + real(r8) :: fy(grid%im,grid%jfirst-1:grid%jlast+1) + + real(r8) :: ymass(grid%im,grid%jfirst: grid%jlast+1) + real(r8) :: yfx(grid%im,grid%jfirst: grid%jlast+1) + + real(r8) :: crx(grid%im,grid%jfirst-grid%ng_c:grid%jlast+grid%ng_c) + real(r8) :: vort_u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8) :: vort(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + + real(r8) :: fxjv(grid%im,grid%jfirst-1:grid%jn2g0) + real(r8) :: p1dv(grid%im,grid%jfirst-1:grid%jn2g0) + real(r8) :: cx1v(grid%im,grid%jfirst-1:grid%jn2g0) + + real(r8) :: qtmp(-grid%im/3:grid%im+grid%im/3) + real(r8) :: qtmpv(-grid%im/3:grid%im+grid%im/3, grid%jfirst-1:grid%jn2g0) + real(r8) :: slope(-grid%im/3:grid%im+grid%im/3) + real(r8) :: al(-grid%im/3:grid%im+grid%im/3) + real(r8) :: ar(-grid%im/3:grid%im+grid%im/3) + real(r8) :: a6(-grid%im/3:grid%im+grid%im/3) + + real(r8) :: p1ke, p2ke + + logical :: ffsl(grid%jm) + logical :: sldv(grid%jfirst-1:grid%jn2g0) + + integer :: i, j, im2 + integer :: js2g1, js2gc1, jn2gc, jn1g1, js2g0, js2gc, jn1gc + integer :: im, jm, jfirst, jlast, jn2g0, ng_s, ng_c, ng_d + + + +! +! For convenience +! + + im = grid%im + jm = grid%jm + jfirst = grid%jfirst + jlast = grid%jlast + + jn2g0 = grid%jn2g0 + + ng_c = grid%ng_c + ng_d = grid%ng_d + ng_s = grid%ng_s + + rcap = grid%rcap + + zt_c = grid%zt_c + dydt = grid%dydt + dtdy5 = grid%dtdy5 + + sc => grid%sc + dc => grid%dc + + cosp => grid%cosp + acosp => grid%acosp + cose => grid%cose + + dxdt => grid%dxdt + dxe => grid%dxe + rdxe => grid%rdxe + dtdx2 => grid%dtdx2 + dtdx4 => grid%dtdx4 + dtxe5 => grid%dtxe5 + dycp => grid%dycp + cye => grid%cye + fc => grid%fc + + sinlon => grid%sinlon + coslon => grid%coslon + sinl5 => grid%sinl5 + cosl5 => grid%cosl5 + + +! Set loop limits + + im2 = im/2 + + js2g0 = max(2,jfirst) + js2gc = max(2,jfirst-ng_c) ! NG lats on S (starting at 2) + jn1gc = min(jm,jlast+ng_c) ! ng_c lats on N (ending at jm) + js2g1 = max(2,jfirst-1) + jn1g1 = min(jm,jlast+1) + jn2gc = min(jm-1,jlast+ng_c) ! NG latitudes on N (ending at jm-1) + js2gc1 = max(2,jfirst-ng_c+1) ! NG-1 latitudes on S (starting at 2) + +! KE at poles + if ( jfirst-ng_d <= 1 ) then + p1ke = D0_125*(u2(1, 1)**2 + v2(1, 1)**2) + endif + + if ( jlast+ng_d >= jm ) then + p2ke = D0_125*(u2(1,jm)**2 + v2(1,jm)**2) + endif + + if ( jfirst /= 1 ) then + do i=1,im + cry(i,jfirst-1) = dtdy5*vc(i,jfirst-1) + enddo + + endif + + do j=js2g0,jn1g1 ! ymass needed on NS + do i=1,im + cry(i,j) = dtdy5*vc(i,j) + ymass(i,j) = cry(i,j)*cose(j) + enddo + enddo + +! New va definition + + if (am_correction) then + do j=js2g1,jn2g0 ! va needed on S (for YCC, iv==1) + do i=1,im + ! weight by cos + va(i,j) = (cry(i,j)*cose(j)+cry(i,j+1)*cose(j+1))/(cose(j)+cose(j+1)) + end do + end do + + else + do j=js2g1,jn2g0 ! va needed on S (for YCC, iv==1) + do i=1,im + va(i,j) = 0.5_r8*(cry(i,j)+cry(i,j+1)) + end do + end do + + end if + +! SJL: Check if FFSL integer fluxes need to be computed + do j=js2gc,jn2gc ! ffsl needed on N*sg S*sg + do i=1,im + crx(i,j) = uc(i,j)*dtdx2(j) + enddo + ffsl(j) = .false. + if( cosp(j) < zt_c ) then + do i=1,im + if( abs(crx(i,j)) > D1_0 ) then + ffsl(j) = .true. +#if ( !defined UNICOSMP ) || ( !defined NEC_SX ) + exit +#endif + endif + enddo + endif + enddo + +! 2D transport of polar filtered delp (for computing fluxes!) +! Update is done on the unfiltered delp + + call tp2c( ptk, va(1,jfirst), delpf(1,jfirst-ng_c), & + crx(1,jfirst-ng_c), cry(1,jfirst), & + im, jm, iord, jord, ng_c, xfx, & + yfx, ffsl, rcap, acosp, & + crx(1,jfirst), ymass, cosp, & + 0, jfirst, jlast) + + do j=js2g0,jn2g0 ! xfx not ghosted + if( ffsl(j) ) then + do i=1,im + xfx(i,j) = xfx(i,j)/sign(max(abs(crx(i,j)),tiny),crx(i,j)) + enddo + endif + enddo + +! pt-advection using pre-computed mass fluxes +! use tm2 below as the storage for pt increment +! WS 99.09.20 : pt, crx need on N*ng S*ng, yfx on N + + call tp2c(tm2 ,va(1,jfirst), pt(1,jfirst-ng_c), & + crx(1,jfirst-ng_c), cry(1,jfirst), & + im, jm, iord, jord, ng_c, fx, & + fy(1,jfirst), ffsl, rcap, acosp, & + xfx, yfx, cosp, 1, jfirst, jlast) + +! use wk4, crx as work arrays + call pft2d(ptk(1,js2g0), sc, & + dc, im, jn2g0-js2g0+1, & + wk4, crx ) + call pft2d(tm2(1,js2g0), sc, & + dc, im, jn2g0-js2g0+1, & + wk4, crx ) + + do j=jfirst,jlast + do i=1,im + ptk(i,j) = delp(i,j) + ptk(i,j) + ptc(i,j) = (pt(i,j)*delp(i,j) + tm2(i,j))/ptk(i,j) + enddo + enddo + +!------------------ +! Momentum equation +!------------------ + + call ycc(im, jm, fy, vc(1,jfirst-2), va(1,jfirst-1), & + va(1,jfirst-1), jord, 1, jfirst, jlast) + + do j=js2g1,jn2g0 + + do i=1,im + cx1v(i,j) = dtdx4(j)*u2(i,j) + enddo + + sldv(j) = .false. + if( cosp(j) < zt_c ) then + do i=1,im + if( abs(cx1v(i,j)) > D1_0 ) then + sldv(j) = .true. +#if ( !defined UNICOSMP ) || ( !defined NEC_SX ) + exit +#endif + endif + enddo + endif + + p1dv(im,j) = uc(1,j) + do i=1,im-1 + p1dv(i,j) = uc(i+1,j) + enddo + + enddo + + call xtpv(im, sldv, fxjv, p1dv, cx1v, iord, cx1v, & + cosp, 0, slope, qtmpv, al, ar, a6, & + jfirst, jlast, js2g1, jn2g0, jm, & + jfirst-1, jn2g0, jfirst-1, jn2g0, & + jfirst-1, jn2g0, jfirst-1, jn2g0, & + jfirst-1, jn2g0, jfirst-1, jn2g0) + + do j=js2g1,jn2g0 + do i=1,im + wk1(i,j) = dxdt(j)*fxjv(i,j) + dydt*fy(i,j) + enddo + enddo + + if ( jfirst == 1 ) then + do i=1,im + wk1(i,1) = p1ke + enddo + endif + + if ( jlast == jm ) then + do i=1,im + wk1(i,jm) = p2ke + enddo + endif + +! crx redefined + do j=js2gc1,jn1gc + crx(1,j) = dtxe5(j)*u(im,j) + do i=2,im + crx(i,j) = dtxe5(j)*u(i-1,j) + enddo + enddo + + if ( jfirst /=1 ) then + do i=1,im + cry(i,jfirst-1) = dtdy5*v(i,jfirst-1) + enddo + endif + + do j=jfirst,jlast + do i=1,im + cry(i,j) = dtdy5*v(i,j) + ymass(i,j) = cry(i,j)*cosp(j) ! ymass actually unghosted + enddo + enddo + + do j=js2g0,jlast + do i=1,im + tm2(i,j) = D0_5*(cry(i,j)+cry(i,j-1)) ! cry ghosted on S + enddo + enddo + +! Compute absolute vorticity on the C-grid. + + if ( jfirst-ng_d <= 1 ) then + do i=1,im + vort_u(i,1) = D0_0 + enddo + endif + + do j=js2gc,jn2gc + do i=1,im + vort_u(i,j) = uc(i,j)*cosp(j) + enddo + enddo + + if ( jlast+ng_d >= jm ) then + do i=1,im + vort_u(i,jm) = D0_0 + enddo + endif + + do j=js2gc1,jn1gc +! The computed absolute vorticity on C-Grid is assigned to vort + vort(1,j) = fc(j) + (vort_u(1,j-1)-vort_u(1,j))*cye(j) + & + (vc(1,j) - vc(im,j))*rdxe(j) + + do i=2,im + vort(i,j) = fc(j) + (vort_u(i,j-1)-vort_u(i,j))*cye(j) + & + (vc(i,j) - vc(i-1,j))*rdxe(j) + enddo + enddo + + do j=js2gc1,jn1gc ! ffsl needed on N*ng S*(ng-1) + ffsl(j) = .false. + if( cose(j) < zt_c ) then + do i=1,im + if( abs(crx(i,j)) > D1_0 ) then + ffsl(j) = .true. +#if ( !defined UNICOSMP ) || ( !defined NEC_SX ) + exit +#endif + endif + enddo + endif + enddo + + call tpcc( tm2, ymass, vort(1,jfirst-ng_d), crx(1,jfirst-ng_c), & + cry(1,jfirst), im, jm, ng_c, ng_d, & + iord, jord, fx, fy(1,jfirst), ffsl, cose, & + jfirst, jlast, slope, qtmp, al, ar, a6 ) + + do j=js2g0,jn2g0 + uc(1,j) = uc(1,j) + dtdx2(j)*(wk1(im,j)-wk1(1,j)) + dycp(j)*fy(1,j) + do i=2,im + uc(i,j) = uc(i,j) + dtdx2(j)*(wk1(i-1,j)-wk1(i,j)) + dycp(j)*fy(i,j) + enddo + enddo + do j=js2g0,jlast + do i=1,im-1 + vc(i,j) = vc(i,j) + dtdy5*(wk1(i,j-1)-wk1(i,j))-dxe(j)*fx(i+1,j) + enddo + vc(im,j) = vc(im,j) + dtdy5*(wk1(im,j-1)-wk1(im,j))-dxe(j)*fx(1,j) + enddo +!EOC + end subroutine c_sw +!-------------------------------------------------------------------------- + + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: d_sw --- Solve the SWE on a D grid +! +! !INTERFACE: + subroutine d_sw( grid, u, v, uc, vc, & + pt, delp, delpf, cx3, cy3, & + mfx, mfy, cdx, cdy, & + cdxde, cdxdp, cdyde, cdydp, & !ldel2 variables + cdxdiv, cdydiv, cdx4, cdy4, cdtau4, & + ldiv2, ldiv4, ldel2, & + iord, jord, tiny, am_correction, & + ddp, duc, vf) +!-------------------------------------------------------------------------- +! Routine for shallow water dynamics on the D-grid + +! !USES: + + use tp_core + use pft_module, only : pft2d + + implicit none + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in):: iord + integer, intent(in):: jord + logical, intent(in) :: ldiv2,ldiv4,ldel2 !damping options + +! Prognostic variables: + real(r8), intent(inout):: u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s) + real(r8), intent(inout):: v(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) +! Delta pressure + real(r8), intent(inout):: delp(grid%im,grid%jfirst:grid%jlast) +! Potential temperature + real(r8), intent(inout):: pt(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + + real(r8), intent(inout):: delpf(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + + real(r8), intent(in):: cdx (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdy (grid%js2g0:grid%jn1g1) + ! + ! variables for div4 and del2 damping + ! + real(r8), intent(in):: cdx4 (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdy4 (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdtau4(grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdxde (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdxdp (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdydp (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdyde (grid%js2g0:grid%jn1g1) + real(r8), intent(in):: cdxdiv(grid%jm) + real(r8), intent(in):: cdydiv(grid%jm) + + real(r8), intent(in):: tiny + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: uc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent(inout):: vc(grid%im,grid%jfirst-2 :grid%jlast+2 ) + real(r8), intent(inout):: cx3(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d)! Accumulated Courant number in X + real(r8), intent(inout):: cy3(grid%im,grid%jfirst:grid%jlast+1) ! Accumulated Courant number in Y + real(r8), intent(inout):: mfx(grid%im,grid%jfirst:grid%jlast) ! Mass flux in X (unghosted) + real(r8), intent(inout):: mfy(grid%im,grid%jfirst:grid%jlast+1) ! Mass flux in Y + + ! AM correction + logical, intent(in) :: am_correction ! logical switch for correction (generate out args) + real(r8), intent(out) :: ddp(grid%im,grid%jfirst:grid%jlast) + real(r8), intent(out) :: duc(grid%im,grid%jfirst:grid%jlast) + real(r8), intent(out) :: vf(grid%im,grid%jfirst-2:grid%jlast+2 ) + +! !DESCRIPTION: +! +! Routine for shallow water dynamics on the D-grid +! +! !REVISION HISTORY: +! WS 2003.11.19 Merged in CAM changes by Mirin +! WS 2004.10.07 Added ProTeX documentation +! WS 2005.07.05 Simplified interface using grid +! +!EOP +!----------------------------------------------------------------------- +!BOC + + +! Local + integer :: im + integer :: jm + integer :: jfirst + integer :: jlast + integer :: js2g0 + integer :: jn1g1 + integer :: ng_d + integer :: ng_s + integer :: nq + + real(r8) :: zt_d + real(r8) :: tdy5 + real(r8) :: rdy + real(r8) :: dtdy + real(r8) :: dtdy5 + real(r8) :: rcap + + real(r8), pointer:: sc(:) + real(r8), pointer:: dc(:,:) + real(r8), pointer:: se(:) + real(r8), pointer:: de(:,:) + + real(r8), pointer :: cosp(:) + real(r8), pointer :: acosp(:) + real(r8), pointer :: cose(:) + + real(r8), pointer :: sinlon(:) + real(r8), pointer :: coslon(:) + real(r8), pointer :: sinl5(:) + real(r8), pointer :: cosl5(:) + + real(r8), pointer :: dtdx(:) + real(r8), pointer :: dtdxe(:) + real(r8), pointer :: dx(:) + real(r8), pointer :: rdx(:) + real(r8), pointer :: cy(:) + real(r8), pointer :: dyce(:) + real(r8), pointer :: dtxe5(:) + real(r8), pointer :: txe5(:) + + real(r8), pointer :: f0(:) + + real(r8) fx(grid%im,grid%jfirst:grid%jlast) + real(r8) xfx(grid%im,grid%jfirst:grid%jlast) + + !for del2 damping + real(r8) :: wku(grid%im,grid%jfirst-1:grid%jlast+1) + real(r8) :: wkv(grid%im,grid%jfirst-1:grid%jlast+1) + + !for div4 damping + real(r8) :: wkdiv4(grid%im+2,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_s) + real(r8) :: wk2div4(grid%im+1,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_s) + + real(r8) wk1(grid%im,grid%jfirst-1:grid%jlast+1) + + real(r8) cry(grid%im,grid%jfirst-1:grid%jlast+1) + real(r8) fy(grid%im,grid%jfirst-2:grid%jlast+2)!halo changed for div4 + + real(r8) ymass(grid%im,grid%jfirst: grid%jlast+1) + real(r8) yfx(grid%im,grid%jfirst: grid%jlast+1) + + real(r8) va(grid%im,grid%jfirst-1:grid%jlast) + real(r8) ub(grid%im,grid%jfirst: grid%jlast+1) + + ! AM correction + real(r8) :: dfx(grid%im,grid%jfirst:grid%jlast) + real(r8) :: dfy(grid%im,grid%jfirst-2:grid%jlast+2) + real(r8) :: dvdx(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + + real(r8) crx(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) +#if defined(FILTER_MASS_FLUXES) + real(r8) u2(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8) v2(grid%im+2,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) +#endif + + real(r8) fxjv(grid%im,grid%jfirst-1:grid%jn1g1) + real(r8) qtmpv(-grid%im/3:grid%im+grid%im/3, grid%jfirst-1:grid%jn1g1) + real(r8) slope(-grid%im/3:grid%im+grid%im/3) + real(r8) al(-grid%im/3:grid%im+grid%im/3) + real(r8) ar(-grid%im/3:grid%im+grid%im/3) + real(r8) a6(-grid%im/3:grid%im+grid%im/3) + + real(r8) c1, c2 + real(r8) uanp(grid%im), uasp(grid%im), vanp(grid%im), vasp(grid%im) + real(r8) un, vn, us, vs, r2im + + real(r8) div (grid%im,grid%jfirst-1:grid%jlast+2) !for div4 damping + real(r8) div4(grid%im,grid%jfirst-1:grid%jlast+1) !for div4 damping + + logical ffsl(grid%jm) + logical sldv(grid%jfirst-1:grid%jn1g1) + + real(r8):: deldiv !for div4 + + + integer i, j + integer js2gd, jn2g0, jn2g1, jn2gd, jn1gd + integer jn2g2 !for extra halo for div4 + integer js2gs, jn1gs + integer im2 + +! +! For convenience +! + nq = grid%nq + + im = grid%im + jm = grid%jm + jfirst = grid%jfirst + jlast = grid%jlast + ng_d = grid%ng_d + ng_s = grid%ng_s + js2g0 = grid%js2g0 + jn1g1 = grid%jn1g1 + + rcap = grid%rcap + zt_d = grid%zt_d + tdy5 = grid%tdy5 + rdy = grid%rdy + dtdy = grid%dtdy + dtdy5 = grid%dtdy5 + + sc => grid%sc + dc => grid%dc + se => grid%se + de => grid%de + + cosp => grid%cosp + acosp => grid%acosp + cose => grid%cose + + sinlon => grid%sinlon + coslon => grid%coslon + sinl5 => grid%sinl5 + cosl5 => grid%cosl5 + + dtdx => grid%dtdx + dtdxe => grid%dtdxe + dx => grid%dx + rdx => grid%rdx + cy => grid%cy + dyce => grid%dyce + dtxe5 => grid%dtxe5 + txe5 => grid%txe5 + + f0 => grid%f0 + +! Set loop limits + + jn2g0 = min(jm-1,jlast) + jn2g1 = min(jm-1,jlast+1) + jn2g2 = min(jm-1,jlast+2) + + js2gd = max(2,jfirst-ng_d) ! NG latitudes on S (starting at 1) + jn2gd = min(jm-1,jlast+ng_d) ! NG latitudes on S (ending at jm-1) + jn1gd = min(jm,jlast+ng_d) ! NG latitudes on N (ending at jm) + js2gs = max(2,jfirst-ng_s) + jn1gs = min(jm,jlast+ng_s) ! NG latitudes on N (ending at jm) + +! Get C-grid U-wind at poles. + im2 = im/2 + r2im = 0.5_r16/real(im,r16) + + if ( jfirst <= 1 ) then +! +! Treat SP +! + do i=1,im-1 + uasp(i) = uc(i,2) + uc(i+1,2) + vasp(i) = vc(i,2) + vc(i,3) + enddo + uasp(im) = uc(im,2) + uc(1,2) + vasp(im) = vc(im,2) + vc(im,3) + +! Projection at SP + + us = D0_0 + vs = D0_0 + do i=1,im2 + us = us + (uasp(i+im2)-uasp(i))*sinlon(i) & + + (vasp(i)-vasp(i+im2))*coslon(i) + vs = vs + (uasp(i+im2)-uasp(i))*coslon(i) & + + (vasp(i+im2)-vasp(i))*sinlon(i) + enddo + us = us*r2im + vs = vs*r2im + +! get U-wind at SP + + do i=1,im2 + uc(i, 1) = -us*sinl5(i) - vs*cosl5(i) + uc(i+im2, 1) = -uc(i, 1) + enddo + + endif + + if ( jlast >= jm ) then +! +! Treat NP +! + do i=1,im-1 + uanp(i) = uc(i,jm-1) + uc(i+1,jm-1) + vanp(i) = vc(i,jm-1) + vc(i,jm) + enddo + uanp(im) = uc(im,jm-1) + uc(1,jm-1) + vanp(im) = vc(im,jm-1) + vc(im,jm) + +! Projection at NP + + un = D0_0 + vn = D0_0 + do i=1,im2 + un = un + (uanp(i+im2)-uanp(i))*sinlon(i) & + + (vanp(i+im2)-vanp(i))*coslon(i) + vn = vn + (uanp(i)-uanp(i+im2))*coslon(i) & + + (vanp(i+im2)-vanp(i))*sinlon(i) + enddo + un = un*r2im + vn = vn*r2im + +! get U-wind at NP + + do i=1,im2 + uc(i,jm) = -un*sinl5(i) + vn*cosl5(i) + uc(i+im2,jm) = -uc(i,jm) + enddo + + endif + + do j=js2gd,jn2gd ! crx needed on N*ng S*ng + do i=1,im + crx(i,j) = dtdx(j)*uc(i,j) + enddo + enddo + + do j=js2gd,jn2gd ! ffsl needed on N*ng S*ng + ffsl(j) = .false. + if( cosp(j) < zt_d ) then + do i=1,im + if( abs(crx(i,j)) > D1_0 ) then + ffsl(j) = .true. +#if ( !defined UNICOSMP ) || ( !defined NEC_SX ) + exit +#endif + endif + enddo + endif + enddo + + do j=js2g0,jn1g1 ! cry, ymass needed on N + do i=1,im + cry(i,j) = dtdy*vc(i,j) + ymass(i,j) = cry(i,j)*cose(j) + enddo + enddo + + do j=js2g0,jn2g0 ! No ghosting + do i=1,im + if( cry(i,j)*cry(i,j+1) > D0_0 ) then + if( cry(i,j) > D0_0 ) then + va(i,j) = cry(i,j) + else + va(i,j) = cry(i,j+1) ! cry ghosted on N + endif + else + va(i,j) = D0_0 + endif + enddo + enddo + +! transport polar filtered delp + call tp2c(ub(1,jfirst), va(1,jfirst), delpf(1,jfirst-ng_d), & + crx(1,jfirst-ng_d),cry(1,jfirst),im,jm,iord,jord, & + ng_d, xfx, yfx, ffsl, & + rcap, acosp,crx(1,jfirst), ymass, & + cosp, 0, jfirst, jlast) + +#if defined(FILTER_MASS_FLUXES) + call pft2d( xfx(1,js2g0), sc, dc, im, jn2g0-js2g0+1, & + v2, u2 ) + call pft2d( yfx(1,js2g0), se, de, im, jn1g1-js2g0+1, & + v2, u2 ) + do j=js2g0,jn2g0 + do i=1,im-1 + ub(i,j) = xfx(i,j) - xfx(i+1,j) + (yfx(i,j)-yfx(i,j+1))*acosp(j) + enddo + ub(im,j) = xfx(im,j) - xfx(1,j) + (yfx(im,j)-yfx(im,j+1))*acosp(j) + enddo +#endif + + ! AM correction + do j = jfirst, jlast + do i = 1, im + ddp(i,j) = 0.0_r8 + duc(i,j) = 0.0_r8 + end do + end do + + if (am_correction) then + do j = js2g0, jn2g0 + do i = 1, im-1 + ddp( i,j) = (xfx(i+1,j) - xfx(i ,j)) + end do + ddp(im,j) = (xfx( 1,j) - xfx(im,j)) + end do + end if ! am_correction + +! <<< Save necessary data for large time step tracer transport >>> + if( nq > 0 ) then + do j=js2g0,jn2g0 ! No ghosting needed + do i=1,im + cx3(i,j) = cx3(i,j) + crx(i,j) + mfx(i,j) = mfx(i,j) + xfx(i,j) + enddo + enddo + + do j=js2g0,jlast ! No ghosting needed + do i=1,im + cy3(i,j) = cy3(i,j) + cry(i,j) + mfy(i,j) = mfy(i,j) + yfx(i,j) + enddo + enddo + endif + do j=js2g0,jn2g0 ! No ghosting needed + if( ffsl(j) ) then + do i=1,im + xfx(i,j) = xfx(i,j)/sign(max(abs(crx(i,j)),tiny),crx(i,j)) + enddo + endif + enddo + +! Update delp + do j=jfirst,jlast + do i=1,im + ! SAVE old delp: pressure thickness ~ "air density" + wk1(i,j) = delp(i,j) + delp(i,j) = wk1(i,j) + ub(i,j) + enddo + enddo + +! pt Advection + call tp2c(ub(1,jfirst),va(1,jfirst),pt(1,jfirst-ng_d), & + crx(1,jfirst-ng_d),cry(1,jfirst), & + im,jm,iord,jord,ng_d,fx,fy(1,jfirst), & + ffsl, rcap, acosp, & + xfx, yfx(1,jfirst), cosp, 1, jfirst,jlast) + +! Update pt. + do j=jfirst,jlast + do i=1,im + pt(i,j) = (pt(i,j)*wk1(i,j)+ub(i,j)) / delp(i,j) + enddo + enddo + +! Compute upwind biased kinetic energy at the four cell corners + +! Start using ub as v (CFL) on B-grid (cell corners) + ! ub here is average over updated C-grid points (involving + ! 6 D-grid points) instead of 2 non-updated D-grid points + do j=js2g0,jn1g1 ! ub needed on N + ub(1,j) = dtdy5*(vc(1,j) + vc(im,j)) + do i=2,im + ub(i,j) = dtdy5*(vc(i,j) + vc(i-1,j)) + enddo + enddo + + call ytp(im, jm, fy(1,jfirst), v(1,jfirst-ng_d), ub(1,jfirst), & + ub(1,jfirst), ng_d, jord, 1, jfirst, jlast) +! End using ub as v (CFL) on B-grid + + do j=js2g0,jn1g1 ! ub needed on N + do i=1,im + ub(i,j) = dtxe5(j)*(uc(i,j) + uc(i,j-1)) +! uc will be used as work array after this point + enddo + enddo + + do j=js2g0,jn1g1 ! wk1 needed on N + sldv(j) = .false. + if( cose(j) < zt_d ) then + do i=1,im + if( abs(ub(i,j)) > D1_0 ) then ! ub ghosted on N + sldv(j) = .true. +#if ( !defined UNICOSMP ) || ( !defined NEC_SX ) + exit +#endif + endif + enddo + endif + enddo + + call xtpv(im, sldv, fxjv, u, ub, iord, ub, cose, & + 0, slope, qtmpv, al, ar, a6, & + jfirst, jlast, js2g0, jn1g1, jm, & + jfirst-1, jn1g1, jfirst-1, jn1g1, & + jfirst-ng_d, jlast+ng_s, jfirst, jlast+1, & + jfirst, jlast+1, jfirst-1, jn1g1) + do j=js2g0,jn1g1 ! wk1 needed on N + do i=1,im + wk1(i,j) = txe5(j)*fxjv(i,j) + tdy5*fy(i,j) ! fy ghosted on N + enddo + enddo + +! Add divergence damping to vector invariant form of the momentum eqn +! (absolute vorticity is damped by ffsl scheme, therefore divergence damping +! provides more consistent dissipation to divergent part of the flow) + +!-------------------------- +! Perform divergence damping +!-------------------------- + + if (ldiv2) then + ! + ! standard div2 damping + ! + do j=max(2,jfirst-1), jn2g1 ! fy need on NS (below) + do i=1,im + ! + ! cosp is cosine(theta) at cell center discretized from the identity + ! + ! cos(theta) = d(sin(theta))/d(theta) + ! + ! as + ! + ! cosp = (sine(j+1)-sine(j))/dp where dp = pi/(jm-1) + ! + fy(i,j) = v(i,j)*cosp(j) ! v ghosted on NS at least + enddo + enddo + + do j=js2g0,jn1g1 + ! i=1 + uc(1,j) = u(im,j) - u(1,j) ! u ghosted on N at least + do i=2,im + uc(i,j) = u(i-1,j) - u(i,j) + enddo + enddo + + if ( jfirst == 1 ) then + ! j=2 + do i=1,im + wk1(i,2) = wk1(i,2) - cdy(2)*fy(i, 2) + cdx(2)*uc(i,2) + enddo + endif + + do j=max(3,jfirst),jn2g1 ! wk1 needed on N (after TP2D) + do i=1,im + wk1(i,j) = wk1(i,j) + cdy(j)*(fy(i,j-1) - fy(i,j)) & + + cdx(j)*uc(i,j) + enddo + enddo + + if ( jlast == jm ) then + do i=1,im + wk1(i,jm) = wk1(i,jm) + cdy(jm)*fy(i,jm-1) + cdx(jm)*uc(i,jm) + enddo + endif + end if + + if (ldiv4) then + ! + ! filter velocity components for stability + ! + call pft2d(u(1,js2gd), grid%sediv4, grid%dediv4, im, jn1gs-js2gd+1, & + wkdiv4, wk2div4 ) + + call pft2d(v(1,js2gs), grid%scdiv4, grid%dcdiv4, im, jn2gd-js2gs+1, & + wkdiv4, wk2div4 ) + + !************************************************************************** + ! + ! div4 damping + ! + !************************************************************************** + + do j=max(2,jfirst-2), min(jm-1,grid%jlast+2) ! fy need on NS (below) + do i=1,im + fy(i,j) = v(i,j)*cosp(j) ! v ghosted on NS at least + enddo + enddo + + do j=max(2,jfirst-1),min(jm,grid%jlast+2) + ! i=1 + uc(1,j) = u(im,j) - u(1,j) ! u ghosted on N at least + do i=2,im + uc(i,j) = u(i-1,j) - u(i,j) + enddo + enddo + ! + ! compute divergence + ! + if ( jfirst == 1 ) then + ! j=2 + do i=1,im + div(i,2) = - cdydiv(2)*fy(i, 2) + cdxdiv(2)*uc(i,2) + enddo + endif + + do j=max(3,jfirst-1),min(jm-1,grid%jlast+2) ! wk1 needed on N (after TP2D) + do i=1,im + div(i,j) = cdydiv(j)*(fy(i,j-1) - fy(i,j)) + cdxdiv(j)*uc(i,j) + enddo + enddo + + if ( jlast == jm ) then + do i=1,im + div(i,jm) = cdydiv(jm)*fy(i,jm-1) + cdxdiv(jm)*uc(i,jm) + enddo + endif + + if ( jfirst == 1 ) then + i=1 + j=2 + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(im ,j ))+& + cdy4(j) * (cosp(j)*(div(i,j+1)-div(i,j))) + wk1(i,j) = wk1(i,j) +cdtau4(j)*deldiv + do i=2,im-1 + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * (cosp(j )*(div(i ,j+1)-div(i ,j))) + wk1(i,j) = wk1(i,j) + cdtau4(j)*deldiv + enddo + i=im + deldiv = cdx4(j) * (div(1 ,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * (cosp(j )*(div(i,j+1)-div(i,j))) + wk1(i,j) = wk1(i,j) + cdtau4(j)*deldiv + endif + + do j=max(3,jfirst),jn2g1 ! wk1 needed on N (after TP2D) + i=1 + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(im ,j ))+& + cdy4(j) * ( & + cosp(j )*(div(i ,j+1)-div(i,j ))-& + cosp(j-1)*(div(i ,j )-div(i,j-1))) + wk1(i,j) = wk1(i,j) +cdtau4(j)*deldiv + do i=2,im-1 + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * ( & + cosp(j )*(div(i ,j+1)-div(i ,j ))-& + cosp(j-1)*(div(i ,j )-div(i ,j-1))) + wk1(i,j) = wk1(i,j) + cdtau4(j)*deldiv + enddo + i=im + deldiv = cdx4(j) * (div(1 ,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * ( & + cosp(j )*(div(i ,j+1)-div(i,j ))-& + cosp(j-1)*(div(i ,j )-div(i,j-1))) + wk1(i,j) = wk1(i,j) + cdtau4(j)*deldiv + enddo + + if ( jlast == jm ) then + i=1 + j = jm + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(im,j ))+& + cdy4(j) * (-cosp(j-1)*(div(i,j)-div(i,j-1))) + wk1(i,j) = wk1(i,j) +cdtau4(j)*deldiv + do i=2,im-1 + deldiv = cdx4(j) * (div(i+1,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * (-cosp(j-1)*(div(i,j)-div(i,j-1))) + wk1(i,j) = wk1(i,j) + cdtau4(j)*deldiv + enddo + i=im + j=jm + deldiv = cdx4(j) * (div(1,j )-D2_0*div(i,j)+div(i-1,j ))+& + cdy4(j) * (-cosp(j-1)*(div(i,j)-div(i,j-1))) + wk1(i,j) = wk1(i,j) +cdtau4(j)*deldiv + endif + end if + + wku(:,:) = D0_0 + wkv(:,:) = D0_0 + if (ldel2) then + !************************************************************************** + ! + ! regular del2 (Laplacian) damping + ! + !************************************************************************** + if ( jfirst == 1 ) then + i=1 + j=2 + wku(i,j) = cdxde(j)* (u(i+1,j )-D2_0*u(i,j)+u(im ,j ))+& + cdyde(j)* (cosp(j )*(u(i ,j+1)-u(i ,j))) + wkv(i,j) = cdxdp(j) * (v(i+1,j )-D2_0*v(i,j)+v(im,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i,j ))-& + cose(j )*(v(i ,j ) )) + !line above: there is no v(i,j-1) since it is on the pole + do i=2,im-1 + wku(i,j) = cdxde(j) * (u(i+1,j )-D2_0*u(i,j)+u(i-1,j ))+& + cdyde(j) * (cosp(j )*(u(i ,j+1)-u(i ,j))) + wkv(i,j) = cdxdp(j) * (v(i+1,j )-D2_0*v(i,j)+v(i-1,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i,j ))-& + cose(j )*(v(i ,j ) )) + enddo + i=im + wku(i,j) = cdxde(j) * (u(1 ,j )-D2_0*u(i,j)+u(i-1,j ))+& + cdyde(j) * (cosp(j )*(u(i ,j+1)-u(i ,j))) + wkv(i,j) = cdxdp(j) * (v(1,j )-D2_0*v(i,j)+v(i-1 ,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i,j ))-& + cose(j )*(v(i ,j ) )) + endif + + do j=max(3,jfirst),jn2g1 ! wk1 needed on N (after TP2D) + i=1 + wku(i,j) = cdxde(j) * (u(i+1,j )-D2_0*u(i,j)+u(im ,j ))+& + cdyde(j) * ( & + cosp(j )*(u(i ,j+1)-u(i,j ))-& + cosp(j-1)*(u(i ,j )-u(i,j-1))) + wkv(i,j) = cdxdp(j) * (v(i+1,j )-D2_0*v(i,j)+v(im ,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i,j ))-& + cose(j )*(v(i ,j )-v(i,j-1))) + do i=2,im-1 + wku(i,j) = cdxde(j) * (u(i+1,j )-D2_0*u(i,j)+u(i-1,j ))+& + cdyde(j) * ( & + cosp(j )*(u(i ,j+1)-u(i ,j ))-& + cosp(j-1)*(u(i ,j )-u(i ,j-1))) + wkv(i,j) = cdxdp(j) * (v(i+1,j )-D2_0*v(i,j)+v(i-1,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i ,j ))-& + cose(j )*(v(i ,j )-v(i ,j-1))) + enddo + i=im + wku(i,j) = cdxde(j) * (u(1 ,j )-D2_0*u(i,j)+u(i-1,j ))+& + cdyde(j) * ( & + cosp(j )*(u(i ,j+1)-u(i,j ))-& + cosp(j-1)*(u(i ,j )-u(i,j-1))) + wkv(i,j) = cdxdp(j) * (v(1 ,j )-D2_0*v(i,j)+v(i-1,j ))+& + cdydp(j) * ( & + cose(j+1)*(v(i ,j+1)-v(i,j ))-& + cose(j )*(v(i ,j )-v(i,j-1))) + enddo + + if ( jlast == jm ) then + i=1 + j = jm + wku(i,jm) = cdxde(j) * (u(i+1,j )-D2_0*u(i,j)+u(im,j ))+& + cdyde(j) * (-cosp(j-1)*(u(i,j)-u(i,j-1))) + do i=2,im-1 + wku(i,jm) = cdxde(j) * (u(i+1,j)-D2_0*u(i,j)+u(i-1,j))+& + cdyde(j) * (-cosp(j-1)*(u(i,j)-u(i,j-1))) + enddo + i=im + j=jm + wku(i,jm) = cdxde(j) * (u(1,j)-D2_0*u(i,j)+u(i-1,j))+& + cdyde(j) * (-cosp(j-1)*(u(i,j)-u(i,j-1))) + endif + end if + +!------------------------------------ +! End divergence damping computation +!------------------------------------ + + +! Compute Vorticity on the D grid +! delpf used as work array + + do j=js2gd,jn1gd + do i=1,im + delpf(i,j) = u(i,j)*cose(j) ! u ghosted on N*ng S*ng + enddo + enddo + + if ( jfirst-ng_d <= 1 ) then + c1 = D0_0 + do i=1,im + c1 = c1 + delpf(i,2) + end do + c1 = -c1*rdy*rcap + do i=1,im + uc(i,1) = c1 + enddo + endif + + if ( jlast+ng_d >= jm ) then + c2 = D0_0 + do i=1,im + c2 = c2 + delpf(i,jm) + end do + c2 = c2*rdy*rcap + do i=1,im + uc(i,jm) = c2 + enddo + else +! This is an attempt to avoid ghosting u on N*(ng+1) + do i=1,im + uc(i,jn2gd) = D1E30 + enddo + endif + + do j=js2gd, min(jm-1,jlast+ng_d-1) + do i=1,im-1 + uc(i ,j) = ( delpf(i,j) - delpf(i ,j+1)) * cy(j) + & + (v(i+1,j) - v(i ,j)) * rdx(j) + enddo + uc(im,j) = (delpf(im,j) - delpf(im,j+1)) * cy(j) + & + (v( 1 ,j) - v(im,j)) * rdx(j) + enddo + +! uc is relative vorticity at this point + + do j=max(1,jfirst-ng_d), jn1gd + do i=1,im + uc(i,j) = uc(i,j) + f0(j) + ! uc is absolute vorticity + enddo + enddo + + call tp2d(va(1,jfirst), uc(1,jfirst-ng_d), crx(1,jfirst-ng_d), & + cry(1,jfirst), im, jm, iord, jord, ng_d, fx, & + fy (1,jfirst), ffsl, crx(1,jfirst), & + ymass, cosp, 0, jfirst, jlast) + + do j = jfirst-2, jlast+2 + do i = 1, im + vf (i,j) = 0.0_r8 + end do + end do + + ! AM correction + if (am_correction) then + + if (jlast+ng_d >= jm) then + do i = 1, im + dvdx(i,jm) = 0.0_r8 + end do + else + do i = 1, im + dvdx(i,jn2gd) = 0.0_r8 + end do + end if + + if (jfirst-ng_d <= 1) then + do i = 1, im + dvdx(i,1) = 0.0_r8 + end do + end if + + do j = js2gd, min(jm-1, jlast+ng_d-1) + do i = 1, im-1 + dvdx( i,j) = (v(i+1,j) - v(i ,j)) * rdx(j) + end do + dvdx(im,j) = (v( 1,j) - v(im,j)) * rdx(j) + end do + + call tp2d(va(1,jfirst),dvdx(1,jfirst-ng_d), crx(1,jfirst-ng_d), & + cry(1,jfirst), im, jm, iord, jord, ng_d,dfx, & + dfy(1,jfirst), ffsl, crx(1,jfirst), & + ymass, cosp, 0, jfirst, jlast) + + do j = js2g0, jlast + do i = 1, im + duc(i,j) = dyce(j)*dfy(i,j) + end do + end do + + do j = js2g0, jlast + do i=1,im + vf(i,j) = dyce(j)*(fy(i,j)-dfy(i,j)) + enddo + enddo + + do j = js2g0, jlast + do i = 1, im-1 + duc( i,j) = dtdxe(j)*(wk1(i+1,j)-wk1(i ,j)) -duc( i,j) -wku( i,j) + end do + duc(im,j) = dtdxe(j)*(wk1( 1,j)-wk1(im,j)) -duc(im,j) -wku(im,j) + end do + + end if ! am_correction + + do j = js2g0, jlast + do i=1,im-1 + uc(i ,j) = dtdxe(j)*(wk1(i ,j)-wk1(i+1,j)) +dyce(j)*fy(i ,j) +wku(i ,j) + enddo + uc(im,j) = dtdxe(j)*(wk1(im,j)-wk1( 1,j)) +dyce(j)*fy(im,j) +wku(im,j) + enddo + + do j = js2g0, jn2g0 + do i=1,im + vc(i,j) = dtdy*(wk1(i,j)-wk1(i,j+1)) -dx(j)*fx(i,j) +wkv(i,j) + enddo + enddo + + end subroutine d_sw +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: d2a2c_winds --- Interpolate winds +! +! !INTERFACE: + subroutine d2a2c_winds(grid, u, v, ua, va, uc, vc, u_cen, v_cen, & + reset_winds, met_rlx, am_correction) + + implicit none + +! !PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid + + real(r8), intent(in ):: u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s) + real(r8), intent(inout):: v(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + real(r8), intent( out):: ua(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent( out):: va(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + real(r8), intent( out):: uc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent( out):: vc(grid%im,grid%jfirst-2:grid%jlast+2 ) + +! cell centered winds + logical , intent(in):: reset_winds + real(r8), intent(in):: u_cen(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) + real(r8), intent(in):: v_cen(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d) + real(r8), intent(in):: met_rlx + logical, intent(in):: am_correction + +! !DESCRIPTION: +! +! Calculate the cell-centered (A-grid) winds and the cell-wall perpendicular +! (C-grid) winds from the cell-wall parallel (D-grid) winds. +! +! This routine assumes that U and V have complete haloes! As a result, +! the A-grid and C-grid results should have complete haloes from +/- ng_c +! (which is generally smaller than ng_d). This feature has not been +! thoroughly tested. +! +! !REVISION HISTORY: +! WP 2007.06.01 Creation +! WS 2007.07.03 Added ProTeX documentation, removed unused vars. +! WS 2009.04.15 Fixed numerous problems in indexing bounds +! +!EOP +!----------------------------------------------------------------------- +!BOC + + real(r8) us, vs, un, vn + real(r8) uanp(grid%im), uasp(grid%im), vanp(grid%im), vasp(grid%im), r2im + + real(r8), pointer:: sinlon(:) + real(r8), pointer:: coslon(:) + real(r8), pointer:: sinl5(:) + real(r8), pointer:: cosl5(:) + + ! AM correction + real(r8), pointer:: cosp(:) + real(r8), pointer:: acosp(:) + real(r8), pointer:: cose(:) + + integer :: i, j, im2 + integer :: im, jm, jfirst, jlast, ng_s, ng_c, ng_d + integer :: jn1gc, js1gc, jn2gc, js2gc ! ng_c ghosted bounds + integer :: js2gd, jn2gd ! ng_d ghosted bounds + integer :: js2gs, jn2gsm1 ! ng_s ghosted bounds + integer :: js2g2, jn1g2 ! 2-lat ghosted bounds + + im = grid%im + jm = grid%jm + jfirst = grid%jfirst + jlast = grid%jlast + + ng_c = grid%ng_c + ng_d = grid%ng_d + ng_s = grid%ng_s + + im2 = im/2 + + js1gc = max(1,jfirst-ng_c) ! ng_c lats on S (starting at 1) + jn1gc = min(jm,jlast+ng_c) ! ng_c latitudes on N (ending at jm) + js2gc = max(2,jfirst-ng_c) ! ng_c lats on S (starting at 2) + jn2gc = min(jm-1,jlast+ng_c) ! ng_c latitudes on N (ending at jm-1) + js2gs = max(2,jfirst-ng_s) ! ng_s latitudes on S (starting at 2) + jn2gsm1= min(jm-1,jlast+ng_s-1) ! ng_s-1 latitudes on N (ending at jm-1) + js2gd = max(2,jfirst-ng_d) ! ng_d latitudes on S (starting at 2) + jn2gd = min(jm-1,jlast+ng_d) ! ng_d latitudes on N (ending at jm-1) + js2g2 = max(2,jfirst-2) ! 2 latitudes on S (starting at 2) + jn1g2 = min(jm,jlast+2) ! 2 latitudes on N (ending at jm) + + sinlon => grid%sinlon + coslon => grid%coslon + sinl5 => grid%sinl5 + cosl5 => grid%cosl5 + + ! AM correction + cosp => grid%cosp + acosp => grid%acosp + cose => grid%cose + +! Get D-grid V-wind at the poles. + + r2im = 0.5_r16/real(im,r16) + + if ( jfirst-ng_d <= 1 ) then + +! +! Treat SP +! + do i=1,im-1 + uasp(i) = u(i,2) + u(i,3) + vasp(i) = v(i,2) + v(i+1,2) + enddo + + uasp(im) = u(im,2) + u(im,3) + vasp(im) = v(im,2) + v(1,2) + +! Projection at SP + + us = D0_0 + vs = D0_0 + + do i=1,im2 + us = us + (uasp(i+im2)-uasp(i))*sinlon(i) & + + (vasp(i)-vasp(i+im2))*coslon(i) + vs = vs + (uasp(i+im2)-uasp(i))*coslon(i) & + + (vasp(i+im2)-vasp(i))*sinlon(i) + enddo + us = us*r2im + vs = vs*r2im + +! get V-wind at SP + + do i=1,im2 + v(i, 1) = us*cosl5(i) - vs*sinl5(i) + v(i+im2,1) = -v(i, 1) + enddo + + endif + + if ( jlast+ng_d >= jm ) then + +! +! Treat NP +! + do i=1,im-1 + uanp(i) = u(i,jm-1) + u(i,jm) + vanp(i) = v(i,jm-1) + v(i+1,jm-1) + enddo + + uanp(im) = u(im,jm-1) + u(im,jm) + vanp(im) = v(im,jm-1) + v(1,jm-1) + +! Projection at NP + + un = D0_0 + vn = D0_0 + do i=1,im2 + un = un + (uanp(i+im2)-uanp(i))*sinlon(i) & + + (vanp(i+im2)-vanp(i))*coslon(i) + vn = vn + (uanp(i)-uanp(i+im2))*coslon(i) & + + (vanp(i+im2)-vanp(i))*sinlon(i) + enddo + un = un*r2im + vn = vn*r2im + +! get V-wind at NP + + do i=1,im2 + v(i,jm) = -un*cosl5(i) - vn*sinl5(i) + v(i+im2,jm) = -v(i,jm) + enddo + + endif + + ua(:,:) = D0_0 + va(:,:) = D0_0 + + do j=js2gs,jn2gd + do i=1,im-1 + va(i,j) = v(i,j) + v(i+1,j) + enddo + va(im,j) = v(im,j) + v(1,j) + enddo + + if (am_correction) then + do j = js2gd, jn2gsm1 + do i = 1, im + ua(i,j) =(u(i,j)*cose(j) + u(i,j+1)*cose(j+1))/cosp(j) ! curl free -> curl free + end do + end do + else + do j = js2gd, jn2gsm1 ! WS: should be safe since u defined to jn2gs + do i = 1, im + ua(i,j) = u(i,j) + u(i,j+1) ! solid body -> solid body + end do + end do + end if +! +! reset cell center winds to the offline meteorlogy data +! + + if ( reset_winds .and. met_rlx > D0_0 ) then + ua(:,:) = (D1_0-met_rlx)*ua(:,:) + met_rlx*( D2_0*u_cen(:,:) ) + va(:,:) = (D1_0-met_rlx)*va(:,:) + met_rlx*( D2_0*v_cen(:,:) ) + endif + + if ( jfirst-ng_d <= 1 ) then +! Projection at SP + us = D0_0 + vs = D0_0 + + + do i=1,im2 + us = us + (ua(i+im2,2)-ua(i ,2))*sinlon(i) & + + (va(i ,2)-va(i+im2,2))*coslon(i) + vs = vs + (ua(i+im2,2)-ua(i ,2))*coslon(i) & + + (va(i+im2,2)-va(i ,2))*sinlon(i) + enddo + + us = us/im + vs = vs/im + + ! SP + do i=1,im2 + ua(i,1) = -us*sinlon(i) - vs*coslon(i) + va(i,1) = us*coslon(i) - vs*sinlon(i) + ua(i+im2,1) = -ua(i,1) + va(i+im2,1) = -va(i,1) + enddo + + endif + + if ( jlast+ng_d >= jm ) then + +! Projection at NP + un = D0_0 + vn = D0_0 + + j = jm-1 + do i=1,im2 + un = un + (ua(i+im2,j)-ua(i ,j))*sinlon(i) & + + (va(i+im2,j)-va(i ,j))*coslon(i) + vn = vn + (ua(i ,j)-ua(i+im2,j))*coslon(i) & + + (va(i+im2,j)-va(i ,j))*sinlon(i) + enddo + + un = un/im + vn = vn/im + + ! NP + do i=1,im2 + ua(i,jm) = -un*sinlon(i) + vn*coslon(i) + va(i,jm) = -un*coslon(i) - vn*sinlon(i) + ua(i+im2,jm) = -ua(i,jm) + va(i+im2,jm) = -va(i,jm) + enddo + + endif + + +! A -> C + do j=js1gc,jn1gc ! uc needed N*ng_c S*ng_c, ua defined at poles + uc(1,j) = D0_25*(ua(1,j)+ua(im,j)) + do i=2,im + uc(i,j) = D0_25*(ua(i,j)+ua(i-1,j)) + enddo + enddo + + if (am_correction) then + do j = js2g2, jn1g2 ! vc needed N*2, S*2 (for ycc), va defined at poles + do i = 1, im + vc(i,j) = D0_25*(va(i,j)*cosp(j) + va(i,j-1)*cosp(j-1))/cose(j) ! div free -> div free + end do + end do + else + do j = js2g2, jn1g2 + do i = 1, im + vc(i,j) = D0_25*(va(i,j) + va(i,j-1)) + end do + end do + end if + + if ( jfirst==1 ) then + do i=1,im + vc(i,1) = D0_0 ! Needed to avoid undefined values in VC + enddo + endif +!EOC + end subroutine d2a2c_winds +!----------------------------------------------------------------------- + end module sw_core diff --git a/src/dynamics/fv/te_map.F90 b/src/dynamics/fv/te_map.F90 new file mode 100644 index 0000000000..04fc3a1b72 --- /dev/null +++ b/src/dynamics/fv/te_map.F90 @@ -0,0 +1,1200 @@ +module te_map_mod + +implicit none +save +private +public :: te_map + +contains +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: te_map --- Map vertical Lagrangian coordinates to normal grid +! +! !INTERFACE: + + subroutine te_map(grid, consv, convt, ps, omga, & + pe, delp, pkz, pk, mdt, & + nx, u, v, pt, tracer, & + hs, cp3v, cap3v, kord, peln, & + te0, te, dz, mfx, mfy, & + uc, vc, du_s, du_w, & + am_correction, am_diag_lbl) +! +! !USES: + + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmd_utils, only : masterproc + use dynamics_vars, only : T_FVDYCORE_GRID + use mapz_module, only : map1_cubic_te, map1_ppm, mapn_ppm_tracer + use cam_logfile, only : iulog + use cam_abortutils,only : endrun + +#if defined( SPMD ) + use mod_comm, only : mp_send3d, mp_recv3d +#endif + use phys_control, only: waccmx_is !WACCM-X runtime switch + use physconst, only: physconst_calc_kappav + use par_vecsum_mod,only: par_vecsum + + implicit none + +#if defined( SPMD ) +#define CPP_PRT_PREFIX if(grid%iam==0) +#else +#define CPP_PRT_PREFIX +#endif + +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(inout) :: grid ! grid for XY decomp + logical consv ! flag to force TE conservation + logical convt ! flag to control pt output (see below) + integer mdt ! mapping time step (same as phys) + integer nx ! number of SMP "decomposition" in x + real(r8) hs(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface geopotential + real(r8) te0 + +! !INPUT/OUTPUT PARAMETERS: + real(r8) pk(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! pe to the kappa + real(r8) u(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! u-wind (m/s) + real(r8) v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! v-wind (m/s) +! tracers including specific humidity +!!! real(r8) q(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) + + real(r8), intent(inout) :: & + cp3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! C_p + real(r8), intent(inout) :: & + cap3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! cappa + + real(r8), intent(inout) :: & + tracer(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) ! Tracer array + real(r8) pe(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! pressure at layer edges + real(r8) ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface pressure + real(r8) pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! virtual potential temperature as input + ! Output: virtual temperature if convt is true + ! false: output is (virtual) potential temperature + real(r8) te(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! Work array (cache performance) + real(r8) dz(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! Work array (cache performance) + real(r8) mfx(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) mfy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + +! !OUTPUT PARAMETERS: + real(r8) delp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! pressure thickness + real(r8) omga(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy) ! vertical press. velocity (pascal/sec) + real(r8) peln(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! log(pe) + real(r8) pkz(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! layer-mean pk for converting t to pt + + ! AM conservation mods + logical, intent(in) :: am_correction ! logical switch for AM correction + logical, intent(in) :: am_diag_lbl ! input + + real(r8), intent(in) :: du_s(grid%km) + real(r8), intent(inout), allocatable :: du_w(:,:,:) + + real(r8), intent(inout), allocatable :: uc(:,:,:) + real(r8), intent(inout), allocatable :: vc(:,:,:) + +! !DESCRIPTION: +! +! !REVISION HISTORY: +! +! WS 99.05.19 : Replaced IMR, JMR, JNP and NL with IM, JM-1, JM and KM +! WS 99.05.25 : Revised conversions with IMR and JMR; removed fvcore.h +! WS 99.07.29 : Reduced computation region to grid%jfirstxy:jlast +! WS 99.07.30 : Tested concept with message concatenation of te_map calls +! WS 99.10.01 : Documentation; indentation; cleaning +! SJL 99.12.31: SMP "decomposition" in-E-W direction +! WS 00.05.14 : Renamed ghost indices as per Kevin's definitions +! WS 00.07.13 : Changed PILGRIM API +! AM 00.08.29 : Variables in this routine will ultimately be decomposed in (i,j). +! AM 01.06.13 : 2-D decomposition; reordering summation causes roundoff difference. +! WS 01.06.10 : Removed "if(first)" section in favor of a variable module +! AM 01.06.27 : Merged yz decomposition technology into ccm code. +! WS 02.01.14 : Upgraded to mod_comm +! WS 02.04.22 : Use mapz_module from FVGCM +! WS 02.04.25 : New mod_comm interfaces +! WS 03.08.12 : Introduced unorth +! WS 03.11.19 : Merged in CAM changes by Mirin +! WS 03.12.03 : Added GRID as argument, dynamics_vars removed +! WS 04.08.25 : Simplified interface by using GRID +! WS 04.10.07 : Removed dependency on spmd_dyn; info now in GRID +! WS 05.03.25 : Changed tracer to type T_TRACERS +! WS 05.04.12 : Call mapn_ppm_tracer instead of mapn_ppm +! AT 05.05.11 : Merged with the version Cerebus (unique pole issues) +! WS 05.05.18 : Merged CAM and GEOS5 versions (mostly GEOS5) +! LT 05.11.14 : Call map1_cubic_te for Cubic Interpolation of Total Energy +! WP 06.01.18 : Added calls to map1_ppm for horizontal mass fluxes +! LT 06.02.08 : Implement code for partial remapping option +! WS 06.11.29 : Merge CAM/GEOS5; magic numbers isolated +! CC 07.01.29 : Additions for proper calculation of OMGA +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + +! Magic numbers used in this module + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_25 = 0.25_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + real(r8), parameter :: D10_0 = 10.0_r8 + real(r8), parameter :: D1E4 = 1.0e4_r8 + + integer :: im, jm, km ! x, y, z dimensions + integer :: nq ! number of tracers to be advected + integer :: ifirst, ilast ! starting & ending longitude index + integer :: jfirst, jlast ! starting & ending latitude index + integer :: myidxy_y, iam + integer :: nprxy_x, nprxy_y + +! Local variables for Partial Remapping +! ------------------------------------- + real(r8) :: pref(grid%km+1) + real(r8) :: zz(grid%km+1) + real(r8) :: z1,z2 + + real(r8), parameter :: alf = 0.042_r8 + real(r8), parameter :: pa = 1.0_r8 + real(r8), parameter :: pb = 500.0_r8 + real(r8), parameter :: psurf = 100001.0_r8 + real(r8), parameter :: bet = D2_0*alf/(D1_0+alf) + + real(r8), parameter :: lagrangianlevcrit = 1.0e-11_r8 ! Criteria for "Lagrangian levels are crossing" error + +! Local arrays: +! ------------- + real(r8) rmin(nx*grid%jm), rmax(nx*grid%jm) + real(r8) tte(grid%jm) +! x-y + real(r8) u2(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy+1) + real(r8) v2(grid%ifirstxy:grid%ilastxy+1,grid%jfirstxy:grid%jlastxy) + real(r8) t2(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + real(r8) veast(grid%jfirstxy:grid%jlastxy,grid%km) +! y-z + real(r8) pe0(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) pe1(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) pe2(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) pe3(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) u2_sp(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) v2_sp(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) t2_sp(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) u2_np(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) v2_np(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) t2_np(grid%ifirstxy:grid%ilastxy,grid%km) + +! Log of pe1/pe2. + real(r8) log_pe1(grid%ifirstxy:grid%ilastxy,grid%km+1) + real(r8) log_pe2(grid%ifirstxy:grid%ilastxy,grid%km+1) + +! x + real(r8) gz(grid%ifirstxy:grid%ilastxy) + real(r8) ratio(grid%ifirstxy:grid%ilastxy) + real(r8) bte(grid%ifirstxy:grid%ilastxy) +! z + real(r8) pe1w(grid%km+1) + real(r8) pe2w(grid%km+1) + + ! AM correction + ! variable for zonal momentum + real(r8) :: dum(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) + + real(r8) cap3vi(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! cappa interface + + integer i1w, nxu + integer i, j, k, js2g0, jn2g0, jn1g1 + integer kord + integer krd + + real(r8) dak, bkh, qmax, qmin + real(r8) te_sp(grid%km), te_np(grid%km) + real(r8) xysum(grid%jfirstxy:grid%jlastxy,2) + real(r8) tmpik(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) tmpij(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,2) + real(r8) omga_ik(grid%ifirstxy:grid%ilastxy,grid%km) ! vertical press. velocity (tmp 2-d array) + real(r8) dtmp + real(r8) sum + real(r8) te1 + real(r8) dlnp + + integer ixj, jp, it, i1, i2 + +#if defined( SPMD ) + integer :: dest, src + real(r8) unorth(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) pewest(grid%km+1,grid%jfirstxy:grid%jlastxy) + real(r8), allocatable :: pesouth(:,:) +#endif + + integer comm_use, npry_use, itot + + logical diag + logical :: high_alt + + data diag /.false./ + + z1 = log(pa/psurf) + z2 = log(pb/psurf) + + high_alt = grid%high_alt + + im = grid%im + jm = grid%jm + km = grid%km + nq = grid%nq + + ifirst = grid%ifirstxy + ilast = grid%ilastxy + jfirst = grid%jfirstxy + jlast = grid%jlastxy + + iam = grid%iam + myidxy_y = grid%myidxy_y + nprxy_x = grid%nprxy_x + nprxy_y = grid%nprxy_y + +! Intialize PREF for Partial Remapping (above 100-mb) +! ----------------------------------------------------------- + do k=1,km+1 + pref(k) = grid%ak(k) + grid%bk(k)*psurf + enddo + zz = log( pref/psurf ) + zz = D10_0*(zz-z2)/z1 + zz = (D1_0-bet)*tanh(zz) + +! WS 99.07.27 : Set loop limits appropriately +! -------------------------------------------- + js2g0 = max(2,jfirst) + jn1g1 = min(jm,jlast+1) + jn2g0 = min(jm-1,jlast) + do j=jfirst,jlast + xysum(j,1) = D0_0 + xysum(j,2) = D0_0 + enddo + do j=jfirst,jlast + do i=ifirst,ilast + tmpij(i,j,1) = D0_0 + tmpij(i,j,2) = D0_0 + enddo + enddo + do k=1,km + do i=ifirst,ilast + tmpik(i,k) = D0_0 + enddo + enddo + + itot = ilast-ifirst+1 + nxu = 1 + if (itot == im) nxu = nx + +#if defined( SPMD ) + comm_use = grid%commxy_y + npry_use = nprxy_y + + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km, & + ifirst, ilast, jfirst, jlast, 1, km, & + ifirst, ilast, jfirst, jfirst, 1, km, u ) +! Nontrivial x decomposition + if (itot /= im) then + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirst, ilast, jfirst, jlast, 1,km, & + ifirst, ifirst, jfirst, jlast, 1, km, v ) + endif +#endif + call pkez(nxu, im, km, jfirst, jlast, 1, km, ifirst, ilast, & + pe, pk, cap3v, grid%ks, peln, pkz, .false., high_alt) + +! Single subdomain case (periodic) + do k=1,km + do j=jfirst,jlast + veast(j,k) = v(ifirst,j,k) + enddo + enddo +#if defined( SPMD ) + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirst, ilast, jlast+1, jlast+1, 1, km, & + ifirst, ilast, jlast+1, jlast+1, 1, km, unorth ) +! Nontrivial x decomposition + if (itot /= im) then + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilast+1, ilast+1, jfirst, jlast, 1, km, & + ilast+1, ilast+1, jfirst, jlast, 1, km, veast ) + dest = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, km+1, jm, & + ifirst, ilast, 1, km+1, jfirst, jlast, & + ilast, ilast, 1, km+1, jfirst, jlast, pe ) + endif + call mp_send3d( grid%commxy, iam+nprxy_x, iam-nprxy_x, im, km+1,jm, & + ifirst, ilast, 1, km+1, jfirst, jlast, & + ifirst, ilast, 1, km+1, jlast, jlast, pe ) +#endif + + if (high_alt) then + call physconst_calc_kappav( ifirst,ilast,jfirst,jlast,1,km, grid%ntotq, tracer, cap3v, cpv=cp3v) + endif + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j, k, u2, v2, t2) + +! Compute cp*T + KE + + do 1000 k=1,km + + do j=js2g0,jlast + do i=ifirst,ilast + u2(i,j) = u(i,j,k)**2 + enddo + enddo +#if defined( SPMD ) + if ( jlast < jm ) then + do i=ifirst,ilast + u2(i,jlast+1) = unorth(i,k)**2 ! fill ghost zone + enddo + endif +#endif + + do j=js2g0,jn2g0 + do i=ifirst,ilast + v2(i,j) = v(i,j,k)**2 + enddo + v2(ilast+1,j) = veast(j,k)**2 + enddo + + do j=jfirst,jlast + do i=ifirst,ilast + ! convert to Cv*T + t2(i,j) = (cp3v(i,j,k)-cap3v(i,j,k)*cp3v(i,j,k))*pt(i,j,k) + enddo + enddo + + do j=js2g0,jn2g0 + do i=ifirst,ilast + te(i,j,k) = D0_25 * ( u2(i,j) + u2(i,j+1) + & + v2(i,j) + v2(i+1,j) ) + & + t2(i,j)*pkz(i,j,k) + enddo + enddo + +! WS 99.07.29 : Restructuring creates small round-off. Not clear why... + +! Do collective Mpisum (in i) for te_sp and te_np below (AAM) +! + if ( jfirst == 1 ) then +! South pole + do i=ifirst,ilast + u2_sp(i,k) = u2(i,2) + v2_sp(i,k) = v2(i,2) + t2_sp(i,k) = t2(i,1) + enddo + endif + + if ( jlast == jm ) then +! North pole + do i=ifirst,ilast + u2_np(i,k) = u2(i,jm) + v2_np(i,k) = v2(i,jm-1) + t2_np(i,k) = t2(i,jm) + enddo + endif + +! Compute dz; geo-potential increments + do j=jfirst,jlast + do i=ifirst,ilast + dz(i,j,k) = t2(i,j)*(pk(i,j,k+1)-pk(i,j,k)) + enddo + enddo +1000 continue + +#if defined( SPMD ) + allocate( pesouth(ifirst:ilast,km+1) ) + if (itot /= im) then + call mp_recv3d( grid%commxy, src, im, km+1, jm, & + ifirst-1, ifirst-1, 1, km+1, jfirst, jlast, & + ifirst-1, ifirst-1, 1, km+1, jfirst, jlast, pewest ) + endif + call mp_recv3d( grid%commxy, iam-nprxy_x, im, km+1, jm, & + ifirst, ilast, 1, km+1, jfirst-1, jfirst-1, & + ifirst, ilast, 1, km+1, jfirst-1, jfirst-1, pesouth ) +#endif + + if ( jfirst == 1 ) then + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + do i=ifirst,ilast + tmpik(i,k) = D0_5*( u2_sp(i,k) + v2_sp(i,k) ) + t2_sp(i,k)*pkz(i,1,k) + enddo + enddo + + call par_xsum( grid, tmpik, km, te_sp) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + te_sp(k) = te_sp(k)/real(im,r8) + do i=ifirst,ilast + te(i, 1,k) = te_sp(k) + enddo + enddo + endif + + if ( jlast == jm ) then + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + do i=ifirst,ilast + tmpik(i,k) = D0_5*( u2_np(i,k) + v2_np(i,k) ) + t2_np(i,k)*pkz(i,jm,k) + enddo + enddo + + call par_xsum( grid, tmpik, km, te_np) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + te_np(k) = te_np(k)/real(im,r8) + do i=ifirst,ilast + te(i,jm,k) = te_np(k) + enddo + enddo + endif + + ! Converting pt to t + do i=ifirst,ilast + do j=jfirst,jlast + do k=1,km + pt(i,j,k) = pt(i,j,k)*pkz(i,j,k) + enddo + enddo + enddo + + it = itot / nxu + jp = nxu * ( jlast - jfirst + 1 ) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k,i1w,pe0,pe1,pe2,pe3,log_pe1,log_pe2,ratio) & +!$omp private(dak,bkh,krd, ixj,i1,i2) & +!$omp private(pe1w, pe2w, omga_ik ) + +! do 2000 j=jfirst,jlast + do 2000 ixj=1,jp + + j = jfirst + (ixj-1) / nxu + i1 = ifirst + it * mod(ixj-1, nxu) + i2 = i1 + it - 1 + +! Copy data to local 2D arrays. + i1w = i1-1 + if (i1 == 1) i1w = im + do k=1,km+1 + do i=i1,i2 + pe1(i,k) = pe(i,k,j) + if (k>1) then + if (pe1(i,k)-pe1(i,k-1) jfirst) then + do k=2,km+1 + do i=i1,i2 + ! extensive integral weight -> use cosines + pe0(i,k) = (pe1(i,k)*grid%cosp(j) + pe(i,k,j-1)*grid%cosp(j-1)) & + / (grid%cosp(j) + grid%cosp(j-1)) + enddo + enddo + do k=grid%ks+2,km+1 + bkh = D0_5*grid%bk(k) + do i=i1,i2 + pe3(i,k) = grid%ak(k) + grid%bk(k)*(pe1(i,km+1)*grid%cosp(j) + & + pe(i,km+1,j-1)*grid%cosp(j-1)) / & + (grid%cosp(j) + grid%cosp(j-1)) + enddo + enddo + +#if defined( SPMD ) + else + ! WS 99.10.01 : Read in pe(:,:,jfirst-1) from the pesouth buffer + do k=2,km+1 + do i=i1,i2 + pe0(i,k) = (pe1(i,k)*grid%cosp(j) + pesouth(i,k)*grid%cosp(j-1)) & + / (grid%cosp(j) + grid%cosp(j-1)) + enddo + enddo + do k=grid%ks+2,km+1 + bkh = D0_5*grid%bk(k) + do i=i1,i2 + pe3(i,k) = grid%ak(k) + grid%bk(k)*(pe1(i,km+1)*grid%cosp(j) + & + pesouth(i,km+1)*grid%cosp(j-1)) / & + (grid%cosp(j) + grid%cosp(j-1)) + enddo + enddo +#endif + endif ! (j > jfirst) + + ! total zonal momentum + do i=i1,i2 + dum(i,j)=0._r8 + enddo + do k=1,km + do i=i1,i2 + dum(i,j)=dum(i,j)-u(i,j,k)*(pe0(i,k+1)-pe0(i,k)) + enddo + enddo + + else ! not am_correction + + ! WS 99.07.29 : protect j==jfirst case + if (j > jfirst) then + do k=2,km+1 + do i=i1,i2 + pe0(i,k) = D0_5*(pe1(i,k)+pe(i,k,j-1)) + enddo + enddo + do k=grid%ks+2,km+1 + bkh = D0_5*grid%bk(k) + do i=i1,i2 + pe3(i,k) = grid%ak(k) + bkh*(pe1(i,km+1)+pe(i,km+1,j-1)) + enddo + enddo +#if defined( SPMD ) + else + ! WS 99.10.01 : Read in pe(:,:,jfirst-1) from the pesouth buffer + do k=2,km+1 + do i=i1,i2 + pe0(i,k) = D0_5*(pe1(i,k)+pesouth(i,k)) + enddo + enddo + do k=grid%ks+2,km+1 + bkh = D0_5*grid%bk(k) + do i=i1,i2 + pe3(i,k) = grid%ak(k) + bkh*(pe1(i,km+1)+pesouth(i,km+1)) + enddo + enddo +#endif + endif ! (j > jfirst) + + endif ! (am_correction) + +!------------------------------- + +! ReMap U-Wind (D-Grid Location) +! ------------------------------ + call map1_ppm ( km, pe0, u, km, pe3, u, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + + if (am_correction) then + + ! compute zonal momentum difference due to remapping + do k=1,km + do i=i1,i2 + dum(i,j)=dum(i,j)+u(i,j,k)*(pe3(i,k+1)-pe3(i,k)) + enddo + enddo + + ! correct zonal wind to preserve momentum + do k=1,km + do i=i1,i2 + u(i,j,k)=u(i,j,k)-dum(i,j)/(pe3(i,km+1)-pe3(i,1)) + enddo + enddo + endif + + if (am_diag_lbl) then + + ! Remap advective wind increment uc + + call map1_ppm ( km, pe0, uc, km, pe3, uc, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + + do k=1,km + do i=i1,i2 + du_w(i,j,k)=du_s(k) + enddo + enddo + call map1_ppm ( km, pe0, du_w, km, pe3, du_w, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + endif + +! ReMap Y-Mass Flux (C-Grid Location) +! ----------------------------------- + do k=1,km + do i=i1,i2 + mfy(i,j,k) = mfy(i,j,k)/(pe0(i,k+1)-pe0(i,k)) + enddo + enddo + call map1_ppm ( km, pe0, mfy, km, pe3, mfy, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + do k=1,km + do i=i1,i2 + mfy(i,j,k) = mfy(i,j,k)*(pe3(i,k+1)-pe3(i,k)) + enddo + enddo + endif + +! ####################################################################### +! # ReMap V-Wind +! ####################################################################### + + if(j /= 1 .and. j /= jm) then + do k=2,km+1 +! pe1(i1-1,1:km+1) must be ghosted + pe0(i1,k) = D0_5*(pe1(i1,k)+pe1w(k)) + do i=i1+1,i2 + pe0(i ,k) = D0_5*(pe1(i,k)+pe1(i-1,k)) + enddo + enddo + + do k=grid%ks+2,km+1 +! pe2(i1-1,grid%ks+2:km+1) must be ghosted + pe3(i1,k) = D0_5*(pe2(i1,k)+pe2w(k)) + do i=i1+1,i2 + pe3(i,k) = D0_5*(pe2(i,k)+pe2(i-1,k)) + enddo + enddo + +! ReMap V-Wind (D-Grid Location) +! ------------------------------ + call map1_ppm ( km, pe0, v, km, pe3, v, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + + + if (am_diag_lbl) then + call map1_ppm ( km, pe0, vc, km, pe3, vc, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + end if + +! ReMap X-Mass Flux (C-Grid Location) +! ----------------------------------- + do k=1,km + do i=i1,i2 + mfx(i,j,k) = mfx(i,j,k)/(pe0(i,k+1)-pe0(i,k)) + enddo + enddo + call map1_ppm ( km, pe0, mfx, km, pe3, mfx, & + 0, 0, itot, i1-ifirst+1, i2-ifirst+1, & + j, jfirst, jlast, -1, kord) + do k=1,km + do i=i1,i2 + mfx(i,j,k) = mfx(i,j,k)*(pe3(i,k+1)-pe3(i,k)) + enddo + enddo + endif + +! Save new PE to temp storage peln +! -------------------------------- + do k=2,km + do i=i1,i2 + peln(i,k,j) = pe2(i,k) + enddo + enddo + +! Check deformation. + if( diag ) then + rmax(ixj) = D0_0 + rmin(ixj) = D1_0 + do k=1,km + do i=i1,i2 + ratio(i) = (pe1(i,k+1)-pe1(i,k)) / (pe2(i,k+1)-pe2(i,k)) + enddo + + do i=i1,i2 + if(ratio(i) > rmax(ixj)) then + rmax(ixj) = ratio(i) + elseif(ratio(i) < rmin(ixj)) then + rmin(ixj) = ratio(i) + endif + enddo + enddo + endif +2000 continue + + if (high_alt) then + call physconst_calc_kappav( ifirst,ilast,jfirst,jlast,1,km,grid%ntotq, tracer, cap3v, cpv=cp3v) + !$omp parallel do private(i,j,k) + do k=2,km + do j=jfirst,jlast + do i=ifirst,ilast + cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k)) + enddo + enddo + enddo + cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2) + cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1) + else + cap3vi(:,:,:) = cap3v(grid%ifirstxy,grid%jfirstxy,1) + endif + +#if defined( SPMD ) + deallocate( pesouth ) + +! Send u southward + call mp_send3d( grid%commxy, iam-nprxy_x, iam+nprxy_x, im, jm, km,& + ifirst, ilast, jfirst, jlast, 1, km, & + ifirst, ilast, jfirst, jfirst, 1, km, u ) + if (itot /= im) then + dest = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, jm, km, & + ifirst, ilast, jfirst, jlast, 1, km, & + ifirst, ifirst, jfirst, jlast, 1, km, v ) + endif +#endif + + if( diag ) then + qmin = rmin(1) + do ixj=2, jp + if(rmin(ixj) < qmin) then + qmin = rmin(ixj) + endif + enddo + CPP_PRT_PREFIX write(iulog,*) 'rmin=', qmin + + qmax = rmax(1) + do ixj=2, jp + if(rmax(ixj) > qmax) then + qmax = rmax(ixj) + endif + enddo + CPP_PRT_PREFIX write(iulog,*) 'rmax=', qmax + endif + +! Recover Final Edge-Pressures and Compute Mid-Level PKZ +! ------------------------------------------------------ + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k) + + do j=jfirst,jlast + do k=2,km + do i=ifirst,ilast + pe(i,k,j) = peln(i,k,j) + enddo + enddo + enddo + + do k=1,km+1 + do j=jfirst,jlast + do i=ifirst,ilast + pk(i,j,k) = pe(i,k,j)**cap3vi(i,j,k) + enddo + enddo + enddo + call pkez(nxu, im, km, jfirst, jlast, 1, km, ifirst, ilast, & + pe, pk, cap3v, grid%ks, peln, pkz, .false., high_alt) + +! Single x-subdomain case (periodic) + do k = 1, km + do j = jfirst, jlast + veast(j,k) = v(ifirst,j,k) + enddo + enddo + +#if defined( SPMD ) +! Recv u from north + call mp_recv3d( grid%commxy, iam+nprxy_x, im, jm, km, & + ifirst, ilast, jlast+1, jlast+1, 1, km, & + ifirst, ilast, jlast+1, jlast+1, 1, km, unorth ) + if (itot /= im) then + call mp_recv3d( grid%commxy, src, im, jm, km, & + ilast+1, ilast+1, jfirst, jlast, 1, km, & + ilast+1, ilast+1, jfirst, jlast, 1, km, veast ) + endif +#endif + +! ((((((((((((((((( compute globally integrated TE ))))))))))))))))) + + if( consv ) then + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k) + + do k=1,km + do j=jfirst,jlast + do i=ifirst,ilast + dz(i,j,k) = te(i,j,k) * delp(i,j,k) + enddo + enddo + enddo + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k,bte) + +! Perform vertical integration + + do 4000 j=jfirst,jlast + + if ( j == 1 ) then +! SP + tte(1) = D0_0 + + do k=1,km + tte(1) = tte(1) + dz(ifirst,1,k) + enddo + + elseif ( j == jm) then +! NP + tte(jm) = D0_0 + + do k=1,km + tte(jm) = tte(jm) + dz(ifirst,jm,k) + enddo + + else +! Interior + do i=ifirst,ilast + bte(i) = D0_0 + enddo + + do k=1,km + do i=ifirst,ilast + bte(i) = bte(i) + dz(i,j,k) + enddo + enddo + + do i=ifirst,ilast + tmpij(i,j,1) = bte(i) + enddo + + endif +4000 continue + + call par_xsum( grid, tmpij, jlast-jfirst+1, xysum) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(j) + + do j = max(jfirst,2), min(jlast,jm-1) + tte(j) = xysum(j,1)*grid%cosp(j) + enddo + + if ( jfirst == 1 ) tte(1) = grid%acap * tte(1) + if ( jlast == jm ) tte(jm) = grid%acap * tte(jm) + + te1 = D0_0 + call par_vecsum(jm, jfirst, jlast, tte, te1, comm_use, npry_use) + + endif ! consv + + if( consv ) then + +!$omp parallel do & +!$omp& default(shared) & +!$omp& private(i,j) + + do j=js2g0, jn2g0 + do i=ifirst,ilast + tmpij(i,j,1) = ps(i,j) + tmpij(i,j,2) = peln(i,km+1,j) + enddo + enddo + + call par_xsum( grid, tmpij, 2*(jlast-jfirst+1), xysum) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(j) + + do j=js2g0, jn2g0 + tte(j) = cp3v(ifirst,j,1)*grid%cosp(j)*(xysum(j,1) - grid%ptop*real(im,r8) - & + cap3v(ifirst,j,1)*grid%ptop*(xysum(j,2) - peln(ifirst,1,j)*real(im,r8)) ) +! peln(i,1,j) should be independent of i (AAM) + enddo + + if ( jfirst == 1 ) tte(1) = grid%acap*cp3v(ifirst,1,km) * (ps(ifirst,1) - grid%ptop - & + cap3v(ifirst,1,km)*grid%ptop*(peln(ifirst,km+1,1) - peln(ifirst,1,1) ) ) + if ( jlast == jm ) tte(jm)= grid%acap*cp3v(ifirst,jm,km) * (ps(ifirst,jm) - grid%ptop - & + cap3v(ifirst,jm,km)*grid%ptop*(peln(ifirst,km+1,jm) - peln(ifirst,1,jm) ) ) + endif ! consv + + if (consv) then + + sum=D0_0 + call par_vecsum(jm, jfirst, jlast, tte, sum, comm_use, npry_use) + + dtmp = (te0 - te1) / sum + if( diag ) then + CPP_PRT_PREFIX write(iulog,*) 'te=',te0, ' Energy deficit in T = ', dtmp + endif + + endif ! end consv check + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i,j,k, u2, v2) + +! -------------------------------------------------------------------- +! --- Recover Tv from remapped Total Energy and its components --- +! -------------------------------------------------------------------- + + do 8000 k=1,km + +! Intialize Kinetic Energy +! ------------------------ + do j=js2g0,jlast + do i=ifirst,ilast + u2(i,j) = u(i,j,k)**2 + enddo + enddo +#if defined( SPMD ) + if ( jlast < jm ) then + do i=ifirst,ilast + u2(i,jlast+1) = unorth(i,k)**2 ! fill ghost zone + enddo + endif +#endif + + do j=js2g0,jn2g0 + do i=ifirst,ilast + v2(i,j) = v(i,j,k)**2 + enddo + v2(ilast+1,j) = veast(j,k)**2 + enddo + +! Subtract Kinetic Energy from Total Energy (Leaving Internal + Potential) +! ------------------------------------------------------------------------ + do j=js2g0,jn2g0 + do i=ifirst,ilast + te(i,j,k) = D0_25 * ( u2(i,j) + u2(i,j+1) & + +v2(i,j) + v2(i+1,j) ) + enddo + enddo + +! South pole +! ---------- + if ( jfirst == 1 ) then + do i=ifirst,ilast + u2_sp(i,k) = u2(i,2) + v2_sp(i,k) = v2(i,2) + enddo + endif + +! North pole +! ---------- + if ( jlast == jm ) then + do i=ifirst,ilast + u2_np(i,k) = u2(i,jm) + v2_np(i,k) = v2(i,jm-1) + enddo + endif + +8000 continue + +! South pole +! ---------- + if ( jfirst == 1 ) then + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + do i=ifirst,ilast + tmpik(i,k) = D0_5*( u2_sp(i,k) + v2_sp(i,k) ) + enddo + enddo + + call par_xsum( grid, tmpik, km, te_sp) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + te_sp(k) = te_sp(k)/real(im,r8) + do i=ifirst,ilast + te(i,1,k) = te_sp(k) + enddo + enddo + endif + +! North pole +! ---------- + if ( jlast == jm ) then + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + do i=ifirst,ilast + tmpik(i,k) = D0_5*( u2_np(i,k) + v2_np(i,k) ) + enddo + enddo + + call par_xsum( grid, tmpik, km, te_np) + +!$omp parallel do & +!$omp default(shared) & +!$omp private(i, k) + + do k = 1, km + te_np(k) = te_np(k)/real(im,r8) + do i=ifirst,ilast + te(i,jm,k) = te_np(k) + enddo + enddo + endif + + + if( .not. convt ) then + do i=ifirst,ilast + do j=jfirst,jlast + do k=1,km + pt(i,j,k) = pt(i,j,k)/pkz(i,j,k) ! Scaled Virtual Potential Temperature + enddo + enddo + enddo + endif + + return +!EOC + end subroutine te_map +!----------------------------------------------------------------------- +end module te_map_mod diff --git a/src/dynamics/fv/tp_core.F90 b/src/dynamics/fv/tp_core.F90 new file mode 100644 index 0000000000..1265dc1582 --- /dev/null +++ b/src/dynamics/fv/tp_core.F90 @@ -0,0 +1,2610 @@ +#if defined( UNICOSMP ) || defined ( NEC_SX ) +#define VECTORIZE +#endif +module tp_core +!BOP +! +! !MODULE: tp_core --- Utilities for the transport core +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + +! +! !PUBLIC MEMBER FUNCTIONS: + public tp2c, tp2d, xtp, xtpv, fxppm, xmist, steepx, lmppm + public huynh, ytp, ymist, fyppm, tpcc, ycc +! +! !DESCRIPTION: +! +! This module provides +! +! \begin{tabular}{|l|l|} \hline \hline +! tp2c & \\ \hline +! tp2d & \\ \hline +! xtp & \\ \hline +! fxppm & \\ \hline +! xmist & \\ \hline +! steepx & \\ \hline +! lmppm & \\ \hline +! huynh & \\ \hline +! ytp & \\ \hline +! ymist & \\ \hline +! fyppm & \\ \hline +! tpcc & \\ \hline +! ycc & \\ \hline +! \hline +! \end{tabular} +! +! !REVISION HISTORY: +! 01.01.15 Lin Routines coalesced into this module +! 01.03.26 Sawyer Additional ProTeX documentation +! 03.11.19 Sawyer Merged in CAM changes by Mirin +! 04.10.07 Sawyer ompinner now from dynamics_vars +! 05.03.25 Todling shr_kind_r8 can only be referenced once (MIPSpro-7.4.2) +! 05.05.25 Sawyer Merged CAM and GEOS5 versions (mostly CAM) +! 06.09.06 Sawyer Turned "magic numbers" into F90 parameters +! +!EOP +!----------------------------------------------------------------------- + +! Magic numbers used in this module + + private + real(r8), parameter :: D0_0 = 0.0_r8 + real(r8), parameter :: D0_05 = 0.05_r8 + real(r8), parameter :: D0_25 = 0.25_r8 + real(r8), parameter :: D0_5 = 0.5_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D2_0 = 2.0_r8 + real(r8), parameter :: D3_0 = 3.0_r8 + real(r8), parameter :: D4_0 = 4.0_r8 + real(r8), parameter :: D8_0 = 8.0_r8 + real(r8), parameter :: D12_0 = 12.0_r8 + real(r8), parameter :: D24_0 = 24.0_r8 + +CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: tp2c --- Perform transport on a C grid +! +! !INTERFACE: + subroutine tp2c(dh, va, h, crx, cry, im, jm, & + iord, jord, ng, fx, fy, ffsl, & + rcap, acosp, xfx, yfx, cosp, id, jfirst, jlast) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer iord, jord ! Interpolation order in x,y + integer ng ! Max. NS dependencies + integer id ! density (0) (mfx = C) + real (r8) rcap ! Ask S.-J. (polar constant?) + real (r8) acosp(jm) ! Ask S.-J. (difference to cosp??) + logical ffsl(jm) ! Use flux-form semi-Lagrangian trans.? + ! (N*NG S*NG) + real (r8) cosp(jm) ! Critical angle + real (r8) va(im,jfirst:jlast) ! Courant (unghosted) + real (r8) h(im,jfirst-ng:jlast+ng) ! Pressure ( N*NG S*NG ) + real (r8) crx(im,jfirst-ng:jlast+ng) ! Ask S.-J. ( N*NG S*NG ) + real (r8) cry(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) + real (r8) xfx(im,jfirst:jlast) ! Ask S.-J. ( unghosted like FX ) + real (r8) yfx(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) + +! !OUTPUT PARAMETERS: + real (r8) dh(im,jfirst:jlast) ! Ask S.-J. ( unghosted ) + real (r8) fx(im,jfirst:jlast) ! Flux in x ( unghosted ) + real (r8) fy(im,jfirst:jlast+1) ! Flux in y ( N, see tp2c ) + +! !DESCRIPTION: +! Perform transport on a C grid. The number of ghost +! latitudes (NG) depends on what method (JORD) will be used +! subsequentally. NG is equal to MIN(ABS(JORD),3). +! Ask S.-J. how exactly this differs from TP2C. +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- +!BOC + integer i, j, js2g0, jn2g0 + real (r8) sum1 + + js2g0 = max(2,jfirst) ! No ghosting + jn2g0 = min(jm-1,jlast) ! No ghosting + + call tp2d(va, h, crx, cry, im, jm, iord, jord, ng,fx, fy, ffsl, & + xfx, yfx, cosp, id, jfirst, jlast) + + do j=js2g0,jn2g0 + do i=1,im-1 + dh(i,j) = fx(i,j) - fx(i+1,j) + (fy(i,j)-fy(i,j+1))*acosp(j) + enddo + dh(im,j) = fx(im,j) - fx(1,j) + (fy(im,j)-fy(im,j+1))*acosp(j) + enddo + +! Poles + if ( jfirst == 1 ) then +! sum1 = - SUM( fy(1:im, 2) ) * rcap + sum1 = D0_0 + do i=1,im + sum1 = sum1 + fy(i,2) + enddo + sum1 = -sum1*rcap + do i=1,im + dh(i, 1) = sum1 + enddo + endif + + if ( jlast == jm ) then +! sum1 = SUM( fy(1:im,jm) ) * rcap + sum1 = D0_0 + do i=1,im + sum1 = sum1 + fy(i,jm) + enddo + sum1 = sum1*rcap + do i=1,im + dh(i,jm) = sum1 + enddo + endif + return +!EOC + end subroutine tp2c +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: tp2d --- Perform transport on a D grid +! +! !INTERFACE: + subroutine tp2d(va, q, crx, cry, im, jm, iord, jord, ng, fx, fy, & + ffsl, xfx, yfx, cosp, id, jfirst, jlast) +!----------------------------------------------------------------------- +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer iord, jord ! Interpolation order in x,y + integer ng ! Max. NS dependencies + integer id ! density (0) (mfx = C) + ! mixing ratio (1) (mfx = mass flux) + logical ffsl(jm) ! Use flux-form semi-Lagrangian trans.? + ! ghosted N*ng S*ng + real (r8) cosp(jm) ! Critical angle + real (r8) va(im,jfirst:jlast) ! Courant (unghosted) + real (r8) q(im,jfirst-ng:jlast+ng) ! transported scalar ( N*NG S*NG ) + real (r8) crx(im,jfirst-ng:jlast+ng) ! Ask S.-J. ( N*NG S*NG ) + real (r8) cry(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) + real (r8) xfx(im,jfirst:jlast) ! Ask S.-J. ( unghosted like FX ) + real (r8) yfx(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) + +! !OUTPUT PARAMETERS: + real (r8) fx(im,jfirst:jlast) ! Flux in x ( unghosted ) + real (r8) fy(im,jfirst:jlast+1) ! Flux in y ( N, see tp2c ) + +! !DESCRIPTION: +! Perform transport on a D grid. The number of ghost +! latitudes (NG) depends on what method (JORD) will be used +! subsequentally. NG is equal to MIN(ABS(JORD),3). +! +! +! !REVISION HISTORY: +! WS 99.04.13: Added jfirst:jlast concept +! 99.04.21: Removed j1 and j2 (j1=2, j2=jm-1 consistently) +! 99.04.27: Removed dc, wk2 as arguments (local to YTP) +! 99.04.27: Removed adx as arguments (local here) +! SJL 99.07.26: ffsl flag added +! WS 99.09.07: Restructuring, cleaning, documentation +! WS 99.10.22: NG now argument; arrays pruned +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local: + integer i, j, iad, jp, js2g0, js2gng, jn2g0, jn2gng + real (r8) adx(im,jfirst-ng:jlast+ng) + real (r8) wk1v(im,jfirst-ng:jlast+ng) + real (r8) dm(-im/3:im+im/3) + real (r8) qtmpv(-im/3:im+im/3,jfirst-ng:jlast+ng) + real (r8) al(-im/3:im+im/3) + real (r8) ar(-im/3:im+im/3) + real (r8) a6(-im/3:im+im/3) + +! Number of ghost latitudes + js2g0 = max(2,jfirst) ! No ghosting + js2gng = max(2,jfirst-ng) ! Number needed on S + jn2g0 = min(jm-1,jlast) ! No ghosting + jn2gng = min(jm-1,jlast+ng) ! Number needed on N + iad = 1 + + call xtpv(im, ffsl, wk1v, q, crx, iad, crx, & + cosp, 0, dm, qtmpv, al, ar, a6, & + jfirst, jlast, js2gng, jn2gng, jm, & + 1, jm, jfirst-ng, jlast+ng, & + jfirst-ng, jlast+ng, jfirst-ng, jlast+ng, & + jfirst-ng, jlast+ng, jfirst-ng, jlast+ng) + + do j=js2gng,jn2gng ! adx needed on N*ng S*ng + + do i=1,im-1 + adx(i,j) = q(i,j) + D0_5 * & + (wk1v(i,j)-wk1v(i+1,j) + q(i,j)*(crx(i+1,j)-crx(i,j))) + enddo + adx(im,j) = q(im,j) + D0_5 * & + (wk1v(im,j)-wk1v(1,j) + q(im,j)*(crx(1,j)-crx(im,j))) + enddo + +! WS 99.09.07 : Split up north and south pole + + if ( jfirst-ng <= 1 ) then + do i=1,im + adx(i, 1) = q(i,1) + enddo + endif + if ( jlast+ng >= jm ) then + do i=1,im + adx(i,jm) = q(i,jm) + enddo + endif + + call ytp(im,jm,fy, adx,cry,yfx,ng,jord,0,jfirst,jlast) + + do j=js2g0,jn2g0 + do i=1,im + jp = j-va(i,j) + wk1v(i,j) = q(i,j) +D0_5*va(i,j)*(q(i,jp)-q(i,jp+1)) + enddo + enddo + + call xtpv(im, ffsl, fx, wk1v, crx, iord, xfx, & + cosp, id, dm, qtmpv, al, ar, a6, & + jfirst, jlast, js2g0, jn2g0, jm, & + 1, jm, jfirst, jlast, & + jfirst-ng, jlast+ng, jfirst-ng, jlast+ng, & + jfirst, jlast, jfirst-ng, jlast+ng) + + return +!EOC + end subroutine tp2d +!----------------------------------------------------------------------- + +#ifndef VECTORIZE +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: xtpv +! +! !INTERFACE: + subroutine xtpv(im, ffslv, fxv, qv, cv, iord, mfxv, & + cosav, id, dmw, qtmpv, alw, arw, a6w, & + jfirst, jlast, jlow, jhigh, jm, & + jl2, jh2, jl3, jh3, & + jl4, jh4, jl5, jh5, & + jl7, jh7, jl11, jh11) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer id ! ID = 0: density (mfx = C) + ! ID = 1: mixing ratio (mfx is mass flux) + + integer im ! Total longitudes + integer iord + integer jfirst, jlast, jlow, jhigh, jm + integer jl2, jh2, jl3, jh3, jl4, jh4, jl5, jh5 + integer jl7, jh7, jl11, jh11 + real (r8) cv(im,jl5:jh5) ! Courant numbers + real (r8) qv(im,jl4:jh4) + real (r8) mfxv(im,jl7:jh7) + logical ffslv(jl2:jh2) + real (r8) cosav(jm) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) qtmpv(-im/3:im+im/3,jl11:jh11) ! Input work arrays: + real (r8) dmw(-im/3:im+im/3) + real (r8) alw(-im/3:im+im/3) + real (r8) arw(-im/3:im+im/3) + real (r8) a6w(-im/3:im+im/3) + +! !OUTPUT PARAMETERS: + real (r8) fxv(im,jl3:jh3) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! Local: + real (r8) cos_upw !critical cosine for upwind + real (r8) cos_van !critical cosine for van Leer + real (r8) cos_ppm !critical cosine for ppm + + parameter (cos_upw = D0_05) !roughly at 87 deg. + parameter (cos_van = D0_25) !roughly at 75 deg. + parameter (cos_ppm = D0_25) + + integer i, imp, j + real (r8) qmax, qmin + real (r8) rut, tmp + integer iu, itmp, ist + integer isave(im) + integer iuw, iue + real (r8) dm(-im/3:im+im/3) + real (r8) al(-im/3:im+im/3) + real (r8) ar(-im/3:im+im/3) + real (r8) a6(-im/3:im+im/3) + + imp = im + 1 + + do j = jlow, jhigh + + do i=1,im + qtmpv(i,j) = qv(i,j) + enddo + + if( ffslv(j) ) then +! Flux-Form Semi-Lagrangian transport + +! Figure out ghost zone for the western edge: + iuw = -cv(1,j) + iuw = min(0, iuw) + + do i=iuw, 0 + qtmpv(i,j) = qv(im+i,j) + enddo + +! Figure out ghost zone for the eastern edge: + iue = im - cv(im,j) + iue = max(imp, iue) + + do i=imp, iue + qtmpv(i,j) = qv(i-im,j) + enddo + + if( iord == 1 .or. cosav(j) < cos_upw) then + do i=1,im + iu = cv(i,j) + if(cv(i,j) .le. D0_0) then + itmp = i - iu + isave(i) = itmp - 1 + else + itmp = i - iu - 1 + isave(i) = itmp + 1 + endif + fxv(i,j) = (cv(i,j)-iu) * qtmpv(itmp,j) + enddo + else + + do i=1,im +! 2nd order slope + tmp = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qmax = max(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - qtmpv(i,j) + qmin = qtmpv(i,j) - min(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) + dm(i) = sign(min(abs(tmp),qmax,qmin), tmp) + enddo + + + do i=iuw, 0 + dm(i) = dm(im+i) + enddo + + do i=imp, iue + dm(i) = dm(i-im) + enddo + + if(iord .ge. 3 .and. cosav(j) .gt. cos_ppm) then + call fxppm(im, cv(:,j), mfxv(:,j), qtmpv(:,j), dm, fxv(:,j), iord, al, ar, a6, & + iuw, iue, ffslv(j), isave) + else + do i=1,im + iu = cv(i,j) + rut = cv(i,j) - iu + if(cv(i,j) .le. D0_0) then + itmp = i - iu + isave(i) = itmp - 1 + fxv(i,j) = rut*(qtmpv(itmp,j)-dm(itmp)*(D1_0+rut)) + else + itmp = i - iu - 1 + isave(i) = itmp + 1 + fxv(i,j) = rut*(qtmpv(itmp,j)+dm(itmp)*(D1_0-rut)) + endif + enddo + endif + + endif + + do i=1,im + if(cv(i,j) .ge. D1_0) then + do ist = isave(i),i-1 + fxv(i,j) = fxv(i,j) + qtmpv(ist,j) + enddo + elseif(cv(i,j) .le. -D1_0) then + do ist = i,isave(i) + fxv(i,j) = fxv(i,j) - qtmpv(ist,j) + enddo + endif + enddo + + if(id .ne. 0) then + do i=1,im + fxv(i,j) = fxv(i,j)*mfxv(i,j) + enddo + endif + + else +! Regular PPM (Eulerian without FFSL extension) + + qtmpv(imp,j) = qv(1,j) + qtmpv( 0,j) = qv(im,j) + + if(iord == 1 .or. cosav(j) < cos_upw) then + do i=1,im + iu = real(i,r8) - cv(i,j) + fxv(i,j) = mfxv(i,j)*qtmpv(iu,j) + enddo + else + + qtmpv(-1,j) = qv(im-1,j) + qtmpv(imp+1,j) = qv(2,j) + + if(iord > 0 .or. cosav(j) < cos_van) then + call xmist(im, qtmpv(:,j), dm, 2) + else + call xmist(im, qtmpv(:,j), dm, iord) + endif + + dm(0) = dm(im) + + if( abs(iord).eq.2 .or. cosav(j) .lt. cos_van ) then + do i=1,im + iu = real(i,r8) - cv(i,j) + fxv(i,j) = mfxv(i,j)*(qtmpv(iu,j)+dm(iu)*(sign(D1_0,cv(i,j))-cv(i,j))) + +! if(cv(i,j) .le. 0.) then +! fxv(i,j) = qtmpv(i,j) - dm(i)*(1.+cv(i,j)) +! else +! fxv(i,j) = qtmpv(i-1,j) + dm(i-1)*(1.-cv(i,j)) +! endif +! fxv(i,j) = fxv(i,j)*mfxv(i,j) + + enddo + else + call fxppm(im, cv(:,j), mfxv(:,j), qtmpv(:,j), dm, fxv(:,j), iord, al, ar, a6, & + iuw, iue, ffslv(j), isave) + endif + endif + + endif + + enddo + + return +!EOC + end subroutine xtpv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: xmist +! +! !INTERFACE: + subroutine xmist(im, q, dm, id) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer im ! Total number of longitudes + integer id ! ID = 0: density (mfx = C) + ! ID = 1: mixing ratio (mfx is mass flux) + real(r8) q(-im/3:im+im/3) ! Input latitude + +! !OUTPUT PARAMETERS: + real(r8) dm(-im/3:im+im/3) ! + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC + + real(r8) r24 + parameter( r24 = D1_0/D24_0) + + integer i + real(r8) qmin, qmax + + if(id .le. 2) then + do i=1,im + dm(i) = r24*(D8_0*(q(i+1) - q(i-1)) + q(i-2) - q(i+2)) + enddo + else + do i=1,im + dm(i) = D0_25*(q(i+1) - q(i-1)) + enddo + endif + + if( id < 0 ) return + +! Apply monotonicity constraint (Lin et al. 1994, MWR) + do i=1,im + qmax = max( q(i-1), q(i), q(i+1) ) - q(i) + qmin = q(i) - min( q(i-1), q(i), q(i+1) ) + dm(i) = sign( min(abs(dm(i)), qmax, qmin), dm(i) ) + enddo + return +!EOC + end subroutine xmist +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fxppm +! +! !INTERFACE: + subroutine fxppm(im, c, mfx, p, dm, fx, iord, al, ar, a6, & + iuw, iue, ffsl, isave) +!----------------------------------------------------------------------- +! +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, iord + real (r8) c(im) + real (r8) p(-im/3:im+im/3) + real (r8) dm(-im/3:im+im/3) + real (r8) mfx(im) + integer iuw, iue + logical ffsl + integer isave(im) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) al(-im/3:im+im/3) + real (r8) ar(-im/3:im+im/3) + real (r8) a6(-im/3:im+im/3) + +! !OUTPUT PARAMETERS: + real (r8) fx(im) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real (r8) r3, r23 + parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) + + integer i, lmt + integer iu, itmp + real (r8) ru + logical steep + + if( iord == 6 ) then + steep = .true. + else + steep = .false. + endif + + do i=1,im + al(i) = D0_5*(p(i-1)+p(i)) + (dm(i-1) - dm(i))*r3 + enddo + + if( steep ) call steepx( im, p, al(1), dm ) + + do i=1,im-1 + ar(i) = al(i+1) + enddo + ar(im) = al(1) + + if(iord == 7) then + call huynh(im, ar(1), al(1), p(1), a6(1), dm(1)) + else + if(iord .eq. 3 .or. iord .eq. 5) then + do i=1,im + a6(i) = D3_0*(p(i)+p(i) - (al(i)+ar(i))) + enddo + endif + lmt = iord - 3 + call lmppm( dm(1), a6(1), ar(1), al(1), p(1), im, lmt ) + endif + + if( ffsl ) then + + do i=iuw, 0 + al(i) = al(im+i) + ar(i) = ar(im+i) + a6(i) = a6(im+i) + enddo + + do i=im+1, iue + al(i) = al(i-im) + ar(i) = ar(i-im) + a6(i) = a6(i-im) + enddo + + do i=1,im + iu = c(i) + ru = c(i) - iu + if(c(i) .gt. D0_0) then + itmp = i - iu - 1 + isave(i) = itmp + 1 + fx(i) = ru*(ar(itmp)+D0_5*ru*(al(itmp)-ar(itmp) + & + a6(itmp)*(D1_0-r23*ru)) ) + else + itmp = i - iu + isave(i) = itmp - 1 + fx(i) = ru*(al(itmp)-D0_5*ru*(ar(itmp)-al(itmp) + & + a6(itmp)*(D1_0+r23*ru)) ) + endif + enddo + + else + al(0) = al(im) + ar(0) = ar(im) + a6(0) = a6(im) + do i=1,im + if(c(i) .gt. D0_0) then + fx(i) = ar(i-1) + D0_5*c(i)*(al(i-1) - ar(i-1) + & + a6(i-1)*(D1_0-r23*c(i)) ) + else + fx(i) = al(i) - D0_5*c(i)*(ar(i) - al(i) + & + a6(i)*(D1_0+r23*c(i))) + endif + fx(i) = mfx(i) * fx(i) + enddo + endif + return +!EOC + end subroutine fxppm +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: steepx +! +! !INTERFACE: + subroutine steepx(im, p, al, dm) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im + real (r8) p(-im/3:im+im/3) + real (r8) dm(-im/3:im+im/3) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) al(im) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i + real (r8) r3 + parameter ( r3 = D1_0/D3_0 ) + + real (r8) dh(0:im) + real (r8) d2(0:im+1) + real (r8) eta(0:im) + real (r8) xxx, bbb, ccc + + do i=0,im + dh(i) = p(i+1) - p(i) + enddo + +! Needs dh(0:im) + do i=1,im + d2(i) = dh(i) - dh(i-1) + enddo + d2(0) = d2(im) + d2(im+1) = d2(1) + +! needs p(-1:im+2), d2(0:im+1) + do i=1,im + if( d2(i+1)*d2(i-1).lt.D0_0 .and. p(i+1).ne.p(i-1) ) then + xxx = D1_0 - D0_5 * ( p(i+2) - p(i-2) ) / ( p(i+1) - p(i-1) ) + eta(i) = max(D0_0, min(xxx, D0_5) ) + else + eta(i) = D0_0 + endif + enddo + + eta(0) = eta(im) + +! needs eta(0:im), dh(0:im-1), dm(0:im) + do i=1,im + bbb = ( D2_0*eta(i ) - eta(i-1) ) * dm(i-1) + ccc = ( D2_0*eta(i-1) - eta(i ) ) * dm(i ) + al(i) = al(i) + D0_5*( eta(i-1) - eta(i)) * dh(i-1) + (bbb - ccc) * r3 + enddo + return +!EOC + end subroutine steepx +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: lmppm +! +! !INTERFACE: + subroutine lmppm(dm, a6, ar, al, p, im, lmt) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer im ! Total longitudes + integer lmt ! LMT = 0: full monotonicity + ! LMT = 1: Improved and simplified full monotonic constraint + ! LMT = 2: positive-definite constraint + ! LMT = 3: Quasi-monotone constraint + real(r8) p(im) + real(r8) dm(im) + +! !OUTPUT PARAMETERS: + real(r8) a6(im) + real(r8) ar(im) + real(r8) al(im) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real (r8) r12 + parameter ( r12 = D1_0/D12_0 ) + + real (r8) da1, da2, fmin, a6da + real (r8) dr, dl + + integer i + +! LMT = 0: full monotonicity +! LMT = 1: Improved and simplified full monotonic constraint +! LMT = 2: positive-definite constraint +! LMT = 3: Quasi-monotone constraint + + if( lmt == 0 ) then + +! Full constraint + do i=1,im + if(dm(i) .eq. D0_0) then + ar(i) = p(i) + al(i) = p(i) + a6(i) = D0_0 + else + da1 = ar(i) - al(i) + da2 = da1**2 + a6da = a6(i)*da1 + if(a6da .lt. -da2) then + a6(i) = D3_0*(al(i)-p(i)) + ar(i) = al(i) - a6(i) + elseif(a6da .gt. da2) then + a6(i) = D3_0*(ar(i)-p(i)) + al(i) = ar(i) - a6(i) + endif + endif + enddo + + elseif( lmt == 1 ) then + +! Improved (Lin 2001?) full constraint + do i=1,im + da1 = dm(i) + dm(i) + dl = sign(min(abs(da1),abs(al(i)-p(i))), da1) + dr = sign(min(abs(da1),abs(ar(i)-p(i))), da1) + ar(i) = p(i) + dr + al(i) = p(i) - dl + a6(i) = D3_0*(dl-dr) + enddo + + elseif( lmt == 2 ) then +! Positive definite constraint + do 250 i=1,im + if(abs(ar(i)-al(i)) .ge. -a6(i)) go to 250 + fmin = p(i) + D0_25*(ar(i)-al(i))**2/a6(i) + a6(i)*r12 + if(fmin.ge.D0_0) go to 250 + if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then + ar(i) = p(i) + al(i) = p(i) + a6(i) = D0_0 + elseif(ar(i) .gt. al(i)) then + a6(i) = D3_0*(al(i)-p(i)) + ar(i) = al(i) - a6(i) + else + a6(i) = D3_0*(ar(i)-p(i)) + al(i) = ar(i) - a6(i) + endif +250 continue + + elseif(lmt .eq. 3) then +! Quasi-monotone constraint + do i=1,im + da1 = D4_0*dm(i) + dl = sign(min(abs(da1),abs(al(i)-p(i))), da1) + dr = sign(min(abs(da1),abs(ar(i)-p(i))), da1) + ar(i) = p(i) + dr + al(i) = p(i) - dl + a6(i) = D3_0*(dl-dr) + enddo + endif + return +!EOC + end subroutine lmppm +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: huynh --- Enforce Huynh's 2nd constraint in 1D periodic domain +! +! !INTERFACE: + subroutine huynh(im, ar, al, p, d2, d1) +!----------------------------------------------------------------------- + +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer im + real(r8) p(im) + +! !OUTPUT PARAMETERS: + real(r8) ar(im) + real(r8) al(im) + real(r8) d2(im) + real(r8) d1(im) + +! !DESCRIPTION: +! +! Enforce Huynh's 2nd constraint in 1D periodic domain +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i + real(r8) pmp + real(r8) lac + real(r8) pmin + real(r8) pmax + +! Compute d1 and d2 + d1(1) = p(1) - p(im) + do i=2,im + d1(i) = p(i) - p(i-1) + enddo + + do i=1,im-1 + d2(i) = d1(i+1) - d1(i) + enddo + d2(im) = d1(1) - d1(im) + +! Constraint for AR +! i = 1 + pmp = p(1) + D2_0 * d1(1) + lac = p(1) + D0_5 * (d1(1)+d2(im)) + d2(im) + pmin = min(p(1), pmp, lac) + pmax = max(p(1), pmp, lac) + ar(1) = min(pmax, max(ar(1), pmin)) + + do i=2, im + pmp = p(i) + D2_0*d1(i) + lac = p(i) + D0_5*(d1(i)+d2(i-1)) + d2(i-1) + pmin = min(p(i), pmp, lac) + pmax = max(p(i), pmp, lac) + ar(i) = min(pmax, max(ar(i), pmin)) + enddo + +! Constraint for AL + do i=1, im-1 + pmp = p(i) - D2_0*d1(i+1) + lac = p(i) + D0_5*(d2(i+1)-d1(i+1)) + d2(i+1) + pmin = min(p(i), pmp, lac) + pmax = max(p(i), pmp, lac) + al(i) = min(pmax, max(al(i), pmin)) + enddo + +! i=im + i = im + pmp = p(im) - D2_0*d1(1) + lac = p(im) + D0_5*(d2(1)-d1(1)) + d2(1) + pmin = min(p(im), pmp, lac) + pmax = max(p(im), pmp, lac) + al(im) = min(pmax, max(al(im), pmin)) + +! compute A6 (d2) + do i=1, im + d2(i) = D3_0*(p(i)+p(i) - (al(i)+ar(i))) + enddo + return +!EOC + end subroutine huynh +!----------------------------------------------------------------------- +#endif + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ytp +! +! !INTERFACE: + subroutine ytp(im, jm, fy, q, c, yfx, ng, jord, iv, jfirst, jlast) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer ng ! Max. NS dependencies + integer jord ! order of subgrid dist + integer iv ! Scalar=0, Vector=1 + real (r8) q(im,jfirst-ng:jlast+ng) ! advected scalar N*jord S*jord + real (r8) c(im,jfirst:jlast+1) ! Courant N (like FY) + real (r8) yfx(im,jfirst:jlast+1) ! Backgrond mass flux + +! !OUTPUT PARAMETERS: + real (r8) fy(im,jfirst:jlast+1) ! Flux N (see tp2c) + +! !DESCRIPTION: +! This routine calculates the flux FX. The method chosen +! depends on the order of the calculation JORD (currently +! 1, 2 or 3). +! +! !CALLED FROM: +! cd_core +! tp2d +! +! !REVISION HISTORY: +! +! SJL 99.04.13: Delivery +! WS 99.04.13: Added jfirst:jlast concept +! WS 99.04.21: Removed j1 and j2 (j1=2, j2=jm-1 consistently) +! removed a6,ar,al from argument list +! WS 99.04.27: DM made local to this routine +! WS 99.09.09: Documentation; indentation; cleaning +! WS 99.10.22: Added NG as argument; pruned arrays +! SJL 99.12.24: Revised documentation; optimized for better cache usage +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!--------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, j, jt + integer js2g0, jn1g1 + +! work arrays (should pass in eventually for performance enhancement): + real (r8) dm(im,jfirst-ng:jlast+ng) + +! real (r8) ar(im,jfirst-1:jlast+1) ! AR needs to be ghosted on NS +! real (r8) al(im,jfirst-1:jlast+2) ! AL needs to be ghosted on N2S +! real (r8) a6(im,jfirst-1:jlast+1) ! A6 needs to be ghosted on NS + + js2g0 = max(2,jfirst) ! No ghosting + jn1g1 = min(jm,jlast+1) ! Ghost N*1 + + if(jord == 1) then + do j=js2g0,jn1g1 + do i=1,im + jt = real(j,r8) - c(i,j) + fy(i,j) = q(i,jt) + enddo + enddo + else + +! +! YMIST requires q on NS; Only call to YMIST here +! + call ymist(im, jm, q, dm, ng, jord, iv, jfirst, jlast) + + if( abs(jord) .ge. 3 ) then + + call fyppm(c,q,dm,fy,im,jm,ng,jord,iv,jfirst,jlast) + + else +! +! JORD can either have the value 2 or -2 at this point +! + do j=js2g0,jn1g1 + do i=1,im + jt = real(j,r8) - c(i,j) + fy(i,j) = q(i,jt) + (sign(D1_0,c(i,j))-c(i,j))*dm(i,jt) + enddo + enddo + endif + endif + + do j=js2g0,jn1g1 + do i=1,im + fy(i,j) = fy(i,j)*yfx(i,j) + enddo + enddo + return +!EOC + end subroutine ytp +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ymist +! +! !INTERFACE: + subroutine ymist(im, jm, q, dm, ng, jord, iv, jfirst, jlast) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer ng ! NS dependencies + integer jord ! order of subgrid distribution + integer iv ! Scalar (==0) Vector (==1) + real (r8) q(im,jfirst-ng:jlast+ng) ! transported scalar N*ng S*ng + +! !OUTPUT PARAMETERS: + real (r8) dm(im,jfirst-ng:jlast+ng) ! Slope only N*(ng-1) S*(ng-1) used + +! !DESCRIPTION: +! Calculate the slope of the pressure. The number of ghost +! latitudes (NG) depends on what method (JORD) will be used +! subsequentally. NG is equal to MIN(ABS(JORD),3). +! +! !CALLED FROM: +! ytp +! +! !REVISION HISTORY: +! +! SJL 99.04.13: Delivery +! WS 99.04.13: Added jfirst:jlast concept +! WS 99.09.09: Documentation; indentation; cleaning +! SJL 00.01.06: Documentation +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! Local variables + + integer i, j, jm1, im2, js2gng1, jn2gng1 + real (r8) qmax, qmin, tmp + + js2gng1 = max(2, jfirst-ng+1) ! Number needed on S + jn2gng1 = min(jm-1,jlast+ng-1) ! Number needed on N + + jm1 = jm - 1 + im2 = im / 2 + + do j=js2gng1,jn2gng1 + do i=1,im + dm(i,j) = D0_25*(q(i,j+1) - q(i,j-1)) + enddo + enddo + + if( iv == 0 ) then + + if ( jfirst-ng <= 1 ) then +! S pole + do i=1,im2 + tmp = D0_25*(q(i,2)-q(i+im2,2)) + qmax = max(q(i,2),q(i,1), q(i+im2,2)) - q(i,1) + qmin = q(i,1) - min(q(i,2),q(i,1), q(i+im2,2)) + dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i, 1) = - dm(i-im2, 1) + enddo + endif + + if ( jlast+ng >= jm ) then +! N pole + do i=1,im2 + tmp = D0_25*(q(i+im2,jm1)-q(i,jm1)) + qmax = max(q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) + qmin = q(i,jm) - min(q(i+im2,jm1),q(i,jm), q(i,jm1)) + dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i,jm) = - dm(i-im2,jm) + enddo + endif + + else + + if ( jfirst-ng <= 1 ) then +! South + do i=1,im2 + tmp = D0_25*(q(i,2)+q(i+im2,2)) + qmax = max(q(i,2),q(i,1), -q(i+im2,2)) - q(i,1) + qmin = q(i,1) - min(q(i,2),q(i,1),-q(i+im2,2)) + dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i, 1) = dm(i-im2, 1) + enddo + endif + + if ( jlast+ng >= jm ) then +! North + do i=1,im2 + tmp = -D0_25*(q(i+im2,jm1)+q(i,jm1)) + qmax = max(-q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) + qmin = q(i,jm) - min(-q(i+im2,jm1),q(i,jm), q(i,jm1)) + dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i,jm) = dm(i-im2,jm) + enddo + endif + + endif + + if( jord > 0 ) then +! +! Applies monotonic slope constraint (off if jord less than zero) +! + do j=js2gng1,jn2gng1 + do i=1,im + qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) + qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) + dm(i,j) = sign(min(abs(dm(i,j)),qmin,qmax),dm(i,j)) + enddo + enddo + endif + return +!EOC + end subroutine ymist +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fyppm +! +! !INTERFACE: + subroutine fyppm(c, q, dm, flux, im, jm, ng, jord, iv, jfirst, jlast) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer ng ! Max. NS dependencies + integer jord ! Approximation order + integer iv ! Scalar=0, Vector=1 + real (r8) q(im,jfirst-ng:jlast+ng) ! mean value needed only N*2 S*2 + real (r8) dm(im,jfirst-ng:jlast+ng) ! Slope needed only N*2 S*2 + real (r8) c(im,jfirst:jlast+1) ! Courant N (like FLUX) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) ar(im,jfirst-1:jlast+1) ! AR needs to be ghosted on NS + real (r8) al(im,jfirst-1:jlast+2) ! AL needs to be ghosted on N2S + real (r8) a6(im,jfirst-1:jlast+1) ! A6 needs to be ghosted on NS + +! !OUTPUT PARAMETERS: + real (r8) flux(im,jfirst:jlast+1) ! Flux N (see tp2c) + +! !DESCRIPTION: +! +! NG is passed from YTP for convenience -- it is actually 1 more in NS +! than the actual number of latitudes needed here. But in the shared-memory +! case it becomes 0, which is much cleaner. +! +! !CALLED FROM: +! ytp +! +! !REVISION HISTORY: +! +! SJL 99.04.13: Delivery +! WS 99.04.19: Added jfirst:jlast concept; FYPPM only called from YTP +! WS 99.04.21: Removed j1, j2 (j1=2, j2=jm-1 consistently) +! removed a6,ar,al from argument list +! WS 99.09.09: Documentation; indentation; cleaning +! WS 99.10.22: Added ng as argument; Pruned arrays +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!--------------------------------------------------------------------- +!BOC + real (r8) r3, r23 + parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) + integer i, j, imh, jm1, lmt + integer js1g1, js2g0, js2g1, jn1g2, jn1g1, jn2g1 + integer jan, jlow, jhigh, ilow, ihigh + integer ja(jlast-jfirst+3) +! logical steep + +! if(jord .eq. 6) then +! steep = .true. +! else +! steep = .false. +! endif + + imh = im / 2 + jm1 = jm - 1 + + js1g1 = max(1,jfirst-1) ! Ghost S*1 + js2g0 = max(2,jfirst) ! No ghosting + js2g1 = max(2,jfirst-1) ! Ghost S*1 + jn1g1 = min(jm,jlast+1) ! Ghost N*1 + jn1g2 = min(jm,jlast+2) ! Ghost N*2 + jn2g1 = min(jm-1,jlast+1) ! Ghost N*1 + + do j=js2g1,jn1g2 ! AL needed N2S + do i=1,im ! P, dm ghosted N2S2 (at least) + al(i,j) = D0_5*(q(i,j-1)+q(i,j)) + r3*(dm(i,j-1) - dm(i,j)) + enddo + enddo + +! Yeh's steepening procedure; to be implemented +! if(steep) call steepy(im, jm, jfirst, jlast, & +! ng, q, al, dm ) + + do j=js1g1,jn2g1 ! AR needed NS + do i=1,im + ar(i,j) = al(i,j+1) ! AL ghosted N2S + enddo + enddo + +! WS 990726 : Added condition to decide if poles are on this processor + +! Poles: + + if( iv == 0 ) then + + if ( jfirst == 1 ) then + do i=1,imh + al(i, 1) = al(i+imh,2) + al(i+imh,1) = al(i, 2) + enddo + endif + + if ( jlast == jm ) then + do i=1,imh + ar(i, jm) = ar(i+imh,jm1) + ar(i+imh,jm) = ar(i, jm1) + enddo + endif + + else + + if ( jfirst == 1 ) then + do i=1,imh + al(i, 1) = -al(i+imh,2) + al(i+imh,1) = -al(i, 2) + enddo + endif + + if ( jlast == jm ) then + do i=1,imh + ar(i, jm) = -ar(i+imh,jm1) + ar(i+imh,jm) = -ar(i, jm1) + enddo + endif + + endif + + if( jord == 3 .or. jord == 5 ) then + do j=js1g1,jn1g1 ! A6 needed NS + do i=1,im + a6(i,j) = D3_0*(q(i,j)+q(i,j) - (al(i,j)+ar(i,j))) + enddo + enddo + endif + + lmt = jord - 3 + +! do j=js1g1,jn1g1 ! A6, AR, AL needed NS +! call lmppm(dm(1,j),a6(1,j),ar(1,j),al(1,j),q(1,j),im,lmt) +! enddo + +#ifdef VECTORIZE + jan = 1 + ja(1) = 1 + ilow = 1 + ihigh = im*(jn1g1-js1g1+1) + jlow = 1 + jhigh = 1 + call lmppmv(dm(1,js1g1), a6(1,js1g1), ar(1,js1g1), & + al(1,js1g1), q(1,js1g1), im*(jn1g1-js1g1+1), lmt, & + jan, ja, ilow, ihigh, jlow, jhigh, jlow, jhigh) +#else + call lmppm(dm(1,js1g1), a6(1,js1g1), ar(1,js1g1), & + al(1,js1g1), q(1,js1g1), im*(jn1g1-js1g1+1), lmt) +#endif + + do j=js2g0,jn1g1 ! flux needed N + do i=1,im + if(c(i,j).gt.D0_0) then + flux(i,j) = ar(i,j-1) + D0_5*c(i,j)*(al(i,j-1) - ar(i,j-1) + & + a6(i,j-1)*(D1_0-r23*c(i,j)) ) + else + flux(i,j) = al(i,j) - D0_5*c(i,j)*(ar(i,j) - al(i,j) + & + a6(i,j)*(D1_0+r23*c(i,j))) + endif + enddo + enddo + return +!EOC + end subroutine fyppm +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: tpcc +! +! !INTERFACE: + subroutine tpcc(va, ymass, q, crx, cry, im, jm, ng_c, ng_d, & + iord, jord, fx, fy, ffsl, cose, jfirst, jlast, & + dm, qtmp, al, ar, a6 ) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer ng_c ! + integer ng_d ! + integer jfirst, jlast ! Latitude strip + integer iord, jord ! Interpolation order in x,y + logical ffsl(jm) ! Flux-form semi-Lagrangian transport? + real (r8) cose(jm) ! Critical cosine (replicated) + real (r8) va(im,jfirst:jlast) ! Courant (unghosted like FX) + real (r8) q(im,jfirst-ng_d:jlast+ng_d) ! + real (r8) crx(im,jfirst-ng_c:jlast+ng_c) + real (r8) cry(im,jfirst:jlast) ! Courant # (ghosted like FY) + real (r8) ymass(im,jfirst:jlast) ! Background y-mass-flux (ghosted like FY) + +! Input 1D work arrays: + real (r8) dm(-im/3:im+im/3) + real (r8) qtmp(-im/3:im+im/3) + real (r8) al(-im/3:im+im/3) + real (r8) ar(-im/3:im+im/3) + real (r8) a6(-im/3:im+im/3) + +! !OUTPUT PARAMETERS: + real (r8) fx(im,jfirst:jlast) ! Flux in x (unghosted) + real (r8) fy(im,jfirst:jlast) ! Flux in y (unghosted since iv==0) + +! !DESCRIPTION: +! In this routine the number +! of north ghosted latitude min(abs(jord),2), and south ghosted +! latitudes is XXXX +! +! !CALLED FROM: +! cd_core +! +! !REVISION HISTORY: +! SJL 99.04.13: Delivery +! WS 99.04.13: Added jfirst:jlast concept +! WS 99.05.10: Replaced JNP with JM, JMR with JM-1, IMR with IM +! WS 99.05.10: Removed fvcore.h and JNP, IMH, IML definitions +! WS 99.10.20: Pruned arrays +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + + real (r8) adx(im,jfirst-1:jlast+2) + integer north, south + integer i, j, jp, im2, js2g0, js2gs, jn2g0, jn1g0, jn1gn + real (r8) wk1v(im,jfirst-1:jlast+2) + real (r8) fx1(im) + real (r8) qtmpv(-im/3:im+im/3,jfirst-1:jlast+2) + + im2 = im/2 + north = min(2,abs(jord)) ! north == 1 or 2 + south = north-1 ! south == 0 or 1 + js2g0 = max(2,jfirst) + js2gs = max(2,jfirst-south) + jn2g0 = min(jm-1,jlast) + jn1gn = min(jm,jlast+north) + jn1g0 = min(jm,jlast) + +! This loop must be ghosted N*NG, S*NG + + call xtpv( im, ffsl, wk1v, q, crx, 1, crx, & + cose, 0, dm, qtmpv, al, ar, a6, & + jfirst, jlast, js2gs, jn1gn, jm, & + 1, jm, jfirst-1, jlast+2, & + jfirst-ng_d, jlast+ng_d, jfirst-ng_c, jlast+ng_c, & + jfirst-ng_c, jlast+ng_c, jfirst-1, jlast+2) + + do j=js2gs,jn1gn + + do i=1,im-1 + adx(i,j) = q(i,j) + D0_5 * & + (wk1v(i,j)-wk1v(i+1,j) + q(i,j)*(crx(i+1,j)-crx(i,j))) + enddo + + adx(im,j) = q(im,j) + D0_5 * & + (wk1v(im,j)-wk1v(1,j) + q(im,j)*(crx(1,j)-crx(im,j))) + enddo + + call ycc(im, jm, fy, adx, cry, ymass, jord, 0,jfirst,jlast) + +! For Scalar only!!! + if ( jfirst == 1 ) then ! ( jfirst -ng_d <= 1 ) fails when + ! ng_d=3, ng_c=2, jlast-jfirst+1 = 3 + do i=1,im2 + q(i,1) = q(i+im2, 2) + enddo + do i=im2+1,im + q(i,1) = q(i-im2, 2) + enddo + endif + + if ( jlast == jm ) then + do i=1,im2 + fx1(i) = q(i+im2,jm) + enddo + do i=im2+1,im + fx1(i) = q(i-im2,jm) + enddo + + do i=1,im + if(va(i,jm) .gt. D0_0) then + adx(i,jm) = q(i,jm) + D0_5*va(i,jm)*(q(i,jm-1)-q(i,jm)) + else + adx(i,jm) = q(i,jm) + D0_5*va(i,jm)*(q(i,jm)-fx1(i)) + endif + enddo + endif + + do j=js2g0,jn2g0 + do i=1,im + jp = j-va(i,j) +! jp = j if va < 0 +! jp = j -1 if va < 0 +! q needed max(1, jfirst-1) + adx(i,j) = q(i,j) + D0_5*va(i,j)*(q(i,jp)-q(i,jp+1)) + enddo + enddo + + call xtpv( im, ffsl, fx, adx, crx, iord, crx, & + cose, 0, dm, qtmpv, al, ar, a6, & + jfirst, jlast, js2g0, jn1g0, jm, & + 1, jm, jfirst, jlast, & + jfirst-1, jlast+2,jfirst-ng_c, jlast+ng_c, & + jfirst-ng_c, jlast+ng_c, jfirst-1, jlast+2) + + return +!EOC + end subroutine tpcc +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ycc +! +! !INTERFACE: + subroutine ycc(im, jm, fy, q, vc, ymass, jord, iv, jfirst, jlast) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im, jm ! Dimensions + integer jfirst, jlast ! Latitude strip + integer jord ! Approximation order + integer iv ! Scalar=0, Vector=1 + real (r8) q(im,jfirst-1-iv:jlast+2) ! Field (N*2 S*(iv+1)) + real (r8) vc(im,jfirst-iv:jlast) ! Courant (like FY) + real (r8) ymass(im,jfirst-iv:jlast) ! background mass flux + +! !OUTPUT PARAMETERS: + real (r8) fy(im,jfirst-iv:jlast) ! Flux (S if iv=1) + +! !DESCRIPTION: +! Will Sawyer's note: In this routine the number +! of ghosted latitudes NG is min(abs(jord),2). The scalar/vector +! flag determines whether the flux FY needs to be ghosted on the +! south. If called from CD\_CORE (iv==1) then it does, if called +! from TPCC (iv==0) it does not. +! +! !CALLED FROM: +! cd_core +! tpcc +! +! !REVISION HISTORY: +! +! SJL 99.04.13: Delivery +! WS 99.04.19: Added jfirst:jlast concept +! WS 99.04.27: DC removed as argument (local to this routine); DC on N +! WS 99.05.10: Replaced JNP with JM, JMR with JM-1, IMR with IM +! WS 99.05.10: Removed fvcore.h +! WS 99.07.27: Built in tests for SP or NP +! WS 99.09.09: Documentation; indentation; cleaning; pole treatment +! WS 99.09.14: Loop limits +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! +!EOP +!--------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + real (r8) dc(im,jfirst-iv:jlast+1) + real (r8) qmax, qmin + integer i, j, jt, im2, js2giv, js3giv, jn2g1, jn2g0 + + + im2 = im/2 + + js2giv = max(2,jfirst-iv) + js3giv = max(3,jfirst-iv) + jn2g1 = min(jm-1,jlast+1) + jn2g0 = min(jm-1,jlast) + + if(jord == 1) then + do j=js2giv,jn2g0 ! FY needed on S*iv + do i=1,im +! jt=j if vc > 0; jt=j+1 if vc <=0 + jt = real(j+1,r8) - vc(i,j) ! VC ghosted like fy + fy(i,j) = q(i,jt)*ymass(i,j) ! ymass ghosted like fy + enddo ! q ghosted N*1, S*iv + enddo + + else + + do j=js3giv,jn2g1 ! dc needed N*1, S*iv + do i=1,im + dc(i,j) = D0_25*(q(i,j+1)-q(i,j-1)) ! q ghosted N*2, S*(iv+1) + enddo + enddo + + if(iv.eq.0) then +! Scalar. + +! WS 99.07.27 : Split loops in SP and NP regions, added SP/NP tests + + if ( jfirst-iv <= 2 ) then + do i=1,im2 + dc(i, 2) = D0_25 * ( q(i,3) - q(i+im2,2) ) + enddo + + do i=im2+1,im + dc(i, 2) = D0_25 * ( q(i,3) - q(i-im2,2) ) + enddo + endif + + if ( jlast == jm ) then + do i=1,im2 + dc(i,jm) = D0_25 * ( q(i+im2,jm) - q(i,jm-1) ) + enddo + + do i=im2+1,im + dc(i,jm) = D0_25 * ( q(i-im2,jm) - q(i,jm-1) ) + enddo + endif + + else +! Vector winds + +! WS 99.07.27 : Split loops in SP and NP regions, added SP/NP tests + + if ( jfirst-iv <= 2 ) then + do i=1,im2 + dc(i, 2) = D0_25 * ( q(i,3) + q(i+im2,2) ) + enddo + + do i=im2+1,im + dc(i, 2) = D0_25 * ( q(i,3) + q(i-im2,2) ) + enddo + endif + + if ( jlast == jm ) then + do i=1,im2 + dc(i,jm) = -D0_25 * ( q(i,jm-1) + q(i+im2,jm) ) + enddo + + do i=im2+1,im + dc(i,jm) = -D0_25 * ( q(i,jm-1) + q(i-im2,jm) ) + enddo + endif + + endif + + if( jord > 0 ) then +! Monotonic constraint + do j=js3giv,jn2g1 ! DC needed N*1, S*iv + do i=1,im ! P ghosted N*2, S*(iv+1) + qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) + qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) + dc(i,j) = sign(min(abs(dc(i,j)),qmin,qmax),dc(i,j)) + enddo + enddo +! +! WS 99.08.03 : Following loop split into SP and NP part +! + if ( jfirst-iv <= 2 ) then + do i=1,im + dc(i, 2) = D0_0 + enddo + endif + if ( jlast == jm ) then + do i=1,im + dc(i,jm) = D0_0 + enddo + endif + endif + + do j=js2giv,jn2g0 ! fy needed S*iv + do i=1,im + jt = real(j+1,r8) - vc(i,j) ! vc, ymass ghosted like fy + fy(i,j) = (q(i,jt)+(sign(D1_0,vc(i,j))-vc(i,j))*dc(i,jt))*ymass(i,j) + enddo + enddo + endif + return +!EOC + end subroutine ycc +!----------------------------------------------------------------------- + +#ifdef VECTORIZE +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: xtpv +! +! !INTERFACE: + subroutine xtpv(im, ffslv, fxv, qv, cv, iord, mfxv, & + cosav, id, dm, qtmpv, al, ar, a6, & + jfirst, jlast, jlow, jhigh, jm, & + jl2, jh2, jl3, jh3, & + jl4, jh4, jl5, jh5, & + jl7, jh7, jl11, jh11) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer id ! ID = 0: density (mfx = C) + ! ID = 1: mixing ratio (mfx is mass flux) + + integer im ! Total longitudes + real (r8) cv(im,jl5:jh5) ! Courant numbers + real (r8) qv(im,jl4:jh4) + real (r8) mfxv(im,jl7:jh7) + logical ffslv(jl2:jh2) + integer iord + integer jfirst, jlast, jlow, jhigh, jm + integer jl2, jh2, jl3, jh3, jl4, jh4, jl5, jh5 + integer jl7, jh7, jl11, jh11 + real (r8) cosav(jm) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) qtmpv(-im/3:im+im/3,jl11:jh11) ! Input work arrays: + real (r8) dm(-im/3:im+im/3) + real (r8) al(-im/3:im+im/3) + real (r8) ar(-im/3:im+im/3) + real (r8) a6(-im/3:im+im/3) + +! !OUTPUT PARAMETERS: + real (r8) fxv(im,jl3:jh3) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! Local: + real (r8) cos_upw !critical cosine for upwind + real (r8) cos_van !critical cosine for van Leer + real (r8) cos_ppm !critical cosine for ppm + + parameter (cos_upw = D0_05) !roughly at 87 deg. + parameter (cos_van = D0_25) !roughly at 75 deg. + parameter (cos_ppm = D0_25) + + real (r8) r24 + parameter (r24 = D1_0/D24_0) + + integer i, imp, j + real (r8) qmax, qmin + real (r8) rut, tmp + real (r8) dmv(-im/3:im+im/3,jlow:jhigh) + integer iu, itmp, ist + integer isave(im,jlow:jhigh) + integer iuwv(jlow:jhigh), iuev(jlow:jhigh) + + integer jatn, jafn, ja + integer jat(jhigh-jlow+1), jaf(jhigh-jlow+1) + integer jattn, jatfn, jaftn, jaffn + integer jatt(jhigh-jlow+1), jatf(jhigh-jlow+1) + integer jaft(jhigh-jlow+1), jaff(jhigh-jlow+1) + integer jatftn, jatffn + integer jatft(jhigh-jlow+1), jatff(jhigh-jlow+1) + integer jafftn1, jafffn1 + integer jafft1(jhigh-jlow+1), jafff1(jhigh-jlow+1) + integer jafftn2, jafffn2 + integer jafft2(jhigh-jlow+1), jafff2(jhigh-jlow+1) + real (r8) qsum((-im/3)-1:im+im/3,jlow:jhigh) ! work arrays + + + jatn = 0 + jafn = 0 + jattn = 0 + jatfn = 0 + jaftn = 0 + jaffn = 0 + jatftn = 0 + jatffn = 0 + jafftn1 = 0 + jafffn1 = 0 + jafftn2 = 0 + jafffn2 = 0 +!call ftrace_region_begin("xtpv_1") + do j = jlow, jhigh + if (ffslv(j)) then + jatn = jatn + 1 + jat(jatn) = j + if( iord == 1 .or. cosav(j) < cos_upw) then + jattn = jattn + 1 + jatt(jattn) = j + else + jatfn = jatfn + 1 + jatf(jatfn) = j + if(iord .ge. 3 .and. cosav(j) .gt. cos_ppm) then + jatftn = jatftn + 1 + jatft(jatftn) = j + else + jatffn = jatffn + 1 + jatff(jatffn) = j + endif + endif + else + jafn = jafn + 1 + jaf(jafn) = j + if( iord == 1 .or. cosav(j) < cos_upw) then + jaftn = jaftn + 1 + jaft(jaftn) = j + else + jaffn = jaffn + 1 + jaff(jaffn) = j + if(iord > 0 .or. cosav(j) < cos_van) then + jafftn1 = jafftn1 + 1 + jafft1(jafftn1) = j + else + jafffn1 = jafffn1 + 1 + jafff1(jafffn1) = j + endif + if( abs(iord).eq.2 .or. cosav(j) .lt. cos_van ) then + jafftn2 = jafftn2 + 1 + jafft2(jafftn2) = j + else + jafffn2 = jafffn2 + 1 + jafff2(jafffn2) = j + endif + endif + endif + enddo +!call ftrace_region_end("xtpv_1") + + imp = im + 1 + + do j = jlow, jhigh + do i=1,im + qtmpv(i,j) = qv(i,j) + enddo + enddo + +! Flux-Form Semi-Lagrangian transport + +!call ftrace_region_begin("xtpv_2") + do ja = 1, jatn + j = jat(ja) + +! Figure out ghost zone for the western edge: + iuwv(j) = -cv(1,j) + iuwv(j) = min(0, iuwv(j)) + + do i=iuwv(j), 0 + qtmpv(i,j) = qv(im+i,j) + enddo + +! Figure out ghost zone for the eastern edge: + iuev(j) = im - cv(im,j) + iuev(j) = max(imp, iuev(j)) + + do i=imp, iuev(j) + qtmpv(i,j) = qv(i-im,j) + enddo + + enddo +!call ftrace_region_end("xtpv_2") + +!call ftrace_region_begin("xtpv_3") + do ja = 1, jattn + j = jatt(ja) + + do i=1,im + iu = cv(i,j) + if(cv(i,j) .le. D0_0) then + itmp = i - iu + isave(i,j) = itmp - 1 + else + itmp = i - iu - 1 + isave(i,j) = itmp + 1 + endif + fxv(i,j) = (cv(i,j)-iu) * qtmpv(itmp,j) + enddo + + enddo +!call ftrace_region_end("xtpv_3") + +!call ftrace_region_begin("xtpv_4") + do ja = 1, jatfn + j = jatf(ja) + + do i=1,im +! 2nd order slope + tmp = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qmax = max(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - qtmpv(i,j) + qmin = qtmpv(i,j) - min(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) + dmv(i,j) = sign(min(abs(tmp),qmax,qmin), tmp) + enddo + + do i=iuwv(j), 0 + dmv(i,j) = dmv(im+i,j) + enddo + + do i=imp, iuev(j) + dmv(i,j) = dmv(i-im,j) + enddo + + enddo +!call ftrace_region_end("xtpv_4") + + call fxppmv(im, cv, mfxv, qtmpv, dmv, fxv, iord, & + iuwv, iuev, ffslv, isave, jatftn, jatft, jlow, jhigh, & + jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) + +!call ftrace_region_begin("xtpv_5") + do ja = 1, jatffn + j = jatff(ja) + + do i=1,im + iu = cv(i,j) + rut = cv(i,j) - iu + if(cv(i,j) .le. D0_0) then + itmp = i - iu + isave(i,j) = itmp - 1 + fxv(i,j) = rut*(qtmpv(itmp,j)-dmv(itmp,j)*(D1_0+rut)) + else + itmp = i - iu - 1 + isave(i,j) = itmp + 1 + fxv(i,j) = rut*(qtmpv(itmp,j)+dmv(itmp,j)*(D1_0-rut)) + endif + enddo + + enddo +!call ftrace_region_end("xtpv_5") + +!call ftrace_region_begin("xtpv_6") + do ja = 1, jatn + j = jat(ja) + qsum(iuwv(j)-1,j) = D0_0 + do i = iuwv(j), iuev(j) + qsum(i,j) = qsum(i-1,j) + qtmpv(i,j) + end do + +! +! The boolean terms: +! a) .and. (isave(i,j) < i) +! b) .and. (i <= isave(i,j)) +! are needed in the IF statements below because I cannot prove to myself +! that the relationship between i and isave are such to guarantee that +! there is always at least one term from qsum (qtmpv,j) contributed to fxv. +! + + do i=1,im + if(cv(i,j) >= D1_0 .and. (isave(i,j) < i) ) then + fxv(i,j) = fxv(i,j) + (qsum(i-1,j) - qsum(isave(i,j) - 1,j)) + else if (cv(i,j) <= -D1_0 .and. (i <= isave(i,j)) ) then + fxv(i,j) = fxv(i,j) - (qsum(isave(i,j),j) - qsum(i-1,j)) + end if + end do + + if(id .ne. 0) then + do i=1,im + fxv(i,j) = fxv(i,j)*mfxv(i,j) + enddo + endif + + enddo +!call ftrace_region_end("xtpv_6") + +! Regular PPM (Eulerian without FFSL extension) + +!call ftrace_region_begin("xtpv_7") + do ja = 1, jafn + j = jaf(ja) + + qtmpv(imp,j) = qv(1,j) + qtmpv( 0,j) = qv(im,j) + enddo + + do ja = 1, jaftn + j = jaft(ja) + + do i=1,im + iu = real(i,r8) - cv(i,j) + fxv(i,j) = mfxv(i,j)*qtmpv(iu,j) + enddo + enddo + + do ja = 1, jaffn + j = jaff(ja) + + qtmpv(-1,j) = qv(im-1,j) + qtmpv(imp+1,j) = qv(2,j) + + enddo +!call ftrace_region_end("xtpv_7") + +!call ftrace_region_begin("xtpv_8") + do ja = 1, jafftn1 + j = jafft1(ja) + +! In-line xmist + + do i=1,im + dmv(i,j) = r24*(D8_0*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qtmpv(i-2,j) - qtmpv(i+2,j)) + enddo + +! Apply monotonicity constraint (Lin et al. 1994, MWR) + do i=1,im + qmax = max( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - qtmpv(i,j) + qmin = qtmpv(i,j) - min( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) + dmv(i,j) = sign( min(abs(dmv(i,j)), qmax, qmin), dmv(i,j) ) + enddo + + enddo +!call ftrace_region_end("xtpv_8") + +!call ftrace_region_begin("xtpv_9") + do ja = 1, jafffn1 + j = jafff1(ja) + +! In-line xmist + + if(iord .le. 2) then + do i=1,im + dmv(i,j) = r24*(D8_0*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qtmpv(i-2,j) - qtmpv(i+2,j)) + enddo + else + do i=1,im + dmv(i,j) = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) + enddo + endif + + if( iord >= 0 ) then + +! Apply monotonicity constraint (Lin et al. 1994, MWR) + do i=1,im + qmax = max( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - qtmpv(i,j) + qmin = qtmpv(i,j) - min( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) + dmv(i,j) = sign( min(abs(dmv(i,j)), qmax, qmin), dmv(i,j) ) + enddo + endif + + enddo +!call ftrace_region_end("xtpv_9") + +!call ftrace_region_begin("xtpv_10") + do ja = 1, jaffn + j = jaff(ja) + + dmv(0,j) = dmv(im,j) + + enddo +!call ftrace_region_end("xtpv_10") + +!call ftrace_region_begin("xtpv_11") + do ja = 1, jafftn2 + j = jafft2(ja) + + do i=1,im + iu = real(i,r8) - cv(i,j) + fxv(i,j) = mfxv(i,j)*(qtmpv(iu,j)+dmv(iu,j)*(sign(D1_0,cv(i,j))-cv(i,j))) + enddo + + enddo +!call ftrace_region_end("xtpv_11") + + call fxppmv(im, cv, mfxv, qtmpv, dmv, fxv, iord, & + iuwv, iuev, ffslv, isave, jafffn2, jafff2, jlow, jhigh, & + jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) + + return +!EOC + end subroutine xtpv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: fxppmv +! +! !INTERFACE: + + subroutine fxppmv(im, c, mfx, p, dm, fx, iord, & + iuw, iue, ffsl, isave, jan, ja, jlow, jhigh, & + jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) +!----------------------------------------------------------------------- +! +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer jan, ja(jan), jlow, jhigh, jj, j + integer jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11 + integer im, iord + real (r8) c(im,jl5:jh5) + real (r8) p(-im/3:im+im/3,jl11:jh11) + real (r8) dm(-im/3:im+im/3,jlow:jhigh) + real (r8) mfx(im,jl7:jh7) + integer iuw(jlow:jhigh), iue(jlow:jhigh) + logical ffsl(jl2:jh2) + integer isave(im,jlow:jhigh) + +! !OUTPUT PARAMETERS: + real (r8) fx(im,jl3:jh3) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real (r8) r3, r23 + parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) + + integer i, lmt + integer iu, itmp + real (r8) ru + logical steep + real (r8) al(-im/3:im+im/3,jlow:jhigh) + real (r8) ar(-im/3:im+im/3,jlow:jhigh) + real (r8) a6(-im/3:im+im/3,jlow:jhigh) + + integer jbtn, jbfn + integer jbt(jan), jbf(jan) + integer ilow, ihigh + + ilow = -im/3 + ihigh = im + im/3 + + if( iord == 6 ) then + steep = .true. + else + steep = .false. + endif + + do jj = 1, jan + j = ja(jj) + + do i=1,im + al(i,j) = D0_5*(p(i-1,j)+p(i,j)) + (dm(i-1,j) - dm(i,j))*r3 + enddo + + enddo + + if (steep) then + + call steepxv( im, p, al, dm, jan, ja, jlow, jhigh, jl11, jh11 ) + + endif + + do jj = 1, jan + j = ja(jj) + + do i=1,im-1 + ar(i,j) = al(i+1,j) + enddo + ar(im,j) = al(1,j) + + enddo + + if(iord == 7) then + + call huynhv(im, ar, al, p, a6, dm, jan, ja, jlow, jhigh, jl11, jh11 ) + + else + + if(iord .eq. 3 .or. iord .eq. 5) then + + do jj = 1, jan + j = ja(jj) + + do i=1,im + a6(i,j) = D3_0*(p(i,j)+p(i,j) - (al(i,j)+ar(i,j))) + enddo + + enddo + endif + + lmt = iord - 3 + + call lmppmv( dm, a6, ar, al, p, im, lmt, jan, ja, ilow, ihigh, & + jlow, jhigh, jl11, jh11 ) + + endif + + jbtn = 0 + jbfn = 0 + do jj = 1, jan + j = ja(jj) + if( ffsl(j) ) then + jbtn = jbtn + 1 + jbt(jbtn) = j + else + jbfn = jbfn + 1 + jbf(jbfn) = j + endif + enddo + + do jj = 1, jbtn + j = jbt(jj) + + do i=iuw(j), 0 + al(i,j) = al(im+i,j) + ar(i,j) = ar(im+i,j) + a6(i,j) = a6(im+i,j) + enddo + + do i=im+1, iue(j) + al(i,j) = al(i-im,j) + ar(i,j) = ar(i-im,j) + a6(i,j) = a6(i-im,j) + enddo + + do i=1,im + iu = c(i,j) + ru = c(i,j) - iu + if(c(i,j) .gt. D0_0) then + itmp = i - iu - 1 + isave(i,j) = itmp + 1 + fx(i,j) = ru*(ar(itmp,j)+D0_5*ru*(al(itmp,j)-ar(itmp,j) + & + a6(itmp,j)*(D1_0-r23*ru)) ) + else + itmp = i - iu + isave(i,j) = itmp - 1 + fx(i,j) = ru*(al(itmp,j)-D0_5*ru*(ar(itmp,j)-al(itmp,j) + & + a6(itmp,j)*(D1_0+r23*ru)) ) + endif + enddo + + enddo + + do jj = 1, jbfn + j = jbf(jj) + + al(0,j) = al(im,j) + ar(0,j) = ar(im,j) + a6(0,j) = a6(im,j) + do i=1,im + if(c(i,j) .gt. D0_0) then + fx(i,j) = ar(i-1,j) + D0_5*c(i,j)*(al(i-1,j) - ar(i-1,j) + & + a6(i-1,j)*(D1_0-r23*c(i,j)) ) + else + fx(i,j) = al(i,j) - D0_5*c(i,j)*(ar(i,j) - al(i,j) + & + a6(i,j)*(D1_0+r23*c(i,j))) + endif + fx(i,j) = mfx(i,j) * fx(i,j) + enddo + + enddo + + return +!EOC + end subroutine fxppmv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: steepxv +! +! !INTERFACE: + subroutine steepxv(im, p, al, dm, jan, ja, jlow, jhigh, jl11, jh11 ) +!----------------------------------------------------------------------- + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer im + integer jan, ja(jan), jlow, jhigh, jl11, jh11 + real (r8) p(-im/3:im+im/3,jl11:jh11) + real (r8) dm(-im/3:im+im/3,jlow:jhigh) + +! !INPUT/OUTPUT PARAMETERS: + real (r8) al(im,jlow:jhigh) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, jj, j + real (r8) r3 + parameter ( r3 = D1_0/D3_0 ) + + real (r8) dh(0:im,jlow:jhigh) + real (r8) d2(0:im+1,jlow:jhigh) + real (r8) eta(0:im,jlow:jhigh) + real (r8) xxx, bbb, ccc + + do jj = 1, jan + j = ja(jj) + + do i=0,im + dh(i,j) = p(i+1,j) - p(i,j) + enddo + +! Needs dh(0:im,j) + do i=1,im + d2(i,j) = dh(i,j) - dh(i-1,j) + enddo + d2(0,j) = d2(im,j) + d2(im+1,j) = d2(1,j) + +! needs p(-1:im+2,j), d2(0:im+1,j) + do i=1,im + if( d2(i+1,j)*d2(i-1,j).lt.D0_0 .and. p(i+1,j).ne.p(i-1,j) ) then + xxx = D1_0 - D0_5 * ( p(i+2,j) - p(i-2,j) ) / ( p(i+1,j) - p(i-1,j) ) + eta(i,j) = max(D0_0, min(xxx, D0_5) ) + else + eta(i,j) = D0_0 + endif + enddo + + eta(0,j) = eta(im,j) + +! needs eta(0:im,j), dh(0:im-1,j), dm(0:im,j) + do i=1,im + bbb = ( D2_0*eta(i,j ) - eta(i-1,j) ) * dm(i-1,j) + ccc = ( D2_0*eta(i-1,j) - eta(i,j ) ) * dm(i,j ) + al(i,j) = al(i,j) + D0_5*( eta(i-1,j) - eta(i,j)) * dh(i-1,j) + (bbb - ccc) * r3 + enddo + + enddo + + return +!EOC + end subroutine steepxv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: huynhv --- Enforce Huynh's 2nd constraint in 1D periodic domain +! +! !INTERFACE: + subroutine huynhv(im, ar, al, p, d2, d1, jan, ja, jlow, jhigh, jl11, jh11) +!----------------------------------------------------------------------- + +! !USES: + + implicit none + +! !INPUT PARAMETERS: + integer im + integer jan, ja(jan), jlow, jhigh, jl11, jh11 + real(r8) p(im,jl11:jh11) + +! !OUTPUT PARAMETERS: + real(r8) ar(im,jlow:jhigh) + real(r8) al(im,jlow:jhigh) + real(r8) d2(im,jlow:jhigh) + real(r8) d1(im,jlow:jhigh) + +! !DESCRIPTION: +! +! Enforce Huynh's 2nd constraint in 1D periodic domain +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer i, jj, j + real(r8) pmp + real(r8) lac + real(r8) pmin + real(r8) pmax + + do jj = 1, jan + j = ja(jj) + +! Compute d1 and d2 + d1(1,j) = p(1,j) - p(im,j) + do i=2,im + d1(i,j) = p(i,j) - p(i-1,j) + enddo + + do i=1,im-1 + d2(i,j) = d1(i+1,j) - d1(i,j) + enddo + d2(im,j) = d1(1,j) - d1(im,j) + +! Constraint for AR +! i = 1 + pmp = p(1,j) + D2_0 * d1(1,j) + lac = p(1,j) + D0_5 * (d1(1,j)+d2(im,j)) + d2(im,j) + pmin = min(p(1,j), pmp, lac) + pmax = max(p(1,j), pmp, lac) + ar(1,j) = min(pmax, max(ar(1,j), pmin)) + + do i=2, im + pmp = p(i,j) + D2_0*d1(i,j) + lac = p(i,j) + D0_5*(d1(i,j)+d2(i-1,j)) + d2(i-1,j) + pmin = min(p(i,j), pmp, lac) + pmax = max(p(i,j), pmp, lac) + ar(i,j) = min(pmax, max(ar(i,j), pmin)) + enddo + +! Constraint for AL + do i=1, im-1 + pmp = p(i,j) - D2_0*d1(i+1,j) + lac = p(i,j) + D0_5*(d2(i+1,j)-d1(i+1,j)) + d2(i+1,j) + pmin = min(p(i,j), pmp, lac) + pmax = max(p(i,j), pmp, lac) + al(i,j) = min(pmax, max(al(i,j), pmin)) + enddo + +! i=im + i = im + pmp = p(im,j) - D2_0*d1(1,j) + lac = p(im,j) + D0_5*(d2(1,j)-d1(1,j)) + d2(1,j) + pmin = min(p(im,j), pmp, lac) + pmax = max(p(im,j), pmp, lac) + al(im,j) = min(pmax, max(al(im,j), pmin)) + +! compute A6 (d2) + do i=1, im + d2(i,j) = D3_0*(p(i,j)+p(i,j) - (al(i,j)+ar(i,j))) + enddo + + enddo + + return +!EOC + end subroutine huynhv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: lmppmv +! +! !INTERFACE: + subroutine lmppmv(dm, a6, ar, al, p, im, lmt, jan, ja, & + ilow, ihigh, jlow, jhigh, jl11, jh11) +!----------------------------------------------------------------------- + + implicit none + +! !INPUT PARAMETERS: + integer im ! Total longitudes + integer jan, ja(jan), ilow, ihigh, jlow, jhigh, jl11, jh11 + integer lmt ! LMT = 0: full monotonicity + ! LMT = 1: Improved and simplified full monotonic constraint + ! LMT = 2: positive-definite constraint + ! LMT = 3: Quasi-monotone constraint + real(r8) p(ilow:ihigh,jl11:jh11) + real(r8) dm(ilow:ihigh,jlow:jhigh) + +! !OUTPUT PARAMETERS: + real(r8) a6(ilow:ihigh,jlow:jhigh) + real(r8) ar(ilow:ihigh,jlow:jhigh) + real(r8) al(ilow:ihigh,jlow:jhigh) + +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.01 Lin Creation +! 01.03.27 Sawyer Additional ProTeX documentation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + real (r8) r12 + parameter ( r12 = D1_0/D12_0 ) + + real (r8) da1, da2, fmin, a6da + real (r8) dr, dl + + integer i, jj, j + +! LMT = 0: full monotonicity +! LMT = 1: Improved and simplified full monotonic constraint +! LMT = 2: positive-definite constraint +! LMT = 3: Quasi-monotone constraint + + if( lmt == 0 ) then + +! Full constraint + + do jj = 1, jan + j = ja(jj) + + do i=1,im + if(dm(i,j) .eq. D0_0) then + ar(i,j) = p(i,j) + al(i,j) = p(i,j) + a6(i,j) = D0_0 + else + da1 = ar(i,j) - al(i,j) + da2 = da1**2 + a6da = a6(i,j)*da1 + if(a6da .lt. -da2) then + a6(i,j) = D3_0*(al(i,j)-p(i,j)) + ar(i,j) = al(i,j) - a6(i,j) + elseif(a6da .gt. da2) then + a6(i,j) = D3_0*(ar(i,j)-p(i,j)) + al(i,j) = ar(i,j) - a6(i,j) + endif + endif + enddo + + enddo + + elseif( lmt == 1 ) then + +! Improved (Lin 2001?) full constraint + + do jj = 1, jan + j = ja(jj) + + do i=1,im + da1 = dm(i,j) + dm(i,j) + dl = sign(min(abs(da1),abs(al(i,j)-p(i,j))), da1) + dr = sign(min(abs(da1),abs(ar(i,j)-p(i,j))), da1) + ar(i,j) = p(i,j) + dr + al(i,j) = p(i,j) - dl + a6(i,j) = D3_0*(dl-dr) + enddo + + enddo + + elseif( lmt == 2 ) then + +! Positive definite constraint + + do jj = 1, jan + j = ja(jj) + + do i=1,im + if(abs(ar(i,j)-al(i,j)) .lt. -a6(i,j)) then + fmin = p(i,j) + D0_25*(ar(i,j)-al(i,j))**2/a6(i,j) + a6(i,j)*r12 + if(fmin.lt.D0_0) then + if(p(i,j).lt.ar(i,j) .and. p(i,j).lt.al(i,j)) then + ar(i,j) = p(i,j) + al(i,j) = p(i,j) + a6(i,j) = D0_0 + elseif(ar(i,j) .gt. al(i,j)) then + a6(i,j) = D3_0*(al(i,j)-p(i,j)) + ar(i,j) = al(i,j) - a6(i,j) + else + a6(i,j) = D3_0*(ar(i,j)-p(i,j)) + al(i,j) = ar(i,j) - a6(i,j) + endif + endif + endif + enddo + + enddo + + elseif(lmt .eq. 3) then + +! Quasi-monotone constraint + + do jj = 1, jan + j = ja(jj) + + do i=1,im + da1 = D4_0*dm(i,j) + dl = sign(min(abs(da1),abs(al(i,j)-p(i,j))), da1) + dr = sign(min(abs(da1),abs(ar(i,j)-p(i,j))), da1) + ar(i,j) = p(i,j) + dr + al(i,j) = p(i,j) - dl + a6(i,j) = D3_0*(dl-dr) + enddo + + enddo + + endif + return +!EOC + end subroutine lmppmv +!----------------------------------------------------------------------- +#endif + +end module tp_core diff --git a/src/dynamics/fv/trac2d.F90 b/src/dynamics/fv/trac2d.F90 new file mode 100644 index 0000000000..82746de118 --- /dev/null +++ b/src/dynamics/fv/trac2d.F90 @@ -0,0 +1,433 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: trac2d --- Remap Lagrangian to fixed coordinates +! +! !INTERFACE: + subroutine trac2d( grid, dp1, tracer, cx, cy, & + mfx, mfy, iord, jord, fill, & + nlo, nhi, va, flx ) + +! !USES: + + use shr_kind_mod, only : r8 => shr_kind_r8, r4 => shr_kind_r4 + use tp_core, only : tp2c + use fill_module, only : fillxy + use dynamics_vars, only : T_FVDYCORE_GRID + use FVperf_module, only : FVstartclock, FVstopclock, FVbarrierclock + +#if defined( SPMD ) + use parutilitiesmodule, only: maxop, parcollective + use mod_comm, only : mp_send4d_ns, mp_recv4d_ns, & + mp_send4d_ns_r4, mp_recv4d_ns_r4, & + mp_send3d_2, mp_recv3d_2 +#endif + + implicit none + +! !INPUT PARAMETERS: + + type (T_FVDYCORE_GRID), intent(inout) :: grid + integer, intent(in):: iord, jord + + logical, intent(in):: fill + integer, intent(in):: nlo, nhi ! Tracer index range + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: dp1(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8), intent(inout):: cx(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) + real(r8), intent(inout):: cy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) + real(r8), intent(inout):: mfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8), intent(inout):: mfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) + real(r8), intent(inout):: tracer(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast,grid%ntotq) + +! !OUTPUT PARAMETERS: + real(r8), intent(out):: va(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + real(r8), intent(out):: flx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + +! !DESCRIPTION: +! +! Perform large-time-step tracer transport using accumulated Courant +! numbers (cx, cy) and the mass fluxes (mfx, mfy) within the Lagrangian +! layers. This routine is 100\% parallel in the vertical direction +! (with SMP). Merdional Courant number will be further split, if +! necessary, to ensure stability. Cy <= 1 away from poles; Cy $\le$ +! 1/2 at the latitudes closest to the poles. +! +! !REVISION HISTORY: +! +! SJL 99.04.13: Delivery +! WS 99.05.26: Added jfirst:jlast concept; im, jm, km as parameters +! replaced IMR, JMR, JNP, NL with IM, JM-1, JM and KM +! WS 99.09.27: Documentation; indentation; jfirst:jlast +! WS 99.09.30: Ghosting; loop limits; full parallelization; tested +! SJL 99.10.15: nsplt migrated to outermost loop to remove bug +! SJL 99.12.19: Local 2D arrays trimmed! +! WS 00.05.14: Renamed ghost indices as per Kevin's definitions +! WS 00.07.13: Changed PILGRIM API +! AAM 00.08.29: Added kfirst, klast +! AAM 01.06.27: Added y communicators +! SJL 30.07.01: MPI optimization/simplification +! WS 02.04.24: New mod_comm interfaces +! WS 02.07.04: Fixed 2D decomposition bug dest/src for mp_send3d +! WS 03.11.19: Merged in CAM changes by Mirin +! WS 03.12.03: Added GRID as argument, dynamics_vars removed +! WS 04.08.25: Simplification of interface with GRID +! WS 04.10.07: Removed dependency on spmd_dyn; info now in GRID +! WS 05.04.04: Transitioned to type T_TRACERS (supports r4 and r8) +! WS 05.04.09: Each tracer now ghosted individually (save buffers) +! WS 05.04.12: Full support for either r4 or r8 tracers +! WS 05.05.25: Merged CAM and GEOS5, e.g. nsplt(k) opt. in CAM +! PW 05.10.12: Changes for Cray X1(E), alternative implementation +! of double buffering logic +! WS 06.09.08: Magic numbers are now F90 parameters +! +!EOP +!--------------------------------------------------------------------- +!BOC + + real(r8), parameter :: D1EM10 = 1.0e-10_r8 + real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D0_0 = 0.0_r8 + +! Local variables: +! 2d arrays + real(r8) a2(grid%im,grid%jfirst:grid%jlast) + real(r8) fx(grid%im,grid%jfirst:grid%jlast) + real(r8) fy(grid%im,grid%jfirst:grid%jlast+1) + real(r8) cymax(grid%kfirst:grid%klast) +! Temporary r8 array for Q + real(r8) :: & + q_r8(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast,1:2) + + real(r8) dp2(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) + logical ffsl(grid%jm,grid%kfirst:grid%klast) + integer :: nsplt(grid%kfirst:grid%klast) + + integer :: im, jm, km ! Dimensions + integer :: ng ! Max number of ghost latitudes + integer :: jfirst, jlast, kfirst, klast ! YZ decomposition limits + integer :: cur, nxt ! current and next q_r8 buffer indices + + integer i, j, k + integer it, iq, kq, max_nsplt + integer :: k_courant, kend + integer ktot + integer js1gd, js2g0, js2gd, jn2g0,jn2gd,jn1g1,jn1gd +#if defined( SPMD ) + integer :: dest, src +#endif + + real(r8) cy_global + real(r8) frac + real(r8) cmax + real(r8) sum1, sum2 + + cur = 1 + nxt = 2 + + im = grid%im + jm = grid%jm + km = grid%km + ng = grid%ng_d + + jfirst = grid%jfirst + jlast = grid%jlast + kfirst = grid%kfirst + klast = grid%klast + + ktot = klast - kfirst + 1 + js2g0 = max(2,jfirst) + jn2g0 = min(jm-1,jlast) + jn1g1 = min(jm,jlast+1) + js1gd = max(1,jfirst-ng) ! NG latitudes on S (starting at 1) + js2gd = max(2,jfirst-ng) ! NG latitudes on S (starting at 2) + jn2gd = min(jm-1,jlast+ng) ! NG latitudes on S (ending at jm-1) + jn1gd = min(jm,jlast+ng) ! NG latitudes on N (ending at jm) + +#if defined( SPMD ) + call FVstartclock(grid,'---TRAC2D_COMM') + call mp_send4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, klast, & + ng, ng, cx ) +! Send one latitude of both cy and mfy to the south + dest = grid%iam-1 + src = grid%iam+1 + if ( mod(grid%iam,grid%npr_y) == 0 ) dest = -1 + if ( mod(grid%iam+1,grid%npr_y) == 0 ) src = -1 + call mp_send3d_2( grid%commyz, dest, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jfirst, jfirst, kfirst, klast, cy, mfy) + call FVstopclock(grid,'---TRAC2D_COMM') +#endif + +!$omp parallel do default(shared) private(i,j,k,cmax) + do k=kfirst,klast + cymax(k) = D0_0 + do j=js2g0,jlast + cmax = D0_0 + do i=1,im + cmax = max( abs(cy(i,j,k)), cmax) + enddo + cymax(k) = max(cymax(k), cmax*(D1_0 + grid%sine(j)**16) ) + enddo + enddo + +#if defined( SPMD ) + call FVstartclock(grid,'---TRAC2D_COMM') + call mp_recv4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, klast, & + ng, ng, cx ) + call mp_recv3d_2( grid%commyz, src, im, jm, km, & + 1, im, jfirst, jlast+1, kfirst, klast, & + 1, im, jlast+1, jlast+1, kfirst, klast, cy, mfy) + + call parcollective( grid%comm_y, MAXOP, ktot, cymax ) + call FVstopclock(grid,'---TRAC2D_COMM') +#endif + +!--------------------------------------------------------------------- +! Determine the required value of nsplt for each level +!--------------------------------------------------------------------- + nsplt(:) = int( D1_0 + cymax(:) ) + max_nsplt = maxval( nsplt(:) ) +#if defined( SPMD ) + call FVstartclock(grid,'---TRAC2D_COMM') + call parcollective( grid%comm_z, MAXOP, max_nsplt ) ! Find global max + call FVstopclock(grid,'---TRAC2D_COMM') +#endif + if (grid%ptop>1._r8) then + nsplt(:) = max_nsplt + endif + do k_courant = klast,kfirst,-1 + if( nsplt(k_courant) > 1 ) then + exit + end if + end do + k_courant = max( kfirst,k_courant ) +!!! if (max_nsplt /= 1) write(iulog,*) 'trac2d: max_nsplt,k_courant = ', max_nsplt,k_courant +!!! write(iulog,*) "max_nsplt", max_nsplt, "k_cour", k_courant, "nsplt", nsplt(:) + +!$omp parallel do default(shared) private(i,j,k,frac) schedule(dynamic,1) + +#if !defined(USE_OMP) +!CSD$ PARALLEL DO PRIVATE (I, J, K, FRAC) +#endif + do 4000 k=kfirst,klast + + if( nsplt(k) .ne. 1 ) then + frac = D1_0 / nsplt(k) + do j=js2gd,jn2gd + do i=1,im + cx(i,j,k) = cx(i,j,k) * frac ! cx ghosted on N*ng S*ng + enddo + enddo + + do j=js2g0,jn2g0 + do i=1,im + mfx(i,j,k) = mfx(i,j,k) * frac + enddo + enddo + + do j=js2g0,jn1g1 + do i=1,im + cy(i,j,k) = cy(i,j,k) * frac ! cy ghosted on N + mfy(i,j,k) = mfy(i,j,k) * frac ! mfy ghosted on N + enddo + enddo + endif + + do j=js2g0,jn2g0 + do i=1,im + if(cy(i,j,k)*cy(i,j+1,k) > D0_0) then + if( cy(i,j,k) > D0_0) then + va(i,j,k) = cy(i,j,k) + else + va(i,j,k) = cy(i,j+1,k) ! cy ghosted on N + endif + else + va(i,j,k) = D0_0 + endif + enddo + enddo + +! Check if FFSL extension is needed. + + do j=js2gd,jn2gd ! flux needed on N*ng S*ng + ffsl(j,k) = .false. + do i=1,im + if( abs(cx(i,j,k)) > D1_0 ) then ! cx ghosted on N*ng S*ng + ffsl(j,k) = .true. + exit + endif + enddo + enddo + +! Scale E-W mass fluxes by CX if FFSL + do j=js2g0,jn2g0 + if( ffsl(j,k) ) then + do i=1,im + flx(i,j,k) = mfx(i,j,k) / sign( max(abs(cx(i,j,k)), D1EM10), & + cx(i,j,k) ) + enddo + else + do i=1,im + flx(i,j,k) = mfx(i,j,k) + enddo + endif + enddo +4000 continue +#if !defined(USE_OMP) +!CSD$ END PARALLEL DO +#endif + + call FVbarrierclock(grid,'sync_trac2d_tracer',grid%commyz) + call FVstartclock(grid,'---TRAC2D_TRACER') + + do 6000 it=1, max_nsplt + if ( it == 1 ) then + kend = klast ! The entire vertical slab needs to be considered + else + kend = k_courant ! Only the subset including courant # > 1 considered + endif +! WS 05.04.06: send only the first tracer the rest at end of do iq loop +! NOTE: there is per definition at least one tracer + q_r8(1:im,jfirst:jlast,kfirst:kend,1) = & + tracer(1:im,jfirst:jlast,kfirst:kend,nlo) +#if defined( SPMD ) + call FVstartclock(grid,'---TRAC2D_TRACER_COMM') + call mp_send4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, kend, & + ng, ng, q_r8(1,jfirst-ng,kfirst,1) ) + call FVstopclock(grid,'---TRAC2D_TRACER_COMM') +#endif + +!$omp parallel do default(shared) private(i,j,k,sum1,sum2) + + do 3000 k=kfirst,kend + if (it <= nsplt(k)) then + do j=js2g0,jn2g0 + do i=1,im-1 + dp2(i,j,k) = dp1(i,j,k) + mfx(i,j,k) - mfx(i+1,j,k) + & + (mfy(i,j,k) - mfy(i,j+1,k)) * grid%acosp(j) + enddo + dp2(im,j,k) = dp1(im,j,k) + mfx(im,j,k) - mfx(1,j,k) + & + (mfy(im,j,k) - mfy(im,j+1,k)) * grid%acosp(j) + enddo + + if ( jfirst == 1 ) then + sum1 = D0_0 + do i=1,im + sum1 = sum1 + mfy(i,2,k) + end do + + sum1 = - sum1 * grid%rcap + do i=1,im + dp2(i,1,k) = dp1(i,1,k) + sum1 + enddo + endif + + if ( jlast == jm ) then + sum2 = D0_0 + do i=1,im + sum2 = sum2 + mfy(i,jm,k) + end do + + sum2 = sum2 * grid%rcap + do i=1,im + dp2(i,jm,k) = dp1(i,jm,k) + sum2 + enddo + endif + endif +3000 continue + + do iq = nlo, nhi +#if defined( SPMD ) + call FVstartclock(grid,'---TRAC2D_TRACER_COMM') +! +! The buffer indices are exchanged, so that cur points to the current buffer, +! while nxt points to the one which will be used next. +! + if ( mod(iq-nlo+1,2) == 0 ) then + cur = 2 + nxt = 1 + else + cur = 1 + nxt = 2 + endif + call mp_recv4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, kend, & + ng, ng, q_r8(1,jfirst-ng,kfirst,cur) ) + +! +! Pre-send the next tracer +! + if ( iq < nhi ) then + q_r8(1:im,jfirst:jlast,kfirst:kend,nxt) = & + tracer(1:im,jfirst:jlast,kfirst:kend,iq+1) + call mp_send4d_ns( grid%commyz, im, jm, km, & + 1, jfirst, jlast, kfirst, kend, & + ng, ng, q_r8(1,jfirst-ng,kfirst,nxt) ) + endif + call FVstopclock(grid,'---TRAC2D_TRACER_COMM') +#else +! +! No message passing -- simply copy the tracer into q_r8 +! + q_r8(1:im,jfirst:jlast,kfirst:kend,cur) = & + tracer(1:im,jfirst:jlast,kfirst:kend,iq) +#endif + +#if (!defined USE_OMP) +!CSD$ PARALLEL DO PRIVATE (I, J, K, KQ, FX, FY, A2) +#endif + do 5000 k=kfirst,kend + if ( it <= nsplt(k) ) then + call tp2c(a2, va(1,jfirst,k), q_r8(1:,jfirst-ng:,k,cur), & + cx(1,jfirst-ng,k) , cy(1,jfirst,k), & + im, jm, iord, jord, ng, & + fx, fy, ffsl(1,k), grid%rcap, grid%acosp, & + flx(1,jfirst,k), mfy(1,jfirst,k), & + grid%cosp, 1, jfirst, jlast ) + + do j=jfirst,jlast + do i=1,im + q_r8(i,j,k,cur) = q_r8(i,j,k,cur)*dp1(i,j,k) + a2(i,j) + enddo + enddo + + if (fill) call fillxy (q_r8(1:,jfirst:,k,cur), im, jm, jfirst, & + jlast, grid%acap, grid%cosp, grid%acosp) + + do j=jfirst,jlast + do i=1,im + tracer(i,j,k,iq) = q_r8(i,j,k,cur) / dp2(i,j,k) + enddo + enddo + endif +5000 continue +#if (!defined USE_OMP) +!CSD$ END PARALLEL DO +#endif + + enddo ! End of do iq=nlo, nhi + +!$omp parallel do private(i, j, k) schedule( dynamic,1 ) + do k=kfirst,kend + if ( it < nsplt(k) ) then + do j=jfirst,jlast + do i=1,im + dp1(i,j,k) = dp2(i,j,k) + enddo + enddo + endif + enddo + +6000 continue + call FVstopclock(grid,'---TRAC2D_TRACER') + + return +!EOC + end subroutine trac2d +!----------------------------------------------------------------------- + + diff --git a/src/dynamics/fv/uv3s_update.F90 b/src/dynamics/fv/uv3s_update.F90 new file mode 100644 index 0000000000..bcf29be3e4 --- /dev/null +++ b/src/dynamics/fv/uv3s_update.F90 @@ -0,0 +1,214 @@ +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: uv3s_update -- update u3s, v3s (XY decomposition) +! +! !INTERFACE: + +subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, & + am_correction) + +! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8 + +#if defined( SPMD ) + use parutilitiesmodule, only : pargatherreal + use mod_comm, only : mp_send3d, mp_recv3d +#endif + use cam_history, only: outfld + + use dynamics_vars, only: T_FVDYCORE_GRID + + implicit none +! !INPUT PARAMETERS: + type (T_FVDYCORE_GRID), intent(in) :: grid +! dudt on A-grid + real(r8),intent(in) :: dua(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy) +! dvdt on A-grid + real(r8),intent(in) :: dva(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy) + real(r8),intent(in) :: dt5 ! weighting factor + logical, intent(in) :: am_correction + +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: u3s(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, & + grid%km) ! U-Wind on D Grid + real(r8), intent(inout) :: v3s(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, & + grid%km) ! V-Wind on D Grid + +! !DESCRIPTION: +! +! This routine performs the update for the N-S staggered u-wind +! and the E-W staggered v-wind +! +! !REVISION HISTORY: +! WS 00.12.22 : Creation from d2a3d +! SJL 01.01.20 : modifications +! AAM 01.06.08 : Name change; folding in of v3s update and outfld calls +! WS 02.04.25 : New mod_comm interfaces +! WS 02.07.04 : Fixed 2D decomposition bug dest/src for mp_send3d +! WS 03.07.22 : Removed strip3zatyt4 from use list (no longer used) +! WS 05.07.14 : Simplified interface with grid argument +! WS 05.09.23 : Modified for XY decomposition +! +!EOP +!----------------------------------------------------------------------- +!BOC + + integer :: i, j, k + integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy, idim + +#if defined( SPMD ) + real(r8) :: duasouth(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: dvawest(grid%km,grid%jfirstxy:grid%jlastxy) + integer :: dest, src + integer :: iam, nprxy_x, myidxy_y +#endif + real(r8) :: tmp + real(r8) :: u3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: v3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: fu3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) :: fv3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) + real(r8) :: fu3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km) + real(r8) :: fv3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km) + + ! AM correction + real(r8), pointer :: cosp(:), cose(:) + + cosp => grid%cosp + cose => grid%cose + + fu3s(:,:,:) = 0._r8 + fv3s(:,:,:) = 0._r8 + + im = grid%im + jm = grid%jm + km = grid%km + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + +#if defined( SPMD ) + iam = grid%iam + nprxy_x = grid%nprxy_x + myidxy_y = grid%myidxy_y +! +! Transfer dua(:,jlast) to the node directly to the north; dva(ifirst, to east) +! + call mp_send3d( grid%commxy, iam+nprxy_x, iam-nprxy_x, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ifirstxy, ilastxy, 1, km, jlastxy, jlastxy, dua ) + call mp_recv3d( grid%commxy, iam-nprxy_x, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, & + ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, duasouth ) + + dest = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x) + src = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x) + call mp_send3d( grid%commxy, dest, src, im, km, jm, & + ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, & + ilastxy, ilastxy, 1, km, jfirstxy, jlastxy, dva ) + call mp_recv3d( grid%commxy, src, im, km, jm, & + ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, & + ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, dvawest ) +#endif + +!$omp parallel do private (i, j, k) + + do k = 1, km + +! +! Adjust D-grid winds by interpolating A-grid tendencies. +! + + if (am_correction) then + do j = jfirstxy+1, jlastxy + do i = ifirstxy, ilastxy + tmp = u3s(i,j,k) + u3s (i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j)*cosp(j) + & + dua(i,k,j-1)*cosp(j-1))/cose(j) ! torque + fu3s(i,j,k) = (u3s(i,j,k) - tmp)/(2._r8*dt5) + end do + end do + else + do j = jfirstxy+1, jlastxy + do i = ifirstxy, ilastxy + tmp = u3s(i,j,k) + u3s (i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j) + dua(i,k,j-1)) ! force + fu3s(i,j,k) = (u3s(i,j,k) - tmp)/(2._r8*dt5) + end do + end do + end if + + do j = max(jfirstxy,2), min(jlastxy,jm-1) + do i=ifirstxy+1,ilastxy + tmp = v3s(i,j,k) + v3s (i,j,k) = v3s(i,j,k) + dt5*(dva(i,k,j)+dva(i-1,k,j)) + fv3s(i,j,k) = (v3s(i,j,k) - tmp)/(2._r8*dt5) + enddo + enddo + +#if defined( SPMD ) + if (am_correction) then + if ( jfirstxy .gt. 1 ) then + do i = ifirstxy, ilastxy + tmp = u3s(i,jfirstxy,k) + u3s (i,jfirstxy,k) = u3s(i,jfirstxy,k) + & + dt5*( dua(i,k,jfirstxy)*cosp(jfirstxy) + & + duasouth(i,k)*cosp(jfirstxy-1))/cose(jfirstxy) + fu3s(i,jfirstxy,k) = (u3s(i,jfirstxy,k) - tmp)/(2._r8*dt5) + end do + end if + else + if ( jfirstxy .gt. 1 ) then + do i = ifirstxy, ilastxy + tmp = u3s(i,jfirstxy,k) + u3s (i,jfirstxy,k) = u3s(i,jfirstxy,k) + & + dt5*( dua(i,k,jfirstxy) + duasouth(i,k) ) + fu3s(i,jfirstxy,k) = (u3s(i,jfirstxy,k) - tmp)/(2._r8*dt5) + end do + end if + end if + + do j = max(jfirstxy,2), min(jlastxy,jm-1) + tmp = v3s(ifirstxy,j,k) + v3s (ifirstxy,j,k) = v3s(ifirstxy,j,k) + dt5*(dva(ifirstxy,k,j)+dvawest(k,j)) + fv3s(ifirstxy,j,k) = (v3s(ifirstxy,j,k) - tmp)/(2._r8*dt5) + enddo +#else + do j = max(jfirstxy,2), min(jlastxy,jm-1) + tmp = v3s(1,j,k) + v3s (1,j,k) = v3s(1,j,k) + dt5*(dva(1,k,j)+dva(im,k,j)) + fv3s(1,j,k) = (v3s(1,j,k) - tmp)/(2._r8*dt5) + enddo +#endif + + enddo + + idim = ilastxy - ifirstxy + 1 + +!$omp parallel do private (i, j, k, u3s_tmp, v3s_tmp, fu3s_tmp, fv3s_tmp) + + do j = jfirstxy, jlastxy + do k = 1, km + do i = ifirstxy, ilastxy + u3s_tmp (i,k) = u3s (i,j,k) + v3s_tmp (i,k) = v3s (i,j,k) + fu3s_tmp(i,k) = fu3s(i,j,k) + fv3s_tmp(i,k) = fv3s(i,j,k) + enddo + enddo + + call outfld ('FU ', dua(:,:,j), idim, j ) + call outfld ('FV ', dva(:,:,j), idim, j ) + call outfld ('US ', u3s_tmp , idim, j ) + call outfld ('VS ', v3s_tmp , idim, j ) + call outfld ('FU_S ', fu3s_tmp , idim, j ) + call outfld ('FV_S ', fv3s_tmp , idim, j ) + + enddo + + return +!EOC + end subroutine uv3s_update +!----------------------------------------------------------------------- diff --git a/src/dynamics/fv/zonal_mean.F90 b/src/dynamics/fv/zonal_mean.F90 new file mode 100644 index 0000000000..de8360d2c3 --- /dev/null +++ b/src/dynamics/fv/zonal_mean.F90 @@ -0,0 +1,56 @@ +module zonal_mean + +use shr_kind_mod, only: r8 => shr_kind_r8 +use dynamics_vars, only: T_FVDYCORE_GRID +use pmgrid, only: plon + +implicit none +private +save + +public :: zonal_mean_3D + +real(r8), parameter :: rplon = 1._r8/plon + +! External that does parallel sums reproducibly. +interface + subroutine par_xsum(grid, a, ltot, sum) + import + type (T_FVDYCORE_GRID), intent(in) :: grid + integer, intent(in) :: ltot + real (r8), intent(in) :: a(grid%ifirstxy:grid%ilastxy,ltot) + real (r8) sum(ltot) + end subroutine par_xsum +end interface + +contains + +subroutine zonal_mean_3D(grid, nlev, fld_orig, fld_zm) + + ! FV dynamics grid + type(T_FVDYCORE_GRID), intent(in) :: grid + ! Number of vertical levels + integer, intent(in) :: nlev + ! Original field + real(r8), intent(in) :: fld_orig(grid%ifirstxy:grid%ilastxy,nlev,grid%jfirstxy:grid%jlastxy) + ! Zonal mean field + real(r8), intent(out) :: fld_zm(nlev,grid%jfirstxy:grid%jlastxy) + + integer :: j + + ! Rename grid bounds for convenience. + associate(beglon => grid%ifirstxy, & + endlon => grid%ilastxy, & + beglat => grid%jfirstxy, & + endlat => grid%jlastxy) + + do j = beglat, endlat + call par_xsum( grid, fld_orig(beglon:endlon,:,j), nlev, fld_zm(:,j) ) + fld_zm(:,j) = fld_zm(:,j) * rplon + end do + + end associate + +end subroutine zonal_mean_3D + +end module zonal_mean diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 new file mode 100644 index 0000000000..9da47c745f --- /dev/null +++ b/src/dynamics/se/dp_coupling.F90 @@ -0,0 +1,901 @@ +module dp_coupling + +!------------------------------------------------------------------------------- +! dynamics - physics coupling module +!------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: begchunk, endchunk, pcols, pver, pverp +use constituents, only: pcnst, cnst_type + +use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs +use spmd_utils, only: mpicom, iam +use dyn_grid, only: get_gcol_block_d, TimeLevel, edgebuf +use dyn_comp, only: dyn_export_t, dyn_import_t + +use physics_types, only: physics_state, physics_tend +use phys_grid, only: get_ncols_p, get_gcol_all_p, block_to_chunk_send_pters, & + transpose_block_to_chunk, block_to_chunk_recv_pters, & + chunk_to_block_send_pters, transpose_chunk_to_block, & + chunk_to_block_recv_pters +use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field + +use dp_mapping, only: nphys_pts + +use cam_logfile, only: iulog +use perf_mod, only: t_startf, t_stopf, t_barrierf +use cam_abortutils, only: endrun + +use parallel_mod, only: par +use thread_mod, only: horz_num_threads +use hybrid_mod, only: config_thread_region, get_loop_ranges, hybrid_t +use dimensions_mod, only: np, npsq, nelemd, nlev, nc, qsize, ntrac, fv_nphys + +use dof_mod, only: UniquePoints, PutUniquePoints +use element_mod, only: element_t +use fvm_control_volume_mod, only: fvm_struct + +implicit none +private +save + +public :: d_p_coupling, p_d_coupling + +real (kind=r8), allocatable :: q_prev(:,:,:,:) ! Previous Q for computing tendencies + +!========================================================================================= +CONTAINS +!========================================================================================= + +subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) + + use gravity_waves_sources, only: gws_src_fnct + use dyn_comp, only: frontgf_idx, frontga_idx + use phys_control, only: use_gw_front, use_gw_front_igw + use hycoef, only: hyai, ps0 + use fvm_control_volume_mod, only: n0_fvm + use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars + use time_mod, only: timelevel_qdp + use control_mod, only: qsplit + use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state + + ! arguments + type(dyn_export_t), intent(inout) :: dyn_out ! dynamics export + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + + + ! LOCAL VARIABLES + type(element_t), pointer :: elem(:) ! pointer to dyn_out element array + integer :: ie ! indices over elements + integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers + + real (kind=r8), allocatable :: ps_tmp(:,:) ! temp array to hold ps + real (kind=r8), allocatable :: dp3d_tmp(:,:,:) ! temp array to hold dp3d + real (kind=r8), allocatable :: dp3d_tmp_tmp(:,:) + real (kind=r8), allocatable :: phis_tmp(:,:) ! temp array to hold phis + real (kind=r8), allocatable :: T_tmp(:,:,:) ! temp array to hold T + real (kind=r8), allocatable :: uv_tmp(:,:,:,:) ! temp array to hold u and v + real (kind=r8), allocatable :: q_tmp(:,:,:,:) ! temp to hold advected constituents + real (kind=r8), allocatable :: omega_tmp(:,:,:) ! temp array to hold omega + + ! Frontogenesis + real (kind=r8), allocatable :: frontgf(:,:,:) ! temp arrays to hold frontogenesis + real (kind=r8), allocatable :: frontga(:,:,:) ! function (frontgf) and angle (frontga) + ! Pointers to pbuf + real (kind=r8), pointer :: pbuf_frontgf(:,:) + real (kind=r8), pointer :: pbuf_frontga(:,:) + + integer :: ncols,i,j,ierr,k,iv + integer :: ioff, m, m_cnst + integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) + integer :: tsize ! amount of data per grid point passed to physics + integer, allocatable :: bpter(:,:) ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + integer :: nphys + + real (kind=r8), allocatable :: bbuffer(:), cbuffer(:) ! transpose buffers + real (kind=r8), allocatable :: qgll(:,:,:,:) + real (kind=r8) :: inv_dp3d(np,np,nlev) + integer :: tl_f, tl_qdp_np0, tl_qdp_np1 + logical :: lmono + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + !---------------------------------------------------------------------------- + + elem => dyn_out%elem + tl_f = TimeLevel%n0 + call TimeLevel_Qdp(TimeLevel, qsplit, tl_qdp_np0,tl_qdp_np1) + + nullify(pbuf_chnk) + nullify(pbuf_frontgf) + nullify(pbuf_frontga) + + if (fv_nphys > 0) then + nphys = fv_nphys + else + allocate(qgll(np,np,nlev,pcnst)) + nphys = np + end if + + ! Allocate temporary arrays to hold data for physics decomposition + allocate(ps_tmp(nphys_pts,nelemd)) + allocate(dp3d_tmp(nphys_pts,pver,nelemd)) + allocate(dp3d_tmp_tmp(nphys_pts,pver)) + allocate(phis_tmp(nphys_pts,nelemd)) + allocate(T_tmp(nphys_pts,pver,nelemd)) + allocate(uv_tmp(nphys_pts,2,pver,nelemd)) + allocate(q_tmp(nphys_pts,pver,pcnst,nelemd)) + allocate(omega_tmp(nphys_pts,pver,nelemd)) + + if (use_gw_front .or. use_gw_front_igw) then + allocate(frontgf(nphys_pts,pver,nelemd), stat=ierr) + if (ierr /= 0) call endrun("dp_coupling: Allocate of frontgf failed.") + allocate(frontga(nphys_pts,pver,nelemd), stat=ierr) + if (ierr /= 0) call endrun("dp_coupling: Allocate of frontga failed.") + end if + + if (iam < par%nprocs) then + + if (use_gw_front .or. use_gw_front_igw) then + call gws_src_fnct(elem, tl_f, tl_qdp_np0, frontgf, frontga, nphys) + end if + + if (fv_nphys > 0) then + call test_mapping_overwrite_dyn_state(elem,dyn_out%fvm,tl_f) + !****************************************************************** + ! physics runs on an FVM grid: map GLL vars to physics grid + !****************************************************************** + call t_startf('dyn2phys') + do ie = 1, nelemd + ! note that the fvm halo has been filled in prim_run_subcycle + ! if physics grid resolution is not equal to fvm resolution + call dyn2phys_all_vars(ie, & + ! spectral element state + elem(ie)%state%dp3d(:,:,:,tl_f), & + elem(ie)%state%T(:,:,:,tl_f), & + elem(ie)%derived%omega(:,:,:), & + ! fvm state + dyn_out%fvm(ie)%dp_fvm(:,:,:,n0_fvm), & + dyn_out%fvm(ie)%c(:,:,:,1:ntrac,n0_fvm), & + pcnst, qsize, elem(ie)%metdet, ntrac>0, dyn_out%fvm(ie), & + ! + hyai(1)*ps0, & + ! output + dp3d_tmp(:,:,ie), ps_tmp(:,ie), q_tmp(:,:,:,ie), T_tmp(:,:,ie), & + omega_tmp(:,:,ie), phis_tmp(:,ie) & + ) + uv_tmp(:,:,:,ie) = & + dyn2phys_vector(elem(ie)%state%v(:,:,:,:,tl_f),elem(ie)) + end do + call t_stopf('dyn2phys') + else + + !****************************************************************** + ! Physics runs on GLL grid: collect unique points before mapping to + ! physics decomposition + !****************************************************************** + + if (qsize < pcnst) then + call endrun('d_p_coupling: Fewer GLL tracers advected than required') + end if + + call t_startf('UniquePoints') + do ie = 1, nelemd + inv_dp3d(:,:,:) = 1.0_r8/elem(ie)%state%dp3d(:,:,:,tl_f) + do m=1,pcnst + qgll(:,:,:,m) = elem(ie)%state%Qdp(:,:,:,m,tl_qdp_np0)*inv_dp3d(:,:,:) + end do + ncols = elem(ie)%idxP%NumUniquePts + call UniquePoints(elem(ie)%idxP, elem(ie)%state%psdry(:,:,tl_f), ps_tmp(1:ncols,ie)) + call UniquePoints(elem(ie)%idxP, nlev, elem(ie)%state%dp3d(:,:,:,tl_f), dp3d_tmp(1:ncols,:,ie)) + call UniquePoints(elem(ie)%idxP, nlev, elem(ie)%state%T(:,:,:,tl_f), T_tmp(1:ncols,:,ie)) + call UniquePoints(elem(ie)%idxV, 2, nlev, elem(ie)%state%V(:,:,:,:,tl_f), uv_tmp(1:ncols,:,:,ie)) + call UniquePoints(elem(ie)%idxV, nlev, elem(ie)%derived%omega, omega_tmp(1:ncols,:,ie)) + + call UniquePoints(elem(ie)%idxP, elem(ie)%state%phis, phis_tmp(1:ncols,ie)) + call UniquePoints(elem(ie)%idxP, nlev, pcnst, qgll,Q_tmp(1:ncols,:,:,ie)) + end do + call t_stopf('UniquePoints') + + end if ! if fv_nphys>0 + + else + + ps_tmp(:,:) = 0._r8 + T_tmp(:,:,:) = 0._r8 + uv_tmp(:,:,:,:) = 0._r8 + omega_tmp(:,:,:) = 0._r8 + phis_tmp(:,:) = 0._r8 + Q_tmp(:,:,:,:) = 0._r8 + + if (use_gw_front .or. use_gw_front_igw) then + frontgf(:,:,:) = 0._r8 + frontga(:,:,:) = 0._r8 + end if + + endif ! iam < par%nprocs + + if (fv_nphys<1) deallocate(qgll) + + ! q_prev is for saving the tracer fields for calculating tendencies + if (.not. allocated(q_prev)) then + allocate(q_prev(pcols,pver,pcnst,begchunk:endchunk)) + end if + q_prev = 0.0_R8 + + call t_startf('dpcopy') + if (local_dp_map) then + + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff, ilyr, m, pbuf_chnk, pbuf_frontgf, pbuf_frontga) + do lchnk = begchunk, endchunk + + ncols = get_ncols_p(lchnk) + call get_gcol_all_p(lchnk, pcols, pgcols) + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + end if + + do icol = 1, ncols + call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) + ie = idmb3(1) + ioff = idmb2(1) + phys_state(lchnk)%ps(icol) = ps_tmp(ioff,ie) + phys_state(lchnk)%phis(icol) = phis_tmp(ioff,ie) + do ilyr=1,pver + phys_state(lchnk)%pdel(icol,ilyr) = dp3d_tmp(ioff,ilyr,ie) + phys_state(lchnk)%t(icol,ilyr) = T_tmp(ioff,ilyr,ie) + phys_state(lchnk)%u(icol,ilyr) = uv_tmp(ioff,1,ilyr,ie) + phys_state(lchnk)%v(icol,ilyr) = uv_tmp(ioff,2,ilyr,ie) + phys_state(lchnk)%omega(icol,ilyr) = omega_tmp(ioff,ilyr,ie) + + if (use_gw_front .or. use_gw_front_igw) then + pbuf_frontgf(icol,ilyr) = frontgf(ioff,ilyr,ie) + pbuf_frontga(icol,ilyr) = frontga(ioff,ilyr,ie) + endif + end do + + do m = 1, pcnst + do ilyr = 1, pver + phys_state(lchnk)%q(icol,ilyr,m) = Q_tmp(ioff,ilyr,m,ie) + end do + end do + end do + end do + + else ! .not. local_dp_map + + tsize = 5 + pcnst + if (use_gw_front .or. use_gw_front_igw) tsize = tsize + 2 + + allocate(bbuffer(tsize*block_buf_nrecs)) + allocate(cbuffer(tsize*chunk_buf_nrecs)) + if (fv_nphys > 0) then + allocate(bpter(fv_nphys*fv_nphys,0:pver)) + else + allocate(bpter(npsq,0:pver)) + end if + + if (iam < par%nprocs) then + !$omp parallel do num_threads(horz_num_threads) private (ie, bpter, icol, ilyr, m, ncols, ioff) + do ie = 1, nelemd + + if (fv_nphys > 0) then + call block_to_chunk_send_pters(elem(ie)%GlobalID, fv_nphys*fv_nphys, & + pver+1, tsize, bpter) + ncols = fv_nphys*fv_nphys + else + call block_to_chunk_send_pters(elem(ie)%GlobalID, npsq, & + pver+1, tsize, bpter) + ncols = elem(ie)%idxP%NumUniquePts + end if + + do icol=1,ncols + bbuffer(bpter(icol,0)+2:bpter(icol,0)+tsize-1) = 0.0_r8 + bbuffer(bpter(icol,0)) = ps_tmp(icol,ie) + bbuffer(bpter(icol,0)+1) = phis_tmp(icol,ie) + + do ilyr=1,pver + ioff = 0 + bbuffer(bpter(icol,ilyr)+ioff) = T_tmp(icol,ilyr,ie) + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = uv_tmp(icol,1,ilyr,ie) + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = uv_tmp(icol,2,ilyr,ie) + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = omega_tmp(icol,ilyr,ie) + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = dp3d_tmp(icol,ilyr,ie) + if (use_gw_front .or. use_gw_front_igw) then + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = frontgf(icol,ilyr,ie) + ioff = ioff + 1 + bbuffer(bpter(icol,ilyr)+ioff) = frontga(icol,ilyr,ie) + end if + + do m=1,pcnst + bbuffer(bpter(icol,ilyr)+tsize-pcnst-1+m) = Q_tmp(icol,ilyr,m,ie) + end do + end do + end do + end do + + else + bbuffer(:) = 0._r8 + end if + + call t_barrierf ('sync_blk_to_chk', mpicom) + call t_startf ('block_to_chunk') + call transpose_block_to_chunk(tsize, bbuffer, cbuffer) + call t_stopf ('block_to_chunk') + + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, icol, ilyr, m, pbuf_chnk, pbuf_frontgf, pbuf_frontga, ioff) + do lchnk = begchunk, endchunk + ncols = phys_state(lchnk)%ncol + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + end if + + call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) + + do icol = 1, ncols + phys_state(lchnk)%ps(icol) = cbuffer(cpter(icol,0)) + phys_state(lchnk)%phis(icol) = cbuffer(cpter(icol,0)+1) + + do ilyr = 1, pver + ioff = 0 + phys_state(lchnk)%t(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + ioff = ioff + 1 + phys_state(lchnk)%u(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + ioff = ioff + 1 + phys_state(lchnk)%v(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + ioff = ioff + 1 + phys_state(lchnk)%omega(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + ioff = ioff + 1 + phys_state(lchnk)%pdel(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + + if (use_gw_front .or. use_gw_front_igw) then + ioff = ioff + 1 + pbuf_frontgf(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + ioff = ioff + 1 + pbuf_frontga(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) + endif + + do m = 1, pcnst + phys_state(lchnk)%q (icol,ilyr,m) = cbuffer(cpter(icol,ilyr)+tsize-pcnst-1+m) + end do + + end do + end do + end do + + deallocate( bbuffer ) + deallocate( cbuffer ) + + end if + call t_stopf('dpcopy') + + ! Save the tracer fields for calculating tendencies + do lchnk = begchunk, endchunk + ncols = phys_state(lchnk)%ncol + q_prev(1:ncols,1:pver,1:pcnst,lchnk) = phys_state(lchnk)%q(1:ncols,1:pver,1:pcnst) + end do + call test_mapping_output_phys_state(phys_state,dyn_out%fvm) + + ! Deallocate the temporary arrays + deallocate(ps_tmp) + deallocate(dp3d_tmp) + deallocate(phis_tmp) + deallocate(T_tmp) + deallocate(uv_tmp) + deallocate(q_tmp) + deallocate(omega_tmp) + + call t_startf('derived_phys') + call derived_phys_dry(phys_state, phys_tend, pbuf2d) + call t_stopf('derived_phys') + +!$omp parallel do private (lchnk, ncols, ilyr, icol) + do lchnk = begchunk, endchunk + ncols=get_ncols_p(lchnk) + if (pcols > ncols) then + phys_state(lchnk)%phis(ncols+1:) = 0.0_r8 + end if + end do + +end subroutine d_p_coupling + +!========================================================================================= + +subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) + + use bndry_mod, only: bndry_exchange + use edge_mod, only: edgeVpack, edgeVunpack + use fvm_mapping, only: phys2dyn_forcings_fvm + use test_fvm_mapping, only: test_mapping_overwrite_tendencies + use test_fvm_mapping, only: test_mapping_output_mapped_tendencies + + ! arguments + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend + integer, intent(in) :: tl_qdp, tl_f + type(dyn_import_t), intent(inout) :: dyn_in + type(hybrid_t) :: hybrid + + ! LOCAL VARIABLES + integer :: ic , ncols ! index + type(element_t), pointer :: elem(:) ! pointer to dyn_in element array + integer :: ie, iep ! indices over elements + integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers + + real (kind=r8), allocatable :: dp_phys(:,:,:) ! temp array to hold dp on physics grid + real (kind=r8), allocatable :: T_tmp(:,:,:) ! temp array to hold T + real (kind=r8), allocatable :: dq_tmp(:,:,:,:) ! temp array to hold q + real (kind=r8), allocatable :: uv_tmp(:,:,:,:) ! temp array to hold uv + integer :: ioff, m, i, j, k + integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) + + integer :: tsize ! amount of data per grid point passed to physics + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for packing data + integer, allocatable :: bpter(:,:) ! offsets into block buffer for unpacking data + + real (kind=r8), allocatable :: bbuffer(:), cbuffer(:) ! transpose buffers + + real (kind=r8) :: factor + + integer :: num_trac + integer :: nets,nete + integer :: kptr,ii + !---------------------------------------------------------------------------- + + if (iam < par%nprocs) then + elem => dyn_in%elem + else + nullify(elem) + end if + + allocate(T_tmp(nphys_pts,pver,nelemd)) + allocate(uv_tmp(nphys_pts,2,pver,nelemd)) + allocate(dq_tmp(nphys_pts,pver,pcnst,nelemd)) + allocate(dp_phys(nphys_pts,pver,nelemd)) + + T_tmp = 0.0_r8 + uv_tmp = 0.0_r8 + dq_tmp = 0.0_r8 + + if (.not. allocated(q_prev)) then + call endrun('p_d_coupling: q_prev not allocated') + end if + + call t_startf('pd_copy') + if (local_dp_map) then + + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff, ilyr, m, factor) + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + call get_gcol_all_p(lchnk, pcols, pgcols) + + call test_mapping_overwrite_tendencies(phys_state(lchnk), phys_tend(lchnk), ncols,& + lchnk, q_prev(1:ncols,:,:,lchnk)) + + do icol = 1, ncols + call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) + ie = idmb3(1) + ioff = idmb2(1) + + do ilyr = 1, pver + + ! phys_state%psdry units is Pa + dp_phys(ioff,ilyr,ie) = phys_state(lchnk)%pdeldry(icol,ilyr) + T_tmp(ioff,ilyr,ie) = phys_tend(lchnk)%dtdt(icol,ilyr) + uv_tmp(ioff,1,ilyr,ie) = phys_tend(lchnk)%dudt(icol,ilyr) + uv_tmp(ioff,2,ilyr,ie) = phys_tend(lchnk)%dvdt(icol,ilyr) + + ! convert wet mixing ratios to dry + ! this code is equivalent to dme_adjust + factor = phys_state(lchnk)%pdel(icol,ilyr)/phys_state(lchnk)%pdeldry(icol,ilyr) + do m = 1, pcnst + if (cnst_type(m) == 'wet') then + phys_state(lchnk)%q(icol,ilyr,m) = factor*phys_state(lchnk)%q(icol,ilyr,m) + end if + dq_tmp(ioff,ilyr,m,ie) = (phys_state(lchnk)%q(icol,ilyr,m) - & + q_prev(icol,ilyr,m,lchnk)) + end do + end do + end do + end do + + else ! not local map + + tsize = 4 + pcnst + + allocate(bbuffer(tsize*block_buf_nrecs)) + allocate(cbuffer(tsize*chunk_buf_nrecs)) + + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, i, icol, ilyr, m, factor) + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + + call test_mapping_overwrite_tendencies(phys_state(lchnk), phys_tend(lchnk), ncols, lchnk, & + q_prev(1:ncols,:,:,lchnk)) + + call chunk_to_block_send_pters(lchnk, pcols, pver+1, tsize, cpter) + + do i = 1, ncols + cbuffer(cpter(i,0):cpter(i,0)+2+pcnst) = 0.0_r8 + end do + + do icol = 1, ncols + do ilyr = 1, pver + cbuffer(cpter(icol,ilyr)) = phys_tend(lchnk)%dtdt(icol,ilyr) + cbuffer(cpter(icol,ilyr)+1) = phys_tend(lchnk)%dudt(icol,ilyr) + cbuffer(cpter(icol,ilyr)+2) = phys_tend(lchnk)%dvdt(icol,ilyr) + cbuffer(cpter(icol,ilyr)+3) = phys_state(lchnk)%pdeldry(icol,ilyr) + + ! this code is equivalent to dme_adjust + factor = phys_state(lchnk)%pdel(icol,ilyr)/phys_state(lchnk)%pdeldry(icol,ilyr) + + do m = 1, pcnst + if (cnst_type(m) == 'wet') then + phys_state(lchnk)%q(icol,ilyr,m) = factor*phys_state(lchnk)%q(icol,ilyr,m) + end if + cbuffer(cpter(icol,ilyr)+3+m) = (phys_state(lchnk)%q(icol,ilyr,m) - & + q_prev(icol,ilyr,m,lchnk)) + end do + end do + end do + end do + + call t_barrierf('sync_chk_to_blk', mpicom) + call t_startf ('chunk_to_block') + call transpose_chunk_to_block(tsize, cbuffer, bbuffer) + call t_stopf ('chunk_to_block') + + if (iam < par%nprocs) then + + if (fv_nphys > 0) then + allocate(bpter(fv_nphys*fv_nphys,0:pver)) + else + allocate(bpter(npsq,0:pver)) + end if + + !$omp parallel do num_threads(horz_num_threads) private (ie, bpter, icol, ilyr, m, ncols) + do ie = 1, nelemd + + if (fv_nphys > 0) then + call chunk_to_block_recv_pters(elem(ie)%GlobalID, fv_nphys*fv_nphys, & + pver+1, tsize, bpter) + ncols = fv_nphys*fv_nphys + else + call chunk_to_block_recv_pters(elem(ie)%GlobalID, npsq, & + pver+1, tsize, bpter) + ncols = elem(ie)%idxP%NumUniquePts + end if + + do icol = 1, ncols + do ilyr = 1, pver + T_tmp (icol,ilyr,ie) = bbuffer(bpter(icol,ilyr)) + uv_tmp (icol,1,ilyr,ie) = bbuffer(bpter(icol,ilyr)+1) + uv_tmp (icol,2,ilyr,ie) = bbuffer(bpter(icol,ilyr)+2) + dp_phys (icol,ilyr,ie) = bbuffer(bpter(icol,ilyr)+3) + + do m = 1, pcnst + dq_tmp(icol,ilyr,m,ie) = bbuffer(bpter(icol,ilyr)+3+m) + end do + end do + end do + end do + deallocate(bpter) + + end if + + deallocate( bbuffer ) + deallocate( cbuffer ) + + end if + call t_stopf('pd_copy') + + if (iam < par%nprocs) then + + if (fv_nphys > 0) then + + ! put forcings into fvm structure + num_trac = max(qsize,ntrac) + do ie = 1, nelemd + do j = 1, fv_nphys + do i = 1, fv_nphys + ii = i + (j-1)*fv_nphys + dyn_in%fvm(ie)%ft(i,j,1:pver) = T_tmp(ii,1:pver,ie) + dyn_in%fvm(ie)%fm(i,j,1:2,1:pver) = uv_tmp(ii,1:2,1:pver,ie) + dyn_in%fvm(ie)%fc_phys(i,j,1:pver,1:num_trac) = dq_tmp(ii,1:pver,1:num_trac,ie) + dyn_in%fvm(ie)%dp_phys(i,j,1:pver) = dp_phys(ii,1:pver,ie) + end do + end do + end do + + !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n) + !JMD hybrid = config_thread_region(par,'horizontal') + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + + ! high-order mapping of ft and fm (and fq if no cslam) using fvm technology + call t_startf('phys2dyn') + call phys2dyn_forcings_fvm(elem, dyn_in%fvm, hybrid,nets,nete,ntrac==0, tl_f, tl_qdp) + call t_stopf('phys2dyn') + else + + call t_startf('putUniquePoints') + + !$omp parallel do num_threads(horz_num_threads) private(ie,ncols) + do ie = 1, nelemd + ncols = elem(ie)%idxP%NumUniquePts + call putUniquePoints(elem(ie)%idxP, nlev, T_tmp(1:ncols,:,ie), & + elem(ie)%derived%fT(:,:,:)) + call putUniquePoints(elem(ie)%idxV, 2, nlev, uv_tmp(1:ncols,:,:,ie), & + elem(ie)%derived%fM(:,:,:,:)) + call putUniquePoints(elem(ie)%idxV, nlev,pcnst, dq_tmp(1:ncols,:,:,ie), & + elem(ie)%derived%fQ(:,:,:,:)) + end do + call t_stopf('putUniquePoints') + end if + end if + + deallocate(T_tmp) + deallocate(uv_tmp) + deallocate(dq_tmp) + + ! Boundary exchange for physics forcing terms. + ! For physics on GLL grid, for points with duplicate degrees of freedom, + ! putuniquepoints() set one of the element values and set the others to zero, + ! so do a simple sum (boundary exchange with no weights). + ! For physics grid, we interpolated into all points, so do weighted average. + + call t_startf('bndry_exchange') + + do ie = 1, nelemd + if (fv_nphys > 0) then + do k = 1, nlev + dyn_in%elem(ie)%derived%FM(:,:,1,k) = & + dyn_in%elem(ie)%derived%FM(:,:,1,k) * & + dyn_in%elem(ie)%spheremp(:,:) + dyn_in%elem(ie)%derived%FM(:,:,2,k) = & + dyn_in%elem(ie)%derived%FM(:,:,2,k) * & + dyn_in%elem(ie)%spheremp(:,:) + dyn_in%elem(ie)%derived%FT(:,:,k) = & + dyn_in%elem(ie)%derived%FT(:,:,k) * & + dyn_in%elem(ie)%spheremp(:,:) + do m = 1, qsize + dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & + dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & + dyn_in%elem(ie)%spheremp(:,:) + end do + end do + end if + kptr = 0 + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) + kptr = kptr + 2*nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) + kptr = kptr + nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end do + + if (iam < par%nprocs) then + call bndry_exchange(par, edgebuf, location='p_d_coupling') + end if + + do ie = 1, nelemd + kptr = 0 + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) + kptr = kptr + 2*nlev + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) + kptr = kptr + nlev + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (fv_nphys > 0) then + do k = 1, nlev + dyn_in%elem(ie)%derived%FM(:,:,1,k) = & + dyn_in%elem(ie)%derived%FM(:,:,1,k) * & + dyn_in%elem(ie)%rspheremp(:,:) + dyn_in%elem(ie)%derived%FM(:,:,2,k) = & + dyn_in%elem(ie)%derived%FM(:,:,2,k) * & + dyn_in%elem(ie)%rspheremp(:,:) + dyn_in%elem(ie)%derived%FT(:,:,k) = & + dyn_in%elem(ie)%derived%FT(:,:,k) * & + dyn_in%elem(ie)%rspheremp(:,:) + do m = 1, qsize + dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & + dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & + dyn_in%elem(ie)%rspheremp(:,:) + end do + end do + end if + end do + call t_stopf('bndry_exchange') + + if (iam < par%nprocs .and. fv_nphys > 0) then + call test_mapping_output_mapped_tendencies(dyn_in%fvm(1:nelemd), elem(1:nelemd), & + 1, nelemd, tl_f, tl_qdp) + end if + +end subroutine p_d_coupling + +!========================================================================================= + +subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) + + use constituents, only: qmin + use physconst, only: cpair, gravit, rair, zvir, cappa, rairv,rh2o,rair + use geopotential, only: geopotential_t + use physics_types, only: set_state_pdry, set_wet_to_dry + use check_energy, only: check_energy_timestep_init + use hycoef, only: hyam, hybm, hyai, hybi, ps0 + use shr_vmath_mod, only: shr_vmath_log + use gmean_mod, only: gmean + use qneg_module, only: qneg3 + + ! arguments + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local variables + integer :: lchnk + real(r8) :: qbot ! bottom level q before change + real(r8) :: qbotm1 ! bottom-1 level q before change + real(r8) :: dqreq ! q change at pver-1 required to remove q pbuf_get_chunk(pbuf2d, lchnk) + call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) + + + end do ! lchnk + +end subroutine derived_phys_dry + +!========================================================================================= + +end module dp_coupling diff --git a/src/dynamics/se/dp_mapping.F90 b/src/dynamics/se/dp_mapping.F90 new file mode 100644 index 0000000000..4d036f4fdf --- /dev/null +++ b/src/dynamics/se/dp_mapping.F90 @@ -0,0 +1,667 @@ +! Separate dynamics and physics grids + +module dp_mapping + use dimensions_mod, only: np, npsq, fv_nphys + use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl + use coordinate_systems_mod, only: spherical_polar_t + use shr_const_mod, only: pi => shr_const_pi + use fvm_control_volume_mod, only: fvm_struct + + implicit none + private + save + + public :: dp_init + public :: dp_reoorder + public :: dp_write + + ! Total number of physics points per spectral element + ! no physgrid: nphys_pts = npsq (physics on GLL grid) + ! physgrid: nphys_pts = nphys2 (physics on CSLAM grid) + ! Value is set when se_fv_nphys namelist variable is read + integer, public :: nphys_pts = npsq + + ! NOTE: dp_gid() is in space filling curve rank order + ! all other global arrays are in block id (global id) order + ! + ! dp_gid() is used to re-order data collected on root via mpi_gatherv + ! into block id ordering + ! + ! j=dp_gid(i) i = element space filling curve rank + ! j = element global id = block id = history file ordering + ! + integer, allocatable,dimension(:) :: dp_gid ! NE=240, integer*4 = 1.3MB + integer, public,allocatable,dimension(:) :: dp_owner + + real (r8),public,allocatable,dimension(:,:,:) :: weights_all_fvm2phys + integer ,public,allocatable,dimension(:,:,:) :: weights_eul_index_all_fvm2phys,weights_lgr_index_all_fvm2phys + real (r8),public,allocatable,dimension(:,:,:) :: weights_all_phys2fvm + integer ,public,allocatable,dimension(:,:,:) :: weights_eul_index_all_phys2fvm,weights_lgr_index_all_phys2fvm + integer ,public,allocatable,dimension(:) :: jall_fvm2phys,jall_phys2fvm + integer ,public :: num_weights_fvm2phys,num_weights_phys2fvm + + +contains + subroutine dp_init(elem,fvm) + use cam_abortutils, only: endrun + use dimensions_mod, only: nelemd,nc,irecons_tracer + use element_mod, only: element_t + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use thread_mod, only: horz_num_threads + + implicit none + type(element_t) , dimension(nelemd), intent(in) :: elem + type (fvm_struct), dimension(nelemd), intent(in) :: fvm + + num_weights_phys2fvm = 0 + num_weights_fvm2phys = 0 + if (fv_nphys>0) then + num_weights_phys2fvm = (nc+fv_nphys)**2 + num_weights_fvm2phys = (nc+fv_nphys)**2 + + allocate(weights_all_fvm2phys(num_weights_fvm2phys,irecons_tracer,nelemd)) + allocate(weights_eul_index_all_fvm2phys(num_weights_fvm2phys,2,nelemd)) + allocate(weights_lgr_index_all_fvm2phys(num_weights_fvm2phys,2,nelemd)) + + allocate(weights_all_phys2fvm(num_weights_phys2fvm,irecons_tracer,nelemd)) + allocate(weights_eul_index_all_phys2fvm(num_weights_phys2fvm,2,nelemd)) + allocate(weights_lgr_index_all_phys2fvm(num_weights_phys2fvm,2,nelemd)) + allocate(jall_fvm2phys(nelemd)) + allocate(jall_phys2fvm(nelemd)) + + call fvm2phys_init(elem,fvm,nc,fv_nphys,irecons_tracer,& + weights_all_fvm2phys,weights_eul_index_all_fvm2phys,weights_lgr_index_all_fvm2phys,& + weights_all_phys2fvm,weights_eul_index_all_phys2fvm,weights_lgr_index_all_phys2fvm,& + jall_fvm2phys,jall_phys2fvm) + + call dp_replicated_init(elem) + + if (masterproc) then + write(iulog, *) 'dp_init: Initialized phys2fvm/fvm2phys mapping vars' + end if + + end if + end subroutine dp_init + + subroutine dp_reoorder(before,after) + use cam_abortutils, only: endrun + use dimensions_mod, only: nelem + !XXgoldyXX + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use shr_sys_mod, only: shr_sys_flush + !XXgoldyXX + implicit none + real(r8), dimension(fv_nphys*fv_nphys,*), intent(in) :: before + real(r8), dimension(fv_nphys*fv_nphys,*), intent(out) :: after + integer :: ie + + ! begin + do ie = 1,nelem + !XXgoldyXX + if (dp_gid(ie) < 0) then + if (masterproc) then + write(iulog,*) 'ie =',ie,', dp_gid(ie) =',dp_gid(ie) + call shr_sys_flush(iulog) + end if + call endrun('Bad element remap in dp_reoorder') + end if + !XXgoldyXX + after(:,dp_gid(ie)) = before(:,ie) + end do + end subroutine dp_reoorder + + !!! + + subroutine dp_replicated_init(elem) + use dimensions_mod, only: nelem, nelemd + use element_mod, only: element_t + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, masterprocid, npes + use spmd_utils, only: mpicom, mpi_integer + + implicit none + type(element_t),dimension(nelemd),intent(in) :: elem + + integer :: i,j,ierror + integer,dimension(nelemd) :: lgid + integer,dimension(:),allocatable :: displs,recvcount + + ! begin + + allocate(displs(npes)) + allocate(dp_gid(nelem)) + allocate(recvcount(npes)) + call mpi_gather(nelemd, 1, mpi_integer, recvcount, 1, mpi_integer, & + masterprocid, mpicom, ierror) + lgid(:) = elem(:)%globalid + if (masterproc) then + displs(1) = 0 + do i = 2,npes + displs(i) = displs(i-1)+recvcount(i-1) + end do + end if + call mpi_gatherv(lgid, nelemd, mpi_integer, dp_gid, recvcount, displs, & + mpi_integer, masterprocid, mpicom, ierror) + if (masterproc) then + allocate(dp_owner(nelem)) + dp_owner(:) = -1 + do i = 1,npes + do j = displs(i)+1,displs(i)+recvcount(i) + dp_owner(dp_gid(j)) = i-1 + end do + end do + end if + deallocate(displs) + deallocate(recvcount) + ! minimize global memory use + call mpi_barrier(mpicom,ierror) + if (.not.masterproc) then + allocate(dp_owner(nelem)) + end if + call mpi_bcast(dp_gid,nelem,mpi_integer,masterprocid,mpicom,ierror) + call mpi_bcast(dp_owner,nelem,mpi_integer,masterprocid,mpicom,ierror) + end subroutine dp_replicated_init + + !!! + + + !!! + + subroutine dp_write(elem, fvm, grid_format, filename_in) + use cam_abortutils, only: endrun + use dimensions_mod, only: nelem, nelemd + use element_mod, only: element_t + use netcdf, only: nf90_create, nf90_close, nf90_enddef + use netcdf, only: nf90_def_dim, nf90_def_var, nf90_put_var + use netcdf, only: nf90_double, nf90_int, nf90_put_att + use netcdf, only: nf90_noerr, nf90_strerror, nf90_clobber + use spmd_utils, only: masterproc, masterprocid, mpicom, npes + use spmd_utils, only: mpi_integer, mpi_real8 + use cam_logfile, only: iulog + use shr_sys_mod, only: shr_sys_flush + use dimensions_mod, only: ne + use coordinate_systems_mod, only: cart2spherical + + ! Inputs + type(element_t), intent(in) :: elem(:) + type (fvm_struct), intent(in) :: fvm(:) + character(len=*), intent(in) :: grid_format + character(len=*), intent(in) :: filename_in + + real(r8), parameter :: rad2deg = 180._r8/pi + + ! Local variables + integer :: i, ie, ierror, j, status, ivtx + integer :: grid_corners_id, grid_rank_id, grid_size_id + character(len=256) :: errormsg + character(len=shr_kind_cl) :: filename + integer :: ncid + integer :: grid_dims_id, grid_area_id, grid_center_lat_id + integer :: grid_center_lon_id, grid_corner_lat_id + integer :: grid_corner_lon_id, grid_imask_id + integer :: gridsize + integer :: IOrootID + logical :: IOroot + integer,allocatable,dimension(:) :: displs,recvcount + + real(r8), dimension(fv_nphys, fv_nphys, nelemd, 4, 2) :: corners + real(r8), dimension(fv_nphys, fv_nphys, nelemd) :: lwork + real(r8), allocatable, dimension(:) :: recvbuf + real(r8), allocatable, dimension(:,:) :: gwork + real(r8) :: x, y + type (spherical_polar_t) :: sphere + + ! begin + + !! Check to see if we are doing grid output + if (trim(grid_format) == "no") then + if (masterproc) then + write(iulog, *) 'dp_write: Not writing phys_grid file.' + end if + return + else if (trim(grid_format) /= 'SCRIP') then + if (masterproc) then + write(errormsg, *) 'dp_write: ERROR, bad value for se_write_grid, ',& + trim(grid_format) + call endrun(errormsg) + end if + end if + + ! Create the NetCDF file + if (len_trim(filename_in) == 0) then + write(filename, '(3(a,i0),3a)') "ne", ne, "np", np, ".pg", fv_nphys, & + "_", trim(grid_format), ".nc" + else + filename = trim(filename_in) + end if + status = nf90_create(trim(filename), nf90_clobber, ncid) + if (status /= nf90_noerr) then + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + ! PIO_put_var puts from its root node, find that (so we do our work there) + IOrootID = masterprocid + IOroot = masterproc + + ! Allocate workspace and calculate PE displacement information + if (IOroot) then + allocate(displs(npes)) + allocate(recvcount(npes)) + else + allocate(displs(0)) + allocate(recvcount(0)) + end if + gridsize = nelem * fv_nphys*fv_nphys + if(masterproc) then + write(iulog, *) 'Writing physics SCRIP grid file: ', trim(filename) + write(iulog, '(a,i7,a,i3)') 'nelem = ', nelem, ', fv_nphys = ', fv_nphys + call shr_sys_flush(iulog) + end if + call mpi_gather(nelemd*fv_nphys*fv_nphys, 1, mpi_integer, recvcount, 1, & + mpi_integer, IOrootID, mpicom, ierror) + + if (IOroot) then + displs(1) = 0 + do i = 2, npes + displs(i) = displs(i-1)+recvcount(i-1) + end do + allocate(recvbuf(gridsize)) + else + allocate(recvbuf(0)) + end if + allocate(gwork(4, gridsize)) + + if (IOroot) then + ! Define the horizontal grid dimensions for SCRIP output + status = nf90_def_dim(ncid, "grid_corners", 4, grid_corners_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining dimension, grid_corners' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + status = nf90_def_dim(ncid, "grid_rank", 1, grid_rank_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining dimension, grid_rank' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + status = nf90_def_dim(ncid, "grid_size", gridsize, grid_size_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining dimension, grid_size' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + ! Define the coordinate variables + status = nf90_def_var(ncid, "grid_dims", nf90_int, (/grid_rank_id/), & + grid_dims_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_dims' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_area", nf90_double, & + (/grid_size_id/), grid_area_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_area' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_area_id, "units", "radians^2") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_area' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_area_id, "long_name", "area weights") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_area' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_center_lat", nf90_double, & + (/grid_size_id/), grid_center_lat_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_center_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_center_lat_id, "units", "degrees") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_center_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_center_lon", nf90_double, & + (/grid_size_id/), grid_center_lon_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_center_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_center_lon_id, "units", "degrees") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_center_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_corner_lat", nf90_double, & + (/grid_corners_id, grid_size_id/), grid_corner_lat_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining grid_corner_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_corner_lat_id, "units", "degrees") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_corner_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_corner_lon", nf90_double, & + (/grid_corners_id, grid_size_id/), grid_corner_lon_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_corner_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_put_att(ncid, grid_corner_lon_id, "units", "degrees") + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining attributes for grid_corner_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + status = nf90_def_var(ncid, "grid_imask", nf90_double, & + (/grid_size_id/), grid_imask_id) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error defining variable grid_imask' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + + ! End of NetCDF definitions + status = nf90_enddef(ncid) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error calling enddef' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if ! IOroot + + if (IOroot) then + status = nf90_put_var(ncid, grid_dims_id, (/ gridsize /)) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_dims' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + + do ie=1,nelemd + lwork(:,:,ie) = fvm(ie)%area_sphere_physgrid(:,:) + end do + call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & + displs, mpi_real8, IOrootID, mpicom, ierror) + if (IOroot) then + call dp_reoorder(recvbuf, gwork(1,:)) + status = nf90_put_var(ncid, grid_area_id, gwork(1,:)) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_area' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + do ie=1,nelemd + lwork(:,:,ie) = rad2deg*fvm(ie)%center_cart_physgrid(:,:)%lat + end do + call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & + displs, mpi_real8, IOrootID, mpicom, ierror) + if (IOroot) then + call dp_reoorder(recvbuf, gwork(1,:)) + status = nf90_put_var(ncid, grid_center_lat_id, gwork(1,:)) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_center_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + + do ie=1,nelemd + lwork(:,:,ie) = rad2deg*fvm(ie)%center_cart_physgrid(:,:)%lon + end do + call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & + displs, mpi_real8, IOrootID, mpicom, ierror) + if (IOroot) then + call dp_reoorder(recvbuf, gwork(1,:)) + status = nf90_put_var(ncid, grid_center_lon_id, gwork(1,:)) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_center_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + ! compute physgrid grid corners + do ie=1,nelemd + do j=1,fv_nphys + do i=1,fv_nphys + do ivtx=1,4 + x = fvm(ie)%vtx_cart_physgrid(ivtx,1,i,j) + y = fvm(ie)%vtx_cart_physgrid(ivtx,2,i,j) + sphere = cart2spherical(x,y,elem(ie)%FaceNum) + corners(i,j,ie,ivtx,1) = rad2deg * sphere%lat + corners(i,j,ie,ivtx,2) = rad2deg * sphere%lon + end do + end do + end do + end do + ! Collect all information for the grid corner latitude (counter-clockwise) + do ivtx=1,4 + call mpi_gatherv(corners(:,:,:,ivtx,1), size(corners(:,:,:,ivtx,1)), mpi_real8, recvbuf, recvcount, & + displs, mpi_real8, IOrootID, mpicom, ierror) + if (IOroot) then + call dp_reoorder(recvbuf, gwork(ivtx,:)) + end if + end do + if (IOroot) then + status = nf90_put_var(ncid, grid_corner_lat_id, gwork) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_corner_lat' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + ! Collect all information for the grid corner longitudes (counter-clockwise) + do ivtx=1,4 + call mpi_gatherv(corners(:,:,:,ivtx,2), size(corners(:,:,:,ivtx,2)), mpi_real8, recvbuf, recvcount, & + displs, mpi_real8, IOrootID, mpicom, ierror) + if (IOroot) then + call dp_reoorder(recvbuf, gwork(ivtx,:)) + end if + end do + if (IOroot) then + status = nf90_put_var(ncid, grid_corner_lon_id, gwork) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_corner_lon' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + + if (IOroot) then + gwork(1,:) = 1._r8 + status = nf90_put_var(ncid, grid_imask_id, gwork(1,:)) + if (status /= nf90_noerr) then + write(iulog, *) 'dp_write: Error writing variable grid_imask' + call shr_sys_flush(iulog) + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + +! call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + ! Close the file + call mpi_barrier(mpicom, ierror) + if (IOroot) then + status = nf90_close(ncid) + if (status /= nf90_noerr) then + call endrun("dp_write: "//trim(nf90_strerror(status))) + end if + end if + + call mpi_barrier(mpicom, ierror) + if(masterproc) then + write(iulog, *) 'Finished writing physics grid file: ', trim(filename) + call shr_sys_flush(iulog) + end if + + end subroutine dp_write + !!! + + subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& + weights_all_fvm2phys,weights_eul_index_all_fvm2phys,weights_lgr_index_all_fvm2phys,& + weights_all_phys2fvm,weights_eul_index_all_phys2fvm,weights_lgr_index_all_phys2fvm,& + jall_fvm2phys,jall_phys2fvm) + use dimensions_mod , only: ngpc,nelemd + use fvm_overlap_mod , only: compute_weights_cell + use element_mod , only: element_t + type(element_t) , dimension(nelemd), intent(in) :: elem + type (fvm_struct), dimension(nelemd), intent(in) :: fvm + integer , intent(in) :: fvm_nc, phys_nc, irecons + real (kind=r8) :: dalpha,dbeta + real (kind=r8), dimension(0:phys_nc+2):: xgno_phys,ygno_phys +! real (kind=r8), dimension(phys_nc,phys_nc):: da_phys + real (kind=r8), dimension(0:fvm_nc+2) :: xgno_fvm,ygno_fvm +! real (kind=r8), dimension(fvm_nc,fvm_nc):: da_fvm + + + real (kind=r8), dimension(ngpc):: gauss_weights, abscissae !dimension(ngauss) + + integer :: i,j + integer, parameter :: nvertex = 4 + real (kind=r8), dimension(nvertex) :: xcell,ycell + + real (kind=r8) , dimension(num_weights_fvm2phys,irecons,nelemd),intent(out) :: weights_all_fvm2phys + integer, dimension(num_weights_fvm2phys,2,nelemd),intent(out) :: weights_eul_index_all_fvm2phys + integer, dimension(num_weights_fvm2phys,2,nelemd),intent(out) :: weights_lgr_index_all_fvm2phys + + real (kind=r8) , dimension(num_weights_phys2fvm,irecons,nelemd),intent(out) :: weights_all_phys2fvm + integer, dimension(num_weights_phys2fvm,2,nelemd),intent(out) :: weights_eul_index_all_phys2fvm + integer, dimension(num_weights_phys2fvm,2,nelemd),intent(out) :: weights_lgr_index_all_phys2fvm + + integer , dimension(nelemd) ,intent(out) :: jall_fvm2phys,jall_phys2fvm + + integer, parameter :: jmax_segments_cell = 50 + real (kind=r8) , dimension(jmax_segments_cell,irecons) :: weights_cell + integer , dimension(jmax_segments_cell,2) :: weights_eul_index_cell + integer :: jcollect_cell,ie + + + xgno_phys(0) = -1D20; xgno_phys(phys_nc+2) = 1D20 + xgno_fvm(0) = -1D20; xgno_fvm(fvm_nc+2) = 1D20 + do ie=1,nelemd + + dalpha = abs(elem(ie)%corners(1)%x-elem(ie)%corners(2)%x)/phys_nc !in alpha + dbeta = abs(elem(ie)%corners(1)%y-elem(ie)%corners(4)%y)/phys_nc !in beta + do i=1,phys_nc+1 + xgno_phys(i) = tan(elem(ie)%corners(1)%x+(i-1)*dalpha) + ygno_phys(i) = tan(elem(ie)%corners(1)%y+(i-1)*dbeta ) + end do + + dalpha = abs(elem(ie)%corners(1)%x-elem(ie)%corners(2)%x)/fvm_nc !in alpha + dbeta = abs(elem(ie)%corners(1)%y-elem(ie)%corners(4)%y)/fvm_nc !in beta + do i=1,fvm_nc+1 + xgno_fvm(i) = tan(elem(ie)%corners(1)%x+(i-1)*dalpha) + ygno_fvm(i) = tan(elem(ie)%corners(1)%y+(i-1)*dbeta ) + end do + + ! + ! compute area using line-integrals + ! +! do j=1,phys_nc +! do i=1,phys_nc +! da_phys(i,j) = (I_00(xgno_phys(i+1),ygno_phys(j+1)) - I_00(xgno_phys(i ),ygno_phys(j+1)) + & +! I_00(xgno_phys(i ),ygno_phys(j )) - I_00(xgno_phys(i+1),ygno_phys(j ))) +! end do +! end do +! +! do j=1,fvm_nc +! do i=1,fvm_nc +! da_fvm(i,j) = (I_00(xgno_fvm(i+1),ygno_fvm(j+1)) - I_00(xgno_fvm(i ),ygno_fvm(j+1)) + & +! I_00(xgno_fvm(i ),ygno_fvm(j )) - I_00(xgno_fvm(i+1),ygno_fvm(j ))) +! end do +! end do + + gauss_weights = 0.0D0; abscissae=0.0D0!not used since line-segments are parallel to coordinate + + jall_fvm2phys(ie)=1 + do j=1,phys_nc + do i=1,phys_nc + xcell(1) = xgno_phys(i) ; ycell(1) = ygno_phys(j) + xcell(2) = xgno_phys(i) ; ycell(2) = ygno_phys(j+1) + xcell(3) = xgno_phys(i+1); ycell(3) = ygno_phys(j+1) + xcell(4) = xgno_phys(i+1); ycell(4) = ygno_phys(j) + + call compute_weights_cell(nvertex,.true.,& + xcell,ycell,i,j,irecons,xgno_fvm,ygno_fvm,0,fvm_nc+2,& + 1,fvm_nc+1,1,fvm_nc+1,& + ngpc,gauss_weights,abscissae,& + weights_cell,weights_eul_index_cell,jcollect_cell,jmax_segments_cell) + + if (jcollect_cell>0) then + weights_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,:,ie) = & + weights_cell(1:jcollect_cell,:)/fvm(ie)%area_sphere_physgrid(i,j)!da_phys(i,j) + + weights_eul_index_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,:,ie) = & + weights_eul_index_cell(1:jcollect_cell,:) + weights_lgr_index_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,1,ie) = i + weights_lgr_index_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,2,ie) = j + jall_fvm2phys(ie) = jall_fvm2phys(ie)+jcollect_cell + endif + end do + enddo + jall_fvm2phys(ie)=jall_fvm2phys(ie)-1 + + + jall_phys2fvm(ie)=1 + do j=1,fvm_nc + do i=1,fvm_nc + xcell(1) = xgno_fvm(i) ; ycell(1) = ygno_fvm(j) + xcell(2) = xgno_fvm(i) ; ycell(2) = ygno_fvm(j+1) + xcell(3) = xgno_fvm(i+1); ycell(3) = ygno_fvm(j+1) + xcell(4) = xgno_fvm(i+1); ycell(4) = ygno_fvm(j) + + call compute_weights_cell(nvertex,.true.,& + xcell,ycell,i,j,irecons,xgno_phys,ygno_phys,0,phys_nc+2,& + 1,phys_nc+1,1,phys_nc+1,& + ngpc,gauss_weights,abscissae,& + weights_cell,weights_eul_index_cell,jcollect_cell,jmax_segments_cell) + + if (jcollect_cell>0) then + weights_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,:,ie) & + = weights_cell(1:jcollect_cell,:)/fvm(ie)%area_sphere(i,j)!da_fvm(i,j) + + weights_eul_index_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,:,ie) = & + weights_eul_index_cell(1:jcollect_cell,:) + weights_lgr_index_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,1,ie) = i + weights_lgr_index_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,2,ie) = j + jall_phys2fvm(ie) = jall_phys2fvm(ie)+jcollect_cell + endif + end do + enddo + jall_phys2fvm(ie)=jall_phys2fvm(ie)-1 + end do + end subroutine fvm2phys_init +end module dp_mapping diff --git a/src/dynamics/se/dycore.F90 b/src/dynamics/se/dycore.F90 new file mode 100644 index 0000000000..89385b22fe --- /dev/null +++ b/src/dynamics/se/dycore.F90 @@ -0,0 +1,26 @@ +module dycore + +implicit none +private + +public :: dycore_is + +!========================================================================================= +CONTAINS +!========================================================================================= + +logical function dycore_is (name) + + character(len=*) :: name + + dycore_is = .false. + if (name == 'unstructured' .or. name == 'UNSTRUCTURED' .or. & + name == 'se' .or. name == 'SE') then + dycore_is = .true. + end if + +end function dycore_is + +!========================================================================================= + +end module dycore diff --git a/src/dynamics/se/dycore/bndry_mod.F90 b/src/dynamics/se/dycore/bndry_mod.F90 new file mode 100644 index 0000000000..0e3954f87a --- /dev/null +++ b/src/dynamics/se/dycore/bndry_mod.F90 @@ -0,0 +1,960 @@ +module bndry_mod + use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 + use parallel_mod, only: HME_BNDRY_A2A, HME_BNDRY_A2AO + use thread_mod, only: omp_in_parallel, omp_get_thread_num + use gbarrier_mod, only: gbarrier + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + + implicit none + private + + interface bndry_exchange + module procedure bndry_exchange_threaded + module procedure bndry_exchange_nonthreaded + module procedure long_bndry_exchange_nonth + end interface + public :: bndry_exchange + + interface ghost_exchange + module procedure ghost_exchange_threaded + module procedure ghost_exchange_nonthreaded + end interface + public :: ghost_exchange + + interface bndry_exchange_start + module procedure bndry_exchange_threaded_start + module procedure bndry_exchange_nonthreaded_start + end interface + public :: bndry_exchange_start + + interface bndry_exchange_finish + module procedure bndry_exchange_threaded_finish + module procedure bndry_exchange_nonthreaded_finish + end interface + public :: bndry_exchange_finish + + + public :: compute_ghost_corner_orientation + public :: ghost_exchangeVfull + public :: copyBuffer + +contains + + subroutine bndry_exchange_a2a(par,nthreads,ithr,buffer,location) + use edgetype_mod, only: Edgebuffer_t + use schedtype_mod, only: schedule_t, cycle_t, schedule + use thread_mod, only: omp_in_parallel, omp_get_thread_num + use perf_mod, only: t_startf, t_stopf + use spmd_utils, only: mpi_real8, mpi_success + use parallel_mod, only: parallel_t + use perf_mod, only: t_startf, t_stopf + + type (parallel_t) :: par + integer, intent(in) :: nthreads + integer :: ithr ! The OpenMP thread ID + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + type (Schedule_t), pointer :: pSchedule + type (Cycle_t), pointer :: pCycle + integer :: icycle,ierr + integer :: length + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character*(80) :: errorstring + character(len=*), parameter :: subname = 'bndry_exchange_a2a' + character(len=80) :: locstring + logical :: ompthreadMissmatch + + integer :: i,j + integer :: request + +! Neighborhood collectives are only in MPI3 and up +#ifdef SPMD +#if MPI_VERSION >= 3 + + if(ithr == 0) then + + call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsFull,buffer%sdisplsFull,Mpi_real8, & + buffer%receive,buffer%rcountsFull,buffer%rdisplsFull,Mpi_real8,par%commGraphFull,request,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring + endif + + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + ! location 1 for copyBuffer + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + + call MPI_wait(request,lstatus,ierr) + call t_stopf('bndry_a2a') + else + + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + + endif +#else + call endrun('bndry_exchange_a2a requires MPI-3 feature support') +#endif +#endif + + end subroutine bndry_exchange_a2a + + subroutine copyBuffer(nthreads,ithr,buffer,location) + use edgetype_mod, only : Edgebuffer_t + integer :: nthreads + integer :: ithr + type (EdgeBuffer_t) :: buffer + character(len=80) :: location + logical :: ompThreadMissmatch + integer lenMovePtr, iptr,length,i,j + + ompThreadMissmatch = .false. + lenMovePtr = size(buffer%moveptr) + if ( lenMOveptr .ne. nthreads) then + ompthreadMissmatch = .true. + write(*,30) TRIM(location), lenMoveptr, nthreads + endif + + if (.not. ompthreadMissmatch) then + iptr = buffer%moveptr(ithr+1) + length = buffer%moveLength(ithr+1) + if(length>0) then + do i=0,length-1 + buffer%receive(iptr+i) = buffer%buf(iptr+i) + enddo + endif + else if(ompthreadMissmatch .and. ithr == 0) then + do j=1,lenMovePtr + iptr = buffer%moveptr(j) + length = buffer%moveLength(j) + if(length>0) then + do i=0,length-1 + buffer%receive(iptr+i) = buffer%buf(iptr+i) + enddo + endif + enddo + endif +30 format(a,'Potential performance issue: ',a,'LenMoveptr,nthreads: ',2(i3)) + end subroutine copyBuffer + + subroutine bndry_exchange_a2ao(par,nthreads,ithr,buffer,location) + use edgetype_mod, only : Edgebuffer_t + use schedtype_mod, only : schedule_t, cycle_t, schedule + use thread_mod, only : omp_in_parallel, omp_get_thread_num + use perf_mod, only : t_startf, t_stopf + use spmd_utils, only: mpi_real8, mpi_success, mpi_status_size + use parallel_mod, only: parallel_t + use perf_mod, only : t_startf, t_stopf + + type (parallel_t) :: par + integer, intent(in) :: nthreads + integer :: ithr ! The OpenMP thread ID + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + integer :: ierr + integer :: errorcode,errorlen + character(len=80) :: errorstring + character(len=*), parameter :: subname = 'bndry_exchange_a2ao' + character(len=80) :: locstring + + integer :: requestIntra,requestInter + integer :: lstatus(MPI_status_size) + +! Neighborhood collectives are only in MPI3 and up +#ifdef SPMD +#if MPI_VERSION >= 3 + + if(ithr == 0) then + + call t_startf('bndry_a2ao') + ! Start Inter-node communication + call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsInter,buffer%sdisplsInter,MPI_real8, & + buffer%receive,buffer%rcountsInter,buffer%rdisplsInter,MPI_real8,par%commGraphInter,requestInter,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring + endif + ! Start Intra-node communication + call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsIntra,buffer%sdisplsIntra,MPI_real8, & + buffer%receive,buffer%rcountsIntra,buffer%rdisplsIntra,MPI_real8,par%commGraphIntra,requestIntra,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring + endif + + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + ! Finish the Intra-node communication + call MPI_wait(requestIntra,lstatus,ierr) + + ! location 3 for copyBuffer + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + + ! Finish the Inter-node communication + call MPI_wait(requestInter,lstatus,ierr) + call t_stopf('bndry_a2ao') + + else + + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + !Copy buffer for ithr!=0 + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + + endif +#else + call endrun('bndry_exchange_a2ao requires MPI-3 feature support') +#endif +#endif + + end subroutine bndry_exchange_a2ao + + subroutine bndry_exchange_p2p(par,nthreads,ithr,buffer,location) + use edgetype_mod, only: Edgebuffer_t + use schedtype_mod, only: schedule_t, cycle_t, schedule + use thread_mod, only: omp_in_parallel, omp_get_thread_num + use spmd_utils, only: mpi_real8, mpi_success + use parallel_mod, only: parallel_t + use perf_mod, only: t_startf, t_stopf + + type (parallel_t) :: par + integer, intent(in) :: nthreads + integer :: ithr + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + type (Schedule_t),pointer :: pSchedule + type (Cycle_t),pointer :: pCycle + integer :: dest,length,tag + integer :: icycle,ierr + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character*(80) :: errorstring + character(len=*), parameter :: subname = 'bndry_exchange_p2p' + character(len=80) :: locstring + logical, parameter :: Debug=.FALSE. + + integer :: i,j + logical :: ompthreadMissmatch + integer :: lenMovePtr + + pSchedule => Schedule(1) + nlyr = buffer%nlyr + ompthreadMissmatch = .FALSE. + + lenMovePtr = size(buffer%moveptr) + + if(ithr == 0) then + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + + + !================================================== + ! Fire off the sends + !================================================== + + do icycle=1,nSendCycles + pCycle => pSchedule%SendCycle(icycle) + dest = pCycle%dest - 1 + length = buffer%scountsFull(icycle) + tag = buffer%tag + iptr = buffer%sdisplsFull(icycle) + 1 + if(Debug) write(iulog,*) subname,': MPI_Isend: DEST:',dest,'LENGTH:',length,'TAG: ',tag + call MPI_Isend(buffer%buf(iptr),length,Mpi_real8,dest,tag,par%comm,buffer%Srequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring + endif + end do ! icycle + + !================================================== + ! Post the Receives + !================================================== + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + source = pCycle%source - 1 + length = buffer%rcountsFull(icycle) + tag = buffer%tag + iptr = buffer%rdisplsFull(icycle) + 1 + if(Debug) write(iulog,*) subname,': MPI_Irecv: SRC:',source,'LENGTH:',length,'TAG: ',tag + call MPI_Irecv(buffer%receive(iptr),length,Mpi_real8, & + source,tag,par%comm,buffer%Rrequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring + endif + end do ! icycle + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + if (nSendCycles>0) call MPI_Waitall(nSendCycles,buffer%Srequest,buffer%status,ierr) + if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,buffer%Rrequest,buffer%status,ierr) + else + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + endif + + end subroutine bndry_exchange_p2p + + subroutine bndry_exchange_p2p_start(par,nthreads,ithr,buffer,location) + + use edgetype_mod, only: Edgebuffer_t + use schedtype_mod, only: schedule_t, cycle_t, schedule + use thread_mod, only: omp_in_parallel, omp_get_thread_num + use spmd_utils, only: mpi_real8, mpi_success + use parallel_mod, only: parallel_t + + type (parallel_t) :: par + integer, intent(in) :: nthreads + integer :: ithr + type (EdgeBuffer_t) :: buffer + character (len=*), optional :: location + + type (Schedule_t),pointer :: pSchedule + type (Cycle_t),pointer :: pCycle + integer :: dest,length,tag + integer :: icycle,ierr + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character*(80) :: errorstring + character(len=*), parameter :: subname = 'bndry_exchange_p2p_start' + logical, parameter :: Debug=.FALSE. + + integer :: i,j, lenMovePtr + logical :: ompthreadMissmatch + + pSchedule => Schedule(1) + nlyr = buffer%nlyr + ompthreadMissmatch = .FALSE. + + lenMovePtr = size(buffer%moveptr) + + if(ithr == 0) then + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + + !================================================== + ! Fire off the sends + !================================================== + + do icycle=1,nSendCycles + pCycle => pSchedule%SendCycle(icycle) + dest = pCycle%dest - 1 + length = buffer%scountsFull(icycle) + tag = buffer%tag + iptr = buffer%sdisplsFull(icycle) + 1 + if(Debug) write(iulog,*) subname,': MPI_Isend: DEST:',dest,'LENGTH:',length,'TAG: ',tag + call MPI_Isend(buffer%buf(iptr),length,Mpi_real8,dest,tag,par%comm,buffer%Srequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring + endif + end do ! icycle + + !================================================== + ! Post the Receives + !================================================== + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + source = pCycle%source - 1 + length = buffer%rcountsFull(icycle) + tag = buffer%tag + iptr = buffer%rdisplsFull(icycle) + 1 + if(Debug) write(iulog,*) subname,': MPI_Irecv: SRC:',source,'LENGTH:',length,'TAG: ',tag + call MPI_Irecv(buffer%receive(iptr),length,Mpi_real8, & + source,tag,par%comm,buffer%Rrequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring + endif + end do ! icycle + endif + + end subroutine bndry_exchange_p2p_start + + subroutine bndry_exchange_p2p_finish(par,nthreads,ithr,buffer,location) + use edgetype_mod, only: Edgebuffer_t + use schedtype_mod, only: schedule_t, cycle_t, schedule + use thread_mod, only: omp_in_parallel, omp_get_thread_num + use parallel_mod, only: parallel_t + use perf_mod, only: t_startf, t_stopf + + + type (parallel_t) :: par + integer, intent(in) :: nthreads + integer :: ithr + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + type (Schedule_t), pointer :: pSchedule + type (Cycle_t), pointer :: pCycle + integer :: dest,length,tag + integer :: icycle,ierr + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character*(80) :: errorstring + character(len=*), parameter :: subname = 'bndry_exchange_p2p_finish' + character(len=80) :: locstring + + integer :: i,j + logical :: ompthreadMissmatch + integer :: lenMovePtr + + + pSchedule => Schedule(1) + if(present(location)) then + locstring = TRIM(subname) // ': ' // TRIM(location) + else + locstring = TRIM(subname) + endif + call t_startf('bndry_copy') + call copyBuffer(nthreads,ithr,buffer,locstring) + call t_stopf('bndry_copy') + + if(ithr == 0) then + + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + + if (nSendCycles>0) call MPI_Waitall(nSendCycles,buffer%Srequest,buffer%status,ierr) + if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,buffer%Rrequest,buffer%status,ierr) + + endif + + end subroutine bndry_exchange_p2p_finish + + subroutine long_bndry_exchange_nonth(par,buffer) + use edgetype_mod, only: LongEdgebuffer_t + use schedtype_mod, only: schedule_t, cycle_t, schedule + use thread_mod, only: omp_in_parallel + use parallel_mod, only: parallel_t, status, srequest, rrequest + use spmd_utils, only: mpi_integer, mpi_success + + type (parallel_t) :: par + type (LongEdgeBuffer_t) :: buffer + + type (Schedule_t), pointer :: pSchedule + type (Cycle_t), pointer :: pCycle + integer :: dest,length,tag + integer :: icycle,ierr + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character*(80) :: errorstring + character(len=*), parameter :: subname = 'long_bndry_exchange_nonth' + + integer :: i + +#ifdef SPMD + if(omp_in_parallel()) then + print *,subname,': Warning you are calling a non-thread safe' + print *,' routine inside a threaded region.... ' + print *,' Results are not predictable!! ' + endif + + + ! Setup the pointer to proper Schedule + pSchedule => Schedule(1) + nlyr = buffer%nlyr + + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + + + !================================================== + ! Fire off the sends + !================================================== + + do icycle=1,nSendCycles + pCycle => pSchedule%SendCycle(icycle) + dest = pCycle%dest - 1 + length = nlyr * pCycle%lengthP + tag = pCycle%tag + iptr = pCycle%ptrP + + call MPI_Isend(buffer%buf(1,iptr),length,Mpi_integer,dest,tag,par%comm,Srequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring + endif + end do ! icycle + + !================================================== + ! Post the Receives + !================================================== + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + source = pCycle%source - 1 + length = nlyr * pCycle%lengthP + tag = pCycle%tag + iptr = pCycle%ptrP + + call MPI_Irecv(buffer%receive(1,iptr),length,Mpi_integer, & + source,tag,par%comm,Rrequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring + endif + end do ! icycle + + + !================================================== + ! Wait for all the receives to complete + !================================================== + + if (nSendCycles>0) call MPI_Waitall(nSendCycles,Srequest,status,ierr) + if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,Rrequest,status,ierr) + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + length = pCycle%lengthP + iptr = pCycle%ptrP + do i=0,length-1 + buffer%buf(1:nlyr,iptr+i) = buffer%receive(1:nlyr,iptr+i) + enddo + end do ! icycle + +#endif + + end subroutine long_bndry_exchange_nonth + !******************************************************************************** + ! + !******************************************************************************** + + + subroutine ghost_exchange_threaded(hybrid,buffer,location) + use hybrid_mod, only : hybrid_t + use edgetype_mod, only : Edgebuffer_t + + implicit none + + type (hybrid_t) :: hybrid + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + call bndry_exchange_threaded(hybrid,buffer,location) + end subroutine ghost_exchange_threaded + + subroutine bndry_exchange_threaded(hybrid,buffer,location) + use hybrid_mod, only : hybrid_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (hybrid_t) :: hybrid + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + character(len=*), parameter :: subname = 'bndry_exchange_threaded' + + call gbarrier(buffer%gbarrier, hybrid%ithr) + if(buffer%bndry_type == HME_BNDRY_A2A) then + call bndry_exchange_a2a(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location) + else if (buffer%bndry_type == HME_BNDRY_A2AO) then + call bndry_exchange_a2ao(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location) + else + call bndry_exchange_p2p(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location) + endif + call gbarrier(buffer%gbarrier, hybrid%ithr) + + end subroutine bndry_exchange_threaded + + subroutine bndry_exchange_threaded_start(hybrid,buffer,location) + use hybrid_mod, only : hybrid_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (hybrid_t) :: hybrid + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + character(len=*), parameter :: subname = 'bndry_exchange_threaded_start' + + call gbarrier(buffer%gbarrier, hybrid%ithr) + call bndry_exchange_p2p_start(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location) + + end subroutine bndry_exchange_threaded_start + + subroutine bndry_exchange_threaded_finish(hybrid,buffer,location) + use hybrid_mod, only : hybrid_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (hybrid_t) :: hybrid + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + character(len=*), parameter :: subname = 'bndry_exchange_threaded_finish' + + call bndry_exchange_p2p_finish(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location) + call gbarrier(buffer%gbarrier, hybrid%ithr) + + end subroutine bndry_exchange_threaded_finish + + subroutine ghost_exchange_nonthreaded(par,buffer,location) + use parallel_mod, only : parallel_t + use edgetype_mod, only : Edgebuffer_t + type (parallel_t) :: par + type (EdgeBUffer_t) :: buffer + character(len=*), optional :: location + call bndry_exchange_nonthreaded(par,buffer,location) + end subroutine ghost_exchange_nonthreaded + + subroutine bndry_exchange_nonthreaded(par,buffer,location) + use parallel_mod, only : parallel_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (parallel_t) :: par + type (EdgeBuffer_t) :: buffer + character(len=*), optional :: location + + integer :: ithr + integer :: nthreads + character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded' + + !$OMP BARRIER + ithr=0 + nthreads = 1 + if(buffer%bndry_type == HME_BNDRY_A2A) then + call bndry_exchange_a2a(par,nthreads,ithr,buffer,location) + else if (buffer%bndry_type == HME_BNDRY_A2AO) then + call bndry_exchange_a2ao(par,nthreads,ithr,buffer,location) + else + call bndry_exchange_p2p(par,nthreads,ithr,buffer,location) + endif + !$OMP BARRIER + + end subroutine bndry_exchange_nonthreaded + + subroutine bndry_exchange_nonthreaded_start(par,buffer,location) + use parallel_mod, only : parallel_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (parallel_t) :: par + type (EdgeBuffer_t) :: buffer + character (len=*), optional :: location + + integer :: ithr + integer :: nthreads + character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded_start' + + !$OMP BARRIER + ithr=0 + nthreads=1 + call bndry_exchange_p2p_start(par,nthreads,ithr,buffer,location) + + end subroutine bndry_exchange_nonthreaded_start + + subroutine bndry_exchange_nonthreaded_finish(par,buffer,location) + use parallel_mod, only : parallel_t + use edgetype_mod, only : Edgebuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf + implicit none + + type (parallel_t) :: par + integer :: ithr + type (EdgeBuffer_t) :: buffer + character (len=*), optional :: location + integer :: nthreads + + character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded_finish' + + ithr=0 + nthreads=1 + call bndry_exchange_p2p_finish(par,nthreads,ithr,buffer,location) + !$OMP BARRIER + + end subroutine bndry_exchange_nonthreaded_finish + + subroutine compute_ghost_corner_orientation(hybrid,elem,nets,nete) +! +! this routine can NOT be called in a threaded region because then each thread +! will have its on ghostbuffer. initghostbufer3D() should detect this and abort. +! + use dimensions_mod, only: nelemd, np + use parallel_mod, only : syncmp + use hybrid_mod, only : hybrid_t + use element_mod, only : element_t + use edgetype_mod, only : edgebuffer_t + use edge_mod, only : ghostpack, ghostunpack, & + initghostbuffer,freeghostbuffer + + use control_mod, only : north,south,east,west,neast, nwest, seast, swest + + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + integer :: nets,nete + type (edgeBuffer_t) :: ghostbuf_cv + + real (kind=r8) :: cin(-1:4,-1:4,1,nets:nete) !CE: fvm tracer + real (kind=r8) :: cout(-1:4,-1:4,1,nets:nete) !CE: fvm tracer + integer :: i,j,ie,kptr,np1,np2,nc,nc1,nc2,k,nlev + logical :: fail,fail1,fail2 + real (kind=r8) :: tol = 0.1_r8 + call syncmp(hybrid%par) + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! first test on the Gauss Grid with same number of ghost cells: +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + nc=2 ! test using GLL interior points + nc1=-1 + nc2=4 + + nlev=1 + + if (hybrid%nthreads > 1) then + call endrun('ERROR: compute_ghost_corner_orientation must be called before threaded region') + endif + call initghostbuffer(hybrid%par,ghostbuf_cv,elem,nlev,nc,nc) + + + cin = 0._r8 + do ie=nets,nete + cin(1,1,1,ie)= elem(ie)%gdofp(1,1) + cin(nc,nc,1,ie)= elem(ie)%gdofp(np,np) + cin(1,nc,1,ie)= elem(ie)%gdofp(1,np) + cin(nc,1,1,ie)= elem(ie)%gdofp(np,1) + enddo + cout=0 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! run ghost exchange on c array to get corner orientation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do ie=nets,nete + kptr=0 + call ghostpack(ghostbuf_cv, cin(:,:,:,ie),nlev,kptr,ie) + end do + call ghost_exchange(hybrid,ghostbuf_cv) + do ie=nets,nete + kptr=0 + call ghostunpack(ghostbuf_cv, cout(:,:,:,ie),nlev,kptr,ie) + enddo + +! nc +--------+ +! ^ | nw ne | +! j | | | +! 1 | sw se | +! +--------+ +! 1 --> nc +! i + +! check SW corner + do ie=nets,nete + fail1=.false. + fail2=.false. + if ( elem(ie)%desc%putmapP_ghost(swest) /= -1) then + if (abs(cout(nc1,1,1,ie)-cout(nc1,0,1,ie)) .gt. tol ) fail1=.true. + if (abs(cout(1,nc1,1,ie)-cout(0,nc1,1,ie)).gt.tol) fail2=.true. + endif + if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange SW orientation failure') + if (fail1) then + elem(ie)%desc%reverse(swest)=.true. + endif + enddo +! check SE corner + do ie=nets,nete + fail1=.false. + fail2=.false. + if ( elem(ie)%desc%putmapP_ghost(seast) /= -1) then + if (abs(cout(nc2,1,1,ie)-cout(nc2,0,1,ie)) .gt. tol ) fail1=.true. + if (abs(cout(nc+1,nc1,1,ie)-cout(nc,nc1,1,ie)).gt.tol) fail2=.true. + endif + if (fail1 .neqv. fail2 ) call endrun('ghost exchange SE orientation failure') + if (fail1) then + elem(ie)%desc%reverse(seast)=.true. + endif + enddo +! check NW corner + do ie=nets,nete + fail1=.false. + fail2=.false. + if ( elem(ie)%desc%putmapP_ghost(nwest) /= -1) then + if (abs(cout(nc1,nc+1,1,ie)-cout(nc1,nc,1,ie)) .gt. tol ) fail1=.true. + if (abs(cout(1,nc2,1,ie)-cout(0,nc2,1,ie)).gt.tol) fail2=.true. + endif + if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange NW orientation failure') + if (fail1) then + elem(ie)%desc%reverse(nwest)=.true. + endif + enddo +! check NE corner + do ie=nets,nete + fail1=.false. + fail2=.false. + if ( elem(ie)%desc%putmapP_ghost(neast) /= -1) then + if (abs(cout(nc2,nc+1,1,ie)-cout(nc2,nc,1,ie)) .gt. tol ) fail1=.true. + if (abs(cout(nc+1,nc2,1,ie)-cout(nc,nc2,1,ie)).gt.tol) fail2=.true. + endif + if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange NE orientation failure') + if (fail1) then + elem(ie)%desc%reverse(neast)=.true. + endif + enddo + call freeghostbuffer(ghostbuf_cv) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! end ghost exchange corner orientation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + end subroutine + subroutine ghost_exchangeVfull(par,ithr,buffer) +! +! MT 2011: derived from bndry_exchange, but copies an entire +! element of ghost cell information, including corner +! elements. Requres cubed-sphere grid +! + use hybrid_mod, only : hybrid_t + use edgetype_mod, only: Ghostbuffer3D_t + use schedtype_mod, only : schedule_t, cycle_t, schedule + use dimensions_mod, only: nelemd + use parallel_mod, only : status, srequest, rrequest, parallel_t + use spmd_utils, only: mpi_integer, mpi_success,mpi_real8 + + implicit none + type (parallel_t) :: par + integer :: ithr ! hybrid%ithr 0 if called outside threaded region + + type (GhostBuffer3D_t) :: buffer + + type (Schedule_t),pointer :: pSchedule + type (Cycle_t),pointer :: pCycle + integer :: dest,length,tag + integer :: icycle,ierr + integer :: iptr,source,nlyr + integer :: nSendCycles,nRecvCycles + integer :: errorcode,errorlen + character(len=*), parameter :: subname = 'ghost_exchangeVfull' + character*(80) errorstring + + integer :: i,i1,i2 + + !$OMP BARRIER + if(ithr == 0) then + + +#ifdef SPMD + ! Setup the pointer to proper Schedule + pSchedule => Schedule(1) + nlyr = buffer%nlyr + + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + + !================================================== + ! Fire off the sends + !================================================== + do icycle=1,nSendCycles + pCycle => pSchedule%SendCycle(icycle) + dest = pCycle%dest - 1 + length = nlyr * pCycle%lengthP_ghost * buffer%elem_size + tag = pCycle%tag + iptr = pCycle%ptrP_ghost + + call MPI_Isend(buffer%buf(1,1,1,iptr),length,MPI_real8,dest,tag,par%comm,Srequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,subname,': Error after call to MPI_Isend: ',errorstring + endif + end do ! icycle + + !================================================== + ! Post the Receives + !================================================== + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + source = pCycle%source - 1 + length = nlyr * pCycle%lengthP_ghost * buffer%elem_size + tag = pCycle%tag + iptr = pCycle%ptrP_ghost + + call MPI_Irecv(buffer%receive(1,1,1,iptr),length,MPI_real8, & + source,tag,par%comm,Rrequest(icycle),ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,subname,': Error after call to MPI_Irecv: ',errorstring + endif + end do ! icycle + + + !================================================== + ! Wait for all the receives to complete + !================================================== + + call MPI_Waitall(nSendCycles,Srequest,status,ierr) + call MPI_Waitall(nRecvCycles,Rrequest,status,ierr) + + do icycle=1,nRecvCycles + pCycle => pSchedule%RecvCycle(icycle) + length = pCycle%lengthP_ghost + iptr = pCycle%ptrP_ghost + do i=0,length-1 + buffer%buf(:,:,1:nlyr,iptr+i) = buffer%receive(:,:,1:nlyr,iptr+i) + enddo + end do ! icycle + + +#endif + endif ! if (hybrid%ithr == 0) + !$OMP BARRIER + + end subroutine ghost_exchangeVfull + + +end module bndry_mod diff --git a/src/dynamics/se/dycore/comp_ctr_vol_around_gll_pts.F90 b/src/dynamics/se/dycore/comp_ctr_vol_around_gll_pts.F90 new file mode 100644 index 0000000000..d9405b034a --- /dev/null +++ b/src/dynamics/se/dycore/comp_ctr_vol_around_gll_pts.F90 @@ -0,0 +1,2310 @@ +! Code that computes control volumes with the same area as the GLL weights +! (for SCRIP) uses analytic area formula. + +module comp_gll_ctr_vol + use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_sys_mod, only: shr_sys_flush + use global_norms_mod, only: wrap_repro_sum + use physconst, only: pi + use infnan, only: isnan + + use coordinate_systems_mod, only: cartesian3d_t, cartesian2d_t + use coordinate_systems_mod, only: spherical_polar_t, change_coordinates + use coordinate_systems_mod, only: cubedsphere2cart, cube_face_number_from_cart + use coordinate_systems_mod, only: distance, sphere_tri_area + use parallel_mod, only: global_shared_buf, global_shared_sum + use edgetype_mod, only: EdgeBuffer_t, Ghostbuffer3D_t + use dimensions_mod, only: np, ne + use control_mod, only: fine_ne + use reduction_mod, only: red_sum, parallelmin, parallelmax + + implicit none + private + save + + character(len=16), public :: se_write_gll_grid = "no" + + ! nv_max will be set to 2*max_elements_attached_to_node + ! This works out to 6 for the regular case and 14 for refined meshes + integer :: nv_max=-99 + + type, public :: ctrlvol_t + real(r8) :: vol(np,np) ! area of the unit sphere covered (local) + real(r8) :: totvol(np,np) ! area of the unit sphere covered (local) + real(r8) :: invvol(np,np) ! inverse area (includes neigbors) + type(cartesian2d_t) :: cartp_dual(0:np,0:np) + type(cartesian3d_t) :: cart3d_dual(0:np,0:np) + type(cartesian3D_t), allocatable :: vert(:,:,:) ! bounding box for the polygon + type(spherical_polar_t), allocatable :: vert_latlon(:,:,:) ! bounding box for the polygon + integer, allocatable :: face_no(:,:,:) ! face_no of cv vertex. 0 if on cube edge + integer :: nvert(np,np) ! number of vertex per polygon + end type ctrlvol_t + + ! tho options: + ! (1) for NP<>4 or Refined Meshes (this is less accurate) + ! build control volumes out of lines which are + ! always gnomonic coordinate lines. results in hexagon control volumes + ! at cube corners and edges. control volumes at cube-sphere edges are + ! non-convex, which breaks SCRIP. + ! iterative option for NP=4 only: + ! (2) (USE_PENTAGONS) + ! iterate to minimize difference between spherical area and GLL weight + ! introduce pentagons in the center of each element to make areas agree + ! control volumes are triangles, squares or pentagons + + type(ctrlvol_t), allocatable, target :: cvlist(:) + type(EdgeBuffer_t) :: edge1 + type(GhostBuffer3D_t) :: ghost_buf + + ! User interface + public :: gll_grid_write ! Write the grid in SCRIP format and exit + + ! Private interfaces + private:: InitControlVolumesData ! allocates internal data structure + private:: InitControlVolumes ! Inits all surfaces: vol,totvol, invvol + + private:: GetVolumeLocal + private:: GetVolume + + logical, private :: initialized = .false. + +CONTAINS + + subroutine gll_grid_write(elem, grid_format, filename_in) + use netcdf, only: nf90_strerror + use spmd_utils, only: masterproc, mpicom + use pio, only: var_desc_t, file_desc_t + use pio, only: pio_int, pio_double, PIO_NOERR + use pio, only: pio_put_att, pio_put_var, pio_enddef + use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + use cam_grid_support, only: cam_grid_id, cam_grid_dimensions + use cam_grid_support, only: cam_grid_write_dist_array + !!XXgoldyXX: v debug only +#define USE_PIO3D +#ifdef USE_PIO3D + use pio, only: io_desc_t, pio_write_darray, PIO_OFFSET_KIND + use cam_pio_utils, only: cam_pio_newdecomp + use spmd_utils, only: iam +#endif + !!XXgoldyXX: ^ debug only + + use hybrid_mod, only: hybrid_t, config_thread_region + use parallel_mod, only: par + use dimensions_mod, only: nelem, nelemd + use control_mod, only: refined_mesh, fine_ne + use element_mod, only: element_t + use dof_mod, only: UniquePoints + use coordinate_systems_mod, only: cart2spherical + + ! Inputs + type(element_t), intent(in) :: elem(:) + character(len=*), intent(in) :: grid_format + character(len=*), intent(in) :: filename_in + + real(r8), parameter :: rad2deg = 180._r8/pi + + ! Local variables +!!XXgoldyXX: v debug only +#ifdef USE_PIO3D + integer(PIO_OFFSET_KIND), allocatable :: ldof(:) + integer :: ii, jj + type(io_desc_t), pointer :: iodesc +#endif +!!XXgoldyXX: ^ debug only + integer :: i, j, ie, ierror, status, ivtx, index + integer :: grid_corners_id, grid_rank_id, grid_size_id + type(var_desc_t) :: grid_dims_id, grid_area_id, grid_center_lat_id + type(var_desc_t) :: grid_center_lon_id, grid_corner_lat_id + type(var_desc_t) :: grid_corner_lon_id, grid_imask_id + + type(file_desc_t) :: file + integer :: gll_grid ! Grid ID + integer :: gridsize ! Total number of unique grid columns + integer :: arr_dims2d(2) ! (/ np*np, nelemed) + integer :: file_dims2d(1) ! (/ gridsize /) + integer :: arr_dims3d(3) ! (/ np*np, nv_max, nelemed) + integer :: file_dims3d(2) ! (/ nv_max, gridsize /) + + real(r8), allocatable :: gwork(:,:,:) ! np*np, nv_max, nelemd + type(hybrid_t) :: hybrid + character(len=256) :: errormsg + character(len=shr_kind_cl) :: filename + type(spherical_polar_t) :: sphere + character(len=*), parameter :: subname = 'gll_grid_write' + + !! Check to see if we are doing grid output + if (trim(grid_format) == "no") then + if (masterproc) then + write(iulog, *) subname, ': Not writing phys_grid file.' + end if + return + else if (trim(grid_format) /= 'SCRIP') then + write(errormsg, *) subname, ': ERROR, bad value for se_write_grid, ', & + trim(grid_format) + call endrun(errormsg) + end if + + ! Set up the control volumes + if (refined_mesh) then + nv_max = 14 + else + nv_max = 5 + end if + if (masterproc) then + write(iulog, *) subname, ': computing GLL dual grid for control volumes:' + end if + call InitControlVolumesData(par,elem,nelemd) + ! single thread + hybrid = config_thread_region(par,'serial') + call InitControlVolumes(elem,hybrid,1,nelemd) + if (masterproc) then + write(6, *) subname, ': done computing GLL dual grid for control volumes.' + end if + + ! Create the NetCDF file + if (len_trim(filename_in) == 0) then + if (refined_mesh) then + if (fine_ne <= 0) then + call endrun('gll_grid_write: refined_mesh selected but fine_ne not set') + else + write(filename,'(a,i0,a,a,3a)') "ne0np", np, "_refined_", trim(grid_format), ".nc" + end if + else + write(filename, '(a,i0,a,i0,a,a,3a)') "ne", ne, "np", np, & + "_", trim(grid_format), ".nc" + end if + else + filename = trim(filename_in) + end if + if (masterproc) then + write(iulog, *) 'Writing gll SCRIP grid file: ', trim(filename) + call shr_sys_flush(iulog) + end if + + call cam_pio_createfile(file, trim(filename)) + gll_grid = cam_grid_id('GLL') + call cam_grid_dimensions(gll_grid, file_dims3d) + gridsize = file_dims3d(1) + file_dims2d(1) = gridsize + file_dims3d(1) = nv_max + file_dims3d(2) = gridsize + arr_dims2d(1) = np*np + arr_dims2d(2) = nelemd + arr_dims3d(1) = np*np + arr_dims3d(2) = nv_max + arr_dims3d(3) = nelemd + call cam_pio_def_dim(file, "grid_corners", nv_max, grid_corners_id) + call cam_pio_def_dim(file, "grid_rank", 1, grid_rank_id) + call cam_pio_def_dim(file, "grid_size", gridsize, grid_size_id) + ! Define the coordinate variables + call cam_pio_def_var(file, "grid_dims", pio_int, (/ grid_rank_id /), & + grid_dims_id) + + ! Define grid area + call cam_pio_def_var(file, "grid_area", pio_double, & + (/grid_size_id/), grid_area_id) + status = pio_put_att(file, grid_area_id, "units", "radians^2") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining units attribute for grid_area' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + status = pio_put_att(file, grid_area_id, "long_name", "area weights") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining long_name attribute for grid_area' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Define grid center latitudes + call cam_pio_def_var(file, "grid_center_lat", pio_double, & + (/grid_size_id/), grid_center_lat_id) + status = pio_put_att(file, grid_center_lat_id, "units", "degrees") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining units attribute for grid_center_lat' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Define grid center longitudes + call cam_pio_def_var(file, "grid_center_lon", pio_double, & + (/grid_size_id/), grid_center_lon_id) + status = pio_put_att(file, grid_center_lon_id, "units", "degrees") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining units attribute for grid_center_lon' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Define grid corner latitudes + call cam_pio_def_var(file, "grid_corner_lat", pio_double, & + (/grid_corners_id, grid_size_id/), grid_corner_lat_id) + status = pio_put_att(file, grid_corner_lat_id, "units", "degrees") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining units attribute for grid_corner_lon' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Grid corner longitudes + call cam_pio_def_var(file, "grid_corner_lon", pio_double, & + (/grid_corners_id, grid_size_id/), grid_corner_lon_id) + status = pio_put_att(file, grid_corner_lon_id, "units", "degrees") + if (status /= pio_noerr) then + write(iulog, *) subname,': Error defining units attribute for grid_corner_lon' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Grid mask + call cam_pio_def_var(file, "grid_imask", pio_double, & + (/grid_size_id/), grid_imask_id) + + ! End of NetCDF definitions + status = PIO_enddef(file) + if (status /= pio_noerr) then + write(iulog, *) subname, ': Error calling enddef' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + + ! Work array to gather info before writing + allocate(gwork(np*np, nv_max, nelemd)) + + ! Write grid size + status = pio_put_var(file, grid_dims_id, (/ gridsize /)) + if (status /= pio_noerr) then + write(iulog, *) subname, ': Error writing variable grid_dims' + call shr_sys_flush(iulog) + call endrun(subname//": "//trim(nf90_strerror(status))) + end if + ! Write GLL grid areas + do ie = 1, nelemd + index = 1 + do j = 1, np + do i = 1, np + gwork(index, 1, ie) = cvlist(ie)%vol(i,j) + index = index + 1 + end do + end do + end do + call cam_grid_write_dist_array(file, gll_grid, arr_dims2d, file_dims2d, & + gwork(:,1,:), grid_area_id) + ! Write GLL grid cell center latitude + do ie = 1, nelemd + index = 1 + do j = 1, np + do i = 1, np + gwork(index, 1, ie) = elem(ie)%spherep(i,j)%lat * rad2deg + index = index + 1 + end do + end do + end do + call cam_grid_write_dist_array(file, gll_grid, arr_dims2d, file_dims2d, & + gwork(:,1,:), grid_center_lat_id) + ! Write GLL grid cell center longitude + do ie = 1, nelemd + index = 1 + do j = 1, np + do i = 1, np + gwork(index, 1, ie) = elem(ie)%spherep(i,j)%lon * rad2deg + index = index + 1 + end do + end do + end do + call cam_grid_write_dist_array(file, gll_grid, arr_dims2d, file_dims2d, & + gwork(:,1,:), grid_center_lon_id) + + ! GLL grid corners + ! Collect all information for the grid corner latitude (counter-clockwise) + do ie = 1, nelemd + do ivtx = 1, nv_max + index = 1 + do j = 1, np + do i = 1, np + gwork(index, ivtx, ie) = cvlist(ie)%vert_latlon(ivtx,i,j)%lat * rad2deg + index = index + 1 + end do + end do + end do + end do +!!XXgoldyXX: v debug only +#ifdef USE_PIO3D +allocate(ldof(np*np*nelemd*nv_max)) +ldof = 0 +do ie = 1, nelemd + do index = 1, elem(ie)%idxP%NumUniquePts + i = elem(ie)%idxP%ia(index) + j = elem(ie)%idxP%ja(index) + ii = (i - 1) + ((j - 1) * np) + ((ie - 1) * np * np * nv_max) + 1 + jj = (elem(ie)%idxP%UniquePtOffset + index - 2) * nv_max + do ivtx = 1, nv_max + ldof(ii) = jj + ivtx + if ((jj+ivtx < 1) .or. (jj+ivtx > gridsize*nv_max)) then + write(errormsg, '(4(a,i0))') ' ERROR (',iam,'): ldof(',ii,') = ',jj + ivtx,' > ',gridsize*nv_max + call endrun(subname//trim(errormsg)) + end if + ii = ii + np*np + end do + end do +end do +allocate(iodesc) +call cam_pio_newdecomp(iodesc, (/ nv_max, gridsize /), ldof, PIO_double) +call pio_write_darray(file, grid_corner_lat_id, iodesc, gwork, status) +#else +!!XXgoldyXX: ^ debug only + call cam_grid_write_dist_array(file, gll_grid, arr_dims3d, file_dims3d, & + gwork, grid_corner_lat_id) +!!XXgoldyXX: v debug only +#endif +!!XXgoldyXX: ^ debug only + ! Collect all information for the grid corner longitude (counter-clockwise) + do ie = 1, nelemd + do ivtx = 1, nv_max + index = 1 + do j = 1, np + do i = 1, np + gwork(index, ivtx, ie) = cvlist(ie)%vert_latlon(ivtx,i,j)%lon * rad2deg + index = index + 1 + end do + end do + end do + end do +!!XXgoldyXX: v debug only +#ifdef USE_PIO3D +call pio_write_darray(file, grid_corner_lon_id, iodesc, gwork, status) +#else +!!XXgoldyXX: ^ debug only + call cam_grid_write_dist_array(file, gll_grid, arr_dims3d, file_dims3d, & + gwork, grid_corner_lon_id) +!!XXgoldyXX: v debug only +#endif +!!XXgoldyXX: ^ debug only + ! Grid imask + gwork(:,1,:) = 1.0_r8 + call cam_grid_write_dist_array(file, gll_grid, arr_dims2d, file_dims2d, & + gwork(:,1,:), grid_imask_id) + + call mpi_barrier(mpicom, ierror) + ! Close the file + call cam_pio_closefile(file) + if(masterproc) then + write(iulog, *) 'Finished writing physics grid file: ', trim(filename) + call shr_sys_flush(iulog) + end if + + end subroutine gll_grid_write + + ! elemid is the local element id (in nets:nete) + function GetVolume(elemid) result(vol) + + integer, intent(in) :: elemid + real(kind=r8), pointer :: vol(:,:) + + if(.not. initialized) then + call endrun('Attempt to use volumes prior to initializing') + end if + vol => cvlist(elemid)%totvol + + end function GetVolume + + function GetVolumeLocal(elemid) result(vol) + + integer, intent(in) :: elemid + real(r8), pointer :: vol(:,:) + + if(.not. initialized) then + call endrun('Attempt to use volumes prior to initializing') + end if + vol => cvlist(elemid)%vol + + end function GetVolumeLocal + + subroutine InitControlVolumesData(par, elem, nelemd) + use edge_mod, only: initedgebuffer, initGhostBuffer3D + use parallel_mod, only: parallel_t, HME_BNDRY_P2P + use element_mod, only: element_t + use thread_mod, only: horz_num_threads + + type(parallel_t), intent(in) :: par + type(element_t), intent(in) :: elem(:) + integer, intent(in) :: nelemd + + integer :: ie + + ! Cannot be done in a threaded region + allocate(cvlist(nelemd)) + do ie = 1, nelemd + allocate(cvlist(ie)%vert(nv_max, np,np)) + allocate(cvlist(ie)%vert_latlon(nv_max,np,np)) + allocate(cvlist(ie)%face_no(nv_max,np,np)) + end do + + call initedgebuffer(par,edge1,elem,3,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + call initGhostBuffer3D(ghost_buf,3,np+1,1) + end subroutine InitControlVolumesData + + subroutine VerifyAreas(elem,hybrid,nets,nete) + + use element_mod, only: element_t + use hybrid_mod, only: hybrid_t + + integer, intent(in) :: nets,nete + type(element_t), intent(in), target :: elem(:) + type(hybrid_t), intent(in) :: hybrid + + integer :: i, j, ie, k, kptr, kmax + real(r8) :: rspheremp(np,np) + real(r8) :: invvol(np,np) + real(r8) :: error, max_error, max_invvol, maxrsphere + + error = 0 + max_error = 0 + do ie=nets,nete + rspheremp = elem(ie)%rspheremp + invvol = cvlist(ie)%invvol + do j=1,np + do i=1,np + error = 100*ABS(rspheremp(i,j)-invvol(i,j))/invvol(i,j) + if (max_error.lt.error) then + max_error = error + max_invvol = invvol(i,j) + maxrsphere = rspheremp(i,j) + end if + end do + end do + end do + print '(A,F16.4 )',"Control Volume Stats: Max error percent:", max_error + print '(A,F16.12)'," Value From Element:",1/maxrsphere + print '(A,F16.12)'," Value From Control Volume:",1/max_invvol + max_error = parallelmax(max_error,hybrid) + if (hybrid%masterthread) then + write(6, '(a,f16.4)') "Control volume area vs. gll area: max error (percent):", max_error + end if + + end subroutine VerifyAreas + + + subroutine InitControlVolumes(elem, hybrid,nets,nete) + use element_mod, only: element_t + use hybrid_mod, only: hybrid_t + use control_mod, only: refined_mesh + + integer, intent(in) :: nets,nete + type(element_t), intent(in), target :: elem(:) + type(hybrid_t), intent(in) :: hybrid + + if (refined_mesh .or. (np /= 4)) then + call InitControlVolumes_duel(elem, hybrid,nets,nete) + else + call InitControlVolumes_gll(elem, hybrid,nets,nete) + call VerifVolumes(elem, hybrid,nets,nete) + end if + end subroutine InitControlVolumes + + subroutine InitControlVolumes_duel(elem, hybrid,nets,nete) + use bndry_mod, only: bndry_exchange + use edge_mod, only: edgeVpack, edgeVunpack, freeedgebuffer, freeghostbuffer3D + use element_mod, only: element_t, element_var_coordinates, element_var_coordinates3d + use hybrid_mod, only: hybrid_t + + use quadrature_mod, only: quadrature_t, gausslobatto + use coordinate_systems_mod, only: cube_face_number_from_sphere + + integer, intent(in) :: nets,nete + type(element_t), intent(in), target :: elem(:) + type(hybrid_t), intent(in) :: hybrid + + type(quadrature_t) :: gll_pts + type(cartesian3d_t) :: quad(4),corners3d(4) + real(r8) :: cv_pts(0:np) !was kind=longdouble_kind in HOMME + real(r8) :: test(np,np,1) + + integer :: i, j, ie, k, kmax2, kk + + gll_pts = gausslobatto(np) + ! gll points + cv_pts(0)=-1 + do i=1,np + cv_pts(i) = cv_pts(i-1) + gll_pts%weights(i) + end do + cv_pts(np)=1 + do i=1,np-1 + if (gll_pts%points(i) > cv_pts(i) .or. cv_pts(i) > gll_pts%points(i+1)) then + call endrun("Error: CV and GLL points not interleaved") + end if + end do + + + ! intialize local element areas + test = 0 + do ie=nets,nete + cvlist(ie)%cart3d_dual(0:np,0:np) = element_var_coordinates3D(elem(ie)%corners3D, cv_pts) + + ! compute true area of element and SEM area + cvlist(ie)%vol=0 + do i=1,np + do j=1,np + ! (gnomonic coordinate lines only), more accurate + quad(1) = cvlist(ie)%cart3d_dual(i-1,j-1) + quad(2) = cvlist(ie)%cart3d_dual(i,j-1) + quad(3) = cvlist(ie)%cart3d_dual(i,j) + quad(4) = cvlist(ie)%cart3d_dual(i-1,j) + cvlist(ie)%vol(i,j) = surfarea(quad,4) + end do + end do + test(:,:,1) = cvlist(ie)%vol(:,:) + call edgeVpack(edge1,test,1,0,ie) + end do + + call bndry_exchange(hybrid, edge1) + + test = 0 + do ie=nets,nete + test(:,:,1) = cvlist(ie)%vol(:,:) + call edgeVunpack(edge1, test, 1, 0, ie) + cvlist(ie)%totvol(:,:) = test(:,:,1) + cvlist(ie)%invvol(:,:)=1.0_r8/cvlist(ie)%totvol(:,:) + end do + + call VerifyAreas(elem, hybrid, nets, nete) + + ! construct the global CV grid and global CV areas from the + ! local dual grid (cvlist()%cart_dual) and local areas (cvlist()%vol) + call construct_cv_duel(elem, hybrid, nets, nete) + ! compute output needed for SCRIP: lat/lon coordinates, and for the + ! control volume with only 3 corners, repeat the last point to make a + ! degenerate quad. + kmax2 = 0 + do ie = nets, nete + kmax2 = MAX(kmax2, MAXVAL(cvlist(ie)%nvert)) + end do + do ie = nets, nete + do j = 1, np + do i = 1, np + cvlist(ie)%vert_latlon(:,i,j)%lat = 0.0_r8 + cvlist(ie)%vert_latlon(:,i,j)%lon = 0.0_r8 + k = cvlist(ie)%nvert(i,j) + ! + ! follow SCRIP protocol - of kk>k then repeat last vertex + ! + do kk = k+1, nv_max + cvlist(ie)%vert(kk, i, j) = cvlist(ie)%vert(k,i,j) + end do + do kk = 1, nv_max + cvlist(ie)%vert_latlon(kk, i, j) = change_coordinates(cvlist(ie)%vert(kk, i, j)) + cvlist(ie)%face_no(kk, i, j) = cube_face_number_from_sphere(cvlist(ie)%vert_latlon(kk, i, j)) + end do + + end do + end do + end do + ! Release memory + if(hybrid%masterthread) then + call freeedgebuffer(edge1) + call FreeGhostBuffer3D(ghost_buf) + end if + + initialized=.true. + end subroutine InitControlVolumes_duel + + function average(t, n) result(a) + + integer, intent(in) :: n + type(cartesian3d_t), intent(in) :: t(n) + type(cartesian3d_t) :: a + integer :: i + + a%x = 0._r8 + a%y = 0._r8 + a%z = 0._r8 + do i = 1, n + a%x = a%x + t(i)%x + a%y = a%y + t(i)%y + a%z = a%z + t(i)%z + end do + a%x = a%x / n + a%y = a%y / n + a%z = a%z / n + return + end function average + + function make_unique(a, n) result(m) + + integer, intent(in) :: n + real(r8), intent(inout) :: a(n) + integer :: m + integer :: i,j + real(r8) :: delta + + do i=1,n-1 + do j=i+1,n + ! if (ABS(a(j)-a(i)).lt. 1e-6) a(j) = 9999 + delta = abs(a(j)-a(i)) + if (delta < 1.e-6_r8) a(j) = 9999.0_r8 + if (abs((2.0_r8*pi) - delta) < 1.0e-6_r8) a(j) = 9999.0_r8 + end do + end do + m = 0 + do i=1,n + if (a(i) < 9000.0_r8) m = m + 1 + end do + if (mod(m,2).ne.0) then + do i=1,n + print *,'angle with centroid: ',i,a(i),mod(a(i),2*pi) + end do + call endrun("Error: Found an odd number or nodes for cv element. Should be even.") + end if + return + end function make_unique + + function SortNodes(t3, n) result(m) + use coordinate_systems_mod, only: cube_face_number_from_cart, cart2cubedsphere, change_coordinates + + + integer, intent(in) :: n + type(cartesian3d_t), intent(inout) :: t3(n) + + type(cartesian3d_t) :: c3, t(n) + type(cartesian2d_t) :: c2, t2 + real(r8) :: angle(n) + integer :: i,j,k,m,f + integer :: ip(n) + + c3 = average(t3, n) + f = cube_face_number_from_cart(c3) + c2 = cart2cubedsphere(c3, f) + + do i=1,n + t2 = cart2cubedsphere(t3(i), f) + t2%x = t2%x - c2%x + t2%y = t2%y - c2%y + angle(i) = atan2(t2%y, t2%x) + end do + m = make_unique(angle,n) + do i=1,m + k = 1 + do j=2,n + if (angle(j)2->3->4 is counter clockwise on the sphere + ! Negative: clockwise orientation + + do j=1,np + do i=1,np + cvlist(ie)%vert(:,i,j)%x = 0.0_r8 + cvlist(ie)%vert(:,i,j)%y = 0.0_r8 + cvlist(ie)%vert(:,i,j)%z = 0.0_r8 + end do + end do + + do j=-1,np+1 + do i=-1,np+1 + cv(i,j)%x = vertunpack(i,j,1) + cv(i,j)%y = vertunpack(i,j,2) + cv(i,j)%z = vertunpack(i,j,3) + end do + end do + + do j=-1,0 + do i=-1,0 + do k=1,mlt(swest)-1 + cv_sw(i,j,k)%x = sw(i,j,1,k) + cv_sw(i,j,k)%y = sw(i,j,2,k) + cv_sw(i,j,k)%z = sw(i,j,3,k) + end do + end do + end do + do j=-1,0 + do i=np,np+1 + do k=1,mlt(seast)-1 + cv_se(i,j,k)%x = se(i,j,1,k) + cv_se(i,j,k)%y = se(i,j,2,k) + cv_se(i,j,k)%z = se(i,j,3,k) + end do + end do + end do + do j=np,np+1 + do i=-1,0 + do k=1,mlt(nwest)-1 + cv_nw(i,j,k)%x = nw(i,j,1,k) + cv_nw(i,j,k)%y = nw(i,j,2,k) + cv_nw(i,j,k)%z = nw(i,j,3,k) + end do + end do + end do + do j=np,np+1 + do i=np,np+1 + do k=1,mlt(neast)-1 + cv_ne(i,j,k)%x = ne(i,j,1,k) + cv_ne(i,j,k)%y = ne(i,j,2,k) + cv_ne(i,j,k)%z = ne(i,j,3,k) + end do + end do + end do + + do j=2,np-1 + do i=2,np-1 + ! internal vertex on Cubed sphere + ! Here is the order: + ! + ! 4NW <- 3NE + ! | ^ + ! v | + ! 1SW -> 2SE + vert(1) = cv(i-1, j-1) + vert(2) = cv(i , j-1) + vert(3) = cv(i , j ) + vert(4) = cv(i-1, j ) + cvlist(ie)%vert(1:4,i,j) = vert(1:4) + cvlist(ie)%nvert(i,j) = 4 + m=4 + end do + end do + + do j=0,np,np + do i=2,np-1 + vert(1) = cv(i-1, j-1) + vert(2) = cv(i , j-1) + vert(3) = cv(i , j ) + vert(4) = cv(i , j+1) + vert(5) = cv(i-1, j+1) + vert(6) = cv(i-1, j ) + p = j + if (p.eq.0) p=1 + cvlist(ie)%vert(1:6,i,p) = vert(1:6) + cvlist(ie)%nvert(i,p) = 6 + m=6 + end do + end do + + do j=2,np-1 + do i=0,np,np + vert(1) = cv(i-1, j-1) + vert(2) = cv(i , j-1) + vert(3) = cv(i+1, j-1) + vert(4) = cv(i+1, j ) + vert(5) = cv(i , j ) + vert(6) = cv(i-1, j ) + o = i + if (o.eq.0) o=1 + cvlist(ie)%vert(1:6,o,j) = vert(1:6) + cvlist(ie)%nvert(o,j) = 6 + m=6 + end do + end do + do j=0,np,np + do i=0,np,np + m = 0 + vert(:)%x = 0 + vert(:)%y = 0 + vert(:)%z = 0 + if (i.eq.0.and.j.eq.0) then + ! counterclockwise from lower right + vert(m+1) = cv(i+1, j-1) ! 5 4 + vert(m+2) = cv(i+1, j ) ! (-1,+1) (0,+1) (+1,+1) 3 + vert(m+3) = cv(i+1, j+1) ! + vert(m+4) = cv(i , j+1) ! (-1, 0) (i, j) (+1, 0) 2 + vert(m+5) = cv(i-1, j+1) ! + vert(m+6) = cv(i-1, j ) ! X X (+1,-1) 1 + m = m + 6 + if (mlt(swest).ne.0) then + vert(m+1) = cv(i-1, j-1) + vert(m+2) = cv(i , j-1) + m = m+2 + do k=1,mlt(swest)-1 ! Bummer, toss in (-1,0) because transpose is undetectable + vert(m+1) = cv_sw(i-1, j , k) + vert(m+2) = cv_sw(i-1, j-1, k) + vert(m+3) = cv_sw(i , j-1, k) + m=m+3 + end do + end if + end if + if (i.eq.np.and.j.eq.0) then + if (mlt(seast).ne.0) then + vert(m+1) = cv(i+1, j-1) + vert(m+2) = cv(i+1, j ) + m = m+2 + do k=1,mlt(seast)-1 + vert(m+1) = cv_se(i , j-1, k) + vert(m+2) = cv_se(i+1, j-1, k) + vert(m+3) = cv_se(i+1, j , k) + m=m+3 + end do + end if + vert(m+1) = cv(i+1, j+1) + vert(m+2) = cv(i , j+1) + vert(m+3) = cv(i-1, j+1) + vert(m+4) = cv(i-1, j ) + vert(m+5) = cv(i-1, j-1) + vert(m+6) = cv(i , j-1) + m = m + 6 + end if + if (i.eq.np.and.j.eq.np) then + vert(1) = cv(i+1, j-1) + vert(2) = cv(i+1, j ) + m = m + 2 + if (mlt(neast).ne.0) then + vert(m+1) = cv(i+1, j+1) + vert(m+2) = cv(i , j+1) + m = m+2 + do k=1,mlt(neast)-1 + vert(m+1) = cv_ne(i+1, j , k) + vert(m+2) = cv_ne(i+1, j+1, k) + vert(m+3) = cv_ne(i , j+1, k) + m=m+3 + end do + end if + vert(m+1) = cv(i-1, j+1) + vert(m+2) = cv(i-1, j ) + vert(m+3) = cv(i-1, j-1) + vert(m+4) = cv(i , j-1) + m = m + 4 + end if + if (i.eq.0.and.j.eq.np) then + vert(m+1) = cv(i+1, j-1) + vert(m+2) = cv(i+1, j ) + vert(m+3) = cv(i+1, j+1) + vert(m+4) = cv(i , j+1) + m = m + 4 + if (mlt(nwest).ne.0) then + vert(m+1) = cv(i-1, j+1) + vert(m+2) = cv(i-1, j ) + m = m+2 + do k=1,mlt(nwest)-1 + vert(m+1) = cv_nw(i , j+1, k) + vert(m+2) = cv_nw(i-1, j+1, k) + vert(m+3) = cv_nw(i-1, j , k) + m=m+3 + end do + end if + vert(m+1) = cv(i-1, j-1) + vert(m+2) = cv(i , j-1) + m = m + 2 + end if + o = i + p = j + if (o.eq.0) o=1 + if (p.eq.0) p=1 + m2=m + if (8 < m) then + m = SortNodes(vert, m2) + end if + if (m > nv_max) then + call endrun("error: vert dimensioned too small") + end if + cvlist(ie)%vert(1:m,o,p) = vert(1:m) + cvlist(ie)%nvert(o,p) = m + end do + end do + end do + end subroutine construct_cv_duel + + function SurfArea( cv, nvert ) result(area) + + type(cartesian3D_t), intent(in) :: cv(:) + integer, intent(in) :: nvert + + real(kind=r8) :: area, area1, area2, area3 + + if (abs(nvert) == 3 ) then + area2 = 0.0_r8 + area3 = 0.0_r8 + if (cv(1)%x == 0) then + call sphere_tri_area(cv(2), cv(3), cv(4), area1) + else if (cv(2)%x == 0) then + call sphere_tri_area(cv(1), cv(3), cv(4), area1) + else if (cv(3)%x == 0) then + call sphere_tri_area(cv(1), cv(2), cv(4), area1) + else if (cv(4)%x == 0) then + call sphere_tri_area(cv(1), cv(2), cv(3), area1) + else + write(iulog, *) cv(1)%x, cv(1)%y + write(iulog, *) cv(2)%x, cv(2)%y + write(iulog, *) cv(3)%x, cv(3)%y + write(iulog, *) cv(4)%x, cv(4)%y + write(iulog, *) 'SurfArea error: should never happen' + call shr_sys_flush(iulog) + call endrun('SurfArea: invalid cv coordinates') + end if + else if (abs(nvert)==4) then + call sphere_tri_area(cv(1), cv(2), cv(3), area1) + call sphere_tri_area(cv(1), cv(3), cv(4), area2) + area3 = 0.0_r8 + + else if (abs(nvert)==5) then + call sphere_tri_area(cv(1),cv(2),cv(3),area1) + call sphere_tri_area(cv(1),cv(3),cv(4),area2) + call sphere_tri_area(cv(1),cv(4),cv(5),area3) + else + call endrun('SurfArea: nvert > 5 not yet supported') + end if + area = area1 + area2 + area3 + end function SurfArea + + ! ^ + ! |dy o + ! | + ! (x,y) ---->dx + function SurfArea_dxdy(dx, dy, corner) result(integral) + use quadrature_mod, only: quadrature_t + + real(r8), intent(in) :: dx, dy + type(cartesian2d_t), intent(in) :: corner + real(r8) :: integral + + real(r8) :: alpha, beta, a1, a2, a3, a4 + + ! cubed-sphere cell area, from Lauritzen & Nair MWR 2008 + ! central angles: + ! cube face: -pi/4,-pi/4 -> pi/4,pi/4 + ! this formula gives 2 so normalize by 4pi/6 / 2 = pi/3 + alpha = corner%x + beta = corner%y + a1 = acos(-sin(alpha)*sin(beta)) ! 2.094 + a2 = -acos(-sin(alpha+dx)*sin(beta) ) ! -1.047 + a3 =- acos(-sin(alpha)*sin(beta+dy) ) ! -1.047 + a4 = acos(-sin(alpha+dx)*sin(beta+dy) ) ! 2.094 + integral = (a1+a2+a3+a4) + return + end function SurfArea_dxdy + + function find_intersect(x1in, x2in, y1in, y2in) result(sect) + + type(cartesian2D_t), intent(in) :: x1in, x2in, y1in, y2in + type(cartesian2D_t) :: sect + + type(cartesian2D_t) :: x, y, b, x1, x2, y1, y2 + real(kind=r8) :: s1, s2, detA + + ! x1 + (x2-x1)*s1 = y1 + (y2-y1)*s2 + ! b = y1-x1 + ! x=x2-x1 + ! y=y2-y1 + ! x s1 - y s2 = b + ! x(1) s1 - y(1) s2 = b(1) + ! x(2) s1 - y(2) s2 = b(2) + ! + ! x(1) -y(1) s1 = b(1) A s = b + ! x(2) -y(2) s2 = b(2) + ! + ! A2= -y(2) y(1) + ! -x(2) x(1) s = A2 * b /detA + + ! convert to gnomonic + x1%x = tan(x1in%x) + x2%x = tan(x2in%x) + y1%x = tan(y1in%x) + y2%x = tan(y2in%x) + x1%y = tan(x1in%y) + x2%y = tan(x2in%y) + y1%y = tan(y1in%y) + y2%y = tan(y2in%y) + + x%x = x2%x-x1%x + x%y = x2%y-x1%y + y%x = y2%x-y1%x + y%y = y2%y-y1%y + b%x = y1%x-x1%x + b%y = y1%y-x1%y + + detA = -x%x*y%y + x%y*y%x + + s1 = (-y%y*b%x + y%x*b%y )/detA + s2 = (-x%y*b%x + x%x*b%y )/detA + + sect%x = x1%x + (x2%x-x1%x)*s1 + sect%y = x1%y + (x2%y-x1%y)*s1 + + sect%x = (sect%x + y1%x + (y2%x-y1%x)*s2)/2 + sect%y = (sect%y + y1%y + (y2%y-y1%y)*s2)/2 + + if (s1<0 .or. s1>1) then + write(iulog, *) 'failed: intersection: ',s1,s2 + call shr_sys_flush(iulog) + call endrun('find_intersect: intersection failure') + end if + + ! convert back to equal angle: + sect%x = atan(sect%x) + sect%y = atan(sect%y) + end function find_intersect + + subroutine pentagon_iteration(sq1,sq2,pent,asq1,asq2,apent,faceno,anorm) + ! sq2 + ! 4 3 + ! 1 2 + ! + ! sq1 4 3 + ! 2 1 5 pent + ! 3 4 1 2 + ! + ! + ! d/dt sq1(1) = (area(sq1)-asq1) * [ com(sq1)-sq1(1) ] + ! +(area(sq2)-asq2) * [ com(sq2)-sq1(1) ] + ! +(area(pent)-apent) * [ com(pent)-sq1(1) ] + ! + ! + ! + type(cartesian2d_t), intent(inout) :: sq1(4), sq2(4), pent(5) + real(r8), intent(in) :: asq1, asq2, apent, anorm + integer, intent(in) :: faceno + + type(cartesian3D_t) :: sq1_3d(4), sq2_3d(4), pent_3d(5) + real(r8) :: isq1, isq2, ipent, diff1, diff2, diffp, err + real(r8), parameter :: dt = .5_r8 + real(r8), parameter :: tol_pentagon_iteration = 1.0e-10_r8 + type(cartesian2d_t) :: sq1com, sq2com, pentcom, ds1, ds2 + integer :: i, iter + integer, parameter :: iter_max = 10000 + + ! compute center of mass: + sq1com%x = sum(sq1(:)%x)/4 + sq1com%y = sum(sq1(:)%y)/4 + sq2com%x = sum(sq2(:)%x)/4 + sq2com%y = sum(sq2(:)%y)/4 + pentcom%x = sum(pent(:)%x)/5 + pentcom%y = sum(pent(:)%y)/5 + + do i = 1, 4 + sq1_3d(i)=cubedsphere2cart(sq1(i),faceno ) + sq2_3d(i)=cubedsphere2cart(sq2(i),faceno ) + pent_3d(i)=cubedsphere2cart(pent(i),faceno ) + end do + pent_3d(5)=cubedsphere2cart(pent(5),faceno ) + + do iter = 1, iter_max + isq1 = SurfArea(sq1_3d,4) + isq2 = SurfArea(sq2_3d,4) + ipent = SurfArea(pent_3d,5) + + ! d/dt sq1(1) = (area(sq1)-asq1) * [ com(sq1)-sq1(1) ] + ! +(area(sq2)-asq2) * [ com(sq2)-sq1(1) ] + ! +(area(pent)-apent) * [ com(pent)-sq1(1) ] + ! + diff1 = (isq1-asq1)/anorm + diff2 = (isq2-asq2)/anorm + diffp = (ipent-apent)/anorm + + err = abs(diff1) + abs(diff2) + abs(diffp) + if (err < tol_pentagon_iteration) exit + if (mod(iter,1000) == 0) then + write(iulog, '(i5,3e18.5)') iter, err + call shr_sys_flush(iulog) + end if + + ds1%x = diff1* ( sq1com%x - sq1(1)%x ) + ds1%y = diff1* ( sq1com%y - sq1(1)%y ) + ds1%x = ds1%x + diffp* ( pentcom%x - sq1(1)%x ) + ds1%y = ds1%y + diffp* ( pentcom%y - sq1(1)%y ) + + ds2%x = diff2* ( sq2com%x - sq2(1)%x ) + ds2%y = diff2* ( sq2com%y - sq2(1)%y ) + ds2%x = ds2%x + diffp* ( pentcom%x - sq2(1)%x ) + ds2%y = ds2%y + diffp* ( pentcom%y - sq2(1)%y ) + + sq1(1)%x = sq1(1)%x + dt*ds1%x + sq1(1)%y = sq1(1)%y + dt*ds1%y + sq2(1)%x = sq2(1)%x + dt*ds2%x + sq2(1)%y = sq2(1)%y + dt*ds2%y + pent(4)=sq2(1) + pent(5)=sq1(1) + sq1_3d(1)=cubedsphere2cart(sq1(1),faceno ) + sq2_3d(1)=cubedsphere2cart(sq2(1),faceno ) + pent_3d(4)=sq2_3d(1) + pent_3d(5)=sq1_3d(1) + end do + if (iter >= iter_max) then + write(iulog, *) 'pentagon iteration did not converge err=', err + call shr_sys_flush(iulog) + end if + end subroutine pentagon_iteration + + subroutine InitControlVolumes_gll(elem, hybrid,nets,nete) + use edge_mod, only: freeedgebuffer + use element_mod, only: element_t,element_coordinates + use hybrid_mod, only: hybrid_t + + use quadrature_mod, only: quadrature_t, gausslobatto + use dimensions_mod, only: nlev + use cube_mod, only: convert_gbl_index + use coordinate_systems_mod, only: cart2cubedsphere_failsafe, cart2cubedsphere + use coordinate_systems_mod, only: cube_face_number_from_sphere + + integer, intent(in) :: nets,nete + type(element_t), intent(in), target :: elem(:) + type(hybrid_t), intent(in) :: hybrid + + type(cartesian2d_t) :: cartp_com(np,np) ! center of mass + type(cartesian2d_t) :: cartp_nm1(0:np,0:np) + real(r8) :: delx_k,dely_k,sum_dbg,r + integer :: i,j,ie,k,kptr,gllpts,nvert,k2,ie1,je1,face_no,kinsert + integer :: iter,iter_max,i1,j1 + real(r8) :: diff(np,np),diffy(np-1,np-1),diffx(np-1,np-1) + real(r8) :: dx,dy,a1(nets:nete),a2(nets:nete),d1(nets:nete),d1mid(nets:nete) + real(r8) :: d2,d1_global,d1_global_mid,sphere1,sphere2,diff2,diff3 + real(r8) :: diff23,diff32,diff33,diff22 + real(r8) :: gllnm1(0:np) !was longdouble_kind in HOMME + type(cartesian2d_t) :: corner,start,endd,cv_loc_2d(4,np,np),cvnew_loc_2d(4,np,np) + type(cartesian3D_t) :: cart,cv_loc_3d(nv_max,np,np) + type(cartesian3D_t) :: temp3d(nv_max) + type(cartesian2d_t) :: cartp2d(np,np) + type(cartesian2d_t) :: x1,x2,x3,x + type(cartesian2d_t) :: sq1(4),sq2(4),pent(5) + type(cartesian3D_t) :: x1_3d,x2_3d,x3_3d + type(quadrature_t) :: gll + type(cartesian2d_t) :: dir,dirsum + type(spherical_polar_t) :: polar_tmp(0:np,0:np) + real(r8) :: rvert,area1,area2,ave,lat(4),lon(4) + real(r8) :: s,ds,triarea,triarea_target + real(r8) :: xp1,xm1,yp1,ym1,sumdiff + real(r8) :: tiny = 1e-11_r8,norm + real(r8) :: tol = 2.e-11_r8 ! convergece outer iteration + real(r8) :: tol_pentagons = 1.e-13_r8 ! convergece pentagon iteration + + ! area difference to trigger pentagons. + ! if it is too small, we will have pentagons with 1 very short edges + ! accuracy of surfarea() with very thin triangles seems poor (1e-11) + ! ne=30 1e-3: add 648 pentagons. area ratio: 1.003 + ! ne=30 1e-4: add 696 pentagons. area ratio: 1.000004102 + ! ne=30 1e-5: add 696 pentagons. area ratio: 1.000004102 + ! ne=240 1e-4: add 5688/ 345600 pentagons, area ratio: 1.0004 + ! ne=240 1e-5: add 5736/ 345600 pentagons, area ratio: 1.000000078 + real(r8) :: tol_use_pentagons=1.0e-5_r8 + logical :: Debug=.FALSE.,keep + + integer :: face1,face2,found,ie_max,movex,movey,moved,ii,kmax,kk + integer :: nskip,npent + integer :: nskipie(nets:nete), npentie(nets:nete) + type(cartesian2d_t) :: vert1_2d, vert_2d,vert2_2d + type(cartesian3D_t) :: vert1,vert2,vert_inserted(7) + + kmax=4 + + gll = gausslobatto(np) + ! mid point rule: + do i=1,np-1 + gllnm1(i) = ( gll%points(i) + gll%points(i+1) ) /2 + end do + ! check that gll(i) < gllnm1(i) < gll(i+1) + do i=1,np-1 + if (gll%points(i) > gllnm1(i) .or. gllnm1(i) > gll%points(i+1)) then + call endrun("InitControlVolumes_gll: CV and GLL points not interleaved") + end if + end do + gllnm1(0)=-1 + gllnm1(np)=1 + + ! MNL: dx and dy are no longer part of element_t + ! but they are easily computed for the + ! uniform case + dx = pi/(2.0d0*dble(ne)) + dy = dx + + ! intialize local element dual grid, local element areas + + do ie=nets,nete + + call convert_gbl_index(elem(ie)%vertex%number,ie1,je1,face_no) + start%x=-pi/4 + ie1*dx + start%y=-pi/4 + je1*dy + endd%x =start%x + dx + endd%y =start%y + dy + cartp_nm1(0:np,0:np) = element_coordinates(start,endd,gllnm1) + cvlist(ie)%cartp_dual = cartp_nm1 + + ! compute true area of element and SEM area + a1(ie) = SurfArea_dxdy(dx,dy,elem(ie)%cartp(1,1)) + a2(ie) = sum(elem(ie)%spheremp(:,:)) + do i=1,np + do j=1,np + ! (gnomonic coordinate lines only), more accurate + delx_k = cartp_nm1(i,j-1)%x - cartp_nm1(i-1,j-1)%x + dely_k = cartp_nm1(i-1,j)%y - cartp_nm1(i-1,j-1)%y + cvlist(ie)%vol(i,j) = SurfArea_dxdy(delx_k,dely_k,cartp_nm1(i-1,j-1)) + end do + end do + global_shared_buf(ie,1) = a1(ie) + global_shared_buf(ie,2) = a2(ie) + end do + call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) + sphere1 = global_shared_sum(1) + sphere2 = global_shared_sum(2) + + ! construct the global CV grid and global CV areas from the + ! local dual grid (cvlist()%cart_dual) and local areas (cvlist()%vol) + call construct_cv_gll(elem,hybrid,nets,nete) + + iter_max=2000 + if (iter_max>0) then + ! areas computed from eleemnts on boundaries are from hexagons and pentagons + ! compute new areas where all CVs are squares or triangles + do ie=nets,nete + do i=1,np + do j=1,np + ! ifort bug if we try this: + ! area2 = surfarea(cvlist(ie)%vert(1:4,i,j),cvlist(ie)%nvert(i,j)) + cv_loc_3d(:,i,j)=cvlist(ie)%vert(:,i,j) + area2 = surfarea(cv_loc_3d(:,i,j),cvlist(ie)%nvert(i,j)) + cvlist(ie)%totvol(i,j)=area2 + end do + end do + end do + end if + ! iteration over cvlist(ie)%totvol + d1_global=0 + do iter=1,iter_max + ie_max=-1 + do ie=nets,nete + ! we want at each point, the gll_area = true_area + ! but sum(gll_area) = a2 and sum(true_area)=a1 + ! so normalize so that: gll_area/a2 = true_area/a1, or gll_area = area*a2/a1 + + ! requires more iterations, but the total volume within an + ! element is always correct + diff(:,:) = ( cvlist(ie)%vol(:,:) - elem(ie)%spheremp(:,:)*a1(ie)/a2(ie) ) + sumdiff=sum( cvlist(ie)%vol(:,:)) - a1(ie) + diff(:,:) = diff(:,:)/(a1(ie)/(np*np)) + + + + ! set boundary values (actually not used) + cartp_nm1 = cvlist(ie)%cartp_dual(0:np,0:np) + ! convert 9 cv corners in this element into cart_nm1 cubed-sphere coordiantes + do i=1,np-1 + do j=1,np-1 + cartp_nm1(i,j) = cart2cubedsphere( cvlist(ie)%vert(3,i,j),elem(ie)%FaceNum ) + end do + end do + ! compute center of mass of control volumes: + ! todo: move points towards GLL points, not center of mass + ! center of mass could send up a feedback with CV points! + do i=1,np + do j=1,np + cart%x = sum( cvlist(ie)%vert(:,i,j)%x )/abs(cvlist(ie)%nvert(i,j)) + cart%y = sum( cvlist(ie)%vert(:,i,j)%y )/abs(cvlist(ie)%nvert(i,j)) + cart%z = sum( cvlist(ie)%vert(:,i,j)%z )/abs(cvlist(ie)%nvert(i,j)) + cartp_com(i,j) = cart2cubedsphere( cart,elem(ie)%FaceNum ) + end do + end do + d2=0 + do i=1,np-1 + do j=1,np-1 + dirsum%x=0 + dirsum%y=0 + movex=1 + movey=1 + moved=0 + + do i1=0,1 + do j1=0,1 + ! keep=.true. : .85/1.05 + ! corners only: .93/1.07 + ! corners and edges: .89/1.11 + keep=.false. + ! corner volumes + if (i==1 .and. j==1) then + if (i1==0 .and. j1==0) keep=.true. + moved=1 + else if (i==np-1 .and. j==1) then + if (i1==1 .and. j1==0) keep=.true. + moved=-1 + else if (i==1 .and. j==np-1) then + if (i1==0 .and. j1==1) keep=.true. + moved=-1 + else if (i==np-1 .and. j==np-1) then + if (i1==1 .and. j1==1) keep=.true. + moved=1 + ! edge volumes + + + else if (i==1) then + if (i1==0) keep=.true. + else if (i==np-1) then + if (i1==1) keep=.true. + else if (j==1) then + if (j1==0) keep=.true. + else if (j==np-1) then + if (j1==1) keep=.true. + else + keep=.true. + end if + if (keep) then + ! error weighted direction towards center of mass of area + ! move towards grid point + dir%x = (elem(ie)%cartp(i+i1,j+j1)%x - cartp_nm1(i,j)%x )*(abs(diff(i+i1,j+j1))) + dir%y = (elem(ie)%cartp(i+i1,j+j1)%y - cartp_nm1(i,j)%y )*(abs(diff(i+i1,j+j1))) + if (moved==1) then + ! project onto (1,1)/sqrt(2) + dir%x = dir%x/sqrt(2d0) + dir%y/sqrt(2d0) + dir%y = dir%x + end if + if (moved==-1) then + ! project onto (-1,1)/sqrt(2) + dir%y = -dir%x/sqrt(2d0) + dir%y/sqrt(2d0) + dir%x = -dir%y + end if + + + if ( diff(i+i1,j+j1) > 0 ) then + ! this volume is too big, so move cv point towards grid center + ! weighted by length error + dirsum%x = dirsum%x + movex*dir%x + dirsum%y = dirsum%y + movey*dir%y + else + dirsum%x = dirsum%x - movex*dir%x + dirsum%y = dirsum%y - movey*dir%y + end if + end if + end do + end do + d2 = d2 + dirsum%x**2 + dirsum%y**2 + cartp_nm1(i,j)%x = cartp_nm1(i,j)%x + 0.25_r8*dirsum%x + cartp_nm1(i,j)%y = cartp_nm1(i,j)%y + 0.25_r8*dirsum%y + + end do + end do + cvlist(ie)%cartp_dual(0:np,0:np) = cartp_nm1 + d2=sqrt(d2) + + d1(ie)=sqrt(sum(diff**2)) + + d1mid(ie)=d1(ie) + ! ignore center cv's: + diff(2:3,2:3)=0 + d1mid(ie)=sqrt(sum(diff**2)) + + end do ! ie loop + dx=maxval(d1) + d1_global = ParallelMax(dx,hybrid) + dx=maxval(d1mid) + d1_global_mid = ParallelMax(dx,hybrid) + if (mod(iter-1,250).eq.0) then + if (hybrid%masterthread) write(iulog, *) iter,"max d1=",d1_global,d1_global_mid + end if + ! compute new global CV (cvlist(ie)%vert from cvlist(ie)%cartp_dual). + ! cvlist()%totarea incorrect since local volumes not computed above + call construct_cv_gll(elem,hybrid,nets,nete) + + ! update totvol (area of multi-element cv) + do ie=nets,nete + do i=1,np + do j=1,np + ! ifort bug if we try this: + ! area2 = surfarea(cvlist(ie)%vert(1:4,i,j),cvlist(ie)%nvert(i,j)) + cv_loc_3d(:,i,j)=cvlist(ie)%vert(:,i,j) + area2 = surfarea(cv_loc_3d(:,i,j),cvlist(ie)%nvert(i,j)) + cvlist(ie)%totvol(i,j) = area2 + if (isnan(area2)) then + write(iulog, *) 'ie,i,j',ie,i,j + write(iulog, *) cvlist(ie)%nvert(i,j) + write(iulog, *) cv_loc_3d(1,i,j) + write(iulog, *) cv_loc_3d(2,i,j) + write(iulog, *) cv_loc_3d(3,i,j) + write(iulog, *) cv_loc_3d(4,i,j) + call shr_sys_flush(iulog) + call endrun('InitControlVolumes_gll: area = NaN') + end if + end do + end do + end do + + ! update %vol (local control volume within each element) + do ie=nets,nete + cartp2d = elem(ie)%cartp + do i=1,np + do j=1,np + ! ifort bug if we try this: + ! area2 = surfarea(cvlist(ie)%vert(1:4,i,j),cvlist(ie)%nvert(i,j)) + + do ii=1,4 + ! + ! if we do not use _failsafe version of cart2cubedsphere code will fail with "-debug" + ! + cv_loc_2d(ii,i,j) = cart2cubedsphere_failsafe( cvlist(ie)%vert(ii,i,j),elem(ie)%FaceNum ) + end do + if (i==1 .and. j==1) then + cv_loc_2d(1,i,j)=cartp2d(i,j) + end if + if (i==np .and. j==1) then + cv_loc_2d(2,i,j)=cartp2d(i,j) + end if + if (i==1 .and. j==np) then + cv_loc_2d(4,i,j)=cartp2d(i,j) + end if + if (i==np .and. j==np) then + cv_loc_2d(3,i,j)=cartp2d(i,j) + end if + + + cvnew_loc_2d(:,i,j)=cv_loc_2d(:,i,j) + + ! + ! 4NW <- 3NE + ! | ^ + ! v | + ! 1SW -> 2SE + if (i==1) then + ! replace points with x< elem(ie)%vert(i,j)%x + if (cv_loc_2d(1,i,j)%x < cartp2d(i,j)%x) then + cvnew_loc_2d(1,i,j) = find_intersect(& + cv_loc_2d(1,i,j), cv_loc_2d(2,i,j),& + elem(ie)%cartp(i,1),elem(ie)%cartp(i,np)) + end if + if (cv_loc_2d(4,i,j)%x < cartp2d(i,j)%x) then + cvnew_loc_2d(4,i,j) = find_intersect(& + cv_loc_2d(4,i,j), cv_loc_2d(3,i,j),& + elem(ie)%cartp(i,1),elem(ie)%cartp(i,np)) + end if + end if + + if (i==np) then + ! replace points with x> elem(ie)%vert(i,j)%x + if (cv_loc_2d(2,i,j)%x > cartp2d(i,j)%x) then + cvnew_loc_2d(2,i,j) = find_intersect(& + cv_loc_2d(1,i,j), cv_loc_2d(2,i,j),& + elem(ie)%cartp(i,1),elem(ie)%cartp(i,np)) + end if + if (cv_loc_2d(3,i,j)%x > cartp2d(i,j)%x) then + cvnew_loc_2d(3,i,j) = find_intersect(& + cv_loc_2d(4,i,j), cv_loc_2d(3,i,j),& + elem(ie)%cartp(i,1),elem(ie)%cartp(i,np)) + end if + end if + ! + ! 4NW <- 3NE + ! | ^ + ! v | + ! 1SW -> 2SE + if (j==1) then + ! replace points with y < elem(ie)%vert(i,j)%y + if (cv_loc_2d(1,i,j)%y < cartp2d(i,j)%y) then + cvnew_loc_2d(1,i,j) = find_intersect(& + cv_loc_2d(1,i,j), cv_loc_2d(4,i,j),& + elem(ie)%cartp(1,j),elem(ie)%cartp(np,j)) + end if + if (cv_loc_2d(2,i,j)%y < cartp2d(i,j)%y) then + cvnew_loc_2d(2,i,j) = find_intersect(& + cv_loc_2d(2,i,j), cv_loc_2d(3,i,j),& + elem(ie)%cartp(1,j),elem(ie)%cartp(np,j)) + end if + end if + if (j==np) then + ! replace points with y > elem(ie)%vert(i,j)%y + if (cv_loc_2d(4,i,j)%y > cartp2d(i,j)%y) then + cvnew_loc_2d(4,i,j) = find_intersect(& + cv_loc_2d(1,i,j), cv_loc_2d(4,i,j),& + elem(ie)%cartp(1,j),elem(ie)%cartp(np,j)) + end if + if (cv_loc_2d(3,i,j)%y > cartp2d(i,j)%y) then + cvnew_loc_2d(3,i,j) = find_intersect(& + cv_loc_2d(2,i,j), cv_loc_2d(3,i,j),& + elem(ie)%cartp(1,j),elem(ie)%cartp(np,j)) + end if + end if + do ii=1,4 + cv_loc_3d(ii,i,j)=cubedsphere2cart(cvnew_loc_2d(ii,i,j),elem(ie)%FaceNum ) + end do + area2 = surfarea(cv_loc_3d(:,i,j),4) + cvlist(ie)%vol(i,j) = area2 + if (isnan(area2)) then + write(iulog, *) 'ie,i,j',ie,i,j + write(iulog, *) cvlist(ie)%nvert(i,j) + write(iulog, *) cv_loc_3d(1,i,j) + write(iulog, *) cv_loc_3d(2,i,j) + write(iulog, *) cv_loc_3d(3,i,j) + write(iulog, *) cv_loc_3d(4,i,j) + call shr_sys_flush(iulog) + call endrun('InitControlVolumes_gll: area = NaN') + end if + end do + end do + end do +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if ( d1_global > 10.0_r8 .or. d1_global_mid < tol) then + if (hybrid%masterthread) then + write(iulog, *) 'first iteration stopping:' + write(iulog, *) iter, "max error=", d1_global_mid + call shr_sys_flush(iulog) + end if + exit + end if + end do ! iteration loop + + kmax=5 + + nskip=0 + npent=0 + nskipie(:) = 0 + npentie(:) = 0 + do ie=nets,nete + diff = ( cvlist(ie)%vol(:,:) - elem(ie)%spheremp(:,:)*a1(ie)/a2(ie) ) + if ( maxval(abs(diff(2:3,2:3)))/a1(ie) > tol_use_pentagons ) then + npent=npent+1 + npentie(ie) = npentie(ie) + 1 + ! + ! 4NW <- 3NE + ! | ^ + ! v | 23 33 + ! 1SW -> 2SE 22 32 + if (diff(2,2)>0 .and. diff(3,3)>0) then + x1 = cart2cubedsphere( cvlist(ie)%vert(3,2,2),elem(ie)%FaceNum ) + x2 = cart2cubedsphere( cvlist(ie)%vert(1,2,2),elem(ie)%FaceNum ) + s = .99_r8 + x3%x = x2%x + (x1%x-x2%x)*s + x3%y = x2%y + (x1%y-x2%y)*s + + sq1(1) = x3 + sq1(2) = cart2cubedsphere( cvlist(ie)%vert(4,2,2),elem(ie)%FaceNum ) + sq1(3) = cart2cubedsphere( cvlist(ie)%vert(1,2,2),elem(ie)%FaceNum ) + sq1(4) = cart2cubedsphere( cvlist(ie)%vert(2,2,2),elem(ie)%FaceNum ) + + x2 = cart2cubedsphere( cvlist(ie)%vert(3,3,3),elem(ie)%FaceNum ) + s = .99_r8 + x3%x = x2%x + (x1%x-x2%x)*s + x3%y = x2%y + (x1%y-x2%y)*s + + sq2(1) = x3 + sq2(2) = cart2cubedsphere( cvlist(ie)%vert(2,3,3),elem(ie)%FaceNum ) + sq2(3) = cart2cubedsphere( cvlist(ie)%vert(3,3,3),elem(ie)%FaceNum ) + sq2(4) = cart2cubedsphere( cvlist(ie)%vert(4,3,3),elem(ie)%FaceNum ) + + pent(1) = cart2cubedsphere( cvlist(ie)%vert(1,3,2),elem(ie)%FaceNum ) + pent(2) = cart2cubedsphere( cvlist(ie)%vert(2,3,2),elem(ie)%FaceNum ) + pent(3) = cart2cubedsphere( cvlist(ie)%vert(3,3,2),elem(ie)%FaceNum ) + pent(4) = sq2(1) + pent(5) = sq1(1) + + call pentagon_iteration(sq1,sq2,pent,& + elem(ie)%spheremp(2,2)*a1(ie)/a2(ie), & + elem(ie)%spheremp(3,3)*a1(ie)/a2(ie), & + elem(ie)%spheremp(3,2)*a1(ie)/a2(ie),elem(ie)%FaceNum,a1(ie)) + + x2_3d=cubedsphere2cart(sq1(1),elem(ie)%FaceNum ) + x3_3d=cubedsphere2cart(sq2(1),elem(ie)%FaceNum ) + + cvlist(ie)%vert(3,2,2)=x2_3d + cvlist(ie)%vert(1,3,3)=x3_3d + + cvlist(ie)%vert(5,2,3)=cvlist(ie)%vert(4,2,3) + cvlist(ie)%vert(4,2,3)=cvlist(ie)%vert(3,2,3) + cvlist(ie)%vert(2,2,3)=x2_3d + cvlist(ie)%vert(3,2,3)=x3_3d + + cvlist(ie)%vert(5,3,2)=x2_3d + cvlist(ie)%vert(4,3,2)=x3_3d + + cvlist(ie)%nvert(2,3)=sign(5,cvlist(ie)%nvert(2,3)) + cvlist(ie)%nvert(3,2)=sign(5,cvlist(ie)%nvert(3,2)) + else if (diff(2,3) >0 .and. diff(3,2)>0) then + ! + ! 4NW <- 3NE + ! | ^ + ! v | 23 33 + ! 1SW -> 2SE 22 32 + x1 = cart2cubedsphere( cvlist(ie)%vert(2,2,3),elem(ie)%FaceNum ) + x2 = cart2cubedsphere( cvlist(ie)%vert(4,2,3),elem(ie)%FaceNum ) + s = .99_r8 + x3%x = x2%x + (x1%x-x2%x)*s + x3%y = x2%y + (x1%y-x2%y)*s + + sq1(1) = x3 + sq1(2) = cart2cubedsphere( cvlist(ie)%vert(3,2,3),elem(ie)%FaceNum ) + sq1(3) = cart2cubedsphere( cvlist(ie)%vert(4,2,3),elem(ie)%FaceNum ) + sq1(4) = cart2cubedsphere( cvlist(ie)%vert(1,2,3),elem(ie)%FaceNum ) + + x2 = cart2cubedsphere( cvlist(ie)%vert(2,3,2),elem(ie)%FaceNum ) + s = .99_r8 + x3%x = x2%x + (x1%x-x2%x)*s + x3%y = x2%y + (x1%y-x2%y)*s + + sq2(1) = x3 + sq2(2) = cart2cubedsphere( cvlist(ie)%vert(1,3,2),elem(ie)%FaceNum ) + sq2(3) = cart2cubedsphere( cvlist(ie)%vert(2,3,2),elem(ie)%FaceNum ) + sq2(4) = cart2cubedsphere( cvlist(ie)%vert(3,3,2),elem(ie)%FaceNum ) + + pent(1) = cart2cubedsphere( cvlist(ie)%vert(4,2,2),elem(ie)%FaceNum ) + pent(2) = cart2cubedsphere( cvlist(ie)%vert(1,2,2),elem(ie)%FaceNum ) + pent(3) = cart2cubedsphere( cvlist(ie)%vert(2,2,2),elem(ie)%FaceNum ) + pent(4) = sq2(1) + pent(5) = sq1(1) + + call pentagon_iteration(sq1,sq2,pent,& + elem(ie)%spheremp(2,3)*a1(ie)/a2(ie), & + elem(ie)%spheremp(3,2)*a1(ie)/a2(ie), & + elem(ie)%spheremp(2,2)*a1(ie)/a2(ie),elem(ie)%FaceNum,a1(ie)) + + x2_3d=cubedsphere2cart(sq1(1),elem(ie)%FaceNum ) + x3_3d=cubedsphere2cart(sq2(1),elem(ie)%FaceNum ) + + cvlist(ie)%vert(2,2,3)=x2_3d + + cvlist(ie)%vert(4,3,2)=x3_3d + + cvlist(ie)%vert(5,2,2)=cvlist(ie)%vert(4,2,2) + cvlist(ie)%vert(3,2,2)=x3_3d + cvlist(ie)%vert(4,2,2)=x2_3d + + + cvlist(ie)%vert(1,3,3)=x3_3d + cvlist(ie)%vert(5,3,3)=x2_3d + + cvlist(ie)%nvert(3,3)=sign(5,cvlist(ie)%nvert(3,3)) + cvlist(ie)%nvert(2,2)=sign(5,cvlist(ie)%nvert(2,2)) + else + if (hybrid%masterthread) then + write(iulog, *) ie,'bad type' + call shr_sys_flush(iulog) + end if + call endrun('InitControlVolumes_gll: bad type') + end if + ! recompute areas: + do i=2,3 + do j=2,3 + nvert=abs(cvlist(ie)%nvert(i,j)) + temp3d(1:nvert)=cvlist(ie)%vert(1:nvert,i,j) + cvlist(ie)%vol(i,j)=surfarea(temp3d,nvert) + cvlist(ie)%totvol(i,j)=cvlist(ie)%vol(i,j) + end do + end do + else + !write(iulog, *) 'skipping pentagon procedure ie=',ie + !write(iulog, *) 'maxval diff: ',maxval(abs(diff(2:3,2:3)))/a1(ie) + nskip=nskip+1 + nskipie(ie) = nskipie(ie) + 1 + end if + global_shared_buf(ie,1) = nskipie(ie) + global_shared_buf(ie,2) = npentie(ie) + end do + call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) + nskip = global_shared_sum(1) + npent = global_shared_sum(2) + if (hybrid%masterthread) then + write(*,'(a,i7,a,i7)') "no. elements where pentagons were added: ",npent,"/",npent+nskip + end if + + ! compute output needed for SCRIP: lat/lon coordinates, and for the + ! control volume with only 3 corners, repeat the last point to make a + ! degenerate quad. + do ie=nets,nete + do j=1,np + do i=1,np + cvlist(ie)%vert_latlon(:,i,j)%lat = 0._r8 + cvlist(ie)%vert_latlon(:,i,j)%lon = 0._r8 + do k = 1, kmax + rvert = cvlist(ie)%vert(k,i,j)%x**2+cvlist(ie)%vert(k,i,j)%y**2+cvlist(ie)%vert(k,i,j)%z**2 + if(rvert > 0.9_r8) then + cvlist(ie)%vert_latlon(k,i,j) = change_coordinates(cvlist(ie)%vert(k,i,j)) + else + ! coordinates = 0, this corner was not set above because this point + ! only has 3 cells (corner point) pick either neighbor to make a degenerate quad + k2 = k - 1 + if (k2 == 0) then + k2 = 2 ! can only happen for corner point with data in 2,3,4 + end if + cvlist(ie)%vert_latlon(k,i,j) = change_coordinates(cvlist(ie)%vert(k2,i,j)) + cvlist(ie)%vert(k,i,j) = cvlist(ie)%vert(k2,i,j) + end if + end do + end do + end do + end do + ! Release memory + if(hybrid%masterthread) then + call freeedgebuffer(edge1) + end if + + initialized=.true. + end subroutine InitControlVolumes_gll + + subroutine construct_cv_gll(elem,hybrid,nets,nete) + ! + ! construct global dual grid from local element dual grid cvlist(ie)%cartp_dual(:,:) + ! all control volumes will be squares or triangles (at cube corners) + ! + ! 10/2009: added option to make hexagon control volumes at cube edges and corners + ! + use bndry_mod, only: bndry_exchange + use element_mod, only: element_t + use hybrid_mod, only: hybrid_t + use edge_mod, only: edgeVpack, edgeVunpack, edgeVunpackVert + + type(element_t), intent(in), target :: elem(:) + type(hybrid_t), intent(in) :: hybrid + integer, intent(in) :: nets,nete + ! local + integer :: i,j,k,ie,kptr,nvert,ie2 + logical :: corner + real(r8) :: test(np,np,1),vertpack(np,np,3),rvert + type(cartesian2d_t) :: vert(4) + type(cartesian2d_t) :: cartp_nm1(0:np,0:np) + + test(:,:,:) = 0 + + do ie=nets,nete + ! now construct the dual grid + + cartp_nm1 = cvlist(ie)%cartp_dual + + do j=1,np + do i=1,np + cvlist(ie)%vert(:,i,j)%x = 0_r8 + cvlist(ie)%vert(:,i,j)%y = 0_r8 + cvlist(ie)%vert(:,i,j)%z = 0_r8 + end do + end do + + ! interior + + do j=2,np-1 + do i=2,np-1 + + ! internal vertex on Cubed sphere + ! Here is the order: + ! + ! 4NW <- 3NE + ! | ^ + ! v | + ! 1SW -> 2SE + vert(1)%x = cartp_nm1(i-1,j-1)%x + vert(1)%y = cartp_nm1(i-1,j-1)%y + vert(2)%x = cartp_nm1(i ,j-1)%x + vert(2)%y = cartp_nm1(i ,j-1)%y + vert(3)%x = cartp_nm1(i ,j )%x + vert(3)%y = cartp_nm1(i ,j )%y + vert(4)%x = cartp_nm1(i-1,j )%x + vert(4)%y = cartp_nm1(i-1,j )%y + + do k=1,4 + cvlist(ie)%vert(k,i,j) = cubedsphere2cart(vert(k),elem(ie)%FaceNum) + end do + cvlist(ie)%nvert(i,j) = 4 + + end do + end do + + ! Compute everything on the edges and then sum + do i=2,np-1 + j=1 + ! + ! 4NW <- 3NE + ! | ^ + ! v | + ! 1SW -> 2SE + ! + ! + ! only pack top two nodes. + ! leave other data zero, filled in by edgeexchange + cvlist(ie)%vert(4,i,j)%x = cvlist(ie)%vert(1,i,j+1)%x + cvlist(ie)%vert(4,i,j)%y = cvlist(ie)%vert(1,i,j+1)%y + cvlist(ie)%vert(4,i,j)%z = cvlist(ie)%vert(1,i,j+1)%z + cvlist(ie)%vert(3,i,j)%x = cvlist(ie)%vert(2,i,j+1)%x + cvlist(ie)%vert(3,i,j)%y = cvlist(ie)%vert(2,i,j+1)%y + cvlist(ie)%vert(3,i,j)%z = cvlist(ie)%vert(2,i,j+1)%z + + + j=np + + cvlist(ie)%vert(1,i,j)%x = cvlist(ie)%vert(4,i,j-1)%x + cvlist(ie)%vert(1,i,j)%y = cvlist(ie)%vert(4,i,j-1)%y + cvlist(ie)%vert(1,i,j)%z = cvlist(ie)%vert(4,i,j-1)%z + cvlist(ie)%vert(2,i,j)%x = cvlist(ie)%vert(3,i,j-1)%x + cvlist(ie)%vert(2,i,j)%y = cvlist(ie)%vert(3,i,j-1)%y + cvlist(ie)%vert(2,i,j)%z = cvlist(ie)%vert(3,i,j-1)%z + + end do + + do j=2,np-1 + i=1 + + cvlist(ie)%vert(2,i,j)%x = cvlist(ie)%vert(1,i+1,j)%x + cvlist(ie)%vert(2,i,j)%y = cvlist(ie)%vert(1,i+1,j)%y + cvlist(ie)%vert(2,i,j)%z = cvlist(ie)%vert(1,i+1,j)%z + cvlist(ie)%vert(3,i,j)%x = cvlist(ie)%vert(4,i+1,j)%x + cvlist(ie)%vert(3,i,j)%y = cvlist(ie)%vert(4,i+1,j)%y + cvlist(ie)%vert(3,i,j)%z = cvlist(ie)%vert(4,i+1,j)%z + + i=np + + cvlist(ie)%vert(4,i,j)%x = cvlist(ie)%vert(3,i-1,j)%x + cvlist(ie)%vert(4,i,j)%y = cvlist(ie)%vert(3,i-1,j)%y + cvlist(ie)%vert(4,i,j)%z = cvlist(ie)%vert(3,i-1,j)%z + cvlist(ie)%vert(1,i,j)%x = cvlist(ie)%vert(2,i-1,j)%x + cvlist(ie)%vert(1,i,j)%y = cvlist(ie)%vert(2,i-1,j)%y + cvlist(ie)%vert(1,i,j)%z = cvlist(ie)%vert(2,i-1,j)%z + + end do + + ! Corners + ! SW + cvlist(ie)%vert(3,1,1)%x = cvlist(ie)%vert(1,2,2)%x + cvlist(ie)%vert(3,1,1)%y = cvlist(ie)%vert(1,2,2)%y + cvlist(ie)%vert(3,1,1)%z = cvlist(ie)%vert(1,2,2)%z + + ! SE + cvlist(ie)%vert(4,np,1)%x = cvlist(ie)%vert(2,np-1,2)%x + cvlist(ie)%vert(4,np,1)%y = cvlist(ie)%vert(2,np-1,2)%y + cvlist(ie)%vert(4,np,1)%z = cvlist(ie)%vert(2,np-1,2)%z + + ! NE + cvlist(ie)%vert(1,np,np)%x = cvlist(ie)%vert(3,np-1,np-1)%x + cvlist(ie)%vert(1,np,np)%y = cvlist(ie)%vert(3,np-1,np-1)%y + cvlist(ie)%vert(1,np,np)%z = cvlist(ie)%vert(3,np-1,np-1)%z + + ! NW + cvlist(ie)%vert(2,1,np)%x = cvlist(ie)%vert(4,2,np-1)%x + cvlist(ie)%vert(2,1,np)%y = cvlist(ie)%vert(4,2,np-1)%y + cvlist(ie)%vert(2,1,np)%z = cvlist(ie)%vert(4,2,np-1)%z + + kptr=0 + test(:,:,1) = cvlist(ie)%vol(:,:) + call edgeVpack(edge1,test(1,1,1),1,kptr,ie) + + cvlist(ie)%invvol(:,:) = cvlist(ie)%vol(:,:) + + end do ! loop over NE + + call bndry_exchange(hybrid,edge1) + + do ie=nets,nete + kptr=0 + call edgeVunpack(edge1, cvlist(ie)%invvol(1,1),1, kptr, ie) + cvlist(ie)%totvol(:,:)=cvlist(ie)%invvol(:,:) + cvlist(ie)%invvol(:,:)=1.0_r8/cvlist(ie)%invvol(:,:) + end do + + ! Create the polygon at the edges of the element + + + if(.NOT.(MODULO(np,2)==0)) then + call endrun("surfaces_mod: NV odd not implemented") + end if + vertpack = 0 + do ie=nets,nete + ! Special messed up copy + ! + !ASC should be replaced by a edgepack + ! S+N + do i=1,np/2 + j=1 + vertpack(i,j,1) = cvlist(ie)%vert(3,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(3,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(3,i,j)%z + j=np + vertpack(i,j,1) = cvlist(ie)%vert(2,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(2,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(2,i,j)%z + end do + + do i=np/2+1,np + j=1 + vertpack(i,j,1) = cvlist(ie)%vert(4,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(4,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(4,i,j)%z + j=np + vertpack(i,j,1) = cvlist(ie)%vert(1,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(1,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(1,i,j)%z + end do + + ! E+W + do j=2,np/2 + i=1 + vertpack(i,j,1) = cvlist(ie)%vert(3,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(3,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(3,i,j)%z + i=np + vertpack(i,j,1) = cvlist(ie)%vert(4,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(4,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(4,i,j)%z + end do + + do j=np/2+1,np-1 + i=1 + vertpack(i,j,1) = cvlist(ie)%vert(2,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(2,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(2,i,j)%z + i=np + vertpack(i,j,1) = cvlist(ie)%vert(1,i,j)%x + vertpack(i,j,2) = cvlist(ie)%vert(1,i,j)%y + vertpack(i,j,3) = cvlist(ie)%vert(1,i,j)%z + end do + + do j=2,np-1 + do i=2,np-1 + vertpack(i,j,1) =0_r8 + vertpack(i,j,2) =0_r8 + vertpack(i,j,3) =0_r8 + end do + end do + + kptr=0 + call edgeVpack(edge1,vertpack,3,kptr,ie) + end do + + call bndry_exchange(hybrid,edge1) + + do ie=nets,nete + kptr=0 + call edgeVunpackVert(edge1, cvlist(ie)%vert,ie) + ! Count and orient vert array + ! nvert is an integer: -4,-3,3,4 + ! Positive: 1->2->3->4 is counter clockwise on the sphere + ! Negative: clockwise orientation + do j=1,np + do i=1,np + nvert=0 + do k=1,4 + rvert = cvlist(ie)%vert(k,i,j)%x**2+cvlist(ie)%vert(k,i,j)%y**2+cvlist(ie)%vert(k,i,j)%z**2 + if(rvert>0.9_r8)nvert=nvert+1 + end do + if(.NOT.Orientation(cvlist(ie)%vert(:,i,j),elem(ie)%FaceNum))nvert=-nvert + cvlist(ie)%nvert(i,j) = nvert + corner = ( ((i==1) .and. (j==1)) .or. & + ((i==1) .and. (j==np)) .or. & + ((i==np) .and. (j==1)) .or. & + ((i==np) .and. (j==np)) ) + if (abs(nvert)/=4) then + if (abs(nvert)/=3) then + write(iulog, *) 'i,j,nvert=',i,j,nvert + call shr_sys_flush(iulog) + call endrun('construct_cv_gll: bad value of nvert') + end if + if (.not. corner) then + write(iulog, *) 'non-corner node with only 3 verticies' + write(iulog, *) 'ie,i,j,nvert,corner=',ie,i,j,nvert,corner + write(iulog, *) cvlist(ie)%vert(1,i,j)%x + write(iulog, *) cvlist(ie)%vert(2,i,j)%x + write(iulog, *) cvlist(ie)%vert(3,i,j)%x + write(iulog, *) cvlist(ie)%vert(4,i,j)%x + !write(iulog, *) 'dual:' + !do ie2=nets,nete + ! write(iulog, *) ie2,maxval(cvlist(ie2)%cartp_dual(:,:)%x) + ! write(iulog, *) ie2,maxval(cvlist(ie2)%cartp_dual(:,:)%y) + !end do + call shr_sys_flush(iulog) + call endrun('construct_cv_gll: corner point should have nvert=3') + end if + ! nvert=3. we are at a cube corner. One of the control volume + ! nodes from the 'missing' corner element should be all zeros: + if (cvlist(ie)%vert(1,i,j)%x==0) then + ! ok + else if (cvlist(ie)%vert(2,i,j)%x==0) then + ! ok + else if (cvlist(ie)%vert(3,i,j)%x==0) then + ! ok + else if (cvlist(ie)%vert(4,i,j)%x==0) then + ! ok + else + write(iulog, *) 'cube corner node with 4 neighbors' + write(iulog, *) 'ie,i,j,nvert,corner=',ie,i,j,nvert,corner + write(iulog, *) cvlist(ie)%vert(1,i,j)%x + write(iulog, *) cvlist(ie)%vert(2,i,j)%x + write(iulog, *) cvlist(ie)%vert(3,i,j)%x + write(iulog, *) cvlist(ie)%vert(4,i,j)%x + call shr_sys_flush(iulog) + call endrun('construct_cv_gll: control volume at cube corner should be a triangle') + end if + + end if + end do + end do + end do + end subroutine construct_cv_gll + + logical function Orientation(v, FaceNum) result(orient) + + type(cartesian3d_t), intent(in) :: v(3) + integer, intent(in) :: FaceNum + + type(cartesian3D_t) :: v12, v23 + real(r8) :: test, cart(3,3) + + orient = .FALSE. + + if ((FaceNum == 5).OR.(FaceNum == 6)) then + + cart(1,1) = v(1)%x + cart(2,1) = v(1)%y + cart(3,1) = v(1)%z + + cart(1,2) = v(2)%x + cart(2,2) = v(2)%y + cart(3,2) = v(2)%z + + cart(1,3) = v(3)%x + cart(2,3) = v(3)%y + cart(3,3) = v(3)%z + + v12%x = cart(1,2) - cart(1,1) + v12%y = cart(2,2) - cart(2,1) + v12%z = cart(3,2) - cart(3,1) + + v23%x = cart(1,3) - cart(1,2) + v23%y = cart(2,3) - cart(2,2) + v23%z = cart(3,3) - cart(3,2) + + test = (v12%y*v23%z - v12%z*v23%y)*v12%x & + - (v12%x*v23%z - v12%z*v23%x)*v12%y & + + (v12%x*v23%y - v12%y*v23%x)*v12%z + + if (test > 0_r8)then + orient=.TRUE. + end if + + else + orient=.TRUE. + end if + + end function Orientation + + subroutine VerifVolumes(elem, hybrid,nets,nete) + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + + type(element_t), intent(in) :: elem(:) + integer, intent(in) :: nets,nete + type(hybrid_t), intent(in) :: hybrid + + real(r8) :: psum,ptot,Vol_tmp(1),corr,maxelem_variation + real(r8) :: vol(np,np,nets:nete),r,rmin,rmax,a1,a2,locmin,locmax,emin,emax,dx,dy + integer :: i,j,ie,kptr,face + + real(r8), pointer :: locvol(:,:) + + dx = pi/(2.0d0*dble(ne)) + dy = dx + + if(.not. initialized) then + call endrun('VerifyVolumes: Attempt to use volumes prior to initializing') + end if + rmin=2 + rmax=0 + maxelem_variation=0 + do ie=nets,nete + locvol => GetVolume(ie) + locmin = minval(locvol(:,:)*elem(ie)%rspheremp(:,:)) + locmax = maxval(locvol(:,:)*elem(ie)%rspheremp(:,:)) + rmin = min(rmin,locmin) + rmax = max(rmax,locmax) + + if (locmax > 1.01_r8) then + write(iulog, *) 'locmin(:,i)=',ie,locvol(1,1),1/elem(ie)%rspheremp(1,1) + end if + + + if (locmax-locmin > maxelem_variation) then + maxelem_variation = locmax-locmin + emin=locmin + emax=locmax + end if + end do + rmin = ParallelMin(rmin,hybrid) + rmax = ParallelMax(rmax,hybrid) + if(hybrid%masterthread) then + write(iulog,'(a,2e14.7)') "Min/max ratio between spherical and GLL area:",rmin,rmax + end if + if (maxelem_variation == ParallelMax(maxelem_variation,hybrid) ) then + write(iulog,'(a,2e14.7)') "Min/max ratio element with largest variation:",emin,emax + end if + call shr_sys_flush(iulog) + + rmin=2 + rmax=0 + do ie=nets,nete + a1 = SurfArea_dxdy(dx,dy,elem(ie)%cartp(1,1)) + a2 = sum(elem(ie)%spheremp(:,:)) + r=a1/a2 + rmin = min(r,rmin) + rmax = max(r,rmax) + end do + rmin = ParallelMin(rmin,hybrid) + rmax = ParallelMax(rmax,hybrid) + if(hybrid%masterthread) then + write(*,'(a,2f12.9)') "Min/max ratio spherical and GLL element area:",rmin,rmax + end if + + do ie=nets,nete + global_shared_buf(ie,1:6) = 0.d0 + face = elem(ie)%FaceNum + locvol => GetVolumeLocal(ie) + do j=1,np + do i=1,np + global_shared_buf(ie,face) = global_shared_buf(ie,face) + locvol(i,j) + end do + end do + end do + call wrap_repro_sum(nvars=6, comm=hybrid%par%comm) + + ptot=0_r8 + do face=1,6 + red_sum%buf(1) = global_shared_sum(face) + psum = red_sum%buf(1) + + ptot = ptot + psum + + if(hybrid%masterthread) then + write(*,'(a,i2,a,2e23.15)') "cube face:",face," : SURFACE FV =",& + 6_r8*psum/(4_r8 * pi), & + 6_r8*psum/(4_r8 * pi)-1 + end if + end do + + if(hybrid%masterthread) then + write(iulog, *) "SURFACE FV (total)= ", ptot/(4_r8 * pi) + end if + + end subroutine VerifVolumes + +end module comp_gll_ctr_vol diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 new file mode 100644 index 0000000000..c3e5df2ecf --- /dev/null +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -0,0 +1,123 @@ +! This module contains constants and namelist variables used through out the model +! to avoid circular dependancies please do not 'use' any further modules here. +! +module control_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + + integer, public, parameter :: MAX_STRING_LEN=240 + integer, public, parameter :: MAX_FILE_LEN=240 +! character(len=MAX_STRING_LEN) , public :: integration ! time integration (only one currently supported is "explicit") + + ! Tracer transport type + integer, public, parameter :: TRACERTRANSPORT_SE_GLL = 1 + integer, public, parameter :: TRACERTRANSPORT_CONSISTENT_SE_FVM = 2 + integer, public :: tracer_transport_type = TRACERTRANSPORT_SE_GLL + +!shallow water advection tests: +!kmass points to a level with density. other levels contain test tracers + + integer, public :: tstep_type= 0 ! 0 = leapfrog + ! 1 = RK (foward-in-time) + integer, public :: rk_stage_user = 0 ! number of RK stages to use + integer, public :: ftype = 0 ! Forcing Type + integer, public :: statediag_numtrac = 3 + + integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps + integer, public :: rsplit = 3 ! for vertically lagrangian dynamics, apply remap + ! every rsplit tracer timesteps + + logical, public :: refined_mesh + +! vert_remap_q_alg: 0 default value, Zerroukat monotonic splines +! 1 PPM vertical remap with mirroring at the boundaries +! (solid wall bc's, high-order throughout) +! 2 PPM vertical remap without mirroring at the boundaries +! (no bc's enforced, first-order at two cells bordering top and bottom boundaries) + integer, public :: vert_remap_q_alg = 0 + + + integer, public :: cubed_sphere_map = -1 ! -1 = chosen at run time + ! 0 = equi-angle Gnomonic (default) + ! 1 = equi-spaced Gnomonic (not yet coded) + ! 2 = element-local projection (for var-res) + ! 3 = parametric (not yet coded) + +!tolerance to define smth small, was introduced for lim 8 in 2d and 3d + real (kind=r8), public, parameter :: tol_limiter=1.0e-13_r8 + + integer , public :: limiter_option = 0 + + integer , public :: partmethod ! partition methods + character(len=MAX_STRING_LEN) , public :: topology ! options: "cube" is supported + integer , public :: tasknum + integer , public :: remapfreq ! remap frequency of synopsis of system state (steps) + character(len=MAX_STRING_LEN) :: remap_type ! selected remapping option + integer , public :: statefreq ! output frequency of synopsis of system state (steps) + integer , public :: runtype + integer , public :: timerdetail + integer , public :: numnodes + integer , public :: multilevel + + character(len=MAX_STRING_LEN) , public :: columnpackage + + integer , public :: maxits ! max iterations of solver + real (kind=r8), public :: tol ! solver tolerance (convergence criteria) + + integer , public :: fine_ne = -1 ! set for refined exodus meshes (variable viscosity) + real (kind=r8), public :: max_hypervis_courant = 1d99 ! upper bound for Courant number + ! (only used for variable viscosity, recommend 1.9 in namelist) + real (kind=r8), public :: nu = 7.0D5 ! viscosity (momentum equ) + real (kind=r8), public :: nu_div = -1 ! viscsoity (momentum equ, div component) + real (kind=r8), public :: nu_s = -1 ! default = nu T equ. viscosity + real (kind=r8), public :: nu_q = -1 ! default = nu tracer viscosity + real (kind=r8), public :: nu_p = 0.0D5 ! default = 0 ps equ. viscosity + real (kind=r8), public :: nu_top = 0.0D5 ! top-of-the-model viscosity + integer, public :: hypervis_subcycle=1 ! number of subcycles for hyper viscsosity timestep + integer, public :: hypervis_subcycle_q=1 ! number of subcycles for hyper viscsosity timestep on TRACERS + integer, public :: psurf_vis = 0 ! 0 = use laplace on eta surfaces + ! 1 = use (approx.) laplace on p surfaces + + real (kind=r8), public :: hypervis_power=0 ! if not 0, use variable hyperviscosity based on element area + real (kind=r8), public :: hypervis_scaling=0 ! use tensor hyperviscosity + +! +!three types of hyper viscosity are supported right now: +! (1) const hv: nu * del^2 del^2 +! (2) scalar hv: nu(lat,lon) * del^2 del^2 +! (3) tensor hv, nu * ( \div * tensor * \grad ) * del^2 +! +! (1) default: hypervis_power=0, hypervis_scaling=0 +! (2) Original version for var-res grids. (M. Levy) +! scalar coefficient within each element +! hypervisc_scaling=0 +! set hypervis_power>0 and set fine_ne, max_hypervis_courant +! (3) tensor HV var-res grids +! tensor within each element: +! set hypervis_scaling > 0 (typical values would be 3.2 or 4.0) +! hypervis_power=0 +! (\div * tensor * \grad) operator uses cartesian laplace +! + + integer, public :: prescribed_wind=0 ! fix the velocities? + logical, public :: se_prescribed_wind_2d=.false. + real (kind=r8), public :: se_met_nudge_u = 0.D0 ! velocity nudging rate (1/sec) + real (kind=r8), public :: se_met_nudge_p = 0.D0 ! pressure nudging rate (1/sec) + real (kind=r8), public :: se_met_nudge_t = 0.D0 ! temperature nudging rate (1/sec) + integer, public :: se_met_tevolve = 0 ! switch to turn on time evolution of nudging within dynamics + integer, public :: prescribed_vertwind = 0 + + real (kind=r8), public :: initial_global_ave_dry_ps = 0 ! scale dry surface pressure to initial_global_ave_dry_ps + + integer, public, parameter :: west = 1 + integer, public, parameter :: east = 2 + integer, public, parameter :: south = 3 + integer, public, parameter :: north = 4 + + integer, public, parameter :: swest = 5 + integer, public, parameter :: seast = 6 + integer, public, parameter :: nwest = 7 + integer, public, parameter :: neast = 8 + + logical, public :: disable_diagnostics = .FALSE. + +end module control_mod diff --git a/src/dynamics/se/dycore/coordinate_systems_mod.F90 b/src/dynamics/se/dycore/coordinate_systems_mod.F90 new file mode 100644 index 0000000000..b5a845acb9 --- /dev/null +++ b/src/dynamics/se/dycore/coordinate_systems_mod.F90 @@ -0,0 +1,919 @@ +module coordinate_systems_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use physconst, only: pi + use cam_abortutils, only: endrun + +! WARNING: When using this class be sure that you know if the +! cubic coordinates are on the unit cube or the [-\pi/4,\pi/4] cube +! and if the spherical longitude is in [0,2\pi] or [-\pi,\pi] + implicit none + private + + real(kind=r8), public, parameter :: DIST_THRESHOLD= 1.0e-9_r8 + real(kind=r8), parameter :: one=1.0_r8 + real(kind=r8), parameter :: two=2.0_r8 + + type, public :: cartesian2D_t + real(r8) :: x ! x coordinate + real(r8) :: y ! y coordinate + end type cartesian2D_t + + type, public :: cartesian3D_t + real(r8) :: x ! x coordinate + real(r8) :: y ! y coordinate + real(r8) :: z ! z coordinate + end type cartesian3D_t + + type, public :: spherical_polar_t + real(r8) :: r ! radius + real(r8) :: lon ! longitude + real(r8) :: lat ! latitude + end type spherical_polar_t + + + interface assignment ( = ) + module procedure copy_cart2d + module procedure copy_spherical_polar + end interface + + interface operator( == ) + module procedure eq_cart2d + end interface + + interface distance + module procedure distance_cart2D + module procedure distance_cart2D_v + module procedure distance_cart3D + module procedure distance_cart3D_v + end interface + + interface change_coordinates + module procedure spherical_to_cart_v + module procedure spherical_to_cart + module procedure cart_to_spherical_v + module procedure cart_to_spherical + module procedure aray_to_spherical + end interface + + + ! ========================================== + ! Public Interfaces + ! ========================================== + + public :: sphere_tri_area + public :: surfareaxy + public :: distance + public :: change_coordinates + public :: cart2cubedsphere ! (x,y,z) -> equal-angle (x,y) + public :: cart2cubedsphere_failsafe + public :: spherical_to_cart ! (lat,lon) -> (x,y,z) + public :: projectpoint ! equal-angle (x,y) -> (lat,lon) + ! should be called cubedsphere2spherical + public :: cubedsphere2cart ! equal-angle (x,y) -> (x,y,z) + public :: sphere2cubedsphere ! (lat,lon) -> equal-angle (x,y) + public :: cube_face_number_from_cart + public :: cube_face_number_from_sphere + +! CE + public :: cart2cubedspherexy ! (x,y,z) -> gnomonic (x,y) + public :: cart2spherical ! gnominic (x,y) -> (lat,lon) + + private :: copy_cart2d + private :: copy_spherical_polar + private :: eq_cart2d + private :: distance_cart2D + private :: distance_cart2D_v + private :: distance_cart3D + private :: distance_cart3D_v + private :: spherical_to_cart_v + !private :: spherical_to_cart + private :: cart_to_spherical_v + private :: cart_to_spherical + private :: aray_to_spherical + +contains + + ! ============================================ + ! copy_cart2d: + ! + ! Overload assignment operator for cartesian2D_t + ! ============================================ + + subroutine copy_cart2d(cart2,cart1) + + type(cartesian2D_t), intent(out) :: cart2 + type(cartesian2D_t), intent(in) :: cart1 + cart2%x=cart1%x + cart2%y=cart1%y + end subroutine copy_cart2d + + ! ============================================ + ! copy_spherical_polar: + ! + ! Overload assignment operator for spherical_polar_t + ! ============================================ + + pure subroutine copy_spherical_polar(sph2, sph1) + + type(spherical_polar_t), intent(out) :: sph2 + type(spherical_polar_t), intent(in) :: sph1 + sph2%r = sph1%r + sph2%lat = sph1%lat + sph2%lon = sph1%lon + end subroutine copy_spherical_polar + + ! ============================================ + ! eq_cart2d: + ! + ! Overload == operator for cartesian2D_t + ! ============================================ + + pure function eq_cart2d(cart2,cart1) result(is_same) + + type(cartesian2D_t), intent(in) :: cart2 + type(cartesian2D_t), intent(in) :: cart1 + + logical :: is_same + + if (distance(cart1,cart2)= DIST_THRESHOLD) then + + if ( abs(abs(sphere%lat)-PI/2) >= DIST_THRESHOLD ) then + sphere%lon=ATAN2(cart%y,cart%x) + if (sphere%lon<0) then + sphere%lon=sphere%lon + 2*PI + end if + end if + + end function cart_to_spherical + + pure function aray_to_spherical(coordinates) result (sphere) + implicit none + real(kind=r8), intent(in) :: coordinates(3) + type(spherical_polar_t) :: sphere + type(cartesian3D_t) :: cart + cart%x = coordinates(1) + cart%y = coordinates(2) + cart%z = coordinates(3) + sphere = cart_to_spherical(cart) + end function aray_to_spherical + + + pure function cart_to_spherical_v(cart) result (sphere) + + type(cartesian3D_t), intent(in) :: cart(:) + type(spherical_polar_t) :: sphere(SIZE(cart)) + + integer :: i + forall (i=1:SIZE(cart)) sphere(i) = cart_to_spherical(cart(i)) + end function cart_to_spherical_v + + + + + function unit_face_based_cube_to_unit_sphere(cart, face_no) result(sphere) + +! Note: Output spherical longitude is [-pi,pi] + +! Project from a UNIT cube to a UNIT sphere. ie, the lenght of the cube edge is 2. +! Face 1 of the cube touches the sphere at longitude, latitude (0,0). The negative +! x axis is negative longitude (ie. going west is negative), the positive x axis +! is increasing longitude. Face 1 maps the Face 1 to the lat,lon on the sphere: +! [-1,1] x [-1,1] => [-\pi/4,\pi/4] x [-\pi/4, \pi/4] + +! Face 2 continues with increasing longitude (ie to the east of Face 1). +! The left edge of Face 2 (negative x) is the right edge of Face 1 (positive x) +! The latitude is the same as Face 1, but the longitude increases: +! [-1,1] x [-1,1] => [\pi/4, 3\pi/4] x [-\pi/4, \pi/4] + +! Face 3 continues with increasing longitude (ie to the east of Face 2). +! Face 3 is like Face 1, but the x coordinates are reversed, ie. decreasing x +! is increasing longitude: +! [-1,1] x [-1,1] = [-1,0] x [-1,1] U [0,1] x [-1,1] => +! [3\pi/4,\pi] x [-\pi, -3\pi/4] + +! Face 4 finally connects Face 3 to Face 1. Like Face 2, but wtih opposite x +! [-1,1] x [-1,1] => [-3\pi/4, -\pi/4] x [-\pi/4, \pi/4] + +! Face 5 is along the bottom edges of Faces 1,2,3,and 4 so the latitude goes from +! -\pi/4 to -\pi/2. The tricky part is lining up the longitude. The zero longitude +! must line up with the center of Face 1. ATAN2(x,1) = 0 => x = 0. +! So the (0,1) point on Face 5 is the zero longitude on the sphere. The top edge of +! Face 5 is the bottom edge of Face 1. +! ATAN(x,0) = \pi/2 => x = 1, so the right edge of Face 5 is the bottom of Face 2. +! Continueing, the bottom edge of 5 is the bottom of 3. Left of 5 is bottom of 4. + +! Face 6 is along the top edges of Faces 1,2,3 and 4 so the latitude goes from +! \pi/4 to \pi/2. The zero longitude must line up with the center of Face 1. +! This is just like Face 5, but the y axis is reversed. So the bottom edge of Face 6 +! is the top edge of Face 1. The right edge of Face 6 is the top of Face 2. The +! top of 6 the top of 3 and the left of 6 the top of 4. + + type (cartesian2d_t), intent(in) :: cart ! On face_no of a unit cube + integer, intent(in) :: face_no + + type (spherical_polar_t) :: sphere + + integer i,j + real(kind=r8) :: r!, l_inf + +! MNL: removing check that points are on the unit cube because we allow +! spherical grids to map beyond the extent of the cube (though we probably +! should still have an upper bound for how far past the edge the element lies) +! l_inf = MAX(ABS(cart%x), ABS(cart%y)) +! if (1.01 < l_inf) then +! call endrun('unit_face_based_cube_to_unit_sphere: Input not on unit cube.') +! end if + + sphere%r=one + r = SQRT( one + (cart%x)**2 + (cart%y)**2) + select case (face_no) + case (1) + sphere%lat=ASIN((cart%y)/r) + sphere%lon=ATAN2(cart%x,one) + case (2) + sphere%lat=ASIN((cart%y)/r) + sphere%lon=ATAN2(one,-cart%x) + case (3) + sphere%lat=ASIN((cart%y)/r) + sphere%lon=ATAN2(-cart%x,-one) + case (4) + sphere%lat=ASIN((cart%y)/r) + sphere%lon=ATAN2(-one,cart%x) + case (5) + if (ABS(cart%y) > DIST_THRESHOLD .or. ABS(cart%x) > DIST_THRESHOLD ) then + sphere%lon=ATAN2(cart%x, cart%y ) + else + sphere%lon= 0.0_r8 ! longitude is meaningless at south pole set to 0.0 + end if + sphere%lat=ASIN(-one/r) + case (6) + if (ABS(cart%y) > DIST_THRESHOLD .or. ABS(cart%x) > DIST_THRESHOLD ) then + sphere%lon = ATAN2(cart%x, -cart%y) + else + sphere%lon= 0.0_r8 ! longitude is meaningless at north pole set to 0.0 + end if + sphere%lat=ASIN(one/r) + case default + call endrun('unit_face_based_cube_to_unit_sphere: Face number not 1 to 6.') + end select + + if (sphere%lon < 0.0_r8) then + sphere%lon=sphere%lon + two*PI + end if + + end function unit_face_based_cube_to_unit_sphere + + function cart2spherical(x,y, face_no) result(sphere) +! IMPORTANT: INPUT ARE the REAL cartesian from the cube sphere +! Note: Output spherical longitude is [-pi,pi] + +! Project from a UNIT cube to a UNIT sphere. ie, the lenght of the cube edge is 2. +! Face 1 of the cube touches the sphere at longitude, latitude (0,0). The negative +! x axis is negative longitude (ie. going west is negative), the positive x axis +! is increasing longitude. Face 1 maps the Face 1 to the lat,lon on the sphere: +! [-1,1] x [-1,1] => [-\pi/4,\pi/4] x [-\pi/4, \pi/4] + +! Face 2 continues with increasing longitude (ie to the east of Face 1). +! The left edge of Face 2 (negative x) is the right edge of Face 1 (positive x) +! The latitude is the same as Face 1, but the longitude increases: +! [-1,1] x [-1,1] => [\pi/4, 3\pi/4] x [-\pi/4, \pi/4] + +! Face 3 continues with increasing longitude (ie to the east of Face 2). +! Face 3 is like Face 1, but the x coordinates are reversed, ie. decreasing x +! is increasing longitude: +! [-1,1] x [-1,1] = [-1,0] x [-1,1] U [0,1] x [-1,1] => +! [3\pi/4,\pi] x [-\pi, -3\pi/4] + +! Face 4 finally connects Face 3 to Face 1. Like Face 2, but wtih opposite x +! [-1,1] x [-1,1] => [-3\pi/4, -\pi/4] x [-\pi/4, \pi/4] + +! Face 5 is along the bottom edges of Faces 1,2,3,and 4 so the latitude goes from +! -\pi/4 to -\pi/2. The tricky part is lining up the longitude. The zero longitude +! must line up with the center of Face 1. ATAN2(x,1) = 0 => x = 0. +! So the (0,1) point on Face 5 is the zero longitude on the sphere. The top edge of +! Face 5 is the bottom edge of Face 1. +! ATAN(x,0) = \pi/2 => x = 1, so the right edge of Face 5 is the bottom of Face 2. +! Continueing, the bottom edge of 5 is the bottom of 3. Left of 5 is bottom of 4. + +! Face 6 is along the top edges of Faces 1,2,3 and 4 so the latitude goes from +! \pi/4 to \pi/2. The zero longitude must line up with the center of Face 1. +! This is just like Face 5, but the y axis is reversed. So the bottom edge of Face 6 +! is the top edge of Face 1. The right edge of Face 6 is the top of Face 2. The +! top of 6 the top of 3 and the left of 6 the top of 4. + + implicit none + real(kind=r8), intent(in) :: x,y ! On face_no of a unit cube + integer, intent(in) :: face_no + + type (spherical_polar_t) :: sphere + + integer i,j + real(kind=r8) :: r!, l_inf + +! MNL: removing check that points are on the unit cube because we allow +! spherical grids to map beyond the extent of the cube (though we probably +! should still have an upper bound for how far past the edge the element lies) +! l_inf = MAX(ABS(cart%x), ABS(cart%y)) +! if (1.01 < l_inf) then +! call endrun('unit_face_based_cube_to_unit_sphere: Input not on unit cube.') +! end if + + sphere%r=one + r = SQRT( one + x**2 + y**2) + select case (face_no) + case (1) + sphere%lat=ASIN(y/r) + sphere%lon=ATAN2(x,one) + case (2) + sphere%lat=ASIN(y/r) + sphere%lon=ATAN2(one,-x) + case (3) + sphere%lat=ASIN(y/r) + sphere%lon=ATAN2(-x,-one) + case (4) + sphere%lat=ASIN(y/r) + sphere%lon=ATAN2(-one,x) + case (5) + if (ABS(y) > DIST_THRESHOLD .or. ABS(x) > DIST_THRESHOLD ) then + sphere%lon=ATAN2(x, y ) + else + sphere%lon= 0.0_r8 ! longitude is meaningless at south pole set to 0.0 + end if + sphere%lat=ASIN(-one/r) + case (6) + if (ABS(y) > DIST_THRESHOLD .or. ABS(x) > DIST_THRESHOLD ) then + sphere%lon = ATAN2(x, -y) + else + sphere%lon= 0.0_r8 ! longitude is meaningless at north pole set to 0.0 + end if + sphere%lat=ASIN(one/r) + case default + call endrun('unit_face_based_cube_to_unit_sphere: Face number not 1 to 6.') + end select + + if (sphere%lon < 0.0_r8) then + sphere%lon=sphere%lon + two*PI + end if + + end function cart2spherical + + + + + + + + +! Note: Output spherical longitude is [-pi,pi] + function projectpoint(cartin, face_no) result(sphere) + +! Projection from a [-pi/4, \pi/4] sized cube. +! This will be checked because unit_face_based_cube_to_unit_sphere checks the ranges. +! See unit_face_based_cube_to_unit_sphere for documentation. + + implicit none + type (cartesian2d_t), intent(in) :: cartin + integer, intent(in) :: face_no + type (spherical_polar_t) :: sphere + type (cartesian2d_t) :: cart + + !ASC This is X and Y and not xhi eta ... + + cart%x = TAN(cartin%x) + cart%y = TAN(cartin%y) + + sphere = unit_face_based_cube_to_unit_sphere(cart, face_no) + + end function projectpoint + + ! takes a 2D point on a face of the cube of size [-\pi/4, \pi/4] and projects it + ! onto a 3D point on a cube of size [-1,1] in R^3 + function cubedsphere2cart(cartin, face_no) result(cart) + implicit none + type (cartesian2d_t), intent(in) :: cartin ! assumed to be cartesian coordinates of cube + integer, intent(in) :: face_no + + type(cartesian3D_t) :: cart + + cart = spherical_to_cart(projectpoint(cartin, face_no)) + + end function cubedsphere2cart + + + ! onto a cube of size [-\pi/2,\pi/2] in R^3 + ! the spherical longitude can be either in [0,2\pi] or [-\pi,\pi] + pure function sphere2cubedsphere (sphere, face_no) result(cart) + implicit none + type(spherical_polar_t), intent(in) :: sphere + integer, intent(in) :: face_no + + type(cartesian2d_t) :: cart + real(kind=r8) :: xp,yp + real(kind=r8) :: lat,lon + real(kind=r8) :: twopi, pi2, pi3, pi4 + + lat = sphere%lat + lon = sphere%lon + + twopi = 2.0_r8 * pi + pi2 = pi * 0.5_r8 + pi3 = pi * 1.5_r8 + pi4 = pi * 0.25_r8 + + select case (face_no) + case (1) + xp = lon + if (pi < lon) xp = lon - twopi !if lon in [0,2\pi] + yp = atan(tan(lat)/cos(xp)) + case (2) + xp = lon - pi2 + yp = atan(tan(lat)/cos(xp)) + case (3) + xp = lon - pi + if (lon < 0) xp = lon + pi !if lon in [0,2\pi] + yp = atan(tan(lat)/cos(xp)) + case (4) + xp = lon - pi3 + if (lon < 0) xp = lon + pi2 !if lon in [0,2\pi] + yp = atan(tan(lat)/cos(xp)) + case (5) + xp = atan(-sin(lon)/tan(lat)) + yp = atan(-cos(lon)/tan(lat)) + case (6) + xp = atan( sin(lon)/tan(lat)) + yp = atan(-cos(lon)/tan(lat)) + end select + + ! coordinates on the cube: + cart%x = xp + cart%y = yp + + end function sphere2cubedsphere + +! Go from an arbitrary sized cube in 3D +! to a [-\pi/4,\pi/4] sized cube with (face,2d) coordinates. +! +! Z +! | +! | +! | +! | +! ---------------Y +! / +! / +! / +! / +! X +! +! NOTE: Face 1 => X positive constant face of cube +! Face 2 => Y positive constant face of cube +! Face 3 => X negative constant face of cube +! Face 4 => Y negative constant face of cube +! Face 5 => Z negative constant face of cube +! Face 6 => Z positive constant face of cube + pure function cart2cubedsphere(cart3D, face_no) result(cart) + + implicit none + type(cartesian3D_t),intent(in) :: cart3d + integer, intent(in) :: face_no + type (cartesian2d_t) :: cart + + real(kind=r8) :: x,y + + select case (face_no) + case (1) + x = cart3D%y/cart3D%x + y = cart3D%z/cart3D%x + case (2) + x = -cart3D%x/cart3D%y + y = cart3D%z/cart3D%y + case (3) + x = cart3D%y/cart3D%x + y = -cart3D%z/cart3D%x + case (4) + x = -cart3D%x/cart3D%y + y = -cart3D%z/cart3D%y + case (5) + x = -cart3D%y/cart3D%z + y = -cart3D%x/cart3D%z + case (6) + x = cart3D%y/cart3D%z + y = -cart3D%x/cart3D%z + end select + cart%x = ATAN(x) + cart%y = ATAN(y) + end function cart2cubedsphere + + function cart2cubedsphere_failsafe(cart3D, face_no) result(cart) + implicit none + type(cartesian3D_t),intent(in) :: cart3d + integer, intent(in) :: face_no + type (cartesian2d_t) :: cart + + real(kind=r8) :: x,y + + select case (face_no) + case (1) + if (abs(cart3D%x) < 1.E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = cart3D%y/cart3D%x + y = cart3D%z/cart3D%x + case (2) + if (abs(cart3D%y)<1.0E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = -cart3D%x/cart3D%y + y = cart3D%z/cart3D%y + case (3) + if (abs(cart3D%x)<1.0E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = cart3D%y/cart3D%x + y = -cart3D%z/cart3D%x + case (4) + if (abs(cart3D%y)<1.0E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = -cart3D%x/cart3D%y + y = -cart3D%z/cart3D%y + case (5) + if (abs(cart3D%z)<1.0E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = -cart3D%y/cart3D%z + y = -cart3D%x/cart3D%z + case (6) + if (abs(cart3D%z)<1.0E-13_r8) then + cart%x=9.0E9_r8 + cart%y=9.0E9_r8 + return + end if + x = cart3D%y/cart3D%z + y = -cart3D%x/cart3D%z + case default + write(*,*) "face_no out out range ",face_no + end select + cart%x = ATAN(x) + cart%y = ATAN(y) + end function cart2cubedsphere_failsafe + + + +! This function divides three dimentional space up into +! six sectors. These sectors are then considered as the +! faces of the cube. It should work for any (x,y,z) coordinate +! if on a sphere or on a cube. + pure function cube_face_number_from_cart(cart) result(face_no) + + implicit none + type(cartesian3D_t),intent(in) :: cart + integer :: face_no + + real(r8) :: x,y,z + x=cart%x + y=cart%y + z=cart%z + +! Divide the X-Y plane into for quadrants of +! [-\pi/2,\pi/2], [\pi/2,3\pi/2], ..... +! based on the lines X=Y and X=-Y. This divides +! 3D space up into four sections. Doing the same +! for the XZ and YZ planes divides space into six +! sections. Can also be thought of as conic sections +! in the L_infinity norm. + + if (y-x) then ! x>0, Face 1,5 or 6 + if (z>x) then + face_no=6 ! north pole + else if (z<-x) then + face_no=5 ! south pole + else + face_no = 1 + endif + else if (y>x .and. y<-x) then ! x<0 + if (z>-x) then + face_no=6 ! north pole + else if (zx .and. y>-x) then ! y>0 + if (z>y) then + face_no=6 ! north pole + else if (z<-y) then + face_no = 5 ! south pole + else + face_no=2 + endif + else if (y-y) then + face_no=6 ! north pole + else if (z pi/4,pi/4 + ! this formula gives 2 so normalize by 4pi/6 / 2 = pi/3 + ! use implementation where the nodes a counterclockwise (not as in the paper) + a1 = acos(-sin(atan(x1))*sin(atan(y1))) + a2 =-acos(-sin(atan(x2))*sin(atan(y1))) + a3 = acos(-sin(atan(x2))*sin(atan(y2))) + a4 =-acos(-sin(atan(x1))*sin(atan(y2))) + area = (a1+a2+a3+a4) + return +end function surfareaxy + + + +end module coordinate_systems_mod diff --git a/src/dynamics/se/dycore/cube_mod.F90 b/src/dynamics/se/dycore/cube_mod.F90 new file mode 100644 index 0000000000..e467fc42f1 --- /dev/null +++ b/src/dynamics/se/dycore/cube_mod.F90 @@ -0,0 +1,2332 @@ +module cube_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use coordinate_systems_mod, only: spherical_polar_t, cartesian3D_t, cartesian2d_t, & + projectpoint, cubedsphere2cart, spherical_to_cart, sphere_tri_area,dist_threshold, & + change_coordinates + + use physconst, only: pi, rearth + use control_mod, only: hypervis_scaling, cubed_sphere_map + use cam_abortutils, only: endrun + + implicit none + private + + integer,public, parameter :: nfaces = 6 ! number of faces on the cube + integer,public, parameter :: nInnerElemEdge = 8 ! number of edges for an interior element + integer,public, parameter :: nCornerElemEdge = 4 ! number of corner elements + + real(kind=r8), public, parameter :: cube_xstart = -0.25_R8*PI + real(kind=r8), public, parameter :: cube_xend = 0.25_R8*PI + real(kind=r8), public, parameter :: cube_ystart = -0.25_R8*PI + real(kind=r8), public, parameter :: cube_yend = 0.25_R8*PI + + + type, public :: face_t + type (spherical_polar_t) :: sphere0 ! tangent point of face on sphere + type (spherical_polar_t) :: sw ! sw corner of face on sphere + type (spherical_polar_t) :: se ! se corner of face on sphere + type (spherical_polar_t) :: ne ! ne corner of face on sphere + type (spherical_polar_t) :: nw ! nw corner of face on sphere + type (cartesian3D_t) :: P0 + type (cartesian3D_t) :: X0 + type (cartesian3D_t) :: Y0 + integer :: number + integer :: padding ! pad the struct + end type face_t + + type, public :: cube_face_coord_t + real(r8) :: x ! x coordinate + real(r8) :: y ! y coordinate + type (face_t), pointer :: face ! face + end type cube_face_coord_t + + ! ========================================== + ! Public Interfaces + ! ========================================== + + public :: CubeTopology + + ! Rotate the North Pole: used for JW baroclinic test case + ! Settings this only changes Coriolis. + ! User must also rotate initial condition + real (kind=r8), public :: rotate_grid = 0 + + ! =============================== + ! Public methods for cube + ! =============================== + + public :: cube_init_atomic + public :: convert_gbl_index + public :: vmap,dmap + public :: covariant_rot + public :: contravariant_rot + public :: set_corner_coordinates + public :: assign_node_numbers_to_elem + + + public :: CubeEdgeCount + public :: CubeElemCount + public :: CubeSetupEdgeIndex + public :: rotation_init_atomic + public :: ref2sphere + + ! =============================== + ! Private methods + ! =============================== + private :: coordinates_atomic + private :: metric_atomic + private :: coreolis_init_atomic + +contains + + ! ======================================= + ! cube_init_atomic: + ! + ! Initialize element descriptors for + ! cube sphere case for each element ... + ! ======================================= + subroutine cube_init_atomic(elem, gll_points, alpha_in) + use element_mod, only : element_t + use dimensions_mod, only : np + + type (element_t), intent(inout) :: elem + real(r8), intent(in) :: gll_points(np) + real(r8), optional, intent(in) :: alpha_in + + real(r8) :: alpha + + if (present(alpha_in)) then + alpha = alpha_in + else + alpha = 1.0_r8 + end if + + elem%FaceNum=elem%vertex%face_number + call coordinates_atomic(elem,gll_points) + + call metric_atomic(elem, gll_points, alpha) + + call coreolis_init_atomic(elem) + elem%desc%use_rotation= 0 + + end subroutine cube_init_atomic + + ! ======================================= + ! coordinates_atomic: + ! + ! Initialize element coordinates for + ! cube-sphere case ... (atomic) + ! + ! ======================================= + + subroutine coordinates_atomic(elem, gll_points) + use element_mod, only: element_t, element_var_coordinates + use dimensions_mod, only: np + + type(element_t), intent(inout) :: elem + real(r8), intent(in) :: gll_points(np) + + real(r8) :: area1,area2 + type (cartesian3d_t) :: quad(4) + integer :: face_no,i,j + + face_no = elem%vertex%face_number + ! compute the corners in Cartesian coordinates + do i=1,4 + elem%corners3D(i)=cubedsphere2cart(elem%corners(i),face_no) + enddo + + ! ========================================= + ! compute lat/lon coordinates of each GLL point + ! ========================================= + do i=1,np + do j=1,np + elem%spherep(i,j)=ref2sphere(gll_points(i),gll_points(j),elem%corners3D,cubed_sphere_map,elem%corners,elem%facenum) + enddo + enddo + + ! also compute the [-pi/2,pi/2] cubed sphere coordinates: + elem%cartp=element_var_coordinates(elem%corners,gll_points) + + ! Matrix describing vector conversion to cartesian + ! Zonal direction + elem%vec_sphere2cart(:,:,1,1) = -SIN(elem%spherep(:,:)%lon) + elem%vec_sphere2cart(:,:,2,1) = COS(elem%spherep(:,:)%lon) + elem%vec_sphere2cart(:,:,3,1) = 0.0_r8 + ! Meridional direction + elem%vec_sphere2cart(:,:,1,2) = -SIN(elem%spherep(:,:)%lat)*COS(elem%spherep(:,:)%lon) + elem%vec_sphere2cart(:,:,2,2) = -SIN(elem%spherep(:,:)%lat)*SIN(elem%spherep(:,:)%lon) + elem%vec_sphere2cart(:,:,3,2) = COS(elem%spherep(:,:)%lat) + + end subroutine coordinates_atomic + + ! elem_jacobians: + ! + ! Calculate Jacobian associated with mapping + ! from arbitrary quadrilateral to [-1,1]^2 + ! along with its inverse and determinant + ! ========================================== + + subroutine elem_jacobians(coords, unif2quadmap) + + use dimensions_mod, only : np + type (cartesian2D_t), dimension(np,np), intent(in) :: coords + ! unif2quadmap is the bilinear map from [-1,1]^2 -> arbitrary quadrilateral + real (kind=r8), dimension(4,2), intent(out) :: unif2quadmap + integer :: ii,jj + + unif2quadmap(1,1)=(coords(1,1)%x+coords(np,1)%x+coords(np,np)%x+coords(1,np)%x)/4.0_r8 + unif2quadmap(1,2)=(coords(1,1)%y+coords(np,1)%y+coords(np,np)%y+coords(1,np)%y)/4.0_r8 + unif2quadmap(2,1)=(-coords(1,1)%x+coords(np,1)%x+coords(np,np)%x-coords(1,np)%x)/4.0_r8 + unif2quadmap(2,2)=(-coords(1,1)%y+coords(np,1)%y+coords(np,np)%y-coords(1,np)%y)/4.0_r8 + unif2quadmap(3,1)=(-coords(1,1)%x-coords(np,1)%x+coords(np,np)%x+coords(1,np)%x)/4.0_r8 + unif2quadmap(3,2)=(-coords(1,1)%y-coords(np,1)%y+coords(np,np)%y+coords(1,np)%y)/4.0_r8 + unif2quadmap(4,1)=(coords(1,1)%x-coords(np,1)%x+coords(np,np)%x-coords(1,np)%x)/4.0_r8 + unif2quadmap(4,2)=(coords(1,1)%y-coords(np,1)%y+coords(np,np)%y-coords(1,np)%y)/4.0_r8 + + end subroutine elem_jacobians + + ! ========================================= + ! metric_atomic: + ! + ! Initialize cube-sphere metric terms: + ! equal angular elements (atomic) + ! initialize: + ! metdet, rmetdet (analytic) = detD, 1/detD + ! met (analytic) D^t D (symmetric) + ! metdet (analytic) = detD + ! metinv (analytic) Dinv Dinv^t (symmetic) + ! D (from subroutine vmap) + ! Dinv (computed directly from D) + ! + ! ucontra = Dinv * u = metinv * ucov + ! ucov = D^t * u = met * ucontra + ! + ! we also compute DE = D*E, where + ! E = eigenvectors of metinv as a basis metinv = E LAMBDA E^t + ! + ! ueig = E^t ucov = E^t D^t u = (DE)^t u + ! + ! + ! so if we want to tweak the mapping by a factor alpha (so he weights add up to 4pi, for example) + ! we take: + ! NEW OLD + ! D = sqrt(alpha) D and then rederive all quantities. + ! detD = alpha detD + ! + ! where alpha = 4pi/SEMarea, SEMarea = global sum elem(ie)%mv(i,j)*elem(ie)%metdet(i,j) + ! + ! ========================================= + + subroutine metric_atomic(elem,gll_points,alpha) + use element_mod, only: element_t + use dimensions_mod, only: np + use physconst, only: ra + + type (element_t), intent(inout) :: elem + real(r8), intent(in) :: alpha + real(r8), intent(in) :: gll_points(np) + + ! Local variables + integer ii + integer i,j,nn + integer iptr + + real (kind=r8) :: r ! distance from origin for point on cube tangent to unit sphere + + real (kind=r8) :: const, norm + real (kind=r8) :: detD ! determinant of vector field mapping matrix. + + real (kind=r8) :: x1 ! 1st cube face coordinate + real (kind=r8) :: x2 ! 2nd cube face coordinate + real (kind=r8) :: tmpD(2,2) + real (kind=r8) :: M(2,2),E(2,2),eig(2),DE(2,2),DEL(2,2),V(2,2), nu1, nu2, lamStar1, lamStar2 + integer :: imaxM(2) + real (kind=r8) :: l1, l2, sc,min_svd,max_svd,max_normDinv + + + ! ============================================== + ! Initialize differential mapping operator + ! to and from vector fields on the sphere to + ! contravariant vector fields on the cube + ! i.e. dM/dx^i in Sadourney (1972) and it's + ! inverse + ! ============================================== + + ! MNL: Calculate Jacobians of bilinear map from cubed-sphere to ref element + if (cubed_sphere_map==0) then + call elem_jacobians(elem%cartp, elem%u2qmap) + endif + + max_svd = 0.0_r8 + max_normDinv = 0.0_r8 + min_svd = 1d99 + do j=1,np + do i=1,np + x1=gll_points(i) + x2=gll_points(j) + call Dmap(elem%D(i,j,:,:),x1,x2,elem%corners3D,cubed_sphere_map,elem%corners,elem%u2qmap,elem%facenum) + + + ! Numerical metric tensor based on analytic D: met = D^T times D + ! (D maps between sphere and reference element) + elem%met(i,j,1,1) = elem%D(i,j,1,1)*elem%D(i,j,1,1) + & + elem%D(i,j,2,1)*elem%D(i,j,2,1) + elem%met(i,j,1,2) = elem%D(i,j,1,1)*elem%D(i,j,1,2) + & + elem%D(i,j,2,1)*elem%D(i,j,2,2) + elem%met(i,j,2,1) = elem%D(i,j,1,1)*elem%D(i,j,1,2) + & + elem%D(i,j,2,1)*elem%D(i,j,2,2) + elem%met(i,j,2,2) = elem%D(i,j,1,2)*elem%D(i,j,1,2) + & + elem%D(i,j,2,2)*elem%D(i,j,2,2) + + ! compute D^-1... + ! compute determinant of D mapping matrix... if not zero compute inverse + + detD = elem%D(i,j,1,1)*elem%D(i,j,2,2) - elem%D(i,j,1,2)*elem%D(i,j,2,1) + + elem%Dinv(i,j,1,1) = elem%D(i,j,2,2)/detD + elem%Dinv(i,j,1,2) = -elem%D(i,j,1,2)/detD + elem%Dinv(i,j,2,1) = -elem%D(i,j,2,1)/detD + elem%Dinv(i,j,2,2) = elem%D(i,j,1,1)/detD + + ! L2 norm = sqrt max eigenvalue of metinv + ! = 1/sqrt(min eigenvalue of met) + ! l1 and l2 are eigenvalues of met + ! (should both be positive, l1 > l2) + l1 = (elem%met(i,j,1,1) + elem%met(i,j,2,2) + sqrt(4.0_r8*elem%met(i,j,1,2)*elem%met(i,j,2,1) + & + (elem%met(i,j,1,1) - elem%met(i,j,2,2))**2))/2.0_r8 + l2 = (elem%met(i,j,1,1) + elem%met(i,j,2,2) - sqrt(4.0_r8*elem%met(i,j,1,2)*elem%met(i,j,2,1) + & + (elem%met(i,j,1,1) - elem%met(i,j,2,2))**2))/2.0_r8 + ! Max L2 norm of Dinv is sqrt of max eigenvalue of metinv + ! max eigenvalue of metinv is 1/min eigenvalue of met + norm = 1.0_r8/sqrt(min(abs(l1),abs(l2))) + max_svd = max(norm, max_svd) + ! Min L2 norm of Dinv is sqrt of min eigenvalue of metinv + ! min eigenvalue of metinv is 1/max eigenvalue of met + norm = 1.0_r8/sqrt(max(abs(l1),abs(l2))) + min_svd = min(norm, min_svd) + + ! some kind of pseudo-norm of Dinv + ! C = 1/sqrt(2) sqrt( |g^x|^2 + |g^y|^2 + 2*|g^x dot g^y|) + ! = 1/sqrt(2) sqrt( |g_x|^2 + |g_y|^2 + 2*|g_x dot g_y|) / J + ! g^x = Dinv(:,1) g_x = D(1,:) + ! g^y = Dinv(:,2) g_y = D(2,:) + norm = (2*abs(sum(elem%Dinv(i,j,:,1)*elem%Dinv(i,j,:,2))) + sum(elem%Dinv(i,j,:,1)**2) + sum(elem%Dinv(i,j,:,2)**2)) + norm = sqrt(norm) +! norm = (2*abs(sum(elem%D(1,:,i,j)*elem%D(2,:,i,j))) + sum(elem%D(1,:,i,j)**2) + sum(elem%D(2,:,i,j)**2)) +! norm = sqrt(norm)/detD + max_normDinv = max(norm,max_normDinv) + + + ! Need inverse of met if not calculated analytically + elem%metdet(i,j) = abs(detD) + elem%rmetdet(i,j) = 1.0_R8/abs(detD) + + elem%metinv(i,j,1,1) = elem%met(i,j,2,2)/(detD*detD) + elem%metinv(i,j,1,2) = -elem%met(i,j,1,2)/(detD*detD) + elem%metinv(i,j,2,1) = -elem%met(i,j,2,1)/(detD*detD) + elem%metinv(i,j,2,2) = elem%met(i,j,1,1)/(detD*detD) + + ! matricies for tensor hyper-viscosity + ! compute eigenvectors of metinv (probably same as computed above) + M = elem%metinv(i,j,:,:) + + eig(1) = (M(1,1) + M(2,2) + sqrt(4.0_r8*M(1,2)*M(2,1) + & + (M(1,1) - M(2,2))**2))/2.0_r8 + eig(2) = (M(1,1) + M(2,2) - sqrt(4.0_r8*M(1,2)*M(2,1) + & + (M(1,1) - M(2,2))**2))/2.0_r8 + + ! use DE to store M - Lambda, to compute eigenvectors + DE=M + DE(1,1)=DE(1,1)-eig(1) + DE(2,2)=DE(2,2)-eig(1) + + imaxM = maxloc(abs(DE)) + if (maxval(abs(DE))==0) then + E(1,1)=1; E(2,1)=0; + elseif ( imaxM(1)==1 .and. imaxM(2)==1 ) then + E(2,1)=1; E(1,1) = -DE(2,1)/DE(1,1) + else if ( imaxM(1)==1 .and. imaxM(2)==2 ) then + E(2,1)=1; E(1,1) = -DE(2,2)/DE(1,2) + else if ( imaxM(1)==2 .and. imaxM(2)==1 ) then + E(1,1)=1; E(2,1) = -DE(1,1)/DE(2,1) + else if ( imaxM(1)==2 .and. imaxM(2)==2 ) then + E(1,1)=1; E(2,1) = -DE(1,2)/DE(2,2) + else + call endrun('Impossible error in cube_mod.F90::metric_atomic()') + endif + + ! the other eigenvector is orthgonal: + E(1,2)=-E(2,1) + E(2,2)= E(1,1) + +!normalize columns + E(:,1)=E(:,1)/sqrt(sum(E(:,1)*E(:,1))); + E(:,2)=E(:,2)/sqrt(sum(E(:,2)*E(:,2))); + + +! OBTAINING TENSOR FOR HV: + +! Instead of the traditional scalar Laplace operator \grad \cdot \grad +! we introduce \grad \cdot V \grad +! where V = D E LAM LAM^* E^T D^T. +! Recall (metric_tensor)^{-1}=(D^T D)^{-1} = E LAM E^T. +! Here, LAM = diag( 4/((np-1)dx)^2 , 4/((np-1)dy)^2 ) = diag( 4/(dx_elem)^2, 4/(dy_elem)^2 ) +! Note that metric tensors and LAM correspondingly are quantities on a unit sphere. + +! This motivates us to use V = D E LAM LAM^* E^T D^T +! where LAM^* = diag( nu1, nu2 ) where nu1, nu2 are HV coefficients scaled like (dx)^{hv_scaling/2}, (dy)^{hv_scaling/2}. +! (Halves in powers come from the fact that HV consists of two Laplace iterations.) + +! Originally, we took LAM^* = diag( +! 1/(eig(1)**(hypervis_scaling/4.0_r8))*(rearth**(hypervis_scaling/2.0_r8)) +! 1/(eig(2)**(hypervis_scaling/4.0_r8))*(rearth**(hypervis_scaling/2.0_r8)) ) = +! = diag( lamStar1, lamStar2) +! \simeq ((np-1)*dx_sphere / 2 )^hv_scaling/2 = SQRT(OPERATOR_HV) +! because 1/eig(...) \simeq (dx_on_unit_sphere)^2 . +! Introducing the notation OPERATOR = lamStar^2 is useful for conversion formulas. + +! This leads to the following conversion formula: nu_const is nu used for traditional HV on uniform grids +! nu_tensor = nu_const * OPERATOR_HV^{-1}, so +! nu_tensor = nu_const *((np-1)*dx_sphere / 2 )^{ - hv_scaling} or +! nu_tensor = nu_const *(2/( (np-1) * dx_sphere) )^{hv_scaling} . +! dx_sphere = 2\pi *rearth/(np-1)/4/NE +! [nu_tensor] = [meter]^{4-hp_scaling}/[sec] + +! (1) Later developments: +! Apply tensor V only at the second Laplace iteration. Thus, LAM^* should be scaled as (dx)^{hv_scaling}, (dy)^{hv_scaling}, +! see this code below: +! DEL(1:2,1) = (lamStar1**2) *eig(1)*DE(1:2,1) +! DEL(1:2,2) = (lamStar2**2) *eig(2)*DE(1:2,2) + +! (2) Later developments: +! Bringing [nu_tensor] to 1/[sec]: +! lamStar1=1/(eig(1)**(hypervis_scaling/4.0_r8)) *(rearth**2.0_r8) +! lamStar2=1/(eig(2)**(hypervis_scaling/4.0_r8)) *(rearth**2.0_r8) +! OPERATOR_HV = ( (np-1)*dx_unif_sphere / 2 )^{hv_scaling} * rearth^4 +! Conversion formula: +! nu_tensor = nu_const * OPERATOR_HV^{-1}, so +! nu_tensor = nu_const *( 2*rearth /((np-1)*dx))^{hv_scaling} * rearth^{-4.0}. + +! For the baseline coefficient nu=1e15 for NE30, +! nu_tensor=7e-8 (BUT RUN TWICE AS SMALL VALUE FOR NOW) for hv_scaling=3.2 +! and +! nu_tensor=1.3e-6 for hv_scaling=4.0. + + +!matrix D*E + DE(1,1)=sum(elem%D(i,j,1,:)*E(:,1)) + DE(1,2)=sum(elem%D(i,j,1,:)*E(:,2)) + DE(2,1)=sum(elem%D(i,j,2,:)*E(:,1)) + DE(2,2)=sum(elem%D(i,j,2,:)*E(:,2)) + + lamStar1=1/(eig(1)**(hypervis_scaling/4.0_r8)) *(rearth**2.0_r8) + lamStar2=1/(eig(2)**(hypervis_scaling/4.0_r8)) *(rearth**2.0_r8) + +!matrix (DE) * Lam^* * Lam , tensor HV when V is applied at each Laplace calculation +! DEL(1:2,1) = lamStar1*eig(1)*DE(1:2,1) +! DEL(1:2,2) = lamStar2*eig(2)*DE(1:2,2) + +!matrix (DE) * (Lam^*)^2 * Lam, tensor HV when V is applied only once, at the last Laplace calculation +!will only work with hyperviscosity, not viscosity + DEL(1:2,1) = (lamStar1**2) *eig(1)*DE(1:2,1) + DEL(1:2,2) = (lamStar2**2) *eig(2)*DE(1:2,2) + +!matrix (DE) * Lam^* * Lam *E^t *D^t or (DE) * (Lam^*)^2 * Lam *E^t *D^t + V(1,1)=sum(DEL(1,:)*DE(1,:)) + V(1,2)=sum(DEL(1,:)*DE(2,:)) + V(2,1)=sum(DEL(2,:)*DE(1,:)) + V(2,2)=sum(DEL(2,:)*DE(2,:)) + + elem%tensorVisc(i,j,:,:)=V(:,:) + + end do + end do + +! see Paul Ullrich writeup: +! max_normDinv might be a tighter bound than max_svd for deformed elements +! max_svd >= max_normDinv/sqrt(2), with equality holding if |g^x| = |g^y| +! elem%normDinv=max_normDinv/sqrt(2) + + ! this norm is consistent with length scales defined below: + elem%normDinv=max_svd + + + ! compute element length scales, based on SVDs, in km: + elem%dx_short = 1.0_r8/(max_svd*0.5_r8*dble(np-1)*ra*1000.0_r8) + elem%dx_long = 1.0_r8/(min_svd*0.5_r8*dble(np-1)*ra*1000.0_r8) + + ! optional noramlization: + elem%D = elem%D * sqrt(alpha) + elem%Dinv = elem%Dinv / sqrt(alpha) + elem%metdet = elem%metdet * alpha + elem%rmetdet = elem%rmetdet / alpha + elem%met = elem%met * alpha + elem%metinv = elem%metinv / alpha + + end subroutine metric_atomic + + + ! ======================================== + ! covariant_rot: + ! + ! 2 x 2 matrix multiply: Db^T * Da^-T + ! for edge rotations: maps face a to face b + ! + ! ======================================== + + function covariant_rot(Da,Db) result(R) + + real (kind=r8) :: Da(2,2) + real (kind=r8) :: Db(2,2) + real (kind=r8) :: R(2,2) + + real (kind=r8) :: detDa + + detDa = Da(2,2)*Da(1,1) - Da(1,2)*Da(2,1) + + R(1,1)=(Da(2,2)*Db(1,1) - Da(1,2)*Db(2,1))/detDa + R(1,2)=(Da(1,1)*Db(2,1) - Da(2,1)*Db(1,1))/detDa + R(2,1)=(Da(2,2)*Db(1,2) - Da(1,2)*Db(2,2))/detDa + R(2,2)=(Da(1,1)*Db(2,2) - Da(2,1)*Db(1,2))/detDa + + end function covariant_rot + + ! ======================================== + ! contravariant_rot: + ! + ! 2 x 2 matrix multiply: Db^-1 * Da + ! that maps a contravariant vector field + ! from an edge of cube face a to a contiguous + ! edge of cube face b. + ! + ! ======================================== + + function contravariant_rot(Da,Db) result(R) + + real(kind=r8), intent(in) :: Da(2,2) + real(kind=r8), intent(in) :: Db(2,2) + real(kind=r8) :: R(2,2) + + real(kind=r8) :: detDb + + detDb = Db(2,2)*Db(1,1) - Db(1,2)*Db(2,1) + + R(1,1)=(Da(1,1)*Db(2,2) - Da(2,1)*Db(1,2))/detDb + R(1,2)=(Da(1,2)*Db(2,2) - Da(2,2)*Db(1,2))/detDb + R(2,1)=(Da(2,1)*Db(1,1) - Da(1,1)*Db(2,1))/detDb + R(2,2)=(Da(2,2)*Db(1,1) - Da(1,2)*Db(2,1))/detDb + + end function contravariant_rot + + ! ======================================================== + ! Dmap: + ! + ! Initialize mapping that tranforms contravariant + ! vector fields on the reference element onto vector fields on + ! the sphere. + ! ======================================================== + subroutine Dmap(D, a,b, corners3D, ref_map, corners, u2qmap, facenum) + real (kind=r8), intent(out) :: D(2,2) + real (kind=r8), intent(in) :: a,b + type (cartesian3D_t) :: corners3D(4) !x,y,z coords of element corners + integer :: ref_map + ! only needed for ref_map=0,1 + type (cartesian2D_t),optional :: corners(4) ! gnomonic coords of element corners + real (kind=r8),optional :: u2qmap(4,2) + integer,optional :: facenum + + + + if (ref_map==0) then + if (.not. present ( corners ) ) & + call endrun('Dmap(): missing arguments for equiangular map') + call dmap_equiangular(D,a,b,corners,u2qmap,facenum) + else if (ref_map==1) then + call endrun('equi-distance gnomonic map not yet implemented') + else if (ref_map==2) then + call dmap_elementlocal(D,a,b,corners3D) + else + call endrun('bad value of ref_map') + endif + end subroutine Dmap + + + + ! ======================================================== + ! Dmap: + ! + ! Equiangular Gnomonic Projection + ! Composition of equiangular Gnomonic projection to cubed-sphere face, + ! followd by bilinear map to reference element + ! ======================================================== + subroutine dmap_equiangular(D, a,b, corners,u2qmap,facenum ) + use dimensions_mod, only : np + real (kind=r8), intent(out) :: D(2,2) + real (kind=r8), intent(in) :: a,b + real (kind=r8) :: u2qmap(4,2) + type (cartesian2D_t) :: corners(4) ! gnomonic coords of element corners + integer :: facenum + ! local + real (kind=r8) :: tmpD(2,2), Jp(2,2),x1,x2,pi,pj,qi,qj + real (kind=r8), dimension(4,2) :: unif2quadmap + +#if 0 + ! we shoud get rid of elem%u2qmap() and routine cube_mod.F90::elem_jacobian() + ! and replace with this code below: + ! but this produces roundoff level changes + !unif2quadmap(1,1)=(elem%cartp(1,1)%x+elem%cartp(np,1)%x+elem%cartp(np,np)%x+elem%cartp(1,np)%x)/4.0_r8 + !unif2quadmap(1,2)=(elem%cartp(1,1)%y+elem%cartp(np,1)%y+elem%cartp(np,np)%y+elem%cartp(1,np)%y)/4.0_r8 + unif2quadmap(2,1)=(-elem%cartp(1,1)%x+elem%cartp(np,1)%x+elem%cartp(np,np)%x-elem%cartp(1,np)%x)/4.0_r8 + unif2quadmap(2,2)=(-elem%cartp(1,1)%y+elem%cartp(np,1)%y+elem%cartp(np,np)%y-elem%cartp(1,np)%y)/4.0_r8 + unif2quadmap(3,1)=(-elem%cartp(1,1)%x-elem%cartp(np,1)%x+elem%cartp(np,np)%x+elem%cartp(1,np)%x)/4.0_r8 + unif2quadmap(3,2)=(-elem%cartp(1,1)%y-elem%cartp(np,1)%y+elem%cartp(np,np)%y+elem%cartp(1,np)%y)/4.0_r8 + unif2quadmap(4,1)=(elem%cartp(1,1)%x-elem%cartp(np,1)%x+elem%cartp(np,np)%x-elem%cartp(1,np)%x)/4.0_r8 + unif2quadmap(4,2)=(elem%cartp(1,1)%y-elem%cartp(np,1)%y+elem%cartp(np,np)%y-elem%cartp(1,np)%y)/4.0_r8 + Jp(1,1) = unif2quadmap(2,1) + unif2quadmap(4,1)*b + Jp(1,2) = unif2quadmap(3,1) + unif2quadmap(4,1)*a + Jp(2,1) = unif2quadmap(2,2) + unif2quadmap(4,2)*b + Jp(2,2) = unif2quadmap(3,2) + unif2quadmap(4,2)*a +#else + ! input (a,b) shold be a point in the reference element [-1,1] + ! compute Jp(a,b) + Jp(1,1) = u2qmap(2,1) + u2qmap(4,1)*b + Jp(1,2) = u2qmap(3,1) + u2qmap(4,1)*a + Jp(2,1) = u2qmap(2,2) + u2qmap(4,2)*b + Jp(2,2) = u2qmap(3,2) + u2qmap(4,2)*a +#endif + + ! map (a,b) to the [-pi/2,pi/2] equi angular cube face: x1,x2 + ! a = gp%points(i) + ! b = gp%points(j) + pi = (1-a)/2 + pj = (1-b)/2 + qi = (1+a)/2 + qj = (1+b)/2 + x1 = pi*pj*corners(1)%x & + + qi*pj*corners(2)%x & + + qi*qj*corners(3)%x & + + pi*qj*corners(4)%x + x2 = pi*pj*corners(1)%y & + + qi*pj*corners(2)%y & + + qi*qj*corners(3)%y & + + pi*qj*corners(4)%y + + call vmap(tmpD,x1,x2,facenum) + + ! Include map from element -> ref element in D + D(1,1) = tmpD(1,1)*Jp(1,1) + tmpD(1,2)*Jp(2,1) + D(1,2) = tmpD(1,1)*Jp(1,2) + tmpD(1,2)*Jp(2,2) + D(2,1) = tmpD(2,1)*Jp(1,1) + tmpD(2,2)*Jp(2,1) + D(2,2) = tmpD(2,1)*Jp(1,2) + tmpD(2,2)*Jp(2,2) + end subroutine dmap_equiangular + + + + ! ======================================================== + ! vmap: + ! + ! Initialize mapping that tranforms contravariant + ! vector fields on the cube onto vector fields on + ! the sphere. This follows Taylor's D matrix + ! + ! | cos(theta)dlambda/dx1 cos(theta)dlambda/dx2 | + ! D = | | + ! | dtheta/dx1 dtheta/dx2 | + ! + ! ======================================================== + + subroutine vmap(D, x1, x2, face_no) + real(kind=r8), intent(inout) :: D(2,2) + real(kind=r8), intent(in) :: x1 + real(kind=r8), intent(in) :: x2 + integer, intent(in) :: face_no + + ! Local variables + + real (kind=r8) :: poledist ! SQRT(TAN(x1)**2 +TAN(x2)**2) + real (kind=r8) :: r ! distance from cube point to center of sphere + + real (kind=r8) :: D11 + real (kind=r8) :: D12 + real (kind=r8) :: D21 + real (kind=r8) :: D22 + character(len=64) :: errmsg + + r = SQRT(1.0_r8 + TAN(x1)**2 + TAN(x2)**2) + + if (face_no >= 1 .and. face_no <= 4) then + + D11 = 1.0_r8 / (r * COS(x1)) + D12 = 0.0_r8 + D21 = -TAN(x1)*TAN(x2) / (COS(x1)*r*r) + D22 = 1.0_r8 / (r*r*COS(x1)*COS(x2)*COS(x2)) + + D(1,1) = D11 + D(1,2) = D12 + D(2,1) = D21 + D(2,2) = D22 + + + else if (face_no == 6) then + poledist = SQRT( TAN(x1)**2 + TAN(x2)**2) + if (poledist <= DIST_THRESHOLD) then + + ! we set the D transform to the identity matrix + ! which works ONLY for swtc1, phi starting at + ! 3*PI/2... assumes lon at pole == 0 + + D(1,1) = 1.0_r8 + D(1,2) = 0.0_r8 + D(2,1) = 0.0_r8 + D(2,2) = 1.0_r8 + + else + + D11 = -TAN(x2)/(poledist*COS(x1)*COS(x1)*r) + D12 = TAN(x1)/(poledist*COS(x2)*COS(x2)*r) + D21 = -TAN(x1)/(poledist*COS(x1)*COS(x1)*r*r) + D22 = -TAN(x2)/(poledist*COS(x2)*COS(x2)*r*r) + + D(1,1) = D11 + D(1,2) = D12 + D(2,1) = D21 + D(2,2) = D22 + + end if + else if (face_no == 5) then + poledist = SQRT( TAN(x1)**2 + TAN(x2)**2) + if (poledist <= DIST_THRESHOLD) then + + ! we set the D transform to the identity matrix + ! which works ONLY for swtc1, phi starting at + ! 3*PI/2... assumes lon at pole == 0, i.e. very specific + + D(1,1) = 1.0_r8 + D(1,2) = 0.0_r8 + D(2,1) = 0.0_r8 + D(2,2) = 1.0_r8 + + else + + D11 = TAN(x2)/(poledist*COS(x1)*COS(x1)*r) + D12 = -TAN(x1)/(poledist*COS(x2)*COS(x2)*r) + D21 = TAN(x1)/(poledist*COS(x1)*COS(x1)*r*r) + D22 = TAN(x2)/(poledist*COS(x2)*COS(x2)*r*r) + + D(1,1) = D11 + D(1,2) = D12 + D(2,1) = D21 + D(2,2) = D22 + + end if + else + write(errmsg, '(a,i0)') 'VMAP: Bad face number, ',face_no + call endrun(errmsg) + end if + + end subroutine vmap + + + + + ! ======================================================== + ! Dmap: + ! + ! Initialize mapping that tranforms contravariant + ! vector fields on the reference element onto vector fields on + ! the sphere. + ! For Gnomonic, followed by bilinear, this code uses the old vmap() + ! for unstructured grids, this code uses the parametric map that + ! maps quads on the sphere directly to the reference element + ! ======================================================== + subroutine dmap_elementlocal(D, a,b, corners3D) + use element_mod, only : element_t + + type (element_t) :: elem + real (kind=r8), intent(out) :: D(2,2) + real (kind=r8), intent(in) :: a,b + type (cartesian3d_t) :: corners3D(4) + + type (spherical_polar_t) :: sphere + + real(kind=r8) :: c(3,4), q(4), xx(3), r, lam, th, dd(4,2) + real(kind=r8) :: sinlam, sinth, coslam, costh + real(kind=r8) :: D1(2,3), D2(3,3), D3(3,2), D4(3,2) + integer :: i,j + + sphere = ref2sphere(a,b,corners3D,2) ! use element local map, ref_map=2 + + c(1,1)=corners3D(1)%x; c(2,1)=corners3D(1)%y; c(3,1)=corners3D(1)%z; + c(1,2)=corners3D(2)%x; c(2,2)=corners3D(2)%y; c(3,2)=corners3D(2)%z; + c(1,3)=corners3D(3)%x; c(2,3)=corners3D(3)%y; c(3,3)=corners3D(3)%z; + c(1,4)=corners3D(4)%x; c(2,4)=corners3D(4)%y; c(3,4)=corners3D(4)%z; + + q(1)=(1-a)*(1-b); q(2)=(1+a)*(1-b); q(3)=(1+a)*(1+b); q(4)=(1-a)*(1+b); + q=q/4.0_r8; + + do i=1,3 + xx(i)=sum(c(i,:)*q(:)) + enddo + + r=sqrt(xx(1)**2+xx(2)**2+xx(3)**2) + + lam=sphere%lon; th=sphere%lat; + sinlam=sin(lam); sinth=sin(th); + coslam=cos(lam); costh=cos(th); + + D1(1,1)=-sinlam; D1(1,2)=coslam; D1(1,3)=0.0_r8; + D1(2,1)=0.0_r8; D1(2,2)=0.0_r8; D1(2,3)=1.0_r8; + + D2(1,1)=(sinlam**2)*(costh**2)+sinth**2; D2(1,2)=-sinlam*coslam*(costh**2); D2(1,3)=-coslam*sinth*costh; + D2(2,1)=-sinlam*coslam*(costh**2); D2(2,2)=(coslam**2)*(costh**2)+sinth**2; D2(2,3)=-sinlam*sinth*costh; + D2(3,1)=-coslam*sinth; D2(3,2)=-sinlam*sinth; D2(3,3)=costh; + + dd(1,1)=-1+b; dd(1,2)=-1+a; + dd(2,1)=1-b; dd(2,2)=-1-a; + dd(3,1)=1+b; dd(3,2)=1+a; + dd(4,1)=-1-b; dd(4,2)=1-a; + + dd=dd/4.0_r8 + + do i=1,3 + do j=1,2 + D3(i,j)=sum(c(i,:)*dd(:,j)) + enddo + enddo + + do i=1,3 + do j=1,2 + D4(i,j)=sum(D2(i,:)*D3(:,j)) + enddo + enddo + + do i=1,2 + do j=1,2 + D(i,j)=sum(D1(i,:)*D4(:,j)) + enddo + enddo + + D=D/r + end subroutine dmap_elementlocal + + + + + + ! ======================================== + ! coreolis_init_atomic: + ! + ! Initialize coreolis term ... + ! + ! ======================================== + + subroutine coreolis_init_atomic(elem) + use element_mod, only: element_t + use dimensions_mod, only: np + use physconst, only: omega + + type (element_t) :: elem + + ! Local variables + + integer :: i,j + real (kind=r8) :: lat,lon,rangle + + rangle = rotate_grid * PI / 180._r8 + do j=1,np + do i=1,np + if ( rotate_grid /= 0) then + lat = elem%spherep(i,j)%lat + lon = elem%spherep(i,j)%lon + elem%fcor(i,j)= 2*omega* & + (-cos(lon)*cos(lat)*sin(rangle) + sin(lat)*cos(rangle)) + else + elem%fcor(i,j) = 2.0_r8*omega*SIN(elem%spherep(i,j)%lat) + endif + end do + end do + + end subroutine coreolis_init_atomic + + ! ========================================= + ! rotation_init_atomic: + ! + ! Initialize cube rotation terms resulting + ! from changing cube face coordinate systems + ! + ! ========================================= + + + subroutine rotation_init_atomic(elem, rot_type) + use element_mod, only : element_t + use dimensions_mod, only : np + use control_mod, only : north, south, east, west, neast, seast, swest, nwest + + type (element_t) :: elem + character(len=*) rot_type + + ! ======================================= + ! Local variables + ! ======================================= + + integer :: myface_no ! current element face number + integer :: nbrface_no ! neighbor element face number + integer :: inbr + integer :: nrot,irot + integer :: ii,i,j,k + integer :: ir,jr + integer :: start, cnt + + real (kind=r8) :: Dloc(2,2,np) + real (kind=r8) :: Drem(2,2,np) + real (kind=r8) :: x1,x2 + + + myface_no = elem%vertex%face_number + + nrot = 0 + + do inbr=1,8 + cnt = elem%vertex%nbrs_ptr(inbr+1) - elem%vertex%nbrs_ptr(inbr) + start = elem%vertex%nbrs_ptr(inbr) + + do k = 0, cnt-1 + nbrface_no = elem%vertex%nbrs_face(start+k) + if (myface_no /= nbrface_no) nrot=nrot+1 + end do + + end do + + if(associated(elem%desc%rot)) then + if (size(elem%desc%rot) > 0) then + ! deallocate(elem%desc%rot) + NULLIFY(elem%desc%rot) + endif + end if + + ! ===================================================== + ! If there are neighbors on other cube faces, allocate + ! an array of rotation matrix structs. + ! ===================================================== + + if (nrot > 0) then + allocate(elem%desc%rot(nrot)) + elem%desc%use_rotation=1 + irot=0 + + do inbr=1,8 + cnt = elem%vertex%nbrs_ptr(inbr+1) - elem%vertex%nbrs_ptr(inbr) + start = elem%vertex%nbrs_ptr(inbr) + + do k= 0, cnt-1 + + nbrface_no = elem%vertex%nbrs_face(start+k) + ! The cube edge (myface_no,nbrface_no) and inbr defines + ! a unique rotation given by (D^-1) on myface_no x (D) on nbrface_no + + if (myface_no /= nbrface_no .and. elem%vertex%nbrs(start+k) /= -1 ) then + irot=irot+1 + + if (inbr <= 4) then + allocate(elem%desc%rot(irot)%R(2,2,np)) ! edge + else + allocate(elem%desc%rot(irot)%R(2,2,1 )) ! corner + end if + ! Initialize Dloc and Drem for no-rotation possibilities + Dloc(1,1,:) = 1.0_r8 + Dloc(1,2,:) = 0.0_r8 + Dloc(2,1,:) = 0.0_r8 + Dloc(2,2,:) = 1.0_r8 + Drem(1,1,:) = 1.0_r8 + Drem(1,2,:) = 0.0_r8 + Drem(2,1,:) = 0.0_r8 + Drem(2,2,:) = 1.0_r8 + + ! must compute Dloc on my face, Drem on neighbor face, + ! for each point on edge or corner. + + ! ==================================== + ! Equatorial belt east/west neighbors + ! ==================================== + + if (nbrface_no <= 4 .and. myface_no <= 4) then + + if (inbr == west) then + do j=1,np + x1 = elem%cartp(1,j)%x + x2 = elem%cartp(1,j)%y + call Vmap(Dloc(1,1,j), x1,x2,myface_no) + call Vmap(Drem(1,1,j),-x1,x2,nbrface_no) + end do + else if (inbr == east) then + do j=1,np + x1 = elem%cartp(np,j)%x + x2 = elem%cartp(np,j)%y + call Vmap(Dloc(1,1,j), x1,x2,myface_no) + call Vmap(Drem(1,1,j),-x1,x2,nbrface_no) + end do + else if (inbr == swest ) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + else if (inbr == nwest ) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(1,1,1), x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + else if (inbr == seast ) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1), x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + else if (inbr == neast ) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1), x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + end if + + end if + + ! Northern Neighbors of Equatorial Belt + + if ( myface_no <= 4 .and. nbrface_no == 6 ) then + if (inbr == north) then + do i=1,np + ir=np+1-i + x1 = elem%cartp(i,np)%x + x2 = elem%cartp(i,np)%y + if ( myface_no == 1) then + call Vmap(Dloc(1,1,i), x1,x2,myface_no) + call Vmap(Drem(1,1,i),x1,-x2,nbrface_no) + end if + if ( myface_no == 2) then + call Vmap(Dloc(1,1,i),x1,x2,myface_no) + call Vmap(Drem(1,1,i),x2,x1,nbrface_no) + + end if + if ( myface_no == 3) then + call Vmap(Dloc(1,1,ir), x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x1,x2,nbrface_no) + end if + if ( myface_no == 4) then + call Vmap(Dloc(1,1,ir), x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x2,-x1,nbrface_no) + end if + end do + else if (inbr == nwest) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(1,1,1), x1,x2,myface_no) + if ( myface_no == 1) call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + if ( myface_no == 2) call Vmap(Drem(1,1,1),x2, x1,nbrface_no) + if ( myface_no == 3) call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + if ( myface_no == 4) call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + else if (inbr == neast) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + if ( myface_no == 1) call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + if ( myface_no == 2) call Vmap(Drem(1,1,1),x2, x1,nbrface_no) + if ( myface_no == 3) call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + if ( myface_no == 4) call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + end if + + end if + + ! Southern Neighbors of Equatorial Belt + + if ( myface_no <= 4 .and. nbrface_no == 5 ) then + if (inbr == south) then + do i=1,np + ir=np+1-i + x1 = elem%cartp(i,1)%x + x2 = elem%cartp(i,1)%y + if ( myface_no == 1) then + call Vmap(Dloc(1,1,i), x1, x2,myface_no) + call Vmap(Drem(1,1,i), x1,-x2,nbrface_no) + end if + if ( myface_no == 2) then + call Vmap(Dloc(1,1,ir),x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x2,-x1,nbrface_no) + end if + if ( myface_no == 3) then + call Vmap(Dloc(1,1,ir), x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x1,x2,nbrface_no) + end if + if ( myface_no == 4) then + call Vmap(Dloc(1,1,i), x1,x2,myface_no) + call Vmap(Drem(1,1,i), x2,x1,nbrface_no) + end if + end do + else if (inbr == swest) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + + + if ( myface_no == 1) call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + if ( myface_no == 2) call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + if ( myface_no == 3) call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + if ( myface_no == 4) call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + + else if (inbr == seast) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + if ( myface_no == 1) call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + if ( myface_no == 2) call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + if ( myface_no == 3) call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + if ( myface_no == 4) call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + end if + + end if + + ! Neighbors of Northern Capping Face Number 6 + + if ( myface_no == 6 ) then + if (nbrface_no == 1) then + if (inbr == south) then + do i=1,np + x1 = elem%cartp(i,1)%x + x2 = elem%cartp(i,1)%y + call Vmap(Dloc(1,1,i),x1,x2,myface_no) + call Vmap(Drem(1,1,i),x1,-x2,nbrface_no) + end do + else if (inbr == swest) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + else if (inbr == seast) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + end if + else if (nbrface_no == 2) then + if (inbr == east) then + do j=1,np + x1 = elem%cartp(np,j)%x + x2 = elem%cartp(np,j)%y + call Vmap(Dloc(1,1,j),x1,x2,myface_no) + call Vmap(Drem(1,1,j),x2,x1,nbrface_no) + end do + else if (inbr == seast) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + else if (inbr == neast) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + end if + else if (nbrface_no == 3) then + if (inbr == north) then + do i=1,np + ir =np+1-i + x1 = elem%cartp(i,np)%x + x2 = elem%cartp(i,np)%y + call Vmap(Dloc(1,1,ir),x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x1,x2,nbrface_no) + end do + else if (inbr == nwest) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + else if (inbr == neast) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + end if + else if (nbrface_no == 4) then + if (inbr == west) then + do j=1,np + jr=np+1-j + x1 = elem%cartp(1,j)%x + x2 = elem%cartp(1,j)%y + call Vmap(Dloc(1,1,jr), x1, x2,myface_no ) + call Vmap(Drem(1,1,jr),-x2,-x1,nbrface_no) + end do + else if (inbr == swest) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + else if (inbr == nwest) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + end if + end if + end if + + ! Neighbors of South Capping Face Number 5 + + if ( myface_no == 5 ) then + if (nbrface_no == 1) then + if (inbr == north) then + do i=1,np + x1 = elem%cartp(i,np)%x + x2 = elem%cartp(i,np)%y + call Vmap(Dloc(1,1,i),x1,x2,myface_no) + call Vmap(Drem(1,1,i),x1,-x2,nbrface_no) + end do + else if (inbr == nwest) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(:,:,1),x1,x2,myface_no) + call Vmap(Drem(:,:,1),x1,-x2,nbrface_no) + else if (inbr == neast) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x1,-x2,nbrface_no) + end if + else if (nbrface_no == 2) then + if (inbr == east) then + do j=1,np + jr=np+1-j + x1 = elem%cartp(np,j)%x + x2 = elem%cartp(np,j)%y + call Vmap(Dloc(1,1,jr),x1, x2,myface_no) + call Vmap(Drem(1,1,jr),-x2,-x1,nbrface_no) + end do + else if (inbr == seast) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + else if (inbr == neast) then + x1 = elem%cartp(np,np)%x + x2 = elem%cartp(np,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x2,-x1,nbrface_no) + end if + else if (nbrface_no == 3) then + if (inbr == south) then + do i=1,np + ir=np+1-i + x1 = elem%cartp(i,1)%x + x2 = elem%cartp(i,1)%y + call Vmap(Dloc(1,1,ir),x1,x2,myface_no) + call Vmap(Drem(1,1,ir),-x1,x2,nbrface_no) + end do + else if (inbr == swest) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + else if (inbr == seast) then + x1 = elem%cartp(np,1)%x + x2 = elem%cartp(np,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),-x1,x2,nbrface_no) + end if + else if (nbrface_no == 4) then + if (inbr == west) then + do j=1,np + x1 = elem%cartp(1,j)%x + x2 = elem%cartp(1,j)%y + call Vmap(Dloc(1,1,j),x1,x2,myface_no) + call Vmap(Drem(1,1,j),x2,x1,nbrface_no) + end do + else if (inbr == swest) then + x1 = elem%cartp(1,1)%x + x2 = elem%cartp(1,1)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + else if (inbr == nwest) then + x1 = elem%cartp(1,np)%x + x2 = elem%cartp(1,np)%y + call Vmap(Dloc(1,1,1),x1,x2,myface_no) + call Vmap(Drem(1,1,1),x2,x1,nbrface_no) + end if + end if + end if + + elem%desc%rot(irot)%nbr = inbr + if (rot_type == "covariant") then + do i=1,SIZE(elem%desc%rot(irot)%R(:,:,:),3) + elem%desc%rot(irot)%R(:,:,i)=covariant_rot(Dloc(:,:,i),Drem(:,:,i)) + end do + else if (rot_type == "contravariant") then + do i=1,SIZE(elem%desc%rot(irot)%R(:,:,:),3) + elem%desc%rot(irot)%R(:,:,i)=contravariant_rot(Dloc(:,:,i),Drem(:,:,i)) + end do + end if + + end if ! end of a unique rotation + end do !k loop over neighbors in that direction + end do !inbr loop + end if !nrot > 0 + + end subroutine rotation_init_atomic + + + subroutine set_corner_coordinates(elem) + use element_mod, only : element_t + use dimensions_mod, only : ne + + type (element_t) :: elem + + ! Local variables + integer i,ie,je,face_no,nn + real (kind=r8) :: dx,dy, startx, starty + + if (0==ne) call endrun('Error in set_corner_coordinates: ne is zero') + + ! ======================================== + ! compute cube face coordinates of element + ! ========================================= + + call convert_gbl_index(elem%vertex%number,ie,je,face_no) + + elem%vertex%face_number = face_no + dx = (cube_xend-cube_xstart)/ne + dy = (cube_yend-cube_ystart)/ne + + startx = cube_xstart+ie*dx + starty = cube_ystart+je*dy + + elem%corners(1)%x = startx + elem%corners(1)%y = starty + elem%corners(2)%x = startx+dx + elem%corners(2)%y = starty + elem%corners(3)%x = startx+dx + elem%corners(3)%y = starty+dy + elem%corners(4)%x = startx + elem%corners(4)%y = starty+dy + +#if 0 + do i=1,4 + elem%node_multiplicity(i) = 4 + end do + ie = ie + 1 + je = je + 1 + if (ie == 1 .and. je == 1) then + elem%node_multiplicity(1) = 3 + else if (ie == ne .and. je == 1) then + elem%node_multiplicity(2) = 3 + else if (ie == ne .and. je == ne) then + elem%node_multiplicity(3) = 3 + else if (ie == 1 .and. je == ne) then + elem%node_multiplicity(4) = 3 + end if +#endif + end subroutine set_corner_coordinates + + + subroutine assign_node_numbers_to_elem(elements, GridVertex) + use dimensions_mod, only : ne + use element_mod, only : element_t + use control_mod, only : north, south, east, west, neast, seast, swest, nwest + use gridgraph_mod, only : GridVertex_t + implicit none + type (element_t), intent(inout) :: elements(:) + type (GridVertex_t), intent(in) :: GridVertex(:) + + type (GridVertex_t) :: vertex + integer :: connectivity(6*ne*ne, 4) + integer :: nn(4), en(4) + integer el, i, n, direction + integer current_node_num, tot_ne + integer :: start, cnt + + current_node_num = 0 + tot_ne = 6*ne*ne + + if (0==ne) call endrun('Error in assign_node_numbers_to_elem: ne is zero') + if (tot_ne /= SIZE(GridVertex)) call endrun('Error in assign_node_numbers_to_elem: GridVertex not correct length') + + connectivity = 0 + + do el = 1,tot_ne + vertex = GridVertex(el) + en = 0 + do direction = 1,8 + cnt = vertex%nbrs_ptr(direction+1) - vertex%nbrs_ptr(direction) + start = vertex%nbrs_ptr(direction) + + do i=0, cnt-1 + n = vertex%nbrs(start+i) + if (n /= -1) then + nn = connectivity(n,:) + select case (direction) + case (north) + if (nn(1)/=0) en(4) = nn(1) + if (nn(2)/=0) en(3) = nn(2) + case (south) + if (nn(4)/=0) en(1) = nn(4) + if (nn(3)/=0) en(2) = nn(3) + case (east) + if (nn(1)/=0) en(2) = nn(1) + if (nn(4)/=0) en(3) = nn(4) + case (west) + if (nn(2)/=0) en(1) = nn(2) + if (nn(3)/=0) en(4) = nn(3) + case (neast) + if (nn(1)/=0) en(3) = nn(1) + case (seast) + if (nn(4)/=0) en(2) = nn(4) + case (swest) + if (nn(3)/=0) en(1) = nn(3) + case (nwest) + if (nn(2)/=0) en(4) = nn(2) + end select + end if + end do + end do !direction + + do i=1,4 + if (en(i) == 0) then + current_node_num = current_node_num + 1 + en(i) = current_node_num + end if + end do + connectivity(el,:) = en + end do + + if (current_node_num /= (6*ne*ne+2)) then + call endrun('Error in assignment of node numbers: Failed Euler test') + end if +! do el = 1,SIZE(elements) +! elements(el)%node_numbers = connectivity(elements(el)%vertex%number, :) +! end do + end subroutine assign_node_numbers_to_elem + + + ! ================================================ + ! convert_gbl_index: + ! + ! Convert global element index to cube index + ! ================================================ + + subroutine convert_gbl_index(number,ie,je,face_no) + use dimensions_mod, only : ne + integer, intent(in) :: number + integer, intent(out) :: ie,je,face_no + + if (0==ne) call endrun('Error in cube_mod:convert_gbl_index: ne is zero') + + ! inverse of the function: number = 1 + ie + ne*je + ne*ne*(face_no-1) + face_no=((number-1)/(ne*ne))+1 + ie=MODULO(number-1,ne) + je=(number-1)/ne - (face_no-1)*ne + + end subroutine convert_gbl_index + + subroutine CubeTopology(GridEdge, GridVertex) + use gridgraph_mod, only: GridEdge_t, GridVertex_t, initgridedge + use gridgraph_mod, only: allocate_gridvertex_nbrs, deallocate_gridvertex_nbrs + use dimensions_mod, only: np, ne + use spacecurve_mod, only: IsFactorable, genspacecurve + use control_mod, only: north, south, east, west, neast, seast, swest, nwest + !----------------------- + + ! Since GridVertex fields must be allocated before calling this, it + ! must be intent(inout). +!og: is 'target' here necessary? +!GridEdge : changed its 'out' attribute to 'inout' + type (GridEdge_t), intent(inout),target :: GridEdge(:) + type (GridVertex_t), intent(inout),target :: GridVertex(:) + + + integer,allocatable :: Mesh(:,:) + integer,allocatable :: Mesh2(:,:),Mesh2_map(:,:,:),sfcij(:,:) + type (GridVertex_t),allocatable :: GridElem(:,:,:) + integer :: i,j,k,ll,number,irev,ne2,i2,j2,sfc_index + integer :: EdgeWgtP,CornerWgt + integer :: ielem, nedge + integer :: offset, ierr, loc + logical, allocatable :: nbrs_used(:,:,:,:) + + + if (0==ne) call endrun('Error in CubeTopology: ne is zero') + + allocate(GridElem(ne,ne,nfaces),stat=ierr) + do k = 1, nfaces + do j = 1, ne + do i = 1, ne + call allocate_gridvertex_nbrs(GridElem(i,j,k)) + end do + end do + end do + + if(ierr/=0) then + call endrun('error in allocation of GridElem structure') + end if + + allocate(nbrs_used(ne,ne,nfaces,8)) + nbrs_used = .false. + + + number=1 + EdgeWgtP = np + CornerWgt = 1 + do k=1,nfaces + do j=1,ne + do i=1,ne + ! ==================================== + ! Number elements + ! ==================================== + GridElem(i,j,k)%nbrs(:)=0 + GridElem(i,j,k)%nbrs_wgt(:)=0 + GridElem(i,j,k)%nbrs_ptr(:)=0 + GridElem(i,j,k)%nbrs_wgt_ghost(:)=1 ! always this value + GridElem(i,j,k)%SpaceCurve=0 + GridElem(i,j,k)%number=number + number=number+1 + + end do + end do + end do + + allocate(Mesh(ne,ne)) + if(IsFactorable(ne)) then + call GenspaceCurve(Mesh) + else + ! find the smallest ne2 which is a power of 2 and ne2>ne + ne2 = 2**ceiling(log(real(ne)) / log(2.0_r8)) + if (ne2 < ne) then + call endrun('Fatal SFC error') + end if + + allocate(Mesh2(ne2,ne2)) + allocate(Mesh2_map(ne2,ne2,2)) + allocate(sfcij(0:ne2*ne2,2)) + + call GenspaceCurve(Mesh2) ! SFC partition for ne2 + + ! associate every element on the ne x ne mesh (Mesh) + ! with its closest element on the ne2 x ne2 mesh (Mesh2) + ! Store this as a map from Mesh2 -> Mesh in Mesh2_map. + ! elements in Mesh2 which are not mapped get assigned a value of 0 + Mesh2_map=0 + do j=1,ne + do i=1,ne + ! map this element to an (i2,j2) element + ! [ (i-.5)/ne , (j-.5)/ne ] = [ (i2-.5)/ne2 , (j2-.5)/ne2 ] + i2=nint( ((i-0.5_r8)/ne)*ne2 + 0.5_r8 ) + j2=nint( ((j-0.5_r8)/ne)*ne2 + 0.5_r8 ) + if (i2<1) i2=1 + if (i2>ne2) i2=ne2 + if (j2<1) j2=1 + if (j2>ne2) j2=ne2 + Mesh2_map(i2,j2,1)=i + Mesh2_map(i2,j2,2)=j + enddo + enddo + + ! create a reverse index array for Mesh2 + ! k = Mesh2(i,j) + ! (i,j) = (sfcij(k,1),sfci(k,2)) + do j=1,ne2 + do i=1,ne2 + k=Mesh2(i,j) + sfcij(k,1)=i + sfcij(k,2)=j + enddo + enddo + + ! generate a SFC for Mesh with the same ordering as the + ! elements in Mesh2 which map to Mesh. + sfc_index=0 + do k=0,ne2*ne2-1 + i2=sfcij(k,1) + j2=sfcij(k,2) + i=Mesh2_map(i2,j2,1) + j=Mesh2_map(i2,j2,2) + if (i/=0) then + ! (i2,j2) element maps to (i,j) element + Mesh(i,j)=sfc_index + sfc_index=sfc_index+1 + endif + enddo + + deallocate(Mesh2) + deallocate(Mesh2_map) + deallocate(sfcij) + endif + + ! ------------------------------------------- + ! Setup the space-filling curve for face 1 + ! ------------------------------------------- + offset=0 + do j=1,ne + do i=1,ne + GridElem(i,j,1)%SpaceCurve = offset + Mesh(i,ne-j+1) + enddo + enddo + + ! ------------------------------------------- + ! Setup the space-filling curve for face 2 + ! ------------------------------------------- + offset = offset + ne*ne + do j=1,ne + do i=1,ne + GridElem(i,j,2)%SpaceCurve = offset + Mesh(i,ne-j+1) + enddo + enddo + + ! ------------------------------------------- + ! Setup the space-filling curve for face 6 + ! ------------------------------------------- + offset = offset + ne*ne + do j=1,ne + do i=1,ne + GridElem(i,j,6)%SpaceCurve = offset + Mesh(ne-i+1,ne-j+1) + enddo + enddo + + ! ------------------------------------------- + ! Setup the space-filling curve for face 4 + ! ------------------------------------------- + offset = offset + ne*ne + do j=1,ne + do i=1,ne + GridElem(i,j,4)%SpaceCurve = offset + Mesh(ne-j+1,i) + enddo + enddo + + ! ------------------------------------------- + ! Setup the space-filling curve for face 5 + ! ------------------------------------------- + offset = offset + ne*ne + do j=1,ne + do i=1,ne + GridElem(i,j,5)%SpaceCurve = offset + Mesh(i,j) + enddo + enddo + + + ! ------------------------------------------- + ! Setup the space-filling curve for face 3 + ! ------------------------------------------- + offset = offset + ne*ne + do j=1,ne + do i=1,ne + GridElem(i,j,3)%SpaceCurve = offset + Mesh(i,j) + enddo + enddo + + ! ================== + ! face interiors + ! ================== + do k=1,6 + ! setup SOUTH, WEST, SW neighbors + do j=2,ne + do i=2,ne + nbrs_used(i,j,k,west) = .true. + nbrs_used(i,j,k,south) = .true. + nbrs_used(i,j,k,swest) = .true. + + + GridElem(i,j,k)%nbrs(west) = GridElem(i-1,j,k)%number + GridElem(i,j,k)%nbrs_face(west) = k + GridElem(i,j,k)%nbrs_wgt(west) = EdgeWgtP + GridElem(i,j,k)%nbrs(south) = GridElem(i,j-1,k)%number + GridElem(i,j,k)%nbrs_face(south) = k + GridElem(i,j,k)%nbrs_wgt(south) = EdgeWgtP + GridElem(i,j,k)%nbrs(swest) = GridElem(i-1,j-1,k)%number + GridElem(i,j,k)%nbrs_face(swest) = k + GridElem(i,j,k)%nbrs_wgt(swest) = CornerWgt + end do + end do + + ! setup EAST, NORTH, NE neighbors + do j=1,ne-1 + do i=1,ne-1 + nbrs_used(i,j,k,east) = .true. + nbrs_used(i,j,k,north) = .true. + nbrs_used(i,j,k,neast) = .true. + + GridElem(i,j,k)%nbrs(east) = GridElem(i+1,j,k)%number + GridElem(i,j,k)%nbrs_face(east) = k + GridElem(i,j,k)%nbrs_wgt(east) = EdgeWgtP + GridElem(i,j,k)%nbrs(north) = GridElem(i,j+1,k)%number + GridElem(i,j,k)%nbrs_face(north) = k + GridElem(i,j,k)%nbrs_wgt(north) = EdgeWgtP + GridElem(i,j,k)%nbrs(neast) = GridElem(i+1,j+1,k)%number + GridElem(i,j,k)%nbrs_face(neast) = k + GridElem(i,j,k)%nbrs_wgt(neast) = CornerWgt + end do + end do + + ! Setup the remaining SOUTH, EAST, and SE neighbors + do j=2,ne + do i=1,ne-1 + nbrs_used(i,j,k,south) = .true. + nbrs_used(i,j,k,east) = .true. + nbrs_used(i,j,k,seast) = .true. + + + + GridElem(i,j,k)%nbrs(south) = GridElem(i,j-1,k)%number + GridElem(i,j,k)%nbrs_face(south) = k + GridElem(i,j,k)%nbrs_wgt(south) = EdgeWgtP + GridElem(i,j,k)%nbrs(east) = GridElem(i+1,j,k)%number + GridElem(i,j,k)%nbrs_face(east) = k + GridElem(i,j,k)%nbrs_wgt(east) = EdgeWgtP + GridElem(i,j,k)%nbrs(seast) = GridElem(i+1,j-1,k)%number + GridElem(i,j,k)%nbrs_face(seast) = k + GridElem(i,j,k)%nbrs_wgt(seast) = CornerWgt + enddo + enddo + + ! Setup the remaining NORTH, WEST, and NW neighbors + do j=1,ne-1 + do i=2,ne + nbrs_used(i,j,k,north) = .true. + nbrs_used(i,j,k,west) = .true. + nbrs_used(i,j,k,nwest) = .true. + + + + GridElem(i,j,k)%nbrs(north) = GridElem(i,j+1,k)%number + GridElem(i,j,k)%nbrs_face(north) = k + GridElem(i,j,k)%nbrs_wgt(north) = EdgeWgtP + GridElem(i,j,k)%nbrs(west) = GridElem(i-1,j,k)%number + GridElem(i,j,k)%nbrs_face(west) = k + GridElem(i,j,k)%nbrs_wgt(west) = EdgeWgtP + GridElem(i,j,k)%nbrs(nwest) = GridElem(i-1,j+1,k)%number + GridElem(i,j,k)%nbrs_face(nwest) = k + GridElem(i,j,k)%nbrs_wgt(nwest) = CornerWgt + enddo + enddo + end do + + ! ====================== + ! west/east "belt" edges + ! ====================== + + do k=1,4 + do j=1,ne + nbrs_used(1,j,k,west) = .true. + nbrs_used(ne,j,k,east) = .true. + + + GridElem(1 ,j,k)%nbrs(west) = GridElem(ne,j,MODULO(2+k,4)+1)%number + GridElem(1 ,j,k)%nbrs_face(west) = MODULO(2+k,4)+1 + GridElem(1 ,j,k)%nbrs_wgt(west) = EdgeWgtP + GridElem(ne,j,k)%nbrs(east) = GridElem(1 ,j,MODULO(k ,4)+1)%number + GridElem(ne,j,k)%nbrs_face(east) = MODULO(k ,4)+1 + GridElem(ne,j,k)%nbrs_wgt(east) = EdgeWgtP + + ! Special rules for corner 'edges' + if( j /= 1) then + nbrs_used(1,j,k,swest) = .true. + nbrs_used(ne,j,k,seast) = .true. + + + GridElem(1 ,j,k)%nbrs(swest) = GridElem(ne,j-1,MODULO(2+k,4)+1)%number + GridElem(1 ,j,k)%nbrs_face(swest) = MODULO(2+k,4)+1 + GridElem(1 ,j,k)%nbrs_wgt(swest) = CornerWgt + GridElem(ne,j,k)%nbrs(seast) = GridElem(1 ,j-1,MODULO(k ,4)+1)%number + GridElem(ne,j,k)%nbrs_face(seast) = MODULO(k ,4)+1 + GridElem(ne,j,k)%nbrs_wgt(seast) = CornerWgt + endif + if( j /= ne) then + nbrs_used(1,j,k,nwest) = .true. + nbrs_used(ne,j,k,neast) = .true. + + + GridElem(1 ,j,k)%nbrs(nwest) = GridElem(ne,j+1,MODULO(2+k,4)+1)%number + GridElem(1 ,j,k)%nbrs_face(nwest) = MODULO(2+k,4)+1 + GridElem(1 ,j,k)%nbrs_wgt(nwest) = CornerWgt + GridElem(ne,j,k)%nbrs(neast) = GridElem(1 ,j+1,MODULO(k ,4)+1)%number + GridElem(ne,j,k)%nbrs_face(neast) = MODULO(k ,4)+1 + GridElem(ne,j,k)%nbrs_wgt(neast) = CornerWgt + endif + end do + end do + + + ! ================================== + ! south edge of 1 / north edge of 5 + ! ================================== + + do i=1,ne + nbrs_used(i,1,1,south) = .true. + nbrs_used(i,ne,5,north) = .true. + + GridElem(i,1 ,1)%nbrs(south) = GridElem(i,ne,5)%number + GridElem(i,1 ,1)%nbrs_face(south) = 5 + GridElem(i,1 ,1)%nbrs_wgt(south) = EdgeWgtP + GridElem(i,ne,5)%nbrs(north) = GridElem(i,1 ,1)%number + GridElem(i,ne,5)%nbrs_face(north) = 1 + GridElem(i,ne,5)%nbrs_wgt(north) = EdgeWgtP + + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,1,1,swest) = .true. + nbrs_used(i,ne,5,nwest) = .true. + + GridElem(i,1 ,1)%nbrs(swest) = GridElem(i-1,ne,5)%number + GridElem(i,1 ,1)%nbrs_face(swest) = 5 + GridElem(i,1 ,1)%nbrs_wgt(swest) = CornerWgt + GridElem(i,ne,5)%nbrs(nwest) = GridElem(i-1,1 ,1)%number + GridElem(i,ne,5)%nbrs_face(nwest) = 1 + GridElem(i,ne,5)%nbrs_wgt(nwest) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,1,1,seast) = .true. + nbrs_used(i,ne,5,neast) = .true. + + GridElem(i,1 ,1)%nbrs(seast) = GridElem(i+1,ne,5)%number + GridElem(i,1 ,1)%nbrs_face(seast) = 5 + GridElem(i,1 ,1)%nbrs_wgt(seast) = CornerWgt + GridElem(i,ne,5)%nbrs(neast) = GridElem(i+1,1 ,1)%number + GridElem(i,ne,5)%nbrs_face(neast) = 1 + GridElem(i,ne,5)%nbrs_wgt(neast) = CornerWgt + endif + + end do + + ! ================================== + ! south edge of 2 / east edge of 5 + ! ================================== + + do i=1,ne + irev=ne+1-i + nbrs_used(i,1,2,south) = .true. + nbrs_used(ne,i,5,east) = .true. + + + GridElem(i,1 ,2)%nbrs(south) = GridElem(ne,irev,5)%number + GridElem(i,1 ,2)%nbrs_face(south) = 5 + GridElem(i,1 ,2)%nbrs_wgt(south) = EdgeWgtP + GridElem(ne,i,5)%nbrs(east) = GridElem(irev,1 ,2)%number + GridElem(ne,i,5)%nbrs_face(east) = 2 + GridElem(ne,i,5)%nbrs_wgt(east) = EdgeWgtP + + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,1,2,swest) = .true. + nbrs_used(ne,i,5,seast) = .true. + + + GridElem(i,1 ,2)%nbrs(swest) = GridElem(ne,irev+1,5)%number + GridElem(i,1 ,2)%nbrs_face(swest) = 5 + GridElem(i,1 ,2)%nbrs_wgt(swest) = CornerWgt + GridElem(ne,i,5)%nbrs(seast) = GridElem(irev+1,1 ,2)%number + GridElem(ne,i,5)%nbrs_face(seast) = 2 + GridElem(ne,i,5)%nbrs_wgt(seast) = CornerWgt + endif + if(i /= ne) then + nbrs_used(i,1,2,seast) = .true. + nbrs_used(ne,i,5,neast) = .true. + + + GridElem(i,1 ,2)%nbrs(seast) = GridElem(ne,irev-1,5)%number + GridElem(i,1 ,2)%nbrs_face(seast) = 5 + GridElem(i,1 ,2)%nbrs_wgt(seast) = CornerWgt + GridElem(ne,i,5)%nbrs(neast) = GridElem(irev-1,1 ,2)%number + GridElem(ne,i,5)%nbrs_face(neast) = 2 + GridElem(ne,i,5)%nbrs_wgt(neast) = CornerWgt + endif + enddo + ! ================================== + ! south edge of 3 / south edge of 5 + ! ================================== + + do i=1,ne + irev=ne+1-i + nbrs_used(i,1,3,south) = .true. + nbrs_used(i,1,5,south) = .true. + + GridElem(i,1,3)%nbrs(south) = GridElem(irev,1,5)%number + GridElem(i,1,3)%nbrs_face(south) = 5 + GridElem(i,1,3)%nbrs_wgt(south) = EdgeWgtP + GridElem(i,1,5)%nbrs(south) = GridElem(irev,1,3)%number + GridElem(i,1,5)%nbrs_face(south) = 3 + GridElem(i,1,5)%nbrs_wgt(south) = EdgeWgtP + + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,1,3,swest) = .true. + nbrs_used(i,1,5,swest) = .true. + + + GridElem(i,1,3)%nbrs(swest) = GridElem(irev+1,1,5)%number + GridElem(i,1,3)%nbrs_face(swest) = 5 + GridElem(i,1,3)%nbrs_wgt(swest) = CornerWgt + GridElem(i,1,5)%nbrs(swest) = GridElem(irev+1,1,3)%number + GridElem(i,1,5)%nbrs_face(swest) = 3 + GridElem(i,1,5)%nbrs_wgt(swest) = CornerWgt + endif + if(i /= ne) then + nbrs_used(i,1,3,seast) = .true. + nbrs_used(i,1,5,seast) = .true. + + GridElem(i,1,3)%nbrs(seast) = GridElem(irev-1,1,5)%number + GridElem(i,1,3)%nbrs_face(seast) = 5 + GridElem(i,1,3)%nbrs_wgt(seast) = CornerWgt + GridElem(i,1,5)%nbrs(seast) = GridElem(irev-1,1,3)%number + GridElem(i,1,5)%nbrs_face(seast) = 3 + GridElem(i,1,5)%nbrs_wgt(seast) = CornerWgt + endif + end do + + ! ================================== + ! south edge of 4 / west edge of 5 + ! ================================== + + do i=1,ne + irev=ne+1-i + nbrs_used(i,1,4,south) = .true. + nbrs_used(1,i,5,west) = .true. + + GridElem(i,1,4)%nbrs(south) = GridElem(1,i,5)%number + GridElem(i,1,4)%nbrs_face(south) = 5 + GridElem(i,1,4)%nbrs_wgt(south) = EdgeWgtP + GridElem(1,i,5)%nbrs(west) = GridElem(i,1,4)%number + GridElem(1,i,5)%nbrs_face(west) = 4 + GridElem(1,i,5)%nbrs_wgt(west) = EdgeWgtP + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,1,4,swest) = .true. + nbrs_used(1,i,5,swest) = .true. + + GridElem(i,1,4)%nbrs(swest) = GridElem(1,i-1,5)%number + GridElem(i,1,4)%nbrs_face(swest) = 5 + GridElem(i,1,4)%nbrs_wgt(swest) = CornerWgt + GridElem(1,i,5)%nbrs(swest) = GridElem(i-1,1,4)%number + GridElem(1,i,5)%nbrs_face(swest) = 4 + GridElem(1,i,5)%nbrs_wgt(swest) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,1,4,seast) = .true. + nbrs_used(1,i,5,nwest) = .true. + + GridElem(i,1,4)%nbrs(seast) = GridElem(1,i+1,5)%number + GridElem(i,1,4)%nbrs_face(seast) = 5 + GridElem(i,1,4)%nbrs_wgt(seast) = CornerWgt + GridElem(1,i,5)%nbrs(nwest) = GridElem(i+1,1,4)%number + GridElem(1,i,5)%nbrs_face(nwest) = 4 + GridElem(1,i,5)%nbrs_wgt(nwest) = CornerWgt + endif + end do + + ! ================================== + ! north edge of 1 / south edge of 6 + ! ================================== + + do i=1,ne + nbrs_used(i,ne,1,north) = .true. + nbrs_used(i,1,6,south) = .true. + + + GridElem(i,ne,1)%nbrs(north) = GridElem(i,1 ,6)%number + GridElem(i,ne,1)%nbrs_face(north) = 6 + GridElem(i,ne,1)%nbrs_wgt(north) = EdgeWgtP + GridElem(i,1 ,6)%nbrs(south) = GridElem(i,ne,1)%number + GridElem(i,1 ,6)%nbrs_face(south) = 1 + GridElem(i,1 ,6)%nbrs_wgt(south) = EdgeWgtP + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,ne,1,nwest) = .true. + nbrs_used(i,1,6,swest) = .true. + + GridElem(i,ne,1)%nbrs(nwest) = GridElem(i-1,1 ,6)%number + GridElem(i,ne,1)%nbrs_face(nwest) = 6 + GridElem(i,ne,1)%nbrs_wgt(nwest) = CornerWgt + GridElem(i,1 ,6)%nbrs(swest) = GridElem(i-1,ne,1)%number + GridElem(i,1 ,6)%nbrs_face(swest) = 1 + GridElem(i,1 ,6)%nbrs_wgt(swest) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,ne,1,neast) = .true. + nbrs_used(i,1,6,seast) = .true. + + + GridElem(i,ne,1)%nbrs(neast) = GridElem(i+1,1 ,6)%number + GridElem(i,ne,1)%nbrs_face(neast) = 6 + GridElem(i,ne,1)%nbrs_wgt(neast) = CornerWgt + GridElem(i,1 ,6)%nbrs(seast) = GridElem(i+1,ne,1)%number + GridElem(i,1 ,6)%nbrs_face(seast) = 1 + GridElem(i,1 ,6)%nbrs_wgt(seast) = CornerWgt + endif + end do + + ! ================================== + ! north edge of 2 / east edge of 6 + ! ================================== + + do i=1,ne + nbrs_used(i,ne,2,north) = .true. + nbrs_used(ne,i,6,east ) = .true. + + GridElem(i,ne,2)%nbrs(north) = GridElem(ne,i,6)%number + GridElem(i,ne,2)%nbrs_face(north) = 6 + GridElem(i,ne,2)%nbrs_wgt(north) = EdgeWgtP + GridElem(ne,i,6)%nbrs(east) = GridElem(i,ne,2)%number + GridElem(ne,i,6)%nbrs_face(east) = 2 + GridElem(ne,i,6)%nbrs_wgt(east) = EdgeWgtP + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,ne,2,nwest) = .true. + nbrs_used(ne,i,6,seast) = .true. + + GridElem(i,ne,2)%nbrs(nwest) = GridElem(ne,i-1,6)%number + GridElem(i,ne,2)%nbrs_face(nwest) = 6 + GridElem(i,ne,2)%nbrs_wgt(nwest) = CornerWgt + GridElem(ne,i,6)%nbrs(seast) = GridElem(i-1,ne,2)%number + GridElem(ne,i,6)%nbrs_face(seast) = 2 + GridElem(ne,i,6)%nbrs_wgt(seast) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,ne,2,neast) = .true. + nbrs_used(ne,i,6,neast) = .true. + + + GridElem(i,ne,2)%nbrs(neast) = GridElem(ne,i+1,6)%number + GridElem(i,ne,2)%nbrs_face(neast) = 6 + GridElem(i,ne,2)%nbrs_wgt(neast) = CornerWgt + GridElem(ne,i,6)%nbrs(neast) = GridElem(i+1,ne,2)%number + GridElem(ne,i,6)%nbrs_face(neast) = 2 + GridElem(ne,i,6)%nbrs_wgt(neast) = CornerWgt + endif + end do + + ! =================================== + ! north edge of 3 / north edge of 6 + ! =================================== + + do i=1,ne + irev=ne+1-i + nbrs_used(i,ne,3,north) = .true. + nbrs_used(i,ne,6,north) = .true. + + GridElem(i,ne,3)%nbrs(north) = GridElem(irev,ne,6)%number + GridElem(i,ne,3)%nbrs_face(north) = 6 + GridElem(i,ne,3)%nbrs_wgt(north) = EdgeWgtP + GridElem(i,ne,6)%nbrs(north) = GridElem(irev,ne,3)%number + GridElem(i,ne,6)%nbrs_face(north) = 3 + GridElem(i,ne,6)%nbrs_wgt(north) = EdgeWgtP + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,ne,3,nwest) = .true. + nbrs_used(i,ne,6,nwest) = .true. + + GridElem(i,ne,3)%nbrs(nwest) = GridElem(irev+1,ne,6)%number + GridElem(i,ne,3)%nbrs_face(nwest) = 6 + GridElem(i,ne,3)%nbrs_wgt(nwest) = CornerWgt + GridElem(i,ne,6)%nbrs(nwest) = GridElem(irev+1,ne,3)%number + GridElem(i,ne,6)%nbrs_face(nwest) = 3 + GridElem(i,ne,6)%nbrs_wgt(nwest) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,ne,3,neast) = .true. + nbrs_used(i,ne,6,neast) = .true. + + GridElem(i,ne,3)%nbrs(neast) = GridElem(irev-1,ne,6)%number + GridElem(i,ne,3)%nbrs_face(neast) = 6 + GridElem(i,ne,3)%nbrs_wgt(neast) = CornerWgt + GridElem(i,ne,6)%nbrs(neast) = GridElem(irev-1,ne,3)%number + GridElem(i,ne,6)%nbrs_face(neast) = 3 + GridElem(i,ne,6)%nbrs_wgt(neast) = CornerWgt + endif + end do + + ! =================================== + ! north edge of 4 / west edge of 6 + ! =================================== + + do i=1,ne + irev=ne+1-i + nbrs_used(i,ne,4,north) = .true. + nbrs_used(1,i,6,west) = .true. + + GridElem(i,ne,4)%nbrs(north) = GridElem(1,irev,6)%number + GridElem(i,ne,4)%nbrs_face(north) = 6 + GridElem(i,ne,4)%nbrs_wgt(north) = EdgeWgtP + GridElem(1,i,6)%nbrs(west) = GridElem(irev,ne,4)%number + GridElem(1,i,6)%nbrs_face(west) = 4 + GridElem(1,i,6)%nbrs_wgt(west) = EdgeWgtP + ! Special rules for corner 'edges' + if( i /= 1) then + nbrs_used(i,ne,4,nwest) = .true. + nbrs_used(1,i,6,swest) = .true. + + GridElem(i,ne,4)%nbrs(nwest) = GridElem(1,irev+1,6)%number + GridElem(i,ne,4)%nbrs_face(nwest) = 6 + GridElem(i,ne,4)%nbrs_wgt(nwest) = CornerWgt + GridElem(1,i,6)%nbrs(swest) = GridElem(irev+1,ne,4)%number + GridElem(1,i,6)%nbrs_face(swest) = 4 + GridElem(1,i,6)%nbrs_wgt(swest) = CornerWgt + endif + if( i /= ne) then + nbrs_used(i,ne,4,neast) = .true. + nbrs_used(1,i,6,nwest) = .true. + + GridElem(i,ne,4)%nbrs(neast) = GridElem(1,irev-1,6)%number + GridElem(i,ne,4)%nbrs_face(neast) = 6 + GridElem(i,ne,4)%nbrs_wgt(neast) = CornerWgt + GridElem(1,i,6)%nbrs(nwest) = GridElem(irev-1,ne,4)%number + GridElem(1,i,6)%nbrs_face(nwest) = 4 + GridElem(1,i,6)%nbrs_wgt(nwest) = CornerWgt + endif + end do + + + ielem = 1 ! Element counter + do k=1,6 + do j=1,ne + do i=1,ne + GridVertex(ielem)%nbrs_ptr(1) = 1 + do ll=1,8 + loc = GridVertex(ielem)%nbrs_ptr(ll) + if (nbrs_used(i,j,k,ll)) then + GridVertex(ielem)%nbrs(loc) = GridElem(i,j,k)%nbrs(ll) + GridVertex(ielem)%nbrs_face(loc) = GridElem(i,j,k)%nbrs_face(ll) + GridVertex(ielem)%nbrs_wgt(loc) = GridElem(i,j,k)%nbrs_wgt(ll) + GridVertex(ielem)%nbrs_wgt_ghost(loc) = GridElem(i,j,k)%nbrs_wgt_ghost(ll) + + GridVertex(ielem)%nbrs_ptr(ll+1) = GridVertex(ielem)%nbrs_ptr(ll)+1 + else + GridVertex(ielem)%nbrs_ptr(ll+1) = GridVertex(ielem)%nbrs_ptr(ll) + end if + end do + GridVertex(ielem)%number = GridElem(i,j,k)%number + GridVertex(ielem)%processor_number = 0 + GridVertex(ielem)%SpaceCurve = GridElem(i,j,k)%SpaceCurve + ielem=ielem+1 + end do + end do + end do + + DEALLOCATE(Mesh) + do k = 1, nfaces + do j = 1, ne + do i = 1, ne + call deallocate_gridvertex_nbrs(GridElem(i,j,k)) + end do + end do + end do + DEALLOCATE(GridElem) + DEALLOCATE(nbrs_used) + + ! ======================================= + ! Generate cube graph... + ! ======================================= + + ! ============================================ + ! Setup the Grid edges (topology independent) + ! ============================================ + call initgridedge(GridEdge,GridVertex) + + ! ============================================ + ! Setup the Grid edge Indirect addresses + ! (topology dependent) + ! ============================================ + nedge = SIZE(GridEdge) + do i=1,nedge + call CubeSetupEdgeIndex(GridEdge(i)) + enddo + + end subroutine CubeTopology + + ! =================================================================== + ! CubeEdgeCount: + ! + ! Determine the number of Grid Edges + ! + ! =================================================================== + + function CubeEdgeCount() result(nedge) + use dimensions_mod, only : ne + implicit none + integer :: nedge + + if (0==ne) call endrun('Error in CubeEdgeCount: ne is zero') + nedge = nfaces*(ne*ne*nInnerElemEdge - nCornerElemEdge) + + end function CubeEdgeCount + + ! =================================================================== + ! CubeElemCount: + ! + ! Determine the number of Grid Elem + ! + ! =================================================================== + + function CubeElemCount() result(nelem) + + use dimensions_mod, only : ne + + implicit none + integer :: nelem + if (0==ne) call endrun('Error in CubeElemCount: ne is zero') + + nelem = nfaces*ne*ne + end function CubeElemCount + + subroutine CubeSetupEdgeIndex(Edge) + use gridgraph_mod, only : gridedge_t + use dimensions_mod, only : np + use control_mod, only : north, south, east, west, neast, seast, swest, nwest + type (GridEdge_t),target :: Edge + + integer :: np0,sFace,dFace + logical :: reverse + integer,allocatable :: forwardV(:), forwardP(:) + integer,allocatable :: backwardV(:), backwardP(:) + + sFace = Edge%tail_face + dFace = Edge%head_face + ! Do not reverse the indices + reverse=.FALSE. + + ! Under special conditions use index reversal + if( (SFace == south .AND. dFace == east) & + .OR. (sFace == east .AND. dFace == south) & + .OR. (sFace == north .AND. dFace == west) & + .OR. (sFace == west .AND. dFace == north) & + .OR. (sFace == south .AND. dFace == south) & + .OR. (sFace == north .AND. dFace == north) & + .OR. (sFace == east .AND. dFace == east ) & + .OR. (sFace == west .AND. dFace == west ) ) then + reverse=.TRUE. + Edge%reverse=.TRUE. + endif + + + end subroutine CubeSetupEdgeIndex + +! +! HOMME mapping from sphere (or other manifold) to reference element +! one should be able to add any mapping here. For each new map, +! an associated dmap() routine (which computes the map derivative matrix) +! must also be written +! Note that for conservation, the parameterization of element edges must be +! identical for adjacent elements. (this is violated with HOMME's default +! equi-angular cubed-sphere mapping for non-cubed sphere grids, hence the +! need for a new map) +! + function ref2sphere(a,b, corners3D, ref_map, corners, facenum) result(sphere) + real(kind=r8) :: a,b + type (spherical_polar_t) :: sphere + type (cartesian3d_t) :: corners3D(4) + integer :: ref_map + ! only needed for gnominic maps + type (cartesian2d_t), optional :: corners(4) + integer, optional :: facenum + + + if (ref_map==0) then + if (.not. present(corners) ) & + call endrun('ref2sphere(): missing arguments for equiangular map') + sphere = ref2sphere_equiangular(a,b,corners,facenum) + elseif (ref_map==1) then + call endrun('gnomonic map not yet coded') + elseif (ref_map==2) then + sphere = ref2sphere_elementlocal(a,b,corners3D) + else + call endrun('ref2sphere(): bad value of ref_map') + endif + end function ref2sphere + +! +! map a point in the referece element to the sphere +! + function ref2sphere_equiangular(a,b, corners, face_no) result(sphere) + implicit none + real(kind=r8) :: a,b + integer,intent(in) :: face_no + type (spherical_polar_t) :: sphere + type (cartesian2d_t) :: corners(4) + ! local + real(kind=r8) :: pi,pj,qi,qj + type (cartesian2d_t) :: cart + + ! map (a,b) to the [-pi/2,pi/2] equi angular cube face: x1,x2 + ! a = gp%points(i) + ! b = gp%points(j) + pi = (1-a)/2 + pj = (1-b)/2 + qi = (1+a)/2 + qj = (1+b)/2 + cart%x = pi*pj*corners(1)%x & + + qi*pj*corners(2)%x & + + qi*qj*corners(3)%x & + + pi*qj*corners(4)%x + cart%y = pi*pj*corners(1)%y & + + qi*pj*corners(2)%y & + + qi*qj*corners(3)%y & + + pi*qj*corners(4)%y + ! map from [pi/2,pi/2] equ angular cube face to sphere: + sphere=projectpoint(cart,face_no) + + end function ref2sphere_equiangular + +!----------------------------------------------------------------------------------------- +! ELEMENT LOCAL MAP (DOES NOT USE CUBE FACES) +! unlike gnomonic equiangular map, this map will map all straight lines to +! great circle arcs +! +! map a point in the referece element to the quad on the sphere by a +! general map, without using faces the map works this way: first, fix +! a coordinate (say, X). Map 4 corners of the ref element (corners are +! (-1,-1),(-1,1),(1,1), and (1,-1)) into 4 X-components of the quad in +! physical space via a bilinear map. Do so for Y and Z components as +! well. It produces a map: Ref element (\xi, \eta) ---> A quad in XYZ +! (ess, a piece of a twisted plane) with vertices of our target quad. though +! the quad lies in a plane and not on the sphere manifold, its +! vertices belong to the sphere (by initial conditions). The last step +! is to utilize a map (X,Y,X) --> (X,Y,Z)/SQRT(X**2+Y**2+Z**2) to +! project the quad to the unit sphere. +! ----------------------------------------------------------------------------------------- + function ref2sphere_elementlocal(a,b, corners3D) result(sphere) + use element_mod, only : element_t + implicit none + real(kind=r8) :: a,b + type (cartesian3d_t) :: corners3D(4) + type (spherical_polar_t) :: sphere + real(kind=r8) :: q(4) ! local + + q(1)=(1-a)*(1-b); q(2)=(1+a)*(1-b); q(3)=(1+a)*(1+b); q(4)=(1-a)*(1+b); + q=q/4.0_r8; + sphere = ref2sphere_elementlocal_q(q,corners3D) + end function ref2sphere_elementlocal + + function ref2sphere_elementlocal_q(q, corners) result(sphere) + implicit none + real(kind=r8) :: q(4) + type (spherical_polar_t) :: sphere + type (cartesian3d_t) :: corners(4) + ! local + type (cartesian3d_t) :: cart + real(kind=r8) :: c(3,4), xx(3), r + integer :: i + +!3D corners fo the quad + c(1,1)=corners(1)%x; c(2,1)=corners(1)%y; c(3,1)=corners(1)%z; + c(1,2)=corners(2)%x; c(2,2)=corners(2)%y; c(3,2)=corners(2)%z; + c(1,3)=corners(3)%x; c(2,3)=corners(3)%y; c(3,3)=corners(3)%z; + c(1,4)=corners(4)%x; c(2,4)=corners(4)%y; c(3,4)=corners(4)%z; + +!physical point on a plane (sliced), not yet on the sphere + do i=1,3 + xx(i)=sum(c(i,:)*q(:)) + end do + +!distance from the plane point to the origin + r = sqrt(xx(1)**2+xx(2)**2+xx(3)**2) + +!projecting the plane point to the sphere + cart%x=xx(1)/r; cart%y=xx(2)/r; cart%z=xx(3)/r; + +!XYZ coords of the point to lon/lat + sphere=change_coordinates(cart) + + end function ref2sphere_elementlocal_q + +end module cube_mod diff --git a/src/dynamics/se/dycore/derivative_mod.F90 b/src/dynamics/se/dycore/derivative_mod.F90 new file mode 100644 index 0000000000..c6a9f5a744 --- /dev/null +++ b/src/dynamics/se/dycore/derivative_mod.F90 @@ -0,0 +1,2474 @@ +module derivative_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_abortutils, only: endrun + use dimensions_mod, only : np, nc, npdg, nelemd, nlev + use quadrature_mod, only : quadrature_t, gauss, gausslobatto,legendre, jacobi + ! needed for spherical differential operators: + use physconst, only: ra + use element_mod, only : element_t + use control_mod, only : hypervis_scaling, hypervis_power + use perf_mod, only : t_startf, t_stopf + +implicit none +private + + type, public :: derivative_t + real (kind=r8) :: Dvv(np,np) + real (kind=r8) :: Dvv_diag(np,np) + real (kind=r8) :: Dvv_twt(np,np) + real (kind=r8) :: Mvv_twt(np,np) ! diagonal matrix of GLL weights + real (kind=r8) :: Mfvm(np,nc+1) + real (kind=r8) :: Cfvm(np,nc) + real (kind=r8) :: legdg(np,np) + end type derivative_t + + type, public :: derivative_stag_t + real (kind=r8) :: D(np,np) + real (kind=r8) :: M(np,np) + real (kind=r8) :: Dpv(np,np) + real (kind=r8) :: D_twt(np,np) + real (kind=r8) :: M_twt(np,np) + real (kind=r8) :: M_t(np,np) + end type derivative_stag_t + + real (kind=r8), allocatable :: integration_matrix(:,:) + real (kind=r8), allocatable :: integration_matrix_physgrid(:,:) + real (kind=r8), allocatable :: boundary_interp_matrix(:,:,:) + +! ====================================== +! Public Interfaces +! ====================================== + + public :: subcell_integration + public :: subcell_dss_fluxes + public :: subcell_div_fluxes + public :: subcell_Laplace_fluxes + public :: allocate_subcell_integration_matrix_cslam !for consistent se-cslam algorithm + public :: allocate_subcell_integration_matrix_physgrid !for integration se basis functions over physgrid control volumes + + public :: derivinit + + public :: gradient + public :: gradient_wk + public :: vorticity + public :: divergence + + public :: interpolate_gll2fvm_corners + public :: interpolate_gll2fvm_points + public :: remap_phys2gll + + + interface divergence + module procedure divergence_nonstag + module procedure divergence_stag + end interface + + interface gradient + module procedure gradient_str_nonstag + module procedure gradient_str_stag + end interface + + interface gradient_wk + module procedure gradient_wk_nonstag + module procedure gradient_wk_stag + end interface + + public :: v2pinit + + private :: dmatinit + private :: dvvinit + private :: dpvinit + +! these routines compute spherical differential operators as opposed to +! the gnomonic coordinate operators above. Vectors (input or output) +! are always expressed in lat-lon coordinates +! +! note that weak derivatives (integrated by parts form) can be defined using +! contra or co-variant test functions, so +! + public :: gradient_sphere + public :: gradient_sphere_wk_testcov + public :: gradient_sphere_wk_testcontra ! only used for debugging + public :: ugradv_sphere + public :: vorticity_sphere + public :: vorticity_sphere_diag + public :: divergence_sphere + public :: curl_sphere + public :: curl_sphere_wk_testcov + public :: divergence_sphere_wk + public :: laplace_sphere_wk + public :: vlaplace_sphere_wk + public :: element_boundary_integral + public :: edge_flux_u_cg + public :: gll_to_dgmodal + public :: dgmodal_to_gll + + public :: limiter_optim_iter_full + +contains + +! ========================================== +! derivinit: +! +! Initialize the matrices for taking +! derivatives and interpolating +! ========================================== + + subroutine derivinit(deriv,fvm_corners, fvm_points) + type (derivative_t) :: deriv + real (kind=r8),optional :: fvm_corners(nc+1) + real (kind=r8),optional :: fvm_points(nc) + + ! Local variables + type (quadrature_t) :: gp ! Quadrature points and weights on pressure grid + + real (kind=r8) :: dmat(np,np) + real (kind=r8) :: dpv(np,np) + real (kind=r8) :: v2p(np,np) + real (kind=r8) :: p2v(np,np) + real (kind=r8) :: dvv(np,np) + real (kind=r8) :: dvv_diag(np,np) + real (kind=r8) :: v2v(np,np) + real (kind=r8) :: xnorm + integer i,j + + ! ============================================ + ! initialize matrices in r8 precision + ! and transfer results into r8 + ! floating point precision + ! ============================================ + + gp=gausslobatto(np) + + ! Legendre polynomials of degree npdg-1, on the np GLL grid: + if (npdg>np) call endrun( 'FATAL ERROR: npdg>np') + if (npdg>0 .and. npdgp +! derivative matrix (dmat) +! ======================================= + + subroutine dmatinit(dmat) + + real (kind=r8) :: dmat(np,np) + + ! Local variables + + type (quadrature_t) :: gll + type (quadrature_t) :: gs + + integer i,j + real(kind=r8) fact,f1,f2 + real(kind=r8) func0,func1 + real(kind=r8) dis,c0,c1 + + real(kind=r8) :: leg(np,np) + real(kind=r8) :: jac(0:np-1) + real(kind=r8) :: djac(0:np-1) + + c0 = 0.0_r8 + c1 = 1.0_r8 + + gll= gausslobatto(np) + gs = gauss(np) + + ! ============================================================= + ! Compute Legendre polynomials on Gauss-Lobatto grid (velocity) + ! ============================================================= + + do i=1,np + leg(:,i) = legendre(gll%points(i),np-1) + end do + + ! ================================================================ + ! Derivatives of velocity cardinal functions on pressure grid + ! d(i,j) = D(j,i) = D' (D-transpose) since D(i,j) = dh_j(x_i)/dx + ! ================================================================ + + fact = np*(np-1) + + do j=1,np + call jacobi(np-1,gs%points(j),c0,c0,jac(0:np-1),djac(0:np-1)) + func0 = jac(np-1) + func1 = djac(np-1) + f1 = fact*func0 + f2 = (c1 - gs%points(j))*(c1 + gs%points(j)) * func1 + do i = 1, np + if ( gs%points(j) /= gll%points(i) ) then + dis = gs%points(j) - gll%points(i) + dmat(i,j) = func0 / ( leg(np,i)*dis ) + f2 / (fact*leg(np,i)*dis*dis) + else + dmat(i,j) = c0 + endif + end do + end do + + deallocate(gll%points) + deallocate(gll%weights) + + deallocate(gs%points) + deallocate(gs%weights) + +end subroutine dmatinit + +! ======================================= +! dpvinit: +! +! Compute rectangular p->v +! derivative matrix (dmat) +! for strong gradients +! ======================================= + +subroutine dpvinit(dmat) + +real (kind=r8) :: dmat(np,np) + +! Local variables + +type (quadrature_t) :: gll +type (quadrature_t) :: gs + +integer i,j +real(kind=r8) dis,c0,c1 + +real(kind=r8) :: legv(0:np,np) +real(kind=r8) :: dlegv(0:np,np) + +real(kind=r8) :: leg(0:np) +real(kind=r8) :: dleg(0:np) + +c0 = 0.0_r8 +c1 = 1.0_r8 + +gll= gausslobatto(np) +gs = gauss(np) + +! ============================================================= +! Compute Legendre polynomials on Gauss-Lobatto grid (velocity) +! ============================================================= + +do i=1,np +call jacobi(np,gll%points(i),c0,c0,legv(0:np,i),dlegv(0:np,i)) +end do + +! ================================================================ +! Derivatives of velocity cardinal functions on pressure grid +! d(i,j) = D(j,i) = D' (D-transpose) since D(i,j) = dh_j(x_i)/dx +! ================================================================ + + do j=1,np + call jacobi(np,gs%points(j),c0,c0,leg(0:np),dleg(0:np)) + do i = 1, np + if ( gs%points(j) /= gll%points(i) ) then + dis = gll%points(i) - gs%points(j) + dmat(j,i) = dlegv(np,i)/( dleg(np)*dis ) - legv(np,i)/ (dleg(np)*dis*dis) + else + dmat(j,i) = c0 + endif + end do + end do + + deallocate(gll%points) + deallocate(gll%weights) + + deallocate(gs%points) + deallocate(gs%weights) + + end subroutine dpvinit + +! ======================================= +! v2pinit: +! Compute interpolation matrix from gll(1:n1) -> gs(1:n2) +! ======================================= + subroutine v2pinit(v2p,gll,gs,n1,n2) + integer :: n1,n2 + real(kind=r8) :: v2p(n1,n2) + real(kind=r8) :: v2p_new(n1,n2) + real(kind=r8) :: gll(n1),gs(n2) + ! Local variables + + integer i,j,k,m,l + real(kind=r8) fact,f1, sum + real(kind=r8) func0,func1 + + real(kind=r8) :: leg(n1,n1) + real(kind=r8) :: jac(0:n1-1) + real(kind=r8) :: djac(0:n1-1) + real(kind=r8) :: c0,c1 + + type(quadrature_t) :: gll_pts + real(kind=r8) :: leg_out(n1,n2) + real(kind=r8) :: gamma(n1) + + c0 = 0.0_r8 + c1 = 1.0_r8 + + ! ============================================================== + ! Compute Legendre polynomials on Gauss-Lobatto grid (velocity) + ! ============================================================== + + fact = -n1*(n1-1) + do i=1,n1 + leg(:,i) = legendre(gll(i),n1-1) + leg(n1,i) = fact * leg(n1,i) + end do + + ! =================================================== + ! Velocity cardinal functions on pressure grid + ! =================================================== + ! NEW VERSION, with no division by (gs(j)-gll(i)): + + ! compute legendre polynomials at output points: + gll_pts = gausslobatto(n1) + + fact = -n1*(n1-1) + do i=1,n2 + leg_out(:,i) = legendre(gs(i),n1-1) + leg_out(n1,i) = fact * leg_out(n1,i) + end do + + + ! compute gamma: (normalization factor for inv(leg) + do m=1,n1 + gamma(m)=0 + do i=1,n1 + gamma(m)=gamma(m)+leg(m,i)*leg(m,i)*gll_pts%weights(i) + enddo + gamma(m)=1/gamma(m) + enddo + + ! compute product of leg_out * inv(leg): + do j=1,n2 ! this should be fvm points + do l=1,n1 ! this should be GLL points + sum=0 + do k=1,n1 ! number of polynomials = number of GLL points + sum=sum + leg_out(k,j)*gamma(k)*leg(k,l) + enddo + v2p_new(l,j) = gll_pts%weights(l)*sum + enddo + enddo + deallocate(gll_pts%points) + deallocate(gll_pts%weights) + + v2p=v2p_new + end subroutine v2pinit + + + +! ======================================= +! dvvinit: +! +! Compute rectangular v->v +! derivative matrix (dvv) +! ======================================= + + subroutine dvvinit(dvv,gll) + + real(kind=r8) :: dvv(np,np) + type (quadrature_t) :: gll + + ! Local variables + + real(kind=r8) :: leg(np,np) + real(kind=r8) :: c0,c1,c4 + + integer i,j + + c0 = 0.0_r8 + c1 = 1.0_r8 + c4 = 4.0_r8 + + do i=1,np + leg(:,i) = legendre(gll%points(i),np-1) + end do + + dvv(:,:) = c0 + do j=1,np + do i=1,j-1 + dvv(j,i) = (c1/(gll%points(i)-gll%points(j)))*leg(np,i)/leg(np,j) + end do + dvv(j,j) = c0 + do i=j+1,np + dvv(j,i) = (c1/(gll%points(i)-gll%points(j)))*leg(np,i)/leg(np,j) + end do + end do + + + dvv(np,np) = + np*(np-1)/c4 + dvv(1,1) = - np*(np-1)/c4 + + end subroutine dvvinit + +! ================================================ +! divergence_stag: +! +! Compute divergence (maps v grid -> p grid) +! ================================================ + + subroutine divergence_stag(v,deriv,div) + + real(kind=r8), intent(in) :: v(np,np,2) + type (derivative_stag_t), intent(in) :: deriv + real(kind=r8), intent(out) :: div(np,np) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) sumx00 + real(kind=r8) sumy00 + + real(kind=r8) :: vtemp(np,np,2) + + + do j=1,np + do l=1,np + + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%D(i,l )*v(i,j ,1) + sumy00 = sumy00 + deriv%M(i,l )*v(i,j ,2) + enddo + vtemp(j ,l ,1) = sumx00 + vtemp(j ,l ,2) = sumy00 + enddo + enddo + do j=1,np + do i=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%M(l,j )*vtemp(l,i ,1) + sumy00 = sumy00 + deriv%D(l,j )*vtemp(l,i ,2) + enddo + div(i ,j ) = sumx00 + sumy00 + + enddo + enddo + + end subroutine divergence_stag + +! ================================================ +! divergence_nonstag: +! +! Compute divergence (maps v->v) +! ================================================ + + subroutine divergence_nonstag(v,deriv,div) + + real(kind=r8), intent(in) :: v(np,np,2) + type (derivative_t), intent(in) :: deriv + + real(kind=r8), intent(out) :: div(np,np) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) :: dudx00 + real(kind=r8) :: dvdy00 + + real(kind=r8) :: vvtemp(np,np) + + do j=1,np + do l=1,np + dudx00=0.0d0 + dvdy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dudx00 = dudx00 + deriv%Dvv(i,l )*v(i,j ,1) + dvdy00 = dvdy00 + deriv%Dvv(i,l )*v(j ,i,2) + end do + + div(l ,j ) = dudx00 + vvtemp(j ,l ) = dvdy00 + end do + end do + do j=1,np + do i=1,np + div(i,j)=div(i,j)+vvtemp(i,j) + end do + end do + + end subroutine divergence_nonstag + +! ================================================ +! gradient_wk_stag: +! +! Compute the weak form gradient: +! maps scalar field on the pressure grid to the +! velocity grid +! ================================================ + + function gradient_wk_stag(p,deriv) result(dp) + + type (derivative_stag_t), intent(in) :: deriv + real(kind=r8), intent(in) :: p(np,np) + + real(kind=r8) :: dp(np,np,2) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) sumx00,sumx01 + real(kind=r8) sumy00,sumy01 + + real(kind=r8) :: vtempt(np,np,2) + + do j=1,np + do l=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%D_twt(i,l )*p(i,j ) + sumy00 = sumy00 + deriv%M_twt(i,l )*p(i,j ) + enddo + vtempt(j ,l ,1) = sumx00 + vtempt(j ,l ,2) = sumy00 + enddo + enddo + do j=1,np + do i=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%M_twt(l,j )*vtempt(l,i ,1) + sumy00 = sumy00 + deriv%D_twt(l,j )*vtempt(l,i ,2) + enddo + dp(i ,j ,1) = sumx00 + dp(i ,j ,2) = sumy00 + enddo + enddo + + + end function gradient_wk_stag + +! ================================================ +! gradient_wk_nonstag: +! +! Compute the weak form gradient: +! maps scalar field on the Gauss-Lobatto grid to the +! weak gradient on the Gauss-Lobbatto grid +! ================================================ + + function gradient_wk_nonstag(p,deriv) result(dp) + + type (derivative_t), intent(in) :: deriv + real(kind=r8), intent(in) :: p(np,np) + + real(kind=r8) :: dp(np,np,2) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) sumx00 + real(kind=r8) sumy00 + + real(kind=r8) :: vvtempt(np,np,2) + + do j=1,np + do l=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%Dvv_twt(i,l )*p(i,j ) + sumy00 = sumy00 + deriv%Mvv_twt(i,l )*p(i,j ) + end do + vvtempt(j ,l ,1) = sumx00 + vvtempt(j ,l ,2) = sumy00 + end do + end do + + do j=1,np + do i=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%Mvv_twt(l,j )*vvtempt(l,i ,1) + sumy00 = sumy00 + deriv%Dvv_twt(l,j )*vvtempt(l,i ,2) + end do + dp(i ,j ,1) = sumx00 + dp(i ,j ,2) = sumy00 + end do + end do + end function gradient_wk_nonstag + +! ================================================ +! gradient_str_stag: +! +! Compute the *strong* form gradient: +! maps scalar field on the pressure grid to the +! velocity grid +! ================================================ + + subroutine gradient_str_stag(p,deriv,dp) + + type (derivative_stag_t), intent(in) :: deriv + real(kind=r8), intent(in) :: p(np,np) + + real(kind=r8), intent(out) :: dp(np,np,2) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) sumx00 + real(kind=r8) sumy00 + + real(kind=r8) :: vtempt(np,np,2) + do j=1,np + do l=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%Dpv(i,l )*p(i,j ) + sumy00 = sumy00 + deriv%M_t(i,l )*p(i,j ) + enddo + vtempt(j ,l ,1) = sumx00 + vtempt(j ,l ,2) = sumy00 + enddo + enddo + do j=1,np + do i=1,np + sumx00=0.0d0 + sumy00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%M_t(l,j )*vtempt(l,i ,1) + sumy00 = sumy00 + deriv%Dpv(l,j )*vtempt(l,i ,2) + enddo + dp(i ,j ,1) = sumx00 + dp(i ,j ,2) = sumy00 + enddo + enddo + + end subroutine gradient_str_stag + +! ================================================ +! gradient_str_nonstag: +! +! Compute the *strong* gradient on the velocity grid +! of a scalar field on the velocity grid +! ================================================ + + subroutine gradient_str_nonstag(s,deriv,ds) + + type (derivative_t), intent(in) :: deriv + real(kind=r8), intent(in) :: s(np,np) + real(kind=r8), intent(out) :: ds(np,np,2) + + integer i + integer j + integer l + real(kind=r8) :: dsdx00,dsdx01 + real(kind=r8) :: dsdy00,dsdy01 + do j=1,np + do l=1,np + dsdx00=0.0d0 + dsdy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dsdx00 = dsdx00 + deriv%Dvv(i,l )*s(i,j ) + dsdy00 = dsdy00 + deriv%Dvv(i,l )*s(j ,i) + end do + ds(l ,j ,1) = dsdx00 + ds(j ,l ,2) = dsdy00 + end do + end do + end subroutine gradient_str_nonstag + +! ================================================ +! vorticity: +! +! Compute the vorticity of the velocity field on the +! velocity grid +! ================================================ + + subroutine vorticity(v,deriv,vort) + + type (derivative_t), intent(in) :: deriv + real(kind=r8), intent(in) :: v(np,np,2) + + real(kind=r8), intent(out) :: vort(np,np) + + integer i + integer j + integer l + + real(kind=r8) :: dvdx00,dvdx01 + real(kind=r8) :: dudy00,dudy01 + + real(kind=r8) :: vvtemp(np,np) + do j=1,np + do l=1,np + dudy00=0.0d0 + dvdx00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dvdx00 = dvdx00 + deriv%Dvv(i,l )*v(i,j ,2) + dudy00 = dudy00 + deriv%Dvv(i,l )*v(j ,i,1) + enddo + vort(l ,j ) = dvdx00 + vvtemp(j ,l ) = dudy00 + enddo + enddo + do j=1,np + do i=1,np + vort(i,j)=vort(i,j)-vvtemp(i,j) + end do + end do + + end subroutine vorticity + +! ================================================ +! interpolate_gll2fvm_points: +! +! shape funtion interpolation from data on GLL grid to cellcenters on physics grid +! Author: Christoph Erath +! ================================================ + function interpolate_gll2fvm_points(v,deriv) result(p) + + real(kind=r8), intent(in) :: v(np,np) + type (derivative_t) :: deriv + real(kind=r8) :: p(nc,nc) + + ! Local + integer i + integer j + integer l + + real(kind=r8) sumx00,sumx01 + real(kind=r8) sumx10,sumx11 + real(kind=r8) vtemp(np,nc) + + do j=1,np + do l=1,nc + sumx00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%Cfvm(i,l )*v(i,j ) + enddo + vtemp(j ,l) = sumx00 + enddo + enddo + do j=1,nc + do i=1,nc + sumx00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%Cfvm(l,j )*vtemp(l,i) + enddo + p(i ,j ) = sumx00 + enddo + enddo + end function interpolate_gll2fvm_points +! ================================================ +! interpolate_gll2fvm_corners: +! +! shape funtion interpolation from data on GLL grid to physics grid +! +! ================================================ + function interpolate_gll2fvm_corners(v,deriv) result(p) + + real(kind=r8), intent(in) :: v(np,np) + type (derivative_t), intent(in) :: deriv + real(kind=r8) :: p(nc+1,nc+1) + + ! Local + integer i + integer j + integer l + + real(kind=r8) sumx00,sumx01 + real(kind=r8) sumx10,sumx11 + real(kind=r8) vtemp(np,nc+1) + + do j=1,np + do l=1,nc+1 + sumx00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + sumx00 = sumx00 + deriv%Mfvm(i,l )*v(i,j ) + enddo + vtemp(j ,l) = sumx00 + enddo + enddo + do j=1,nc+1 + do i=1,nc+1 + sumx00=0.0d0 +!DIR$ UNROLL(NP) + do l=1,np + sumx00 = sumx00 + deriv%Mfvm(l,j )*vtemp(l,i) + enddo + p(i ,j ) = sumx00 + enddo + enddo + end function interpolate_gll2fvm_corners + + +! ================================================ +! remap_phys2gll: +! +! interpolate to an equally spaced (in reference element coordinate system) +! "physics" grid to the GLL grid +! +! 1st order, monotone, conservative +! MT initial version 2013 +! ================================================ + function remap_phys2gll(pin,nphys) result(pout) + integer :: nphys + real(kind=r8), intent(in) :: pin(nphys*nphys) + real(kind=r8) :: pout(np,np) + + ! Local + integer, save :: nphys_init=0 + integer, save :: nintersect + real(kind=r8),save,pointer :: acell(:) ! arrivial cell index of i'th intersection + real(kind=r8),save,pointer :: dcell(:) ! departure cell index of i'th intersection + real(kind=r8),save,pointer :: delta(:) ! length of i'th intersection + real(kind=r8),save,pointer :: delta_a(:) ! length of arrival cells + integer in_i,in_j,ia,ja,id,jd,count,i,j + logical :: found + + real(kind=r8) :: tol = 1.0e-13_r8 + real(kind=r8) :: weight,x1,x2,dx + real(kind=r8) :: gll_edges(np+1),phys_edges(nphys+1) + type(quadrature_t) :: gll_pts + if (nphys_init/=nphys) then + ! setup (most be done on masterthread only) since all data is static + ! MT: move barrier inside if loop - we dont want a barrier every regular call +!OMP BARRIER +!OMP MASTER + nphys_init=nphys + ! find number of intersections + nintersect = np+nphys-1 ! max number of possible intersections + allocate(acell(nintersect)) + allocate(dcell(nintersect)) + allocate(delta(nintersect)) + allocate(delta_a(np)) + + ! compute phys grid cell edges on [-1,1] + do i=1,nphys+1 + dx = 2d0/nphys + phys_edges(i)=-1 + (i-1)*dx + enddo + + ! compute GLL cell edges on [-1,1] + gll_pts = gausslobatto(np) + gll_edges(1)=-1 + do i=2,np + gll_edges(i) = gll_edges(i-1) + gll_pts%weights(i-1) + enddo + gll_edges(np+1)=1 + delta_a=gll_pts%weights + deallocate(gll_pts%points) + deallocate(gll_pts%weights) + + count=0 + x1=-1 + do while ( abs(x1-1) > tol ) + ! find point x2 closet to x1 and x2>x1: + x2 = 1.1_r8 + do ia=2,np+1 + if (gll_edges(ia)>x1) then + if ( ( gll_edges(ia)-x1) < (x2-x1) ) then + x2=gll_edges(ia) + endif + endif + enddo + do id=2,nphys+1 + if (phys_edges(id)>x1) then + if ( ( phys_edges(id)-x1) < (x2-x1) ) then + x2=phys_edges(id) + endif + endif + enddo + print *,'x2=',x2 + if (x2>1+tol) call endrun('ERROR: did not find next intersection point') + if (x2<=x1) call endrun('ERROR: next intersection point did not advance') + count=count+1 + if (count>nintersect) call endrun('ERROR: search failuer: nintersect was too small') + delta(count)=x2-x1 + + found=.false. + do ia=1,np + if (gll_edges(ia) <= x1+tol .and. x2-tol <= gll_edges(ia+1)) then + found=.true. + acell(count)=ia + endif + enddo + if (.not. found) call endrun('ERROR: interval search problem') + + found=.false. + do id=1,nphys + if (phys_edges(id) <= x1+tol .and. x2-tol <= phys_edges(id+1)) then + found=.true. + dcell(count)=id + endif + enddo + if (.not. found) call endrun('ERROR: interval search problem') + x1=x2 + enddo + ! reset to actual number of intersections + nintersect=count +!OMP END MASTER +!OMP BARRIER + endif + + pout=0 + do in_i = 1,nintersect + do in_j = 1,nintersect + ia = acell(in_i) + ja = acell(in_j) + id = dcell(in_i) + jd = dcell(in_j) + ! mass in intersection region: value*area_intersect + ! value_arrival = value*area_intersect/area_arrival + weight = ( delta(in_i)*delta(in_j) ) / ( delta_a(ia)*delta_a(ja)) + ! accumulate contribution from each intersection region: + pout(ia,ja) = pout(ia,ja) + weight*pin(id+(jd-1)*nphys) + enddo + enddo + + end function remap_phys2gll + +!---------------------------------------------------------------- + +!DIR$ ATTRIBUTES FORCEINLINE :: gradient_sphere + subroutine gradient_sphere(s,deriv,Dinv,ds) +! +! input s: scalar +! output ds: spherical gradient of s, lat-lon coordinates +! + + type (derivative_t), intent(in) :: deriv + real(kind=r8), intent(in), dimension(np,np,2,2) :: Dinv + real(kind=r8), intent(in) :: s(np,np) + real(kind=r8), intent(out) :: ds(np,np,2) + + integer i + integer j + integer l + + real(kind=r8) :: dsdx00, dsdy00 + real(kind=r8) :: v1(np,np),v2(np,np) + + do j=1,np + do l=1,np + dsdx00=0.0d0 + dsdy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dsdx00 = dsdx00 + deriv%Dvv(i,l )*s(i,j ) + dsdy00 = dsdy00 + deriv%Dvv(i,l )*s(j ,i) + end do + v1(l ,j ) = dsdx00*ra + v2(j ,l ) = dsdy00*ra + end do + end do + ! convert covarient to latlon + do j=1,np + do i=1,np + ds(i,j,1)=Dinv(i,j,1,1)*v1(i,j) + Dinv(i,j,2,1)*v2(i,j) + ds(i,j,2)=Dinv(i,j,1,2)*v1(i,j) + Dinv(i,j,2,2)*v2(i,j) + enddo + enddo + + end subroutine gradient_sphere + + + function curl_sphere_wk_testcov(s,deriv,elem) result(ds) +! +! integrated-by-parts gradient, w.r.t. COVARIANT test functions +! input s: scalar (assumed to be s*khat) +! output ds: weak curl, lat/lon coordinates +! +! starting with: +! PHIcov1 = (PHI,0) covariant vector +! PHIcov2 = (0,PHI) covariant vector +! +! ds1 = integral[ PHIcov1 dot curl(s*khat) ] +! ds2 = integral[ PHIcov2 dot curl(s*khat) ] +! integrate by parts: +! ds1 = integral[ vor(PHIcov1) * s ] +! ds2 = integral[ vor(PHIcov1) * s ] +! +! PHIcov1 = (PHI^mn,0) +! PHIcov2 = (0,PHI^mn) +! vorticity() acts on covariant vectors: +! ds1 = sum wij g s_ij 1/g ( (PHIcov1_2)_x - (PHIcov1_1)_y ) +! = -sum wij s_ij d/dy (PHI^mn ) +! for d/dy component, only sum over i=m +! = -sum w_mj s_mj d( PHI^n)(j) +! j +! +! ds2 = sum wij g s_ij 1/g ( (PHIcov2_2)_x - (PHIcov2_1)_y ) +! = +sum wij s_ij d/dx (PHI^mn ) +! for d/dx component, only sum over j=n +! = +sum w_in s_in d( PHI^m)(i) +! i +! + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: s(np,np) + + real(kind=r8) :: ds(np,np,2) + + integer i,j,l,m,n + real(kind=r8) :: dscontra(np,np,2) + + dscontra=0 + do n=1,np + do m=1,np +!DIR$ UNROLL(NP) + do j=1,np + ! phi(n)_y sum over second index, 1st index fixed at m + dscontra(m,n,1)=dscontra(m,n,1)-(elem%mp(m,j)*s(m,j)*deriv%Dvv(n,j) )*ra + ! phi(m)_x sum over first index, second index fixed at n + dscontra(m,n,2)=dscontra(m,n,2)+(elem%mp(j,n)*s(j,n)*deriv%Dvv(m,j) )*ra + enddo + enddo + enddo + + ! convert contra -> latlon + do j=1,np + do i=1,np + ds(i,j,1)=(elem%D(i,j,1,1)*dscontra(i,j,1) + elem%D(i,j,1,2)*dscontra(i,j,2)) + ds(i,j,2)=(elem%D(i,j,2,1)*dscontra(i,j,1) + elem%D(i,j,2,2)*dscontra(i,j,2)) + enddo + enddo + end function curl_sphere_wk_testcov + + + function gradient_sphere_wk_testcov(s,deriv,elem) result(ds) +! +! integrated-by-parts gradient, w.r.t. COVARIANT test functions +! input s: scalar +! output ds: weak gradient, lat/lon coordinates +! ds = - integral[ div(PHIcov) s ] +! +! PHIcov1 = (PHI^mn,0) +! PHIcov2 = (0,PHI^mn) +! div() acts on contra components, so convert test function to contra: +! PHIcontra1 = metinv PHIcov1 = (a^mn,b^mn)*PHI^mn +! a = metinv(1,1) b=metinv(2,1) +! +! ds1 = sum wij g s_ij 1/g ( g a PHI^mn)_x + ( g b PHI^mn)_y ) +! = sum wij s_ij ag(m,n) d/dx( PHI^mn ) + bg(m,n) d/dy( PHI^mn) +! i,j +! for d/dx component, only sum over j=n +! = sum w_in s_in ag(m,n) d( PHI^m)(i) +! i +! for d/dy component, only sum over i=m +! = sum w_mj s_mj bg(m,n) d( PHI^n)(j) +! j +! +! +! This formula is identical to gradient_sphere_wk_testcontra, except that +! g(m,n) is replaced by a(m,n)*g(m,n) +! and we have two terms for each componet of ds +! +! + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: s(np,np) + + real(kind=r8) :: ds(np,np,2) + + integer i,j,l,m,n + real(kind=r8) :: dscontra(np,np,2) + + + dscontra=0 + do n=1,np + do m=1,np +!DIR$ UNROLL(NP) + do j=1,np + dscontra(m,n,1)=dscontra(m,n,1)-(& + (elem%mp(j,n)*elem%metinv(m,n,1,1)*elem%metdet(m,n)*s(j,n)*deriv%Dvv(m,j) ) +& + (elem%mp(m,j)*elem%metinv(m,n,2,1)*elem%metdet(m,n)*s(m,j)*deriv%Dvv(n,j) ) & + ) *ra + + dscontra(m,n,2)=dscontra(m,n,2)-(& + (elem%mp(j,n)*elem%metinv(m,n,1,2)*elem%metdet(m,n)*s(j,n)*deriv%Dvv(m,j) ) +& + (elem%mp(m,j)*elem%metinv(m,n,2,2)*elem%metdet(m,n)*s(m,j)*deriv%Dvv(n,j) ) & + ) *ra + enddo + enddo + enddo + ! convert contra -> latlon + do j=1,np + do i=1,np + ds(i,j,1)=(elem%D(i,j,1,1)*dscontra(i,j,1) + elem%D(i,j,1,2)*dscontra(i,j,2)) + ds(i,j,2)=(elem%D(i,j,2,1)*dscontra(i,j,1) + elem%D(i,j,2,2)*dscontra(i,j,2)) + enddo + enddo + + end function gradient_sphere_wk_testcov + + + function gradient_sphere_wk_testcontra(s,deriv,elem) result(ds) +! +! integrated-by-parts gradient, w.r.t. CONTRA test functions +! input s: scalar +! output ds: weak gradient, lat/lon coordinates +! +! integral[ div(phivec) s ] = sum spheremp()* divergence_sphere(phivec) *s +! ds1 = above formual with phivec=(PHI,0) in CONTRA coordinates +! ds2 = above formual with phivec=(0,PHI) in CONTRA coordinates +! +! PHI = (phi,0) +! s1 = sum w_ij s_ij g_ij 1/g_ij ( g_ij PHI^mn )x +! = sum w_ij s_ij g_mn dx(PHI^mn)_ij +! ij +! because x derivative is zero for j<>n, only have to sum over j=n +! s1(m,n) = sum w_i,n g_mn dx(PHI^m)_i,n s_i,n +! i +! + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: s(np,np) + + real(kind=r8) :: ds(np,np,2) + + integer i,j,l,m,n + real(kind=r8) :: dscov(np,np,2) + + dscov=0 + do n=1,np + do m=1,np +!DIR$ UNROLL(NP) + do j=1,np + ! phi(m)_x sum over first index, second index fixed at n + dscov(m,n,1)=dscov(m,n,1)-(elem%mp(j,n)*elem%metdet(m,n)*s(j,n)*deriv%Dvv(m,j) )*ra + ! phi(n)_y sum over second index, 1st index fixed at m + dscov(m,n,2)=dscov(m,n,2)-(elem%mp(m,j)*elem%metdet(m,n)*s(m,j)*deriv%Dvv(n,j) )*ra + enddo + enddo + enddo + + ! convert covariant -> latlon + ds(:,:,1)=elem%Dinv(:,:,1,1)*dscov(:,:,1) + elem%Dinv(:,:,2,1)*dscov(:,:,2) + ds(:,:,2)=elem%Dinv(:,:,1,2)*dscov(:,:,1) + elem%Dinv(:,:,2,2)*dscov(:,:,2) + + end function gradient_sphere_wk_testcontra + + function ugradv_sphere(u,v,deriv,elem) result(ugradv) +! +! input: vectors u and v (latlon coordinates) +! output: vector [ u dot grad ] v (latlon coordinates) +! + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: u(np,np,2) + real(kind=r8), intent(in) :: v(np,np,2) + + real(kind=r8) :: ugradv(np,np,2) + real(kind=r8) :: dum_cart(np,np,3) + real(kind=r8) :: temp(np,np,2) + + integer :: component + + ! latlon -> cartesian + do component=1,3 + ! Summing along the third dimension is a sum over components for each point. + ! (This is just a faster way of doing a dot product for each grid point, + ! since reindexing the inputs to use the intrinsic effectively would be + ! just asking for trouble.) + dum_cart(:,:,component)=sum( elem%vec_sphere2cart(:,:,component,:)*v(:,:,:) ,3) + end do + + ! Do ugradv on the cartesian components. + do component=1,3 + ! Dot u with the gradient of each component + call gradient_sphere(dum_cart(:,:,component),deriv,elem%Dinv,temp) + dum_cart(:,:,component) = sum( u(:,:,:) * temp,3) + enddo + + ! cartesian -> latlon + do component=1,2 + ! vec_sphere2cart is its own pseudoinverse. + ugradv(:,:,component) = sum(dum_cart(:,:,:)*elem%vec_sphere2cart(:,:,:,component), 3) + end do + + end function ugradv_sphere + + + + function curl_sphere(s,deriv,elem) result(ds) +! +! input s: scalar (assumed to be s khat) +! output curl(s khat) vector in lat-lon coordinates +! +! This subroutine can be used to compute divergence free velocity fields, +! since div(ds)=0 +! +! first compute: +! curl(s khat) = (1/jacobian) ( ds/dy, -ds/dx ) in contra-variant coordinates +! then map to lat-lon +! + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: s(np,np) + + real(kind=r8) :: ds(np,np,2) + + integer i + integer j + integer l + + real(kind=r8) :: dsdx00 + real(kind=r8) :: dsdy00 + real(kind=r8) :: v1(np,np),v2(np,np) + + do j=1,np + do l=1,np + dsdx00=0.0d0 + dsdy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dsdx00 = dsdx00 + deriv%Dvv(i,l )*s(i,j ) + dsdy00 = dsdy00 + deriv%Dvv(i,l )*s(j ,i) + end do + v2(l ,j ) = -dsdx00*ra + v1(j ,l ) = dsdy00*ra + end do + end do + ! convert contra -> latlon *and* divide by jacobian + do j=1,np + do i=1,np + ds(i,j,1)=(elem%D(i,j,1,1)*v1(i,j) + elem%D(i,j,1,2)*v2(i,j))/elem%metdet(i,j) + ds(i,j,2)= (elem%D(i,j,2,1)*v1(i,j) + elem%D(i,j,2,2)*v2(i,j))/elem%metdet(i,j) + enddo + enddo + + end function curl_sphere + + +!-------------------------------------------------------------------------- + + + + subroutine divergence_sphere_wk(v,deriv,elem,div) +! +! input: v = velocity in lat-lon coordinates +! ouput: div(v) spherical divergence of v, integrated by parts +! +! Computes -< grad(psi) dot v > +! (the integrated by parts version of < psi div(v) > ) +! +! note: after DSS, divergence_sphere() and divergence_sphere_wk() +! are identical to roundoff, as theory predicts. +! + real(kind=r8), intent(in) :: v(np,np,2) ! in lat-lon coordinates + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8),intent(out) :: div(np,np) + + ! Local + + integer i,j,m,n + + real(kind=r8) :: vtemp(np,np,2) + real(kind=r8) :: ggtemp(np,np,2) + real(kind=r8) :: gtemp(np,np,2) + real(kind=r8) :: psi(np,np) + real(kind=r8) :: xtmp + + ! latlon- > contra + do j=1,np + do i=1,np + vtemp(i,j,1)=(elem%Dinv(i,j,1,1)*v(i,j,1) + elem%Dinv(i,j,1,2)*v(i,j,2)) + vtemp(i,j,2)=(elem%Dinv(i,j,2,1)*v(i,j,1) + elem%Dinv(i,j,2,2)*v(i,j,2)) + enddo + enddo + + do n=1,np + do m=1,np + + div(m,n)=0 +!DIR$ UNROLL(NP) + do j=1,np + div(m,n)=div(m,n)-(elem%spheremp(j,n)*vtemp(j,n,1)*deriv%Dvv(m,j) & + +elem%spheremp(m,j)*vtemp(m,j,2)*deriv%Dvv(n,j)) & + * ra + enddo + + end do + end do + + end subroutine divergence_sphere_wk + + + + function element_boundary_integral(v,deriv,elem) result(result) +! +! input: v = velocity in lat-lon coordinates +! ouput: result(i,j) = contour integral of PHI_ij * v dot normal +! where PHI_ij = cardinal function at i,j GLL point +! +! this routine is used just to check spectral element integration by parts identities +! + real(kind=r8), intent(in) :: v(np,np,2) ! in lat-lon coordinates + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8) :: result(np,np) + + ! Local + real(kind=r8) :: ucontra(np,np,2) ! in lat-lon coordinates + integer i,j + + ! latlon->contra + do j=1,np + do i=1,np + ucontra(i,j,1)=(elem%Dinv(i,j,1,1)*v(i,j,1) + elem%Dinv(i,j,1,2)*v(i,j,2)) + ucontra(i,j,2)=(elem%Dinv(i,j,2,1)*v(i,j,1) + elem%Dinv(i,j,2,2)*v(i,j,2)) + enddo + enddo + + ! note: GLL weights weight(i) = Mvv_twt(i,i) + result=0 + j=1 + do i=1,np + result(i,j)=result(i,j)-deriv%Mvv_twt(i,i)*elem%metdet(i,j)*ucontra(i,j,2)*ra + enddo + + j=np + do i=1,np + result(i,j)=result(i,j)+deriv%Mvv_twt(i,i)*elem%metdet(i,j)*ucontra(i,j,2)*ra + enddo + + i=1 + do j=1,np + result(i,j)=result(i,j)-deriv%Mvv_twt(j,j)*elem%metdet(i,j)*ucontra(i,j,1)*ra + enddo + + i=np + do j=1,np + result(i,j)=result(i,j)+deriv%Mvv_twt(j,j)*elem%metdet(i,j)*ucontra(i,j,1)*ra + enddo + end function element_boundary_integral + + + + function edge_flux_u_cg( v,p,pedges, deriv, elem, u_is_contra) result(result) +! +! +! input: v = velocity in contra or lat-lon coordinates (CONTINUIOUS) +! p = scalar on this element +! pedges = scalar edge data from neighbor elements +! +! ouput: result(i,j) = contour integral of PHI_ij * pstar * v dot normal +! where PHI_ij = cardinal function at i,j GLL point +! pstar = centered or other flux +! + real(kind=r8), intent(in) :: v(np,np,2) + real(kind=r8), intent(in) :: p(np,np) + real(kind=r8), intent(in) :: pedges(0:np+1,0:np+1) + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8) :: result(np,np) + logical :: u_is_contra + + ! Local + real(kind=r8) :: ucontra(np,np,2) ! in lat-lon coordinates + real(kind=r8) :: flux,pstar + integer i,j + + + result=0 + + + if (u_is_contra) then + ucontra=v + else + ! latlon->contra + do j=1,np + do i=1,np + ucontra(i,j,1)=(elem%Dinv(i,j,1,1)*v(i,j,1) + elem%Dinv(i,j,1,2)*v(i,j,2)) + ucontra(i,j,2)=(elem%Dinv(i,j,2,1)*v(i,j,1) + elem%Dinv(i,j,2,2)*v(i,j,2)) + enddo + enddo + endif + ! upwind + do i=1,np + j=1 + pstar=p(i,j) + if (ucontra(i,j,2)>0) pstar=pedges(i,0) + flux = -pstar*ucontra(i,j,2)*( deriv%Mvv_twt(i,i)*elem%metdet(i,j)*ra) + result(i,j)=result(i,j)+flux + + j=np + pstar=p(i,j) + if (ucontra(i,j,2)<0) pstar=pedges(i,np+1) + flux = pstar*ucontra(i,j,2)* ( deriv%Mvv_twt(i,i)*elem%metdet(i,j)*ra) + result(i,j)=result(i,j)+flux + enddo + + do j=1,np + i=1 + pstar=p(i,j) + if (ucontra(i,j,1)>0) pstar=pedges(0,j) + flux = -pstar*ucontra(i,j,1)* ( deriv%Mvv_twt(j,j)*elem%metdet(i,j)*ra) + result(i,j)=result(i,j)+flux + + i=np + pstar=p(i,j) + if (ucontra(i,j,1)<0) pstar=pedges(np+1,j) + flux = pstar*ucontra(i,j,1)* ( deriv%Mvv_twt(j,j)*elem%metdet(i,j)*ra) + result(i,j)=result(i,j)+flux + end do + + end function edge_flux_u_cg + + +!DIR$ ATTRIBUTES FORCEINLINE :: vorticity_sphere + subroutine vorticity_sphere(v,deriv,elem,vort) +! +! input: v = velocity in lat-lon coordinates +! ouput: spherical vorticity of v +! + + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: v(np,np,2) + + real(kind=r8), intent(out) :: vort(np,np) + + integer i + integer j + integer l + + real(kind=r8) :: dvdx00,dudy00 + real(kind=r8) :: vco(np,np,2) + real(kind=r8) :: vtemp(np,np) + + ! convert to covariant form + do j=1,np + do i=1,np + vco(i,j,1)=(elem%D(i,j,1,1)*v(i,j,1) + elem%D(i,j,2,1)*v(i,j,2)) + vco(i,j,2)=(elem%D(i,j,1,2)*v(i,j,1) + elem%D(i,j,2,2)*v(i,j,2)) + enddo + enddo + + do j=1,np + do l=1,np + + dudy00=0.0d0 + dvdx00=0.0d0 + +!DIR$ UNROLL(NP) + do i=1,np + dvdx00 = dvdx00 + deriv%Dvv(i,l )*vco(i,j ,2) + dudy00 = dudy00 + deriv%Dvv(i,l )*vco(j ,i,1) + enddo + + vort(l ,j ) = dvdx00 + vtemp(j ,l ) = dudy00 + enddo + enddo + + do j=1,np + do i=1,np + vort(i,j)=(vort(i,j)-vtemp(i,j))*(elem%rmetdet(i,j)*ra) + end do + end do + + end subroutine vorticity_sphere + + function vorticity_sphere_diag(v,deriv,elem) result(vort) + ! + ! input: v = velocity in lat-lon coordinates + ! ouput: diagonal component of spherical vorticity of v + ! + + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(in) :: v(np,np,2) + + real(kind=r8) :: vort(np,np) + + integer i + integer j + integer l + + real(kind=r8) :: dvdx00,dudy00 + real(kind=r8) :: vco(np,np,2) + real(kind=r8) :: vtemp(np,np) + real(kind=r8) :: rdx + real(kind=r8) :: rdy + + ! convert to covariant form + + do j=1,np + do i=1,np + vco(i,j,1)=(elem%D(i,j,1,1)*v(i,j,1) + elem%D(i,j,2,1)*v(i,j,2)) + vco(i,j,2)=(elem%D(i,j,1,2)*v(i,j,1) + elem%D(i,j,2,2)*v(i,j,2)) + enddo + enddo + + + do j=1,np + do l=1,np + dudy00=0.0d0 + dvdx00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dvdx00 = dvdx00 + deriv%Dvv_diag(i,l)*vco(i,j ,2) + dudy00 = dudy00 + deriv%Dvv_diag(i,l)*vco(j ,i,1) + enddo + vort(l ,j) = dvdx00 + vtemp(j ,l) = dudy00 + enddo + enddo + + do j=1,np + do i=1,np + vort(i,j)=(vort(i,j)-vtemp(i,j))*(elem%rmetdet(i,j)*ra) + end do + end do + + end function vorticity_sphere_diag + +!DIR$ ATTRIBUTES FORCEINLINE :: divergence_sphere + subroutine divergence_sphere(v,deriv,elem,div) +! +! input: v = velocity in lat-lon coordinates +! ouput: div(v) spherical divergence of v +! + + + real(kind=r8), intent(in) :: v(np,np,2) ! in lat-lon coordinates + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), intent(out) :: div(np,np) + + ! Local + + integer i + integer j + integer l + + real(kind=r8) :: dudx00 + real(kind=r8) :: dvdy00 + real(kind=r8) :: gv(np,np,2),vvtemp(np,np) + + ! convert to contra variant form and multiply by g + do j=1,np + do i=1,np + gv(i,j,1)=elem%metdet(i,j)*(elem%Dinv(i,j,1,1)*v(i,j,1) + elem%Dinv(i,j,1,2)*v(i,j,2)) + gv(i,j,2)=elem%metdet(i,j)*(elem%Dinv(i,j,2,1)*v(i,j,1) + elem%Dinv(i,j,2,2)*v(i,j,2)) + enddo + enddo + + ! compute d/dx and d/dy + do j=1,np + do l=1,np + dudx00=0.0d0 + dvdy00=0.0d0 +!DIR$ UNROLL(NP) + do i=1,np + dudx00 = dudx00 + deriv%Dvv(i,l )*gv(i,j ,1) + dvdy00 = dvdy00 + deriv%Dvv(i,l )*gv(j ,i,2) + end do + div(l ,j ) = dudx00 + vvtemp(j ,l ) = dvdy00 + end do + end do + + do j=1,np + do i=1,np + div(i,j)=(div(i,j)+vvtemp(i,j))*(elem%rmetdet(i,j)*ra) + end do + end do + + end subroutine divergence_sphere + + +!DIR$ ATTRIBUTES FORCEINLINE :: laplace_sphere_wk + subroutine laplace_sphere_wk(s,deriv,elem,laplace,var_coef) +! +! input: s = scalar +! ouput: -< grad(PHI), grad(s) > = weak divergence of grad(s) +! note: for this form of the operator, grad(s) does not need to be made C0 +! + real(kind=r8), intent(in) :: s(np,np) + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8) :: laplace(np,np) + logical, intent(in),optional :: var_coef + + real(kind=r8) :: laplace2(np,np) + integer i,j + + ! Local + real(kind=r8) :: grads(np,np,2), oldgrads(np,np,2) + + call gradient_sphere(s,deriv,elem%Dinv,grads) + + if (var_coef) then + if (hypervis_power/=0 ) then + ! scalar viscosity with variable coefficient + grads(:,:,1) = grads(:,:,1)*elem%variable_hyperviscosity(:,:) + grads(:,:,2) = grads(:,:,2)*elem%variable_hyperviscosity(:,:) + else if (hypervis_scaling /=0 ) then + ! tensor hv, (3) + oldgrads=grads + do j=1,np + do i=1,np + grads(i,j,1) = oldgrads(i,j,1)*elem%tensorVisc(i,j,1,1) + & + oldgrads(i,j,2)*elem%tensorVisc(i,j,1,2) + grads(i,j,2) = oldgrads(i,j,1)*elem%tensorVisc(i,j,2,1) + & + oldgrads(i,j,2)*elem%tensorVisc(i,j,2,2) + end do + end do + else + ! do nothing: constant coefficient viscsoity + endif + endif + + ! note: divergnece_sphere and divergence_sphere_wk are identical *after* bndry_exchange + ! if input is C_0. Here input is not C_0, so we should use divergence_sphere_wk(). + ! laplace=divergence_sphere_wk(grads,deriv,elem) + call divergence_sphere_wk(grads,deriv,elem,laplace) + + end subroutine laplace_sphere_wk + +!DIR$ ATTRIBUTES FORCEINLINE :: vlaplace_sphere_wk + subroutine vlaplace_sphere_wk(v,deriv,elem,laplace,var_coef,nu_ratio) +! +! input: v = vector in lat-lon coordinates +! ouput: weak laplacian of v, in lat-lon coordinates +! +! logic: +! tensorHV: requires cartesian +! nu_div/=nu: requires contra formulatino +! +! One combination NOT supported: tensorHV and nu_div/=nu then abort +! + real(kind=r8), intent(in) :: v(np,np,2) + logical, intent(in),optional :: var_coef + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8), optional :: nu_ratio + real(kind=r8), intent(out) :: laplace(np,np,2) + + + if (hypervis_scaling/=0 .and. var_coef) then + ! tensorHV is turned on - requires cartesian formulation + if (present(nu_ratio)) then + if (nu_ratio /= 1) then + call endrun('ERROR: tensorHV can not be used with nu_div/=nu') + endif + endif + laplace=vlaplace_sphere_wk_cartesian(v,deriv,elem,var_coef) + else + ! all other cases, use contra formulation: + laplace=vlaplace_sphere_wk_contra(v,deriv,elem,var_coef,nu_ratio) + endif + + end subroutine vlaplace_sphere_wk + + + + function vlaplace_sphere_wk_cartesian(v,deriv,elem,var_coef) result(laplace) +! +! input: v = vector in lat-lon coordinates +! ouput: weak laplacian of v, in lat-lon coordinates + + real(kind=r8), intent(in) :: v(np,np,2) + logical :: var_coef + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8) :: laplace(np,np,2) + ! Local + + integer component + real(kind=r8) :: dum_cart(np,np,3) + real(kind=r8) :: dum_cart2(np,np) + + + ! latlon -> cartesian + do component=1,3 + dum_cart2(:,:) = elem%vec_sphere2cart(:,:,component,1)*v(:,:,1) + & + elem%vec_sphere2cart(:,:,component,2)*v(:,:,2) + ! Do laplace on cartesian comps + call laplace_sphere_wk(dum_cart2,deriv,elem,dum_cart(:,:,component),var_coef) + enddo + + ! cartesian -> latlon + do component=1,2 + ! vec_sphere2cart is its own pseudoinverse. + laplace(:,:,component) = dum_cart(:,:,1)*elem%vec_sphere2cart(:,:,1,component) + & + dum_cart(:,:,2)*elem%vec_sphere2cart(:,:,2,component) + & + dum_cart(:,:,3)*elem%vec_sphere2cart(:,:,3,component) + end do + +#define UNDAMPRRCART +#ifdef UNDAMPRRCART + ! add in correction so we dont damp rigid rotation + laplace(:,:,1)=laplace(:,:,1) + 2*elem%spheremp(:,:)*v(:,:,1)*(ra**2) + laplace(:,:,2)=laplace(:,:,2) + 2*elem%spheremp(:,:)*v(:,:,2)*(ra**2) +#endif + end function vlaplace_sphere_wk_cartesian + + + + function vlaplace_sphere_wk_contra(v,deriv,elem,var_coef,nu_ratio) result(laplace) +! +! input: v = vector in lat-lon coordinates +! ouput: weak laplacian of v, in lat-lon coordinates +! +! du/dt = laplace(u) = grad(div) - curl(vor) +! < PHI du/dt > = < PHI laplace(u) > PHI = covariant, u = contravariant +! = < PHI grad(div) > - < PHI curl(vor) > +! = grad_wk(div) - curl_wk(vor) +! + real(kind=r8), intent(in) :: v(np,np,2) + logical, intent(in) :: var_coef + type (derivative_t), intent(in) :: deriv + type (element_t), intent(in) :: elem + real(kind=r8) :: laplace(np,np,2) + real(kind=r8), optional :: nu_ratio + ! Local + + integer i,j,l,m,n + real(kind=r8) :: vor(np,np),div(np,np) + real(kind=r8) :: v1,v2,div1,div2,vor1,vor2,phi_x,phi_y + + call divergence_sphere(v,deriv,elem,div) + call vorticity_sphere(v,deriv,elem,vor) + + if (var_coef .and. hypervis_power/=0 ) then + ! scalar viscosity with variable coefficient + div = div*elem%variable_hyperviscosity(:,:) + vor = vor*elem%variable_hyperviscosity(:,:) + endif + + if (present(nu_ratio)) div = nu_ratio*div + + laplace = gradient_sphere_wk_testcov(div,deriv,elem) - & + curl_sphere_wk_testcov(vor,deriv,elem) + + do n=1,np + do m=1,np + ! add in correction so we dont damp rigid rotation +#define UNDAMPRR +#ifdef UNDAMPRR + laplace(m,n,1)=laplace(m,n,1) + 2*elem%spheremp(m,n)*v(m,n,1)*(ra**2) + laplace(m,n,2)=laplace(m,n,2) + 2*elem%spheremp(m,n)*v(m,n,2)*(ra**2) +#endif + enddo + enddo + end function vlaplace_sphere_wk_contra + + function gll_to_dgmodal(p,deriv) result(phat) +! +! input: v = velocity in lat-lon coordinates +! ouput: phat = Legendre coefficients +! +! Computes < g dot p > = SUM g(i,j) p(i,j) w(i) w(j) +! (the quadrature approximation on the *reference element* of the integral of p against +! all Legendre polynomials up to degree npdg +! +! for npdg < np, this routine gives the (exact) modal expansion of p/spheremp() +! + real(kind=r8), intent(in) :: p(np,np) + type (derivative_t), intent(in) :: deriv + real(kind=r8) :: phat(npdg,npdg) + + ! Local + integer i,j,m,n + real(kind=r8) :: A(np,npdg) + A=0 + phat=0 + + ! N^3 tensor product formulation: + do m=1,npdg + do j=1,np +!DIR$ UNROLL(NP) + do i=1,np + A(j,m)=A(j,m)+( p(i,j)*deriv%Mvv_twt(i,i)*deriv%Mvv_twt(j,j) )*deriv%legdg(m,i) + enddo + enddo + enddo + + do n=1,npdg + do m=1,npdg +!DIR$ UNROLL(NP) + do j=1,np + phat(m,n)=phat(m,n)+A(j,m)*deriv%legdg(n,j) + enddo + enddo + enddo + + end function + + function dgmodal_to_gll(phat,deriv) result(p) + ! + ! input: phat = coefficients of Legendre expansion + ! ouput: p = sum expansion to evaluate phat at GLL points + ! + real(kind=r8) :: p(np,np) + type (derivative_t), intent(in) :: deriv + real(kind=r8) :: phat(npdg,npdg) + ! Local + integer i,j,m,n + real(kind=r8) :: A(npdg,np) + + p(:,:)=0 + ! tensor product version + A=0 + do i=1,np + do n=1,npdg + do m=1,npdg + A(n,i)=A(n,i)+phat(m,n)*deriv%legdg(m,i) + enddo + enddo + enddo + do j=1,np + do i=1,np + do n=1,npdg + p(i,j) = p(i,j)+A(n,i)*deriv%legdg(n,j) + enddo + enddo + enddo + + end function dgmodal_to_gll + + subroutine subcell_dss_fluxes(dss, p, n, metdet, C, fluxes) + + integer , intent(in) :: p + integer , intent(in) :: n + real (kind=r8), intent(in) :: dss (p,p) + real (kind=r8), intent(in) :: metdet (p,p) + real (kind=r8), intent(in) :: C (2,2,2) + + real (kind=r8) :: fluxes (n,n,4) + + real (kind=r8) :: Bp(p,p) + real (kind=r8) :: Tp(p,p) + real (kind=r8) :: Lp(p,p) + real (kind=r8) :: Rp(p,p) + + real (kind=r8) :: B(n,n) + real (kind=r8) :: T(n,n) + real (kind=r8) :: L(n,n) + real (kind=r8) :: R(n,n) + + integer :: i,j + + fluxes = 0 + + Bp = 0 + Tp = 0 + Rp = 0 + Lp = 0 + + Bp(:,1) = dss(:,1) ! bottom + Tp(:,p) = dss(:,p) ! top + Rp(p,:) = dss(p,:) ! right + Lp(1,:) = dss(1,:) ! left + + Bp(1,1) = C(1,1,2) + Lp(1,1) = C(1,1,1) + Bp(p,1) = C(2,1,2) + Rp(p,1) = C(2,1,1) + + Tp(1,p) = C(1,2,2) + Lp(1,p) = C(1,2,1) + Tp(p,p) = C(2,2,2) + Rp(p,p) = C(2,2,1) + + + call subcell_integration(Bp, p, n, metdet,B) + call subcell_integration(Tp, p, n, metdet,T) + call subcell_integration(Lp, p, n, metdet,L) + call subcell_integration(Rp, p, n, metdet,R) + + do i = 1,n + do j = 1,n + if (1 [a,b] + ! all the GLL points by y = (a/2)(1-x) + (b/2)(1+x) + do i=1,intervals + a = -one + (i-one)*two/intervals + b = -one + i *two/intervals + sub_gll(i,:) = (a+b)/two + gll%points(:)/intervals + end do + + ! Now to interpolate from the values at the input GLL + ! points to the sub-GLL points. Do this by Lagrange + ! interpolation. The jth Lagrange interpolating polynomial + ! for points x_i is + ! \prod_{i\ne j} (x-x_i)/(x_j-x_i) + ! These are then multiplied by the sampled values y_i + ! and summed. + + ! Save some time by pre-computing the denominitor. I think + ! this is OK since all the points are of order 1 so should + ! be well behaved. + do n = 1,np + x_j = gll%points(n) + x = one + do m = 1,np + if (m.ne.n) then + x_i = gll%points(m) + x = x * (x_j-x_i) + endif + end do + legrange_div(n)= x + end do + do i=1,intervals + do n=1,np + x = sub_gll(i,n) + do j = 1,np + y = one + do m = 1,np + if (m.ne.j) then + x_i = gll%points(m) + y = y * (x-x_i) + end if + end do + Lagrange_interp(i,n,j) = y/legrange_div(j) + end do + end do + end do + + ! Integration is the GLL weights times Jacobians times + ! the interpolated values: + ! w^t I Y I^t w + ! where + ! w is GLL weights and Jacobians, + ! I is the Lagrange_interp matrix, and + ! Y is the coefficient matrix, sampled_val. + ! This can be written J Y J^t where + ! J = w^t I + ! J is integration_matrix + do i=1,intervals + integration_matrix(i,:) = MATMUL(gll%weights(:),Lagrange_interp(i,:,:)) + end do + + ! There is still the Jacobian to consider. We are + ! integrating over [a,b] x [c,d] where + ! |b-a| = |d-c| = 2/Intervals + ! Multiply the weights appropriately given that + ! they are defined for a 2x2 square + integration_matrix = integration_matrix/intervals + + boundary_interp_matrix(:,:,:) = Lagrange_interp(:,(/1,np/),:) + end subroutine allocate_subcell_integration_matrix_cslam + + subroutine allocate_subcell_integration_matrix_physgrid(np, intervals) + !----------------- + !----------------- + use quadrature_mod, only : gausslobatto, quadrature_t + + implicit none + + integer , intent(in) :: np + integer , intent(in) :: intervals + real (kind=r8) :: values(intervals,intervals) + + + real(kind=r8), parameter :: zero = 0.0D0, one=1.0D0, two=2.0D0 + + + real (kind=r8) :: sub_gll (intervals,np) + + real (kind=r8) :: Lagrange_interp(intervals,np,np) + type (quadrature_t) :: gll + + real (kind=r8) :: legrange_div(np) + real (kind=r8) :: a,b,x,y, x_j, x_i + real (kind=r8) :: r(1) + integer i,j,n,m + + if (ALLOCATED(integration_matrix_physgrid)) deallocate(integration_matrix_physgrid) + allocate(integration_matrix_physgrid(intervals,np)) + + gll = gausslobatto(np) + + ! The GLL (Gauss-Lobatto-Legendre) points are from [-1,1], + ! we have a bunch of sub-intervals defined by intervals that + ! go from [a,b] so we need to linearly map [-1,1] -> [a,b] + ! all the GLL points by y = (a/2)(1-x) + (b/2)(1+x) + do i=1,intervals + a = -one + (i-one)*two/intervals + b = -one + i *two/intervals + sub_gll(i,:) = (a+b)/two + gll%points(:)/intervals + end do + + ! Now to interpolate from the values at the input GLL + ! points to the sub-GLL points. Do this by Lagrange + ! interpolation. The jth Lagrange interpolating polynomial + ! for points x_i is + ! \prod_{i\ne j} (x-x_i)/(x_j-x_i) + ! These are then multiplied by the sampled values y_i + ! and summed. + + ! Save some time by pre-computing the denominitor. I think + ! this is OK since all the points are of order 1 so should + ! be well behaved. + do n = 1,np + x_j = gll%points(n) + x = one + do m = 1,np + if (m.ne.n) then + x_i = gll%points(m) + x = x * (x_j-x_i) + endif + end do + legrange_div(n)= x + end do + do i=1,intervals + do n=1,np + x = sub_gll(i,n) + do j = 1,np + y = one + do m = 1,np + if (m.ne.j) then + x_i = gll%points(m) + y = y * (x-x_i) + end if + end do + Lagrange_interp(i,n,j) = y/legrange_div(j) + end do + end do + end do + do i=1,intervals + integration_matrix_physgrid(i,:) = MATMUL(gll%weights(:),Lagrange_interp(i,:,:)) + end do + integration_matrix_physgrid = integration_matrix_physgrid/intervals + end subroutine allocate_subcell_integration_matrix_physgrid + + + + subroutine limiter_optim_iter_full(ptens,sphweights,minp,maxp,dpmass,kbeg,kend) + ! + !The idea here is the following: We need to find a grid field which is closest + !to the initial field (in terms of weighted sum), but satisfies the min/max constraints. + !So, first we find values which do not satisfy constraints and bring these values + !to a closest constraint. This way we introduce some mass change (addmass), + !so, we redistribute addmass in the way that l2 error is smallest. + !This redistribution might violate constraints thus, we do a few iterations. + ! + ! O. Guba ~2012 Documented in Guba, Taylor & St-Cyr, JCP 2014 + ! I. Demeshko & M. Taylor 7/2015: Removed indirect addressing. + ! N. Lopez & M. Taylor 8/2015: Mass redistributon tweak which is better at + ! linear coorelation preservation + ! + use dimensions_mod, only : np, np, nlev + + real (kind=r8), dimension(nlev), intent(inout) :: minp, maxp + real (kind=r8), dimension(np*np,nlev), intent(inout) :: ptens + real (kind=r8), dimension(np*np,nlev), intent(in), optional :: dpmass + real (kind=r8), dimension(np*np), intent(in) :: sphweights + integer, intent(in) :: kbeg, kend + + real (kind=r8), dimension(np,np) :: ptens_mass + integer k1, k, i, j, iter, weightsnum + real (kind=r8) :: addmass, weightssum, mass, sumc + real (kind=r8) :: x(np*np),c(np*np) + integer :: maxiter = np*np-1 + real (kind=r8) :: tol_limiter = 5.0e-14_r8 + + do k = kbeg, kend + + do k1=1,np*np + c(k1)=sphweights(k1)*dpmass(k1,k) + x(k1)=ptens(k1,k)/dpmass(k1,k) + enddo + + sumc=sum(c) + if (sumc <= 0 ) CYCLE ! this should never happen, but if it does, dont limit + mass=sum(c*x) + + + + ! relax constraints to ensure limiter has a solution: + ! This is only needed if runnign with the SSP CFL>1 or + ! due to roundoff errors + if( mass < minp(k)*sumc ) then + minp(k) = mass / sumc + endif + if( mass > maxp(k)*sumc ) then + maxp(k) = mass / sumc + endif + + + + do iter=1,maxiter + + addmass=0.0d0 + + do k1=1,np*np + if((x(k1)>maxp(k))) then + addmass=addmass+(x(k1)-maxp(k))*c(k1) + x(k1)=maxp(k) + endif + if((x(k1)0)then + do k1=1,np*np + if(x(k1)minp(k))then + weightssum=weightssum+c(k1) + endif + enddo + do k1=1,np*np + if(x(k1)>minp(k))then + x(k1)=x(k1)+addmass/weightssum + endif + enddo + endif + + + enddo!end of iteration + + do k1=1,np*np + ptens(k1,k)=x(k1) + enddo + + enddo + + do k = kbeg, kend + do k1=1,np*np + ptens(k1,k)=ptens(k1,k)*dpmass(k1,k) + enddo + enddo + + end subroutine limiter_optim_iter_full + + + + + +end module derivative_mod diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 new file mode 100644 index 0000000000..ae0aa02709 --- /dev/null +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -0,0 +1,127 @@ +module dimensions_mod + use shr_kind_mod, only: r8=>shr_kind_r8 +#ifdef FVM_TRACERS + use constituents, only: ntrac_d=>pcnst ! _EXTERNAL +#else + use constituents, only: qsize_d=>pcnst ! _EXTERNAL +#endif + + implicit none + private + +! set MAX number of tracers. actual number of tracers is a run time argument +#ifdef FVM_TRACERS + integer, parameter :: qsize_d = 6 ! SE tracers (currently SE supports 6 condensate loading tracers) +#else + integer, parameter :: ntrac_d = 0 ! No fvm tracers if CSLAM is off +#endif + + integer, public :: qsize_condensate_loading = 1 !how many water variables to include in full density + ! + ! The variables below hold indices of water vapor and condensate loading tracers as well as + ! associated heat capacities (initialized in dyn_init): + ! + ! qsize_condensate_loading_idx = index of water tracers included in condensate loading according to CAM physics + ! qsize_condensate_loading_idx_gll = index of water tracers included in condensate loading terms for SE tracers + ! + ! Note that when running without CSLAM then + ! + ! qsize_condensate_loading_idx_gll = qsize_condensate_loading_idx + ! + ! but when running with CSLAM then SE tracers are only the water tracers included in the condensate loading + ! + integer, allocatable, public :: qsize_condensate_loading_idx(:) + integer, allocatable, public :: qsize_condensate_loading_idx_gll(:) + real(r8), allocatable, public :: qsize_condensate_loading_cp(:) + character(len=16), allocatable, public :: cnst_name_gll(:) ! constituent names for SE tracers + character(len=128), allocatable, public :: cnst_longname_gll(:) ! long name of SE tracers + ! + !moist cp in energy conversion term + ! + ! .false.: force dycore to use cpd (cp dry) instead of moist cp + ! .true. : use moist cp in dycore + ! + logical , public :: lcp_moist = .true. + + integer, parameter, public :: np = NP + integer, parameter, public :: nc = 3 !cslam resolution + integer , public :: fv_nphys !physics-grid resolution - the "MAX" is so that the code compiles with NC=0 + + integer :: ntrac = 0 !ntrac is set in dyn_comp + integer :: qsize = 0 !qsize is set in dyn_comp + ! + ! hyperviscosity is applied on approximate pressure levels + ! Similar to CAM-EUL; see CAM5 scietific documentation (Note TN-486), equation (3.09), page 58. + ! + logical, public :: hypervis_on_plevs = .true. + ! fvm dimensions: + logical, public :: lprint!for debugging + integer, parameter, public :: ngpc=3 !number of Gausspoints for the fvm integral approximation !phl change from 4 + integer, parameter, public :: irecons_tracer=6!=1 is PCoM, =3 is PLM, =6 is PPM for tracer reconstruction + integer, parameter, public :: nhe=1 !Max. Courant number + integer, parameter, public :: nhr=2 !halo width needed for reconstruction - phl + integer, parameter, public :: nht=nhe+nhr !total halo width where reconstruction is needed (nht<=nc) - phl + integer, parameter, public :: ns=3!quadratic halo interpolation - recommended setting for nc=3 + !nhc determines width of halo exchanged with neighboring elements + integer, parameter, public :: nhc = nhr+(nhe-1)+(ns-MOD(ns,2))/2 + !(different from halo needed for elements on edges and corners + integer, parameter, public :: lbc = 1-nhc + integer, parameter, public :: ubc = nc+nhc + + + integer, parameter, public :: kmin_jet=1,kmax_jet=PLEV !min and max level index for the jet + + integer, public :: nhc_phys + integer, public :: nhe_phys + integer, public :: nhr_phys + integer, public :: ns_phys + + integer, public :: npdg = 0 ! dg degree for hybrid cg/dg element 0=disabled + + integer, parameter, public :: npsq = np*np + integer, parameter, public :: nlev=PLEV + integer, parameter, public :: nlevp=nlev+1 + + +! params for a mesh +! integer, public, parameter :: max_elements_attached_to_node = 7 +! integer, public, parameter :: s_nv = 2*max_elements_attached_to_node + + !default for non-refined mesh (note that these are *not* parameters now) + integer, public :: max_elements_attached_to_node = 4 + integer, public :: s_nv = 6 + integer, public :: max_corner_elem = 1 !max_elements_attached_to_node-3 + integer, public :: max_neigh_edges = 8 !4 + 4*max_corner_elem + + public :: qsize,qsize_d,ntrac_d,ntrac + + integer, public :: ne + integer, public :: nelem ! total number of elements + integer, public :: nelemd ! number of elements per MPI task + integer, public :: nelemdmax ! max number of elements on any MPI task + integer, public :: nPhysProc ! This is the number of physics processors/ per dynamics processor + integer, public :: nnodes,npart,nmpi_per_node + integer, public :: GlobalUniqueCols + + + + public :: set_mesh_dimensions + +contains + + subroutine set_mesh_dimensions() + + ! new "params" + max_elements_attached_to_node = 7 ! variable resolution + s_nv = 2*max_elements_attached_to_node + + !recalculate these + max_corner_elem = max_elements_attached_to_node-3 + max_neigh_edges = 4 + 4*max_corner_elem + + + end subroutine set_mesh_dimensions + + +end module dimensions_mod + diff --git a/src/dynamics/se/dycore/dof_mod.F90 b/src/dynamics/se/dycore/dof_mod.F90 new file mode 100644 index 0000000000..4b33c2788a --- /dev/null +++ b/src/dynamics/se/dycore/dof_mod.F90 @@ -0,0 +1,402 @@ +module dof_mod + use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 + use dimensions_mod, only: np, npsq, nelem, nelemd + use quadrature_mod, only: quadrature_t + use element_mod, only: element_t,index_t + use spmd_utils, only: mpi_integer + use parallel_mod, only: parallel_t + use edge_mod, only: initedgebuffer,freeedgebuffer, & + longedgevpack, longedgevunpackmin + use edgetype_mod, only: longedgebuffer_t + use bndry_mod, only: bndry_exchange +implicit none +private + ! public data + ! public subroutines + public :: global_dof + public :: UniquePoints + public :: PutUniquePoints + public :: UniqueNcolsP + public :: UniqueCoords + public :: CreateUniqueIndex + public :: SetElemOffset + public :: CreateMetaData + + interface UniquePoints + module procedure UniquePoints2D + module procedure UniquePoints3D + module procedure UniquePoints4D + end interface + interface PutUniquePoints + module procedure PutUniquePoints2D + module procedure PutUniquePoints3D + module procedure PutUniquePoints4D + end interface + + +contains + + subroutine genLocalDof(ig,npts,ldof) + + integer, intent(in) :: ig + integer, intent(in) :: npts + integer, intent(inout) :: ldof(:,:) + + integer :: i,j,npts2 + + + npts2=npts*npts + do j=1,npts + do i=1,npts + ldof(i,j) = (ig-1)*npts2 + (j-1)*npts + i + enddo + enddo + + end subroutine genLocalDOF + +! =========================================== +! global_dof +! +! Compute the global degree of freedom for each element... +! =========================================== + + subroutine global_dof(par,elem) + + type (parallel_t),intent(in) :: par + type (element_t) :: elem(:) + + type (LongEdgeBuffer_t) :: edge + + real(kind=r8) da ! area element + + type (quadrature_t) :: gp + + integer :: ldofP(np,np,nelemd) + + integer ii + integer i,j,ig,ie + integer kptr + integer iptr + + ! =================== + ! begin code + ! =================== + call initEdgeBuffer(edge,1) + + ! ================================================= + ! mass matrix on the velocity grid + ! ================================================= + + + do ie=1,nelemd + ig = elem(ie)%vertex%number + call genLocalDOF(ig,np,ldofP(:,:,ie)) + + kptr=0 + call LongEdgeVpack(edge,ldofP(:,:,ie),1,kptr,elem(ie)%desc) + end do + + ! ============================== + ! Insert boundary exchange here + ! ============================== + + call bndry_exchange(par,edge) + + do ie=1,nelemd + ! we should unpack directly into elem(ie)%gdofV, but we dont have + ! a VunpackMIN that takes integer*8. gdofV integer*8 means + ! more than 2G grid points. + kptr=0 + call LongEdgeVunpackMIN(edge,ldofP(:,:,ie),1,kptr,elem(ie)%desc) + elem(ie)%gdofP(:,:)=ldofP(:,:,ie) + end do +!$OMP BARRIER + call FreeEdgeBuffer(edge) + + end subroutine global_dof + + + subroutine UniquePoints2D(idxUnique,src,dest) + type (index_t) :: idxUnique + real (kind=r8) :: src(:,:) + real (kind=r8) :: dest(:) + + integer :: i,j,ii + + + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + dest(ii)=src(i,j) + enddo + + end subroutine UniquePoints2D + +! putUniquePoints first zeros out the destination array, then fills the unique points of the +! array with values from src. A boundary communication should then be called to fill in the +! redundent points of the array + + subroutine putUniquePoints2D(idxUnique,src,dest) + type (index_t) :: idxUnique + real (kind=r8),intent(in) :: src(:) + real (kind=r8),intent(out) :: dest(:,:) + + integer :: i,j,ii + + dest=0.0D0 + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + dest(i,j)=src(ii) + enddo + + end subroutine putUniquePoints2D + + subroutine UniqueNcolsP(elem,idxUnique,cid) + use element_mod, only : GetColumnIdP, element_t + type (element_t), intent(in) :: elem + type (index_t), intent(in) :: idxUnique + integer,intent(out) :: cid(:) + integer :: i,j,ii + + + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + cid(ii)=GetColumnIdP(elem,i,j) + enddo + + end subroutine UniqueNcolsP + + + subroutine UniqueCoords(idxUnique,src,lat,lon) + + use coordinate_systems_mod, only : spherical_polar_t + type (index_t), intent(in) :: idxUnique + + type (spherical_polar_t) :: src(:,:) + real (kind=r8), intent(out) :: lat(:) + real (kind=r8), intent(out) :: lon(:) + + integer :: i,j,ii + + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + lat(ii)=src(i,j)%lat + lon(ii)=src(i,j)%lon + enddo + + end subroutine UniqueCoords + + subroutine UniquePoints3D(idxUnique,nlyr,src,dest) + type (index_t) :: idxUnique + integer :: nlyr + real (kind=r8) :: src(:,:,:) + real (kind=r8) :: dest(:,:) + + integer :: i,j,k,ii + + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + do k=1,nlyr + dest(ii,k)=src(i,j,k) + enddo + enddo + + end subroutine UniquePoints3D + subroutine UniquePoints4D(idxUnique,d3,d4,src,dest) + type (index_t) :: idxUnique + integer :: d3,d4 + real (kind=r8) :: src(:,:,:,:) + real (kind=r8) :: dest(:,:,:) + + integer :: i,j,k,n,ii + + do n=1,d4 + do k=1,d3 + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + dest(ii,k,n)=src(i,j,k,n) + enddo + end do + enddo + + end subroutine UniquePoints4D + +! putUniquePoints first zeros out the destination array, then fills the unique points of the +! array with values from src. A boundary communication should then be called to fill in the +! redundent points of the array + + subroutine putUniquePoints3D(idxUnique,nlyr,src,dest) + type (index_t) :: idxUnique + integer :: nlyr + real (kind=r8),intent(in) :: src(:,:) + real (kind=r8),intent(out) :: dest(:,:,:) + + integer :: i,j,k,ii + + dest=0.0D0 + do k=1,nlyr + do ii=1,idxUnique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + dest(i,j,k)=src(ii,k) + enddo + enddo + + end subroutine putUniquePoints3D + + subroutine putUniquePoints4D(idxUnique,d3,d4,src,dest) + type (index_t) :: idxUnique + integer :: d3,d4 + real (kind=r8),intent(in) :: src(:,:,:) + real (kind=r8),intent(out) :: dest(:,:,:,:) + + integer :: i,j,k,n,ii + + dest=0.0D0 + do n=1,d4 + do k=1,d3 + do ii=1,idxunique%NumUniquePts + i=idxUnique%ia(ii) + j=idxUnique%ja(ii) + dest(i,j,k,n)=src(ii,k,n) + enddo + enddo + end do + end subroutine putUniquePoints4D + + subroutine SetElemOffset(par,elem,GlobalUniqueColsP) + use spmd_utils, only : mpi_sum + + type (parallel_t) :: par + type (element_t) :: elem(:) + integer, intent(out) :: GlobalUniqueColsP + + integer, allocatable :: numElemP(:),numElem2P(:) + integer, allocatable :: numElemV(:),numElem2V(:) + integer, allocatable :: gOffset(:) + + integer :: ie, ig, nprocs, ierr + logical, parameter :: Debug = .FALSE. + + nprocs = par%nprocs + allocate(numElemP(nelem)) + allocate(numElem2P(nelem)) + allocate(gOffset(nelem)) + numElemP=0;numElem2P=0;gOffset=0 + + do ie = 1, nelemd + ig = elem(ie)%GlobalId + numElemP(ig) = elem(ie)%idxP%NumUniquePts + end do + call MPI_Allreduce(numElemP,numElem2P,nelem,MPI_INTEGER,MPI_SUM,par%comm,ierr) + + gOffset(1)=1 + do ig = 2, nelem + gOffset(ig) = gOffset(ig-1)+numElem2P(ig-1) + end do + do ie = 1, nelemd + ig = elem(ie)%GlobalId + elem(ie)%idxP%UniquePtOffset=gOffset(ig) + end do + GlobalUniqueColsP = gOffset(nelem)+numElem2P(nelem)-1 + + deallocate(numElemP) + deallocate(numElem2P) + deallocate(gOffset) + end subroutine SetElemOffset + + subroutine CreateUniqueIndex(ig,gdof,idx) + + integer :: ig + type (index_t) :: idx + integer(i8) :: gdof(:,:) + + integer, allocatable :: ldof(:,:) + integer :: i,j,ii,npts + + + npts = size(gdof,dim=1) + allocate(ldof(npts,npts)) + ! ==================== + ! Form the local DOF + ! ==================== + call genLocalDOF(ig,npts,ldof) + + ii=1 + + do j=1,npts + do i=1,npts + ! ========================== + ! check for point ownership + ! ========================== + if(gdof(i,j) .eq. ldof(i,j)) then + idx%ia(ii) = i + idx%ja(ii) = j + ii=ii+1 + endif + enddo + enddo + + idx%NumUniquePts=ii-1 + deallocate(ldof) + + end subroutine CreateUniqueIndex + + + subroutine CreateMetaData(par,elem,subelement_corners, fdofp) + type (parallel_t), intent(in) :: par + type (element_t), target :: elem(:) + + integer, optional, intent(out) :: subelement_corners((np-1)*(np-1)*nelemd,4) + integer, optional :: fdofp(np,np,nelemd) + + type (index_t), pointer :: idx + type (LongEdgeBuffer_t) :: edge + integer :: i, j, ii, ie, base + integer(i8), pointer :: gdof(:,:) + integer :: fdofp_local(np,np,nelemd) + + call initEdgeBuffer(edge,1) + fdofp_local=0 + + do ie=1,nelemd + idx => elem(ie)%idxP + do ii=1,idx%NumUniquePts + i=idx%ia(ii) + j=idx%ja(ii) + + fdofp_local(i,j,ie) = -(idx%UniquePtoffset+ii-1) + end do + call LongEdgeVpack(edge,fdofp_local(:,:,ie),1,0,elem(ie)%desc) + end do + call bndry_exchange(par,edge) + do ie=1,nelemd + base = (ie-1)*(np-1)*(np-1) + call LongEdgeVunpackMIN(edge,fdofp_local(:,:,ie),1,0,elem(ie)%desc) + if(present(subelement_corners)) then + ii=0 + do j=1,np-1 + do i=1,np-1 + ii=ii+1 + subelement_corners(base+ii,1) = -fdofp_local(i,j,ie) + subelement_corners(base+ii,2) = -fdofp_local(i,j+1,ie) + subelement_corners(base+ii,3) = -fdofp_local(i+1,j+1,ie) + subelement_corners(base+ii,4) = -fdofp_local(i+1,j,ie) + end do + end do + end if + end do + if(present(fdofp)) then + fdofp=-fdofp_local + end if + + + + end subroutine CreateMetaData + +end module dof_mod diff --git a/src/dynamics/se/dycore/edge_mod.F90 b/src/dynamics/se/dycore/edge_mod.F90 new file mode 100644 index 0000000000..f0cd967ee8 --- /dev/null +++ b/src/dynamics/se/dycore/edge_mod.F90 @@ -0,0 +1,2629 @@ +module edge_mod + + use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 + use dimensions_mod, only: max_neigh_edges, nelemd + use perf_mod, only: t_startf, t_stopf, t_adj_detailf ! _EXTERNAL + use thread_mod, only: max_num_threads, omp_get_num_threads, omp_get_thread_num + use coordinate_systems_mod, only: cartesian3D_t + use schedtype_mod, only: cycle_t, schedule_t, pgindex_t, schedule, HME_Ordinal,HME_Cardinal + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use parallel_mod, only: parallel_t, & + MAX_ACTIVE_MSG, HME_status_size, BNDRY_TAG_BASE, HME_BNDRY_A2A, HME_BNDRY_P2P, & + HME_BNDRY_A2AO + use edgetype_mod, only: edgedescriptor_t, edgebuffer_t, & + Longedgebuffer_t, initedgebuffer_callid, Ghostbuffer3D_t + use element_mod, only: element_t + use gbarrier_mod, only: gbarrier_init, gbarrier_delete + use spmd_utils, only: mpi_real8, mpi_integer, mpi_info_null, mpi_success + + implicit none + private + save + + ! 8-byte Integer routines + public :: LongEdgeVpack, LongEdgeVunpackMIN + + ! 8-byte Real routines + public :: zeroEdgeBuffer + + interface initEdgeBuffer + module procedure initEdgeBuffer_r8 + module procedure initEdgeBuffer_i8 + end interface + interface initEdgeSBuffer + module procedure initEdgeSbuffer_r8 + end interface + interface freeEdgeBuffer + module procedure freeEdgeBuffer_r8 + module procedure freeEdgeBuffer_i8 + end interface + interface freeGhostBuffer + module procedure freeGhostBuffer_r8 + end interface + + public :: initEdgeBuffer + public :: initEdgeSBuffer + public :: freeEdgeBuffer + + public :: initGhostBuffer + public :: ghostpack, ghostunpack + public :: freeGhostBuffer + + !--------------------------------------------------------- + ! Pack/unpack routines that use the New format Edge buffer + !--------------------------------------------------------- + + public :: edgeVpack, edgeVunpack + public :: edgeVunpackMIN, edgeVunpackMAX + public :: edgeDGVpack, edgeDGVunpack + public :: edgeVunpackVert + + + public :: initGhostBuffer3D + public :: FreeGhostBuffer3D + public :: ghostVpack3D, ghostVunpack3D + + !---------------------------------------------------------------- + ! Pack/unpack routines that communicate a fixed number values + ! per element. This is used to communicate MIN/MAX values from + ! neighboring elemeents + !---------------------------------------------------------------- + interface edgeSpack + module procedure edgeSpack_r8 + end interface + public :: edgeSpack + public :: edgeSunpackMIN, edgeSunpackMAX + + logical, private :: threadsafe=.true. + + real(kind=r8), parameter, public :: edgeDefaultVal = 1.11e+100_r8 + +! NOTE ON ELEMENT ORIENTATION +! +! Element orientation: index V(i,j) +! +! (1,np) NWEST (np,np) NEAST +! +! (1,1) SWEST (np,1) SEAST +! +! +! for the edge neighbors: +! we set the "reverse" flag if two elements who share an edge use a +! reverse orientation. The data is reversed during the *pack* stage +! For corner neighbors: +! for edge buffers, there is no orientation because two corner neighbors +! only share a single point. +! For ghost cell data, there is a again two posible orientations. For +! this case, we set the "reverse" flag if the corner element is using +! the reverse orientation. In this case, the data is reversed during the +! *unpack* stage (not sure why) +! +! The edge orientation is set at startup. The corner orientation is computed +! at run time, via the call to compute_ghost_corner_orientation() +! This routine only works for meshes with at most 1 corner element. It's +! not called and the corner orientation flag is not set for unstructured meshes + +! +! Christoph Erath +! pack/unpack partial element of data of size (nx,nx) with user specifed halo size nh +! user specifies the sizes when creating the buffer +! buffer has 1 extra dimension (as compared to subroutines above) for multiple tracers +! input/output arrays are cartesian, and thus assume at most 1 element at each corner +! hence currently only supports cube-sphere grids. +! +! +! routines which including element edge data +! (used for FVM arrays where edge data is not shared by neighboring elements) +! these routines pack/unpack element data with user specified halo size + + ! Wrap pointer so we can make an array of them. + type :: wrap_ptr + real (kind=r8), dimension(:,:), pointer :: ptr => null() + end type wrap_ptr + + type(wrap_ptr) :: edgebuff_ptrs(0:1) + +contains + + subroutine initEdgeSBuffer_r8(par,edge,elem,nlyr,bndry_type, nthreads) + type (parallel_t), intent(in) :: par + type (EdgeBuffer_t), target, intent(out) :: edge + type (element_t), intent(in) :: elem(:) + integer, intent(in) :: nlyr + integer , optional, intent(in) :: bndry_type + integer, optional, intent(in) :: nthreads + + + call initEdgeBuffer(par,edge,elem,nlyr,bndry_type=bndry_type, & + nthreads=nthreads,CardinalLength=1,OrdinalLength=1) + + end subroutine initEdgeSBuffer_r8 + + subroutine initGhostBuffer(par,edge,elem,nlyr,ndepth, npoints,bndry_type,nthreads) + + type (parallel_t), intent(in) :: par + type (Edgebuffer_t), target, intent(out) :: edge + type (element_t), intent(in) :: elem(:) + integer,intent(in) :: nlyr,ndepth, npoints + integer , optional, intent(in) :: bndry_type + integer, optional, intent(in) :: nthreads + + call initEdgeBuffer(par,edge,elem,nlyr,bndry_type=bndry_type, & + nthreads=nthreads,CardinalLength=ndepth*npoints,OrdinalLength=ndepth*ndepth) + ! set some parameters need to support deep halos + edge%ndepth = ndepth + edge%npoints = npoints + edge%lb = 1 - edge%ndepth + edge%ub = edge%npoints + edge%ndepth + + end subroutine initGhostBuffer + + + + subroutine zeroEdgeBuffer(edge) + + type (EdgeBuffer_t), intent(inout) :: edge + integer :: i + + do i=1,edge%nbuf + edge%buf(i) = 0.0d0 + edge%receive(i) = 0.0d0 + enddo + + end subroutine zeroEdgeBuffer + + ! ========================================= + ! initEdgeBuffer: + ! + ! create an Real based communication buffer + ! ========================================= + subroutine initEdgeBuffer_r8(par,edge,elem,nlyr, bndry_type,nthreads,CardinalLength,OrdinalLength) + use dimensions_mod, only: np, nelemd, max_corner_elem + use schedtype_mod, only: cycle_t, schedule_t, schedule + use mpi, only: MPI_VERSION + + type (parallel_t), intent(in) :: par + type (EdgeBuffer_t), target, intent(out) :: edge + type (element_t), intent(in) :: elem(:) + integer, intent(in) :: nlyr + integer, optional, intent(in) :: bndry_type + integer, optional, intent(in) :: nthreads + integer, optional, intent(in) :: CardinalLength + integer, optional, intent(in) :: OrdinalLength + + ! Notes about the buf_ptr/receive_ptr options: + ! + ! If an EdgeBuffer_t object is initialized from pre-existing storage + ! (i.e. buf_ptr is provided and not null), it must *not* be freed, + ! and must not be used if the underlying storage has been deallocated. + ! + ! All these restrictions also applied to the old newbuf and newreceive + ! options. + + ! Workaround for NAG bug. + ! NAG 5.3.1 dies if you use pointer bounds remapping to set + ! a pointer that is also a component. So remap to temporary, + ! then use that to set component pointer. + + ! Local variables + integer :: nbuf,ith + integer :: nSendCycles, nRecvCycles + integer :: icycle, ierr + integer :: ie, i + integer :: edgeid,elemid + integer :: ptr,llen,moveLength, mLen, tlen + type (Cycle_t), pointer :: pCycle + type (Schedule_t), pointer :: pSchedule + integer :: dest, source, length, tag, iptr + integer :: nlen, ithr + + integer :: len, lenP,lenS + integer :: j,jj,il,mesgid, dst0,src0 + integer :: moveptr + integer :: nbuf2,ilm1,iem1,lenm1 + integer,allocatable :: putmap2(:,:),getmap2(:,:) + integer,allocatable :: scounts(:), rcounts(:) + integer,allocatable :: sdispls(:), rdispls(:) + integer :: nInter, nIntra + integer :: icInter, icIntra + + integer :: maxnsend + integer :: tmpnMesg + integer :: wintmpnMesg, wintmpDest, wintmpDisp + integer(kind=i8) :: winsize + integer :: win + integer :: sizeofreal + integer, allocatable :: tmpDest(:),tmpDisp(:) + integer :: nFull + integer :: disp, one + integer :: errorcode,errorlen + integer :: CardinalLen, OrdinalLen + character(len=80) :: errorstring + character(len=80), parameter :: subname='initedgeBuffer' + + if(present(bndry_type)) then + if ( MPI_VERSION >= 3 ) then + edge%bndry_type = bndry_type + else + edge%bndry_type = HME_BNDRY_P2P + endif + else + edge%bndry_type = HME_BNDRY_P2P + endif + + ! Set the length of the cardinal and ordinal message lengths + if(present(CardinalLength)) then + CardinalLen = CardinalLength + else + CardinalLen = np + endif + if(present(OrdinalLength)) then + OrdinalLen = OrdinalLength + else + OrdinalLen = 1 + endif + +! DO NOT REMOVE THIS NEXT BARRIER +! MT: This initial barrier fixes a long standing issue with Intel compilers on +! two different platforms. Without this barrier, edge buffers initialized from +! within the threaded region would not work in a reproducable way with certain +! thread combinations. I cant explain why, but this fixes that issue on Edison +!$OMP BARRIER + + if (nlyr==0) return ! tracer code might call initedgebuffer() with zero tracers + + +!$OMP MASTER + ! + ! Keep a counter of how many times initedgebuffer is called. + ! This is used to assign a unique message ID for the boundary exchange + ! + initedgebuffer_callid=initedgebuffer_callid+1 + edge%id = initedgebuffer_callid + edge%tag = BNDRY_TAG_BASE + MODULO(edge%id, MAX_ACTIVE_MSG) + + allocate(edge%putmap(max_neigh_edges,nelemd)) + allocate(edge%getmap(max_neigh_edges,nelemd)) + allocate(edge%reverse(max_neigh_edges,nelemd)) + + edge%putmap(:,:)=-1 + edge%getmap(:,:)=-1 + + allocate(putmap2(max_neigh_edges,nelemd)) + allocate(getmap2(max_neigh_edges,nelemd)) + putmap2(:,:)=-1 + getmap2(:,:)=-1 + do ie=1,nelemd + do i=1,max_neigh_edges + edge%reverse(i,ie) = elem(ie)%desc%reverse(i) + enddo + enddo + + pSchedule => Schedule(1) + nSendCycles = pSchedule%nSendCycles + nRecvCycles = pSchedule%nRecvCycles + nInter = pSchedule%nInter + nIntra = pSchedule%nIntra + nFull = nInter+nIntra + + edge%nInter=nInter + edge%nIntra=nIntra + + if(nInter>0) then + allocate(edge%rcountsInter(nInter),edge%rdisplsInter(nInter)) + allocate(edge%scountsInter(nInter),edge%sdisplsInter(nInter)) + endif + if(nIntra>0) then + allocate(edge%rcountsIntra(nIntra),edge%rdisplsIntra(nIntra)) + allocate(edge%scountsIntra(nIntra),edge%sdisplsIntra(nIntra)) + endif + + if (nSendCycles>0) then + allocate(edge%scountsFull(nSendCycles),edge%sdisplsFull(nSendCycles)) + allocate(edge%Srequest(nSendCycles)) + edge%scountsFull(:) = 0 + endif + ! + ! Setup the data-structures for the sends + ! + j = 1 + icycle = 1 + dst0 = pSchedule%pIndx(j)%mesgid + il = pSchedule%pIndx(j)%edgeid + ie = pSchedule%pIndx(j)%elemid + len = CalcSegmentLength(pSchedule%pIndx(j),CardinalLen,OrdinalLen,nlyr) + edge%putmap(il,ie) = 0 + if(nSendCycles>0) then + edge%sdisplsFull(icycle) = edge%putmap(il,ie) + edge%scountsFull(icycle) = len + endif + ilm1 = il + iem1 = ie + lenm1 = len + + do j=2,SIZE(pSchedule%pIndx) + il = pSchedule%pIndx(j)%edgeid + ie = pSchedule%pIndx(j)%elemid + mesgid = pSchedule%pIndx(j)%mesgid + if(il>0 .and. ie >0) then + len = CalcSegmentLength(pSchedule%pIndx(j),CardinalLen,OrdinalLen,nlyr) + edge%putmap(il,ie) = edge%putmap(ilm1,iem1)+lenm1 + if(mesgid .ne. par%rank) then ! don't enter if this is a move cycle where (mesgid == par%rank) + if(mesgid .ne. dst0) then + icycle=icycle+1 + if (nSendCycles>0) edge%sdisplsFull(icycle) = edge%putmap(il,ie) + dst0=mesgid + endif + if (nSendCycles>0) edge%scountsFull(icycle) = edge%scountsFull(icycle)+len + endif + ilm1=il + iem1=ie + lenm1=len + endif + enddo + + icInter=0 + icIntra=0 + do icycle=1,nSendCycles + if(pSchedule%SendCycle(icycle)%onNode .eqv. .FALSE.) then + icInter=icInter+1 + edge%sdisplsInter(icInter)=edge%sdisplsFull(icycle) + edge%scountsInter(icInter)=edge%scountsFull(icycle) + else + icIntra=icIntra+1 + edge%sdisplsIntra(icIntra)=edge%sdisplsFull(icycle) + edge%scountsIntra(icIntra)=edge%scountsFull(icycle) + endif + enddo + + if (nRecvCycles>0) then + allocate(edge%rcountsFull(nRecvCycles),edge%rdisplsFull(nRecvCycles)) + allocate(edge%getDisplsFull(nRecvCycles),edge%putDisplsFull(nRecvCycles)) + edge%rcountsFull(:) = 0 + ! allocate the MPI Send/Recv request handles + allocate(edge%Rrequest(nRecvCycles)) + allocate(edge%status(HME_status_size,nRecvCycles)) + endif + + ! + ! Setup the data-structures for the receives + ! + j = 1 + icycle = 1 + src0 = pSchedule%gIndx(j)%mesgid + il = pSchedule%gIndx(j)%edgeid + ie = pSchedule%gIndx(j)%elemid + len = CalcSegmentLength(pSchedule%gIndx(j),CardinalLen,OrdinalLen,nlyr) + edge%getmap(il,ie) = 0 + if (nRecvCycles>0) then + edge%rdisplsFull(icycle) = edge%getmap(il,ie) + edge%rcountsFull(icycle) = len + endif + ilm1=il + iem1=ie + lenm1=len + + do j=2,SIZE(pSchedule%gIndx) + il = pSchedule%gIndx(j)%edgeid + ie = pSchedule%gIndx(j)%elemid + mesgid = pSchedule%gIndx(j)%mesgid + if(il>0 .and. ie >0) then + len = CalcSegmentLength(pSchedule%gIndx(j),CardinalLen,OrdinalLen,nlyr) + edge%getmap(il,ie) = edge%getmap(ilm1,iem1)+lenm1 + if(mesgid .ne. par%rank) then ! don't enter if this is a move cycle where (mesgid == par%rank) + if(mesgid .ne. src0) then + if (nRecvCycles>0) edge%rdisplsFull(icycle+1) = edge%getmap(il,ie) + icycle=icycle+1 + src0=mesgid + endif + if (nRecvCycles>0) edge%rcountsFull(icycle) = edge%rcountsFull(icycle)+len + endif + ilm1=il + iem1=ie + lenm1=len + endif + enddo + + + ! + ! populate the Inter and Intra node communication data-structures + ! + icInter=0 + icIntra=0 + do icycle=1,nRecvCycles + if(pSchedule%RecvCycle(icycle)%onNode .eqv. .FALSE.) then + icInter=icInter+1 + edge%rdisplsInter(icInter)=edge%rdisplsFull(icycle) + edge%rcountsInter(icInter)=edge%rcountsFull(icycle) + else + icIntra=icIntra+1 + edge%rdisplsIntra(icIntra)=edge%rdisplsFull(icycle) + edge%rcountsIntra(icIntra)=edge%rcountsFull(icycle) + endif + enddo + + + ! Setup the data-structures for the on process moves + ! Note that this assumes that the data to move is at + ! the end of the message buffer. + if(nRecvCycles>0) then + moveptr = edge%rdisplsFull(nRecvCycles)+edge%rcountsFull(nRecvCycles)+1 + else + moveptr = 1 + endif + moveLength = 0 + do j=1,SIZE(pSchedule%gIndx) + il = pSchedule%gIndx(j)%edgeid + ie = pSchedule%gIndx(j)%elemid + mesgid = pSchedule%gIndx(j)%mesgid + if(mesgid == par%rank) then + len = CalcSegmentLength(pSchedule%gIndx(j),CardinalLen,OrdinalLen,nlyr) + moveLength = moveLength + len + endif + enddo + + ! decompose the move data between the available threads + if(max_num_threads<=0) then + nlen = 1 + else + if(present(nthreads)) then + if (nthreads > 0) then + nlen = nthreads + else + nlen = max_num_threads + end if + else + nlen = max_num_threads + end if + end if + call gbarrier_init(edge%gbarrier, nlen) + + allocate(edge%moveLength(nlen)) + allocate(edge%movePtr(nlen)) + + if (nlen > 1) then + ! the master thread performs no data movement because it is busy with the + ! MPI messaging + edge%moveLength(1) = -1 + edge%movePtr(1) = 0 + + ! Calculate the length of the local copy in bndy_exchange + llen = ceiling(real(moveLength,kind=r8)/real(nlen-1,kind=r8)) + iptr = moveptr + mLen = 0 + do i=2,nlen + if( (mLen+llen) <= moveLength) then + tlen = llen + else + tlen = moveLength - mLen + endif + edge%moveLength(i) = tlen + edge%movePtr(i) = iptr + iptr = iptr + tlen + mLen = mLen + tLen + enddo + else + edge%moveLength(1) = moveLength + edge%movePtr(1) = moveptr + endif + + ! Set the maximum length of the message buffer + nbuf = movePtr+moveLength + + edge%nlyr=nlyr + edge%nbuf=nbuf + + allocate(edge%receive(nbuf)) + allocate(edge%buf(nbuf)) + +21 format('RANK: ',i2, A,8(i6)) + +!$OMP END MASTER +! MT: This next barrier is also needed - threads cannot start using edge() +! until MASTER is done initializing it +!$OMP BARRIER + + end subroutine initEdgeBuffer_r8 + + integer function CalcSegmentLength(pgIndx,CardinalLength,OrdinalLength,nlyr) result(len) + + type(pgindex_t) :: pgIndx + integer, intent(in) :: CardinalLength,OrdinalLength + integer, intent(in) :: nlyr + + integer :: rem + integer, parameter :: alignment=1 ! align on word boundaries +! integer, parameter :: alignment=2 ! align on 2 word boundaries +! integer, parameter :: alignment=8 ! align on 8 word boundaries + + select case(pgIndx%edgeType) + CASE(HME_Cardinal) + len = nlyr*CardinalLength + CASE(HME_Ordinal) + len = nlyr*OrdinalLength + end select + + rem = MODULO(len,alignment) + if(rem .ne. 0) then + len = len + (alignment-rem) + endif + + end function calcSegmentLength + + ! ========================================= + ! initEdgeBuffer: + ! + ! create an Integer based communication buffer + ! ========================================= + subroutine initEdgeBuffer_i8(edge,nlyr) + use dimensions_mod, only : np, nelemd, max_corner_elem + + integer, intent(in) :: nlyr + type (LongEdgeBuffer_t), intent(out) :: edge + + ! Local variables + integer :: nbuf + + ! sanity check for threading + if (omp_get_num_threads()>1) then + call endrun('ERROR: initEdgeBuffer must be called before threaded reagion') + endif + + nbuf=4*(np+max_corner_elem)*nelemd + edge%nlyr=nlyr + edge%nbuf=nbuf + allocate(edge%buf(nlyr,nbuf)) + edge%buf(:,:)=0 + + allocate(edge%receive(nlyr,nbuf)) + edge%receive(:,:)=0 + + end subroutine initEdgeBuffer_i8 + ! ========================================= + ! edgeDGVpack: + ! + ! Pack edges of v into buf for DG stencil + ! ========================================= + subroutine edgeDGVpack(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np + + type (EdgeBuffer_t) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(in) :: v(np,np,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! ========================================= + ! This code is just a wrapper call the + ! normal oldedgeVpack + ! ========================================= + call edgeVpack(edge,v,vlyr,kptr,ielem) + + end subroutine edgeDGVpack + + subroutine FreeGhostBuffer_r8(edge) + type (EdgeBuffer_t), intent(inout) :: edge + call FreeEdgeBuffer_r8(edge) + end subroutine FreeGhostBuffer_r8 + ! =========================================== + ! FreeEdgeBuffer: + ! + ! Freed an edge communication buffer + ! ========================================= + subroutine FreeEdgeBuffer_r8(edge) + + type (EdgeBuffer_t),intent(inout) :: edge + +!$OMP BARRIER +!$OMP MASTER + deallocate(edge%buf) + deallocate(edge%receive) + if(associated(edge%putmap)) deallocate(edge%putmap) + if(associated(edge%getmap)) deallocate(edge%getmap) + if(associated(edge%reverse)) deallocate(edge%reverse) + if(associated(edge%moveLength)) deallocate(edge%moveLength) + if(associated(edge%movePtr)) deallocate(edge%movePtr) + + ! All MPI communications + if(associated(edge%rcountsFull)) deallocate(edge%rcountsFull) + if(associated(edge%scountsFull)) deallocate(edge%scountsFull) + if(associated(edge%sdisplsFull)) deallocate(edge%sdisplsFull) + if(associated(edge%rdisplsFull)) deallocate(edge%rdisplsFull) + + ! Intra-node MPI Communication + if(edge%nIntra>0) then + if(associated(edge%rcountsIntra)) deallocate(edge%rcountsIntra) + if(associated(edge%scountsIntra)) deallocate(edge%scountsIntra) + if(associated(edge%sdisplsIntra)) deallocate(edge%sdisplsIntra) + if(associated(edge%rdisplsIntra)) deallocate(edge%rdisplsIntra) + endif + + ! Inter-node MPI Communication + if(edge%nInter>0) then + if(associated(edge%rcountsInter)) deallocate(edge%rcountsInter) + if(associated(edge%scountsInter)) deallocate(edge%scountsInter) + if(associated(edge%sdisplsInter)) deallocate(edge%sdisplsInter) + if(associated(edge%rdisplsInter)) deallocate(edge%rdisplsInter) + endif + if(allocated(edge%rRequest)) deallocate(edge%rRequest) + if(allocated(edge%sRequest)) deallocate(edge%sRequest) + if(allocated(edge%status)) deallocate(edge%status) + call gbarrier_delete(edge%gbarrier) + +!$OMP END MASTER + + end subroutine FreeEdgeBuffer_r8 + + ! =========================================== + ! FreeEdgeBuffer: + ! + ! Freed an edge communication buffer + ! ========================================= + subroutine FreeEdgeBuffer_i8(edge) + + type (LongEdgeBuffer_t),intent(inout) :: edge + + edge%nbuf=0 + edge%nlyr=0 + deallocate(edge%buf) + deallocate(edge%receive) + + end subroutine FreeEdgeBuffer_i8 + + ! ========================================= + ! + !> @brief Pack edges of v into an edge buffer for boundary exchange. + ! + !> This subroutine packs for one or more vertical layers into an edge + !! buffer. If the buffer associated with edge is not large enough to + !! hold all vertical layers you intent to pack, the method will + !! halt the program with a call to endrum(). + !! @param[in] edge Edge Buffer into which the data will be packed. + !! This buffer must be previously allocated with initEdgeBuffer(). + !! @param[in] v The data to be packed. + !! @param[in] vlyr Number of vertical level coming into the subroutine + !! for packing for input v. + !! @param[in] kptr Vertical pointer to the place in the edge buffer where + !! data will be located. + ! ========================================= + subroutine edgeVpack(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(in) :: v(np,np,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local variables + integer :: i,k,ir,ll,iptr + integer :: is,ie,in,iw,edgeptr + + is = edge%putmap(south,ielem) + ie = edge%putmap(east,ielem) + in = edge%putmap(north,ielem) + iw = edge%putmap(west,ielem) + if (edge%nlyr < (kptr+vlyr) ) then + print *,'edge%nlyr = ',edge%nlyr + print *,'kptr+vlyr = ',kptr+vlyr + call endrun('edgeVpack: Buffer overflow: size of the vertical dimension must be increased!') + endif + +!dir$ ivdep + do k=1,vlyr + iptr = np*(kptr+k-1) + do i=1,np + edge%buf(iptr+ie+i) = v(np ,i ,k) ! East + edge%buf(iptr+is+i) = v(i ,1 ,k) ! South + edge%buf(iptr+in+i) = v(i ,np,k) ! North + edge%buf(iptr+iw+i) = v(1 ,i ,k) ! West + enddo + enddo + + ! This is really kludgy way to setup the index reversals + ! But since it is so a rare event not real need to spend time optimizing + + if(edge%reverse(south,ielem)) then + do k=1,vlyr + iptr = np*(kptr+k-1)+is + do i=1,np + ir = np-i+1 + edge%buf(iptr+ir)=v(i,1,k) + enddo + enddo + endif + + if(edge%reverse(east,ielem)) then + do k=1,vlyr + iptr=np*(kptr+k-1)+ie + do i=1,np + ir = np-i+1 + edge%buf(iptr+ir)=v(np,i,k) + enddo + enddo + endif + + if(edge%reverse(north,ielem)) then + do k=1,vlyr + iptr=np*(kptr+k-1)+in + do i=1,np + ir = np-i+1 + edge%buf(iptr+ir)=v(i,np,k) + enddo + enddo + endif + + if(edge%reverse(west,ielem)) then + do k=1,vlyr + iptr=np*(kptr+k-1)+iw + do i=1,np + ir = np-i+1 + edge%buf(iptr+ir)=v(1,i,k) + enddo + enddo + endif + +! SWEST + do ll=swest,swest+max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr = edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + if (iptr > size(edge%buf)) then + write(6, *) 'ERROR SW: ',size(edge%buf),iptr,edge%putmap(ll,ielem) + call endrun('pointer bounds ERROR SW') + end if + edge%buf(iptr) = v(1, 1, k) + end do + end if + end do + +! SEAST + do ll=swest+max_corner_elem,swest+2*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr = edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + if (iptr > size(edge%buf)) then + write(6, *) 'ERROR SE: ',size(edge%buf),iptr,edge%putmap(ll,ielem) + call endrun('pointer bounds ERROR SE') + end if + edge%buf(iptr)=v(np, 1, k) + end do + end if + end do + +! NEAST + do ll=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr = edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + if (iptr > size(edge%buf)) then + write(6, *) 'ERROR NE: ',size(edge%buf),iptr,edge%putmap(ll,ielem) + call endrun('pointer bounds ERROR NE') + end if + edge%buf(iptr) = v(np, np, k) + end do + end if + end do + +! NWEST + do ll=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr = edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + if (iptr > size(edge%buf)) then + write(6, *) 'ERROR NW: ',size(edge%buf),iptr,edge%putmap(ll,ielem) + call endrun('pointer bounds ERROR NW') + end if + edge%buf(iptr) = v(1, np, k) + end do + end if + end do + + end subroutine edgeVpack + + subroutine edgeSpack_r8(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(in) :: v(vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local variables + integer :: i,k,ir,ll,iptr + integer :: is,ie,in,iw,edgeptr + real (kind=r8) :: tmp + + is = edge%putmap(south,ielem) + ie = edge%putmap(east,ielem) + in = edge%putmap(north,ielem) + iw = edge%putmap(west,ielem) + if (edge%nlyr < (kptr+vlyr) ) then + call endrun('edgeSpack: Buffer overflow: size of the vertical dimension must be increased!') + endif + + do k=1,vlyr + iptr = kptr+k-1 + edge%buf(iptr+ie+1) = v(k) ! East + edge%buf(iptr+is+1) = v(k) ! South + edge%buf(iptr+in+1) = v(k) ! North + edge%buf(iptr+iw+1) = v(k) ! West + enddo + +! SWEST + do ll=swest,swest+max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr=edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + edge%buf(iptr)=v(k) + end do + end if + end do + +! SEAST + do ll=swest+max_corner_elem,swest+2*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr=edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + edge%buf(iptr)=v(k) + end do + end if + end do + +! NEAST + do ll=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr=edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + edge%buf(iptr)=v(k) + end do + end if + end do + +! NWEST + do ll=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if (edge%putmap(ll,ielem) /= -1) then + edgeptr=edge%putmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + edge%buf(iptr)=v(k) + end do + end if + end do + + end subroutine edgeSpack_r8 + + ! ========================================= + ! LongEdgeVpack: + ! + ! Pack edges of v into buf... + ! ========================================= + subroutine LongEdgeVpack(edge,v,vlyr,kptr,desc) + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + use dimensions_mod, only: np, max_corner_elem + + type (LongEdgeBuffer_t) :: edge + integer, intent(in) :: vlyr + integer , intent(in) :: v(np,np,vlyr) + integer, intent(in) :: kptr + type (EdgeDescriptor_t), intent(in) :: desc + + ! Local variables + logical, parameter :: UseUnroll = .TRUE. + integer :: i,k,ir,l + integer :: is,ie,in,iw + + if(.not. threadsafe) then +!$OMP BARRIER + threadsafe=.true. + end if + + is = desc%putmapP(south) + ie = desc%putmapP(east) + in = desc%putmapP(north) + iw = desc%putmapP(west) + + if(MODULO(np,2) == 0 .and. UseUnroll) then + do k=1,vlyr + do i=1,np,2 + edge%buf(kptr+k,is+i) = v(i ,1 ,k) + edge%buf(kptr+k,is+i+1) = v(i+1,1 ,k) + edge%buf(kptr+k,ie+i) = v(np ,i ,k) + edge%buf(kptr+k,ie+i+1) = v(np ,i+1 ,k) + edge%buf(kptr+k,in+i) = v(i ,np,k) + edge%buf(kptr+k,in+i+1) = v(i+1 ,np,k) + edge%buf(kptr+k,iw+i) = v(1 ,i ,k) + edge%buf(kptr+k,iw+i+1) = v(1 ,i+1 ,k) + + enddo + end do + else + do k=1,vlyr + do i=1,np + edge%buf(kptr+k,is+i) = v(i ,1 ,k) + edge%buf(kptr+k,ie+i) = v(np ,i ,k) + edge%buf(kptr+k,in+i) = v(i ,np,k) + edge%buf(kptr+k,iw+i) = v(1 ,i ,k) + enddo + end do + + endif + + + ! This is really kludgy way to setup the index reversals + ! But since it is so a rare event not real need to spend time optimizing + + if(desc%reverse(south)) then + is = desc%putmapP(south) + do k=1,vlyr + do i=1,np + ir = np-i+1 + edge%buf(kptr+k,is+ir)=v(i,1,k) + enddo + enddo + endif + + if(desc%reverse(east)) then + ie = desc%putmapP(east) + do k=1,vlyr + do i=1,np + ir = np-i+1 + edge%buf(kptr+k,ie+ir)=v(np,i,k) + enddo + enddo + endif + + if(desc%reverse(north)) then + in = desc%putmapP(north) + do k=1,vlyr + do i=1,np + ir = np-i+1 + edge%buf(kptr+k,in+ir)=v(i,np,k) + enddo + enddo + endif + + if(desc%reverse(west)) then + iw = desc%putmapP(west) + do k=1,vlyr + do i=1,np + ir = np-i+1 + edge%buf(kptr+k,iw+ir)=v(1,i,k) + enddo + enddo + endif + +! SWEST + do l=swest,swest+max_corner_elem-1 + if (desc%putmapP(l) /= -1) then + do k=1,vlyr + edge%buf(kptr+k,desc%putmapP(l)+1)=v(1 ,1 ,k) + end do + end if + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if (desc%putmapP(l) /= -1) then + do k=1,vlyr + edge%buf(kptr+k,desc%putmapP(l)+1)=v(np ,1 ,k) + end do + end if + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if (desc%putmapP(l) /= -1) then + do k=1,vlyr + edge%buf(kptr+k,desc%putmapP(l)+1)=v(np ,np,k) + end do + end if + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if (desc%putmapP(l) /= -1) then + do k=1,vlyr + edge%buf(kptr+k,desc%putmapP(l)+1)=v(1 ,np,k) + end do + end if + end do + + end subroutine LongEdgeVpack + + subroutine edgeVunpack(edge,v,vlyr,kptr,ielem,rank) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(np,np,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + integer, optional, intent(in) :: rank + + ! Local + integer :: i,k,ll,iptr + integer :: is,ie,in,iw,edgeptr + integer :: ise,isw,ine,inw + integer :: ks,ke,kblock + logical :: done + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + isw=edge%getmap(swest,ielem) + ise=edge%getmap(seast,ielem) + inw=edge%getmap(nwest,ielem) + ine=edge%getmap(neast,ielem) + + !DIR$ IVDEP + do k=1,vlyr + iptr=np*(kptr+k-1) + do i=1,np + v(np ,i ,k) = v(np ,i ,k)+edge%receive(iptr+i+ie) ! East + v(i ,1 ,k) = v(i ,1 ,k)+edge%receive(iptr+i+is) ! South + v(i ,np ,k) = v(i ,np ,k)+edge%receive(iptr+i+in) ! North + v(1 ,i ,k) = v(1 ,i ,k)+edge%receive(iptr+i+iw) ! West + enddo + enddo + +! SWEST + do ll=swest,swest+max_corner_elem-1 + if(edge%getmap(ll,ielem) /= -1) then + edgeptr=edge%getmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(1 ,1 ,k)=v(1 ,1 ,k)+edge%receive(iptr) + enddo + endif + end do + +! SEAST + do ll=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(edge%getmap(ll,ielem) /= -1) then + edgeptr=edge%getmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(np ,1 ,k)=v(np,1 ,k)+edge%receive(iptr) + enddo + endif + end do + +! NEAST + do ll=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(edge%getmap(ll,ielem) /= -1) then + edgeptr=edge%getmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(np ,np,k)=v(np,np,k)+edge%receive(iptr) + enddo + endif + end do + +! NWEST + do ll=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(edge%getmap(ll,ielem) /= -1) then + edgeptr=edge%getmap(ll,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(1 ,np,k)=v(1 ,np,k)+edge%receive(iptr) + enddo + endif + end do + + + end subroutine edgeVunpack +! + subroutine edgeVunpackVert(edge,v,ielem) + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + use dimensions_mod, only: np, max_corner_elem, ne + use coordinate_systems_mod, only: cartesian3D_t + + type (EdgeBuffer_t), intent(inout) :: edge + type (cartesian3D_t), intent(inout) :: v(:,:,:) + integer, intent(in) :: ielem + + ! Local + logical, parameter :: UseUnroll = .TRUE. + integer :: i,k,l, nce + integer :: is,ie,in,iw,ine,inw,isw,ise + + threadsafe=.false. + + if (max_corner_elem.ne.1 .and. ne==0) then + ! MNL: this is used to construct the dual grid on the cube, + ! currently only supported for the uniform grid. If + ! this is desired on a refined grid, a little bit of + ! work will be required. + call endrun("edgeVunpackVert should not be called with unstructured meshes") + end if + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + + + ! N+S + do i=1,np/2 + ! North + v(3,i ,np)%x = edge%receive(in+i) + v(3,i ,np)%y = edge%receive(np+in+i) + v(3,i ,np)%z = edge%receive(2*np+in+i) + + ! South + v(2,i ,1)%x = edge%receive(is+i) + v(2,i ,1)%y = edge%receive(np+is+i) + v(2,i ,1)%z = edge%receive(2*np+is+i) + enddo + + do i=np/2+1,np + ! North + v(4,i ,np)%x = edge%receive(in+i) + v(4,i ,np)%y = edge%receive(np+in+i) + v(4,i ,np)%z = edge%receive(2*np+in+i) + ! South + v(1,i ,1)%x = edge%receive(is+i) + v(1,i ,1)%y = edge%receive(np+is+i) + v(1,i ,1)%z = edge%receive(2*np+is+i) + enddo + + do i=1,np/2 + ! East + v(3,np,i)%x = edge%receive(ie+i) + v(3,np,i)%y = edge%receive(np+ie+i) + v(3,np,i)%z = edge%receive(2*np+ie+i) + ! West + v(4,1,i)%x = edge%receive(iw+i) + v(4,1,i)%y = edge%receive(np+iw+i) + v(4,1,i)%z = edge%receive(2*np+iw+i) + end do + + do i=np/2+1,np + ! East + v(2,np,i)%x = edge%receive(ie+i) + v(2,np,i)%y = edge%receive(np+ie+i) + v(2,np,i)%z = edge%receive(2*np+ie+i) + ! West + v(1,1,i)%x = edge%receive(iw+i) + v(1,1,i)%y = edge%receive(np+iw+i) + v(1,1,i)%z = edge%receive(2*np+iw+i) + end do + +! SWEST + nce = max_corner_elem + do l=swest,swest+max_corner_elem-1 + ! find the one active corner, then exist + isw=edge%getmap(l,ielem) + if(isw /= -1) then + v(1,1,1)%x=edge%receive(isw+1) + v(1,1,1)%y=edge%receive(nce+isw+1) + v(1,1,1)%z=edge%receive(2*nce+isw+1) + exit + else + v(1,1,1)%x=0_r8 + v(1,1,1)%y=0_r8 + v(1,1,1)%z=0_r8 + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + ! find the one active corner, then exist + ise=edge%getmap(l,ielem) + if(ise /= -1) then + v(2,np,1)%x=edge%receive(ise+1) + v(2,np,1)%y=edge%receive(nce+ise+1) + v(2,np,1)%z=edge%receive(2*nce+ise+1) + exit + else + v(2,np,1)%x=0_r8 + v(2,np,1)%y=0_r8 + v(2,np,1)%z=0_r8 + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + ! find the one active corner, then exist + ine=edge%getmap(l,ielem) + if(ine /= -1) then + v(3,np,np)%x=edge%receive(ine+1) + v(3,np,np)%y=edge%receive(nce+ine+1) + v(3,np,np)%z=edge%receive(2*nce+ine+1) + exit + else + v(3,np,np)%x=0_r8 + v(3,np,np)%y=0_r8 + v(3,np,np)%z=0_r8 + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + ! find the one active corner, then exist + inw = edge%getmap(l,ielem) + if(inw/= -1) then + v(4,1,np)%x=edge%receive(inw+1) + v(4,1,np)%y=edge%receive(nce+inw+1) + v(4,1,np)%z=edge%receive(2*nce+inw+1) + exit + else + v(4,1,np)%x=0_r8 + v(4,1,np)%y=0_r8 + v(4,1,np)%z=0_r8 + endif + end do + + ! Fill the missing vertex info + + do i=2,np/2 + ! North + v(4,i ,np)%x = v(3,i-1 ,np)%x + v(4,i ,np)%y = v(3,i-1 ,np)%y + v(4,i ,np)%z = v(3,i-1 ,np)%z + ! South + v(1,i ,1)%x = v(2,i-1 ,1)%x + v(1,i ,1)%y = v(2,i-1 ,1)%y + v(1,i ,1)%z = v(2,i-1 ,1)%z + enddo + + do i=np/2+1,np-1 + ! North + v(3,i ,np)%x = v(4,i+1 ,np)%x + v(3,i ,np)%y = v(4,i+1 ,np)%y + v(3,i ,np)%z = v(4,i+1 ,np)%z + ! South + v(2,i ,1)%x = v(1,i+1 ,1)%x + v(2,i ,1)%y = v(1,i+1 ,1)%y + v(2,i ,1)%z = v(1,i+1 ,1)%z + enddo + + do i=2,np/2 + ! East + v(2,np,i)%x = v(3,np,i-1)%x + v(2,np,i)%y = v(3,np,i-1)%y + v(2,np,i)%z = v(3,np,i-1)%z + ! West + v(1,1,i)%x = v(4,1,i-1)%x + v(1,1,i)%y = v(4,1,i-1)%y + v(1,1,i)%z = v(4,1,i-1)%z + end do + + do i=np/2+1,np-1 + ! East + v(3,np,i)%x = v(2,np,i+1)%x + v(3,np,i)%y = v(2,np,i+1)%y + v(3,np,i)%z = v(2,np,i+1)%z + ! West + v(4,1,i)%x = v(1,1,i+1)%x + v(4,1,i)%y = v(1,1,i+1)%y + v(4,1,i)%z = v(1,1,i+1)%z + end do + + end subroutine edgeVunpackVert + ! ======================================== + ! edgeDGVunpack: + ! + ! Unpack edges from edge buffer into v... + ! ======================================== + + subroutine edgeDGVunpack(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(0:np+1,0:np+1,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local + integer :: i,k,iptr + integer :: is,ie,in,iw + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + do k=1,vlyr + iptr=np*(kptr+k-1) + do i=1,np + v(i ,0 ,k)=edge%receive(iptr+is+i) + v(np+1,i ,k)=edge%receive(iptr+ie+i) + v(i ,np+1,k)=edge%receive(iptr+in+i) + v(0 ,i ,k)=edge%receive(iptr+iw+i) + end do + end do + + i = swest + if(edge%getmap(i,ielem) /= -1) then + do k=1,vlyr + iptr=(kptr+k-1) + v(0,0,k) = edge%receive(iptr+edge%getmap(i,ielem)+1) + end do + end if + i = swest+max_corner_elem + if(edge%getmap(i,ielem) /= -1) then + do k=1,vlyr + iptr=(kptr+k-1) + v(np+1,0,k) = edge%receive(iptr+edge%getmap(i,ielem)+1) + end do + end if + i = swest+3*max_corner_elem + if(edge%getmap(i,ielem) /= -1) then + do k=1,vlyr + iptr=(kptr+k-1) + v(np+1,np+1,k) = edge%receive(iptr+edge%getmap(i,ielem)+1) + end do + end if + i = swest+2*max_corner_elem + if(edge%getmap(i,ielem) /= -1) then + do k=1,vlyr + iptr=(kptr+k-1) + v(0,np+1,k) = edge%receive(iptr+edge%getmap(i,ielem)+1) + end do + end if + + end subroutine edgeDGVunpack + + ! ======================================== + ! edgeVunpackMIN/MAX: + ! + ! Finds the Min/Max edges from edge buffer into v... + ! ======================================== + subroutine edgeVunpackMAX(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(np,np,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local + integer :: i,k,l,iptr + integer :: is,ie,in,iw + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + do k=1,vlyr + iptr=np*(kptr+k-1) + do i=1,np + v(np ,i ,k) = MAX(v(np ,i ,k),edge%receive(iptr+ie+i )) + v(i ,1 ,k) = MAX(v(i ,1 ,k),edge%receive(iptr+is+i )) + v(i ,np ,k) = MAX(v(i ,np ,k),edge%receive(iptr+in+i )) + v(1 ,i ,k) = MAX(v(1 ,i ,k),edge%receive(iptr+iw+i )) + end do + end do + +! SWEST + do l=swest,swest+max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + do k=1,vlyr + v(1 ,1 ,k)=MAX(v(1 ,1 ,k),edge%receive((kptr+k-1)+edge%getmap(l,ielem)+1)) + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + do k=1,vlyr + v(np ,1 ,k)=MAX(v(np,1 ,k),edge%receive((kptr+k-1)+edge%getmap(l,ielem)+1)) + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + do k=1,vlyr + v(np ,np,k)=MAX(v(np,np,k),edge%receive((kptr+k-1)+edge%getmap(l,ielem)+1)) + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + do k=1,vlyr + v(1 ,np,k)=MAX(v(1 ,np,k),edge%receive((kptr+k-1)+edge%getmap(l,ielem)+1)) + enddo + endif + end do + + end subroutine edgeVunpackMAX + + subroutine edgeSunpackMAX(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local + integer :: i,k,l,iptr + integer :: is,ie,in,iw,edgeptr + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + do k=1,vlyr + iptr=(kptr+k-1) + v(k) = MAX(v(k),edge%receive(iptr+is+1),edge%receive(iptr+ie+1),edge%receive(iptr+in+1),edge%receive(iptr+iw+1)) + end do + +! SWEST + do l=swest,swest+max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MAX(v(k),edge%receive(iptr)) + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MAX(v(k),edge%receive(iptr)) + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MAX(v(k),edge%receive(iptr)) + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MAX(v(k),edge%receive(iptr)) + enddo + endif + end do + + end subroutine edgeSunpackMAX + + subroutine edgeSunpackMIN(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local + integer :: i,k,l,iptr + integer :: is,ie,in,iw,edgeptr + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + do k=1,vlyr + iptr=(kptr+k-1) + v(k) = MIN(v(k),edge%receive(iptr+is+1),edge%receive(iptr+ie+1),edge%receive(iptr+in+1),edge%receive(iptr+iw+1)) + end do + +! SWEST + do l=swest,swest+max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MiN(v(k),edge%receive(iptr)) + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MIN(v(k),edge%receive(iptr)) + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MIN(v(k),edge%receive(iptr)) + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr = edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr = (kptr+k-1)+edgeptr + v(k)=MIN(v(k),edge%receive(iptr)) + enddo + endif + end do + + end subroutine edgeSunpackMIN + + subroutine edgeVunpackMIN(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only: np, max_corner_elem + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + + type (EdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + real (kind=r8), intent(inout) :: v(np,np,vlyr) + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + ! Local + integer :: i,k,l,iptr + integer :: is,ie,in,iw,edgeptr + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + do k=1,vlyr + iptr = np*(kptr+k-1) + do i=1,np + v(np ,i ,k) = MIN(v(np ,i ,k),edge%receive(iptr+ie+i )) + v(i ,1 ,k) = MIN(v(i ,1 ,k),edge%receive(iptr+is+i )) + v(i ,np ,k) = MIN(v(i ,np ,k),edge%receive(iptr+in+i )) + v(1 ,i ,k) = MIN(v(1 ,i ,k),edge%receive(iptr+iw+i )) + end do + end do + +! SWEST + do l=swest,swest+max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr=edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr=(kptr+k-1)+edgeptr + v(1 ,1 ,k)=MIN(v(1 ,1 ,k),edge%receive(iptr)) + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr=edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr=(kptr+k-1)+edgeptr + v(np ,1 ,k)=MIN(v(np,1 ,k),edge%receive(iptr)) + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr=edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr=(kptr+k-1)+edgeptr + v(np ,np,k)=MIN(v(np,np,k),edge%receive(iptr)) + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(edge%getmap(l,ielem) /= -1) then + edgeptr=edge%getmap(l,ielem)+1 + do k=1,vlyr + iptr=(kptr+k-1)+edgeptr + v(1 ,np,k)=MIN(v(1 ,np,k),edge%receive(iptr)) + enddo + endif + end do + + end subroutine edgeVunpackMIN + + ! ======================================== + ! LongEdgeVunpackMIN: + ! + ! Finds the Min edges from edge buffer into v... + ! ======================================== + subroutine LongEdgeVunpackMIN(edge,v,vlyr,kptr,desc) + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + use dimensions_mod, only: np, max_corner_elem + + type (LongEdgeBuffer_t), intent(in) :: edge + integer, intent(in) :: vlyr + integer , intent(inout) :: v(np,np,vlyr) + integer, intent(in) :: kptr + type (EdgeDescriptor_t), intent(in) :: desc + + ! Local + + integer :: i,k,l + integer :: is,ie,in,iw + + threadsafe=.false. + + is=desc%getmapP(south) + ie=desc%getmapP(east) + in=desc%getmapP(north) + iw=desc%getmapP(west) + do k=1,vlyr + do i=1,np + v(i ,1 ,k) = MIN(v(i ,1 ,k),edge%buf(kptr+k,is+i )) + v(np ,i ,k) = MIN(v(np ,i ,k),edge%buf(kptr+k,ie+i )) + v(i ,np ,k) = MIN(v(i ,np ,k),edge%buf(kptr+k,in+i )) + v(1 ,i ,k) = MIN(v(1 ,i ,k),edge%buf(kptr+k,iw+i )) + end do + end do + +! SWEST + do l=swest,swest+max_corner_elem-1 + if(desc%getmapP(l) /= -1) then + do k=1,vlyr + v(1 ,1 ,k)=MIN(v(1 ,1 ,k),edge%buf(kptr+k,desc%getmapP(l)+1)) + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if(desc%getmapP(l) /= -1) then + do k=1,vlyr + v(np ,1 ,k)=MIN(v(np,1 ,k),edge%buf(kptr+k,desc%getmapP(l)+1)) + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if(desc%getmapP(l) /= -1) then + do k=1,vlyr + v(np ,np,k)=MIN(v(np,np,k),edge%buf(kptr+k,desc%getmapP(l)+1)) + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if(desc%getmapP(l) /= -1) then + do k=1,vlyr + v(1 ,np,k)=MIN(v(1 ,np,k),edge%buf(kptr+k,desc%getmapP(l)+1)) + enddo + endif + end do + + end subroutine LongEdgeVunpackMIN + + +subroutine ghostpack(edge,v,vlyr,kptr,ielem) + + use dimensions_mod, only : max_corner_elem + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + use edgetype_mod, only : EdgeDescriptor_t + + implicit none + + type (Edgebuffer_t) :: edge + integer, intent(in) :: vlyr + integer, intent(in) :: kptr + + real (kind=r8),intent(in) :: v(edge%lb:edge%ub,edge%lb:edge%ub,vlyr) + integer, intent(in) :: ielem + + ! Local variables + integer :: i,j,k,ir,l,itr,ktmp + + integer :: is,ie,in,iw,isw,ise,inw,ine + integer :: nhc, npoints + integer :: edgeptr,iptr + + is = edge%putmap(south,ielem) + ie = edge%putmap(east,ielem) + in = edge%putmap(north,ielem) + iw = edge%putmap(west,ielem) + if (edge%nlyr < (kptr+vlyr) ) then + print *,'edge%nlyr = ',edge%nlyr + print *,'kptr+vlyr = ',kptr+vlyr + call endrun('ghostpack: Buffer overflow: size of the vertical dimension must be increased!') + endif + + + nhc = edge%ndepth + npoints = edge%npoints + + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + edge%buf(iptr+is+i) = v(i ,j ,k) + edge%buf(iptr+ie+i) = v(npoints-j+1 ,i ,k) + edge%buf(iptr+in+i) = v(i ,npoints-j+1,k) + edge%buf(iptr+iw+i) = v(j ,i ,k) + enddo + end do + end do + + + ! This is really kludgy way to setup the index reversals + ! But since it is so a rare event not real need to spend time optimizing + ! Check if the edge orientation of the recieving element is different + ! if it is, swap the order of data in the edge + if(edge%reverse(south,ielem)) then + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + ir = npoints-i+1 + edge%buf(iptr+is+i)=v(ir,j,k) + enddo + enddo + enddo + endif + + if(edge%reverse(east,ielem)) then + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + ir = npoints-i+1 + edge%buf(iptr+ie+i)=v(npoints-j+1,ir,k) + enddo + enddo + enddo + endif + + if(edge%reverse(north,ielem)) then + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + ir = npoints-i+1 + edge%buf(iptr+in+i)=v(ir,npoints-j+1,k) + enddo + enddo + enddo + endif + + if(edge%reverse(west,ielem)) then + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + ir = npoints-i+1 + edge%buf(iptr+iw+i)=v(j,ir,k) + enddo + enddo + enddo + endif + + + ! corners. this is difficult because we dont know the orientaton + ! of the corners, and this which (i,j) dimension maps to which dimension +! SWEST + do l=swest,swest+max_corner_elem-1 + if (edge%putmap(l,ielem) /= -1) then + isw = edge%putmap(l,ielem) + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + edge%buf(iptr+isw+i)=v(i ,j ,k) + enddo + end do + end do + end if + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if (edge%putmap(l,ielem) /= -1) then + ise = edge%putmap(l,ielem) + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + edge%buf(iptr+ise+i)=v(npoints-i+1 ,j ,k) + enddo + end do + end do + end if + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if (edge%putmap(l,ielem) /= -1) then + ine = edge%putmap(l,ielem) + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + edge%buf(iptr+ine+i)=v(npoints-i+1,npoints-j+1,k) + enddo + enddo + end do + end if + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if (edge%putmap(l,ielem) /= -1) then + inw = edge%putmap(l,ielem) + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + edge%buf(iptr+inw+i)=v(i ,npoints-j+1,k) + enddo + end do + end do + end if + end do + +end subroutine ghostpack + +subroutine ghostunpack(edge,v,vlyr,kptr,ielem) + use dimensions_mod, only : max_corner_elem + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + type (Edgebuffer_t), intent(in) :: edge + + integer, intent(in) :: vlyr + integer, intent(in) :: kptr + integer, intent(in) :: ielem + + real (kind=r8), intent(inout) :: v(edge%lb:edge%ub,edge%lb:edge%ub,vlyr) + + + ! Local + logical, parameter :: UseUnroll = .TRUE. + integer :: i,j,k,l,itr, ktmp + integer :: is,ie,in,iw,isw,ise,inw,ine + integer :: nhc,npoints,iptr + logical :: reverse + + threadsafe=.false. + + is=edge%getmap(south,ielem) + ie=edge%getmap(east,ielem) + in=edge%getmap(north,ielem) + iw=edge%getmap(west,ielem) + + nhc = edge%ndepth + npoints = edge%npoints + + ! example for north buffer + ! first row ('edge') goes in v(:,np+1,k) + ! 2nd row ('edge') goes in v(:,np+2,k) + ! etc... + !DIR$ IVDEP + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = npoints*(ktmp + j - 1) + do i=1,npoints + v(i ,1-j ,k) = edge%receive(iptr+is+i) ! South + v(npoints+j ,i ,k) = edge%receive(iptr+ie+i) ! East + v(i ,npoints+j ,k) = edge%receive(iptr+in+i) ! North + v(1-j ,i ,k) = edge%receive(iptr+iw+i) ! West + end do + end do + end do + + +! SWEST + do l=swest,swest+max_corner_elem-1 + isw = edge%getmap(l,ielem) + if(isw /= -1) then + ! note the following is the the correct meaning of reverse in this code. + ! It is best described as a transponse operation + if (edge%reverse(l,ielem)) then + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + v(1-j,1-i,k)=edge%receive(iptr+isw+i) + enddo + enddo + enddo + else + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do i=1,nhc + iptr = nhc*(ktmp + i - 1) + do j=1,nhc + v(1-j,1-i,k)=edge%receive(iptr+isw+j) + enddo + enddo + enddo + endif + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i,1-j,k)=edgeDefaultVal + enddo + enddo + enddo + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + ise = edge%getmap(l,ielem) + if(ise /= -1) then + if (edge%reverse(l,ielem)) then + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do i=1,nhc + iptr = nhc*(ktmp + i - 1) + do j=1,nhc + v(npoints+i,1-j,k)=edge%receive(iptr+ise+j) + enddo + enddo + enddo + else + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + v(npoints+i ,1-j ,k)=edge%receive(iptr+ise+i) + enddo + enddo + enddo + endif + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(npoints+i,1-j,k)=edgeDefaultVal + enddo + enddo + enddo + endif + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + ine = edge%getmap(l,ielem) + if(ine /= -1) then + if (edge%reverse(l,ielem)) then + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + do i=1,nhc + iptr = nhc*(ktmp + i - 1) + v(npoints+i ,npoints+j,k)=edge%receive(iptr+ine+j) + enddo + enddo + enddo + else + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + v(npoints+i ,npoints+j,k)=edge%receive(iptr+ine+i) + enddo + enddo + enddo + endif + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(npoints+i,npoints+j,k)=edgeDefaultVal + enddo + enddo + enddo + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + inw = edge%getmap(l,ielem) + if(inw /= -1) then + if (edge%reverse(l,ielem)) then + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do i=1,nhc + iptr = nhc*(ktmp + i - 1) + do j=1,nhc + v(1-i ,npoints+j,k)=edge%receive(iptr+inw+j) + enddo + enddo + enddo + else + do k=1,vlyr + ktmp = nhc*(kptr+k-1) + do j=1,nhc + iptr = nhc*(ktmp + j - 1) + do i=1,nhc + v(1-i ,npoints+j,k)=edge%receive(iptr+inw+i) + enddo + enddo + enddo + endif + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i,npoints+j,k)=edgeDefaultVal + enddo + enddo + enddo + endif + end do + +end subroutine ghostunpack + + ! ========================================= + ! initGhostBuffer3d: + ! Author: James Overfelt + ! create an Real based communication buffer + ! npoints is the number of points on one side + ! nhc is the deep of the ghost/halo zone + ! ========================================= + subroutine initGhostBuffer3d(ghost,nlyr,np,nhc_in) + + implicit none + integer,intent(in) :: nlyr, np + integer,intent(in),optional :: nhc_in + type (Ghostbuffer3d_t),intent(out) :: ghost + + ! Local variables + + integer :: nbuf,nhc,i + + ! sanity check for threading + if (omp_get_num_threads()>1) then + call endrun('ERROR: initGhostBuffer must be called before threaded region') + endif + + if (present(nhc_in)) then + nhc=nhc_in + else + nhc = np-1 + endif + + nbuf=max_neigh_edges*nelemd + + ghost%nlyr = nlyr + ghost%nhc = nhc + ghost%np = np + ghost%nbuf = nbuf + ghost%elem_size = np*(nhc+1) + allocate(ghost%buf (np,(nhc+1),nlyr,nbuf)) + allocate(ghost%receive(np,(nhc+1),nlyr,nbuf)) + ghost%buf=0 + ghost%receive=0 + + end subroutine initGhostBuffer3d + + ! ================================================================================= + ! GHOSTVPACK3D + ! AUTHOR: James Overfelt (from a subroutine of Christoph Erath, ghostvpack2D) + ! Pack edges of v into an ghost buffer for boundary exchange. + ! + ! This subroutine packs for many vertical layers into an ghost + ! buffer. + ! If the buffer associated with edge is not large enough to + ! hold all vertical layers you intent to pack, the method will + ! halt the program with a call to endrun(). + ! INPUT: + ! - ghost Buffer into which the data will be packed. + ! This buffer must be previously allocated with initGhostBuffer(). + ! - v The data to be packed. + ! - nhc deep of ghost/halo zone + ! - npoints number of points on on side + ! - kptr Vertical pointer to the place in the edge buffer where + ! data will be located. + ! ================================================================================= + subroutine ghostVpack3d(ghost, v, vlyr, kptr, desc) + use dimensions_mod, only : max_corner_elem + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + use edgetype_mod, only : edgedescriptor_t, ghostbuffer3d_t + implicit none + + type (Ghostbuffer3d_t) :: ghost + integer, intent(in) :: kptr,vlyr + real (kind=r8),intent(in) :: v(ghost%np, ghost%np, vlyr) + type (EdgeDescriptor_t),intent(in) :: desc + + integer :: nhc, np + + ! Local variables + integer :: i,j,k,ir,l,e + + integer :: is,ie,in,iw + + if(.not. threadsafe) then +!$OMP BARRIER + threadsafe=.true. + end if + ! Example convenction for buffer to the north: + ! buf(:,,:,i,e) + ! each "edge" is a row of data (i=1,np) in the element + ! north most row of data goes into e=1 + ! next row of data goes into e=2 + ! .... + ! south most row of data goes into e=np + ! We need to pack this way to preserve the orientation + ! so the data can be unpacked correctly + + ! note: we think of buf as dimensioned buf(k,is,i,e) + ! but this array is flatted to: buf(k,is+(i-1)+(e-1)*np) + ! + nhc = ghost%nhc + np = ghost%np + is = desc%putmapP_ghost(south) + ie = desc%putmapP_ghost(east) + in = desc%putmapP_ghost(north) + iw = desc%putmapP_ghost(west) + + do k=1,vlyr + do j=1,nhc + do i=1,np + ghost%buf(i,j,kptr+k,is) = v(i, j+1 , k) + ghost%buf(i,j,kptr+k,ie) = v(np-j, i , k) + ghost%buf(i,j,kptr+k,in) = v(i, np-j , k) + ghost%buf(i,j,kptr+k,iw) = v(j+1, i , k) + enddo + end do + end do + ! This is really kludgy way to setup the index reversals + ! But since it is so a rare event not real need to spend time optimizing + ! Check if the edge orientation of the recieving element is different + ! if it is, swap the order of data in the edge + if(desc%reverse(south)) then + do k=1,vlyr + do j=1,nhc + do i=1,np + ir = np-i+1 + ghost%buf(ir, j, kptr+k, is)=v(i, j+1, k) + enddo + enddo + enddo + endif + + if(desc%reverse(east)) then + do k=1,vlyr + do j=1,nhc + do i=1,np + ir = np-i+1 + ghost%buf(ir, j, kptr+k, ie)=v(np-j, i, k) + enddo + enddo + enddo + endif + + if(desc%reverse(north)) then + do k=1,vlyr + do j=1,nhc + do i=1,np + ir = np-i+1 + ghost%buf(ir, j, kptr+k, in)=v(i, np-j, k) + enddo + enddo + enddo + endif + + if(desc%reverse(west)) then + do k=1,vlyr + do j=1,nhc + do i=1,np + ir = np-i+1 + ghost%buf(ir, j, kptr+k, iw)=v(j+1, i, k) + enddo + enddo + enddo + endif + + ! corners. this is difficult because we dont know the orientaton + ! of the corners, and this which (i,j) dimension maps to which dimension +! SWEST + do l=swest, swest+max_corner_elem-1 + if (desc%putmapP_ghost(l) /= -1) then + do k=1,vlyr + do j=1,nhc+1 + do i=1,nhc+1 + ghost%buf(i, j, kptr+k, desc%putmapP_ghost(l))=v(i, j, k) + enddo + enddo + enddo + end if + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + if (desc%putmapP_ghost(l) /= -1) then + do k=1,vlyr + do j=1,nhc+1 + do i=1,nhc+1 + ghost%buf(i, j, kptr+k, desc%putmapP_ghost(l))=v(np-i+1, j, k) + enddo + enddo + enddo + end if + end do + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + if (desc%putmapP_ghost(l) /= -1) then + do k=1,vlyr + do j=1,nhc+1 + do i=1,nhc+1 + ghost%buf(i, j, kptr+k,desc%putmapP_ghost(l))=v(np-i+1, np-j+1, k) + enddo + enddo + enddo + end if + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + if (desc%putmapP_ghost(l) /= -1) then + do k=1,vlyr + do j=1,nhc+1 + do i=1,nhc+1 + ghost%buf(i, j, kptr+k,desc%putmapP_ghost(l))=v(i, np-j+1, k) + enddo + enddo + enddo + end if + end do + end subroutine ghostVpack3d + + ! ================================================================================= + ! GHOSTVUNPACK3D + ! AUTHOR: James Overfelt (from a subroutine of Christoph Erath, + ! ghostVunpack2d) + ! Unpack ghost points from ghost buffer into v... + ! It is for cartesian points (v is only two dimensional). + ! INPUT SAME arguments as for GHOSTVPACK + ! ================================================================================= + + subroutine ghostVunpack3d(g, v, vlyr, kptr, desc, sw, se, nw, ne, mult) + use dimensions_mod, only : max_corner_elem + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + use edgetype_mod, only : edgedescriptor_t, ghostbuffer3d_t + implicit none + type (Ghostbuffer3d_t), intent(in) :: g + + integer, intent(in) :: kptr,vlyr + real (kind=r8), intent(inout) :: v (1-g%nhc : g%np+g%nhc, 1-g%nhc : g%np+g%nhc, vlyr) + integer, intent(out) :: mult(5:8) + real (kind=r8), intent(out) :: sw(1-g%nhc : 1, 1-g%nhc : 1, vlyr, max_corner_elem-1) + real (kind=r8), intent(out) :: se( g%np : g%np+g%nhc, 1-g%nhc : 1, vlyr, max_corner_elem-1) + real (kind=r8), intent(out) :: ne( g%np : g%np+g%nhc, g%np : g%np+g%nhc, vlyr, max_corner_elem-1) + real (kind=r8), intent(out) :: nw(1-g%nhc : 1, g%np : g%np+g%nhc, vlyr, max_corner_elem-1) + type (EdgeDescriptor_t) :: desc + + integer :: nhc, np + + ! Local + logical, parameter :: UseUnroll = .TRUE. + integer :: i,j,k,l + integer :: is,ie,in,iw,ic + logical :: reverse + + threadsafe=.false. + + nhc = g%nhc + np = g%np + + is=desc%getmapP_ghost(south) + ie=desc%getmapP_ghost(east) + in=desc%getmapP_ghost(north) + iw=desc%getmapP_ghost(west) + +! fill in optional values with edgeDefaultVal + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i, 1-j, k)=edgeDefaultVal + v(np+i , 1-j, k)=edgeDefaultVal + v(np+i, np+j, k)=edgeDefaultVal + v(1-i , np+j, k)=edgeDefaultVal + enddo + enddo + enddo + + ! example for north buffer + ! first row ('edge') goes in v(:,np+1) + ! 2nd row ('edge') goes in v(:,np+2) + ! etc... + + do k=1,vlyr + do j=1,nhc + do i=1,np + v(i , 1-j , k) = g%buf(i,j,kptr+k,is ) + v(np+j , i , k) = g%buf(i,j,kptr+k,ie ) + v(i , np+j, k) = g%buf(i,j,kptr+k,in ) + v(1-j , i , k) = g%buf(i,j,kptr+k,iw ) + end do + end do + end do + + ! four sides are always just one + mult(swest) = 0 + mult(seast) = 0 + mult(neast) = 0 + mult(nwest) = 0 + + + +! SWEST + do l=swest, swest+max_corner_elem-1 + ic = desc%getmapP_ghost(l) + if(ic /= -1) then + reverse=desc%reverse(l) + if (mult(swest) .eq. 0) then + if (reverse) then + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i, 1-j, k)=g%buf(j+1, i+1, kptr+k, ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i,1-j,k)=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + else + if (reverse) then + do k=1,vlyr + do j=0,nhc + do i=0,nhc + sw(1-i,1-j,k,mult(swest))=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=0,nhc + do i=0,nhc + sw(1-i,1-j,k,mult(swest))=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + endif + mult(swest) = mult(swest) + 1 + endif + end do + +! SEAST + do l=swest+max_corner_elem,swest+2*max_corner_elem-1 + ic = desc%getmapP_ghost(l) + if(ic /= -1) then + reverse=desc%reverse(l) + if (mult(seast) .eq. 0) then + if (reverse) then + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(np+i,1-j,k)=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(np+i ,1-j,k)=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + else + if (reverse) then + do k=1,vlyr + do j=0,nhc + do i=0,nhc + se(np+i,1-j,k,mult(seast))=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=0,nhc + do i=0,nhc + se(np+i ,1-j,k,mult(seast))=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + endif + mult(seast) = mult(seast) + 1 + endif + end do + + +! NEAST + do l=swest+3*max_corner_elem,swest+4*max_corner_elem-1 + ic = desc%getmapP_ghost(l) + if(ic /= -1) then + reverse=desc%reverse(l) + if (mult(neast) .eq. 0) then + if (reverse) then + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(np+i ,np+j,k)=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(np+i ,np+j,k)=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + else + if (reverse) then + do k=1,vlyr + do j=0,nhc + do i=0,nhc + ne(np+i ,np+j,k,mult(neast))=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=0,nhc + do i=0,nhc + ne(np+i ,np+j,k,mult(neast))=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + endif + mult(neast) = mult(neast) + 1 + endif + end do + +! NWEST + do l=swest+2*max_corner_elem,swest+3*max_corner_elem-1 + ic = desc%getmapP_ghost(l) + if(ic /= -1) then + reverse=desc%reverse(l) + if (mult(nwest) .eq. 0) then + if (reverse) then + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i ,np+j,k)=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=1,nhc + do i=1,nhc + v(1-i ,np+j,k)=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + else + if (reverse) then + do k=1,vlyr + do j=0,nhc + do i=0,nhc + nw(1-i ,np+j,k,mult(nwest))=g%buf(j+1,i+1,kptr+k,ic) + enddo + enddo + enddo + else + do k=1,vlyr + do j=0,nhc + do i=0,nhc + nw(1-i ,np+j,k,mult(nwest))=g%buf(i+1,j+1,kptr+k,ic) + enddo + enddo + enddo + endif + endif + mult(nwest) = mult(nwest) + 1 + endif + end do + + end subroutine ghostVunpack3d + + subroutine FreeGhostBuffer3D(buffer) + use edgetype_mod, only : ghostbuffer3d_t + implicit none + type (Ghostbuffer3d_t),intent(inout) :: buffer + +!$OMP BARRIER +!$OMP MASTER + buffer%nbuf=0 + buffer%nlyr=0 + deallocate(buffer%buf) + deallocate(buffer%receive) +!$OMP END MASTER + + end subroutine FreeGhostBuffer3D + + +End module edge_mod diff --git a/src/dynamics/se/dycore/edgetype_mod.F90 b/src/dynamics/se/dycore/edgetype_mod.F90 new file mode 100644 index 0000000000..4cfe12020f --- /dev/null +++ b/src/dynamics/se/dycore/edgetype_mod.F90 @@ -0,0 +1,94 @@ +module edgetype_mod + + use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 + use coordinate_systems_mod, only : cartesian3D_t + use gbarriertype_mod, only : gbarrier_t + + implicit none + private + save + + integer, public :: initedgebuffer_callid = 0 + + type, public :: rotation_t + integer :: nbr ! nbr direction: north south east west + integer :: reverse ! 0 = do not reverse order + ! 1 = reverse order + real (kind=r8), pointer :: R(:,:,:) => null() ! rotation matrix + end type rotation_t + + type, public :: EdgeDescriptor_t + integer :: use_rotation + integer :: padding + integer, pointer :: putmapP(:) => null() + integer, pointer :: getmapP(:) => null() + integer, pointer :: putmapP_ghost(:) => null() + integer, pointer :: getmapP_ghost(:) => null() + integer, pointer :: putmapS(:) => null() + integer, pointer :: getmapS(:) => null() + integer, pointer :: globalID(:) => null() + integer, pointer :: loc2buf(:) => null() + type(cartesian3D_t), pointer :: neigh_corners(:,:) => null() + integer :: actual_neigh_edges + logical, pointer :: reverse(:) => null() + type (rotation_t), pointer :: rot(:) => null() ! Identifies list of edges + ! that must be rotated, and how + end type EdgeDescriptor_t + + type, public :: EdgeBuffer_t + real (kind=r8), allocatable :: buf(:) + real (kind=r8), allocatable :: receive(:) + integer, pointer :: putmap(:,:) => null() + integer, pointer :: getmap(:,:) => null() + logical, pointer :: reverse(:,:) => null() + integer, pointer :: moveLength(:) => null() + integer, pointer :: movePtr(:) => null() + integer, pointer :: rcountsFull(:) => null() + integer, pointer :: scountsFull(:) => null() + integer, pointer :: sdisplsFull(:) => null() + integer, pointer :: rdisplsFull(:) => null() + integer, pointer :: rcountsInter(:) => null() + integer, pointer :: scountsInter(:) => null() + integer, pointer :: sdisplsInter(:) => null() + integer, pointer :: rdisplsInter(:) => null() + integer, pointer :: rcountsIntra(:) => null() + integer, pointer :: scountsIntra(:) => null() + integer, pointer :: sdisplsIntra(:) => null() + integer, pointer :: rdisplsIntra(:) => null() + integer, pointer :: getDisplsFull(:) => null() + integer, pointer :: putDisplsFull(:) => null() + integer, allocatable :: Rrequest(:),Srequest(:) + integer, allocatable :: status(:,:) + type (gbarrier_t) :: gbarrier + integer :: nlyr ! Number of layers + integer :: nbuf ! total size of message passing buffer, includes vertical levels + integer :: ndepth ! Depth of halo + integer :: npoints ! length of edge + integer :: lb,ub ! lower and upper bound of arrays + integer :: nInter, nIntra + integer :: id + integer :: bndry_type + integer :: tag + integer :: win + integer(kind=i8) :: winsize + end type EdgeBuffer_t + + type, public :: LongEdgeBuffer_t + integer :: nlyr + integer :: nbuf + integer, pointer :: buf(:,:) => null() + integer, pointer :: receive(:,:) => null() + end type LongEdgeBuffer_t + + type, public :: GhostBuffer3D_t + real (kind=r8), dimension(:,:,:,:), pointer :: buf => null() + real (kind=r8), dimension(:,:,:,:), pointer :: receive => null() + integer :: nlyr ! Number of layers + integer :: nhc ! Number of layers of ghost cells + integer :: np ! Number of points in a cell + integer :: nbuf ! size of the horizontal dimension of the buffers. + integer :: elem_size ! size of 2D array (first two dimensions of buf()) + end type GhostBuffer3D_t + + +end module edgetype_mod diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 new file mode 100644 index 0000000000..966b289c98 --- /dev/null +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -0,0 +1,378 @@ +module element_mod + + use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 + use coordinate_systems_mod, only: spherical_polar_t, cartesian2D_t, cartesian3D_t, distance + use dimensions_mod, only: np, nc, npsq, nlev, nlevp, qsize_d, max_neigh_edges,ntrac_d + use edgetype_mod, only: edgedescriptor_t + use gridgraph_mod, only: gridvertex_t + + implicit none + private + integer, public, parameter :: timelevels = 3 + + +! =========== PRIMITIVE-EQUATION DATA-STRUCTURES ===================== + + type, public :: elem_state_t + + ! prognostic variables for preqx solver + + ! prognostics must match those in prim_restart_mod.F90 + ! vertically-lagrangian code advects dp3d instead of ps + ! tracers Q, Qdp always use 2 level time scheme + + real (kind=r8) :: v (np,np,2,nlev,timelevels) ! velocity 1 + real (kind=r8) :: T (np,np,nlev,timelevels) ! temperature 2 + real (kind=r8) :: dp3d (np,np,nlev,timelevels) ! dry delta p on levels 8 + real (kind=r8) :: psdry (np,np,timelevels) ! dry surface pressure 4 + real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) 5 + real (kind=r8) :: Qdp (np,np,nlev,qsize_d,2) ! Tracer mass 6 + + end type elem_state_t + + !___________________________________________________________________ + type, public :: derived_state_t + + ! diagnostic variables for preqx solver + + ! storage for subcycling tracers/dynamics + + real (kind=r8) :: vn0 (np,np,2,nlev) ! velocity for SE tracer advection + real (kind=r8) :: dpdiss_biharmonic(np,np,nlev) ! mean dp dissipation tendency, if nu_p>0 + real (kind=r8) :: dpdiss_ave(np,np,nlev) ! mean dp used to compute psdiss_tens + + ! diagnostics for explicit timestep + real (kind=r8) :: phi(np,np,nlev) ! geopotential + real (kind=r8) :: omega(np,np,nlev) ! vertical velocity + + ! semi-implicit diagnostics: computed in explict-component, reused in Helmholtz-component. + real (kind=r8) :: zeta(np,np,nlev) ! relative vorticity + real (kind=r8) :: div(np,np,nlev,timelevels) ! divergence + + ! tracer advection fields used for consistency and limiters + real (kind=r8) :: dp(np,np,nlev) ! for dp_tracers at physics timestep + real (kind=r8) :: divdp(np,np,nlev) ! divergence of dp + real (kind=r8) :: divdp_proj(np,np,nlev) ! DSSed divdp + real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+2) ! total tracer mass for diagnostics + + ! forcing terms for CAM + real (kind=r8) :: FQ(np,np,nlev,qsize_d) ! tracer forcing + real (kind=r8) :: FM(np,np,2,nlev) ! momentum forcing + real (kind=r8) :: FT(np,np,nlev) ! temperature forcing + real (kind=r8) :: etadot_prescribed(np,np,nlevp) ! prescribed vertical tendency + real (kind=r8) :: u_met(np,np,nlev) ! zonal component of prescribed meteorology winds + real (kind=r8) :: dudt_met(np,np,nlev) ! rate of change of zonal component of prescribed meteorology winds + real (kind=r8) :: v_met(np,np,nlev) ! meridional component of prescribed meteorology winds + real (kind=r8) :: dvdt_met(np,np,nlev) ! rate of change of meridional component of prescribed meteorology winds + real (kind=r8) :: T_met(np,np,nlev) ! prescribed meteorology temperature + real (kind=r8) :: dTdt_met(np,np,nlev) ! rate of change of prescribed meteorology temperature + real (kind=r8) :: ps_met(np,np) ! surface pressure of prescribed meteorology + real (kind=r8) :: dpsdt_met(np,np) ! rate of change of surface pressure of prescribed meteorology + real (kind=r8) :: nudge_factor(np,np,nlev) ! nudging factor (prescribed) + real (kind=r8) :: Utnd(npsq,nlev) ! accumulated U tendency due to nudging towards prescribed met + real (kind=r8) :: Vtnd(npsq,nlev) ! accumulated V tendency due to nudging towards prescribed met + real (kind=r8) :: Ttnd(npsq,nlev) ! accumulated T tendency due to nudging towards prescribed met + + real (kind=r8) :: pecnd(np,np,nlev) ! pressure perturbation from condensate + + end type derived_state_t + + !___________________________________________________________________ + type, public :: elem_accum_t + + + ! the "4" timelevels represents data computed at: + ! 1 t-.5 + ! 2 t+.5 after dynamics + ! 3 t+.5 after forcing + ! 4 t+.5 after Robert + ! after calling TimeLevelUpdate, all times above decrease by 1.0 + + + end type elem_accum_t + + +! ============= DATA-STRUCTURES COMMON TO ALL SOLVERS ================ + + type, public :: index_t + integer :: ia(npsq),ja(npsq) + integer :: is,ie + integer :: NumUniquePts + integer :: UniquePtOffset + end type index_t + + !___________________________________________________________________ + type, public :: element_t + integer :: LocalId + integer :: GlobalId + + ! Coordinate values of element points + type (spherical_polar_t) :: spherep(np,np) ! Spherical coords of GLL points + + ! Equ-angular gnomonic projection coordinates + type (cartesian2D_t) :: cartp(np,np) ! gnomonic coords of GLL points + type (cartesian2D_t) :: corners(4) ! gnomonic coords of element corners + real (kind=r8) :: u2qmap(4,2) ! bilinear map from ref element to quad in cubedsphere coordinates + ! SHOULD BE REMOVED + ! 3D cartesian coordinates + type (cartesian3D_t) :: corners3D(4) + + ! Element diagnostics + real (kind=r8) :: area ! Area of element + real (kind=r8) :: normDinv ! some type of norm of Dinv used for CFL + real (kind=r8) :: dx_short ! short length scale in km + real (kind=r8) :: dx_long ! long length scale in km + + real (kind=r8) :: variable_hyperviscosity(np,np) ! hyperviscosity based on above + real (kind=r8) :: hv_courant ! hyperviscosity courant number + real (kind=r8) :: tensorVisc(np,np,2,2) !og, matrix V for tensor viscosity + + ! Edge connectivity information +! integer :: node_numbers(4) +! integer :: node_multiplicity(4) ! number of elements sharing corner node + + type (GridVertex_t) :: vertex ! element grid vertex information + type (EdgeDescriptor_t) :: desc + + type (elem_state_t) :: state + + type (derived_state_t) :: derived + ! Metric terms + real (kind=r8) :: met(np,np,2,2) ! metric tensor on velocity and pressure grid + real (kind=r8) :: metinv(np,np,2,2) ! metric tensor on velocity and pressure grid + real (kind=r8) :: metdet(np,np) ! g = SQRT(det(g_ij)) on velocity and pressure grid + real (kind=r8) :: rmetdet(np,np) ! 1/metdet on velocity pressure grid + real (kind=r8) :: D(np,np,2,2) ! Map covariant field on cube to vector field on the sphere + real (kind=r8) :: Dinv(np,np,2,2) ! Map vector field on the sphere to covariant v on cube + + + ! Mass flux across the sides of each sub-element. + ! The storage is redundent since the mass across shared sides + ! must be equal in magnitude and opposite in sign. + ! The layout is like: + ! -------------------------------------------------------------- + ! ^| (1,4,3) | | | (4,4,3) | + ! || | | | | + ! ||(1,4,4) | | |(4,4,4) | + ! || (1,4,2)| | | (4,4,2)| + ! || | | | | + ! || (1,4,1) | | | (4,4,1) | + ! |--------------------------------------------------------------- + ! S| | | | | + ! e| | | | | + ! c| | | | | + ! o| | | | | + ! n| | | | | + ! d| | | | | + ! --------------------------------------------------------------- + ! C| | | | | + ! o| | | | | + ! o| | | | | + ! r| | | | | + ! d| | | | | + ! i| | | | | + ! n--------------------------------------------------------------- + ! a| (1,1,3) | | | (4,1,3) | + ! t| | | |(4,1,4) | + ! e|(1,1,4) | | | | + ! | (1,1,2)| | | (4,1,2)| + ! | | | | | + ! | (1,1,1) | | | (4,1,1) | + ! --------------------------------------------------------------- + ! First Coordinate -------> + real (kind=r8) :: sub_elem_mass_flux(nc,nc,4,nlev) + + ! Convert vector fields from spherical to rectangular components + ! The transpose of this operation is its pseudoinverse. + real (kind=r8) :: vec_sphere2cart(np,np,3,2) + + ! Mass matrix terms for an element on a cube face + real (kind=r8) :: mp(np,np) ! mass matrix on v and p grid + real (kind=r8) :: rmp(np,np) ! inverse mass matrix on v and p grid + + ! Mass matrix terms for an element on the sphere + ! This mass matrix is used when solving the equations in weak form + ! with the natural (surface area of the sphere) inner product + real (kind=r8) :: spheremp(np,np) ! mass matrix on v and p grid + real (kind=r8) :: rspheremp(np,np) ! inverse mass matrix on v and p grid + + integer(i8) :: gdofP(np,np) ! global degree of freedom (P-grid) + + real (kind=r8) :: fcor(np,np) ! Coreolis term + + type (index_t) :: idxP + type (index_t),pointer :: idxV + integer :: FaceNum + + ! force element_t to be a multiple of 8 bytes. + ! on BGP, code will crash (signal 7, or signal 15) if 8 byte alignment is off + ! check core file for: + ! core.63:Generated by interrupt..(Alignment Exception DEAR=0xa1ef671c ESR=0x01800000 CCR0=0x4800a002) + integer :: dummy + end type element_t + + !___________________________________________________________________ + public :: element_coordinates + public :: element_var_coordinates + public :: element_var_coordinates3D + public :: GetColumnIdP,GetColumnIdV + public :: allocate_element_desc + public :: PrintElem + +contains + + subroutine PrintElem(arr) + + real(kind=r8) :: arr(:,:) + integer :: i,j + + do j=np,1,-1 + write(6,*) (arr(i,j), i=1,np) + enddo + + end subroutine PrintElem +! ===================== ELEMENT_MOD METHODS ========================== + + function GetColumnIdP(elem,i,j) result(col_id) + + ! Get unique identifier for a Physics column on the P-grid + + type(element_t), intent(in) :: elem + integer, intent(in) :: i,j + integer :: col_id + col_id = elem%gdofP(i,j) + end function GetColumnIdP + + !___________________________________________________________________ + function GetColumnIdV(elem,i,j) result(col_id) + + ! Get unique identifier for a Physics column on the V-grid + + type(element_t), intent(in) :: elem + integer, intent(in) :: i,j + integer :: col_id + col_id = elem%gdofP(i,j) + end function GetColumnIdV + + !___________________________________________________________________ + function element_coordinates(start,end,points) result(cart) + + ! Initialize 2D rectilinear element colocation points + + type (cartesian2D_t), intent(in) :: start + type (cartesian2D_t), intent(in) :: end + real(r8), intent(in) :: points(:) + type (cartesian2D_t) :: cart(SIZE(points),SIZE(points)) + + type (cartesian2D_t) :: length, centroid + real(r8) :: y + integer :: i,j + + length%x = 0.50D0*(end%x-start%x) + length%y = 0.50D0*(end%y-start%y) + centroid%x = 0.50D0*(end%x+start%x) + centroid%y = 0.50D0*(end%y+start%y) + do j=1,SIZE(points) + y = centroid%y + length%y*points(j) + do i=1,SIZE(points) + cart(i,j)%x = centroid%x + length%x*points(i) + cart(i,j)%y = y + end do + end do + end function element_coordinates + + !___________________________________________________________________ + function element_var_coordinates(c,points) result(cart) + + type (cartesian2D_t), intent(in) :: c(4) + real(r8), intent(in) :: points(:) + type (cartesian2D_t) :: cart(SIZE(points),SIZE(points)) + + real(r8) :: p(size(points)) + real(r8) :: q(size(points)) + integer :: i,j + + p(:) = (1.0D0-points(:))/2.0D0 + q(:) = (1.0D0+points(:))/2.0D0 + + do j=1,SIZE(points) + do i=1,SIZE(points) + cart(i,j)%x = p(i)*p(j)*c(1)%x & + + q(i)*p(j)*c(2)%x & + + q(i)*q(j)*c(3)%x & + + p(i)*q(j)*c(4)%x + cart(i,j)%y = p(i)*p(j)*c(1)%y & + + q(i)*p(j)*c(2)%y & + + q(i)*q(j)*c(3)%y & + + p(i)*q(j)*c(4)%y + end do + end do + end function element_var_coordinates + + !___________________________________________________________________ + function element_var_coordinates3d(c,points) result(cart) + + type(cartesian3D_t), intent(in) :: c(4) + real(r8), intent(in) :: points(:) + + type(cartesian3D_t) :: cart(SIZE(points),SIZE(points)) + + real(r8) :: p(size(points)) + real(r8) :: q(size(points)), r + integer :: i,j + + p(:) = (1.0D0-points(:))/2.0D0 + q(:) = (1.0D0+points(:))/2.0D0 + + do j=1,SIZE(points) + do i=1,SIZE(points) + cart(i,j)%x = p(i)*p(j)*c(1)%x & + + q(i)*p(j)*c(2)%x & + + q(i)*q(j)*c(3)%x & + + p(i)*q(j)*c(4)%x + cart(i,j)%y = p(i)*p(j)*c(1)%y & + + q(i)*p(j)*c(2)%y & + + q(i)*q(j)*c(3)%y & + + p(i)*q(j)*c(4)%y + cart(i,j)%z = p(i)*p(j)*c(1)%z & + + q(i)*p(j)*c(2)%z & + + q(i)*q(j)*c(3)%z & + + p(i)*q(j)*c(4)%z + + ! project back to sphere: + r = distance(cart(i,j)) + cart(i,j)%x = cart(i,j)%x/r + cart(i,j)%y = cart(i,j)%y/r + cart(i,j)%z = cart(i,j)%z/r + end do + end do + end function element_var_coordinates3d + + !___________________________________________________________________ + subroutine allocate_element_desc(elem) + + type (element_t), intent(inout) :: elem(:) + integer :: num, j,i + + num = SIZE(elem) + + do j=1,num + allocate(elem(j)%desc%putmapP(max_neigh_edges)) + allocate(elem(j)%desc%getmapP(max_neigh_edges)) + allocate(elem(j)%desc%putmapP_ghost(max_neigh_edges)) + allocate(elem(j)%desc%getmapP_ghost(max_neigh_edges)) + allocate(elem(j)%desc%putmapS(max_neigh_edges)) + allocate(elem(j)%desc%getmapS(max_neigh_edges)) + allocate(elem(j)%desc%reverse(max_neigh_edges)) + allocate(elem(j)%desc%globalID(max_neigh_edges)) + allocate(elem(j)%desc%loc2buf(max_neigh_edges)) + do i=1,max_neigh_edges + elem(j)%desc%loc2buf(i)=i + elem(j)%desc%globalID(i)=-1 + enddo + + end do + end subroutine allocate_element_desc + + +end module element_mod diff --git a/src/dynamics/se/dycore/fvm_analytic_mod.F90 b/src/dynamics/se/dycore/fvm_analytic_mod.F90 new file mode 100644 index 0000000000..7640793d73 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_analytic_mod.F90 @@ -0,0 +1,1217 @@ +!MODULE FVM_ANALYTIC_MOD--------------------------------------------CE-for FVM! +! AUTHOR: CHRISTOPH ERATH, 17.October 2011 ! +! This module contains all analytical terms for fvm ! +!-----------------------------------------------------------------------------! +module fvm_analytic_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + use cam_abortutils, only: endrun + + implicit none + private + + public :: get_high_order_weights_over_areas, compute_reconstruct_matrix + public :: compute_halo_vars, init_flux_orient + public :: I_00, I_10, I_01, I_20, I_02, I_11, gauss_points + public :: F_00, F_10, F_01, F_20, F_02, F_11 + public :: create_interpolation_points, compute_basic_coordinate_vars + +CONTAINS + + subroutine compute_basic_coordinate_vars(elem,& + nc,irecons,dalpha,dbeta,vtx_cart,center_cart,area_sphere,spherecentroid) + use coordinate_systems_mod, only: cart2spherical + use element_mod, only: element_t + use coordinate_systems_mod, only: spherical_polar_t + + type (element_t), intent(in ) :: elem + integer, intent(in) :: nc,irecons + + real (kind=r8), intent(out) :: dalpha, dbeta + real (kind=r8), intent(out) :: vtx_cart (4,2,nc,nc) + real (kind=r8), intent(out) :: area_sphere(nc,nc) + real (kind=r8), intent(out) :: spherecentroid(irecons-1,nc,nc) + type (spherical_polar_t), intent(out) :: center_cart(nc,nc) ! Spherical coordinates of fvm grid + + integer :: i,j + real (kind=r8) :: centerx,centery + real (kind=r8) :: acartx(nc+1), acarty(nc+1) + + dalpha=abs(elem%corners(1)%x-elem%corners(2)%x)/nc + dbeta =abs(elem%corners(1)%y-elem%corners(4)%y)/nc + + do i=1,nc+1 + acartx(i) = tan(elem%corners(1)%x+(i-1)*dalpha) + acarty(i) = tan(elem%corners(1)%y+(i-1)*dbeta) + end do + + do j=1,nc + do i=1,nc + centerx = tan(elem%corners(1)%x+(i-0.5_r8)*dalpha) + centery = tan(elem%corners(1)%y+(j-0.5_r8)*dbeta) + center_cart(i,j) = cart2spherical(centerx,centery,elem%FaceNum) + enddo + enddo + + vtx_cart = -9D9 + do j=1,nc + do i=1,nc + vtx_cart(1,1,i,j) = acartx(i ) + vtx_cart(1,2,i,j) = acarty(j ) + + vtx_cart(2,1,i,j) = acartx(i+1) + vtx_cart(2,2,i,j) = acarty(j ) + + vtx_cart(3,1,i,j) = acartx(i+1) + vtx_cart(3,2,i,j) = acarty(j+1) + + vtx_cart(4,1,i,j) = acartx(i ) + vtx_cart(4,2,i,j) = acarty(j+1) + end do + end do + ! compute area and centroid for the interior and halo zone of interior elements + call moment_onsphere(nc,irecons,area_sphere,vtx_cart,.true.,spherecentroid) + end subroutine compute_basic_coordinate_vars + + subroutine compute_halo_vars(faceno,cubeboundary,nc,nhc,nhe,& + jx_min,jx_max,jy_min,jy_max,flux_orient, ifct, rot_matrix) + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + + integer, intent(in) :: faceno,nc,nhc,nhe,cubeboundary + + integer, intent(out) :: jx_min(3),jx_max(3),jy_min(3),jy_max(3) + real (kind=r8), intent(out) :: flux_orient(2, 1-nhc:nc+nhc,1-nhc:nc+nhc) + integer, intent(out) :: ifct (1-nhc:nc+nhc,1-nhc:nc+nhc) + integer, intent(out) :: rot_matrix(2,2,1-nhc:nc+nhc,1-nhc:nc+nhc) + + integer :: i,j + integer :: rot90_matrix(2,2) + integer :: ishft + + + jx_min(2) = 0; jx_max(2) = -1; jy_min(2) = 0; jy_max(2) = -1 + jx_min(3) = 0; jx_max(3) = -1; jy_min(3) = 0; jy_max(3) = -1 + + select case (cubeboundary) + case (0) + jx_min(1)=1-nhe; jx_max(1)=nc+1+nhe; jy_min(1)=1-nhe; jy_max(1)=nc+1+nhe + case (west) + jx_min(1)=1 ; jx_max(1)=nc+1+nhe; jy_min(1)=1-nhe; jy_max(1)=nc+1+nhe + jx_min(2)=1-nhe; jx_max(2)=1 ; jy_min(2)=1-nhe; jy_max(2)=nc+1+nhe + case(east) + jx_min(1)=1-nhe; jx_max(1)=nc+1 ; jy_min(1)=1-nhe; jy_max(1)=nc+1+nhe + jx_min(2)=nc+1 ; jx_max(2)=nc+1+nhe; jy_min(2)=1-nhe; jy_max(2)=nc+1+nhe + case(north) + jx_min(1)=1-nhe; jx_max(1)=nc+1+nhe; jy_min(1)=1-nhe; jy_max(1)=nc+1 + jx_min(2)=1-nhe; jx_max(2)=nc+1+nhe; jy_min(2)=nc+1 ; jy_max(2)=nc+1+nhe + case(south) + jx_min(1)=1-nhe; jx_max(1)=nc+1+nhe; jy_min(1)=1 ; jy_max(1)=nc+1+nhe + jx_min(2)=1-nhe; jx_max(2)=nc+1+nhe; jy_min(2)=1-nhe; jy_max(2)=1 + case(swest) + jx_min(1)=1 ; jx_max(1)=nc+1+nhe; jy_min(1)=1 ; jy_max(1)=nc+1+nhe + jx_min(2)=1 ; jx_max(2)=nc+1+nhe; jy_min(2)=1-nhe; jy_max(2)=1 + jx_min(3)=1-nhe; jx_max(3)=1 ; jy_min(3)=1 ; jy_max(3)=nc+1+nhe + case(seast) + jx_min(1)=1-nhe; jx_max(1)=nc+1 ; jy_min(1)=1 ; jy_max(1)=nc+1+nhe + jx_min(2)=1-nhe; jx_max(2)=nc+1 ; jy_min(2)=1-nhe; jy_max(2)=1 + jx_min(3)=nc+1 ; jx_max(3)=nc+1+nhe; jy_min(3)=1 ; jy_max(3)=nc+1+nhe + case(neast) + jx_min(1)=1-nhe; jx_max(1)=nc+1 ; jy_min(1)=1-nhe; jy_max(1)=nc+1 + jx_min(2)=1-nhe; jx_max(2)=nc+1 ; jy_min(2)=nc+1 ; jy_max(2)=nc+1+nhe + jx_min(3)=nc+1 ; jx_max(3)=nc+1+nhe; jy_min(3)=1-nhe; jy_max(3)=nc+1 + case(nwest) + jx_min(1)=1 ; jx_max(1)=nc+1+nhe; jy_min(1)=1-nhe; jy_max(1)=nc+1 + jx_min(2)=1 ; jx_max(2)=nc+1+nhe; jy_min(2)=nc+1 ; jy_max(2)=nc+1+nhe + jx_min(3)=1-nhe; jx_max(3)=1 ; jy_min(3)=1-nhe; jy_max(3)=nc+1 + + case default + print *, 'Fatal Error in fvm_line_integrals_mod.F90.' + call endrun('Selected case for cubeboundary does not exists!') + end select + ! + ! init location of flux-sides + ! + call init_flux_orient(flux_orient,ifct,nc,nhc,cubeboundary,faceno) + rot_matrix(1,1,:,:) = 1; rot_matrix(1,2,:,:) = 0; + rot_matrix(2,1,:,:) = 0; rot_matrix(2,2,:,:) = 1; + + if (cubeboundary>0) then + ! + ! clockwise 90 rotation of vectors + ! + rot90_matrix(1,1) = 0; rot90_matrix(2,1) = -1; + rot90_matrix(1,2) = 1; rot90_matrix(2,2) = 0; + do j=1-nhc,nc+nhc + do i=1-nhc,nc+nhc + do ishft=1,4-nint(flux_orient(2,i,j)) + rot_matrix(:,:,i,j) = MATMUL(rot90_matrix,rot_matrix(:,:,i,j)) + end do + enddo + enddo + end if + end subroutine compute_halo_vars + + + ! ----------------------------------------------------------------------------------! + !SUBROUTINE MOMENT_ONSPHERE-----------------------------------------------CE-for FVM! + ! AUTHOR: CHRISTOPH ERATH, 20.July 2011 ! + ! DESCRIPTION: Compute area and centroids/moments via line integrals ! + ! ! + ! INPUT: x ... x cartesian coordinats of the arrival grid on the cube ! + ! y ... y cartesian coordinats of the arrival grid on the cube ! + ! ... cell boundaries in x and y directions ! + ! INPUT/OUTPUT: ! + ! area ... area of cells on the sphere ! + ! centroid ... x,y,x^2,y^2,xy ! + !-----------------------------------------------------------------------------------! + subroutine moment_onsphere(nc,irecons,area,vtx_cart,lanalytic,spherecentroid) + use dimensions_mod, only: ngpc + + integer, intent(in) :: nc,irecons + real (kind=r8), dimension(nc,nc) , intent(out) :: area + real (kind=r8), dimension(irecons-1,nc,nc), intent(out) :: spherecentroid + real (kind=r8), dimension(4,2,nc,nc) , intent(in) :: vtx_cart + logical, optional, intent(in) :: lanalytic + integer :: i,j + ! + ! variables for call to get_high_order_weights_over_areas + ! + integer, parameter :: num_area=1, num_seg_max=2 + REAL(KIND=r8), dimension(2,num_seg_max,num_area) :: xx, dxx + integer , dimension(num_area ), parameter :: num_seg=2 + REAL(KIND=r8), dimension(irecons,num_area):: weights + real (kind=r8), dimension(nc+1) :: x, y + + + real (kind=r8), dimension(ngpc):: gsweights, gspts + ! + ! initialize quadrature weights for get_high_order_weights_over_areas + ! + call gauss_points(ngpc,gsweights,gspts) !set gauss points/weights + gspts = 0.5_r8*(gspts+1.0_r8) !shift location so in [0:1] instead of [-1:1] + + x(1:nc) = vtx_cart(1,1,1:nc,1 ) + y(1:nc) = vtx_cart(1,2,1 ,1:nc) + x(nc+1) = vtx_cart(2,1, nc,1 ) + y(nc+1) = vtx_cart(3,2,1 ,nc ) + + select case (irecons) + case(1) + if (present(lanalytic)) then + do j=1,nc + do i=1,nc + area(i,j) = (I_00(x(i+1),y(j+1)) - I_00(x(i),y(j+1)) + & + I_00(x(i),y(j)) - I_00(x(i+1),y(j))) + end do + end do + else + call endrun("non-analytic moments not coded for irecons=1") + end if + + case(3) + if (present(lanalytic)) then + do j=1,nc + do i=1,nc + area(i,j) = (I_00(x(i+1),y(j+1)) - I_00(x(i),y(j+1)) + & + I_00(x(i),y(j)) - I_00(x(i+1),y(j))) + ! Compute centroids via line integrals + spherecentroid(1,i,j) = (I_10(x(i+1),y(j+1)) - I_10(x(i),y(j+1)) + & + I_10(x(i),y(j)) - I_10(x(i+1),y(j))) / area(i,j) + spherecentroid(2,i,j) = (I_01(x(i+1),y(j+1)) - I_01(x(i),y(j+1)) + & + I_01(x(i),y(j)) - I_01(x(i+1),y(j))) / area(i,j) + end do + end do + else + call endrun("non-analytic moments not coded for irecons=3") + end if + + + case(6) + if (present(lanalytic)) then + do j=1,nc + do i=1,nc + ! area(i,j) = surfareaxy(x(i),x(i+1),y(j),y(j+1)) + area(i,j) = (I_00(x(i+1),y(j+1)) - I_00(x(i),y(j+1)) + & + I_00(x(i),y(j)) - I_00(x(i+1),y(j))) + ! Compute centroids via line integrals + spherecentroid(1,i,j) = (I_10(x(i+1),y(j+1)) - I_10(x(i),y(j+1)) + & + I_10(x(i),y(j)) - I_10(x(i+1),y(j))) / area(i,j) + spherecentroid(2,i,j) = (I_01(x(i+1),y(j+1)) - I_01(x(i),y(j+1)) + & + I_01(x(i),y(j)) - I_01(x(i+1),y(j))) / area(i,j) + ! TAN(alpha)^2 component + spherecentroid(3,i,j) = (I_20(x(i+1),y(j+1)) - I_20(x(i),y(j+1)) + & + I_20(x(i),y(j)) - I_20(x(i+1),y(j))) / area(i,j) + ! TAN(beta)^2 component + spherecentroid(4,i,j) = (I_02(x(i+1),y(j+1)) - I_02(x(i),y(j+1)) + & + I_02(x(i),y(j)) - I_02(x(i+1),y(j))) / area(i,j) + ! TAN(alpha) TAN(beta) component + spherecentroid(5,i,j) = (I_11(x(i+1),y(j+1)) - I_11(x(i),y(j+1)) + & + I_11(x(i),y(j)) - I_11(x(i+1),y(j))) / area(i,j) + end do + end do + else + do j=1,nc + do i=1,nc + + xx (1,1,1) = x(i) ; xx (2,1,1) = y(j+1); + dxx(1,1,1) = x(i+1)-x(i); dxx(2,1,1) = 0.0_r8 ; + + xx (1,2,1) = x(i+1) ; xx (2,2,1) = y(j) ; + dxx(1,2,1) = x(i)-x(i+1); dxx(2,2,1) = 0.0_r8 ; + + call get_high_order_weights_over_areas(xx,dxx,num_seg,num_seg_max,num_area,weights,ngpc,gsweights,gspts,irecons) + + area(i,j) = weights(1,1) + + spherecentroid(1:5,i,j) = weights(2:6,1)/area(i,j) + end do + end do + end if + case default + write(*,*) "irecons out of range",irecons + end select + end subroutine moment_onsphere + + + ! ----------------------------------------------------------------------------------! + !SUBROUTINES I_00, I_01, I_20, I_02, I11----------------------------------CE-for FVM! + ! AUTHOR: CHRISTOPH ERATH, 17.October 2011 ! + ! DESCRIPTION: calculates the exact integrals ! + ! ! + ! CALLS: none ! + ! INPUT: x ... x coordinate of the evaluation point (Cartesian on the cube) ! + ! y ... y coordinate of the evaluation point (Cartesian on the cube) ! + ! OUTPUT: I_00, I_01, I_20, I_02, I11 ! + !-----------------------------------------------------------------------------------! + function I_00(x,y) + implicit none + real (kind=r8) :: I_00 + real (kind=r8), intent(in) :: x,y + + I_00 = ATAN(x*y/SQRT(1.0_r8+x*x+y*y)) + end function I_00 + + function I_10(x,y) + implicit none + real (kind=r8) :: I_10 + real (kind=r8), intent(in) :: x,y + real (kind=r8) :: tmp + + ! tmp = ATAN(x) + ! I_10 = -ASINH(y*COS(tmp)) + tmp = y*COS(ATAN(x)) + I_10 = -log(tmp+sqrt(tmp*tmp+1)) + end function I_10 + + + function I_01(x,y) + implicit none + real (kind=r8) :: I_01 + real (kind=r8), intent(in) :: x,y + real (kind=r8) :: tmp + + ! I_01 = -ASINH(x/SQRT(1+y*y)) + tmp=x/SQRT(1+y*y) + I_01 = -log(tmp+sqrt(tmp*tmp+1)) + end function I_01 + + function I_20(x,y) + implicit none + real (kind=r8) :: I_20 + real (kind=r8), intent(in) :: x,y + real (kind=r8) :: tmp,tmp1 + + tmp = 1.0_r8+y*y + tmp1=x/SQRT(tmp) + I_20 = y*log(tmp1+sqrt(tmp1*tmp1+1))+ACOS(x*y/(SQRT((1.0_r8+x*x)*tmp))) + end function I_20 + + function I_02(x,y) + implicit none + real (kind=r8) :: I_02 + real (kind=r8), intent(in) :: x,y + real (kind=r8) :: tmp,tmp1 + + ! tmp=1.0_r8+x*x + ! I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) + tmp=1.0_r8+x*x + tmp1=y/SQRT(tmp) + + I_02 = x*log(tmp1+sqrt(tmp1*tmp1+1))+ACOS(x*y/SQRT(tmp*(1+y*y))) + + end function I_02 + + function I_11(x,y) + implicit none + real (kind=r8) :: I_11 + real (kind=r8), intent(in) :: x,y + + I_11 = -SQRT(1+x*x+y*y) + end function I_11 + !END SUBROUTINES I_00, I_01, I_20, I_02, I11------------------------------CE-for FVM! + + + real (kind=r8) function F_00(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y + ! + x = x_in + y = y_in + F_00 =y/((1.0_r8+x*x)*SQRT(1.0_r8+x*x+y*y)) + end function F_00 + + real (kind=r8) function F_10(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y + + x = x_in + y = y_in + + F_10 =x*y/((1.0_r8+x*x)*SQRT(1.0_r8+x*x+y*y)) + end function F_10 + + real (kind=r8) function F_01(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y + + x = x_in + y = y_in + + F_01 =-1.0_r8/(SQRT(1.0_r8+x*x+y*y)) + end function F_01 + + real (kind=r8) function F_20(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y + + x = x_in + y = y_in + + F_20 =x*x*y/((1.0_r8+x*x)*SQRT(1.0_r8+x*x+y*y)) + end function F_20 + + real (kind=r8) function F_02(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y,alpha,tmp + + x = x_in + y = y_in + + alpha = ATAN(x) +! F_02 =-y/SQRT(1.0_r8+x*x+y*y)+ASINH(y*COS(alpha)) + tmp=y*COS(alpha) + F_02 =-y/SQRT(1.0_r8+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) + + ! + ! cos(alpha) = 1/sqrt(1+x*x) + ! + end function F_02 + + real (kind=r8) function F_11(x_in,y_in) + implicit none + real (kind=r8), intent(in) :: x_in,y_in + real (kind=r8) :: x,y + + x = x_in + y = y_in + + F_11 =-x/(SQRT(1.0_r8+x*x+y*y)) + end function F_11 + + + + ! + ! matrix version of reconstruct_cubic_onface + ! + subroutine compute_reconstruct_matrix(nc,nhe,nhc,irecons,dalpha,dbeta,spherecentroid,vtx_cart,& + centroid_stretch,vertex_recons_weights,recons_metrics,recons_metrics_integral) + implicit none + integer , intent(in) :: nc,nhe,irecons,nhc + real (kind=r8), intent(in) :: dalpha,dbeta + real (kind=r8), dimension(irecons-1,1-nhc:nc+nhc,1-nhc:nc+nhc), intent(in) :: spherecentroid + real (kind=r8), dimension(4,2,1-nhc:nc+nhc,1-nhc:nc+nhc) , intent(in) :: vtx_cart + + real (kind=r8), dimension(7,1-nhe:nc+nhe,1-nhe:nc+nhe) , intent(out):: centroid_stretch + real (kind=r8), dimension(1:irecons-1,4,1-nhe:nc+nhe,1-nhe:nc+nhe), intent(out):: vertex_recons_weights + real (kind=r8), dimension(3,1-nhe:nc+nhe,1-nhe:nc+nhe) , intent(out):: recons_metrics + real (kind=r8), dimension(3,1-nhe:nc+nhe,1-nhe:nc+nhe) , intent(out):: recons_metrics_integral + + ! + integer :: i, j, count, m, n + real (kind=r8) :: coef,tmp,cartx,carty + ! + ! pre-compute variables for reconstruction + ! + select case (irecons) + case(3) + do j= 1-nhe,nc+nhe + do i=1-nhe,nc+nhe + count = 1 + do n = j, j+1 + do m = i, i+1 + cartx = vtx_cart(count,1,i,j); carty = vtx_cart(count,2,i,j); + + vertex_recons_weights(1,count,i,j) = cartx - spherecentroid(1,i,j) + vertex_recons_weights(2,count,i,j) = carty - spherecentroid(2,i,j) + + count=count+1 + end do + enddo + end do + end do + call endrun("recons_metrics and recons_metrics_integral not initialize") + ! + ! for reconstruction + ! + do j= 1-nhe,nc+nhe + do i=1-nhe,nc+nhe + ! + !*************** + !* dfdx * + !*************** + ! + coef = 1.0_r8/(12.0_r8 * dalpha) !finite difference coefficient + coef = coef /( 1.0_r8 + spherecentroid(1,i,j)**2) !stretching coefficient + + centroid_stretch(1,i,j) = coef + ! + !*************** + !* dfdy * + !*************** + ! + coef = 1.0_r8/(12.0_r8 * dbeta) !finite difference coefficient + coef = coef /( 1.0_r8 + spherecentroid(2,i,j)**2) !stretching coefficient + + centroid_stretch(2,i,j) = coef + end do + end do + case(6) + do j= 1-nhe,nc+nhe + do i=1-nhe,nc+nhe + do count=1,4 + cartx = vtx_cart(count,1,i,j); carty = vtx_cart(count,2,i,j); + + vertex_recons_weights(1,count,i,j) = cartx - spherecentroid(1,i,j) + vertex_recons_weights(2,count,i,j) = carty - spherecentroid(2,i,j) + + vertex_recons_weights(3,count,i,j) = (spherecentroid(1,i,j)**2 - & + spherecentroid(3,i,j)) + & + (cartx - spherecentroid(1,i,j))**2 + vertex_recons_weights(4,count,i,j) = (spherecentroid(2,i,j)**2 - & + spherecentroid(4,i,j)) + & + (carty - spherecentroid(2,i,j))**2 + + vertex_recons_weights(5,count,i,j) = (cartx - spherecentroid(1,i,j))* & + (carty - spherecentroid(2,i,j))+ & + (spherecentroid(1,i,j) * & + spherecentroid(2,i,j) - & + spherecentroid(5,i,j)) + end do + end do + end do + + do j= 1-nhe,nc+nhe + do i=1-nhe,nc+nhe + recons_metrics(1,i,j) = spherecentroid(1,i,j)**2 -spherecentroid(3,i,j) + recons_metrics(2,i,j) = spherecentroid(2,i,j)**2 -spherecentroid(4,i,j) + recons_metrics(3,i,j) = spherecentroid(1,i,j)*spherecentroid(2,i,j)-& + spherecentroid(5,i,j) + + recons_metrics_integral(1,i,j) = & + 2.0_r8*spherecentroid(1,i,j)**2 -spherecentroid(3,i,j) + recons_metrics_integral(2,i,j) = & + 2.0_r8*spherecentroid(2,i,j)**2 -spherecentroid(4,i,j) + recons_metrics_integral(3,i,j) = & + 2.0_r8*spherecentroid(1,i,j)*spherecentroid(2,i,j)-& + spherecentroid(5,i,j) + end do + end do + + + + ! + ! pre-compute variables for reconstruction + ! + do j= 1-nhe,nc+nhe + do i=1-nhe,nc+nhe + ! + !*************** + !* dfdx * + !*************** + ! + coef = 1.0_r8/(12.0_r8 * dalpha) !finite difference coefficient + coef = coef /( 1.0_r8 + spherecentroid(1,i,j)**2) !stretching coefficient + + centroid_stretch(1,i,j) = coef + ! + !*************** + !* dfdy * + !*************** + ! + coef = 1.0_r8/(12.0_r8 * dbeta) !finite difference coefficient + coef = coef /( 1.0_r8 + spherecentroid(2,i,j)**2) !stretching coefficient + + centroid_stretch(2,i,j) = coef + + !***************** + !* d2fdx2 * + !***************** + ! + coef = 1.0_r8 / (12.0_r8 * dalpha**2) !finite difference coefficient + ! + ! stretching coefficient part 2 + ! recons(3,i,j) = (a * recons(1,i,j)+ recons(3,i,j))*b + ! + tmp = 0.5_r8/((1.0_r8 + spherecentroid(1,i,j)**2)**2) + + centroid_stretch(3,i,j) = coef*tmp + centroid_stretch(6,i,j) = -spherecentroid(1,i,j)/(1.0_r8 + spherecentroid(1,i,j)**2) + + ! + !***************** + !* d2fdy2 * + !***************** + ! + ! + coef = 1.0_r8 / (12.0_r8 * dbeta**2) !finite difference coefficient + ! + ! stretching coefficient part 2 + ! + ! recons(4,i,j) = (a * recons(1,i,j)+ recons(4,i,j))*b + ! + tmp =0.5_r8/((1.0_r8 + spherecentroid(2,i,j)**2)**2) + + centroid_stretch(4,i,j) = coef*tmp + centroid_stretch(7,i,j) = -spherecentroid(2,i,j)/(1.0_r8 + spherecentroid(2,i,j)**2) + ! + !***************** + !* d2fdxdy * + !***************** + ! + ! + coef = 1.0_r8 / (4.0_r8 * dalpha * dbeta) !finite difference coefficient + coef = coef / ((1.0_r8 + spherecentroid(1,i,j)**2) * & + (1.0_r8 + spherecentroid(2,i,j)**2)) !stretching coefficient + + centroid_stretch(5,i,j) = coef + enddo + enddo + case default + write(*,*) "irecons out of range",irecons + stop + end select + end subroutine compute_reconstruct_matrix + + + subroutine get_high_order_weights_over_areas(x,dx,num_seg,num_seg_max,num_area,weights,ngpc,gsweights, gspts,irecons) + implicit none + integer , intent(in) :: num_area, num_seg_max, irecons + REAL(KIND=r8), dimension(2,num_seg_max,num_area ), intent(inout) :: x, dx + integer , intent(in) :: ngpc + integer , dimension(num_area ), intent(in) :: num_seg + REAL(KIND=r8), dimension(irecons,num_area), intent(out) :: weights + + real (kind=r8), dimension(ngpc,num_seg_max ) :: xq,yq !quadrature points along line segments + real (kind=r8), dimension(ngpc,num_seg_max,irecons) :: F !potentials + real (kind=r8), dimension( irecons) :: weights_area + real (kind=r8), dimension(ngpc,num_seg_max) :: xq2, yrh, rho, tmp !intermediate variables for optimization + REAL(KIND=r8) , dimension(ngpc,num_seg_max) :: xq2ir, xq2i, rhoi !intermediate variables for optimization + + integer :: iseg,iarea,i,j,k + + real (kind=r8), dimension(ngpc) :: gsweights, gspts + + weights(1:irecons,1:num_area) = 0.0_r8 !may not be necessary dbgxxx + do iarea=1,num_area + do iseg=1,num_seg(iarea) + xq(:,iseg) = x(1,iseg,iarea)+dx(1,iseg,iarea)*gspts(:) + yq(:,iseg) = x(2,iseg,iarea)+dx(2,iseg,iarea)*gspts(:) + end do + ! + ! potentials (equation's 23-28 in CSLAM paper; Lauritzen et al., 2010): + ! + ! (Rory Kelly optimization) + ! + do j=1,num_seg(iarea) +!DIR$ SIMD + do i=1,ngpc + xq2(i,j) = xq(i,j)*xq(i,j) + xq2i(i,j) = 1.0_r8/(1.0_r8+xq2(i,j)) + xq2ir(i,j) = SQRT(xq2i(i,j)) + rho(i,j) = SQRT(1.0_r8+xq2(i,j)+yq(i,j)*yq(i,j)) + rhoi(i,j) = 1.0_r8/rho(i,j) + yrh(i,j) = yq(i,j)*rhoi(i,j) + tmp(i,j) = yq(i,j)*xq2ir(i,j) + F(i,j,1) = yrh(i,j)*xq2i(i,j) !F_00 !F_00 + F(i,j,2) = xq(i,j)*yrh(i,j)*xq2i(i,j) !F_10 !F_10 + F(i,j,3) = -1.0_r8*rhoi(i,j) !F_01 !F_01 + F(i,j,4) = xq2(i,j)*yrh(i,j)*xq2i(i,j) !F_20 !F_20 + F(i,j,6) = -xq(i,j)*rhoi(i,j) !F_11 !F_11 + enddo + ! + ! take F(i,j,5) out of loop above since it prevents vectorization + ! + do i=1,ngpc + F(i,j,5) = -yq(i,j)*rhoi(i,j)+log(tmp(i,j)+rho(i,j)*xq2ir(i,j)) !F_02 !F_02 + end do + enddo + weights_area = 0.0_r8 + do k=1,irecons + do iseg=1,num_seg(iarea) + weights_area(k) = weights_area(k) + sum(gsweights(:)*F(:,iseg,k))*0.5_r8*dx(1,iseg,iarea) + end do + end do + weights(1:irecons,iarea) = weights_area(1:irecons) + end do + end subroutine get_high_order_weights_over_areas + + + !******************************************************************************** + ! + ! Gauss-Legendre quadrature + ! + ! Tabulated values + ! + !******************************************************************************** + subroutine gauss_points(n,weights,points) + implicit none + integer, intent(in ) :: n + real (kind=r8), dimension(:), intent(out) :: weights, points !dimension(n) + + select case (n) + ! CASE(1) + ! abscissae(1) = 0.0_r8 + ! weights(1) = 2.0_r8 + case(2) + points(1) = -sqrt(1.0_r8/3.0_r8) + points(2) = sqrt(1.0_r8/3.0_r8) + weights(1) = 1.0_r8 + weights(2) = 1.0_r8 + case(3) + points(1) = -0.774596669241483377035853079956_r8 + points(2) = 0.0_r8 + points(3) = 0.774596669241483377035853079956_r8 + weights(1) = 0.555555555555555555555555555556_r8 + weights(2) = 0.888888888888888888888888888889_r8 + weights(3) = 0.555555555555555555555555555556_r8 + case(4) + points(1) = -0.861136311594052575223946488893_r8 + points(2) = -0.339981043584856264802665659103_r8 + points(3) = 0.339981043584856264802665659103_r8 + points(4) = 0.861136311594052575223946488893_r8 + weights(1) = 0.347854845137453857373063949222_r8 + weights(2) = 0.652145154862546142626936050778_r8 + weights(3) = 0.652145154862546142626936050778_r8 + weights(4) = 0.347854845137453857373063949222_r8 + case(5) + points(1) = -(1.0_r8/3.0_r8)*sqrt(5.0_r8+2.0_r8*sqrt(10.0_r8/7.0_r8)) + points(2) = -(1.0_r8/3.0_r8)*sqrt(5.0_r8-2.0_r8*sqrt(10.0_r8/7.0_r8)) + points(3) = 0.0_r8 + points(4) = (1.0_r8/3.0_r8)*sqrt(5.0_r8-2.0_r8*sqrt(10.0_r8/7.0_r8)) + points(5) = (1.0_r8/3.0_r8)*sqrt(5.0_r8+2.0_r8*sqrt(10.0_r8/7.0_r8)) + weights(1) = (322.0_r8-13.0_r8*sqrt(70.0_r8))/900.0_r8 + weights(2) = (322.0_r8+13.0_r8*sqrt(70.0_r8))/900.0_r8 + weights(3) = 128.0_r8/225.0_r8 + weights(4) = (322.0_r8+13.0_r8*sqrt(70.0_r8))/900.0_r8 + weights(5) = (322.0_r8-13.0_r8*sqrt(70.0_r8))/900.0_r8 + case default + write(*,*) 'n out of range in glwp of module gll. n=',n + write(*,*) '00) then + + ! + ! cshift (permute) value needed to be applied to vertex number so that they match orientation + ! of the interior of the panel + ! + ! + ib = cubeboundary + if (faceno==2) then + if (ib==north.or.ib==nwest.or.ib==neast) flux_orient(2,1-nhc:nc+nhc,nc+1 :nc+nhc) = 1 + if (ib==south.or.ib==swest.or.ib==seast) flux_orient(2,1-nhc:nc+nhc,1-nhc:0 ) = 3 + end if + if (faceno==3) then + if (ib==north.or.ib==nwest.or.ib==neast) flux_orient (2,1-nhc:nc+nhc,nc+1 :nc+nhc) = 2 + if (ib==south.or.ib==swest.or.ib==seast) flux_orient (2,1-nhc:nc+nhc,1-nhc:0 ) = 2 + end if + if (faceno==4) then + if (ib==north.or.ib==nwest.or.ib==neast) flux_orient (2,1-nhc:nc+nhc,nc+1 :nc+nhc) = 3 + if (ib==south.or.ib==swest.or.ib==seast) flux_orient (2,1-nhc:nc+nhc,1-nhc:0 ) = 1 + end if + if (faceno==5) then + if (ib==south.or.ib==swest.or.ib==seast) flux_orient (2,1-nhc:nc+nhc,1-nhc:0 ) = 2 + if (ib== west.or.ib==swest.or.ib==nwest) flux_orient (2,1-nhc:0 ,1-nhc:nc+nhc) = 3 + if (ib== east.or.ib==seast.or.ib==neast) flux_orient (2, nc+1:nc+nhc,1-nhc:nc+nhc) = 1 + end if + + if (faceno==6) then + if (ib==north.or.ib==nwest.or.ib==neast ) flux_orient (2,1-nhc:nc+nhc,nc+1 :nc+nhc) = 2 + if (ib==west .or.ib==swest.or.ib==nwest ) flux_orient (2,1-nhc:0 ,1-nhc:nc+nhc) = 1 + if (ib==east .or.ib==seast.or.ib==neast ) flux_orient (2,nc+1:nc+nhc,1-nhc:nc+nhc) = 3 + end if + ! + ! non-existent cells in physical space + ! + if (cubeboundary==nwest) then + flux_orient(2,1-nhc:0 ,nc+1 :nc+nhc) = 0 + ifct ( 1-nhc:0 ,nc+1 :nc+nhc) = 0 + else if (cubeboundary==swest) then + flux_orient (2,1-nhc:0 ,1-nhc:0 ) = 0 + ifct ( 1-nhc:0 ,1-nhc:0 ) = 0 + else if (cubeboundary==neast) then + flux_orient (2,nc+1 :nc+nhc,nc+1 :nc+nhc) = 0 + ifct ( nc+1 :nc+nhc,nc+1 :nc+nhc) = 0 + else if (cubeboundary==seast) then + flux_orient (2,nc+1 :nc+nhc,1-nhc:0 ) = 0 + ifct ( nc+1 :nc+nhc,1-nhc:0 ) = 0 + end if + end if + + end subroutine init_flux_orient + +! +! +! + +! ----------------------------------------------------------------------------------! +!SUBROUTINE CREATE_INTERPOLATIION_POINTS----------------------------------CE-for FVM! +! AUTHOR: CHRISTOPH ERATH, 17.October 2011 ! +! DESCRIPTION: for elements, which share a cube edge, we have to do some ! +! interpolation on different cubic faces, also in the halo region: ! +! because we also need the reconstruction coefficients in the halo zone, ! +! which is basically calculated twice, on the original cell of an element ! +! on face A and on a cell in the halo region of an element of face B ! +! The crux is, that the interpolation has to be the same to ensure ! +! conservation of the scheme ! +! SYMMETRY of the CUBE is used for calucaltion the interpolation_point ! +! ! +! CALLS: interpolation_point ! +! INPUT/OUTPUT: ! +! elem ... element structure from HOMME ! +! fvm ... structure ! +!-----------------------------------------------------------------------------------! + subroutine create_interpolation_points(elem,& + nc,nhc,nhr,ns,nh,cubeboundary,& + dalpha,dbeta,ibase,halo_interp_weight) + use element_mod , only: element_t + use coordinate_systems_mod, only: cartesian2D_t + use control_mod , only: north, south, east, west, neast, nwest, seast, swest + use cube_mod , only: cube_xstart, cube_xend, cube_ystart, cube_yend + + implicit none + type (element_t), intent(in) :: elem + + integer , intent(in) :: nc,nhc,nhr,ns,nh,cubeboundary + integer , intent(out) :: ibase(1-nh:nc+nh,1:nhr,2) + real (kind=r8), intent(out) :: halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,2) + ! + ! pre-compute weight/index matrices + ! + integer :: imin,imax,jmin,jmax,iinterp + real (kind=r8), intent(in) :: dalpha,dbeta + + real (kind=r8), dimension(1-nhc:nc+nhc) :: gnomxstart, gnomxend, gnomystart, gnomyend + integer :: i, halo, ida, ide, iref1 + type (cartesian2D_t) :: tmpgnom + real (kind=r8) :: interp(1-nh:nc+nh,1:nhr,2) + integer ::ibaseref + integer :: ibase_tmp(1-nh:nc+nh,1:nhr,2) + + ibase = 99999 !dbg + halo_interp_weight(:,:,:,:) = 9.99E9_r8 !dbg + + ! element is not on a corner, but shares a cube edge (call of subroutine) + if(cubeboundary <= 4) then + gnomxstart(1-nhc)=elem%corners(1)%x-(nhc-0.5_r8)*dalpha + gnomystart(1-nhc)=elem%corners(1)%y-(nhc-0.5_r8)*dbeta + do i=2-nhc,nc+nhc + gnomxstart(i)=gnomxstart(i-1)+dalpha + gnomystart(i)=gnomystart(i-1)+dbeta + end do + ida=1-nhc !lower bound + ide=nc+nhc !upper bound + select case (cubeboundary) + !INTERIOR element + case(0) + ! nothing to do! + !CASE WEST + case(west) + do halo=1,nhr +! iref1=ida + tmpgnom%x=cube_xstart-(halo-0.5_r8)*dalpha + do i=halo-nh,nc+nh-(halo-1) !see fvm_reconstruction to understand these boundaries + iref1=ida + tmpgnom%y=gnomystart(i) + call interpolation_point(nc,ns,tmpgnom,gnomystart,1,4,1,interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + + !CASE EAST + case(east) + ! east zone + do halo=1,nhr + iref1=ida + tmpgnom%x=cube_xend+(halo-0.5_r8)*dalpha + do i=halo-nh,nc+nh-(halo-1) + tmpgnom%y=gnomystart(i) + call interpolation_point(nc,ns,tmpgnom,gnomystart,1,2,1,interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + + !CASE NORTH + case(north) + ! north zone + do halo=1,nhr + tmpgnom%y=cube_yend+(halo-0.5_r8)*dbeta + iref1=ida + do i=halo-nh,nc+nh-(halo-1) + tmpgnom%x=gnomxstart(i) + ! + ! dbg - change to interp(i,halo,1) instead of interp(i,halo,2) + ! so that I can get rid of iinterp = 1 in fvm_reconstruction_mod + ! + call interpolation_point(nc,ns,tmpgnom,gnomxstart,1,6,0,interp(i,halo,2),& + ida,ide,iref1,ibase_tmp(i,halo,2)) + end do + end do + !CASE SOUTH + case(south) + !south zone + do halo=1,nhr + iref1=ida + tmpgnom%y=cube_ystart-(halo-0.5_r8)*dbeta + do i=halo-nh,nc+nh-(halo-1) + tmpgnom%x=gnomxstart(i) + call interpolation_point(nc,ns,tmpgnom,gnomxstart,1,5,0,interp(i,halo,2),& + ida,ide,iref1,ibase_tmp(i,halo,2)) + end do + end do + + ! + !THIS CASE SHOULD NOT HAPPEN! + case default + print *,'Fatal Error in first select statement:' + call endrun('fvm_reconstruction_mod.F90 subroutine fillhalo_cubic!' ) + end select + !CORNER TREATMENT + else + gnomxstart(1-nhc)=cube_xstart-(nhc-0.5_r8)*dalpha + gnomxend(nc+nhc)=cube_xend+(nhc-0.5_r8)*dalpha + gnomystart(1-nhc)=cube_ystart-(nhc-0.5_r8)*dbeta + gnomyend(nc+nhc)=cube_yend+(nhc-0.5_r8)*dbeta + do i=2-nhc,nc+nhc + gnomxstart(i)=gnomxstart(i-1)+dalpha + gnomxend(nc+1-i)=gnomxend(nc+2-i)-dalpha + gnomystart(i)=gnomystart(i-1)+dbeta + gnomyend(nc+1-i)=gnomyend(nc+2-i)-dbeta + end do + + select case (cubeboundary) + !CASE SOUTH WEST + case(swest) + ! west zone + do halo=1,nhr + tmpgnom%x=cube_xstart-(halo-0.5_r8)*dalpha + ida=1 + ide=nc+nc + iref1=ida + do i=0,nc+nh-(halo-1) + tmpgnom%y=gnomystart(i) + call interpolation_point(nc,ns,tmpgnom,gnomystart,1,4,1,interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + !CASE SOUTH EAST + case(seast) + ! east zone + do halo=1,nhr + tmpgnom%x=cube_xend+(halo-0.5_r8)*dalpha + ida=1 + ide=nc+nc + iref1=ida + do i=0,nc+nh-(halo-1) + tmpgnom%y=gnomystart(i) + call interpolation_point(nc,ns,tmpgnom,gnomystart,1,2,1, interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + !CASE NORTH EAST + case(neast) + ! east zone + do halo=1,nhr + tmpgnom%x=cube_xend+(halo-0.5_r8)*dalpha + ida=1-nc + ide=nc + iref1=ida + do i=halo-nh,nc+1 + tmpgnom%y=gnomyend(i) + call interpolation_point(nc,ns,tmpgnom,gnomyend,1,2,1, interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + !CASE NORTH WEST + case(nwest) + ! west zone + do halo=1,2 + tmpgnom%x=cube_xstart-(halo-0.5_r8)*dalpha + ida=1-nc + ide=nc + iref1=ida + do i=halo-nh,nc+1 + tmpgnom%y=gnomyend(i) + call interpolation_point(nc,ns,tmpgnom,gnomyend,1,4,1, interp(i,halo,1),& + ida,ide,iref1,ibase_tmp(i,halo,1)) + end do + end do + !THIS CASE SHOULD NOT HAPPEN! + case default + print *,'Fatal Error in second select statement:' + call endrun('fvm_reconstruction_mod.F90 subroutine create_interpolationpoint!') + end select + endif + + !************************** + ! + ! compute haloe weights and indices + ! + if (cubeboundary>0) then + if (cubeboundary<5) then + ! + ! element is located at a panel side but is not a corner element + ! (west,east,south,north) = (1,2,3,4) + ! + if (cubeboundary==west .or.cubeboundary==east ) then + iinterp = 1 + end if + if (cubeboundary==north.or.cubeboundary==south) iinterp = 2 + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref=ibase_tmp(i,halo,iinterp) + ibase(i,halo,1) = ibaseref + call get_equispace_weights(dbeta, interp(i,halo,iinterp),& + halo_interp_weight(:,i,halo,1),ns) + end do + end do + else + ! + ! element is located at a cube corner + ! (swest,seast,nwest,neast)=(5,6,7,8) + ! + do halo=1,nhr + if (cubeboundary==swest .or.cubeboundary==seast) then + imin = 0 ; imax = nc+nh-(halo-1); + jmin = halo-nh; jmax = nc+1; + else + jmin = 0 ; jmax = nc+nh-(halo-1); + imin = halo-nh; imax = nc+1; + end if + do i=imin,imax + ibaseref=ibase_tmp(i,halo,1) + ibase(i,halo,1) = ibaseref + call get_equispace_weights(dbeta, interp(i,halo,1),halo_interp_weight(:,i,halo,1),ns) + end do + ! + ! reverse weights/indices for fotherpanel (see details on reconstruct_matrix) + ! + halo_interp_weight(1:ns,jmin:jmax,halo,2) = halo_interp_weight(ns:1:-1,imax:imin:-1,halo,1) + ibase (jmin:jmax,halo ,2) = nc+1-(ns-1)-ibase(imax:imin:-1,halo ,1) + end do + end if + + end if + + +end subroutine create_interpolation_points + + + + +!END SUBROUTINE CREATE_INTERPOLATION_POINTS-------------------------------CE-for FVM! + + + +! ----------------------------------------------------------------------------------! +!SUBROUTINE INTERPOLATION_POINT-------------------------------------------CE-for FVM! +! AUTHOR: CHRISTOPH ERATH, 14.November 2011 ! +! DESCRIPTION: calculates the interpolation point on from face 1 in face 2 in ! +! alpha/beta coordinates, only 1D ! +! ! +! CALLS: cubedsphere2cart, cart2cubedsphere ! +! INPUT: gnom... 1D coordinates ! +! gnom1d... 1d coordinates ! +! face1... orginal face ! +! face2... target face (where the interpolation has to be done) ! +! xy ... 0 for alpha coordinate, any other for beta ! +! except.which type, interior, left edge (-1), right edge (1) ! +! point... interpolation point ! +! ida ... begin of interpval ! +! ide ... end of interpval ! + + +! INPUT/OUTPUT/RETURN: ! +! iref ... where we start the search, is also an OUTPUT, so we know for the ! +! next point where to start ! +!-----------------------------------------------------------------------------------! + ! +! DESCRIPTION: searchs where the interpolation point has to be (iref), two values ! +! of interpval on the left and on the right, except if we are out of range ! +! which is indicated through ia and ie, respectively ! +! It is a 1D interpolation, use alpha/beta coordinates!!! ! +! ! +! CALLS: cubic_equispace_interp ! +! INPUT: iref ... where we start the search, is also an OUTPUT, so we know for the ! +! next point where to start ! +! ibaseref ... startindex of the four tracer value for the reconstruction ! +! point ... provides the difference of the interpolation point to use it ! +! directly in CUBIC_EQUISPACE_INTERP ! +!-----------------------------------------------------------------------------------! +function get_gno_point(gnom,face1,face2,xy) result(point) + use coordinate_systems_mod, only : cubedsphere2cart, cart2cubedsphere, & + cartesian2D_t,cartesian3D_t + implicit none + type (cartesian2D_t), intent(in) :: gnom + integer, intent(in) :: face1, face2, xy + real (kind=r8) :: point + + type(cartesian3D_t) :: tmpcart3d + type (cartesian2D_t) :: tmpgnom + + tmpcart3d=cubedsphere2cart(gnom,face1) + tmpgnom=cart2cubedsphere(tmpcart3d,face2) + if(xy==0) then + point=tmpgnom%x + else + point=tmpgnom%y + end if +end function get_gno_point + +subroutine interpolation_point(nc,ns,gnom,gnom1d,face1,face2,xy,point,ida,ide,iref,ibaseref) + use coordinate_systems_mod, only : cartesian2D_t + implicit none + integer , intent(in) :: nc,ns + type (cartesian2D_t), intent(in) :: gnom + real (kind=r8), dimension(1-nc:), intent(in) :: gnom1d !dimension(1-nhc:nc+nhc) + integer, intent(in) :: face1, face2, xy + integer,intent(in) :: ida, ide + integer,intent(inout) :: iref,ibaseref + real (kind=r8), intent(inout) :: point + +! type(cartesian3D_t) :: tmpcart3d +! type (cartesian2D_t) :: tmpgnom + + point = get_gno_point(gnom,face1,face2,xy) + +! tmpcart3d=cubedsphere2cart(gnom,face1) +! tmpgnom=cart2cubedsphere(tmpcart3d,face2) +! if(xy==0) then +! point=tmpgnom%x +! else +! point=tmpgnom%y +! end if + ! + ! in which cell is interpolation point located? gno(iref) is location of point to the right that is closest + ! + ! |----------|---------|------x---|----------|------|------ + ! gno(iref-1) gno(iref) + ! + iref=ida + do while (point>gnom1d(iref)) + iref = iref + 1 + if (iref>ide+1) then + call endrun("error in search - ABORT; probably invalid ns-nc combination") + end if + if (iref>ide) then + write(*,*) "extrapolation in interpolation_point",iref,ide + iref=ide + exit + endif + end do + ! + ! this routine works for ns=1 and ns even + ! + if (MOD(ns,2)==1) then + iref = max(iref,ida+1)!make sure gnom1d does not go out of bounds for extrapolation + if (gnom1d(iref)-point>point-gnom1d(iref-1)) iref=iref-1 + iref=iref-((ns-1)/2) + ibaseref = min(max(iref,ida),ide-(ns-1))!extrapolation + point=point-gnom1d(ibaseref) + else if (MOD(ns, 2)==0) then + ! + ! this code is only coded for ns even + ! + ! ibaseref is the left most index used for 1D interpolation + ! (hence iref = iref-ns/2 except near corners) + ! + iref = iref-ns/2 + ibaseref = min(max(iref,ida),ide-(ns-1)) + point=point-gnom1d(ibaseref) + end if +end subroutine interpolation_point +!END SUBROUTINE INTERPOLATION_POINT---------------------------------------CE-for FVM! +! ---------------------------------------------------------------------! +! ! +! Precompute weights for Lagrange interpolation ! +! for equi-distant source grid values ! +! ! +!----------------------------------------------------------------------! + +subroutine get_equispace_weights(dx, x, w,ns) + ! + ! Coordinate system for Lagrange interpolation: + ! + ! |------|------|------|------| + ! 0 dx 2*dx 3*dx ns*dx + ! + implicit none + real (kind=r8),intent(in) :: dx ! spacing of points, alpha/beta + real (kind=r8),intent(in) :: x ! X coordinate where interpolation is to be applied + real (kind=r8),dimension(:),intent(out) :: w ! dimension(ns) + integer ,intent(in) :: ns + ! + integer :: j,k + ! + ! use Lagrange interpolation formulae, e.g.,: + ! + ! http://mathworld.wolfram.com/LagrangeInterpolatingPolynomial.html + ! + w = 1.0_r8 + if (ns.ne.1) then + do j=1,ns + do k=1,ns + if (k.ne.j) then + w(j)=w(j)*(x-dble(k-1)*dx)/(dble(j-1)*dx-dble(k-1)*dx) + end if + end do + end do + end if +end subroutine get_equispace_weights + +end module fvm_analytic_mod diff --git a/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 new file mode 100644 index 0000000000..433044bc83 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 @@ -0,0 +1,1947 @@ +module fvm_consistent_se_cslam + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: nc, nhe, nlev, ntrac, np, nhr, nhc, ngpc, ns, nht, lbc,ubc + use dimensions_mod, only: irecons_tracer + use dimensions_mod, only: kmin_jet,kmax_jet + use cam_abortutils, only: endrun + + use time_mod, only: timelevel_t + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use hybrid_mod, only: hybrid_t + use perf_mod, only: t_startf, t_stopf + + implicit none + private + save + + real (kind=r8), dimension(ngpc), private :: gsweights, gspts + real (kind=r8),parameter , private :: eps=1.0e-14_r8 + public :: run_consistent_se_cslam +contains + ! + !************************************************************************************** + ! + ! Consistent CSLAM-SE algorithm documented in + ! + ! Lauritzen et al. (2017): CAM-SE-CSLAM: Consistent finite-volume transport with + ! spectral-element dynamics. Mon. Wea. Rev. + ! + ! + !************************************************************************************** + ! + subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord) + ! --------------------------------------------------------------------------------- + use fvm_control_volume_mod, only: n0_fvm, np1_fvm + use fvm_mod , only: fill_halo_fvm, ghostBufQnhc, ghostBufQ1, ghostBufFlux + use fvm_reconstruction_mod, only: reconstruction + use fvm_analytic_mod , only: gauss_points + use derivative_mod , only: subcell_integration + use edge_mod , only: ghostpack, ghostunpack + use bndry_mod , only: ghost_exchange + use hybvcoord_mod , only: hvcoord_t + + implicit none + type (element_t) , intent(inout) :: elem(:) + type (fvm_struct) , intent(inout) :: fvm(:) + type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) + type (TimeLevel_t) , intent(in) :: tl ! time level struct + type (hvcoord_t) , intent(in) :: hvcoord + integer , intent(in) :: nets ! starting thread element number (private) + integer , intent(in) :: nete ! ending thread element number (private) + real (kind=r8) , intent(in) :: dt_fvm + + + !high-order air density reconstruction + real (kind=r8) :: ctracer(irecons_tracer,1-nhe:nc+nhe,1-nhe:nc+nhe,ntrac) + real (kind=r8) :: inv_dp_area(nc,nc) + real (kind=r8) :: dp_se(nc,nc) + real (kind=r8) :: p_top + + logical :: llimiter(ntrac) + integer :: i,j,k,ie,itr,ntmp + + llimiter = .true. + + call gauss_points(ngpc,gsweights,gspts) !set gauss points/weights + gspts = 0.5_r8*(gspts+1.0_r8) !shift location so in [0:1] instead of [-1:1] + + call t_startf('fvm:before_Qnhc') + do ie=nets,nete + do k=1,nlev + elem(ie)%sub_elem_mass_flux(:,:,:,k) = dt_fvm*elem(ie)%sub_elem_mass_flux(:,:,:,k)*fvm(ie)%dp_ref_inverse(k) + fvm(ie)%dp_fvm(1:nc,1:nc,k,n0_fvm) = fvm(ie)%dp_fvm (1:nc,1:nc,k,n0_fvm)*fvm(ie)%dp_ref_inverse(k) + end do + call ghostpack(ghostbufQnhc,fvm(ie)%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,1:nlev,n0_fvm),nlev, 0,ie) + call ghostpack(ghostbufQnhc,fvm(ie)%c(1-nhc:nc+nhc,1-nhc:nc+nhc,1:nlev,1:ntrac,n0_fvm) ,nlev*ntrac,nlev,ie) + end do + call t_stopf('fvm:before_Qnhc') + + call t_startf('fvm:ghost_exchange:Qnhc') + call ghost_exchange(hybrid,ghostbufQnhc) + call t_stopf('fvm:ghost_exchange:Qnhc') + + call t_startf('fvm:orthogonal_swept_areas') + do ie=nets,nete + fvm(ie)%se_flux (1:nc,1:nc,:,:) = elem(ie)%sub_elem_mass_flux(:,:,:,:) + call ghostunpack(ghostbufQnhc, fvm(ie)%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,1:nlev,n0_fvm),nlev ,0,ie) + call ghostunpack(ghostbufQnhc, fvm(ie)%c(1-nhc:nc+nhc,1-nhc:nc+nhc,1:nlev,1:ntrac,n0_fvm), nlev*ntrac,nlev,ie) + call compute_displacements_for_swept_areas (fvm(ie),fvm(ie)%dp_fvm(1-nhe:nc+nhe,1-nhe:nc+nhe,:,n0_fvm),1) + call ghostpack(ghostBufFlux, fvm(ie)%se_flux(:,:,:,:),4*nlev,0,ie) + end do + call ghost_exchange(hybrid,ghostBufFlux) + do ie=nets,nete + call ghostunpack(ghostBufFlux, fvm(ie)%se_flux(:,:,:,:),4*nlev,0,ie) + call ghost_flux_unpack(fvm(ie)) + enddo + + call t_stopf('fvm:orthogonal_swept_areas') + + do ie=nets,nete + fvm(ie)%c(:,:,:,:,np1_fvm) = 0.0_r8!to avoid problems when uninitialized variables are set to NaN + fvm(ie)%dp_fvm(:,:,:,np1_fvm) = 0.0_r8!to avoid problems when uninitialized variables are set to NaN + do k=1,nlev + call t_startf('fvm:tracers_reconstruct') + call reconstruction(fvm(ie)%c(1-nhc:nc+nhc,1-nhc:nc+nhc,k,1:ntrac,n0_fvm),& + ctracer(:,:,:,:),irecons_tracer,llimiter,ntrac,& + nc,nhe,nhr,nhc,nht,ns,nhr+(nhe-1),& + fvm(ie)%jx_min,fvm(ie)%jx_max,fvm(ie)%jy_min,fvm(ie)%jy_max,& + fvm(ie)%cubeboundary,fvm(ie)%halo_interp_weight,fvm(ie)%ibase,& + fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe),& + fvm(ie)%recons_metrics,fvm(ie)%recons_metrics_integral,& + fvm(ie)%rot_matrix,fvm(ie)%centroid_stretch,& + fvm(ie)%vertex_recons_weights,fvm(ie)%vtx_cart& + ) + call t_stopf('fvm:tracers_reconstruct') + call t_startf('fvm:swept_flux') + call swept_flux(elem(ie),fvm(ie),k,ctracer) + call t_stopf('fvm:swept_flux') + end do + end do + ! + !*************************************** + ! + ! Large Courant number increment + ! + !*************************************** + ! + ! In the jet region the effective Courant number + ! in the cslam trajectory algorithm can be > 1 + ! (by up to 20%) + ! + ! We limit the trajectories to < 1 but in this step + ! we do a piecewise constant update for the + ! amount of mass for which the Courant number is >1 + ! + ! + call t_startf('fvm:fill_halo_fvm:large_Courant') + call fill_halo_fvm(ghostbufQ1,elem,fvm,hybrid,nets,nete,np1_fvm,1,kmin_jet,kmax_jet) + call t_stopf('fvm:fill_halo_fvm:large_Courant') + call t_startf('fvm:large_Courant_number_increment') + do ie=nets,nete + do k=kmin_jet,kmax_jet !1,nlev + call large_courant_number_increment(fvm(ie),k) + end do + end do + call t_stopf('fvm:large_Courant_number_increment') + + call t_startf('fvm:end_of_reconstruct_subroutine') + do ie=nets,nete + ! + ! convert to mixing ratio + ! + do k=1,nlev + ! + ! dp from SE integrated over fvm control volumes are round-off equal to dp_fvm + ! to avoid accumulation of round-off error overwrite dp_fvm with dp_se + ! + call subcell_integration(elem(ie)%state%dp3d(:,:,k,tl%np1), np, nc, elem(ie)%metdet,dp_se) + do j=1,nc + do i=1,nc + dp_se(i,j) = dp_se(i,j)*fvm(ie)%dp_ref_inverse(k) + !overwrite dp_fvm here to preserve tracer mass to round-off +! fvm(ie)%dp_fvm(i,j,k,np1_fvm) = dp_se(i,j) + inv_dp_area(i,j) = 1.0_r8/fvm(ie)%dp_fvm(i,j,k,np1_fvm) + end do + end do + + do itr=1,ntrac + do j=1,nc + do i=1,nc + ! convert to mixing ratio + fvm(ie)%c(i,j,k,itr,np1_fvm) = fvm(ie)%c(i,j,k,itr,np1_fvm)*inv_dp_area(i,j) + end do + end do + end do + ! + ! convert to dp and scale back dp + ! + ! overwrite dp_fvm here to preserve mixing ratio (not mass) to round-off level + fvm(ie)%dp_fvm(1:nc,1:nc,k,np1_fvm) = dp_se(1:nc,1:nc) + fvm(ie)%dp_fvm(1:nc,1:nc,k,np1_fvm) = fvm(ie)%dp_fvm(1:nc,1:nc,k,np1_fvm)*fvm(ie)%dp_ref(k)*fvm(ie)%inv_area_sphere + end do + ! + ! surface pressure implied by fvm + ! + p_top = hvcoord%hyai(1)*hvcoord%ps0 + do j=1,nc + do i=1,nc + fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:,np1_fvm)) + p_top + end do + end do + end do + call t_stopf('fvm:end_of_reconstruct_subroutine') + ! + ! advance fvm time-levels + ! + ntmp = np1_fvm + np1_fvm = n0_fvm + n0_fvm = ntmp + + end subroutine run_consistent_se_cslam + + subroutine swept_flux(elem,fvm,ilev,ctracer) + use fvm_control_volume_mod, only: n0_fvm, np1_fvm + use fvm_analytic_mod , only: get_high_order_weights_over_areas + use dimensions_mod, only : kmin_jet,kmax_jet + implicit none + type (element_t) , intent(in) :: elem + type (fvm_struct), intent(inout):: fvm + integer , intent(in) :: ilev + real (kind=r8), intent(inout) :: ctracer(irecons_tracer,1-nhe:nc+nhe,1-nhe:nc+nhe,ntrac) + + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides) :: base_vtx + integer , dimension(2,num_area, imin:imax,imin:imax,num_sides) :: idx + real (kind=r8) , dimension(imin:imax,imin:imax,num_sides) :: mass_flux_se + real (kind=r8) , dimension(irecons_tracer,num_area) :: weights + real (kind=r8) :: gamma + integer :: i,j,iside,iarea,iw + + integer, parameter :: num_seg_max=5 + REAL(KIND=r8), dimension(2,num_seg_max,num_area) :: x, dx, x_static, dx_static + integer , dimension(num_area) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) :: x_start, dgam_vec + REAL(KIND=r8) :: gamma_max, displ_first_guess + + REAL(KIND=r8) :: flux,flux_tracer(ntrac) + + REAL(KIND=r8), dimension(num_area) :: dp_area + + logical :: tl1,tl2,tr1,tr2 + + integer, dimension(4), parameter :: imin_side = (/1 ,0 ,1 ,1 /) + integer, dimension(4), parameter :: imax_side = (/nc ,nc ,nc ,nc+1/) + integer, dimension(4), parameter :: jmin_side = (/1 ,1 ,0 ,1 /) + integer, dimension(4), parameter :: jmax_side = (/nc+1,nc ,nc ,nc /) + + integer :: iseg, iseg_tmp,flowcase,ii,jj,itr + + call define_swept_areas(fvm,ilev,displ,base_vec,base_vtx,idx) + + mass_flux_se(1:nc,1:nc,1:4) = -elem%sub_elem_mass_flux(1:nc,1:nc,1:4,ilev) + mass_flux_se(0 ,1:nc,2 ) = elem%sub_elem_mass_flux(1 ,1:nc,4 ,ilev) + mass_flux_se(nc+1,1:nc,4 ) = elem%sub_elem_mass_flux(nc ,1:nc,2 ,ilev) + mass_flux_se(1:nc,0 ,3 ) = elem%sub_elem_mass_flux(1:nc,1 ,1 ,ilev) + mass_flux_se(1:nc,nc+1,1 ) = elem%sub_elem_mass_flux(1:nc,nc ,3 ,ilev) + ! + ! prepare for air/tracer update + ! + fvm%dp_fvm(1:nc,1:nc,ilev,np1_fvm) = fvm%dp_fvm(1:nc,1:nc,ilev,n0_fvm)*fvm%area_sphere + do itr=1,ntrac + fvm%c(1:nc,1:nc,ilev,itr,np1_fvm) = fvm%c(1:nc,1:nc,ilev,itr,n0_fvm)*fvm%dp_fvm(1:nc,1:nc,ilev,np1_fvm) + do iw=1,irecons_tracer + ctracer(iw,1-nhe:nc+nhe,1-nhe:nc+nhe,itr)=ctracer(iw,1-nhe:nc+nhe,1-nhe:nc+nhe,itr)*& + fvm%dp_fvm(1-nhe:nc+nhe,1-nhe:nc+nhe,ilev,n0_fvm) + end do + end do + + do iside=1,4 + do j=jmin_side(iside),jmax_side(iside) + do i=imin_side(iside),imax_side(iside) + !DO NOT USE MASS_FLUX_SE AS THRESHOLD - THRESHOLD CONDITION MUST BE CONSISTENT WITH + !THE ONE USED IN DEFINE_SWEPT_AREAS +! if (mass_flux_se(i,j,iside)>eps) then + if (fvm%se_flux(i,j,iside,ilev)>eps) then + ! + ! || || + ! tl1 || || tr1 + ! || || + ! ============================= + ! || || + ! tl2 || || tr2 + ! || || + ! + tl1 = displ(3,i,j,iside)<0.0_r8.and.displ(6,i,j,iside).ge.0.0_r8 !departure point in tl1 quadrant + tl2 = displ(6,i,j,iside)<0.0_r8.and.displ(7,i,j,iside) >0.0_r8 !departure point in tl2 quadrant + tr1 = displ(2,i,j,iside)<0.0_r8.and.displ(4,i,j,iside).ge.0.0_r8 !departure point in tr1 quadrant + tr2 = displ(4,i,j,iside)<0.0_r8.and.displ(5,i,j,iside) >0.0_r8 !departure point in tr2 quadrant + + ! + ! pathological cases + ! + ! | || || || || + ! | ||-----------|| ||-----------|| + ! | || || || || + ! ================================ ================================= + ! || || | || || + ! ---------|| || ------|--|| || + ! || || | || || + ! + ! tl1=tl1.or.tl2 + ! tr1=tr1.or.tr2 + ! tl1=displ(3,i,j,iside)<0.0_r8.and..not.(tl1.and.tl2) + ! tr1=displ(2,i,j,iside)<0.0_r8.and..not.(tr1.and.tr2) + + num_seg=-1; num_seg_static=-1 !initialization + if (.not.tl1.and..not.tl2.and..not.tr1.and..not.tr2) then + flowcase=0 + ! + ! || || || || || || + ! || * * || || *----------* |*----------* || + ! || / \ || || / || || \ || + ! ||/ \|| ||/ || || \|| + ! ============================= ============================= ============================= + ! || || || || || || + ! + ! + call define_area3_center (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec,fvm%se_flux(i,j,iside,ilev),displ_first_guess) + + gamma=1.0_r8!fvm%se_flux(i,j,iside,ilev) + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else + if (tl1.and.tr1) then + flowcase=1 + ! + ! + ! tl1 || || tr1 || || || || + ! *--||-------------||--* *--||-------------|| ||-------------||--* + ! \ || || / \ || ||\ /|| || / + ! \|| ||/ \|| || \ / || ||/ + ! ============================= =========================*=== ==*========================== + ! || || || || || || + ! + call define_area2 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,& + num_seg, num_seg_static,x_start, dgam_vec,displ_first_guess) + call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,& + num_seg, num_seg_static,x_start, dgam_vec) + call define_area4 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,& + num_seg, num_seg_static,x_start, dgam_vec) + gamma=1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tl1.and..not.tr1.and..not.tr2) then + flowcase=2 + ! + ! || || || || || || + ! *--||----------* || /||----------* || *--||-------------* + ! \ || \ || / || \ || \ || || + ! \|| \|| / || \|| \|| || + ! ============================= ==*========================== ============================= + ! || || || || || || + ! + call define_area2 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,& + x_start, dgam_vec,displ_first_guess) + call define_area3_left(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,& + x_start, dgam_vec) + gamma=1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tr1.and..not.tl1.and..not.tl2) then !displ(3).ge.0.0_r8) then + flowcase=3 + ! + ! || *----------||--* || *----------||\ *-------------||--* + ! || / || / || / || \ || || / + ! ||/ ||/ ||/ || \ || ||/ + ! ============================= ==========================*== ============================= + ! || || || || || || + ! || || || || || || + ! || || || || || || + ! + call define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static, x_start, dgam_vec) + call define_area4 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static, x_start, dgam_vec,displ_first_guess) + gamma=1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tl2.and..not.tr1.and..not.tr2) then !displ(2).ge.0.0_r8) then + flowcase=4 + ! + ! ||----------* || ||-------------* + ! /|| \ || /|| || + ! / || \|| / || || + ! ===/========================= ===/========================= + ! | /|| || | /|| || + ! |/ || || |/ || || + ! * || || * || || + ! + call define_area1_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area3_left (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,& + x_start, dgam_vec,displ_first_guess) + gamma = 1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tr2.and..not.tl1.and..not.tl2) then !displ(3).ge.0.0_r8) then + flowcase=5 + ! case(5) + ! + ! + ! || *-----2----|| + ! || /1 3||\ + ! ||/ 4 || \ + ! ============================= + ! || ||\ | + ! || || \| + ! || || * + ! + call define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area4_area5(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec,displ_first_guess) + gamma=1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tl2.and.tr1.and..not.tr2) then + flowcase=6 + ! case(6) + ! + ! + ! ||-------------||--* + ! /|| || / + ! / || ||/ + ! ===/========================= + ! | /|| || + ! |/ || || + ! * || || + ! + ! + call define_area1_area2 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area4 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec,displ_first_guess) + + gamma=1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tr2.and.tl1.and..not.tl2) then + flowcase=7 + ! case(7) + ! + ! + ! *--||-------------|| + ! \ || ||\ + ! \|| || \ + ! ============================= + ! || ||\ | + ! || || \| + ! || || * + ! + ! + call define_area2 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec,displ_first_guess) + call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area4_area5 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + gamma = 1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else if (tl2.and.tr2) then + flowcase=8 + ! case(8) + ! + ! + ! ||-------------|| + ! /|| ||\ + ! / || || \ + ! ============================= + ! | /|| ||\ | + ! |/ || || \| + ! * || || * + ! + ! + ! + ! + ! + call define_area1_area2 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec) + call define_area4_area5 (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,& + num_seg_static,x_start, dgam_vec,displ_first_guess) + gamma = 1.0_r8 + gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess + else + call endrun('ERROR - unknown flow case') + end if + end if + ! + ! iterate to get flux area + ! + call t_startf('fvm:swept_area:get_gamma') + do iarea=1,num_area + dp_area(iarea) = fvm%dp_fvm(idx(1,iarea,i,j,iside),idx(2,iarea,i,j,iside),ilev,n0_fvm) + end do + call get_flux_segments_area_iterate(x,x_static,dx_static,dx,x_start,dgam_vec,num_seg,num_seg_static,& + num_seg_max,num_area,dp_area,flowcase,gamma,mass_flux_se(i,j,iside),0.0_r8,gamma_max) + call t_stopf('fvm:swept_area:get_gamma') + ! + ! pack segments for high-order weights computation + ! + do iarea=1,num_area + do iseg=1,num_seg_static(iarea) + iseg_tmp=num_seg(iarea)+iseg + x (:,iseg_tmp,iarea) = x_static (:,iseg,iarea) + dx(:,iseg_tmp,iarea) = dx_static(:,iseg,iarea) + end do + num_seg(iarea)=num_seg(iarea)+MAX(0,num_seg_static(iarea)) + end do + ! + ! compute higher-order weights + ! + call t_startf('fvm:swept_area:get_high_order_w') + call get_high_order_weights_over_areas(x,dx,num_seg,num_seg_max,num_area,weights,ngpc,gsweights, gspts,irecons_tracer) + call t_stopf('fvm:swept_area:get_high_order_w') + ! + !************************************************** + ! + ! remap air and tracers + ! + !************************************************** + ! + call t_startf('fvm:swept_area:remap') + flux=0.0_r8; flux_tracer=0.0_r8 + do iarea=1,num_area + if (num_seg(iarea)>0) then + ii=idx(1,iarea,i,j,iside); jj=idx(2,iarea,i,j,iside) + flux=flux+weights(1,iarea)*fvm%dp_fvm(ii,jj,ilev,n0_fvm) + do itr=1,ntrac + do iw=1,irecons_tracer + flux_tracer(itr) = flux_tracer(itr)+weights(iw,iarea)*ctracer(iw,ii,jj,itr) + end do + end do + end if + end do + fvm%se_flux(i,j,iside,ilev) = mass_flux_se(i,j,iside)-flux + if (fvm%se_flux(i,j,iside,ilev)>1.0E-13_r8.and.(ilevkmax_jet)) then + write(*,*) "CN excess flux outside of pre-scribed jet region" + write(*,*) "Increase jet region with kmin_jet and kmax_jet ",& + ilev,fvm%se_flux(i,j,iside,ilev),mass_flux_se(i,j,iside),flux,flowcase,& + kmin_jet,kmax_jet + end if + + fvm%dp_fvm(i ,j ,ilev ,np1_fvm) = fvm%dp_fvm(i ,j ,ilev ,np1_fvm)-flux + fvm% c(i ,j ,ilev,1:ntrac,np1_fvm) = fvm% c(i ,j ,ilev,1:ntrac,np1_fvm)-flux_tracer(1:ntrac) + ! + ! update flux in nearest neighbor cells + ! + if (iside==1) then + fvm%dp_fvm(i,j-1,ilev ,np1_fvm) = fvm%dp_fvm(i,j-1,ilev ,np1_fvm)+flux + fvm% c(i,j-1,ilev,1:ntrac,np1_fvm) = fvm% c(i,j-1,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==2) then + fvm%dp_fvm(i+1,j,ilev ,np1_fvm) = fvm%dp_fvm(i+1,j,ilev ,np1_fvm)+flux + fvm% c(i+1,j,ilev,1:ntrac,np1_fvm) = fvm% c(i+1,j,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==3) then + fvm%dp_fvm(i,j+1,ilev ,np1_fvm) = fvm%dp_fvm(i,j+1,ilev ,np1_fvm)+flux + fvm% c(i,j+1,ilev,1:ntrac,np1_fvm) = fvm% c(i,j+1,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==4) then + fvm%dp_fvm(i-1,j,ilev ,np1_fvm) = fvm%dp_fvm(i-1,j,ilev ,np1_fvm)+flux + fvm% c(i-1,j,ilev,1:ntrac,np1_fvm) = fvm% c(i-1,j,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + call t_stopf('fvm:swept_area:remap') + end if + end do + end do + end do + end subroutine swept_flux + + + subroutine large_courant_number_increment(fvm,ilev) + use fvm_control_volume_mod, only: np1_fvm + implicit none + type (fvm_struct), intent(inout):: fvm + integer , intent(in) :: ilev + + integer, parameter :: num_sides=4, imin= 0, imax=nc+1 + + integer, dimension(4), parameter :: imin_side = (/1 ,0 ,1 ,1 /) + integer, dimension(4), parameter :: imax_side = (/nc ,nc ,nc ,nc+1/) + integer, dimension(4), parameter :: jmin_side = (/1 ,1 ,0 ,1 /) + integer, dimension(4), parameter :: jmax_side = (/nc+1,nc ,nc ,nc /) + + integer :: i,j,iside,itr + real (kind=r8) :: flux,flux_tracer(ntrac) + real (kind=r8), dimension(0:nc+1,0:nc+1) :: inv_dp_area + real (kind=r8), dimension(0:nc+1,0:nc+1,ntrac):: c_tmp + + inv_dp_area=1.0_r8/fvm%dp_fvm(0:nc+1,0:nc+1,ilev,np1_fvm) + c_tmp = fvm%c(0:nc+1,0:nc+1,ilev,1:ntrac,np1_fvm) + do iside=1,4 + do j=jmin_side(iside),jmax_side(iside) + do i=imin_side(iside),imax_side(iside) + if (fvm%se_flux(i,j,iside,ilev)>eps) then + flux = fvm%se_flux(i,j,iside,ilev) + do itr=1,ntrac + flux_tracer(itr) = fvm%se_flux(i,j,iside,ilev)*c_tmp(i,j,itr)*inv_dp_area(i,j) + end do + fvm%dp_fvm(i ,j ,ilev ,np1_fvm) = fvm%dp_fvm(i ,j ,ilev ,np1_fvm)-flux + fvm% c(i ,j ,ilev,1:ntrac,np1_fvm) = fvm% c(i ,j ,ilev,1:ntrac,np1_fvm)-flux_tracer(1:ntrac) + ! + ! update flux in nearest neighbor cells + ! + if (iside==1) then + fvm%dp_fvm(i,j-1,ilev ,np1_fvm) = fvm%dp_fvm(i,j-1,ilev ,np1_fvm)+flux + fvm% c(i,j-1,ilev,1:ntrac,np1_fvm) = fvm% c(i,j-1,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==2) then + fvm%dp_fvm(i+1,j,ilev ,np1_fvm) = fvm%dp_fvm(i+1,j,ilev ,np1_fvm)+flux + fvm% c(i+1,j,ilev,1:ntrac,np1_fvm) = fvm% c(i+1,j,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==3) then + fvm%dp_fvm(i,j+1,ilev ,np1_fvm) = fvm%dp_fvm(i,j+1,ilev ,np1_fvm)+flux + fvm% c(i,j+1,ilev,1:ntrac,np1_fvm) = fvm% c(i,j+1,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + if (iside==4) then + fvm%dp_fvm(i-1,j,ilev ,np1_fvm) = fvm%dp_fvm(i-1,j,ilev ,np1_fvm)+flux + fvm% c(i-1,j,ilev,1:ntrac,np1_fvm) = fvm% c(i-1,j,ilev,1:ntrac,np1_fvm)+flux_tracer(1:ntrac) + end if + end if + end do + end do + end do + end subroutine large_courant_number_increment + + subroutine ghost_flux_unpack(fvm) + use control_mod, only : neast, nwest, seast, swest + implicit none + type (fvm_struct), intent(inout) :: fvm + + integer :: i,j,k,ishft + ! + ! rotate coordinates if needed + ! + if (fvm%cubeboundary.NE.0) then + do k=1,nlev + do j=1-nhe,nc+nhe + do i=1-nhe,nc+nhe + ishft = NINT(fvm%flux_orient(2,i,j)) + fvm%se_flux(i,j,1:4,k) = cshift(fvm%se_flux(i,j,1:4,k),shift=ishft) + end do + end do + end do + ! + ! non-existent cells in physical space - necessary? + ! + if (fvm%cubeboundary==nwest) then + fvm%se_flux(1-nhe:0,nc+1 :nc+nhe,:,:) = 0.0_r8 + else if (fvm%cubeboundary==swest) then + fvm%se_flux(1-nhe:0,1-nhe:0 ,:,:) = 0.0_r8 + else if (fvm%cubeboundary==neast) then + fvm%se_flux(nc+1 :nc+nhe,nc+1 :nc+nhe,:,:) = 0.0_r8 + else if (fvm%cubeboundary==seast) then + fvm%se_flux(nc+1 :nc+nhe,1-nhe:0,:,:) = 0.0_r8 + end if + end if + end subroutine ghost_flux_unpack + + subroutine compute_displacements_for_swept_areas(fvm,cair,irecons) + implicit none + type (fvm_struct), intent(inout) :: fvm + integer, intent(in) :: irecons + real (kind=r8) :: cair(1-nhe:nc+nhe,1-nhe:nc+nhe,irecons,nlev) !high-order air density reconstruction + ! + ! flux iside 1 flux iside 3 flux iside 2 flux iside 4 + ! + ! | | | ---1--> | | --2-->| |--1--> | + ! -4----------3- /\ -4----------3- -4----------3- -4----------3- || + ! | | /||\ |\\\\\\\\\\| || | |\\\\\\| |\\\\\\| | + ! | --2--> | || dv(1) |\\\\\\\\\\| || | |\\\\\\| |\\\\\\| | + ! |----------| || |----------| || dv(3) | |\\\\\\| |\\\\\\| | + ! |\\\\\\\\\\| || | <--2--- | \||/ | |\\\\\\| |\\\\\\| | + ! |\\\\\\\\\\| || | | \/ | |\\\\\\| |\\\\\\| | + ! -1----------2- -1----------2- -1----------2- -1----------2- + ! | <--1-- | | | | <--1--| |<--2-- + ! + ! / \ + ! line-integral <========== =========> + ! from vertex 2 \ dv(2) dv(4)/ + ! to 1 + ! + ! Note vertical + ! lines have + ! zero line- + ! integral! + ! + integer :: i,j,k,iside,ix + integer, parameter :: num_area=1, num_seg_max=2 + REAL(KIND=r8), dimension(2,num_seg_max,num_area,4,nc,nc) :: x_static, dx_static + REAL(KIND=r8), dimension(2,num_seg_max,num_area,4,nc,nc) :: x, dx + REAL(KIND=r8), dimension(2,num_seg_max,num_area) :: x_tmp, dx_tmp + integer , dimension( num_area,4 ) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8, 4,nc,nc) :: x_start, dgam_vec + REAL(KIND=r8), dimension(num_area) :: dp_area + integer, dimension(4) :: flowcase + REAL(KIND=r8) :: gamma(4), flux_se + + num_seg_static(1,1) = 1; num_seg(1,1) = 1; flowcase(1) = -1 + num_seg_static(1,2) = 0; num_seg(1,2) = 2; flowcase(2) = -2 + num_seg_static(1,3) = 1; num_seg(1,3) = 1; flowcase(3) = -1 + num_seg_static(1,4) = 0; num_seg(1,4) = 2; flowcase(4) = -4 + + do j=1,nc + do i=1,nc + do ix=1,2 + iside=1; + x_static (ix,1,1,iside,i,j) = fvm%vtx_cart(2,ix,i,j) + dx_static(ix,1,1,iside,i,j) = fvm%vtx_cart(1,ix,i,j)-fvm%vtx_cart(2,ix,i,j) + x_start (ix,1, iside,i,j) = fvm%vtx_cart(1,ix,i,j) + x_start (ix,2, iside,i,j) = fvm%vtx_cart(2,ix,i,j) + dgam_vec (ix,1, iside,i,j) = fvm%vtx_cart(4,ix,i,j)-fvm%vtx_cart(1,ix,i,j) + ! + ! compute first guess + ! + gamma(iside) = 0.5_r8 + x (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j) + dx (ix,1,1,iside,i,j) = -dx_static(ix,1,1,iside,i,j) + ! + ! side 2 + ! + iside=2; + x_start (ix,1, iside,i,j) = fvm%vtx_cart(2,ix,i,j) + x_start (ix,2, iside,i,j) = fvm%vtx_cart(3,ix,i,j) + dgam_vec (ix,1, iside,i,j) = fvm%vtx_cart(1,ix,i,j)-fvm%vtx_cart(2,ix,i,j) + x (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j) + ! + ! compute first guess - gamma=1 + ! + gamma(iside) = 0.5_r8 + dx (ix,1,1,iside,i,j) = gamma(iside)*dgam_vec (ix,1, iside,i,j) + x (ix,2,1,iside,i,j) = x_start(ix,2,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j) + dx (ix,2,1,iside,i,j) = -gamma(iside)*dgam_vec (ix,1, iside,i,j) + ! + ! side 3 + ! + iside=3; + x_static (ix,1,1,iside,i,j) = fvm%vtx_cart(4,ix,i,j) + dx_static(ix,1,1,iside,i,j) = fvm%vtx_cart(3,ix,i,j)-fvm%vtx_cart(4,ix,i,j) + x_start (ix,1, iside,i,j) = fvm%vtx_cart(3,ix,i,j) + x_start (ix,2, iside,i,j) = fvm%vtx_cart(4,ix,i,j) + dgam_vec (ix,1, iside,i,j) = fvm%vtx_cart(2,ix,i,j)-fvm%vtx_cart(3,ix,i,j) + ! + ! compute first guess - gamma(iside)=1 + ! + gamma(iside) = 0.5_r8 + x (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j) + dx (ix,1,1,iside,i,j) = -dx_static(ix,1,1,iside,i,j) + ! + ! side 4 + ! + iside=4; + x_start (ix,1, iside,i,j) = fvm%vtx_cart(1,ix,i,j) + x_start (ix,2, iside,i,j) = fvm%vtx_cart(4,ix,i,j) + dgam_vec (ix,1, iside,i,j) = fvm%vtx_cart(2,ix,i,j)-fvm%vtx_cart(1,ix,i,j) + x (ix,2,1,iside,i,j) = x_start(ix,2,iside,i,j) + ! + ! compute first guess - gamma(iside)=1 + ! + gamma(iside) = 0.5_r8 + dx (ix,2,1,iside,i,j) = gamma(iside)*dgam_vec (ix,1, iside,i,j) + x (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j) + dx (ix,1,1,iside,i,j) = -gamma(iside)*dgam_vec (ix,1, iside,i,j) + end do + end do + end do + + do k=1,nlev + do j=1,nc + do i=1,nc + dp_area = cair(i,j,1,k) + do iside=1,4 + flux_se = -fvm%se_flux(i,j,iside,k) + if (flux_se>eps) then + gamma(iside)=0.5_r8 + ! + ! this copying is necessary since get_flux_segments_area_iterate change x and dx + ! + x_tmp (:,1:num_seg(1,iside),:)=x (:,1:num_seg(1,iside),:,iside,i,j) + dx_tmp(:,1:num_seg(1,iside),:)=dx(:,1:num_seg(1,iside),:,iside,i,j) + call get_flux_segments_area_iterate(& + x_tmp(:,:,:),x_static(:,:,:,iside,i,j),dx_static(:,:,:,iside,i,j),dx_tmp(:,:,:),& + x_start(:,:,iside,i,j),dgam_vec(:,:,iside,i,j),num_seg(:,iside),num_seg_static(:,iside),& + num_seg_max,num_area,dp_area,flowcase(iside),gamma(iside),flux_se,0.0_r8,1.0_r8) + fvm%se_flux(i,j,iside,k) = ABS(SUM(gamma(iside)*dgam_vec(:,1,iside,i,j))) + if (gamma(iside)>1_r8) then + gamma(iside)=1.0_r8-eps + end if + else + fvm%se_flux(i,j,iside,k) = 0.0_r8 + end if + enddo + end do + end do + end do + end subroutine compute_displacements_for_swept_areas + + + + subroutine get_flux_segments_area_iterate(x,x_static,dx_static,dx,x_start,dgam_vec,num_seg,num_seg_static,& + num_seg_max,num_area,c,flow_case,gamma,flux,gamma_min,gamma_max) + implicit none + integer , intent(in) :: num_area, num_seg_max + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(in) :: x_static, dx_static + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx + integer , dimension(num_area ), intent(in) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) , intent(in) :: x_start, dgam_vec + REAL(KIND=r8) , intent(inout) :: gamma + REAL(KIND=r8) , intent(in) :: flux,gamma_min,gamma_max + integer , intent(in) :: flow_case + + real (kind=r8), dimension(num_area) , intent(in) :: c + + real (kind=r8) :: flux_static + real (kind=r8) :: weight_area(num_area), xtmp(2), xtmp2(2) + real (kind=r8) :: gamma1, gamma2, gamma3, dgamma, f1, f2 + + real (kind=r8), dimension( ngpc ) :: xq,yq + real (kind=r8), dimension( ngpc,1) :: F !linear + + real (kind=r8) :: xq2,xq2i, rho, rhoi, yrh, w_static(num_area) + + integer :: iseg,iarea,iter,ipt + integer, parameter :: iter_max=20 + logical :: lexit_after_one_more_iteration + + lexit_after_one_more_iteration = .false. + ! + ! compute static line-integrals (not necessary to recompute them for every iteration) + ! + flux_static = 0.0_r8 + w_static = 0.0_r8 + weight_area = 0.0_r8 + do iarea=1,num_area + do iseg=1,num_seg_static(iarea) + +!rck vector directive needed here +!DIR$ SIMD + do ipt=1,ngpc + xq(ipt) = x_static(1,iseg,iarea)+dx_static(1,iseg,iarea)*gspts(ipt)! create quadrature point locations + yq(ipt) = x_static(2,iseg,iarea)+dx_static(2,iseg,iarea)*gspts(ipt) + F(ipt,1) = yq(ipt)/(SQRT(1.0_r8+xq(ipt)*xq(ipt) + yq(ipt)*yq(ipt))*(1.0_r8+xq(ipt)*xq(ipt)))! potential ! potential + enddo + weight_area(iarea) = weight_area(iarea)+sum(gsweights(:)*F(:,1))*0.5_r8*dx_static(1,iseg,iarea) !integral + end do + w_static(iarea)= weight_area(iarea) + flux_static = flux_static+weight_area(iarea)*c(iarea) !add to swept flux + end do + ! + ! initilization + ! + gamma1=0.0_r8; f1=-flux ! zero flux guess 1 + ! + ! compute flux integrals of first guess passed to subroutine + ! + gamma2=gamma + f2 = 0.0_r8 + weight_area=w_static + do iarea=1,num_area + do iseg=1,num_seg(iarea) +!rck vector directive needed here +!DIR$ SIMD + do ipt=1,ngpc + xq(ipt) = x(1,iseg,iarea)+dx(1,iseg,iarea)*gspts(ipt)! create quadrature point locations + yq(ipt) = x(2,iseg,iarea)+dx(2,iseg,iarea)*gspts(ipt) + xq2 = xq(ipt)*xq(ipt) + xq2i = 1.0_r8/(1.0_r8+xq2) + rho = SQRT(1.0_r8+xq2+yq(ipt)*yq(ipt)) + rhoi = 1.0_r8/rho + yrh = yq(ipt)*rhoi + F(ipt,1) = yrh*xq2i + enddo + weight_area(iarea) = weight_area(iarea)+sum(gsweights(:)*F(:,1))*0.5_r8*dx(1,iseg,iarea)! integral + end do + f2 = f2+weight_area(iarea)*c(iarea) + end do + f2 = f2-flux !integral error + iter=0 + if (abs(f2-f1)gamma_max) then + lexit_after_one_more_iteration=.true. + gamma=gamma_max + gamma3=gamma_max + else + exit + end if + else + ! + ! Newton increment + ! + if (abs(f2-f1)eps) then + gamma3 = gamma2-dgamma; + else + ! + ! dgamma set to minimum displacement to avoid f2-f1=0 + ! + gamma3=gamma2-SIGN(1.0_r8,dgamma)*eps + write(*,*) "WARNING: setting gamma to min",gamma3,iter + end if + gamma3=MAX(gamma3,gamma_min) + ! + ! prepare for next iteration + ! + gamma1 = gamma2; f1 = f2; gamma2 = gamma3; + endif + end do + if (iter>iter_max) write(*,*) "WARNING: iteration not converged",& + ABS(f2),flux,gamma1,gamma2,gamma3 + end subroutine get_flux_segments_area_iterate + + subroutine define_swept_areas(fvm,ilev,displ,base_vec,base_vtx,idx) + use control_mod, only : neast, nwest, seast, swest + implicit none + type (fvm_struct), intent(inout) :: fvm + integer , intent(in) :: ilev + + + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides), intent(out) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(out) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(out) :: base_vtx + integer , dimension(2,num_area, imin:imax,imin:imax,num_sides), intent(out) :: idx + + real (kind=r8) :: flux_sum (0:nc+1,0:nc+1,2) + integer :: degenerate (1:nc+1,1:nc+1 ) + integer :: circular_flow(1:nc+1,1:nc+1 ) + integer :: illcond (1:nc+1,1:nc+1) + integer :: ib,i,j,sgn, iside, iarea + + ! + ! set where reconstruction function is as a function of area and side + ! + integer, dimension(num_area*4), parameter :: idx_shift_tmp = (/-1,-1, 0, 1, 1,& !iside=1 + 1, 0, 0, 0, 1,& !iside=2 + 1, 1, 0,-1,-1,& !iside=3 + -1, 0, 0, 0,-1/) !iside=4 + + integer, dimension(num_area*4), parameter :: idy_shift_tmp = (/-1, 0, 0, 0,-1,& !iside=1 + -1,-1, 0, 1, 1,& !iside=2 + 1, 0, 0, 0, 1,& !iside=3 + 1, 1, 0,-1,-1/) !iside=4 + + integer, dimension(num_area,4), parameter :: idx_shift = RESHAPE(idx_shift_tmp,(/num_area,4/)) + integer, dimension(num_area,4), parameter :: idy_shift = RESHAPE(idy_shift_tmp,(/num_area,4/)) + + integer, dimension(4), parameter :: iside_m1 = (/4,1,2,3/) + integer, dimension(4), parameter :: iside_p1 = (/2,3,4,1/) + integer, dimension(4), parameter :: iside_p2 = (/3,4,1,2/) + integer, dimension(4), parameter :: iside_p3 = (/4,1,2,3/) + + integer, dimension(4), parameter :: imin_side = (/1 ,0 ,1 ,1 /) + integer, dimension(4), parameter :: imax_side = (/nc ,nc ,nc ,nc+1/) + integer, dimension(4), parameter :: jmin_side = (/1 ,1 ,0 ,1 /) + integer, dimension(4), parameter :: jmax_side = (/nc+1,nc ,nc ,nc /) + + + + integer :: iur,jur,ilr,jlr,iul,jul,ill,jll + + ib = fvm%cubeboundary + flux_sum(0:nc+1,1:nc+1,1) = fvm%se_flux(0:nc+1,0:nc ,3,ilev)-fvm%se_flux(0:nc+1,1:nc+1,1,ilev) + flux_sum(1:nc+1,0:nc+1,2) = fvm%se_flux(0:nc ,0:nc+1,2,ilev)-fvm%se_flux(1:nc+1,0:nc+1,4,ilev) + + ! + ! Degenerate case ("two departure points") + ! + ! || | || no change in this situation || no change in this situation + ! || | || || + ! ||-------- ||---------- ||---------- + ! || | || || + ! ======================= ======================= ===================== + ! | || | || || + ! -----|---|| ------|---|| ---------|| + ! | || | || || + ! | || | || || + ! + ! + where (flux_sum(0:nc,1:nc+1,1)*flux_sum(1:nc+1,1:nc+1,1)<0.0_r8.and.flux_sum(1:nc+1,0:nc,2)*flux_sum(1:nc+1,1:nc+1,2)<0.0_r8) + degenerate(:,:) = 0 + elsewhere + degenerate(:,:) = 1 + end where + + if (ib>0) then + if (ib==swest) degenerate(1 ,1 ) = 1 + if (ib==nwest) degenerate(1 ,nc+1) = 1 + if (ib==neast) degenerate(nc+1,nc+1) = 1 + if (ib==seast) degenerate(nc+1,1 ) = 1 + end if + + do j=1,nc+1 + do i=1,nc+1 + do sgn=-1,1,2 + if (& + sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.& + sgn*flux_sum(i ,j,1)>0.0_r8.and.sgn*flux_sum(i,j ,2)<0.0_r8) then + circular_flow(i,j) = 0 + else + circular_flow(i,j) = 1 + end if + end do + end do + end do + ! + ! wrap around corners + ! + if (ib==nwest) then + flux_sum(0,nc+1,1) = fvm%se_flux(0,nc,3,ilev)-fvm%se_flux(1,nc+1,4,ilev) + flux_sum(1,nc+1,2) = fvm%se_flux(0,nc,3,ilev)-fvm%se_flux(1,nc+1,4,ilev) + + i=1;j=nc+1; + circular_flow(i,j) = 1 + do sgn=-1,1,2 + if (& + sgn*flux_sum(i,j-1,2)>0.0_r8.and.& + sgn*flux_sum(i ,j,1)>0.0_r8.and.sgn*flux_sum(i,j ,2)<0.0_r8) then + circular_flow(i,j) = 0 + end if + end do + else if (ib==swest) then + flux_sum(0,1,1) = fvm%se_flux(1,0,4,ilev)-fvm%se_flux(0,1,1,ilev) + flux_sum(1,0,2) = fvm%se_flux(0,1,1,ilev)-fvm%se_flux(1,0,4,ilev) + i=1;j=1; + circular_flow(i,j) = 1 + do sgn=-1,1,2 + if (& + sgn*flux_sum(i-1,j,1)<0.0_r8.and.& + sgn*flux_sum(i ,j,1)>0.0_r8.and.sgn*flux_sum(i,j ,2)<0.0_r8) then + circular_flow(i,j) = 0 + end if + end do + else if (ib==neast) then + flux_sum(nc+1,nc+1,1) = fvm%se_flux(nc+1,nc,3,ilev)-fvm%se_flux(nc,nc+1,2,ilev) + flux_sum(nc+1,nc+1,2) = fvm%se_flux(nc,nc+1,2,ilev)-fvm%se_flux(nc+1,nc,3,ilev) + i=nc+1;j=nc+1; + circular_flow(i,j) = 1 + do sgn=-1,1,2 + if (& + sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.& + sgn*flux_sum(i,j ,2)<0.0_r8) then + circular_flow(i,j) = 0 + end if + end do + else if (ib==seast) then + flux_sum(nc+1,1 ,1) = fvm%se_flux(nc,0,2,ilev)-fvm%se_flux(nc+1,1,1,ilev) + flux_sum(nc+1,0 ,2) = fvm%se_flux(nc,0,2,ilev)-fvm%se_flux(nc+1,1,1,ilev) + i=nc+1;j=1; + circular_flow(i,j) = 1 + do sgn=-1,1,2 + if (& + sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.& + sgn*flux_sum(i,j ,2)<0.0_r8) then + circular_flow(i,j) = 0 + end if + end do + end if + illcond = circular_flow*degenerate + ! + ! + ! + ! + do iside=1,4 + do j=jmin_side(iside),jmax_side(iside) + do i=imin_side(iside),imax_side(iside) + if (fvm%se_flux(i,j,iside,ilev)>eps) then + iur = i+idx_shift(4,iside); jur = j+idy_shift(4,iside) !(i,j) index of upper right quadrant + ilr = i+idx_shift(5,iside); jlr = j+idy_shift(5,iside) !(i,j) index of lower left quadrant + iul = i+idx_shift(2,iside); jul = j+idy_shift(2,iside) !(i,j) index of upper right quadrant + ill = i+idx_shift(1,iside); jll = j+idy_shift(1,iside) !(i,j) index of lower left quadrant + + !iside=1 + if (iside==1) then + displ(0,i,j,iside) = -flux_sum (i ,j ,1)*illcond(i,j) !center left + displ(1,i,j,iside) = -flux_sum (i ,j ,1)*illcond(i+1,j) !center right + displ(2,i,j,iside) = flux_sum (i+1,j ,2)*illcond(i+1,j) !c2 + displ(3,i,j,iside) = -flux_sum (i ,j ,2)*illcond(i ,j) !c3 + displ(4,i,j,iside) = -flux_sum (i+1,j ,1)*illcond(i+1,j) !r1 + displ(5,i,j,iside) = -flux_sum (i+1,j-1,2)*illcond(i+1,j) !r2 + displ(6,i,j,iside) = -flux_sum (i-1,j ,1)*illcond(i ,j) !l1 + displ(7,i,j,iside) = flux_sum (i ,j-1,2)*illcond(i ,j) !l2 + + end if + if (iside==2) then + !iside=2 + displ(0,i,j,iside) = flux_sum (i+1,j ,2)*illcond(i+1,j ) !center left + displ(1,i,j,iside) = flux_sum (i+1,j ,2)*illcond(i+1,j+1) !center right + displ(2,i,j,iside) = flux_sum (i ,j+1,1)*illcond(i+1,j+1) !c2 + displ(3,i,j,iside) = -flux_sum (i ,j ,1)*illcond(i+1,j ) !c3 + displ(4,i,j,iside) = flux_sum (i+1,j+1,2)*illcond(i+1,j+1) !r1 + displ(5,i,j,iside) = -flux_sum (i+1,j+1,1)*illcond(i+1,j+1) !r2 + displ(6,i,j,iside) = flux_sum (i+1,j-1,2)*illcond(i+1,j) !l1 + displ(7,i,j,iside) = flux_sum (i+1,j ,1)*illcond(i+1,j) !l2 + end if + !iside=3 + if (iside==3) then + displ(0,i,j,iside) = flux_sum (i ,j+1,1)*illcond(i+1,j+1) !center left + displ(1,i,j,iside) = flux_sum (i ,j+1,1)*illcond(i ,j+1) !center right + displ(2,i,j,iside) = -flux_sum (i ,j ,2)*illcond(i ,j+1) !c2 + displ(3,i,j,iside) = flux_sum (i+1,j ,2)*illcond(i+1,j+1) !c3 + displ(4,i,j,iside) = flux_sum (i-1,j+1,1)*illcond(i ,j+1) !r1 + displ(5,i,j,iside) = flux_sum (i ,j+1,2)*illcond(i ,j+1) !r2 + displ(6,i,j,iside) = flux_sum (i+1,j+1,1)*illcond(i+1,j+1) !l1 + displ(7,i,j,iside) = -flux_sum (i+1,j+1,2)*illcond(i+1,j+1) !l2 + end if + if (iside==4) then + !iside=4 + displ(0,i,j,iside) = -flux_sum (i ,j ,2)*illcond(i ,j+1) !center left + displ(1,i,j,iside) = -flux_sum (i ,j ,2)*illcond(i ,j ) !center right + displ(2,i,j,iside) = -flux_sum (i ,j ,1)*illcond(i ,j ) !c2 + displ(3,i,j,iside) = flux_sum (i ,j+1,1)*illcond(i ,j+1) !c3 + displ(4,i,j,iside) = -flux_sum (i ,j-1,2)*illcond(i ,j ) !r1 + displ(5,i,j,iside) = flux_sum (i-1,j ,1)*illcond(i ,j ) !r2 + displ(6,i,j,iside) = -flux_sum (i ,j+1,2)*illcond(i ,j+1) !l1 + displ(7,i,j,iside) = -flux_sum (i-1,j+1,1)*illcond(i ,j+1) !l2 + end if + + base_vtx(:,1,i,j,iside) = fvm%vtx_cart(iside,:,i ,j ) !vertex center left + base_vtx(:,2,i,j,iside) = fvm%vtx_cart(iside_p1(iside),:,i ,j ) !vertex center right + base_vtx(:,3,i,j,iside) = fvm%vtx_cart(iside,:,iur,jur ) !vertex upper right + base_vtx(:,4,i,j,iside) = fvm%vtx_cart(iside_p3(iside),:,ilr,jlr) !vertex lower right + base_vtx(:,5,i,j,iside) = fvm%vtx_cart(iside_p1(iside),:,iul,jul) !vertex upper left + base_vtx(:,6,i,j,iside) = fvm%vtx_cart(iside_p2(iside),:,ill,jll) !vertex lower left + + base_vec(:, 1,i,j,iside) = fvm%flux_vec (:,i ,j ,iside ) !vector center + base_vec(:, 2,i,j,iside) = fvm%flux_vec (:,i ,j ,iside_p1(iside)) !vector center right + base_vec(:, 3,i,j,iside) = fvm%flux_vec (:,i ,j ,iside_p3(iside)) !vector center left + base_vec(:, 4,i,j,iside) = fvm%flux_vec (:,iur,jur,iside ) !vector upper right 1 + base_vec(:, 5,i,j,iside) = fvm%flux_vec (:,iur,jur,iside_p3(iside)) !vector upper right 2 + base_vec(:, 6,i,j,iside) = fvm%flux_vec (:,ilr,jlr,iside_p3(iside)) !vector lower right 1 + base_vec(:, 7,i,j,iside) = fvm%flux_vec (:,ilr,jlr,iside_p2(iside)) !vector lower right 2 + base_vec(:, 8,i,j,iside) = fvm%flux_vec (:,iul,jul,iside ) !vector upper left 1 + base_vec(:, 9,i,j,iside) = fvm%flux_vec (:,iul,jul,iside_p1(iside)) !vector upper left 2 + base_vec(:,10,i,j,iside) = fvm%flux_vec (:,ill,jll,iside_p1(iside)) !vector lower left 1 + base_vec(:,11,i,j,iside) = fvm%flux_vec (:,ill,jll,iside_p2(iside)) !vector lower left 2 + + do iarea=1,5 + idx(1,iarea,i,j,iside) = i+idx_shift(iarea,iside) + idx(2,iarea,i,j,iside) = j+idy_shift(iarea,iside) + end do + else + displ(:,i,j,iside) = 9D99!for debugging + end if + end do + end do + end do + ! + ! wrap around corners here + ! + + end subroutine define_swept_areas + + + ! + ! Notation conventions used in define_area subroutines + ! + ! + ! + ! ^ ||---> ^ <---|| ^ + ! /|\ || 3 /|\ 2 || /|\ + ! | 6 || 1 | || | 4 + ! | || | || | + ! ================================= + ! || || + ! || || + ! 7 || || 5 + ! <---|| ||---> + ! + + subroutine define_area1_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,& + x_start, dgam_vec) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + integer, parameter :: num_seg_max=5 + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer , dimension(num_area) , intent(inout) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) , intent(inout):: x_start, dgam_vec + + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + + + REAL(KIND=r8) :: xtmp(2),xtmp2(2) + ! + ! + ! ||----- || + ! /|| || + ! / || || + ! ===X========================= + ! | /|| || + ! |/ || || + ! * || || + ! + ! + ! crossing X + if (SUM(ABS(base_vec(:,9,i,j,iside))).NE.0) then + gamma = displ(0,i,j,iside)*displ(7,i,j,iside)/(displ(0,i,j,iside)-displ(6,i,j,iside)) +! gamma = MAX(MIN(gamma,displ(7,i,j,iside),-displ(3,i,j,iside)),0.0_r8)!MWR manuscript + gamma = MAX(MIN(gamma,displ(7,i,j,iside),-0.25_r8*displ(3,i,j,iside)),0.0_r8)!dbgxxx + else + ! + ! corner case + ! + gamma=displ(0,i,j,iside) + end if + + + xdep (:,1) = base_vtx(:, 6,i,j,iside)+displ(7,i,j,iside)*base_vec(:,10,i,j,iside)-displ(6,i,j,iside)*base_vec(:,11,i,j,iside) + x_start (:,1) = base_vtx(:, 6,i,j,iside) + dgam_vec(:,1) = base_vec(:,10,i,j,iside)*gamma + + xdep(:,2) = base_vtx(:,2,i,j,iside)+displ(1,i,j,iside)*base_vec(:, 1,i,j,iside)+displ(2,i,j,iside)*base_vec(:, 2,i,j,iside) + + iarea = 1 + num_seg (iarea) = 2 + num_seg_static(iarea) = 1 + + x_static (:,1,iarea) = base_vtx(:,6,i,j,iside) !static + dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static + + xtmp(: ) = x_start(:,1)+dgam_vec(:,1) + x (:,1,iarea) = xdep(:,1) !static + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic + + x (:,2,iarea) = xtmp(:) !dynamic + dx(:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic + ! + ! + ! + iarea = 2 + num_seg (iarea) = 3 + + x_start (:,2) = base_vtx(:,5,i,j,iside) + dgam_vec(:,2) = base_vec(:,9,i,j,iside)*gamma + xtmp (: ) = x_start(:,2)+dgam_vec(:,2) + + x_start (:,3) = base_vtx(:,5,i,j,iside) + dgam_vec(:,3) = base_vec(:,8,i,j,iside)*displ(0,i,j,iside) + xtmp2 (: ) = x_start(:,3)+dgam_vec(:,3) + + x (:,1,iarea) = base_vtx(:,5,i,j,iside) !static + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic + + x (:,2,iarea) = xtmp (:) !dynamic + dx(:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic + + x (:,3,iarea) = xtmp2(:) !dynamic + dx(:,3,iarea) = x(:,1,iarea)-xtmp2(:) !dynamic + end subroutine define_area1_area2 + + + subroutine define_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,x_start, dgam_vec,& + displ_first_guess) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + integer, parameter :: num_seg_max=5 + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer , dimension(num_area) , intent(inout) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) , intent(inout):: x_start, dgam_vec + + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8), optional, intent(out) :: displ_first_guess + real (kind=r8) :: gamma + integer :: iarea + + + REAL(KIND=r8) :: xtmp(2) + ! *: xdep(:,1) + ! x: xtmp + ! + ! 2 || || + ! *--x || + ! 1\3||1 || + ! \|| || + ! ============================= + ! || || + ! + ! + ! compute departure points (xdep(1) is left; xdep(3) is right and xdep(2) is midway + ! + xdep(:,1) = base_vtx(:,5,i,j,iside)+& + MAX(0.0_r8,displ(6,i,j,iside))*base_vec(:,8,i,j,iside)-displ(3,i,j,iside)*base_vec(:,9,i,j,iside) + x_start (:,1) = base_vtx(:,5,i,j,iside) + gamma = displ(0,i,j,iside) + dgam_vec(:,1) = base_vec(:,8,i,j,iside)*gamma + if (present(displ_first_guess)) displ_first_guess = gamma + + iarea = 2 + num_seg (iarea) = 2 + num_seg_static(iarea) = 1 + + x_static (:,1,iarea) = base_vtx(:,5,i,j,iside) !static - line 1 + dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static - line 1 + + xtmp (: ) = x_start(:,1)+dgam_vec(:,1) + x (:,1,iarea) = xdep(:,1) !static - line 2 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2 + + x (:,2,iarea) = xtmp(:) !dynamic - line 3 + dx (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 3 + end subroutine define_area2 + + + subroutine define_area3_left(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, & + num_seg, num_seg_static,x_start, dgam_vec,displ_first_guess) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + integer, parameter :: num_seg_max=5 + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer , dimension(num_area) , intent(inout) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) , intent(inout):: x_start, dgam_vec + real (kind=r8), optional, intent(out) :: displ_first_guess + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + + + REAL(KIND=r8) :: xtmp(2) + + ! iarea = 3 + !------------------------------------------------------------------------------------------- + ! + ! xtmp xdep(2) + ! |x-----2------* || + ! || \ || + ! |1 3 || + ! || \|| + ! ===========4============== + ! + ! + xdep(:,2) = base_vtx(:,2,i,j,iside)+displ(1,i,j,iside)*base_vec(:,1,i,j,iside)& + +MAX(0.0_r8,displ(2,i,j,iside))*base_vec(:,2,i,j,iside) + x_start (:,4) = base_vtx(:,1,i,j,iside) + gamma = displ(0,i,j,iside) + dgam_vec(:,4) = base_vec(:,1,i,j,iside)*gamma + xtmp (: ) = x_start(:,4)+dgam_vec(:,4) + + if (present(displ_first_guess)) displ_first_guess = gamma + + iarea = 3 + num_seg (iarea) = 2 + num_seg_static(iarea) = 2 + + x_static (:,1,iarea) = xdep(:,2) !static - line 3 + dx_static(:,1,iarea) = base_vtx(:,2,i,j,iside)-xdep(:,2) !static - line 3 + + x_static (:,2,iarea) = base_vtx(:,2,i,j,iside) !static - line 4 + dx_static(:,2,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static - line 4 + + x (:,1,iarea) = base_vtx(:,1,i,j,iside) !static - line 1 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 1 + + x (:,2,iarea) = xtmp(:) !dynamic -line 2 + dx (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2 + end subroutine define_area3_left + + subroutine define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static,x_start, dgam_vec) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + real (kind=r8) , dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8) , dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8) , dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + integer, parameter :: num_seg_max=5 + REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer , dimension(num_area) , intent(inout) :: num_seg, num_seg_static + REAL(KIND=r8), dimension(2,8) , intent(inout):: x_start, dgam_vec + + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + + REAL(KIND=r8) :: xtmp(2) + ! + ! + ! || *-----2----||\ + ! || /1 3|| \ + ! ||/ 4 || + ! ============================= + ! || || + ! || || + ! || || + ! + xdep(:,1) = base_vtx(:,1,i,j,iside)+displ(0,i,j,iside)*base_vec(:,1,i,j,iside)& + +MAX(0.0_r8,displ(3,i,j,iside))*base_vec(:,3,i,j,iside) + x_start (:,5) = base_vtx(:,2,i,j,iside) + gamma = displ(1,i,j,iside) + dgam_vec(:,5) = base_vec(:,1,i,j,iside)*gamma + xtmp (: ) = x_start(:,5)+dgam_vec(:,5) + + iarea = 3 + num_seg (iarea) = 2 + num_seg_static(iarea) = 2 + + x_static (:,1,iarea) = base_vtx(:,1,i,j,iside) !static - line 1 + dx_static(:,1,iarea) = xdep(:,1)-base_vtx(:,1,i,j,iside) !static - line 1 + + x_static (:,2,iarea) = base_vtx(:,2,i,j,iside) !static - line 4 + dx_static(:,2,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static - line 4 + + x (:,1,iarea) = xdep(:,1) !static - line 2 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2 + + x (:,2,iarea) = xtmp(:) !dynamic -line 2 + dx (:,2,iarea) = x_static(:,2,iarea)-xtmp(:) !dynamic - line 2 + end subroutine define_area3_right + + + subroutine define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static,x_start, dgam_vec) + implicit none + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + integer, parameter :: num_seg_max=5 + integer, intent(in) :: i,j,iside + real (kind=r8), dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout):: displ + integer (kind=r8), dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout):: base_vec + real (kind=r8), dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout):: base_vtx + real(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout):: x, dx, x_static, dx_static + integer, dimension(num_area), intent(inout):: num_seg, num_seg_static + real(KIND=r8), dimension(2,8), intent(inout):: x_start, dgam_vec + + real (kind=r8) :: gamma + integer :: iarea + real(KIND=r8) :: xtmp(2),xtmp2(2) + ! + ! ||-------------|| + ! /|| ||\ + ! || || + ! ============================= + ! || || + ! || || + ! || || + ! + x_start (:,4) = base_vtx(:,1,i,j,iside) + x_start (:,5) = base_vtx(:,2,i,j,iside) + gamma = displ(0,i,j,iside) + dgam_vec(:,4) = base_vec(:,1,i,j,iside)*gamma + dgam_vec(:,5) = base_vec(:,1,i,j,iside)*gamma + xtmp (: ) = x_start(:,4)+dgam_vec(:,4) + xtmp2 (: ) = x_start(:,5)+dgam_vec(:,5) + + iarea = 3 + num_seg (iarea) = 3 + num_seg_static(iarea) = 1 + + x_static (:,1,iarea) = base_vtx(:,2,i,j,iside) !static + dx_static(:,1,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static + + x (:,1,iarea) = base_vtx(:,1,i,j,iside) !static + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic + + x (:,2,iarea) = xtmp (:) !dynamic + dx (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic + + x (:,3,iarea) = xtmp2(:) !dynamic + dx (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic + end subroutine define_area3_left_right + + subroutine define_area4_area5(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static,x_start, dgam_vec,displ_first_guess) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + integer, parameter :: num_seg_max=5 + real (kind=r8), dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8), dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8), dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + real(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer, dimension(num_area), intent(inout) :: num_seg, num_seg_static + real(KIND=r8), dimension(2,8), intent(inout) :: x_start, dgam_vec + real(KIND=r8), optional, intent(out) :: displ_first_guess + + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + + real(KIND=r8) :: xtmp(2),xtmp2(2) + ! + ! || --------|| + ! || ||\ + ! || || \ + ! ============================= + ! || ||\ | + ! || || \| + ! || || * + ! + ! + ! iarea = 4 + ! + iarea = 4 + num_seg (iarea) = 3 + + if (SUM(ABS(base_vec(:,5,i,j,iside))).NE.0) then + gamma = displ(1,i,j,iside)*displ(5,i,j,iside)/(displ(1,i,j,iside)-displ(4,i,j,iside)) +! gamma = MAX(MIN(gamma,displ(5,i,j,iside),-displ(2,i,j,iside)),0.0_r8)!MWR manuscript + gamma = MAX(MIN(gamma,displ(5,i,j,iside),-0.25_r8*displ(2,i,j,iside)),0.0_r8) + else + ! + ! corner case + ! + gamma = displ(1,i,j,iside) + end if + + if (present(displ_first_guess)) displ_first_guess = displ(1,i,j,iside) + + x_start (:,6) = base_vtx(:,3,i,j,iside) + dgam_vec(:,6) = base_vec(:,4,i,j,iside)*displ(1,i,j,iside) + xtmp (: ) = x_start(:,6)+dgam_vec(:,6) + x_start (:,7) = base_vtx(:,3,i,j,iside) + dgam_vec(:,7) = base_vec(:,5,i,j,iside)*gamma + xtmp2 (: ) = x_start(:,7)+dgam_vec(:,7) + + x (:,1,iarea) = base_vtx(:,3,i,j,iside)!static -line 1 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 1 + + x (:,2,iarea) = xtmp(:) !dynamic -line 2 + dx (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic - line 2 + + x (:,3,iarea) = xtmp2(:) !static -line 1 + dx (:,3,iarea) = x(:,1,iarea)-xtmp2(:) !dynamic - line 1 + ! + !iarea = 5 + ! + xdep(:,1) = base_vtx(:,4,i,j,iside)+displ(5,i,j,iside)*base_vec(:,6,i,j,iside)& + -displ(4,i,j,iside)*base_vec(:,7,i,j,iside) + x_start (:,8) = base_vtx(:,4,i,j,iside) + dgam_vec(:,8) = base_vec(:,6,i,j,iside)*gamma + xtmp (: ) = x_start(:,8)+dgam_vec(:,8) + + iarea = 5 + num_seg (iarea) = 2 + num_seg_static(iarea) = 1 + + x (:,1,iarea) = base_vtx(:,4,i,j,iside)!static -line 1 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 1 + + x_static (:,1,iarea) = xdep(:,1) !static - line 1 + dx_static(:,1,iarea) = x(:,1,iarea)-x_static(:,1,iarea) !static - line 1 + + x (:,2,iarea) = xtmp(:) !dynamic -line 2 + dx (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2 + end subroutine define_area4_area5 + + + subroutine define_area4(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, & + num_seg_static,x_start, dgam_vec,displ_first_guess) + implicit none + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + integer, parameter :: num_seg_max=5 + integer, intent(in) :: i,j,iside + real (kind=r8), dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8), dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8), dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + + real(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer, dimension(num_area) , intent(inout) :: num_seg, num_seg_static + real(KIND=r8), dimension(2,8) , intent(inout) :: x_start, dgam_vec + real(KIND=r8), optional, intent(out) :: displ_first_guess + + + + real (kind=r8), dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + real(KIND=r8) :: xtmp(2) + + iarea = 4 + num_seg (iarea) = 2 + num_seg_static(iarea) = 1 + + xdep(:,1) = base_vtx(:,3,i,j,iside)+MAX(0.0_r8,displ(4,i,j,iside))*base_vec(:,4,i,j,iside)& + -displ(2,i,j,iside)*base_vec(:,5,i,j,iside) + x_start (:,6) = base_vtx(:,3,i,j,iside) + gamma = displ(1,i,j,iside) + dgam_vec(:,6) = base_vec(:,4,i,j,iside)*gamma + xtmp (: ) = x_start(:,6)+dgam_vec(:,6) + + if (present(displ_first_guess)) displ_first_guess = gamma + + x_static (:,1,iarea) = xdep(:,1) !static + dx_static(:,1,iarea) = base_vtx(:,3,i,j,iside)-xdep(:,1) !static + + x (:,1,iarea) = base_vtx(:,3,i,j,iside) !static - line 2 + dx (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2 + + x (:,2,iarea) = xtmp(:) !dynamic -line 2 + dx (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2 + end subroutine define_area4 + + subroutine define_area3_center(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,& + x_start, dgam_vec,se_flux_center,displ_first_guess) + implicit none + integer, intent(in) :: i,j,iside + integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1 + integer, parameter :: num_seg_max=5 + real (kind=r8), dimension(0:7 , imin:imax,imin:imax,num_sides), intent(inout) :: displ + integer (kind=r8), dimension(1:2,11 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec + real (kind=r8), dimension(1:2, 6 , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx + + real(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static + integer, dimension(num_area), intent(inout) :: num_seg, num_seg_static + real(KIND=r8), dimension(2,8), intent(inout) :: x_start, dgam_vec + real(KIND=r8) , intent(in ) :: se_flux_center + real(KIND=r8), optional, intent(out) :: displ_first_guess + + real (kind=r8) , dimension(2,3) :: xdep !departure points + real (kind=r8) :: gamma + integer :: iarea + ! + ! xdep(2) + ! ______X______ + ! || / \ || + ! || *--/ \--* || + ! || /xdep(1) xdep(3)\ || + ! ||/ \|| + ! ======================================== + ! || || + ! + ! + ! compute departure points (xdep(1) is left; xdep(3) is right and xdep(2) is midway + ! + + xdep(:,1) = base_vtx(:,1,i,j,iside)+& + displ(0,i,j,iside)*base_vec(:,1,i,j,iside)+displ(3,i,j,iside)*base_vec(:,3,i,j,iside) + xdep(:,3) = base_vtx(:,2,i,j,iside)+& + displ(1,i,j,iside)*base_vec(:,1,i,j,iside)+displ(2,i,j,iside)*base_vec(:,2,i,j,iside) + xdep(:,2) = 0.5_r8*(xdep(:,1)+xdep(:,3)) + + gamma= se_flux_center + x_start(:,1) = ABS(base_vec(:,3,i,j,iside))*((xdep(:,2)-base_vtx(:,1,i,j,iside)))+& + base_vtx(:,1,i,j,iside) !xdep(2) - midway between departure points projected to side 1 + + dgam_vec(:,1) = gamma*base_vec(:,1,i,j,iside) + + if (present(displ_first_guess)) displ_first_guess = gamma + + xdep(:,2) = x_start(:,1)+dgam_vec(:,1) + iarea = 3 + num_seg (iarea) = 2 + num_seg_static(iarea) = 3 + + ! ______X______ + ! || 2 / \ 3 || + ! || *--/ \--* || + ! || / \ || + ! ||/ 1 5 4\|| + ! ======================================== + ! || || + ! + x_static (:,1,iarea) = base_vtx(:,1,i,j,iside) !static - line 1 + dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static - line 1 + + x (:,1,iarea) = xdep(:,1) !static - line 2 + dx (:,1,iarea) = xdep(:,2)-x(:,1,iarea) !dynamic - line 2 + + x (:,2,iarea) = xdep(:,2) !dynamic - line 3 + dx (:,2,iarea) = xdep(:,3)-x(:,2,iarea) !dynamic - line 3 + + x_static (:,2,iarea) = xdep(:,3) !static - line 4 + dx_static(:,2,iarea) = base_vtx(:,2,i,j,iside)-x_static(:,2,iarea)!static - line 4 + + x_static (:,3,iarea) = base_vtx(:,2,i,j,iside) !static - line 5 + dx_static(:,3,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static - line 5 + + end subroutine define_area3_center +end module fvm_consistent_se_cslam diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 new file mode 100644 index 0000000000..fb5105d946 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -0,0 +1,312 @@ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +!MODULE FVM_CONTROL_VOLUME_MOD---------------------------------------------CE-for FVM +! AUTHOR: Christoph Erath, 11.June 2011 ! +! This module contains everything to initialize the arrival. It also provides the ! +! interpolation points for the reconstruction (projection from one face to another ! +! when the element is on the cube edge) ! +! It also intialize the start values, see also fvm_analytic ! +!-----------------------------------------------------------------------------------! +module fvm_control_volume_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use coordinate_systems_mod, only: spherical_polar_t + use element_mod, only: element_t + use dimensions_mod, only: nc, nhe, nlev, ntrac_d, qsize_d,ne, np, nhr, ns, nhc + use dimensions_mod, only: fv_nphys, nhe_phys, nhr_phys, ns_phys, nhc_phys,fv_nphys + use dimensions_mod, only: irecons_tracer + use cam_abortutils, only: endrun + + implicit none + private + integer, parameter, private:: nh = nhr+(nhe-1) ! = 2 (nhr=2; nhe=1) + ! = 3 (nhr=2; nhe=2) + + type, public :: fvm_struct + ! fvm tracer mixing ratio: (kg/kg) + real (kind=r8) :: c(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,ntrac_d,2) + real (kind=r8) :: se_flux(1-nhe:nc+nhe,1-nhe:nc+nhe,4,nlev) + + real (kind=r8) :: dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,2) + real (kind=r8) :: dp_ref(nlev) + real (kind=r8) :: dp_ref_inverse(nlev) + real (kind=r8) :: psc(1-nhc:nc+nhc,1-nc:nc+nhc) + + real (kind=r8) :: inv_area_sphere(nc,nc) ! inverse area_sphere + real (kind=r8) :: inv_se_area_sphere(nc,nc) ! inverse area_sphere + + integer :: faceno !face number + ! number of south,....,swest and 0 for interior element + integer :: cubeboundary + + + real (kind=r8) :: displ_max(1-nhc:nc+nhc,1-nhc:nc+nhc,4) + integer :: flux_vec (2,1-nhc:nc+nhc,1-nhc:nc+nhc,4) + ! + ! + ! cartesian location of vertices for flux sides + ! + ! x-coordinate of vertex 1: vtx_cart(1,1i,j,1,1) = fvm%acartx(i) + ! y-coordinate of vertex 1: vtx_cart(1,2,i,j,2,1) = fvm%acarty(j) + ! + ! x-coordinate of vertex 2: vtx_cart(2,1,i,j) = fvm%acartx(i+1) + ! y-coordinate of vertex 2: vtx_cart(2,2,i,j) = fvm%acarty(j ) + ! + ! x-coordinate of vertex 3: vtx_cart(3,1,i,j) = fvm%acartx(i+1) + ! y-coordinate of vertex 3: vtx_cart(3,2,i,j) = fvm%acarty(j+1) + ! + ! x-coordinate of vertex 4: vtx_cart(4,1,i,j) = fvm%acartx(i ) + ! y-coordinate of vertex 4: vtx_cart(4,2,i,j) = fvm%acarty(j+1) + ! + real (kind=r8) :: vtx_cart (4,2,1-nhc:nc+nhc,1-nhc:nc+nhc) + ! + ! flux_orient(1,i,j) = panel on which control volume (i,j) is located + ! flux_orient(2,i,j) = cshift value for vertex permutation + ! + real (kind=r8) :: flux_orient(2 ,1-nhc:nc+nhc,1-nhc:nc+nhc) + ! + ! i,j: indicator function for non-existent cells (0 for corner halo and 1 elsewhere) + ! + integer :: ifct (1-nhc:nc+nhc,1-nhc:nc+nhc) + integer :: rot_matrix(2,2,1-nhc:nc+nhc,1-nhc:nc+nhc) + ! + real (kind=r8) :: dalpha, dbeta ! central-angle for gnomonic coordinates + type (spherical_polar_t) :: center_cart(nc,nc) ! center of fvm cell in gnomonic coordinates + real (kind=r8) :: area_sphere(nc,nc) ! spherical area of fvm cell + real (kind=r8) :: spherecentroid(irecons_tracer-1,1-nhc:nc+nhc,1-nhc:nc+nhc) ! centroids + ! + ! pre-computed metric terms (for efficiency) + ! + ! recons_metrics(1,:,:) = spherecentroid(1,:,:)**2 -spherecentroid(3,:,:) + ! recons_metrics(2,:,:) = spherecentroid(2,:,:)**2 -spherecentroid(4,:,:) + ! recons_metrics(3,:,:) = spherecentroid(1,:,:)*spherecentroid(2,:,:)-spherecentroid(5,:,:) + ! + real (kind=r8) :: recons_metrics(3,1-nhe:nc+nhe,1-nhe:nc+nhe) + ! + ! recons_metrics_integral(1,:,:) = 2.0_r8*spherecentroid(1,:,:)**2 -spherecentroid(3,:,:) + ! recons_metrics_integral(2,:,:) = 2.0_r8*spherecentroid(2,:,:)**2 -spherecentroid(4,:,:) + ! recons_metrics_integral(3,:,:) = 2.0_r8*spherecentroid(1,:,:)*spherecentroid(2,:,:)-spherecentroid(5,:,:) + ! + real (kind=r8) :: recons_metrics_integral(3,1-nhe:nc+nhe,1-nhe:nc+nhe) + ! + integer :: jx_min(3), jx_max(3), jy_min(3), jy_max(3) !bounds for computation + + ! provide fixed interpolation points with respect to the arrival grid for + ! reconstruction + integer :: ibase(1-nh:nc+nh,1:nhr,2) + real (kind=r8) :: halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,2) + real (kind=r8) :: centroid_stretch(7,1-nhe:nc+nhe,1-nhe:nc+nhe) !for finite-difference reconstruction + ! + ! pre-compute weights for reconstruction at cell vertices + ! + ! ! Evaluate constant order terms + ! value = fcube(a,b) + & + ! ! Evaluate linear order terms + ! recons(1,a,b) * (cartx - centroid(1,a,b)) + & + ! recons(2,a,b) * (carty - centroid(2,a,b)) + & + ! ! Evaluate second order terms + ! recons(3,a,b) * (centroid(1,a,b)**2 - centroid(3,a,b)) + & + ! recons(4,a,b) * (centroid(2,a,b)**2 - centroid(4,a,b)) + & + ! recons(5,a,b) * (centroid(1,a,b) * centroid(2,a,b) - centroid(5,a,b)) + & + ! + ! recons(3,a,b) * (cartx - centroid(1,a,b))**2 + & + ! recons(4,a,b) * (carty - centroid(2,a,b))**2 + & + ! recons(5,a,b) * (cartx - centroid(1,a,b)) * (carty - centroid(2,a,b)) + ! + real (kind=r8) :: vertex_recons_weights(1:irecons_tracer-1,4,1-nhe:nc+nhe,1-nhe:nc+nhe) + ! + ! for mapping fvm2dyn + ! + real (kind=r8) :: norm_elem_coord(2,1-nhc:nc+nhc,1-nhc:nc+nhc) + ! + !****************************************** + ! + ! separate physics grid variables + ! + !****************************************** + ! + real (kind=r8) , allocatable :: phis_physgrid(:,:) + real (kind=r8) , allocatable :: vtx_cart_physgrid(:,:,:,:) + real (kind=r8) , allocatable :: flux_orient_physgrid(:,:,:) + integer , allocatable :: ifct_physgrid(:,:) + integer , allocatable :: rot_matrix_physgrid(:,:,:,:) + real (kind=r8) , allocatable :: spherecentroid_physgrid(:,:,:) + real (kind=r8) , allocatable :: recons_metrics_physgrid(:,:,:) + real (kind=r8) , allocatable :: recons_metrics_integral_physgrid(:,:,:) + ! centroid_stretch_physgrid for finite-difference reconstruction + real (kind=r8) , allocatable :: centroid_stretch_physgrid (:,:,:) + real (kind=r8) :: dalpha_physgrid, dbeta_physgrid ! central-angle for gnomonic coordinates + type (spherical_polar_t) , allocatable :: center_cart_physgrid(:,:) ! center of fvm cell in gnomonic coordinates + real (kind=r8) , allocatable :: area_sphere_physgrid(:,:) ! spherical area of fvm cell + integer :: jx_min_physgrid(3), jx_max_physgrid(3) !bounds for computation + integer :: jy_min_physgrid(3), jy_max_physgrid(3) !bounds for computation + integer , allocatable :: ibase_physgrid(:,:,:) + real (kind=r8) , allocatable :: halo_interp_weight_physgrid(:,:,:,:) + real (kind=r8) , allocatable :: vertex_recons_weights_physgrid(:,:,:,:) + + real (kind=r8) , allocatable :: norm_elem_coord_physgrid(:,:,:) + real (kind=r8) , allocatable :: Dinv_physgrid(:,:,:,:) + + real (kind=r8) , allocatable :: fc(:,:,:,:) + real (kind=r8) , allocatable :: fc_phys(:,:,:,:) + real (kind=r8) , allocatable :: ft(:,:,:) + real (kind=r8) , allocatable :: fm(:,:,:,:) + real (kind=r8) , allocatable :: dp_phys(:,:,:) + end type fvm_struct + + public :: fvm_mesh, fvm_set_cubeboundary, allocate_physgrid_vars + + + real (kind=r8),parameter, public :: bignum = 1.0D20 + + integer, public :: n0_fvm, np1_fvm !fvm time-levels + integer, parameter, public :: fvm_supercycling = 3 + +contains + subroutine fvm_set_cubeboundary(elem, fvm) + implicit none + type (element_t) , intent(in) :: elem + type (fvm_struct), intent(inout) :: fvm + + logical :: corner + integer :: j, mynbr_cnt, mystart + integer :: nbrsface(8)! store the neighbours in north, south + + fvm%faceno=elem%FaceNum + ! write the neighbors in the structure + fvm%cubeboundary=0 + corner=.FALSE. + do j=1,8 + mynbr_cnt = elem%vertex%nbrs_ptr(j+1) - elem%vertex%nbrs_ptr(j) !length of neighbor location + mystart = elem%vertex%nbrs_ptr(j) + !NOTE: assuming that we do not have multiple corner neighbors (so not a refined mesh) + if (mynbr_cnt > 0 ) then + nbrsface(j)=elem%vertex%nbrs_face(mystart) + ! note that if the element lies on a corner, it will be at j=5,6,7,8 + if ((nbrsface(j) /= fvm%faceno) .AND. (j<5)) then + fvm%cubeboundary=j + endif + else ! corner on the cube + if (.NOT. corner) then + nbrsface(j)=-1 + fvm%cubeboundary=j + corner=.TRUE. + else + if ( ne == 0 ) then + ! dont check this condition. note that we call this code + ! generate phys grid template files, so we need to be able + ! to call create_ari() to create the subcells even though + ! cslam cant run with the unstructed ne=0 case + else + print *,'Error in fvm_CONTROL_VOLUME_MOD - Subroutine fvm_MESH_ARI: ' + call endrun('Do not allow one element per face for fvm, please increase ne!') + endif + endif + end if + end do + end subroutine fvm_set_cubeboundary + + subroutine fvm_mesh(elem, fvm) + use fvm_analytic_mod, only : compute_halo_vars + use fvm_analytic_mod, only : create_interpolation_points + use derivative_mod , only : subcell_integration + + implicit none + type (element_t), intent(in) :: elem + type (fvm_struct), intent(inout) :: fvm + integer :: i,j + real (kind=r8) :: tmp(np,np) + ! + ! initialize metric and related terms on panel + ! + call compute_halo_vars(& !input + fvm%faceno,fvm%cubeboundary,nc,nhc,nhe, & !input + fvm%jx_min,fvm%jx_max,fvm%jy_min,fvm%jy_max,&!output + fvm%flux_orient,fvm%ifct,fvm%rot_matrix) !output + do j=1,nc + do i=1,nc + fvm%norm_elem_coord(1,i,j) = elem%corners(1)%x+(i-0.5_r8)*fvm%dalpha + fvm%norm_elem_coord(2,i,j) = elem%corners(1)%y+(j-0.5_r8)*fvm%dalpha + end do + end do + + ! + ! overwrite areas for consistency with SE areas (that are O(10E-5) incorrect) + ! + tmp = 1.0_r8 + call subcell_integration(tmp, np, nc, elem%metdet,fvm%area_sphere) + ! + ! do the same for physics grid + ! + call compute_halo_vars(& + fvm%faceno,fvm%cubeboundary,fv_nphys,nhc_phys,nhe_phys,& + fvm%jx_min_physgrid,fvm%jx_max_physgrid,fvm%jy_min_physgrid,fvm%jy_max_physgrid,& + fvm%flux_orient_physgrid,fvm%ifct_physgrid,fvm%rot_matrix_physgrid) + do j=1,fv_nphys + do i=1,fv_nphys + fvm%norm_elem_coord_physgrid(1,i,j) = elem%corners(1)%x+(i-0.5_r8)*fvm%dalpha_physgrid + fvm%norm_elem_coord_physgrid(2,i,j) = elem%corners(1)%y+(j-0.5_r8)*fvm%dalpha_physgrid + end do + end do + ! + ! initialize halo interpolation variables + ! + call create_interpolation_points(elem,& + nc,nhc,nhr,ns,nh,fvm%cubeboundary,& + fvm%dalpha,fvm%dbeta,fvm%ibase,fvm%halo_interp_weight) + call create_interpolation_points(elem,& + fv_nphys,nhc_phys,nhr_phys,ns_phys,nhr_phys,fvm%cubeboundary,& + fvm%dalpha_physgrid,fvm%dbeta_physgrid,fvm%ibase_physgrid,fvm%halo_interp_weight_physgrid) + end subroutine fvm_mesh + + + subroutine allocate_physgrid_vars(fvm,par) + use cam_logfile , only : iulog + use parallel_mod , only : parallel_t + use dimensions_mod, only : nelemd + type (fvm_struct), intent(inout) :: fvm(:) + type (parallel_t), intent(in) :: par + integer :: ie + + nhc_phys = fv_nphys + nhe_phys = 0 + nhr_phys = 2 + ns_phys = MAX(fv_nphys,2) + + if(par%masterproc) then + write(iulog,*)"allocating physgrid grid vars" + write(iulog,*)"fv_nphys,nhc_phys,nhe_phys,nhr_phys,ns_phys = ",& + fv_nphys,nhc_phys,nhe_phys,nhr_phys,ns_phys + end if + + do ie=1,nelemd + allocate(fvm(ie)%phis_physgrid (fv_nphys,fv_nphys)) + allocate(fvm(ie)%vtx_cart_physgrid (4,2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + allocate(fvm(ie)%flux_orient_physgrid (2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + allocate(fvm(ie)%ifct_physgrid (1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + allocate(fvm(ie)%rot_matrix_physgrid (2,2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + + allocate(fvm(ie)%spherecentroid_physgrid(irecons_tracer-1,& + 1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + allocate(fvm(ie)%recons_metrics_physgrid (3,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys)) + allocate(fvm(ie)%recons_metrics_integral_physgrid(3,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys)) + allocate(fvm(ie)%centroid_stretch_physgrid (7,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys)) + allocate(fvm(ie)%center_cart_physgrid(fv_nphys,fv_nphys)) + allocate(fvm(ie)%area_sphere_physgrid(fv_nphys,fv_nphys)) + allocate(fvm(ie)%ibase_physgrid(1-nhr_phys:fv_nphys+nhr_phys,1:nhr_phys,2)) + allocate(fvm(ie)%halo_interp_weight_physgrid(1:ns_phys,1-nhr_phys:fv_nphys+nhr_phys,1:nhr_phys,2)) + allocate(fvm(ie)%vertex_recons_weights_physgrid(1:irecons_tracer-1,4,1-nhe_phys:fv_nphys+nhe_phys,& + 1-nhe_phys:fv_nphys+nhe_phys)) + + allocate(fvm(ie)%norm_elem_coord_physgrid(2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys )) + allocate(fvm(ie)%Dinv_physgrid ( 1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,2,2)) + + allocate(fvm(ie)%fc(nc,nc,nlev,max(ntrac_d,qsize_d))) + allocate(fvm(ie)%fc_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,max(ntrac_d,qsize_d))) + allocate(fvm(ie)%ft(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) + allocate(fvm(ie)%fm(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,2,nlev)) + allocate(fvm(ie)%dp_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) + end do + end subroutine allocate_physgrid_vars +end module fvm_control_volume_mod diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 new file mode 100644 index 0000000000..2bd5d038f2 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -0,0 +1,1152 @@ +module fvm_mapping + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: irecons_tracer + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use perf_mod, only: t_startf, t_stopf + + implicit none + private + + public :: phys2dyn_forcings_fvm, dyn2phys, dyn2phys_vector, dyn2phys_all_vars,dyn2fvm_mass_vars + public :: phys2dyn,fvm2dyn +contains + ! + ! map all mass variables from gll to fvm + ! + subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_qdp) + use dimensions_mod, only: np, nc,nlev, qsize + use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc + use dimensions_mod, only: qsize_condensate_loading, qsize_condensate_loading_idx + use fvm_control_volume_mod, only: n0_fvm + use hybrid_mod, only: hybrid_t + + type (element_t), intent(inout):: elem(:) + type(fvm_struct), intent(inout):: fvm(:) + + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + logical, intent(in) :: no_cslam + integer, intent(in) :: nets, nete, tl_f, tl_qdp + + integer :: i, j, ie, k, m_cnst,nq + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll, fld_fvm + real (kind=r8), dimension(:,:) , allocatable :: dp_fvm_tmp + real (kind=r8), dimension(np,np,nlev,qsize_condensate_loading,nets:nete) :: qgll + ! + ! for tensor product Lagrange interpolation + ! + integer :: nflds + real (kind=r8) :: tmp + logical, allocatable :: llimiter(:) + + do ie=nets,nete + do nq=1,qsize_condensate_loading + qgll(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,nq,tl_qdp)/elem(ie)%state%dp3d(:,:,:,tl_f) + end do + end do + + if (no_cslam) then + ! + !************************************* + ! + ! no cslam case: NOT SUPPORTED + ! + !************************************* + ! + nflds = qsize+3 + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) + allocate(fld_gll(np,np,nlev,nflds,nets:nete)) + allocate(llimiter(nflds)) + llimiter = .false. + llimiter(4:nflds) = .true. + do ie=nets,nete + ! + ! pack fields that need to be interpolated + ! + fld_phys(1:nhc_phys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) + ! + ! convert forcing from mass per unit area to mixing ratio per unit area + ! + do m_cnst=1,qsize + do k=1,nlev + fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & + fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,m_cnst) + end do + end do + end do + ! + ! do mapping + ! + call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) + do ie=nets,nete + elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) + elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) + elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) + end do + do ie=nets,nete + do m_cnst=1,qsize + elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie) + end do + end do + else if (nc.ne.fv_nphys) then + ! + !*********************************************************** + ! + ! using cslam and different resolution physics grid + ! + !*********************************************************** + ! + nflds = 4+ntrac + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) + allocate(fld_gll(np,np,nlev,3,nets:nete)) + allocate(llimiter(nflds)) + fld_phys = -9.99E99_r8 + + llimiter = .false. + do ie=nets,nete + ! + ! pack fields that need to be interpolated + ! + fld_phys(1:nhc_phys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,4,ie) = fvm(ie)%dp_phys(1:fv_nphys,1:fv_nphys,:) + do m_cnst=1,ntrac + fld_phys(1:fv_nphys,1:fv_nphys,:,4+m_cnst,ie) = & + fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,:,m_cnst) + end do + end do + call fill_halo_phys(elem,fld_phys,hybrid,nets,nete,nlev,nflds) + ! + ! do mapping of fu,fv,ft + ! + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,1:3,:),nets,nete,nlev,3,fvm,llimiter(1:3),2,.true.) + do ie=nets,nete + elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) + elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) + elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) + end do + deallocate(fld_gll) + ! + ! map fq from phys to fvm + ! + allocate(dp_fvm_tmp(nc,nc)) + do ie=nets,nete + do k=1,nlev + ! + ! note that phys2fvm assumes that halo has already been filled + ! + call phys2fvm(ie,fvm(ie),fld_phys(:,:,k,4,ie),dp_fvm_tmp(:,:),& + fld_phys(:,:,k,5:4+ntrac,ie),fvm(ie)%fc(:,:,k,1:ntrac),ntrac,.false.) + ! + ! convert to mixing ratio tendency (%fc holds tracer mass change) + ! + dp_fvm_tmp(:,:) = 1.0_r8/fvm(ie)%dp_fvm(1:nc,1:nc,k,n0_fvm) + do m_cnst=1,ntrac + fvm(ie)%fc(:,:,k,m_cnst) = fvm(ie)%fc(:,:,k,m_cnst)*dp_fvm_tmp(:,:) + end do + end do + end do + ! + ! overwrite SE Q with cslam Q + ! + nflds = qsize_condensate_loading + allocate(fld_gll(np,np,nlev,nflds,nets:nete)) + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) + do ie=nets,nete + ! + ! compute cslam updated Q value + ! + do m_cnst=1,qsize_condensate_loading + fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,qsize_condensate_loading_idx(m_cnst),n0_fvm)+& + fvm(ie)%fc(1:nc,1:nc,:,qsize_condensate_loading_idx(m_cnst)) + enddo + fld_fvm(1:nc,1:nc,:,nflds,ie) = fvm(ie)%c(1:nc,1:nc,:,qsize_condensate_loading_idx(1),n0_fvm) + end do + llimiter(1:qsize_condensate_loading) = .false. + call fvm2dyn(elem,fld_fvm,fld_gll(:,:,:,1:nflds,:),hybrid,nets,nete,nlev,nflds,fvm,llimiter(1:nflds)) + ! + ! fld_gll now holds q cslam value on gll grid + ! + ! convert fld_gll to increment (q_new-q_old)*dp + ! + do ie=nets,nete + do m_cnst=1,qsize_condensate_loading + elem(ie)%derived%fq(:,:,:,m_cnst) =& + fld_gll(:,:,:,m_cnst,ie)-qgll(:,:,:,m_cnst,ie) + end do + end do + deallocate(fld_fvm) + else + ! + ! + !***************************************************************************************** + ! + ! using cslam with same physics grid resolution as cslam resolution + ! + !***************************************************************************************** + ! + nflds = 3+qsize_condensate_loading + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) + allocate(fld_gll(np,np,nlev,nflds,nets:nete)) + allocate(llimiter(nflds)) + llimiter(1:nflds) = .false. + do ie=nets,nete + ! + ! pack fields that need to be interpolated + ! + fld_phys(1:nhc_phys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) + fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) + ! + ! compute cslam mixing ratio with physics update + ! + do m_cnst=1,qsize_condensate_loading + do k=1,nlev + fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & + fvm(ie)%c(1:fv_nphys,1:fv_nphys,k,qsize_condensate_loading_idx(m_cnst),n0_fvm)+& + fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,qsize_condensate_loading_idx(m_cnst)) + end do + end do + end do + ! + ! do mapping + ! + call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) + do ie=nets,nete + elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) + elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) + elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) + end do + do ie=nets,nete + do m_cnst=1,qsize_condensate_loading + ! + ! convert fq so that it will effectively overwrite SE q with CSLAM q + ! + elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie)-& + qgll(:,:,:,m_cnst,ie) + end do + fvm(ie)%fc(1:nc,1:nc,:,1:ntrac) = fvm(ie)%fc_phys(1:nc,1:nc,:,1:ntrac) + end do + end if + deallocate(fld_phys,llimiter,fld_gll) + end subroutine phys2dyn_forcings_fvm + + subroutine fvm2dyn(elem,fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter) + use dimensions_mod, only: np, nhc, nc + use hybrid_mod , only: hybrid_t + + use bndry_mod , only: ghost_exchange + use edge_mod , only: initghostbuffer, freeghostbuffer,ghostpack,ghostunpack + use edgetype_mod , only: edgebuffer_t + + + integer , intent(in) :: nets,nete,num_flds,numlev + real (kind=r8), intent(inout) :: fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,numlev,num_flds,nets:nete) + real (kind=r8), intent(out) :: fld_gll(np,np,numlev,num_flds,nets:nete) + type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) + type (element_t) , intent(in) :: elem(nets:nete) + type(fvm_struct) , intent(in) :: fvm(nets:nete) + logical , intent(in) :: llimiter(num_flds) + + integer :: ie, iwidth + type (edgeBuffer_t) :: cellghostbuf + ! + !********************************************* + ! + ! halo exchange + ! + !********************************************* + ! + call t_startf('fvm2dyn:initbuffer') + call initghostbuffer(hybrid%par,cellghostbuf,elem,numlev*num_flds,nhc,nc) + call t_stopf('fvm2dyn:initbuffer') + do ie=nets,nete + call ghostpack(cellghostbuf, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,cellghostbuf) + do ie=nets,nete + call ghostunpack(cellghostbuf, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call freeghostbuffer(cellghostbuf) + ! + ! mapping + ! + iwidth=2 + do ie=nets,nete + call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,nc,nhc,numlev,num_flds,fld_fvm(:,:,:,:,ie),& + fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord) + end do + end subroutine fvm2dyn + + + subroutine fill_halo_phys(elem,fld_phys,hybrid,nets,nete,num_lev,num_flds) + use dimensions_mod, only: nhc_phys, fv_nphys + use hybrid_mod , only: hybrid_t + use bndry_mod , only: ghost_exchange + use edge_mod , only: initghostbuffer, freeghostbuffer, ghostpack, ghostunpack + use edgetype_mod , only: edgebuffer_t + + + integer , intent(in) :: nets,nete,num_lev,num_flds + real (kind=r8), intent(inout) :: fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,num_lev,num_flds, & + nets:nete) + type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) + type (element_t) , intent(inout) :: elem(:) + + integer :: ie + type (edgeBuffer_t) :: cellghostbuf + ! + !********************************************* + ! + ! halo exchange + ! + !********************************************* + ! + call t_startf('fvm:fill_halo_phys') + call t_startf('fvm:fill_halo_phys:initbuffer') + call initghostbuffer(hybrid%par,cellghostbuf,elem,num_lev*num_flds,nhc_phys,fv_nphys) + call t_stopf('fvm:fill_halo_phys:initbuffer') + do ie=nets,nete + call ghostpack(cellghostbuf, fld_phys(:,:,:,:,ie),num_lev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,cellghostbuf) + do ie=nets,nete + call ghostunpack(cellghostbuf, fld_phys(:,:,:,:,ie),num_lev*num_flds,0,ie) + end do + call freeghostbuffer(cellghostbuf) + ! + call t_stopf('fvm:fill_halo_phys') + end subroutine fill_halo_phys + + ! + ! must call fill_halo_phys before calling this subroutine + ! + subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm,llimiter,istart_vector,halo_filled) + use dimensions_mod, only: np, nhc_phys, fv_nphys + use hybrid_mod, only : hybrid_t + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + integer , intent(in) :: nets,nete,num_flds,num_lev + real (kind=r8), intent(inout) :: fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,num_lev,num_flds, & + nets:nete) + real (kind=r8), intent(out) :: fld_gll(np,np,num_lev,num_flds,nets:nete) + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(in) :: fvm(:) + integer, optional , intent(in) :: istart_vector + logical , intent(in) :: llimiter(num_flds) + logical, optional , intent(in) :: halo_filled + + integer :: i, j, ie, k, iwidth + real (kind=r8) :: v1,v2 + + if (present(halo_filled)) then + if (.not.halo_filled) call fill_halo_phys(elem,fld_phys,hybrid,nets,nete,num_lev,num_flds) + else + call fill_halo_phys(elem,fld_phys,hybrid,nets,nete,num_lev,num_flds) + end if + if (present(istart_vector)) then + do ie=nets,nete + do k=1,num_lev + do j=1-nhc_phys,fv_nphys+nhc_phys + do i=1-nhc_phys,fv_nphys+nhc_phys + ! + ! convert lat-lon vectors to contra-variant gnomonic + ! + v1 = fld_phys(i,j,k,istart_vector ,ie) + v2 = fld_phys(i,j,k,istart_vector+1,ie) + fld_phys(i,j,k,istart_vector ,ie)=fvm(ie)%Dinv_physgrid(i,j,1,1)*v1 + fvm(ie)%Dinv_physgrid(i,j,1,2)*v2 + fld_phys(i,j,k,istart_vector+1,ie)=fvm(ie)%Dinv_physgrid(i,j,2,1)*v1 + fvm(ie)%Dinv_physgrid(i,j,2,2)*v2 + end do + end do + end do + end do + end if + ! + ! mapping + ! + iwidth=2 + if (fv_nphys==1) iwidth=1 + do ie=nets,nete + call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,fv_nphys,nhc_phys,num_lev,num_flds,fld_phys(:,:,:,:,ie),& + fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord_physgrid) + end do + + if (present(istart_vector)) then + ! + ! convert contra-variant to lat-lon + ! + do ie=nets,nete + do k=1,num_lev + do j=1,np + do i=1,np + v1 = fld_gll(i,j,k,istart_vector ,ie) + v2 = fld_gll(i,j,k,istart_vector+1,ie) + fld_gll(i,j,k,istart_vector ,ie) = elem(ie)%D(i,j,1,1)*v1 + elem(ie)%D(i,j,1,2)*v2 + fld_gll(i,j,k,istart_vector+1,ie) = elem(ie)%D(i,j,2,1)*v1 + elem(ie)%D(i,j,2,2)*v2 + end do + end do + end do + end do + end if + end subroutine phys2dyn + + + ! + ! map all mass variables from gll to fvm + ! + subroutine dyn2fvm_mass_vars(dp_gll,ps_gll,q_gll,& + dp_fvm,ps_fvm,q_fvm,num_trac,metdet,inv_area) + use dimensions_mod, only: np, nc,nlev + integer, intent(in) :: num_trac + real (kind=r8), dimension(np,np,nlev) , intent(in) :: dp_gll + real (kind=r8), dimension(np,np,nlev,num_trac), intent(in) :: q_gll + real (kind=r8), dimension(np,np) , intent(in) :: ps_gll + + + real (kind=r8), dimension(nc,nc,nlev) , intent(inout) :: dp_fvm + real (kind=r8), dimension(nc,nc,nlev,num_trac), intent(inout) :: q_fvm + real (kind=r8), dimension(nc,nc) , intent(inout) :: ps_fvm + real (kind=r8), dimension(nc,nc) , intent(out) :: inv_area + + real (kind=r8), intent(in) :: metdet(np,np) + + real (kind=r8) :: se_area_sphere(nc,nc), tmp(np,np) + real (kind=r8) :: inv_darea_dp_fvm(nc,nc) + integer :: k,m_cnst + + tmp = 1.0_r8 + se_area_sphere = dyn2fvm(tmp,metdet) + inv_area = 1.0_r8/se_area_sphere + + ps_fvm(:,:) = dyn2fvm(ps_gll,metdet,inv_area) + do k=1,nlev + dp_fvm(:,:,k) = dyn2fvm(dp_gll(:,:,k),metdet,inv_area) + inv_darea_dp_fvm = inv_area/dp_fvm(:,:,k) + do m_cnst=1,num_trac + q_fvm(:,:,k,m_cnst) = & + dyn2fvm(q_gll(:,:,k,m_cnst)*dp_gll(:,:,k),metdet,& + inv_darea_dp_fvm,q_gll(:,:,k,m_cnst)) + end do + end do + end subroutine dyn2fvm_mass_vars + ! + ! this subroutine assumes that the fvm halo has already been filled + ! (if nc/=fv_nphys) + ! + subroutine dyn2phys_all_vars(ie,dp_gll,T_gll,omega_gll,& + dp_fvm,q_fvm,num_trac,num_trac_gll,metdet,lcslam,fvm,ptop,& + dp3d_phys,ps_phys,q_phys,T_phys,omega_phys,phis_phys) + use dimensions_mod, only: np, nc,nlev,fv_nphys,nhc + use dp_mapping, only: nphys_pts + + integer, intent(in) :: ie,num_trac,num_trac_gll + real (kind=r8), dimension(np,np,nlev) , intent(in) :: dp_gll,T_gll,omega_gll + + real (kind=r8), dimension(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev) , intent(inout) :: dp_fvm + real (kind=r8), dimension(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,num_trac), intent(inout) :: q_fvm + type(fvm_struct) , intent(in) :: fvm + + real (kind=r8), intent(in) :: metdet(np,np) + logical , intent(in) :: lcslam + real (kind=r8), intent(in) :: ptop + + real (kind=r8), dimension(nphys_pts) , intent(out) :: ps_phys,phis_phys + real (kind=r8), dimension(nphys_pts,nlev) , intent(out) :: dp3d_phys,T_phys,omega_phys + real (kind=r8), dimension(nphys_pts,nlev,num_trac) , intent(out) :: q_phys + + + real (kind=r8) :: tmp(np,np) + real (kind=r8), dimension(fv_nphys,fv_nphys) :: inv_area,inv_darea_dp_phys,se_area_sphere,dp3d_tmp + real (kind=r8), dimension(fv_nphys,fv_nphys) :: dp_phys_tmp + real (kind=r8), dimension(fv_nphys,fv_nphys,num_trac) :: q_phys_tmp + + integer :: k,m_cnst + + tmp = 1.0_r8 + se_area_sphere = dyn2phys(tmp,metdet) + inv_area = 1.0_r8/se_area_sphere + phis_phys(:) = RESHAPE(fvm%phis_physgrid,SHAPE(phis_phys(:))) + + ps_phys = ptop + do k=1,nlev + dp3d_tmp = dyn2phys(dp_gll(:,:,k),metdet,inv_area) + inv_darea_dp_phys = inv_area/dp3d_tmp + T_phys(:,k) = RESHAPE(dyn2phys(T_gll(:,:,k)*dp_gll(:,:,k),metdet,& + inv_darea_dp_phys),SHAPE(T_phys(:,k))) + Omega_phys(:,k) = RESHAPE(dyn2phys(Omega_gll(:,:,k),metdet,inv_area),SHAPE(Omega_phys(:,k))) + + if (nc.ne.fv_nphys) then + call fvm2phys(ie,fvm,dp_fvm(:,:,k),dp_phys_tmp,q_fvm(:,:,k,:),q_phys_tmp,num_trac) + dp3d_phys(:,k) = RESHAPE(dp_phys_tmp,SHAPE(dp3d_phys(:,k))) + ps_phys(:) = ps_phys(:)+RESHAPE(dp_phys_tmp,SHAPE(ps_phys(:))) + do m_cnst=1,num_trac + q_phys(:,k,m_cnst) = RESHAPE(q_phys_tmp(:,:,m_cnst),SHAPE(q_phys(:,k,m_cnst))) + end do + else + ! + ! no mapping needed - just copy fields into physics structure + ! + dp3d_phys(:,k) = RESHAPE(dp_fvm(1:nc,1:nc,k),SHAPE(dp3d_phys(:,k))) + ps_phys(:) = ps_phys(:)+RESHAPE(dp_fvm(1:nc,1:nc,k),SHAPE(ps_phys(:))) + do m_cnst=1,num_trac + q_phys(:,k,m_cnst) = RESHAPE(q_fvm(1:nc,1:nc,k,m_cnst),SHAPE(q_phys(:,k,m_cnst))) + end do + end if + end do + end subroutine dyn2phys_all_vars + + function dyn2phys(qdp_gll,metdet,inv_dp_darea_phys,q_gll) result(qdp_phys) + use dimensions_mod, only: np, nc, fv_nphys + use derivative_mod, only: subcell_integration + real (kind=r8), intent(in) :: qdp_gll(np,np) + real (kind=r8) :: qdp_phys(fv_nphys,fv_nphys) + real (kind=r8), intent(in) :: metdet(np,np) + real (kind=r8), intent(in), optional :: inv_dp_darea_phys(fv_nphys,fv_nphys) + real (kind=r8), intent(in), optional :: q_gll(np,np) + integer :: i,j + real (kind=r8) :: min_val, max_val + + call subcell_integration(qdp_gll(:,:), np, fv_nphys, metdet,qdp_phys,nc.ne.fv_nphys) + if (present(inv_dp_darea_phys)) then + ! + ! convert qdp to q + ! + qdp_phys = qdp_phys*inv_dp_darea_phys + ! + ! simple limiter + ! + if (present(q_gll)) then + min_val = minval(q_gll) + max_val = maxval(q_gll) + do j = 1, fv_nphys + do i = 1, fv_nphys + ! + ! simple limiter: only coded for nc=3 and np4 + ! + qdp_phys(i,j) = max(min_val,min(max_val,qdp_phys(i,j))) + end do + end do + end if + end if + end function dyn2phys + + + function dyn2fvm(qdp_gll,metdet,inv_dp_darea_phys,q_gll) result(qdp_phys) + use dimensions_mod, only: np, nc + use derivative_mod, only: subcell_integration + real (kind=r8), intent(in) :: qdp_gll(np,np) + real (kind=r8) :: qdp_phys(nc,nc) + real (kind=r8), intent(in) :: metdet(np,np) + real (kind=r8), intent(in), optional :: inv_dp_darea_phys(nc,nc) + real (kind=r8), intent(in), optional :: q_gll(np,np) + integer :: i,j + real (kind=r8) :: min_val, max_val + + call subcell_integration(qdp_gll(:,:), np, nc, metdet,qdp_phys) + if (present(inv_dp_darea_phys)) then + ! + ! convert qdp to q + ! + qdp_phys = qdp_phys*inv_dp_darea_phys + ! + ! simple limiter + ! + if (present(q_gll)) then + do j = 1, nc + do i = 1, nc + ! + ! simple limiter: only coded for nc=3 and np4 + ! + min_val = minval(q_gll(i:i+1,j:j+1)) + max_val = maxval(q_gll(i:i+1,j:j+1)) + qdp_phys(i,j) = max(min_val,min(max_val,qdp_phys(i,j))) + end do + end do + end if + end if + end function dyn2fvm + + function dyn2phys_vector(v_gll,elem) result(v_phys) + use dimensions_mod, only: np, nlev, fv_nphys + use interpolate_mod,only: interpdata_t,interpolate_2d,interpolate_t + use cube_mod ,only: dmap + use control_mod ,only: cubed_sphere_map + + type (interpdata_t):: interpdata + type (element_t), intent(in) :: elem + type (interpolate_t) , target :: interp_p + real (kind=r8), intent(in) :: v_gll(np,np,2,nlev) + real (kind=r8) :: v_phys(fv_nphys*fv_nphys,2,nlev) + + integer :: i,j,k + + ! Local variables + real (kind=r8) :: fld_contra(np,np,2,nlev) ! vector field + + real (kind=r8) :: v1,v2 + real (kind=r8) :: D(2,2,fv_nphys*fv_nphys) ! derivative of gnomonic mapping + ! + ! this could be done at initialization and does not need to be repeated + ! + call setup_interpdata_for_gll_to_phys_vec_mapping(interpdata, interp_p) + ! convert to contra + do k=1,nlev + do j=1,np + do i=1,np + ! latlon->contra + fld_contra(i,j,1,k) = elem%Dinv(i,j,1,1)*v_gll(i,j,1,k) + elem%Dinv(i,j,1,2)*v_gll(i,j,2,k) + fld_contra(i,j,2,k) = elem%Dinv(i,j,2,1)*v_gll(i,j,1,k) + elem%Dinv(i,j,2,2)*v_gll(i,j,2,k) + enddo + enddo + end do + + do k=1,nlev + do i=1,interpdata%n_interp + v_phys(i,1,k)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,1,k),interp_p,np) + v_phys(i,2,k)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,2,k),interp_p,np) + end do + end do + do i=1,interpdata%n_interp + ! convert fld from contra->latlon + call dmap(D(:,:,i),interpdata%interp_xy(i)%x,interpdata%interp_xy(i)%y,& + elem%corners3D,cubed_sphere_map,elem%corners,elem%u2qmap,elem%facenum) + end do + do k=1,nlev + do i=1,interpdata%n_interp + ! convert fld from contra->latlon + v1 = v_phys(i,1,k) + v2 = v_phys(i,2,k) + + v_phys(i,1,k)=D(1,1,i)*v1 + D(1,2,i)*v2 + v_phys(i,2,k)=D(2,1,i)*v1 + D(2,2,i)*v2 + end do + end do + end function dyn2phys_vector + + subroutine setup_interpdata_for_gll_to_phys_vec_mapping(interpdata,interp_p) + ! + ! initialize interpolation data structures to interpolate to phys grid + ! using interpolate_mod subroutines + ! + use interpolate_mod, only: interpolate_t, interpdata_t, interpolate_create + use dimensions_mod, only : np + use quadrature_mod, only : quadrature_t, gausslobatto + use dimensions_mod, only : fv_nphys + type (interpdata_t) , intent(out) :: interpdata + type (interpolate_t) , intent(out), target :: interp_p + + ! local + type (quadrature_t) :: gp_quadrature + integer i,j,ioff,ngrid + real (kind=r8) :: dx + + ngrid = fv_nphys*fv_nphys + interpdata%n_interp=ngrid + ! + ! initialize interpolation stuff related to basis functions + ! + gp_quadrature = gausslobatto(np) + call interpolate_create(gp_quadrature,interp_p) + allocate(interpdata%interp_xy(ngrid)) + allocate(interpdata%ilat(ngrid) ) + allocate(interpdata%ilon(ngrid) ) + ! + !WARNING: THIS CODE INTERFERES WITH LAT-LON OUTPUT + ! OF REGULAR SE IF nc>0 + ! + ioff=1 + dx = 2.0_r8/dble(fv_nphys) + do j=1,fv_nphys + do i=1,fv_nphys + interpdata%interp_xy(ioff)%x = -1_r8+(i-0.5_r8)*dx + interpdata%interp_xy(ioff)%y = -1_r8+(j-0.5_r8)*dx + interpdata%ilon(ioff) = i + interpdata%ilat(ioff) = j + ioff=ioff+1 + enddo + enddo + end subroutine setup_interpdata_for_gll_to_phys_vec_mapping + + + function lagrange_1d(src_grid,src_val,ngrid,dst_point,iwidth) result(val) + integer , intent(in) :: ngrid,iwidth + real (kind=r8), intent(in) :: src_grid(ngrid), src_val(ngrid) + real (kind=r8) :: val + + real (kind=r8), intent(in) :: dst_point + + integer :: iref, j,k + real (kind=r8) :: w(ngrid) + + if (dst_point.LE.src_grid(1)) then + iref=1 + else + iref=1 + do while (dst_point>src_grid(iref)) + iref = iref + 1 + if (iref>ngrid) then + exit + end if + end do + iref=iref-1 + end if + + iref=MIN(MAX(iref,iwidth),ngrid-iwidth) + + w = 1.0_r8 + do j=iref-(iwidth-1),iref+iwidth + do k=iref-(iwidth-1),iref+iwidth + if (k.ne.j) then + w(j)=w(j)*(dst_point-src_grid(k))/(src_grid(j)-src_grid(k)) + end if + end do + end do + + val=0.0_r8 + do j=iref-(iwidth-1),iref+iwidth + val=val+w(j)*src_val(j) + end do + end function lagrange_1d + + subroutine tensor_lagrange_interp(cubeboundary,np,nc,nhc,num_lev,nflds,psi,interp_value,llimiter,iwidth,norm_elem_coord) + use control_mod, only : north, south, east, west, neast, nwest, seast, swest + implicit none + + integer , intent(in) :: cubeboundary,nc, np, iwidth,nhc,num_lev,nflds + logical , intent(in) :: llimiter(nflds) !apply limiter + real (kind=r8), intent(inout) :: psi(1-nhc:nc+nhc,1-nhc:nc+nhc,num_lev,nflds) !fvm grid values with filled halo + real (kind=r8), intent(out) :: interp_value(np,np,num_lev,nflds) !interpolated field + real (kind=r8), intent(in) :: norm_elem_coord(2,1-nhc:nc+nhc,1-nhc:nc+nhc) + integer :: which_nc_cell(np) + + real (kind=r8):: dx,gll_points(np) + real (kind=r8):: nc_points(1-nc:nc+nc) + + real (kind=r8):: value(1-iwidth:nc+iwidth) + real (kind=r8):: val_tmp(1-nhc:nc+nhc,1-nhc:nc+nhc) + + real (kind=r8):: min_value(np,np,num_lev,nflds), max_value(np,np,num_lev,nflds) + + integer :: imin(1-nhc:nc+nhc), imax(1-nhc:nc+nhc) + integer :: k,i,j,isearch,igll,jgll,jrow,h,irow,itr + + gll_points(1) = -1.0_r8 + gll_points(2) = -sqrt(1.0_r8/5.0_r8) + gll_points(3) = sqrt(1.0_r8/5.0_r8) + gll_points(4) = 1.0_r8 + + dx = 2_r8/dble(nc) + do k=1-nc,2*nc + nc_points(k) = -1.0_r8+dx*0.5_r8+dble(k-1)*dx + end do + ! + ! find fvm point surrounding gll points for simple limiter + ! + do k=1,np + do isearch=0,nc+1 + if (nc_points(isearch)4) then + h=1 + select case(cubeboundary) + case (nwest) + psi(0,nc+h ,:,itr) = psi(1-h,nc ,:,itr) + psi(1-h,nc+1,:,itr) = psi(1 ,nc+h,:,itr) + case (swest) + psi(1-h,0,:,itr) = psi(1,1-h,:,itr) + psi(0,1-h,:,itr) = psi(1-h,1,:,itr) + case (seast) + psi(nc+h,0,:,itr) = psi(nc,1-h,:,itr) + psi(nc+1,1-h,:,itr) = psi(nc+h,1,:,itr) + case (neast) + psi(nc+h,nc+1,:,itr) = psi(nc,nc+h,:,itr) + psi(nc+1,nc+h,:,itr) = psi(nc+h,nc,:,itr) + end select + end if + do k=1,num_lev + do j=1,np + do i=1,np + max_value(i,j,k,itr) = max(& + psi(which_nc_cell(i) ,which_nc_cell(j) ,k,itr),& + psi(which_nc_cell(i)+1,which_nc_cell(j) ,k,itr),& + psi(which_nc_cell(i) ,which_nc_cell(j)+1,k,itr),& + psi(which_nc_cell(i)+1,which_nc_cell(j)+1,k,itr) & + ) + min_value(i,j,k,itr) = min(& + psi(which_nc_cell(i) ,which_nc_cell(j) ,k,itr),& + psi(which_nc_cell(i)+1,which_nc_cell(j) ,k,itr),& + psi(which_nc_cell(i) ,which_nc_cell(j)+1,k,itr),& + psi(which_nc_cell(i)+1,which_nc_cell(j)+1,k,itr) & + ) + end do + end do + end do + end if + end do + + imin=1-nhc + imax=nc+nhc + ! + ! special corner treatment + ! + if (cubeboundary==swest) then + do itr=1,nflds + do k=1,num_lev + do jrow=1,nc+iwidth + ! + ! cubic along constant x (i=irow) in west halo to fvm points in halo + ! + do irow=1-iwidth,0 + val_tmp(irow,jrow) = lagrange_1d(norm_elem_coord(2,irow,1:nc+nhc),psi(irow,1:nc+nhc,k,itr),nc+nhc,& + norm_elem_coord(2,1,jrow),iwidth) + end do + end do + psi(1-iwidth:0,1:nc+iwidth,k,itr) = val_tmp(1-iwidth:0,1:nc+iwidth) + enddo + end do + imin(1-nhc:0) = 1 + end if + if (cubeboundary==nwest) then + do itr=1,nflds + do k=1,num_lev + do jrow=1-iwidth,nc + ! + ! cubic along constant x (i=irow) in west halo to fvm points in halo + ! + do irow=1-iwidth,0 + val_tmp(irow,jrow) = lagrange_1d(norm_elem_coord(2,irow,1-nhc:nc),psi(irow,1-nhc:nc,k,itr),nc+nhc,& + norm_elem_coord(2,1,jrow),iwidth) + end do + end do + psi(1-iwidth:0,1-iwidth:nc,k,itr) = val_tmp(1-iwidth:0,1-iwidth:nc) + end do + end do + imin(nc+1:nc+nhc) = 1 + end if + + if (cubeboundary==seast) then + do itr=1,nflds + do k=1,num_lev + do jrow=1,nc+iwidth + value=0.0_r8 + ! + ! cubic along constant y in ease halo to fvm points in halo + ! + do irow=nc+1,nc+iwidth + val_tmp(irow,jrow) = lagrange_1d(norm_elem_coord(2,irow,1:nc+nhc),psi(irow,1:nc+nhc,k,itr),nc+nhc,& + norm_elem_coord(2,1,jrow),iwidth) + end do + end do + psi(nc+1:nc+iwidth,1:nc+iwidth,k,itr) = val_tmp(nc+1:nc+iwidth,1:nc+iwidth) + end do + end do + imax(1-nhc:0) = nc + end if + + if (cubeboundary==neast) then + do itr=1,nflds + do k=1,num_lev + do jrow=1-iwidth,nc + ! + ! cubic along constant y in ease halo to fvm points in halo + ! + do irow=nc+1,nc+iwidth + val_tmp(irow,jrow) = lagrange_1d(norm_elem_coord(2,irow,1-nhc:nc),psi(irow,1-nhc:nc,k,itr),nc+nhc,& + norm_elem_coord(2,1,jrow),iwidth) + end do + end do + psi(nc+1:nc+iwidth,1-iwidth:nc,k,itr) = val_tmp(nc+1:nc+iwidth,1-iwidth:nc) + end do + end do + imax(nc+1:nc+nhc) = nc + end if + ! + ! mapping + ! + ! + if (cubeboundary==0.or.cubeboundary==north.or.cubeboundary==south.or.& + cubeboundary==swest.or.cubeboundary==nwest.or.& + cubeboundary==seast.or.cubeboundary==neast) then + do itr=1,nflds + do k=1,num_lev + do igll=1,np + ! + ! cubic along constant y (j=jrow) + ! + do jrow=1-iwidth,nc+iwidth + value(jrow) = lagrange_1d(norm_elem_coord(1,imin(jrow):imax(jrow),jrow),psi(imin(jrow):imax(jrow),jrow,k,itr),& + imax(jrow)-imin(jrow)+1,gll_points(igll),iwidth) + end do + do jgll=1,np + interp_value(igll,jgll,k,itr) = lagrange_1d(norm_elem_coord(2,1,1-iwidth:nc+iwidth),value,nc+2*iwidth,& + gll_points(jgll),iwidth) + end do + end do + end do + end do + else if (cubeboundary==east.or.cubeboundary==west) then + do itr=1,nflds + do k=1,num_lev + do jgll=1,np + ! + ! cubic along constant x (i=irow) + ! + do irow=1-iwidth,nc+iwidth + value(irow) = lagrange_1d(norm_elem_coord(2,irow,1-nhc:nc+nhc),psi(irow,1-nhc:nc+nhc,k,itr),nc+2*nhc,& + gll_points(jgll),iwidth) + end do + do igll=1,np + interp_value(igll,jgll,k,itr) = lagrange_1d(norm_elem_coord(1,1-iwidth:nc+iwidth,1),value,nc+2*iwidth,& + gll_points(igll),iwidth) + end do + end do + end do + end do + end if + do itr=1,nflds + if (llimiter(itr)) then + do k=1,num_lev + do j=1,np + do i=1,np + interp_value(i,j,k,itr)=max(min_value(i,j,k,itr),min(max_value(i,j,k,itr),interp_value(i,j,k,itr))) + end do + enddo + end do + end if + end do + end subroutine tensor_lagrange_interp + + + subroutine fvm2phys(ie,fvm,dp_fvm,dp_phys,q_fvm,q_phys,num_trac) + use dimensions_mod, only: nc,nhr,nhc,ns,fv_nphys + use fvm_reconstruction_mod, only: reconstruction + ! + ! weights must be initialized in fvm2phys_init before using these functions + ! + use dp_mapping, only: weights_all_fvm2phys, weights_eul_index_all_fvm2phys + use dp_mapping, only: weights_lgr_index_all_fvm2phys, jall_fvm2phys + ! + ! setting nhe=0 because we do not need reconstruction outside of element + ! + integer, parameter :: nhe_local=0 + integer, parameter :: nh = nhr!+(nhe-1) ! = 2 (nhr=2; nhe_local=1),! = 3 (nhr=2; nhe_local=2) + + type(fvm_struct) , intent(in) :: fvm + integer , intent(in) :: ie + integer , intent(in) :: num_trac + real (kind=r8), intent(inout) :: dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,1) + real (kind=r8), intent(out) :: dp_phys(fv_nphys,fv_nphys) + + real (kind=r8), intent(inout) :: q_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,num_trac) + real (kind=r8), intent(out) :: q_phys(fv_nphys,fv_nphys,num_trac) + + real (kind=r8) :: recons (irecons_tracer,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local,1) + real (kind=r8) :: recons_q (irecons_tracer,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local, & + num_trac) + + real (kind=r8) :: recons_tmp(irecons_tracer) + + logical :: llimiter(1),llimiter_q(num_trac) + integer :: h,jx,jy,jdx,jdy,m_cnst,nht_local + integer :: jx_min_local(3), jx_max_local(3), jy_min_local(3), jy_max_local(3) + real (kind=r8) :: dp_phys_inv(fv_nphys,fv_nphys),dp_tmp + + llimiter=.false. + nht_local=nhe_local+nhr !total halo width where reconstruction is needed (nht<=nc) - phl + ! + ! to accomodate nhe=0 make sure nothing is done for neighboring panel recontructions + ! + jx_min_local(1) = 1 ; jx_max_local(1) = nc+1 + jy_min_local(1) = 1 ; jy_max_local(1) = nc+1 + jx_min_local(2) = 0 ; jx_max_local(2) = -1 + jy_min_local(2) = 0 ; jy_max_local(2) = -1 + jx_min_local(3) = 0 ; jx_max_local(3) = -1 + jy_min_local(3) = 0 ; jy_max_local(3) = -1 + + call reconstruction(dp_fvm,recons,irecons_tracer,llimiter,1,& + nc,nhe_local,nhr,nhc,nht_local,ns,nh,& + jx_min_local,jx_max_local,jy_min_local,jy_max_local,& + fvm%cubeboundary,fvm%halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,:),fvm%ibase(1-nh:nc+nh,1:nhr,:),& + fvm%spherecentroid(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%recons_metrics(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%recons_metrics_integral(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local) ,& + fvm%rot_matrix,fvm%centroid_stretch(1:7,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%vertex_recons_weights(1:irecons_tracer-1,:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%vtx_cart(:,:,1-nhc:nc+nhc,1-nhc:nc+nhc)) + + dp_phys = 0.0_r8 + do h=1,jall_fvm2phys(ie) + jx = weights_lgr_index_all_fvm2phys(h,1,ie) + jy = weights_lgr_index_all_fvm2phys(h,2,ie) + jdx = weights_eul_index_all_fvm2phys(h,1,ie) + jdy = weights_eul_index_all_fvm2phys(h,2,ie) + dp_phys(jx,jy) = dp_phys(jx,jy) + SUM(weights_all_fvm2phys(h,:,ie)*recons(:,jdx,jdy,1)) + end do + + llimiter_q=.true. + call reconstruction(q_fvm,recons_q,irecons_tracer,llimiter_q,num_trac,& + nc,nhe_local,nhr,nhc,nht_local,ns,nh,& + jx_min_local,jx_max_local,jy_min_local,jy_max_local,& + fvm%cubeboundary,fvm%halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,:),fvm%ibase(1-nh:nc+nh,1:nhr,:),& + fvm%spherecentroid(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%recons_metrics(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%recons_metrics_integral(:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local) ,& + fvm%rot_matrix,fvm%centroid_stretch(1:7,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%vertex_recons_weights(1:irecons_tracer-1,:,1-nhe_local:nc+nhe_local,1-nhe_local:nc+nhe_local),& + fvm%vtx_cart(:,:,1-nhc:nc+nhc,1-nhc:nc+nhc)) + ! + ! q-dp coupling as described in equation (55) in Appendinx B of + ! Nair and Lauritzen, 2010: A Class of Deformational Flow Test Cases for Linear Transport Problems on the Sphere. + ! J. Comput. Phys.: Vol. 229, Issue 23, pp. 8868-8887, DOI:10.1016/j.jcp.2010.08.014. + ! + q_phys = 0.0_r8 + do h=1,jall_fvm2phys(ie) + jx = weights_lgr_index_all_fvm2phys(h,1,ie) + jy = weights_lgr_index_all_fvm2phys(h,2,ie) + jdx = weights_eul_index_all_fvm2phys(h,1,ie) + jdy = weights_eul_index_all_fvm2phys(h,2,ie) + recons_tmp = recons(:,jdx,jdy,1) + recons_tmp(1) = recons(1,jdx,jdy,1)-dp_fvm(jdx,jdy,1) + dp_tmp = SUM(weights_all_fvm2phys(h,:,ie)*recons_tmp(:)) + do m_cnst=1,num_trac + q_phys(jx,jy,m_cnst) = q_phys(jx,jy,m_cnst) + & + dp_fvm(jdx,jdy,1)*SUM(weights_all_fvm2phys(h,:,ie)*recons_q(:,jdx,jdy,m_cnst))+& + q_fvm(jdx,jdy,m_cnst) *dp_tmp + end do + end do + ! + ! convert to mixing ratio + ! + dp_phys_inv=1.0_r8/dp_phys + do m_cnst=1,num_trac + q_phys(:,:,m_cnst) = q_phys(:,:,m_cnst)*dp_phys_inv(:,:) + end do + end subroutine fvm2phys + + + subroutine phys2fvm(ie,fvm,dp_phys,dp_fvm,q_phys,dp_q_fvm,num_trac,return_mixing_ratio) + use dimensions_mod, only: fv_nphys,nhr_phys,nhc_phys,ns_phys,fv_nphys,nhe_phys,nc + use fvm_reconstruction_mod, only: reconstruction + ! + ! weights must be initialized in phys2fvm_init before using this function + ! + use dp_mapping, only: weights_all_phys2fvm, weights_eul_index_all_phys2fvm + use dp_mapping, only: weights_lgr_index_all_phys2fvm, jall_phys2fvm + + type(fvm_struct) , intent(in) :: fvm + integer , intent(in) :: ie + integer , intent(in) :: num_trac + logical , intent(in) :: return_mixing_ratio + real (kind=r8), intent(inout) :: dp_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,1) + real (kind=r8), intent(out) :: dp_fvm(nc,nc) + + real (kind=r8), intent(inout) :: q_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,num_trac) + real (kind=r8), intent(out) :: dp_q_fvm (nc,nc,num_trac) + + real (kind=r8) :: recons (irecons_tracer,1-nhe_phys:fv_nphys+nhe_phys,& + 1-nhe_phys:fv_nphys+nhe_phys,1) + real (kind=r8) :: recons_q (irecons_tracer,1-nhe_phys:fv_nphys+nhe_phys,& + 1-nhe_phys:fv_nphys+nhe_phys,num_trac) + real (kind=r8) :: recons_tmp(irecons_tracer) + + logical :: llimiter(1),llimiter_q(num_trac) + integer :: h,jx,jy,jdx,jdy,m_cnst + integer :: jx_min_local(3), jx_max_local(3), jy_min_local(3), jy_max_local(3) + real (kind=r8) :: dp_fvm_inv(nc,nc), dp_tmp + ! + ! setting nhe=0 because we do not need reconstruction outside of element + ! + integer:: nh_phys + integer:: nht_local + + nh_phys = nhr_phys!-1!+(nhe-1) ! = 2 (nhr=2; nhe_phys=1),! = 3 (nhr=2; nhe_phys=2) + nht_local=nhe_phys+nhr_phys !total halo width where reconstruction is needed (nht<=nc) - phl + + + llimiter=.false. + ! + ! to accomodate nhe=0 make sure nothing is done for neighboring panel recontructions + ! + jx_min_local(1) = 1 ; jx_max_local(1) = fv_nphys+1 + jy_min_local(1) = 1 ; jy_max_local(1) = fv_nphys+1 + jx_min_local(2) = 0 ; jx_max_local(2) = -1 + jy_min_local(2) = 0 ; jy_max_local(2) = -1 + jx_min_local(3) = 0 ; jx_max_local(3) = -1 + jy_min_local(3) = 0 ; jy_max_local(3) = -1 + call reconstruction(dp_phys,recons,irecons_tracer,llimiter,1,& + fv_nphys,nhe_phys,nhr_phys,nhc_phys,nht_local,ns_phys,nh_phys,& + jx_min_local,jx_max_local,jy_min_local,jy_max_local,& + fvm%cubeboundary,fvm%halo_interp_weight_physgrid(1:ns_phys,1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fvm%ibase_physgrid(1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fvm%spherecentroid_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%recons_metrics_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%recons_metrics_integral_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys) ,& + fvm%rot_matrix_physgrid,& + fvm%centroid_stretch_physgrid(1:7,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%vertex_recons_weights_physgrid(1:irecons_tracer-1,:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%vtx_cart_physgrid(:,:,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + + + dp_fvm = 0.0_r8 + do h=1,jall_phys2fvm(ie) + jx = weights_lgr_index_all_phys2fvm(h,1,ie) + jy = weights_lgr_index_all_phys2fvm(h,2,ie) + jdx = weights_eul_index_all_phys2fvm(h,1,ie) + jdy = weights_eul_index_all_phys2fvm(h,2,ie) + dp_fvm(jx,jy) = dp_fvm(jx,jy) + SUM(weights_all_phys2fvm(h,:,ie)*recons(:,jdx,jdy,1)) + end do + + llimiter_q=.true. + call reconstruction(q_phys,recons_q,irecons_tracer,llimiter_q,num_trac,& + fv_nphys,nhe_phys,nhr_phys,nhc_phys,nht_local,ns_phys,nh_phys,& + jx_min_local,jx_max_local,jy_min_local,jy_max_local,& + fvm%cubeboundary,fvm%halo_interp_weight_physgrid(1:ns_phys,1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fvm%ibase_physgrid(1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fvm%spherecentroid_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%recons_metrics_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%recons_metrics_integral_physgrid(:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys) ,& + fvm%rot_matrix_physgrid,& + fvm%centroid_stretch_physgrid(1:7,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%vertex_recons_weights_physgrid(1:irecons_tracer-1,:,1-nhe_phys:fv_nphys+nhe_phys,1-nhe_phys:fv_nphys+nhe_phys),& + fvm%vtx_cart_physgrid(:,:,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) + ! + ! q-dp coupling as described in equation (55) in Appendinx B of + ! Nair and Lauritzen, 2010: A Class of Deformational Flow Test Cases for Linear Transport Problems on the Sphere. + ! J. Comput. Phys.: Vol. 229, Issue 23, pp. 8868-8887, DOI:10.1016/j.jcp.2010.08.014. + ! + dp_q_fvm = 0.0_r8 + do h=1,jall_phys2fvm(ie) + jx = weights_lgr_index_all_phys2fvm(h,1,ie) + jy = weights_lgr_index_all_phys2fvm(h,2,ie) + jdx = weights_eul_index_all_phys2fvm(h,1,ie) + jdy = weights_eul_index_all_phys2fvm(h,2,ie) + recons_tmp = recons(:,jdx,jdy,1) + recons_tmp(1) = recons(1,jdx,jdy,1)-dp_phys(jdx,jdy,1) + dp_tmp = SUM(weights_all_phys2fvm(h,:,ie)*recons_tmp(:)) + do m_cnst=1,num_trac + dp_q_fvm(jx,jy,m_cnst) = dp_q_fvm(jx,jy,m_cnst) + & + dp_phys(jdx,jdy,1)*SUM(weights_all_phys2fvm(h,:,ie)*recons_q(:,jdx,jdy,m_cnst))+& + q_phys(jdx,jdy,m_cnst) *dp_tmp + end do + end do + ! + ! convert to mixing ratio + ! + if (return_mixing_ratio) then + dp_fvm_inv=1.0_r8/dp_fvm + do m_cnst=1,num_trac + dp_q_fvm(:,:,m_cnst) = dp_q_fvm(:,:,m_cnst)*dp_fvm_inv(:,:) + end do + end if + end subroutine phys2fvm + +end module fvm_mapping diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 new file mode 100644 index 0000000000..140ee32a61 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -0,0 +1,862 @@ +!-----------------------------------------------------------------------------! +!MODULE FVM_MOD-----------------------------------------------------CE-for FVM! +! FVM_MOD File for the fvm project in HOMME ! +! Author: Christoph Erath ! +! Date: 25.January 2011 ! +! MAIN module to run fvm on HOMME ! +! 14.November 2011: reorganisation done ! +! 7.Februar 2012: cslam_run and cslam_runair ! +!-----------------------------------------------------------------------------! + +module fvm_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use edge_mod, only: initghostbuffer, freeghostbuffer, ghostpack, ghostunpack + use edgetype_mod, only: edgebuffer_t + use bndry_mod, only: ghost_exchange + + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use hybrid_mod, only: hybrid_t + + implicit none + private + save + + type (EdgeBuffer_t) :: edgeveloc + type (EdgeBuffer_t), public :: ghostBufQnhc, ghostBufQ1, ghostBufFlux + + interface fill_halo_fvm + module procedure fill_halo_fvm_noprealloc + module procedure fill_halo_fvm_prealloc + end interface + + + public :: edgeveloc, fvm_init1,fvm_init2, fill_halo_fvm, fvm_pg_init,fvm_init3,fill_halo_and_extend_panel + +contains + + subroutine fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,tnp0,ndepth,kmin,kmax) + use perf_mod, only : t_startf, t_stopf ! _EXTERNAL + use dimensions_mod, only: nc, ntrac + implicit none + type (element_t),intent(inout) :: elem(:) + type (fvm_struct),intent(inout) :: fvm(:) + type (hybrid_t),intent(in) :: hybrid + + type (edgeBuffer_t) :: cellghostbuf + + integer,intent(in) :: nets,nete,tnp0,ndepth,kmin,kmax + integer :: ie,i1,i2,num_levels + ! + ! + + call t_startf('FVM:initbuf') + i1=1-ndepth + i2=nc+ndepth + num_levels = kmax-kmin+1 + call initghostbuffer(hybrid%par,cellghostbuf,elem,num_levels*(ntrac+1),ndepth,nc) + call t_stopf('FVM:initbuf') + call t_startf('FVM:pack') + do ie=nets,nete + call ghostpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax,tnp0),num_levels, 0,ie) + call ghostpack(cellghostbuf, fvm(ie)%c(i1:i2,i1:i2,kmin:kmax,:,tnp0) ,num_levels*ntrac,num_levels,ie) + end do + call t_stopf('FVM:pack') + call t_startf('FVM:Communication') + call ghost_exchange(hybrid,cellghostbuf) + call t_stopf('FVM:Communication') + !-----------------------------------------------------------------------------------! + call t_startf('FVM:Unpack') + do ie=nets,nete + call ghostunpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax,tnp0),num_levels ,0,ie) + call ghostunpack(cellghostbuf, fvm(ie)%c(i1:i2,i1:i2,kmin:kmax,:,tnp0), num_levels*ntrac,num_levels,ie) + enddo + call t_stopf('FVM:Unpack') + call t_startf('FVM:freebuf') + call freeghostbuffer(cellghostbuf) + call t_stopf('FVM:freebuf') + end subroutine fill_halo_fvm_noprealloc + +subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,tnp0,ndepth,kmin,kmax) + use perf_mod, only : t_startf, t_stopf ! _EXTERNAL + use dimensions_mod, only: nc, ntrac + implicit none + type (EdgeBuffer_t), intent(inout) :: cellghostbuf + type (element_t),intent(inout) :: elem(:) + type (fvm_struct),intent(inout) :: fvm(:) + type (hybrid_t),intent(in) :: hybrid + + + integer,intent(in) :: nets,nete,tnp0,ndepth,kmin,kmax + integer :: ie,i1,i2,num_levels + ! + ! + +! call t_startf('FVM:initbuf') + i1=1-ndepth + i2=nc+ndepth + num_levels = kmax-kmin+1 + call t_startf('FVM:pack') + do ie=nets,nete + call ghostpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax,tnp0),num_levels, 0,ie) + call ghostpack(cellghostbuf, fvm(ie)%c(i1:i2,i1:i2,kmin:kmax,:,tnp0) ,num_levels*ntrac,num_levels,ie) + end do + call t_stopf('FVM:pack') + call t_startf('FVM:Communication') + call ghost_exchange(hybrid,cellghostbuf) + call t_stopf('FVM:Communication') + !-----------------------------------------------------------------------------------! + call t_startf('FVM:Unpack') + do ie=nets,nete + call ghostunpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax,tnp0),num_levels ,0,ie) + call ghostunpack(cellghostbuf, fvm(ie)%c(i1:i2,i1:i2,kmin:kmax,:,tnp0), num_levels*ntrac,num_levels,ie) + enddo + call t_stopf('FVM:Unpack') + + end subroutine fill_halo_fvm_prealloc + + subroutine PrintArray(i1,i2,array) + ! debug routine potentially called from any MPI rank + integer :: i1,i2 + real(kind=r8) :: array(i1:i2,i1:i2) + integer :: sz,i,ub + + sz = size(array,dim=1) + + if (sz == 9) then + do i=i2,i1,-1 + write(6,9) array(-2,i),array(-1,i), array(0,i), & + array( 1,i), array(2,i), array(3,i), & + array( 4,i), array(5,i), array(6,i) + enddo + endif + + 9 format('|',9(f10.1,'|')) + + + end subroutine + + + subroutine fill_halo_and_extend_panel(elem,fvm,fld,hybrid,nets,nete,nphys,nhcc, ndepth,numlev,num_flds,lfill_halo,lextend_panel) + use hybrid_mod, only: hybrid_t + use edge_mod, only: initghostbuffer, freeghostbuffer, ghostpack, ghostunpack + + use fvm_reconstruction_mod, only: extend_panel_interpolate + use cam_abortutils, only: endrun + use dimensions_mod, only: fv_nphys,nhr,nhr_phys,nhc,nhc_phys,ns,ns_phys,nhe_phys,nc + use perf_mod, only : t_startf, t_stopf ! _EXTERNAL + + integer , intent(in) :: nets,nete,nphys,ndepth,numlev,num_flds,nhcc + real (kind=r8) , intent(inout) :: fld(1-nhcc:nphys+nhcc,1-nhcc:nphys+nhcc,numlev,num_flds,nets:nete) + type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(in) :: fvm(:) + logical , intent(in) :: lfill_halo,lextend_panel +! real (kind=r8) , allocatable :: ftmp(:,:) +! real (kind=r8) :: ftmp(1-nhcc:nphys+nhcc,1-nhcc:nphys+nhcc,numlev,num_flds,nets:nete) + real (kind=r8), allocatable :: fld_tmp(:,:) + + integer :: ie,k,itr,nht_phys,nh_phys + type (edgeBuffer_t) :: cellghostbuf + + if (lfill_halo) then + ! + !********************************************* + ! + ! halo exchange + ! + !********************************************* + ! + call t_startf('fill_halo_and_extend_panel initbuffer') + call initghostbuffer(hybrid%par,cellghostbuf,elem,numlev*num_flds,nhcc,nphys) + call t_stopf('fill_halo_and_extend_panel initbuffer') + do ie=nets,nete + call ghostpack(cellghostbuf, fld(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,cellghostbuf) + do ie=nets,nete + call ghostunpack(cellghostbuf, fld(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call freeghostbuffer(cellghostbuf) + end if + if (lextend_panel) then + ! + !********************************************* + ! + ! extend panel + ! + !********************************************* + ! + if (nphys==fv_nphys) then + if (ndepth>nhr_phys) & + call endrun("fill_halo_and_extend_panel: ndepth>nhr_phys") + nht_phys = nhe_phys+nhr_phys + nh_phys = nhr_phys + allocate(fld_tmp(1-nht_phys:nphys+nht_phys,1-nht_phys:nphys+nht_phys)) + do ie=nets,nete + do itr=1,num_flds + do k=1,numlev + call extend_panel_interpolate(fv_nphys,nhc_phys,nhr_phys,nht_phys,ns_phys,nh_phys,& + fld(:,:,k,itr,ie),fvm(ie)%cubeboundary,& + fvm(ie)%halo_interp_weight_physgrid(1:ns_phys,1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fvm(ie)%ibase_physgrid(1-nh_phys:fv_nphys+nh_phys,1:nhr_phys,:),& + fld_tmp) + fld(1-ndepth:nphys+ndepth,1-ndepth:nphys+ndepth,k,itr,ie) = fld_tmp(1-ndepth:nphys+ndepth,1-ndepth:nphys+ndepth) + end do + end do + end do + deallocate(fld_tmp) + else if (nphys==nc) then + if (ndepth>nhr) & + call endrun("fill_halo_and_extend_panel: ndepth>nhr") + nhe_phys= 0 + nht_phys= nhe_phys+nhr + nh_phys = nhr + allocate(fld_tmp(1-nht_phys:nphys+nht_phys,1-nht_phys:nphys+nht_phys)) + do ie=nets,nete + do itr=1,num_flds + do k=1,numlev + call extend_panel_interpolate(nc,nhc,nhr,nht_phys,ns,nh_phys,& + fld(:,:,k,itr,ie),fvm(ie)%cubeboundary,& + fvm(ie)%halo_interp_weight(1:ns,1-nh_phys:nc+nh_phys,1:nhr,:),& + fvm(ie)%ibase(1-nh_phys:nc+nh_phys,1:nhr,:),& + fld_tmp) + fld(1-ndepth:nphys+ndepth,1-ndepth:nphys+ndepth,k,itr,ie) = fld_tmp(1-ndepth:nphys+ndepth,1-ndepth:nphys+ndepth) + end do + end do + end do + deallocate(fld_tmp) + else + call endrun("fill_halo_and_extend_panel: resolution not supported") + end if + end if + end subroutine fill_halo_and_extend_panel + + + ! initialize global buffers shared by all threads + subroutine fvm_init1(par,elem) + use parallel_mod, only: parallel_t + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use control_mod, only: tracer_transport_type, rsplit + use control_mod, only: TRACERTRANSPORT_CONSISTENT_SE_FVM + use fvm_control_volume_mod, only: n0_fvm, np1_fvm, fvm_supercycling + use dimensions_mod, only: qsize, qsize_d + use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac_d,ns, nhr + + type (parallel_t) :: par + type (element_t),intent(inout) :: elem(:) + ! + ! initialize fvm time-levels + ! + n0_fvm = 1 + np1_fvm = 2 + ! + if (ntrac>0) then + if (par%masterproc) then + write(iulog,*) " " + write(iulog,*) "|-----------------------------------------|" + write(iulog,*) "| FVM tracer transport scheme information |" + write(iulog,*) "|-----------------------------------------|" + write(iulog,*) " " + end if + if (tracer_transport_type == TRACERTRANSPORT_CONSISTENT_SE_FVM) then + if (par%masterproc) then + write(iulog,*) "Running consistent SE-CSLAM, Lauritzen et al. (2017, MWR)." + write(iulog,*) "CSLAM = Conservative Semi-LAgrangian Multi-tracer scheme" + write(iulog,*) "Lauritzen et al., (2010), J. Comput. Phys." + write(iulog,*) " " + end if + end if + + if (ntrac>ntrac_d) & + call endrun("PARAMETER ERROR for fvm: ntrac > ntrac_d") + + if (qsize>0.and.mod(rsplit,fvm_supercycling).ne.0) then + if (par%masterproc) then + write(iulog,*)'cannot supercycle fvm tracers with respect to se tracers' + write(iulog,*)'with this choice of rsplit =',rsplit + write(iulog,*)'rsplit must be a multiple of fvm_supercycling=',fvm_supercycling + call endrun("PARAMETER ERROR for fvm: mod(rsplit,fvm_supercycling<>0") + end if + endif + + + if (par%masterproc) then + write(iulog,*) " " + write(iulog,*) "Done Tracer transport scheme information " + write(iulog,*) " " + end if + end if + + + if (par%masterproc) write(iulog,*) "fvm resolution is nc*nc in each element: nc = ",nc + if (par%masterproc) write(iulog,*)'ntrac,ntrac_d=',ntrac,ntrac_d + if (par%masterproc) write(iulog,*)'qsize,qsize_d=',qsize,qsize_d + + + if (nc<3) then + if (par%masterproc) then + write(iulog,*) "NUMBER OF CELLS ERROR for fvm: Number of cells parameter" + write(iulog,*) "parameter nc at least 3 (nc>=3), nc*nc cells per element. This is" + write(iulog,*) "needed for the cubic reconstruction, which is only implemented yet! STOP" + endif + call endrun("stopping") + end if + + if (par%masterproc) then + write(iulog,*) " " + if (ns==1) then + write(iulog,*) "ns==1: using no interpolation for mapping cell averages values across edges" + write(iulog,*) "Note: this is not a recommended setting - large errors at panel edges!" + else if (ns==2) then + write(iulog,*) "ns==2: using linear interpolation for mapping cell averages values across edges" + write(iulog,*) "Note that ns=4 is default CSLAM setting used in Lauritzen et al. (2010)" + write(iulog,*) "so this option is slightly less accurate (but the stencil is smaller near panel edges!)" + + else if (ns==3) then + write(iulog,*) "ns==3: using quadratic interpolation for mapping cell averages values across edges" + write(iulog,*) "Note that ns=4 is default CSLAM setting used in Lauritzen et al. (2010)" + write(iulog,*) "so this option is slightly less accurate (but the stencil is smaller near panel edges!)" + else if (ns==4) then + write(iulog,*) "ns==4: using cubic interpolation for mapping cell averages values across edges" + write(iulog,*) "This is default CSLAM setting used in Lauritzen et al. (2010)" + else + write(iulog,*) "Not a tested value for ns but it should work! You choose ns = ",ns + end if + + ! if (ns.NE.3) then + ! write(*,*) "In fvm_reconstruction_mod function matmul_w has been hard-coded for ns=3 for performance" + ! write(*,*) "Revert to general code - outcommented above" + ! call endrun("stopping") + ! end if + end if + + if (MOD(ns,2)==0.and.nhr+(nhe-1)+ns/2>nc+nc) then + write(iulog,*) "to run this combination of ns and nhr you need to increase nc to ",nhr+ns/2+nhe-1 + write(iulog,*) "You choose (ns,nhr,nc,nhe)=",ns,nhr,nc,nhe + call endrun("stopping") + end if + if (MOD(ns,2)==1.and.nhr+(ns-1)/2+(nhe-1)>nc+nc) then + write(iulog,*) "to run this combination of ns and nhr you need to increase nc to ",nhr+(ns-1)/2+nhe-1 + write(iulog,*) "You choose (ns,nhr,nc,nhe)=",ns,nhr,nc,nhe + call endrun("stopping") + end if + + if (nc==3.and.ns.ne.3) then + if (par%masterproc) then + write(iulog,*) "Recommended setting for nc=3 is ns=3 (linear interpolation in halo)" + write(iulog,*) "You choose ns=",ns + write(iulog,*) "Goto dimensions_mod to change value of ns" + write(iulog,*) "or outcomment call haltmop below (i.e. you know what you are doing!)" + endif + call endrun("stopping") + end if + + if (nc==4.and.ns.ne.4) then + if (par%masterproc) then + write(iulog,*) "Recommended setting for nc=4 is ns=4 (cubic interpolation in halo)" + write(iulog,*) "You choose ns=",ns + write(iulog,*) "Goto dimensions_mod to change value of ns" + write(iulog,*) "or outcomment call haltmop below (i.e. you know what you are doing!)" + endif + call endrun("stopping") + end if + + if (nhe .ne. 1) then + if (par%masterproc) then + write(iulog,*) "PARAMETER ERROR for fvm: Number of halo zone for the extended" + write(iulog,*) "element nhe has to be 1, only this is available now! STOP!" + endif + call endrun("stopping") + end if + + end subroutine fvm_init1 + + + + + + ! initialization that can be done in threaded regions + subroutine fvm_init2(elem,fvm,hybrid,nets,nete) + use fvm_control_volume_mod, only: fvm_mesh,fvm_set_cubeboundary,n0_fvm,np1_fvm + use bndry_mod, only: compute_ghost_corner_orientation + use dimensions_mod, only: nlev, nc, nhc, nhe, ntrac, ntrac_d + use hycoef, only: hyai, hybi, ps0 + + type (fvm_struct) :: fvm(:) + type (element_t) :: elem(:) + type (hybrid_t) :: hybrid + integer :: ie,nets,nete,k + + do ie=nets,nete + do k = 1, nlev + fvm(ie)%dp_ref(k) = ( hyai(k+1) - hyai(k) )*ps0 + ( hybi(k+1) - hybi(k) )*ps0 + fvm(ie)%dp_ref_inverse(k) = 1.0_r8/fvm(ie)%dp_ref(k) + end do + end do + + n0_fvm = 1 !in case no cslam but physgrid + np1_fvm = 2 + + call compute_ghost_corner_orientation(hybrid,elem,nets,nete) + ! run some tests: + ! call test_ghost(hybrid,elem,nets,nete) + + do ie=nets,nete + call fvm_set_cubeboundary(elem(ie),fvm(ie)) + call fvm_mesh(elem(ie),fvm(ie)) + fvm(ie)%inv_area_sphere = 1.0_r8/fvm(ie)%area_sphere + fvm(ie)%inv_se_area_sphere = fvm(ie)%inv_area_sphere + + fvm(ie)%fc(:,:,:,:) = 0.0_r8 + fvm(ie)%fm(:,:,:,:) = 0.0_r8 + fvm(ie)%ft(:,:,: ) = 0.0_r8 + enddo + ! Need to allocate ghostBufQnhc after compute_ghost_corner_orientation because it + ! changes the values for reverse + call initghostbuffer(hybrid%par,ghostBufQnhc,elem,nlev*(ntrac+1),nhc,nc) + call initghostbuffer(hybrid%par,ghostBufQ1,elem,nlev*(ntrac+1),1,nc) + call initghostbuffer(hybrid%par,ghostBufFlux,elem,4*nlev,nhe,nc) + + end subroutine fvm_init2 + + + subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) + use control_mod , only: neast, nwest, seast, swest + use fvm_analytic_mod, only: compute_reconstruct_matrix + use dimensions_mod , only: fv_nphys + use dimensions_mod, only: nlev, nc, nhe, nlev, ntrac, ntrac_d,nhc + use coordinate_systems_mod, only: cartesian2D_t,cartesian3D_t + use fvm_control_volume_mod, only: n0_fvm + use coordinate_systems_mod, only: cubedsphere2cart, cart2cubedsphere + implicit none + type (element_t) ,intent(inout) :: elem(:) + type (fvm_struct),intent(inout) :: fvm(:) + type (hybrid_t) ,intent(in) :: hybrid + integer ,intent(in) :: nets,nete,irecons + ! + type (edgeBuffer_t) :: cellghostbuf + integer :: ie, ixy, ivertex, i, j,istart,itot,ishft,imin,imax + integer, dimension(2,4) :: unit_vec + integer :: rot90_matrix(2,2), iside + + type (cartesian2D_t) :: tmpgnom + type (cartesian2D_t) :: gnom + type(cartesian3D_t) :: tmpcart3d + + if (ntrac>0.and.nc.ne.fv_nphys) then + ! + ! fill the fvm halo for mapping in d_p_coupling if + ! physics grid resolution is different than fvm resolution + ! + call fill_halo_fvm(elem,fvm,hybrid,nets,nete,n0_fvm,nhc,1,nlev) + end if + + + imin=1-nhc + imax=nc+nhc + ! + ! fill halo start + ! + itot=9+irecons-1+2 + call initghostbuffer(hybrid%par,cellghostbuf,elem,itot,nhc,nc) + do ie=nets,nete + istart = 0 + call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord(1,:,:),1,istart,ie) + istart = istart+1 + call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord(2,:,:),1,istart,ie) + istart = istart+1 + do ixy=1,2 + do ivertex=1,4 + call ghostpack(cellghostbuf, fvm(ie)%vtx_cart(ivertex,ixy,:,:) ,1,istart,ie) + istart = istart+1 + end do + end do + call ghostpack(cellghostbuf, fvm(ie)%flux_orient(1,:,:) ,1,istart,ie) + do ixy=1,irecons-1 + istart=istart+1 + call ghostpack(cellghostbuf, fvm(ie)%spherecentroid(ixy,:,:) ,1,istart,ie) + end do + end do + call ghost_exchange(hybrid,cellghostbuf) + do ie=nets,nete + istart = 0 + call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord(1,:,:),1,istart,ie) + istart = istart+1 + call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord(2,:,:),1,istart,ie) + istart = istart+1 + do ixy=1,2 + do ivertex=1,4 + call ghostunpack(cellghostbuf, fvm(ie)%vtx_cart(ivertex,ixy,:,:) ,1,istart,ie) + istart = istart+1 + end do + end do + call ghostunpack(cellghostbuf, fvm(ie)%flux_orient(1,:,:) ,1,istart,ie) + do ixy=1,irecons-1 + istart=istart+1 + call ghostunpack(cellghostbuf, fvm(ie)%spherecentroid(ixy,:,:) ,1,istart,ie) + end do + enddo + call freeghostbuffer(cellghostbuf) + ! + ! indicator for non-existing cells + ! set vtx_cart to corner value in non-existent cells + ! + do ie=nets,nete + if (fvm(ie)%cubeboundary==nwest) then + fvm(ie)%flux_orient (: ,1-nhc :0 ,nc +1 :nc +nhc ) = -1 + fvm(ie)%spherecentroid (:, 1-nhc :0 ,nc +1 :nc +nhc ) = -1e5_r8 + fvm(ie)%vtx_cart(:,1,1-nhc:0 ,nc+1 :nc+nhc) = fvm(ie)%vtx_cart(4,1,1,nc) + fvm(ie)%vtx_cart(:,2,1-nhc:0 ,nc+1 :nc+nhc) = fvm(ie)%vtx_cart(4,2,1,nc) + else if (fvm(ie)%cubeboundary==swest) then + fvm(ie)%flux_orient (:,1-nhc :0 ,1-nhc :0 ) = -1 + fvm(ie)%spherecentroid (:,1-nhc :0 ,1-nhc :0 ) = -1e5_r8 + fvm(ie)%vtx_cart(:,1,1-nhc:0 ,1-nhc:0 ) = fvm(ie)%vtx_cart(1,1,1,1) + fvm(ie)%vtx_cart(:,2,1-nhc:0 ,1-nhc:0 ) = fvm(ie)%vtx_cart(1,2,1,1) + else if (fvm(ie)%cubeboundary==neast) then + fvm(ie)%flux_orient (:,nc +1 :nc +nhc ,nc +1 :nc +nhc ) = -1 + fvm(ie)%spherecentroid (:,nc +1 :nc +nhc ,nc +1 :nc +nhc ) = -1e5_r8 + fvm(ie)%vtx_cart(:,1,nc+1 :nc+nhc,nc+1 :nc+nhc) = fvm(ie)%vtx_cart(3,1,nc,nc) + fvm(ie)%vtx_cart(:,2,nc+1 :nc+nhc,nc+1 :nc+nhc) = fvm(ie)%vtx_cart(3,2,nc,nc) + else if (fvm(ie)%cubeboundary==seast) then + fvm(ie)%flux_orient (:,nc +1 :nc +nhc ,1-nhc :0 ) = -1 + fvm(ie)%spherecentroid (:,nc +1 :nc +nhc ,1-nhc :0 ) = -1e5_r8 + fvm(ie)%vtx_cart(:,1,nc+1 :nc+nhc,1-nhc:0 ) = fvm(ie)%vtx_cart(2,1,nc,1) + fvm(ie)%vtx_cart(:,2,nc+1 :nc+nhc,1-nhc:0 ) = fvm(ie)%vtx_cart(2,2,nc,1) + end if + end do + + ! + ! set vectors for perpendicular flux vector + ! + rot90_matrix(1,1) = 0; rot90_matrix(2,1) = 1 !counter-clockwise rotation matrix + rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix + + iside = 1 + unit_vec(1,iside) = 0 !x-component of displacement vector for side 1 + unit_vec(2,iside) = 1 !y-component of displacement vector for side 1 + + do iside=2,4 + unit_vec(:,iside) = MATMUL(rot90_matrix(:,:),unit_vec(:,iside-1)) + end do + + ! + ! fill halo done + ! + !------------------------------- + + do ie=nets,nete + fvm(ie)%displ_max = 0.0_r8 + do j=imin,imax + do i=imin,imax + ! + ! rotate gnomonic coordinate vector + ! + ! fvm(ie)%norm_elem_coord(:,i,j) = MATMUL(fvm(ie)%rot_matrix(:,:,i,j),fvm(ie)%norm_elem_coord(:,i,j)) + ! + ishft = NINT(fvm(ie)%flux_orient(2,i,j)) + do ixy=1,2 + ! + ! rotate coordinates if needed through permutation + ! + fvm(ie)%vtx_cart(1:4,ixy,i,j) = cshift(fvm(ie)%vtx_cart(1:4,ixy,i,j),shift=ishft) + fvm(ie)%flux_vec (ixy,i,j,1:4) = cshift(unit_vec (ixy,1:4 ),shift=ishft) + ! + ! set flux vector to zero in non-existent cells (corner halo) + ! + fvm(ie)%flux_vec (ixy,i,j,1:4) = fvm(ie)%ifct(i,j)*fvm(ie)%flux_vec(ixy,i,j,1:4) + + iside=1 + fvm(ie)%displ_max(i,j,iside) = fvm(ie)%displ_max(i,j,iside)+& + ABS(fvm(ie)%vtx_cart(4,ixy,i,j)-fvm(ie)%vtx_cart(1,ixy,i,j)) + iside=2 + fvm(ie)%displ_max(i,j,iside) = fvm(ie)%displ_max(i,j,iside)+& + ABS(fvm(ie)%vtx_cart(1,ixy,i,j)-fvm(ie)%vtx_cart(2,ixy,i,j)) + iside=3 + fvm(ie)%displ_max(i,j,iside) = fvm(ie)%displ_max(i,j,iside)+& + ABS(fvm(ie)%vtx_cart(2,ixy,i,j)-fvm(ie)%vtx_cart(3,ixy,i,j)) + iside=4 + fvm(ie)%displ_max(i,j,iside) = fvm(ie)%displ_max(i,j,iside)+& + ABS(fvm(ie)%vtx_cart(2,ixy,i,j)-fvm(ie)%vtx_cart(1,ixy,i,j)) + end do + end do + end do + end do + ! + ! pre-compute derived metric terms used for integration, polynomial + ! evaluation at fvm cell vertices, etc. + ! + do ie=nets,nete + call compute_reconstruct_matrix(nc,nhe,nhc,irecons,fvm(ie)%dalpha,fvm(ie)%dbeta,& + fvm(ie)%spherecentroid,fvm(ie)%vtx_cart,fvm(ie)%centroid_stretch,& + fvm(ie)%vertex_recons_weights,fvm(ie)%recons_metrics,fvm(ie)%recons_metrics_integral) + end do + ! + ! create a normalized element coordinate system with a halo + ! + do ie=nets,nete + do j=1-nhc,nc+nhc + do i=1-nhc,nc+nhc + ! + ! only compute for physically existent cells + ! + if (fvm(ie)%ifct(i,j)>0) then + gnom%x = fvm(ie)%norm_elem_coord(1,i,j) + gnom%y = fvm(ie)%norm_elem_coord(2,i,j) + ! + ! coordinate transform only necessary for points on another panel + ! + if (NINT(fvm(ie)%flux_orient(1,1,1)).NE.NINT(fvm(ie)%flux_orient(1,i,j))) then + tmpcart3d=cubedsphere2cart(gnom,NINT(fvm(ie)%flux_orient(1,i,j))) + tmpgnom=cart2cubedsphere(tmpcart3d,NINT(fvm(ie)%flux_orient(1,1,1))) + else + tmpgnom%x = fvm(ie)%norm_elem_coord(1,i,j) + tmpgnom%y = fvm(ie)%norm_elem_coord(2,i,j) + end if + ! + ! convert to element normalized coordinates + ! + fvm(ie)%norm_elem_coord(1,i,j) =(tmpgnom%x-elem(ie)%corners(1)%x)/& + (0.5_r8*dble(nc)*fvm(ie)%dalpha)-1.0_r8 + fvm(ie)%norm_elem_coord(2,i,j) =(tmpgnom%y-elem(ie)%corners(1)%y)/& + (0.5_r8*dble(nc)*fvm(ie)%dalpha)-1.0_r8 + else + fvm(ie)%norm_elem_coord(1,i,j) = 1D9 + fvm(ie)%norm_elem_coord(2,i,j) = 1D9 + end if + end do + end do + end do + + end subroutine fvm_init3 + + + subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) + use coordinate_systems_mod, only : cartesian2D_t,cartesian3D_t + use control_mod, only : neast, nwest, seast, swest + use coordinate_systems_mod, only : cubedsphere2cart, cart2cubedsphere + use dimensions_mod, only: fv_nphys, nhe_phys,nhc_phys + use dimensions_mod, only: ntrac_d + use cube_mod ,only: dmap + use control_mod ,only: cubed_sphere_map + use fvm_analytic_mod, only: compute_reconstruct_matrix + + type (element_t) , intent(in) :: elem(:) + type (fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t) , intent(in) :: hybrid + + type (cartesian2D_t) :: gnom + type(cartesian3D_t) :: tmpcart3d + type (cartesian2D_t) :: tmpgnom + + + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete,irecons ! ending thread element number (private) + + ! ================================== + ! Local variables + ! ================================== + + integer :: ie, ixy, ivertex, i, j,istart,itot,ishft,imin,imax + integer, dimension(2,4) :: unit_vec + integer :: rot90_matrix(2,2), iside + + type (edgeBuffer_t) :: cellghostbuf + + ! D is derivative of gnomonic mapping + real (kind=r8) :: D(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,2,2) + real (kind=r8) :: detD,x1,x2 + + if (fv_nphys>0) then + ! + ! do the same as fvm_init3 for the metric terms of physgrid + ! + imin=1-nhc_phys + imax=fv_nphys+nhc_phys + ! + ! fill halo start + ! + itot=9+irecons-1+2 + call initghostbuffer(hybrid%par,cellghostbuf,elem,itot,nhc_phys,fv_nphys) + do ie=nets,nete + istart = 0 + call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord_physgrid(1,:,:),1,istart,ie) + istart = istart+1 + call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord_physgrid(2,:,:),1,istart,ie) + istart = istart+1 + do ixy=1,2 + do ivertex=1,4 + call ghostpack(cellghostbuf, fvm(ie)%vtx_cart_physgrid(ivertex,ixy,:,:) ,1,istart,ie) + istart = istart+1 + end do + end do + call ghostpack(cellghostbuf, fvm(ie)%flux_orient_physgrid(1,:,:) ,1,istart,ie) + do ixy=1,irecons-1 + istart=istart+1 + call ghostpack(cellghostbuf, fvm(ie)%spherecentroid_physgrid(ixy,:,:) ,1,istart,ie) + end do + end do + call ghost_exchange(hybrid,cellghostbuf) + do ie=nets,nete + istart = 0 + call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord_physgrid(1,:,:),1,istart,ie) + istart = istart+1 + call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord_physgrid(2,:,:),1,istart,ie) + istart = istart+1 + do ixy=1,2 + do ivertex=1,4 + call ghostunpack(cellghostbuf, fvm(ie)%vtx_cart_physgrid(ivertex,ixy,:,:) ,1,istart,ie) + istart = istart+1 + end do + end do + call ghostunpack(cellghostbuf, fvm(ie)%flux_orient_physgrid(1,:,:) ,1,istart,ie) + do ixy=1,irecons-1 + istart=istart+1 + call ghostunpack(cellghostbuf, fvm(ie)%spherecentroid_physgrid(ixy,:,:) ,1,istart,ie) + end do + enddo + call freeghostbuffer(cellghostbuf) + ! + ! indicator for non-existing cells + ! set vtx_cart to corner value in non-existent cells + ! + do ie=nets,nete + if (fvm(ie)%cubeboundary==nwest) then + fvm(ie)%flux_orient_physgrid (: ,1-nhc_phys :0 ,fv_nphys +1 :fv_nphys +nhc_phys ) = -1 + fvm(ie)%spherecentroid_physgrid(:, 1-nhc_phys :0 ,fv_nphys +1 :fv_nphys +nhc_phys ) = -1e5_r8 + fvm(ie)%vtx_cart_physgrid(:,1,1-nhc_phys:0 ,fv_nphys+1 :fv_nphys+nhc_phys) = & + fvm(ie)%vtx_cart_physgrid(4,1,1,fv_nphys) + fvm(ie)%vtx_cart_physgrid(:,2,1-nhc_phys:0 ,fv_nphys+1 :fv_nphys+nhc_phys) = & + fvm(ie)%vtx_cart_physgrid(4,2,1,fv_nphys) + else if (fvm(ie)%cubeboundary==swest) then + fvm(ie)%flux_orient_physgrid (:,1-nhc_phys :0 ,1-nhc_phys :0 ) = -1 + fvm(ie)%spherecentroid_physgrid(:,1-nhc_phys :0 ,1-nhc_phys :0 ) = -1e5_r8 + fvm(ie)%vtx_cart_physgrid(:,1,1-nhc_phys:0 ,1-nhc_phys:0 ) = fvm(ie)%vtx_cart_physgrid(1,1,1,1) + fvm(ie)%vtx_cart_physgrid(:,2,1-nhc_phys:0 ,1-nhc_phys:0 ) = fvm(ie)%vtx_cart_physgrid(1,2,1,1) + else if (fvm(ie)%cubeboundary==neast) then + fvm(ie)%flux_orient_physgrid (:,fv_nphys +1 :fv_nphys +nhc_phys , & + fv_nphys +1 :fv_nphys +nhc_phys ) = -1 + fvm(ie)%spherecentroid_physgrid(:,fv_nphys +1 :fv_nphys +nhc_phys , & + fv_nphys +1 :fv_nphys +nhc_phys ) = -1e5_r8 + fvm(ie)%vtx_cart_physgrid(:,1,fv_nphys+1 :fv_nphys+nhc_phys,fv_nphys+1 :fv_nphys+nhc_phys) = & + fvm(ie)%vtx_cart_physgrid(3,1,fv_nphys,fv_nphys) + fvm(ie)%vtx_cart_physgrid(:,2,fv_nphys+1 :fv_nphys+nhc_phys,fv_nphys+1 :fv_nphys+nhc_phys) = & + fvm(ie)%vtx_cart_physgrid(3,2,fv_nphys,fv_nphys) + else if (fvm(ie)%cubeboundary==seast) then + fvm(ie)%flux_orient_physgrid (:,fv_nphys +1 :fv_nphys +nhc_phys ,1-nhc_phys :0 ) = -1 + fvm(ie)%spherecentroid_physgrid(:,fv_nphys +1 :fv_nphys +nhc_phys ,1-nhc_phys :0 ) = -1e5_r8 + fvm(ie)%vtx_cart_physgrid(:,1,fv_nphys+1 :fv_nphys+nhc_phys,1-nhc_phys:0 ) = & + fvm(ie)%vtx_cart_physgrid(2,1,fv_nphys,1) + fvm(ie)%vtx_cart_physgrid(:,2,fv_nphys+1 :fv_nphys+nhc_phys,1-nhc_phys:0 ) = & + fvm(ie)%vtx_cart_physgrid(2,2,fv_nphys,1) + end if + end do + + ! + ! set vectors for perpendicular flux vector + ! + rot90_matrix(1,1) = 0; rot90_matrix(2,1) = 1 !counter-clockwise rotation matrix + rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix + + iside = 1 + unit_vec(1,iside) = 0 !x-component of displacement vector for side 1 + unit_vec(2,iside) = 1 !y-component of displacement vector for side 1 + + do iside=2,4 + unit_vec(:,iside) = MATMUL(rot90_matrix(:,:),unit_vec(:,iside-1)) + end do + + ! + ! fill halo done + ! + !------------------------------- + + do ie=nets,nete + do j=imin,imax + do i=imin,imax + ! + ! rotate gnomonic coordinate vector + ! + ishft = NINT(fvm(ie)%flux_orient_physgrid(2,i,j)) + do ixy=1,2 + ! + ! rotate coordinates if needed through permutation + ! + fvm(ie)%vtx_cart_physgrid(1:4,ixy,i,j) = cshift(fvm(ie)%vtx_cart_physgrid(1:4,ixy,i,j),shift=ishft) + end do + end do + end do + end do + ! + ! pre-compute derived metric terms used for integration, polynomial + ! evaluation at fvm cell vertices, etc. + ! + do ie=nets,nete + call compute_reconstruct_matrix(fv_nphys,nhe_phys,nhc_phys,irecons,fvm(ie)%dalpha_physgrid,fvm(ie)%dbeta_physgrid,& + fvm(ie)%spherecentroid_physgrid,fvm(ie)%vtx_cart_physgrid,fvm(ie)%centroid_stretch_physgrid,& + fvm(ie)%vertex_recons_weights_physgrid,fvm(ie)%recons_metrics_physgrid,fvm(ie)%recons_metrics_integral_physgrid) + end do + ! + ! code specific for physgrid + ! + ! + ! create a normalized element coordinate system with a halo + ! + do ie=nets,nete + do j=1-nhc_phys,fv_nphys+nhc_phys + do i=1-nhc_phys,fv_nphys+nhc_phys + ! + ! only compute for physically existent cells + ! + if (fvm(ie)%ifct_physgrid(i,j)>0) then + gnom%x = fvm(ie)%norm_elem_coord_physgrid(1,i,j) + gnom%y = fvm(ie)%norm_elem_coord_physgrid(2,i,j) + ! + ! coordinate transform only necessary for points on another panel + ! + if (NINT(fvm(ie)%flux_orient_physgrid(1,1,1)).NE.NINT(fvm(ie)%flux_orient_physgrid(1,i,j))) then + tmpcart3d=cubedsphere2cart(gnom,NINT(fvm(ie)%flux_orient_physgrid(1,i,j))) + tmpgnom=cart2cubedsphere(tmpcart3d,NINT(fvm(ie)%flux_orient_physgrid(1,1,1))) + else + tmpgnom%x = fvm(ie)%norm_elem_coord_physgrid(1,i,j) + tmpgnom%y = fvm(ie)%norm_elem_coord_physgrid(2,i,j) + end if + ! + ! convert to element normalized coordinates + ! + fvm(ie)%norm_elem_coord_physgrid(1,i,j) =(tmpgnom%x-elem(ie)%corners(1)%x)/& + (0.5_r8*dble(fv_nphys)*fvm(ie)%dalpha_physgrid)-1.0_r8 + fvm(ie)%norm_elem_coord_physgrid(2,i,j) =(tmpgnom%y-elem(ie)%corners(1)%y)/& + (0.5_r8*dble(fv_nphys)*fvm(ie)%dalpha_physgrid)-1.0_r8 + else + fvm(ie)%norm_elem_coord_physgrid(1,i,j) = 1D9 + fvm(ie)%norm_elem_coord_physgrid(2,i,j) = 1D9 + end if + end do + end do + end do + ! + ! compute Dinv + ! + do ie=nets,nete + do j=1-nhc_phys,fv_nphys+nhc_phys + do i=1-nhc_phys,fv_nphys+nhc_phys + x1 = fvm(ie)%norm_elem_coord_physgrid(1,i,j) + x2 = fvm(ie)%norm_elem_coord_physgrid(2,i,j) + call Dmap(D(i,j,:,:),x1,x2,elem(ie)%corners3D,cubed_sphere_map,elem(ie)%corners,elem(ie)%u2qmap,elem(ie)%facenum) + detD = D(i,j,1,1)*D(i,j,2,2) - D(i,j,1,2)*D(i,j,2,1) + + fvm(ie)%Dinv_physgrid(i,j,1,1) = D(i,j,2,2)/detD + fvm(ie)%Dinv_physgrid(i,j,1,2) = -D(i,j,1,2)/detD + fvm(ie)%Dinv_physgrid(i,j,2,1) = -D(i,j,2,1)/detD + fvm(ie)%Dinv_physgrid(i,j,2,2) = D(i,j,1,1)/detD + end do + end do + end do + end if + + end subroutine fvm_pg_init + + +end module fvm_mod diff --git a/src/dynamics/se/dycore/fvm_overlap_mod.F90 b/src/dynamics/se/dycore/fvm_overlap_mod.F90 new file mode 100644 index 0000000000..1da2cef52d --- /dev/null +++ b/src/dynamics/se/dycore/fvm_overlap_mod.F90 @@ -0,0 +1,877 @@ +module fvm_overlap_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + + real (kind=r8),parameter, private :: bignum = 1.0e20_r8 + real (kind=r8),parameter, private :: tiny = 1.0e-12_r8 + real (kind=r8),parameter, private :: fuzzy_width = 10.0_r8*tiny + + public:: compute_weights_cell + + private + integer, parameter :: max_cross = 10 +contains + subroutine compute_weights_cell(nvertex,lexact_horizontal_line_integrals,& + xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,igno_min,igno_max,& + jx_min, jx_max, jy_min, jy_max,& + ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments) + + implicit none + integer , intent(in) :: nvertex + logical, intent(in) :: lexact_horizontal_line_integrals + integer , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments + ! + ! dimension(nvertex) + ! + real (kind=r8) , dimension(4), intent(in):: xcell_in,ycell_in + ! + integer , intent(in) :: jx_min, jy_min, jx_max, jy_max,igno_min,igno_max + ! + ! dimension(-ihalo:nc+2+ihalo) + ! + real (kind=r8), dimension(igno_min:igno_max), intent(in) :: xgno, ygno + ! + ! for Gaussian quadrature + ! + real (kind=r8), dimension(:), intent(in) :: gauss_weights, abscissae !dimension(ngauss) + ! + ! Number of Eulerian sub-cell integrals for the cell in question + ! + integer , intent(out) :: jcollect + ! + ! local workspace + ! + ! + ! max number of line segments is: + ! + ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 + ! + real (kind=r8) , & + dimension(jmax_segments,nreconstruction), intent(out) :: weights + integer , & + dimension(jmax_segments,2), intent(out) :: weights_eul_index + + integer :: jsegment + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer :: jcross_lat + ! + ! max. crossings per side is 2*ihalo + ! + real (kind=r8), & + dimension(max_cross,2) :: r_cross_lat + integer , & + dimension(max_cross,2) :: cross_lat_eul_index + real (kind=r8) , dimension(nvertex) :: xcell,ycell + + xcell = xcell_in(1:nvertex) + ycell = ycell_in(1:nvertex) + + jsegment = 0 + weights = 0.0_r8 + jcross_lat = 0 + + call side_integral(lexact_horizontal_line_integrals,xcell,ycell,nvertex,jsegment,jmax_segments,& + weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,igno_min,igno_max,jx_min, jx_max, jy_min, jy_max,& + ngauss,gauss_weights,abscissae,& + jcross_lat,r_cross_lat,cross_lat_eul_index) + ! + !********************** + ! + ! Do inner integrals + ! + !********************** + ! + call compute_inner_line_integrals_lat(lexact_horizontal_line_integrals,& + r_cross_lat,cross_lat_eul_index,& + jcross_lat,jsegment,xgno,igno_min,igno_max,jx_min, jx_max, jy_min, jy_max,& + weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae) + + IF (ABS((jcross_lat/2)-DBLE(jcross_lat)/2.0_r8)>tiny) then + WRITE(*,*) "number of latitude crossings are not even: ABORT",jcross_lat,jx,jy + STOP + END IF + + ! + ! collect line-segment that reside in the same Eulerian cell + ! + if (jsegment>0) then + call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + else + jcollect = 0 + end if + end subroutine compute_weights_cell + ! + !**************************************************************************** + ! + ! organize data and store it + ! + !**************************************************************************** + ! + subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + implicit none + integer , INTENT(IN ) :: jsegment,jmax_segments + integer , intent(in) :: nreconstruction + ! + real (kind=r8) , dimension(:,:), intent(inout) :: weights !dimension(jmax_segments,nreconstruction) + integer , dimension(:,:), intent(inout) :: weights_eul_index !dimension(jmax_segments,2) + integer , INTENT(OUT ) :: jcollect + ! + ! local workspace + ! + integer :: imin, imax, jmin, jmax, i,j,k,h + logical :: ltmp + + real (kind=r8) , dimension(jmax_segments,nreconstruction) :: weights_out + integer , dimension(jmax_segments,2 ) :: weights_eul_index_out + + weights_out = 0.0_r8 + weights_eul_index_out = -100 + + imin = MINVAL(weights_eul_index(1:jsegment,1)) + imax = MAXVAL(weights_eul_index(1:jsegment,1)) + jmin = MINVAL(weights_eul_index(1:jsegment,2)) + jmax = MAXVAL(weights_eul_index(1:jsegment,2)) + + ltmp = .FALSE. + + jcollect = 1 + + do j=jmin,jmax + do i=imin,imax + do k=1,jsegment + if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then + weights_out(jcollect,1:nreconstruction) = & + weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) + ltmp = .TRUE. + h = k + endif + enddo + if (ltmp) then + weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) + jcollect = jcollect+1 + endif + ltmp = .FALSE. + enddo + enddo + jcollect = jcollect-1 + weights = weights_out + weights_eul_index = weights_eul_index_out + end subroutine collect + ! + !***************************************************************************************** + ! + ! compute crossings with Eulerian latitudes and longitudes + ! + !***************************************************************************************** + ! + subroutine compute_inner_line_integrals_lat(lexact_horizontal_line_integrals,r_cross_lat,& + cross_lat_eul_index,& + jcross_lat,jsegment,xgno,igno_min,igno_max,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae) + implicit none + logical, intent(in) :: lexact_horizontal_line_integrals + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer , intent(in):: jcross_lat, nreconstruction,ngauss,igno_min,igno_max + integer , intent(inout):: jsegment + ! + ! for Gaussian quadrature + ! + real (kind=r8), dimension(ngauss), intent(in) :: gauss_weights, abscissae + ! + ! max. crossings per side is 2*ihalo + ! + + real (kind=r8) , dimension(:,:), intent(in):: r_cross_lat ! dimension(8*ihalo,2) + integer , dimension(:,:), intent(in):: cross_lat_eul_index ! ! dimension(8*ihalo,2) + integer , intent(in):: jx_min, jx_max, jy_min, jy_max + + real (kind=r8), dimension(igno_min:igno_max), intent(in) :: xgno !dimension(-ihalo:nc+2+ihalo) + ! + ! dimension(jmax_segments,nreconstruction) + ! + real (kind=r8), dimension(:,:), intent(inout) :: weights + ! + ! dimension(jmax_segments,2) + ! + integer , dimension(:,:), intent(inout) :: weights_eul_index + + real (kind=r8) , dimension(nreconstruction) :: weights_tmp + integer :: imin,imax,i,j,k,h + real (kind=r8), dimension(2) :: rstart,rend,rend_tmp + real (kind=r8), dimension(2) :: xseg, yseg + 5 FORMAT(10e14.6) + if (jcross_lat>0) then + do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) + ! + ! find "first" crossing with Eulerian cell i + ! + do k=1,jcross_lat + if (cross_lat_eul_index(k,2)==i) exit + enddo + do j=k+1,jcross_lat + ! + ! find "second" crossing with Eulerian cell i + ! + if (cross_lat_eul_index(j,2)==i) then + if (r_cross_lat(k,1)10) THEN + WRITE(*,*) "search not converging",iter + STOP + END IF + lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) + lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) + IF (lsame_cell_x.AND.lsame_cell_y) THEN + ! + !**************************** + ! + ! same cell integral + ! + !**************************** + ! + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + lcontinue = .FALSE. + ! + ! prepare for next side if (x(2),y(2)) is on a grid line + ! + IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN + ! + ! cross longitude jx_eul+1 + ! + jx_eul=jx_eul+1 + ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN + ! + ! register crossing with latitude: line-segments point Northward + ! + jcross_lat = jcross_lat + 1 + jy_eul = jy_eul + 1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + cross_lat_eul_index(jcross_lat,2) = jy_eul + r_cross_lat(jcross_lat,1) = x(2) + r_cross_lat(jcross_lat,2) = y(2) +! write(*,*) "A register crossing with latitude",x(2),y(2),jx_eul,jy_eul + ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" + ysgn2 = INT(SIGN(1.0_r8,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + ! + !******************************************************************************* + ! + ! there is at least one crossing with latitudes but no crossing with longitudes + ! + !******************************************************************************* + ! + yeul = ygno(jy_eul+ysgn1) + IF (x(1).EQ.x(2)) THEN + ! + ! line segment is parallel to longitude (infinite slope) + ! + xcross = x(1) + ELSE + slope = (y(2)-y(1))/(x(2)-x(1)) + xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) + ! + ! constrain crossing to be "physically" possible + ! + xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) + ! + ! debugging + ! + IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN + WRITE(*,*) "xcross is out of range",jx,jy + WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& + xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) + STOP + END IF + END IF + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul + ELSE IF (lsame_cell_y) THEN + ! + !******************************************************************************* + ! + ! there is at least one crossing with longitudes but no crossing with latitudes + ! + !******************************************************************************* + ! + xsgn1 = (1+INT(SIGN(1.0_r8,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" + xsgn2 = INT(SIGN(1.0_r8,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" + xeul = xgno(jx_eul+xsgn1) + IF (ABS(x(2)-x(1))x(1) else "0" + xsgn2 = (INT(SIGN(1.0_r8,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" + xeul = xgno(jx_eul+xsgn1) + ysgn1 = (1+INT(SIGN(1.0_r8,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" + ysgn2 = INT(SIGN(1.0_r8,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + yeul = ygno(jy_eul+ysgn1) + + slope = (y(2)-y(1))/(x(2)-x(1)) + IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN + ! + ! cross latitude + ! + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul +! write(*,*) "D register crossing with latitude",xcross,yeul,jx_eul,cross_lat_eul_index(jcross_lat,2) + ELSE + ! + ! cross longitude + ! + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 + END IF + + END IF + END IF + ! + ! register line-segment (don't register line-segment if outside of panel) + ! + if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& + jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then + jsegment=jsegment+1 + weights_eul_index(jsegment,1) = jx_eul_tmp + weights_eul_index(jsegment,2) = jy_eul_tmp + + call get_weights_exact(lexact_horizontal_line_integrals.AND.ABS(yseg(2)-yseg(1))0) THEN + x_cross_eul_lat = x+(yeul-y)/slope + ELSE + x_cross_eul_lat = bignum + END IF + end function x_cross_eul_lat + + subroutine get_weights_exact(lexact_horizontal_line_integrals,weights,xseg,yseg,nreconstruction,& + ngauss,gauss_weights,abscissae) + use fvm_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 + implicit none + logical, intent(in) :: lexact_horizontal_line_integrals + integer , intent(in) :: nreconstruction, ngauss + real (kind=r8), intent(out) :: weights(:) + real (kind=r8), dimension(:), intent(in) :: gauss_weights, abscissae !dimension(ngauss) + + + real (kind=r8), dimension(:), intent(in) :: xseg,yseg !dimension(2) + ! + ! compute weights + ! + if(lexact_horizontal_line_integrals) then + weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) + if (ABS(weights(1))>1.0_r8) THEN + WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg + stop + end if + if (nreconstruction>1) then + weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) + weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) + endif + if (nreconstruction>3) then + weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) + weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) + weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) + endif + else + call get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + endif + end subroutine get_weights_exact + + + + subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + use fvm_analytic_mod, only: F_00, F_10, F_01, F_20, F_02, F_11 + implicit none + integer , intent(in) :: nreconstruction,ngauss + real (kind=r8), intent(out) :: weights(:) + real (kind=r8), dimension(2 ), intent(in) :: xseg,yseg + real (kind=r8) :: slope + ! + ! compute weights + ! + ! + ! for Gaussian quadrature + ! + real (kind=r8), dimension(ngauss), intent(in) :: gauss_weights, abscissae + + ! if line-segment parallel to x or y use exact formulaes else use qudrature + ! + real (kind=r8) :: b,integral,dx2,xc,x,y + integer :: i + +! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then + if (xseg(1).EQ.xseg(2))then + weights = 0.0_r8 + else + slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) + b = yseg(1)-slope*xseg(1) + dx2 = 0.5_r8*(xseg(2)-xseg(1)) + xc = 0.5_r8*(xseg(1)+xseg(2)) + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_00(x,y) + enddo + weights(1) = integral*dx2 + if (nreconstruction>1) then + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_10(x,y) + enddo + weights(2) = integral*dx2 + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_01(x,y) + enddo + weights(3) = integral*dx2 + endif + if (nreconstruction>3) then + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_20(x,y) + enddo + weights(4) = integral*dx2 + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_02(x,y) + enddo + weights(5) = integral*dx2 + integral = 0.0_r8 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_11(x,y) + enddo + weights(6) = integral*dx2 + endif + end if + end subroutine get_weights_gauss + + subroutine truncate_vertex(x,j_eul,gno,igno_min,igno_max) + implicit none + integer , intent(inout) :: j_eul + integer , intent(in) :: igno_min,igno_max + + real (kind=r8) , intent(inout) :: x + real (kind=r8), dimension(igno_min:igno_max), intent(in) :: gno !dimension(-ihalo:nc+2+ihalo) +! real (kind=r8), intent(in) :: eps + + logical :: lcontinue + integer :: iter, xsgn + real (kind=r8) :: dist,dist_new,tmp + + lcontinue = .TRUE. + iter = 0 + dist = bignum + + xsgn = INT(SIGN(1.0_r8,x-gno(j_eul))) + + DO WHILE (lcontinue) + if ((j_euligno_max)) then + write(*,*) 'something is wrong', j_eul,igno_min,igno_max, iter + stop + endif + iter = iter+1 + tmp = x-gno(j_eul) + dist_new = ABS(tmp) + IF (dist_new>dist) THEN + lcontinue = .FALSE. + ELSE IF (ABS(tmp)<1.0E-9_r8) THEN + x = gno(j_eul) + lcontinue = .FALSE. + ELSE + j_eul = j_eul+xsgn + dist = dist_new + END IF + IF (iter>100) THEN + WRITE(*,*) "truncate vertex not converging" + STOP + END IF + END DO + END subroutine truncate_vertex + + subroutine which_eul_cell(x,j_eul,gno,igno_min,igno_max) + implicit none + integer , intent(inout) :: j_eul + integer , intent(in) :: igno_min,igno_max + real (kind=r8), dimension(:) , intent(in):: x !dimension(3) + real (kind=r8), dimension(igno_min:igno_max), intent(in) :: gno ! dimension(-ihalo:nc+2+ihalo) + + logical :: lcontinue + integer :: iter + + lcontinue = .TRUE. + iter = 0 + + DO WHILE (lcontinue) + iter = iter+1 + IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN + lcontinue = .FALSE. + ! + ! special case when x(1) is on top of grid line + ! + IF (x(1).EQ.gno(j_eul)) THEN + ! + ! x(1) is on top of gno(J_eul) + ! + IF (x(2).GT.gno(j_eul)) THEN + j_eul = j_eul + ELSE IF (x(2).LT.gno(j_eul)) THEN + j_eul = j_eul-1 + ELSE + ! + ! x(2) is on gno(j_eul) grid line; need x(3) to determine Eulerian cell + ! + IF (x(3).GT.gno(j_eul)) THEN + ! + ! x(3) to the right + ! + j_eul = j_eul + ELSE IF (x(3).LT.gno(j_eul)) THEN + ! + ! x(3) to the left + ! + j_eul = j_eul-1 + ELSE + WRITE(*,*) "inconsistent cell: x(1)=x(2)=x(3)",x(1),x(2),x(3) + STOP + END IF + END IF + END IF + ELSE + ! + ! searching - prepare for next iteration + ! + IF (x(1).GE.gno(j_eul+1)) THEN + j_eul = j_eul + 1 + ELSE + ! + ! x(1).LT.gno(j_eul) + ! + j_eul = j_eul - 1 + END IF + END IF + IF (iter>1000.OR.j_euligno_max) THEN + WRITE(*,*) "search is which_eul_cell not converging!", iter, j_eul,igno_min,igno_max + WRITE(*,*) "gno", gno(igno_min), gno(igno_max) + write(*,*) gno + STOP + END IF + END DO + END subroutine which_eul_cell + + + function fuzzy(x,epsilon) + implicit none + + integer :: fuzzy + real (kind=r8), intent(in) :: epsilon + real (kind=r8) :: x + + IF (ABS(x)epsilon) THEN + fuzzy = 1 + ELSE !IF (x < fuzzy_width) THEN + fuzzy = -1 + ENDIF + end function + +end module fvm_overlap_mod diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 new file mode 100644 index 0000000000..e8b7689c89 --- /dev/null +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -0,0 +1,1753 @@ +!MODULE FVM_RECONSTRUCTION_MOD--------------------------------------CE-for FVM! + ! AUTHOR: CHRISTOPH ERATH, 17.October 2011 ! + ! This module contains everything to do (ONLY) a CUBIC (3rd order) reconstruction ! + ! ! + ! IMPORTANT: the implementation is done for a ncfl > 1, which is not working ! + ! but it works for ncfl=1 ! + ! + ! This module has been recoded for multi-tracer efficiency (May, 2014) + ! + !---------------------------------------------------------------------------! +module fvm_reconstruction_mod + + use shr_kind_mod, only: r8=>shr_kind_r8 + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + use cam_abortutils, only: endrun + use perf_mod, only: t_startf, t_stopf + + + implicit none + private +! integer, parameter, private:: nh = nhr+(nhe-1) ! = 2 (nhr=2; nhe=1) + ! = 3 (nhr=2; nhe=2) + public :: reconstruction, recons_val_cart, extend_panel_interpolate +!reconstruction_gradient, +contains + ! ----------------------------------------------------------------------------------! + !SUBROUTINE RECONSTRUCTION------------------------------------------------CE-for FVM! + ! AUTHOR: CHRISTOPH ERATH, 17.October 2011 ! + ! DESCRIPTION: controls the cubic (3rd order) reconstructions: ! + ! ! + ! CALLS: fillhalo_cubic, reconstruction_cubic ! + ! INPUT: fcube ... tracer values incl. the halo zone ! + ! fvm ... structure incl. tracer values aso ! ! + ! OUTPUT:recons ... has the reconstruction coefficients (5) for the 3rd order ! + ! reconstruction: dx, dy, dx^2, dy^2, dxdy ! + !-----------------------------------------------------------------------------------! + subroutine reconstruction(fcube,recons,irecons,llimiter,ntrac_in,& + nc,nhe,nhr,nhc,nht,ns,nh,& + jx_min,jx_max,jy_min,jy_max,& + cubeboundary,halo_interp_weight,ibase,& + spherecentroid,& + recons_metrics,recons_metrics_integral,& + rot_matrix,centroid_stretch,& + vertex_recons_weights,vtx_cart& + ) + implicit none + ! + ! dimension(1-nhc:nc+nhc, 1-nhc:nc+nhc) + ! + integer, intent(in) :: irecons + integer, intent(in) :: ntrac_in,nc,nhe,nhr,nhc,nht,ns,nh,cubeboundary + real (kind=r8), dimension(1-nhc:nc+nhc,1-nhc:nc+nhc,ntrac_in), intent(inout) :: fcube + real (kind=r8), dimension(irecons,1-nhe:nc+nhe,1-nhe:nc+nhe,ntrac_in), intent(out) :: recons + integer, intent(in) :: jx_min(3), jx_max(3), jy_min(3), jy_max(3) + integer , intent(in):: ibase(1-nh:nc+nh,1:nhr,2) + real (kind=r8), intent(in):: halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,2) + real (kind=r8), intent(in):: spherecentroid(irecons-1,1-nhe:nc+nhe,1-nhe:nc+nhe) + real (kind=r8), intent(in):: recons_metrics(3,1-nhe:nc+nhe,1-nhe:nc+nhe) + real (kind=r8), intent(in):: recons_metrics_integral(3,1-nhe:nc+nhe,1-nhe:nc+nhe) + integer , intent(in):: rot_matrix(2,2,1-nhc:nc+nhc,1-nhc:nc+nhc) + real (kind=r8), intent(in):: centroid_stretch(7,1-nhe:nc+nhe,1-nhe:nc+nhe) + real (kind=r8), intent(in):: vertex_recons_weights(1:irecons-1,4,1-nhe:nc+nhe,1-nhe:nc+nhe) + real (kind=r8), intent(in):: vtx_cart(4,2,1-nhc:nc+nhc,1-nhc:nc+nhc) + + logical, intent(in) :: llimiter(ntrac_in) + + real (kind=r8), dimension(1-nht:nc+nht,1-nht:nc+nht,3) :: f + + integer :: i,j,in,h,itr + integer, dimension(2,3) :: jx,jy + + jx(1,1)=jx_min(1); jx(2,1)=jx_max(1)-1 + jx(1,2)=jx_min(2); jx(2,2)=jx_max(2)-1 + jx(1,3)=jx_min(3); jx(2,3)=jx_max(3)-1 + + jy(1,1)=jy_min(1); jy(2,1)=jy_max(1)-1 + jy(1,2)=jy_min(2); jy(2,2)=jy_max(2)-1 + jy(1,3)=jy_min(3); jy(2,3)=jy_max(3)-1 + + call t_startf('FVM:reconstruction:part#1') + recons=0.0_r8 + if (nhe>0) then + do itr=1,ntrac_in +! f=-9e9_r8 + call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& + fcube(:,:,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) + if (irecons>1) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& + rot_matrix,centroid_stretch,nc,nht,nhe,nhc) + end do + else + do itr=1,ntrac_in +! f=-9e9_r8!to avoid floating point exception for uninitialized variables +! !in non-existent cells (corners of cube) + call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& + fcube(:,:,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) + if (irecons>1) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& + rot_matrix,centroid_stretch,nc,nht,nhe,nhc) + end do + end if + call t_stopf('FVM:reconstruction:part#1') + call t_startf('FVM:reconstruction:part#2') + + ! + ! fill in non-existent (in physical space) corner values to simplify + ! logic in limiter code (min/max operation) + ! + do itr=1,ntrac_in + if (llimiter(itr)) then + if (cubeboundary>4) then + select case(cubeboundary) + case (nwest) + do h=1,nhe+1 + fcube(0,nc+h ,itr) = fcube(1-h,nc ,itr) + fcube(1-h,nc+1,itr) = fcube(1 ,nc+h,itr) + end do + case (swest) + do h=1,nhe+1 + fcube(1-h,0,itr) = fcube(1,1-h,itr) + fcube(0,1-h,itr) = fcube(1-h,1,itr) + end do + case (seast) + do h=1,nhe+1 + fcube(nc+h,0 ,itr) = fcube(nc,1-h,itr) + fcube(nc+1,1-h,itr) = fcube(nc+h,1,itr) + end do + case (neast) + do h=1,nhe+1 + fcube(nc+h,nc+1,itr) = fcube(nc,nc+h,itr) + fcube(nc+1,nc+h,itr) = fcube(nc+h,nc,itr) + end do + end select + end if + call slope_limiter(nhe,nc,nhc,fcube(:,:,itr),jx,jy,irecons,recons(:,:,:,itr),& + spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe),& + recons_metrics,vertex_recons_weights,vtx_cart ) +! call slope_limiter(fvm,fcube(:,:,itr),jx,jy,irecons,recons(:,:,:,itr)) + end if + end do + + call t_stopf('FVM:reconstruction:part#2') + call t_startf('FVM:reconstruction:part#3') + select case (irecons) + case(1) + do in=1,3 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + recons(1,i,j,1:ntrac_in) = fcube(i,j,1:ntrac_in) + end do + end do + end do + case(3) +! do j=1-nhe,nc+nhe +! do i=1-nhe,nc+nhe + do in=1,3 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + recons(1,i,j,1:ntrac_in) = fcube(i,j,1:ntrac_in) & + - recons(2,i,j,1:ntrac_in)*spherecentroid(1,i,j) & + - recons(3,i,j,1:ntrac_in)*spherecentroid(2,i,j) + recons(2,i,j,1:ntrac_in) = recons(2,i,j,1:ntrac_in) + recons(3,i,j,1:ntrac_in) = recons(3,i,j,1:ntrac_in) + end do + end do + end do + case(6) + do itr=1,ntrac_in +! do j=1-nhe,nc+nhe +! do i=1-nhe,nc+nhe + do in=1,3 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + +! recons(1,i,j,itr) = fcube(i,j,itr) !hack first-order +! recons(2:6,i,j,itr) = 0.0_r8 !hack first-order + + recons(1,i,j,itr) = fcube(i,j,itr) & + - recons(2,i,j,itr)*spherecentroid(1,i,j) & + - recons(3,i,j,itr)*spherecentroid(2,i,j) & + + recons(4,i,j,itr)*recons_metrics_integral(1,i,j) & + + recons(5,i,j,itr)*recons_metrics_integral(2,i,j) & + + recons(6,i,j,itr)*recons_metrics_integral(3,i,j) + recons(2,i,j,itr) = recons(2,i,j,itr) & + - recons(4,i,j,itr)*2.0_r8*spherecentroid(1,i,j) & + - recons(6,i,j,itr) *spherecentroid(2,i,j) + recons(3,i,j,itr) = recons(3,i,j,itr) & + - recons(5,i,j,itr)*2.0_r8*spherecentroid(2,i,j) & + - recons(6,i,j,itr)*spherecentroid(1,i,j) + ! + ! recons(i,j,4:6) already set in get_gradients + ! + end do + end do + end do + end do + case default + write(*,*) "irecons out of range in get_ceof", irecons + end select + call t_stopf('FVM:reconstruction:part#3') + + ! recons(a,b,3) * (centroid(a,b,1)**2 - centroid(a,b,3)) + & + ! recons(a,b,4) * (centroid(a,b,2)**2 - centroid(a,b,4)) + & + ! recons(a,b,5) * (centroid(a,b,1) * centroid(a,b,2) - centroid(a,b,5)) + & + + + ! call debug_halo(fvm,fcubenew,fpanel) + ! call debug_halo_recons(fvm,recons,recons_trunk) + ! call print_which_case(fvm) + ! + ! call debug_halo_neighbor (fvm,fotherface,fotherpanel) + ! call debug_halo_neighbor_recons(fvm,recons,recons_trunk) + end subroutine reconstruction + !END SUBROUTINE RECONSTRUCTION--------------------------------------------CE-for FVM! + + subroutine get_gradients(f,jx,jy,irecons,gradient,rot_matrix,centroid_stretch,nc,nht,nhe,nhc) + implicit none + integer, intent(in) :: irecons,nc,nht,nhe,nhc + real (kind=r8), dimension(1-nht:nc+nht,1-nht:nc+nht,3), intent(in) :: f + real (kind=r8), dimension(irecons,1-nhe:nc+nhe,1-nhe:nc+nhe), intent(inout):: gradient + integer, dimension(2,3), intent(in) :: jx,jy + integer , dimension(2,2,1-nhc:nc+nhc,1-nhc:nc+nhc), intent(in) :: rot_matrix + real (kind=r8), dimension(7,1-nhe:nc+nhe,1-nhe:nc+nhe), intent(in) :: centroid_stretch + + integer :: i,j,in + real (kind=r8), dimension(2) :: g + real (kind=r8) :: sign + + select case (irecons) + case(3) + in=1 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + ! + ! df/dx: 4-th-order finite difference: (-f(i+2)+8f(i+1)-8f(i-1)+f(i-2))/12dx + ! + gradient(2,i,j) = -f(i+2,j ,in)+8.0_r8*f(i+1,j ,in)-8.0_r8*f(i-1,j ,in)+f(i-2,j ,in) + gradient(3,i,j) = -f(i ,j+2,in)+8.0_r8*f(i ,j+1,in)-8.0_r8*f(i ,j-1,in)+f(i ,j-2,in) + end do + end do + do in=2,3 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + g(1) = -f(i+2,j ,in)+8.0_r8*f(i+1,j ,in)-8.0_r8*f(i-1,j ,in)+f(i-2,j ,in) + g(2) = -f(i ,j+2,in)+8.0_r8*f(i ,j+1,in)-8.0_r8*f(i ,j-1,in)+f(i ,j-2,in) + gradient(2:3,i,j) = MATMUL(rot_matrix(:,:,i,j),g(:)) + end do + end do + end do + gradient(2,:,:) = centroid_stretch(1,:,:)*gradient(2,:,:) + gradient(3,:,:) = centroid_stretch(2,:,:)*gradient(3,:,:) + case (6) + in=1 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + ! + ! df/dx: 4-th-order finite difference: (-f(i+2)+8f(i+1)-8f(i-1)+f(i-2))/12dx + ! + gradient(2,i,j) = -f(i+2,j ,in)+ 8.0_r8*f(i+1,j ,in) - 8.0_r8*f(i-1,j ,in)+f(i-2,j ,in) + gradient(3,i,j) = -f(i ,j+2,in)+ 8.0_r8*f(i ,j+1,in) - 8.0_r8*f(i ,j-1,in)+f(i ,j-2,in) + ! + ! d2f/dx2: + ! + gradient(4,i,j) = -f(i+2,j ,in)+16.0_r8*f(i+1,j ,in)-30.0_r8*f(i,j,in)+16.0_r8*f(i-1,j ,in)-f(i-2,j ,in) + gradient(5,i,j) = -f(i ,j+2,in)+16.0_r8*f(i ,j+1,in)-30.0_r8*f(i,j,in)+16.0_r8*f(i ,j-1,in)-f(i ,j-2,in) + + gradient(6,i,j) = f(i+1,j+1,in)- f(i+1,j-1,in) - f(i-1,j+1,in)+f(i-1,j-1,in) + ! + ! "stretching factors + ! + gradient(2,i,j) = centroid_stretch(1,i,j)*gradient(2,i,j) + gradient(3,i,j) = centroid_stretch(2,i,j)*gradient(3,i,j) + + gradient(4,i,j) = centroid_stretch(3,i,j)*gradient(4,i,j)+centroid_stretch(6,i,j)*gradient(2,i,j) + gradient(5,i,j) = centroid_stretch(4,i,j)*gradient(5,i,j)+centroid_stretch(7,i,j)*gradient(3,i,j) + + gradient(6,i,j) = centroid_stretch(5,i,j)*gradient(6,i,j) + end do + end do + do in=2,3 + if (SUM(rot_matrix(:,:,jx(1,in),jy(1,in)))==0) then + sign=-1 + else + sign=1 + end if + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + g(1) = -f(i+2,j ,in)+8.0_r8*f(i+1,j ,in)-8.0_r8*f(i-1,j ,in)+f(i-2,j ,in) + g(2) = -f(i ,j+2,in)+8.0_r8*f(i ,j+1,in)-8.0_r8*f(i ,j-1,in)+f(i ,j-2,in) + gradient(2:3,i,j) = MATMUL(rot_matrix(:,:,i,j),g(:)) + + g(1) = -f(i+2,j ,in)+16.0_r8*f(i+1,j ,in)-30.0_r8*f(i,j,in)+16.0_r8*f(i-1,j ,in)-f(i-2,j ,in) + g(2) = -f(i ,j+2,in)+16.0_r8*f(i ,j+1,in)-30.0_r8*f(i,j,in)+16.0_r8*f(i ,j-1,in)-f(i ,j-2,in) + gradient(4:5,i,j) = MATMUL(ABS(rot_matrix(:,:,i,j)),g(:)) + + gradient(6,i,j) = sign*(f(i+1,j+1,in)- f(i+1,j-1,in) - f(i-1,j+1,in)+f(i-1,j-1,in)) + ! + ! "stretching factors + ! + gradient(2,i,j) = centroid_stretch(1,i,j)*gradient(2,i,j) + gradient(3,i,j) = centroid_stretch(2,i,j)*gradient(3,i,j) + + gradient(4,i,j) = centroid_stretch(3,i,j)*gradient(4,i,j)+centroid_stretch(6,i,j)*gradient(2,i,j) + gradient(5,i,j) = centroid_stretch(4,i,j)*gradient(5,i,j)+centroid_stretch(7,i,j)*gradient(3,i,j) + + gradient(6,i,j) = centroid_stretch(5,i,j)*gradient(6,i,j) + end do + end do + end do + case default + call endrun('ERROR: irecons out of range in fvm_reconstruction_mod') + end select + end subroutine get_gradients + + + subroutine slope_limiter(nhe,nc,nhc,fcube,jx,jy,irecons,recons,spherecentroid,recons_metrics,& + vertex_recons_weights,vtx_cart) + implicit none + integer , intent(in) :: irecons,nhe,nc,nhc + real (kind=r8), dimension(1-nhc:, 1-nhc:), intent(inout) :: fcube + real (kind=r8), dimension(irecons,1-nhe:nc+nhe,1-nhe:nc+nhe), intent(inout):: recons + integer, dimension(2,3) , intent(in) :: jx,jy + real (kind=r8), dimension(irecons-1,1-nhe:nc+nhe,1-nhe:nc+nhe) , intent(in) :: spherecentroid + real (kind=r8), dimension(3,1-nhe:nc+nhe,1-nhe:nc+nhe) , intent(in) :: recons_metrics + real (kind=r8), dimension(1:irecons-1,4,1-nhe:nc+nhe,1-nhe:nc+nhe), intent(in) :: vertex_recons_weights + real (kind=r8), dimension(4,2,1-nhc:nc+nhc,1-nhc:nc+nhc) , intent(in) :: vtx_cart + + real (kind=r8):: minval_patch,maxval_patch + real (kind=r8):: phi, min_val, max_val,disc + + real (kind=r8):: min_phi + real (kind=r8):: extrema(2), xminmax(2),yminmax(2),extrema_value(13) + + real(kind=r8) :: invtmp ! temporary to pre-compute inverses + integer :: itmp1,itmp2,i,j,in,vertex,n + +! real (kind=r8), dimension(-1:5) :: diff_value + real (kind=r8), parameter :: threshold = 1.e-12_r8 + select case (irecons) + ! + ! PLM limiter + ! + + case(3) + do in=1,3 + do j=jy(1,in),jy(2,in) + do i=jx(1,in),jx(2,in) + ! do j=1-nhe,nc+nhe + ! do i=1-nhe,nc+nhe + ! if (mask(i,j)) then + + !rck combined min/max and unrolled inner loop + !minval_patch = MINVAL(fcube(i-1:i+1,j-1:j+1)) + !maxval_patch = MAXVAL(fcube(i-1:i+1,j-1:j+1)) + minval_patch = fcube(i-1,j-1) + maxval_patch = fcube(i-1,j-1) + do itmp2=j-1,j+1 + minval_patch = min(minval_patch,fcube(i-1,itmp2),fcube(i,itmp2),fcube(i+1,itmp2)) + maxval_patch = max(maxval_patch,fcube(i-1,itmp2),fcube(i,itmp2),fcube(i+1,itmp2)) + enddo + min_phi=1.0_r8 + !rck restructured loop + do vertex=1,4 + extrema_value(vertex) = & + SUM(recons(2:irecons,i,j)*vertex_recons_weights(1:irecons-1,vertex,i,j))+fcube(i,j) + call slopelimiter_val(extrema_value(vertex), fcube(i,j),minval_patch, maxval_patch, min_phi) + end do + max_val = MAXVAL(extrema_value(1:4)) + min_val = MINVAL(extrema_value(1:4)) +! if (ABS(min_val-fcube(i,j))<1.0D-16.or.ABS(max_val-fcube(i,j))<1.0D-16) then +! min_phi=0.0_r8 +! else + if (max_val>maxval_patch) then + phi = (maxval_patch-fcube(i,j))/(max_val-fcube(i,j)) + if (phi threshold) then + extrema(1) = recons(6,i,j) * recons(3,i,j) - 2.0_r8 * recons(5,i,j) * recons(2,i,j) + extrema(2) = recons(6,i,j) * recons(2,i,j) - 2.0_r8 * recons(4,i,j) * recons(3,i,j) + + disc=1.0_r8/disc + extrema(1) = extrema(1) * disc + spherecentroid(1,i,j) + extrema(2) = extrema(2) * disc + spherecentroid(2,i,j) + if ( (extrema(1) - xminmax(1) > -threshold) .and. & !xmin + (extrema(1) - xminmax(2) < threshold) .and. & !xmax + (extrema(2) - yminmax(1) > -threshold) .and. & !ymin + (extrema(2) - yminmax(2) < threshold)) then !ymax + call recons_val_cart(fcube(i,j), extrema(1), extrema(2), spherecentroid(:,i,j), & + recons_metrics(:,i,j), recons(:,i,j), extrema_value(5)) + endif + endif + ! + ! Check all potential minimizer points along element boundaries + ! + if (abs(recons(6,i,j)) > threshold) then + invtmp = 1.0d0 / (recons(6,i,j) + spherecentroid(2,i,j)) + do n=1,2 + ! Left edge, intercept with du/dx = 0 + extrema(2) = invtmp * (-recons(2,i,j) - 2.0_r8 * recons(4,i,j) * (xminmax(n) - spherecentroid(1,i,j))) + if ((extrema(2) > yminmax(1)-threshold) .and. (extrema(2) < yminmax(2)+threshold)) then + call recons_val_cart(fcube(i,j), xminmax(n), extrema(2), spherecentroid(:,i,j), & + recons_metrics(:,i,j), recons(:,i,j), extrema_value(5+n)) + endif + enddo + ! Top/bottom edge, intercept with du/dy = 0 + invtmp = 1.0d0 / recons(6,i,j) + spherecentroid(1,i,j) + do n = 1,2 + extrema(1) = invtmp * (-recons(3,i,j) - 2.0_r8 * recons(5,i,j) * (yminmax(n) - spherecentroid(2,i,j))) + if ((extrema(1) > xminmax(1)-threshold) .and. (extrema(1) < xminmax(2)+threshold)) then + call recons_val_cart(fcube(i,j), extrema(1), yminmax(n),spherecentroid(:,i,j), & + recons_metrics(:,i,j), recons(:,i,j), extrema_value(7+n)) + endif + enddo + endif + + ! Top/bottom edge, y=const., du/dx=0 + if (abs(recons(4,i,j)) > threshold) then + invtmp = 1.0d0 / (2.0_r8 * recons(4,i,j))! + spherecentroid(1,i,j) + do n = 1,2 + extrema(1) = spherecentroid(1,i,j)+& + invtmp * (-recons(2,i,j) - recons(6,i,j) * (yminmax(n) - spherecentroid(2,i,j))) + + if ((extrema(1) > xminmax(1)-threshold) .and. (extrema(1) < xminmax(2)+threshold)) then + call recons_val_cart(fcube(i,j), extrema(1), yminmax(n), spherecentroid(:,i,j),& + recons_metrics(:,i,j),recons(:,i,j), extrema_value(9+n)) + endif + enddo + endif + ! Left/right edge, x=const., du/dy=0 + if (abs(recons(5,i,j)) > threshold) then + invtmp = 1.0d0 / (2.0_r8 * recons(5,i,j)) + do n = 1,2 + extrema(2) = spherecentroid(2,i,j)+& + invtmp * (-recons(3,i,j) - recons(6,i,j) * (xminmax(n) - spherecentroid(1,i,j))) + + if ((extrema(2)>yminmax(1)-threshold) .and. (extrema(2) < yminmax(2)+threshold)) then + call recons_val_cart(fcube(i,j), xminmax(n), extrema(2), spherecentroid(:,i,j), & + recons_metrics(:,i,j), recons(:,i,j), extrema_value(11+n)) + endif + enddo + endif + !rck - combined min/max calculation and unrolled + ! max_val = MAXVAL(extrema_value) + ! min_val = MINVAL(extrema_value) + max_val = extrema_value(13) + min_val = extrema_value(13) + do itmp1 = 1,12,4 + max_val = max(max_val, extrema_value(itmp1),extrema_value(itmp1+1),extrema_value(itmp1+2),extrema_value(itmp1+3)) + min_val = min(min_val, extrema_value(itmp1),extrema_value(itmp1+1),extrema_value(itmp1+2),extrema_value(itmp1+3)) + enddo + !rck + + if (max_val>maxval_patch.and.abs(max_val-fcube(i,j))>threshold) then + phi = (maxval_patch-fcube(i,j))/(max_val-fcube(i,j)) + if (phithreshold) then + phi = (minval_patch-fcube(i,j))/(min_val-fcube(i,j)) + if (phi in cube CARTESIAN coordinates ! + ! ! + ! INPUT: fcube ... tracer values incl. the halo zone ! + ! cartx ... x cartesian coordinate of the evaluation point ! + ! carty ... y cartesian coordinate of the evaluation point ! + ! centroid.. x,y,x^2,y^2,xy ! + ! recons ... array of reconstructed coefficients ! + ! OUTPUT: value ... evaluation at a given point ! + !-----------------------------------------------------------------------------------! + SUBROUTINE recons_val_cart(fcube, cartx, carty, centroid, pre_computed_metrics, recons, value) + IMPLICIT NONE + REAL(KIND=r8), intent(in) :: fcube + REAL(KIND=r8), intent(in) :: cartx, carty + REAL(KIND=r8), dimension(1:5), intent(in) :: centroid + REAL(KIND=r8), dimension(3), intent(in) :: pre_computed_metrics + REAL(KIND=r8), dimension(1:6), intent(in) :: recons + REAL(KIND=r8), intent(out) :: value + real(kind=r8) :: dx, dy + dx = cartx - centroid(1) + dy = carty - centroid(2) + ! Evaluate constant order terms + value = fcube + & + ! Evaluate linear order terms + recons(2) * dx + & + recons(3) * dy + & + ! Evaluate second order terms + recons(4) * (pre_computed_metrics(1) + dx*dx) + & + recons(5) * (pre_computed_metrics(2) + dy*dy) + & + recons(6) * (pre_computed_metrics(3) + dx*dy) +END SUBROUTINE recons_val_cart + + + ! ----------------------------------------------------------------------------------! + !SUBROUTINE SLOPELIMITER_VAL----------------------------------------------CE-for FVM! + ! AUTHOR: CHRISTOPH ERATH, 30.November 2011 ! + ! DESCRIPTION: returns the value from the reconstruction (3rd order Taylor polynom) ! + ! at the point (cartx,carty) -> in cube CARTESIAN coordinates ! + ! ! + ! INPUT: value ... point value (calculated here by recons_val_cart) ! + ! cell_value ... tracer value (in the cell center) of the cell ! + ! local_min ... minmal value in the patch ! + ! local_max ... maximal value in the patch ! + ! INPUT/OUTPUT: min_phi ... slope limiter, inout because we go through any possible ! + ! extrema on the cell ! + !-----------------------------------------------------------------------------------! + subroutine slopelimiter_val(value, cell_value, local_min, local_max, min_phi) + implicit none + real (kind=r8), intent(in) :: value, cell_value + real (kind=r8), intent(in) :: local_min, local_max + real (kind=r8), intent(inout) :: min_phi + real (kind=r8) :: phi + + phi= 0.0_r8 + ! Check against the minimum bound on the reconstruction + if (value - cell_value > 1.0e-12_r8 * value) then + phi = (local_max - cell_value) / (value - cell_value) + if (phi < min_phi) then + min_phi = phi + endif + ! Check against the maximum bound on the reconstruction + elseif (value - cell_value < -1.0e-12_r8 * value) then + phi = (local_min - cell_value) / (value - cell_value) + if(phi < min_phi) then + min_phi = phi + endif + endif + end subroutine slopelimiter_val + !END SUBROUTINE SLOPELIMITER_VAL------------------------------------------CE-for FVM! + + function matmul_w(w,f,ns) + implicit none + real (kind=r8) :: matmul_w + real (kind=r8),dimension(:), intent(in) :: w,f !dimension(ns) + integer, intent(in) :: ns + integer :: k + matmul_w = 0.0_r8 + do k=1,ns + matmul_w = matmul_w+w(k)*f(k) + end do + end function matmul_w + + ! special hard-coded version of the function where ns=3 + ! for performance optimization +! function matmul_w(w, f) +! IMPLICIT NONE +! REAL(KIND=r8), dimension(3), intent(in) :: w +! REAL(KIND=r8), dimension(3), intent(in) :: f +! REAL(KIND=r8) :: matmul_w +! matmul_w = w(1)*f(1) + w(2)*f(2) + w(3)*f(3) +! end function matmul_w + + subroutine extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,fcube,cubeboundary,halo_interp_weight,ibase,& + fpanel,fotherpanel) + implicit none + integer, intent(in) :: cubeboundary,nc,nhr,nht,nh,nhc,ns + real (kind=r8), & + dimension(1-nhc:nc+nhc, 1-nhc:nc+nhc), intent(in) :: fcube + + real (kind=r8), intent(in) :: halo_interp_weight(1:ns,1-nh:nc+nh,1:nhr,2) + integer , intent(in) :: ibase(1-nh:nc+nh,1:nhr,2) + + real (kind=r8) , dimension(1-nht:nc+nht, 1-nht:nc+nht ), intent(out) :: fpanel + real (kind=r8), dimension(1-nht:nc+nht,1-nht:nc+nht,2), intent(out), optional :: fotherpanel + + integer :: i, halo,ibaseref + real (kind=r8), dimension(1:ns,1-nh:nc+nh,1:nhr) :: w + ! + ! fpanel = 1.0E19 !dbg + ! + ! + ! Stencil for reconstruction is: + ! + ! --------------------- + ! | | | i | | | + ! --------------------- + ! | | i | i | i | | + ! --------------------- + ! | i | i | R | i | i | + ! --------------------- + ! | | i | i | i | | + ! --------------------- + ! | | | i | | | + ! --------------------- + ! + ! where + ! + ! "R" is cell for which we whish to do the reconstruction + ! "i" is the stencil + ! + ! + ! If one or more point in the stencil is on another panel(s) then we need to interpolate + ! to a stencil that is an extension of the panel on which R is located + ! (this is done using one dimensional cubic Lagrange interpolation along panel side) + ! + ! Example: say that southern most "s" on Figure above is on another panels projection then the stencil becomes + ! + ! + ! --------------------------------- + ! | | | | | | i | | | + ! ----------------|---------------- + ! | | | | | i | i | i | | + ! ----------------|---------------- + ! | | | | i | i | R | i | i | + ! ----------------|---------------- + ! | | | | | i | i | i | | + ! --------------------------------- + ! / / / / / S /S&i/ S / S / + ! /---/---/---/---/---/---/---/---/ + ! / / / / / / / / / + !/---/---/---/---/---/---/---/---/ + ! + ! + ! where "S" are the cell average values used for the cubic interpolation (located on the South panel) + ! + ! + if (cubeboundary==0) then + fpanel(1-nht:nc+nht,1-nht:nc+nht)=fcube(1-nht:nc+nht,1-nht:nc+nht) + else if (cubeboundary==west) then + ! ! + ! ! Case shown below: nhr=2, nhe=1, nht=nhr+nhe + ! ! (nhr = reconstruction width along x and y) + ! ! (nhe = max. Courant number) + ! ! + ! ! + ! Figure below shows the element in question ! In terms of data structure: + ! (center element) and the surrounding elements ! + ! on the element in question's projection ! * "H" is on same panel average value + ! ! * "w" is west panel average values that need + ! Notation: "0" marks the element boundaries ! to be interpolated to main element + ! ! projection + ! Elements to the west are on a different projection ! * "i" is extra halo required by the cubic + ! ! interpolation + ! 0 ! + ! |0000 ! + ! | |00000 ! + ! |\--| |000000000000000000000000000000000000 ! -x---x---x---x---x---x---x---x---x---x---x---x + ! | |\--| 0 | | | 0 | | | 0 ! | | | i | | | | | | | | | + ! |\--| |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! | |\--| 0 | | | 0 | | | 0 ! | | i | i | H | H | H | H | H | | | | + ! |\--| |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! 0 |\--| 0 | | | 0 | | | 0 ! | | i | w | H | H | H | H | H | H | | | + ! |0000 |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! | |0000 0 | | | 0 | | | 0 ! | | w | w | r | r | r | r | r | H | H | | + ! |\--| |000000000000000000000000000000000000 ! -x---x---x---00000000000000000---x---x---x---x + ! | |\--| 0 | | | 0 | | | 0 ! | | w | w 0 r | r | r | r 0 r | H | H | | + ! |\--| \---0---------------0---------------0 ! -------------0---------------0---------------x + ! | |\--| 0 | | | 0 | | | 0 ! | | w | w 0 r | r | r | r 0 r | H | H | | + ! |\--| \---0---------------0---------------0 ! -------------0---------------0---------------x + ! 0 |\--| 0 | | | 0 | | | 0 ! | | w | w 0 r | r | r | r 0 r | H | H | | + ! |0000 |\--0---------------0---------------0 ! -------------0---------------0---------------x + ! | |0000 0 | | | 0 | | | 0 ! | | w | w 0 r | r | r | r 0 r | H | H | | + ! |\--| |000000000000000000000000000000000000 ! -x---x---x---00000000000000000---x---x---x---x + ! | |\--| 0 | | | 0 | | | 0 ! | | w | w | r | r | r | r | r | H | H | | + ! |\--| |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! | |\--| 0 | | | 0 | | | 0 ! | | i | w | H | H | H | H | H | H | | | + ! |\--| |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! 0 |\--| 0 | | | 0 | | | 0 ! | | i | i | H | H | H | H | H | | | | + ! 0000 |\--0---------------0---------------0 ! -------------x---------------x---------------x + ! 0000 0 | | | 0 | | | 0 ! | | | i | | | | | | | | | + ! 000000000000000000000000000000000000 ! -x---x---x---x---x---x---x---x---x---x---x---x + ! + ! + ! -2 |-1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 + ! + ! + ! + ! fill in values (incl. halo) that are on the "main" panels projection + ! + fpanel(1:nc+nht,1-nht:nc+nht)=fcube(1:nc+nht,1-nht:nc+nht) + ! + ! fill in values that are on the west panels projection + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref=ibase(i,halo,1) + ! ibaseref = ibase(i,halo,1) + fpanel(1-halo ,i) = matmul_w(w(:,i,halo),fcube(1-halo ,ibaseref:ibaseref+ns-1),ns) + end do + end do + + if (present(fotherpanel)) then + ! + ! fill in values that are on the west panels projection + ! + fotherpanel (1-nht:0,1-nht:nc+nht,1)=fcube(1-nht:0,1-nht:nc+nht) + ! + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref=ibase(i,halo,1) + ! + ! Exploit symmetry in interpolation weights + ! + fotherpanel(halo,i,1) = matmul_w(w(:,i,halo),fcube(halo ,ibaseref:ibaseref+ns-1),ns) + end do + end do + end if + else if (cubeboundary==east) then + ! + ! north part is on different panel + ! + ! stencil + ! + ! CN<1 case ! + ! ! + ! + ! + ! 0 ! + ! 0000| ! + ! 0000| | ! + ! 000000000000000000000000000000000000| |--/| ! x---x---x---x---x---x---x---x---x---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | | | | | | | | i | | | + ! 0---------------0---------------0--/ |--/| ! x---------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | | | H | H | H | H | H | i | i | | + ! 0---------------0---------------0--/| |--/| ! x---------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 |--/| 0 ! | | | H | H | H | H | H | H | e | i | | + ! 0---------------0---------------0--/| 0000| ! x---------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 0000| | ! | | H | H | r | r | r | r | r | e | e | | + ! 000000000000000000000000000000000000| |--/| ! x---x---x---x---00000000000000000---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | H | H | r 0 r | r | r | r 0 e | e | | + ! 0---------------0---------------0--/| |--/| ! x---------------0---------------0---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | H | H | r 0 r | r | r | r 0 e | e | | + ! 0---------------0---------------0--/| |--/| ! x---------------0---------------0---x---x---x- + ! 0 | | | 0 | | | 0 |--/| 0 ! | | H | H | r 0 r | r | r | r 0 e | e | | + ! 0---------------0---------------0--/| 0000| ! x---------------0---------------0---x---x---x- + ! 0 | | | 0 | | | 0 0000| | ! | | H | H | r 0 r | r | r | r 0 e | e | | + ! 000000000000000000000000000000000000| |--/| ! x---x---x---x---00000000000000000---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | H | H | r | r | r | r | r | e | e | | + ! 0---------------0---------------0--/| |--/| ! ----------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 |--/| | ! | | | H | H | H | H | H | H | e | i | | + ! 0---------------0---------------0--/| |--/| ! ----------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 |--/| 0 ! | | | | H | H | H | H | H | i | i | | + ! 0---------------0---------------0--/| 0000 ! ----------------x---------------x---x---x---x- + ! 0 | | | 0 | | | 0 0000 ! | | | | | | | | | i | | | + ! 000000000000000000000000000000000000 ! x---x---x---x---x---x---x---x---x---x---x---x- + ! + ! + ! -3 |-2 |-1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 + ! + fpanel (1-nht:nc ,1-nht:nc+nht )=fcube(1-nht:nc ,1-nht:nc+nht) + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + fpanel (nc+halo ,i ) = matmul_w(w(:,i,halo),fcube(nc +halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + + if (present(fotherpanel)) then + fotherpanel (nc+1 :nc+nht ,1-nht:nc+nht,1)=fcube(nc+1 :nc+nht ,1-nht:nc+nht) ! + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ! ibaseref=ibase(i,halo,1 ) + ibaseref = ibase(i,halo,1) + fotherpanel (nc+1-halo ,i,1) = matmul_w(w(:,i,halo),fcube(nc+1-halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + end if + + else if (cubeboundary==north) then + ! + ! north part is on different panel + ! + ! stencil + ! + ! CN<1 case + ! ! x---------------x---------------x---------------x + ! ! | | | | | | | | | | | | | + !0---\---\---\---0---\---\---\---0---\---\---\---0 ! x---------------x---------------x---------------x + ! 0 \ \ \ 0 \ \ \ 0 \ \ \ 0 ! | | i | i | n | n | n | n | n | n | i | i | | + ! 0---\---\---\---0---\---\---\---0---\---\---\---0 ! x---------------x---------------x---------------x + ! 0 \ \ \ 0 \ \ \ 0 \ \ \ 0 ! | i | i | n | n | n | n | n | n | n | n | i | i | + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r | r | r | r | r | r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | H | H | H | H | H | H | H | H | | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | | H | H | H | H | H | H | | | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | | | | | | | | | | | + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! + ! -3 |-2 |-1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 ! -3 |-2 |-1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 + ! + ! fill in values that are on the same projection as "main" element + fpanel (1-nht:nc+nht ,1-nht:nc)=fcube(1-nht:nc+nht ,1-nht:nc) + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + fpanel (i,nc+halo ) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+halo ),ns) !north + end do + end do + if (present(fotherpanel)) then + ! fill in halo for north element + fotherpanel (1-nht:nc+nht ,nc+1:nc+nht,1)=fcube(1-nht:nc+nht ,nc+1:nc+nht) + ! + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + fotherpanel (i,nc+1-halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+1-halo),ns) + end do + end do + end if + + + else if (cubeboundary==south) then + ! + ! south part is on different panel + ! + ! stencil + ! + ! ! + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | | | | | | | | | | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | | H | H | H | H | H | H | | | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | | H | H | H | H | H | H | H | H | | | + ! 0---------------0---------------0---------------0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r | r | r | r | r | r | H | H | | + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0---------------0---------------0---------------0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | | 0 ! | | H | H | r 0 r | r | r | r 0 r | H | H | | + ! 0000000000000000000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 / / / 0 / / / 0 / / / 0 ! | i | i | s | s | s | s | s | s | s | s | i | i | + ! 0---/---/---/---0---/---/---/---0---/---/---/---0 ! x---------------x---------------x---------------x + ! 0 / / / 0 / / / 0 / / / 0 ! | | i | i | s | s | s | s | s | s | i | i | | + !0---/---/---/---0---/---/---/---0---/---/---/---0 ! x---------------x---------------x---------------x + ! ! | | | | | | | | | | | | | + ! + ! 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 ! 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 + ! + ! fill in values that are on the same projection as "main" element (marked with "i" in Figure above) + ! + fpanel (1-nht:nc+nht,1:nc+nht )=fcube(1-nht:nc+nht,1:nc+nht) + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref=ibase(i,halo,1)!ibase(i,halo,2) + fpanel (i,1-halo ) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,1-halo),ns) !south + end do + end do + if (present(fotherpanel)) then + fotherpanel (1-nht:nc+nht,1-nht:0 ,1)=fcube(1-nht:nc+nht,1-nht:0 ) + do halo=1,nhr + do i=halo-nh,nc+nh-(halo-1) + ibaseref=ibase(i,halo,1)!ibase(i,halo,2) + fotherpanel (i, halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1, halo),ns) + end do + end do + end if + else if (cubeboundary==swest) then + ! + ! south and west neighboring cells are on different panel + ! + ! stencil + ! + ! + ! CN<1 case + ! + ! + ! + ! |000000000000000000000000000000000000 ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! 0000 0 | | | 0 | | | 0 ! | | | | | | | | | | | | | + ! 0 |/--0---------------0---------------0 ! x---------------x---------------x---------------x + ! |/--| 0 | | | 0 | | | 0 ! | | | | w | H | H | H | H | H | | | | + ! | |/--0---------------0---------------0 ! x---------------x---------------x---------------x + ! |/--| 0 | | | 0 | | | 0 ! | | | w | w | H | H | H | H | H | H | | | + ! | |/--0---------------0---------------0 ! x---------------x---------------x---------------x + ! |/--| 0 | | | 0 | | | 0 ! | | | w | w | r | r | r | r | r | H | H | | + ! | |000000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! |0000 0 | | | 0 | | | 0 ! | | | w | w 0 r | r | r | r 0 r | H | H | | + ! 0 |/--0---------------0---------------0 ! x---------------0---------------0---------------x + ! |/--| 0 | | | 0 | | | 0 ! | | | w | w 0 r | r | r | r 0 r | H | H | | + ! | |/--0---------------0---------------0 ! x---------------0---------------0---------------x + ! |/--| 0 | | | 0 | | | 0 ! | | | w | w 0 r | r | r | r 0 r | H | H | | + ! | |/--0---------------0---------------0 ! x---------------0---------------0---------------x + ! | | 0 | | | 0 | | | 0 ! | | | w | w 0 r | r | r | r 0 r | H | H | | + ! | -/| 000000000000000000000000000000000 ! x---x---x---x---00000000000000000---x---x---x---x + ! |/ | 0 / / / 0 / / / 0 ! | | | w | | s | s | s | s | s | s | | | + ! | 0-----/---/---/---0---/---/---/---0 ! x---------------x---------------x---------------x + ! | 0 / / / 0 / / / 0 ! | | | | s | s | s | s | s | s | | | | + ! 0-------/---/---/---0---/---/---/---0 ! x---------------x---------------x---------------x + ! + ! + ! -1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | ! |-3 |-2 |-1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | + ! + ! fill in values that are on the same projection as "main" element (marked with "i" in Figure above) + ! + fpanel(1:nc+nht,1:nc+nht)=fcube(1:nc+nht,1:nc+nht) + ! + ! fill in west part (marked with "w" on Figure above) and south part (marked with "s") + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref=ibase(i,halo,1)!ibase(i,halo,1) + fpanel(1-halo ,i) = matmul_w(w(:,i,halo),fcube(1-halo ,ibaseref:ibaseref+ns-1),ns) !west + fpanel(i,1-halo ) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,1-halo) ,ns) !south + end do + end do + ! + ! corner value + ! + fpanel(0,0) =0.25_r8*(fpanel(0,1)+fpanel(1,0)+fpanel(-1,0)+fpanel(0,-1)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on south neighbor panel projection + ! + ! **************************************************************** + ! + ! On the south panel projection the neighbors are arragened as follow (nwest case): + ! + ! + ! \ + ! \ p + ! \ + ! \----- + ! | + ! w | s + ! | + ! + ! + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | p 0 p | p | p | p 0 p | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | w | wp0 p | p | p | p 0 p | p | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | w | w | r | r | r | r | r | i | i | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | w | i | i | i | i | i | i | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | i | i | i | i | i | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x--- + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + if (present(fotherpanel)) then + fotherpanel(1:nc+nht,1-nht:0,1) = fcube(1:nc+nht,1-nht:0) + ! + ! compute interpolated cell average values in "p" cells on Figure on above + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref=ibase(i,halo,1) + ! + ! use same weights as interpolation south from main panel (symmetric) + ! + fotherpanel(i,halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,halo),ns) + end do + end do + ! + ! compute interpolated cell average values in "w" cells on Figure on above + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=nc+halo-nhr,nc+1 + ibaseref=ibase(i,halo,2)-nc + ! + ! fotherpanel indexing follows main panel indexing + ! fcube indexing most be "rotated": + ! + ! =============================== + ! | | | + ! | W ^ | S | + ! | | | | + ! | x | | | + ! | | | | + ! ! | | + ! ! <----- | | + ! ! y | | + ! ! | | + ! =============================== + ! + fotherpanel(1-halo,i-nc,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,halo),ns) + end do + end do + fotherpanel(0,1,1) = 0.25_r8*(fotherpanel(-1,1,1)+fotherpanel(1,1,1)+fotherpanel(0,2,1)+fotherpanel(0,0,1)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on west neighbor panel projection + ! + ! **************************************************************** + ! + ! On the west panel projection the neighbors are arragened as follow (seast case): + ! + ! -------- + ! | | + ! | w | p + ! | | + ! -------\ + ! \ + ! s \ + ! + ! + ! + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | i | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | i | i | e | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | i | i | r | e | e | | | | | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | i | i | r 0 e | e | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | i | i | r 0 e | e | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | i | i | r 0 e | e | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | i | i | r 0 e | e | | 0 | | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | s | s | se| e | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | s | s | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x--- + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + fotherpanel(1-nht:nc,1:nc+nht,2) = fcube(1-nht:nc,1:nc+nht) + ! + ! compute interpolated cell average values in "p" cells on Figure on above + ! + w = halo_interp_weight(:,:,:,1) ! symmetry + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref=ibase(i,halo,1) + ! + ! use same weights as interpolation south from main panel (symmetric) + ! + fotherpanel(halo,i,2) = matmul_w(w(:,i,halo),fcube(halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! compute interpolated cell average values in "s" cells on Figure on above + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=nc+halo-nhr,nc+1 + ibaseref=ibase(i,halo,2)-nc + ! + ! fotherpanel indexing follows main panel indexing + ! fcube indexing most be "rotated": + ! + ! =============================== + ! | | | + ! | W ^ | S | + ! | | | | + ! | x | | | + ! | | | | + ! ! | | + ! ! <----- | | + ! ! y | | + ! ! | | + ! =============================== + ! + fotherpanel(i-nc,1-halo,2) = matmul_w(w(:,i,halo),fcube(halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + fotherpanel(1,0,2) = 0.25_r8*(fotherpanel(0,0,2)+fotherpanel(2,0,2)+fotherpanel(1,-1,2)+fotherpanel(1,1,2)) + end if + else if (cubeboundary==seast) then + ! + ! south and east neighboring cells are on different panel + ! + ! + ! + ! 000000000000000000000000000000000000| + ! 0 | | | 0 | | | 0 0000 ! | | | | | | | | | | | | | + ! 0---------------0---------------0--\| 0 ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 |--\| ! | | | | | H | H | H | H | | | | | + ! 0---------------0---------------0--\| | ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 |--\| ! | | | | H | H | H | H | H | e | | | | + ! 0---------------0---------------0--\| | ! x---------------x---------------x---------------x + ! 0 | | | 0 | | | 0 |--\| ! | | H | H | r | r | r | r | r | e | e | | | + ! 000000000000000000000000000000000000| | ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 | | | 0 | | | 0 0000| ! | | H | H | r 0 r | r | r | r 0 e | e | | | + ! 0---------------0---------------0--\| 0 ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 |--\| ! | | H | H | r 0 r | r | r | r 0 e | e | | | + ! 0---------------0---------------0--\| | ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 |--\| ! | | H | H | r 0 r | r | r | r 0 e | e | | | + ! 0---------------0---------------0--\| | ! x---------------0---------------0---------------x + ! 0 | | | 0 | | | 0 | | ! | | H | H | r 0 r | r | r | r 0 e | e | | | + ! 000000000000000000000000000000000 |\- | ! x---x---x---x---00000000000000000---x---x---x---x + ! 0 \ \ \ 0 \ \ \ 0 | \| ! | | | s | s | s | s | s | s |s/e| e | | | + ! 0---\---\---\---0---\---\---\-----0 | ! x---------------x---------------x---------------x + ! 0 \ \ \ 0 \ \ \ 0 | ! | | | | s | s | s | s | s | s | | | | + ! 0---\---\---\---0---\---\---\-------0 ! x---------------x---------------x---------------x + ! + ! + fpanel (1-nht:nc,1:nc+nht)=fcube(1-nht:nc,1:nc+nht) + ! + ! east + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + fpanel(nc+halo,i) = matmul_w(w(:,i,halo),fcube(nc +halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! south + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref = ibase(i,halo,2) + fpanel(i,1-halo ) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,1-halo),ns) !south + end do + end do + fpanel(nc+1,0 )=0.25_r8*(& + fpanel(nc+1,1)+fpanel(nc,0)+fpanel(nc+2,0)+fpanel(nc+1,-1)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on south neighbor panel projection + ! + ! **************************************************************** + ! + ! On the south panel projection the neighbors are arragened as follow (neast case): + ! + ! + ! / + ! P / + ! / + ! ------/ + ! | | E + ! | S | + ! | | + ! + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | n 0 n | n | n | n 0 n | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | n | n 0 n | n | n | n 0 ne| e | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | i | i | r | r | r | r | r | e | e | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | i | i | i | i | i | i | e | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | i | i | i | i | i | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + if (present(fotherpanel)) then + fotherpanel(1-nht:nc,1-nht:0,1) = fcube(1-nht:nc,1-nht:0) + ! + w = halo_interp_weight(:,:,:,2) + ! + ! fill in "n" on Figure above + ! + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref = ibase(i,halo,2) + fotherpanel (i,halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1, halo),ns) + end do + end do + ! + ! fill in "e" on Figure above + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=0,nht-halo!nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + ! + ! fother panel follows indexing on main panel + ! + ! use symmetry for weights (same weights as East from main panel but for south panel + ! projection the indecies are rotated) + ! + fotherpanel (nc+halo ,1-i,1) = matmul_w(w(:,i,halo),fcube(nc+ibaseref:nc+ibaseref+ns-1,halo),ns) + end do + end do + fotherpanel(nc+1,1,1) = 0.25_r8*(fotherpanel(nc+2,1,1)+fotherpanel(nc,1,1)& + +fotherpanel(nc+1,2,1)+fotherpanel(nc+1,0,1)) + + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on east neighbor panel projection + ! + ! **************************************************************** + ! + ! On the south panel projection the neighbors are arragened as follow (neast case): + ! + ! + ! | | + ! P | E | + ! |-----| + ! / + ! / S + ! / + ! + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | i | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | w | i | i | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | w | w | r | i | i | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | | 0 | | w | w 0 r | i | i | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | w | w 0 r | i | i | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | w | w 0 r | i | i | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | w | w 0 r | i | i | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | | | | | w | ws| s | s | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | s | s | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + fotherpanel(nc+1:nc+nht,1:nc+nht,2) = fcube(nc+1:nc+nht,1:nc+nht) + ! + ! + ! fill in "w" on Figure above + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=0,nc+nh-(halo-1) + ibaseref = ibase(i,halo,1) + fotherpanel(nc+1-halo,i,2) = matmul_w(w(:,i,halo),fcube(nc+1-halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! fill in "s" on Figure above + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=nc+1-nht+halo,nc+1 + ! + ! + ! ! P | E + ! ! | + ! ! | + ! ================ + ! | | + ! | S | | <----- y + ! | | | ^ + ! | x | | | + ! | v | | + ! ! | | + ! ! -----> | x + ! ! y | + ! ! | + ! ================ + ! + ! + ! shift (since we are using south weights from main panel interpolation + ! + ibaseref = ibase(i,halo,2)-nc + ! + ! fotherpanel index: reverse + ! + ! fcube index: due to rotation (see Figure above) + ! + fotherpanel(nc+(nc+1-i),1-halo,2) = matmul_w(w(:,i,halo),fcube(nc+1-halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + fotherpanel(nc,0,2) = 0.25_r8*(fotherpanel(nc+1,0,2)+fotherpanel(nc-1,0,2)& + +fotherpanel(nc,1,2)+fotherpanel(nc,-1,2)) + end if + else if (cubeboundary==nwest) then + ! + ! + ! 0-------\---\---\---0---\---\---\---0 ! --------x---------------x---------------x + ! | 0 \ \ \ 0 \ \ \ 0 ! | | n | n | n | n | n | n | | | | + ! | 0-----\---\---\---0---\---\---\---0 ! --------x---------------x---------------x + ! | | 0 \ \ \ 0 \ \ \ 0 ! | w | a | n | n | n | n | n | n | | | + ! |\ | 000000000000000000000000000000000 ! --------00000000000000000---------------x + ! | -\| 0 | | | 0 | | | 0 ! | w | w 0 r | r | r | r 0 r | H | H | | + ! | |\--0---------------0---------------0 ! --------0---------------0---------------x + ! |\--| 0 | | | 0 | | | 0 ! | w | w 0 r | r | r | r 0 r | H | H | | + ! | |\--0---------------0---------------0 ! --------0---------------0---------------x + ! |\--| 0 | | | 0 | | | 0 ! | w | w 0 r | r | r | r 0 r | H | H | | + ! 0 |\--0---------------0---------------0 ! --------0---------------0---------------x + ! |0000 0 | | | 0 | | | 0 ! | w | w 0 r | r | r | r 0 r | H | H | | + ! | |000000000000000000000000000000000000 ! --------00000000000000000---------------x + ! |\--| 0 | | | 0 | | | 0 ! | w | w | r | r | r | r | r | H | H | | + ! | |\--0---------------0---------------0 ! --------x---------------x---------------x + ! |\--| 0 | | | 0 | | | 0 ! | | w | H | H | H | H | H | H | | | + ! | |\--0---------------0---------------0 ! --------x---------------x---------------x + ! |\--| 0 | | | 0 | | | 0 ! | | | H | H | H | H | H | | | | + ! 0 |\--0---------------0---------------0 ! --------x---------------x---------------x + ! 0000 0 | | | 0 | | | 0 ! | | | | | | | | | | | + ! 000000000000000000000000000000000000 ! --------x---------------x---------------x + ! + ! + ! + fpanel(1:nc+nht,1-nht:nc)=fcube(1:nc+nht,1-nht:nc) + ! + ! west + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1) + fpanel(1-halo ,i) = matmul_w(w(:,i,halo),fcube(1-halo ,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! north + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref = ibase(i,halo,2) + fpanel(i,nc+halo) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+halo ),ns) !north + end do + end do + fpanel(0 ,nc+1)=0.25_r8*(& + fpanel(0,nc)+fpanel(1,nc+1)+fpanel(-1,nc+1)+fpanel(0,nc+2)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on north neighbor panel projection + ! + ! **************************************************************** + ! + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | i | i | i | i | i | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | w | i | i | i | i | i | i | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | w | w | r | r | r | r | r | i | i | | + !x---x---x---x---00000000000000000---x---x---x---x + !| | | w | ws0 s | s | s | s 0 s | s | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | s 0 s | s | s | s 0 s | | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | 0 | | | 0 | | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | 0 | | | 0 | | | | + !x---x---x---x---00000000000000000---x---x---x---x + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + if (present(fotherpanel)) then + fotherpanel(1:nc+nht,nc+1:nc+nht,1) = fcube(1:nc+nht,nc+1:nc+nht) + ! + ! + ! fill in "s" on Figure above + ! + ! (use code from north above) + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=max(halo-nh,0),nc+nh-(halo-1) + ibaseref = ibase(i,halo,2) + fotherpanel(i,nc+1-halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+1-halo ),ns) + end do + end do + ! + ! fill in "w" on Figure above + ! + ! (use code from west above) + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=nc+1-nht+halo,nc+1 + ibaseref=ibase(i,halo,1)-nc + fotherpanel(1-halo,nc-(i-(nc+1)),1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+1-halo),ns) + end do + end do + fotherpanel(0,nc,1)=0.25_r8*(& + fotherpanel(1,nc,1)+fotherpanel(-1,nc,1)+fotherpanel(0,nc+1,1)+fotherpanel(0,nc-1,1)) + + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on west neighbor panel projection + ! + ! **************************************************************** + ! + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | n | n | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | n | n | ne| e | | | | | | | + !x---x---x---x---00000000000000000---x---x---x---x + !| | i | i | r 0 e | e | | 0 | | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | i | i | r 0 e | e | | 0 | | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | i | i | r 0 e | e | | 0 | | | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | i | i | r 0 e | e | | 0 | | | | + !x---x---x---x---00000000000000000---x---x---x---x + !| | i | i | r | e | e | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | i | i | e | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | i | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x--- + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + fotherpanel(1-nht:nc,1-nht:nc,2) = fcube(1-nht:nc,1-nht:nc) + ! + ! + ! fill in "e" on Figure above + ! + ! (use code from west above) + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1) + fotherpanel(halo ,i,2) = matmul_w(w(:,i,halo),fcube(halo ,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! + ! fill in "n" on Figure above + ! + ! (use code from north above) + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=0,nht-halo + ibaseref = ibase(i,halo,2)+nc + fotherpanel(1-i,nc+halo,2) = matmul_w(w(:,i,halo),fcube(halo,ibaseref:ibaseref+ns-1),ns) !north + end do + end do + fotherpanel(1,nc+1,2)=0.25_r8*(& + fotherpanel(2,nc+1,2)+fotherpanel(0,nc+1,2)+fotherpanel(1,nc+2,2)+fotherpanel(1,nc,2)) + end if + + else if (cubeboundary==neast) then + ! + ! + ! 0---/---/---/---0---/---/---/-------0 ! x---------------x---------------x-------- + ! 0 / / / 0 / / / 0 | ! | | | | | n | n | n | n | n | | + ! 0---/---/---/---0---/---/---/-----0 | ! x---------------x---------------x-------- + ! 0 / / / 0 / / / 0 | | ! | | | | n | n | n | n | n | a | e | + ! 000000000000000000000000000000000 | | ! x---------------00000000000000000-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | H | H 0 r | r | r | r 0 e | e | + ! 0---------------0---------------0--/| | ! x---------------0---------------0-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | H | H 0 r | r | r | r 0 e | e | + ! 0---------------0---------------0--/| | ! x---------------0---------------0-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | H | H 0 r | r | r | r 0 e | e | + ! 0---------------0---------------0--/| 0 ! x---------------0---------------0-------- + ! 0 | | | 0 | | | 0 0000| ! | | | H | H 0 r | r | r | r 0 e | e | + ! 000000000000000000000000000000000000| | ! x---------------00000000000000000-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | H | H | r | r | r | r | e | e | + ! 0---------------0---------------0--/| | ! x---------------x---------------x-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | | H | H | H | H | H | e | | + ! 0---------------0---------------0--/| | ! x---------------x---------------x-------- + ! 0 | | | 0 | | | 0 |--/| ! | | | | | H | H | H | H | | | + ! 0---------------0---------------0--/| 0 ! x---------------x---------------x-------- + ! 0 | | | 0 | | | 0 0000 ! | | | | | | | | | | | + ! 000000000000000000000000000000000000 ! x---------------x---------------x-------- + ! + ! + ! + fpanel(1-nht:nc,1-nht:nc)=fcube(1-nht:nc,1-nht:nc) + ! fotherpanel (nc+1 :nc+nht ,1-nht:nc+nht)=fcube(nc+1 :nc+nht ,1-nht:nc+nht) + ! + ! east + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1 ) + fpanel(nc+halo,i) = matmul_w(w(:,i,halo),fcube(nc +halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! north + ! + ! w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1) + fpanel(i,nc+halo) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+halo ),ns) !north + end do + end do + fpanel(nc+1,nc+1)=0.25_r8*(& + fpanel(nc,nc+1)+fpanel(nc+1,nc)+fpanel(nc+1,nc+2)+fpanel(nc+2,nc+1)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on north neighbor panel projection + ! + ! **************************************************************** + ! + ! On the north panel projection the neighbors are arragened as follow (seast case): + ! + ! + ! | | + ! | N | E + ! |-----| + ! \ + ! S \ + ! \ + ! + ! + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | | i | i | i | i | i | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | | i | i | i | i | i | i | e | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! | | i | i | r | r | r | r | r | e | e | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | s | s 0 s | s | s | s 0 se| e | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | s 0 s | s | s | s 0 s | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---0---x---x---x---0---x---x---x---x + ! | | | | 0 | | | 0 | | | | + ! x---x---x---x---00000000000000000---x---x---x---x + ! | | | | | | | | | | | | | + ! x---x---x---x---x---x---x---x---x---x---x---x---x + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + if (present(fotherpanel)) then + fotherpanel(1-nht:nc,nc+1:nc+nht,1) = fcube(1-nht:nc,nc+1:nc+nht) + ! + ! fill in "s" on Figure above + ! + ! (use north case from above and shift/reverse j-index + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1) + fotherpanel (i,nc+1-halo,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+1-halo),ns) + end do + end do + ! + ! fill in "e" on Figure above + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=max(halo-nh,0),nht-halo + ibaseref=ibase(i,halo,2) +nc + ! + ! fotherpanel uses indexing of main panel's projection + ! fcube: rotated indexing + ! + fotherpanel (nc+halo,nc+i,1) = matmul_w(w(:,i,halo),fcube(ibaseref:ibaseref+ns-1,nc+1-halo),ns) + end do + end do + fotherpanel(nc+1,nc,1)=0.25_r8*(& + fotherpanel(nc+2,nc,1)+fotherpanel(nc,nc,1)+fotherpanel(nc+1,nc+1,1)+fotherpanel(nc+1,nc-1,1)) + ! + ! **************************************************************** + ! + ! fill halo for reconstruction on east neighbor panel projection + ! + ! **************************************************************** + ! + ! On the north panel projection the neighbors are arragened as follow (seast case): + ! + ! + ! \ N + ! \ + ! \------ + ! | | + ! P | E | + ! | | + ! ------- + ! + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | n | n | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | w | wn| n | n | | | + !x---x---x---x---00000000000000000---x---x---x---x + !| | | | 0 | | w | w 0 r | i | i | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | 0 | | w | w 0 r | i | i | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | 0 | | w | w 0 r | i | i | | + !x---x---x---x---0---x---x---x---0---x---x---x---x + !| | | | 0 | | w | w 0 r | i | i | | + !x---x---x---x---00000000000000000---x---x---x---x + !| | | | | | | w | w | r | i | i | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | w | i | i | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | i | | | | + !x---x---x---x---x---x---x---x---x---x---x---x---x + !| | | | | | | | | | | | | + !x---x---x---x---x---x---x---x---x---x---x---x--- + ! + ! + ! + ! fill values on same panel projection ("r" and "i" on Figure above) + ! + fotherpanel(nc+1:nc+nht,1-nht:nc,2) = fcube(nc+1:nc+nht,1-nht:nc) + ! + ! fill in "w" on Figure above + ! + ! (use east case from above and shift/reverse j-index + ! + w = halo_interp_weight(:,:,:,1) + do halo=1,nhr + do i=halo-nh,min(nc+nh-(halo-1),nc+1) + ibaseref=ibase(i,halo,1 ) + fotherpanel(nc+1-halo,i,2) = matmul_w(w(:,i,halo),fcube(nc+1-halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + ! + ! fill in "n" on Figure above + ! + w = halo_interp_weight(:,:,:,2) + do halo=1,nhr + do i=max(halo-nh,0),nht-halo + ibaseref=ibase(i,halo,2) +nc + ! + ! fotherpanel uses indexing of main panel's projection + ! fcube: rotated indexing + ! + fotherpanel (nc+i,nc+halo,2) = matmul_w(w(:,i,halo),fcube(nc+1-halo,ibaseref:ibaseref+ns-1),ns) + end do + end do + fotherpanel(nc,nc+1,2)=0.25_r8*(& + fotherpanel(nc+1,nc+1,2)+fotherpanel(nc-1,nc+1,2)+fotherpanel(nc,nc+2,2)+fotherpanel(nc,nc,2)) + end if + end if + end subroutine extend_panel_interpolate +end module fvm_reconstruction_mod diff --git a/src/dynamics/se/dycore/gbarrier.c b/src/dynamics/se/dycore/gbarrier.c new file mode 100644 index 0000000000..6984377861 --- /dev/null +++ b/src/dynamics/se/dycore/gbarrier.c @@ -0,0 +1,109 @@ +//: multi-level barrier code; predefined to a max of 64 threads, as below + +// We need to define the Log2 of the maximum number of threads: +#define LOG2MAX 6 +#define NTHREADS 64 + +#include +#include +#include +#include +#include +#include +#include +#include + +// utility functions: +int ipow2 (int val) { + int result = 1; + while (val > 0) { + result *= 2; + --val; + } + return result; +} + +// Define the data associated with a global barrier: +typedef struct gbt { + volatile bool LocalFlags [2][LOG2MAX]; + volatile bool *PartnerFlags [2][LOG2MAX]; + bool sense; + int parity; + int id; +} GBarrier_Type; + +// Define a singular type for the global barrier: +typedef struct gb { + GBarrier_Type threadData[NTHREADS]; + int numThreads; + int log2Threads; +} GBarrier; + +void initializeThread(GBarrier_Type *threadData, int thread, int numThreads) { + // Local loop variables: (p)arity, (r)ound and (x) [temporary] + int p, r; + unsigned int x; + + // local log2 threads: + int log2Threads = ceil(log2(numThreads)); + + threadData[thread].id = thread; + threadData[thread].sense = true; + threadData[thread].parity = 0; + + for (p = 0; p < 2; p++) { + for (r = 0; r < log2Threads; r++) { + x = (threadData[thread].id + ipow2(r)) % numThreads; + threadData[thread].LocalFlags[p][r] = 0; + threadData[thread].PartnerFlags[p][r] = &threadData[x].LocalFlags[p][r]; + } + } +} + +void gbarrier_synchronize(GBarrier* b, int thread) +{ + // Local: + int i; + + // Get the pointer to our thread's data: + GBarrier_Type *my = &b->threadData[thread]; + + // Loop through the log2 rounds: + for (i = 0; i < b->log2Threads; i++) { + *my->PartnerFlags[my->parity][i] = my->sense; + + while (my->LocalFlags[my->parity][i] != my->sense) { sched_yield(); } + } + + // Reverse the sense for reuse on parity=1 + if (my->parity == 1) { my->sense = !my->sense; } + + // Swap our parity between 0 & 1: + my->parity = 1 - my->parity; +} + +void gbarrier_initialize(GBarrier **ptb, int numThreads) { + // Local variables: + int t; + + GBarrier *b; + (*ptb) = malloc(sizeof(GBarrier)); + b = (*ptb); + + b->numThreads = numThreads; + b->log2Threads = ceil(log2(b->numThreads)); + + for (t = 0; t < b->numThreads; t++) { + initializeThread(b->threadData, t, b->numThreads); + } +} + +void gbarrier_print(GBarrier *b) { + printf("GBarrier Info: %d threads \n", b->numThreads); +} + +void gbarrier_free(GBarrier **ptb) { + GBarrier *b = (*ptb); + free(b); +} + diff --git a/src/dynamics/se/dycore/gbarrier_mod.F90 b/src/dynamics/se/dycore/gbarrier_mod.F90 new file mode 100644 index 0000000000..94c342429b --- /dev/null +++ b/src/dynamics/se/dycore/gbarrier_mod.F90 @@ -0,0 +1,79 @@ +module gbarrier_mod + use gbarriertype_mod, only: gbarrier_t + implicit none + + integer, parameter :: LOG2MAX = 6 + integer, parameter :: MAXTHREADS = 64 + + public :: gbarrier_init + public :: gbarrier_info + public :: gbarrier + + contains + + subroutine gbarrier_init(barrier, nthreads) + type (gbarrier_t), intent(out) :: barrier + integer, intent(in) :: nthreads + + interface + subroutine gbarrier_initialize(c_barrier, nthreads) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_ptr, C_int + implicit none + + type (C_ptr), intent(out) :: c_barrier + integer (C_int), intent(in), value :: nthreads + end subroutine gbarrier_initialize + end interface + + call gbarrier_initialize(barrier%c_barrier, nthreads) + end subroutine gbarrier_init + + subroutine gbarrier_delete(barrier) + type (gbarrier_t), intent(in) :: barrier + + interface + subroutine gbarrier_free(c_barrier) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_ptr + implicit none + + type (C_ptr), intent(in) :: c_barrier + end subroutine gbarrier_free + end interface + + call gbarrier_free(barrier%c_barrier) + end subroutine gbarrier_delete + + subroutine gbarrier_info(barrier) + type (gbarrier_t), intent(in) :: barrier + + interface + subroutine gbarrier_print(c_barrier) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_ptr + implicit none + type (C_ptr), value :: c_barrier + end subroutine gbarrier_print + end interface + + call gbarrier_print(barrier%c_barrier) + end subroutine gbarrier_info + + + subroutine gbarrier(barrier, threadID) + type (gbarrier_t), intent(in) :: barrier + integer, intent(in) :: threadID + + interface + subroutine gbarrier_synchronize(c_barrier, thread) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_ptr, C_int + implicit none + + type (C_ptr), intent(in), value :: c_barrier + integer (C_int), intent(in), value :: thread + end subroutine gbarrier_synchronize + end interface + + call gbarrier_synchronize(barrier%c_barrier, threadID) + end subroutine gbarrier + +end module gbarrier_mod + diff --git a/src/dynamics/se/dycore/gbarriertype_mod.F90 b/src/dynamics/se/dycore/gbarriertype_mod.F90 new file mode 100644 index 0000000000..6503c04c51 --- /dev/null +++ b/src/dynamics/se/dycore/gbarriertype_mod.F90 @@ -0,0 +1,8 @@ +module gbarriertype_mod + use ISO_C_Binding, only: C_ptr + + type, public :: gbarrier_t + type (C_ptr) :: c_barrier + end type gbarrier_t + +end module gbarriertype_mod diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 new file mode 100644 index 0000000000..3734d60e5b --- /dev/null +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -0,0 +1,1042 @@ +module global_norms_mod + + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_logfile, only: iulog + use edgetype_mod, only: EdgeBuffer_t + + implicit none + private + save + + public :: l1_snorm + public :: l2_snorm + public :: linf_snorm + + public :: l1_vnorm + public :: l2_vnorm + public :: linf_vnorm + + public :: print_cfl + public :: test_global_integral + public :: global_integral + public :: global_integrals_general + public :: wrap_repro_sum + + private :: global_maximum + type (EdgeBuffer_t), private :: edgebuf + +contains + + + subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use dimensions_mod, only: np, nelemd + use physconst, only: pi + use parallel_mod, only: global_shared_buf, global_shared_sum + + type(element_t) , intent(in) :: elem(:) + integer , intent(in) :: npts,nets,nete,num_flds + real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: I_sphere(num_flds) + + real (kind=r8) :: I_priv + real (kind=r8) :: I_shared + common /gblintcom/I_shared + ! + ! Local variables + ! + integer :: ie,j,i,q + + real (kind=r8) :: da + real (kind=r8) :: J_tmp(nets:nete,num_flds) + ! + ! This algorithm is independent of thread count and task count. + ! This is a requirement of consistancy checking in cam. + ! + J_tmp = 0.0_r8 + +!JMD print *,'global_integral: before loop' + do ie=nets,nete + do q=1,num_flds + do j=1,np + do i=1,np + da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) + J_tmp(ie,q) = J_tmp(ie,q) + da*h(i,j,q,ie) + end do + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) + enddo + !JMD print *,'global_integral: before wrap_repro_sum' + call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) + !JMD print *,'global_integral: after wrap_repro_sum' + I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) + end subroutine global_integrals + + subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere) + use hybrid_mod, only: hybrid_t + use dimensions_mod, only: nc, nelemd + use physconst, only: pi + use parallel_mod, only: global_shared_buf, global_shared_sum + + integer, intent(in) :: npts,nets,nete,num_flds + real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + type (hybrid_t), intent(in) :: hybrid + real (kind=r8), intent(in) :: da(npts,npts,nets:nete) + + real (kind=r8) :: I_sphere(num_flds) + + real (kind=r8) :: I_priv + real (kind=r8) :: I_shared + common /gblintcom/I_shared + ! + ! Local variables + ! + integer :: ie,j,i,q + + real (kind=r8) :: J_tmp(nets:nete,num_flds) + ! + ! This algorithm is independent of thread count and task count. + ! This is a requirement of consistancy checking in cam. + ! + J_tmp = 0.0_r8 + +!JMD print *,'global_integral: before loop' + do ie=nets,nete + do q=1,num_flds + do j=1,npts + do i=1,npts + J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*h(i,j,q,ie) + end do + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) + enddo + !JMD print *,'global_integral: before wrap_repro_sum' + call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) + !JMD print *,'global_integral: after wrap_repro_sum' + I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) + end subroutine global_integrals_general + + + ! ================================ + ! global_integral: + ! + ! eq 81 in Williamson, et. al. p 218 + ! for spectral elements + ! + ! ================================ + ! -------------------------- + function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use dimensions_mod, only: np, nelemd + use physconst, only: pi + use parallel_mod, only: global_shared_buf, global_shared_sum + + type(element_t) , intent(in) :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: I_sphere + + real (kind=r8) :: I_priv + real (kind=r8) :: I_shared + common /gblintcom/I_shared + + ! Local variables + + integer :: ie,j,i + real(kind=r8) :: I_tmp(1) + + real (kind=r8) :: da + real (kind=r8) :: J_tmp(nets:nete) +! +! This algorythm is independent of thread count and task count. +! This is a requirement of consistancy checking in cam. +! + J_tmp = 0.0_r8 + +!JMD print *,'global_integral: before loop' + do ie=nets,nete + do j=1,np + do i=1,np + da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) + J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1) = J_tmp(ie) + enddo +!JMD print *,'global_integral: before wrap_repro_sum' + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) +!JMD print *,'global_integral: after wrap_repro_sum' + I_tmp = global_shared_sum(1) +!JMD print *,'global_integral: after global_shared_sum' + I_sphere = I_tmp(1)/(4.0_r8*PI) + + end function global_integral + + ! ================================ + ! test_global_integral: + ! + ! test that the global integral of + ! the area of the sphere is 1. + ! + ! ================================ + + subroutine test_global_integral(elem,hybrid,nets,nete,mindxout) + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use dimensions_mod, only: np,ne, nelem, nelemd + use mesh_mod, only: MeshUseMeshFile + use reduction_mod, only: ParallelMin,ParallelMax + use physconst, only: pi, ra, rearth + use parallel_mod, only: global_shared_buf, global_shared_sum + + type(element_t), intent(inout) :: elem(:) + integer, intent(in) :: nets,nete + type(hybrid_t), intent(in) :: hybrid + + real(kind=r8), intent(out), optional :: mindxout + + ! Local variables + real(kind=r8) :: I_sphere + real(kind=r8) :: h(np,np,nets:nete) + ! Element statisics + real(kind=r8) :: min_area,max_area,avg_area, max_ratio + real(kind=r8) :: min_min_dx, max_min_dx, avg_min_dx + real(kind=r8) :: min_normDinv, max_normDinv + real(kind=r8) :: min_len + integer :: ie + + + h(:,:,nets:nete)=1.0_r8 + + ! Calculate surface area by integrating 1.0d0 over sphere and dividing by 4*PI + ! (Should be 1) + I_sphere = global_integral(elem, h(:,:,nets:nete),hybrid,np,nets,nete) + + min_area=1d99 + max_area=0 + avg_area=0_r8 + + max_ratio = 0 + + min_normDinv=1d99 + max_normDinv=0 + + min_min_dx=1d99 + max_min_dx=0 + avg_min_dx=0_r8 + + do ie=nets,nete + + elem(ie)%area = sum(elem(ie)%spheremp(:,:)) + min_area=min(min_area,elem(ie)%area) + max_area=max(max_area,elem(ie)%area) + + min_normDinv = min(min_normDinv,elem(ie)%normDinv) + max_normDinv = max(max_normDinv,elem(ie)%normDinv) + + max_ratio = max(max_ratio,elem(ie)%dx_long/elem(ie)%dx_short) + + + min_min_dx = min(min_min_dx,elem(ie)%dx_short) + max_min_dx = max(max_min_dx,elem(ie)%dx_short) + + + global_shared_buf(ie,1) = elem(ie)%area + global_shared_buf(ie,2) = elem(ie)%dx_short + + enddo + + min_area=ParallelMin(min_area,hybrid) + max_area=ParallelMax(max_area,hybrid) + + min_normDinv=ParallelMin(min_normDinv,hybrid) + max_normDinv=ParallelMax(max_normDinv,hybrid) + + max_ratio=ParallelMax(max_ratio,hybrid) + + min_min_dx=ParallelMin(min_min_dx,hybrid) + max_min_dx=ParallelMax(max_min_dx,hybrid) + + call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) + + avg_area = global_shared_sum(1)/dble(nelem) + avg_min_dx = global_shared_sum(2)/dble(nelem) + + ! Physical units for area + min_area = min_area*rearth*rearth/1000000._r8 + max_area = max_area*rearth*rearth/1000000._r8 + avg_area = avg_area*rearth*rearth/1000000._r8 + + + ! for an equation du/dt = i c u, leapfrog is stable for |c u dt| < 1 + ! Consider a gravity wave at the equator, c=340m/s + ! u = exp(i kmax x/ a ) with x = longitude, and kmax = pi a / dx, + ! u = exp(i pi x / dx ), so du/dt = c du/dx becomes du/dt = i c pi/dx u + ! stable for dt < dx/(c*pi) + ! CAM 26 level AMIP simulation: max gravity wave speed 341.75 m/s + if (hybrid%masterthread) then + write(iulog,* )"" + write(iulog,* )"Running Global Integral Diagnostic..." + write(iulog,*)"Area of unit sphere is",I_sphere + write(iulog,*)"Should be 1.0 to round off..." + write(iulog,'(a,f9.3)') 'Element area: max/min',(max_area/min_area) + if (.not.MeshUseMeshFile) then + write(iulog,'(a,f6.3,f8.2)') "Average equatorial node spacing (deg, km) = ", & + dble(90)/dble(ne*(np-1)), PI*rearth/(2000.0d0*dble(ne*(np-1))) + end if + write(iulog,'(a,2f9.3)') 'norm of Dinv (min, max): ', min_normDinv, max_normDinv + write(iulog,'(a,1f8.2)') 'Max Dinv-based element distortion: ', max_ratio + write(iulog,'(a,3f8.2)') 'dx based on Dinv svd: ave,min,max = ', avg_min_dx, min_min_dx, max_min_dx + write(iulog,'(a,3f8.2)') "dx based on sqrt element area: ave,min,max = ", & + sqrt(avg_area)/(np-1),sqrt(min_area)/(np-1),sqrt(max_area)/(np-1) + end if + + if(present(mindxout)) then + ! min_len now based on norm(Dinv) + min_len = 0.002d0*rearth/(dble(np-1)*max_normDinv) + mindxout=1000_r8*min_len + end if + + end subroutine test_global_integral + + +!------------------------------------------------------------------------------------ + + ! ================================ + ! print_cfl: + ! + ! Calculate / output CFL info + ! (both advective and based on + ! viscosity or hyperviscosity) + ! + ! ================================ + + subroutine print_cfl(elem,hybrid,nets,nete,dtnu) +! +! estimate various CFL limits +! also, for variable resolution viscosity coefficient, make sure +! worse viscosity CFL (given by dtnu) is not violated by reducing +! viscosity coefficient in regions where CFL is violated +! + use hybrid_mod, only: hybrid_t, PrintHybrid + use element_mod, only: element_t + use dimensions_mod, only: np,ne,nelem,nelemd,nc,nhe,qsize,ntrac + use quadrature_mod, only: gausslobatto, quadrature_t + + use reduction_mod, only: ParallelMin,ParallelMax + use physconst, only: ra, rearth, pi + use control_mod, only: nu, nu_q, nu_div, nu_top, & + fine_ne, rk_stage_user, max_hypervis_courant + use control_mod, only: tstep_type, hypervis_power, hypervis_scaling + use cam_abortutils, only: endrun + use parallel_mod, only: global_shared_buf, global_shared_sum + use edge_mod, only: initedgebuffer, FreeEdgeBuffer, edgeVpack, edgeVunpack + use bndry_mod, only: bndry_exchange + use time_mod, only: tstep + + type(element_t) , intent(inout) :: elem(:) + integer , intent(in) :: nets,nete + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8), intent(in) :: dtnu + + ! Element statisics + real (kind=r8) :: min_max_dx,max_unif_dx ! used for normalizing scalar HV + real (kind=r8) :: max_normDinv ! used for CFL + real (kind=r8) :: min_hypervis, max_hypervis, avg_hypervis, stable_hv + real (kind=r8) :: normDinv_hypervis + real (kind=r8) :: x, y, noreast, nw, se, sw + real (kind=r8), dimension(np,np,nets:nete) :: zeta + real (kind=r8) :: lambda_max, lambda_vis, min_gw, lambda + integer :: ie,corner, i, j, rowind, colind + type (quadrature_t) :: gp + + + ! Eigenvalues calculated by folks at UMich (Paul U & Jared W) + select case (np) + case (2) + lambda_max = 0.5d0 + lambda_vis = 0.0d0 ! need to compute this + case (3) + lambda_max = 1.5d0 + lambda_vis = 12.0d0 + case (4) + lambda_max = 2.74d0 + lambda_vis = 30.0d0 + case (5) + lambda_max = 4.18d0 + lambda_vis = 91.6742d0 + case (6) + lambda_max = 5.86d0 + lambda_vis = 190.1176d0 + case (7) + lambda_max = 7.79d0 + lambda_vis = 374.7788d0 + case (8) + lambda_max = 10.0d0 + lambda_vis = 652.3015d0 + case DEFAULT + lambda_max = 0.0d0 + lambda_vis = 0.0d0 + end select + + if ((lambda_max.eq.0d0).and.(hybrid%masterthread)) then + print*, "lambda_max not calculated for NP = ",np + print*, "Estimate of gravity wave timestep will be incorrect" + end if + if ((lambda_vis.eq.0d0).and.(hybrid%masterthread)) then + print*, "lambda_vis not calculated for NP = ",np + print*, "Estimate of viscous CFLs will be incorrect" + end if + + do ie=nets,nete + elem(ie)%variable_hyperviscosity = 1.0_r8 + end do + + gp=gausslobatto(np) + min_gw = minval(gp%weights) + + max_normDinv=0 + min_max_dx=1d99 + do ie=nets,nete + max_normDinv = max(max_normDinv,elem(ie)%normDinv) + min_max_dx = min(min_max_dx,elem(ie)%dx_long) + enddo + max_normDinv=ParallelMax(max_normDinv,hybrid) + min_max_dx=ParallelMin(min_max_dx,hybrid) + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! SCALAR, RESOLUTION-AWARE HYPERVISCOSITY +! this block of code initializes the variable_hyperviscsoity() array +! based on largest length scale in each element and user specified scaling +! it then limits the coefficient if the user specifed a max CFL +! this limiting is based on the smallest length scale of each element +! since that controls the CFL. +! Mike Levy +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (hypervis_power /= 0) then + + min_hypervis = 1d99 + max_hypervis = 0 + avg_hypervis = 0 + + + max_unif_dx = min_max_dx ! use this for average resolution, unless: +! viscosity in namelist specified for smallest element: + if (fine_ne>0) then + ! viscosity in namelist specified for regions with a resolution + ! equivilant to a uniform grid with ne=fine_ne + if (np /= 4 ) call endrun('ERROR: setting fine_ne only supported with NP=4') + max_unif_dx = (111.28_r8*30)/dble(fine_ne) ! in km + endif + +! +! note: if L = eigenvalue of metinv, then associated length scale (km) is +! dx = 1.0d0/( sqrt(L)*0.5d0*dble(np-1)*ra*1000.0d0) +! +! for viscosity *tensor*, we take at each point: +! nu1 = nu*(dx1/max_unif_dx)**3.2 dx1 associated with eigenvalue 1 +! nu2 = nu*(dx2/max_unif_dx)**3.2 dx2 associated with eigenvalue 2 +! with this approach: +! - with this formula, no need to adjust for CFL violations +! - if nu comes from a 3.2 scaling that is stable for coarse and fine resolutions, +! this formulat will be stable. +! - gives the correct answer in long skinny rectangles: +! large viscosity in the long direction, small viscosity in the short direction +! +! + + normDinv_hypervis = 0 + + do ie=nets,nete + ! variable viscosity based on map from ulatlon -> ucontra + + ! dx_long + elem(ie)%variable_hyperviscosity = sqrt((elem(ie)%dx_long/max_unif_dx) ** hypervis_power) + elem(ie)%hv_courant = dtnu*(elem(ie)%variable_hyperviscosity(1,1)**2) * & + (lambda_vis**2) * ((ra*elem(ie)%normDinv)**4) + + ! Check to see if this is stable + if (elem(ie)%hv_courant.gt.max_hypervis_courant) then + stable_hv = sqrt( max_hypervis_courant / & + ( dtnu * (lambda_vis)**2 * (ra*elem(ie)%normDinv)**4 ) ) + +#if 0 + ! Useful print statements for debugging the adjustments to hypervis + print*, "Adjusting hypervis on elem ", elem(ie)%GlobalId + print*, "From ", nu*elem(ie)%variable_hyperviscosity(1,1)**2, " to ", nu*stable_hv + print*, "Difference = ", nu*(/elem(ie)%variable_hyperviscosity(1,1)**2-stable_hv/) + print*, "Factor of ", elem(ie)%variable_hyperviscosity(1,1)**2/stable_hv + print*, " " +#endif + +! make sure that: elem(ie)%hv_courant <= max_hypervis_courant + elem(ie)%variable_hyperviscosity = stable_hv + elem(ie)%hv_courant = dtnu*(stable_hv**2) * (lambda_vis)**2 * (ra*elem(ie)%normDinv)**4 + end if + normDinv_hypervis = max(normDinv_hypervis, elem(ie)%hv_courant/dtnu) + + min_hypervis = min(min_hypervis, elem(ie)%variable_hyperviscosity(1,1)) + max_hypervis = max(max_hypervis, elem(ie)%variable_hyperviscosity(1,1)) + global_shared_buf(ie,1) = elem(ie)%variable_hyperviscosity(1,1) + end do + + min_hypervis = ParallelMin(min_hypervis, hybrid) + max_hypervis = ParallelMax(max_hypervis, hybrid) + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) + avg_hypervis = global_shared_sum(1)/dble(nelem) + + normDinv_hypervis = ParallelMax(normDinv_hypervis, hybrid) + + ! apply DSS (aka assembly procedure) to variable_hyperviscosity (makes continuous) + call initEdgeBuffer(hybrid%par,edgebuf,elem,1) + do ie=nets,nete + zeta(:,:,ie) = elem(ie)%variable_hyperviscosity(:,:)*elem(ie)%spheremp(:,:) + call edgeVpack(edgebuf,zeta(1,1,ie),1,0,ie) + end do + call bndry_exchange(hybrid,edgebuf) + do ie=nets,nete + call edgeVunpack(edgebuf,zeta(1,1,ie),1,0,ie) + elem(ie)%variable_hyperviscosity(:,:) = zeta(:,:,ie)*elem(ie)%rspheremp(:,:) + end do + call FreeEdgeBuffer(edgebuf) + + ! replace hypervis w/ bilinear based on continuous corner values + do ie=nets,nete + noreast = elem(ie)%variable_hyperviscosity(np,np) + nw = elem(ie)%variable_hyperviscosity(1,np) + se = elem(ie)%variable_hyperviscosity(np,1) + sw = elem(ie)%variable_hyperviscosity(1,1) + do i=1,np + x = gp%points(i) + do j=1,np + y = gp%points(j) + elem(ie)%variable_hyperviscosity(i,j) = 0.25d0*( & + (1.0d0-x)*(1.0d0-y)*sw + & + (1.0d0-x)*(y+1.0d0)*nw + & + (x+1.0d0)*(1.0d0-y)*se + & + (x+1.0d0)*(y+1.0d0)*noreast) + end do + end do + end do + else if (hypervis_scaling/=0) then + ! tensorHV. New eigenvalues are the eigenvalues of the tensor V + ! formulas here must match what is in cube_mod.F90 + ! for tensorHV, we scale out the rearth dependency + lambda = max_normDinv**2 + normDinv_hypervis = (lambda_vis**2) * (max_normDinv**4) * & + (lambda**(-hypervis_scaling/2) ) + else + ! constant coefficient formula: + normDinv_hypervis = (lambda_vis**2) * (ra*max_normDinv)**4 + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! TENSOR, RESOLUTION-AWARE HYPERVISCOSITY +! The tensorVisc() array is computed in cube_mod.F90 +! this block of code will DSS it so the tensor if C0 +! and also make it bilinear in each element. +! Oksana Guba +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (hypervis_scaling /= 0) then + + call initEdgeBuffer(hybrid%par,edgebuf,elem,1) + do rowind=1,2 + do colind=1,2 + do ie=nets,nete + zeta(:,:,ie) = elem(ie)%tensorVisc(:,:,rowind,colind)*elem(ie)%spheremp(:,:) + call edgeVpack(edgebuf,zeta(1,1,ie),1,0,ie) + end do + + call bndry_exchange(hybrid,edgebuf) + do ie=nets,nete + call edgeVunpack(edgebuf,zeta(1,1,ie),1,0,ie) + elem(ie)%tensorVisc(:,:,rowind,colind) = zeta(:,:,ie)*elem(ie)%rspheremp(:,:) + end do + enddo !rowind + enddo !colind + call FreeEdgeBuffer(edgebuf) + +!IF BILINEAR MAP OF V NEEDED + + do rowind=1,2 + do colind=1,2 + ! replace hypervis w/ bilinear based on continuous corner values + do ie=nets,nete + noreast = elem(ie)%tensorVisc(np,np,rowind,colind) + nw = elem(ie)%tensorVisc(1,np,rowind,colind) + se = elem(ie)%tensorVisc(np,1,rowind,colind) + sw = elem(ie)%tensorVisc(1,1,rowind,colind) + do i=1,np + x = gp%points(i) + do j=1,np + y = gp%points(j) + elem(ie)%tensorVisc(i,j,rowind,colind) = 0.25d0*( & + (1.0d0-x)*(1.0d0-y)*sw + & + (1.0d0-x)*(y+1.0d0)*nw + & + (x+1.0d0)*(1.0d0-y)*se + & + (x+1.0d0)*(y+1.0d0)*noreast) + end do + end do + end do + enddo !rowind + enddo !colind + + endif + deallocate(gp%points) + deallocate(gp%weights) + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (hybrid%masterthread) then + write(iulog,'(a,f10.2)') 'CFL estimates in terms of S=time step stability region' + write(iulog,'(a,f10.2)') '(i.e. advection w/leapfrog: S=1, viscosity w/forward Euler: S=2)' + if (rk_stage_user>0) then + write(iulog,'(a,f10.2,a)') 'SSP preservation (120m/s) RKSSP euler step dt < S *', & + min_gw/(120.0d0*max_normDinv*ra),'s' + endif + if (qsize>0) & + write(iulog,'(a,f10.2,a)') 'Stability: advective (120m/s) dt_tracer < S *',& + 1/(120.0d0*max_normDinv*lambda_max*ra),'s' + if (ntrac>0) then + ! + ! rough estimate of Courant number limted time-step: + ! + ! U_max*dt_tracer/dx < nhe + ! + ! where U_max=120 m/s and dx = 360 degrees/(4*ne*nc) = (2*pi*Rearth m)/(4*ne*nc) + ! + write(iulog,'(a,f10.2,a)') "Stability (fvm Courant number): advective (120m/s) dt_tracer < ",& + dble(nhe)*(2.0_r8*pi*Rearth/dble(4.0_r8*ne*nc))/120.0e0_r8,'s' + write(iulog,*) "(note that fvm stability is also limited by flow deformation - Lipschitz criterion!)" + end if + write(iulog,'(a,f10.2,a)') 'Stability: advective (120m/s) dt_tracer < S *', & + 1/(120.0d0*max_normDinv*lambda_max*ra),'s' + write(iulog,'(a,f10.2,a)') 'Stability: gravity wave(342m/s) dt_dyn < S *', & + 1/(342.0d0*max_normDinv*lambda_max*ra),'s' + if (nu>0) then +! if (hypervis_order==1) then +! write(iulog,'(a,f10.2,a)') 'Stability: viscosity dt < S *',1/(((ra*max_normDinv)**2)*lambda_vis),'s' +! endif +! if (hypervis_order==2) then + ! counrant number = dtnu*normDinv_hypervis < S + ! dt < S 1/nu*normDinv + write(iulog,'(a,f10.2,a)') "Stability: nu_q hyperviscosity dt < S *", 1/(nu_q*normDinv_hypervis),'s' + write(iulog,'(a,f10.2,a)') "Stability: nu_vor hyperviscosity dt < S *", 1/(nu*normDinv_hypervis),'s' + + write(iulog,'(a,f10.2,a)') "Stability: nu_div hyperviscosity dt < S *", 1/(nu_div*normDinv_hypervis),'s' +! endif + endif + if(nu_top>0) then + write(iulog,'(a,f10.2,a)') 'TOP3 viscosity CFL: dt < S*', & + 1.0d0/(4*nu_top*((ra*max_normDinv)**2)*lambda_vis),'s' + end if + if (hypervis_power /= 0) then + write(iulog,'(a,3e11.4)')'Hyperviscosity (dynamics): ave,min,max = ', & + nu*(/avg_hypervis**2,min_hypervis**2,max_hypervis**2/) +! print*, 'fine_ne = ', fine_ne +! print*, 'Using max_unif_dx = ', max_unif_dx + end if + write(iulog,*) 'tstep_type = ',tstep_type + end if + + end subroutine print_cfl + + ! ================================ + ! global_maximum: + ! + ! Find global maximum on sphere + ! + ! ================================ + + function global_maximum(h,hybrid,npts,nets,nete) result(Max_sphere) + + use hybrid_mod, only : hybrid_t + use reduction_mod, only : red_max, pmax_mt + + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: Max_sphere + + ! Local variables + + real (kind=r8) :: redp(1) + + Max_sphere = MAXVAL(h(:,:,nets:nete)) + + redp(1) = Max_sphere + call pmax_mt(red_max,redp,1,hybrid) + Max_sphere = red_max%buf(1) + + end function global_maximum + + ! ========================================================== + ! l1_snorm: + ! + ! computes the l1 norm per Williamson et al, p. 218 eq(8) + ! for a scalar quantity + ! =========================================================== + + function l1_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l1) + + use element_mod, only : element_t + use hybrid_mod, only : hybrid_t + + type(element_t) , intent(in) :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: l1 + + ! Local variables + + real (kind=r8) :: dhabs(npts,npts,nets:nete) + real (kind=r8) :: htabs(npts,npts,nets:nete) + real (kind=r8) :: dhabs_int + real (kind=r8) :: htabs_int + integer i,j,ie + + do ie=nets,nete + do j=1,npts + do i=1,npts + dhabs(i,j,ie) = ABS(h(i,j,ie)-ht(i,j,ie)) + htabs(i,j,ie) = ABS(ht(i,j,ie)) + end do + end do + end do + + dhabs_int = global_integral(elem, dhabs(:,:,nets:nete),hybrid,npts,nets,nete) + htabs_int = global_integral(elem, htabs(:,:,nets:nete),hybrid,npts,nets,nete) + + l1 = dhabs_int/htabs_int + + end function l1_snorm + + ! =========================================================== + ! l1_vnorm: + ! + ! computes the l1 norm per Williamson et al, p. 218 eq(97), + ! for a contravariant vector quantity on the velocity grid. + ! + ! =========================================================== + + function l1_vnorm(elem, v,vt,hybrid,npts,nets,nete) result(l1) + use element_mod, only : element_t + use hybrid_mod, only : hybrid_t + + type(element_t) , intent(in), target :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: v(npts,npts,2,nets:nete) ! computed soln + real (kind=r8), intent(in) :: vt(npts,npts,2,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: l1 + + ! Local variables + + real (kind=r8), dimension(:,:,:,:), pointer :: met + real (kind=r8) :: dvsq(npts,npts,nets:nete) + real (kind=r8) :: vtsq(npts,npts,nets:nete) + real (kind=r8) :: dvco(npts,npts,2) ! covariant velocity + real (kind=r8) :: vtco(npts,npts,2) ! covariant velocity + real (kind=r8) :: dv1,dv2 + real (kind=r8) :: vt1,vt2 + real (kind=r8) :: dvsq_int + real (kind=r8) :: vtsq_int + + integer i,j,ie + + do ie=nets,nete + met => elem(ie)%met + do j=1,npts + do i=1,npts + + dv1 = v(i,j,1,ie)-vt(i,j,1,ie) + dv2 = v(i,j,2,ie)-vt(i,j,2,ie) + + vt1 = vt(i,j,1,ie) + vt2 = vt(i,j,2,ie) + + dvco(i,j,1) = met(i,j,1,1)*dv1 + met(i,j,1,2)*dv2 + dvco(i,j,2) = met(i,j,2,1)*dv1 + met(i,j,2,2)*dv2 + + vtco(i,j,1) = met(i,j,1,1)*vt1 + met(i,j,1,2)*vt2 + vtco(i,j,2) = met(i,j,2,1)*vt1 + met(i,j,2,2)*vt2 + + dvsq(i,j,ie) = SQRT(dvco(i,j,1)*dv1 + dvco(i,j,2)*dv2) + vtsq(i,j,ie) = SQRT(vtco(i,j,1)*vt1 + vtco(i,j,2)*vt2) + + end do + end do + end do + + dvsq_int = global_integral(elem, dvsq(:,:,nets:nete),hybrid,npts,nets,nete) + vtsq_int = global_integral(elem, vtsq(:,:,nets:nete),hybrid,npts,nets,nete) + + l1 = dvsq_int/vtsq_int + + end function l1_vnorm + + ! ========================================================== + ! l2_snorm: + ! + ! computes the l2 norm per Williamson et al, p. 218 eq(83) + ! for a scalar quantity on the pressure grid. + ! + ! =========================================================== + + function l2_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l2) + use element_mod, only : element_t + use hybrid_mod, only : hybrid_t + + type(element_t), intent(in) :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: l2 + + ! Local variables + + real (kind=r8) :: dh2(npts,npts,nets:nete) + real (kind=r8) :: ht2(npts,npts,nets:nete) + real (kind=r8) :: dh2_int + real (kind=r8) :: ht2_int + integer i,j,ie + + do ie=nets,nete + do j=1,npts + do i=1,npts + dh2(i,j,ie)=(h(i,j,ie)-ht(i,j,ie))**2 + ht2(i,j,ie)=ht(i,j,ie)**2 + end do + end do + end do + + dh2_int = global_integral(elem,dh2(:,:,nets:nete),hybrid,npts,nets,nete) + ht2_int = global_integral(elem,ht2(:,:,nets:nete),hybrid,npts,nets,nete) + + l2 = SQRT(dh2_int)/SQRT(ht2_int) + + end function l2_snorm + + ! ========================================================== + ! l2_vnorm: + ! + ! computes the l2 norm per Williamson et al, p. 219 eq(98) + ! for a contravariant vector quantity on the velocity grid. + ! + ! =========================================================== + + function l2_vnorm(elem, v,vt,hybrid,npts,nets,nete) result(l2) + use element_mod, only : element_t + use hybrid_mod, only : hybrid_t + + type(element_t) , intent(in), target :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: v(npts,npts,2,nets:nete) ! computed soln + real (kind=r8), intent(in) :: vt(npts,npts,2,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: l2 + + ! Local variables + + real (kind=r8), dimension(:,:,:,:), pointer :: met + real (kind=r8) :: dvsq(npts,npts,nets:nete) + real (kind=r8) :: vtsq(npts,npts,nets:nete) + real (kind=r8) :: dvco(npts,npts,2) ! covariant velocity + real (kind=r8) :: vtco(npts,npts,2) ! covariant velocity + real (kind=r8) :: dv1,dv2 + real (kind=r8) :: vt1,vt2 + real (kind=r8) :: dvsq_int + real (kind=r8) :: vtsq_int + integer i,j,ie + + do ie=nets,nete + met => elem(ie)%met + do j=1,npts + do i=1,npts + + dv1 = v(i,j,1,ie)-vt(i,j,1,ie) + dv2 = v(i,j,2,ie)-vt(i,j,2,ie) + + vt1 = vt(i,j,1,ie) + vt2 = vt(i,j,2,ie) + + dvco(i,j,1) = met(i,j,1,1)*dv1 + met(i,j,1,2)*dv2 + dvco(i,j,2) = met(i,j,2,1)*dv1 + met(i,j,2,2)*dv2 + + vtco(i,j,1) = met(i,j,1,1)*vt1 + met(i,j,1,2)*vt2 + vtco(i,j,2) = met(i,j,2,1)*vt1 + met(i,j,2,2)*vt2 + + dvsq(i,j,ie) = dvco(i,j,1)*dv1 + dvco(i,j,2)*dv2 + vtsq(i,j,ie) = vtco(i,j,1)*vt1 + vtco(i,j,2)*vt2 + + end do + end do + end do + + dvsq_int = global_integral(elem, dvsq(:,:,nets:nete),hybrid,npts,nets,nete) + vtsq_int = global_integral(elem, vtsq(:,:,nets:nete),hybrid,npts,nets,nete) + + l2 = SQRT(dvsq_int)/SQRT(vtsq_int) + + end function l2_vnorm + + ! ========================================================== + ! linf_snorm: + ! + ! computes the l infinity norm per Williamson et al, p. 218 eq(84) + ! for a scalar quantity on the pressure grid... + ! + ! =========================================================== + + function linf_snorm(h,ht,hybrid,npts,nets,nete) result(linf) + use hybrid_mod, only : hybrid_t + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: linf + + ! Local variables + + real (kind=r8) :: dhabs(npts,npts,nets:nete) + real (kind=r8) :: htabs(npts,npts,nets:nete) + real (kind=r8) :: dhabs_max + real (kind=r8) :: htabs_max + integer i,j,ie + + do ie=nets,nete + do j=1,npts + do i=1,npts + dhabs(i,j,ie)=ABS(h(i,j,ie)-ht(i,j,ie)) + htabs(i,j,ie)=ABS(ht(i,j,ie)) + end do + end do + end do + + dhabs_max = global_maximum(dhabs(:,:,nets:nete),hybrid,npts,nets,nete) + htabs_max = global_maximum(htabs(:,:,nets:nete),hybrid,npts,nets,nete) + + linf = dhabs_max/htabs_max + + end function linf_snorm + + + ! ========================================================== + ! linf_vnorm: + ! + ! computes the linf norm per Williamson et al, p. 218 eq(99), + ! for a contravariant vector quantity on the velocity grid. + ! + ! =========================================================== + + function linf_vnorm(elem,v,vt,hybrid,npts,nets,nete) result(linf) + use hybrid_mod, only : hybrid_t + use element_mod, only : element_t + + type(element_t) , intent(in), target :: elem(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: v(npts,npts,2,nets:nete) ! computed soln + real (kind=r8), intent(in) :: vt(npts,npts,2,nets:nete) ! true soln + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8) :: linf + + ! Local variables + + real (kind=r8), dimension(:,:,:,:), pointer :: met + real (kind=r8) :: dvsq(npts,npts,nets:nete) + real (kind=r8) :: vtsq(npts,npts,nets:nete) + real (kind=r8) :: dvco(npts,npts,2) ! covariant velocity + real (kind=r8) :: vtco(npts,npts,2) ! covariant velocity + real (kind=r8) :: dv1,dv2 + real (kind=r8) :: vt1,vt2 + real (kind=r8) :: dvsq_max + real (kind=r8) :: vtsq_max + integer i,j,ie + + do ie=nets,nete + met => elem(ie)%met + + do j=1,npts + do i=1,npts + + dv1 = v(i,j,1,ie)-vt(i,j,1,ie) + dv2 = v(i,j,2,ie)-vt(i,j,2,ie) + + vt1 = vt(i,j,1,ie) + vt2 = vt(i,j,2,ie) + + dvco(i,j,1) = met(i,j,1,1)*dv1 + met(i,j,1,2)*dv2 + dvco(i,j,2) = met(i,j,2,1)*dv1 + met(i,j,2,2)*dv2 + + vtco(i,j,1) = met(i,j,1,1)*vt1 + met(i,j,1,2)*vt2 + vtco(i,j,2) = met(i,j,2,1)*vt1 + met(i,j,2,2)*vt2 + + dvsq(i,j,ie) = SQRT(dvco(i,j,1)*dv1 + dvco(i,j,2)*dv2) + vtsq(i,j,ie) = SQRT(vtco(i,j,1)*vt1 + vtco(i,j,2)*vt2) + + end do + end do + end do + + dvsq_max = global_maximum(dvsq(:,:,nets:nete),hybrid,npts,nets,nete) + vtsq_max = global_maximum(vtsq(:,:,nets:nete),hybrid,npts,nets,nete) + + linf = dvsq_max/vtsq_max + + end function linf_vnorm + + subroutine wrap_repro_sum (nvars, comm, nsize) + use dimensions_mod, only: nelemd + use shr_reprosum_mod, only: repro_sum => shr_reprosum_calc + use cam_abortutils, only: endrun + use parallel_mod, only: global_shared_buf, global_shared_sum, nrepro_vars + + integer :: nvars ! number of variables to be summed (cannot exceed nrepro_vars) + integer :: comm ! mpi communicator + integer, optional :: nsize ! local buffer size (defaults to nelemd - number of elements in mpi task) + + integer nsize_use + + if (present(nsize)) then + nsize_use = nsize + else + nsize_use = nelemd + endif + if (nvars .gt. nrepro_vars) call endrun('ERROR: repro_sum_buffer_size exceeded') + +! Repro_sum contains its own OpenMP, so only one thread should call it (AAM) + +!$OMP BARRIER +!$OMP MASTER + + call repro_sum(global_shared_buf, global_shared_sum, nsize_use, nelemd, nvars, commid=comm) + + +!$OMP END MASTER +!$OMP BARRIER + + end subroutine wrap_repro_sum + +end module global_norms_mod diff --git a/src/dynamics/se/dycore/gridgraph_mod.F90 b/src/dynamics/se/dycore/gridgraph_mod.F90 new file mode 100644 index 0000000000..cbafebcb91 --- /dev/null +++ b/src/dynamics/se/dycore/gridgraph_mod.F90 @@ -0,0 +1,555 @@ +module GridGraph_mod + !------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + !------------------------------- + use dimensions_mod, only: max_neigh_edges + !------------------------- + use control_mod, only: north, south, east, west, neast, nwest, seast, swest + !----- + use cam_logfile, only: iulog + !----- + implicit none + + + private + + integer, public, parameter :: num_neighbors=8 ! for north, south, east, west, neast, nwest, seast, swest + + + type, public :: GridVertex_t + + integer, pointer :: nbrs(:) => null() ! The numbers of the neighbor elements + integer, pointer :: nbrs_face(:) => null() ! The cube face number of the neighbor element (nbrs array) + integer, pointer :: nbrs_wgt(:) => null() ! The weights for edges defined by nbrs array + integer, pointer :: nbrs_wgt_ghost(:) => null() ! The weights for edges defined by nbrs array + integer :: nbrs_ptr(num_neighbors + 1) !index into the nbrs array for each neighbor direction + + integer :: face_number ! which face of the cube this vertex is on + integer :: number ! element number + integer :: processor_number ! processor number + integer :: SpaceCurve ! index in Space-Filling curve + end type GridVertex_t + + type, public :: GridEdge_t + integer :: head_face ! needed if head vertex has shape (i.e. square) + integer :: tail_face ! needed if tail vertex has shape (i.e. square) + integer :: head_dir !which of 8 neighbor directions is the head + integer :: tail_dir !which of 8 neighbor directions is the tail + integer :: wgtP, wgtS + type (GridVertex_t),pointer :: head => null() ! edge head vertex + type (GridVertex_t),pointer :: tail => null() ! edge tail vertex + logical :: reverse + + end type GridEdge_t + +! ========================================== +! Public Interfaces +! ========================================== + + public :: set_GridVertex_number + public :: PrintGridVertex + + public :: allocate_gridvertex_nbrs + public :: deallocate_gridvertex_nbrs + public :: initgridedge + public :: gridedge_search + public :: gridedge_type + public :: grid_edge_uses_vertex + public :: PrintGridEdge + public :: CheckGridNeighbors + public :: PrintChecksum + + public :: CreateSubGridGraph + + public :: assignment ( = ) + + interface assignment ( = ) + module procedure copy_gridedge + module procedure copy_gridvertex + end interface + +contains + +!====================================================================== + + subroutine allocate_gridvertex_nbrs(vertex, dim) + + type (GridVertex_t), intent(inout) :: vertex + integer, optional, intent(in) :: dim + integer :: num + + if (present(dim)) then + num = dim + else + num = max_neigh_edges + end if + + allocate(vertex%nbrs(num)) + allocate(vertex%nbrs_face(num)) + allocate(vertex%nbrs_wgt(num)) + allocate(vertex%nbrs_wgt_ghost(num)) + + + end subroutine allocate_gridvertex_nbrs +!====================================================================== + + subroutine deallocate_gridvertex_nbrs(vertex) + + type (GridVertex_t), intent(inout) :: vertex + + deallocate(vertex%nbrs) + deallocate(vertex%nbrs_face) + deallocate(vertex%nbrs_wgt) + deallocate(vertex%nbrs_wgt_ghost) + + end subroutine deallocate_gridvertex_nbrs + +!====================================================================== + +! ===================================== +! copy edge: +! copy device for overloading = sign. +! ===================================== + + + recursive subroutine copy_gridedge(edge2, edge1) + + type (GridEdge_t), intent(out) :: edge2 + type (GridEdge_t), intent(in) :: edge1 + + edge2%tail_face = edge1%tail_face + edge2%head_face = edge1%head_face + edge2%tail_dir = edge1%tail_dir + edge2%head_dir = edge1%head_dir + edge2%reverse = edge1%reverse + edge2%wgtP = edge1%wgtP + edge2%wgtS = edge1%wgtS + + + if (associated(edge1%tail)) then + edge2%tail=>edge1%tail + end if + if (associated(edge1%head)) then + edge2%head=>edge1%head + end if + + end subroutine copy_gridedge + +!====================================================================== + + recursive subroutine copy_gridvertex(vertex2, vertex1) + + implicit none + + type (GridVertex_t), intent(out) :: vertex2 + type (GridVertex_t), intent(in) :: vertex1 + + integer :: i,j,n + + n = SIZE(vertex1%nbrs) + + if (associated(vertex2%nbrs)) then + nullify(vertex2%nbrs) + end if + if (associated(vertex2%nbrs_face)) then + nullify(vertex2%nbrs_face) + end if + if (associated(vertex2%nbrs_wgt)) then + nullify(vertex2%nbrs_wgt) + end if + if (associated(vertex2%nbrs_wgt_ghost)) then + nullify(vertex2%nbrs_wgt_ghost) + end if + + call allocate_gridvertex_nbrs(vertex2) + + do i=1,n + vertex2%nbrs(i) = vertex1%nbrs(i) + vertex2%nbrs_face(i) = vertex1%nbrs_face(i) + vertex2%nbrs_wgt(i) = vertex1%nbrs_wgt(i) + vertex2%nbrs_wgt_ghost(i) = vertex1%nbrs_wgt_ghost(i) + enddo + + do i=1, num_neighbors+1 + vertex2%nbrs_ptr(i) = vertex1%nbrs_ptr(i) + enddo + + vertex2%face_number = vertex1%face_number + vertex2%number = vertex1%number + vertex2%processor_number = vertex1%processor_number + vertex2%SpaceCurve = vertex1%SpaceCurve + + end subroutine copy_gridvertex + +!=========================== +! search edge list for match +!=========================== + + function gridedge_search(nvert1, nvert2, edge) result(number) + + integer, intent(in) :: nvert1 + integer, intent(in) :: nvert2 + type(GridEdge_t), intent(in) :: edge(:) + integer :: number + + integer :: tmp + integer :: head + integer :: tail + + integer :: nedge + integer :: i + + nedge=SIZE(edge) + + tail=nvert1 + head=nvert2 + + if (tail > head) then + tmp = tail + tail = head + head = tmp + end if + + do i=1,nedge + if (edge(i)%tail%number==tail .and. edge(i)%head%number==head)then + number=i + end if + end do + + end function gridedge_search + +!====================================================================== + + function gridedge_type(edge) result(type) + + use params_mod, only : INTERNAL_EDGE, EXTERNAL_EDGE + type (GridEdge_t), intent(in) :: edge + integer :: type + + if (edge%head%processor_number==edge%tail%processor_number) then + type=INTERNAL_EDGE + else + type=EXTERNAL_EDGE + endif + + end function gridedge_type + +!====================================================================== + + + + function grid_edge_uses_vertex(Vertex,Edge) result(log) + + type(GridVertex_t), intent(in) :: Vertex + type(GridEdge_t), intent(in) :: Edge + logical :: log + integer :: number + + number = Vertex%number + if(number == Edge%head%number .or. number == Edge%tail%number) then + log = .TRUE. + else + log = .FALSE. + endif + + end function grid_edge_uses_vertex + +!====================================================================== + + subroutine PrintChecksum(TestPattern,Checksum) + + use dimensions_mod, only : nlev, nelemd, np + + implicit none + + real(kind=r8), target,intent(in) :: TestPattern(:,:,:,:) + real(kind=r8), target,intent(in) :: Checksum(:,:,:,:) + + integer :: i,k,ix,iy + + print * + write (iulog,*) 'checksums:' + do i=1,nelemd + ! Lets start out only looking at the first element + write(iulog,*) + do k=1,nlev + do iy=1,np + do ix=1,np + write(iulog,*)INT(TestPattern(ix,iy,k,i))," checksum = ",INT(Checksum(ix,iy,k,i)) + enddo + enddo + enddo + enddo + + + end subroutine PrintChecksum + +!====================================================================== + + subroutine CreateSubGridGraph(Vertex, SVertex, local2global) + + implicit none + + type (GridVertex_t),intent(in) :: Vertex(:) + type (GridVertex_t),intent(inout) :: SVertex(:) + integer,intent(in) :: local2global(:) + + integer :: nelem,nelem_s,n,ncount,cnt,pos, orig_start + integer :: inbr,i,ig,j,k, new_pos + + integer,allocatable :: global2local(:) + + nelem = SIZE(Vertex) + nelem_s = SiZE(SVertex) + + allocate(global2local(nelem)) + + global2local(:) = 0 + do i=1,nelem_s + ig = local2global(i) + global2local(ig) = i + enddo + + do i=1,nelem_s + ig = local2global(i) + + call copy_gridvertex(SVertex(i),Vertex(ig)) !svertex(i) = vertex(ig) + + n = SIZE(SVertex(i)%nbrs(:)) + ! ============================================== + ! Apply the correction to the neighbors list to + ! reflect new subgraph numbers + ! ============================================== + + orig_start = 1 + + do j=1,num_neighbors + + cnt = Svertex(i)%nbrs_ptr(j+1) - orig_start !number of neighbors for this direction + ncount = 0 + do k = 1, cnt + pos = orig_start + k-1 + inbr = global2local(Svertex(i)%nbrs(pos)) + + if(inbr .gt. 0) then + new_pos = Svertex(i)%nbrs_ptr(j) + ncount + + Svertex(i)%nbrs(new_pos) = inbr + Svertex(i)%nbrs_face(new_pos) = Svertex(i)%nbrs_face(pos) + Svertex(i)%nbrs_wgt(new_pos) = Svertex(i)%nbrs_wgt(pos) + Svertex(i)%nbrs_wgt_ghost(new_pos) = Svertex(i)%nbrs_wgt_ghost(pos) + ncount = ncount+1 + endif + enddo + !set neighbors ptr + orig_start = Svertex(i)%nbrs_ptr(j+1); + Svertex(i)%nbrs_ptr(j+1) = Svertex(i)%nbrs_ptr(j) + ncount + + + enddo !num_neighbors loop + + + Svertex(i)%number = i + enddo !nelem_s loop + deallocate(global2local) + + end subroutine CreateSubGridGraph + +!====================================================================== + + subroutine PrintGridEdge(Edge) + + implicit none + type (GridEdge_t), intent(in) :: Edge(:) + + integer :: i,nedge,ii,wgtP + + nedge = SIZE(Edge) + + write(iulog,95) + do i=1,nedge + ii=Edge(i)%tail_face + + !map to correct location - for now all on same nbr side have same wgt, so take the first one + ii = Edge(i)%tail%nbrs_ptr(ii) + + wgtP=Edge(i)%tail%nbrs_wgt(ii) + write(iulog,100) i, & + Edge(i)%tail%number,Edge(i)%tail_face, wgtP, & + Edge(i)%head%number,Edge(i)%head_face, gridedge_type(Edge(i)) + enddo + 95 format(5x,'GRIDEDGE #',3x,'Tail (face)',5x,'Head (face)',3x,'Type') + 100 format(10x,I6,8x,I4,1x,'(',I1,') --',I2,'--> ',I6,1x,'(',I1,')',5x,'[',I1,']') + + end subroutine PrintGridEdge + +!====================================================================== +! ========================================== +! set_GridVertex_neighbors: +! +! Set global element number for element elem +! ========================================== + + subroutine set_GridVertex_number(elem,number) + + type(GridVertex_t) :: elem + integer :: number + + elem%number=number + + end subroutine set_GridVertex_number + +!====================================================================== + subroutine PrintGridVertex(Vertex) + + implicit none + type (GridVertex_t), intent(in),target :: Vertex(:) + + integer :: i,nvert + integer ::n_west, n_east, n_south, n_north, n_swest, n_seast, n_nwest, n_neast + integer ::w_west, w_east, w_south, w_north, w_swest, w_seast, w_nwest, w_neast + integer ::n, print_buf(90), nbr(8), j, k, start, cnt, nbrs_cnt(8) + + nbr = (/ west, east, south, north, swest, seast, nwest, neast/) + + nvert = SIZE(Vertex) + + write(iulog,98) + do i=1,nvert + + print_buf(:) = 0 + nbrs_cnt(:) = 0 + cnt = 1 + do j = 1,num_neighbors + n = Vertex(i)%nbrs_ptr(nbr(j)+1) - Vertex(i)%nbrs_ptr(nbr(j)) !num neigbors in that directions + start = Vertex(i)%nbrs_ptr(nbr(j)) !start in array + nbrs_cnt(j) = n + do k = 1, n + print_buf(cnt) = Vertex(i)%nbrs(start+k-1) + print_buf(cnt+1) = Vertex(i)%nbrs_wgt(start+k-1) + print_buf(cnt+2) = Vertex(i)%nbrs_face(start+k-1) + cnt = cnt + 3 + end do + enddo + + write(iulog,991) Vertex(i)%number, Vertex(i)%processor_number, & + Vertex(i)%face_number, & + print_buf(1:cnt-1) + + write(iulog,992) nbrs_cnt(1:8) + + + enddo + 98 format(5x,'GRIDVERTEX #',2x,'PART',2x,'DEG',4x,'W',9x,'E',9x, & + 'S',9x,'N',9x,'SW',9x,'SE',9x,'NW',9x,'NE') + + 991 format(10x,I3,8x,I4,8x,I4,2x,30(1x,I4,1x,'(',I2,I2,')')) + 992 format(30x,'nbrs_cnt:', 2x,8(1x,I4)) + + end subroutine PrintGridVertex + + +!====================================================================== + + subroutine CheckGridNeighbors(Vertex) + + implicit none + type (GridVertex_t), intent(in) :: Vertex(:) + + integer :: i,j,k,l,m,nnbrs,inbrs,nvert + nvert = SIZE(Vertex) + + do i=1,nvert + nnbrs = SIZE(Vertex(i)%nbrs) + do j=1,nnbrs + inbrs = Vertex(i)%nbrs(j) + if(inbrs > 0) then + do k=1,nnbrs + if( inbrs .eq. Vertex(i)%nbrs(k) .and. (j/=k) ) & + write(iulog,*)'CheckGridNeighbors: ERROR identical neighbors detected for Vertex ',i + + enddo + endif + enddo + enddo + + end subroutine CheckGridNeighbors + +!====================================================================== + subroutine initgridedge(GridEdge,GridVertex) + use cam_abortutils, only : endrun + use dimensions_mod, only : max_corner_elem + + type (GridEdge_t), intent(inout) :: GridEdge(:) + type (GridVertex_t), intent(in),target :: GridVertex(:) + + integer :: i,j,k,iptr,m,n,wgtV,wgtP + integer :: nelem,nelem_edge,inbr + logical :: Verbose=.FALSE. + integer :: mynbr_cnt, cnt, mystart, start + + nelem = SIZE(GridVertex) + nelem_edge = SIZE(GridEdge) + + GridEdge(:)%reverse=.FALSE. + GridEdge(:)%wgtP=-1 + GridEdge(:)%wgtS=-1 + + iptr=1 + do j=1,nelem + do i=1,num_neighbors + mynbr_cnt = GridVertex(j)%nbrs_ptr(i+1) - GridVertex(j)%nbrs_ptr(i) !length of neighbor location + mystart = GridVertex(j)%nbrs_ptr(i) + do m=0,mynbr_cnt-1 + if((GridVertex(j)%nbrs_wgt(mystart + m) .gt. 0)) then ! Do this only if has a non-zero weight + if (nelem_edge GridVertex(j) + GridEdge(iptr)%tail_face = mystart + m ! needs to be mystart + m (location in array) + GridEdge(iptr)%tail_dir = i*max_corner_elem + m !conversion needed for setcycle + inbr = GridVertex(j)%nbrs(mystart+m) + GridEdge(iptr)%head => GridVertex(inbr) + + ! =========================================== + ! Need this awful piece of code to determine + ! which "face" of the neighbor element the + ! edge links (i.e. the "head_face") + ! =========================================== + do k=1,num_neighbors + cnt = GridVertex(inbr)%nbrs_ptr(k+1) -GridVertex(inbr)%nbrs_ptr(k) + start = GridVertex(inbr)%nbrs_ptr(k) + do n = 0, cnt-1 + if(GridVertex(inbr)%nbrs(start+n) == GridVertex(j)%number) then + GridEdge(iptr)%head_face=start+n !needs to be start + n (location in array) + GridEdge(iptr)%head_dir=k*max_corner_elem+n !conversion (un-done in setcycle) + endif + enddo + enddo + GridEdge(iptr)%wgtP = GridVertex(j)%nbrs_wgt(mystart+m) + GridEdge(iptr)%wgtS = 1 + iptr=iptr+1 + end if + end do ! m loop + end do !end i loop + end do !end j loop + if (nelem_edge+1 /= iptr) then + call endrun('Error in initgridedge: Number of edges less than expected.') + end if + if (Verbose) then + + print * + write(iulog,*)"element edge tail,head list: (TEST)" + do i=1,nelem_edge + write(iulog,*)GridEdge(i)%tail%number,GridEdge(i)%head%number + end do + + print * + write(iulog,*)"element edge tail_face, head_face list: (TEST)" + do i=1,nelem_edge + write(iulog,*)GridEdge(i)%tail_face,GridEdge(i)%head_face + end do + end if + + end subroutine initgridedge +!====================================================================== + +end module GridGraph_mod diff --git a/src/dynamics/se/dycore/hybrid_mod.F90 b/src/dynamics/se/dycore/hybrid_mod.F90 new file mode 100644 index 0000000000..561b2127af --- /dev/null +++ b/src/dynamics/se/dycore/hybrid_mod.F90 @@ -0,0 +1,530 @@ +! =========================================== +! Module to support hybrid programming model +! hybrid_t is assumed to be a private struct +! =========================================== +module hybrid_mod + +use parallel_mod , only : parallel_t, copy_par +use thread_mod , only : omp_set_num_threads, omp_get_thread_num +use thread_mod , only : horz_num_threads, vert_num_threads, tracer_num_threads +use dimensions_mod, only : nlev, qsize, ntrac + +implicit none +private + + type, private :: hybrid_p + integer :: ibeg, iend + integer :: kbeg, kend + integer :: qbeg, qend + end type + + type, public :: hybrid_t + type (parallel_t) :: par + integer :: ithr + integer :: nthreads + integer :: ibeg, iend + integer :: kbeg, kend + integer :: qbeg, qend + logical :: masterthread + end type + + integer, allocatable :: work_pool_horz(:,:) + integer, allocatable :: work_pool_vert(:,:) + integer, allocatable :: work_pool_trac(:,:) + + integer :: nelemd_save + logical :: init_ranges = .true. + integer :: region_num_threads + character(len=64) :: region_name + + public :: PrintHybrid + public :: set_region_num_threads + private :: set_loop_ranges + public :: get_loop_ranges + public :: init_loop_ranges + public :: threadOwnsTracer, threadOwnsVertlevel + public :: config_thread_region + + interface config_thread_region + module procedure config_thread_region_par + module procedure config_thread_region_hybrid + end interface + interface PrintHybrid + module procedure PrintHybridnew + end interface + +contains + + subroutine PrintHybridnew(hybt,vname) + type (hybrid_t) :: hybt + character(len=*) :: vname + + write(*,21) vname, hybt%par%rank, hybt%ithr, hybt%nthreads, & + hybt%ibeg, hybt%iend,hybt%kbeg,hybt%kend, & + hybt%qbeg, hybt%qend +21 format('PrintHybrid: (',a, ', rank: ',i8, ', ithrd: ',i4,', nthreads: ',i4, & + ', i{beg,end}: ',2(i4),', k{beg,end}: ',2(i4),', q{beg,end}: ',2(i4),')') + + end subroutine PrintHybridnew + + + function config_thread_region_hybrid(old,region_name) result(new) + type (hybrid_t), intent(in) :: old + character(len=*), intent(in) :: region_name + type (hybrid_t) :: new + + integer :: ithr + integer :: kbeg_range, kend_range, qbeg_range, qend_range + + + ithr = omp_get_thread_num() + + if ( TRIM(region_name) == 'serial') then + region_num_threads = 1 + new%ibeg = old%ibeg; new%iend = old%iend + new%kbeg = old%kbeg; new%kend = old%kend + new%qbeg = old%qbeg; new%qend = old%qend + endif + if ( TRIM(region_name) == 'vertical') then + region_num_threads = vert_num_threads + call set_thread_ranges_1D ( work_pool_vert, kbeg_range, kend_range, ithr ) + new%ibeg = old%ibeg; new%iend = old%iend + new%kbeg = kbeg_range; new%kend = kend_range + new%qbeg = old%qbeg; new%qend = old%qend + endif + + if ( TRIM(region_name) == 'tracer' ) then + region_num_threads = tracer_num_threads + call set_thread_ranges_1D ( work_pool_trac, qbeg_range, qend_range, ithr) + new%ibeg = old%ibeg; new%iend = old%iend + new%kbeg = old%kbeg; new%kend = old%kend + new%qbeg = qbeg_range; new%qend = qend_range + endif + + + if ( TRIM(region_name) == 'vertical_and_tracer' ) then + region_num_threads = vert_num_threads*tracer_num_threads + call set_thread_ranges_2D ( work_pool_vert, work_pool_trac, kbeg_range, kend_range, & + qbeg_range, qend_range, ithr ) + new%ibeg = old%ibeg; new%iend = old%iend + new%kbeg = kbeg_range; new%kend = kend_range + new%qbeg = qbeg_range; new%qend = qend_range + endif + + + new%par = old%par ! relies on parallel_mod copy constructor + new%nthreads = old%nthreads * region_num_threads + if( region_num_threads .ne. 1 ) then + new%ithr = old%ithr * region_num_threads + ithr + else + new%ithr = old%ithr + endif + new%masterthread = old%masterthread +! Do we want to make this following call? +! call omp_set_num_threads(new%nthreads) + + end function config_thread_region_hybrid + + function config_thread_region_par(par,region_name) result(hybrid) + type (parallel_t) , intent(in) :: par + character(len=*), intent(in) :: region_name + type (hybrid_t) :: hybrid + ! local + integer :: ithr + integer :: ibeg_range, iend_range + integer :: kbeg_range, kend_range + integer :: qbeg_range, qend_range + integer :: nthreads + + ithr = omp_get_thread_num() + + if ( TRIM(region_name) == 'serial') then + region_num_threads = 1 + if ( .NOT. allocated(work_pool_horz) ) allocate(work_pool_horz(horz_num_threads,2)) + call set_thread_ranges_1D ( work_pool_horz, ibeg_range, iend_range, ithr ) + hybrid%ibeg = 1; hybrid%iend = nelemd_save + hybrid%kbeg = 1; hybrid%kend = nlev + hybrid%qbeg = 1; hybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'horizontal') then + region_num_threads = horz_num_threads + call set_thread_ranges_1D ( work_pool_horz, ibeg_range, iend_range, ithr ) + hybrid%ibeg = ibeg_range; hybrid%iend = iend_range + hybrid%kbeg = 1; hybrid%kend = nlev + hybrid%qbeg = 1; hybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'vertical') then + region_num_threads = vert_num_threads + call set_thread_ranges_1D ( work_pool_vert, kbeg_range, kend_range, ithr ) + hybrid%ibeg = 1; hybrid%iend = nelemd_save + hybrid%kbeg = kbeg_range; hybrid%kend = kend_range + hybrid%qbeg = 1; hybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'tracer' ) then + region_num_threads = tracer_num_threads + call set_thread_ranges_1D ( work_pool_trac, qbeg_range, qend_range, ithr) + hybrid%ibeg = 1; hybrid%iend = nelemd_save + hybrid%kbeg = 1; hybrid%kend = nlev + hybrid%qbeg = qbeg_range; hybrid%qend = qend_range + endif + + + if ( TRIM(region_name) == 'vertical_and_tracer' ) then + region_num_threads = vert_num_threads*tracer_num_threads + call set_thread_ranges_2D ( work_pool_vert, work_pool_trac, kbeg_range, kend_range, & + qbeg_range, qend_range, ithr ) + hybrid%ibeg = 1; hybrid%iend = nelemd_save + hybrid%kbeg = kbeg_range; hybrid%kend = kend_range + hybrid%qbeg = qbeg_range; hybrid%qend = qend_range + endif + call omp_set_num_threads(region_num_threads) + +! hybrid%par = par ! relies on parallel_mod copy constructor + call copy_par(hybrid%par,par) + hybrid%nthreads = region_num_threads + hybrid%ithr = ithr + hybrid%masterthread = (par%masterproc .and. ithr==0) + + end function config_thread_region_par + + subroutine init_loop_ranges(nelemd) + + integer, intent(in) :: nelemd + integer :: ith, beg_index, end_index + + + if ( init_ranges ) then + nelemd_save=nelemd +!JMD#ifdef _OPENMP + if ( .NOT. allocated(work_pool_horz) ) allocate(work_pool_horz(horz_num_threads,2)) + do ith=0,horz_num_threads-1 + call create_work_pool( 1, nelemd, horz_num_threads, ith, beg_index, end_index ) + work_pool_horz(ith+1,1) = beg_index + work_pool_horz(ith+1,2) = end_index + end do + + if ( .NOT. allocated(work_pool_vert) ) allocate(work_pool_vert(vert_num_threads,2)) + do ith=0,vert_num_threads-1 + call create_work_pool( 1, nlev, vert_num_threads, ith, beg_index, end_index ) + work_pool_vert(ith+1,1) = beg_index + work_pool_vert(ith+1,2) = end_index + end do + + if ( .NOT. allocated(work_pool_trac) ) allocate(work_pool_trac(tracer_num_threads,2)) + do ith=0,tracer_num_threads-1 + call create_work_pool( 1, qsize, tracer_num_threads, ith, beg_index, end_index ) + work_pool_trac(ith+1,1) = beg_index + work_pool_trac(ith+1,2) = end_index + end do + +!JMD#endif + init_ranges = .false. + endif + + end subroutine init_loop_ranges + + subroutine set_region_num_threads( local_name ) + + character(len=*), intent(in) :: local_name + + region_name = local_name + +#ifdef _OPENMP + + if ( TRIM(region_name) == 'horizontal') then + region_num_threads = horz_num_threads + call omp_set_num_threads(region_num_threads) + return + endif + + if ( TRIM(region_name) == 'vertical') then + region_num_threads = vert_num_threads + call omp_set_num_threads(region_num_threads) + return + endif + + if ( TRIM(region_name) == 'tracer' ) then + region_num_threads = tracer_num_threads + call omp_set_num_threads(region_num_threads) + return + endif + + if ( TRIM(region_name) == 'vertical_and_tracer' ) then + region_num_threads = vert_num_threads*tracer_num_threads + call omp_set_num_threads(region_num_threads) + return + endif + +#endif + + end subroutine set_region_num_threads + + subroutine set_loop_ranges (pybrid) + + type (hybrid_p) :: pybrid + + integer :: ibeg_range, iend_range + integer :: kbeg_range, kend_range + integer :: qbeg_range, qend_range + integer :: idthread + +#ifdef _OPENMP + idthread = omp_get_thread_num() + + if ( TRIM(region_name) == 'horizontal' ) then + call set_thread_ranges_1D ( work_pool_horz, ibeg_range, iend_range, idthread ) + pybrid%ibeg = ibeg_range; pybrid%iend = iend_range + pybrid%kbeg = 1; pybrid%kend = nlev + pybrid%qbeg = 1; pybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'vertical' ) then + call set_thread_ranges_1D ( work_pool_vert, kbeg_range, kend_range, idthread ) + !FIXME: need to set ibeg, iend as well + pybrid%kbeg = kbeg_range; pybrid%kend = kend_range + pybrid%qbeg = 1; pybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'tracer' ) then + call set_thread_ranges_1D ( work_pool_trac, qbeg_range, qend_range, idthread ) + !FIXME: need to set ibeg, iend as well + pybrid%kbeg = 1; pybrid%kend = nlev + pybrid%qbeg = qbeg_range; pybrid%qend = qend_range + endif + + if ( TRIM(region_name) == 'vertical_and_tracer' ) then + call set_thread_ranges_2D ( work_pool_vert, work_pool_trac, kbeg_range, kend_range, & + qbeg_range, qend_range, idthread ) + !FIXME: need to set ibeg, iend as well + pybrid%kbeg = kbeg_range; pybrid%kend = kend_range + pybrid%qbeg = qbeg_range; pybrid%qend = qend_range + endif + +#else + call reset_loop_ranges(pybrid, region_name) +#endif + + end subroutine set_loop_ranges + + subroutine get_loop_ranges (pybrid, ibeg, iend, kbeg, kend, qbeg, qend) + + type (hybrid_t), intent(in) :: pybrid + integer, optional, intent(out) :: ibeg, iend, kbeg, kend, qbeg, qend + + if ( present(ibeg) ) then + ibeg = pybrid%ibeg + endif + if ( present(iend) ) then + iend = pybrid%iend + endif + if ( present(kbeg) ) then + kbeg = pybrid%kbeg + endif + if ( present(kend) ) then + kend = pybrid%kend + endif + if ( present(qbeg) ) then + qbeg = pybrid%qbeg + endif + if ( present(qend) ) then + qend = pybrid%qend + endif + + end subroutine get_loop_ranges + + function threadOwnsVertlevel(hybrid,value) result(found) + + type (hybrid_t), intent(in) :: hybrid + integer, intent(in) :: value + logical :: found + + found = .false. + if ((value >= hybrid%kbeg) .and. (value <= hybrid%kend)) then + found = .true. + endif + + end function threadOwnsVertlevel + + function threadOwnsTracer(hybrid,value) result(found) + + type (hybrid_t), intent(in) :: hybrid + integer, intent(in) :: value + logical :: found + + found = .false. + if ((value >= hybrid%qbeg) .and. (value <= hybrid%qend)) then + found = .true. + endif + + end function threadOwnsTracer + + subroutine reset_loop_ranges (pybrid, region_name) + + type (hybrid_p) :: pybrid + character(len=*), intent(in) :: region_name + + if ( TRIM(region_name) == 'vertical' ) then + pybrid%kbeg = 1; pybrid%kend = nlev + endif + + if ( TRIM(region_name) == 'tracer' ) then + pybrid%qbeg = 1; pybrid%qend = qsize + endif + + if ( TRIM(region_name) == 'vertical_and_tracer' ) then + pybrid%kbeg = 1; pybrid%kend = nlev + pybrid%qbeg = 1; pybrid%qend = qsize + endif + + end subroutine reset_loop_ranges + + subroutine set_thread_ranges_3D ( work_pool_x, work_pool_y, work_pool_z, & + beg_range_1, end_range_1, beg_range_2, end_range_2, & + beg_range_3, end_range_3, idthread ) + + integer, intent (in ) :: work_pool_x(:,:) + integer, intent (in ) :: work_pool_y(:,:) + integer, intent (in ) :: work_pool_z(:,:) + integer, intent (inout) :: beg_range_1 + integer, intent (inout) :: end_range_1 + integer, intent (inout) :: beg_range_2 + integer, intent (inout) :: end_range_2 + integer, intent (inout) :: beg_range_3 + integer, intent (inout) :: end_range_3 + integer, intent (inout) :: idthread + + integer :: index(3) + integer :: i, j, k, ind, irange, jrange, krange + + ind = 0 + + krange = SIZE(work_pool_z,1) + jrange = SIZE(work_pool_y,1) + irange = SIZE(work_pool_x,1) + do k = 1, krange + do j = 1, jrange + do i = 1, irange + if( ind == idthread ) then + index(1) = i + index(2) = j + index(3) = k + endif + ind = ind + 1 + enddo + enddo + enddo + beg_range_1 = work_pool_x(index(1),1) + end_range_1 = work_pool_x(index(1),2) + beg_range_2 = work_pool_y(index(2),1) + end_range_2 = work_pool_y(index(2),2) + beg_range_3 = work_pool_z(index(3),1) + end_range_3 = work_pool_z(index(3),2) + +! write(6,1000) idthread, beg_range_1, end_range_1, & +! beg_range_2, end_range_2, & +! beg_range_3, end_range_3 +! call flush(6) +1000 format( 'set_thread_ranges_3D', 7(i4) ) + + end subroutine set_thread_ranges_3D + + subroutine set_thread_ranges_2D( work_pool_x, work_pool_y, beg_range_1, end_range_1, & + beg_range_2, end_range_2, idthread ) + + integer, intent (in ) :: work_pool_x(:,:) + integer, intent (in ) :: work_pool_y(:,:) + integer, intent (inout) :: beg_range_1 + integer, intent (inout) :: end_range_1 + integer, intent (inout) :: beg_range_2 + integer, intent (inout) :: end_range_2 + integer, intent (inout) :: idthread + + integer :: index(2) + integer :: i, j, ind, irange, jrange + + ind = 0 + + jrange = SIZE(work_pool_y,1) + irange = SIZE(work_pool_x,1) + do j = 1, jrange + do i = 1, irange + if( ind == idthread ) then + index(1) = i + index(2) = j + endif + ind = ind + 1 + enddo + enddo + beg_range_1 = work_pool_x(index(1),1) + end_range_1 = work_pool_x(index(1),2) + beg_range_2 = work_pool_y(index(2),1) + end_range_2 = work_pool_y(index(2),2) + +! write(6,1000) idthread, beg_range_1, end_range_1, & +! beg_range_2, end_range_2 +! call flush(6) + +1000 format( 'set_thread_ranges_2D', 7(i4) ) + + end subroutine set_thread_ranges_2D + + subroutine set_thread_ranges_1D( work_pool, beg_range, end_range, idthread ) + + integer, intent (in ) :: work_pool(:,:) + integer, intent (inout) :: beg_range + integer, intent (inout) :: end_range + integer, intent (inout) :: idthread + + integer :: index + integer :: i, j, ind, irange + + ind = 0 + + irange = SIZE(work_pool) + do i = 1, irange + if( ind == idthread ) then + index = i + endif + ind = ind + 1 + enddo + beg_range = work_pool(index,1) + end_range = work_pool(index,2) + +! write(6,1000) idthread, beg_range, end_range +! call flush(6) +1000 format( 'set_thread_ranges_1D', 7(i4) ) + + end subroutine set_thread_ranges_1D + + subroutine create_work_pool( start_domain, end_domain, ndomains, ipe, beg_index, end_index ) + + integer, intent(in) :: start_domain, end_domain + integer, intent(in) :: ndomains, ipe + integer, intent(out) ::beg_index, end_index + + integer :: beg(0:ndomains) + integer :: length + integer :: n + + length = end_domain - start_domain + 1 + beg(0) = start_domain + + do n=1,ndomains-1 + if (n.le.mod(length,ndomains)) then + beg(n)=beg(n-1)+(length-1)/ndomains+1 + else + beg(n)=beg(n-1)+length/ndomains + end if + end do + + beg(ndomains) = start_domain + length + + beg_index = beg(ipe) + end_index = beg(ipe+1) - 1 + + end subroutine create_work_pool + +end module hybrid_mod diff --git a/src/dynamics/se/dycore/hybvcoord_mod.F90 b/src/dynamics/se/dycore/hybvcoord_mod.F90 new file mode 100644 index 0000000000..641a255ecd --- /dev/null +++ b/src/dynamics/se/dycore/hybvcoord_mod.F90 @@ -0,0 +1,28 @@ +module hybvcoord_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_logfile, only: iulog + use dimensions_mod, only: plev => nlev, plevp => nlevp + use physconst, only: pstd + + implicit none + private + + !----------------------------------------------------------------------- + ! hvcoord_t: Hybrid level definitions: p = a*p0 + b*ps + ! interfaces p(k) = hyai(k)*ps0 + hybi(k)*ps + ! midpoints p(k) = hyam(k)*ps0 + hybm(k)*ps + !----------------------------------------------------------------------- + type, public :: hvcoord_t + real(r8) ps0 ! base state surface-pressure for level definitions + real(r8) hyai(plevp) ! ps0 component of hybrid coordinate - interfaces + real(r8) hyam(plev) ! ps0 component of hybrid coordinate - midpoints + real(r8) hybi(plevp) ! ps component of hybrid coordinate - interfaces + real(r8) hybm(plev) ! ps component of hybrid coordinate - midpoints + real(r8) hybd(plev) ! difference in b (hybi) across layers + real(r8) prsfac ! log pressure extrapolation factor (time, space independent) + real(r8) etam(plev) ! eta-levels at midpoints + real(r8) etai(plevp) ! eta-levels at interfaces + integer nprlev ! number of pure pressure levels at top + integer pad + end type hvcoord_t +end module hybvcoord_mod diff --git a/src/dynamics/se/dycore/interpolate_mod.F90 b/src/dynamics/se/dycore/interpolate_mod.F90 new file mode 100644 index 0000000000..10716fb34b --- /dev/null +++ b/src/dynamics/se/dycore/interpolate_mod.F90 @@ -0,0 +1,1828 @@ +module interpolate_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use element_mod, only: element_t + use dimensions_mod, only: np, ne, nelemd, nc, nhe, nhc + use quadrature_mod, only: quadrature_t, legendre, quad_norm + use coordinate_systems_mod, only: spherical_polar_t, cartesian2d_t, & + cartesian3D_t, sphere2cubedsphere, spherical_to_cart, & + cubedsphere2cart, distance, change_coordinates, projectpoint + use physconst, only: PI + use quadrature_mod, only: quadrature_t, gauss, gausslobatto + use parallel_mod, only: syncmp, parallel_t + use cam_abortutils, only: endrun + use spmd_utils, only: MPI_MAX, MPI_SUM, MPI_MIN, mpi_real8, MPI_integer + use cube_mod, only: convert_gbl_index, dmap, ref2sphere + use mesh_mod, only: MeshUseMeshFile + use control_mod, only: cubed_sphere_map + use cam_logfile, only: iulog + + implicit none + private + save + + logical :: debug=.false. + + type, public :: interpolate_t + real (kind=r8), dimension(:,:), pointer :: Imat ! P_k(xj)*wj/gamma(k) + real (kind=r8), dimension(:) , pointer :: rk ! 1/k + real (kind=r8), dimension(:) , pointer :: vtemp ! temp results + real (kind=r8), dimension(:) , pointer :: glp ! GLL pts (nair) + end type interpolate_t + + type, public :: interpdata_t + ! Output Interpolation points. Used to output data on lat-lon (or other grid) + ! with native element interpolation. Each element keeps a list of points from the + ! interpolation grid that are in this element + type (cartesian2D_t),pointer,dimension(:):: interp_xy ! element coordinate + integer, pointer,dimension(:) :: ilat,ilon ! position of interpolation point in lat-lon grid + integer :: n_interp + integer :: nlat + integer :: nlon + logical :: first_entry = .TRUE. + end type interpdata_t + + real (kind=r8), private :: delta = 1.0e-9_r8 ! move tiny bit off center to + ! avoid landing on element edges + + + ! static data for interp_tracers + logical :: interp_tracers_init=.false. + real (kind=r8 ) :: interp_c(np,np) + real (kind=r8 ) :: interp_gll(np) + + public :: interp_init + public :: setup_latlon_interp + public :: interpolate_scalar + public :: interpolate_ce + + public :: interpol_phys_latlon + public :: interpolate_vector + public :: set_interp_parameter + public :: get_interp_parameter + public :: get_interp_gweight + public :: get_interp_lat + public :: get_interp_lon + public :: cube_facepoint_ne + public :: cube_facepoint_unstructured + public :: parametric_coordinates + + public :: interpolate_tracers + public :: interpolate_tracers_init + public :: minmax_tracers + public :: interpolate_2d + public :: interpolate_create + public :: point_inside_quad + public :: vec_latlon_to_contra + + + interface interpolate_scalar + module procedure interpolate_scalar2d + module procedure interpolate_scalar3d + end interface + interface interpolate_vector + module procedure interpolate_vector2d + module procedure interpolate_vector3d + end interface + + type (interpolate_t), target :: interp_p + + ! store the lat-lon grid + ! gridtype = 1 equally spaced, including poles (FV scalars output grid) + ! gridtype = 2 Gauss grid (CAM Eulerian) + ! gridtype = 3 equally spaced, no poles (FV staggered velocity) + ! Seven possible history files, last one is inithist and should be native grid + integer :: nlat,nlon + real (kind=r8), pointer, public :: lat(:) => NULL() + real (kind=r8), pointer, public :: lon(:) => NULL() + real (kind=r8), pointer, public :: gweight(:) => NULL() + integer :: gridtype = 1 ! + integer :: itype = 1 ! 0 = native high order + ! 1 = bilinear + + integer :: auto_grid = 0 ! 0 = interpolation grid set by namelist + ! 1 = grid set via mesh resolution + + + ! static data, used by bilin_phys2gll() + ! shared by all threads. only allocate if subroutine will be used +!JMD integer :: nphys_init=0 +!JMD integer :: index_l(np),index_r(np) +!JMD real(kind=r8),allocatable :: weights(:,:,:,:,:) ! np,np,2,2,nelemd + +!JMD public :: bilin_phys2gll +!JMD public :: bilin_phys2gll_init +contains + + + subroutine set_interp_parameter(parm_name, value) + character*(*), intent(in) :: parm_name + character(len=80) :: msg + integer :: value,power + real (kind=r8) :: value_target + + if(parm_name .eq. 'itype') then + itype=value + else if(parm_name .eq. 'nlon') then + nlon=value + else if(parm_name .eq. 'nlat') then + nlat=value + else if(parm_name.eq. 'gridtype') then + gridtype=value + else if(parm_name.eq. 'auto') then + auto_grid=1 + ! compute recommended nlat,nlon which has slightly higher + ! resolution than the specifed number of points around equator given in "value" + ! computed recommended lat-lon grid. + ! nlon > peq peq = points around equator cubed sphere grid + ! take nlon power of 2, and at most 1 power of 3 + if (value.eq.0) then + ! If reading in unstructured mesh, ne = 0 + ! This makes it hard to guess how many interpolation points to use + ! So We'll set the default as 720 x 360 + ! BUT if you're running with an unstructured mesh, set interp_nlon and interp_nlat + nlon = 1536 + nlat = 768 + else + value_target=value*1.25_r8 + power = nint(0.5_r8 + log( value_target)/log(2.0_r8) ) + power = max(power,7) ! min grid: 64x128 + if ( 3*2**(power-2) > value_target) then + nlon=3*2**(power-2) ! use 1 power of 3 + else + nlon=2**power + endif + endif + nlat=nlon/2 + if (gridtype==1) nlat=nlat+1 + else + write(msg,*) 'Did not recognize parameter named ',parm_name,' in interpolate_mod:set_interp_parameter' + call endrun(msg) + end if + end subroutine set_interp_parameter + function get_interp_parameter(parm_name) result(value) + character*(*), intent(in) :: parm_name + integer :: value + character(len=80) :: msg + if(parm_name .eq. 'itype') then + value=itype + else if(parm_name .eq. 'nlon') then + value=nlon + else if(parm_name .eq. 'nlat') then + value=nlat + else if(parm_name.eq. 'gridtype') then + value=gridtype + else if(parm_name.eq. 'auto_grid') then + value=auto_grid + else + write(msg,*) 'Did not recognize parameter named ',parm_name,' in interpolate_mod:get_interp_parameter' + value=-1 + call endrun(msg) + end if + return + end function get_interp_parameter + function get_interp_gweight() result(gw) + real(kind=r8) :: gw(nlat) + gw=gweight + return + end function get_interp_gweight + function get_interp_lat() result(thislat) + real(kind=r8) :: thislat(nlat) + thislat=lat*180.0_r8/PI + return + end function get_interp_lat + function get_interp_lon() result(thislon) + real(kind=r8) :: thislon(nlon) + thislon=lon*180.0_r8/PI + return + end function get_interp_lon + + subroutine interpolate_create(gquad,interp) + type (quadrature_t) , intent(in) :: gquad + type (interpolate_t), intent(out) :: interp + + + ! Local variables + + integer k,j + integer npts + real (kind=r8), dimension(:), allocatable :: gamma + real (kind=r8), dimension(:), allocatable :: leg + + npts = size(gquad%points) + + allocate(interp%Imat(npts,npts)) + allocate(interp%rk(npts)) + allocate(interp%vtemp(npts)) + allocate(interp%glp(npts)) + allocate(gamma(npts)) + allocate(leg(npts)) + + gamma = quad_norm(gquad,npts) + + do k=1,npts + interp%rk(k) = 1.0_r8/k + interp%glp(k) = gquad%points(k) !nair + end do + + do j=1,npts + leg=legendre(gquad%points(j),npts-1) + do k=1,npts + interp%Imat(j,k)=leg(k)*gquad%weights(j)/gamma(k) + end do + end do + + deallocate(gamma) + deallocate(leg) + + end subroutine interpolate_create + + + subroutine interpolate_tracers_init() + use dimensions_mod, only : np, qsize + use quadrature_mod, only : quadrature_t, gausslobatto + + + implicit none + + type (quadrature_t ) :: gll + real (kind=r8 ) :: dp (np) + integer :: i,j + + gll=gausslobatto(np) + dp = 1 + do i=1,np + do j=1,np + if (i /= j) then + dp(i) = dp(i) * (gll%points(i) - gll%points(j)) + end if + end do + end do + do i=1,np + do j=1,np + interp_c(i,j) = 1/(dp(i)*dp(j)) + end do + end do + interp_gll(:) = gll%points(:) + interp_tracers_init = .true. + + deallocate(gll%points) + deallocate(gll%weights) + + + end subroutine interpolate_tracers_init + + + + + subroutine interpolate_tracers(r, tracers, f) + use dimensions_mod, only : np, qsize + + + implicit none + type (cartesian2D_t), intent(in) :: r + real (kind=r8),intent(in) :: tracers(np*np,qsize) + real (kind=r8),intent(out) :: f(qsize) + + real (kind=r8 ) :: x (np) + real (kind=r8 ) :: y (np) + real (kind=r8 ) :: xy (np*np) + + integer :: i,j + + + if (.not. interp_tracers_init ) then + call endrun('ERROR: interpolate_tracers() was not initialized') + endif + + x = 1 + y = 1 + do i=1,np + do j=1,np + if (i /= j) then + x(i) = x(i) * (r%x - interp_gll(j)) + y(i) = y(i) * (r%y - interp_gll(j)) + end if + end do + end do + + do j=1,np + do i=1,np + xy(i + (j-1)*np) = x(i)*y(j)*interp_c(i,j) + end do + end do + f = MATMUL(xy,tracers) + end subroutine interpolate_tracers + + + + subroutine linear_interpolate_2d(x,y,s,v) + use dimensions_mod, only : np, qsize + + real(kind=r8) , intent(in) :: x(np) + real(kind=r8), intent(in) :: y(np,np,qsize) + type (cartesian2D_t), intent(in) :: s + real(kind=r8), intent(inout) :: v(qsize) + + integer :: i,j,q + real (kind=r8) dx, dy(qsize), dydx(qsize) + real (kind=r8) y0(qsize), y1(qsize) + type (cartesian2D_t) :: r + + r = s + if (r%x < -1) r%x = -1 + if (r%y < -1) r%y = -1 + if ( 1 < r%x) r%x = 1 + if ( 1 < r%y) r%y = 1 + do i=1,np + if (r%x < x(i)) exit + end do + do j=1,np + if (r%y < x(j)) exit + end do + if (1 < i) i = i-1 + if (1 < j) j = j-1 + if (np==i) i = i-1 + if (np==j) j = j-1 + + dx = x(i+1) - x(i) + dy = y(i+1,j,:) - y(i,j,:) + dydx = dy/dx + y0 = y(i,j,:) + (r%x-x(i))*dydx + + dy = y(i+1,j+1,:) - y(i,j+1,:) + dydx = dy/dx + y1 = y(i,j+1,:) + (r%x-x(i))*dydx + + dx = x(j+1) - x(j) + dy = y1 - y0 + dydx = dy/dx + v = y0 + (r%y-x(j))*dydx + + end subroutine linear_interpolate_2d + + subroutine minmax_tracers(r, tracers, mint, maxt) + use dimensions_mod, only : np, qsize + use quadrature_mod, only : quadrature_t, gausslobatto + + + implicit none + + type (cartesian2D_t), intent(in) :: r + real (kind=r8),intent(in) :: tracers(np,np,qsize) + real (kind=r8),intent(out) :: mint (qsize) + real (kind=r8),intent(out) :: maxt (qsize) + + type (quadrature_t), save :: gll + integer :: i,j + logical , save :: first_time=.true. + real (kind=r8) :: y1 (qsize) + real (kind=r8) :: y2 (qsize) + real (kind=r8) :: q_interp (4,qsize) + type (cartesian2D_t) :: s + real (kind=r8) :: delta + integer :: q + + do q=1,qsize + mint(q) = minval(tracers(:,:,q)) + maxt(q) = maxval(tracers(:,:,q)) + enddo + return + + delta = 1._r8/8._r8 + + if (first_time) then + first_time = .false. + gll=gausslobatto(np) + end if + + do i=1,np + if (r%x < gll%points(i)) exit + end do + do j=1,np + if (r%y < gll%points(j)) exit + end do + if (1 < i) i = i-1 + if (1 < j) j = j-1 + if (np==i) i = i-1 + if (np==j) j = j-1 + +! mint(:) = minval(minval(tracers(i:i+1,j:j+1,:),1),1) +! maxt(:) = maxval(maxval(tracers(i:i+1,j:j+1,:),1),1) + +! Or check this out: + s = r + s%x = s%x - delta + s%y = s%y - delta + call linear_interpolate_2d(gll%points,tracers,s,q_interp(1,:)) + s = r + s%x = s%x + delta + s%y = s%y - delta + call linear_interpolate_2d(gll%points,tracers,s,q_interp(2,:)) + s = r + s%x = s%x - delta + s%y = s%y + delta + call linear_interpolate_2d(gll%points,tracers,s,q_interp(3,:)) + s = r + s%x = s%x + delta + s%y = s%y + delta + call linear_interpolate_2d(gll%points,tracers,s,q_interp(4,:)) + + mint(:) = minval(q_interp(:,:),1) + maxt(:) = maxval(q_interp(:,:),1) + end subroutine minmax_tracers + + function interpolate_2d(cart, f, interp, npts, fillvalue) result(fxy) + integer, intent(in) :: npts + type (cartesian2D_t), intent(in) :: cart + real (kind=r8), intent(in) :: f(npts,npts) + type (interpolate_t) :: interp + real (kind=r8) :: fxy ! value of f interpolated to (x,y) + real (kind=r8), intent(in), optional :: fillvalue + ! local variables + + real (kind=r8) :: tmp_1,tmp_2 + real (kind=r8) :: fk0,fk1 + real (kind=r8) :: pk + + integer :: l,j,k + + if(present(fillvalue)) then + if (any(f==fillvalue)) then + fxy = fillvalue + return + endif + endif + + + do l=1,npts,2 + + ! Compute Pk(cart%x) for Legendre order 0 + + pk = 1.0_r8 + + fk0=0.0_r8 + fk1=0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,1)*f(j,l ) + fk1 = fk1 + interp%Imat(j,1)*f(j,l+1) + end do + interp%vtemp(l ) = pk*fk0 + interp%vtemp(l+1) = pk*fk1 + + ! Compute Pk(cart%x) for Legendre order 1 + + tmp_2 = pk + pk = cart%x + + fk0=0.0_r8 + fk1=0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,2)*f(j,l ) + fk1 = fk1 + interp%Imat(j,2)*f(j,l+1) + end do + interp%vtemp(l ) = interp%vtemp(l ) + pk*fk0 + interp%vtemp(l+1) = interp%vtemp(l+1) + pk*fk1 + + ! Compute Pk(cart%x) for Legendre order 2 to npts-1 + + do k = 2,npts-1 + + tmp_1 = tmp_2 + tmp_2 = pk + pk = ( (2*k-1)*cart%x*tmp_2 - (k-1)*tmp_1 )*interp%rk(k) + + fk0=0.0_r8 + fk1=0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,k+1)*f(j,l ) + fk1 = fk1 + interp%Imat(j,k+1)*f(j,l+1) + end do + interp%vtemp(l ) = interp%vtemp(l ) + pk*fk0 + interp%vtemp(l+1) = interp%vtemp(l+1) + pk*fk1 + + end do + + end do + + ! Compute Pk(cart%y) for Legendre order 0 + + pk = 1.0_r8 + + fk0 = 0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,1)*interp%vtemp(j) + end do + fxy = pk*fk0 + + ! Compute Pk(cart%y) for Legendre order 1 + + tmp_2 = pk + pk = cart%y + + fk0=0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,2)*interp%vtemp(j) + end do + fxy = fxy + pk*fk0 + + ! Compute Pk(cart%y) for Legendre order 2, npts-1 + + do k = 2,npts-1 + tmp_1 = tmp_2 + tmp_2 = pk + pk = ( (2*k-1)*cart%y*tmp_2 - (k-1)*tmp_1 )*interp%rk(k) + + fk0 = 0.0_r8 + do j=1,npts + fk0 = fk0 + interp%Imat(j,k+1)*interp%vtemp(j) + end do + + fxy = fxy + pk*fk0 + + end do + + end function interpolate_2d + + !=============================== + !(Nair) Bilinear interpolation for every GLL grid cell + !=============================== + + function interpol_bilinear(cart, f, xoy, imin, imax, fillvalue) result(fxy) + integer, intent(in) :: imin,imax + type (cartesian2D_t), intent(in) :: cart + real (kind=r8), intent(in) :: f(imin:imax,imin:imax) + real (kind=r8) :: xoy(imin:imax) + real (kind=r8) :: fxy ! value of f interpolated to (x,y) + real (kind=r8), intent(in), optional :: fillvalue + ! local variables + + real (kind=r8) :: p,q,xp,yp ,y4(4) + integer :: l,j,k, ii, jj, na,nb,nm + + xp = cart%x + yp = cart%y + + ! Search index along "x" (bisection method) + + na = imin + nb = imax + do + if ((nb-na) <= 1) exit + nm = (nb + na)/2 + if (xp > xoy(nm)) then + na = nm + else + nb = nm + endif + enddo + ii = na + + ! Search index along "y" + + na = imin + nb = imax + do + if ((nb-na) <= 1) exit + nm = (nb + na)/2 + if (yp > xoy(nm)) then + na = nm + else + nb = nm + endif + enddo + jj = na + + ! GLL cell containing (xp,yp) + + y4(1) = f(ii,jj) + y4(2) = f(ii+1,jj) + y4(3) = f(ii+1,jj+1) + y4(4) = f(ii,jj+1) + + if(present(fillvalue)) then + if (any(y4==fillvalue)) then + fxy = fillvalue + return + endif + endif + + p = (xp - xoy(ii))/(xoy(ii+1) - xoy(ii)) + q = (yp - xoy(jj))/(xoy(jj+1) - xoy(jj)) + + fxy = (1.0_r8 - p)*(1.0_r8 - q)* y4(1) + p*(1.0_r8 - q) * y4(2) & + + p*q* y4(3) + (1.0_r8 - p)*q * y4(4) + end function interpol_bilinear + + ! ----------------------------------------------------------------------------------! + !FUNCTION interpol_phys_latlon----------------------------------------CE-for fvm! + ! AUTHOR: CHRISTOPH ERATH, 23. May 2012 ! + ! DESCRIPTION: evaluation of the reconstruction for every physics grid cell ! + ! ! + ! CALLS: + ! INPUT: + ! + ! OUTPUT: + !-----------------------------------------------------------------------------------! + subroutine interpol_phys_latlon(interpdata,f, fvm, corners, desc, flatlon,lmono) + use fvm_control_volume_mod, only : fvm_struct + ! use fvm_reconstruction_mod, only: reconstruction_gradient, recons_val_cart + use edgetype_mod, only : edgedescriptor_t + + type (interpdata_t), intent(in) :: interpdata + real (kind=r8), intent(inout) :: f(1-nhc:nc+nhc,1-nhc:nc+nhc) + type (fvm_struct), intent(in) :: fvm + type (cartesian2d_t), intent(in) :: corners(:) + type (edgedescriptor_t),intent(in) :: desc + logical, intent(in) :: lmono + + real (kind=r8) :: flatlon(:) + ! local variables + real (kind=r8) :: xp,yp, tmpval + real (kind=r8) :: tmpaxp,tmpaxm, tmpayp, tmpaym + integer :: i, ix, jy, starti,endi,tmpi + real (kind=r8), dimension(1-nhe:nc+nhe,1-nhe:nc+nhe,6) :: recons + + real (kind=r8), dimension(nc+1) :: x, y + + ! call reconstruction_gradient(f, fvm,recons,6,lmono) + ! recons=0.0 ! PCoM + + x(1:nc) = fvm%vtx_cart(1,1,1:nc,1 ) + y(1:nc) = fvm%vtx_cart(1,2,1 ,1:nc) + x(nc+1) = fvm%vtx_cart(2,1,nc,1 ) + y(nc+1) = fvm%vtx_cart(3,2,1 ,nc ) + + tmpaxp=(corners(1)%x+corners(2)%x)/2 + tmpaxm=(corners(2)%x-corners(1)%x)/2 + tmpayp=(corners(1)%y+corners(4)%y)/2 + tmpaym=(corners(4)%y-corners(1)%y)/2 + do i=1,interpdata%n_interp + ! caculation phys grid coordinate of xp point, note the interp_xy are on the reference [-1,1]x[-1,1] + xp=tan(tmpaxp+interpdata%interp_xy(i)%x*tmpaxm) + yp=tan(tmpayp+interpdata%interp_xy(i)%y*tmpaym) + + ! Search index along "x" (bisection method) + starti = 1 + endi = nc+1 + do + if ((endi-starti) <= 1) exit + tmpi = (endi + starti)/2 + if (xp > x(tmpi)) then + starti = tmpi + else + endi = tmpi + endif + enddo + ix = starti + + ! Search index along "y" + starti = 1 + endi = nc+1 + do + if ((endi-starti) <= 1) exit + tmpi = (endi + starti)/2 + if (yp > y(tmpi)) then + starti = tmpi + else + endi = tmpi + endif + enddo + jy = starti + + ! call recons_val_cart(f(ix,jy), xp,yp, fvm%spherecentroid(ix,jy,:), fvm%recons_metrics(ix,jy,:), & + ! recons(ix,jy,:), tmpval) + tmpval=f(ix,jy) + flatlon(i)=tmpval + !phl PCoM + ! flatlon(i)=f(ix,jy) + end do + end subroutine interpol_phys_latlon + + function parametric_coordinates(sphere, corners3D,ref_map_in, corners,u2qmap,facenum) result (ref) + implicit none + type (spherical_polar_t), intent(in) :: sphere + type (cartesian2D_t) :: ref + + type (cartesian3D_t) :: corners3D(4) !x,y,z coords of element corners + integer,optional :: ref_map_in ! default is global variable 'cubed_sphere_map' + ! optional arguments, only needed for ref_map=1 (equi-angle gnomonic projection): + type (cartesian2D_t),optional :: corners(4) ! gnomonic coords of element corners + real (kind=r8),optional :: u2qmap(4,2) + integer,optional :: facenum + + + ! local + integer :: i, MAX_NR_ITER=10 + real(kind=r8) :: D(2,2),Dinv(2,2),detD,a,b,resa,resb,dela,delb,costh + real(kind=r8) :: tol_sq = 1.0e-26_r8 + type (spherical_polar_t) :: sphere1, sphere_tmp + integer :: ref_map + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! newton iteration on: ref=ref - df^-1 (ref2sphere(ref) - sphere) + ! + ! Generic version written in terms of HOMME's 'ref2sphere' and 'Dmap' operaters, + ! with no assumption as to the type of map (gnomonic, equi-angular, parametric) + ! + ! Note that the coordinate increment from newton iterations is not a direction and thus + ! should not be converted into motion along a great circle arc - this routine + ! correclty applies the increment by just adding it to the coordintes + ! + ! f = ref2sphere(xvec) - sphere + ! df = d(ref2sphere) + ! + ! D = diag(cos(theta),1) * d(ref2sphere) d(ref2sphere) = diag(1/cos(theta),1)*D + ! + ! df = diag(1/cos(theta),1)*D + ! df^-1 = D^-1 * diag(cos(theta),1) + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (present(ref_map_in)) then + ref_map=ref_map_in + else + ref_map=cubed_sphere_map + endif + costh=cos(sphere%lat) + a=0 + b=0 + i=0 + do + sphere1 = ref2sphere(a,b,corners3D,ref_map,corners,facenum) + resa = sphere1%lon - sphere%lon + if (resa > pi) resa= resa - 2*pi + if (resa < -pi) resa= resa + 2*pi + + resb = sphere1%lat - sphere%lat + + call Dmap(D,a,b,corners3D,ref_map,corners,u2qmap,facenum) + detD = D(1,1)*D(2,2) - D(1,2)*D(2,1) + Dinv(1,1) = D(2,2)/detD + Dinv(1,2) = -D(1,2)/detD + Dinv(2,1) = -D(2,1)/detD + Dinv(2,2) = D(1,1)/detD + + dela = Dinv(1,1)*costh*resa + Dinv(1,2)*resb + delb = Dinv(2,1)*costh*resa + Dinv(2,2)*resb + a = a - dela + b = b - delb + i=i+1 + if ( (costh*resa)**2 + resb**2 < tol_sq .or. MAX_NR_ITER < i) exit + end do + ref%x=a + ref%y=b + + end function parametric_coordinates + + + + +! +! find element containing given point, useing HOMME's standard +! equi-angular gnomonic map. +! note that with this map, only coordinate lines are great circle arcs +! + function point_inside_equiangular(elem, sphere, sphere_xyz) result(inside) + implicit none + type (spherical_polar_t), intent(in) :: sphere + type (cartesian3D_t), intent(in) :: sphere_xyz + type (element_t) , intent(in) :: elem + logical :: inside, inside2 + integer :: i,j + type (cartesian2D_t) :: corners(4),sphere_xy,cart + type (cartesian3D_t) :: corners_xyz(4),center,a,b,cross(4) + real (kind=r8) :: yp(4), y, elem_diam,dotprod + real (kind=r8) :: xp(4), x, xc,yc + real (kind=r8) :: tol_inside + real (kind=r8) :: d1,d2 + + type (spherical_polar_t) :: sphere_tmp + + inside = .false. + + + ! first check if point is near the element: + corners_xyz(:) = elem%corners3D(:) + elem_diam = max( distance(corners_xyz(1),corners_xyz(3)), & + distance(corners_xyz(2),corners_xyz(4)) ) + + center%x = sum(corners_xyz(1:4)%x)/4 + center%y = sum(corners_xyz(1:4)%y)/4 + center%z = sum(corners_xyz(1:4)%z)/4 + if ( distance(center,sphere_xyz) > 1.0_r8*elem_diam ) return + + tol_inside = 1.0e-10_r8*elem_diam**2 + ! the point is close to the element, so project both to cubed sphere + ! and perform contour integral + sphere_xy=sphere2cubedsphere(sphere,elem%FaceNum) + x = sphere_xy%x + y = sphere_xy%y + do i=1,4 + xp(i) = elem%corners(i)%x + yp(i) = elem%corners(i)%y + end do + + + if (debug) then + print *,'point: ',x,y,elem%FaceNum + print *,'element:' + write(*,'(a,4e16.8,a)') 'x=[',xp(1:4),']' + write(*,'(a,4e16.8,a)') 'y=[',yp(1:4),']' + + ! first check if centroid is in this element (sanity check) + sphere_tmp=change_coordinates(center) + sphere_xy=sphere2cubedsphere(sphere_tmp,elem%FaceNum) + xc=sphere_xy%x + yc=sphere_xy%y + print *,'cross product with centroid: all numbers should be negative' + j = 4 + do i=1,4 + print *,i,(xc-xp(j))*(yp(i)-yp(j)) - (yc-yp(j))*(xp(i)-xp(j)) + j = i ! within this loopk j = i-1 + end do + + print *,'cross product with search point' + j = 4 + do i=1,4 + print *,i,(x-xp(j))*(yp(i)-yp(j)) - (y-yp(j))*(xp(i)-xp(j)) + j = i ! within this loopk j = i-1 + end do + endif + + + j = 4 + do i=1,4 + ! a = x-xp(j), y-yp(j) + ! b = xp(i)-xp(j), yp(i)-yp(j) + ! compute a cross b: + if ( -( (x-xp(j))*(yp(i)-yp(j)) - (y-yp(j))*(xp(i)-xp(j))) > tol_inside ) then + return + endif + j = i ! within this loopk j = i-1 + end do + ! all cross products were negative, must be inside: + inside=.true. + end function point_inside_equiangular + + +! +! find if quad contains given point, with quad edges assumed to be great circle arcs +! this will work with any map where straight lines are mapped to great circle arcs. +! (thus it will fail on unstructured grids using the equi-angular gnomonic map) +! + function point_inside_quad(corners_xyz, sphere_xyz) result(inside) + implicit none + type (cartesian3D_t), intent(in) :: sphere_xyz + type (cartesian3D_t) , intent(in) :: corners_xyz(4) + logical :: inside, inside2 + integer :: i,j,ii + type (cartesian2D_t) :: corners(4),sphere_xy,cart + type (cartesian3D_t) :: center,a,b,cross(4) + real (kind=r8) :: yp(4), y, elem_diam,dotprod + real (kind=r8) :: xp(4), x + real (kind=r8) :: d1,d2, tol_inside = 1.0e-12_r8 + + type (spherical_polar_t) :: sphere ! debug + + inside = .false. + + ! first check if point is near the corners: + elem_diam = max( distance(corners_xyz(1),corners_xyz(3)), & + distance(corners_xyz(2),corners_xyz(4)) ) + + center%x = sum(corners_xyz(1:4)%x)/4 + center%y = sum(corners_xyz(1:4)%y)/4 + center%z = sum(corners_xyz(1:4)%z)/4 + if ( distance(center,sphere_xyz) > 1.0_r8*elem_diam ) return + + j = 4 + do i=1,4 + ! outward normal to plane containing j->i edge: corner(i) x corner(j) + ! sphere dot (corner(i) x corner(j) ) = negative if inside + cross(i)%x = corners_xyz(i)%y*corners_xyz(j)%z - corners_xyz(i)%z*corners_xyz(j)%y + cross(i)%y =-(corners_xyz(i)%x*corners_xyz(j)%z - corners_xyz(i)%z*corners_xyz(j)%x) + cross(i)%z = corners_xyz(i)%x*corners_xyz(j)%y - corners_xyz(i)%y*corners_xyz(j)%x + dotprod = cross(i)%x*sphere_xyz%x + cross(i)%y*sphere_xyz%y +& + cross(i)%z*sphere_xyz%z + j = i ! within this loopk j = i-1 + + ! dot product is proportional to elem_diam. positive means outside, + ! but allow machine precision tolorence: + if (dotprod > tol_inside*elem_diam) return + !if (dotprod > 0) return + end do + inside=.true. + return + end function point_inside_quad + +! +! find element containing given point, with element edges assumed to be great circle arcs +! this will work with any map where straight lines are mapped to great circle arcs. +! (thus it will fail on unstructured grids using the equi-angular gnomonic map) +! + function point_inside_gc(elem, sphere_xyz) result(inside) + implicit none + type (cartesian3D_t), intent(in) :: sphere_xyz + type (element_t) , intent(in) :: elem + logical :: inside, inside2 + integer :: i,j,ii + type (cartesian2D_t) :: corners(4),sphere_xy,cart + type (cartesian3D_t) :: corners_xyz(4),center,a,b,cross(4) + real (kind=r8) :: yp(4), y, elem_diam,dotprod + real (kind=r8) :: xp(4), x + real (kind=r8) :: d1,d2, tol_inside = 1.0e-12_r8 + + type (spherical_polar_t) :: sphere ! debug + + inside = .false. + + ! first check if point is near the element: + corners_xyz(:) = elem%corners3D(:) + elem_diam = max( distance(corners_xyz(1),corners_xyz(3)), & + distance(corners_xyz(2),corners_xyz(4)) ) + + center%x = sum(corners_xyz(1:4)%x)/4 + center%y = sum(corners_xyz(1:4)%y)/4 + center%z = sum(corners_xyz(1:4)%z)/4 + if ( distance(center,sphere_xyz) > 1.0_r8*elem_diam ) return + + j = 4 + do i=1,4 + ! outward normal to plane containing j->i edge: corner(i) x corner(j) + ! sphere dot (corner(i) x corner(j) ) = negative if inside + cross(i)%x = corners_xyz(i)%y*corners_xyz(j)%z - corners_xyz(i)%z*corners_xyz(j)%y + cross(i)%y =-(corners_xyz(i)%x*corners_xyz(j)%z - corners_xyz(i)%z*corners_xyz(j)%x) + cross(i)%z = corners_xyz(i)%x*corners_xyz(j)%y - corners_xyz(i)%y*corners_xyz(j)%x + dotprod = cross(i)%x*sphere_xyz%x + cross(i)%y*sphere_xyz%y +& + cross(i)%z*sphere_xyz%z + j = i ! within this loopk j = i-1 + + !if (dotprod>0 .and. dotprod/elem_diam < 1e-5) print *,dotprod/elem_diam + + ! dot product is proportional to elem_diam. positive means outside, + ! but allow machine precision tolorence: + if (dotprod > tol_inside*elem_diam) return + !if (dotprod > 0) return + end do + inside=.true. + return + end function point_inside_gc + + + !================================================ + ! (Nair) Cube face index and local coordinates + !================================================ + + subroutine cube_facepoint_ne(sphere, ne, cart, number) + use coordinate_systems_mod, only : cube_face_number_from_sphere, sphere2cubedsphere + + type(spherical_polar_t), intent(in) :: sphere + integer, intent(in) :: ne + type(cartesian2D_t), intent(out) :: cart + integer, intent(out) :: number + + real(kind=r8) :: xp, yp + type(cartesian2D_t) :: cube + integer :: ie, je, face_no + real(kind=r8) :: x1, x2 + real(kind=r8) :: dx + + face_no = cube_face_number_from_sphere(sphere) + cube = sphere2cubedsphere(sphere, face_no) + xp = cube%x + yp = cube%y + + ! MNL: for uniform grids (on cube face), analytic solution is fine + x1 = xp + 0.25_r8*PI + x2 = yp + 0.25_r8*PI + + dx = (0.5_r8*PI)/ne + ie = INT(ABS(x1)/dx) + je = INT(ABS(x2)/dx) + ! if we are exactly on an element edge, we can put the point in + ! either the ie or ie+1 element, EXCEPT if ie==ne. + if ( ABS(x1) < ne*dx ) then + ie = ie + 1 + end if + if ( ABS(x2) < ne*dx ) then + je = je + 1 + end if + if ((ie > ne) .or. (je > ne)) then + write(iulog, *) 'ERROR: ',ie,je,ne + write(iulog, *) 'lat,lon=',sphere%lat,sphere%lon + write(iulog, *) 'face no=',face_no + write(iulog, *) x1,x2,x1/dx,x2/dx + call endrun('interpolate_mod: bad argument') + endif + + ! bug fix MT 1/2009. This was creating a plotting error at + ! the row of elements in iface=2 at 50 degrees (NE=16 128x256 lat/lon grid) + ! For point on element edge, we can have ie=2, but x1=dx + ! but if ie>1, we must execute this statement. + ! The only time we can skip this statement is if ie=1, but then + ! the statement has no effect, so lets never skip it: + ! if (x1 > dx ) then + x1 = x1 - dble(ie-1)*dx + ! endif + + x1 = 2.0_r8*(x1/dx)-1.0_r8 + + ! if (x2 > dx ) then ! removed MT 1/2009, see above + x2 = x2 - dble(je-1)*dx + ! endif + + x2 = 2.0_r8*(x2/dx)-1.0_r8 + + ! coordinates within an element [-1,1] + cart%x = x1 + cart%y = x2 + number = ie + (je-1)*ne + (face_no-1)*ne*ne + end subroutine cube_facepoint_ne + !================================================ + ! (Nair) Cube face index and local coordinates + !================================================ + + + subroutine cube_facepoint_unstructured(sphere,cart, number, elem) + use coordinate_systems_mod, only : cube_face_number_from_sphere, & + sphere2cubedsphere,change_coordinates,cube_face_number_from_cart + implicit none + + type (element_t) , intent(in), target :: elem(:) + type (spherical_polar_t), intent (in) :: sphere + type (cartesian2D_t), intent(out) :: cart + integer , intent(out) :: number + + integer :: ii + Logical :: found + type (cartesian3D_t) :: sphere_xyz + type (cartesian2D_t) :: cube + sphere_xyz=spherical_to_cart(sphere) + + number=-1 +! print *,'WARNING: using GC map' + do ii = 1,nelemd + ! for equiangular gnomonic map: + ! unstructed grid element edges are NOT great circles + if (cubed_sphere_map==0) then + found = point_inside_equiangular(elem(ii), sphere, sphere_xyz) + else + ! assume element edges are great circle arcs: + found = point_inside_gc(elem(ii), sphere_xyz) + endif + + if (found) then + number = ii + cart = parametric_coordinates(sphere, elem(ii)%corners3D,& + cubed_sphere_map,elem(ii)%corners,elem(ii)%u2qmap,elem(ii)%facenum) + exit + end if + end do + end subroutine cube_facepoint_unstructured + + + subroutine interp_init() + type (quadrature_t) :: gp + + gp = gausslobatto(np) + call interpolate_create(gp,interp_p) + end subroutine interp_init + + + subroutine setup_latlon_interp(elem,interpdata,par) + ! + ! initialize interpolation data structures to interpolate to a lat-lon grid + ! + ! + + implicit none + type (element_t) , intent(in), target :: elem(:) + type (parallel_t) , intent(in) :: par + type (interpdata_t) , intent(out) :: interpdata(:) + + ! local + integer i,j,ii,count_total,n_interp,count_max + integer ngrid, number, elem_num, plat + integer countx, missing_pts,ierr + integer :: npts_mult_claims,max_claims + + real (kind=r8) :: dp,latdeg(nlat+1),clat(nlat+1),w(nlat+1),w_staggered(nlat) + real (kind=r8) :: clat_staggered(nlat),latdeg_st(nlat),err,err2 + + type (spherical_polar_t) :: sphere + type (cartesian2D_t) :: cart + type (cartesian3D_t) :: sphere_xyz,sphere2_xyz + + type (quadrature_t) :: gp + + + ! Array to make sure each interp point is on exactly one process + type (cartesian2D_t),allocatable :: cart_vec(:,:) + integer :: k + integer, allocatable :: global_elem_gid(:,:),local_elem_gid(:,:), local_elem_num(:,:) + + ! these arrays often are too large for stack, so lets make sure + ! they go on the heap: + allocate(local_elem_num(nlat,nlon)) + allocate(local_elem_gid(nlat,nlon)) + allocate(global_elem_gid(nlat,nlon)) + allocate(cart_vec(nlat,nlon)) + + if (par%masterproc) then + write(iulog,'(a,i4,a,i4,a)') 'Initializing ',nlat,' x ',nlon,' lat-lon interpolation grid: ' + endif + + do ii=1,nelemd + interpdata(ii)%n_interp=0 ! reset counter + enddo + + if (associated(lat))then + deallocate(lat) + nullify(lat) + endif + if (associated(gweight))then + deallocate(gweight) + nullify(gweight) + endif + + if (associated(lon))then + deallocate(lon) + nullify(lon) + endif + + allocate(lat(nlat)) + allocate(gweight(nlat)) + allocate(lon(nlon)) + call interp_init() + gweight=0 + do i=1,nlon + lon(i)=2*pi*(i-1)/nlon + enddo + if (gridtype==1) then + do j=1,nlat + lat(j) = -pi/2 + pi*(j-1)/(nlat-1) + end do + plat=nlat + endif + if (gridtype==2) then + gp=gauss(nlat) + do j=1,nlat + lat(j) = asin(gp%points(j)) + gweight(j) = gp%weights(j) + end do + endif + if (gridtype==3) then + do j=1,nlat + lat(j) = -pi/2 + pi*(j-.5_r8)/nlat + end do + plat=nlat+1 + endif + + if (gridtype==1 .or. gridtype==3) then + ! gridtype=1 plat=nlat gweight(1:nlat)=w(1:plat) + ! gridtype=3 plat=nlat+1 gweight(1:nlat)=w_staggered(1:plat-1) + + ! L-R dynamics uses a regular latitude distribution (not gausian). + ! The algorithm below is a bastardized version of LSM: map.F. + dp = 180.0_r8/(plat-1) + do j = 1, plat + latdeg(j) = -90.0_r8 + (j-1)*dp + clat(j) = latdeg(j)*pi/180.0_r8 + end do + + ! Calculate latitudes for the staggered grid + + do j = 1, plat-1 + clat_staggered(j) = (clat(j) + clat(j+1)) / 2 + latdeg_st (j) = clat_staggered(j)*180.0_r8/pi + end do + + ! Weights are defined as cos(phi)*(delta-phi) + ! For a sanity check, the sum of w across all lats should be 2, or 1 across + ! half of the latitudes. + + do j = 2, plat-1 + w(j) = sin(clat_staggered(j)) - sin(clat_staggered(j-1)) + end do + w(1) = sin(clat_staggered(1)) + 1 + w(plat) = w(1) + + ! with nlat=2048, this error was 4e-16 + if (abs(sum(w(1:plat)) - 2) > 1.0e-8_r8) then + write(iulog,*) 'interpolate_mod: w weights do not sum to 2. sum=',sum(w(1:plat)) + call endrun('interpolate_mod: weights do not sum to 2.') + end if + + dp = pi / (plat-1) + do j = 1, plat-1 + w_staggered(j) = sin(clat(j+1)) - sin(clat(j)) + end do + + + if (abs(sum(w_staggered(1:plat-1)) - 2) > 1.0e-8_r8) then + write(iulog,*) 'interpolate_mod: staggered weights do not sum to 2. sum=',sum(w_staggered(1:plat-1)) + call endrun('interpolate_mod: weights do not sum to 2.') + end if + + if (gridtype==1) then + gweight(1:nlat)=w(1:plat) + endif + if (gridtype==3) then + gweight(1:nlat)=w_staggered(1:plat-1) + endif + endif + + + ! go through once, counting the number of points on each element + sphere%r=1 + local_elem_num = -1 + local_elem_gid = -1 + global_elem_gid = -1 + err=0 + do j=1,nlat + do i=1,nlon + sphere%lat=lat(j) + sphere%lon=lon(i) + + number = -1 + if ( (cubed_sphere_map /= 0) .or. MeshUseMeshFile) then + call cube_facepoint_unstructured(sphere, cart, number, elem) + if (number /= -1) then + ! If points are outside element but within tolerance, move to boundary + if (cart%x + 1.0_r8.le.0.0_r8) cart%x = -1.0_r8 + if (cart%x - 1.0_r8.ge.0.0_r8) cart%x = 1.0_r8 + if (cart%y + 1.0_r8.le.0.0_r8) cart%y = -1.0_r8 + if (cart%y - 1.0_r8.ge.0.0_r8) cart%y = 1.0_r8 + + local_elem_num(j,i) = number + local_elem_gid(j,i) = elem(number)%vertex%number + cart_vec(j,i) = cart ! local element coordiante of interpolation point + endif + else + call cube_facepoint_ne(sphere, ne, cart, number) + ! the sphere point belongs to the element number on face = face_no. + ! do I own this element? + if (number /= -1) then + do ii=1,nelemd + if (number == elem(ii)%vertex%number) then + local_elem_gid(j,i) = number + local_elem_num(j,i) = ii + cart_vec(j,i) = cart ! local element coordinate found above + exit + endif + enddo + endif + endif + ii=local_elem_num(j,i) + if (ii /= -1) then + ! compute error: map 'cart' back to sphere and compare with original + ! interpolation point: + sphere2_xyz = spherical_to_cart( ref2sphere(cart%x,cart%y, & + elem(ii)%corners3D,cubed_sphere_map,elem(ii)%corners,elem(ii)%facenum )) + sphere_xyz = spherical_to_cart(sphere) + err=max(err,distance(sphere2_xyz,sphere_xyz)) + endif + enddo + if (par%masterproc) then + if ((MOD(j,64).eq.1).or.(j.eq.nlat)) then + print *,'finished latitude ',j,' of ',nlat + endif + endif + enddo + err2=err + call MPI_Allreduce(err, err2, 1, MPI_real8, MPI_MAX, par%comm, ierr) + if (par%masterproc) then + write(iulog,'(a,e12.4)') 'Max interpolation point search error: ',err2 + endif + + ! if multile elements claim a interpolation point, take the one with largest gid: + global_elem_gid = local_elem_gid + call MPI_Allreduce(local_elem_gid, global_elem_gid, nlat*nlon, MPI_integer, MPI_MAX, par%comm,ierr) + + missing_pts=0 + do j=1,nlat + do i=1,nlon + if (global_elem_gid(j,i) == -1 ) then + missing_pts = missing_pts + 1 + if (par%masterproc) & + print *,'Error: point not claimed by any element j,i,lat(j),lon(i)=',j,i,lat(j),lon(i) + else if (local_elem_gid(j,i) == global_elem_gid(j,i) ) then + ii = local_elem_num(j,i) + interpdata(ii)%n_interp = interpdata(ii)%n_interp + 1 + endif + end do + end do + + countx=maxval(interpdata(1:nelemd)%n_interp) + count_max = countx + call MPI_Allreduce(countx,count_max,1,MPI_integer,MPI_MAX,par%comm,ierr) + + if (par%masterproc) then + write(iulog,'(a,i6)') 'Maximum number of interpolation points claimed by an element: ',count_max + endif + + ! allocate storage + do ii=1,nelemd + ngrid = interpdata(ii)%n_interp + if(interpdata(ii)%first_entry)then + NULLIFY(interpdata(ii)%interp_xy) + NULLIFY(interpdata(ii)%ilat) + NULLIFY(interpdata(ii)%ilon) + + interpdata(ii)%first_entry=.FALSE. + endif + if(associated(interpdata(ii)%interp_xy))then + if(size(interpdata(ii)%interp_xy)>0)deallocate(interpdata(ii)%interp_xy) + endif + if(associated(interpdata(ii)%ilat))then + if(size(interpdata(ii)%ilat)>0)deallocate(interpdata(ii)%ilat) + endif + + if (associated(interpdata(ii)%ilon))then + if(size(interpdata(ii)%ilon)>0)deallocate(interpdata(ii)%ilon) + endif + allocate(interpdata(ii)%interp_xy( ngrid ) ) + allocate(interpdata(ii)%ilat( ngrid ) ) + allocate(interpdata(ii)%ilon( ngrid ) ) + interpdata(ii)%n_interp=0 ! reset counter + enddo + do j=1,nlat + do i=1,nlon + if (local_elem_gid(j,i) == global_elem_gid(j,i) .and. & + local_elem_gid(j,i) /= -1 ) then + ii = local_elem_num(j,i) + ngrid = interpdata(ii)%n_interp + 1 + interpdata(ii)%n_interp = ngrid + interpdata(ii)%interp_xy( ngrid ) = cart_vec(j,i) + interpdata(ii)%ilon( ngrid ) = i + interpdata(ii)%ilat( ngrid ) = j + endif + enddo + enddo + + ! now lets compute the number of points that were claimed by + ! more than one element: + do j=1,nlat + do i=1,nlon + if (local_elem_gid(j,i) == -1) then + local_elem_gid(j,i)=0 + else + local_elem_gid(j,i)=1 + endif + enddo + enddo + global_elem_gid = local_elem_gid + call MPI_Allreduce(local_elem_gid, global_elem_gid, nlat*nlon, MPI_integer, MPI_SUM, par%comm,ierr) + if (par%masterproc) then + countx=0 + do j=1,nlat + do i=1,nlon + if (global_elem_gid(j,i)>1) countx=countx+1 + enddo + enddo + npts_mult_claims=countx + max_claims=maxval(global_elem_gid) + endif + + if (par%masterproc) then + print *,'Number of interpolation points claimed by more than one element: ',npts_mult_claims + print *,'max number of elements which claimed the same interpolation point:',max_claims + endif + + deallocate(global_elem_gid) + deallocate(local_elem_num) + deallocate(local_elem_gid) + deallocate(cart_vec) + + ! check if every point in interpolation grid was claimed by an element: + if (missing_pts>0) then + count_total = nlat*nlon + if(par%masterproc) then + write(iulog,"(3A,I4,A,I7,a,i5)")"Error:",__FILE__," ",__LINE__," count_total:",count_total," missing:",missing_pts + end if + call syncmp(par) + call endrun('Error: interpolation points not claimed by any element') + endif + + + end subroutine setup_latlon_interp + + + +! interpolate_scalar +! +! Interpolate a scalar field given in an element (fld_cube) to the points in +! interpdata%interp_xy(i), i=1 .. interpdata%n_interp. +! +! Note that it is possible the given element contains none of the interpolation points +! ======================================= +subroutine interpolate_ce(cart,fld_cube,npts,fld, fillvalue) + type (cartesian2D_t) :: cart + integer :: npts + real (kind=r8) :: fld_cube(npts,npts) ! cube field + real (kind=r8) :: fld ! field at new grid lat,lon coordinates + real (kind=r8), intent(in), optional :: fillvalue + ! Local variables + type (interpolate_t), pointer :: interp ! interpolation structure + + integer :: ne + integer :: i + + if (npts==np) then + interp => interp_p + else + call endrun('Error in interpolate_scalar(): must be called with p or v grid data') + endif + + fld=interpolate_2d(cart,fld_cube,interp,npts,fillvalue) + +end subroutine interpolate_ce + + + + ! ======================================= + ! interpolate_scalar + ! + ! Interpolate a scalar field given in an element (fld_cube) to the points in + ! interpdata%interp_xy(i), i=1 .. interpdata%n_interp. + ! + ! Note that it is possible the given element contains none of the interpolation points + ! ======================================= + subroutine interpolate_scalar2d(interpdata,fld_cube,nsize,nhalo,fld, fillvalue) + use dimensions_mod, only: npsq, fv_nphys,nc + integer, intent(in) :: nsize,nhalo + real (kind=r8), intent(in) :: fld_cube(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo) ! cube field + real (kind=r8), intent(out):: fld(:) ! field at new grid lat,lon coordinates + type (interpdata_t), intent(in) :: interpdata + real (kind=r8), intent(in), optional :: fillvalue + ! Local variables + type (interpolate_t), pointer :: interp ! interpolation structure + + integer :: i,imin,imax,ne + real (kind=r8):: xoy(1-nhalo:nsize+nhalo),dx + type (cartesian2D_t) :: cart + + if (nsize==np.and.nhalo==0) then + ! + ! GLL grid + ! + interp => interp_p + xoy = interp%glp(:) + imin = 1 + imax = np + else if (nhalo>0.and.(nsize==fv_nphys.or.nsize==nc)) then + ! + ! finite-volume grid + ! + if (itype.ne.1) then + call endrun('itype must be 1 for latlon output from finite-volume (non-GLL) grids') + end if + imin = 1-nhalo + imax = nsize+nhalo + ! + ! create normalized coordinates + ! + dx = 2.0_r8/REAL(nsize,KIND=r8) + do i=imin,imax + xoy(i) = -1.0_r8+(i-0.5_r8)*dx + end do + else + call endrun('interpolate_scalar2d: resolution not supported') + endif + + ! Choice for Native (high-order) or Bilinear interpolations + if(present(fillvalue)) then + if (itype == 0) then + do i=1,interpdata%n_interp + fld(i)=interpolate_2d(interpdata%interp_xy(i),fld_cube,interp,nsize,fillvalue) + end do + elseif (itype == 1) then + do i=1,interpdata%n_interp + fld(i)=interpol_bilinear(interpdata%interp_xy(i),fld_cube,xoy,imin,imax,fillvalue) + end do + end if + else + if (itype == 0) then + do i=1,interpdata%n_interp + fld(i)=interpolate_2d(interpdata%interp_xy(i),fld_cube,interp,nsize) + end do + elseif (itype == 1) then + do i=1,interpdata%n_interp + fld(i)=interpol_bilinear(interpdata%interp_xy(i),fld_cube,xoy,imin,imax) + end do + end if + endif + + + end subroutine interpolate_scalar2d + subroutine interpolate_scalar3d(interpdata,fld_cube,nsize,nhalo,nlev,fld, fillvalue) + use dimensions_mod, only: npsq, fv_nphys,nc + integer , intent(in) :: nsize, nhalo, nlev + real (kind=r8), intent(in) :: fld_cube(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,nlev) ! cube field + real (kind=r8), intent(out) :: fld(:,:) ! field at new grid lat,lon coordinates + type (interpdata_t), intent(in) :: interpdata + real (kind=r8), intent(in), optional :: fillvalue + ! Local variables + type (interpolate_t), pointer :: interp ! interpolation structure + + integer :: ne + + integer :: i, k, imin, imax + real (kind=r8) :: xoy(1-nhalo:nsize+nhalo),dx + + type (cartesian2D_t) :: cart + + if (nsize==np.and.nhalo==0) then + ! + ! GLL grid + ! + interp => interp_p + xoy = interp%glp(:) + imin = 1 + imax = np + else if (nhalo>0.and.(nsize==fv_nphys.or.nsize==nc)) then + ! + ! finite-volume grid + ! + if (itype.ne.1) then + call endrun('itype must be 1 for latlon output from finite-volume (non-GLL) grids') + end if + imin = 1-nhalo + imax = nsize+nhalo + ! + ! create normalized coordinates + ! + dx = 2.0_r8/REAL(nsize,KIND=r8) + do i=imin,imax + xoy(i) = -1.0_r8+(i-0.5_r8)*dx + end do + else + call endrun('interpolate_scalar3d: resolution not supported') + endif + + ! Choice for Native (high-order) or Bilinear interpolations + if(present(fillvalue)) then + if (itype == 0) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k)=interpolate_2d(interpdata%interp_xy(i),fld_cube(:,:,k),interp,nsize,fillvalue) + end do + end do + elseif (itype == 1) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k)=interpol_bilinear(interpdata%interp_xy(i),fld_cube(:,:,k),xoy,imin,imax,fillvalue) + end do + end do + endif + else + if (itype == 0) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k)=interpolate_2d(interpdata%interp_xy(i),fld_cube(:,:,k),interp,nsize) + end do + end do + elseif (itype == 1) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k)=interpol_bilinear(interpdata%interp_xy(i),fld_cube(:,:,k),xoy,imin,imax) + end do + end do + else + write(iulog,*) itype + call endrun("wrong interpolation type") + endif + endif + end subroutine interpolate_scalar3d + + + ! ======================================= + ! interpolate_vector + ! + ! Interpolate a vector field given in an element (fld_cube) + ! to the points in interpdata%interp_xy(i), i=1 .. interpdata%n_interp. + ! + ! input_coords = 0 fld_cube given in lat-lon + ! input_coords = 1 fld_cube given in contravariant + ! + ! Note that it is possible the given element contains none of the interpolation points + ! ======================================= + subroutine interpolate_vector2d(interpdata,elem,fld_cube,npts,fld,input_coords, fillvalue) + implicit none + integer :: npts + real (kind=r8) :: fld_cube(npts,npts,2) ! vector field + real (kind=r8) :: fld(:,:) ! field at new grid lat,lon coordinates + type (interpdata_t) :: interpdata + type (element_t), intent(in) :: elem + real (kind=r8), intent(in), optional :: fillvalue + integer :: input_coords + + + ! Local variables + real (kind=r8) :: fld_contra(npts,npts,2) ! vector field + type (interpolate_t), pointer :: interp ! interpolation structure + + real (kind=r8) :: v1,v2 + real (kind=r8) :: D(2,2) ! derivative of gnomonic mapping + real (kind=r8) :: JJ(2,2), tmpD(2,2) ! derivative of gnomonic mapping + + integer :: i,j + + type (cartesian2D_t) :: cart + + if(present(fillvalue)) then + if (any(fld_cube==fillvalue)) then + fld = fillvalue + return + end if + end if + + if (input_coords==0 ) then + ! convert to contra + do j=1,npts + do i=1,npts + ! latlon->contra + fld_contra(i,j,1) = elem%Dinv(i,j,1,1)*fld_cube(i,j,1) + elem%Dinv(i,j,1,2)*fld_cube(i,j,2) + fld_contra(i,j,2) = elem%Dinv(i,j,2,1)*fld_cube(i,j,1) + elem%Dinv(i,j,2,2)*fld_cube(i,j,2) + enddo + enddo + else + fld_contra=fld_cube + endif + + + if (npts==np) then + interp => interp_p + else if (npts==np) then + call endrun('Error in interpolate_vector(): input must be on velocity grid') + endif + + + ! Choice for Native (high-order) or Bilinear interpolations + + if (itype == 0) then + do i=1,interpdata%n_interp + fld(i,1)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,1),interp,npts) + fld(i,2)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,2),interp,npts) + end do + elseif (itype == 1) then + do i=1,interpdata%n_interp + fld(i,1)=interpol_bilinear(interpdata%interp_xy(i),fld_contra(:,:,1),interp%glp(:),1,np) + fld(i,2)=interpol_bilinear(interpdata%interp_xy(i),fld_contra(:,:,2),interp%glp(:),1,np) + end do + else + write(iulog,*) itype + call endrun("wrong interpolation type") + endif + do i=1,interpdata%n_interp + ! convert fld from contra->latlon + call dmap(D,interpdata%interp_xy(i)%x,interpdata%interp_xy(i)%y,& + elem%corners3D,cubed_sphere_map,elem%corners,elem%u2qmap,elem%facenum) + ! convert fld from contra->latlon + v1 = fld(i,1) + v2 = fld(i,2) + + fld(i,1)=D(1,1)*v1 + D(1,2)*v2 + fld(i,2)=D(2,1)*v1 + D(2,2)*v2 + end do + + end subroutine interpolate_vector2d + + ! ======================================= + ! interpolate_vector + ! + ! Interpolate a vector field given in an element (fld_cube) + ! to the points in interpdata%interp_xy(i), i=1 .. interpdata%n_interp. + ! + ! input_coords = 0 fld_cube given in lat-lon + ! input_coords = 1 fld_cube given in contravariant + ! + ! Note that it is possible the given element contains none of the interpolation points + ! ======================================= + subroutine interpolate_vector3d(interpdata,elem,fld_cube,npts,nlev,fld,input_coords, fillvalue) + implicit none + type (interpdata_t),intent(in) :: interpdata + type (element_t), intent(in) :: elem + integer, intent(in) :: npts, nlev + real (kind=r8), intent(in) :: fld_cube(npts,npts,2,nlev) ! vector field + real (kind=r8), intent(out) :: fld(:,:,:) ! field at new grid lat,lon coordinates + real (kind=r8), intent(in),optional :: fillvalue + integer, intent(in) :: input_coords + + ! Local variables + real (kind=r8) :: fld_contra(npts,npts,2,nlev) ! vector field + type (interpolate_t), pointer :: interp ! interpolation structure + + real (kind=r8) :: v1,v2 + real (kind=r8) :: D(2,2) ! derivative of gnomonic mapping + real (kind=r8) :: JJ(2,2), tmpD(2,2) ! derivative of gnomonic mapping + + + integer :: i,j,k + + type (cartesian2D_t) :: cart + if(present(fillvalue)) then + if (any(fld_cube==fillvalue)) then + fld = fillvalue + return + end if + end if + if (input_coords==0 ) then + ! convert to contra + do k=1,nlev + do j=1,npts + do i=1,npts + ! latlon->contra + fld_contra(i,j,1,k) = elem%Dinv(i,j,1,1)*fld_cube(i,j,1,k) + elem%Dinv(i,j,1,2)*fld_cube(i,j,2,k) + fld_contra(i,j,2,k) = elem%Dinv(i,j,2,1)*fld_cube(i,j,1,k) + elem%Dinv(i,j,2,2)*fld_cube(i,j,2,k) + enddo + enddo + end do + else + fld_contra=fld_cube + endif + + if (npts==np) then + interp => interp_p + else if (npts==np) then + call endrun('Error in interpolate_vector(): input must be on velocity grid') + endif + + + ! Choice for Native (high-order) or Bilinear interpolations + + if (itype == 0) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k,1)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,1,k),interp,npts) + fld(i,k,2)=interpolate_2d(interpdata%interp_xy(i),fld_contra(:,:,2,k),interp,npts) + end do + end do + elseif (itype == 1) then + do k=1,nlev + do i=1,interpdata%n_interp + fld(i,k,1)=interpol_bilinear(interpdata%interp_xy(i),fld_contra(:,:,1,k),interp%glp(:),1,np) + fld(i,k,2)=interpol_bilinear(interpdata%interp_xy(i),fld_contra(:,:,2,k),interp%glp(:),1,np) + end do + end do + else + call endrun("wrong interpolation type") + endif + + + do i=1,interpdata%n_interp + ! compute D(:,:) at the point elem%interp_cube(i) + call dmap(D,interpdata%interp_xy(i)%x,interpdata%interp_xy(i)%y,& + elem%corners3D,cubed_sphere_map,elem%corners,elem%u2qmap,elem%facenum) + do k=1,nlev + ! convert fld from contra->latlon + v1 = fld(i,k,1) + v2 = fld(i,k,2) + + fld(i,k,1)=D(1,1)*v1 + D(1,2)*v2 + fld(i,k,2)=D(2,1)*v1 + D(2,2)*v2 + end do + end do + end subroutine interpolate_vector3d + + subroutine vec_latlon_to_contra(elem,nphys,nhalo,nlev,fld,fvm) + use fvm_control_volume_mod, only: fvm_struct + use dimensions_mod, only: fv_nphys + integer , intent(in) :: nphys,nhalo,nlev + real(kind=r8), intent(inout):: fld(1-nhalo:nphys+nhalo,1-nhalo:nphys+nhalo,2,nlev) + type (element_t), intent(in) :: elem + type(fvm_struct), intent(in), optional :: fvm + ! + ! local variables + ! + integer :: i,j,k + real(r8):: v1,v2 + + if (nhalo==0.and.nphys==np) then + do k=1,nlev + do j=1,nphys + do i=1,nphys + ! latlon->contra + v1 = fld(i,j,1,k) + v2 = fld(i,j,2,k) + fld(i,j,1,k) = elem%Dinv(i,j,1,1)*v1 + elem%Dinv(i,j,1,2)*v2 + fld(i,j,2,k) = elem%Dinv(i,j,2,1)*v1 + elem%Dinv(i,j,2,2)*v2 + enddo + enddo + end do + else if (nphys==fv_nphys.and.nhalo.le.fv_nphys) then + do k=1,nlev + do j=1-nhalo,nphys+nhalo + do i=1-nhalo,nphys+nhalo + ! latlon->contra + v1 = fld(i,j,1,k) + v2 = fld(i,j,2,k) + fld(i,j,1,k) = fvm%Dinv_physgrid(i,j,1,1)*v1 + fvm%Dinv_physgrid(i,j,1,2)*v2 + fld(i,j,2,k) = fvm%Dinv_physgrid(i,j,2,1)*v1 + fvm%Dinv_physgrid(i,j,2,2)*v2 + enddo + enddo + end do + else + call endrun('ERROR: vec_latlon_to_contra - grid not supported or halo too large') + end if + end subroutine vec_latlon_to_contra +end module interpolate_mod diff --git a/src/dynamics/se/dycore/ll_mod.F90 b/src/dynamics/se/dycore/ll_mod.F90 new file mode 100644 index 0000000000..cf445c86ff --- /dev/null +++ b/src/dynamics/se/dycore/ll_mod.F90 @@ -0,0 +1,149 @@ +module ll_mod + implicit none + private + type :: node_t + integer :: id + integer :: Src,Dest + type(node_t), pointer :: prev => NULL() + type(node_t), pointer :: next => NULL() + end type node_t + + type :: root_t + integer :: number + type(node_t), pointer :: first => NULL() + end type root_t + public :: node_t, root_t + integer, public :: NumEdges + + public :: PrintEdgeList + public :: LLAddEdge,LLFindEdge, LLInsertEdge + public :: LLSetEdgeCount,LLGetEdgeCount + public :: LLFree + +contains + + subroutine LLSetEdgeCount(value) + implicit none + integer,intent(in) :: value + NumEdges=value + end subroutine LLSetEdgeCount + + subroutine LLGetEdgeCount(value) + implicit none + integer,intent(out) :: value + value=NumEdges + end subroutine LLGetEdgeCount + + subroutine PrintEdgeList(EdgeList) + + type(root_t) :: EdgeList(:) + type(node_t), pointer :: temp_node + integer :: nlist, i + nlist = SIZE(EdgeList) + + do i=1,nlist + temp_node => EdgeList(i)%first + do while(associated(temp_node)) + print *,'Vertex: ',EdgeList(i)%number ,temp_node%Src,'->' ,temp_node%dest, '(',temp_node%id,')' + temp_node => temp_node%next + enddo + enddo + + end subroutine PrintEdgeList + + subroutine LLFree(List) + + implicit none + type(root_t) :: List + type(node_t), pointer :: temp_node + integer :: nlist,i + + + temp_node => List%first + if (associated(temp_node)) then + ! Find the end of the list + do while(associated(temp_node%next)) + temp_node => temp_node%next + end do + + temp_node => temp_node%prev + !Now step back and deallocate all entries + do while(associated(temp_node)) + deallocate(temp_node%next) + temp_node => temp_node%prev + end do + end if + + end subroutine LLFree + + subroutine LLInsertEdge(EdgeList,src,dest,eNum) + type (root_t), intent(inout) :: EdgeList + integer, intent(in) :: src,dest + integer, intent(out) :: eNum + logical :: found + + call LLFindEdge(EdgeList,src,dest,eNum,found) + if(.not. found) then + call LLAddEdge(EdgeList,src,dest,eNum) + endif + + end subroutine LLInsertEdge + + subroutine LLFindEdge(Edge,src,dest,id,found) + + type (root_t), intent(in) :: Edge + integer, intent(in) :: src,dest + integer, intent(out) :: id + logical, intent(out) :: found + + type (node_t), pointer :: temp_node + + found =.FALSE. + + temp_node => Edge%first + do while(associated(temp_node) .and. (.not. found)) + if((dest .eq. temp_node%dest) .and. (src .eq. temp_node%Src) ) then + found = .TRUE. + id=temp_node%id + else + temp_node => temp_node%next + endif + enddo + end subroutine LLFindEdge + + subroutine LLAddEdge(EdgeList,src,dest,id) + type (root_t), intent(inout) :: EdgeList + integer, intent(in) :: src + integer, intent(in) :: dest + integer, intent(out) :: id + + type(node_t), pointer :: temp_node + type(node_t), pointer :: new_node + type(node_t), pointer :: parent + + temp_node => EdgeList%first + parent => EdgeList%first + + do while(associated(temp_node)) + parent => temp_node + temp_node => parent%next + enddo + allocate(new_node) + NumEdges = NumEdges + 1 + + new_node%src=src + new_node%dest=dest + new_node%id=NumEdges + NULLIFY(new_node%next) + new_node%prev => parent + + if(associated(EdgeList%first)) then + parent%next => new_node + else + EdgeList%first => new_node + endif + id = NumEdges + + end subroutine LLAddEdge + +end module ll_mod diff --git a/src/dynamics/se/dycore/mass_matrix_mod.F90 b/src/dynamics/se/dycore/mass_matrix_mod.F90 new file mode 100644 index 0000000000..a59f1cc15d --- /dev/null +++ b/src/dynamics/se/dycore/mass_matrix_mod.F90 @@ -0,0 +1,120 @@ +module mass_matrix_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: np, nelemd + use quadrature_mod, only: quadrature_t, gauss ,gausslobatto + use element_mod, only: element_t + use parallel_mod, only: parallel_t + use edge_mod, only: edgevpack, edgevunpack, & + freeedgebuffer,initedgebuffer + use edgetype_mod, only: edgebuffer_t + use bndry_mod, only: bndry_exchange + +implicit none +private + + public :: mass_matrix + +contains + +! =========================================== +! mass_matrix: +! +! Compute the mass matrix for each element... +! =========================================== + + subroutine mass_matrix(par,elem) + + type (parallel_t),intent(in) :: par + type (element_t) :: elem(:) + + type (EdgeBuffer_t) :: edge + + real(kind=r8) da ! area element + + type (quadrature_t) :: gp + + integer ii + integer i,j + integer kptr + integer iptr + + ! =================== + ! begin code + ! =================== + + call initEdgeBuffer(par,edge,elem,1,nthreads=1) + + ! ================================================= + ! mass matrix on the velocity grid + ! ================================================= + + gp=gausslobatto(np) + + do ii=1,nelemd + do j=1,np + do i=1,np + ! MNL: metric term for map to reference element is now in metdet! + elem(ii)%mp(i,j)=gp%weights(i)*gp%weights(j) + elem(ii)%rmp(i,j)=elem(ii)%mp(i,j) + end do + end do + + kptr=0 + call edgeVpack(edge,elem(ii)%rmp,1,kptr,ii) + + end do + + ! ============================== + ! Insert boundary exchange here + ! ============================== + + call bndry_exchange(par,edge,location='mass_matrix #1') + + do ii=1,nelemd + + kptr=0 + call edgeVunpack(edge,elem(ii)%rmp,1,kptr,ii) + + do j=1,np + do i=1,np + elem(ii)%rmp(i,j)=1.0_r8/elem(ii)%rmp(i,j) + end do + end do + + end do +!$OMP BARRIER + + deallocate(gp%points) + deallocate(gp%weights) + + ! ============================================= + ! compute spherical element mass matrix + ! ============================================= + do ii=1,nelemd + do j=1,np + do i=1,np + elem(ii)%spheremp(i,j)=elem(ii)%mp(i,j)*elem(ii)%metdet(i,j) + elem(ii)%rspheremp(i,j)=elem(ii)%spheremp(i,j) + end do + end do + kptr=0 + call edgeVpack(edge,elem(ii)%rspheremp,1,kptr,ii) + end do + call bndry_exchange(par,edge,location='mass_matrix #2') + do ii=1,nelemd + kptr=0 + call edgeVunpack(edge,elem(ii)%rspheremp,1,kptr,ii) + do j=1,np + do i=1,np + elem(ii)%rspheremp(i,j)=1.0_r8/elem(ii)%rspheremp(i,j) + end do + end do + end do +!$OMP BARRIER + + call FreeEdgeBuffer(edge) + + end subroutine mass_matrix + +end module mass_matrix_mod + diff --git a/src/dynamics/se/dycore/mesh_mod.F90 b/src/dynamics/se/dycore/mesh_mod.F90 new file mode 100644 index 0000000000..c5e2286853 --- /dev/null +++ b/src/dynamics/se/dycore/mesh_mod.F90 @@ -0,0 +1,1289 @@ +module mesh_mod + + use shr_kind_mod, only: r8=>shr_kind_r8 + use physconst, only: PI + use control_mod, only: MAX_FILE_LEN + use cam_abortutils, only: endrun + + use netcdf, only: nf90_strerror, nf90_open, nf90_close + use netcdf, only: NF90_NOWRITE, nf90_NoErr + use netcdf, only: nf90_inq_dimid, nf90_inquire_dimension + use netcdf, only: nf90_inq_varid, nf90_get_var + + implicit none + logical, public :: MeshUseMeshFile = .false. + + public :: MeshOpen ! Must be called first + + integer, parameter :: MXSTLN = 32 + + ! =============================== + ! Public methods for mesh_mod + ! =============================== + + public :: MeshCubeEdgeCount ! called anytime afer MeshOpen + public :: MeshCubeElemCount ! called anytime afer MeshOpen + public :: MeshCubeTopology ! called afer MeshOpen + public :: MeshSetCoordinates ! called after MeshCubeTopology + public :: MeshPrint ! show the contents of the Mesh after it has been loaded into the module + public :: MeshClose + ! =============================== + ! Private members + ! =============================== + + integer,private,parameter :: nfaces = 6 ! number of faces on the cube + integer,private,parameter :: nInnerElemEdge = 8 ! number of edges for an interior element + + character (len=MAX_FILE_LEN), private :: p_mesh_file_name + integer , private :: p_ncid + integer , private :: p_number_elements + integer , private :: p_number_elements_per_face + integer , private :: p_number_blocks + integer , private :: p_number_nodes + integer , private :: p_number_dimensions + integer , private :: p_number_neighbor_edges + real(kind=r8) , private, allocatable :: p_node_coordinates(:,:) + integer , private, allocatable :: p_connectivity(:,:) + + ! =============================== + ! Private methods + ! =============================== + + private :: create_index_table + private :: find_side_neighbors + private :: find_corner_neighbors + private :: get_node_coordinates + private :: get_2D_sub_coordinate_indexes + private :: mesh_connectivity + private :: cube_face_element_centroids + private :: smallest_diameter_element + private :: cube_to_cube_coordinates + private :: sphere_to_cube_coordinates + private :: initialize_space_filling_curve + + private :: handle_error + private :: open_mesh_file + private :: close_mesh_file + private :: get_number_of_elements + private :: get_number_of_dimensions + private :: get_number_of_elements_per_face + private :: get_number_of_nodes + private :: get_number_of_element_blocks + private :: get_node_multiplicity + private :: get_face_connectivity + +CONTAINS + +!====================================================================== +! subroutine handle_error +!====================================================================== + subroutine handle_error (status, file, line) + + integer, intent(in) :: status + character (len=*), intent(in) :: file + integer, intent(in) :: line + print *, file,':', line, ': ', trim(nf90_strerror(status)) + call endrun("Terminating program due to netcdf error while obtaining mesh information, please see message in standard output.") + end subroutine handle_error + +!====================================================================== +! open_mesh_file() +! +!> Open the netcdf file containing the mesh. +!! Assign the holder to the file to p_ncid so everyone else knows +!! how to use it without passing the argument around. +!====================================================================== + subroutine open_mesh_file() + implicit none + integer :: status + + status = nf90_open(p_mesh_file_name, NF90_NOWRITE, p_ncid) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + MeshUseMeshFile = .true. + + end subroutine open_mesh_file + +!====================================================================== +! subroutine close_mesh_file() +!====================================================================== + + subroutine close_mesh_file() + implicit none + integer :: status + + status = nf90_close(p_ncid) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + end subroutine close_mesh_file + +!====================================================================== +! function get_number_of_dimensions() +!====================================================================== + + function get_number_of_dimensions() result(number_dimensions) + implicit none + integer :: number_dimensions + + ! local variables + integer :: status, number_of_dim_id + + ! Get the id of 'num_elem', if such dimension is not there panic and quit :P + status = nf90_inq_dimid(p_ncid, "num_dim", number_of_dim_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + ! How many values for 'num_elem' are there? + status = nf90_inquire_dimension(p_ncid, number_of_dim_id, len = number_dimensions) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + end function get_number_of_dimensions + +!====================================================================== +! function get_number_of_elements() +!====================================================================== + + function get_number_of_elements() result(number_elements) + implicit none + integer :: number_elements + ! local variables + integer :: status, number_of_elements_id + + ! Get the id of 'num_elem', if such dimension is not there panic and quit :P + status = nf90_inq_dimid(p_ncid, "num_elem", number_of_elements_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + ! How many values for 'num_elem' are there? + status = nf90_inquire_dimension(p_ncid, number_of_elements_id, len = number_elements) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + end function get_number_of_elements + +!====================================================================== +! function get_number_of_nodes() +!====================================================================== + function get_number_of_nodes() result(number_nodes) + implicit none + integer :: number_nodes + ! local variables + integer :: status, number_of_nodes_id + + ! Get the id of 'num_nodes', if such dimension is not there panic and quit :P + status = nf90_inq_dimid(p_ncid, "num_nodes", number_of_nodes_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + ! How many values for 'num_nodes' are there? + status = nf90_inquire_dimension(p_ncid, number_of_nodes_id, len = number_nodes) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + end function get_number_of_nodes + + +!====================================================================== +! function get_number_of_element_blocks() +!====================================================================== + function get_number_of_element_blocks() result(number_element_blocks) + + integer :: number_element_blocks + ! local variables + integer :: status, number_of_element_blocks_id + + ! Get the id of 'num_el_blk', if such dimension is not there panic and quit :P + status = nf90_inq_dimid(p_ncid, "num_el_blk", number_of_element_blocks_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + ! How many values for 'num_el_blk' are there? + status = nf90_inquire_dimension(p_ncid, number_of_element_blocks_id, len = number_element_blocks) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + + if (number_element_blocks /= 1) then + if (number_element_blocks /= 6 ) then + call endrun('Reading cube-sphere from input file is not supported') + else + call endrun('Number of elements blocks not exactly 1 (sphere) or 6 (cube)') + endif + endif + + end function get_number_of_element_blocks + +!====================================================================== +! function get_number_of_elements_per_face() +!====================================================================== + function get_number_of_elements_per_face() result(number_elements_per_face) + + integer :: number_elements_per_face + + integer :: face_num ! For each of the face, we get the information + character(len=MXSTLN) :: element_type ! Each face is composed of elements of certain type + integer :: number_elements_in_face ! How many elements in this face + integer :: num_nodes_per_elem ! How many nodes in each element + integer :: number_of_attributes ! How many attributes in the face + + integer :: status, dimension_id + + if (p_number_blocks == 0) then + call endrun('get_number_of_elements_per_face called before MeshOpen') + else if (p_number_blocks == 1) then ! we are in the presence of a sphere + ! First we get sure the number of nodes per element is four + status = nf90_inq_dimid(p_ncid, "num_nod_per_el1", dimension_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + status = nf90_inquire_dimension(p_ncid, dimension_id, len = num_nodes_per_elem) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + if (num_nodes_per_elem /= 4) call endrun('Number of nodes per element is not four') + ! now we check how many elements there are in the face + status = nf90_inq_dimid(p_ncid, "num_el_in_blk1", dimension_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + status = nf90_inquire_dimension(p_ncid, dimension_id, len = number_elements_in_face) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + number_elements_per_face = number_elements_in_face + else if (p_number_blocks == 6) then ! we are in the presence of a cube-sphere + call endrun('Reading a mesh for a cube-sphere is not supported') + else + call endrun('Number of elements blocks not exactly 1 (sphere) or 6 (cube)') + end if + + end function get_number_of_elements_per_face + +!====================================================================== +! subroutine get_face_connectivity +!====================================================================== + subroutine get_face_connectivity() + + integer :: var_id, status + + status = nf90_inq_varid(p_ncid, "connect1", var_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + status = nf90_get_var(p_ncid, var_id, p_connectivity) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + end subroutine get_face_connectivity + +!====================================================================== +! subroutine get_node_multiplicity +!====================================================================== + subroutine get_node_multiplicity(node_multiplicity) + use dimensions_mod, only : max_elements_attached_to_node + + integer, intent(out) :: node_multiplicity(:) + integer :: node_num(4) + + integer :: k, number_nodes + + node_multiplicity(:) = 0 + number_nodes = SIZE(node_multiplicity) + ! check this external buffer was allocated correctly + if (number_nodes /= p_number_nodes) call endrun('Number of nodes does not matches size of node multiplicity array') + ! for each node, we have for four other nodes + + if (minval(p_connectivity) < 1 .or. number_nodes < maxval(p_connectivity)) then + call endrun('get_node_multiplicity: Node number less than 1 or greater than max.') + end if + + do k=1,p_number_elements_per_face + node_num = p_connectivity(:,k) + node_multiplicity(node_num) = node_multiplicity(node_num) + 1 + enddo + + if (minval(node_multiplicity) < 3 .or. max_elements_attached_to_node < maxval(node_multiplicity)) then + print *, 'minval(node_multiplicity)', minval(node_multiplicity) + print *, 'maxval(node_multiplicity)', maxval(node_multiplicity),& + ' and max_elements_attached_to_node ',max_elements_attached_to_node + call endrun('get_node_multiplicity: Number of elements attached to node less than 3 or greater than maximum.') + endif + + end subroutine get_node_multiplicity + +!====================================================================== +! subroutine get_node_coordinates () +!====================================================================== + subroutine get_node_coordinates () + + integer :: var_id, status + + status = nf90_inq_varid(p_ncid, "coord", var_id) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + status = nf90_get_var(p_ncid, var_id, p_node_coordinates) + if(status /= nf90_NoErr) call handle_error(status, __FILE__, __LINE__) + end subroutine get_node_coordinates + + ! ================================================================================ + ! + ! -----------------Internal private routines that do not use netCDF IO ----------- + ! + ! ================================================================================ + +!====================================================================== +! subroutine get_2D_sub_coordinate_indexes +!====================================================================== + subroutine get_2D_sub_coordinate_indexes(x, y, sgnx, sgny, face_no) + implicit none + integer, intent(in) :: face_no + integer, intent(out) :: x,y + integer, intent(out) :: sgnx, sgny + if (face_no == 1 .or. face_no == 3) then + x = 2 + y = 3 + else if (face_no == 2 .or. face_no == 4) then + x = 1 + y = 3 + else + x = 2 + y = 1 + endif + if (face_no == 1 .or. face_no == 4 .or. face_no == 5) then + sgnx = 1 + sgny = 1 + else if (face_no == 2 .or. face_no == 3) then + sgnx = -1 + sgny = 1 + else + sgnx = 1 + sgny = -1 + endif + end subroutine get_2D_sub_coordinate_indexes + + + +!====================================================================== +! subroutine mesh_connectivity(connect) +! +! puts the transpose of p_connectivity into connect +!====================================================================== + + subroutine mesh_connectivity (connect) + + integer, intent(out) :: connect(p_number_elements,4) + + integer :: k, j + + if (0 == p_number_blocks) call endrun('mesh_connectivity called before MeshOpen') + j=0 + do k=1, p_number_elements_per_face + j=j+1 + connect(j,:) = p_connectivity(:,k) + enddo + + if (j /= p_number_elements) call endrun('mesh_connectivity: Number of elements in side sets not equal to total elements') + + if (minval(connect) < 1 .or. maxval(connect) > p_number_nodes) then + call endrun('mesh_connectivity: Node number out of bounds') + end if + + end subroutine mesh_connectivity +!====================================================================== +! subroutine create_index_table() +! +! this is needed to detremine side and corner neighbors +!====================================================================== + + subroutine create_index_table(index_table, element_nodes) + use dimensions_mod, only : max_elements_attached_to_node + + integer, allocatable, intent(inout) :: index_table(:,:) + integer , intent(in) :: element_nodes(p_number_elements, 4) + integer :: cnt, cnt_index, node + integer :: k, ll + + !Create an index table so that we can find neighbors on O(n) + ! so for each node, we want to know which elements it is part of + allocate(index_table(p_number_nodes, max_elements_attached_to_node + 1)) + + !the last column in the index table is a count of the number of elements + index_table = 0 + + cnt_index = max_elements_attached_to_node + 1 + + do k=1,p_number_elements + do ll=1,4 + node = element_nodes(k, ll) !the node + cnt = index_table(node, cnt_index) !how many elements for that node already in table + cnt = cnt + 1 !increment since we are adding an element + if (cnt > max_elements_attached_to_node) then + call endrun('Found a node in too many elements.') + endif + index_table(node, cnt_index) = cnt + index_table(node, cnt) = k !put the element in the indextable + enddo + enddo + + end subroutine create_index_table + +!====================================================================== +! subroutine find_side_neighbors() +! +! find the element neighbors to the n,s,e,w and put them in GridVertex_t +! (only 1 neighbor to the n,s,e,w) +!====================================================================== + subroutine find_side_neighbors (GridVertex, normal_to_homme_ordering, element_nodes, edge_wgt, index_table) + use coordinate_systems_mod, only : cartesian3D_t + use gridgraph_mod, only : GridVertex_t + use dimensions_mod, only : max_elements_attached_to_node + + integer , intent(in) :: normal_to_homme_ordering(8) + integer , intent(in) :: element_nodes(p_number_elements, 4) + integer , intent(in) :: edge_wgt + integer , intent(in) :: index_table(:,:) + type (GridVertex_t) , intent(inout) :: GridVertex(:) + + integer :: i_node(2), my_node(2) + integer :: neighbor, direction + integer :: j,k,ll,i, m + integer :: i_elem, jump, end_i + integer :: loc, cnt_index, a_count(2) + logical :: found + if (0 == p_number_blocks) call endrun('find_side_neighbors called before MeshOpen') + + + !the last column in the index table is a count of the number of elements + cnt_index = max_elements_attached_to_node + 1 + + !use index table to find neighbors + do k=1,p_number_elements ! for each element k + !set the side weights + GridVertex(k)%nbrs_wgt(1:4) = edge_wgt + do ll=1,4 !loop through the four sides + + jump = normal_to_homme_ordering(ll) + loc = GridVertex(k)%nbrs_ptr(jump) + + if (GridVertex(k)%nbrs(loc) == 0) then !if side is not set yet, then + !look for side element + found = .false. + neighbor = 0 + + my_node(1) = element_nodes(k, ll) + a_count(1) = index_table(my_node(1), cnt_index) + my_node(2) = element_nodes(k, mod(ll,4)+1) + a_count(2) = index_table(my_node(2), cnt_index) + + !loop through the elements that are in the index table for each node + !and find the element number and direction of the side neighbor + do m = 1,2 + if (found) exit + end_i = a_count(m) + do i = 1, end_i + if (found) exit + i_elem = index_table(my_node(m),i) + if (i_elem /= k) then !k is the element we are setting sides for + do j=1,4 !loop through each of i_elem's four sides + i_node(1) = element_nodes(i_elem, j) + i_node(2) = element_nodes(i_elem, mod(j,4)+1) + if ( (i_node(1) == my_node(2) .and. i_node(2) == my_node(1)) .or. & + (i_node(1) == my_node(1) .and. i_node(2) == my_node(2)) ) then + neighbor = i_elem + direction = j + found = .true. + !found a match + exit + end if + end do ! j loop + end if + enddo ! i loop + enddo !m loop + + if (neighbor == 0) call endrun('find_side_neighbor: Neighbor not found! Every side should have a neighbor.') + + GridVertex(k)%nbrs(loc) = neighbor + jump = normal_to_homme_ordering(direction) + loc = GridVertex(neighbor)%nbrs_ptr(jump) + GridVertex(neighbor)%nbrs(loc)= k + endif + enddo ! ll loop => 4 sides + enddo ! k loop: each element + + do k=1,p_number_elements + do ll=1,4 + if ( 0 == GridVertex(k)%nbrs(ll)) then + call endrun('Found one side of one element witout a neighbor. Bummer!') + end if + end do + end do + + end subroutine find_side_neighbors + +!====================================================================== +! function smallest_diameter_element +!====================================================================== + + function smallest_diameter_element(element_nodes) result(min_diameter) + + integer ,intent(in) :: element_nodes(:,:) + + integer :: i, j + integer :: node_numbers(4) + real(kind=r8) :: coordinates (4,3) + real(kind=r8) :: x(3), y(3), r(3), d, min_diameter + + if (SIZE(element_nodes,dim=1) /= p_number_elements) then + call endrun('smallest_diameter_element:Element count check failed in & + &exodus_mesh. Connectivity array length not equal to number of elements.') + end if + if ( p_number_elements_per_face /= p_number_elements) then + call endrun('smallest_diameter_element: Element count check failed in & + &exodus_mesh. Element array length not equal to sum of face.') + end if + + min_diameter = 9999999.0_r8 + do i=1, p_number_elements + node_numbers = element_nodes(i,:) + coordinates = p_node_coordinates(node_numbers,:) + ! smallest side length + do j=1,4 + x = coordinates(j ,:) + y = coordinates(1+MOD(j,4),:) + r = x-y + d = dot_product(r,r) + if (d < min_diameter ) then + min_diameter = d + end if + end do + ! smallest diameter length + do j=1,2 + x = coordinates(j ,:) + y = coordinates(2+MOD(j,4),:) + r = x-y + d = dot_product(r,r) + if (d < min_diameter ) then + min_diameter = d + end if + end do + enddo + min_diameter = SQRT(min_diameter) + end function smallest_diameter_element + +!====================================================================== +! subroutine cube_to_cube_coordinates +!====================================================================== + + subroutine cube_to_cube_coordinates (cube_coor, node_coor, face_number) + + real(kind=r8), intent(in) :: node_coor(4,3) + integer, intent(in) :: face_number + real(kind=r8), intent(out) :: cube_coor(4,2) + + integer :: x_index, y_index, sgnx, sgny + call get_2D_sub_coordinate_indexes(x_index, y_index, sgnx, sgny, face_number) + cube_coor(:,1) = sgnx*node_coor(:,x_index) + cube_coor(:,2) = sgny*node_coor(:,y_index) + end subroutine cube_to_cube_coordinates + + +!====================================================================== +! subroutine sphere_to_cube_coordinates +!====================================================================== + + subroutine sphere_to_cube_coordinates (cube_coor, node_coor, face_number) + use coordinate_systems_mod, only : cartesian2d_t, change_coordinates, sphere2cubedsphere + implicit none + real(kind=r8), intent(in) :: node_coor(4,3) + integer, intent(in) :: face_number + real(kind=r8), intent(out) :: cube_coor(4,2) + integer :: i + type(cartesian2d_t) :: cart(4) + + do i=1,4 + cart(i) = sphere2cubedsphere(change_coordinates(node_coor(i,:)), face_number) + end do + cube_coor(:,1) = cart(:)%x + cube_coor(:,2) = cart(:)%y + end subroutine sphere_to_cube_coordinates + + +!====================================================================== +! subroutine cube_face_element_centroids +!====================================================================== + + subroutine cube_face_element_centroids(centroids, face_numbers, element_nodes) + + integer , intent(in) :: element_nodes(:,:) + integer, intent(in) :: face_numbers (p_number_elements) + real(kind=r8),intent(out) :: centroids (p_number_elements,2) + real(kind=r8) :: coordinates(4,3) + real(kind=r8) :: cube_coor (4,2) + integer :: i, node_numbers(4) + + if (0 == p_number_blocks) call endrun('cube_face_element_centroids called before MeshOpen') + if (SIZE(element_nodes,dim=1) /= p_number_elements) then + call endrun('cube_face_element_centroids:Element count check failed in & + &exodus_mesh. Connectivity array length not equal to number of elements.') + end if + if ( p_number_elements_per_face /= p_number_elements ) then + call endrun('cube_face_element_centroids: Element count check failed in & + &exodus_mesh. Element array length not equal to sum of face.') + end if + + do i=1, p_number_elements + node_numbers = element_nodes(i,:) + coordinates = p_node_coordinates(node_numbers,:) + if (6 == p_number_blocks) then + call cube_to_cube_coordinates (cube_coor, coordinates, face_numbers(i)) + else + call sphere_to_cube_coordinates (cube_coor, coordinates, face_numbers(i)) + end if + centroids(i,:) = SUM(cube_coor,dim=1)/4.0_r8 + enddo + end subroutine cube_face_element_centroids + +!====================================================================== +! subroutine initialize_space_filling_curve +!====================================================================== + subroutine initialize_space_filling_curve(GridVertex, element_nodes) + use gridgraph_mod, only : GridVertex_t + use spacecurve_mod, only : GenspaceCurve + + type (GridVertex_t), intent(inout) :: GridVertex(:) + integer , intent(in) :: element_nodes(:,:) + + integer,allocatable :: Mesh2(:,:),Mesh2_map(:,:),sfcij(:,:) + + real(kind=r8) :: centroids(p_number_elements,2) + integer :: face_numbers(p_number_elements) + real(kind=r8) :: x, y, h + integer :: i, j, i2, j2, ne, ne2 + integer :: sfc_index, face + + if (SIZE(GridVertex) /= p_number_elements) then + call endrun('initialize_space_filling_curve:Element count check failed & + &in exodus_mesh. Vertex array length not equal to number of elements.') + end if + if (SIZE(element_nodes,dim=1) /= p_number_elements) then + call endrun('initialize_space_filling_curve:Element count check failed & + &in exodus_mesh. Connectivity array length not equal to number of elements.') + end if + + face_numbers(:) = GridVertex(:)%face_number + h = smallest_diameter_element ( element_nodes) + + call cube_face_element_centroids (centroids, face_numbers, element_nodes) + + if (h<.00001_r8) then + call endrun('initialize_space_filling_curve: Unreasonably small element found. less than .00001') + end if + + ne = CEILING(0.5_r8*PI/(h/2)); + + ! find the smallest ne2 which is a power of 2 and ne2>ne + ne2=2**ceiling( log(real(ne))/log(2._r8) ) + if (ne2 Mesh in Mesh2_map. + ! elements in Mesh2 which are not mapped get assigned a value of 0 + Mesh2_map=0 + do i=1,p_number_elements + if (face_numbers(i) == face ) then + x = centroids(i,1) + y = centroids(i,2) + ! map this element to an (i2,j2) element + ! [ -PI/4, PI/4 ] -> [ 0, ne2 ] + i2=nint( (0.5_r8 + 2.0_r8*x/PI)*ne2 + 0.5_r8 ) + j2=nint( (0.5_r8 + 2.0_r8*y/PI)*ne2 + 0.5_r8 ) + if (face == 4 .or. face == 6 ) i2 = ne2-i2+1 + if (face == 1 .or. face == 2 .or. face == 6) j2 = ne2-j2+1 + if (i2<1 ) i2=1 + if (i2>ne2) i2=ne2 + if (j2<1 ) j2=1 + if (j2>ne2) j2=ne2 + Mesh2_map(i2,j2)=i + end if + end do + + ! generate a SFC for Mesh with the same ordering as the + ! elements in Mesh2 which map to Mesh. + do j=0,ne2*ne2-1 + i2=sfcij(j,1) + j2=sfcij(j,2) + i=Mesh2_map(i2,j2) + if (i/=0) then + ! (i2,j2) element maps to element + GridVertex(i)%SpaceCurve=sfc_index + sfc_index=sfc_index+1 + endif + enddo + enddo + deallocate(Mesh2) + deallocate(Mesh2_map) + deallocate(sfcij) + + if (minval(GridVertex(:)%SpaceCurve) == -1) then + do i=1,p_number_elements + if (-1==GridVertex(i)%SpaceCurve) then + write (*,*) " Error in projecting element ",i," to space filling curve." + write (*,*) " Face:",face_numbers(i) + write (*,*) " Centroid:",centroids(i,:) + end if + end do + call endrun('initialize_space_filling_curve: Vertex not on SpaceCurve') + end if + + end subroutine initialize_space_filling_curve + +!====================================================================== +! subroutine find_corner_neighbors +!====================================================================== + + subroutine find_corner_neighbors (GridVertex, normal_to_homme_ordering, element_nodes, corner_wgt, index_table) + use gridgraph_mod, only : GridVertex_t + use dimensions_mod, only : max_elements_attached_to_node, max_corner_elem + use control_mod, only: north, south, east, west, neast,seast, nwest,swest + + type (GridVertex_t), intent(inout) :: GridVertex(:) + integer , intent(in) :: normal_to_homme_ordering(8) + integer , intent(in) :: element_nodes(p_number_elements, 4) + integer , intent(in) :: corner_wgt + integer , intent(in) :: index_table(:,:) + + integer :: node_elements (2*max_elements_attached_to_node) + integer :: elem_neighbor (4*max_elements_attached_to_node) + integer :: nbr_cnt(4) + integer :: elem_nbr_start, start + integer :: i, j, k, ll, jj, kk + integer :: node, loc, cnt, cnt_index + integer :: corner_array(max_corner_elem), orig_pos(max_corner_elem) + integer :: face_array(max_corner_elem), a_corner_elems(max_corner_elem) + integer :: corner_sides(2) + integer :: side_elem, corner_elem, tmp_s + + !the last column in the index table is a count of the number of elements + cnt_index = max_elements_attached_to_node + 1 + + do i=1, p_number_elements !loop through all elements + node_elements(:) = 0 + elem_neighbor(:) = 0 + elem_nbr_start = 0 + nbr_cnt(:) = 0 + + do j=1,4 !check each of the 4 nodes at the element corners + node = element_nodes(i,j) + cnt = index_table(node, cnt_index) + if (cnt < 3 .or. max_elements_attached_to_node < cnt) then + call endrun('find_corner_neighbors: Number of elements attached to node less than 3 or greater than maximum.') + endif + + node_elements(1:cnt) = index_table(node, 1:cnt) + + !now node_elements contains the element neighbors to that node - so grab the + ! corner neighbors - these are the ones that are not already side neighbors (or myself) + k = 0 + do ll=1,cnt + if ( i /= node_elements(ll) .and. & !not me + GridVertex(i)%nbrs(1) /= node_elements(ll) .and. & !not side 1 + GridVertex(i)%nbrs(2) /= node_elements(ll) .and. & ! etc ... + GridVertex(i)%nbrs(3) /= node_elements(ll) .and. & + GridVertex(i)%nbrs(4) /= node_elements(ll)) then + k = k + 1 + elem_neighbor(elem_nbr_start + k) = node_elements(ll) + end if + end do ! end of ll loop for multiplicity + + !keep track of where we are starting in elem_neighbor for each corner j + elem_nbr_start = elem_nbr_start + k + nbr_cnt(j) = k !how many neighbors in this corner + end do ! end of j loop through 4 nodes + + + ! now that we have done the 4 corners we can populate nbrs and nbrs_ptr + ! with the corners in the proper order (clockwise) in neighbors + ! also we can add the corner weight + + do j=5,8 !loop through 4 corners + elem_nbr_start = 1 + !easiest to do the corner in ascending order - find loc + do jj = 5,8 + ll = normal_to_homme_ordering(jj) + if (j == ll) then + loc = jj + exit + end if + elem_nbr_start = elem_nbr_start + nbr_cnt(jj-4) + end do + + start = GridVertex(i)%nbrs_ptr(j) + cnt = nbr_cnt(loc - 4) + GridVertex(i)%nbrs_ptr(j+1) = start + cnt + + if (cnt > 0) then + GridVertex(i)%nbrs(start : start + cnt-1) = & + elem_neighbor(elem_nbr_start : elem_nbr_start + cnt -1) + GridVertex(i)%nbrs_face(start : start + cnt - 1) = & + GridVertex(elem_neighbor(elem_nbr_start : elem_nbr_start + cnt -1))%face_number + GridVertex(i)%nbrs_wgt(start : start + cnt-1) = corner_wgt + + end if + + ! within each corner neighbor, lets list the corners in clockwise order + if (cnt > 1) then !cnt is the number of neighbors in this corner j + !there can be at most max_corner element of these + + a_corner_elems = 0 + a_corner_elems(1:cnt) = elem_neighbor(elem_nbr_start : elem_nbr_start + cnt -1) + !corner-sides(2) is clockwise of corner_side(1) + corner_array= 0 + orig_pos = 0 + select case (j) + case(neast) + corner_sides(1) = north + corner_sides(2) = east + case(seast) + corner_sides(1) = east + corner_sides(2) = south + case(swest) + corner_sides(1) = south + corner_sides(2) = west + case(nwest) + corner_sides(1) = west + corner_sides(2) = north + end select + + !so the first element to list touches corner_sides(1) element + side_elem = GridVertex(i)%nbrs(corner_sides(1)) + + !loop though the corner elements and see if any have a side neighbor + !that = side_elem + do k = 1,cnt !number of corner elements + corner_elem = a_corner_elems(k) + do kk = 1,4 !number of sides to check + loc = GridVertex(corner_elem)%nbrs_ptr(kk) + tmp_s = GridVertex(corner_elem)%nbrs(loc) + if (tmp_s == side_elem) then + corner_array(1) = corner_elem + orig_pos(1) = k + exit + endif + enddo + if (corner_array(1)> 0) exit + enddo + if (corner_array(1)==0) then + print *, i, cnt + call endrun('find_corner_neighbors (1) : mistake finding corner neighbor order') + endif + + !if cnt == 2, we are done (we know the order of neighbors) + if (cnt ==2) then + if (corner_array(1) == a_corner_elems(1)) then + corner_array(2) = a_corner_elems(2) + orig_pos(2) = 2 + else + corner_array(2) = a_corner_elems(1) + orig_pos(2) = 1 + end if + else !cnt = 3 or 4 + !find which corner element borders corner_sides(2) + side_elem = GridVertex(i)%nbrs(corner_sides(2)) + do k = 1,cnt + corner_elem = a_corner_elems(k) + do kk = 1,4 + loc = GridVertex(corner_elem)%nbrs_ptr(kk) + tmp_s = GridVertex(corner_elem)%nbrs(loc) + if (tmp_s == side_elem) then + corner_array(4) = corner_elem + orig_pos(4) = k + exit + endif + enddo + if (corner_array(4)> 0) exit + enddo + if (corner_array(4)==0 .or. corner_array(4) == corner_array(1)) then + print *, i, cnt + call endrun('find_corner_neighbors (2) : mistake finding corner neighbor order') + endif + + !now if cnt = 3 then we are done + if (cnt ==3) then + corner_array(3) = corner_array(4) + orig_pos(3) = orig_pos(4) + + do k = 1,cnt !find the "middle" element + if (k /= orig_pos(1) .and. k /= orig_pos(3)) then + orig_pos(2) = k + corner_array(2) = a_corner_elems(k) + exit + endif + enddo + else !cnt = 4 + !which of the two unassigned elements borders the element in + !corner_array(1) => put in corner_array(2) + side_elem = corner_array(1) + + do k = 1,cnt + corner_elem = a_corner_elems(k) + if (corner_elem == corner_array(4) .or. corner_elem == corner_array(1)) then + cycle + else + do kk = 1,4 !check each side + loc = GridVertex(corner_elem)%nbrs_ptr(kk) + tmp_s = GridVertex(corner_elem)%nbrs(loc) + if (tmp_s == side_elem) then + corner_array(2) = corner_elem + orig_pos(2) = k + exit + endif + enddo + endif + if (corner_array(2)> 0) exit + enddo + !now put the remaining one in pos 3 + do k = 1,cnt + corner_elem = a_corner_elems(k) + if (corner_elem /= corner_array(4) .and. corner_elem /= & + corner_array(2) .and. corner_elem /= corner_array(1)) then + corner_array(3) = corner_elem + orig_pos(3) = k + exit + endif + enddo + endif ! end of cnt=4 + endif! end of not cnt=2 + + !now re-set the elements in this corner + GridVertex(i)%nbrs(start : start + cnt-1) = corner_array(1:cnt) + !nbrs_wgt are the same - nothing to do + !fix neighbors face + do k = 1,cnt + face_array(k) = GridVertex(i)%nbrs_face(start + orig_pos(k) - 1) + end do + GridVertex(i)%nbrs_face(start : start + cnt - 1) = face_array(1:cnt) + endif !end of cnt > 1 loop for corners + + end do !j loop through each corner + + end do ! end of i loop through elements + end subroutine find_corner_neighbors + + ! ================================================================================ + ! + ! -------------------------------Public Methods----------------------------------- + ! + ! ================================================================================ + +!====================================================================== +! subroutine MeshOpen +!====================================================================== + + subroutine MeshOpen(mesh_file_name, par) + use parallel_mod, only: parallel_t + use cam_logfile, only: iulog + + character (len=*), intent(in) :: mesh_file_name + type (parallel_t), intent(in) :: par + + integer, allocatable :: node_multiplicity(:) + integer :: k + + p_mesh_file_name = mesh_file_name + call open_mesh_file () + + p_number_elements = get_number_of_elements () + p_number_nodes = get_number_of_nodes () + p_number_blocks = get_number_of_element_blocks () + p_number_dimensions = get_number_of_dimensions () + + if (p_number_dimensions /= 3) then + call endrun('The number of dimensions must be 3, otherwise the mesh algorithms will not work') + endif + + ! Only spheres are allowed in input files. + if (par%masterproc) then + if (p_number_blocks == 1) then + write(iulog,*) "Since the mesh file has only one block, it is assumed to be a sphere." + endif + end if + + if (p_number_blocks /= 1) then + call endrun('Number of elements blocks not exactly 1 (sphere)') + end if + + p_number_elements_per_face = get_number_of_elements_per_face() + ! Because all elements are in one face, this value must match p_number_elements + if ( p_number_elements /= p_number_elements_per_face) then + call endrun('The value of the total number of elements does not match all the elements found in face 1') + end if + + allocate( p_connectivity(4,p_number_elements_per_face) ) + p_connectivity(:,:)=0 + ! extract the connectivity from the netcdf file + call get_face_connectivity() + + allocate(node_multiplicity(p_number_nodes)) + call get_node_multiplicity(node_multiplicity) + + ! tricky: For each node with multiplicity n, there are n(n-1) neighbor links + ! created. But this counts each edge twice, so: n(n-1) -n + ! Should be the same as SUM(SIZE(GridVertex(i)%nbrs(j)%n),i=1:p_number_elements,j=1:8) + ! p_number_neighbor_edges = dot_product(mult,mult) - 2*sum(mult) + p_number_neighbor_edges = 0 + do k=1,p_number_nodes + p_number_neighbor_edges = p_number_neighbor_edges + node_multiplicity(k)*(node_multiplicity(k)-2) + end do + + deallocate(node_multiplicity) + + ! allocate the space for the coordinates, this is used in many functions + allocate(p_node_coordinates(p_number_nodes, p_number_dimensions)) + call get_node_coordinates() + + if (p_number_elements_per_face /= p_number_elements) then + call endrun('MeshOpen: Total number of elements not equal to the number of elements on face 1!') + end if + + end subroutine MeshOpen + +!====================================================================== +! subroutine MeshClose +! +! This routine acts as a destructor cleaning the memory allocated in MeshOpen +! which acts as a constructor allocated dynamical memory for the nodes coordinates. +!====================================================================== + + subroutine MeshClose + + ! release memory + deallocate(p_node_coordinates) + deallocate(p_connectivity) + ! let the file go + call close_mesh_file () + + end subroutine MeshClose + + +!====================================================================== +! subroutine MeshPrint +!====================================================================== + + + subroutine MeshPrint(par) + use parallel_mod, only: parallel_t + use cam_logfile, only: iulog + + type (parallel_t), intent(in) :: par + if (par%masterproc) then + write(iulog,*) 'This are the values for file ', trim(p_mesh_file_name) + write(iulog,*) 'The value for the number of dimensions (num_dim) is ', p_number_dimensions + write(iulog,*) 'The number of elements in the mesh file is ', p_number_elements + write(iulog,*) 'The number of nodes in the mesh file is ', p_number_nodes + write(iulog,*) 'The number of blocks in the mesh file is ', p_number_blocks + write(iulog,*) 'The number of elements in the face 1 (sphere) is ', p_number_elements_per_face + if ( p_number_elements == p_number_elements) then + write(iulog,*) 'The value of the total number of elements does match all the elements found in face 1 (the only face)' + else + write(iulog,*) 'The value of the total number of elements does not match all the elements found in face 1' + write(iulog,*) 'This message should not be appearing, there is something wrong in the code' + endif + write(iulog,*) 'The number of neighbor edges ', p_number_neighbor_edges + end if + + end subroutine MeshPrint + +!====================================================================== +! subroutine MeshCubeTopology +!====================================================================== + subroutine MeshCubeTopology(GridEdge, GridVertex) + use dimensions_mod, only : np + use coordinate_systems_mod, only : cartesian3D_t, cube_face_number_from_cart + use gridgraph_mod, only : GridVertex_t + use gridgraph_mod, only : GridEdge_t + use cube_mod, only : CubeSetupEdgeIndex + use gridgraph_mod, only : initgridedge, num_neighbors + use control_mod, only : north, south, east, west, neast, seast, swest, nwest + + type (GridEdge_t), intent(inout), target :: GridEdge(:) + type (GridVertex_t), intent(inout), target :: GridVertex(:) + + real(kind=r8) :: coordinates(4,3) + real(kind=r8) :: centroid(3) + type (cartesian3D_t) :: face_center + + integer :: i, j, k, ll, loc + integer :: element_nodes(p_number_elements, 4) + integer :: EdgeWgtP,CornerWgt + integer :: normal_to_homme_ordering(8) + integer :: node_numbers(4) + integer, allocatable :: index_table(:,:) + + normal_to_homme_ordering(1) = south + normal_to_homme_ordering(2) = east + normal_to_homme_ordering(3) = north + normal_to_homme_ordering(4) = west + normal_to_homme_ordering(5) = swest + normal_to_homme_ordering(6) = seast + normal_to_homme_ordering(7) = neast + normal_to_homme_ordering(8) = nwest + + if (SIZE(GridVertex) /= p_number_elements) then + call endrun('MeshCubeTopology: Element count check failed in exodus_mesh. & + &Vertex array length not equal to number of elements.') + end if + if (p_number_elements_per_face /= p_number_elements) then + call endrun('MeshCubeTopology: Element count check failed in exodus_mesh. & + &Element array length not equal to sum of face.') + end if + + EdgeWgtP = np + CornerWgt = 1 + + + call mesh_connectivity (element_nodes) + + do i=1, p_number_elements + GridVertex(i)%number = i + GridVertex(i)%face_number = 0 + GridVertex(i)%processor_number = 0 + GridVertex(i)%SpaceCurve = 0 + + GridVertex(i)%nbrs(:) = 0 + GridVertex(i)%nbrs_face(:) = 0 + GridVertex(i)%nbrs_wgt(:) = 0 + GridVertex(i)%nbrs_wgt_ghost(:) = 1 + + !each elements has one side neighbor (first 4) + GridVertex(i)%nbrs_ptr(1) = 1 + GridVertex(i)%nbrs_ptr(2) = 2 + GridVertex(i)%nbrs_ptr(3) = 3 + GridVertex(i)%nbrs_ptr(4) = 4 + !don't know about corners yet + GridVertex(i)%nbrs_ptr(5:num_neighbors+1) = 5 + + end do + + !create index table to find neighbors + call create_index_table(index_table, element_nodes) + + ! side neighbors + call find_side_neighbors(GridVertex, normal_to_homme_ordering, element_nodes, EdgeWgtP, index_table) + + ! set vertex faces + do i=1, p_number_elements + node_numbers = element_nodes(i,:) + coordinates = p_node_coordinates(node_numbers,:) + centroid = SUM(coordinates, dim=1)/4.0_r8 + face_center%x = centroid(1) + face_center%y = centroid(2) + face_center%z = centroid(3) + GridVertex(i)%face_number = cube_face_number_from_cart(face_center) + end do + + ! set side neighbor faces + do i=1, p_number_elements + do j=1,4 !look at each side + k = normal_to_homme_ordering(j) + loc = GridVertex(i)%nbrs_ptr(k) + ll = GridVertex(i)%nbrs(loc) + GridVertex(i)%nbrs_face(loc) = GridVertex(ll)%face_number + end do + end do + + ! find corner neighbor and faces (weights added also) + call find_corner_neighbors (GridVertex, normal_to_homme_ordering, element_nodes, CornerWgt, index_table) + + !done with the index table + deallocate(index_table) + + + call initgridedge(GridEdge,GridVertex) + do i=1,SIZE(GridEdge) + call CubeSetupEdgeIndex(GridEdge(i)) + enddo + + call initialize_space_filling_curve(GridVertex, element_nodes) + end subroutine MeshCubeTopology + +!====================================================================== +! subroutine MeshSetCoordinates(elem) +!====================================================================== + + subroutine MeshSetCoordinates(elem) + use element_mod, only: element_t + + type (element_t), intent(inout) :: elem(:) + + integer :: connectivity(p_number_elements,4) + integer :: node_multiplicity(p_number_nodes) + integer :: face_no, i, k, l + integer :: number + integer :: node_num(4) + real(kind=r8) :: coordinates(4,3) + real(kind=r8) :: cube_coor (4,2) + + connectivity =0 + node_multiplicity=0 + + call mesh_connectivity (connectivity) + + do k=1,p_number_elements + node_num = connectivity(k,:) + node_multiplicity(node_num(:)) = node_multiplicity(node_num(:)) + 1 + end do + + do k=1,SIZE(elem) + number = elem(k)%vertex%number + face_no = elem(k)%vertex%face_number + node_num = connectivity(number,:) + coordinates = p_node_coordinates(node_num,:) + + if (6 == p_number_blocks) then + call cube_to_cube_coordinates (cube_coor, coordinates, face_no) + else + call sphere_to_cube_coordinates (cube_coor, coordinates, face_no) + end if +! elem(k)%node_numbers = node_num +! elem(k)%node_multiplicity(:) = node_multiplicity(node_num(:)) + elem(k)%corners(:)%x = cube_coor(:,1) + elem(k)%corners(:)%y = cube_coor(:,2) + end do + end subroutine MeshSetCoordinates + +!====================================================================== +!function MeshCubeEdgeCount() +!====================================================================== + function MeshCubeEdgeCount() result(nedge) + + integer :: nedge + if (0 == p_number_blocks) call endrun('MeshCubeEdgeCount called before MeshOpenMesh') + if (MeshUseMeshFile) then + ! should be the same as SUM(SIZE(GridVertex(i)%nbrs(j)%n),i=1:p_number_elements,j=1:nInnerElemEdge) + ! the total number of neighbors. + nedge = p_number_neighbor_edges + else + call endrun('Error in MeshCubeEdgeCount: Should not call for non-exodus mesh file.') + endif + + end function MeshCubeEdgeCount + + function MeshCubeElemCount() result(nelem) + + integer :: nelem + if (0 == p_number_blocks) call endrun('MeshCubeElemCount called before MeshOpenMesh') + if (MeshUseMeshFile) then + nelem = p_number_elements + else + call endrun('Error in MeshCubeElemCount: Should not call for non-exodus mesh file.') + end if + end function MeshCubeElemCount + + subroutine test_private_methods + implicit none + integer :: element_nodes(p_number_elements, 4) + call mesh_connectivity (element_nodes) + end subroutine test_private_methods + + +end module mesh_mod diff --git a/src/dynamics/se/dycore/metagraph_mod.F90 b/src/dynamics/se/dycore/metagraph_mod.F90 new file mode 100644 index 0000000000..a2870ae8b2 --- /dev/null +++ b/src/dynamics/se/dycore/metagraph_mod.F90 @@ -0,0 +1,375 @@ +module metagraph_mod + use cam_logfile, only: iulog + use gridgraph_mod, only : gridvertex_t, gridedge_t, & + allocate_gridvertex_nbrs, assignment ( = ) + + implicit none + private + + type, public :: MetaEdge_t + type (GridEdge_t),pointer :: members(:) + integer ,pointer :: edgeptrP(:) + integer ,pointer :: edgeptrP_ghost(:) + integer ,pointer :: edgeptrS(:) + integer :: number + integer :: type + integer :: wgtP ! sum of lengths of all messages to pack for edges + integer :: wgtP_ghost ! sum of lengths of all messages to pack for ghost cells + integer :: wgtS + integer :: HeadVertex ! processor number to send to + integer :: TailVertex ! processor number to send from + integer :: nmembers ! number of messages to (un)pack (out)into this buffer + integer :: padding ! just to quite compiler + end type MetaEdge_t + + type, public :: MetaVertex_t ! one for each processor + integer :: number ! USELESS just the local processor number + integer :: nmembers ! number of elements on this processor + type (GridVertex_t),pointer :: members(:) ! array of elements on this processor + type (MetaEdge_t),pointer :: edges(:) ! description of messages to send/receive + integer :: nedges ! number of processors to communicate with (length of edges) + integer :: padding ! just to quite compiler + end type MetaVertex_t + + + public :: edge_uses_vertex + public :: PrintMetaEdge, PrintMetaVertex + public :: LocalElemCount + public :: initMetaGraph + + interface assignment ( = ) + module procedure copy_metaedge + end interface + +CONTAINS + + ! ===================================== + ! copy vertex: + ! copy device for overloading = sign. + ! ===================================== + + recursive subroutine copy_metaedge(edge2,edge1) + + type (MetaEdge_t), intent(out) :: edge2 + type (MetaEdge_t), intent(in) :: edge1 + + integer i + + edge2%number = edge1%number + edge2%type = edge1%type + edge2%wgtP = edge1%wgtP + edge2%wgtP_ghost = edge1%wgtP_ghost + edge2%nmembers = edge1%nmembers + + if (associated(edge1%members)) then + allocate(edge2%members(edge2%nmembers)) + do i=1,edge2%nmembers + edge2%members(i)=edge1%members(i) + end do + end if + + if (associated(edge1%edgeptrP)) then + allocate(edge2%edgeptrP(edge2%nmembers)) + allocate(edge2%edgeptrS(edge2%nmembers)) + allocate(edge2%edgeptrP_ghost(edge2%nmembers)) + do i=1,edge2%nmembers + edge2%edgeptrP(i)=edge1%edgeptrP(i) + edge2%edgeptrS(i)=edge1%edgeptrS(i) + edge2%edgeptrP_ghost(i)=edge1%edgeptrP_ghost(i) + end do + end if + + edge2%HeadVertex = edge1%HeadVertex + edge2%TailVertex = edge1%TailVertex + + end subroutine copy_metaedge + + function LocalElemCount(Vertex) result(nelemd) + + type (MetaVertex_t),intent(in) :: Vertex + integer :: nelemd + + nelemd = Vertex%nmembers + + end function LocalElemCount + + function edge_uses_vertex(Vertex,Edge) result(log) + + type(MetaVertex_t), intent(in) :: Vertex + type(MetaEdge_t), intent(in) :: Edge + logical :: log + integer :: number + + number = Vertex%number + if(number == Edge%HeadVertex .or. number == Edge%TailVertex) then + log = .TRUE. + else + log = .FALSE. + endif + + end function edge_uses_vertex + + subroutine PrintMetaEdge(Edge) + use gridgraph_mod, only : PrintGridEdge + implicit none + type (MetaEdge_t), intent(in) :: Edge(:) + integer :: i,nedge + + nedge = SIZE(Edge) + do i=1,nedge + print * + write(iulog,90) Edge(i)%number,Edge(i)%type,Edge(i)%wgtP,Edge(i)%nmembers, & + Edge(i)%TailVertex, Edge(i)%HeadVertex + if(associated(Edge(i)%members)) then + call PrintGridEdge(Edge(i)%members) + endif + enddo +90 format('METAEDGE #',I4,2x,'TYPE ',I1,2x,'WGT ',I4,2x,'NUM ',I6,2x,'Processors ',I4,' ---> ',I4) + + end subroutine PrintMetaEdge + + subroutine PrintMetaVertex(Vertex) + use gridgraph_mod, only : PrintGridVertex + implicit none + type (MetaVertex_t), intent(in),target :: Vertex + + integer :: j + + + write(iulog,*) + write(iulog,95) Vertex%nmembers + call PrintGridVertex(Vertex%members) + write(iulog,96) Vertex%nedges + if(associated(Vertex%edges)) then + do j=1,Vertex%nedges + write(iulog,97) Vertex%edges(j)%number, Vertex%edges(j)%type, & + Vertex%edges(j)%wgtP, Vertex%edges(j)%HeadVertex, & + Vertex%edges(j)%TailVertex + enddo + endif + +95 format(5x,I2,' Member Grid Vertices') +96 format(5x,I2,' Incident Meta Edges ') +97 format(10x,'METAEDGE #',I2,2x,'TYPE ',I1,2x,'WGT ',I4,2x,'Processors ',I2,' ---> ',I2) + + end subroutine PrintMetaVertex + + subroutine initMetaGraph(ThisProcessorNumber,MetaVertex,GridVertex,GridEdge) + use ll_mod, only : root_t, LLSetEdgeCount, LLFree, LLInsertEdge, LLGetEdgeCount, LLFindEdge + use gridgraph_mod, only : GridEdge_type, printGridVertex + !------------------ + !------------------ + implicit none + + integer, intent(in) :: ThisProcessorNumber + type (MetaVertex_t), intent(out) :: MetaVertex + type (GridVertex_t), intent(in),target :: GridVertex(:) + type (GridEdge_t), intent(in),target :: GridEdge(:) + + !type (MetaEdge_t), allocatable :: MetaEdge(:) + integer :: nelem,nelem_edge, nedges + integer,allocatable :: icount(:) + integer :: ic,i,j,ii + integer :: npart + integer :: head_processor_number + integer :: tail_processor_number + integer :: nedge_active,enum + logical :: found + integer iTail, iHead, wgtP,wgtS + + type (root_t) :: mEdgeList ! root_t = C++ std::set > + + logical :: Verbose = .FALSE. + logical :: Debug = .FALSE. + + + if(Debug) write(iulog,*)'initMetagraph: point #1' + ! Number of grid vertices + nelem = SIZE(GridVertex) + ! Number of grid edges + nelem_edge = SIZE(GridEdge) + + mEdgeList%number = ThisProcessorNumber + NULLIFY(mEdgeList%first) + call LLSetEdgeCount(0) + + do i=1,nelem_edge + tail_processor_number = GridEdge(i)%tail%processor_number + head_processor_number = GridEdge(i)%head%processor_number + if(tail_processor_number .eq. ThisProcessorNumber .or. & + head_processor_number .eq. ThisProcessorNumber ) then + call LLInsertEdge(mEdgeList,tail_processor_number,head_processor_number,eNum) + endif + enddo + + call LLGetEdgeCount(nedges) + + NULLIFY(MetaVertex%edges) + + allocate(MetaVertex%edges(nedges)) + + ! Initalize the Meta Vertices to zero... probably should be done + ! in a separate routine + MetaVertex%nmembers=0 + MetaVertex%number=0 + MetaVertex%nedges=0 + if(Debug) write(iulog,*)'initMetagraph: point #2' + + + ! Give some identity to the Meta_vertex + MetaVertex%number = ThisProcessorNumber + if(Debug) write(iulog,*)'initMetagraph: point #3' + + ! Look through all the small_vertices and determine the number of + ! member vertices + if(Debug) call PrintGridVertex(GridVertex) + if(Debug) write(iulog,*)'initMetagraph: After call to PrintGridVertex point #3.1' + if(Debug) write(iulog,*)'initMetaGraph: ThisProcessorNumber is ',ThisProcessorNumber + + do j=1,nelem ! count number of elements on this processor + if(GridVertex(j)%processor_number .eq. ThisProcessorNumber) then + MetaVertex%nmembers = MetaVertex%nmembers + 1 + endif + enddo + + if(Debug) write(iulog,*)'initMetagraph: point #4 ' + ! Allocate space for the members of the MetaVertices + if(Debug) write(iulog,*)'initMetagraph: point #4.1 i,MetaVertex%nmembers',i,MetaVertex%nmembers + allocate(MetaVertex%members(MetaVertex%nmembers)) + + do j=1, MetaVertex%nmembers + call allocate_gridvertex_nbrs(MetaVertex%members(j)) + end do + + if(Debug) write(iulog,*)'initMetagraph: point #5' + + ! Set the identity of the members of the MetaVertices + ic=1 + do j=1,nelem + if( GridVertex(j)%processor_number .eq. ThisProcessorNumber) then + MetaVertex%members(ic) = GridVertex(j) + ic=ic+1 + endif + enddo + + nedges = SIZE(MetaVertex%edges) + if(Debug) write(iulog,*)'initMetagraph: point #6 nedges',nedges + ! Zero out all the edge numbers ... this should probably be + ! move to some initalization routine + MetaVertex%edges%number = 0 + MetaVertex%edges%nmembers = 0 + MetaVertex%edges%wgtP = 0 + MetaVertex%edges%wgtS = 0 + MetaVertex%edges%wgtP_ghost = 0 + do i=1,nedges + NULLIFY(MetaVertex%edges(i)%members) + enddo + + if(Debug) write(iulog,*)'initMetagraph: point #7' + + ! Insert all the grid edges into the Meta Edges + do i=1, nelem_edge + ! Which Meta Edge does this grid edge belong + head_processor_number = GridEdge(i)%head%processor_number + tail_processor_number = GridEdge(i)%tail%processor_number + call LLFindEdge(mEdgeList,tail_processor_number,head_processor_number,j,found) + if(found) then + + ! Increment the number of grid edges contained in the grid edge + ! and setup the pointers + if(Debug) write(iulog,*)'initMetagraph: point #8' + ii=GridEdge(i)%tail_face + + wgtP=Gridedge(i)%tail%nbrs_wgt(ii) + wgtS=1 + + MetaVertex%edges(j)%nmembers = MetaVertex%edges(j)%nmembers+1 + MetaVertex%edges(j)%wgtP = MetaVertex%edges(j)%wgtP + wgtP + MetaVertex%edges(j)%wgtS = MetaVertex%edges(j)%wgtS + wgtS + + MetaVertex%edges(j)%wgtP_ghost = MetaVertex%edges(j)%wgtP_ghost + Gridedge(i)%tail%nbrs_wgt_ghost(ii) + + if(Debug) write(iulog,*)'initMetagraph: point #9' + + ! If this the first grid edge to be inserted into the Meta Edge + ! do some more stuff + + if(MetaVertex%edges(j)%nmembers .eq. 1) then + + if(Debug) write(iulog,*)'initMetagraph: point #10' + MetaVertex%edges(j)%number = j ! its identity + MetaVertex%edges(j)%type = gridedge_type(GridEdge(i)) ! Type of grid edge + + if(Debug) write(iulog,*)'initMetagraph: point #11' + + ! Setup the pointer to the head and tail of the Vertex + MetaVertex%edges(j)%HeadVertex = head_processor_number + MetaVertex%edges(j)%TailVertex = tail_processor_number + if(Debug) write(iulog,*)'initMetagraph: point #12' + + ! Determine the number of edges for the Meta_Vertex + ! This is the number of processors to communicate with + MetaVertex%nedges = MetaVertex%nedges + 1 + if(Debug) write(iulog,*)'initMetagraph: point #13' + endif + endif + enddo + + do i=1,nedges + ! Allocate space for the member edges and edge index + allocate(MetaVertex%edges(i)%members (MetaVertex%edges(i)%nmembers)) + allocate(MetaVertex%edges(i)%edgeptrP(MetaVertex%edges(i)%nmembers)) + allocate(MetaVertex%edges(i)%edgeptrS(MetaVertex%edges(i)%nmembers)) + allocate(MetaVertex%edges(i)%edgeptrP_ghost(MetaVertex%edges(i)%nmembers)) + MetaVertex%edges(i)%edgeptrP(:)=0 + MetaVertex%edges(i)%edgeptrS(:)=0 + MetaVertex%edges(i)%edgeptrP_ghost(:)=0 + enddo + if(Debug) write(iulog,*)'initMetagraph: point #14' + + ! Insert the edges into the proper meta edges + allocate(icount(nelem_edge)) + icount=1 + do i=1,nelem_edge + head_processor_number = GridEdge(i)%head%processor_number + tail_processor_number = GridEdge(i)%tail%processor_number + call LLFindEdge(mEdgeList,tail_processor_number,head_processor_number,j,found) + if(found) then + MetaVertex%edges(j)%members(icount(j)) = GridEdge(i) + if(icount(j)+1 .le. MetaVertex%edges(j)%nmembers) then + + ii=GridEdge(i)%tail_face + + wgtP=Gridedge(i)%tail%nbrs_wgt(ii) + MetaVertex%edges(j)%edgeptrP(icount(j)+1) = MetaVertex%edges(j)%edgeptrP(icount(j)) + wgtP + + wgtS = 1 + MetaVertex%edges(j)%edgeptrS(icount(j)+1) = MetaVertex%edges(j)%edgeptrS(icount(j)) + wgtS + + wgtP=Gridedge(i)%tail%nbrs_wgt_ghost(ii) + MetaVertex%edges(j)%edgeptrP_ghost(icount(j)+1) = MetaVertex%edges(j)%edgeptrP_ghost(icount(j)) + wgtP + endif + if(Debug) write(iulog,*)'initMetagraph: point #15' + icount(j)=icount(j)+1 + endif + enddo + deallocate(icount) + if(Debug) write(iulog,*)'initMetagraph: point #16' + + if(Verbose) then + print * + write(iulog,*)"edge bundle list:(INITMETAGRAPH)" + call PrintMetaEdge( MetaVertex%edges) + write(iulog,*)'initmetagrap: Before last call to PrintMetaVertex' + call PrintMetaVertex(MetaVertex) + endif + + call LLFree(mEdgeList) + +90 format('EDGE #',I2,2x,'TYPE ',I1,2x,'Processor Numbers ',I2,' ---> ',I2) +100 format(10x,I2,1x,'(',I1,') ---> ',I2,1x,'(',I1,')') + + end subroutine initMetaGraph + + +end module metagraph_mod diff --git a/src/dynamics/se/dycore/namelist_mod.F90 b/src/dynamics/se/dycore/namelist_mod.F90 new file mode 100644 index 0000000000..951659cf31 --- /dev/null +++ b/src/dynamics/se/dycore/namelist_mod.F90 @@ -0,0 +1,193 @@ +module namelist_mod + !----------------- + use cam_logfile, only: iulog + !----------------- + use params_mod, only: recursive, sfcurve + !----------------- + use shr_string_mod, only: shr_string_toUpper + use shr_kind_mod, only: r8=>shr_kind_r8 + !----------------- + use control_mod, only: & + partmethod, & ! Mesh partitioning method (METIS) + multilevel, & + numnodes, & + tasknum, & ! used dg model in AIX machine + remapfreq, & ! number of steps per remapping call + remap_type, & ! selected remapping option + statefreq, & ! number of steps per printstate call + runtype, & + cubed_sphere_map, & + prescribed_wind, & + limiter_option, & + nu, & + nu_s, & + nu_q, & + nu_div, & + nu_top, & + hypervis_scaling, & ! use tensor HV instead of scalar coefficient + disable_diagnostics, & ! Use to disable diagnostics for timing reasons + hypervis_power, & + columnpackage, & + tracer_transport_type, & + TRACERTRANSPORT_CONSISTENT_SE_FVM + + !----------------- + use thread_mod, only : omp_get_max_threads, max_num_threads, horz_num_threads, vert_num_threads, tracer_num_threads + !----------------- + use dimensions_mod, only : ne, np, npdg, nnodes, nmpi_per_node, npart, qsize, qsize_d, set_mesh_dimensions + !----------------- + !----------------- + use cam_abortutils, only: endrun + use parallel_mod, only: parallel_t, partitionfornodes, useframes + !----------------- + + + use interpolate_mod, only : set_interp_parameter, get_interp_parameter + +!=============================================================================! + implicit none + private +! +! This module should contain no global data and should only be 'use'd to +! call one of the public interfaces below +! + public :: homme_set_defaults + public :: homme_postprocess_namelist + + contains + + ! ============================================ + ! homme_set_defaults: + ! + ! Set default values for namelist variables + ! + ! ============================================ + subroutine homme_set_defaults() + npart = 1 + useframes = 0 + multilevel = 1 + numnodes = -1 + runtype = 0 + statefreq = 1 + remapfreq = 240 + remap_type = "parabolic" + tasknum =-1 + columnpackage = "none" + nu_top = 0 + ne = 0 + disable_diagnostics = .false. + + end subroutine homme_set_defaults + + subroutine homme_postprocess_namelist(mesh_file, par) + use mesh_mod, only: MeshOpen + + ! Dummy arguments + character(len=*), intent(in) :: mesh_file + type (parallel_t), intent(in) :: par + + ! Local variable + real(kind=r8) :: dt_max + character(len=*), parameter :: subname = 'HOMME_POSTPROCESS_NAMELIST: ' + + if(par%masterproc) then + write(iulog, *) subname, 'omp_get_max_threads() = ', max_num_threads + end if + + if((vert_num_threads > 1) .and. (limiter_option .ne. 8)) then + if(par%masterproc) then + write(iulog, *) subname, 'WARNING: vertical threading on supported for limiter_option != 8 ' + end if + vert_num_threads = 1 + endif + + if (ne /= 0) then + if (mesh_file /= "none" .and. mesh_file /= "/dev/null") then + if (par%masterproc) then + write(iulog, *) subname, "mesh_file:", trim(mesh_file), & + " and ne:",ne," are both sepcified in the input file." + write(iulog,*) " Specify one or the other, but not both." + end if + call endrun(subname//"Do not specify ne if using a mesh file input.") + end if + end if + if (par%masterproc) then + write(iulog,*) subname, "Mesh File:", trim(mesh_file) + end if + if (ne == 0) then + if (par%masterproc) then + write (iulog,*) subname, "Opening Mesh File:", trim(mesh_file) + end if + call set_mesh_dimensions() + call MeshOpen(mesh_file, par) + end if + + ! set map + if (cubed_sphere_map < 0) then + if (ne == 0) then + cubed_sphere_map = 2 ! element_local for var-res grids + else + cubed_sphere_map = 0 ! default is equi-angle gnomonic + end if + end if + + if ((cubed_sphere_map /= 0) .AND. & + tracer_transport_type .eq. TRACERTRANSPORT_CONSISTENT_SE_FVM) then + if (par%masterproc) then + write(iulog, *) subname, 'fvm transport and require equi-angle gnomonic cube sphere mapping.' + write(iulog, *) ' Set cubed_sphere_map = 0 or comment it out all together. ' + end if + call endrun(subname//"ERROR: fvm transport and cubed_sphere_map>0") + end if + if (par%masterproc) then + write (iulog,*) subname, "Reference element projection: cubed_sphere_map=",cubed_sphere_map + end if + + !logic around different hyperviscosity options + if (hypervis_power /= 0) then + if (hypervis_scaling /= 0) then + if (par%masterproc) then + write(iulog, *) subname, 'Both hypervis_power and hypervis_scaling are nonzero.' + write(iulog, *) ' (1) Set hypervis_power=1, hypervis_scaling=0 for HV based on an element area.' + write(iulog, *) ' (2) Set hypervis_power=0 and hypervis_scaling=1 for HV based on a tensor.' + write(iulog, *) ' (3) Set hypervis_power=0 and hypervis_scaling=0 for constant HV.' + end if + call endrun(subname//"ERROR: hypervis_power>0 and hypervis_scaling>0") + end if + end if + + if((prescribed_wind /= 0) .and. (prescribed_wind /= 1))then + call endrun(subname//'prescribed_wind should be either 0 or 1') + end if + + ! some default diffusion coefficiets + if (nu_s < 0) then + nu_s = nu + end if + if (nu_q < 0) then + nu_q = nu + end if + if (nu_div < 0) then + nu_div = nu + end if + + if (multilevel <= 0) then + nmpi_per_node = 1 + end if + + nnodes = npart / nmpi_per_node + + if((numnodes > 0) .and. (multilevel == 1)) then + nnodes = numnodes + nmpi_per_node = npart/nnodes + end if + + ! ==================================================================== + ! Do not perform node level partitioning if you are only on one node + ! ==================================================================== + if((nnodes .eq. 1) .and. PartitionForNodes) then + PartitionForNodes = .FALSE. + end if + + end subroutine homme_postprocess_namelist +end module namelist_mod diff --git a/src/dynamics/se/dycore/parallel_mod.F90 b/src/dynamics/se/dycore/parallel_mod.F90 new file mode 100644 index 0000000000..6cdf797b58 --- /dev/null +++ b/src/dynamics/se/dycore/parallel_mod.F90 @@ -0,0 +1,246 @@ +module parallel_mod + ! --------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + ! --------------------------- + use dimensions_mod, only : nmpi_per_node, nlev, qsize_d + ! --------------------------- + use spmd_utils, only: MPI_STATUS_SIZE, MPI_MAX_ERROR_STRING, MPI_TAG_UB + + implicit none + private + + integer, public, parameter :: ORDERED = 1 + integer, public, parameter :: FAST = 2 + integer, public, parameter :: BNDRY_TAG_BASE = 0 + integer, public, parameter :: THREAD_TAG_BITS = 9 + integer, public, parameter :: MAX_ACTIVE_MSG = (MPI_TAG_UB/2**THREAD_TAG_BITS) - 1 + integer, public, parameter :: HME_status_size = MPI_STATUS_SIZE + + integer, public, parameter :: HME_BNDRY_P2P = 1 + integer, public, parameter :: HME_BNDRY_MASHM = 2 + integer, public, parameter :: HME_BNDRY_A2A = 3 + integer, public, parameter :: HME_BNDRY_A2AO = 4 + + integer, public, parameter :: nrepro_vars = MAX(10, nlev*qsize_d) + + integer, public :: MaxNumberFrames + integer, public :: numframes + integer, public :: useframes + logical, public :: PartitionForNodes + logical, public :: PartitionForFrames + + ! Namelist-selectable type of boundary comms (AUTO,P2P,A2A,MASHM) + integer, public :: boundaryCommMethod + + integer, public, allocatable :: status(:,:) + integer, public, allocatable :: Rrequest(:) + integer, public, allocatable :: Srequest(:) + + real(r8), public, allocatable :: FrameWeight(:) + integer, public, allocatable :: FrameIndex(:) + integer, public, allocatable :: FrameCount(:) + integer, public :: nComPoints + integer, public :: nPackPoints + + real(r8), public, allocatable :: global_shared_buf(:,:) + real(r8), public :: global_shared_sum(nrepro_vars) + + ! ================================================== + ! Define type parallel_t for distributed memory info + ! ================================================== + type, public :: parallel_t + integer :: rank ! local rank + integer :: root ! local root + integer :: nprocs ! number of processes in group + integer :: comm ! communicator + integer :: intracomm ! Intra-node communicator + integer :: commGraphFull ! distributed graph topo communicator for all neighbors + integer :: commGraphInter ! distributed graph topo communicator for off-node neighbors + integer :: commGraphIntra ! distributed graph topo communicator for on-node neighbors + integer :: groupGraphFull + logical :: masterproc + end type + + type (parallel_t), public :: par ! info for distributed memory programming + + ! =================================================== + ! Module Interfaces + ! =================================================== + + public :: initmpi + public :: syncmp + public :: copy_par + + interface assignment ( = ) + module procedure copy_par + end interface + +CONTAINS + +! ================================================ +! copy_par: copy constructor for parallel_t type +! +! +! Overload assignment operator for parallel_t +! ================================================ + + subroutine copy_par(par2,par1) + type(parallel_t), intent(out) :: par2 + type(parallel_t), intent(in) :: par1 + + par2%rank = par1%rank + par2%root = par1%root + par2%nprocs = par1%nprocs + par2%comm = par1%comm + par2%intracomm = par1%intracomm + par2%commGraphFull = par1%commGraphFull + par2%commGraphInter = par1%commGraphInter + par2%commGraphIntra = par1%commGraphIntra + par2%groupGraphFull = par1%groupGraphFull + par2%masterproc = par1%masterproc + + end subroutine copy_par + +! ================================================ +! initmpi: +! Initializes the parallel (message passing) +! environment, returns a parallel_t structure.. +! ================================================ + + function initmpi(npes_homme) result(par) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, MPI_COMM_NULL, MPI_MAX_PROCESSOR_NAME + use spmd_utils, only: MPI_CHARACTER, MPI_INTEGER, MPI_BAND, iam, npes + + integer, intent(in) :: npes_homme + + type(parallel_t) :: par + + integer :: ierr,tmp + integer :: FrameNumber + logical :: running ! state of MPI at beginning of initmpi call + character(len=MPI_MAX_PROCESSOR_NAME) :: my_name + character(len=MPI_MAX_PROCESSOR_NAME), allocatable :: the_names(:) + + integer, allocatable :: tarray(:) + integer :: namelen, i + integer :: color + + !================================================ + ! Basic MPI initialization + ! ================================================ + + call MPI_initialized(running, ierr) + + if (.not.running) then + call endrun('initmpi: MPI not initialized for SE dycore') + end if + + par%root = 0 + par%masterproc = .FALSE. + nmpi_per_node = 2 + PartitionForNodes = .TRUE. + + ! The SE dycore needs to split from CAM communicator for npes > par%nprocs + color = iam / npes_homme + call mpi_comm_split(mpicom, color, iam, par%comm, ierr) + if (iam < npes_homme) then + call MPI_comm_size(par%comm, par%nprocs, ierr) + call MPI_comm_rank(par%comm, par%rank, ierr) + if ( par%nprocs /= npes_homme) then + call endrun('INITMPI: SE communicator count mismatch') + end if + + if(par%rank == par%root) then + par%masterproc = .TRUE. + end if + else + par%rank = 0 + par%nprocs = 0 + par%comm = MPI_COMM_NULL + end if + + if (par%masterproc) then + write(iulog, '(a,i0)')'initmpi: Number of MPI processes: ', par%nprocs + end if + + if (iam < npes_homme) then + ! ================================================ + ! Determine where this MPI process is running + ! then use this information to determined the + ! number of MPI processes per node + ! ================================================ + my_name(:) = '' + call MPI_Get_Processor_Name(my_name, namelen, ierr) + + allocate(the_names(par%nprocs)) + do i = 1, par%nprocs + the_names(i)(:) = '' + end do + + ! ================================================ + ! Collect all the machine names + ! ================================================ + call MPI_Allgather(my_name, MPI_MAX_PROCESSOR_NAME, MPI_CHARACTER, & + the_names,MPI_MAX_PROCESSOR_NAME,MPI_CHARACTER,par%comm,ierr) + + ! ====================================================================== + ! Calculate how many other MPI processes are on my node + ! ====================================================================== + nmpi_per_node = 0 + do i = 1, par%nprocs + if(TRIM(ADJUSTL(my_name)) .eq. TRIM(ADJUSTL(the_names(i)))) then + nmpi_per_node = nmpi_per_node + 1 + end if + end do + + ! ======================================================================= + ! Verify that everybody agrees on this number otherwise do not do + ! the multi-level partitioning + ! ======================================================================= + call MPI_Allreduce(nmpi_per_node,tmp,1,MPI_INTEGER,MPI_BAND,par%comm,ierr) + if(tmp /= nmpi_per_node) then + if (par%masterproc) then + write(iulog,*)'initmpi: disagrement accross nodes for nmpi_per_node' + end if + nmpi_per_node = 1 + PartitionForNodes = .FALSE. + else + PartitionForNodes = .TRUE. + end if + + if(PartitionForFrames .and. par%masterproc) then + write(iulog,*)'initmpi: FrameWeight: ', FrameWeight + end if + + deallocate(the_names) + end if + + end function initmpi + + ! ===================================== + ! syncmp: + ! + ! sychronize message passing domains + ! + ! ===================================== + subroutine syncmp(par) + use cam_abortutils, only: endrun + use spmd_utils, only: MPI_MAX_ERROR_STRING, MPI_ERROR + + type (parallel_t), intent(in) :: par + + integer :: errorcode, errorlen, ierr + character(len=MPI_MAX_ERROR_STRING) :: errorstring + + call MPI_barrier(par%comm, ierr) + + if(ierr == MPI_ERROR) then + errorcode = ierr + call MPI_Error_String(errorcode, errorstring, errorlen, ierr) + call endrun(errorstring) + end if + end subroutine syncmp + +end module parallel_mod diff --git a/src/dynamics/se/dycore/params_mod.F90 b/src/dynamics/se/dycore/params_mod.F90 new file mode 100644 index 0000000000..cc7b5ba555 --- /dev/null +++ b/src/dynamics/se/dycore/params_mod.F90 @@ -0,0 +1,11 @@ +module params_mod + integer, public, parameter :: INTERNAL_EDGE = 0 + integer, public, parameter :: EXTERNAL_EDGE = 1 + + integer, public, parameter :: RECURSIVE = 0, & ! Type of partitioning methods + KWAY = 1, & + VOLUME = 2, & + WRECURSIVE = 3, & + SFCURVE = 4 + +end module params_mod diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 new file mode 100644 index 0000000000..c1a5dfc556 --- /dev/null +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -0,0 +1,2034 @@ +module prim_advance_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use edgetype_mod, only: EdgeBuffer_t + use perf_mod, only: t_startf, t_stopf, t_adj_detailf !, t_barrierf _EXTERNAL + use cam_abortutils, only: endrun + use parallel_mod, only: parallel_t, HME_BNDRY_P2P!,HME_BNDRY_A2A + use control_mod, only: se_prescribed_wind_2d + use thread_mod , only: horz_num_threads, vert_num_threads + + implicit none + private + save + + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega + + type (EdgeBuffer_t) :: edge3p1 + real (kind=r8), allocatable :: ur_weights(:) + +contains + + subroutine prim_advance_init(par, elem) + use edge_mod, only: initEdgeBuffer + use element_mod, only: element_t + use dimensions_mod, only: nlev,hypervis_on_plevs + use control_mod, only: qsplit,nu_p + + type (parallel_t) :: par + type (element_t), target, intent(inout) :: elem(:) + integer :: i + + if (hypervis_on_plevs.and.nu_p>0) then + call initEdgeBuffer(par,edge3p1,elem,5*nlev+1,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + else + call initEdgeBuffer(par,edge3p1,elem,4*nlev+1,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + end if + + allocate(ur_weights(qsplit)) + ur_weights(:)=0.0_r8 + + if(mod(qsplit,2).NE.0)then + ur_weights(1)=1.0_r8/qsplit + do i=3,qsplit,2 + ur_weights(i)=2.0_r8/qsplit + enddo + else + do i=2,qsplit,2 + ur_weights(i)=2.0_r8/qsplit + enddo + endif + end subroutine prim_advance_init + + + subroutine prim_advance_exp(elem, deriv, hvcoord, hybrid,dt, tl, nets, nete) + use control_mod, only: prescribed_wind, tstep_type, qsplit + use derivative_mod, only: derivative_t + use dimensions_mod, only: np, nlev, ntrac + use element_mod, only: element_t + use hybvcoord_mod, only: hvcoord_t + use hybrid_mod, only: hybrid_t + use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx_gll + use dimensions_mod, only: qsize_condensate_loading_cp, lcp_moist + use physconst, only: cpair + + + implicit none + + type (element_t), intent(inout), target :: elem(:) + type (derivative_t) , intent(in) :: deriv + type (hvcoord_t) :: hvcoord + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8), intent(in) :: dt + type (TimeLevel_t) , intent(in) :: tl + integer , intent(in) :: nets + integer , intent(in) :: nete + + ! Local + real (kind=r8) :: dt_vis, eta_ave_w + real (kind=r8) :: dp(np,np) + integer :: ie,nm1,n0,np1,k,qn0,i,j,m_cnst, nq + real (kind=r8) :: inv_cp_full(np,np,nlev,nets:nete), sum_cp, sum_water + real (kind=r8) :: qwater(np,np,nlev,qsize_condensate_loading,nets:nete) + + call t_startf('prim_advance_exp') + nm1 = tl%nm1 + n0 = tl%n0 + np1 = tl%np1 + + call TimeLevel_Qdp(tl, qsplit, qn0) ! compute current Qdp() timelevel + ! + ! tstep_type=1 RK2-SSP 3 stage (as used by tracers) CFL=.58 + ! optimal in terms of SSP CFL, but not CFLSSP=2 + ! optimal in terms of CFL + ! typically requires qsplit=3 + ! but if windspeed > 340m/s, could use this + ! with qsplit=1 + ! tstep_type=2 classic RK3 CFL=1.73 (sqrt(3)) + ! + ! tstep_type=3 Kinnmark&Gray RK4 4 stage CFL=sqrt(8)=2.8 + ! should we replace by standard RK4 (CFL=sqrt(8))? + ! (K&G 1st order method has CFL=3) + ! tstep_type=4 Kinnmark&Gray RK3 5 stage 3rd order CFL=3.87 (sqrt(15)) + ! From Paul Ullrich. 3rd order for nonlinear terms also + ! K&G method is only 3rd order for linear + ! optimal: for windspeeds ~120m/s,gravity: 340m/2 + ! run with qsplit=1 + ! (K&G 2nd order method has CFL=4. tiny CFL improvement not worth 2nd order) + ! + +#ifdef _OPENMP + call omp_set_nested(.true.) +#endif + + ! default weights for computing mean dynamics fluxes + eta_ave_w = 1_r8/qsplit + + if (1==prescribed_wind .and. .not.se_prescribed_wind_2d) then + do ie=nets,nete + do k=1,nlev + elem(ie)%state%dp3d(:,:,k,np1) = elem(ie)%state%dp3d(:,:,k,n0) + enddo + end do + + + + do ie=nets,nete + ! subcycling code uses a mean flux to advect tracers + !$omp parallel do num_threads (vert_num_threads) private(dp) + do k=1,nlev + dp(:,:) = elem(ie)%state%dp3d(:,:,k,tl%n0) + + elem(ie)%derived%vn0(:,:,1,k)=elem(ie)%derived%vn0(:,:,1,k)+& + eta_ave_w*elem(ie)%state%v(:,:,1,k,n0)*dp(:,:) + elem(ie)%derived%vn0(:,:,2,k)=elem(ie)%derived%vn0(:,:,2,k)+& + eta_ave_w*elem(ie)%state%v(:,:,2,k,n0)*dp(:,:) + enddo + end do + call t_stopf('prim_advance_exp') + return + endif + + ! ================================== + ! Take timestep + ! ================================== + + do ie=nets,nete + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + ! + ! make sure Q is updated + ! + qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) + end do + end do + ! + ! compute Cp here and not in RK-stages since Q stays constant Cp also stays constant + ! + if (lcp_moist) then + do ie=nets,nete + do k=1,nlev + do j=1,np + do i=1,np + sum_cp = cpair + sum_water = 1.0_r8 + do nq=1,qsize_condensate_loading + sum_cp = sum_cp+qsize_condensate_loading_cp(nq)*qwater(i,j,k,nq,ie) + sum_water = sum_water + qwater(i,j,k,nq,ie) + end do + inv_cp_full(i,j,k,ie) = sum_water/sum_cp + end do + end do + end do + end do + else + do ie=nets,nete + inv_cp_full(:,:,:,nets:nete) = 1.0_r8/cpair + end do + end if + + dt_vis = dt + if (tstep_type==1) then + ! RK2-SSP 3 stage. matches tracer scheme. optimal SSP CFL, but + ! not optimal for regular CFL + ! u1 = u0 + dt/2 RHS(u0) + call compute_and_apply_rhs(np1,n0,n0,dt/2,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w/3,inv_cp_full,qwater) + ! u2 = u1 + dt/2 RHS(u1) + call compute_and_apply_rhs(np1,np1,np1,dt/2,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w/3,inv_cp_full,qwater) + ! u3 = u2 + dt/2 RHS(u2) + call compute_and_apply_rhs(np1,np1,np1,dt/2,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w/3,inv_cp_full,qwater) + + ! unew = u/3 +2*u3/3 = u + 1/3 (RHS(u) + RHS(u1) + RHS(u2)) + do ie=nets,nete + elem(ie)%state%v(:,:,:,:,np1)= elem(ie)%state%v(:,:,:,:,n0)/3 & + + 2*elem(ie)%state%v(:,:,:,:,np1)/3 + elem(ie)%state%T(:,:,:,np1)= elem(ie)%state%T(:,:,:,n0)/3 & + + 2*elem(ie)%state%T(:,:,:,np1)/3 + elem(ie)%state%dp3d(:,:,:,np1)= elem(ie)%state%dp3d(:,:,:,n0)/3 & + + 2*elem(ie)%state%dp3d(:,:,:,np1)/3 + enddo + else if (tstep_type==2) then + ! classic RK3 CFL=sqrt(3) + ! u1 = u0 + dt/3 RHS(u0) + call compute_and_apply_rhs(np1,n0,n0,dt/3,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! u2 = u0 + dt/2 RHS(u1) + call compute_and_apply_rhs(np1,n0,np1,dt/2,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! u3 = u0 + dt RHS(u2) + call compute_and_apply_rhs(np1,n0,np1,dt,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w,inv_cp_full,qwater) + else if (tstep_type==3) then + ! KG 4th order 4 stage: CFL=sqrt(8) + ! low storage version of classic RK4 + ! u1 = u0 + dt/4 RHS(u0) + call compute_and_apply_rhs(np1,n0,n0,dt/4,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! u2 = u0 + dt/3 RHS(u1) + call compute_and_apply_rhs(np1,n0,np1,dt/3,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! u3 = u0 + dt/2 RHS(u2) + call compute_and_apply_rhs(np1,n0,np1,dt/2,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! u4 = u0 + dt RHS(u3) + call compute_and_apply_rhs(np1,n0,np1,dt,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w,inv_cp_full,qwater) + else if (tstep_type==4) then + ! + ! Ullrich 3nd order 5 stage: CFL=sqrt( 4^2 -1) = 3.87 + ! u1 = u0 + dt/5 RHS(u0) (save u1 in timelevel nm1) + ! rhs: t=t + call compute_and_apply_rhs(nm1,n0,n0,dt/5,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w/4,inv_cp_full,qwater) + ! + ! u2 = u0 + dt/5 RHS(u1); rhs: t=t+dt/5 + ! + call compute_and_apply_rhs(np1,n0,nm1,dt/5,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! + ! u3 = u0 + dt/3 RHS(u2); rhs: t=t+2*dt/5 + ! + call compute_and_apply_rhs(np1,n0,np1,dt/3,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! + ! u4 = u0 + 2dt/3 RHS(u3); rhs: t=t+2*dt/5+dt/3 + ! + call compute_and_apply_rhs(np1,n0,np1,2*dt/3,elem,hvcoord,hybrid,& + deriv,nets,nete,0.0_r8,inv_cp_full,qwater) + ! compute (5*u1/4 - u0/4) in timelevel nm1: + do ie=nets,nete + elem(ie)%state%v(:,:,:,:,nm1)= (5*elem(ie)%state%v(:,:,:,:,nm1) & + - elem(ie)%state%v(:,:,:,:,n0) ) /4 + elem(ie)%state%T(:,:,:,nm1)= (5*elem(ie)%state%T(:,:,:,nm1) & + - elem(ie)%state%T(:,:,:,n0) )/4 + elem(ie)%state%dp3d(:,:,:,nm1)= (5*elem(ie)%state%dp3d(:,:,:,nm1) & + - elem(ie)%state%dp3d(:,:,:,n0) )/4 + enddo + ! u5 = (5*u1/4 - u0/4) + 3dt/4 RHS(u4) + ! + ! phl: rhs: t=t+2*dt/5+dt/3+3*dt/4 -wrong RK times ... + ! + call compute_and_apply_rhs(np1,nm1,np1,3*dt/4,elem,hvcoord,hybrid,& + deriv,nets,nete,3*eta_ave_w/4,inv_cp_full,qwater) + ! final method is the same as: + ! u5 = u0 + dt/4 RHS(u0)) + 3dt/4 RHS(u4) + else + call endrun('ERROR: bad choice of tstep_type') + endif + + ! ============================================== + ! Time-split Horizontal diffusion: nu.del^2 or nu.del^4 + ! U(*) = U(t+1) + dt2 * HYPER_DIFF_TERM(t+1) + ! ============================================== + + call t_startf('advance_hypervis') + + ! note:time step computes u(t+1)= u(t*) + RHS. + ! for consistency, dt_vis = t-1 - t*, so this is timestep method dependent + + ! forward-in-time, hypervis applied to dp3d + call advance_hypervis_dp(edge3p1,elem,hybrid,deriv,np1,qn0,nets,nete,dt_vis,eta_ave_w,& + inv_cp_full,hvcoord) + + call t_stopf('advance_hypervis') + + tevolve=tevolve+dt + +#ifdef _OPENMP + call omp_set_nested(.false.) +#endif + + call t_stopf('prim_advance_exp') + end subroutine prim_advance_exp + + + subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_q,nets,nete,nsubstep) + use dimensions_mod, only: np, nc, nlev, qsize, ntrac, nelemd + use element_mod, only: element_t + use time_mod, only: nsplit + use control_mod, only: ftype + use fvm_control_volume_mod, only: fvm_struct, n0_fvm + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) + real (kind=r8), intent(in) :: dt_q + integer, intent(in) :: np1,nets,nete,np1_qdp,nsubstep + + ! local + integer :: i,j,k,ie,q + real (kind=r8) :: v1,dt_local, dt_local_tracer + real (kind=r8) :: dt_local_tracer_fvm + real (kind=r8) :: ftmp(np,np,nlev,qsize,nelemd) !diagnostics + + if (ftype==0) then + ! + ! "Dribble" tendencies: divide total adjustment with nsplit and + ! add adjustments to state after each + ! vertical remap + ! + dt_local = dt_q + dt_local_tracer = dt_q + dt_local_tracer_fvm = dt_q + else if (ftype==1) then + ! + ! CAM-FV-stype forcing, i.e. equivalent to updating state once in the + ! beginning of dynamics + ! + dt_local = nsplit*dt_q + dt_local_tracer = nsplit*dt_q + dt_local_tracer_fvm = nsplit*dt_q + if (nsubstep.ne.1) then + ! + ! do nothing + ! + dt_local = 0.0_r8 + dt_local_tracer = 0.0_r8 + dt_local_tracer_fvm = 0.0_r8 + end if + else if (ftype==2) then + ! + ! do state-update for tracers and "dribbling" forcing for u,v,T + ! + dt_local = dt_q + if (ntrac>0) then + dt_local_tracer = dt_q + dt_local_tracer_fvm = nsplit*dt_q + if (nsubstep.ne.1) then + dt_local_tracer_fvm = 0.0_r8 + end if + else + dt_local_tracer = nsplit*dt_q + dt_local_tracer_fvm = nsplit*dt_q + if (nsubstep.ne.1) then + dt_local_tracer = 0.0_r8 + dt_local_tracer_fvm = 0.0_r8 + end if + end if + end if + + do ie=nets,nete + elem(ie)%state%T(:,:,:,np1) = elem(ie)%state%T(:,:,:,np1) + & + dt_local*elem(ie)%derived%FT(:,:,:) + elem(ie)%state%v(:,:,:,:,np1) = elem(ie)%state%v(:,:,:,:,np1) + & + dt_local*elem(ie)%derived%FM(:,:,:,:) + +#if (defined COLUMN_OPENMP) + !$omp parallel do private(q,k,i,j,v1) +#endif + ! + ! tracers + ! + if (qsize>0.and.dt_local_tracer>0) then + do q=1,qsize + do k=1,nlev + do j=1,np + do i=1,np + ! + ! FQ holds q-tendency: (qnew-qold)/dt_physics + ! + v1 = dt_local_tracer*elem(ie)%derived%FQ(i,j,k,q) + if (elem(ie)%state%Qdp(i,j,k,q,np1_qdp) + v1 < 0 .and. v1<0) then + if (elem(ie)%state%Qdp(i,j,k,q,np1_qdp) < 0 ) then + v1=0 ! Q already negative, dont make it more so + else + v1 = -elem(ie)%state%Qdp(i,j,k,q,np1_qdp) + endif + endif + elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = elem(ie)%state%Qdp(i,j,k,q,np1_qdp)+v1 + ftmp(i,j,k,q,ie) = dt_local_tracer*& + elem(ie)%derived%FQ(i,j,k,q)-v1 !Only used for diagnostics! + enddo + enddo + enddo + enddo + else + ftmp(:,:,:,:,ie) = 0.0_r8 + end if + if (ntrac>0.and.dt_local_tracer_fvm>0) then + ! + ! Repeat for the fvm tracers: fc holds tendency (fc_new-fc_old)/dt_physics + ! + do q = 1, ntrac + do k = 1, nlev + do j = 1, nc + do i = 1, nc + v1 = dt_local_tracer_fvm*fvm(ie)%fc(i,j,k,q)/fvm(ie)%dp_fvm(i,j,k,n0_fvm) + if (fvm(ie)%c(i,j,k,q,n0_fvm) + v1 < 0 .and. v1<0) then + if (fvm(ie)%c(i,j,k,q,n0_fvm) < 0 ) then + v1 = 0 ! C already negative, dont make it more so + else + v1 = -fvm(ie)%c(i,j,k,q,n0_fvm) + end if + end if + fvm(ie)%c(i,j,k,q,n0_fvm) = fvm(ie)%c(i,j,k,q,n0_fvm)+ v1 + end do + end do + end do + end do + end if + end do + call output_qdp_var_dynamics(ftmp(:,:,:,:,:),nets,nete,'PDC') + call calc_tot_energy_dynamics(elem,nets,nete,np1,np1_qdp,'dBD') + end subroutine applyCAMforcing + + subroutine advance_hypervis_dp(edge3,elem,hybrid,deriv,nt,qn0,nets,nete,dt2,eta_ave_w,inv_cp_full,hvcoord) + ! + ! take one timestep of: + ! u(:,:,:,np) = u(:,:,:,np) + dt2*nu*laplacian**order ( u ) + ! T(:,:,:,np) = T(:,:,:,np) + dt2*nu_s*laplacian**order ( T ) + ! + ! + ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace + ! + ! + use dimensions_mod, only: np, np, nlev, nc, ntrac + use dimensions_mod, only: hypervis_on_plevs + use control_mod, only: nu, nu_s, hypervis_subcycle, nu_p, nu_top + use hybrid_mod, only: hybrid_t!, get_loop_ranges + use element_mod, only: element_t + use derivative_mod, only: derivative_t, laplace_sphere_wk, vlaplace_sphere_wk + use derivative_mod, only: subcell_Laplace_fluxes, subcell_dss_fluxes + use edge_mod, only: edgevpack, edgevunpack, edgeDGVunpack + use edgetype_mod, only: EdgeBuffer_t, EdgeDescriptor_t + use bndry_mod, only: bndry_exchange + use viscosity_mod, only: biharmonic_wk_dp3d + use hybvcoord_mod, only: hvcoord_t + + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + type (EdgeBuffer_t), intent(inout):: edge3 + type (derivative_t), intent(in ) :: deriv + integer , intent(in) :: nets,nete, nt, qn0 + real (kind=r8) , intent(in) :: inv_cp_full(np,np,nlev,nets:nete) + type (hvcoord_t) , intent(in) :: hvcoord + real (kind=r8) :: eta_ave_w ! weighting for mean flux terms + real (kind=r8) :: dt2 + + ! local + real (kind=r8) :: nu_scale_top + integer :: k,kptr,i,j,ie,ic + integer :: kbeg, kend, kblk + real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens + real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens + real (kind=r8), dimension(np,np,nlev,nets:nete) :: dptens + real (kind=r8), dimension(np,np,nlev,nets:nete) :: dptens_ref,dp3d_ref + real (kind=r8), dimension(0:np+1,0:np+1,nlev) :: corners + real (kind=r8), dimension(2,2,2) :: cflux + real (kind=r8), dimension(nc,nc,4,nlev,nets:nete) :: dpflux + real (kind=r8), dimension(np,np,nlev) :: nabla4_pk,pk,inv_dpk + type (EdgeDescriptor_t) :: desc + + ! NOTE: PGI compiler bug: when using spheremp, rspheremp and ps as pointers to elem(ie)% members, + ! data is incorrect (offset by a few numbers actually) + ! removed for now. + ! real (kind=r8), dimension(:,:), pointer :: spheremp,rspheremp + ! real (kind=r8), dimension(:,:,:), pointer :: ps + + real (kind=r8), dimension(np,np) :: lap_t,lap_dp + real (kind=r8), dimension(np,np,2) :: lap_v + real (kind=r8) :: v1,v2,dt,heating + real (kind=r8) :: temp (np,np,nlev) + real (kind=r8) :: laplace_fluxes(nc,nc,4) + real (kind=r8) :: tempflux(nc,nc,4) + real (kind=r8) :: rhypervis_subcycle + + if (nu_s == 0 .and. nu == 0 .and. nu_p==0 ) return; + call t_startf('advance_hypervis_dp') + + if (hypervis_on_plevs.and.nu_p>0)& + call calc_dp3d_reference(elem,deriv,edge3p1,hybrid,nets,nete,nt,hvcoord,dp3d_ref) + + ! call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend) + kbeg=1; kend=nlev + + kblk = kend - kbeg + 1 + + dt=dt2/hypervis_subcycle + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! hyper viscosity + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do ic=1,hypervis_subcycle + call calc_tot_energy_dynamics(elem,nets,nete,nt,qn0,'dBH') + + rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) + if (hypervis_on_plevs.and.nu_p>0) then + call biharmonic_wk_dp3d(elem,dptens_ref,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,& + dptens,dp3d_ref) + else + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) + end if + do ie=nets,nete + if (hypervis_on_plevs) then + ! + ! compute \nabla^4 p_k + ! + nabla4_pk(:,:,1) = 0.5_r8*dptens(:,:,1,ie) + do k=2,nlev + nabla4_pk(:,:,k) = nabla4_pk(:,:,k-1)+0.5_r8*dptens(:,:,k-1,ie)+0.5_r8*dptens(:,:,k,ie) + end do + pk(:,:,1) = 0.5_r8*elem(ie)%state%dp3d(:,:,1,nt) + do k=2,nlev + pk(:,:,k) = pk(:,:,k-1)+0.5_r8*elem(ie)%state%dp3d(:,:,k-1,nt)+0.5_r8*elem(ie)%state%dp3d(:,:,k,nt) + end do + inv_dpk(:,:,1) = 1.0_r8/(pk(:,:,2)-pk(:,:,1)) + do k=2,nlev-1 + inv_dpk(:,:,k) = 1.0_r8/(pk(:,:,k+1)-pk(:,:,k-1)) + end do + inv_dpk(:,:,nlev) = 1.0_r8/(pk(:,:,nlev)-pk(:,:,nlev-1)) + do k=1,nlev + ! + ! viscosity on approximate pressure levels (section 3.3.6 in CAM5 scientific documentation; NCAR Tech. Note TN-486) + ! + ttens(:,:,k,ie) = ttens(:,:,k,ie) -nabla4_pk(:,:,k)*(& + inv_dpk(:,:,k)*(elem(ie)%state%T(:,:,MIN(k+1,nlev),nt)-elem(ie)%state%T(:,:,MAX(k-1,1),nt))) + ! vtens(:,:,1,k,ie) = vtens(:,:,1,k,ie) -nabla4_pk(:,:,k)*(& + ! inv_dpk(:,:,k)*(elem(ie)%state%v(:,:,1,MIN(k+1,nlev),nt)-elem(ie)%state%v(:,:,1,MAX(k-1,1),nt))) + ! vtens(:,:,2,k,ie) = vtens(:,:,2,k,ie) -nabla4_pk(:,:,k)*(& + ! inv_dpk(:,:,k)*(elem(ie)%state%v(:,:,2,MIN(k+1,nlev),nt)-elem(ie)%state%v(:,:,2,MAX(k-1,1),nt))) + end do + if (nu_p>0) dptens(:,:,:,ie) = dptens_ref(:,:,:,ie) !pressure damping will only be on difference between smoothed dp3d and dp3d + endif! done correction term + + ! compute mean flux + if (nu_p>0) then + do k=kbeg,kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%derived%dpdiss_ave(i,j,k)=elem(ie)%derived%dpdiss_ave(i,j,k)+& + rhypervis_subcycle*eta_ave_w*elem(ie)%state%dp3d(i,j,k,nt) + elem(ie)%derived%dpdiss_biharmonic(i,j,k)=elem(ie)%derived%dpdiss_biharmonic(i,j,k)+& + rhypervis_subcycle*eta_ave_w*dptens(i,j,k,ie) + enddo + enddo + enddo + endif + !$omp parallel do num_threads(vert_num_threads) private(lap_t,lap_dp,lap_v,laplace_fluxes,nu_scale_top) + do k=kbeg,kend + ! advace in time. + ! note: DSS commutes with time stepping, so we can time advance and then DSS. + ! note: weak operators alreayd have mass matrix "included" + + ! add regular diffusion in top 3 layers: + if (nu_top>0 .and. k<=3) then + call laplace_sphere_wk(elem(ie)%state%T(:,:,k,nt),deriv,elem(ie),lap_t,var_coef=.false.) + call laplace_sphere_wk(elem(ie)%state%dp3d(:,:,k,nt),deriv,elem(ie),lap_dp,var_coef=.false.) + call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),lap_v, var_coef=.false.) + endif + nu_scale_top = 1 + if (k==1) nu_scale_top=4 + if (k==2) nu_scale_top=2 + + ! biharmonic terms need a negative sign: + if (nu_top>0 .and. k<=3) then + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ttens(i,j,k,ie) = (-nu_s*ttens(i,j,k,ie) + nu_scale_top*nu_top*lap_t(i,j) ) + dptens(i,j,k,ie) = (-nu_p*dptens(i,j,k,ie) + nu_scale_top*nu_top*lap_dp(i,j) ) + vtens(i,j,1,k,ie) = (-nu*vtens(i,j,1,k,ie) + nu_scale_top*nu_top*lap_v(i,j,1)) + vtens(i,j,2,k,ie) = (-nu*vtens(i,j,2,k,ie) + nu_scale_top*nu_top*lap_v(i,j,2)) + enddo + enddo + else + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ttens(i,j,k,ie) = -nu_s*ttens(i,j,k,ie) + dptens(i,j,k,ie) = -nu_p*dptens(i,j,k,ie) + vtens(i,j,1,k,ie) = -nu*vtens(i,j,1,k,ie) + vtens(i,j,2,k,ie) = -nu*vtens(i,j,2,k,ie) + enddo + enddo + endif + + if (ntrac>0) then + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,nc + do i=1,nc + elem(ie)%sub_elem_mass_flux(i,j,:,k) = elem(ie)%sub_elem_mass_flux(i,j,:,k) - & + rhypervis_subcycle*eta_ave_w*nu_p*dpflux(i,j,:,k,ie) + enddo + enddo + if (nu_top>0 .and. k<=3) then + call subcell_Laplace_fluxes(elem(ie)%state%dp3d(:,:,k,nt),deriv,elem(ie),np,nc,laplace_fluxes) + elem(ie)%sub_elem_mass_flux(:,:,:,k) = elem(ie)%sub_elem_mass_flux(:,:,:,k) + & + rhypervis_subcycle*eta_ave_w*nu_scale_top*nu_top*laplace_fluxes + endif + endif + + ! NOTE: we will DSS all tendicies, EXCEPT for dp3d, where we DSS the new state + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%dp3d(i,j,k,nt) = elem(ie)%state%dp3d(i,j,k,nt)*elem(ie)%spheremp(i,j)& + + dt*dptens(i,j,k,ie) + enddo + enddo + + enddo + + kptr = kbeg - 1 + call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + nlev + call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 2*nlev + call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 3*nlev + call edgeVpack(edge3,elem(ie)%state%dp3d(:,:,kbeg:kend,nt),kblk,kptr,ie) + enddo + + call bndry_exchange(hybrid,edge3,location='advance_hypervis_dp2') + + do ie=nets,nete + + kptr = kbeg - 1 + call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + nlev + call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 2*nlev + call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + if (ntrac>0) then + do k=kbeg,kend + temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS + corners(0:np+1,0:np+1,k) = 0.0_r8 + corners(1:np ,1:np ,k) = elem(ie)%state%dp3d(1:np,1:np,k,nt) ! fill in interior data of STATE*mass + enddo + endif + kptr = kbeg - 1 + 3*nlev + call edgeVunpack(edge3,elem(ie)%state%dp3d(:,:,kbeg:kend,nt),kblk,kptr,ie) + + if (ntrac>0) then + desc = elem(ie)%desc + + kptr = kbeg - 1 + 3*nlev + call edgeDGVunpack(edge3,corners(:,:,kbeg:kend),kblk,kptr,ie) + do k=kbeg,kend + corners(:,:,k) = corners(:,:,k)/dt !note: array size is 0:np+1 + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + temp(i,j,k) = elem(ie)%rspheremp(i,j)*elem(ie)%state%dp3d(i,j,k,nt) - temp(i,j,k) + temp(i,j,k) = temp(i,j,k)/dt + enddo + enddo + + call distribute_flux_at_corners(cflux, corners(:,:,k), desc%getmapP) + + cflux(1,1,:) = elem(ie)%rspheremp(1, 1) * cflux(1,1,:) + cflux(2,1,:) = elem(ie)%rspheremp(np, 1) * cflux(2,1,:) + cflux(1,2,:) = elem(ie)%rspheremp(1, np) * cflux(1,2,:) + cflux(2,2,:) = elem(ie)%rspheremp(np,np) * cflux(2,2,:) + + call subcell_dss_fluxes(temp(:,:,k), np, nc, elem(ie)%metdet,cflux,tempflux) + elem(ie)%sub_elem_mass_flux(:,:,:,k) = elem(ie)%sub_elem_mass_flux(:,:,:,k) + & + rhypervis_subcycle*eta_ave_w*tempflux + end do + endif + + ! apply inverse mass matrix, accumulate tendencies + !$omp parallel do num_threads(vert_num_threads) + do k=kbeg,kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + vtens(i,j,1,k,ie)=dt*vtens(i,j,1,k,ie)*elem(ie)%rspheremp(i,j) + vtens(i,j,2,k,ie)=dt*vtens(i,j,2,k,ie)*elem(ie)%rspheremp(i,j) + ttens(i,j,k,ie)=dt*ttens(i,j,k,ie)*elem(ie)%rspheremp(i,j) + elem(ie)%state%dp3d(i,j,k,nt)=elem(ie)%state%dp3d(i,j,k,nt)*elem(ie)%rspheremp(i,j) + enddo + enddo + enddo + + ! apply hypervis to u -> u+utens: + ! E0 = dpdn * .5*u dot u + dpdn * T + dpdn*PHIS + ! E1 = dpdn * .5*(u+utens) dot (u+utens) + dpdn * (T-X) + dpdn*PHIS + ! E1-E0: dpdn (u dot utens) + dpdn .5 utens dot utens - dpdn X + ! X = (u dot utens) + .5 utens dot utens + ! alt: (u+utens) dot utens + !$omp parallel do num_threads(vert_num_threads) private(k,i,j) + do k=kbeg,kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ! update v first (gives better results than updating v after heating) + elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & + vtens(i,j,:,k,ie) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + +ttens(i,j,k,ie) + enddo + enddo + enddo + end do + + call calc_tot_energy_dynamics(elem,nets,nete,nt,qn0,'dCH') + do ie=nets,nete + !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) + do k=kbeg,kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1=elem(ie)%state%v(i,j,1,k,nt) + v2=elem(ie)%state%v(i,j,2,k,nt) + heating = (vtens(i,j,1,k,ie)*v1 + vtens(i,j,2,k,ie)*v2 ) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + -heating*inv_cp_full(i,j,k,ie) + enddo + enddo + enddo + enddo + + call calc_tot_energy_dynamics(elem,nets,nete,nt,qn0,'dAH') + enddo + + call t_stopf('advance_hypervis_dp') + end subroutine advance_hypervis_dp + + subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& + deriv,nets,nete,eta_ave_w,inv_cp_full,qwater) + ! =================================== + ! compute the RHS, accumulate into u(np1) and apply DSS + ! + ! u(np1) = u(nm1) + dt2*DSS[ RHS(u(n0)) ] + ! + ! This subroutine is normally called to compute a leapfrog timestep + ! but by adjusting np1,nm1,n0 and dt2, many other timesteps can be + ! accomodated. For example, setting nm1=np1=n0 this routine will + ! take a forward euler step, overwriting the input with the output. + ! + ! if dt2<0, then the DSS'd RHS is returned in timelevel np1 + ! + ! Combining the RHS and DSS pack operation in one routine + ! allows us to fuse these two loops for more cache reuse + ! + ! Combining the dt advance and DSS unpack operation in one routine + ! allows us to fuse these two loops for more cache reuse + ! + ! note: for prescribed velocity case, velocity will be computed at + ! "real_time", which should be the time of timelevel n0. + ! + ! + ! =================================== + use dimensions_mod, only: np, nc, nlev + use dimensions_mod, only: qsize_condensate_loading, ntrac + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use derivative_mod, only: derivative_t, divergence_sphere, gradient_sphere, vorticity_sphere + use derivative_mod, only: subcell_div_fluxes, subcell_dss_fluxes + use edge_mod, only: edgevpack, edgevunpack, edgeDGVunpack + use edgetype_mod, only: edgedescriptor_t + use bndry_mod, only: bndry_exchange + use hybvcoord_mod, only: hvcoord_t + use physconst, only: rair, epsilo + use prim_si_mod, only: preq_hydrostatic + use control_mod, only: se_met_nudge_u, se_met_nudge_p, se_met_nudge_t, se_met_tevolve + + use time_mod, only : tevolve + + implicit none + integer, intent(in) :: np1,nm1,n0,nets,nete + real (kind=r8), intent(in) :: dt2 + + type (hvcoord_t) , intent(in) :: hvcoord + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + type (derivative_t) , intent(in) :: deriv + real (kind=r8) , intent(in) :: inv_cp_full(np,np,nlev,nets:nete) + real (kind=r8) , intent(in) :: qwater(np,np,nlev,qsize_condensate_loading,nets:nete) + + real (kind=r8) :: eta_ave_w ! weighting for eta_dot_dpdn mean flux + + ! local + real (kind=r8), pointer, dimension(:,:,:) :: phi + real (kind=r8), dimension(np,np,nlev) :: omega_full + real (kind=r8), dimension(np,np,nlev) :: divdp_dry + real (kind=r8), dimension(np,np,nlev) :: divdp_full + real (kind=r8), dimension(np,np,2) :: vtemp + real (kind=r8), dimension(np,np,2,nlev) :: vdp_dry + real (kind=r8), dimension(np,np,2,nlev) :: vdp_full + real (kind=r8), dimension(np,np,nlev) :: vgrad_p_full + real (kind=r8), dimension(np,np,2 ) :: v ! + real (kind=r8), dimension(np,np) :: vgrad_T ! v.grad(T) + real (kind=r8), dimension(np,np) :: Ephi ! kinetic energy + PHI term + real (kind=r8), dimension(np,np,2,nlev) :: grad_p_full + real (kind=r8), dimension(np,np,2,nlev) :: grad_p_m_pmet! gradient(p - p_met) + real (kind=r8), dimension(np,np,nlev) :: vort ! vorticity + real (kind=r8), dimension(np,np,nlev) :: p_dry ! pressure dry + real (kind=r8), dimension(np,np,nlev) :: dp_dry ! delta pressure dry + real (kind=r8), dimension(np,np,nlev) :: p_full ! pressure + real (kind=r8), dimension(np,np,nlev) :: dp_full ! delta pressure + real (kind=r8), dimension(0:np+1,0:np+1,nlev) :: corners + real (kind=r8), dimension(2,2,2) :: cflux + real (kind=r8), dimension(np,np) :: suml + real (kind=r8) :: vtens1(np,np,nlev),vtens2(np,np,nlev),ttens(np,np,nlev) + real (kind=r8) :: stashdp3d (np,np,nlev),tempdp3d(np,np), tempflux(nc,nc,4) + real (kind=r8) :: inv_epsilon, ckk, term, T_v(np,np,nlev) + + type (EdgeDescriptor_t):: desc + + real (kind=r8) :: sum_water(np,np,nlev), density_inv + real (kind=r8) :: E,v1,v2,glnps1,glnps2 + integer :: i,j,k,kptr,ie,nq + real (kind=r8) :: u_m_umet, v_m_vmet, t_m_tmet + +!JMD call t_barrierf('sync_compute_and_apply_rhs', hybrid%par%comm) + inv_epsilon = 1/Epsilo + call t_adj_detailf(+1) + call t_startf('compute_and_apply_rhs') + do ie=nets,nete + !ps => elem(ie)%state%psdry(:,:,n0) + phi => elem(ie)%derived%phi(:,:,:) + + ! ================================================== + ! compute pressure (p) on half levels from ps + ! using the hybrid coordinates relationship, i.e. + ! e.g. equation (3.a.92) of the CCM-2 description, + ! (NCAR/TN-382+STR), June 1993, p. 24. + ! ================================================== + + ! ============================ + ! compute p and delta p + ! ============================ + + do k=1,nlev + ! vertically lagrangian code: we advect dp3d instead of ps + ! we also need grad(p) at all levels (not just grad(ps)) + !p(k)= hyam(k)*ps0 + hybm(k)*ps + ! = .5_r8*(hyai(k+1)+hyai(k))*ps0 + .5_r8*(hybi(k+1)+hybi(k))*ps + ! = .5_r8*(ph(k+1) + ph(k) ) = ph(k) + dp(k)/2 + ! + ! p(k+1)-p(k) = ph(k+1)-ph(k) + (dp(k+1)-dp(k))/2 + ! = dp(k) + (dp(k+1)-dp(k))/2 = (dp(k+1)+dp(k))/2 + dp_dry(:,:,k) = elem(ie)%state%dp3d(:,:,k,n0) + if (k==1) then + p_dry(:,:,k)=hvcoord%hyai(k)*hvcoord%ps0 + dp_dry(:,:,k)/2 + else + p_dry(:,:,k)=p_dry(:,:,k-1) + dp_dry(:,:,k-1)/2 + dp_dry(:,:,k)/2 + endif + ! + ! compute virtual temperature + ! + sum_water(:,:,k) = 1.0_r8 + do nq=1,qsize_condensate_loading + sum_water(:,:,k) = sum_water(:,:,k) + qwater(:,:,k,nq,ie) + end do + do j=1,np + do i=1,np + t_v(i,j,k) = elem(ie)%state%T(i,j,k,n0)*(1+inv_epsilon*qwater(i,j,k,1,ie))/sum_water(i,j,k) + end do + end do + ! + ! convert to gas pressure (dry + water vapor pressure) + ! (assumes T and q are constant in the layer) + ! + dp_full(:,:,k)=sum_water(:,:,k)*dp_dry(:,:,k) + if (k==1) then + p_full(:,:,k) = hvcoord%hyai(k)*hvcoord%ps0 + dp_full(:,:,k)/2 + else + p_full(:,:,k)=p_full(:,:,k-1) + dp_full(:,:,k-1)/2 + dp_full(:,:,k)/2 + endif + call gradient_sphere(p_full(:,:,k),deriv,elem(ie)%Dinv,grad_p_full(:,:,:,k)) + + + ! ============================== + ! compute vgrad_lnps - for omega_full + ! ============================== + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + vgrad_p_full(i,j,k) = (v1*grad_p_full(i,j,1,k) + v2*grad_p_full(i,j,2,k)) + vdp_dry(i,j,1,k) = v1*dp_dry(i,j,k) + vdp_dry(i,j,2,k) = v2*dp_dry(i,j,k) + vdp_full(i,j,1,k) = v1*dp_full(i,j,k) + vdp_full(i,j,2,k) = v2*dp_full(i,j,k) + end do + end do + ! ============================ + ! compute grad(P-P_met) + ! ============================ + if (se_met_nudge_p.gt.0._r8) then + suml(:,:) = elem(ie)%derived%ps_met(:,:)+tevolve*elem(ie)%derived%dpsdt_met(:,:) + call gradient_sphere(suml,deriv,elem(ie)%Dinv,vtemp) + grad_p_m_pmet(:,:,:,k) = grad_p_full(:,:,:,k) - hvcoord%hybm(k)*vtemp + endif + ! ================================ + ! Accumulate mean Vel_rho flux in vn0 + ! ================================ + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%derived%vn0(i,j,1,k)=elem(ie)%derived%vn0(i,j,1,k)+eta_ave_w*vdp_dry(i,j,1,k) + elem(ie)%derived%vn0(i,j,2,k)=elem(ie)%derived%vn0(i,j,2,k)+eta_ave_w*vdp_dry(i,j,2,k) + enddo + enddo + !divdp_dry(:,:,k) + ! ========================================= + ! + ! Compute relative vorticity and divergence + ! + ! ========================================= + call divergence_sphere(vdp_dry(:,:,:,k),deriv,elem(ie),divdp_dry(:,:,k)) + call divergence_sphere(vdp_full(:,:,:,k),deriv,elem(ie),divdp_full(:,:,k)) + call vorticity_sphere(elem(ie)%state%v(:,:,:,k,n0),deriv,elem(ie),vort(:,:,k)) + enddo + + ! compute T_v for timelevel n0 +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k,i,j) +#endif + ! + ! ==================================================== + ! Compute Hydrostatic equation, modelled after CCM-3 + ! ==================================================== + call preq_hydrostatic(phi,elem(ie)%state%phis,T_v,p_full,dp_full) + ! ==================================================== + ! Compute omega_full + ! ==================================================== +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k,j,i,ckk,term) +#endif + ckk = 0.5_r8 + suml(:,: ) = 0 + do k=1,nlev + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np ! Loop inversion (AAM) + do i=1,np + term = -divdp_full(i,j,k) + + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + + omega_full(i,j,k) = suml(i,j) + ckk*term+vgrad_p_full(i,j,k) + suml(i,j) = suml(i,j) + term + end do + end do + end do +#if (defined COLUMN_OPENMP) + !$omp parallel do private(k) +#endif + do k=1,nlev ! Loop index added (AAM) + elem(ie)%derived%omega(:,:,k) = & + elem(ie)%derived%omega(:,:,k) + eta_ave_w*omega_full(:,:,k) + enddo + ! ============================================== + ! Compute phi + kinetic energy term: 10*nv*nv Flops + ! ============================================== +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k,i,j,v1,v2,E,Ephi,vtemp,vgrad_T,gpterm,glnps1,glnps2) +#endif + vertloop: do k=1,nlev + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + E = 0.5_r8*( v1*v1 + v2*v2 ) + Ephi(i,j)=E+phi(i,j,k) + end do + end do + ! ================================================ + ! compute gradp term (ps/p)*(dp/dps)*T + ! ================================================ + call gradient_sphere(elem(ie)%state%T(:,:,k,n0),deriv,elem(ie)%Dinv,vtemp) + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + vgrad_T(i,j) = v1*vtemp(i,j,1) + v2*vtemp(i,j,2) + end do + end do + + + ! vtemp = grad ( E + PHI ) + ! vtemp = gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv) + call gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv,vtemp) + + do j=1,np + do i=1,np + density_inv = Rair*T_v(i,j,k)/p_full(i,j,k) + + glnps1 = density_inv*grad_p_full(i,j,1,k) + glnps2 = density_inv*grad_p_full(i,j,2,k) + + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + + vtens1(i,j,k) = & + + v2*(elem(ie)%fcor(i,j) + vort(i,j,k)) & + - vtemp(i,j,1) - glnps1 + + vtens2(i,j,k) = & + - v1*(elem(ie)%fcor(i,j) + vort(i,j,k)) & + - vtemp(i,j,2) - glnps2 + ttens(i,j,k) = - vgrad_T(i,j) + & + density_inv*omega_full(i,j,k)*inv_cp_full(i,j,k,ie) + + if (se_prescribed_wind_2d) then + vtens1(i,j,k) = 0._r8 + vtens2(i,j,k) = 0._r8 + ttens(i,j,k) = 0._r8 + else + if(se_met_nudge_u.gt.0._r8)then + u_m_umet = v1 - & + elem(ie)%derived%u_met(i,j,k) - & + se_met_tevolve*tevolve*elem(ie)%derived%dudt_met(i,j,k) + v_m_vmet = v2 - & + elem(ie)%derived%v_met(i,j,k) - & + se_met_tevolve*tevolve*elem(ie)%derived%dvdt_met(i,j,k) + + vtens1(i,j,k) = vtens1(i,j,k) - se_met_nudge_u*u_m_umet * elem(ie)%derived%nudge_factor(i,j,k) + + elem(ie)%derived%Utnd(i+(j-1)*np,k) = elem(ie)%derived%Utnd(i+(j-1)*np,k) & + + se_met_nudge_u*u_m_umet * elem(ie)%derived%nudge_factor(i,j,k) + + vtens2(i,j,k) = vtens2(i,j,k) - se_met_nudge_u*v_m_vmet * elem(ie)%derived%nudge_factor(i,j,k) + + elem(ie)%derived%Vtnd(i+(j-1)*np,k) = elem(ie)%derived%Vtnd(i+(j-1)*np,k) & + + se_met_nudge_u*v_m_vmet * elem(ie)%derived%nudge_factor(i,j,k) + + endif + + if(se_met_nudge_p.gt.0._r8)then + vtens1(i,j,k) = vtens1(i,j,k) - se_met_nudge_p*grad_p_m_pmet(i,j,1,k) * elem(ie)%derived%nudge_factor(i,j,k) + vtens2(i,j,k) = vtens2(i,j,k) - se_met_nudge_p*grad_p_m_pmet(i,j,2,k) * elem(ie)%derived%nudge_factor(i,j,k) + endif + + if(se_met_nudge_t.gt.0._r8)then + t_m_tmet = elem(ie)%state%T(i,j,k,n0) - & + elem(ie)%derived%T_met(i,j,k) - & + se_met_tevolve*tevolve*elem(ie)%derived%dTdt_met(i,j,k) + ttens(i,j,k) = ttens(i,j,k) - se_met_nudge_t*t_m_tmet * elem(ie)%derived%nudge_factor(i,j,k) + elem(ie)%derived%Ttnd(i+(j-1)*np,k) = elem(ie)%derived%Ttnd(i+(j-1)*np,k) & + + se_met_nudge_t*t_m_tmet * elem(ie)%derived%nudge_factor(i,j,k) + endif + endif + + end do + end do + + end do vertloop + + ! ========================================================= + ! local element timestep, store in np1. + ! note that we allow np1=n0 or nm1 + ! apply mass matrix + ! ========================================================= +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%v(i,j,1,k,np1) = elem(ie)%spheremp(i,j)*( elem(ie)%state%v(i,j,1,k,nm1) + dt2*vtens1(i,j,k) ) + elem(ie)%state%v(i,j,2,k,np1) = elem(ie)%spheremp(i,j)*( elem(ie)%state%v(i,j,2,k,nm1) + dt2*vtens2(i,j,k) ) + elem(ie)%state%T(i,j,k,np1) = elem(ie)%spheremp(i,j)*(elem(ie)%state%T(i,j,k,nm1) + dt2*ttens(i,j,k)) + elem(ie)%state%dp3d(i,j,k,np1) = & + elem(ie)%spheremp(i,j) * (elem(ie)%state%dp3d(i,j,k,nm1) - & + dt2 * (divdp_dry(i,j,k))) + enddo + enddo + + + if (ntrac>0.and.eta_ave_w.ne.0._r8) then + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v(i,j,1) = elem(ie)%Dinv(i,j,1,1)*vdp_dry(i,j,1,k) + elem(ie)%Dinv(i,j,1,2)*vdp_dry(i,j,2,k) + v(i,j,2) = elem(ie)%Dinv(i,j,2,1)*vdp_dry(i,j,1,k) + elem(ie)%Dinv(i,j,2,2)*vdp_dry(i,j,2,k) + enddo + enddo + call subcell_div_fluxes(v, np, nc, elem(ie)%metdet,tempflux) + elem(ie)%sub_elem_mass_flux(:,:,:,k) = elem(ie)%sub_elem_mass_flux(:,:,:,k) - eta_ave_w*tempflux + end if + enddo + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%psdry(i,j,np1) = elem(ie)%spheremp(i,j)*( elem(ie)%state%psdry(i,j,nm1)) + enddo + enddo + + + + ! ========================================================= + ! + ! Pack + ! + ! ========================================================= + kptr=0 + call edgeVpack(edge3p1, elem(ie)%state%psdry(:,:,np1),1,kptr,ie) + + kptr=1 + call edgeVpack(edge3p1, elem(ie)%state%T(:,:,:,np1),nlev,kptr,ie) + + kptr=nlev+1 + call edgeVpack(edge3p1, elem(ie)%state%v(:,:,:,:,np1),2*nlev,kptr,ie) + + kptr=kptr+2*nlev + call edgeVpack(edge3p1, elem(ie)%state%dp3d(:,:,:,np1),nlev,kptr, ie) + end do + + ! ============================================================= + ! Insert communications here: for shared memory, just a single + ! sync is required + ! ============================================================= + call bndry_exchange(hybrid,edge3p1) + do ie=nets,nete + ! =========================================================== + ! Unpack the edges for vgrad_T and v tendencies... + ! =========================================================== + kptr=0 + call edgeVunpack(edge3p1, elem(ie)%state%psdry(:,:,np1), 1, kptr, ie) + + kptr=1 + call edgeVunpack(edge3p1, elem(ie)%state%T(:,:,:,np1), nlev, kptr, ie) + + kptr=nlev+1 + call edgeVunpack(edge3p1, elem(ie)%state%v(:,:,:,:,np1), 2*nlev, kptr, ie) + + if (ntrac>0.and.eta_ave_w.ne.0._r8) then + do k=1,nlev + stashdp3d(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1)/elem(ie)%spheremp(:,:) + end do + endif + + corners = 0.0_r8 + corners(1:np,1:np,:) = elem(ie)%state%dp3d(:,:,:,np1) + kptr=kptr+2*nlev + call edgeVunpack(edge3p1, elem(ie)%state%dp3d(:,:,:,np1),nlev,kptr,ie) + + if (ntrac>0.and.eta_ave_w.ne.0._r8) then + desc = elem(ie)%desc + + call edgeDGVunpack(edge3p1, corners, nlev, kptr, ie) + + corners = corners/dt2 + + do k=1,nlev + tempdp3d = elem(ie)%rspheremp(:,:)*elem(ie)%state%dp3d(:,:,k,np1) + tempdp3d = tempdp3d - stashdp3d(:,:,k) + tempdp3d = tempdp3d/dt2 + + call distribute_flux_at_corners(cflux, corners(:,:,k), desc%getmapP) + + cflux(1,1,:) = elem(ie)%rspheremp(1, 1) * cflux(1,1,:) + cflux(2,1,:) = elem(ie)%rspheremp(np, 1) * cflux(2,1,:) + cflux(1,2,:) = elem(ie)%rspheremp(1, np) * cflux(1,2,:) + cflux(2,2,:) = elem(ie)%rspheremp(np,np) * cflux(2,2,:) + + call subcell_dss_fluxes(tempdp3d, np, nc, elem(ie)%metdet, cflux,tempflux) + elem(ie)%sub_elem_mass_flux(:,:,:,k) = elem(ie)%sub_elem_mass_flux(:,:,:,k) + eta_ave_w*tempflux + end do + end if + + ! ==================================================== + ! Scale tendencies by inverse mass matrix + ! ==================================================== + +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%T(i,j,k,np1) = elem(ie)%rspheremp(i,j)*elem(ie)%state%T(i,j,k,np1) + elem(ie)%state%v(i,j,1,k,np1) = elem(ie)%rspheremp(i,j)*elem(ie)%state%v(i,j,1,k,np1) + elem(ie)%state%v(i,j,2,k,np1) = elem(ie)%rspheremp(i,j)*elem(ie)%state%v(i,j,2,k,np1) + enddo + enddo + end do + + ! vertically lagrangian: complete dp3d timestep: + do k=1,nlev + elem(ie)%state%dp3d(:,:,k,np1)= elem(ie)%rspheremp(:,:)*elem(ie)%state%dp3d(:,:,k,np1) + enddo + end do + +#ifdef DEBUGOMP +#if (defined HORIZ_OPENMP) +!$OMP BARRIER +#endif +#endif + call t_stopf('compute_and_apply_rhs') + call t_adj_detailf(-1) + end subroutine compute_and_apply_rhs + + + ! + ! corner fluxes for CSLAM + ! + subroutine distribute_flux_at_corners(cflux, corners, getmapP) + use dimensions_mod, only : np, max_corner_elem + use control_mod, only : swest + + real(r8), intent(out) :: cflux(2,2,2) + real(r8), intent(in) :: corners(0:np+1,0:np+1) + integer, intent(in) :: getmapP(:) + + cflux = 0.0_r8 + if (getmapP(swest+0*max_corner_elem) /= -1) then + cflux(1,1,1) = (corners(0,1) - corners(1,1)) + cflux(1,1,1) = cflux(1,1,1) + (corners(0,0) - corners(1,1)) / 2.0_r8 + cflux(1,1,1) = cflux(1,1,1) + (corners(0,1) - corners(1,0)) / 2.0_r8 + + cflux(1,1,2) = (corners(1,0) - corners(1,1)) + cflux(1,1,2) = cflux(1,1,2) + (corners(0,0) - corners(1,1)) / 2.0_r8 + cflux(1,1,2) = cflux(1,1,2) + (corners(1,0) - corners(0,1)) / 2.0_r8 + else + cflux(1,1,1) = (corners(0,1) - corners(1,1)) + cflux(1,1,2) = (corners(1,0) - corners(1,1)) + endif + + if (getmapP(swest+1*max_corner_elem) /= -1) then + cflux(2,1,1) = (corners(np+1,1) - corners(np,1)) + cflux(2,1,1) = cflux(2,1,1) + (corners(np+1,0) - corners(np,1)) / 2.0_r8 + cflux(2,1,1) = cflux(2,1,1) + (corners(np+1,1) - corners(np,0)) / 2.0_r8 + + cflux(2,1,2) = (corners(np ,0) - corners(np, 1)) + cflux(2,1,2) = cflux(2,1,2) + (corners(np+1,0) - corners(np, 1)) / 2.0_r8 + cflux(2,1,2) = cflux(2,1,2) + (corners(np ,0) - corners(np+1,1)) / 2.0_r8 + else + cflux(2,1,1) = (corners(np+1,1) - corners(np,1)) + cflux(2,1,2) = (corners(np ,0) - corners(np,1)) + endif + + if (getmapP(swest+2*max_corner_elem) /= -1) then + cflux(1,2,1) = (corners(0,np ) - corners(1,np )) + cflux(1,2,1) = cflux(1,2,1) + (corners(0,np+1) - corners(1,np )) / 2.0_r8 + cflux(1,2,1) = cflux(1,2,1) + (corners(0,np ) - corners(1,np+1)) / 2.0_r8 + + cflux(1,2,2) = (corners(1,np+1) - corners(1,np )) + cflux(1,2,2) = cflux(1,2,2) + (corners(0,np+1) - corners(1,np )) / 2.0_r8 + cflux(1,2,2) = cflux(1,2,2) + (corners(1,np+1) - corners(0,np )) / 2.0_r8 + else + cflux(1,2,1) = (corners(0,np ) - corners(1,np )) + cflux(1,2,2) = (corners(1,np+1) - corners(1,np )) + endif + + if (getmapP(swest+3*max_corner_elem) /= -1) then + cflux(2,2,1) = (corners(np+1,np ) - corners(np,np )) + cflux(2,2,1) = cflux(2,2,1) + (corners(np+1,np+1) - corners(np,np )) / 2.0_r8 + cflux(2,2,1) = cflux(2,2,1) + (corners(np+1,np ) - corners(np,np+1)) / 2.0_r8 + + cflux(2,2,2) = (corners(np ,np+1) - corners(np,np )) + cflux(2,2,2) = cflux(2,2,2) + (corners(np+1,np+1) - corners(np,np )) / 2.0_r8 + cflux(2,2,2) = cflux(2,2,2) + (corners(np ,np+1) - corners(np+1,np)) / 2.0_r8 + else + cflux(2,2,1) = (corners(np+1,np ) - corners(np,np )) + cflux(2,2,2) = (corners(np ,np+1) - corners(np,np )) + endif + end subroutine distribute_flux_at_corners + + + subroutine calc_tot_energy_dynamics(elem,nets,nete,tl,tl_qdp,outfld_name_suffix) + use dimensions_mod, only: npsq,nlev,np,lcp_moist + use dimensions_mod, only: qsize_condensate_loading, qsize_condensate_loading_cp + use dimensions_mod, only: qsize_condensate_loading_idx_gll + use physconst, only: gravit, cpair, rearth,omega + use element_mod, only: element_t + use cam_history, only: outfld, hist_fld_active + use constituents, only: cnst_get_ind + use hycoef, only: hyai, ps0 +! use fvm_control_volume_mod, only: fvm_struct + use control_mod, only: TRACERTRANSPORT_SE_GLL, tracer_transport_type + + !------------------------------Arguments-------------------------------- + + type (element_t) , intent(in) :: elem(:) + integer , intent(in) :: tl, tl_qdp,nets,nete!, n_fvm + character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names + + !---------------------------Local storage------------------------------- + + real(kind=r8) :: se(npsq) ! Dry Static energy (J/m2) + real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) + real(kind=r8) :: wv(npsq) ! column integrated vapor (kg/m2) + real(kind=r8) :: wl(npsq) ! column integrated liquid (kg/m2) + real(kind=r8) :: wi(npsq) ! column integrated ice (kg/m2) + real(kind=r8) :: tt(npsq) ! column integrated test tracer (kg/m2) + real(kind=r8) :: se_tmp + real(kind=r8) :: ke_tmp + real(kind=r8) :: wv_tmp + real(kind=r8) :: wl_tmp + real(kind=r8) :: wi_tmp + real(kind=r8) :: tt_tmp + real(kind=r8) :: ps(np,np) + real(kind=r8) :: pdel + ! + ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion + ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) + ! associated with the angular velocity OMEGA (2*pi/d, where d is the length of the day) of the planet + ! (also known as mass AAM) + ! + real(kind=r8) :: mr(npsq) ! wind AAM + real(kind=r8) :: mo(npsq) ! mass AAM + real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp + + integer :: ie,i,j,k,nq,m_cnst + integer :: ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices + character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + + !----------------------------------------------------------------------- + + name_out1 = 'SE_' //trim(outfld_name_suffix) + name_out2 = 'KE_' //trim(outfld_name_suffix) + name_out3 = 'WV_' //trim(outfld_name_suffix) + name_out4 = 'WL_' //trim(outfld_name_suffix) + name_out5 = 'WI_' //trim(outfld_name_suffix) + name_out6 = 'TT_' //trim(outfld_name_suffix) + + if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& + hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + if (qsize_condensate_loading>1) then + ixcldliq = qsize_condensate_loading_idx_gll(2) + ixcldice = qsize_condensate_loading_idx_gll(3) + else + ixcldliq = -1 + ixcldice = -1 + end if + if (tracer_transport_type == TRACERTRANSPORT_SE_GLL) then + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + else + ixtt = -1 + end if + ! + ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid + ! + do ie=nets,nete + se = 0.0_r8 + ke = 0.0_r8 + wv = 0.0_r8 + wl = 0.0_r8 + wi = 0.0_r8 + tt = 0.0_r8 + + ps(:,:) = hyai(1)*ps0 + do k = 1, nlev + do j=1,np + do i = 1, np + pdel = elem(ie)%state%dp3d(i,j,k,tl) + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + pdel = pdel + elem(ie)%state%qdp(i,j,k,m_cnst,tl_qdp) + end do + ps(i,j) = ps(i,j)+pdel + ! + ! kinetic energy + ! + ke_tmp = 0.5_r8*(elem(ie)%state%v(i,j,1,k,tl)**2+ elem(ie)%state%v(i,j,2,k,tl)**2)*pdel/gravit + if (lcp_moist) then + ! + ! Internal energy formula including all condensates and corresponding heat capacities + ! + se_tmp = cpair*elem(ie)%state%dp3d(i,j,k,tl) + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + se_tmp = se_tmp+qsize_condensate_loading_cp(nq)*elem(ie)%state%qdp(i,j,k,m_cnst,tl_qdp) + end do + se_tmp = se_tmp*elem(ie)%state%T(i,j,k,tl)/gravit + else + ! + ! using CAM physics definition of internal energy + ! + se_tmp = cpair*elem(ie)%state%T(i,j,k,tl)*pdel/gravit + end if + wv_tmp = elem(ie)%state%qdp(i,j,k,1,tl_qdp)/gravit + + se (i+(j-1)*np) = se (i+(j-1)*np) + se_tmp + ke (i+(j-1)*np) = ke (i+(j-1)*np) + ke_tmp + wv (i+(j-1)*np) = wv (i+(j-1)*np) + wv_tmp + end do + end do + end do + + do j=1,np + do i = 1, np + se(i+(j-1)*np) = se(i+(j-1)*np) + elem(ie)%state%phis(i,j)*ps(i,j)/gravit + end do + end do + + ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. + + if (ixcldliq > 1) then + do k = 1, nlev + do j = 1, np + do i = 1, np + wl_tmp = elem(ie)%state%qdp(i,j,k,ixcldliq,tl_qdp)/gravit + wl (i+(j-1)*np) = wl(i+(j-1)*np) + wl_tmp + end do + end do + end do + end if + + if (ixcldice > 1) then + do k = 1, nlev + do j = 1, np + do i = 1, np + wi_tmp = elem(ie)%state%qdp(i,j,k,ixcldice,tl_qdp)/gravit + wi(i+(j-1)*np) = wi(i+(j-1)*np) + wi_tmp + end do + end do + end do + end if + + if (ixtt > 1) then + do k = 1, nlev + do j = 1, np + do i = 1, np + tt_tmp = elem(ie)%state%qdp(i,j,k,ixtt,tl_qdp)/gravit + tt (i+(j-1)*np) = tt(i+(j-1)*np) + tt_tmp + end do + end do + end do + end if + + ! Output energy diagnostics + call outfld(name_out1 ,se ,npsq,ie) + call outfld(name_out2 ,ke ,npsq,ie) + call outfld(name_out3 ,wv ,npsq,ie) + call outfld(name_out4 ,wl ,npsq,ie) + call outfld(name_out5 ,wi ,npsq,ie) + call outfld(name_out6 ,tt ,npsq,ie) + end do + end if + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian + ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, + ! doi:10.1002/2013MS000268 + ! + ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) + ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) + ! + name_out1 = 'MR_' //trim(outfld_name_suffix) + name_out2 = 'MO_' //trim(outfld_name_suffix) + + if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then + if (qsize_condensate_loading>1) then + ixcldliq = qsize_condensate_loading_idx_gll(2) + ixcldice = qsize_condensate_loading_idx_gll(3) + else + ixcldliq = -1 + ixcldice = -1 + end if + mr_cnst = rearth**3/gravit + mo_cnst = omega*rearth**4/gravit + do ie=nets,nete + mr = 0.0_r8 + mo = 0.0_r8 + do k = 1, nlev + do j=1,np + do i = 1, np + pdel = elem(ie)%state%dp3d(i,j,k,tl) + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + pdel = pdel + elem(ie)%state%qdp(i,j,k,m_cnst,tl_qdp) + end do + + cos_lat = cos(elem(ie)%spherep(i,j)%lat) + mr_tmp = mr_cnst*elem(ie)%state%v(i,j,1,k,tl)*pdel*cos_lat + mo_tmp = mo_cnst*pdel*cos_lat**2 + + mr (i+(j-1)*np) = mr (i+(j-1)*np) + mr_tmp + mo (i+(j-1)*np) = mo (i+(j-1)*np) + mo_tmp + end do + end do + end do + call outfld(name_out1 ,mr ,npsq,ie) + call outfld(name_out2 ,mo ,npsq,ie) + end do + end if + + + end subroutine calc_tot_energy_dynamics + + subroutine output_qdp_var_dynamics(qdp,nets,nete,outfld_name) + use dimensions_mod, only: npsq,qsize,nlev,np,nelemd + use physconst , only: gravit + use cam_history , only: outfld, hist_fld_active + use constituents , only: cnst_get_ind + use control_mod, only: TRACERTRANSPORT_SE_GLL, tracer_transport_type + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx_gll + !------------------------------Arguments-------------------------------- + + real(kind=r8) :: qdp(np,np,nlev,qsize,nelemd) + character*(*),intent(in) :: outfld_name + integer ,intent(in) :: nets,nete + + !---------------------------Local storage------------------------------- + + real(kind=r8) :: qdp1(npsq),qdp2(npsq),qdp3(npsq),qdp4(npsq) + real(kind=r8) :: qdp_tmp + + integer :: i,j,k,ie + integer :: ixcldice, ixcldliq, ixtt + character(len=16) :: name_out1,name_out2,name_out3,name_out4 + + !----------------------------------------------------------------------- + + name_out1 = 'WV_' //trim(outfld_name) + name_out2 = 'WI_' //trim(outfld_name) + name_out3 = 'WL_' //trim(outfld_name) + name_out4 = 'TT_' //trim(outfld_name) + + if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& + hist_fld_active(name_out4)) then + + if (qsize_condensate_loading>1) then + ixcldliq = qsize_condensate_loading_idx_gll(2) + ixcldice = qsize_condensate_loading_idx_gll(3) + else + ixcldliq = -1 + ixcldice = -1 + end if + if (tracer_transport_type == TRACERTRANSPORT_SE_GLL) then + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + else + ixtt = -1 + end if + + do ie=nets,nete + qdp1 = 0.0_r8 + qdp2 = 0.0_r8 + qdp3 = 0.0_r8 + qdp4 = 0.0_r8 + + do k = 1, nlev + do j = 1, np + do i = 1, np + qdp_tmp = qdp(i,j,k,1,ie)/gravit + qdp1 (i+(j-1)*np) = qdp1(i+(j-1)*np) + qdp_tmp + end do + end do + end do + + if (ixcldice > 0) then + do k = 1, nlev + do j = 1, np + do i = 1, np + qdp_tmp = qdp(i,j,k,ixcldice,ie)/gravit + qdp2 (i+(j-1)*np) = qdp2(i+(j-1)*np) + qdp_tmp + end do + end do + end do + end if + + if (ixcldliq > 0) then + do k = 1, nlev + do j = 1, np + do i = 1, np + qdp_tmp = qdp(i,j,k,ixcldliq,ie)/gravit + qdp3 (i+(j-1)*np) = qdp3(i+(j-1)*np) + qdp_tmp + end do + end do + end do + end if + + + if (ixtt > 0) then + do k = 1, nlev + do j = 1, np + do i = 1, np + qdp_tmp = qdp(i,j,k,ixtt,ie)/gravit + qdp4 (i+(j-1)*np) = qdp4(i+(j-1)*np) + qdp_tmp + end do + end do + end do + end if + + call outfld(name_out1 ,qdp1 ,npsq,ie) + call outfld(name_out2 ,qdp2 ,npsq,ie) + call outfld(name_out3 ,qdp3 ,npsq,ie) + call outfld(name_out4 ,qdp4 ,npsq,ie) + end do + end if + end subroutine output_qdp_var_dynamics + + subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) + use control_mod, only : nu_p, hypervis_subcycle + use edge_mod, only : initEdgeBuffer, FreeEdgeBuffer + use dimensions_mod, only : np, nlev + use hybrid_mod, only : hybrid_t + use element_mod, only : element_t + use derivative_mod, only : divergence_sphere, derivative_t,gradient_sphere + use hybvcoord_mod, only : hvcoord_t + use edge_mod, only : edgevpack, edgevunpack + use bndry_mod, only : bndry_exchange + use viscosity_mod, only: biharmonic_wk_omega + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx_gll + implicit none + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + type (derivative_t) , intent(in) :: deriv + integer , intent(in) :: nets,nete,n0,qn0 + real (kind=r8) , intent(in) :: dt + type (hvcoord_t) , intent(in) :: hvcoord + + integer :: i,j,k,ie,kptr,ic,m_cnst,nq + real (kind=r8) :: ckk, suml(np,np), v1, v2, term + real (kind=r8) :: dp_full(np,np,nlev) + real (kind=r8) :: p_full(np,np,nlev),grad_p_full(np,np,2),vgrad_p_full(np,np,nlev) + real (kind=r8) :: divdp_full(np,np,nlev),vdp_full(np,np,2) + real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper, sum_water(np,np,nlev) + + type (EdgeBuffer_t) :: edgeOmega + logical, parameter :: del4omega = .true. + + call initEdgeBuffer(hybrid%par,edgeOmega,elem,nlev,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + do ie=nets,nete + sum_water(:,:,:) = 1.0_r8 + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + sum_water(:,:,:) = sum_water(:,:,:) + & + elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) + end do + do k=1,nlev + dp_full(:,:,k)=sum_water(:,:,k)*elem(ie)%state%dp3d(:,:,k,n0) + if (k==1) then + p_full(:,:,k) = hvcoord%hyai(k)*hvcoord%ps0 + dp_full(:,:,k)/2 + else + p_full(:,:,k)=p_full(:,:,k-1) + dp_full(:,:,k-1)/2 + dp_full(:,:,k)/2 + endif + call gradient_sphere(p_full(:,:,k),deriv,elem(ie)%Dinv,grad_p_full (:,:,:)) + do j=1,np + do i=1,np + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + vdp_full(i,j,1) = dp_full(i,j,k)*v1 + vdp_full(i,j,2) = dp_full(i,j,k)*v2 + vgrad_p_full(i,j,k) = (v1*grad_p_full(i,j,1) + v2*grad_p_full(i,j,2)) + end do + end do + call divergence_sphere(vdp_full(:,:,:),deriv,elem(ie),divdp_full(:,:,k)) + end do + ckk = 0.5_r8 + suml(:,: ) = 0 + do k=1,nlev + do j=1,np ! Loop inversion (AAM) + do i=1,np + term = -divdp_full(i,j,k) + + v1 = elem(ie)%state%v(i,j,1,k,n0) + v2 = elem(ie)%state%v(i,j,2,k,n0) + + elem(ie)%derived%omega(i,j,k) = suml(i,j) + ckk*term+vgrad_p_full(i,j,k) + + suml(i,j) = suml(i,j) + term + end do + end do + end do + end do + do ie=nets,nete + do k=1,nlev + elem(ie)%derived%omega(:,:,k) = elem(ie)%spheremp(:,:)*elem(ie)%derived%omega(:,:,k) + end do + kptr=0 + call edgeVpack(edgeOmega, elem(ie)%derived%omega(:,:,:),nlev,kptr, ie) + end do + call bndry_exchange(hybrid,edgeOmega) + do ie=nets,nete + kptr=0 + call edgeVunpack(edgeOmega, elem(ie)%derived%omega(:,:,:),nlev,kptr, ie) + do k=1,nlev + elem(ie)%derived%omega(:,:,k) = elem(ie)%rspheremp(:,:)*elem(ie)%derived%omega(:,:,k) + end do + end do + + if (del4omega) then + dt_hyper=dt/hypervis_subcycle + do ic=1,hypervis_subcycle + do ie=nets,nete + Otens(:,:,:,ie) = elem(ie)%derived%omega(:,:,:) + end do + call biharmonic_wk_omega(elem,Otens,deriv,edgeOmega,hybrid,nets,nete,1,nlev) + do ie=nets,nete + do k=1,nlev + Otens(:,:,k,ie) = -dt_hyper*nu_p*Otens(:,:,k,ie) + end do + kptr=0 + call edgeVpack(edgeOmega,Otens(:,:,:,ie) ,nlev,kptr, ie) + end do + call bndry_exchange(hybrid,edgeOmega) + do ie=nets,nete + kptr=0 + call edgeVunpack(edgeOmega, Otens(:,:,:,ie),nlev,kptr, ie) + end do + do ie=nets,nete + do k=1,nlev + elem(ie)%derived%omega(:,:,k) =elem(ie)%derived%omega(:,:,k)+& + elem(ie)%rspheremp(:,:)*Otens(:,:,k,ie) + end do + end do + end do + end if + call FreeEdgeBuffer(edgeOmega) + end subroutine compute_omega + + subroutine calc_dp3d_reference(elem,deriv,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) + ! + ! calc_dp3d_reference: When the del^4 horizontal damping is applied to dp3d + ! the values are implicitly affected by natural variations + ! due to surface topography. + ! + ! To account for these physicaly correct variations, use + ! the current state values to compute appropriate + ! reference values for the current (lagrangian) ETA-surfaces. + ! Damping should then be applied to values relative to + ! the reference. + !======================================================================= + use hybvcoord_mod ,only: hvcoord_t + use physconst ,only: rair + use derivative_mod ,only: gradient_sphere,derivative_t + use element_mod, only: element_t + use dimensions_mod, only: np,nlev + use hybrid_mod, only: hybrid_t + use edge_mod, only: edgevpack, edgevunpack + use bndry_mod, only: bndry_exchange + ! + ! Passed variables + !------------------- + type(element_t ),target,intent(inout):: elem(:) + type(derivative_t) ,intent(in ):: deriv + type(EdgeBuffer_t) ,intent(inout):: edge3 + type(hybrid_t ) ,intent(in ):: hybrid + integer ,intent(in ):: nets,nete + integer ,intent(in ):: nt + type(hvcoord_t ) ,intent(in ):: hvcoord + real(kind=r8) ,intent(out) :: dp3d_ref(np,np,nlev,nets:nete) + ! + ! Local Values + !-------------- + real(kind=r8):: p_val (np,np,nlev) + real(kind=r8):: ps_val (np,np) + real(kind=r8):: ps_ref (np,np,nets:nete) + real(kind=r8):: Tv_val (np,np) + real(kind=r8):: Tv_grad (np,np,2) + real(kind=r8):: phis_grad(np,np,2) + real(kind=r8):: phis_gamp(np,np) + real(kind=r8):: Tv_lapse (np,np) + real(kind=r8):: E_psXdp3d(nlev) + real(kind=r8):: E_dp3d (nlev) + real(kind=r8):: E_Awgt,E_psval,E_psXps,E_laps,E_gamp,E_tv,E_phis,E_psref + real(kind=r8):: Expon,Coef,VARps_val + real(kind=r8):: S_Awgt + real(kind=r8):: S_dpavg(np,np,nlev) + real(kind=r8):: S_dpcov(np,np,nlev) + real(kind=r8):: S_psref(np,np) + integer :: jm,jp,js,im,ip,is + integer :: ie,ii,jj,kk,kptr + ! + real(kind=r8):: ps_refavg(np,np,nets:nete) + real(kind=r8):: dp3d_cov(np,np,nlev,nets:nete) + real(kind=r8):: dp3d_avg(np,np,nlev,nets:nete) + ! Loop over elements + !-------------------- + do ie=nets,nete + + ! Calculate Pressure values from dp3dp + !-------------------------------------- + kk=1 + p_val(:,:,kk) = hvcoord%hyai(kk)*hvcoord%ps0 & + + elem(ie)%state%dp3d(:,:,kk,nt)*0.5_r8 + do kk=2,nlev + p_val(:,:,kk) = p_val(:,:,kk-1) & + + elem(ie)%state%dp3d (:,:,kk-1,nt)*0.5_r8 & + + elem(ie)%state%dp3d (:,:,kk ,nt)*0.5_r8 + end do + ps_val(:,:) = p_val(:,:,nlev) + elem(ie)%state%dp3d(:,:,nlev,nt)*0.5_r8 + ! + ! Calculate R*Tv values at surface layer. + ! Use the gradient dotted into the gradient if PHIS to estimate the surface lapse rate. + ! + ! Note: PHIS dependent values could be precalculated and stored. + ! + Tv_val(:,:) = rair*elem(ie)%state%T(:,:,nlev,nt)!*(1._r8+zvir*Q(:,:,nlev,1)) + + call gradient_sphere( Tv_val(:,:),deriv,elem(ie)%Dinv, Tv_grad(:,:,:)) + call gradient_sphere(elem(ie)%state%phis(:,:),deriv,elem(ie)%Dinv,phis_grad(:,:,:)) + + phis_gamp(:,:) = (phis_grad(:,:,1)*phis_grad(:,:,1) + phis_grad(:,:,2)*phis_grad(:,:,2)) + Tv_lapse (:,:) = ( Tv_grad(:,:,1)*phis_grad(:,:,1) + Tv_grad(:,:,2)*phis_grad(:,:,2)) + + ! Calculate needed element average values + !------------------------------------------ + E_Awgt = 0.0_r8 + E_psval = 0.0_r8 + E_psXps = 0.0_r8 + E_laps = 0.0_r8 + E_gamp = 0.0_r8 + E_tv = 0.0_r8 + E_phis = 0.0_r8 + do jj=1,np + do ii=1,np + E_Awgt = E_Awgt + elem(ie)%spheremp(ii,jj) + E_psval = E_psval + elem(ie)%spheremp(ii,jj)*ps_val (ii,jj) + E_psXps = E_psXps + elem(ie)%spheremp(ii,jj)*ps_val (ii,jj)*ps_val(ii,jj) + E_laps = E_laps + elem(ie)%spheremp(ii,jj)*Tv_lapse (ii,jj) + E_gamp = E_gamp + elem(ie)%spheremp(ii,jj)*phis_gamp(ii,jj) + E_tv = E_tv + elem(ie)%spheremp(ii,jj)*Tv_val (ii,jj) + E_phis = E_phis + elem(ie)%spheremp(ii,jj)*elem(ie)%state%phis(ii,jj) + end do + end do + E_psval = E_psval/E_Awgt + E_psXps = E_psXps/E_Awgt + E_laps = E_laps /E_Awgt + E_gamp = E_gamp /E_Awgt + E_tv = E_tv /E_Awgt + E_phis = E_phis /E_Awgt + + ! The estimates of surface lapse rates are still a work in progress, this + ! way gives acceptable results for now. + !----------------------------------------------------------------------- + if(E_gamp.ne.0._r8) then + Tv_lapse(:,:) = E_laps/E_gamp + else + Tv_lapse(:,:) = 0._r8 + endif + + ! Calculate reference surface pressure values + !--------------------------------------------- + E_psref = 0._r8 + do jj=1,np + do ii=1,np + if(Tv_lapse(ii,jj).ne.0._r8) then + ! Hydrostatic PS along topography + !---------------------------------- + Expon = -1._r8/Tv_lapse(ii,jj) + Coef = Tv_lapse(ii,jj)/E_tv + ps_ref(ii,jj,ie) = E_psval*(1._r8+Coef*(elem(ie)%state%phis(ii,jj)-E_phis))**Expon + else + ! Locally Isothermal along topography + !-------------------------------------- + ps_ref(ii,jj,ie) = E_psval*exp(-(elem(ie)%state%phis(ii,jj)-E_phis)/E_tv) + endif + E_psref = E_psref + elem(ie)%spheremp(ii,jj)*ps_ref(ii,jj,ie) + end do + end do + E_psref = E_psref/E_Awgt + + ! remove element averages for ps_val + !----------------------------------------------- + ps_val(:,:) = ps_val(:,:) - E_psval + + ! Calc dp3d covariances. + !------------------------ + VARps_val = E_psXps - E_psval*E_psval + if(VARps_val.ne.0._r8) then + E_psXdp3d(:) = 0._r8 + E_dp3d (:) = 0._r8 + do jj=1,np + do ii=1,np + E_psXdp3d(:) = E_psXdp3d(:) + elem(ie)%spheremp(ii,jj)*ps_val(ii,jj) & + *elem(ie)%state%dp3d(ii,jj,:,nt) + E_dp3d (:) = E_dp3d (:) + elem(ie)%spheremp(ii,jj)*elem(ie)%state%dp3d(ii,jj,:,nt) + end do ! ii=1,np + end do ! jj=1,np + E_dp3d (:) = E_dp3d (:)/E_Awgt + E_psXdp3d(:) = E_psXdp3d(:)/E_Awgt + E_psXdp3d(:) = E_psXdp3d(:)/VARps_val + else + E_psXdp3d(:) = 0._r8 + E_dp3d (:) = 0._r8 + do jj=1,np + do ii=1,np + E_dp3d(:) = E_dp3d(:) + elem(ie)%spheremp(ii,jj)*elem(ie)%state%dp3d(ii,jj,:,nt) + end do ! ii=1,np + end do ! jj=1,np + E_dp3d(:) = E_dp3d(:)/E_Awgt + endif + + ! Store these values for a boundary exchange + !-------------------------------------------- + ps_refavg(:,:,ie) = E_psref + do kk=1,nlev + dp3d_avg(:,:,kk,ie) = E_dp3d (kk) + dp3d_cov(:,:,kk,ie) = E_psXdp3d(kk) + end do + + end do ! ie=nets,nete + + ! Boundary exchange of values needed to evaluate dp3d_ref + !--------------------------------------------------------- + do ie=nets,nete + + ! Scale and pack values for boundary exchange + !---------------------------------------------------- + ps_refavg(:,:,ie) = elem(ie)%spheremp(:,:)*ps_refavg(:,:,ie) + do kk=1,nlev + dp3d_avg(:,:,kk,ie) = elem(ie)%spheremp(:,:)*dp3d_avg(:,:,kk,ie) + + dp3d_cov(:,:,kk,ie) = elem(ie)%spheremp(:,:)*dp3d_cov(:,:,kk,ie) + end do + kptr = 0 + call edgeVpack(edge3,dp3d_avg(1,1,1,ie),nlev,kptr,ie) + kptr = nlev + call edgeVpack(edge3,dp3d_cov(1,1,1,ie),nlev,kptr,ie) + kptr = 2*nlev + call edgeVpack(edge3,ps_refavg(1,1,ie),1,kptr,ie) + end do ! ie=nets,nete + + ! boundary exchange + !------------------- + call bndry_exchange(hybrid,edge3) + + ! Loop over elements + !-------------------- + do ie=nets,nete + ! Unpack and scale values + !-------------------------------- + kptr = 0 + call edgeVunpack(edge3,dp3d_avg(1,1,1,ie),nlev,kptr,ie) + kptr = nlev + call edgeVunpack(edge3,dp3d_cov(1,1,1,ie),nlev,kptr,ie) + kptr = 2*nlev + call edgeVunpack(edge3,ps_refavg(1,1,ie),1,kptr,ie) + + ps_refavg(:,:,ie) = elem(ie)%rspheremp(:,:)*ps_refavg(:,:,ie) + + do kk=1,nlev + dp3d_avg(:,:,kk,ie) = elem(ie)%rspheremp(:,:)*dp3d_avg(:,:,kk,ie) + + dp3d_cov(:,:,kk,ie) = elem(ie)%rspheremp(:,:)*dp3d_cov(:,:,kk,ie) + end do + + ! Carry out area-weighted averaging for internal elemenet points + !-------------------------------------------------------------------- + S_dpavg(:,:,:) = dp3d_avg (:,:,:,ie) + S_dpcov(:,:,:) = dp3d_cov (:,:,:,ie) + S_psref(:,:) = ps_refavg(:,:,ie) + do jj=2,(np-1) + jp = jj + 1 + jm = jj - 1 + do ii=2,(np-1) + ip = ii + 1 + im = ii - 1 + S_Awgt = 0._r8 + S_dpavg(ii,jj,:) = 0._r8 + S_dpcov(ii,jj,:) = 0._r8 + S_psref(ii,jj) = 0._r8 + do js = jm,jp + do is = im,ip + S_Awgt = S_Awgt + elem(ie)%spheremp (is,js) + S_dpavg(ii,jj,:) = S_dpavg(ii,jj,:) + elem(ie)%spheremp (is,js) & + *dp3d_avg (is,js,:,ie) + S_dpcov(ii,jj,:) = S_dpcov(ii,jj,:) + elem(ie)%spheremp (is,js) & + *dp3d_cov (is,js,:,ie) + S_psref(ii,jj) = S_psref(ii,jj) + elem(ie)%spheremp (is,js) & + *ps_refavg(is,js,ie) + end do + end do + S_dpavg(ii,jj,:) = S_dpavg(ii,jj,:)/S_Awgt + S_dpcov(ii,jj,:) = S_dpcov(ii,jj,:)/S_Awgt + S_psref(ii,jj ) = S_psref(ii,jj )/S_Awgt + end do + end do + dp3d_avg (:,:,:,ie) = S_dpavg(:,:,:) + dp3d_cov (:,:,:,ie) = S_dpcov(:,:,:) + ps_refavg(:,:,ie) = S_psref(:,:) + + ! Now Evaluate dp3d reference values + !------------------------------------ + do kk=1,nlev + dp3d_ref(:,:,kk,ie) = dp3d_avg(:,:,kk,ie) & + +(dp3d_cov(:,:,kk,ie) & + * (ps_ref(:,:,ie) & + -ps_refavg(:,:,ie))) + end do + end do ! ie=nets,nete + + ! End Routine + !------------ + return + end subroutine calc_dp3d_reference + !============================================================================= + + +end module prim_advance_mod diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 new file mode 100644 index 0000000000..f45ff2e22b --- /dev/null +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -0,0 +1,1124 @@ +#define OVERLAP 1 + +module prim_advection_mod +! +! two formulations. both are conservative +! u grad Q formulation: +! +! d/dt[ Q] + U grad Q = 0 +! +! d/dt[ dp/dn ] = div( dp/dn U ) +! +! total divergence formulation: +! d/dt[dp/dn Q] + div( U dp/dn Q ) = 0 +! +! for convience, rewrite this as dp Q: (since dn does not depend on time or the horizonal): +! equation is now: +! d/dt[dp Q] + div( U dp Q ) = 0 +! +! + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: nlev, np, qsize, nc + use physconst, only: cpair + use derivative_mod, only: derivative_t + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use hybvcoord_mod, only: hvcoord_t + use time_mod, only: TimeLevel_t, TimeLevel_Qdp + use control_mod, only: nu_q, nu_p, limiter_option, hypervis_subcycle_q, rsplit + use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, initedgesbuffer + + use edgetype_mod, only: EdgeBuffer_t + use hybrid_mod, only: hybrid_t + use viscosity_mod, only: biharmonic_wk_scalar, neighbor_minmax, & + neighbor_minmax_start, neighbor_minmax_finish + use perf_mod, only: t_startf, t_stopf, t_barrierf + use cam_abortutils, only: endrun + use thread_mod, only: horz_num_threads, tracer_num_threads + + implicit none + + private + save + + public :: Prim_Advec_Init1, Prim_Advec_Init2 + public :: Prim_Advec_Tracers_remap + public :: prim_advec_tracers_fvm + public :: vertical_remap + + type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeAdv1, edgeveloc + + integer,parameter :: DSSeta = 1 + integer,parameter :: DSSomega = 2 + integer,parameter :: DSSdiv_vdp_ave = 3 + integer,parameter :: DSSno_var = -1 + + real(kind=r8), allocatable :: qmin(:,:,:), qmax(:,:,:) + +!JMD I don't see why this needs to be thread private. +!JMD type (derivative_t), public, allocatable :: deriv(:) ! derivative struct (nthreads) + type (derivative_t), public :: deriv + + +contains + + + subroutine Prim_Advec_Init1(par, elem) + use dimensions_mod, only : nlev, qsize, nelemd + use parallel_mod, only : parallel_t, boundaryCommMethod + type(parallel_t) :: par + type (element_t) :: elem(:) + ! + ! Shared buffer pointers. + ! Using "=> null()" in a subroutine is usually bad, because it makes + ! the variable have an implicit "save", and therefore shared between + ! threads. But in this case we want shared pointers. + real(kind=r8), pointer :: buf_ptr(:) => null() + real(kind=r8), pointer :: receive_ptr(:) => null() + + + ! this might be called with qsize=0 + ! allocate largest one first + ! Currently this is never freed. If it was, only this first one should + ! be freed, as only it knows the true size of the buffer. + call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& + nthreads=horz_num_threads*tracer_num_threads) + call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*tracer_num_threads) + call initEdgeBuffer(par,edgeAdv1,elem,nlev,bndry_type=boundaryCommMethod) + call initEdgeBuffer(par,edgeveloc,elem,2*nlev,bndry_type=boundaryCommMethod) + + ! This is a different type of buffer pointer allocation + ! used for determine the minimum and maximum value from + ! neighboring elements + call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*tracer_num_threads) + + ! Don't actually want these saved, if this is ever called twice. + nullify(buf_ptr) + nullify(receive_ptr) + + + ! this static array is shared by all threads, so dimension for all threads (nelemd), not nets:nete: + allocate (qmin(nlev,qsize,nelemd)) + allocate (qmax(nlev,qsize,nelemd)) + + end subroutine Prim_Advec_Init1 + + subroutine Prim_Advec_Init2(fvm_corners, fvm_points) + use dimensions_mod, only : nc + use derivative_mod, only : derivinit + + real(kind=r8), intent(in) :: fvm_corners(nc+1) + real(kind=r8), intent(in) :: fvm_points(nc) + + ! ================================== + ! Initialize derivative structure + ! ================================== + call derivinit(deriv,fvm_corners, fvm_points) + end subroutine Prim_Advec_Init2 + + ! + ! fvm driver + ! + subroutine Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& + dt,tl,nets,nete) + use fvm_consistent_se_cslam, only: run_consistent_se_cslam + use control_mod, only: tracer_transport_type,TRACERTRANSPORT_CONSISTENT_SE_FVM + implicit none + type (element_t), intent(inout) :: elem(:) + type (fvm_struct), intent(inout) :: fvm(:) + type (hvcoord_t) :: hvcoord + type (hybrid_t), intent(in):: hybrid + type (TimeLevel_t) :: tl + + real(kind=r8) , intent(in) :: dt + integer,intent(in) :: nets,nete + + call t_barrierf('sync_prim_advec_tracers_fvm', hybrid%par%comm) + call t_startf('prim_advec_tracers_fvm') + + if (rsplit==0) call endrun('cslam only works for rsplit>0') + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! 2D advection step + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (tracer_transport_type == TRACERTRANSPORT_CONSISTENT_SE_FVM) then + call run_consistent_se_cslam(elem,fvm,hybrid,dt,tl,nets,nete,hvcoord) + else + call endrun('Bad tracer_transport_type in Prim_Advec_Tracers_fvm') + end if + + call t_stopf('prim_advec_tracers_fvm') + end subroutine Prim_Advec_Tracers_fvm + + + +!=================================================================================================! + + subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) + implicit none + type (element_t) , intent(inout) :: elem(:) + type (derivative_t) , intent(in ) :: deriv + type (hvcoord_t) , intent(in ) :: hvcoord + type (hybrid_t) , intent(in ) :: hybrid + real(kind=r8) , intent(in ) :: dt + type (TimeLevel_t) , intent(inout) :: tl + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + + call Prim_Advec_Tracers_remap_rk2( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) + end subroutine Prim_Advec_Tracers_remap + + + subroutine euler_step_driver(np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , nets , nete , DSSopt , rhs_multiplier ) + + + integer , intent(in ) :: np1_qdp, n0_qdp + real (kind=r8), intent(in ) :: dt + type (element_t) , intent(inout) :: elem(:) + type (hvcoord_t) , intent(in ) :: hvcoord + type (hybrid_t) , intent(in ) :: hybrid + type (derivative_t) , intent(in ) :: deriv + integer , intent(in ) :: nets + integer , intent(in ) :: nete + integer , intent(in ) :: DSSopt + integer , intent(in ) :: rhs_multiplier + + call euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , nets , nete , DSSopt , rhs_multiplier) + + end subroutine euler_step_driver + +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! forward-in-time 2 level vertically lagrangian step +! this code takes a lagrangian step in the horizontal +! (complete with DSS), and then applies a vertical remap +! +! This routine may use dynamics fields at timelevel np1 +! In addition, other fields are required, which have to be +! explicitly saved by the dynamics: (in elem(ie)%derived struct) +! +! Fields required from dynamics: (in +! omega it will be DSS'd here, for later use by CAM physics +! we DSS omega here because it can be done for "free" +! Consistent mass/tracer-mass advection (used if subcycling turned on) +! dp() dp at timelevel n0 +! vn0() mean flux < U dp > going from n0 to np1 +! +! 3 stage +! Euler step from t -> t+.5 +! Euler step from t+.5 -> t+1.0 +! Euler step from t+1.0 -> t+1.5 +! u(t) = u(t)/3 + u(t+2)*2/3 +! +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + subroutine Prim_Advec_Tracers_remap_rk2( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) + use derivative_mod, only : divergence_sphere + use control_mod , only : qsplit + use hybrid_mod , only : get_loop_ranges!, PrintHybrid +! use thread_mod , only : omp_set_num_threads, omp_get_thread_num + + type (element_t) , intent(inout) :: elem(:) + type (derivative_t) , intent(in ) :: deriv + type (hvcoord_t) , intent(in ) :: hvcoord + type (hybrid_t) , intent(in ) :: hybrid + real(kind=r8) , intent(in ) :: dt + type (TimeLevel_t) , intent(inout) :: tl + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + real (kind=r8), dimension(np,np,2 ) :: gradQ + integer :: k,ie + integer :: rkstage,rhs_multiplier + integer :: n0_qdp, np1_qdp + integer :: kbeg,kend,qbeg,qend + +! call t_barrierf('sync_prim_advec_tracers_remap_k2', hybrid%par%comm) +! call t_startf('prim_advec_tracers_remap_rk2') +! call extrae_user_function(1) + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) !time levels for qdp are not the same + rkstage = 3 ! 3 stage RKSSP scheme, with optimal SSP CFL + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! RK2 2D advection step + ! note: stage 3 we take the oppertunity to DSS omega + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! use these for consistent advection (preserve Q=1) + ! derived%vdp_ave = mean horiz. flux: U*dp + ! derived%omega = advection code will DSS this for the physics, but otherwise + ! it is not needed + ! Also: save a copy of div(U dp) in derived%div(:,:,:,1), which will be DSS'd + ! and a DSS'ed version stored in derived%div(:,:,:,2) + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + do ie=nets,nete + do k=kbeg,kend + ! div( U dp Q), + gradQ(:,:,1)=elem(ie)%derived%vn0(:,:,1,k) + gradQ(:,:,2)=elem(ie)%derived%vn0(:,:,2,k) + ! elem(ie)%derived%divdp(:,:,k) = divergence_sphere(gradQ,deriv,elem(ie)) + call divergence_sphere(gradQ,deriv,elem(ie),elem(ie)%derived%divdp(:,:,k)) + elem(ie)%derived%divdp_proj(:,:,k) = elem(ie)%derived%divdp(:,:,k) + enddo + enddo + + + !rhs_multiplier is for obtaining dp_tracers at each stage: + !dp_tracers(stage) = dp - rhs_multiplier*dt*divdp_proj +! call t_startf('euler_step') + + rhs_multiplier = 0 + call euler_step_driver( np1_qdp, n0_qdp , dt/2, elem, hvcoord, hybrid, deriv, nets, nete, DSSdiv_vdp_ave, rhs_multiplier ) + + rhs_multiplier = 1 + call euler_step_driver( np1_qdp, np1_qdp, dt/2, elem, hvcoord, hybrid, deriv, nets, nete, DSSno_var , rhs_multiplier ) + + rhs_multiplier = 2 + call euler_step_driver( np1_qdp, np1_qdp, dt/2, elem, hvcoord, hybrid, deriv, nets, nete, DSSomega , rhs_multiplier ) + +! call t_stopf ('euler_step') + + !to finish the 2D advection step, we need to average the t and t+2 results to get a second order estimate for t+1. + call qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid, nets , nete ) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Dissipation + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( limiter_option == 8 ) then + ! dissipation was applied in RHS. + else + call advance_hypervis_scalar(edgeadv,elem,hvcoord,hybrid,deriv,tl%np1,np1_qdp,nets,nete,dt) + endif +! call extrae_user_function(0) + +! call t_stopf('prim_advec_tracers_remap_rk2') + + end subroutine prim_advec_tracers_remap_rk2 + +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + + subroutine qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid , nets , nete ) + use hybrid_mod, only : hybrid_t, get_loop_ranges + implicit none + type(element_t) , intent(inout) :: elem(:) + integer , intent(in ) :: rkstage , n0_qdp , np1_qdp , nets , nete + type(hybrid_t) :: hybrid + integer :: i,j,ie,q,k + integer :: kbeg,kend,qbeg,qend + real(kind=r8) :: rrkstage + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + rrkstage=1.0_r8/real(rkstage,kind=r8) + do ie=nets,nete + do q=qbeg,qend + do k=kbeg,kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = & + rrkstage *( elem(ie)%state%Qdp(i,j,k,q,n0_qdp) + & + (rkstage-1)*elem(ie)%state%Qdp(i,j,k,q,np1_qdp) ) + enddo + enddo + enddo + enddo + enddo + end subroutine qdp_time_avg + +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + + subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , nets , nete , DSSopt , rhs_multiplier ) + ! =================================== + ! This routine is the basic foward + ! euler component used to construct RK SSP methods + ! + ! u(np1) = u(n0) + dt2*DSS[ RHS(u(n0)) ] + ! + ! n0 can be the same as np1. + ! + ! DSSopt = DSSeta or DSSomega: also DSS omega + ! + ! =================================== + use dimensions_mod , only : np, nlev + use hybrid_mod , only : hybrid_t!, PrintHybrid + use hybrid_mod , only : get_loop_ranges, threadOwnsTracer + use element_mod , only : element_t + use derivative_mod , only : derivative_t, divergence_sphere, limiter_optim_iter_full + use edge_mod , only : edgevpack, edgevunpack + use bndry_mod , only : bndry_exchange + use hybvcoord_mod , only : hvcoord_t + + integer , intent(in ) :: np1_qdp, n0_qdp + real (kind=r8), intent(in ) :: dt + type (element_t) , intent(inout), target :: elem(:) + type (hvcoord_t) , intent(in ) :: hvcoord + type (hybrid_t) , intent(in ) :: hybrid + type (derivative_t) , intent(in ) :: deriv + integer , intent(in ) :: nets + integer , intent(in ) :: nete + integer , intent(in ) :: DSSopt + integer , intent(in ) :: rhs_multiplier + + ! local + real(kind=r8), dimension(np,np ) :: dpdiss + real(kind=r8), dimension(np,np,nlev) :: dpdissk + real(kind=r8), dimension(np,np,2 ) :: gradQ + real(kind=r8), dimension(np,np,2,nlev ) :: Vstar + real(kind=r8), dimension(np,np ,nlev ) :: Qtens + real(kind=r8), dimension(np,np ,nlev ) :: dp + real(kind=r8), dimension(np,np ,nlev,qsize,nets:nete) :: Qtens_biharmonic + real(kind=r8), dimension(np,np) :: div + real(kind=r8), pointer, dimension(:,:,:) :: DSSvar + real(kind=r8) :: dp0(nlev) + integer :: ie,q,i,j,k, kptr + integer :: rhs_viss = 0 + integer :: kblk,qblk ! The per thead size of the vertical and tracers + integer :: kbeg, kend, qbeg, qend + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + do k = kbeg, kend + dp0(k) = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 + enddo + +! call t_startf('euler_step') + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! compute Q min/max values for lim8 + ! compute biharmonic mixing term f + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + rhs_viss = 0 + if ( limiter_option == 8 ) then + ! when running lim8, we also need to limit the biharmonic, so that term needs + ! to be included in each euler step. three possible algorithms here: + ! 1) most expensive: + ! compute biharmonic (which also computes qmin/qmax) during all 3 stages + ! be sure to set rhs_viss=1 + ! cost: 3 biharmonic steps with 3 DSS + ! + ! 2) cheapest: + ! compute biharmonic (which also computes qmin/qmax) only on first stage + ! be sure to set rhs_viss=3 + ! reuse qmin/qmax for all following stages (but update based on local qmin/qmax) + ! cost: 1 biharmonic steps with 1 DSS + ! main concern: viscosity + ! + ! 3) compromise: + ! compute biharmonic (which also computes qmin/qmax) only on last stage + ! be sure to set rhs_viss=3 + ! compute qmin/qmax directly on first stage + ! reuse qmin/qmax for 2nd stage stage (but update based on local qmin/qmax) + ! cost: 1 biharmonic steps, 2 DSS + ! + ! NOTE when nu_p=0 (no dissipation applied in dynamics to dp equation), we should + ! apply dissipation to Q (not Qdp) to preserve Q=1 + ! i.e. laplace(Qdp) ~ dp0 laplace(Q) + ! for nu_p=nu_q>0, we need to apply dissipation to Q * diffusion_dp + ! + ! initialize dp, and compute Q from Qdp (and store Q in Qtens_biharmonic) + do ie = nets, nete + ! add hyperviscosity to RHS. apply to Q at timelevel n0, Qdp(n0)/dp + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + dp(i,j,k) = elem(ie)%derived%dp(i,j,k) - rhs_multiplier*dt*elem(ie)%derived%divdp_proj(i,j,k) + enddo + enddo + enddo + !JMD need to update loop based on changes in dungeon21 tag + do q = qbeg, qend + do k= kbeg, kend + Qtens_biharmonic(:,:,k,q,ie) = elem(ie)%state%Qdp(:,:,k,q,n0_qdp)/dp(:,:,k) + if ( rhs_multiplier == 1 ) then + qmin(k,q,ie)=min(qmin(k,q,ie),minval(Qtens_biharmonic(:,:,k,q,ie))) + qmax(k,q,ie)=max(qmax(k,q,ie),maxval(Qtens_biharmonic(:,:,k,q,ie))) + else + qmin(k,q,ie)=minval(Qtens_biharmonic(:,:,k,q,ie)) + qmax(k,q,ie)=maxval(Qtens_biharmonic(:,:,k,q,ie)) + endif + enddo + enddo + enddo + + ! compute element qmin/qmax + if ( rhs_multiplier == 0 ) then + ! update qmin/qmax based on neighbor data for lim8 +! call t_startf('euler_neighbor_minmax1') + call neighbor_minmax(hybrid,edgeAdvQminmax,nets,nete,qmin(:,:,nets:nete),qmax(:,:,nets:nete)) +! call t_stopf('euler_neighbor_minmax1') + endif + + ! get niew min/max values, and also compute biharmonic mixing term + if ( rhs_multiplier == 2 ) then + rhs_viss = 3 + ! two scalings depending on nu_p: + ! nu_p=0: qtens_biharmonic *= dp0 (apply viscsoity only to q) + ! nu_p>0): qtens_biharmonc *= elem()%psdiss_ave (for consistency, if nu_p=nu_q) + if ( nu_p > 0 ) then + do ie = nets, nete + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + dpdissk(i,j,k) = elem(ie)%derived%dpdiss_ave(i,j,k)/dp0(k) + enddo + enddo + enddo + do q = qbeg,qend + do k = kbeg, kend + ! NOTE: divide by dp0 since we multiply by dp0 below + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + Qtens_biharmonic(i,j,k,q,ie)=Qtens_biharmonic(i,j,k,q,ie)*dpdissk(i,j,k) + enddo + enddo + enddo + enddo + enddo + endif + +! Previous version of biharmonic_wk_scalar_minmax included a min/max +! calculation into the boundary exchange. This was causing cache issues. +! Split the single operation into two separate calls +! call neighbor_minmax() +! call biharmonic_wk_scalar() +! +#ifdef OVERLAP + call neighbor_minmax_start(hybrid,edgeAdvQminmax,nets,nete,qmin(:,:,nets:nete),qmax(:,:,nets:nete)) + call biharmonic_wk_scalar(elem,qtens_biharmonic,deriv,edgeAdv,hybrid,nets,nete) + do ie = nets, nete + do q = qbeg, qend + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ! note: biharmonic_wk() output has mass matrix already applied. Un-apply since we apply again below: + qtens_biharmonic(i,j,k,q,ie) = & + -rhs_viss*dt*nu_q*dp0(k)*Qtens_biharmonic(i,j,k,q,ie) / elem(ie)%spheremp(i,j) + enddo + enddo + enddo + enddo + enddo + call neighbor_minmax_finish(hybrid,edgeAdvQminmax,nets,nete,qmin(:,:,nets:nete),qmax(:,:,nets:nete)) +#else + call t_startf('euler_neighbor_minmax2') + call neighbor_minmax(hybrid,edgeAdvQminmax,nets,nete,qmin(:,:,nets:nete),qmax(:,:,nets:nete)) + call t_stopf('euler_neighbor_minmax2') + call biharmonic_wk_scalar(elem,qtens_biharmonic,deriv,edgeAdv,hybrid,nets,nete) + + do ie = nets, nete + do q = qbeg, qend + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ! note: biharmonic_wk() output has mass matrix already applied. Un-apply since we apply again below: + qtens_biharmonic(i,j,k,q,ie) = & + -rhs_viss*dt*nu_q*dp0(k)*Qtens_biharmonic(i,j,k,q,ie) / elem(ie)%spheremp(i,j) + enddo + enddo + enddo + enddo + enddo +#endif + + + endif + endif ! compute biharmonic mixing term and qmin/qmax + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! 2D Advection step + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do ie = nets, nete + + + ! Compute velocity used to advance Qdp + do k = kbeg, kend + ! derived variable divdp_proj() (DSS'd version of divdp) will only be correct on 2nd and 3rd stage + ! but that's ok because rhs_multiplier=0 on the first stage: + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + dp(i,j,k) = elem(ie)%derived%dp(i,j,k) - rhs_multiplier * dt * elem(ie)%derived%divdp_proj(i,j,k) + Vstar(i,j,1,k) = elem(ie)%derived%vn0(i,j,1,k) / dp(i,j,k) + Vstar(i,j,2,k) = elem(ie)%derived%vn0(i,j,2,k) / dp(i,j,k) + enddo + enddo + enddo + if ( limiter_option == 8) then + ! Note that the term dpdissk is independent of Q + do k = kbeg, kend + ! UN-DSS'ed dp at timelevel n0+1: + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + dpdissk(i,j,k) = dp(i,j,k) - dt * elem(ie)%derived%divdp(i,j,k) + enddo + enddo + if ( nu_p > 0 .and. rhs_viss /= 0 ) then + ! add contribution from UN-DSS'ed PS dissipation +! dpdiss(:,:) = ( hvcoord%hybi(k+1) - hvcoord%hybi(k) ) * +! elem(ie)%derived%psdiss_biharmonic(:,:) + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + dpdiss(i,j) = elem(ie)%derived%dpdiss_biharmonic(i,j,k) + dpdissk(i,j,k) = dpdissk(i,j,k) - rhs_viss * dt * nu_q * dpdiss(i,j) / elem(ie)%spheremp(i,j) + enddo + enddo + endif + ! IMPOSE ZERO THRESHOLD. do this here so it can be turned off for + ! testing + do q=qbeg, qend + qmin(k,q,ie)=max(qmin(k,q,ie),0.0_r8) + enddo + enddo + endif ! limiter == 8 + + + ! advance Qdp + do q = qbeg, qend + do k = kbeg, kend + ! div( U dp Q), + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + gradQ(i,j,1) = Vstar(i,j,1,k) * elem(ie)%state%Qdp(i,j,k,q,n0_qdp) + gradQ(i,j,2) = Vstar(i,j,2,k) * elem(ie)%state%Qdp(i,j,k,q,n0_qdp) + enddo + enddo + ! Qtens(:,:,k) = elem(ie)%state%Qdp(:,:,k,q,n0_qdp) - & + ! dt * divergence_sphere( gradQ , deriv , elem(ie) ) + call divergence_sphere( gradQ , deriv , elem(ie),div ) + + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + Qtens(i,j,k) = elem(ie)%state%Qdp(i,j,k,q,n0_qdp) - dt * div(i,j) + enddo + enddo + + ! optionally add in hyperviscosity computed above: + if ( rhs_viss /= 0 ) then + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + Qtens(i,j,k) = Qtens(i,j,k) + Qtens_biharmonic(i,j,k,q,ie) + enddo + enddo + endif + enddo + + if ( limiter_option == 8) then + ! apply limiter to Q = Qtens / dp_star + call limiter_optim_iter_full( Qtens(:,:,:) , elem(ie)%spheremp(:,:) , qmin(:,q,ie) , & + qmax(:,q,ie) , dpdissk, kbeg, kend ) + endif + + + ! apply mass matrix, overwrite np1 with solution: + ! dont do this earlier, since we allow np1_qdp == n0_qdp + ! and we dont want to overwrite n0_qdp until we are done using it + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = elem(ie)%spheremp(i,j) * Qtens(i,j,k) + enddo + enddo + enddo + + if ( limiter_option == 4 ) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 + ! sign-preserving limiter, applied after mass matrix + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 +!JMD !$OMP BARRIER +!JMD !$OMP MASTER + call limiter2d_zero(elem(ie)%state%Qdp(:,:,:,q,np1_qdp)) +!JMD !$OMP END MASTER +!JMD !$OMP BARRIER + endif + + kptr = nlev*(q-1) + kbeg - 1 + call edgeVpack(edgeAdvp1 , elem(ie)%state%Qdp(:,:,kbeg:kend,q,np1_qdp) , kblk , kptr , ie ) + enddo + ! only perform this operation on thread which owns the first tracer + if (DSSopt>0) then + if (threadOwnsTracer(hybrid,1)) then + ! all zero so we only have to DSS 1:nlev + if ( DSSopt == DSSomega ) DSSvar => elem(ie)%derived%omega(:,:,:) + if ( DSSopt == DSSdiv_vdp_ave ) DSSvar => elem(ie)%derived%divdp_proj(:,:,:) + ! also DSS extra field + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + DSSvar(i,j,k) = elem(ie)%spheremp(i,j) * DSSvar(i,j,k) + enddo + enddo + enddo + kptr = nlev*qsize + kbeg - 1 + call edgeVpack( edgeAdvp1 , DSSvar(:,:,kbeg:kend), kblk, kptr, ie) + endif + end if + enddo + + call bndry_exchange( hybrid , edgeAdvp1) + + do ie = nets, nete + ! only perform this operation on thread which owns the first tracer + if (DSSopt>0) then + if(threadOwnsTracer(hybrid,1)) then + if ( DSSopt == DSSomega ) DSSvar => elem(ie)%derived%omega(:,:,:) + if ( DSSopt == DSSdiv_vdp_ave ) DSSvar => elem(ie)%derived%divdp_proj(:,:,:) + kptr = qsize*nlev + kbeg -1 + call edgeVunpack( edgeAdvp1 , DSSvar(:,:,kbeg:kend) , kblk , kptr , ie ) + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + DSSvar(i,j,k) = DSSvar(i,j,k) * elem(ie)%rspheremp(i,j) + enddo + enddo + enddo + endif + end if + do q = qbeg, qend + kptr = nlev*(q-1) + kbeg - 1 + call edgeVunpack( edgeAdvp1 , elem(ie)%state%Qdp(:,:,kbeg:kend,q,np1_qdp) , kblk , kptr , ie ) + do k = kbeg, kend + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = elem(ie)%rspheremp(i,j) * elem(ie)%state%Qdp(i,j,k,q,np1_qdp) + enddo + enddo + enddo + enddo + enddo +! call t_stopf('euler_step') + + end subroutine euler_step + + + + subroutine limiter2d_zero(Q) + ! mass conserving zero limiter (2D only). to be called just before DSS + ! + ! this routine is called inside a DSS loop, and so Q had already + ! been multiplied by the mass matrix. Thus dont include the mass + ! matrix when computing the mass = integral of Q over the element + ! + ! ps is only used when advecting Q instead of Qdp + ! so ps should be at one timelevel behind Q + implicit none + real (kind=r8), intent(inout) :: Q(np,np,nlev) + + ! local +! real (kind=r8) :: dp(np,np) + real (kind=r8) :: mass,mass_new,ml + integer i,j,k + + do k = nlev , 1 , -1 + mass = 0 + do j = 1 , np + do i = 1 , np + !ml = Q(i,j,k)*dp(i,j)*spheremp(i,j) ! see above + ml = Q(i,j,k) + mass = mass + ml + enddo + enddo + + ! negative mass. so reduce all postive values to zero + ! then increase negative values as much as possible + if ( mass < 0 ) Q(:,:,k) = -Q(:,:,k) + mass_new = 0 + do j = 1 , np + do i = 1 , np + if ( Q(i,j,k) < 0 ) then + Q(i,j,k) = 0 + else + ml = Q(i,j,k) + mass_new = mass_new + ml + endif + enddo + enddo + + ! now scale the all positive values to restore mass + if ( mass_new > 0 ) Q(:,:,k) = Q(:,:,k) * abs(mass) / mass_new + if ( mass < 0 ) Q(:,:,k) = -Q(:,:,k) + enddo + end subroutine limiter2d_zero + +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + + subroutine advance_hypervis_scalar( edgeAdv , elem , hvcoord , hybrid , deriv , nt , nt_qdp , nets , nete , dt2 ) + ! hyperviscsoity operator for foward-in-time scheme + ! take one timestep of: + ! Q(:,:,:,np) = Q(:,:,:,np) + dt2*nu*laplacian**order ( Q ) + ! + ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace + use dimensions_mod , only : np, nlev + use hybrid_mod , only : hybrid_t!, PrintHybrid + use hybrid_mod , only : get_loop_ranges + use element_mod , only : element_t + use derivative_mod , only : derivative_t + use edge_mod , only : edgevpack, edgevunpack + use edgetype_mod , only : EdgeBuffer_t + use bndry_mod , only : bndry_exchange + + implicit none + type (EdgeBuffer_t) , intent(inout) :: edgeAdv + type (element_t) , intent(inout), target :: elem(:) + type (hvcoord_t) , intent(in ) :: hvcoord + type (hybrid_t) , intent(in ) :: hybrid + type (derivative_t) , intent(in ) :: deriv + integer , intent(in ) :: nt + integer , intent(in ) :: nt_qdp + integer , intent(in ) :: nets + integer , intent(in ) :: nete + real (kind=r8), intent(in ) :: dt2 + + ! local + real (kind=r8), dimension(np,np,nlev,qsize,nets:nete) :: Qtens + real (kind=r8), dimension(np,np,nlev ) :: dp +! real (kind=r8), dimension( nlev,qsize,nets:nete) :: min_neigh +! real (kind=r8), dimension( nlev,qsize,nets:nete) :: max_neigh + integer :: k,kptr,ie,ic,q,i,j + integer :: kbeg,kend,qbeg,qend + +! NOTE: PGI compiler bug: when using spheremp, rspheremp and ps as pointers to elem(ie)% members, +! data is incorrect (offset by a few numbers actually) +! removed for now. +! real (kind=r8), dimension(:,:), pointer :: spheremp,rspheremp + real (kind=r8) :: dt,dp0 + integer :: kblk,qblk ! The per thead size of the vertical and tracers + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + if ( nu_q == 0 ) return + !if ( hypervis_order /= 2 ) return + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + call t_startf('advance_hypervis_scalar') + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! hyper viscosity + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + dt = dt2 / hypervis_subcycle_q + + do ic = 1 , hypervis_subcycle_q + do ie = nets, nete + ! Qtens = Q/dp (apply hyperviscsoity to dp0 * Q, not Qdp) + do k = kbeg, kend + ! various options: + ! 1) biharmonic( Qdp ) + ! 2) dp0 * biharmonic( Qdp/dp ) + ! 3) dpave * biharmonic(Q/dp) + ! For trace mass / mass consistenciy, we use #2 when nu_p=0 + ! and #e when nu_p>0, where dpave is the mean mass flux from the nu_p + ! contribution from dynamics. + dp0 = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) ) * hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) ) * hvcoord%ps0 + dp(:,:,k) = elem(ie)%derived%dp(:,:,k) - dt2*elem(ie)%derived%divdp_proj(:,:,k) + if (nu_p>0) then + do q = qbeg, qend + Qtens(:,:,k,q,ie) = elem(ie)%derived%dpdiss_ave(:,:,k)*& + elem(ie)%state%Qdp(:,:,k,q,nt_qdp) / dp(:,:,k) + enddo + else + do q = qbeg, qend + Qtens(:,:,k,q,ie) = dp0*elem(ie)%state%Qdp(:,:,k,q,nt_qdp) / dp(:,:,k) + enddo + endif + enddo + enddo + + ! compute biharmonic operator. Qtens = input and output + call biharmonic_wk_scalar( elem , Qtens , deriv , edgeAdv , hybrid , nets , nete ) + + do ie = nets, nete + !spheremp => elem(ie)%spheremp + do q = qbeg, qend + do k = kbeg, kend + dp0 = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) ) * hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) ) * hvcoord%ps0 + do j = 1 , np + do i = 1 , np + + ! advection Qdp. For mass advection consistency: + ! DIFF( Qdp) ~ dp0 DIFF (Q) = dp0 DIFF ( Qdp/dp ) + elem(ie)%state%Qdp(i,j,k,q,nt_qdp) = elem(ie)%state%Qdp(i,j,k,q,nt_qdp) * elem(ie)%spheremp(i,j) & + - dt * nu_q * Qtens(i,j,k,q,ie) + enddo + enddo + enddo + + if (limiter_option .ne. 0 ) then +!JMD Only need if threading over the vertical +!JMD!$OMP BARRIER +!JMD!$OMP MASTER + ! smooth some of the negativities introduced by diffusion: + call limiter2d_zero( elem(ie)%state%Qdp(:,:,:,q,nt_qdp) ) +!JMD!$OMP END MASTER +!JMD!$OMP BARRIER + endif + + enddo + do q = qbeg, qend + kptr = nlev*(q-1) + kbeg - 1 + call edgeVpack( edgeAdv , elem(ie)%state%Qdp(:,:,kbeg:kend,q,nt_qdp) , kblk, kptr, ie ) + enddo + enddo + + call bndry_exchange( hybrid , edgeAdv) + + do ie = nets, nete + do q = qbeg, qend + kptr = nlev*(q-1) + kbeg - 1 + call edgeVunpack( edgeAdv , elem(ie)%state%Qdp(:,:,kbeg:kend,q,nt_qdp) , kblk, kptr, ie ) + enddo + !rspheremp => elem(ie)%rspheremp + do q = qbeg, qend + ! apply inverse mass matrix + do k = kbeg, kend + elem(ie)%state%Qdp(:,:,k,q,nt_qdp) = elem(ie)%rspheremp(:,:) * elem(ie)%state%Qdp(:,:,k,q,nt_qdp) + enddo + enddo + enddo + + enddo + call t_stopf('advance_hypervis_scalar') + end subroutine advance_hypervis_scalar + + + subroutine vertical_remap(hybrid,elem,fvm,hvcoord,dt,np1,np1_qdp,n_fvm,nets,nete) + ! This routine is called at the end of the vertically Lagrangian + ! dynamics step to compute the vertical flux needed to get back + ! to reference eta levels + ! + ! input: + ! derived%dp() delta p on levels at beginning of timestep + ! state%dp3d(np1) delta p on levels at end of timestep + ! output: + ! state%psdry(np1) surface pressure at time np1 + ! + + use hybvcoord_mod, only : hvcoord_t + use vertremap_mod, only : remap1, remap1_nofilter + use hybrid_mod , only : hybrid_t!, set_region_num_threads + use fvm_control_volume_mod, only : fvm_struct + use control_mod, only : se_prescribed_wind_2d + use dimensions_mod , only : ntrac + use dimensions_mod , only : qsize_condensate_loading, qsize_condensate_loading_idx_gll + use dimensions_mod, only : lcp_moist,qsize_condensate_loading_cp + + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type(fvm_struct), intent(inout) :: fvm(:) + type (element_t), intent(inout) :: elem(:) + integer, intent(in) :: n_fvm + ! + real (kind=r8) :: cdp(1:nc,1:nc,nlev,ntrac) + real (kind=r8) :: dpc(nc,nc,nlev),dpc_star(nc,nc,nlev) + + type (hvcoord_t) :: hvcoord + real (kind=r8) :: dt + integer :: ie,i,j,k,np1,nets,nete,np1_qdp,q, m_cnst + real (kind=r8), dimension(np,np,nlev) :: dp_moist,dp_star_moist, dp_inv,dp_dry,dp_star_dry + real (kind=r8), dimension(np,np,nlev) :: internal_energy_star + real (kind=r8), dimension(np,np,nlev,2):: ttmp + + + ! reference levels: + ! dp(k) = (hyai(k+1)-hyai(k))*ps0 + (hybi(k+1)-hybi(k))*ps(i,j) + ! hybi(1)=0 pure pressure at top of atmosphere + ! hyai(1)=ptop + ! hyai(nlev+1) = 0 pure sigma at bottom + ! hybi(nlev+1) = 1 + ! + ! sum over k=1,nlev + ! sum(dp(k)) = (hyai(nlev+1)-hyai(1))*ps0 + (hybi(nlev+1)-hybi(1))*ps + ! = -ps0 + ps + ! ps = ps0+sum(dp(k)) + ! + ! reference levels: + ! dp(k) = (hyai(k+1)-hyai(k))*ps0 + (hybi(k+1)-hybi(k))*ps + ! + do ie=nets,nete + if (lcp_moist) then + ! + ! compute internal energy on Lagrangian levels + ! (do it here since qdp is overwritten by remap1) + ! + internal_energy_star = cpair*elem(ie)%state%dp3d(:,:,:,np1) + do q=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(q) + internal_energy_star = internal_energy_star+& + qsize_condensate_loading_cp(q)*elem(ie)%state%qdp(:,:,:,m_cnst,np1_qdp) + end do + internal_energy_star = internal_energy_star*elem(ie)%state%t(:,:,:,np1) + end if + ! + ! REMAP u,v,T from levels in dp3d() to REF levels + ! + ! update final ps + elem(ie)%state%psdry(:,:,np1) = hvcoord%hyai(1)*hvcoord%ps0 + & + sum(elem(ie)%state%dp3d(:,:,:,np1),3) + ! + do k=1,nlev + dp_star_dry(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1) + dp_dry(:,:,k) = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*elem(ie)%state%psdry(:,:,np1) + elem(ie)%state%dp3d(:,:,k,np1) = dp_dry(:,:,k) + enddo + if (minval(dp_star_dry)<0) call endrun('negative dry layer thickness. timestep or remap time too large B') + ! + dp_star_moist(:,:,:) = dp_star_dry(:,:,:) + do q=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(q) + do k=1,nlev + dp_star_moist(:,:,k)= dp_star_moist(:,:,k)+elem(ie)%state%Qdp(:,:,k,m_cnst,np1_qdp) + end do + end do + if (minval(dp_star_moist)<0) call endrun('negative moist layer thickness. timestep or remap time too large') + + call remap1(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),np,1,qsize,qsize,dp_star_dry,dp_dry,hybrid=hybrid) + ! + ! compute moist reference pressure level thickness + ! + dp_moist(:,:,:) = dp_dry(:,:,:) + do q=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(q) + do k=1,nlev + dp_moist(:,:,k) = dp_moist(:,:,k)+elem(ie)%state%Qdp(:,:,k,m_cnst,np1_qdp) + end do + end do + if (minval(dp_star_moist)<0) call endrun('negative layer thickness. timestep or remap time too large') + + dp_inv=1.0_R8/dp_moist !for efficiency + + ! + ! remap internal energy and back out temperature + ! + if (lcp_moist) then + call remap1(internal_energy_star,np,1,1,1,dp_star_dry,dp_dry) + ! + ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid + ! + ttmp(:,:,:,2) = cpair*dp_dry + do q=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(q) + ttmp(:,:,:,2) = ttmp(:,:,:,2)+qsize_condensate_loading_cp(q)*elem(ie)%state%qdp(:,:,:,m_cnst,np1_qdp) + end do + elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,2) + else + internal_energy_star(:,:,:)=elem(ie)%state%t(:,:,:,np1)*dp_star_moist + call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist) + elem(ie)%state%t(:,:,:,np1)=internal_energy_star*dp_inv + end if + ! + ! remap velocity components + ! + ttmp(:,:,:,1)=elem(ie)%state%v(:,:,1,:,np1)*dp_star_moist + ttmp(:,:,:,2)=elem(ie)%state%v(:,:,2,:,np1)*dp_star_moist + ! remap with PPM filter: call remap1(ttmp,np,1,2,2,dp_star_moist,dp_moist) + call remap1_nofilter(ttmp,np,2,dp_star_moist,dp_moist) + + if ( .not. se_prescribed_wind_2d ) & + elem(ie)%state%v(:,:,1,:,np1)=ttmp(:,:,:,1)*dp_inv + if ( .not. se_prescribed_wind_2d ) & + elem(ie)%state%v(:,:,2,:,np1)=ttmp(:,:,:,2)*dp_inv +#ifdef REMAP_TE + ! back out T from TE + elem(ie)%state%t(:,:,:,np1) = & + ( elem(ie)%state%t(:,:,:,np1) - ( (elem(ie)%state%v(:,:,1,:,np1)**2 + & + elem(ie)%state%v(:,:,2,:,np1)**2)/2))/cpair + +#endif + + ! remap the gll tracers from lagrangian levels (dp_star) to REF levels dp + if (qsize>0) then + + if ( se_prescribed_wind_2d ) then + ! Peter Lauritzen et al, "The terminator 'toy'-chemistry test: A simple tool to assess errors in transport schemes", + ! submitted to Geosci Model Dev, Oct 2014 + ! -- code to let dp evolve without vertical transport of tracers (consistent mass tracer coupling) + do q=1,qsize + do k=1,nlev + do j=1,np + do i=1,np + !elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = elem(ie)%state%Qdp(i,j,k,q,np1_qdp) * dp(i,j,k)/dp_star(i,j,k) + ttmp(i,j,k,1)= elem(ie)%state%Qdp(i,j,k,q,np1_qdp) / dp_star_moist(i,j,k) ! This is the actual q + elem(ie)%state%Qdp(i,j,k,q,np1_qdp) = ttmp(i,j,k,1) * dp_moist(i,j,k) + enddo + enddo + enddo + enddo + endif + endif + + + if (ntrac>0) then + do i=1,nc + do j=1,nc + ! + ! compute source (cdp) and target (dpc) pressure grids for vertical remapping + ! + do k=1,nlev + dpc(i,j,k) = (hvcoord%hyai(k+1) - hvcoord%hyai(k))*hvcoord%ps0 + & + (hvcoord%hybi(k+1) - hvcoord%hybi(k))*fvm(ie)%psc(i,j) + cdp(i,j,k,1:ntrac)=fvm(ie)%c(i,j,k,1:ntrac,n_fvm)*fvm(ie)%dp_fvm(i,j,k,n_fvm) + end do + end do + end do + dpc_star=fvm(ie)%dp_fvm(1:nc,1:nc,:,n_fvm) + call remap1(cdp,nc,1,ntrac,ntrac,dpc_star,dpc) + do k=1,nlev + do j=1,nc + do i=1,nc + fvm(ie)%dp_fvm(i,j,k,n_fvm)=dpc(i,j,k) + fvm(ie)%c(i,j,k,1:ntrac,n_fvm)=cdp(i,j,k,1:ntrac)/dpc(i,j,k) + end do + end do + end do + end if + ! call remap_velocityC(np1,dt,elem,fvm,hvcoord,ie) + enddo + end subroutine vertical_remap + +end module prim_advection_mod diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 new file mode 100644 index 0000000000..4ab4100746 --- /dev/null +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -0,0 +1,598 @@ +!#define _DBG_ print *,"file: ",__FILE__," line: ",__LINE__," ithr: ",hybrid%ithr +#define _DBG_ +module prim_driver_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_logfile, only: iulog + use dimensions_mod, only: np, nlev, nelem, nelemd, GlobalUniqueCols, qsize, nc,nhc + use hybrid_mod, only: hybrid_t, config_thread_region, PrintHybrid + use derivative_mod, only: derivative_t + use fvm_control_volume_mod, only: fvm_struct + + use element_mod, only: element_t, timelevels, allocate_element_desc + use thread_mod , only: horz_num_threads, vert_num_threads, tracer_num_threads + use perf_mod, only: t_startf, t_stopf + use prim_init, only: gp, fvm_corners, fvm_points + + implicit none + private + public :: prim_init2, prim_run_subcycle, prim_finalize + public :: prim_set_dry_mass + +contains + +!=============================================================================! + + subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) + use dimensions_mod, only: irecons_tracer + use dimensions_mod, only: fv_nphys, ntrac, nc + use cam_abortutils, only: endrun + use parallel_mod, only: syncmp + use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp + use prim_state_mod, only: prim_printstate + use control_mod, only: runtype, & + topology, rsplit, qsplit, rk_stage_user, & + nu, nu_q, nu_div, hypervis_subcycle, hypervis_subcycle_q + use fvm_control_volume_mod, only: fvm_supercycling,n0_fvm + use fvm_mod, only: fill_halo_fvm,ghostBufQnhc + use thread_mod, only: omp_get_thread_num + use global_norms_mod, only: test_global_integral, print_cfl + use hybvcoord_mod, only: hvcoord_t + use prim_advection_mod, only: prim_advec_init2,deriv + use prim_advance_mod, only: prim_advance_init, compute_omega + + type (element_t), intent(inout) :: elem(:) + type (fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid + + type (TimeLevel_t), intent(inout) :: tl ! time level struct + type (hvcoord_t), intent(inout) :: hvcoord ! hybrid vertical coordinate struct + + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + + + ! ================================== + ! Local variables + ! ================================== + +! variables used to calculate CFL + real (kind=r8) :: dtnu ! timestep*viscosity parameter + real (kind=r8) :: dt_dyn_vis ! viscosity timestep used in dynamics + real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers + + real (kind=r8) :: dp + + integer :: i,j,k,ie,t,q + integer :: n0,n0_qdp + + + do ie=nets,nete + elem(ie)%derived%FM=0.0_r8 + elem(ie)%derived%FT=0.0_r8 + elem(ie)%derived%FQ=0.0_r8 + end do + + ! ========================== + ! begin executable code + ! ========================== + call prim_advance_init(hybrid%par,elem) + + if (topology == "cube") then + call test_global_integral(elem, hybrid,nets,nete) + end if + + + ! compute most restrictive dt*nu for use by variable res viscosity: + ! compute timestep seen by viscosity operator: + dt_dyn_vis = tstep + dt_tracer_vis=tstep*qsplit + + ! compute most restrictive condition: + ! note: dtnu ignores subcycling + dtnu=max(dt_dyn_vis*max(nu,nu_div), dt_tracer_vis*nu_q) + ! compute actual viscosity timesteps with subcycling + dt_tracer_vis = dt_tracer_vis/hypervis_subcycle_q + dt_dyn_vis = dt_dyn_vis/hypervis_subcycle + + ! ================================== + ! Initialize derivative structure + ! ================================== + call Prim_Advec_Init2(fvm_corners, fvm_points) + if (fv_nphys>0.and.nc.ne.fv_nphys) then + ! + ! need to fill halo for dp_coupling for fvm2phys mapping + ! + call fill_halo_fvm(ghostBufQnhc,elem,fvm,hybrid,nets,nete,n0_fvm,nhc,1,nlev) + end if + !$OMP BARRIER + if (hybrid%ithr==0) then + call syncmp(hybrid%par) + end if + !$OMP BARRIER + + if (topology /= "cube") then + call endrun('Error: only cube topology supported for primaitve equations') + endif + + ! timesteps to use for advective stability: tstep*qsplit and tstep + call print_cfl(elem,hybrid,nets,nete,dtnu) + + if (hybrid%masterthread) then + ! CAM has set tstep based on dtime before calling prim_init2(), + ! so only now does HOMME learn the timstep. print them out: + write(iulog,'(a,2f9.2)') "dt_remap: (0=disabled) ",tstep*qsplit*rsplit + + if (ntrac>0) then + write(iulog,'(a,2f9.2)') "dt_tracer (fvm) ",tstep*qsplit*fvm_supercycling + end if + if (qsize>0) then + write(iulog,'(a,2f9.2)') "dt_tracer (SE), per RK stage: ",tstep*qsplit,(tstep*qsplit)/(rk_stage_user-1) + end if + write(iulog,'(a,2f9.2)') "dt_dyn: ",tstep + write(iulog,'(a,2f9.2)') "dt_dyn (viscosity): ",dt_dyn_vis + write(iulog,'(a,2f9.2)') "dt_tracer (viscosity): ",dt_tracer_vis + + + if (phys_tscale/=0) then + write(iulog,'(a,2f9.2)') "CAM physics timescale: ",phys_tscale + endif + write(iulog,'(a,2f9.2)') "CAM dtime (dt_phys): ",tstep*nsplit*qsplit*max(rsplit,1) + + write(iulog,*) "CAM-SE uses dry-mass vertical coordinates" + end if + + n0=tl%n0 + call TimeLevel_Qdp( tl, qsplit, n0_qdp) + call compute_omega(hybrid,n0,n0_qdp,elem,deriv,nets,nete,tstep,hvcoord) + + if (hybrid%masterthread) write(iulog,*) "initial state:" + call prim_printstate(elem, tl, hybrid,nets,nete, fvm) + + end subroutine prim_init2 + +!=======================================================================================================! + + + subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep) +! +! advance all variables (u,v,T,ps,Q,C) from time t to t + dt_q +! +! for the RK schemes: +! input: +! tl%nm1 not used +! tl%n0 data at time t +! tl%np1 new values at t+dt_q +! +! then we update timelevel pointers: +! tl%nm1 = tl%n0 +! tl%n0 = tl%np1 +! so that: +! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt +! tl%n0 time t + dt_q +! +! for the implicit schemes: +! +! input: +! tl%nm1 variables at t-1 level are stored fro BDF2 scheme +! tl%n0 data at time t +! tl%np1 new values at t+dt_q +! generally dt_q = t for BDF2, so its t+1 +! +! then we update timelevel pointers: +! tl%nm1 = tl%n0 +! tl%n0 = tl%np1 +! so that: +! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt +! tl%n0 time t + dt_q +! +! + use hybvcoord_mod, only : hvcoord_t + use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit + use control_mod, only: statefreq,disable_diagnostics,qsplit, rsplit + use prim_advance_mod, only: applycamforcing + use prim_advance_mod, only: calc_tot_energy_dynamics,compute_omega + use prim_state_mod, only: prim_printstate + use prim_advection_mod, only: vertical_remap, deriv + use fvm_control_volume_mod, only: n0_fvm + use thread_mod, only: omp_get_thread_num + use perf_mod , only: t_startf, t_stopf + use fvm_mod , only: fill_halo_fvm, ghostBufQnhc + use dimensions_mod, only: ntrac,fv_nphys + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout):: tl + integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit + + real(kind=r8) :: dt_q, dt_remap + integer :: ie, q,k,n0_qdp,np1_qdp,r, nstep_end,region_num_threads + real (kind=r8) :: dp_np1(np,np) + logical :: compute_diagnostics +! type (hybrid_t) :: vybrid + + ! =================================== + ! Main timestepping loop + ! =================================== + dt_q = dt*qsplit + dt_remap = dt_q + nstep_end = tl%nstep + qsplit + dt_remap=dt_q*rsplit + nstep_end = tl%nstep + qsplit*rsplit ! nstep at end of this routine + + ! compute diagnostics for STDOUT + compute_diagnostics=.false. + + if (statefreq>0) then + if (MODULO(nstep_end,statefreq)==0 .or. nstep_end==tl%nstep0) then + compute_diagnostics=.true. + endif + end if + + if(disable_diagnostics) compute_diagnostics=.false. + + + call TimeLevel_Qdp( tl, qsplit, n0_qdp) + + call calc_tot_energy_dynamics(elem,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,nets,nete,nsubstep) + + + ! loop over rsplit vertically lagrangian timesteps + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,1) + do r=2,rsplit + call TimeLevel_update(tl,"leapfrog") + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + enddo + ! defer final timelevel update until after remap and diagnostics + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! apply vertical remap + ! always for tracers + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !compute timelevels for tracers (no longer the same as dynamics) + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) + ! note: time level update for fvm tracers takes place in fvm_mod + + call calc_tot_energy_dynamics(elem,nets,nete,tl%np1,np1_qdp,'dAD') + + call t_startf('vertical_remap') + call vertical_remap(hybrid,elem,fvm,hvcoord,dt_remap,tl%np1,np1_qdp,n0_fvm,nets,nete) + call t_stopf('vertical_remap') + + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! time step is complete. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call calc_tot_energy_dynamics(elem,nets,nete,tl%np1,np1_qdp,'dAR') + + if (nsubstep==nsplit) & + call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt,hvcoord) + + ! now we have: + ! u(nm1) dynamics at t+dt_remap - 2*dt + ! u(n0) dynamics at t+dt_remap - dt + ! u(np1) dynamics at t+dt_remap + ! + ! Q(1) Q at t+dt_remap + + + + ! ================================= + ! update dynamics time level pointers + ! ================================= + call TimeLevel_update(tl,"leapfrog") + ! note: time level update for fvm tracers takes place in fvm_mod + + ! now we have: + ! u(nm1) dynamics at t+dt_remap - dt (Robert-filtered) + ! u(n0) dynamics at t+dt_remap + ! u(np1) undefined + + + ! ============================================================ + ! Print some diagnostic information + ! ============================================================ + if (compute_diagnostics) then + call prim_printstate(elem, tl, hybrid,nets,nete, fvm) + end if + + if (ntrac>0.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then + ! + ! fill the fvm halo for mapping in d_p_coupling if + ! physics grid resolution is different than fvm resolution + ! + call fill_halo_fvm(ghostBufQnhc, elem,fvm,hybrid,nets,nete,n0_fvm,nhc,1,nlev) + end if + + end subroutine prim_run_subcycle + + + subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + ! + ! Take qsplit dynamics steps and one tracer step + ! for vertically lagrangian option, this subroutine does only the horizontal step + ! + ! input: + ! tl%nm1 not used + ! tl%n0 data at time t + ! tl%np1 new values at t+dt_q + ! + ! then we update timelevel pointers: + ! tl%nm1 = tl%n0 + ! tl%n0 = tl%np1 + ! so that: + ! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt + ! tl%n0 time t + dt_q + ! + use hybvcoord_mod, only: hvcoord_t + use time_mod, only: TimeLevel_t, timelevel_update + use control_mod, only: statefreq, qsplit, nu_p + use control_mod, only: TRACERTRANSPORT_CONSISTENT_SE_FVM, tracer_transport_type + use thread_mod, only: omp_get_thread_num + use prim_advance_mod, only: prim_advance_exp + use prim_advection_mod, only: prim_advec_tracers_remap, prim_advec_tracers_fvm, deriv + use derivative_mod, only: subcell_integration + use fvm_control_volume_mod, only: fvm_supercycling + use hybrid_mod, only: set_region_num_threads, config_thread_region + use dimensions_mod, only: ntrac + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout) :: tl + integer, intent(in) :: rstep ! vertical remap subcycling step + + type (hybrid_t):: hybridnew + real(kind=r8) :: st, st1, dp, dt_q + integer :: ie,t,q,k,i,j,n, n_Q + integer :: ithr + integer :: region_num_threads + + real (kind=r8) :: tempdp3d(np,np), x + real (kind=r8) :: tempmass(nc,nc) + real (kind=r8) :: tempflux(nc,nc,4) + + real (kind=r8) :: dp_np1(np,np) + + dt_q = dt*qsplit + if (ntrac>0.and.rstep==1) then + do ie=nets,nete + elem(ie)%sub_elem_mass_flux=0 + end do + end if + + ! =============== + ! initialize mean flux accumulation variables and save some variables at n0 + ! for use by advection + ! =============== + do ie=nets,nete + elem(ie)%derived%vn0=0 ! mean horizontal mass flux + elem(ie)%derived%omega=0 + if (nu_p>0) then + elem(ie)%derived%dpdiss_ave=0 + elem(ie)%derived%dpdiss_biharmonic=0 + endif + + ! dp at time t: use floating lagrangian levels: + elem(ie)%derived%dp(:,:,:)=elem(ie)%state%dp3d(:,:,:,tl%n0) + enddo + + ! =============== + ! Dynamical Step + ! =============== + n_Q = tl%n0 ! n_Q = timelevel of FV tracers at time t. need to save this + ! FV tracers still carry 3 timelevels + ! SE tracers only carry 2 timelevels + + call t_startf('prim_advance_exp') +! ithr = 0 ! omp_get_thread_num() +! vybrid = hybrid_create(hybrid%par,ithr) + + call prim_advance_exp(elem, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('prim_advance_exp') + + do n=2,qsplit + call TimeLevel_update(tl,"leapfrog") + + call t_startf('prim_advance_exp') + + call prim_advance_exp(elem, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('prim_advance_exp') + + ! defer final timelevel update until after Q update. + enddo +#ifdef HOMME_TEST_SUB_ELEMENT_MASS_FLUX + if (ntrac>0.and.rstep==1) then + do ie=nets,nete + do k=1,nlev + tempdp3d = elem(ie)%state%dp3d(:,:,k,tl%np1) - & + elem(ie)%derived%dp(:,:,k) + call subcell_integration(tempdp3d, np, nc, elem(ie)%metdet,tempmass) + tempflux = dt_q*elem(ie)%sub_elem_mass_flux(:,:,:,k) + do i=1,nc + do j=1,nc + x = SUM(tempflux(i,j,:)) + if (ABS(tempmass(i,j)).lt.1e-11_r8 .and. 1e-11_r8.lt.ABS(x)) then + print *,__FILE__,__LINE__,"**********",ie,k,i,j,tempmass(i,j),x + elseif (1e-5_r8.lt.ABS((tempmass(i,j)-x)/tempmass(i,j))) then + print *,__FILE__,__LINE__,"**********",ie,k,i,j,tempmass(i,j),x,& + ABS((tempmass(i,j)-x)/tempmass(i,j)) + endif + end do + end do + end do + end do + end if +#endif + + ! current dynamics state variables: + ! derived%dp = dp at start of timestep + ! derived%vn0 = mean horiz. flux: U*dp + ! rsplit>0 + ! state%v(:,:,:,np1) = velocity on lagrangian levels + ! state%dp3d(:,:,:,np1) = dp3d + ! + + + ! =============== + ! Tracer Advection. + ! in addition, this routine will apply the DSS to: + ! derived%omega = + ! Tracers are always vertically lagrangian. + ! =============== + ! Advect tracers if their count is > 0. + ! special case in CAM: if CSLAM tracers are turned on , qsize=1 but this tracer should + ! not be advected. This will be cleaned up when the physgrid is merged into CAM trunk + ! Currently advecting all species + if (qsize > 0) then + + call t_startf('prim_advec_tracers_remap') + region_num_threads = tracer_num_threads +#ifdef _OPENMP + call omp_set_nested(.true.) +#endif +!JMD !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) +!JMD hybridnew = config_thread_region(hybrid,'tracer') + call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybrid,dt_q,tl,nets,nete) +!JMD !$OMP END PARALLEL +#ifdef _OPENMP + call omp_set_nested(.false.) +#endif + call t_stopf('prim_advec_tracers_remap') + end if + ! + ! only run fvm transport every fvm_supercycling rstep + ! + if (ntrac>0 .and. (mod(rstep,fvm_supercycling) == 0)) then + ! + ! FVM transport + ! + if (tracer_transport_type == TRACERTRANSPORT_CONSISTENT_SE_FVM) & + call Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& + dt_q,tl,nets,nete) + endif + + end subroutine prim_step + + +!=======================================================================================================! + + + subroutine prim_finalize(hybrid) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + + ! ========================== + ! end of the hybrid program + ! ========================== + end subroutine prim_finalize + +!========================================================================================= + + subroutine prim_set_dry_mass(elem, hvcoord,initial_global_ave_dry_ps,q) + use element_mod, only: element_t + use hybvcoord_mod , only: hvcoord_t + use dimensions_mod, only: nelemd, nlev, np + use constituents, only: cnst_type, qmin, pcnst + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + type (element_t) , intent(inout):: elem(:) + type (hvcoord_t) , intent(in) :: hvcoord + real (kind=r8), intent(in) :: initial_global_ave_dry_ps + real (kind=r8), intent(inout):: q(np,np,nlev,nelemd,pcnst) + + ! local + real (kind=r8) :: global_ave_ps_inic,dp_tmp, factor(np,np,nlev) + integer :: ie, i, j ,k, m_cnst + + if (initial_global_ave_dry_ps == 0) return; + + call get_global_ave_surface_pressure(elem, global_ave_ps_inic) + + do ie=1,nelemd + elem(ie)%state%psdry(:,:,1)=elem(ie)%state%psdry(:,:,1)*(initial_global_ave_dry_ps/global_ave_ps_inic) + do k=1,nlev + do j = 1,np + do i = 1,np + dp_tmp = ((hvcoord%hyai(k+1) - hvcoord%hyai(k))*hvcoord%ps0)+& + ((hvcoord%hybi(k+1) - hvcoord%hybi(k))*elem(ie)%state%psdry(i,j,1)) + factor(i,j,k) = elem(ie)%state%dp3d(i,j,k,1)/dp_tmp + elem(ie)%state%dp3d(i,j,k,:) = dp_tmp + end do + end do + end do + ! + ! conserve initial condition mass of 'wet' tracers (following dryairm.F90 for FV dycore) + ! and conserve mixing ratio (not mass) of 'dry' tracers + ! + do m_cnst=1,pcnst + if (cnst_type(m_cnst).ne.'dry') then + do k=1,nlev + do j = 1,np + do i = 1,np + q(i,j,k,ie,m_cnst) = q(i,j,k,ie,m_cnst)*factor(i,j,k) + q(i,j,k,ie,m_cnst) = max(qmin(m_cnst),q(i,j,k,ie,m_cnst)) + end do + end do + end do + end if + end do + end do + if (masterproc) then + write (iulog,*) "------ info from prim_set_dry_mass -----------------------------------------------------------" + write (iulog,*) "Scaling dry surface pressure to global average of = ",& + initial_global_ave_dry_ps/100.0_r8,"hPa" + write (iulog,*) "Average dry surface pressure in initial condition = ",global_ave_ps_inic/100.0_r8,"hPa" + write (iulog,*) "Average dry surface pressure change = ",& + initial_global_ave_dry_ps-global_ave_ps_inic,"Pa" + write (iulog,*) "Mixing ratios that are wet have been scaled so that total mass of tracer is conserved" + write (iulog,*) "Mixing ratios that are dry have not been changed (mass not conserved in scaling process)" + write (iulog,*) "------ end info from prim_set_dry_mass -------------------------------------------------------" + endif + end subroutine prim_set_dry_mass + + subroutine get_global_ave_surface_pressure(elem, global_ave_ps_inic) + use element_mod , only : element_t + use dimensions_mod , only : np + use global_norms_mod , only : global_integral + use hybrid_mod , only : config_thread_region, get_loop_ranges, hybrid_t + use parallel_mod , only : par + + type (element_t) , intent(in) :: elem(:) + real (kind=r8), intent(out) :: global_ave_ps_inic + + ! local + real (kind=r8), allocatable :: tmp(:,:,:) + type (hybrid_t) :: hybrid + integer :: ie, nets, nete + + !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n) + !JMD hybrid = config_thread_region(par,'horizontal') + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + allocate(tmp(np,np,nets:nete)) + + do ie=nets,nete + tmp(:,:,ie)=elem(ie)%state%psdry(:,:,1) + enddo + global_ave_ps_inic = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) + deallocate(tmp) + end subroutine get_global_ave_surface_pressure + +end module prim_driver_mod diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 new file mode 100644 index 0000000000..226713ab6a --- /dev/null +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -0,0 +1,394 @@ +module prim_init + + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: nc + use reduction_mod, only: reductionbuffer_ordered_1d_t + use quadrature_mod, only: quadrature_t, gausslobatto + + implicit none + private + save + + public :: prim_init1 + + real(r8), public :: fvm_corners(nc+1) ! fvm cell corners on reference element + real(r8), public :: fvm_points(nc) ! fvm cell centers on reference element + + type (quadrature_t), public :: gp ! element GLL points + type (ReductionBuffer_ordered_1d_t) :: red ! reduction buffer (shared) + +contains + subroutine prim_init1(elem, fvm, par, Tl) + use cam_logfile, only: iulog + use shr_sys_mod, only: shr_sys_flush + use thread_mod, only: max_num_threads + use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax + use dimensions_mod, only: GlobalUniqueCols, fv_nphys,irecons_tracer + use control_mod, only: topology, partmethod + use element_mod, only: element_t, allocate_element_desc + use fvm_mod, only: fvm_init1 + use mesh_mod, only: MeshUseMeshFile + use time_mod, only: timelevel_init, timelevel_t + use mass_matrix_mod, only: mass_matrix + use derivative_mod, only: allocate_subcell_integration_matrix_cslam + use derivative_mod, only: allocate_subcell_integration_matrix_physgrid + use cube_mod, only: cubeedgecount , cubeelemcount, cubetopology + use cube_mod, only: cube_init_atomic, rotation_init_atomic, set_corner_coordinates + use cube_mod, only: assign_node_numbers_to_elem + use mesh_mod, only: MeshSetCoordinates, MeshUseMeshFile, MeshCubeTopology + use mesh_mod, only: MeshCubeElemCount, MeshCubeEdgeCount + use metagraph_mod, only: metavertex_t, localelemcount, initmetagraph, printmetavertex + use gridgraph_mod, only: gridvertex_t, gridedge_t + use gridgraph_mod, only: allocate_gridvertex_nbrs, deallocate_gridvertex_nbrs + use schedtype_mod, only: schedule + use schedule_mod, only: genEdgeSched + use prim_advection_mod, only: prim_advec_init1 + use cam_abortutils, only: endrun + use spmd_utils, only: mpi_integer, mpi_max + use parallel_mod, only: parallel_t, syncmp, global_shared_buf, nrepro_vars + use spacecurve_mod, only: genspacepart + use dof_mod, only: global_dof, CreateUniqueIndex, SetElemOffset + use params_mod, only: SFCURVE + use physconst, only: pi + use reduction_mod, only: red_min, red_max, red_max_int, red_flops + use reduction_mod, only: red_sum, red_sum_int, initreductionbuffer + use infnan, only: nan, assignment(=) + use shr_reprosum_mod, only: repro_sum => shr_reprosum_calc + use fvm_analytic_mod, only: compute_basic_coordinate_vars + use fvm_control_volume_mod, only: fvm_struct, allocate_physgrid_vars + + type(element_t), pointer :: elem(:) + type(fvm_struct), pointer :: fvm(:) + type(parallel_t), intent(inout) :: par + type(timelevel_t), intent(out) :: Tl + + ! Local Variables + type (GridVertex_t), target,allocatable :: GridVertex(:) + type (GridEdge_t), target,allocatable :: Gridedge(:) + type (MetaVertex_t), target,allocatable :: MetaVertex(:) + + integer :: ie + integer :: nets, nete + integer :: nelem_edge + integer :: ierr, j + logical, parameter :: Debug = .FALSE. + + real(r8), allocatable :: aratio(:,:) + real(r8) :: area(1), xtmp + character(len=80) :: rot_type ! cube edge rotation type + + integer :: i + + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'PRIM_INIT1: ' + + ! ==================================== + ! Set cube edge rotation type for model + ! unnecessary complication here: all should + ! be on the same footing. RDL + ! ===================================== + rot_type = "contravariant" + + ! =============================================================== + ! Allocate and initialize the graph (array of GridVertex_t types) + ! =============================================================== + + if (topology=="cube") then + + if (par%masterproc) then + write(iulog,*) subname, "creating cube topology..." + call shr_sys_flush(iulog) + end if + + if (MeshUseMeshFile) then + nelem = MeshCubeElemCount() + nelem_edge = MeshCubeEdgeCount() + else + nelem = CubeElemCount() + nelem_edge = CubeEdgeCount() + end if + + allocate(GridVertex(nelem)) + allocate(GridEdge(nelem_edge)) + + do j = 1, nelem + call allocate_gridvertex_nbrs(GridVertex(j)) + end do + + if (MeshUseMeshFile) then + if (par%masterproc) then + write(iulog,*) subname, "Set up grid vertex from mesh..." + end if + call MeshCubeTopology(GridEdge, GridVertex) + else + call CubeTopology(GridEdge,GridVertex) + end if + + if (par%masterproc) then + write(iulog,*)"...done." + end if + end if + if(par%masterproc) then + write(iulog,*) subname, "total number of elements nelem = ",nelem + end if + + if(partmethod == SFCURVE) then + if(par%masterproc) then + write(iulog,*) subname, "partitioning graph using SF Curve..." + end if + call genspacepart(GridVertex) + else + write(errmsg, *) 'Unsupported partition method, ',partmethod + call endrun(subname//trim(errmsg)) + end if + + ! =========================================================== + ! given partition, count number of local element descriptors + ! =========================================================== + allocate(MetaVertex(1)) + allocate(Schedule(1)) + + nelem_edge = SIZE(GridEdge) + + ! ==================================================== + ! Generate the communication graph + ! ==================================================== + call initMetaGraph(par%rank+1,MetaVertex(1),GridVertex,GridEdge) + + nelemd = LocalElemCount(MetaVertex(1)) + if (par%masterproc .and. Debug) then + call PrintMetaVertex(MetaVertex(1)) + endif + + if(nelemd <= 0) then + call endrun(subname//'Not yet ready to handle nelemd = 0 yet' ) + end if + call mpi_allreduce(nelemd, nelemdmax, 1, MPI_INTEGER, MPI_MAX, par%comm, ierr) + + if (nelemd > 0) then + allocate(elem(nelemd)) + call allocate_element_desc(elem) + end if + + if (fv_nphys > 0) then + allocate(fvm(nelemd)) + call allocate_physgrid_vars(fvm,par) + else + ! Even if fvm not needed, still desirable to allocate it as empty + ! so it can be passed as a (size zero) array rather than pointer. + allocate(fvm(0)) + end if + + ! ==================================================== + ! Generate the communication schedule + ! ==================================================== + + call genEdgeSched(par, elem, par%rank+1, Schedule(1), MetaVertex(1)) + + allocate(global_shared_buf(nelemd, nrepro_vars)) + global_shared_buf = 0.0_r8 + + call syncmp(par) + + ! ================================================================= + ! Set number of domains (for 'decompose') equal to number of threads + ! for OpenMP across elements, equal to 1 for OpenMP within element + ! ================================================================= + + ! ================================================================= + ! Initialize shared boundary_exchange and reduction buffers + ! ================================================================= + if(par%masterproc) then + write(iulog,*) subname, 'init shared boundary_exchange buffers' + call shr_sys_flush(iulog) + end if + call InitReductionBuffer(red,3*nlev,max_num_threads) + call InitReductionBuffer(red_sum,5) + call InitReductionBuffer(red_sum_int,1) + call InitReductionBuffer(red_max,1) + call InitReductionBuffer(red_max_int,1) + call InitReductionBuffer(red_min,1) + call initReductionBuffer(red_flops,1) + + gp = gausslobatto(np) ! GLL points + + ! fvm nodes are equally spaced in alpha/beta + ! HOMME with equ-angular gnomonic projection maps alpha/beta space + ! to the reference element via simple scale + translation + ! thus, fvm nodes in reference element [-1,1] are a tensor product of + ! array 'fvm_corners(:)' computed below: + xtmp = nc + do i = 1, nc+1 + fvm_corners(i)= 2*(i-1)/xtmp - 1 ! [-1,1] including end points + end do + do i = 1, nc + fvm_points(i)= ( fvm_corners(i)+fvm_corners(i+1) ) /2 + end do + + if (topology == "cube") then + if(par%masterproc) then + write(iulog,*) subname, "initializing cube elements..." + call shr_sys_flush(iulog) + end if + if (MeshUseMeshFile) then + call MeshSetCoordinates(elem) + else + do ie = 1, nelemd + call set_corner_coordinates(elem(ie)) + end do + call assign_node_numbers_to_elem(elem, GridVertex) + end if + do ie = 1, nelemd + call cube_init_atomic(elem(ie),gp%points) + end do + end if + + ! ================================================================= + ! Initialize mass_matrix + ! ================================================================= + if(par%masterproc) then + write(iulog,*) subname, 'running mass_matrix' + call shr_sys_flush(iulog) + end if + call mass_matrix(par, elem) + allocate(aratio(nelemd,1)) + + if (topology == "cube") then + area = 0 + do ie = 1, nelemd + aratio(ie,1) = sum(elem(ie)%mp(:,:)*elem(ie)%metdet(:,:)) + end do + call repro_sum(aratio, area, nelemd, nelemd, 1, commid=par%comm) + area(1) = 4.0_r8*pi/area(1) ! ratio correction + deallocate(aratio) + if (par%masterproc) then + write(iulog,'(2a,f20.17)') subname, "re-initializing cube elements: area correction=", area(1) + call shr_sys_flush(iulog) + end if + + do ie = 1, nelemd + call cube_init_atomic(elem(ie),gp%points,area(1)) + call rotation_init_atomic(elem(ie),rot_type) + end do + end if + + if(par%masterproc) then + write(iulog,*) subname, 're-running mass_matrix' + call shr_sys_flush(iulog) + end if + call mass_matrix(par, elem) + + ! ================================================================= + ! Determine the global degree of freedome for each gridpoint + ! ================================================================= + if(par%masterproc) then + write(iulog,*) subname, 'running global_dof' + call shr_sys_flush(iulog) + end if + call global_dof(par, elem) + + ! ================================================================= + ! Create Unique Indices + ! ================================================================= + + do ie = 1, nelemd + call CreateUniqueIndex(elem(ie)%GlobalId,elem(ie)%gdofP,elem(ie)%idxP) + end do + + call SetElemOffset(par,elem, GlobalUniqueCols) + + do ie = 1, nelemd + elem(ie)%idxV=>elem(ie)%idxP + end do + + ! initialize flux terms to 0 + do ie = 1, nelemd + elem(ie)%derived%FM=0.0_r8 + elem(ie)%derived%FQ=0.0_r8 + elem(ie)%derived%FT=0.0_r8 + elem(ie)%derived%pecnd=0.0_r8 + + elem(ie)%derived%Omega=0 + elem(ie)%state%dp3d=0 + + elem(ie)%derived%etadot_prescribed = nan + elem(ie)%derived%u_met = nan + elem(ie)%derived%v_met = nan + elem(ie)%derived%dudt_met = nan + elem(ie)%derived%dvdt_met = nan + elem(ie)%derived%T_met = nan + elem(ie)%derived%dTdt_met = nan + elem(ie)%derived%ps_met = nan + elem(ie)%derived%dpsdt_met = nan + elem(ie)%derived%nudge_factor = nan + + elem(ie)%derived%Utnd=0._r8 + elem(ie)%derived%Vtnd=0._r8 + elem(ie)%derived%Ttnd=0._r8 + end do + + ! ========================================================== + ! This routines initalizes a Restart file. This involves: + ! I) Setting up the MPI datastructures + ! ========================================================== + deallocate(GridEdge) + do j = 1, nelem + call deallocate_gridvertex_nbrs(GridVertex(j)) + end do + deallocate(GridVertex) + + do j = 1, MetaVertex(1)%nmembers + call deallocate_gridvertex_nbrs(MetaVertex(1)%members(j)) + end do + deallocate(MetaVertex) + + ! ===================================== + ! Set number of threads... + ! ===================================== + if(par%masterproc) then + write(iulog,*) subname, "max_num_threads=",max_num_threads + call shr_sys_flush(iulog) + end if + + nets = 1 + nete = nelemd + call Prim_Advec_Init1(par, elem) + if (fv_nphys > 0) then + call fvm_init1(par,elem) + end if + + ! ======================================================= + ! Allocate memory for subcell flux calculations. + ! ======================================================= + call allocate_subcell_integration_matrix_cslam(np, nc) + if (fv_nphys > 0) then + call allocate_subcell_integration_matrix_physgrid(np, fv_nphys) + end if + + call TimeLevel_init(tl) + + if (fv_nphys > 0) then + if(par%masterproc) then + write(iulog,*) subname, 'initialize basic fvm coordinate variables' + call shr_sys_flush(iulog) + end if + do ie = 1, nelemd + call compute_basic_coordinate_vars(elem(ie), nc, irecons_tracer, & + fvm(ie)%dalpha, fvm(ie)%dbeta, fvm(ie)%vtx_cart(:,:,1:nc,1:nc), & + fvm(ie)%center_cart(1:nc,1:nc), fvm(ie)%area_sphere(1:nc,1:nc), & + fvm(ie)%spherecentroid(:,1:nc,1:nc)) + call compute_basic_coordinate_vars(elem(ie), fv_nphys, irecons_tracer,& + fvm(ie)%dalpha_physgrid, fvm(ie)%dbeta_physgrid, & + fvm(ie)%vtx_cart_physgrid (:,:,1:fv_nphys,1:fv_nphys), & + fvm(ie)%center_cart_physgrid(1:fv_nphys,1:fv_nphys), & + fvm(ie)%area_sphere_physgrid(1:fv_nphys,1:fv_nphys), & + fvm(ie)%spherecentroid_physgrid(:,1:fv_nphys,1:fv_nphys)) + end do + end if + + if(par%masterproc) then + write(iulog,*) subname, 'end of prim_init' + call shr_sys_flush(iulog) + end if + end subroutine prim_init1 +end module prim_init diff --git a/src/dynamics/se/dycore/prim_si_mod.F90 b/src/dynamics/se/dycore/prim_si_mod.F90 new file mode 100644 index 0000000000..7e7a484be4 --- /dev/null +++ b/src/dynamics/se/dycore/prim_si_mod.F90 @@ -0,0 +1,217 @@ +module prim_si_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + + implicit none + private + + public :: preq_hydrostatic, geopotential_t + public :: preq_pressure +contains + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 +! +! CCM3 hydrostatic integral +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 + subroutine preq_hydrostatic(phi,phis,T_v,p,dp) + use dimensions_mod, only : np, nlev + use physconst, only: rair + + + !------------------------------Arguments--------------------------------------------------------------- + real(kind=r8), intent(out) :: phi(np,np,nlev) + real(kind=r8), intent(in) :: phis(np,np) + real(kind=r8), intent(in) :: T_v(np,np,nlev) + real(kind=r8), intent(in) :: p(np,np,nlev) + real(kind=r8), intent(in) :: dp(np,np,nlev) + !------------------------------------------------------------------------------------------------------ + + !---------------------------Local workspace----------------------------- + integer i,j,k ! longitude, level indices + real(kind=r8) Hkk,Hkl ! diagonal term of energy conversion matrix + real(kind=r8), dimension(np,np,nlev) :: phii ! Geopotential at interfaces + !----------------------------------------------------------------------- + +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k,j,i,hkk,hkl) +#endif + do j=1,np ! Loop inversion (AAM) + + do i=1,np + hkk = dp(i,j,nlev)*0.5_r8/p(i,j,nlev) + hkl = 2*hkk + phii(i,j,nlev) = Rair*T_v(i,j,nlev)*hkl + phi(i,j,nlev) = phis(i,j) + Rair*T_v(i,j,nlev)*hkk + end do + + do k=nlev-1,2,-1 + do i=1,np + ! hkk = dp*ckk + hkk = dp(i,j,k)*0.5_r8/p(i,j,k) + hkl = 2*hkk + phii(i,j,k) = phii(i,j,k+1) + Rair*T_v(i,j,k)*hkl + phi(i,j,k) = phis(i,j) + phii(i,j,k+1) + Rair*T_v(i,j,k)*hkk + end do + end do + + do i=1,np + ! hkk = dp*ckk + hkk = 0.5_r8*dp(i,j,1)/p(i,j,1) + phi(i,j,1) = phis(i,j) + phii(i,j,2) + Rair*T_v(i,j,1)*hkk + end do + + end do + + +end subroutine preq_hydrostatic + + + +! +! The hydrostatic routine from CAM physics. +! (FV stuff removed) +! t,q input changed to take t_v +! removed gravit, so this routine returns PHI, not zm +subroutine geopotential_t( & + pmid , pdel , tv , rair , zm) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the geopotential height (above the surface) at the midpoints and +! interfaces using the input temperatures and pressures. +! +!----------------------------------------------------------------------- + use dimensions_mod, only : nlev, nlevp, np + implicit none + +!------------------------------Arguments-------------------------------- +! +! Input arguments + + + + real(r8), intent(in) :: pmid (np*np,nlev) ! Midpoint pressures + real(r8), intent(in) :: pdel (np*np,nlev) ! layer thickness + real(r8), intent(in) :: tv (np*np,nlev) ! temperature + real(r8), intent(in) :: rair ! Gas constant for dry air + ! real(r8), intent(in) :: gravit ! Acceleration of gravity + ! real(r8), intent(in) :: zvir ! rh2o/rair - 1 + +! Output arguments + + real(r8), intent(out) :: zm(np*np,nlev) ! Geopotential height at mid level +! +!---------------------------Local variables----------------------------- + integer :: ncol=np*np ! Number of longitudes + + integer :: i,k ! Lon, level indices + real(r8) :: hkk(np*np) ! diagonal element of hydrostatic matrix + real(r8) :: hkl(np*np) ! off-diagonal element + real(r8) :: rog ! Rair / gravit + real(r8) :: zi(np*np,nlevp) ! Height above surface at interfaces +! +!----------------------------------------------------------------------- +! +! rog = rair/gravit + rog = rair + +! The surface height is zero by definition. + do i = 1,ncol + zi(i,nlevp) = 0.0_r8 + end do + +! Compute zi, zm from bottom up. +! Note, zi(i,k) is the interface above zm(i,k) + do k = nlev, 1, -1 +! First set hydrostatic elements consistent with dynamics + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + +! Now compute tv, zm, zi + do i = 1,ncol + ! tvfac = 1._r8 + zvir * q(i,k) + ! tv = t(i,k) * tvfac + zm(i,k) = zi(i,k+1) + rog * tv(i,k) * hkk(i) + zi(i,k) = zi(i,k+1) + rog * tv(i,k) * hkl(i) + end do + end do + + return + end subroutine geopotential_t + + + + + +!----------------------------------------------------------------------- +! preq_pressure: +! +! Purpose: +! Define the pressures of the interfaces and midpoints from the +! coordinate definitions and the surface pressure. Originally plevs0! +! +! Method: +! +! Author: B. Boville/ Adapted for HOMME by Rich Loft +! +!----------------------------------------------------------------------- +! +! $Id: prim_si_mod.F90,v 2.10 2005/10/14 20:17:22 jedwards Exp $ +! $Author: jedwards $ +! +!----------------------------------------------------------------------- + + subroutine preq_pressure (ps0, ps, & + hyai, hybi, hyam, hybm, & + pint, pmid, pdel) + use dimensions_mod, only : np, nlev, nlevp + implicit none + + !----------------------------------------------------------------------- + + real(kind=r8), intent(in) :: ps0 ! Hybrid coordinate reference pressure (pascals) + real(kind=r8), intent(in) :: ps(np,np) ! Surface pressure (pascals) + real(kind=r8), intent(in) :: hyai(nlevp) ! Hybrid interface A coefficients + real(kind=r8), intent(in) :: hybi(nlevp) ! Hybrid interface B coefficients + real(kind=r8), intent(in) :: hyam(nlev) ! Hybrid midpoint A coefficients + real(kind=r8), intent(in) :: hybm(nlev) ! Hybrid midpoint B coefficients + real(kind=r8), intent(out) :: pint(np,np,nlevp) ! Pressure at model interfaces + real(kind=r8), intent(out) :: pmid(np,np,nlev) ! Pressure at model levels + real(kind=r8), intent(out) :: pdel(np,np,nlev) ! Layer thickness (pint(k+1) - pint(k)) + !----------------------------------------------------------------------- + + !---------------------------Local workspace----------------------------- + integer i,j,k ! Horizontal, level indices + !----------------------------------------------------------------------- + ! + ! Set interface pressures + ! + do k=1,nlevp + do j=1,np + do i=1,np + pint(i,j,k) = hyai(k)*ps0 + hybi(k)*ps(i,j) + end do + end do + end do + ! + ! Set midpoint pressures and layer thicknesses + ! + do k=1,nlev + do j=1,np + do i=1,np + pmid(i,j,k) = hyam(k)*ps0 + hybm(k)*ps(i,j) + pdel(i,j,k) = pint(i,j,k+1) - pint(i,j,k) + end do + end do + end do + + end subroutine preq_pressure + + + + +end module prim_si_mod diff --git a/src/dynamics/se/dycore/prim_state_mod.F90 b/src/dynamics/se/dycore/prim_state_mod.F90 new file mode 100644 index 0000000000..e1e80b1d1d --- /dev/null +++ b/src/dynamics/se/dycore/prim_state_mod.F90 @@ -0,0 +1,251 @@ +module prim_state_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_logfile, only: iulog + use dimensions_mod, only: nlev, np, nc, qsize_d, ntrac_d + use parallel_mod, only: ordered + use hybrid_mod, only: hybrid_t + use time_mod, only: timelevel_t, TimeLevel_Qdp, time_at + use control_mod, only: qsplit, statediag_numtrac + use global_norms_mod, only: global_integrals_general + use element_mod, only: element_t + use reduction_mod, only: parallelmax,parallelmin + use fvm_control_volume_mod, only: fvm_struct + + implicit none + private + + public :: prim_printstate + +CONTAINS + + subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm) + use fvm_control_volume_mod, only: n0_fvm + use dimensions_mod, only: ntrac + use constituents, only: cnst_name + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx_gll + use cam_control_mod, only: initial_run + + type (element_t), intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (TimeLevel_t), target, intent(in) :: tl + type (hybrid_t), intent(in) :: hybrid + integer, intent(in) :: nets,nete + + ! Local variables... + integer :: k,ie,m_cnst + integer, parameter :: type=ORDERED + + integer, parameter :: vmax=8+2*MAX(qsize_d,ntrac_d) + + character(len=7) :: varname(vmax) + + real (kind=r8), dimension(nets:nete,vmax) :: min_local,max_local + real (kind=r8), dimension(vmax) :: min_p,max_p,mass,mass_chg + real (kind=r8), dimension(np,np,nets:nete):: moist_ps + + real (kind=r8) :: tmp_gll(np,np,vmax,nets:nete),tmp_mass(vmax)! + real (kind=r8) :: tmp_fvm(nc,nc,vmax,nets:nete) + real (kind=r8) :: tmp_q(np,np,nlev) + integer :: n0, n0_qdp, q, nm, nm2 + real(kind=r8) :: da_gll(np,np,nets:nete),da_fvm(nc,nc,nets:nete) + + !dt=tstep*qsplit + !dt = tstep*qsplit*rsplit ! vertical REMAP timestep + !dynamics variables in n0 are at time = 'time': time=tl%nstep*tstep + if (hybrid%masterthread) then + write(iulog,*) "nstep=",tl%nstep," time=",Time_at(tl%nstep)/(24*3600)," [day]" + end if + ! dynamics timelevels + n0=tl%n0 + call TimeLevel_Qdp( tl, qsplit, n0_qdp) + ! moist surface pressure + do ie=nets,nete + moist_ps(:,:,ie)=elem(ie)%state%psdry(:,:,n0) + do q=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(q) + do k=1,nlev + moist_ps(:,:,ie) = moist_ps(:,:,ie)+& + elem(ie)%state%Qdp(:,:,k,m_cnst,n0_qdp) + end do + end do + enddo + ! weights/areas for global integrals + do ie=nets,nete + da_gll(:,:,ie) = elem(ie)%mp(:,:)*elem(ie)%metdet(:,:) + enddo + if (ntrac>0) then + do ie=nets,nete + da_fvm(:,:,ie) = fvm(ie)%area_sphere(:,:) + enddo + end if + ! + !********************************************* + ! + ! min/max of u,v,T,PS,OMEGA + ! + !********************************************* + ! + varname(1) = 'U ' + varname(2) = 'V ' + varname(3) = 'T ' + varname(4) = 'OMEGA ' + varname(5) = 'PSDRY ' + varname(6) = 'PS ' + nm = 6 ! number of vars before tracers + nm2 = 6+statediag_numtrac ! number of state diagnostics + do ie=nets,nete + min_local(ie,1) = MINVAL(elem(ie)%state%v(:,:,1,:,n0)) + max_local(ie,1) = MAXVAL(elem(ie)%state%v(:,:,1,:,n0)) + min_local(ie,2) = MINVAL(elem(ie)%state%v(:,:,2,:,n0)) + max_local(ie,2) = MAXVAL(elem(ie)%state%v(:,:,2,:,n0)) + min_local(ie,3) = MINVAL(elem(ie)%state%T(:,:,:,n0)) + max_local(ie,3) = MAXVAL(elem(ie)%state%T(:,:,:,n0)) + min_local(ie,4) = MINVAL(elem(ie)%derived%Omega(:,:,:)) + max_local(ie,4) = MAXVAL(elem(ie)%derived%Omega(:,:,:)) + min_local(ie,5) = MINVAL(elem(ie)%state%psdry(:,:,n0)) + max_local(ie,5) = MAXVAL(elem(ie)%state%psdry(:,:,n0)) + min_local(ie,6) = MINVAL(moist_ps(:,:,ie)) + max_local(ie,6) = MAXVAL(moist_ps(:,:,ie)) + + if (ntrac>0) then + do q=1,statediag_numtrac + varname(nm+q) = TRIM(cnst_name(q)) + min_local(ie,nm+q) = MINVAL(fvm(ie)%c(1:nc,1:nc,:,q,n0_fvm)) + max_local(ie,nm+q) = MAXVAL(fvm(ie)%c(1:nc,1:nc,:,q,n0_fvm)) + end do + else + do q=1,statediag_numtrac + varname(nm+q) = TRIM(cnst_name(q)) + tmp_q = elem(ie)%state%Qdp(:,:,:,q,n0_qdp)/elem(ie)%state%dp3d(:,:,:,n0) + min_local(ie,nm+q) = MINVAL(tmp_q) + max_local(ie,nm+q) = MAXVAL(tmp_q) + end do + end if + ! + ! forcing diagnostics + ! + varname(nm2+1) = 'FT ' + varname(nm2+2) = 'FM ' + min_local(ie,nm2+1) = MINVAL(elem(ie)%derived%FT(:,:,:)) + max_local(ie,nm2+1) = MAXVAL(elem(ie)%derived%FT(:,:,:)) + min_local(ie,nm2+2) = MINVAL(elem(ie)%derived%FM(:,:,:,:)) + max_local(ie,nm2+2) = MAXVAL(elem(ie)%derived%FM(:,:,:,:)) + if (ntrac>0) then + do q=1,statediag_numtrac + varname(nm2+2+q) = TRIM('F'//TRIM(cnst_name(q))) + min_local(ie,nm2+2+q) = MINVAL(fvm(ie)%fc(1:nc,1:nc,:,q)) + max_local(ie,nm2+2+q) = MAXVAL(fvm(ie)%fc(1:nc,1:nc,:,q)) + end do + else + do q=1,statediag_numtrac + varname(nm2+2+q) = TRIM('F'//TRIM(cnst_name(q))) + tmp_q = elem(ie)%derived%FQ(:,:,:,q) + min_local(ie,nm2+2+q) = MINVAL(tmp_q) + max_local(ie,nm2+2+q) = MAXVAL(tmp_q) + end do + end if + + end do + !JMD This is a Thread Safe Reduction + do k = 1, nm2+2+statediag_numtrac + min_p(k) = ParallelMin(min_local(:,k),hybrid) + max_p(k) = ParallelMax(max_local(:,k),hybrid) + end do + ! + !********************************************* + ! + ! Mass diagnostics + ! + !********************************************* + ! + ! tracers + ! + mass(1:nm) = -1.0_r8 + if (ntrac>0) then + do ie=nets,nete + do q=1,statediag_numtrac + tmp_fvm(:,:,q,ie) = SUM(fvm(ie)%c(1:nc,1:nc,:,q,n0_fvm)*fvm(ie)%dp_fvm(1:nc,1:nc,:,n0_fvm),DIM=3) + end do + end do + call global_integrals_general(tmp_fvm(:,:,1:statediag_numtrac,nets:nete),hybrid,nc,da_fvm,statediag_numtrac,& + nets,nete,tmp_mass(1:statediag_numtrac)) + else + do ie=nets,nete + do q=1,statediag_numtrac + tmp_gll(:,:,q,ie)=sum(elem(ie)%state%Qdp(:,:,:,q,n0_qdp),DIM=3) + end do + end do + call global_integrals_general(tmp_gll(:,:,1:statediag_numtrac,nets:nete),hybrid,np,da_gll,statediag_numtrac,& + nets,nete,tmp_mass(1:statediag_numtrac)) + end if + ! + ! convert to weight in hPa + ! + mass(nm+1:nm+statediag_numtrac)=tmp_mass(1:statediag_numtrac)*0.01_r8 + ! + ! compute dry and moist average PS + ! + do ie=nets,nete + tmp_gll(:,:,1,ie)=elem(ie)%state%psdry(:,:,n0) + tmp_gll(:,:,2,ie)=moist_ps(:,:,ie) + enddo + call global_integrals_general(tmp_gll(:,:,1:2,nets:nete),hybrid,np,da_gll,2,& + nets,nete,tmp_mass(1:2)) + ! + ! convert to hPa + ! + mass(5) = tmp_mass(1)*0.01_r8 + mass(6) = tmp_mass(2)*0.01_r8 + ! + ! compute relative mass change + ! + if (tl%nstep==0.or..not. initial_run) then + mass_chg(:) = 0.0_R8 + elem(nets)%derived%mass(1:statediag_numtrac) = mass(nm+1:nm+statediag_numtrac) + elem(nets)%derived%mass(statediag_numtrac+1) = mass(5) + elem(nets)%derived%mass(statediag_numtrac+2) = mass(6) + else + mass_chg(:) = 0.0_r8 + do q=1,statediag_numtrac + if (ABS(elem(nets)%derived%mass(q))<1.0e-12_r8) then + mass_chg(nm+q) =mass(nm+q) - elem(nets)%derived%mass(q) + else + mass_chg(nm+q) =(mass(nm+q) - elem(nets)%derived%mass(q))/elem(nets)%derived%mass(q) + end if + end do + mass_chg(5) =(mass(5) - elem(nets)%derived%mass(statediag_numtrac+1))/& + elem(nets)%derived%mass(statediag_numtrac+1) + mass_chg(6) =(mass(6) - elem(nets)%derived%mass(statediag_numtrac+2))/& + elem(nets)%derived%mass(statediag_numtrac+2) + end if + ! + ! write diagnostics to log file + ! + if(hybrid%masterthread) then + write(iulog,101) ' ','MIN','MAX','AVE (hPa)','REL. MASS. CHANGE' + do k=1,nm+statediag_numtrac + if (mass(k)==-1.0_r8) then + write(iulog,100) varname(k),min_p(k),max_p(k) + else + write(iulog,100) varname(k),min_p(k),max_p(k),mass(k),mass_chg(k) + end if + end do + ! + ! forcing diagnostics + ! + write(iulog,*) ' ' + write(iulog,*) 'FORCING DIAGNOSTICS' + write(iulog,*) ' ' + write(iulog,101) ' ','MIN','MAX' + do k=nm2+1,nm2+2+statediag_numtrac + write(iulog,100) varname(k),min_p(k),max_p(k) + end do + end if + +100 format (A8,4(E23.15)) +101 format (A8,A23,A23,A23,A23) + + end subroutine prim_printstate + + +end module prim_state_mod diff --git a/src/dynamics/se/dycore/quadrature_mod.F90 b/src/dynamics/se/dycore/quadrature_mod.F90 new file mode 100644 index 0000000000..ca6ba83578 --- /dev/null +++ b/src/dynamics/se/dycore/quadrature_mod.F90 @@ -0,0 +1,955 @@ +#undef _GAUSS_TABLE +module quadrature_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + + implicit none + private + + type, public :: quadrature_t + real (kind=r8), dimension(:), pointer :: points + real (kind=r8), dimension(:), pointer :: weights + end type quadrature_t + + public :: gausslobatto + public :: test_gausslobatto + public :: gauss + public :: test_gauss + public :: legendre + public :: jacobi + public :: quad_norm + + public :: trapezoid + private :: trapN + public :: simpsons + public :: gaussian_int + + private :: gausslobatto_pts + private :: gausslobatto_wts + private :: gauss_pts + private :: gauss_wts + private :: jacobi_polynomials + private :: jacobi_derivatives + + +contains + + ! ============================================================== + ! gauss: + ! + ! Find the Gauss collocation points and the corresponding weights. + ! + ! ============================================================== + + function gauss(npts) result(gs) + integer, intent(in) :: npts + type (quadrature_t) :: gs + + allocate(gs%points(npts)) + allocate(gs%weights(npts)) + + gs%points=gauss_pts(npts) + gs%weights=gauss_wts(npts,gs%points) + + end function gauss + +#if defined(_GAUSS_TABLE) + function gauss_pts(npts) result(pts) + + integer, intent(in) :: npts + real (kind=r8) :: pts(npts) + + pts(1) = -0.93246951420315202781_r8 + pts(2) = -0.66120938646626451366_r8 + pts(3) = -0.23861918608319690863_r8 + pts(4) = -pts(3) + pts(5) = -pts(2) + pts(6) = -pts(1) + + end function gauss_pts + + + function gauss_wts(npts,pts) result(wts) + + integer, intent(in) :: npts + real (kind=r8) :: pts(npts) + real (kind=r8) :: wts(npts) + + wts(1) = 0.17132449237917034504_r8 + wts(2) = 0.36076157304813860756_r8 + wts(3) = 0.46791393457269104738_r8 + wts(4) = wts(3) + wts(5) = wts(2) + wts(6) = wts(1) + + end function gauss_wts +#else + + ! ============================================================== + ! gauss_pts: + ! + ! Compute the Gauss Collocation points + ! for Jacobi Polynomials + ! + ! ============================================================== + + function gauss_pts(np1) result(pts) + use physconst, only: pi + + integer, intent(in) :: np1 ! Number of velocity grid points + real (kind=r8) :: pts(np1) + + ! Local variables + + real (kind=r8) :: alpha,beta + real (kind=r8) :: xjac(0:np1-1) + real (kind=r8) :: jac(0:np1) + real (kind=r8) :: djac(0:np1) + + integer prec ! number of mantissa bits + real (kind=r8) eps ! machine epsilon + real (kind=r8), parameter :: convthresh = 10 ! convergence threshold relative\ + + ! to machine epsilon + integer, parameter :: kstop = 30 ! max iterations for polynomial deflation + + real (kind=r8) :: poly + real (kind=r8) :: pder + real (kind=r8) :: recsum,thresh + real (kind=r8) :: dth + + real (kind=r8) :: x + real (kind=r8) :: delx + real (kind=r8) :: c0,c1,c2,c10 + + integer i,j,k + integer n, nh + + n = np1 - 1 + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + c10 = 10.0_r8 + alpha = c0 + beta = c0 + + ! ========================================================= + ! compute machine precision and set the convergence + ! threshold thresh to 10 times that level + ! ========================================================= + + prec = precision(c10) + eps = c10**(-prec) + thresh = convthresh*eps + + ! ============================================================ + ! Compute first half of the roots by "polynomial deflation". + ! ============================================================ + + dth = PI/(2*n+2) + + nh = (n+1)/2 + + do j=0,nh-1 + x=COS((c2*j+1)*dth) ! first guess at root + k=0 + delx=c1 + do while(k thresh) + call jacobi(n+1,x,alpha,beta,jac(0:n+1),djac(0:n+1)) + poly = jac(n+1) + pder = djac(n+1) + recsum=c0 + do i=0,j-1 + recsum = recsum + c1/(x-xjac(i)) + end do + delx = -poly/(pder-recsum*poly) + x = x + delx + k = k + 1 + end do + + xjac(j)=x + + end do + + ! ================================================ + ! compute the second half of the roots by symmetry + ! ================================================ + + do j=0,nh + xjac(n-j) = -xjac(j) + end do + + if (MODULO(n,2)==0) xjac(nh)=c0 + + ! ==================================================== + ! Reverse the sign of everything so that indexing + ! increases with position + ! ==================================================== + + do j=0,n + pts(j+1) = -xjac(j) + end do + + end function gauss_pts + + ! ================================================ + ! gauss_wts: + ! + ! Gauss Legendre Weights + ! ================================================ + + function gauss_wts(np1, gpts) result(wts) + + integer, intent(in) :: np1 + real (kind=r8), intent(in) :: gpts(np1) ! Gauss-Legendre points + real (kind=r8) :: wts(np1) ! Gauss-Legendre weights + + ! Local variables + + real (kind=r8) :: c0,c1,c2 + real (kind=r8) :: alpha + real (kind=r8) :: beta + real (kind=r8) :: djac(np1) + integer i,n + + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + + alpha = c0 + beta = c0 + n = np1-1 + + djac=jacobi_derivatives(np1,alpha,beta,np1,gpts) + + do i=1,np1 + wts(i)=c2/((c1-gpts(i)**2)*djac(i)*djac(i)) + end do + + end function gauss_wts + +#endif + + ! ============================================================== + ! test_gauss: + ! + ! Unit Tester for Gaussian Points, Weights + ! ============================================================== + + subroutine test_gauss(npts) + + integer, intent(in) :: npts + type (quadrature_t) :: gs + + integer i + real (kind=r8) :: gssum + gs=gauss(npts) + + print * + print *,"============================================" + print *," Testing Gaussian Quadrature..." + print * + print *," points weights" + print *,"============================================" + do i=1,npts + print *,i,gs%points(i),gs%weights(i) + end do + print *,"============================================" + gssum=SUM(gs%weights(:)) + print *,"sum of Gaussian weights=",gssum + print *,"============================================" + + deallocate(gs%points) + deallocate(gs%weights) + + end subroutine test_gauss + + ! ============================================================== + ! gausslobatto: + ! + ! Find the Gauss-Lobatto Legendre collocation points xgl(i) and the + ! corresponding weights. + ! + ! ============================================================== + + function gausslobatto(npts) result(gll) + + integer, intent(in) :: npts + type (quadrature_t) :: gll + + allocate(gll%points(npts)) + allocate(gll%weights(npts)) + + gll%points=gausslobatto_pts(npts) + gll%weights=gausslobatto_wts(npts,gll%points) + + end function gausslobatto + + ! ============================================================== + ! gausslobatto_pts: + ! + ! Compute the Gauss-Lobatto Collocation points + ! for Jacobi Polynomials + ! + ! ============================================================== + + function gausslobatto_pts(np1) result(pts) + use physconst, only: pi + + integer, intent(in) :: np1 ! Number of velocity grid points + real (kind=r8) :: pts(np1) + + ! Local variables + + real (kind=r8) :: alpha,beta + real (kind=r8) :: xjac(0:np1-1) + real (kind=r8) :: jac(0:np1) + real (kind=r8) :: jacm1(0:np1) + real (kind=r8) :: djac(0:np1) + + integer prec ! number of mantissa bits + real (kind=r8) eps ! machine epsilon + real (kind=r8), parameter :: convthresh = 10 ! convergence threshold relative + ! to machine epsilon + integer, parameter :: kstop = 30 ! max iterations for polynomial deflation + + real (kind=r8) :: a,b,det + real (kind=r8) :: poly + real (kind=r8) :: pder + real (kind=r8) :: recsum,thresh + real (kind=r8) :: dth,cd,sd,cs,ss,cstmp + + real (kind=r8) :: x + real (kind=r8) :: delx + real (kind=r8) :: c0,c1,c2,c10 + + integer i,j,k + integer n, nh + + n = np1 - 1 + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + c10 = 10.0_r8 + + alpha = c0 + beta = c0 + + ! ========================================================= + ! compute machine precision and set the convergence + ! threshold thresh to 10 times that level + ! ========================================================= + + prec = PRECISION(c10) + eps = c10**(-prec) + thresh = convthresh*eps + + ! ===================================================== + ! initialize the end points + ! ===================================================== + + xjac(0) = c1 + xjac(n) = -c1 + + ! ============================================================ + ! Compute first half of the roots by "polynomial deflation". + ! ============================================================ + + ! ============================================================ + ! compute the parameters in the polynomial whose + ! roots are desired... + ! ============================================================ + + call jacobi(n+1, c1,alpha,beta,jac(0:n+1),djac(0:n+1)) + call jacobi(n+1,-c1,alpha,beta,jacm1(0:n+1),djac(0:n+1)) + + det = jac(n )*jacm1(n-1)-jacm1(n )*jac(n-1) + a = -(jac(n+1)*jacm1(n-1)-jacm1(n+1)*jac(n-1))/det + b = -(jac(n )*jacm1(n+1)-jacm1(n )*jac(n+1))/det + + dth = PI/(2*n+1) + cd = COS(c2*dth) + sd = SIN(c2*dth) + cs = COS(dth) + ss = SIN(dth) + + nh = (n+1)/2 + + do j=1,nh-1 + x=cs ! first guess at root + k=0 + delx=c1 + do while(k thresh) + call jacobi(n+1,x,alpha,beta,jac(0:n+1),djac(0:n+1)) + poly = jac(n+1)+a* jac(n)+b* jac(n-1) + pder = djac(n+1)+a*djac(n)+b*djac(n-1) + recsum=c0 + do i=0,j-1 + recsum = recsum + c1/(x-xjac(i)) + end do + delx = -poly/(pder-recsum*poly) + x = x + delx + k = k + 1 + end do + + xjac(j)=x + + ! ===================================================== + ! compute the guesses for the roots + ! for the next points, i.e : + ! + ! ss = sn(theta) => sin(theta+2*dth) + ! cs = cs(theta) => cs(theta+2*dth) + ! ===================================================== + + cstmp=cs*cd-ss*sd + ss=cs*sd+ss*cd + cs=cstmp + end do + + ! ================================================ + ! compute the second half of the roots by symmetry + ! ================================================ + + do j=1,nh + xjac(n-j) = -xjac(j) + end do + + if (MODULO(n,2)==0) xjac(nh)=c0 + + ! ==================================================== + ! Reverse the sign of everything so that indexing + ! increases with position + ! ==================================================== + + do j=0,n + pts(j+1) = -xjac(j) + end do + + end function gausslobatto_pts + + ! ================================================ + ! Gauss Lobatto Legendre Weights + ! ================================================ + + function gausslobatto_wts(np1, glpts) result(wts) + + integer, intent(in) :: np1 + real (kind=r8), intent(in) :: glpts(np1) + real (kind=r8) :: wts(np1) + + ! Local variables + + real (kind=r8) :: c0,c2 + real (kind=r8) :: alpha + real (kind=r8) :: beta + real (kind=r8) :: jac(np1) + integer i,n + + c0 = 0.0_r8 + c2 = 2.0_r8 + alpha = c0 + beta = c0 + n = np1-1 + + jac=jacobi_polynomials(n,alpha,beta,np1,glpts) + + do i=1,np1 + wts(i)=c2/(n*(n+1)*jac(i)*jac(i)) + end do + + end function gausslobatto_wts + + ! ============================================================== + ! test_gausslobatto: + ! + ! Unit Tester for Gaussian Lobatto Quadrature... + ! ============================================================== + + subroutine test_gausslobatto(npts) + integer, intent(in) :: npts + type (quadrature_t) :: gll + + integer i + real (kind=r8) :: gllsum + gll=gausslobatto(npts) + + print * + print *,"============================================" + print *," Testing Gauss-Lobatto Quadrature..." + print * + print *," points weights" + print *,"============================================" + do i=1,npts + print *,i,gll%points(i),gll%weights(i) + end do + print *,"============================================" + gllsum=SUM(gll%weights(:)) + print *,"sum of Gauss-Lobatto weights=",gllsum + print *,"============================================" + + deallocate(gll%points) + deallocate(gll%weights) + + end subroutine test_gausslobatto + + ! ================================================ + ! + ! subroutine jacobi: + ! + ! Computes the Jacobi Polynomials (jac) and their + ! first derivatives up to and including degree n + ! at point x on the interval (-1,1). + ! + ! See for example the recurrence relations + ! in equation 2.5.4 (page 70) in + ! + ! "Spectral Methods in Fluid Dynamics", + ! by C. Canuto, M.Y. Hussaini, A. Quarteroni, T.A.Zang + ! Springer-Verlag, 1988. + ! ================================================ + + subroutine jacobi(n, x, alpha, beta, jac, djac) + + integer, intent(in) :: n + real (kind=r8), intent(in) :: x + real (kind=r8), intent(in) :: alpha + real (kind=r8), intent(in) :: beta + real (kind=r8) :: jac(0:n) + real (kind=r8) :: djac(0:n) + + ! Local variables + + real (kind=r8) :: a1k + real (kind=r8) :: a2k + real (kind=r8) :: a3k + real (kind=r8) :: da2kdx + + real (kind=r8) :: c2,c1,c0 + + integer :: k + + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + + jac(0)=c1 + jac(1)=(c1 + alpha)*x + + djac(0)=c0 + djac(1)=(c1 + alpha) + + do k=1,n-1 + a1k = c2*( k + c1 )*( k + alpha + beta + c1 )*( c2*k + alpha + beta ) + da2kdx = ( c2*( k + c1 ) + alpha + beta )*( c2*k + alpha + beta + c1 )*( c2*k + alpha + beta ) + a2k = ( c2*k + alpha + beta + c1 )*( alpha*alpha - beta*beta ) + x*da2kdx + a3k = c2*(k + alpha)*( k + beta )*( c2*k + alpha + beta + c2 ) + jac(k+1) = ( a2k*jac(k)-a3k*jac(k-1) )/a1k + djac(k+1)= ( a2k*djac(k) + da2kdx*jac(k) - a3k*djac(k-1) )/a1k + end do + + end subroutine jacobi + + + ! ========================================================== + ! This routine computes the Nth order Jacobi Polynomials + ! (jac) for a vector of positions x on the interval (-1,1), + ! of length npoints. + ! + ! See for example the recurrence relations + ! in equation 2.5.4 (page 70) in + ! + ! "Spectral Methods in Fluid Dynamics", + ! by C. Canuto, M.Y. Hussaini, A. Quarteroni, T.A.Zang + ! Springer-Verlag, 1988. + ! + ! =========================================================== + + function jacobi_polynomials(n, alpha, beta, npoints, x) result(jac) + + integer, intent(in) :: n ! order of the Jacobi Polynomial + real (kind=r8) :: alpha + real (kind=r8) :: beta + integer, intent(in) :: npoints + real (kind=r8) :: x(npoints) + real (kind=r8) :: jac(npoints) + + ! Local variables + + real (kind=r8) :: a1k + real (kind=r8) :: a2k + real (kind=r8) :: a3k + real (kind=r8) :: da2kdx + + real (kind=r8) :: jacp1 + real (kind=r8) :: jacm1 + real (kind=r8) :: jac0 + real (kind=r8) :: xtmp + + real (kind=r8) :: c2,c1,c0 + integer j,k + + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + + do j = 1,npoints + + xtmp=x(j) + + jacm1=c1 + jac0 =(c1+alpha)*xtmp + + do k=1,n-1 + a1k=c2*(k+c1)*(k+alpha+beta+c1)*(c2*k+alpha+beta) + da2kdx=(c2*k+alpha+beta+c2)*(c2*k+alpha+beta+c1)*(c2*k+alpha+beta) + a2k=(c2*k+alpha+beta+c1)*(alpha*alpha-beta*beta) + xtmp*da2kdx + a3k=c2*(k+alpha)*(k+beta)*(c2*k+alpha+beta+c2) + jacp1=(a2k*jac0-a3k*jacm1)/a1k + jacm1=jac0 + jac0 =jacp1 + end do + + if (n==0)jac0=jacm1 + jac(j)=jac0 + end do + + end function jacobi_polynomials + + ! ================================================ + ! This routine computes the first derivatives of Nth + ! order Jacobi Polynomials (djac) for a vector of + ! positions x on the interval (-1,1), of length npoints. + ! + ! See for example the recurrence relations + ! in equation 2.5.4 (page 70) in + ! + ! "Spectral Methods in Fluid Dynamics", + ! by C. Canuto, M.Y. Hussaini, A. Quarteroni, T.A.Zang + ! Springer-Verlag, 1988. + ! + ! ================================================ + + function jacobi_derivatives(n, alpha, beta, npoints, x) result(djac) + + integer , intent(in) :: n ! order of the Jacobi Polynomial + real (kind=r8), intent(in) :: alpha + real (kind=r8), intent(in) :: beta + integer , intent(in) :: npoints + real (kind=r8), intent(in) :: x(npoints) + + real (kind=r8) :: djac(npoints) + + ! Local variables + + ! Local variables + + real (kind=r8) :: a1k + real (kind=r8) :: a2k + real (kind=r8) :: a3k + real (kind=r8) :: da2kdx + + real (kind=r8) :: jacp1 + real (kind=r8) :: jacm1 + real (kind=r8) :: jac0 + real (kind=r8) :: djacp1 + real (kind=r8) :: djacm1 + real (kind=r8) :: djac0 + + real (kind=r8) :: xtmp + + real (kind=r8) :: c2,c1,c0 + integer j,k + + c0 = 0.0_r8 + c1 = 1.0_r8 + c2 = 2.0_r8 + + do j = 1,npoints + + xtmp=x(j) + + jacm1=c1 + jac0 =(c1+alpha)*xtmp + + djacm1 = c0 + djac0 = (c1+alpha) + + do k=1,n-1 + a1k=c2*(k+c1)*(k+alpha+beta+c1)*(c2*k+alpha+beta) + da2kdx=(c2*k+alpha+beta+c2)*(c2*k+alpha+beta+c1)*(c2*k+alpha+beta) + a2k=(c2*k+alpha+beta+c1)*(alpha*alpha-beta*beta) + xtmp*da2kdx + a3k=c2*(k+alpha)*(k+beta)*(c2*k+alpha+beta+c2) + + jacp1=(a2k*jac0-a3k*jacm1)/a1k + djacp1=(a2k*djac0+da2kdx*jac0-a3k*djacm1)/a1k + + jacm1=jac0 + jac0=jacp1 + + djacm1=djac0 + djac0=djacp1 + + end do + + if (n==0)djac0=djacm1 + djac(j)=djac0 + + end do + + end function jacobi_derivatives + + ! =================================================== + ! + ! legendre: + ! + ! Compute the legendre polynomials using + ! the recurrence relationship. + ! return leg(m+1) = P_N(x) for m=0..N + ! p_3 = Legendre polynomial of degree N + ! p_2 = Legendre polynomial of degree N-1 at x + ! p_1 = Legendre polynomial of degree N-2 at x + ! + ! =================================================== + + function legendre(x,N) result(leg) + + integer :: N + real (kind=r8) :: x + real (kind=r8) :: leg(N+1) + + real (kind=r8) :: p_1, p_2, p_3 + integer :: k + + p_3 = 1.0_r8 + leg(1)=p_3 + if (n.ne.0) then + p_2 = p_3 + p_3 = x + leg(2)=p_3 + do k = 2,N + p_1 = p_2 + p_2 = p_3 + p_3 = ( (2*k-1)*x*p_2 - (k-1)*p_1 ) / k + leg(k+1)=p_3 + end do + end if + + end function legendre + + + ! =========================================== + ! quad_norm: + ! + ! compute normalization constants + ! for k=1,N order Legendre polynomials + ! + ! e.g. gamma(k) in Canuto, page 58. + ! + ! =========================================== + + function quad_norm(gquad,N) result(gamma) + type (quadrature_t), intent(in) :: gquad + integer , intent(in) :: N + + real (kind=r8) :: gamma(N) + + ! Local variables + real (kind=r8) :: leg(N) + integer :: i,k + + gamma(:)=0.0_r8 + + do i=1,N + leg=legendre(gquad%points(i),N-1) + do k=1,N + gamma(k)= gamma(k)+leg(k)*leg(k)*gquad%weights(i) + end do + end do + + end function quad_norm + + ! ======================= + ! TrapN: + ! Numerical recipes + ! ======================= + + subroutine trapN(f,a,b,N,it,s) + INTERFACE + FUNCTION f(x) RESULT(f_x) ! Function to be integrated + use shr_kind_mod, only: r8=>shr_kind_r8 + real(kind=r8), INTENT(IN) :: x + real(kind=r8) :: f_x + END FUNCTION f + END INTERFACE + + real(kind=r8),intent(in) :: a,b + integer, intent(in) :: N + integer, intent(inout) :: it + real(kind=r8), intent(inout) :: s + + real(kind=r8) :: ssum + real(kind=r8) :: del + real(kind=r8) :: rtnm + real(kind=r8) :: x + + integer :: j + + if (N==1) then + s = 0.5_r8*(b-a)*(f(a) + f(b)) + it =1 + else + ssum = 0.0_r8 + rtnm =1.0_r8/it + del = (b-a)*rtnm + x=a+0.5_r8*del + do j=1,it + ssum = ssum + f(x) + x=x+del + end do + s=0.5_r8*(s + del*ssum) + it=2*it + end if + + end subroutine trapN + + ! ========================================== + ! Trapezoid Rule for integrating functions + ! from a to b with residual error eps + ! ========================================== + + function trapezoid(f,a,b,eps) result(Integral) + + integer, parameter :: Nmax = 25 ! At most 2^Nmax + 1 points in integral + + INTERFACE + FUNCTION f(x) RESULT(f_x) ! Function to be integrated + use shr_kind_mod, only: r8=>shr_kind_r8 + real(kind=r8), INTENT(IN) :: x + real(kind=r8) :: f_x + END FUNCTION f + END INTERFACE + + real(kind=r8), intent(in) :: a,b ! The integral bounds + real(kind=r8), intent(in) :: eps ! relative error bound for integral + real(kind=r8) :: Integral ! the integral result (within eps) + real(kind=r8) :: s ! Integral approximation + real(kind=r8) :: sold ! previous integral approx + + integer :: N + integer :: it + + ! ============================================================== + ! Calculate I here using trapezoid rule using f and a DO loop... + ! ============================================================== + + s = 1.0e30_r8 + sold = 0.0_r8 + N=1 + it=0 + do while(N<=Nmax .and. ABS(s-sold)>eps*ABS(sold)) + sold=s + call trapN(f,a,b,N,it,s) + N=N+1 + end do + + Integral = s + + end function trapezoid + + ! ========================================== + ! Simpsons Rule for integrating functions + ! from a to b with residual error eps + ! ========================================== + + function simpsons(f,a,b,eps) result(Integral) + + integer, parameter :: Nmax = 25 ! At most 2^Nmax + 1 points in integral + + INTERFACE + FUNCTION f(x) RESULT(f_x) ! Function to be integrated + use shr_kind_mod, only: r8=>shr_kind_r8 + real(kind=r8), INTENT(IN) :: x + real(kind=r8) :: f_x + END FUNCTION f + END INTERFACE + + real(kind=r8), intent(in) :: a,b ! The integral bounds + real(kind=r8), intent(in) :: eps ! relative error bound for integral + real(kind=r8) :: Integral ! the integral result (within eps) + real(kind=r8) :: s ! Integral approximation + real(kind=r8) :: os ! previous integral approx + real(kind=r8) :: st ! Integral approximation + real(kind=r8) :: ost ! previous integral approx + + integer :: N + integer :: it + + ! ============================================================== + ! Calculate I here using trapezoid rule using f and a DO loop... + ! ============================================================== + + ost= 0.0_r8 + s = 1.0e30_r8 + os = 0.0_r8 + + N=1 + it=0 + do while ((N<=Nmax .and. ABS(s-os)>eps*ABS(os) ) .or. N<=2) + os = s + call trapN(f,a,b,N,it,st) + s=(4.0_r8*st-ost)/3.0_r8 + ost=st + N=N+1 + end do + + Integral = s + + end function simpsons + + + ! ========================================== + ! gaussian_int: + ! + ! Gaussian Quadrature Rule for integrating + ! function f from a to b with gs weights and + ! points with precomputed gaussian quadrature + ! and weights. + ! ========================================== + + function gaussian_int(f,a,b,gs) result(Integral) + + integer, parameter :: Nmax = 10 ! At most 2^Nmax + 1 points in integral + + INTERFACE + FUNCTION f(x) RESULT(f_x) ! Function to be integrated + use shr_kind_mod, only: r8=>shr_kind_r8 + real(kind=r8), INTENT(IN) :: x + real(kind=r8) :: f_x + END FUNCTION f + END INTERFACE + + real(kind=r8), intent(in) :: a,b ! The integral bounds + type(quadrature_t), intent(in) :: gs ! gaussian points/wts + real(kind=r8) :: Integral ! the integral result (within eps) + + integer :: i + real (kind=r8) :: s,x + ! ============================================================== + ! Calculate I = S f(x)dx here using gaussian quadrature + ! ============================================================== + + s = 0.0_r8 + do i=1,SIZE(gs%points) + x = 0.50_r8*((b-a)*gs%points(i) + (b+a)) + s = s + gs%weights(i)*f(x) + end do + Integral = s*(0.5_r8*(b-a)) + + end function gaussian_int + +end module quadrature_mod + + + + + diff --git a/src/dynamics/se/dycore/reduction_mod.F90 b/src/dynamics/se/dycore/reduction_mod.F90 new file mode 100644 index 0000000000..3f8afbc3c9 --- /dev/null +++ b/src/dynamics/se/dycore/reduction_mod.F90 @@ -0,0 +1,447 @@ +module reduction_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: mpi_sum, mpi_min, mpi_max, mpi_real8, mpi_integer + use spmd_utils, only: mpi_success + use cam_abortutils, only: endrun + + implicit none + private + + type, public :: ReductionBuffer_int_1d_t + integer, dimension(:), pointer :: buf + integer :: len=0 + integer :: ctr + end type ReductionBuffer_int_1d_t + + type, public :: ReductionBuffer_r_1d_t + real (kind=r8), dimension(:), pointer :: buf + integer :: len=0 + integer :: ctr + end type ReductionBuffer_r_1d_t + + type, public :: ReductionBuffer_ordered_1d_t + real (kind=r8), dimension(:,:),pointer :: buf + integer :: len=0 + integer :: ctr + end type ReductionBuffer_ordered_1d_t + + public :: ParallelMin + public :: ParallelMax + + type (ReductionBuffer_int_1d_t), public :: red_max_int + type (ReductionBuffer_int_1d_t), public :: red_sum_int + type (ReductionBuffer_r_1d_t), public :: red_flops + type (ReductionBuffer_r_1d_t), public :: red_max + type (ReductionBuffer_r_1d_t), public :: red_min + type (ReductionBuffer_r_1d_t), public :: red_sum +#ifndef Darwin + SAVE red_max_int, red_sum_int, red_flops, red_max, red_min, red_sum +#endif + + interface ParallelMin + module procedure ParallelMin1d + module procedure ParallelMin0d + end interface + interface ParallelMax + module procedure ParallelMax1d_int + module procedure ParallelMax2d_int + module procedure ParallelMax1d + module procedure ParallelMax0d + module procedure ParallelMax0d_int + end interface + + interface pmax_mt + module procedure pmax_mt_int_1d + module procedure pmax_mt_r_1d + end interface + + interface pmin_mt + module procedure pmin_mt_r_1d + end interface + + interface InitReductionBuffer + module procedure InitReductionBuffer_int_1d + module procedure InitReductionBuffer_r_1d + module procedure InitReductionBuffer_ordered_1d + end interface + + public :: InitReductionBuffer + public :: pmax_mt, pmin_mt + public :: ElementSum_1d + +contains + + function ParallelMin1d(data,hybrid) result(pmin) + use hybrid_mod, only : hybrid_t + + real(kind=r8), intent(in) :: data(:) + type (hybrid_t), intent(in) :: hybrid + real(kind=r8) :: pmin + + real(kind=r8) :: tmp(1) + + + tmp(1) = MINVAL(data) + call pmin_mt(red_min,tmp,1,hybrid) + pmin = red_min%buf(1) + + end function ParallelMin1d + + function ParallelMin0d(data,hybrid) result(pmin) + use hybrid_mod, only : hybrid_t + implicit none + real(kind=r8), intent(in) :: data + type (hybrid_t), intent(in) :: hybrid + real(kind=r8) :: pmin + real(kind=r8) :: tmp(1) + tmp(1) = data + call pmin_mt(red_min,tmp,1,hybrid) + pmin = red_min%buf(1) + + end function ParallelMin0d + !================================================== + function ParallelMax2d_int(data, n, m, hybrid) result(pmax) + use hybrid_mod, only : hybrid_t + implicit none + integer, intent(in) :: n,m + integer, intent(in), dimension(n,m) :: data + type (hybrid_t), intent(in) :: hybrid + integer, dimension(n,m) :: pmax + integer, dimension(n*m) :: tmp + integer :: i,j + do i=1,n + do j=1,m + tmp(i+(j-1)*n) = data(i,j) + enddo + enddo + call pmax_mt(red_max_int,tmp,n*m,hybrid) + do i=1,n + do j=1,m + pmax(i,j) = red_max_int%buf(i+(j-1)*n) + enddo + enddo + end function ParallelMax2d_int + + function ParallelMax1d_int(data, len, hybrid) result(pmax) + use hybrid_mod, only : hybrid_t + implicit none + integer, intent(in) :: len + integer, intent(in), dimension(len) :: data + type (hybrid_t), intent(in) :: hybrid + integer, dimension(len) :: pmax, tmp + + tmp = data(:) + call pmax_mt(red_max_int,tmp,len,hybrid) + pmax(:) = red_max_int%buf(1:len) + + end function ParallelMax1d_int + function ParallelMax1d(data,hybrid) result(pmax) + use hybrid_mod, only : hybrid_t + implicit none + real(kind=r8), intent(in) :: data(:) + type (hybrid_t), intent(in) :: hybrid + real(kind=r8) :: pmax + + real(kind=r8) :: tmp(1) + + + tmp(1) = MAXVAL(data) + call pmax_mt(red_max,tmp,1,hybrid) + pmax = red_max%buf(1) + + end function ParallelMax1d + function ParallelMax0d(data,hybrid) result(pmax) + use hybrid_mod, only : hybrid_t + implicit none + real(kind=r8), intent(in) :: data + type (hybrid_t), intent(in) :: hybrid + real(kind=r8) :: pmax + real(kind=r8) :: tmp(1) + + tmp(1)=data + + call pmax_mt(red_max,tmp,1,hybrid) + pmax = red_max%buf(1) + + end function ParallelMax0d + function ParallelMax0d_int(data,hybrid) result(pmax) + use hybrid_mod, only : hybrid_t + implicit none + integer , intent(in) :: data + type (hybrid_t), intent(in) :: hybrid + integer :: pmax + integer :: tmp(1) + + tmp(1)=data + + call pmax_mt(red_max_int,tmp,1,hybrid) + pmax = red_max_int%buf(1) + + end function ParallelMax0d_int + !================================================== + subroutine InitReductionBuffer_int_1d(red,len) + use thread_mod, only: omp_get_num_threads + integer, intent(in) :: len + type (ReductionBuffer_int_1d_t),intent(out) :: red + + if (omp_get_num_threads()>1) then + call endrun("Error: attempt to allocate reduction buffer in threaded region") + endif + + ! if buffer is already allocated and large enough, do nothing + if (len > red%len) then + !buffer is too small, or has not yet been allocated + if (red%len>0) deallocate(red%buf) + red%len = len + allocate(red%buf(len)) + red%buf = 0 + red%ctr = 0 + endif + + end subroutine InitReductionBuffer_int_1d + !**************************************************************** + subroutine InitReductionBuffer_r_1d(red,len) + use thread_mod, only: omp_get_num_threads + integer, intent(in) :: len + type (ReductionBuffer_r_1d_t),intent(out) :: red + + if (omp_get_num_threads()>1) then + call endrun("Error: attempt to allocate reduction buffer in threaded region") + endif + + if (len > red%len) then + if (red%len>0) deallocate(red%buf) + red%len = len + allocate(red%buf(len)) + red%buf = 0.0_R8 + red%ctr = 0 + endif + end subroutine InitReductionBuffer_r_1d + !**************************************************************** + subroutine InitReductionBuffer_ordered_1d(red,len,nthread) + use thread_mod, only: omp_get_num_threads + integer, intent(in) :: len + integer, intent(in) :: nthread + type (ReductionBuffer_ordered_1d_t),intent(out) :: red + + if (omp_get_num_threads()>1) then + call endrun("Error: attempt to allocate reduction buffer in threaded region") + endif + + if (len > red%len) then + if (red%len>0) deallocate(red%buf) + red%len = len + allocate(red%buf(len,nthread+1)) + red%buf = 0.0_R8 + red%ctr = 0 + endif + end subroutine InitReductionBuffer_ordered_1d + + ! ======================================= + ! pmax_mt: + ! + ! thread safe, parallel reduce maximum + ! of a one dimensional reduction vector + ! ======================================= + + subroutine pmax_mt_int_1d(red,redp,len,hybrid) + use hybrid_mod, only : hybrid_t + + type (ReductionBuffer_int_1d_t) :: red ! shared memory reduction buffer struct + integer, intent(in) :: len ! buffer length + integer, intent(inout) :: redp(len) ! thread private vector of partial sum + type (hybrid_t), intent(in) :: hybrid ! parallel handle + + ! Local variables +#ifdef _MPI + integer ierr +#endif + + integer :: k + if (len>red%len) then + call endrun('ERROR: threadsafe reduction buffer too small') + end if + + !$OMP BARRIER + !$OMP CRITICAL (CRITMAX) + if (red%ctr == 0) red%buf(1:len)= -9999 + if (red%ctr < hybrid%NThreads) then + do k=1,len + red%buf(k)=MAX(red%buf(k),redp(k)) + enddo + red%ctr=red%ctr+1 + end if + if (red%ctr == hybrid%NThreads) red%ctr=0 + !$OMP END CRITICAL (CRITMAX) +#ifdef _MPI + !$OMP BARRIER + if (hybrid%ithr==0) then + + call MPI_Allreduce(red%buf(1),redp,len,Mpi_integer, & + MPI_MAX,hybrid%par%comm,ierr) + + red%buf(1:len)=redp(1:len) + end if +#endif + !$OMP BARRIER + + end subroutine pmax_mt_int_1d + + subroutine pmax_mt_r_1d(red,redp,len,hybrid) + use hybrid_mod, only : hybrid_t + + type (ReductionBuffer_r_1d_t) :: red ! shared memory reduction buffer struct + real (kind=r8), intent(inout) :: redp(:) ! thread private vector of partial sum + integer, intent(in) :: len ! buffer length + type (hybrid_t), intent(in) :: hybrid ! parallel handle + + ! Local variables +#ifdef _MPI + integer ierr +#endif + + integer :: k + if (len>red%len) then + call endrun('ERROR: threadsafe reduction buffer too small') + end if + + !$OMP BARRIER + !$OMP CRITICAL (CRITMAX) + if (red%ctr == 0) red%buf(1:len)= -9.11e30_r8 + if (red%ctr < hybrid%NThreads) then + do k=1,len + red%buf(k)=MAX(red%buf(k),redp(k)) + enddo + red%ctr=red%ctr+1 + end if + if (red%ctr == hybrid%NThreads) red%ctr=0 + !$OMP END CRITICAL (CRITMAX) +#ifdef _MPI + !$OMP BARRIER + if (hybrid%ithr==0) then + + call MPI_Allreduce(red%buf(1),redp,len,Mpi_real8, & + MPI_MAX,hybrid%par%comm,ierr) + + red%buf(1:len)=redp(1:len) + end if +#endif + !$OMP BARRIER + + end subroutine pmax_mt_r_1d + + ! ======================================= + ! pmin_mt: + ! + ! thread safe, parallel reduce maximum + ! of a one dimensional reduction vector + ! ======================================= + + subroutine pmin_mt_r_1d(red,redp,len,hybrid) + use hybrid_mod, only : hybrid_t + + type (ReductionBuffer_r_1d_t) :: red ! shared memory reduction buffer struct + real (kind=r8), intent(inout) :: redp(:) ! thread private vector of partial sum + integer, intent(in) :: len ! buffer length + type (hybrid_t), intent(in) :: hybrid ! parallel handle + + ! Local variables + +#ifdef _MPI + integer :: ierr +#endif + integer :: k + + if (len>red%len) then + call endrun('ERROR: threadsafe reduction buffer too small') + end if + + !$OMP BARRIER + !$OMP CRITICAL (CRITMAX) + if (red%ctr == 0) red%buf(1:len)= 9.11e30_r8 + if (red%ctr < hybrid%NThreads) then + do k=1,len + red%buf(k)=MIN(red%buf(k),redp(k)) + enddo + red%ctr=red%ctr+1 + end if + if (red%ctr == hybrid%NThreads) red%ctr=0 + !$OMP END CRITICAL (CRITMAX) +#ifdef _MPI + !$OMP BARRIER + if (hybrid%ithr==0) then + + call MPI_Allreduce(red%buf(1),redp,len,Mpi_real8, & + MPI_MIN,hybrid%par%comm,ierr) + + red%buf(1:len)=redp(1:len) + end if +#endif + !$OMP BARRIER + + end subroutine pmin_mt_r_1d + + subroutine ElementSum_1d(res,variable,type,hybrid) + use hybrid_mod, only: hybrid_t + use dimensions_mod, only: nelem + use parallel_mod, only: ORDERED + + ! ========================== + ! Arguments + ! ========================== + real(kind=r8), intent(out) :: res + real(kind=r8), intent(in) :: variable(:) + integer, intent(in) :: type + type (hybrid_t), intent(in) :: hybrid + + ! ========================== + ! Local Variables + ! ========================== + + ! + ! Note this is a real kludge here since it may be used for + ! arrays of size other then nelem + ! + +#ifdef _MPI + integer :: errorcode,errorlen + character(len=80) :: errorstring + + real(kind=r8) :: local_sum + integer :: ierr +#else + integer :: i +#endif + +#ifdef _MPI + if(hybrid%ithr == 0) then + local_sum=SUM(variable) + call MPI_Barrier(hybrid%par%comm,ierr) + + call MPI_Allreduce(local_sum,res,1,Mpi_real8, & + MPI_SUM,hybrid%par%comm,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,'ElementSum_1d: Error after call to MPI_Allreduce: ',errorstring + endif + endif +#else + if(hybrid%ithr == 0) then + if(type == ORDERED) then + ! =========================== + ! Perform the ordererd sum + ! =========================== + res = 0.0_r8 + do i=1,nelem + res = res + variable(i) + enddo + else + res=SUM(variable) + endif + endif +#endif + + end subroutine ElementSum_1d + +end module reduction_mod diff --git a/src/dynamics/se/dycore/schedtype_mod.F90 b/src/dynamics/se/dycore/schedtype_mod.F90 new file mode 100644 index 0000000000..a4efb14626 --- /dev/null +++ b/src/dynamics/se/dycore/schedtype_mod.F90 @@ -0,0 +1,59 @@ +module schedtype_mod + + use metagraph_mod, only : MetaEdge_t + + implicit none + private + type, public :: Cycle_t + integer :: tag + integer :: dest + integer :: source + integer :: lengthP + integer :: lengthP_ghost + integer :: lengthS + integer :: type + integer :: ptrP + integer :: ptrP_ghost + integer :: ptrS + logical :: onNode + type (MetaEdge_t),pointer :: edge + end type Cycle_t + + type, public :: pgindex_t + integer :: elemid + integer :: edgeid + integer :: mesgid + integer :: lenP,lenS + integer :: edgeType + end type pgindex_t + + type, public :: Schedule_t + integer :: ncycles + integer :: nelemd + integer :: placeholder ! total integer count should be even + integer :: nSendCycles + integer :: nRecvCycles + integer :: nInter ! number of off-node or inter node communication cycles + integer :: nIntra ! number of on-node or intra node communication cycles + integer :: padding + integer,pointer :: Local2Global(:) + integer,pointer :: destFull(:) + integer,pointer :: srcFull(:) + type (Cycle_t), pointer :: Cycle(:) + type (Cycle_t), pointer :: SendCycle(:) + type (Cycle_t), pointer :: RecvCycle(:) + type (Cycle_t), pointer :: MoveCycle(:) + type (pgindex_t), pointer :: pIndx(:) + type (pgindex_t), pointer :: gIndx(:) + integer :: pPtr,gPtr + end type Schedule_t + + type (Schedule_t), public, allocatable, target :: Schedule(:) + type (Schedule_t), public, allocatable, target :: gSchedule(:) + type (Schedule_t), public, allocatable, target :: sSchedule(:) + + integer,public,parameter :: HME_Cardinal = 101 + integer,public,parameter :: HME_Ordinal = 102 + + +end module schedtype_mod diff --git a/src/dynamics/se/dycore/schedule_mod.F90 b/src/dynamics/se/dycore/schedule_mod.F90 new file mode 100644 index 0000000000..cabdcbb74f --- /dev/null +++ b/src/dynamics/se/dycore/schedule_mod.F90 @@ -0,0 +1,714 @@ +module schedule_mod + use metagraph_mod, only: MetaEdge_t + use schedtype_mod, only: Cycle_t, Schedule_t, schedule, pgindex_t, HME_Ordinal,HME_Cardinal + use parallel_mod, only: parallel_t + use cam_logfile, only: iulog + + implicit none + private + + type, public :: GraphStats_t + integer :: offnode + integer :: onnode + integer :: LB + integer :: padding + end type GraphStats_t + + integer,public,parameter :: HME_CYCLE_SEND=1 + integer,public,parameter :: HME_CYCLE_RECV=2 + integer,public,parameter :: HME_CYCLE_MOVE=3 + integer,public,parameter :: HME_CYCLE_ANY =4 + + + integer,public,parameter :: BNDRY_EXCHANGE_MESSAGE=10 + integer,private,allocatable,target :: Global2Local(:) + + integer :: MinNelemd,MaxNelemd + + public :: genEdgeSched ! Setup the communication schedule for the edge based boundary exchange + public :: PrintSchedule, PrintCycle + public :: PrintIndex + public :: CheckSchedule + public :: FindBufferSlot + +contains + + subroutine genEdgeSched(par,elem, PartNumber,LSchedule,MetaVertex) + use element_mod, only: element_t + use metagraph_mod, only: metavertex_t + use dimensions_mod, only: nelem, max_neigh_edges + use gridgraph_mod, only: gridvertex_t, gridedge_t, assignment ( = ) + use cam_abortutils, only: endrun + use spmd_utils, only: mpi_status_size, mpi_info_null, mpi_success + use parallel_mod, only: nComPoints, rrequest, srequest, status, npackpoints + + type(parallel_t), intent(inout) :: par + type(element_t), intent(inout) :: elem(:) + integer, intent(in) :: PartNumber + type (schedule_t), intent(inout) :: LSchedule + type (MetaVertex_t), intent(inout) :: MetaVertex + + integer :: lengthP,lengthS,total_length,lengthp_ghost + integer :: i,j,is,ir,ncycle + integer :: il,ie,ig + integer :: nelemd0 + integer :: jmd + integer :: inbr + integer :: nSched + integer,allocatable :: tmpP(:,:) + integer,allocatable :: tmpS(:,:) + integer,allocatable :: tmpP_ghost(:,:) + integer :: nSend,nRecv,nedges + integer :: icycle + integer :: iSched + logical, parameter :: VerbosePrint=.FALSE. + logical, parameter :: Debug=.FALSE. + character(len=*), parameter :: subname = 'genEdgeSched' + integer :: errorcode,errorlen + character*(80) :: errorstring + integer, allocatable :: intracommranks(:) + integer :: numIntra, numInter, rank + logical :: OnNode + + + integer :: ierr + integer :: l1,l2,l1id,l2id + integer :: src,dest,wgt + integer :: icIntra, icInter + + integer, allocatable :: srcFull(:), destFull(:), srcweightFull(:), destweightFull(:) + integer, allocatable :: srcInter(:),destInter(:), srcweightInter(:),destweightInter(:) + integer, allocatable :: srcIntra(:),destIntra(:), srcweightIntra(:),destweightIntra(:) + + logical :: reorder + integer :: sizeGroup, groupFull + + nSched=SIZE(schedule) + ! ================================================ + ! allocate some arrays for the call to MPI_gatherv + ! ================================================ + + MinNelemd = nelem + MaxNelemd = 0 + ! ===================================================== + ! It looks like this is only used in this routine... + ! so no need to put it in the schedule data-structure + ! ===================================================== + allocate(Global2Local(nelem)) + if(Debug) write(iulog,*)'genEdgeSched: point #1' + iSched = PartNumber + + nelemd0 = MetaVertex%nmembers + MaxNelemd = AMAX0(MaxNelemd,nelemd0) + MinNelemd = AMIN0(MinNelemd,nelemd0) + if(Debug) write(iulog,*)'genEdgeSched: point #2' + + if(Debug) write(iulog,*)'genEdgeSched: point #3' + LSchedule%ncycles = MetaVertex%nedges + LSchedule%nelemd = nelemd0 + if(Debug) write(iulog,*)'genEdgeSched: point #4' + + ! Note the minus one is for the internal node + nedges = MetaVertex%nedges + if(2*(nedges/2) .eq. nedges) then + nedges = nedges/2 + else + nedges = (nedges-1)/2 + endif + LSchedule%nSendCycles = nedges + LSchedule%nRecvCycles = nedges + if(Debug) write(iulog,*)'genEdgeSched: point #5' + + ! Temporary array to calculate the Buffer Slot + allocate(tmpP(2,nedges+1)) + allocate(tmpS(2,nedges+1)) + allocate(tmpP_ghost(2,nedges+1)) + + + ! Allocate all the cycle structures + allocate(LSchedule%SendCycle(nedges)) + allocate(LSchedule%RecvCycle(nedges)) + allocate(LSchedule%MoveCycle(1)) + + ! Initialize the schedules... + LSchedule%MoveCycle(1)%ptrP = 0 + LSchedule%MoveCycle(1)%ptrS = 0 + LSchedule%MoveCycle(1)%lengthP = 0 + if(Debug) write(iulog,*)'genEdgeSched: point #6' + + !================================================================== + ! Allocate and initalized the index translation arrays + Global2Local = -1 + allocate(LSchedule%Local2Global(nelemd0)) + allocate(LSchedule%pIndx(max_neigh_edges*nelemd0)) + allocate(LSchedule%gIndx(max_neigh_edges*nelemd0)) + + LSchedule%pIndx(:)%elemId = -1 + LSchedule%pIndx(:)%edgeId = -1 + LSchedule%pIndx(:)%lenP = -1 + LSchedule%pIndx(:)%lenS = -1 + LSchedule%pIndx(:)%mesgid = -1 + LSchedule%pIndx(:)%edgeType = -1 + + LSchedule%gIndx(:)%elemId = -1 + LSchedule%gIndx(:)%edgeId = -1 + LSchedule%gIndx(:)%lenP = -1 + LSchedule%gIndx(:)%lenS = -1 + LSchedule%gIndx(:)%mesgid = -1 + LSchedule%gIndx(:)%edgeType = -1 + + LSchedule%pPtr=1 + LSchedule%gPtr=1 + + if(Debug) write(iulog,*)'genEdgeSched: point #7' + + do il=1,nelemd0 + ig = MetaVertex%members(il)%number + Global2Local(ig)=il + LSchedule%Local2Global(il)=ig + elem(il)%desc%putmapP=-1 + elem(il)%desc%getmapP=-1 + elem(il)%desc%putmapS=-1 + elem(il)%desc%getmapS=-1 + elem(il)%desc%putmapP_ghost=-1 + elem(il)%desc%getmapP_ghost=-1 + elem(il)%desc%reverse = .FALSE. + enddo + !================================================================== + if(Debug) write(iulog,*)'genEdgeSched: point #8' + + + + total_length = 0 + ncycle = LSchedule%ncycles + ! + ! Send Cycle + ! + is=1 + tmpP(1,:) = -1 + tmpP(2,:) = 0 + tmpS(1,:) = -1 + tmpS(2,:) = 0 + tmpP_ghost(1,:) = -1 + tmpP_ghost(2,:) = 0 + + do j=1,ncycle + lengthP = MetaVertex%edges(j)%wgtP + lengthS = MetaVertex%edges(j)%wgtS + lengthP_ghost = MetaVertex%edges(j)%wgtP_ghost + + if ((MetaVertex%edges(j)%TailVertex == PartNumber) .AND. & + (MetaVertex%edges(j)%HeadVertex .ne. PartNumber) ) then + inbr = MetaVertex%edges(j)%HeadVertex + if(Debug) write(iulog,*)'genEdgeSched: point #11', par%rank + LSchedule%SendCycle(is)%ptrP = FindBufferSlot(inbr,lengthP,tmpP) + LSchedule%SendCycle(is)%ptrS = FindBufferSlot(inbr,lengthS,tmpS) + LSchedule%SendCycle(is)%ptrP_ghost= FindBufferSlot(inbr,lengthP_ghost,tmpP_ghost) + call SetCycle(par, elem, LSchedule,LSchedule%SendCycle(is),MetaVertex%edges(j), HME_CYCLE_SEND) + if(Debug) write(iulog,*)'genEdgeSched: point #12',par%rank + is = is+1 + endif + enddo + + ! + ! Recv Cycle: Note that by reinitializing the tmpP array we change the structure of the receive buffer + ! + ir=1 + tmpP(1,:) = -1 + tmpP(2,:) = 0 + tmpS(1,:) = -1 + tmpS(2,:) = 0 + tmpP_ghost(1,:) = -1 + tmpP_ghost(2,:) = 0 + + do j=1,ncycle + lengthP = MetaVertex%edges(j)%wgtP + lengthS = MetaVertex%edges(j)%wgtS + lengthP_ghost = MetaVertex%edges(j)%wgtP_ghost + + if ( (MetaVertex%edges(j)%HeadVertex == PartNumber) .AND. & + (MetaVertex%edges(j)%TailVertex .ne. PartNumber) ) then + inbr = MetaVertex%edges(j)%TailVertex + if(Debug) write(iulog,*)'genEdgeSched: point #13',par%rank + LSchedule%RecvCycle(ir)%ptrP = FindBufferSlot(inbr,lengthP,tmpP) + LSchedule%RecvCycle(ir)%ptrS = FindBufferSlot(inbr,lengthS,tmpS) + LSchedule%RecvCycle(ir)%ptrP_ghost= FindBufferSlot(inbr,lengthP_ghost,tmpP_ghost) + call SetCycle(par, elem, LSchedule,LSchedule%RecvCycle(ir),MetaVertex%edges(j),HME_CYCLE_RECV) + if(Debug) write(iulog,*)'genEdgeSched: point #14',par%rank + ir = ir+1 + endif + enddo + + ! Put the move cycle at the end of the buffer. + do j=1,ncycle + lengthP = MetaVertex%edges(j)%wgtP + lengthS = MetaVertex%edges(j)%wgtS + lengthP_ghost = MetaVertex%edges(j)%wgtP_ghost + + if((MetaVertex%edges(j)%HeadVertex == PartNumber) .AND. & + (MetaVertex%edges(j)%TailVertex == PartNumber)) then + inbr = PartNumber + if(Debug) write(iulog,*)'genEdgeSched: point #9', par%rank + LSchedule%MoveCycle%ptrP = FindBufferSlot(inbr,lengthP,tmpP) + LSchedule%MoveCycle%ptrS = FindBufferSlot(inbr,lengthS,tmpS) + LSchedule%MoveCycle%ptrP_ghost = FindBufferSlot(inbr,lengthP_ghost,tmpP_ghost) + call SetCycle(par, elem, LSchedule,LSchedule%MoveCycle(1),MetaVertex%edges(j),HME_CYCLE_MOVE) + if(Debug) write(iulog,*)'genEdgeSched: point #10',par%rank + endif + enddo + + deallocate(tmpP) + deallocate(tmpS) + deallocate(tmpP_ghost) + + do ie=1,nelemd0 + ! compute number of neighbers for each element + elem(ie)%desc%actual_neigh_edges=0 + do i=1,max_neigh_edges + if (elem(ie)%desc%globalID(i)>0) then + elem(ie)%desc%actual_neigh_edges=elem(ie)%desc%actual_neigh_edges+1 + endif + enddo + + ! normally, we loop over max_neigh_edges, checking if there is an edge + ! let's create a mapping so that we can loop over actual_neigh_edges + ! sort in REVERSE global id order (so the ones with globalID=0 are last) + do l1 = 1,max_neigh_edges-1 + do l2=l1+1,max_neigh_edges + l1id=elem(ie)%desc%loc2buf(l1) + l2id=elem(ie)%desc%loc2buf(l2) + if (elem(ie)%desc%globalID(l2id) > elem(ie)%desc%globalID(l1id)) then + ! swap index: + l1id=elem(ie)%desc%loc2buf(l2) + elem(ie)%desc%loc2buf(l2)=elem(ie)%desc%loc2buf(l1) + elem(ie)%desc%loc2buf(l1)=l1id + endif + enddo + enddo + + + + + elem(ie)%vertex = MetaVertex%members(ie) + ig = MetaVertex%members(ie)%number + elem(ie)%GlobalId = ig + elem(ie)%LocalId = ie + enddo + + deallocate(Global2Local) + +#ifdef SPMD + !================================================================ + ! Allocate a couple of structures for bndry_exchange + ! done here to remove it from the critical path + !================================================================ + nComPoints = 0 + + nSend = nedges + nRecv = nedges + allocate(Rrequest(nRecv)) + allocate(Srequest(nSend)) + allocate(status(MPI_STATUS_SIZE,nRecv)) + + !=============================================================== + ! Number of communication points ... to be used later to + ! setup the size of the communication buffer for MPI_Ibsend + !=============================================================== + do icycle = 1, nSend + nComPoints = nComPoints + LSchedule%SendCycle(icycle)%lengthP + end do + nPackPoints = nComPoints + LSchedule%MoveCycle(1)%lengthP +#if MPI_VERSION >= 3 + ! Create a communicator that only contains the on-node MPI ranks + call MPI_Comm_split_type(par%comm, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, par%intracomm, ierr) + + call MPI_Comm_size(par%intracomm, par%intracommsize, ierr) + call MPI_Comm_rank(par%intracomm, par%intracommrank, ierr) + + allocate(intracommranks(par%intracommsize)) + call MPI_Allgather(par%rank,1,MPIinteger_t,intracommranks,1,MPIinteger_t,par%intracomm,ierr) + + numIntra=0 + do icycle=1,nSend + rank = LSchedule%SendCycle(icycle)%dest - 1 + onNode = isIntraComm(intracommranks,rank) + LSchedule%SendCycle(icycle)%onNode = onNode + if(onNode) then + numIntra=numIntra+1 + endif + enddo + do icycle=1,nRecv + rank = LSchedule%RecvCycle(icycle)%source - 1 + onNode = isIntraComm(intracommranks,rank) + LSchedule%RecvCycle(icycle)%onNode = onNode + enddo + numInter = nsend-numIntra + + + deallocate(intracommranks) +#else + numIntra = 0 + numInter = nSend + ! Mark all communications as off-node by default + do icycle=1,nSend + LSchedule%SendCycle(icycle)%onNode = .False. + enddo + do icycle=1,nRecv + LSchedule%RecvCycle(icycle)%onNode = .False. + enddo +#endif + LSchedule%nInter = numInter + LSchedule%nIntra = numIntra + + allocate(srcFull(nRecv), srcWeightFull(nRecv),destFull(nSend),destWeightFull(nSend)) + if(numInter>0) then + allocate(srcInter(numInter),srcWeightInter(numInter),destInter(numInter), destWeightInter(numInter)) + endif + if(numIntra>0) then + allocate(srcIntra(numIntra),srcWeightIntra(numIntra),destIntra(numIntra), destWeightIntra(numIntra)) + endif + + icIntra=0 + icInter=0 + do icycle=1,nSend + dest = LSchedule%SendCycle(icycle)%dest - 1 + wgt = LSchedule%SendCycle(icycle)%lengthP + destFull(icycle) = dest + destWeightFull(icycle) = wgt + if(LSchedule%SendCycle(icycle)%onNode) then + icIntra=icIntra+1 + destIntra(icIntra) = dest + destWeightIntra(icIntra) = wgt + else + icInter=icInter+1 + destInter(icInter) = dest + destWeightInter(icInter) = wgt + endif + enddo + + icIntra=0 + icInter=0 + do icycle=1,nRecv + src = LSchedule%RecvCycle(icycle)%source - 1 + wgt = LSchedule%RecvCycle(icycle)%lengthP + srcFull(icycle) = src + srcWeightFUll(icycle) = wgt + if(LSchedule%RecvCycle(icycle)%onNode) then + icIntra=icIntra+1 + srcIntra(icIntra) = src + srcWeightIntra(icIntra) = wgt + else + icInter=icInter+1 + srcInter(icInter) = src + srcWeightInter(icInter) = wgt + endif + enddo + + ! construct the FULL communication graph + reorder=.FALSE. + call MPI_Dist_graph_create_adjacent(par%comm, nRecv,srcFull,srcWeightFull, & + nSend,destFull,destWeightFull,MPI_INFO_NULL,reorder,par%commGraphFull,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,subname,': Error after call to MPI_dist_graph_create_adjacent(FULL) ',errorstring + endif + allocate(LSchedule%destFull(nSend),LSchedule%srcFull(nRecv)) + LSchedule%destFull(:) = destFull(:) + LSchedule%srcFull(:) = srcFull(:) + ! construct the FULL communication -group- (for one-sided operations): + call MPI_Comm_group(par%comm, groupFull, ierr) + call MPI_group_incl(groupFull,nRecv,srcFull,par%groupGraphFull,ierr) + if (ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode, errorstring, errorlen, ierr) + print *,subname, ': Error after call to MPI_Comm_group (groupGraphFull) ', errorstring + endif + call MPi_Group_size(par%groupGraphFull,sizeGroup,ierr) + if(Debug) write (*,199) par%rank,sizeGroup,nSend,nRecv + +199 format ('RANK: ',i4,' genEdgeSched: size of groupGraphFUll is: ',i8,' nSend, nRecv: ',2(i4)) + deallocate(srcFull,srcWeightFull,destFull,destWeightFull) + + ! construct the INTER communication graph + reorder=.FALSE. + if(numInter>0) then + call MPI_Dist_graph_create_adjacent(par%comm, numInter,srcInter,srcWeightInter, & + numInter,destInter,destWeightInter,MPI_INFO_NULL,reorder,par%commGraphInter,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,subname,': Error after call to MPI_dist_graph_create_adjacent(INTER) ',errorstring + endif + deallocate(srcInter,srcWeightInter,destInter,destWeightInter) + endif + + ! construct the INTRA communication graph + reorder=.FALSE. + if(numIntra>0) then + call MPI_Dist_graph_create_adjacent(par%comm, numIntra,srcIntra,srcWeightIntra, & + numIntra,destIntra,destWeightIntra,MPI_INFO_NULL,reorder,par%commGraphIntra,ierr) + if(ierr .ne. MPI_SUCCESS) then + errorcode=ierr + call MPI_Error_String(errorcode,errorstring,errorlen,ierr) + print *,subname,': Error after call to MPI_dist_graph_create_adjacent(INTRA) ',errorstring + endif + deallocate(srcIntra,srcWeightIntra,destIntra,destWeightIntra) + endif + + 200 format ('IAM: ',i4,': ', i2,' of',i2,' comms are interNode') + 201 format ('IAM: ',i4,': ', i2,' of',i2,' comms are intraNode') +#endif + + + end subroutine genEdgeSched + + logical function isIntraComm(commranks,rank) + + + integer, intent(in) :: commranks(:) + integer, intent(in) :: rank + + integer :: i,nranks + + nranks = SIZE(commranks) + isIntraComm = .FALSE. + do i=1,nranks + if(commranks(i) .eq. rank) then + isIntraComm=.TRUE. + endif + enddo + + end function isIntraComm + + subroutine CheckSchedule() + + integer :: i, nSched, nbufferwords_1, nbufferwords_2 + type (Schedule_t), pointer :: pSchedule + + nSched = SIZE(Schedule) + + do i = 1, nSched + pSchedule => Schedule(i) + nbufferwords_1 = SUM(pSchedule%SendCycle(:)%lengthP) + nbufferwords_2 = SUM(pSchedule%RecvCycle(:)%lengthP) + if(nbufferwords_1 .ne. nbufferwords_2) then + write (iulog,100) i,nbufferwords_1, nbufferwords_2 + end if + end do +100 format('CheckSchedule: ERR IAM:',I3,' SIZEOF(SendBuffer):',I10,' != SIZEOF(RecvBuffer) :',I10) + + end subroutine CheckSchedule + + subroutine PrintSchedule(Schedule) + ! Debug subroutine for the schedule_t data-structure + use gridgraph_mod, only : printgridedge + + type (Schedule_t),intent(in),target :: Schedule(:) + type (Schedule_t), pointer :: pSchedule + type (Cycle_t),pointer :: pCycle + + integer :: i,j,nSched + + nSched = SIZE(Schedule) + + write(6,*) '------NEW SCHEDULE FORMAT---------------------' + do i=1,nSched + pSchedule => Schedule(i) + write(6,*) + write(6,*) '----------------------------------------------' + write(6,90) i,pSchedule%ncycles + write(6,*) '----------------------------------------------' + write(6,*) '-----------SEND-------------------------------' + do j=1,pSchedule%nSendCycles + pCycle => pSchedule%SendCycle(j) + call PrintCycle(pCycle) + call PrintGridEdge(pCycle%edge%members) + enddo + write(6,*) '-----------RECV-------------------------------' + do j=1,pSchedule%nRecvCycles + pCycle => pSchedule%RecvCycle(j) + call PrintCycle(pCycle) + call PrintGridEdge(pCycle%edge%members) + enddo + write(6,*) '-----------MOVE-------------------------------' + pCycle => pSchedule%MoveCycle(1) + call PrintCycle(pCycle) + call PrintGridEdge(pCycle%edge%members) + enddo + write(6,*) '-----------Put Index--------------------' + call PrintIndex(Schedule(1)%pIndx) + write(6,*) '-----------Get Index--------------------' + call PrintIndex(Schedule(1)%gIndx) + +90 format('NODE # ',I2,2x,'NCYCLES ',I2) +97 format(10x,'EDGE #',I2,2x,'TYPE ',I1,2x,'G.EDGES',I4,2x,'WORDS ',I5,2x, & + 'SRC ',I3,2x,'DEST ',I3,2x,'PTR ',I4) +100 format(15x,I4,5x,I3,1x,'(',I1,') --',I1,'--> ',I3,1x,'(',I1,')') + + end subroutine PrintSchedule + + subroutine PrintIndex(Indx) + ! Debugging subroutine for the pgindex_t data-structure + + ! type, public :: pgindex_t + ! integer :: elemid + ! integer :: edgeid + ! integer :: mesgid + ! integer :: lenP,lenS + ! end type pgindex_t + + type (pgindex_t) :: Indx(:) + + integer :: i, len + + len = SIZE(Indx) + + write(6,*) ' elemID, edgeID, mesgID, lenP, lenS ' + do i=1,len + write(6,1099) Indx(i)%elemid,Indx(i)%edgeid,Indx(i)%mesgid,Indx(i)%lenP,Indx(i)%lenS + enddo + +1099 format(I4,5X,I4,5X,I4,5X,I2,4X,I2) + + end subroutine PrintIndex + + subroutine PrintCycle(Cycle) + ! debug subroutine for the cycle_t data-structure + type (Cycle_t),intent(in),target :: Cycle + + write(6,97) Cycle%edge%number,Cycle%type,Cycle%edge%nmembers, & + Cycle%lengthP,Cycle%source, Cycle%dest,Cycle%ptrP + +97 format(5x,'METAEDGE #',I2,2x,'TYPE ',I1,2x,'G.EDGES',I4,2x,'WORDS ',I5,2x, & + 'SRC ',I3,2x,'DEST ',I3,2x,'PTR ',I5) + + end subroutine PrintCycle + + subroutine SetCycle(par, elem, schedule,Cycle,Edge,ctype) + use element_mod, only: element_t + use dimensions_mod, only: max_corner_elem, max_neigh_edges + use cam_abortutils, only: endrun + + type(parallel_t), intent(in) :: par + type(element_t), intent(inout) :: elem(:) + type (Schedule_t), intent(inout) :: Schedule + type (Cycle_t), intent(inout) :: Cycle + type (MetaEdge_t), intent(in), target :: Edge + integer, intent(in) :: ctype + integer :: i,il,face, loc, dir + + do i = 1, Edge%nmembers + if((ctype == HME_CYCLE_SEND) .or. & + (ctype == HME_CYCLE_MOVE) .or. & + (ctype == HME_CYCLE_ANY)) then + ! Setup send index + il = Global2Local(Edge%members(i)%tail%number) + face = Edge%members(i)%tail_face + !need to convert the location of corner elements for getmap and putmap + if (face.ge.5) then ! if a corner element + dir = Edge%members(i)%tail_dir + loc = MOD(dir,max_corner_elem) !this is the location within that direction + dir = (dir - loc)/max_corner_elem !this is the direction (1-8) + loc = dir + (dir-5)*(max_corner_elem-1)+loc + else + loc = face + end if + + if(il .gt. 0) then + elem(il)%desc%putmapP(loc) = Edge%edgeptrP(i) + Cycle%ptrP - 1 ! offset, so start at 0 + elem(il)%desc%putmapS(loc) = Edge%edgeptrS(i) + Cycle%ptrS - 1 + elem(il)%desc%putmapP_ghost(loc) = Edge%edgeptrP_ghost(i) + Cycle%ptrP_ghost ! index, start at 1 + elem(il)%desc%reverse(loc) = Edge%members(i)%reverse + schedule%pIndx(schedule%pPtr)%elemid=il + schedule%pIndx(schedule%pPtr)%edgeid=loc + schedule%pIndx(schedule%pPtr)%mesgid=Edge%HeadVertex-1 ! convert this to 0-based + schedule%pIndx(schedule%pPtr)%lenP =Edge%members(i)%wgtP + schedule%pIndx(schedule%pPtr)%lenS =Edge%members(i)%wgtS + if (face.ge.5) then + schedule%pIndx(schedule%pPtr)%edgeType = HME_Ordinal + else + schedule%pIndx(schedule%pPtr)%edgeType = HME_Cardinal + endif + schedule%pPtr=schedule%pPtr+1 + end if + end if + + if((ctype == HME_CYCLE_RECV) .or. & + (ctype == HME_CYCLE_MOVE) .or. & + (ctype == HME_CYCLE_ANY)) then + ! Setup receive index + il = Global2Local(Edge%members(i)%head%number) + face = Edge%members(i)%head_face + !need to convert the location of corner elements for getmap and putmap + if (face.ge.5) then !its a corner + dir = Edge%members(i)%head_dir + loc = MOD(dir,max_corner_elem) !this is the location within that direction + dir = (dir - loc)/max_corner_elem !this is the direction (1-8) + loc = dir + (dir-5)*(max_corner_elem-1)+loc + if(loc > max_neigh_edges) then + write(iulog, *) __FILE__,__LINE__,par%rank,face,i,max_corner_elem,max_neigh_edges,edge%members(i)%head_face + call endrun('max_neigh_edges set too low.') + end if + else + loc = face + end if + + if(il .gt. 0) then + elem(il)%desc%getmapP(loc) = Edge%edgeptrP(i) + Cycle%ptrP - 1 + elem(il)%desc%getmapS(loc) = Edge%edgeptrS(i) + Cycle%ptrS - 1 + elem(il)%desc%getmapP_ghost(loc) = Edge%edgeptrP_ghost(i) + Cycle%ptrP_ghost + elem(il)%desc%globalID(loc) = Edge%members(i)%tail%number + schedule%gIndx(schedule%gPtr)%elemid=il + schedule%gIndx(schedule%gPtr)%edgeid=loc + schedule%gIndx(schedule%gPtr)%mesgid=Edge%TailVertex-1 ! convert this to 0-based + schedule%gIndx(schedule%gPtr)%lenP =Edge%members(i)%wgtP + schedule%gIndx(schedule%gPtr)%lenS =Edge%members(i)%wgtS + if (face.ge.5) then + schedule%gIndx(schedule%gPtr)%edgeType = HME_Ordinal + else + schedule%gIndx(schedule%gPtr)%edgeType = HME_Cardinal + endif + schedule%gPtr=schedule%gPtr+1 + end if + end if + end do + Cycle%edge => Edge + Cycle%type = Edge%type + Cycle%dest = Edge%HeadVertex + Cycle%source = Edge%TailVertex + Cycle%tag = BNDRY_EXCHANGE_MESSAGE + Cycle%lengthP = Edge%wgtP + Cycle%lengthS = Edge%wgtS + Cycle%lengthP_ghost = Edge%wgtP_ghost + + end subroutine SetCycle + + function FindBufferSlot(inbr,length,tmp) result(ptr) + + integer :: ptr + integer, intent(in) :: inbr,length + integer, intent(inout) :: tmp(:,:) + + integer :: i,n + + n = SIZE(tmp,2) + + ptr = 0 + do i=1,n + if( tmp(1,i) == inbr) then + ptr = tmp(2,i) + return + endif + if( tmp(1,i) == -1 ) then + tmp(1,i) = inbr + if(i .eq. 1) tmp(2,i) = 1 + ptr = tmp(2,i) + if(i .ne. n) tmp(2,i+1) = ptr +length + return + endif + enddo + + end function FindBufferSlot + +end module schedule_mod diff --git a/src/dynamics/se/dycore/spacecurve_mod.F90 b/src/dynamics/se/dycore/spacecurve_mod.F90 new file mode 100644 index 0000000000..c7631121c8 --- /dev/null +++ b/src/dynamics/se/dycore/spacecurve_mod.F90 @@ -0,0 +1,1274 @@ +module spacecurve_mod + use cam_logfile, only: iulog + + implicit none + private + + type, public :: factor_t + integer :: numfact + integer, dimension(:),pointer :: factors => NULL() + end type factor_t + + + integer,public, dimension(:,:), allocatable :: ordered + integer,public, dimension(:,:), allocatable :: dir ! direction to move along each level + integer,public, dimension(:) , allocatable :: pos ! position along each of the axes + + integer,public :: maxdim ! dimensionality of entire space + integer,public :: vcnt ! visitation count + logical,private :: verbose=.FALSE. + + type (factor_t), public :: fact + + SAVE:: fact + public :: map + public :: hilbert_old + public :: PeanoM,hilbert, Cinco + public :: GenCurve + public :: GenSpaceCurve + public :: log2,Factor + public :: PrintCurve + public :: IsFactorable,IsLoadBalanced + public :: genspacepart +contains + !--------------------------------------------------------- + recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) + + implicit none + integer,intent(in) :: l,type,ma,md,ja,jd + + integer :: lma,lmd,lja,ljd,ltype + integer :: ll + integer :: ierr + logical :: debug = .FALSE. + + ll = l + if(ll .gt. 1) ltype = fact%factors(ll-1) ! Set the next type of space curve + + !-------------------------------------------------------------- + ! Position [0,0] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'Cinco: After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,0] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,1] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,2] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = ma + ljd = -md + + if(ll .gt. 1) then + if(debug) write(iulog,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [1,2] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,1] + !-------------------------------------------------------------- + lma = ma + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + !-------------------------------------------------------------- + ! Position [0,1] + !-------------------------------------------------------------- + lma = ma + lmd = -md + lja = MOD(ma+1,maxdim) + ljd = md + + if(ll .gt. 1) then + if(debug) write(iulog,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [0,2] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [0,3] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,30) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [0,4] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,31) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,4] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = MOD(ma+1,maxdim) + ljd = -md + + if(ll .gt. 1) then + if(debug) write(iulog,32) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,3] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = ma + ljd = md + + if(ll .gt. 1) then + if(debug) write(iulog,33) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,3] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,34) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,4] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,35) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [3,4] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,36) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [4,4] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = MOD(ma+1,maxdim) + ljd = -md + + if(ll .gt. 1) then + if(debug) write(iulog,37) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [4,3] + !-------------------------------------------------------------- + lma = ma + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,38) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [3,3] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,39) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [3,2] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = ma + ljd = md + + if(ll .gt. 1) then + if(debug) write(iulog,40) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [4,2] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = MOD(ma+1,maxdim) + ljd = -md + + if(ll .gt. 1) then + if(debug) write(iulog,41) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [4,1] + !-------------------------------------------------------------- + lma = ma + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,42) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [3,1] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,43) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [3,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = ma + ljd = md + + if(ll .gt. 1) then + if(debug) write(iulog,44) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [4,0] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = ja + ljd = jd + + if(ll .gt. 1) then + if(debug) write(iulog,45) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + +21 format('Call Cinco Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +22 format('Call Cinco Pos [1,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +23 format('Call Cinco Pos [2,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +24 format('Call Cinco Pos [2,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +25 format('Call Cinco Pos [2,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +26 format('Call Cinco Pos [1,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +27 format('Call Cinco Pos [1,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +28 format('Call Cinco Pos [0,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +29 format('Call Cinco Pos [0,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +30 format('Call Cinco Pos [0,3] Level ',i1,' at (',i2,',',i2,')',4(i3)) +31 format('Call Cinco Pos [0,4] Level ',i1,' at (',i2,',',i2,')',4(i3)) +32 format('Call Cinco Pos [1,4] Level ',i1,' at (',i2,',',i2,')',4(i3)) +33 format('Call Cinco Pos [1,3] Level ',i1,' at (',i2,',',i2,')',4(i3)) +34 format('Call Cinco Pos [2,3] Level ',i1,' at (',i2,',',i2,')',4(i3)) +35 format('Call Cinco Pos [2,4] Level ',i1,' at (',i2,',',i2,')',4(i3)) +36 format('Call Cinco Pos [3,4] Level ',i1,' at (',i2,',',i2,')',4(i3)) +37 format('Call Cinco Pos [4,4] Level ',i1,' at (',i2,',',i2,')',4(i3)) +38 format('Call Cinco Pos [4,3] Level ',i1,' at (',i2,',',i2,')',4(i3)) +39 format('Call Cinco Pos [3,3] Level ',i1,' at (',i2,',',i2,')',4(i3)) +40 format('Call Cinco Pos [3,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +41 format('Call Cinco Pos [4,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +42 format('Call Cinco Pos [4,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +43 format('Call Cinco Pos [3,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +44 format('Call Cinco Pos [3,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +45 format('Call Cinco Pos [4,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) + + end function Cinco + + !--------------------------------------------------------- + recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) + + implicit none + integer,intent(in) :: l,type,ma,md,ja,jd + + integer :: lma,lmd,lja,ljd,ltype + integer :: ll + integer :: ierr + logical :: debug = .FALSE. + + ll = l + if(ll .gt. 1) ltype = fact%factors(ll-1) ! Set the next type of space curve + !-------------------------------------------------------------- + ! Position [0,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [0,1] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + if(ll .gt. 1) then + if(debug) write(iulog,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,1] ',pos + endif + + !-------------------------------------------------------------- + ! Position [0,2] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + if(ll .gt. 1) then + if(debug) write(iulog,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,2] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,2] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + if(ll .gt. 1) then + if(debug) write(iulog,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,2] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [2,2] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = MOD(lma+1,maxdim) + ljd = -lmd + + if(ll .gt. 1) then + if(debug) write(iulog,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [2,2] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,1] + !-------------------------------------------------------------- + lma = ma + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [2,1] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,1] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,1] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [1,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = MOD(lma+1,maxdim) + ljd = -lmd + + if(ll .gt. 1) then + if(debug) write(iulog,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,0] ',pos + endif + + !-------------------------------------------------------------- + ! Position [2,0] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = ja + ljd = jd + + if(ll .gt. 1) then + if(debug) write(iulog,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [2,0] ',pos + endif + +21 format('Call PeanoM Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +22 format('Call PeanoM Pos [0,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +23 format('Call PeanoM Pos [0,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +24 format('Call PeanoM Pos [1,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +25 format('Call PeanoM Pos [2,2] Level ',i1,' at (',i2,',',i2,')',4(i3)) +26 format('Call PeanoM Pos [2,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +27 format('Call PeanoM Pos [1,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +28 format('Call PeanoM Pos [1,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +29 format('Call PeanoM Pos [2,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) + + end function PeanoM + !--------------------------------------------------------- + recursive function hilbert(l,type,ma,md,ja,jd) result(ierr) + + implicit none + integer,intent(in) :: l,type,ma,md,ja,jd + + integer :: lma,lmd,lja,ljd,ltype + integer :: ll + integer :: ierr + logical :: debug = .FALSE. + + ll = l + if(ll .gt. 1) ltype = fact%factors(ll-1) ! Set the next type of space curve + !-------------------------------------------------------------- + ! Position [0,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = md + lja = lma + ljd = lmd + + if(ll .gt. 1) then + if(debug) write(iulog,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,0] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [0,1] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = lma + ljd = lmd + if(ll .gt. 1) then + if(debug) write(iulog,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [0,1] ',pos + endif + + + !-------------------------------------------------------------- + ! Position [1,1] + !-------------------------------------------------------------- + lma = ma + lmd = md + lja = MOD(ma+1,maxdim) + ljd = -md + + if(ll .gt. 1) then + if(debug) write(iulog,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,1] ',pos + endif + + !-------------------------------------------------------------- + ! Position [1,0] + !-------------------------------------------------------------- + lma = MOD(ma+1,maxdim) + lmd = -md + lja = ja + ljd = jd + + if(ll .gt. 1) then + if(debug) write(iulog,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) + if(debug) call PrintCurve(ordered) + else + ierr = IncrementCurve(lja,ljd) + if(debug) write(iulog,*)'After Position [1,0] ',pos + endif + +21 format('Call Hilbert Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) +22 format('Call Hilbert Pos [0,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +23 format('Call Hilbert Pos [1,1] Level ',i1,' at (',i2,',',i2,')',4(i3)) +24 format('Call Hilbert Pos [1,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) + + end function hilbert + !--------------------------------------------------------- + function IncrementCurve(ja,jd) result(ierr) + + implicit none + + integer :: ja,jd + integer :: ierr + + ordered(pos(0)+1,pos(1)+1) = vcnt + vcnt = vcnt + 1 + pos(ja) = pos(ja) + jd + + ierr = 0 + end function IncrementCurve + !--------------------------------------------------------- + recursive function hilbert_old(l,d,ma,md,ja,jd) result(ierr) + + integer :: l,d ! log base 2 of levels and dimensions left + integer :: ma,md ! main axis and direction + integer :: ja,jd ! joiner axis and direction + + integer :: ierr + integer :: axis + integer :: ll + + if(verbose) write(iulog,10) l,d,ma,md,ja,jd,pos(0),pos(1) + ll = l ! Copy this to a temporary variable + if(d == 0) then + ll=ll-1 + if(ll == 0) then + return + endif + axis = ja + if(dir(ll,axis) /= jd) then ! do not move away from joiner plane + axis = MOD(axis+1,maxdim) ! next axis + endif + if(verbose) write(iulog,*)'hilbert_old: call hilbert_old(l,d) #1:' + ierr = hilbert_old(ll,maxdim,axis,dir(ll,axis),ja,jd) + dir(ll,ja) = -dir(ll,ja) + return + endif + axis = MOD(ma+1,maxdim) + if(verbose) write(iulog,*)'hilbert_old: before call hilbert_old(l,d) #2:' + ierr = hilbert_old(ll,d-1,axis,dir(ll,axis),ma,md) + if(verbose) write(iulog,*)'hilbert_old: after call hilbert_old(l,d) #2:' + if(verbose) write(iulog,30) l,d,ma,md,ja,jd,pos(0),pos(1) + + + pos(ma) = pos(ma) + md + dir(ll,ma) = - dir(ll,ma) + + !---------------------------------- + ! Mark this node as visited + !---------------------------------- + if(verbose) write(iulog,20) l,d,ma,md,ja,jd,pos(0),pos(1) + vcnt=vcnt+1 + if(verbose) write(iulog,15) pos(0)+1,pos(1)+1,vcnt + if(verbose) write(iulog,*)' ' + if(verbose) write(iulog,*)' ' + ordered(pos(0)+1,pos(1)+1)=vcnt + + if(verbose) write(iulog,*)'hilbert_old: before call hilbert_old(l,d) #3:' + ierr = hilbert_old(ll,d-1,axis,dir(ll,axis),ja,jd) + if(verbose) write(iulog,*)'hilbert_old: after call hilbert_old(l,d) #3:' + +10 format('hilbert_old: Entering hilbert_old (l,d,ma,md,ja,jd) are: ', & + 2(i4),' [',2(i3),'][',2(i3),']',2(i3)) +15 format('hilbert_old: mark element {x,y,ordered}:',3(i4)) +20 format('hilbert_old: Before visit code (l,d,ma,md,ja,jd) are:', & + 2(i4),' [',2(i3),'][',2(i3),']',2(i3)) + +30 format('hilbert_old: after call hilbert_old(l,d) #2: (l,d,ma,md,ja,jd are:', & + 2(i4),' [',2(i3),'][',2(i3),']',2(i3)) + + end function hilbert_old + !--------------------------------------------------------- + function log2( n) + + implicit none + + integer :: n + + integer :: log2,tmp + ! + ! Find the log2 of input value + ! + log2 = 1 + tmp =n + do while (tmp/2 .ne. 1) + tmp=tmp/2 + log2=log2+1 + enddo + + end function log2 + !--------------------------------------------------------- + function IsLoadBalanced(nelem,npart) + + implicit none + + integer :: nelem,npart + + logical :: IsLoadBalanced + + integer :: tmp1 + + tmp1 = nelem/npart + + if(npart*tmp1 == nelem ) then + IsLoadBalanced=.TRUE. + else + IsLoadBalanced=.FALSE. + endif + + end function IsLoadBalanced + !--------------------------------------------------------- + recursive function GenCurve(l,type,ma,md,ja,jd) result(ierr) + + implicit none + integer,intent(in) :: l,type,ma,md,ja,jd + integer :: ierr + + if(type == 2) then + ierr = hilbert(l,type,ma,md,ja,jd) + elseif ( type == 3) then + ierr = PeanoM(l,type,ma,md,ja,jd) + elseif ( type == 5) then + ierr = Cinco(l,type,ma,md,ja,jd) + endif + + end function GenCurve + !--------------------------------------------------------- + function Factor(num) result(res) + + implicit none + integer,intent(in) :: num + + type (factor_t) :: res + integer :: tmp,tmp2,tmp3,tmp5 + integer :: i,n + logical :: found + + ! -------------------------------------- + ! Allocate for max # of factors + ! -------------------------------------- + tmp = num + tmp2 = log2(num) + allocate(res%factors(tmp2)) + + n=0 + !----------------------- + ! Look for factors of 2 + !----------------------- + found=.TRUE. + do while (found) + found = .FALSE. + tmp2 = tmp/2 + if( tmp2*2 == tmp ) then + n = n + 1 + res%factors(n) = 2 + found = .TRUE. + tmp = tmp2 + endif + enddo + + !----------------------- + ! Look for factors of 3 + !----------------------- + found=.TRUE. + do while (found) + found = .FALSE. + tmp3 = tmp/3 + if( tmp3*3 == tmp ) then + n = n + 1 + res%factors(n) = 3 + found = .TRUE. + tmp = tmp3 + endif + enddo + + !----------------------- + ! Look for factors of 5 + !----------------------- + found=.TRUE. + do while (found) + found = .FALSE. + tmp5 = tmp/5 + if( tmp5*5 == tmp ) then + n = n + 1 + res%factors(n) = 5 + found = .TRUE. + tmp = tmp5 + endif + enddo + + tmp=1 + do i=1,n + tmp = tmp * res%factors(i) + enddo + if(tmp == num) then + res%numfact = n + else + res%numfact = -1 + endif + + end function Factor + !--------------------------------------------------------- + + function IsFactorable(n) + use cam_abortutils, only: endrun + + integer,intent(in) :: n + type (factor_t) :: fact + + logical :: IsFactorable + + if (associated(fact%factors)) then + call endrun("fact already allocated!!!") + end if + fact = Factor(n) + if(fact%numfact .ne. -1) then + IsFactorable = .TRUE. + else + IsFactorable = .FALSE. + endif + + end function IsFactorable + !------------------------------------------------ + + subroutine map(l) + + implicit none + integer :: l,d + integer :: type, ierr + + d = SIZE(pos) + + pos=0 + maxdim=d + vcnt=0 + + type = fact%factors(l) + ierr = GenCurve(l,type,0,1,0,1) + + end subroutine map + !--------------------------------------------------------- + subroutine GenSpaceCurve(Mesh) + + implicit none + + integer,target,intent(inout) :: Mesh(:,:) + integer :: level,dim + + integer :: gridsize + + ! Setup the size of the grid to traverse + + dim = 2 + gridsize = SIZE(Mesh,dim=1) + fact = factor(gridsize) + level = fact%numfact + + if(verbose) write(iulog,*)'GenSpacecurve: level is ',level + allocate(ordered(gridsize,gridsize)) + + ! Setup the working arrays for the traversal + allocate(pos(0:dim-1)) + + ! The array ordered will contain the visitation order + ordered(:,:) = 0 + + call map(level) + + Mesh(:,:) = ordered(:,:) + + end subroutine GenSpaceCurve + !------------------------------------------------------------------------------------------------------- + subroutine PrintCurve(Mesh) + implicit none + integer,target :: Mesh(:,:) + integer :: gridsize,i + + gridsize = SIZE(Mesh,dim=1) + + if(gridsize == 2) then + write (iulog,*) "A Level 1 Hilbert Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,2) Mesh(1,i),Mesh(2,i) + enddo + else if(gridsize == 3) then + write (iulog,*) "A Level 1 Peano Meandering Curve:" + write (iulog,*) "---------------------------------" + do i=1,gridsize + write(iulog,3) Mesh(1,i),Mesh(2,i),Mesh(3,i) + enddo + else if(gridsize == 4) then + write (iulog,*) "A Level 2 Hilbert Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,4) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i) + enddo + else if(gridsize == 5) then + write (iulog,*) "A Level 1 Cinco Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,5) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i) + enddo + else if(gridsize == 6) then + write (iulog,*) "A Level 1 Hilbert and Level 1 Peano Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,6) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i),Mesh(6,i) + enddo + else if(gridsize == 8) then + write (iulog,*) "A Level 3 Hilbert Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,8) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i) + enddo + else if(gridsize == 9) then + write (iulog,*) "A Level 2 Peano Meandering Curve:" + write (iulog,*) "---------------------------------" + do i=1,gridsize + write(iulog,9) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & + Mesh(9,i) + enddo + else if(gridsize == 10) then + write (iulog,*) "A Level 1 Hilbert and Level 1 Cinco Curve:" + write (iulog,*) "---------------------------------" + do i=1,gridsize + write(iulog,10) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & + Mesh(9,i),Mesh(10,i) + enddo + else if(gridsize == 12) then + write (iulog,*) "A Level 2 Hilbert and Level 1 Peano Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,12) Mesh(1,i),Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i),Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i) + enddo + else if(gridsize == 15) then + write (iulog,*) "A Level 1 Peano and Level 1 Cinco Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,15) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & + Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i) + enddo + else if(gridsize == 16) then + write (iulog,*) "A Level 4 Hilbert Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,16) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & + Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i) + enddo + else if(gridsize == 18) then + write (iulog,*) "A Level 1 Hilbert and Level 2 Peano Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,18) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i) + enddo + else if(gridsize == 20) then + write (iulog,*) "A Level 2 Hilbert and Level 1 Cinco Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,20) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i) + enddo + else if(gridsize == 24) then + write (iulog,*) "A Level 3 Hilbert and Level 1 Peano Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,24) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i) + enddo + else if(gridsize == 25) then + write (iulog,*) "A Level 2 Cinco Curve:" + write (iulog,*) "------------------------------------------" + do i=1,gridsize + write(iulog,25) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & + Mesh(25,i) + enddo + else if(gridsize == 27) then + write (iulog,*) "A Level 3 Peano Meandering Curve:" + write (iulog,*) "---------------------------------" + do i=1,gridsize + write(iulog,27) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & + Mesh(25,i),Mesh(26,i),Mesh(27,i) + enddo + else if(gridsize == 32) then + write (iulog,*) "A Level 5 Hilbert Curve:" + write (iulog,*) "------------------------" + do i=1,gridsize + write(iulog,32) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & + Mesh(25,i),Mesh(26,i),Mesh(27,i),Mesh(28,i), & + Mesh(29,i),Mesh(30,i),Mesh(31,i),Mesh(32,i) + enddo + endif +2 format('|',2(i2,'|')) +3 format('|',3(i2,'|')) +4 format('|',4(i2,'|')) +5 format('|',5(i2,'|')) +6 format('|',6(i2,'|')) +8 format('|',8(i2,'|')) +9 format('|',9(i2,'|')) +10 format('|',10(i2,'|')) +12 format('|',12(i3,'|')) +15 format('|',15(i3,'|')) +16 format('|',16(i3,'|')) +18 format('|',18(i3,'|')) +20 format('|',20(i3,'|')) +24 format('|',24(i3,'|')) +25 format('|',25(i3,'|')) +27 format('|',27(i3,'|')) +32 format('|',32(i4,'|')) + + end subroutine PrintCurve + + !------------------------------------------------------------------------------------------------------- + subroutine genspacepart(GridVertex) + use dimensions_mod, only: npart + use gridgraph_mod, only: gridedge_t, gridvertex_t + + type (GridVertex_t), intent(inout) :: GridVertex(:) + + integer :: nelem, nelemd + integer :: k, tmp1, id, s1, extra + + nelem = SIZE(GridVertex(:)) + + nelemd = nelem / npart + ! every cpu gets nelemd elements, but the first 'extra' get nelemd+1 + extra = mod(nelem,npart) + s1 = extra*(nelemd+1) + + ! split curve into two curves: + ! 1 ... s1 s2 ... nelem + ! + ! s1 = extra*(nelemd+1) (count be 0) + ! s2 = s1+1 + ! + ! First region gets nelemd+1 elements per Processor + ! Second region gets nelemd elements per Processor + + ! =========================================== + ! Add the partitioning information into the + ! Grid Vertex and Grid Edge structures + ! =========================================== + + do k = 1, nelem + id = GridVertex(k)%SpaceCurve + if (id <= s1) then + tmp1 = id/(nelemd+1) + GridVertex(k)%processor_number = tmp1 + 1 + else + id = id - s1 + tmp1 = id / nelemd + GridVertex(k)%processor_number = extra + tmp1+1 + end if + end do +#if 0 + if (masterproc) then + write(iulog, *)'Space-Filling Curve Parititioning: ' + write(iulog, '(2(a,i0))') 'npart = ',npart,', nelem = ',nelem + write(iulog, '(2(a,i0))') 'nelemd = ',npart,', extra = ',extra + write(iulog, '(a)') ' elem task#' + do k = 1, nelem + write(iulog,'(i6," ",i6)') k, GridVertex(k)%processor_number + end do + end if + call mpi_barrier(mpicom, tmp1) +#endif + + end subroutine genspacepart + + end module spacecurve_mod diff --git a/src/dynamics/se/dycore/thread_mod.F90 b/src/dynamics/se/dycore/thread_mod.F90 new file mode 100644 index 0000000000..db406c23a4 --- /dev/null +++ b/src/dynamics/se/dycore/thread_mod.F90 @@ -0,0 +1,74 @@ +module thread_mod + +#ifdef _OPENMP + use omp_lib, only: omp_get_thread_num, & + omp_in_parallel, & + omp_set_num_threads, & + omp_get_max_threads, & + omp_get_num_threads, & + omp_get_nested +#endif + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + implicit none + private + + integer, public :: max_num_threads=1 ! maximum number of OpenMP threads + integer, public :: horz_num_threads, vert_num_threads, tracer_num_threads + + public :: omp_get_thread_num + public :: omp_in_parallel + public :: omp_set_num_threads + public :: omp_get_max_threads + public :: omp_get_num_threads + public :: omp_get_nested + public :: initomp +contains + +#ifndef _OPENMP + function omp_get_thread_num() result(ithr) + integer ithr + ithr=0 + end function omp_get_thread_num + + function omp_get_num_threads() result(ithr) + integer ithr + ithr=1 + end function omp_get_num_threads + + function omp_in_parallel() result(ans) + logical ans + ans=.FALSE. + end function omp_in_parallel + + subroutine omp_set_num_threads(NThreads) + integer Nthreads + NThreads=1 + end subroutine omp_set_num_threads + + integer function omp_get_max_threads() + omp_get_max_threads=1 + end function omp_get_max_threads + + integer function omp_get_nested() + omp_get_nested=0 + end function omp_get_nested + + subroutine initomp + max_num_threads = 1 + if (masterproc) then + write(iulog,*) "INITOMP: INFO: openmp not activated" + end if + end subroutine initomp + +#else + subroutine initomp + max_num_threads = omp_get_num_threads() + if (masterproc) then + write(iulog,*) "INITOMP: INFO: number of OpenMP threads = ", max_num_threads + end if + end subroutine initomp +#endif + +end module thread_mod diff --git a/src/dynamics/se/dycore/time_mod.F90 b/src/dynamics/se/dycore/time_mod.F90 new file mode 100644 index 0000000000..c2946c858f --- /dev/null +++ b/src/dynamics/se/dycore/time_mod.F90 @@ -0,0 +1,133 @@ +module time_mod + !------------------ + use shr_kind_mod, only: r8=>shr_kind_r8 + !------------------ + implicit none + integer,public :: nsplit=1 + integer,public :: nmax ! Max number of timesteps + integer,public :: nEndStep ! Number of End Step + integer,public :: ndays ! Max number of days + + real (kind=r8) , public :: tstep ! Dynamics timestep + real (kind=r8) , public :: tevolve ! time evolved since start of dynamics (end of physics) + real (kind=r8) , public :: phys_tscale=0 ! Physics time scale + real (kind=r8) , public :: dt_phys = -900! physics time-step (only used in standalone HOMME) + ! if negative no forcing (see prim_main) + + ! smooth now in namelist + integer, parameter :: ptimelevels = 3 ! number of time levels in the dycore + + type, public :: TimeLevel_t + integer nm1 ! relative time level n-1 + integer n0 ! relative time level n + integer np1 ! relative time level n+1 + integer nstep ! time level since simulation start + integer nstep0 ! timelevel of first complete leapfrog timestep + end type TimeLevel_t + + ! Methods + public :: Time_at + public :: TimeLevel_update + public :: TimeLevel_init + public :: TimeLevel_Qdp + + interface TimeLevel_init + module procedure TimeLevel_init_default + module procedure TimeLevel_init_specific + module procedure TimeLevel_init_copy + end interface + +contains + + function Time_at(nstep) result(tat) + integer, intent(in) :: nstep + real (kind=r8) :: tat + tat = nstep*tstep + end function Time_at + + subroutine TimeLevel_init_default(tl) + type (TimeLevel_t), intent(out) :: tl + tl%nm1 = 1 + tl%n0 = 2 + tl%np1 = 3 + tl%nstep = 0 + tl%nstep0 = 2 + end subroutine TimeLevel_init_default + + subroutine TimeLevel_init_copy(tl, tin) + type (TimeLevel_t), intent(in) :: tin + type (TimeLevel_t), intent(out) :: tl + tl%nm1 = tin%nm1 + tl%n0 = tin%n0 + tl%np1 = tin%np1 + tl%nstep = tin%nstep + tl%nstep0= tin%nstep0 + end subroutine TimeLevel_init_copy + + subroutine TimeLevel_init_specific(tl,n0,n1,n2,nstep) + type (TimeLevel_t) :: tl + integer, intent(in) :: n0,n1,n2,nstep + tl%nm1= n0 + tl%n0 = n1 + tl%np1= n2 + tl%nstep= nstep + end subroutine TimeLevel_init_specific + + + !this subroutine returns the proper + !locations for nm1 and n0 for Qdp - because + !it only has 2 levels for storage + subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) + type (TimeLevel_t) :: tl + integer, intent(in) :: qsplit + integer, intent(inout) :: n0 + integer, intent(inout), optional :: np1 + + integer :: i_temp + + i_temp = tl%nstep/qsplit + + if (mod(i_temp,2) ==0) then + n0 = 1 + if (present(np1)) then + np1 = 2 + endif + else + n0 = 2 + if (present(np1)) then + np1 = 1 + end if + endif + + !print * ,'nstep = ', tl%nstep, 'qsplit= ', qsplit, 'i_temp = ', i_temp, 'n0 = ', n0 + + end subroutine TimeLevel_Qdp + + subroutine TimeLevel_update(tl,uptype) + type (TimeLevel_t) :: tl + character(len=*) :: uptype + + ! Local Variable + + integer :: ntmp +!$OMP BARRIER +!$OMP MASTER + if (uptype == "leapfrog") then + ntmp = tl%np1 + tl%np1 = tl%nm1 + tl%nm1 = tl%n0 + tl%n0 = ntmp + else if (uptype == "forward") then + ntmp = tl%np1 + tl%np1 = tl%n0 + tl%n0 = ntmp + else + print *,'WARNING: TimeLevel_update called wint invalid uptype=',uptype + end if + + tl%nstep = tl%nstep+1 +!$OMP END MASTER +!$OMP BARRIER + end subroutine TimeLevel_update + +end module time_mod diff --git a/src/dynamics/se/dycore/vertremap_mod.F90 b/src/dynamics/se/dycore/vertremap_mod.F90 new file mode 100644 index 0000000000..9f8cecff11 --- /dev/null +++ b/src/dynamics/se/dycore/vertremap_mod.F90 @@ -0,0 +1,733 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Begin GPU remap module !! +!! by Rick Archibald, 2010 !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +module vertremap_mod + + !************************************************************************************** + ! + ! Purpose: + ! Construct sub-grid-scale polynomials using piecewise spline method with + ! monotone filters. + ! + ! References: PCM - Zerroukat et al., Q.J.R. Meteorol. Soc., 2005. (ZWS2005QJR) + ! PSM - Zerroukat et al., Int. J. Numer. Meth. Fluids, 2005. (ZWS2005IJMF) + ! + !************************************************************************************** + + use shr_kind_mod, only: r8=>shr_kind_r8 + use dimensions_mod, only: np,nlev,qsize,nlevp,npsq,nc + use hybvcoord_mod, only: hvcoord_t + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use perf_mod, only: t_startf, t_stopf ! _EXTERNAL + use parallel_mod, only: parallel_t + use cam_abortutils, only: endrun + use control_mod, only: vert_remap_q_alg + + public remap1 ! remap any field, splines, monotone + public remap1_nofilter ! remap any field, splines, no filter +! todo: tweak interface to match remap1 above, rename remap1_ppm: + public remap_q_ppm ! remap state%Q, PPM, monotone + + contains + +!=======================================================================================================! + +subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,hybrid) + ! remap 1 field + ! input: Qdp field to be remapped (NOTE: MASS, not MIXING RATIO) + ! dp1 layer thickness (source) + ! dp2 layer thickness (target) + ! + ! output: remaped Qdp, conserving mass, monotone on Q=Qdp/dp + ! + use hybrid_mod, only : hybrid_t, get_loop_ranges, config_thread_region + use thread_mod, only : tracer_num_threads + implicit none + integer, intent(in) :: nx,qstart,qstop,qsize + real (kind=r8), intent(inout) :: Qdp(nx,nx,nlev,qsize) + real (kind=r8), intent(in) :: dp1(nx,nx,nlev),dp2(nx,nx,nlev) + type (hybrid_t), optional :: hybrid + ! ======================== + ! Local Variables + ! ======================== + + type (hybrid_t) :: hybridnew + real (kind=r8), dimension(nlev+1) :: rhs,lower_diag,diag,upper_diag,q_diag,zgam,z1c,z2c,zv + real (kind=r8), dimension(nlev) :: h,Qcol,dy,za0,za1,za2,zarg,zhdp + real (kind=r8) :: f_xm,level1,level2,level4,level5, & + peaks_min,peaks_max,tmp_cal,xm,xm_d,zv1,zv2, & + zero = 0._r8,one = 1._r8,tiny = 1.e-12_r8,qmax = 1.e50_r8 + integer :: zkr(nlev+1),filter_code(nlev),peaks,im1,im2,im3,ip1,ip2, & + lt1,lt2,lt3,t1,t2,t3,t4,tm,tp,i,ilev,j,jk,k,q + integer :: qbeg, qend + logical :: abort=.false. + + if (vert_remap_q_alg == 1 .or. vert_remap_q_alg == 2) then + call t_startf('remap_Q_ppm') + if ( present(hybrid) ) then + !$OMP PARALLEL NUM_THREADS(tracer_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew,qbeg,qend) + hybridnew = config_thread_region(hybrid,'tracer') + call get_loop_ranges(hybridnew, qbeg=qbeg, qend=qend) + call remap_Q_ppm(qdp,nx,qbeg,qend,qsize,dp1,dp2) + !$OMP END PARALLEL + else + call remap_Q_ppm(qdp,nx,qstart,qstop,qsize,dp1,dp2) + endif + call t_stopf('remap_Q_ppm') + return + endif + + ! write(6,*) 'YOU ARE DOINGS SPLINES REMAP WHICH IS NOT STRICTLY MONOTONE! ABORT' + ! abort = .true. + do q=qstart,qstop + do i=1,nx + do j=1,nx + + z1c(1)=0 ! source grid + z2c(1)=0 ! target grid + do k=1,nlev + z1c(k+1)=z1c(k)+dp1(i,j,k) + z2c(k+1)=z2c(k)+dp2(i,j,k) + enddo + + zv(1)=0 + do k=1,nlev + Qcol(k)=Qdp(i,j,k,q)! *(z1c(k+1)-z1c(k)) input is mass + zv(k+1) = zv(k)+Qcol(k) + enddo + + if (ABS(z2c(nlev+1)-z1c(nlev+1)).GE.0.000001_r8) then + write(6,*) 'SURFACE PRESSURE IMPLIED BY ADVECTION SCHEME' + write(6,*) 'NOT CORRESPONDING TO SURFACE PRESSURE IN ' + write(6,*) 'DATA FOR MODEL LEVELS' + write(6,*) 'PLEVMODEL=',z2c(nlev+1) + write(6,*) 'PLEV =',z1c(nlev+1) + write(6,*) 'DIFF =',z2c(nlev+1)-z1c(nlev+1) + abort=.true. + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! quadratic splies with UK met office monotonicity constraints !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + zkr = 99 + ilev = 2 + zkr(1) = 1 + zkr(nlev+1) = nlev + kloop: do k = 2,nlev + do jk = ilev,nlev+1 + if (z1c(jk).ge.z2c(k)) then + ilev = jk + zkr(k) = jk-1 + cycle kloop + endif + enddo + enddo kloop + + zgam = (z2c(1:nlev+1)-z1c(zkr)) / (z1c(zkr+1)-z1c(zkr)) + zgam(1) = 0.0_r8 + zgam(nlev+1) = 1.0_r8 + zhdp = z1c(2:nlev+1)-z1c(1:nlev) + + + h = 1/zhdp + zarg = Qcol * h + rhs = 0 + lower_diag = 0 + diag = 0 + upper_diag = 0 + + rhs(1)=3*zarg(1) + rhs(2:nlev) = 3*(zarg(2:nlev)*h(2:nlev) + zarg(1:nlev-1)*h(1:nlev-1)) + rhs(nlev+1)=3*zarg(nlev) + + lower_diag(1)=1 + lower_diag(2:nlev) = h(1:nlev-1) + lower_diag(nlev+1)=1 + + diag(1)=2 + diag(2:nlev) = 2*(h(2:nlev) + h(1:nlev-1)) + diag(nlev+1)=2 + + upper_diag(1)=1 + upper_diag(2:nlev) = h(2:nlev) + upper_diag(nlev+1)=0 + + q_diag(1)=-upper_diag(1)/diag(1) + rhs(1)= rhs(1)/diag(1) + + do k=2,nlev+1 + tmp_cal = 1/(diag(k)+lower_diag(k)*q_diag(k-1)) + q_diag(k) = -upper_diag(k)*tmp_cal + rhs(k) = (rhs(k)-lower_diag(k)*rhs(k-1))*tmp_cal + enddo + do k=nlev,1,-1 + rhs(k)=rhs(k)+q_diag(k)*rhs(k+1) + enddo + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! monotonicity modifications !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + filter_code = 0 + dy(1:nlev-1) = zarg(2:nlev)-zarg(1:nlev-1) + dy(nlev) = dy(nlev-1) + + dy = merge(zero, dy, abs(dy) < tiny ) + + do k=1,nlev + im1=MAX(1,k-1) + im2=MAX(1,k-2) + im3=MAX(1,k-3) + ip1=MIN(nlev,k+1) + t1 = merge(1,0,(zarg(k)-rhs(k))*(rhs(k)-zarg(im1)) >= 0) + t2 = merge(1,0,dy(im2)*(rhs(k)-zarg(im1)) > 0 .AND. dy(im2)*dy(im3) > 0 & + .AND. dy(k)*dy(ip1) > 0 .AND. dy(im2)*dy(k) < 0 ) + t3 = merge(1,0,ABS(rhs(k)-zarg(im1)) > ABS(rhs(k)-zarg(k))) + + filter_code(k) = merge(0,1,t1+t2 > 0) + rhs(k) = (1-filter_code(k))*rhs(k)+filter_code(k)*(t3*zarg(k)+(1-t3)*zarg(im1)) + filter_code(im1) = MAX(filter_code(im1),filter_code(k)) + enddo + + rhs = merge(qmax,rhs,rhs > qmax) + rhs = merge(zero,rhs,rhs < zero) + + za0 = rhs(1:nlev) + za1 = -4*rhs(1:nlev) - 2*rhs(2:nlev+1) + 6*zarg + za2 = 3*rhs(1:nlev) + 3*rhs(2:nlev+1) - 6*zarg + + dy(1:nlev) = rhs(2:nlev+1)-rhs(1:nlev) + dy = merge(zero, dy, abs(dy) < tiny ) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Compute the 3 quadratic spline coeffients {za0, za1, za2} !! + !! knowing the quadratic spline parameters {rho_left,rho_right,zarg} !! + !! Zerroukat et.al., Q.J.R. Meteorol. Soc., Vol. 128, pp. 2801-2820 (2002). !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + h = rhs(2:nlev+1) + + do k=1,nlev + xm_d = merge(one,2*za2(k),abs(za2(k)) < tiny) + xm = merge(zero,-za1(k)/xm_d, abs(za2(k)) < tiny) + f_xm = za0(k) + za1(k)*xm + za2(k)*xm**2 + + t1 = merge(1,0,ABS(za2(k)) > tiny) + t2 = merge(1,0,xm <= zero .OR. xm >= 1) + t3 = merge(1,0,za2(k) > zero) + t4 = merge(1,0,za2(k) < zero) + tm = merge(1,0,t1*((1-t2)+t3) .EQ. 2) + tp = merge(1,0,t1*((1-t2)+(1-t3)+t4) .EQ. 3) + + peaks=0 + peaks = merge(-1,peaks,tm .EQ. 1) + peaks = merge(+1,peaks,tp .EQ. 1) + peaks_min = merge(f_xm,MIN(za0(k),za0(k)+za1(k)+za2(k)),tm .EQ. 1) + peaks_max = merge(f_xm,MAX(za0(k),za0(k)+za1(k)+za2(k)),tp .EQ. 1) + + im1=MAX(1,k-1) + im2=MAX(1,k-2) + ip1=MIN(nlev,k+1) + ip2=MIN(nlev,k+2) + + t1 = merge(abs(peaks),0,(dy(im2)*dy(im1) <= tiny) .OR. & + (dy(ip1)*dy(ip2) <= tiny) .OR. (dy(im1)*dy(ip1) >= tiny) .OR. & + (dy(im1)*float(peaks) <= tiny)) + + filter_code(k) = merge(1,t1+(1-t1)*filter_code(k),(rhs(k) >= qmax) .OR. & + (rhs(k) <= zero) .OR. (peaks_max > qmax) .OR. (peaks_min < tiny)) + + if (filter_code(k) > 0) then + level1 = rhs(k) + level2 = (2*rhs(k)+h(k))/3 + level4 = (1/3_r8)*rhs(k)+2*(1/3_r8)*h(k) + level5 = h(k) + + t1 = merge(1,0,h(k) >= rhs(k)) + t2 = merge(1,0,zarg(k) <= level1 .OR. zarg(k) >= level5) + t3 = merge(1,0,zarg(k) > level1 .AND. zarg(k) < level2) + t4 = merge(1,0,zarg(k) > level4 .AND. zarg(k) < level5) + + lt1 = t1*t2 + lt2 = t1*(1-t2+t3) + lt3 = t1*(1-t2+1-t3+t4) + + za0(k) = merge(zarg(k),za0(k),lt1 .EQ. 1) + za1(k) = merge(zero,za1(k),lt1 .EQ. 1) + za2(k) = merge(zero,za2(k),lt1 .EQ. 1) + + za0(k) = merge(rhs(k),za0(k),lt2 .EQ. 2) + za1(k) = merge(zero,za1(k),lt2 .EQ. 2) + za2(k) = merge(3*(zarg(k)-rhs(k)),za2(k),lt2 .EQ. 2) + + za0(k) = merge(-2*h(k)+3*zarg(k),za0(k),lt3 .EQ. 3) + za1(k) = merge(+6*h(k)-6*zarg(k),za1(k),lt3 .EQ. 3) + za2(k) = merge(-3*h(k)+3*zarg(k),za2(k),lt3 .EQ. 3) + + t2 = merge(1,0,zarg(k) >= level1 .OR. zarg(k) <= level5) + t3 = merge(1,0,zarg(k) < level1 .AND. zarg(k) > level2) + t4 = merge(1,0,zarg(k) < level4 .AND. zarg(k) > level5) + + lt1 = (1-t1)*t2 + lt2 = (1-t1)*(1-t2+t3) + lt3 = (1-t1)*(1-t2+1-t3+t4) + + za0(k) = merge(zarg(k),za0(k),lt1 .EQ. 1) + za1(k) = merge(zero,za1(k),lt1 .EQ. 1) + za2(k) = merge(zero,za2(k),lt1 .EQ. 1) + + za0(k) = merge(rhs(k),za0(k),lt2 .EQ. 2) + za1(k) = merge(zero,za1(k),lt2 .EQ. 2) + za2(k) = merge(3*(zarg(k)-rhs(k)),za2(k),lt2 .EQ. 2) + + za0(k) = merge(-2*h(k)+3*zarg(k),za0(k),lt3 .EQ. 3) + za1(k) = merge(+6*h(k)-6*zarg(k),za1(k),lt3 .EQ. 3) + za2(k) = merge(-3*h(k)+3*zarg(k),za2(k),lt3 .EQ. 3) + endif + enddo + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! start iteration from top to bottom of atmosphere !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + zv1 = 0 + do k=1,nlev + if (zgam(k+1)>1_r8) then + WRITE(*,*) 'r not in [0:1]', zgam(k+1) + abort=.true. + endif + zv2 = zv(zkr(k+1))+(za0(zkr(k+1))*zgam(k+1)+(za1(zkr(k+1))/2)*(zgam(k+1)**2)+ & + (za2(zkr(k+1))/3)*(zgam(k+1)**3))*zhdp(zkr(k+1)) + Qdp(i,j,k,q) = (zv2 - zv1) ! / (z2c(k+1)-z2c(k) ) dont convert back to mixing ratio + zv1 = zv2 + enddo + enddo + enddo + enddo ! q loop + if (abort) then + call endrun('Bad levels in remap1. usually CFL violatioin') + end if + +end subroutine remap1 + +subroutine remap1_nofilter(Qdp,nx,qsize,dp1,dp2) + ! remap 1 field + ! input: Qdp field to be remapped (NOTE: MASS, not MIXING RATIO) + ! dp1 layer thickness (source) + ! dp2 layer thickness (target) + ! + ! output: remaped Qdp, conserving mass + ! + implicit none + integer, intent(in) :: nx,qsize + real (kind=r8), intent(inout) :: Qdp(nx,nx,nlev,qsize) + real (kind=r8), intent(in) :: dp1(nx,nx,nlev),dp2(nx,nx,nlev) + ! ======================== + ! Local Variables + ! ======================== + + real (kind=r8), dimension(nlev+1) :: rhs,lower_diag,diag,upper_diag,q_diag,zgam,z1c,z2c,zv + real (kind=r8), dimension(nlev) :: h,Qcol,za0,za1,za2,zarg,zhdp + real (kind=r8) :: tmp_cal,zv1,zv2 + integer :: zkr(nlev+1),i,ilev,j,jk,k,q + logical :: abort=.false. + ! call t_startf('remap1_nofilter') + +#if (defined COLUMN_OPENMP) + !$omp parallel do num_threads(tracer_num_threads) & + !$omp private(q,i,j,z1c,z2c,zv,k,Qcol,zkr,ilev) & + !$omp private(jk,zgam,zhdp,h,zarg,rhs,lower_diag,diag,upper_diag,q_diag,tmp_cal) & + !$omp private(za0,za1,za2) & + !$omp private(ip2,zv1,zv2) +#endif + do q=1,qsize + do i=1,nx + do j=1,nx + + z1c(1)=0 ! source grid + z2c(1)=0 ! target grid + do k=1,nlev + z1c(k+1)=z1c(k)+dp1(i,j,k) + z2c(k+1)=z2c(k)+dp2(i,j,k) + enddo + + zv(1)=0 + do k=1,nlev + Qcol(k)=Qdp(i,j,k,q)! *(z1c(k+1)-z1c(k)) input is mass + zv(k+1) = zv(k)+Qcol(k) + enddo + + if (ABS(z2c(nlev+1)-z1c(nlev+1)).GE.0.000001_r8) then + write(6,*) 'SURFACE PRESSURE IMPLIED BY ADVECTION SCHEME' + write(6,*) 'NOT CORRESPONDING TO SURFACE PRESSURE IN ' + write(6,*) 'DATA FOR MODEL LEVELS' + write(6,*) 'PLEVMODEL=',z2c(nlev+1) + write(6,*) 'PLEV =',z1c(nlev+1) + write(6,*) 'DIFF =',z2c(nlev+1)-z1c(nlev+1) + abort=.true. + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! quadratic splies with UK met office monotonicity constraints !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + zkr = 99 + ilev = 2 + zkr(1) = 1 + zkr(nlev+1) = nlev + kloop: do k = 2,nlev + do jk = ilev,nlev+1 + if (z1c(jk).ge.z2c(k)) then + ilev = jk + zkr(k) = jk-1 + cycle kloop + endif + enddo + enddo kloop + + zgam = (z2c(1:nlev+1)-z1c(zkr)) / (z1c(zkr+1)-z1c(zkr)) + zgam(1) = 0.0_r8 + zgam(nlev+1) = 1.0_r8 + zhdp = z1c(2:nlev+1)-z1c(1:nlev) + + + h = 1/zhdp + zarg = Qcol * h + rhs = 0 + lower_diag = 0 + diag = 0 + upper_diag = 0 + + rhs(1)=3*zarg(1) + rhs(2:nlev) = 3*(zarg(2:nlev)*h(2:nlev) + zarg(1:nlev-1)*h(1:nlev-1)) + rhs(nlev+1)=3*zarg(nlev) + + lower_diag(1)=1 + lower_diag(2:nlev) = h(1:nlev-1) + lower_diag(nlev+1)=1 + + diag(1)=2 + diag(2:nlev) = 2*(h(2:nlev) + h(1:nlev-1)) + diag(nlev+1)=2 + + upper_diag(1)=1 + upper_diag(2:nlev) = h(2:nlev) + upper_diag(nlev+1)=0 + + q_diag(1)=-upper_diag(1)/diag(1) + rhs(1)= rhs(1)/diag(1) + + do k=2,nlev+1 + tmp_cal = 1/(diag(k)+lower_diag(k)*q_diag(k-1)) + q_diag(k) = -upper_diag(k)*tmp_cal + rhs(k) = (rhs(k)-lower_diag(k)*rhs(k-1))*tmp_cal + enddo + do k=nlev,1,-1 + rhs(k)=rhs(k)+q_diag(k)*rhs(k+1) + enddo + + za0 = rhs(1:nlev) + za1 = -4*rhs(1:nlev) - 2*rhs(2:nlev+1) + 6*zarg + za2 = 3*rhs(1:nlev) + 3*rhs(2:nlev+1) - 6*zarg + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! start iteration from top to bottom of atmosphere !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + zv1 = 0 + do k=1,nlev + if (zgam(k+1)>1_r8) then + WRITE(*,*) 'r not in [0:1]', zgam(k+1) + abort=.true. + endif + zv2 = zv(zkr(k+1))+(za0(zkr(k+1))*zgam(k+1)+(za1(zkr(k+1))/2)*(zgam(k+1)**2)+ & + (za2(zkr(k+1))/3)*(zgam(k+1)**3))*zhdp(zkr(k+1)) + Qdp(i,j,k,q) = (zv2 - zv1) ! / (z2c(k+1)-z2c(k) ) dont convert back to mixing ratio + zv1 = zv2 + enddo + enddo + enddo + enddo ! q loop + if (abort) then + call endrun('Bad levels in remap1_nofilter. usually CFL violatioin') + end if +end subroutine remap1_nofilter + +!=============================================================================! + + +!This uses the exact same model and reference grids and data as remap_Q, but it interpolates +!using PPM instead of splines. +subroutine remap_Q_ppm(Qdp,nx,qstart,qstop,qsize,dp1,dp2) + ! remap 1 field + ! input: Qdp field to be remapped (NOTE: MASS, not MIXING RATIO) + ! dp1 layer thickness (source) + ! dp2 layer thickness (target) + ! + ! output: remaped Qdp, conserving mass + ! + use control_mod, only : vert_remap_q_alg + implicit none + integer,intent(in) :: nx,qstart,qstop,qsize + real (kind=r8), intent(inout) :: Qdp(nx,nx,nlev,qsize) + real (kind=r8), intent(in) :: dp1(nx,nx,nlev),dp2(nx,nx,nlev) + ! Local Variables + integer, parameter :: gs = 2 !Number of cells to place in the ghost region + real(kind=r8), dimension( nlev+2 ) :: pio !Pressure at interfaces for old grid + real(kind=r8), dimension( nlev+1 ) :: pin !Pressure at interfaces for new grid + real(kind=r8), dimension( nlev+1 ) :: masso !Accumulate mass up to each interface + real(kind=r8), dimension( 1-gs:nlev+gs) :: ao !Tracer value on old grid + real(kind=r8), dimension( 1-gs:nlev+gs) :: dpo !change in pressure over a cell for old grid + real(kind=r8), dimension( 1-gs:nlev+gs) :: dpn !change in pressure over a cell for old grid + real(kind=r8), dimension(3, nlev ) :: coefs !PPM coefficients within each cell + real(kind=r8), dimension( nlev ) :: z1, z2 + real(kind=r8) :: ppmdx(10,0:nlev+1) !grid spacings + real(kind=r8) :: massn1, massn2 + integer :: i, j, k, q, kk, kid(nlev) + + do j = 1 , nx + do i = 1 , nx + + pin(1)=0 + pio(1)=0 + do k=1,nlev + dpn(k)=dp2(i,j,k) + dpo(k)=dp1(i,j,k) + pin(k+1)=pin(k)+dpn(k) + pio(k+1)=pio(k)+dpo(k) + enddo + + + + pio(nlev+2) = pio(nlev+1) + 1._r8 !This is here to allow an entire block of k threads to run in the remapping phase. + !It makes sure there's an old interface value below the domain that is larger. + pin(nlev+1) = pio(nlev+1) !The total mass in a column does not change. + !Therefore, the pressure of that mass cannot either. + !Fill in the ghost regions with mirrored values. if vert_remap_q_alg is defined, this is of no consequence. + do k = 1 , gs + dpo(1 -k) = dpo( k) + dpo(nlev+k) = dpo(nlev+1-k) + enddo + + !Compute remapping intervals once for all tracers. Find the old grid cell index in which the + !k-th new cell interface resides. Then integrate from the bottom of that old cell to the new + !interface location. In practice, the grid never deforms past one cell, so the search can be + !simplified by this. Also, the interval of integration is usually of magnitude close to zero + !or close to dpo because of minimial deformation. + !Numerous tests confirmed that the bottom and top of the grids match to machine precision, so + !I set them equal to each other. + do k = 1 , nlev + kk = k !Keep from an order n^2 search operation by assuming the old cell index is close. + !Find the index of the old grid cell in which this new cell's bottom interface resides. + do while ( pio(kk) <= pin(k+1) ) + kk = kk + 1 + enddo + kk = kk - 1 !kk is now the cell index we're integrating over. + if (kk == nlev+1) kk = nlev !This is to keep the indices in bounds. + !Top bounds match anyway, so doesn't matter what coefficients are used + kid(k) = kk !Save for reuse + z1(k) = -0.5_R8 !This remapping assumes we're starting from the left interface of an old grid cell + !In fact, we're usually integrating very little or almost all of the cell in question + z2(k) = ( pin(k+1) - ( pio(kk) + pio(kk+1) ) * 0.5_r8 ) / dpo(kk) !PPM interpolants are normalized to an independent + !coordinate domain [-0.5,0.5]. + enddo + + !This turned out a big optimization, remembering that only parts of the PPM algorithm depends on the data, namely the + !limiting. So anything that depends only on the grid is pre-computed outside the tracer loop. + ppmdx(:,:) = compute_ppm_grids( dpo ) + + !From here, we loop over tracers for only those portions which depend on tracer data, which includes PPM limiting and + !mass accumulation + do q = qstart, qstop + !Accumulate the old mass up to old grid cell interface locations to simplify integration + !during remapping. Also, divide out the grid spacing so we're working with actual tracer + !values and can conserve mass. The option for ifndef ZEROHORZ I believe is there to ensure + !tracer consistency for an initially uniform field. I copied it from the old remap routine. + masso(1) = 0._r8 + + do k = 1 , nlev + ao(k) = Qdp(i,j,k,q) + masso(k+1) = masso(k) + ao(k) !Accumulate the old mass. This will simplify the remapping + ao(k) = ao(k) / dpo(k) !Divide out the old grid spacing because we want the tracer mixing ratio, not mass. + enddo + !Fill in ghost values. Ignored if vert_remap_q_alg == 2 + do k = 1 , gs + ao(1 -k) = ao( k) + ao(nlev+k) = ao(nlev+1-k) + enddo + !Compute monotonic and conservative PPM reconstruction over every cell + coefs(:,:) = compute_ppm( ao , ppmdx ) + !Compute tracer values on the new grid by integrating from the old cell bottom to the new + !cell interface to form a new grid mass accumulation. Taking the difference between + !accumulation at successive interfaces gives the mass inside each cell. Since Qdp is + !supposed to hold the full mass this needs no normalization. + massn1 = 0._r8 + do k = 1 , nlev + kk = kid(k) + massn2 = masso(kk) + integrate_parabola( coefs(:,kk) , z1(k) , z2(k) ) * dpo(kk) + Qdp(i,j,k,q) = massn2 - massn1 + massn1 = massn2 + enddo + enddo + enddo + enddo +! call t_stopf('remap_Q_ppm') +end subroutine remap_Q_ppm + + +!=======================================================================================================! + + +!THis compute grid-based coefficients from Collela & Woodward 1984. +function compute_ppm_grids( dx ) result(rslt) + use control_mod, only: vert_remap_q_alg + implicit none + real(kind=r8), intent(in) :: dx(-1:nlev+2) !grid spacings + real(kind=r8) :: rslt(10,0:nlev+1) !grid spacings + integer :: j + integer :: indB, indE + + !Calculate grid-based coefficients for stage 1 of compute_ppm + if (vert_remap_q_alg == 2) then + indB = 2 + indE = nlev-1 + else + indB = 0 + indE = nlev+1 + endif + do j = indB , indE + rslt( 1,j) = dx(j) / ( dx(j-1) + dx(j) + dx(j+1) ) + rslt( 2,j) = ( 2._r8*dx(j-1) + dx(j) ) / ( dx(j+1) + dx(j) ) + rslt( 3,j) = ( dx(j) + 2._r8*dx(j+1) ) / ( dx(j-1) + dx(j) ) + enddo + + !Caculate grid-based coefficients for stage 2 of compute_ppm + if (vert_remap_q_alg == 2) then + indB = 2 + indE = nlev-2 + else + indB = 0 + indE = nlev + endif + do j = indB , indE + rslt( 4,j) = dx(j) / ( dx(j) + dx(j+1) ) + rslt( 5,j) = 1._r8 / sum( dx(j-1:j+2) ) + rslt( 6,j) = ( 2._r8 * dx(j+1) * dx(j) ) / ( dx(j) + dx(j+1 ) ) + rslt( 7,j) = ( dx(j-1) + dx(j ) ) / ( 2._r8 * dx(j ) + dx(j+1) ) + rslt( 8,j) = ( dx(j+2) + dx(j+1) ) / ( 2._r8 * dx(j+1) + dx(j ) ) + rslt( 9,j) = dx(j ) * ( dx(j-1) + dx(j ) ) / ( 2._r8*dx(j ) + dx(j+1) ) + rslt(10,j) = dx(j+1) * ( dx(j+1) + dx(j+2) ) / ( dx(j ) + 2._r8*dx(j+1) ) + enddo +end function compute_ppm_grids + +!=======================================================================================================! + + + +!This computes a limited parabolic interpolant using a net 5-cell stencil, but the stages of computation are broken up into 3 stages +function compute_ppm( a , dx ) result(coefs) + use control_mod, only: vert_remap_q_alg + implicit none + real(kind=r8), intent(in) :: a ( -1:nlev+2) !Cell-mean values + real(kind=r8), intent(in) :: dx (10, 0:nlev+1) !grid spacings + real(kind=r8) :: coefs(0:2, nlev ) !PPM coefficients (for parabola) + real(kind=r8) :: ai (0:nlev ) !fourth-order accurate, then limited interface values + real(kind=r8) :: dma(0:nlev+1) !An expression from Collela's '84 publication + real(kind=r8) :: da !Ditto + ! Hold expressions based on the grid (which are cumbersome). + real(kind=r8) :: al, ar !Left and right interface values for cell-local limiting + integer :: j + integer :: indB, indE + + ! Stage 1: Compute dma for each cell, allowing a 1-cell ghost stencil below and above the domain + if (vert_remap_q_alg == 2) then + indB = 2 + indE = nlev-1 + else + indB = 0 + indE = nlev+1 + endif + do j = indB , indE + da = dx(1,j) * ( dx(2,j) * ( a(j+1) - a(j) ) + dx(3,j) * ( a(j) - a(j-1) ) ) + dma(j) = minval( (/ abs(da) , 2._r8 * abs( a(j) - a(j-1) ) , 2._r8 * abs( a(j+1) - a(j) ) /) ) * sign(1._R8,da) + if ( ( a(j+1) - a(j) ) * ( a(j) - a(j-1) ) <= 0._r8 ) dma(j) = 0._r8 + enddo + + ! Stage 2: Compute ai for each cell interface in the physical domain (dimension nlev+1) + if (vert_remap_q_alg == 2) then + indB = 2 + indE = nlev-2 + else + indB = 0 + indE = nlev + endif + do j = indB , indE + ai(j) = a(j) + dx(4,j) * ( a(j+1) - a(j) ) + dx(5,j) * ( dx(6,j) * ( dx(7,j) - dx(8,j) ) & + * ( a(j+1) - a(j) ) - dx(9,j) * dma(j+1) + dx(10,j) * dma(j) ) + enddo + + ! Stage 3: Compute limited PPM interpolant over each cell in the physical domain + ! (dimension nlev) using ai on either side and ao within the cell. + if (vert_remap_q_alg == 2) then + indB = 3 + indE = nlev-2 + else + indB = 1 + indE = nlev + endif + do j = indB , indE + al = ai(j-1) + ar = ai(j ) + if ( (ar - a(j)) * (a(j) - al) <= 0._r8 ) then + al = a(j) + ar = a(j) + endif + if ( (ar - al) * (a(j) - (al + ar)/2._r8) > (ar - al)**2/6._r8 ) al = 3._r8*a(j) - 2._r8 * ar + if ( (ar - al) * (a(j) - (al + ar)/2._r8) < -(ar - al)**2/6._r8 ) ar = 3._r8*a(j) - 2._r8 * al + !Computed these coefficients from the edge values and cell mean in Maple. Assumes normalized coordinates: xi=(x-x0)/dx + coefs(0,j) = 1.5_r8 * a(j) - ( al + ar ) / 4._r8 + coefs(1,j) = ar - al + coefs(2,j) = -6._r8 * a(j) + 3._r8 * ( al + ar ) + enddo + + !If we're not using a mirrored boundary condition, then make the two cells bordering the top and bottom + !material boundaries piecewise constant. Zeroing out the first and second moments, and setting the zeroth + !moment to the cell mean is sufficient to maintain conservation. + if (vert_remap_q_alg == 2) then + coefs(0,1:2) = a(1:2) + coefs(1:2,1:2) = 0._r8 + coefs(0,nlev-1:nlev) = a(nlev-1:nlev) + coefs(1:2,nlev-1:nlev) = 0._R8 + endif +end function compute_ppm + +!=======================================================================================================! + + +!Simple function computes the definite integral of a parabola in normalized coordinates, xi=(x-x0)/dx, +!given two bounds. Make sure this gets inlined during compilation. +function integrate_parabola( a , x1 , x2 ) result(mass) + implicit none + real(kind=r8), intent(in) :: a(0:2) !Coefficients of the parabola + real(kind=r8), intent(in) :: x1 !lower domain bound for integration + real(kind=r8), intent(in) :: x2 !upper domain bound for integration + real(kind=r8) :: mass + mass = a(0) * (x2 - x1) + a(1) * (x2 ** 2 - x1 ** 2) / 0.2D1 + a(2) * (x2 ** 3 - x1 ** 3) / 0.3D1 +end function integrate_parabola + + +!=============================================================================================! + + + +end module vertremap_mod + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! End GPU remap module !! +!! by Rick Archibald, 2010 !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 new file mode 100644 index 0000000000..b4449dbcce --- /dev/null +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -0,0 +1,873 @@ +module viscosity_mod +! +! This module should be renamed "global_deriv_mod.F90" +! +! It is a collection of derivative operators that must be applied to the field +! over the sphere (as opposed to derivative operators that can be applied element +! by element) +! +! + use shr_kind_mod, only: r8=>shr_kind_r8 + use thread_mod, only: max_num_threads, omp_get_num_threads + use dimensions_mod, only: np, nc, nlev,qsize,nelemd + use hybrid_mod, only: hybrid_t, get_loop_ranges, config_thread_region + use parallel_mod, only: parallel_t + use element_mod, only: element_t + use derivative_mod, only: derivative_t, laplace_sphere_wk, vlaplace_sphere_wk, vorticity_sphere, derivinit, divergence_sphere + use edgetype_mod, only: EdgeBuffer_t, EdgeDescriptor_t + use edge_mod, only: edgevpack, edgevunpack, edgeVunpackmin, edgeSunpackmin, & + edgeVunpackmax, initEdgeBuffer, FreeEdgeBuffer, edgeSunpackmax, edgeSpack + use bndry_mod, only: bndry_exchange, bndry_exchange_start,bndry_exchange_finish + use control_mod, only: hypervis_scaling, nu, nu_div + use thread_mod, only: vert_num_threads + + implicit none + save + + public :: biharmonic_wk + public :: biharmonic_wk_scalar + public :: biharmonic_wk_omega + public :: neighbor_minmax, neighbor_minmax_start,neighbor_minmax_finish + + ! + ! compute vorticity/divergence and then project to make continious + ! high-level routines uses only for I/O + public :: compute_zeta_C0 + public :: compute_div_C0 + + interface compute_zeta_C0 + module procedure compute_zeta_C0_hybrid ! hybrid version + module procedure compute_zeta_C0_par ! single threaded + end interface compute_zeta_C0 + interface compute_div_C0 + module procedure compute_div_C0_hybrid + module procedure compute_div_C0_par + end interface compute_div_C0 + + public :: compute_zeta_C0_contra ! for older versions of sweq which carry + public :: compute_div_C0_contra ! velocity around in contra-coordinates + + type (EdgeBuffer_t) :: edge1 + +CONTAINS + +subroutine biharmonic_wk(elem,pstens,ptens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute weak biharmonic operator +! input: h,v (stored in elem()%, in lat-lon coordinates +! output: ptens,vtens overwritten with weak biharmonic of h,v (output in lat-lon coordinates) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(inout), target :: elem(:) +integer :: nt,nets,nete,kbeg,kend +real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens +real (kind=r8), dimension(np,np,nlev,nets:nete) :: ptens +type (EdgeBuffer_t) , intent(inout) :: edge3 +type (derivative_t) , intent(in) :: deriv +real (kind=r8), dimension(np,np,nets:nete) :: pstens + +! local +integer :: k,kptr,i,j,ie,ic,kblk +real (kind=r8), dimension(:,:), pointer :: rspheremv +real (kind=r8), dimension(np,np) :: lap_ps +real (kind=r8), dimension(np,np,nlev) :: T +real (kind=r8), dimension(np,np,2) :: v +real (kind=r8) :: nu_ratio1,nu_ratio2 +logical var_coef1 + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !so tensor is only used on second call to laplace_sphere_wk + + kblk = kend - kbeg + 1 + + var_coef1 = .true. + if(hypervis_scaling > 0) var_coef1= .false. + + nu_ratio1=1 + nu_ratio2=1 + if (nu_div/=nu) then + if(hypervis_scaling /= 0) then + ! we have a problem with the tensor in that we cant seperate + ! div and curl components. So we do, with tensor V: + ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) + nu_ratio1=nu_div/nu + nu_ratio2=1 + else + nu_ratio1=sqrt(nu_div/nu) + nu_ratio2=sqrt(nu_div/nu) + endif + endif + + + do ie=nets,nete + + ! should filter lnps + PHI_s/RT? + call laplace_sphere_wk(elem(ie)%state%psdry(:,:,nt),deriv,elem(ie),pstens(:,:,ie),var_coef=var_coef1) + + do k=kbeg,kend + do j=1,np + do i=1,np + T(i,j,k)=elem(ie)%state%T(i,j,k,nt) + enddo + enddo + + call laplace_sphere_wk(T(:,:,k),deriv,elem(ie),ptens(:,:,k,ie),var_coef=var_coef1) + call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,& + elem(ie),vtens(:,:,:,k,ie),var_coef=var_coef1,nu_ratio=nu_ratio1) + + enddo + + kptr = kbeg - 1 + call edgeVpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = (kbeg - 1) + nlev + call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = (kbeg - 1) + 2*nlev + call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + kptr = (kbeg - 1) + 3*nlev + call edgeVpack(edge3,pstens(:,:,ie),1,kptr,ie) ! need logic for surface field + enddo + + call bndry_exchange(hybrid,edge3) + + do ie=nets,nete + rspheremv => elem(ie)%rspheremp(:,:) + + kptr = kbeg - 1 + call edgeVunpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = (kbeg - 1) + nlev + call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = (kbeg - 1) + 2*nlev + call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + ! apply inverse mass matrix, then apply laplace again + do k=kbeg,kend + do j=1,np + do i=1,np + T(i,j,k)=rspheremv(i,j)*ptens(i,j,k,ie) + v(i,j,1)=rspheremv(i,j)*vtens(i,j,1,k,ie) + v(i,j,2)=rspheremv(i,j)*vtens(i,j,2,k,ie) + enddo + enddo + call laplace_sphere_wk(T(:,:,k),deriv,elem(ie),ptens(:,:,k,ie),var_coef=.true.) + call vlaplace_sphere_wk(v(:,:,:),deriv,elem(ie),vtens(:,:,:,k,ie),var_coef=.true.,& + nu_ratio=nu_ratio2) + enddo + + kptr = (kbeg - 1) + 3*nlev + call edgeVunpack(edge3,pstens(:,:,ie),1,kptr,ie) ! need logic for surface field + + ! apply inverse mass matrix, then apply laplace again + lap_ps(:,:)=rspheremv(:,:)*pstens(:,:,ie) + call laplace_sphere_wk(lap_ps,deriv,elem(ie),lap_ps,var_coef=.true.) + + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end subroutine + + +subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,& + dptens2,dp3d_ref) + use derivative_mod, only : subcell_Laplace_fluxes + use dimensions_mod, only : ntrac + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! compute weak biharmonic operator + ! input: h,v (stored in elem()%, in lat-lon coordinates + ! output: ttens,vtens overwritten with weak biharmonic of h,v (output in lat-lon coordinates) + ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + integer , intent(in) :: nt,nets,nete + integer , intent(in) :: kbeg, kend + real (kind=r8), intent(out), dimension(nc,nc,4,nlev,nets:nete) :: dpflux + real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens + real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens + real (kind=r8), dimension(np,np,nlev,nets:nete), optional :: dptens2, dp3d_ref + type (EdgeBuffer_t) , intent(inout) :: edge3 + type (derivative_t) , intent(in) :: deriv + + ! local + integer :: i,j,k,kptr,ie,kblk +! real (kind=r8), dimension(:,:), pointer :: rspheremv + real (kind=r8), dimension(np,np) :: tmp + real (kind=r8), dimension(np,np) :: tmp2 + real (kind=r8), dimension(np,np,2) :: v + real (kind=r8) :: nu_ratio1, nu_ratio2 + logical var_coef1 + + kblk = kend - kbeg + 1 + + if (ntrac>0) dpflux = 0 + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !so tensor is only used on second call to laplace_sphere_wk + var_coef1 = .true. + if(hypervis_scaling > 0) var_coef1 = .false. + + nu_ratio1=1 + nu_ratio2=1 + if (nu_div/=nu) then + if(hypervis_scaling /= 0) then + ! we have a problem with the tensor in that we cant seperate + ! div and curl components. So we do, with tensor V: + ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) + nu_ratio1=nu_div/nu + nu_ratio2=1 + else + nu_ratio1=sqrt(nu_div/nu) + nu_ratio2=sqrt(nu_div/nu) + endif + endif + + do ie=nets,nete +!$omp parallel do num_threads(vert_num_threads) private(tmp) + do k=kbeg,kend + tmp=elem(ie)%state%T(:,:,k,nt) + call laplace_sphere_wk(tmp,deriv,elem(ie),ttens(:,:,k,ie),var_coef=var_coef1) + if (present(dptens2)) then + tmp=elem(ie)%state%dp3d(:,:,k,nt)-dp3d_ref(:,:,k,ie) + else + tmp=elem(ie)%state%dp3d(:,:,k,nt) + end if + call laplace_sphere_wk(tmp,deriv,elem(ie),dptens(:,:,k,ie),var_coef=var_coef1) + if (present(dptens2)) then + tmp=elem(ie)%state%dp3d(:,:,k,nt) + call laplace_sphere_wk(tmp,deriv,elem(ie),dptens2(:,:,k,ie),var_coef=var_coef1) + end if + call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),vtens(:,:,:,k,ie), & + var_coef=var_coef1,nu_ratio=nu_ratio1) + enddo + + kptr = kbeg - 1 + call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + nlev + call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 2*nlev + call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 3*nlev + call edgeVpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + if (present(dptens2)) then + kptr = kbeg - 1 + 4*nlev + call edgeVpack(edge3,dptens2(:,:,kbeg:kend,ie),kblk,kptr,ie) + end if + enddo + + call bndry_exchange(hybrid,edge3) + + do ie=nets,nete +!CLEAN rspheremv => elem(ie)%rspheremp(:,:) + + kptr = kbeg - 1 + call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + nlev + call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 2*nlev + call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) + + kptr = kbeg - 1 + 3*nlev + call edgeVunpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + if (present(dptens2)) then + kptr = kbeg - 1 + 4*nlev + call edgeVunpack(edge3,dptens2(:,:,kbeg:kend,ie),kblk,kptr,ie) + end if + + if (ntrac>0) then + do k=1,nlev +!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) + tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) + call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) + enddo + endif + + ! apply inverse mass matrix, then apply laplace again +!$omp parallel do num_threads(vert_num_threads) private(v,tmp,tmp2) + do k=kbeg,kend +!CLEAN tmp(:,:)=rspheremv(:,:)*ttens(:,:,k,ie) + tmp(:,:)=elem(ie)%rspheremp(:,:)*ttens(:,:,k,ie) + call laplace_sphere_wk(tmp,deriv,elem(ie),ttens(:,:,k,ie),var_coef=.true.) +!CLEAN tmp2(:,:)=rspheremv(:,:)*dptens(:,:,k,ie) + tmp2(:,:)=elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) + call laplace_sphere_wk(tmp2,deriv,elem(ie),dptens(:,:,k,ie),var_coef=.true.) + if (present(dptens2)) then +!CLEAN tmp2(:,:)=rspheremv(:,:)*dptens2(:,:,k,ie) + tmp2(:,:)=elem(ie)%rspheremp(:,:)*dptens2(:,:,k,ie) + call laplace_sphere_wk(tmp2,deriv,elem(ie),dptens2(:,:,k,ie),var_coef=.true.) + end if +!CLEAN v(:,:,1)=rspheremv(:,:)*vtens(:,:,1,k,ie) +!CLEAN v(:,:,2)=rspheremv(:,:)*vtens(:,:,2,k,ie) + + v(:,:,1)=elem(ie)%rspheremp(:,:)*vtens(:,:,1,k,ie) + v(:,:,2)=elem(ie)%rspheremp(:,:)*vtens(:,:,2,k,ie) + call vlaplace_sphere_wk(v(:,:,:),deriv,elem(ie),vtens(:,:,:,k,ie), & + var_coef=.true.,nu_ratio=nu_ratio2) + + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end subroutine biharmonic_wk_dp3d + + +subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend) + type (hybrid_t) , intent(in) :: hybrid + type (element_t) , intent(inout), target :: elem(:) + integer , intent(in) :: nets,nete + integer , intent(in) :: kbeg, kend + real (kind=r8), dimension(np,np,nlev,nets:nete) :: ptens + type (EdgeBuffer_t) , intent(inout) :: edge3 + type (derivative_t) , intent(in) :: deriv + + ! local + integer :: i,j,k,kptr,ie,kblk + real (kind=r8), dimension(:,:), pointer :: rspheremv + real (kind=r8), dimension(np,np) :: tmp + real (kind=r8), dimension(np,np) :: tmp2 + real (kind=r8), dimension(np,np,2) :: v + real (kind=r8) :: nu_ratio1, nu_ratio2 + logical var_coef1 + + kblk = kend - kbeg + 1 + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !so tensor is only used on second call to laplace_sphere_wk + var_coef1 = .true. + if(hypervis_scaling > 0) var_coef1 = .false. + + nu_ratio1=1 + nu_ratio2=1 + + do ie=nets,nete + +!$omp parallel do num_threads(vert_num_threads) private(tmp) + do k=kbeg,kend + tmp=elem(ie)%derived%omega(:,:,k) + call laplace_sphere_wk(tmp,deriv,elem(ie),ptens(:,:,k,ie),var_coef=var_coef1) + enddo + + kptr = kbeg - 1 + call edgeVpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + enddo + + call bndry_exchange(hybrid,edge3) + + do ie=nets,nete + rspheremv => elem(ie)%rspheremp(:,:) + + kptr = kbeg - 1 + call edgeVunpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) + + ! apply inverse mass matrix, then apply laplace again +!$omp parallel do num_threads(vert_num_threads) private(v,tmp,tmp2) + do k=kbeg,kend + tmp(:,:)=rspheremv(:,:)*ptens(:,:,k,ie) + call laplace_sphere_wk(tmp,deriv,elem(ie),ptens(:,:,k,ie),var_coef=.true.) + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end subroutine biharmonic_wk_omega + + +subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute weak biharmonic operator +! input: qtens = Q +! output: qtens = weak biharmonic of Q +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(inout), target :: elem(:) +integer :: nets,nete +real (kind=r8), dimension(np,np,nlev,qsize,nets:nete) :: qtens +type (EdgeBuffer_t) , intent(inout) :: edgeq +type (derivative_t) , intent(in) :: deriv + +! local +integer :: k,kptr,i,j,ie,ic,q +integer :: kbeg,kend,qbeg,qend +real (kind=r8), dimension(np,np) :: lap_p +logical var_coef1 +integer :: kblk,qblk ! The per thead size of the vertical and tracers + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !so tensor is only used on second call to laplace_sphere_wk + var_coef1 = .true. + if(hypervis_scaling > 0) var_coef1 = .false. + + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + do ie=nets,nete + do q=qbeg,qend + do k=kbeg,kend + lap_p(:,:)=qtens(:,:,k,q,ie) + call laplace_sphere_wk(lap_p,deriv,elem(ie),qtens(:,:,k,q,ie),var_coef=var_coef1) + enddo + kptr = nlev*(q-1) + kbeg - 1 + call edgeVpack(edgeq, qtens(:,:,kbeg:kend,q,ie),kblk,kptr,ie) + enddo + enddo + + + call bndry_exchange(hybrid,edgeq,location='biharmonic_wk_scalar') + + do ie=nets,nete + + ! apply inverse mass matrix, then apply laplace again + do q=qbeg,qend + kptr = nlev*(q-1) + kbeg - 1 + call edgeVunpack(edgeq, qtens(:,:,kbeg:kend,q,ie),kblk,kptr,ie) + do k=kbeg,kend + lap_p(:,:)=elem(ie)%rspheremp(:,:)*qtens(:,:,k,q,ie) + call laplace_sphere_wk(lap_p,deriv,elem(ie),qtens(:,:,k,q,ie),var_coef=.true.) + enddo + enddo + enddo + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end subroutine biharmonic_wk_scalar + + +subroutine make_C0(zeta,elem,hybrid,nets,nete) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! apply DSS (aka assembly procedure) to zeta. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nets,nete +real (kind=r8), dimension(np,np,nlev,nets:nete) :: zeta + +! local +integer :: k,i,j,ie,ic,kptr,nthread_save + + + call initEdgeBuffer(hybrid%par,edge1,elem,nlev) + +do ie=nets,nete +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + zeta(:,:,k,ie)=zeta(:,:,k,ie)*elem(ie)%spheremp(:,:) + enddo + kptr=0 + call edgeVpack(edge1, zeta(1,1,1,ie),nlev,kptr,ie) +enddo +call bndry_exchange(hybrid,edge1) +do ie=nets,nete + kptr=0 + call edgeVunpack(edge1, zeta(1,1,1,ie),nlev,kptr, ie) +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + zeta(:,:,k,ie)=zeta(:,:,k,ie)*elem(ie)%rspheremp(:,:) + enddo +enddo + +call FreeEdgeBuffer(edge1) + +end subroutine + + +subroutine make_C0_vector(v,elem,hybrid,nets,nete) +#if 1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! apply DSS to a velocity vector +! this is a low-performance routine used for I/O and analysis. +! no need to optimize +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nets,nete +real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: v + +! local +integer :: k,i,j,ie,ic,kptr +type (EdgeBuffer_t) :: edge2 +real (kind=r8), dimension(np,np,nlev,nets:nete) :: v1 + +v1(:,:,:,:) = v(:,:,1,:,:) +call make_C0(v1,elem,hybrid,nets,nete) +v(:,:,1,:,:) = v1(:,:,:,:) + +v1(:,:,:,:) = v(:,:,2,:,:) +call make_C0(v1,elem,hybrid,nets,nete) +v(:,:,2,:,:) = v1(:,:,:,:) +#else +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nets,nete +real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: v + +! local +integer :: k,i,j,ie,ic,kptr +type (EdgeBuffer_t) :: edge2 +real (kind=r8), dimension(np,np,nlev,nets:nete) :: v1 + + + + call initEdgeBuffer(hybrid%par,edge2,elem,2*nlev) + +do ie=nets,nete +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + v(:,:,1,k,ie)=v(:,:,1,k,ie)*elem(ie)%spheremp(:,:) + v(:,:,2,k,ie)=v(:,:,2,k,ie)*elem(ie)%spheremp(:,:) + enddo + kptr=0 + call edgeVpack(edge2, v(1,1,1,1,ie),2*nlev,kptr,ie) +enddo +call bndry_exchange(hybrid,edge2) +do ie=nets,nete + kptr=0 + call edgeVunpack(edge2, v(1,1,1,1,ie),2*nlev,kptr,ie) +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif + do k=1,nlev + v(:,:,1,k,ie)=v(:,:,1,k,ie)*elem(ie)%rspheremp(:,:) + v(:,:,2,k,ie)=v(:,:,2,k,ie)*elem(ie)%rspheremp(:,:) + enddo +enddo + +call FreeEdgeBuffer(edge2) +#endif +end subroutine + + + + + + +subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 vorticity. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in contra-variant coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nt,nets,nete +real (kind=r8), dimension(np,np,nlev,nets:nete) :: zeta +real (kind=r8), dimension(np,np,2) :: ulatlon +real (kind=r8), dimension(np,np) :: v1,v2 + +! local +integer :: k,ie +type (derivative_t) :: deriv + +call derivinit(deriv) + +do k=1,nlev +do ie=nets,nete + v1 = elem(ie)%state%v(:,:,1,k,nt) + v2 = elem(ie)%state%v(:,:,2,k,nt) + ulatlon(:,:,1) = elem(ie)%D(:,:,1,1)*v1 + elem(ie)%D(:,:,1,2)*v2 + ulatlon(:,:,2) = elem(ie)%D(:,:,2,1)*v1 + elem(ie)%D(:,:,2,2)*v2 + call vorticity_sphere(ulatlon,deriv,elem(ie),zeta(:,:,k,ie)) +enddo +enddo + +call make_C0(zeta,elem,hybrid,nets,nete) + +end subroutine + + + +subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 divergence. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in contra-variant coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nt,nets,nete +real (kind=r8), dimension(np,np,nlev,nets:nete) :: zeta +real (kind=r8), dimension(np,np,2) :: ulatlon +real (kind=r8), dimension(np,np) :: v1,v2 + +! local +integer :: k,ie +type (derivative_t) :: deriv + +call derivinit(deriv) + +do k=1,nlev +do ie=nets,nete + v1 = elem(ie)%state%v(:,:,1,k,nt) + v2 = elem(ie)%state%v(:,:,2,k,nt) + ulatlon(:,:,1) = elem(ie)%D(:,:,1,1)*v1 + elem(ie)%D(:,:,1,2)*v2 + ulatlon(:,:,2) = elem(ie)%D(:,:,2,1)*v1 + elem(ie)%D(:,:,2,2)*v2 + call divergence_sphere(ulatlon,deriv,elem(ie),zeta(:,:,k,ie)) +enddo +enddo + +call make_C0(zeta,elem,hybrid,nets,nete) + +end subroutine + +subroutine compute_zeta_C0_par(zeta,elem,par,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 vorticity. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in lat-lon coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +type (parallel_t) :: par +type (element_t) , intent(in), target :: elem(:) +real (kind=r8), dimension(np,np,nlev,nelemd) :: zeta +integer :: nt + +! local +type (hybrid_t) :: hybrid +integer :: k,i,j,ie,ic +type (derivative_t) :: deriv + +! single thread +hybrid = config_thread_region(par,'serial') + +call compute_zeta_C0_hybrid(zeta,elem,hybrid,1,nelemd,nt) + +end subroutine + + +subroutine compute_div_C0_par(zeta,elem,par,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 divergence. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in lat-lon coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (parallel_t) :: par +type (element_t) , intent(in), target :: elem(:) +real (kind=r8), dimension(np,np,nlev,nelemd) :: zeta +integer :: nt + +! local +type (hybrid_t) :: hybrid +integer :: k,i,j,ie,ic +type (derivative_t) :: deriv + +! single thread +hybrid = config_thread_region(par,'serial') + +call compute_div_C0_hybrid(zeta,elem,hybrid,1,nelemd,nt) + +end subroutine + + + +subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 vorticity. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in lat-lon coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nt,nets,nete +real (kind=r8), dimension(np,np,nlev,nets:nete) :: zeta + +! local +integer :: k,i,j,ie,ic +type (derivative_t) :: deriv + +call derivinit(deriv) + +do ie=nets,nete +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif +do k=1,nlev + call vorticity_sphere(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),zeta(:,:,k,ie)) +enddo +enddo + +call make_C0(zeta,elem,hybrid,nets,nete) + +end subroutine + + +subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute C0 divergence. That is, solve: +! < PHI, zeta > = +! +! input: v (stored in elem()%, in lat-lon coordinates) +! output: zeta(:,:,:,:) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +type (hybrid_t) , intent(in) :: hybrid +type (element_t) , intent(in), target :: elem(:) +integer :: nt,nets,nete +real (kind=r8), dimension(np,np,nlev,nets:nete) :: zeta + +! local +integer :: k,i,j,ie,ic +type (derivative_t) :: deriv + +call derivinit(deriv) + +do ie=nets,nete +#if (defined COLUMN_OPENMP) +!$omp parallel do private(k) +#endif +do k=1,nlev + call divergence_sphere(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),zeta(:,:,k,ie)) +enddo +enddo + +call make_C0(zeta,elem,hybrid,nets,nete) + +end subroutine + + + + + + + + +subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) + + type (hybrid_t) , intent(in) :: hybrid + type (EdgeBuffer_t) , intent(inout) :: edgeMinMax + integer :: nets,nete + real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) + real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) + integer :: kblk, qblk + ! local + integer:: ie, q, k, kptr + integer:: kbeg, kend, qbeg, qend + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + do ie=nets,nete + do q = qbeg, qend + kptr = nlev*(q - 1) + kbeg - 1 + call edgeSpack(edgeMinMax,min_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + kptr = qsize*nlev + nlev*(q - 1) + kbeg - 1 + call edgeSpack(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + enddo + enddo + + call bndry_exchange(hybrid,edgeMinMax) + + do ie=nets,nete + do q=qbeg,qend + kptr = nlev*(q - 1) + kbeg - 1 + call edgeSunpackMIN(edgeMinMax,min_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + kptr = qsize*nlev + nlev*(q - 1) + kbeg - 1 + call edgeSunpackMAX(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + do k=kbeg,kend + min_neigh(k,q,ie) = max(min_neigh(k,q,ie),0.0_r8) + enddo + enddo + enddo + +end subroutine neighbor_minmax + + +subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) + + type (hybrid_t) , intent(in) :: hybrid + type (EdgeBuffer_t) , intent(inout) :: edgeMinMax + integer :: nets,nete + real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) + real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) + integer :: kblk, qblk + integer :: kbeg, kend, qbeg, qend + + ! local + integer :: ie,q, k,kptr + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + do ie=nets,nete + do q=qbeg, qend + kptr = nlev*(q - 1) + kbeg - 1 + call edgeSpack(edgeMinMax,min_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + kptr = qsize*nlev + nlev*(q - 1) + kbeg - 1 + call edgeSpack(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + enddo + enddo + + call bndry_exchange_start(hybrid,edgeMinMax) + +end subroutine neighbor_minmax_start + +subroutine neighbor_minmax_finish(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) + + type (hybrid_t) , intent(in) :: hybrid + type (EdgeBuffer_t) , intent(inout) :: edgeMinMax + integer :: nets,nete + real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) + real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) + integer :: kblk, qblk + integer :: ie,q, k,kptr + integer :: kbeg, kend, qbeg, qend + + call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) + + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels + qblk = qend - qbeg + 1 ! calculate size of the block of tracers + + call bndry_exchange_finish(hybrid,edgeMinMax) + + do ie=nets,nete + do q=qbeg, qend + kptr = nlev*(q - 1) + kbeg - 1 + call edgeSunpackMIN(edgeMinMax,min_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + kptr = qsize*nlev + nlev*(q - 1) + kbeg - 1 + call edgeSunpackMAX(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) + do k=kbeg,kend + min_neigh(k,q,ie) = max(min_neigh(k,q,ie),0.0_r8) + enddo + enddo + enddo + +end subroutine neighbor_minmax_finish + +end module viscosity_mod diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 new file mode 100644 index 0000000000..6bc81ee845 --- /dev/null +++ b/src/dynamics/se/dyn_comp.F90 @@ -0,0 +1,2096 @@ +module dyn_comp + +! CAM interfaces to the SE Dynamical Core + +use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl +use physconst, only: pi +use spmd_utils, only: iam, masterproc +use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_longname, & + cnst_read_iv, qmin, cnst_type +use cam_control_mod, only: initial_run +use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim +use phys_control, only: use_gw_front, use_gw_front_igw +use dyn_grid, only: timelevel, hvcoord, edgebuf + +use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, & + cam_grid_dimensions, cam_grid_get_dim_names, & + cam_grid_get_latvals, cam_grid_get_lonvals, & + max_hcoordname_len +use cam_map_utils, only: iMap + +use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic +use dyn_tests_utils, only: vcoord=>vc_dry_pressure + +use cam_history, only: outfld, hist_fld_active, fieldname_len +use cam_history_support, only: max_fieldname_len +use time_manager, only: get_step_size + +use ncdio_atm, only: infld +use pio, only: file_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, & + pio_inq_dimid, pio_inq_dimlen, PIO_NOERR + +use infnan, only: isnan +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use shr_sys_mod, only: shr_sys_flush + +use parallel_mod, only: par +use hybrid_mod, only: hybrid_t +use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys, & + qsize +use element_mod, only: element_t, elem_state_t +use fvm_control_volume_mod, only: fvm_struct, n0_fvm +use time_mod, only: nsplit +use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer +use edgetype_mod, only: EdgeBuffer_t +use bndry_mod, only: bndry_exchange + +implicit none +private +save + +public :: & + dyn_import_t, & + dyn_export_t, & + dyn_readnl, & + dyn_register, & + dyn_init, & + dyn_run, & + dyn_final + +type dyn_import_t + type (element_t), pointer :: elem(:) => null() + type (fvm_struct), pointer :: fvm(:) => null() +end type dyn_import_t + +type dyn_export_t + type (element_t), pointer :: elem(:) => null() + type (fvm_struct), pointer :: fvm(:) => null() +end type dyn_export_t + +! Namelist +logical, public, protected :: write_restart_unstruct + +! Frontogenesis indices +integer, public :: frontgf_idx = -1 +integer, public :: frontga_idx = -1 + +interface read_dyn_var + module procedure read_dyn_field_2d + module procedure read_dyn_field_3d +end interface read_dyn_var + +real(r8), parameter :: rad2deg = 180.0_r8 / pi +real(r8), parameter :: deg2rad = pi / 180.0_r8 + +!=============================================================================== +contains +!=============================================================================== + +subroutine dyn_readnl(NLFileName) + + use namelist_utils, only: find_group_name + use namelist_mod, only: homme_set_defaults, homme_postprocess_namelist + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, masterprocid, mpicom, npes + use spmd_utils, only: mpi_real8, mpi_integer, mpi_character, mpi_logical + use dyn_grid, only: se_write_grid_file, se_grid_filename, se_write_gll_corners + use dp_mapping, only: nphys_pts + use native_mapping, only: native_mapping_readnl + + use control_mod, only: TRACERTRANSPORT_SE_GLL, tracer_transport_type + use control_mod, only: TRACERTRANSPORT_CONSISTENT_SE_FVM + use control_mod, only: hypervis_subcycle + use control_mod, only: hypervis_subcycle_q, statefreq, runtype + use control_mod, only: nu, nu_div, nu_p, nu_q, nu_top, qsplit, rsplit + use control_mod, only: vert_remap_q_alg, tstep_type, rk_stage_user + use control_mod, only: ftype, limiter_option, partmethod + use control_mod, only: topology, tasknum + use control_mod, only: remap_type + use control_mod, only: fine_ne, hypervis_power, hypervis_scaling + use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh + use control_mod, only: se_met_nudge_u, se_met_nudge_p, se_met_nudge_t, se_met_tevolve + use dimensions_mod, only: qsize_d, ne, npart + use dimensions_mod, only: qsize_condensate_loading, lcp_moist + use dimensions_mod, only: hypervis_on_plevs + use params_mod, only: SFCURVE + use parallel_mod, only: initmpi + use thread_mod, only: initomp, max_num_threads + use thread_mod, only: horz_num_threads, vert_num_threads, tracer_num_threads + + ! Dummy argument + character(len=*), intent(in) :: NLFileName + + ! Local variables + integer :: unitn, ierr + real(r8) :: uniform_res_hypervis_scaling + + + ! SE Namelist variables + integer :: se_qsize_condensate_loading + integer :: se_fine_ne + integer :: se_ftype + integer :: se_statediag_numtrac + integer :: se_fv_nphys + real(r8) :: se_hypervis_power + real(r8) :: se_hypervis_scaling + integer :: se_hypervis_subcycle + integer :: se_hypervis_subcycle_q + integer :: se_limiter_option + real(r8) :: se_max_hypervis_courant + character(len=SHR_KIND_CL) :: se_mesh_file + integer :: se_ne + integer :: se_npes + integer :: se_nsplit + real(r8) :: se_nu + real(r8) :: se_nu_div + real(r8) :: se_nu_p + real(r8) :: se_nu_top + integer :: se_qsplit + logical :: se_refined_mesh + integer :: se_rsplit + integer :: se_statefreq + integer :: se_tstep_type + integer :: se_vert_remap_q_alg + integer :: se_horz_num_threads + integer :: se_vert_num_threads + integer :: se_tracer_num_threads + logical :: se_hypervis_on_plevs + logical :: se_write_restart_unstruct + + namelist /dyn_se_inparm/ & + se_qsize_condensate_loading, & + se_fine_ne, & ! For refined meshes + se_ftype, & ! forcing type + se_statediag_numtrac, & + se_fv_nphys, & + se_hypervis_power, & + se_hypervis_scaling, & + se_hypervis_subcycle, & + se_hypervis_subcycle_q, & + se_limiter_option, & + se_max_hypervis_courant, & + se_mesh_file, & ! Refined mesh definition file + se_ne, & + se_npes, & + se_nsplit, & ! # of dyn steps per physics timestep + se_nu, & + se_nu_div, & + se_nu_p, & + se_nu_top, & + se_qsplit, & + se_refined_mesh, & + se_rsplit, & + se_statefreq, & ! number of steps per printstate call + se_tstep_type, & + se_vert_remap_q_alg, & + se_met_nudge_u, & + se_met_nudge_p, & + se_met_nudge_t, & + se_met_tevolve, & + se_write_grid_file, & + se_grid_filename, & + se_write_gll_corners, & + se_horz_num_threads, & + se_vert_num_threads, & + se_tracer_num_threads, & + se_hypervis_on_plevs, & + se_write_restart_unstruct + !-------------------------------------------------------------------------- + + ! defaults for variables not set by build-namelist + se_fine_ne = -1 + se_hypervis_power = 0 + se_hypervis_scaling = 0 + se_max_hypervis_courant = 1.0e99_r8 + se_mesh_file = '' + se_npes = npes + se_write_restart_unstruct = .false. + + ! Read the namelist (dyn_se_inparm) + call MPI_barrier(mpicom, ierr) + if (masterproc) then + write(iulog, *) "dyn_readnl: reading dyn_se_inparm namelist..." + unitn = getunit() + open( unitn, file=trim(NLFileName), status='old' ) + call find_group_name(unitn, 'dyn_se_inparm', status=ierr) + if (ierr == 0) then + read(unitn, dyn_se_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun('dyn_readnl: ERROR reading dyn_se_inparm namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist values to all PEs + call MPI_bcast(se_qsize_condensate_loading, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_fine_ne, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_ftype, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_statediag_numtrac, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_hypervis_power, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_hypervis_scaling, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_hypervis_subcycle, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_hypervis_subcycle_q, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_limiter_option, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_max_hypervis_courant, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_mesh_file, SHR_KIND_CL, mpi_character, masterprocid, mpicom, ierr) + call MPI_bcast(se_ne, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_npes, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_nsplit, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_nu, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_nu_div, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_nu_p, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_nu_top, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_qsplit, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_refined_mesh, 1, mpi_logical, masterprocid, mpicom, ierr) + call MPI_bcast(se_rsplit, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_statefreq, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_tstep_type, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_vert_remap_q_alg, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_met_nudge_u, 1, MPI_real8, masterprocid, mpicom,ierr) + call MPI_bcast(se_met_nudge_p, 1, MPI_real8, masterprocid, mpicom,ierr) + call MPI_bcast(se_met_nudge_t, 1, MPI_real8, masterprocid, mpicom,ierr) + call MPI_bcast(se_met_tevolve, 1, MPI_integer, masterprocid, mpicom,ierr) + call MPI_bcast(se_fv_nphys, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_write_grid_file, 16, mpi_character, masterprocid, mpicom, ierr) + call MPI_bcast(se_grid_filename, shr_kind_cl, mpi_character, masterprocid, mpicom, ierr) + call MPI_bcast(se_write_gll_corners, 1, mpi_logical, masterprocid, mpicom, ierr) + call MPI_bcast(se_horz_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) + call MPI_bcast(se_vert_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) + call MPI_bcast(se_tracer_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) + call MPI_bcast(se_hypervis_on_plevs, 1, mpi_logical, masterprocid, mpicom, ierr) + call MPI_bcast(se_write_restart_unstruct, 1, mpi_logical, masterprocid, mpicom, ierr) + + if (se_npes <= 0) then + call endrun('dyn_readnl: ERROR: se_npes must be > 0') + end if + + ! Initialize the SE structure that holds the MPI decomposition information + par = initmpi(se_npes) + call initomp() + ! + ! automatically set viscosity coefficients + ! + uniform_res_hypervis_scaling = 3.0_r8 + if (se_nu_div < 0) then + if (se_ne <= 0) then + call endrun('dyn_readnl: ERROR must have se_ne > 0 for se_nu_div < 0') + end if + se_nu_div = 0.751_r8*((30.0_r8/se_ne)*110000.0_r8)**uniform_res_hypervis_scaling + end if + if (se_nu_p < 0) then + if (se_ne <= 0) then + call endrun('dyn_readnl: ERROR must have se_ne > 0 for se_nu_p < 0') + end if + se_nu_p = 0.751_r8*((30.0_r8/se_ne)*110000.0_r8)**uniform_res_hypervis_scaling + end if + if (se_nu < 0) then + if (se_ne <= 0) then + call endrun('dyn_readnl: ERROR must have se_ne > 0 for se_nu < 0') + end if + se_nu = 0.15_r8*((30.0_r8/se_ne)*110000.0_r8)**uniform_res_hypervis_scaling + end if + ! Go ahead and enforce ne = 0 for refined mesh runs + if (se_refined_mesh) then + se_ne = 0 + end if + + ! Set HOMME defaults + call homme_set_defaults() + ! Set HOMME variables not in CAM's namelist but with different CAM defaults + partmethod = SFCURVE + npart = se_npes + ! CAM requires forward-in-time, subcycled dynamics + ! RK2 3 stage tracers, sign-preserving conservative + rk_stage_user = 3 + topology = "cube" + ! Finally, set the HOMME variables which have different names + qsize_condensate_loading = se_qsize_condensate_loading + lcp_moist = .true. + fine_ne = se_fine_ne + ftype = se_ftype + statediag_numtrac = MIN(se_statediag_numtrac,pcnst) + hypervis_power = se_hypervis_power + hypervis_scaling = se_hypervis_scaling + hypervis_subcycle = se_hypervis_subcycle + hypervis_subcycle_q = se_hypervis_subcycle_q + limiter_option = se_limiter_option + max_hypervis_courant = se_max_hypervis_courant + refined_mesh = se_refined_mesh + ne = se_ne + nsplit = se_nsplit + nu = se_nu + nu_div = se_nu_div + nu_p = se_nu_p + nu_q = se_nu_p !for tracer-wind consistency nu_q must me equal to nu_p + nu_top = se_nu_top + qsplit = se_qsplit + rsplit = se_rsplit + statefreq = se_statefreq + tstep_type = se_tstep_type + vert_remap_q_alg = se_vert_remap_q_alg + fv_nphys = se_fv_nphys + hypervis_on_plevs = se_hypervis_on_plevs + + if (fv_nphys > 0) then + ! Use finite volume physics grid and CSLAM for tracer advection + nphys_pts = fv_nphys*fv_nphys + tracer_transport_type = TRACERTRANSPORT_CONSISTENT_SE_FVM + qsize = qsize_condensate_loading ! number tracers advected by GLL + ntrac = pcnst ! number tracers advected by CSLAM + else + ! Use GLL grid for physics and tracer advection + nphys_pts = npsq + tracer_transport_type = TRACERTRANSPORT_SE_GLL + qsize = pcnst + ntrac = 0 + end if + + if (rsplit < 1) then + call endrun('dyn_readnl: rsplit must be > 0') + end if + + ! if restart or branch run + if (.not. initial_run) then + runtype = 1 + end if + + ! HOMME wants 'none' to indicate no mesh file + if (len_trim(se_mesh_file) == 0) then + se_mesh_file = 'none' + if (se_refined_mesh) then + call endrun('dyn_readnl ERROR: se_refined_mesh=.true. but no se_mesh_file') + end if + end if + call homme_postprocess_namelist(se_mesh_file, par) + + ! Set threading numbers to reasonable values + if ((se_horz_num_threads == 0) .and. (se_vert_num_threads == 0) .and. (se_tracer_num_threads == 0)) then + ! The user has not set any threading values, choose defaults + se_horz_num_threads = max_num_threads + se_vert_num_threads = 1 + se_tracer_num_threads = se_vert_num_threads + end if + if (se_horz_num_threads < 1) then + se_horz_num_threads = 1 + end if + if (se_vert_num_threads < 1) then + se_vert_num_threads = 1 + end if + if (se_tracer_num_threads < 1) then + se_tracer_num_threads = 1 + end if + horz_num_threads = se_horz_num_threads + vert_num_threads = se_vert_num_threads + tracer_num_threads = se_tracer_num_threads + + write_restart_unstruct = se_write_restart_unstruct + + if (masterproc) then + write(iulog, '(a,i0)') 'dyn_readnl: se_ftype = ',ftype + write(iulog, '(a,i0)') 'dyn_readnl: se_statediag_numtrac = ',statediag_numtrac + write(iulog, '(a,i0)') 'dyn_readnl: se_hypervis_subcycle = ',se_hypervis_subcycle + write(iulog, '(a,i0)') 'dyn_readnl: se_hypervis_subcycle_q = ',se_hypervis_subcycle_q + write(iulog, '(a,i0)') 'dyn_readnl: se_limiter_option = ',se_limiter_option + if (.not. se_refined_mesh) then + write(iulog, '(a,i0)') 'dyn_readnl: se_ne = ',se_ne + end if + write(iulog, '(a,i0)') 'dyn_readnl: se_npes = ',se_npes + write(iulog, '(a,i0)') 'dyn_readnl: se_nsplit = ',se_nsplit + write(iulog, '(a,e9.2)') 'dyn_readnl: se_nu = ',se_nu + write(iulog, '(a,e9.2)') 'dyn_readnl: se_nu_div = ',se_nu_div + write(iulog, '(a,e9.2)') 'dyn_readnl: se_nu_p = ',se_nu_p + write(iulog, '(a)') 'Note that nu_q=nu_p for mass / tracer inconsistency' + write(iulog, '(a,e9.2)') 'dyn_readnl: se_nu_top = ',se_nu_top + write(iulog, '(a,i0)') 'dyn_readnl: se_qsplit = ',se_qsplit + write(iulog, '(a,i0)') 'dyn_readnl: se_rsplit = ',se_rsplit + write(iulog, '(a,i0)') 'dyn_readnl: se_statefreq = ',se_statefreq + write(iulog, '(a,i0)') 'dyn_readnl: se_tstep_type = ',se_tstep_type + write(iulog, '(a,i0)') 'dyn_readnl: se_vert_remap_q_alg = ',se_vert_remap_q_alg + write(iulog, '(a,i0)') 'dyn_readnl: se_qsize_condensate_loading = ',se_qsize_condensate_loading + write(iulog, '(a,l4)') ' : lcp_moist = ',lcp_moist + write(iulog, '(a,l4)') ' dyn_readnl: hypervis_on_plevs = ',hypervis_on_plevs + if (hypervis_on_plevs.and.nu_p>0) then + write(iulog, *) 'FYI: nu_p>0 and hypervis_on_plevs=T => hypervis is applied to dp-dp_ref' + else if (hypervis_on_plevs.and.nu_p==0) then + write(iulog, *) 'FYI: hypervis_on_plevs=T and nu_p=0' + end if + if (se_refined_mesh) then + write(iulog, '(a)') 'dyn_readnl: Refined mesh simulation' + write(iulog, '(a)') 'dyn_readnl: se_mesh_file = ',trim(se_mesh_file) + if (abs(se_hypervis_power) < 1.0e-12_r8) then + write(iulog, '(a,e11.4)') 'dyn_readnl: se_hypervis_power = ',se_hypervis_power, ', (tensor hyperviscosity)' + write(iulog, '(a,e11.4)') 'dyn_readnl: se_hypervis_scaling = ',se_hypervis_scaling + else if (abs(se_hypervis_power - 3.322_r8) < 1.0e-12_r8) then + write(iulog, '(a,e11.4)') 'dyn_readnl: se_hypervis_power = ',se_hypervis_power, ', (scalar hyperviscosity)' + write(iulog, '(a,i0)') 'dyn_readnl: se_fine_ne = ',se_fine_ne + else + write(iulog, '(a,i0)') 'dyn_readnl: se_hypervis_power = ',se_hypervis_power + write(iulog, '(a,e11.4)') 'dyn_readnl: se_hypervis_scaling = ',se_hypervis_scaling + write(iulog, '(a,e11.4)') 'dyn_readnl: se_fine_ne = ',se_fine_ne + end if + write(iulog, '(a,e11.4)') 'dyn_readnl: se_max_hypervis_courant = ',se_max_hypervis_courant + end if + if ((se_met_nudge_u /= 0._r8) .or. (se_met_nudge_p /= 0._r8) .or. & + (se_met_nudge_t /= 0._r8) .or. (se_met_tevolve /= 0)) then + write(iulog, '(a)') 'dyn_readnl: Nudging:' + write(iulog,'(a,e14.6)') " : se_met_nudge_u = ", se_met_nudge_u + write(iulog,'(a,e14.6)') " : se_met_nudge_p = ", se_met_nudge_p + write(iulog,'(a,e14.6)') " : se_met_nudge_t = ", se_met_nudge_t + write(iulog,'(a,i0)') " : se_met_tevolve = ", se_met_tevolve + else + write(iulog, '(a)') 'dyn_readnl: Nudging off' + end if + + if (fv_nphys > 0) then + write(iulog, '(a)') 'dyn_readnl: physics will run on FVM points; advection by CSLAM' + write(iulog,'(a,i0)') 'dyn_readnl: se_fv_nphys = ', fv_nphys + else + write(iulog, '(a)') 'dyn_readnl: physics will run on SE GLL points' + end if + write(iulog, '(a,i0)') 'dyn_readnl: se_horz_num_threads = ',horz_num_threads + write(iulog, '(a,i0)') 'dyn_readnl: se_vert_num_threads = ',vert_num_threads + write(iulog, '(a,i0)') 'dyn_readnl: se_tracer_num_threads = ',tracer_num_threads + if (trim(se_write_grid_file) == 'SCRIP') then + write(iulog,'(2a)') "dyn_readnl: write SCRIP grid file = ", trim(se_grid_filename) + else + write(iulog,'(a)') "dyn_readnl: do not write grid file" + end if + write(iulog,'(a,l1)') 'dyn_readnl: write gll corners to SEMapping.nc = ', & + se_write_gll_corners + write(iulog,'(a,l1)') 'dyn_readnl: write restart data on unstructured grid = ', & + se_write_restart_unstruct + end if + + call native_mapping_readnl(NLFileName) + +end subroutine dyn_readnl + +!========================================================================================= + +subroutine dyn_register() + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use ppgrid, only: pcols, pver + + ! These fields are computed by the dycore and passed to the physics via the + ! physics buffer. + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_add_field("FRONTGF", "global", dtype_r8, (/pcols,pver/), & + frontgf_idx) + call pbuf_add_field("FRONTGA", "global", dtype_r8, (/pcols,pver/), & + frontga_idx) + end if + +end subroutine dyn_register + +!========================================================================================= + +subroutine dyn_init(dyn_in, dyn_out) + + use dyn_grid, only: elem, fvm + use cam_pio_utils, only: clean_iodesc_list + use physconst, only: cpwv, cpliq, cpice + use cam_history, only: addfld, add_default, horiz_only, register_vector_field + use gravity_waves_sources, only: gws_init + + use thread_mod, only: horz_num_threads + use hybrid_mod, only: get_loop_ranges, config_thread_region + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx + use dimensions_mod, only: qsize_condensate_loading_idx_gll + use dimensions_mod, only: qsize_condensate_loading_cp + use dimensions_mod, only: cnst_name_gll, cnst_longname_gll + use prim_driver_mod, only: prim_init2 + use time_mod, only: time_at + use control_mod, only: runtype + use test_fvm_mapping, only: test_mapping_addfld + + ! Dummy arguments: + type(dyn_import_t), intent(out) :: dyn_in + type(dyn_export_t), intent(out) :: dyn_out + + ! Local variables + integer :: ithr, nets, nete, ie, k + real(r8), parameter :: Tinit = 300.0_r8 + type(hybrid_t) :: hybrid + + integer :: ixcldice, ixcldliq, ixrain, ixsnow, ixgraupel + integer :: m_cnst, m + + ! variables for initializing energy and axial angular momentum diagnostics + character (len = 3), dimension(9) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH"/) + character (len = 70),dimension(9) :: stage_txt = (/& + " end of previous dynamics ",& !dED + " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop + " state after applying CAM forcing ",& !dBD - state after applyCAMforcing + " before vertical remapping ",& !dAD - state before vertical remapping + " after vertical remapping ",& !dAR - state at end of nsplit loop + " state passed to parameterizations ",& !dBF + " state before hypervis ",& !dBH + " state after hypervis but before adding heating term",& !dCH + " state after hypervis " & !dAH + /) + character (len = 2) , dimension(8) :: vars = (/"WV","WL","WI","SE","KE","MR","MO","TT"/) + character (len = 70), dimension(8) :: vars_descriptor = (/& + "Total column water vapor ",& + "Total column cloud water ",& + "Total column cloud ice ",& + "Total column dry static energy ",& + "Total column kinetic energy ",& + "Total column wind axial angular momentum",& + "Total column mass axial angular momentum",& + "Total column test tracer "/) + character (len = 14), dimension(8) :: & + vars_unit = (/& + "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& + "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) + + integer :: istage, ivars + character (len=108) :: str1, str2, str3 + + character(len=*), parameter :: subname = 'dyn_init' + !---------------------------------------------------------------------------- + + if (qsize_condensate_loading > 6) then + call endrun(subname//': se_qsize_condensate_loading not setup for more than 6 forms of water') + end if + + ! Now allocate and set condenstate vars + allocate(qsize_condensate_loading_idx(qsize_condensate_loading)) + allocate(qsize_condensate_loading_idx_gll(qsize_condensate_loading)) + allocate(qsize_condensate_loading_cp(qsize_condensate_loading)) + + allocate(cnst_name_gll(qsize)) ! constituent names for gll tracers + allocate(cnst_longname_gll(qsize)) ! long name of constituents for gll tracers + + ! water vapor is always tracer 1 + qsize_condensate_loading_idx(1) = 1 + qsize_condensate_loading_cp(1) = cpwv + if (qsize_condensate_loading > 1) then + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + if (ixcldliq < 1) & + call endrun(subname//': ERROR: qsize_condensate_loading >1 but CLDLIQ not available') + qsize_condensate_loading_idx(2) = ixcldliq + qsize_condensate_loading_cp(2) = cpliq + end if + if (qsize_condensate_loading > 2) then + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + if (ixcldice < 1) & + call endrun(subname//': ERROR: qsize_condensate_loading >2 but CLDICE not available') + qsize_condensate_loading_idx(3) = ixcldice + qsize_condensate_loading_cp(3) = cpice + end if + if (qsize_condensate_loading > 3) then + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + if (ixrain < 1) & + call endrun(subname//': ERROR: qsize_condensate_loading >3 but RAINQM not available') + qsize_condensate_loading_idx(4) = ixrain + qsize_condensate_loading_cp(4) = cpliq + end if + if (qsize_condensate_loading > 4) then + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + if (ixsnow < 1) & + call endrun(subname//': ERROR: qsize_condensate_loading >4 but SNOWQM not available') + qsize_condensate_loading_idx(5) = ixsnow + qsize_condensate_loading_cp(5) = cpice + end if + if (qsize_condensate_loading > 5) then + call cnst_get_ind('GRAUQM', ixgraupel, abort=.false.) + if (ixgraupel < 1) & + call endrun(subname//': ERROR: qsize_condensate_loading >5 but GRAUQM not available') + qsize_condensate_loading_idx(6) = ixgraupel + qsize_condensate_loading_cp(6) = cpice + end if + ! + ! if adding more condensate loading tracers remember to increase qsize_d in dimensions_mod + ! + qsize_condensate_loading_idx_gll(:) = -1 + do m=1,qsize + ! + ! The "_gll" index variables below are used to keep track of condensate-loading tracers + ! since they are not necessarily indexed contiguously and not necessarily in the same + ! order (physics is in charge of the order) + ! + ! if running with CSLAM then the SE (gll) condensate-loading water tracers are always + ! indexed contiguously (q,cldliq,cldice,rain,snow,graupel) - see above + ! + ! CSLAM tracers are always indexed as in physics + ! of no CSLAM then SE tracers are always indexed as in physics + ! + if (ntrac>0) then + ! + ! note that in this case qsize = qsize_condensate_loading + ! + qsize_condensate_loading_idx_gll(m) = m + cnst_name_gll (m) = cnst_name (qsize_condensate_loading_idx(m)) + cnst_longname_gll(m) = cnst_longname(qsize_condensate_loading_idx(m)) + else + ! + ! if not running with CSLAM then the condensate-loading water tracers are not necessarily + ! indexed contiguously (are indexed as in physics) + ! + if (m.le.qsize_condensate_loading) qsize_condensate_loading_idx_gll(m) = qsize_condensate_loading_idx(m) + cnst_name_gll (m) = cnst_name (m) + cnst_longname_gll(m) = cnst_longname(m) + end if + + end do + + ! if user wants to add more condensate loading tracers add them here .... + + ! + ! Initialize the import/export objects + ! + if(iam < par%nprocs) then + dyn_in%elem => elem + dyn_in%fvm => fvm + + dyn_out%elem => elem + dyn_out%fvm => fvm + else + nullify(dyn_in%elem) + nullify(dyn_in%fvm) + nullify(dyn_out%elem) + nullify(dyn_out%fvm) + end if + + call read_phis(dyn_in) + + if (initial_run) then + call read_inidat(dyn_in) + call clean_iodesc_list() + end if + + if (iam < par%nprocs) then + +!$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,ie) + hybrid = config_thread_region(par,'horizontal') + call get_loop_ranges(hybrid, ibeg=nets, iend=nete) + call prim_init2(elem, fvm, hybrid, nets, nete, TimeLevel, hvcoord) +!$OMP END PARALLEL + + if (use_gw_front .or. use_gw_front_igw) call gws_init(elem) + + end if ! iam < par%nprocs + + ! Forcing from physics on the GLL grid + call addfld ('FU', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind forcing term on GLL grid', gridname='GLL') + call addfld ('FV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind forcing term on GLL grid',gridname='GLL') + call register_vector_field('FU', 'FV') + call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on GLL grid',gridname='GLL') + + ! Tracer forcing on fvm (CSLAM) grid and internal CSLAM pressure fields + if (ntrac>0) then + do m = 1, ntrac + call addfld (trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname(m)), gridname='FVM') + + call addfld ('F'//trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg/s', & + trim(cnst_longname(m))//' mixing ratio forcing term (q_new-q_old) on fvm grid', & + gridname='FVM') + end do + + call addfld ('dp_fvm' ,(/ 'lev' /), 'I', 'Pa','CSLAM Pressure level thickness', gridname='FVM') + call addfld ('PSDRY_fvm',horiz_only, 'I','Pa','CSLAM dry surface pressure' , gridname='FVM') + end if + + do m_cnst = 1, qsize + call addfld ('F'//trim(cnst_name_gll(m_cnst))//'_gll', (/ 'lev' /), 'I', 'kg/kg/s', & + trim(cnst_longname(m_cnst))//' mixing ratio forcing term (q_new-q_old) on GLL grid', gridname='GLL') + end do + + ! Energy diagnostics and axial angular momentum diagnostics + call addfld ('ABS_dPSdt', horiz_only, 'A', 'Pa/s', 'Absolute surface pressure tendency',gridname='GLL') + + call addfld ('WV_PDC', horiz_only, 'A', 'kg/m2','Total column water vapor lost in physics-dynamics coupling',gridname='GLL') + call addfld ('WL_PDC', horiz_only, 'A', 'kg/m2','Total column cloud water lost in physics-dynamics coupling',gridname='GLL') + call addfld ('WI_PDC', horiz_only, 'A', 'kg/m2','Total column cloud ice lost in physics-dynamics coupling' ,gridname='GLL') + call addfld ('TT_PDC', horiz_only, 'A', 'kg/m2','Total column test tracer lost in physics-dynamics coupling' ,gridname='GLL') + + do istage = 1,SIZE(stage) + do ivars=1,SIZE(vars) + write(str1,*) TRIM(ADJUSTL(vars(ivars))),TRIM(ADJUSTL("_")),TRIM(ADJUSTL(stage(istage))) + write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars))),& + TRIM(ADJUSTL(" ")),TRIM(ADJUSTL(stage_txt(istage))) + write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + end do + end do + + call test_mapping_addfld + +end subroutine dyn_init + +!========================================================================================= + +subroutine dyn_run(dyn_state) + + use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_driver_mod, only: prim_run_subcycle + use dimensions_mod, only: qsize_condensate_loading, qsize_condensate_loading_idx_gll + use dimensions_mod, only: cnst_name_gll + use time_mod, only: tstep, nsplit, timelevel_qdp + use hybrid_mod, only: config_thread_region, get_loop_ranges + use control_mod, only: qsplit ,rsplit + use thread_mod, only: horz_num_threads + use time_mod, only: tevolve + + type(dyn_export_t), intent(inout) :: dyn_state + + type(hybrid_t) :: hybrid + integer :: tl_f + integer :: n + integer :: nets, nete, ithr + integer :: i, ie, j, k, m + integer :: n0_qdp + logical :: ldiag + + real(r8) :: ftmp(npsq,nlev,3) + real(r8) :: dtime + real(r8) :: rec2dt + + real(r8), allocatable, dimension(:,:,:) :: ps_before + real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend + !---------------------------------------------------------------------------- + +#ifdef debug_coupling + return +#endif + + tevolve = 0._r8 + + if (iam >= par%nprocs) return + + !$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n,ie,m,i,j,k) + hybrid = config_thread_region(par,'horizontal') + call get_loop_ranges(hybrid, ibeg=nets, iend=nete) + + dtime = get_step_size() + rec2dt = 1._r8/dtime + + tl_f = TimeLevel%n0 ! timelevel which was adjusted by physics + + ! output physics forcing + if (hist_fld_active('FU') .or. hist_fld_active('FV') .or.hist_fld_active('FT')) then + do ie = nets, nete + do k = 1, nlev + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,k,1) = dyn_state%elem(ie)%derived%FM(i,j,1,k) + ftmp(i+(j-1)*np,k,2) = dyn_state%elem(ie)%derived%FM(i,j,2,k) + ftmp(i+(j-1)*np,k,3) = dyn_state%elem(ie)%derived%FT(i,j,k) + end do + end do + end do + + call outfld('FU', ftmp(:,:,1), npsq, ie) + call outfld('FV', ftmp(:,:,2), npsq, ie) + call outfld('FT', ftmp(:,:,3), npsq, ie) + end do + end if + + do m = 1, qsize + if (hist_fld_active('F'//trim(cnst_name_gll(m))//'_gll')) then + do ie = nets, nete + call outfld('F'//trim(cnst_name_gll(m))//'_gll',& + RESHAPE(dyn_state%elem(ie)%derived%FQ(:,:,:,m), (/np*np,nlev/)), npsq, ie) + end do + end if + end do + + ! convert elem(ie)%derived%fq to tendency + do ie = nets, nete + do m = 1, qsize + do k = 1, nlev + do j = 1, np + do i = 1, np + dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & + rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) + end do + end do + end do + end do + end do + + if (ntrac > 0) then + do ie = nets, nete + do m = 1, ntrac + do k = 1, nlev + do j = 1, nc + do i = 1, nc + dyn_state%fvm(ie)%fc(i,j,k,m) = dyn_state%fvm(ie)%fc(i,j,k,m)* & + rec2dt*dyn_state%fvm(ie)%dp_fvm(i,j,k,n0_fvm) + end do + end do + end do + end do + end do + end if + + ldiag = hist_fld_active('ABS_dPSdt') + if (ldiag) then + allocate(ps_before(np,np,nets:nete)) + allocate(abs_ps_tend(np,np,nets:nete)) + abs_ps_tend(:,:,nets:nete) = 0.0_r8 + end if + + do n = 1, nsplit + + if (ldiag) then + do ie = nets, nete + ps_before(:,:,ie) = dyn_state%elem(ie)%state%psdry(:,:,tl_f) + end do + end if + + ! forward-in-time RK, with subcycling + call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets, nete, & + tstep, TimeLevel, hvcoord, n) + + if (ldiag) then + do ie = nets, nete + abs_ps_tend(:,:,ie) = abs_ps_tend(:,:,ie) + & + ABS(ps_before(:,:,ie)-dyn_state%elem(ie)%state%psdry(:,:,tl_f)) & + /(tstep*qsplit*rsplit) + end do + end if + + end do + + if (ldiag) then + do ie=nets,nete + abs_ps_tend(:,:,ie)=abs_ps_tend(:,:,ie)/DBLE(nsplit) + call outfld('ABS_dPSdt',RESHAPE(abs_ps_tend(:,:,ie),(/npsq/)),npsq,ie) + end do + deallocate(ps_before,abs_ps_tend) + end if + + call TimeLevel_Qdp(TimeLevel, qsplit, n0_qdp)!get n0_qdp for diagnostics call + call calc_tot_energy_dynamics(dyn_state%elem, nets, nete, tl_f, n0_qdp, 'dBF') + !$OMP END PARALLEL + + ! output vars on CSLAM fvm grid + call write_dyn_vars(dyn_state) + +end subroutine dyn_run + +!=============================================================================== + +subroutine dyn_final(DYN_STATE, RESTART_FILE) + + type (elem_state_t), target :: DYN_STATE + character(LEN=*) , intent(IN) :: RESTART_FILE + +end subroutine dyn_final + +!=============================================================================== + +subroutine read_inidat(dyn_in) + + use shr_sys_mod, only: shr_sys_flush + use hycoef, only: hyai, hybi, ps0 + use const_init, only: cnst_init_default + use cam_control_mod, only: ideal_phys + + use element_mod, only: timelevels + use dimensions_mod, only: qsize_d, qsize_condensate_loading + use dimensions_mod, only: qsize_condensate_loading_idx + use fvm_mapping, only: dyn2fvm_mass_vars + use control_mod, only: runtype,initial_global_ave_dry_ps + use prim_driver_mod, only: prim_set_dry_mass + + ! Arguments + type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import + + ! Local variables + + integer(iMap), pointer :: ldof(:) ! Basic (2D) grid dof + + type(file_desc_t), pointer :: fh_ini, fh_topo + + type(element_t), pointer :: elem(:) + + real(r8), allocatable :: qtmp(:,:,:,:,:) ! (np,np,nlev,nelemd,n) + real(r8), allocatable :: dbuf2(:,:) ! (npsq,nelemd) + real(r8), allocatable :: dbuf3(:,:,:) ! (npsq,nlev,nelemd) + real(r8), allocatable :: factor_array(:,:,:,:) ! (np,np,nlev,nelemd) + logical, allocatable :: pmask(:) ! (npsq*nelemd) unique grid vals + logical, allocatable :: pmask_phys(:) + + character(len=max_hcoordname_len):: grid_name + real(r8), allocatable :: latvals(:),latvals_phys(:) + real(r8), allocatable :: lonvals(:),lonvals_phys(:) + real(r8), pointer :: latvals_deg(:) + real(r8), pointer :: lonvals_deg(:) + + integer :: ie, k, t + character(len=max_fieldname_len) :: fieldname, fieldname2 + logical :: found + logical :: inic_wet ! true if initial condition is based on + ! wet pressure and water species + integer :: kptr, m_cnst + type(EdgeBuffer_t) :: edge + integer :: lsize + + character(len=max_fieldname_len) :: dimname, varname + integer :: ierr + integer :: ncol_did + integer :: ncol_size + + integer :: rndm_seed_sz + integer, allocatable :: rndm_seed(:) + integer :: dims(2) + integer :: pio_errtype + real(r8) :: pertval + integer :: i, j, indx, nq + integer :: dyn_cols + character(len=128) :: errmsg + character(len=*), parameter :: subname='READ_INIDAT' + + integer :: ioff + + + ! fvm vars + real(r8), allocatable :: inv_dp_darea_fvm(:,:,:) + real(r8) :: min_val, max_val + + real(r8) :: dp_tmp, pstmp(np,np) + + ! Variables for analytic initial conditions + integer, allocatable :: glob_ind(:) + integer, allocatable :: m_ind(:) + real(r8), allocatable :: dbuf4(:,:,:,:) + !---------------------------------------------------------------------------- + + fh_ini => initial_file_get_id() + fh_topo => topo_file_get_id() + + if (iam < par%nprocs) then + elem => dyn_in%elem + else + nullify(elem) + end if + + allocate(qtmp(np,np,nlev,nelemd,pcnst)) + + ! Set mask to indicate which columns are active + nullify(ldof) + call cam_grid_get_gcid(cam_grid_id('GLL'), ldof) + allocate(pmask(npsq*nelemd)) + pmask(:) = (ldof /= 0) + + ! lat/lon needed in radians + latvals_deg => cam_grid_get_latvals(cam_grid_id('GLL')) + lonvals_deg => cam_grid_get_lonvals(cam_grid_id('GLL')) + allocate(latvals(np*np*nelemd)) + allocate(lonvals(np*np*nelemd)) + latvals(:) = latvals_deg(:)*deg2rad + lonvals(:) = lonvals_deg(:)*deg2rad + + ! Set ICs. Either from analytic expressions or read from file. + + if (analytic_ic_active() .and. (iam < par%nprocs)) then + + inic_wet = .false. + allocate(glob_ind(npsq * nelemd)) + j = 1 + do ie = 1, nelemd + do i = 1, npsq + ! Create a global(ish) column index + glob_ind(j) = elem(ie)%GlobalId + j = j + 1 + end do + end do + + ! First, initialize all the variables, then assign + allocate(dbuf4(npsq, nlev, nelemd, (qsize + 4))) + dbuf4 = 0.0_r8 + allocate(m_ind(qsize)) + do m_cnst = 1, qsize + m_ind(m_cnst) = m_cnst + end do + + call analytic_ic_set_ic(vcoord, latvals, lonvals, glob_ind, & + PS=dbuf4(:,1,:,(qsize+1)), U=dbuf4(:,:,:,(qsize+2)), & + V=dbuf4(:,:,:,(qsize+3)), T=dbuf4(:,:,:,(qsize+4)), & + Q=dbuf4(:,:,:,1:qsize), m_cnst=m_ind, mask=pmask(:)) + + deallocate(m_ind) + deallocate(glob_ind) + do ie = 1, nelemd + indx = 1 + do j = 1, np + do i = 1, np + ! PS + elem(ie)%state%psdry(i,j,1) = dbuf4(indx, 1, ie, (qsize+1)) + ! U + elem(ie)%state%v(i,j,1,:,1) = dbuf4(indx, :, ie, (qsize+2)) + ! V + elem(ie)%state%v(i,j,2,:,1) = dbuf4(indx, :, ie, (qsize+3)) + ! T + elem(ie)%state%T(i,j,:,1) = dbuf4(indx, :, ie, (qsize+4)) + indx = indx + 1 + end do + end do + end do + + ! Tracers to be advected on GLL grid. + ! Note that fvm tracers are initialized below. + do m_cnst = 1, qsize + do ie = 1, nelemd + qtmp(:,:,:,ie,m_cnst) = 0.0_r8 + indx = 1 + do j = 1, np + do i = 1, np + qtmp(i,j,:,ie,m_cnst) = dbuf4(indx, :, ie, m_cnst) + indx = indx + 1 + end do + end do + end do + end do + deallocate(dbuf4) + + + else + + ! Read ICs from file. Assume all fields in the initial file are on the GLL grid. + + ! Set PIO to return error codes. + call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, pio_errtype) + + ! The grid name is defined in dyn_grid::define_cam_grids. + ! Get the number of columns in the global GLL grid. + call cam_grid_dimensions('GLL', dims) + dyn_cols = dims(1) + + allocate(dbuf2(npsq,nelemd)) + allocate(dbuf3(npsq,nlev,nelemd)) + + ! Check that number of columns in IC file matches grid definition. + call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true., dimname) + + ! Read 2-D field + + fieldname = 'PS' + fieldname2 = 'PSDRY' + if (dyn_field_exists(fh_ini, trim(fieldname), required=.false.)) then + inic_wet = .true. + call read_dyn_var(trim(fieldname), fh_ini, dimname, dbuf2) + elseif (dyn_field_exists(fh_ini, trim(fieldname2), required=.false.)) then + inic_wet = .false. + call read_dyn_var(trim(fieldname2), fh_ini, dimname, dbuf2) + else + call endrun(trim(subname)//': PS or PSDRY must be on GLL grid') + end if + + if (iam < par%nprocs) then + if (minval(dbuf2, mask=reshape(pmask, (/npsq,nelemd/))) < 10000._r8) then + call endrun(trim(subname)//': Problem reading ps or psdry field -- bad values') + end if + end if + + do ie = 1, nelemd + indx = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%psdry(i,j,1) = dbuf2(indx,ie) ! can be either wet or dry ps + indx = indx + 1 + end do + end do + end do + + ! Read in 3-D fields + + if (dyn_field_exists(fh_ini, 'U')) then + call read_dyn_var('U', fh_ini, dimname, dbuf3) + else + call endrun(trim(subname)//': U not found') + end if + do ie = 1, nelemd + elem(ie)%state%v = 0.0_r8 + indx = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%v(i,j,1,:,1) = dbuf3(indx,:,ie) + indx = indx + 1 + end do + end do + end do + + if (dyn_field_exists(fh_ini, 'V')) then + call read_dyn_var('V', fh_ini, dimname, dbuf3) + else + call endrun(trim(subname)//': V not found') + end if + do ie = 1, nelemd + indx = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%v(i,j,2,:,1) = dbuf3(indx,:,ie) + indx = indx + 1 + end do + end do + end do + + if (dyn_field_exists(fh_ini, 'T')) then + call read_dyn_var('T', fh_ini, dimname, dbuf3) + else + call endrun(trim(subname)//': T not found') + end if + do ie=1,nelemd + elem(ie)%state%T = 0.0_r8 + indx = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%T(i,j,:,1) = dbuf3(indx,:,ie) + indx = indx + 1 + end do + end do + end do + + if (pertlim .ne. 0.0_r8) then + if (masterproc) then + write(iulog,*) trim(subname), ': Adding random perturbation bounded', & + 'by +/- ', pertlim, ' to initial temperature field' + end if + + call random_seed(size=rndm_seed_sz) + allocate(rndm_seed(rndm_seed_sz)) + + do ie = 1, nelemd + ! seed random number generator based on element ID + ! (possibly include a flag to allow clock-based random seeding) + rndm_seed = elem(ie)%GlobalId + call random_seed(put=rndm_seed) + do i = 1, np + do j = 1, np + do k = 1, nlev + call random_number(pertval) + pertval = 2.0_r8*pertlim*(0.5_r8 - pertval) + elem(ie)%state%T(i,j,k,1) = elem(ie)%state%T(i,j,k,1)*(1.0_r8 + pertval) + end do + end do + end do + end do + + deallocate(rndm_seed) + end if + + ! Read in or cold-initialize all the tracer fields + ! Data is read in on the GLL grid + ! Both GLL and FVM tracer fields are initialized based on the + ! dimension qsize or ntrac for GLL or FVM tracers respectively. + ! Data is only read in on GLL so if FVM tracers are active, + ! interpolation is performed. + if (ntrac > qsize) then + if (ntrac < pcnst) then + write(errmsg, '(a,3(i0,a))') ': ntrac (',ntrac,') > qsize (',qsize, & + ') but < pcnst (',pcnst,')' + call endrun(trim(subname)//errmsg) + end if + else if (qsize < pcnst) then + write(errmsg, '(a,2(i0,a))') ': qsize (',qsize,') < pcnst (',pcnst,')' + call endrun(trim(subname)//errmsg) + end if + + do m_cnst = 1, pcnst + + found = .false. + + if (cnst_read_iv(m_cnst)) then + found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), & + required=.false.) + end if + + if (found) then + call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, dimname, dbuf3) + else + call cnst_init_default(m_cnst, latvals, lonvals, dbuf3, pmask) + end if + + do ie = 1, nelemd + ! Copy tracers defined on GLL grid into Eulerian array + ! Make sure tracers have at least minimum value + do k=1, nlev + indx = 1 + do j = 1, np + do i = 1, np + ! Set qtmp at the unique columns only: zero non-unique columns + if (pmask(((ie - 1) * npsq) + indx)) then + qtmp(i,j, k, ie, m_cnst) = max(qmin(m_cnst),dbuf3(indx,k,ie)) + else + qtmp(i,j, k, ie, m_cnst) = 0.0_r8 + end if + indx = indx + 1 + end do + end do + end do + end do + end do ! pcnst + + ! Cleanup + deallocate(dbuf2) + deallocate(dbuf3) + + ! Put the error handling back the way it was + call pio_seterrorhandling(fh_ini, pio_errtype) + + end if ! analytic_ic_active + + ! Cleanup + deallocate(pmask) + deallocate(latvals) + deallocate(lonvals) + + if (associated(ldof)) then + deallocate(ldof) + nullify(ldof) + end if + + ! once we've read or initialized all the fields we do a boundary exchange to + ! update the redundent columns in the dynamics + if(iam < par%nprocs) then + call initEdgeBuffer(par, edge, elem, (3+pcnst)*nlev + 2 ) + end if + do ie = 1, nelemd + kptr = 0 + call edgeVpack(edge, elem(ie)%state%psdry,1,kptr,ie) + kptr = kptr + 1 + call edgeVpack(edge, elem(ie)%state%v(:,:,:,:,1),2*nlev,kptr,ie) + kptr = kptr + (2 * nlev) + call edgeVpack(edge, elem(ie)%state%T(:,:,:,1),nlev,kptr,ie) + kptr = kptr + nlev + call edgeVpack(edge, qtmp(:,:,:,ie,:),nlev*pcnst,kptr,ie) + end do + if(iam < par%nprocs) then + call bndry_exchange(par,edge,location='read_inidat') + end if + do ie = 1, nelemd + kptr = 0 + call edgeVunpack(edge, elem(ie)%state%psdry,1,kptr,ie) + kptr = kptr + 1 + call edgeVunpack(edge, elem(ie)%state%v(:,:,:,:,1),2*nlev,kptr,ie) + kptr = kptr + (2 * nlev) + call edgeVunpack(edge, elem(ie)%state%T(:,:,:,1),nlev,kptr,ie) + kptr = kptr + nlev + call edgeVunpack(edge, qtmp(:,:,:,ie,:),nlev*pcnst,kptr,ie) + end do + + if (inic_wet) then + ! + ! convert to dry + ! + ! (this has to be done after edge-exchange since shared points between elements are only + ! initialized in one element and not the other!) + ! + if (par%masterproc) then + write(iulog,*) 'Convert specific/wet mixing ratios to dry' + end if + + allocate(factor_array(np,np,nlev,nelemd)) + ! + ! compute: factor_array = 1/(1-sum(q)) + ! + factor_array(:,:,:,:) = 1.0_r8 + do ie = 1, nelemd + do k = 1, qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(k) + factor_array(:,:,:,ie) = factor_array(:,:,:,ie) - qtmp(:,:,:,ie,m_cnst) + end do + end do + factor_array(:,:,:,:) = 1.0_r8/factor_array(:,:,:,:) + + do m_cnst = 1, pcnst + if (cnst_type(m_cnst) == 'wet') then + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + + ! convert wet mixing ratio to dry + qtmp(i,j,k,ie,m_cnst) = qtmp(i,j,k,ie,m_cnst) * factor_array(i,j,k,ie) + + ! truncate negative values if they were not analytically specified + if (.not. analytic_ic_active()) then + qtmp(i,j,k,ie,m_cnst) = max(qmin(m_cnst), qtmp(i,j,k,ie,m_cnst)) + end if + end do + end do + end do + end do + end if + end do + + ! initialize dp3d and qdp + ! + ! compute: factor_array = 1/(1+sum(q)) + + factor_array(:,:,:,:) = 1.0_r8 + do ie = 1, nelemd + do k = 1, qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(k) + factor_array(:,:,:,ie) = factor_array(:,:,:,ie) + qtmp(:,:,:,ie,m_cnst) + end do + end do + factor_array(:,:,:,:) = 1.0_r8/factor_array(:,:,:,:) + do ie = 1, nelemd + ! pstmp is the wet ps + pstmp = elem(ie)%state%psdry(:,:,1) + ! start accumulating the dry air pressure differences across each layer + elem(ie)%state%psdry(:,:,1) = hyai(1)*ps0 + do k=1,nlev + do j = 1,np + do i = 1,np + dp_tmp = ((hyai(k+1) - hyai(k))*ps0) + & + ((hybi(k+1) - hybi(k))*pstmp(i,j)) + if (.not. analytic_ic_active()) then + + ! if analytic_ic then the surface pressure is already dry + ! (note that it is not correct to convert to moist pressure + ! in analytic_ic and not have the #ifndef statement here + ! since the dry levels are in a different location than + ! what is obtained from algorithm below) + + ! convert dp_tmp to dry + dp_tmp = dp_tmp*factor_array(i,j,k,ie) + end if + + elem(ie)%state%dp3d(i,j,k,:) = dp_tmp + + ! compute dry surface pressure; note that at this point + ! + ! dp3d .NE. (hyai(k+1) - hyai(k))*ps0 + (hybi(k+1) - hybi(k))*ps(i,j) + + elem(ie)%state%psdry(i,j,1) = elem(ie)%state%psdry(i,j,1) + & + elem(ie)%state%dp3d(i,j,k,1) + end do + end do + end do + end do + + deallocate(factor_array) + + else + + ! initial condition is based on dry surface pressure and constituents + ! + ! we only need to initialize state%dp3d + + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + elem(ie)%state%dp3d(i,j,k,:) = (hyai(k+1) - hyai(k))*ps0 + & + (hybi(k+1) - hybi(k))*elem(ie)%state%psdry(i,j,1) + end do + end do + end do + end do + end if + + ! scale PS to achieve prescribed dry mass following FV dycore (dryairm.F90) + if (runtype == 0) then + initial_global_ave_dry_ps = 98288.0_r8 + if (.not. associated(fh_topo)) then + initial_global_ave_dry_ps = 101325._r8 - 245._r8 + end if + if (analytic_ic_active()) then + initial_global_ave_dry_ps = 0 !do not scale psdry + end if + if (iam < par%nprocs) then + call prim_set_dry_mass(elem, hvcoord, initial_global_ave_dry_ps, qtmp) + end if + endif + + ! store Q values: + ! + ! if CSLAM is NOT active then state%Qdp for all constituents + ! if CSLAM active then we only advect water vapor and condensate + ! loading tracers in state%qdp + + if (ntrac > 0) then + do ie = 1, nelemd + do nq = 1, qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + do k = 1, nlev + do j = 1, np + do i = 1, np + elem(ie)%state%Qdp(i,j,k,nq,:) = & + elem(ie)%state%dp3d(i,j,k,1)*qtmp(i,j,k,ie,m_cnst) + end do + end do + end do + end do + end do + else + do ie = 1, nelemd + do m_cnst = 1, qsize + do k = 1, nlev + do j = 1, np + do i = 1, np + elem(ie)%state%Qdp(i,j,k,m_cnst,:)=& + elem(ie)%state%dp3d(i,j,k,1)*qtmp(i,j,k,ie,m_cnst) + end do + end do + end do + end do + end do + end if + + ! interpolate fvm tracers and fvm pressure variables + + if (ntrac > 0) then + if (par%masterproc) then + write(iulog,*) 'Initializing dp_fvm from spectral element dp' + end if + + do ie = 1, nelemd + ! + ! note that the area over fvm cells as computed from subcell_integration is up to 1.0E-6 + ! different than the areas (exact) computed by CSLAM + ! + ! Map the constituents which are also to be transported by dycore + if (analytic_ic_active()) then + lsize = 1 + else + lsize = ntrac + end if + call dyn2fvm_mass_vars(elem(ie)%state%dp3d(:,:,:,1),elem(ie)%state%psdry(:,:,1),& + qtmp(:,:,:,ie,1:lsize),& + dyn_in%fvm(ie)%dp_fvm(1:nc,1:nc,:,1),dyn_in%fvm(ie)%psC(1:nc,1:nc),& + dyn_in%fvm(ie)%c(1:nc,1:nc,:,1:lsize,1),& + lsize,elem(ie)%metdet,dyn_in%fvm(ie)%inv_se_area_sphere(1:nc,1:nc)) + + dyn_in%fvm(ie)%dp_fvm(1:nc,1:nc,:,2) = dyn_in%fvm(ie)%dp_fvm(1:nc,1:nc,:,1) + dyn_in%fvm(ie)%c(1:nc,1:nc,:,1:ntrac,2) = dyn_in%fvm(ie)%c(1:nc,1:nc,:,1:ntrac,1) + end do + + if (analytic_ic_active()) then + + ! initialize tracers + + allocate(latvals(nc*nc*nelemd)) + allocate(lonvals(nc*nc*nelemd)) + indx = 1 + do ie = 1, nelemd + do j = 1, nc + do i = 1, nc + latvals(indx) = dyn_in%fvm(ie)%center_cart(i,j)%lat + lonvals(indx) = dyn_in%fvm(ie)%center_cart(i,j)%lon + indx = indx + 1 + end do + end do + end do + + allocate(pmask(nc*nc*nelemd)) + pmask(:) = .true. + + allocate(dbuf4(nc*nc, nlev, nelemd, ntrac)) + allocate(m_ind(ntrac)) + allocate(glob_ind(nc*nc*nelemd)) + j = 1 + do ie = 1, nelemd + do i = 1, nc*nc + ! Create a global(ish) column index + glob_ind(j) = elem(ie)%GlobalId + j = j + 1 + end do + end do + + dbuf4 = 0.0_r8 + do m_cnst = 1, ntrac + m_ind(m_cnst) = m_cnst + end do + call analytic_ic_set_ic(vcoord, latvals, lonvals, glob_ind, Q=dbuf4, m_cnst=m_ind, mask=pmask) + + ! it is more balanced to use dyn2fvm for Q than to use the "analytical" value + ! on the fvm grid + + do m_cnst = 2, ntrac + do ie = 1, nelemd + indx = 1 + do j = 1, nc + do i = 1, nc + dyn_in%fvm(ie)%c(i,j,:,m_cnst,1) = dbuf4(indx, :, ie, m_cnst) + dyn_in%fvm(ie)%c(i,j,:,m_cnst,2) = dbuf4(indx, :, ie, m_cnst) + indx = indx + 1 + end do + end do + end do + end do + deallocate(dbuf4) + deallocate(m_ind) + deallocate(latvals) + deallocate(lonvals) + deallocate(glob_ind) + deallocate(pmask) + end if + + if(par%masterproc) then + write(iulog,*) 'FVM tracers, FVM pressure variables and se_area_sphere initialized.' + end if + + end if ! (ntrac > 0) + + ! Cleanup + deallocate(qtmp) + + do ie = 1, nelemd + do t = 2, timelevels + elem(ie)%state%psdry(:,:,t) = elem(ie)%state%psdry(:,:,1) + elem(ie)%state%v(:,:,:,:,t) = elem(ie)%state%v(:,:,:,:,1) + elem(ie)%state%T(:,:,:,t) = elem(ie)%state%T(:,:,:,1) + end do + end do + + if(iam < par%nprocs) then + call FreeEdgeBuffer(edge) + end if + +end subroutine read_inidat + +!======================================================================================== + +subroutine read_phis(dyn_in) + + ! Set PHIS according to the following rules. + ! + ! 1) If a topo file is specified use it. This option has highest precedence. + ! 2) If not using topo file, but analytic_ic option is on, use analytic phis. + ! 3) Set phis = 0.0. + ! + ! If using the physics grid then the topo file will be on that grid since its + ! contents are primarily for the physics parameterizations, and the values of + ! PHIS should be consistent with the values of sub-grid variability (e.g., SGH) + ! which are computed on the physics grid. In this case phis on the physics grid + ! will be interpolated to the GLL grid. + + + ! Arguments + type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import + + ! local variables + type(file_desc_t), pointer :: fh_topo + + type(element_t), pointer :: elem(:) + + real(r8), allocatable :: phis_tmp(:,:) ! (npsp,nelemd) + real(r8), allocatable :: phis_phys_tmp(:,:) ! (fv_nphys**2,nelemd) + + integer :: i, ie, indx, j, kptr + integer :: ierr, pio_errtype + + character(len=max_fieldname_len) :: fieldname + character(len=max_hcoordname_len):: grid_name + integer :: dims(2) + integer :: dyn_cols + integer :: ncol_did + integer :: ncol_size + + integer(iMap), pointer :: ldof(:) ! Basic (2D) grid dof + logical, allocatable :: pmask(:) ! (npsq*nelemd) unique columns + + ! Variables for analytic initial conditions + integer, allocatable :: glob_ind(:) + logical, allocatable :: pmask_phys(:) + real(r8), pointer :: latvals_deg(:) + real(r8), pointer :: lonvals_deg(:) + real(r8), allocatable :: latvals(:) + real(r8), allocatable :: lonvals(:) + real(r8), allocatable :: latvals_phys(:) + real(r8), allocatable :: lonvals_phys(:) + + character(len=*), parameter :: subname='read_phis' + !---------------------------------------------------------------------------- + + fh_topo => topo_file_get_id() + + if (iam < par%nprocs) then + elem => dyn_in%elem + else + nullify(elem) + end if + + allocate(phis_tmp(npsq,nelemd)) + phis_tmp = 0.0_r8 + + if (fv_nphys > 0) then + allocate(phis_phys_tmp(fv_nphys**2,nelemd)) + phis_phys_tmp = 0.0_r8 + end if + + ! Set mask to indicate which columns are active in GLL grid. + nullify(ldof) + call cam_grid_get_gcid(cam_grid_id('GLL'), ldof) + allocate(pmask(npsq*nelemd)) + pmask(:) = (ldof /= 0) + deallocate(ldof) + + if (associated(fh_topo)) then + + ! Set PIO to return error flags. + call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) + + ! Set name of grid object which will be used to read data from file + ! into internal data structure via PIO. + if (fv_nphys == 0) then + grid_name = 'GLL' + else + grid_name = 'physgrid_d' + end if + + ! Get number of global columns from the grid object and check that + ! it matches the file data. + call cam_grid_dimensions(grid_name, dims) + dyn_cols = dims(1) + + ! The dimension of the unstructured grid in the TOPO file is 'ncol'. + ierr = pio_inq_dimid(fh_topo, 'ncol', ncol_did) + if (ierr /= PIO_NOERR) then + call endrun(subname//': dimension ncol not found in bnd_topo file') + end if + ierr = pio_inq_dimlen(fh_topo, ncol_did, ncol_size) + if (ncol_size /= dyn_cols) then + if (masterproc) then + write(iulog,*) subname//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols + end if + call endrun(subname//': ncol size in bnd_topo file does not match grid definition') + end if + + fieldname = 'PHIS' + if (dyn_field_exists(fh_topo, trim(fieldname))) then + if (fv_nphys == 0) then + call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) + else + call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) + call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & + phis_tmp, pmask) + end if + else + call endrun(subname//': Could not find PHIS field on input datafile') + end if + + ! Put the error handling back the way it was + call pio_seterrorhandling(fh_topo, pio_errtype) + + else if (analytic_ic_active() .and. (iam < par%nprocs)) then + + ! lat/lon needed in radians + latvals_deg => cam_grid_get_latvals(cam_grid_id('GLL')) + lonvals_deg => cam_grid_get_lonvals(cam_grid_id('GLL')) + allocate(latvals(np*np*nelemd)) + allocate(lonvals(np*np*nelemd)) + latvals(:) = latvals_deg(:)*deg2rad + lonvals(:) = lonvals_deg(:)*deg2rad + + allocate(glob_ind(npsq*nelemd)) + j = 1 + do ie = 1, nelemd + do i = 1, npsq + ! Create a global(ish) column index + glob_ind(j) = elem(ie)%GlobalId + j = j + 1 + end do + end do + + call analytic_ic_set_ic(vcoord, latvals, lonvals, glob_ind, & + PHIS=phis_tmp, mask=pmask(:)) + + deallocate(glob_ind) + + if (fv_nphys > 0) then + + ! initialize PHIS on physgrid + allocate(latvals_phys(fv_nphys*fv_nphys*nelemd)) + allocate(lonvals_phys(fv_nphys*fv_nphys*nelemd)) + indx = 1 + do ie = 1, nelemd + do j = 1, fv_nphys + do i = 1, fv_nphys + latvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lat + lonvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lon + indx = indx + 1 + end do + end do + end do + + allocate(pmask_phys(fv_nphys*fv_nphys*nelemd)) + pmask_phys(:) = .true. + allocate(glob_ind(fv_nphys*fv_nphys*nelemd)) + + j = 1 + do ie = 1, nelemd + do i = 1, fv_nphys*fv_nphys + ! Create a global(ish) column index + glob_ind(j) = elem(ie)%GlobalId + j = j + 1 + end do + end do + + call analytic_ic_set_ic(vcoord, latvals_phys, lonvals_phys, glob_ind, PHIS=phis_phys_tmp, & + mask=pmask_phys) + + deallocate(latvals_phys) + deallocate(lonvals_phys) + deallocate(pmask_phys) + deallocate(glob_ind) + end if + + end if + + deallocate(pmask) + + ! Set PHIS in element objects + do ie = 1, nelemd + elem(ie)%state%phis = 0.0_r8 + indx = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%phis(i,j) = phis_tmp(indx, ie) + indx = indx + 1 + end do + end do + end do + if (fv_nphys > 0) then + do ie = 1, nelemd + dyn_in%fvm(ie)%phis_physgrid = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) + end do + end if + + deallocate(phis_tmp) + if (fv_nphys > 0) then + deallocate(phis_phys_tmp) + end if + + ! boundary exchange to update the redundent columns in the element objects + do ie = 1, nelemd + kptr = 0 + call edgeVpack(edgebuf, elem(ie)%state%phis, 1, kptr, ie) + end do + if(iam < par%nprocs) then + call bndry_exchange(par, edgebuf, location=subname) + end if + do ie = 1, nelemd + kptr = 0 + call edgeVunpack(edgebuf, elem(ie)%state%phis,1,kptr,ie) + end do + +end subroutine read_phis + +!======================================================================================== + +subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok, dimname) + + type(file_desc_t), pointer :: file + type(element_t), pointer :: elem(:) + integer, intent(in) :: dyn_cols + character(len=*), intent(in) :: file_desc + logical, intent(in) :: dyn_ok ! .true. iff ncol_d is okay + character(len=*), intent(out) :: dimname + + integer :: ncol_did, ncol_size + integer :: ierr + integer :: ie, i, j + integer :: grid_id + integer :: indx + real(r8) :: dbuf2(npsq, nelemd) + logical :: found + character(len=max_fieldname_len) :: dimname2, coordname + + character(len=*), parameter :: subname = 'check_file_layout' + !---------------------------------------------------------------------------- + + ! Check that number of columns in IC file matches grid definition. + ! The dimension of the unstructured grid in the IC file can either be 'ncol' + ! or 'ncol_d'. Check for ncol_d first since if a file contains distinct GLL + ! and physics grids the GLL grid will use dimension ncol_d. + ierr = pio_inq_dimid(file, 'ncol_d', ncol_did) + if (ierr /= PIO_NOERR) then + if (dyn_ok) then + ierr = pio_inq_dimid(file, 'ncol', ncol_did) + if (ierr /= PIO_NOERR) then + call endrun(subname//': ERROR: neither ncol nor ncol_d dimension found in ' & + //trim(file_desc)//' file') + end if + else + call endrun(trim(subname)//': ERROR: ncol dimension not found in '//trim(file_desc) & + //' file') + end if + end if + ierr = pio_inq_dimlen(file, ncol_did, ncol_size) + if (ncol_size /= dyn_cols) then + if (masterproc) then + write(iulog, '(a,2(a,i0))') trim(subname), ': ncol_size=', ncol_size, & + ' : dyn_cols=', dyn_cols + end if + call endrun(subname//': ERROR: dimension ncol size not same as in ncdata file') + end if + + ! The dimname that's passed to the read_dyn_var routines must match the + ! dimname that's in the GLL grid object definition. The mapping info used by + ! pio is constructed using the grid object. So this dimname is not necessarily + ! the one in the IC (or topo) file. + grid_id = cam_grid_id('GLL') + call cam_grid_get_dim_names(grid_id, dimname, dimname2) + + ! If coordinates come from an initial file containing only the GLL grid then the + ! the variable names will be lat/lon. On the other hand if the file contains both + ! GLL and a distinct physics grid, then the variable names will be lat_d/lon_d. + ! Check whether lat_d/lon_d are present and use them if they are. Otherwise use + ! lat/lon. + if (dyn_field_exists(file, 'lat_d', required=.false.)) then + coordname = 'lat_d' + else + coordname = 'lat' + end if + + !! Check to make sure file is in correct order + call read_dyn_var(coordname, file, dimname, dbuf2) + found = .true. + do ie = 1, nelemd + indx = 1 + do j = 1, np + do i = 1, np + if ((abs(dbuf2(indx,ie)) > 1.e-12_r8) .and. & + (abs((elem(ie)%spherep(i,j)%lat*rad2deg - dbuf2(indx,ie))/dbuf2(indx,ie)) > 1.0e-10_r8)) then + write(6, *) 'XXG ',iam,') ',ie,i,j,elem(ie)%spherep(i,j)%lat,dbuf2(indx,ie)*deg2rad + call shr_sys_flush(6) + found = .false. + end if + indx = indx + 1 + end do + end do + end do + if (.not. found) then + call endrun("ncdata file latitudes not in correct column order") + end if + + if (dyn_field_exists(file, 'lon_d', required=.false.)) then + coordname = 'lon_d' + else + coordname = 'lon' + end if + + call read_dyn_var(coordname, file, dimname, dbuf2) + do ie = 1, nelemd + indx = 1 + do j = 1, np + do i = 1, np + if ((abs(dbuf2(indx,ie)) > 1.e-12_r8) .and. & + (abs((elem(ie)%spherep(i,j)%lon*rad2deg - dbuf2(indx,ie))/dbuf2(indx,ie)) > 1.0e-10_r8)) then + write(6, *) 'XXG ',iam,') ',ie,i,j,elem(ie)%spherep(i,j)%lon,dbuf2(indx,ie)*deg2rad + call shr_sys_flush(6) + found = .false. + end if + indx = indx + 1 + end do + end do + end do + if (.not. found) then + call endrun("ncdata file longitudes not in correct column order") + end if +end subroutine check_file_layout + +!======================================================================================== + +logical function dyn_field_exists(fh, fieldname, required) + + use pio, only: var_desc_t, PIO_inq_varid + use pio, only: PIO_NOERR + + type(file_desc_t), intent(in) :: fh + character(len=*), intent(in) :: fieldname + logical, optional, intent(in) :: required + + ! Local variables + logical :: found + logical :: field_required + integer :: ret + type(var_desc_t) :: varid + character(len=128) :: errormsg + !-------------------------------------------------------------------------- + + if (present(required)) then + field_required = required + else + field_required = .true. + end if + + ret = PIO_inq_varid(fh, trim(fieldname), varid) + found = (ret == PIO_NOERR) + if (.not. found) then + if (field_required) then + write(errormsg, *) trim(fieldname),' was not present in the input file.' + call endrun('DYN_FIELD_EXISTS: '//errormsg) + end if + end if + + dyn_field_exists = found + +end function dyn_field_exists + +!======================================================================================== + +subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + type(file_desc_t), intent(inout) :: fh + character(len=*), intent(in) :: dimname + real(r8), intent(inout) :: buffer(:, :) + + ! Local variables + logical :: found + !---------------------------------------------------------------------------- + + buffer = 0.0_r8 + call infld(trim(fieldname), fh, dimname, 1, npsq, 1, nelemd, buffer, & + found, gridname='GLL') + if(.not. found) then + call endrun('READ_DYN_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') + end if + + ! This code allows use of compiler option to set uninitialized values + ! to NaN. In that case infld can return NaNs where the element GLL points + ! are not "unique columns" + where (isnan(buffer)) buffer = 0.0_r8 + +end subroutine read_dyn_field_2d + +!======================================================================================== + +subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + type(file_desc_t), intent(inout) :: fh + character(len=*), intent(in) :: dimname + real(r8), intent(inout) :: buffer(:,:,:) + + ! Local variables + logical :: found + !---------------------------------------------------------------------------- + + buffer = 0.0_r8 + call infld(trim(fieldname), fh, dimname, 'lev', 1, npsq, 1, nlev, & + 1, nelemd, buffer, found, gridname='GLL') + if(.not. found) then + call endrun('READ_DYN_FIELD_3D: Could not find '//trim(fieldname)//' field on input datafile') + end if + + ! This code allows use of compiler option to set uninitialized values + ! to NaN. In that case infld can return NaNs where the element GLL points + ! are not "unique columns" + where (isnan(buffer)) buffer = 0.0_r8 + +end subroutine read_dyn_field_3d + +!======================================================================================== + +subroutine read_phys_field_2d(fieldname, fh, dimname, buffer) + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + type(file_desc_t), intent(inout) :: fh + character(len=*), intent(in) :: dimname + real(r8), intent(inout) :: buffer(:, :) + + ! Local variables + logical :: found + !---------------------------------------------------------------------------- + + call infld(trim(fieldname), fh, dimname, 1, fv_nphys**2, 1, nelemd, buffer, & + found, gridname='physgrid_d') + if(.not. found) then + call endrun('READ_PHYS_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') + end if + +end subroutine read_phys_field_2d + +!======================================================================================== + +subroutine map_phis_from_physgrid_to_gll(fvm,elem,phis_phys_tmp,phis_tmp,pmask) + + use hybrid_mod, only: get_loop_ranges, config_thread_region + use dimensions_mod, only: nhc_phys + use fvm_mapping, only: phys2dyn + use thread_mod, only: horz_num_threads + + type(element_t), intent(inout) :: elem(:) + type (fvm_struct), intent(in) :: fvm(:) + real(r8) , intent(in) :: phis_phys_tmp(fv_nphys**2,nelemd) !physgrid phis + real(r8) , intent(inout) :: phis_tmp(npsq,nelemd) !gll phis + logical , intent(in) :: pmask(npsq*nelemd) + + type(hybrid_t) :: hybrid + integer :: nets, nete, ie,i,j,indx + real(r8), allocatable :: fld_phys(:,:,:,:,:),fld_gll(:,:,:,:,:) + logical :: llimiter(1) + !---------------------------------------------------------------------------- + +!$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,ie) + hybrid = config_thread_region(par,'horizontal') + + call get_loop_ranges(hybrid, ibeg=nets, iend=nete) + + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,1,1,nets:nete)) + allocate(fld_gll(np,np,1,1,nets:nete)) + fld_phys = 0.0_r8 + do ie = nets, nete + fld_phys(1:fv_nphys,1:fv_nphys,1,1,ie) = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) + end do + llimiter = .true. + call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,1,1,fvm,llimiter,halo_filled=.false.) + do ie = nets,nete + indx = 1 + do j = 1, np + do i = 1, np + if (pmask(((ie - 1) * npsq) + indx)) then + phis_tmp(indx,ie) = fld_gll(i,j,1,1,ie) + else + phis_tmp(indx,ie) = 0.0_r8 + end if + indx = indx + 1 + end do + end do + end do + deallocate(fld_phys) + deallocate(fld_gll) +!$OMP END PARALLEL +end subroutine map_phis_from_physgrid_to_gll + +!======================================================================================== + +subroutine write_dyn_vars(dyn_out) + + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + + character(len=fieldname_len) :: tfname + integer :: ie, m + !---------------------------------------------------------------------------- + + if (ntrac > 0) then + do ie = 1, nelemd + call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:,n0_fvm), & + (/nc*nc,nlev/)), nc*nc, ie) + call outfld('PSDRY_fvm', RESHAPE(dyn_out%fvm(ie)%psc(1:nc,1:nc), & + (/nc*nc/)), nc*nc, ie) + do m = 1, ntrac + tfname = trim(cnst_name(m))//'_fvm' + call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%c(1:nc,1:nc,:,m,n0_fvm), & + (/nc*nc,nlev/)), nc*nc, ie) + + tfname = 'F'//trim(cnst_name(m))//'_fvm' + call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%fc(1:nc,1:nc,:,m),& + (/nc*nc,nlev/)), nc*nc, ie) + end do + end do + end if + +end subroutine write_dyn_vars + +!========================================================================================= + +end module dyn_comp diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 new file mode 100644 index 0000000000..5bb963e60d --- /dev/null +++ b/src/dynamics/se/dyn_grid.F90 @@ -0,0 +1,1572 @@ +module dyn_grid +!------------------------------------------------------------------------------- +! +! Define SE computational grids on the dynamics decomposition. +! + +! The grid used by the SE dynamics is called the GLL grid. It is +! decomposed into elements which correspond to "blocks" in the +! physics/dynamics coupler terminology. The columns in this grid are +! located at the Gauss-Lobatto-Legendre (GLL) quadrature points. The GLL +! grid will also be used by the physics if the CSLAM advection is not used. +! If CSLAM is used for tracer advection then it uses an FVM grid and the +! physics will either use the same FVM grid or an FVM grid with a different +! number of equal area subcells. The FVM grid used by the physics is +! referred to as the "physgrid". +! +! Module responsibilities: +! +! . Provide the physics/dynamics coupler (in module phys_grid) with data for the +! physics grid on the dynamics decomposition. +! +! . Create CAM grid objects that are used by the I/O functionality to read +! data from an unstructured grid format to the dynamics data structures, and +! to write from the dynamics data structures to unstructured grid format. The +! global column ordering for the unstructured grid is determined by the SE dycore. +! +!------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl +use spmd_utils, only: masterproc, iam, mpicom, mstrid=>masterprocid, & + npes, mpi_integer, mpi_real8, mpi_success +use constituents, only: pcnst +use physconst, only: pi +use cam_initfiles, only: initial_file_get_id +use cam_grid_support, only: iMap +use dp_mapping, only: dp_reoorder + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use shr_sys_mod, only: shr_sys_flush + +use pio, only: file_desc_t, pio_seterrorhandling, pio_bcast_error, & + pio_internal_error, pio_noerr, pio_inq_dimid, & + pio_inq_dimlen + +use dimensions_mod, only: globaluniquecols, nelem, nelemd, nelemdmax, & + ne, np, npsq, fv_nphys, nlev, nc, ntrac, & + qsize_condensate_loading +use element_mod, only: element_t +use fvm_control_volume_mod, only: fvm_struct +use hybvcoord_mod, only: hvcoord_t +use prim_init, only: prim_init1 +use edge_mod, only: initEdgeBuffer +use edgetype_mod, only: EdgeBuffer_t +use time_mod, only: TimeLevel_t +use dof_mod, only: UniqueCoords, UniquePoints + +implicit none +private +save + +integer, parameter :: dyn_decomp = 101 ! The SE dynamics grid +integer, parameter :: fvm_decomp = 102 ! The FVM (CSLAM) grid +integer, parameter :: physgrid_d = 103 ! physics grid on dynamics decomp +integer, parameter :: ptimelevels = 2 + +type (TimeLevel_t) :: TimeLevel ! main time level struct (used by tracers) +type (hvcoord_t) :: hvcoord +type(element_t), pointer :: elem(:) => null() ! local GLL elements for this task +type(fvm_struct), pointer :: fvm(:) => null() ! local FVM elements for this task + +public :: & + dyn_decomp, & + ptimelevels, & + TimeLevel, & + hvcoord, & + elem, & + fvm, & + edgebuf + +public :: & + dyn_grid_init, & + get_block_bounds_d, & ! get first and last indices in global block ordering + get_block_gcol_d, & ! get column indices for given block + get_block_gcol_cnt_d, & ! get number of columns in given block + get_block_lvl_cnt_d, & ! get number of vertical levels in column + get_block_levels_d, & ! get vertical levels in column + get_block_owner_d, & ! get process "owning" given block + get_gcol_block_d, & ! get global block indices and local columns + ! index for given global column index + get_gcol_block_cnt_d, & ! get number of blocks containing data + ! from a given global column index + get_horiz_grid_dim_d, & + get_horiz_grid_d, & ! get horizontal grid coordinates + get_dyn_grid_parm, & + get_dyn_grid_parm_real1d, & + dyn_grid_get_elem_coords, & ! get coordinates of a specified block element + dyn_grid_get_colndx, & ! get element block/column and MPI process indices + ! corresponding to a specified global column index + physgrid_copy_attributes_d + +! Namelist variables controlling grid writing. +! Read in dyn_readnl from dyn_se_inparm group. +character(len=16), public :: se_write_grid_file = 'no' +character(len=shr_kind_cl), public :: se_grid_filename = '' +logical, public :: se_write_gll_corners = .false. + +type block_global_data + integer :: UniquePtOffset ! global index of first column in element + integer :: NumUniqueP ! number of unique columns in element + integer :: LocalID ! local index of element in a task + integer :: Owner ! task id of element owner +end type block_global_data + +! Only need this global data for the GLL grid if it is also the physics grid. +type(block_global_data), allocatable :: gblocks(:) + +! number of global dynamics columns. Set by SE dycore init. +integer :: ngcols_d = 0 +! number of global elements. Set by SE dycore init. +integer :: nelem_d = 0 + +real(r8), parameter :: rad2deg = 180.0_r8/pi + +type(EdgeBuffer_t) :: edgebuf + +!============================================================================= +contains +!============================================================================= + +subroutine dyn_grid_init() + + ! Initialize SE grid, and decomposition. + + use hycoef, only: hycoef_init, hypi, hypm, nprlev, & + hyam, hybm, hyai, hybi, ps0 + use ref_pres, only: ref_pres_init + use spmd_utils, only: MPI_MAX, MPI_INTEGER, mpicom + use time_manager, only: get_nstep, get_step_size + use dp_mapping, only: dp_init, dp_write + use native_mapping, only: do_native_mapping, create_native_mapping_files + + use parallel_mod, only: par + use hybrid_mod, only: hybrid_t, init_loop_ranges, & + get_loop_ranges, config_thread_region + use thread_mod , only: horz_num_threads + use control_mod, only: qsplit, rsplit + use time_mod, only: tstep, nsplit + use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init + use dimensions_mod, only: irecons_tracer + use comp_gll_ctr_vol, only: gll_grid_write + + ! Local variables + + type(file_desc_t), pointer :: fh_ini + + integer :: qsize_local + integer :: k + + type(hybrid_t) :: hybrid + integer :: ierr + integer :: neltmp(3) + integer :: dtime + + real(r8), allocatable ::clat(:), clon(:), areaa(:) + integer :: nets, nete + + character(len=*), parameter :: sub = 'dyn_grid_init' + !---------------------------------------------------------------------------- + + ! Get file handle for initial file and first consistency check + fh_ini => initial_file_get_id() + + ! Initialize hybrid coordinate arrays + call hycoef_init(fh_ini, psdry=.true.) + + hvcoord%hyam = hyam + hvcoord%hyai = hyai + hvcoord%hybm = hybm + hvcoord%hybi = hybi + hvcoord%ps0 = ps0 + do k = 1, nlev + hvcoord%hybd(k) = hvcoord%hybi(k+1) - hvcoord%hybi(k) + end do + + ! Initialize reference pressures + call ref_pres_init(hypi, hypm, nprlev) + + if (iam < par%nprocs) then + + call prim_init1(elem, fvm, par, TimeLevel) + if (fv_nphys > 0) then + call dp_init(elem, fvm) + end if + + if (fv_nphys > 0) then + qsize_local = qsize_condensate_loading + 3 + else + qsize_local = pcnst + 3 + end if + + call initEdgeBuffer(par, edgebuf, elem, qsize_local*nlev, nthreads=1) + + else ! auxiliary processes + + globaluniquecols = 0 + nelem = 0 + nelemd = 0 + nelemdmax = 0 + endif + + ! nelemdmax is computed on the dycore comm, we need it globally. + ngcols_d = nelemdmax + call MPI_Allreduce(ngcols_d, nelemdmax, 1, MPI_INTEGER, MPI_MAX, mpicom, ierr) + ! All pes might not have the correct global grid size + call MPI_Allreduce(globaluniquecols, ngcols_d, 1, MPI_INTEGER, MPI_MAX, mpicom, ierr) + ! All pes might not have the correct number of elements + call MPI_Allreduce(nelem, nelem_d, 1, MPI_INTEGER, MPI_MAX, mpicom, ierr) + + ! nelemd (# of elements on this task) is set by prim_init1 + call init_loop_ranges(nelemd) + + ! Dynamics timestep + ! + ! Note: dtime = timestep for physics/dynamics coupling + ! tstep = the dynamics timestep: + dtime = get_step_size() + tstep = dtime / real(nsplit*qsplit*rsplit, r8) + TimeLevel%nstep = get_nstep()*nsplit*qsplit*rsplit + + ! initial SE (subcycled) nstep + TimeLevel%nstep0 = 0 + + ! Define the dynamics and physics grids on the dynamics decompostion. + ! Physics grid on the physics decomposition is defined in phys_grid_init. + call define_cam_grids() + + if (fv_nphys > 0) then + + ! ================================================ + ! finish fvm initialization + ! ================================================ + + if (iam < par%nprocs) then +!$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete) + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid, ibeg=nets, iend=nete) + + ! initialize halo coordinate variables for cslam and physgrid + call fvm_init2(elem, fvm, hybrid, nets, nete) + call fvm_pg_init(elem, fvm, hybrid, nets, nete, irecons_tracer) + call fvm_init3(elem, fvm, hybrid, nets, nete, irecons_tracer) +!$OMP END PARALLEL + end if + + else + + ! construct global arrays needed when GLL grid used by physics + call gblocks_init() + + end if + + ! write grid and mapping files + if (se_write_gll_corners) then + call write_grid_mapping(par, elem) + end if + + if (trim(se_write_grid_file) /= "no") then + if (fv_nphys > 0) then + call dp_write(elem, fvm, trim(se_write_grid_file), trim(se_grid_filename)) + else + call gll_grid_write(elem, trim(se_write_grid_file), trim(se_grid_filename)) + end if + end if + + if (do_native_mapping) then + + allocate(areaA(ngcols_d)) + allocate(clat(ngcols_d),clon(ngcols_d)) + call get_horiz_grid_d(ngcols_d, clat_d_out=clat, clon_d_out=clon, area_d_out=areaA) + + ! Create mapping files using SE basis functions + call create_native_mapping_files(par, elem, 'native', ngcols_d, clat, clon, areaa) + call create_native_mapping_files(par, elem, 'bilin', ngcols_d, clat, clon, areaa) + + deallocate(areaa, clat, clon) + end if + + call mpi_barrier(mpicom, ierr) + +end subroutine dyn_grid_init + +!========================================================================================= + +subroutine get_block_bounds_d(block_first, block_last) + + ! Return first and last indices used in global block ordering + + integer, intent(out) :: block_first ! first (global) index used for blocks + integer, intent(out) :: block_last ! last (global) index used for blocks + !---------------------------------------------------------------------------- + + block_first = 1 + block_last = nelem_d + +end subroutine get_block_bounds_d + +!========================================================================================= + +subroutine get_block_gcol_d(blockid, asize, cdex) + + ! Return list of global column indices in given block + + !------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: asize ! array size + + integer, intent(out):: cdex(asize) ! global column indices + + integer :: ic + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + cdex(1) = (blockid-1)*fv_nphys*fv_nphys + 1 + do ic = 2, asize + cdex(ic) = cdex(1) + ic - 1 + end do + else + + do ic = 1, asize + cdex(ic) = gblocks(blockid)%UniquePtOffset + ic - 1 + end do + end if + +end subroutine get_block_gcol_d + +!========================================================================================= + +integer function get_block_gcol_cnt_d(blockid) + + ! Return number of dynamics columns in indicated block + + integer, intent(in) :: blockid + + integer :: ie + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + get_block_gcol_cnt_d = fv_nphys*fv_nphys + else + get_block_gcol_cnt_d = gblocks(blockid)%NumUniqueP + end if + +end function get_block_gcol_cnt_d + +!========================================================================================= + +integer function get_block_lvl_cnt_d(blockid, bcid) + + ! Return number of levels in indicated column. If column + ! includes surface fields, then it is defined to also + ! include level 0. + + use pmgrid, only: plevp + + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + !----------------------------------------------------------------------- + + get_block_lvl_cnt_d = plevp + +end function get_block_lvl_cnt_d + +!========================================================================================= + +subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) + + use pmgrid, only: plev + + ! Return level indices in indicated column. If column + ! includes surface fields, then it is defined to also + ! include level 0. + + ! arguments + integer, intent(in) :: blockid ! global block id + integer, intent(in) :: bcid ! column index within block + integer, intent(in) :: lvlsiz ! dimension of levels array + + integer, intent(out) :: levels(lvlsiz) ! levels indices for block + + ! local variables + integer :: k + character(len=128) :: errmsg + !--------------------------------------------------------------------------- + + if (lvlsiz < plev + 1) then + write(errmsg,*) 'levels array not large enough (', lvlsiz,' < ',plev + 1,')' + call endrun('GET_BLOCK_LEVELS_D: '//trim(errmsg)) + else + do k = 0, plev + levels(k+1) = k + end do + do k = plev+2, lvlsiz + levels(k) = -1 + end do + end if + +end subroutine get_block_levels_d + +!========================================================================================= + +integer function get_gcol_block_cnt_d(gcol) + + ! Return number of blocks containg data for the vertical column with the + ! given global column index. + ! + ! For SE dycore each column is "owned" by a single element, so this routine + ! always returns 1. + + integer, intent(in) :: gcol ! global column index + !---------------------------------------------------------------------------- + + get_gcol_block_cnt_d = 1 + +end function get_gcol_block_cnt_d + +!========================================================================================= + +subroutine get_gcol_block_d(gcol, cnt, blockid, bcid, localblockid) + + use dp_mapping, only: dp_owner + + ! Return global block index and local column index for given global column index. + ! + ! The SE dycore assigns each global column to a singe element. So cnt is assumed + ! to be 1. + + ! arguments + integer, intent(in) :: gcol ! global column index + integer, intent(in) :: cnt ! size of blockid and bcid arrays + + integer, intent(out) :: blockid(cnt) ! block index + integer, intent(out) :: bcid(cnt) ! column index within block + integer, intent(out), optional :: localblockid(cnt) + + ! local variables + integer :: sb, eb, ie, high, low + logical :: found + integer, save :: iedex_save = 1 + character(len=*), parameter :: subname='get_gcol_block_d' + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + + blockid(1) = 1 + ((gcol-1) / (fv_nphys*fv_nphys)) + bcid(1) = 1 + mod(gcol-1, fv_nphys*fv_nphys) + + if (present(localblockid)) then + localblockid = -1 + if (iam == dp_owner(blockid(1))) then + if (blockid(1) == elem(iedex_save)%globalid) then + localblockid = iedex_save + else + do ie = 1,nelemd + if (blockid(1) == elem(ie)%globalid) then + localblockid = ie + iedex_save = ie + exit + end if + end do + end if + end if + end if + + else + + found = .false. + low = 1 + high = nelem_d + + ! check whether previous found element is the same here + if (.not. found) then + ie = iedex_save + sb = gblocks(ie)%UniquePtOffset + if (gcol >= sb) then + eb = sb + gblocks(ie)%NumUniqueP + if (gcol < eb) then + found = .true. + else + low = ie + endif + else + high = ie + endif + endif + + ! check whether next element is the one wanted + if ((.not. found) .and. & + ((low .eq. iedex_save) .or. (iedex_save .eq. nelem_d))) then + ie = iedex_save + 1 + if (ie > nelem_d) ie = 1 + + sb = gblocks(ie)%UniquePtOffset + if (gcol >= sb) then + eb = sb + gblocks(ie)%NumUniqueP + if (gcol < eb) then + found = .true. + else + low = ie + endif + else + high = ie + endif + endif + + ! otherwise, use a binary search to find element + if (.not. found) then + ! (start with a sanity check) + ie = low + sb = gblocks(ie)%UniquePtOffset + + ie = high + eb = gblocks(ie)%UniquePtOffset + gblocks(ie)%NumUniqueP + + if ((gcol < sb) .or. (gcol >= eb)) then + do ie=1,nelemd + write(iulog,*) __LINE__,ie,elem(ie)%idxP%UniquePtOffset,elem(ie)%idxP%NumUniquePts + end do + call endrun(subname//': binary search to find element') + end if + + do while (.not. found) + + ie = low + (high-low)/2; + sb = gblocks(ie)%UniquePtOffset + if (gcol >= sb) then + eb = sb + gblocks(ie)%NumUniqueP + if (gcol < eb) then + found = .true. + else + low = ie+1 + end if + else + high = ie-1 + end if + end do + end if + + blockid(1) = ie + bcid(1) = gcol - sb + 1 + iedex_save = ie + + if (present(localblockid)) localblockid(1) = gblocks(ie)%LocalID + + end if + +end subroutine get_gcol_block_d + +!========================================================================================= + +integer function get_block_owner_d(blockid) + + ! Return id of processor that "owns" the indicated block + + use dp_mapping, only: dp_owner + + integer, intent(in) :: blockid ! global block id + + character(len=*), parameter :: name = 'get_block_owner_d' + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + if (dp_owner(blockid) > -1) then + get_block_owner_d = dp_owner(blockid) + else + call endrun(name//': Block owner not assigned in gblocks_init') + end if + + else + + if (gblocks(blockid)%Owner > -1) then + get_block_owner_d = gblocks(blockid)%Owner + else + call endrun(name//': Block owner not assigned in gblocks_init') + end if + end if + +end function get_block_owner_d + +!========================================================================================= + +subroutine get_horiz_grid_dim_d(hdim1_d,hdim2_d) + + ! Returns declared horizontal dimensions of computational grid. + ! For non-lon/lat grids, declare grid to be one-dimensional, + ! i.e., (ngcols_d x 1) + + !------------------------------Arguments-------------------------------- + integer, intent(out) :: hdim1_d ! first horizontal dimension + integer, intent(out), optional :: hdim2_d ! second horizontal dimension + !----------------------------------------------------------------------- + + if (fv_nphys > 0) then + hdim1_d = fv_nphys*fv_nphys*nelem_d + else + hdim1_d = ngcols_d + end if + if (present(hdim2_d)) then + hdim2_d = 1 + end if + +end subroutine get_horiz_grid_dim_d + +!========================================================================================= + +subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & + wght_d_out, lat_d_out, lon_d_out) + + ! Return global arrays of latitude and longitude (in radians), column + ! surface area (in radians squared) and surface integration weights for + ! global column indices that will be passed to/from physics + + ! arguments + integer, intent(in) :: nxy ! array sizes + + real(r8), intent(out), optional :: clat_d_out(:) ! column latitudes + real(r8), intent(out), optional :: clon_d_out(:) ! column longitudes + real(r8), intent(out), target, optional :: area_d_out(:) ! column surface + + real(r8), intent(out), target, optional :: wght_d_out(:) ! column integration weight + real(r8), intent(out), optional :: lat_d_out(:) ! column degree latitudes + real(r8), intent(out), optional :: lon_d_out(:) ! column degree longitudes + + ! local variables + real(r8), pointer :: area_d(:) + real(r8), pointer :: temp(:) + character(len=256) :: errormsg + character(len=*), parameter :: sub = 'get_horiz_grid_d' + !---------------------------------------------------------------------------- + + ! check that nxy is set to correct size for global arrays + if (fv_nphys > 0) then + if (nxy < fv_nphys*fv_nphys*nelem_d) then + write(errormsg, *) sub//': arrays too small; Passed', & + nxy, ', needs to be at least', fv_nphys*fv_nphys*nelem_d + call endrun(errormsg) + end if + else + if (nxy < ngcols_d) then + write(errormsg,*) sub//': arrays not large enough; ', & + 'Passed', nxy, ', needs to be at least', ngcols_d + call endrun(errormsg) + end if + end if + + if ( present(area_d_out) ) then + if (size(area_d_out) /= nxy) then + call endrun(sub//': bad area_d_out array size') + end if + area_d => area_d_out + call create_global_area(area_d) + + else if ( present(wght_d_out) ) then + if (size(wght_d_out) /= nxy) then + call endrun(sub//': bad wght_d_out array size') + end if + area_d => wght_d_out + call create_global_area(area_d) + + end if + + ! If one of area_d_out or wght_d_out was present, then it was computed + ! above. If they were *both* present, then do this: + if ( present(area_d_out) .and. present(wght_d_out) ) then + wght_d_out(:) = area_d_out(:) + end if + + if (present(clon_d_out)) then + if (size(clon_d_out) /= nxy) then + call endrun(sub//': bad clon_d_out array size in dyn_grid') + end if + end if + + if (present(clat_d_out)) then + + if (size(clat_d_out) /= nxy) then + call endrun('bad clat_d_out array size in dyn_grid') + end if + + if (present(clon_d_out)) then + call create_global_coords(clat_d_out, clon_d_out, lat_d_out, lon_d_out) + else + allocate(temp(nxy)) + call create_global_coords(clat_d_out, temp, lat_d_out, lon_d_out) + deallocate(temp) + end if + + else if (present(clon_d_out)) then + + allocate(temp(nxy)) + call create_global_coords(temp, clon_d_out, lat_d_out, lon_d_out) + deallocate(temp) + + end if + +end subroutine get_horiz_grid_d + +!========================================================================================= + +subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) + + ! create list of attributes for the physics grid that should be copied + ! from the corresponding grid object on the dynamics decomposition + + use cam_grid_support, only: max_hcoordname_len + + ! Dummy arguments + character(len=max_hcoordname_len), intent(out) :: gridname + character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) + + if (fv_nphys > 0) then + gridname = 'physgrid_d' + allocate(grid_attribute_names(2)) + grid_attribute_names(1) = 'fv_nphys' + grid_attribute_names(2) = 'ne' + else + gridname = 'GLL' + allocate(grid_attribute_names(3)) + ! For standard CAM-SE, we need to copy the area attribute. + ! For physgrid, the physics grid will create area (GLL has area_d) + grid_attribute_names(1) = 'area' + grid_attribute_names(2) = 'np' + grid_attribute_names(3) = 'ne' + end if + +end subroutine physgrid_copy_attributes_d + +!========================================================================================= + +function get_dyn_grid_parm_real1d(name) result(rval) + + ! This routine is not used for SE, but still needed as a dummy interface to satisfy + ! references from mo_synoz.F90 and phys_gmean.F90 + + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:) + + if(name.eq.'w') then + call endrun('get_dyn_grid_parm_real1d: w not defined') + else if(name.eq.'clat') then + call endrun('get_dyn_grid_parm_real1d: clat not supported, use get_horiz_grid_d') + else if(name.eq.'latdeg') then + call endrun('get_dyn_grid_parm_real1d: latdeg not defined') + else + nullify(rval) + end if +end function get_dyn_grid_parm_real1d + +!========================================================================================= + +integer function get_dyn_grid_parm(name) result(ival) + + ! This function is in the process of being deprecated, but is still needed + ! as a dummy interface to satisfy external references from some chemistry routines. + + use pmgrid, only: plat, plon, plev, plevp + + character(len=*), intent(in) :: name + !---------------------------------------------------------------------------- + + if (name.eq.'plat') then + ival = plat + else if(name.eq.'plon') then + if (fv_nphys>0) then + ival = fv_nphys*fv_nphys*nelem_d + else + ival = ngcols_d + end if + else if(name.eq.'plev') then + ival = plev + + else + ival = -1 + end if + +end function get_dyn_grid_parm + +!========================================================================================= + +subroutine dyn_grid_get_colndx(igcol, ncols, owners, col, lbk) + + ! For each global column index return the owning task. If the column is owned + ! by this task, then also return the local block number and column index in that + ! block. + ! + ! NOTE: this routine needs to be updated for the physgrid + + integer, intent(in) :: ncols + integer, intent(in) :: igcol(ncols) + integer, intent(out) :: owners(ncols) + integer, intent(out) :: col(ncols) + integer, intent(out) :: lbk(ncols) + + integer :: i, j, k, ii + integer :: blockid(1), bcid(1), lclblockid(1) + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + call endrun('dyn_grid_get_colndx: not implemented for the FVM physics grid') + end if + + do i = 1, ncols + + call get_gcol_block_d(igcol(i), 1, blockid, bcid, lclblockid) + owners(i) = get_block_owner_d(blockid(1)) + + if (owners(i) == iam) then + lbk(i) = lclblockid(1) + ii = igcol(i) - elem(lbk(i))%idxp%UniquePtoffset + 1 + k = elem(lbk(i))%idxp%ia(ii) + j = elem(lbk(i))%idxp%ja(ii) + col(i) = k + (j - 1)*np + else + lbk(i) = -1 + col(i) = -1 + end if + + end do + +end subroutine dyn_grid_get_colndx + +!========================================================================================= + +subroutine dyn_grid_get_elem_coords(ie, rlon, rlat, cdex) + + ! Returns coordinates of a specified block element of the dyn grid + ! + ! NB: This routine only uses the GLL points (i.e, it ignores the physics + ! grid). This is probably OK as current use is only for dyn_decomp + ! variables in history. + + integer, intent(in) :: ie ! block element index + + real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the element + real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the element + integer, optional, intent(out) :: cdex(:) ! global column index + + integer :: sb,eb, ii, i,j, icol, igcol + real(r8), allocatable :: clat(:), clon(:) + !---------------------------------------------------------------------------- + + if (fv_nphys > 0) then + call endrun('dyn_grid_get_colndx: not implemented for the FVM physics grid') + end if + + sb = elem(ie)%idxp%UniquePtOffset + eb = sb + elem(ie)%idxp%NumUniquePts-1 + + allocate( clat(sb:eb), clon(sb:eb) ) + call UniqueCoords( elem(ie)%idxP, elem(ie)%spherep, clat(sb:eb), clon(sb:eb) ) + + if (present(cdex)) cdex(:) = -1 + if (present(rlat)) rlat(:) = -999._r8 + if (present(rlon)) rlon(:) = -999._r8 + + do ii=1,elem(ie)%idxp%NumUniquePts + i=elem(ie)%idxp%ia(ii) + j=elem(ie)%idxp%ja(ii) + icol = i+(j-1)*np + igcol = elem(ie)%idxp%UniquePtoffset+ii-1 + if (present(cdex)) cdex(icol) = igcol + if (present(rlat)) rlat(icol) = clat( igcol ) + if (present(rlon)) rlon(icol) = clon( igcol ) + end do + + deallocate( clat, clon ) + +end subroutine dyn_grid_get_elem_coords + +!========================================================================================= +! Private routines. +!========================================================================================= + +subroutine define_cam_grids() + + ! Create grid objects on the dynamics decomposition for grids used by + ! the dycore. The decomposed grid object contains data for the elements + ! in each task and information to map that data to the global grid. + ! + ! Notes on dynamic memory management: + ! + ! . Coordinate values and the map passed to the horiz_coord_create + ! method are copied to the object. The memory may be deallocated + ! after the object is created. + ! + ! . The area values passed to cam_grid_attribute_register are only pointed + ! to by the attribute object, so that memory cannot be deallocated. But the + ! map is copied. + ! + ! . The grid_map passed to cam_grid_register is just pointed to. + ! Cannot be deallocated. + + use cam_grid_support, only: horiz_coord_t, horiz_coord_create + use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + use spmd_utils, only: MPI_MAX, MPI_INTEGER, mpicom + + ! Local variables + integer :: i, ii, j, k, ie, mapind + character(len=8) :: latname, lonname, ncolname, areaname + + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + integer(iMap), pointer :: grid_map(:,:) + + real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) + real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) + real(r8), pointer :: pearea(:) => null() ! pe-local areas + real(r8) :: areaw(np,np) + integer(iMap) :: fdofP_local(npsq,nelemd)! pe-local map for dynamics decomp + integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp + + integer :: ncols_fvm, ngcols_fvm + real(r8), allocatable :: fvm_coord(:) + real(r8), pointer :: fvm_area(:) + integer(iMap), pointer :: fvm_map(:) + + integer :: ncols_physgrid, ngcols_physgrid + real(r8), allocatable :: physgrid_coord(:) + real(r8), pointer :: physgrid_area(:) + integer(iMap), pointer :: physgrid_map(:) + !---------------------------------------------------------------------------- + + !----------------------- + ! Create GLL grid object + !----------------------- + + ! Calculate the mapping between element GLL points and file order + fdofp_local = 0 + do ie = 1, nelemd + do ii = 1, elem(ie)%idxP%NumUniquePts + i = elem(ie)%idxP%ia(ii) + j = elem(ie)%idxP%ja(ii) + fdofp_local((np*(j-1))+i,ie) = elem(ie)%idxP%UniquePtoffset + ii - 1 + end do + end do + + allocate(pelat_deg(np*np*nelemd)) + allocate(pelon_deg(np*np*nelemd)) + allocate(pearea(np*np*nelemd)) + allocate(pemap(np*np*nelemd)) + + pemap = 0 + ii = 1 + do ie = 1, nelemd + areaw = 1.0_r8 / elem(ie)%rspheremp(:,:) + pearea(ii:ii+npsq-1) = reshape(areaw, (/ np*np /)) + pemap(ii:ii+npsq-1) = fdofp_local(:,ie) + do j = 1, np + do i = 1, np + pelat_deg(ii) = elem(ie)%spherep(i,j)%lat * rad2deg + pelon_deg(ii) = elem(ie)%spherep(i,j)%lon * rad2deg + ii = ii + 1 + end do + end do + end do + + ! If using the physics grid then the GLL grid will use the names with + ! '_d' suffixes and the physics grid will use the unadorned names. + ! This allows fields on both the GLL and physics grids to be written to history + ! output files. + if (fv_nphys > 0) then + latname = 'lat_d' + lonname = 'lon_d' + ncolname = 'ncol_d' + areaname = 'area_d' + else + latname = 'lat' + lonname = 'lon' + ncolname = 'ncol' + areaname = 'area' + end if + lat_coord => horiz_coord_create(trim(latname), trim(ncolname), ngcols_d, & + 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) + lon_coord => horiz_coord_create(trim(lonname), trim(ncolname), ngcols_d, & + 'longitude', 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) + + ! Map for GLL grid + allocate(grid_map(3,npsq*nelemd)) + grid_map = 0 + mapind = 1 + do j = 1, nelemd + do i = 1, npsq + grid_map(1, mapind) = i + grid_map(2, mapind) = j + grid_map(3, mapind) = pemap(mapind) + mapind = mapind + 1 + end do + end do + + ! The native SE GLL grid + call cam_grid_register('GLL', dyn_decomp, lat_coord, lon_coord, & + grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('GLL', trim(areaname), 'gll grid areas', & + trim(ncolname), pearea, map=pemap) + call cam_grid_attribute_register('GLL', 'np', '', np) + call cam_grid_attribute_register('GLL', 'ne', '', ne) + + ! Coordinate values and maps are copied into the coordinate and attribute objects. + ! Locally allocated storage is no longer needed. + deallocate(pelat_deg) + deallocate(pelon_deg) + deallocate(pemap) + + ! pearea cannot be deallocated as the attribute object is just pointing + ! to that memory. It can be nullified since the attribute object has + ! the reference. + nullify(pearea) + + ! grid_map cannot be deallocated as the cam_filemap_t object just points + ! to it. It can be nullified. + nullify(grid_map) + + !--------------------------------- + ! Create FVM grid object for CSLAM + !--------------------------------- + + if (ntrac > 0) then + + ncols_fvm = nc * nc * nelemd + ngcols_fvm = nc * nc * nelem_d + allocate(fvm_coord(ncols_fvm)) + allocate(fvm_map(ncols_fvm)) + allocate(fvm_area(ncols_fvm)) + + do ie = 1, nelemd + k = 1 + do j = 1, nc + do i = 1, nc + mapind = k + ((ie - 1) * nc * nc) + fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lon*rad2deg + fvm_map(mapind) = k + ((elem(ie)%GlobalId-1) * nc * nc) + fvm_area(mapind) = fvm(ie)%area_sphere(i,j) + k = k + 1 + end do + end do + end do + lon_coord => horiz_coord_create('lon_fvm', 'ncol_fvm', ngcols_fvm, & + 'longitude', 'degrees_east', 1, size(fvm_coord), fvm_coord, & + map=fvm_map) + + do ie = 1, nelemd + k = 1 + do j = 1, nc + do i = 1, nc + mapind = k + ((ie - 1) * nc * nc) + fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lat*rad2deg + k = k + 1 + end do + end do + end do + lat_coord => horiz_coord_create('lat_fvm', 'ncol_fvm', ngcols_fvm, & + 'latitude', 'degrees_north', 1, size(fvm_coord), fvm_coord, & + map=fvm_map) + + ! Map for FVM grid + allocate(grid_map(3, ncols_fvm)) + grid_map = 0 + mapind = 1 + do j = 1, nelemd + do i = 1, nc*nc + grid_map(1, mapind) = i + grid_map(2, mapind) = j + grid_map(3, mapind) = fvm_map(mapind) + mapind = mapind + 1 + end do + end do + + ! create FVM (CSLAM) grid object + call cam_grid_register('FVM', fvm_decomp, lat_coord, lon_coord, & + grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('FVM', 'area_fvm', 'fvm grid areas', & + 'ncol_fvm', fvm_area, map=fvm_map) + call cam_grid_attribute_register('FVM', 'nc', '', nc) + call cam_grid_attribute_register('FVM', 'ne', '', ne) + + deallocate(fvm_coord) + deallocate(fvm_map) + nullify(fvm_area) + nullify(grid_map) + + end if + + !------------------------------------------------------------------ + ! Create grid object for physics grid on the dynamics decomposition + !------------------------------------------------------------------ + + if (fv_nphys > 0) then + + ncols_physgrid = fv_nphys * fv_nphys * nelemd + ngcols_physgrid = fv_nphys * fv_nphys * nelem_d + allocate(physgrid_coord(ncols_physgrid)) + allocate(physgrid_map(ncols_physgrid)) + allocate(physgrid_area(ncols_physgrid)) + + do ie = 1, nelemd + k = 1 + do j = 1, fv_nphys + do i = 1, fv_nphys + mapind = k + ((ie - 1) * fv_nphys * fv_nphys) + physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lon*rad2deg + physgrid_map(mapind) = k + ((elem(ie)%GlobalId-1) * fv_nphys * fv_nphys) + physgrid_area(mapind) = fvm(ie)%area_sphere_physgrid(i,j) + k = k + 1 + end do + end do + end do + lon_coord => horiz_coord_create('lon', 'ncol', ngcols_physgrid, & + 'longitude', 'degrees_east', 1, size(physgrid_coord), physgrid_coord, & + map=physgrid_map) + + do ie = 1, nelemd + k = 1 + do j = 1, fv_nphys + do i = 1, fv_nphys + mapind = k + ((ie - 1) * fv_nphys * fv_nphys) + physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lat*rad2deg + k = k + 1 + end do + end do + end do + lat_coord => horiz_coord_create('lat', 'ncol', ngcols_physgrid, & + 'latitude', 'degrees_north', 1, size(physgrid_coord), physgrid_coord, & + map=physgrid_map) + + ! Map for physics grid + allocate(grid_map(3, ncols_physgrid)) + grid_map = 0 + mapind = 1 + do j = 1, nelemd + do i = 1, fv_nphys*fv_nphys + grid_map(1, mapind) = i + grid_map(2, mapind) = j + grid_map(3, mapind) = physgrid_map(mapind) + mapind = mapind + 1 + end do + end do + + ! create physics grid object + call cam_grid_register('physgrid_d', physgrid_d, lat_coord, lon_coord, & + grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('physgrid_d', 'area_physgrid', 'physics grid areas', & + 'ncol', physgrid_area, map=physgrid_map) + call cam_grid_attribute_register('physgrid_d', 'fv_nphys', '', fv_nphys) + call cam_grid_attribute_register('physgrid_d', 'ne', '', ne) + + deallocate(physgrid_coord) + deallocate(physgrid_map) + nullify(physgrid_area) + nullify(grid_map) + + end if + + nullify(lat_coord) ! Belongs to grid + nullify(lon_coord) ! Belongs to grid + +end subroutine define_cam_grids + +!======================================================================================== + +subroutine write_grid_mapping(par, elem) + + use parallel_mod, only: parallel_t + use cam_pio_utils, only: cam_pio_createfile, pio_subsystem + use pio, only: pio_def_dim, var_desc_t, pio_int, pio_def_var, & + pio_enddef, pio_closefile, pio_initdecomp, io_desc_t, & + pio_write_darray, pio_freedecomp + use dof_mod, only: createmetadata + + ! arguments + type(parallel_t), intent(in) :: par + type(element_t), intent(in) :: elem(:) + + ! local variables + integer, parameter :: npm12 = (np-1)*(np-1) + + type(file_desc_t) :: nc + type(var_desc_t) :: vid + type(io_desc_t) :: iodesc + integer :: dim1, dim2, ierr, i, j, ie, cc, base, ii, jj + integer :: subelement_corners(npm12*nelemd,4) + integer :: dof(npm12*nelemd*4) + !---------------------------------------------------------------------------- + + ! Create a CS grid mapping file for postprocessing tools + + ! write meta data for physics on GLL nodes + call cam_pio_createfile(nc, 'SEMapping.nc', 0) + + ierr = pio_def_dim(nc, 'ncenters', npm12*nelem_d, dim1) + ierr = pio_def_dim(nc, 'ncorners', 4, dim2) + ierr = pio_def_var(nc, 'element_corners', PIO_INT, (/dim1,dim2/), vid) + + ierr = pio_enddef(nc) + call createmetadata(par, elem, subelement_corners) + + jj=0 + do cc = 0, 3 + do ie = 1, nelemd + base = ((elem(ie)%globalid-1)+cc*nelem_d)*npm12 + ii=0 + do j = 1, np-1 + do i = 1, np-1 + ii=ii+1 + jj=jj+1 + dof(jj) = base+ii + end do + end do + end do + end do + + call pio_initdecomp(pio_subsystem, pio_int, (/nelem_d*npm12,4/), dof, iodesc) + + call pio_write_darray(nc, vid, iodesc, & + reshape(subelement_corners, (/nelemd*npm12*4/)), ierr) + + call pio_freedecomp(nc, iodesc) + + call pio_closefile(nc) + +end subroutine write_grid_mapping + +!========================================================================================= + +subroutine gblocks_init() + + ! construct global array of type block_global_data objects for GLL grid + + integer :: ie, p + integer :: ibuf + integer :: ierr + integer :: rdispls(npes), recvcounts(npes), gid(npes), lid(npes) + !---------------------------------------------------------------------------- + + if (.not. allocated(gblocks)) then + if (masterproc) then + write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in SE dycore.' + end if + allocate(gblocks(nelem_d)) + do ie = 1, nelem_d + gblocks(ie)%Owner = -1 + gblocks(ie)%UniquePtOffset = -1 + gblocks(ie)%NumUniqueP = -1 + gblocks(ie)%LocalID = -1 + end do + end if + + ! nelemdmax is the maximum number of elements in a dynamics task + ! nelemd is the actual number of elements in a dynamics task + + do ie = 1, nelemdmax + + if (ie <= nelemd) then + rdispls(iam+1) = elem(ie)%idxP%UniquePtOffset - 1 + gid(iam+1) = elem(ie)%GlobalID + lid(iam+1) = ie + recvcounts(iam+1) = elem(ie)%idxP%NumUniquePts + else + rdispls(iam+1) = 0 + recvcounts(iam+1) = 0 + gid(iam+1) = 0 + endif + + ibuf = lid(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, lid, 1, mpi_integer, mpicom, ierr) + + ibuf = gid(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, gid, 1, mpi_integer, mpicom, ierr) + + ibuf = rdispls(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, rdispls, 1, mpi_integer, mpicom, ierr) + + ibuf = recvcounts(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, recvcounts, 1, mpi_integer, mpicom, ierr) + + do p = 1, npes + if (gid(p) > 0) then + gblocks(gid(p))%UniquePtOffset = rdispls(p) + 1 + gblocks(gid(p))%NumUniqueP = recvcounts(p) + gblocks(gid(p))%LocalID = lid(p) + gblocks(gid(p))%Owner = p - 1 + end if + end do + end do + +end subroutine gblocks_init + +!========================================================================================= + +subroutine create_global_area(area_d) + + ! Gather global array of column areas for the physics grid, + ! reorder to global column order, then broadcast it to all tasks. + + ! Input variables + real(r8), pointer :: area_d(:) + + ! Local variables + real(r8) :: areaw(np,np) + real(r8), allocatable :: rbuf(:), dp_area(:,:) + integer :: rdispls(npes), recvcounts(npes) + integer :: ncol + integer :: ie, sb, eb, i, j, k + integer :: ierr + integer :: ibuf + character(len=*), parameter :: sub = 'create_global_area' + !---------------------------------------------------------------------------- + + if (masterproc) then + write(iulog, *) sub//': INFO: Non-scalable action: gathering global area in SE dycore.' + end if + + if (fv_nphys > 0) then ! physics uses an FVM grid + + ! first gather all data onto masterproc, in mpi task order (via + ! mpi_gatherv) then redorder into globalID order (via dp_reoorder) + ncol = fv_nphys*fv_nphys*nelem_d + allocate(rbuf(ncol)) + allocate(dp_area(fv_nphys*fv_nphys,nelem_d)) + + do ie = 1, nelemd + k = 1 + do j = 1, fv_nphys + do i = 1, fv_nphys + dp_area(k,ie) = fvm(ie)%area_sphere_physgrid(i,j) + k = k + 1 + end do + end do + end do + + call mpi_gather(nelemd*fv_nphys*fv_nphys, 1, mpi_integer, recvcounts, 1, & + mpi_integer, mstrid, mpicom, ierr) + ! Figure global displacements + if (masterproc) then + rdispls(1) = 0 + do ie = 2, npes + rdispls(ie) = rdispls(ie-1) + recvcounts(ie-1) + end do + ! Check to make sure we counted correctly + if (rdispls(npes) + recvcounts(npes) /= ncol) then + call endrun(sub//': bad rdispls array size') + end if + end if + + ! Gather up the areas onto the masterproc + call mpi_gatherv(dp_area, fv_nphys*fv_nphys*nelemd, mpi_real8, rbuf, & + recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) + + ! Reorder to global order + if (masterproc) call dp_reoorder(rbuf, area_d) + + ! Send everyone else the data + call mpi_bcast(area_d, ncol, mpi_real8, mstrid, mpicom, ierr) + + deallocate(dp_area) + + else ! physics is on the GLL grid + + allocate(rbuf(ngcols_d)) + do ie = 1, nelemdmax + if (ie <= nelemd) then + rdispls(iam+1) = elem(ie)%idxp%UniquePtOffset - 1 + eb = rdispls(iam+1) + elem(ie)%idxp%NumUniquePts + recvcounts(iam+1) = elem(ie)%idxP%NumUniquePts + areaw = 1.0_r8 / elem(ie)%rspheremp(:,:) + call UniquePoints(elem(ie)%idxP, areaw, area_d(rdispls(iam+1)+1:eb)) + else + rdispls(iam+1) = 0 + recvcounts(iam+1) = 0 + end if + + ibuf = rdispls(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, rdispls, & + 1, mpi_integer, mpicom, ierr) + + ibuf = recvcounts(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, recvcounts, & + 1, mpi_integer, mpicom, ierr) + + sb = rdispls(iam+1) + 1 + eb = rdispls(iam+1) + recvcounts(iam+1) + + rbuf(1:recvcounts(iam+1)) = area_d(sb:eb) + call mpi_allgatherv(rbuf, recvcounts(iam+1), mpi_real8, area_d, & + recvcounts(:), rdispls(:), mpi_real8, mpicom, ierr) + end do + + end if + + deallocate(rbuf) + +end subroutine create_global_area + +!========================================================================================= + +subroutine create_global_coords(clat, clon, lat_out, lon_out) + + ! Gather global arrays of column coordinates for the physics grid, + ! reorder to global column order, then broadcast to all tasks. + + ! arguments + real(r8), intent(out) :: clat(:) + real(r8), intent(out) :: clon(:) + real(r8), optional, intent(out) :: lat_out(:) + real(r8), optional, intent(out) :: lon_out(:) + + ! Local variables + real(r8), allocatable :: rbuf(:), dp_lon(:,:), dp_lat(:,:) + integer :: rdispls(npes), recvcounts(npes) + integer :: ie, sb, eb, i, j, k + integer :: ierr + integer :: ibuf + integer :: ncol + character(len=*), parameter :: sub='create_global_coords' + !---------------------------------------------------------------------------- + + if (masterproc) then + write(iulog, *) sub//': INFO: Non-scalable action: Creating global coords in SE dycore.' + end if + + clat(:) = -iam + clon(:) = -iam + if (present(lon_out)) then + lon_out(:) = -iam + end if + if (present(lat_out)) then + lat_out(:) = -iam + end if + + if (fv_nphys > 0) then ! physics uses an FVM grid + + ! first gather all data onto masterproc, in mpi task order (via + ! mpi_gatherv) then redorder into globalID order (via dp_reoorder) + + ncol = fv_nphys*fv_nphys*nelem_d + allocate(rbuf(ncol)) + allocate(dp_lon(fv_nphys*fv_nphys,nelem_d)) + allocate(dp_lat(fv_nphys*fv_nphys,nelem_d)) + + do ie = 1, nelemd + k = 1 + do j = 1, fv_nphys + do i = 1, fv_nphys + dp_lon(k,ie) = fvm(ie)%center_cart_physgrid(i,j)%lon ! radians + dp_lat(k,ie) = fvm(ie)%center_cart_physgrid(i,j)%lat + k = k + 1 + end do + end do + end do + + call mpi_gather(nelemd*fv_nphys*fv_nphys, 1, mpi_integer, recvcounts, & + 1, mpi_integer, mstrid, mpicom, ierr) + + ! Figure global displacements + if (masterproc) then + rdispls(1) = 0 + do ie = 2, npes + rdispls(ie) = rdispls(ie-1) + recvcounts(ie-1) + end do + ! Check to make sure we counted correctly + if (rdispls(npes) + recvcounts(npes) /= ncol) then + call endrun(sub//': bad rdispls array size') + end if + end if + + ! Gather up global latitudes + call mpi_gatherv(dp_lat, fv_nphys*fv_nphys*nelemd, mpi_real8, rbuf, & + recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) + + ! Reorder to global order + if (masterproc) call dp_reoorder(rbuf, clat) + + ! Send everyone else the data + call mpi_bcast(clat, ncol, mpi_real8, mstrid, mpicom, ierr) + + ! Gather up global longitudes + call mpi_gatherv(dp_lon, fv_nphys*fv_nphys*nelemd, mpi_real8, rbuf, & + recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) + + ! Reorder to global order + if (masterproc) call dp_reoorder(rbuf, clon) + + ! Send everyone else the data + call mpi_bcast(clon, ncol, mpi_real8, mstrid, mpicom, ierr) + + ! Create degree versions if requested + if (present(lat_out)) then + lat_out(:) = clat(:) * rad2deg + end if + if (present(lon_out)) then + lon_out(:) = clon(:) * rad2deg + end if + + deallocate(dp_lon) + deallocate(dp_lat) + + else ! physics uses the GLL grid + + allocate(rbuf(ngcols_d)) + + do ie = 1, nelemdmax + + if(ie <= nelemd) then + rdispls(iam+1) = elem(ie)%idxp%UniquePtOffset - 1 + eb = rdispls(iam+1) + elem(ie)%idxp%NumUniquePts + recvcounts(iam+1) = elem(ie)%idxP%NumUniquePts + + call UniqueCoords(elem(ie)%idxP, elem(ie)%spherep, & + clat(rdispls(iam+1)+1:eb), clon(rdispls(iam+1)+1:eb)) + + if (present(lat_out)) then + lat_out(rdispls(iam+1)+1:eb) = clat(rdispls(iam+1)+1:eb) * rad2deg + end if + + if (present(lon_out)) then + lon_out(rdispls(iam+1)+1:eb) = clon(rdispls(iam+1)+1:eb) * rad2deg + end if + + else + rdispls(iam+1) = 0 + recvcounts(iam+1) = 0 + end if + + ibuf = rdispls(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, rdispls, & + 1, mpi_integer, mpicom, ierr) + + ibuf = recvcounts(iam+1) + call mpi_allgather(ibuf, 1, mpi_integer, recvcounts, & + 1, mpi_integer, mpicom, ierr) + + sb = rdispls(iam+1) + 1 + eb = rdispls(iam+1) + recvcounts(iam+1) + + rbuf(1:recvcounts(iam+1)) = clat(sb:eb) ! whats going to happen if end=0? + call mpi_allgatherv(rbuf, recvcounts(iam+1), mpi_real8, clat, & + recvcounts(:), rdispls(:), mpi_real8, mpicom, ierr) + + if (present(lat_out)) then + rbuf(1:recvcounts(iam+1)) = lat_out(sb:eb) + call mpi_allgatherv(rbuf, recvcounts(iam+1), mpi_real8, lat_out, & + recvcounts(:), rdispls(:), mpi_real8, mpicom, ierr) + end if + + rbuf(1:recvcounts(iam+1)) = clon(sb:eb) + call mpi_allgatherv(rbuf, recvcounts(iam+1), mpi_real8, clon, & + recvcounts(:), rdispls(:), mpi_real8, mpicom, ierr) + + if (present(lon_out)) then + rbuf(1:recvcounts(iam+1)) = lon_out(sb:eb) + call mpi_allgatherv(rbuf, recvcounts(iam+1), mpi_real8, lon_out, & + recvcounts(:), rdispls(:), mpi_real8, mpicom, ierr) + end if + + end do ! ie = 1, nelemdmax + + end if ! (fv_nphys > 0) + +end subroutine create_global_coords + +!========================================================================================= + +end module dyn_grid diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 new file mode 100644 index 0000000000..4f981e2f7a --- /dev/null +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -0,0 +1,215 @@ +module gravity_waves_sources + use derivative_mod, only: derivative_t + use dimensions_mod, only: np,nlev + use edgetype_mod, only: EdgeBuffer_t + use element_mod, only: element_t + use hybrid_mod, only: hybrid_t + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + save + + !! gravity_waves_sources created by S Santos, 10 Aug 2011 + !! + !! gws_src_fnct starts parallel environment and computes frontogenesis + !! for use by WACCM (via dp_coupling) + + public :: gws_src_fnct + public :: gws_init + private :: compute_frontogenesis + + type (EdgeBuffer_t) :: edge3 + type (derivative_t) :: deriv + real(r8) :: psurf_ref + +!---------------------------------------------------------------------- +CONTAINS +!---------------------------------------------------------------------- + + subroutine gws_init(elem) + use parallel_mod, only : par + use edge_mod, only : initEdgeBuffer + use hycoef, only : hypi + use pmgrid, only : plev + use thread_mod, only : horz_num_threads + implicit none + + ! Elem will be needed for future updates to edge code + type(element_t), pointer :: elem(:) + + ! Set up variables similar to dyn_comp and prim_driver_mod initializations + call initEdgeBuffer(par, edge3, elem, 3*nlev,nthreads=horz_num_threads) + + psurf_ref = hypi(plev+1) + + end subroutine gws_init + + subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga,nphys) + use derivative_mod, only : derivinit + use dimensions_mod, only : npsq, nelemd + use dof_mod, only : UniquePoints + use hybrid_mod, only : config_thread_region, get_loop_ranges + use parallel_mod, only : par + use ppgrid, only : pver + use thread_mod, only : horz_num_threads + use dimensions_mod, only : fv_nphys + implicit none + type (element_t), intent(inout), dimension(:) :: elem + integer, intent(in) :: tl, nphys, tlq + real (kind=r8), intent(out) :: frontgf(nphys*nphys,pver,nelemd) + real (kind=r8), intent(out) :: frontga(nphys*nphys,pver,nelemd) + + ! Local variables + type (hybrid_t) :: hybrid + integer :: nets, nete, ithr, ncols, ie + real(kind=r8), allocatable :: frontgf_thr(:,:,:,:) + real(kind=r8), allocatable :: frontga_thr(:,:,:,:) + + ! This does not need to be a thread private data-structure + call derivinit(deriv) + !$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(nets,nete,hybrid,ie,ncols,frontgf_thr,frontga_thr) + hybrid = config_thread_region(par,'horizontal') +!JMD hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + + allocate(frontgf_thr(nphys,nphys,nlev,nets:nete)) + allocate(frontga_thr(nphys,nphys,nlev,nets:nete)) + call compute_frontogenesis(frontgf_thr,frontga_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys) + if (fv_nphys>0) then + do ie=nets,nete + frontgf(:,:,ie) = RESHAPE(frontgf_thr(:,:,:,ie),(/nphys*nphys,nlev/)) + frontga(:,:,ie) = RESHAPE(frontga_thr(:,:,:,ie),(/nphys*nphys,nlev/)) + end do + else + do ie=nets,nete + ncols = elem(ie)%idxP%NumUniquePts + call UniquePoints(elem(ie)%idxP, nlev, frontgf_thr(:,:,:,ie), frontgf(1:ncols,:,ie)) + call UniquePoints(elem(ie)%idxP, nlev, frontga_thr(:,:,:,ie), frontga(1:ncols,:,ie)) + end do + end if + deallocate(frontga_thr) + deallocate(frontgf_thr) + !$OMP END PARALLEL + + end subroutine gws_src_fnct + + subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets,nete,nphys) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! compute frontogenesis function F + ! F = -gradth dot C + ! with: + ! theta = potential temperature + ! gradth = grad(theta) + ! C = ( gradth dot grad ) U + ! + ! Original by Mark Taylor, July 2011 + ! Change by Santos, 10 Aug 2011: + ! Integrated into gravity_waves_sources module, several arguments made global + ! to prevent repeated allocation/initialization + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + use physconst, only: cappa + use derivative_mod, only: gradient_sphere, ugradv_sphere + use edge_mod, only: edgevpack, edgevunpack + use bndry_mod, only: bndry_exchange + use dyn_grid, only: hvcoord + use dimensions_mod, only: fv_nphys,ntrac + use dimensions_mod, only: qsize_condensate_loading_idx_gll,qsize_condensate_loading + use fvm_mapping, only: dyn2phys_vector,dyn2phys + + type(hybrid_t), intent(in) :: hybrid + type(element_t), intent(inout), target :: elem(:) + type(derivative_t), intent(in) :: ederiv + integer, intent(in) :: nets,nete,nphys + integer, intent(in) :: tl,tlq + real(r8), intent(out) :: frontgf(nphys,nphys,nlev,nets:nete) + real(r8), intent(out) :: frontga(nphys,nphys,nlev,nets:nete) + + ! local + real(r8) :: area_inv(fv_nphys,fv_nphys), tmp(np,np) + real(r8) :: uv_tmp(fv_nphys*fv_nphys,2,nlev) + real(r8) :: frontgf_gll(np,np,nlev,nets:nete) + real(r8) :: frontga_gll(np,np,nlev,nets:nete) + integer :: k,kptr,i,j,ie,component,h,nq,m_cnst + real(r8) :: gradth(np,np,2,nlev,nets:nete) ! grad(theta) + real(r8) :: p(np,np) ! pressure at mid points + real(r8) :: pint(np,np) ! pressure at interface points + real(r8) :: theta(np,np) ! potential temperature at mid points + real(r8) :: C(np,np,2), sum_water(np,np) + + do ie=nets,nete + ! pressure at model top + pint(:,:) = hvcoord%hyai(1) + do k=1,nlev + ! moist pressure at mid points + sum_water(:,:) = 1.0_r8 + do nq=1,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + ! + ! make sure Q is updated + ! + sum_water(:,:) = sum_water(:,:) + elem(ie)%state%Qdp(:,:,k,m_cnst,tlq)/elem(ie)%state%dp3d(:,:,k,tl) + end do + p(:,:) = pint(:,:) + 0.5_r8*sum_water(:,:)*elem(ie)%state%dp3d(:,:,k,tl) + ! moist pressure at interface for next iteration + pint(:,:) = pint(:,:)+elem(ie)%state%dp3d(:,:,k,tl) + ! + theta(:,:) = elem(ie)%state%T(:,:,k,tl)*(psurf_ref / p(:,:))**cappa + ! gradth(:,:,:,k,ie) = gradient_sphere(theta,ederiv,elem(ie)%Dinv) + call gradient_sphere(theta,ederiv,elem(ie)%Dinv,gradth(:,:,:,k,ie)) + ! compute C = (grad(theta) dot grad ) u + C(:,:,:) = ugradv_sphere(gradth(:,:,:,k,ie), elem(ie)%state%v(:,:,:,k,tl),ederiv,elem(ie)) + ! gradth dot C + frontgf_gll(:,:,k,ie) = -( C(:,:,1)*gradth(:,:,1,k,ie) + C(:,:,2)*gradth(:,:,2,k,ie) ) + ! apply mass matrix + gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%spheremp(:,:) + gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%spheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) + enddo + ! pack + call edgeVpack(edge3, frontgf_gll(:,:,:,ie),nlev,0,ie) + call edgeVpack(edge3, gradth(:,:,:,:,ie),2*nlev,nlev,ie) + enddo + call bndry_exchange(hybrid,edge3,location='compute_frontogenesis') + do ie=nets,nete + call edgeVunpack(edge3, frontgf_gll(:,:,:,ie),nlev,0,ie) + call edgeVunpack(edge3, gradth(:,:,:,:,ie),2*nlev,nlev,ie) + ! apply inverse mass matrix, + do k=1,nlev + gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%rspheremp(:,:) + gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%rspheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) + end do + if (fv_nphys>0) then + uv_tmp(:,:,:) = dyn2phys_vector(gradth(:,:,:,:,ie),elem(ie)) + do k=1,nlev + h=0 + do j=1,fv_nphys + do i=1,fv_nphys + h=h+1 + frontga(i,j,k,ie) = atan2 ( uv_tmp(h,2,k) , uv_tmp(h,1,k) + 1.e-10_r8 ) + end do + end do + end do + ! + ! compute inverse physgrid area for mapping of scaler + ! + tmp = 1.0_r8 + area_inv = dyn2phys(tmp,elem(ie)%metdet) + area_inv = 1.0_r8/area_inv + do k=1,nlev + frontgf(:,:,k,ie) = dyn2phys(frontgf_gll(:,:,k,ie),elem(ie)%metdet,area_inv) + end do + else + do k=1,nlev + frontgf(:,:,k,ie)=frontgf_gll(:,:,k,ie) + ! Frontogenesis angle + frontga(:,:,k,ie) = atan2 ( gradth(:,:,2,k,ie) , gradth(:,:,1,k,ie) + 1.e-10_r8 ) + end do + end if + enddo + end subroutine compute_frontogenesis + + +end module gravity_waves_sources diff --git a/src/dynamics/se/interp_mod.F90 b/src/dynamics/se/interp_mod.F90 new file mode 100644 index 0000000000..1e5bc380de --- /dev/null +++ b/src/dynamics/se/interp_mod.F90 @@ -0,0 +1,769 @@ +module interp_mod + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8 + use dimensions_mod, only: nelemd, np, ne + use interpolate_mod, only: interpdata_t + use interpolate_mod, only: interp_lat => lat, interp_lon => lon + use interpolate_mod, only: interp_gweight => gweight + use dyn_grid, only: elem,fvm + use spmd_utils, only: masterproc, iam + use cam_history_support, only: fillvalue + use hybrid_mod, only: hybrid_t, config_thread_region + use cam_abortutils, only: endrun + + implicit none + private + save + + public :: setup_history_interpolation + public :: set_interp_hfile + public :: write_interpolated + + interface write_interpolated + module procedure write_interpolated_scalar + module procedure write_interpolated_vector + end interface + + ! hybrid is created in setup_history_interpolation + type(hybrid_t) :: hybrid + +! A type to hold interpdata info for each interpolated history file +type cam_interpolate_t + type(interpdata_t), pointer :: interpdata(:) => NULL() +end type cam_interpolate_t + +type(cam_interpolate_t), pointer :: interpdata_set(:) => NULL() ! all files +type(interpdata_t), pointer :: cam_interpolate(:) => NULL() ! curr. file + +CONTAINS + + subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & + interp_info) + + use cam_history_support, only: interp_info_t + use cam_history_support, only: interp_type_native + use cam_history_support, only: interp_type_bilinear + use cam_history_support, only: interp_gridtype_equal_poles + use cam_history_support, only: interp_gridtype_gauss + use cam_history_support, only: interp_gridtype_equal_nopoles + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap + use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + use cam_grid_support, only: max_hcoordname_len + use interpolate_mod, only: get_interp_lat, get_interp_lon + use interpolate_mod, only: get_interp_parameter, set_interp_parameter + use interpolate_mod, only: get_interp_gweight, setup_latlon_interp + use parallel_mod, only: par + use thread_mod, only: omp_get_thread_num + + ! Dummy arguments + logical, intent(inout) :: interp_ok + integer, intent(in) :: mtapes + logical, intent(in) :: interp_output(:) + type(interp_info_t), intent(inout) :: interp_info(:) + + ! Local variables + integer :: ithr, i, j + real(r8), pointer :: w(:) + integer(iMap), pointer :: grid_map(:,:) + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + character(len=max_hcoordname_len) :: gridname + + if (associated(cam_interpolate)) then + do i = 1, size(cam_interpolate) +!JMD This is strange ithr used before it is set + ithr = 0 + if (associated(interpdata_set(ithr)%interpdata)) then + deallocate(interpdata_set(ithr)%interpdata) + nullify(interpdata_set(ithr)%interpdata) + end if + end do + deallocate(cam_interpolate) + nullify(cam_interpolate) + end if + nullify(grid_map) + + ! For this dycore, interpolated output should be OK + interp_ok = (iam < par%nprocs) + + if (interp_ok) then + hybrid = config_thread_region(par,'serial') +! ithr = omp_get_thread_num() +! hybrid = hybrid_create(par,ithr,1) + + if(any(interp_output)) then + allocate(interpdata_set(mtapes)) + do i = 1, mtapes + if (interp_output(i)) then + if ( (interp_info(i)%interp_nlon == 0) .or. & + (interp_info(i)%interp_nlat == 0)) then + ! compute interpolation grid based on number of points around equator + call set_interp_parameter('auto', (4 * ne * (np-1))) + interp_info(i)%interp_nlat = get_interp_parameter('nlat') + interp_info(i)%interp_nlon = get_interp_parameter('nlon') + else + call set_interp_parameter('nlat', interp_info(i)%interp_nlat) + call set_interp_parameter('nlon', interp_info(i)%interp_nlon) + end if + call set_interp_parameter('itype', interp_info(i)%interp_type) + call set_interp_parameter('gridtype', interp_info(i)%interp_gridtype) + + allocate(interpdata_set(i)%interpdata(nelemd)) + ! Reset pointers in the interpolate module so they are not + ! overwritten + nullify(interp_lat) + nullify(interp_lon) + nullify(interp_gweight) + call setup_latlon_interp(elem, interpdata_set(i)%interpdata, par) + ! Create the grid coordinates + lat_coord => horiz_coord_create('lat', '', & + interp_info(i)%interp_nlat, 'latitude', 'degrees_north', & + 1, interp_info(i)%interp_nlat, get_interp_lat()) + lon_coord => horiz_coord_create('lon', '', & + interp_info(i)%interp_nlon, 'longitude', 'degrees_east', & + 1, interp_info(i)%interp_nlon, get_interp_lon()) + ! Create a grid for this history file + write(gridname, '(a,i0)') 'interp_out_', i + interp_info(i)%grid_id = 200 + i + call cam_grid_register(trim(gridname), interp_info(i)%grid_id, & + lat_coord, lon_coord, grid_map, unstruct=.false.) + interp_info(i)%gridname = trim(gridname) + ! Add grid attributes + allocate(w(get_interp_parameter('nlat'))) + w = get_interp_gweight() + select case(interp_info(i)%interp_gridtype) + case(interp_gridtype_equal_poles) + call cam_grid_attribute_register(trim(gridname), & + 'interp_outputgridtype', 'equally spaced with poles') + call cam_grid_attribute_register(trim(gridname), 'w', & + 'latitude weights', 'lat', w) + case(interp_gridtype_equal_nopoles) + call cam_grid_attribute_register(trim(gridname), & + 'interp_outputgridtype', 'equally spaced no poles') + call cam_grid_attribute_register(trim(gridname), 'gw', & + 'latitude weights', 'lat', w) + case(interp_gridtype_gauss) + call cam_grid_attribute_register(trim(gridname), & + 'interp_outputgridtype', 'Gauss') + call cam_grid_attribute_register(trim(gridname), 'gw', & + 'gauss weights', 'lat', w) + case default + call cam_grid_attribute_register(trim(gridname), & + 'interp_outputgridtype', & + 'Unknown interpolation output grid type', & + interp_info(i)%interp_gridtype) + end select + nullify(w) ! belongs to attribute + if(interp_info(i)%interp_type == interp_type_native) then + call cam_grid_attribute_register(trim(gridname), & + 'interp_type', 'se basis functions') + else if(interp_info(i)%interp_type == interp_type_bilinear) then + call cam_grid_attribute_register(trim(gridname), & + 'interp_type', 'bilinear') + else + call cam_grid_attribute_register(trim(gridname), 'interp_type', & + 'Unknown interpolation type', interp_info(i)%interp_type) + end if + ! Store the data pointers for reuse later + interp_info(i)%interp_lat => interp_lat + interp_info(i)%interp_lon => interp_lon + interp_info(i)%interp_gweight => interp_gweight + end if + end do + end if + end if + + end subroutine setup_history_interpolation + + subroutine set_interp_hfile(hfilenum, interp_info) + use cam_history_support, only: interp_info_t + use interpolate_mod, only: set_interp_parameter + + ! Dummy arguments + integer, intent(in) :: hfilenum + type(interp_info_t), intent(inout) :: interp_info(:) + + if (.not. associated(interpdata_set)) then + call endrun('SET_INTERP_HFILE: interpdata_set not allocated') + else if ((hfilenum < 1) .or. (hfilenum > size(interpdata_set))) then + call endrun('SET_INTERP_HFILE: hfilenum out of range') + else if (hfilenum > size(interp_info)) then + call endrun('SET_INTERP_HFILE: hfilenum out of range') + else + cam_interpolate => interpdata_set(hfilenum)%interpdata + interp_lat => interp_info(hfilenum)%interp_lat + interp_lon => interp_info(hfilenum)%interp_lon + interp_gweight => interp_info(hfilenum)%interp_gweight + call set_interp_parameter('nlat', interp_info(hfilenum)%interp_nlat) + call set_interp_parameter('nlon', interp_info(hfilenum)%interp_nlon) + call set_interp_parameter('itype', interp_info(hfilenum)%interp_type) + call set_interp_parameter('gridtype', interp_info(hfilenum)%interp_gridtype) + end if + end subroutine set_interp_hfile + + subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) + use pio, only: file_desc_t, var_desc_t + use pio, only: iosystem_desc_t + use pio, only: pio_initdecomp, pio_freedecomp + use pio, only: io_desc_t, pio_write_darray + use interpolate_mod, only: interpolate_scalar + use cam_instance, only: atm_id + use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs + use ppgrid, only: begchunk, endchunk, pcols, pverp, pver + use phys_grid, only: get_gcol_all_p, get_ncols_p, chunk_to_block_send_pters, chunk_to_block_recv_pters, & + transpose_chunk_to_block + use dyn_grid, only: get_gcol_block_d + use dimensions_mod, only: npsq, fv_nphys,nc,nhc,nhc_phys + use dof_mod, only: PutUniquePoints + use interpolate_mod, only: get_interp_parameter + use shr_pio_mod, only: shr_pio_getiosys + use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, freeedgebuffer + use edgetype_mod, only: EdgeBuffer_t + use bndry_mod, only: bndry_exchange + use parallel_mod, only: par + use thread_mod, only: horz_num_threads + use cam_grid_support, only: cam_grid_id + use hybrid_mod, only: hybrid_t,config_thread_region, get_loop_ranges + use fvm_mapping, only: fvm2dyn,phys2dyn + use fvm_mod, only: fill_halo_and_extend_panel + + type(file_desc_t), intent(inout) :: File + type(var_desc_t) , intent(inout) :: varid + real(r8), intent(in) :: fld(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + ! + ! local variables + ! + type(io_desc_t) :: iodesc + type(hybrid_t) :: hybrid + type(iosystem_desc_t), pointer :: pio_subsystem + type (EdgeBuffer_t) :: edgebuf ! edge buffer + + + integer :: lchnk, i, j, icol, ncols, pgcols(pcols), ierr + integer :: idmb1(1), idmb2(1), idmb3(1), nets, nete + integer, allocatable :: bpter(:,:)! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + integer :: phys_decomp, fvm_decomp,gll_decomp + + real(r8), pointer :: dest(:,:,:,:) + real(r8), pointer :: bbuffer(:), cbuffer(:), fldout(:,:) + real(r8), allocatable :: fld_dyn(:,:,:), fld_tmp(:,:,:,:,:) + + integer :: st, en, ie, ioff, ncnt_out, k + integer, pointer :: idof(:) + integer :: nlon, nlat, ncol,nsize,nhalo,nhcc + logical :: usefillvalues + + usefillvalues=.false. + + phys_decomp = cam_grid_id('physgrid') + fvm_decomp = cam_grid_id('FVM') + gll_decomp = cam_grid_id('GLL') + ! + ! There are 2 main scenarios regarding decomposition: + ! + ! decomp_type==phys_decomp: we need to move data from physics decomposition to dynamics decomposition + ! else : data is on dynamics decomposition + ! + if (decomp_type==phys_decomp) then + if (fv_nphys>0) then + ! + ! note that even if fv_nphys<4 then SIZE(fld,DIM=1)=PCOLS + ! + nsize = fv_nphys + nhalo = 1!for bilinear only a halo of 1 is needed + nhcc = nhc_phys + else + nsize = np + nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) + nhcc = 0 + end if + else if (decomp_type==fvm_decomp) then + ! + ! CSLAM grid output + ! + nsize = nc + nhalo = 1!for bilinear only a halo of 1 is needed + nhcc = nhc + else if (decomp_type==gll_decomp) then + nsize = np + nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) + nhcc = 0 + else + call endrun('write_interpolated_scalar: unknown decomp_type') + end if + allocate(fld_dyn(nsize*nsize,numlev,nelemd)) + allocate(fld_tmp(1-nhcc:nsize+nhcc,1-nhcc:nsize+nhcc,numlev,1,nelemd)) + allocate(dest(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,numlev,nelemd)) + + nlon=get_interp_parameter('nlon') + nlat=get_interp_parameter('nlat') + pio_subsystem => shr_pio_getiosys(atm_id) + + if(decomp_type==phys_decomp) then + fld_dyn = -999_R8 + if(local_dp_map) then + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff,k) + do lchnk=begchunk,endchunk + ncols=get_ncols_p(lchnk) + call get_gcol_all_p(lchnk,pcols,pgcols) + if (fv_nphys>0) ncols = fv_nphys*fv_nphys + do icol=1,ncols + call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) + ie = idmb3(1) + ioff=idmb2(1) + do k=1,numlev + fld_dyn(ioff,k,ie) = fld(icol, k, lchnk-begchunk+1) + end do + end do + end do + else + allocate( bbuffer(block_buf_nrecs*numlev) )!xxx Steve: this is different that dp_coupling? (no numlev in dp_coupling) + allocate( cbuffer(chunk_buf_nrecs*numlev) ) + + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, i, k, icol) + do lchnk = begchunk,endchunk + ncols = get_ncols_p(lchnk) + + call chunk_to_block_send_pters(lchnk,pcols,pverp,1,cpter) + + do i=1,ncols + cbuffer(cpter(i,1):cpter(i,1)) = 0.0_r8 + end do + + do k=1,numlev + do icol=1,ncols + cbuffer(cpter(icol,k-1)) = fld(icol,k,lchnk-begchunk+1) + end do + end do + + end do + + call transpose_chunk_to_block(1, cbuffer, bbuffer) + if(iam < par%nprocs) then + if (fv_nphys>0) then + allocate(bpter(fv_nphys*fv_nphys,0:pver)) + else + allocate(bpter(npsq,0:pver)) + end if + !$omp parallel do num_threads(horz_num_threads) private (ie, bpter, k, ncols, icol) + do ie=1,nelemd + if (fv_nphys>0) then + call chunk_to_block_recv_pters(elem(ie)%GlobalID,fv_nphys*fv_nphys,pverp,1,bpter) + ncols = fv_nphys*fv_nphys + else + call chunk_to_block_recv_pters(elem(ie)%GlobalID,npsq,pverp,1,bpter) + ncols = elem(ie)%idxp%NumUniquePts + end if + do k = 1, numlev + do icol=1,ncols + fld_dyn(icol,k,ie) = bbuffer(bpter(icol,k-1)) + end do + end do + end do + end if + deallocate( bbuffer ) + deallocate( cbuffer ) + deallocate( bpter ) + + end if!local_dp_map + if (fv_nphys>0) then + do ie = 1, nelemd + fld_tmp(1:nsize,1:nsize,:,1,ie) = RESHAPE(fld_dyn(:,:,ie),(/nsize,nsize,numlev/)) + end do + else + call initEdgeBuffer(par, edgebuf, elem, numlev,nthreads=1) + + do ie=1,nelemd + ncols = elem(ie)%idxp%NumUniquePts + call putUniquePoints(elem(ie)%idxP, numlev, fld_dyn(1:ncols,1:numlev,ie), fld_tmp(:,:,1:numlev,1,ie)) + call edgeVpack(edgebuf, fld_tmp(:,:,1:numlev,1,ie), numlev, 0, ie) + end do + if(iam < par%nprocs) then + call bndry_exchange(par, edgebuf,location='write_interpolated_scalar') + end if + do ie=1,nelemd + call edgeVunpack(edgebuf, fld_tmp(:,:,1:numlev,1,ie), numlev, 0, ie) + end do + call freeEdgeBuffer(edgebuf) + usefillvalues = any(fld_tmp == fillvalue) + end if + else + ! + ! not physics decomposition + ! + do ie = 1, nelemd + fld_tmp(1:nsize,1:nsize,1:numlev,1,ie) = RESHAPE(fld(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) + end do + end if + deallocate(fld_dyn) + ! + ! code for non-GLL grids: need to fill halo and interpolate (if on panel edge/corner) for bilinear interpolation + ! + if (decomp_type==fvm_decomp.or.(fv_nphys>0.and.decomp_type==phys_decomp)) then + !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n) + !JMD hybrid = config_thread_region(par,'horizontal') + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + call fill_halo_and_extend_panel(elem(nets:nete),fvm(nets:nete),& + fld_tmp(:,:,:,:,nets:nete),hybrid,nets,nete,nsize,nhcc,nhalo,numlev,1,.true.,.true.) + end if + ! + ! WARNING - 1:nelemd and nets:nete + ! + !$OMP MASTER !JMD + dest(:,:,:,1:nelemd) = fld_tmp(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,:,1,1:nelemd) + !$OMP END MASTER + deallocate(fld_tmp) + ! + !*************************************************************************** + ! + ! now data is on dynamics decomposition + ! + !*************************************************************************** + ! + ncnt_out = sum(cam_interpolate(1:nelemd)%n_interp) + allocate(fldout(ncnt_out,numlev)) + allocate(idof(ncnt_out*numlev)) + fldout = -999_r8 + idof = 0 + st = 1 + + do ie=1,nelemd + ncol = cam_interpolate(ie)%n_interp + do k=0,numlev-1 + do i=1,ncol + idof(st+i-1+k*ncnt_out)=cam_interpolate(ie)%ilon(i)+nlon*(cam_interpolate(ie)%ilat(i)-1)+nlon*nlat*k + enddo + enddo + ! Now that we have the field on the dyn grid we need to interpolate + en = st+cam_interpolate(ie)%n_interp-1 + if(usefillvalues) then + call interpolate_scalar(cam_interpolate(ie),dest(:,:,:,ie), nsize, nhalo, numlev, fldout(st:en,:), fillvalue) + else + call interpolate_scalar(cam_interpolate(ie),dest(:,:,:,ie), nsize, nhalo, numlev, fldout(st:en,:)) + end if + st = en+1 + end do + + if(numlev==1) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat/), idof, iodesc) + else + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) + end if + call pio_write_darray(File, varid, iodesc, fldout, ierr) + + deallocate(dest) + + deallocate(fldout) + deallocate(idof) + call pio_freedecomp(file,iodesc) + + end subroutine write_interpolated_scalar + + subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) + use pio, only: file_desc_t, var_desc_t + use pio, only: iosystem_desc_t + use pio, only: pio_initdecomp, pio_freedecomp + use pio, only: io_desc_t, pio_write_darray + use cam_instance, only: atm_id + use interpolate_mod, only: interpolate_scalar, vec_latlon_to_contra,get_interp_parameter + use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs + use ppgrid, only: begchunk, endchunk, pcols, pverp, pver + use phys_grid, only: get_gcol_all_p, get_ncols_p, chunk_to_block_send_pters, chunk_to_block_recv_pters, & + transpose_chunk_to_block + use dyn_grid, only: get_gcol_block_d + use hybrid_mod, only: hybrid_t,config_thread_region, get_loop_ranges + use dimensions_mod, only: npsq, fv_nphys,nc,nhc,nhc_phys + use dof_mod, only: PutUniquePoints + use shr_pio_mod, only: shr_pio_getiosys + use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, freeedgebuffer + use edgetype_mod, only: EdgeBuffer_t + use bndry_mod, only: bndry_exchange + use parallel_mod, only: par + use thread_mod, only: horz_num_threads + use cam_grid_support, only: cam_grid_id + use fvm_mod, only: fill_halo_and_extend_panel + use control_mod, only: cubed_sphere_map + use cube_mod, only: dmap + + implicit none + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(inout) :: varidu, varidv + real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) + integer, intent(in) :: numlev, data_type, decomp_type + + type(hybrid_t) :: hybrid + type(io_desc_t) :: iodesc + type(iosystem_desc_t), pointer :: pio_subsystem + type (EdgeBuffer_t) :: edgebuf ! edge buffer + + integer :: lchnk, i, j, icol, ncols, pgcols(pcols), ierr, nets, nete + integer :: idmb1(1), idmb2(1), idmb3(1) + integer, allocatable :: bpter(:,:) ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + + real(r8), allocatable :: dest(:,:,:,:,:) + real(r8), pointer :: bbuffer(:), cbuffer(:), fldout(:,:,:) + real(r8), allocatable :: fld_dyn(:,:,:,:),fld_tmp(:,:,:,:,:) + + integer :: st, en, ie, ioff, ncnt_out, k + integer, pointer :: idof(:) + integer :: nlon, nlat, ncol,nsize,nhalo,nhcc + logical :: usefillvalues + integer :: phys_decomp, fvm_decomp,gll_decomp + real (r8) :: D(2,2) ! derivative of gnomonic mapping + real (r8) :: v1,v2 + + usefillvalues=.false. + + phys_decomp = cam_grid_id('physgrid') + fvm_decomp = cam_grid_id('FVM') + gll_decomp = cam_grid_id('GLL') + ! + ! There are 2 main scenarios regarding decomposition: + ! + ! decomp_type==phys_decomp: we need to move data from physics decomposition to dynamics decomposition + ! else : data is on dynamics decomposition + ! + if (decomp_type==phys_decomp) then + if (fv_nphys>0) then + ! + ! note that even if fv_nphys<4 then SIZE(fld,DIM=1)=npsq + ! + nsize = fv_nphys + nhalo = 1!for bilinear only a halo of 1 is needed + nhcc = nhc_phys + else + nsize = np + nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) + nhcc = 0 + end if + else if (decomp_type==fvm_decomp) then + ! + ! CSLAM grid output + ! + nsize = nc + nhalo = 1!for bilinear only a halo of 1 is needed + nhcc = nhc + else if (decomp_type==gll_decomp) then + nsize = np + nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) + nhcc = 0 + else + call endrun('write_interpolated_scalar: unknown decomp_type') + end if + allocate(fld_dyn(nsize*nsize,2,numlev,nelemd)) + allocate(fld_tmp(1-nhcc:nsize+nhcc,1-nhcc:nsize+nhcc,2,numlev,nelemd)) + allocate(dest(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,2,numlev,nelemd)) + + nlon=get_interp_parameter('nlon') + nlat=get_interp_parameter('nlat') + pio_subsystem => shr_pio_getiosys(atm_id) + fld_dyn = -999_R8 + if(decomp_type==phys_decomp) then + if(local_dp_map) then + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, k, ioff) + do lchnk=begchunk,endchunk + ncols=get_ncols_p(lchnk) + call get_gcol_all_p(lchnk,pcols,pgcols) + if (fv_nphys>0) ncols = fv_nphys*fv_nphys + do icol=1,ncols + call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) + ie = idmb3(1) + ioff=idmb2(1) + do k=1,numlev + fld_dyn(ioff,1,k,ie) = fldu(icol, k, lchnk-begchunk+1) + fld_dyn(ioff,2,k,ie) = fldv(icol, k, lchnk-begchunk+1) + end do + end do + end do + else + allocate( bbuffer(2*block_buf_nrecs*numlev) ) + allocate( cbuffer(2*chunk_buf_nrecs*numlev) ) + !$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, i, k, icol) + do lchnk = begchunk,endchunk + ncols = get_ncols_p(lchnk) + + call chunk_to_block_send_pters(lchnk,pcols,pverp,2,cpter) + + do i=1,ncols + cbuffer(cpter(i,1):cpter(i,1)) = 0.0_r8 + end do + + do icol=1,ncols + do k=1,numlev + cbuffer(cpter(icol,k-1)) = fldu(icol,k,lchnk-begchunk+1) + cbuffer(cpter(icol,k-1)+1) = fldv(icol,k,lchnk-begchunk+1) + end do + end do + end do + + call transpose_chunk_to_block(2, cbuffer, bbuffer) + if(iam < par%nprocs) then + if (fv_nphys>0) then + allocate(bpter(fv_nphys*fv_nphys,0:pver)) + else + allocate(bpter(npsq,0:pver)) + end if + !$omp parallel do num_threads(horz_num_threads) private (ie, bpter, k, icol) + do ie=1,nelemd + if (fv_nphys>0) then + call chunk_to_block_recv_pters(elem(ie)%GlobalID,fv_nphys*fv_nphys,pverp,2,bpter) + ncols = fv_nphys*fv_nphys + else + call chunk_to_block_recv_pters(elem(ie)%GlobalID,npsq,pverp,2,bpter) + ncols = elem(ie)%idxp%NumUniquePts + end if + do icol=1,ncols + do k=1,numlev + fld_dyn(icol,1,k,ie) = bbuffer(bpter(icol,k-1)) + fld_dyn(icol,2,k,ie) = bbuffer(bpter(icol,k-1)+1) + enddo + end do + end do + end if + deallocate( bbuffer ) + deallocate( cbuffer ) + deallocate( bpter ) + end if!local_dp_map + if (fv_nphys>0) then + do ie = 1, nelemd + fld_tmp(1:nsize,1:nsize,:,:,ie) = RESHAPE(fld_dyn(:,:,:,ie),(/nsize,nsize,2,numlev/)) + end do + else + call initEdgeBuffer(par, edgebuf, elem, 2*numlev,nthreads=1) + + do ie=1,nelemd + ncols = elem(ie)%idxp%NumUniquePts + call putUniquePoints(elem(ie)%idxP, 2, numlev, fld_dyn(1:ncols,:,1:numlev,ie), fld_tmp(:,:,:,1:numlev,ie)) + call edgeVpack(edgebuf, fld_tmp(:,:,:,:,ie), 2*numlev, 0, ie) + enddo + if(iam < par%nprocs) then + call bndry_exchange(par, edgebuf,location='write_interpolated_vector') + end if + + do ie=1,nelemd + call edgeVunpack(edgebuf, fld_tmp(:,:,:,:,ie), 2*numlev, 0, ie) + enddo + call freeEdgeBuffer(edgebuf) + usefillvalues = any(fld_tmp==fillvalue) + end if + else + ! + ! not physics decomposition + ! + usefillvalues = (any(fldu(1:nsize:1,nsize,:)==fillvalue) .or. any(fldv(1:nsize:1,nsize,:)==fillvalue)) + do ie = 1, nelemd + fld_tmp(1:nsize,1:nsize,1,1:numlev,ie) = RESHAPE(fldu(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) + fld_tmp(1:nsize,1:nsize,2,1:numlev,ie) = RESHAPE(fldv(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) + end do + endif + deallocate(fld_dyn) + ! + !*************************************************************************** + ! + ! now data is on dynamics decomposition + ! + !*************************************************************************** + ! + if (decomp_type==fvm_decomp.or.(fv_nphys>0.and.decomp_type==phys_decomp)) then + ! + !*************************************************************************** + ! + ! code for non-GLL grids: need to fill halo and interpolate + ! (if on panel edge/corner) for bilinear interpolation + ! + !*************************************************************************** + ! + + !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n) + !JMD hybrid = config_thread_region(par,'horizontal') + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + call fill_halo_and_extend_panel(elem(nets:nete),fvm(nets:nete),& + fld_tmp(:,:,:,:,nets:nete),hybrid,nets,nete,nsize,nhcc,nhalo,2,numlev,.true.,.false.) + do ie=nets,nete + call vec_latlon_to_contra(elem(ie),nsize,nhcc,numlev,fld_tmp(:,:,:,:,ie),fvm(ie)) + end do + call fill_halo_and_extend_panel(elem(nets:nete),fvm(nets:nete),& + fld_tmp(:,:,:,:,nets:nete),hybrid,nets,nete,nsize,nhcc,nhalo,2,numlev,.false.,.true.) + else + do ie=1,nelemd + call vec_latlon_to_contra(elem(ie),nsize,nhcc,numlev,fld_tmp(:,:,:,:,ie)) + end do + end if + ! + ! WARNING - 1:nelemd and nets:nete + ! + !$OMP MASTER !JMD + dest(:,:,:,:,1:nelemd) = fld_tmp(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,:,:,1:nelemd) + !$OMP END MASTER + deallocate(fld_tmp) + ! + !*************************************************************************** + ! + ! do mapping from source grid to latlon grid + ! + !*************************************************************************** + ! + ncnt_out = sum(cam_interpolate(1:nelemd)%n_interp) + allocate(fldout(ncnt_out,numlev,2)) + allocate(idof(ncnt_out*numlev)) + + fldout = -999_r8 + idof = 0 + st = 1 + do ie=1,nelemd + ncol = cam_interpolate(ie)%n_interp + do k=0,numlev-1 + do i=1,ncol + idof(st+i-1+k*ncnt_out)=cam_interpolate(ie)%ilon(i)+nlon*(cam_interpolate(ie)%ilat(i)-1)+nlon*nlat*k + enddo + enddo + ! Now that we have the field on the dyn grid we need to interpolate + en = st+cam_interpolate(ie)%n_interp-1 + if(usefillvalues) then + call interpolate_scalar(cam_interpolate(ie),dest(:,:,1,:,ie), nsize, nhalo, numlev, fldout(st:en,:,1), fillvalue) + call interpolate_scalar(cam_interpolate(ie),dest(:,:,2,:,ie), nsize, nhalo, numlev, fldout(st:en,:,2), fillvalue) + else + call interpolate_scalar(cam_interpolate(ie),dest(:,:,1,:,ie), nsize, nhalo, numlev, fldout(st:en,:,1)) + call interpolate_scalar(cam_interpolate(ie),dest(:,:,2,:,ie), nsize, nhalo, numlev, fldout(st:en,:,2)) + end if + ! + ! convert from contravariant components to lat-lon + ! + do i=1,cam_interpolate(ie)%n_interp + ! convert fld from contra->latlon + call dmap(D,cam_interpolate(ie)%interp_xy(i)%x,cam_interpolate(ie)%interp_xy(i)%y,& + elem(ie)%corners3D,cubed_sphere_map,elem(ie)%corners,elem(ie)%u2qmap,elem(ie)%facenum) + ! convert fld from contra->latlon + do k=1,numlev + v1 = fldout(st+i-1,k,1) + v2 = fldout(st+i-1,k,2) + fldout(st+i-1,k,1)=D(1,1)*v1 + D(1,2)*v2 + fldout(st+i-1,k,2)=D(2,1)*v1 + D(2,2)*v2 + end do + end do + st = en+1 + end do + + if(numlev==1) then + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat/), idof, iodesc) + else + call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) + end if + + call pio_write_darray(File, varidu, iodesc, fldout(:,:,1), ierr) + call pio_write_darray(File, varidv, iodesc, fldout(:,:,2), ierr) + + + deallocate(fldout) + deallocate(idof) + deallocate(dest) + call pio_freedecomp(file,iodesc) + + end subroutine write_interpolated_vector + +end module interp_mod diff --git a/src/dynamics/se/native_mapping.F90 b/src/dynamics/se/native_mapping.F90 new file mode 100644 index 0000000000..bfe75511fb --- /dev/null +++ b/src/dynamics/se/native_mapping.F90 @@ -0,0 +1,534 @@ +module native_mapping +! +! Create mapping files using the SE basis functions. This module looks for the namelist 'native_mapping' in +! file NLFileName (usually atm_in) and reads from it a list of up to maxoutgrids grid description files +! It then creates a grid mapping file from the currently defined SE grid to the grid described in each file +! using the SE basis functions. The output mapping file name is generated based on the SE model resolution +! and the input grid file name and ends in '_date_native.nc' +! + use cam_logfile, only : iulog + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use shr_const_mod, only : pi=>shr_const_pi + use cam_abortutils, only : endrun + use spmd_utils, only : iam, masterproc, mpi_character, mpi_logical, mpi_integer, mpi_max, & + mpicom, mstrid=>masterprocid + + implicit none + private + public :: native_mapping_readnl, create_native_mapping_files, do_native_mapping + + integer, parameter :: maxoutgrids=5 + character(len=shr_kind_cl) :: native_mapping_outgrids(maxoutgrids) + logical, protected :: do_native_mapping + +!============================================================================================= +contains +!============================================================================================= + +subroutine native_mapping_readnl(NLFileName) + + use units, only : getunit, freeunit + use namelist_utils, only : find_group_name + + character(len=*), intent(in) :: NLFileName + + character(len=shr_kind_cl) :: mappingfile, fname + + namelist /native_mapping_nl/ native_mapping_outgrids + integer :: nf, unitn, ierr + logical :: exist + character(len=*), parameter :: sub="native_mapping_readnl" + !----------------------------------------------------------------------------- + + do_native_mapping=.false. + + do nf=1,maxoutgrids + native_mapping_outgrids(nf)='' + enddo + + if(masterproc) then + exist=.true. + write(iulog,*) sub//': Check for native_mapping_nl namelist in ',trim(nlfilename) + unitn = getunit() + open( unitn, file=trim(nlfilename), status='old' ) + + call find_group_name(unitn, 'native_mapping_nl', status=ierr) + if(ierr/=0) then + write(iulog,*) sub//': No native_mapping_nl namelist found' + exist=.false. + end if + if(exist) then + read(unitn, native_mapping_nl, iostat=ierr) + if(ierr/=0) then + call endrun(sub//': namelist read returns an error condition for native_mapping_nl') + end if + if(len_trim(native_mapping_outgrids(1))==0) exist=.false. + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(exist, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: exist") + + if(.not. exist) return + + call mpi_bcast(native_mapping_outgrids, maxoutgrids*shr_kind_cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: native_mapping_outgrids") + + do_native_mapping=.true. + +end subroutine native_mapping_readnl + +!============================================================================================= + +subroutine create_native_mapping_files(par, elem, maptype, ncol, clat, clon, areaa) + + use parallel_mod, only : parallel_t, global_shared_buf, global_shared_sum + use global_norms_mod, only: wrap_repro_sum + use cam_pio_utils, only : cam_pio_openfile, cam_pio_createfile + use element_mod, only : element_t + use hybrid_mod, only : hybrid_t, config_thread_region + use pio, only : pio_noerr, pio_openfile, pio_createfile, pio_closefile, & + pio_get_var, pio_put_var, pio_write_darray,pio_int, pio_double, & + pio_def_var, pio_put_att, pio_global, file_desc_t, var_desc_t, & + io_desc_t, pio_internal_error,pio_inq_dimlen, pio_inq_varid, & + pio_get_att, pio_enddef, pio_bcast_error,pio_internal_error, & + pio_def_dim, pio_inq_dimid, pio_seterrorhandling, pio_initdecomp + use quadrature_mod, only : quadrature_t, gauss, gausslobatto + use interpolate_mod, only : interpdata_t, cube_facepoint_ne, interpolate_scalar, set_interp_parameter, interp_init, & + get_interp_parameter + use coordinate_systems_mod, only : spherical_polar_t, cartesian2d_t + use dimensions_mod, only : nelemd, ne, np, npsq, nelem + use reduction_mod, only : ParallelMin,ParallelMax + use cube_mod, only : convert_gbl_index + use infnan, only : isnan + use dof_mod, only : CreateMetaData + use thread_mod, only: omp_get_thread_num + use datetime_mod, only: datetime + + + use cam_history_support, only : fillvalue + + + type(parallel_t), intent(in) :: par + type(element_t), intent(in) :: elem(:) + character(len=*), intent(in) :: maptype + integer, intent(in) :: ncol + real(r8), intent(in) :: clat(ncol) + real(r8), intent(in) :: clon(ncol) + real(r8), intent(in) :: areaa(ncol) + + character(len=shr_kind_cl) :: mappingfile, fname + + + type(hybrid_t) :: hybrid + logical :: exist + + type (spherical_polar_t) :: sphere + type(file_desc_t) :: ogfile, agfile + type (interpdata_t) :: interpdata(nelemd) + integer :: ierr, dimid, npts, vid + real(r8), allocatable :: lat(:), lon(:) + integer :: i, ii, ie2, je2, ie, je, face_no, face_no2, k, j, n, ngrid, tpts, nf, number + real(r8) :: countx, count_max, count_total + integer :: fdofp(np,np,nelemd) + type (cartesian2D_t) :: cart + real(r8) :: f(np,np) + real(r8), allocatable :: h(:), h1d(:) + integer, allocatable :: grid_imask(:), row(:), col(:), ldof(:), dg_dims(:) + integer :: ns_dim, cnt, na_dim, nb_dim, sg_dim, dg_dim + type(var_desc_t) :: rowid, colid, sid, xca_id, yca_id, xcb_id, ycb_id, maskb_id, maska_id + type(var_desc_t) :: areaA_id, areaB_id, dg_id, sg_id + type(io_desc_t) :: iodesci, iodescd + character(len=12) :: unit_str + real(r8), allocatable :: areaB(:) + integer :: cntperelem_in(nelem), cntperelem_out(nelem) + integer :: ithr, dg_rank, substr1, substr2 + + type(interpdata_t), pointer :: mapping_interpolate(:) + character(len=8) :: cdate, ctime + integer :: olditype, oldnlat, oldnlon, itype + + + + if(.not. do_native_mapping) return + + if (maptype=='native') then + itype=0 + else if (maptype=='bilin') then + itype=1 + else + call endrun('bad interp_type') + endif + + + + + if(iam > par%nprocs) then + ! The special case of npes_se < npes_cam is not worth dealing with here + call endrun('Native mapping code requires npes_se==npes_cam') + end if + + + call interp_init() + + + oldnlon = get_interp_parameter('nlon') + oldnlat = get_interp_parameter('nlat') + olditype = get_interp_parameter('itype') + + call datetime(cdate, ctime) + + do nf=1,maxoutgrids + fname = native_mapping_outgrids(nf) + if(masterproc) then + write(iulog,*) 'looking for target grid = ',trim(fname) + endif + if(len_trim(fname)==0) cycle + inquire(file=fname,exist=exist) + if(.not. exist) then + write(iulog,*) 'WARNING: Could not find or open grid file ',fname + cycle + end if + if(masterproc) then + write(iulog,*) 'Creating ',trim(maptype),' mapping to grid ',fname + endif + call cam_pio_openfile( ogfile, fname, 0) + + ierr = pio_inq_dimid( ogfile, 'grid_size', dimid) + ierr = pio_inq_dimlen( ogfile, dimid, npts) + allocate(lat(npts), lon(npts), grid_imask(npts), areab(npts)) + + ierr = pio_inq_dimid( ogfile, 'grid_rank', dimid) + ierr = pio_inq_dimlen(ogfile, dimid, dg_rank) + allocate(dg_dims(dg_rank)) + ierr = pio_inq_varid( ogfile, 'grid_dims', vid) + ierr = pio_get_var( ogfile, vid, dg_dims) + + + ierr = pio_inq_varid( ogfile, 'grid_center_lat', vid) + ierr = pio_get_var(ogfile, vid, lat) + ierr = pio_get_att(ogfile, vid, 'units', unit_str) + + ierr = pio_inq_varid( ogfile, 'grid_center_lon', vid) + ierr = pio_get_var(ogfile, vid, lon) + + call pio_seterrorhandling(ogfile, PIO_BCAST_ERROR) + ierr = pio_inq_varid( ogfile, 'grid_area', vid) + call pio_seterrorhandling(ogfile, PIO_INTERNAL_ERROR) + if(ierr == PIO_NOERR) then + ierr = pio_get_var(ogfile, vid, areaB) + else + areaB=fillvalue + end if + + if(unit_str .eq. 'degrees') then + lat = lat * pi/180_r8 + lon = lon * pi/180_r8 + end if + + ierr = pio_inq_varid( ogfile, 'grid_imask', vid) + ierr = pio_get_var(ogfile, vid, grid_imask) + call pio_closefile(ogfile) + + do ie=1,nelemd + interpdata(ie)%n_interp=0 + end do + + call set_interp_parameter('itype',itype) ! itype=0 native, 1 for bilinear + if(lon(1)==lon(2)) then + call set_interp_parameter('nlon',dg_dims(1)) + call set_interp_parameter('nlat',dg_dims(2)) + else + call set_interp_parameter('nlon',dg_dims(2)) + call set_interp_parameter('nlat',dg_dims(1)) + end if + + + + + +! call setup_latlon_interp(elem, cam_interpolate, hybrid, 1, nelemd) + ! go through once, counting the number of points on each element + + sphere%r=1 + do i=1,npts + if(grid_imask(i)==1) then + sphere%lat=lat(i) + sphere%lon=lon(i) + call cube_facepoint_ne(sphere, ne, cart, number) ! new interface + if (number /= -1) then + do ii=1,nelemd + if (number == elem(ii)%vertex%number) then + interpdata(ii)%n_interp = interpdata(ii)%n_interp + 1 + exit + endif + enddo + endif + + + if(masterproc) then + if(mod(i,npts/10).eq.1) then + print *,'finished point ',i,' of ',npts + endif + end if + end if + enddo + + hybrid = config_thread_region(par,'serial') +! ithr=omp_get_thread_num() +! hybrid = hybrid_create(par,ithr,1) + + + + ! check if every point in interpolation grid was claimed by an element: + countx=sum(interpdata(1:nelemd)%n_interp) + global_shared_buf(1,1) = countx + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm, nsize=1) + count_total = global_shared_sum(1) + tpts = sum(grid_imask) + if (count_total /= tpts ) then + write(iulog,*)__FILE__,__LINE__,iam, count_total, tpts, npts + call endrun('Error setting up interpolation grid count_total<>npts') + endif + + countx=maxval(interpdata(1:nelemd)%n_interp) + count_max = ParallelMax(countx,hybrid) + + if (masterproc) then + write(iulog,'(a,f8.1)') 'Average number of interpolation points per element: ',count_total/real(6*ne*ne) + write(iulog,'(a,f8.0)') 'Maximum number of interpolation points on any element: ',count_max + endif + + + ! allocate storage + do ii=1,nelemd + ngrid = interpdata(ii)%n_interp + allocate(interpdata(ii)%interp_xy( ngrid ) ) + allocate(interpdata(ii)%ilat( ngrid ) ) + allocate(interpdata(ii)%ilon( ngrid ) ) + interpdata(ii)%n_interp=0 ! reset counter + enddo + + ! now go through the list again, adding the coordinates + ! if this turns out to be slow, then it can be done in the loop above + ! but we have to allocate and possibly resize the interp_xy() array. + do i=1,npts + if(grid_imask(i)==1) then + sphere%lat=lat(i) + sphere%lon=lon(i) + call cube_facepoint_ne(sphere, ne, cart, number) ! new interface + if (number /= -1) then + do ii=1,nelemd + if (number == elem(ii)%vertex%number) then + ngrid = interpdata(ii)%n_interp + 1 + interpdata(ii)%n_interp = ngrid + interpdata(ii)%interp_xy( ngrid ) = cart + interpdata(ii)%ilon( ngrid ) = i + interpdata(ii)%ilat( ngrid ) = i + endif + enddo + endif + end if + end do + + + allocate(h(int(countx))) + allocate(h1d(int(countx)*npsq*nelemd)) + allocate(row(int(countx)*npsq*nelemd)) + allocate(col(int(countx)*npsq*nelemd)) + + row = 0 + col = 0 + + ngrid=0 + cntperelem_in=0 + call CreateMetaData(hybrid%par, elem, fdofp=fdofp) + + do ie=1,nelemd + ii=0 + do j=1,np + do i=1,np + ii=ii+1 + f = 0.0_R8 + f(i,j) = 1.0_R8 + h = 0 + call interpolate_scalar(interpdata(ie), f, np, 0, h(:)) + + do n=1,interpdata(ie)%n_interp + if(any(isnan(h ))) then + + call endrun('nan generated') + end if + if(h(n)/=0) then + ngrid=ngrid+1 + h1d(ngrid) = h(n) + row(ngrid) = interpdata(ie)%ilon(n) + col(ngrid) = fdofp(i,j,ie) + cntperelem_in(elem(ie)%Globalid)=cntperelem_in(elem(ie)%Globalid)+1 + end if + enddo + + enddo + end do + end do + + countx=ngrid + global_shared_buf(1,1) = countx + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm, nsize=1) + count_total = global_shared_sum(1) + + + call mpi_allreduce(cntperelem_in, cntperelem_out, nelem, MPI_INTEGER, MPI_MAX, par%comm, ierr) + + + allocate(ldof(ngrid)) + ldof = 0 + ii=1 + do ie=1,nelemd + if(elem(ie)%GlobalID==1) then + cnt = 0 + else + cnt = sum(cntperelem_out(1:elem(ie)%globalid-1)) + endif + do i=1,cntperelem_out(elem(ie)%globalid) + ldof(ii) = cnt+i + ii=ii+1 + end do + end do + + deallocate(h) + + ngrid = int(count_total) + + substr1 = index(fname,'/',BACK=.true.) + substr2 = index(fname,'.nc',BACK=.true.) + + if(ne<100) then + write(mappingfile,113) ne,np,fname(substr1+1:substr2-1),trim(maptype),cdate(7:8),cdate(1:2),cdate(4:5) + else if(ne<1000) then + write(mappingfile,114) ne,np,fname(substr1+1:substr2-1),trim(maptype),cdate(7:8),cdate(1:2),cdate(4:5) + else + write(mappingfile,115) ne,np,fname(substr1+1:substr2-1),trim(maptype),cdate(7:8),cdate(1:2),cdate(4:5) + end if + +113 format('map_ne',i2.2,'np',i1,'_to_',a,'_',a,'_',3a2,'.nc') +114 format('map_ne',i3.3,'np',i1,'_to_',a,'_',a,'_',3a2,'.nc') +115 format('map_ne',i4.4,'np',i1,'_to_',a,'_',a,'_',3a2,'.nc') + + call cam_pio_createfile( ogfile,mappingfile , 0) + + ierr = pio_def_dim( ogfile, 'n_a', ncol, na_dim) + ierr = pio_def_dim( ogfile, 'n_b', npts, nb_dim) + ierr = pio_def_dim( ogfile, 'n_s', ngrid, ns_dim) + + ierr = pio_def_dim( ogfile, 'src_grid_rank', 1, sg_dim) + ierr = pio_def_var( ogfile, 'src_grid_dims',pio_int, (/sg_dim/),sg_id) + + ierr = pio_def_dim( ogfile, 'dst_grid_rank',dg_rank, dg_dim) + ierr = pio_def_var( ogfile, 'dst_grid_dims',pio_int, (/dg_dim/),dg_id) + + + + + + ierr = pio_def_var( ogfile, 'col', pio_int, (/ns_dim/), colid) + ierr = pio_def_var( ogfile, 'row', pio_int, (/ns_dim/), rowid) + ierr = pio_def_var( ogfile, 'S', pio_double, (/ns_dim/), sid) + + ierr = pio_def_var( ogfile, 'xc_a', pio_double, (/na_dim/), xca_id) + ierr = pio_def_var( ogfile, 'yc_a', pio_double, (/na_dim/), yca_id) + + ierr = pio_def_var( ogfile, 'xc_b', pio_double, (/nb_dim/), xcb_id) + ierr = pio_def_var( ogfile, 'yc_b', pio_double, (/nb_dim/), ycb_id) + + ierr = pio_def_var( ogfile, 'area_a', pio_double, (/na_dim/), areaA_id) + ierr = pio_def_var( ogfile, 'area_b', pio_double, (/nb_dim/), areaB_id) + ierr = pio_put_att( ogfile, areaB_id, '_FillValue',fillvalue) + + ierr = pio_def_var( ogfile, 'mask_a', pio_int, (/na_dim/), maska_id) + ierr = pio_def_var( ogfile, 'mask_b', pio_int, (/nb_dim/), maskb_id) + + + + ierr = pio_put_att( ogfile, xca_id, 'units','radians') + ierr = pio_put_att( ogfile, yca_id, 'units','radians') + ierr = pio_put_att( ogfile, xcb_id, 'units','radians') + ierr = pio_put_att( ogfile, ycb_id, 'units','radians') + + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'title', 'SE NATIVE Regridding Weights') + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'normalization', 'none') + if (itype==0 ) then + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'map_method', 'Spectral-Element remapping') + else if (itype==1) then + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'map_method', 'Bilinear remapping') + endif + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'conventions', 'NCAR-CSM') + + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'grid_file_out', fname ) + ierr = pio_put_att( ogfile, PIO_GLOBAL, 'grid_file_atm', 'none - model generated') + + + ierr = pio_enddef ( ogfile ) + + ierr = pio_put_var(ogfile, sg_id, ncol) + ierr = pio_put_var(ogfile, dg_id, dg_dims(1:dg_rank)) + + + call pio_initdecomp( ogfile%iosystem, pio_int, (/ngrid/), ldof, iodesci) + call pio_initdecomp( ogfile%iosystem, pio_double, (/ngrid/), ldof, iodescd) + + call pio_write_darray(ogfile, colid, iodesci, col, ierr) + call pio_write_darray(ogfile, rowid, iodesci, row, ierr) + call pio_write_darray(ogfile, sid, iodescd, h1d, ierr) + + + ierr = pio_put_var(ogfile, xcb_id, lon) + ierr = pio_put_var(ogfile, ycb_id, lat) + + ierr = pio_put_var(ogfile, xca_id, clon) + ierr = pio_put_var(ogfile, yca_id, clat) + + ierr = pio_put_var(ogfile, maskb_id, grid_imask) + deallocate(grid_imask) + + ierr = pio_put_var(ogfile, areaA_id, areaA) + ierr = pio_put_var(ogfile, areaB_id, areaB) + deallocate(areaB) + + allocate(grid_imask(ncol)) + grid_imask=1 + + ierr = pio_put_var(ogfile, maska_id, grid_imask) + + call pio_closefile(ogfile) + + deallocate(grid_imask, lat,lon, h1d, col, row, dg_dims, ldof) + do ii=1,nelemd + if(associated(interpdata(ii)%interp_xy))then + deallocate(interpdata(ii)%interp_xy) + endif + if(associated(interpdata(ii)%ilat))then + deallocate(interpdata(ii)%ilat) + endif + if (associated(interpdata(ii)%ilon))then + deallocate(interpdata(ii)%ilon) + endif + end do + + + end do + + call set_interp_parameter('itype',olditype) + call set_interp_parameter('nlon',oldnlon) + call set_interp_parameter('nlat',oldnlat) + + + end subroutine create_native_mapping_files + + + + + +end module native_mapping diff --git a/src/dynamics/se/pmgrid.F90 b/src/dynamics/se/pmgrid.F90 new file mode 100644 index 0000000000..fff3dbce18 --- /dev/null +++ b/src/dynamics/se/pmgrid.F90 @@ -0,0 +1,15 @@ +module pmgrid + +! PLON and PLAT do not correspond to the number of latitudes and longitudes in +! this version of dynamics. + +implicit none +save + +integer, parameter :: plev = PLEV ! number of vertical levels +integer, parameter :: plevp = plev + 1 + +integer, parameter :: plon = 1 +integer, parameter :: plat = 1 + +end module pmgrid diff --git a/src/dynamics/se/restart_dynamics.F90 b/src/dynamics/se/restart_dynamics.F90 new file mode 100644 index 0000000000..64f8b6c6e1 --- /dev/null +++ b/src/dynamics/se/restart_dynamics.F90 @@ -0,0 +1,1048 @@ +module restart_dynamics + +! Write and read dynamics fields from the restart file. For exact restart +! it is necessary to write all element data, including duplicate columns, +! to the file. The namelist option, se_write_restart_unstruct, is +! available to write just the unique columns to the restart file using the +! same unstructured grid used by the history and initial files. This +! results in the introduction of a roundoff size difference on restart, but +! writes the fields in the unstructured grid format which is easier to +! modify if the user desires to introduce perturbations or other +! adjustments into the run. The restart file containing the unstructured +! grid format may also be used for an initial run. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: iam + +use constituents, only: cnst_name +use dyn_grid, only: timelevel, fvm, elem, edgebuf +use dyn_comp, only: dyn_import_t, dyn_export_t, dyn_init, write_restart_unstruct +use hycoef, only: init_restart_hycoef, write_restart_hycoef, & + hyai, hybi, ps0 +use ref_pres, only: ptop_ref + +use pio, only: pio_global, pio_unlimited, pio_offset_kind, pio_double, & + pio_seterrorhandling, pio_bcast_error, pio_noerr, & + file_desc_t, var_desc_t, io_desc_t, & + pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & + pio_def_dim, pio_def_var, & + pio_enddef, & + pio_initdecomp, pio_freedecomp, pio_setframe, & + pio_put_att, pio_put_var, pio_write_darray, & + pio_get_att, pio_read_darray + +use cam_pio_utils, only: pio_subsystem, cam_pio_handle_error +use cam_grid_support, only: cam_grid_header_info_t, cam_grid_id, cam_grid_write_attr, & + cam_grid_write_var, cam_grid_get_decomp, cam_grid_dimensions, & + max_hcoordname_len, cam_grid_get_dim_names +use ncdio_atm, only: infld + +use infnan, only: isnan +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use parallel_mod, only: par +use thread_mod, only: horz_num_threads +use control_mod, only: qsplit +use dimensions_mod, only: np, npsq, ne, nlev, qsize, nelemd, nc, ntrac +use dof_mod, only: UniquePoints +use element_mod, only: element_t +use time_mod, only: tstep, TimeLevel_Qdp + +use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer +use edgetype_mod, only: EdgeBuffer_t +use bndry_mod, only: bndry_exchange + +use fvm_control_volume_mod, only: fvm_struct, n0_fvm + +implicit none +private +save + +public :: & + init_restart_dynamics, & + write_restart_dynamics, & + read_restart_dynamics + +! these variables are module data so they can be shared between the +! file definition and write phases +type(var_desc_t) :: psdry_desc, udesc, vdesc, tdesc +type(var_desc_t), allocatable :: qdesc_dp(:) +type(var_desc_t) :: dp_fvm_desc +type(var_desc_t), pointer :: c_fvm_desc(:) + +integer, private :: nelem_tot = -1 ! Correct total number of elements + +!========================================================================================= +CONTAINS +!========================================================================================= + +subroutine init_nelem_tot() + use spmd_utils, only: mpicom, MPI_INTEGER, MPI_SUM + + integer :: ierr + + if (nelem_tot < 0) then + call MPI_Allreduce(nelemd, nelem_tot, 1, MPI_INTEGER, MPI_SUM, mpicom, ierr) + end if +end subroutine init_nelem_tot + +subroutine init_restart_dynamics(file, dyn_out) + + ! Define dimensions, variables, attributes for restart file. + + ! This is not really an "init" routine. It is called before + ! write_restart_dynamics every time an restart is written. + + ! arguments + type(file_desc_t), intent(inout) :: file + type(dyn_export_t), intent(in) :: dyn_out + + ! local variables + integer :: i + integer :: vdimids(2) + integer :: nlev_dimid + integer :: ncol_dimid + integer :: ncol_fvm_dimid + integer :: time_dimid + + integer :: ierr, err_handling + + integer :: grid_id + type(cam_grid_header_info_t) :: info + + !---------------------------------------------------------------------------- + + call init_nelem_tot() + call init_restart_hycoef(file, vdimids) + nlev_dimid = vdimids(1) + + call pio_seterrorhandling(File, pio_bcast_error, err_handling) + + ierr = PIO_Def_Dim(File, 'time', PIO_UNLIMITED, time_dimid) + + ! GLL restart fields + + ! number of columns written to restart depends on whether all columns in the + ! element structures are written, or just the unique columns (unstructured grid) + if (write_restart_unstruct) then + grid_id = cam_grid_id('GLL') + call cam_grid_write_attr(File, grid_id, info) + ncol_dimid = info%get_hdimid(1) + else + ierr = PIO_Def_Dim(File,'nenpnp', nelem_tot*np*np, ncol_dimid) + ierr = PIO_Put_Att(File, PIO_GLOBAL, 'ne', ne) + ierr = PIO_Put_Att(File, PIO_GLOBAL, 'np', np) + end if + + ierr = PIO_Def_Var(File, 'PSDRY', pio_double, (/ncol_dimid, time_dimid/), psdry_desc) + ierr = PIO_Def_Var(File, 'U', pio_double, (/ncol_dimid, nlev_dimid, time_dimid/), Udesc) + ierr = PIO_Def_Var(File, 'V', pio_double, (/ncol_dimid, nlev_dimid, time_dimid/), Vdesc) + ierr = PIO_Def_Var(File, 'T', pio_double, (/ncol_dimid, nlev_dimid, time_dimid/), Tdesc) + + allocate(qdesc_dp(qsize)) + + do i=1,qsize + ierr = PIO_Def_Var(File,"dp"//trim(cnst_name(i)), pio_double, & + (/ncol_dimid, nlev_dimid, time_dimid/), Qdesc_dp(i)) + end do + + ! CSLAM restart fields + + if (ntrac > 0) then + + grid_id = cam_grid_id('FVM') + call cam_grid_write_attr(File, grid_id, info) + ncol_fvm_dimid = info%get_hdimid(1) + + ierr = PIO_Def_Var(File, 'dp_fvm', pio_double, & + (/ncol_fvm_dimid, nlev_dimid, time_dimid/), dp_fvm_desc) + + allocate(c_fvm_desc(ntrac)) + do i = 1, ntrac + ierr = PIO_Def_Var(File, trim(cnst_name(i))//"_fvm", pio_double, & + (/ncol_fvm_dimid, nlev_dimid, time_dimid/), c_fvm_desc(i)) + end do + + end if + + call pio_seterrorhandling(File, err_handling) + +end subroutine init_restart_dynamics + +!========================================================================================= + +subroutine write_restart_dynamics(File, dyn_out) + + type(file_desc_t), intent(inout) :: File + type(dyn_export_t), intent(in) :: dyn_out + + ! local variables + integer(pio_offset_kind), parameter :: t_idx = 1 + + type(element_t), pointer :: elem(:) + type(fvm_struct), pointer :: fvm(:) + + integer :: tl, tlqdp + integer :: i, ie, ii, j, k, m + integer :: ierr + + integer :: grid_id + integer :: grid_dimlens(2) + + + + integer :: array_lens(3) + integer :: file_lens(2) + type(io_desc_t), pointer :: iodesc3d_fvm + real(r8), allocatable :: buf3d(:,:,:) + + + + character(len=*), parameter :: sub = 'write_restart_dynamics' + !---------------------------------------------------------------------------- + + call write_restart_hycoef(File) + + tl = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tlQdp) + + if (iam .lt. par%nprocs) then + elem => dyn_out%elem + fvm => dyn_out%fvm + else + allocate (elem(0), fvm(0)) + endif + + ! write fields on GLL grid + + if (write_restart_unstruct) then + call write_unstruct() + else + call write_elem() + end if + + ! write CSLAM fields + + if (ntrac > 0) then + + grid_id = cam_grid_id('FVM') + + ! write coords for FVM grid + call cam_grid_write_var(File, grid_id) + + call cam_grid_dimensions(grid_id, grid_dimlens) + allocate(buf3d(nc*nc,nlev,nelemd)) + array_lens = (/nc*nc, nlev, nelemd/) + file_lens = (/grid_dimlens(1), nlev/) + call cam_grid_get_decomp(grid_id, array_lens, file_lens, pio_double, iodesc3d_fvm) + + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, nc + do i = 1, nc + buf3d(ii,k,ie) = fvm(ie)%dp_fvm(i,j,k,n0_fvm) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(file, dp_fvm_desc, t_idx) + call PIO_Write_Darray(file, dp_fvm_desc, iodesc3d_fvm, buf3d, ierr) + + do m = 1, ntrac + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, nc + do i = 1, nc + buf3d(ii,k,ie) = fvm(ie)%c(i,j,k,m,n0_fvm) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(file, c_fvm_desc(m), t_idx) + call PIO_Write_Darray(file, c_fvm_desc(m), iodesc3d_fvm, buf3d, ierr) + end do + + deallocate(c_fvm_desc) + deallocate(buf3d) + ! should this call be made on a pointer? + !call pio_freedecomp(File, iodesc3d_fvm) + + end if + + if (iam >= par%nprocs) then + deallocate(elem, fvm) + endif + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + +subroutine write_elem() + + ! local variables + integer :: i, ie, j, k + integer :: ierr + integer, pointer :: ldof(:) + + type(io_desc_t) :: iodesc2d, iodesc3d + + real(kind=r8), pointer :: var3d(:,:,:,:), var2d(:,:,:) + !---------------------------------------------------------------------------- + + ldof => get_restart_decomp(elem, 1) + call PIO_InitDecomp(pio_subsystem, pio_double, (/nelem_tot*np*np/), ldof, iodesc2d) + deallocate(ldof) + + ldof => get_restart_decomp(elem, nlev) + call PIO_InitDecomp(pio_subsystem, pio_double, (/nelem_tot*np*np,nlev/), ldof, iodesc3d) + deallocate(ldof) + + allocate(var2d(np,np,nelemd)) + allocate(var3d(np,np,nelemd,nlev)) + + !$omp parallel do num_threads(horz_num_threads) private(ie, j, i) + do ie = 1, nelemd + do j = 1, np + do i = 1, np + var2d(i,j,ie) = elem(ie)%state%psdry(i,j,tl) + end do + end do + end do + call PIO_Setframe(File, psdry_desc, t_idx) + call PIO_Write_Darray(File, psdry_desc, iodesc2d, var2d, ierr) + + !$omp parallel do num_threads(horz_num_threads) private(ie, k, j, i) + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + var3d(i,j,ie,k) = elem(ie)%state%V(i,j,1,k,tl) + end do + end do + end do + end do + call PIO_Setframe(File, Udesc, t_idx) + call PIO_Write_Darray(File, Udesc, iodesc3d, var3d, ierr) + + !$omp parallel do num_threads(horz_num_threads) private(ie, k, j, i) + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + var3d(i,j,ie,k) = elem(ie)%state%V(i,j,2,k,tl) + end do + end do + end do + end do + call PIO_Setframe(File, Vdesc, t_idx) + call PIO_Write_Darray(File, Vdesc, iodesc3d, var3d, ierr) + + !$omp parallel do num_threads(horz_num_threads) private(ie, k, j, i) + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + var3d(i,j,ie,k) = elem(ie)%state%T(i,j,k,tl) + end do + end do + end do + end do + call PIO_Setframe(File, Tdesc, t_idx) + call PIO_Write_Darray(File, Tdesc, iodesc3d, var3d, ierr) + + do m = 1, qsize + + !$omp parallel do num_threads(horz_num_threads) private(ie, k, j, i) + do ie = 1, nelemd + do k = 1, nlev + do j = 1, np + do i = 1, np + var3d(i,j,ie,k) = elem(ie)%state%Qdp(i,j,k,m,tlQdp) + end do + end do + end do + end do + call PIO_Setframe(File, Qdesc_dp(m), t_idx) + call PIO_Write_Darray(File, Qdesc_dp(m), iodesc3d, var3d, ierr) + + end do + + deallocate(var2d) + deallocate(var3d) + deallocate(qdesc_dp) + + call pio_freedecomp(File, iodesc2d) + call pio_freedecomp(File, iodesc3d) + +end subroutine write_elem + +!------------------------------------------------------------------------------- + +subroutine write_unstruct() + + ! local variables + integer :: i, ie, ii, j, k + integer :: ierr + + integer :: array_lens_3d(3), array_lens_2d(2) + integer :: file_lens_2d(2), file_lens_1d(1) + + type(io_desc_t), pointer :: iodesc + real(r8), allocatable :: var2d(:,:), var3d(:,:,:) + !---------------------------------------------------------------------------- + + grid_id = cam_grid_id('GLL') + + ! write coordinate variables for unstructured GLL grid + call cam_grid_write_var(File, grid_id) + + ! create map for distributed write + call cam_grid_dimensions(grid_id, grid_dimlens) + + ! create map for distributed write of 2D fields + array_lens_2d = (/npsq, nelemd/) + file_lens_1d = (/grid_dimlens(1)/) + call cam_grid_get_decomp(grid_id, array_lens_2d, file_lens_1d, pio_double, iodesc) + + allocate(var2d(npsq,nelemd)) + + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + var2d(ii,ie) = elem(ie)%state%psdry(i,j,tl) + ii = ii + 1 + end do + end do + end do + call PIO_Setframe(File, psdry_desc, t_idx) + call PIO_Write_Darray(File, psdry_desc, iodesc, var2d, ierr) + + nullify(iodesc) + deallocate(var2d) + + ! create map for distributed write of 3D fields + array_lens_3d = (/npsq, nlev, nelemd/) + file_lens_2d = (/grid_dimlens(1), nlev/) + call cam_grid_get_decomp(grid_id, array_lens_3d, file_lens_2d, pio_double, iodesc) + + allocate(var3d(npsq,nlev,nelemd)) + + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, np + do i = 1, np + var3d(ii,k,ie) = elem(ie)%state%V(i,j,1,k,tl) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(File, Udesc, t_idx) + call PIO_Write_Darray(File, Udesc, iodesc, var3d, ierr) + + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, np + do i = 1, np + var3d(ii,k,ie) = elem(ie)%state%V(i,j,2,k,tl) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(File, Vdesc, t_idx) + call PIO_Write_Darray(File, Vdesc, iodesc, var3d, ierr) + + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, np + do i = 1, np + var3d(ii,k,ie) = elem(ie)%state%T(i,j,k,tl) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(File, Tdesc, t_idx) + call PIO_Write_Darray(File, Tdesc, iodesc, var3d, ierr) + + do m = 1, qsize + + !$omp parallel do num_threads(horz_num_threads) private(ie, k, j, i) + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, np + do i = 1, np + var3d(ii,k,ie) = elem(ie)%state%Qdp(i,j,k,m,tlQdp) + ii = ii + 1 + end do + end do + end do + end do + call PIO_Setframe(File, Qdesc_dp(m), t_idx) + call PIO_Write_Darray(File, Qdesc_dp(m), iodesc, var3d, ierr) + + end do + + deallocate(var3d) + deallocate(qdesc_dp) + +end subroutine write_unstruct + +!------------------------------------------------------------------------------- + +end subroutine write_restart_dynamics + +!========================================================================================= + +subroutine read_restart_dynamics(File, dyn_in, dyn_out) + + ! arguments + type(File_desc_t), intent(inout) :: File + type(dyn_import_t), intent(out) :: dyn_in + type(dyn_export_t), intent(out) :: dyn_out + + ! local variables + integer(pio_offset_kind), parameter :: t_idx = 1 + + integer :: tl, tlQdp + integer :: i, ie, ii, k, m, j + integer :: ierr, err_handling + integer :: fne, fnp, fnlev, fnc + integer :: hdim_len, ncols_fvm + + integer :: nlev_dimid + integer :: ncol_dimid + integer :: ncol_fvm_dimid + + type(var_desc_t) :: udesc + type(var_desc_t) :: vdesc + type(var_desc_t) :: tdesc + type(var_desc_t) :: psdry_desc + type(var_desc_t), allocatable :: qdesc_dp(:) + + integer :: grid_id + integer :: grid_dimlens(2) + character(len=max_hcoordname_len) :: dimname1, dimname2 + + real(r8), allocatable :: var3d_fvm(:,:,:) + + logical :: readvar + + character(len=*), parameter :: sub = 'read_restart_dynamics' + !---------------------------------------------------------------------------- + + ! Note1: the hybrid coefficients are read from the same location as for an + ! initial run (e.g., dyn_grid_init). + + ! Note2: the dyn_in and dyn_out objects are not associated with the elem and fvm + ! objects until dyn_init is called. Until the restart is better integrated + ! into dyn_init we just access elem and fvm directly from the dyn_grid + ! module. + + tl = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tlQdp) + call init_nelem_tot() + + call pio_seterrorhandling(File, pio_bcast_error, err_handling) + + ! some checks that the restart contains the same grid as the running model. + + ierr = PIO_Get_Att(File, PIO_GLOBAL, 'ne', fne) + ierr = PIO_Get_Att(File, PIO_GLOBAL, 'np', fnp) + if (ne /= fne .or. np /= fnp) then + write(iulog,*) 'Restart file np or ne does not match model. np (file, model):', & + fnp, np, ' ne (file, model) ', fne, ne + call endrun(sub//': Restart file np or ne does not match model.') + end if + + ierr = PIO_Inq_DimID(File, 'lev', nlev_dimid) + ierr = PIO_Inq_dimlen(File, nlev_dimid, fnlev) + if (nlev /= fnlev) then + write(iulog,*) 'Restart file nlev does not match model. nlev (file, namelist):', & + fnlev, nlev + call endrun(sub//': Restart file nlev does not match model.') + end if + + ! variable descriptors of required dynamics fields + ierr = PIO_Inq_varid(File, 'U', udesc) + call cam_pio_handle_error(ierr, sub//': cannot find U') + ierr = PIO_Inq_varid(File, 'V', Vdesc) + call cam_pio_handle_error(ierr, sub//': cannot find V') + ierr = PIO_Inq_varid(File, 'T', tdesc) + call cam_pio_handle_error(ierr, sub//': cannot find T') + ierr = PIO_Inq_varid(File, 'PSDRY', psdry_desc) + call cam_pio_handle_error(ierr, sub//': cannot find PSDRY') + allocate(qdesc_dp(qsize)) + do m = 1, qsize + ierr = PIO_Inq_varid(File, "dp"//trim(cnst_name(m)), Qdesc_dp(m)) + call cam_pio_handle_error(ierr, sub//': cannot find dp'//trim(cnst_name(m))) + end do + + ! check whether the restart fields on the GLL grid contain unique columns + ! or the element structure (nenpnp = nelem_tot*np*np columns) + + ierr = PIO_Inq_DimID(File, 'nenpnp', ncol_dimid) + if (ierr == pio_noerr) then + + call read_elem() + + else + + call read_unstruct() + + end if + + deallocate(qdesc_dp) + + ! recompute dp3d from psdry + do ie = 1, nelemd + do k = 1, nlev + elem(ie)%state%dp3d(:,:,k,tl) = ((hyai(k+1) - hyai(k))*ps0) + & + ((hybi(k+1) - hybi(k))*elem(ie)%state%psdry(:,:,tl)) + end do + end do + + ! Seems like this initialization should be done somewhere else. + do ie = 1, nelemd + elem(ie)%derived%fM = 0._r8 + elem(ie)%derived%fT = 0._r8 + elem(ie)%derived%fQ = 0._r8 + end do + + ! read cslam fields + + if (ntrac > 0) then + + ! Checks that file and model dimensions agree. + + ierr = PIO_Get_Att(File, PIO_GLOBAL, 'nc', fnc) + if (nc /= fnc) then + write(iulog,*) 'Restart file nc does not match model. nc (file, model):',fnc,nc,& + ' ne (file, model) ', fne, ne + call endrun(sub//': Restart file nc does not match model.') + end if + + ierr = PIO_Inq_DimID(File, 'ncol_fvm', ncol_fvm_dimid) + call cam_pio_handle_error(ierr, sub//': cannot find ncol_fvm') + ierr = PIO_Inq_dimlen(File, ncol_fvm_dimid, ncols_fvm) + + grid_id = cam_grid_id('FVM') + call cam_grid_dimensions(grid_id, grid_dimlens) + + if (ncols_fvm /= grid_dimlens(1)) then + write(iulog,*) 'Restart file ncol_fvm does not match model. ncols_fvm (file, model):',& + ncols_fvm, grid_dimlens(1) + call endrun(sub//': Restart file ncols_fvm does not match model.') + end if + + allocate(var3d_fvm(nc*nc,nlev,nelemd)) + var3d_fvm = 0._r8 + + ! dp_fvm + call infld('dp_fvm', file, 'ncol_fvm', 'lev', 1, nc**2, 1, nlev, 1, nelemd, & + var3d_fvm, readvar, gridname='FVM', timelevel=int(t_idx)) + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, nc + do i = 1, nc + fvm(ie)%dp_fvm(i,j,k,n0_fvm) = var3d_fvm(ii,k,ie) + ii = ii + 1 + end do + end do + end do + end do + + ! tracers + do m = 1, ntrac + call infld(trim(cnst_name(m))//'_fvm', file, 'ncol_fvm', 'lev', & + 1, nc**2, 1, nlev, 1, nelemd, var3d_fvm, readvar, & + gridname='FVM', timelevel=int(t_idx)) + do ie = 1, nelemd + do k = 1, nlev + ii = 1 + do j = 1, nc + do i = 1, nc + fvm(ie)%c(i,j,k,m,n0_fvm) = var3d_fvm(ii,k,ie) + ii = ii + 1 + end do + end do + end do + end do + end do + + ! compute dry surface pressure (a derived quantity) + do ie = 1, nelemd + do j = 1, nc + do i = 1, nc + fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:,n0_fvm)) + ptop_ref + end do + end do + end do + + end if + + call pio_seterrorhandling(File, err_handling) + + call dyn_init(dyn_in, dyn_out) + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + +subroutine read_elem() + + ! local variables + integer :: ierr + integer :: ncol + integer :: i, ie, ii, j, k, m + + integer, pointer :: ldof(:) + + type(io_desc_t) :: iodesc2d, iodesc3d + real(r8), allocatable :: var3d(:), var2d(:) + + character(len=*), parameter :: sub='read_elem' + !---------------------------------------------------------------------------- + + ierr = PIO_Inq_dimlen(File, ncol_dimid, ncol) + call cam_pio_handle_error(ierr, sub//': reading nenpnp') + + ldof => get_restart_decomp(elem, 1) + call PIO_InitDecomp(pio_subsystem, pio_double, (/ncol/), ldof, iodesc2d) + deallocate(ldof) + + ldof => get_restart_decomp(elem, nlev) + call PIO_InitDecomp(pio_subsystem, pio_double, (/ncol,nlev/), ldof, iodesc3d) + deallocate(ldof) + + allocate(var3d(ncol*nlev), var2d(ncol)) + var2d = 0._r8 + var3d = 0._r8 + + call pio_setframe(File, psdry_desc, t_idx) + call pio_read_darray(File, psdry_desc, iodesc2d, var2d, ierr) + call cam_pio_handle_error(ierr, sub//': reading PSDRY') + ii = 0 + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ii = ii + 1 + elem(ie)%state%psdry(i,j,tl) = var2d(ii) + end do + end do + end do + + call pio_setframe(File, udesc, t_idx) + call pio_read_darray(File, udesc, iodesc3d, var3d, ierr) + call cam_pio_handle_error(ierr, sub//': reading U') + ii = 0 + do k = 1, nlev + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ii = ii + 1 + elem(ie)%state%v(i,j,1,k,tl) = var3d(ii) + end do + end do + end do + end do + + call pio_setframe(File, vdesc, t_idx) + call pio_read_darray(File, vdesc, iodesc3d, var3d, ierr) + call cam_pio_handle_error(ierr, sub//': reading V') + ii = 0 + do k = 1, nlev + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ii = ii + 1 + elem(ie)%state%v(i,j,2,k,tl) = var3d(ii) + end do + end do + end do + end do + + call pio_setframe(File, tdesc, t_idx) + call pio_read_darray(File, tdesc, iodesc3d, var3d, ierr) + call cam_pio_handle_error(ierr, sub//': reading T') + ii = 0 + do k = 1, nlev + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ii = ii + 1 + elem(ie)%state%T(i,j,k,tl) = var3d(ii) + end do + end do + end do + end do + + do m = 1, qsize + call pio_setframe(File, qdesc_dp(m), t_idx) + call pio_read_darray(File, qdesc_dp(m), iodesc3d, var3d, ierr) + call cam_pio_handle_error(ierr, sub//': reading dp'//trim(cnst_name(m))) + ii = 0 + do k = 1, nlev + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ii = ii + 1 + elem(ie)%state%Qdp(i,j,k,m,tlQdp) = var3d(ii) + end do + end do + end do + end do + end do + + deallocate(var3d, var2d) + +end subroutine read_elem + +!------------------------------------------------------------------------------- + +subroutine read_unstruct() + + ! local variables + integer :: grid_id + + integer :: i, ie, ii, j, kptr, m + + real(r8), allocatable :: dbuf2(:,:) ! (npsq,nelemd) + real(r8), allocatable :: dbuf3(:,:,:) ! (npsq,nlev,nelemd) + + type(EdgeBuffer_t) :: edge + + character(len=*), parameter :: sub='read_unstruct' + !---------------------------------------------------------------------------- + + ! The name of the unstructured grid dimension is in the grid object + ! since the coordinate date was written to the restart file using + ! that object. + grid_id = cam_grid_id('GLL') + call cam_grid_get_dim_names(grid_id, dimname1, dimname2) + + allocate(dbuf2(npsq,nelemd)) + + call read_2d('PSDRY', dbuf2) + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%psdry(i,j,tl) = dbuf2(ii,ie) + ii = ii + 1 + end do + end do + end do + + deallocate(dbuf2) + + allocate(dbuf3(npsq,nlev,nelemd)) + + call read_3d('U', dbuf3) + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%v(i,j,1,:,tl) = dbuf3(ii,:,ie) + ii = ii + 1 + end do + end do + end do + + call read_3d('V', dbuf3) + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%v(i,j,2,:,tl) = dbuf3(ii,:,ie) + ii = ii + 1 + end do + end do + end do + + call read_3d('T', dbuf3) + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%T(i,j,:,tl) = dbuf3(ii,:,ie) + ii = ii + 1 + end do + end do + end do + + do m = 1, qsize + + call read_3d('dp'//trim(cnst_name(m)), dbuf3) + do ie = 1, nelemd + ii = 1 + do j = 1, np + do i = 1, np + elem(ie)%state%Qdp(i,j,:,m,tlQdp) = dbuf3(ii,:,ie) + ii = ii + 1 + end do + end do + end do + + end do + + deallocate(dbuf3) + + ! boundary exchange + if (iam < par%nprocs) then + call initEdgeBuffer(par, edge, elem, (3+qsize)*nlev + 1 ) + end if + do ie = 1, nelemd + kptr = 0 + call edgeVpack(edge, elem(ie)%state%psdry(:,:,tl), 1, kptr, ie) + kptr = kptr + 1 + call edgeVpack(edge, elem(ie)%state%v(:,:,:,:,tl), 2*nlev, kptr, ie) + kptr = kptr + (2 * nlev) + call edgeVpack(edge, elem(ie)%state%T(:,:,:,tl), nlev, kptr, ie) + kptr = kptr + nlev + call edgeVpack(edge, elem(ie)%state%Qdp(:,:,:,:,tlQdp), nlev*qsize, kptr, ie) + end do + if (iam < par%nprocs) then + call bndry_exchange(par, edge, location='read_restart_dynamics::read_ustruct') + end if + do ie = 1, nelemd + kptr = 0 + call edgeVunpack(edge, elem(ie)%state%psdry(:,:,tl), 1, kptr, ie) + kptr = kptr + 1 + call edgeVunpack(edge, elem(ie)%state%v(:,:,:,:,tl), 2*nlev, kptr, ie) + kptr = kptr + (2 * nlev) + call edgeVunpack(edge, elem(ie)%state%T(:,:,:,tl), nlev, kptr, ie) + kptr = kptr + nlev + call edgeVunpack(edge, elem(ie)%state%Qdp(:,:,:,:,tlQdp), nlev*qsize, kptr, ie) + end do + + if (iam < par%nprocs) then + call FreeEdgeBuffer(edge) + end if + +end subroutine read_unstruct + +!------------------------------------------------------------------------------- + +subroutine read_2d(fieldname, buffer) + + character(len=*), intent(in) :: fieldname + real(r8), intent(inout) :: buffer(:, :) + + logical :: found + !---------------------------------------------------------------------------- + + buffer = 0.0_r8 + call infld(trim(fieldname), file, dimname1, 1, npsq, 1, nelemd, buffer, & + found, gridname='GLL', timelevel=int(t_idx)) + if (.not. found) then + call endrun('read_restart_dynamics: read_unstruct: read_2d: Could not find ' // & + trim(fieldname)) + end if + + ! This code allows use of compiler option to set uninitialized values + ! to NaN. In that case infld can return NaNs where the element GLL points + ! are not "unique columns" + where (isnan(buffer)) buffer = 0.0_r8 + +end subroutine read_2d + +!------------------------------------------------------------------------------- + +subroutine read_3d(fieldname, buffer) + + character(len=*), intent(in) :: fieldname + real(r8), intent(inout) :: buffer(:,:,:) + + logical :: found + !---------------------------------------------------------------------------- + + buffer = 0.0_r8 + call infld(trim(fieldname), file, dimname1, 'lev', 1, npsq, 1, nlev, & + 1, nelemd, buffer, found, gridname='GLL', timelevel=int(t_idx)) + if (.not. found) then + call endrun('read_restart_dynamics: read_unstruct: read_3d: Could not find ' // & + trim(fieldname)) + end if + + ! This code allows use of compiler option to set uninitialized values + ! to NaN. In that case infld can return NaNs where the element GLL points + ! are not "unique columns" + where (isnan(buffer)) buffer = 0.0_r8 + +end subroutine read_3d + +!------------------------------------------------------------------------------- +end subroutine read_restart_dynamics + +!========================================================================================= +! Private +!========================================================================================= + +function get_restart_decomp(elem, lev) result(ldof) + + ! Get the integer mapping of a variable in the dynamics decomp in memory. + ! The canonical ordering is as on the file. A 0 value indicates that the + ! variable is not on the file (eg halo or boundary values) + + type(element_t), intent(in) :: elem(:) + integer, intent(in) :: lev + integer, pointer :: ldof(:) + + integer :: i, j, k, ie + !---------------------------------------------------------------------------- + + allocate(ldof(nelemd*np*np*lev)) + + j = 1 + do k = 1, lev + do ie = 1, nelemd + do i = 1, np*np + ldof(j) = (elem(ie)%GlobalID-1)*np*np + (k-1)*nelem_tot*np*np + i + j = j + 1 + end do + end do + end do + +end function get_restart_decomp + +!========================================================================================= + +function get_restart_decomp_fvm(elem, lev) result(ldof) + + type(element_t), intent(in) :: elem(:) + integer, intent(in) :: lev + integer, pointer :: ldof(:) + + integer :: i, j, k, ie + !---------------------------------------------------------------------------- + + allocate(ldof(nelemd*nc*nc*lev)) + + j = 1 + do k = 1, lev + do ie = 1, nelemd + do i = 1, nc*nc + ldof(j) = (elem(ie)%GlobalID-1)*nc*nc + (k-1)*nelem_tot*nc*nc + i + j = j + 1 + end do + end do + end do + +end function get_restart_decomp_fvm + +!========================================================================================= + +end module restart_dynamics diff --git a/src/dynamics/se/spmd_dyn.F90 b/src/dynamics/se/spmd_dyn.F90 new file mode 100644 index 0000000000..308a610002 --- /dev/null +++ b/src/dynamics/se/spmd_dyn.F90 @@ -0,0 +1,34 @@ +module spmd_dyn + + !----------------------------------------------------------------------- + ! + ! Purpose: SPMD implementation of CAM SE finite element dynamics. + ! + !----------------------------------------------------------------------- + + implicit none + private + + public spmdbuf + + ! These variables are not used locally, but are set and used in phys_grid. + ! They probably should be moved there. + logical, public :: local_dp_map=.true. ! flag indicates that mapping between dynamics + ! and physics decompositions does not require + ! interprocess communication + integer, public :: block_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in dynamics decomposition (including level 0) + integer, public :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) + ! in physics decomposition (including level 0) + ! assigned in phys_grid.F90 + +!======================================================================== +CONTAINS +!======================================================================== + +subroutine spmdbuf +end subroutine spmdbuf + +!======================================================================== + +end module spmd_dyn diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 new file mode 100644 index 0000000000..9aa3f27512 --- /dev/null +++ b/src/dynamics/se/stepon.F90 @@ -0,0 +1,382 @@ +module stepon + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: iam, mpicom +use ppgrid, only: begchunk, endchunk + +use physics_types, only: physics_state, physics_tend +use dyn_comp, only: dyn_import_t, dyn_export_t + +use perf_mod, only: t_startf, t_stopf, t_barrierf +use cam_abortutils, only: endrun + +use parallel_mod, only: par +use dimensions_mod, only: nelemd + +implicit none +private +save + +public stepon_init +public stepon_run1 +public stepon_run2 +public stepon_run3 +public stepon_final + +!========================================================================================= +contains +!========================================================================================= + +subroutine stepon_init(dyn_in, dyn_out ) + + use cam_history, only: addfld, add_default, horiz_only + use constituents, only: pcnst, cnst_name, cnst_longname + use dimensions_mod, only: fv_nphys, cnst_name_gll, cnst_longname_gll, qsize + + ! arguments + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + + ! local variables + integer :: m, m_cnst + !---------------------------------------------------------------------------- + ! These fields on dynamics grid are output before the call to d_p_coupling. + do m_cnst = 1, qsize + call addfld(trim(cnst_name_gll(m_cnst))//'_gll', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname_gll(m_cnst)), gridname='GLL') + call addfld(trim(cnst_name_gll(m_cnst))//'dp_gll', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname_gll(m_cnst))//'*dp', gridname='GLL') + end do + call addfld('U_gll' ,(/ 'lev' /), 'I', 'm/s ','U wind on gll grid',gridname='GLL') + call addfld('V_gll' ,(/ 'lev' /), 'I', 'm/s ','V wind on gll grid',gridname='GLL') + call addfld('T_gll' ,(/ 'lev' /), 'I', 'K ' ,'T on gll grid' ,gridname='GLL') + call addfld('PSDRY_gll' ,horiz_only , 'I', 'Pa ' ,'psdry on gll grid' ,gridname='GLL') + call addfld('PS_gll' ,horiz_only , 'I', 'Pa ' ,'ps on gll grid' ,gridname='GLL') + call addfld('PHIS_gll' ,horiz_only , 'I', 'Pa ' ,'PHIS on gll grid' ,gridname='GLL') + + ! Fields for initial condition files + call addfld('U&IC', (/ 'lev' /), 'I', 'm/s', 'Zonal wind', gridname='GLL' ) + call addfld('V&IC', (/ 'lev' /), 'I', 'm/s', 'Meridional wind',gridname='GLL' ) + ! Don't need to register U&IC V&IC as vector components since we don't interpolate IC files + call add_default('U&IC',0, 'I') + call add_default('V&IC',0, 'I') + + call addfld('PS&IC', horiz_only, 'I', 'Pa', 'Surface pressure', gridname='GLL') + call addfld('T&IC', (/ 'lev' /), 'I', 'K', 'Temperature', gridname='GLL') + call add_default('PS&IC', 0, 'I') + call add_default('T&IC', 0, 'I') + + do m_cnst = 1,pcnst + call addfld(trim(cnst_name(m_cnst))//'&IC', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname(m_cnst)), gridname='GLL') + call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I') + end do + +end subroutine stepon_init + +!========================================================================================= + +subroutine stepon_run1( dtime_out, phys_state, phys_tend, & + pbuf2d, dyn_in, dyn_out ) + + use time_manager, only: get_step_size + use dp_coupling, only: d_p_coupling + use physics_buffer, only: physics_buffer_desc + + use time_mod, only: tstep ! dynamics timestep + + real(r8), intent(out) :: dtime_out ! Time-step + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + type (physics_buffer_desc), pointer :: pbuf2d(:,:) + !---------------------------------------------------------------------------- + + dtime_out = get_step_size() + + if (iam < par%nprocs) then + if (tstep <= 0) call endrun('stepon_run1: bad tstep') + if (dtime_out <= 0) call endrun('stepon_run1: bad dtime') + + ! write diagnostic fields on gll grid and initial file + call diag_dynvar_ic(dyn_out%elem, dyn_out%fvm) + end if + + call t_barrierf('sync_d_p_coupling', mpicom) + call t_startf('d_p_coupling') + ! Move data into phys_state structure. + call d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out ) + call t_stopf('d_p_coupling') + +end subroutine stepon_run1 + +!========================================================================================= + +subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) + + use dp_coupling, only: p_d_coupling + use dyn_grid, only: TimeLevel + + use time_mod, only: TimeLevel_Qdp + use control_mod, only: qsplit + use prim_advance_mod, only: calc_tot_energy_dynamics + + ! arguments + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + + ! local variables + integer :: tl_f, tl_fQdp + !---------------------------------------------------------------------------- + + tl_f = TimeLevel%n0 ! timelevel which was adjusted by physics + call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) + + call t_barrierf('sync_p_d_coupling', mpicom) + call t_startf('p_d_coupling') + ! copy from phys structures -> dynamics structures + call p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_fQdp) + call t_stopf('p_d_coupling') + + if (iam < par%nprocs) then + call calc_tot_energy_dynamics(dyn_in%elem, 1, nelemd, tl_f, tl_fQdp, 'dED') + end if + +end subroutine stepon_run2 + +!========================================================================================= + +subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) + + use camsrfexch, only: cam_out_t + use dyn_comp, only: dyn_run + + ! arguments + real(r8), intent(in) :: dtime ! Time-step + type(cam_out_t), intent(inout) :: cam_out(:) ! Output from CAM to surface + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + !---------------------------------------------------------------------------- + + call t_barrierf('sync_dyn_run', mpicom) + call t_startf ('dyn_run') + call dyn_run(dyn_out) + call t_stopf ('dyn_run') + +end subroutine stepon_run3 + +!========================================================================================= + +subroutine stepon_final(dyn_in, dyn_out) + + type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container + type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container + +end subroutine stepon_final + +!========================================================================================= + +subroutine diag_dynvar_ic(elem, fvm) + + use cam_history, only: write_inithist, outfld, hist_fld_active, fieldname_len + use dyn_grid, only: TimeLevel + + use time_mod, only: TimeLevel_Qdp ! dynamics typestep + use control_mod, only: qsplit + use hybrid_mod, only: config_thread_region, get_loop_ranges + use hybrid_mod, only: hybrid_t + use dimensions_mod, only: np, npsq, nc, nhc, fv_nphys, qsize, ntrac, nlev + use dimensions_mod, only: qsize_condensate_loading, qsize_condensate_loading_idx_gll + use dimensions_mod, only: cnst_name_gll + use constituents, only: cnst_name + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct, n0_fvm + use fvm_mapping, only: fvm2dyn + + ! arguments + type(element_t) , intent(in) :: elem(1:nelemd) + type(fvm_struct), intent(inout) :: fvm(:) + + ! local variables + integer :: ie, i, j, m, m_cnst, nq + integer :: tl_f, tl_qdp + character(len=fieldname_len) :: tfname + + type(hybrid_t) :: hybrid + integer :: nets, nete + real(r8), allocatable :: ftmp(:,:,:) + real(r8), allocatable :: fld_fvm(:,:,:,:,:), fld_gll(:,:,:,:,:) + logical, allocatable :: llimiter(:) + real(r8) :: qtmp(np,np,nlev) + !---------------------------------------------------------------------------- + + tl_f = timelevel%n0 + call TimeLevel_Qdp(TimeLevel, qsplit, tl_Qdp) + + allocate(ftmp(npsq,nlev,2)) + + ! Output tracer fields for analysis of advection schemes + do m_cnst = 1, qsize + tfname = trim(cnst_name_gll(m_cnst))//'_gll' + if (hist_fld_active(tfname)) then + do ie = 1, nelemd + qtmp(:,:,:) = elem(ie)%state%Qdp(:,:,:,m_cnst,tl_qdp)/& + elem(ie)%state%dp3d(:,:,:,tl_f) + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,:,1) = elem(ie)%state%Qdp(i,j,:,m_cnst,tl_qdp)/& + elem(ie)%state%dp3d(i,j,:,tl_f) + end do + end do + call outfld(tfname, ftmp(:,:,1), npsq, ie) + end do + end if + end do + + do m_cnst = 1, qsize + tfname = trim(cnst_name_gll(m_cnst))//'dp_gll' + if (hist_fld_active(tfname)) then + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,:,1) = elem(ie)%state%Qdp(i,j,:,m_cnst,tl_qdp) + end do + end do + call outfld(tfname, ftmp(:,:,1), npsq, ie) + end do + end if + end do + + if (hist_fld_active('U_gll') .or. hist_fld_active('V_gll')) then + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,:,1) = elem(ie)%state%v(i,j,1,:,tl_f) + ftmp(i+(j-1)*np,:,2) = elem(ie)%state%v(i,j,2,:,tl_f) + end do + end do + call outfld('U_gll', ftmp(:,:,1), npsq, ie) + call outfld('V_gll', ftmp(:,:,2), npsq, ie) + end do + end if + + if (hist_fld_active('T_gll')) then + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,:,1) = elem(ie)%state%T(i,j,:,tl_f) + end do + end do + call outfld('T_gll', ftmp(:,:,1), npsq, ie) + end do + end if + + if (hist_fld_active('PSDRY_gll')) then + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,1,1) = elem(ie)%state%psdry(i,j,tl_f) + end do + end do + call outfld('PSDRY_gll', ftmp(:,1,1), npsq, ie) + end do + end if + + if (hist_fld_active('PS_gll')) then + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,1,1) = elem(ie)%state%psdry(i,j,tl_f) + do nq = 1, qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + ftmp(i+(j-1)*np,1,1) = ftmp(i+(j-1)*np,1,1) + & + SUM(elem(ie)%state%Qdp(i,j,:,m_cnst,tl_Qdp)) + end do + end do + end do + call outfld('PS_gll', ftmp(:,1,1), npsq, ie) + end do + end if + + if (hist_fld_active('PHIS_gll')) then + do ie = 1, nelemd + call outfld('PHIS_gll', RESHAPE(elem(ie)%state%phis, (/np*np/)), np*np, ie) + end do + end if + + if (write_inithist()) then + + do ie = 1, nelemd + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,1,1) = elem(ie)%state%psdry(i,j,tl_f) + do nq = 1, qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx_gll(nq) + ftmp(i+(j-1)*np,1,1) = ftmp(i+(j-1)*np,1,1) + & + SUM(elem(ie)%state%Qdp(i,j,:,m_cnst,tl_Qdp)) + end do + end do + end do + call outfld('PS&IC', ftmp(:,1,1), npsq, ie) + end do + + do ie = 1, nelemd + call outfld('T&IC', RESHAPE(elem(ie)%state%T(:,:,:,tl_f), (/npsq,nlev/)), npsq, ie) + call outfld('U&IC', RESHAPE(elem(ie)%state%v(:,:,1,:,tl_f), (/npsq,nlev/)), npsq, ie) + call outfld('V&IC', RESHAPE(elem(ie)%state%v(:,:,2,:,tl_f), (/npsq,nlev/)), npsq, ie) + + if (fv_nphys < 1) then + do m_cnst = 1, qsize + call outfld(trim(cnst_name(m_cnst))//'&IC', & + RESHAPE(elem(ie)%state%Qdp(:,:,:,m_cnst,tl_qdp)/& + elem(ie)%state%dp3d(:,:,:,tl_f), (/npsq,nlev/)), npsq, ie) + end do + end if + end do + + if (fv_nphys > 0) then + + !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n) + !JMD hybrid = config_thread_region(par,'horizontal') + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid, ibeg=nets, iend=nete) + + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,ntrac,nets:nete)) + allocate(fld_gll(np,np,nlev,ntrac,nets:nete)) + allocate(llimiter(ntrac)) + + llimiter = .true. + do ie = nets, nete + do m_cnst = 1, ntrac + fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst,n0_fvm) + end do + end do + + call fvm2dyn(elem(nets:nete), fld_fvm, fld_gll, hybrid, nets, nete, & + nlev, ntrac, fvm(nets:nete), llimiter) + + do ie = nets, nete + do m_cnst = 1, ntrac + call outfld(trim(cnst_name(m_cnst))//'&IC', & + RESHAPE(fld_gll(:,:,:,m_cnst,ie), (/npsq,nlev/)), npsq, ie) + end do + end do + + deallocate(fld_fvm) + deallocate(fld_gll) + deallocate(llimiter) + end if + + end if ! if (write_inithist) + + deallocate(ftmp) + +end subroutine diag_dynvar_ic + +!========================================================================================= + +end module stepon diff --git a/src/dynamics/se/test_fvm_mapping.F90 b/src/dynamics/se/test_fvm_mapping.F90 new file mode 100644 index 0000000000..cc97cccbda --- /dev/null +++ b/src/dynamics/se/test_fvm_mapping.F90 @@ -0,0 +1,735 @@ +module test_fvm_mapping + use shr_kind_mod, only: r8=>shr_kind_r8 + use fvm_control_volume_mod, only: fvm_struct + use cam_history, only: outfld + use physconst, only: pi + use dimensions_mod, only: qsize_condensate_loading,qsize_condensate_loading_idx + use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac + use element_mod, only: element_t + implicit none + private + + real(r8), parameter, private :: deg2rad = pi/180.0_r8 + real(r8), parameter, private :: psurf_moist = 100000.0_r8 !moist surface pressure + + public :: test_mapping_overwrite_tendencies, test_mapping_addfld + public :: test_mapping_output_mapped_tendencies, test_mapping_overwrite_dyn_state + public :: test_mapping_output_phys_state +contains + + subroutine test_mapping_addfld +#ifdef debug_coupling + use cam_history, only: addfld, add_default, horiz_only, register_vector_field + use constituents, only: cnst_get_ind,cnst_name + character(LEN=128) :: name + integer :: nq,m_cnst + + name = 'd2p_u_gll' + call addfld(trim(name), (/ 'lev' /), 'I','m/2','Exact zonal wind on GLL grid',gridname='GLL') + call add_default (trim(name), 1, ' ') + + name = 'd2p_v_gll' + call addfld(trim(name), (/ 'lev' /), 'I','m/2','Exact meridional wind on GLL grid',gridname='GLL') + call add_default (trim(name), 1, ' ') + + name = 'd2p_scalar_gll' + call addfld(trim(name), (/ 'lev' /), 'I','','Exact scalar on GLL grid',gridname='GLL') + call add_default (trim(name), 1, ' ') + + name = 'd2p_u' + call addfld(trim(name), (/ 'lev' /), 'I','m/2','Zonal wind mapped to physics grid') + call add_default (trim(name), 1, ' ') + + name = 'd2p_u_err' + call addfld(trim(name), (/ 'lev' /), 'I','m/2','Error in zonal wind mapped to physics grid') + call add_default (trim(name), 1, ' ') + + name = 'd2p_v_err' + call addfld(trim(name), (/ 'lev' /), 'I','m/2','Error in meridional wind mapped to physics grid') + call add_default (trim(name), 1, ' ') + + name = 'd2p_v' + call addfld(trim(name), (/ 'lev' /), 'I','m/s','Meridional wind mapped to physics grid') + call add_default (trim(name), 1, ' ') + + name = 'd2p_scalar' + call addfld(trim(name), (/ 'lev' /), 'I','','Scalar mapped to physics grid') + call add_default (trim(name), 1, ' ') + + name = 'd2p_scalar_err' + call addfld(trim(name), (/ 'lev' /), 'I','','Error in scalar mapped to physics grid') + call add_default (trim(name), 1, ' ') + + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + name = 'f2p_'//trim(cnst_name(m_cnst))//'_fvm' + call addfld(trim(name), (/ 'lev' /), 'I','','Exact water tracer on fvm grid',gridname='FVM') + call add_default (trim(name), 1, ' ') + name = 'f2p_'//trim(cnst_name(m_cnst))//'_err' + call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer on physics grid (mapped from fvm grid)') + call add_default (trim(name), 1, ' ') + name = 'f2p_'//trim(cnst_name(m_cnst))//'' + call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid (mapped from fvm grid') + call add_default (trim(name), 1, ' ') + ! + ! physgrid to gll (condensate loading tracers) + ! + name = 'p2d_'//trim(cnst_name(m_cnst))//'' + call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid') + call add_default (trim(name), 1, ' ') + name = 'p2d_'//trim(cnst_name(m_cnst))//'_gll' + call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on GLL grid',gridname='GLL') + call add_default (trim(name), 1, ' ') + name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' + call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer mapped to GLL grid',gridname='GLL') + call add_default (trim(name), 1, ' ') + ! + ! physgrid to fvm (condensate loading tracers) + ! + name = 'p2f_'//trim(cnst_name(m_cnst))//'' + call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid') + call add_default (trim(name), 1, ' ') + name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' + call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on FVM grid',gridname='FVM') + call add_default (trim(name), 1, ' ') + name = 'p2f_'//trim(cnst_name(m_cnst))//'_err_fvm' + call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer mapped to FVM grid',gridname='FVM') + call add_default (trim(name), 1, ' ') + end do + call addfld('p2d_u', (/ 'lev' /), 'I','m/2','Zonal wind on physics grid') + call add_default ('p2d_u', 1, ' ') + call addfld('p2d_v', (/ 'lev' /), 'I','m/2','Meridional wind on physics grid') + call add_default ('p2d_v', 1, ' ') + call addfld('p2d_u_gll', (/ 'lev' /), 'I','m/2','Zonal wind on physics grid',gridname='GLL') + call add_default ('p2d_u_gll', 1, ' ') + call addfld('p2d_v_gll', (/ 'lev' /), 'I','m/2','Meridional wind on physics grid',gridname='GLL') + call add_default ('p2d_v_gll', 1, ' ') + call addfld('p2d_u_gll_err', (/ 'lev' /), 'I','m/2','Error in zonal wind interpolation to GLL grid',gridname='GLL') + call add_default ('p2d_u_gll_err', 1, ' ') + call addfld('p2d_v_gll_err', (/ 'lev' /), 'I','m/2','Error in meridional wind interpolation to GLL grid',& + gridname='GLL') + call add_default ('p2d_v_gll_err', 1, ' ') + +! name = 'phys2dyn_'//trim(cnst_name(m_cnst))//'_physgrid' +! call outfld(trim(name),phys_state%q(:ncols,:,m_cnst),ncols,lchnk) +#endif + end subroutine test_mapping_addfld + + subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,lchnk,q_prev) + use dimensions_mod, only: fv_nphys + use constituents, only: cnst_get_ind,pcnst,cnst_name + use physics_types, only: physics_state, physics_tend + type(physics_state), intent(inout) :: phys_state + type(physics_tend), intent(inout) :: phys_tend + real(r8), dimension(:,:,:), intent(inout) :: q_prev +! type(fvm_struct), intent(inout):: fvm(:) + integer, intent(in) :: ncols,lchnk +#ifdef debug_coupling + integer :: icol,k + character(LEN=128) :: name + integer :: m_cnst, nq + + q_prev = 0.0_r8 + phys_state%pdel(1:ncols,:) = phys_state%pdeldry(1:ncols,:) !make sure there is no conversion from wet to dry + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + do icol=1,ncols + do k=1,8 + phys_state%q(icol,k,m_cnst) = test_func(phys_state%lat(icol), phys_state%lon(icol), k, k) + end do + enddo + name = 'p2f_'//trim(cnst_name(m_cnst))//'' + call outfld(trim(name),phys_state%q(:ncols,:,m_cnst),ncols,lchnk) + end do + + do icol=1,ncols + do k=1,nlev + phys_tend%dudt(icol,k) = test_func(phys_state%lat(icol), phys_state%lon(icol), k, 9) + phys_tend%dvdt(icol,k) = test_func(phys_state%lat(icol), phys_state%lon(icol), k,10) + end do + enddo + name = 'p2d_u' + call outfld(trim(name),phys_tend%dudt(:ncols,:),ncols,lchnk) + name = 'p2d_v' + call outfld(trim(name),phys_tend%dvdt(:ncols,:),ncols,lchnk) + +! do icol=1,ncols +! do k=1,nlev +! phys_tend%dudt(icol,k) = 0.0_r8 +! phys_tend%dvdt(icol,k) = 0.0_r8 +! end do +! enddo +#endif + end subroutine test_mapping_overwrite_tendencies + + subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) + use dimensions_mod, only: fv_nphys,nlev,nc + use constituents, only: cnst_get_ind,cnst_name + integer, intent(in) :: nets,nete,tl_f,tl_qdp + type(fvm_struct), intent(inout):: fvm(nets:nete) + type(element_t), intent(inout):: elem(nets:nete) ! pointer to dyn_out element array +#ifdef debug_coupling + integer :: ie,i,j,k + character(LEN=128) :: name + integer :: nq,m_cnst + real(r8) :: diff(nc,nc,nlev) + + do ie = nets,nete + call outfld('p2d_u_gll', RESHAPE(elem(ie)%derived%fm(:,:,1,:,1),(/npsq,nlev/)), npsq, ie) + call outfld('p2d_v_gll', RESHAPE(elem(ie)%derived%fm(:,:,2,:,1),(/npsq,nlev/)), npsq, ie) + do k=1,nlev + do j=1,np + do i=1,np + elem(ie)%derived%fm(i,j,1,k,1) = elem(ie)%derived%fm(i,j,1,k,1) -& + test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k, 9) + elem(ie)%derived%fm(i,j,2,k,1) = elem(ie)%derived%fm(i,j,2,k,1) - & + test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k,10) + end do + end do + end do + call outfld('p2d_u_gll_err', RESHAPE(elem(ie)%derived%fm(:,:,1,:,1),(/npsq,nlev/)), npsq, ie) + call outfld('p2d_v_gll_err', RESHAPE(elem(ie)%derived%fm(:,:,2,:,1),(/npsq,nlev/)), npsq, ie) + end do + + do ie = nets,nete + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + name = 'p2d_'//trim(cnst_name(m_cnst))//'_gll' + call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq,1),(/npsq,nlev/)), npsq, ie) + ! call outfld(trim(name),& + ! RESHAPE(fvm(ie)%fc(1:nc,1:nc,:,m_cnst),& + ! (/nc*nc,nlev/)),nc*nc,ie) + do k=1,8 + do j=1,np + do i=1,np + elem(ie)%derived%fq(i,j,k,nq,1) = elem(ie)%derived%fq(i,j,k,nq,1)-& + test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k, k) + end do + end do + end do + name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' + call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq,1),(/npsq,nlev/)), npsq, ie) + end do + if (ntrac>0) then + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' + call outfld(trim(name),& + RESHAPE(fvm(ie)%fc(1:nc,1:nc,:,m_cnst),& + (/nc*nc,nlev/)),nc*nc,ie) + do k=1,8 + do j=1,nc + do i=1,nc + fvm(ie)%fc(i,j,k,m_cnst) = fvm(ie)%fc(i,j,k,m_cnst)-& + test_func(fvm(ie)%center_cart(i,j)%lat,fvm(ie)%center_cart(i,j)%lon, k, k) + end do + end do + end do + name = 'p2f_'//trim(cnst_name(m_cnst))//'_err_fvm' + call outfld(TRIM(name), RESHAPE(fvm(ie)%fc(:,:,:,m_cnst),(/nc*nc,nlev/)), nc*nc, ie) + + end do + endif + end do +#endif + end subroutine test_mapping_output_mapped_tendencies + + + subroutine test_mapping_overwrite_dyn_state(elem,fvm,tl_f) + use fvm_control_volume_mod, only: fvm_struct + use constituents, only: cnst_name + use dimensions_mod, only: nc + type (fvm_struct), intent(inout) :: fvm(:) + integer, intent(in) :: tl_f + type(element_t), intent(inout) :: elem(:) ! pointer to dyn_out element array +#ifdef debug_coupling + integer :: i,j,k,ie,nq,m_cnst + character(LEN=128) :: name + do ie=1,nelemd + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + name = 'f2p_'//trim(cnst_name(m_cnst))//'_fvm' + do k=1,8 + do j=1,nc + do i=1,nc + fvm(ie)%c(i,j,k,m_cnst,:) = test_func(fvm(ie)%center_cart(i,j)%lat,fvm(ie)%center_cart(i,j)%lon, k, k) + end do + end do + end do + call outfld(TRIM(name), RESHAPE(fvm(ie)%c(:,:,:,m_cnst,1),(/nc*nc,nlev/)), nc*nc, ie) + end do + + + elem(ie)%state%Qdp(:,:,:,:,:) = 0.0_r8 !for testing the p2d map + do k=1,nlev + do j=1,np + do i=1,np + elem(ie)%state%v(i,j,1,k,:) = test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k, 9 ) + elem(ie)%state%v(i,j,2,k,:) = test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k, 10) + end do + end do + end do + do k=1,8 + do j=1,np + do i=1,np + elem(ie)%derived%omega(i,j,k) = test_func(elem(ie)%spherep(i,j)%lat, elem(ie)%spherep(i,j)%lon, k, k) + end do + end do + end do + call outfld('d2p_scalar_gll', RESHAPE(elem(ie)%derived%omega(:,:,:) ,(/npsq,nlev/)), npsq, ie) + call outfld('d2p_u_gll', RESHAPE(elem(ie)%state%v(:,:,1,:,1),(/npsq,nlev/)), npsq, ie) + call outfld('d2p_v_gll', RESHAPE(elem(ie)%state%v(:,:,2,:,1),(/npsq,nlev/)), npsq, ie) + end do +#endif + end subroutine test_mapping_overwrite_dyn_state + + subroutine test_mapping_output_phys_state(phys_state,fvm) + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk, pver, pcols + use constituents, only: cnst_get_ind,cnst_name + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(fvm_struct), pointer:: fvm(:) +#ifdef debug_coupling + integer :: lchnk, ncol,k,icol,m_cnst,nq,ie + character(LEN=128) :: name + + do ie=1,nelemd + fvm(ie)%c(:,:,:,:,:) = 0.0_r8 + end do + + do lchnk = begchunk, endchunk + call outfld('d2p_scalar', phys_state(lchnk)%omega(1:pcols,1:pver), pcols, lchnk) + call outfld('d2p_u', phys_state(lchnk)%U(1:pcols,1:pver), pcols, lchnk) + call outfld('d2p_v', phys_state(lchnk)%V(1:pcols,1:pver), pcols, lchnk) + if (ntrac>0) then + do nq=2,qsize_condensate_loading + m_cnst = qsize_condensate_loading_idx(nq) + name = 'f2p_'//trim(cnst_name(m_cnst)) + call outfld(TRIM(name), phys_state(lchnk)%q(1:pcols,1:pver,m_cnst), pcols, lchnk) + phys_state(lchnk)%q(1:pcols,1:pver,m_cnst) = 0.0_r8 + + do k=1,8 + do icol=1,phys_state(lchnk)%ncol + phys_state(lchnk)%q(icol,k,m_cnst) = phys_state(lchnk)%q(icol,k,m_cnst)& + -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k, 9) + phys_state(lchnk)%q(icol,k,m_cnst) = phys_state(lchnk)%q(icol,k,m_cnst)& + -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k,10) + end do + enddo + name = 'f2p_'//trim(cnst_name(m_cnst))//'_err' + call outfld(TRIM(name), phys_state(lchnk)%q(1:pcols,1:pver,m_cnst), pcols, lchnk) + phys_state(lchnk)%q(1:pcols,1:pver,m_cnst) = 0.0_r8 + end do + end if + end do + + + do lchnk = begchunk, endchunk + do k=1,nlev + do icol=1,phys_state(lchnk)%ncol + phys_state(lchnk)%U(icol,k) = phys_state(lchnk)%U(icol,k)& + -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k, 9) + phys_state(lchnk)%V(icol,k) = phys_state(lchnk)%V(icol,k)& + -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k,10) + end do + enddo + name = 'd2p_u_err' + call outfld(trim(name),phys_state(lchnk)%U(:pcols,:),pcols,lchnk) + name = 'd2p_v_err' + call outfld(trim(name),phys_state(lchnk)%V(:pcols,:),pcols,lchnk) + do k=1,8 + do icol=1,phys_state(lchnk)%ncol + phys_state(lchnk)%omega(icol,k) = phys_state(lchnk)%omega(icol,k)& + -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k,k) + end do + end do + name = 'd2p_scalar_err' + call outfld(trim(name),phys_state(lchnk)%omega(:pcols,:),pcols,lchnk) + end do +#endif + end subroutine test_mapping_output_phys_state + +! subroutine test_mapping_overwrite_state(phys_tend,nets,nete) +!#ifdef debug_coupling +! phys_tend(lchnk)%dtdt(icol,ilyr) = 0!test_func(phys_state(lchnk)%lat(icol),phys_state(lchnk)%lon(icol),ilyr,9) +! phys_tend(lchnk)%dudt(icol,ilyr) = 0!test_func(phys_state(lchnk)%lat(icol),phys_state(lchnk)%lon(icol),ilyr,12) +! phys_tend(lchnk)%dvdt(icol,ilyr) = 0!test_func(phys_state(lchnk)%lat(icol),phys_state(lchnk)%lon(icol),ilyr,13) +! q_prev(icol, ilyr, 2:pcnst, lchnk) = 0.0D0 +! do m=2,pcnst +! phys_state(lchnk)%Q(icol,ilyr,m)=0!test_func(phys_state(lchnk)%lat(icol),phys_state(lchnk)%lon(icol),ilyr,m) +! end do +!#endif +! end subroutine test_mapping_overwrite_state + +#ifdef debug_coupling + function test_func(lat_in, lon_in, k, funcnum) result(fout) + use hycoef, only: hyai, hybi, hyam, hybm, ps0 + use shr_sys_mod, only: shr_sys_flush + use cam_abortutils, only: endrun + real(r8), intent(in) :: lon_in + real(r8), intent(in) :: lat_in + integer, intent(in) :: k + integer, intent(in) :: funcnum + real(r8) :: fout + real(r8) :: lon1,lat1,R0,Rg1,Rg2,lon2,lat2,cl,cl2 + real(r8) :: eta_c + + real(r8) :: radius = 10.0_r8 ! radius of the perturbation + real(r8) :: perturb_lon = 20.0_r8 ! longitudinal position, 20E + real(r8) :: perturb_lat = 40.0_r8 ! latitudinal position, 40N + real(r8) :: cos_tmp, sin_tmp, eta + real(r8) :: u_wind, v_wind, lat, lon, u_tmp, v_tmp + real(r8) :: rotation_angle + + + lon = lon_in + lat = lat_in + + + select case(funcnum) + case(1) + ! + ! Non-smooth scalar field (slotted cylinder) + ! + R0 = 0.5_r8 + lon1 = 4.0_r8 * PI / 5.0_r8 + lat1 = 0.0_r8 + Rg1 = acos(sin(lat1)*sin(lat)+cos(lat1)*cos(lat)*cos(lon-lon1)) + lon2 = 6.0_r8 * PI / 5.0_r8 + lat2 = 0.0_r8 + Rg2 = acos(sin(lat2)*sin(lat)+cos(lat2)*cos(lat)*cos(lon-lon2)) + + if ((Rg1 <= R0) .AND. (abs(lon-lon1) >= R0/6)) then + fout = 2.0_r8 + elseif ((Rg2 <= R0) .AND. (abs(lon-lon2) >= R0/6)) then + fout = 2.0_r8 + elseif ((Rg1 <= R0) .AND. (abs(lon-lon1) < R0/6) & + .AND. (lat-lat1 < -5.0_r8*R0/12.0_r8)) then + fout = 2.0_r8 + elseif ((Rg2 <= R0) .AND. (abs(lon-lon2) < R0/6) & + .AND. (lat-lat2 > 5.0_r8*R0/12.0_r8)) then + fout = 2.0_r8 + else + fout = 1.0_r8 + endif + case(2) + ! + ! Smooth Gaussian "ball" + ! + R0 = 10.0_r8 ! radius of the perturbation + lon1 = 20.0_r8*deg2rad ! longitudinal position, 20E + lat1 = 40.0_r8 *deg2rad ! latitudinal position, 40N + eta_c = 0.6_r8 + sin_tmp = SIN(lat1)*SIN(lat) + cos_tmp = COS(lat1)*COS(lat) + Rg1 = ACOS( sin_tmp + cos_tmp*COS(lon-lon1) ) ! great circle distance + eta = (hyam(k)*ps0 + hybm(k)*psurf_moist)/psurf_moist + fout = EXP(- ((Rg1*R0)**2 + ((eta-eta_c)/0.1_r8)**2)) + if (ABS(fout) < 1.0E-8_r8) then + fout = 0.0_r8 + end IF + case(3) + ! + ! + ! + fout = 0.5_r8 * ( tanh( 3.0_r8*abs(lat)-pi ) + 1.0_r8) + case(4) + fout = 1.0e-8_r8 + case(5) + ! + ! approximately Y^2_2 spherical harmonic + ! + fout = 0.5_r8 + 0.5_r8*(cos(lat)*cos(lat)*cos(2.0_r8*lon)) + case(6) + ! + ! approximately Y32_16 spherical harmonic + ! + fout = 0.5_r8 + 0.5_r8*(cos(16*lon)*(sin(2_r8*lat)**16)) + case(7) + fout = 2.0_r8 + lat + case(8) + fout = 2.0_r8 + cos(lon) + case(9) + rotation_angle = 45.0_r8*pi/180.0_r8 + CALL regrot(lon_in,lat_in,lon,lat,0.0_r8,-0.5_r8*pi+rotation_angle,1) + call Rossby_Haurwitz (lon, lat,u_wind, v_wind) + CALL turnwi(u_wind,v_wind,u_tmp,v_tmp,lon_in,lat_in,lon,lat,0.0_r8,-0.5_r8*pi+rotation_angle,-1) + fout = u_tmp + case(10) + rotation_angle = 45.0_r8*pi/180.0_r8 + CALL regrot(lon_in,lat_in,lon,lat,0.0_r8,-0.5_r8*pi+rotation_angle,1) + call Rossby_Haurwitz (lon, lat,u_wind, v_wind) + CALL turnwi(u_wind,v_wind,u_tmp,v_tmp,lon_in,lat_in,lon,lat,0.0_r8,-0.5_r8*pi+rotation_angle,-1) + fout = v_tmp + case default + call endrun("Illegal funcnum_arg in test_func") + end select + end function test_func + + function test_wind(lat, lon, iwind) result(fout) + use cam_abortutils, only: endrun + real(r8), intent(in) :: lon + real(r8), intent(in) :: lat + integer, intent(in) :: iwind + + real(r8) :: fout + + + fout = 0 + end function test_wind + + + SUBROUTINE regrot(pxreg,pyreg,pxrot,pyrot,pxcen,pycen,kcall) + use physconst, only: pi +! +!---------------------------------------------------------------------- +! +!* conversion between regular and rotated spherical coordinates. +!* +!* pxreg longitudes of the regular coordinates +!* pyreg latitudes of the regular coordinates +!* pxrot longitudes of the rotated coordinates +!* pyrot latitudes of the rotated coordinates +!* all coordinates given in degrees n (negative for s) +!* and degrees e (negative values for w) +!* pxcen regular longitude of the south pole of the rotated grid +!* pycen regular latitude of the south pole of the rotated grid +!* +!* kcall=-1: find regular as functions of rotated coordinates. +!* kcall= 1: find rotated as functions of regular coordinates. +! +!----------------------------------------------------------------------- +! + integer kxdim,kydim,kx,ky,kcall + real(r8) :: pxreg,pyreg,& + pxrot,pyrot,& + pxcen,pycen +! +!----------------------------------------------------------------------- +! + real(r8) zsycen,zcycen,zxmxc,zsxmxc,zcxmxc,zsyreg,zcyreg, & + zsyrot,zcyrot,zcxrot,zsxrot,zpi,zpih + integer jy,jx + + zpih = pi*0.5_r8 +! + !---------------------------------------------------------------------- +! + zsycen = SIN((pycen+zpih)) + zcycen = COS((pycen+zpih)) +! + IF (kcall.eq.1) then +! + zxmxc = pxreg - pxcen + zsxmxc = SIN(zxmxc) + zcxmxc = COS(zxmxc) + zsyreg = SIN(pyreg) + zcyreg = COS(pyreg) + zsyrot = zcycen*zsyreg - zsycen*zcyreg*zcxmxc + zsyrot = max(zsyrot,-1.0_r8) + zsyrot = min(zsyrot,+1.0_r8) + ! + pyrot = ASIN(zsyrot) + ! + zcyrot = COS(pyrot) + zcxrot = (zcycen*zcyreg*zcxmxc +zsycen*zsyreg)/zcyrot + zcxrot = max(zcxrot,-1.0_r8) + zcxrot = min(zcxrot,+1.0_r8) + zsxrot = zcyreg*zsxmxc/zcyrot + ! + pxrot = ACOS(zcxrot) + ! + IF (zsxrot < 0.0_r8) then + pxrot = -pxrot + end IF + ! + ELSEIF (kcall.eq.-1) then + ! + zsxrot = SIN(pxrot) + zcxrot = COS(pxrot) + zsyrot = SIN(pyrot) + zcyrot = COS(pyrot) + zsyreg = zcycen*zsyrot + zsycen*zcyrot*zcxrot + zsyreg = max(zsyreg,-1.0_r8) + zsyreg = min(zsyreg,+1.0_r8) + ! + pyreg = ASIN(zsyreg) + ! + zcyreg = COS(pyreg) + zcxmxc = (zcycen*zcyrot*zcxrot -& + zsycen*zsyrot)/zcyreg + zcxmxc = max(zcxmxc,-1.0_r8) + zcxmxc = min(zcxmxc,+1.0_r8) + zsxmxc = zcyrot*zsxrot/zcyreg + zxmxc = ACOS(zcxmxc) + IF (zsxmxc < 0.0_r8) then + zxmxc = -zxmxc + end IF + ! + pxreg = zxmxc + pxcen + ! + ELSE + WRITE(6,'(1x,''invalid kcall in regrot'')') + STOP + ENDIF + END SUBROUTINE regrot + + SUBROUTINE turnwi(puarg,pvarg,pures,pvres,pxreg,pyreg,pxrot,pyrot,pxcen,pycen,kcall) + use physconst, only: pi + ! + !----------------------------------------------------------------------- + ! + !* turn horizontal velocity components between regular and + !* rotated spherical coordinates. + ! + !* puarg : input u components + !* pvarg : input v components + !* pures : output u components + !* pvres : output v components + !* pa : transformation coefficients + !* pb : -"- + !* pc : -"- + !* pd : -"- + !* pxreg : regular longitudes + !* pyreg : regular latitudes + !* pxrot : rotated longitudes + !* pyrot : rotated latitudes + !* kxdim : dimension in the x (longitude) direction + !* kydim : dimension in the y (latitude) direction + !* kx : number of gridpoints in the x direction + !* ky : number of gridpoints in the y direction + !* pxcen : regular longitude of the south pole of the + !* transformed grid + !* pycen : regular latitude of the south pole of the + !* transformed grid + !* + !* kcall < 0 : find wind components in regular coordinates + !* from wind components in rotated coordinates + !* kcall > 0 : find wind components in rotated coordinates + !* from wind components in regular coordinates + !* note that all coordinates are given in degrees n and degrees e. + !* (negative values for s and w) + ! + !----------------------------------------------------------------------- + + integer kxdim,kydim,kx,ky,kcall + real(r8) puarg,pvarg, & + pures,pvres, & + pa, pb, & + pc, pd, & + pxreg,pyreg, & + pxrot,pyrot + real(r8) pxcen,pycen + ! + !----------------------------------------------------------------------- + ! + integer jy,jx + real(r8) zpih,zsyc,zcyc,zsxreg,zcxreg,zsyreg,zcyreg,zxmxc,& + zsxmxc,zcxmxc,zsxrot,zcxrot,zsyrot,zcyrot + ! + !----------------------------------------------------------------------- + ! + IF (kcall.eq.1) then + zpih = pi*0.5_r8 + zsyc = SIN(pycen+zpih) + zcyc = COS(pycen+zpih) + ! + zsxreg = SIN(pxreg) + zcxreg = COS(pxreg) + zsyreg = SIN(pyreg) + zcyreg = COS(pyreg) + ! + zxmxc = pxreg - pxcen + zsxmxc = SIN(zxmxc) + zcxmxc = COS(zxmxc) + ! + zsxrot = SIN(pxrot) + zcxrot = COS(pxrot) + zsyrot = SIN(pyrot) + zcyrot = COS(pyrot) + ! + pa = zcyc*zsxmxc*zsxrot + zcxmxc*zcxrot + pb = zcyc*zcxmxc*zsyreg*zsxrot - zsyc*zcyreg*zsxrot - & + zsxmxc*zsyreg*zcxrot + pc = zsyc*zsxmxc/zcyrot + pd = (zsyc*zcxmxc*zsyreg + zcyc*zcyreg)/zcyrot + ! + pures = pa*puarg + pb*pvarg + pvres = pc*puarg + pd*pvarg + ELSEIF (kcall.eq.-1) then + zpih = pi*0.5_r8 + zsyc = SIN(pycen+zpih) + zcyc = COS(pycen+zpih) + ! + zsxreg = SIN(pxreg) + zcxreg = COS(pxreg) + zsyreg = SIN(pyreg) + zcyreg = COS(pyreg) + ! + zxmxc = pxreg - pxcen + zsxmxc = SIN(zxmxc) + zcxmxc = COS(zxmxc) + ! + zsxrot = SIN(pxrot) + zcxrot = COS(pxrot) + zsyrot = SIN(pyrot) + zcyrot = COS(pyrot) + ! + pa = zcxmxc*zcxrot + zcyc*zsxmxc*zsxrot + pb = zcyc*zsxmxc*zcxrot*zsyrot + zsyc*zsxmxc*zcyrot -& + zcxmxc*zsxrot*zsyrot + pc =-zsyc*zsxrot/zcyreg + pd = (zcyc*zcyrot - zsyc*zcxrot*zsyrot)/zcyreg + ! + pures = pa*puarg + pb*pvarg + pvres = pc*puarg + pd*pvarg + ELSE + write(6,'(1x,''invalid kcall in turnwi'')') + STOP + ENDIF + END SUBROUTINE turnwi + + SUBROUTINE Rossby_Haurwitz (lon, lat,u_wind, v_wind) + use physconst, only: rearth +!----------------------------------------------------------------------- +! input parameters +!----------------------------------------------------------------------- + real(r8), intent(in) :: lon, & ! longitude in radians + lat ! latitude in radians + ! both coefficients 'a' and 'b' are needed at the full model level +!----------------------------------------------------------------------- +! input parameters +!----------------------------------------------------------------------- + real(r8), intent(out) :: u_wind, & ! zonal wind in m/s + v_wind ! meridional wind in m/s + +!----------------------------------------------------------------------- +! test case parameters +!----------------------------------------------------------------------- + real(r8),parameter :: u0 = 50._r8, & ! reference wind + n = 4._r8 ! wavenumber + +!----------------------------------------------------------------------- +! local +!----------------------------------------------------------------------- + real(r8) :: tmp1, tmp2, tmp3, KK, MM + real(r8) :: sin_lat, cos_lat, sin_slat, cos_slat + +!----------------------------------------------------------------------- +! initialize the wind components +!----------------------------------------------------------------------- + MM = u0/(n*rearth) ! parameter M + KK = u0/(n*rearth) ! parameter K + + + cos_lat = cos(lat) + sin_lat = sin(lat) + tmp1 = rearth * MM * cos_lat + tmp2 = rearth * KK * cos_lat**(n-1._r8)*(n*sin_lat**2 - cos_lat**2) + tmp3 = -rearth * KK * n * cos_lat**(n-1._r8) * sin_lat + u_wind = tmp1 + tmp2 * cos(n*lon) + v_wind = tmp3 * sin(n*lon) + end subroutine Rossby_Haurwitz + +#endif +end module test_fvm_mapping diff --git a/src/dynamics/tests/dyn_tests_utils.F90 b/src/dynamics/tests/dyn_tests_utils.F90 new file mode 100644 index 0000000000..3a3596b0d5 --- /dev/null +++ b/src/dynamics/tests/dyn_tests_utils.F90 @@ -0,0 +1,23 @@ +module dyn_tests_utils +!----------------------------------------------------------------------- +! +! Utility data (and code) for dynamics testing +! +! The public items in this module are items used both by internal code +! (e.g., analytic initial conditions) and by infrastructure which uses +! the internal code (e.g., read_inidat). They cannot be members of the +! internal code because that is conditionally compiled. +! +!----------------------------------------------------------------------- + + + implicit none + private + save + + integer, parameter :: vc_moist_pressure = 0 ! Moist pressure vertical coord + integer, parameter :: vc_dry_pressure = 1 ! Dry pressure vertical coord + integer, parameter :: vc_height = 2 ! Height vertical coord + public :: vc_moist_pressure, vc_dry_pressure, vc_height + +end module dyn_tests_utils diff --git a/src/dynamics/tests/inic_analytic.F90 b/src/dynamics/tests/inic_analytic.F90 new file mode 100644 index 0000000000..62f21c7bbe --- /dev/null +++ b/src/dynamics/tests/inic_analytic.F90 @@ -0,0 +1,570 @@ +module inic_analytic + + !----------------------------------------------------------------------- + ! + ! Purpose: Set analytic initial conditions based on input coordinates + ! + ! + !----------------------------------------------------------------------- + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use shr_sys_mod, only: shr_sys_flush + use inic_analytic_utils, only: analytic_ic_active, analytic_ic_type + + implicit none + private + + public :: analytic_ic_active ! forwarded from init_analytic_utils + public :: analytic_ic_set_ic ! Set analytic initial conditions + + interface analytic_ic_set_ic + module procedure dyn_set_inic_cblock + end interface analytic_ic_set_ic + + ! Private module variables + integer :: call_num = 0 + + ! Private interface +#ifdef ANALYTIC_IC + interface get_input_shape + module procedure get_input_shape_2d + module procedure get_input_shape_3d + end interface get_input_shape +#endif + +!============================================================================== +CONTAINS +!============================================================================== + + subroutine dyn_set_inic_col(vcoord, latvals, lonvals, glob_ind, U, V, T, & + PS, PHIS, Q, m_cnst, mask, verbose) + use cam_initfiles, only: pertlim +#ifdef ANALYTIC_IC + use ic_held_suarez, only: hs94_set_ic + use ic_baroclinic, only: bc_wav_set_ic +#endif + use spmd_utils, only: masterproc + !----------------------------------------------------------------------- + ! + ! Purpose: Set analytic initial values for dynamics state variables + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + integer , intent(in) :: vcoord ! See dyn_tests_utils + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + integer, intent(in) :: glob_ind(:) ! global column index + real(r8), optional, intent(inout) :: U(:,:) ! zonal velocity + real(r8), optional, intent(inout) :: V(:,:) ! meridional velocity + real(r8), optional, intent(inout) :: T(:,:) ! temperature + real(r8), optional, intent(inout) :: PS(:) ! surface pressure + real(r8), optional, intent(inout) :: PHIS(:) ! surface geopotential + real(r8), optional, intent(inout) :: Q(:,:,:) ! tracer (ncol, lev, m) + integer, optional, intent(in) :: m_cnst(:) ! tracer indices (reqd. if Q) + logical, optional, intent(in) :: mask(:) ! Only init where .true. + logical, optional, intent(in) :: verbose ! For internal use + + ! Local variables + logical :: verbose_use + logical, allocatable :: mask_use(:) + real(r8) :: pertval + integer, allocatable :: rndm_seed(:) + integer :: rndm_seed_sz + integer :: i, k + integer :: ncol, nlev + character(len=*), parameter :: subname = 'DYN_SET_INIC_COL' + +#ifdef ANALYTIC_IC + allocate(mask_use(size(latvals))) + if (present(mask)) then + if (size(mask_use) /= size(mask)) then + call endrun('cnst_init_default: input, mask, is wrong size') + end if + mask_use = mask + else + mask_use = .true. + end if + + if (present(verbose)) then + verbose_use = verbose + else + verbose_use = .true. + end if + + ! Basic size sanity checks + if (size(latvals) /= size(lonvals)) then + call endrun(subname//'latvals and lonvals must have same size') + end if + if (present(U)) then + if (size(U) > 0) then + call check_array_size(U(:,1), 'U', latvals, subname) + else + return + end if + end if + if (present(V)) then + if (size(V) > 0) then + call check_array_size(V(:,1), 'V', latvals, subname) + else + return + end if + end if + if (present(T)) then + if (size(T) > 0) then + call check_array_size(T(:,1), 'T', latvals, subname) + else + return + end if + end if + if (present(PS)) then + if (size(PS) > 0) then + call check_array_size(PS, 'PS', latvals, subname) + else + return + end if + end if + if (present(PHIS)) then + if (size(PHIS) > 0) then + call check_array_size(PHIS, 'PHIS', latvals, subname) + else + return + end if + end if + ! Some special checks on the tracer argument + if (present(Q)) then + if (.not. present(m_cnst)) then + call endrun(subname//'m_cnst is required if Q is present') + end if + if (size(Q, 3) /= size(m_cnst, 1)) then + call endrun(subname//': size of m_cnst must match last dimension of Q') + end if + if (size(Q) > 0) then + call check_array_size(Q(:,1,1), 'Q', latvals, subname) + else + return + end if + end if + + select case(trim(analytic_ic_type)) + case('held_suarez_1994') + call hs94_set_ic(latvals, lonvals, U=U, V=V, T=T, PS=PS, PHIS=PHIS, & + Q=Q, m_cnst=m_cnst, mask=mask_use, verbose=verbose_use) + + case('baroclinic_wave', 'dry_baroclinic_wave') + + + call bc_wav_set_ic(vcoord, latvals, lonvals, U=U, V=V, T=T, PS=PS, & + PHIS=PHIS, Q=Q, m_cnst=m_cnst, mask=mask_use, verbose=verbose_use) + + case default + call endrun(subname//': Unknown analytic_ic_type, "'//trim(analytic_ic_type)//'"') + end select + + ! Maybe peturb T initial conditions + if (present(T) .and. (pertlim /= 0.0_r8)) then + + ! Add random perturbation to temperature if required + if(masterproc .and. verbose_use) then + write(iulog,*) trim(subname), ': Adding random perturbation bounded by +/-', & + pertlim,' to initial temperature field' + end if + call random_seed(size=rndm_seed_sz) + allocate(rndm_seed(rndm_seed_sz)) + + ncol = size(T, 1) + nlev = size(T, 2) + do i = 1, ncol + if (mask_use(i)) then + ! seed random_number generator based on global column index + rndm_seed(:) = glob_ind(i) + call random_seed(put=rndm_seed) + do k = 1, nlev + call random_number(pertval) + pertval = 2.0_r8 * pertlim * (0.5_r8 - pertval) + T(i,k) = T(i,k) * (1.0_r8 + pertval) + end do + end if + end do + + deallocate(rndm_seed) + end if + + ! To get different random seeds each time + call_num = call_num + 1 +#else + call endrun(subname//': analytic initial conditions are not enabled') +#endif + + end subroutine dyn_set_inic_col + + subroutine dyn_set_inic_cblock(vcoord,latvals, lonvals, glob_ind, U, V, T, & + PS, PHIS, Q, m_cnst, mask) + !----------------------------------------------------------------------- + ! + ! Purpose: Set analytic initial values for dynamics state variables + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + integer, intent(in) :: vcoord ! See dyn_tests_utils + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + integer, intent(in) :: glob_ind(:) ! global column index + real(r8), optional, intent(inout) :: U(:,:,:) ! zonal velocity + real(r8), optional, intent(inout) :: V(:,:,:) ! meridional velocity + real(r8), optional, intent(inout) :: T(:,:,:) ! temperature + real(r8), optional, intent(inout) :: PS(:,:) ! surface pressure + real(r8), optional, intent(inout) :: PHIS(:,:) ! surface geopotential + real(r8), optional, intent(inout) :: Q(:,:,:,:) ! tracer (ncol,lev,blk,m) + integer, optional, intent(in) :: m_cnst(:) ! tracer indices (reqd. if Q) + logical, optional, intent(in) :: mask(:) ! Only init where .true. + + ! Local variables + real(r8), allocatable :: lat_use(:) + integer :: i, bbeg, bend + integer :: size1, size2, size3 + integer :: nblks, blksize + logical :: verbose + character(len=4) :: mname + character(len=*), parameter :: subname = 'DYN_SET_INIC_CBLOCK' + +#ifdef ANALYTIC_IC + verbose = .true. ! So subroutines can report setting variables + ! Figure out what sort of blocks we have, all variables should be the same + size1 = -1 + mname = '' + if (present(U)) then + call get_input_shape(U, 'U', mname, size1, size2, size3, subname) + end if + if(present(V)) then + call get_input_shape(V, 'V', mname, size1, size2, size3, subname) + end if + if(present(T)) then + call get_input_shape(T, 'T', mname, size1, size2, size3, subname) + end if + if(present(Q)) then + call get_input_shape(Q(:,:,:,1), 'Q', mname, size1, size2, size3, subname) + end if + ! Need to do all 3-D variables before any 2-D variables + if(present(PS)) then + call get_input_shape(PS, 'PS', mname, size1, size2, size3, subname) + end if + if(present(PHIS)) then + call get_input_shape(PHIS, 'PHIS', mname, size1, size2, size3, subname) + end if + if (size1 < 0) then + call endrun(subname//': No state variables to initialize') + end if + if ((size(latvals) == size1*size3) .and. (size(lonvals) == size1*size3)) then + ! Case: unstructured with blocks in 3rd dim + if (size(glob_ind) /= size(latvals)) then + call endrun(subname//': there must be a global index for every column') + end if + nblks = size3 + blksize = size1 + bend = 0 + do i = 1, nblks + bbeg = bend + 1 + bend = bbeg + blksize - 1 + if (present(mask)) then + if (size(mask) /= size(latvals)) then + call endrun(subname//': incorrect mask size') + end if + if (present(U)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), U=U(:,:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), V=V(:,:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), T=T(:,:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PS=PS(:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PHIS=PHIS(:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), Q=Q(:,:,i,:), m_cnst=m_cnst, & + mask=mask(bbeg:bend), verbose=verbose) + end if + else + if (present(U)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), U=U(:,:,i), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), V=V(:,:,i), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), T=T(:,:,i), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PS=PS(:,i), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PHIS=PHIS(:,i), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), Q=Q(:,:,i,:), m_cnst=m_cnst, & + verbose=verbose) + end if + end if + verbose = .false. + end do + else if ((size(latvals) == size1*size2) .and. (size(lonvals) == size1*size2)) then + ! Case: unstructured with blocks in 2nd dim + if (size(glob_ind) /= size(latvals)) then + call endrun(subname//': there must be a global index for every column') + end if + nblks = size2 + blksize = size1 + bend = 0 + do i = 1, nblks + bbeg = bend + 1 + bend = bbeg + blksize - 1 + if (present(mask)) then + if (size(mask) /= size(latvals)) then + call endrun(subname//': incorrect mask size') + end if + if (present(U)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), U=U(:,i,:), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), V=V(:,i,:), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), T=T(:,i,:), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PS=PS(:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PHIS=PHIS(:,i), mask=mask(bbeg:bend), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), Q=Q(:,i,:,:), m_cnst=m_cnst, & + mask=mask(bbeg:bend), verbose=verbose) + end if + else + if (present(U)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), U=U(:,i,:), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), V=V(:,i,:), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), T=T(:,i,:), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PS=PS(:,i), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), PHIS=PHIS(:,i), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,latvals(bbeg:bend), lonvals(bbeg:bend), & + glob_ind(bbeg:bend), Q=Q(:,i,:,:), m_cnst=m_cnst, & + verbose=verbose) + end if + end if + verbose = .false. + end do + else if ((size(latvals) == size2) .and. (size(lonvals) == size1)) then + ! Case: lon,lat,lev + if (size(glob_ind) /= (size2 * size1)) then + call endrun(subname//': there must be a global index for every column') + end if + nblks = size2 + allocate(lat_use(size(lonvals))) + if (present(mask)) then + call endrun(subname//': mask not supported for lon/lat') + else + bend = 0 + do i = 1, nblks + bbeg = bend + 1 + bend = bbeg + size1 - 1 + lat_use = latvals(i) + if (present(U)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + U=U(:,i,:), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + V=V(:,i,:), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + T=T(:,i,:), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + PS=PS(:,i), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + PHIS=PHIS(:,i), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + Q=Q(:,i,:,:), m_cnst=m_cnst, verbose=verbose) + end if + verbose = .false. + end do + end if + deallocate(lat_use) + else if ((size(latvals) == size3) .and. (size(lonvals) == size1)) then + if (size(glob_ind) /= (size3 * size1)) then + call endrun(subname//': there must be a global index for every column') + end if + ! Case: lon,lev,lat + nblks = size3 + allocate(lat_use(size(lonvals))) + if (present(mask)) then + call endrun(subname//': mask not supported for lon/lat') + else + bend = 0 + do i = 1, nblks + bbeg = bend + 1 + bend = bbeg + size1 - 1 + lat_use = latvals(i) + if (present(U)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + U=U(:,:,i), verbose=verbose) + end if + if (present(V)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + V=V(:,:,i), verbose=verbose) + end if + if (present(T)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + T=T(:,:,i), verbose=verbose) + end if + if (present(PS)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + PS=PS(:,i), verbose=verbose) + end if + if (present(PHIS)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + PHIS=PHIS(:,i), verbose=verbose) + end if + if (present(Q)) then + call dyn_set_inic_col(vcoord,lat_use, lonvals, glob_ind(bbeg:bend), & + Q=Q(:,:,i,:), m_cnst=m_cnst, verbose=verbose) + end if + verbose = .false. + end do + end if + deallocate(lat_use) + else + call endrun(subname//': Unknown state variable layout') + end if +#else + call endrun(subname//': analytic initial conditions are not enabled') +#endif + end subroutine dyn_set_inic_cblock + +#ifdef ANALYTIC_IC + subroutine get_input_shape_2d(array, aname, sname, size1, size2, size3, es) + real(r8), intent(in) :: array(:,:) + character(len=*), intent(in) :: aname + character(len=*), intent(inout) :: sname + integer, intent(inout) :: size1 + integer, intent(inout) :: size2 + integer, intent(inout) :: size3 + character(len=*), intent(in) :: es + + if ((size1 < 0) .and. (size(array) == 0)) then + ! The shape has not yet been set, set it to zero + size1 = 0 + size2 = 0 + size3 = 0 + sname = trim(aname) + else if (size1 < 0) then + ! The shape has not yet been set, set it + size1 = size(array, 1) + size2 = size(array, 2) + size3 = 1 + sname = trim(aname) + else if ((size1 * size2 * size3) > 0) then + ! For 2-D variables, the second dimension is always the block size + ! However, since the shape may have been set by a 3-D variable, we + ! need to pass either possibility + if ( (size1 /= size(array, 1)) .or. & + ((size2 /= size(array, 2)) .and. (size3 /= size(array, 2)))) then + call endrun(trim(es)//': shape of '//trim(aname)//' does not match shape of '//trim(sname)) + end if + ! No else, we cannot compare to zero size master array + end if + + end subroutine get_input_shape_2d + + subroutine get_input_shape_3d(array, aname, sname, size1, size2, size3, es) + real(r8), intent(in) :: array(:,:,:) + character(len=*), intent(in) :: aname + character(len=*), intent(inout) :: sname + integer, intent(inout) :: size1 + integer, intent(inout) :: size2 + integer, intent(inout) :: size3 + character(len=*), intent(in) :: es + + if ((size1 < 0) .and. (size(array) == 0)) then + ! The shape has not yet been set, set it to zero + size1 = 0 + size2 = 0 + size3 = 0 + sname = trim(aname) + else if (size1 < 0) then + ! The shape has not yet been set, set it + size1 = size(array, 1) + size2 = size(array, 2) + size3 = size(array, 3) + sname = trim(aname) + else if ((size1 * size2 * size3) > 0) then + ! We have a shape, make sure array matches it + if ((size1 /= size(array, 1)) .or. (size2 /= size(array, 2)) .or. (size3 /= size(array, 3))) then + call endrun(trim(es)//': shape of '//trim(aname)//' does not match shape of '//trim(sname)) + end if + end if + ! No else, we cannot compare to zero size master array + end subroutine get_input_shape_3d + + subroutine check_array_size(array, aname, check, subname) + real(r8), intent(in) :: array(:) + character(len=*), intent(in) :: aname + real(r8), intent(in) :: check(:) + character(len=*), intent(in) :: subname + + if (size(array, 1) /= size(check, 1)) then + call endrun(trim(subname)//': '//trim(aname)//' has the wrong first dimension') + end if + + end subroutine check_array_size +#endif + +end module inic_analytic diff --git a/src/dynamics/tests/inic_analytic_utils.F90 b/src/dynamics/tests/inic_analytic_utils.F90 new file mode 100644 index 0000000000..d94175e2c1 --- /dev/null +++ b/src/dynamics/tests/inic_analytic_utils.F90 @@ -0,0 +1,126 @@ +module inic_analytic_utils + + !----------------------------------------------------------------------- + ! + ! Purpose: Set analytic initial conditions based on input coordinates + ! + ! + !----------------------------------------------------------------------- + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use shr_sys_mod, only: shr_sys_flush + + implicit none + private + + ! Public interfaces + public :: analytic_ic_readnl ! Read dyn_test_nl namelist + public :: analytic_ic_active ! .true. if analytic IC should be set + public :: analytic_ic_is_moist ! .true. if IC are moist + + ! Private module variables + integer, parameter :: scheme_len = 32 + logical :: moist = .false. + + ! Protected resource + character(len=scheme_len), public, protected :: analytic_ic_type = 'none' + +!============================================================================== +CONTAINS +!============================================================================== + + logical function analytic_ic_active() + analytic_ic_active = (trim(analytic_ic_type) /= 'none') + end function analytic_ic_active + + logical function analytic_ic_is_moist() + analytic_ic_is_moist = moist + end function analytic_ic_is_moist + + subroutine analytic_ic_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, masterprocid, mpicom, mpi_character, mpi_logical + use shr_string_mod, only: shr_string_toLower + + ! Dummy argument + character(len=*), intent(in) :: nlfile ! filepath of namelist input file + + ! + ! Local variables + integer :: unitn, ierr + logical :: nl_not_found + character(len=128) :: msg + character(len=*), parameter :: subname = 'ANALYTIC_IC_READNL' + +#ifdef ANALYTIC_IC + ! History namelist items + namelist /analytic_ic_nl/ analytic_ic_type + + if (masterproc) then + unitn = getunit() + open(unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'analytic_ic_nl', status=ierr) + if (ierr == 0) then + nl_not_found = .false. + write(iulog, *) 'Read in analytic_ic_nl namelist from: ',trim(nlfile) + read(unitn, analytic_ic_nl, iostat=ierr) + if (ierr /= 0) then + write(msg, '(a,i0)') & + ': ERROR reading namelist, analytic_ic_nl, iostat = ', ierr + call endrun(subname//trim(msg)) + end if + else + nl_not_found = .true. + end if + close(unitn) + call freeunit(unitn) + + analytic_ic_type = shr_string_toLower(analytic_ic_type) + end if + + ! Broadcast namelist variables + call mpi_bcast(analytic_ic_type, len(analytic_ic_type), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(nl_not_found, 1, mpi_logical, masterprocid, mpicom, ierr) + + if (nl_not_found) then + ! If analytic IC functionality is turned on (via a configure switch), then + ! build-namelist supplies the namelist group. If not found then nothing + ! to do. + return + else + select case(trim(analytic_ic_type)) + case('held_suarez_1994') + msg = 'Dynamics state will be set to Held-Suarez (1994) initial conditions.' + case('baroclinic_wave') + moist = .true. + msg = 'Dynamics state will be set to a baroclinic wave initial condition.' + case('dry_baroclinic_wave') + moist = .false. + msg = 'Dynamics state will be set to a dry baroclinic wave initial condition.' + case('none') + msg = subname//': ERROR: analytic_ic_type must be set' + write(iulog, *) msg + call endrun(msg) + case default + msg = subname//': ERROR: analytic_ic_type not recognized: '//trim(analytic_ic_type) + write(iulog, *) msg + call endrun(msg) + end select + + end if + + ! Write out initial condition scheme info + if (masterproc) then + write(iulog, *) msg + end if +#else + analytic_ic_type = 'none' + moist = .false. +#endif + + end subroutine analytic_ic_readnl + +end module inic_analytic_utils diff --git a/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 b/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 new file mode 100644 index 0000000000..34a25922c3 --- /dev/null +++ b/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 @@ -0,0 +1,689 @@ +module ic_baroclinic + !----------------------------------------------------------------------- + ! + ! Purpose: Set idealized initial conditions for the Ullrich, Melvin, + ! Jablonowski and Staniforth (QJRMS, 2014) baroclinic + ! instability test. + ! + !----------------------------------------------------------------------- + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + + use physconst, only : rair, gravit, rearth, pi, omega, epsilo + use hycoef, only : hyai, hybi, hyam, hybm, ps0 + + implicit none + private + + real(r8), parameter :: deg2rad = pi/180.0_r8 + + !======================================================================= + ! Baroclinic wave test case parameters + !======================================================================= + real(r8), parameter, private :: Mvap = 0.608_r8 ! Ratio of molar mass dry air/water vapor + real(r8), parameter, private :: psurf_moist = 100000.0_r8 ! Moist surface pressure + + real(r8), parameter, private :: & + T0E = 310.0_r8, & ! Temperature at equatorial surface (K) + T0P = 240.0_r8, & ! Temperature at polar surface (K) + B = 2.0_r8, & ! Jet half-width parameter + KK = 3.0_r8, & ! Jet width parameter + lapse = 0.005_r8 ! Lapse rate parameter + + real(r8), parameter, private :: & + pertu0 = 0.5_r8, & ! SF Perturbation wind velocity (m/s) + pertr = 1.0_r8/6.0_r8, & ! SF Perturbation radius (Earth radii) + pertup = 1.0_r8, & ! Exp. perturbation wind velocity (m/s) + pertexpr = 0.1_r8, & ! Exp. perturbation radius (Earth radii) + pertlon = pi/9.0_r8, & ! Perturbation longitude + pertlat = 2.0_r8*pi/9.0_r8, & ! Perturbation latitude + pertz = 15000.0_r8, & ! Perturbation height cap + dxepsilon = 1.0e-5_r8 ! Small value for numerical derivatives + + real(r8), parameter, private :: & + moistqlat = 2.0_r8*pi/9.0_r8, & ! Humidity latitudinal width + moistqp = 34000.0_r8, & ! Humidity vertical pressure width + moistq0 = 0.018_r8 ! Maximum specific humidity + + real(r8), parameter, private :: & + eps = 1.0e-13_r8, & ! Iteration threshold + qv_min = 1.0e-12_r8 ! Min specific humidity value + + + integer, parameter :: deep = 0 ! Deep (1) or Shallow (0) test case + integer, parameter :: pertt = 0 ! 0: exponential, 1: streamfunction + real(r8), parameter :: bigx = 1.0 ! Factor for a reduced size earth + + ! + ! Gauss nodes and weights + ! + integer , parameter :: num_gauss = 10 + real(r8), parameter, dimension(num_gauss), private :: gaussx =(/& + -0.97390652851717_r8,-0.865063366689_r8,-0.67940956829902_r8,-0.4333953941292_r8,-0.14887433898163_r8,& + 0.14887433898163_r8,0.4333953941292_r8,0.679409568299_r8,0.86506336668898_r8,0.97390652851717_r8/) + + real(r8), parameter, dimension(num_gauss), private :: gaussw =(/& + 0.06667134430869_r8,0.1494513491506_r8,0.219086362516_r8,0.26926671931_r8,0.29552422471475_r8, & + 0.2955242247148_r8,0.26926671931_r8,0.21908636251598_r8,0.1494513491506_r8,0.0666713443087_r8/) + + ! Public interface + public :: bc_wav_set_ic + +contains + + subroutine bc_wav_set_ic(vcoord,latvals, lonvals, U, V, T, PS, PHIS, & + Q, m_cnst, mask, verbose) + use dyn_tests_utils, only: vc_moist_pressure, vc_dry_pressure, vc_height + use constituents, only: cnst_name + use const_init, only: cnst_init_default + use inic_analytic_utils, only: analytic_ic_is_moist + + !----------------------------------------------------------------------- + ! + ! Purpose: Set baroclinic wave initial values for dynamics state variables + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + integer, intent(in) :: vcoord + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + ! z_k for vccord 1) + real(r8), optional, intent(inout) :: U(:,:) ! zonal velocity + real(r8), optional, intent(inout) :: V(:,:) ! meridional velocity + real(r8), optional, intent(inout) :: T(:,:) ! temperature + real(r8), optional, intent(inout) :: PS(:) ! surface pressure + real(r8), optional, intent(inout) :: PHIS(:) ! surface geopotential + real(r8), optional, intent(inout) :: Q(:,:,:) ! tracer (ncol, lev, m) + integer, optional, intent(in) :: m_cnst(:) ! tracer indices (reqd. if Q) + logical, optional, intent(in) :: mask(:) ! only init where .true. + logical, optional, intent(in) :: verbose ! for internal use + ! Local variables + logical, allocatable :: mask_use(:) + logical :: verbose_use + integer :: i, k, m + integer :: ncol + integer :: nlev + integer :: ncnst + character(len=*), parameter :: subname = 'BC_WAV_SET_IC' + real(r8) :: ztop,ptop + real(r8) :: uk,vk,Tvk,qk,pk !mid-level state + real(r8) :: psurface + real(r8) :: wvp,qdry + logical :: lU, lV, lT, lQ, l3d_vars + real(r8), allocatable :: pdry_half(:), pwet_half(:),zdry_half(:),zk(:) + + if ((vcoord == vc_moist_pressure) .or. (vcoord == vc_dry_pressure)) then + ! + ! pressure-based vertical coordinate + ! + ptop = hyai(1) * ps0 + if (ptop > 1.0e5_r8) then + call endrun(subname//' ERROR: For iterate_z_given_pressure to work ptop must be less than 100hPa') + end if + ztop = iterate_z_given_pressure(ptop,.false.,ptop,0.0_r8,-1000._r8) !Find height of top pressure surface + else if (vcoord == vc_height) then + ! + ! height-based vertical coordinate + ! + call endrun(subname//' ERROR: z-based vertical coordinate not coded yet') + else + call endrun(subname//' ERROR: vcoord value out of range') + end if + + allocate(mask_use(size(latvals))) + if (present(mask)) then + if (size(mask_use) /= size(mask)) then + call endrun(subname//': input, mask, is wrong size') + end if + mask_use = mask + else + mask_use = .true. + end if + + if (present(verbose)) then + verbose_use = verbose + else + verbose_use = .true. + end if + + if(masterproc .and. verbose .and. present(PS)) then + write(iulog,*) subname, ': Model top (in km) is at z= ',ztop/1000.0_r8 + end if + + ncol = size(latvals, 1) + nlev = -1 + ! + !******************************* + ! + ! initialize surface pressure + ! + !******************************* + ! + if (present(PS)) then + if (vcoord == vc_moist_pressure) then + where(mask_use) + PS = psurf_moist + end where + else if(vcoord == vc_dry_pressure) then + ! + ! compute dry surface pressure (subtract water vapor in coloumn) + ! + do i=1,ncol + if (mask_use(i)) then + wvp = weight_of_water_vapor_given_z(0.0_r8,latvals(i),ztop) + ps(i) = psurf_moist-wvp + end if + end do + endif + + if(masterproc .and. verbose_use) then + write(iulog,*) ' PS initialized by "',subname,'"' + end if + end if + ! + !******************************* + ! + ! Initialize PHIS + ! + !******************************* + ! + if (present(PHIS)) then + where(mask_use) + PHIS = 0.0_r8 + end where + if(masterproc .and. verbose_use) then + write(iulog,*) ' PHIS initialized by "',subname,'"' + end if + end if + ! + !******************************* + ! + ! Initialize 3D vars + ! + ! + !******************************* + ! + lu = present(U) + lv = present(V) + lT = present(T) + lq = present(Q) + l3d_vars = lu .or. lv .or. lt .or.lq + nlev = -1 + if (l3d_vars) then + if (lu) nlev = size(U, 2) + if (lv) nlev = size(V, 2) + if (lt) nlev = size(T, 2) + if (lq) nlev = size(Q, 2) + allocate(zk(nlev+1)) + if ((lq.or.lt) .and. (vcoord == vc_dry_pressure)) then + allocate(pdry_half(nlev+1)) + allocate(pwet_half(nlev+1)) + allocate(zdry_half(nlev+1)) + end if + do i=1,ncol + if (mask_use(i)) then + if (vcoord == vc_moist_pressure) then + psurface = psurf_moist + wvp = -99 + else if (vcoord == vc_dry_pressure) then + ! + ! convert surface pressure to dry + ! + wvp = weight_of_water_vapor_given_z(0.0_r8,latvals(i),ztop) + psurface = psurf_moist-wvp + end if + + do k=1,nlev + ! compute pressure levels + pk = hyam(k)*ps0 + hybm(k)*psurface + ! find height of pressure surface + zk(k) = iterate_z_given_pressure(pk,(vcoord == vc_dry_pressure),ptop,latvals(i),ztop) + end do + do k=1,nlev + ! + ! wind components + ! + if (lu.or.lv) call uv_given_z(zk(k),uk,vk,latvals(i),lonvals(i)) + if (lu) U(i,k) = uk + if (lv) V(i,k) = vk + ! + ! temperature and moisture for moist vertical coordinates + ! + if ((lq.or.lt).and.(vcoord == vc_moist_pressure)) then + if (analytic_ic_is_moist()) then + pk = moist_pressure_given_z(zk(k),latvals(i)) + qk = qv_given_moist_pressure(pk,latvals(i)) + else + qk = 0.d0 + end if + if (lq) Q(i,k,1) = qk + if (lt) then + tvk = Tv_given_z(zk(k),latvals(i)) + T(i,k) = tvk / (1.d0 + Mvap * qk) + end if + end if + end do + ! + ! temperature and moisture for dry-mass vertical coordinates + ! + if ((lq.or.lt).and. (vcoord==vc_dry_pressure)) then + ! + ! compute dry pressure vertical coordinate + ! + pdry_half(1) = hyai(1)*ps0 + hybi(1)*psurface + pwet_half(1) = pdry_half(1) + zdry_half(1) = ztop + do k=2,nlev+1 + pdry_half(k) = hyai(k)*ps0 + hybi(k)*psurface + ! find height of pressure surfaces corresponding moist pressure + zdry_half(k) = iterate_z_given_pressure(pdry_half(k),.true.,ptop,latvals(i),ztop) + pwet_half(k) = pdry_half(k)+weight_of_water_vapor_given_z(zdry_half(k),latvals(i),ztop) + end do + + do k=1,nlev + if (analytic_ic_is_moist()) then + qdry =((pwet_half(k+1)-pwet_half(k))/(pdry_half(k+1)-pdry_half(k)))-1.0_r8 + qdry = MAX(qdry,qv_min/(1.0_r8-qv_min)) + else + qdry = 0.0_r8 + end if + if (lq) then + Q(i,k,1) = qdry + end if + if (lt) then + ! + ! convert virtual temperature to temperature + ! + tvk = Tv_given_z(zk(k),latvals(i)) + T(i,k) = tvk*(1.0_r8+qdry)/(1.0_r8+(1.0_r8/epsilo)*qdry) + end if + end do + end if + end if + end do + if(lu .and. masterproc.and. verbose_use) write(iulog,*) ' U initialized by "',subname,'"' + if(lv .and. masterproc.and. verbose_use) write(iulog,*) ' V initialized by "',subname,'"' + if(lt .and. masterproc.and. verbose_use) write(iulog,*) ' T initialized by "',subname,'"' + if(lq .and. masterproc.and. verbose_use) write(iulog,*) & + ' ', trim(cnst_name(m_cnst(1))), ' initialized by "',subname,'"' + end if + + if (lq) then + ncnst = size(m_cnst, 1) + if ((vcoord == vc_moist_pressure) .or. (vcoord == vc_dry_pressure)) then + do m = 2, ncnst + call cnst_init_default(m_cnst(m), latvals, lonvals, Q(:,:,m_cnst(m)),& + mask=mask_use, verbose=verbose_use, notfound=.false.) +#if 0 + do k = 1, nlev + do i=1,ncol + if (mask_use(i)) then + Q(i,k,m_cnst(m)) = test_func(latvals(i),lonvals(i), k, m) + end if + end do + end do + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(cnst_name(m_cnst(m))), ' initialized by "',subname,'"' + end if +#endif + end do + end if + end if + deallocate(mask_use) + if (l3d_vars) then + deallocate(zk) + if ((lq.or.lt) .and. (vcoord == vc_dry_pressure)) then + deallocate(pdry_half) + deallocate(pwet_half) + deallocate(zdry_half) + end if + end if + end subroutine bc_wav_set_ic + + real(r8) FUNCTION iterate_z_given_pressure(p,ldry_mass_vertical_coordinates,ptop,lat,ztop) + + real(r8), INTENT(IN) :: & + p, &! Pressure (Pa) + ptop,&! Pressure (Pa) + lat,&! latitude + ztop + + logical, INTENT(IN) :: ldry_mass_vertical_coordinates + + integer :: ix + + real(r8) :: z0, z1, z2 + real(r8) :: p0, p1, p2 + z0 = 0.0_r8 + z1 = 10000.0_r8 + if (ldry_mass_vertical_coordinates) then + p0 = weight_of_dry_air_given_z(z0,ptop,lat,ztop) + p1 = weight_of_dry_air_given_z(z1,ptop,lat,ztop) + else + p0 = moist_pressure_given_z(z0,lat) + p1 = moist_pressure_given_z(z1,lat) + endif + + DO ix = 1, 1000 + z2 = z1 - (p1 - p) * (z1 - z0) / (p1 - p0) + if (ldry_mass_vertical_coordinates) then + p2 = weight_of_dry_air_given_z(z2,ptop,lat,ztop) + else + p2 = moist_pressure_given_z(z2,lat) + end if + + IF (ABS(p2 - p)/p < eps.or.ABS(z1-z2) 0.1_r8) then ! intialize q if p > 100 hPa + qv_given_moist_pressure = moistq0 * exp(- (lat/moistqlat)**4) & + * exp(- ((eta-1.0_r8)*psurf_moist/moistqp)**2) + else + qv_given_moist_pressure = qv_min ! above 100 hPa set q to 1e-12 to avoid supersaturation + endif + end if + END FUNCTION qv_given_moist_pressure + + real(r8) FUNCTION weight_of_water_vapor_given_z(z,lat, ztop) + use inic_analytic_utils, only: analytic_ic_is_moist + + real(r8), INTENT(IN) :: z,lat, ztop + real (r8) :: xm,xr,integral + real(r8) :: qv, z1, z2, Tv,pwet, ztmp + integer :: jgw + + if (.not. analytic_ic_is_moist()) then + ! + ! dry case + ! + weight_of_water_vapor_given_z = 0.0_r8 + else + z1=z + z2=ztop + xm=0.5_r8*(z1+z2) + xr=0.5_r8*(z2-z1) + integral=0 + do jgw=1,num_gauss + ztmp=xm+gaussx(jgw)*xr + pwet = moist_pressure_given_z(ztmp,lat); qv= qv_given_moist_pressure(pwet,lat);Tv= Tv_given_z(ztmp,lat) + integral=integral+gaussw(jgw)*gravit*pwet*qv/(Rair*Tv) + enddo + integral=0.5_r8*(z2-z1)*integral ! Scale the answer to the range of integration. + weight_of_water_vapor_given_z = integral + end if + end FUNCTION weight_of_water_vapor_given_z + + + real(r8) FUNCTION weight_of_dry_air_given_z(z,ptop,lat,ztop) + + real (r8), INTENT(IN) :: z,ptop, lat, ztop + real (r8) :: xm,xr,integral + real(r8) :: qv, z1, z2, Tv,pwet, ztmp + integer :: jgw + + z1=z + z2=ztop + xm=0.5*(z1+z2) + xr=0.5*(z2-z1) + integral=0 + do jgw=1,num_gauss + ztmp=xm+gaussx(jgw)*xr + pwet = moist_pressure_given_z(ztmp,lat); qv= qv_given_moist_pressure(pwet,lat);Tv= Tv_given_z(ztmp,lat) + integral=integral+gaussw(jgw)*gravit*pwet*(1-qv)/(Rair*Tv) + enddo + integral=0.5_r8*(z2-z1)*integral ! Scale the answer to the range of integration. + weight_of_dry_air_given_z = integral+ptop + end FUNCTION weight_of_dry_air_given_z + +end module ic_baroclinic diff --git a/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 b/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 new file mode 100644 index 0000000000..f3729c5e8b --- /dev/null +++ b/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 @@ -0,0 +1,155 @@ +module ic_held_suarez + + !----------------------------------------------------------------------- + ! + ! Purpose: Set Held-Suarez initial conditions based on input coordinates + ! + ! + !----------------------------------------------------------------------- + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use shr_sys_mod, only: shr_sys_flush + + implicit none + private + + ! Public interface + public :: hs94_set_ic + +!============================================================================== +CONTAINS +!============================================================================== + + subroutine hs94_set_ic(latvals, lonvals, U, V, T, PS, PHIS, & + Q, m_cnst, mask, verbose) + use const_init, only: cnst_init_default + use constituents, only: cnst_name + + !----------------------------------------------------------------------- + ! + ! Purpose: Set Held-Suarez initial values for dynamics state variables + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + real(r8), optional, intent(inout) :: U(:,:) ! zonal velocity + real(r8), optional, intent(inout) :: V(:,:) ! meridional velocity + real(r8), optional, intent(inout) :: T(:,:) ! temperature + real(r8), optional, intent(inout) :: PS(:) ! surface pressure + real(r8), optional, intent(inout) :: PHIS(:) ! surface geopotential + real(r8), optional, intent(inout) :: Q(:,:,:) ! tracer (ncol, lev, m) + integer, optional, intent(in) :: m_cnst(:) ! tracer indices (reqd. if Q) + logical, optional, intent(in) :: mask(:) ! Only init where .true. + logical, optional, intent(in) :: verbose ! For internal use + + ! Local variables + logical, allocatable :: mask_use(:) + logical :: verbose_use + integer :: i, k, m + integer :: ncol + integer :: nlev + integer :: ncnst + character(len=*), parameter :: subname = 'HS94_SET_IC' + + allocate(mask_use(size(latvals))) + if (present(mask)) then + if (size(mask_use) /= size(mask)) then + call endrun('cnst_init_default: input, mask, is wrong size') + end if + mask_use = mask + else + mask_use = .true. + end if + + if (present(verbose)) then + verbose_use = verbose + else + verbose_use = .true. + end if + + ncol = size(latvals, 1) + nlev = -1 + if (present(U)) then + nlev = size(U, 2) + do k = 1, nlev + where(mask_use) + U(:,k) = 0.0_r8 + end where + end do + if(masterproc .and. verbose_use) then + write(iulog,*) ' U initialized by "',subname,'"' + end if + end if + + if (present(V)) then + nlev = size(V, 2) + do k = 1, nlev + where(mask_use) + V(:,k) = 0.0_r8 + end where + end do + if(masterproc .and. verbose_use) then + write(iulog,*) ' V initialized by "',subname,'"' + end if + end if + + if (present(T)) then + nlev = size(T, 2) + do k = 1, nlev + where(mask_use) + T(:,k) = 250.0_r8 + end where + end do + if(masterproc .and. verbose_use) then + write(iulog,*) ' T initialized by "',subname,'"' + end if + end if + + if (present(PS)) then + where(mask_use) + PS = 100000.0_r8 + end where + if(masterproc .and. verbose_use) then + write(iulog,*) ' PS initialized by "',subname,'"' + end if + end if + + if (present(PHIS)) then + where(mask_use) + PHIS = 0.0_r8 + end where + if(masterproc .and. verbose_use) then + write(iulog,*) ' PHIS initialized by "',subname,'"' + end if + end if + + if (present(Q)) then + nlev = size(Q, 2) + ncnst = size(m_cnst, 1) + do m = 1, ncnst + if (m_cnst(m) == 1) then + ! No water vapor in Held-Suarez + do k = 1, nlev + where(mask_use) + Q(:,k,m_cnst(m)) = 0.0_r8 + end where + end do + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(cnst_name(m_cnst(m))), ' initialized by "',subname,'"' + end if + else + call cnst_init_default(m_cnst(m), latvals, lonvals, Q(:,:,m_cnst(m)),& + mask=mask_use, verbose=verbose_use, notfound=.false.) + end if + end do + end if + + deallocate(mask_use) + + end subroutine hs94_set_ic + +end module ic_held_suarez diff --git a/src/ionosphere/ionosphere_interface.F90 b/src/ionosphere/ionosphere_interface.F90 new file mode 100644 index 0000000000..bf12f4e37c --- /dev/null +++ b/src/ionosphere/ionosphere_interface.F90 @@ -0,0 +1,93 @@ +module ionosphere_interface + + ! Dummy interface -- actual ionosphere interface exist in src/ionosphere/modelname + + implicit none + + private + + public :: ionosphere_readnl + public :: ionosphere_init + public :: ionosphere_run1 + public :: ionosphere_run2 + public :: ionosphere_init_restart + public :: ionosphere_write_restart + public :: ionosphere_read_restart + public :: ionosphere_final + +contains + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_readnl( nlfile ) + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + end subroutine ionosphere_readnl + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_init() + + end subroutine ionosphere_init + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_run1(pbuf2d) + use physics_buffer, only: physics_buffer_desc + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + end subroutine ionosphere_run1 + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_run2( phys_state, dyn_in, pbuf2d ) + + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use phys_grid, only: begchunk, endchunk + use dyn_comp, only: dyn_import_t + + ! args + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(dyn_import_t), intent(in) :: dyn_in ! dynamics import + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + end subroutine ionosphere_run2 + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_init_restart(File) + use pio, only: file_desc_t + + type(File_desc_t), intent(inout) :: File + + end subroutine ionosphere_init_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_write_restart(File) + use pio, only: file_desc_t + + type(File_desc_t), intent(inout) :: File + + end subroutine ionosphere_write_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_read_restart(File) + use pio, only: file_desc_t + + type(file_desc_t), intent(inout) :: File + + end subroutine ionosphere_read_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_final + + end subroutine ionosphere_final + +end module ionosphere_interface diff --git a/src/ionosphere/waccmx/dpie_coupling.F90 b/src/ionosphere/waccmx/dpie_coupling.F90 new file mode 100644 index 0000000000..c02156b579 --- /dev/null +++ b/src/ionosphere/waccmx/dpie_coupling.F90 @@ -0,0 +1,911 @@ +module dpie_coupling +! +! Dynamics/Physics Ionosphere/Electrodynamics coupler. +! B. Foster, 2015. +! + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_logfile ,only: iulog + use cam_history ,only: outfld + use cam_history ,only: addfld, horiz_only + use cam_history_support, only: fillvalue + use cam_abortutils ,only: endrun + use spmd_utils ,only: masterproc + use savefield_waccm ,only: savefld_waccm + use edyn_mpi ,only: array_ptr_type + use perf_mod ,only: t_startf, t_stopf + + implicit none + + private + public :: d_pie_init + public :: d_pie_epotent ! sets electric potential + public :: d_pie_coupling ! handles coupling with edynamo and ion transport + + logical :: ionos_edyn_active, ionos_oplus_xport ! if true, call oplus_xport for O+ transport + integer :: nspltop ! nsplit for oplus_xport + + logical :: debug = .false. + +contains +!---------------------------------------------------------------------- + subroutine d_pie_init( edyn_active_in, oplus_xport_in, oplus_nsplit_in ) + + logical, intent(in) :: edyn_active_in, oplus_xport_in + integer, intent(in) :: oplus_nsplit_in + + ionos_edyn_active = edyn_active_in + ionos_oplus_xport = oplus_xport_in + nspltop = oplus_nsplit_in + + ! Dynamo inputs (called from dpie_coupling. Fields are in waccm format, in CGS units): + call addfld ('DPIE_OMEGA',(/ 'lev' /), 'I', 'Pa/s ','OMEGA input to DPIE coupling', gridname='fv_centers') + call addfld ('DPIE_MBAR' ,(/ 'lev' /), 'I', ' ','MBAR Mean Mass from dpie_coupling', gridname='fv_centers') + call addfld ('DPIE_TN ',(/ 'lev' /), 'I', 'deg K ','DPIE_TN' , gridname='fv_centers') + call addfld ('DPIE_UN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_UN' , gridname='fv_centers') + call addfld ('DPIE_VN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_VN' , gridname='fv_centers') + call addfld ('DPIE_WN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_WN' , gridname='fv_centers') + call addfld ('DPIE_OM ',(/ 'lev' /), 'I', 's-1 ','DPIE_OM' , gridname='fv_centers') + call addfld ('DPIE_ZHT ',(/ 'lev' /), 'I', 'cm ','DPIE_ZHT (geometric height,simple)', gridname='fv_centers') + call addfld ('DPIE_ZGI ',(/ 'lev' /), 'I', 'cm ','DPIE_ZGI (geopotential height on interfaces)', gridname='fv_centers') + call addfld ('DPIE_BARM ',(/ 'lev' /), 'I', ' ','DPIE_BARM' , gridname='fv_centers') + call addfld ('DPIE_O2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_O2' , gridname='fv_centers') + call addfld ('DPIE_O ',(/ 'lev' /), 'I', 'mmr ','DPIE_O' , gridname='fv_centers') + call addfld ('DPIE_N2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_N2' , gridname='fv_centers') + call addfld ('DPIE_TE ',(/ 'lev' /), 'I', 'deg K ','DPIE_TE' , gridname='fv_centers') + call addfld ('DPIE_TI ',(/ 'lev' /), 'I', 'deg K ','DPIE_TI' , gridname='fv_centers') + + call addfld ('DPIE_OPMMR' ,(/ 'lev' /), 'I', 'mmr' ,'DPIE_OPMMR' , gridname='fv_centers') + call addfld ('DPIE_O2P',(/ 'lev' /), 'I', 'm^3','DPIE_O2P(dpie input)', gridname='fv_centers') + call addfld ('DPIE_NOP',(/ 'lev' /), 'I', 'm^3','DPIE_NOP(dpie input)', gridname='fv_centers') + call addfld ('DPIE_N2P',(/ 'lev' /), 'I', 'm^3','DPIE_N2P(dpie input)', gridname='fv_centers') + + call addfld ('OPLUS', (/ 'lev' /), 'I', 'cm^3','O+ (oplus_xport output)', gridname='fv_centers') + call addfld ('WACCM_UI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_UI (dpie output)', gridname='fv_centers') + call addfld ('WACCM_VI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_VI (dpie output)', gridname='fv_centers') + call addfld ('WACCM_WI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_WI (dpie output)', gridname='fv_centers') + + call addfld ('HMF2' , horiz_only , 'I', 'km' ,'Height of the F2 Layer' , gridname='fv_centers') + call addfld ('NMF2' , horiz_only , 'I', 'cm-3','Peak Density of the F2 Layer', gridname='fv_centers') + + call addfld ('Z3GM' ,(/ 'lev' /), 'I', 'm' ,'Geometric height' , gridname='fv_centers') + call addfld ('Z3GMI ',(/ 'lev' /), 'I', 'm' ,'Geometric height (Interfaces)', gridname='fv_centers') + call addfld ('OpDens' ,(/ 'lev' /), 'I', 'cm^3','O+ Number Density' , gridname='fv_centers') + call addfld ('EDens' ,(/ 'lev' /), 'I', 'cm^3','e Number Density (sum of O2+,NO+,N2+,O+)', gridname='fv_centers') + + end subroutine d_pie_init + +!----------------------------------------------------------------------- + subroutine d_pie_epotent + use edyn_solve, only: pfrac ! NH fraction of potential (nmlonp1,nmlat0) + use edyn_geogrid,only: nglblat=>nlat + use time_manager,only: get_nstep + use time_manager,only: get_curr_date + use mag_parms, only: get_mag_parms + use mag_parms, only: highlat_potential_model ! either 'heelis' or 'weimer' + use heelis, only: heelis_model + use wei05sc, only: weimer05 ! driver for weimer high-lat convection model + use edyn_esmf, only: edyn_esmf_update + use solar_parms_data, only: solar_parms_advance + use solar_wind_data, only: solar_wind_advance + use solar_wind_data, only: bzimf=>solar_wind_bzimf, byimf=>solar_wind_byimf + use solar_wind_data, only: swvel=>solar_wind_swvel, swden=>solar_wind_swden + + real(r8) :: secs ! time of day in seconds + integer :: nstep,iyear,imo,iday,tod ! tod is time-of-day in seconds + real(r8) :: ctpoten ! Cross-tail potential from get_mag_parms method + real(r8) :: ctpoten_weimer ! Cross-tail potential from Weimer model + real(r8) :: sunlons(nglblat) + + call edyn_esmf_update() + + call get_curr_date(iyear,imo,iday,tod) ! tod is integer time-of-day in seconds + secs = tod ! should promote from int to real(r8) + + ! update solar wind data (IMF, etc.) + call solar_wind_advance() + + ! update kp -- phys timestep init happens later ... + call solar_parms_advance() + + call get_mag_parms( ctpoten = ctpoten ) + + ! + ! Get sun's longitude at latitudes (geographic): + ! + call sunloc(iday,secs,sunlons) ! sunlons(nglblat) is returned + ! + ! Get high-latitude convection from empirical model (heelis or weimer). + ! High-latitude potential phihm (edyn_solve) is defined for edynamo. + ! Heelis takes ctpoten as input, Weimer returns ctpoten_weimer as output. + ! + if (trim(highlat_potential_model) == 'heelis') then + if (debug.and.masterproc) then + nstep = get_nstep() + write(iulog,"('dpie_coupling call heelis: nstep=', i16, ' sunloc=', f16.12 ,' ctpoten=',f16.12)") & + nstep,sunlons(1),ctpoten + endif + call heelis_model(ctpoten,sunlons) ! heelis.F90 + call calc_pfrac(sunlons(1),pfrac) ! returns pfrac for dynamo (edyn_solve) + elseif (trim(highlat_potential_model) == 'weimer') then + ! + ! ctpoten_weimer is returned by Weimer model (weisc05.F90). + ! If get_mag_parms is called for ctpoten, it will return ctpoten_weimer. + ! + call weimer05(byimf,bzimf,swvel,swden,sunlons,ctpoten_weimer) + call calc_pfrac(sunlons(1),pfrac) ! returns pfrac for dynamo (edyn_solve) + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling call weimer05: byimf,bzimf=',2f8.2,' swvel,swden=',2f8.2,' ctpoten_weimer=',f8.2)") & + byimf,bzimf,swvel,swden,ctpoten_weimer + endif + else + call endrun('dpie_coupling: Unknown highlat_potential_model') + endif + end subroutine d_pie_epotent + +!----------------------------------------------------------------------- + subroutine d_pie_coupling(omega,pe,zgi,zgpmid,u,v,tn, & + sigma_ped,sigma_hall,te,ti,o2mmr,o1mmr,h1mmr,o2pmmr, & + nopmmr,n2pmmr,opmmr,opmmrtm1,ui,vi,wi, & + rmassO2,rmassO1,rmassH,rmassN2,rmassO2p, rmassNOp,rmassN2p,rmassOp, & + i0,i1,j0,j1) +! +! Call dynamo to calculate electric potential, electric field, and ion drifts. +! Then call oplus_xport to transport O+, which is passed back to physics. +! +! This routine is called from p_d_coupling (dynamics/fv/dp_coupling.F90) when +! nstep > 0. +! + use edyn_geogrid, only: nlev, nilev + use shr_const_mod,only: & + grav => shr_const_g, & ! gravitational constant (m/s^2) + kboltz => shr_const_boltz ! Boltzmann constant (J/K/molecule) + use time_manager, only: get_nstep + use time_manager, only: get_curr_date + use edynamo, only: dynamo + use edyn_mpi, only: switch_model_format ! routine to switch between "model formats" + use edyn_mpi, only: mp_geo_halos,mp_pole_halos + use oplus, only: oplus_xport + use ref_pres, only: pref_mid +! +! Args: +! + integer,intent(in) :: & + i0, & ! grid%ifirstxy + i1, & ! grid%ilastxy + j0, & ! grid%jfirstxy + j1 ! grid%jlastxy + + real(r8),intent(in) :: omega (i0:i1,j0:j1,nlev) ! pressure velocity on midpoints (Pa/s) (i,k,j) + real(r8),intent(in) :: pe (i0:i1,nilev,j0:j1) ! interface pressure (Pa) (note i,k,j dims) + real(r8),intent(in) :: zgi (i0:i1,j0:j1,nlev) ! geopotential height (on interfaces) (m) + real(r8),intent(in) :: zgpmid (i0:i1,j0:j1,nlev) ! geopotential height (on midpoints) (m) + real(r8),intent(in) :: u (i0:i1,j0:j1,nlev) ! U-wind (m/s) + real(r8),intent(in) :: v (i0:i1,j0:j1,nlev) ! V-wind (m/s) + real(r8),intent(in) :: tn (i0:i1,j0:j1,nlev) ! neutral temperature (K) + real(r8),intent(in) :: sigma_ped (i0:i1,j0:j1,nlev) ! Pedersen conductivity + real(r8),intent(in) :: sigma_hall(i0:i1,j0:j1,nlev) ! Hall conductivity + real(r8),intent(in) :: te(i0:i1,j0:j1,nlev) ! electron temperature + real(r8),intent(in) :: ti(i0:i1,j0:j1,nlev) ! ion temperature + real(r8),intent(in) :: o2mmr(i0:i1,j0:j1,nlev) ! O2 mass mixing ratio (for oplus) + real(r8),intent(in) :: o1mmr(i0:i1,j0:j1,nlev) ! O mass mixing ratio (for oplus) + real(r8),intent(in) :: h1mmr(i0:i1,j0:j1,nlev) ! H mass mixing ratio (for oplus) + real(r8),intent(in) :: o2pmmr(i0:i1,j0:j1,nlev) ! O2+ mass mixing ratio (for oplus) + real(r8),intent(in) :: nopmmr(i0:i1,j0:j1,nlev) ! NO+ mass mixing ratio (for oplus) + real(r8),intent(in) :: n2pmmr(i0:i1,j0:j1,nlev) ! N2+ mass mixing ratio (for oplus) + real(r8),intent(inout) :: opmmr(i0:i1,j0:j1,nlev) ! O+ mass mixing ratio (oplus_xport output) + real(r8),intent(inout) :: opmmrtm1(i0:i1,j0:j1,nlev) ! O+ previous time step (oplus_xport output) + real(r8),intent(inout) :: ui(i0:i1,j0:j1,nlev) ! zonal ion drift (edynamo or empirical) + real(r8),intent(inout) :: vi(i0:i1,j0:j1,nlev) ! meridional ion drift (edynamo or empirical) + real(r8),intent(inout) :: wi(i0:i1,j0:j1,nlev) ! vertical ion drift (edynamo or empirical) + real(r8),intent(in) :: rmassO2 ! O2 molecular weight kg/kmol + real(r8),intent(in) :: rmassO1 ! O atomic weight kg/kmol + real(r8),intent(in) :: rmassH ! H atomic weight kg/kmol + real(r8),intent(in) :: rmassN2 ! N2 molecular weight kg/kmol + real(r8),intent(in) :: rmassO2p ! O2+ molecular weight kg/kmol + real(r8),intent(in) :: rmassNOp ! NO+ molecular weight kg/kmol + real(r8),intent(in) :: rmassN2p ! N2+ molecular weight kg/kmol + real(r8),intent(in) :: rmassOp ! O+ molecular weight kg/kmol +! +! Local: +! + integer :: i,j,k + integer :: kx ! Vertical index at peak of F2 layer electron density + integer :: nstep + integer :: nfields ! Number of fields for multi-field calls + integer :: iyear,imo,iday,tod ! tod is time-of-day in seconds + integer :: isplit ! loop index + + real(r8) :: secs ! time of day in seconds + + real(r8), parameter :: n2min = 1.e-6_r8 ! lower limit of N2 mixing ratios + real(r8), parameter :: small = 1.e-25_r8 ! for fields not currently available + real(r8) :: zht (i0:i1,j0:j1,nlev) ! geometric height (m) (Simple method - interfaces) + real(r8) :: zhtmid(i0:i1,j0:j1,nlev)! geometric height (m) (Simple method - midpoints) + real(r8) :: wn (i0:i1,j0:j1,nlev) ! vertical velocity (from omega) + real(r8) :: mbar (i0:i1,j0:j1,nlev) ! mean molecular weight + real(r8) :: n2mmr(i0:i1,j0:j1,nlev) ! N2 mass mixing ratio (for oplus) + real(r8) :: pmid_inv(nlev) ! inverted reference pressure at midpoints (Pa) + real(r8) :: pmid(i0:i1,nlev,j0:j1) ! pressure at midpoints (Pa) (global i,j) + real(r8) :: re = 6.370e6_r8 ! earth radius (m) + + real(r8),dimension(i0:i1,j0:j1,nlev) :: & ! ion number densities (m^3) + o2p,nop,n2p,op,ne, optm1 + + real(r8),dimension(nlev,i0:i1,j0:j1) :: opmmr_kij +! +! Args for dynamo: + real(r8),target :: edyn_tn (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_un (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_vn (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_wn (nlev,i0:i1,j0:j1) ! vertical wind (cm/s) + real(r8),target :: edyn_zht (nlev,i0:i1,j0:j1) ! geometric height (cm) + real(r8),target :: edyn_mbar (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_ped (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_hall (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_ui (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_vi (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_wi (nlev,i0:i1,j0:j1) +! +! Additional fields needed by oplus_xport: + real(r8),target :: edyn_te (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_ti (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_o2 (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_o1 (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_n2 (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_op (nlev,i0:i1,j0:j1) + real(r8),target :: edyn_optm1(nlev,i0:i1,j0:j1) + real(r8),target :: edyn_om (nlev,i0:i1,j0:j1) ! omega vertical motion (1/s) + real(r8),target :: edyn_zgi (nlev,i0:i1,j0:j1) ! geopotential height (cm) (interfaces) + real(r8),target :: op_out (nlev,i0:i1,j0:j1) ! oplus_xport output + real(r8),target :: opnm_out (nlev,i0:i1,j0:j1) ! oplus_xport output at time n-1 + real(r8),target :: edyn_ne (nlev,i0:i1,j0:j1) ! electron density diagnostic + + real(r8),target :: halo_tn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral temperature (deg K) + real(r8),target :: halo_te (nlev,i0-2:i1+2,j0-2:j1+2) ! electron temperature (deg K) + real(r8),target :: halo_ti (nlev,i0-2:i1+2,j0-2:j1+2) ! ion temperature (deg K) + real(r8),target :: halo_un (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral zonal wind (cm/s) + real(r8),target :: halo_vn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral meridional wind (cm/s) + real(r8),target :: halo_om (nlev,i0-2:i1+2,j0-2:j1+2) ! omega (1/s) + real(r8),target :: halo_o2 (nlev,i0-2:i1+2,j0-2:j1+2) ! o2 (mmr) + real(r8),target :: halo_o1 (nlev,i0-2:i1+2,j0-2:j1+2) ! o (mmr) + real(r8),target :: halo_n2 (nlev,i0-2:i1+2,j0-2:j1+2) ! n2 (mmr) + real(r8),target :: halo_mbar(nlev,i0-2:i1+2,j0-2:j1+2) ! mean molecular weight + real(r8), allocatable :: polesign(:) +! + real(r8) :: nmf2 (i0:i1,j0:j1) ! Electron number density at F2 peak (m-3 converted to cm-3) + real(r8) :: hmf2 (i0:i1,j0:j1) ! Height of electron number density F2 peak (m converted to km) + real(r8) :: & + height(3), & ! Surrounding heights when locating electron density F2 peak + nde(3) ! Surround densities when locating electron density F2 peak + real(r8) h12,h22,h32,deltx,atx,ax,btx,bx,ctx,cx ! Variables used for weighting when locating F2 peak +! + logical :: do_integrals +! +! Pointers for multiple-field calls: + type(array_ptr_type),allocatable :: ptrs(:) + + call t_startf('d_pie_coupling') + + if (debug.and.masterproc) then + + nstep = get_nstep() + call get_curr_date(iyear,imo,iday,tod) ! tod is integer time-of-day in seconds + secs = tod ! integer to float + + write(iulog,"('Enter d_pie_coupling: nstep=',i8,' iyear,imo,iday=',3i5,' ut (hrs)=',f6.2)") & + nstep,iyear,imo,iday,secs/3600._r8 + + write(iulog,"('d_pie_coupling: nspltop = ',i3)") nspltop + endif +! +! Get pressure at midpoints from pe (note pe is vertical dimension is nilev): +! + do k=1,nlev + pmid(i0:i1,k,j0:j1) = 0.5_r8*(pe(i0:i1,k,j0:j1)+pe(i0:i1,k+1,j0:j1)) + enddo + + !--------------------------------------------------------------- + ! Convert geopotential z to geometric height zht (m): + !--------------------------------------------------------------- + + zht(:,:,1:nlev) = zgi(:,:,1:nlev) * (1._r8 + zgi(:,:,1:nlev) / re) ! geometric height (interfaces) + + !--------------------------------------------------------------- + ! Need geometric height on midpoints for output + !--------------------------------------------------------------- + + zhtmid(:,:,1:nlev) = zgpmid(:,:,1:nlev) *(1._r8 + zgpmid(:,:,1:nlev) / re ) + + !------------------------------------------------------------------------------------------ + ! Convert virtual potential temperature to temperature and compute mean molecular weight: + !------------------------------------------------------------------------------------------ + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + n2mmr(i,j,k) = max(1.0_r8-(o1mmr(i,j,k)+o2mmr(i,j,k)+h1mmr(i,j,k)),n2min) + mbar(i,j,k) = 1.0_r8/(o1mmr(i,j,k)/rmassO1+o2mmr(i,j,k)/rmassO2 & + +h1mmr(i,j,k)/rmassH+n2mmr(i,j,k)/rmassN2) + enddo + enddo + enddo + + !----------------------------------------------------------------------------------------------- + ! Save analytically derived geometric height on interfaces and midpoints, omega (Pa/s) and mbar. + !----------------------------------------------------------------------------------------------- + do j=j0,j1 + call outfld('Z3GMI' ,zht(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('Z3GM' ,zhtmid(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('DPIE_OMEGA',omega(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('DPIE_MBAR' ,mbar (i0:i1,j,1:nlev),i1-i0+1,j) + enddo + + !--------------------------------------------------------------- + ! Calculate vertical neutral wind velocity wn(i,j,k). + ! (omega is input Pa/s, grav is m/s^2, tn and mbar are calculated above) + !--------------------------------------------------------------- + call calc_wn(tn,omega,pmid,mbar,grav,wn,i0,i1,j0,j1,nlev) ! wn is output (m/s) + + !--------------------------------------------------------------- + ! Convert from mmr to number densities (m^3): + !--------------------------------------------------------------- + do k=1,nlev + do j=j0,j1 + do i=i0,i1 +! O2+, NO+, N2+, O+: + o2p(i,j,k) = o2pmmr(i,j,k) * mbar(i,j,k) / rmassO2p * & + pmid(i,k,j) / (kboltz * tn(i,j,k)) + nop(i,j,k) = nopmmr(i,j,k) * mbar(i,j,k) / rmassNOp * & + pmid(i,k,j) / (kboltz * tn(i,j,k)) + n2p(i,j,k) = n2pmmr(i,j,k) * mbar(i,j,k) / rmassN2p * & + pmid(i,k,j) / (kboltz * tn(i,j,k)) + op(i,j,k) = opmmr(i,j,k) * mbar(i,j,k) / rmassOp * & + pmid(i,k,j) / (kboltz * tn(i,j,k)) + optm1(i,j,k) = opmmrtm1(i,j,k) * mbar(i,j,k) / rmassOp * & + pmid(i,k,j) / (kboltz * tn(i,j,k)) + enddo + enddo + enddo ! k=1,nlev +! +! Save input ions to waccm history (m^3): + do j=j0,j1 + call outfld('DPIE_O2P',o2p(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('DPIE_NOP',nop(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('DPIE_N2P',n2p(i0:i1,j,1:nlev),i1-i0+1,j) + call outfld('OpDens' ,op (i0:i1,j,1:nlev)/1.E6_r8,i1-i0+1,j) + do k=1,nlev + do i=i0,i1 + ne(i,j,k) = o2p(i,j,k)+nop(i,j,k)+n2p(i,j,k)+op(i,j,k) + enddo + enddo + call outfld('EDens' ,ne (i0:i1,j,1:nlev)/1.E6_r8,i1-i0+1,j) + enddo ! j=j0,j1 + + !------------------------------------------------------------------------------- + ! Derive diagnostics nmF2 and hmF2 for output based on TIE-GCM algorithm + !------------------------------------------------------------------------------- + jloop: do j=j0,j1 + iloop: do i=i0,i1 + + kx = 0 + kloop: do k=2,nlev + if (ne(i,j,k) >= ne(i,j,k-1) .and. ne(i,j,k) >= ne(i,j,k+1)) then + kx = k + exit kloop + endif + enddo kloop + + if (kx==0) then + hmf2(i,j) = fillvalue + nmf2(i,j) = fillvalue + exit iloop + endif + + height = (/zht(i,j,kx+1),zht(i,j,kx),zht(i,j,kx-1)/) + nde = (/ne(i,j,kx+1),ne(i,j,kx),ne(i,j,kx-1)/) + + h12 = height(1)*height(1) + h22 = height(2)*height(2) + h32 = height(3)*height(3) + + deltx=h12*height(2)+h22*height(3)+h32*height(1)-h32*height(2)-h12*height(3)-h22*height(1) + atx=nde(1)*height(2)+nde(2)*height(3)+nde(3)*height(1)-height(2)*nde(3)-height(3)*nde(1)-height(1)*nde(2) + ax=atx/deltx + + btx=h12*nde(2)+h22*nde(3)+h32*nde(1)-h32*nde(2)-h12*nde(3)-h22*nde(1) + bx=btx/deltx + ctx=h12*height(2)*nde(3)+h22*height(3)*nde(1)+h32*height(1)*nde(2)-h32*height(2)*nde(1)- & + h12*height(3)*nde(2)-h22*height(1)*nde(3) + cx=ctx/deltx + + hmf2(i,j)=-(bx/(2._r8*ax)) * 1.E-03_r8 + nmf2(i,j)=-((bx*bx-4._r8*ax*cx)/(4._r8*ax)) * 1.E-06_r8 + + enddo iloop ! i=i0,i1 + + call outfld('HMF2',hmf2(i0:i1,j),i1-i0+1,j) + call outfld('NMF2',nmf2(i0:i1,j),i1-i0+1,j) + + enddo jloop +! +! Save fields to waccm history: +! (must be transformed from (i,j,k) to (k,i,j)) +! + do j=j0,j1 + do i=i0,i1 + opmmr_kij(:,i,j) = opmmr(i,j,:) + enddo + enddo + call savefld_waccm(opmmr_kij,'DPIE_OPMMR',nlev,i0,i1,j0,j1) ! mmr +! +! O+ loss rates: +! Input loss rates: +! real(r8),intent(in) :: ion_OpO2(i0:i1,j0:j1,nlev) ! Op+O2 rate +! real(r8),intent(in) :: ion_OpN2(i0:i1,j0:j1,nlev) ! Op+N2 rate + + +! +! Get high-latitude potential from Heelis empirical model: +! (sub heelis_model is in heelis.F90) +! + +! +! Prepare inputs to edynamo and oplus_xport: +! + do k = 1,nlev + edyn_tn (k,i0:i1,j0:j1) = tn (i0:i1,j0:j1,k) + edyn_un (k,i0:i1,j0:j1) = u (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s + edyn_vn (k,i0:i1,j0:j1) = v (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s + edyn_wn (k,i0:i1,j0:j1) = wn (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s + edyn_zgi (k,i0:i1,j0:j1) = zgi (i0:i1,j0:j1,k) * 100._r8 ! m -> cm + edyn_zht (k,i0:i1,j0:j1) = zht (i0:i1,j0:j1,k) * 100._r8 ! m -> cm + edyn_mbar (k,i0:i1,j0:j1) = mbar (i0:i1,j0:j1,k) + edyn_ped (k,i0:i1,j0:j1) = sigma_ped (i0:i1,j0:j1,k) + edyn_hall (k,i0:i1,j0:j1) = sigma_hall(i0:i1,j0:j1,k) + edyn_ui (k,i0:i1,j0:j1) = ui (i0:i1,j0:j1,k) * 100._r8 ! zonal ion drift (m/s -> cm/s) + edyn_vi (k,i0:i1,j0:j1) = vi (i0:i1,j0:j1,k) * 100._r8 ! meridional ion drift (m/s -> cm/s) + edyn_wi (k,i0:i1,j0:j1) = wi (i0:i1,j0:j1,k) * 100._r8 ! vertical ion drift (m/s -> cm/s) +! +! Additional fields for oplus: +! + edyn_te (k,i0:i1,j0:j1) = te (i0:i1,j0:j1,k) + edyn_ti (k,i0:i1,j0:j1) = ti (i0:i1,j0:j1,k) + edyn_o2 (k,i0:i1,j0:j1) = o2mmr (i0:i1,j0:j1,k) + edyn_o1 (k,i0:i1,j0:j1) = o1mmr (i0:i1,j0:j1,k) + edyn_n2 (k,i0:i1,j0:j1) = n2mmr (i0:i1,j0:j1,k) + edyn_om (k,i0:i1,j0:j1) = -(omega(i0:i1,j0:j1,k) / pmid(i0:i1,k,j0:j1)) ! Pa/s -> 1/s + edyn_op (k,i0:i1,j0:j1) = op (i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 + edyn_optm1(k,i0:i1,j0:j1) = optm1 (i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 + enddo +! +! At first timestep, allocate optm1 module data, and initialize local +! edyn_optm1 to op from physics. This will be input to oplus_xport. +! After oplus_xport, optm1 will be updated from local oplus_xport output. +! After first timestep, simply update edyn_optm1 from optm1. +! optm1 is m^3 for waccm, whereas edyn_optm1 is cm^3 for oplus_xport. +! +! At this point, everything is in waccm format. The locals edyn_op and +! edyn_optm1 will be converted to tiegcm format for the call to oplus_xport, +! then oplus_xport output (opnm_out) will be converted back to waccm format +! before using it to update optm1 module data. +! +! if (nstep==1) then +! optm1 = 0._r8 +! do k=1,nlev +! edyn_optm1(k,i0:i1,j0:j1) = op(i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 +! enddo +! +! After the first step, edyn_optm1 input is updated from the module data +! (note edyn_optm1 will be converted to TIEGCM format before being +! passed in to oplus_xport) +! +! else ! nstep > 1 +! do k=1,nlev +! edyn_optm1(k,i0:i1,j0:j1) = optm1(i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 +! enddo +! endif +! +! These are in WACCM format, and most are in CGS units (see above): +! (units are specified in addfld calls, edyn_init.F90) +! + call savefld_waccm(edyn_tn ,'DPIE_TN' ,nlev,i0,i1,j0,j1) ! deg K + call savefld_waccm(edyn_un ,'DPIE_UN' ,nlev,i0,i1,j0,j1) ! cm/s + call savefld_waccm(edyn_vn ,'DPIE_VN' ,nlev,i0,i1,j0,j1) ! cm/s + call savefld_waccm(edyn_wn ,'DPIE_WN' ,nlev,i0,i1,j0,j1) ! cm/s + call savefld_waccm(edyn_om ,'DPIE_OM' ,nlev,i0,i1,j0,j1) ! omega on midpoints (1/s) + call savefld_waccm(edyn_zht ,'DPIE_ZHT' ,nlev,i0,i1,j0,j1) ! geometric height (cm) + call savefld_waccm(edyn_zgi ,'DPIE_ZGI' ,nlev,i0,i1,j0,j1) ! geopotential height on interfaces (cm) + call savefld_waccm(edyn_mbar ,'DPIE_BARM',nlev,i0,i1,j0,j1) ! mean mass + call savefld_waccm(edyn_o2 ,'DPIE_O2' ,nlev,i0,i1,j0,j1) ! cm^3 + call savefld_waccm(edyn_o1 ,'DPIE_O' ,nlev,i0,i1,j0,j1) ! cm^3 + call savefld_waccm(edyn_n2 ,'DPIE_N2' ,nlev,i0,i1,j0,j1) ! cm^3 + call savefld_waccm(edyn_te ,'DPIE_TE' ,nlev,i0,i1,j0,j1) + call savefld_waccm(edyn_ti ,'DPIE_TI' ,nlev,i0,i1,j0,j1) +! +! Save electron density to TIEGCM-format file (edynamo.nc): +! (ne(i,j,k) was calculated in m^3 above, save here in cm^3) +! + do j=j0,j1 + do i=i0,i1 + do k=1,nlev + edyn_ne(k,i,j) = ne(i,j,k)*1.e-6_r8 ! m^3 -> cm^3 + enddo + enddo + enddo +! +! Convert input fields from "WACCM format" to "TIEGCM format" +! (phase shift longitude data and invert the vertical dimension). +! + if (ionos_edyn_active) then + nfields = 21 + allocate(ptrs(nfields)) + ! + ! Fields needed for edynamo: + ptrs(1)%ptr => edyn_tn ; ptrs(2)%ptr => edyn_un ; ptrs(3)%ptr => edyn_vn + ptrs(4)%ptr => edyn_wn ; ptrs(5)%ptr => edyn_zht ; ptrs(6)%ptr => edyn_zgi + ptrs(7)%ptr => edyn_mbar ; ptrs(8)%ptr => edyn_ped ; ptrs(9)%ptr => edyn_hall + ! + ! Additional fields needed for oplus (and Ne for diag): + ptrs(10)%ptr => edyn_te ; ptrs(11)%ptr => edyn_ti ; ptrs(12)%ptr => edyn_o2 + ptrs(13)%ptr => edyn_o1 ; ptrs(14)%ptr => edyn_n2 ; ptrs(15)%ptr => edyn_om + ptrs(16)%ptr => edyn_op ; ptrs(17)%ptr => edyn_optm1 ; ptrs(18)%ptr => edyn_ne + ptrs(19)%ptr => edyn_ui ; ptrs(20)%ptr => edyn_vi ; ptrs(21)%ptr => edyn_wi + ! + ! Convert from WACCM to TIEGCM format: + call switch_model_format(ptrs,1,nlev,i0,i1,j0,j1,nfields) + deallocate(ptrs) + endif +! +! Call electrodynamo (edynamo.F90) +! If using time3d conductances, tell dynamo to *not* do fieldline +! integrations (i.e., do_integrals == false). In this case, edynamo +! conductances zigmxx,rim1,2 from time3d will be set by subroutine +! transform_glbin in time3d module. +! + do_integrals = .true. +! +! If ionos_edyn_active=false, then empirical ion drifts were passed in from physics, +! otherwise dynamo calculates them here, and they will be passed to physics. +! + if (ionos_edyn_active) then + + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling call dynamo... nstep=',i8)") nstep + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_tn ', & + MINVAL(edyn_tn(:,i0:i1,j0:j1)), MAXVAL(edyn_tn(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_un ', & + MINVAL(edyn_un(:,i0:i1,j0:j1)), MAXVAL(edyn_un(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_vn ', & + MINVAL(edyn_un(:,i0:i1,j0:j1)), MAXVAL(edyn_vn(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_wn ', & + MINVAL(edyn_wn(:,i0:i1,j0:j1)), MAXVAL(edyn_wn(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_zgi ', & + MINVAL(edyn_zgi(:,i0:i1,j0:j1)), MAXVAL(edyn_zgi(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_ped ', & + MINVAL(edyn_ped(:,i0:i1,j0:j1)), MAXVAL(edyn_ped(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_hall ', & + MINVAL(edyn_hall(:,i0:i1,j0:j1)), MAXVAL(edyn_hall(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_op ', & + MINVAL(edyn_op(:,i0:i1,j0:j1)), MAXVAL(edyn_op(:,i0:i1,j0:j1)) + write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_optm1 ', & + MINVAL(edyn_optm1(:,i0:i1,j0:j1)), MAXVAL(edyn_optm1(:,i0:i1,j0:j1)) + endif + + call t_startf('dpie_ionos_dynamo') + call dynamo(edyn_tn, edyn_un, edyn_vn, edyn_wn, edyn_zgi, & + edyn_ped, edyn_hall, edyn_ui, edyn_vi, edyn_wi, & + 1,nlev,i0,i1,j0,j1,do_integrals) + call t_stopf ('dpie_ionos_dynamo') + + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling after dynamo: nstep=',i8)") nstep + write(iulog,"(' ui min,max (cm/s)=',2es12.4)") minval(edyn_ui),maxval(edyn_ui) + write(iulog,"(' vi min,max (cm/s)=',2es12.4)") minval(edyn_vi),maxval(edyn_vi) + write(iulog,"(' wi min,max (cm/s)=',2es12.4)") minval(edyn_wi),maxval(edyn_wi) + endif + else + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling (dynamo NOT called): nstep=',i8)") nstep + write(iulog,"(' empirical ExB ui min,max (cm/s)=',2es12.4)") minval(ui),maxval(ui) + write(iulog,"(' empirical ExB vi min,max (cm/s)=',2es12.4)") minval(vi),maxval(vi) + write(iulog,"(' empirical ExB wi min,max (cm/s)=',2es12.4)") minval(wi),maxval(wi) + endif + endif +! +! Call O+ transport routine. Now all inputs to oplus_xport should be in +! tiegcm-format wrt longitude (-180->180), vertical (bot2top), and units (CGS). +! (Composition is mmr, ne is cm^3, winds are cm/s) +! Output op_out and opnm_out will be in cm^3, converted to mmr below. +! + if (ionos_oplus_xport) then + pmid_inv(1:nlev) = pref_mid(nlev:1:-1) ! invert ref pressure (Pa) as in tiegcm + + +! +! Transport O+ (all args in 'TIEGCM format') +! Subcycle oplus_xport nspltop times. +! + if (debug.and.masterproc) & + write(iulog,"('dpie_coupling before subcycling oplus_xport: nstep=',i8,' nspltop=',i3)") nstep,nspltop + + call t_startf('dpie_halo') +!$omp parallel do private(i, j, k) + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + halo_tn(k,i,j) = edyn_tn(k,i,j) + halo_te(k,i,j) = edyn_te(k,i,j) + halo_ti(k,i,j) = edyn_ti(k,i,j) + halo_un(k,i,j) = edyn_un(k,i,j) + halo_vn(k,i,j) = edyn_vn(k,i,j) + halo_om(k,i,j) = edyn_om(k,i,j) + halo_o2(k,i,j) = edyn_o2(k,i,j) + halo_o1(k,i,j) = edyn_o1(k,i,j) + halo_n2(k,i,j) = edyn_n2(k,i,j) + halo_mbar(k,i,j) = edyn_mbar(k,i,j) + enddo + enddo + enddo + ! + ! Define halo points on inputs: + ! WACCM has global longitude values at the poles (j=1,j=nlev) + ! (they are constant for most, except the winds.) + ! + ! Set two halo points in lat,lon: + ! + nfields=10 + allocate(ptrs(nfields),polesign(nfields)) + ptrs(1)%ptr => halo_tn ; ptrs(2)%ptr => halo_te ; ptrs(3)%ptr => halo_ti + ptrs(4)%ptr => halo_un ; ptrs(5)%ptr => halo_vn ; ptrs(6)%ptr => halo_om + ptrs(7)%ptr => halo_o2 ; ptrs(8)%ptr => halo_o1 ; ptrs(9)%ptr => halo_n2 + ptrs(10)%ptr => halo_mbar + + polesign = 1._r8 + polesign(4:5) = -1._r8 ! un,vn + + call mp_geo_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields) + ! + ! Set latitude halo points over the poles (this does not change the poles). + ! (the 2nd halo over the poles will not actually be used (assuming lat loops + ! are lat=2,plat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 + ! will be the first halo over the pole) + ! + call mp_pole_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields,polesign) + deallocate(ptrs,polesign) + call t_stopf('dpie_halo') + + call t_startf('dpie_oplus_xport') + do isplit=1,nspltop + + if (isplit > 1) then + edyn_op = op_out + edyn_optm1 = opnm_out + endif + + call oplus_xport(halo_tn,halo_te,halo_ti,halo_un,halo_vn,halo_om, & + edyn_zgi,halo_o2,halo_o1,halo_n2,edyn_op,edyn_optm1, & + halo_mbar,edyn_ui,edyn_vi,edyn_wi,pmid_inv, & + op_out,opnm_out, & + i0,i1,j0,j1,nspltop,isplit) + + enddo ! isplit=1,nspltop + call t_stopf ('dpie_oplus_xport') + + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling after subcycling oplus_xport: nstep=',i8,' nspltop=',i3)") & + nstep,nspltop + write(iulog,"(' op_out min,max (cm^3)=',2es12.4)") minval(op_out) ,maxval(op_out) + write(iulog,"(' opnm_out min,max (cm^3)=',2es12.4)") minval(opnm_out),maxval(opnm_out) + endif + + endif ! ionos_oplus_xport +! +! Convert ion drifts and O+ output from TIEGCM to WACCM format: +! + if (ionos_edyn_active) then + nfields = 5 ! ui,vi,wi,op,opnm + allocate(ptrs(nfields)) + ptrs(1)%ptr => edyn_ui ; ptrs(2)%ptr => edyn_vi ; ptrs(3)%ptr => edyn_wi + ptrs(4)%ptr => op_out ; ptrs(5)%ptr => opnm_out + call switch_model_format(ptrs,1,nlev,i0,i1,j0,j1,nfields) + deallocate(ptrs) + endif +! + if (ionos_oplus_xport) then + call savefld_waccm(op_out,'OPLUS',nlev,i0,i1,j0,j1) ! cm^3 +! +! Pass new O+ for current and previous time step back to physics (convert from cm^3 to m^3 and back to mmr). +! + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + opmmr(i,j,k) = op_out(k,i,j)*1.e6_r8 * rmassOp / mbar(i,j,k) * & + (kboltz * tn(i,j,k)) / pmid(i,k,j) + op_out(k,i,j) = opmmr(i,j,k) ! for save to waccm hist in mmr + opmmrtm1(i,j,k) = opnm_out(k,i,j)*1.e6_r8 * rmassOp / mbar(i,j,k) * & + (kboltz * tn(i,j,k)) / pmid(i,k,j) + enddo + enddo + enddo + + endif ! ionos_oplus_xport +! +! Convert ion drifts from cm/s to m/s for WACCM physics and history files. +! real(r8),intent(inout) :: ui(i0:i1,j0:j1,nlev) ! zonal ion drift (edynamo or empirical) +! + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + ui(i,j,k) = edyn_ui(k,i,j)/100._r8 + vi(i,j,k) = edyn_vi(k,i,j)/100._r8 + wi(i,j,k) = edyn_wi(k,i,j)/100._r8 + enddo + enddo + enddo + call savefld_waccm(edyn_ui/100._r8,'WACCM_UI',nlev,i0,i1,j0,j1) + call savefld_waccm(edyn_vi/100._r8,'WACCM_VI',nlev,i0,i1,j0,j1) + call savefld_waccm(edyn_wi/100._r8,'WACCM_WI',nlev,i0,i1,j0,j1) + + call t_stopf('d_pie_coupling') + + end subroutine d_pie_coupling +!----------------------------------------------------------------------- + subroutine calc_wn(tn,omega,pmid,mbar,grav,wn,i0,i1,j0,j1,nlev) + use shr_const_mod,only : shr_const_rgas ! Universal gas constant +! +! Calculate neutral vertical wind on midpoints (m/s) +! +! Inputs: + integer,intent(in) :: i0,i1,j0,j1,nlev + real(r8),dimension(i0:i1,j0:j1,nlev),intent(in) :: & + tn, & ! neutral temperature (deg K) + omega,& ! pressure velocity (Pa/s) + mbar ! mean molecular weight + real(r8),dimension(i0:i1,nlev,j0:j1),intent(in) :: & + pmid ! pressure at midpoints (Pa) + real(r8),intent(in) :: grav ! m/s^2 +! +! Output: + real(r8),intent(out) :: wn(i0:i1,j0:j1,nlev) ! vertical velocity output (m/s) +! +! Local: + integer :: i,j,k + real(r8) :: scheight(i0:i1,j0:j1,nlev) ! dimensioned for vectorization + + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + scheight(i,j,k) = shr_const_rgas*tn(i,j,k)/(mbar(i,j,k)*grav) + wn(i,j,k) = -omega(i,j,k)*scheight(i,j,k)/pmid(i,k,j) + enddo + enddo + enddo + end subroutine calc_wn +!----------------------------------------------------------------------- + subroutine calc_pfrac(sunlon,pfrac) +! +! Calculate pfrac fractional presence of dynamo equation using critical +! convection colatitudes crit(2). +! + use edyn_maggrid ,only: nmlonp1,ylonm,ylatm + use edyn_solve ,only: nmlat0 + use edyn_params ,only: dtr + implicit none +! +! Args: + real(r8),intent(in) :: sunlon ! Sun's longitude in dipole coordinates +! +! Output: fractional presence of dynamo equation using critical colatitudes +! + real(r8),intent(out) :: pfrac(nmlonp1,nmlat0) ! NH fraction of potential +! +! Local: + integer :: j,i + real(r8) :: offc(2),dskofc(2) + real(r8),dimension(nmlonp1,nmlat0) :: colatc + real(r8) :: sinlat,coslat,aslonc,ofdc,cosofc,sinofc + real(r8) :: crit(2) ! colatitude limits of high-lat potential (radians) + +! +! As in TIEGCM aurora: + offc(:) = 1._r8*dtr ! offset of auroral circle coord from mag coords + dskofc(:) = 0._r8 + +! +! Critical colatitudes: + crit = (/0.261799387_r8, 0.523598775_r8/) +! +! offc(2), dskofc(2) are for northern hemisphere aurora +! + ofdc = sqrt(offc(2)**2+dskofc(2)**2) + cosofc = cos(ofdc) + sinofc = sin(ofdc) + aslonc = asin(dskofc(2)/ofdc) +! +! Define colatc with northern convection circle coordinates +! + do j=1,nmlat0 + sinlat = sin(abs(ylatm(j+nmlat0-1))) + coslat = cos( ylatm(j+nmlat0-1)) + do i=1,nmlonp1 + colatc(i,j) = cos(ylonm(i)-sunlon+aslonc) + colatc(i,j) = acos(cosofc*sinlat-sinofc*coslat*colatc(i,j)) + enddo ! i=1,nmlonp1 +! +! Calculate fractional presence of dynamo equation at each northern +! hemisphere geomagnetic grid point. Output in pfrac(nmlonp1,nmlat0) +! + do i=1,nmlonp1 + pfrac(i,j) = (colatc(i,j)-crit(1))/(crit(2)-crit(1)) + if (pfrac(i,j) < 0._r8) pfrac(i,j) = 0._r8 + if (pfrac(i,j) >= 1._r8) pfrac(i,j) = 1._r8 + enddo ! i=1,nmlonp1 + enddo ! j=1,nmlat0 + end subroutine calc_pfrac +!----------------------------------------------------------------------- + subroutine sunloc(iday,secs,sunlons) +! +! Given day of year and ut, return sun's longitudes in dipole coordinates +! in sunlons(nlat) +! + use getapex ,only: alonm ! (nlonp1,0:nlatp1) + use edyn_geogrid ,only: nlon,nlat + use edyn_params ,only: pi +! +! Args: + integer,intent(in) :: iday ! day of year + real(r8),intent(in) :: secs ! ut in seconds + real(r8),intent(out) :: sunlons(nlat) ! output +! +! Local: + integer :: j,i,ii,isun,jsun + real(r8) :: glats,glons,pisun,pjsun,sndlons,csdlons + real(r8) :: dphi,dlamda + real(r8) :: rlonm(nlon+4,nlat) ! (nlon+4,nlat) + real(r8) :: r8_nlat, r8_nlon + real(r8) :: r8_isun, r8_jsun + +! +! Sun's geographic coordinates: + r8_nlat = dble(nlat) + r8_nlon = dble(nlon) + glats = asin(.398749_r8*sin(2._r8*pi*(iday-80)/365._r8)) + glons = pi*(1._r8-2._r8*secs/86400._r8) + dphi = pi/r8_nlat + dlamda = 2._r8*pi/r8_nlon + + do j=1,nlat + do i=1,nlon + ii = i+2 + rlonm(ii,j) = alonm(i,j) + enddo + do i=1,2 + rlonm(i,j) = rlonm(i+nlon,j) + rlonm(i+nlon+2,j) = rlonm(i+2,j) + enddo + enddo + + pisun = (glons+pi)/dlamda+1._r8 + pjsun = (glats+.5_r8*(pi-dphi))/dphi+1._r8 + isun = int(pisun) + jsun = int(pjsun) + r8_isun = dble(isun) + r8_jsun = dble(jsun) + pisun = pisun-r8_isun + pjsun = pjsun-r8_jsun + + sndlons = (1._r8-pisun)*(1._r8-pjsun)*sin(rlonm(isun+2,jsun))+ & + pisun*(1._r8-pjsun) *sin(rlonm(isun+3,jsun))+ & + pisun*pjsun *sin(rlonm(isun+3,jsun+1))+ & + (1._r8-pisun)*pjsun *sin(rlonm(isun+2,jsun+1)) + csdlons = (1._r8-pisun)*(1._r8-pjsun)*cos(rlonm(isun+2,jsun))+ & + pisun*(1._r8-pjsun) *cos(rlonm(isun+3,jsun))+ & + pisun*pjsun *cos(rlonm(isun+3,jsun+1))+ & + (1._r8-pisun)*pjsun *cos(rlonm(isun+2,jsun+1)) + sunlons(1) = atan2(sndlons,csdlons) + do j = 2,nlat + sunlons(j) = sunlons(1) + enddo + + end subroutine sunloc +!----------------------------------------------------------------------- +end module dpie_coupling diff --git a/src/ionosphere/waccmx/edyn_esmf.F90 b/src/ionosphere/waccmx/edyn_esmf.F90 new file mode 100644 index 0000000000..8f98efdb8a --- /dev/null +++ b/src/ionosphere/waccmx/edyn_esmf.F90 @@ -0,0 +1,1061 @@ +module edyn_esmf +#ifdef WACCMX_EDYN_ESMF + + use esmf ,only: ESMF_Grid, ESMF_Field, ESMF_RouteHandle, & ! ESMF library module + ESMF_LOGKIND_NONE, ESMF_SUCCESS, ESMF_END_KEEPMPI, ESMF_KIND_R8, ESMF_KIND_I4, & + ESMF_FieldGet, ESMF_GridWriteVTK, ESMF_STAGGERLOC_CENTER, ESMF_FieldRegridStore, & + ESMF_REGRIDMETHOD_BILINEAR, ESMF_POLEMETHOD_ALLAVG, ESMF_FieldSMMStore, & + ESMF_GridCreate1PeriDim, ESMF_INDEX_GLOBAL, ESMF_GridAddCoord, ESMF_GridGetCoord, & + ESMF_TYPEKIND_R8, ESMF_FieldCreate, ESMF_Array, ESMF_ArraySpec, ESMF_DistGrid, & + ESMF_GridGet, ESMF_ArraySpecSet, ESMF_ArrayCreate, ESMF_FieldGet, ESMF_FieldSMM, & + ESMF_TERMORDER_SRCSEQ + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_logfile ,only: iulog + use cam_abortutils ,only: endrun + use edyn_mpi ,only: ntask,ntaski,ntaskj,tasks,lon0,lon1,lat0,lat1,mytid,& + nmagtaski,nmagtaskj,mlon0,mlon1,mlat0,mlat1 + use getapex ,only: gdlatdeg,gdlondeg + use edyn_geogrid ,only: nlon,nlat,nlev,glon,glat,jspole,jnpole ! dynamically allocated geo grid + use edyn_maggrid ,only: nmlev,nmlon,nmlonp1,gmlat,gmlon + use spmd_utils ,only: masterproc +#endif + + implicit none + save + private + + public :: edyn_esmf_update + +#ifdef WACCMX_EDYN_ESMF + + public :: nf_3dgeo,f_3dgeo + public :: edyn_esmf_init, edyn_esmf_final, edyn_esmf_update_step, edyn_esmf_regrid + public :: edyn_esmf_get_2dfield, edyn_esmf_set2d_geo, edyn_esmf_get_3dfield, edyn_esmf_set3d_mag, edyn_esmf_set3d_geo + + public :: mag_be3, mag_adota1,mag_adota2,mag_a1dta2,mag_sini,mag_adotv2,mag_adotv1,mag_scht + public :: mag_zpot,mag_hal,mag_ped, mag_phi3d + public :: geo_be3,geo_adotv2,geo_a1dta2,geo_adota2,geo_adota1,geo_adotv1,geo_sini,geo_scht,geo_zpot + public :: geo_hal, geo_ped, mag_des_grid, geo_src_grid, geo_phi3d, geo_emz3d, geo_elam3d, geo_ephi3d + public :: mag_emz3d, mag_elam3d, mag_ephi3d + + type(ESMF_Grid) :: & + geo_src_grid, mag_src_grid, & ! source grids (will not have periodic pts) + geo_des_grid, mag_des_grid ! destination grids (will have periodic pts) +! +! 3d (i,j,k) ESMF Fields on geographic subdomains: +! + type(ESMF_Field) :: & ! 3d ESMF fields on geographic grid + geo_ped, & ! pedersen conductivity + geo_hal, & ! hall conductivity + geo_zpot, & ! geopotential height (cm) + geo_scht, & ! scale height (cm) + geo_adotv1, & ! ue1 (m/s) + geo_adotv2 ! ue2 (m/s) + integer,parameter :: nf_3dgeo=6 ! number of 3d fields on geographic grid + type(ESMF_Field) :: f_3dgeo(nf_3dgeo) ! fields on 3d geo grid (could be bundled?) +! +! 2d (i,j) ESMF fields on geographic subdomains: +! + type(ESMF_Field) :: & ! 2d ESMF fields on geographic grid + geo_sini, & ! sin(I_m) + geo_adota1, & ! d(1)**2/D + geo_adota2, & ! d(2)**2/D + geo_a1dta2, & ! (d(1) dot d(2)) /D + geo_be3 ! mag field strength (T) +! +! 3d (i,j,k) ESMF fields regridded to magnetic subdomains: +! + type(ESMF_Field) :: & ! 3d ESMF fields on geomagnetic grid + mag_ped, & ! pedersen conductivity + mag_hal, & ! hall conductivity + mag_zpot, & ! geopotential height (cm) + mag_scht, & ! scale height (cm) + mag_adotv1, & ! ue1 (m/s) + mag_adotv2 ! ue2 (m/s) +! +! 2d (i,j) ESMF fields on magnetic subdomains: +! + type(ESMF_Field) :: & ! 2d fields on geomagnetic grid + mag_sini, & ! sin(I_m) + mag_adota1, & ! d(1)**2/D + mag_adota2, & ! d(2)**2/D + mag_a1dta2, & ! (d(1) dot d(2)) /D + mag_be3 ! mag field strength (T) +! +! 3d electric potential and electric field for mag to geo regridding: +! + type(ESMF_Field) :: mag_phi3d,mag_ephi3d,mag_elam3d,mag_emz3d + type(ESMF_Field) :: geo_phi3d,geo_ephi3d,geo_elam3d,geo_emz3d + + type(ESMF_RouteHandle) :: & ! ESMF route handles for regridding + routehandle_geo2mag, & ! for geo to mag regrid + routehandle_mag2geo, & ! for mag to geo regrid + routehandle_geo2mag_2d ! for 2d geo to mag +! + real(r8) :: r8_nlon + real(r8),allocatable :: unitv(:) +! + private routehandle_geo2mag, routehandle_mag2geo,& + routehandle_geo2mag_2d,r8_nlon + + logical, protected :: edyn_esmf_update_step = .true. + logical :: debug=.false. ! set true for prints to stdout at each call +#endif + + contains +#ifdef WACCMX_EDYN_ESMF +!----------------------------------------------------------------------- + subroutine edyn_esmf_init( mpi_comm ) + + integer, intent(in) :: mpi_comm + + end subroutine edyn_esmf_init + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine edyn_esmf_final + + end subroutine edyn_esmf_final + +#endif + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine edyn_esmf_update + use getapex, only: get_apex,magfield, alonm + use mo_apex, only: geomag_year_updated + +#ifdef WACCMX_EDYN_ESMF +! Create ESMF grids for geographic and magnetic, and create ESMF fields +! as necessary on both grids. Define the 2d coordinates for each grid, +! and save an ESMF routehandles for geo2mag and mag2geo regridding. +! +! Local: + integer :: rc ! return code for ESMF calls + real(ESMF_KIND_R8),pointer :: fptr(:,:,:) + integer :: lbnd_destgeo(3),ubnd_destgeo(3) ! 3d bounds of destination geo grid + integer :: lbnd_destmag(3),ubnd_destmag(3) ! 3d bounds of destination mag grid + integer :: lbnd_srcgeo(3),ubnd_srcgeo(3) ! 3d bounds of source geo grid + integer :: lbnd_srcmag(3),ubnd_srcmag(3) ! 3d bounds of source mag grid + integer(ESMF_KIND_I4),pointer :: factorIndexList(:,:) + real(ESMF_KIND_R8),pointer :: factorList(:) + integer :: smm_srctermproc, smm_pipelinedep +#endif + + if (.not.geomag_year_updated .and. allocated(alonm)) return +! +! Get apex coordinates. +! + call get_apex( ) ! get apex coordinates + call magfield ! calculate magnetic field parameters + +#ifdef WACCMX_EDYN_ESMF + + smm_srctermproc = 0 + smm_pipelinedep = 16 +! +! Set unit vector (this routine called once per run unless crossing year boundary): +! Handle year boundary by checking if field is allocated +! + if (.not.allocated(unitv)) allocate(unitv(nlon)) + unitv(:) = 1._r8 + r8_nlon = dble(nlon) ! 8-byte float(nlon) +! +! Make magnetic and geographic grids for geo2mag regridding: +! + call create_geo_grid(geo_src_grid,'src') ! geo source grid + call create_mag_grid(mag_des_grid,'des') ! mag destination grid +! +! Make grids for mag2geo regridding: +! + call create_mag_grid(mag_src_grid,'src') + call create_geo_grid(geo_des_grid,'des') +! +! Create empty fields on geographic grid that will be transformed to +! the magnetic grid and passed as input to the dynamo. This does not +! assign any values. +! +! 3d fields on source geo grid (these exclude periodic points): +! + call edyn_esmf_create_geofield(geo_ped,geo_src_grid, 'PED ',nlev) + call edyn_esmf_create_geofield(geo_hal ,geo_src_grid, 'HAL ',nlev) + call edyn_esmf_create_geofield(geo_zpot,geo_src_grid, 'ZPOT ',nlev) + call edyn_esmf_create_geofield(geo_scht,geo_src_grid, 'SCHT ',nlev) + call edyn_esmf_create_geofield(geo_adotv1,geo_src_grid,'ADOTV1 ',nlev) + call edyn_esmf_create_geofield(geo_adotv2,geo_src_grid,'ADOTV2 ',nlev) +! +! Get 3d bounds of source geo field: +! + call ESMF_FieldGet(geo_ped,localDe=0,farrayPtr=fptr, & + computationalLBound=lbnd_srcgeo, & + computationalUBound=ubnd_srcgeo,rc=rc) + + if (debug) then + write(iulog,"('Bounds of source geo field: lbnd_srcgeo=',3i4,' ubnd_srcgeo=',3i4,' glon=',2f9.3)") & + lbnd_srcgeo,ubnd_srcgeo + endif +! +! 2d fields on source geo grid (these exclude periodic points): +! + call edyn_esmf_create_geofield(geo_sini ,geo_src_grid,'SINI ',0) + call edyn_esmf_create_geofield(geo_adota1,geo_src_grid,'ADOTA1 ',0) + call edyn_esmf_create_geofield(geo_adota2,geo_src_grid,'ADOTA2 ',0) + call edyn_esmf_create_geofield(geo_a1dta2,geo_src_grid,'A1DTA2 ',0) + call edyn_esmf_create_geofield(geo_be3 ,geo_src_grid,'BE3 ',0) +! +! 3d fields on destination mag grid (will include periodic point): +! + call edyn_esmf_create_magfield(mag_ped ,mag_des_grid, 'PED ',nmlev) + call edyn_esmf_create_magfield(mag_hal ,mag_des_grid, 'HAL ',nmlev) + call edyn_esmf_create_magfield(mag_zpot,mag_des_grid, 'ZPOT ',nmlev) + call edyn_esmf_create_magfield(mag_scht,mag_des_grid, 'SCHT ',nmlev) + call edyn_esmf_create_magfield(mag_adotv1,mag_des_grid,'ADOTV1 ',nmlev) + call edyn_esmf_create_magfield(mag_adotv2,mag_des_grid,'ADOTV2 ',nmlev) +! +! Get 3d bounds of destination mag field: +! + call ESMF_FieldGet(mag_ped,localDe=0,farrayPtr=fptr, & + computationalLBound=lbnd_destmag, & + computationalUBound=ubnd_destmag,rc=rc) + + if (debug) then + write(iulog,"('Bounds of destination mag field: lbnd_destmag=',3i4,' ubnd_destmag=',3i4,' gmlon=',2f9.3)") & + lbnd_destmag,ubnd_destmag + write(iulog,"('esmf_init: lon bnd_destmag =',2i4,' gmlon=',2f9.3)") & + lbnd_destmag(1),ubnd_destmag(1),gmlon(lbnd_destmag(1)),gmlon(ubnd_destmag(1)) + write(iulog,"('esmf_init: lat bnd_destmag =',2i4,' gmlat=',2f9.3)") & + lbnd_destmag(2),ubnd_destmag(2),gmlat(lbnd_destmag(2)),gmlat(ubnd_destmag(2)) + endif +! +! 2d fields on destination mag grid (will include periodic point): +! + call edyn_esmf_create_magfield(mag_sini ,mag_des_grid,'SINI ',0) + call edyn_esmf_create_magfield(mag_adota1,mag_des_grid,'ADOTA1 ',0) + call edyn_esmf_create_magfield(mag_adota2,mag_des_grid,'ADOTA2 ',0) + call edyn_esmf_create_magfield(mag_a1dta2,mag_des_grid,'A1DTA2 ',0) + call edyn_esmf_create_magfield(mag_be3 ,mag_des_grid,'BE3 ',0) +! +! 3d fields on source mag grid for mag2geo: +! + call edyn_esmf_create_magfield(mag_phi3d ,mag_src_grid,'PHIM3D ',nmlev) + call edyn_esmf_create_magfield(mag_ephi3d,mag_src_grid,'EPHI3D ',nmlev) + call edyn_esmf_create_magfield(mag_elam3d,mag_src_grid,'ELAM3D ',nmlev) + call edyn_esmf_create_magfield(mag_emz3d ,mag_src_grid,'EMZ3D ',nmlev) +! +! 3d fields on destination geo grid for mag2geo: +! + call edyn_esmf_create_geofield(geo_phi3d ,geo_des_grid,'PHIG3D ',nlev) + call edyn_esmf_create_geofield(geo_ephi3d,geo_des_grid,'EPHI3D ',nlev) + call edyn_esmf_create_geofield(geo_elam3d,geo_des_grid,'ELAM3D ',nlev) + call edyn_esmf_create_geofield(geo_emz3d ,geo_des_grid,'EMZ3D ',nlev) +! +! Get 3d bounds of source mag field: + call ESMF_FieldGet(mag_phi3d,localDe=0,farrayPtr=fptr,& + computationalLBound=lbnd_srcmag, & + computationalUBound=ubnd_srcmag,rc=rc) + + if (debug) then + write(iulog,"('esmf_init: lon bnd_srcmag =',2i4,' gmlon=',2f9.3)") & + lbnd_srcmag(1),ubnd_srcmag(1) + write(iulog,"('esmf_init: lat bnd_srcmag =',2i4,' gmlat=',2f9.3)") & + lbnd_srcmag(2),ubnd_srcmag(2) + endif +! +! Get 3d bounds of destination geo field: +! + call ESMF_FieldGet(geo_phi3d,localDe=0,farrayPtr=fptr,& + computationalLBound=lbnd_destgeo, & + computationalUBound=ubnd_destgeo,rc=rc) + + if (debug) then + write(iulog,"('esmf_init: lon bnd_destgeo=',2i4,' glon=',2f9.3)") & + lbnd_destgeo(1),ubnd_destgeo(1) + write(iulog,"('esmf_init: lat bnd_destgeo=',2i4,' glat=',2f9.3)") & + lbnd_destgeo(2),ubnd_destgeo(2) + endif +! +! Save route handles for grid transformations in both directions +! geo2mag and mag2geo. FieldRegridStore needs to be called only +! once for each transformation before the timestep loop (src and +! dest fields are still required, so just use ped here). Once inside +! the timestep loop, the same routehandle can be used for all fields +! that are regridded in the given direction. +! +! These calls will leave *.vtk info files in execdir: +! call ESMF_GridWriteVTK(geo_src_grid, & +! staggerloc=ESMF_STAGGERLOC_CENTER, filename="geoGrid",rc=rc) +! call ESMF_GridWriteVTK(mag_des_grid, & +! staggerloc=ESMF_STAGGERLOC_CENTER, filename="magGrid",rc=rc) +! +! Save route handle and get esmf indices and weights for geo2mag: +! + call ESMF_FieldRegridStore(srcField=geo_ped,dstField=mag_ped, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + routeHandle=routehandle_geo2mag,factorIndexList=factorIndexList, & + factorList=factorList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(a,a,i4)") '>>> edyn_esmf_update: error return from ', & + 'ESMF_FieldRegridStore for 3d geo2mag: rc=',rc + call endrun('edyn_esmf_update: ESMF_FieldRegridStore ped') + endif +! +! Store route handle for geo2mag 3d fields. +! + call ESMF_FieldSMMStore(geo_ped,mag_ped,routehandle_geo2mag, & + factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore for ',& + '3d geo2mag: rc=',rc + call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 3d geo2mag ped') + endif +! +! Store route handle geo2mag 2d fields: +! + call ESMF_FieldSMMStore(geo_sini,mag_sini,routehandle_geo2mag_2d, & + factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore',& + ' for 2d geo2mag: rc=',rc + call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 2d geo2mag sini') + endif +! +! Save route handle and get esmf indices and weights for mag2geo: +! (this overwrites factorIndexList and factorList from geo2mag call above) +! +! These calls will leave *.vtk info files in execdir: +! call ESMF_GridWriteVTK(mag_src_grid, & +! staggerloc=ESMF_STAGGERLOC_CENTER, filename="magSrcGrid",rc=rc) +! call ESMF_GridWriteVTK(geo_des_grid, & +! staggerloc=ESMF_STAGGERLOC_CENTER, filename="geoDesGrid",rc=rc) + +! Save route handle and get esmf indices and weights for mag2geo: +! + call ESMF_FieldRegridStore(srcField=mag_phi3d,dstField=geo_phi3d, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + routeHandle=routehandle_mag2geo,factorIndexList=factorIndexList,& + factorList=factorList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ',& + 'ESMF_FieldRegridStore for 3d mag2geo: rc=',rc + call endrun('edyn_esmf_update: ESMF_FieldRegridStore for 3d mag2geo phi3d') + endif +! +! mag2geo 3d fields: +! + call ESMF_FieldSMMStore(mag_phi3d,geo_phi3d,routehandle_mag2geo,& + factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore ',& + 'for 3d mag2geo: rc=',rc + call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 3d geo2mag phi3d') + endif + + edyn_esmf_update_step = .true. +#endif + end subroutine edyn_esmf_update + +#ifdef WACCMX_EDYN_ESMF +!----------------------------------------------------------------------- + real(r8) function select_wt_mag2geo(n,dimx,djmy) + integer,intent(in) :: n + real(r8),intent(in) :: dimx,djmy + + select_wt_mag2geo = 0._r8 + select case (n) + case(1) + select_wt_mag2geo = (1._r8-dimx)*(1._r8-djmy) + case(2) + select_wt_mag2geo = dimx*(1._r8-djmy) + case(3) + select_wt_mag2geo = dimx*djmy + case(4) + select_wt_mag2geo = (1._r8-dimx)*djmy + end select + end function select_wt_mag2geo +!----------------------------------------------------------------------- + subroutine create_mag_grid(grid_out,srcdes) +! +! Create ESMF geomagnetic grid, w/ lon,lat coordinates. +! This is called from esmf_init during model initialization. +! +! Args: + type(ESMF_Grid),intent(out) :: grid_out + character(len=*),intent(in) :: srcdes +! +! Local: + integer :: istat,i,j,n,rc + real(ESMF_KIND_R8),pointer :: coordX(:,:),coordY(:,:) + integer :: lbnd(2),ubnd(2) + integer :: nmlons_task(ntaski) ! number of lons per task + integer :: nmlats_task(ntaskj) ! number of lats per task +! +! We are creating either a source grid or a destination grid: +! + if (srcdes /= 'src' .and. srcdes /= 'des') then + write(iulog,"(a)") '>>> create_mag_grid: srcdes = ''',srcdes, & + ''' but must be either ''src'' or ''des''' + call endrun('create_mag_grid: srcdes') + endif +! +! nmlons_task(nmagtaski) = number of mag lons per task in lon dim +! + do i=1,nmagtaski + loop: do n=0,ntask-1 + if (tasks(n)%magtidi==i-1) then + nmlons_task(i) = tasks(n)%nmaglons + exit loop + endif + enddo loop + enddo +! +! Exclude periodic points (1 point fewer for mpi tasks at east end) +! for source grids (this overwrites above for eastern-most tasks): +! + if (srcdes == 'src') then + do n=0,ntask-1 + if (tasks(n)%magtidi==nmagtaski-1) then ! east edge of proc matrix + nmlons_task(tasks(n)%magtidi+1) = tasks(n)%nmaglons-1 + endif + enddo + endif +! +! nmlats_task(nmagtaskj) = number of mag lats per task in lat dim +! + do j=1,nmagtaskj + loop1: do n=0,ntask-1 + if (tasks(n)%magtidj==j-1) then + nmlats_task(j) = tasks(n)%nmaglats + exit loop1 + endif + enddo loop1 + enddo +! +! Create curvilinear magnetic grid (both coords depend +! on both dimensions, i.e., lon(i,j),lat(i,j)): +! + grid_out = ESMF_GridCreate1PeriDim( & + countsPerDEDim1=nmlons_task, coordDep1=(/1,2/), & + countsPerDEDim2=nmlats_task, coordDep2=(/1,2/), & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> create_mag_grid: error return from ',& + 'ESMF_GridCreateShapeTile: rc=',rc + call endrun('create_mag_grid: ESMF_GridCreate1PeriDim') + endif +! +! Allocate coordinates: +! + call ESMF_GridAddCoord(grid_out,staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) + + if (rc /=ESMF_SUCCESS) then + write(iulog,"(2a,i4)") '>>> create_mag_grid: error return from ',& + 'ESMF_GridAddCoord: rc=',rc + call endrun('create_mag_grid: ESMF_GridAddCoord mag_grid') + endif +! +! Get pointer and set mag grid longitude coordinates: +! + call ESMF_GridGetCoord(grid_out, coordDim=1, localDE=0, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordX, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(i4)") '>>> create_mag_grid: error return from ', & + 'ESMF_GridGetCoord for longitude coords: rc=',rc + call endrun('create_mag_grid: ESMF_GridGetCoord mag grid longitude') + endif + + do j=lbnd(2),ubnd(2) + do i=lbnd(1),ubnd(1) + coordX(i,j) = gdlondeg(i,j) + enddo + enddo +! +! Get pointer and set mag grid latitude coordinates: +! + call ESMF_GridGetCoord(grid_out, coordDim=2, localDE=0, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordY, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(i4)") '>>> create_mag_grid: error return from ',& + 'ESMF_GridGetCoord for latitude coords: rc=',rc + call endrun('create_mag_grid: ESMF_GridGetCoord latitude') + endif + + do j=lbnd(2),ubnd(2) + do i=lbnd(1),ubnd(1) + coordY(i,j) = gdlatdeg(i,j) + enddo + enddo + + if (debug) then + write(iulog,"(4a,2i4,a,2i4,a,2i4,a,2i4)") 'Created ESMF ',srcdes,' mag grid: ', & + ' lbnd,ubnd_lon=',lbnd(1),ubnd(1),' mlon0,1=',mlon0,mlon1, & + ' lbnd,ubnd_lat=',lbnd(2),ubnd(2),' mlat0,1=',mlat0,mlat1 + endif + + end subroutine create_mag_grid +!----------------------------------------------------------------------- + subroutine create_geo_grid(grid_out,srcdes) +! +! Args: + type(ESMF_Grid),intent(out) :: grid_out + character(len=*),intent(in) :: srcdes +! +! Local: + integer :: i,j,n,rc + integer :: lbnd_lat,ubnd_lat,lbnd_lon,ubnd_lon,lbnd(1),ubnd(1) + integer :: ihalf, nlon_local ! Used to convert from CAM lons to edynamo lons + real(ESMF_KIND_R8),pointer :: coordX(:),coordY(:) + integer :: nlons_task(ntaski) ! number of lons per task + integer :: nlats_task(ntaskj) ! number of lats per task + logical :: has_poles +! +! We are creating either a source grid or a destination grid: +! + if (srcdes /= 'src' .and. srcdes /= 'des') then + write(iulog,"(a)") '>>> create_geo_grid: srcdes = ''',srcdes, & + ''' but must be either ''src'' or ''des''' + call endrun('create_geo_grid: srcdes') + endif +! +! nlons_task(ntaski) = number of geo lons per task. +! + do i=1,ntaski + loop: do n=0,ntask-1 + if (tasks(n)%mytidi==i-1) then + nlons_task(i) = tasks(n)%nlons + exit loop + endif + enddo loop + enddo +! +! Exclude periodic points (2 points fewer for procs at each end) +! for source grids only (east and west edges of task table). +! (TIMEGCM only) +! +! if (srcdes == 'src'.and.trim(model_name)=='TIMEGCM') then +! do n=0,ntask-1 +! east or west edge of task table: +! if (tasks(n)%mytidi==ntaski-1.or.tasks(n)%mytidi==0) & +! nlons_task(tasks(n)%mytidi+1) = tasks(n)%nlons-2 +! enddo +! endif +! +! nlats_task(ntaskj) = number of geo lats per task. +! + do j=1,ntaskj + loop1: do n=0,ntask-1 + if (tasks(n)%mytidj==j-1) then + nlats_task(j) = tasks(n)%nlats + exit loop1 + endif + enddo loop1 + enddo +! +! Check to see if global glat(nlat) has poles (WACCM does, TIMEGCM does not): + has_poles = .false. + do j=1,nlat + if (abs(glat(j))==90._r8) has_poles = .true. + enddo + + if (debug) write(iulog,"('create_geo_grid: srcdes=',a,' has_poles=',l1)") srcdes,has_poles +! +! If making destination grid and glat does not have poles, add extra points +! at north and south edges of task table: +! + if (.not.has_poles.and.srcdes=='des') then ! probably TIMEGCM + do n=0,ntask-1 +! north or south edge of task table: add 1 lat for pole + if (tasks(n)%mytidj==ntaskj-1.or.tasks(n)%mytidj==0) & + nlats_task(tasks(n)%mytidj+1) = tasks(n)%nlats+1 + enddo +! +! Create 2d geographic destination grid (minimum lat index is 0 to include poles): + grid_out = ESMF_GridCreate1PeriDim( & + countsPerDEDim1=nlons_task, coordDep1=(/1/), & + countsPerDEDim2=nlats_task, coordDep2=(/2/), & + indexflag=ESMF_INDEX_GLOBAL,minIndex=(/1,0/),rc=rc) + + elseif (has_poles) then ! geo source grid does not have poles +! +! Create 2d geographic source grid (without poles) + grid_out = ESMF_GridCreate1PeriDim( & + countsPerDEDim1=nlons_task, coordDep1=(/1/), & + countsPerDEDim2=nlats_task, coordDep2=(/2/), & + indexflag=ESMF_INDEX_GLOBAL,minIndex=(/1,1/),rc=rc) + else + write(iulog,*) 'No capability for ESMF to handle source grid without poles' + call endrun('create_geo_grid: No ESMF capability for source grid without poles') + endif + + if (rc /=ESMF_SUCCESS) then + write(iulog,"(/,2a,i4)") '>>> create_geo_grid: error return from ',& + 'ESMF_GridCreate1PeriDim: rc=',rc + call endrun('create_geo_grid: ESMF_GridCreate1PeriDim') + endif +! +! Allocate coordinates: +! + call ESMF_GridAddCoord(grid_out,staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) + + if (rc /=ESMF_SUCCESS) then + write(iulog,"(/,a)") '>>> create_geo_grid: error return from ESMF_GridAddCoord' + call endrun('create_geo_grid: ESMF_GridAddCoord') + endif +! +! Get pointer and set geo grid longitude coordinates: +! + call ESMF_GridGetCoord(grid_out, coordDim=1, localDE=0, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordX, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + + if (rc /=ESMF_SUCCESS) then + write(iulog,"(/,2a)") '>>> create_geo_grid: error return from ',& + 'ESMF_GridGetCoord for longitude coords' + call endrun('create_geo_grid: ESMF_GridGetCoord longitude') + endif +! +! Note glon was shifted to +/-180 by sub set_geogrid (edyn_init.F90) +! + lbnd_lon = lbnd(1) ; ubnd_lon = ubnd(1) + do i=lbnd_lon,ubnd_lon + coordX(i) = glon(i) ! 1 -> 72 + enddo +! +! Get pointer and set geo grid latitude coordinates, including poles: +! + call ESMF_GridGetCoord(grid_out, coordDim=2, localDE=0, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordY, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + + if (rc /=ESMF_SUCCESS) then + write(iulog,"(/,2a)") '>>> create_geo_grid: error return from ',& + 'ESMF_GridGetCoord for latitude coords' + call endrun('create_geo_grid: ESMF_GridGetCoord latitude') + endif + + lbnd_lat = lbnd(1) ; ubnd_lat = ubnd(1) + + if (.not.has_poles.and.srcdes=='des') then ! geo destination grid has poles + do j=lbnd_lat,ubnd_lat + if (j==jspole) then + coordY(j) = -90._r8 + elseif (j==jnpole) then + coordY(j) = +90._r8 + else + coordY(j) = glat(j) + endif + enddo + elseif (has_poles) then + do j=lbnd_lat,ubnd_lat + coordY(j) = glat(j) + enddo + else + write(iulog,*) 'No capability for ESMF to handle source grid without poles' + call endrun('create_geo_grid: No ESMF capability for source grid without poles') + endif + + if (debug) then + write(iulog,"(4a,2i4,a,2i4,a,2i4,a,2i4)") 'Created ESMF ',srcdes,' geo grid: ', & + ' lbnd,ubnd_lon=',lbnd_lon,ubnd_lon,' lon0,1=',lon0,lon1, & + ' lbnd,ubnd_lat=',lbnd_lat,ubnd_lat,' lat0,1=',lat0,lat1 + + write(iulog,"('coordX for ',a,' geo grid = ',/,(8f10.4))") srcdes,coordX + write(iulog,"('coordY for ',a,' geo grid = ',/,(8f10.4))") srcdes,coordY + endif + + end subroutine create_geo_grid +!----------------------------------------------------------------------- + subroutine edyn_esmf_create_geofield(field,grid,name,nlev) +! +! Create ESMF field (2d or 3d) on geo grid (will exclude periodic points) +! If nlev == 0, field is 2d (i,j), otherwise field is 3d, +! and 3rd dimension is ungridded +! +! Args: + integer,intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) + type(ESMF_Grid),intent(in) :: grid + character(len=*),intent(in) :: name + type(ESMF_Field),intent(out) :: field +! +! Local: + integer :: rc + type(ESMF_ArraySpec) :: arrayspec +! +! Create 3d field (i,j,k), with non-distributed vertical dimension: + if (nlev > 0) then + call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_ArraySpecSet 3d field') + field = ESMF_FieldCreate(grid, arrayspec,ungriddedLBound=(/1/), & + ungriddedUBound=(/nlev/),staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_FieldCreate 3d field') +! +! Create 2d field (i,j): + else ! create 2d field + call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_ArraySpecSet 2d field') + field = ESMF_FieldCreate(grid, arrayspec,& + staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_FieldCreate 2d field') + endif + end subroutine edyn_esmf_create_geofield +!----------------------------------------------------------------------- + subroutine edyn_esmf_create_magfield(field,grid,name,nlev) +! +! Create ESMF field (2d or 3d) on mag grid. This will include the +! mag periodic point, which will be zero after regridding. +! If nlev == 0, field is 2d (i,j), otherwise field is 3d, +! and 3rd dimension is ungridded +! +! Args: + integer,intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) + type(ESMF_Grid),intent(in) :: grid + character(len=*),intent(in) :: name + type(ESMF_Field),intent(out) :: field +! +! Local: + integer :: rc + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_Array) :: array3d,array2d + type(ESMF_DistGrid) :: distgrid +! +! Get necessary information from the mag grid: + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CENTER,& + distgrid=distgrid,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_GridGet') +! +! Create 3d mag field (i,j,k), with non-distributed vertical dimension: +! (add periodic point in longitude with computationalEdgeUWidth) +! + if (nlev > 0) then + call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) + if (rc /= ESMF_SUCCESS)call endrun('edyn_esmf_create_magfield: ESMF_ArraySpecSet 3d field') + + array3d = ESMF_ArrayCreate(arrayspec=arrayspec, & + distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & + undistLBound=(/1/),undistUBound=(/nlev/), & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_ArrayCreate 3d field') + + field = ESMF_FieldCreate(grid, array3d, & + ungriddedLBound=(/1/), ungriddedUBound=(/nlev/), & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_FieldCreate 3d field') +! +! Create 2d mag field (i,j): +! (add periodic point in longitude with computationalEdgeUWidth) +! + else ! create 2d field + call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8,rc=rc) + if (rc /= ESMF_SUCCESS)call endrun('edyn_esmf_create_magfield: ESMF_ArraySpecSet 2d field') + + array2d = ESMF_ArrayCreate(arrayspec=arrayspec, & + distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_ArrayCreate 2d field') + field = ESMF_FieldCreate(grid, array2d, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_FieldCreate 2d field') + endif + end subroutine edyn_esmf_create_magfield + +!----------------------------------------------------------------------- + subroutine edyn_esmf_set3d_geo(fields,fnames,f,nf,ilev0,ilev1,& + ilon0,ilon1,ilat0,ilat1) +! +! Set values of a 3d ESMF field on geographic source grid, prior to +! geographic to magnetic grid transformation. +! Periodic points are excluded, geographic poles are at j==jspole and jnpole +! Note dimension order changes from input (k,i,j) to output (i,j,k). +! +! Args: + integer,intent(in) :: nf + type(ESMF_Field) ,intent(in) :: fields(nf) ! esmf fields on geo grid + character(len=*) ,intent(in) :: fnames(nf) ! field names +! +! f is input data on model subdomains (including periodic points) +! (note esmf source field excludes periodic points) +! + integer,intent(in) :: ilev0,ilev1,ilon0,ilon1,ilat0,ilat1 + real(r8),intent(in) :: f(ilev0:ilev1,ilon0:ilon1,ilat0:ilat1,nf) +! +! Local: + integer :: i,ii,j,k,rc,n,istat + integer,parameter :: mxf=8 ! for call by dynamo_inputs + integer :: lbnd(3),ubnd(3) ! lower,upper bounds of 3d field +! +! fptr is esmf pointer (i,j,k) to 3d field, set by this subroutine + real(ESMF_KIND_R8),pointer :: fptr(:,:,:) + real(r8),allocatable :: ftmp(:,:,:,:) ! esmf bounds, plus nf + + if (nf > mxf) then + write(iulog,"('>>> esmf_set3d_geo: nf cannot be greater than mxf: nf=',i4,' mxf=',i4)") & + nf,mxf + call endrun('edyn_esmf_set3d_geo: nf > mxf') + endif + ! + ! This routine is called every timestep from dynamo_inputs for 8 fields, + ! and is called once per run for a single field from geo2mag_3d + ! (called by define_phim3d, which is called from rdsource.F). + ! + +! +! Get array bounds: + call ESMF_FieldGet(fields(1),localDe=0,farrayPtr=fptr, & + computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"('>>> esmf_set3d_geo: error from ESMF_FieldGet: rc=',i4)") rc + call endrun('edyn_esmf_set3d_geo: ESMF_FieldGet field 1') + endif +! +! Do the allocation: + allocate(ftmp(lbnd(1):ubnd(1),lbnd(2):ubnd(2),lbnd(3):ubnd(3),mxf),stat=istat) + if (istat /= 0) then + write(iulog,"('>>> esmf_set3d_geo: error allocating ftmp')") + call endrun('edyn_esmf_set3d_geo: allocating ftmp') + endif +! +! Fields loop: + do n=1,nf + ftmp(:,:,:,n) = 0._r8 +! +! Set interior latitudes (ftmp(i,j,k,n) <- f(k,i,j,n)) +! ftmp excludes periodic points. +! + do j=lbnd(2),ubnd(2) ! lat + if (j /= jspole .and. j /= jnpole) then ! interior latitudes (not poles) + do i=lbnd(1),ubnd(1) ! lon + ii = i + do k=lbnd(3),ubnd(3) ! lev + ftmp(i,j,k,n) = f(k,ii,j,n) + enddo ! lev + enddo ! lon + endif ! poles or interior + enddo ! lat + enddo ! n=1,nf +! +! Get and set pointer to the field: + do n=1,nf + call ESMF_FieldGet(fields(n),localDe=0,farrayPtr=fptr, & + computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"(a,i4)") '>>> esmf_set3d_geo: error from ESMF_FieldGet: rc=',rc + call endrun('edyn_esmf_set3d_geo: ESMF_FieldGet field') + endif + fptr(:,:,:) = ftmp(:,:,:,n) + enddo ! n=1,nf + + deallocate(ftmp) + + end subroutine edyn_esmf_set3d_geo +!----------------------------------------------------------------------- + subroutine edyn_esmf_set2d_geo(field,grid,fname,f,ilon0,ilon1,ilat0,ilat1) +! +! Set values of a 2d ESMF field on geographic source grid, prior to +! geographic to magnetic grid transformation. (Essentially the same +! as esmf_set3d_geo, except for 2d fields instead of 3d) +! Periodic points are excluded, geographic poles are at j==jspole and jnpole +! +! Args: + type(ESMF_Field) ,intent(in) :: field + type(ESMF_Grid) ,intent(in) :: grid + character(len=*) ,intent(in) :: fname ! field name + integer ,intent(in) :: ilon0,ilon1,ilat0,ilat1 + real(r8) ,intent(in) :: f(ilon0:ilon1,ilat0:ilat1) +! +! Local: + integer :: i,ii,j,rc + real(ESMF_KIND_R8),pointer :: fptr(:,:) ! i,j + integer :: lbnd(2),ubnd(2) +! +! Get pointer to the field: + call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr,& + computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"(a,i4)") '>>> esmf_set2d_geo: error from ESMF_FieldGet: rc=',rc + call endrun('edyn_esmf_set2d_geo: ESMF_FieldGet') + endif +! + fptr(:,:) = 0._r8 ! init +! +! Set interior latitudes (excluding poles): + do j=lbnd(2),ubnd(2) + if (j /= jspole .and. j /= jnpole) then + do i=lbnd(1),ubnd(1) + ii = i + fptr(i,j) = f(ii,j) + enddo + endif ! interior latitudes only + enddo + + if (debug) & + write(iulog,"('esmf_set2d_geo field ',a,': lon bnds=',2i4, & + ' lat bnds=',2i4,' 2d mnmx=',2e12.4)") & + fname,lbnd(1),ubnd(1),lbnd(2),ubnd(2), & + minval(fptr(:,:)),maxval(fptr(:,:)) + + end subroutine edyn_esmf_set2d_geo +!----------------------------------------------------------------------- + subroutine edyn_esmf_set3d_mag(fields,fnames,f,nf,ilev0,ilev1,ilon0,ilon1,ilat0,ilat1) +! +! Set values of a 3d ESMF field on magnetic grid, prior to magnetic to +! geographic grid transformation. +! +! Args: + integer,intent(in) :: nf + type(ESMF_Field) ,intent(in) :: fields(nf) ! esmf fields on mag grid + character(len=*) ,intent(in) :: fnames(nf) ! field names +! +! f is input data on model subdomains: +! + integer,intent(in) :: ilev0,ilev1,ilon0,ilon1,ilat0,ilat1 + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,ilev0:ilev1,nf) +! +! Local: + integer :: i,j,k,rc,n,istat + integer :: ncalls=0,lbnd(3),ubnd(3) ! lower,upper bounds of 3d field +! +! fptr is esmf pointer (i,j,k) to 3d field, set by this subroutine + real(ESMF_KIND_R8),pointer :: fptr(:,:,:) +! +! Fields loop: + do n=1,nf + call ESMF_FieldGet(fields(n),localDe=0,farrayPtr=fptr,& + computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"(a,i4)") '>>> esmf_set2d_mag: error from ESMF_FieldGet: rc=',rc + call endrun('edyn_esmf_set2d_mag: ESMF_FieldGet') + endif +! + fptr(:,:,:) = 0._r8 +! +! Set ESMF pointer: +! + do j=lbnd(2),ubnd(2) ! lat + do i=lbnd(1),ubnd(1) ! lon + do k=lbnd(3),ubnd(3) ! lev + fptr(i,j,k) = f(i,j,k,n) + enddo ! mlev + enddo ! mlon + enddo ! mlat + enddo ! n=1,nf + end subroutine edyn_esmf_set3d_mag +!----------------------------------------------------------------------- + subroutine edyn_esmf_get_3dfield(field, fptr, name) +! +! Get pointer to 3d esmf field (i,j,k): +! +! Args: + type(ESMF_field),intent(in) :: field + real(r8),pointer,dimension(:,:,:),intent(out) :: fptr + character(len=*),intent(in) :: name +! +! Local: + integer :: rc,k,lbnd(3),ubnd(3) + character(len=80) :: errmsg + + call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr, & + computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(errmsg,"('esmf_get_field 3d field ',a)") trim(name) + call endrun('edyn_esmf_get_3dfield: ESMF_FieldGet') + endif + end subroutine edyn_esmf_get_3dfield +!----------------------------------------------------------------------- + subroutine edyn_esmf_get_2dfield(field, fptr, name) +! +! Get pointer to 2d esmf field (i,j): +! +! Args: + type(ESMF_field),intent(in) :: field + real(r8),pointer,dimension(:,:),intent(out) :: fptr + character(len=*),intent(in) :: name +! +! Local: + integer :: rc + character(len=80) :: errmsg + + call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(errmsg,"('edyn_esmf_get_2dfield ',a)") trim(name) + call endrun('edyn_esmf_get_2dfield: ESMF_FieldGet') + endif + + edyn_esmf_update_step = .false. + + end subroutine edyn_esmf_get_2dfield +!----------------------------------------------------------------------- + subroutine edyn_esmf_regrid(srcfield,dstfield,direction,ndim) +! +! Args: + integer :: ndim + type(ESMF_Field),intent(inout) :: srcfield,dstfield + character(len=*),intent(in) :: direction +! +! Local: + integer :: rc + type(ESMF_RouteHandle) :: routehandle +! +! Direction is either geo2mag or mag2geo. +! Use corresponding route handle (module data) +! + select case(trim(direction)) + case ('geo2mag') + routehandle = routehandle_geo2mag + if (ndim==2) then +! +! Do sparse matrix multiply for 2d geo2mag. +! + routehandle = routehandle_geo2mag_2d + call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,rc=rc) + + if (rc /= ESMF_SUCCESS) then + write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& + 'ESMF_FieldSMM for 2d ',trim(direction),': rc=',rc + call endrun('edyn_esmf_regrid: ESMF_FieldSMM 2d') + endif + else ! 3d geo2mag +! +! Do sparse matrix multiply for 3d geo2mag. +! + routehandle = routehandle_geo2mag + call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& + 'ESMF_FieldSMM for 3d ',trim(direction),': rc=',rc + call endrun('edyn_esmf_regrid: ESMF_FieldSMM 3d') + endif + endif +! +! Do sparse matrix multiply for 3d mag2geo. +! btf 6/18/14: mag2geo is not working due to error return rc=51 from the +! below call. Calls to mag2geo_3d at end of sub pefield (edynamo.F90) +! are commented out (mag2geo_3d calls this routine with direction='mag2geo'). +! + case ('mag2geo') + routehandle = routehandle_mag2geo + call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,rc=rc) + if (rc /= ESMF_SUCCESS) then + write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& + 'ESMF_FieldSMM for 3d ',trim(direction),': rc=',rc + call endrun('edyn_esmf_regrid: ESMF_FieldSMM magtogeo') + endif + case default + write(iulog,"('>>> edyn_esmf_regrid: bad direction=',a)") trim(direction) + call endrun + end select + end subroutine edyn_esmf_regrid +!----------------------------------------------------------------------- + +#endif +end module edyn_esmf diff --git a/src/ionosphere/waccmx/edyn_geogrid.F90 b/src/ionosphere/waccmx/edyn_geogrid.F90 new file mode 100644 index 0000000000..cacff0d7e8 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_geogrid.F90 @@ -0,0 +1,73 @@ +module edyn_geogrid +! +! Global geographic grid. +! See sub set_geogrid (edyn_init.F90) +! + use shr_kind_mod, only : r8 => shr_kind_r8 ! 8-byte reals + implicit none + save + + integer :: & ! dimensions + nlat, & ! number of latitudes + nlon, & ! number of longitudes + nlev, & ! number of midpoint levels + nilev, & ! number of interface latitudes + ntime ! number of times on input file + + real(r8),allocatable,dimension(:) :: & ! coordinate vars + glat, & ! latitude coordinates (degrees) + glon, & ! longitude coordinates (degrees) + ylatg, & ! latitudes (radians) + ylong, & ! longitudes (radians) + zlev, & ! midpoint vertical coordinates + zilev, & ! interface vertical coordinates + time ! times (histories) on input file + + real(r8),allocatable,dimension(:) :: & + cs, & ! cos(phi) (0:nlat+1) + zp, & ! log pressure (as in tiegcm lev(nlev)) + expz ! exp(-zp) + + integer :: & ! model independent (set by sub get_geogrid) + nlonp1, & ! nlon+1 + nlonp2, & ! nlon+2 + nlatp1 ! nlat+1 + + real(r8) :: dlatg,dlong + real(r8) :: dphi,dlamda +! +! Using p0 in microbars, as in TIEGCM. + real(r8),parameter :: p0 = 5.0e-4_r8 ! standard pressure (microbars) + + integer :: & ! model dependent (set by subs read_tgcm, read_waccm) + jspole, & ! latitude index to geographic south pole + jnpole ! latitude index to geographic north pole +! +! lev_sequence is a string indicating ordering of the vertical +! coordinates lev and ilev, and of the field arrays along the +! vertical dimension. lev_sequence can have 1 of 2 values: +! +! 'bottom2top' means lev(1) is the bottom boundary, lev(nlev) is the top boundary +! 'top2bottom' means lev(1) is the top boundary, lev(nlev) is the bottom boundary +! +! For example, TIMEGCM history files are bottom2top, whereas +! WACCM files are top2bottom. The edynamo code assumes bottom2top, +! so WACCM input fields are reversed to be bottom2top for the edynamo +! calculations, then reversed back to the native WACCM sequence +! (top2bottom) before writing to the edynamo output file. +! + character(len=10) :: lev_sequence +! +! lon_sequence is a string indicating ordering of the longitude +! coordinate lon, and of the field arrays along this dimension. +! lon_sequece can have 1 of 2 values: +! +! '-180to180' means lon(1) is -180 deg west longitude, lon(nlon) is +180 east +! 'zeroto360' means lon(1) is 0 deg west longitude, lon(nlon) is 360 deg east +! +! Note that TIMEGCM convention is '-180to180' and WACCM convention is 'zeroto360' +! (this is treating similarly to lev_sequence above) +! + character(len=9) :: lon_sequence + +end module edyn_geogrid diff --git a/src/ionosphere/waccmx/edyn_init.F90 b/src/ionosphere/waccmx/edyn_init.F90 new file mode 100644 index 0000000000..c7ea23dd21 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_init.F90 @@ -0,0 +1,394 @@ + module edyn_init +! +! Initialize edynamo +! + use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals + use shr_const_mod, only: pi => shr_const_pi + use cam_logfile ,only: iulog + use cam_abortutils ,only: endrun + use spmd_utils, only: masterproc + use infnan, only: nan, assignment(=) + + use edyn_geogrid ,only: nlon,nlat,nlev,nilev,glon,glat,zlev,zilev,& + nlonp1,nlonp2,nlatp1,jspole,jnpole,dlatg,dlong,& + ylatg,ylong,dphi,dlamda,cs,expz,zp + use mag_parms, only: highlat_potential_model + use edyn_params ,only: edyn_params_init, kbotdyn, pbotdyn + + implicit none + + private + public :: edynamo_init, lonshift_global + + logical :: debug=.false. ! set true for prints to stdout at each call + + contains +!----------------------------------------------------------------------- + subroutine edynamo_init(mpicomm, nlon_in,nlat_in,nlev_in, lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj, & + glon_in, glat_in, pres_in, pres_edge_in) +! +! One-time initialization, called from inital.F90 after dyn_init and initcom. +! + use edyn_maggrid ,only: set_maggrid + use edyn_mpi ,only: mp_init,mp_distribute_geo,mp_distribute_mag,& + mp_exchange_tasks +#ifdef WACCMX_EDYN_ESMF + use edynamo ,only: alloc_edyn + use edyn_esmf ,only: edyn_esmf_init ! initialize ESMF +#endif +! +! Args: + integer, intent(in) :: mpicomm + integer, intent(in) :: nlon_in,nlat_in,nlev_in + integer, intent(in) :: lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj + real(r8),intent(in) :: glon_in(:), glat_in(:) + real(r8),intent(in) :: pres_in(:), pres_edge_in(:) + + if (masterproc) then + write(iulog,"('Enter edynamo_init:')") + write(iulog,"(' highlat_potential_model = ',a)") trim(highlat_potential_model) + endif + + call mp_init(mpicomm) ! get ntask,mytid + call edyn_params_init() + call set_geogrid(nlon_in,nlat_in,nlev_in, glon_in, glat_in, pres_in, pres_edge_in) ! set global geographic grid + call set_maggrid () ! set parameter-based global magnetic grid + + call mp_distribute_geo(lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj) + call mp_distribute_mag + call register_maggrid + call mp_exchange_tasks(0) ! single arg is iprint + +#ifdef WACCMX_EDYN_ESMF + call alloc_edyn ! allocate dynamo arrays + call edyn_esmf_init(mpicomm) ! initialize ESMF +#endif + call add_fields ! add fields to WACCM history master list + + end subroutine edynamo_init +!----------------------------------------------------------------------- + subroutine set_geogrid( nlon_in,nlat_in,nlev_in, glon_in, glat_in, pres_in, pres_edge_in ) + + ! Args + integer, intent(in) :: nlon_in,nlat_in,nlev_in + real(r8),intent(in) :: glon_in(:), glat_in(:) + real(r8),intent(in) :: pres_in(:), pres_edge_in(:) +! +! Local: + integer :: i,j,js, k + real(r8) :: real8,phi + real(r8),parameter :: eps = 1.e-6_r8 + + real(r8) :: pmid(nlev_in) + + nlon = nlon_in + nlat = nlat_in + nlev = nlev_in + + nilev = nlev+1 + + nlonp1 = nlon+1 + nlonp2 = nlon+2 + nlatp1 = nlat+1 + + jspole = 1 + jnpole = nlat + + dphi = pi/dble(nlat) + dlamda = 2._r8*pi/dble(nlon) + +! +! Allocate coordinate variables: +! + allocate(glon(nlon)) + glon(:nlon) = glon_in(:nlon) + + allocate(glat(nlat)) + glat(:nlat) = glat_in(:nlat) + + allocate(zlev(nlev)) + allocate(zilev(nilev)) +! +! zp and expz are not set until oplus is called from dpie_coupling. + allocate(zp(nlev)) ! log pressure (as in TIEGCM) + allocate(expz(nlev)) ! exp(-zp) + zp = nan + expz = nan +! +! + call lonshift_global(glon,nlon,'-180to180',.true.) ! shift to +/-180 +! +! Hybrid-sigma levels from ref_pres module: +! + zlev(:nlev) = pres_in(:) ! midpoints vertical coord (top down) + zilev(:nilev) = pres_edge_in(:nilev) ! interfaces vertical coord + + ! do bottom up search for kbotdyn + pmid(:nlev) = zlev(nlev:1:-1) + kloop: do k=1,nlev + if ( pmid(k) <= pbotdyn) then + kbotdyn = k + exit kloop + end if + enddo kloop + if ( kbotdyn < 1 ) then + call endrun('set_geogrid: kbotdyn is not set') + endif + if (debug) then + write(iulog,"('set_geogrid: kbotdyn=',i4,' pmid(kbotdyn)=',es12.4)") kbotdyn,pmid(kbotdyn) + endif + +! +! Set horizontal geographic grid in radians (for apex code): +! + allocate(ylatg(nlat)) ! waccm grid includes poles + allocate(ylong(nlonp1)) ! single periodic point + real8 = dble(nlat) ; dlatg = pi/real8 + real8 = dble(nlon) ; dlong = 2._r8*pi/real8 + ylatg(1) = -pi/2._r8+eps ! south pole + ylatg(nlat) = pi/2._r8-eps ! north pole + do j=2,nlat-1 + real8 = dble(j-1) + ylatg(j) = -0.5_r8*(pi-dlatg)+real8*dlatg + enddo + do i=1,nlonp1 + real8 = dble(i-1) + ylong(i) = -pi+real8*dlong + enddo +! +! Calculate cosine of latitude +! + allocate(cs(0:nlat+1)) + js = -(nlat/2) + do j=1,nlat + phi = (j+js-.5_r8)*dphi + cs(j) = cos(phi) + enddo + cs(0) = -cs(1) + cs(nlat+1) = -cs(nlat) + + end subroutine set_geogrid +!----------------------------------------------------------------------- + subroutine lonshift_global(f,nlon,lonseq,iscoord) +! +! Shift longitude vector f(nlon) forward 180 degrees according to input +! string lonseq. Input f can be either arbitrary field values or +! the coordinate array itself. Shift f in the 'lonseq' manner, as follows: +! +! If lonseq='-180to180', then shift from 0->360 to -180->+180 +! If lonseq='zeroto360', then shift from -180->+180 to 0->360 +! +! WARNING: This routine works with WACCM-X history files, where nlon=144, 72, or 80 +! It has not been tested with other models or resolutions. +! (e.g., there is no test for center point, its assumed to be nlon/2) +! +! Args: + integer,intent(in) :: nlon + real(r8),intent(inout) :: f(nlon) + character(len=*),intent(in) :: lonseq + logical,intent(in) :: iscoord ! if true, f is a coordinate, otherwise it is data +! +! Local: + character(len=80) :: msg + integer :: ihalf,i + + if (lonseq /= '-180to180'.and.lonseq /= 'zeroto360') then + write(msg,"('shift_lon: bad lonseq=',a,' must be either ''-180to180'' or ''zeroto360''')") & + lonseq + call endrun + endif + + ihalf = nlon/2 + if (lonseq == '-180to180') then ! shift to -180 -> +180 + f = cshift(f,ihalf) ! cshift is circular shift intrinsic + if (iscoord) then + do i=1,ihalf + f(i) = f(i)-360._r8 + enddo + endif + else ! shift to 0 -> 360 + f = cshift(f,ihalf) ! cshift is circular shift intrinsic + if (iscoord) then + do i=ihalf+1,nlon + f(i) = f(i)+360._r8 + enddo + endif + endif + end subroutine lonshift_global +!----------------------------------------------------------------------- + subroutine add_fields + use cam_history, only: addfld, horiz_only, add_default + use phys_control, only: phys_getopts !Method used to get flag for waccmx ionosphere output variables + + logical :: history_waccmx + +! Geomagnetic fields are in waccm format, in CGS units): + call addfld ('PED_MAG' ,(/ 'lev' /), 'I', 'S/m ','Pedersen Conductivity' ,gridname='gmag_grid') + call addfld ('HAL_MAG' ,(/ 'lev' /), 'I', 'S/m ','Hall Conductivity' ,gridname='gmag_grid') + call addfld ('ZMAG' ,(/ 'lev' /), 'I', 'cm ','ZMAG: Geopotential' ,gridname='gmag_grid') + call addfld ('PHIM2D' , horiz_only, 'I', 'VOLTS','PHIM2D: Electric Potential' ,gridname='gmag_grid') + call addfld ('ED1' , horiz_only, 'I', 'V/m ','ED1: Eastward Electric Field' ,gridname='gmag_grid') + call addfld ('ED2' , horiz_only, 'I', 'V/m ','ED2: Equatorward Electric Field' ,gridname='gmag_grid') + call addfld ('PHIM3D' ,(/ 'lev' /), 'I', 'VOLTS','PHIM3D: 3d Electric Potential' ,gridname='gmag_grid') + + call addfld ('EPHI3D' ,(/ 'lev' /), 'I', ' ','EPHI3D' ,gridname='gmag_grid') + call addfld ('ELAM3D' ,(/ 'lev' /), 'I', ' ','ELAM3D' ,gridname='gmag_grid') + call addfld ('EMZ3D' ,(/ 'lev' /), 'I', ' ','EMZ3D' ,gridname='gmag_grid') + + call addfld ('ED13D' ,(/ 'lev' /), 'I', 'V/m ','ED13D: Eastward Electric Field' ,gridname='gmag_grid') + call addfld ('ED23D' ,(/ 'lev' /), 'I', 'V/m ','ED23D: Equatorward Electric Field',gridname='gmag_grid') + call addfld ('ZPOT_MAG' ,(/ 'lev' /), 'I', 'cm ','Geopotential on mag grid (h0 min)',gridname='gmag_grid') + call addfld ('ADOTV1_MAG',(/ 'lev' /), 'I', ' ','ADOTV1 on mag grid' ,gridname='gmag_grid') + call addfld ('ADOTV2_MAG',(/ 'lev' /), 'I', ' ','ADOTV2 on mag grid' ,gridname='gmag_grid') + +! +! Dynamo inputs from sub dynamo_input (edynamo.F90): + call addfld ('EDYN_TN ',(/ 'lev' /), 'I', 'deg K ','EDYN_TN' , gridname='fv_centers') + call addfld ('EDYN_UN ',(/ 'lev' /), 'I', 'cm/s ','EDYN_UN' , gridname='fv_centers') + call addfld ('EDYN_VN ',(/ 'lev' /), 'I', 'cm/s ','EDYN_VN' , gridname='fv_centers') + call addfld ('EDYN_OMG ',(/ 'lev' /), 'I', 's-1 ','EDYN_OMG' , gridname='fv_centers') + call addfld ('EDYN_Z ',(/ 'lev' /), 'I', 'cm ','EDYN_ZHT' , gridname='fv_centers') + call addfld ('EDYN_BARM ',(/ 'lev' /), 'I', ' ','EDYN_MBAR' , gridname='fv_centers') + call addfld ('EDYN_PED ',(/ 'lev' /), 'I', 'S/m ','EDYN_PED' , gridname='fv_centers') + call addfld ('EDYN_HALL ',(/ 'lev' /), 'I', 'S/m ','EDYN_HALL' , gridname='fv_centers') + +! call addfld ('EDYN_SCHT ',(/ 'lev' /), 'I', ' ','EDYN_SCHT ' , gridname='fv_centers') + call addfld ('EDYN_WN ',(/ 'lev' /), 'I', 'm/s ','EDYN_WN ' , gridname='fv_centers') + call addfld ('EDYN_ADOTV1 ',(/ 'lev' /), 'I', ' ','EDYN_ADOTV1' , gridname='fv_centers') + call addfld ('EDYN_ADOTV2 ',(/ 'lev' /), 'I', ' ','EDYN_ADOTV2' , gridname='fv_centers') +! +! 2d dynamo input fields on geo grid (edynamo.F90): + call addfld ('EDYN_SINI ', horiz_only , 'I', ' ','EDYN_SINI' , gridname='fv_centers') + call addfld ('EDYN_ADOTA1 ', horiz_only , 'I', ' ','EDYN_ADOTA1' , gridname='fv_centers') + call addfld ('EDYN_ADOTA2 ', horiz_only , 'I', ' ','EDYN_ADOTA2' , gridname='fv_centers') + call addfld ('EDYN_A1DTA2 ', horiz_only , 'I', ' ','EDYN_A1DTA2' , gridname='fv_centers') + call addfld ('EDYN_BE3 ', horiz_only , 'I', ' ','EDYN_BE3' , gridname='fv_centers') + + + call addfld ('ADOTA1', horiz_only , 'I', ' ','ADOTA1' , gridname='fv_centers') + call addfld ('ADOTA1_MAG', horiz_only , 'I', ' ','ADOTA1 in geo-mag coords' , gridname='fv_centers') + +! 3d ion drifts and 2d conductances at end of dpie_coupling +! (from either edynamo or time3d): +! +! call addfld ('TIME3D_ZIGM11',horiz_only,'I',' ','TIME3D_ZIGM11',gridname='gmag_grid) +! call addfld ('TIME3D_ZIGM22',horiz_only,'I',' ','TIME3D_ZIGM22',gridname='gmag_grid) +! call addfld ('TIME3D_ZIGMC' ,horiz_only,'I',' ','TIME3D_ZIGMC' ,gridname='gmag_grid) +! call addfld ('TIME3D_ZIGM2' ,horiz_only,'I',' ','TIME3D_ZIGM2' ,gridname='gmag_grid) +! call addfld ('TIME3D_RIM1' ,horiz_only,'I',' ','TIME3D_RIM1' ,gridname='gmag_grid) +! call addfld ('TIME3D_RIM2' ,horiz_only,'I',' ','TIME3D_RIM2' ,gridname='gmag_grid) + +! call addfld ('TIME3D_UI',(/ 'lev' /),'I',' ','TIME3D_UI') +! call addfld ('TIME3D_VI',(/ 'lev' /),'I',' ','TIME3D_VI') +! call addfld ('TIME3D_WI',(/ 'lev' /),'I',' ','TIME3D_WI') + +! call addfld ('T3D_OP_2WACCM',(/ 'lev' /),'I',' ','T3D_OP_2WACCM') +! call addfld ('DPIE_OP',(/ 'lev' /),'I',' ','DPIE_OP') ! this is also below + + call addfld ('QEP',(/ 'lev' /), 'I', 'm^3/s' ,'Photo-Electron Production', gridname='fv_centers') + call addfld ('QOP',(/ 'lev' /), 'I', 'm^3/s' ,'O+ Production Rate' , gridname='fv_centers') + call addfld ('OpO2',(/ 'lev' /), 'I', 'cm^3/s' ,'Op+O2 Loss Rate' , gridname='fv_centers') + call addfld ('OpN2',(/ 'lev' /), 'I', 'cm^3/s' ,'Op+N2 Loss Rate' , gridname='fv_centers') + call addfld ('LOP',(/ 'lev' /), 'I', 'cm^3/s' ,'O+ Loss Rate' , gridname='fv_centers') + call addfld ('SIGMA_PED' ,(/ 'lev' /), 'I', ' ','Pederson Conductivity' , gridname='fv_centers') + call addfld ('SIGMA_HALL',(/ 'lev' /), 'I', ' ','Hall Conductivity' , gridname='fv_centers') + + call addfld ('adota1_mag_a', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') + call addfld ('ZIGM11_a', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') + call addfld ('EDYN_ZIGM11_0', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') + call addfld ('EDYN_ZIGM11', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') + call addfld ('EDYN_ZIGM11_PED', horiz_only, 'I', 'S','Pedersen Conductance',gridname='gmag_grid') + call addfld ('EDYN_ZIGM22', horiz_only, 'I', ' ','EDYN_ZIGM22',gridname='gmag_grid') + call addfld ('EDYN_ZIGMC' , horiz_only, 'I', ' ','EDYN_ZIGMC' ,gridname='gmag_grid') + call addfld ('EDYN_ZIGM2' , horiz_only, 'I', ' ','EDYN_ZIGM2' ,gridname='gmag_grid') + call addfld ('EDYN_ZIGM2_HAL' , horiz_only, 'I', 'S','Hall Conductance' ,gridname='gmag_grid') + call addfld ('EDYN_RIM1' , horiz_only, 'I', ' ','EDYN_RIM1' ,gridname='gmag_grid') + call addfld ('EDYN_RIM2' , horiz_only, 'I', ' ','EDYN_RIM2' ,gridname='gmag_grid') + + call addfld ('EDYN_UI',(/ 'lev' /), 'I', 'cm/s','EDYN_UI', gridname='fv_centers') + call addfld ('EDYN_VI',(/ 'lev' /), 'I', 'cm/s','EDYN_VI', gridname='fv_centers') + call addfld ('EDYN_WI',(/ 'lev' /), 'I', 'cm/s','EDYN_WI', gridname='fv_centers') + + call addfld ('POTEN' ,(/ 'lev' /), 'I', 'Volts','POTEN: Electric Potential',& + gridname='fv_centers') + call addfld ('EX' ,(/ 'lev' /), 'I', 'V/m' ,'EX: Zonal component of Electric Field',& + gridname='fv_centers') + call addfld ('EY' ,(/ 'lev' /), 'I', 'V/m' ,'EY: Meridional component of Electric Field',& + gridname='fv_centers') + call addfld ('EZ' ,(/ 'lev' /), 'I', 'V/m' ,'EZ: Vertical component of Electric Field',& + gridname='fv_centers') + + call addfld ('ZEDYN360 ' ,(/ 'lev' /), 'I', 'm ','Geopotential 0 to 360 lon grid', gridname='fv_centers') + call addfld ('ZEDYN180 ',(/ 'lev' /), 'I', 'm ','Geopotential -180 to 180 lon grid', gridname='fv_centers') + + call addfld ('BMOD' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('XB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('YB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('ZB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') + + call addfld ('RJAC11' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('RJAC12' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('RJAC21' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') + call addfld ('RJAC22' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') + + !------------------------------------------------------------------------------- + ! Set default values for ionosphere history variables + !------------------------------------------------------------------------------- + call phys_getopts(history_waccmx_out=history_waccmx) + + if (history_waccmx) then + call add_default ('EDYN_ZIGM11_PED' , 1, ' ') + call add_default ('EDYN_ZIGM2_HAL' , 1, ' ') + end if + + end subroutine add_fields +!----------------------------------------------------------------------- + + subroutine register_maggrid + + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap, cam_grid_register + use edyn_mpi, only: mlat0,mlat1,mlon0,omlon1 + use edyn_maggrid, only: gmlat, gmlon, nmlat, nmlon + integer, parameter :: mag_decomp = 111 !arbitrary value + + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: coord_map(:) + integer :: i,j,ind + + allocate(grid_map(4, ((omlon1 - mlon0 + 1) * (mlat1 - mlat0 + 1)))) + ind = 0 + do i = mlat0, mlat1 + do j = mlon0, omlon1 + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + + allocate(coord_map(mlat1 - mlat0 + 1)) + coord_map = (/ (i, i = mlat0, mlat1) /) + lat_coord => horiz_coord_create('mlat', '', nmlat, 'latitude', & + 'degrees_north', mlat0, mlat1, gmlat(mlat0:mlat1), & + map=coord_map) + nullify(coord_map) + + allocate(coord_map(omlon1 - mlon0 + 1)) + coord_map = (/ (i, i = mlon0, omlon1) /) + lon_coord => horiz_coord_create('mlon', '', nmlon, 'longitude', & + 'degrees_east', mlon0, omlon1, gmlon(mlon0:omlon1), & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + + call cam_grid_register('gmag_grid', mag_decomp, lat_coord, lon_coord, & + grid_map, unstruct=.false.) + nullify(grid_map) + + end subroutine register_maggrid + +!----------------------------------------------------------------------- +end module edyn_init diff --git a/src/ionosphere/waccmx/edyn_maggrid.F90 b/src/ionosphere/waccmx/edyn_maggrid.F90 new file mode 100644 index 0000000000..7699db4897 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_maggrid.F90 @@ -0,0 +1,150 @@ +module edyn_maggrid + use shr_kind_mod, only : r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile, only: iulog + implicit none + save + +! +! Global geomagnetic grid: +! + integer, parameter :: & + nmlat = 97, & ! number of mag latitudes + nmlath = (nmlat+1)/2, & ! index of magnetic equator + nmlon = 80, & ! number of mag longitudes + nmlonp1 = nmlon+1 ! number of longitudes plus periodic point +! +! Mag grid coordinates: +! + real(r8) :: & + ylatm(nmlat), & ! magnetic latitudes (radians) + ylonm(nmlonp1), & ! magnetic longitudes (radians) + gmlat(nmlat), & ! magnetic latitudes (degrees) + gmlon(nmlonp1), & ! magnetic longitudes (degrees) + dlonm,dlatm +! +! Level coordinates will be same as geographic levels: +! + integer :: nmlev ! number of levels (same as nlev in geographic) + + real(r8) :: & + rcos0s(nmlat), & ! cos(theta0)/cos(thetas) + dt0dts(nmlat), & ! d(theta0)/d(thetas) + dt1dts(nmlat) ! dt0dts/abs(sinim) (non-zero at equator) + + real(r8) :: table(91,2) + + logical :: debug=.false. ! set true for prints to stdout at each call + + contains +!----------------------------------------------------------------------- + subroutine set_maggrid + use edyn_params ,only: pi,pi_dyn,rtd,r0 + use edyn_geogrid,only: nlev,zlev +! +! Local: + integer :: i,j,k,n + real(r8) :: tanths2,dtheta,real8 + real(r8) :: & + tanth0(nmlat), & + tanths(nmlat), & + theta0(nmlat), & + hamh0(nmlat) + + real(r8),parameter :: & + e=1.e-6_r8, & + r1=1.06e7_r8, & + alfa=1.668_r8 + + real(r8) :: table2(91,3:5) + + real8 = dble(nmlat-1) + dlatm = pi_dyn/real8 + real8 = dble(nmlon) + dlonm = 2._r8*pi_dyn/real8 +! +! ylatm is equally spaced in theta0, but holds corresponding value of thetas. +! + do j=1,nmlat + real8 = dble(j-1) + theta0(j) = -pi_dyn/2._r8+real8*dlatm ! note use of pi_dyn + enddo ! j=1,nmlat + do j=2,nmlat-1 + tanth0(j) = abs(tan(theta0(j))) + hamh0(j) = r1*tanth0(j)+r0*tanth0(j)**(2._r8+2._r8*alfa)/ & + (1._r8+tanth0(j)**2)**alfa + tanths(j) = sqrt(hamh0(j)/r0) + ylatm(j) = sign(atan(tanths(j)),theta0(j)) + rcos0s(j) = sqrt((1._r8+tanths(j)**2)/(1._r8+tanth0(j)**2)) +! +! Timegcm has an alternate calculation for dt1dts and dt0dts if dynamo +! is not called. +! + tanths2 = tanths(j)**2 + dt1dts(j) = & + (r0*sqrt(1._r8+4._r8*tanths2)*(1._r8+tanths2))/ & + (r1*(1._r8+tanth0(j)**2)+2._r8*r0*tanth0(j)**(2._r8*alfa+1._r8)* & + (1._r8+alfa+tanth0(j)**2)/(1._r8+tanth0(j)**2)**alfa) + dt0dts(j) = dt1dts(j)*2._r8*tanths(j)/sqrt(1._r8+4._r8*tanths2) + enddo ! j=2,nmlat-1 +! +! Magnetic poles: +! + ylatm(1) = theta0(1) + ylatm(nmlat) = theta0(nmlat) + rcos0s(1) = 1._r8 + rcos0s(nmlat) = 1._r8 + dt0dts(1) = 1._r8 + dt0dts(nmlat) = 1._r8 +! +! Magnetic longitudes: +! + do i=1,nmlonp1 + real8 = dble(i-1) + ylonm(i) = -pi+real8*dlonm +! ylonm(i) = real8*dlonm + enddo ! i=1,nmlonp1 +! +! Define mag grid in degrees, and mag levels: +! + gmlat(:) = ylatm(:)*rtd + gmlon(:) = ylonm(:)*rtd +! +! Magnetic levels are same as midpoint geographic levels: +! + nmlev = nlev + +! +! Calculate table: +! + table(1,1) = 0._r8 + table(1,2) = 0._r8 + dtheta = pi/180._r8 + do i=2,91 + table(i,1) = table(i-1,1)+dtheta + enddo + do i=2,90 + table2(i,4) = tan(table(i,1)) + table(i,2) = table(i,1) + enddo ! i=2,90 + table(91,2) = table(91,1) + do n=1,7 + do i=2,90 + table2(i,3) = table(i,2) + table(i,2) = tan(table2(i,3)) + table2(i,5) = sqrt(r1/r0*table(i,2)+table(i,2)**(2._r8*(1._r8+alfa))/ & + (1._r8+table(i,2)**2)**alfa) + table(i,2) = table2(i,3)-(table2(i,5)-table2(i,4))*2._r8* & + table2(i,5)/(r1/r0*(1._r8+table(i,2)**2)+2._r8*table(i,2)** & + (2._r8*alfa+1._r8)*(1._r8+alfa+table(i,2)**2)/ & + (1._r8+table(i,2)**2)**alfa) + enddo ! i=2,90 + enddo ! n=1,7 + + if (debug) then + write(iulog,"('set_maggrid: table= ',/,(6e12.4))") table + write(iulog,"('set_maggrid: table2=',/,(6e12.4))") table2 + endif + + end subroutine set_maggrid +!----------------------------------------------------------------------- +end module edyn_maggrid diff --git a/src/ionosphere/waccmx/edyn_mpi.F90 b/src/ionosphere/waccmx/edyn_mpi.F90 new file mode 100644 index 0000000000..ad0db875c6 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_mpi.F90 @@ -0,0 +1,2081 @@ +module edyn_mpi + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_logfile ,only: iulog + use cam_abortutils,only: endrun + + use edyn_geogrid ,only: nlon,nlat + use edyn_maggrid ,only: nmlonp1,nmlat,nmlath,nmlev ! note nmlev is not a parameter + use spmd_utils ,only: masterproc + use mpi ,only: mpi_comm_size, mpi_comm_rank, MPI_PROC_NULL, mpi_comm_split, & + MPI_INTEGER, MPI_STATUS_SIZE, mpi_wait, & + MPI_REAL8, MPI_SUCCESS, MPI_SUM, & + MPI_Comm_rank + + implicit none + private + + public :: array_ptr_type,switch_model_format,mp_geo_halos,mp_pole_halos,mlon0,mlon1,omlon1, & + mlat0,mlat1,mlev0,mlev1,mytid,lon0,lon1,lat0,lat1,lev0,lev1,mp_mag_halos,mp_scatter_phim, & + mp_mageq,mp_mageq_jpm1,mp_magpole_2d,mp_mag_foldhem,mp_mag_periodic_f2d,mp_gather_edyn, & + mp_mageq_jpm3,mp_mag_jslot,mp_magpoles,ixfind,mp_magpole_3d,ntask,ntaski,ntaskj,tasks, & + nmagtaski,nmagtaskj,setpoles, mp_gatherlons_f3d, mytidi, mp_scatterlons_f3d, mp_exchange_tasks, & + mp_distribute_mag, mp_distribute_geo, mp_init + + + +! +! Number of MPI tasks and current task id (geo or mag): +! + integer :: & + ntask, & ! number of mpi tasks + mytid ! my task id +! +! Geographic subdomains for current task: +! + integer :: & + ntaski, & ! number of tasks in lon dimension + ntaskj, & ! number of tasks in lat dimension + mytidi, & ! i coord for current task in task table + mytidj, & ! j coord for current task in task table + lat0,lat1, & ! first and last lats for each task + lon0,lon1, & ! first and last lons for each task + lev0,lev1, & ! first and last levs for each task (not distributed) + mxlon,mxlat ! max number of subdomain lon,lat points among all tasks +! +! Magnetic subdomains for current task: +! + integer :: & + nmagtaski, & ! number of tasks in mag lon dimension + nmagtaskj, & ! number of tasks in mag lat dimension + magtidi, & ! i coord for current task in task table + magtidj, & ! j coord for current task in task table + mlat0,mlat1, & ! first and last mag lats for each task + mlon0,mlon1, & ! first and last mag lons for each task + omlon1, & ! last mag lons for each task to remove periodic point from outputs + mlev0,mlev1, & ! first and last mag levs (not distributed) + mxmaglon, & ! max number of mag subdomain lon points among all tasks + mxmaglat ! max number of mag subdomain lat points among all tasks + + integer,allocatable,save :: & + itask_table_geo(:,:), & ! 2d table of tasks on geographic grid (i,j) + itask_table_mag(:,:) ! 2d table of tasks on mag grid (i,j) + + integer :: cols_comm ! communicators for each task column + integer :: rows_comm ! communicators for each task row +! +! Task type: subdomain information for all tasks, known by all tasks: +! + type task + integer :: mytid ! task id +! +! Geographic subdomains in task structure: + integer :: mytidi ! task coord in longitude dimension of task table + integer :: mytidj ! task coord in latitude dimension of task table + integer :: nlats ! number of latitudes calculated by this task + integer :: nlons ! number of longitudes calculated by this task + integer :: lat0,lat1 ! first and last latitude indices + integer :: lon0,lon1 ! first and last longitude indices +! +! Magnetic subdomains in task structure: + integer :: magtidi ! task coord in mag longitude dimension of task table + integer :: magtidj ! task coord in mag latitude dimension of task table + integer :: nmaglats ! number of mag latitudes calculated by this task + integer :: nmaglons ! number of mag longitudes calculated by this task + integer :: mlat0,mlat1 ! first and last latitude indices + integer :: mlon0,mlon1 ! first and last longitude indices + end type task +! +! type(task) :: tasks(ntask) will be made available to all tasks +! (so each task has information about all tasks) +! + type(task),allocatable,save :: tasks(:) +! +! Conjugate points in mag subdomains, for mp_mag_foldhem +! + integer,allocatable,dimension(:),save :: & ! (ntask) + nsend_south, & ! number of south lats to send to north (each task) + nrecv_north ! number of north lats to send to south (each task) + integer,allocatable,dimension(:,:),save :: & ! (mxlats,ntask) + send_south_coords, & ! south j lats to send to north + recv_north_coords ! north j lats to recv from south + + type array_ptr_type + real(r8),pointer :: ptr(:,:,:) ! (k,i,j) + end type array_ptr_type + + integer, protected :: mpi_comm_edyn = -9999 + + logical, parameter :: debug = .false. + + contains +!----------------------------------------------------------------------- + subroutine mp_init( mpi_comm ) +! +! Initialize MPI, and allocate task table. +! + integer, intent(in) :: mpi_comm + + integer :: ier + + mpi_comm_edyn = mpi_comm + + call mpi_comm_size(mpi_comm_edyn,ntask,ier) + call mpi_comm_rank(mpi_comm_edyn,mytid,ier) +! +! Allocate array of task structures: +! + allocate(tasks(0:ntask-1),stat=ier) + if (ier /= 0) then + write(iulog,"('>>> mp_init: error allocating tasks(',i3,')')") ntask + call endrun('edyn_mpi mp_init') + endif + end subroutine mp_init +!----------------------------------------------------------------------- + subroutine mp_distribute_geo(lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski_in,ntaskj_in) +! +! Args: + integer, intent(in) :: lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski_in,ntaskj_in +! +! Local: + integer :: i,j,n,irank,ier,tidrow,nj,ni +! +! Define all task structures with current task values +! (redundant for alltoall): +! Use WACCM subdomains: +! + lon0 = lonndx0 ; lon1 = lonndx1 + lat0 = latndx0 ; lat1 = latndx1 + lev0 = levndx0 ; lev1 = levndx1 + + ntaski = ntaski_in + ntaskj = ntaskj_in +! +! Allocate and set 2d table of tasks: +! + allocate(itask_table_geo(-1:ntaski,-1:ntaskj),stat=ier) + if (ier /= 0) then + write(iulog,"('>>> Error allocating itable: ntaski,j=',2i4)") ntaski,ntaskj + call endrun('itask_table_geo') + endif + itask_table_geo(:,:) = MPI_PROC_NULL + + irank = 0 + do j = 0,ntaskj-1 + do i = 0,ntaski-1 + itask_table_geo(i,j) = irank + if (mytid == irank) then + mytidi = i + mytidj = j + endif + irank = irank+1 + enddo +! +! Tasks are periodic in longitude: +! (this is not done in tiegcm, but here sub mp_geo_halos depends on it) +! + itask_table_geo(-1,j) = itask_table_geo(ntaski-1,j) + itask_table_geo(ntaski,j) = itask_table_geo(0,j) + + enddo ! j=0,ntaskj-1 + + if (debug.and.masterproc) then + write(iulog,"('mp_distribute_geo: mytid=',i4,' ntaski,j=',2i4,' mytidi,j=',2i4,& + ' lon0,1=',2i4,' lat0,1=',2i4,' lev0,1=',2i4)") & + mytid,ntaski,ntaskj,mytidi,mytidj,lon0,lon1,lat0,lat1,lev0,lev1 +! +! Print table to stdout, including -1,ntaski: +! + write(iulog,"(/,'ntask=',i3,' ntaski=',i2,' ntaskj=',i2,' Geo Task Table:')") & + ntask,ntaski,ntaskj + do j=-1,ntaskj + write(iulog,"('j=',i3,' itask_table_geo(:,j)=',100i3)") j,itask_table_geo(:,j) + enddo + endif +! +! Calculate start and end indices in lon,lat dimensions for each task: +! For WACCM: do not call distribute_1d - lon0,1, lat0,1 are set from +! waccm grid above. +! +! call distribute_1d(1,nlon,ntaski,mytidi,lon0,lon1) +! call distribute_1d(1,nlat,ntaskj,mytidj,lat0,lat1) + + nj = lat1-lat0+1 ! number of latitudes for this task + ni = lon1-lon0+1 ! number of longitudes for this task +! +! Report my stats to stdout: +! write(iulog,"(/,'mytid=',i3,' mytidi,j=',2i3,' lat0,1=',2i3,' (',i2,') lon0,1=',2i3,' (',i2,') ncells=',i4)") & +! mytid,mytidi,mytidj,lat0,lat1,nj,lon0,lon1,ni +! +! Define all task structures with current task values +! (redundant for alltoall): +! + do n=0,ntask-1 + tasks(n)%mytid = mytid + tasks(n)%mytidi = mytidi + tasks(n)%mytidj = mytidj + tasks(n)%nlats = nj + tasks(n)%nlons = ni + tasks(n)%lat0 = lat0 + tasks(n)%lat1 = lat1 + tasks(n)%lon0 = lon0 + tasks(n)%lon1 = lon1 + enddo +! +! All tasks must have at least 4 longitudes: +! + do n=0,ntask-1 + + if (debug.and.masterproc) then + write(iulog,"('mp_distribute_geo: n=',i3,' tasks(n)%nlons=',i3,' tasks(n)%nlats=',i3)") & + n,tasks(n)%nlons,tasks(n)%nlats + endif + + if (tasks(n)%nlons < 4) then + write(iulog,"('>>> mp_distribute_geo: each task must carry at least 4 longitudes. task=',i4,' nlons=',i4)") & + n,tasks(n)%nlons + call endrun('edyn_mpi: nlons per task') + endif + enddo +! +! Create sub-communicators for each task row (used by mp_geopole_3d): +! +! call mpi_comm_split(mpi_comm_edyn,mod(mytid,ntaskj),mytid,rows_comm,ier) +! call MPI_Comm_rank(rows_comm,tidrow,ier) + + call mpi_comm_split(mpi_comm_edyn,mytidj,mytid,rows_comm,ier) + call MPI_Comm_rank(rows_comm,tidrow,ier) + + if (debug.and.masterproc) then + write(iulog,"('mp_distribute_geo: ntaskj=',i3,' tidrow=',i3)") & + ntaskj,tidrow + endif + + end subroutine mp_distribute_geo +!----------------------------------------------------------------------- + subroutine mp_distribute_mag +! +! Local: + integer :: i,j,n,irank,ier,tidcol,nj,ni,ncells +! +! Number of tasks in mag lon,lat same as geo grid: +! Also true for WACCM processor distribution. +! + nmagtaski = ntaski + nmagtaskj = ntaskj +! +! Vertical dimension is not distributed: + mlev0 = 1 + mlev1 = nmlev +! +! Allocate and set 2d table of tasks: + allocate(itask_table_mag(-1:nmagtaski,-1:nmagtaskj),stat=ier) + if (ier /= 0) then + write(iulog,"('>>> Error allocating itable: nmagtaski,j=',2i3)") & + nmagtaski,nmagtaskj + call endrun('itask_table_mag') + endif + itask_table_mag(:,:) = MPI_PROC_NULL + irank = 0 + do j = 0,nmagtaskj-1 + do i = 0,nmagtaski-1 + itask_table_mag(i,j) = irank + if (mytid == irank) then + magtidi = i + magtidj = j + endif + irank = irank+1 + enddo +! +! Tasks are periodic in longitude: +! + itask_table_mag(-1,j) = itask_table_mag(nmagtaski-1,j) + itask_table_mag(nmagtaski,j) = itask_table_mag(0,j) + enddo + + if (debug.and.masterproc) then +! +! Print table to stdout: + write(iulog,"(/,'ntask=',i3,' nmagtaski=',i2,' nmagtaskj=',i2,' Mag Task Table:')") & + ntask,nmagtaski,nmagtaskj + do j=-1,nmagtaskj + write(iulog,"('j=',i3,' itask_table_mag(:,j)=',100i3)") j,itask_table_mag(:,j) + enddo + endif +! +! Calculate start and end indices in mag lon,lat dimensions for each task: +! + call distribute_1d(1,nmlonp1,nmagtaski,magtidi,mlon0,mlon1) + call distribute_1d(1,nmlat ,nmagtaskj,magtidj,mlat0,mlat1) + + omlon1=mlon1 + if (omlon1 == nmlonp1) omlon1=omlon1-1 + + nj = mlat1-mlat0+1 ! number of mag latitudes for this task + ni = mlon1-mlon0+1 ! number of mag longitudes for this task + ncells = nj*ni ! total number of grid cells for this task + + if (debug.and.masterproc) then +! +! Report my stats to stdout: + write(iulog,"(/,'mytid=',i3,' magtidi,j=',2i3,' mlat0,1=',2i3,' (',i2,') mlon0,1=',2i3,' (',i2,') ncells=',i4)") & + mytid,magtidi,magtidj,mlat0,mlat1,nj,mlon0,mlon1,ni,ncells + endif +! +! Define all task structures with current task values +! (redundant for alltoall): +! + do n=0,ntask-1 + tasks(n)%magtidi = magtidi + tasks(n)%magtidj = magtidj + tasks(n)%nmaglats = nj + tasks(n)%nmaglons = ni + tasks(n)%mlat0 = mlat0 + tasks(n)%mlat1 = mlat1 + tasks(n)%mlon0 = mlon0 + tasks(n)%mlon1 = mlon1 + enddo +! +! All tasks must have at least 4 longitudes: + do n=0,ntask-1 + if (tasks(n)%nmaglons < 4) then + write(iulog,"('>>> mp_distribute_mag: each task must carry at least 4 longitudes. task=',i4,' nmaglons=',i4)") & + n,tasks(n)%nmaglons + call endrun('edyn_mpi: nmaglons per task') + endif + enddo +! +! Create subgroup communicators for each task column: +! These communicators will be used by sub mp_mag_jslot (mpi.F). +! + call mpi_comm_split(mpi_comm_edyn,mod(mytid,nmagtaski),mytid,cols_comm,ier) + call MPI_Comm_rank(cols_comm,tidcol,ier) + + if (debug.and.masterproc) then + write(iulog,"('mp_distribute_mag: nmagtaski=',i3,' mod(mytid,nmagtaski)=',i3,' tidcol=',i3)") & + nmagtaski,mod(mytid,nmagtaski),tidcol + endif + + end subroutine mp_distribute_mag +!----------------------------------------------------------------------- + subroutine distribute_1d(n1,n2,nprocs,myrank,istart,iend) +! +! Distribute work across a 1d vector(n1->n2) to nprocs. +! Return start and end indices for proc myrank. +! +! Args: + integer,intent(in) :: n1,n2,nprocs,myrank + integer,intent(out) :: istart,iend +! +! Local: + integer :: lenproc,iremain,n +! + n = n2-n1+1 + lenproc = n/nprocs + iremain = mod(n,nprocs) + istart = n1 + myrank*lenproc + min(myrank,iremain) + iend = istart+lenproc-1 + if (iremain > myrank) iend = iend+1 + end subroutine distribute_1d +!----------------------------------------------------------------------- + subroutine mp_exchange_tasks(iprint) +! +! Args: + integer,intent(in) :: iprint +! +! Local: +! itasks_send(len_task_type,ntask) will be used to send tasks(:) info +! to all tasks (directly passing mpi derived data types is reportedly +! not stable, or not available until MPI 2.x). +! + integer :: n,ier + integer,parameter :: len_task_type = 17 ! see type task above + integer,allocatable,save :: & + itasks_send(:,:), & ! send buffer + itasks_recv(:,:) ! send buffer +! +! Pack tasks(mytid) into itasks_send: + allocate(itasks_send(len_task_type,0:ntask-1),stat=ier) + if (ier /= 0) then + write(iulog,"(i4,i4)") '>>> Error allocating itasks_send: len_task_type=',& + len_task_type,' ntask=',ntask + endif + allocate(itasks_recv(len_task_type,0:ntask-1),stat=ier) + if (ier /= 0) then + write(iulog,"(i4,i4)") '>>> Error allocating itasks_recv: len_task_type=',& + len_task_type,' ntask=',ntask + endif + do n=0,ntask-1 + itasks_send(1,n) = tasks(mytid)%mytid + + itasks_send(2,n) = tasks(mytid)%mytidi + itasks_send(3,n) = tasks(mytid)%mytidj + itasks_send(4,n) = tasks(mytid)%nlats + itasks_send(5,n) = tasks(mytid)%nlons + itasks_send(6,n) = tasks(mytid)%lat0 + itasks_send(7,n) = tasks(mytid)%lat1 + itasks_send(8,n) = tasks(mytid)%lon0 + itasks_send(9,n) = tasks(mytid)%lon1 + + itasks_send(10,n) = tasks(mytid)%magtidi + itasks_send(11,n) = tasks(mytid)%magtidj + itasks_send(12,n) = tasks(mytid)%nmaglats + itasks_send(13,n) = tasks(mytid)%nmaglons + itasks_send(14,n) = tasks(mytid)%mlat0 + itasks_send(15,n) = tasks(mytid)%mlat1 + itasks_send(16,n) = tasks(mytid)%mlon0 + itasks_send(17,n) = tasks(mytid)%mlon1 + enddo +! +! Send itasks_send and receive itasks_recv: + call mpi_alltoall(itasks_send,len_task_type,MPI_INTEGER,& + itasks_recv,len_task_type,MPI_INTEGER,& + mpi_comm_edyn,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'edyn_mpi: mpi_alltoall to send/recv itasks') +! +! Unpack itasks_recv into tasks(n) +! + do n=0,ntask-1 + tasks(n)%mytid = itasks_recv(1,n) + + tasks(n)%mytidi = itasks_recv(2,n) + tasks(n)%mytidj = itasks_recv(3,n) + tasks(n)%nlats = itasks_recv(4,n) + tasks(n)%nlons = itasks_recv(5,n) + tasks(n)%lat0 = itasks_recv(6,n) + tasks(n)%lat1 = itasks_recv(7,n) + tasks(n)%lon0 = itasks_recv(8,n) + tasks(n)%lon1 = itasks_recv(9,n) + + tasks(n)%magtidi = itasks_recv(10,n) + tasks(n)%magtidj = itasks_recv(11,n) + tasks(n)%nmaglats = itasks_recv(12,n) + tasks(n)%nmaglons = itasks_recv(13,n) + tasks(n)%mlat0 = itasks_recv(14,n) + tasks(n)%mlat1 = itasks_recv(15,n) + tasks(n)%mlon0 = itasks_recv(16,n) + tasks(n)%mlon1 = itasks_recv(17,n) +! +! Report to stdout: +! + if (n==mytid.and.iprint > 0) then + write(iulog,"(/,'Task ',i3,':')") n + write(iulog,"(/,'Subdomain on geographic grid:')") + write(iulog,"('tasks(',i3,')%mytid =',i3)") n,tasks(n)%mytid + write(iulog,"('tasks(',i3,')%mytidi=',i3)") n,tasks(n)%mytidi + write(iulog,"('tasks(',i3,')%mytidj=',i3)") n,tasks(n)%mytidj + write(iulog,"('tasks(',i3,')%nlats =',i3)") n,tasks(n)%nlats + write(iulog,"('tasks(',i3,')%nlons =',i3)") n,tasks(n)%nlons + write(iulog,"('tasks(',i3,')%lat0 =',i3)") n,tasks(n)%lat0 + write(iulog,"('tasks(',i3,')%lat1 =',i3)") n,tasks(n)%lat1 + write(iulog,"('tasks(',i3,')%lon0 =',i3)") n,tasks(n)%lon0 + write(iulog,"('tasks(',i3,')%lon1 =',i3)") n,tasks(n)%lon1 + write(iulog,"('Number of geo subdomain grid points = ',i6)") & + tasks(n)%nlons * tasks(n)%nlats + write(iulog,"(/,'Subdomain on geomagnetic grid:')") + write(iulog,"('tasks(',i3,')%magtidi=',i3)") n,tasks(n)%magtidi + write(iulog,"('tasks(',i3,')%magtidj=',i3)") n,tasks(n)%magtidj + write(iulog,"('tasks(',i3,')%nmaglats =',i3)") n,tasks(n)%nmaglats + write(iulog,"('tasks(',i3,')%nmaglons =',i3)") n,tasks(n)%nmaglons + write(iulog,"('tasks(',i3,')%mlat0 =',i3)") n,tasks(n)%mlat0 + write(iulog,"('tasks(',i3,')%mlat1 =',i3)") n,tasks(n)%mlat1 + write(iulog,"('tasks(',i3,')%mlon0 =',i3)") n,tasks(n)%mlon0 + write(iulog,"('tasks(',i3,')%mlon1 =',i3)") n,tasks(n)%mlon1 + write(iulog,"('Number of mag subdomain grid points = ',i6)") & + tasks(n)%nmaglons * tasks(n)%nmaglats + endif + enddo +! +! Release locally allocated space: + deallocate(itasks_send) + deallocate(itasks_recv) +! +! mxlon,mxlat are maximum number of lons,lats owned by all tasks: + mxlon = -9999 + do n=0,ntask-1 + if (tasks(n)%nlons > mxlon) mxlon = tasks(n)%nlons + enddo + mxlat = -9999 + do n=0,ntask-1 + if (tasks(n)%nlats > mxlat) mxlat = tasks(n)%nlats + enddo +! +! mxmaglon,mxmaglat are maximum number of mag lons,lats owned by all tasks: + mxmaglon = -9999 + do n=0,ntask-1 + if (tasks(n)%nmaglons > mxmaglon) mxmaglon = tasks(n)%nmaglons + enddo + mxmaglat = -9999 + do n=0,ntask-1 + if (tasks(n)%nmaglats > mxmaglat) mxmaglat = tasks(n)%nmaglats + enddo +! +! Find conjugate points for folding hemispheres: + call conjugate_points + + end subroutine mp_exchange_tasks +!----------------------------------------------------------------------- + subroutine mp_mageq(fin,fout,nf,mlon0,mlon1,mlat0,mlat1,nmlev) +! +! Each task needs values of conductivities and adotv1,2 fields at the +! at the mag equator for its longitude subdomain (and all levels), for +! the fieldline integrations. +! +! On input, fin is ped_mag, hal_mag, adotv1_mag, adotv2_mag +! on (i,j,k) magnetic subdomain. +! On output, fout(mlon0:mlon1,nmlev,nf) is ped_meq, hal_meq, adotv1_meq, +! adotv2_meq at mag equator at longitude subdomain and all levels. +! +! Args: + integer :: mlon0,mlon1,mlat0,mlat1,nmlev,nf + real(r8),intent(in) :: fin (mlon0:mlon1,mlat0:mlat1,nmlev,nf) + real(r8),intent(out) :: fout(mlon0:mlon1,nmlev,nf) +! +! Local: + real(r8) :: & ! mpi buffers + sndbuf(mxmaglon,nmlev,nf), & ! mxmaglon,nmlev,nf + rcvbuf(mxmaglon,nmlev,nf) ! mxmaglon,nmlev,nf + integer :: i,j,n,itask,ier,len,jlateq,ireqsend,ireqrecv + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + logical :: have_eq + + sndbuf = 0._r8 + rcvbuf = 0._r8 + len = mxmaglon*nmlev*nf +! +! If mag equator is in current subdomain, load it into sndbuf +! and send to other tasks in my task column (mytidi) +! + jlateq = (nmlat+1)/2 ! lat index of mag equator (49) + have_eq = .false. + do j=mlat0,mlat1 + if (j == jlateq) then ! load send buffer w/ data at equator + have_eq = .true. + do i=mlon0,mlon1 + sndbuf(i-mlon0+1,:,:) = fin(i,j,:,:) + enddo +! +! Send mag equator data to other tasks in my task column (mytidi): + do itask=0,ntask-1 + if (itask /= mytid.and.tasks(itask)%mytidi==mytidi) then + call mpi_isend(sndbuf,len,MPI_REAL8,itask,1, & + mpi_comm_edyn,ireqsend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mageq isend') + call mpi_wait(ireqsend,irstat,ier) + endif ! another task in mytidi + enddo ! itask=0,ntask-1 + endif ! j==jlateq + enddo ! j=mlat0,mlat1 +! +! Receive by other tasks in the sending task's column: + fout = 0._r8 + if (.not.have_eq) then ! find task to receive from + do itask=0,ntask-1 + do j=tasks(itask)%mlat0,tasks(itask)%mlat1 + if (j == jlateq.and.tasks(itask)%mytidi==mytidi) then + call mpi_irecv(rcvbuf,len,MPI_REAL8,itask,1, & + mpi_comm_edyn,ireqrecv,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mageq irecv') + call mpi_wait(ireqrecv,irstat,ier) + do n=1,nf + do i=mlon0,mlon1 + fout(i,:,n) = rcvbuf(i-mlon0+1,:,n) + enddo + enddo + endif ! itask has mag eq and is in my column (sending task) + enddo ! scan itask latitudes + enddo ! task table search +! +! If I am the sending task, set fout to equator values of input array: + else + do n=1,nf + do i=mlon0,mlon1 + fout(i,:,n) = fin(i,jlateq,:,n) + enddo + enddo + endif ! I am receiving or sending task + end subroutine mp_mageq +!----------------------------------------------------------------------- + subroutine mp_mageq_jpm1(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm1,nf) +! +! All tasks need data at mag latitudes equator-1, equator+1 at global +! longitudes. +! On input: f is 6 fields on mag subdomains: zigm11,zigm22,zigmc,zigm2,rim1,rim2 +! On output: feq_jpm1(nmlonp1,2,nf) +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf + real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: feq_jpm1(nmlonp1,2,nf) ! eq-1,eq+1 +! +! Local: + integer :: j,ier,len,jlateq + real(r8) :: sndbuf(nmlonp1,2,nf) + + sndbuf = 0._r8 + feq_jpm1 = 0._r8 + len = nmlonp1*2*nf +! +! Load send buffer w/ eq +/- 1 for current subdomain +! (redundant to all tasks for alltoall) +! + jlateq = (nmlat+1)/2 + do j=mlat0,mlat1 + if (j == jlateq+1) then ! equator+1 + sndbuf(mlon0:mlon1,1,:) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-1) then ! equator-1 + sndbuf(mlon0:mlon1,2,:) = f(mlon0:mlon1,j,:) + endif ! j==jlateq + enddo ! j=mlat0,mlat1 +! +! Do the exchange: +! + call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm1(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm1 call mpi_allreduce') + +! +! Periodic point: + feq_jpm1(nmlonp1,:,:) = feq_jpm1(1,:,:) + + end subroutine mp_mageq_jpm1 +!----------------------------------------------------------------------- + subroutine mp_mageq_jpm3(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm3,nf) +! +! All tasks need global longitudes at mag latitudes equator, +! and equator +/- 1,2,3 +! On input: f is nf fields on mag subdomains +! On output: feq_jpm3(nmlonp1,-3:3,nf) has global lons at eq, eq +/- 1,2,3 +! 2nd dimension of feq_jpm3 (and send/recv buffers) is as follows: +! +3: eq+3 +! +2: eq+2 +! +1: eq+1 +! 0: eq +! -1: eq-1 +! -2: eq-2 +! -3: eq-3 +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf + real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: feq_jpm3(nmlonp1,-3:3,nf) +! +! Local: + integer :: j,ier,len,jlateq + integer,parameter :: mxnf=6 + + real(r8) :: sndbuf(nmlonp1,-3:3,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_mageq_jpm3: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_mageq_jpm3') + endif + + sndbuf = 0._r8 + feq_jpm3 = 0._r8 + len = nmlonp1*7*nf +! +! Load send buffer w/ eq +/- 3 for current subdomain +! + jlateq = (nmlat+1)/2 + do j=mlat0,mlat1 + if (j == jlateq-3) then ! equator-3 + sndbuf(mlon0:mlon1,-3,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-2) then ! equator-2 + sndbuf(mlon0:mlon1,-2,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-1) then ! equator-1 + sndbuf(mlon0:mlon1,-1,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq) then ! equator + sndbuf(mlon0:mlon1,0,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+1) then ! equator+1 + sndbuf(mlon0:mlon1,1,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+2) then ! equator+2 + sndbuf(mlon0:mlon1,2,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+3) then ! equator+3 + sndbuf(mlon0:mlon1,3,1:nf) = f(mlon0:mlon1,j,:) + endif ! j==jlateq + enddo ! j=mlat0,mlat1 +! +! Do the exchange: +! + call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm3(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm3 call mpi_allreduce') + +! +! Periodic point: + feq_jpm3(nmlonp1,:,:) = feq_jpm3(1,:,:) + + end subroutine mp_mageq_jpm3 +!----------------------------------------------------------------------- + subroutine mp_magpole_2d(f,ilon0,ilon1,ilat0,ilat1, & + nglblon,jspole,jnpole,fpole_jpm2,nf) +! +! Return fpole_jpm2(nglblon,1->4,nf) as: +! 1: j = jspole+1 (spole+1) +! 2: j = jspole+2 (spole+2) +! 3: j = jnpole-1 (npole-1) +! 4: j = jnpole-2 (npole-2) +! This can be called with different number of fields nf, but cannot +! be called w/ > mxnf fields. +! +! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,jspole,jnpole,nf + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) + real(r8),intent(out) :: fpole_jpm2(nglblon,4,nf) +! +! Local: + integer :: j,ier,len + integer,parameter :: mxnf=6 + real(r8) :: sndbuf(nglblon,4,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_magpole_2d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_magpole_2d') + endif + + sndbuf = 0._r8 + fpole_jpm2 = 0._r8 + len = nglblon*4*nf +! +! Load send buffer with values at poles +/- 2 for current subdomain +! + do j=ilat0,ilat1 + if (j==jspole+1) then ! south pole +1 + sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jspole+2) then ! south pole +2 + sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole-1) then ! north pole -1 + sndbuf(ilon0:ilon1,3,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole-2) then ! north pole -2 + sndbuf(ilon0:ilon1,4,1:nf) = f(ilon0:ilon1,j,:) + endif + enddo + +! +! Do the exchange: +! + call mpi_allreduce( sndbuf(:,:,1:nf), fpole_jpm2(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_2d call mpi_allreduce') + + end subroutine mp_magpole_2d +!----------------------------------------------------------------------- + subroutine mp_magpole_3d(f,ilon0,ilon1,ilat0,ilat1,nlev, nglblon,jspole,jnpole,fpole_jpm2,nf) +! +! Return fpole_jpm2(nglblon,1->4,nlev,nf) as: +! 1: j = jspole+1 (spole+1) +! 2: j = jspole+2 (spole+2) +! 3: j = jnpole-1 (npole-1) +! 4: j = jnpole-2 (npole-2) +! This can be called with different number of fields nf, but cannot +! be called w/ > mxnf fields. +! +! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,& + jspole,jnpole,nf,nlev + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nlev,nf) + real(r8),intent(out) :: fpole_jpm2(nglblon,4,nlev,nf) +! +! Local: + integer :: j,k,ier,len + integer,parameter :: mxnf=6 + real(r8) :: sndbuf(nglblon,4,nlev,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_magpole_3d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_magpole_3d') + endif + + sndbuf = 0._r8 + fpole_jpm2 = 0._r8 + len = nglblon*4*nlev*nf +! +! Load send buffer with values at poles +/- 2 for current subdomain +! + do j=ilat0,ilat1 + do k=1,nlev + if (j==jspole+1) then ! south pole +1 + sndbuf(ilon0:ilon1,1,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jspole+2) then ! south pole +2 + sndbuf(ilon0:ilon1,2,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jnpole-1) then ! north pole -1 + sndbuf(ilon0:ilon1,3,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jnpole-2) then ! north pole -2 + sndbuf(ilon0:ilon1,4,k,1:nf) = f(ilon0:ilon1,j,k,:) + endif + enddo + enddo + +! +! Do the exchange: +! + call mpi_allreduce( sndbuf(:,:,:,1:nf), fpole_jpm2(:,:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_3d call mpi_allreduce') + + end subroutine mp_magpole_3d +!----------------------------------------------------------------------- + subroutine mp_magpoles(f,ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,fpoles,nf) +! +! Similiar to mp_magpole_2d, but returns global longitudes for +! j==1 and j==nmlat (not for poles +/- 2) +! Return fpoles(nglblon,2,nf) as: +! 1: j = jspole (spole) +! 2: j = jnpole (npole) +! This can be called with different number of fields nf, but cannot +! be called w/ > mxnf fields. +! +! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,nf + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) + real(r8),intent(out) :: fpoles(nglblon,2,nf) +! +! Local: + integer :: j,ier,len + real(r8) :: sndbuf(nglblon,2,nf) + + sndbuf = 0._r8 + fpoles = 0._r8 + len = nglblon*2*nf +! +! Load send buffer with values at poles +/- 2 for current subdomain +! + do j=ilat0,ilat1 + if (j==jspole) then ! south pole + sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole) then ! npole pole + sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) + endif + enddo + +! +! Do the exchange: +! + call mpi_allreduce( sndbuf(:,:,1:nf), fpoles(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpoles call mpi_allreduce') + + end subroutine mp_magpoles +!----------------------------------------------------------------------- + integer function getpe(ix,jx) + integer,intent(in) :: ix,jx + integer :: it + + getpe = -1 + do it=0,ntask-1 + if ((tasks(it)%lon0 <= ix .and. tasks(it)%lon1 >= ix).and.& + (tasks(it)%lat0 <= jx .and. tasks(it)%lat1 >= jx)) then + getpe = it + exit + endif + enddo + if (getpe < 0) then + write(iulog,"('getpe: pe with ix=',i4,' not found.')") ix + call endrun('getpe') + endif + end function getpe +!----------------------------------------------------------------------- + subroutine mp_pole_halos(f,lev0,lev1,lon0,lon1,lat0,lat1,nf,polesign) +! +! Set latitude halo points over the poles. +! +! Args: + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1,nf + real(r8),intent(in) :: polesign(nf) + type(array_ptr_type) :: f(nf) ! (plev,i0-2:i1+2,j0-2:j1+2) +! +! Local: + integer :: if,i,j,k,ihalo,it,i0,i1,j0,j1,itask + +! real(r8) :: fglblon(lev0:lev1,nlon,lat0-2:lat1+2,nf) + type(array_ptr_type) :: pglblon(nf) ! (lev0:lev1,nlon,lat0-2:lat1+2) + + if (mytidj /= 0 .and. mytidj /= ntaskj-1) return + +! fglblon = 0._r8 ! init +! +! Allocate local fields with global longitudes: + do if=1,nf + allocate(pglblon(if)%ptr(lev0:lev1,nlon,lat0-2:lat1+2)) + enddo +! +! Define my subdomain in local fglblon, which has global lon dimension: +! + do if=1,nf + do j=lat0-2,lat1+2 + do i=lon0,lon1 + pglblon(if)%ptr(lev0:lev1,i,j) = f(if)%ptr(lev0:lev1,i,j) + enddo + enddo + enddo +! +! Gather longitude data to westernmost processors (far north and south): +! + call mp_gatherlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) +! +! Loop over tasks in my latitude row (far north or far south), +! including myself, and set halo points over the poles. +! + if (mytidi==0) then + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + i0 = tasks(itask)%lon0 + i1 = tasks(itask)%lon1 + j0 = tasks(itask)%lat0 + j1 = tasks(itask)%lat1 + do if=1,nf + if (j0==1) then ! south + do i=i0,i1 + ihalo = 1+mod(i-1+nlon/2,nlon) + pglblon(if)%ptr(lev0:lev1,i,j0-2) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+2) ! get lat -1 from lat 3 + pglblon(if)%ptr(lev0:lev1,i,j0-1) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+1) ! get lat 0 from lat 2 + enddo + else ! north + do i=i0,i1 + ihalo = 1+mod(i-1+nlon/2,nlon) + pglblon(if)%ptr(lev0:lev1,i,j1+1) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-1) ! get lat plat+1 from plat-1 + pglblon(if)%ptr(lev0:lev1,i,j1+2) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-2) ! get lat plat+2 from plat-2 + enddo + endif + enddo ! if=1,nf + enddo ! it=0,ntaski-1 + endif ! mytidi==0 +! +! Scatter data back out to processors in my latitude row: +! + call mp_scatterlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) +! +! Finally, define halo points in data arrays from local global lon array, +! changing sign if necessary (winds): +! + if (lat0==1) then ! south + do if=1,nf + do j=lat0-2,lat0-1 + do k=lev0,lev1 + f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) + enddo + enddo + enddo + else ! north + do if=1,nf + do j=lat1+1,lat1+2 + do k=lev0,lev1 + f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) + enddo + enddo + enddo + endif + + do if=1,nf + deallocate(pglblon(if)%ptr) + enddo + end subroutine mp_pole_halos +!----------------------------------------------------------------------- + subroutine conjugate_points + use edyn_maggrid,only: gmlat +! +! Local: + integer :: ier,j,js,jn,itask,jj +! +! nsend_south(ntask): number of lats in south to send north +! nrecv_north(ntask): number of lats in north to recv from south +! + allocate(nsend_south(0:ntask-1),stat=ier) + allocate(nrecv_north(0:ntask-1),stat=ier) +! +! send_south_coords: south j lats to send north +! recv_north_coords: north j lats to recv from south +! + allocate(send_south_coords(mxmaglat,0:ntask-1),stat=ier) + allocate(recv_north_coords(mxmaglat,0:ntask-1),stat=ier) + + nsend_south(:) = 0 + nrecv_north(:) = 0 + send_south_coords(:,:) = 0 + recv_north_coords(:,:) = 0 + + magloop: do j=mlat0,mlat1 +! +! In north hem: find tasks w/ conjugate points in south to recv: +! (nmlath is in params module) + if (gmlat(j) > 0._r8) then ! in north hem of current task + js = nmlath-(j-nmlath) ! j index to south conjugate point (should be -j) + do itask=0,ntask-1 + do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 +! +! Receive these north coords from the south: + if (jj==js.and.mlon0==tasks(itask)%mlon0.and. & + mlon1==tasks(itask)%mlon1) then + nrecv_north(itask) = nrecv_north(itask)+1 + recv_north_coords(nrecv_north(itask),itask) = j + endif + enddo ! jj of remote task + enddo ! itask=0,ntask-1 + if (all(nrecv_north==0)) & + write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find north conjugate',& + ' points corresponding to south latitude js=',js,' gmlat(js)=',gmlat(js) +! +! In south hem: find tasks w/ conjugate points in north to send: + elseif (gmlat(j) < 0._r8.and.j /= nmlath) then ! in south hem + jn = nmlath+(nmlath-j) ! j index of north conjugate point + do itask=0,ntask-1 + do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 + if (jj==jn.and.mlon0==tasks(itask)%mlon0.and. & + mlon1==tasks(itask)%mlon1) then + nsend_south(itask) = nsend_south(itask)+1 +! Send these south coords to the north: + send_south_coords(nsend_south(itask),itask) = j + endif + enddo ! jj of remote task + enddo ! itask=0,ntask-1 + if (all(nsend_south==0)) & + write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find south conjugate',& + ' points corresponding to north latitude jn=',jn,' gmlat(jn)=',gmlat(jn) + endif ! in north or south hem + enddo magloop ! j=mlat0,mlat1 + end subroutine conjugate_points +!----------------------------------------------------------------------- + subroutine mp_mag_foldhem(f,mlon0,mlon1,mlat0,mlat1,nf) +! +! For each point in northern hemisphere (if any) of the current task +! subdomain, receive data from conjugate point in the south (from the +! south task that owns it), and sum it to the north point data. +! Do this for nf fields. Conjugate point indices to send/recv to/from +! each task were determined by sub conjugate_points (this module). +! nsend_south, ! number of south lats to send to north (each task) +! nrecv_north ! number of north lats to send to south (each task) +! +! This routine is called from edynamo at every timestep. +! Sub conjugate_points is called once per run, from mp_distribute. +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) +! +! Local: + integer :: j,n,len,itask,ifld,ier,nmlons + real(r8) :: sndbuf(mxmaglon,mxmaglat,nf,0:ntask-1) + real(r8) :: rcvbuf(mxmaglon,mxmaglat,nf,0:ntask-1) + integer :: jsend(0:ntask-1),jrecv(0:ntask-1) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + +! + sndbuf = 0._r8 ; rcvbuf = 0._r8 + jsend = 0 ; jrecv = 0 + len = mxmaglon*mxmaglat*nf + nmlons = mlon1-mlon0+1 +! +! Send south data to north itask: +! (To avoid deadlock, do not send if north task is also myself. This will +! happen when there is an odd number of tasks in the latitude dimension, +! e.g., ntask == 12, 30, etc) +! + do itask=0,ntask-1 + +! Attempt to fetch from allocatable variable NSEND_SOUTH when it is not allocated + + if (nsend_south(itask) > 0 .and. itask /= mytid) then + do ifld = 1,nf + do n=1,nsend_south(itask) + sndbuf(1:nmlons,n,ifld,itask) = & + f(:,send_south_coords(n,itask),ifld) + enddo + enddo ! ifld=1,nf + call mpi_isend(sndbuf(1,1,1,itask),len,MPI_REAL8, & + itask,1,mpi_comm_edyn,jsend(itask),ier) + call mpi_wait(jsend(itask),irstat,ier) + endif ! nsend_south(itask) > 0 + enddo ! itask=0,ntask-1 +! +! Receive north data from south itask and add to north, +! i.e., north = north+south. (do not receive if south task is +! also myself, but do add south data to my north points, see below) +! + do itask=0,ntask-1 + if (nrecv_north(itask) > 0 .and. itask /= mytid) then + call mpi_irecv(rcvbuf(1,1,1,itask),len,MPI_REAL8, & + itask,1,mpi_comm_edyn,jrecv(itask),ier) + call mpi_wait(jrecv(itask),irstat,ier) + do ifld=1,nf + do n=1,nrecv_north(itask) +! +! Receive lats in reverse order: + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & + rcvbuf(1:nmlons,n,ifld,itask) + enddo ! n=1,nrecv_north(itask) + enddo ! ifld=1,nf +! +! If I am send *and* receive task, simply add my south data to my north points: + elseif (nrecv_north(itask) > 0 .and. itask == mytid) then + do ifld=1,nf + do n=1,nrecv_north(itask) + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & + f(mlon0:mlon1,send_south_coords(n,itask),ifld) + enddo ! n=1,nrecv_north(itask) + enddo ! ifld=1,nf + endif ! nrecv_north(itask) > 0 + enddo ! itask=0,ntask-1 +! +! Mag equator is also "folded", but not included in conjugate points, +! so double it here: + do j=mlat0,mlat1 + if (j==nmlath) then + do ifld=1,nf + f(:,j,ifld) = f(:,j,ifld)+f(:,j,ifld) + enddo + endif + enddo + + end subroutine mp_mag_foldhem +!----------------------------------------------------------------------- + subroutine mp_mag_periodic_f2d(f,mlon0,mlon1,mlat0,mlat1,nf) +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) +! +! Local: + integer :: j,ier,idest,isrc,len,ireqsend,ireqrecv,msgtag + real(r8) :: sndbuf(mxmaglat,nf),rcvbuf(mxmaglat,nf) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + + if (ntaski>1) then + len = mxmaglat*nf + ! + ! I am a western-most task. Send lon 1 to eastern-most tasks: + if (mytidi==0) then + idest = itask_table_mag(ntaski-1,mytidj) + do j=mlat0,mlat1 + sndbuf(j-mlat0+1,:) = f(1,j,:) + enddo + msgtag = mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,msgtag,mpi_comm_edyn, ireqsend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d send to idest') + call mpi_wait(ireqsend,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for send') + ! + ! I am eastern-most task. Receive lon 1 from western-most tasks, + ! and assign to nmlonp1: + elseif (mytidi==ntaski-1) then + isrc = itask_table_mag(0,mytidj) + msgtag = isrc + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,msgtag,mpi_comm_edyn, ireqrecv,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d recv from isrc') + call mpi_wait(ireqrecv,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for recv') + + do j=mlat0,mlat1 + f(nmlonp1,j,:) = rcvbuf(j-mlat0+1,:) + enddo + endif ! mytidi == 0 or ntaski-1 + else + do j=mlat0,mlat1 + f(nmlonp1,j,:) = f(1,j,:) + enddo + endif + + end subroutine mp_mag_periodic_f2d +!----------------------------------------------------------------------- + subroutine mp_mag_halos(fmsub,mlon0,mlon1,mlat0,mlat1,nf) +! +! Exchange halo/ghost points between magnetic grid subdomains for nf fields. +! Only a single halo point is required in both lon and lat dimensions. +! Note that all tasks in any row of the task matrix have the same +! mlat0,mlat1, and that all tasks in any column of the task matrix +! have the same mlon0,mlon1. +! Longitude halos are done first, exchanging mlat0:mlat1, then latitude +! halos are done, exchanging mlon0-1:mlon1+1 (i.e., including the +! longitude halos that were defined first). +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: fmsub(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nf) +! +! Local: + integer :: ifld,west,east,north,south,len,isend0,isend1, & + irecv0,irecv1,ier,nmlats,istat(MPI_STATUS_SIZE,4),ireq(4),nmlons + real(r8),dimension(mlat1-mlat0+1,nf)::sndlon0,sndlon1,rcvlon0,rcvlon1 + real(r8),dimension((mlon1+1)-(mlon0-1)+1,nf) :: & + sndlat0,sndlat1,rcvlat0,rcvlat1 + +! +! Init send/recv buffers for lon halos: + sndlon0 = 0._r8 ; rcvlon0 = 0._r8 + sndlon1 = 0._r8 ; rcvlon1 = 0._r8 +! +! Identify east and west neightbors: + west = itask_table_mag(mytidi-1,mytidj) + east = itask_table_mag(mytidi+1,mytidj) +! +! Exchange mlat0:mlat1 (lat halos are not yet defined): + nmlats = mlat1-mlat0+1 + len = nmlats*nf +! +! Send mlon0 to the west neighbor, and mlon1 to the east. +! However, tasks are periodic in longitude (see itask_table_mag), +! and far west tasks send mlon0+1, and far east tasks send mlon1-1 +! + do ifld=1,nf +! Far west tasks send mlon0+1 to far east (periodic) tasks: + if (mytidi==0) then + sndlon0(:,ifld) = fmsub(mlon0+1,mlat0:mlat1,ifld) +! Interior tasks send mlon0 to west neighbor: + else + sndlon0(:,ifld) = fmsub(mlon0,mlat0:mlat1,ifld) + endif + +! Far east tasks send mlon1-1 to far west (periodic) tasks: + if (mytidi==nmagtaski-1) then + sndlon1(:,ifld) = fmsub(mlon1-1,mlat0:mlat1,ifld) +! Interior tasks send mlon1 to east neighbor: + else + sndlon1(:,ifld) = fmsub(mlon1,mlat0:mlat1,ifld) + endif + enddo ! ifld=1,nf +! +! Send mlon0 to the west: + call mpi_isend(sndlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon0 to west') +! +! Send mlon1 to the east: + call mpi_isend(sndlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon1 to east') +! +! Recv mlon0-1 from west: + call mpi_irecv(rcvlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon0 from west') +! +! Recv mlon1+1 from east: + call mpi_irecv(rcvlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon1 from east') +! +! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lons') +! +! Copy mlon0-1 from rcvlon0, and mlon1+1 from rcvlon1: + do ifld=1,nf + fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) + fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) +! +! Fix special case of 2 tasks in longitude dimension: + if (east == west) then + fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) + fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) + endif + enddo ! ifld=1,nf +! +! Now exchange latitudes: + sndlat0 = 0._r8 ; rcvlat0 = 0._r8 + sndlat1 = 0._r8 ; rcvlat1 = 0._r8 + + south = itask_table_mag(mytidi,mytidj-1) ! neighbor to south + north = itask_table_mag(mytidi,mytidj+1) ! neighbor to north +! +! Include halo longitudes that were defined by the exchanges above: + nmlons = (mlon1+1)-(mlon0-1)+1 + len = nmlons*nf +! +! Send mlat0 to south neighbor, and mlat1 to north: + do ifld=1,nf + sndlat0(:,ifld) = fmsub(:,mlat0,ifld) + sndlat1(:,ifld) = fmsub(:,mlat1,ifld) + enddo +! +! Send mlat0 to south: + call mpi_isend(sndlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat0 to south') +! +! Send mlat1 to north: + call mpi_isend(sndlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat1 to north') +! +! Recv mlat0-1 from south: + call mpi_irecv(rcvlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat0-1 from south') +! +! Recv mlat1+1 from north: + call mpi_irecv(rcvlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat1+1 from north') +! +! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lats') +! +! Copy mlat0-1 from rcvlat0, and mlat1+1 from rcvlat1: + do ifld=1,nf + fmsub(:,mlat0-1,ifld) = rcvlat0(:,ifld) + fmsub(:,mlat1+1,ifld) = rcvlat1(:,ifld) + enddo ! ifld=1,nf + + end subroutine mp_mag_halos +!----------------------------------------------------------------------- + subroutine mp_geo_halos(fmsub,lev0,lev1,lon0,lon1,lat0,lat1,nf) +! +! Exchange halo/ghost points between geographic grid subdomains for nf fields. +! Two halo points are set in both lon and lat dimensions. +! Longitude halos are done first, then latitude halos are done, including +! longitude halos that were defined first). +! +! Args: + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1,nf + type(array_ptr_type) :: fmsub(nf) ! (lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) + +! +! Local: + integer :: k,i,ifld,west,east,north,south,len,isend0,isend1, & + irecv0,irecv1,ier,nlats,istat(MPI_STATUS_SIZE,4),ireq(4),nlons + real(r8),dimension(lev0:lev1,2,lat1-lat0+1,nf) :: & + sndlon0,sndlon1,rcvlon0,rcvlon1 + real(r8),dimension(lev0:lev1,2,(lon1+2)-(lon0-2)+1,nf) :: & + sndlat0,sndlat1,rcvlat0,rcvlat1 + +! if (mpi_timing) starttime = mpi_wtime() +! +! Init send/recv buffers for lon halos: + sndlon0 = 0._r8 ; rcvlon0 = 0._r8 + sndlon1 = 0._r8 ; rcvlon1 = 0._r8 +! +! Identify east and west neighbors: + west = itask_table_geo(mytidi-1,mytidj) + east = itask_table_geo(mytidi+1,mytidj) +! +! Exchange lat0:lat1 (lat halos are not yet defined): + nlats = lat1-lat0+1 + len = (lev1-lev0+1)*2*nlats*nf +! +! Send lon0:lon0+1 to the west neighbor, and lon1-1:lon1 to the east. +! + do ifld=1,nf + do i=1,2 + do k=lev0,lev1 + sndlon0(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon0+i-1,lat0:lat1) ! lon0, lon0+1 + sndlon1(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon1+i-2,lat0:lat1) ! lon1-1, lon1 + enddo + enddo + enddo ! ifld=1,nf +! +! Send lon0:lon0+1 to the west: + call mpi_isend(sndlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos send lon0:lon0+1 to west') +! +! Send lon1-1:lon1 to the east: + call mpi_isend(sndlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos send lon1-1:lon1 to east') +! +! Recv lon0-2:lon0-1 from west: + call mpi_irecv(rcvlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos recv lon0-2:lon0-1 from west') +! +! Recv lon1+1:lon1+2 from east: + call mpi_irecv(rcvlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos recv lon1+1:lon1+2 from east') +! +! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos waitall for lons') +! +! Copy lon0-2:lon0-1 from rcvlon0, and lon1+1:lon1+2 from rcvlon1: + do ifld=1,nf + if (east /= west) then + do i=1,2 + do k=lev0,lev1 + fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon0-2, lon0-1 + fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon1+1, lon1+2 + enddo + enddo ! i=1,2 +! +! Fix special case of 2 tasks in longitude dimension: + else ! east==west + do i=1,2 + do k=lev0,lev1 + fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon0-2, lon0-1 + fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon1+1, lon1+2 + enddo + enddo + endif ! east==west + enddo ! ifld=1,nf +! +! Now exchange latitudes: + sndlat0 = 0._r8 ; rcvlat0 = 0._r8 + sndlat1 = 0._r8 ; rcvlat1 = 0._r8 + + south = itask_table_geo(mytidi,mytidj-1) ! neighbor to south + north = itask_table_geo(mytidi,mytidj+1) ! neighbor to north +! +! Include halo longitudes that were defined by the exchanges above: + nlons = (lon1+2)-(lon0-2)+1 + len = (lev1-lev0+1)*2*nlons*nf +! +! Send lat0:lat0+1 to south neighbor, and lat1-1:lat1 to north: + do ifld=1,nf + do k=lev0,lev1 + sndlat0(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat0 ) ! send lat0 to south + sndlat0(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat0+1) ! send lat0+1 to south + + sndlat1(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat1 ) ! send lat1 to north + sndlat1(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat1-1) ! send lat1-1 to north + enddo + enddo +! +! Send lat0:lat0+1 to south (matching recv is lat1+1:lat1+2): + call mpi_isend(sndlat0,len,MPI_REAL8,south,100,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos send lat0:lat0+1 to south') +! +! Send lat1-1:lat1 to north (matching recv is lat0-2:lat0-1): + call mpi_isend(sndlat1,len,MPI_REAL8,north,101,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos send lat1-1:lat1 to north') +! +! Recv lat0-2:lat0-1 from south: + call mpi_irecv(rcvlat0,len,MPI_REAL8,south,101,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos recv lat0-2:lat0-1 from south') +! +! Recv lat1+1:lat1+2 from north: + call mpi_irecv(rcvlat1,len,MPI_REAL8,north,100,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos recv lat1+1:lat1+2 from north') +! +! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier, & + 'mp_geo_halos waitall for lats') +! +! Copy lat0-2:lat0-1 from rcvlat0, and lat1+1:lat1+2 from rcvlat1: + do ifld=1,nf + do k=lev0,lev1 + fmsub(ifld)%ptr(k,:,lat0-1) = rcvlat0(k,1,:,ifld) ! recv lat0-1 from south + fmsub(ifld)%ptr(k,:,lat0-2) = rcvlat0(k,2,:,ifld) ! recv lat0-2 from south + + fmsub(ifld)%ptr(k,:,lat1+1) = rcvlat1(k,1,:,ifld) ! recv lat1+1 from north + fmsub(ifld)%ptr(k,:,lat1+2) = rcvlat1(k,2,:,ifld) ! recv lat1+2 from north + enddo +! +! Fix special case of 2 tasks in latitude dimension: +! Not sure if this will happen in WACCM: +! + if (north == south) then + call endrun('mp_geo_halos: north==south') + endif + enddo ! ifld=1,nf + + end subroutine mp_geo_halos +!----------------------------------------------------------------------- + subroutine mp_gather_edyn(fmsub,mlon0,mlon1,mlat0,mlat1,fmglb,nmlonp1,nmlat,nf) +! +! Gather fields on mag subdomains to root task, so root task can +! complete non-parallel portion of dynamo (starting after rhspde) +! +! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nmlat,nf + real(r8),intent(in) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: fmglb(nmlonp1,nmlat,nf) +! +! Local: + integer :: len,i,j,ifld,ier + real(r8),dimension(nmlonp1,nmlat,nf) :: sndbuf + + sndbuf = 0._r8 + fmglb = 0._r8 + + len = nmlonp1*nmlat*nf +! +! Load send buffer with my subdomain: + do ifld=1,nf + do j=mlat0,mlat1 + do i=mlon0, mlon1 + sndbuf(i,j,ifld) = fmsub(i,j,ifld) + enddo + enddo + enddo + +! +! Gather to root by using scalable reduce method: + + call mpi_reduce(sndbuf, fmglb, len, MPI_REAL8, MPI_SUM, 0, mpi_comm_edyn, ier ) + if (ier /= 0) call handle_mpi_err(ier,'mp_gather_edyn: mpi_gather to root') + + end subroutine mp_gather_edyn +!----------------------------------------------------------------------- + subroutine mp_scatter_phim(phim_glb,phim) + real(r8),intent(in) :: phim_glb(nmlonp1,nmlat) + real(r8),intent(out) :: phim(mlon0:mlon1,mlat0:mlat1) +! +! Local: + integer :: ier,len,i,j + +! if (mpi_timing) starttime = mpi_wtime() +! +! Broadcast global phim (from pdynamo phim(nmlonp1,nmlat)): + len = nmlat*nmlonp1 + call mpi_bcast(phim_glb,len,MPI_REAL8,0,mpi_comm_edyn,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatter_phim: bcast global phim') +! +! Define subdomains: + do j=mlat0,mlat1 + do i=mlon0,mlon1 + phim(i,j) = phim_glb(i,j) + enddo + enddo + + end subroutine mp_scatter_phim +!----------------------------------------------------------------------- + subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, & + fout,jneed,mxneed,nf) +! +! Current task needs to receive (from other tasks) field f at (non-zero) +! latitude indices in jneed, at all longitudes in the current subdomain. +! Note subdomains include halo points mlon0-1 and mlat1+1. Data in f also +! includes halo points (will need the lat data at halo-longitudes) +! +! Args: + integer,intent(in) :: mlon00,mlon11,mlat00,mlat11 ! subdomains w/ halos + integer,intent(in) :: nf ! number of fields + integer,intent(in) :: mxneed ! max number of needed lats (nmlat+2) + integer,intent(in) :: jneed(mxneed) ! j-indices of needed lats (where /= -1) + real(r8),intent(in) :: fin(mlon00:mlon11,mlat00:mlat11,nf) ! data at current subdomain + real(r8),intent(out) :: fout(mlon00:mlon11,mxneed,nf) ! returned data at needed lats + ! + ! Local: + integer,parameter :: sndbuf_cntr_max = 10 ! Maximum number of ibsend from one mpi task + integer :: ier,njneed,i,j,n,nj,idest, & + icount,len,nlons,isrc,msgid,ifld,sndbuf_cntr + integer :: tij ! rank in cols_comm (0 to nmagtaskj-1) + integer :: jhave(mxneed),njhave,wid + integer :: peersneed(mxneed,0:nmagtaskj-1) + integer :: jneedall (mxneed,0:nmagtaskj-1) + real(r8) :: sndbuf(mxmaglon+2,mxneed,nf,sndbuf_cntr_max) + real(r8) :: rcvbuf(mxmaglon+2,mxneed,nf) + real(r8) :: buffer((mxmaglon+2)*mxneed*nf*sndbuf_cntr_max) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: isstat(MPI_STATUS_SIZE,sndbuf_cntr_max) !mpi_ibsend wait status + integer :: ibsend_requests(sndbuf_cntr_max) !array of ibsend requests + + sndbuf = 0._r8 + rcvbuf = 0._r8 + njneed = 0 + ibsend_requests = 0 + sndbuf_cntr = 0 + do j=1,mxneed + if (jneed(j) /= -1) njneed=njneed+1 + enddo + if (any(jneed(1:njneed)==-1)) call endrun('mp_mag_jslot jneed') + ! + call MPI_Comm_rank(cols_comm,tij,ier) + call MPI_buffer_attach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_attach') + + ! + ! Send needed lat indices to all tasks in my column: + ! (redundant for alltoall) + do n=0,nmagtaskj-1 + jneedall(:,n) = jneed(:) + enddo + + call mpi_alltoall(jneedall,mxneed,MPI_INTEGER, & + peersneed,mxneed,MPI_INTEGER,cols_comm,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_alltoall') + ! + ! Check if I have any needed lats, and who to send to: + do n=0,nmagtaskj-1 + if (n==tij) cycle + njhave = 0 + do j=1,mxneed + if (peersneed(j,n) >= mlat00.and.peersneed(j,n) <= mlat11)then + njhave = njhave+1 + jhave(njhave) = peersneed(j,n) + idest = n + wid = itask_table_geo(mytidi,idest) + endif + enddo + if (njhave > 0) then + + sndbuf_cntr = sndbuf_cntr + 1 + if (sndbuf_cntr > sndbuf_cntr_max) call endrun('sndbuf_cntr exceeded sndbuf_cntr_max') + + ! + ! Load send buffer: + nlons = mlon11-mlon00+1 + do ifld=1,nf + do j=1,njhave + do i=mlon00,mlon11 + sndbuf(i-mlon00+1,j,ifld,sndbuf_cntr) = fin(i,jhave(j),ifld) + enddo + enddo + enddo + len = nlons*njhave*nf + msgid = mytid+wid*10000 + call mpi_ibsend(sndbuf(1:nlons,1:njhave,:,sndbuf_cntr),len,MPI_REAL8, & + idest,msgid,cols_comm,ibsend_requests(sndbuf_cntr),ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_ibsend') + endif + enddo ! n=0,nmagtaskj-1 + + call MPI_waitall(sndbuf_cntr,ibsend_requests,isstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_waitall') + call MPI_buffer_detach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_detach') + + ! + ! Determine which tasks to receive which lats from. Task to + ! receive from must be in same task column magtidi as I am. + if (njneed > 0) then + njhave = 0 + jhave(:) = -1 + do n=0,ntask-1 + njhave = 0 + do j=1,njneed + if (jneed(j) >= tasks(n)%mlat0-1 .and. & + jneed(j) <= tasks(n)%mlat1+1) then + njhave = njhave+1 + jhave(njhave) = jneed(j) + endif + enddo + if (njhave > 0 .and. tasks(n)%magtidi==magtidi) then + isrc = tasks(n)%magtidj ! task id in cols_comm to recv from + nlons = mlon11-mlon00+1 + len = nlons*njhave*nf + msgid = mytid*10000+n + rcvbuf = 0._r8 + call mpi_recv(rcvbuf(1:nlons,1:njhave,:),len,MPI_REAL8, & + isrc,msgid,cols_comm,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_recv') + ! + ! Get data from receive buffer: + ! real,intent(out) :: fout(mlon00:mlon11,mxneed) ! returned data at needed lats + do ifld=1,nf + do j=1,njhave + nj = ixfind(jneed,mxneed,jhave(j),icount) + if (nj==0) call endrun('jhave(j) not in jneed') + do i=mlon00,mlon11 + fout(i,nj,ifld) = rcvbuf(i-mlon00+1,j,ifld) + enddo + enddo ! j=1,njhave + enddo ! ifld=1,nf + endif ! jhave > 0 + enddo ! n=0,ntask-1 + endif ! njneed > 0 + + end subroutine mp_mag_jslot +!----------------------------------------------------------------------- + subroutine mp_gatherlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) +! +! Gather longitude data in a row of tasks to leftmost task in the row. +! On entry f(k0:k1,i0:i1,j0:j1,nflds) is defined for current task. +! On exit f(k0:k1,nlonp4,j0:j1,nflds) is defined for task with mytidi==0. +! + +! +! Args: +! + integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds +! real(r8),intent(inout) :: f(k0:k1,nlon,j0:j1,nflds) + type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) +! +! Local: +! + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: j,n,nlons,nlonrecv,nlevs,len,idest,isrc,ier, & + isend,irecv,itask,lonrecv0,lonrecv1,mtag + real(r8) :: & + sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer + rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer +! +! Exec: +! + nlons = i1-i0+1 + nlevs = k1-k0+1 + + sndbuf = 0._r8 + rcvbuf = 0._r8 + len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos +! +! If mytidi==0, receive from other tasks in my row (mytidi>0,mytidj): + if (mytidi == 0) then + do itask=1,ntaski-1 + isrc = itask_table_geo(itask,mytidj) + mtag = isrc+mytid + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d recv fm isrc') + call mpi_wait(irecv,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d wait for recv0') +! +! Copy data from receive buffer: + lonrecv0 = tasks(isrc)%lon0 + lonrecv1 = tasks(isrc)%lon1 + nlonrecv = lonrecv1-lonrecv0+1 + do n=1,nflds + do j=j0,j1 + f(n)%ptr(k0:k1,lonrecv0:lonrecv1,j) = rcvbuf(k0:k1,1:nlonrecv,j-j0+1,n) + enddo ! j=j0,j1 + enddo ! n=1,nflds + enddo ! itask=1,ntaski-1 +! +! If mytidi > 0, load send buffer, and send to task (0,mytidj): + else ! mytidi /= 0 + idest = itask_table_geo(0,mytidj) + do n=1,nflds + do j=j0,j1 + sndbuf(:,1:nlons,j-j0+1,n) = f(n)%ptr(k0:k1,i0:i1,j) + enddo ! j=j0,j1 + enddo ! n=1,nflds + mtag = idest+mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d send0 to idest') + call mpi_wait(isend,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d wait for send0') + endif ! mytidi==0 + end subroutine mp_gatherlons_f3d +!----------------------------------------------------------------------- + subroutine mp_scatterlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) +! +! Redistribute longitudes from left most task in j-row to other tasks +! in the row. +! On input, f(:,nlonp4,j0:j1,nflds) is defined for tasks with mytidi==0. +! On output, f(:,i0:i1,j0:j1,nflds) is defined for all tasks. +! +! Args: +! + integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds + type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) +! +! Local: +! + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: j,n,nlevs,nlons,nlonsend,len,idest,isrc,ier, & + isend,irecv,itask,lonsend0,lonsend1,mtag + real(r8) :: & + sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer + rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer +! +! Exec: +! + nlons = i1-i0+1 + nlevs = k1-k0+1 + + sndbuf = 0._r8 ; rcvbuf = 0._r8 + len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos +! +! If mytidi==0, send to other tasks in my row (mytidi>0,mytidj): + if (mytidi == 0) then + do itask=1,ntaski-1 + idest = itask_table_geo(itask,mytidj) + lonsend0 = tasks(idest)%lon0 + lonsend1 = tasks(idest)%lon1 + nlonsend = lonsend1-lonsend0+1 + mtag = idest+mytid + do n=1,nflds + do j=j0,j1 + sndbuf(:,1:nlonsend,j-j0+1,n) = f(n)%ptr(:,lonsend0:lonsend1,j) + enddo ! j=j0,j1 + enddo ! n=1,nflds + mtag = idest+mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d send to idest') + call mpi_wait(isend,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d wait for send') + enddo ! itask=1,ntaski-1 +! +! If mytidi > 0, receive from task (0,mytidj): + else + isrc = itask_table_geo(0,mytidj) + mtag = isrc+mytid + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatterlons_f3d recv fm isrc') + call mpi_wait(irecv,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatterlons_f3d wait for recv') + do n=1,nflds + do j=j0,j1 + f(n)%ptr(:,i0:i1,j) = rcvbuf(:,1:nlons,j-j0+1,n) + enddo ! j=j0,j1 + enddo ! n=1,nflds + endif + end subroutine mp_scatterlons_f3d +!----------------------------------------------------------------------- + subroutine handle_mpi_err(ierrcode,string) +! +! Args: + integer,intent(in) :: ierrcode + character(len=*) :: string +! +! Local: + character(len=80) :: errstring + integer :: len_errstring, ierr +! + call mpi_error_string(ierrcode,errstring,len_errstring, ierr) + write(iulog,"(/,'>>> mpi error: ',a)") trim(string) + write(iulog,"(' ierrcode=',i3,': ',a)") trim(errstring) + end subroutine handle_mpi_err +!----------------------------------------------------------------------- + integer function ixfind(iarray,idim,itarget,icount) +! +! Search iarray(idim) for itarget, returning first index in iarray +! where iarray(idim)==target. Also return number of elements of +! iarray that == itarget in icount. +! +! Args: + integer,intent(in) :: idim,itarget + integer,intent(in) :: iarray(idim) + integer,intent(out) :: icount +! +! Local: + integer :: i +! + ixfind = 0 + icount = 0 + if (.not.any(iarray==itarget)) return + icount = count(iarray==itarget) + do i=1,idim + if (iarray(i)==itarget) then + ixfind = i + exit + endif + enddo + end function ixfind + +!----------------------------------------------------------------------- + subroutine setpoles(f,k0,k1,i0,i1,j0,j1) +! +! Args: + integer,intent(in) :: k0,k1,i0,i1,j0,j1 + real(r8),intent(inout) :: f(k0:k1,i0:i1,j0:j1) +! +! Local: + integer :: i,j,k,lon0,lon1,it,itask + type(array_ptr_type) :: ptr(1) + real(r8) :: fave(k0:k1) + real(r8) :: rnlon + + if (j0 /= 1 .and. j1 /= nlat) return ! subdomain does not include poles + + rnlon = dble(nlon) + allocate(ptr(1)%ptr(k0:k1,nlon,j0:j1)) +! +! Define subdomains in global longitude dimension of ptmp: +! + do j=j0,j1 + do i=i0,i1 + ptr(1)%ptr(k0:k1,i,j) = f(k0:k1,i,j) + enddo + enddo +! +! Get values for global longitudes at the latitude below each pole, +! average them at each level, and assign the average redundantly +! to all lons at each pole. +! + call mp_gatherlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) +! + if (mytidi==0) then ! only westernmost tasks have global longitudes + + if (j0 == 1) then ! subdomain includes south pole + fave(:) = 0._r8 +! +! Find average of all lons at each level, at first lat equatorward of south pole. +! + do k=k0,k1 + do i=1,nlon + fave(k) = fave(k)+ptr(1)%ptr(k,i,j0+1) + enddo + fave(k) = fave(k) / rnlon + enddo + if (debug.and.masterproc) write(iulog,"('setpoles: spole ave(k0:k1)=',/,(8es12.4))") fave +! +! Define south pole in ptmp on subdomains for each tasks in my latitude row +! (I am SW corner task): +! + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + lon0 = tasks(itask)%lon0 + lon1 = tasks(itask)%lon1 + do k=k0,k1 + ptr(1)%ptr(k,lon0:lon1,j0) = fave(k) ! all lons get the average + enddo + enddo + endif ! south pole + + if (j1 == nlat) then ! subdomain includes north pole + fave(:) = 0._r8 +! +! Find average of all lons at each level, at first lat equatorward of north pole. +! + do k=k0,k1 + do i=1,nlon + fave(k) = fave(k)+ptr(1)%ptr(k,i,j1-1) + enddo + fave(k) = fave(k) / rnlon + enddo + if (debug.and.masterproc) write(iulog,"('setpoles: npole fave(k0:k1)=',/,(8es12.4))") fave +! +! Define north pole in ptmp on subdomains for each tasks in my latitude row +! (I am NW corner task): +! + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + lon0 = tasks(itask)%lon0 + lon1 = tasks(itask)%lon1 + do k=k0,k1 + ptr(1)%ptr(k,lon0:lon1,j1) = fave(k) + enddo + enddo + endif ! north pole + endif ! mytidj==0 +! +! Scatter to tasks in my latitude row: +! + call mp_scatterlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) +! +! Define poles on current subdomain inout arg array: +! + if (j0==1) then + do i=i0,i1 + do k=k0,k1 + f(k,i,j0) = ptr(1)%ptr(k,i,j0) + enddo + enddo + endif + if (j1==nlat) then + do i=i0,i1 + do k=k0,k1 + f(k,i,j1) = ptr(1)%ptr(k,i,j1) + enddo + enddo + endif + deallocate(ptr(1)%ptr) + end subroutine setpoles +!----------------------------------------------------------------------- + subroutine lonshift_blocks(f,k0,k1,i0,i1,j0,j1,nfields) +! +! On input, field(s) f are in subdomains +! On output, field(s) f subdomain longitudes are shifted by 180 degrees +! (either 0->360 to -180->+180, or the reverse) +! + use edyn_geogrid ,only: nlon +! +! Args: + integer :: k0,k1,i0,i1,j0,j1,nfields + type(array_ptr_type) :: f(nfields) ! f(n)%ptr(k0:k1,i0:i1,j0:j1) +! +! Local variables +! + integer :: i,j,k,ifield + integer :: midpoint ! middle point of longitude dimension + real(r8) :: flons(nlon) ! fields at global longitudes + type(array_ptr_type) :: pglblon(nfields) ! pglblon(n)%ptr(k0:k1,nlon,j0:j1) +! +! Shift longitude grid from 0 to 360 to -180 to 180 for edynamo +! Check for compatible geographic longitude dimension and quit if not compatible +! + if (nlon /= 144 .and. nlon /= 80 .and. nlon /= 72 .and. nlon /= 24) then + write(iulog,"('ERROR lonshift_blocks: incompatible nlon = ',i5,' i0,i1=',2i4)") nlon,i0,i1 + call endrun + end if +! +! Load subdomains into local global longitude pointer: + do ifield=1,nfields + allocate(pglblon(ifield)%ptr(k0:k1,nlon,j0:j1)) + do j=j0,j1 + do i=i0,i1 + pglblon(ifield)%ptr(k0:k1,i,j) = f(ifield)%ptr(k0:k1,i,j) + enddo + enddo + enddo + + call mp_gatherlons_f3d(pglblon,k0,k1,i0,i1,j0,j1,nfields) +! +! Only leftmost tasks (mytidi=0) at each latitude does the longitude shift for that latitude +! + if (mytidi==0) then + do j=j0,j1 + midpoint = nlon/2 + do ifield = 1,nfields + do k = k0,k1 + flons(:) = pglblon(ifield)%ptr(k,1:nlon,j) + flons = cshift(flons,midpoint) + pglblon(ifield)%ptr(k,1:nlon,j) = flons(:) + enddo ! k0,k1 + enddo ! nfields + enddo ! j=j0,j1 + endif ! mytidi==0 +! +! Now leftmost task at each j-row must redistribute filtered data +! back to other tasks in the j-row (mytidi>0,mytidj) (includes latitude): +! + call mp_scatterlons_f3d(pglblon,k0,k1,i0,i1,j0,j1,nfields) +! +! Update fields argument: + do ifield=1,nfields + do j=j0,j1 + do i=i0,i1 + f(ifield)%ptr(k0:k1,i,j) = pglblon(ifield)%ptr(k0:k1,i,j) + enddo + enddo + enddo + + do ifield=1,nfields + deallocate(pglblon(ifield)%ptr) + enddo + end subroutine lonshift_blocks +!----------------------------------------------------------------------- + subroutine switch_model_format(fptr,k0,k1,i0,i1,j0,j1,nfields) +! +! fptr is array of pointer structures to nfields fields. Convert these +! fields in "model format", i.e., phase shift longitude data by 180 degrees, +! and invert the vertical dimension. This may be converting from WACCM to +! TIEGCM, or the reverse. It is up to the calling routine to keep track of +! which model format the data is being converted from/to. +! (This routine does not do unit conversion on the fields) +! +! Args: + integer,intent(in) :: k0,k1,i0,i1,j0,j1,nfields +! +! Pointer structures to each field: + type(array_ptr_type) :: fptr(nfields) ! (fptr(n)%ptr(k0:k1,i0:i1,j0:j1)) +! +! Local: + integer :: ifield +! +! Phase shift longitudes by 180 degrees: +! + call lonshift_blocks(fptr,k0,k1,i0,i1,j0,j1,nfields) +! +! Invert vertical dimension: +! + do ifield=1,nfields + fptr(ifield)%ptr(k0:k1,i0:i1,j0:j1) = fptr(ifield)%ptr(k1:k0:-1,i0:i1,j0:j1) + enddo + end subroutine switch_model_format +!----------------------------------------------------------------------- +end module edyn_mpi diff --git a/src/ionosphere/waccmx/edyn_mud.F90 b/src/ionosphere/waccmx/edyn_mud.F90 new file mode 100644 index 0000000000..614fd52b9a --- /dev/null +++ b/src/ionosphere/waccmx/edyn_mud.F90 @@ -0,0 +1,1403 @@ +!----------------------------------------------------------------------- + subroutine mud(pe,jntl,isolve) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun + use edyn_solve,only: nc,ncee,cee +! + implicit none + integer,intent(in) :: isolve + integer jntl +! +! set grid size params +! + integer,parameter :: iixp = 5 , jjyq = 3, iiex = 5, jjey = 5 + integer,parameter :: nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1 +! +! estimate work space for point relaxation (see mud2cr.d) +! + integer,parameter :: llwork=(7*(nnx+2)*(nny+2)+76*nnx*nny)/3 + real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) + real(r8) :: time0,time1 +! +! put integer and floating point argument names in contiguous +! storage for labelling in vectors iprm,fprm +! +! btf 1/21/14: dimension iprm(17) to match iprm in edyn_muh2cr.F90 +! integer iprm(16),mgopt(4) + integer iprm(17),mgopt(4) + real(r8) :: fprm(6) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny, & + iguess,maxcy,method,nwork,lwrkqd,itero + common/itmud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny, & + iguess,maxcy,method,nwork,lwrkqd,itero + real(r8) :: xa,xb,yc,yd,tolmax,relmax + common/ftmud2cr/xa,xb,yc,yd,tolmax,relmax + equivalence(intl,iprm) + equivalence(xa,fprm) + integer i,j,ierror + real(r8) :: PE(NNX,1) + integer maxcya + DATA MAXCYA/150/ + integer mm,nn,jj,jjj + real(r8) :: pi +! +! set input integer arguments +! + MM = NNX + NN = NNY + PI = 4._r8*ATAN(1._r8) +! +! SET INPUT INTEGER PARAMETERS +! + INTL = JNTL +! +! set boundary condition flags +! + nxa = 0 + nxb = 0 + nyc = 2 + nyd = 1 +! +! set grid sizes from parameter statements +! + ixp = iixp + jyq = jjyq + iex = iiex + jey = jjey + nx = nnx + ny = nny +! +! set multigrid arguments (w(2,1) cycling with fully weighted +! residual restriction and cubic prolongation) +! + mgopt(1) = 2 + mgopt(2) = 2 + mgopt(3) = 1 + mgopt(4) = 3 +! +! set for one cycle +! + maxcy = maxcya +! +! set no initial guess forcing full multigrid cycling +! + iguess = 0 +! +! set work space length approximation from parameter statement +! + nwork = llwork +! +! set line z relaxation +! + method = 3 +! +! set end points of solution rectangle in (x,y) space +! + xa = -pi + xb = pi + yc = 0.0_r8 + yd = 0.5_r8*pi +! +! set error control flag +! + tolmax = 0.01_r8 +! +! set right hand side in rhs +! initialize phi to zero +! + if (isolve >= 0) then ! called from dynamo + do i=1,nx + do j=1,ny + RHS(I,J) = CEE(I+(J-1)*NX+9*NX*NY) + phi(i,j) = 0.0_r8 + end do + end do +! +! set specified boundaries in phi +! + DO I=1,NX + PHI(I,NY) = RHS(I,NY)/CEE(I+(NY-1)*NX+8*NX*NY) + END DO +! +! set specified boundaries in phi +! + endif ! isolve +! +! intialization call +! + call mud2cr(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) + if (ierror.gt.0) call endrun('mud call init mud2cr') +! +! attempt solution +! + intl = 1 + call mud2cr(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) + if (ierror.gt.0) call endrun('mud call solve mud2cr') +! +! COPY PHI TO PE +! + DO J = 1,NY + JJ = NY+J-1 + JJJ = NY+1-J + DO I = 1,NX + PE(I,JJ) = PHI(I,J) + PE(I,JJJ) = PHI(I,J) + END DO + END DO +! ITRANS = 0 +! CALL EZCNTR(PE(1,JMX0),IMX0,JMX0) +! ITRANS = 1 +! CALL SET(.05,.95,.05,.95,-1.,1.,-1.,1.,1) +! CALL CONREC(PE(1,JMX0),IMX0,IMX0,JMX0,0.,0.,0.,1,0,-1430B) +! CALL FRAME +! ITRANS = 0 +! CALL EZCNTR(PE(1,JMX0),IMX0,JMX0) +! ITRANS = 1 + end subroutine mud +!----------------------------------------------------------------------- +! +! file mud2cr.f (version 4.0 modified for Cicley 2/99) +! . +! . MUDPACK version 4.0 . +! . . +! ... author and specialist +! +! John C. Adams (National Center for Atmospheric Research) (retired) +! +! ... For MUDPACK information, visit the website: +! (https://www2.cisl.ucar.edu/resources/legacy/mudpack) +! +! ... purpose +! +! mud2cr attempts to produce a second order finite difference +! approximation to the two dimensional nonseparable elliptic +! partial differential equation with cross derivative +! +! cxx(x,y)*pxx + cxy(x,y)*pxy + cyy(x,y)*pyy + +! +! cx(x,y)*px + cy(x,y)*py + ce(x,y)*pe(x,y) = r(x,y) +! +! ... documentation +! +! see the documentation on above website for a complete discussion +! of how to use subroutine mud2cr. +! +! ... required MUDPACK files +! +! mudcom.f +! +! +! + subroutine mud2cr(iparm,fparm,work,rhs,phi,mgopt, & + ierror,isolve) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer,intent(in) :: isolve + integer iparm,mgopt,ierror + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: fparm,xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer int,iw,k,kb,nx,ny,ic,itx,ity + dimension iparm(17),fparm(6),mgopt(4) + real(r8) :: work(*),phi(*),rhs(*) + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50), & + nxk(50),nyk(50),isx,jsy + data int / 0 / + save int +! + ierror = 1 + intl = iparm(1) ! set and check intl on all calls + if (intl*(intl-1).ne.0) return + if (int.eq.0) then + int = 1 + if (intl.ne.0) return ! very first call is not intl=0 + end if + ierror = 0 +! +! set arguments internally +! these will not be rechecked if intl=1! +! + nxa = iparm(2) + nxb = iparm(3) + nyc = iparm(4) + nyd = iparm(5) + ixp = iparm(6) + jyq = iparm(7) + iex = iparm(8) + jey = iparm(9) + ngrid = max0(iex,jey) + nfx = iparm(10) + nfy = iparm(11) + iguess = iparm(12) + maxcy = iparm(13) + method = iparm(14) + nwork = iparm(15) + kcycle = mgopt(1) + if (kcycle .eq. 0) then +! set defaults + kcycle = 2 + iprer = 2 + ipost = 1 + intpol = 3 + else + iprer = mgopt(2) + ipost = mgopt(3) + intpol = mgopt(4) + end if + xa = fparm(1) + xb = fparm(2) + yc = fparm(3) + yd = fparm(4) + tolmax = fparm(5) + if (intl .eq. 0) then ! intialization call +! +! check input arguments +! + ierror = 2 ! check boundary condition flags + if (max0(nxa,nxb,nyc,nyd).gt.2) return + if (min0(nxa,nxb,nyc,nyd).lt.0) return + if (nxa.eq.0.and.nxb.ne.0) return + if (nxa.ne.0.and.nxb.eq.0) return + if (nyc.eq.0.and.nyd.ne.0) return + if (nyc.ne.0.and.nyd.eq.0) return + ierror = 3 ! check grid sizes + if (ixp.lt.2) return + if (jyq.lt.2) return + ierror = 4 + ngrid = max0(iex,jey) + if (iex.lt.1) return + if (jey.lt.1) return + if (ngrid.gt.50) return + ierror = 5 + if (nfx.ne.ixp*2**(iex-1)+1) return + if (nfy.ne.jyq*2**(jey-1)+1) return + ierror = 6 + if (iguess*(iguess-1).ne.0) return + ierror = 7 + if (maxcy.lt.1) return + ierror = 8 + if (method.lt.0 .or. method.gt.3) return + ierror = 9 +! compute and test minimum work space + isx = 0 + if (method.eq.1 .or. method.eq.3) then + if (nxa.ne.0) isx = 3 + if (nxa.eq.0) isx = 5 + end if + jsy = 0 + if (method.eq.2 .or. method.eq.3) then + if (nyc.ne.0) jsy = 3 + if (nyc.eq.0) jsy = 5 + end if + kps = 1 + do k=1,ngrid +! set subgrid sizes + nxk(k) = ixp*2**(max0(k+iex-ngrid,1)-1)+1 + nyk(k) = jyq*2**(max0(k+jey-ngrid,1)-1)+1 + nx = nxk(k) + ny = nyk(k) + kps = kps+(nx+2)*(ny+2)+nx*ny*(10+isx+jsy) + end do + iparm(16) = kps+(nfx+2)*(nfy+2) ! exact minimum work space + lwork = iparm(16) + if (lwork .gt. nwork) return + ierror = 10 ! check solution region + if (xb.le.xa .or. yd.le.yc) return + ierror = 11 + if (tolmax .lt. 0.0_r8) return + ierror = 12 ! multigrid parameters + if (kcycle.lt.0) return + if (min0(iprer,ipost).lt.1) return + if ((intpol-1)*(intpol-3).ne.0) return + if (max0(kcycle,iprer,ipost).gt.2) then + ierror = -5 ! inefficient multigrid cycling + end if + if (ierror .gt. 0) ierror = 0 ! no fatal errors +! +! set work space pointers and discretize pde at each grid level +! + iw = 1 + do kb=1,ngrid + k = ngrid-kb+1 + nx = nxk(k) + ny = nyk(k) + kpbgn(k) = iw + kcbgn(k) = kpbgn(k)+(nx+2)*(ny+2) + ktxbgn(k) = kcbgn(k)+10*nx*ny + ktybgn(k) = ktxbgn(k)+isx*nx*ny + iw = ktybgn(k)+jsy*nx*ny + ic = kcbgn(k) + itx = ktxbgn(k) + ity = ktybgn(k) + klevel = k + call dismd2cr(nx,ny,work(ic),work(itx),work(ity), & + work,ierror,isolve) + end do + return + end if ! end of intl=0 initialization call block + nx = nfx + ny = nfy + call mud2cr1(nx,ny,rhs,phi,work) + iparm(17) = itero + if (tolmax.gt.0.0_r8) then ! check for convergence + fparm(6) = relmax + if (relmax.gt.tolmax) ierror = -1 ! flag convergenc failure + end if + return + end subroutine mud2cr +!----------------------------------------------------------------------- + subroutine mud2cr1(nx,ny,rhsf,phif,wk) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny + real(r8) :: phif(nx,ny),rhsf(nx,ny),wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax,phmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer k,kb,ip,ic,ir,ipc,irc,icc + integer ncx,ncy,jj,ij,i,j,iter + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50),& + nxk(50),nyk(50),isx,jsy + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + ir = ic+9*nx*ny +! +! set phif,rhsf in wk and adjust right hand side +! + call swk2(nx,ny,phif,rhsf,wk(ip),wk(ir)) + if (iguess.eq.0) then +! +! no initial guess at finest grid level! +! + do kb=2,ngrid + k = ngrid-kb+1 + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ir = kcbgn(k+1)+9*nx*ny + ncx = nxk(k) + ncy = nyk(k) + ipc = kpbgn(k) + icc = kcbgn(k) + irc = icc+9*ncx*ncy +! +! transfer down to all grid levels +! + call trsfc2(nx,ny,wk(ip),wk(ir),ncx,ncy,& + wk(ipc),wk(irc)) + end do +! +! adjust right hand side at all grid levels in case +! rhs or specified b.c. in phi or gbdy changed +! + do k=1,ngrid + nx = nxk(k) + ny = nyk(k) + ip = kpbgn(k) + ic = kcbgn(k) + call adjmd2cr(nx,ny,wk(ip),wk(ic)) + end do +! +! execute one full multigrid cycle +! + do k=1,ngrid-1 + kcur = k + call kcymd2cr(wk) + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ipc = kpbgn(k) + ncx = nxk(k) + ncy = nyk(k) +! +! lift or prolong approximation from k to k+1 +! + call prolon2(ncx,ncy,wk(ipc),nx,ny,wk(ip),nxa,nxb,& + nyc,nyd,intpol) + end do + else +! +! adjust rhs at finest grid level only +! + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + call adjmd2cr(nx,ny,wk(ip),wk(ic)) + end if +! +! execute maxcy more multigrid k cycles from finest level +! + kcur = ngrid + do iter=1,maxcy + itero = iter + call kcymd2cr(wk) + if (tolmax.gt.0.0_r8) then +! +! error control +! + relmax = 0.0_r8 + phmax = 0.0_r8 + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 +! phmax = amax1(phmax,abs(wk(ij))) +! relmax = amax1(relmax,abs(wk(ij)-phif(i,j))) + phmax = max(phmax,abs(wk(ij))) + relmax = max(relmax,abs(wk(ij)-phif(i,j))) + phif(i,j) = wk(ij) + end do + end do +! +! set maximum relative difference and check for convergence +! + if (phmax.gt.0.0_r8) relmax = relmax/phmax + if (relmax.le.tolmax) return + end if + end do +! +! set final interate after maxcy cycles in phif +! + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 + phif(i,j) = wk(ij) + end do + end do + return + end subroutine mud2cr1 +!----------------------------------------------------------------------- + subroutine kcymd2cr(wk) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! execute multigrid k cycle from kcur grid level +! kcycle=1 for v cycles, kcycle=2 for w cycles +! + implicit none + real(r8) :: wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ip,ic,ipc,irc,itx,ity,ncx,ncy,l,nrel + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50),& + nxk(50),nyk(50),isx,jsy + integer kount(50) + klevel = kcur + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) +! +! prerelax at current finest grid level +! + do l=1,iprer + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + if (kcur .eq. 1) go to 5 +! +! restrict residual to kcur-1 level +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy + call resmd2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic),wk(kps)) +! +! set counter for grid levels to zero +! + do l = 1,kcur + kount(l) = 0 + end do +! +! set new grid level and continue k-cycling +! + klevel = kcur-1 + nrel = iprer +! +! kcycle control point +! + 10 continue +! +! post relax when kcur revisited +! + if (klevel .eq. kcur) go to 5 +! +! count hit at current level +! + kount(klevel) = kount(klevel)+1 +! +! relax at current level +! + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) + do l=1,nrel + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + if (kount(klevel) .eq. kcycle+1) then +! +! kcycle complete at klevel +! + ipc = ip + ip = kpbgn(klevel+1) + ncx = nxk(klevel) + ncy = nyk(klevel) + nx = nxk(klevel+1) + ny = nyk(klevel+1) +! +! inject correction to finer grid +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd,& + intpol,wk(kps)) +! +! reset counter to zero +! + kount(klevel) = 0 +! +! ascend to next higher level and set to postrelax there +! + klevel = klevel+1 + nrel = ipost + go to 10 + else + if (klevel .gt. 1) then +! +! kcycle not complete so descend unless at coarsest grid +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy + call resmd2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic),& + wk(kps)) +! +! prerelax at next coarser level +! + klevel = klevel-1 + nrel = iprer + go to 10 + else +! +! postrelax at coarsest level +! + do l=1,ipost + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + ipc = ip + ip = kpbgn(2) + ncx = nxk(1) + ncy = nyk(1) + nx = nxk(2) + ny = nyk(2) +! +! inject correction to level 2 +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd,& + intpol,wk(kps)) +! +! set to postrelax at level 2 +! + nrel = ipost + klevel = 2 + go to 10 + end if + end if + 5 continue +! +! post relax at current finest grid level +! + nx = nxk(kcur) + ny = nyk(kcur) + ip = kpbgn(kcur) + ic = kcbgn(kcur) + itx = ktxbgn(kcur) + ity = ktybgn(kcur) + do l=1,ipost + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + return + end subroutine kcymd2cr +!----------------------------------------------------------------------- + subroutine dismd2cr(nx,ny,cf,tx,ty,wk,ier,isolve) + use edyn_solve,only: nc,ncee,cee,ceee + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun +! +! discretize elliptic pde for mud2cr, set nonfatal errors +! + implicit none + integer,intent(in) :: isolve + integer nx,ny,i,j,l,im1,jm1,ier,nnx,nny + real(r8) :: cf(nx,ny,10),tx(nx,ny,*),ty(ny,nx,*) + real(r8) :: wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + + real(r8) :: xa,xb,yc,yd,tolmax,relmax + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax +! +! CHECK FOR CONSISTENCYT WRT KLEVEL +! + NNX = ixp*2**(KLEVEL-1)+1 + NNY = jyq*2**(KLEVEL-1)+1 + IF(NNX.NE.NX.OR.NNY.NE.NY)THEN + call endrun('dismd2cr in mud') + ENDIF + if (isolve >= 0) then + call ceee(cee(nc(6-klevel)),nx,ny,cf) + endif +! +! set coefficient for specified boundaries +! + if (nxa.eq.1) then + i = 1 + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nxb.eq.1) then + i = nx + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyc.eq.1) then + j = 1 + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyd.eq.1) then + j = ny + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if +! +! set and factor tridiagonal matrices for line relaxation(s) if flagged +! + if (method.eq.1.or.method.eq.3) then + if (nxa.ne.0) then +! +! nonperiodic x line relaxation +! + do i=1,nx + im1 = max0(i-1,1) + do j=1,ny + tx(im1,j,1) = cf(i,j,5) + tx(i,j,2) = cf(i,j,9) + tx(i,j,3) = cf(i,j,1) + end do + end do + call factri(ny,nx,tx(1,1,1),tx(1,1,2),tx(1,1,3)) + else +! +! periodic x line relaxation +! + if (nx .gt. 3) then +! +! set and factor iff nx > 3 +! + do i=1,nx-1 + do j=1,ny + tx(i,j,1) = cf(i,j,5) + tx(i,j,2) = cf(i,j,9) + tx(i,j,3) = cf(i,j,1) + end do + end do + call factrp(ny,nx,tx,tx(1,1,2),tx(1,1,3),tx(1,1,4),& + tx(1,1,5),wk(kps)) + end if + end if + end if + + if (method.eq.2.or.method.eq.3) then + if (nyc.ne.0) then +! +! nonperiodic y line relaxation +! + do j=1,ny + jm1 = max0(j-1,1) + do i=1,nx + ty(jm1,i,1) = cf(i,j,7) + ty(j,i,2) = cf(i,j,9) + ty(j,i,3) = cf(i,j,3) + end do + end do + call factri(nx,ny,ty(1,1,1),ty(1,1,2),ty(1,1,3)) + else +! +! periodic y line relaxation +! + if (ny .gt. 3) then +! +! set and factor iff ny > 3 +! + do j=1,ny-1 + do i=1,nx + ty(j,i,1) = cf(i,j,7) + ty(j,i,2) = cf(i,j,9) + ty(j,i,3) = cf(i,j,3) + end do + end do + call factrp(nx,ny,ty,ty(1,1,2),ty(1,1,3),ty(1,1,4),& + ty(1,1,5),wk(kps)) + end if + end if + end if + return + end subroutine dismd2cr +!----------------------------------------------------------------------- + subroutine adjmd2cr(nx,ny,phi,cf) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! adjust righthand side in cf(i,j,10) for boundary conditions +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer nx,ny,i,j + real(r8) :: cf(nx,ny,10),phi(0:nx+1,0:ny+1) + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax +! +! set specified boundaries in rhs from phi +! + if (nxa.eq.1) then + i = 1 + do j=1,ny + cf(i,j,10) = phi(i,j) + end do + end if + if (nxb.eq.1) then + i = nx + do j=1,ny + cf(i,j,10) = phi(i,j) + end do + end if + if (nyc.eq.1) then + j = 1 + do i=1,nx + cf(i,j,10) = phi(i,j) + end do + end if + if (nyd.eq.1) then + j = ny + do i=1,nx + cf(i,j,10) = phi(i,j) + end do + end if + return + end subroutine adjmd2cr +!----------------------------------------------------------------------- + subroutine resmd2cr(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! restrict residual from fine to coarse mesh using fully weighted +! residual restriction +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ncx,ncy,i,j,ic,jc + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: rhsc(ncx,ncy),resf(nx,ny) + real(r8) :: phi(0:nx+1,0:ny+1),phic(0:ncx+1,0:ncy+1) + real(r8) :: cof(nx,ny,10) +! +! set phic zero +! + do jc=0,ncy+1 + do ic=0,ncx+1 + phic(ic,jc) = 0.0_r8 + end do + end do +! +! compute residual on fine mesh in resf +! + do j=1,ny + do i=1,nx + resf(i,j) = cof(i,j,10)-( & + cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)+ & + cof(i,j,9)*phi(i,j)) + end do + end do +! +! restrict resf to coarse mesh in rhsc +! + call res2(nx,ny,resf,ncx,ncy,rhsc,nxa,nxb,nyc,nyd) + return + end subroutine resmd2cr +!----------------------------------------------------------------------- + subroutine relmd2cr(nx,ny,phi,cof,tx,ty,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! relaxation for mud2 +! + implicit none + integer nx,ny + real(r8) :: phi(*),cof(*),tx(*),ty(*),sum(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + if (method.eq.0) then ! point relaxation + call relmd2crp(nx,ny,phi,cof) + else if (method.eq.1) then ! line x relaxation + call slxmd2cr(nx,ny,phi,cof,tx,sum) + else if (method.eq.2) then ! line y relaxation + call slymd2cr(nx,ny,phi,cof,ty,sum) + else if (method.eq.3) then ! line x&y relaxation + call slxmd2cr(nx,ny,phi,cof,tx,sum) + call slymd2cr(nx,ny,phi,cof,ty,sum) + end if + return + end subroutine relmd2cr +!----------------------------------------------------------------------- + subroutine relmd2crp(nx,ny,phi,cof) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! gauss-seidel four color point relaxation +! + implicit none + integer nx,ny,i,j,lcolor,i1,i2,i3,i4,it + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + i1 = 1 + i2 = 4 + i3 = 3 + i4 = 2 +! +! sweep four colored grid points +! + do lcolor=1,4 +!$OMP PARALLEL DO SHARED(i1,cof,phi,nx,ny) PRIVATE(i,j) + do j=1,ny,4 + do i=i1,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!$OMP PARALLEL DO SHARED(i2,cof,phi,nx,ny) PRIVATE(i,j) + do j=2,ny,4 + do i=i2,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!$OMP PARALLEL DO SHARED(i3,cof,phi,nx,ny) PRIVATE(i,j) + do j=3,ny,4 + do i=i3,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!$OMP PARALLEL DO SHARED(i4,cof,phi,nx,ny) PRIVATE(i,j) + do j=4,ny,4 + do i=i4,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +! +! set periodic virtual boundaries as necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if +! +! permute (i1,i2,i3,i4) for next color +! + it = i4 + i4 = i3 + i3 = i2 + i2 = i1 + i1 = it + end do + return + end subroutine relmd2crp +!----------------------------------------------------------------------- + subroutine slxmd2cr(nx,ny,phi,cof,tx,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! line relaxation in the x direction (periodic or nonperiodic) +! + implicit none + + integer nx,ny,i,ib,j,ii + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),tx(nx,ny,*),sum(ny) + real(r8) :: starttime,endtime +! +! replace line x with point gauss-seidel if +! x direction is periodic and nx = 3 (coarsest) +! + if (nxa .eq. 0 .and. nx .eq. 3) then + call relmd2crp(nx,ny,phi,cof) + return + end if +! +! set periodic y virtual boundary if necessary +! + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if + + if (nxa.ne.0) then +! +! x direction not periodic, sweep odd j lines +! +!$OMP PARALLEL DO SHARED(cof,phi,tx,nx,ny) PRIVATE(i,ib,j) + do j=1,ny,2 + do i=1,nx + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx + phi(i,j) = phi(i,j)-tx(i-1,j,1)*phi(i-1,j) + end do +! +! backward sweep +! + phi(nx,j) = phi(nx,j)/tx(nx,j,2) + do ib=2,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j))/tx(i,j,2) + end do + end do +! +! sweep even j lines forward and back +! +!$OMP PARALLEL DO SHARED(cof,phi,tx,nx,ny) PRIVATE(i,ib,j) + do j=2,ny,2 + do i=1,nx + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do i=2,nx + phi(i,j) = phi(i,j)-tx(i-1,j,1)*phi(i-1,j) + end do + phi(nx,j) = phi(nx,j)/tx(nx,j,2) + do ib=2,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j))/tx(i,j,2) + end do + end do + else +! +! x direction periodic +! + do j=1,ny + sum(j) = 0.0_r8 + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do +! +! sweep odd lines forward and back +! +!$OMP PARALLEL DO SHARED(sum,cof,phi,tx,nx,ny) PRIVATE(i,j,ib) + do j=1,ny,2 + do i=1,nx-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx-2 + phi(i,j) = phi(i,j)-tx(i,j,1)*phi(i-1,j) + end do + do i=1,nx-2 + sum(j) = sum(j)+tx(i,j,5)*phi(i,j) + end do + phi(nx-1,j) = phi(nx-1,j)-sum(j) +! +! backward sweep +! + phi(nx-1,j) = phi(nx-1,j)/tx(nx-1,j,2) + phi(nx-2,j) = (phi(nx-2,j)-tx(nx-2,j,4)*phi(nx-1,j))/ & + tx(nx-2,j,2) + do ib=4,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j)-tx(i,j,4)* & + phi(nx-1,j))/tx(i,j,2) + end do + end do +! +! set periodic and virtual points for j odd +! + do j=1,ny,2 + phi(nx,j) = phi(1,j) + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do +! +! sweep even j lines +! +!$OMP PARALLEL DO SHARED(sum,cof,phi,tx,nx,ny) PRIVATE(i,j,ib) + do j=2,ny,2 + do i=1,nx-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx-2 + phi(i,j) = phi(i,j)-tx(i,j,1)*phi(i-1,j) + end do + do i=1,nx-2 + sum(j) = sum(j)+tx(i,j,5)*phi(i,j) + end do + phi(nx-1,j) = phi(nx-1,j)-sum(j) +! +! backward sweep +! + phi(nx-1,j) = phi(nx-1,j)/tx(nx-1,j,2) + phi(nx-2,j) = (phi(nx-2,j)-tx(nx-2,j,4)*phi(nx-1,j))/ & + tx(nx-2,j,2) + do ib=4,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j)-tx(i,j,4)* & + phi(nx-1,j))/tx(i,j,2) + end do + end do +! +! set periodic and virtual points for j even +! + do j=2,ny,2 + phi(nx,j) = phi(1,j) + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if +! +! set periodic y virtual boundaries if necessary +! + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if + return + end subroutine slxmd2cr +!----------------------------------------------------------------------- + subroutine slymd2cr(nx,ny,phi,cof,ty,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + + integer nx,ny,i,j,jb + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),ty(ny,nx,*),sum(nx) + real(r8) :: starttime,endtime +! +! replace line y with point gauss-seidel if +! y direction is periodic and ny = 3 +! + if (nyc .eq. 0 .and. ny .eq. 3) then + call relmd2crp(nx,ny,phi,cof) + return + end if +! +! set periodic and virtual x boundaries if necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx,j) = phi(1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + + if (nyc.ne.0) then +! +! y direction not periodic +! +!$OMP PARALLEL DO SHARED(cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=1,nx,2 + do j=1,ny + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep thru odd x lines +! + do j=2,ny + phi(i,j) = phi(i,j)-ty(j-1,i,1)*phi(i,j-1) + end do +! +! backward sweep +! + phi(i,ny) = phi(i,ny)/ty(ny,i,2) + do jb=2,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1))/ty(j,i,2) + end do + end do +! +! forward sweep even x lines +! +!$OMP PARALLEL DO SHARED(cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=2,nx,2 + do j=1,ny + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny + phi(i,j) = phi(i,j)-ty(j-1,i,1)*phi(i,j-1) + end do +! +! backward sweep +! + phi(i,ny) = phi(i,ny)/ty(ny,i,2) + do jb=2,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1))/ty(j,i,2) + end do + end do + else +! +! y direction periodic +! + do i=1,nx + sum(i) = 0.0_r8 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do +! +! forward sweep odd x lines +! +!$OMP PARALLEL DO SHARED(sum,cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=1,nx,2 + do j=1,ny-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny-2 + phi(i,j) = phi(i,j)-ty(j,i,1)*phi(i,j-1) + end do + do j=1,ny-2 + sum(i) = sum(i)+ty(j,i,5)*phi(i,j) + end do + phi(i,ny-1) = phi(i,ny-1)-sum(i) +! +! backward sweep +! + phi(i,ny-1) = phi(i,ny-1)/ty(ny-1,i,2) + phi(i,ny-2) = (phi(i,ny-2)-ty(ny-2,i,4)*phi(i,ny-1))/ & + ty(ny-2,i,2) + do jb=4,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1)-ty(j,i,4)* & + phi(i,ny-1))/ty(j,i,2) + end do + end do +! +! set odd periodic and virtual y boundaries +! + do i=1,nx,2 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do +! +! forward sweep even x lines +! +!$OMP PARALLEL DO SHARED(sum,cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=2,nx,2 + do j=1,ny-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny-2 + phi(i,j) = phi(i,j)-ty(j,i,1)*phi(i,j-1) + end do + do j=1,ny-2 + sum(i) = sum(i)+ty(j,i,5)*phi(i,j) + end do + phi(i,ny-1) = phi(i,ny-1)-sum(i) +! +! backward sweep +! + phi(i,ny-1) = phi(i,ny-1)/ty(ny-1,i,2) + phi(i,ny-2) = (phi(i,ny-2)-ty(ny-2,i,4)*phi(i,ny-1))/ & + ty(ny-2,i,2) + do jb=4,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1)-ty(j,i,4)* & + phi(i,ny-1))/ty(j,i,2) + end do + end do +! +! set even periodic and virtual y boundaries +! + do i=2,nx,2 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do + end if +! +! set periodic and virtual x boundaries if necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + + return + end subroutine slymd2cr +!----------------------------------------------------------------------- diff --git a/src/ionosphere/waccmx/edyn_mudcom.F90 b/src/ionosphere/waccmx/edyn_mudcom.F90 new file mode 100644 index 0000000000..bf840a4b8f --- /dev/null +++ b/src/ionosphere/waccmx/edyn_mudcom.F90 @@ -0,0 +1,2260 @@ +!module mudcom +! use shr_kind_mod ,only: r8 => shr_kind_r8 +! use cam_logfile ,only: iulog +! use cam_abortutils ,only: endrun +!----------------------------------------------------------------------- +! contains +!----------------------------------------------------------------------- +! +! file mudcom.f +! . . +! . MUDPACK version 4.0 . +! +! ... author and specialist +! +! John C. Adams (National Center for Atmospheric Research) (retired) + +! ... For MUDPACK information, visit the website: +! (https://www2.cisl.ucar.edu/resources/legacy/mudpack) +! +! ... purpose +! +! mudcom.f is a common subroutines file containing subroutines +! called by some or all of the real two- and three-dimensional +! mudpack solvers. mudcom.f must be loaded with any real mudpack +! solver. +! +! cb mud2cr1: call swk2(nx,ny,phif,rhsf,wk(ip),wk(ir)) +! +!----------------------------------------------------------------------- + subroutine swk2(nfx,nfy,phif,rhsf,phi,rhs) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! set phif,rhsf input in arrays which include +! virtual boundaries for phi (for all 2-d real codes) +! + implicit none + integer nfx,nfy,i,j + real(r8) :: phif(nfx,nfy),rhsf(nfx,nfy) + real(r8) :: phi(0:nfx+1,0:nfy+1),rhs(nfx,nfy) + do j=1,nfy + do i=1,nfx + phi(i,j) = phif(i,j) + rhs(i,j) = rhsf(i,j) + end do + end do +! +! set virtual boundaries in phi to zero +! + do j=0,nfy+1 + phi(0,j) = 0.0_r8 + phi(nfx+1,j) = 0.0_r8 + end do + do i=0,nfx+1 + phi(i,0) = 0.0_r8 + phi(i,nfy+1) = 0.0_r8 + end do + return + end subroutine swk2 +!----------------------------------------------------------------------- + subroutine trsfc2(nx,ny,phi,rhs,ncx,ncy,phic,rhsc) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! transfer fine grid to coarse grid +! + implicit none + integer nx,ny,ncx,ncy,i,j,ic,jc + real(r8) :: phi(0:nx+1,0:ny+1),rhs(nx,ny) + real(r8) :: phic(0:ncx+1,0:ncy+1),rhsc(ncx,ncy) +! +! set virtual boundaries in phic to zero +! + do jc=0,ncy+1 + phic(0,jc) = 0.0_r8 + phic(ncx+1,jc) = 0.0_r8 + end do + do ic=0,ncx+1 + phic(ic,0) = 0.0_r8 + phic(ic,ncy+1) = 0.0_r8 + end do + if (ncx.lt.nx .and. ncy.lt.ny) then +! +! coarsening in both x and y +! + do jc=1,ncy + j = jc+jc-1 + do ic=1,ncx + i = ic+ic-1 + phic(ic,jc) = phi(i,j) + rhsc(ic,jc) = rhs(i,j) + end do + end do + else if (ncx.lt.nx .and. ncy.eq.ny) then +! +! coarsening in x only +! + do jc=1,ncy + j = jc + do ic=1,ncx + i = ic+ic-1 + phic(ic,jc) = phi(i,j) + rhsc(ic,jc) = rhs(i,j) + end do + end do + else +! +! coarsening in y only +! + do jc=1,ncy + j = jc+jc-1 + do ic=1,ncx + i = ic + phic(ic,jc) = phi(i,j) + rhsc(ic,jc) = rhs(i,j) + end do + end do + end if + return + end subroutine trsfc2 +!----------------------------------------------------------------------- + subroutine res2(nx,ny,resf,ncx,ncy,rhsc,nxa,nxb,nyc,nyd) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,ncx,ncy,nxa,nxb,nyc,nyd + integer i,j,ic,jc,im1,ip1,jm1,jp1,ix,jy +! +! restrict fine grid residual in resf to coarse grid in rhsc +! using full weighting for all real 2d codes +! + real(r8) :: resf(nx,ny),rhsc(ncx,ncy) +! +! set x,y coarsening integer subscript scales +! + ix = 1 + if (ncx.eq.nx) ix = 0 + jy = 1 + if (ncy.eq.ny) jy = 0 +! +! restrict on interior +! + if (ncy.lt.ny .and. ncx.lt.nx) then +! +! coarsening in both directions +! + do jc=2,ncy-1 + j = jc+jc-1 + do ic=2,ncx-1 + i = ic+ic-1 + rhsc(ic,jc) = (resf(i-1,j-1)+resf(i+1,j-1)+resf(i-1,j+1)+ & + resf(i+1,j+1)+2._r8*(resf(i-1,j)+resf(i+1,j)+ & + resf(i,j-1)+resf(i,j+1))+4._r8*resf(i,j))*.0625_r8 + end do + end do + else if (ncy.eq.ny) then +! +! no coarsening in y but coarsening in x +! + do jc=2,ncy-1 + j = jc + do ic=2,ncx-1 + i = ic+ic-1 + rhsc(ic,jc) = (resf(i-1,j-1)+resf(i+1,j-1)+resf(i-1,j+1)+ & + resf(i+1,j+1)+2._r8*(resf(i-1,j)+resf(i+1,j)+ & + resf(i,j-1)+resf(i,j+1))+4._r8*resf(i,j))*.0625_r8 + end do + end do + else +! +! no coarsening in x but coarsening in y +! + do jc=2,ncy-1 + j = jc+jc-1 + do ic=2,ncx-1 + i = ic + rhsc(ic,jc) = (resf(i-1,j-1)+resf(i+1,j-1)+resf(i-1,j+1)+ & + resf(i+1,j+1)+2._r8*(resf(i-1,j)+resf(i+1,j)+ & + resf(i,j-1)+resf(i,j+1))+4._r8*resf(i,j))*.0625_r8 + end do + end do + end if +! +! set residual on boundaries +! + do jc=1,ncy,ncy-1 +! +! y=yc,yd boundaries +! + j = jc+jy*(jc-1) + jm1 = max0(j-1,2) + jp1 = min0(j+1,ny-1) + if (j.eq.1 .and. nyc.eq.0) jm1 = ny-1 + if (j.eq.ny .and. nyc.eq.0) jp1 = 2 +! +! y=yc,yd and x=xa,xb cornors +! + do ic=1,ncx,ncx-1 + i = ic+ix*(ic-1) + im1 = max0(i-1,2) + ip1 = min0(i+1,nx-1) + if (i.eq.1 .and. nxa.eq.0) im1 = nx-1 + if (i.eq.nx .and. nxa.eq.0) ip1 = 2 + rhsc(ic,jc) = (resf(im1,jm1)+resf(ip1,jm1)+resf(im1,jp1)+ & + resf(ip1,jp1)+2._r8*(resf(im1,j)+resf(ip1,j)+ & + resf(i,jm1)+resf(i,jp1))+4._r8*resf(i,j))*.0625_r8 + end do +! +! set y=yc,yd interior edges +! + do ic=2,ncx-1 + i = ic+ix*(ic-1) + rhsc(ic,jc) = (resf(i-1,jm1)+resf(i+1,jm1)+resf(i-1,jp1)+ & + resf(i+1,jp1)+2._r8*(resf(i-1,j)+resf(i+1,j)+ & + resf(i,jm1)+resf(i,jp1))+4._r8*resf(i,j))*.0625_r8 + end do + end do +! +! set x=xa,xb interior edges +! + do ic=1,ncx,ncx-1 + i = ic+ix*(ic-1) + im1 = max0(i-1,2) + ip1 = min0(i+1,nx-1) + if (i.eq.1 .and. nxa.eq.0) im1 = nx-1 + if (i.eq.nx .and. nxa.eq.0) ip1 = 2 + do jc=2,ncy-1 + j = jc+jy*(jc-1) + rhsc(ic,jc) = (resf(im1,j-1)+resf(ip1,j-1)+resf(im1,j+1)+ & + resf(ip1,j+1)+2._r8*(resf(im1,j)+resf(ip1,j)+ & + resf(i,j-1)+resf(i,j+1))+4._r8*resf(i,j))*.0625_r8 + end do + end do +! +! set coarse grid residual zero on specified boundaries +! + if (nxa.eq.1) then + do jc=1,ncy + rhsc(1,jc) = 0.0_r8 + end do + end if + if (nxb.eq.1) then + do jc=1,ncy + rhsc(ncx,jc) = 0.0_r8 + end do + end if + if (nyc.eq.1) then + do ic=1,ncx + rhsc(ic,1) = 0.0_r8 + end do + end if + if (nyd.eq.1) then + do ic=1,ncx + rhsc(ic,ncy) = 0.0_r8 + end do + end if + return + end subroutine res2 +!----------------------------------------------------------------------- +! +! prolon2 modified from rgrd2u 11/20/97 +! + subroutine prolon2(ncx,ncy,p,nx,ny,q,nxa,nxb,nyc,nyd,intpol) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer ncx,ncy,nx,ny,intpol,nxa,nxb,nyc,nyd + real(r8) :: p(0:ncx+1,0:ncy+1),q(0:nx+1,0:ny+1) + integer i,j,jc,ist,ifn,jst,jfn,joddst,joddfn + ist = 1 + ifn = nx + jst = 1 + jfn = ny + joddst = 1 + joddfn = ny + if (nxa.eq.1) then + ist = 2 + end if + if (nxb.eq.1) then + ifn = nx-1 + end if + if (nyc.eq.1) then + jst = 2 + joddst = 3 + end if + if (nyd.eq.1) then + jfn = ny-1 + joddfn = ny-2 + end if + if (intpol.eq.1 .or. ncy.lt.4) then +! +! linearly interpolate in y +! + if (ncy .lt. ny) then +! +! ncy grid is an every other point subset of ny grid +! set odd j lines interpolating in x and then set even +! j lines by averaging odd j lines +! + do j=joddst,joddfn,2 + jc = j/2+1 + call prolon1(ncx,p(0,jc),nx,q(0,j),nxa,nxb,intpol) + end do + do j=2,jfn,2 + do i=ist,ifn + q(i,j) = 0.5_r8*(q(i,j-1)+q(i,j+1)) + end do + end do +! +! set periodic virtual boundaries if necessary +! + if (nyc.eq.0) then + do i=ist,ifn + q(i,0) = q(i,ny-1) + q(i,ny+1) = q(i,2) + end do + end if + return + else +! +! ncy grid is equals ny grid so interpolate in x only +! + do j=jst,jfn + jc = j + call prolon1(ncx,p(0,jc),nx,q(0,j),nxa,nxb,intpol) + end do +! +! set periodic virtual boundaries if necessary +! + if (nyc.eq.0) then + do i=ist,ifn + q(i,0) = q(i,ny-1) + q(i,ny+1) = q(i,2) + end do + end if + return + end if + else +! +! cubically interpolate in y +! + if (ncy .lt. ny) then +! +! set every other point of ny grid by interpolating in x +! + do j=joddst,joddfn,2 + jc = j/2+1 + call prolon1(ncx,p(0,jc),nx,q(0,j),nxa,nxb,intpol) + end do +! +! set deep interior of ny grid using values just +! generated and symmetric cubic interpolation in y +! + do j=4,ny-3,2 + do i=ist,ifn + q(i,j)=(-q(i,j-3)+9._r8*(q(i,j-1)+q(i,j+1))-q(i,j+3))*.0625_r8 + end do + end do +! +! interpolate from q at j=2 and j=ny-1 +! + if (nyc.ne.0) then +! +! asymmetric formula near nonperiodic y boundaries +! + do i=ist,ifn + q(i,2)=(5._r8*q(i,1)+15._r8*q(i,3)-5._r8*q(i,5)+q(i,7))*.0625_r8 + q(i,ny-1)=(5._r8*q(i,ny)+15._r8*q(i,ny-2)-5._r8*q(i,ny-4)+ & + q(i,ny-6))*.0625_r8 + end do + else +! +! periodicity in y alows symmetric formula near bndys +! + do i=ist,ifn + q(i,2) = (-q(i,ny-2)+9._r8*(q(i,1)+q(i,3))-q(i,5))*.0625_r8 + q(i,ny-1)=(-q(i,ny-4)+9._r8*(q(i,ny-2)+q(i,ny))-q(i,3))*.0625_r8 + q(i,ny+1) = q(i,2) + q(i,0) = q(i,ny-1) + end do + end if + return + else +! +! ncy grid is equals ny grid so interpolate in x only +! + do j=jst,jfn + jc = j + call prolon1(ncx,p(0,jc),nx,q(0,j),nxa,nxb,intpol) + end do +! +! set periodic virtual boundaries if necessary +! + if (nyc.eq.0) then + do i=ist,ifn + q(i,0) = q(i,ny-1) + q(i,ny+1) = q(i,2) + end do + end if + return + end if + end if + end subroutine prolon2 +!----------------------------------------------------------------------- +! +! 11/20/97 modification of rgrd1u.f for mudpack +! + subroutine prolon1(ncx,p,nx,q,nxa,nxb,intpol) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer intpol,nxa,nxb,ncx,nx,i,ic,ist,ifn,ioddst,ioddfn + real(r8) :: p(0:ncx+1),q(0:nx+1) + ist = 1 + ioddst = 1 + ifn = nx + ioddfn = nx + if (nxa.eq.1) then + ist = 2 + ioddst = 3 + end if + if (nxb.eq.1) then + ifn = nx-1 + ioddfn = nx-2 + end if + if (intpol.eq.1 .or. ncx.lt.4) then +! +! linear interpolation in x +! + if (ncx .lt. nx) then +! +! every other point of nx grid is ncx grid +! + do i=ioddst,ioddfn,2 + ic = (i+1)/2 + q(i) = p(ic) + end do + do i=2,ifn,2 + q(i) = 0.5_r8*(q(i-1)+q(i+1)) + end do + else +! +! nx grid equals ncx grid +! + do i=ist,ifn + q(i) = p(i) + end do + end if +! +! set virtual end points if periodic +! + if (nxa.eq.0) then + q(0) = q(nx-1) + q(nx+1) = q(2) + end if + return + else +! +! cubic interpolation in x +! + if (ncx .lt. nx) then + do i=ioddst,ioddfn,2 + ic = (i+1)/2 + q(i) = p(ic) + end do +! +! set deep interior with symmetric formula +! + do i=4,nx-3,2 + q(i)=(-q(i-3)+9._r8*(q(i-1)+q(i+1))-q(i+3))*.0625_r8 + end do +! +! interpolate from q at i=2 and i=nx-1 +! + if (nxa.ne.0) then +! +! asymmetric formula near nonperiodic bndys +! + q(2)=(5._r8*q(1)+15._r8*q(3)-5._r8*q(5)+q(7))*.0625_r8 + q(nx-1)=(5._r8*q(nx)+15._r8*q(nx-2)-5._r8*q(nx-4)+q(nx-6))*.0625_r8 + else +! +! periodicity in x alows symmetric formula near bndys +! + q(2) = (-q(nx-2)+9._r8*(q(1)+q(3))-q(5))*.0625_r8 + q(nx-1) = (-q(nx-4)+9._r8*(q(nx-2)+q(nx))-q(3))*.0625_r8 + q(nx+1) = q(2) + q(0) = q(nx-1) + end if + return + else +! +! ncx grid equals nx grid +! + do i=ist,ifn + q(i) = p(i) + end do + if (nxa.eq.0) then + q(0) = q(nx-1) + q(nx+1) = q(2) + end if + return + end if + end if + end subroutine prolon1 +!----------------------------------------------------------------------- + subroutine cor2(nx,ny,phif,ncx,ncy,phic,nxa,nxb,nyc,nyd,intpol,phcor) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! add coarse grid correction in phic to fine grid approximation +! in phif using linear or cubic interpolation +! + implicit none + integer i,j,nx,ny,ncx,ncy,nxa,nxb,nyc,nyd,intpol,ist,ifn,jst,jfn + real(r8) :: phif(0:nx+1,0:ny+1),phic(0:ncx+1,0:ncy+1) + real(r8) :: phcor(0:nx+1,0:ny+1) + do j=0,ny+1 + do i=0,nx+1 + phcor(i,j) = 0.0_r8 + end do + end do +! +! lift correction in phic to fine grid in phcor +! + call prolon2(ncx,ncy,phic,nx,ny,phcor,nxa,nxb,nyc,nyd,intpol) +! +! add correction in phcor to phif on nonspecified boundaries +! + ist = 1 + ifn = nx + jst = 1 + jfn = ny + if (nxa.eq.1) ist = 2 + if (nxb.eq.1) ifn = nx-1 + if (nyc.eq.1) jst = 2 + if (nyd.eq.1) jfn = ny-1 + do j=jst,jfn + do i=ist,ifn + phif(i,j) = phif(i,j) + phcor(i,j) + end do + end do +! +! add periodic points if necessary +! + if (nyc.eq.0) then + do i=ist,ifn + phif(i,0) = phif(i,ny-1) + phif(i,ny+1) = phif(i,2) + end do + end if + if (nxa.eq.0) then + do j=jst,jfn + phif(0,j) = phif(nx-1,j) + phif(nx+1,j) = phif(2,j) + end do + end if + end subroutine cor2 +!----------------------------------------------------------------------- + subroutine pde2(nx,ny,u,i,j,ux3,ux4,uy3,uy4,nxa,nyc) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,i,j,nxa,nyc + real(r8) :: u(nx,ny),dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 + common/pde2com/dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 + real(r8) :: ux3,ux4,uy3,uy4 +! +! use second order approximation in u to estimate (second order) +! third and fourth partial derivatives in the x and y direction +! non-symmetric difference formula (derived from the routine +! finpdf,findif) are used at and one point in from mixed boundaries. +! + if (nxa.ne.0) then +! +! nonperiodic in x +! + if(i.gt.2 .and. i.lt.nx-1) then + ux3 = (-u(i-2,j)+2.0_r8*u(i-1,j)-2.0_r8*u(i+1,j)+u(i+2,j))/tdlx3 + ux4 = (u(i-2,j)-4.0_r8*u(i-1,j)+6.0_r8*u(i,j)-4.0_r8*u(i+1,j)+u(i+2,j)) & + /dlx4 + else if (i.eq.1) then + ux3 = (-5.0_r8*u(1,j)+18.0_r8*u(2,j)-24.0_r8*u(3,j)+14.0_r8*u(4,j)- & + 3.0_r8*u(5,j))/tdlx3 + ux4 = (3.0_r8*u(1,j)-14.0_r8*u(2,j)+26.0_r8*u(3,j)-24.0_r8*u(4,j)+ & + 11.0_r8*u(5,j)-2.0_r8*u(6,j))/dlx4 + else if (i.eq.2) then + ux3 = (-3.0_r8*u(1,j)+10.0_r8*u(2,j)-12.0_r8*u(3,j)+6.0_r8*u(4,j)-u(5,j)) & + /tdlx3 + ux4 = (2.0_r8*u(1,j)-9.0_r8*u(2,j)+16.0_r8*u(3,j)-14.0_r8*u(4,j)+ & + 6.0_r8*u(5,j)-u(6,j))/dlx4 + else if (i.eq.nx-1) then + ux3 = (u(nx-4,j)-6.0_r8*u(nx-3,j)+12.0_r8*u(nx-2,j)-10.0_r8*u(nx-1,j)+ & + 3.0_r8*u(nx,j))/tdlx3 + ux4 = (-u(nx-5,j)+6.0_r8*u(nx-4,j)-14.0_r8*u(nx-3,j)+16.0_r8*u(nx-2,j)- & + 9.0_r8*u(nx-1,j)+2.0_r8*u(nx,j))/dlx4 + else if (i.eq.nx) then + ux3 = (3.0_r8*u(nx-4,j)-14.0_r8*u(nx-3,j)+24.0_r8*u(nx-2,j)- & + 18.0_r8*u(nx-1,j)+5.0_r8*u(nx,j))/tdlx3 + ux4 = (-2.0_r8*u(nx-5,j)+11.0_r8*u(nx-4,j)-24.0_r8*u(nx-3,j)+ & + 26.0_r8*u(nx-2,j)-14.0_r8*u(nx-1,j)+3.0_r8*u(nx,j))/dlx4 + end if + else +! +! periodic in x +! + if(i.gt.2 .and. i.lt.nx-1) then + ux3 = (-u(i-2,j)+2.0_r8*u(i-1,j)-2.0_r8*u(i+1,j)+u(i+2,j))/tdlx3 + ux4 = (u(i-2,j)-4.0_r8*u(i-1,j)+6.0_r8*u(i,j)-4.0_r8*u(i+1,j)+u(i+2,j)) & + /dlx4 + else if (i.eq.1) then + ux3 = (-u(nx-2,j)+2.0_r8*u(nx-1,j)-2.0_r8*u(2,j)+u(3,j))/tdlx3 + ux4 = (u(nx-2,j)-4.0_r8*u(nx-1,j)+6.0_r8*u(1,j)-4.0_r8*u(2,j)+u(3,j)) & + /dlx4 + else if (i.eq.2) then + ux3 = (-u(nx-1,j)+2.0_r8*u(1,j)-2.0_r8*u(3,j)+u(4,j))/(tdlx3) + ux4 = (u(nx-1,j)-4.0_r8*u(1,j)+6.0_r8*u(2,j)-4.0_r8*u(3,j)+u(4,j))/dlx4 + else if (i.eq.nx-1) then + ux3 = (-u(nx-3,j)+2.0_r8*u(nx-2,j)-2.0_r8*u(1,j)+u(2,j))/tdlx3 + ux4 = (u(nx-3,j)-4.0_r8*u(nx-2,j)+6.0_r8*u(nx-1,j)-4.0_r8*u(1,j)+ & + u(2,j))/dlx4 + else if (i.eq.nx) then + ux3 = (-u(nx-2,j)+2.0_r8*u(nx-1,j)-2.0_r8*u(2,j)+u(3,j))/tdlx3 + ux4 = (u(nx-2,j)-4.0_r8*u(nx-1,j)+6.0_r8*u(nx,j)-4.0_r8*u(2,j)+u(3,j)) & + /dlx4 + end if + end if +! +! y partial derivatives +! + if (nyc.ne.0) then +! +! not periodic in y +! + if (j.gt.2 .and. j.lt.ny-1) then + uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 + uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2)) & + /dly4 + else if (j.eq.1) then + uy3 = (-5.0_r8*u(i,1)+18.0_r8*u(i,2)-24.0_r8*u(i,3)+14.0_r8*u(i,4)- & + 3.0_r8*u(i,5))/tdly3 + uy4 = (3.0_r8*u(i,1)-14.0_r8*u(i,2)+26.0_r8*u(i,3)-24.0_r8*u(i,4)+ & + 11.0_r8*u(i,5)-2.0_r8*u(i,6))/dly4 + else if (j.eq.2) then + uy3 = (-3.0_r8*u(i,1)+10.0_r8*u(i,2)-12.0_r8*u(i,3)+6.0_r8*u(i,4)-u(i,5)) & + /tdly3 + uy4 = (2.0_r8*u(i,1)-9.0_r8*u(i,2)+16.0_r8*u(i,3)-14.0_r8*u(i,4)+ & + 6.0_r8*u(i,5)-u(i,6))/dly4 + else if (j.eq.ny-1) then + uy3 = (u(i,ny-4)-6.0_r8*u(i,ny-3)+12.0_r8*u(i,ny-2)-10.0_r8*u(i,ny-1)+ & + 3.0_r8*u(i,ny))/tdly3 + uy4 = (-u(i,ny-5)+6.0_r8*u(i,ny-4)-14.0_r8*u(i,ny-3)+16.0_r8*u(i,ny-2)- & + 9.0_r8*u(i,ny-1)+2.0_r8*u(i,ny))/dly4 + else if (j.eq.ny) then + uy3 = (3.0_r8*u(i,ny-4)-14.0_r8*u(i,ny-3)+24.0_r8*u(i,ny-2)- & + 18.0_r8*u(i,ny-1)+5.0_r8*u(i,ny))/tdly3 + uy4 = (-2.0_r8*u(i,ny-5)+11.0_r8*u(i,ny-4)-24.0_r8*u(i,ny-3)+ & + 26.0_r8*u(i,ny-2)-14.0_r8*u(i,ny-1)+3.0_r8*u(i,ny))/dly4 + end if + else +! +! periodic in y +! + if (j.gt.2 .and. j.lt.ny-1) then + uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 + uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2)) & + /dly4 + else if (j.eq.1) then + uy3 = (-u(i,ny-2)+2.0_r8*u(i,ny-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 + uy4 = (u(i,ny-2)-4.0_r8*u(i,ny-1)+6.0_r8*u(i,1)-4.0_r8*u(i,2)+u(i,3)) & + /dly4 + else if (j.eq.2) then + uy3 = (-u(i,ny-1)+2.0_r8*u(i,1)-2.0_r8*u(i,3)+u(i,4))/(tdly3) + uy4 = (u(i,ny-1)-4.0_r8*u(i,1)+6.0_r8*u(i,2)-4.0_r8*u(i,3)+u(i,4))/dly4 + else if (j.eq.ny-1) then + uy3 = (-u(i,ny-3)+2.0_r8*u(i,ny-2)-2.0_r8*u(i,1)+u(i,2))/tdly3 + uy4 = (u(i,ny-3)-4.0_r8*u(i,ny-2)+6.0_r8*u(i,ny-1)-4.0_r8*u(i,1)+ & + u(i,2))/dly4 + else if (j.eq.ny) then + uy3 = (-u(i,ny-2)+2.0_r8*u(i,ny-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 + uy4 = (u(i,ny-2)-4.0_r8*u(i,ny-1)+6.0_r8*u(i,ny)-4.0_r8*u(i,2)+u(i,3)) & + /dly4 + end if + end if + return + end subroutine pde2 +!----------------------------------------------------------------------- + subroutine swk3(nfx,nfy,nfz,phif,rhsf,phi,rhs) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! set phif,rhsf input in arrays which include +! virtual boundaries for phi (for all 2-d real codes) +! + implicit none + integer nfx,nfy,nfz,i,j,k + real(r8) :: phif(nfx,nfy,nfz),rhsf(nfx,nfy,nfz) + real(r8) :: phi(0:nfx+1,0:nfy+1,0:nfz+1),rhs(nfx,nfy,nfz) + do k=1,nfz + do j=1,nfy + do i=1,nfx + phi(i,j,k) = phif(i,j,k) + rhs(i,j,k) = rhsf(i,j,k) + end do + end do + end do +! +! set virtual boundaries in phi to zero +! + do k=0,nfz+1 + do j=0,nfy+1 + phi(0,j,k) = 0.0_r8 + phi(nfx+1,j,k) = 0.0_r8 + end do + end do + do k=0,nfz+1 + do i=0,nfx+1 + phi(i,0,k) = 0.0_r8 + phi(i,nfy+1,k) = 0.0_r8 + end do + end do + do j=0,nfy+1 + do i=0,nfx+1 + phi(i,j,0) = 0.0_r8 + phi(i,j,nfz+1) = 0.0_r8 + end do + end do + return + end subroutine swk3 +!----------------------------------------------------------------------- + subroutine trsfc3(nx,ny,nz,phi,rhs,ncx,ncy,ncz,phic,rhsc) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! transfer fine grid to coarse grid +! + implicit none + integer nx,ny,nz,ncx,ncy,ncz,i,j,k,ic,jc,kc,ix,jy,kz + real(r8) :: phi(0:nx+1,0:ny+1,0:nz+1),rhs(nx,ny,nz) + real(r8) :: phic(0:ncx+1,0:ncy+1,0:ncz+1),rhsc(ncx,ncy,ncz) +! +! set virtual boundaries in phic to zero +! + do kc=0,ncz+1 + do jc=0,ncy+1 + phic(0,jc,kc) = 0.0_r8 + phic(ncx+1,jc,kc) = 0.0_r8 + end do + end do + do kc=0,ncz+1 + do ic=0,ncx+1 + phic(ic,0,kc) = 0.0_r8 + phic(ic,ncy+1,kc) = 0.0_r8 + end do + end do + do jc=0,ncy+1 + do ic=0,ncx+1 + phic(ic,jc,0) = 0.0_r8 + phic(ic,jc,ncz+1) = 0.0_r8 + end do + end do + if (ncx.lt.nx .and. ncy.lt.ny .and. ncz.lt.nz) then +! +! coarsening in x,y,z (usually the case?) +! + do kc=1,ncz + k = kc+kc-1 + do jc=1,ncy + j = jc+jc-1 + do ic=1,ncx + i = ic+ic-1 + phic(ic,jc,kc) = phi(i,j,k) + rhsc(ic,jc,kc) = rhs(i,j,k) + end do + end do + end do + else +! +! no coarsening in at least one dimension +! + ix = 1 + if (ncx.eq.nx) ix = 0 + jy = 1 + if (ncy.eq.ny) jy = 0 + kz = 1 + if (ncz.eq.nz) kz = 0 + + do kc=1,ncz + k = kc+kz*(kc-1) + do jc=1,ncy + j = jc+jy*(jc-1) + do ic=1,ncx + i = ic+ix*(ic-1) + phic(ic,jc,kc) = phi(i,j,k) + rhsc(ic,jc,kc) = rhs(i,j,k) + end do + end do + end do + end if + return + end subroutine trsfc3 +!----------------------------------------------------------------------- + subroutine res3(nx,ny,nz,resf,ncx,ncy,ncz,rhsc, & + nxa,nxb,nyc,nyd,nze,nzf) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,nz,ncx,ncy,ncz,nxa,nxb,nyc,nyd,nze,nzf + integer ix,jy,kz,i,j,k,ic,jc,kc,im1,ip1,jm1,jp1,km1,kp1 + real(r8) :: rm,rk,rp +! +! restrict fine grid residual in resf to coarse grid in rhsc +! using full weighting +! + real(r8) :: resf(nx,ny,nz),rhsc(ncx,ncy,ncz) +! +! set x,y,z coarsening integer subscript scales +! + ix = 1 + if (ncx.eq.nx) ix = 0 + jy = 1 + if (ncy.eq.ny) jy = 0 + kz = 1 + if (ncz.eq.nz) kz = 0 +! +! restrict on interior +! + if (ncz.lt.nz .and. ncy.lt.ny .and. ncx.lt.nx) then +! +! coarsening in x,y,z +! + do kc=2,ncz-1 + k = kc+kc-1 + do jc=2,ncy-1 + j = jc+jc-1 + do ic=2,ncx-1 + i = ic+ic-1 +! +! weight on k-1,k,k+1 z planes in rm,rk,rp +! + rm=(resf(i-1,j-1,k-1)+resf(i+1,j-1,k-1)+resf(i-1,j+1,k-1)+ & + resf(i+1,j+1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & + resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 + + rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & + resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & + resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(i-1,j-1,k+1)+resf(i+1,j-1,k+1)+resf(i-1,j+1,k+1)+ & + resf(i+1,j+1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & + resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 +! +! weight in z direction for final result +! + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do + end do + else +! +! allow for noncoarsening in any of x,y,z +! + do kc=2,ncz-1 + k = kc+kz*(kc-1) + do jc=2,ncy-1 + j = jc+jy*(jc-1) + do ic=2,ncx-1 + i = ic+ix*(ic-1) +! +! weight on k-1,k,k+1 z planes in rm,rk,rp +! + rm=(resf(i-1,j-1,k-1)+resf(i+1,j-1,k-1)+resf(i-1,j+1,k-1)+ & + resf(i+1,j+1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & + resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 + + rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & + resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & + resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(i-1,j-1,k+1)+resf(i+1,j-1,k+1)+resf(i-1,j+1,k+1)+ & + resf(i+1,j+1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & + resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 +! +! weight in z direction for final result +! + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do + end do + end if +! +! set residual on boundaries +! + do ic=1,ncx,ncx-1 +! +! x=xa and x=xb +! + i = ic+ix*(ic-1) + im1 = max0(i-1,2) + ip1 = min0(i+1,nx-1) + if (i.eq.1 .and. nxa.eq.0) im1 = nx-1 + if (i.eq.nx .and. nxb.eq.0) ip1 = 2 +! +! (y,z) interior +! + do kc=2,ncz-1 + k = kc+kz*(kc-1) + do jc=2,ncy-1 + j = jc+jy*(jc-1) + rm=(resf(im1,j-1,k-1)+resf(ip1,j-1,k-1)+resf(im1,j+1,k-1)+ & + resf(ip1,j+1,k-1)+2._r8*(resf(im1,j,k-1)+resf(ip1,j,k-1)+ & + resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 + + rk=(resf(im1,j-1,k)+resf(ip1,j-1,k)+resf(im1,j+1,k)+ & + resf(ip1,j+1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & + resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(im1,j-1,k+1)+resf(ip1,j-1,k+1)+resf(im1,j+1,k+1)+ & + resf(ip1,j+1,k+1)+2._r8*(resf(im1,j,k+1)+resf(ip1,j,k+1)+ & + resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do +! +! x=xa,xb and y=yc,yd interior edges +! + do jc=1,ncy,ncy-1 + j = jc+jy*(jc-1) + jm1 = max0(j-1,2) + jp1 = min0(j+1,ny-1) + if (j.eq.1 .and. nyc.eq.0) jm1 = ny-1 + if (j.eq.ny .and. nyc.eq.0) jp1 = 2 + do kc=2,ncz-1 + k = kc+kz*(kc-1) + rm=(resf(im1,jm1,k-1)+resf(ip1,jm1,k-1)+resf(im1,jp1,k-1)+ & + resf(ip1,jp1,k-1)+2._r8*(resf(im1,j,k-1)+resf(ip1,j,k-1)+ & + resf(i,jm1,k-1)+resf(i,jp1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 + + rk=(resf(im1,jm1,k)+resf(ip1,jm1,k)+resf(im1,jp1,k)+ & + resf(ip1,jp1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & + resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(im1,jm1,k+1)+resf(ip1,jm1,k+1)+resf(im1,jp1,k+1)+ & + resf(ip1,jp1,k+1)+2._r8*(resf(im1,j,k+1)+resf(ip1,j,k+1)+ & + resf(i,jm1,k+1)+resf(i,jp1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do +! x=xa,xb; y=yc,yd; z=ze,zf cornors + do kc=1,ncz,ncz-1 + k = kc+kz*(kc-1) + km1 = max0(k-1,2) + kp1 = min0(k+1,nz-1) + if (k.eq.1 .and. nze.eq.0) km1 = nz-1 + if (k.eq.nz .and. nzf.eq.0) kp1 = 2 + rm=(resf(im1,jm1,km1)+resf(ip1,jm1,km1)+resf(im1,jp1,km1)+ & + resf(ip1,jp1,km1)+2._r8*(resf(im1,j,km1)+resf(ip1,j,km1)+ & + resf(i,jm1,km1)+resf(i,jp1,km1))+4._r8*resf(i,j,km1))*.0625_r8 + + rk=(resf(im1,jm1,k)+resf(ip1,jm1,k)+resf(im1,jp1,k)+ & + resf(ip1,jp1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & + resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(im1,jm1,kp1)+resf(ip1,jm1,kp1)+resf(im1,jp1,kp1)+ & + resf(ip1,jp1,kp1)+2._r8*(resf(im1,j,kp1)+resf(ip1,j,kp1)+ & + resf(i,jm1,kp1)+resf(i,jp1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do +! +! x=xa,xb and z=ze,zf edges +! + do kc=1,ncz,ncz-1 + k = kc+kz*(kc-1) + km1 = max0(k-1,2) + kp1 = min0(k+1,nz-1) + if (k.eq.1 .and. nze.eq.0) km1 = nz-1 + if (k.eq.nz .and. nzf.eq.0) kp1 = 2 + do jc=2,ncy-1 + j = jc+jy*(jc-1) + rm=(resf(im1,j-1,km1)+resf(ip1,j-1,km1)+resf(im1,j+1,km1)+ & + resf(ip1,j+1,km1)+2._r8*(resf(im1,j,km1)+resf(ip1,j,km1)+ & + resf(i,j-1,km1)+resf(i,j+1,km1))+4._r8*resf(i,j,km1))*.0625_r8 + + rk=(resf(im1,j-1,k)+resf(ip1,j-1,k)+resf(im1,j+1,k)+ & + resf(ip1,j+1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & + resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(im1,j-1,kp1)+resf(ip1,j-1,kp1)+resf(im1,j+1,kp1)+ & + resf(ip1,j+1,kp1)+2._r8*(resf(im1,j,kp1)+resf(ip1,j,kp1)+ & + resf(i,j-1,kp1)+resf(i,j+1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do + end do +! +! y boundaries y=yc and y=yd +! + do jc=1,ncy,ncy-1 + j = jc+jy*(jc-1) + jm1 = max0(j-1,2) + jp1 = min0(j+1,ny-1) + if (j.eq.1 .and. nyc.eq.0) jm1 = ny-1 + if (j.eq.ny .and. nyd.eq.0) jp1 = 2 +! +! (x,z) interior +! + do kc=2,ncz-1 + k = kc+kz*(kc-1) + do ic=2,ncx-1 + i = ic+ix*(ic-1) + rm=(resf(i-1,jm1,k-1)+resf(i+1,jm1,k-1)+resf(i-1,jp1,k-1)+ & + resf(i+1,jp1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & + resf(i,jm1,k-1)+resf(i,jp1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 + + rk=(resf(i-1,jm1,k)+resf(i+1,jm1,k)+resf(i-1,jp1,k)+ & + resf(i+1,jp1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & + resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(i-1,jm1,k+1)+resf(i+1,jm1,k+1)+resf(i-1,jp1,k+1)+ & + resf(i+1,jp1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & + resf(i,jm1,k+1)+resf(i,jp1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do +! +! y=yc,yd and z=ze,zf edges +! + do kc=1,ncz,ncz-1 + k = kc+kz*(kc-1) + km1 = max0(k-1,2) + kp1 = min0(k+1,nz-1) + if (k.eq.1 .and. nze.eq.0) km1 = nz-1 + if (k.eq.nz .and. nzf.eq.0) kp1 = 2 +! +! interior in x +! + do ic=2,ncx-1 + i = ic+ix*(ic-1) + rm=(resf(i-1,jm1,km1)+resf(i+1,jm1,km1)+resf(i-1,jp1,km1)+ & + resf(i+1,jp1,km1)+2._r8*(resf(i-1,j,km1)+resf(i+1,j,km1)+ & + resf(i,jm1,km1)+resf(i,jp1,km1))+4._r8*resf(i,j,km1))*.0625_r8 + + rk=(resf(i-1,jm1,k)+resf(i+1,jm1,k)+resf(i-1,jp1,k)+ & + resf(i+1,jp1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & + resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(i-1,jm1,kp1)+resf(i+1,jm1,kp1)+resf(i-1,jp1,kp1)+ & + resf(i+1,jp1,kp1)+2._r8*(resf(i-1,j,kp1)+resf(i+1,j,kp1)+ & + resf(i,jm1,kp1)+resf(i,jp1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do + end do +! +! z=ze,zf boundaries +! + do kc=1,ncz,ncz-1 + k = kc+kz*(kc-1) + km1 = max0(k-1,2) + kp1 = min0(k+1,nz-1) + if (k.eq.1 .and. nze.eq.0) km1 = nz-1 + if (k.eq.nz .and. nzf.eq.0) kp1 = 2 +! +! (x,y) interior +! + do jc=2,ncy-1 + j = jc+jy*(jc-1) + do ic=2,ncx-1 + i = ic+ix*(ic-1) + rm=(resf(i-1,j-1,km1)+resf(i+1,j-1,km1)+resf(i-1,j+1,km1)+ & + resf(i+1,j+1,km1)+2._r8*(resf(i-1,j,km1)+resf(i+1,j,km1)+ & + resf(i,j-1,km1)+resf(i,j+1,km1))+4._r8*resf(i,j,km1))*.0625_r8 + + rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & + resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & + resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 + + rp=(resf(i-1,j-1,kp1)+resf(i+1,j-1,kp1)+resf(i-1,j+1,kp1)+ & + resf(i+1,j+1,kp1)+2._r8*(resf(i-1,j,kp1)+resf(i+1,j,kp1)+ & + resf(i,j-1,kp1)+resf(i,j+1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 + + rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) + end do + end do + end do +! +! set coarse grid residual to zero at specified boundaries +! + if (nxa.eq.1) then + ic = 1 + do kc=1,ncz + do jc=1,ncy + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + if (nxb.eq.1) then + ic = ncx + do kc=1,ncz + do jc=1,ncy + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + if (nyc.eq.1) then + jc = 1 + do kc=1,ncz + do ic=1,ncx + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + if (nyd.eq.1) then + jc = ncy + do kc=1,ncz + do ic=1,ncx + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + if (nze.eq.1) then + kc = 1 + do jc=1,ncy + do ic=1,ncx + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + if (nzf.eq.1) then + kc = ncz + do jc=1,ncy + do ic=1,ncx + rhsc(ic,jc,kc) = 0.0_r8 + end do + end do + end if + return + end subroutine res3 +!----------------------------------------------------------------------- +! +! prolon3 modified from prolon2 11/25/97 +! + subroutine prolon3(ncx,ncy,ncz,p,nx,ny,nz,q,nxa,nxb,nyc,nyd, & + nze,nzf,intpol) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer ncx,ncy,ncz,nx,ny,nz,intpol,nxa,nxb,nyc,nyd,nze,nzf + real(r8) :: p(0:ncx+1,0:ncy+1,0:ncz+1),q(0:nx+1,0:ny+1,0:nz+1) + integer i,j,k,kc,ist,ifn,jst,jfn,kst,kfn,koddst,koddfn + ist = 1 + ifn = nx + jst = 1 + jfn = ny + kst = 1 + kfn = nz + koddst = 1 + koddfn = nz + if (nxa.eq.1) then + ist = 2 + end if + if (nxb.eq.1) then + ifn = nx-1 + end if + if (nyc.eq.1) then + jst = 2 + end if + if (nyd.eq.1) then + jfn = ny-1 + end if + if (nze.eq.1) then + kst = 2 + koddst = 3 + end if + if (nzf.eq.1) then + kfn = nz-1 + koddfn = nz-2 + end if + if (intpol.eq.1 .or. ncz.lt.4) then +! +! linearly interpolate in z +! + if (ncz .lt. nz) then +! +! ncz grid is an every other point subset of nz grid +! set odd k planes interpolating in x&y and then set even +! k planes by averaging odd k planes +! + do k=koddst,koddfn,2 + kc = k/2+1 + call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & + nyd,intpol) + end do + do k=2,kfn,2 + do j=jst,jfn + do i=ist,ifn + q(i,j,k) = 0.5_r8*(q(i,j,k-1)+q(i,j,k+1)) + end do + end do + end do +! +! set periodic virtual boundaries if necessary +! + if (nze.eq.0) then + do j=jst,jfn + do i=ist,ifn + q(i,j,0) = q(i,j,nz-1) + q(i,j,nz+1) = q(i,j,2) + end do + end do + end if + return + else +! +! ncz grid is equals nz grid so interpolate in x&y only +! + do k=kst,kfn + kc = k + call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & + nyd,intpol) + end do +! +! set periodic virtual boundaries if necessary +! + if (nze.eq.0) then + do j=jst,jfn + do i=ist,ifn + q(i,j,0) = q(i,j,nz-1) + q(i,j,nz+1) = q(i,j,2) + end do + end do + end if + return + end if + else +! +! cubically interpolate in z +! + if (ncz .lt. nz) then +! +! set every other point of nz grid by interpolating in x&y +! + do k=koddst,koddfn,2 + kc = k/2+1 + call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & + nyd,intpol) + end do +! +! set deep interior of nz grid using values just +! generated and symmetric cubic interpolation in z +! + do k=4,nz-3,2 + do j=jst,jfn + do i=ist,ifn + q(i,j,k)=(-q(i,j,k-3)+9._r8*(q(i,j,k-1)+q(i,j,k+1))-q(i,j,k+3)) & + *.0625_r8 + end do + end do + end do +! +! interpolate from q at k=2 and k=nz-1 +! + if (nze.ne.0) then +! +! asymmetric formula near nonperiodic z boundaries +! + do j=jst,jfn + do i=ist,ifn + q(i,j,2)=(5._r8*q(i,j,1)+15._r8*q(i,j,3)-5._r8*q(i,j,5)+q(i,j,7)) & + *.0625_r8 + q(i,j,nz-1)=(5._r8*q(i,j,nz)+15._r8*q(i,j,nz-2)-5._r8*q(i,j,nz-4)+ & + q(i,j,nz-6))*.0625_r8 + end do + end do + else +! +! periodicity in y alows symmetric formula near bndys +! + do j=jst,jfn + do i=ist,ifn + q(i,j,2) = (-q(i,j,nz-2)+9._r8*(q(i,j,1)+q(i,j,3))-q(i,j,5)) & + *.0625_r8 + q(i,j,nz-1)=(-q(i,j,nz-4)+9._r8*(q(i,j,nz-2)+q(i,j,nz))- & + q(i,j,3))*.0625_r8 + q(i,j,nz+1) = q(i,j,2) + q(i,j,0) = q(i,j,nz-1) + end do + end do + end if + return + else +! +! ncz grid is equals nx grid so interpolate in x&y only +! + do k=kst,kfn + kc = k + call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & + nyd,intpol) + end do +! +! set periodic virtual boundaries if necessary +! + if (nze.eq.0) then + do j=jst,jfn + do i=ist,ifn + q(i,j,0) = q(i,j,nz-1) + q(i,j,nz+1) = q(i,j,2) + end do + end do + end if + return + end if + end if + end subroutine prolon3 +!----------------------------------------------------------------------- + subroutine cor3(nx,ny,nz,phif,ncx,ncy,ncz,phic,nxa,nxb,nyc,nyd, & + nze,nzf,intpol,phcor) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,nz,ncx,ncy,ncz,nxa,nxb,nyc,nyd,nze,nzf,intpol + integer i,j,k,ist,ifn,jst,jfn,kst,kfn +! +! add coarse grid correction in phic to fine grid approximation +! in phif using linear or cubic interpolation +! + real(r8) :: phif(0:nx+1,0:ny+1,0:nz+1),phic(0:ncx+1,0:ncy+1,0:ncz+1) + real(r8) :: phcor(0:nx+1,0:ny+1,0:nz+1) + do k=0,nz+1 + do j=0,ny+1 + do i=0,nx+1 + phcor(i,j,k) = 0.0_r8 + end do + end do + end do +! +! lift correction in phic to fine grid in phcor +! + call prolon3(ncx,ncy,ncz,phic,nx,ny,nz,phcor,nxa,nxb,nyc,nyd, & + nze,nzf,intpol) +! +! add correction in phcor to phif on nonspecified boundaries +! + ist = 1 + ifn = nx + jst = 1 + jfn = ny + kst = 1 + kfn = nz + if (nxa.eq.1) ist = 2 + if (nxb.eq.1) ifn = nx-1 + if (nyc.eq.1) jst = 2 + if (nyd.eq.1) jfn = ny-1 + if (nze.eq.1) kst = 2 + if (nzf.eq.1) kfn = nz-1 + do k=kst,kfn + do j=jst,jfn + do i=ist,ifn + phif(i,j,k) = phif(i,j,k) + phcor(i,j,k) + end do + end do + end do +! +! add periodic points if necessary +! + if (nze.eq.0) then + do j=jst,jfn + do i=ist,ifn + phif(i,j,0) = phif(i,j,nz-1) + phif(i,j,nz+1) = phif(i,j,2) + end do + end do + end if + if (nyc.eq.0) then + do k=kst,kfn + do i=ist,ifn + phif(i,0,k) = phif(i,ny-1,k) + phif(i,ny+1,k) = phif(i,2,k) + end do + end do + end if + if (nxa.eq.0) then + do k=kst,kfn + do j=jst,jfn + phif(0,j,k) = phif(nx-1,j,k) + phif(nx+1,j,k) = phif(2,j,k) + end do + end do + end if + end subroutine cor3 +!----------------------------------------------------------------------- + subroutine per3vb(nx,ny,nz,phi,nxa,nyc,nze) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! set virtual periodic boundaries from interior values +! in three dimensions (for all 3-d solvers) +! + implicit none + integer nx,ny,nz,nxa,nyc,nze,j,k,i + real(r8) :: phi(0:nx+1,0:ny+1,0:nz+1) + if (nxa.eq.0) then + do k=1,nz + do j=1,ny + phi(0,j,k) = phi(nx-1,j,k) + phi(nx,j,k) = phi(1,j,k) + phi(nx+1,j,k) = phi(2,j,k) + end do + end do + end if + if (nyc.eq.0) then + do k=1,nz + do i=1,nx + phi(i,0,k) = phi(i,ny-1,k) + phi(i,ny,k) = phi(i,1,k) + phi(i,ny+1,k) = phi(i,2,k) + end do + end do + end if + if (nze.eq.0) then + do j=1,ny + do i=1,nx + phi(i,j,0) = phi(i,j,nz-1) + phi(i,j,nz) = phi(i,j,1) + phi(i,j,nz+1) = phi(i,j,2) + end do + end do + end if + return + end subroutine per3vb +!----------------------------------------------------------------------- + subroutine pde2cr(nx,ny,u,i,j,ux3y,uxy3,ux2y2) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! compute mixed partial derivative approximations +! + implicit none + integer nx,ny,i,j,n1,n2,n3,n4,m1,m2,m3,m4 + real(r8) :: u(nx,ny),ux3y,uxy3,ux2y2 + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + real(r8) :: dlx,dly,dyox,dxoy,dlx2,dly2,dlxx,dlxy,dlyy,dlxy2, & + dlxy4,dxxxy4,dxyyy4,dxxyy,tdlx3,tdly3,dlx4,dly4, & + dlxxx,dlyyy + common/com2dcr/dyox,dxoy,dlx2,dly2,dlxy,dlxy2,dlxy4, & + dxxxy4,dxyyy4,dxxyy,dlxxx,dlyyy + common/pde2com/dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 + n1=ny-1 + n2=ny-2 + n3=ny-3 + n4=ny-4 + m1=nx-1 + m2=nx-2 + m3=nx-3 + m4=nx-4 + + if (i.eq.1) then + + if ((j.gt.2.and.j.lt.ny-1)) then +! x=xa, yinterior + ux3y=(5*u(1,j-1)-18*u(2,j-1)+24*u(3,j-1)-14*u(4,j-1)+3*u(5,j-1) & + -5*u(1,j+1)+18*u(2,j+1)-24*u(3,j+1)+14*u(4,j+1)-3*u(5,j+1)) & + /dxxxy4 + uxy3=(3*u(1,j-2)-4*u(2,j-2)+u(3,j-2) & + -6*u(1,j-1)+8*u(2,j-1)-2*u(3,j-1) & + +6*u(1,j+1)-8*u(2,j+1)+2*u(3,j+1) & + -3*u(1,j+2)+4*u(2,j+2)-u(3,j+2))/dxyyy4 + else if (j.eq.1) then +! (xa,yc) + ux3y=(15*u(1,1)-54*u(2,1)+72*u(3,1)-42*u(4,1)+9*u(5,1) & + -20*u(1,2)+72*u(2,2)-96*u(3,2)+56*u(4,2)-12*u(5,2) & + +5*u(1,3)-18*u(2,3)+24*u(3,3)-14*u(4,3)+3*u(5,3)) & + /dxxxy4 + uxy3=(15*u(1,1)-20*u(2,1)+5*u(3,1) & + -54*u(1,2)+72*u(2,2)-18*u(3,2) & + +72*u(1,3)-96*u(2,3)+24*u(3,3) & + -42*u(1,4)+56*u(2,4)-14*u(3,4) & + +9*u(1,5)-12*u(2,5)+3*u(3,5)) & + /dxyyy4 + ux2y2=(4*u(1,1)-10*u(2,1)+8*u(3,1)-2*u(4,1) & + -10*u(1,2)+25*u(2,2)-20*u(3,2)+5*u(4,2) & + +8*u(1,3)-20*u(2,3)+16*u(3,3)-4*u(4,3) & + -2*u(1,4)+5*u(2,4)-4*u(3,4)+u(4,4)) & + /dxxyy + else if (j.eq.2) then +! (xa,yc+dly) + ux3y=(5*u(1,1)-18*u(2,1)+24*u(3,1)-14*u(4,1)+3*u(5,1) & + -5*u(1,3)+18*u(2,3)-24*u(3,3)+14*u(4,3)-3*u(5,3)) & + /dxxxy4 + uxy3=(9*u(1,1)-12*u(2,1)+3*u(3,1) & + -30*u(1,2)+40*u(2,2)-10*u(3,2) & + +36*u(1,3)-48*u(2,3)+12*u(3,3) & + -18*u(1,4)+24*u(2,4)-6*u(3,4) & + +3*u(1,5)-4*u(2,5)+u(3,5)) & + /dxyyy4 + else if (j.eq.ny-1) then +! x=xa,y=yd-dly + ux3y=(5*u(1,j-1)-18*u(2,j-1)+24*u(3,j-1)-14*u(4,j-1)+3*u(5,j-1) & + -5*u(1,j+1)+18*u(2,j+1)-24*u(3,j+1)+14*u(4,j+1)-3*u(5,j+1)) + uxy3=(5*u(1,n2)-18*u(2,n2)+24*u(3,n2)-14*u(4,n2)+3*u(5,n2) & + -5*u(1,ny)+18*u(2,ny)-24*u(3,ny)+14*u(4,ny)-3*u(5,ny)) & + /dxyyy4 + else if (j.eq.ny) then +! x=xa, y=yd + ux3y=(-5*u(1,n2)+18*u(2,n2)-24*u(3,n2)+14*u(4,n2)-3*u(5,n2) & + +20*u(1,n1)-72*u(2,n1)+96*u(3,n1)-56*u(4,n1)+12*u(5,n1) & + -15*u(1,ny)+54*u(2,ny)-72*u(3,ny)+42*u(4,ny)-9*u(5,ny)) & + /dxxxy4 + uxy3=(-9*u(1,n4)+12*u(2,n4)-3*u(3,n4) & + +42*u(1,n3)-56*u(2,n3)+14*u(3,n3) & + -72*u(1,n2)+96*u(2,n2)-24*u(3,n2) & + +54*u(1,n1)-72*u(2,n1)+18*u(3,n1) & + -15*u(1,ny)+20*u(2,ny)-5*u(3,ny)) & + /dxyyy4 + ux2y2=(-2*u(1,n3)+5*u(2,n3)-4*u(3,n3)+u(4,n3) & + +8*u(1,n2)-20*u(2,n2)+16*u(3,n2)-4*u(4,n2) & + -10*u(1,n1)+25*u(2,n1)-20*u(3,n1)+5*u(4,n1) & + +4*u(1,ny)-10*u(2,ny)+8*u(3,ny)-2*u(4,ny)) & + /dxxyy + end if + + else if (i.eq.2) then + + if ((j.gt.2.and.j.lt.ny-1)) then +! x=xa+dlx, y interior + ux3y=(3*u(1,j-1)-10*u(2,j-1)+12*u(3,j-1)-6*u(4,j-1)+u(5,j-1) & + -3*u(1,j+1)+10*u(2,j+1)-12*u(3,j+1)+6*u(4,j+1)-u(5,j+1))/dxxxy4 + uxy3=(u(1,j-2)-u(3,j-2)-2*u(1,j-1)+2*u(3,j-1) & + +2*u(1,j+1)-2*u(3,j+1)-u(1,j+2)+u(3,j+2))/dxyyy4 + else if (j.eq.1) then +! x=xa+dlx, y=yc + ux3y=(9*u(1,1)-30*u(2,1)+36*u(3,1)-18*u(4,1)+3*u(5,1) & + -12*u(1,2)+40*u(2,2)-48*u(3,2)+24*u(4,2)-4*u(5,2) & + +3*u(1,3)-10*u(2,3)+12*u(3,3)-6*u(4,3)+u(5,3)) & + /dxxxy4 + uxy3=(5*u(1,1)-5*u(3,1)-18*u(1,2)+18*u(3,2) & + +24*u(1,3)-24*u(3,3)-14*u(1,4) & + +14*u(3,4)+3*u(1,5)-3*u(3,5)) & + /dxyyy4 + else if (j.eq.2) then +! at x=xa+dlx,y=yc+dly + ux3y=(3*u(1,1)-10*u(2,1)+12*u(3,1)-6*u(4,1)+u(5,1) & + -3*u(1,3)+10*u(2,3)-12*u(3,3)+6*u(4,3)-u(5,3)) & + /dxxxy4 + uxy3=(3*u(1,1)-3*u(3,1)-10*u(1,2)+10*u(3,2) & + +12*u(1,3)-12*u(3,3)-6*u(1,4)+6*u(3,4) & + +u(1,5)-u(3,5)) & + /dxyyy4 + else if (j.eq.ny-1) then +! x=xa+dlx,y=yd-dly + ux3y=(3*u(1,n2)-10*u(2,n2)+12*u(3,n2)-6*u(4,n2)+u(5,n2) & + -3*u(1,ny)+10*u(2,ny)-12*u(3,ny)+6*u(4,ny)-u(5,ny)) & + /dxxxy4 + uxy3=(-u(1,n4)+u(3,n4)+6*u(1,n3)-6*u(3,n3) & + -12*u(1,n2)+12*u(3,n2)+10*u(1,n1)-10*u(3,n1) & + -3*u(1,ny)+3*u(3,ny)) & + /dxyyy4 + else if (j.eq.ny) then +! at x=xa+dlx,y=yd + ux3y=(-3*u(1,n2)+10*u(2,n2)-12*u(3,n2)+6*u(4,n2)-u(5,n2) & + +12*u(1,n1)-40*u(2,n1)+48*u(3,n1)-24*u(4,n1)+4*u(5,n1) & + -9*u(1,ny)+30*u(2,ny)-36*u(3,ny)+18*u(4,ny)-3*u(5,ny)) & + /dxxxy4 + uxy3=(-3*u(1,n4)+3*u(3,n4)+14*u(1,n3)-14*u(3,n3) & + -24*u(1,n2)+24*u(3,n2)+18*u(1,n1)-18*u(3,n1) & + -5*u(1,ny)+5*u(3,ny)) & + /dxyyy4 + end if + + else if (i.gt.2 .and. i.lt.nx-1) then + + if (j.eq.1) then +! y=yc,x interior + ux3y=(3.0_r8*u(i-2,1)-6.0_r8*u(i-1,1)+6.0_r8*u(i+1,1)-3.0_r8*u(i+2,1) & + -4.0_r8*u(i-2,2)+8.0_r8*u(i-1,2)-8.0_r8*u(i+1,2)+4.0_r8*u(i+2,2) & + +u(i-2,3)-2.0_r8*u(i-1,3)+2.0_r8*u(i+1,3)-u(i+2,3)) & + /dxxxy4 + uxy3=(5.0_r8*u(i-1,1)-5.0_r8*u(i+1,1)-18.0_r8*u(i-1,2)+18.0_r8*u(i+1,2) & + +24.0_r8*u(i-1,3)-24.0_r8*u(i+1,3)-14.0_r8*u(i-1,4)+14.0_r8*u(i+1,4) & + +3.0_r8*u(i-1,5)-3.0_r8*u(i+1,5)) & + /dxyyy4 + else if (j.eq.2) then +! y=yc+dly,x interior + ux3y=(u(i-2,1)-2.0_r8*u(i-1,1)+2.0_r8*u(i+1,1)-u(i+2,1) & + -u(i-2,3)+2.0_r8*u(i-1,3)-2.0_r8*u(i+1,3)+u(i+2,3)) & + /dxxxy4 + uxy3=(u(i-1,1)-u(i+1,1)-2.0_r8*u(i-1,2)+2.0_r8*u(i+1,2) & + +2.0_r8*u(i-1,4)-2.0_r8*u(i+1,4)-u(i-1,5)+u(i+1,5)) & + /dxyyy4 + else if (j.eq.ny-1) then +! y=yd-dly, x interior + ux3y=(u(i-2,n2)-2.0_r8*u(i-1,n2)+2.0_r8*u(i+1,n2)-u(i+2,n2) & + -u(i-2,ny)+2.0_r8*u(i-1,ny)-2.0_r8*u(i+1,ny)+u(i+2,ny)) & + /dxxxy4 + uxy3=(-u(i-1,n4)+u(i+1,n4)+6.0_r8*u(i-1,n3)-6.0_r8*u(i+1,n3) & + -12.0_r8*u(i-1,n2)+12.0_r8*u(i+1,n2)+10.0_r8*u(i-1,n1)-10.0_r8*u(i+1,n1) & + -3.0_r8*u(i-1,ny)+3.0_r8*u(i+1,ny)) & + /dxyyy4 + else if (j.eq.ny) then +! at y=yd, x interior + ux3y=(-u(i-2,n2)+2.0_r8*u(i-1,n2)-2.0_r8*u(i+1,n2)+u(i+2,n2) & + +4.0_r8*u(i-2,n1)-8.0_r8*u(i-1,n1)+8.0_r8*u(i+1,n1)-4.0_r8*u(i+2,n1) & + -3.0_r8*u(i-2,ny)+6.0_r8*u(i-1,ny)-6.0_r8*u(i+1,ny)+3.0_r8*u(i+2,ny)) & + /dxxxy4 + uxy3=(-3.0_r8*u(i-1,n4)+3.0_r8*u(i+1,n4)+14.0_r8*u(i-1,n3)-14.0_r8*u(i+1,n3) & + -24.0_r8*u(i-1,n2) +24.0_r8*u(i+1,n2)+18.0_r8*u(i-1,n1)-18.0_r8*u(i+1,n1) & + -5.0_r8*u(i-1,ny)+5.0_r8*u(i+1,ny)) & + /dxyyy4 + end if + + else if (i.eq.nx-1) then + + if ((j.gt.2.and.j.lt.ny-1)) then +! x=xb-dlx,y interior + ux3y=(-u(m4,j-1)+6._r8*u(m3,j-1)-12._r8*u(m2,j-1)+10._r8*u(m1,j-1)-3._r8*u(nx & + ,j-1)+u(m4,j+1)-6._r8*u(m3,j+1)+12._r8*u(m2,j+1)-10._r8*u(m1,j+1)+3._r8*u(nx,j & + +1)) /dxxxy4 + uxy3=(u(m2,j-2)-u(nx,j-2)-2._r8*u(m2,j-1)+2._r8*u(nx,j-1) & + +2._r8*u(m2,j+1)-2._r8*u(nx,j+1)-u(m2,j+2)+u(nx,j+2)) /dxyyy4 + else if (j.eq.1) then +! at x=xb-dlx, y=yc + ux3y=(-3.0_r8*u(m4,1)+18.0_r8*u(m3,1)-36.0_r8*u(m2,1)+30.0_r8*u(m1,1)-9.0_r8*u( & + nx,1)+4.0_r8*u(m4,2)-24.0_r8*u(m3,2)+48.0_r8*u(m2,2)-40.0_r8*u(m1,2)+12.0_r8*u(nx & + ,2)-u(m4,3)+6.0_r8*u(m3,3)-12.0_r8*u(m2,3)+10.0_r8*u(m1,3)-3.0_r8*u(nx,3)) & + /dxxxy4 + uxy3=(5.0_r8*u(m2,1)-5.0_r8*u(nx,1)-18.0_r8*u(m2,2)+18.0_r8*u(nx,2) & + +24.0_r8*u(m2,3)-24.0_r8*u(nx,3)-14.0_r8*u(m2,4)+14.0_r8*u(nx,4) & + +3.0_r8*u(m2,5)-3.0_r8*u(nx,5)) & + /dxyyy4 + else if (j.eq.2) then +! x=xb-dlx,y=yc+dly + ux3y=(-u(m4,1)+6.0_r8*u(m3,1)-12.0_r8*u(m2,1)+10._r8*u(m1,1)-3._r8*u(nx,1) & + +u(m4,3)-6.0_r8*u(m3,3)+12.0_r8*u(m2,3)-10._r8*u(m1,3)+3._r8*u(nx,3)) & + /dxxxy4 + uxy3=(3.0_r8*u(m2,1)-3._r8*u(nx,1)-10._r8*u(m2,2)+10._r8*u(nx,2) & + +12._r8*u(m2,3)-12._r8*u(nx,3)-6._r8*u(m2,4)+6._r8*u(nx,4) & + +u(m2,5)-u(nx,5)) / dxyyy4 + else if (j.eq.ny-1) then +! at x=xb-dlx,y=yd-dly + ux3y=(-u(m4,n2)+6._r8*u(m3,n2)-12._r8*u(m2,n2)+10._r8*u(m1,n2)-3._r8*u(nx,n2) & + +u(m4,ny)-6._r8*u(m3,ny)+12._r8*u(m2,ny)-10._r8*u(m1,ny)+3._r8*u(nx,ny)) & + /dxxxy4 + uxy3=(-u(m2,n4)+u(nx,n4)+6*u(m2,n3)-6._r8*u(nx,n3) & + -12._r8*u(m2,n2)+12._r8*u(nx,n2)+10._r8*u(m2,n1)-10._r8*u(nx,n1) & + -3._r8*u(m2,ny)+3._r8*u(nx,ny)) / dxyyy4 + else if (j.eq.ny) then +! at x=xb.dlx,y=yd + ux3y=(u(m4,n2)-6._r8*u(m3,n2)+12._r8*u(m2,n2)-10._r8*u(m1,n2)+3._r8*u(nx,n2) & + -4._r8*u(m4,n1)+24._r8*u(m3,n1)-48._r8*u(m2,n1)+40._r8*u(m1,n1)-12._r8*u(nx,n1) & + +3._r8*u(m4,ny)-18._r8*u(m3,ny)+36._r8*u(m2,ny)-30._r8*u(m1,ny)+9._r8*u(nx,ny)) & + / dxxxy4 + uxy3=(-3._r8*u(m2,n4)+3._r8*u(nx,n4)+14._r8*u(m2,n3)-14._r8*u(nx,n3) & + -24._r8*u(m2,n2)+24._r8*u(nx,n2)+18._r8*u(m2,n1)-18._r8*u(nx,n1) & + -5._r8*u(m2,ny)+5._r8*u(nx,ny)) / dxyyy4 + end if + + else if (i.eq.nx) then + + if ((j.gt.2.and.j.lt.ny-1)) then +! x=xb,y interior + ux3y=(-3._r8*u(m4,j-1)+14._r8*u(m3,j-1)-24._r8*u(m2,j-1)+18._r8*u(m1,j-1)-5._r8* & + u(nx,j-1)+3._r8*u(m4,j+1)-14._r8*u(m3,j+1)+24._r8*u(m2,j+1)-18._r8*u(m1,j+1)+5._r8* & + u(nx,j+1)) / dxxxy4 + uxy3=(-u(m2,j-2)+4._r8*u(m1,j-2)-3._r8*u(nx,j-2) & + +2._r8*u(m2,j-1)-8._r8*u(m1,j-1)+6._r8*u(nx,j-1) & + -2._r8*u(m2,j+1)+8._r8*u(m1,j+1)-6._r8*u(nx,j+1) & + +u(m2,j+2)-4._r8*u(m1,j+2)+3._r8*u(nx,j+2)) / dxyyy4 + else if (j.eq.1) then +! x=xb,y=yc + ux3y=(-9._r8*u(m4,1)+42._r8*u(m3,1)-72._r8*u(m2,1)+54._r8*u(m1,1)-15._r8*u(nx,1) & + +12._r8*u(m4,2)-56._r8*u(m3,2)+96._r8*u(m2,2)-72._r8*u(m1,2)+20._r8*u(nx,2) & + -3._r8*u(m4,3)+14._r8*u(m3,3)-24._r8*u(m2,3)+18._r8*u(m1,3)-5._r8*u(nx,3)) & + /dxxxy4 + uxy3=(-5._r8*u(m2,1)+20._r8*u(m1,1)-15._r8*u(nx,1) & + +18._r8*u(m2,2)-72._r8*u(m1,2)+54._r8*u(nx,2) & + -24._r8*u(m2,3)+96._r8*u(m1,3)-72._r8*u(nx,3) & + +14._r8*u(m2,4)-56._r8*u(m1,4)+42._r8*u(nx,4) & + -3._r8*u(m2,5)+12._r8*u(m1,5)-9._r8*u(nx,5)) / dxyyy4 + ux2y2=(-2._r8*u(m3,1)+8._r8*u(m2,1)-10._r8*u(m1,1)+4._r8*u(nx,1) & + +5._r8*u(m3,2)-20._r8*u(m2,2)+25._r8*u(m1,2)-10._r8*u(nx,2) & + -4._r8*u(m3,3)+16._r8*u(m2,3)-20._r8*u(m1,3)+8._r8*u(nx,3) & + +u(m3,4)-4._r8*u(m2,4)+5._r8*u(m1,4)-2._r8*u(nx,4)) / dxxyy + else if (j.eq.2) then +! x=xb,y=yc+dly + ux3y=(-3._r8*u(m4,1)+14._r8*u(m3,1)-24._r8*u(m2,1)+18._r8*u(m1,1)-5._r8*u(nx,1) & + +3._r8*u(m4,3)-14._r8*u(m3,3)+24._r8*u(m2,3)-18._r8*u(m1,3)+5._r8*u(nx,3)) & + / dxxxy4 + uxy3=(-3._r8*u(m2,1)+12._r8*u(m1,1)-9._r8*u(nx,1) & + +10._r8*u(m2,2)-40._r8*u(m1,2)+30._r8*u(nx,2) & + -12._r8*u(m2,3)+48._r8*u(m1,3)-36._r8*u(nx,3) & + +6._r8*u(m2,4)-24._r8*u(m1,4)+18._r8*u(nx,4) & + -u(m2,5)+4._r8*u(m1,5)-3._r8*u(nx,5)) / dxyyy4 + else if (j.eq.ny-1) then +! x=xb,y=yd-dly + ux3y=(-3._r8*u(m4,n2)+14._r8*u(m3,n2)-24._r8*u(m2,n2)+18._r8*u(m1,n2)-5._r8*u(nx & + ,n2)+3._r8*u(m4,ny)-14._r8*u(m3,ny)+24._r8*u(m2,ny)-18._r8*u(m1,ny)+5._r8*u(nx,ny & + )) / dxxxy4 + uxy3=(u(m2,n4)-4._r8*u(m1,n4)+3._r8*u(nx,n4) & + -6._r8*u(m2,n3)+24._r8*u(m1,n3)-18._r8*u(nx,n3) & + +12._r8*u(m2,n2)-48._r8*u(m1,n2)+36._r8*u(nx,n2) & + -10._r8*u(m2,n1)+40._r8*u(m1,n1)-30._r8*u(nx,n1) & + +3._r8*u(m2,ny)-12._r8*u(m1,ny)+9._r8*u(nx,ny)) / dxyyy4 + else if (j.eq.ny) then +! x=xb,y=yd + ux3y=(3._r8*u(m4,n2)-14._r8*u(m3,n2)+24._r8*u(m2,n2)-18._r8*u(m1,n2)+5._r8*u(nx, & + n2)-12._r8*u(m4,n1)+56._r8*u(m3,n1)-96._r8*u(m2,n1)+72._r8*u(m1,n1)-20._r8*u(nx, & + n1)+9._r8*u(m4,ny)-42._r8*u(m3,ny)+72._r8*u(m2,ny)-54._r8*u(m1,ny)+15._r8*u(nx,ny & + )) / dxxxy4 + uxy3=(3._r8*u(m2,n4)-12._r8*u(m1,n4)+9._r8*u(nx,n4) & + -14._r8*u(m2,n3)+56._r8*u(m1,n3)-42._r8*u(nx,n3) & + +24._r8*u(m2,n2)-96._r8*u(m1,n2)+72._r8*u(nx,n2) & + -18._r8*u(m2,n1)+72._r8*u(m1,n1)-54._r8*u(nx,n1) & + +5._r8*u(m2,ny)-20._r8*u(m1,ny)+15._r8*u(nx,ny)) / dxyyy4 + ux2y2=(u(m3,n3)-4._r8*u(m2,n3)+5._r8*u(m1,n3)-2._r8*u(nx,n3) & + -4._r8*u(m3,n2)+16._r8*u(m2,n2)-20._r8*u(m1,n2)+8._r8*u(nx,n2) & + +5.0_r8*u(m3,n1)-20._r8*u(m2,n1)+25._r8*u(m1,n1)-10._r8*u(nx,n1) & + -2._r8*u(m3,ny)+8._r8*u(m2,ny)-10._r8*u(m1,ny)+4._r8*u(nx,ny)) & + / dxxyy + end if + + end if + + return + end subroutine pde2cr +!----------------------------------------------------------------------- + subroutine pde3(nx,ny,nz,u,i,j,k,ux3,ux4,uy3,uy4,uz3,uz4, & + nxa,nyc,nze) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! estimate third and fourth partial derivatives in x,y,z +! + implicit none + integer nx,ny,nz,i,j,k,nxa,nyc,nze + real(r8) :: u(nx,ny,nz) + real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 + common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & + dlx4,dly4,dlz4 + real(r8) :: ux3,ux4,uy3,uy4,uz3,uz4 +! +! x,y partial derivatives +! + call p3de2(nx,ny,u(1,1,k),i,j,ux3,ux4,uy3,uy4,nxa,nyc) +! +! z partial derivatives +! + if (nze.ne.0) then +! +! nonperiodic in z +! + if(k.gt.2 .and. k.lt.nz-1) then + uz3=(-u(i,j,k-2)+2.0_r8*u(i,j,k-1)-2.0_r8*u(i,j,k+1)+u(i,j,k+2))/tdlz3 + uz4=(u(i,j,k-2)-4.0_r8*u(i,j,k-1)+6.0_r8*u(i,j,k)-4.0_r8*u(i,j,k+1)+ & + u(i,j,k+2))/dlz4 + else if (k.eq.1) then + uz3=(-5.0_r8*u(i,j,1)+18.0_r8*u(i,j,2)-24.0_r8*u(i,j,3)+14.0_r8*u(i,j,4)- & + 3.0_r8*u(i,j,5))/tdlz3 + uz4 = (3.0_r8*u(i,j,1)-14.0_r8*u(i,j,2)+26.0_r8*u(i,j,3)-24.0_r8*u(i,j,4)+ & + 11.0_r8*u(i,j,5)-2.0_r8*u(i,j,6))/dlz4 + else if (k.eq.2) then + uz3 = (-3.0_r8*u(i,j,1)+10.0_r8*u(i,j,2)-12.0_r8*u(i,j,3)+6.0_r8*u(i,j,4)- & + u(i,j,5))/tdlz3 + uz4 = (2.0_r8*u(i,j,1)-9.0_r8*u(i,j,2)+16.0_r8*u(i,j,3)-14.0_r8*u(i,j,4)+6.0_r8* & + u(i,j,5)-u(i,j,6))/dlz4 + else if (k.eq.nz-1) then + uz3 = (u(i,j,nz-4)-6.0_r8*u(i,j,nz-3)+12.0_r8*u(i,j,nz-2)-10.0_r8* & + u(i,j,nz-1)+3.0_r8*u(i,j,nz))/tdlz3 + uz4 = (-u(i,j,nz-5)+6.0_r8*u(i,j,nz-4)-14.0_r8*u(i,j,nz-3)+16.0_r8* & + u(i,j,nz-2)-9.0_r8*u(i,j,nz-1)+2.0_r8*u(i,j,nz))/dlz4 + else if (k.eq.nz) then + uz3 = (3.0_r8*u(i,j,nz-4)-14.0_r8*u(i,j,nz-3)+24.0_r8*u(i,j,nz-2)-18.0_r8* & + u(i,j,nz-1)+5.0_r8*u(i,j,nz))/tdlz3 + uz4 = (-2.0_r8*u(i,j,nz-5)+11.0_r8*u(i,j,nz-4)-24.0_r8*u(i,j,nz-3)+26.0_r8* & + u(i,j,nz-2)-14.0_r8*u(i,j,nz-1)+3.0_r8*u(i,j,nz))/dlz4 + end if + else +! +! periodic in z so use symmetric formula even "near" z boundaies +! + if(k.gt.2 .and. k.lt.nz-1) then + uz3=(-u(i,j,k-2)+2.0_r8*u(i,j,k-1)-2.0_r8*u(i,j,k+1)+u(i,j,k+2))/tdlz3 + uz4=(u(i,j,k-2)-4.0_r8*u(i,j,k-1)+6.0_r8*u(i,j,k)-4.0_r8*u(i,j,k+1)+ & + u(i,j,k+2))/dlz4 + else if (k.eq.1) then + uz3 = (-u(i,j,nz-2)+2.0_r8*u(i,j,nz-1)-2.0_r8*u(i,j,2)+u(i,j,3))/tdlz3 + uz4 = (u(i,j,nz-2)-4.0_r8*u(i,j,nz-1)+6.0_r8*u(i,j,1)-4.0_r8*u(i,j,2)+ & + u(i,j,3))/dlz4 + else if (k.eq.2) then + uz3 = (-u(i,j,nz-1)+2.0_r8*u(i,j,1)-2.0_r8*u(i,j,3)+u(i,j,4))/(tdlz3) + uz4 = (u(i,j,nz-1)-4.0_r8*u(i,j,1)+6.0_r8*u(i,j,2)-4.0_r8*u(i,j,3)+ & + u(i,j,4))/dlz4 + else if (k.eq.nz-1) then + uz3 = (-u(i,j,nz-3)+2.0_r8*u(i,j,nz-2)-2.0_r8*u(i,j,1)+u(i,j,2))/tdlz3 + uz4 = (u(i,j,nz-3)-4.0_r8*u(i,j,nz-2)+6.0_r8*u(i,j,nz-1)-4.0_r8*u(i,j,1)+ & + u(i,j,2))/ dlz4 + else if (k.eq.nz) then + uz3 = (-u(i,j,nz-2)+2.0_r8*u(i,j,nz-1)-2.0_r8*u(i,j,2)+u(i,j,3))/tdlz3 + uz4 = (u(i,j,nz-2)-4.0_r8*u(i,j,nz-1)+6.0_r8*u(i,j,nz)-4.0_r8*u(i,j,2)+ & + u(i,j,3))/dlz4 + end if + end if + return + end subroutine pde3 +!----------------------------------------------------------------------- + subroutine p3de2(nx,ny,u,i,j,ux3,ux4,uy3,uy4,nxa,nyc) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! third and fourth partial derivatives in x and y +! + implicit none + integer nx,ny,i,j,nxa,nyc,l + real(r8) :: u(nx,ny) + real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 + common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & + dlx4,dly4,dlz4 + real(r8) :: ux3,ux4,uy3,uy4 + l=ny +! +! x partial derivatives +! + call p3de1(nx,u(1,j),i,ux3,ux4,nxa) +! +! y partial derivatives +! + if (nyc.ne.0) then +! +! not periodic in y +! + if (j.gt.2 .and. j.lt.ny-1) then + uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 + uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2))/ & + dly4 + else if (j.eq.1) then + uy3 = (-5.0_r8*u(i,1)+18.0_r8*u(i,2)-24.0_r8*u(i,3)+14.0_r8*u(i,4)- & + 3.0_r8*u(i,5))/tdly3 + uy4 = (3.0_r8*u(i,1)-14.0_r8*u(i,2)+26.0_r8*u(i,3)-24.0_r8*u(i,4)+ & + 11.0_r8*u(i,5)-2.0_r8*u(i,6))/dly4 + else if (j.eq.2) then + uy3 = (-3.0_r8*u(i,1)+10.0_r8*u(i,2)-12.0_r8*u(i,3)+6.0_r8*u(i,4)-u(i,5))/ & + tdly3 + uy4 = (2.0_r8*u(i,1)-9.0_r8*u(i,2)+16.0_r8*u(i,3)-14.0_r8*u(i,4)+6.0_r8*u(i,5)- & + u(i,6))/dly4 + else if (j.eq.ny-1) then + uy3 = (u(i,l-4)-6.0_r8*u(i,l-3)+12.0_r8*u(i,l-2)-10.0_r8*u(i,l-1)+ & + 3.0_r8*u(i,l))/tdly3 + uy4 = (-u(i,l-5)+6.0_r8*u(i,l-4)-14.0_r8*u(i,l-3)+16.0_r8*u(i,l-2)- & + 9.0_r8*u(i,l-1)+2.0_r8*u(i,l))/dly4 + else if (j.eq.ny) then + uy3 = (3.0_r8*u(i,l-4)-14.0_r8*u(i,l-3)+24.0_r8*u(i,l-2)-18.0_r8*u(i,l-1)+ & + 5.0_r8*u(i,l))/tdly3 + uy4 = (-2.0_r8*u(i,l-5)+11.0_r8*u(i,l-4)-24.0_r8*u(i,l-3)+26.0_r8*u(i,l-2)- & + 14.0_r8*u(i,l-1)+3.0_r8*u(i,l))/dly4 + end if + else +! +! periodic in y +! + if (j.gt.2 .and. j.lt.ny-1) then + uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 + uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2))/ & + dly4 + else if (j.eq.1) then + uy3 = (-u(i,l-2)+2.0_r8*u(i,l-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 + uy4 = (u(i,l-2)-4.0_r8*u(i,l-1)+6.0_r8*u(i,1)-4.0_r8*u(i,2)+u(i,3))/dly4 + else if (j.eq.2) then + uy3 = (-u(i,l-1)+2.0_r8*u(i,1)-2.0_r8*u(i,3)+u(i,4))/(tdly3) + uy4 = (u(i,l-1)-4.0_r8*u(i,1)+6.0_r8*u(i,2)-4.0_r8*u(i,3)+u(i,4))/dly4 + else if (j.eq.ny-1) then + uy3 = (-u(i,l-3)+2.0_r8*u(i,l-2)-2.0_r8*u(i,1)+u(i,2))/tdly3 + uy4 = (u(i,l-3)-4.0_r8*u(i,l-2)+6.0_r8*u(i,l-1)-4.0_r8*u(i,1)+u(i,2))/ & + dly4 + else if (j.eq.ny) then + uy3 = (-u(i,l-2)+2.0_r8*u(i,l-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 + uy4 = (u(i,l-2)-4.0_r8*u(i,l-1)+6.0_r8*u(i,l)-4.0_r8*u(i,2)+u(i,3))/dly4 + end if + end if + return + end subroutine p3de2 +!----------------------------------------------------------------------- + subroutine p3de1(nx,u,i,ux3,ux4,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! third and fourth derivatives in x +! + implicit none + integer nx,i,nxa,k + real(r8) :: u(nx) + real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 + common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & + dlx4,dly4,dlz4 + real(r8) :: ux3,ux4 + k = nx + if (nxa.ne.0) then +! +! nonperiodic in x +! + if(i.gt.2 .and. i.lt.nx-1) then + ux3 = (-u(i-2)+2.0_r8*u(i-1)-2.0_r8*u(i+1)+u(i+2))/tdlx3 + ux4 = (u(i-2)-4.0_r8*u(i-1)+6.0_r8*u(i)-4.0_r8*u(i+1)+u(i+2))/dlx4 + else if (i.eq.1) then + ux3 = (-5.0_r8*u(1)+18.0_r8*u(2)-24.0_r8*u(3)+14.0_r8*u(4)-3.0_r8*u(5))/tdlx3 + ux4 = (3.0_r8*u(1)-14.0_r8*u(2)+26.0_r8*u(3)-24.0_r8*u(4)+11.0_r8*u(5)-2.0_r8*u(6)) & + /dlx4 + else if (i.eq.2) then + ux3 = (-3.0_r8*u(1)+10.0_r8*u(2)-12.0_r8*u(3)+6.0_r8*u(4)-u(5))/tdlx3 + ux4 = (2.0_r8*u(1)-9.0_r8*u(2)+16.0_r8*u(3)-14.0_r8*u(4)+6.0_r8*u(5)-u(6))/dlx4 + else if (i.eq.nx-1) then + ux3 = (u(k-4)-6.0_r8*u(k-3)+12.0_r8*u(k-2)-10.0_r8*u(k-1)+3.0_r8*u(k))/tdlx3 + ux4 = (-u(k-5)+6.0_r8*u(k-4)-14.0_r8*u(k-3)+16.0_r8*u(k-2)-9.0_r8*u(k-1)+ & + 2.0_r8*u(k))/dlx4 + else if (i.eq.nx) then + ux3 = (3.0_r8*u(k-4)-14.0_r8*u(k-3)+24.0_r8*u(k-2)-18.0_r8*u(k-1)+5.0_r8*u(k))/ & + tdlx3 + ux4 = (-2.0_r8*u(k-5)+11.0_r8*u(k-4)-24.0_r8*u(k-3)+26.0_r8*u(k-2)- & + 14.0_r8*u(k-1)+3.0_r8*u(k))/dlx4 + end if + else +! +! periodic in x +! + if(i.gt.2 .and. i.lt.nx-1) then + ux3 = (-u(i-2)+2.0_r8*u(i-1)-2.0_r8*u(i+1)+u(i+2))/tdlx3 + ux4 = (u(i-2)-4.0_r8*u(i-1)+6.0_r8*u(i)-4.0_r8*u(i+1)+u(i+2))/dlx4 + else if (i.eq.1) then + ux3 = (-u(k-2)+2.0_r8*u(k-1)-2.0_r8*u(2)+u(3))/tdlx3 + ux4 = (u(k-2)-4.0_r8*u(k-1)+6.0_r8*u(1)-4.0_r8*u(2)+u(3))/dlx4 + else if (i.eq.2) then + ux3 = (-u(k-1)+2.0_r8*u(1)-2.0_r8*u(3)+u(4))/(tdlx3) + ux4 = (u(k-1)-4.0_r8*u(1)+6.0_r8*u(2)-4.0_r8*u(3)+u(4))/dlx4 + else if (i.eq.nx-1) then + ux3 = (-u(k-3)+2.0_r8*u(k-2)-2.0_r8*u(1)+u(2))/tdlx3 + ux4 = (u(k-3)-4.0_r8*u(k-2)+6.0_r8*u(k-1)-4.0_r8*u(1)+u(2))/dlx4 + else if (i.eq.nx) then + ux3 = (-u(k-2)+2.0_r8*u(k-1)-2.0_r8*u(2)+u(3))/tdlx3 + ux4 = (u(k-2)-4.0_r8*u(k-1)+6.0_r8*u(k)-4.0_r8*u(2)+u(3))/dlx4 + end if + end if + return + end subroutine p3de1 +!----------------------------------------------------------------------- +! +! factri and factrip are: +! subroutines called by any real mudpack solver which uses line +! relaxation(s) within multigrid iteration. these subroutines do +! a vectorized factorization of m simultaneous tridiagonal systems +! of order n arising from nonperiodic or periodic discretizations +! + subroutine factri(m,n,a,b,c) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! factor the m simultaneous tridiagonal systems of order n +! + implicit none + integer m,n,i,j + real(r8) :: a(n,m),b(n,m),c(n,m) + do i=2,n + do j=1,m + a(i-1,j) = a(i-1,j)/b(i-1,j) + b(i,j) = b(i,j)-a(i-1,j)*c(i-1,j) + end do + end do + return + end subroutine factri +!----------------------------------------------------------------------- + subroutine factrp(m,n,a,b,c,d,e,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! factor the m simultaneous "tridiagonal" systems of order n +! from discretized periodic system (leave out periodic n point) +! (so sweeps below only go from i=1,2,...,n-1) n > 3 is necessary +! + implicit none + integer m,n,i,j + real(r8) :: a(n,m),b(n,m),c(n,m),d(n,m),e(n,m),sum(m) + do j=1,m + d(1,j) = a(1,j) + end do + do i=2,n-2 + do j=1,m + a(i,j) = a(i,j)/b(i-1,j) + b(i,j) = b(i,j)-a(i,j)*c(i-1,j) + d(i,j) = -a(i,j)*d(i-1,j) + end do + end do +! +! correct computation of last d element +! + do j=1,m + d(n-2,j) = c(n-2,j)+d(n-2,j) + end do + do j=1,m + e(1,j) = c(n-1,j)/b(1,j) + end do + do i=2,n-3 + do j=1,m + e(i,j) = -e(i-1,j)*c(i-1,j)/b(i,j) + end do + end do + do j=1,m + e(n-2,j) = (a(n-1,j)-e(n-3,j)*c(n-3,j))/b(n-2,j) + end do +! +! compute inner product (e,d) for each j in sum(j) +! + do j=1,m + sum(j) = 0._r8 + end do + do i=1,n-2 + do j=1,m + sum(j) = sum(j)+e(i,j)*d(i,j) + end do + end do +! +! set last diagonal element +! + do j=1,m + b(n-1,j) = b(n-1,j)-sum(j) + end do + return + end subroutine factrp +!----------------------------------------------------------------------- + subroutine transp(n,amat) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! transpose n by n real matrix +! + implicit none + integer n,i,j + real(r8) :: amat(n,n),temp + do i=1,n-1 + do j=i+1,n + temp = amat(i,j) + amat(i,j) = amat(j,i) + amat(j,i) = temp + end do + end do + return + end subroutine transp +!----------------------------------------------------------------------- + subroutine sgfa (a,lda,n,ipvt,info) + use shr_kind_mod ,only: r8 => shr_kind_r8 + integer lda,n,ipvt(1),info + real(r8) :: a(lda,1) + real(r8) :: t + integer isfmax,j,k,kp1,l,nm1 + info = 0 + nm1 = n - 1 + if (nm1 .lt. 1) go to 70 + do 60 k = 1, nm1 + kp1 = k + 1 + l = isfmax(n-k+1,a(k,k),1) + k - 1 + ipvt(k) = l + if (a(l,k) .eq. 0.0e0_r8) go to 40 + if (l .eq. k) go to 10 + t = a(l,k) + a(l,k) = a(k,k) + a(k,k) = t + 10 continue + t = -1.0e0_r8/a(k,k) + call sscl(n-k,t,a(k+1,k),1) + do 30 j = kp1, n + t = a(l,j) + if (l .eq. k) go to 20 + a(l,j) = a(k,j) + a(k,j) = t + 20 continue + call sxpy(n-k,t,a(k+1,k),1,a(k+1,j),1) + 30 continue + go to 50 + 40 continue + info = k + 50 continue + 60 continue + 70 continue + ipvt(n) = n + if (a(n,n) .eq. 0.0e0_r8) info = n + return + end subroutine sgfa +!----------------------------------------------------------------------- + subroutine sgsl (a,lda,n,ipvt,b,job) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer lda,n,ipvt(1),job + real(r8) :: a(lda,1),b(1) + real(r8) :: sdt,t + integer k,kb,l,nm1 + nm1 = n - 1 + if (job .ne. 0) go to 50 + if (nm1 .lt. 1) go to 30 + do 20 k = 1, nm1 + l = ipvt(k) + t = b(l) + if (l .eq. k) go to 10 + b(l) = b(k) + b(k) = t + 10 continue + call sxpy(n-k,t,a(k+1,k),1,b(k+1),1) + 20 continue + 30 continue + do 40 kb = 1, n + k = n + 1 - kb + b(k) = b(k)/a(k,k) + t = -b(k) + call sxpy(k-1,t,a(1,k),1,b(1),1) + 40 continue + go to 100 + 50 continue + do 60 k = 1, n + t = sdt(k-1,a(1,k),1,b(1),1) + b(k) = (b(k) - t)/a(k,k) + 60 continue + if (nm1 .lt. 1) go to 90 + do 80 kb = 1, nm1 + k = n - kb + b(k) = b(k) + sdt(n-k,a(k+1,k),1,b(k+1),1) + l = ipvt(k) + if (l .eq. k) go to 70 + t = b(l) + b(l) = b(k) + b(k) = t + 70 continue + 80 continue + 90 continue + 100 continue + return + end subroutine sgsl +!----------------------------------------------------------------------- + function sdt(n,sx,incx,sy,incy) result(sdtx) + use shr_kind_mod ,only: r8 => shr_kind_r8 + + implicit none + + real(r8), intent(in) :: sx(1),sy(1) + integer, intent(in) :: n, incx, incy + + integer :: i,ix,iy,m,mp1 + real(r8) :: sdtx + real(r8) :: stemp + + stemp = 0.0e0_r8 + sdtx = 0.0e0_r8 + if(n.le.0)return + if(incx.eq.1.and.incy.eq.1)go to 20 + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + stemp = stemp + sx(ix)*sy(iy) + ix = ix + incx + iy = iy + incy + 10 continue + sdtx = stemp + return + 20 m = mod(n,5) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + stemp = stemp + sx(i)*sy(i) + 30 continue + if( n .lt. 5 ) go to 60 + 40 mp1 = m + 1 + do 50 i = mp1,n,5 + stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + & + sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) + 50 continue + 60 sdtx = stemp + return + end function sdt +!----------------------------------------------------------------------- + integer function isfmax(n,sx,incx) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + real(r8) :: sx(1),smax + integer i,incx,ix,n + isfmax = 0 + if( n .lt. 1 ) return + isfmax = 1 + if(n.eq.1)return + if(incx.eq.1)go to 20 + ix = 1 + smax = abs(sx(1)) + ix = ix + incx + do 10 i = 2,n + if(abs(sx(ix)).le.smax) go to 5 + isfmax = i + smax = abs(sx(ix)) + 5 ix = ix + incx + 10 continue + return + 20 smax = abs(sx(1)) + do 30 i = 2,n + if(abs(sx(i)).le.smax) go to 30 + isfmax = i + smax = abs(sx(i)) + 30 continue + return + end function isfmax +!----------------------------------------------------------------------- + subroutine sxpy(n,sa,sx,incx,sy,incy) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + real(r8) :: sx(1),sy(1),sa + integer i,incx,incy,ix,iy,m,mp1,n + if(n.le.0)return + if (sa .eq. 0.0_r8) return + if(incx.eq.1.and.incy.eq.1)go to 20 + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + sy(iy) = sy(iy) + sa*sx(ix) + ix = ix + incx + iy = iy + incy + 10 continue + return + 20 m = mod(n,4) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sy(i) = sy(i) + sa*sx(i) + 30 continue + if( n .lt. 4 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,4 + sy(i) = sy(i) + sa*sx(i) + sy(i + 1) = sy(i + 1) + sa*sx(i + 1) + sy(i + 2) = sy(i + 2) + sa*sx(i + 2) + sy(i + 3) = sy(i + 3) + sa*sx(i + 3) + 50 continue + return + end subroutine sxpy +!----------------------------------------------------------------------- + subroutine sscl(n,sa,sx,incx) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + real(r8) :: sa,sx(1) + integer i,incx,m,mp1,n,nincx + if(n.le.0)return + if(incx.eq.1)go to 20 + nincx = n*incx + do 10 i = 1,nincx,incx + sx(i) = sa*sx(i) + 10 continue + return + 20 m = mod(n,5) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sx(i) = sa*sx(i) + 30 continue + if( n .lt. 5 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,5 + sx(i) = sa*sx(i) + sx(i + 1) = sa*sx(i + 1) + sx(i + 2) = sa*sx(i + 2) + sx(i + 3) = sa*sx(i + 3) + sx(i + 4) = sa*sx(i + 4) + 50 continue + return + end subroutine sscl +!----------------------------------------------------------------------- +!end module mudcom diff --git a/src/ionosphere/waccmx/edyn_mudmod.F90 b/src/ionosphere/waccmx/edyn_mudmod.F90 new file mode 100644 index 0000000000..7fb68acbc0 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_mudmod.F90 @@ -0,0 +1,794 @@ +!----------------------------------------------------------------------- + subroutine mudmod(pe,phi_out,jntl,isolve,ier) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun + use edyn_solve ,only: cee + use cam_logfile ,only: iulog + + implicit none + + integer jntl,ier ! output: not converged ier < 0 + integer,intent(in) :: isolve +! +! set grid size params +! + integer iixp,jjyq,iiex,jjey,nnx,nny,llwork + parameter (iixp = 5 , jjyq = 3, iiex = 5, jjey = 5 ) + parameter (nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1) +! +! estimate work space for point relaxation (see mud2cr.d) +! + parameter (llwork=(7*(nnx+2)*(nny+2)+76*nnx*nny)/3 ) + real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) + real(r8) :: phi_out(0:nnx+1,0:nny+1) + real(r8) :: time0,time1 +! +! put integer and floating point argument names in contiguous +! storage for labelling in vectors iprm,fprm +! + integer iprm(17),mgopt(4) + real(r8) :: fprm(6) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& + iguess,maxcy,method,nwork,lwrkqd,itero + common/itmud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny, & + iguess,maxcy,method,nwork,lwrkqd,itero + real(r8) :: xa,xb,yc,yd,tolmax,relmax + common/ftmud2cr/xa,xb,yc,yd,tolmax,relmax + equivalence(intl,iprm) + equivalence(xa,fprm) + integer i,j,ierror + real(r8) :: PE(NNX,*) + integer maxcya + DATA MAXCYA/50/ + integer mm,nn,jj,jjj,ij + real(r8) :: pi +! +! set input integer arguments +! + MM = NNX + NN = NNY + PI = 4._r8*ATAN(1._r8) +! +! SET INPUT INTEGER PARAMETERS +! + INTL = JNTL +! +! set boundary condition flags +! + nxa = 0 + nxb = 0 + nyc = 2 + nyd = 1 +! +! set grid sizes from parameter statements +! + ixp = iixp + jyq = jjyq + iex = iiex + jey = jjey + nx = nnx + ny = nny +! +! set multigrid arguments (w(2,1) cycling with fully weighted +! residual restriction and cubic prolongation) +! + mgopt(1) = 2 + mgopt(2) = 3 + mgopt(3) = 2 + mgopt(4) = 3 +! +! set for one cycle +! + maxcy = maxcya +! +! set no initial guess forcing full multigrid cycling +! + iguess = 0 +! +! set work space length approximation from parameter statement +! + nwork = llwork +! +! set line z relaxation +! + method = 3 +! +! set end points of solution rectangle in (x,y) space +! + xa = -pi + xb = pi + yc = 0.0_r8 + yd = 0.5_r8*pi +! +! set error control flag +! + tolmax = 0.001_r8 +! +! set right hand side in rhs +! initialize phi to zero +! + do i=1,nx + do j=1,ny + rhs(i,j) = cee(i+(j-1)*nx+9*nx*ny) + phi(i,j) = 0.0_r8 + end do + end do +! +! set specified boundaries in phi +! + do i=1,nx + phi(i,ny) = rhs(i,ny)/cee(i+(ny-1)*nx+8*nx*ny) + end do + +! write(iulog,100) +! 100 format(//' mud2cr test ') +! write (iulog,101) (iprm(i),i=1,15) +! 101 format(/,' integer input arguments ',/, +! | ' intl = ',i2,/,' nxa = ',i2,' nxb = ',i2,' nyc = ',i2, +! | ' nyd = ',i2,/,' ixp = ',i2,' jyq = ',i2,' iex = ',i2, +! | ' jey = ',i2,/,' nx = ',i3,' ny = ',i3,' iguess = ',i2, +! | ' maxcy = ',i3,/,' method = ',i2, ' work space estimate = ',i7) +! write (iulog,102) (mgopt(i),i=1,4) +! 102 format(/' multigrid option arguments ', +! | /,' kcycle = ',i2, +! | /,' iprer = ',i2, +! | /,' ipost = ',i2 +! | /,' intpol = ',i2) +! write(iulog,103) xa,xb,yc,yd,tolmax +! 103 format(/' floating point input parameters ', +! | /,' xa = ',f6.3,' xb = ',f6.3,' yc = ',f6.3,' yd = ',f6.3, +! | /,' tolerance (error control) = ',e10.3) +! write(iulog,"('fprm(1-5) (xa,xb,yc,yd,tolmax=',6f8.3)") fprm(1:5) +! +! intialization call +! +! write(iulog,104) intl +! 104 format(/' discretization call to mud2cr', ' intl = ', i2) + + call mud2cm(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) + +! write (iulog,200) ierror,iprm(16) +! 200 format(' ierror = ',i2, ' minimum work space = ',i7) +! if (ierror.gt.0) call exit(0) +! +! attempt solution +! + intl = 1 +! write(iulog,106) intl,method,iguess +! 106 format(/' approximation call to mud2cr', +! +/' intl = ',i2, ' method = ',i2,' iguess = ',i2) + + call mud2cm(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) + ier = ierror ! ier < 0 not converged + if(ier < 0 ) goto 108 + +! write (iulog,107) ierror +! 107 format(' ierror = ',i2) + if (ierror.gt.0) call endrun('mudmod call mud2cm') +! +! COPY PHI TO PE +! + DO J = 1,NY + JJ = NY+J-1 + JJJ = NY+1-J + DO I = 1,NX + PE(I,JJ) = PHI(I,J) + PE(I,JJJ) = PHI(I,J) + END DO + END DO + +! am 8/10 for calculating residual: convert work array (solution) into array +! sized as coefficient stencil (c0, cofum) including values at index 0, nmlon0+1 +! and nmlat0+1 + + do j=0,ny+1 + jj = j*(nx+2) + do i=0,nx+1 + ij = jj+i+1 + phi_out(i,j) = work(ij) + end do + end do + + 108 continue + end subroutine mudmod +!------------------------------------------------------------------- + subroutine mud2cm(iparm,fparm,work,rhs,phi,mgopt,ierror,isolve) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_logfile ,only: iulog + implicit none + integer,intent(in) :: isolve + integer iparm,mgopt,ierror + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: fparm,xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer int,iw,k,kb,nx,ny,ic,itx,ity + dimension iparm(17),fparm(6),mgopt(4) + real(r8) :: work(*),phi(*),rhs(*) + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50), & + nxk(50),nyk(50),isx,jsy + + data int / 0 / + save int + + ierror = 1 + intl = iparm(1) ! set and check intl on all calls + if (intl*(intl-1).ne.0) return + if (int.eq.0) then + int = 1 + if (intl.ne.0) return ! very first call is not intl=0 + end if + ierror = 0 +! +! set arguments internally +! these will not be rechecked if intl=1! +! + nxa = iparm(2) + nxb = iparm(3) + nyc = iparm(4) + nyd = iparm(5) + ixp = iparm(6) + jyq = iparm(7) + iex = iparm(8) + jey = iparm(9) + ngrid = max0(iex,jey) + nfx = iparm(10) + nfy = iparm(11) + iguess = iparm(12) + maxcy = iparm(13) + method = iparm(14) + nwork = iparm(15) + kcycle = mgopt(1) + if (kcycle .eq. 0) then +! set defaults + kcycle = 2 + iprer = 2 + ipost = 1 + intpol = 3 + else + iprer = mgopt(2) + ipost = mgopt(3) + intpol = mgopt(4) + end if + xa = fparm(1) + xb = fparm(2) + yc = fparm(3) + yd = fparm(4) + tolmax = fparm(5) + if (intl .eq. 0) then ! intialization call +! +! check input arguments +! + ierror = 2 ! check boundary condition flags + if (max0(nxa,nxb,nyc,nyd).gt.2) return + if (min0(nxa,nxb,nyc,nyd).lt.0) return + if (nxa.eq.0.and.nxb.ne.0) return + if (nxa.ne.0.and.nxb.eq.0) return + if (nyc.eq.0.and.nyd.ne.0) return + if (nyc.ne.0.and.nyd.eq.0) return + ierror = 3 ! check grid sizes + if (ixp.lt.2) return + if (jyq.lt.2) return + ierror = 4 + ngrid = max0(iex,jey) + if (iex.lt.1) return + if (jey.lt.1) return + if (ngrid.gt.50) return + ierror = 5 + if (nfx.ne.ixp*2**(iex-1)+1) return + if (nfy.ne.jyq*2**(jey-1)+1) return + ierror = 6 + if (iguess*(iguess-1).ne.0) return + ierror = 7 + if (maxcy.lt.1) return + ierror = 8 + if (method.lt.0 .or. method.gt.3) return + ierror = 9 +! compute and test minimum work space + isx = 0 + if (method.eq.1 .or. method.eq.3) then + if (nxa.ne.0) isx = 3 + if (nxa.eq.0) isx = 5 + end if + jsy = 0 + if (method.eq.2 .or. method.eq.3) then + if (nyc.ne.0) jsy = 3 + if (nyc.eq.0) jsy = 5 + end if + kps = 1 + do k=1,ngrid +! set subgrid sizes + nxk(k) = ixp*2**(max0(k+iex-ngrid,1)-1)+1 + nyk(k) = jyq*2**(max0(k+jey-ngrid,1)-1)+1 + nx = nxk(k) + ny = nyk(k) + kps = kps+(nx+2)*(ny+2)+nx*ny*(10+isx+jsy) + end do + iparm(16) = kps+(nfx+2)*(nfy+2) ! exact minimum work space + lwork = iparm(16) + if (lwork .gt. nwork) return + ierror = 10 ! check solution region + if (xb.le.xa .or. yd.le.yc) return + ierror = 11 + if (tolmax .lt. 0.0_r8) return + ierror = 12 ! multigrid parameters + if (kcycle.lt.0) return + if (min0(iprer,ipost).lt.1) return + if ((intpol-1)*(intpol-3).ne.0) return + if (max0(kcycle,iprer,ipost).gt.2) then + ierror = -5 ! inefficient multigrid cycling + end if + if (ierror .gt. 0) ierror = 0 ! no fatal errors +! +! set work space pointers and discretize pde at each grid level +! + iw = 1 + do kb=1,ngrid + k = ngrid-kb+1 + nx = nxk(k) + ny = nyk(k) + kpbgn(k) = iw + kcbgn(k) = kpbgn(k)+(nx+2)*(ny+2) + ktxbgn(k) = kcbgn(k)+10*nx*ny + ktybgn(k) = ktxbgn(k)+isx*nx*ny + iw = ktybgn(k)+jsy*nx*ny + ic = kcbgn(k) + itx = ktxbgn(k) + ity = ktybgn(k) + klevel = k + call dismd2cr(nx,ny,work(ic),work(itx),work(ity), & + work,ierror,isolve) + end do + return + end if ! end of intl=0 initialization call block + nx = nfx + ny = nfy + call mud2c1m(nx,ny,rhs,phi,work) + iparm(17) = itero + if (tolmax.gt.0.0_r8) then ! check for convergence + fparm(6) = relmax + if (relmax.gt.tolmax) then + +! ierror = -1 ! flag convergenc failure + write(iulog,*) "no convergence with mudmod" +! + iguess = 1 + iparm(12)= iguess + call mud2cr1(nx,ny,rhs,phi,work) ! solve with modified stencils + + fparm(6) = relmax + if (relmax.gt.tolmax) then + write(iulog,*) "no convergence with mud" + ierror = -1 ! flag convergenc failure + end if + + end if + end if + + return + end subroutine mud2cm +!------------------------------------------------------------------------ + subroutine mud2c1m(nx,ny,rhsf,phif,wk) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny + real(r8) :: phif(nx,ny),rhsf(nx,ny),wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax,phmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer k,kb,ip,ic,ir,ipc,irc,icc + integer ncx,ncy,jj,ij,i,j,iter + integer iw,itx,ity,ierror + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50), & + nxk(50),nyk(50),isx,jsy + + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + ir = ic+9*nx*ny +! +! set phif,rhsf in wk and adjust right hand side +! + call swk2(nx,ny,phif,rhsf,wk(ip),wk(ir)) + if (iguess.eq.0) then +! +! no initial guess at finest grid level! +! + do kb=2,ngrid + k = ngrid-kb+1 + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ir = kcbgn(k+1)+9*nx*ny + ncx = nxk(k) + ncy = nyk(k) + ipc = kpbgn(k) + icc = kcbgn(k) + irc = icc+9*ncx*ncy +! +! transfer down to all grid levels +! + call trsfc2(nx,ny,wk(ip),wk(ir),ncx,ncy,wk(ipc),wk(irc)) + end do +! +! adjust right hand side at all grid levels in case +! rhs or specified b.c. in phi or gbdy changed +! + do k=1,ngrid + nx = nxk(k) + ny = nyk(k) + ip = kpbgn(k) + ic = kcbgn(k) + call adjmd2cr(nx,ny,wk(ip),wk(ic)) + end do +! +! execute one full multigrid cycle +! + do k=1,ngrid-1 + kcur = k + call kcymd2cr(wk) + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ipc = kpbgn(k) + ncx = nxk(k) + ncy = nyk(k) +! +! lift or prolong approximation from k to k+1 +! + call prolon2(ncx,ncy,wk(ipc),nx,ny,wk(ip),nxa,nxb,nyc,nyd,intpol) + end do + else +! +! adjust rhs at finest grid level only +! + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + call adjmd2cr(nx,ny,wk(ip),wk(ic)) + end if +! +! execute maxcy more multigrid k cycles from finest level +! + kcur = ngrid + do iter=1,maxcy + itero = iter + call kcym2cm(wk) + if (tolmax.gt.0.0_r8) then +! +! error control +! + relmax = 0.0_r8 + phmax = 0.0_r8 + + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 + phmax = max(phmax,abs(wk(ij))) + relmax = max(relmax,abs(wk(ij)-phif(i,j))) + + phif(i,j) = wk(ij) + end do + end do +! +! set maximum relative difference and check for convergence +! + if (phmax.gt.0.0_r8) relmax = relmax/phmax + if (relmax.le.tolmax) return + end if + end do +! +! set final interate after maxcy cycles in phif +! + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 + phif(i,j) = wk(ij) + end do + end do + return + end subroutine mud2c1m + +!------------------------------------------------------------------------ + subroutine kcym2cm(wk) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use edyn_solve,only: cofum +! +! execute multigrid k cycle from kcur grid level +! kcycle=1 for v cycles, kcycle=2 for w cycles +! + implicit none + real(r8) :: wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ip,ic,ipc,irc,itx,ity,ncx,ncy,l,nrel + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50), & + nxk(50),nyk(50),isx,jsy + integer kount(50) +! real(r8) :: :: cofum +! common/mudmd/cofum(1) + + klevel = kcur + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) +! +! prerelax at current finest grid level +! + do l=1,iprer + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + if (kcur .eq. 1) go to 5 +! +! restrict residual to kcur-1 level +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy +! call resmd2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic),wk(kps)) + + call resm2cm(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic), & + wk(kps),cofum) +! +! set counter for grid levels to zero +! + do l = 1,kcur + kount(l) = 0 + end do +! +! set new grid level and continue k-cycling +! + klevel = kcur-1 + nrel = iprer +! +! kcycle control point +! + 10 continue +! +! post relax when kcur revisited +! + if (klevel .eq. kcur) go to 5 +! +! count hit at current level +! + kount(klevel) = kount(klevel)+1 +! +! relax at current level +! + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) + do l=1,nrel + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + if (kount(klevel) .eq. kcycle+1) then +! +! kcycle complete at klevel +! + ipc = ip + ip = kpbgn(klevel+1) + ncx = nxk(klevel) + ncy = nyk(klevel) + nx = nxk(klevel+1) + ny = nyk(klevel+1) +! +! inject correction to finer grid +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd, & + intpol,wk(kps)) +! +! reset counter to zero +! + kount(klevel) = 0 +! +! ascend to next higher level and set to postrelax there +! + klevel = klevel+1 + nrel = ipost + go to 10 + else + if (klevel .gt. 1) then +! +! kcycle not complete so descend unless at coarsest grid +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy + call resmd2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic), & + wk(kps)) +! +! prerelax at next coarser level +! + klevel = klevel-1 + nrel = iprer + go to 10 + else +! +! postrelax at coarsest level +! + do l=1,ipost + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + ipc = ip + ip = kpbgn(2) + ncx = nxk(1) + ncy = nyk(1) + nx = nxk(2) + ny = nyk(2) +! +! inject correction to level 2 +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd, & + intpol,wk(kps)) +! +! set to postrelax at level 2 +! + nrel = ipost + klevel = 2 + go to 10 + end if + end if + 5 continue +! +! post relax at current finest grid level +! + nx = nxk(kcur) + ny = nyk(kcur) + ip = kpbgn(kcur) + ic = kcbgn(kcur) + itx = ktxbgn(kcur) + ity = ktybgn(kcur) + do l=1,ipost + call relmd2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + return + end subroutine kcym2cm +!---------------------------------------------------------------------- + subroutine resm2cm(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf,cofum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! restrict residual from fine to coarse mesh using fully weighted +! residual restriction +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ncx,ncy,i,j,ic,jc + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: rhsc(ncx,ncy),resf(nx,ny) + real(r8) :: phi(0:nx+1,0:ny+1),phic(0:ncx+1,0:ncy+1) + real(r8) :: cof(nx,ny,10),cofum(nx,ny,9) + real(r8) :: l2norm +! +! set phic zero +! + do jc=0,ncy+1 + do ic=0,ncx+1 + phic(ic,jc) = 0.0_r8 + end do + end do + + call bnd2cm(nx,ny,cofum) +! +! compute residual on fine mesh in resf +! + l2norm = 0._r8 +!$OMP PARALLEL DO SHARED(resf,cof,phi,nx,ny) PRIVATE(i,j) + do j=1,ny + do i=1,nx + resf(i,j) = cof(i,j,10)-( & + cofum(i,j,1)*phi(i+1,j)+ & + cofum(i,j,2)*phi(i+1,j+1)+ & + cofum(i,j,3)*phi(i,j+1)+ & + cofum(i,j,4)*phi(i-1,j+1)+ & + cofum(i,j,5)*phi(i-1,j)+ & + cofum(i,j,6)*phi(i-1,j-1)+ & + cofum(i,j,7)*phi(i,j-1)+ & + cofum(i,j,8)*phi(i+1,j-1)+ & + cofum(i,j,9)*phi(i,j)) + + l2norm = l2norm + resf(i,j)*resf(i,j) + end do + end do +! +! restrict resf to coarse mesh in rhsc +! + call res2(nx,ny,resf,ncx,ncy,rhsc,nxa,nxb,nyc,nyd) + return + end subroutine resm2cm + +!----------------------------------------------------------------------- + subroutine bnd2cm(nx,ny,cf) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! set stencil & boundary condition for finest stencil +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer nx,ny,i,j,kbdy,l,im1,jm1,ier,jc,nnx,nny + real(r8) :: cf(nx,ny,*) + real(r8) :: dlx,dlx2,dlxx,dly,dly2,dlyy,cmin,alfmax,cemax + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + +! +! set coefficient for specified boundaries +! + if (nxa.eq.1) then + i = 1 + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nxb.eq.1) then + i = nx + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyc.eq.1) then + j = 1 + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyd.eq.1) then + j = ny + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if +! + return + end subroutine bnd2cm +!----------------------------------------------------------------------- diff --git a/src/ionosphere/waccmx/edyn_muh2cr.F90 b/src/ionosphere/waccmx/edyn_muh2cr.F90 new file mode 100644 index 0000000000..78a31e0fdd --- /dev/null +++ b/src/ionosphere/waccmx/edyn_muh2cr.F90 @@ -0,0 +1,2024 @@ +!----------------------------------------------------------------------- + subroutine muh(pe,jntl) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun + use edyn_solve,only: nc,ncee,cee + use cam_logfile ,only: iulog + + implicit none + integer jntl +! +! set grid size params +! + integer,parameter :: iixp = 80 , jjyq = 48,iiex = 1, jjey = 1 + integer,parameter :: nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1 +! +! estimate work space for point relaxation (see muh2cr.d) +! + integer,parameter :: llwork=(5*((nnx+2)*(nny+2)+18*nnx*nny)/3+ & + (nnx+2)*(nny+2)+ (iixp+1)*(jjyq+1)*(2*iixp+3)) + integer,parameter :: iiwork=(iixp+1)*(jjyq+1) + real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) + integer iwork(iiwork) +! +! put integer and floating point argument names in contiguous +! storage for labelling in vectors iprm,fprm +! + integer iprm(17),mgopt(4) + real(r8) :: fprm(6) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& + iguess,maxcy,method,nwork,lwrkqd,itero + common/itmud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& + iguess,maxcy,method,nwork,lwrkqd,itero + real(r8) :: xa,xb,yc,yd,tolmax,relmax + common/ftmud2cr/xa,xb,yc,yd,tolmax,relmax + equivalence(intl,iprm) + equivalence(xa,fprm) + integer i,j,ierror + real(r8) :: PE(NNX,1) + integer maxcya +! DATA MAXCYA/20/ + DATA MAXCYA/1/ + integer mm,nn,jj,jjj + real(r8) :: pi +! +! set input integer arguments +! + MM = NNX + NN = NNY + PI = 4._r8*ATAN(1._r8) +! +! SET INPUT INTEGER PARAMETERS +! + INTL = JNTL +! +! set boundary condition flags +! + nxa = 0 + nxb = 0 + nyc = 2 + nyd = 1 +! +! set grid sizes from parameter statements +! + ixp = iixp + jyq = jjyq + iex = iiex + jey = jjey + nx = nnx + ny = nny +! +! set multigrid arguments (w(2,1) cycling with fully weighted +! residual restriction and cubic prolongation) +! + mgopt(1) = 2 + mgopt(2) = 2 + mgopt(3) = 2 + mgopt(4) = 3 +! +! set for one cycle +! + maxcy = maxcya +! +! set no initial guess forcing full multigrid cycling +! + iguess = 0 +! +! set work space length approximation from parameter statement +! + nwork = llwork +! +! set line z relaxation +! + method = 3 +! +! set end points of solution rectangle in (x,y) space +! + xa = -pi + xb = pi + yc = 0.0_r8 + yd = 0.5_r8*pi +! +! set error control flag +! + tolmax = 0.01_r8 +! +! set right hand side in rhs +! initialize phi to zero +! + do i=1,nx + do j=1,ny + RHS(I,J) = CEE(I+(J-1)*NX+9*NX*NY) + phi(i,j) = 0.0_r8 + end do + end do +! +! set specified boundaries in phi +! + DO I=1,NX + PHI(I,NY) = RHS(I,NY)/CEE(I+(NY-1)*NX+8*NX*NY) + END DO +! +! set specified boundaries in phi +! + DO I=1,NX + PHI(I,NY) = RHS(I,NY)/CEE(I+(NY-1)*NX+8*NX*NY) + END DO + +! write(iulog,100) + 100 format(//' mud2cr test ') +! write (iulog,101) (iprm(i),i=1,15) +! 101 format(/,' integer input arguments ',/, +! | ' intl = ',i2,/,' nxa = ',i2,' nxb = ',i2,' nyc = ',i2, +! | ' nyd = ',i2,/,' ixp = ',i2,' jyq = ',i2,' iex = ',i2, +! | ' jey = ',i2,/,' nx = ',i3,' ny = ',i3,' iguess = ',i2, +! | ' maxcy = ',i3,/,' method = ',i2, ' work space estimate = ',i7) +! write (iulog,102) (mgopt(i),i=1,4) +! 102 format(/' multigrid option arguments ', +! | /,' kcycle = ',i2, +! | /,' iprer = ',i2, +! | /,' ipost = ',i2 +! | /,' intpol = ',i2) +! write(iulog,103) xa,xb,yc,yd,tolmax +! 103 format(/' floating point input parameters ', +! | /,' xa = ',f6.3,' xb = ',f6.3,' yc = ',f6.3,' yd = ',f6.3, +! | /,' tolerance (error control) = ',e10.3) +! write(iulog,"('fprm(1-5) (xa,xb,yc,yd,tolmax=',6f8.3)") fprm(1:5) +! +! intialization call +! +! write(iulog,104) intl + 104 format(/' discretization call to muh2cr', ' intl = ', i2) + call muh2cr(iprm,fprm,work,iwork,rhs,phi,mgopt,ierror) +! write (iulog,200) ierror,iprm(16) +! 200 format(' ierror = ',i2, ' minimum work space = ',i7) + if (ierror.gt.0) call endrun('muh call init muh2cr') +! +! attempt solution +! + intl = 1 +! write(iulog,106) intl,method,iguess +! 106 format(/' approximation call to muh2cr', +! +/' intl = ',i2, ' method = ',i2,' iguess = ',i2) + call muh2cr(iprm,fprm,work,iwork,rhs,phi,mgopt,ierror) +! write (iulog,107) ierror + 107 format(' ierror = ',i2) + if (ierror.gt.0) call endrun('muh call solve muh2cr') +! +! COPY PHI TO PE +! + DO J = 1,NY + JJ = NY+J-1 + JJJ = NY+1-J + DO I = 1,NX + PE(I,JJ) = PHI(I,J) + PE(I,JJJ) = PHI(I,J) + END DO + END DO + end subroutine muh +!----------------------------------------------------------------------- + subroutine muh2cr(iparm,fparm,wk,iwk,rhs,phi,mgopt,ierror) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer iparm(17),mgopt(4),ierror,iwk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + real(r8) :: fparm(6),xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer int,iw,k,kb,nx,ny,ic,itx,ity + real(r8) :: wk(*),phi(*),rhs(*) + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50),& + nxk(50),nyk(50),isx,jsy + integer ibeta,ialfa,izmat,idmat + common/mh2cr/ibeta,ialfa,izmat,idmat + data int / 0 / + save int + ierror = 1 + intl = iparm(1) ! set and check intl on all calls + if (intl*(intl-1).ne.0) return + if (int.eq.0) then + int = 1 + if (intl.ne.0) return ! very first call is not intl=0 + end if + ierror = 0 +! +! set arguments internally +! these will not be rechecked if intl=1! +! + nxa = iparm(2) + nxb = iparm(3) + nyc = iparm(4) + nyd = iparm(5) + ixp = iparm(6) + jyq = iparm(7) + iex = iparm(8) + jey = iparm(9) + ngrid = max0(iex,jey) + nfx = iparm(10) + nfy = iparm(11) + iguess = iparm(12) + maxcy = iparm(13) + method = iparm(14) + nwork = iparm(15) + kcycle = mgopt(1) + if (kcycle .eq. 0) then +! set defaults + kcycle = 2 + iprer = 2 + ipost = 1 + intpol = 3 + else + iprer = mgopt(2) + ipost = mgopt(3) + intpol = mgopt(4) + end if + xa = fparm(1) + xb = fparm(2) + yc = fparm(3) + yd = fparm(4) + tolmax = fparm(5) + if (intl .eq. 0) then ! intialization call +! +! check input arguments +! + ierror = 2 ! check boundary condition flags + if (max0(nxa,nxb,nyc,nyd).gt.2) return + if (min0(nxa,nxb,nyc,nyd).lt.0) return + if (nxa.eq.0.and.nxb.ne.0) return + if (nxa.ne.0.and.nxb.eq.0) return + if (nyc.eq.0.and.nyd.ne.0) return + if (nyc.ne.0.and.nyd.eq.0) return + ierror = 3 ! check grid sizes + if (ixp.lt.2) return + if (jyq.lt.2) return + ierror = 4 + ngrid = max0(iex,jey) + if (iex.lt.1) return + if (jey.lt.1) return + if (ngrid.gt.50) return + ierror = 5 + if (nfx.ne.ixp*2**(iex-1)+1) return + if (nfy.ne.jyq*2**(jey-1)+1) return + ierror = 6 + if (iguess*(iguess-1).ne.0) return + ierror = 7 + if (maxcy.lt.1) return + ierror = 8 + if (method.lt.0 .or. method.gt.3) return + ierror = 9 +! compute and test minimum work space + isx = 0 + if (method.eq.1 .or. method.eq.3) then + if (nxa.ne.0) isx = 3 + if (nxa.eq.0) isx = 5 + end if + jsy = 0 + if (method.eq.2 .or. method.eq.3) then + if (nyc.ne.0) jsy = 3 + if (nyc.eq.0) jsy = 5 + end if + kps = 1 + do k=1,ngrid +! set subgrid sizes + nxk(k) = ixp*2**(max0(k+iex-ngrid,1)-1)+1 + nyk(k) = jyq*2**(max0(k+jey-ngrid,1)-1)+1 + nx = nxk(k) + ny = nyk(k) + kps = kps+(nx+2)*(ny+2)+nx*ny*(10+isx+jsy) + end do +! +! set pointers for direct at coarse grid +! + nx = ixp+1 + ny = jyq+1 + ibeta = kps+1 + if (nyc .eq. 0) then + ialfa = ibeta + nx*nx*(ny-1) + izmat = ialfa+nx*nx*(ny-1) + idmat = izmat+nx*nx*(ny-2) + kps = idmat+nx*nx*(ny-2) + else + ialfa = ibeta + nx*nx*ny + kps = ialfa+nx*nx*ny + end if + iparm(16) = kps+(nfx+2)*(nfy+2) ! exact minimum work space + lwork = iparm(16) + if (lwork .gt. nwork) return + ierror = 10 ! check solution region + if (xb.le.xa .or. yd.le.yc) return + ierror = 11 + if (tolmax .lt. 0.0_r8) return + ierror = 12 ! multigrid parameters + if (kcycle.lt.0) return + if (min0(iprer,ipost).lt.1) return + if ((intpol-1)*(intpol-3).ne.0) return + if (max0(kcycle,iprer,ipost).gt.2) then + ierror = -5 ! inefficient multigrid cycling + end if + if (ierror .gt. 0) ierror = 0 ! no fatal errors +! +! set work space pointers and discretize pde at each grid level +! + iw = 1 + do kb=1,ngrid + k = ngrid-kb+1 + nx = nxk(k) + ny = nyk(k) + kpbgn(k) = iw + kcbgn(k) = kpbgn(k)+(nx+2)*(ny+2) + ktxbgn(k) = kcbgn(k)+10*nx*ny + ktybgn(k) = ktxbgn(k)+isx*nx*ny + iw = ktybgn(k)+jsy*nx*ny + ic = kcbgn(k) + itx = ktxbgn(k) + ity = ktybgn(k) + klevel = k + call dismh2cr(nx,ny,wk(ic),wk(itx),wk(ity),wk,iwk,ierror) + end do + return + end if ! end of intl=0 initialization call block + nx = nfx + ny = nfy + call muh2cr1(nx,ny,rhs,phi,wk,iwk) + iparm(17) = itero + if (tolmax.gt.0.0_r8) then ! check for convergence + fparm(6) = relmax + if (relmax.gt.tolmax) ierror = -1 ! flag convergenc failure + end if + return + end subroutine muh2cr +!----------------------------------------------------------------------- + subroutine muh2cr1(nx,ny,rhsf,phif,wk,iwk) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,iwk(*) + real(r8) :: phif(nx,ny),rhsf(nx,ny),wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax,phmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + integer k,kb,ip,ic,ir,ipc,irc,icc + integer ncx,ncy,jj,ij,i,j,iter + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50),& + nxk(50),nyk(50),isx,jsy + integer ibeta,ialfa,izmat,idmat + common/mh2cr/ibeta,ialfa,izmat,idmat + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + ir = ic+9*nx*ny +! +! set phif,rhsf in wk and adjust right hand side +! + call swk2(nx,ny,phif,rhsf,wk(ip),wk(ir)) + if (iguess.eq.0) then +! +! no initial guess at finest grid level! +! + do kb=2,ngrid + k = ngrid-kb+1 + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ir = kcbgn(k+1)+9*nx*ny + ncx = nxk(k) + ncy = nyk(k) + ipc = kpbgn(k) + icc = kcbgn(k) + irc = icc+9*ncx*ncy +! +! transfer down to all grid levels +! + call trsfc2(nx,ny,wk(ip),wk(ir),ncx,ncy,wk(ipc),wk(irc)) + end do +! +! adjust right hand side at all grid levels in case +! rhs or specified b.c. in phi or gbdy changed +! + do k=1,ngrid + nx = nxk(k) + ny = nyk(k) + ip = kpbgn(k) + ic = kcbgn(k) + call adjmh2cr(nx,ny,wk(ip),wk(ic)) + end do +! +! execute one full multigrid cycle +! + do k=1,ngrid-1 + kcur = k + call kcymh2cr(wk,iwk) + nx = nxk(k+1) + ny = nyk(k+1) + ip = kpbgn(k+1) + ipc = kpbgn(k) + ncx = nxk(k) + ncy = nyk(k) + +! +! lift or prolong approximation from k to k+1 +! + call prolon2(ncx,ncy,wk(ipc),nx,ny,wk(ip),nxa,nxb,nyc,nyd,intpol) + end do + else +! +! adjust rhs at finest grid level only +! + nx = nxk(ngrid) + ny = nyk(ngrid) + ip = kpbgn(ngrid) + ic = kcbgn(ngrid) + call adjmh2cr(nx,ny,wk(ip),wk(ic)) + end if +! +! execute maxcy more multigrid k cycles from finest level +! + kcur = ngrid + do iter=1,maxcy + itero = iter + call kcymh2cr(wk,iwk) + if (tolmax.gt.0.0_r8) then +! +! error control +! + relmax = 0.0_r8 + phmax = 0.0_r8 + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 + phmax = max(phmax,abs(wk(ij))) + relmax = max(relmax,abs(wk(ij)-phif(i,j))) + + phif(i,j) = wk(ij) + end do + end do +! +! set maximum relative difference and check for convergence +! + if (phmax.gt.0.0_r8) relmax = relmax/phmax + + if (relmax.le.tolmax) return + end if + end do +! +! set final interate after maxcy cycles in phif +! + do j=1,nfy + jj = j*(nfx+2) + do i=1,nfx + ij = jj+i+1 + phif(i,j) = wk(ij) + end do + end do + return + end subroutine muh2cr1 +!----------------------------------------------------------------------- + subroutine kcymh2cr(wk,iwk) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! execute multigrid k cycle from kcur grid level +! kcycle=1 for v cycles, kcycle=2 for w cycles +! + implicit none + integer iwk(*) + real(r8) :: wk(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ip,ic,ipc,irc,itx,ity,ncx,ncy,l,nrel + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50),& + nxk(50),nyk(50),isx,jsy + integer ibeta,ialfa,izmat,idmat + common/mh2cr/ibeta,ialfa,izmat,idmat + integer kount(50) + klevel = kcur + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) + if (kcur .eq. 1) then +! +! solve at coarse level with direct method and return +! + if (nyc .ne. 0) then + call dir2cr(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),iwk,nxa) + return + else + call dir2crp(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),& + wk(izmat),wk(idmat),iwk,nxa) + return + end if + end if +! +! prerelax at current finest grid level > 1 +! + do l=1,iprer + call relmh2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do +! +! restrict residual to kcur-1 level +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy + call resmh2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic),wk(kps)) +! +! set counter for grid levels to zero +! + do l = 1,kcur + kount(l) = 0 + end do +! +! set new grid level and continue k-cycling +! + klevel = kcur-1 + nrel = iprer +! +! kcycle control point +! + 10 continue +! +! post relax when kcur revisited +! + if (klevel .eq. kcur) go to 5 +! +! count hit at current level +! + kount(klevel) = kount(klevel)+1 +! +! relax or solve directly at current level +! + nx = nxk(klevel) + ny = nyk(klevel) + ip = kpbgn(klevel) + ic = kcbgn(klevel) + itx = ktxbgn(klevel) + ity = ktybgn(klevel) + if (klevel.gt.1) then + do l=1,nrel + call relmh2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + else +! +! use direct method at coarsest level +! + if (nyc .ne. 0) then + call dir2cr(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),iwk,nxa) + else + call dir2crp(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),& + wk(izmat),wk(idmat),iwk,nxa) + end if +! +! insure direct method is not called again at coarse level +! + kount(1) = kcycle+1 + end if + if (kount(klevel) .eq. kcycle+1) then +! +! kcycle complete at klevel +! + ipc = ip + ip = kpbgn(klevel+1) + ncx = nxk(klevel) + ncy = nyk(klevel) + nx = nxk(klevel+1) + ny = nyk(klevel+1) +! +! inject correction to finer grid +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd,& + intpol,wk(kps)) +! +! reset counter to zero +! + kount(klevel) = 0 +! +! ascend to next higher level and set to postrelax there +! + klevel = klevel+1 + nrel = ipost + go to 10 + else + if (klevel .gt. 1) then +! +! kcycle not complete so descend unless at coarsest grid +! + ipc = kpbgn(klevel-1) + ncx = nxk(klevel-1) + ncy = nyk(klevel-1) + irc = kcbgn(klevel-1)+9*ncx*ncy + call resmh2cr(nx,ny,wk(ip),ncx,ncy,wk(ipc),wk(irc),wk(ic),wk(kps)) +! +! prerelax at next coarser level +! + klevel = klevel-1 + nrel = iprer + go to 10 + else +! +! direct at coarsest level takes place of postrelax +! + ip = kpbgn(1) + ic = kcbgn(1) + nx = nxk(1) + ny = nyk(1) + if (nyc .ne. 0) then + call dir2cr(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),iwk,nxa) + else + call dir2crp(nx,ny,wk(ip),wk(ic),wk(ibeta),wk(ialfa),& + wk(izmat),wk(idmat),iwk,nxa) + end if + ipc = ip + ip = kpbgn(2) + ncx = nxk(1) + ncy = nyk(1) + nx = nxk(2) + ny = nyk(2) +! +! inject correction to level 2 +! + call cor2(nx,ny,wk(ip),ncx,ncy,wk(ipc),nxa,nxb,nyc,nyd,& + intpol,wk(kps)) +! +! set to postrelax at level 2 +! + nrel = ipost + klevel = 2 + go to 10 + end if + end if + 5 continue +! +! post relax at current finest grid level +! + nx = nxk(kcur) + ny = nyk(kcur) + ip = kpbgn(kcur) + ic = kcbgn(kcur) + itx = ktxbgn(kcur) + ity = ktybgn(kcur) + do l=1,ipost + call relmh2cr(nx,ny,wk(ip),wk(ic),wk(itx),wk(ity),wk(kps)) + end do + return + end subroutine kcymh2cr +!----------------------------------------------------------------------- + subroutine dismh2cr(nx,ny,cf,tx,ty,wk,iwk,ier) + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun + use edyn_solve,only: nc,ncee,cee,ceee + use cam_logfile ,only: iulog +! +! discretize elliptic pde for muh2cr, set nonfatal errors +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer nx,ny,iwk(*),i,j,kbdy,l,im1,jm1,ier,jc + real(r8) :: cf(nx,ny,10),tx(nx,ny,*),ty(ny,nx,*) + real(r8) :: wk(*) + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + integer ibeta,ialfa,izmat,idmat + common/mh2cr/ibeta,ialfa,izmat,idmat + integer nnx,nny +! +! CHECK FOR CONSISTENCYT WRT KLEVEL +! + NNX = ixp*2**(KLEVEL-1)+1 + NNY = jyq*2**(KLEVEL-1)+1 + IF(NNX.NE.NX.OR.NNY.NE.NY)THEN +! WRITE(iulog,100)NX,NY,NNX,NNY,ixp,jyq,KLEVEL +! 100 FORMAT(' INCONSISTENCY WRT LEVEL. NX,NY,NNX,NNY,ixp,jyq,', +! | 'klevel = ',8I6) + call endrun('dismh2cr') + ENDIF + call ceee(cee(nc(6-klevel-4)),nx,ny,cf) +! +! set coefficient for specified boundaries +! + if (nxa.eq.1) then + i = 1 + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nxb.eq.1) then + i = nx + do j=1,ny + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyc.eq.1) then + j = 1 + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (nyd.eq.1) then + j = ny + do i=1,nx + do l=1,9 + cf(i,j,l) = 0.0_r8 + end do + cf(i,j,9) = 1.0_r8 + end do + end if + if (klevel .eq. 1) then +! +! set block tri-diagonal coefficient matrix and do lu decomposition +! for direct method at coarsest grid level +! + nx = ixp+1 + ny = jyq+1 + if (nyc .ne. 0) then +! factor non-periodic block matrix + call lud2cr(nx,ny,cf,wk(ibeta),wk(ialfa),iwk,nxa) + return + else +! factor periodic block matrix + + do j =1,ny-1 + call setbcr(nx,ny,cf,wk(ibeta),j,nxa) + call setacr(nx,ny,cf,wk(ialfa),j,nxa) + end do + call lud2crp(nx,ny,cf,wk(ibeta),wk(ialfa),wk(izmat),& + wk(idmat),iwk,nxa) + return + end if + end if +! +! set and factor tridiagonal matrices for line relaxation(s) if flagged +! + if (method.eq.1.or.method.eq.3) then + if (nxa.ne.0) then +! +! nonperiodic x line relaxation +! + do i=1,nx + im1 = max0(i-1,1) + do j=1,ny + tx(im1,j,1) = cf(i,j,5) + tx(i,j,2) = cf(i,j,9) + tx(i,j,3) = cf(i,j,1) + end do + end do + call factri(ny,nx,tx(1,1,1),tx(1,1,2),tx(1,1,3)) + else +! +! periodic x line relaxation +! + if (nx .gt. 3) then +! +! set and factor iff nx > 3 +! + do i=1,nx-1 + do j=1,ny + tx(i,j,1) = cf(i,j,5) + tx(i,j,2) = cf(i,j,9) + tx(i,j,3) = cf(i,j,1) + end do + end do + call factrp(ny,nx,tx,tx(1,1,2),tx(1,1,3),tx(1,1,4),& + tx(1,1,5),wk(kps)) + end if + end if + end if + + if (method.eq.2.or.method.eq.3) then + if (nyc.ne.0) then +! +! nonperiodic y line relaxation +! + do j=1,ny + jm1 = max0(j-1,1) + do i=1,nx + ty(jm1,i,1) = cf(i,j,7) + ty(j,i,2) = cf(i,j,9) + ty(j,i,3) = cf(i,j,3) + end do + end do + call factri(nx,ny,ty(1,1,1),ty(1,1,2),ty(1,1,3)) + else +! +! periodic y line relaxation +! + if (ny .gt. 3) then +! +! set and factor iff ny > 3 +! + do j=1,ny-1 + do i=1,nx + ty(j,i,1) = cf(i,j,7) + ty(j,i,2) = cf(i,j,9) + ty(j,i,3) = cf(i,j,3) + end do + end do + call factrp(nx,ny,ty,ty(1,1,2),ty(1,1,3),ty(1,1,4),& + ty(1,1,5),wk(kps)) + end if + end if + end if + return + end subroutine dismh2cr +!----------------------------------------------------------------------- + subroutine lud2cr(nx,ny,cof,beta,alfa,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! decompose nonperiodic block coefficient matrix +! + implicit none + integer nx,ny,nxa,index(nx,ny) + real(r8) :: cof(nx,ny,10),beta(nx,nx,*),alfa(nx,nx,*) + integer iz,i1,jcur,jm1,l,lm1,lp1,k,i + real(r8) :: gama,sum + iz = 0 + i1 = 1 +! +! set and factor umat(1) in beta(1) +! + jcur = 1 + call setbcr(nx,ny,cof,beta,jcur,nxa) + call sgfa(beta,nx,nx,index,iz) + + do jcur=2,ny +! +! solve transpose of lmat(jcur)*beta(jcur-1) = alfa(jcur) in alfa(jcur) +! + call setacr(nx,ny,cof,alfa,jcur,nxa) + call transp(nx,alfa(1,1,jcur)) + jm1 = jcur-1 + do l=1,nx + call sgsl(beta(1,1,jm1),nx,nx,index(1,jm1),alfa(1,l,jcur),i1) + end do + call transp(nx,alfa(1,1,jcur)) + call setbcr(nx,ny,cof,beta,jcur,nxa) + do i=1,nx + do l=1,nx + sum = 0.0_r8 + lm1=max0(1,l-1) + lp1=min0(l+1,nx) + do k=lm1,lp1 + if (k .eq. l+1) then + gama = cof(k,jcur-1,4) + else if (k.eq. l) then + gama = cof(k,jcur-1,3) + else if (k .eq. l-1) then + gama = cof(k,jcur-1,2) + else + gama=0.0_r8 + end if + sum = sum+alfa(i,k,jcur)*gama + end do + if (nxa.eq.0) then + if (l .eq. 2) then + sum=sum+alfa(i,nx,jcur)*cof(nx,jcur-1,2) + end if + if (l .eq. nx-1) then + sum=sum+alfa(i,1,jcur)*cof(1,jcur-1,4) + end if + end if + beta(i,l,jcur) = beta(i,l,jcur)-sum + end do + end do +! +! factor current beta for next pass +! + iz = 0 + call sgfa(beta(1,1,jcur),nx,nx,index(1,jcur),iz) + end do + return + end subroutine lud2cr +!----------------------------------------------------------------------- + subroutine dir2cr(nx,ny,phi,cof,beta,alfa,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! direct solve at coarsest grid +! + implicit none + integer nx,ny,index(nx,ny),nxa + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + real(r8) :: beta(nx,nx,*),alfa(nx,nx,*) +! forward sweep + call for2cr(nx,ny,phi,cof(1,1,10),alfa) +! backward sweep + call bkw2cr(nx,ny,phi,cof,beta,index,nxa) + return + end subroutine dir2cr +!----------------------------------------------------------------------- + subroutine for2cr(nx,ny,phi,frhs,alfa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! forward sweep +! + implicit none + integer nx,ny,i,j,l + real(r8) :: phi(0:nx+1,0:ny+1),frhs(nx,ny),alfa(nx,nx,*),sum + do j=1,ny + do i=1,nx + phi(i,j)=frhs(i,j) + end do + end do + do j=2,ny + do i=1,nx + sum=0.0_r8 + do l=1,nx + sum=sum+alfa(i,l,j)*phi(l,j-1) + end do + phi(i,j)=phi(i,j)-sum + end do + end do + return + end subroutine for2cr +!----------------------------------------------------------------------- + subroutine bkw2cr(nx,ny,phi,cof,beta,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,index(nx,ny),nxa + real(r8) :: beta(nx,nx,*),sum + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + integer iz,jcur,jb,j,i + iz = 0 + jcur=ny + call sgsl(beta(1,1,jcur),nx ,nx ,index(1,jcur),phi(1,jcur),iz) + do jb=2,ny + j=ny-jb+1 + jcur=j + do i=2,nx-1 + sum=cof(i,j,2)*phi(i+1,j+1)+cof(i,j,3)*phi(i,j+1)+cof(i,j,4)* & + phi(i-1,j+1) + phi(i,j)=phi(i,j)-sum + end do + phi(1,j)=phi(1,j)-(cof(1,j,2)*phi(2,j+1)+cof(1,j,3)*phi(1,j+1)) + phi(nx,j)=phi(nx,j)-(cof(nx,j,3)*phi(nx,j+1)+cof(nx,j,4)* & + phi(nx-1,j+1)) + if (nxa .eq.0) then + phi(1,j)=phi(1,j)-cof(1,j,4)*phi(nx-1,j+1) + phi(nx,j)=phi(nx,j)-cof(nx,j,2)*phi(2,j+1) + end if + call sgsl(beta(1,1,jcur),nx ,nx ,index(1,jcur),phi(1,jcur),iz) + end do + return + end subroutine bkw2cr +!----------------------------------------------------------------------- + subroutine lud2crp(nx,ny,cof,beta,alfa,zmat,dmat,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! decompose periodic block tridiagonal matrix for direct at coarsest grid +! + implicit none + integer nx,ny,index(nx,ny),nxa + real(r8) :: cof(nx,ny,10),alfa(nx,nx,*),beta(nx,nx,*) + real(r8) :: dmat(nx,nx,*),zmat(nx,nx,*),sum,gama + integer iz,j,jcur,i,l,jm1,i1,lm1,lp1,k + jcur = 1 +! +! set dmat(1)=alfa(1) +! + call setacr(nx,ny,cof,alfa,jcur,nxa) + do i=1,nx + do l=1,nx + dmat(i,l,1) = alfa(i,l,1) + end do + end do + iz = 0 +! +! factor umat(1) in beta(1) +! + call setbcr(nx,ny,cof,beta,jcur,nxa) + call sgfa(beta(1,1,1),nx,nx,index(1,1),iz) + do jcur=2,ny-2 +! +! solve transpose of lmat(jcur)umat(jcur-1)=alfa(jcur) in alfa(jcur) +! + call setacr(nx,ny,cof,alfa,jcur,nxa) + call transp(nx,alfa(1,1,jcur)) + jm1 = jcur-1 + i1 = 1 + do l=1,nx + call sgsl(beta(1,1,jm1),nx,nx,index(1,jm1),alfa(1,l,jcur),i1) + end do + call transp(nx,alfa(1,1,jcur)) + call setbcr(nx,ny,cof,beta,jcur,nxa) + do i=1,nx + do l=1,nx + sum = 0.0_r8 + lm1=max0(1,l-1) + lp1=min0(l+1,nx) + do k=lm1,lp1 + if (k .eq. l+1) then + gama = cof(k,jcur-1,4) + else if (k.eq. l) then + gama = cof(k,jcur-1,3) + else if (k .eq. l-1) then + gama = cof(k,jcur-1,2) + else + gama=0.0_r8 + end if + sum = sum+alfa(i,k,jcur)*gama + end do + if (nxa.eq.0) then + if (l .eq. 2) then + sum=sum+alfa(i,nx,jcur)*cof(nx,jcur-1,2) + end if + if (l .eq. nx-1) then + sum=sum+alfa(i,1,jcur)*cof(1,jcur-1,4) + end if + end if + beta(i,l,jcur)=beta(i,l,jcur)-sum + end do + end do +! +! factor current beta(1,1,jcur) for next pass +! + call sgfa(beta(1,1,jcur),nx ,nx,index(1,jcur),iz) +! +! set dmat(jcur) = -alfa(jcur)*dmat(jcur-1) +! + do i=1,nx + do j=1,nx + dmat(i,j,jcur) = 0.0_r8 + do l=1,nx + dmat(i,j,jcur) = dmat(i,j,jcur)-alfa(i,l,jcur)* & + dmat(l,j,jcur-1) + end do + end do + end do + if (jcur .eq. ny-2) then +! +! adjust dmat(ny-2) = gama(ny-2)-alfa(ny-2)*dmat(ny-3) +! + dmat(1,1,jcur) = cof(1,jcur,3) + dmat(1,1,jcur) + dmat(1,2,jcur) = cof(1,jcur,2) + dmat(1,2,jcur) +! +! adjust for periodic b.c. in x +! + if (nxa .eq. 0) then + dmat(1,nx-1,jcur) = cof(1,jcur,4) + dmat(1,nx-1,jcur) + dmat(nx,2,jcur) = cof(nx,jcur,2) + dmat(nx,2,jcur) + end if +! +! matrix interior +! + do i=2,nx-1 + dmat(i,i,jcur) = cof(i,jcur,3) + dmat(i,i,jcur) + dmat(i,i-1,jcur) = cof(i,jcur,4) + dmat(i,i-1,jcur) + dmat(i,i+1,jcur) = cof(i,jcur,2) + dmat(i,i+1,jcur) + end do + dmat(nx,nx,jcur) = cof(nx,jcur,3) + dmat(nx,nx,jcur) + dmat(nx,nx-1,jcur) = cof(nx,jcur,4) + dmat(nx,nx-1,jcur) + end if + end do +! +! final phase with periodic factorization +! +! solve transpose of zmat(1) beta(1) = gama(ny-1) +! + zmat(1,1,1) = cof(1,ny-1,3) + zmat(1,2,1) = cof(1,ny-1,2) + do l=3,nx + zmat(1,l,1) = 0.0_r8 + end do + + do i=2,nx-1 + do l=1,nx + zmat(i,l,1) = 0.0_r8 + end do + zmat(i,i,1) = cof(i,ny-1,3) + zmat(i,i+1,1) = cof(i,ny-1,2) + zmat(i,i-1,1) = cof(i,ny-1,4) + end do + zmat(nx,nx-1,1) = cof(nx,ny-1,4) + zmat(nx,nx,1) = cof(nx,ny-1,3) + do l=1,nx-2 + zmat(nx,l,1) = 0.0_r8 + end do +! +! adjust for periodic x b.c. +! + if (nxa .eq.0) then + zmat(1,nx-1,1) = cof(1,ny-1,4) + zmat(nx,2,1) = cof(nx,ny-1,2) + end if + call transp(nx,zmat(1,1,1)) + do l=1,nx + call sgsl(beta(1,1,1),nx,nx,index(1,1),zmat(1,l,1),i1) + end do + call transp(nx,zmat(1,1,1)) + do jcur = 2,ny-3 +! +! solve transpose of zmat(jcur) umat(jcur) = -zmat(jcur-1) gama(jcur-1) +! + do i=1,nx + zmat(i,1,jcur) = -(zmat(i,1,jcur-1)*cof(1,jcur-1,3) + & + zmat(i,2,jcur-1)*cof(2,jcur-1,4)) + end do + do i=1,nx + do l=2,nx-1 + zmat(i,l,jcur) = -(zmat(i,l-1,jcur-1)*cof(l-1,jcur-1,2) + & + zmat(i,l,jcur-1)*cof(l,jcur-1,3) + & + zmat(i,l+1,jcur-1)*cof(l+1,jcur-1,4)) + end do + end do + do i=1,nx + zmat(i,nx,jcur) = -(zmat(i,nx-1,jcur-1)*cof(nx-1,jcur-1,2) + & + zmat(i,nx,jcur-1)*cof(nx,jcur-1,3)) + end do +! +! adjust j=2 and j=nx-1 column if periodic in x +! + if (nxa .eq. 0) then + do i=1,nx + zmat(i,2,jcur)=zmat(i,2,jcur)-zmat(i,nx,jcur-1)* & + cof(nx,jcur-1,2) + zmat(i,nx-1,jcur)=zmat(i,nx-1,jcur)-zmat(i,1,jcur-1)* & + cof(1,jcur-1,4) + end do + end if + call transp(nx,zmat(1,1,jcur)) + do l=1,nx + call sgsl(beta(1,1,jcur),nx,nx,index(1,jcur),zmat(1,l,jcur),i1) + end do + call transp(nx,zmat(1,1,jcur)) + end do +! +! solve transpose of zmat(ny-2)umat(ny-2)=alfa(ny-1)-zmat(ny-3)gama(ny-3) +! + jcur = ny-2 + do i=1,nx + zmat(i,1,jcur) = -(zmat(i,1,jcur-1)*cof(1,jcur-1,3) + & + zmat(i,2,jcur-1)*cof(2,jcur-1,4)) + end do + + do i=1,nx + do l=2,nx-1 + zmat(i,l,jcur) = -(zmat(i,l-1,jcur-1)*cof(l-1,jcur-1,2) + & + zmat(i,l,jcur-1)*cof(l,jcur-1,3) + & + zmat(i,l+1,jcur-1)*cof(l+1,jcur-1,4)) + end do + end do + do i=1,nx + zmat(i,nx,jcur) = -(zmat(i,nx-1,jcur-1)*cof(nx-1,jcur-1,2) + & + zmat(i,nx,jcur-1)*cof(nx,jcur-1,3)) + end do +! +! adjust j=2 and j=nx-1 column if periodic in x +! + if (nxa .eq. 0) then + do i=1,nx + zmat(i,2,jcur)=zmat(i,2,jcur)-zmat(i,nx,jcur-1)* & + cof(nx,jcur-1,2) + zmat(i,nx-1,jcur)=zmat(i,nx-1,jcur)-zmat(i,1,jcur-1)* & + cof(1,jcur-1,4) + end do + end if + call setacr(nx,ny,cof,alfa,ny-1,nxa) + do i=1,nx + do l=1,nx + zmat(i,l,ny-2) = alfa(i,l,ny-1) + zmat(i,l,ny-2) + end do + end do + call transp(nx,zmat(1,1,ny-2)) + do l=1,nx + call sgsl(beta(1,1,ny-2),nx,nx,index(1,ny-2),zmat(1,l,ny-2),i1) + end do + call transp(nx,zmat(1,1,ny-2)) +! +! set umat(ny-1) = beta(ny-1)-(zmat(1)*dmat(1)+...+zmat(ny-2)*dmat(ny-2)) +! in beta(ny-1) +! + call setbcr(nx,ny,cof,beta,ny-1,nxa) + do i=1,nx + do j=1,nx + sum = 0.0_r8 + do jcur=1,ny-2 + do l=1,nx + sum = sum + zmat(i,l,jcur)*dmat(l,j,jcur) + end do + end do + beta(i,j,ny-1) = beta(i,j,ny-1) - sum + end do + end do +! +! factor bmat(ny-1) for backward sweep +! + call sgfa(beta(1,1,ny-1),nx,nx,index(1,ny-1),iz) +! +! lud is now complete +! + return + end subroutine lud2crp +!----------------------------------------------------------------------- + subroutine dir2crp(nx,ny,phi,cof,beta,alfa,zmat,dmat,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,index(nx,ny),nxa + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + real(r8) :: beta(nx,nx,*),alfa(nx,nx,*) + real(r8) :: zmat(nx,nx,*), dmat(nx,nx,*) +! forward sweep + call for2crp(nx,ny,phi,cof(1,1,10),alfa,zmat) +! backward sweep + call bkw2crp(nx,ny,phi,cof,beta,dmat,index,nxa) + return + end subroutine dir2crp +!----------------------------------------------------------------------- + subroutine for2crp(nx,ny,phi,frhs,alfa,zmat) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,i,j,l,jcur,k + real(r8) :: frhs(nx,ny) + real(r8) :: phi(0:nx+1,0:ny+1) + + real(r8) :: alfa(nx,nx,*),zmat(nx,nx,*) + real(r8) :: sum + do j=1,ny-1 + do i=1,nx + phi(i,j)=frhs(i,j) + end do + end do + do jcur=2,ny-2 + do i=1,nx + sum=0.0_r8 + do l=1,nx + sum=sum+alfa(i,l,jcur)*phi(l,jcur-1) + end do + phi(i,jcur)=phi(i,jcur)-sum + end do + end do +! +! solve: +! zmat(1)*phi(1)+...+zmat(ny-2)*phi(ny-2) + phi(ny-1) = f(ny-1) +! + do i=1,nx + sum = 0.0_r8 + do k=1,ny-2 + do l=1,nx + sum = sum + zmat(i,l,k)*phi(l,k) + end do + end do + phi(i,ny-1) = phi(i,ny-1) - sum + end do + return + end subroutine for2crp +!----------------------------------------------------------------------- + subroutine bkw2crp(nx,ny,phi,cof,beta,dmat,index,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,index(nx,ny),nxa + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + real(r8) :: beta(nx,nx,ny),dmat(nx,nx,*) + integer iz,i,l,kb,k + real(r8) :: sum + iz = 0 + call sgsl(beta(1,1,ny-1),nx,nx,index(1,ny-1),phi(1,ny-1),iz) +! +! solve beta(ny-2)*phi(ny-2) = phi(ny-2)-dmat(ny-2)*phi(ny-1) +! + do i=1,nx + sum = 0.0_r8 + do l=1,nx + sum = sum + dmat(i,l,ny-2)*phi(l,ny-1) + end do + phi(i,ny-2) = phi(i,ny-2) - sum + end do + call sgsl(beta(1,1,ny-2),nx,nx,index(1,ny-2),phi(1,ny-2),iz) +! +! solve beta(k)*phi(k) = phi(k) - gama(k)*phi(k+1)-dmat(k)*phi(ny-1) +! k=ny-3,...,1 +! + do kb=4,ny + k = ny-kb+1 + sum = 0.0_r8 + do l=1,nx + sum = sum+dmat(1,l,k)*phi(l,ny-1) + end do + phi(1,k) = phi(1,k)-sum - ( cof(1,k,3)*phi(1,k+1) + & + cof(1,k,2)*phi(2,k+1)) + do i=2,nx-1 + sum = 0.0_r8 + do l=1,nx + sum = sum+dmat(i,l,k)*phi(l,ny-1) + end do + phi(i,k) = phi(i,k) - sum - (cof(i,k,4)*phi(i-1,k+1) + & + cof(i,k,3)*phi(i,k+1) + & + cof(i,k,2)*phi(i+1,k+1)) + end do + sum = 0.0_r8 + do l=1,nx + sum = sum+dmat(nx,l,k)*phi(l,ny-1) + end do + phi(nx,k) = phi(nx,k) - sum - (cof(nx,k,4)*phi(nx-1,k+1) + & + cof(nx,k,3)*phi(nx,k+1)) +! +! adjust for periodic x b.c. +! + if (nxa .eq. 0) then + phi(1,k) = phi(1,k) - cof(1,k,4)*phi(nx-1,k+1) + phi(nx,k) = phi(nx,k) - cof(nx,k,2)*phi(2,k+1) + end if + call sgsl(beta(1,1,k),nx,nx,index(1,k),phi(1,k),iz) + end do +! +! set j=ny by periodicity +! + do i=1,nx + phi(i,ny) = phi(i,1) + end do + return + end subroutine bkw2crp +!----------------------------------------------------------------------- + subroutine setbcr(nx,ny,cof,beta,jcur,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! set diagonal matrix on block +! + implicit none + integer nx,ny,jcur,nxa,i,l + real(r8) :: cof(nx,ny,10),beta(nx,nx,*) + do i=1,nx + do l=1,nx + beta(i,l,jcur)=0.0_r8 + end do + end do + do i=1,nx + beta(i,i,jcur) = cof(i,jcur,9) + end do + do i=2,nx + beta(i,i-1,jcur) = cof(i,jcur,5) + end do + do i=1,nx-1 + beta(i,i+1,jcur) = cof(i,jcur,1) + end do + if (nxa.eq.0) then + beta(1,nx-1,jcur) = cof(1,jcur,5) + beta(nx,2,jcur) = cof(nx,jcur,1) + end if + return + end subroutine setbcr +!----------------------------------------------------------------------- + subroutine setacr(nx,ny,cof,alfa,jcur,nxa) + use shr_kind_mod ,only: r8 => shr_kind_r8 + implicit none + integer nx,ny,jcur,nxa,i,j + real(r8) :: cof(nx,ny,10),alfa(nx,nx,*) + do i=1,nx + do j=1,nx + alfa(i,j,jcur)=0.0_r8 + end do + end do + do i=2,nx + alfa(i,i-1,jcur)=cof(i,jcur,6) + end do + do i=1,nx + alfa(i,i,jcur)=cof(i,jcur,7) + end do + do i=1,nx-1 + alfa(i,i+1,jcur)=cof(i,jcur,8) + end do + if (nxa .eq. 0) then +! adjust for x periodicity + alfa(1,nx-1,jcur)=cof(1,jcur,6) + alfa(nx,2,jcur)=cof(nx,jcur,8) + end if + return + end subroutine setacr +!----------------------------------------------------------------------- + subroutine adjmh2cr(nx,ny,phi,cf) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! adjust righthand side in cf(i,j,10) for boundary conditions +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + real(r8) :: xa,xb,yc,yd,tolmax,relmax + integer nx,ny,i,j,kbdy + real(r8) :: cf(nx,ny,10),phi(0:nx+1,0:ny+1) + real(r8) :: dlx,dlx2,dlxx,dly,dly2,dlyy,dlxy,dlxy2,dlxy4,dxoy,dyox + real(r8) :: x,y,cxx,cxy,cyy,cx,cy,ce,c1,c2,c3,c4,c5 + real(r8) :: c6,c7,c8 + real(r8) :: alfaa,alfab,alfac,alfad,betaa,betab,betac,betad,det + real(r8) :: gamaa,gamab,gamac,gamad + real(r8) :: alfim1,alfi,alfip1,betim1,beti,betip1,gamim1,gami,gamip1 + real(r8) :: alfjm1,alfj,alfjp1,betjm1,betj,betjp1,gamjm1,gamj,gamjp1 + real(r8) :: gbdim1,gbdi,gbdip1,gbdj,gbdjm1,gbdjp1 + real(r8) :: gbdya,gbdyb,gbdyc,gbdyd + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + common/fmud2cr/xa,xb,yc,yd,tolmax,relmax + + +! +! set specified boundaries in rhs from phi +! + if (nxa.eq.1) then + i = 1 + do j=1,ny + cf(i,j,10) = phi(i,j) + end do + end if + if (nxb.eq.1) then + i = nx + do j=1,ny + cf(i,j,10) = phi(i,j) + end do + end if + if (nyc.eq.1) then + j = 1 + do i=1,nx + cf(i,j,10) = phi(i,j) + end do + end if + if (nyd.eq.1) then + j = ny + do i=1,nx + cf(i,j,10) = phi(i,j) + end do + end if + return + end subroutine adjmh2cr +!----------------------------------------------------------------------- + subroutine resmh2cr(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! restrict residual from fine to coarse mesh using fully weighted +! residual restriction +! + implicit none + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + integer nx,ny,ncx,ncy,i,j,ic,jc + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: rhsc(ncx,ncy),resf(nx,ny) + real(r8) :: phi(0:nx+1,0:ny+1),phic(0:ncx+1,0:ncy+1) + real(r8) :: cof(nx,ny,10) +! +! set phic zero +! + do jc=0,ncy+1 + do ic=0,ncx+1 + phic(ic,jc) = 0.0_r8 + end do + end do +! +! compute residual on fine mesh in resf +! +!!$OMP PARALLEL DO SHARED(resf,cof,phi,nx,ny) PRIVATE(i,j) + do j=1,ny + do i=1,nx + resf(i,j) = cof(i,j,10)-( & + cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)+ & + cof(i,j,9)*phi(i,j)) + end do + end do +! +! restrict resf to coarse mesh in rhsc +! + call res2(nx,ny,resf,ncx,ncy,rhsc,nxa,nxb,nyc,nyd) + return + end subroutine resmh2cr +!----------------------------------------------------------------------- + subroutine relmh2cr(nx,ny,phi,cof,tx,ty,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! relaxation for muh2cr +! + implicit none + integer nx,ny + real(r8) :: phi(*),cof(*),tx(*),ty(*),sum(*) + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + if (method.eq.0) then ! point relaxation + call relmh2crp(nx,ny,phi,cof) + else if (method.eq.1) then ! line x relaxation + call slxmh2cr(nx,ny,phi,cof,tx,sum) + else if (method.eq.2) then ! line y relaxation + call slymh2cr(nx,ny,phi,cof,ty,sum) + else if (method.eq.3) then ! line x&y relaxation + call slxmh2cr(nx,ny,phi,cof,tx,sum) + call slymh2cr(nx,ny,phi,cof,ty,sum) + end if + return + end subroutine relmh2cr +!----------------------------------------------------------------------- + subroutine relmh2crp(nx,ny,phi,cof) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! gauss-seidel four color point relaxation +! + implicit none + integer nx,ny,i,j,lcolor,i1,i2,i3,i4,it + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10) + i1 = 1 + i2 = 4 + i3 = 3 + i4 = 2 +! +! sweep four colored grid points +! + do lcolor=1,4 +!!$OMP PARALLEL DO SHARED(i1,cof,phi,nx,ny) PRIVATE(i,j) + do j=1,ny,4 + do i=i1,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!!$OMP PARALLEL DO SHARED(i2,cof,phi,nx,ny) PRIVATE(i,j) + do j=2,ny,4 + do i=i2,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!!$OMP PARALLEL DO SHARED(i3,cof,phi,nx,ny) PRIVATE(i,j) + do j=3,ny,4 + do i=i3,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +!!$OMP PARALLEL DO SHARED(i4,cof,phi,nx,ny) PRIVATE(i,j) + do j=4,ny,4 + do i=i4,nx,4 + phi(i,j) = (cof(i,j,10) - ( & + cof(i,j,1)*phi(i+1,j) + & + cof(i,j,2)*phi(i+1,j+1) + & + cof(i,j,3)*phi(i,j+1) + & + cof(i,j,4)*phi(i-1,j+1) + & + cof(i,j,5)*phi(i-1,j) + & + cof(i,j,6)*phi(i-1,j-1) + & + cof(i,j,7)*phi(i,j-1) + & + cof(i,j,8)*phi(i+1,j-1)))/cof(i,j,9) + end do + end do +! +! set periodic virtual boundaries as necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if +! +! permute (i1,i2,i3,i4) for next color +! + it = i4 + i4 = i3 + i3 = i2 + i2 = i1 + i1 = it + end do + return + end subroutine relmh2crp +!----------------------------------------------------------------------- + subroutine slxmh2cr(nx,ny,phi,cof,tx,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! line relaxation in the x direction (periodic or nonperiodic) +! + implicit none + integer nx,ny,i,ib,j + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & + iguess, maxcy,method,nwork,lwork,itero,ngrid, & + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),tx(nx,ny,*),sum(ny) +! +! set periodic y virtual boundary if necessary +! + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if + + if (nxa.ne.0) then +!!$OMP PARALLEL DO SHARED(cof,phi,tx,nx,ny) PRIVATE(i,ib,j) +! +! x direction not periodic, sweep odd j lines +! + do j=1,ny,2 + do i=1,nx + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx + phi(i,j) = phi(i,j)-tx(i-1,j,1)*phi(i-1,j) + end do +! +! backward sweep +! + phi(nx,j) = phi(nx,j)/tx(nx,j,2) + do ib=2,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j))/tx(i,j,2) + end do + end do +! +! sweep even j lines forward and back +! +!!$OMP PARALLEL DO SHARED(cof,phi,tx,nx,ny) PRIVATE(i,ib,j) + do j=2,ny,2 + do i=1,nx + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do i=2,nx + phi(i,j) = phi(i,j)-tx(i-1,j,1)*phi(i-1,j) + end do + phi(nx,j) = phi(nx,j)/tx(nx,j,2) + do ib=2,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j))/tx(i,j,2) + end do + end do + else +! +! x direction periodic +! + do j=1,ny + sum(j) = 0.0_r8 + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do +! +! sweep odd lines forward and back +! +!!$OMP PARALLEL DO SHARED(sum,cof,phi,tx,nx,ny) PRIVATE(i,j,ib) + do j=1,ny,2 + do i=1,nx-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx-2 + phi(i,j) = phi(i,j)-tx(i,j,1)*phi(i-1,j) + end do + do i=1,nx-2 + sum(j) = sum(j)+tx(i,j,5)*phi(i,j) + end do + phi(nx-1,j) = phi(nx-1,j)-sum(j) +! +! backward sweep +! + phi(nx-1,j) = phi(nx-1,j)/tx(nx-1,j,2) + phi(nx-2,j) = (phi(nx-2,j)-tx(nx-2,j,4)*phi(nx-1,j))/ & + tx(nx-2,j,2) + do ib=4,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j)-tx(i,j,4)* & + phi(nx-1,j))/tx(i,j,2) + end do + end do +! +! set periodic and virtual points for j odd +! + do j=1,ny,2 + phi(nx,j) = phi(1,j) + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do +! +! sweep even j lines +! +!!$OMP PARALLEL DO SHARED(sum,cof,phi,tx,nx,ny) PRIVATE(i,j,ib) + do j=2,ny,2 + do i=1,nx-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,3)*phi(i,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,7)*phi(i,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep +! + do i=2,nx-2 + phi(i,j) = phi(i,j)-tx(i,j,1)*phi(i-1,j) + end do + do i=1,nx-2 + sum(j) = sum(j)+tx(i,j,5)*phi(i,j) + end do + phi(nx-1,j) = phi(nx-1,j)-sum(j) +! +! backward sweep +! + phi(nx-1,j) = phi(nx-1,j)/tx(nx-1,j,2) + phi(nx-2,j) = (phi(nx-2,j)-tx(nx-2,j,4)*phi(nx-1,j))/ & + tx(nx-2,j,2) + do ib=4,nx + i = nx-ib+1 + phi(i,j) = (phi(i,j)-tx(i,j,3)*phi(i+1,j)-tx(i,j,4)* & + phi(nx-1,j))/tx(i,j,2) + end do + end do +! +! set periodic and virtual points for j even +! + do j=2,ny,2 + phi(nx,j) = phi(1,j) + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if +! +! set periodic y virtual boundaries if necessary +! + if (nyc.eq.0) then + do i=1,nx + phi(i,0) = phi(i,ny-1) + phi(i,ny+1) = phi(i,2) + end do + end if + return + end subroutine slxmh2cr +!----------------------------------------------------------------------- + subroutine slymh2cr(nx,ny,phi,cof,ty,sum) + use shr_kind_mod ,only: r8 => shr_kind_r8 +! +! line relaxation in the y direction (periodic or nonperiodic) +! + implicit none + integer nx,ny,i,j,jb + integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& + maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& + kcycle,iprer,ipost,intpol,kps + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& + iguess, maxcy,method,nwork,lwork,itero,ngrid,& + klevel,kcur,kcycle,iprer,ipost,intpol,kps + real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),ty(ny,nx,*),sum(nx) +! +! set periodic and virtual x boundaries if necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx,j) = phi(1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + + if (nyc.ne.0) then +! +! y direction not periodic +! +!!$OMP PARALLEL DO SHARED(cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=1,nx,2 + do j=1,ny + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do +! +! forward sweep thru odd x lines +! + do j=2,ny + phi(i,j) = phi(i,j)-ty(j-1,i,1)*phi(i,j-1) + end do +! +! backward sweep +! + phi(i,ny) = phi(i,ny)/ty(ny,i,2) + do jb=2,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1))/ty(j,i,2) + end do + end do +! +! forward sweep even x lines +! +!!$OMP PARALLEL DO SHARED(cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=2,nx,2 + do j=1,ny + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny + phi(i,j) = phi(i,j)-ty(j-1,i,1)*phi(i,j-1) + end do +! +! backward sweep +! + phi(i,ny) = phi(i,ny)/ty(ny,i,2) + do jb=2,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1))/ty(j,i,2) + end do + end do + else +! +! y direction periodic +! + do i=1,nx + sum(i) = 0.0_r8 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do +! +! forward sweep odd x lines +! +!!$OMP PARALLEL DO SHARED(sum,cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=1,nx,2 + do j=1,ny-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny-2 + phi(i,j) = phi(i,j)-ty(j,i,1)*phi(i,j-1) + end do + do j=1,ny-2 + sum(i) = sum(i)+ty(j,i,5)*phi(i,j) + end do + phi(i,ny-1) = phi(i,ny-1)-sum(i) +! +! backward sweep +! + phi(i,ny-1) = phi(i,ny-1)/ty(ny-1,i,2) + phi(i,ny-2) = (phi(i,ny-2)-ty(ny-2,i,4)*phi(i,ny-1))/ & + ty(ny-2,i,2) + do jb=4,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1)-ty(j,i,4)* & + phi(i,ny-1))/ty(j,i,2) + end do + end do +! +! set odd periodic and virtual y boundaries +! + do i=1,nx,2 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do +! +! forward sweep even x lines +! +!!$OMP PARALLEL DO SHARED(sum,cof,phi,ty,nx,ny) PRIVATE(i,j,jb) + do i=2,nx,2 + do j=1,ny-1 + phi(i,j) = cof(i,j,10)-(cof(i,j,1)*phi(i+1,j)+ & + cof(i,j,2)*phi(i+1,j+1)+ & + cof(i,j,4)*phi(i-1,j+1)+ & + cof(i,j,5)*phi(i-1,j)+ & + cof(i,j,6)*phi(i-1,j-1)+ & + cof(i,j,8)*phi(i+1,j-1)) + end do + do j=2,ny-2 + phi(i,j) = phi(i,j)-ty(j,i,1)*phi(i,j-1) + end do + do j=1,ny-2 + sum(i) = sum(i)+ty(j,i,5)*phi(i,j) + end do + phi(i,ny-1) = phi(i,ny-1)-sum(i) +! +! backward sweep +! + phi(i,ny-1) = phi(i,ny-1)/ty(ny-1,i,2) + phi(i,ny-2) = (phi(i,ny-2)-ty(ny-2,i,4)*phi(i,ny-1))/ & + ty(ny-2,i,2) + do jb=4,ny + j = ny-jb+1 + phi(i,j) = (phi(i,j)-ty(j,i,3)*phi(i,j+1)-ty(j,i,4)* & + phi(i,ny-1))/ty(j,i,2) + end do + end do +! +! set even periodic and virtual y boundaries +! + do i=2,nx,2 + phi(i,0) = phi(i,ny-1) + phi(i,ny) = phi(i,1) + phi(i,ny+1) = phi(i,2) + end do + end if +! +! set periodic and virtual x boundaries if necessary +! + if (nxa.eq.0) then + do j=1,ny + phi(0,j) = phi(nx-1,j) + phi(nx+1,j) = phi(2,j) + end do + end if + return + end subroutine slymh2cr +!----------------------------------------------------------------------- diff --git a/src/ionosphere/waccmx/edyn_params.F90 b/src/ionosphere/waccmx/edyn_params.F90 new file mode 100644 index 0000000000..ef1694c0dc --- /dev/null +++ b/src/ionosphere/waccmx/edyn_params.F90 @@ -0,0 +1,53 @@ +module edyn_params +! +! Constants for edynamo. +! + use shr_kind_mod, only: r8 => shr_kind_r8 ! 8-byte reals + implicit none + save + + private + + public :: edyn_params_init + public :: pi, pi_dyn, re_dyn, r0, re, rtd, dtr, finit, h0, hs + public :: kbotdyn, pbotdyn, cm2km + + real(r8),parameter :: & + finit = 0._r8, & ! initialization value + re = 6.37122e8_r8, & ! earth radius (cm) + h0 = 9.7e6_r8, & ! minimum height (cm) + r0 = re+h0, & ! min height from earth center + hs = 1.3e7_r8, & + cm2km = 1.e-5_r8 ! cm to km conversion +! +! Special pi for mag field calculations. If pi=4.*atan(1.) and code is +! linked with -lmass lib, then the last 2 digits (16th and 17th) of pi +! are different (56 instead of 12), resulting in theta0(j=49)==0., which +! is wrong (should be .1110e-15). +! + real(r8),parameter :: pi_dyn = 3.14159265358979312_r8 ! pi for dynamo + real(r8),parameter :: re_dyn = 6.378165e8_r8 ! earth radius (cm) for dynamo + + real(r8) :: & ! constants that are set at runtime + pi, & ! pi = 4.*atan(1.) + dtr, & ! degrees to radians + rtd ! radians to degrees +! +! kbotdyn is the column index at which upward dynamo integrals begin. +! This should correspond to about 85 km (zbotdyn). The index is determined +! by function find_kbotdyn (edynamo.F90) at every step (called by sub +! dynamo_input). The function insures that all processors use the same +! (minimum) kbotdyn. +! + real(r8),parameter :: pbotdyn = 1.0_r8 ! Pa pressure (~80 km) at which to set kbotdyn + integer :: kbotdyn = -1 + + contains +!----------------------------------------------------------------------- + subroutine edyn_params_init + pi = 4._r8*atan(1._r8) + rtd = 180._r8/pi + dtr = pi/180._r8 + end subroutine edyn_params_init +!----------------------------------------------------------------------- +end module edyn_params diff --git a/src/ionosphere/waccmx/edyn_solve.F90 b/src/ionosphere/waccmx/edyn_solve.F90 new file mode 100644 index 0000000000..a751d411ab --- /dev/null +++ b/src/ionosphere/waccmx/edyn_solve.F90 @@ -0,0 +1,916 @@ +module edyn_solve +! +! Prepare stencils and call mudpack PDE solver. This is executed +! by the root task only, following the gather_edyn call in edynamo.F90. +! + use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile ,only: iulog + use edyn_params ,only: finit + use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,nmlath,nmlev + + implicit none + save +! +! Global 2d fields for root task to complete serial part of dynamo. +! The zigmxxx, rhs and rims are gathered from subdomains by in sub +! gather_edyn (edynamo.F90). +! + real(r8),dimension(nmlonp1,nmlat) :: & + zigm11_glb ,& + zigm22_glb ,& + zigmc_glb ,& + zigm2_glb ,& + rhs_glb + real(r8),dimension(nmlonp1,nmlat,2) :: & + rim_glb ! pde solver output + real(r8),dimension(0:nmlonp1,0:nmlat+1) :: & + phisolv +! +! Dimensions of the 5 grid resolutions for the multi-grid PDE: + integer,parameter :: & + nmlon0=nmlon+1, & + nmlat0=(nmlat +1)/2, & + nmlon1=(nmlon0+1)/2, & + nmlat1=(nmlat0+1)/2, & + nmlon2=(nmlon1+1)/2, & + nmlat2=(nmlat1+1)/2, & + nmlon3=(nmlon2+1)/2, & + nmlat3=(nmlat2+1)/2, & + nmlon4=(nmlon3+1)/2, & + nmlat4=(nmlat3+1)/2 +! +! Unmodified coefficients for using modified mudpack: + real(r8),dimension(nmlon0,nmlat0,9) :: cofum +! +! Space needed for descretized coefficients of of dynamo pde at all +! 5 levels of resolution: +! + integer,parameter :: & + ncee=10*nmlon0*nmlat0+9*(nmlon1*nmlat1+nmlon2*nmlat2+nmlon3* & + nmlat3+nmlon4*nmlat4) +! +! Coefficients are stored in 1-d array cee(ncee) +! cee transmits descretized dynamo PDE coefficients to the multi-grid +! mudpack solver. (cee was formerly in ceee.h) +! The common block /cee_com/ is retained from earlier versions because +! of the equivalencing below of coefficient arrays c0, c1, etc. +! + real(r8) :: cee(ncee) + common/cee_com/ cee +! +! The following parameters nc0,nc1,... are pointers to the beginning of +! the coefficients for each level of resolution. +! + integer,parameter :: & + nc0=1, & + nc1=nc0+10*nmlon0*nmlat0, & + nc2=nc1+9 *nmlon1*nmlat1, & + nc3=nc2+9 *nmlon2*nmlat2, & + nc4=nc3+9 *nmlon3*nmlat3 +! +! nc(1:6) are pointers to beginning of coefficient blocks at each of +! 5 levels of resolution: +! nc(1) = nc0, pointer to coefficients for highest resolution. +! nc(2) = nc1, pointer to coefficients at half the resolution of nc0, +! and so on for nc(3), nc(4), nc(5), etc. +! nc(6) = ncee, the dimension of the entire cee array, containing +! coefficients for all 5 levels of resolution. +! + integer :: nc(6) + + real(r8) :: & + c0(nmlon0,nmlat0,10), & + c1(nmlon1,nmlat1,9), & + c2(nmlon2,nmlat2,9), & + c3(nmlon3,nmlat3,9), & + c4(nmlon4,nmlat4,9) + equivalence & + (cee,c0), & + (cee(nc1),c1), & + (cee(nc2),c2), & + (cee(nc3),c3), & + (cee(nc4),c4) +! +! phihm is high-latitude potential, obtained from the Heelis model +! (heelis.F90): +! + real(r8) :: phihm(nmlonp1,nmlat) ! high-latitude potential + real(r8) :: pfrac(nmlonp1,nmlat0) ! NH fraction of potential + + contains +!----------------------------------------------------------------------- + subroutine solve_edyn +! +! Local: + real(r8) :: & ! Global coefficients for PDE solver + coefglb_rhs(nmlonp1,nmlat), & + coefglb_cofum(nmlonp1,nmlat,9) +! +! Initialize global coefficients: +! + coefglb_rhs = finit + coefglb_cofum = finit +! +! Set up stencils for solver: +! + call stencils +! +! Call mudpack PDE solver: +! + call solver(cofum,c0) + + coefglb_rhs (:,1:nmlath) = c0(:,:,10) + coefglb_cofum(:,1:nmlath,:) = cofum(:,:,:) + + end subroutine solve_edyn +!----------------------------------------------------------------------- + subroutine stencils + use edyn_params ,only: pi_dyn + use edyn_maggrid,only: dlatm,dlonm +! +! Locals: + integer :: i,j,jj,jjj,j0,n,ncc,nmaglon,nmaglat + real(r8) :: sym + real(r8) :: cs(nmlat0) + +! +! Set index array nc and magnetic latitude cosine array: +! nc pointes to the start of the coefficient array for each level + nc(1) = nc0 + nc(2) = nc1 + nc(3) = nc2 + nc(4) = nc3 + nc(5) = nc4 + nc(6) = ncee + + do j=1,nmlat0 + cs(j) = cos(pi_dyn/2._r8-(nmlat0-j)*dlatm) + enddo ! j=1,nmlat0 +! +! Set up difference coefficients. Replace zigm11 by A, zigm22 by B, +! zigmc by C, and zigm2 by D. +! + j0 = nmlat0-nmlath + do j=1,nmlath ! 1,49 (assuming nmlat=97) + jj = nmlath+j-1 ! 49,97 + jjj = nmlath-j+1 ! 49,1 +! +! factor 4 from 5-point diff. stencil +! Sigma_(phi lam)/( 4*Delta lam* Delta lon ) +! Sigma_(phi lam)/( 4*Delta lam* Delta lon ) +! Sigma_(lam lam)*cos(lam_m)*DT0DTS/(Delta lam)^2 +! -zigmc_north = southern hemis. 49,1 equator-pole +! -zigm2_north = southern hemis. 49,1 equator-pole +! zigm22 = southern hemis. 49,1 equator-pole +! + do i=1,nmlonp1 + zigmc_glb(i,jj) = (zigmc_glb(i,jj)+zigm2_glb(i,jj))/ & + (4._r8*dlatm*dlonm) + zigm2_glb(i,jj) = zigmc_glb(i,jj)-2._r8*zigm2_glb(i,jj)/ & + (4._r8*dlatm*dlonm) + zigm22_glb(i,jj) = zigm22_glb(i,jj)*cs(j0+j)/dlatm**2 + zigmc_glb(i,jjj) = -zigmc_glb(i,jj) + zigm2_glb(i,jjj) = -zigm2_glb(i,jj) + zigm22_glb(i,jjj) = zigm22_glb(i,jj) + enddo ! i=1,nmlonp1 + if (j /= nmlath) then +! +! Sigma_(phi phi)/( cos(lam_m)*DT0DTS*(Delta lon)^2 ) +! zigm11 = southern hemis. 49,1 equator-pole +! + do i = 1,nmlonp1 + zigm11_glb(i,jj) = zigm11_glb(i,jj)/(cs(j0+j)*dlonm**2) + zigm11_glb(i,jjj) = zigm11_glb(i,jj) + enddo + endif + enddo ! j=1,nmlath +! +! Set zigm11 to zero at megnetic poles to avoid floating exception +! (values at poles are not used): +! + do i = 1,nmlonp1 + zigm11_glb(i,1) = 0.0_r8 + zigm11_glb(i,nmlat) = 0.0_r8 + enddo + +! Clear array for difference stencils at all levels: + call clearcee(cee,nmlon0,nmlat0) +! +! Init cofum coefficients: + cofum(:,:,:) = finit +! +! Calculate contribution to stencils from each PDE coefficient +! +! Sigma_(phi phi)/( cos(lam_m)*dt0dts*(Delta lon)^2 ) + sym = 1._r8 + call stencmd(zigm11_glb,cs,nmlon0,nmlat0,sym,cee,1) +! +! Sigma_(lam lam)*cos(lam_m)*dt0dts/(Delta lam)^2 + sym = 1._r8 + call stencmd(zigm22_glb,cs,nmlon0,nmlat0,sym,cee,4) +! +! Sigma_(phi lam)/( 4*Delta lam* Delta lon ) + sym = -1._r8 + call stencmd(zigmc_glb,cs,nmlon0,nmlat0,sym,cee,2) +! +! Sigma_(lam phi)/( 4*Delta lam* Delta lon ) + sym = -1._r8 + call stencmd(zigm2_glb,cs,nmlon0,nmlat0,sym,cee,3) +! +! Insert RHS in finest stencil: + do j = 1,nmlat0 + jj = nmlath-nmlat0+j + do i = 1,nmlon0 + c0(i,j,10) = rhs_glb(i,jj) + enddo ! i = 1,nmlon0 + enddo ! j = 1,nmlat0 + c0(nmlonp1,1,10) = c0(1,1,10) +! +! Set boundary condition at the pole: + call edges(c0,nmlon0,nmlat0) + call edges(c1,nmlon1,nmlat1) + call edges(c2,nmlon2,nmlat2) + call edges(c3,nmlon3,nmlat3) + call edges(c4,nmlon4,nmlat4) + call edges(cofum,nmlon0,nmlat0) +! +! Divide stencils by cos(lam_0) (not rhs): + call divide(c0,nmlon0,nmlat0,nmlon0,nmlat0,cs,1) + call divide(c1,nmlon1,nmlat1,nmlon0,nmlat0,cs,1) + call divide(c2,nmlon2,nmlat2,nmlon0,nmlat0,cs,1) + call divide(c3,nmlon3,nmlat3,nmlon0,nmlat0,cs,1) + call divide(c4,nmlon4,nmlat4,nmlon0,nmlat0,cs,1) + call divide(cofum,nmlon0,nmlat0,nmlon0,nmlat0,cs,0) +! +! Set value of solution to 1. at pole: + do i=1,nmlon0 + c0(i,nmlat0,10) = 1._r8 + enddo +! +! Modify stencils and RHS so that the NH high lat potential is inserted at +! high latitude. The SH high lat potential will be added back later. +! pfrac = fraction of dynamo in solution in the NH. = 1 low lat, = 0 hi lat +! cons_module: crit(1)=15, crit(2)=30 deg colats, or hi-lat > 75 deg, +! dynamo < 60 deg, and combination between 60-75 mag lat. +! The dynamo is symmetric about the magnetic equator, but the high latitude +! is anti-symmetric in both hemispheres. However, since Mudpack uses the +! NH potential pattern, then the SH potential pattern must be added +! back into the 2-D phim before the call threed, and before it is +! transformed to geographic coordinates. +! + ncc = 1 + nmaglon = nmlon0 + nmaglat = nmlat0 + do n=1,5 + call stenmd(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0),pfrac) + ncc = ncc+9*nmaglon*nmaglat + if (n==1) ncc = ncc+nmaglon*nmaglat ! rhs is in 10th slot + nmaglon = (nmaglon+1)/2 + nmaglat = (nmaglat+1)/2 + enddo ! n=1,5 + + end subroutine stencils +!----------------------------------------------------------------------- + subroutine clearcee(cee,nlon0,nlat0) +! +! Zero C arrays for stencil coefficients. +! Cee will contain: +! c0(nmlon0,nmlat0,10), c1(nmlon1,nmlat1,9), c2(nmlon2,nmlat2,9), +! c3(nmlon3,nmlat3,9), c4(nmlon4,nmlat4,9) +! +! Args: + integer,intent(in) :: nlon0,nlat0 + real(r8),intent(out) :: cee(*) +! +! Local: + integer :: nlon,nlat,n,m,i +! +! Compute total size of cee + nlon = nlon0 + nlat = nlat0 + n = 0 + do m=1,5 ! 5 resolution levels + n = n+nlon*nlat + nlon = (nlon+1)/2 + nlat = (nlat+1)/2 + enddo ! m=1,5 (5 resolution levels) + n = 9*n+nlon0*nlat0 +! +! Clear cee: + do i=1,n + cee(i) = 0._r8 + enddo + end subroutine clearcee +!----------------------------------------------------------------------- + subroutine stencmd(zigm,cs,nlon0,nlat0,sym,cee,ncoef) +! +! Calculate contribution fo 3 by 3 stencil from coefficient zigm +! at each grid point and level. +! +! Args: + integer,intent(in) :: & + nlon0, & ! longitude dimension of finest grid level + nlat0, & ! latitude dimension of finest grid level + ncoef ! integer identifier of coefficient + real(r8),intent(in) :: & + zigm(nlon0,nlat0), & ! coefficients (nlon0+1/2,(nlat0+1)/2) + sym, & ! 1. if zigm symmetric w.r.t. equator, -1 otherwise + cs(nlat0) + real(r8),intent(inout) :: & ! output stencil array consisting of c0,c1,c2,c3,c4 + cee(*) +! +! Local: + integer :: nc,nlon,nlat,n + real(r8) :: wkarray(-15:nmlon0+16,nmlat0) +! +! Perform half-way interpolation and extend zigm in wkarray: +! + call htrpex(zigm,nlon0,nlat0,sym,wkarray) +! +! Calculate contribution to stencil for each grid point and level: +! + nc = 1 + nlon = nlon0 + nlat = nlat0 +! +! Calculate modified and unmodified stencil on finest grid +! + call cnmmod(nlon0,nlat0,nlon,nlat,cee(nc),ncoef,wkarray,cofum) +! +! Stencils on other grid levels remain the same. + nc = nc+10*nlon*nlat + nlon = (nlon+1)/2 + nlat = (nlat+1)/2 +! + do n=2,5 + call cnm(nlon0,nlat0,nlon,nlat,cee(nc),ncoef,wkarray) + nc = nc+9*nlon*nlat + if (n==1) nc = nc+nlon*nlat + nlon = (nlon+1)/2 + nlat = (nlat+1)/2 + enddo ! n=1,5 + end subroutine stencmd +!----------------------------------------------------------------------- + subroutine htrpex(coeff,nmlon0,nmlat0,sym,wkarray) +! +! Perform half-way interpolation on array coeff and extend over 16 grid +! points. Result returned in wkarray. +! +! Args: + integer,intent(in) :: nmlon0,nmlat0 + real(r8),intent(in) :: coeff(nmlon0,nmlat0),sym + real(r8),intent(out) :: wkarray(-15:nmlon0+16,nmlat0) +! +! Local: + integer :: i,j,jj +! +! Copy coeff into positions in wkarray: + do j=1,nmlat0 + jj = nmlat0-j+1 + do i=1,nmlon0 + wkarray(i,j) = sym*coeff(i,jj) + enddo ! i=1,nmlon0 + enddo ! j=1,nmlat0 +! +! Extend over 32 grid spaces to allow for a total of 5 grid levels: + do i=1,16 + do j=1,nmlat0 + wkarray(1-i,j) = wkarray(nmlon0-i,j) + wkarray(nmlon0+i,j) = wkarray(1+i,j) + enddo ! j=1,nmlat0 + enddo ! i=1,16 + end subroutine htrpex +!----------------------------------------------------------------------- + subroutine cnm(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray) +! +! Compute contribution to stencil from zigm(ncoef) on grid nlon by nlat, +! Finest grid is nlon0 by nlat0. +! +! Args: + integer,intent(in) :: & + nlon0,nlat0, & ! finest grid dimensions + nlon,nlat ! output grid dimensions + real(r8),intent(in) :: wkarray(-15:nmlon0+16,nmlat0) +! +! ncoef: integer id of coefficient: +! ncoef = 1 for zigm11 +! ncoef = 2 for zigm12 (=zigmc+zigm2) +! ncoef = 3 for zigm21 (=zigmc-zigm2) +! ncoef = 4 for zigm22 +! + integer,intent(in) :: ncoef + real(r8),intent(inout) :: & + c(nlon,nlat,*) ! output array for grid point stencils at resolution nlon x nlat +! +! Local: + integer :: i,j,nint,i0,j0 +! For now, retain this pi to insure bit compatability w/ old code + real(r8),parameter :: pi=3.141592654_r8 + real(r8) :: wk(nlon0,3) +! +! Compute separation of grid points of resolution nlon x nlat within +! grid of resolution nlon0,nlat0. Evaluate dlon and dlat, grid spacing +! of nlon x nlat. +! + nint = (nlon0-1)/(nlon-1) +! +! Scan wkarray nlon x nlat calculating and adding contributions to stencil +! from zigm(ncoef) + i0 = 1-nint + j0 = 1-nint +! +! zigm11: +! am 2001-6-27 include boundary condition at equator + if (ncoef==1) then + do j = 1,nlat-1 + do i = 1,nlon + c(i,j,1) = c(i,j,1)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + c(i,j,5) = c(i,j,5)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+(i+1)*nint,j0+j*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+wkarray(i0+(i-1)*nint,j0+j*nint)) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! zigm12 (=zigmc+zigm2) + elseif (ncoef==2) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,2) = c(i,j,2)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + c(i,j,4) = c(i,j,4)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,6) = c(i,j,6)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,8) = c(i,j,8)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + wk(i,1) = 0.5_r8*(wkarray(i0+(i+1)*nint,j0+j*nint)- & + wkarray(i0+(i-1)*nint,j0+j*nint)) + wk(i,2) = (c(i,j,3)+wk(i,1))*(c(i,j,7)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,3)+c(i,j,7)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,3) = c(i,j,3)+wk(i,1)+wk(i,3) + c(i,j,7) = c(i,j,7)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! zigm21 (=zigmc-zigm2) + elseif (ncoef==3) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,2) = c(i,j,2)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,4) = c(i,j,4)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,6) = c(i,j,6)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + c(i,j,8) = c(i,j,8)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + wk(i,1) = 0.5_r8*(wkarray(i0+i*nint,j0+(j+1)*nint)- & + wkarray(i0+i*nint,j0+(j-1)*nint)) + wk(i,2) = (c(i,j,1)+wk(i,1))*(c(i,j,5)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,1)+c(i,j,5)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,1) = c(i,j,1)+wk(i,1)+wk(i,3) + c(i,j,5) = c(i,j,5)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! Low latitude boundary condition: + j = 1 + do i=1,nlon + c(i,j,2) = c(i,j,2)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,4) = c(i,j,4)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + wk(i,1) = 0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + wk(i,2) = (c(i,j,1)+wk(i,1))*(c(i,j,5)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,1)+c(i,j,5)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,1) = c(i,j,1)+wk(i,1)+wk(i,3) + c(i,j,5) = c(i,j,5)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i=1,nlon +! +! zigm22: + elseif (ncoef==4) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,3) = c(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,7) = c(i,j,7)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+(j-1)*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! Low latitude boundary condition: + j = 1 + do i=1,nlon + c(i,j,3) = c(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + enddo ! i=1,nlon + endif ! ncoef + end subroutine cnm +!----------------------------------------------------------------------- + subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) +! +! Compute contribution to stencil from zigm(ncoef) on grid nlon by nlat, +! Finest grid is nlon0 by nlat0. +! +! Args: + integer,intent(in) :: & + nlon0,nlat0, & ! finest grid dimensions + nlon,nlat ! output grid dimensions + real(r8),intent(in) :: wkarray(-15:nmlon0+16,nmlat0) + real(r8),dimension(nmlon0,nmlat0,9),intent(inout) :: cofum +! +! ncoef: integer id of coefficient: +! ncoef = 1 for zigm11 +! ncoef = 2 for zigm12 (=zigmc+zigm2) +! ncoef = 3 for zigm21 (=zigmc-zigm2) +! ncoef = 4 for zigm22 +! + integer,intent(in) :: ncoef + real(r8),intent(inout) :: & + c(nlon,nlat,*) ! output array for grid point stencils at resolution nlon x nlat +! +! Local: + integer :: i,j,nint,i0,j0 +! For now, retain this pi to insure bit compatability w/ old code + real(r8),parameter :: pi=3.141592654_r8 + real(r8) :: wk(nlon0,3) +! +! Compute separation of grid points of resolution nlon x nlat within +! grid of resolution nlon0,nlat0. Evaluate dlon and dlat, grid spacing +! of nlon x nlat. +! + nint = (nlon0-1)/(nlon-1) +! +! Scan wkarray nlon x nlat calculating and adding contributions to stencil +! from zigm(ncoef) + i0 = 1-nint + j0 = 1-nint +! +! zigm11: +! am 2001-6-27 include boundary condition at equator + if (ncoef==1) then + do j = 1,nlat-1 + do i = 1,nlon + c(i,j,1) = c(i,j,1)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + c(i,j,5) = c(i,j,5)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+(i+1)*nint,j0+j*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) +! +! Unmodified: + cofum(i,j,1) = cofum(i,j,1)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + cofum(i,j,5) = cofum(i,j,5)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + cofum(i,j,9) = cofum(i,j,9)-0.5_r8*(wkarray(i0+(i+1)*nint,j0+j*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+wkarray(i0+(i-1)*nint,j0+j*nint)) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! zigm12 (=zigmc+zigm2) + elseif (ncoef==2) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,2) = c(i,j,2)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + c(i,j,4) = c(i,j,4)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,6) = c(i,j,6)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i-1)*nint,j0+j*nint)) + c(i,j,8) = c(i,j,8)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+(i+1)*nint,j0+j*nint)) + wk(i,1) = 0.5_r8*(wkarray(i0+(i+1)*nint,j0+j*nint)- & + wkarray(i0+(i-1)*nint,j0+j*nint)) +! +! Unmodified: + cofum(i,j,2) = c(i,j,2) + cofum(i,j,4) = c(i,j,4) + cofum(i,j,6) = c(i,j,6) + cofum(i,j,8) = c(i,j,8) + cofum(i,j,3) = cofum(i,j,3)+wk(i,1) + cofum(i,j,7) = cofum(i,j,7)-wk(i,1) +! + wk(i,2) = (c(i,j,3)+wk(i,1))*(c(i,j,7)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,3)+c(i,j,7)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,3) = c(i,j,3)+wk(i,1)+wk(i,3) + c(i,j,7) = c(i,j,7)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! zigm21 (=zigmc-zigm2) + elseif (ncoef==3) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,2) = c(i,j,2)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,4) = c(i,j,4)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,6) = c(i,j,6)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + c(i,j,8) = c(i,j,8)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + wk(i,1) = 0.5_r8*(wkarray(i0+i*nint,j0+(j+1)*nint)- & + wkarray(i0+i*nint,j0+(j-1)*nint)) +! +! Unmodified: + cofum(i,j,2) = c(i,j,2) + cofum(i,j,4) = c(i,j,4) + cofum(i,j,6) = c(i,j,6) + cofum(i,j,8) = c(i,j,8) + cofum(i,j,1) = cofum(i,j,1)+wk(i,1) + cofum(i,j,5) = cofum(i,j,5)-wk(i,1) +! + wk(i,2) = (c(i,j,1)+wk(i,1))*(c(i,j,5)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,1)+c(i,j,5)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,1) = c(i,j,1)+wk(i,1)+wk(i,3) + c(i,j,5) = c(i,j,5)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! Low latitude boundary condition: + j = 1 + do i=1,nlon + c(i,j,2) = c(i,j,2)+.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,4) = c(i,j,4)-.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + wk(i,1) = .5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + + cofum(i,j,2) = c(i,j,2) + cofum(i,j,4) = c(i,j,4) + cofum(i,j,1) = cofum(i,j,1)+wk(i,1) + cofum(i,j,5) = cofum(i,j,5)-wk(i,1) + + wk(i,2) = (c(i,j,1)+wk(i,1))*(c(i,j,5)-wk(i,1)) + wk(i,3) = sign(wk(i,1),c(i,j,1)+c(i,j,5)) + if (wk(i,2) >= 0._r8) wk(i,3) = 0._r8 + c(i,j,1) = c(i,j,1)+wk(i,1)+wk(i,3) + c(i,j,5) = c(i,j,5)-wk(i,1)+wk(i,3) + c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) + enddo ! i=1,nlon +! +! zigm22: + elseif (ncoef==4) then + do j = 2,nlat-1 + do i = 1,nlon + c(i,j,3) = c(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,7) = c(i,j,7)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+(j-1)*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+wkarray(i0+i*nint,j0+(j+1)*nint)) +! +! Unmodified: + cofum(i,j,3) = cofum(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + cofum(i,j,7) = cofum(i,j,7)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j-1)*nint)) + cofum(i,j,9) = cofum(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+(j-1)*nint)+ & + 2._r8*wkarray(i0+i*nint,j0+j*nint)+wkarray(i0+i*nint,j0+(j+1)*nint)) + enddo ! i = 1,nlon + enddo ! j = 2,nlat-1 +! +! Low latitude boundary condition: + j = 1 + do i=1,nlon + c(i,j,3) = c(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + c(i,j,9) = c(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + cofum(i,j,3) = cofum(i,j,3)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + cofum(i,j,9) = cofum(i,j,9)-0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & + wkarray(i0+i*nint,j0+(j+1)*nint)) + enddo ! i=1,nlon + endif ! ncoef + end subroutine cnmmod +!----------------------------------------------------------------------- + subroutine ceee(cee,nx,ny,cf) + +! +! Called from mudpack solvers to transfer coefficients. +! +! Args: + integer,intent(in) :: nx,ny + real(r8),intent(in) :: cee(nx,ny,*) + real(r8),intent(out) :: cf(nx,ny,*) +! +! Local: + integer :: i,j,n + + do n = 1,9 + do j = 1,ny + do i = 1,nx + cf(i,j,n) = cee(i,j,n) + enddo + enddo + enddo + end subroutine ceee +!-------------------------------------------------------------------- + subroutine edges(c,nlon,nlat) +! +! Insert equatorial and polar boundary conditions in stencil c(nlon,nlat,9) +! +! Args: + integer,intent(in) :: nlon,nlat + real(r8),intent(out) :: c(nlon,nlat,*) +! +! Local: + integer :: n,i + + do n=1,8 + do i=1,nlon + c(i,nlat,n) = 0._r8 + enddo + enddo + do i=1,nlon + c(i,nlat,9) = 1._r8 + enddo + end subroutine edges +!-------------------------------------------------------------------- + subroutine divide(c,nlon,nlat,nlon0,nlat0,cs,igrid) +! +! Divide stencil C by cos(theta(i,j)) +! +! Args: + integer,intent(in) :: nlon,nlat,nlon0,nlat0,igrid + real(r8),intent(in) :: cs(*) + real(r8),intent(out) :: c(nlon,nlat,*) +! +! Local: + integer :: nint,j0,n,j,i +! + nint = (nlon0-1)/(nlon-1) + j0 = 1-nint + do n = 1,9 + do j = 1,nlat-1 + do i = 1,nlon + c(i,j,n) = c(i,j,n)/(cs(j0+j*nint)*nint**2) + enddo ! i = 1,nlon + enddo ! j = 1,nlat-1 + enddo ! n = 1,9 +! + if (nint==1.and.igrid > 0) then + do i = 1,nlon + c(i,1,10) = c(i,1,10)/cs(1) + enddo ! i = 1,nlon + endif + end subroutine divide +!-------------------------------------------------------------------- + subroutine stenmd(inlon,inlat,c,phihm,pfrac) + use edyn_params ,only: dtr + use edyn_maggrid,only: dlatm +! +! Modify stencil to set potential to heelis value within auroral circle. +! +! Args: + integer,intent(in) :: inlon,inlat + real(r8),intent(inout) :: c(inlon,inlat,*) + real(r8),dimension(nmlon0,nmlat0),intent(in) :: & + phihm, & ! heelis potential (from subs potm, flwv32) + pfrac ! fractional presence of dynamo (from sub colath) +! +! Local: + integer :: nint,i0,j0,i,j,n,jj + real(r8) :: real8 +! +! Compute separation of grid points for this resolution: + nint = (nmlon0-1)/(inlon-1) + i0 = 1-nint + j0 = 1-nint +! +! If nint==1, then we are at the highest resolution. +! Correct RHS, which is in c(10) +! + if (nint==1) then + do j=1,inlat + do i=1,inlon + c(i,j,10) = pfrac(i,j)*c(i,j,10)+(1._r8-pfrac(i,j))*c(i,j,9)* & + (dlatm/(10._r8*dtr))**2*phihm(i,j) + enddo ! i=1,inlon + enddo ! j=1,inlat + endif +! +! Modify stencil, c(i,j,n),n=1,9: +! + real8 = dble(nint) + if (nint==1) then + do j=1,inlat + jj = j0+j*nint + do n = 1,8 + do i = 1,inlon + c(i,j,n) = c(i,j,n)*pfrac(i0+i*nint,jj) + cofum(i,j,n) = cofum(i,j,n)*pfrac(i0+i*nint,jj) + enddo ! i = 1,inlon + enddo ! n = 1,8 + do i = 1,inlon + c(i,j,9) = c(i,j,9)*pfrac(i0+i*nint,jj)+ & + (1._r8-pfrac(i0+i*nint,jj))*c(i,j,9)* & + (dlatm*real8/(10._r8*dtr))**2 + cofum(i,j,9) =cofum(i,j,9)*pfrac(i0+i*nint,jj)+ & + (1._r8-pfrac(i0+i*nint,jj))*cofum(i,j,9)* & + (dlatm*real8/(10._r8*dtr))**2 + enddo ! i = 1,inlon + enddo ! j=1,inlat + else ! nint /= 1 + do j=1,inlat + jj = j0+j*nint + do n = 1,8 + do i = 1,inlon + c(i,j,n) = c(i,j,n)*pfrac(i0+i*nint,jj) + enddo ! i = 1,inlon + enddo ! n = 1,8 + do i = 1,inlon + c(i,j,9) = c(i,j,9)*pfrac(i0+i*nint,jj)+ & + (1._r8-pfrac(i0+i*nint,jj))*c(i,j,9)* & + (dlatm*real8/(10._r8*dtr))**2 + enddo ! i = 1,inlon + enddo ! j=1,inlat + endif ! nint + end subroutine stenmd +!-------------------------------------------------------------------- + subroutine solver(cofum,c0) +! use edyn_mudmod, only: mudmod +! use edyn_muh2cr, only: muh +! +! Call mudpack to solve PDE. Solution is returned in rim: +! real,dimension(nmlonp1,nmlat,2) :: rim +! Mudpack solvers: +! isolve = 0 org. mud v5. (modified stencils neq direct solution) +! isolve = 1 muh hybrid solver (no convergence => only as direct solver) +! isolve = 2 modified mud (residual calculated with unmodified stencils +! same solution as with direct solver, if same +! coefficient matrix is used) +! Only isolve==2 is supported in edynamo. +! +! Args: + real(r8),dimension(nmlon0,nmlat0,9),intent(in) :: cofum + real(r8),intent(in) :: c0(nmlon0,nmlat0,10) +! +! Local: + integer :: i,j,jntl,ier,isolve + real(r8) :: l2norm + real(r8),dimension(nmlon0,nmlat0) :: ressolv + real(r8),dimension(nmlon0,nmlat0,9) :: cofum_solv + +! Module data: +! real,dimension(nmlonp1,nmlat,2) :: rim_glb ! pde solver output + + jntl = 0 + ier = 0 + isolve = 2 + call mudmod(rim_glb,phisolv,jntl,isolve,ier)! solver in mudmod.F + if (ier < 0 ) then ! not converged + write(iulog,*) 'muh: use direct solver' + call muh(rim_glb,jntl) ! solver in mud.F + endif + + l2norm=0._r8 + ressolv = 0.0_r8 + do j = 1,nmlat0 + do i = 1,nmlon0-1 + cofum_solv(i,j,:)= cofum(i,j,:) +! +! fields: phisolv(0:nmlonp1,0:nmlat+1) ! 2d solution/ electric potential +! + ressolv(i,j) = ( & + cofum_solv(i,j,1)*phisolv(i+1,j)+ & + cofum_solv(i,j,2)*phisolv(i+1,j+1)+ & + cofum_solv(i,j,3)*phisolv(i,j+1)+ & + cofum_solv(i,j,4)*phisolv(i-1,j+1)+ & + cofum_solv(i,j,5)*phisolv(i-1,j)+ & + cofum_solv(i,j,6)*phisolv(i-1,j-1)+ & + cofum_solv(i,j,7)*phisolv(i,j-1)+ & + cofum_solv(i,j,8)*phisolv(i+1,j-1)+ & + cofum_solv(i,j,9)*phisolv(i,j)) + + ressolv(i,j) = c0(i,j,10)-ressolv(i,j) + l2norm = l2norm + ressolv(i,j)*ressolv(i,j) + enddo + enddo +! write(iulog,*) 'L2norm (global root task) = ',l2norm + + end subroutine solver +!-------------------------------------------------------------------- +end module edyn_solve diff --git a/src/ionosphere/waccmx/edynamo.F90 b/src/ionosphere/waccmx/edynamo.F90 new file mode 100644 index 0000000000..b2687d8a2f --- /dev/null +++ b/src/ionosphere/waccmx/edynamo.F90 @@ -0,0 +1,2277 @@ +module edynamo +! +!----------------------------------------------------------------------- +! Purpose: +! Electro-dynamo module +!----------------------------------------------------------------------- +! + use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile ,only: iulog + use cam_abortutils,only: endrun + use spmd_utils ,only: masterproc +#ifdef WACCMX_EDYN_ESMF + use edyn_params ,only: finit ! initialization value + use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,nmlath,nmlev + use edyn_mpi ,only: mlon0,mlon1,omlon1,mlat0,mlat1,mlev0,mlev1,mytid,& + lon0,lon1,lat0,lat1,lev0,lev1 + use edyn_solve ,only: solve_edyn + use time_manager, only: get_nstep ! for debug + use cam_history, only : outfld, hist_fld_active + use savefield_waccm,only: savefld_waccm_switch + use esmf, only : ESMF_KIND_R8, ESMF_Field ! ESMF library module +#endif + + implicit none + save + private + +#ifdef WACCMX_EDYN_ESMF + integer :: nstep +! +! 3d pointers to fields regridded to magnetic subdomains (i,j,k): +! (mlon0:mlon1,mlat0:mlat1,nmlev) +! + real(ESMF_KIND_R8),pointer,dimension(:,:,:) :: & ! 3d fields on mag grid + ped_mag, & ! pedersen conductivity on magnetic grid + hal_mag, & ! hall conductivity on magnetic grid + zpot_mag, & ! geopotential on magnetic grid + scht_mag, & ! scale height on magnetic grid + adotv1_mag, & ! ue1 (m/s) + adotv2_mag ! ue2 (m/s) +! +! 2d pointers to fields on magnetic subdomains (i,j): +! (mlon0:mlon1,mlat0:mlat1) +! + real(ESMF_KIND_R8),pointer,dimension(:,:) :: & + sini_mag, & ! sin(I_m) + adota1_mag, & ! d(1)**2/D + adota2_mag, & ! d(2)**2/D + a1dta2_mag, & ! (d(1) dot d(2)) /D + be3_mag ! mag field strength (T) +! +! 2d coefficients and RHS terms for PDE on magnetic subdomains +! (including halo points). +! If use_time3d_integ==.true., these will be input from time3d +! (see use-association in time3d.F90) +! + real(r8),allocatable,dimension(:,:) :: & + zigm11, & ! sigma11*cos(theta0) + zigmc, & ! sigmac + zigm2, & ! sigma2 + zigm22, & ! sigma22/cos(theta0) + rim1,rim2, & ! see description in comment below + rhs, & ! right-hand side of PDE + phimsolv, & ! solution direct from solver (nhem only) + phim2d ! solution with phihm and both nhem and shem +! +! 3d potential and electric field on mag subdomains (see sub pthreed): +! (mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) +! Electric potential and field components are output fields of edynamo +! (later, these can be output arguments of the main driver, sub dynamo) +! + real(r8),allocatable,dimension(:,:,:) :: & + phim3d, & ! 3d electric potential + ed13d,ed23d, & ! 3d electric field for current calculations + ephi3d, & ! 3d eastward electric field + elam3d, & ! 3d equatorward electric field + emz3d, & ! 3d upward electric field + zpotm3d ! 3d geopotential (values at all levels) +! +! 3d ion drift velocities on geographic grid (output): +! +! real(r8),allocatable,dimension(:,:,:),save,target :: & ! (nlev,lon0:lon1,lat0:lat1) +! ui, & ! zonal ion drift +! vi, & ! meridional ion drift +! wi ! vertical ion drift +! +! 3d electric field on geographic subdomains (see sub pefield): +! (nlev,lon0-2,lon1+2,lat0:lat1) + real(r8),allocatable,dimension(:,:,:) :: ex,ey,ez +! +! 3d electric potential on geographic subdomains (lon0:lon1,lat0:lat1,nlevp1) +! This will be regridded from phim3d for output to history files. + real(r8),allocatable,dimension(:,:,:) :: phig3d ! (lon0:lon1,lat0:lat1,nlevp1) + real(r8),allocatable,dimension(:,:,:) :: poten ! (nlevp1,lon0:lon1,lat0:lat1) +! +! Fields at mag equator: +! + real(r8),allocatable,dimension(:,:) :: & ! (mlon0:mlon1,nmlev) + ped_meq, hal_meq, adotv1_meq, adotv2_meq, zpot_meq + real(r8),allocatable,dimension(:,:,:) :: & ! (mlon0:mlon1,nmlev,4) + fmeq_out + real(r8),allocatable,dimension(:,:,:,:) :: & ! (mlon0:mlon1,mlat0:mlat1,nmlev,4) + fmeq_in +! +! Global longitude values near mag equator and poles for complete_integrals and rhs. +! These are declared in module data because they are used by subs complete_integrals +! and rhspde. The nf2d 6 fields are: zigm11,zigm22,zigmc,zigm2,rim1,rim2, +! order is important (see feq_jpm1 and fpole_jpm2)! +! + integer,parameter :: nf2d=6 ! 6 2d fields + real(r8) :: feq_jpm1(nmlonp1,2,nf2d) ! 6 fields at 2 lats (eq-1, eq+1) + real(r8) :: fpole_jpm2(nmlonp1,4,nf2d) ! fields at S pole+1,2 and N pole-1,2 + + real(r8),parameter :: unitvm(nmlon)=1._r8 +! +! ed1,ed2: 2d electric field output on mag grid: +! (use-associated by dpie_coupling) +! + real(r8),allocatable,dimension(:,:) :: ed1,ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) +! +! Global inputs to time3d: Note dimension order switch: +! edynamo has subdomains (mlon,mlat), whereas time3d has global (nmlat,nmlonp1) +! These are use-associated by time3d, and are init to zero in edyn_init. +! + real(r8),dimension(nmlat,nmlonp1) :: ed1_glb,ed2_glb + logical :: do_integ ! from input arg do_integrals + logical :: debug=.false. ! set true for prints to stdout at each call + + public alloc_edyn,ed1,ed2,ed1_glb,ed2_glb + public zigm11,zigmc,zigm2,zigm22,rim1,rim2 +#endif + public :: dynamo + + contains +!----------------------------------------------------------------------- + subroutine dynamo(tn,un,vn,wn,zpot,ped,hall,ui,vi,wi, & + lev0,lev1,lon0,lon1,lat0,lat1,do_integrals) + use edyn_mpi,only: & + mp_mag_halos, & ! set magnetic halo points + mp_scatter_phim ! scatter solution to slave tasks + use edyn_solve,only: rim_glb ! pde solver output (nmlonp1,nmlat,2) + use edyn_geogrid ,only: nlat + use cam_abortutils,only: endrun +! +! Main driver for edynamo. +! Note alloc_edyn and esmf_init are called from edyn_init. +! +! Args: + integer,intent(in) :: & ! geographic subdomain + lev0,lev1, & ! first,last level indices (not distributed) + lon0,lon1, & ! first,last longitude indices of geographic subdomain + lat0,lat1 ! first,last latitude indices of geographic subdomain + logical,intent(in) :: do_integrals +! +! Inputs from neutral atmosphere (on geographic subdomain): +! (intent(inout) because they are passed to sub dynamo_input) +! + real(r8),intent(inout),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + tn, & ! neutral temperature (deg K) + un, & ! neutral zonal wind velocity (cm/s) + vn, & ! neutral meridional wind velocity (cm/s) + wn, & ! neutral vertical wind velocity (cm/s) + zpot, & ! geopotential height (cm) + ped, & ! pedersen conductivity (S/m) + hall, & ! hall conductivity (S/m) + ui, & ! zonal ion drift (cm/s) + vi, & ! meridional ion drift (cm/s) + wi ! vertical ion drift (cm/s) +#ifdef WACCMX_EDYN_ESMF +! +! Local: + real(r8) :: & ! Global coefficients for PDE solver + coefglb_rhs(nmlonp1,nmlat), & + coefglb_cofum(nmlonp1,nmlat,9) + real(r8) :: fmin,fmax ! for debug + integer :: k + + if (debug) then + nstep = get_nstep() + write(iulog,"('Enter dynamo: nstep=',i5,' do_integrals=',l1)") nstep,do_integrals + endif + + do_integ = do_integrals ! do_integ is module data +! +! Regrid input fields from geographic to magnetic, and calculate +! some additional fields. If conductances are passed in from +! time3d (.not.do_integrals), then we do not need these inputs. +! + if (do_integrals) then + call dynamo_input(tn,un,vn,wn,zpot,ped,hall,& + lev0,lev1,lon0,lon1,lat0,lat1) + if (debug) write(iulog,"('edynamo debug: after dynamo_input')") + endif +! +! Fieldline integration: +! +! If *not* doing fieldline integrations, then global conductances +! were passed in to the driver from time3d, and transformed from +! (nmlat,nmlonp1) to (nmlonp1,nmlat), defining zigmxx and rim1,2 +! for the solver. +! + if (do_integrals) call fieldline_integrals +! +! Equatorial and polar values, hemisphere folding: +! (these will be time3d integrations if do_integrals==.false.) +! + call complete_integrals + if (debug) write(iulog,"('edynamo debug: after complete_integrals')") +! +! Calculate right-hand side on mag subdomains: +! (mag halos are needed in rim1,2 for rhs calculation) +! + call mp_mag_halos(rim1,mlon0,mlon1,mlat0,mlat1,1) + call mp_mag_halos(rim2,mlon0,mlon1,mlat0,mlat1,1) + call rhspde + if (debug) write(iulog,"('edynamo debug: after rhspde')") +! +! Gather needed arrays to root task for the serial solver: +! + call gather_edyn + if (debug) write(iulog,"('edynamo debug: after gather_edyn')") +! +! Root task now sets up stencils and calls the PDE solver: +! + if (debug) write(iulog,"('edynamo debug: call solve_edyn (master only)')") + if (mytid==0) then + call solve_edyn + endif + if (debug) write(iulog,"('edynamo debug: after solve_edyn (master only)')") +! +! rim1 after solver is needed for highlat_poten. rim_glb is distributed +! to subdomains as rim1, and mag halos set. This will overwrite rim1 from +! fieldline_integrals, complete_integrals, etc. +! + call mp_scatter_phim(rim_glb(:,:,1),rim1(mlon0:mlon1,mlat0:mlat1)) + if (debug) write(iulog,"('edynamo debug: after mp_scatter_phim')") + + call mp_mag_halos(rim1,mlon0,mlon1,mlat0,mlat1,1) + if (debug) write(iulog,"('edynamo debug: after mp_mag_halos')") +! +! Add high latitude potential from empirical model (heelis or weimer) +! to solution rim1, defining phim2d on mag subdomains. +! + call highlat_poten + if (debug) write(iulog,"('edynamo debug: after highlat_poten')") +! +! Expand phim2d to phim3d, first setting mag halos in phim2d from +! hightlat_poten. phim3d will then be the final potential from pdynamo. +! + call mp_mag_halos(phim2d,mlon0,mlon1,mlat0,mlat1,1) + + call pthreed + if (debug) write(iulog,"('edynamo debug: after pthreed')") +! +! Convert electric field to geographic grid: + call pefield + if (debug) write(iulog,"('edynamo debug: after pefield')") + +! +! Calculate ion drift velocities: +! + + call ionvel(zpot,ui,vi,wi) + if (debug) write(iulog,"('edynamo debug: after ionvel')") +#else + call endrun('ERROR: To use edymamo must build with cppdef WACCMX_EDYN_ESMF') +#endif + end subroutine dynamo +!----------------------------------------------------------------------- +#ifdef WACCMX_EDYN_ESMF + subroutine dynamo_input(tn,un,vn,wn,zpot,ped,hall,& + lev0,lev1,lon0,lon1,lat0,lat1) +! +! Input fields are in "TIEGCM format" and CGS units. +! Provide needed inputs to the dynamo by regridding the fields +! from geographic to magnetic. +! + use edyn_params ,only: h0,dtr,kbotdyn,cm2km + use getapex ,only: & ! (nlonp1,0:nlatp1) + zb, & ! downward component of magnetic field + bmod ! magnitude of magnetic field (gauss?) + use edyn_geogrid,only: nlon,nlev + + use edyn_mpi,only: & +! mp_periodic_f2d, & ! set 2d periodic points +! mp_periodic_f3d, & ! set 3d periodic points + mp_mageq ! get global values at mag equator + + use edyn_esmf,only: & ! use-associate grid definitions and subroutines + geo_src_grid, & ! geographic source grid (ESMF_Grid type) + mag_des_grid, & ! magnetic destination grid (ESMF_Grid type) + edyn_esmf_regrid, & ! subroutine that calls ESMF to regrid a field + edyn_esmf_set2d_geo, & ! set values of a 2d ESMF field on geographic grid + edyn_esmf_set3d_geo, & ! set values of a 3d ESMF field on geographic grid + edyn_esmf_get_3dfield, & ! retrieve values of a 3d ESMF field + edyn_esmf_get_2dfield ! retrieve values of a 2d ESMF field + + use edyn_esmf,only: & ! 3d ESMF fields on geographic grid + geo_ped, & ! pedersen conductivity + geo_hal, & ! hall conductivity + geo_zpot, & ! geopotential height + geo_scht, & ! scale height + geo_adotv1, & ! ue1 (m/s) + geo_adotv2 ! ue2 (m/s) + + use edyn_esmf,only: & ! 2d ESMF fields on geographic grid + geo_sini, & ! sin(I_m) + geo_adota1, & ! d(1)**2/D + geo_adota2, & ! d(2)**2/D + geo_a1dta2, & ! (d(1) dot d(2)) /D + geo_be3 ! mag field strength (T) + + use edyn_esmf,only: & ! 3d ESMF fields on geomagnetic grid + mag_ped, & ! pedersen conductivity + mag_hal, & ! hall conductivity + mag_zpot, & ! geopotential height + mag_scht, & ! scale height + mag_adotv1, & ! ue1 (m/s) + mag_adotv2 ! ue2 (m/s) + + use edyn_esmf,only: & ! 3d fields on geographic grid (bundled?) + nf_3dgeo, & ! number of 3d geo fields + f_3dgeo ! array of nf_3dgeo pointers to 3d geo fields + + use edyn_esmf,only: & ! 2d ESMF fields on geomagnetic grid + mag_sini, & ! sin(I_m) + mag_adota1, & ! d(1)**2/D + mag_adota2, & ! d(2)**2/D + mag_a1dta2, & ! (d(1) dot d(2)) /D + mag_be3 ! mag field strength (T) + + use edyn_esmf,only: edyn_esmf_update_step ! indicates ESMF updated the current time step with updated geo-mag coordinates + +! +! Args: Input fields on geographic grid: +! + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & + tn, & ! neutral temperature (deg K) + un, & ! neutral zonal velocity (cm/s) + vn, & ! neutral meridional velocity (cm/s) + wn ! neutral vertical velocity (cm/s) + + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(inout) :: & + zpot, & ! geopotential height (cm) + ped, & ! pedersen conductivity (S/m) + hall ! hall conductivity (S/m) +! +! Local: +! + integer :: j,i,k,rc + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + scheight, & ! scale height (no longer necessary since wn calculated outside) + adotv1, & ! ue1 (m/s) + adotv2 ! ue2 (m/s) + real(r8),dimension(lon0:lon1,lat0:lat1) :: & + sini, & ! sin(I_m) + adota1, & ! d(1)**2/D + adota2, & ! d(2)**2/D + a1dta2, & ! (d(1) dot d(2)) /D + be3 ! mag field strength (T) + +! real(r8),dimension(lon0:lon1,lat0:lat1) :: & ! temp for debug +! zb_diag,bmod_diag + + real(r8) :: f2d(lon0:lon1,lat0:lat1,4) +! +! See nf_3dgeo above: + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1,nf_3dgeo) :: f3d + character(len=8) :: fnames(nf_3dgeo) +! +! For wc timing: +! real(r8) :: starttime,endtime + + scheight = 0._r8 + +! starttime = mpi_wtime() + + if (debug) write(iulog,"('Enter dynamo_input')") +! +! Save 3d input fields on geo grid to WACCM history: + call savefld_waccm_switch(tn ,'EDYN_TN' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(un ,'EDYN_UN' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(vn ,'EDYN_VN' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(wn ,'EDYN_WN' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(zpot ,'EDYN_Z' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(ped ,'EDYN_PED' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(hall ,'EDYN_HALL',nlev,lon0,lon1,lat0,lat1) + +! + if (debug) write(iulog,"('dynamo_input after savefld_waccm calls')") + if (debug) write(iulog,"('dynamo_input: kbotdyn=',i4)") kbotdyn +! +! Calculate some 2d and 3d fields: + call calc_adotv(zpot,un,vn,wn,adotv1,adotv2,adota1,adota2, & + a1dta2,be3,lev0,lev1,lon0,lon1,lat0,lat1) + if (debug) write(iulog,"('dynamo_input after calc_adotv')") + + call savefld_waccm_switch(adotv1 ,'EDYN_ADOTV1',nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(adotv2 ,'EDYN_ADOTV2',nlev,lon0,lon1,lat0,lat1) +! +! Calculate sini sin(I_m) (zb and bmod are from apex) +! + do j=lat0,lat1 + do i=lon0,lon1 + sini(i,j) = zb(i,j)/bmod(i,j) ! sin(I_m) + enddo + enddo +! +! Set 3d field values on geographic source grid, including +! separate calculations at the poles. This is consolidated +! into a single call, so mp_geopole_3d can be called by +! esmf_set3d_geo once for all fields. +! + fnames = (/'PED ','HAL ','ZPOT ','SCHT ',& + 'ADOTV1 ','ADOTV2 '/) + + f3d(:,:,:,1) = ped + f3d(:,:,:,2) = hall + f3d(:,:,:,3) = zpot + f3d(:,:,:,4) = scheight + f3d(:,:,:,5) = adotv1 + f3d(:,:,:,6) = adotv2 + + f_3dgeo(1) = geo_ped + f_3dgeo(2) = geo_hal + f_3dgeo(3) = geo_zpot + f_3dgeo(4) = geo_scht + f_3dgeo(5) = geo_adotv1 + f_3dgeo(6) = geo_adotv2 + + call edyn_esmf_set3d_geo(f_3dgeo,fnames,f3d,nf_3dgeo, & + lev0,lev1,lon0,lon1,lat0,lat1) + + geo_ped = f_3dgeo(1) + geo_hal = f_3dgeo(2) + geo_zpot = f_3dgeo(3) + geo_scht = f_3dgeo(4) + geo_adotv1 = f_3dgeo(5) + geo_adotv2 = f_3dgeo(6) + + ped = f3d(:,:,:,1) + hall = f3d(:,:,:,2) + zpot = f3d(:,:,:,3) + scheight= f3d(:,:,:,4) + adotv1 = f3d(:,:,:,5) + adotv2 = f3d(:,:,:,6) + + if (debug) write(iulog,"('dynamo_input after edyn_esmf_set3d_geo')") +! +! 2d fields need only be calculated in first timestep: + if (edyn_esmf_update_step) then +! +! Set 2d field values on geographic grid: +! (esmf fields on source grid exclude periodic points) +! + call edyn_esmf_set2d_geo(geo_sini, geo_src_grid,'SINI ',& + sini, lon0,lon1,lat0,lat1) + call edyn_esmf_set2d_geo(geo_adota1,geo_src_grid,'ADOTA1 ',& + adota1,lon0,lon1,lat0,lat1) + call edyn_esmf_set2d_geo(geo_adota2,geo_src_grid,'ADOTA2 ',& + adota2,lon0,lon1,lat0,lat1) + call edyn_esmf_set2d_geo(geo_a1dta2,geo_src_grid,'A1DTA2 ',& + a1dta2,lon0,lon1,lat0,lat1) + call edyn_esmf_set2d_geo(geo_be3, geo_src_grid,'BE3 ',& + be3, lon0,lon1,lat0,lat1) + if (debug) write(iulog,"('dynamo_input after edyn_esmf_set2d_geo')") + endif + +! +! Regrid 3d geo fields to mag grid: + call edyn_esmf_regrid(geo_ped ,mag_ped, 'geo2mag',3) + call edyn_esmf_regrid(geo_hal ,mag_hal, 'geo2mag',3) + call edyn_esmf_regrid(geo_zpot ,mag_zpot, 'geo2mag',3) + call edyn_esmf_regrid(geo_scht ,mag_scht, 'geo2mag',3) + call edyn_esmf_regrid(geo_adotv1 ,mag_adotv1, 'geo2mag',3) + call edyn_esmf_regrid(geo_adotv2 ,mag_adotv2, 'geo2mag',3) + if (debug) write(iulog,"('dynamo_input after edyn_esmf_regrid')") +! +! Regrid time-independent 2d geo fields to mag grid: + if (edyn_esmf_update_step) then + call edyn_esmf_regrid(geo_sini ,mag_sini , 'geo2mag',2) + call edyn_esmf_regrid(geo_adota1 ,mag_adota1, 'geo2mag',2) + call edyn_esmf_regrid(geo_adota2 ,mag_adota2, 'geo2mag',2) + call edyn_esmf_regrid(geo_a1dta2 ,mag_a1dta2, 'geo2mag',2) + call edyn_esmf_regrid(geo_be3 ,mag_be3 , 'geo2mag',2) + endif +! +! Define edynamo module data pointers to the regridded mag fields. +! First arg of esmf_get_field is input esmf field (my_esmf module), +! second arg is output data pointer (edynamo module) +! (These destination grid fields have periodic points allocated and set) +! +! Get regridded 3d mag fields: +! + call edyn_esmf_get_3dfield(mag_ped ,ped_mag, "PED ") + call edyn_esmf_get_3dfield(mag_hal ,hal_mag, "HAL ") + call edyn_esmf_get_3dfield(mag_zpot ,zpot_mag, "ZPOT ") + call edyn_esmf_get_3dfield(mag_scht ,scht_mag, "SCHT ") + call edyn_esmf_get_3dfield(mag_adotv1,adotv1_mag,"ADOTV1 ") + call edyn_esmf_get_3dfield(mag_adotv2,adotv2_mag,"ADOTV2 ") +! +! Get regridded 2d mag fields (time-independent): +! First arg is input ESMF field, second is output pointer: +! + if (edyn_esmf_update_step) then + call edyn_esmf_get_2dfield(mag_sini ,sini_mag , "SINI ") + call edyn_esmf_get_2dfield(mag_adota1,adota1_mag, "ADOTA1 ") + call edyn_esmf_get_2dfield(mag_adota2,adota2_mag, "ADOTA2 ") + call edyn_esmf_get_2dfield(mag_a1dta2,a1dta2_mag, "A1A2M ") + call edyn_esmf_get_2dfield(mag_be3 ,be3_mag , "BE3 ") + endif +! +! fmeq_in are input fields on 3d mag subdomains. +! allocate(fmeq_in(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1,4) +! + fmeq_in(:,:,:,1) = ped_mag(:,:,:) + fmeq_in(:,:,:,2) = hal_mag(:,:,:) + fmeq_in(:,:,:,3) = adotv1_mag(:,:,:) + fmeq_in(:,:,:,4) = adotv2_mag(:,:,:) +! +! Tasks w/ mag equator send eq data(i,k) to other tasks in their tidi: +! + call mp_mageq(fmeq_in,fmeq_out,4,mlon0,mlon1,mlat0,mlat1,nmlev) +! +! Output arrays now have mag equator data on longitude subdomain +! and full column (mlon0:mlon1,nmlev) +! These will be used in fieldline_integrals. +! + ped_meq(:,:) = fmeq_out(:,:,1) + hal_meq(:,:) = fmeq_out(:,:,2) + adotv1_meq(:,:) = fmeq_out(:,:,3) + adotv2_meq(:,:) = fmeq_out(:,:,4) +! +! Save geopotential on magnetic grid in zpotm3d, then +! limit max zpot_mag to h0 for use in fieldline integrals +! and pthreed. This should set zpot_mag to constant h0 +! below kbotdyn. It is not necessary to set poles of zpotm3d +! since sub pthreed does not reference the poles of zpotm3d. +! + do k=mlev0,mlev1 + do j=mlat0,mlat1 + do i=mlon0,mlon1 + zpotm3d(i,j,k) = zpot_mag(i,j,k) + if (zpot_mag(i,j,k) < h0) zpot_mag(i,j,k)=h0 + enddo + enddo + enddo +! +! Set 3d mag fields to zero below kbotdyn: +! +! ped_mag(:,:,1:kbotdyn-1) = finit +! hal_mag(:,:,1:kbotdyn-1) = finit +! adotv1_mag(:,:,1:kbotdyn-1) = finit +! adotv2_mag(:,:,1:kbotdyn-1) = finit + +! call savefld_waccm_switch(adota1_mag(mlon0:mlon1,mlat0:mlat1) ,'ADOTA1_MAG' ,1,mlon0,mlon1,mlat0,mlat1) + + do j=mlat0,mlat1 + call outfld('PED_MAG',ped_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('HAL_MAG',hal_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ZPOT_MAG',zpot_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ADOTV1_MAG',adotv1_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ADOTV2_MAG',adotv2_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + enddo +! +! Save 3d input fields on geo grid to waccm files (switch to "waccm format"): +! call savefld_waccm_switch(tn ,'EDYN_TN' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(un ,'EDYN_UN' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(vn ,'EDYN_VN' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(wn ,'EDYN_WN' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(zpot ,'EDYN_Z' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(ped ,'EDYN_PED' ,nlev,lon0,lon1,lat0,lat1) +! call savefld_waccm_switch(hall ,'EDYN_HALL',nlev,lon0,lon1,lat0,lat1) + +! call savefld_waccm_switch(scheight,'EDYN_SCHT' ,nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(adotv1 ,'EDYN_ADOTV1',nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(adotv2 ,'EDYN_ADOTV2',nlev,lon0,lon1,lat0,lat1) +! +! Save 2d geo fields (lon0:lon1,lat0:lat1): + call savefld_waccm_switch(sini ,'EDYN_SINI' ,1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(adota1,'EDYN_ADOTA1',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(adota2,'EDYN_ADOTA2',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(a1dta2,'EDYN_A1DTA2',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(be3 ,'EDYN_BE3' ,1,lon0,lon1,lat0,lat1) + +! endtime = mpi_wtime() +! time_dynamo_input=time_dynamo_input+(endtime-starttime) + end subroutine dynamo_input +!----------------------------------------------------------------------- + subroutine calc_adotv(z,un,vn,wn,adotv1,adotv2,adota1,adota2,& + a1dta2,be3,lev0,lev1,lon0,lon1,lat0,lat1) +! +! Calculate adotv1,2, adota1,2, a1dta2 and be3. +! + use edyn_params ,only: r0,h0 + use edyn_geogrid,only: nlon,jspole,jnpole + use getapex, only: & + dvec, & ! (nlonp1,nlat,3,2) + dddarr, & ! (nlonp1,nlat) + be3arr, & ! (nlonp1,nlat) + alatm ! (nlonp1,0:nlatp1) +! +! Args: + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & + z, & ! geopotential height (cm) + un, & ! neutral zonal velocity (cm/s) + vn ! neutral meridional velocity (cm/s) + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & + wn ! vertical velocity (cm/s) + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(out) :: & + adotv1, adotv2 + real(r8),dimension(lon0:lon1,lat0:lat1),intent(out) :: & + adota1, adota2, a1dta2, be3 +! +! Local: + integer :: k,i,j + real(r8) :: r0or,rat,sinalat + real(r8) :: clm2(lon0:lon1,lat0:lat1) +! + adotv1 = finit + adotv2 = finit + adota1 = finit + adota2 = finit + a1dta2 = finit + be3 = finit + + do j=lat0,lat1 + if (j==jspole.or.j==jnpole) cycle + do i=lon0,lon1 + sinalat = sin(alatm(i,j)) ! sin(lam) + clm2(i,j) = 1._r8-sinalat*sinalat ! cos^2(lam) + be3(i,j) = 1.e-9_r8*be3arr(i,j) ! be3 is in T (be3arr in nT) + + do k=lev0,lev1-1 +! +! d_1 = (R_0/R)^1.5 + r0or = r0/(r0 + 0.5_r8*(z(k,i,j)+z(k+1,i,j))-h0) + rat = 1.e-2_r8*r0or**1.5_r8 ! 1/100 conversion in cm +! +! A_1 dot V = fac( d_1(1) u + d_1(2) v + d_1(3) w + adotv1(k,i,j) = rat*( & + dvec(i,j,1,1)*un(k,i,j)+ & + dvec(i,j,2,1)*vn(k,i,j)+ & + dvec(i,j,3,1)*wn(k,i,j)) + +! +! Note: clm2 is being used here to represent the squared cosine of the +! quasi-dipole latitude, not of the M(90) latitude, since the wind +! values are aligned vertically, not along the field line. +! + rat = rat*sqrt((4._r8-3._r8*clm2(i,j))/(4._r8-3._r8*r0or*clm2(i,j))) +! +! A_2 dot V = fac( d_2(1) u + d_2(2) v + d_2(3) w + adotv2(k,i,j) = rat*( & + dvec(i,j,1,2)*un(k,i,j)+ & + dvec(i,j,2,2)*vn(k,i,j)+ & + dvec(i,j,3,2)*wn(k,i,j)) + enddo ! k=lev0,lev1-1 +! +! Calculation of adota(n) = d(n)**2/D +! a1dta2 = (d(1) dot d(2)) /D +! + adota1(i,j) = (dvec(i,j,1,1)**2 + dvec(i,j,2,1)**2 + & + dvec(i,j,3,1)**2)/dddarr(i,j) + adota2(i,j) = (dvec(i,j,1,2)**2 + dvec(i,j,2,2)**2 + & + dvec(i,j,3,2)**2)/dddarr(i,j) + a1dta2(i,j) = (dvec(i,j,1,1)*dvec(i,j,1,2) + & + dvec(i,j,2,1)*dvec(i,j,2,2) + & + dvec(i,j,3,1)*dvec(i,j,3,2))/dddarr(i,j) + enddo ! i=lon0,lon1 + + enddo ! j=lat0,lat1 + + call savefld_waccm_switch(adota1 ,'ADOTA1' ,1,lon0,lon1,lat0,lat1) + + end subroutine calc_adotv +!----------------------------------------------------------------------- + subroutine alloc_edyn + use edyn_geogrid,only: nlev +! +! Allocate and initialize arrays for parallel dynamo (module data) +! (called once per run) +! + integer :: istat,n + integer :: mlon00,mlon11,mlat00,mlat11 +! + mlon00=mlon0-1 ; mlon11=mlon1+1 + mlat00=mlat0-1 ; mlat11=mlat1+1 +! +! 2d fields on mag subdomains (i,j): +! Certain fields are allocated with halos mlon0-1:mlon1+1,mlat0-1:mlat1+1 +! + allocate(zigm11(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zigm11') + zigm11 = finit + allocate(zigmc(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zigmc') + zigmc = finit + allocate(zigm2(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zigm2') + zigm2 = finit + allocate(zigm22(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zigm22') + zigm22 = finit + allocate(rhs(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: rhs') + rhs = finit + allocate(rim1(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: rim1') + rim1 = finit + allocate(rim2(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: rim2') + rim2 = finit + allocate(phimsolv(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: phimsolv') + phimsolv = finit + allocate(phim2d(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: phim2d') + phim2d = finit +! +! 3d phim and electric field on mag subdomains: + allocate(phim3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: phim3d') + phim3d = finit + allocate(ed13d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ed13d') + ed13d = finit + allocate(ed23d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ed23d') + ed23d = finit + allocate(ephi3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ephi3d') + ephi3d = finit + allocate(elam3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: elam3d') + elam3d = finit + allocate(emz3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: emz3d') + emz3d = finit + allocate(zpotm3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zpotm3d') + zpotm3d = finit +! +! Fields at mag equator (subdomain longitudes and full column): +! + allocate(ped_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ped_meq') + ped_meq = finit + allocate(hal_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: hal_meq') + hal_meq = finit + allocate(adotv1_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: adotv1_meq') + adotv1_meq = finit + allocate(adotv2_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: adotv2_meq') + adotv2_meq = finit + allocate(zpot_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zpot_meq') + zpot_meq = finit +! +! Fields input to mp_mageq (4 fields at full mag subdomain i,j,k): +! + allocate(fmeq_in(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1,4),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: fmeq_in') + fmeq_in = finit +! +! Fields output by mp_mageq (4 fields at mag subdomain i,k) +! + allocate(fmeq_out(mlon0:mlon1,mlev0:mlev1,4),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: fmeq_out') + fmeq_out = finit +! +! 3d electric field on geographic subdomains, with halos: +! + allocate(ex(nlev,lon0:lon1,lat0:lat1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ex') + allocate(ey(nlev,lon0:lon1,lat0:lat1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ey') + allocate(ez(nlev,lon0:lon1,lat0:lat1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ez') + ex=finit ; ey=finit ; ez=finit +! +! 3d electric potential on geographic subdomains (k,i,j): + allocate(poten(nlev,lon0:lon1,lat0:lat1),stat=istat) + if (istat /= 0) call endrun('alloc_pdyn: poten') + poten = finit +! +! 3d electric potential on geographic subdomains ((i,j,k) regridded from phim3d): + allocate(phig3d(lon0:lon1,lat0:lat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_pdyn: phig3d') + phig3d = finit +! +! 2d electric field components on mag grid (these may be input to time3d): +! real(r8),dimension(:,:) :: ed1,ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) +! + allocate(ed1(mlon0-1:mlon1+1,mlat0-1:mlat1+1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ed1') + ed1 = finit + + allocate(ed2(mlon0-1:mlon1+1,mlat0-1:mlat1+1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: ed2') + ed2 = finit + + end subroutine alloc_edyn +!----------------------------------------------------------------------- + subroutine fieldline_integrals +! +! Integrate along magnetic field lines, saving conductances and rims. +! + use edyn_params, only: r0,h0,finit,kbotdyn + use edyn_maggrid, only: ylatm +! +! Local: + integer :: ier,i,j,k + real(r8) :: & + sinlm, & ! sin(lam_m) + clm2, & ! cos^2(lam_m) + absinim, & ! | sin I_m | + ra, & ! (R_E + H_0)/cos^2(lam_m) + sqomrra, & ! sqrt(1/ R_0/R_A) = sin(lam_m) + sqrra, & ! sqrt(R_0/R_A) + afac, & ! 2*sqrt(R_A-R_0) (afac is NaN at mag poles) + htfac ! sqrt(R_A -3/4*R_0) + + real(r8) :: rora,del,omdel,sig1,sig2,ue1,ue2,jgr,jmp,fac,je1pg,je2pg + real(r8),dimension(mlon0:mlon1) :: sindm, cosdm, ram, aam, cosiam, & + csthdam, rtadram + real(r8),dimension(mlon0:mlon1,mlev0:mlev1) :: rrm, sinidm, cosidm, & + costhdm, rtramrm, htfunc, htfunc2 +! +! Initialize coefficients: +! + zigm11 = finit + zigm22 = finit + zigm2 = finit + zigmc = finit + rim1 = finit + rim2 = finit +! +! Subdomain latitude scan for field line integrations: +! + do j=mlat0,mlat1 +! +! Skip poles and equator: + if (j==1.or.j==nmlat.or.j==nmlath) cycle + + sinlm = sin(ylatm(j)) + clm2 = 1._r8 - sinlm*sinlm + absinim = abs(sinlm)/sqrt(1._r8-0.75_r8*clm2) + ra = r0/clm2 + sqomrra = sqrt(1._r8-r0/ra) + sqrra = sqrt(r0/ra) + afac = 2._r8*sqrt(ra-r0) + htfac = sqrt(ra-0.75_r8*r0) + do i=mlon0,mlon1 + aam(i) = afac/abs(sini_mag(i,j)) + enddo +! +! 2*sqrt( h_A - h_0 )/ |sin I_m | w.r to reference height A(h_R) + do k=kbotdyn,mlev1 + do i=mlon0,mlon1 +! +! rr = r0+z-z0 radius of magnetic point +! (Note zpot_mag min was set to h0 in dynamo_inputs) + rrm(i,k) = r0+zpot_mag(i,j,k)-h0 +! +! rtramr = ra-r if +ive, zero otherwise + rtramrm(i,k) = max(0._r8,ra-rrm(i,k)) + rtramrm(i,k) = sqrt(rtramrm(i,k)) + enddo ! i=mlon0,mlon1 + enddo ! k=kbotdyn,mlev1 +! +! Interpolate to midpoints: +! htfunc = factor by which to multiply AAM(I)*d(sqrt(ra-r)) = ds + do k=kbotdyn,mlev1-1 + do i=mlon0,mlon1 + rrm(i,k) = 0.5_r8*(rrm(i,k)+rrm(i,k+1)) + rtramrm(i,k) = rtramrm(i,k)-rtramrm(i,k+1) + htfunc(i,k) = sqrt(ra-0.75_r8*rrm(i,k))/htfac + htfunc2(i,k) = htfunc(i,k)**2 + enddo ! i=mlon0,mlon1 + enddo ! k=kbotdyn,mlev1 +! +! Compute integrals: + do k=kbotdyn,mlev1-1 + do i=mlon0,mlon1 +! +! (R_E+h)/(R_E+h_A) < 1 -> h_A > h + rora = min(1._r8,rrm(i,k)/ra) +! +! (lam_m - lam) / lam_m = +! sqrt(1-r_0/r_A)sqrt(r/r_A) - sqrt(r_0/r_A)sqrt(1-r/r_A) + del = (sqomrra*sqrt(rora)-sqrra*sqrt(1._r8-rora))/abs(ylatm(j)) + omdel = 1._r8 - del +! +! Interpolate conductivities and winds in latitude along field line, assuming +! linear variation between foot of field line and magnetic equator. +! (For field lines other than those near the magnetic equator, del is nearly +! zero, so that the interpolated values are essentially the values for the +! latitude of the foot of the field line; inaccuracy of the assumption of +! linear variation is thus unimportant for these field lines.) +! +! Here, mag equator ped_meq, etc. are from mp_mageq, called from dynamo inputs: + sig1 = omdel*ped_mag(i,j,k) + del*ped_meq(i,k) + sig2 = omdel*hal_mag(i,j,k) + del*hal_meq(i,k) + ue1 = omdel*adotv1_mag(i,j,k) + del*adotv1_meq(i,k) + ue2 = omdel*adotv2_mag(i,j,k) + del*adotv2_meq(i,k) +! +! height varying factors: ds = aam*htfunc +! d_1^2/D = 1/htfunc * adota1_mag(i,j) +! d_2^2/D = htfunc * adota2_mag(i,j) +! d_1*d_2/D = 1 * a1dta2_mag(i,j) +! +! zigm11: int (sigma_p*d_1^2/D) ds : d_1^2/D +! zigm22: int (sigma_p*d_2^2/D) ds : d_2^2/D +! + zigm11(i,j) = zigm11(i,j) + sig1*rtramrm(i,k) + zigm22(i,j) = zigm22(i,j) + sig1*rtramrm(i,k)*htfunc2(i,k) +! +! zigmc: int (sigma_p*d_1*d_2/D) ds +! zigm2: int (sigma_h) ds +! + zigmc(i,j) = zigmc(i,j) + sig1*rtramrm(i,k)*htfunc(i,k) + zigm2(i,j) = zigm2(i,j) + sig2*rtramrm(i,k)*htfunc(i,k) +! +! rim1: int [sigma_p*d_1^2/D u_e2+(sigma_h-(sigma_p*d_1*d_2)/D) u_e1] ds +! rim2: int [(sigma_h+sigma_p*d_1*d_2/D) u_e2-sigma_p*d_2^2/D u_e1 ] ds +! + rim1(i,j) = rim1(i,j) + (sig1*adota1_mag(i,j)*ue2 + & + (sig2 - sig1*a1dta2_mag(i,j))*htfunc(i,k)*ue1)*rtramrm(i,k) + rim2(i,j) = rim2(i,j) + (sig1*adota2_mag(i,j)*htfunc2(i,k)* & + ue1 - (sig2 + sig1*a1dta2_mag(i,j))*htfunc(i,k)*ue2)*rtramrm(i,k) + enddo ! i=mlon0,mlon1 + enddo ! k=kbotdyn,mlev1 +! +! Complete calculation and place result in /coefm/ zigm's +! rim's are in A/m multiply by 1/100 to convert from [cm] to [m] +! +! At this point, +! zigm11 is int[sig_p*d_1^2/D] ds, i.e. Sigma_(phi phi)/abs(sin Im) +! zigm22 is int[sig_p*d_2^2/D] ds, i.e. Sigma_(lam lam)*abs(sin Im) +! zigmc is int[sig_p*d_1*d_2/D] ds, i.e. Sigma_c +! zigm2 is int[sigma_h] ds, i.e. Sigma_h +! +! rim1 is int[(sigma_h-sigma_p*d_1*d_2/D)u_e1 + sigma_p*d_1^2/D u_e2] *A(h_r)* +! B_e3 ds, i.e. K_(m phi)^D/abs(sin Im) +! rim2 is int[(sigma_h+sigma_p*d_1*d_2/D)u_e2 - sigma_p*d_2^2/D u_e1] *A(h_r)* +! B_e3 ds, K_(m lam)^D ( minus in northern hemisphere +! Change sign of RIM(2) in S. hemisphere to be compatible with transf +! At this point, rim2 is +-K_(m lam)^D +! + do i = mlon0,mlon1 + zigm11(i,j) = 1.e-2_r8*zigm11(i,j)*aam(i)*adota1_mag(i,j) + zigm22(i,j) = 1.e-2_r8*zigm22(i,j)*aam(i)*adota2_mag(i,j) + zigmc(i,j) = 1.e-2_r8*zigmc (i,j)*aam(i)*a1dta2_mag(i,j) + zigm2(i,j) = 1.e-2_r8*zigm2 (i,j)*aam(i) + rim1(i,j) = 1.e-2_r8*rim1(i,j)*aam(i)*be3_mag(i,j) + rim2(i,j) = 1.e-2_r8*rim2(i,j)*aam(i)*be3_mag(i,j) + enddo ! i = 1,nmlon + enddo ! j=mlat0,mlat1 (without poles) + +! call savefld_waccm_switch(adota1_mag(mlon0:mlon1,mlat0:mlat1) ,'adota1_mag_a' ,1,mlon0,mlon1,mlat0,mlat1) + +! call savefld_waccm_switch(zigm11(mlon0:mlon1,mlat0:mlat1) ,'ZIGM11_a' ,1,mlon0,mlon1,mlat0,mlat1) + + end subroutine fieldline_integrals +!----------------------------------------------------------------------- + subroutine complete_integrals + use edyn_mpi,only: mlat0,mlat1,mlon0,mlon1,mp_mageq_jpm1,mp_magpole_2d,& + mp_mag_foldhem,mp_mag_periodic_f2d + use edyn_maggrid,only: rcos0s,dt1dts +! +! Field line integrals for each hemisphere have been calculated in +! mag subdomains. Now, complete these arrays with equator and polar +! values, and sum the integrals from the 2 hemispheres. +! This is done by obtaining global mag fields via mpi exchange +! of mag subdomains, completing the global fields, and updating +! the subdomains. +! The 6 2d fields are: zigm11,zigm22,zigmc,zigm2,rim1,rim2 +! +! Local: + integer :: i,j,ii,lonend + real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf2d) + real(r8) :: corfac + real(r8),parameter :: r8_nmlon = dble(nmlon) +! +! If do_integ==.false. (meaning use_time3d_integ=.true.), then these were passed in +! from time3d (in this case, dynamo did not call fieldline_integrals). Otherwise, +! they were calculated by this module, in sub fieldline_integrals and this routine. +! + +! +! For equatorial values, we need latitudes eq+1 and eq-1: +! Local feq_jpm1(nmlonp1,2,6) is returned by mp_mageq_jpm1, +! where the 2 dim contains lats nmlath-1, nmlath+1. These +! are global in lon, even tho each subd uses only its own i's. +! These mag equator values do not show up on plots because +! of the small factor .06 and .125. +! The 6 2d fields are: zigm11,zigm22,zigmc,zigm2,rim1,rim2 +! Must specify mlon0:mlon1,mlat0:mlat1 because these fields +! were allocated to include single-point halos (these calls +! exclude the halo points): +! + fmsub(:,:,1) = zigm11(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,2) = zigm22(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,3) = zigmc (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) + + call mp_mageq_jpm1(fmsub,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm1,nf2d) +! +! From sub fieldline_integrals: +! zigm11 is int[sig_p*d_1^2/D] ds, i.e. Sigma_(phi phi)/abs(sin Im) +! zigm22 is int[sig_p*d_2^2/D] ds, i.e. Sigma_(lam lam)*abs(sin Im) +! zigmc is int[sig_p*d_1*d_2/D] ds, i.e. Sigma_c +! zigm2 is int[sigma_h] ds, i.e. Sigma_h +! +! rim1 is int[(sigma_h-sigma_p*d_1*d_2/D)u_e1 + sigma_p*d_1^2/D u_e2] *A(h_r)* +! B_e3 ds, i.e. K_(m phi)^D/abs(sin Im) +! rim2 is int[(sigma_h+sigma_p*d_1*d_2/D)u_e2 - sigma_p*d_2^2/D u_e1] *A(h_r)* +! B_e3 ds, K_(m lam)^D ( minus in northern hemisphere +! Change sign of RIM(2) in S. hemisphere to be compatible with transf +! At this point, rim2 is +-K_(m lam)^D +! +! Equatorial values: +! Assume that quantities primarily dependent on Pedersen conductivity +! have field-line integrals 1/4 as large as the averages for next-higher +! field lines; quantities primarily dependent on Hall conductivity +! have field-line integrals 0.12 as large as the averages for next-higher +! field lines. Exact values chosen should not be important for potential +! calculation, as long as they are physically reasonable and not too +! different from adjacent values. +! + do j=mlat0,mlat1 + if (j==nmlath) then ! mag equator + + zigm11(mlon0:mlon1,j) = .125_r8*(feq_jpm1(mlon0:mlon1,1,1)+ & + feq_jpm1(mlon0:mlon1,2,1)) + zigm22(mlon0:mlon1,j) = .125_r8*(feq_jpm1(mlon0:mlon1,1,2)+ & + feq_jpm1(mlon0:mlon1,2,2)) + zigmc (mlon0:mlon1,j) = .125_r8*(feq_jpm1(mlon0:mlon1,1,3)+ & + feq_jpm1(mlon0:mlon1,2,3)) + zigm2 (mlon0:mlon1,j) = .060_r8*(feq_jpm1(mlon0:mlon1,1,4)+ & + feq_jpm1(mlon0:mlon1,2,4)) + rim1 (mlon0:mlon1,j) = .060_r8*(feq_jpm1(mlon0:mlon1,1,5)+ & + feq_jpm1(mlon0:mlon1,2,5)) + rim2 (mlon0:mlon1,j) = .060_r8*(feq_jpm1(mlon0:mlon1,1,6)+ & + feq_jpm1(mlon0:mlon1,2,6)) +! +! Include the boundary condition at the equator eq.(5.30) in +! Richmond (1995) Ionospheric Electrodynamics use. Mag. Apex Coord. +! J.Geomag.Geoelectr. 47,191-212 +! Sig_phiphi/abs(sin Im) = 0.5*Sig_cowling/abs(sin Im) +! = 0.5/abs(sin Im)*(Sig_phiphi - Sig_philam*sig_lamphi/Sig_lamlam) +! = 0.5/abs(sin Im)*(Sig_phiphi + (Sig_h-sig_c)*(Sig_h+sig_c)/Sig_lamlam) +! rim(1) / |sin I_m| = I_1 = R/2*(K_mphi - Sig_philam/Sig_lamlam*K_mlam) +! + do i=mlon0,mlon1 + zigm11(i,j) = zigm11(i,j)+(zigm2(i,j)-zigmc(i,j))* & + (zigm2(i,j)+zigmc(i,j))/zigm22(i,j) + rim1(i,j) = rim1(i,j) - (zigm2(i,j)-zigmc(i,j))/ & + zigm22(i,j)*rim2(i,j) + enddo ! i=mlon0,mlon1 + endif ! j at equator + enddo ! j=mlat0,mlat1 +! + do j=mlat0,mlat1 + call outfld('EDYN_ZIGM11_PED',zigm11(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('EDYN_ZIGM2_HAL',zigm2(mlon0:omlon1,j),omlon1-mlon0+1,j) + enddo + +! +! Using notation of Richmond (1995) on right-hand side below: +! Sigma_(phi phi) = zigm11*abs(sin I_m) +! Sigma_(lam lam) = zigm22/abs(sin I_m) +! Sigma_(phi lam) = +-(zigm2-zigmc) +! Sigma_(lam phi) = -+(zigm2+zigmc) +! K_(m phi)^D = rim(1)*abs(sin I_m) +! K_(m lam)^D = +-rim(2) +! +! Transforming PDE from original apex (theta_a) to new apex grid (theta_0) +! which is equally spaced in magnetic latitude +! SCALE quantities to modified (0) magnetic latitude system, multiplying or +! dividing by abs(sin I_m) [inverse contained in DT1DTS] as necessary. +! Sign of K_(m lam)^D in southern hemisphere remains reversed. +! for the mixed terms the transformation from the integration and differentiation +! canceled out (zigmc, zigm2) +! DT1DTS : d theta_0/ d theta_a / abs(sin I_m) +! RCOS0S : cos(theta_0)/ cos(theta_a) +! +! corfac: abs(I_m)*d theta_a/d theta_0 * cos(theta_0)/ cos(theta_a) +! zigm11: abs(I_m)*d theta_a/d theta_0 * cos(theta_0)/ cos(theta_a) +! zigm22: 1/abs(I_m)*d theta_0/d theta_a * cos(theta_a)/ cos(theta_0) +! rim(1): abs(I_m)*d theta_a/d theta_0 +! rim(2): cos(theta_a)/ cos(theta_0) +! + do j=mlat0,mlat1 + if (j==1.or.j==nmlat) cycle ! skip poles + corfac = rcos0s(j)/dt1dts(j) + do i=mlon0,mlon1 + zigm11(i,j) = zigm11(i,j)*corfac + zigm22(i,j) = zigm22(i,j)/corfac + rim1(i,j) = rim1(i,j)/dt1dts(j) + rim2(i,j) = rim2(i,j)/rcos0s(j) + enddo + enddo +! +! For polar values, we need south pole plus 1 and 2 (j==2,3), +! and north pole minus 1 and 2 (j==nmlat-1,nmlat-2). These +! are returned by sub mp_magpole_jpm2 (mpi.F): +! Must specify (mlon0:mlon1,mlat0:mlat1) because zigmxx and rims +! are allocated to include halo cells. +! + fmsub(:,:,1) = zigm11(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,2) = zigm22(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,3) = zigmc (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) +! +! mp_magpole_2d returns fpole_jpm2(nmlonp1,1->4,nf) as: +! 1: j = 2 (spole+1) +! 2: j = 3 (spole+2) +! 3: j = nmlat-1 (npole-1) +! 4: j = nmlat-2 (npole-2) +! + call mp_magpole_2d(fmsub,mlon0,mlon1,mlat0,mlat1,nmlonp1, & + 1,nmlat,fpole_jpm2,nf2d) +! +! the PDE is divided by 1/ DT0DTS +! Sigma_(phi phi) = zigm11/ rcos0s * dt0dts +! Sigma_(lam lam) = zigm22 * rcos0s / dt0dts +! Sigma_(phi lam) = +-(zigm2-zigmc) +! Sigma_(lam phi) = -+(zigm2+zigmc) +! K_(m phi)^D = rim(1) * dt0dts +! K_(m lam)^D = +-rim(2) * rcos0s +! +! Compute polar values for the conductances, 4th order interpolation: +! + do j=mlat0,mlat1 +! +! South pole: + if (j==1) then ! south pole (use fpole_jpm2(nmlon,1->2,nf) + zigm11(mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,1,1))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,2,1)))/ & + (3._r8*r8_nmlon) + zigm22(mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,1,2))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,2,2)))/ & + (3._r8*r8_nmlon) + zigmc (mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,1,3))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,2,3)))/ & + (3._r8*r8_nmlon) + zigm2 (mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,1,4))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,2,4)))/ & + (3._r8*r8_nmlon) +! +! Extend south pole over longitude: + do i=mlon0+1,mlon1 + zigm11(i,j) = zigm11(mlon0,j) + zigm22(i,j) = zigm22(mlon0,j) + zigmc (i,j) = zigmc (mlon0,j) + zigm2 (i,j) = zigm2 (mlon0,j) + enddo ! i=mlon0,mlon1 +! +! RHS vector (I_1,I_2): average over south pole: +! (use fpole_jpm2(i,1,nf), i.e. j==2, and lons across the pole) + lonend = mlon1 + if (mlon1==nmlonp1) lonend = mlon1-1 + do i=mlon0,lonend + ii = 1+mod(i-1+nmlon/2,nmlon) + rim1(i,j) = 0.5_r8*(fpole_jpm2(i,1,5)-fpole_jpm2(ii,1,5)) + rim2(i,j) = 0.5_r8*(fpole_jpm2(i,1,6)-fpole_jpm2(ii,1,6)) + enddo +! +! North pole: + elseif (j==nmlat) then ! north pole (use fpole_jpm2(nmlon,3->4,1,nf) + zigm11(mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,3,1))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,4,1)))/ & + (3._r8*r8_nmlon) + zigm22(mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,3,2))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,4,2)))/ & + (3._r8*r8_nmlon) + zigmc (mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,3,3))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,4,3)))/ & + (3._r8*r8_nmlon) + zigm2 (mlon0,j)=(4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,3,4))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,4,4)))/ & + (3._r8*r8_nmlon) +! +! Extend north pole over longitude: + do i=mlon0+1,mlon1 + zigm11(i,j) = zigm11(mlon0,j) + zigm22(i,j) = zigm22(mlon0,j) + zigmc (i,j) = zigmc (mlon0,j) + zigm2 (i,j) = zigm2 (mlon0,j) + enddo ! i=mlon0,mlon1 +! +! RHS vector (I_1,I_2): average over north pole: +! (use fpole_jpm2(i,3,nf), i.e. j==nmlat-1, and lons across the pole) + lonend = mlon1 + if (mlon1==nmlonp1) lonend = mlon1-1 + do i=mlon0,lonend + ii = 1+mod(i-1+nmlon/2,nmlon) + rim1(i,j) = 0.5_r8*(fpole_jpm2(i,3,5)-fpole_jpm2(ii,3,5)) + rim2(i,j) = 0.5_r8*(fpole_jpm2(i,3,6)-fpole_jpm2(ii,3,6)) + enddo + endif ! south or north pole + enddo ! j=mlat0,mlat1 +! +! Fold south hemisphere over onto north, and set periodic points: + fmsub(:,:,1) = zigm11(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,2) = zigm22(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,3) = zigmc (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) + + call mp_mag_foldhem(fmsub,mlon0,mlon1,mlat0,mlat1,nf2d) + call mp_mag_periodic_f2d(fmsub,mlon0,mlon1,mlat0,mlat1,nf2d) + + zigm11(mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,1) + zigm22(mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,2) + zigmc (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,3) + zigm2 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,4) + rim1 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,5) + rim2 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,6) +! +! Reverse sign of zigmc in northern hemisphere. + do j=mlat0,mlat1 + if (j >= nmlath) then + zigmc(mlon0:mlon1,j) = -zigmc(mlon0:mlon1,j) + endif + call outfld('EDYN_RIM1',rim1(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('EDYN_RIM2',rim2(mlon0:omlon1,j),omlon1-mlon0+1,j) + enddo + + if (debug.and.masterproc) then + write(iulog,"('complete_integrals: nstep=',i4)") nstep + write(iulog,"(' zigm11 min,max=',2e12.4)") & + minval(zigm11(mlon0:mlon1,mlat0:mlat1)),maxval(zigm11(mlon0:mlon1,mlat0:mlat1)) + write(iulog,"(' zigm22 min,max=',2e12.4)") & + minval(zigm22(mlon0:mlon1,mlat0:mlat1)),maxval(zigm22(mlon0:mlon1,mlat0:mlat1)) + write(iulog,"(' zigmc min,max=',2e12.4)") & + minval(zigmc (mlon0:mlon1,mlat0:mlat1)),maxval(zigmc (mlon0:mlon1,mlat0:mlat1)) + write(iulog,"(' zigm2 min,max=',2e12.4)") & + minval(zigm2 (mlon0:mlon1,mlat0:mlat1)),maxval(zigm2 (mlon0:mlon1,mlat0:mlat1)) + write(iulog,"(' rim1 min,max=',2e12.4)") & + minval(rim1 (mlon0:mlon1,mlat0:mlat1)),maxval(rim1 (mlon0:mlon1,mlat0:mlat1)) + write(iulog,"(' rim2 min,max=',2e12.4)") & + minval(rim2 (mlon0:mlon1,mlat0:mlat1)),maxval(rim2 (mlon0:mlon1,mlat0:mlat1)) + endif + + call savefld_waccm_switch(zigm11(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM11' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm_switch(zigm22(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM22' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm_switch(zigmc (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGMC' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm_switch(zigm2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM2' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm_switch(rim1 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM1' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm_switch(rim2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM2' ,1,mlon0,mlon1,mlat0,mlat1) + + end subroutine complete_integrals +!----------------------------------------------------------------------- + subroutine rhspde + use edyn_params ,only: pi_dyn,r0 + use edyn_maggrid ,only: dlatm,dlonm,rcos0s,dt1dts +! +! Calculate right-hand side from rim1,2 on mag subdomains. +! Use global longitude arrays for poles and equator obtained +! by sub complete_integrals. +! +! Local: + integer :: j,i,ii + real(r8),dimension(nmlat) :: tint1 + real(r8) :: & + rim2_npm1(nmlonp1), & ! global rim2 at nmlat-1 + rim2_eqp1(nmlonp1), & ! global rim2 at meq+1 + rim2_meq (nmlonp1), & ! global rim2 at mag eq + rim2_tmp (nmlonp1), & ! temp array + rim1_meq (nmlonp1), & ! global rim1 at mag eq + zigm2_meq(nmlonp1), & ! needed for rim1_meq + zigmc_meq(nmlonp1), & ! needed for rim1_meq + zigm22_meq(nmlonp1) ! needed for rim1_meq + real(r8),parameter :: r8_nmlon = dble(nmlon) + + do j=1,nmlat + tint1(j) = cos(-pi_dyn/2._r8+(j-1)*dlatm) + enddo +! +! Init rhs subdomains: + rhs(:,:) = finit +! +! Will need rim2 at npole-1 and mag equator: +! rim2_npm1: global rim2 at nmlat-1: + rim2_npm1(:) = fpole_jpm2(:,3,6)+fpole_jpm2(:,1,6) +! +! rim2_meq: global rim2 at mag equator: + rim2_meq(:) = .060_r8*(feq_jpm1(:,1,6)+feq_jpm1(:,2,6)) + rim2_meq(:) = rim2_meq(:)/rcos0s(nmlath) + rim2_meq(:) = rim2_meq(:)*2._r8 ! fold eq on itself +! +! Perform differentiation of rim(2) w.r.t. lam_0: +! +/- (d [ K_(m lam)^D * cos(lam_m)]/ d lam_0 ) /cos ( lam_0) = +! + (d [ K_(m lam)^D * cos(lam_m)]/ d lam_m ) /cos ( lam_m) / (RCOS0S*DT0DTS) = +! +/- (d [ K_(m lam)^D(0) * cos(lam_0)]/ d lam_0 ) /cos ( lam_0) = +! +! Lat scan to define rhs subdomains: + do j=mlat0,mlat1 +! +! North Pole (redundant in longitude): + if (j == nmlat) then ! north pole + do i=mlon0,mlon1 + rhs(i,j) = -2._r8/r8_nmlon*dot_product(unitvm,rim2_npm1(1:nmlon))/ & + tint1(nmlat-1) + enddo +! +! Include the boundary condition at the equator. +! rhs(equator)/R = d (K_mphi^DT(0) - sig_philam/sig_lamlam*K_mlam^DT(0)) / d phi_m +! + d (cos lam_0 * K_mlam^DT(0))/ d lam_0 +! from Cicely's notes: +! I_1 = 0.5*(K_(m phi)^DT(0) - Sig_(phi lam)/Sig_(lam lam)*K_(ml am)^DT(0)) +! I_2 = K_(m lam)^DT(0) +! differentiate +! rhs = (I_1(i+1/2,j)-I_1(i-1/2,j))/dlonm + +! (2*cos(lam_0)_(j+1/2)*I_2(i,j+1/2))/dlat_0 +! (first calc global mag equator as in complete_integrals) +! + elseif (j == nmlath) then ! mag equator + rim2_eqp1(:) = feq_jpm1(:,2,6)/rcos0s(j-1)+ & + feq_jpm1(:,1,6)/rcos0s(j+1) + zigm22_meq(:) = .125_r8*(feq_jpm1(:,1,2)+feq_jpm1(:,2,2)) + zigmc_meq (:) = .125_r8*(feq_jpm1(:,1,3)+feq_jpm1(:,2,3)) + zigm2_meq (:) = .060_r8*(feq_jpm1(:,1,4)+feq_jpm1(:,2,4)) + rim1_meq (:) = .060_r8*(feq_jpm1(:,1,5)+feq_jpm1(:,2,5)) + rim2_tmp (:) = .060_r8*(feq_jpm1(:,1,6)+feq_jpm1(:,2,6)) + do i=1,nmlonp1 + rim1_meq(i) = rim1_meq(i) - (zigm2_meq(i)-zigmc_meq(i))/ & + zigm22_meq(i)*rim2_tmp(i) + enddo + rim1_meq(:) = rim1_meq(:)/dt1dts(j) + rim1_meq(:) = rim1_meq(:)*2._r8 ! fold eq on itself + + do i=mlon0,mlon1 + if (i==1) then ! western most lon + rhs(i,j) = 0.5_r8/dlonm*(rim1(i+1,j)-rim1_meq(nmlon)) + rhs(i,j) = rhs(i,j)+1._r8/dlatm*(tint1(j)*rim2(i,j)+ & + tint1(j+1)*rim2_eqp1(i)) + elseif (i==nmlonp1) then ! eastern most lon + rhs(i,j) = 0.5_r8/dlonm*(rim1_meq(1)-rim1(i-1,j)) + rhs(i,j) = rhs(i,j)+1._r8/dlatm*(tint1(j)*rim2(i,j)+ & + tint1(j+1)*rim2_eqp1(i)) + else ! body of i subdomain +! Note that rim1 halos were set before calling this subroutine. + rhs(i,j) = 0.5_r8/dlonm*(rim1(i+1,j)-rim1(i-1,j)) + rhs(i,j) = rhs(i,j)+1._r8/dlatm*(tint1(j)*rim2(i,j)+ & + tint1(j+1)*rim2_eqp1(i)) + endif + enddo ! i=mlon0,mlon1 +! +! North hemisphere (not npole and not equator): +! (allow south hemisphere to remain 0) +! (use rim1 instead of tint33) +! + elseif (j > nmlath) then ! north hem only (excluding npole) + do i=mlon0,mlon1 + rhs(i,j) = 1._r8/(dlonm*tint1(j))*0.5_r8*(rim1(i+1,j)-rim1(i-1,j)) + if (j == nmlath+1) then + rhs(i,j) = rhs(i,j)+1._r8/(dlatm*tint1(j))* & + 0.5_r8*(rim2(i,j+1)*tint1(j+1)-rim2_meq(i)*tint1(j-1)) + else + rhs(i,j) = rhs(i,j)+1._r8/(dlatm*tint1(j))* & + 0.5_r8*(rim2(i,j+1)*tint1(j+1)-rim2(i,j-1)*tint1(j-1)) + endif + enddo + endif ! at poles or equator + enddo ! j=mlat0,mlat1 +! +! scale (multiply by earth radius in meter = R0*1.E-2) +![( d K_(m phi)^D / d phi /(cos(theta_m)?) + +! (d [ K_(m lam)^D * cos(lam_m)]/ d lam_m ) /cos ( lam_m) ] * R / (RCOS0S*DT0DTS) +! ~ J_(Mr)*r^2*cos(theta_m)/cos(theta_0)/DT0DTS +! theta_m = theta_s +! + do j=mlat0,mlat1 + do i=mlon0,mlon1 + rhs(i,j) = rhs(i,j)*r0*1.e-2_r8 + enddo + enddo + + end subroutine rhspde +!----------------------------------------------------------------------- + subroutine gather_edyn +! +! Gather needed global arrays to root task, so it can finish non-parallel +! part of dynamo (beginning after sub rhspde) as in original code +! + use edyn_mpi, only: mp_gather_edyn + use edyn_solve,only: & ! (nmlonp1,nmlat) + zigm11_glb ,& + zigm22_glb ,& + zigmc_glb ,& + zigm2_glb ,& + rhs_glb + use edyn_solve ,only: rim_glb ! pde solver output (nmlonp1,nmlat,2) +! +! Local: +! 7 fields to gather: zigm11,zigm22,zigmc,zigm2,rim1,rim2,rhs +! + integer,parameter :: nf = 7 + real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf) + real(r8) :: fmglb(nmlonp1,nmlat,nf) + real(r8) :: rhs_nhem(nmlonp1,nmlat) + integer :: i,j,jj +! +! These calls exclude halo points in zigm11, etc. +! + fmsub(:,:,1) = zigm11(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,2) = zigm22(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,3) = zigmc (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,7) = rhs (mlon0:mlon1,mlat0:mlat1) + + call mp_gather_edyn(fmsub,mlon0,mlon1,mlat0,mlat1, & + fmglb,nmlonp1,nmlat,nf) +! +! Now root task can take over, and work with global arrays: +! + if (mytid==0) then + zigm11_glb(:,:) = fmglb(:,:,1) + zigm22_glb(:,:) = fmglb(:,:,2) + zigmc_glb(:,:) = fmglb(:,:,3) + zigm2_glb(:,:) = fmglb(:,:,4) + rim_glb(:,:,1) = fmglb(:,:,5) + rim_glb(:,:,2) = fmglb(:,:,6) + rhs_nhem(:,:) = fmglb(:,:,7) +! +! Transfer local global rhs_nhem (from sub rhspde) to rhs_glb, +! so the latter has data in south hemisphere. +! + rhs_glb= 0._r8 ! init + do j=1,nmlat +! +! Transfer north pole to equator: + if (j == nmlat) then + do i=1,nmlonp1 + rhs_glb(i,nmlath) = rhs_nhem(i,j) + enddo +! Transfer equator to south pole: + elseif (j == nmlath) then + do i=1,nmlonp1 + rhs_glb(i,1) = rhs_nhem(i,j) + enddo +! Transfer north hem to south hem: + elseif (j > nmlath) then ! 50 -> 96 + jj = j-nmlath+1 ! 2 -> 48 + do i=1,nmlonp1 + rhs_glb(i,jj) = rhs_nhem(i,j) + enddo + endif + enddo ! j=mlat0,mlat1 + + endif ! mytid==0 + end subroutine gather_edyn +!----------------------------------------------------------------------- + subroutine highlat_poten + use edyn_solve,only: & + phihm ,& ! high-latitude potential (nmlonp1,nmlat) + pfrac ! NH fraction of potential (nmlonp1,nmlat0) +! +! Global PDE solution rim_glb(:,:,1) has been scattered to mag subdomains +! in rim1, and halos set (this overwrites previous rim1 from fieldline +! integrations). Now add high latitude potential from empirical model +! (heelis or weimer), defining phim2d on mag subdomains. After this pthreed +! will expand phim2d to phim3d. +! +! Input: rim1(mag subdomains) ! Solution from mudpack solver (nhem only) +! pfrac(nmlonp1,nmlat0) ! NH fraction of potential +! phihm(nmlonp1,nmlat) ! potential in magnetic +! Output: phim2d(mag subdomains) ! solution with phihm in both nhem and shem +! Both rim1 and phim2d are dimensioned (mlon00:mlon11,mlat00:mlat11) +! +! Both phihm and pfrac have been set by either heelis or weimer. +! phihm is on 2d global mag grid, pfrac is in north hemisphere only +! +! Local: + logical,parameter :: mod_heelis = .false. ! true == modified + integer :: i,j,jn,js + real(r8) :: fac +! +! Add empirical model potential at high latitude: +! + fac = 1.0_r8 + if (mod_heelis) fac = 0._r8 ! modified heelis + do j=mlat0,mlat1 + if (j > nmlath) cycle ! south only (including equator) + jn = nmlat-j+1 + js = nmlath-j+1 + do i=mlon0,mlon1 + phim2d(i,j) = rim1(i,j)+fac*(1._r8-pfrac(i,js))*(phihm(i,j)- & + phihm(i,jn)) + enddo + enddo + + do j=mlat0,mlat1 + if (j <= nmlath) cycle ! north only (excluding equator) + do i=mlon0,mlon1 + phim2d(i,j) = rim1(i,j) + enddo + enddo + + do j=mlat0,mlat1 + call outfld('PHIM2D',phim2d(mlon0:omlon1,j),omlon1-mlon0+1,j) + enddo + + end subroutine highlat_poten +!----------------------------------------------------------------------- + subroutine pthreed +! +! phim2d is now 2d electric potential solution on mag subdomains, +! with high-latitude potential added from empirical model (see subs +! heelis and highlat_poten), and mag halos set. Now expand phim2d in +! vertical, defining phim3d. Also calculate electric field ed13d, ed23d +! for later current calculations, and ephi3d, elam3d and emz3d for conversion +! to geographic grid (sub pefield), and subsequent calculation of ion drifts +! by sub ionvel (not in edynamo). +! + use edyn_params ,only: h0,re,pi_dyn,r0,kbotdyn + use edyn_maggrid,only: ylatm,dlatm,dlonm,rcos0s,dt1dts,dt0dts,table + use edyn_mpi ,only: & + mp_mag_halos ,& + mp_magpole_2d ,& + mp_mageq_jpm3 ,& + mp_mag_jslot ,& + mp_magpoles ,& + mp_mag_periodic_f2d ,& + ixfind +! +! Local: + real(r8),parameter :: eps = 1.e-10_r8, unitvm(nmlon)=1._r8 + integer,parameter :: mxneed=nmlat+2 + integer :: i,j,k,n,mlon00,mlon11,mlat00,mlat11 + real(r8) :: csth0,cosltm,sinltm,sym,pi,phims,phimn,siniq,real8 + real(r8),dimension(nmlonp1) :: thetam,pslot,qslot + integer,dimension(nmlonp1) :: islot,jslot,ip1f,ip2f,ip3f + +! real(r8),dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ed1,ed2 + + real(r8),dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ephi,elam + real(r8) :: fpole2d_jpm2(nmlonp1,4,4) ! global lons at S pole+1,2 and N pole-1,2 + real(r8) :: fpoles(nmlonp1,2,1) ! global lons at poles (1 field only) + real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,4) + real(r8) :: fmsub1(mlon0-1:mlon1+1,mlat0-1:mlat1+1,5) + real(r8) :: feq_jpm3(nmlonp1,-3:3,1) ! global lons at equator +/- 3 + integer :: jneed(mxneed) ! lats needed from other tasks for interp + integer :: njneed,icount + real(r8),dimension(mlon0-1:mlon1+1,mxneed) :: & + phineed, & ! phim2d at needed latitudes + ed1need, & ! ed1 at needed latitudes + ed2need, & ! ed2 at needed latitudes + ephineed, & ! ephi at needed latitudes + elamneed ! elam at needed latitudes + real(r8),dimension(mlon0-1:mlon1+1,mxneed,5) :: fmneed + real(r8) :: phi0j0,phi1j0,phi0j1,phi1j1 + real(r8) :: ed1i0j0,ed1i1j0,ed1i0j1,ed1i1j1 + real(r8) :: ed2i0j0,ed2i1j0,ed2i0j1,ed2i1j1 + real(r8) :: ephi0j0,ephi1j0,ephi0j1,ephi1j1 + real(r8) :: elam0j0,elam1j0,elam0j1,elam1j1 + real(r8) :: fac_elam +! + pi = pi_dyn + mlon00=mlon0-1 ; mlon11=mlon1+1 + mlat00=mlat0-1 ; mlat11=mlat1+1 +! +! Calculate ed1,ed2 components of electric field: +! phim2d has halos set, so when mlon0==1, i-1 should wrap +! to value at i==nmlon, and when mlon1==nmlonp1, i+1 should +! wrap to value at i==2. +! + ed1 = 0._r8 + ephi = 0._r8 + do j=mlat0,mlat1 + if (j==1.or.j==nmlat) cycle + csth0 = cos(-pi/2._r8+(j-1)*dlatm) + do i=mlon0,mlon1 + ed1(i,j) = -(phim2d(i+1,j)-phim2d(i-1,j))/(2._r8*dlonm*csth0)* & + rcos0s(j)/(r0*1.e-2_r8) + ephi(i,j) = ed1(i,j)*(r0*1.e-2_r8) + enddo ! i=mlon0,mlon1 + enddo ! j=mlat0,mlat1 +! +! Southern hemisphere (excluding equator): + ed2 = 0._r8 + elam = 0._r8 + do j=mlat0,mlat1 + if (j >= nmlath) cycle + if (j==1.or.j==nmlat) cycle ! skip poles + do i=mlon0,mlon1 + ed2(i,j)= -(phim2d(i,j+1)-phim2d(i,j-1))/(2._r8*dlatm)*dt1dts(j)/ & + (r0*1.e-2_r8) + elam(i,j)= -(phim2d(i,j+1)-phim2d(i,j-1))/(2._r8*dlatm)*dt0dts(j) + enddo ! i=mlon0,mlon1 + enddo ! j=mlat0,mlat1 +! +! Northern hemisphere (excluding equator): + do j=mlat0,mlat1 + if (j <= nmlath) cycle + if (j==1.or.j==nmlat) cycle ! skip poles + do i=mlon0,mlon1 + ed2(i,j) = (phim2d(i,j+1)-phim2d(i,j-1))/(2._r8*dlatm)*dt1dts(j)/ & + (r0*1.e-2_r8) + elam(i,j)= -(phim2d(i,j+1)-phim2d(i,j-1))/(2._r8*dlatm)*dt0dts(j) + enddo ! i=mlon0,mlon1 + enddo ! j=mlat0,mlat1 + +! Need ed1,2 at global longitudes at j==2 and j==nmlat-1: +! mp_magpole_2d: Return fpole_jpm2(nglblon,1->4,nf) as: +! 1: j = jspole+1 (spole+1) +! 2: j = jspole+2 (spole+2) (unused here) +! 3: j = jnpole-1 (npole-1) +! 4: j = jnpole-2 (npole-2) (unused here) +! + fmsub(:,:,1) = ed1(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,2) = ed2(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,3) = ephi(mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,4) = elam(mlon0:mlon1,mlat0:mlat1) + call mp_magpole_2d(fmsub,mlon0,mlon1,mlat0,mlat1,nmlonp1, & + 1,nmlat,fpole2d_jpm2,4) +! +! Poles: average over four surrounding points + do i = 1,nmlonp1 + ip1f(i) = i + nmlon/4 + if (ip1f(i) > nmlonp1) ip1f(i) = ip1f(i) - nmlon + ip2f(i) = i + nmlon/2 + if (ip2f(i) > nmlonp1) ip2f(i) = ip2f(i) - nmlon + ip3f(i) = i + 3*nmlon/4 + if (ip3f(i) > nmlonp1) ip3f(i) = ip3f(i) - nmlon + enddo ! i=1,nmlonp1 +! +! S pole: + do j=mlat0,mlat1 + if (j==1) then + do i=mlon0,mlon1 + ed1(i,j)=.25_r8*(fpole2d_jpm2(i,1,1)-fpole2d_jpm2(ip2f(i),1,1)+ & + fpole2d_jpm2(ip1f(i),1,2)-fpole2d_jpm2(ip3f(i),1,2)) + ed2(i,j)=.25_r8*(fpole2d_jpm2(i,1,2)-fpole2d_jpm2(ip2f(i),1,2)- & + fpole2d_jpm2(ip1f(i),1,1)+fpole2d_jpm2(ip3f(i),1,1)) + + ephi(i,j)=.25_r8*(fpole2d_jpm2(i,1,3)-fpole2d_jpm2(ip2f(i),1,3)+ & + fpole2d_jpm2(ip1f(i),1,4)-fpole2d_jpm2(ip3f(i),1,4)) + elam(i,j)=.25_r8*(fpole2d_jpm2(i,1,4)-fpole2d_jpm2(ip2f(i),1,4)- & + fpole2d_jpm2(ip1f(i),1,3)+fpole2d_jpm2(ip3f(i),1,3)) + enddo ! i=mlon0,mlon1 +! N pole: + elseif (j==nmlat) then + do i=mlon0,mlon1 + ed1(i,j)=.25_r8*(fpole2d_jpm2(i,3,1)-fpole2d_jpm2(ip2f(i),3,1)+ & + fpole2d_jpm2(ip1f(i),3,2)-fpole2d_jpm2(ip3f(i),3,2)) + ed2(i,j)=.25_r8*(fpole2d_jpm2(i,3,2)-fpole2d_jpm2(ip2f(i),3,2)- & + fpole2d_jpm2(ip1f(i),3,1)+fpole2d_jpm2(ip3f(i),3,1)) + + ephi(i,j)=.25_r8*(fpole2d_jpm2(i,3,3)-fpole2d_jpm2(ip2f(i),3,3)+ & + fpole2d_jpm2(ip1f(i),3,4)-fpole2d_jpm2(ip3f(i),3,4)) + elam(i,j)=.25_r8*(fpole2d_jpm2(i,3,4)-fpole2d_jpm2(ip2f(i),3,4)- & + fpole2d_jpm2(ip1f(i),3,3)+fpole2d_jpm2(ip3f(i),3,3)) + enddo ! i=mlon0,mlon1 + endif ! S or N pole + enddo ! j=mlat0,mlat1 +! +! Equator: derivative of quadratic polynomial (3 given points) +! For equator and equator +/- 1 of ed2, we need equator and +! equator +/- 3 of phim2d (note feq_jpm3(nmlonp1,-3:3,1)): +! + fmsub(:,:,1) = phim2d(mlon0:mlon1,mlat0:mlat1) + call mp_mageq_jpm3(fmsub(:,:,1),mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm3,1) + do j=mlat0,mlat1 + if (j==nmlath-1) then ! equator-1 + do i=mlon0,mlon1 + ed2(i,j) = (4._r8*feq_jpm3(i,-2,1)-feq_jpm3(i,-3,1)- & + 3._r8*feq_jpm3(i,-1,1))/(2._r8*dlatm)/(r0*1.e-2_r8) + enddo + elseif (j==nmlath) then ! equator + do i=mlon0,mlon1 + ed2(i,j) = (4._r8*feq_jpm3(i,1,1)-feq_jpm3(i,2,1)- & + 3._r8*feq_jpm3(i,0,1))/(2._r8*dlatm)/(r0*1.e-2_r8) + elam(i,j) = (4._r8*feq_jpm3(i,1,1)-feq_jpm3(i,2,1)- & + 3._r8*feq_jpm3(i,0,1))/(2._r8*dlatm) + enddo + elseif (j==nmlath+1) then ! equator+1 + do i=mlon0,mlon1 + ed2(i,j) = (4._r8*feq_jpm3(i,2,1)-feq_jpm3(i,3,1)- & + 3._r8*feq_jpm3(i,1,1))/(2._r8*dlatm)/(r0*1.e-2_r8) + enddo + endif ! equator +/- 1 + enddo ! j=mlat0,mlat1 +! +! Set halos for 3d calculations: + fmsub1(:,:,1) = ed1 + fmsub1(:,:,2) = ed2 + fmsub1(:,:,3) = ephi + fmsub1(:,:,4) = elam + call mp_mag_halos(fmsub1,mlon0,mlon1,mlat0,mlat1,4) + ed1 = fmsub1(:,:,1) + ed2 = fmsub1(:,:,2) + ephi = fmsub1(:,:,3) + elam = fmsub1(:,:,4) + + do j=mlat0,mlat1 + call outfld('ED1',ed1(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('ED2',ed2(mlon0:omlon1,j),omlon1-mlon0+1,j) + enddo +! +! Determine latitudes needed for interpolation that fall +! outside a task's latitudinal subdomain: +! + if (debug) write(iulog,*) "pthreed: kbotdyn ", kbotdyn + + njneed = 0 ! number of unique latitudes needed + jneed(:) = -1 ! j-indices of needed latitudes + do k=kbotdyn,nmlev + do j=mlat0,mlat1 + if (j==1.or.j==nmlat) cycle ! exclude poles + sym = 1._r8 + if (j < nmlath) sym = -1._r8 + cosltm = cos(ylatm(j)) + do i=mlon0,mlon1 + if (i==nmlonp1) cycle + + thetam(i)=(re+zpotm3d(i,j,kbotdyn))/(re+zpotm3d(i,j,k)) + thetam(i) = acos(sqrt(thetam(i))*cosltm*(1._r8-eps)) + + pslot(i) = thetam(i)*180._r8/pi+1._r8 + islot(i) = pslot(i) + real8 = dble(islot(i)) + pslot(i) = pslot(i)-real8 + + thetam(i) = ((1._r8-pslot(i))*table(islot(i),2)+pslot(i)* & + table(islot(i)+1,2))*sym ! thetam negative for south hem + + islot(i) = i + pslot(i) = 0._r8 + qslot(i) = (thetam(i)+pi/2._r8)/dlatm+1._r8 + jslot(i) = qslot(i) + real8 = dble(jslot(i)) + qslot(i) = qslot(i)-real8 + +! Save j index if outside subdomain w/ halos: + if ((jslot(i) < mlat00 .or. jslot(i) > mlat11).and. & + .not.any(jslot(i)==jneed)) then + njneed = njneed+1 + if (njneed > mxneed) call endrun('njneed') + jneed(njneed) = jslot(i) + endif ! jslot is outside subdomain +! +! Save j+1 index if outside subdomain: + if ((jslot(i)+1 < mlat00 .or. jslot(i)+1 > mlat11).and. & + .not.any(jslot(i)+1==jneed)) then + njneed = njneed+1 + if (njneed > mxneed) call endrun('njneed') + jneed(njneed) = jslot(i)+1 + endif ! jslot(i)+1 is outside subdomain + enddo ! i=mlon0,mlon1 + enddo ! j=mlat0,mlat1 + enddo ! k=kbotdyn,nmlev +! +! Get phim2 at needed latitudes (note inclusion of phim2d halos). +! real,intent(in) :: fin(mlon00:mlon11,mlat00:mlat11,nf) ! data at current subdomain +! real,intent(out) :: fout(mlon00:mlon11,mxneed,nf) ! returned data at needed lats +! + fmsub1(:,:,1) = phim2d + fmsub1(:,:,2) = ed1 + fmsub1(:,:,3) = ed2 + fmsub1(:,:,4) = ephi + fmsub1(:,:,5) = elam + call mp_mag_jslot(fmsub1,mlon00,mlon11,mlat00,mlat11,fmneed,jneed,mxneed,5) + phineed = fmneed(:,:,1) + ed1need = fmneed(:,:,2) + ed2need = fmneed(:,:,3) + ephineed= fmneed(:,:,4) + elamneed= fmneed(:,:,5) + + ephi3d = 0._r8 + elam3d = 0._r8 + emz3d = 0._r8 + do k=kbotdyn,nmlev + do j=mlat0,mlat1 + if (j==1.or.j==nmlat) cycle ! exclude poles + sym = 1._r8 + if (j < nmlath) sym = -1._r8 + cosltm = cos(ylatm(j)) + sinltm = sin(ylatm(j)) + do i=mlon0,mlon1 + if (i==nmlonp1) cycle + siniq = 2._r8*sinltm/sqrt(4._r8-3._r8*cosltm**2) + + thetam(i)=(re+zpotm3d(i,j,kbotdyn))/(re+zpotm3d(i,j,k)) + thetam(i) = acos(sqrt(thetam(i))*cosltm*(1._r8-eps)) + fac_elam = tan(ylatm(j))/tan(thetam(i)*sym) ! tan(lambda_q)/tan(lambda_m) + + pslot(i) = thetam(i)*180._r8/pi+1._r8 + islot(i) = pslot(i) + real8 = dble(islot(i)) + pslot(i) = pslot(i)-real8 + + thetam(i) = ((1._r8-pslot(i))*table(islot(i),2)+pslot(i)* & + table(islot(i)+1,2))*sym ! thetam negative for south hem + + islot(i) = i + pslot(i) = 0._r8 + qslot(i) = (thetam(i)+pi/2._r8)/dlatm+1._r8 + jslot(i) = qslot(i) + real8 = dble(jslot(i)) + qslot(i) = qslot(i)-real8 +! +! Check for jslot in subdomain: + if (jslot(i) >= mlat00.and.jslot(i) <= mlat11) then ! within subdomain + phi0j0 = phim2d(islot(i) ,jslot(i)) + phi1j0 = phim2d(islot(i)+1,jslot(i)) + ed1i0j0 = ed1(islot(i) ,jslot(i)) + ed1i1j0 = ed1(islot(i)+1,jslot(i)) + ed2i0j0 = ed2(islot(i) ,jslot(i)) + ed2i1j0 = ed2(islot(i)+1,jslot(i)) + ephi0j0 = ephi(islot(i) ,jslot(i)) + ephi1j0 = ephi(islot(i)+1,jslot(i)) + elam0j0 = elam(islot(i) ,jslot(i)) + elam1j0 = elam(islot(i)+1,jslot(i)) + else ! jslot outside subdomain + n = ixfind(jneed,mxneed,jslot(i),icount) + if (n==0) then + write(iulog,"('>>> pthreed: i=',i4,' j=',i4,' k=',i4)") i,j,k + write(iulog,"(' Could not find jslot ',i4,' in jneed=',/,(10i4))") & + i,j,k,jslot(i),jneed + call endrun('jslot(i) not in jneed') + endif + phi0j0 = phineed(islot(i) ,n) + phi1j0 = phineed(islot(i)+1,n) + ed1i0j0 = ed1need(islot(i) ,n) + ed1i1j0 = ed1need(islot(i)+1,n) + ed2i0j0 = ed2need(islot(i) ,n) + ed2i1j0 = ed2need(islot(i)+1,n) + ephi0j0 =ephineed(islot(i) ,n) + ephi1j0 =ephineed(islot(i)+1,n) + elam0j0 =elamneed(islot(i) ,n) + elam1j0 =elamneed(islot(i)+1,n) + endif +! +! Check for jslot+1 in subdomain: + if (jslot(i)+1 >= mlat00.and.jslot(i)+1 <= mlat11) then ! within subdomain + phi0j1 = phim2d(islot(i) ,jslot(i)+1) + phi1j1 = phim2d(islot(i)+1,jslot(i)+1) + ed1i0j1 = ed1(islot(i) ,jslot(i)+1) + ed1i1j1 = ed1(islot(i)+1,jslot(i)+1) + ed2i0j1 = ed2(islot(i) ,jslot(i)+1) + ed2i1j1 = ed2(islot(i)+1,jslot(i)+1) + ephi0j1 = ephi(islot(i) ,jslot(i)+1) + ephi1j1 = ephi(islot(i)+1,jslot(i)+1) + elam0j1 = elam(islot(i) ,jslot(i)+1) + elam1j1 = elam(islot(i)+1,jslot(i)+1) + else ! jslot+1 outside subdomain + n = ixfind(jneed,mxneed,jslot(i)+1,icount) + if (n==0) then + write(iulog,"('>>> pthreed: i=',i4,' j=',i4,' k=',i4)") i,j,k + write(iulog,"(' Could not find jslot+1 ',i4,' in jneed=',/,(10i4))") & + i,j,k,jslot(i)+1,jneed + call endrun('jslot(i)+1 not in jneed') + endif + phi0j1 = phineed(islot(i) ,n) + phi1j1 = phineed(islot(i)+1,n) + ed1i0j1 = ed1need(islot(i) ,n) + ed1i1j1 = ed1need(islot(i)+1,n) + ed2i0j1 = ed2need(islot(i) ,n) + ed2i1j1 = ed2need(islot(i)+1,n) + ephi0j1 =ephineed(islot(i) ,n) + ephi1j1 =ephineed(islot(i)+1,n) + elam0j1 =elamneed(islot(i) ,n) + elam1j1 =elamneed(islot(i)+1,n) + endif +! +! Do the interpolation: + phim3d(i,j,k) = (1._r8-qslot(i))*((1._r8-pslot(i))* & + phi0j0 + pslot(i) * phi1j0) + qslot(i)*((1._r8-pslot(i))* & + phi0j1 + pslot(i) * phi1j1) + + ed13d(i,j,k) = (1._r8-qslot(i))*((1._r8-pslot(i))* & + ed1i0j0 + pslot(i) * ed1i1j0) + qslot(i)*((1._r8-pslot(i))* & + ed1i0j1 + pslot(i) * ed1i1j1) + ed23d(i,j,k) = (1._r8-qslot(i))*((1._r8-pslot(i))* & + ed2i0j0 + pslot(i) * ed2i1j0) + qslot(i)*((1._r8-pslot(i))* & + ed2i0j1 + pslot(i) * ed2i1j1) + + ephi3d(i,j,k) = (1._r8-qslot(i))*((1._r8-pslot(i))* & + ephi0j0 + pslot(i) * ephi1j0) + qslot(i)*((1._r8-pslot(i))* & + ephi0j1 + pslot(i) * ephi1j1) + elam3d(i,j,k) = (1._r8-qslot(i))*((1._r8-pslot(i))* & + elam0j0 + pslot(i) * elam1j0) + qslot(i)*((1._r8-pslot(i))* & + elam0j1 + pslot(i) * elam1j1) + elam3d(i,j,k) = elam3d(i,j,k)*fac_elam ! add height variation + enddo ! i=mlon0,mlon1 + enddo ! j=mlat0,mlat1 + enddo ! k=kbotdyn,nmlev + +! +! Mag poles for phim: +! mp_magpoles returns global longitudes at S,N poles in fpoles(nglblon,2,nf) +! + call mp_magpoles(phim2d(mlon0:mlon1,mlat0:mlat1), & + mlon0,mlon1,mlat0,mlat1,nmlonp1,1,nmlat,fpoles,1) + + real8 = dble(nmlon) + phims=dot_product(unitvm,fpoles(1:nmlon,1,1))/real8 + phimn=dot_product(unitvm,fpoles(1:nmlon,2,1))/real8 + + do k=kbotdyn,nmlev + do j=mlat0,mlat1 + if (j==1) then + do i=mlon0,mlon1 + phim3d(i,j,k) = phims + ed13d(i,j,k) = ed1(i,j) + ed23d(i,j,k) = ed2(i,j) + ephi3d(i,j,k) = ephi(i,j) + elam3d(i,j,k) = ed2(i,j)*(r0*1.e-2_r8) + enddo + elseif (j==nmlat) then + do i=mlon0,mlon1 + phim3d(i,j,k) = phimn + ed13d(i,j,k) = ed1(i,j) + ed23d(i,j,k) = ed2(i,j) + ephi3d(i,j,k) = ephi(i,j) + elam3d(i,j,k) = -ed2(i,j)*(r0*1.e-2_r8) + enddo + endif ! poles + enddo ! j=mlat0,mlat1 + enddo ! k=kbotdyn,nmlev +! +! Extend kbotdyn downward redundantly: + do k=1,kbotdyn-1 + phim3d(:,:,k) = phim3d(:,:,kbotdyn) + ephi3d(:,:,k) = ephi3d(:,:,kbotdyn) + elam3d(:,:,k) = elam3d(:,:,kbotdyn) + enddo +! +! Upward electric field: + do k=kbotdyn,nmlev-1 + do j=mlat0,mlat1 + do i=mlon0,mlon1 + emz3d(i,j,k) = -(phim3d(i,j,k+1)-phim3d(i,j,k-1)) + enddo + enddo + enddo +! + do k=mlev0,mlev1 + call mp_mag_periodic_f2d(phim3d(:,:,k),mlon0,mlon1,mlat0,mlat1,1) + enddo +! + do j=mlat0,mlat1 + call outfld('EPHI3D',ephi3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ELAM3D',elam3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('EMZ3D', emz3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + + call outfld('PHIM3D',phim3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ED13D' ,ed13d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ED23D' ,ed23d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + enddo + end subroutine pthreed +!----------------------------------------------------------------------- + subroutine pefield + use edyn_params ,only: pi + use edyn_maggrid,only: dt0dts,dlatm,dlonm,rcos0s,table + use edyn_geogrid,only: nlev + use edyn_mpi ,only: mp_magpole_3d,mp_mag_halos,mp_magpoles,mytid + use edyn_esmf ,only: mag_ephi3d,mag_elam3d,mag_emz3d,mag_phi3d,& + geo_ephi3d,geo_elam3d,geo_emz3d,geo_phi3d +! +! Local: + integer :: i,ii,j,k + real(r8) :: & + phi3d(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nmlev), & ! local phi w/ halos + fpole3d_jpm2(nmlonp1,4,nmlev,1) ! global lons at S pole+1,2 and N pole-1,2 + real(r8) :: csth0,real8 + real(r8) :: fpoles(nmlonp1,2,nmlev) ! global lons at poles + real(r8),dimension(lon0:lon1,lat0:lat1,nlev) :: exgeo,eygeo,ezgeo + real(r8),dimension(lon0:lon1,nlev) :: diag_ik +! +! Copy phim3d to local phi3d, and set halo points: + do j=mlat0,mlat1 + do i=mlon0,mlon1 + phi3d(i,j,:) = phim3d(i,j,:) + enddo + enddo + call mp_mag_halos(phi3d,mlon0,mlon1,mlat0,mlat1,nmlev) +! +! Return fpole3d_jpm2(nglblon,1->4,nlev,nf) as: +! 1: j = jspole+1 (spole+1) +! 2: j = jspole+2 (spole+2) not used here +! 3: j = jnpole-1 (npole-1) +! 4: j = jnpole-2 (npole-2) not used here +! + call mp_magpole_3d(phim3d(mlon0:mlon1,mlat0:mlat1,:),mlon0,& + mlon1,mlat0,mlat1,nmlev,nmlonp1,1,nmlat,fpole3d_jpm2,1) +! +! Set j=0 and j=nmlat+1 of local phi3d. This overwrites the far +! north and south halo points set by mp_mag_halos above. + do j=mlat0,mlat1 + if (j==1) then + do i=mlon0,mlon1 + ii = 1+mod(i-1+nmlon/2,nmlon) ! over the south pole + phi3d(i,j-1,:) = fpole3d_jpm2(ii,1,:,1) + enddo + elseif (j==nmlat) then + do i=mlon0,mlon1 + ii = 1+mod(i-1+nmlon/2,nmlon) ! over the north pole + phi3d(i,j+1,:) = fpole3d_jpm2(ii,3,:,1) + enddo + endif ! poles or not + enddo ! j=mlat0,mlat1 +! +! Meridional component of electric field: + do j=mlat0,mlat1 + do i=mlon0,mlon1 + elam3d(i,j,:) = -(phi3d(i,j+1,:)-phi3d(i,j-1,:))/ & + (2._r8*dlatm)*dt0dts(j) + enddo + enddo +! +! Zonal component of electric field: + do j=mlat0,mlat1 + if (j==1.or.j==nmlat) cycle + real8 = dble(j-1) + csth0 = cos(-pi/2._r8+real8*dlatm) + do i=mlon0,mlon1 + ephi3d(i,j,:) = -(phi3d(i+1,j,:)-phi3d(i-1,j,:))/ & + (2._r8*dlonm*csth0)*rcos0s(j) + enddo + enddo +! +! Polar values for ephi3d (need global lons at poles of elam3d): + call mp_magpoles(elam3d,mlon0,mlon1,mlat0,mlat1,nmlonp1,1,nmlat,fpoles,nmlev) + do j=mlat0,mlat1 + if (j==1) then ! south pole + do i=mlon0,mlon1 + ii = 1+mod(i-1+(nmlon/4),nmlon) ! over the south pole + ephi3d(i,j,:) = fpoles(ii,1,:) + enddo + elseif (j==nmlat) then ! north pole + do i=mlon0,mlon1 + ii = 1+mod(i-1+((3*nmlon)/4),nmlon) ! over the north pole + ephi3d(i,j,:) = fpoles(ii,2,:) + enddo + endif ! poles or not + enddo ! j=mlat0,mlat1 +! +! emz = d(phi)/dz + do k=2,nmlev-1 + do j=mlat0,mlat1 + do i=mlon0,mlon1 + emz3d(i,j,k) = -(phim3d(i,j,k+1)-phi3d(i,j,k-1)) + enddo + enddo + enddo ! k=2,nmlev-1 +! +! btf 6/18/14: mag2geo is not working due to error return rc=51 from +! ESMF_FieldSMM for 3d mag2geo (see sub esmf_regrid in edyn_esmf.F90) +! (this is the call to do the data regridding, not the init call) +! +! Use ESMF to regrid the electric field to the geographic grid: + call mag2geo_3d(ephi3d,exgeo ,mag_ephi3d,geo_ephi3d,'EPHI3D ') + call mag2geo_3d(elam3d,eygeo ,mag_elam3d,geo_elam3d,'ELAM3D ') + call mag2geo_3d(emz3d ,ezgeo ,mag_emz3d ,geo_emz3d ,'EMZ3D ') + call mag2geo_3d(phim3d,phig3d,mag_phi3d ,geo_phi3d ,'PHIM3D ') +! +! Define ex,ey,ez on geographic subdomains for ionvel: + do j=lat0,lat1 + do i=lon0,lon1 + ex(:,i,j) = exgeo(i,j,:) + ey(:,i,j) = eygeo(i,j,:) + ez(:,i,j) = ezgeo(i,j,:) + poten(:,i,j) = phig3d(i,j,:) + enddo + enddo + +! ex,ey,ez(nlev,lon0-2,lon1+2,lat0:lat1) + if (debug) then + write(iulog,"('pefield after mag2geo: ex=',2e12.4,' ey=',2e12.4,' ez=',2e12.4)") & + minval(ex(:,lon0:lon1,:)),maxval(ex(:,lon0:lon1,:)), & + minval(ey(:,lon0:lon1,:)),maxval(ey(:,lon0:lon1,:)), & + minval(ez(:,lon0:lon1,:)),maxval(ez(:,lon0:lon1,:)) + endif + + call savefld_waccm_switch(poten(1:nlev,lon0:lon1,lat0:lat1),'POTEN',& + nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(ex(1:nlev,lon0:lon1,lat0:lat1),'EX',& + nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(ey(1:nlev,lon0:lon1,lat0:lat1),'EY',& + nlev,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(ez(1:nlev,lon0:lon1,lat0:lat1),'EZ',& + nlev,lon0,lon1,lat0,lat1) + + end subroutine pefield +!----------------------------------------------------------------------- + subroutine ionvel(z,ui,vi,wi) +! +! Calculate 3d ExB ion drifts from electric field (sub pefield) +! on geographic grid. +! + use edyn_params ,only: re + use edyn_geogrid ,only: nlev + use getapex ,only: & + rjac ,& ! (nlon+1,jspole:jnpole,2,2) + bmod ,& ! magnitude of magnetic field (nlon+1,jspole:jnpole) + xb,yb,zb ! north,east,down magnetic field (nlon+1,jspole:jnpole) +! +! Args: + real(r8),intent(in),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + z ! geopotential from input (cm) + real(r8),intent(out),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + ui,vi,wi +! +! Local: + integer :: i,ii,k,j + real(r8),dimension(lev0:lev1,lon0:lon1) :: eex,eey,eez + real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: rjac_out + real(r8),dimension(lon0:lon1,nlev) :: diag_ik + +! mag field diagnostics + call savefld_waccm_switch(bmod(lon0:lon1,lat0:lat1),'BMOD',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(xb(lon0:lon1,lat0:lat1),'XB',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(yb(lon0:lon1,lat0:lat1),'YB',1,lon0,lon1,lat0,lat1) + call savefld_waccm_switch(zb(lon0:lon1,lat0:lat1),'ZB',1,lon0,lon1,lat0,lat1) + +! +! Scan geographic latitude subdomain: +! + do j=lat0,lat1 + do i=lon0,lon1 + ii = i + do k=lev0,lev1 + eex(k,i) = (rjac(ii,j,1,1)*ex(k,i,j)+ & + rjac(ii,j,2,1)*ey(k,i,j))/(re+z(k,i,j)) + eey(k,i) = (rjac(ii,j,1,2)*ex(k,i,j)+ & + rjac(ii,j,2,2)*ey(k,i,j))/(re+z(k,i,j)) + enddo ! k=lev0,lev1 + enddo +! + do i=lon0,lon1 + do k=lev0+1,lev1-1 + eez(k,i) = ez(k,i,j)/(z(k+1,i,j)-z(k-1,i,j)) + enddo ! k=lev0+1,lev1-1 + enddo +! +! Extrapolate for lower and upper boundaries: + do i=lon0,lon1 + eez(lev0,i) = 2._r8*eez(2,i)-eez(3,i) + eez(lev1,i) = 2._r8*eez(lev1-1,i)-eez(lev1-2,i) + enddo + + if (debug.and.masterproc) then + write(iulog,"('ionvel: j=',i4,' eex=',2e12.4,' eey=',2e12.4,' eez=',2e12.4)") & + j,minval(eex),maxval(eex),minval(eey),maxval(eey),minval(eez),maxval(eez) + endif + +! +! ion velocities = (e x b/b**2) (x 1.e6 for m/sec) +! ui = zonal, vi = meridional, wi = vertical +! + do k=lev0,lev1 + do i=lon0,lon1 + ii = i + ui(k,i,j) = -(eey(k,i)*zb(ii,j)+eez(k,i)*xb(ii,j))* & + 1.e6_r8/bmod(ii,j)**2 + vi(k,i,j) = (eez(k,i)*yb(ii,j)+eex(k,i)*zb(ii,j))* & + 1.e6_r8/bmod(ii,j)**2 + wi(k,i,j) = (eex(k,i)*xb(ii,j)-eey(k,i)*yb(ii,j))* & + 1.e6_r8/bmod(ii,j)**2 + enddo ! i=lon0,lon1 + enddo ! k=lev0,lev1 + + if (debug.and.masterproc) then + write(iulog,"('ionvel: j=',i4,' ui=',2e12.4,' vi=',2e12.4,' wi=',2e12.4)") & + j,minval(ui),maxval(ui),minval(vi),maxval(vi),minval(wi),maxval(wi) + endif +! +! Output ion drifts in cm/s for oplus_xport call from dpie_coupling: + do i=lon0,lon1 + ui(:,i,j) = ui(:,i,j)*100._r8 + vi(:,i,j) = vi(:,i,j)*100._r8 + wi(:,i,j) = wi(:,i,j)*100._r8 + enddo + enddo ! j=lat0,lat1 + + if (debug.and.masterproc) then + write(iulog,"('ionvel: ion drifts on geo grid: ui=',2e12.4,' vi=',2e12.4,' wi=',2e12.4)") & + minval(ui),maxval(ui), minval(vi),maxval(vi), minval(wi),maxval(wi) + endif + + if (hist_fld_active('RJAC11')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,1) + end do + call savefld_waccm_switch(rjac_out,'RJAC11',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC12')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,2) + end do + call savefld_waccm_switch(rjac_out,'RJAC12',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC21')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,1) + end do + call savefld_waccm_switch(rjac_out,'RJAC21',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC22')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,2) + end do + call savefld_waccm_switch(rjac_out,'RJAC22',nlev,lon0,lon1,lat0,lat1) + endif + + end subroutine ionvel +!----------------------------------------------------------------------- + subroutine mag2geo_3d(fmag,fgeo,ESMF_mag,ESMF_geo,fname) +! +! Convert field on geomagnetic grid fmag to geographic grid in fgeo. +! + use edyn_esmf,only: edyn_esmf_set3d_mag,edyn_esmf_regrid,edyn_esmf_get_3dfield + use edyn_geogrid,only: nlev +! +! Args: +! integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlev,lon0,lon1,lat0,lat1,nlev + character(len=*) :: fname + type(ESMF_Field),intent(inout) :: ESMF_mag, ESMF_geo + real(r8),intent(in) :: fmag(mlon0:mlon1,mlat0:mlat1,nmlev) + real(r8),intent(out) :: fgeo(lon0:lon1,lat0:lat1,nlev) +! +! Local: + integer :: j + character(len=8) :: fnames(1) + type(ESMF_Field) :: magfields(1) + real(r8),pointer,dimension(:,:,:) :: fptr + + fgeo = finit + fnames(1) = fname + magfields(1) = ESMF_mag +! +! Put fmag into ESMF mag field on mag source grid: + call edyn_esmf_set3d_mag(magfields,fnames,fmag,1,1,nmlev,mlon0,mlon1,mlat0,mlat1) +! +! Regrid to geographic destination grid, defining ESMF_geo: + call edyn_esmf_regrid(ESMF_mag,ESMF_geo,'mag2geo',3) +! +! Put regridded geo field into pointer: + call edyn_esmf_get_3dfield(ESMF_geo,fptr,fname) +! +! Transfer from pointer to output arg: + do j=lat0,lat1 + fgeo(:,j,:) = fptr(:,j,:) + enddo + end subroutine mag2geo_3d +#endif + +!----------------------------------------------------------------------- +end module edynamo diff --git a/src/ionosphere/waccmx/filter.F90 b/src/ionosphere/waccmx/filter.F90 new file mode 100644 index 0000000000..4a8bce29d8 --- /dev/null +++ b/src/ionosphere/waccmx/filter.F90 @@ -0,0 +1,230 @@ +module filter_module + use shr_kind_mod,only: r8 => shr_kind_r8 + use cam_logfile ,only: iulog + use edyn_geogrid,only: nlon, nlat + + implicit none + private + public :: ntrigs, ifax + public :: filter_init + public :: filter1, filter2 + public :: kut1, kut2 +! +! Coefficients and factors for fft. Sub setfft is called once per run from edyn_init +! + integer :: ntrigs ! = 3*nlon/2+1 + real(r8), allocatable :: trigs(:) + integer :: ifax(13) +!-------------------------------------------------------------------------- +! +! For filter1: +! +! This is used by TIEGCM for basic filtering (t,u,v, et.al.), +! when nlat=72 (2.5 deg res): +! +! integer,parameter :: kut(nlat) = +! | (/1 ,1 ,2 ,2 ,4 ,4 ,8 ,8 ,10 ,10 ,12 ,12, +! | 15 ,15 ,18 ,18 ,22 ,22 ,26 ,26 ,30 ,30 ,32 ,32, +! | 34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34, +! | 34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34, +! | 32 ,32 ,30 ,30 ,26 ,26 ,22 ,22 ,18 ,18 ,15 ,15, +! | 12 ,12 ,10 ,10 ,8 ,8 ,4 ,4 ,2 ,2 ,1 ,1/) + + integer, allocatable, protected :: kut1(:) + integer, allocatable, protected :: kut2(:) + + integer, parameter :: nxlat = 96 + integer,parameter :: kut1_x(nxlat) = & + (/0 ,0 ,0 ,0 ,1 ,1 ,1 ,1 ,2 ,2 ,2 ,2 , & + 3 ,3 ,3 ,3 ,4 ,4 ,4 ,4 ,6 ,6 ,6 ,6 , & + 8 ,8 ,8 ,8 ,10 ,10 ,10 ,10 ,12 ,12 ,12 ,12, & + 16 ,16 ,18 ,18 ,20 ,20 ,22 ,22 ,24 ,24 ,26 ,26, & + 26 ,26 ,24 ,24 ,22 ,22 ,20 ,20 ,18 ,18 ,16 ,16, & + 12 ,12 ,12 ,12 ,10 ,10 ,10 ,10 ,8 ,8 ,8 ,8 , & + 6 ,6 ,6 ,6 ,4 ,4 ,4 ,4 ,3 ,3 ,3 ,3 , & + 2 ,2 ,2 ,2 ,1 ,1 ,1 ,1 ,0 ,0 ,0 ,0 /) +!-------------------------------------------------------------------------- +! +! For filter2: +! +! This is used by TIEGCM for O+ filtering when nlat=72 (2.5 deg res): +! +! kut2=(/0, 0, 1, 2, 4, 4, 6, 6, 8, 8,10,10,12,12,15,15,18,18, +! | 20,20,20,20,18,18,15,12, 8, 8, 4, 4, 4, 4, 2, 2, 1, 1, +! | 1, 1, 2, 2, 4, 4, 4, 4, 8, 8,12,15,18,18,20,20,20,20, +! | 18,18,15,15,12,12,10,10, 8, 8, 6, 6, 4, 4, 2, 1, 0, 0/) ! 2.5 deg +! +! nn=(/90,90,40,40,22,22,14,14,10,10, 8, 8, 6, 6, 4, 4, 2, 2, +! | 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, +! | 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, +! | 2, 2, 4, 4, 6, 6, 8, 8,10,10,14,14,22,22,40,40,90,90/) ! 2.5 deg +! +! At 1.9 deg resolution, nlat==96 +! + integer, parameter :: kut2_x(nxlat) = & + (/ 0, 0, 0, 0, 1, 2, 3, 4, 5, 5, 6, 7, & + 8, 8, 9, 10, 11, 11, 13, 14, 15, 16, 17, 18, & + 19, 19, 20, 20, 19, 19, 18, 17, 15, 13, 10, 8, & + 7, 5, 4, 4, 4, 3, 3, 2, 1, 1, 1, 1, & + 1, 1, 1, 1, 2, 3, 3, 4, 4, 4, 5, 7, & + 8, 10, 13, 15, 17, 18, 19, 19, 20, 20, 19, 19, & + 18, 17, 16, 15, 14, 13, 11, 11, 10, 9, 8, 8, & + 7, 6, 5, 5, 4, 3, 2, 1, 0, 0, 0, 0 /) + + integer, parameter :: nn(nxlat) = & + (/255, 171, 104, 60, 42, 32, 26, 20, 17, 15, 12, 11, & + 9, 9, 8, 7, 6, 6, 5, 4, 3, 3, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 2, 3, 3, 4, 5, 6, 6, 7, 8, 9, 9, & + 11, 12, 15, 17, 20, 26, 32, 42, 60, 104, 171, 255 /) + + contains +!----------------------------------------------------------------------- + subroutine filter_init + use interpolate_data, only : lininterp + real(r8) :: xlats(nxlat), lats(nlat), kut1_out(nlat), kut2_out(nlat) + integer :: i + + ntrigs = 3*nlon/2+1 + allocate(trigs(ntrigs),kut1(nlat),kut2(nlat)) + + call set99(trigs,ifax,nlon) ! initialize fft for O+ polar filtering + + do i = 1,nlat + lats(i) = -90._r8 + (i-1)*(180._r8/(nlat-1)) + enddo + + do i = 1,nxlat + xlats(i) = -90._r8 + (i-1)*(180._r8/(nxlat-1)) + end do + + call lininterp( dble(kut1_x), xlats, nxlat, kut1_out, lats, nlat ) + call lininterp( dble(kut2_x), xlats, nxlat, kut2_out, lats, nlat ) + + kut1 = int( kut1_out ) + kut2 = int( kut2_out ) + + end subroutine filter_init +!----------------------------------------------------------------------- + subroutine filter1(f,lev0,lev1,lat) +! +! Remove longitudinal waves of prognostic variables with global fft. +! Remove wave numbers greater than kut(nlat). This is called after +! mp_gatherlons, and only by tasks with mytidi==0. On entry, task must +! have global longitude data defined (mp_gatherlons). +! +! Args: + integer,intent(in) :: lev0,lev1,lat + real(r8),intent(inout) :: f(nlon,lev0:lev1) +! +! Local: + integer :: n1,n2,k,i,nlevs + real(r8) :: fx(nlon+2,lev1-lev0+1), wfft(nlon+1,lev1-lev0+1) + + nlevs = lev1-lev0+1 + n1 = 2*kut1(lat)+3 ! nyquist freq (?) + n2 = nlon+2 + if (n1 > n2) then + write(iulog,"('filter1: lat=',i2,' kutj=',i2,' n1,2=',2i3,' n1 > n2')") & + lat,kut1(lat),n1,n2 + return + endif +! +! Load fx from f for the fft: + fx(:,:) = 0._r8 + do k=lev0,lev1 + do i=1,nlon + fx(i,k) = f(i,k) + enddo + enddo + + call fft991(fx, wfft, trigs, ifax,1,nlon+2,nlon,nlevs,-1) +! +! Remove wave numbers greater than kut(lat) + do k = 1,nlevs + do i=n1,n2 + fx(i,k) = 0.0_r8 + enddo + enddo +! +! Inverse transform fourier back to gridpoint: +! + call fft991(fx, wfft, trigs, ifax,1,nlon+2,nlon,nlevs,1) +! +! Redefine f from fx: + do k=lev0,lev1 + do i=1,nlon + f(i,k) = fx(i,k) + enddo + enddo + end subroutine filter1 +!----------------------------------------------------------------------- + subroutine filter2(f,lev0,lev1,lat) + use edyn_geogrid,only : dlamda +! +! Remove longitudinal waves of prognostic variables with global fft. +! Remove wave numbers greater than kut2(nlat). This is called after +! mp_gatherlons, and only by tasks with mytidi==0. On entry, task must +! have global longitude data defined (mp_gatherlons). +! +! Args: + integer,intent(in) :: lev0,lev1,lat + real(r8),intent(inout) :: f(nlon,lev0:lev1) +! +! Local: + integer :: n1,k,i,nlevs + real(r8) :: fx(nlon+2,lev1-lev0+1), wfft(nlon+1,lev1-lev0+1) + real(r8) :: smoothfunc,coslon +! + nlevs = lev1-lev0+1 +! +! Load local fx from inout f subdomain for the fft: +! + fx(:,:) = 0._r8 + do k=lev0,lev1 + do i=1,nlon + fx(i,k) = f(i,k) + enddo + enddo + + call fft991(fx, wfft, trigs, ifax,1,nlon+2,nlon,nlevs,-1) +! +! Wenbin's comments from TIEGCM: +! Change filters so that it does not over filtering at high latitudes, it will be the +! same as filter for low wavenumer, but wrapping up smoothly for large wavenumers, not a +! sharp transition, so there is still filtering effect in the lower latitudes +! Wenbin Wang 06/11/13 + n1=2*(kut2(lat)-1)+3 +! +! Multiply by smoothing function: +! Test coslon to avoid underflow in smoothfunc at the poles +! + + do k=lev0,lev1 + do i=n1,nlon + coslon = cos(((i-n1)/2._r8)*dlamda/2._r8) + if ((coslon<0.1_r8) .or. (coslon<0.9_r8 .and. nn(lat)>50)) then + fx(i,k) = 0._r8 + else + smoothfunc = coslon**(2*nn(lat)) + fx(i,k) = fx(i,k)*smoothfunc + endif + enddo ! i=1,nlon + enddo ! k=lev0,lev1 +! +! Inverse transform fourier back to gridpoint: +! + call fft991(fx, wfft, trigs, ifax,1,nlon+2,nlon,nlevs,1) +! +! Redefine f from fx: + do k=lev0,lev1 + do i=1,nlon + f(i,k) = fx(i,k) + enddo + enddo + end subroutine filter2 +!----------------------------------------------------------------------- +end module filter_module diff --git a/src/ionosphere/waccmx/getapex.F90 b/src/ionosphere/waccmx/getapex.F90 new file mode 100644 index 0000000000..4c9b3ee7f1 --- /dev/null +++ b/src/ionosphere/waccmx/getapex.F90 @@ -0,0 +1,341 @@ +module getapex +! +! Calculate quantities needed to transform scalar fields between geographic +! and geomagnetic coordinate systems. +! + use shr_kind_mod ,only : r8 => shr_kind_r8 + use cam_logfile ,only: iulog + use cam_abortutils ,only: endrun + use edyn_geogrid ,only: nlon,nlonp1,nlonp2,nlat,ylatg,ylong,dlong,& + jspole,jnpole + use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,ylatm,ylonm,dlonm + + implicit none + save + + private + + public :: get_apex + public :: magfield, bx, by, bz, bmod2, bmod, xb, yb, zb, be3arr, dddarr, dvec + public :: alatm, alonm, gdlondeg, gdlatdeg + public :: rjac + + integer :: & + ig(nmlonp1,nmlat), & ! geog lon grid containing each geomag point + jg(nmlonp1,nmlat) ! geog lat grid containing each geomag point + + real(r8) :: & + wt(4,nmlonp1,nmlat) ! interpolation weights for geo2mag + + real(r8),dimension(nmlonp1,nmlat) :: & ! geo lat,lon coords on mag grid + gdlatdeg, & ! geographic latitude of each magnetic grid point (deg) + gdlondeg ! geographic longitude of each magnetic grid point (deg) +! +! Variables on geographic grid needed by other modules must +! be allocated dynamically to be grid-independent (sub alloc_apex): +! + integer,allocatable :: & ! (nlonp1,jspole:jnpole)) + im(:,:), & ! geomag lon grid containing each geog point + jm(:,:) ! geomag lat grid containing each geog point + + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) + dim(:,:), & ! fraction in lon for grid interp + djm(:,:) ! fraction in lat for grid interp + + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole,3,2) + dvec(:,:,:,:) ! vectors from apxmall + + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) + dddarr(:,:), & ! from apxmall + be3arr(:,:) ! from apxmall + + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) + alatm(:,:), & ! geomagnetic latitude at each geographic grid point (radians) + alonm(:,:), & ! geomagnetic longitude at each geographic grid point (radians) + xb(:,:), & ! northward component of magnetic field + yb(:,:), & ! eastward component of magnetic field + zb(:,:), & ! downward component of magnetic field (gauss) + bmod(:,:) ! magnitude of magnetic field (gauss) +! +! rjac: scaled derivatives of geomagnetic coords wrt geographic coordinates. +! rjac(1,1) = cos(thetas)/cos(theta)*d(lamdas)/d(lamda) +! rjac(1,2) = cos(thetas)*d(lamdas)/d(theta) +! rjac(2,1) = 1./cos(theta)*d(thetas)/d(lamda) +! rjac(2,2) = d(thetas)/d(theta) +! where (lamda,theta) are geographic coordinates +! (lamdas,thetas) are geomagnetic coordinates +! + real(r8),allocatable :: & + rjac(:,:,:,:) ! (nlon+1,jspole:jnpole,2,2) +! +! Parameters defined by sub magfield (allocated in alloc_magfield): +! + real(r8),allocatable,dimension(:,:) :: & ! (0:nlon+1,jspole-1:jnpole+1) + bx,by,bz,bmod2 + + contains +!----------------------------------------------------------------------- + subroutine get_apex( ) +! +! This is called once per run from main. +! + use edyn_params,only: re_dyn,h0,hs,dtr,rtd + use apex, only: apex_mall,apex_q2g + use edyn_geogrid,only: glat_edyn_geo => glat, glon_edyn_geo => glon + +! +! Local: + integer :: i,j,ier,jjm,jjg + integer,parameter :: nalt=2 + real(r8) :: real8 + + real(r8) :: rekm,h0km,alt,hr,ror03,glat,glon,& + xlonmi,qdlon,qdlat,gdlon,gdlat,xlongi,frki,frkj + +! +! Non-scalar arguments returned by apxmall: + real(r8) :: & + b(3),bhat(3), & + d1(3),d2(3),d3(3), & + e1(3),e2(3),e3(3), & + f1(2),f2(2) + real(r8) :: bmag,alon,xlatm,vmp,w,d,be3,si,sim,xlatqd,f + +! +! Allocate arrays that are needed by other modules: + call alloc_apex + call alloc_magfield + + rekm = re_dyn*1.e-5_r8 ! earth radius (km) + h0km = h0*1.e-5_r8 + alt = hs*1.e-5_r8 ! modified apex reference altitude (km) + hr = alt + ror03= ((rekm + alt)/(rekm + h0km))**3 +! +! Loop over 2d geographic grid: +! + do j=jspole,jnpole + glat = glat_edyn_geo(j) + do i=1,nlonp1 + if (i.eq.nlonp1) then + glon = glon_edyn_geo(1) + else + glon = glon_edyn_geo(i) + endif + + call apex_mall ( & + glat,glon,alt,hr, & !Inputs + b,bhat,bmag,si, & !Mag Fld + alon, & !Apx Lon + xlatm,vmp,w,d,be3,sim,d1,d2,d3,e1,e2,e3, & !Mod Apx + xlatqd,f,f1,f2 , ier) !Qsi-Dpl + + if (ier /= 0) call endrun('get_apex: apxmall error') + + alatm(i,j) = xlatm*dtr + alonm(i,j) = alon *dtr + xb (i,j) = b(2)*1.e-5_r8 ! nT -> gauss + yb (i,j) = b(1)*1.e-5_r8 ! nT -> gauss + zb (i,j) = -b(3)*1.e-5_r8 ! nT -> gauss + bmod (i,j) = bmag*1.e-5_r8 ! nT -> gauss + + rjac (i,j,1,1) = f2(2) + rjac (i,j,1,2) = -f2(1) + rjac (i,j,2,1) = -f1(2) + rjac (i,j,2,2) = f1(1) +! +! Set up parameters for magnetic to geographic interpolation. +! + xlonmi = (alonm(i,j) - ylonm(1))/dlonm + real8 = dble(nmlon) + if (xlonmi < 0._r8) xlonmi = xlonmi + real8 + im(i,j) = xlonmi + real8 = dble(im(i,j)) + dim(i,j) = xlonmi - real8 + im(i,j) = im(i,j) + 1 + if (im(i,j) >= nmlonp1) im(i,j) = im(i,j) - nmlon + alatm(i,j) = min(alatm(i,j),ylatm(nmlat)) + do jjm=2,nmlat + if (alatm(i,j) > ylatm(jjm)) cycle + jm(i,j) = jjm - 1 + djm(i,j) = (alatm(i,j) - ylatm(jm(i,j)))/ & + (ylatm(jjm) - ylatm(jm(i,j))) + exit + enddo + if (j /= jspole .and. j /= jnpole) then + dvec(i,j,1,1) = d1(1) + dvec(i,j,2,1) = d1(2) + dvec(i,j,3,1) = d1(3) + dvec(i,j,1,2) = d2(1) + dvec(i,j,2,2) = d2(2) + dvec(i,j,3,2) = d2(3) + dddarr(i,j) = d +! +! Scale be3 from 130 km to a reference height of 90 km. + be3arr(i,j) = be3*ror03 + endif + enddo ! i=1,nlonp1 + enddo ! j=jspole,jnpole +! +! Set up parameters for geographic to magnetic interpolation + do i=1,nmlonp1 + qdlon = ylonm(i)*rtd + do j=1,nmlat + qdlat = ylatm(j)*rtd +! +! Convert from Quasi-Dipole to geographic coordinates. +! gdlat,gdlon are returned by apxq2g. +! + call apex_q2g(qdlat,qdlon,alt,gdlat,gdlon,ier) + if (ier /= 0) then + write(iulog,"(i3,i3,i3)") '>>> Error from apex_q2g: ier=',ier, & + ' i=',i,' j=',j + call endrun('get_apex: apex_q2g ier') + endif + gdlat = gdlat*dtr + gdlon = gdlon*dtr + xlongi = (gdlon - ylong(1))/dlong + real8 = dble(nlon) + if (xlongi < 0._r8) xlongi = xlongi + real8 + ig(i,j) = xlongi + real8 = dble(ig(i,j)) + frki = xlongi - real8 + ig(i,j) = ig(i,j) + 1 + if (ig(i,j) >= nlonp1) ig(i,j) = ig(i,j) - nlon + gdlat = min(gdlat,ylatg(jnpole)) + do jjg=1,jnpole + if (gdlat > ylatg(jjg)) cycle + jg(i,j) = jjg - 1 + frkj = (gdlat - ylatg(jg(i,j)))/(ylatg(jjg) - ylatg(jg(i,j))) +! +! 99/2/25b Add one to JG to account for the fact that AG in geo2mag has +! a second (J) index starting at 1, while the second index of the +! array in the calling arguments begins at 0. +! + jg(i,j) = jg(i,j) + 1 + exit + enddo + wt(1,i,j) = (1._r8 - frki)*(1._r8 - frkj) + wt(2,i,j) = frki *(1._r8 - frkj) + wt(3,i,j) = frki *frkj + wt(4,i,j) = (1._r8 - frki)*frkj +! +! gdlatdeg,gdlondeg will be coordY,coordX of the mag grid for ESMF +! regridding (see edyn_esmf.F) +! + gdlatdeg(i,j) = gdlat*rtd + gdlondeg(i,j) = gdlon*rtd + enddo ! j=1,nmlat + enddo ! i=1,nmlonp1 + end subroutine get_apex +!----------------------------------------------------------------------- + subroutine magfield +! +! Calculate magnetic field parameters (bx,by,bz) +! (see also TIEGCM magfield.F) +! This is called once per run and when crossing year boundary from edyn_init, after get_apex. +! All arrays are on the global domain, all processors execute. +! +! Local: + integer :: i,j +! +! QUESTION: in TIEGCM, dipmin is resolution dependent - how do we +! handle this for different resolutions in WACCM? +! +! real(r8),parameter :: dipmin=0.17 ! set for 5.0-deg TIEGCM (also known as sin10) + real(r8),parameter :: dipmin=0.24_r8 ! set for 2.5-deg TIEGCM (also known as sin10) + real(r8) :: cos10 + + cos10 = sqrt(1._r8-dipmin**2) + do j=jspole,jnpole ! 1,nlat + do i=1,nlon + bx(i,j) = yb(i,j)/bmod(i,j) + by(i,j) = xb(i,j)/bmod(i,j) + bz(i,j) = -zb(i,j)/bmod(i,j) + bmod2(i,j) = bmod(i,j) +! +! Set minimum dip to 10 degrees + if (abs(bz(i,j))-dipmin < 0._r8) then + bx(i,j) = bx(i,j)*(cos10/sqrt(1._r8-bz(i,j)**2)) + by(i,j) = by(i,j)*(cos10/sqrt(1._r8-bz(i,j)**2)) + bz(i,j) = sign(dipmin,bz(i,j)) + endif + enddo ! i=1,nlon + enddo ! j=jspole,jnpole + +! +! Values at jspole-1: + j=jspole-1 ! j=0 + do i=1,nlon + bx(i,j) = -bx(1+mod(i-1+nlon/2,nlon),jspole) + by(i,j) = -by(1+mod(i-1+nlon/2,nlon),jspole) + bz(i,j) = bz(1+mod(i-1+nlon/2,nlon),jspole) + bmod2(i,j) = bmod2(1+mod(i-1+nlon/2,nlon),jspole) + enddo +! +! Values at jnpole+1: + j=jnpole+1 ! j=nlat+1 + do i=1,nlon + bx(i,j) = -bx(1+mod(i-1+nlon/2,nlon),jnpole) + by(i,j) = -by(1+mod(i-1+nlon/2,nlon),jnpole) + bz(i,j) = bz(1+mod(i-1+nlon/2,nlon),jnpole) + bmod2(i,j) = bmod2(1+mod(i-1+nlon/2,nlon),jnpole) + enddo +! +! Periodic points: +! FIX: not sure about this, but +! I am following tiegcm, but with a single point on each end instead of 2 +! + do j=jspole-1,jnpole+1 + bx(nlonp1,j) = bx(1,j) + by(nlonp1,j) = by(1,j) + bz(nlonp1,j) = bz(1,j) + bmod2(nlonp1,j) = bmod2(1,j) + + bx(0,j) = bx(nlon,j) + by(0,j) = by(nlon,j) + bz(0,j) = bz(nlon,j) + bmod2(0,j) = bmod2(nlon,j) + enddo + + end subroutine magfield +!----------------------------------------------------------------------- + subroutine alloc_magfield + +!------------------------------------------------------------------------------------------ +! Do allocations, checking if previously allocated in case of year boundary crossing +!------------------------------------------------------------------------------------------ + if (.not.allocated(bx)) allocate(bx(0:nlonp1,jspole-1:jnpole+1)) + if (.not.allocated(by)) allocate(by(0:nlonp1,jspole-1:jnpole+1)) + if (.not.allocated(bz)) allocate(bz(0:nlonp1,jspole-1:jnpole+1)) + if (.not.allocated(bmod2)) allocate(bmod2(0:nlonp1,jspole-1:jnpole+1)) + + end subroutine alloc_magfield +!----------------------------------------------------------------------- + + subroutine alloc_apex + +!------------------------------------------------------------------------------------------ +! Do allocations, checking if previously allocated in case of year boundary crossing +!------------------------------------------------------------------------------------------ + if (.not.allocated(im)) allocate(im (nlonp1,jspole:jnpole)) + if (.not.allocated(jm)) allocate(jm (nlonp1,jspole:jnpole)) + if (.not.allocated(dim)) allocate(dim(nlonp1,jspole:jnpole)) + if (.not.allocated(djm)) allocate(djm(nlonp1,jspole:jnpole)) + + if (.not.allocated(xb)) allocate(xb (nlonp1,jspole:jnpole)) + if (.not.allocated(yb)) allocate(yb (nlonp1,jspole:jnpole)) + if (.not.allocated(zb)) allocate(zb (nlonp1,jspole:jnpole)) + if (.not.allocated(bmod)) allocate(bmod (nlonp1,jspole:jnpole)) + if (.not.allocated(alatm)) allocate(alatm(nlonp1,jspole:jnpole)) + if (.not.allocated(alonm))allocate(alonm(nlonp1,jspole:jnpole)) + + if (.not.allocated(dvec)) allocate(dvec (nlonp1,jspole:jnpole,3,2)) + if (.not.allocated(dddarr)) allocate(dddarr(nlonp1,jspole:jnpole)) + if (.not.allocated(be3arr)) allocate(be3arr(nlonp1,jspole:jnpole)) + + if (.not.allocated(rjac)) allocate(rjac(nlon+1,jspole:jnpole,2,2)) + + end subroutine alloc_apex +!----------------------------------------------------------------------- +end module getapex diff --git a/src/ionosphere/waccmx/heelis.F90 b/src/ionosphere/waccmx/heelis.F90 new file mode 100644 index 0000000000..1bc69be503 --- /dev/null +++ b/src/ionosphere/waccmx/heelis.F90 @@ -0,0 +1,273 @@ +module heelis + use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals + use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,ylonm,ylatm + use edyn_geogrid ,only: nlat,nlon + use edyn_params ,only: dtr,pi +! +! phihm and pfrac are output of this module: +! + use edyn_solve, only: phihm ! output high-latitude potential (nmlonp1,nmlat) + + implicit none + save + private + + public :: heelis_model + +! +! Auroral parameters (taken from aurora.F of timegcm): +! (dimension of 2 is for south,north hemispheres) +! + real(r8) :: & + offc(2) ,& ! + dskofc(2) ,& ! + phin(2) ,& ! night convection entrance in MLT converted to radians (f(By)) + phid(2) ,& ! dayside convection entrance in MLT converted to radians (f(By)) + psim(2) ,& ! night convection entrance in MLT converted to radians (f(By)) + psie(2) ,& ! + pcen(2) ,& ! + phidp0(2) ,& ! + phidm0(2) ,& ! + phinp0(2) ,& ! + phinm0(2) ,& ! + theta0(2) ,& ! convection reversal boundary in radians + rr1(2) ! +! +! Critical angles (radians south,north) of transition from edynamo +! potential to Heelis potential (taken from timegcm cons.F) +! + real(r8),parameter :: crit(2) = (/0.261799387_r8, 0.523598775_r8/) +! + + real(r8) :: byloc ! local By; now is just a hook, and set to 0. + real(r8), parameter :: h2deg = 15._r8 ! hour to degree + integer, parameter :: isouth = 1 + integer, parameter :: inorth = 2 + + contains +!----------------------------------------------------------------------- + subroutine heelis_model(ctpoten,sunlons) +! +! Driver for Heelis empirical model to calculate high-latitude potential. +! +! Args: + real(r8),intent(in) :: ctpoten ! cross-tail potential + real(r8),intent(in) :: sunlons(nlat) ! sun's location +! +! Set auroral parameters: +! + call heelis_init(ctpoten) +! +! Calculate the heelis potential phihm in geomagnetic coordinates: +! (potm calls sub flwv32) +! + call potm(sunlons) + + end subroutine heelis_model +!----------------------------------------------------------------------- + subroutine heelis_init(ctpoten) +! +! Auroral parameters for Heelis (taken from aurora.F of timegcm): +! +! This is called at every timestep because ctpoten may change with time. +! Time-dependent ctpoten (kV) is read from TIMEGCM and WACCM input files, +! unless it was provided as a constant by the user via namelist (namelist.F90). +! +! Args: + real(r8),intent(in) :: ctpoten ! cross-tail potential + + byloc = 0._r8 + + offc(:) = 1._r8*dtr + dskofc(:) = 0._r8 + phin(:) = 180._r8*dtr + + phid(isouth) = (9.39_r8 + 0.21_r8*byloc - 12._r8) * h2deg * dtr ! In keeping with TIE-GCM2.0, phid also changed in mo_aurora.F90 + phid(inorth) = (9.39_r8 - 0.21_r8*byloc - 12._r8) * h2deg * dtr + phin(isouth) = (23.50_r8 + 0.15_r8*byloc - 12._r8) * h2deg * dtr + phin(inorth) = (23.50_r8 - 0.15_r8*byloc - 12._r8) * h2deg * dtr + psim(:) = 0.44_r8 * ctpoten * 1000._r8 + psie(:) = -0.56_r8 * ctpoten * 1000._r8 + pcen(isouth) = (-0.168_r8 + 0.027_r8*byloc) * ctpoten * 1000._r8 + pcen(inorth) = (-0.168_r8 - 0.027_r8*byloc) * ctpoten * 1000._r8 + + phidp0(:) = 90._r8*dtr + phidm0(:) = 90._r8*dtr + phinp0(:) = 90._r8*dtr + phinm0(:) = 90._r8*dtr + rr1(:) = -2.6_r8 + theta0(:) = (-3.80_r8+8.48_r8*(ctpoten**0.1875_r8))*dtr + + end subroutine heelis_init +!----------------------------------------------------------------------- + subroutine potm(sunlons) + use edyn_params ,only: pi_dyn ! pi used in dynamo calculations +! +! Calculate heelis potential in geomagnetic coordinates. +! +! Args: + real(r8),intent(in) :: sunlons(nlat) +! +! Local: + integer :: j + real(r8),dimension(nmlon) :: dlat,dlon,ratio + integer,dimension(nmlon) :: iflag +! + ratio(:) = 1._r8 + do j=1,nmlat + iflag(:) = 1 ! must be updated at each j + dlat(:) = ylatm(j) + dlon(:) = ylonm(1:nmlon)-sunlons(1) +! +! flwv32 returns single-level Heelis potential in geomag coords: +! + if (abs(ylatm(j)) > pi_dyn/6._r8) then + call flwv32(dlat,dlon,ratio,iflag,nmlon,phihm(:,j)) + else + phihm(1:nmlon,j) = 0._r8 + endif + enddo ! j=1,nmlat +! +! Periodic point: + do j=1,nmlat + phihm(nmlonp1,j) = phihm(1,j) + enddo ! j=1,nmlat + end subroutine potm +!----------------------------------------------------------------------- + subroutine flwv32(dlat,dlon,ratio,iflag,nmlon,poten) +! +! Calculate heelis potential at current magnetic latitude mlat. +! + use edyn_params ,only: pi_dyn +! +! Args: + integer,intent(in) :: nmlon + integer,intent(inout) :: iflag(nmlon) + real(r8),dimension(nmlon),intent(in) :: dlat,dlon,ratio + real(r8),dimension(nmlon+1),intent(out) :: poten +! +! Local: + integer :: i,n,ihem + real(r8),parameter :: eps=1.e-6_r8 + real(r8) :: & + pi2,pih,sinthr1,psi(8),phirc,sinth0, & + ofdc,cosofc(2),sinofc(2),aslonc(2), & + phdpmx(2),phnpmx(2),phnmmx(2),phdmmx(2) + real(r8),dimension(nmlon) :: sinlat,coslat,sinlon,coslon,alon, & + colat,wk1,wk2,wk3,phifun,phifn2 + integer :: ifn(nmlon) + real(r8) :: phi(nmlon,8) +! + pi2 = 2.0_r8*pi_dyn + pih = 0.5_r8*pi_dyn + do n=1,2 +! + ofdc = sqrt(offc(n)**2+dskofc(n)**2) + cosofc(n) = cos(ofdc) + sinofc(n) = sin(ofdc) + aslonc(n) = asin(dskofc(n)/ofdc) +! + if (phin(n) < phid(n)) phin(n) = phin(n)+pi2 ! modifies aurora phin + phdpmx(n) = .5_r8*min(pi,(phin(n)-phid(n))) + phnpmx(n) = .5_r8*min(pi,(phid(n)-phin(n)+pi2)) + phnmmx(n) = phdpmx(n) + phdmmx(n) = phnpmx(n) + enddo ! n=1,2 +! +! Set ihem=1,2 for South,North hemisphere: +! + ihem = int(dlat(max0(1,nlon/2))*2._r8/3.1416_r8+2._r8) + sinth0 = sin(theta0(ihem)) +! +! Average amie results show r1=-2.6 for 11.3 degrees +! (0.1972 rad) beyond theta0. +! + sinthr1 = sin(theta0(ihem)+0.1972_r8) + psi(1) = psie(ihem) + psi(3) = psim(ihem) + do n=2,4,2 + psi(n) = psi(n-1) + enddo ! n=2,4,2 + do n=1,4 + psi(n+4) = psi(n) + enddo ! n=1,4 +! +! Transform to auroral circle coordinates: +! + do i=1,nmlon + sinlat(i) = sin(abs(dlat(i))) + coslat(i) = cos(dlat(i)) + sinlon(i) = sin(dlon(i)+aslonc(ihem)) + coslon(i) = cos(dlon(i)+aslonc(ihem)) + colat(i) = cosofc(ihem)*sinlat(i)-sinofc(ihem)*coslat(i)* & + coslon(i) + alon(i) = mod(atan2(sinlon(i)*coslat(i),sinlat(i)* & + sinofc(ihem)+cosofc(ihem)*coslat(i)*coslon(i))- & + aslonc(ihem)+3._r8*pi_dyn,pi2)-pi_dyn + colat(i) = acos(colat(i))*sqrt(ratio(i)) +! +! Boundaries for longitudinal function: +! + wk1(i) = ((colat(i)-theta0(ihem))/theta0(ihem))**2 + phi(i,4)=phid(ihem)+eps-min(phidm0(ihem)+wk1(i)* & + (pih-phidm0(ihem)),phdmmx(ihem)) + phi(i,5)=phid(ihem)-eps+min(phidp0(ihem)+wk1(I)* & + (pih-phidp0(ihem)),phdpmx(ihem)) + phi(i,6)=phin(ihem)+eps-min(phinm0(ihem)+wk1(i)* & + (pih-phinm0(ihem)),phnmmx(ihem)) + phi(i,7)=phin(ihem)-eps+min(phinp0(ihem)+wk1(i)* & + (pih-phinp0(ihem)),phnpmx(ihem)) + phi(i,1)=phi(i,5)-pi2 + phi(i,2)=phi(i,6)-pi2 + phi(i,3)=phi(i,7)-pi2 + phi(i,8)=phi(i,4)+pi2 + phifun(i)=0._r8 + phifn2(i) = 0._r8 + if (colat(i)-theta0(ihem) >= 0._r8) then + ifn(i) = 3 + else + ifn(i) = 2 + endif + if (iflag(i) == 1) iflag(i) = ifn(i) +! +! Add ring current rotation to potential (phirc) +! + phirc = 0._r8 + wk2(i) = mod(alon(i)+phirc+2._r8*pi2+pi_dyn,pi2)-pi_dyn + wk3(i) = mod(alon(i)+phirc+3._r8*pi2,pi2)-pi_dyn + enddo ! i=1,nmlon +! +! Longitudinal variation: +! + do n=1,7 + do i=1,nmlon + phifun(i)=phifun(i)+.25_r8*(psi(n)+psi(n+1)+(psi(n)- & + psi(n+1))*cos(mod(pi_dyn*(wk2(i)-phi(i,n))/(phi(i,n+1)- & + phi(i,n)),pi2)))*(1._r8-sign(1._r8,(wk2(i)-phi(i,n))* & + (wk2(i)-phi(i,n+1)))) + phifn2(i)=phifn2(i)+.25_r8*(psi(n)+psi(n+1)+(psi(n)- & + psi(n+1))*cos(mod(pi_dyn*(wk3(i)-phi(i,n))/(phi(i,n+1)- & + phi(i,n)),pi2)))*(1._r8-sign(1._r8,(wk3(i)-phi(i,n))* & + (wk3(i)-phi(i,n+1)))) + enddo + enddo +! +! Evaluate total potential: +! + + do i=1,nmlon + if (iflag(i)==2) then + poten(i) = (2._r8*(pcen(ihem)-phifun(i))+(phifun(i)-phifn2(i))* & + 0.75_r8)*(colat(i)/theta0(ihem))**3 + & + (1.5_r8*(phifun(i)+phifn2(i))-3._r8*pcen(ihem))*(colat(i)/ & + theta0(ihem))**2 + 0.75_r8*(phifun(i)-phifn2(i))*(colat(i)/ & + theta0(ihem)) + pcen(ihem) + else + poten(i) = phifun(i)*(max(sin(colat(i)),sinth0)/sinth0)**rr1(ihem)* & + exp(7._r8*(1._r8-max(sin(colat(i)),sinthr1)/sinthr1)) + endif + enddo + + end subroutine flwv32 +!----------------------------------------------------------------------- +end module heelis diff --git a/src/ionosphere/waccmx/ionosphere_interface.F90 b/src/ionosphere/waccmx/ionosphere_interface.F90 new file mode 100644 index 0000000000..7287234a78 --- /dev/null +++ b/src/ionosphere/waccmx/ionosphere_interface.F90 @@ -0,0 +1,1143 @@ +module ionosphere_interface + + use shr_kind_mod, only: r8 => shr_kind_r8 + use phys_grid, only: begchunk, endchunk, get_ncols_p + use pmgrid, only: plat, plon, plev + use ppgrid, only: pcols, pver + + use dpie_coupling, only: d_pie_init + use dpie_coupling, only: d_pie_epotent + use dpie_coupling, only: d_pie_coupling ! WACCM-X ionosphere/electrodynamics coupling + use short_lived_species, only: slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species + + use chem_mods, only: adv_mass ! Array holding mass values for short lived species + use mo_chem_utls, only: get_spc_ndx ! Routine to get index of adv_mass array for short lived species + use physics_buffer, only: pbuf_get_chunk, pbuf_get_field, pbuf_get_index + + use cam_abortutils, only: endrun + use constituents, only: cnst_get_ind, cnst_mw !Needed to access constituent molecular weights + use phys_grid, only: get_lon_all_p, get_lat_all_p, transpose_block_to_chunk, transpose_chunk_to_block + use phys_grid, only: chunk_to_block_send_pters, chunk_to_block_recv_pters, block_to_chunk_send_pters, & + block_to_chunk_recv_pters + use physconst, only: gravit + use oplus, only: oplus_init + use edyn_init, only: edynamo_init + use pio, only: var_desc_t + use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs + use dyn_internal_state, only: get_dyn_state_grid + use dynamics_vars, only: t_fvdycore_grid + use perf_mod + + implicit none + + private + + public :: ionosphere_readnl + public :: ionosphere_init + public :: ionosphere_run1 + public :: ionosphere_run2 + public :: ionosphere_init_restart + public :: ionosphere_write_restart + public :: ionosphere_read_restart + public :: ionosphere_final + + ! private data + + ! this needs to persist from time-step to time-step and across restarts + real(r8), allocatable :: opmmrtm1_blck(:,:,:) ! O+ at previous time step(blocks) + + type(var_desc_t) :: Optm1_vdesc + integer :: index_ped, index_hall, index_te, index_ti + integer :: index_ui, index_vi, index_wi + + integer :: ixo2=-1, ixo=-1, ixh=-1 + integer :: ixo2p=-1, ixnop=-1, ixn2p=-1, ixop=-1 + + ! indices for accessing ions in pbuf when non-advected + integer :: sIndxOp=-1, sIndxO2p=-1, sIndxNOp=-1, sIndxN2p=-1 + + real(r8) :: rmassO2 ! O2 molecular weight kg/kmol + real(r8) :: rmassO1 ! O atomic weight kg/kmol + real(r8) :: rmassH ! H atomic weight kg/kmol + real(r8) :: rmassN2 ! N2 molecular weight kg/kmol + real(r8) :: rmassO2p ! O2+ molecular weight kg/kmol + real(r8) :: rmassNOp ! NO+ molecular weight kg/kmol + real(r8) :: rmassN2p ! N2+ molecular weight kg/kmol + real(r8) :: rmassOp ! O+ molecular weight kg/kmol + + logical, public, protected :: ionos_edyn_active = .true. ! if true, edynamo will generate ion drifts + logical, public, protected :: ionos_xport_active = .true. ! if true, call d_pie_coupling from dp_coupling + ! + ! ionos_edyn_active = .true. will activate the edynamo which will generate ion drift velocities + ! used in oplus transport, otherwise empirical ion drifts calculated in exbdrift (physics) will be used. + ! + logical, public, protected :: ionos_oplus_xport = .true. ! if true, call sub oplus (based on tiegcm oplus.F) + integer, public, protected :: ionos_xport_nsplit = 5 ! number of substeps for O+ transport per model time step + + real(r8), public, protected :: oplus_adiff_limiter = 1.5e+8_r8 ! limiter for ambipolar diffusion coefficient + real(r8), public, protected :: oplus_shapiro_const = 0.03_r8 ! shapiro constant for spatial smoother + logical, public, protected :: oplus_enforce_floor = .true. ! switch to apply Stan's floor + + character(len=256) :: wei05_coefs_file = 'NONE' !'wei05sc.nc' + +contains + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_readnl( nlfile ) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical, mpi_integer, mpi_character + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use mag_parms, only: mag_parms_setopts + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'ionosphere_readnl' + character(len=16) :: ionos_epotential_model = 'none' + + namelist /ionosphere_nl/ ionos_xport_active, ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit + namelist /ionosphere_nl/ oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor + namelist /ionosphere_nl/ ionos_epotential_model, wei05_coefs_file + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'ionosphere_nl', status=ierr) + if (ierr == 0) then + read(unitn, ionosphere_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(ionos_xport_active, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_edyn_active, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_oplus_xport, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_xport_nsplit, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_adiff_limiter, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_epotential_model, len(ionos_epotential_model), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(wei05_coefs_file, len(wei05_coefs_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_shapiro_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_enforce_floor, 1, mpi_logical, masterprocid, mpicom, ierr) + + ! log the user settings + if (masterproc) then + write(iulog,*) 'ionosphere_readnl: ionos_xport_active = ', ionos_xport_active + write(iulog,*) 'ionosphere_readnl: ionos_edyn_active = ', ionos_edyn_active + write(iulog,*) 'ionosphere_readnl: ionos_oplus_xport = ', ionos_oplus_xport + write(iulog,*) 'ionosphere_readnl: ionos_xport_nsplit = ', ionos_xport_nsplit + write(iulog,*) 'ionosphere_readnl: ionos_epotential_model = ', trim(ionos_epotential_model) + write(iulog,*) 'ionosphere_readnl: oplus_adiff_limiter = ', oplus_adiff_limiter + write(iulog,*) 'ionosphere_readnl: oplus_shapiro_const = ', oplus_shapiro_const + write(iulog,*) 'ionosphere_readnl: oplus_enforce_floor = ', oplus_enforce_floor + endif + + call mag_parms_setopts(ionos_epotential_model) + + end subroutine ionosphere_readnl + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_init() + use cam_history, only: addfld, add_default + use mo_apex, only: mo_apex_init1 + use cam_control_mod,only: initial_run + use dyn_grid, only: get_horiz_grid_d + use wei05sc, only: weimer05_init + + use ref_pres, only : & ! Hybrid level definitions: + pref_mid, & ! target alev(plev) midpoint levels coord + pref_edge ! target ailev(plevp) interface levels coord + + ! local variables: + type (t_fvdycore_grid), pointer :: grid + integer :: sIndx + + integer :: mpicomm ! MPI communicator + integer :: ntaski, ntaskj ! number of MPI tasks in lon,lat dimensions + integer :: lat0,lat1 ! first and last latitude indices + integer :: lon0,lon1 ! first and last longitude indices + integer :: lev0,lev1 ! first and last pressure indices + real(r8), allocatable :: glon(:) ! global geo-graphic longitudes (degrees) + real(r8), allocatable :: glat(:) ! global geo-graphic latitudes (degrees) + + if (initial_run) then + call ionosphere_read_ic() + endif + + call mo_apex_init1() + + op_transport: if (ionos_xport_active) then + + grid => get_dyn_state_grid() + + index_ped = pbuf_get_index('PedConduct') + index_hall = pbuf_get_index('HallConduct') + + index_te = pbuf_get_index('TElec') + index_ti = pbuf_get_index('TIon') + ! + ! pbuf indices to empirical ion drifts, to be passed to oplus_xport, + ! if ionos_edyn_active is false. + ! + index_ui = pbuf_get_index('UI') + index_vi = pbuf_get_index('VI') + index_wi = pbuf_get_index('WI') + + !----------------------------------------------------------------------- + ! Get indices for neutrals to get mixing ratios from state%q and masses + !----------------------------------------------------------------------- + call cnst_get_ind('O2' ,ixo2 ) + call cnst_get_ind('O' ,ixo ) + call cnst_get_ind('H' ,ixh ) + !------------------------------------ + ! Get neutral molecular weights + !------------------------------------ + rmassO2 = cnst_mw(ixo2) + rmassO1 = cnst_mw(ixo) + rmassH = cnst_mw(ixh) + rmassN2 = 28._r8 + + call cnst_get_ind('Op',ixop, abort=.false.) + if (ixop > 0) then + rMassOp = cnst_mw(ixop) + else + sIndxOp = slvd_index( 'Op' ) + if (sIndxOp > 0) then + sIndx = get_spc_ndx( 'Op' ) + rmassOp = adv_mass(sIndx) + else + call endrun('ionosphere_init: Cannot find state or pbuf index for Op') + endif + endif + + call cnst_get_ind('O2p',ixo2p, abort=.false.) + if (ixo2p > 0) then + rMassO2p = cnst_mw(ixo2p) + else + sIndxO2p = slvd_index( 'O2p' ) + if (sIndxO2p > 0) then + sIndx = get_spc_ndx( 'O2p' ) + rmassO2p = adv_mass(sIndx) + else + call endrun('ionosphere_init: Cannot find state or pbuf index for O2p') + endif + endif + + call cnst_get_ind('NOp',ixnop, abort=.false.) + if (ixnop > 0) then + rMassNOp = cnst_mw(ixnop) + else + sIndxNOp = slvd_index( 'NOp' ) + if (sIndxNOp > 0) then + sIndx = get_spc_ndx( 'NOp' ) + rmassNOp = adv_mass(sIndx) + else + call endrun('ionosphere_init: Cannot find state or pbuf index for NOp') + endif + endif + + call cnst_get_ind('N2p',ixn2p, abort=.false.) + if (ixn2p > 0) then + rMassN2p = cnst_mw(ixn2p) + else + sIndxN2p = slvd_index( 'N2p' ) + if (sIndxN2p > 0) then + sIndx = get_spc_ndx( 'N2p' ) + rmassN2p = adv_mass(sIndx) + else + call endrun('ionosphere_init: Cannot find state or pbuf index for N2p') + endif + endif + + call d_pie_init( ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit ) + if ( grid%iam < grid%npes_xy ) then + + allocate(glon(plon)) + allocate(glat(plat)) + call get_horiz_grid_d( plon, lon_d_out=glon ) + call get_horiz_grid_d( plat, lat_d_out=glat ) + + mpicomm = grid%commxy + lon0 = grid%ifirstxy ; lon1 = grid%ilastxy + lat0 = grid%jfirstxy ; lat1 = grid%jlastxy + lev0 = 1 ; lev1 = grid%km + ntaski = grid%nprxy_x + ntaskj = grid%nprxy_y + + call edynamo_init( mpicomm, plon, plat, plev, lon0,lon1,lat0,lat1,lev0,lev1, ntaski,ntaskj, & + glon, glat, pref_mid,pref_edge) + call ionosphere_alloc() + call oplus_init( oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor ) + + deallocate(glon,glat) + endif + + if (sIndxOp > 0) then + call addfld ('Op&IC', (/ 'lev' /),'I','kg/kg','O+',gridname='physgrid') + call add_default ('Op&IC',0, 'I') + endif + call addfld ('OpTM1&IC', (/ 'lev' /),'I','kg/kg','O+ at time step minus 1',gridname='fv_centers') + call add_default ('OpTM1&IC',0, 'I') + + endif op_transport + + if (ionos_edyn_active) then + call addfld ('UI',(/ 'lev' /),'I','m/s', 'UI Zonal ion drift from edynamo') + call addfld ('VI',(/ 'lev' /),'I','m/s', 'VI Meridional ion drift from edynamo') + call addfld ('WI',(/ 'lev' /),'I','m/s', 'WI Vertical ion drift from edynamo') + call addfld ('UI&IC', (/ 'lev' /), 'I','m/s', 'Zonal ion drift velocity') + call addfld ('VI&IC', (/ 'lev' /), 'I','m/s', 'Meridional ion drift velocity') + call addfld ('WI&IC', (/ 'lev' /), 'I','m/s', 'Vertical ion drift velocity') + call add_default ('UI&IC', 0, ' ') + call add_default ('VI&IC', 0, ' ') + call add_default ('WI&IC', 0, ' ') + endif + + call weimer05_init(wei05_coefs_file) + + end subroutine ionosphere_init + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_run1(pbuf2d) + use physics_buffer, only: physics_buffer_desc + use cam_history , only: outfld, write_inithist + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + integer :: i, j, k, lchnk ! indices + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km, idim + real(r8), allocatable :: tmp(:,:) + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + real(r8),pointer :: Op_phys(:,:) ! Pointer to access O+ in pbuf + + type(t_fvdycore_grid), pointer :: grid + + if( write_inithist() .and. ionos_xport_active ) then + + grid => get_dyn_state_grid() + + allocate( tmp(grid%ifirstxy:grid%ilastxy,grid%km) ) + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + + idim = ilastxy - ifirstxy + 1 + do j = jfirstxy, jlastxy + do k = 1, km + do i = ifirstxy, ilastxy + tmp(i,k) = opmmrtm1_blck(i,j,k) + enddo + enddo + call outfld ('OpTM1&IC', tmp, idim, j) + enddo + + if (sIndxOp > 0) then + do lchnk = begchunk,endchunk + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, Op_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + call outfld ('Op&IC', Op_phys, pcols,lchnk ) + enddo + endif + + deallocate( tmp ) + + endif + + ! set cross tail potential before physics -- aurora uses weimer derived potential + call d_pie_epotent() + + end subroutine ionosphere_run1 + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_run2( phys_state, dyn_in, pbuf2d ) + + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use dyn_comp, only: dyn_import_t + use cam_history, only: outfld, write_inithist + + ! - pull some fields from pbuf and dyn_in + ! - invoke ionosphere/electro-dynamics coupling + ! - push some fields back to physics via pbuf... + + ! args + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(dyn_import_t), intent(inout) :: dyn_in ! dynamics inputs + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + integer :: i,j,k, lchnk + integer :: astat + + integer, allocatable, dimension(:,:) :: bpter + ! offsets into block buffer for packing data + integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + real(r8), allocatable, dimension(:) :: bbuffer, cbuffer + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + real(r8), pointer :: sigma_ped_phys(:,:) ! physics pointer to Pedersen Conductivity + real(r8), pointer :: sigma_hall_phys(:,:) ! physics pointer fo Hall Conductivity + real(r8), pointer :: te_phys(:,:) ! te from pbuf + real(r8), pointer :: ti_phys(:,:) ! ti from pbuf + real(r8), pointer :: mmrPO2p_phys(:,:) ! Pointer to access O2+ in pbuf + real(r8), pointer :: mmrPNOp_phys(:,:) ! Pointer to access NO+ in pbuf + real(r8), pointer :: mmrPN2p_phys(:,:) ! Pointer to access N2+ in pbuf + real(r8), pointer :: mmrPOp_phys(:,:) ! Pointer to access O+ in pbuf +! +! Empirical ion drifts from exbdrift (to be converted to blocked for dpie_coupling): + real(r8), pointer :: ui_phys(:,:) ! zonal ion drift from pbuf + real(r8), pointer :: vi_phys(:,:) ! meridional ion drift from pbuf + real(r8), pointer :: wi_phys(:,:) ! vertical ion drift from pbuf + + real(r8), pointer :: o2pmmr_blck(:,:,:) => null() ! O2+ (blocks) + real(r8), pointer :: nopmmr_blck(:,:,:) => null() ! NO+ (blocks) + real(r8), pointer :: n2pmmr_blck(:,:,:) => null() ! N2+ (blocks) + real(r8), pointer :: opmmr_blck(:,:,:) => null() ! O+ (blocks) + + real(r8), pointer :: tracer(:,:,:,:) + real(r8), pointer :: u3s(:,:,:) + real(r8), pointer :: v3s(:,:,:) + real(r8), pointer :: pexy(:,:,:) + + real(r8), pointer :: phis(:,:) ! surface geopotential + + real(r8), pointer :: o2mmr_blck(:,:,:) + real(r8), pointer :: o1mmr_blck(:,:,:) + real(r8), pointer :: h1mmr_blck(:,:,:) + + integer :: ib, ic, jc, ifirstxy, ilastxy, jfirstxy, jlastxy, km, ncol + + integer :: lats(pcols) ! array of latitude indices + integer :: lons(pcols) ! array of longitude indices + integer :: nSIons ! number of ions set to non-advected + integer :: ibuffOp,ibuffO2p,ibuffNOp, ibuffN2p ! Buffer indices for non-advected ions + + integer :: blksiz ! number of columns in 2D block + integer :: tsize ! amount of data per grid point passed to physics + integer :: iam + + real(r8), allocatable :: wuxy(:,:,:) + real(r8), allocatable :: wvxy(:,:,:) + real(r8), allocatable :: sigma_ped_blck (:,:,:) + real(r8), allocatable :: sigma_hall_blck(:,:,:) + real(r8), allocatable :: ti_blck(:,:,:) + real(r8), allocatable :: te_blck(:,:,:) + real(r8), allocatable :: zi_blck(:,:,:) + real(r8), allocatable :: zm_blck(:,:,:) + real(r8), allocatable :: ui_blck(:,:,:) + real(r8), allocatable :: vi_blck(:,:,:) + real(r8), allocatable :: wi_blck(:,:,:) + real(r8), allocatable :: omega_blck(:,:,:) + real(r8), allocatable :: tn_blck(:,:,:) + + type (t_fvdycore_grid), pointer :: grid + + ionos_cpl: if (ionos_xport_active) then + + grid => get_dyn_state_grid() + iam = grid%iam + + allocate( wuxy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( wvxy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( sigma_ped_blck (grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( sigma_hall_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( ti_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( te_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( zi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( zm_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( ui_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( vi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( wi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( omega_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + allocate( tn_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) + + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + + phis => dyn_in%phis + + tracer => dyn_in%tracer + pexy => dyn_in%pe + + u3s => dyn_in%u3s + v3s => dyn_in%v3s + + if (iam < grid%npes_xy) then + call d2a3dijk( grid, u3s, v3s, wuxy, wvxy ) + endif + + if (sIndxOp>0) then + allocate(opmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) + if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate opmmr_blck') + endif + if (sIndxO2p>0) then + allocate(o2pmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) + if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate o2pmmr_blck') + endif + if (sIndxNOp>0) then + allocate(nopmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) + if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate nopmmr_blck') + endif + if (sIndxN2p>0) then + allocate(n2pmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) + if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate n2pmmr_blck') + endif + + phys2blcks_local: if (local_dp_map) then + + do lchnk = begchunk,endchunk + + ncol = get_ncols_p(lchnk) + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + ! Get Pedersen and Hall conductivities: + call pbuf_get_field(pbuf_chnk, index_ped, sigma_ped_phys) + call pbuf_get_field(pbuf_chnk, index_hall, sigma_hall_phys) + do k=1,km + do i=1,ncol + sigma_ped_blck(lons(i),lats(i),k) = sigma_ped_phys(i,k) + sigma_hall_blck(lons(i),lats(i),k) = sigma_hall_phys(i,k) + end do + enddo + + ! Get ion and electron temperatures + call pbuf_get_field(pbuf_chnk, index_te, te_phys) + call pbuf_get_field(pbuf_chnk, index_ti, ti_phys) + do k=1,km + do i=1,ncol + te_blck(lons(i),lats(i),k) = te_phys(i,k) + ti_blck(lons(i),lats(i),k) = ti_phys(i,k) + end do + enddo + + ! Get components of ion drift velocities + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + do k=1,km + do i=1,ncol + ui_blck(lons(i),lats(i),k) = ui_phys(i,k) + vi_blck(lons(i),lats(i),k) = vi_phys(i,k) + wi_blck(lons(i),lats(i),k) = wi_phys(i,k) + zi_blck(lons(i),lats(i),k) = phys_state(lchnk)%zi(i,k) + zm_blck(lons(i),lats(i),k) = phys_state(lchnk)%zm(i,k) + omega_blck(lons(i),lats(i),k) = phys_state(lchnk)%omega(i,k) + tn_blck(lons(i),lats(i),k) = phys_state(lchnk)%t(i,k) + enddo + enddo + + !-------------------------------------------------------- + ! Get ions from physics buffer if non-transported + !-------------------------------------------------------- + if (sIndxO2p > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPO2p_phys, & + start=(/1,1,sIndxO2p/), kount=(/pcols,pver,1/) ) + do k=1,km + do i=1,ncol + o2pmmr_blck(lons(i),lats(i),k) = mmrPO2p_phys(i,k) + end do + enddo + endif + if (sIndxNOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPNOp_phys, & + start=(/1,1,sIndxNOp/), kount=(/pcols,pver,1/) ) + do k=1,km + do i=1,ncol + nopmmr_blck(lons(i),lats(i),k) = mmrPNOp_phys(i,k) + end do + enddo + endif + if (sIndxN2p > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPN2p_phys, & + start=(/1,1,sIndxN2p/), kount=(/pcols,pver,1/) ) + do k=1,km + do i=1,ncol + n2pmmr_blck(lons(i),lats(i),k) = mmrPN2p_phys(i,k) + end do + enddo + endif + if (sIndxOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + do k=1,km + do i=1,ncol + opmmr_blck(lons(i),lats(i),k) = mmrPOp_phys(i,k) + end do + enddo + endif + + enddo ! do lchnk = begchunk,endchunk + + else ! phys2blcks_local + + tsize = 11 + + nSIons = 0 + if (sIndxOp > 0) then + ibuffOp = tsize + nSIons + nSIons = nSIons + 1 + endif + if (sIndxO2p > 0) then + ibuffO2p = tsize + nSIons + nSIons = nSIons + 1 + endif + if (sIndxNOp > 0) then + ibuffNOp = tsize + nSIons + nSIons = nSIons + 1 + endif + if (sIndxN2p > 0) then + ibuffN2p = tsize + nSIons + nSIons = nSIons + 1 + endif + tsize = tsize + nSIons + + blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) + allocate(bpter(blksiz,0:km)) + allocate(bbuffer(tsize*block_buf_nrecs)) + allocate(cbuffer(tsize*chunk_buf_nrecs)) + + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + ! Get Pedersen and Hall conductivities: + call pbuf_get_field(pbuf_chnk, index_ped, sigma_ped_phys) + call pbuf_get_field(pbuf_chnk, index_hall, sigma_hall_phys) + + ! Get ion and electron temperatures + call pbuf_get_field(pbuf_chnk, index_te, te_phys) + call pbuf_get_field(pbuf_chnk, index_ti, ti_phys) + + ! Get components of ion drift velocities + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + + !-------------------------------------------------------- + ! Get ions from physics buffer if non-transported + !-------------------------------------------------------- + + if (sIndxOp > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + if (sIndxO2p > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPO2p_phys, & + start=(/1,1,sIndxO2p/), kount=(/pcols,pver,1/) ) + if (sIndxNOp > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPNOp_phys, & + start=(/1,1,sIndxNOp/), kount=(/pcols,pver,1/) ) + if (sIndxN2p > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPN2p_phys, & + start=(/1,1,sIndxN2p/), kount=(/pcols,pver,1/) ) + + call chunk_to_block_send_pters(lchnk,pcols,pver+1,tsize,cpter) + + do i=1,ncol + cbuffer(cpter(i,0):cpter(i,0)+tsize-1) = 0.0_r8 + end do + + do k=1,km + do i=1,ncol + + cbuffer(cpter(i,k)+0) = sigma_ped_phys(i,k) + cbuffer(cpter(i,k)+1) = sigma_hall_phys(i,k) + cbuffer(cpter(i,k)+2) = te_phys(i,k) + cbuffer(cpter(i,k)+3) = ti_phys(i,k) + cbuffer(cpter(i,k)+4) = phys_state(lchnk)%zi(i,k) + cbuffer(cpter(i,k)+5) = phys_state(lchnk)%zm(i,k) + cbuffer(cpter(i,k)+6) = ui_phys(i,k) + cbuffer(cpter(i,k)+7) = vi_phys(i,k) + cbuffer(cpter(i,k)+8) = wi_phys(i,k) + cbuffer(cpter(i,k)+9) = phys_state(lchnk)%omega(i,k) + cbuffer(cpter(i,k)+10) = phys_state(lchnk)%t(i,k) + + if (sIndxO2p > 0)cbuffer(cpter(i,k)+ibuffO2p) = mmrPO2p_phys(i,k) + if (sIndxNOp > 0)cbuffer(cpter(i,k)+ibuffNOp) = mmrPNOp_phys(i,k) + if (sIndxN2p > 0)cbuffer(cpter(i,k)+ibuffN2p) = mmrPN2p_phys(i,k) + if (sIndxOp > 0) cbuffer(cpter(i,k)+ibuffOp) = mmrPOp_phys(i,k) + + end do + + end do + + end do + + call t_barrierf('sync_chk_to_blk', grid%commxy) + call t_startf ('chunk_to_block') + call transpose_chunk_to_block(tsize, cbuffer, bbuffer) + call t_stopf ('chunk_to_block') + + if (iam < grid%npes_xy) then + call chunk_to_block_recv_pters(iam+1,blksiz,pver+1,tsize,bpter) + endif + + do j=jfirstxy,jlastxy + do k=1,km + do i=ifirstxy,ilastxy + ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) + + sigma_ped_blck(i,j,k) = bbuffer(bpter(ib,k)+0) + sigma_hall_blck(i,j,k) = bbuffer(bpter(ib,k)+1) + te_blck(i,j,k) = bbuffer(bpter(ib,k)+2) + ti_blck(i,j,k) = bbuffer(bpter(ib,k)+3) + zi_blck(i,j,k) = bbuffer(bpter(ib,k)+4) + zm_blck(i,j,k) = bbuffer(bpter(ib,k)+5) + ui_blck(i,j,k) = bbuffer(bpter(ib,k)+6) + vi_blck(i,j,k) = bbuffer(bpter(ib,k)+7) + wi_blck(i,j,k) = bbuffer(bpter(ib,k)+8) + omega_blck(i,j,k) = bbuffer(bpter(ib,k)+9) + tn_blck(i,j,k) = bbuffer(bpter(ib,k)+10) + + if (sIndxO2p > 0) o2pmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffO2p) + if (sIndxNOp > 0) nopmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffNOp) + if (sIndxN2p > 0) n2pmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffN2p) + if (sIndxOp > 0) opmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffOp) + + enddo + enddo + enddo + + deallocate(bpter) + deallocate(bbuffer) + deallocate(cbuffer) + + endif phys2blcks_local + + !------------------------------------------------------------------------------------------- + ! Set dpie_coupling input ions if they are advected ... + !------------------------------------------------------------------------------------------- + if (ixo2p > 0) then + o2pmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo2p) + endif + if (ixnop > 0) then + nopmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixnop) + endif + if (ixn2p > 0) then + n2pmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixn2p) + endif + if (ixop > 0) then + opmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixop) + endif + + !------------------------------------ + ! Get neutrals from advected tracers array + !------------------------------------ + + o2mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo2) + o1mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo) + h1mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixh) + + ! + ! Make geopotential height (m) for d_pie_coupling. + ! + do k=1,km + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + zi_blck(i,j,k) = zi_blck(i,j,k)+phis(i,j)/gravit ! phis is redundant in k + zm_blck(i,j,k) = zm_blck(i,j,k)+phis(i,j)/gravit ! phis is redundant in k + enddo + enddo + enddo + + call t_startf('d_pie_coupling') + + if (iam < grid%npes_xy) then + ! waccmx ionosphere electro-dynamics -- transports O+ and provides updates to ion drift velocities + call d_pie_coupling(omega_blck,pexy,zi_blck,zm_blck,wuxy,wvxy,tn_blck, & + sigma_ped_blck,sigma_hall_blck,te_blck,ti_blck, & + o2mmr_blck,o1mmr_blck,h1mmr_blck,o2pmmr_blck,nopmmr_blck,n2pmmr_blck, & + opmmr_blck,opmmrtm1_blck,ui_blck,vi_blck,wi_blck, & + rmassO2,rmassO1,rmassH,rmassN2,rmassO2p,rmassNOp,rmassN2p, rmassOp, & + ifirstxy,ilastxy, jfirstxy,jlastxy) + endif + + call t_stopf ('d_pie_coupling') + + ! + !---------------------------------------- + ! Put data back in to state%q or pbuf + !---------------------------------------- + if (ixop > 0) then + tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixop) = opmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km) + endif + + ! blocks --> physics chunks + + blcks2phys_local: if (local_dp_map) then + + chnk_loop1 : do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + call get_lon_all_p(lchnk, ncol, lons) + call get_lat_all_p(lchnk, ncol, lats) + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + if (sIndxOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + endif + do k=1,km + do i=1,ncol + ic = lons(i) + jc = lats(i) + ui_phys(i,k) = ui_blck(ic,jc,k) + vi_phys(i,k) = vi_blck(ic,jc,k) + wi_phys(i,k) = wi_blck(ic,jc,k) + if (sIndxOp > 0) mmrPOp_phys(i,k) = opmmr_blck(ic,jc,k) + end do + end do + + if (ionos_edyn_active) then + call outfld ( 'UI', ui_phys, pcols, lchnk ) + call outfld ( 'VI', vi_phys, pcols, lchnk ) + call outfld ( 'WI', wi_phys, pcols, lchnk ) + if (write_inithist()) then + call outfld ( 'UI&IC', ui_phys, pcols, lchnk ) + call outfld ( 'VI&IC', vi_phys, pcols, lchnk ) + call outfld ( 'WI&IC', wi_phys, pcols, lchnk ) + endif + endif + + end do chnk_loop1 + + else ! blcks2phys_local + + if (sIndxOp > 0) then + tsize = 4 ! for ui,vi,wi,op + else + tsize = 3 ! for ui,vi,wi + endif + tsize=tsize+1 + + blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) + allocate( bpter(blksiz,0:km),stat=astat ) + allocate( bbuffer(tsize*block_buf_nrecs),stat=astat ) + allocate( cbuffer(tsize*chunk_buf_nrecs),stat=astat ) + + if (iam < grid%npes_xy) then + call block_to_chunk_send_pters(iam+1,blksiz,km+1,tsize,bpter) + endif + + do j=jfirstxy,jlastxy + do i=ifirstxy,ilastxy + ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) + + do k=1,km + + bbuffer(bpter(ib,k)) = ui_blck(i,j,k) + bbuffer(bpter(ib,k)+1) = vi_blck(i,j,k) + bbuffer(bpter(ib,k)+2) = wi_blck(i,j,k) + if (sIndxOp > 0) bbuffer(bpter(ib,k)+3) = opmmr_blck(i,j,k) + + end do + end do + end do + + call t_barrierf('sync_ionos_blk_to_chk', grid%commxy) + call t_startf ('ionos_block_to_chunk') + call transpose_block_to_chunk(tsize, bbuffer, cbuffer) + call t_stopf ('ionos_block_to_chunk') + + chnk_loop2: do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + if (sIndxOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + endif + + call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) + + do i=1,ncol + + do k=1,km + ui_phys(i,k) = cbuffer(cpter(i,k)) + vi_phys(i,k) = cbuffer(cpter(i,k)+1) + wi_phys(i,k) = cbuffer(cpter(i,k)+2) + if (sIndxOp > 0) then + mmrPOp_phys(i,k) = cbuffer(cpter(i,k)+3) + endif + end do ! k=1,km + end do ! i=1,ncol + + if (ionos_edyn_active) then + call outfld ( 'UI', ui_phys, pcols, lchnk ) + call outfld ( 'VI', vi_phys, pcols, lchnk ) + call outfld ( 'WI', wi_phys, pcols, lchnk ) + if (write_inithist()) then + call outfld ( 'UI&IC', ui_phys, pcols, lchnk ) + call outfld ( 'VI&IC', vi_phys, pcols, lchnk ) + call outfld ( 'WI&IC', wi_phys, pcols, lchnk ) + endif + endif + + end do chnk_loop2 + + deallocate(bpter) + deallocate(bbuffer) + deallocate(cbuffer) + + endif blcks2phys_local + + if (sIndxOp>0) then + deallocate(opmmr_blck) + nullify(opmmr_blck) + endif + if (sIndxO2p>0) then + deallocate(o2pmmr_blck) + nullify(o2pmmr_blck) + endif + if (sIndxNOp>0) then + deallocate(nopmmr_blck) + nullify(nopmmr_blck) + endif + if (sIndxN2p>0) then + deallocate(n2pmmr_blck) + nullify(n2pmmr_blck) + endif + + deallocate( wuxy ) + deallocate( wvxy ) + deallocate( sigma_ped_blck ) + deallocate( sigma_hall_blck ) + deallocate( ti_blck ) + deallocate( te_blck ) + deallocate( zi_blck ) + deallocate( ui_blck ) + deallocate( vi_blck ) + deallocate( wi_blck ) + deallocate( omega_blck ) + deallocate( tn_blck ) + + endif ionos_cpl + + end subroutine ionosphere_run2 + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_init_restart(File) + use pio, only: file_desc_t, pio_double, pio_def_var + use cam_pio_utils, only: cam_pio_def_dim + use dyn_grid, only: get_horiz_grid_dim_d + + type(File_desc_t), intent(inout) :: File + + integer :: ierr,hdim1,hdim2, dimids(3) + + call get_horiz_grid_dim_d(hdim1, hdim2) + + call cam_pio_def_dim(File, 'lon', hdim1, dimids(1), existOK=.true.) + call cam_pio_def_dim(File, 'lat', hdim2, dimids(2), existOK=.true.) + call cam_pio_def_dim(File, 'lev', pver, dimids(3), existOK=.true.) + + if (ionos_xport_active) then + ierr = PIO_Def_Var(File, 'Optm1', pio_double, dimids, Optm1_vdesc) + endif + end subroutine ionosphere_init_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_write_restart(File) + use pio, only: io_desc_t, file_desc_t, pio_write_darray, pio_initdecomp, pio_double + use cam_pio_utils, only: pio_subsystem + use dyn_grid, only: get_horiz_grid_dim_d + + type(File_desc_t), intent(inout) :: File + + type(io_desc_t) :: iodesc3d + integer :: hdim1, hdim2 + integer, pointer :: ldof(:) + integer :: ierr + + if (ionos_xport_active) then + call get_horiz_grid_dim_d(hdim1, hdim2) + ldof => get_restart_decomp(hdim1, hdim2, pver) + call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2, pver/), ldof, iodesc3d) + deallocate(ldof) + + call pio_write_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_blck, ierr) + endif + + end subroutine ionosphere_write_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_read_restart(File) + use pio, only: io_desc_t, file_desc_t, pio_inq_varid, pio_read_darray, pio_initdecomp, pio_double + use cam_pio_utils, only: pio_subsystem + use dyn_grid, only: get_horiz_grid_dim_d + + type(file_desc_t), intent(inout) :: File + + integer :: ierr + type(io_desc_t) :: iodesc3d + integer :: hdim1, hdim2 + integer, pointer :: ldof(:) + + if (ionos_xport_active) then + call ionosphere_alloc + + call get_horiz_grid_dim_d(hdim1, hdim2) + ldof => get_restart_decomp(hdim1, hdim2, pver) + call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2, pver/), ldof, iodesc3d) + deallocate(ldof) + + ierr = pio_inq_varid(File, 'Optm1', Optm1_vdesc) + call pio_read_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_blck, ierr) + endif + + end subroutine ionosphere_read_restart + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_final + +#ifdef WACCMX_EDYN_ESMF + use edyn_esmf, only: edyn_esmf_final + + call edyn_esmf_final() +#endif + + if (allocated(opmmrtm1_blck)) deallocate(opmmrtm1_blck) + + end subroutine ionosphere_final + +!========================================================================================= + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_read_ic() + + use pio, only: file_desc_t + use ncdio_atm, only: infld + use cam_initfiles, only: initial_file_get_id + + type(file_desc_t), pointer :: fh_ini ! PIO filehandle + + type (t_fvdycore_grid), pointer :: grid + integer :: ifirstxy,ilastxy,jfirstxy,jlastxy,km + logical :: readvar + + if ( ionos_xport_active ) then + call ionosphere_alloc() + + fh_ini => initial_file_get_id() + grid => get_dyn_state_grid() + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + + ! try reading in OpTM1 from the IC file + call infld('OpTM1', fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, opmmrtm1_blck, readvar, gridname='fv_centers') + + if (.not.readvar) then + ! if OpTM1 is not included in the IC file then try using O+ + call infld('Op', fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & + 1, km, opmmrtm1_blck, readvar, gridname='fv_centers') + endif + endif + + end subroutine ionosphere_read_ic + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + subroutine ionosphere_alloc + + type(T_FVDYCORE_GRID),pointer :: grid ! FV Dynamics grid + integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km + integer :: astat + + if (.not. allocated(opmmrtm1_blck)) then + + grid => get_dyn_state_grid() + ifirstxy = grid%ifirstxy + ilastxy = grid%ilastxy + jfirstxy = grid%jfirstxy + jlastxy = grid%jlastxy + km = grid%km + + allocate(opmmrtm1_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) + if (astat /= 0) call endrun('ionosphere_init: failed to allocate opmmrtm1_blck') + opmmrtm1_blck = 0._r8 + + endif + + end subroutine ionosphere_alloc + + + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- +function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) + use dyn_grid, only: get_dyn_grid_parm + + ! Get the integer mapping of a variable in the dynamics decomp in memory. + ! The canonical ordering is as on the file. A 0 value indicates that the + ! variable is not on the file (eg halo or boundary values) + + ! arguments + integer, intent(in) :: hdim1, hdim2, nlev + integer, pointer :: ldof(:) + + ! local variables + integer :: i, k, j + integer :: lcnt + integer :: beglatxy, beglonxy, endlatxy, endlonxy + !---------------------------------------------------------------------------- + + beglonxy = get_dyn_grid_parm('beglonxy') + endlonxy = get_dyn_grid_parm('endlonxy') + beglatxy = get_dyn_grid_parm('beglatxy') + endlatxy = get_dyn_grid_parm('endlatxy') + + lcnt = (endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) + allocate(ldof(lcnt)) + ldof(:) = 0 + + lcnt = 0 + do k = 1, nlev + do j = beglatxy, endlatxy + do i = beglonxy, endlonxy + lcnt = lcnt + 1 + ldof(lcnt) = i + (j-(plat-hdim2+1))*hdim1+(k-1)*hdim1*hdim2 + end do + end do + end do + +end function get_restart_decomp + +!========================================================================================= + + +end module ionosphere_interface diff --git a/src/ionosphere/waccmx/oplus.F90 b/src/ionosphere/waccmx/oplus.F90 new file mode 100644 index 0000000000..cd8cdd0a57 --- /dev/null +++ b/src/ionosphere/waccmx/oplus.F90 @@ -0,0 +1,1756 @@ +module oplus +! +! Horizontally transport the O+ ion, adapted for WACCM-X from TIEGCM. +! Input O+ is received from WACCM physics/chemistry, transported O+ +! (op_out and opnm_out) are passed back to chemistry. +! +! B. Foster (foster@ucar.edu), May, 2015. +! + use shr_kind_mod ,only: r8 => shr_kind_r8 + use cam_abortutils ,only: endrun + use cam_logfile ,only: iulog + use savefield_waccm,only: savefld_waccm, savefld_waccm_switch ! save field to waccm history + use edyn_geogrid ,only: dphi,dlamda,cs,zp,expz,p0 !, nlon, nlat, nlev + use getapex ,only: bx,by,bz,bmod2 ! (0:nlonp1,jspole-1:jnpole+1) + use edyn_params ,only: re + use time_manager ,only: get_step_size,is_first_step,is_first_restart_step + use edyn_mpi ,only: array_ptr_type + use shr_const_mod ,only: shr_const_g ! gravitational constant (m/s^2) + use spmd_utils ,only: masterproc + + implicit none + private + public :: oplus_xport, oplus_init + public :: kbot + + real(r8) :: pi,rtd +! +! Constants in CGS: +! + real(r8),parameter :: boltz = 1.38E-16_r8 ! boltzman's constant (erg/kelvin) + real(r8),parameter :: gask = 8.314e7_r8 ! gas constant (erg/mol) +! +! Collision factor (tuneable) (see also local colfac in iondrag.F90) +! FIX: Collision factor colfac is set locally in iondrag.F90 and here. +! It should be in one location and shared between ionosphere and +! dpie_coupling. +! + real(r8),parameter :: colfac = 1.5_r8 ! see also iondrag.F90 +! +! Reciprocal of molecular mass (multiply is cheaper than divide) + real(r8),parameter :: rmassinv_o2=1._r8/32._r8, rmassinv_o1=1._r8/16._r8, & + rmassinv_n2=1._r8/28._r8 + real(r8),parameter :: rmass_op=16._r8 + + real(r8) :: dzp ! delta zp (typically 0.5 from kbot to top) + real(r8) :: grav_cm ! gravitational constant (cm/s^2) + integer, protected :: kbot = -999 ! k-index corresponding to ~pbot + real(r8),parameter :: pbot = 0.004_r8 ! Pa -- bottom of O+ transport (near 120 km) +! +! The shapiro constant .03 is used for spatial smoothing of oplus, +! (shapiro is tuneable, and maybe should be a function of timestep size). +! dtsmooth and dtsmooth_div2 are used in the time smoothing. +! To turn off all smoothing here, set shapiro=0. and dtsmooth = 1. +! + + real(r8),parameter :: & + dtsmooth = 0.95_r8, & ! for time smoother + dtsmooth_div2 = 0.5_r8*(1._r8-dtsmooth) + + real(r8) :: adiff_limiter + real(r8) :: shapiro_const + logical :: enforce_floor + logical, parameter :: debug = .false. + + contains + +!----------------------------------------------------------------------- + subroutine oplus_init( adiff_limiter_in, shapiro_const_in, enforce_floor_in ) + + use cam_history, only : addfld, horiz_only + use filter_module,only : filter_init + + real(r8), intent(in) :: adiff_limiter_in + real(r8), intent(in) :: shapiro_const_in + logical , intent(in) :: enforce_floor_in + + shapiro_const = shapiro_const_in + enforce_floor = enforce_floor_in + adiff_limiter = adiff_limiter_in + + call filter_init + + ! + ! Save fields from oplus module: + ! + call addfld ('OPLUS_Z' ,(/ 'lev' /), 'I', 'cm ','OPLUS_Z' , gridname='fv_centers') + call addfld ('OPLUS_TN' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TN' , gridname='fv_centers') + call addfld ('OPLUS_TE' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TE' , gridname='fv_centers') + call addfld ('OPLUS_TI' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TI' , gridname='fv_centers') + call addfld ('OPLUS_UN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_UN' , gridname='fv_centers') + call addfld ('OPLUS_VN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_VN' , gridname='fv_centers') + call addfld ('OPLUS_OM' ,(/ 'lev' /), 'I', 'Pa/s' ,'OPLUS_OM' , gridname='fv_centers') + call addfld ('OPLUS_O2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O2' , gridname='fv_centers') + call addfld ('OPLUS_O1' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O1' , gridname='fv_centers') + + call addfld ('OPLUS_N2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_N2' , gridname='fv_centers') + call addfld ('OPLUS_OP' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS_OP' , gridname='fv_centers') + call addfld ('OPLUS_UI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_UI' , gridname='fv_centers') + call addfld ('OPLUS_VI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_VI' , gridname='fv_centers') + call addfld ('OPLUS_WI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_WI' , gridname='fv_centers') + call addfld ('OPLUS_MBAR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_MBAR' , gridname='fv_centers') + call addfld ('OPLUS_TR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TR' , gridname='fv_centers') + call addfld ('OPLUS_TP0' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP0' , gridname='fv_centers') + call addfld ('OPLUS_TP1' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP1' , gridname='fv_centers') + ! call addfld ('OPLUS_TP2' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP2' , gridname='fv_centers') + call addfld ('OPLUS_DJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_DJ' , gridname='fv_centers') + call addfld ('OPLUS_HJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_HJ' , gridname='fv_centers') + call addfld ('OPLUS_BVEL' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_BVEL' , gridname='fv_centers') + call addfld ('OPLUS_DIFFJ',(/ 'lev' /), 'I', ' ' ,'OPLUS_DIFFJ' , gridname='fv_centers') + call addfld ('OPLUS_OPNM' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_OPNM' , gridname='fv_centers') + call addfld ('OPNM_SMOOTH',(/ 'lev' /), 'I', ' ' ,'OPNM_SMOOTH' , gridname='fv_centers') + call addfld ('BDOTDH_OP' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OP' , gridname='fv_centers') + call addfld ('BDOTDH_OPJ' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OPJ' , gridname='fv_centers') + call addfld ('BDOTDH_DIFF',(/ 'lev' /), 'I', ' ' ,'BDOTDH_DIFF' , gridname='fv_centers') + call addfld ('BDZDVB_OP' ,(/ 'lev' /), 'I', ' ' ,'BDZDVB_OP' , gridname='fv_centers') + call addfld ('EXPLICIT0' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT0' , gridname='fv_centers') + + call addfld ('EXPLICITa' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITa' , gridname='fv_centers') ! part a + call addfld ('EXPLICITb' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITb' , gridname='fv_centers') ! part b + call addfld ('EXPLICIT1' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT1' , gridname='fv_centers') ! complete + call addfld ('EXPLICIT' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT' , gridname='fv_centers') ! final w/ poles + + call addfld ('EXPLICIT2' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT2' , gridname='fv_centers') + call addfld ('EXPLICIT3' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT3' , gridname='fv_centers') + call addfld ('TPHDZ0' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ0' , gridname='fv_centers') + call addfld ('TPHDZ1' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ1' , gridname='fv_centers') + call addfld ('DIVBZ' ,(/ 'lev' /), 'I', ' ' ,'DIVBZ' , gridname='fv_centers') + call addfld ('HDZMBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZMBZ' , gridname='fv_centers') + call addfld ('HDZPBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZPBZ' , gridname='fv_centers') + call addfld ('P_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0' , gridname='fv_centers') + call addfld ('Q_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0' , gridname='fv_centers') + call addfld ('R_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0' , gridname='fv_centers') + call addfld ('P_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0a' , gridname='fv_centers') + call addfld ('Q_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0a' , gridname='fv_centers') + call addfld ('DJINT' ,(/ 'lev' /), 'I', ' ' ,'DJINT' , gridname='fv_centers') + call addfld ('BDOTU' ,(/ 'lev' /), 'I', ' ' ,'BDOTU' , gridname='fv_centers') + call addfld ('R_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0a' , gridname='fv_centers') + call addfld ('P_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF1' , gridname='fv_centers') + call addfld ('Q_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF1' , gridname='fv_centers') + call addfld ('R_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF1' , gridname='fv_centers') + call addfld ('P_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF2' , gridname='fv_centers') + call addfld ('Q_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF2' , gridname='fv_centers') + call addfld ('R_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF2' , gridname='fv_centers') + + call addfld ('P_COEFF' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF' , gridname='fv_centers') ! final w/ poles + call addfld ('Q_COEFF' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF' , gridname='fv_centers') ! final w/ poles + call addfld ('R_COEFF' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF' , gridname='fv_centers') ! final w/ poles + + call addfld ('OP_SOLVE' ,(/ 'lev' /), 'I', ' ' ,'OP_SOLVE' , gridname='fv_centers') + + call addfld ('OP_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS (oplus_xport output)', gridname='fv_centers') + call addfld ('OPNM_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPNM_OUT' , gridname='fv_centers') + call addfld ('BMOD2' ,(/ 'lev' /), 'I', ' ' ,'BMOD2' , gridname='fv_centers') + + call addfld ('OPLUS_FLUX', horiz_only , 'I', ' ','OPLUS_FLUX', gridname='fv_centers') + call addfld ('OPLUS_DIVB', horiz_only , 'I', ' ','OPLUS_DIVB', gridname='fv_centers') + call addfld ('OPLUS_BX' , horiz_only , 'I', ' ','OPLUS_BX' , gridname='fv_centers') + call addfld ('OPLUS_BY' , horiz_only , 'I', ' ','OPLUS_BY' , gridname='fv_centers') + call addfld ('OPLUS_BZ' , horiz_only , 'I', ' ','OPLUS_BZ' , gridname='fv_centers') + call addfld ('OPLUS_BMAG', horiz_only , 'I', ' ','OPLUS_BMAG', gridname='fv_centers') + + end subroutine oplus_init + +!----------------------------------------------------------------------- + subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & + mbar,ui,vi,wi,pmid,op_out,opnm_out, & + i0,i1,j0,j1,nspltop,ispltop ) +! +! All input fields from dpie_coupling are in "TIEGCM" format, i.e., +! longitude (-180->180), vertical (bot2top), and units (CGS). +! + use edyn_mpi,only: mp_geo_halos,mp_pole_halos,setpoles + use edyn_geogrid,only : glat, nlat, nlev +! +! Transport O+ ion. +! March-May, 2015 B.Foster: Adapted from TIEGCM (oplus.F) for WACCM-X. +! +! Notes: +! - waccmx_opt='ionosphere' must be set in user_nl_cam for te,ti inputs to have values +! +! Args: +! + integer,intent(in) :: & + i0, & ! grid%ifirstxy + i1, & ! grid%ilastxy + j0, & ! grid%jfirstxy + j1 ! grid%jlastxy + integer,intent(in) :: nspltop,ispltop +! +! Input fields without halo points (lon +/-180, vertical bot2top, CGS units): +! + real(r8),intent(in) :: tn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral temperature (deg K) + real(r8),intent(in) :: te (nlev,i0-2:i1+2,j0-2:j1+2) ! electron temperature (deg K) + real(r8),intent(in) :: ti (nlev,i0-2:i1+2,j0-2:j1+2) ! ion temperature (deg K) + real(r8),intent(in) :: un (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral zonal wind (cm/s) + real(r8),intent(in) :: vn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral meridional wind (cm/s) + real(r8),intent(in) :: om (nlev,i0-2:i1+2,j0-2:j1+2) ! omega (1/s) + real(r8),intent(in) :: o2 (nlev,i0-2:i1+2,j0-2:j1+2) ! o2 (mmr) + real(r8),intent(in) :: o1 (nlev,i0-2:i1+2,j0-2:j1+2) ! o (mmr) + real(r8),intent(in) :: n2 (nlev,i0-2:i1+2,j0-2:j1+2) ! n2 (mmr) + real(r8),intent(in) :: mbar (nlev,i0-2:i1+2,j0-2:j1+2) ! mean molecular weight + + real(r8),intent(in) :: op_in(nlev,i0:i1,j0:j1) ! O+ density (cm^3) + real(r8),intent(in) :: opnm_in(nlev,i0:i1,j0:j1) ! O+ density (cm^3) at time-1 + real(r8),intent(in) :: zg (nlev,i0:i1,j0:j1) ! geopotential height (cm) +! +! Ion drifts from edynamo (also in tiegcm-format): +! + real(r8),intent(in) :: ui(nlev,i0:i1,j0:j1) ! zonal ion drift + real(r8),intent(in) :: vi(nlev,i0:i1,j0:j1) ! meridional ion drift + real(r8),intent(in) :: wi(nlev,i0:i1,j0:j1) ! vertical ion drift + real(r8),intent(in) :: pmid(nlev) ! pressure at midpoints (Pa) +! +! Output: +! + real(r8),intent(out) :: & + op_out (nlev,i0:i1,j0:j1), & ! O+ output + opnm_out(nlev,i0:i1,j0:j1) ! O+ output at time n-1 +! +! Local: +! + integer :: i,j,k,lat,jm1,jp1,jm2,jp2,lat0,lat1 + real(r8),dimension(i0:i1,j0:j1) :: & + opflux, & ! upward number flux of O+ (returned by sub oplus_flux) + dvb ! divergence of B-field +! +! Local inputs with added halo points in lat,lon: +! + real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: op, opnm + + real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: & + tr ,& ! Reduced temperature (.5*(tn+ti)) + tp ,& ! Plasma temperature N(O+)*(te+ti) + dj ,& ! diffusion coefficients + bvel ,& ! bvel @ j = (B.U)*N(O+) + diffj ,& ! (D/(H*DZ)*2.*TP+M*G/R)*N(O+) + bdotdh_op ,& ! (b(h)*del(h))*phi + bdotdh_opj ,& ! (b(h)*del(h))*phi + bdotdh_diff ,& ! (b(h)*del(h))*phi + opnm_smooth ! O+ at time-1, smoothed + + real(r8),dimension(nlev,i0:i1,j0:j1) :: & ! for saving to histories + diag0,diag1,diag2,diag3,diag4,diag5,diag6,diag7,diag8,diag9,& + diag10,diag11,diag12,diag13,diag14,diag15,diag16,diag17,& + diag18,diag19,diag20,diag21,diag22,diag23,diag24,diag25,& + diag26,diag27 + real(r8),dimension(nlev,i0:i1,j0-1:j1+1) :: hj ! scale height + real(r8) :: gmr,dtime,dtx2,dtx2inv + real(r8),dimension(nlev,i0:i1) :: & + bdzdvb_op, & + hdz, & + tp1, & + tphdz0, & + tphdz1, & + djint, & + divbz, & + hdzmbz, & + hdzpbz, & + bdotu +! +! Arguments for tridiagonal solver trsolv (no halos): + real(r8),dimension(nlev,i0:i1,j0:j1) :: & + explicit,explicit_a,explicit_b,p_coeff,q_coeff,r_coeff + + real(r8),dimension(i0:i1) :: ubca, ubcb ! O+ upper boundary + real(r8),parameter :: one=1._r8 + logical :: calltrsolv +! +! Pointers for multiple-field calls (e.g., mp_geo_halos) + integer :: nfields + real(r8),allocatable :: polesign(:) + type(array_ptr_type),allocatable :: ptrs(:) + + real(r8) :: zpmid(nlev), opfloor + real(r8),parameter :: opmin=3000.0_r8 +! +! Execute: +! + dtime = get_step_size() ! step size in seconds + dtime = dtime / dble(nspltop) + dtx2 = 2._r8*dtime + dtx2inv = 1._r8/dtx2 + + if ((is_first_step().or.is_first_restart_step()).and.ispltop==1) then + if (masterproc) write(iulog,"('oplus: shapiro=',es12.4,' dtsmooth=',es12.4,' dtsmooth_div2=',es12.4)") & + shapiro_const,dtsmooth,dtsmooth_div2 + if (masterproc) write(iulog,"('oplus: shr_const_g=',f8.3)") shr_const_g + endif + + ! + ! zp,expz are declared in edyn_geogrid.F90, and allocated in sub + ! set_geogrid (edyn_init.F90). pmid was passed in here (bot2top) + ! from dpie_coupling. + ! + ! kbot is the k-index at the bottom of O+ transport calculations, + ! corresponding to pressure pbot. + ! + if ((is_first_step().or.is_first_restart_step()).and.ispltop==1) then + kloop: do k=1,nlev + if ( pmid(k) <= pbot) then + kbot = k + exit kloop + end if + enddo kloop + do k=1,nlev + zp(k) = -log(pmid(k)*10._r8/p0) + expz(k) = exp(-zp(k)) + enddo + if (debug.and.masterproc) then + write(iulog,"('oplus: kbot=',i4,' pmid(kbot)=',es12.4,' zp(kbot)=',es12.4)") & + kbot,pmid(kbot),zp(kbot) + endif + endif + + if (kbot < 1) then + call endrun('oplus_xport: kbot is not set') + endif + + dzp = zp(nlev)-zp(nlev-1) ! use top 2 levels (typically dzp=0.5) + + if (debug.and.masterproc) then + write(iulog,"('oplus: nlev=',i3,' zp (bot2top) =',/,(6es12.3))") nlev,zp + write(iulog,"('oplus: nlev=',i3,' expz (bot2top) =',/,(6es12.3))") nlev,expz + write(iulog,"('oplus: nlev=',i3,' dzp =',/,(6es12.3))") nlev,dzp + endif +! +! Set subdomain blocks from input (composition is in mmr): +! +!$omp parallel do private(i, j, k) + do k=1,nlev + do j=j0,j1 + do i=i0,i1 + op(k,i,j) = op_in(k,i,j) + opnm(k,i,j) = opnm_in(k,i,j) + enddo + enddo + enddo + +! +! Define halo points on inputs: +! WACCM has global longitude values at the poles (j=1,j=nlev) +! (they are constant for most, except the winds.) +! +! Set two halo points in lat,lon: +! real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: tn,te,etc. +! + nfields = 2 + allocate(ptrs(nfields),polesign(nfields)) + + ptrs(1)%ptr => op ; ptrs(2)%ptr => opnm + polesign = 1._r8 +! +! mp_geo_halos first arg: +! type(array_ptr_type) :: fmsub(nf) ! (lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) +! + call mp_geo_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields) +! +! Set latitude halo points over the poles (this does not change the poles). +! (the 2nd halo over the poles will not actually be used (assuming lat loops +! are lat=2,nlat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 +! will be the first halo over the pole) +! +! mp_pole_halos first arg: +! type(array_ptr_type) :: f(nf) ! (nlev,i0-2:i1+2,j0-2:j1+2) + + call mp_pole_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields,polesign) + deallocate(ptrs,polesign) + +! +! Use below to exclude the poles (lat=2,nlat-1) from latitude scans. +! + lat0 = j0 + lat1 = j1 + if (j0 == 1) lat0 = 2 + if (j1 == nlat) lat1 = nlat-1 +! +! Save input fields to WACCM histories. Sub savefld_waccm_switch converts +! fields from tiegcm-format to waccm-format before saving to waccm histories. +! + call savefld_waccm_switch(tn(:,i0:i1,j0:j1),'OPLUS_TN',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(te(:,i0:i1,j0:j1),'OPLUS_TE',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(ti(:,i0:i1,j0:j1),'OPLUS_TI',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(un(:,i0:i1,j0:j1),'OPLUS_UN',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(vn(:,i0:i1,j0:j1),'OPLUS_VN',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(om(:,i0:i1,j0:j1),'OPLUS_OM',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(zg(:,i0:i1,j0:j1),'OPLUS_Z' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(o2(:,i0:i1,j0:j1),'OPLUS_O2',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(o1(:,i0:i1,j0:j1),'OPLUS_O1',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(n2(:,i0:i1,j0:j1),'OPLUS_N2',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(op(:,i0:i1,j0:j1),'OPLUS_OP',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(ui(:,i0:i1,j0:j1),'OPLUS_UI',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(vi(:,i0:i1,j0:j1),'OPLUS_VI',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(wi(:,i0:i1,j0:j1),'OPLUS_WI',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(mbar(:,i0:i1,j0:j1),'OPLUS_MBAR',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(opnm(:,i0:i1,j0:j1),'OPLUS_OPNM',nlev,i0,i1,j0,j1) +! +! Initialize output op_out with input op at 1:kbot-1, to retain values from +! bottom of column up to kbot. This routine will change (transport) these +! outputs only from kbot to the top (nlev). +! + op_out = 0._r8 + opnm_out = 0._r8 + op_out (1:kbot-1,i0:i1,j0:j1) = op (1:kbot-1,i0:i1,j0:j1) + opnm_out(1:kbot-1,i0:i1,j0:j1) = opnm(1:kbot-1,i0:i1,j0:j1) +! +! Sub oplus_flux returns upward number flux of O+ in opflux +! Output opflux(i,j) is 2d lon x lat subdomain: +! + call oplus_flux(opflux,i0,i1,j0,j1) + call savefld_waccm(opflux(i0:i1,j0:j1),'OPLUS_FLUX',1,i0,i1,j0,j1) +! +! Divergence of B (mag field) is returned by divb in dvb(i0:i1,j0:j1) +! + call divb(dvb,i0,i1,j0,j1) + call savefld_waccm(dvb(i0:i1,j0:j1),'OPLUS_DIVB',1,i0,i1,j0,j1) +! +! The solver will be called only if calltrsolv=true. It is sometimes +! set false when skipping parts of the code for debug purposes. +! + calltrsolv = .true. + + tr = 0._r8 + tp = 0._r8 + dj = 0._r8 + hj = 0._r8 + bvel= 0._r8 + diffj = 0._r8 + opnm_smooth = 0._r8 + diag0 =0._r8 + grav_cm = shr_const_g * 100._r8 ! m/s^2 -> cm/s^2 +! +!----------------------- Begin first latitude scan --------------------- + do lat=lat0,lat1 + jm2 = lat-2 + jm1 = lat-1 + jp1 = lat+1 + jp2 = lat+2 +! +! as of April, 2015, TIEGCM incorrectly uses te+ti instead of tn+ti +! This has not been fixed in TIEGCM, because fixing it causes a tuning +! problem (ask Hanli and Wenbin). For WACCM, it is correct as below. +! (see also tp) +! +!$omp parallel do private(i,k) + do i=i0,i1 +! +! Reduced temperature (tpj in tiegcm): +! 'OPLUS_TR' (has constants at poles) +! + do k=kbot,nlev + tr(k,i,jm1) = 0.5_r8*(tn(k,i,jm1)+ti(k,i,jm1)) + tr(k,i,lat) = 0.5_r8*(tn(k,i,lat)+ti(k,i,lat)) + tr(k,i,jp1) = 0.5_r8*(tn(k,i,jp1)+ti(k,i,jp1)) + enddo + enddo ! i=i0,i1 +! +! rrk returns ambipolar diffusion coefficients in d(jm1),dj(lat),djp1(jp1): +! 'OPLUS_DJ' (has constants at poles) +! + call rrk( & + tn(kbot:nlev,i0:i1,jm1),mbar(kbot:nlev,i0:i1,jm1), & + o2(kbot:nlev,i0:i1,jm1),o1 (kbot:nlev,i0:i1,jm1), & + n2(kbot:nlev,i0:i1,jm1),tr (kbot:nlev,i0:i1,jm1), & + dj(kbot:nlev,i0:i1,jm1),i0,i1,kbot,nlev) + + call rrk( & + tn(kbot:nlev,i0:i1,lat),mbar(kbot:nlev,i0:i1,lat), & + o2(kbot:nlev,i0:i1,lat),o1 (kbot:nlev,i0:i1,lat), & + n2(kbot:nlev,i0:i1,lat),tr (kbot:nlev,i0:i1,lat), & + dj(kbot:nlev,i0:i1,lat),i0,i1,kbot,nlev) + + call rrk( & + tn(kbot:nlev,i0:i1,jp1),mbar(kbot:nlev,i0:i1,jp1), & + o2(kbot:nlev,i0:i1,jp1),o1 (kbot:nlev,i0:i1,jp1), & + n2(kbot:nlev,i0:i1,jp1),tr (kbot:nlev,i0:i1,jp1), & + dj(kbot:nlev,i0:i1,jp1),i0,i1,kbot,nlev) +! +! Plasma temperature: +! 'OPLUS_TP0' (tp will get poles from jm1 and jp1) +! +!$omp parallel do private(i,k) + do i=i0,i1 + do k=kbot,nlev + tp(k,i,jm1) = te(k,i,jm1)+ti(k,i,jm1) + tp(k,i,lat) = te(k,i,lat)+ti(k,i,lat) + tp(k,i,jp1) = te(k,i,jp1)+ti(k,i,jp1) + enddo + enddo + diag0(kbot:nlev,i0:i1,lat) = tp(kbot:nlev,i0:i1,lat) +! +! Add poles to diag0: + if (j0==1.and.lat==2) diag0(kbot:nlev,i0:i1,j0) = tp(kbot:nlev,i0:i1,jm1) + if (j1==nlat.and.lat==nlat-1) diag0(kbot:nlev,i0:i1,j1) = tp(kbot:nlev,i0:i1,jp1) +! +! Neutral scale height: +! 'OPLUS_HJ' (has constants at poles) +! +!$omp parallel do private(i,k) + do i=i0,i1 + do k=kbot,nlev + hj(k,i,jm1) = gask * tn(k,i,jm1) / (mbar(k,i,jm1) * grav_cm) + hj(k,i,lat) = gask * tn(k,i,lat) / (mbar(k,i,lat) * grav_cm) + hj(k,i,jp1) = gask * tn(k,i,jp1) / (mbar(k,i,jp1) * grav_cm) + enddo + enddo +! +! bvel @ jm1 = (B.U)*N(O+) (J-1) +! bvel @ j = (B.U)*N(O+) (J) +! bvel @ jp1 = (B.U)*N(O+) (J+1) +! 'OPLUS_BVEL' (has constants at poles) +! +! Note bx,by,bz were set globally for all tasks by sub magfield +! (getapex.F90) +! +!$omp parallel do private(i,k) + do i=i0,i1 + do k=kbot,nlev + bvel(k,i,jm1) = & + (bx(i,jm1)*un(k,i,jm1)+by(i,jm1)*vn(k,i,jm1)+ & + hj(k,i,jm1)*bz(i,jm1)*om(k,i,jm1))*op(k,i,jm1) + bvel(k,i,lat) = & + (bx(i,lat)*un(k,i,lat)+by(i,lat)*vn(k,i,lat)+ & + hj(k,i,lat)*bz(i,lat)*om(k,i,lat))*op(k,i,lat) + bvel(k,i,jp1) = & + (bx(i,jp1)*un(k,i,jp1)+by(i,jp1)*vn(k,i,jp1)+ & + hj(k,i,jp1)*bz(i,jp1)*om(k,i,jp1))*op(k,i,jp1) + enddo ! k=kbot,nlev + enddo ! i=lon0,lon1 +! +! Ambipolar diffusion is returned in diffj: +! 'OPLUS_DIFFJ' (will have constants at poles after this lat scan) +! + call diffus(tp(kbot:nlev,i0:i1,jm1),op(kbot:nlev,i0:i1,jm1),hj(kbot:nlev,:,jm1), & + diffj(kbot:nlev,i0:i1,jm1),i0,i1,kbot,nlev,lat) + call diffus(tp(kbot:nlev,i0:i1,lat),op(kbot:nlev,i0:i1,lat),hj(kbot:nlev,:,lat), & + diffj(kbot:nlev,i0:i1,lat),i0,i1,kbot,nlev,lat) + call diffus(tp(kbot:nlev,i0:i1,jp1),op(kbot:nlev,i0:i1,jp1),hj(kbot:nlev,:,jp1), & + diffj(kbot:nlev,i0:i1,jp1),i0,i1,kbot,nlev,lat) +! +! 'OPLUS_TP1' (constants at the poles) +! +!$omp parallel do private(i,k) + do i=i0,i1 + do k=kbot,nlev + tp(k,i,jm2) = op(k,i,jm2)*(te(k,i,jm2)+ti(k,i,jm2)) + tp(k,i,jm1) = tp(k,i,jm1)*op(k,i,jm1) + tp(k,i,lat) = tp(k,i,lat)*op(k,i,lat) + tp(k,i,jp1) = tp(k,i,jp1)*op(k,i,jp1) + tp(k,i,jp2) = op(k,i,jp2)*(te(k,i,jp2)+ti(k,i,jp2)) + enddo + enddo +! +! Latidinal shapiro smoother: opnm is O+ at time n-1. +! opnm_smooth will be used in explicit terms below. +! Smooth in latitude: +! 'OPNM_SMOOTH' (zero at poles) +! +!$omp parallel do private(i,k) + do i=i0,i1 + do k=kbot,nlev + opnm_smooth(k,i,lat) = opnm(k,i,lat)-shapiro_const* & + (opnm(k,i,jp2)+opnm(k,i,jm2)-4._r8* & + (opnm(k,i,jp1)+opnm(k,i,jm1))+6._r8* & + opnm(k,i,lat)) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + enddo ! end first latitude scan (lat=lat0,lat1) +! +!------------------------- End first latitude scan --------------------- +! +! Set pole values for opnm_smooth. Do this before savefld calls, so plots will +! include the poles. All other fields in 1st lat scan got values at the poles +! via jm1,jp1 above. +! + call setpoles(opnm_smooth(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) +! +! Save to history file (exclude halo points) +! + call savefld_waccm_switch(tr (:,i0:i1,j0:j1),'OPLUS_TR' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(dj (:,i0:i1,j0:j1),'OPLUS_DJ' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(hj (:,i0:i1,j0:j1),'OPLUS_HJ' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(bvel (:,i0:i1,j0:j1),'OPLUS_BVEL' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diffj(:,i0:i1,j0:j1),'OPLUS_DIFFJ',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag0(:,i0:i1,j0:j1),'OPLUS_TP0' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(tp (:,i0:i1,j0:j1),'OPLUS_TP1' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(opnm_smooth(:,i0:i1,j0:j1),'OPNM_SMOOTH',nlev,i0,i1,j0,j1) +! +! Set halo points where needed. +! + nfields = 5 + allocate(ptrs(nfields),polesign(nfields)) + ptrs(1)%ptr => dj ; ptrs(2)%ptr => bvel ; ptrs(3)%ptr => diffj + ptrs(4)%ptr => tp ; ptrs(5)%ptr => opnm_smooth + polesign = 1._r8 + + call mp_geo_halos (ptrs,1,nlev,i0,i1,j0,j1,5) + call mp_pole_halos(ptrs,1,nlev,i0,i1,j0,j1,5,polesign) + + deallocate(ptrs,polesign) + +!----------------------- Begin second latitude scan -------------------- + bdotdh_op = 0._r8 + bdotdh_opj = 0._r8 + + do lat=lat0,lat1 + jm2 = lat-2 + jm1 = lat-1 + jp1 = lat+1 + jp2 = lat+2 +! +! bdotdh_op = (B(H).DEL(H))*(D/(H*DZ)*TP+M*G/R)*N(O+) +! then bdotdh_op = d*bz*bdotdh_op +! real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2) :: diffj +! real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2) :: bdotdh_op +! 'BDOTDH_OP' (zero at the poles) +! + call bdotdh( & + diffj(kbot:nlev,i0:i1,jm1), & + diffj(kbot:nlev,:,lat ), & ! includes longitude halos + diffj(kbot:nlev,i0:i1,jp1), & + bdotdh_op(kbot:nlev,i0:i1,lat),i0,i1,kbot,nlev,lat) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + bdotdh_op(k,i,lat) = dj(k,i,lat)*bz(i,lat)*bdotdh_op(k,i,lat) ! BDOTDH_OP + enddo ! k=kbot,nlev + enddo ! i=i0,i1 +! +! bdotdh_opjm1 = (B(H).DEL(H))*2.*TP*N(O+) (J-1) +! bdotdh_opj = (B(H).DEL(H))*2.*TP*N(O+) (J) +! bdotdh_opjp1 = (B(H).DEL(H))*2.*TP*N(O+) (J+1) +! 'BDOTDH_OPJ' (has reasonable non-constant values at poles) +! + call bdotdh( & + tp(kbot:nlev,i0:i1,jm2), & + tp(kbot:nlev,:,jm1), & + tp(kbot:nlev,i0:i1,lat), & + bdotdh_opj(kbot:nlev,i0:i1,jm1),i0,i1,kbot,nlev,jm1) + call bdotdh( & + tp(kbot:nlev,i0:i1,jm1), & + tp(kbot:nlev,:,lat), & + tp(kbot:nlev,i0:i1,jp1), & + bdotdh_opj(kbot:nlev,i0:i1,lat),i0,i1,kbot,nlev,lat) + call bdotdh( & + tp(kbot:nlev,i0:i1,lat), & + tp(kbot:nlev,:,jp1), & + tp(kbot:nlev,i0:i1,jp2), & + bdotdh_opj(kbot:nlev,i0:i1,jp1),i0,i1,kbot,nlev,jp1) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + bdotdh_opj(k,i,jm1) = bdotdh_opj(k,i,jm1)*dj(k,i,jm1) + bdotdh_opj(k,i,lat) = bdotdh_opj(k,i,lat)*dj(k,i,lat) + bdotdh_opj(k,i,jp1) = bdotdh_opj(k,i,jp1)*dj(k,i,jp1) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + enddo ! lat=j0,j1 (end second lat scan) +! +!------------------------ End second latitude scan --------------------- +! +! bdotdh_opj already has non-constant polar values, but bdotdh_op poles are zero. +! Sub setpoles will set poles to the zonal average of the latitude below each pole. +! +! This may not be necessary, but do it for plotting: + call setpoles(bdotdh_op(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) + + call savefld_waccm_switch(bdotdh_op (:,i0:i1,j0:j1),'BDOTDH_OP' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(bdotdh_opj(:,i0:i1,j0:j1),'BDOTDH_OPJ',nlev,i0,i1,j0,j1) +! +! Note mp_geo_halos will overwrite jm1,jp1 that was set above. +! bdotdh_opj needs longitude halos for the bdotdh call below. +! +! real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: bdotdh_op,opj +! + allocate(ptrs(1)) + ptrs(1)%ptr => bdotdh_opj + call mp_geo_halos (ptrs,1,nlev,i0,i1,j0,j1,1) + call mp_pole_halos(ptrs,1,nlev,i0,i1,j0,j1,1,(/1._r8/)) + deallocate(ptrs) +! +!----------------------- Begin third latitude scan --------------------- +! + bdotdh_diff = 0._r8 + bdzdvb_op = 0._r8 + explicit(1:nlev,i0:i1,j0:j1) = 0._r8 ; explicit_a(1:nlev,i0:i1,j0:j1)=0._r8 ; explicit_b(1:nlev,i0:i1,j0:j1)=0._r8 + hdz = 0._r8 + tphdz0 = 0._r8 + tphdz1 = 0._r8 + djint = 0._r8 + divbz = 0._r8 + hdzmbz = 0._r8 + hdzpbz = 0._r8 + p_coeff(1:nlev,i0:i1,j0:j1) = 0._r8 + q_coeff(1:nlev,i0:i1,j0:j1) = 0._r8 + r_coeff(1:nlev,i0:i1,j0:j1) = 0._r8 + bdotu = 0._r8 + + diag1 = 0._r8 ; diag2 = 0._r8 ; diag3 = 0._r8 ; diag4 = 0._r8 ; diag5 = 0._r8 + diag6 = 0._r8 ; diag7 = 0._r8 ; diag8 = 0._r8 ; diag9 = 0._r8 ; diag10= 0._r8 + diag11 = 0._r8 ; diag12= 0._r8 ; diag13= 0._r8 ; diag14= 0._r8 ; diag15= 0._r8 + diag16 = 0._r8 ; diag17= 0._r8 ; diag18= 0._r8 ; diag19= 0._r8 ; diag20= 0._r8 + diag21 = 0._r8 ; diag22= 0._r8 ; diag23= 0._r8 ; diag24= 0._r8 ; diag25= 0._r8 + diag26 = 0._r8 ; diag27= 0._r8 + +! +! gmr = G*M(O+)/(2.*R) +! + gmr = grav_cm*rmass_op/(2._r8*gask) + +! +! Globally, this loop is lat=2,nlat-1 (i.e., skipping the poles) +! + do lat=lat0,lat1 + jm2 = lat-2 + jm1 = lat-1 ! this will be south pole for southern pes (j==1) + jp1 = lat+1 ! this will be north pole for northern pes (j==nlat) + jp2 = lat+2 +! +! bdotdh_opj = (B(H).DEL(H))*D*(B(H).DEL(H))*2.*TP*N(O+) (J) +! 'BDOTDH_DIFF' (zero at the poles) +! + call bdotdh( & + bdotdh_opj(kbot:nlev,i0:i1,jm1), & + bdotdh_opj(kbot:nlev,:,lat), & ! includes longitude halos + bdotdh_opj(kbot:nlev,i0:i1,jp1), & + bdotdh_diff(kbot:nlev,i0:i1,lat),i0,i1,kbot,nlev,lat) ! BDOTDH_DIFF +! +! bdzdvb_op = (BZ*D/(H*DZ)+DIV(*B))*S2 +! bdzdvb returns bdzdvb_op(k,i). +! 'BDZDVB_OP' (zero at the poles) +! +! real(r8),dimension(i0:i1,j0:j1) :: dvb +! real(r8),dimension(nlev,i0:i1,j0-1:j1+1) :: hj ! scale height +! real(r8),dimension(nlev,i0:i1) :: bdzdvb_op + +! subroutine bdzdvb(phi,dvb,h,ans,lev0,lev1,lon0,lon1,lat) +! real(r8),intent(in) :: dvb(lon0:lon1) +! real(r8),dimension(lev0:lev1,lon0:lon1),intent(in) :: phi,h +! real(r8),dimension(lev0:lev1,lon0:lon1),intent(out) :: ans +! + call bdzdvb(bdotdh_opj(kbot:nlev,i0:i1,lat),dvb(:,lat),hj(kbot:nlev,i0:i1,lat), & + bdzdvb_op(kbot:nlev,i0:i1),kbot,nlev,i0,i1,lat) + diag1(:,i0:i1,lat) = bdzdvb_op(:,i0:i1) ! BDZDVB_OP +! +! Collect explicit terms: +! 'EXPLICIT0' (this will have poles set after third lat scan, before +! plotting. The poles will be constant in longitude, and +! may differ structurally from adjacent latitudes. +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + explicit(k,i,lat) = -one*(bdzdvb_op(k,i)+bdotdh_diff(k,i,lat)+ & + bdotdh_op(k,i,lat)) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + diag2(:,i0:i1,lat) = explicit(:,i0:i1,lat) ! EXPLICIT0 +! +! Ion drifts are interpolated to midpoints (is this necessary in WACCM?). +! +! Need lon,lat halos for op, bvel, and bmod2 +! op,bvel halos were set above, bmod2 was set in magfield (getapex.F90) +! (ui,vi,wi halos are not used here.) +! +! bmod2 halos are set in sub magfield (getapex.F90), including nlat-1,nlat,nlat+1, +! and 1 halo point in longitude. Note bmod2 is global in lon and lat for all pe's. +! use getapex,only: bmod2 ! (0:nlonp1,jspole-1:jnpole+1) +! +! When looping lat=2,nlat-1, this explicit has zero pole values, +! but there are still problems at processor longitude boundaries, +! especially near the south pole: +! 'EXPLICIT1' (zero at the poles) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev-1 +! +! Original TIEGCM statement: +! explicit(k,i) = explicit(k,i)+1._r8/(2._r8*re)* & +! (1._r8/(cs(lat)*dlamda)*(bx(i,lat)* & +! (bvel(k,i+1,lat)-bvel(k,i-1,lat))+ & +! 0.5_r8*(ui(k,i,lat)+ui(k+1,i,lat))*bmod2(i,lat)**2* & +! (op(k,i+1,lat)/bmod2(i+1,lat)**2- & +! op(k,i-1,lat)/bmod2(i-1,lat)**2))+ & +! +! 1._r8/dphi*(by(i,lat)*(bvel(k,i,jp1)-bvel(k,i,jm1))+ & +! 0.5_r8*(vi(k,i,lat)+vi(k+1,i,lat))*bmod2(i,lat)**2* & +! (op(k,i,jp1)/bmod2(i,jp1)**2- & +! op(k,i,jm1)/bmod2(i,jm1)**2))) +! +! Break it into two pieces and put together for debug: +! +! 'EXPLICITa' + explicit_a(k,i,lat) = (bx(i,lat)* & + (bvel(k,i+1,lat)-bvel(k,i-1,lat))+ & + 0.5_r8*(ui(k,i,lat)+ui(k+1,i,lat))*bmod2(i,lat)**2* & + (op(k,i+1,lat)/bmod2(i+1,lat)**2- & + op(k,i-1,lat)/bmod2(i-1,lat)**2)) +! +! 'EXPLICITb' +! + explicit_b(k,i,lat) = & + (by(i,lat)*(bvel(k,i,jp1)-bvel(k,i,jm1))+ & + 0.5_r8*(vi(k,i,lat)+vi(k+1,i,lat))*bmod2(i,lat)**2* & + (op(k,i,jp1)/bmod2(i,jp1)**2- & + op(k,i,jm1)/bmod2(i,jm1)**2)) +! +! 'EXPLICIT1' +! explicit will receive polar values after this latitude scan. +! + explicit(k,i,lat) = explicit(k,i,lat)+1._r8/(2._r8*re)* & + (1._r8/(cs(lat)*dlamda)*explicit_a(k,i,lat)+ & + 1._r8/dphi*explicit_b(k,i,lat)) + +! +! explicit is bad at i=1,72,73,144 near south pole (npole appears to be ok) +! This does not appear to adversely affect the final O+ output, and TIEGCM +! has the same high magnitudes, so am ignoring this for now. The high magnitudes +! are near the south pole, at processor longitude boundaries (implicating an error +! with longitude halo points). +! + if (debug) then + if (explicit(k,i,lat) < -300._r8 .or. explicit(k,i,lat) > 300._r8) then + write(iulog,"('>>> bad explicit: k,i,lat=',3i4,' explicit=',es12.4)") & + k,i,lat,explicit(k,i,lat) + write(iulog,"(' cs(lat) =',3es12.4)") cs(lat) + write(iulog,"(' op(k,i-1:i+1,lat) =',3es12.4)") op(k,i-1:i+1,lat) + write(iulog,"(' op(k,i,jm1:jp1) =',3es12.4)") op(k,i,jm1:jp1) + write(iulog,"(' bvel(k,i-1:i+1,lat)=',3es12.4)") bvel(k,i-1:i+1,lat) + write(iulog,"(' bvel(k,i,jm1:jp1) =',3es12.4)") bvel(k,i,jm1:jp1) + write(iulog,"(' bmod2(i-1:i+1,lat) =',3es12.4)") bmod2(i-1:i+1,lat) + write(iulog,"(' bmod2(i,jm1:jp1) =',3es12.4)") bmod2(i,jm1:jp1) + write(iulog,"(' ui(k:k+1,i,lat) =',2es12.4)") ui(k:k+1,i,lat) + write(iulog,"(' vi(k:k+1,i,lat) =',2es12.4)") vi(k:k+1,i,lat) + write(iulog,"(' bx,by(i,lat) =',2es12.4)") bx(i,lat),by(i,lat) + endif + endif + + enddo ! k=kbot,nlev-1 + enddo ! i=i0,i1 + +!$omp parallel do private( k ) + do k=kbot,nlev + diag25(k,i0:i1,lat) = bmod2(i0:i1,lat) ! BMOD2 (redundant in vertical) + enddo + diag26(:,i0:i1,lat) = explicit_a(:,i0:i1,lat) ! EXPLICITa + diag27(:,i0:i1,lat) = explicit_b(:,i0:i1,lat) ! EXPLICITb + diag3 (:,i0:i1,lat) = explicit (:,i0:i1,lat) ! EXPLICIT1 + +!$omp parallel do private( i ) + do i=i0,i1 + dvb(i,lat) = dvb(i,lat)/bz(i,lat) + enddo ! i=i0,i1 + +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + hdz(k,i) = 1._r8/(hj(k,i,lat)*dzp) + tp1(k,i) = 0.5_r8*(ti(k,i,lat)+te(k,i,lat)) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev-1 + tphdz1(k+1,i) = 2._r8*tp1(k+1,i)*(0.5_r8*(hdz(k,i)+hdz(k+1,i)))+gmr + tphdz0(k+1,i) = 2._r8*tp1(k ,i)*(0.5_r8*(hdz(k,i)+hdz(k+1,i)))-gmr + enddo ! k=kbot,nlev-1 + enddo ! i=lon0,lon1 +! +! Upper and lower boundaries: +! Both TPHDZ0 and TPHDZ1 are zero at the poles. +! +! 5/9/15: Appears to be a problem in TPHDZ0,1 near kbot, maybe is zero? +! +!$omp parallel do private( i ) + do i=i0,i1 + tphdz1(kbot,i) = 2._r8*tp1(kbot,i)* & + (1.5_r8*hdz(kbot,i)-0.5_r8*hdz(kbot+1,i))+gmr + tphdz1(nlev,i) = 2._r8*(2._r8*tp1(nlev-1,i)-tp1(nlev-2,i))* & + (1.5_r8*hdz(nlev-1,i)-0.5_r8*hdz(nlev-2,i))+gmr + tphdz0(kbot,i) = 2._r8*(2._r8*tp1(kbot,i)-tp1(kbot+1,i))* & + (1.5_r8*hdz(kbot,i)-0.5_r8*hdz(kbot+1,i))-gmr + tphdz0(nlev,i) = 2._r8*tp1(nlev-1,i)* & + (1.5_r8*hdz(nlev-1,i)-0.5_r8*hdz(nlev-2,i))-gmr + enddo ! i=i0,i1 + diag4(:,i0:i1,lat) = tphdz0(:,i0:i1) ! TPHDZ0 + diag5(:,i0:i1,lat) = tphdz1(:,i0:i1) ! TPHDZ1 +! +! djint = dj diffusion at interfaces: +! 'DJINT' (zero at the poles - messes up the plots - may give +! diag6 polar values after the lat scan, before plotting) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev-1 + djint(k+1,i) = 0.5_r8*(dj(k,i,lat)+dj(k+1,i,lat)) + enddo + djint(kbot,i) = (1.5_r8*dj(kbot ,i,lat)-0.5_r8*dj(kbot+1,i,lat)) + djint(nlev,i) = (1.5_r8*dj(nlev-1,i,lat)-0.5_r8*dj(nlev-2,i,lat)) + enddo ! i=i0,i1 + diag6(:,i0:i1,lat) = djint(:,i0:i1) ! DJINT +! +! divbz = (DIV(B)+(DH*D*BZ)/(D*BZ) +! 'DIVBZ' Field appears as a line following mins along magnetic equator (zero at poles) +! Field may be zero at kbot? Lat slices look strange between +/- 14 deg lat. +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + divbz(k,i) = & + dvb(i,lat)+1._r8/(re*dj(k,i,lat)*bz(i,lat)**2)*(bx(i,lat)/ & + cs(lat)*(dj(k,i+1,lat)*bz(i+1,lat)-dj(k,i-1,lat)* & + bz(i-1,lat))/(2._r8*dlamda)+by(i,lat)*(dj(k,i,jp1)* & + bz(i,jp1)-dj(k,i,jm1)*bz(i,jm1))/(2._r8*dphi)) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + diag7(:,i0:i1,lat) = divbz(:,i0:i1) ! DIVBZ +! +! hdzmbz = (1./(H*DZ)-(DIV(B)+DH*D*BZ/(D*BZ))/(2*BZ))*BZ**2 +! hdzpbz = (1./(H*DZ)+(DIV(B)+DH*D*BZ/(D*BZ))/(2*BZ))*BZ**2 +! 'HDZMBZ' and 'HDZPBZ' are zero at the poles. +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + hdzmbz(k,i) = (hdz(k,i)-0.5_r8*divbz(k,i))*bz(i,lat)**2 + hdzpbz(k,i) = (hdz(k,i)+0.5_r8*divbz(k,i))*bz(i,lat)**2 + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + diag8(:,i0:i1,lat) = hdzmbz(:,i0:i1) ! HDZMBZ + diag9(:,i0:i1,lat) = hdzpbz(:,i0:i1) ! HDZPBZ +! +! Sum O+ at time n-1 to explicit terms: N(O+)/(2*DT) (N-1) +! 'EXPLICIT2' (zero at the poles) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + explicit(k,i,lat) = explicit(k,i,lat)-(opnm_smooth(k,i,lat)-shapiro_const* & + (opnm_smooth(k,i+2,lat)+opnm_smooth(k,i-2,lat)-4._r8* & + (opnm_smooth(k,i+1,lat)+opnm_smooth(k,i-1,lat))+6._r8* & + opnm_smooth(k,i,lat)))*dtx2inv + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + diag10(:,i0:i1,lat) = explicit(:,i0:i1,lat) ! EXPLICIT2 +! +! Begin coefficients p_coeff, q_coeff, r_coeff +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev-1 + p_coeff(k,i,lat) = hdzmbz(k,i)*djint(k ,i)*tphdz0(k ,i) + q_coeff(k,i,lat) = -(hdzpbz(k,i)*djint(k+1,i)*tphdz0(k+1,i)+ & + hdzmbz(k,i)*djint(k ,i)*tphdz1(k ,i)) + r_coeff(k,i,lat) = hdzpbz(k,i)*djint(k+1,i)*tphdz1(k+1,i) + enddo ! k=kbot,nlev-1 + enddo ! i=i0,i1 + + diag11(:,i0:i1,lat) = p_coeff(:,i0:i1,lat) ! P_COEFF0 (zero at poles) + diag12(:,i0:i1,lat) = q_coeff(:,i0:i1,lat) ! Q_COEFF0 (zero at ubc) + diag13(:,i0:i1,lat) = r_coeff(:,i0:i1,lat) ! R_COEFF0 (zero at ubc) +! +! bdotu = B.U +! Introducing neutral winds. +! Am not using 0.5*(om(k)+om(k+1)) here because waccm omega is on midpoints (?) +! (tiegcm has 0.5*(w(k,i,j0)+w(k+1,i,j0)) ) +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + bdotu(k,i) = bx(i,lat)*un(k,i,lat)+by(i,lat)*vn(k,i,lat)+ & + hj(k,i,lat)*bz(i,lat)*om(k,i,lat) + enddo ! k=kbot,nlev + enddo ! i=i0,i1 + diag14(:,i0:i1,lat) = bdotu(:,i0:i1) ! BDOTU +! +! Continue coefficients with vertical ion drift: +! wi is converted from interfaces to midpoints (first use of wi). +! The p,q,r coeffs are still zero at top boundary k=nlev, and at poles. +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev-2 + + p_coeff(k+1,i,lat) = p_coeff(k+1,i,lat)+(bz(i,lat)*bdotu(k,i)+ & + 0.5_r8*(wi(k+1,i,lat)+wi(k+2,i,lat)))*0.5_r8*hdz(k+1,i) + + q_coeff(k,i,lat) = q_coeff(k,i,lat)-0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat))*6._r8/re + + r_coeff(k,i,lat) = r_coeff(k,i,lat)-(bz(i,lat)*bdotu(k+1,i)+ & + 0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat)))*0.5_r8*hdz(k,i) + + enddo ! k=kbot,nlev-1 + enddo ! i=i0,i1 + + diag22(:,i0:i1,lat) = p_coeff(:,i0:i1,lat) ! P_COEFF0a + diag23(:,i0:i1,lat) = q_coeff(:,i0:i1,lat) ! Q_COEFF0a + diag24(:,i0:i1,lat) = r_coeff(:,i0:i1,lat) ! R_COEFF0a +! +! Upper (nlev) and lower (kbot) boundaries of p,q,r_coeff: +! (convert wi to midpoints) +! +! tiegcm considers nlev-1 to be the top level. Do it tiegcm-style here, +! and then extrapolate to nlev. +! +!$omp parallel do private( i ) + do i=i0,i1 + p_coeff(kbot,i,lat) = p_coeff(kbot,i,lat)+(bz(i,lat)* & ! reset p_coeff lbc + (2._r8*bdotu(kbot,i)-bdotu(kbot+1,i))+ & + 0.5_r8*(wi(kbot,i,lat)+wi(kbot+1,i,lat)))*0.5_r8*hdz(kbot,i) + + q_coeff(nlev-1,i,lat) = q_coeff(nlev-1,i,lat)- & + 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat))*6._r8/re + + r_coeff(nlev-1,i,lat) = r_coeff(nlev-1,i,lat)-(bz(i,lat)* & + (2._r8*bdotu(nlev-1,i)-bdotu(nlev-2,i))+ & + 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat)))*0.5_r8*hdz(nlev-1,i) + enddo ! i=i0,i1 +! +! Extrapolate to top level (tiegcm does not do this): +! + p_coeff(nlev,i0:i1,lat) = 1.5_r8*p_coeff(nlev-1,i0:i1,lat)- & + 0.5_r8*p_coeff(nlev-2,i0:i1,lat) + q_coeff(nlev,i0:i1,lat) = 1.5_r8*q_coeff(nlev-1,i0:i1,lat)- & + 0.5_r8*q_coeff(nlev-2,i0:i1,lat) + r_coeff(nlev,i0:i1,lat) = 1.5_r8*r_coeff(nlev-1,i0:i1,lat)- & + 0.5_r8*r_coeff(nlev-2,i0:i1,lat) +! +! All P,Q,R are zero at the poles. Polar values will be set after third lat scan. + diag15(:,i0:i1,lat) = p_coeff(:,i0:i1,lat) ! P_COEFF1 (zero at ubc and poles) + diag17(:,i0:i1,lat) = r_coeff(:,i0:i1,lat) ! R_COEFF1 (ok at ubc, zero at poles) +! +! Additions to Q coefficients (includes q_coeff lbc,ubc): +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + q_coeff(k,i,lat) = q_coeff(k,i,lat)-bdotu(k,i)*dvb(i,lat)*bz(i,lat)-dtx2inv + enddo ! k=kbot,nlev-1 + enddo ! i=i0,i1 +! +! Plot Q_COEFF1 after ubc has been set. + diag16(:,i0:i1,lat) = q_coeff(:,i0:i1,lat) ! Q_COEFF1 (ok at ubc, zero at poles) +! +! Upper boundary condition for O+: +!$omp parallel do private( i ) + do i=i0,i1 + ubca(i) = 0._r8 + ubcb(i) = -bz(i,lat)**2*djint(nlev,i)*tphdz0(nlev,i)-ubca(i) + ubca(i) = -bz(i,lat)**2*djint(nlev,i)*tphdz1(nlev,i)+ubca(i) +! +! Q = Q+B/A*R + q_coeff(nlev,i,lat) = q_coeff(nlev,i,lat)+ubcb(i)/ubca(i)* & + r_coeff(nlev,i,lat) +! +! F = F -R/A*PHI + explicit(nlev,i,lat) = explicit(nlev,i,lat)-opflux(i,lat)* & ! explicit ubc + r_coeff(nlev,i,lat)/ubca(i) + r_coeff(nlev,i,lat) = 0._r8 ! r_coeff ubc is reset to zero + enddo ! i=i0,i1 +! +! Ubc of EXPLICIT3 has a stripe along the mag equator, unlike the level below. +! + diag18(:,i0:i1,lat) = explicit(:,i0:i1,lat) ! EXPLICIT3 (ubc ok, zero at poles) + diag19(:,i0:i1,lat) = p_coeff(:,i0:i1,lat) ! P_COEFF2 (zero at ubc, zero at poles) + diag20(:,i0:i1,lat) = q_coeff(:,i0:i1,lat) ! Q_COEFF2 (ubc ok, zero at poles) + diag21(:,i0:i1,lat) = r_coeff(:,i0:i1,lat) ! R_COEFF2 (zero at ubc, zero at poles) +! +! At this point, TIEGCM calculates "sources and sinks" xiop2p and xiop2d. +! Also calculates op_loss, which is subtracted from q_coeff. +! Then TIEGCM "Add source term to RHS (explicit terms)", and calculates +! lower boundary condition N(O+) = Q/L (q_coeff, explicit, p_coeff), and +! finally calls trsolv. +! + 300 continue + enddo ! end third latitude scan (lat=lat0,lat1) +! +!------------------------ End third latitude scan --------------------- + +! +! Set poles for selected diagnostics: +! + call setpoles(diag26(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! EXPLICITa + call setpoles(diag27(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! EXPLICITb + call setpoles(diag2 (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! EXPLICIT0 + call setpoles(diag3 (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! EXPLICIT1 + call setpoles(diag6 (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! DJINT +! +! All tasks have global 2d bmod2. +! bmod2 was set by sub magfield (getapex.F90) +! allocate(bmod2(0:nlonp1,jspole-1:jnpole+1)) +! Copy bmod2 poles to diagnostic array. +! +!$omp parallel do private( i, k ) + do i=i0,i1 + do k=kbot,nlev + diag25(k,i,j0) = bmod2(i,j0) + diag25(k,i,j1) = bmod2(i,j1) + enddo + enddo + call savefld_waccm_switch(diag25,'BMOD2' ,nlev,i0,i1,j0,j1) +! +! Assign polar values to coefficients for trsolv. +! + call setpoles(explicit(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) + call setpoles(p_coeff (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) + call setpoles(q_coeff (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) + call setpoles(r_coeff (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) +! +! Call solver, defining O+ output op_out: +! +! Its best not to call this unless the coefficients and explicit terms +! have been properly set in the third latitude scan above (e.g., during +! "goto 300" debugging above, where the coeffs may not have been calculated). +! + if (calltrsolv) then + +!$omp parallel do private( lat ) + do lat=j0,j1 + + call trsolv(p_coeff (kbot:nlev,i0:i1,lat), & + q_coeff (kbot:nlev,i0:i1,lat), & + r_coeff (kbot:nlev,i0:i1,lat), & + explicit(kbot:nlev,i0:i1,lat), & + op_out (kbot:nlev,i0:i1,lat), & + kbot,nlev,kbot,nlev,i0,i1 ) + + enddo + + call savefld_waccm_switch(op_out,'OP_SOLVE',nlev,i0,i1,j0,j1) + + else ! trsolv not called (debug only) + op_out (kbot:nlev,i0:i1,j0:j1) = op (kbot:nlev,i0:i1,j0:j1) + opnm_out(kbot:nlev,i0:i1,j0:j1) = opnm(kbot:nlev,i0:i1,j0:j1) + endif ! calltrsolv +! +! Write fields from third latitude scan to waccm history: +! + call savefld_waccm_switch(explicit,'EXPLICIT',nlev,i0,i1,j0,j1) ! non-zero at ubc + call savefld_waccm_switch(p_coeff ,'P_COEFF' ,nlev,i0,i1,j0,j1) ! zero at ubc? + call savefld_waccm_switch(q_coeff ,'Q_COEFF' ,nlev,i0,i1,j0,j1) ! non-zero at ubc + call savefld_waccm_switch(r_coeff ,'R_COEFF' ,nlev,i0,i1,j0,j1) ! is set zero at ubc + + call savefld_waccm_switch(bdotdh_diff(:,i0:i1,j0:j1), 'BDOTDH_DIFF',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag1 ,'BDZDVB_OP',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag2 ,'EXPLICIT0',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag26,'EXPLICITa',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag27,'EXPLICITb',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag3 ,'EXPLICIT1',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag4 ,'TPHDZ0' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag5 ,'TPHDZ1' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag6 ,'DJINT' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag7 ,'DIVBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag8 ,'HDZMBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag9 ,'HDZPBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag10,'EXPLICIT2',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag11,'P_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag12,'Q_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag13,'R_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag14,'BDOTU' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag15,'P_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag16,'Q_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag17,'R_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag18,'EXPLICIT3',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag19,'P_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag20,'Q_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag21,'R_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag22,'P_COEFF0a',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag23,'Q_COEFF0a',nlev,i0,i1,j0,j1) + call savefld_waccm_switch(diag24,'R_COEFF0a',nlev,i0,i1,j0,j1) +! +!------------------------------------------------------------------------ +! +! Filter O+ output from solver: +! (TIMEGCM calls both filters, whereas TIEGCM calls only filter2) +! +! call filter1_op(op_out(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) +! + call filter2_op(op_out(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) +! +!----------------------- Begin fourth latitude scan --------------------- +! +!$omp parallel do private(lat, i, k, opfloor) + do lat=j0,j1 + do i=i0,i1 + do k=kbot,nlev + opnm_out(k,i,lat) = dtsmooth*op(k,i,lat)+dtsmooth_div2* & + (opnm(k,i,lat)+op_out(k,i,lat)) + enddo + enddo +! +! Insure non-negative O+ output: + do i=i0,i1 + do k=kbot,nlev + if (op_out (k,i,lat) < 1.e-5_r8) op_out (k,i,lat) = 1.e-5_r8 + if (opnm_out(k,i,lat) < 1.e-5_r8) opnm_out(k,i,lat) = 1.e-5_r8 + enddo ! k=lev0,lev1-1 + enddo ! i=lon0,lon1 +! +! Enforce O+ minimum if enforce_opfloor is true. +! Opfloor is Stan's "smooth floor" (product of two Gaussians, +! dependent on latitude and pressure level) (opmin=3000.0): +! + if (enforce_floor) then + zpmid(kbot:nlev) = log(50.e-6_r8/pmid(kbot:nlev)) ! tgcm levs -- maybe done once at init time + do k=kbot,nlev + opfloor = opmin*exp(-(glat(lat)/90.0_r8)**2/0.3_r8) & + *exp(-((zpmid(k)-4.25_r8)/zpmid(nlev))**2/0.1_r8) + do i=i0,i1 + if (op_out(k,i,lat) < opfloor) then + op_out(k,i,lat) = opfloor + endif ! opout < opfloor + enddo ! i=lon0,lon1 + enddo ! k=lev0,lev1-1 + endif ! enforce_opfloor + + enddo ! lat=lat0,lat1 + +! +! Save O+ output to WACCM history (cm^3): + call savefld_waccm_switch(op_out (:,i0:i1,j0:j1),'OP_OUT' ,nlev,i0,i1,j0,j1) + call savefld_waccm_switch(opnm_out(:,i0:i1,j0:j1),'OPNM_OUT',nlev,i0,i1,j0,j1) + end subroutine oplus_xport +!----------------------------------------------------------------------- + subroutine oplus_flux(opflux,lon0,lon1,lat0,lat1) +! +! Calculate O+ number flux for sub oplus_xport. +! Flux is returned in opflux(lon0:lon1,lat0:lat1). +! +! alatm: geomagnetic latitude at each geographic grid point (radians) + use getapex,only: alatm ! (nlonp1,jspole:jnpole) +! +! Args: + integer,intent(in) :: lon0,lon1,lat0,lat1 + real(r8),intent(out) :: opflux(lon0:lon1,lat0:lat1) +! +! Local: + integer :: i,j + real(r8),dimension(lon0:lon1,lat0:lat1) :: chi ! solar zenith angle + real(r8),parameter :: & + phid = 2.0e8_r8, & + phin = -2.0e8_r8, & +! phin = 0._r8, & + ppolar = 0._r8 + real(r8) :: a(lon0:lon1) + real(r8) :: fed(lon0:lon1) + real(r8) :: fen(lon0:lon1) +! +! Set some paramaters: + pi = 4._r8*atan(1._r8) + rtd = 45._r8/atan(1._r8) +! +! Sub get_zenith calls sub zenith (..cam/src/physics/cam/zenith.F90) + call get_zenith(chi,lon0,lon1,lat0,lat1) +! +! Latitude scan: + do j=lat0,lat1 +! +! Longitude loop: + do i=lon0,lon1 + if (abs(alatm(i,j))-pi/24._r8>=0._r8) then + a(i) = 1._r8 + else + a(i)=.5_r8*(1._r8+sin(pi*(abs(alatm(i,j))-pi/48._r8)/(pi/24._r8))) + if (a(i) < 0.05_r8) a(i) = 0.05_r8 + endif + fed(i) = phid*a(i) + fen(i) = phin*a(i) + if (chi(i,j)-0.5_r8*pi >= 0._r8) then + opflux(i,j) = fen(i) + else + opflux(i,j) = fed(i) + endif + if ((chi(i,j)*rtd-80._r8)*(chi(i,j)*rtd-100._r8) < 0._r8) then + opflux(i,j) = .5_r8*(fed(i)+fen(i))+.5_r8*(fed(i)-fen(i))* & + cos(pi*(chi(i,j)*rtd-80._r8)/20._r8) + endif +! +! Add ppolar if magnetic latitude >= 60 degrees: +! QUESTION: is the 60 deg here related to critical angles crit(2) in tiegcm? +! 3/15/15: opflux is comparable to tiegcm. +! + if (abs(alatm(i,j))-pi/3._r8 >= 0._r8) & + opflux(i,j) = opflux(i,j)+ppolar + enddo ! i=lon0,lon1 + enddo ! j=lat0,lat1 +! + end subroutine oplus_flux +!----------------------------------------------------------------------- + subroutine get_zenith(chi,i0,i1,j0,j1) +! +! Get solar zenith angle chi(i0:i1,j0:j1) (radians) +! Subroutine zenith returns cos(chi) at each (i,j) +! Note glon(i0:i1) from edyn_init is in -180 -> +180 (TIEGCM mode) +! + use time_manager,only : get_curr_calday + use edyn_geogrid,only : glon,glat + use orbit, only : zenith +! +! Args: + integer,intent(in) :: i0,i1,j0,j1 + real(r8),intent(out) :: chi(i0:i1,j0:j1) +! +! Local: + integer :: i,j + real(r8) :: dtr,calday + real(r8) :: cosZenAngR(1) + + dtr = pi/180._r8 + calday = get_curr_calday() ! fractional day of year + do j=j0,j1 + do i=i0,i1 + call zenith(calday,(/dtr*glat(j)/),(/dtr*glon(i)/),cosZenAngR,1) + chi(i,j) = acos(cosZenAngR(1)) + enddo + enddo + end subroutine get_zenith +!----------------------------------------------------------------------- + subroutine divb(dvb,i0,i1,j0,j1) +! +! Evaluate divergence of B, the unit magnetic field vector. +! (all processors have the full global 2d field) +! +! Args: + integer,intent(in) :: i0,i1,j0,j1 + real(r8),intent(out) :: dvb(i0:i1,j0:j1) +! +! Local: + integer :: i,j,jm1,jp1 + real(r8),parameter :: re = 6.37122e8_r8 ! earth radius (cm) + + dvb = 0._r8 + + call savefld_waccm(bx(i0:i1,j0:j1),'OPLUS_BX',1,i0,i1,j0,j1) + call savefld_waccm(by(i0:i1,j0:j1),'OPLUS_BY',1,i0,i1,j0,j1) + call savefld_waccm(bz(i0:i1,j0:j1),'OPLUS_BZ',1,i0,i1,j0,j1) + call savefld_waccm(bmod2(i0:i1,j0:j1),'OPLUS_BMAG',1,i0,i1,j0,j1) +! +! Note re is in cm. +! (bx,by,bz are set by sub magfield (getapex.F90)) +! (dphi,dlamda, and cs are set by sub set_geogrid (edyn_init.F90)) +! + do j=j0,j1 + jm1 = j-1 + jp1 = j+1 + do i=i0,i1 + dvb(i,j) = (((bx(i+1,j)-bx(i-1,j))/(2._r8*dlamda)+ & + (cs(jp1)*by(i,jp1)-cs(jm1)*by(i,jm1))/(2._r8*dphi))/ & + cs(j)+2._r8*bz(i,j))/re + enddo ! i=i0,i1 + enddo ! j=j0,j1 + end subroutine divb +!----------------------------------------------------------------------- + subroutine rrk(t,rms,ps1,ps2,n2,tr,ans,lon0,lon1,lev0,lev1) +! +! Returns ambipolar diffusion coefficient in ans. +! +! Args: + integer,intent(in) :: lon0,lon1,lev0,lev1 + real(r8),dimension(lev0:lev1,lon0:lon1),intent(in) :: & + t,rms,ps1,ps2,n2,tr + real(r8),dimension(lev0:lev1,lon0:lon1),intent(out) :: ans +! +! Local: +! + integer :: k,i +! +!$omp parallel do private(i,k) + do i=lon0,lon1 + do k=lev0,lev1-1 + + ans(k,i) = 1.42e17_r8*boltz*t(k,i)/(p0*expz(k)*.5_r8*(rms(k,i)+ & + rms(k+1,i))*(ps2(k,i)*rmassinv_o1*sqrt(tr(k,i))*(1._r8-0.064_r8* & + log10(tr(k,i)))**2*colfac+18.6_r8*n2(k,i)*rmassinv_n2+18.1_r8* & + ps1(k,i)*rmassinv_o2)) + + enddo ! k=lev0,lev1 + ans(lev1,i) = ans(lev1-1,i) ! should not need to do this + + enddo ! i=lon0,lon1 +! +! Cap ambipolar diffusion coefficient in ans. +! + ! acceptable range for limiter 1.e8 to 1.e9 ... + where( ans(:,:) > adiff_limiter ) + ans(:,:) = adiff_limiter + endwhere + + end subroutine rrk +!----------------------------------------------------------------------- + subroutine diffus(tp,en,hj,ans,i0,i1,lev0,lev1,lat) +! kbot,nlev +! Evaluates ans = (d/(h*dz)*tp+m*g/r)*en +! Remember: "bot2top": lev0=kbot=bottom, lev1=nlev=top +! +! Args: + integer :: i0,i1,lev0,lev1,lat + real(r8),dimension(lev0:lev1,i0:i1),intent(in) :: tp,en,hj + real(r8),dimension(lev0:lev1,i0:i1),intent(out) :: ans +! +! Local: + integer :: i,k + real(r8) :: mgr + + mgr = rmass_op*grav_cm/gask + +!$omp parallel do private(i,k) + do i=i0,i1 + do k=lev0,lev1-2 + ans(k+1,i) = 1._r8/(2._r8*hj(k+1,i)*dzp)*(tp(k+2,i)*en(k+2,i)- & + tp(k,i)*en(k,i))+mgr*en(k+1,i) + enddo + if (debug) then + write(iulog,"('diffus: lat=',i4,' i=',i4,' ans(lev0:lev1-1,i)=',2es12.4)") & + lat,i,minval(ans(lev0:lev1-1,i)),maxval(ans(lev0:lev1-1,i)) + endif + enddo +! +! Upper and lower boundaries: +! +!$omp parallel do private(i) + do i=i0,i1 +! +! Upper boundary: + ans(lev1,i) = 1._r8/(hj(lev1,i)*dzp)*(tp(lev1,i)*en(lev1,i)- & + tp(lev1-1,i)*en(lev1-1,i))+mgr*en(lev1,i) +! +! Lower boundary: + ans(lev0,i) = 1._r8/(hj(lev0,i)*dzp)*(tp(lev0+1,i)*en(lev0+1,i)- & + tp(lev0,i)*en(lev0,i))+mgr*en(lev0,i) + enddo + end subroutine diffus +!----------------------------------------------------------------------- + subroutine bdotdh(phijm1,phij,phijp1,ans,lon0,lon1,lev0,lev1,lat) +! +! Evaluates ans = (b(h)*del(h))*phi +! +! Args: + integer,intent(in) :: lon0,lon1,lev0,lev1,lat + real(r8),dimension(lev0:lev1,lon0:lon1),intent(in) :: phijm1,phijp1 + real(r8),dimension(lev0:lev1,lon0-2:lon1+2),intent(inout) :: phij ! why intent(inout)? + real(r8),dimension(lev0:lev1,lon0:lon1),intent(out) :: ans +! +! Local: + integer :: k,i +! +! Note phij longitude dimension is lon0-2:lon1+2 (only i-1 and i+1 are used). +! Halo longitudes i-1 and i+1 must have been set before this routine is +! called. ('by' is use-associated above) +! +!$omp parallel do private( i, k ) + do i=lon0,lon1 + do k=lev0,lev1 + ans(k,i) = 1._r8/re*(bx(i,lat)/(cs(lat)*2._r8*dlamda)* & + (phij(k,i+1)-phij(k,i-1))+by(i,lat)* & + (phijp1(k,i)-phijm1(k,i))/(2._r8*dphi)) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 +! + end subroutine bdotdh +!----------------------------------------------------------------------- + subroutine bdzdvb(phi,dvb,h,ans,lev0,lev1,lon0,lon1,lat) +! +! Evaluates ans = (bz*d/(h*dz)+divb)*phi +! +! Args: + integer,intent(in) :: lev0,lev1,lon0,lon1,lat + real(r8),intent(in) :: dvb(lon0:lon1) + real(r8),dimension(lev0:lev1,lon0:lon1),intent(in) :: phi,h + real(r8),dimension(lev0:lev1,lon0:lon1),intent(out) :: ans +! +! Local: + integer :: k,i +! +!$omp parallel do private( i, k ) + do i=lon0,lon1 + do k=lev0+1,lev1-1 + ans(k,i) = bz(i,lat)/(2._r8*h(k,i)*dzp)*(phi(k+1,i)-phi(k-1,i))+ & + dvb(i)*phi(k,i) + enddo ! k=lev0+1,lev1-1 + enddo ! i=lon0,lon1 +! +! Upper and lower boundaries: +!$omp parallel do private( i ) + do i=lon0,lon1 + ans(lev1,i) = bz(i,lat)/(h(lev1,i)*dzp)*(phi(lev1,i)- & + phi(lev1-1,i))+dvb(i)*phi(lev1,i) + ans(lev0,i) = bz(i,lat)/(h(lev0,i)*dzp)* & + (phi(lev0+1,i)-phi(lev0,i))+dvb(i)*phi(lev0,i) + enddo ! i=lon0,lon1 + end subroutine bdzdvb +!----------------------------------------------------------------------- + subroutine trsolv(a,b,c,f,x,lev0,lev1,k1,k2,lon0,lon1) +! +! Tri-diagonal solver. +! a(k,i)*x(k-1,i) + b(k,i)*x(k,i) + c(k,i)*x(k+1,i) = f(k,i) +! + implicit none +! +! Args: + integer,intent(in) :: lev0,lev1,k1,k2,lon0,lon1 + real(r8),dimension(lev0:lev1,lon0:lon1),intent(in) :: & + a, & ! input coefficients + b, & ! input coefficients + c, & ! input coefficients + f ! input RHS + real(r8),dimension(lev0:lev1,lon0:lon1),intent(out) :: & + x ! output +! +! Local: + integer :: k,kk,i + real(r8),dimension(lev0:lev1,lon0:lon1) :: w1,w2,w3 ! work arrays + +! +! Lower boundary (W(K1)=B(K1): + do i=lon0,lon1 + w1(lev0,i) = b(lev0,i) + enddo +! +! Set up work arrays: + do i=lon0,lon1 + do k=k1+1,k2 +! +! W(KF+K-1)=C(K-1)/W(K-1): + w2(k-1,i) = c(k-1,i) / w1(k-1,i) +! +! W(K)=A(K)*W(KF+K-1) + w1(k,i) = a(k,i) * w2(k-1,i) +! +! W(K)=B(K)-W(K) + w1(k,i) = b(k,i) - w1(k,i) + enddo ! k=k1+1,k2 + enddo ! i=lon0,lon1 +! +! Lower boundary (W(2*KF+K1)=F(K1)/W(K1)): + do i=lon0,lon1 + w3(k1,i) = f(k1,i) / w1(k1,i) + enddo +! + do i=lon0,lon1 + do k=k1+1,k2 +! +! W(2*KF+K)=A(K)*W(2*KF+K-1) + w3(k,i) = a(k,i) * w3(k-1,i) +! +! W(2*KF+K)=F(K)-W(2*KF+K) + w3(k,i) = f(k,i) - w3(k,i) +! +! W(2*KF+K)=W(2*KF+K)/W(K) + w3(k,i) = w3(k,i) / w1(k,i) + enddo ! k=k1+1,k2 + enddo ! i=lon0,lon1 +! +! Upper boundary (X(K2)=W(2*KF+K2)): + do i=lon0,lon1 + x(k2,i) = w3(k2,i) + enddo +! + +! Back substitution: + do i=lon0,lon1 + do kk=k1+1,k2 + k = k1+k2-kk ! k2-1,k1,-1 +! +! X(K)=W(KF+K)*X(K+1) + x(k,i) = w2(k,i) * x(k+1,i) +! +! X(K)=W(2*KF+K)-X(K) + x(k,i) = w3(k,i) - x(k,i) + enddo ! k=k1+1,k2 + enddo + end subroutine trsolv +!----------------------------------------------------------------------- + subroutine printpoles(f,klev,k0,k1,i0,i1,j0,j1,name) + use edyn_geogrid,only : nlat +! +! Args: + integer,intent(in) :: klev,k0,k1,i0,i1,j0,j1 + real(r8),intent(in) :: f(k0:k1,i0:i1,j0:j1) + character(len=*),intent(in) :: name +! +! Print values at the poles at klev: + if (j0==1) then + if (debug.and.masterproc) write(iulog,"(/,'printpoles ',a,' spole: klev=',i4,' f(klev,i0:i1,j0)=',/,(8es12.4))") & + name,klev,f(klev,i0:i1,j0) + endif + if (j1==nlat) then + if (debug.and.masterproc) write(iulog,"(/,'printpoles ',a,' npole: klev=',i4,' f(klev,i0:i1,j1)=',/,(8es12.4))") & + name,klev,f(klev,i0:i1,j1) + endif + + end subroutine printpoles +!----------------------------------------------------------------------- + subroutine filter1_op(f,k0,k1,i0,i1,j0,j1) +! +! Polar fft filter, option 1 (see filter.F90). +! + use filter_module,only: filter1,kut1 + use edyn_mpi ,only: mp_gatherlons_f3d,mytidi + use edyn_mpi ,only: mp_scatterlons_f3d + use edyn_geogrid ,only: nlon +! +! Args: + integer,intent(in) :: k0,k1,i0,i1,j0,j1 + real(r8),intent(inout) :: f(k0:k1,i0:i1,j0:j1) +! +! Local: + integer :: i,j,k,nlevs + real(r8) :: fik(nlon,k1-k0+1) + type(array_ptr_type) :: fkij(1) ! fkij(1)%ptr(k1-k0+1,nlon,j0:j1) + + nlevs = k1-k0+1 +! +! Define lons in fkij from current task subdomain: +! + allocate(fkij(1)%ptr(nlevs,nlon,j0:j1)) + do j=j0,j1 + do i=i0,i1 + do k=k0,k1 ! kbot,nlev + fkij(1)%ptr(k-k0+1,i,j) = f(k,i,j) + enddo + enddo + enddo +! +! Gather longitudes into tasks in first longitude column of task table +! (leftmost of each j-row) for global fft. (i.e., tasks with mytidi==0 +! gather lons from other tasks in that row). This includes all latitudes. +! + call mp_gatherlons_f3d(fkij,1,nlevs,i0,i1,j0,j1,1) +! +! Only leftmost tasks at each j-row of tasks does the global filtering: +! + if (mytidi==0) then +! +! Define 2d array with all longitudes for filter at each latitude: +! + latscan: do j=j0,j1 + if (kut1(j) >= nlon/2) cycle latscan + do i=1,nlon + do k=k0,k1 + fik(i,k-k0+1) = fkij(1)%ptr(k-k0+1,i,j) + enddo + enddo +! +! Remove wave numbers > kut(lat): +! + call filter1(fik,1,nlevs,j) +! +! Return filtered array to fkij: +! + do i=1,nlon + do k=k0,k1 + fkij(1)%ptr(k-k0+1,i,j) = fik(i,k-k0+1) + enddo + enddo ! i=1,nlon + enddo latscan ! j=j0,j1 + endif ! mytidi==0 +! +! Now leftmost task at each j-row must redistribute filtered data +! back to other tasks in the j-row (mytidi>0,mytidj) (includes latitude): +! + call mp_scatterlons_f3d(fkij,1,nlevs,i0,i1,j0,j1,1) +! +! Return filtered array to inout field at task subdomain: +! + do j=j0,j1 + do i=i0,i1 + do k=k0,k1 + f(k,i,j) = fkij(1)%ptr(k-k0+1,i,j) + enddo + enddo + enddo + deallocate(fkij(1)%ptr) + end subroutine filter1_op +!----------------------------------------------------------------------- + subroutine filter2_op(f,k0,k1,i0,i1,j0,j1) + use filter_module,only: filter2 + use edyn_mpi ,only: mp_gatherlons_f3d,mytidi + use edyn_mpi ,only: mp_scatterlons_f3d + use edyn_geogrid ,only: nlon +! +! Args: + integer,intent(in) :: k0,k1,i0,i1,j0,j1 + real(r8),intent(inout) :: f(k0:k1,i0:i1,j0:j1) +! +! Local: + integer :: i,j,k,nlevs + real(r8) :: fik(nlon,k1-k0+1) + type(array_ptr_type) :: fkij(1) ! fkij(1)%ptr(k1-k0+1,nlon,j0:j1) + + nlevs = k1-k0+1 +! +! Define lons in fkij from current task subdomain: +! + allocate(fkij(1)%ptr(nlevs,nlon,j0:j1)) +!$omp parallel do private( i,j,k ) + do j=j0,j1 + do i=i0,i1 + do k=k0,k1 + fkij(1)%ptr(k-k0+1,i,j) = f(k,i,j) + enddo + enddo + enddo +! +! Gather longitudes into tasks in first longitude column of task table +! (leftmost of each j-row) for global fft. (i.e., tasks with mytidi==0 +! gather lons from other tasks in that row). This includes all latitudes. +! + call mp_gatherlons_f3d(fkij,1,nlevs,i0,i1,j0,j1,1) +! +! Only leftmost tasks at each j-row of tasks does the global filtering: +! + if (mytidi==0) then +! +! Define 2d array with all longitudes for filter at each latitude: +! + do j=j0,j1 + do i=1,nlon + do k=k0,k1 + fik(i,k-k0+1) = fkij(1)%ptr(k-k0+1,i,j) + enddo + enddo +! +! Remove wave numbers > kut(lat): +! + call filter2(fik,1,nlevs,j) +! +! Return filtered array to fkij: +! + do i=1,nlon + do k=k0,k1 + fkij(1)%ptr(k-k0+1,i,j) = fik(i,k-k0+1) + enddo + enddo ! i=1,nlon + enddo ! j=j0,j1 + endif ! mytidi==0 +! +! Now leftmost task at each j-row must redistribute filtered data +! back to other tasks in the j-row (mytidi>0,mytidj) (includes latitude): +! + call mp_scatterlons_f3d(fkij,1,nlevs,i0,i1,j0,j1,1) +! +! Return filtered array to inout field at task subdomain: + do j=j0,j1 + do i=i0,i1 + do k=k0,k1 + f(k,i,j) = fkij(1)%ptr(k-k0+1,i,j) + enddo + enddo + enddo + deallocate(fkij(1)%ptr) + end subroutine filter2_op +!----------------------------------------------------------------------- +end module oplus diff --git a/src/ionosphere/waccmx/savefield_waccm.F90 b/src/ionosphere/waccmx/savefield_waccm.F90 new file mode 100644 index 0000000000..f968700f1c --- /dev/null +++ b/src/ionosphere/waccmx/savefield_waccm.F90 @@ -0,0 +1,98 @@ +module savefield_waccm + use shr_kind_mod,only: r8 => shr_kind_r8 ! 8-byte reals + use cam_history ,only: hist_fld_active,outfld ! Routine to output fields to history files + use edyn_mpi ,only: array_ptr_type +! +! Save fields to WACCM output history file. +! + implicit none + save + private + public savefld_waccm,savefld_waccm_switch + contains +!----------------------------------------------------------------------- + subroutine savefld_waccm(f,name,nlev,i0,i1,j0,j1) +! +! Save field to WACCM history. +! Call to addfld must be made in edyn_init for each field to be saved. +! Field names must be in user_nl_cam to be written to the file. +! +! Args: + integer,intent(in) :: nlev,i0,i1,j0,j1 + real(r8),dimension(nlev,i0:i1,j0:j1),intent(in) :: f + character(len=*),intent(in) :: name +! +! Local: + integer :: i,j,k + real(r8) :: diag_ik(i0:i1,nlev) +! + if (.not.hist_fld_active(name)) return + + if (nlev /= 1) then + do j=j0,j1 + do i=i0,i1 + do k=1,nlev + diag_ik(i,k) = f(k,i,j) + enddo + enddo + call outfld(name,diag_ik,i1-i0+1,j) + enddo + else + do j=j0,j1 + do i=i0,i1 + diag_ik(i,1) = f(1,i,j) + enddo + call outfld(name,diag_ik,i1-i0+1,j) + enddo + endif + end subroutine savefld_waccm +!----------------------------------------------------------------------- + subroutine savefld_waccm_switch(f,name,plev,i0,i1,j0,j1) +! +! Copy input array to a local array, associate a pointer to the local array, +! switch the "model format" of the pointer (shift longitude and invert vertical), +! (TIEGCM to WACCM in this case), and save the local array to WACCM history. +! (Input array is unchanged) +! + use edyn_mpi ,only: switch_model_format +! +! Args: + integer,intent(in) :: plev,i0,i1,j0,j1 + real(r8),intent(in) :: f(plev,i0:i1,j0:j1) + character(len=*),intent(in) :: name +! +! Local: + integer :: i,j + real(r8),target :: ftmp(plev,i0:i1,j0:j1) + type(array_ptr_type) :: ptr(1) + + if (.not.hist_fld_active(name)) return + +! +! Copy input to local array: + do j=j0,j1 + do i=i0,i1 + ftmp(:,i,j) = f(:,i,j) + enddo + enddo +! +! Associate local pointer (lonshift_blocks expects an array_ptr_type) + ptr(1)%ptr => ftmp +! +! Switch from TIEGCM format to WACCM format: +! + call switch_model_format(ptr,1,plev,i0,i1,j0,j1,1) +! +! Return data to local array, and save on WACCM history: +! + do j=j0,j1 + do i=i0,i1 + ftmp(1:plev,i,j) = ptr(1)%ptr(1:plev,i,j) + enddo + enddo + + call savefld_waccm(ftmp(:,i0:i1,j0:j1),trim(name),plev,i0,i1,j0,j1) + + end subroutine savefld_waccm_switch +!----------------------------------------------------------------------- +end module savefield_waccm diff --git a/src/ionosphere/waccmx/wei05sc.F90 b/src/ionosphere/waccmx/wei05sc.F90 new file mode 100644 index 0000000000..d632808f3d --- /dev/null +++ b/src/ionosphere/waccmx/wei05sc.F90 @@ -0,0 +1,1501 @@ +module wei05sc +! +! The Weimer model of high-latitude potential created by Daniel Weimer and +! if extracted, distributed, or used for any purpose other than as implemented +! in the NCAR TIEGCM and CESM/WACCM models, please contact Dan Weimer for +! further information and discussion. +! +! 2005 Version of the electric and magnetic potential (FAC) models +! by Dan Weimer. Uses Spherical Cap Harmonic Analysis (SCHA) functions. +! Model description is in: +! Weimer, D. R., Predicting Surface Geomagnetic Variations Using Ionospheric +! Electrodynamic Models, J. Geophys. Res., 110, A12307, doi:10.1029/ +! 2005JA011270, 2005. +! Some information about the model (such as outer boundary calculation) +! is also in the earlier paper: +! Weimer, D. R. (2005), Improved ionospheric electrodynamic models and +! application to calculating Joule heating rates, J. Geophys. Res., 110, +! A05306, doi:10.1029/2004JA010884. +! +! For information about the SCHA, see the paper: +! Haines, G. V., Spherical cap harmonic analysis, J. Geophys. Res., 90, B3, +! 2583, 1985. (Note that this is in JGR-B, "Solid Earth", rather than JGR-A) +! +! April, 2008: +! This f90 module of the Electric Potential model was translated +! from the original IDL by Ben Foster (NCAR, foster@ucar.edu) +! Netcdf data file wei05sc.nc was written from original IDL save files +! W05scBndy.xdr, W05scEpot.xdr, W05scBpot.xdr, and SCHAtable.dat +! +! September, 2015 btf: +! Modified for free-format fortran, and for CESM/WACCM (r8, etc). +! + use shr_kind_mod ,only: r8 => shr_kind_r8 +#ifdef WACCMX_IONOS + use cam_logfile ,only: iulog + use cam_abortutils,only: endrun + use time_manager ,only: get_curr_date + use edyn_maggrid ,only: nmlat,nmlon,nmlonp1 +#endif + implicit none + private + +#ifdef WACCMX_IONOS +! +! Coefficients read from netcdf data file wei05sc.nc: +! + integer,parameter :: & + na=6, nb=7, nex=2, n1_scha=19, n2_scha=7, n3_scha=68, & + csize=28, n_schfits=15, n_alschfits=18 + integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot + real(r8) :: bndya(na), bndyb(nb), ex_bndy(nex), ex_epot(nex),ex_bpot(nex) + real(r8) :: th0s(n3_scha), allnkm(n1_scha,n2_scha,n3_scha) + integer :: ab(csize), ls(csize), ms(csize) + real(r8) :: epot_alschfits(n_alschfits,csize), bpot_alschfits(n_alschfits,csize) + real(r8) :: bpot_schfits(n_schfits,csize),epot_schfits(n_schfits,csize) +! +! Intermediate calculations: +! + integer,parameter :: mxtablesize=500 + real(r8) :: rad2deg,deg2rad ! set by setmodel + real(r8) :: bndyfitr ! calculated by setboundary + real(r8) :: esphc(csize),bsphc(csize) ! calculated by setmodel + real(r8) :: tmat(3,3) !,ttmat(3,3) ! from setboundary + real(r8) :: plmtable(mxtablesize,csize),colattable(mxtablesize) + real(r8) :: nlms(csize) + real(r8) :: wei05sc_fac(nmlonp1,nmlat) ! field-aligned current output + +! 05/08 bae: Have ctpoten from both hemispheres from Weimer + real(r8) :: weictpoten(2),phimin,phimax + + real(r8) :: real8,real8a ! for type conversion to 8-byte real + +! +! Several items in the public list are for efield.F90 (chemistry/mozart) +! (dpie_coupling calls the weimer05 driver, but efield calls the individual +! routines, not the driver) +! + public :: weimer05 + public :: weimer05_init + +#endif + public :: ctpoten_weimer + + real(r8),protected :: ctpoten_weimer = huge(1.0_r8) + + contains + +!----------------------------------------------------------------------- + subroutine weimer05_init(wei05_ncfile) + use infnan, only: nan, assignment(=) + + character(len=*),intent(in) :: wei05_ncfile + + ctpoten_weimer = nan + bndya = nan + bndyb = nan + ex_bndy = nan + ex_bpot = nan + th0s = nan + allnkm = nan + bpot_schfits = nan + bpot_alschfits = nan + + if (wei05_ncfile.ne.'NONE') then + call read_wei05_ncfile(wei05_ncfile) + endif + + end subroutine weimer05_init + +!----------------------------------------------------------------------- + subroutine weimer05(by,bz_in,swvel,swden,sunlons,ctpoten_out) +! +! 9/16/15 btf: Driver to call Weimer 2005 model for waccm[x]. +! +#ifdef WACCMX_IONOS + use edyn_solve,only: & + nmlat0, & ! (nmlat+1)/2 + phihm ! output: high-latitude potential (nmlonp1,nmlat) + use edyn_maggrid,only: & + ylonm, & ! magnetic latitudes (nmlat) (radians) + ylatm ! magnetic longtitudes (nmlonp1) (radians) +#endif + + implicit none +! +! Args: + real(r8),intent(in) :: bz_in,by,swvel,swden + real(r8),intent(in) :: sunlons(:) + real(r8),intent(out) :: ctpoten_out ! Cross-tail potential output +#ifdef WACCMX_IONOS +! +! Local: + real(r8) :: pi,rtd + real(r8) :: angl,angle,bt + integer :: i,j + real(r8) :: rmlt,mlat,tilt,htilt,hem,ut,secs + real(r8),parameter :: fill=0._r8 + integer :: iyear,imon,iday,isecs + logical :: debug = .false. + real(r8) :: bz + + bz = bz_in + pi = 4._r8*atan(1._r8) + rtd = 180._r8/pi ! radians to degrees +! +! Get current date and time: +! + call get_curr_date(iyear,imon,iday,isecs) +! +! Get sun's location (longitude at all latitudes): +! + real8 = dble(isecs) + secs = real8 + +! +! At least one of by,bz must be non-zero: + if (by==0._r8.and.bz==0._r8) then + write(iulog,"(/,'>>> WARNING: by and bz cannot both be zero',& + ' when calling the Weimer model: am setting bz=0.01')") + bz = 0.01_r8 + endif +! + bt = sqrt(by**2+bz**2) + angl = atan2(by,bz)*rtd +! +! Convert from day-of-year to month,day and get tilt from date and ut: +! + ut = secs/3600._r8 ! decimal hours +! +! Given year and day-of-year, cvt2md returns month and day of month. +! We do not need this, since get_curr_date returns month and day of month. +! call cvt2md(iulog,iyear,idoy,imon,iday) ! given iyear,idoy, return imo,ida +! + if (debug) write(iulog,"('weimer05: iyear,imon,iday=',3i5,' ut=',f8.2)") & + iyear,imon,iday,ut + tilt = get_tilt(iyear,imon,iday,ut) + if (debug) write(iulog,"('weimer05: tilt=',e12.4)") tilt + + phihm = 0._r8 ! whole-array init (nmlonp1,nmlat) +! +! Call Weimer model for southern hemisphere electric potential: +! + hem = -1._r8 + htilt = hem * tilt + angle = hem * angl + if (debug) write(iulog,"('weimer05 call setmodel for SH potential')") + call setmodel(angle,bt,htilt,swvel,swden,'epot') + if (debug) write(iulog,"('weimer05 after setmodel for SH potential')") + do j=1,nmlat0 ! Spole to equator + do i=1,nmlon +! +! sunlons(nlat): sun's longitude in dipole coordinates (see sub sunloc) in rad +! + rmlt = (ylonm(i)-sunlons(1)) * rtd / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*rtd +! +! Obtain electric potential and convert from kV to V +! + call epotval(mlat,rmlt,fill,phihm(i,j)) + phihm(i,j) = phihm(i,j)*1000._r8 + enddo ! i=1,nmlon + enddo ! j=1,nmlat0 + if (debug) write(iulog,"('weimer05: SH phihm min,max=',2es12.4)") & + minval(phihm(1:nmlon,1:nmlat0)),maxval(phihm(1:nmlon,1:nmlat0)) +! +! Re-calculate SH values of offa, dskofa, arad, and phid and phin from +! Weimer 2005 setboundary values of offc, dskofc, and theta0 +! 9/16/15 btf: not calling this for waccm yet. See wei05loc.src for +! free-format source file w/ r8, etc., but still w/ tiegcm use-assoc. +! +! call wei05loc(1) +! +! Call Weimer model for southern hemisphere fac: +! + if (debug) write(iulog,"('weimer05 call setmodel for SH fac')") + call setmodel(angle,bt,htilt,swvel,swden,'bpot') + if (debug) write(iulog,"('weimer05 after setmodel for SH fac')") + do j=1,nmlat0 + do i=1,nmlon + rmlt = (ylonm(i)-sunlons(1)) * rtd / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*rtd + call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) + enddo ! i=1,nmlon + enddo ! j=1,nmlat0 +! +! Call Weimer model for northern hemisphere epot: +! + hem = 1._r8 + htilt = hem * tilt + angle = hem * angl + if (debug) write(iulog,"('weimer05 call setmodel for NH potential')") + call setmodel(angle,bt,htilt,swvel,swden,'epot') + if (debug) write(iulog,"('weimer05 after setmodel for NH potential')") + do j=nmlat0+1,nmlat + do i=1,nmlon +! +! sunlons(nlat): sun's longitude in dipole coordinates (see sub sunloc) in rad + rmlt = (ylonm(i)-sunlons(1)) * rtd / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*rtd +! +! Obtain electric potential and convert from kV to V + call epotval(mlat,rmlt,fill,phihm(i,j)) + phihm(i,j) = phihm(i,j)*1000._r8 + enddo ! i=1,nmlon + enddo ! j=1,nmlat0+1,nmlat + if (debug) write(iulog,"('weimer05: NH phihm min,max=',2es12.4)") & + minval(phihm(1:nmlon,nmlat0+1:nmlat)),maxval(phihm(1:nmlon,nmlat0+1:nmlat)) +! +! Re-calculate NH values of offa, dskofa, arad, and Heelis phid and phin from +! Weimer 2005 setboundary values of offc, dskofc, and theta0 +! 9/16/15 btf: not calling this for waccm yet. +! +! call wei05loc (2) +! +! Call Weimer model for northern hemisphere fac: + if (debug) write(iulog,"('weimer05 call setmodel for NH fac')") + call setmodel(angle,bt,htilt,swvel,swden,'bpot') + if (debug) write(iulog,"('weimer05 after setmodel for NH fac')") + do j=nmlat0+1,nmlat + do i=1,nmlon + rmlt = (ylonm(i)-sunlons(1)) * rtd / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*rtd + call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) + enddo ! i=1,nmlon + enddo ! j=1,nmlat0 +! +! Periodic points: + do j=1,nmlat + phihm(nmlonp1,j) = phihm(1,j) + wei05sc_fac(nmlonp1,j) = wei05sc_fac(1,j) + enddo ! j=1,nmlat +! +! Calculate ctpoten for each hemisphere: +! South: +! + phimax = -1.e36_r8 + phimin = 1.e36_r8 + do j=1,nmlat0 ! SH + do i=1,nmlon + if (phihm(i,j) > phimax) phimax = phihm(i,j) + if (phihm(i,j) < phimin) phimin = phihm(i,j) + enddo + enddo + weictpoten(1) = 0.001_r8 * (phimax - phimin) +! +! North: +! + phimax = -1.e36_r8 + phimin = 1.e36_r8 + do j=nmlat0+1,nmlat ! NH + do i=1,nmlon + if (phihm(i,j) > phimax) phimax = phihm(i,j) + if (phihm(i,j) < phimin) phimin = phihm(i,j) + enddo + enddo + weictpoten(2) = 0.001_r8 * (phimax - phimin) +! +! Return the average of the weictpoten from the SH and NH in ctpoten + ctpoten_out = 0.5_r8*(weictpoten(1)+weictpoten(2)) + ctpoten_weimer = ctpoten_out + + write(iulog,"('weimer05: ctpoten=',f8.2,' phihm min,max=',2es12.4)") & + ctpoten_weimer,minval(phihm),maxval(phihm) +! +#endif + end subroutine weimer05 +!----------------------------------------------------------------------- + subroutine read_wei05_ncfile(file) +! +! Read coefficients and other data from netcdf data file. +! + use netcdf + implicit none +! +! Arg: + character(len=*),intent(in) :: file +#ifdef WACCMX_IONOS +! +! Local: + integer :: istat,ncid + integer :: rd_na,rd_nb,rd_nex,rd_n1_scha,rd_n2_scha,rd_n3_scha,& + rd_csize,rd_n_schfits,rd_n_alschfits + integer :: id +! +! Open netcdf file for reading: +! + istat = nf90_open(file,NF90_NOWRITE,ncid) + if (istat /= NF90_NOERR) then + write(iulog,"('Error from nf90_open of netcdf file ',a)") trim(file) + call endrun('wei05sc') + else + write(iulog,"('wei05sc: opened netcdf data file',a)") trim(file) + endif +! +! Read and check dimensions: +! +! na=6 + istat = nf90_inq_dimid(ncid,"na",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_na) + if (rd_na /= na) then + write(iulog,"(/,'>>> wei05sc: rd_na /= na: rd_na=',i4,' na=',i4)") rd_na,na + call endrun('wei05sc') + endif +! +! nb=7 +! + istat = nf90_inq_dimid(ncid,"nb",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_nb) + if (rd_na /= na) then + write(iulog,"(/,'>>> wei05sc: rd_nb /= nb: rd_nb=',i4,' nb=',i4)") rd_nb,nb + call endrun('wei05sc') + endif +! +! nex=2 +! + istat = nf90_inq_dimid(ncid,"nex",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_nex) + if (rd_nex /= nex) then + write(iulog,"(/,'>>> wei05sc: rd_nex /= nex: rd_nex=',i4,' nex=',i4)") & + rd_nex,nex + call endrun('wei05sc') + endif +! +! n1_scha=19 +! + istat = nf90_inq_dimid(ncid,"n1_scha",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_n1_scha) + if (rd_n1_scha /= n1_scha) then + write(iulog,"(/,'>>> wei05sc: rd_n1_scha /= n1_scha: rd_n1_scha=',i4,' n1_scha=',i4)") & + rd_n1_scha,n1_scha + call endrun('wei05sc') + endif +! +! n2_scha=7 +! + istat = nf90_inq_dimid(ncid,"n2_scha",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_n2_scha) + if (rd_n2_scha /= n2_scha) then + write(iulog,"(/,'>>> wei05sc: rd_n2_scha /= n2_scha: rd_n2_scha=',i4,' n2_scha=',i4)") & + rd_n2_scha,n2_scha + call endrun('wei05sc') + endif +! +! n3_scha=68 +! + istat = nf90_inq_dimid(ncid,"n3_scha",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_n3_scha) + if (rd_n3_scha /= n3_scha) then + write(6,"(/,'>>> wei05sc: rd_n3_scha /= n3_scha: rd_n3_scha=',i4,' n3_scha=',i4)") & + rd_n3_scha,n3_scha + call endrun('wei05sc') + endif +! +! csize=28 +! + istat = nf90_inq_dimid(ncid,"csize",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_csize) + if (rd_csize /= csize) then + write(iulog,"(/,'>>> wei05sc: rd_csize /= csize: rd_csize=',i4,' csize=',i4)") & + rd_csize,csize + call endrun('wei05sc') + endif +! +! n_schfits=15 +! + istat = nf90_inq_dimid(ncid,"n_schfits",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_n_schfits) + if (rd_n_schfits /= n_schfits) then + write(iulog,"(/,'>>> wei05sc: rd_n_schfits /= n_schfits: rd_n_schfits=',i4,' n_schfits=',i4)") & + rd_n_schfits,n_schfits + call endrun('wei05sc') + endif +! +! n_alschfits=18 +! + istat = nf90_inq_dimid(ncid,"n_alschfits",id) + istat = nf90_inquire_dimension(ncid,id,len=rd_n_alschfits) + if (rd_n_alschfits /= n_alschfits) then + write(iulog,"(/,'>>> wei05sc: rd_n_alschfits /= n_alschfits: rd_n_alschfits=',i4,' n_alschfits=',i4)") & + rd_n_alschfits,n_alschfits + call endrun('wei05sc') + endif +! +! integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot +! maxk_scha = 18 ; +! maxm_scha = 6 ; +! maxl_pot = 12 ; +! maxm_pot = 2 ; +! + istat = nf90_inq_dimid(ncid,"maxk_scha",id) + istat = nf90_inquire_dimension(ncid,id,len=maxk_scha) + istat = nf90_inq_dimid(ncid,"maxm_scha",id) + istat = nf90_inquire_dimension(ncid,id,len=maxm_scha) + istat = nf90_inq_dimid(ncid,"maxl_pot",id) + istat = nf90_inquire_dimension(ncid,id,len=maxl_pot) + istat = nf90_inq_dimid(ncid,"maxm_pot",id) + istat = nf90_inquire_dimension(ncid,id,len=maxm_pot) + +! write(iulog,"('wei05sc: maxk_scha=',i3,' maxm_scha=',i3)") & +! maxk_scha,maxm_scha +! write(iulog,"('wei05sc: maxl_pot=',i3,' maxm_pot=',i3)") & +! maxl_pot,maxm_pot +! +! Read variables: +! +! double bndya(na): + istat = nf90_inq_varid(ncid,'bndya',id) + istat = nf90_get_var(ncid,id,bndya) +! write(iulog,"('wei05sc: bndya=',/,(8f8.3))") bndya +! +! double bndyb(nb): + istat = nf90_inq_varid(ncid,'bndyb',id) + istat = nf90_get_var(ncid,id,bndyb) +! write(iulog,"('wei05sc: bndyb=',/,(8f8.3))") bndyb +! +! double ex_bndy(nex): + istat = nf90_inq_varid(ncid,'ex_bndy',id) + istat = nf90_get_var(ncid,id,ex_bndy) +! write(iulog,"('wei05sc: ex_bndy=',/,(8f8.3))") ex_bndy +! +! double th0s(n3_scha): + istat = nf90_inq_varid(ncid,'th0s',id) + istat = nf90_get_var(ncid,id,th0s) +! write(iulog,"('wei05sc: th0s=',/,(8f8.3))") th0s +! +! double allnkm(n1_scha,n2_scha,n3_scha): + istat = nf90_inq_varid(ncid,'allnkm',id) + istat = nf90_get_var(ncid,id,allnkm) +! write(iulog,"('wei05sc: allnkm min,max=',2e12.4)") minval(allnkm),maxval(allnkm) +! +! int ab(csize): + istat = nf90_inq_varid(ncid,'ab',id) + istat = nf90_get_var(ncid,id,ab) +! write(iulog,"('wei05sc: ab=',/,(10i4))") ab +! +! int ls(csize): + istat = nf90_inq_varid(ncid,'ls',id) + istat = nf90_get_var(ncid,id,ls) +! write(iulog,"('wei05sc: ls=',/,(10i4))") ls +! +! int ms(csize): + istat = nf90_inq_varid(ncid,'ms',id) + istat = nf90_get_var(ncid,id,ms) +! write(iulog,"('wei05sc: ms=',/,(10i4))") ms +! +! double ex_epot(nex): + istat = nf90_inq_varid(ncid,'ex_epot',id) + istat = nf90_get_var(ncid,id,ex_epot) +! write(iulog,"('wei05sc: ex_epot=',/,(8f8.3))") ex_epot +! +! double ex_bpot(nex): + istat = nf90_inq_varid(ncid,'ex_bpot',id) + istat = nf90_get_var(ncid,id,ex_bpot) +! write(iulog,"('wei05sc: ex_bpot=',/,(8f8.3))") ex_bpot +! +! double epot_schfits(csize,n_schfits): + istat = nf90_inq_varid(ncid,'epot_schfits',id) + istat = nf90_get_var(ncid,id,epot_schfits) +! write(iulog,"('wei05sc: epot_schfits min,max=',2e12.4)") & +! minval(epot_schfits),maxval(epot_schfits) +! +! double bpot_schfits(csize,n_schfits): + istat = nf90_inq_varid(ncid,'bpot_schfits',id) + istat = nf90_get_var(ncid,id,bpot_schfits) +! write(iulog,"('wei05sc: bpot_schfits min,max=',2e12.4)") & +! minval(bpot_schfits),maxval(bpot_schfits) +! +! double epot_alschfits(csize,n_alschfits): + istat = nf90_inq_varid(ncid,'epot_alschfits',id) + istat = nf90_get_var(ncid,id,epot_alschfits) +! write(iulog,"('wei05sc: epot_alschfits min,max=',2e12.4)") & +! minval(epot_alschfits),maxval(epot_alschfits) +! +! double bpot_alschfits(csize,n_alschfits): + istat = nf90_inq_varid(ncid,'bpot_alschfits',id) + istat = nf90_get_var(ncid,id,bpot_alschfits) +! write(iulog,"('wei05sc: bpot_alschfits min,max=',2e12.4)") & +! minval(bpot_alschfits),maxval(bpot_alschfits) +! +! Close file: + istat = nf90_close(ncid) + write(iulog,"('wei05sc: completed read of file ',a)") trim(file) +#endif + end subroutine read_wei05_ncfile +#ifdef WACCMX_IONOS +!----------------------------------------------------------------------- + subroutine setmodel(angle,bt,tilt,swvel,swden,model) +! +! Calculate the complete set of the models' SCHA coeficients, +! given an aribitrary IMF angle (degrees from northward toward +Y), +! given byimf, bzimf, solar wind velocity (km/sec), and density. +! + implicit none +! +! Args: + real(r8),intent(in) :: angle,bt,tilt,swvel,swden + character(len=*),intent(in) :: model +! +! Local: + integer :: i,j + real(r8) :: pi,stilt,stilt2,sw,swp,swe,c0,rang,cosa,sina,cos2a,sin2a + real(r8) :: a(n_schfits) +! + if (trim(model) /= 'epot'.and.trim(model) /= 'bpot') then + write(iulog,"('>>> model=',a)") trim(model) + write(iulog,"('>>> setmodel: model must be either','''epot'' or ''bpot''')") + call endrun('setmodel') + endif +! + pi = 4._r8*atan(1._r8) + rad2deg = 180._r8/pi + deg2rad = pi/180._r8 +! +! write(iulog,"('setmodel call setboundary: model=',a,' swvel=',e12.4)") & +! model, swvel + + call setboundary(angle,bt,swvel,swden) +! + stilt = sin(tilt*deg2rad) + stilt2 = stilt**2 + sw = bt*swvel/1000._r8 + if (trim(model) == 'epot') then + swe = (1._r8-exp(-sw*ex_epot(2)))*sw**ex_epot(1) + else + swe = (1._r8-exp(-sw*ex_bpot(2)))*sw**ex_bpot(1) + endif + c0 = 1._r8 + swp = swvel**2 * swden*1.6726e-6_r8 + rang = angle*deg2rad + cosa = cos(rang) + sina = sin(rang) + cos2a = cos(2._r8*rang) + sin2a = sin(2._r8*rang) + if (bt < 1._r8) then ! remove angle dependency for IMF under 1 nT + cosa = -1._r8+bt*(cosa+1._r8) + cos2a = 1._r8+bt*(cos2a-1._r8) + sina = bt*sina + sin2a = bt*sin2a + endif + a = (/c0 , swe , stilt , stilt2 , swp, & + swe*cosa, stilt*cosa, stilt2*cosa, swp*cosa, & + swe*sina, stilt*sina, stilt2*sina, swp*sina, & + swe*cos2a,swe*sin2a/) + if (trim(model) == 'epot') then + esphc(:) = 0._r8 + do j=1,csize + do i=1,n_schfits + esphc(j) = esphc(j)+epot_schfits(i,j)*a(i) + enddo + enddo +! write(iulog,"('setmodel: esphc=',/,(6e12.4))") esphc + else + bsphc(:) = 0._r8 + do j=1,csize + do i=1,n_schfits + bsphc(j) = bsphc(j)+bpot_schfits(i,j)*a(i) + enddo + enddo +! write(iulog,"('setmodel: bsphc=',/,(6e12.4))") bsphc + endif + end subroutine setmodel +!----------------------------------------------------------------------- + subroutine setboundary(angle,bt,swvel,swden) +! +! Sets the coefficients that define the low-latitude boundary model, +! given the IMF and solar wind values. +! + implicit none +! +! Args: + real(r8),intent(in) :: angle,bt,swvel,swden +! +! Local: + integer :: i + real(r8) :: swp,xc,theta,ct,st,cosa,btx,x(na),c(na) +! +! Calculate the transformation matrix to the coordinate system +! of the offset pole. +! + xc = 4.2_r8 + theta = xc*(deg2rad) + ct = cos(theta) + st = sin(theta) +! + tmat(1,:) = (/ ct, 0._r8, st/) + tmat(2,:) = (/ 0._r8, 1._r8, 0._r8/) + tmat(3,:) = (/-st, 0._r8, ct/) +! +! ttmat(1,:) = (/ct, 0._r8,-st/) +! ttmat(2,:) = (/ 0._r8,1._r8, 0._r8/) +! ttmat(3,:) = (/st, 0._r8, ct/) +! + swp = swden*swvel**2*1.6726e-6_r8 ! pressure + cosa = cos(angle*deg2rad) + btx = 1._r8-exp(-bt*ex_bndy(1)) + if (bt > 1._r8) then + btx = btx*bt**ex_bndy(2) + else + cosa = 1._r8+bt*(cosa-1._r8) ! remove angle dependency for IMF under 1 nT + endif + x = (/1._r8, cosa, btx, btx*cosa, swvel, swp/) + c = bndya + bndyfitr = 0._r8 + do i=1,na + bndyfitr = bndyfitr+x(i)*c(i) + +! write(iulog,"('setboundry: i=',i3,' bndyfitr=',e12.4)") i,bndyfitr + + enddo + end subroutine setboundary +!----------------------------------------------------------------------- + subroutine epotval(lat,mlt,fill,epot) +! +! Return the Potential (in kV) at given combination of def. latitude +! (lat) and MLT, in geomagnetic apex coordinates (practically identical +! to AACGM). +! If the location is outside of the model's low-latitude boundary, then +! the value "fill" is returned. +! + implicit none +! +! Args: + real(r8),intent(in) :: lat,mlt,fill + real(r8),intent(out) :: epot +! +! Local: + integer :: inside,j,m,skip + real(r8) :: z,phir,plm,colat,nlm + real(r8) :: phim(2),cospm(2),sinpm(2) +! +! checkinputs returns inside=1 if lat is inside model boundary, +! inside=0 otherwise. Phir and colat are also returned by checkinputs. +! + call checkinputs(lat,mlt,inside,phir,colat) + if (inside == 0) then + epot = fill + return + endif +! +! IDL code: +! phim=phir # replicate(1,maxm) * ((indgen(maxm)+1) ## replicate(1,n_elements(phir))) +! where the '#' operator multiplies columns of first array by rows of second array, +! and the '##' operator multiplies rows of first array by columns of second array. +! Here, maxm == maxm_pot == 2, and phir is a scalar. The above IDL statement then +! becomes: phim = ([phir] # [1,1]) * ([1,2] ## [phir]) where phim will be +! dimensioned [1,2] +! + phim(1) = phir + phim(2) = phir*2._r8 + cospm(:) = cos(phim(:)) + sinpm(:) = sin(phim(:)) +! + z = 0._r8 + skip = 0 ! Added by B.Foster, 4/23/14 + do j=1,csize + if (skip == 1) then + skip = 0 + cycle + endif + m = ms(j) + if (ab(j)==1) then + plm = scplm(j,colat,nlm) ! scplm function is in this module + skip = 0 + if (m == 0) then + z = z+plm*esphc(j) + else + z = z+plm*(esphc(j)*cospm(m)+esphc(j+1)*sinpm(m)) + skip = 1 + endif + endif ! ab(j) + enddo + epot = z + end subroutine epotval +!----------------------------------------------------------------------- + subroutine mpfac(lat,mlt,fill,fac) + implicit none +! +! Args: + real(r8),intent(in) :: lat,mlt,fill + real(r8),intent(out) :: fac +! +! Local: + integer :: j,m,inside,skip + real(r8) :: phim(2),cospm(2),sinpm(2),cfactor + real(r8) :: re,z,phir,plm,colat,nlm,pi +! + re = 6371.2_r8 + 110._r8 ! km radius (allow default ht=110) +! +! checkinputs returns inside=1 if lat is inside model boundary, +! inside=0 otherwise. Phir and colat are also returned by checkinputs. +! + call checkinputs(lat,mlt,inside,phir,colat) + if (inside == 0) then + fac = fill + return + endif +! + phim(1) = phir + phim(2) = phir*2._r8 + cospm(:) = cos(phim(:)) + sinpm(:) = sin(phim(:)) +! + z = 0._r8 + skip = 0 ! Added by B.Foster, 4/23/14 + jloop: do j=1,csize + if (skip == 1) then + skip = 0 + cycle + endif + if (ls(j) >= 11) exit jloop + m = ms(j) + if (ab(j) == 1) then + plm = scplm(j,colat,nlm) ! colat and nlm are returned (both reals) + plm = plm*(nlm*(nlm+1._r8)) +! +! bsphc was calculated in setmodel (when setmodel called with 'bpot') + if (m==0) then + z = z-plm*bsphc(j) + else + z = z-(plm*(bsphc(j)*cospm(m)+bsphc(j+1)*sinpm(m))) + skip = 1 + endif + endif + enddo jloop ! j=1,csize + pi = 4._r8*atan(1._r8) + cfactor = -1.e5_r8/(4._r8*pi*re**2) ! convert to uA/m2 + z = z*cfactor + fac = z +! write(iulog,"('mpfac: lat=',f8.3,' mlt=',f8.3,' fac=',1pe12.4)") lat,mlt,fac + end subroutine mpfac +!----------------------------------------------------------------------- + real(r8) function scplm(index,colat,nlm) +! +! Return Spherical Cap Harmonic Associated Legendre values, given colat +! values and index i into array of L and M values. +! + implicit none +! +! Args: + integer,intent(in) :: index + real(r8),intent(in) :: colat + real(r8),intent(out) :: nlm +! +! Local: + integer :: i,j,l,m,skip + real(r8) :: th0,out(1),colata(1) + real(r8) :: cth(mxtablesize) + real(r8),save :: prevth0=1.e36_r8 + integer,save :: tablesize +! + scplm = 0._r8 + skip = 0 ! Added by B.Foster, 4/23/14 + th0 = bndyfitr + if (prevth0 /= th0) then + tablesize = 3*nint(th0) + if (tablesize > mxtablesize) then + write(iulog,"('>>> tablesize > mxtablesize: tablesize=',i8,' mxtablesize=',i8,' th0=',e12.4)") & + tablesize,mxtablesize,th0 + call endrun('tablesize') + endif + do i=1,tablesize + real8 = dble(i-1) + real8a = dble(tablesize-1) + colattable(i) = real8*(th0/real8a) + cth(i) = cos(colattable(i)*deg2rad) + enddo + prevth0 = th0 + nlms = 0._r8 ! whole array init + do j=1,csize + if (skip == 1) then + skip = 0 + cycle + endif + l = ls(j) + m = ms(j) + nlms(j) = nkmlookup(l,m,th0) ! nkmlookup in this module + +! real :: plmtable(mxtablesize,csize) + call pm_n(m,nlms(j),cth,plmtable(1:tablesize,j),tablesize) + skip = 0 + if (m /= 0 .and. ab(j) > 0) then + plmtable(1,j+1) = plmtable(1,j) + nlms(j+1) = nlms(j) + skip = 1 + endif + enddo ! j=1,csize + endif ! prevth0 + nlm = nlms(index) + colata(1) = colat + call interpol_quad(plmtable(1:tablesize,index), & + colattable(1:tablesize),colata,out) + scplm = out(1) + end function scplm +!----------------------------------------------------------------------- + subroutine pm_n(m,r,cth,plmtable,tablesize) +! +! Another SCHA function, returns the SCHA version of the associated +! Legendre Polynomial, Pmn +! + implicit none +! +! Args: + integer,intent(in) :: m,tablesize + real(r8),intent(in) :: r + real(r8),intent(in) :: cth(tablesize) + real(r8),intent(out) :: plmtable(tablesize) +! +! Local: + integer :: i,k + real(r8) :: rm,rk,div,ans,xn + real(r8),dimension(tablesize) :: a,x,tmp,table +! + if (m == 0) then + a = 1._r8 ! whole array op + else + do i=1,tablesize + a(i) = sqrt(1._r8-cth(i)**2)**m + enddo + endif + xn = r*(r+1._r8) + x(:) = (1._r8-cth(:))/2._r8 + table = a ! whole array init + k = 1 + pmn_loop: do ! repeat-until loop in idl code + do i=1,tablesize + real8 = dble(m) + rm = real8 + real8 = dble(k) + rk = real8 + a(i) = a(i)*(x(i)*((rk+rm-1._r8)*(rk+rm)-xn)/(rk*(rk+rm))) + table(i) = table(i)+a(i) ! "result" in idl code + enddo + k = k+1 + do i=1,tablesize + div = abs(table(i)) + if (div <= 1.e-6_r8) div = 1.e-6_r8 + tmp(i) = abs(a(i)) / div + enddo + if (maxval(tmp) < 1.e-6_r8) exit pmn_loop + enddo pmn_loop + ans = km_n(m,r) + + plmtable(:) = table(:)*ans + end subroutine pm_n +!----------------------------------------------------------------------- + real(r8) function km_n(m,rn) +! +! A normalization function used by the SCHA routines. See Haines. +! + implicit none +! +! Args: + integer,intent(in) :: m + real(r8),intent(in) :: rn +! +! Local: + real(r8) :: rm +! + if (m == 0) then + km_n = 1._r8 + return + endif + real8 = dble(m) + rm = real8 + km_n = sqrt(2._r8*exp(lngamma(rn+rm+1._r8)-lngamma(rn-rm+1._r8))) / & + (2._r8**m*factorial(m)) + end function km_n +!----------------------------------------------------------------------- + real(r8) function nkmlookup(k,m,th0) +! +! Given the size of a spherical cap, defined by the polar cap angle, th0, +! and also the values of integers k and m, returns the value of n, a +! real number (see Haines). +! It uses interpolation from a lookup table that had been precomputed, +! in order to reduce the computation time. +! + implicit none +! +! Args: + integer,intent(in) :: k,m + real(r8),intent(in) :: th0 +! +! Local: + integer :: kk,mm + real(r8) :: th0a(1),out(1) + + if (th0 == 90._r8) then + real8 = dble(k) + nkmlookup = real8 + return + endif + th0a(1) = th0 + kk = k+1 + mm = m+1 + if (kk > maxk_scha) then + call interpol_quad(allnkm(maxk_scha,mm,:),th0s,th0a,out) + endif + if (mm > maxm_scha) then + call interpol_quad(allnkm(kk,maxm_scha,:),th0s,th0a,out) + endif + if (th0 < th0s(1)) then + write(iulog,"('>>> nkmlookup: th0 < th0s(1): th0=',e12.4,' th0s(1)=',e12.4)") & + th0,th0s(1) + endif + call interpol_quad(allnkm(kk,mm,:),th0s,th0a,out) + nkmlookup = out(1) + end function nkmlookup +!----------------------------------------------------------------------- + subroutine checkinputs(lat,mlt,inside,phir,colat) + implicit none +! +! Args: + real(r8),intent(in) :: lat,mlt + integer,intent(out) :: inside + real(r8),intent(out) :: phir,colat +! +! Local: + real(r8) :: lon,tlat,tlon,radii +! + lon = mlt*15._r8 + call dorotation(lat,lon,tlat,tlon) + radii = 90._r8-tlat + inside = 0 + if (radii <= bndyfitr) inside = 1 ! bndyfitr from setboundary + phir = tlon*deg2rad + colat = radii + end subroutine checkinputs +!----------------------------------------------------------------------- + subroutine dorotation(latin,lonin,latout,lonout) +! +! Uses transformation matrices tmat and ttmat, to convert between +! the given geomagnetic latatud/longitude, and the coordinate +! system that is used within the model,that is offset from the pole. +! +! Rotate Lat/Lon spherical coordinates with the transformation given +! by saved matrix. The coordinates are assumed to be on a sphere of +! Radius=1. Uses cartesian coordinates as an intermediate step. +! + implicit none +! +! Args: + real(r8),intent(in) :: latin,lonin + real(r8),intent(out) :: latout,lonout +! +! Local: + real(r8) :: latr,lonr,stc,ctc,sf,cf,a,b,pos(3) + integer :: i +! + latr = latin*deg2rad + lonr = lonin*deg2rad + stc = sin(latr) + ctc = cos(latr) + sf = sin(lonr) + cf = cos(lonr) + a = ctc*cf + b = ctc*sf +! +! IDL code: Pos= TM ## [[A],[B],[STC]] +! The ## operator multiplies rows of first array by columns of second array. +! Currently, TM(3,3) = Tmat (or TTmat if "reversed" was set) +! If called w/ single lat,lon, then a,b,stc are dimensioned (1), and +! Pos is then (1,3) +! + do i=1,3 + pos(i) = tmat(1,i)*a + tmat(2,i)*b + tmat(3,i)*stc + enddo + latout = asin(pos(3))*rad2deg + lonout = atan2(pos(2),pos(1))*rad2deg + end subroutine dorotation +!----------------------------------------------------------------------- + subroutine interpol_quad(v,x,u,p) +! +! f90 translation of IDL function interpol(v,x,u,/quadratic) +! + implicit none +! +! Args: + real(r8),intent(in) :: v(:),x(:),u(:) + real(r8),intent(out) :: p(:) +! +! Local: + integer :: nv,nx,nu,i,ix + real(r8) :: x0,x1,x2 +! + nv = size(v) + nx = size(x) + nu = size(u) + if (nx /= nv) then + p(:) = 0._r8 + return + endif + do i=1,nu + ix = value_locate(x,u(i)) +! 01/14 bae: interpol_quad in wei05sc.F is called when inside=1 or radii=nx assures epot is non-zero near +! the pole (85.8mlat,0MLT) and the boundary (bndryfit). + if (ix <=1) ix = 2 ! bug fix by bae 01/28/14 + if (ix >=nx) ix = nx-1 ! bug fix by bae 01/29/14 +! if (ix <= 1.or.ix >= nx) then ! bug fix by btf 12/23/09 +! p(i) = 0._r8 +! cycle ! bug fix by btf 12/23/09 +! endif + x1 = x(ix) + x0 = x(ix-1) + x2 = x(ix+1) + p(i) = v(ix-1) * (u(i)-x1) * (u(i)-x2) / ((x0-x1) * (x0-x2)) + & + v(ix) * (u(i)-x0) * (u(i)-x2) / ((x1-x0) * (x1-x2)) + & + v(ix+1) * (u(i)-x0) * (u(i)-x1) / ((x2-x0) * (x2-x1)) + enddo + end subroutine interpol_quad +!----------------------------------------------------------------------- + integer function value_locate(vec,val) +! +! f90 translation of IDL function value_locate +! Return index i into vec for which vec(i) <= val >= vec(i+1) +! Input vec must be monotonically increasing +! + implicit none +! +! Args: + real(r8),intent(in) :: vec(:),val +! +! Local: + integer :: n,i +! + value_locate = 0 + n = size(vec) + if (val < vec(1)) return + if (val > vec(n)) then + value_locate = n + return + endif + do i=1,n-1 + if (val >= vec(i) .and. val <= vec(i+1)) then + value_locate = i + return + endif + enddo + end function value_locate +!----------------------------------------------------------------------- + real(r8) function lngamma(xx) +! +! This is an f90 translation from C code copied from +! www.fizyka.umk.pl/nrbook/c6-1.pdf (numerical recipes gammln) +! + implicit none + real(r8),intent(in) :: xx + real(r8) :: x,y,tmp,ser + real(r8) :: cof(6) = (/76.18009172947146_r8, -86.50532032941677_r8, & + 24.01409824083091_r8, -1.231739572450155_r8, 0.1208650973866179e-2_r8, & + -0.5395239384953e-5_r8/) + integer :: j +! + y = xx + x = xx + tmp = x+5.5_r8 + tmp = tmp-(x+0.5_r8)*log(tmp) + ser = 1.000000000190015_r8 + do j=1,5 + y = y+1 + ser = ser+cof(j)/y + enddo + lngamma = -tmp+log(2.5066282746310005_r8*ser/x) + end function lngamma +!----------------------------------------------------------------------- + real(r8) function factorial(n) + implicit none + integer,intent(in) :: n + integer :: m + if (n <= 0) then + factorial = 0._r8 + return + endif + if (n == 1) then + factorial = 1._r8 + return + endif + real8 = dble(n) + factorial = real8 + do m = n-1,1,-1 + real8 = dble(m) + factorial = factorial * real8 + enddo + end function factorial +!----------------------------------------------------------------------- +!*********************** Copyright 1996,2001 Dan Weimer/MRC *********************** +! COORDINATE TRANSFORMATION UTILITIES + +!NCAR Feb 01: Changed TRANS to GET_TILT s.t. the dipole tilt angle is +! returned. + + real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) +! SUBROUTINE TRANS(YEAR,MONTH,DAY,HOUR,IDBUG) + implicit none + real(r8) :: B3,B32,B33 + integer :: IYR,JD,MJD,I,J,K +!NCAR + + INTEGER YEAR,MONTH,DAY,IDBUG + real(r8) :: HOUR +! +! THIS SUBROUTINE DERIVES THE ROTATION MATRICES AM(I,J,K) FOR 11 +! TRANSFORMATIONS, IDENTIFIED BY K. +! K=1 TRANSFORMS GSE to GEO +! K=2 " GEO to MAG +! K=3 " GSE to MAG +! K=4 " GSE to GSM +! K=5 " GEO to GSM +! K=6 " GSM to MAG +! K=7 " GSE to GEI +! K=8 " GEI to GEO +! K=9 " GSM to SM +! K=10 " GEO to SM +! K=11 " MAG to SM +! +! IF IDBUG IS NOT 0, THEN OUTPUTS DIAGNOSTIC INFORMATION TO +! FILE UNIT=IDBUG +! + INTEGER GSEGEO,GEOGSE,GEOMAG,MAGGEO + INTEGER GSEMAG,MAGGSE,GSEGSM,GSMGSE + INTEGER GEOGSM,GSMGEO,GSMMAG,MAGGSM + INTEGER GSEGEI,GEIGSE,GEIGEO,GEOGEI + INTEGER GSMSM,SMGSM,GEOSM,SMGEO,MAGSM,SMMAG + + PARAMETER (GSEGEO= 1,GEOGSE=-1,GEOMAG= 2,MAGGEO=-2) + PARAMETER (GSEMAG= 3,MAGGSE=-3,GSEGSM= 4,GSMGSE=-4) + PARAMETER (GEOGSM= 5,GSMGEO=-5,GSMMAG= 6,MAGGSM=-6) + PARAMETER (GSEGEI= 7,GEIGSE=-7,GEIGEO= 8,GEOGEI=-8) + PARAMETER (GSMSM = 9,SMGSM =-9,GEOSM =10,SMGEO=-10) + PARAMETER (MAGSM =11,SMMAG =-11) +! +! The formal names of the coordinate systems are: +! GSE - Geocentric Solar Ecliptic +! GEO - Geographic +! MAG - Geomagnetic +! GSM - Geocentric Solar Magnetospheric +! SM - Solar Magnetic +! +! THE ARRAY CX(I) ENCODES VARIOUS ANGLES, STORED IN DEGREES +! ST(I) AND CT(I) ARE SINES & COSINES. +! +! Program author: D. R. Weimer +! +! Some of this code has been copied from subroutines which had been +! obtained from D. Stern, NASA/GSFC. Other formulas are from "Space +! Physics Coordinate Transformations: A User Guide" by M. Hapgood (1991). +! +! The formulas for the calculation of Greenwich mean sidereal time (GMST) +! and the sun's location are from "Almanac for Computers 1990", +! U.S. Naval Observatory. +! + real(r8) :: UT,T0,GMSTD,GMSTH,ECLIP,MA,LAMD,SUNLON + +!NCAR Feb 01: Eliminate unused routines from translib.for: ROTATE, +! ROTATEV, FROMCART, TOCART, MLT, MAGLONG, SUNLOC. Remaining +! are ADJUST and JULDAY +!NCAR Nov 02: Commons MFIELD and TRANSDAT now only in TRANS (GET_TILT) +! So eliminate them as commons. For Fortran 90, eliminate +! the DATA statement for assignments (not block_data) +! COMMON/MFIELD/EPOCH,TH0,PH0,DIPOLE +! COMMON/TRANSDAT/CX(9),ST(6),CT(6),AM(3,3,11) +! + real(r8) TH0,PH0 !,DIPOLE + real(r8) CX(9),ST(6),CT(6),AM(3,3,11) +! +! TH0 = geog co-lat of NH magnetic pole +! PH0 = geog longitude of NH magnetic pole +! DIPOLE = magnitude of the B field in gauss at the equator + + TH0 = 11.19_r8 + PH0 = -70.76_r8 +! DIPOLE = 0.30574_r8 +!NCAR + +!NCAR Feb 01: Prevent debug printing to a file + IDBUG = 0 +!NCAR + + IF(YEAR.LT.1900)THEN + IYR=1900+YEAR + ELSE + IYR=YEAR + ENDIF + UT=HOUR + JD=JULDAY(MONTH,DAY,IYR) + MJD=JD-2400001 + real8 = dble(MJD) + T0=(real8-51544.5_r8)/36525.0_r8 + GMSTD=100.4606184_r8 + 36000.770_r8*T0 + 3.87933E-4_r8*T0*T0 + & + 15.0410686_r8*UT + CALL ADJUST(GMSTD) + GMSTH=GMSTD*24._r8/360._r8 + ECLIP=23.439_r8 - 0.013_r8*T0 + MA=357.528_r8 + 35999.050_r8*T0 + 0.041066678_r8*UT + CALL ADJUST(MA) + LAMD=280.460_r8 + 36000.772_r8*T0 + 0.041068642_r8*UT + CALL ADJUST(LAMD) + SUNLON=LAMD + (1.915_r8-0.0048_r8*T0)*SIND(MA) + 0.020_r8*SIND(2._r8*MA) + CALL ADJUST(SUNLON) + IF(IDBUG.NE.0)THEN + WRITE(IDBUG,*) YEAR,MONTH,DAY,HOUR + WRITE(IDBUG,*) 'MJD=',MJD + WRITE(IDBUG,*) 'T0=',T0 + WRITE(IDBUG,*) 'GMSTH=',GMSTH + WRITE(IDBUG,*) 'ECLIPTIC OBLIQUITY=',ECLIP + WRITE(IDBUG,*) 'MEAN ANOMALY=',MA + WRITE(IDBUG,*) 'MEAN LONGITUDE=',LAMD + WRITE(IDBUG,*) 'TRUE LONGITUDE=',SUNLON + ENDIF + + CX(1)= GMSTD + CX(2) = ECLIP + CX(3) = SUNLON + CX(4) = TH0 + CX(5) = PH0 +! Derived later: +! CX(6) = Dipole tilt angle +! CX(7) = Angle between sun and magnetic pole +! CX(8) = Subsolar point latitude +! CX(9) = Subsolar point longitude + + DO I=1,5 + ST(I) = SIND(CX(I)) + CT(I) = COSD(CX(I)) + ENDDO +! + AM(1,1,GSEGEI) = CT(3) + AM(1,2,GSEGEI) = -ST(3) + AM(1,3,GSEGEI) = 0._r8 + AM(2,1,GSEGEI) = ST(3)*CT(2) + AM(2,2,GSEGEI) = CT(3)*CT(2) + AM(2,3,GSEGEI) = -ST(2) + AM(3,1,GSEGEI) = ST(3)*ST(2) + AM(3,2,GSEGEI) = CT(3)*ST(2) + AM(3,3,GSEGEI) = CT(2) +! + AM(1,1,GEIGEO) = CT(1) + AM(1,2,GEIGEO) = ST(1) + AM(1,3,GEIGEO) = 0._r8 + AM(2,1,GEIGEO) = -ST(1) + AM(2,2,GEIGEO) = CT(1) + AM(2,3,GEIGEO) = 0._r8 + AM(3,1,GEIGEO) = 0._r8 + AM(3,2,GEIGEO) = 0._r8 + AM(3,3,GEIGEO) = 1._r8 +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSEGEO) = AM(I,1,GEIGEO)*AM(1,J,GSEGEI) + & + AM(I,2,GEIGEO)*AM(2,J,GSEGEI) + AM(I,3,GEIGEO)*AM(3,J,GSEGEI) + ENDDO + ENDDO +! + AM(1,1,GEOMAG) = CT(4)*CT(5) + AM(1,2,GEOMAG) = CT(4)*ST(5) + AM(1,3,GEOMAG) =-ST(4) + AM(2,1,GEOMAG) =-ST(5) + AM(2,2,GEOMAG) = CT(5) + AM(2,3,GEOMAG) = 0._r8 + AM(3,1,GEOMAG) = ST(4)*CT(5) + AM(3,2,GEOMAG) = ST(4)*ST(5) + AM(3,3,GEOMAG) = CT(4) +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSEMAG) = AM(I,1,GEOMAG)*AM(1,J,GSEGEO) + & + AM(I,2,GEOMAG)*AM(2,J,GSEGEO) + AM(I,3,GEOMAG)*AM(3,J,GSEGEO) + ENDDO + ENDDO +! + B32 = AM(3,2,GSEMAG) + B33 = AM(3,3,GSEMAG) + B3 = SQRT(B32*B32+B33*B33) + IF (B33.LE.0._r8) B3 = -B3 +! + AM(2,2,GSEGSM) = B33/B3 + AM(3,3,GSEGSM) = AM(2,2,GSEGSM) + AM(3,2,GSEGSM) = B32/B3 + AM(2,3,GSEGSM) =-AM(3,2,GSEGSM) + AM(1,1,GSEGSM) = 1._r8 + AM(1,2,GSEGSM) = 0._r8 + AM(1,3,GSEGSM) = 0._r8 + AM(2,1,GSEGSM) = 0._r8 + AM(3,1,GSEGSM) = 0._r8 +! + DO I=1,3 + DO J=1,3 + AM(I,J,GEOGSM) = AM(I,1,GSEGSM)*AM(J,1,GSEGEO) + & + AM(I,2,GSEGSM)*AM(J,2,GSEGEO) + AM(I,3,GSEGSM)*AM(J,3,GSEGEO) + ENDDO + ENDDO +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSMMAG) = AM(I,1,GEOMAG)*AM(J,1,GEOGSM) + & + AM(I,2,GEOMAG)*AM(J,2,GEOGSM) + AM(I,3,GEOMAG)*AM(J,3,GEOGSM) + ENDDO + ENDDO +! + ST(6) = AM(3,1,GSEMAG) + CT(6) = SQRT(1._r8-ST(6)*ST(6)) + CX(6) = ASIND(ST(6)) + + AM(1,1,GSMSM) = CT(6) + AM(1,2,GSMSM) = 0._r8 + AM(1,3,GSMSM) = -ST(6) + AM(2,1,GSMSM) = 0._r8 + AM(2,2,GSMSM) = 1._r8 + AM(2,3,GSMSM) = 0._r8 + AM(3,1,GSMSM) = ST(6) + AM(3,2,GSMSM) = 0._r8 + AM(3,3,GSMSM) = CT(6) +! + DO I=1,3 + DO J=1,3 + AM(I,J,GEOSM) = AM(I,1,GSMSM)*AM(1,J,GEOGSM) + & + AM(I,2,GSMSM)*AM(2,J,GEOGSM) + AM(I,3,GSMSM)*AM(3,J,GEOGSM) + ENDDO + ENDDO +! + DO I=1,3 + DO J=1,3 + AM(I,J,MAGSM) = AM(I,1,GSMSM)*AM(J,1,GSMMAG) + & + AM(I,2,GSMSM)*AM(J,2,GSMMAG) + AM(I,3,GSMSM)*AM(J,3,GSMMAG) + ENDDO + ENDDO +! + CX(7)=ATAN2D( AM(2,1,11) , AM(1,1,11) ) + CX(8)=ASIND( AM(3,1,1) ) + CX(9)=ATAN2D( AM(2,1,1) , AM(1,1,1) ) + + IF(IDBUG.NE.0)THEN + WRITE(IDBUG,*) 'Dipole tilt angle=',CX(6) + WRITE(IDBUG,*) 'Angle between sun and magnetic pole=',CX(7) + WRITE(IDBUG,*) 'Subsolar point latitude=',CX(8) + WRITE(IDBUG,*) 'Subsolar point longitude=',CX(9) + + DO K=1,11 + WRITE(IDBUG,1001) K + DO I=1,3 + WRITE(IDBUG,1002) (AM(I,J,K),J=1,3) + ENDDO + ENDDO + 1001 FORMAT(' ROTATION MATRIX ',I2) + 1002 FORMAT(3F9.5) + ENDIF + +!NCAR Mar 96: return the dipole tilt from this function call. + GET_TILT = CX(6) +!NCAR + + RETURN + end function get_tilt +!----------------------------------------------------------------------- +!NCAR Feb 01: Eliminate unused routines from translib.for: ROTATE, +! ROTATEV, FROMCART, TOCART, MLT, MAGLONG, SUNLOC. Remaining +! are ADJUST and JULDAY +!NCAR + SUBROUTINE ADJUST(ANGLE) + implicit none + real(r8) :: angle +! ADJUST AN ANGLE IN DEGREES TO BE IN RANGE OF 0 TO 360. + 10 CONTINUE + IF(ANGLE.LT.0._r8)THEN + ANGLE=ANGLE+360._r8 + GOTO 10 + ENDIF + 20 CONTINUE + IF(ANGLE.GE.360._r8)THEN + ANGLE=ANGLE-360._r8 + GOTO 20 + ENDIF + end subroutine adjust +!----------------------------------------------------------------------- + integer FUNCTION JULDAY(MM,ID,IYYY) + implicit none + integer :: igreg, iyyy, mm, id, jy, jm, ja + PARAMETER (IGREG=15+31*(10+12*1582)) + IF (IYYY.EQ.0) call endrun('There is no Year Zero.') + IF (IYYY.LT.0) IYYY=IYYY+1 + IF (MM.GT.2) THEN + JY=IYYY + JM=MM+1 + ELSE + JY=IYYY-1 + JM=MM+13 + ENDIF + JULDAY=INT(365.25_r8*JY)+INT(30.6001_r8*JM)+ID+1720995 + IF (ID+31*(MM+12*IYYY).GE.IGREG) THEN + JA=INT(0.01_r8*JY) + JULDAY=JULDAY+2-JA+INT(0.25_r8*JA) + ENDIF + end function julday +!----------------------------------------------------------------------- + SUBROUTINE CVT2MD(iulog,IYEAR,NDA,MON,DAY) +! This sub converts NDA, the day number of the year, IYEAR, +! into the appropriate month and day of month (integers) + implicit none + integer :: iulog,iyear,nda,mon,miss,numd,i + INTEGER DAY + INTEGER LMON(12) + PARAMETER (MISS=-32767) + SAVE LMON + DATA LMON/31,28,31,30,31,30,31,31,30,31,30,31/ + + LMON(2)=28 + IF(MOD(IYEAR,4) .EQ. 0)LMON(2)=29 + + NUMD=0 + DO 100 I=1,12 + IF(NDA.GT.NUMD .AND. NDA.LE.NUMD+LMON(I))GO TO 200 + NUMD=NUMD+LMON(I) + 100 CONTINUE + WRITE(iulog,'('' CVT2MD: Unable to convert year & day of year'', & + I5,'','',I5,''to month & day of month'')')IYEAR,NDA + MON = MISS + DAY = MISS + RETURN + 200 MON=I + DAY=NDA-NUMD + end subroutine cvt2md +!----------------------------------------------------------------------- +! +!NCAR Routines added to work around non-ANSI trig functions which +! input degrees instead of radians: SIND, COSD, ASIND, ATAN2D + + FUNCTION SIND (DEG) + implicit none + real(r8) :: sind,d2r,r2d,deg + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) + SIND = SIN (DEG * D2R) + end function sind +!----------------------------------------------------------------------- + FUNCTION COSD (DEG) + implicit none + real(r8) :: cosd,d2r,r2d,deg + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) + + COSD = COS (DEG * D2R) + end function cosd +!----------------------------------------------------------------------- + FUNCTION ASIND (RNUM) + implicit none + real(r8) :: asind,d2r,r2d,rnum + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) + ASIND = R2D * ASIN (RNUM) + end function asind +!----------------------------------------------------------------------- + FUNCTION ATAN2D (RNUM1,RNUM2) + implicit none + real(r8) :: atan2d,d2r,r2d,rnum1,rnum2 + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) + ATAN2D = R2D * ATAN2 (RNUM1,RNUM2) + end function atan2d +#endif +!----------------------------------------------------------------------- +end module wei05sc diff --git a/src/physics/cam/CMakeLists.txt b/src/physics/cam/CMakeLists.txt new file mode 100644 index 0000000000..a11e6a3f02 --- /dev/null +++ b/src/physics/cam/CMakeLists.txt @@ -0,0 +1,5 @@ +# Append sources from this directory to the cam_sources list. +list(APPEND cam_sources micro_mg_data.F90 micro_mg_utils.F90 + vdiff_lu_solver.F90) + +sourcelist_to_parent(cam_sources) diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 new file mode 100644 index 0000000000..06419de4d0 --- /dev/null +++ b/src/physics/cam/aer_rad_props.F90 @@ -0,0 +1,724 @@ +module aer_rad_props + +!------------------------------------------------------------------------------------------------ +! Converts aerosol masses to bulk optical properties for sw and lw radiation +! computations. +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use physconst, only: rga +use physics_types, only: physics_state + +use physics_buffer, only: physics_buffer_desc +use radconstants, only: nrh, nswbands, nlwbands, idx_sw_diag, ot_length +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, & + rad_cnst_get_aer_props +use wv_saturation, only: qsat +use modal_aer_opt, only: modal_aero_sw, modal_aero_lw +use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only +use cam_history_support, only : fillvalue +! Placed here due to PGI bug. +use ref_pres, only: clim_modal_aero_top_lev + +use cam_abortutils, only: endrun + +implicit none +private +save + +integer :: top_lev = 1 + +public :: & + aer_rad_props_init, & + aer_rad_props_sw, & ! return SW optical props of aerosols + aer_rad_props_lw ! return LW optical props of aerosols + +! Private data +character(len=fieldname_len), pointer :: odv_names(:) ! outfld names for visible OD + + +!============================================================================== +contains +!============================================================================== + +subroutine aer_rad_props_init() + use phys_control, only: phys_getopts + + + integer :: i + integer :: numaerosols ! number of aerosols + character(len=64), pointer :: aernames(:) ! aerosol names + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_aero_optics ! Output aerosol optics diagnostics + logical :: prog_modal_aero ! Prognostic modal aerosols present + + !---------------------------------------------------------------------------- + + call phys_getopts( history_aero_optics_out = history_aero_optics, & + history_amwg_out = history_amwg, & + prog_modal_aero_out = prog_modal_aero ) + + ! Limit modal aerosols with top_lev here. + if (prog_modal_aero) top_lev = clim_modal_aero_top_lev + + call addfld ('AEROD_v ', horiz_only, 'A', '1', & + 'Total Aerosol Optical Depth in visible band', flag_xyfill=.true.) + + call addfld ('AODvstrt', horiz_only, 'A', '1', & + 'Stratospheric Aerosol Optical Depth in visible band', flag_xyfill=.true.) + + ! Contributions to AEROD_v from individual aerosols (climate species). + + ! number of bulk aerosols in climate list + call rad_cnst_get_info(0, naero=numaerosols) + + ! get names of bulk aerosols + allocate(aernames(numaerosols)) + call rad_cnst_get_info(0, aernames=aernames) + + ! diagnostic output for bulk aerosols + ! create outfld names for visible OD + allocate(odv_names(numaerosols)) + do i = 1, numaerosols + odv_names(i) = 'ODV_'//trim(aernames(i)) + call addfld (odv_names(i), horiz_only, 'A', '1', & + trim(aernames(i))//' optical depth in visible band', flag_xyfill=.true.) + end do + + ! Determine default fields + if (history_amwg ) then + call add_default ('AEROD_v', 1, ' ') + endif + + if ( history_aero_optics ) then + call add_default ('AEROD_v', 1, ' ') + do i = 1, numaerosols + odv_names(i) = 'ODV_'//trim(aernames(i)) + call add_default (odv_names(i), 1, ' ') + end do + endif + + + deallocate(aernames) + +end subroutine aer_rad_props_init + +!============================================================================== + +subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & + tau, tau_w, tau_w_g, tau_w_f) + + ! Return bulk layer tau, omega, g, f for all spectral intervals. + + use physics_buffer, only : physics_buffer_desc + use tropopause, only : tropopause_find + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(:) ! local column indices of night columns + + real(r8), intent(out) :: tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * tau * w + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k ! index + integer :: troplev(pcols) + + ! optical props for each aerosol + ! hygroscopic + real(r8), pointer :: h_ext(:,:) + real(r8), pointer :: h_ssa(:,:) + real(r8), pointer :: h_asm(:,:) + ! non-hygroscopic + real(r8), pointer :: n_ext(:) + real(r8), pointer :: n_ssa(:) + real(r8), pointer :: n_asm(:) + real(r8), pointer :: n_scat(:) + real(r8), pointer :: n_ascat(:) + ! radius-dependent + real(r8), pointer :: r_ext(:,:) ! radius-dependent mass-specific extinction + real(r8), pointer :: r_scat(:,:) + real(r8), pointer :: r_ascat(:,:) + real(r8), pointer :: r_mu(:) ! log(radius) domain variable for r_ext, r_scat, r_ascat + + ! radiative properties for each aerosol + real(r8) :: ta (pcols,pver,nswbands) + real(r8) :: tw (pcols,pver,nswbands) + real(r8) :: twf(pcols,pver,nswbands) + real(r8) :: twg(pcols,pver,nswbands) + + ! aerosol masses + real(r8), pointer :: aermmr(:,:) ! mass mixing ratio of aerosols + real(r8) :: mmr_to_mass(pcols,pver) ! conversion factor for mmr to mass + real(r8) :: aermass(pcols,pver) ! mass of aerosols + + ! for table lookup into rh grid + real(r8) :: es(pcols,pver) ! saturation vapor pressure + real(r8) :: qs(pcols,pver) ! saturation specific humidity + real(r8) :: rh(pcols,pver) + real(r8) :: rhtrunc(pcols,pver) + real(r8) :: wrh(pcols,pver) + integer :: krh(pcols,pver) + + integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list + integer :: nmodes ! number of aerosol modes in climate/diagnostic list + integer :: iaerosol ! index into bulk aerosol list + + character(len=ot_length) :: opticstype ! hygro or nonhygro + character(len=16) :: pbuf_fld + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute mixing ratio to mass conversion + do k = 1, pver + mmr_to_mass(:ncol,k) = rga * state%pdeldry(:ncol,k) + enddo + + ! initialize to conditions that would cause failure + tau (:,:,:) = -100._r8 + tau_w (:,:,:) = -100._r8 + tau_w_g (:,:,:) = -100._r8 + tau_w_f (:,:,:) = -100._r8 + + ! top layer (ilev = 0) has no aerosol (ie tau = 0) + ! also initialize rest of layers to accumulate od's + tau (1:ncol,:,:) = 0._r8 + tau_w (1:ncol,:,:) = 0._r8 + tau_w_g(1:ncol,:,:) = 0._r8 + tau_w_f(1:ncol,:,:) = 0._r8 + + ! calculate relative humidity for table lookup into rh grid + call qsat(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), & + es(1:ncol,1:pver), qs(1:ncol,1:pver)) + rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) + + rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) + krh(1:ncol,1:pver) = min(floor( rhtrunc(1:ncol,1:pver) * nrh ) + 1, nrh - 1) ! index into rh mesh + wrh(1:ncol,1:pver) = rhtrunc(1:ncol,1:pver) * nrh - krh(1:ncol,1:pver) ! (-) weighting on left side values + + ! get number of bulk aerosols and number of modes in current list + call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes) + + ! Contributions from modal aerosols. + if (nmodes > 0) then + call modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & + tau, tau_w, tau_w_g, tau_w_f) + else + tau (1:ncol,:,:) = 0._r8 + tau_w (1:ncol,:,:) = 0._r8 + tau_w_g(1:ncol,:,:) = 0._r8 + tau_w_f(1:ncol,:,:) = 0._r8 + end if + + call tropopause_find(state, troplev) + + ! Contributions from bulk aerosols. + do iaerosol = 1, numaerosols + + ! get bulk aerosol mass mixing ratio + call rad_cnst_get_aer_mmr(list_idx, iaerosol, state, pbuf, aermmr) + aermass(1:ncol,1:top_lev-1) = 0._r8 + aermass(1:ncol,top_lev:pver) = aermmr(1:ncol,top_lev:pver) * mmr_to_mass(1:ncol,top_lev:pver) + + ! get optics type + call rad_cnst_get_aer_props(list_idx, iaerosol, opticstype=opticstype) + + select case (trim(opticstype)) + case('hygro','hygroscopic','hygroscopi') + ! get optical properties for hygroscopic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, sw_hygro_ext=h_ext, sw_hygro_ssa=h_ssa, sw_hygro_asm=h_asm) + call get_hygro_rad_props(ncol, krh, wrh, aermass, h_ext, h_ssa, h_asm, ta, tw, twg, twf) + tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) + tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) + tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) + tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) + + case('nonhygro','insoluble ') + ! get optical properties for non-hygroscopic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, sw_nonhygro_ext=n_ext, sw_nonhygro_ssa=n_ssa, & + sw_nonhygro_asm=n_asm) + + call get_nonhygro_rad_props(ncol, aermass, n_ext, n_ssa, n_asm, ta, tw, twg, twf) + tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) + tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) + tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) + tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) + + case('volcanic') + ! get optical properties for volcanic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, sw_nonhygro_ext=n_ext, sw_nonhygro_scat=n_scat, & + sw_nonhygro_ascat=n_ascat) + + call get_volcanic_rad_props(ncol, aermass, n_ext, n_scat, n_ascat, ta, tw, twg, twf) + tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) + tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) + tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) + tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) + + case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') + pbuf_fld = 'VOLC_RAD_GEOM ' + if (len_trim(opticstype)>15) then + pbuf_fld = trim(pbuf_fld)//opticstype(16:16) + endif + ! get optical properties for volcanic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, r_sw_ext=r_ext, r_sw_scat=r_scat, r_sw_ascat=r_ascat, mu=r_mu) + call get_volcanic_radius_rad_props(ncol, aermass, pbuf_fld, pbuf, r_ext, r_scat, r_ascat, r_mu, ta, tw, twg, twf) + tau (1:ncol,1:pver,:) = tau (1:ncol,1:pver,:) + ta (1:ncol,:,:) + tau_w (1:ncol,1:pver,:) = tau_w (1:ncol,1:pver,:) + tw (1:ncol,:,:) + tau_w_g(1:ncol,1:pver,:) = tau_w_g(1:ncol,1:pver,:) + twg(1:ncol,:,:) + tau_w_f(1:ncol,1:pver,:) = tau_w_f(1:ncol,1:pver,:) + twf(1:ncol,:,:) + + case('zero') + ! no effect of "zero" aerosols, so update nothing + case default + call endrun('aer_rad_props_sw: unsupported opticstype :'//trim(opticstype)//':') + end select + + ! diagnostic output of individual aerosol optical properties + ! currently implemented for climate list only + call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaerosol, ta(:,:,idx_sw_diag), list_idx, troplev) + + enddo + + ! diagnostic output of total aerosol optical properties + ! currently implemented for climate list only + call aer_vis_diag_out(lchnk, ncol, nnite, idxnite, 0, tau(:,:,idx_sw_diag), list_idx, troplev) + +end subroutine aer_rad_props_sw + +!============================================================================== + +subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) + + use radconstants, only: ot_length + + use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc + ! Purpose: Compute aerosol transmissions needed in absorptivity/ + ! emissivity calculations + + ! lw extinction is the same representation for all + ! species. If this changes, this routine will need to do something + ! similar to the sw with routines like get_hygro_lw_abs + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state + + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: odap_aer(pcols,pver,nlwbands) ! [fraction] absorption optical depth, per layer + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list + integer :: nmodes ! number of aerosol modes in climate/diagnostic list + integer :: iaerosol ! index into bulk aerosol list + character(len=ot_length) :: opticstype ! hygro or nonhygro + + ! optical props for each aerosol + real(r8), pointer :: lw_abs(:) + real(r8), pointer :: lw_hygro_abs(:,:) + real(r8), pointer :: geometric_radius(:,:) + + ! volcanic lookup table + real(r8), pointer :: r_lw_abs(:,:) ! radius dependent mass-specific absorption coefficient + real(r8), pointer :: r_mu(:) ! log(geometric_mean_radius) domain samples of r_lw_abs(:,:) + integer :: idx ! index to pbuf for geometric radius + real(r8) :: mu(pcols,pver) ! log(geometric_radius) + real(r8) :: r_mu_min, r_mu_max, wmu, mutrunc + integer :: nmu, kmu + + ! for table lookup into rh grid + real(r8) :: es(pcols,pver) ! saturation vapor pressure + real(r8) :: qs(pcols,pver) ! saturation specific humidity + real(r8) :: rh(pcols,pver) + real(r8) :: rhtrunc(pcols,pver) + real(r8) :: wrh(pcols,pver) + integer :: krh(pcols,pver) + + ! aerosol (vertical) mass path and extinction + ! aerosol masses + real(r8), pointer :: aermmr(:,:) ! mass mixing ratio of aerosols + real(r8) :: mmr_to_mass(pcols,pver) ! conversion factor for mmr to mass + real(r8) :: aermass(pcols,pver) ! mass of aerosols + + character(len=16) :: pbuf_fld + !----------------------------------------------------------------------------- + + ncol = state%ncol + + ! get number of bulk aerosols and number of modes in current list + call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes) + + ! Contributions from modal aerosols. + if (nmodes > 0) then + call modal_aero_lw(list_idx, state, pbuf, odap_aer) + else + odap_aer = 0._r8 + end if + + ! Contributions from bulk aerosols. + if (numaerosols > 0) then + + ! compute mixing ratio to mass conversion + do k = 1, pver + mmr_to_mass(:ncol,k) = rga * state%pdeldry(:ncol,k) + end do + + ! calculate relative humidity for table lookup into rh grid + call qsat(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), & + es(1:ncol,1:pver), qs(1:ncol,1:pver)) + rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) + + rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) + krh(1:ncol,1:pver) = min(floor( rhtrunc(1:ncol,1:pver) * nrh ) + 1, nrh - 1) ! index into rh mesh + wrh(1:ncol,1:pver) = rhtrunc(1:ncol,1:pver) * nrh - krh(1:ncol,1:pver) ! (-) weighting on left side values + + end if + + ! Loop over bulk aerosols in list. + do iaerosol = 1, numaerosols + + ! get aerosol mass mixing ratio + call rad_cnst_get_aer_mmr(list_idx, iaerosol, state, pbuf, aermmr) + aermass(1:ncol,1:top_lev-1) = 0._r8 + aermass(1:ncol,top_lev:pver) = aermmr(1:ncol,top_lev:pver) * mmr_to_mass(1:ncol,top_lev:pver) + + ! get optics type + call rad_cnst_get_aer_props(list_idx, iaerosol, opticstype=opticstype) + select case (trim(opticstype)) + case('hygroscopic') + ! get optical properties for hygroscopic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, lw_hygro_ext=lw_hygro_abs) + do bnd_idx = 1, nlwbands + do k = 1, pver + do i = 1, ncol + odap_aer(i, k, bnd_idx) = odap_aer(i, k, bnd_idx) + & + aermass(i, k) * & + ((1 + wrh(i,k)) * lw_hygro_abs(krh(i,k)+1,bnd_idx) & + - wrh(i,k) * lw_hygro_abs(krh(i,k), bnd_idx)) + end do + end do + end do + case('insoluble','nonhygro','hygro','volcanic') + ! get optical properties for hygroscopic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, lw_ext=lw_abs) + do bnd_idx = 1, nlwbands + do k = 1, pver + do i = 1, ncol + odap_aer(i,k,bnd_idx) = odap_aer(i,k,bnd_idx) + lw_abs(bnd_idx)*aermass(i,k) + end do + end do + end do + + case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') + pbuf_fld = 'VOLC_RAD_GEOM ' + if (len_trim(opticstype)>15) then + pbuf_fld = trim(pbuf_fld)//opticstype(16:16) + endif + + ! get optical properties for hygroscopic aerosols + call rad_cnst_get_aer_props(list_idx, iaerosol, r_lw_abs=r_lw_abs, mu=r_mu) + ! get microphysical properties for volcanic aerosols + idx = pbuf_get_index(pbuf_fld) + call pbuf_get_field(pbuf, idx, geometric_radius ) + + ! interpolate in radius + ! caution: clip the table with no warning when outside bounds + nmu = size(r_mu) + r_mu_max = r_mu(nmu) + r_mu_min = r_mu(1) + do i = 1, ncol + do k = 1, pver + if(geometric_radius(i,k) > 0._r8) then + mu(i,k) = log(geometric_radius(i,k)) + else + mu(i,k) = 0._r8 + endif + mutrunc = max(min(mu(i,k),r_mu_max),r_mu_min) + kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) + wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) + do bnd_idx = 1, nlwbands + odap_aer(i,k,bnd_idx) = odap_aer(i,k,bnd_idx) + & + aermass(i,k) * & + ((1._r8 - wmu) * r_lw_abs(bnd_idx, kmu ) + & + (wmu) * r_lw_abs(bnd_idx, kmu+1)) + end do + end do + end do + + case('zero') + ! zero aerosols types have no optical effect, so do nothing. + case default + call endrun('aer_rad_props_lw: unsupported opticstype: '//trim(opticstype)) + end select + end do + +end subroutine aer_rad_props_lw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & + tau, tau_w, tau_w_g, tau_w_f) + + ! Arguments + integer, intent(in) :: ncol + integer, intent(in) :: krh(pcols,pver) ! index for linear interpolation of optics on rh + real(r8), intent(in) :: wrh(pcols,pver) ! weight for linear interpolation of optics on rh + real(r8), intent(in) :: mass(pcols,pver) + real(r8), intent(in) :: ext(:,:) + real(r8), intent(in) :: ssa(:,:) + real(r8), intent(in) :: asm(:,:) + + real(r8), intent(out) :: tau (pcols,pver,nswbands) + real(r8), intent(out) :: tau_w (pcols,pver,nswbands) + real(r8), intent(out) :: tau_w_g(pcols,pver,nswbands) + real(r8), intent(out) :: tau_w_f(pcols,pver,nswbands) + + ! Local variables + real(r8) :: ext1, ssa1, asm1 + integer :: icol, ilev, iswband + !----------------------------------------------------------------------------- + + do iswband = 1, nswbands + do icol = 1, ncol + do ilev = 1, pver + ext1 = (1 + wrh(icol,ilev)) * ext(krh(icol,ilev)+1,iswband) & + - wrh(icol,ilev) * ext(krh(icol,ilev), iswband) + ssa1 = (1 + wrh(icol,ilev)) * ssa(krh(icol,ilev)+1,iswband) & + - wrh(icol,ilev) * ssa(krh(icol,ilev), iswband) + asm1 = (1 + wrh(icol,ilev)) * asm(krh(icol,ilev)+1,iswband) & + - wrh(icol,ilev) * asm(krh(icol,ilev), iswband) + + tau (icol, ilev, iswband) = mass(icol, ilev) * ext1 + tau_w (icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 + tau_w_g(icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 * asm1 + tau_w_f(icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 * asm1 * asm1 + enddo + enddo + enddo + +end subroutine get_hygro_rad_props + +!============================================================================== + +subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & + tau, tau_w, tau_w_g, tau_w_f) + + ! Arguments + integer, intent(in) :: ncol + real(r8), intent(in) :: mass(pcols, pver) + real(r8), intent(in) :: ext(:) + real(r8), intent(in) :: ssa(:) + real(r8), intent(in) :: asm(:) + + real(r8), intent(out) :: tau (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + + ! Local variables + integer :: iswband + real(r8) :: ext1, ssa1, asm1 + !----------------------------------------------------------------------------- + + do iswband = 1, nswbands + ext1 = ext(iswband) + ssa1 = ssa(iswband) + asm1 = asm(iswband) + tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 + tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 + tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 * asm1 + tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext1 * ssa1 * asm1 * asm1 + enddo + +end subroutine get_nonhygro_rad_props + +!============================================================================== + +subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ext, r_scat, r_ascat, r_mu, & + tau, tau_w, tau_w_g, tau_w_f) + + + use physics_buffer, only : pbuf_get_field, pbuf_get_index + + ! Arguments + integer, intent(in) :: ncol + real(r8), intent(in) :: mass(pcols, pver) + character(len=*) :: pbuf_radius_name + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: r_ext(:,:) + real(r8), intent(in) :: r_scat(:,:) + real(r8), intent(in) :: r_ascat(:,:) + real(r8), intent(in) :: r_mu(:) ! log(radius) domain of mass-specific optics + + real(r8), intent(out) :: tau (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + + ! Local variables + integer :: iswband + real(r8) :: g + + integer :: idx ! index to radius in physics buffer + real(r8), pointer :: geometric_radius(:,:) ! geometric mean radius of volcanic aerosol + real(r8) :: mu(pcols,pver) ! log(geometric mean radius of volcanic aerosol) + integer :: kmu, nmu + real(r8) :: wmu, mutrunc, r_mu_max, r_mu_min + + ! interpolated values from table + real(r8) :: ext(nswbands) + real(r8) :: scat(nswbands) + real(r8) :: ascat(nswbands) + + integer :: i, k ! column level iterator + !----------------------------------------------------------------------------- + + tau =0._r8 + tau_w =0._r8 + tau_w_g=0._r8 + tau_w_f=0._r8 + + ! get microphysical properties for volcanic aerosols + idx = pbuf_get_index(pbuf_radius_name) + call pbuf_get_field(pbuf, idx, geometric_radius ) + + ! interpolate in radius + ! caution: clip the table with no warning when outside bounds + nmu = size(r_mu) + r_mu_max = r_mu(nmu) + r_mu_min = r_mu(1) + do i = 1, ncol + do k = 1, pver + if(geometric_radius(i,k) > 0._r8) then + mu(i,k) = log(geometric_radius(i,k)) + else + mu(i,k) = 0._r8 + endif + mutrunc = max(min(mu(i,k),r_mu_max),r_mu_min) + kmu = max(min(1 + (mutrunc-r_mu_min)/(r_mu_max-r_mu_min)*(nmu-1),nmu-1._r8),1._r8) + wmu = max(min( (mutrunc -r_mu(kmu)) / (r_mu(kmu+1) - r_mu(kmu)) ,1._r8),0._r8) + do iswband = 1, nswbands + ext(iswband) = & + ((1._r8 - wmu) * r_ext(iswband, kmu ) + & + (wmu) * r_ext(iswband, kmu+1)) + scat(iswband) = & + ((1._r8 - wmu) * r_scat(iswband, kmu ) + & + (wmu) * r_scat(iswband, kmu+1)) + ascat(iswband) = & + ((1._r8 - wmu) * r_ascat(iswband, kmu ) + & + (wmu) * r_ascat(iswband, kmu+1)) + if (scat(iswband).gt.0._r8) then + g = ascat(iswband)/scat(iswband) + else + g=0._r8 + endif + tau (i,k,iswband) = mass(i,k) * ext(iswband) + tau_w (i,k,iswband) = mass(i,k) * scat(iswband) + tau_w_g(i,k,iswband) = mass(i,k) * ascat(iswband) + tau_w_f(i,k,iswband) = mass(i,k) * g * ascat(iswband) + end do + enddo + enddo + +end subroutine get_volcanic_radius_rad_props + +!============================================================================== + +subroutine get_volcanic_rad_props(ncol, mass, ext, scat, ascat, & + tau, tau_w, tau_w_g, tau_w_f) + + ! Arguments + integer, intent(in) :: ncol + real(r8), intent(in) :: mass(pcols, pver) + real(r8), intent(in) :: ext(:) + real(r8), intent(in) :: scat(:) + real(r8), intent(in) :: ascat(:) + + real(r8), intent(out) :: tau (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w (pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + + ! Local variables + integer :: iswband + real(r8) :: g + !----------------------------------------------------------------------------- + + do iswband = 1, nswbands + if (scat(iswband).gt.0._r8) then + g = ascat(iswband)/scat(iswband) + else + g=0._r8 + endif + tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext(iswband) + tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * scat(iswband) + tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ascat(iswband) + tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * g * ascat(iswband) + enddo + +end subroutine get_volcanic_rad_props + +!============================================================================== + +subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, troplev) + + ! output aerosol optical depth for the visible band + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(:) ! local column indices of night columns + integer, intent(in) :: iaer ! aerosol index -- if 0 then tau is a total for all aerosols + real(r8), intent(in) :: tau(:,:) ! aerosol optical depth for the visible band + integer, intent(in) :: diag_idx ! identifies whether the aerosol optics + ! is for the climate calc or a diagnostic calc + integer, intent(in) :: troplev(:) ! tropopause level + + ! Local variables + integer :: i + real(r8) :: tmp(pcols), tmp2(pcols) + !----------------------------------------------------------------------------- + + ! currently only implemented for climate calc + if (diag_idx > 0) return + + ! compute total column aerosol optical depth + tmp(1:ncol) = sum(tau(1:ncol,:), 2) + ! use fillvalue to indicate night columns + do i = 1, nnite + tmp(idxnite(i)) = fillvalue + end do + + if (iaer > 0) then + call outfld(odv_names(iaer), tmp, pcols, lchnk) + else + call outfld('AEROD_v', tmp, pcols, lchnk) + do i = 1, ncol + tmp2(i) = sum(tau(i,:troplev(i))) + end do + call outfld('AODvstrt', tmp2, pcols, lchnk) + end if + +end subroutine aer_vis_diag_out + +!============================================================================== + +end module aer_rad_props diff --git a/src/physics/cam/aoa_tracers.F90 b/src/physics/cam/aoa_tracers.F90 new file mode 100644 index 0000000000..f13660b327 --- /dev/null +++ b/src/physics/cam/aoa_tracers.F90 @@ -0,0 +1,425 @@ +!=============================================================================== +! Age of air test tracers +! provides dissipation rate and surface fluxes for diagnostic constituents +!=============================================================================== + +module aoa_tracers + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver + use constituents, only: pcnst, cnst_add, cnst_name, cnst_longname + use cam_logfile, only: iulog + use ref_pres, only: pref_mid_norm + + implicit none + private + save + + ! Public interfaces + public :: aoa_tracers_register ! register constituents + public :: aoa_tracers_implements_cnst ! true if named constituent is implemented by this package + public :: aoa_tracers_init_cnst ! initialize constituent field + public :: aoa_tracers_init ! initialize history fields, datasets + public :: aoa_tracers_timestep_init ! place to perform per timestep initialization + public :: aoa_tracers_timestep_tend ! calculate tendencies + public :: aoa_tracers_readnl ! read namelist options + + ! Private module data + + integer, parameter :: ncnst=4 ! number of constituents implemented by this module + + ! constituent names + character(len=8), parameter :: c_names(ncnst) = (/'AOA1', 'AOA2', 'HORZ', 'VERT'/) + + ! constituent source/sink names + character(len=8), parameter :: src_names(ncnst) = (/'AOA1SRC', 'AOA2SRC', 'HORZSRC', 'VERTSRC'/) + + integer :: ifirst ! global index of first constituent + integer :: ixaoa1 ! global index for AOA1 tracer + integer :: ixaoa2 ! global index for AOA2 tracer + integer :: ixht ! global index for HORZ tracer + integer :: ixvt ! global index for VERT tracer + + ! Data from namelist variables + logical :: aoa_tracers_flag = .false. ! true => turn on test tracer code, namelist variable + logical :: aoa_read_from_ic_file = .true. ! true => tracers initialized from IC file + + real(r8), parameter :: treldays = 15._r8 + real(r8), parameter :: vert_offset = 10._r8 + + ! 15-days used for diagnostic of transport circulation and K-tensors + ! relaxation (in the original papers PM-1987 and YSGD-2000) => Zonal Mean + ! to evaluate eddy-fluxes for 2D-diagnostics, here relaxation to the GLOBAL MEAN IC + ! it may help to keep gradients but will rule-out 2D-transport diagnostics + ! in km to avoid negative values of vertical tracers + ! VERT(k) = -7._r8*alog(hyam(k)+hybm(k)) + vert_offset + + ! PM-1987: + ! Plumb, R. A., and J. D. Mahlman (1987), The zonally averaged transport + ! characteristics of the GFDL general circulation/transport model, + ! J. Atmos.Sci.,44, 298-327 + + ! YSGD-2000: + ! Yudin, Valery A., Sergey P. Smyshlyaev, Marvin A. Geller, Victor L. Dvortsov, 2000: + ! Transport Diagnostics of GCMs and Implications for 2D Chemistry-Transport Model of + ! Troposphere and Stratosphere. J. Atmos. Sci., 57, 673-699. + ! doi: http://dx.doi.org/10.1175/1520-0469(2000)057<0673:TDOGAI>2.0.CO;2 + + real(r8) :: qrel_vert(pver) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + +!=============================================================================== +contains +!=============================================================================== + +!================================================================================ + subroutine aoa_tracers_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + use cam_abortutils, only: endrun + + implicit none + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aoa_tracers_readnl' + + + namelist /aoa_tracers_nl/ aoa_tracers_flag, aoa_read_from_ic_file + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aoa_tracers_nl', status=ierr) + if (ierr == 0) then + read(unitn, aoa_tracers_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(aoa_tracers_flag, 1, mpilog, 0, mpicom) + call mpibcast(aoa_read_from_ic_file, 1, mpilog, 0, mpicom) +#endif + + endsubroutine aoa_tracers_readnl + +!================================================================================ + + subroutine aoa_tracers_register + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents + ! + !----------------------------------------------------------------------- + use physconst, only: cpair, mwdry + !----------------------------------------------------------------------- + + if (.not. aoa_tracers_flag) return + + call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa1, readiv=aoa_read_from_ic_file, & + longname='Age-of_air tracer 1') + ifirst = ixaoa1 + call cnst_add(c_names(2), mwdry, cpair, 0._r8, ixaoa2, readiv=aoa_read_from_ic_file, & + longname='Age-of_air tracer 2') + call cnst_add(c_names(3), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & + longname='horizontal tracer') + call cnst_add(c_names(4), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & + longname='vertical tracer') + + end subroutine aoa_tracers_register + +!=============================================================================== + + function aoa_tracers_implements_cnst(name) + !----------------------------------------------------------------------- + ! + ! Purpose: return true if specified constituent is implemented by this package + ! + !----------------------------------------------------------------------- + + character(len=*), intent(in) :: name ! constituent name + logical :: aoa_tracers_implements_cnst ! return value + + !---------------------------Local workspace----------------------------- + integer :: m + !----------------------------------------------------------------------- + + aoa_tracers_implements_cnst = .false. + + if (.not. aoa_tracers_flag) return + + do m = 1, ncnst + if (name == c_names(m)) then + aoa_tracers_implements_cnst = .true. + return + end if + end do + + end function aoa_tracers_implements_cnst + +!=============================================================================== + + subroutine aoa_tracers_init_cnst(name, latvals, lonvals, mask, q) + + !----------------------------------------------------------------------- + ! + ! Purpose: initialize test tracers mixing ratio fields + ! This subroutine is called at the beginning of an initial run ONLY + ! + !----------------------------------------------------------------------- + + character(len=*), intent(in) :: name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev) + + integer :: m + !----------------------------------------------------------------------- + + if (.not. aoa_tracers_flag) return + + do m = 1, ncnst + if (name == c_names(m)) then + ! pass global constituent index + call init_cnst_3d(ifirst+m-1, latvals, lonvals, mask, q) + endif + end do + + end subroutine aoa_tracers_init_cnst + +!=============================================================================== + + subroutine aoa_tracers_init + + !----------------------------------------------------------------------- + ! + ! Purpose: initialize age of air constituents + ! (declare history variables) + !----------------------------------------------------------------------- + + use cam_history, only: addfld, add_default + + integer :: m, mm, k + !----------------------------------------------------------------------- + + if (.not. aoa_tracers_flag) return + + ! Set names of tendencies and declare them as history variables + + do m = 1, ncnst + mm = ifirst+m-1 + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm)) + call addfld(src_names(m), (/ 'lev' /), 'A', 'kg/kg/s', trim(cnst_name(mm))//' source/sink') + + call add_default (cnst_name(mm), 1, ' ') + call add_default (src_names(m), 1, ' ') + end do + + do k = 1,pver + qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset + enddo + + end subroutine aoa_tracers_init + +!=============================================================================== + + subroutine aoa_tracers_timestep_init( phys_state ) + !----------------------------------------------------------------------- + ! Provides a place to reinitialize diagnostic constituents HORZ and VERT + !----------------------------------------------------------------------- + + use time_manager, only: get_curr_date + use ppgrid, only: begchunk, endchunk + use physics_types, only: physics_state + + type(physics_state), intent(inout), dimension(begchunk:endchunk), optional :: phys_state + + + integer c, i, k, ncol + integer yr, mon, day, tod + !-------------------------------------------------------------------------- + + if (.not. aoa_tracers_flag) return + + call get_curr_date (yr,mon,day,tod) + + if ( day == 1 .and. tod == 0) then + if (masterproc) then + write(iulog,*) 'AGE_OF_AIR_CONSTITUENTS: RE-INITIALIZING HORZ/VERT CONSTITUENTS' + endif + + do c = begchunk, endchunk + ncol = phys_state(c)%ncol + do k = 1, pver + do i = 1, ncol + phys_state(c)%q(i,k,ixht) = 2._r8 + sin(phys_state(c)%lat(i)) + phys_state(c)%q(i,k,ixvt) = qrel_vert(k) + end do + end do + end do + + end if + + end subroutine aoa_tracers_timestep_init + +!=============================================================================== + + subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use cam_history, only: outfld + use time_manager, only: get_nstep + + ! Arguments + type(physics_state), intent(in) :: state ! state variables + type(physics_ptend), intent(out) :: ptend ! package tendencies + real(r8), intent(inout) :: cflx(pcols,pcnst) ! Surface constituent flux (kg/m^2/s) + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: dt ! timestep + + !----------------- Local workspace------------------------------- + + integer :: i, k + integer :: lchnk ! chunk identifier + integer :: ncol ! no. of column in chunk + integer :: nstep ! current timestep number + real(r8) :: qrel ! value to be relaxed to + real(r8) :: xhorz ! updated value of HORZ + real(r8) :: xvert ! updated value of VERT + logical :: lq(pcnst) + real(r8) :: teul ! relaxation in 1/sec*dt/2 = k*dt/2 + real(r8) :: wimp ! 1./(1.+ k*dt/2) + real(r8) :: wsrc ! teul*wimp + !------------------------------------------------------------------ + + teul = .5_r8*dt/(86400._r8 * treldays) ! 1/2 for the semi-implicit scheme if dt=time step + wimp = 1._r8/(1._r8 +teul) + wsrc = teul*wimp + + if (.not. aoa_tracers_flag) then + call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update + return + end if + + lq(:) = .FALSE. + lq(ixaoa1) = .TRUE. + lq(ixaoa2) = .TRUE. + lq(ixht) = .TRUE. + lq(ixvt) = .TRUE. + call physics_ptend_init(ptend,state%psetcols, 'aoa_tracers', lq=lq) + + nstep = get_nstep() + lchnk = state%lchnk + ncol = state%ncol + + do k = 1, pver + do i = 1, ncol + + ! AOA1 + ptend%q(i,k,ixaoa1) = 0.0_r8 + + ! AOA2 + ptend%q(i,k,ixaoa2) = 0.0_r8 + + ! HORZ + qrel = 2._r8 + sin(state%lat(i)) ! qrel should zonal mean + xhorz = state%q(i,k,ixht)*wimp + wsrc*qrel ! Xnew = weight*3D-tracer + (1.-weight)*1D-tracer + ptend%q(i,k,ixht) = (xhorz - state%q(i,k,ixht)) / dt ! Xnew = weight*3D-tracer + (1.-weight)*2D-tracer zonal mean + ! Can be still used .... to diagnose fluxes OT-tracers + ! VERT + qrel = qrel_vert(k) ! qrel should zonal mean + xvert = wimp*state%q(i,k,ixvt) + wsrc*qrel + ptend%q(i,k,ixvt) = (xvert - state%q(i,k,ixvt)) / dt + + end do + end do + + ! record tendencies on history files + call outfld (src_names(1), ptend%q(:,:,ixaoa1), pcols, lchnk) + call outfld (src_names(2), ptend%q(:,:,ixaoa2), pcols, lchnk) + call outfld (src_names(3), ptend%q(:,:,ixht), pcols, lchnk) + call outfld (src_names(4), ptend%q(:,:,ixvt), pcols, lchnk) + + ! Set tracer fluxes + do i = 1, ncol + + ! AOA1 + cflx(i,ixaoa1) = 1.e-6_r8 + + ! AOA2 + if (landfrac(i) .eq. 1._r8 .and. state%lat(i) .gt. 0.35_r8) then + cflx(i,ixaoa2) = 1.e-6_r8 + 1e-6_r8*0.0434_r8*real(nstep,r8)*dt/(86400._r8*365._r8) + else + cflx(i,ixaoa2) = 0._r8 + endif + + ! HORZ + cflx(i,ixht) = 0._r8 + + ! VERT + cflx(i,ixvt) = 0._r8 + + end do + + end subroutine aoa_tracers_timestep_tend + +!=========================================================================== + + subroutine init_cnst_3d(m, latvals, lonvals, mask, q) + + integer, intent(in) :: m ! global constituent index + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol,plev) + + integer :: j, k, gsize + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m + end if + + if (m == ixaoa1) then + + q(:,:) = 0.0_r8 + + else if (m == ixaoa2) then + + q(:,:) = 0.0_r8 + + else if (m == ixht) then + + gsize = size(q, 1) + do j = 1, gsize + q(j,:) = 2._r8 + sin(latvals(j)) + end do + + else if (m == ixvt) then + + do k = 1, pver + do j = 1, size(q,1) + q(j,k) = qrel_vert(k) + end do + end do + + end if + + end subroutine init_cnst_3d + +!===================================================================== + + +end module aoa_tracers diff --git a/src/physics/cam/beljaars_drag.F90 b/src/physics/cam/beljaars_drag.F90 new file mode 100644 index 0000000000..ccafd0e639 --- /dev/null +++ b/src/physics/cam/beljaars_drag.F90 @@ -0,0 +1,152 @@ +module beljaars_drag + + implicit none + private + save + + public init_blj ! Initialization + public compute_blj ! Full routine + + ! ------------ ! + ! Private data ! + ! ------------ ! + + integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + + real(r8), parameter :: horomin= 1._r8 ! Minimum value of subgrid orographic height for mountain stress [ m ] + real(r8), parameter :: z0max = 100._r8 ! Maximum value of z_0 for orography [ m ] + real(r8), parameter :: dv2min = 0.01_r8 ! Minimum shear squared [ m2/s2 ] + real(r8) :: orocnst ! Converts from standard deviation to height [ no unit ] + real(r8) :: z0fac ! Factor determining z_0 from orographic standard deviation [ no unit ] + real(r8) :: karman ! von Karman constant + real(r8) :: gravit ! Acceleration due to gravity + real(r8) :: rair ! Gas constant for dry air + +contains + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine init_blj( kind, gravit_in, rair_in , errstring ) + + integer, intent(in) :: kind + real(r8), intent(in) :: gravit_in, rair_in + + character(len=*), intent(out) :: errstring + + errstring = ' ' + + if ( kind /= r8 ) then + errstring = 'inconsistent KIND of reals passed to init_blj' + return + endif + + gravit = gravit_in + rair = rair_in + + end subroutine init_blj + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine compute_blj( pcols , pver , ncol , & + u , v , t , pmid , delp , & + zm , sgh , drag , taux , tauy , & + landfrac ) + + !------------------------------------------------------------------------------ ! + ! Beljaars Sub-Grid Orographic (SGO) Form drag parameterization ! + ! ! + ! Returns drag profile and integrated stress associated with subgrid mountains ! + ! with horizontal length scales nominally below 3km. Similar to TMS but ! + ! drag is distributed in the vertical (Beljaars et al., 2003, QJRMS). ! + ! ! + ! First cut follows TMS. J. Bacmeister, March 2016 ! + !------------------------------------------------------------------------------ ! + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + integer, intent(in) :: pcols ! Number of columns dimensioned + integer, intent(in) :: pver ! Number of model layers + integer, intent(in) :: ncol ! Number of columns actually used + + real(r8), intent(in) :: u(pcols,pver) ! Layer mid-point zonal wind [ m/s ] + real(r8), intent(in) :: v(pcols,pver) ! Layer mid-point meridional wind [ m/s ] + real(r8), intent(in) :: t(pcols,pver) ! Layer mid-point temperature [ K ] + real(r8), intent(in) :: pmid(pcols,pver) ! Layer mid-point pressure [ Pa ] + real(r8), intent(in) :: delp(pcols,pver) ! Layer thickness [ Pa ] + real(r8), intent(in) :: zm(pcols,pver) ! Layer mid-point height [ m ] + real(r8), intent(in) :: sgh(pcols) ! Standard deviation of orography [ m ] + real(r8), intent(in) :: landfrac(pcols) ! Land fraction [ fraction ] + + real(r8), intent(out) :: drag(pcols,pver) ! SGO drag profile [ kg/s/m2 ] + real(r8), intent(out) :: taux(pcols) ! Surface zonal wind stress [ N/m2 ] + real(r8), intent(out) :: tauy(pcols) ! Surface meridional wind stress [ N/m2 ] + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer :: i,k ! Loop indices + integer :: kb, kt ! Bottom and top of source region + + real(r8) :: vmag ! Velocity magnitude [ m /s ] + + real(r8) :: alpha,beta,Cmd,Ccorr,n1,n2,k1,kflt,k2,IH + real(r8) :: a1(pcols),a2(pcols) + + alpha = 12._r8 + beta = 1._r8 + n1 = -1.9_r8 + n2 = -2.8_r8 + + Cmd = 0.005_r8 + Ccorr = 0.6_r8 * 5._r8 + + kflt = 0.00035_r8 ! m-1 + k1 = 0.003_r8 ! m-1 + IH = 0.00102_r8 ! m-1 + + a1(1:ncol) = (sgh(1:ncol)*sgh(1:ncol)) / ( IH* (kflt**n1) ) + a2(1:ncol) = a1(1:ncol) * k1**(n1-n2) + + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + do k = 1, pver + do i = 1, ncol + Vmag = SQRT( u(i,k)**2 + v(i,k)**2) + drag(i,k) = -alpha * beta * Cmd * Ccorr * Vmag * 2.109_r8 * & + EXP ( -(zm(i,k)/1500._r8 )*SQRT(zm(i,k)/1500._r8) ) * ( zm(i,k)**(-1.2_r8) ) & + * a2(i) + end do + end do + + + !---------------------------------! + ! Diagnose effective surface drag ! + ! in X and Y by integrating in ! + ! the vertical ! + !---------------------------------! + ! FIXME: uses 'state' u and v. + ! Should updated u and v's be used? + + taux=0._r8 + tauy=0._r8 + do k = 1, pver + do i = 1, ncol + taux(i) = taux(i) + drag(i,k)*u(i,k)*delp(i,k)/gravit + tauy(i) = tauy(i) + drag(i,k)*v(i,k)*delp(i,k)/gravit + end do + end do + + return + end subroutine compute_blj + +end module beljaars_drag diff --git a/src/physics/cam/beljaars_drag_cam.F90 b/src/physics/cam/beljaars_drag_cam.F90 new file mode 100644 index 0000000000..d81d2bb9b0 --- /dev/null +++ b/src/physics/cam/beljaars_drag_cam.F90 @@ -0,0 +1,154 @@ +module beljaars_drag_cam + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use shr_log_mod, only: errMsg => shr_log_errMsg +use cam_logfile, only: iulog +use ppgrid, only: pcols, pver + +implicit none +private + +public :: beljaars_drag_readnl +public :: beljaars_drag_register +public :: beljaars_drag_init +public :: beljaars_drag_tend + +! Is this module on at all? +logical, public, protected :: do_beljaars = .false. + +! Tuning parameters for TMS. +real(r8) :: blj_orocnst +real(r8) :: blj_z0fac + +! pbuf field indices +integer :: & + sgh30_idx = -1, & + dragblj_idx = -1, & + taubljx_idx = -1, & + taubljy_idx = -1 + +contains + +subroutine beljaars_drag_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterprocid, mpi_logical, mpi_real8, mpicom + + ! filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! file unit and error code + integer :: unitn, ierr + + character(len=*), parameter :: subname = "beljaars_drag_readnl" + + namelist /blj_nl/ do_beljaars + + ierr = 0 + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'blj_nl', status=ierr) + if (ierr == 0) then + read(unitn, blj_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(do_beljaars, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + +end subroutine beljaars_drag_readnl + +subroutine beljaars_drag_register() + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call pbuf_add_field("dragblj", "physpkg", dtype_r8, (/pcols,pver/), dragblj_idx) + call pbuf_add_field("taubljx", "physpkg", dtype_r8, (/pcols/), taubljx_idx) + call pbuf_add_field("taubljy", "physpkg", dtype_r8, (/pcols/), taubljy_idx) + +end subroutine beljaars_drag_register + +subroutine beljaars_drag_init() + + use cam_history, only: addfld, add_default, horiz_only + use error_messages, only: handle_errmsg + use phys_control, only: phys_getopts + use physconst, only: karman, gravit, rair + use physics_buffer, only: pbuf_get_index + use beljaars_drag, only: init_blj + + logical :: history_amwg + + character(len=128) :: errstring + + if (.not. do_beljaars) return + + call phys_getopts(history_amwg_out=history_amwg) + + call init_blj( r8, gravit, rair, errstring ) + call handle_errmsg(errstring, subname="init_blj") + + call addfld('DRAGBLJ', (/ 'lev' /) , 'A', '1/s', 'Drag profile from Beljaars SGO ') + call addfld('TAUBLJX', horiz_only, 'A', 'N/m2', 'Zonal integrated drag from Beljaars SGO') + call addfld('TAUBLJY', horiz_only, 'A', 'N/m2', 'Meridional integrated drag from Beljaars SGO') + if (history_amwg) then + call add_default( 'TAUBLJX ', 1, ' ' ) + call add_default( 'TAUBLJY ', 1, ' ' ) + end if + + if (masterproc) then + write(iulog,*)'Using Beljaars SGO drag module' + end if + + sgh30_idx = pbuf_get_index("SGH30") + +end subroutine beljaars_drag_init + +subroutine beljaars_drag_tend(state, pbuf, cam_in) + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + use beljaars_drag, only: compute_blj + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + type(cam_in_t), intent(in) :: cam_in + + real(r8), pointer :: sgh30(:) + real(r8), pointer :: dragblj(:,:) + real(r8), pointer :: taubljx(:), taubljy(:) + + call pbuf_get_field(pbuf, dragblj_idx, dragblj) + call pbuf_get_field(pbuf, taubljx_idx, taubljx) + call pbuf_get_field(pbuf, taubljy_idx, taubljy) + + if (.not. do_beljaars) then + dragblj = 0._r8 + taubljx = 0._r8 + taubljy = 0._r8 + return + end if + + call pbuf_get_field(pbuf, sgh30_idx, sgh30) + + call compute_blj( pcols , pver , state%ncol , & + state%u , state%v , state%t , state%pmid , & + state%pdel , state%zm , sgh30 , dragblj , & + taubljx , taubljy , cam_in%landfrac ) + + call outfld("TAUBLJX", taubljx, pcols, state%lchnk) + call outfld("TAUBLJY", taubljy, pcols, state%lchnk) + call outfld("DRAGBLJ", dragblj, pcols, state%lchnk) + +end subroutine beljaars_drag_tend + +end module beljaars_drag_cam diff --git a/src/physics/cam/boundarydata.F90 b/src/physics/cam/boundarydata.F90 new file mode 100644 index 0000000000..59409b9a88 --- /dev/null +++ b/src/physics/cam/boundarydata.F90 @@ -0,0 +1,936 @@ +#define _FILE 'physics/cam1/boundarydata.F90 ' +module boundarydata + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, begchunk, endchunk + use physics_types, only: physics_state + use cam_abortutils, only: endrun +#if ( defined SPMD ) + use mpishorthand, only: mpicom, mpir8, mpiint +#endif + use netcdf + use error_messages, only: handle_ncerr + use cam_logfile, only: iulog + implicit none + private + integer, parameter :: ptrtim=12, ptrlon=1 + + type boundarydata_type + integer :: ncid + integer :: fieldcnt + integer :: nm + integer :: np + integer :: latsiz + integer :: levsiz + integer :: ncolsiz + integer :: timsiz + integer :: vertextrap + logical :: iszonal, isncol + integer :: ndims + integer :: thistimedim + integer :: psid + integer :: map(4) + integer :: dimids(4) + integer, pointer :: dataid(:) => null() + integer, pointer :: columnmap(:) => null() + integer, pointer :: start(:,:) => null() + integer, pointer :: count(:,:) => null() + real(r8), pointer :: lat(:) => null() + real(r8), pointer :: zi(:) => null() + real(r8), pointer :: pin(:) => null() + real(r8), pointer :: cdates(:) => null() + real(r8), pointer :: fields(:,:,:,:,:) => null() + real(r8), pointer :: datainst(:,:,:,:) => null() + real(r8), pointer :: hybi(:) => null() + real(r8), pointer :: ps(:,:,:) => null() + end type boundarydata_type + + public boundarydata_init + public boundarydata_update + public boundarydata_vert_interp + public boundarydata_type + +contains + subroutine boundarydata_init(bndyfilename,phys_state,fieldnames,fieldcnt,bndydata,vertextrap) + implicit none + character(len=*),intent(in) :: bndyfilename + type(physics_state), intent(in):: phys_state(begchunk:endchunk) + integer,intent(in) :: fieldcnt + character(len=*), intent(in) :: fieldnames(fieldcnt) + type(boundarydata_type),intent(out) :: bndydata + integer,intent(in), optional :: vertextrap ! if 0 set values outside output grid to 0 + ! if 1 set to boundary value + ! if 2 set to cyclic boundaries + ! if 3 leave on input data grid and extrapolate later + real(r8), pointer :: datain(:,:,:,:,:) + integer :: lchnk + + bndydata%fieldcnt=fieldcnt + if(present(vertextrap)) then + bndydata%vertextrap=vertextrap + else + bndydata%vertextrap=0 + end if + nullify(bndydata%fields) + + call boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydata,datain) + + if(bndydata%iszonal) then + call boundarydata_interpolate(phys_state,datain,bndydata) + + allocate(bndydata%datainst(size(bndydata%fields,1),size(bndydata%fields,2), & + begchunk:endchunk,bndydata%fieldcnt)) + + deallocate(datain) + end if + end subroutine boundarydata_init + + subroutine boundarydata_update(phys_state, bndydata, update_out) + use interpolate_data,only : get_timeinterp_factors + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(boundarydata_type), intent(inout) :: bndydata + logical, intent(out), optional :: update_out + real(r8) :: cdate + integer :: nm, np, lchnk, j, k, fld, cols, cole, ncol, ndims + real(r8) :: fact1, fact2 + real(r8), allocatable :: datain(:,:,:,:,:) + logical :: update + integer :: latspan + integer :: kmax + integer :: count(4), start(4), ierr + + + call get_data_bounding_date_indices(bndydata%cdates,bndydata%nm,bndydata%np,cdate,update) + if(present(update_out)) update_out=update + nm= bndydata%nm + np= bndydata%np + + call get_timeinterp_factors(.true., np, bndydata%cdates(nm), bndydata%cdates(np), & + cdate, fact1, fact2, _FILE) + + if(size(bndydata%fields,5).eq.2) then + nm=1 + np=2 + if(update) then ! we need to read in the next month and interpolate + if(bndydata%isncol) then + bndydata%fields(:,:,:,:,nm)=bndydata%fields(:,:,:,:,np) + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + cols=1 + cole=cols+bndydata%count(cols,lchnk)-1 + do while(cole<=ncol) + + if(bndydata%levsiz==1) then + ndims=2 + start=(/bndydata%start(cols,lchnk),bndydata%np,-1,-1/) + count=(/bndydata%count(cols,lchnk),1,-1,-1/) + else + ndims=3 + start=(/bndydata%start(cols,lchnk),bndydata%levsiz,bndydata%np,-1/) + count=(/bndydata%count(cols,lchnk),1,1,-1/) + end if + do fld=1,bndydata%fieldcnt + call handle_ncerr( nf90_get_var(bndydata%ncid, bndydata%dataid(fld) , & + bndydata%fields(cols:cole,:,lchnk,fld,np), & + start(1:ndims), count(1:ndims)),& + _FILE,__LINE__) + + end do + if(cols==ncol) exit + cols=cols+bndydata%count(cols,lchnk) + cole=cols+bndydata%count(cols,lchnk)-1 + end do + end do + + else + allocate(datain(ptrlon,bndydata%levsiz,bndydata%latsiz,1,bndydata%fieldcnt)) + if(masterproc) then + count(1)=ptrlon + count(2)=bndydata%levsiz + count(3)=bndydata%latsiz + count(4)=1 + start(1)=1 + start(2)=1 + start(3)=1 + start(4)=bndydata%np + write(iulog,*) 'boundarydata reading data for month: ',bndydata%np + do fld=1,bndydata%fieldcnt + call handle_ncerr( nf90_get_var(bndydata%ncid, bndydata%dataid(fld), & + datain(:,:,:,:,fld), start, count),_FILE,__LINE__) + end do + end if +#ifdef SPMD + call mpibcast (datain, bndydata%levsiz*bndydata%latsiz*1*bndydata%fieldcnt, mpir8, 0, mpicom, ierr) +#endif + bndydata%fields(:,:,:,:,nm) = bndydata%fields(:,:,:,:,np) + call boundarydata_interpolate(phys_state,datain,bndydata) + deallocate(datain) + end if + end if + end if + kmax = size(bndydata%fields,2) + + do fld=1,bndydata%fieldcnt + do lchnk=begchunk,endchunk + if(bndydata%isncol) then + latspan = phys_state(lchnk)%ncol + else + latspan=phys_state(lchnk)%ulatcnt + end if + do k=1,kmax + do j=1,latspan + bndydata%datainst(j,k,lchnk,fld)=bndydata%fields(j,k,lchnk,fld,nm)*fact1 + & + bndydata%fields(j,k,lchnk,fld,np)*fact2 + end do + end do + end do + end do + end subroutine boundarydata_update + + + subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydata,datain) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Do initial read of time-variant boundary dataset, containing + ! 12 monthly fields as a function of latitude and pressure. Determine the two + ! consecutive months between which the current date lies. + ! + ! Method: + ! + ! Author: NCAR CMS + !----------------------------------------------------------------------- + use ioFileMod, only : getfil + use bnddyi_mod, only: bnddyi + + implicit none + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + character(len=*),intent(in) :: bndyfilename + integer,intent(in) :: fieldcnt + character(len=*), intent(in) :: fieldnames(fieldcnt) + type(boundarydata_type), intent(inout) :: bndydata + real(r8), pointer :: datain(:,:,:,:,:) ! + ! + ! Local variables + ! + integer :: londimid + integer :: latdimid + integer :: ncoldimid + integer :: levdimid + integer :: ilevdimid + integer :: timdimid + integer :: ndims + integer :: dimlen + integer :: ilevsiz + integer :: ncolsiz + character(len=nf90_max_name) :: dimname + + +! integer :: ncid ! netcdf id for file + integer :: dateid ! netcdf id for date variable + integer :: secid ! netcdf id for seconds variable + integer :: lonid ! netcdf id for longitude variable + integer :: ncolid ! netcdf id for longitude variable + integer :: latid ! netcdf id for latitude variable + integer :: levid ! netcdf id for level variable + integer :: timid ! netcdf id for time variable + integer :: hybid + + integer :: dataid ! netcdf id for data fields + + integer :: lonsiz ! size of longitude dimension on tracer dataset + integer :: levsiz ! size of level dimension on tracer dataset + integer :: latsiz ! size of latitude dimension on tracer dataset + + integer :: j,n,k,nt,id ! indices + integer :: ki,ko,ji,jo ! indices + integer :: date_tr(ptrtim), sec_tr(ptrtim) + + integer :: dimids(4), start(4), count(4) + integer, pointer :: columnmap(:) + real(r8) :: calday ! current calendar day + real(r8), pointer :: pin(:) + real(r8), allocatable :: tmp_ps(:,:), tmp_fld(:,:,:) + integer :: mincid,maxcid + real(r8), allocatable, target:: lati(:) + integer :: cols, cole + integer :: ierr, dimcnt + integer :: i, ncol, lchnk + character(len=256) :: locfn ! netcdf local filename to open + + ! + !----------------------------------------------------------------------- + ! + ! SPMD: Master reads dataset and does broadcast. All subsequent interpolation is + ! done in every process. This is not required, one could remove this conditional + ! and read the dataset independently on each task. + ! + if(masterproc) then + write(iulog,*)'boundarydata_read: Reading from: ', trim(bndyfilename) +#ifndef USE_MASTERPROC + end if +#endif + call getfil(bndyfilename, locfn) + call handle_ncerr( nf90_open(locfn, 0, bndydata%ncid),& + _FILE,__LINE__) + + ! write(iulog,*)'boundarydata_read: NCOPN returns id ',bndydata%ncid,' for file ',trim(locfn) + ! + !------------------------------------------------------------------------ + ! Read tracer data + !------------------------------------------------------------------------ + ! + ! Get dimension info + ! + nullify(columnmap) + nullify(pin) + call handle_ncerr( nf90_inquire(bndydata%ncid, bndydata%ndims, unlimiteddimid=timdimid), & + _FILE,__LINE__) + ncolsiz=-1 + levsiz=-1 + lonsiz=-1 + latsiz=-1 + bndydata%isncol = .false. + do i=1,bndydata%ndims + call handle_ncerr( nf90_inquire_dimension(bndydata%ncid, i, dimname, dimlen),& + _FILE,__LINE__) + if (dimname(1:3).eq.'lat') then + latdimid=i + latsiz=dimlen + else if (dimname(1:3) .eq.'lon') then + londimid=i + lonsiz=dimlen + else if (dimname(1:4) .eq. 'ncol') then + ncoldimid=i + ncolsiz=dimlen + bndydata%isncol=.true. + else if (dimname(1:3) .eq. 'lev') then + levdimid=i + levsiz=dimlen + else if (dimname(1:4) .eq. 'ilev') then + ilevdimid=i + ilevsiz=dimlen + else if (dimname(1:4) .eq. 'time') then + if(timdimid/=i) then + timdimid=i + end if + bndydata%timsiz=dimlen + else + write(iulog,*) 'Warning: do not know how to handle dimension ',& + trim(dimname), ' in boundarydata.F90:313' + end if + end do + + bndydata%iszonal = (latsiz>0 .and. lonsiz<=1) + if (bndydata%iszonal) then + allocate(bndydata%lat(latsiz)) + end if + if(bndydata%isncol) then +! allocate (columnmap(ncolsiz)) +! call handle_ncerr( nf90_inq_varid(bndydata%ncid, 'ncol' , ncolid),& +! _FILE,__LINE__) +! call handle_ncerr( nf90_get_var(bndydata%ncid,ncolid,columnmap), & +! _FILE,__LINE__) + if(levsiz>0) then + allocate(bndydata%fields(pcols,levsiz,begchunk:endchunk,fieldcnt,2)) + + ierr = nf90_inq_varid(bndydata%ncid, 'PS', bndydata%psid) + if(ierr.eq.NF90_NOERR) then + allocate(bndydata%ps(pcols,begchunk:endchunk,2)) + allocate(bndydata%hybi(levsiz+1)) + call handle_ncerr(nf90_inq_varid(bndydata%ncid,'hybi',hybid),& + _FILE,__LINE__) + call handle_ncerr( nf90_get_var(bndydata%ncid, hybid, bndydata%hybi ),& + _FILE,__LINE__) + else + call endrun('Did not recognize a vertical coordinate variable') + end if + else + levsiz=1 + allocate(bndydata%fields(pcols,1,begchunk:endchunk,fieldcnt,2)) + end if + else + allocate(datain(lonsiz,levsiz,latsiz,2,fieldcnt)) + ! + ! Check dimension info + ! + if (lonsiz/=ptrlon) then + call endrun ('BOUNDARYDATA_READ: longitude dependence not implemented') + endif + + if (bndydata%timsiz /= ptrtim) then + write(iulog,*)'BOUNDARYDATA_READ: timsiz=',bndydata%timsiz,' must = ptrtim=',ptrtim + call endrun + end if + if( bndydata%vertextrap.lt.3) then + allocate(pin(levsiz)) + else + allocate(bndydata%pin(levsiz)) + pin => bndydata%pin + end if + allocate(bndydata%lat(latsiz)) + + + allocate(datain(ptrlon,levsiz,latsiz,2,fieldcnt)) + + call handle_ncerr( nf90_inq_varid(bndydata%ncid, 'lat' , latid),& + _FILE,__LINE__) + end if + ! + ! Determine necessary dimension and variable id's + ! + allocate(bndydata%cdates(bndydata%timsiz)) + + call handle_ncerr(nf90_inq_varid(bndydata%ncid, 'date' , dateid), & + _FILE,__LINE__) + call handle_ncerr( nf90_get_var(bndydata%ncid, dateid, date_tr),& + _FILE,__LINE__) + ierr = nf90_inq_varid(bndydata%ncid, 'datesec', secid) + if(ierr==NF90_NOERR) then + call handle_ncerr( nf90_get_var(bndydata%ncid, secid , sec_tr),& + _FILE,__LINE__) + else + sec_tr=0 + end if + + if (mod(date_tr(1),10000)/100 /= 1) then + call endrun ('(boundarydata_read): error when cycling data: 1st month must be 1') + end if + if (mod(date_tr(ptrtim),10000)/100 /= 12) then + call endrun ('(boundarydata_read): error when cycling data: last month must be 12') + end if + ! + ! return the calander dates of the file data + ! + do n=1,ptrtim + call bnddyi(date_tr(n), sec_tr(n), bndydata%cdates(n)) + end do +! else +! call handle_ncerr( nf90_inq_varid(bndydata%ncid, 'time', dateid),& +! _FILE,__LINE__) +! +! call handle_ncerr( nf90_get_var(bndydata%ncid, dateid, bndydata%cdates),& +! _FILE,__LINE__) +! +! end if +#ifdef USE_MASTERPROC + else + allocate(bndydata%cdates(ptrtim)) + end if +#ifdef SPMD + call mpibcast (bndydata%cdates, ptrtim, mpir8, 0, mpicom, ierr) +#endif +#endif + bndydata%nm=12 + bndydata%np=1 + call get_data_bounding_date_indices(bndydata%cdates,bndydata%nm,bndydata%np) +#ifdef USE_MASTERPROC + if(masterproc) then +#endif + ! + ! Obtain entire date and sec variables. Assume that will always + ! cycle over 12 month data. + ! + ! + ! Obtain input data latitude and level arrays. + ! + if(bndydata%iszonal) then + call handle_ncerr( nf90_get_var(bndydata%ncid, latid, bndydata%lat),& + _FILE,__LINE__) + ierr = nf90_inq_varid(bndydata%ncid, 'lev' , levid) + call handle_ncerr( nf90_get_var(bndydata%ncid, levid, pin ),& + _FILE,__LINE__) + end if + + allocate(bndydata%dataid(fieldcnt)) + if(masterproc) then + write(iulog,*) 'boundarydata reading data for months: ',bndydata%nm,bndydata%np + end if + do i=1,fieldcnt + call handle_ncerr( nf90_inq_varid(bndydata%ncid, fieldnames(i) , bndydata%dataid(i)),& + _FILE,__LINE__) + end do + if(bndydata%isncol) then + allocate(bndydata%start(pcols,begchunk:endchunk), & + bndydata%count(pcols,begchunk:endchunk)) + +! +! For i/o efficiency we read in a block of data which includes the data needed on this +! processor but which may in fact include data not needed here. physics cids are just the +! offset into the file. +! + + bndydata%start=-1 + bndydata%count=1 + mincid=2147483647 + maxcid=-1 + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + i=minval(phys_state(lchnk)%cid(1:ncol)) + if(i < mincid) mincid = i + i=maxval(phys_state(lchnk)%cid(1:ncol)) + if(i > maxcid) maxcid = i + end do + + allocate(tmp_ps(mincid:maxcid,2)) + start=(/mincid,bndydata%nm,1,-1/) + if(bndydata%np>bndydata%nm) then + count=(/maxcid-mincid+1,2,-1,-1/) + else + count=(/maxcid-mincid+1,1,-1,-1/) + end if + if(associated(bndydata%ps) ) then + call handle_ncerr( nf90_get_var(bndydata%ncid, bndydata%psid , & + tmp_ps(:,1:count(2)), start(1:2), & + count(1:2)),& + _FILE,__LINE__) + if(bndydata%np1) then + dimcnt=3 + else + dimcnt=2 + end if + start(2)=1 + count(2)=levsiz + + if(bndydata%np>bndydata%nm) then + count(dimcnt)=2 + else + count(dimcnt)=1 + end if + start(dimcnt)=bndydata%nm + + allocate(tmp_fld(mincid:maxcid,count(2),2)) + + do i=1,fieldcnt + call handle_ncerr( nf90_get_var(bndydata%ncid, bndydata%dataid(i) , & + tmp_fld(:,:,1:count(dimcnt)), & + start(1:dimcnt), count(1:dimcnt)),& + _FILE,__LINE__) + + do lchnk=begchunk,endchunk + do n=1,phys_state(lchnk)%ncol + bndydata%fields(n,:,lchnk,i,1:count(dimcnt)) = tmp_fld(phys_state(lchnk)%cid(n),:,:) + end do + end do + end do + if(bndydata%np bndydata%pin + end if + allocate(bndydata%lat(latsiz)) + allocate(datain(ptrlon,levsiz,latsiz,2,fieldcnt)) + endif +#ifdef SPMD + call mpibcast (bndydata%lat, latsiz, mpir8, 0, mpicom, ierr) + call mpibcast (pin, levsiz, mpir8, 0, mpicom, ierr) + call mpibcast (datain, levsiz*latsiz*2*fieldcnt, mpir8, 0, mpicom, ierr) + +#endif +#endif + ! Convert input pressure from millibars to pascals. + if(associated(pin)) then + pin=pin*100._r8 + if(bndydata%vertextrap.lt.3) then + allocate(bndydata%zi(levsiz)) + ! + ! + ! Convert input pressure levels to height (m). + ! + do k=1,levsiz + bndydata%zi(k) = 7.0e3_r8 * log (1.0e5_r8 / pin(k)) + end do + deallocate(pin) + end if + end if +end subroutine boundarydata_read + + subroutine boundarydata_interpolate(phys_state, datain, bndydata) + use ref_pres, only : pref_mid + use interpolate_data,only : interp_type, lininterp_init, & + lininterp_finish, lininterp + use physconst, only: pi + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + real(r8),intent(in) :: datain(:,:,:,:,:) + type(boundarydata_type), intent(inout) :: bndydata + type(interp_type) :: interp_wgts, lev_wgts + + integer :: k, lchnk, nt, j, fcnt + real(r8) :: zo(pver) + real(r8) :: lato(pcols) + integer :: ulatcnt + integer :: maxlatcnt + integer :: timesize, tvalout + + !------------------------------------------------------------------------ + ! Interpolate tracer data to model grid + !------------------------------------------------------------------------ + ! + ! Loop over all input times. + ! + + timesize=2 + + maxlatcnt=1 + do lchnk=begchunk,endchunk + maxlatcnt=max(maxlatcnt,phys_state(lchnk)%ulatcnt) + end do + if(bndydata%vertextrap.lt.3) then + ! + ! Convert approximate cam pressure levels to height (m). + ! + do k=1,pver + zo (k) = 7.0e3_r8 * log (1.0e5_r8 / pref_mid(k)) + end do + + call lininterp_init(bndydata%zi,size(bndydata%zi),zo,pver,bndydata%vertextrap,lev_wgts) + if(.not. associated(bndydata%fields)) then + allocate(bndydata%fields(maxlatcnt,pver,begchunk:endchunk,bndydata%fieldcnt,timesize)) + bndydata%fields=0_r8 + end if + else + if(.not. associated(bndydata%fields)) then + allocate(bndydata%fields(maxlatcnt,bndydata%levsiz,begchunk:endchunk,bndydata%fieldcnt,timesize)) + bndydata%fields=0_r8 + end if + endif + do lchnk=begchunk,endchunk + ulatcnt=phys_state(lchnk)%ulatcnt + + ! + ! Convert cam model latitudes to degrees. + ! Input model latitudes already in degrees. + ! + do j=1,ulatcnt + lato(j) = phys_state(lchnk)%ulat(j)*180._r8/pi + end do + + call lininterp_init(bndydata%lat,size(bndydata%lat),lato(1:ulatcnt),ulatcnt,1,interp_wgts) + timesize = size(datain,4) + do fcnt=1,bndydata%fieldcnt + do nt = 1,timesize + if(timesize.gt.1) then + tvalout=nt + else + tvalout=2 + end if + if(bndydata%vertextrap.lt.3) then + call lininterp(transpose(datain(1,:,:,nt,fcnt)),bndydata%latsiz,bndydata%levsiz, & + bndydata%fields(1:ulatcnt,:,lchnk,fcnt,tvalout), ulatcnt, pver, interp_wgts, lev_wgts) + else + do k=1,bndydata%levsiz + call lininterp(datain(1,k,:,nt,fcnt),bndydata%latsiz, & + bndydata%fields(1:ulatcnt,k,lchnk,fcnt,tvalout), ulatcnt, interp_wgts) + end do + end if + end do + end do ! end loop over time samples + call lininterp_finish(interp_wgts) + end do + if(bndydata%vertextrap.lt.3) & + call lininterp_finish(lev_wgts) + + return + end subroutine boundarydata_interpolate + + subroutine get_data_bounding_date_indices(cdates,nm,np, cdayout, update) + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + real(r8), intent(in) :: cdates(ptrtim) + real(r8), intent(out),optional :: cdayout + logical, intent(out) ,optional :: update + integer, intent(inout) :: nm, np + integer :: n, np1 + real(r8) :: calday + integer :: yr, mon, day ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + + calday = get_curr_calday() + if(present(cdayout)) cdayout=calday + if(present(update)) update=.false. ! initialize output variable + + if(min(nm,np) .ge. 1 .and. max(nm,np) .le. 12 .and. & + calday>cdates(nm) .and. calday<=cdates(np)) return + if((nm==12 .and. np==1) .and. (calday <= cdates(np) .or. & + calday > cdates(nm))) return + + if(present(update)) update=.true. + + if(calday <= cdates(1) .or. calday > cdates(12)) then + nm=12 + np=1 + else + nm=0 + do n=1,ptrtim-1 + if(calday>cdates(n) .and. calday<=cdates(n+1)) then + nm=n + np=n+1 + end if + end do + if(nm .eq. 0) then + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + ncdate = yr*10000 + mon*100 + day + + write(iulog,*)'model date:', ncdate, ncsec,'boundary data dates:', cdates + call endrun('BOUNDARYDATA_READ: Failed to find dates bracketing dates') + end if + end if + + end subroutine get_data_bounding_date_indices + + + !================================================================================================ + subroutine boundarydata_vert_interp(lchnk, ncol, levsiz, fldcnt, pin, pmid, datain, dataout) + !----------------------------------------------------------------------- + ! + ! Purpose: Interpolate ozone from current time-interpolated values to model levels + ! + ! Method: Use pressure values to determine interpolation levels + ! + ! Author: Bruce Briegleb + ! + !-------------------------------------------------------------------------- + implicit none + ! Arguments + ! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: levsiz + integer, intent(in) :: fldcnt + real(r8), intent(in) :: pin(levsiz) + real(r8), intent(in) :: pmid(pcols,pver) ! level pressures (mks) + real(r8), intent(in) :: datain(pcols,levsiz,fldcnt) + real(r8), intent(out) :: dataout(pcols,pver,fldcnt) ! ozone mass mixing ratio + ! + ! local storage + ! + + integer :: i ! longitude index + integer :: k, kk, kkstart ! level indices + integer :: kupper(pcols) ! Level indices for interpolation + integer :: kount ! Counter + integer :: fld + real(r8) dpu ! upper level pressure difference + real(r8) dpl ! lower level pressure difference + !-------------------------------------------------------------------------- + ! + ! Initialize index array + ! + do i=1,ncol + kupper(i) = 1 + end do + + do k=1,pver + ! + ! Top level we need to start looking is the top level for the previous k + ! for all longitude points + ! + kkstart = levsiz + do i=1,ncol + kkstart = min0(kkstart,kupper(i)) + end do + kount = 0 + ! + ! Store level indices for interpolation + ! + do kk=kkstart,levsiz-1 + do i=1,ncol + if (pin(kk).lt.pmid(i,k) .and. pmid(i,k).le.pin(kk+1)) then + kupper(i) = kk + kount = kount + 1 + end if + end do + ! + ! If all indices for this level have been found, do the interpolation and + ! go to the next level + ! + if (kount.eq.ncol) then + do fld=1,fldcnt + do i=1,ncol + dpu = pmid(i,k) - pin(kupper(i)) + dpl = pin(kupper(i)+1) - pmid(i,k) + dataout(i,k,fld) = (datain(i,kupper(i),fld )*dpl + & + datain(i,kupper(i)+1,fld)*dpu)/(dpl + dpu) + + end do + end do + goto 35 + end if + end do + ! + ! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and + ! must extrapolate from the bottom or top data level for at least some + ! of the longitude points. + ! + do fld=1,fldcnt + do i=1,ncol + if (pmid(i,k) .lt. pin(1)) then + dataout(i,k,fld) = datain(i,1,fld)*pmid(i,k)/pin(1) + else if (pmid(i,k) .gt. pin(levsiz)) then + dataout(i,k,fld) = datain(i,levsiz,fld) + else + dpu = pmid(i,k) - pin(kupper(i)) + dpl = pin(kupper(i)+1) - pmid(i,k) + dataout(i,k,fld) = (datain(i,kupper(i),fld )*dpl + & + datain(i,kupper(i)+1,fld)*dpu)/(dpl + dpu) + end if + end do + end do + if (kount.gt.ncol) then + call endrun ('ozone_data_vert_interp: Bad ozone data: non-monotonicity suspected') + end if +35 continue + end do + end subroutine boundarydata_vert_interp +#if 0 + subroutine ncol_read_bracket(cid,columnmap,start,count,ncol) + integer, intent(in) :: cid(:), columnmap(:), ncol + integer, intent(out) :: start(:), count(:) + + integer :: i, j, tcol + + tcol = size(columnmap) + count=1 + do i=1,ncol +#if 1 + start(i)=cid(i) + count(i)=1 +#else + do j=1,tcol + if(columnmap(j).eq.cid(i)) then + start(i)=j + count(i)=1 + exit + end if + end do +#endif + end do + do i=1,ncol-1 + do j=1,ncol-i + if(columnmap(start(i+j)).eq.columnmap(start(i)+j)) then + count(i)=count(i)+1 + else + exit + end if + end do + end do + write(iulog,*) __LINE__,cid(1),cid(ncol),minval(cid(1:ncol)),maxval(cid(1:ncol)) + + end subroutine ncol_read_bracket +#endif +end module boundarydata diff --git a/src/physics/cam/cam3_aero_data.F90 b/src/physics/cam/cam3_aero_data.F90 new file mode 100644 index 0000000000..bb32e36b8a --- /dev/null +++ b/src/physics/cam/cam3_aero_data.F90 @@ -0,0 +1,1021 @@ +module cam3_aero_data +!----------------------------------------------------------------------- +! +! Purposes: +! read, store, interpolate, and return fields +! of aerosols to CAM. The initialization +! file (mass.nc) is assumed to be a monthly climatology +! of aerosols from MATCH (on a sigma pressure +! coordinate system). +! also provide a "background" aerosol field to correct +! for any deficiencies in the physical parameterizations +! This fields is a "tuning" parameter. +! Public methods: +! (1) - initialization +! read aerosol masses from external file +! also pressure coordinates +! convert from monthly average values to mid-month values +! (2) - interpolation (time and vertical) +! interpolate onto pressure levels of CAM +! interpolate to time step of CAM +! return mass of aerosols +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use phys_grid, only: get_ncols_p, scatter_field_to_chunk + use time_manager, only: get_curr_calday + use infnan, only: nan, assignment(=) + use cam_abortutils, only: endrun + use scamMod, only: scmlon,scmlat,single_column + use error_messages, only: handle_ncerr + use physics_types, only: physics_state + use boundarydata, only: boundarydata_init, boundarydata_type + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + use netcdf + + implicit none + private + save + + public :: & + cam3_aero_data_readnl, & ! read namelist + cam3_aero_data_register, & ! register these aerosols with pbuf2d + cam3_aero_data_init, & ! read from file, interpolate onto horiz grid + cam3_aero_data_timestep_init ! update data-aerosols to this timestep + + ! namelist variables + logical, public :: cam3_aero_data_on = .false. + character(len=256) :: bndtvaer = 'bndtvaer' ! full pathname for time-variant aerosol mass climatology dataset + + ! naer is number of species in climatology + integer, parameter :: naer = 11 + + real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode + + ! indices to aerosol array (species portion) + integer, parameter :: & + idxSUL = 1, & + idxSSLTA = 2, & ! accumulation mode + idxSSLTC = 3, & ! coarse mode + idxOCPHO = 8, & + idxBCPHO = 9, & + idxOCPHI = 10, & + idxBCPHI = 11 + + ! indices to sections of array that represent + ! groups of aerosols + integer, parameter :: & + idxSSLTfirst = 2, numSSLT = 2, & + idxDUSTfirst = 4, & + numDUST = 4, & + idxCARBONfirst = 8, & + numCARBON = 4 + + ! names of aerosols are they are represented in + ! the climatology file. + ! Appended '_V' indicates field has been vertically summed. + character(len=8), parameter :: aerosol_name(naer) = & + (/"MSUL_V "& + ,"MSSLTA_V"& + ,"MSSLTC_V"& + ,"MDUST1_V"& + ,"MDUST2_V"& + ,"MDUST3_V"& + ,"MDUST4_V"& + ,"MOCPHO_V"& + ,"MBCPHO_V"& + ,"MOCPHI_V"& + ,"MBCPHI_V"/) + + ! number of different "groups" of aerosols + integer, parameter :: num_aer_groups=4 + + ! which group does each bin belong to? + integer, dimension(naer), parameter :: & + group =(/1,2,2,3,3,3,3,4,4,4,4/) + + ! name of each group + character(len=10), dimension(num_aer_groups), parameter :: & + aerosol_names = (/'sul ','sslt ','dust ','car '/) + + ! this boundarydata_type is used for datasets in the ncols format only. + type(boundarydata_type) :: aerosol_datan + + integer :: aernid = -1 ! netcdf id for aerosol file (init to invalid) + integer :: species_id(naer) = -1 ! netcdf_id of each aerosol species (init to invalid) + integer :: Mpsid ! netcdf id for MATCH PS + integer :: nm = 1 ! index to prv month in array. init to 1 and toggle between 1 and 2 + integer :: np = 2 ! index to nxt month in array. init to 2 and toggle between 1 and 2 + integer :: mo_nxt = huge(1) ! index to nxt month in file + + real(r8) :: cdaym ! calendar day of prv month + real(r8) :: cdayp ! calendar day of next month + + ! aerosol mass + real(r8), allocatable :: aer_mass(:, :, :, :) + + ! Days into year for mid month date + ! This variable is dumb, the dates are in the dataset to be read in but they are + ! slightly different than this so getting rid of it causes a change which + ! exceeds roundoff. + real(r8) :: Mid(12) = (/16.5_r8, 46.0_r8, 75.5_r8, 106.0_r8, 136.5_r8, 167.0_r8, & + 197.5_r8, 228.5_r8, 259.0_r8, 289.5_r8, 320.0_r8, 350.5_r8 /) + + ! values read from file and temporary values used for interpolation + ! + ! aerosolc is: + ! Cumulative Mass at midpoint of each month + ! on CAM's horizontal grid (col) + ! on MATCH's levels (lev) + ! aerosolc + integer, parameter :: paerlev = 28 ! number of levels for aerosol fields (MUST = naerlev) + integer :: naerlev ! size of level dimension in MATCH data + integer :: naerlon + integer :: naerlat + real(r8), pointer :: M_hybi(:) ! MATCH hybi + real(r8), pointer :: M_ps(:,:) ! surface pressure from MATCH file + real(r8), pointer :: aerosolc(:,:,:,:,:) ! Aerosol cumulative mass from MATCH + real(r8), pointer :: M_ps_cam_col(:,:,:) ! PS from MATCH on Cam Columns + + ! indices for fields in the physics buffer + integer :: cam3_sul_idx, cam3_ssam_idx, cam3_sscm_idx, & + cam3_dust1_idx, cam3_dust2_idx, cam3_dust3_idx, cam3_dust4_idx,& + cam3_ocpho_idx, cam3_bcpho_idx, cam3_ocphi_idx, cam3_bcphi_idx + +!================================================================================================ +contains +!================================================================================================ + +subroutine cam3_aero_data_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cam3_aero_data_readnl' + + namelist /cam3_aero_data_nl/ cam3_aero_data_on, bndtvaer + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cam3_aero_data_nl', status=ierr) + if (ierr == 0) then + read(unitn, cam3_aero_data_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(cam3_aero_data_on, 1, mpilog, 0, mpicom) + call mpibcast(bndtvaer, len(bndtvaer), mpichar, 0, mpicom) +#endif + + ! Prevent using these before they are set. + cdaym = nan + cdayp = nan + +end subroutine cam3_aero_data_readnl + +!================================================================================================ + +subroutine cam3_aero_data_register + + ! register old prescribed aerosols with physics buffer + + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call pbuf_add_field('cam3_sul', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sul_idx) + call pbuf_add_field('cam3_ssam', 'physpkg',dtype_r8,(/pcols,pver/),cam3_ssam_idx) + call pbuf_add_field('cam3_sscm', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sscm_idx) + call pbuf_add_field('cam3_dust1','physpkg',dtype_r8,(/pcols,pver/),cam3_dust1_idx) + call pbuf_add_field('cam3_dust2','physpkg',dtype_r8,(/pcols,pver/),cam3_dust2_idx) + call pbuf_add_field('cam3_dust3','physpkg',dtype_r8,(/pcols,pver/),cam3_dust3_idx) + call pbuf_add_field('cam3_dust4','physpkg',dtype_r8,(/pcols,pver/),cam3_dust4_idx) + call pbuf_add_field('cam3_ocpho','physpkg',dtype_r8,(/pcols,pver/),cam3_ocpho_idx) + call pbuf_add_field('cam3_bcpho','physpkg',dtype_r8,(/pcols,pver/),cam3_bcpho_idx) + call pbuf_add_field('cam3_ocphi','physpkg',dtype_r8,(/pcols,pver/),cam3_ocphi_idx) + call pbuf_add_field('cam3_bcphi','physpkg',dtype_r8,(/pcols,pver/),cam3_bcphi_idx) + +end subroutine cam3_aero_data_register + +!================================================================================================ + +subroutine cam3_aero_data_init(phys_state) +!------------------------------------------------------------------ +! Reads in: +! file from which to read aerosol Masses on CAM grid. Currently +! assumed to be MATCH ncep runs, averaged by month. +! NOTE (Data have been externally interpolated onto CAM grid +! and backsolved to provide Mid-month values) +! +! Populates: +! module variables: +! aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) +! aerosolc( column_index +! , level_index (match levels) +! , chunk_index +! , species_index +! , month = 1:2 ) +! M_hybi(level_index = Lev_MATCH) = pressure at mid-level. +! M_ps_cam_col(column,chunk,month) ! PS from MATCH on Cam Columns +! +! Method: +! read data from file +! allocate memory for storage of aerosol data on CAM horizontal grid +! distribute data to remote nodes +! populates the module variables +! +!------------------------------------------------------------------ + use ioFileMod, only: getfil + +#if ( defined SPMD ) + use mpishorthand +#endif + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + +! local variables + + integer :: naerlev + + integer dateid ! netcdf id for date variable + integer secid ! netcdf id for seconds variable + integer londimid ! netcdf id for longitude dimension + integer latdimid ! netcdf id for latitude dimension + integer levdimid ! netcdf id for level dimension + + integer timesiz ! number of time samples (=12) in netcdf file + integer latid ! netcdf id for latitude variable + integer Mhybiid ! netcdf id for MATCH hybi + integer timeid ! netcdf id for time variable + integer dimids(nf90_max_var_dims) ! variable shape + integer :: start(4) ! start vector for netcdf calls + integer :: kount(4) ! count vector for netcdf calls + integer mo ! month index + integer m ! constituent index + integer :: n ! loop index + integer :: i,j,k ! spatial indices + integer :: date_aer(12) ! Date on aerosol dataset (YYYYMMDD) + integer :: attnum ! attribute number + integer :: ierr ! netcdf return code + real(r8) :: coldata(paerlev) ! aerosol field read in from dataset + integer :: ret + integer mo_prv ! index to previous month + integer latidx,lonidx + + character(len=8) :: aname ! temporary aerosol name + character(len=8) :: tmp_aero_name(naer) ! name for input to boundary data + + character(len=256) :: locfn ! netcdf local filename to open +! +! aerosol_data will be read in from the aerosol boundary dataset, then scattered to chunks +! after filling in the bottom level with zeros +! + real(r8), allocatable :: aerosol_data(:,:,:) ! aerosol field read in from dataset + real(r8), allocatable :: aerosol_field(:,:,:) ! (plon,paerlev+1,plat) aerosol field to be scattered + real(r8) :: caldayloc ! calendar day of current timestep + real(r8) :: closelat,closelon + + character(len=*), parameter :: subname = 'cam3_aero_data_init' + !------------------------------------------------------------------ + + call t_startf(subname) + + allocate (aer_mass(pcols, pver, naer, begchunk:endchunk) ) + + ! set new aerosol names because input file has 1 seasalt bin + do m = 1, naer + tmp_aero_name(m)=aerosol_name(m) + if (aerosol_name(m)=='MSSLTA_V') tmp_aero_name(m) = 'MSSLT_V' + if (aerosol_name(m)=='MSSLTC_V') tmp_aero_name(m) = 'MSSLT_V' + end do + + allocate (aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) + aerosolc(:,:,:,:,:) = 0._r8 + + caldayloc = get_curr_calday () + + if (caldayloc < Mid(1)) then + mo_prv = 12 + mo_nxt = 1 + else if (caldayloc >= Mid(12)) then + mo_prv = 12 + mo_nxt = 1 + else + do i = 2 , 12 + if (caldayloc < Mid(i)) then + mo_prv = i-1 + mo_nxt = i + exit + end if + end do + end if + + ! Set initial calendar day values + cdaym = Mid(mo_prv) + cdayp = Mid(mo_nxt) + + if (masterproc) & + write(iulog,*) subname//': CAM3 prescribed aerosol dataset is: ', trim(bndtvaer) + + call getfil (bndtvaer, locfn, 0) + + call handle_ncerr( nf90_open (locfn, 0, aernid),& + subname, __LINE__) + + if (single_column) & + call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + + ! Check to see if this dataset is in ncol format. + aerosol_datan%isncol=.false. + ierr = nf90_inq_dimid( aernid, 'ncol', londimid ) + if ( ierr==NF90_NOERR ) then + + aerosol_datan%isncol=.true. + call handle_ncerr(nf90_close(aernid),subname, __LINE__) + + call boundarydata_init(bndtvaer, phys_state, tmp_aero_name, naer, & + aerosol_datan, 3) + + aerosolc(:,1:paerlev,:,:,:)=aerosol_datan%fields + + M_ps_cam_col=>aerosol_datan%ps + M_hybi=>aerosol_datan%hybi + + else + + ! Allocate memory for dynamic arrays local to this module + allocate (M_ps_cam_col(pcols,begchunk:endchunk,2)) + allocate (M_hybi(paerlev+1)) + ! TBH: HACK to avoid use of uninitialized values when ncols < pcols + M_ps_cam_col(:,:,:) = 0._r8 + + if (masterproc) then + + ! First ensure dataset is CAM-ready + + call handle_ncerr(nf90_inquire_attribute (aernid, nf90_global, 'cam-ready', attnum=attnum),& + subname//': interpaerosols needs to be run to create a cam-ready aerosol dataset') + + ! Get and check dimension info + + call handle_ncerr( nf90_inq_dimid( aernid, 'lon', londimid ),& + subname, __LINE__) + call handle_ncerr( nf90_inq_dimid( aernid, 'lev', levdimid ),& + subname, __LINE__) + call handle_ncerr( nf90_inq_dimid( aernid, 'time', timeid ),& + subname, __LINE__) + call handle_ncerr( nf90_inq_dimid( aernid, 'lat', latdimid ),& + subname, __LINE__) + call handle_ncerr( nf90_inquire_dimension( aernid, londimid, len=naerlon ),& + subname, __LINE__) + call handle_ncerr( nf90_inquire_dimension( aernid, levdimid, len=naerlev ),& + subname, __LINE__) + call handle_ncerr( nf90_inquire_dimension( aernid, latdimid, len=naerlat ),& + subname, __LINE__) + call handle_ncerr( nf90_inquire_dimension( aernid, timeid, len=timesiz ),& + subname, __LINE__) + + call handle_ncerr( nf90_inq_varid( aernid, 'date', dateid ),& + subname, __LINE__) + call handle_ncerr( nf90_inq_varid( aernid, 'datesec', secid ),& + subname, __LINE__) + + do m = 1, naer + aname=aerosol_name(m) + ! rename because file has only one seasalt field + if (aname=='MSSLTA_V') aname = 'MSSLT_V' + if (aname=='MSSLTC_V') aname = 'MSSLT_V' + call handle_ncerr( nf90_inq_varid( aernid, TRIM(aname), species_id(m)), & + subname, __LINE__) + end do + + call handle_ncerr( nf90_inq_varid( aernid, 'lat', latid ),& + subname, __LINE__) + + ! quick sanity check on one field + call handle_ncerr( nf90_inquire_variable (aernid, species_id(1), dimids=dimids),& + subname, __LINE__) + + if ( (dimids(4) /= timeid) .or. & + (dimids(3) /= levdimid) .or. & + (dimids(2) /= latdimid) .or. & + (dimids(1) /= londimid) ) then + write(iulog,*) subname//': Data must be ordered time, lev, lat, lon' + write(iulog,*) 'data are ordered as', dimids(4), dimids(3), dimids(2), dimids(1) + write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid + call endrun () + end if + + ! use hybi,PS from MATCH + call handle_ncerr( nf90_inq_varid( aernid, 'hybi', Mhybiid ),& + subname, __LINE__) + call handle_ncerr( nf90_inq_varid( aernid, 'PS', Mpsid ),& + subname, __LINE__) + + ! check dimension order for MATCH's surface pressure + call handle_ncerr( nf90_inquire_variable (aernid, Mpsid, dimids=dimids),& + subname, __LINE__) + if ( (dimids(3) /= timeid) .or. & + (dimids(2) /= latdimid) .or. & + (dimids(1) /= londimid) ) then + write(iulog,*) subname//': Pressure must be ordered time, lat, lon' + write(iulog,*) 'data are ordered as', dimids(3), dimids(2), dimids(1) + write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid + call endrun () + end if + + ! read in hybi from MATCH + call handle_ncerr( nf90_get_var (aernid, Mhybiid, M_hybi),& + subname, __LINE__) + + ! Retrieve date and sec variables. + call handle_ncerr( nf90_get_var (aernid, dateid, date_aer),& + subname, __LINE__) + if (timesiz < 12) then + write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & + 'months of data starting with Jan' + write(iulog,*) 'Current dataset has only ',timesiz,' months' + call endrun () + end if + do mo = 1,12 + if (mod(date_aer(mo),10000)/100 /= mo) then + write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & + 'months of data starting with Jan' + write(iulog,*)'Month ',mo,' of dataset says date=',date_aer(mo) + call endrun () + end if + end do + if (single_column) then + naerlat=1 + naerlon=1 + endif + kount(:) = (/naerlon,naerlat,paerlev,1/) + end if ! masterproc + + ! broadcast hybi to nodes + +#if ( defined SPMD ) + call mpibcast (M_hybi, paerlev+1, mpir8, 0, mpicom) + call mpibcast (kount, 3, mpiint, 0, mpicom) + naerlon = kount(1) + naerlat = kount(2) +#endif + allocate(aerosol_field(kount(1),kount(3)+1,kount(2))) + allocate(M_ps(kount(1),kount(2))) + if (masterproc) allocate(aerosol_data(kount(1),kount(2),kount(3))) + + ! Retrieve Aerosol Masses (kg/m^2 in each layer), transpose to model order (lon,lev,lat), + ! then scatter to slaves. + if (nm /= 1 .or. np /= 2) call endrun (subname//': bad nm or np value') + do n=nm,np + if (n == 1) then + mo = mo_prv + else + mo = mo_nxt + end if + + do m=1,naer + if (masterproc) then + if (single_column) then + start(:) = (/lonidx,latidx,1,mo/) + else + start(:) = (/1,1,1,mo/) + endif + kount(:) = (/naerlon,naerlat,paerlev,1/) + + call handle_ncerr( nf90_get_var (aernid, species_id(m),aerosol_data, start, kount),& + subname, __LINE__) + do j=1,naerlat + do k=1,paerlev + aerosol_field(:,k,j) = aerosol_data(:,j,k) + end do + aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom + end do + + end if + call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & + aerosolc(:,:,:,m,n)) + end do + + ! Retrieve PS from Match + + if (masterproc) then + if (single_column) then + start(:) = (/lonidx,latidx,mo,-1/) + else + start(:) = (/1,1,mo,-1/) + endif + kount(:) = (/naerlon,naerlat,1,-1/) + call handle_ncerr( nf90_get_var(aernid, Mpsid, M_ps,start,kount),& + subname, __LINE__) + end if + call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,n)) + end do ! n=nm,np (=1,2) + + if(masterproc) deallocate(aerosol_data) + deallocate(aerosol_field) + + end if ! Check to see if this dataset is in ncol format. + + call t_stopf(subname) + +end subroutine cam3_aero_data_init + +!================================================================================================ + +subroutine cam3_aero_data_timestep_init(pbuf2d, phys_state) +!------------------------------------------------------------------ +! +! Input: +! time at which aerosol masses are needed (get_curr_calday()) +! chunk index +! CAM's vertical grid (pint) +! +! Output: +! values for Aerosol Mass at time specified by get_curr_calday +! on vertical grid specified by pint (aer_mass) :: aerosol at time t +! +! Method: +! first determine which indexs of aerosols are the bounding data sets +! interpolate both onto vertical grid aerm(),aerp(). +! from those two, interpolate in time. +! +!------------------------------------------------------------------ + + use interpolate_data, only: get_timeinterp_factors + + use physics_buffer, only: physics_buffer_desc, dtype_r8, pbuf_set_field, pbuf_get_chunk + use cam_logfile, only: iulog + use ppgrid, only: begchunk,endchunk + use physconst, only: gravit + +! +! aerosol fields interpolated to current time step +! on pressure levels of this time step. +! these should be made read-only for other modules +! Is allocation done correctly here? +! + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state + +! +! Local workspace +! + type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) + real(r8) :: pint(pcols,pverp) ! interface pres. + integer :: c ! chunk index + real(r8) caldayloc ! calendar day of current timestep + real(r8) fact1, fact2 ! time interpolation factors + + integer i, k, j ! spatial indices + integer m ! constituent index + integer lats(pcols),lons(pcols) ! latitude and longitudes of column + integer ncol ! number of columns + integer lchnk ! chunk index + + real(r8) speciesmin(naer) ! minimal value for each species +! +! values before current time step "the minus month" +! aerosolm(pcols,pver) is value of preceeding month's aerosol masses +! aerosolp(pcols,pver) is value of next month's aerosol masses +! (think minus and plus or values to left and right of point to be interpolated) +! + real(r8) aerosolm(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at previous (minus) month +! +! values beyond (or at) current time step "the plus month" +! + real(r8) aerosolp(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at next (plus) month + real(r8) :: mass_to_mmr(pcols,pver) + + character(len=*), parameter :: subname = 'cam3_aero_data_timestep_init' + + logical error_found + !------------------------------------------------------------------ + + call aerint(phys_state) + + caldayloc = get_curr_calday () + + ! Determine time interpolation factors. 1st arg says we are cycling 1 year of data + call get_timeinterp_factors (.true., mo_nxt, cdaym, cdayp, caldayloc, & + fact1, fact2, 'GET_AEROSOL:') + + ! interpolate (prv and nxt month) bounding datasets onto cam vertical grid. + ! compute mass mixing ratios on CAMS's pressure coordinate + ! for both the "minus" and "plus" months + ! + ! This loop over chunk could probably be removed by working with the whole + ! begchunk:endchunk group at once. It would require a slight generalization + ! in vert_interpolate. + do c = begchunk,endchunk + + lchnk = phys_state(c)%lchnk + pint = phys_state(c)%pint + ncol = get_ncols_p(c) + + call vert_interpolate (M_ps_cam_col(:,c,nm), pint, nm, aerosolm(:,:,:,c), ncol, c) + call vert_interpolate (M_ps_cam_col(:,c,np), pint, np, aerosolp(:,:,:,c), ncol, c) + + ! Time interpolate. + do m=1,naer + do k=1,pver + do i=1,ncol + aer_mass(i,k,m,c) = aerosolm(i,k,m,c)*fact1 + aerosolp(i,k,m,c)*fact2 + end do + end do + ! Partition seasalt aerosol mass + if (m .eq. idxSSLTA) then + aer_mass(:ncol,:,m,c) = (1._r8-wgt_sscm)*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in accumulation mode + elseif (m .eq. idxSSLTC) then + aer_mass(:ncol,:,m,c) = wgt_sscm*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in coarse mode + endif + end do + + ! exit if mass is negative (we have previously set + ! cumulative mass to be a decreasing function.) + speciesmin(:) = 0._r8 ! speciesmin(m) = 0 is minimum mass for each species + + error_found = .false. + do m=1,naer + do k=1,pver + do i=1,ncol + if (aer_mass(i, k, m,c) < speciesmin(m)) error_found = .true. + end do + end do + end do + if (error_found) then + do m=1,naer + do k=1,pver + do i=1,ncol + if (aer_mass(i, k, m,c) < speciesmin(m)) then + write(iulog,*) subname//': negative mass mixing ratio, exiting' + write(iulog,*) 'm, column, pver',m, i, k ,aer_mass(i, k, m,c) + call endrun () + end if + end do + end do + end do + end if + do k = 1, pver + mass_to_mmr(1:ncol,k) = gravit/(pint(1:ncol,k+1)-pint(1:ncol,k)) + enddo + + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, lchnk) + + call pbuf_set_field(phys_buffer_chunk, cam3_sul_idx, aer_mass(1:ncol,:, idxSUL,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_ssam_idx, aer_mass(1:ncol,:, idxSSLTA,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_sscm_idx, aer_mass(1:ncol,:, idxSSLTC,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_dust1_idx, aer_mass(1:ncol,:, idxDUSTfirst,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_dust2_idx, aer_mass(1:ncol,:,idxDUSTfirst+1,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_dust3_idx, aer_mass(1:ncol,:,idxDUSTfirst+2,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_dust4_idx, aer_mass(1:ncol,:,idxDUSTfirst+3,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_ocpho_idx, aer_mass(1:ncol,:, idxOCPHO,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_bcpho_idx, aer_mass(1:ncol,:, idxBCPHO,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_ocphi_idx, aer_mass(1:ncol,:, idxOCPHI,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk, cam3_bcphi_idx, aer_mass(1:ncol,:, idxBCPHI,c)*mass_to_mmr(:ncol,:), & + start=(/1,1/), kount=(/ncol,pver/)) + + enddo ! c = begchunk:endchunk + +end subroutine cam3_aero_data_timestep_init + +!================================================================================================ + +subroutine vert_interpolate (Match_ps, pint, n, aerosol_mass, ncol, c) +!-------------------------------------------------------------------- +! Input: match surface pressure, cam interface pressure, +! month index, number of columns, chunk index +! +! Output: Aerosol mass mixing ratio (aerosol_mass) +! +! Method: +! interpolate column mass (cumulative) from match onto +! cam's vertical grid (pressure coordinate) +! convert back to mass mixing ratio +! +!-------------------------------------------------------------------- + + real(r8), intent(out) :: aerosol_mass(pcols,pver,naer) ! aerosol mass from MATCH + real(r8), intent(in) :: Match_ps(pcols) ! surface pressure at a particular month + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressure from CAM + + integer, intent(in) :: ncol,c ! chunk index and number of columns + integer, intent(in) :: n ! prv or nxt month index +! +! Local workspace +! + integer m ! index to aerosol species + integer kupper(pcols) ! last upper bound for interpolation + integer i, k, kk, kkstart, kount ! loop vars for interpolation + integer isv, ksv, msv ! loop indices to save + + logical bad ! indicates a bad point found + logical lev_interp_comp ! interpolation completed for a level + logical error_found + + real(r8) aerosol(pcols,pverp,naer) ! cumulative mass of aerosol in column beneath upper + ! interface of level in column at particular month + real(r8) dpl, dpu ! lower and upper intepolation factors + real(r8) v_coord ! vertical coordinate + real(r8) AER_diff ! temp var for difference between aerosol masses + + character(len=*), parameter :: subname = 'cam3_aero_data.vert_interpolate' + !----------------------------------------------------------------------- + + call t_startf ('vert_interpolate') +! +! Initialize index array +! + do i=1,ncol + kupper(i) = 1 + end do +! +! assign total mass to topmost level +! + aerosol(:,1,:) = aerosolc(:,1,c,:,n) +! +! At every pressure level, interpolate onto that pressure level +! + do k=2,pver +! +! Top level we need to start looking is the top level for the previous k +! for all longitude points +! + kkstart = paerlev+1 + do i=1,ncol + kkstart = min0(kkstart,kupper(i)) + end do + kount = 0 +! +! Store level indices for interpolation +! +! for the pressure interpolation should be comparing +! pint(column,lev) with M_hybi(lev)*M_ps_cam_col(month,column,chunk) +! + lev_interp_comp = .false. + do kk=kkstart,paerlev + if(.not.lev_interp_comp) then + do i=1,ncol + v_coord = pint(i,k) + if (M_hybi(kk)*Match_ps(i) .lt. v_coord .and. v_coord .le. M_hybi(kk+1)*Match_ps(i)) then + kupper(i) = kk + kount = kount + 1 + end if + end do +! +! If all indices for this level have been found, do the interpolation and +! go to the next level +! +! Interpolate in pressure. +! + if (kount.eq.ncol) then + do m=1,naer + do i=1,ncol + dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) + dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) + aerosol(i,k,m) = & + (aerosolc(i,kupper(i) ,c,m,n)*dpl + & + aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) + enddo !i + end do + lev_interp_comp = .true. + end if + end if + end do +! +! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and +! must extrapolate from the bottom or top pressure level for at least some +! of the longitude points. +! + + if(.not.lev_interp_comp) then + do m=1,naer + do i=1,ncol + if (pint(i,k) .lt. M_hybi(1)*Match_ps(i)) then + aerosol(i,k,m) = aerosolc(i,1,c,m,n) + else if (pint(i,k) .gt. M_hybi(paerlev+1)*Match_ps(i)) then + aerosol(i,k,m) = 0.0_r8 + else + dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) + dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) + aerosol(i,k,m) = & + (aerosolc(i,kupper(i) ,c,m,n)*dpl + & + aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) + end if + end do + end do + + if (kount.gt.ncol) then + call endrun (subname//': Bad data: non-monotonicity suspected in dependent variable') + end if + end if + end do + +! call t_startf ('vi_checks') +! +! aerosol mass beneath lowest interface (pverp) must be 0 +! + aerosol(1:ncol,pverp,:) = 0._r8 +! +! Set mass in layer to zero whenever it is less than +! 1.e-40 kg/m^2 in the layer +! + do m = 1, naer + do k = 1, pver + do i = 1, ncol + if (aerosol(i,k,m) < 1.e-40_r8) aerosol(i,k,m) = 0._r8 + end do + end do + end do +! +! Set mass in layer to zero whenever it is less than +! 10^-15 relative to column total mass +! + error_found = .false. + do m = 1, naer + do k = 1, pver + do i = 1, ncol + AER_diff = aerosol(i,k,m) - aerosol(i,k+1,m) + if( abs(AER_diff) < 1e-15_r8*aerosol(i,1,m)) then + AER_diff = 0._r8 + end if + aerosol_mass(i,k,m)= AER_diff + if (aerosol_mass(i,k,m) < 0) error_found = .true. + end do + end do + end do + if (error_found) then + do m = 1, naer + do k = 1, pver + do i = 1, ncol + if (aerosol_mass(i,k,m) < 0) then + write(iulog,*) subname//': mass < 0, m, col, lev, mass',m, i, k, aerosol_mass(i,k,m) + write(iulog,*) subname//': aerosol(k),(k+1)',aerosol(i,k,m),aerosol(i,k+1,m) + write(iulog,*) subname//': pint(k+1),(k)',pint(i,k+1),pint(i,k) + write(iulog,*)'n,c',n,c + call endrun() + end if + end do + end do + end do + end if + + call t_stopf ('vert_interpolate') + + return +end subroutine vert_interpolate + +!================================================================================================ + +subroutine aerint (phys_state) + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + + integer :: ntmp ! used in index swapping + integer :: start(4) ! start vector for netcdf calls + integer :: kount(4) ! count vector for netcdf calls + integer :: i,j,k ! spatial indices + integer :: m ! constituent index + integer :: cols, cole + integer :: lchnk, ncol + real(r8) :: caldayloc ! calendar day of current timestep + real(r8) :: aerosol_data(naerlon,naerlat,paerlev) ! aerosol field read in from dataset + real(r8) :: aerosol_field(naerlon,paerlev+1,naerlat) ! aerosol field to be scattered + integer latidx,lonidx + real(r8) closelat,closelon + + character(len=*), parameter :: subname = 'cam3_aero_data.aerint' + !----------------------------------------------------------------------- + + if (single_column) & + call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + +! +! determine if need to read in next month data +! also determine time interpolation factors +! + caldayloc = get_curr_calday () +! +! If model time is past current forward timeslice, then +! masterproc reads in the next timeslice for time interpolation. Messy logic is +! for interpolation between December and January (mo_nxt == 1). Just like +! ozone_data_timestep_init, sstint. +! + if (caldayloc > cdayp .and. .not. (mo_nxt == 1 .and. caldayloc >= cdaym)) then + mo_nxt = mod(mo_nxt,12) + 1 + cdaym = cdayp + cdayp = Mid(mo_nxt) +! +! Check for valid date info +! + if (.not. (mo_nxt == 1 .or. caldayloc <= cdayp)) then + call endrun (subname//': Non-monotonicity suspected in input aerosol data') + end if + + ntmp = nm + nm = np + np = ntmp + + if(aerosol_datan%isncol) then + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + cols=1 + cole=cols+aerosol_datan%count(cols,lchnk)-1 + do while(cole<=ncol) + start=(/aerosol_datan%start(cols,lchnk),mo_nxt,1,-1/) + kount=(/aerosol_datan%count(cols,lchnk),1,-1,-1/) + call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%psid , & + aerosol_datan%ps(cols:cole,lchnk,np), start(1:2), & + kount(1:2)),& + subname, __LINE__) + start(2)=1 + start(3)=mo_nxt + kount(2)=paerlev + kount(3)=1 + do m=1,naer + call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%dataid(m) , & + aerosol_datan%fields(cols:cole,:,lchnk,m,np), & + start(1:3), kount(1:3)),& + subname, __LINE__) + + end do + if(cols==ncol) exit + cols=cols+aerosol_datan%count(cols,lchnk) + cole=cols+aerosol_datan%count(cols,lchnk)-1 + end do + end do + aerosolc(:,1:paerlev,:,:,np)=aerosol_datan%fields(:,:,:,:,np) + else + do m=1,naer + if (masterproc) then + if (single_column) then + naerlon=1 + naerlat=1 + start(:) = (/lonidx,latidx,1,mo_nxt/) + else + start(:) = (/1,1,1,mo_nxt/) + endif + kount(:) = (/naerlon,naerlat,paerlev,1/) + call handle_ncerr( nf90_get_var (aernid, species_id(m), aerosol_data, start, kount),& + subname, __LINE__) + + do j=1,naerlat + do k=1,paerlev + aerosol_field(:,k,j) = aerosol_data(:,j,k) + end do + aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom + end do + end if + call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & + aerosolc(:,:,:,m,np)) + end do +! +! Retrieve PS from Match +! + if (masterproc) then + if (single_column) then + naerlon=1 + naerlat=1 + start(:) = (/lonidx,latidx,mo_nxt,-1/) + else + start(:) = (/1,1,mo_nxt,-1/) + endif + kount(:) = (/naerlon,naerlat,1,-1/) + call handle_ncerr( nf90_get_var (aernid, Mpsid, M_ps, start, kount),& + subname, __LINE__) + write(iulog,*) subname//': Read aerosols data for julian day', Mid(mo_nxt) + end if + call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,np)) + end if + end if + +end subroutine aerint + +end module cam3_aero_data diff --git a/src/physics/cam/cam3_ozone_data.F90 b/src/physics/cam/cam3_ozone_data.F90 new file mode 100644 index 0000000000..567679fb0d --- /dev/null +++ b/src/physics/cam/cam3_ozone_data.F90 @@ -0,0 +1,220 @@ +module cam3_ozone_data + +!----------------------------------------------------------------------- +! Purpose: +! +! Interpolates zonal ozone datasets used by CAM3 and puts the field 'O3' into +! the physics buffer. +! +! Revision history: +! 2004-07-31 B. Eaton Assemble module from comozp.F90, oznini.F90, oznint.F90, radozn.F90 +! 2004-08-19 B. Eaton Modify ozone_data_vert_interp to return mass mixing ratio. +! 2004-08-30 B. Eaton Add ozone_data_get_cnst method. +! 2008 June B. Eaton Change name to cam3_ozone_data to support backwards compatibility +! for reading the CAM3 ozone data. Add *_readnl method so module +! reads its own namelist. Add cam3_ozone_data_on variable to +! turn the module on from the namelist. By default it's off. +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: begchunk, endchunk, pcols, pver +use cam_abortutils, only: endrun +use cam_logfile, only: iulog +use physics_types, only: physics_state +use boundarydata, only: boundarydata_type, boundarydata_init, boundarydata_update, & + boundarydata_vert_interp +use mpishorthand + +implicit none +private +save + +! Public methods +public ::& + cam3_ozone_data_readnl, &! get namelist input + cam3_ozone_data_register, &! register ozone with physics buffer + cam3_ozone_data_init, &! open dataset and spatially interpolate data bounding initial time + cam3_ozone_data_timestep_init ! interpolate to current time + +! Namelist variables +logical, public :: cam3_ozone_data_on = .false. ! switch to turn module on/off +logical :: ozncyc = .true. ! .true. => assume annual cycle ozone data +character(len=256) :: bndtvo = ' ' ! full pathname for time-variant ozone dataset + +! Local +integer :: oz_idx ! index into phys_buffer for ozone + +type(boundarydata_type) :: ozonedata +character(len=6), parameter, dimension(1) :: nc_name = (/'OZONE '/) ! constituent names + +!================================================================================================ +contains +!================================================================================================ + +subroutine cam3_ozone_data_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cam3_ozone_data_readnl' + + namelist /cam3_ozone_data_nl/ cam3_ozone_data_on, bndtvo, ozncyc + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cam3_ozone_data_nl', status=ierr) + if (ierr == 0) then + read(unitn, cam3_ozone_data_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(cam3_ozone_data_on, 1, mpilog, 0, mpicom) + call mpibcast(bndtvo, len(bndtvo), mpichar, 0, mpicom) + call mpibcast(ozncyc, 1, mpilog, 0, mpicom) +#endif + +end subroutine cam3_ozone_data_readnl + +!================================================================================================ + +subroutine cam3_ozone_data_register() + use physics_buffer, only : pbuf_add_field, dtype_r8 + + call pbuf_add_field('O3','physpkg',dtype_r8,(/pcols,pver/),oz_idx) + +end subroutine cam3_ozone_data_register + +!================================================================================================ + +subroutine cam3_ozone_data_init(phys_state) +!----------------------------------------------------------------------- +! +! Purpose: Do initial read of time-variant ozone boundary dataset, containing +! ozone mixing ratios as a function of latitude and pressure. Read two +! consecutive months between which the current date lies. Routine +! RADOZ2 then evaluates the two path length integrals (with and without +! pressure weighting) from zero to the interfaces between the input +! levels. It also stores the contribution to the integral from each +! layer. +! +! Method: Call appropriate netcdf wrapper routines and interpolate to model grid +! +! Author: CCM Core Group +! Modified: P. Worley, August 2003, for chunking and performance optimization +! J. Edwards, Dec 2005, functionality now performed by zonalbndrydata +!----------------------------------------------------------------------- + + use cam_history, only: addfld + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + !----------------------------------------------------------------------- + + call addfld ('O3VMR', (/ 'lev' /), 'A', 'm3/m3', 'Ozone volume mixing ratio', sampling_seq='rad_lwsw') + + + ! Initialize for one field (arg_4=1) and do not vertically interpolate (arg_6=3) + call boundarydata_init(bndtvo, phys_state, nc_name, 1, ozonedata, 3) + + if (masterproc) then + write(iulog,*)'cam3_ozone_data_init: Initializing CAM3 prescribed ozone' + write(iulog,*)'Time-variant boundary dataset (ozone) is: ', trim(bndtvo) + if (ozncyc) then + write(iulog,*)'OZONE dataset will be reused for each model year' + else + write(iulog,*)'OZONE dataset will not be cycled' + end if + end if + +end subroutine cam3_ozone_data_init + +!================================================================================================ + +subroutine cam3_ozone_data_timestep_init(pbuf2d, phys_state) +!----------------------------------------------------------------------- +! +! Purpose: Interpolate ozone mixing ratios to current time, reading in new monthly +! data if necessary, and spatially interpolating it. +! +! Method: Find next month of ozone data to interpolate. Linearly interpolate +! vertically and horizontally +! +!----------------------------------------------------------------------- + + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + real(r8),pointer :: tmpptr(:,:) + + integer lchnk + + call boundarydata_update(phys_state, ozonedata) + + do lchnk = begchunk, endchunk + call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), oz_idx, tmpptr) + call ozone_data_get_cnst(phys_state(lchnk), tmpptr) + enddo + +end subroutine cam3_ozone_data_timestep_init + +!================================================================================================ + +subroutine ozone_data_get_cnst(state, q) + + use cam_history, only: outfld + use physconst, only: mwo3 + + type(physics_state), intent(in) :: state + real(r8) :: q(:,:) ! constituent mass mixing ratio + + ! local variables + integer :: lchnk ! chunk identifier + integer :: i, k + real(r8) :: ozmixin(pcols,ozonedata%levsiz) + ! *** N.B. this hardwired mw of dry air needs to be changed to the share value + real(r8), parameter :: mwdry = 28.9644_r8 ! Effective molecular weight of dry air (g/mol) + real(r8), parameter :: mwr = mwo3/mwdry ! convert from the dataset values of vmr to mmr + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + + ozmixin=0._r8 + do k=1,ozonedata%levsiz + do i=1,state%ncol + ozmixin(i,k) = ozonedata%datainst(state%latmapback(i),k,lchnk,1) + end do + end do + call boundarydata_vert_interp(lchnk, state%ncol, ozonedata%levsiz, & + 1, ozonedata%pin, state%pmid, ozmixin , q) + + call outfld('O3VMR', q, pcols, lchnk) + + do k=1,pver + do i=1,state%ncol + q(i,k) = mwr*q(i,k) + end do + end do + +end subroutine ozone_data_get_cnst + +!================================================================================================ + +end module cam3_ozone_data + diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 new file mode 100644 index 0000000000..61eb723f1f --- /dev/null +++ b/src/physics/cam/cam_diagnostics.F90 @@ -0,0 +1,2214 @@ +module cam_diagnostics + +!--------------------------------------------------------------------------------- +! Module to compute a variety of diagnostics quantities for history files +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use camsrfexch, only: cam_in_t, cam_out_t +use cam_control_mod, only: moist_physics +use physics_types, only: physics_state, physics_tend +use ppgrid, only: pcols, pver, begchunk, endchunk +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8 +use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx + +use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all +use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld +use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind +use dycore, only: dycore_is +use phys_control, only: phys_getopts +use wv_saturation, only: qsat, qsat_water, svp_ice +use time_manager, only: is_first_step + +use scamMod, only: single_column, wfld +use cam_abortutils, only: endrun + +implicit none +private +save + +! Public interfaces + +public :: & + diag_readnl, &! read namelist options + diag_register, &! register pbuf space + diag_init, &! initialization + diag_allocate, &! allocate memory for module variables + diag_deallocate, &! deallocate memory for module variables + diag_conv_tend_ini, &! initialize convective tendency calcs + diag_phys_writeout, &! output diagnostics of the dynamics + diag_phys_tend_writeout, & ! output physics tendencies + diag_state_b4_phys_write,& ! output state before physics execution + diag_conv, &! output diagnostics of convective processes + diag_surf, &! output diagnostics of the surface + diag_export, &! output export state + diag_physvar_ic + + +! Private data + +integer :: dqcond_num ! number of constituents to compute convective +character(len=16) :: dcconnam(pcnst) ! names of convection tendencies + ! tendencies for +real(r8), allocatable :: dtcond(:,:,:) ! temperature tendency due to convection +type dqcond_t + real(r8), allocatable :: cnst(:,:,:) ! constituent tendency due to convection +end type dqcond_t +type(dqcond_t), allocatable :: dqcond(:) + +character(len=8) :: diag_cnst_conv_tend = 'q_only' ! output constituent tendencies due to convection + ! 'none', 'q_only' or 'all' + +integer, parameter :: surf_100000 = 1 +integer, parameter :: surf_092500 = 2 +integer, parameter :: surf_085000 = 3 +integer, parameter :: surf_070000 = 4 +integer, parameter :: nsurf = 4 + +logical :: history_amwg ! output the variables used by the AMWG diag package +logical :: history_vdiag ! output the variables used by the AMWG variability diag package +logical :: history_eddy ! output the eddy variables +logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. +integer :: history_budget_histfile_num ! output history file number for budget fields +logical :: history_waccm ! outputs typically used for WACCM + +!Physics buffer indices +integer :: qcwat_idx = 0 +integer :: tcwat_idx = 0 +integer :: lcwat_idx = 0 +integer :: cld_idx = 0 +integer :: concld_idx = 0 +integer :: tke_idx = 0 +integer :: kvm_idx = 0 +integer :: kvh_idx = 0 +integer :: cush_idx = 0 +integer :: t_ttend_idx = 0 + +integer :: prec_dp_idx = 0 +integer :: snow_dp_idx = 0 +integer :: prec_sh_idx = 0 +integer :: snow_sh_idx = 0 +integer :: prec_sed_idx = 0 +integer :: snow_sed_idx = 0 +integer :: prec_pcw_idx = 0 +integer :: snow_pcw_idx = 0 + + +integer :: tpert_idx=-1, qpert_idx=-1, pblh_idx=-1 + +integer :: trefmxav_idx = -1, trefmnav_idx = -1 + +contains + +!============================================================================== + + subroutine diag_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, masterprocid, mpi_character, mpicom + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'diag_readnl' + + namelist /cam_diag_opts/ diag_cnst_conv_tend + !-------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cam_diag_opts', status=ierr) + if (ierr == 0) then + read(unitn, cam_diag_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(diag_cnst_conv_tend, len(diag_cnst_conv_tend), mpi_character, masterprocid, mpicom, ierr) + + end subroutine diag_readnl + +!============================================================================== + + subroutine diag_register_dry() + ! Request physics buffer space for fields that persist across timesteps. + call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx) + end subroutine diag_register_dry + + subroutine diag_register_moist() + ! Request physics buffer space for fields that persist across timesteps. + call pbuf_add_field('TREFMXAV', 'global', dtype_r8, (/pcols/), trefmxav_idx) + call pbuf_add_field('TREFMNAV', 'global', dtype_r8, (/pcols/), trefmnav_idx) + end subroutine diag_register_moist + + subroutine diag_register() + call diag_register_dry() + if (moist_physics) then + call diag_register_moist() + end if + end subroutine diag_register + +!============================================================================== + + subroutine diag_init_dry(pbuf2d) + ! Declare the history fields for which this module contains outfld calls. + + use cam_history, only: addfld, add_default, horiz_only + use cam_history, only: register_vector_field + use constituent_burden, only: constituent_burden_init + use physics_buffer, only: pbuf_set_field + use tidal_diag, only: tidal_diag_init + + type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) + + integer :: k, m + integer :: ierr + + ! outfld calls in diag_phys_writeout + call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) + call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep') + call addfld ('PHIS', horiz_only, 'I', 'm2/s2', 'Surface geopotential') + + call addfld ('PS', horiz_only, 'A', 'Pa', 'Surface pressure') + call addfld ('T', (/ 'lev' /), 'A', 'K', 'Temperature') + call addfld ('U', (/ 'lev' /), 'A', 'm/s', 'Zonal wind') + call addfld ('V', (/ 'lev' /), 'A', 'm/s', 'Meridional wind') + + call register_vector_field('U','V') + + ! State before physics + call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)') + call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)') + ! State after physics + call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' ) + call addfld ('UAP', (/ 'lev' /), 'A','m/s', 'Zonal wind (after physics)' ) + call addfld ('VAP', (/ 'lev' /), 'A','m/s', 'Meridional wind (after physics)' ) + + call register_vector_field('UAP','VAP') + + call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') + if ( dycore_is('LR') .or. dycore_is('SE') ) then + call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') + end if + call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') + + call addfld ('Z3', (/ 'lev' /), 'A', 'm', 'Geopotential Height (above sea level)') + call addfld ('Z1000', horiz_only, 'A', 'm', 'Geopotential Z at 1000 mbar pressure surface') + call addfld ('Z700', horiz_only, 'A', 'm', 'Geopotential Z at 700 mbar pressure surface') + call addfld ('Z500', horiz_only, 'A', 'm', 'Geopotential Z at 500 mbar pressure surface') + call addfld ('Z300', horiz_only, 'A', 'm', 'Geopotential Z at 300 mbar pressure surface') + call addfld ('Z200', horiz_only, 'A', 'm', 'Geopotential Z at 200 mbar pressure surface') + call addfld ('Z100', horiz_only, 'A', 'm', 'Geopotential Z at 100 mbar pressure surface') + call addfld ('Z050', horiz_only, 'A', 'm', 'Geopotential Z at 50 mbar pressure surface') + + call addfld ('ZZ', (/ 'lev' /), 'A', 'm2', 'Eddy height variance' ) + call addfld ('VZ', (/ 'lev' /), 'A', 'm2/s', 'Meridional transport of geopotential height') + call addfld ('VT', (/ 'lev' /), 'A', 'K m/s ', 'Meridional heat transport') + call addfld ('VU', (/ 'lev' /), 'A', 'm2/s2', 'Meridional flux of zonal momentum' ) + call addfld ('VV', (/ 'lev' /), 'A', 'm2/s2', 'Meridional velocity squared' ) + call addfld ('OMEGAV', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of meridional momentum' ) + call addfld ('OMGAOMGA', (/ 'lev' /), 'A', 'Pa2/s2', 'Vertical flux of vertical momentum' ) + + call addfld ('UU', (/ 'lev' /), 'A', 'm2/s2', 'Zonal velocity squared' ) + call addfld ('WSPEED', (/ 'lev' /), 'X', 'm/s', 'Horizontal total wind speed maximum' ) + call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at the surface' ) + call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at the surface' ) + + call addfld ('OMEGA', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)') + call addfld ('OMEGAT', (/ 'lev' /), 'A', 'K Pa/s ', 'Vertical heat flux' ) + call addfld ('OMEGAU', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of zonal momentum' ) + call addfld ('OMEGA850', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 850 mbar pressure surface') + call addfld ('OMEGA500', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 500 mbar pressure surface') + + call addfld ('PSL', horiz_only, 'A', 'Pa','Sea level pressure') + + call addfld ('T1000', horiz_only, 'A', 'K','Temperature at 1000 mbar pressure surface') + call addfld ('T925', horiz_only, 'A', 'K','Temperature at 925 mbar pressure surface') + call addfld ('T850', horiz_only, 'A', 'K','Temperature at 850 mbar pressure surface') + call addfld ('T700', horiz_only, 'A', 'K','Temperature at 700 mbar pressure surface') + call addfld ('T500', horiz_only, 'A', 'K','Temperature at 500 mbar pressure surface') + call addfld ('T400', horiz_only, 'A', 'K','Temperature at 400 mbar pressure surface') + call addfld ('T300', horiz_only, 'A', 'K','Temperature at 300 mbar pressure surface') + call addfld ('T200', horiz_only, 'A', 'K','Temperature at 200 mbar pressure surface') + call addfld ('T010', horiz_only, 'A', 'K','Temperature at 10 mbar pressure surface') + + call addfld ('T7001000', horiz_only, 'A', 'K','Temperature difference 700 mb - 1000 mb') + call addfld ('TH7001000', horiz_only, 'A', 'K','Theta difference 700 mb - 1000 mb') + call addfld ('THE7001000', horiz_only, 'A', 'K','ThetaE difference 700 mb - 1000 mb') + + call addfld ('T8501000', horiz_only, 'A', 'K','Temperature difference 850 mb - 1000 mb') + call addfld ('TH8501000', horiz_only, 'A', 'K','Theta difference 850 mb - 1000 mb') + call addfld ('T9251000', horiz_only, 'A', 'K','Temperature difference 925 mb - 1000 mb') + call addfld ('TH9251000', horiz_only, 'A', 'K','Theta difference 925 mb - 1000 mb') + + call addfld ('TT', (/ 'lev' /), 'A', 'K2','Eddy temperature variance' ) + + call addfld ('U850', horiz_only, 'A', 'm/s','Zonal wind at 850 mbar pressure surface') + call addfld ('U500', horiz_only, 'A', 'm/s','Zonal wind at 500 mbar pressure surface') + call addfld ('U250', horiz_only, 'A', 'm/s','Zonal wind at 250 mbar pressure surface') + call addfld ('U200', horiz_only, 'A', 'm/s','Zonal wind at 200 mbar pressure surface') + call addfld ('U010', horiz_only, 'A', 'm/s','Zonal wind at 10 mbar pressure surface') + call addfld ('V850', horiz_only, 'A', 'm/s','Meridional wind at 850 mbar pressure surface') + call addfld ('V500', horiz_only, 'A', 'm/s','Meridional wind at 500 mbar pressure surface') + call addfld ('V250', horiz_only, 'A', 'm/s','Meridional wind at 250 mbar pressure surface') + call addfld ('V200', horiz_only, 'A', 'm/s','Meridional wind at 200 mbar pressure surface') + + call register_vector_field('U850', 'V850') + call register_vector_field('U500', 'V500') + call register_vector_field('U250', 'V250') + call register_vector_field('U200', 'V200') + + call addfld ('UBOT', horiz_only, 'A', 'm/s','Lowest model level zonal wind') + call addfld ('VBOT', horiz_only, 'A', 'm/s','Lowest model level meridional wind') + call register_vector_field('UBOT', 'VBOT') + + call addfld ('ZBOT', horiz_only, 'A', 'm','Lowest model level height') + + call addfld ('ATMEINT', horiz_only, 'A', 'J/m2','Vertically integrated total atmospheric energy ') + + if (history_amwg) then + call add_default ('PHIS ' , 1, ' ') + call add_default ('PS ' , 1, ' ') + call add_default ('T ' , 1, ' ') + call add_default ('U ' , 1, ' ') + call add_default ('V ' , 1, ' ') + call add_default ('Z3 ' , 1, ' ') + call add_default ('OMEGA ' , 1, ' ') + call add_default ('VT ', 1, ' ') + call add_default ('VU ', 1, ' ') + call add_default ('VV ', 1, ' ') + call add_default ('UU ', 1, ' ') + call add_default ('OMEGAT ', 1, ' ') + call add_default ('PSL ', 1, ' ') + end if + + if (history_vdiag) then + call add_default ('U200', 2, ' ') + call add_default ('V200', 2, ' ') + call add_default ('U850', 2, ' ') + call add_default ('U200', 3, ' ') + call add_default ('U850', 3, ' ') + call add_default ('OMEGA500', 3, ' ') + end if + + if (history_eddy) then + call add_default ('VT ', 1, ' ') + call add_default ('VU ', 1, ' ') + call add_default ('VV ', 1, ' ') + call add_default ('UU ', 1, ' ') + call add_default ('OMEGAT ', 1, ' ') + call add_default ('OMEGAU ', 1, ' ') + call add_default ('OMEGAV ', 1, ' ') + endif + + if ( history_budget ) then + call add_default ('PHIS ' , history_budget_histfile_num, ' ') + call add_default ('PS ' , history_budget_histfile_num, ' ') + call add_default ('T ' , history_budget_histfile_num, ' ') + call add_default ('U ' , history_budget_histfile_num, ' ') + call add_default ('V ' , history_budget_histfile_num, ' ') + call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ') + + ! State before physics (FV) + call add_default ('TBP ' , history_budget_histfile_num, ' ') + call add_default (bpcnst(1) , history_budget_histfile_num, ' ') + ! State after physics (FV) + call add_default ('TAP ' , history_budget_histfile_num, ' ') + call add_default ('UAP ' , history_budget_histfile_num, ' ') + call add_default ('VAP ' , history_budget_histfile_num, ' ') + call add_default (apcnst(1) , history_budget_histfile_num, ' ') + if ( dycore_is('LR') .or. dycore_is('SE') ) then + call add_default ('TFIX ' , history_budget_histfile_num, ' ') + end if + end if + + if (history_waccm) then + call add_default ('PHIS', 7, ' ') + call add_default ('PS', 7, ' ') + call add_default ('PSL', 7, ' ') + end if + + ! outfld calls in diag_phys_tend_writeout + call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency' ) + if ( history_budget ) then + call add_default ('PTTEND' , history_budget_histfile_num, ' ') + end if + + ! create history variables for fourier coefficients of the diurnal + ! and semidiurnal tide in T, U, V, and Z3 + call tidal_diag_init() + + end subroutine diag_init_dry + + subroutine diag_init_moist(pbuf2d) + + ! Declare the history fields for which this module contains outfld calls. + + use cam_history, only: addfld, add_default, horiz_only + use cam_history, only: register_vector_field + use constituent_burden, only: constituent_burden_init + use physics_buffer, only: pbuf_set_field + + type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) + + integer :: k, m + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + integer :: ierr + ! column burdens for all constituents except water vapor + call constituent_burden_init + + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + + ! outfld calls in diag_phys_writeout + call addfld ('OMEGAQ', (/ 'lev' /), 'A', 'kgPa/kgs', 'Vertical water transport' ) + call addfld ('VQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Meridional water transport') + call addfld ('QQ', (/ 'lev' /), 'A', 'kg2/kg2', 'Eddy moisture variance') + + call addfld ('MQ', (/ 'lev' /), 'A', 'kg/m2','Water vapor mass in layer') + call addfld ('TMQ', horiz_only, 'A', 'kg/m2','Total (vertically integrated) precipitable water') + call addfld ('RELHUM', (/ 'lev' /), 'A', 'percent','Relative humidity') + call addfld ('RHW', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to liquid') + call addfld ('RHI', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to ice') + call addfld ('RHCFMIP', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to water above 273 K, ice below 273 K') + + call addfld ('THE8501000', horiz_only, 'A', 'K','ThetaE difference 850 mb - 1000 mb') + call addfld ('THE9251000', horiz_only, 'A', 'K','ThetaE difference 925 mb - 1000 mb') + + call addfld ('Q1000', horiz_only, 'A', 'kg/kg','Specific Humidity at 1000 mbar pressure surface') + call addfld ('Q925', horiz_only, 'A', 'kg/kg','Specific Humidity at 925 mbar pressure surface') + call addfld ('Q850', horiz_only, 'A', 'kg/kg','Specific Humidity at 850 mbar pressure surface') + call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 700 mbar pressure surface') + call addfld ('QBOT', horiz_only, 'A', 'kg/kg','Lowest model level water vapor mixing ratio') + + call addfld ('PSDRY', horiz_only, 'A', 'Pa', 'Dry surface pressure') + call addfld ('PMID', (/ 'lev' /), 'A', 'Pa', 'Pressure at layer midpoints') + call addfld ('PDELDRY', (/ 'lev' /), 'A', 'Pa', 'Dry pressure difference between levels') + + ! outfld calls in diag_conv + + call addfld ('DTCOND', (/ 'lev' /), 'A','K/s','T tendency - moist processes') + call addfld ('DTCOND_24_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. cos coeff.') + call addfld ('DTCOND_24_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. sin coeff.') + call addfld ('DTCOND_12_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. cos coeff.') + call addfld ('DTCOND_12_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. sin coeff.') + call addfld ('DTCOND_08_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. cos coeff.') + call addfld ('DTCOND_08_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. sin coeff.') + + call addfld ('PRECL', horiz_only, 'A', 'm/s','Large-scale (stable) precipitation rate (liq + ice)' ) + call addfld ('PRECC', horiz_only, 'A', 'm/s','Convective precipitation rate (liq + ice)' ) + call addfld ('PRECT', horiz_only, 'A', 'm/s','Total (convective and large-scale) precipitation rate (liq + ice)' ) + call addfld ('PREC_PCW', horiz_only, 'A', 'm/s','LS_pcw precipitation rate') + call addfld ('PREC_zmc', horiz_only, 'A', 'm/s','CV_zmc precipitation rate') + call addfld ('PRECTMX', horiz_only, 'X','m/s','Maximum (convective and large-scale) precipitation rate (liq+ice)' ) + call addfld ('PRECSL', horiz_only, 'A', 'm/s','Large-scale (stable) snow rate (water equivalent)' ) + call addfld ('PRECSC', horiz_only, 'A', 'm/s','Convective snow rate (water equivalent)' ) + call addfld ('PRECCav', horiz_only, 'A', 'm/s','Average large-scale precipitation (liq + ice)' ) + call addfld ('PRECLav', horiz_only, 'A', 'm/s','Average convective precipitation (liq + ice)' ) + + ! outfld calls in diag_surf + + call addfld ('SHFLX', horiz_only, 'A', 'W/m2','Surface sensible heat flux') + call addfld ('LHFLX', horiz_only, 'A', 'W/m2','Surface latent heat flux') + call addfld ('QFLX', horiz_only, 'A', 'kg/m2/s','Surface water flux') + + call addfld ('TAUX', horiz_only, 'A', 'N/m2','Zonal surface stress') + call addfld ('TAUY', horiz_only, 'A', 'N/m2','Meridional surface stress') + call addfld ('TREFHT', horiz_only, 'A', 'K','Reference height temperature') + call addfld ('TREFHTMN', horiz_only, 'M','K','Minimum reference height temperature over output period') + call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period') + call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity') + call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed') + call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') + + call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') + call addfld ('ICEFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by sea-ice') + call addfld ('OCNFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by ocean') + + call addfld ('TREFMNAV', horiz_only, 'A', 'K','Average of TREFHT daily minimum') + call addfld ('TREFMXAV', horiz_only, 'A', 'K','Average of TREFHT daily maximum') + + call addfld ('TS', horiz_only, 'A', 'K','Surface temperature (radiative)') + call addfld ('TSMN', horiz_only, 'M','K','Minimum surface temperature over output period') + call addfld ('TSMX', horiz_only, 'X','K','Maximum surface temperature over output period') + call addfld ('SNOWHLND', horiz_only, 'A', 'm','Water equivalent snow depth') + call addfld ('SNOWHICE', horiz_only, 'A', 'm','Snow depth over ice', fill_value = 1.e30_r8) + call addfld ('TBOT', horiz_only, 'A', 'K','Lowest model level temperature') + + call addfld ('ASDIR', horiz_only, 'A', '1','albedo: shortwave, direct') + call addfld ('ASDIF', horiz_only, 'A', '1','albedo: shortwave, diffuse') + call addfld ('ALDIR', horiz_only, 'A', '1','albedo: longwave, direct') + call addfld ('ALDIF', horiz_only, 'A', '1','albedo: longwave, diffuse') + call addfld ('SST', horiz_only, 'A', 'K','sea surface temperature') + ! + ! energy diagnostics + ! + call addfld ('SE_pBF', horiz_only, 'A', 'J/m2','Dry Static Energy before energy fixer') + call addfld ('SE_pBP', horiz_only, 'A', 'J/m2','Dry Static Energy before parameterizations') + call addfld ('SE_pAP', horiz_only, 'A', 'J/m2','Dry Static Energy after parameterizations') + call addfld ('SE_pAM', horiz_only, 'A', 'J/m2','Dry Static Energy after dry mass correction') + + call addfld ('KE_pBF', horiz_only, 'A', 'J/m2','Kinetic Energy before energy fixer') + call addfld ('KE_pBP', horiz_only, 'A', 'J/m2','Kinetic Energy before parameterizations') + call addfld ('KE_pAP', horiz_only, 'A', 'J/m2','Kinetic Energy after parameterizations') + call addfld ('KE_pAM', horiz_only, 'A', 'J/m2','Kinetic Energy after dry mass correction') + + call addfld ('TT_pBF', horiz_only, 'A', 'kg/m2','Total column test tracer before energy fixer') + call addfld ('TT_pBP', horiz_only, 'A', 'kg/m2','Total column test tracer before parameterizations') + call addfld ('TT_pAP', horiz_only, 'A', 'kg/m2','Total column test tracer after parameterizations') + call addfld ('TT_pAM', horiz_only, 'A', 'kg/m2','Total column test tracer after dry mass correction') + + call addfld ('WV_pBF', horiz_only, 'A', 'kg/m2','Total column water vapor before energy fixer') + call addfld ('WV_pBP', horiz_only, 'A', 'kg/m2','Total column water vapor before parameterizations') + call addfld ('WV_pAP', horiz_only, 'A', 'kg/m2','Total column water vapor after parameterizations') + call addfld ('WV_pAM', horiz_only, 'A', 'kg/m2','Total column water vapor after dry mass correction') + + call addfld ('WL_pBF', horiz_only, 'A', 'kg/m2','Total column cloud water before energy fixer') + call addfld ('WL_pBP', horiz_only, 'A', 'kg/m2','Total column cloud water before parameterizations') + call addfld ('WL_pAP', horiz_only, 'A', 'kg/m2','Total column cloud water after parameterizations') + call addfld ('WL_pAM', horiz_only, 'A', 'kg/m2','Total column cloud water after dry mass correction') + + call addfld ('WI_pBF', horiz_only, 'A', 'kg/m2','Total column cloud ice before energy fixer') + call addfld ('WI_pBP', horiz_only, 'A', 'kg/m2','Total column cloud ice before parameterizations') + call addfld ('WI_pAP', horiz_only, 'A', 'kg/m2','Total column cloud ice after parameterizations') + call addfld ('WI_pAM', horiz_only, 'A', 'kg/m2','Total column cloud ice after dry mass correction') + ! + ! Axial Angular Momentum diagnostics + ! + call addfld ('MR_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column wind axial angular momentum before energy fixer') + call addfld ('MR_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column wind axial angular momentum before parameterizations') + call addfld ('MR_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column wind axial angular momentum after parameterizations') + call addfld ('MR_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column wind axial angular momentum after dry mass correction') + + call addfld ('MO_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column mass axial angular momentum before energy fixer') + call addfld ('MO_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column mass axial angular momentum before parameterizations') + call addfld ('MO_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column mass axial angular momentum after parameterizations') + call addfld ('MO_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& + 'Total column mass axial angular momentum after dry mass correction') + + ! outfld calls in diag_phys_tend_writeout + + call addfld (ptendnam( 1),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name( 1))//' total physics tendency ' ) + call addfld (ptendnam(ixcldliq),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldliq))//' total physics tendency ' ) + if (ixcldice > 0) then + call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') + end if + if ( dycore_is('LR') )then + call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name( 1))//' dme adjustment tendency (FV) ') + call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') + if (ixcldice > 0) then + call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') + end if + end if + + ! outfld calls in diag_physvar_ic + + call addfld ('QCWAT&IC', (/ 'lev' /), 'I','kg/kg','q associated with cloud water' ) + call addfld ('TCWAT&IC', (/ 'lev' /), 'I','kg/kg','T associated with cloud water' ) + call addfld ('LCWAT&IC', (/ 'lev' /), 'I','kg/kg','Cloud water (ice + liq' ) + call addfld ('CLOUD&IC', (/ 'lev' /), 'I','fraction','Cloud fraction' ) + call addfld ('CONCLD&IC', (/ 'lev' /), 'I','fraction','Convective cloud fraction' ) + call addfld ('TKE&IC', (/ 'ilev' /), 'I','m2/s2','Turbulent Kinetic Energy' ) + call addfld ('CUSH&IC', horiz_only, 'I','m','Convective Scale Height' ) + call addfld ('KVH&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (heat/moisture)' ) + call addfld ('KVM&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (momentum)' ) + call addfld ('PBLH&IC', horiz_only, 'I','m','PBL height' ) + call addfld ('TPERT&IC', horiz_only, 'I','K','Perturbation temperature (eddies in PBL)' ) + call addfld ('QPERT&IC', horiz_only, 'I','kg/kg','Perturbation specific humidity (eddies in PBL)' ) + + ! CAM export state + call addfld('a2x_BCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic black carbon') + call addfld('a2x_BCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic black carbon') + call addfld('a2x_BCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic black carbon') + call addfld('a2x_OCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic organic carbon') + call addfld('a2x_OCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic organic carbon') + call addfld('a2x_OCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic organic carbon') + call addfld('a2x_DSTWET1', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin1)') + call addfld('a2x_DSTDRY1', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin1)') + call addfld('a2x_DSTWET2', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin2)') + call addfld('a2x_DSTDRY2', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin2)') + call addfld('a2x_DSTWET3', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin3)') + call addfld('a2x_DSTDRY3', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin3)') + call addfld('a2x_DSTWET4', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin4)') + call addfld('a2x_DSTDRY4', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin4)') + + ! defaults + if (history_amwg) then + call add_default (cnst_name(1), 1, ' ') + call add_default ('VQ ', 1, ' ') + call add_default ('TMQ ', 1, ' ') + call add_default ('PSL ', 1, ' ') + call add_default ('RELHUM ', 1, ' ') + + call add_default ('DTCOND ', 1, ' ') + call add_default ('PRECL ', 1, ' ') + call add_default ('PRECC ', 1, ' ') + call add_default ('PRECSL ', 1, ' ') + call add_default ('PRECSC ', 1, ' ') + call add_default ('SHFLX ', 1, ' ') + call add_default ('LHFLX ', 1, ' ') + call add_default ('QFLX ', 1, ' ') + call add_default ('TAUX ', 1, ' ') + call add_default ('TAUY ', 1, ' ') + call add_default ('TREFHT ', 1, ' ') + call add_default ('LANDFRAC', 1, ' ') + call add_default ('OCNFRAC ', 1, ' ') + call add_default ('QREFHT ', 1, ' ') + call add_default ('U10 ', 1, ' ') + call add_default ('ICEFRAC ', 1, ' ') + call add_default ('TS ', 1, ' ') + call add_default ('TSMN ', 1, ' ') + call add_default ('TSMX ', 1, ' ') + call add_default ('SNOWHLND', 1, ' ') + call add_default ('SNOWHICE', 1, ' ') + end if + + if (dycore_is('SE')) then + call add_default ('PSDRY', 1, ' ') + call add_default ('PMID', 1, ' ') + end if + + if (history_eddy) then + call add_default ('VQ ', 1, ' ') + endif + + if ( history_budget ) then + call add_default (cnst_name(1), history_budget_histfile_num, ' ') + call add_default ('PTTEND' , history_budget_histfile_num, ' ') + call add_default (ptendnam( 1), history_budget_histfile_num, ' ') + call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ') + if (ixcldice > 0) then + call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') + end if + if ( dycore_is('LR') )then + call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') + call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') + if (ixcldice > 0) then + call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') + end if + end if + if( history_budget_histfile_num > 1 ) then + call add_default ('DTCOND ' , history_budget_histfile_num, ' ') + end if + end if + + if (history_vdiag) then + call add_default ('PRECT ', 2, ' ') + call add_default ('PRECT ', 3, ' ') + call add_default ('PRECT ', 4, ' ') + end if + + ! Initial file - Optional fields + if (inithist_all.or.single_column) then + call add_default ('CONCLD&IC ',0, 'I') + call add_default ('QCWAT&IC ',0, 'I') + call add_default ('TCWAT&IC ',0, 'I') + call add_default ('LCWAT&IC ',0, 'I') + call add_default ('PBLH&IC ',0, 'I') + call add_default ('TPERT&IC ',0, 'I') + call add_default ('QPERT&IC ',0, 'I') + call add_default ('CLOUD&IC ',0, 'I') + call add_default ('TKE&IC ',0, 'I') + call add_default ('CUSH&IC ',0, 'I') + call add_default ('KVH&IC ',0, 'I') + call add_default ('KVM&IC ',0, 'I') + end if + + ! determine number of constituents for which convective tendencies must be computed + if (history_budget) then + dqcond_num = pcnst + else + if (diag_cnst_conv_tend == 'none') dqcond_num = 0 + if (diag_cnst_conv_tend == 'q_only') dqcond_num = 1 + if (diag_cnst_conv_tend == 'all') dqcond_num = pcnst + end if + + do m = 1, dqcond_num + dcconnam(m) = 'DC'//cnst_name(m) + end do + + if ((diag_cnst_conv_tend == 'q_only') .or. (diag_cnst_conv_tend == 'all') .or. history_budget) then + call addfld (dcconnam(1),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(1))//' tendency due to moist processes') + if ( diag_cnst_conv_tend == 'q_only' .or. diag_cnst_conv_tend == 'all' ) then + call add_default (dcconnam(1), 1, ' ') + end if + if( history_budget ) then + call add_default (dcconnam(1), history_budget_histfile_num, ' ') + end if + if (diag_cnst_conv_tend == 'all' .or. history_budget) then + do m = 2, pcnst + call addfld (dcconnam(m),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to moist processes') + if( diag_cnst_conv_tend == 'all' ) then + call add_default (dcconnam(m), 1, ' ') + end if + if( history_budget .and. (m == ixcldliq .or. m == ixcldice) ) then + call add_default (dcconnam(m), history_budget_histfile_num, ' ') + end if + end do + end if + end if + + ! Pbuf field indices for collecting output data + qcwat_idx = pbuf_get_index('QCWAT', errcode=ierr) + tcwat_idx = pbuf_get_index('TCWAT', errcode=ierr) + lcwat_idx = pbuf_get_index('LCWAT', errcode=ierr) + cld_idx = pbuf_get_index('CLD', errcode=ierr) + concld_idx = pbuf_get_index('CONCLD', errcode=ierr) + + tke_idx = pbuf_get_index('tke', errcode=ierr) + kvm_idx = pbuf_get_index('kvm', errcode=ierr) + kvh_idx = pbuf_get_index('kvh', errcode=ierr) + cush_idx = pbuf_get_index('cush', errcode=ierr) + + pblh_idx = pbuf_get_index('pblh', errcode=ierr) + tpert_idx = pbuf_get_index('tpert', errcode=ierr) + qpert_idx = pbuf_get_index('qpert', errcode=ierr) + + prec_dp_idx = pbuf_get_index('PREC_DP', errcode=ierr) + snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=ierr) + prec_sh_idx = pbuf_get_index('PREC_SH', errcode=ierr) + snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=ierr) + prec_sed_idx = pbuf_get_index('PREC_SED', errcode=ierr) + snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=ierr) + prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=ierr) + snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=ierr) + + if (is_first_step()) then + call pbuf_set_field(pbuf2d, trefmxav_idx, -1.0e36_r8) + call pbuf_set_field(pbuf2d, trefmnav_idx, 1.0e36_r8) + end if + + end subroutine diag_init_moist + + subroutine diag_init(pbuf2d) + use cam_history, only: addfld + + ! Declare the history fields for which this module contains outfld calls. + + type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) + + ! ---------------------------- + ! determine default variables + ! ---------------------------- + call phys_getopts(history_amwg_out = history_amwg , & + history_vdiag_out = history_vdiag , & + history_eddy_out = history_eddy , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_waccm_out = history_waccm) + + call diag_init_dry(pbuf2d) + if (moist_physics) then + call diag_init_moist(pbuf2d) + end if + + end subroutine diag_init + +!=============================================================================== + + subroutine diag_allocate_dry() + use infnan, only: nan, assignment(=) + + ! Allocate memory for module variables. + ! Done at the begining of a physics step at same point as the pbuf allocate + ! for variables with "physpkg" scope. + + ! Local variables + character(len=*), parameter :: sub = 'diag_allocate_dry' + character(len=128) :: errmsg + integer :: istat + + allocate(dtcond(pcols,pver,begchunk:endchunk), stat=istat) + if ( istat /= 0 ) then + write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat + call endrun (errmsg) + end if + dtcond = nan + end subroutine diag_allocate_dry + + subroutine diag_allocate_moist() + use infnan, only: nan, assignment(=) + + ! Allocate memory for module variables. + ! Done at the begining of a physics step at same point as the pbuf allocate + ! for variables with "physpkg" scope. + + ! Local variables + character(len=*), parameter :: sub = 'diag_allocate_moist' + character(len=128) :: errmsg + integer :: i, istat + + if (dqcond_num > 0) then + allocate(dqcond(dqcond_num)) + do i = 1, dqcond_num + allocate(dqcond(i)%cnst(pcols,pver,begchunk:endchunk), stat=istat) + if ( istat /= 0 ) then + write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat + call endrun (errmsg) + end if + dqcond(i)%cnst = nan + end do + end if + + end subroutine diag_allocate_moist + + subroutine diag_allocate() + + call diag_allocate_dry() + if (moist_physics) then + call diag_allocate_moist() + end if + + end subroutine diag_allocate + +!=============================================================================== + + subroutine diag_deallocate_dry() + ! Deallocate memory for module variables. + ! Done at the end of a physics step at same point as the pbuf deallocate for + ! variables with "physpkg" scope. + + ! Local variables + character(len=*), parameter :: sub = 'diag_deallocate_dry' + integer :: istat + + deallocate(dtcond, stat=istat) + if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') + end subroutine diag_deallocate_dry + + subroutine diag_deallocate_moist() + + ! Deallocate memory for module variables. + ! Done at the end of a physics step at same point as the pbuf deallocate for + ! variables with "physpkg" scope. + + ! Local variables + character(len=*), parameter :: sub = 'diag_deallocate_moist' + integer :: i, istat + + if (dqcond_num > 0) then + do i = 1, dqcond_num + deallocate(dqcond(i)%cnst, stat=istat) + if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') + end do + deallocate(dqcond, stat=istat) + if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') + end if + end subroutine diag_deallocate_moist + + subroutine diag_deallocate() + + call diag_deallocate_dry() + if (moist_physics) then + call diag_deallocate_moist() + end if + + end subroutine diag_deallocate + +!=============================================================================== + + subroutine diag_conv_tend_ini(state,pbuf) + + ! Initialize convective tendency calcs. + + ! Arguments: + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables: + + integer :: i, k, m, lchnk, ncol + real(r8), pointer, dimension(:,:) :: t_ttend + + lchnk = state%lchnk + ncol = state%ncol + + do k = 1, pver + do i = 1, ncol + dtcond(i,k,lchnk) = state%t(i,k) + end do + end do + + do m = 1, dqcond_num + do k = 1, pver + do i = 1, ncol + dqcond(m)%cnst(i,k,lchnk) = state%q(i,k,m) + end do + end do + end do + + !! initialize to pbuf T_TTEND to temperature at first timestep + if (is_first_step()) then + do m = 1, dyn_time_lvls + call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/)) + t_ttend(:ncol,:) = state%t(:ncol,:) + end do + end if + + end subroutine diag_conv_tend_ini + +!=============================================================================== + + subroutine diag_phys_writeout_dry(state, p_surf_t, psl) + + !----------------------------------------------------------------------- + ! + ! Purpose: output dry physics diagnostics + ! + !----------------------------------------------------------------------- + use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa + use time_manager, only: get_nstep + use interpolate_data, only: vertinterp + use constituent_burden, only: constituent_burden_comp + use cam_control_mod, only: moist_physics + use co2_cycle, only: c_i, co2_transport + + use tidal_diag, only: tidal_diag_write + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(inout) :: state + real(r8), intent(out) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface + real(r8), optional , intent(out) :: psl(pcols) + ! + !---------------------------Local workspace----------------------------- + ! + real(r8) :: ftem(pcols,pver) ! temporary workspace + real(r8) :: ftem1(pcols,pver) ! another temporary workspace + real(r8) :: ftem2(pcols,pver) ! another temporary workspace + real(r8) :: psl_tmp(pcols) ! Sea Level Pressure + real(r8) :: z3(pcols,pver) ! geo-potential height + real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface + real(r8) :: tem2(pcols,pver) ! temporary workspace + real(r8) :: timestep(pcols) ! used for outfld call + real(r8) :: esl(pcols,pver) ! saturation vapor pressures + real(r8) :: esi(pcols,pver) ! + real(r8) :: dlon(pcols) ! width of grid cell (meters) + integer :: plon ! number of longitudes + + integer :: i, k, m, lchnk, ncol, nstep + ! + !----------------------------------------------------------------------- + ! + lchnk = state%lchnk + ncol = state%ncol + + ! Output NSTEP for debugging + nstep = get_nstep() + timestep(:ncol) = nstep + call outfld ('NSTEP ',timestep, pcols, lchnk) + + call outfld('T ',state%t , pcols ,lchnk ) + call outfld('PS ',state%ps, pcols ,lchnk ) + call outfld('U ',state%u , pcols ,lchnk ) + call outfld('V ',state%v , pcols ,lchnk ) + + call outfld('PHIS ',state%phis, pcols, lchnk ) + +#if (defined BFB_CAM_SCAM_IOP ) + call outfld('phis ',state%phis, pcols, lchnk ) +#endif + + do m = 1, pcnst + if (cnst_cam_outfld(m)) then + call outfld(cnst_name(m), state%q(1,1,m), pcols, lchnk) + end if + end do + + ! + ! Add height of surface to midpoint height above surface + ! + do k = 1, pver + z3(:ncol,k) = state%zm(:ncol,k) + state%phis(:ncol)*rga + end do + call outfld('Z3 ',z3,pcols,lchnk) + ! + ! Output Z3 on pressure surfaces + ! + if (hist_fld_active('Z1000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, z3, p_surf, & + extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) + call outfld('Z1000 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z700')) then + call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, z3, p_surf, & + extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) + call outfld('Z700 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z500')) then + call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, z3, p_surf, & + extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) + call outfld('Z500 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z300')) then + call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, z3, p_surf, ln_interp=.true.) + call outfld('Z300 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z200')) then + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, z3, p_surf, ln_interp=.true.) + call outfld('Z200 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z100')) then + call vertinterp(ncol, pcols, pver, state%pmid, 10000._r8, z3, p_surf, ln_interp=.true.) + call outfld('Z100 ', p_surf, pcols, lchnk) + end if + if (hist_fld_active('Z050')) then + call vertinterp(ncol, pcols, pver, state%pmid, 5000._r8, z3, p_surf, ln_interp=.true.) + call outfld('Z050 ', p_surf, pcols, lchnk) + end if + ! + ! Quadratic height fiels Z3*Z3 + ! + ftem(:ncol,:) = z3(:ncol,:)*z3(:ncol,:) + call outfld('ZZ ',ftem,pcols,lchnk) + + ftem(:ncol,:) = z3(:ncol,:)*state%v(:ncol,:) + call outfld('VZ ',ftem, pcols,lchnk) + ! + ! Meridional advection fields + ! + ftem(:ncol,:) = state%v(:ncol,:)*state%t(:ncol,:) + call outfld ('VT ',ftem ,pcols ,lchnk ) + + ftem(:ncol,:) = state%v(:ncol,:)**2 + call outfld ('VV ',ftem ,pcols ,lchnk ) + + ftem(:ncol,:) = state%v(:ncol,:) * state%u(:ncol,:) + call outfld ('VU ',ftem ,pcols ,lchnk ) + ! + ! zonal advection + ! + ftem(:ncol,:) = state%u(:ncol,:)**2 + call outfld ('UU ',ftem ,pcols ,lchnk ) + + ! Wind speed + ftem(:ncol,:) = sqrt( state%u(:ncol,:)**2 + state%v(:ncol,:)**2) + call outfld ('WSPEED ',ftem ,pcols ,lchnk ) + call outfld ('WSPDSRFMX',ftem(:,pver) ,pcols ,lchnk ) + call outfld ('WSPDSRFAV',ftem(:,pver) ,pcols ,lchnk ) + + ! Vertical velocity and advection + + if (single_column) then + call outfld('OMEGA ',wfld, pcols, lchnk ) + else + call outfld('OMEGA ',state%omega, pcols, lchnk ) + endif + +#if (defined BFB_CAM_SCAM_IOP ) + call outfld('omega ',state%omega, pcols, lchnk ) +#endif + + ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:) + call outfld('OMEGAT ',ftem, pcols, lchnk ) + ftem(:ncol,:) = state%omega(:ncol,:)*state%u(:ncol,:) + call outfld('OMEGAU ',ftem, pcols, lchnk ) + ftem(:ncol,:) = state%omega(:ncol,:)*state%v(:ncol,:) + call outfld('OMEGAV ',ftem, pcols, lchnk ) + ftem(:ncol,:) = state%omega(:ncol,:)*state%omega(:ncol,:) + call outfld('OMGAOMGA',ftem, pcols, lchnk ) + ! + ! Output omega at 850 and 500 mb pressure levels + ! + if (hist_fld_active('OMEGA850')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%omega, p_surf) + call outfld('OMEGA850', p_surf, pcols, lchnk) + end if + if (hist_fld_active('OMEGA500')) then + call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%omega, p_surf) + call outfld('OMEGA500', p_surf, pcols, lchnk) + end if + ! + ! Sea level pressure + ! + if (present(psl) .or. hist_fld_active('PSL')) then + call cpslec (ncol, state%pmid, state%phis, state%ps, state%t,psl_tmp, gravit, rair) + call outfld ('PSL ',psl_tmp ,pcols, lchnk ) + if (present(psl)) then + psl(:ncol) = psl_tmp(:ncol) + end if + end if + ! + ! Output T,u,v fields on pressure surfaces + ! + if (hist_fld_active('T850')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf, & + extrapolate='T', ps=state%ps, phis=state%phis) + call outfld('T850 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('T500')) then + call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%t, p_surf, & + extrapolate='T', ps=state%ps, phis=state%phis) + call outfld('T500 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('T400')) then + call vertinterp(ncol, pcols, pver, state%pmid, 40000._r8, state%t, p_surf, & + extrapolate='T', ps=state%ps, phis=state%phis) + call outfld('T400 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('T300')) then + call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, state%t, p_surf) + call outfld('T300 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('T200')) then + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%t, p_surf) + call outfld('T200 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('U850')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%u, p_surf) + call outfld('U850 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('U500')) then + call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%u, p_surf) + call outfld('U500 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('U250')) then + call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%u, p_surf) + call outfld('U250 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('U200')) then + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%u, p_surf) + call outfld('U200 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('U010')) then + call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%u, p_surf) + call outfld('U010 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('V850')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%v, p_surf) + call outfld('V850 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('V500')) then + call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%v, p_surf) + call outfld('V500 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('V250')) then + call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%v, p_surf) + call outfld('V250 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('V200')) then + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%v, p_surf) + call outfld('V200 ', p_surf, pcols, lchnk ) + end if + + ftem(:ncol,:) = state%t(:ncol,:)*state%t(:ncol,:) + call outfld('TT ',ftem ,pcols ,lchnk ) + ! + ! Output U, V, T, P and Z at bottom level + ! + call outfld ('UBOT ', state%u(1,pver) , pcols, lchnk) + call outfld ('VBOT ', state%v(1,pver) , pcols, lchnk) + call outfld ('ZBOT ', state%zm(1,pver) , pcols, lchnk) + + !! Boundary layer atmospheric stability, temperature, water vapor diagnostics + + p_surf_t = -99.0_r8 ! Uninitialized to impossible value + if (hist_fld_active('T1000') .or. & + hist_fld_active('T9251000') .or. & + hist_fld_active('TH9251000') .or. & + hist_fld_active('T8501000') .or. & + hist_fld_active('TH8501000') .or. & + hist_fld_active('T7001000') .or. & + hist_fld_active('TH7001000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:,surf_100000)) + end if + + if ( hist_fld_active('T925') .or. & + hist_fld_active('T9251000') .or. & + hist_fld_active('TH9251000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:,surf_092500)) + end if + +!!! at 1000 mb and 925 mb + if (hist_fld_active('T1000')) then + call outfld('T1000 ', p_surf_t(:,surf_100000), pcols, lchnk ) + end if + + if (hist_fld_active('T925')) then + call outfld('T925 ', p_surf_t(:,surf_092500), pcols, lchnk ) + end if + + if (hist_fld_active('T9251000')) then + p_surf = p_surf_t(:,surf_092500) - p_surf_t(:,surf_100000) + call outfld('T9251000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('TH9251000')) then + p_surf = (p_surf_t(:,surf_092500)*(1000.0_r8/925.0_r8)**cappa) - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa) + call outfld('TH9251000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('T8501000') .or. & + hist_fld_active('TH8501000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:,surf_085000)) + end if + +!!! at 1000 mb and 850 mb + if (hist_fld_active('T8501000')) then + p_surf = p_surf_t(:,surf_085000)-p_surf_t(:,surf_100000) + call outfld('T8501000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('TH8501000')) then + p_surf = (p_surf_t(:,surf_085000)*(1000.0_r8/850.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa) + call outfld('TH8501000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('T7001000') .or. & + hist_fld_active('TH7001000') .or. & + hist_fld_active('T700')) then + call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:,surf_070000)) + end if + +!!! at 700 mb + if (hist_fld_active('T700')) then + call outfld('T700 ', p_surf_t(:,surf_070000), pcols, lchnk ) + end if + +!!! at 1000 mb and 700 mb + if (hist_fld_active('T7001000')) then + p_surf = p_surf_t(:,surf_070000)-p_surf_t(:,surf_100000) + call outfld('T7001000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('TH7001000')) then + p_surf = (p_surf_t(:,surf_070000)*(1000.0_r8/700.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa) + call outfld('TH7001000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('T010')) then + call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%t, p_surf) + call outfld('T010 ', p_surf, pcols, lchnk ) + end if + + !--------------------------------------------------------- + ! tidal diagnostics + !--------------------------------------------------------- + call tidal_diag_write(state) + + return + end subroutine diag_phys_writeout_dry + +!=============================================================================== + + subroutine diag_phys_writeout_moist(state, p_surf_t) + + !----------------------------------------------------------------------- + ! + ! Purpose: record dynamics variables on physics grid + ! + !----------------------------------------------------------------------- + use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa + use interpolate_data, only: vertinterp + use constituent_burden, only: constituent_burden_comp + use cam_control_mod, only: moist_physics + use co2_cycle, only: c_i, co2_transport + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(inout) :: state + real(r8), intent(inout) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface + ! + !---------------------------Local workspace----------------------------- + ! + real(r8) :: ftem(pcols,pver) ! temporary workspace + real(r8) :: ftem1(pcols,pver) ! another temporary workspace + real(r8) :: ftem2(pcols,pver) ! another temporary workspace + real(r8) :: z3(pcols,pver) ! geo-potential height + real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface + real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface + real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface + real(r8) :: tem2(pcols,pver) ! temporary workspace + real(r8) :: esl(pcols,pver) ! saturation vapor pressures + real(r8) :: esi(pcols,pver) ! + real(r8) :: dlon(pcols) ! width of grid cell (meters) + integer :: plon ! number of longitudes + + integer :: i, k, m, lchnk, ncol + ! + !----------------------------------------------------------------------- + ! + lchnk = state%lchnk + ncol = state%ncol + + if (co2_transport()) then + do m = 1,4 + call outfld(trim(cnst_name(c_i(m)))//'_BOT', state%q(1,pver,c_i(m)), pcols, lchnk) + end do + end if + + ! column burdens of all constituents except water vapor + call constituent_burden_comp(state) + + call outfld('PSDRY', state%psdry, pcols, lchnk) + call outfld('PMID', state%pmid, pcols, lchnk) + call outfld('PDELDRY', state%pdeldry, pcols, lchnk) + + ! + ! Meridional advection fields + ! + ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,1) + call outfld ('VQ ',ftem ,pcols ,lchnk ) + + ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,1) + call outfld ('QQ ',ftem ,pcols ,lchnk ) + + ! Vertical velocity and advection + ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,1) + call outfld('OMEGAQ ',ftem, pcols, lchnk ) + ! + ! Mass of q, by layer and vertically integrated + ! + ftem(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga + call outfld ('MQ ',ftem ,pcols ,lchnk ) + + do k=2,pver + ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) + end do + call outfld ('TMQ ',ftem, pcols ,lchnk ) + + ! Relative humidity + if (hist_fld_active('RELHUM')) then + call qsat(state%t(:ncol,:), state%pmid(:ncol,:), & + tem2(:ncol,:), ftem(:ncol,:)) + ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 + call outfld ('RELHUM ',ftem ,pcols ,lchnk ) + end if + + if (hist_fld_active('RHW') .or. hist_fld_active('RHI') .or. hist_fld_active('RHCFMIP') ) then + + ! RH w.r.t liquid (water) + call qsat_water (state%t(:ncol,:), state%pmid(:ncol,:), & + esl(:ncol,:), ftem(:ncol,:)) + ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 + call outfld ('RHW ',ftem ,pcols ,lchnk ) + + ! Convert to RHI (ice) + do i=1,ncol + do k=1,pver + esi(i,k)=svp_ice(state%t(i,k)) + ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k) + end do + end do + call outfld ('RHI ',ftem1 ,pcols ,lchnk ) + + ! use temperature to decide if you populate with ftem (liquid, above 0 C) or ftem1 (ice, below 0 C) + + ftem2(:ncol,:)=ftem(:ncol,:) + + do i=1,ncol + do k=1,pver + if (state%t(i,k) .gt. 273) then + ftem2(i,k)=ftem(i,k) !!wrt water + else + ftem2(i,k)=ftem1(i,k) !!wrt ice + end if + end do + end do + + call outfld ('RHCFMIP ',ftem2 ,pcols ,lchnk ) + + end if + ! + ! Output q field on pressure surfaces + ! + if (hist_fld_active('Q850')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf) + call outfld('Q850 ', p_surf, pcols, lchnk ) + end if + if (hist_fld_active('Q200')) then + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,1), p_surf) + call outfld('Q200 ', p_surf, pcols, lchnk ) + end if + ! + ! Output Q at bottom level + ! + call outfld ('QBOT ', state%q(1,pver,1), pcols, lchnk) + + ! Total energy of the atmospheric column for atmospheric heat storage calculations + + !! temporary variable to get surface geopotential in dimensions of (ncol,pver) + do k=1,pver + ftem1(:ncol,k)=state%phis(:ncol) !! surface geopotential in units (m2/s2) + end do + + !! calculate sum of sensible, kinetic, latent, and surface geopotential energy + !! E=CpT+PHIS+Lv*q+(0.5)*(u^2+v^2) + ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,1) + & + 0.5_r8*(state%u(:ncol,:)**2+state%v(:ncol,:)**2))*(state%pdel(:ncol,:)/gravit) + !! vertically integrate + do k=2,pver + ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) + end do + call outfld ('ATMEINT ',ftem(:ncol,1) ,pcols ,lchnk ) + + !! Boundary layer atmospheric stability, temperature, water vapor diagnostics + + if ( hist_fld_active('THE9251000') .or. & + hist_fld_active('THE8501000') .or. & + hist_fld_active('THE7001000')) then + if (p_surf_t(1, surf_100000) < 0.0_r8) then + call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:, surf_100000)) + end if + end if + + if ( hist_fld_active('TH9251000') .or. & + hist_fld_active('THE9251000')) then + if (p_surf_t(1, surf_092500) < 0.0_r8) then + call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:, surf_092500)) + end if + end if + + if ( hist_fld_active('Q1000') .or. & + hist_fld_active('THE9251000') .or. & + hist_fld_active('THE8501000') .or. & + hist_fld_active('THE7001000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,1), p_surf_q1) + end if + + if (hist_fld_active('THE9251000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,1), p_surf_q2) + end if + +!!! at 1000 mb and 925 mb + if (hist_fld_active('Q1000')) then + call outfld('Q1000 ', p_surf_q1, pcols, lchnk ) + end if + + if (hist_fld_active('Q925')) then + call outfld('Q925 ', p_surf_q2, pcols, lchnk ) + end if + + if (hist_fld_active('THE9251000')) then + p_surf = ((p_surf_t(:, surf_092500)*(1000.0_r8/925.0_r8)**cappa) * & + exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_092500)))) - & + (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) + call outfld('THE9251000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('THE8501000')) then + if (p_surf_t(1, surf_085000) < 0.0_r8) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:, surf_085000)) + end if + end if + +!!! at 1000 mb and 850 mb + if (hist_fld_active('THE8501000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf_q2) + p_surf = ((p_surf_t(:, surf_085000)*(1000.0_r8/850.0_r8)**cappa) * & + exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_085000)))) - & + (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) + call outfld('THE8501000 ', p_surf, pcols, lchnk ) + end if + + if (hist_fld_active('THE7001000')) then + if (p_surf_t(1, surf_070000) < 0.0_r8) then + call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:, surf_070000)) + end if + end if + +!!! at 1000 mb and 700 mb + if (hist_fld_active('THE7001000')) then + call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,1), p_surf_q2) + p_surf = ((p_surf_t(:, surf_070000)*(1000.0_r8/700.0_r8)**cappa) * & + exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_070000)))) - & + (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) + call outfld('THE7001000 ', p_surf, pcols, lchnk ) + end if + + return + end subroutine diag_phys_writeout_moist + +!=============================================================================== + + subroutine diag_phys_writeout(state, psl) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(inout) :: state + real(r8), optional , intent(out) :: psl(pcols) + + ! + ! Local variable + ! + real(r8) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface + + call diag_phys_writeout_dry(state, p_surf_t, psl) + if (moist_physics) then + call diag_phys_writeout_moist(state, p_surf_t) + end if + end subroutine diag_phys_writeout + +!=============================================================================== + + subroutine diag_conv(state, ztodt, pbuf) + + !----------------------------------------------------------------------- + ! + ! Output diagnostics associated with all convective processes. + ! + !----------------------------------------------------------------------- + use physconst, only: cpair + use tidal_diag, only: get_tidal_coeffs + + ! Arguments: + + real(r8), intent(in) :: ztodt ! timestep for computing physics tendencies + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + ! convective precipitation variables + real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection + real(r8), pointer :: snow_dp(:) ! snow from ZM convection + real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection + real(r8), pointer :: snow_sh(:) ! snow from Hack convection + real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection + real(r8), pointer :: snow_sed(:) ! snow from ZM convection + real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection + real(r8), pointer :: snow_pcw(:) ! snow from Hack convection + + ! Local variables: + + integer :: i, k, m, lchnk, ncol + + real(r8) :: rtdt + + real(r8):: precc(pcols) ! convective precip rate + real(r8):: precl(pcols) ! stratiform precip rate + real(r8):: snowc(pcols) ! convective snow rate + real(r8):: snowl(pcols) ! stratiform snow rate + real(r8):: prect(pcols) ! total (conv+large scale) precip rate + real(r8) :: dcoef(6) ! for tidal component of T tend + + lchnk = state%lchnk + ncol = state%ncol + + rtdt = 1._r8/ztodt + + if (moist_physics) then + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp) + else + nullify(prec_dp) + end if + if (snow_dp_idx > 0) then + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp) + else + nullify(snow_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh) + else + nullify(prec_sh) + end if + if (snow_sh_idx > 0) then + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh) + else + nullify(snow_sh) + end if + if (prec_sed_idx > 0) then + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed) + else + nullify(prec_sed) + end if + if (snow_sed_idx > 0) then + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed) + else + nullify(snow_sed) + end if + if (prec_pcw_idx > 0) then + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw) + else + nullify(prec_pcw) + end if + if (snow_pcw_idx > 0) then + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw) + else + nullify(snow_pcw) + end if + + ! Precipitation rates (multi-process) + if (associated(prec_dp) .and. associated(prec_sh)) then + precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) + else if (associated(prec_dp)) then + precc(:ncol) = prec_dp(:ncol) + else if (associated(prec_sh)) then + precc(:ncol) = prec_sh(:ncol) + else + precc(:ncol) = 0._r8 + end if + if (associated(prec_sed) .and. associated(prec_pcw)) then + precl(:ncol) = prec_sed(:ncol) + prec_pcw(:ncol) + else if (associated(prec_sed)) then + precl(:ncol) = prec_sed(:ncol) + else if (associated(prec_pcw)) then + precl(:ncol) = prec_pcw(:ncol) + else + precl(:ncol) = 0._r8 + end if + if (associated(snow_dp) .and. associated(snow_sh)) then + snowc(:ncol) = snow_dp(:ncol) + snow_sh(:ncol) + else if (associated(snow_dp)) then + snowc(:ncol) = snow_dp(:ncol) + else if (associated(snow_sh)) then + snowc(:ncol) = snow_sh(:ncol) + else + snowc(:ncol) = 0._r8 + end if + if (associated(snow_sed) .and. associated(snow_pcw)) then + snowl(:ncol) = snow_sed(:ncol) + snow_pcw(:ncol) + else if (associated(snow_sed)) then + snowl(:ncol) = snow_sed(:ncol) + else if (associated(snow_pcw)) then + snowl(:ncol) = snow_pcw(:ncol) + else + snowl(:ncol) = 0._r8 + end if + prect(:ncol) = precc(:ncol) + precl(:ncol) + + call outfld('PRECC ', precc, pcols, lchnk ) + call outfld('PRECL ', precl, pcols, lchnk ) + if (associated(prec_pcw)) then + call outfld('PREC_PCW', prec_pcw,pcols ,lchnk ) + end if + if (associated(prec_dp)) then + call outfld('PREC_zmc', prec_dp ,pcols ,lchnk ) + end if + call outfld('PRECSC ', snowc, pcols, lchnk ) + call outfld('PRECSL ', snowl, pcols, lchnk ) + call outfld('PRECT ', prect, pcols, lchnk ) + call outfld('PRECTMX ', prect, pcols, lchnk ) + + call outfld('PRECLav ', precl, pcols, lchnk ) + call outfld('PRECCav ', precc, pcols, lchnk ) + +#if ( defined BFB_CAM_SCAM_IOP ) + call outfld('Prec ' , prect, pcols, lchnk ) +#endif + + ! Total convection tendencies. + + do k = 1, pver + do i = 1, ncol + dtcond(i,k,lchnk) = (state%t(i,k) - dtcond(i,k,lchnk))*rtdt + end do + end do + call outfld('DTCOND ', dtcond(:,:,lchnk), pcols, lchnk) + + ! output tidal coefficients + call get_tidal_coeffs( dcoef ) + call outfld( 'DTCOND_24_SIN', dtcond(:ncol,:,lchnk)*dcoef(1), ncol, lchnk ) + call outfld( 'DTCOND_24_COS', dtcond(:ncol,:,lchnk)*dcoef(2), ncol, lchnk ) + call outfld( 'DTCOND_12_SIN', dtcond(:ncol,:,lchnk)*dcoef(3), ncol, lchnk ) + call outfld( 'DTCOND_12_COS', dtcond(:ncol,:,lchnk)*dcoef(4), ncol, lchnk ) + call outfld( 'DTCOND_08_SIN', dtcond(:ncol,:,lchnk)*dcoef(5), ncol, lchnk ) + call outfld( 'DTCOND_08_COS', dtcond(:ncol,:,lchnk)*dcoef(6), ncol, lchnk ) + + do m = 1, dqcond_num + if ( cnst_cam_outfld(m) ) then + do k = 1, pver + do i = 1, ncol + dqcond(m)%cnst(i,k,lchnk) = (state%q(i,k,m) - dqcond(m)%cnst(i,k,lchnk))*rtdt + end do + end do + call outfld(dcconnam(m), dqcond(m)%cnst(:,:,lchnk), pcols, lchnk) + end if + end do + + end if + end subroutine diag_conv + +!=============================================================================== + + subroutine diag_surf (cam_in, cam_out, state, pbuf) + + !----------------------------------------------------------------------- + ! + ! Purpose: record surface diagnostics + ! + !----------------------------------------------------------------------- + + use time_manager, only: is_end_curr_day + use co2_cycle, only: c_i, co2_transport + use constituents, only: sflxnam + + !----------------------------------------------------------------------- + ! + ! Input arguments + ! + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i, k, m ! indexes + integer :: lchnk ! chunk identifier + integer :: ncol ! longitude dimension + real(r8) tem2(pcols) ! temporary workspace + real(r8) ftem(pcols) ! temporary workspace + + real(r8), pointer :: trefmnav(:) ! daily minimum tref + real(r8), pointer :: trefmxav(:) ! daily maximum tref + + ! + !----------------------------------------------------------------------- + ! + lchnk = cam_in%lchnk + ncol = cam_in%ncol + + if (moist_physics) then + call outfld('SHFLX', cam_in%shf, pcols, lchnk) + call outfld('LHFLX', cam_in%lhf, pcols, lchnk) + call outfld('QFLX', cam_in%cflx(1,1), pcols, lchnk) + + call outfld('TAUX', cam_in%wsx, pcols, lchnk) + call outfld('TAUY', cam_in%wsy, pcols, lchnk) + call outfld('TREFHT ', cam_in%tref, pcols, lchnk) + call outfld('TREFHTMX', cam_in%tref, pcols, lchnk) + call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) + call outfld('QREFHT', cam_in%qref, pcols, lchnk) + call outfld('U10', cam_in%u10, pcols, lchnk) + ! + ! Calculate and output reference height RH (RHREFHT) + + call qsat(cam_in%tref(:ncol), state%ps(:ncol), tem2(:ncol), ftem(:ncol)) + ftem(:ncol) = cam_in%qref(:ncol)/ftem(:ncol)*100._r8 + + + call outfld('RHREFHT', ftem, pcols, lchnk) + + +#if (defined BFB_CAM_SCAM_IOP ) + call outfld('shflx ',cam_in%shf, pcols, lchnk) + call outfld('lhflx ',cam_in%lhf, pcols, lchnk) + call outfld('trefht ',cam_in%tref, pcols, lchnk) +#endif + ! + ! Ouput ocn and ice fractions + ! + call outfld('LANDFRAC', cam_in%landfrac, pcols, lchnk) + call outfld('ICEFRAC', cam_in%icefrac, pcols, lchnk) + call outfld('OCNFRAC', cam_in%ocnfrac, pcols, lchnk) + ! + ! Compute daily minimum and maximum of TREF + ! + call pbuf_get_field(pbuf, trefmxav_idx, trefmxav) + call pbuf_get_field(pbuf, trefmnav_idx, trefmnav) + do i = 1,ncol + trefmxav(i) = max(cam_in%tref(i),trefmxav(i)) + trefmnav(i) = min(cam_in%tref(i),trefmnav(i)) + end do + if (is_end_curr_day()) then + call outfld('TREFMXAV', trefmxav,pcols, lchnk ) + call outfld('TREFMNAV', trefmnav,pcols, lchnk ) + trefmxav(:ncol) = -1.0e36_r8 + trefmnav(:ncol) = 1.0e36_r8 + endif + + call outfld('TBOT', cam_out%tbot, pcols, lchnk) + call outfld('TS', cam_in%ts, pcols, lchnk) + call outfld('TSMN', cam_in%ts, pcols, lchnk) + call outfld('TSMX', cam_in%ts, pcols, lchnk) + call outfld('SNOWHLND', cam_in%snowhland, pcols, lchnk) + call outfld('SNOWHICE', cam_in%snowhice, pcols, lchnk) + call outfld('ASDIR', cam_in%asdir, pcols, lchnk) + call outfld('ASDIF', cam_in%asdif, pcols, lchnk) + call outfld('ALDIR', cam_in%aldir, pcols, lchnk) + call outfld('ALDIF', cam_in%aldif, pcols, lchnk) + call outfld('SST', cam_in%sst, pcols, lchnk) + + if (co2_transport()) then + do m = 1,4 + call outfld(sflxnam(c_i(m)), cam_in%cflx(:,c_i(m)), pcols, lchnk) + end do + end if + end if + + end subroutine diag_surf + +!=============================================================================== + + subroutine diag_export(cam_out) + + !----------------------------------------------------------------------- + ! + ! Purpose: Write export state to history file + ! + !----------------------------------------------------------------------- + + ! arguments + type(cam_out_t), intent(inout) :: cam_out + + ! Local variables: + integer :: lchnk ! chunk identifier + logical :: atm_dep_flux ! true ==> sending deposition fluxes to coupler. + ! Otherwise, set them to zero. + !----------------------------------------------------------------------- + + lchnk = cam_out%lchnk + + call phys_getopts(atm_dep_flux_out=atm_dep_flux) + + if (.not. atm_dep_flux) then + ! set the fluxes to zero before outfld and sending them to the + ! coupler + cam_out%bcphiwet = 0.0_r8 + cam_out%bcphidry = 0.0_r8 + cam_out%bcphodry = 0.0_r8 + cam_out%ocphiwet = 0.0_r8 + cam_out%ocphidry = 0.0_r8 + cam_out%ocphodry = 0.0_r8 + cam_out%dstwet1 = 0.0_r8 + cam_out%dstdry1 = 0.0_r8 + cam_out%dstwet2 = 0.0_r8 + cam_out%dstdry2 = 0.0_r8 + cam_out%dstwet3 = 0.0_r8 + cam_out%dstdry3 = 0.0_r8 + cam_out%dstwet4 = 0.0_r8 + cam_out%dstdry4 = 0.0_r8 + end if + + if (moist_physics) then + call outfld('a2x_BCPHIWET', cam_out%bcphiwet, pcols, lchnk) + call outfld('a2x_BCPHIDRY', cam_out%bcphidry, pcols, lchnk) + call outfld('a2x_BCPHODRY', cam_out%bcphodry, pcols, lchnk) + call outfld('a2x_OCPHIWET', cam_out%ocphiwet, pcols, lchnk) + call outfld('a2x_OCPHIDRY', cam_out%ocphidry, pcols, lchnk) + call outfld('a2x_OCPHODRY', cam_out%ocphodry, pcols, lchnk) + call outfld('a2x_DSTWET1', cam_out%dstwet1, pcols, lchnk) + call outfld('a2x_DSTDRY1', cam_out%dstdry1, pcols, lchnk) + call outfld('a2x_DSTWET2', cam_out%dstwet2, pcols, lchnk) + call outfld('a2x_DSTDRY2', cam_out%dstdry2, pcols, lchnk) + call outfld('a2x_DSTWET3', cam_out%dstwet3, pcols, lchnk) + call outfld('a2x_DSTDRY3', cam_out%dstdry3, pcols, lchnk) + call outfld('a2x_DSTWET4', cam_out%dstwet4, pcols, lchnk) + call outfld('a2x_DSTDRY4', cam_out%dstdry4, pcols, lchnk) + end if + + end subroutine diag_export + +!####################################################################### + + subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in) + ! + !--------------------------------------------- + ! + ! Purpose: record physics variables on IC file + ! + !--------------------------------------------- + ! + + ! + ! Arguments + ! + integer , intent(in) :: lchnk ! chunk identifier + type(physics_buffer_desc), pointer :: pbuf(:) + + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(inout) :: cam_in + ! + !---------------------------Local workspace----------------------------- + ! + integer :: k ! indices + integer :: itim_old ! indices + + real(r8), pointer, dimension(:,:) :: cwat_var + real(r8), pointer, dimension(:,:) :: conv_var_3d + real(r8), pointer, dimension(: ) :: conv_var_2d + real(r8), pointer :: tpert(:), pblh(:), qpert(:) + ! + !----------------------------------------------------------------------- + ! + if( write_inithist() .and. moist_physics ) then + + ! + ! Associate pointers with physics buffer fields + ! + itim_old = pbuf_old_tim_idx() + + if (qcwat_idx > 0) then + call pbuf_get_field(pbuf, qcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld('QCWAT&IC ',cwat_var, pcols,lchnk) + end if + + if (tcwat_idx > 0) then + call pbuf_get_field(pbuf, tcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld('TCWAT&IC ',cwat_var, pcols,lchnk) + end if + + if (lcwat_idx > 0) then + call pbuf_get_field(pbuf, lcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld('LCWAT&IC ',cwat_var, pcols,lchnk) + end if + + if (cld_idx > 0) then + call pbuf_get_field(pbuf, cld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld('CLOUD&IC ',cwat_var, pcols,lchnk) + end if + + if (concld_idx > 0) then + call pbuf_get_field(pbuf, concld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld('CONCLD&IC ',cwat_var, pcols,lchnk) + end if + + if (cush_idx > 0) then + call pbuf_get_field(pbuf, cush_idx, conv_var_2d ,(/1,itim_old/), (/pcols,1/)) + call outfld('CUSH&IC ',conv_var_2d, pcols,lchnk) + + end if + + if (tke_idx > 0) then + call pbuf_get_field(pbuf, tke_idx, conv_var_3d) + call outfld('TKE&IC ',conv_var_3d, pcols,lchnk) + end if + + if (kvm_idx > 0) then + call pbuf_get_field(pbuf, kvm_idx, conv_var_3d) + call outfld('KVM&IC ',conv_var_3d, pcols,lchnk) + end if + + if (kvh_idx > 0) then + call pbuf_get_field(pbuf, kvh_idx, conv_var_3d) + call outfld('KVH&IC ',conv_var_3d, pcols,lchnk) + end if + + if (qpert_idx > 0) then + call pbuf_get_field(pbuf, qpert_idx, qpert) + call outfld('QPERT&IC ', qpert, pcols, lchnk) + end if + + if (pblh_idx > 0) then + call pbuf_get_field(pbuf, pblh_idx, pblh) + call outfld('PBLH&IC ', pblh, pcols, lchnk) + end if + + if (tpert_idx > 0) then + call pbuf_get_field(pbuf, tpert_idx, tpert) + call outfld('TPERT&IC ', tpert, pcols, lchnk) + end if + + end if + + end subroutine diag_physvar_ic + + +!####################################################################### + + subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) + + !--------------------------------------------------------------- + ! + ! Purpose: Dump physics tendencies for temperature + ! + !--------------------------------------------------------------- + + use check_energy, only: check_energy_get_integrals + use physconst, only: cpair + + ! Arguments + + type(physics_state), intent(in) :: state + + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_tend ), intent(in) :: tend + real(r8), intent(in) :: ztodt ! physics timestep + + !---------------------------Local workspace----------------------------- + + integer :: lchnk ! chunk index + integer :: ncol ! number of columns in chunk + real(r8) :: ftem2(pcols) ! Temporary workspace for outfld variables + real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables + real(r8) :: heat_glob ! global energy integral (FV only) + ! CAM pointers to get variables from the physics buffer + real(r8), pointer, dimension(:,:) :: t_ttend + integer :: itim_old,m + + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! Dump out post-physics state (FV only) + + call outfld('TAP', state%t, pcols, lchnk ) + call outfld('UAP', state%u, pcols, lchnk ) + call outfld('VAP', state%v, pcols, lchnk ) + + ! Total physics tendency for Temperature + ! (remove global fixer tendency from total for FV and SE dycores) + + if (dycore_is('LR') .or. dycore_is('SE')) then + call check_energy_get_integrals( heat_glob_out=heat_glob ) + ftem2(:ncol) = heat_glob/cpair + call outfld('TFIX', ftem2, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair + else + ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) + end if + call outfld('PTTEND',ftem3, pcols, lchnk ) + + ! Total (physics+dynamics, everything!) tendency for Temperature + + !! get temperature stored in physics buffer + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + !! calculate and outfld the total temperature tendency + ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt + call outfld('TTEND_TOT', ftem3, pcols, lchnk) + + !! update physics buffer with this time-step's temperature + t_ttend(:ncol,:) = state%t(:ncol,:) + + end subroutine diag_phys_tend_writeout_dry + +!####################################################################### + + subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + + !--------------------------------------------------------------- + ! + ! Purpose: Dump physics tendencies for moisture + ! + !--------------------------------------------------------------- + + ! Arguments + + type(physics_state), intent(in) :: state + + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_tend ), intent(in) :: tend + real(r8), intent(in) :: ztodt ! physics timestep + real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics + real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics + real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics + + !---------------------------Local workspace----------------------------- + + integer :: lchnk ! chunk index + integer :: ncol ! number of columns in chunk + real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables + real(r8) :: rtdt + integer :: ixcldice, ixcldliq! constituent indices for cloud liquid and ice water. + + lchnk = state%lchnk + ncol = state%ncol + rtdt = 1._r8/ztodt + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + + if ( cnst_cam_outfld( 1) ) then + call outfld (apcnst( 1), state%q(1,1, 1), pcols, lchnk) + end if + if (ixcldliq > 0) then + if (cnst_cam_outfld(ixcldliq)) then + call outfld (apcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk) + end if + end if + if (ixcldice > 0) then + if ( cnst_cam_outfld(ixcldice) ) then + call outfld (apcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk) + end if + end if + + ! Tendency for dry mass adjustment of q (FV only) + + if (dycore_is('LR')) then + tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt + if (ixcldliq > 0) then + tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt + else + tmp_cldliq(:ncol,:pver) = 0.0_r8 + end if + if (ixcldice > 0) then + tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt + else + tmp_cldice(:ncol,:pver) = 0.0_r8 + end if + if ( cnst_cam_outfld( 1) ) then + call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) + end if + if (ixcldliq > 0) then + if ( cnst_cam_outfld(ixcldliq) ) then + call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) + end if + end if + if (ixcldice > 0) then + if ( cnst_cam_outfld(ixcldice) ) then + call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) + end if + end if + end if + + ! Total physics tendency for moisture and other tracers + + if ( cnst_cam_outfld( 1) ) then + ftem3(:ncol,:pver) = (state%q(:ncol,:pver, 1) - qini (:ncol,:pver) )*rtdt + call outfld (ptendnam( 1), ftem3, pcols, lchnk) + end if + if (ixcldliq > 0) then + if (cnst_cam_outfld(ixcldliq) ) then + ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - cldliqini(:ncol,:pver) )*rtdt + call outfld (ptendnam(ixcldliq), ftem3, pcols, lchnk) + end if + end if + if (ixcldice > 0) then + if ( cnst_cam_outfld(ixcldice) ) then + ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - cldiceini(:ncol,:pver) )*rtdt + call outfld (ptendnam(ixcldice), ftem3, pcols, lchnk) + end if + end if + + end subroutine diag_phys_tend_writeout_moist + +!####################################################################### + + subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + + !--------------------------------------------------------------- + ! + ! Purpose: Dump physics tendencies for moisture and temperature + ! + !--------------------------------------------------------------- + + ! Arguments + + type(physics_state), intent(in) :: state + + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_tend ), intent(in) :: tend + real(r8), intent(in) :: ztodt ! physics timestep + real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics + real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics + real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics + + !----------------------------------------------------------------------- + + call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) + if (moist_physics) then + call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + end if + + end subroutine diag_phys_tend_writeout + +!####################################################################### + + subroutine diag_state_b4_phys_write_dry (state) + ! + !--------------------------------------------------------------- + ! + ! Purpose: Dump dry state just prior to executing physics + ! + !--------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(in) :: state + ! + !---------------------------Local workspace----------------------------- + ! + integer :: lchnk ! chunk index + ! + !----------------------------------------------------------------------- + ! + lchnk = state%lchnk + + call outfld('TBP', state%t, pcols, lchnk ) + + end subroutine diag_state_b4_phys_write_dry + + subroutine diag_state_b4_phys_write_moist (state) + ! + !--------------------------------------------------------------- + ! + ! Purpose: Dump moist state just prior to executing physics + ! + !--------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(in) :: state + ! + !---------------------------Local workspace----------------------------- + ! + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + integer :: lchnk ! chunk index + ! + !----------------------------------------------------------------------- + ! + lchnk = state%lchnk + + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + + if ( cnst_cam_outfld( 1) ) then + call outfld (bpcnst( 1), state%q(1,1, 1), pcols, lchnk) + end if + if (ixcldliq > 0) then + if (cnst_cam_outfld(ixcldliq)) then + call outfld (bpcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk) + end if + end if + if (ixcldice > 0) then + if (cnst_cam_outfld(ixcldice)) then + call outfld (bpcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk) + end if + end if + + end subroutine diag_state_b4_phys_write_moist + + subroutine diag_state_b4_phys_write (state) + ! + !--------------------------------------------------------------- + ! + ! Purpose: Dump state just prior to executing physics + ! + !--------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(in) :: state + ! + + call diag_state_b4_phys_write_dry(state) + if (moist_physics) then + call diag_state_b4_phys_write_moist(state) + end if + end subroutine diag_state_b4_phys_write + +end module cam_diagnostics diff --git a/src/physics/cam/carma_flags_mod.F90 b/src/physics/cam/carma_flags_mod.F90 new file mode 100644 index 0000000000..59fee48bf3 --- /dev/null +++ b/src/physics/cam/carma_flags_mod.F90 @@ -0,0 +1,191 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control CARMA's behavior. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Aug-2010 +module carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_readnl ! read the carma namelist + + + ! Namelist flags + ! + ! NOTE: Setting the carma_flag to false prevents CARMA from doing any microphysics + ! calculations, but it will still initialize itself. This allows the same build and + ! namelist to be used, but the CARMA processing diabled. Use the configure option + ! -carma none to totally disable CARMA and prevent even the register from happening. + logical, public :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM + logical, public :: carma_do_aerosol = .true. ! If .true. then CARMA is processed after surface coupling + logical, public :: carma_do_cldice = .false. ! If .true. then do cloud ice + logical, public :: carma_do_cldliq = .false. ! If .true. then do cloud liquid + logical, public :: carma_do_clearsky = .false. ! If .true. then do clear sky particle calculations + logical, public :: carma_do_coag = .false. ! If .true. then do coagulation + logical, public :: carma_do_detrain = .false. ! If .true. then do detrain + logical, public :: carma_do_drydep = .false. ! If .true. then do dry deposition + logical, public :: carma_do_emission = .false. ! If .true. then do emission + logical, public :: carma_do_fixedinit= .false. ! If .true. then do fixed initialization to a reference state + logical, public :: carma_hetchem_feedback= .false.! If .true. then CARMA sulfate surface area density used in heterogeneous chemistry + logical, public :: carma_rad_feedback= .false. ! If .true. then CARMA sulfate mass mixing ratio & effective radius used in radiation + logical, public :: carma_do_explised = .false. ! If .true. then do sedimentation with substepping + logical, public :: carma_do_incloud = .false. ! If .true. then do incloud particle calculations + logical, public :: carma_do_grow = .false. ! If .true. then do growth + logical, public :: carma_do_optics = .false. ! If .true. then do optical properties file + logical, public :: carma_do_partialinit= .false. ! If .true. then do initialization of coagulation to a reference state (requires fixedinit) + logical, public :: carma_do_pheat = .false. ! If .true. then do particle heating + logical, public :: carma_do_pheatatm = .false. ! If .true. then do particle heating of atmosphere + logical, public :: carma_do_substep = .false. ! If .true. then do substeping + logical, public :: carma_do_thermo = .false. ! If .true. then do solve thermodynamics equation + logical, public :: carma_do_wetdep = .false. ! If .true. then do wet deposition + logical, public :: carma_do_vdiff = .false. ! If .true. then do vertical brownian diffusion + logical, public :: carma_do_vtran = .false. ! If .true. then do vertical transport + integer, public :: carma_maxsubsteps = 1 ! Maximum number of time substeps allowed + integer, public :: carma_minsubsteps = 1 ! Minimum number of time substeps allowed + integer, public :: carma_maxretries = 8 ! Maximum number of time substeps allowed + real(r8), public :: carma_conmax = 0.1_r8 ! Minumum relative concentration to consider in substep + real(r8), public :: carma_dgc_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas concentration allowed per substep. + real(r8), public :: carma_ds_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas saturation allowed per substep. + real(r8), public :: carma_dt_threshold = 0.0_r8 ! When non-zero, the largest change in temperature (K) allowed per substep. + real(r8), public :: carma_tstick = 1.0_r8 ! Thermal accommodation coefficient + real(r8), public :: carma_gsticki = 0.93_r8 ! Growth accommodation coefficient for ice + real(r8), public :: carma_gstickl = 1.0_r8 ! Growth accommodation coefficient for liquid + real(r8), public :: carma_cstick = 1.0_r8 ! Coagulation accommodation coefficient + real(r8), public :: carma_rhcrit = 1.0_r8 ! Critical relative humidity for liquid clouds + real(r8), public :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] + character(len=256), public :: carma_reftfile = 'carma_reft.nc' ! path to the file containing the reference temperature profile + character(len=32), public :: carma_model = "none" ! String (no spaces) that identifies the model + +contains + + + !! Read the CARMA runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Aug-2010 + subroutine carma_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + use carma_model_flags_mod, only: carma_model_readnl + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_nl/ & + carma_flag, & + carma_do_aerosol, & + carma_do_cldliq, & + carma_do_cldice, & + carma_do_clearsky, & + carma_do_coag, & + carma_do_detrain, & + carma_do_drydep, & + carma_do_emission, & + carma_do_fixedinit, & + carma_hetchem_feedback, & + carma_rad_feedback, & + carma_do_explised, & + carma_do_incloud, & + carma_do_grow, & + carma_do_optics, & + carma_do_partialinit, & + carma_do_pheat, & + carma_do_pheatatm, & + carma_do_substep, & + carma_do_thermo, & + carma_do_wetdep, & + carma_do_vdiff, & + carma_do_vtran, & + carma_maxsubsteps, & + carma_minsubsteps, & + carma_maxretries, & + carma_model, & + carma_reftfile, & + carma_conmax, & + carma_dgc_threshold, & + carma_ds_threshold, & + carma_dt_threshold, & + carma_tstick, & + carma_gsticki, & + carma_gstickl, & + carma_cstick, & + carma_rhcrit, & + carma_vf_const + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast (carma_flag, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_aerosol, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_cldliq, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_cldice, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_clearsky, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_coag, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_detrain, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_drydep, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_emission, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_fixedinit, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_hetchem_feedback,1 ,mpilog, 0,mpicom) + call mpibcast (carma_rad_feedback, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_explised, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_incloud, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_grow, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_optics, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_partialinit, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_pheat, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_pheatatm, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_substep, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_thermo, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_wetdep, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_vdiff, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_do_vtran, 1 ,mpilog, 0,mpicom) + call mpibcast (carma_maxsubsteps, 1 ,mpiint, 0,mpicom) + call mpibcast (carma_minsubsteps, 1 ,mpiint, 0,mpicom) + call mpibcast (carma_maxretries, 1 ,mpiint, 0,mpicom) + call mpibcast (carma_conmax, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_dgc_threshold, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_ds_threshold, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_dt_threshold, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_tstick, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_gsticki, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_gstickl, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_cstick, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_rhcrit, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_vf_const, 1 ,mpir8, 0,mpicom) + call mpibcast (carma_model, len(carma_model), mpichar, 0, mpicom) + call mpibcast (carma_reftfile, len(carma_reftfile), mpichar, 0, mpicom) +#endif + + ! Also cause the CARMA model flags to be read in. + call carma_model_readnl(nlfile) + + end subroutine carma_readnl + +end module carma_flags_mod diff --git a/src/physics/cam/carma_intr.F90 b/src/physics/cam/carma_intr.F90 new file mode 100644 index 0000000000..fc09de5246 --- /dev/null +++ b/src/physics/cam/carma_intr.F90 @@ -0,0 +1,186 @@ +!! This module is stub for a coupler between the CAM model and the Community Aerosol +!! and Radiation Model for Atmospheres (CARMA) microphysics model. It is used when +!! CARMA is not being used, so that the CAM code that calls CARMA does not need to +!! be changed. The real version of this routine exists in the directory +!! physics/carma/cam. A CARMA model can be activated by using configure with the +!! option: +!! +!! -carma +!! +!! where carma_pkg is the name for a particular microphysical model. +!! +!! @author Chuck Bardeen +!! @version May 2009 +module carma_intr + + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use constituents, only: pcnst + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc + + + implicit none + + private + save + + ! Public interfaces + + ! CAM Physics Interface + public carma_register ! register consituents + public carma_is_active ! retrns true if this package is active (microphysics = .true.) + public carma_implements_cnst ! returns true if consituent is implemented by this package + public carma_init_cnst ! initialize constituent mixing ratios, if not read from initial file + public carma_init ! initialize timestep independent variables + public carma_final ! finalize the CARMA module + public carma_timestep_init ! initialize timestep dependent variables + public carma_timestep_tend ! interface to tendency computation + public carma_accumulate_stats ! collect stats from all MPI tasks + + ! Other Microphysics + public carma_emission_tend ! calculate tendency from emission source function + public carma_wetdep_tend ! calculate tendency from wet deposition + +contains + + + subroutine carma_register + implicit none + + return + end subroutine carma_register + + + function carma_is_active() + implicit none + + logical :: carma_is_active + + carma_is_active = .false. + + return + end function carma_is_active + + + function carma_implements_cnst(name) + implicit none + + character(len=*), intent(in) :: name !! constituent name + logical :: carma_implements_cnst ! return value + + carma_implements_cnst = .false. + + return + end function carma_implements_cnst + + + subroutine carma_init + implicit none + + return + end subroutine carma_init + + + subroutine carma_final + implicit none + + return + end subroutine carma_final + + + subroutine carma_timestep_init + implicit none + + return + end subroutine carma_timestep_init + + + subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rliq, prec_str, snow_str, & + prec_sed, snow_sed, ustar, obklen) + use hycoef, only: hyai, hybi, hyam, hybm + use time_manager, only: get_nstep, get_step_size, is_first_step + use camsrfexch, only: cam_in_t, cam_out_t + use scamMod, only: single_column + + implicit none + + type(physics_state), intent(inout) :: state !! physics state variables + type(cam_in_t), intent(in) :: cam_in !! surface inputs + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_ptend), intent(out) :: ptend !! constituent tendencies + real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(in), optional :: ustar(pcols) !! friction velocity (m/s) + real(r8), intent(in), optional :: obklen(pcols) !! Obukhov length [ m ] + + call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update + + if (present(prec_str)) prec_str(:) = 0._r8 + if (present(snow_str)) snow_str(:) = 0._r8 + if (present(prec_sed)) prec_sed(:) = 0._r8 + if (present(snow_sed)) snow_sed(:) = 0._r8 + + return + end subroutine carma_timestep_tend + + + subroutine carma_init_cnst(name, latvals, lonvals, mask, q) + implicit none + + character(len=*), intent(in) :: name !! constituent name + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio + + if (name == "carma") then + q = 0._r8 + end if + + return + end subroutine carma_init_cnst + + + subroutine carma_emission_tend(state, ptend, cam_in, dt) + use camsrfexch, only: cam_in_t + + implicit none + + type(physics_state), intent(in ) :: state !! physics state + type(physics_ptend), intent(inout) :: ptend !! physics state tendencies + type(cam_in_t), intent(inout) :: cam_in !! surface inputs + real(r8), intent(in) :: dt !! time step (s) + + return + end subroutine carma_emission_tend + + + subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) + use camsrfexch, only: cam_out_t + + implicit none + + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in ) :: state !! physics state + type(physics_ptend), intent(inout) :: ptend !! physics state tendencies + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + + return + end subroutine carma_wetdep_tend + + + subroutine carma_accumulate_stats() + implicit none + + end subroutine carma_accumulate_stats +end module carma_intr diff --git a/src/physics/cam/carma_model_flags_mod.F90 b/src/physics/cam/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..6cf268e133 --- /dev/null +++ b/src/physics/cam/carma_model_flags_mod.F90 @@ -0,0 +1,85 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM + real(r8), public :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] + character(len=256), public :: carma_reftfile = 'carma_reft.nc' ! path to the file containing the reference temperature profile + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA +! namelist /carma_model_nl/ & +! carma_flag, & +! carma_maxretries, & +! carma_conmax, & +! carma_reftfile + +! if (masterproc) then +! unitn = getunit() +! open( unitn, file=trim(nlfile), status='old' ) +! call find_group_name(unitn, 'carma_model_nl', status=ierr) +! if (ierr == 0) then +! read(unitn, carma_model_nl, iostat=ierr) +! if (ierr /= 0) then +! call endrun('carma_model_readnl: ERROR reading namelist') +! end if +! end if +! close(unitn) +! call freeunit(unitn) +! end if + +#ifdef SPMD +! call mpibcast (carma_flag, 1 ,mpilog, 0,mpicom) +! call mpibcast (carma_maxretries, 1 ,mpiint, 0,mpicom) +! call mpibcast (carma_conmax, 1 ,mpir8, 0,mpicom) +! call mpibcast (carma_reftfile, len(carma_reftfile), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 new file mode 100644 index 0000000000..60dd2b3700 --- /dev/null +++ b/src/physics/cam/check_energy.F90 @@ -0,0 +1,972 @@ + +module check_energy + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Module to check +! 1. vertically integrated total energy and water conservation for each +! column within the physical parameterizations +! +! 2. global mean total energy conservation between the physics output state +! and the input state on the next time step. +! +! 3. add a globally uniform heating term to account for any change of total energy in 2. +! +! Author: Byron Boville Oct 31, 2002 +! +! Modifications: +! 03.03.29 Boville Add global energy check and fixer. +! +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, begchunk, endchunk + use spmd_utils, only: masterproc + + use gmean_mod, only: gmean + use physconst, only: gravit, latvap, latice, cpair, cpairv + use physics_types, only: physics_state, physics_tend, physics_ptend, physics_ptend_init + use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind + use time_manager, only: is_first_step + use cam_logfile, only: iulog + + implicit none + private + +! Public types: + public check_tracers_data + +! Public methods + public :: check_energy_readnl ! read namelist values + public :: check_energy_register ! register fields in physics buffer + public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean + public :: check_energy_init ! initialization of module + public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes + public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes + public :: check_energy_gmean ! global means of physics input and output total energy + public :: check_energy_fix ! add global mean energy difference as a heating + public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes + public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes + + public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics + +! Private module data + + logical :: print_energy_errors = .false. + + real(r8) :: teout_glob ! global mean energy of output state + real(r8) :: teinp_glob ! global mean energy of input state + real(r8) :: tedif_glob ! global mean energy difference + real(r8) :: psurf_glob ! global mean surface pressure + real(r8) :: ptopb_glob ! global mean top boundary pressure + real(r8) :: heat_glob ! global mean heating rate + +! Physics buffer indices + + integer :: teout_idx = 0 ! teout index in physics buffer + integer :: dtcore_idx = 0 ! dtcore index in physics buffer + + type check_tracers_data + real(r8) :: tracer(pcols,pcnst) ! initial vertically integrated total (kinetic + static) energy + real(r8) :: tracer_tnd(pcols,pcnst) ! cumulative boundary flux of total energy + integer :: count(pcnst) ! count of values with significant imbalances + end type check_tracers_data + + +!=============================================================================== +contains +!=============================================================================== + +subroutine check_energy_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical + use cam_abortutils, only: endrun + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'check_energy_readnl' + + namelist /check_energy_nl/ print_energy_errors + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'check_energy_nl', status=ierr) + if (ierr == 0) then + read(unitn, check_energy_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(print_energy_errors, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: print_energy_errors") + + if (masterproc) then + write(iulog,*) 'check_energy options:' + write(iulog,*) ' print_energy_errors =', print_energy_errors + end if + +end subroutine check_energy_readnl + +!=============================================================================== + + subroutine check_energy_register() +! +! Register fields in the physics buffer. +! +!----------------------------------------------------------------------- + + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls + use physics_buffer, only : pbuf_register_subcol + use subcol_utils, only : is_subcol_on + +!----------------------------------------------------------------------- + +! Request physics buffer space for fields that persist across timesteps. + + call pbuf_add_field('TEOUT', 'global',dtype_r8 , (/pcols,dyn_time_lvls/), teout_idx) + call pbuf_add_field('DTCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dtcore_idx) + if(is_subcol_on()) then + call pbuf_register_subcol('TEOUT', 'phys_register', teout_idx) + call pbuf_register_subcol('DTCORE', 'phys_register', dtcore_idx) + end if + + end subroutine check_energy_register + +!=============================================================================== + +subroutine check_energy_get_integrals( tedif_glob_out, heat_glob_out ) + +!----------------------------------------------------------------------- +! Purpose: Return energy integrals +!----------------------------------------------------------------------- + + real(r8), intent(out), optional :: tedif_glob_out + real(r8), intent(out), optional :: heat_glob_out + +!----------------------------------------------------------------------- + + if ( present(tedif_glob_out) ) then + tedif_glob_out = tedif_glob + endif + if ( present(heat_glob_out) ) then + heat_glob_out = heat_glob + endif + +end subroutine check_energy_get_integrals + +!================================================================================================ + + subroutine check_energy_init() +! +! Initialize the energy conservation module +! +!----------------------------------------------------------------------- + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + + implicit none + + logical :: history_budget, history_waccm + integer :: history_budget_histfile_num ! output history file number for budget fields + +!----------------------------------------------------------------------- + + call phys_getopts( history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_waccm_out = history_waccm ) + +! register history variables + call addfld('TEINP', horiz_only, 'A', 'J/m2', 'Total energy of physics input') + call addfld('TEOUT', horiz_only, 'A', 'J/m2', 'Total energy of physics output') + call addfld('TEFIX', horiz_only, 'A', 'J/m2', 'Total energy after fixer') + call addfld('EFIX', horiz_only, 'A', 'W/m2', 'Effective sensible heat flux due to energy fixer') + call addfld('DTCORE', (/ 'lev' /), 'A', 'K/s' , 'T tendency due to dynamical core') + + if ( history_budget ) then + call add_default ('DTCORE', history_budget_histfile_num, ' ') + end if + if ( history_waccm ) then + call add_default ('DTCORE', 1, ' ') + end if + + end subroutine check_energy_init + +!=============================================================================== + + subroutine check_energy_timestep_init(state, tend, pbuf, col_type) + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + use cam_abortutils, only: endrun +!----------------------------------------------------------------------- +! Compute initial values of energy and water integrals, +! zero cumulative tendencies +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional :: col_type ! Flag inidicating whether using grid or subcolumns +!---------------------------Local storage------------------------------- + + real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy + real(r8) :: se(state%ncol) ! vertical integral of static energy + real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) + real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) + real(r8) :: wi(state%ncol) ! vertical integral of water (ice) + + real(r8),allocatable :: cpairv_loc(:,:,:) + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + integer i,k ! column, level indices + integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices + integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices +!----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + + ! cpairv_loc needs to be allocated to a size which matches state and ptend + ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc + ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair + + if (state%psetcols == pcols) then + allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpairv(:,:,:) + else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then + allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpair + else + call endrun('check_energy_timestep_init: cpairv is not allowed to vary when subcolumns are turned on') + end if + + ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) + ke = 0._r8 + se = 0._r8 + wv = 0._r8 + wl = 0._r8 + wi = 0._r8 + do k = 1, pver + do i = 1, ncol + ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit + se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit + wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit + end do + end do + do i = 1, ncol + se(i) = se(i) + state%phis(i)*state%ps(i)/gravit + end do + + ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. + if (ixcldliq > 1 .and. ixcldice > 1) then + do k = 1, pver + do i = 1, ncol + wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit + wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit + end do + end do + end if + + ! Don't require precip either, if microphysics doesn't add it. + if (ixrain > 1 .and. ixsnow > 1) then + do k = 1, pver + do i = 1, ncol + wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit + wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit + end do + end do + end if + +! Compute vertical integrals of frozen static energy and total water. + do i = 1, ncol + state%te_ini(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) + state%tw_ini(i) = wv(i) + wl(i) + wi(i) + + state%te_cur(i) = state%te_ini(i) + state%tw_cur(i) = state%tw_ini(i) + end do + +! zero cummulative boundary fluxes + tend%te_tnd(:ncol) = 0._r8 + tend%tw_tnd(:ncol) = 0._r8 + + state%count = 0 + +! initialize physics buffer + if (is_first_step()) then + call pbuf_set_field(pbuf, teout_idx, state%te_ini, col_type=col_type) + end if + + deallocate(cpairv_loc) + + end subroutine check_energy_timestep_init + +!=============================================================================== + + subroutine check_energy_chng(state, tend, name, nstep, ztodt, & + flx_vap, flx_cnd, flx_ice, flx_sen) + use cam_abortutils, only: endrun + +!----------------------------------------------------------------------- +! Check that the energy and water change matches the boundary fluxes +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state) , intent(inout) :: state + type(physics_tend ) , intent(inout) :: tend + character*(*),intent(in) :: name ! parameterization name for fluxes + integer , intent(in ) :: nstep ! current timestep number + real(r8), intent(in ) :: ztodt ! 2 delta t (model time increment) + real(r8), intent(in ) :: flx_vap(:) ! (pcols) - boundary flux of vapor (kg/m2/s) + real(r8), intent(in ) :: flx_cnd(:) ! (pcols) -boundary flux of liquid+ice (m/s) (precip?) + real(r8), intent(in ) :: flx_ice(:) ! (pcols) -boundary flux of ice (m/s) (snow?) + real(r8), intent(in ) :: flx_sen(:) ! (pcols) -boundary flux of sensible heat (w/m2) + +!******************** BAB ****************************************************** +!******* Note that the precip and ice fluxes are in precip units (m/s). ******** +!******* I would prefer to have kg/m2/s. ******** +!******* I would also prefer liquid (not total) and ice fluxes ******** +!******************************************************************************* + +!---------------------------Local storage------------------------------- + + real(r8) :: te_xpd(state%ncol) ! expected value (f0 + dt*boundary_flux) + real(r8) :: te_dif(state%ncol) ! energy of input state - original energy + real(r8) :: te_tnd(state%ncol) ! tendency from last process + real(r8) :: te_rer(state%ncol) ! relative error in energy column + + real(r8) :: tw_xpd(state%ncol) ! expected value (w0 + dt*boundary_flux) + real(r8) :: tw_dif(state%ncol) ! tw_inp - original water + real(r8) :: tw_tnd(state%ncol) ! tendency from last process + real(r8) :: tw_rer(state%ncol) ! relative error in water column + + real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy + real(r8) :: se(state%ncol) ! vertical integral of static energy + real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) + real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) + real(r8) :: wi(state%ncol) ! vertical integral of water (ice) + + real(r8) :: te(state%ncol) ! vertical integral of total energy + real(r8) :: tw(state%ncol) ! vertical integral of total water + + real(r8),allocatable :: cpairv_loc(:,:,:) + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + integer i,k ! column, level indices + integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices + integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices +!----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + + ! cpairv_loc needs to be allocated to a size which matches state and ptend + ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc + ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair + + if (state%psetcols == pcols) then + allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpairv(:,:,:) + else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then + allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpair + else + call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') + end if + + ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) + ke = 0._r8 + se = 0._r8 + wv = 0._r8 + wl = 0._r8 + wi = 0._r8 + do k = 1, pver + do i = 1, ncol + ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit + se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit + wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit + end do + end do + do i = 1, ncol + se(i) = se(i) + state%phis(i)*state%ps(i)/gravit + end do + + ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. + if (ixcldliq > 1 .and. ixcldice > 1) then + do k = 1, pver + do i = 1, ncol + wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit + wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit + end do + end do + end if + + ! Don't require precip either, if microphysics doesn't add it. + if (ixrain > 1 .and. ixsnow > 1) then + do k = 1, pver + do i = 1, ncol + wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit + wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit + end do + end do + end if + + ! Compute vertical integrals of frozen static energy and total water. + do i = 1, ncol + te(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) + tw(i) = wv(i) + wl(i) + wi(i) + end do + + ! compute expected values and tendencies + do i = 1, ncol + ! change in static energy and total water + te_dif(i) = te(i) - state%te_cur(i) + tw_dif(i) = tw(i) - state%tw_cur(i) + + ! expected tendencies from boundary fluxes for last process + te_tnd(i) = flx_vap(i)*(latvap+latice) - (flx_cnd(i) - flx_ice(i))*1000._r8*latice + flx_sen(i) + tw_tnd(i) = flx_vap(i) - flx_cnd(i) *1000._r8 + + ! cummulative tendencies from boundary fluxes + tend%te_tnd(i) = tend%te_tnd(i) + te_tnd(i) + tend%tw_tnd(i) = tend%tw_tnd(i) + tw_tnd(i) + + ! expected new values from previous state plus boundary fluxes + te_xpd(i) = state%te_cur(i) + te_tnd(i)*ztodt + tw_xpd(i) = state%tw_cur(i) + tw_tnd(i)*ztodt + + ! relative error, expected value - input state / previous state + te_rer(i) = (te_xpd(i) - te(i)) / state%te_cur(i) + end do + + ! relative error for total water (allow for dry atmosphere) + tw_rer = 0._r8 + where (state%tw_cur(:ncol) > 0._r8) + tw_rer(:ncol) = (tw_xpd(:ncol) - tw(:ncol)) / state%tw_cur(:ncol) + end where + + ! error checking + if (print_energy_errors) then + if (any(abs(te_rer(1:ncol)) > 1.E-14_r8 .or. abs(tw_rer(1:ncol)) > 1.E-10_r8)) then + do i = 1, ncol + ! the relative error threshold for the water budget has been reduced to 1.e-10 + ! to avoid messages generated by QNEG3 calls + ! PJR- change to identify if error in energy or water + if (abs(te_rer(i)) > 1.E-14_r8 ) then + state%count = state%count + 1 + write(iulog,*) "significant energy conservation error after ", name, & + " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i + write(iulog,*) te(i),te_xpd(i),te_dif(i),tend%te_tnd(i)*ztodt, & + te_tnd(i)*ztodt,te_rer(i) + endif + if ( abs(tw_rer(i)) > 1.E-10_r8) then + state%count = state%count + 1 + write(iulog,*) "significant water conservation error after ", name, & + " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i + write(iulog,*) tw(i),tw_xpd(i),tw_dif(i),tend%tw_tnd(i)*ztodt, & + tw_tnd(i)*ztodt,tw_rer(i) + end if + end do + end if + end if + + ! copy new value to state + do i = 1, ncol + state%te_cur(i) = te(i) + state%tw_cur(i) = tw(i) + end do + + deallocate(cpairv_loc) + + end subroutine check_energy_chng + + +!=============================================================================== + subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + +!----------------------------------------------------------------------- +! Compute global mean total energy of physics input and output states +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + real(r8), intent(in) :: dtime ! physics time step + integer , intent(in) :: nstep ! current timestep number + +!---------------------------Local storage------------------------------- + integer :: ncol ! number of active columns + integer :: lchnk ! chunk index + + real(r8) :: te(pcols,begchunk:endchunk,3) + ! total energy of input/output states (copy) + real(r8) :: te_glob(3) ! global means of total energy + real(r8), pointer :: teout(:) +!----------------------------------------------------------------------- + + ! Copy total energy out of input and output states + do lchnk = begchunk, endchunk + ncol = state(lchnk)%ncol + ! input energy + te(:ncol,lchnk,1) = state(lchnk)%te_ini(:ncol) + ! output energy + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk),teout_idx, teout) + + te(:ncol,lchnk,2) = teout(1:ncol) + ! surface pressure for heating rate + te(:ncol,lchnk,3) = state(lchnk)%pint(:ncol,pver+1) + end do + + ! Compute global means of input and output energies and of + ! surface pressure for heating rate (assume uniform ptop) + call gmean(te, te_glob, 3) + + if (begchunk .le. endchunk) then + teinp_glob = te_glob(1) + teout_glob = te_glob(2) + psurf_glob = te_glob(3) + ptopb_glob = state(begchunk)%pint(1,1) + + ! Global mean total energy difference + tedif_glob = teinp_glob - teout_glob + heat_glob = -tedif_glob/dtime * gravit / (psurf_glob - ptopb_glob) + + if (masterproc) then + write(iulog,'(1x,a9,1x,i8,4(1x,e25.17))') "nstep, te", nstep, teinp_glob, teout_glob, heat_glob, psurf_glob + end if + else + heat_glob = 0._r8 + end if ! (begchunk .le. endchunk) + + end subroutine check_energy_gmean + +!=============================================================================== + subroutine check_energy_fix(state, ptend, nstep, eshflx) + +!----------------------------------------------------------------------- +! Add heating rate required for global mean total energy conservation +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(in ) :: state + type(physics_ptend), intent(out) :: ptend + + integer , intent(in ) :: nstep ! time step number + real(r8), intent(out ) :: eshflx(pcols) ! effective sensible heat flux + +!---------------------------Local storage------------------------------- + integer :: i ! column + integer :: ncol ! number of atmospheric columns in chunk +!----------------------------------------------------------------------- + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) + +#if ( defined OFFLINE_DYN ) + ! disable the energy fix for offline driver + heat_glob = 0._r8 +#endif +! add (-) global mean total energy difference as heating + ptend%s(:ncol,:pver) = heat_glob +!!$ write(iulog,*) "chk_fix: heat", state%lchnk, ncol, heat_glob + +! compute effective sensible heat flux + do i = 1, ncol + eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) / gravit + end do +!!! if (nstep > 0) write(iulog,*) "heat", heat_glob, eshflx(1) + + return + end subroutine check_energy_fix + + +!=============================================================================== + subroutine check_tracers_init(state, tracerint) + +!----------------------------------------------------------------------- +! Compute initial values of tracers integrals, +! zero cumulative tendencies +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(in) :: state + type(check_tracers_data), intent(out) :: tracerint + +!---------------------------Local storage------------------------------- + + real(r8) :: tr(pcols) ! vertical integral of tracer + real(r8) :: trpdel(pcols, pver) ! pdel for tracer + + integer ncol ! number of atmospheric columns + integer i,k,m ! column, level,constituent indices + integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices + integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices + +!----------------------------------------------------------------------- + + ncol = state%ncol + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + + do m = 1,pcnst + + if ( any(m == (/ 1, ixcldliq, ixcldice, & + ixrain, ixsnow /)) ) exit ! dont process water substances + ! they are checked in check_energy + if (cnst_get_type_byind(m).eq.'dry') then + trpdel(:ncol,:) = state%pdeldry(:ncol,:) + else + trpdel(:ncol,:) = state%pdel(:ncol,:) + endif + + ! Compute vertical integrals of tracer + tr = 0._r8 + do k = 1, pver + do i = 1, ncol + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + end do + end do + + ! Compute vertical integrals of frozen static tracers and total water. + do i = 1, ncol + tracerint%tracer(i,m) = tr(i) + end do + + ! zero cummulative boundary fluxes + tracerint%tracer_tnd(:ncol,m) = 0._r8 + + tracerint%count(m) = 0 + + end do + + return + end subroutine check_tracers_init + +!=============================================================================== + subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) + +!----------------------------------------------------------------------- +! Check that the tracers and water change matches the boundary fluxes +! these checks are not save when there are tracers transformations, as +! they only check to see whether a mass change in the column is +! associated with a flux +!----------------------------------------------------------------------- + + use cam_abortutils, only: endrun + + + implicit none + +!------------------------------Arguments-------------------------------- + + type(physics_state) , intent(in ) :: state + type(check_tracers_data), intent(inout) :: tracerint! tracers integrals and boundary fluxes + character*(*),intent(in) :: name ! parameterization name for fluxes + integer , intent(in ) :: nstep ! current timestep number + real(r8), intent(in ) :: ztodt ! 2 delta t (model time increment) + real(r8), intent(in ) :: cflx(pcols,pcnst) ! boundary flux of tracers (kg/m2/s) + +!---------------------------Local storage------------------------------- + + real(r8) :: tracer_inp(pcols,pcnst) ! total tracer of new (input) state + real(r8) :: tracer_xpd(pcols,pcnst) ! expected value (w0 + dt*boundary_flux) + real(r8) :: tracer_dif(pcols,pcnst) ! tracer_inp - original tracer + real(r8) :: tracer_tnd(pcols,pcnst) ! tendency from last process + real(r8) :: tracer_rer(pcols,pcnst) ! relative error in tracer column + + real(r8) :: tr(pcols) ! vertical integral of tracer + real(r8) :: trpdel(pcols, pver) ! pdel for tracer + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + integer i,k ! column, level indices + integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices + integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices + integer :: m ! tracer index + character(len=8) :: tracname ! tracername +!----------------------------------------------------------------------- +!!$ if (.true.) return + + lchnk = state%lchnk + ncol = state%ncol + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + + do m = 1,pcnst + + if ( any(m == (/ 1, ixcldliq, ixcldice, & + ixrain, ixsnow /)) ) exit ! dont process water substances + ! they are checked in check_energy + + tracname = cnst_name(m) + if (cnst_get_type_byind(m).eq.'dry') then + trpdel(:ncol,:) = state%pdeldry(:ncol,:) + else + trpdel(:ncol,:) = state%pdel(:ncol,:) + endif + + ! Compute vertical integrals tracers + tr = 0._r8 + do k = 1, pver + do i = 1, ncol + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + end do + end do + + ! Compute vertical integrals of tracer + do i = 1, ncol + tracer_inp(i,m) = tr(i) + end do + + ! compute expected values and tendencies + do i = 1, ncol + ! change in tracers + tracer_dif(i,m) = tracer_inp(i,m) - tracerint%tracer(i,m) + + ! expected tendencies from boundary fluxes for last process + tracer_tnd(i,m) = cflx(i,m) + + ! cummulative tendencies from boundary fluxes + tracerint%tracer_tnd(i,m) = tracerint%tracer_tnd(i,m) + tracer_tnd(i,m) + + ! expected new values from original values plus boundary fluxes + tracer_xpd(i,m) = tracerint%tracer(i,m) + tracerint%tracer_tnd(i,m)*ztodt + + ! relative error, expected value - input value / original + tracer_rer(i,m) = (tracer_xpd(i,m) - tracer_inp(i,m)) / tracerint%tracer(i,m) + end do + +!! final loop for error checking +! do i = 1, ncol + +!! error messages +! if (abs(enrgy_rer(i)) > 1.E-14 .or. abs(water_rer(i)) > 1.E-14) then +! tracerint%count = tracerint%count + 1 +! write(iulog,*) "significant conservations error after ", name, & +! " count", tracerint%count, " nstep", nstep, "chunk", lchnk, "col", i +! write(iulog,*) enrgy_inp(i),enrgy_xpd(i),enrgy_dif(i),tracerint%enrgy_tnd(i)*ztodt, & +! enrgy_tnd(i)*ztodt,enrgy_rer(i) +! write(iulog,*) water_inp(i),water_xpd(i),water_dif(i),tracerint%water_tnd(i)*ztodt, & +! water_tnd(i)*ztodt,water_rer(i) +! end if +! end do + + + ! final loop for error checking + if ( maxval(tracer_rer) > 1.E-14_r8 ) then + write(iulog,*) "CHECK_TRACERS TRACER large rel error" + write(iulog,*) tracer_rer + endif + + do i = 1, ncol + ! error messages + if (abs(tracer_rer(i,m)) > 1.E-14_r8 ) then + tracerint%count = tracerint%count + 1 + write(iulog,*) "CHECK_TRACERS TRACER significant conservation error after ", name, & + " count", tracerint%count, " nstep", nstep, "chunk", lchnk, "col",i + write(iulog,*)' process name, tracname, index ', name, tracname, m + write(iulog,*)" input integral ",tracer_inp(i,m) + write(iulog,*)" expected integral ", tracer_xpd(i,m) + write(iulog,*)" input - inital integral ",tracer_dif(i,m) + write(iulog,*)" cumulative tend ",tracerint%tracer_tnd(i,m)*ztodt + write(iulog,*)" process tend ",tracer_tnd(i,m)*ztodt + write(iulog,*)" relative error ",tracer_rer(i,m) + call endrun() + end if + end do + end do + + return + end subroutine check_tracers_chng + +!####################################################################### + + subroutine calc_te_and_aam_budgets(state, outfld_name_suffix) + use physconst, only: gravit,cpair,pi,rearth,omega + use cam_history, only: hist_fld_active, outfld + +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(inout) :: state + character*(*),intent(in) :: outfld_name_suffix ! suffix for "outfld" names + +!---------------------------Local storage------------------------------- + + real(r8) :: se(pcols) ! Dry Static energy (J/m2) + real(r8) :: ke(pcols) ! kinetic energy (J/m2) + real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) + real(r8) :: wl(pcols) ! column integrated liquid (kg/m2) + real(r8) :: wi(pcols) ! column integrated ice (kg/m2) + real(r8) :: tt(pcols) ! column integrated test tracer (kg/m2) + real(r8) :: mr(pcols) ! column integrated wind axial angular momentum (kg*m2/s) + real(r8) :: mo(pcols) ! column integrated mass axial angular momentum (kg*m2/s) + real(r8) :: se_tmp,ke_tmp,wv_tmp,wl_tmp,wi_tmp,tt_tmp,mr_tmp,mo_tmp,cos_lat + real(r8) :: mr_cnst, mo_cnst + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + integer i,k ! column, level indices + integer :: ixcldice, ixcldliq,ixtt ! CLDICE and CLDLIQ indices + character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 +!----------------------------------------------------------------------- + + name_out1 = 'SE_' //trim(outfld_name_suffix) + name_out2 = 'KE_' //trim(outfld_name_suffix) + name_out3 = 'WV_' //trim(outfld_name_suffix) + name_out4 = 'WL_' //trim(outfld_name_suffix) + name_out5 = 'WI_' //trim(outfld_name_suffix) + name_out6 = 'TT_' //trim(outfld_name_suffix) + + if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& + hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + + lchnk = state%lchnk + ncol = state%ncol + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + + ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid + + se = 0._r8 + ke = 0._r8 + wv = 0._r8 + wl = 0._r8 + wi = 0._r8 + tt = 0._r8 + + do k = 1, pver + do i = 1, ncol + ke_tmp = 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit + se_tmp = cpair*state%t(i,k) *state%pdel(i,k)/gravit + wv_tmp = state%q(i,k,1 ) *state%pdel(i,k)/gravit + + se (i) = se (i) + se_tmp + ke (i) = ke (i) + ke_tmp + wv (i) = wv (i) + wv_tmp + end do + end do + do i = 1, ncol + se(i) = se(i) + state%phis(i)*state%ps(i)/gravit + end do + + ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. + + if (ixcldliq > 1) then + do k = 1, pver + do i = 1, ncol + wl_tmp = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit + wl (i) = wl(i) + wl_tmp + end do + end do + end if + + if (ixcldice > 1) then + do k = 1, pver + do i = 1, ncol + wi_tmp = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit + wi(i) = wi(i) + wi_tmp + end do + end do + end if + + if (ixtt > 1) then + if (name_out6 == 'TT_pAM') then + ! + ! after dme_adjust mixing ratios are all wet + ! + do k = 1, pver + do i = 1, ncol + tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit + tt (i) = tt(i) + tt_tmp + end do + end do + else + do k = 1, pver + do i = 1, ncol + tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit + tt (i) = tt(i) + tt_tmp + end do + end do + end if + end if + + ! Output energy diagnostics + + call outfld(name_out1 ,se , pcols ,lchnk ) + call outfld(name_out2 ,ke , pcols ,lchnk ) + call outfld(name_out3 ,wv , pcols ,lchnk ) + call outfld(name_out4 ,wl , pcols ,lchnk ) + call outfld(name_out5 ,wi , pcols ,lchnk ) + call outfld(name_out6 ,tt , pcols ,lchnk ) + end if + + + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian + ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, + ! doi:10.1002/2013MS000268 + ! + ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) + ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) + ! + name_out1 = 'MR_' //trim(outfld_name_suffix) + name_out2 = 'MO_' //trim(outfld_name_suffix) + + if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then + lchnk = state%lchnk + ncol = state%ncol + + mr_cnst = rearth**3/gravit + mo_cnst = omega*rearth**4/gravit + do k = 1, pver + do i = 1, ncol + cos_lat = cos(state%lat(i)*180._r8/pi) + mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat + mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2 + + mr(i) = mr(i) + mr_tmp + mo(i) = mo(i) + mo_tmp + end do + end do + call outfld(name_out1 ,mr, pcols,lchnk ) + call outfld(name_out1 ,mo, pcols,lchnk ) + end if + end subroutine calc_te_and_aam_budgets + + +end module check_energy diff --git a/src/physics/cam/chem_surfvals.F90 b/src/physics/cam/chem_surfvals.F90 new file mode 100644 index 0000000000..3a8920d37d --- /dev/null +++ b/src/physics/cam/chem_surfvals.F90 @@ -0,0 +1,643 @@ + +module chem_surfvals + +!----------------------------------------------------------------------------------- +! Purpose: Provides greenhouse gas (ghg) values at the Earth's surface. +! These values may be time dependent. +! +! Author: Brian Eaton (assembled module from existing scattered code pieces) +!----------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use time_manager, only: get_curr_date, get_start_date, is_end_curr_day, & + timemgr_datediff, get_curr_calday + use cam_abortutils, only: endrun + use netcdf + use error_messages, only: handle_ncerr + use cam_logfile, only: iulog + use m_types, only: time_ramp + use constituents, only: pcnst + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + private ! Make default access private + save + +! Public methods + public ::& + chem_surfvals_readnl, &! read namelist input + chem_surfvals_init, &! initialize options that depend on namelist input + chem_surfvals_set, &! set ghg surface values when scenario_ghg is 'RAMPED' or 'CHEM_LBC_FILE' + chem_surfvals_get, &! return surface values for: CO2VMR, CO2MMR, CH4VMR + ! N2OVMR, F11VMR, and F12VMR + chem_surfvals_co2_rad ! return co2 for radiation + + public :: flbc_list + +! Private module data + + ! Default values for namelist variables -- now set by build-namelist + real(r8) :: o2mmr = .23143_r8 ! o2 mass mixing ratio + real(r8) :: co2vmr_rad = -1.0_r8 ! co2 vmr override for radiation + real(r8) :: co2vmr = -1.0_r8 ! co2 volume mixing ratio + real(r8) :: n2ovmr = -1.0_r8 ! n2o volume mixing ratio + real(r8) :: ch4vmr = -1.0_r8 ! ch4 volume mixing ratio + real(r8) :: f11vmr = -1.0_r8 ! cfc11 volume mixing ratio + real(r8) :: f12vmr = -1.0_r8 ! cfc12 volume mixing ratio + character(len=16) :: scenario_ghg = 'FIXED' ! 'FIXED','RAMPED' or 'RAMP_CO2_ONLY' + integer :: rampYear_ghg = 0 ! ramped gases fixed at this year (if > 0) + character(len=256) :: bndtvghg = 'NONE' ! filename for ramped data + integer :: ramp_co2_start_ymd = 0 ! start date for co2 ramping (yyyymmdd) + real(r8) :: ramp_co2_annual_rate = 1.0_r8 ! % amount of co2 ramping per yr; default is 1% + real(r8) :: ramp_co2_cap = -9999.0_r8 ! co2 ramp cap if rate>0, floor otherwise + ! as multiple or fraction of inital value + ! ex. 4.0 => cap at 4x initial co2 setting + integer :: ghg_yearStart_model = 0 ! model start year + integer :: ghg_yearStart_data = 0 ! data start year + + logical :: ghg_use_calendar ! true => data year = model year + logical :: doRamp_ghg ! true => turn on ramping for ghg + logical :: ramp_just_co2 ! true => ramping to be done just for co2 and not other ghg's + integer :: fixYear_ghg ! year at which Ramped gases are fixed + integer :: co2_start ! date at which co2 begins ramping + real(r8) :: co2_daily_factor ! daily multiplier to achieve annual rate of co2 ramp + real(r8) :: co2_limit ! value of co2vmr where ramping ends + real(r8) :: co2_base ! initial co2 volume mixing ratio, before any ramping + integer :: ntim = -1 ! number of yearly data values + integer, allocatable :: yrdata(:) ! yearly data values + real(r8), allocatable :: co2(:) ! co2 mixing ratios in ppmv + real(r8), allocatable :: ch4(:) ! ppbv + real(r8), allocatable :: n2o(:) ! ppbv + real(r8), allocatable :: f11(:) ! pptv + real(r8), allocatable :: f12(:) ! pptv + real(r8), allocatable :: adj(:) ! unitless adjustment factor for f11 & f12 + + ! fixed lower boundary + + character(len=256) :: flbc_file = 'NONE' + character(len=16) :: flbc_list(pcnst) = '' + type(time_ramp) :: flbc_timing != time_ramp( "CYCLICAL", 19970101, 0 ) + +!========================================================================================= +contains +!========================================================================================= + +subroutine chem_surfvals_readnl(nlfile) + + ! Read chem_surfvals_nl namelist group. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, i + character(len=*), parameter :: subname = 'chem_surfvals_readnl' + + character(len=8) :: flbc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'FIXED' + integer :: flbc_cycle_yr = 0 + integer :: flbc_fixed_ymd = 0 + integer :: flbc_fixed_tod = 0 + + namelist /chem_surfvals_nl/ co2vmr, n2ovmr, ch4vmr, f11vmr, f12vmr, & + co2vmr_rad, scenario_ghg, rampyear_ghg, bndtvghg, & + ramp_co2_start_ymd, ramp_co2_annual_rate, ramp_co2_cap, & + ghg_yearStart_model, ghg_yearStart_data + ! waccm/cam-chem naemlist + namelist /chem_surfvals_nl/ flbc_type, flbc_cycle_yr, flbc_fixed_ymd, flbc_fixed_tod, flbc_list, flbc_file + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'chem_surfvals_nl', status=ierr) + if (ierr == 0) then + read(unitn, chem_surfvals_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast (co2vmr, 1, mpir8, 0, mpicom) + call mpibcast (n2ovmr, 1, mpir8, 0, mpicom) + call mpibcast (ch4vmr, 1, mpir8, 0, mpicom) + call mpibcast (f11vmr, 1, mpir8, 0, mpicom) + call mpibcast (f12vmr, 1, mpir8, 0, mpicom) + call mpibcast (co2vmr_rad, 1, mpir8, 0, mpicom) + call mpibcast (scenario_ghg, len(scenario_ghg), mpichar, 0, mpicom) + call mpibcast (rampyear_ghg, 1, mpiint, 0, mpicom) + call mpibcast (bndtvghg, len(bndtvghg), mpichar, 0, mpicom) + call mpibcast (ramp_co2_start_ymd, 1, mpiint, 0, mpicom) + call mpibcast (ramp_co2_annual_rate, 1, mpir8, 0, mpicom) + call mpibcast (ramp_co2_cap, 1, mpir8, 0, mpicom) + call mpibcast (ghg_yearstart_model, 1, mpiint, 0, mpicom) + call mpibcast (ghg_yearstart_data, 1, mpiint, 0, mpicom) + + ! waccm/cam-chem fixed lower boundary + + call mpibcast (flbc_type, len(flbc_type), mpichar, 0, mpicom) + call mpibcast (flbc_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast (flbc_fixed_ymd, 1, mpiint, 0, mpicom) + call mpibcast (flbc_fixed_tod, 1, mpiint, 0, mpicom) + call mpibcast (flbc_list, len(flbc_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast (flbc_file, len(flbc_file), mpichar, 0, mpicom) + +#endif + + flbc_timing%type = flbc_type + flbc_timing%cycle_yr = flbc_cycle_yr + flbc_timing%fixed_ymd = flbc_fixed_ymd + flbc_timing%fixed_tod = flbc_fixed_tod + + if ( (bndtvghg.ne.'NONE') .and. (flbc_file.ne.'NONE') ) then + call endrun('chem_surfvals_readnl: Cannot specify both bndtvghg and flbc_file ') + endif + + if (co2vmr_rad > 0._r8) then + if (masterproc) & + write(iulog,*) trim(subname)//': co2vmr_rad override is set to ', co2vmr_rad + end if + +end subroutine chem_surfvals_readnl + +!================================================================================================ + +subroutine chem_surfvals_init() + +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize the ramp options that are controlled by namelist input. +! Set surface values at initial time. +! N.B. This routine must be called after the time manager has been initialized +! since chem_surfvals_set calls time manager methods. +! +! Author: B. Eaton - merged code from parse_namelist and rampnl_ghg. +! +!----------------------------------------------------------------------- + + use infnan, only: posinf, assignment(=) + use mo_flbc, only: flbc_inti + use phys_control, only: use_simple_phys + + !---------------------------Local variables----------------------------- + integer :: yr, mon, day, ncsec + !----------------------------------------------------------------------- + + if (use_simple_phys) return + + if (scenario_ghg == 'FIXED') then + doRamp_ghg = .false. + ramp_just_co2 = .false. + if (masterproc) & + write(iulog,*)'chem_surfvals_init: ghg surface values are fixed as follows' + + else if (scenario_ghg == 'RAMPED') then + doRamp_ghg = .true. + ramp_just_co2 = .false. + call ghg_ramp_read + + fixYear_ghg = rampYear_ghg ! set private member to namelist var + if (masterproc) then + if ( fixYear_ghg > 0 ) then + write(iulog,*) ' FIXED values from year ',fixYear_ghg + else + write(iulog,*) ' RAMPED values initialized to' + end if + end if + call chem_surfvals_set() + + else if (scenario_ghg == 'RAMP_CO2_ONLY') then + if(ramp_co2_start_ymd == 0) then + ! by default start the ramp at the initial run time + call get_start_date(yr, mon, day, ncsec) + ramp_co2_start_ymd = yr*10000 + mon*100 + day + end if + co2_start = ramp_co2_start_ymd + + if(ramp_co2_annual_rate <= -100.0_r8) then + write(iulog,*) 'RAMP_CO2: invalid ramp_co2_annual_rate= ',ramp_co2_annual_rate + call endrun ('chem_surfvals_init: RAMP_CO2_ANNUAL_RATE must be greater than -100.0') + end if + + doRamp_ghg = .true. + ramp_just_co2 = .true. + co2_base = co2vmr ! save initial setting + if (masterproc) & + write(iulog,*) ' RAMPED values initialized to' + + co2_daily_factor = (ramp_co2_annual_rate*0.01_r8+1.0_r8)**(1.0_r8/365.0_r8) + + if(ramp_co2_cap > 0.0_r8) then + co2_limit = ramp_co2_cap * co2_base + else ! if no cap/floor specified, provide default + if(ramp_co2_annual_rate < 0.0_r8) then + co2_limit = 0.0_r8 + else + co2_limit = posinf + end if + end if + if((ramp_co2_annual_rate<0.0_r8 .and. co2_limit>co2_base) .or. & + (ramp_co2_annual_rate>0.0_r8 .and. co2_limit 0._r8) then + chem_surfvals_co2_rad = convert_vmr * co2vmr_rad + else + chem_surfvals_co2_rad = convert_vmr * co2vmr + end if + +end function chem_surfvals_co2_rad + +!========================================================================================= + +subroutine chem_surfvals_set() + + use ppgrid, only: begchunk, endchunk + use mo_flbc, only: flbc_gmean_vmr, flbc_chk + +!---------------------------Local variables----------------------------- + + integer :: yr, mon, day, ncsec ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + + if ( doRamp_ghg ) then + if(ramp_just_co2) then + call chem_surfvals_set_co2() + else + call chem_surfvals_set_all() + end if + elseif (scenario_ghg == 'CHEM_LBC_FILE') then + ! set mixing ratios from cam-chem/waccm lbc file + call flbc_chk() + call flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + endif + + if (masterproc .and. is_end_curr_day()) then + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + write(iulog,*) 'chem_surfvals_set: ncdate= ',ncdate,' co2vmr=',co2vmr + + if (.not. ramp_just_co2 .and. mon==1 .and. day==1) then + write(iulog,*) 'chem_surfvals_set: ch4vmr=', ch4vmr, ' n2ovmr=', n2ovmr, & + ' f11vmr=', f11vmr, ' f12vmr=', f12vmr + end if + + end if + + return +end subroutine chem_surfvals_set + +!========================================================================================= + +subroutine chem_surfvals_set_all() +!----------------------------------------------------------------------- +! +! Purpose: +! Computes greenhouse gas volume mixing ratios via interpolation of +! yearly input data. +! +! Author: B. Eaton - updated ramp_ghg for use in chem_surfvals module +! +!----------------------------------------------------------------------- + use interpolate_data, only: get_timeinterp_factors + +!---------------------------Local variables----------------------------- + + integer yrmodel ! model year + integer nyrm ! year index + integer nyrp ! year index + integer :: yr, mon, day ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + + real(r8) :: calday ! current calendar day + real(r8) doymodel ! model day of year + real(r8) doydatam ! day of year for input data yrdata(nyrm) + real(r8) doydatap ! day or year for input data yrdata(nyrp) + real(r8) deltat ! delta time + real(r8) fact1, fact2 ! time interpolation factors + real(r8) cfcscl ! cfc scale factor for f11 + + integer yearRan_model ! model ran year +! +! --------------------------------------------------------------------- +! + calday = get_curr_calday() + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day +! +! determine ghg_use_calendar +! + if ( ghg_yearStart_model > 0 .and. ghg_yearStart_data > 0 ) then + ghg_use_calendar = .false. + else + ghg_use_calendar = .true. + end if +! +! determine index into input data +! + if ( fixYear_ghg > 0) then + yrmodel = fixYear_ghg + nyrm = fixYear_ghg - yrdata(1) + 1 + else + if ( ghg_use_calendar) then + yrmodel = yr + nyrm = yr - yrdata(1) + 1 + else + yearRan_model = yr - ghg_yearStart_model + if ( yearRan_model < 0 ) then + call endrun('chem_surfvals_set_all: incorrect ghg_yearStart_model') + endif + yrmodel = yearRan_model + ghg_yearStart_data + + nyrm = ghg_yearStart_data + yearRan_model - yrdata(1) + 1 + end if + end if + + nyrp = nyrm + 1 +! +! if current date is before yrdata(1), quit +! + if (nyrm < 1) then + write(iulog,*)'chem_surfvals_set_all: data time index is out of bounds' + write(iulog,*)'nyrm = ',nyrm,' nyrp= ',nyrp, ' ncdate= ', ncdate + call endrun + endif +! +! if current date later than yrdata(ntim), call endrun. +! if want to use ntim values - uncomment the following lines +! below and comment the call to endrun and previous write +! + if (nyrp > ntim) then + call endrun ('chem_surfvals_set_all: error - current date is past the end of valid data') +! write(iulog,*)'chem_surfvals_set_all: using ghg data for ',yrdata(ntim) +! co2vmr = co2(ntim)*1.e-06 +! ch4vmr = ch4(ntim)*1.e-09 +! n2ovmr = n2o(ntim)*1.e-09 +! f11vmr = f11(ntim)*1.e-12*(1.+cfcscl) +! f12vmr = f12(ntim)*1.e-12 +! co2mmr = rmwco2 * co2vmr +! return + endif +! +! determine time interpolation factors, check sanity +! of interpolation factors to within 32-bit roundoff +! assume that day of year is 1 for all input data +! + doymodel = yrmodel*365._r8 + calday + doydatam = yrdata(nyrm)*365._r8 + 1._r8 + doydatap = yrdata(nyrp)*365._r8 + 1._r8 + + call get_timeinterp_factors(.false.,2,doydatam,doydatap, doymodel, & + fact1, fact2,'chem_surfvals') + +! +! do time interpolation: +! co2 in ppmv +! n2o,ch4 in ppbv +! f11,f12 in pptv +! + co2vmr = (co2(nyrm)*fact1 + co2(nyrp)*fact2)*1.e-06_r8 + ch4vmr = (ch4(nyrm)*fact1 + ch4(nyrp)*fact2)*1.e-09_r8 + n2ovmr = (n2o(nyrm)*fact1 + n2o(nyrp)*fact2)*1.e-09_r8 + + cfcscl = (adj(nyrm)*fact1 + adj(nyrp)*fact2) + f11vmr = (f11(nyrm)*fact1 + f11(nyrp)*fact2)*1.e-12_r8*(1._r8+cfcscl) + f12vmr = (f12(nyrm)*fact1 + f12(nyrp)*fact2)*1.e-12_r8 + + return +end subroutine chem_surfvals_set_all + +!========================================================================================= + +subroutine chem_surfvals_set_co2() +!----------------------------------------------------------------------- +! +! Purpose: +! Computes co2 greenhouse gas volume mixing ratio via ramping info +! provided in namelist var's +! +! Author: B. Eaton - updated ramp_ghg for use in chem_surfvals module +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + +!---------------------------Local variables----------------------------- + + real(r8) :: daydiff ! number of days of co2 ramping + integer :: yr, mon, day, ncsec ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] +!----------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, ncsec) + ncdate = yr*10000 + mon*100 + day + + call timemgr_datediff(co2_start, 0, ncdate, ncsec, daydiff) + + if (daydiff > 0.0_r8) then + + co2vmr = co2_base*(co2_daily_factor)**daydiff + + if(co2_daily_factor < 1.0_r8) then + co2vmr = max(co2vmr,co2_limit) + else + co2vmr = min(co2vmr,co2_limit) + end if + end if + + return +end subroutine chem_surfvals_set_co2 + + +!========================================================================================= + +end module chem_surfvals diff --git a/src/physics/cam/cldfrc2m.F90 b/src/physics/cam/cldfrc2m.F90 new file mode 100644 index 0000000000..daef9ed9b0 --- /dev/null +++ b/src/physics/cam/cldfrc2m.F90 @@ -0,0 +1,1158 @@ +module cldfrc2m + +! cloud fraction calculations + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols +use physconst, only: rair +use wv_saturation, only: qsat_water, svp_water, svp_ice +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + cldfrc2m_readnl, & + cldfrc2m_init, & + astG_PDF_single, & + astG_PDF, & + astG_RHU_single, & + astG_RHU, & + aist_single, & + aist_vector, & + CAMstfrac, & + rhmini_const, & + rhmaxi_const, & + rhminis_const, & + rhmaxis_const + +! Namelist variables +real(r8) :: cldfrc2m_rhmini ! Minimum rh for ice cloud fraction > 0. +real(r8) :: cldfrc2m_rhmaxi +real(r8) :: cldfrc2m_rhminis ! Minimum rh for ice cloud fraction > 0 in the stratsophere. +real(r8) :: cldfrc2m_rhmaxis +logical :: cldfrc2m_do_subgrid_growth = .false. +! -------------------------- ! +! Parameters for Ice Stratus ! +! -------------------------- ! +real(r8), protected :: rhmini_const ! Minimum rh for ice cloud fraction > 0. +real(r8), protected :: rhmaxi_const +real(r8), protected :: rhminis_const ! Minimum rh for ice cloud fraction > 0. +real(r8), protected :: rhmaxis_const + +real(r8), parameter :: qist_min = 1.e-7_r8 ! Minimum in-stratus ice IWC constraint [ kg/kg ] +real(r8), parameter :: qist_max = 5.e-3_r8 ! Maximum in-stratus ice IWC constraint [ kg/kg ] + +! ----------------------------- ! +! Parameters for Liquid Stratus ! +! ----------------------------- ! + +logical, parameter :: CAMstfrac = .false. ! If .true. (.false.), + ! use Slingo (triangular PDF-based) liquid stratus fraction +logical, parameter :: freeze_dry = .false. ! If .true., use 'freeze dry' in liquid stratus fraction formula +real(r8) :: rhminl_const ! Critical RH for low-level liquid stratus clouds +real(r8) :: rhminl_adj_land_const ! rhminl adjustment for snowfree land +real(r8) :: rhminh_const ! Critical RH for high-level liquid stratus clouds +real(r8) :: premit ! Top height for mid-level liquid stratus fraction +real(r8) :: premib ! Bottom height for mid-level liquid stratus fraction +integer :: iceopt ! option for ice cloud closure + ! 1=wang & sassen 2=schiller (iciwc) + ! 3=wood & field, 4=Wilson (based on smith) + ! 5=modified slingo (ssat & empyt cloud) +real(r8) :: icecrit ! Critical RH for ice clouds in Wilson & Ballard closure + ! ( smaller = more ice clouds ) + +!================================================================================================ +contains +!================================================================================================ + +subroutine cldfrc2m_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cldfrc2m_readnl' + + namelist /cldfrc2m_nl/ cldfrc2m_rhmini, cldfrc2m_rhmaxi, cldfrc2m_rhminis, cldfrc2m_rhmaxis, cldfrc2m_do_subgrid_growth + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cldfrc2m_nl', status=ierr) + if (ierr == 0) then + read(unitn, cldfrc2m_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + rhmini_const = cldfrc2m_rhmini + rhmaxi_const = cldfrc2m_rhmaxi + rhminis_const = cldfrc2m_rhminis + rhmaxis_const = cldfrc2m_rhmaxis + + end if + + ! Broadcast namelist variables + call mpi_bcast(rhmini_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(rhmaxi_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(rhminis_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(rhmaxis_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(cldfrc2m_do_subgrid_growth, 1, mpi_logical,masterprocid, mpicom, ierr) + +end subroutine cldfrc2m_readnl + +!================================================================================================ + +subroutine cldfrc2m_init() + + use cloud_fraction, only: cldfrc_getparams + + call cldfrc_getparams(rhminl_out=rhminl_const, rhminl_adj_land_out=rhminl_adj_land_const, & + rhminh_out=rhminh_const, premit_out=premit, premib_out=premib, & + iceopt_out=iceopt, icecrit_out=icecrit) + + if( masterproc ) then + write(iulog,*) 'cldfrc2m parameters:' + write(iulog,*) ' rhminl = ', rhminl_const + write(iulog,*) ' rhminl_adj_land = ', rhminl_adj_land_const + write(iulog,*) ' rhminh = ', rhminh_const + write(iulog,*) ' premit = ', premit + write(iulog,*) ' premib = ', premib + write(iulog,*) ' iceopt = ', iceopt + write(iulog,*) ' icecrit = ', icecrit + write(iulog,*) ' rhmini = ', rhmini_const + write(iulog,*) ' rhmaxi = ', rhmaxi_const + write(iulog,*) ' rhminis = ', rhminis_const + write(iulog,*) ' rhmaxis = ', rhmaxis_const + write(iulog,*) ' do_subgrid_growth = ', cldfrc2m_do_subgrid_growth + end if + +end subroutine cldfrc2m_init + +!================================================================================================ + + +subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & + rhminl_in, rhminl_adj_land_in, rhminh_in ) + + ! --------------------------------------------------------- ! + ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! + ! analytical formulation of triangular PDF. ! + ! Here, 'dV' is the ratio of 'half-width of PDF / qs(p,T)', ! + ! so using constant 'dV' assume that width is proportional ! + ! to the saturation specific humidity. ! + ! dV ~ 0.1. ! + ! cldrh : RH of in-stratus( = 1 if no supersaturation) ! + ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! + ! G is discontinuous across U = 1. In fact, it does not ! + ! matter whether Ga = 1.e10 or 0 at a = 1: I derived that ! + ! they will produce the same results. ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: U ! Relative humidity + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(in) :: qv ! Grid-mean water vapor specific humidity [kg/kg] + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: a ! Stratus fraction + real(r8), intent(out) :: Ga ! dU/da + real(r8), optional, intent(out) :: orhmin ! Critical RH + + real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus + + ! Local variables + integer :: i ! Loop indexes + real(r8) dV ! Width of triangular PDF + real(r8) cldrh ! RH of stratus cloud + real(r8) rhmin ! Critical RH + real(r8) rhwght + + real(r8) :: rhminl + real(r8) :: rhminl_adj_land + real(r8) :: rhminh + + ! Statement functions + logical land + land = nint(landfrac) == 1 + + ! ---------- ! + ! Parameters ! + ! ---------- ! + + cldrh = 1.0_r8 + + rhminl = rhminl_const + if (present(rhminl_in)) rhminl = rhminl_in + rhminl_adj_land = rhminl_adj_land_const + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in + rhminh = rhminh_const + if (present(rhminh_in)) rhminh = rhminh_in + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + if( p .ge. premib ) then + + if( land .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + if( freeze_dry ) then + a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + endif + + elseif( p .lt. premit ) then + + rhmin = rhminh + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + else + + rhwght = (premib-(max(p,premit)))/(premib-premit) + + ! if( land .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + endif + + if (present(orhmin)) orhmin = rhmin + +end subroutine astG_PDF_single + +!================================================================================================ + +subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, ncol, & + rhminl_in, rhminl_adj_land_in, rhminh_in ) + + ! --------------------------------------------------------- ! + ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! + ! analytical formulation of triangular PDF. ! + ! Here, 'dV' is the ratio of 'half-width of PDF / qs(p,T)', ! + ! so using constant 'dV' assume that width is proportional ! + ! to the saturation specific humidity. ! + ! dV ~ 0.1. ! + ! cldrh : RH of in-stratus( = 1 if no supersaturation) ! + ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! + ! G is discontinuous across U = 1. In fact, it does not ! + ! matter whether Ga = 1.e10 or 0 at a = 1: I derived that ! + ! they will produce the same results. ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: U_in(pcols) ! Relative humidity + real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa] + real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor specific humidity [kg/kg] + real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction + real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: a_out(pcols) ! Stratus fraction + real(r8), intent(out) :: Ga_out(pcols) ! dU/da + integer, intent(in) :: ncol + + real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus + + real(r8) :: rhminl ! Critical relative humidity for low-level liquid stratus + real(r8) :: rhminl_adj_land ! Adjustment drop of rhminl over the land + real(r8) :: rhminh ! Critical relative humidity for high-level liquid stratus + + real(r8) :: U ! Relative humidity + real(r8) :: p ! Pressure [Pa] + real(r8) :: qv ! Grid-mean water vapor specific humidity [kg/kg] + real(r8) :: landfrac ! Land fraction + real(r8) :: snowh ! Snow depth (liquid water equivalent) + + real(r8) :: a ! Stratus fraction + real(r8) :: Ga ! dU/da + + ! Local variables + integer :: i ! Loop indexes + real(r8) dV ! Width of triangular PDF + real(r8) cldrh ! RH of stratus cloud + real(r8) rhmin ! Critical RH + real(r8) rhwght + + ! Statement functions + logical land + land(i) = nint(landfrac_in(i)) == 1 + + ! ---------- ! + ! Parameters ! + ! ---------- ! + + cldrh = 1.0_r8 + + rhminl = rhminl_const + rhminl_adj_land = rhminl_adj_land_const + rhminh = rhminh_const + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + a_out(:) = 0._r8 + Ga_out(:) = 0._r8 + + do i = 1, ncol + + U = U_in(i) + p = p_in(i) + qv = qv_in(i) + landfrac = landfrac_in(i) + snowh = snowh_in(i) + + if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) + if (present(rhminh_in)) rhminh = rhminh_in(i) + + if( p .ge. premib ) then + + if( land(i) .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + if( freeze_dry ) then + a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + endif + + elseif( p .lt. premit ) then + + rhmin = rhminh + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + else + + rhwght = (premib-(max(p,premit)))/(premib-premit) + + ! if( land(i) .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + + dV = cldrh - rhmin + + if( U .ge. 1._r8 ) then + a = 1._r8 + Ga = 1.e10_r8 + elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then + a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) + Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) + elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 + Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) + elseif( U .le. (cldrh-dV) ) then + a = 0._r8 + Ga = 1.e10_r8 + endif + + endif + + a_out(i) = a + Ga_out(i) = Ga + + enddo + +end subroutine astG_PDF +!================================================================================================ + +subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & + rhminl_in, rhminl_adj_land_in, rhminh_in ) + + ! --------------------------------------------------------- ! + ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! + ! CAM35 cloud fraction formula. ! + ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! + ! For the other cases, I should re-define 'rhminl,rhminh' & ! + ! 'premib,premit'. ! + ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! + ! G is discontinuous across U = 1. ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: U ! Relative humidity + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(in) :: qv ! Grid-mean water vapor specific humidity [kg/kg] + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: a ! Stratus fraction + real(r8), intent(out) :: Ga ! dU/da + real(r8), optional, intent(out) :: orhmin ! Critical RH + + real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus + + ! Local variables + real(r8) rhmin ! Critical RH + real(r8) rhdif ! Factor for stratus fraction + real(r8) rhwght + + real(r8) :: rhminl + real(r8) :: rhminl_adj_land + real(r8) :: rhminh + + ! Statement functions + logical land + land = nint(landfrac) == 1 + + rhminl = rhminl_const + if (present(rhminl_in)) rhminl = rhminl_in + rhminl_adj_land = rhminl_adj_land_const + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in + rhminh = rhminh_const + if (present(rhminh_in)) rhminh = rhminh_in + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + if( p .ge. premib ) then + + if( land .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0.0_r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e20_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + if( freeze_dry ) then + a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + endif + + elseif( p .lt. premit ) then + + rhmin = rhminh + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0._r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e20_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + + else + + rhwght = (premib-(max(p,premit)))/(premib-premit) + + ! if( land .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0._r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e10_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + + endif + + if (present(orhmin)) orhmin = rhmin + +end subroutine astG_RHU_single + +!================================================================================================ + +subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, ncol, & + rhminl_in, rhminl_adj_land_in, rhminh_in ) + + ! --------------------------------------------------------- ! + ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! + ! CAM35 cloud fraction formula. ! + ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! + ! For the other cases, I should re-define 'rhminl,rhminh' & ! + ! 'premib,premit'. ! + ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! + ! G is discontinuous across U = 1. ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: U_in(pcols) ! Relative humidity + real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa] + real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor specific humidity [kg/kg] + real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction + real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: a_out(pcols) ! Stratus fraction + real(r8), intent(out) :: Ga_out(pcols) ! dU/da + integer, intent(in) :: ncol + + real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus + + real(r8) :: U ! Relative humidity + real(r8) :: p ! Pressure [Pa] + real(r8) :: qv ! Grid-mean water vapor specific humidity [kg/kg] + real(r8) :: landfrac ! Land fraction + real(r8) :: snowh ! Snow depth (liquid water equivalent) + + real(r8) :: rhminl ! Critical relative humidity for low-level liquid stratus + real(r8) :: rhminl_adj_land ! Adjustment drop of rhminl over the land + real(r8) :: rhminh ! Critical relative humidity for high-level liquid stratus + + real(r8) :: a ! Stratus fraction + real(r8) :: Ga ! dU/da + + ! Local variables + integer i + real(r8) rhmin ! Critical RH + real(r8) rhdif ! Factor for stratus fraction + real(r8) rhwght + + ! Statement functions + logical land + land(i) = nint(landfrac_in(i)) == 1 + + rhminl = rhminl_const + rhminl_adj_land = rhminl_adj_land_const + rhminh = rhminh_const + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + a_out(:) = 0._r8 + Ga_out(:) = 0._r8 + + do i = 1, ncol + + U = U_in(i) + p = p_in(i) + qv = qv_in(i) + landfrac = landfrac_in(i) + snowh = snowh_in(i) + + if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) + if (present(rhminh_in)) rhminh = rhminh_in(i) + + if( p .ge. premib ) then + + if( land(i) .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0.0_r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e20_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + if( freeze_dry ) then + a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + endif + + elseif( p .lt. premit ) then + + rhmin = rhminh + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0._r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e20_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + + else + + rhwght = (premib-(max(p,premit)))/(premib-premit) + + ! if( land(i) .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + + rhdif = (U-rhmin)/(1.0_r8-rhmin) + a = min(1._r8,(max(rhdif,0._r8))**2) + if( (U.ge.1._r8) .or. (U.le.rhmin) ) then + Ga = 1.e10_r8 + else + Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) + endif + + endif + + a_out(i) = a + Ga_out(i) = Ga + + enddo + +end subroutine astG_RHU + +!================================================================================================ + +subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & + rhmaxi_in, rhmini_in, rhminl_in, rhminl_adj_land_in, rhminh_in, & + qsatfac_out) + + ! --------------------------------------------------------- ! + ! Compute non-physical ice stratus fraction ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: qv ! Grid-mean water vapor[kg/kg] + real(r8), intent(in) :: T ! Temperature + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(in) :: qi ! Grid-mean ice water content [kg/kg] + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: aist ! Non-physical ice stratus fraction ( 0<= aist <= 1 ) + + real(r8), optional, intent(in) :: rhmaxi_in + real(r8), optional, intent(in) :: rhmini_in ! Critical relative humidity for ice stratus + real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus + real(r8), optional, intent(out) :: qsatfac_out ! Subgrid scaling factor for qsat + + ! Local variables + real(r8) rhmin ! Critical RH + real(r8) rhwght + + real(r8) a,b,c,as,bs,cs ! Fit parameters + real(r8) Kc ! Constant for ice cloud calc (wood & field) + real(r8) ttmp ! Limited temperature + real(r8) icicval ! Empirical IWC value [ kg/kg ] + real(r8) rho ! Local air density + real(r8) esl ! Liq sat vapor pressure + real(r8) esi ! Ice sat vapor pressure + real(r8) ncf,phi ! Wilson and Ballard parameters + real(r8) es, qs + + real(r8) rhi ! grid box averaged relative humidity over ice + real(r8) minice ! minimum grid box avg ice for having a 'cloud' + real(r8) mincld ! minimum ice cloud fraction threshold + real(r8) icimr ! in cloud ice mixing ratio + real(r8) rhdif ! working variable for slingo scheme + + real(r8) :: rhmaxi + real(r8) :: rhmini + real(r8) :: rhminl + real(r8) :: rhminl_adj_land + real(r8) :: rhminh + + ! Statement functions + logical land + land = nint(landfrac) == 1 + + ! --------- ! + ! Constants ! + ! --------- ! + + ! Wang and Sassen IWC paramters ( Option.1 ) + a = 26.87_r8 + b = 0.569_r8 + c = 0.002892_r8 + ! Schiller parameters ( Option.2 ) + as = -68.4202_r8 + bs = 0.983917_r8 + cs = 2.81795_r8 + ! Wood and Field parameters ( Option.3 ) + Kc = 75._r8 + ! Wilson & Ballard closure ( Option.4. smaller = more ice clouds) + ! Slingo modified (option 5) + minice = 1.e-12_r8 + mincld = 1.e-4_r8 + + rhmaxi = rhmaxi_const + if (present(rhmaxi_in)) rhmaxi = rhmaxi_in + rhmini = rhmini_const + if (present(rhmini_in)) rhmini = rhmini_in + rhminl = rhminl_const + if (present(rhminl_in)) rhminl = rhminl_in + rhminl_adj_land = rhminl_adj_land_const + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in + rhminh = rhminh_const + if (present(rhminh_in)) rhminh = rhminh_in + if (present(qsatfac_out)) qsatfac_out = 1.0_r8 + + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + call qsat_water(T, p, es, qs) + esl = svp_water(T) + esi = svp_ice(T) + + if( iceopt.lt.3 ) then + if( iceopt.eq.1 ) then + ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8 + icicval = a + b * ttmp + c * ttmp**2._r8 + rho = p/(rair*T) + icicval = icicval * 1.e-6_r8 / rho + else + ttmp = max(190._r8,min(T,273.16_r8)) + icicval = 10._r8 **(as * bs**ttmp + cs) + icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8 + endif + aist = max(0._r8,min(qi/icicval,1._r8)) + elseif( iceopt.eq.3 ) then + aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl))) + aist = max(0._r8,min(aist,1._r8)) + elseif( iceopt.eq.4) then + if( p .ge. premib ) then + if( land .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + elseif( p .lt. premit ) then + rhmin = rhminh + else + rhwght = (premib-(max(p,premit)))/(premib-premit) + ! if( land .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + endif + ncf = qi/((1._r8 - icecrit)*qs) + if( ncf.le.0._r8 ) then + aist = 0._r8 + elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then + aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8) + elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then + phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8 + aist = (1._r8 - 4._r8 * cos(phi) * cos(phi)) + else + aist = 1._r8 + endif + aist = max(0._r8,min(aist,1._r8)) + elseif (iceopt.eq.5) then + ! set rh ice cloud fraction + rhi= (qv+qi)/qs * (esl/esi) + if (rhmaxi .eq. rhmini) then + if (rhi .gt. rhmini) then + rhdif = 1._r8 + else + rhdif = 0._r8 + end if + else + rhdif = (rhi-rhmini) / (rhmaxi - rhmini) + end if + aist = min(1.0_r8, max(rhdif,0._r8)**2) + + ! Similar to alpha in Wilson & Ballard (1999), determine a + ! scaling factor for saturation vapor pressure that reflects + ! the cloud fraction, rhmini, and rhmaxi. + ! + ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less. + if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then + qsatfac_out = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi) + end if + + ! limiter to remove empty cloud and ice with no cloud + ! and set icecld fraction to mincld if ice exists + + if (qi.lt.minice) then + aist=0._r8 + else + aist=max(mincld,aist) + endif + + ! enforce limits on icimr + if (qi.ge.minice) then + icimr=qi/aist + + !minimum + if (icimr.lt.qist_min) then + aist = max(0._r8,min(1._r8,qi/qist_min)) + endif + !maximum + if (icimr.gt.qist_max) then + aist = max(0._r8,min(1._r8,qi/qist_max)) + endif + + endif + endif + + ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate + ! computed after updating 'qi_st'. + + aist = max(0._r8,min(aist,0.999_r8)) + +end subroutine aist_single + +!================================================================================================ + +subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, aist_out, ncol, & + rhmaxi_in, rhmini_in, rhminl_in, rhminl_adj_land_in, rhminh_in, & + qsatfac_out ) + + ! --------------------------------------------------------- ! + ! Compute non-physical ice stratus fraction ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor[kg/kg] + real(r8), intent(in) :: T_in(pcols) ! Temperature + real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa] + real(r8), intent(in) :: qi_in(pcols) ! Grid-mean ice water content [kg/kg] + real(r8), intent(in) :: ni_in(pcols) ! Grid-mean ice water number concentration [#/kg] + real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction + real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent) + + real(r8), intent(out) :: aist_out(pcols) ! Non-physical ice stratus fraction ( 0<= aist <= 1 ) + integer, intent(in) :: ncol + + real(r8), optional, intent(in) :: rhmaxi_in(pcols) + real(r8), optional, intent(in) :: rhmini_in(pcols) ! Critical relative humidity for ice stratus + real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus + real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land + real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus + real(r8), optional, intent(out) :: qsatfac_out(pcols) ! Subgrid scaling factor for qsat + + ! Local variables + + real(r8) qv ! Grid-mean water vapor[kg/kg] + real(r8) T ! Temperature + real(r8) p ! Pressure [Pa] + real(r8) qi ! Grid-mean ice water content [kg/kg] + real(r8) ni + real(r8) landfrac ! Land fraction + real(r8) snowh ! Snow depth (liquid water equivalent) + + real(r8) rhmaxi ! Critical relative humidity for ice stratus + real(r8) rhmini ! Critical relative humidity for ice stratus + real(r8) rhminl ! Critical relative humidity for low-level liquid stratus + real(r8) rhminl_adj_land ! Adjustment drop of rhminl over the land + real(r8) rhminh ! Critical relative humidity for high-level liquid stratus + + real(r8) aist ! Non-physical ice stratus fraction ( 0<= aist <= 1 ) + + real(r8) rhmin ! Critical RH + real(r8) rhwght + + real(r8) a,b,c,as,bs,cs,ah,bh,ch ! Fit parameters + real(r8) nil + real(r8) Kc ! Constant for ice cloud calc (wood & field) + real(r8) ttmp ! Limited temperature + real(r8) icicval ! Empirical IWC value [ kg/kg ] + real(r8) rho ! Local air density + real(r8) esl ! Liq sat vapor pressure + real(r8) esi ! Ice sat vapor pressure + real(r8) ncf,phi ! Wilson and Ballard parameters + real(r8) qs + real(r8) esat_in(pcols) + real(r8) qsat_in(pcols) + + real(r8) rhi ! grid box averaged relative humidity over ice + real(r8) minice ! minimum grid box avg ice for having a 'cloud' + real(r8) mincld ! minimum ice cloud fraction threshold + real(r8) icimr ! in cloud ice mixing ratio + real(r8) rhdif ! working variable for slingo scheme + + integer i + + + ! Statement functions + logical land + land(i) = nint(landfrac_in(i)) == 1 + + ! --------- ! + ! Constants ! + ! --------- ! + + ! Wang and Sassen IWC paramters ( Option.1 ) + a = 26.87_r8 + b = 0.569_r8 + c = 0.002892_r8 + ! Schiller parameters ( Option.2 ) + as = -68.4202_r8 + bs = 0.983917_r8 + cs = 2.81795_r8 + ! Wood and Field parameters ( Option.3 ) + Kc = 75._r8 + ! Wilson & Ballard closure ( Option.4. smaller = more ice clouds) + ! Slingo modified (option 5) + minice = 1.e-12_r8 + mincld = 1.e-4_r8 + + rhmaxi = rhmaxi_const + + rhmini = rhmini_const + rhminl = rhminl_const + rhminl_adj_land = rhminl_adj_land_const + rhminh = rhminh_const + + if (present(qsatfac_out)) qsatfac_out = 1.0_r8 + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + aist_out(:) = 0._r8 + esat_in(:) = 0._r8 + qsat_in(:) = 0._r8 + + call qsat_water(T_in(1:ncol), p_in(1:ncol), & + esat_in(1:ncol), qsat_in(1:ncol)) + + do i = 1, ncol + + landfrac = landfrac_in(i) + snowh = snowh_in(i) + T = T_in(i) + qv = qv_in(i) + p = p_in(i) + qi = qi_in(i) + ni = ni_in(i) + qs = qsat_in(i) + esl = svp_water(T) + esi = svp_ice(T) + + if (present(rhmaxi_in)) rhmaxi = rhmaxi_in(i) + if (present(rhmini_in)) rhmini = rhmini_in(i) + if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) + if (present(rhminh_in)) rhminh = rhminh_in(i) + + if( iceopt.lt.3 ) then + if( iceopt.eq.1 ) then + ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8 + icicval = a + b * ttmp + c * ttmp**2._r8 + rho = p/(rair*T) + icicval = icicval * 1.e-6_r8 / rho + else + ttmp = max(190._r8,min(T,273.16_r8)) + icicval = 10._r8 **(as * bs**ttmp + cs) + icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8 + endif + aist = max(0._r8,min(qi/icicval,1._r8)) + elseif( iceopt.eq.3 ) then + aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl))) + aist = max(0._r8,min(aist,1._r8)) + elseif( iceopt.eq.4) then + if( p .ge. premib ) then + if( land(i) .and. (snowh.le.0.000001_r8) ) then + rhmin = rhminl - rhminl_adj_land + else + rhmin = rhminl + endif + elseif( p .lt. premit ) then + rhmin = rhminh + else + rhwght = (premib-(max(p,premit)))/(premib-premit) + ! if( land(i) .and. (snowh.le.0.000001_r8) ) then + ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + ! else + rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + ! endif + endif + ncf = qi/((1._r8 - icecrit)*qs) + if( ncf.le.0._r8 ) then + aist = 0._r8 + elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then + aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8) + elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then + phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8 + aist = (1._r8 - 4._r8 * cos(phi) * cos(phi)) + else + aist = 1._r8 + endif + aist = max(0._r8,min(aist,1._r8)) + elseif (iceopt.eq.5) then + ! set rh ice cloud fraction + rhi= (qv+qi)/qs * (esl/esi) + if (rhmaxi .eq. rhmini) then + if (rhi .gt. rhmini) then + rhdif = 1._r8 + else + rhdif = 0._r8 + end if + else + rhdif = (rhi-rhmini) / (rhmaxi - rhmini) + end if + aist = min(1.0_r8, max(rhdif,0._r8)**2) + + elseif (iceopt.eq.6) then + !----- ICE CLOUD OPTION 6: fit based on T and Number (Gettelman: based on Heymsfield obs) + ! Use observations from Heymsfield et al 2012 of IWC and Ni v. Temp + ! Multivariate fit follows form of Boudala 2002: ICIWC = a * exp(b*T) * N^c + ! a=6.73e-8, b=0.05, c=0.349 + ! N is #/L, so need to convert Ni_L=N*rhoa/1000. + ah= 6.73834e-08_r8 + bh= 0.0533110_r8 + ch= 0.3493813_r8 + rho=p/(rair*T) + nil=ni*rho/1000._r8 + icicval = ah * exp(bh*T) * nil**ch + !result is in g m-3, convert to kg H2O / kg air (icimr...) + icicval = icicval / rho / 1000._r8 + aist = max(0._r8,min(qi/icicval,1._r8)) + aist = min(aist,1._r8) + + endif + + if (iceopt.eq.5 .or. iceopt.eq.6) then + + ! Similar to alpha in Wilson & Ballard (1999), determine a + ! scaling factor for saturation vapor pressure that reflects + ! the cloud fraction, rhmini, and rhmaxi. + ! + ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less. + if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then + qsatfac_out(i) = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi) + end if + + ! limiter to remove empty cloud and ice with no cloud + ! and set icecld fraction to mincld if ice exists + + if (qi.lt.minice) then + aist=0._r8 + else + aist=max(mincld,aist) + endif + + ! enforce limits on icimr + if (qi.ge.minice) then + icimr=qi/aist + + !minimum + if (icimr.lt.qist_min) then + aist = max(0._r8,min(1._r8,qi/qist_min)) + endif + !maximum + if (icimr.gt.qist_max) then + aist = max(0._r8,min(1._r8,qi/qist_max)) + endif + + endif + endif + + ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate + ! computed after updating 'qi_st'. + + aist = max(0._r8,min(aist,0.999_r8)) + + aist_out(i) = aist + + enddo + +end subroutine aist_vector + +!================================================================================================ + +end module cldfrc2m diff --git a/src/physics/cam/cldwat.F90 b/src/physics/cam/cldwat.F90 new file mode 100644 index 0000000000..6522bb9917 --- /dev/null +++ b/src/physics/cam/cldwat.F90 @@ -0,0 +1,1286 @@ +#undef DEBUG +module cldwat +!----------------------------------------------------------------------- +! +! Purpose: Prognostic cloud water data and methods. +! +! Public interfaces: +! +! inimc -- Initialize constants +! pcond -- Calculate prognostic condensate +! +! Author: P. Rasch, with Modifications by Minghua Zhang +! January 2010, modified by J. Kay to add precip fluxes for COSP simulator +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use physconst, only: latvap, latice, cpair + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use ref_pres, only: top_lev => trop_cloud_top_lev + + implicit none + +!----------------------------------------------------------------------- +! PUBLIC: Make default data and interfaces private +!----------------------------------------------------------------------- + private + save + public inimc, pcond ! Public interfaces + public :: cldwat_init + integer, public:: ktop ! Level above 10 hPa + + real(r8),public :: icritc ! threshold for autoconversion of cold ice + real(r8),public :: icritw ! threshold for autoconversion of warm ice +!!$ real(r8),public,parameter:: conke = 1.e-6 ! tunable constant for evaporation of precip +!!$ real(r8),public,parameter:: conke = 2.e-6 ! tunable constant for evaporation of precip + real(r8),public :: conke ! tunable constant for evaporation of precip + real(r8),public :: r3lcrit ! critical radius where liq conversion begins + +!----------------------------------------------------------------------- +! PRIVATE: Everything else is private to this module +!----------------------------------------------------------------------- + real(r8), private:: rhonot ! air density at surface + real(r8), private:: t0 ! Freezing temperature + real(r8), private:: cldmin ! assumed minimum cloud amount + real(r8), private:: small ! small number compared to unity + real(r8), private:: c ! constant for graupel like snow cm**(1-d)/s + real(r8), private:: d ! constant for graupel like snow + real(r8), private:: esi ! collection efficient for ice by snow + real(r8), private:: esw ! collection efficient for water by snow + real(r8), private:: nos ! particles snow / cm**4 + real(r8), private:: pi ! Mathematical constant + real(r8), private:: gravit ! Gravitational acceleration at surface + real(r8), private:: rh2o + real(r8), private:: prhonos + real(r8), private:: thrpd ! numerical three added to d + real(r8), private:: gam3pd ! gamma function on (3+d) + real(r8), private:: gam4pd ! gamma function on (4+d) + real(r8), private:: rhoi ! ice density + real(r8), private:: rhos ! snow density + real(r8), private:: rhow ! water density + real(r8), private:: mcon01 ! constants used in cloud microphysics + real(r8), private:: mcon02 ! constants used in cloud microphysics + real(r8), private:: mcon03 ! constants used in cloud microphysics + real(r8), private:: mcon04 ! constants used in cloud microphysics + real(r8), private:: mcon05 ! constants used in cloud microphysics + real(r8), private:: mcon06 ! constants used in cloud microphysics + real(r8), private:: mcon07 ! constants used in cloud microphysics + real(r8), private:: mcon08 ! constants used in cloud microphysics + + +! Parameters used in findmcnew + real(r8) :: capnsi ! sea ice cloud particles / cm3 + real(r8) :: capnc ! cold and oceanic cloud particles / cm3 + real(r8) :: capnw ! warm continental cloud particles / cm3 + real(r8) :: kconst ! const for terminal velocity (stokes regime) + real(r8) :: effc ! collection efficiency + real(r8) :: alpha ! ratio of 3rd moment radius to 2nd + real(r8) :: capc ! constant for autoconversion + real(r8) :: convfw ! constant used for fall velocity calculation + real(r8) :: cracw ! constant used for rain accreting water + real(r8) :: critpr ! critical precip rate collection efficiency changes + real(r8) :: ciautb ! coefficient of autoconversion of ice (1/s) + real(r8) :: psrhmin ! condensation threshold in polar stratosphere + logical :: do_psrhmin + +#ifdef DEBUG + integer, private,parameter :: nlook = 1 ! Number of points to examine + integer, private :: ilook(nlook) ! Longitude index to examine + integer, private :: latlook(nlook) ! Latitude index to examine + integer, private :: lchnklook(nlook) ! Chunk index to examine + integer, private :: icollook(nlook) ! Column index to examine +#endif + +contains +!=============================================================================== +subroutine cldwat_init(icritw_in, icritc_in, conke_in, r3lcrit_in, psrhmin_in, do_psrhmin_in ) + + real(r8), intent(in) :: icritw_in ! icritw = threshold for autoconversion of warm ice + real(r8), intent(in) :: icritc_in ! icritc = threshold for autoconversion of cold ice + real(r8), intent(in) :: conke_in ! conke = tunable constant for evaporation of precip + real(r8), intent(in) :: r3lcrit_in ! r3lcrit = critical radius where liq conversion begins + real(r8), intent(in) :: psrhmin_in ! condensation threadhold in polar stratosphere + logical, intent(in) :: do_psrhmin_in + + icritw = icritw_in + icritc = icritc_in + conke = conke_in + r3lcrit = r3lcrit_in + psrhmin = psrhmin_in + do_psrhmin = do_psrhmin_in + + end subroutine cldwat_init + +subroutine inimc( tmeltx, rhonotx, gravitx, rh2ox) +!----------------------------------------------------------------------- +! +! Purpose: +! initialize constants for the prognostic condensate +! +! Author: P. Rasch, April 1997 +! +!----------------------------------------------------------------------- + use pmgrid, only: plev, plevp + use ref_pres, only: pref_mid + + integer k + real(r8), intent(in) :: tmeltx + real(r8), intent(in) :: rhonotx + real(r8), intent(in) :: gravitx + real(r8), intent(in) :: rh2ox + +#ifdef UNICOSMP + real(r8) signgam ! variable required by cray gamma function + external gamma +#endif + + rhonot = rhonotx ! air density at surface (gm/cm3) + gravit = gravitx + rh2o = rh2ox + rhos = .1_r8 ! assumed snow density (gm/cm3) + rhow = 1._r8 ! water density + rhoi = 1._r8 ! ice density + esi = 1.0_r8 ! collection efficient for ice by snow + esw = 0.1_r8 ! collection efficient for water by snow + t0 = tmeltx ! approximate freezing temp + cldmin = 0.02_r8 ! assumed minimum cloud amount + small = 1.e-22_r8 ! a small number compared to unity + c = 152.93_r8 ! constant for graupel like snow cm**(1-d)/s + d = 0.25_r8 ! constant for graupel like snow + nos = 3.e-2_r8 ! particles snow / cm**4 + pi = 4._r8*atan(1.0_r8) + prhonos = pi*rhos*nos + thrpd = 3._r8 + d + if (d==0.25_r8) then + gam3pd = 2.549256966718531_r8 ! only right for d = 0.25 + gam4pd = 8.285085141835282_r8 + else +#ifdef UNICOSMP + call gamma(3._r8+d, signgam, gam3pd) + gam3pd = sign(exp(gam3pd),signgam) + call gamma(4._r8+d, signgam, gam4pd) + gam4pd = sign(exp(gam4pd),signgam) + write(iulog,*) ' d, gamma(3+d), gamma(4+d) =', gam3pd, gam4pd +#else + call endrun(' can only use d ne 0.25 on a cray ') +#endif + endif + mcon01 = pi*nos*c*gam3pd/4._r8 + mcon02 = 1._r8/(c*gam4pd*sqrt(rhonot)/(6*prhonos**(d/4._r8))) + mcon03 = -(0.5_r8+d/4._r8) + mcon04 = 4._r8/(4._r8+d) + mcon05 = (3+d)/(4+d) + mcon06 = (3+d)/4._r8 + mcon07 = mcon01*sqrt(rhonot)*mcon02**mcon05/prhonos**mcon06 + mcon08 = -0.5_r8/(4._r8+d) + + if( masterproc ) write(iulog,*) 'cloud water initialization by inimc complete ' + +! Initialize parameters used by findmcnew + capnw = 400._r8 ! warm continental cloud particles / cm3 + capnc = 150._r8 ! cold and oceanic cloud particles / cm3 +! capnsi = 40._r8 ! sea ice cloud particles density / cm3 + capnsi = 75._r8 ! sea ice cloud particles density / cm3 + + kconst = 1.18e6_r8 ! const for terminal velocity + +! effc = 1._r8 ! autoconv collection efficiency following boucher 96 +! effc = .55*0.05_r8 ! autoconv collection efficiency following baker 93 + effc = 0.55_r8 ! autoconv collection efficiency following tripoli and cotton +! effc = 0._r8 ! turn off warm-cloud autoconv + alpha = 1.1_r8**4 + capc = pi**(-.333_r8)*kconst*effc *(0.75_r8)**(1.333_r8)*alpha ! constant for autoconversion + +! critical precip rate at which we assume the collector drops can change the +! drop size enough to enhance the auto-conversion process (mm/day) + critpr = 0.5_r8 + convfw = 1.94_r8*2.13_r8*sqrt(rhow*1000._r8*9.81_r8*2.7e-4_r8) + +! liquid microphysics +! cracw = 6_r8 ! beheng + cracw = .884_r8*sqrt(9.81_r8/(rhow*1000._r8*2.7e-4_r8)) ! tripoli and cotton + +! ice microphysics + ciautb = 5.e-4_r8 + + if ( masterproc ) then + write(iulog,*)'tuning parameters cldwat: icritw',icritw,'icritc',icritc,'conke',conke,'r3lcrit',r3lcrit + write(iulog,*)'tuning parameters cldwat: capnw',capnw,'capnc',capnc,'capnsi',capnsi,'kconst',kconst + write(iulog,*)'tuning parameters cldwat: effc',effc,'alpha',alpha,'capc',capc + write(iulog,*)'tuning parameters cldwat: critpr',critpr,'convfw',convfw,'cracw',cracw,'ciautb',ciautb + endif + +end subroutine inimc + +subroutine pcond (lchnk ,ncol ,troplev ,dlat , & + tn ,ttend ,qn ,qtend ,omega , & + cwat ,p ,pdel ,cldn ,fice , fsnow, & + cme ,prodprec,prodsnow,evapprec,evapsnow,evapheat, prfzheat, & + meltheat,precip ,snowab ,deltat ,fwaut , & + fsaut ,fracw ,fsacw ,fsaci ,lctend , & + rhdfda ,rhu00 ,landm ,seaicef ,zi ,ice2pr, liq2pr, & + liq2snow, snowh, rkflxprc, rkflxsnw, pracwo, psacwo, psacio) +!----------------------------------------------------------------------- +! +! Purpose: +! The public interface to the cloud water parameterization +! returns tendencies to water vapor, temperature and cloud water variables +! +! For basic method +! See: Rasch, P. J, and J. E. Kristjansson, A Comparison of the CCM3 +! model climate using diagnosed and +! predicted condensate parameterizations, 1998, J. Clim., 11, +! pp1587---1614. +! +! For important modifications to improve the method of determining +! condensation/evaporation see Zhang et al (2001, in preparation) +! +! Authors: M. Zhang, W. Lin, P. Rasch and J.E. Kristjansson +! B. A. Boville (latent heat of fusion) +!----------------------------------------------------------------------- + use wv_saturation, only: qsat, estblf, svp_to_qsat, findsp_vc + use physconst, only: epsilo +! +!--------------------------------------------------------------------- +! +! Input Arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: troplev(pcols) ! tropopause level + real(r8), intent(in) :: dlat(pcols) ! latitudes in degrees + real(r8), intent(in) :: fice(pcols,pver) ! fraction of cwat that is ice + real(r8), intent(in) :: fsnow(pcols,pver) ! fraction of rain that freezes to snow + real(r8), intent(in) :: cldn(pcols,pver) ! new value of cloud fraction (fraction) + real(r8), intent(in) :: cwat(pcols,pver) ! cloud water (kg/kg) + real(r8), intent(in) :: omega(pcols,pver) ! vert pressure vel (Pa/s) + real(r8), intent(in) :: p(pcols,pver) ! pressure (K) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness (Pa) + real(r8), intent(in) :: qn(pcols,pver) ! new water vapor (kg/kg) + real(r8), intent(in) :: qtend(pcols,pver) ! mixing ratio tend (kg/kg/s) + real(r8), intent(in) :: tn(pcols,pver) ! new temperature (K) + real(r8), intent(in) :: ttend(pcols,pver) ! temp tendencies (K/s) + real(r8), intent(in) :: deltat ! time step to advance solution over + real(r8), intent(in) :: lctend(pcols,pver) ! cloud liquid water tendencies ====wlin + real(r8), intent(in) :: rhdfda(pcols,pver) ! dG(a)/da, rh=G(a), when rh>u00 ====wlin + real(r8), intent(in) :: rhu00 (pcols,pver) ! Rhlim for cloud ====wlin + real(r8), intent(in) :: landm(pcols) ! Land fraction ramped over water (fraction) + real(r8), intent(in) :: seaicef(pcols) ! sea ice fraction (fraction) + real(r8), intent(in) :: zi(pcols,pverp) ! layer interfaces (m) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) +! +! Output Arguments +! + real(r8), intent(out) :: cme (pcols,pver) ! rate of cond-evap of condensate (1/s) + real(r8), intent(out) :: prodprec(pcols,pver) ! rate of conversion of condensate to precip (1/s) + real(r8), intent(out) :: evapprec(pcols,pver) ! rate of evaporation of falling precip (1/s) + real(r8), intent(out) :: evapsnow(pcols,pver) ! rate of evaporation of falling snow (1/s) + real(r8), intent(out) :: evapheat(pcols,pver) ! heating rate due to evaporation of precip (W/kg) + real(r8), intent(out) :: prfzheat(pcols,pver) ! heating rate due to freezing of precip (W/kg) + real(r8), intent(out) :: meltheat(pcols,pver) ! heating rate due to snow melt (W/kg) + real(r8), intent(out) :: precip(pcols) ! rate of precipitation (kg / (m**2 * s)) + real(r8), intent(out) :: snowab(pcols) ! rate of snow (kg / (m**2 * s)) + real(r8), intent(out) :: ice2pr(pcols,pver) ! rate of conversion of ice to precip + real(r8), intent(out) :: liq2pr(pcols,pver) ! rate of conversion of liquid to precip + real(r8), intent(out) :: liq2snow(pcols,pver) ! rate of conversion of liquid to snow + real(r8), intent(out) :: rkflxprc(pcols,pverp) ! grid-box mean RK flux_large_scale_cloud_rain+snow at interfaces (kg m^-2 s^-1) + real(r8), intent(out) :: rkflxsnw(pcols,pverp) ! grid-box mean RK flux_large_scale_cloud_snow at interfaces (kg m^-2 s^-1) +! intent(out)s here for pcond to pass to stratiform.F90 to be addflded/outflded + real(r8), intent(out) :: pracwo(pcols,pver) ! accretion of cloud water by rain (1/s) + real(r8), intent(out) :: psacwo(pcols,pver) ! accretion of cloud water by snow (1/s) + real(r8), intent(out) :: psacio(pcols,pver) ! accretion of cloud ice by snow (1/s) + + real(r8) nice2pr ! rate of conversion of ice to snow + real(r8) nliq2pr ! rate of conversion of liquid to precip + real(r8) nliq2snow ! rate of conversion of liquid to snow + real(r8) prodsnow(pcols,pver) ! rate of production of snow + +! +! Local workspace +! + real(r8) :: precab(pcols) ! rate of precipitation (kg / (m**2 * s)) + integer i ! work variable + integer iter ! #iterations for precipitation calculation + integer k ! work variable + integer l ! work variable + + real(r8) cldm(pcols) ! mean cloud fraction over the time step + real(r8) cldmax(pcols) ! max cloud fraction above + real(r8) coef(pcols) ! conversion time scale for condensate to rain + real(r8) cwm(pcols) ! cwat mixing ratio at midpoint of time step + real(r8) cwn(pcols) ! cwat mixing ratio at end + real(r8) denom ! work variable + real(r8) dqsdt ! change in sat spec. hum. wrt temperature + real(r8) es(pcols) ! sat. vapor pressure + real(r8) fracw(pcols,pver) ! relative importance of collection of liquid by rain + real(r8) fsaci(pcols,pver) ! relative importance of collection of ice by snow + real(r8) fsacw(pcols,pver) ! relative importance of collection of liquid by snow + real(r8) fsaut(pcols,pver) ! relative importance of ice auto conversion + real(r8) fwaut(pcols,pver) ! relative importance of warm cloud autoconversion + real(r8) gamma(pcols) ! d qs / dT + real(r8) icwc(pcols) ! in-cloud water content (kg/kg) + real(r8) mincld ! a small cloud fraction to avoid / zero + real(r8),parameter ::omsm=0.99999_r8 ! a number just less than unity (for rounding) + real(r8) prprov(pcols) ! provisional value of precip at btm of layer + real(r8) prtmp ! work variable + real(r8) q(pcols,pver) ! mixing ratio before time step ignoring condensate + real(r8) qs(pcols) ! spec. hum. of water vapor + real(r8) qsn, esn ! work variable + real(r8) qsp(pcols,pver) ! sat pt mixing ratio + real(r8) qtl(pcols) ! tendency which would saturate the grid box in deltat + real(r8) qtmp, ttmp ! work variable + real(r8) relhum1(pcols) ! relative humidity + real(r8) relhum(pcols) ! relative humidity +!!$ real(r8) tc ! crit temp of transition to ice + real(r8) t(pcols,pver) ! temp before time step ignoring condensate + real(r8) tsp(pcols,pver) ! sat pt temperature + real(r8) pol ! work variable + real(r8) cdt ! work variable + real(r8) wtthick ! work variable + +! Extra local work space for cloud scheme modification + + real(r8) cpohl !cpair/Latvap + real(r8) hlocp !Latvap/cpair + real(r8) dto2 !0.5*deltat (delta=2.0*dt) + real(r8) calpha(pcols) !alpha of new C - E scheme formulation + real(r8) cbeta (pcols) !beta of new C - E scheme formulation + real(r8) cbetah(pcols) !beta_hat at saturation portion + real(r8) cgamma(pcols) !gamma of new C - E scheme formulation + real(r8) cgamah(pcols) !gamma_hat at saturation portion + real(r8) rcgama(pcols) !gamma/gamma_hat + real(r8) csigma(pcols) !sigma of new C - E scheme formulation + real(r8) cmec1 (pcols) !c1 of new C - E scheme formulation + real(r8) cmec2 (pcols) !c2 of new C - E scheme formulation + real(r8) cmec3 (pcols) !c3 of new C - E scheme formulation + real(r8) cmec4 (pcols) !c4 of new C - E scheme formulation + real(r8) cmeres(pcols) !residual cond of over-sat after cme and evapprec + real(r8) ctmp !a scalar representation of cmeres + real(r8) clrh2o ! Ratio of latvap to water vapor gas const + real(r8) ice(pcols,pver) ! ice mixing ratio + real(r8) liq(pcols,pver) ! liquid mixing ratio + real(r8) rcwn(pcols,2,pver), rliq(pcols,2,pver), rice(pcols,2,pver) + real(r8) cwnsave(pcols,2,pver), cmesave(pcols,2,pver) + real(r8) prodprecsave(pcols,2,pver) + logical error_found + + real(r8) :: rhu_adj(pcols,pver) ! adjusted rhlim for dehydration +! +!------------------------------------------------------------ +! + clrh2o = latvap/rh2o ! Ratio of latvap to water vapor gas const +#ifdef PERGRO + mincld = 1.e-4_r8 + iter = 1 ! number of times to iterate the precipitation calculation +#else + mincld = 1.e-4_r8 + iter = 2 +#endif +! omsm = 0.99999 + cpohl = cpair/latvap + hlocp = latvap/cpair + dto2=0.5_r8*deltat +! +! Constant for computing rate of evaporation of precipitation: +! +!!$ conke = 1.e-5 +!!$ conke = 1.e-6 +! +! initialize a few single level fields +! + do i = 1,ncol + precip(i) = 0.0_r8 + precab(i) = 0.0_r8 + snowab(i) = 0.0_r8 + cldmax(i) = 0.0_r8 + end do +! +! initialize multi-level fields +! + do k = 1,pver + do i = 1,ncol + q(i,k) = qn(i,k) + t(i,k) = tn(i,k) +! q(i,k)=qn(i,k)-qtend(i,k)*deltat +! t(i,k)=tn(i,k)-ttend(i,k)*deltat + end do + end do + cme (:ncol,:) = 0._r8 + evapprec(:ncol,:) = 0._r8 + prodprec(:ncol,:) = 0._r8 + evapsnow(:ncol,:) = 0._r8 + prodsnow(:ncol,:) = 0._r8 + evapheat(:ncol,:) = 0._r8 + meltheat(:ncol,:) = 0._r8 + prfzheat(:ncol,:) = 0._r8 + ice2pr(:ncol,:) = 0._r8 + liq2pr(:ncol,:) = 0._r8 + liq2snow(:ncol,:) = 0._r8 + fwaut(:ncol,:) = 0._r8 + fsaut(:ncol,:) = 0._r8 + fracw(:ncol,:) = 0._r8 + fsacw(:ncol,:) = 0._r8 + fsaci(:ncol,:) = 0._r8 + rkflxprc(:ncol,:) = 0._r8 + rkflxsnw(:ncol,:) = 0._r8 + + pracwo(:ncol,:) = 0._r8 + psacwo(:ncol,:) = 0._r8 + psacio(:ncol,:) = 0._r8 +! +! find the wet bulb temp and saturation value +! for the provisional t and q without condensation +! + do 800 k = top_lev,pver + + ! "True" means that ice will be taken into account. + call findsp_vc(qn(:ncol,k), tn(:ncol,k), p(:ncol,k), .true., & + tsp(:ncol,k), qsp(:ncol,k)) + + call qsat(t(:ncol,k), p(:ncol,k), & + es(:ncol), qs(:ncol), gam=gamma(:ncol)) + do i = 1,ncol + relhum(i) = q(i,k)/qs(i) +! + cldm(i) = max(cldn(i,k),mincld) +! +! the max cloud fraction above this level +! + cldmax(i) = max(cldmax(i), cldm(i)) + +! define the coefficients for C - E calculation + + calpha(i) = 1.0_r8/qs(i) + cbeta (i) = q(i,k)/qs(i)**2*gamma(i)*cpohl + cbetah(i) = 1.0_r8/qs(i)*gamma(i)*cpohl + cgamma(i) = calpha(i)+latvap*cbeta(i)/cpair + cgamah(i) = calpha(i)+latvap*cbetah(i)/cpair + rcgama(i) = cgamma(i)/cgamah(i) + + if(cldm(i) > mincld) then + icwc(i) = max(0._r8,cwat(i,k)/cldm(i)) + else + icwc(i) = 0.0_r8 + endif +!PJR the above logic give zero icwc with nonzero cwat, dont like it! +!PJR generates problems with csigma +!PJR set the icwc to a very small number, so we can start from zero cloud cover and make some clouds +! icwc(i) = max(1.e-8_r8,cwat(i,k)/cldm(i)) + +! +! initial guess of evaporation, will be updated within iteration +! + evapprec(i,k) = conke*(1._r8 - cldm(i))*sqrt(precab(i)) & + *(1._r8 - min(relhum(i),1._r8)) + +! +! zero cmeres before iteration for each level +! + cmeres(i)=0.0_r8 + + end do + do i = 1,ncol +! +! fractions of ice at this level +! +!!$ tc = t(i,k) - t0 +!!$ fice(i,k) = max(0._r8,min(-tc*0.05,1.0_r8)) +! +! calculate the cooling due to a phase change of the rainwater +! from above +! + if (t(i,k) >= t0) then + meltheat(i,k) = -latice * snowab(i) * gravit/pdel(i,k) + snowab(i) = 0._r8 + else + meltheat(i,k) = 0._r8 + endif + end do + +! +! calculate cme and formation of precip. +! +! The cloud microphysics is highly nonlinear and coupled with cme +! Both rain processes and cme are calculated iteratively. +! + do 100 l = 1,iter + + do i = 1,ncol + +! +! calculation of cme has 4 scenarios +! ================================== +! + call relhum_min_adj( ncol, troplev, dlat, rhu00, rhu_adj ) + + if(relhum(i) > rhu_adj(i,k)) then + + ! 1. whole grid saturation + ! ======================== + if(relhum(i) >= 0.999_r8 .or. cldm(i) >= 0.999_r8 ) then + cme(i,k)=(calpha(i)*qtend(i,k)-cbetah(i)*ttend(i,k))/cgamah(i) + + ! 2. fractional saturation + ! ======================== + else + if (rhdfda(i,k) .eq. 0._r8 .and. icwc(i).eq.0._r8) then + write (iulog,*) ' cldwat.F90: empty rh cloud ', i, k, lchnk + write (iulog,*) ' relhum, iter ', relhum(i), l, rhu_adj(i,k), cldm(i), cldn(i,k) + call endrun () + endif + csigma(i) = 1.0_r8/(rhdfda(i,k)+cgamma(i)*icwc(i)) + cmec1(i) = (1.0_r8-cldm(i))*csigma(i)*rhdfda(i,k) + cmec2(i) = cldm(i)*calpha(i)/cgamah(i)+(1.0_r8-rcgama(i)*cldm(i))* & + csigma(i)*calpha(i)*icwc(i) + cmec3(i) = cldm(i)*cbetah(i)/cgamah(i) + & + (cbeta(i)-rcgama(i)*cldm(i)*cbetah(i))*csigma(i)*icwc(i) + cmec4(i) = csigma(i)*cgamma(i)*icwc(i) + + ! Q=C-E=-C1*Al + C2*Aq - C3* At + C4*Er + + cme(i,k) = -cmec1(i)*lctend(i,k) + cmec2(i)*qtend(i,k) & + -cmec3(i)*ttend(i,k) + cmec4(i)*evapprec(i,k) + endif + + ! 3. when rh < rhu00, evaporate existing cloud water + ! ================================================== + else if(cwat(i,k) > 0.0_r8)then + ! liquid water should be evaporated but not to exceed + ! saturation point. if qn > qsp, not to evaporate cwat + cme(i,k)=-min(max(0._r8,qsp(i,k)-qn(i,k)),cwat(i,k))/deltat + + ! 4. no condensation nor evaporation + ! ================================== + else + cme(i,k)=0.0_r8 + endif + + + end do !end loop for cme update + +! Because of the finite time step, +! place a bound here not to exceed wet bulb point +! and not to evaporate more than available water +! + do i = 1, ncol + qtmp = qn(i,k) - cme(i,k)*deltat + +! possibilities to have qtmp > qsp +! +! 1. if qn > qs(tn), it condenses; +! if after applying cme, qtmp > qsp, more condensation is applied. +! +! 2. if qn < qs, evaporation should not exceed qsp, + + if(qtmp > qsp(i,k)) then + cme(i,k) = cme(i,k) + (qtmp-qsp(i,k))/deltat + endif + +! +! if net evaporation, it should not exceed available cwat +! + if(cme(i,k) < -cwat(i,k)/deltat) & + cme(i,k) = -cwat(i,k)/deltat +! +! addition of residual condensation from previous step of iteration +! + cme(i,k) = cme(i,k) + cmeres(i) + + end do + + ! limit cme for roundoff errors + do i = 1, ncol + cme(i,k) = cme(i,k)*omsm + end do + + do i = 1,ncol +! +! as a safe limit, condensation should not reduce grid mean rh below rhu00 +! + if(cme(i,k) > 0.0_r8 .and. relhum(i) > rhu_adj(i,k) ) & + cme(i,k) = min(cme(i,k), (qn(i,k)-qs(i)*rhu_adj(i,k))/deltat) +! +! initial guess for cwm (mean cloud water over time step) if 1st iteration +! + if(l < 2) then + cwm(i) = max(cwat(i,k)+cme(i,k)*dto2, 0._r8) + endif + + enddo + +! provisional precipitation falling through model layer + do i = 1,ncol +!!$ prprov(i) = precab(i) + prodprec(i,k)*pdel(i,k)/gravit +! rain produced in this layer not too effective in collection process + wtthick = max(0._r8,min(0.5_r8,((zi(i,k)-zi(i,k+1))/1000._r8)**2)) + prprov(i) = precab(i) + wtthick*prodprec(i,k)*pdel(i,k)/gravit + end do + +! calculate conversion of condensate to precipitation by cloud microphysics + call findmcnew (lchnk ,ncol , & + k ,prprov ,snowab, t ,p , & + cwm ,cldm ,cldmax ,fice(1,k),coef , & + fwaut(1,k),fsaut(1,k),fracw(1,k),fsacw(1,k),fsaci(1,k), & + landm, seaicef, snowh, pracwo(1,k), psacwo(1,k), psacio(1,k)) + +! +! calculate the precip rate +! + error_found = .false. + do i = 1,ncol + if (cldm(i) > 0) then +! +! first predict the cloud water +! + cdt = coef(i)*deltat + if (cdt > 0.01_r8) then + pol = cme(i,k)/coef(i) ! production over loss + cwn(i) = max(0._r8,(cwat(i,k)-pol)*exp(-cdt)+ pol) + else + cwn(i) = max(0._r8,(cwat(i,k) + cme(i,k)*deltat)/(1+cdt)) + endif +! +! now back out the tendency of net rain production +! + prodprec(i,k) = max(0._r8,cme(i,k)-(cwn(i)-cwat(i,k))/deltat) + else + prodprec(i,k) = 0.0_r8 + cwn(i) = 0._r8 + endif + + ! provisional calculation of conversion terms + ice2pr(i,k) = prodprec(i,k)*(fsaut(i,k)+fsaci(i,k)) + liq2pr(i,k) = prodprec(i,k)*(fwaut(i,k)+fsacw(i,k)+fracw(i,k)) +!old liq2snow(i,k) = prodprec(i,k)*fsacw(i,k) + +! revision suggested by Jim McCaa +! it controls the amount of snow hitting the sfc +! by forcing a lot of conversion of cloud liquid to snow phase +! it might be better done later by an explicit representation of +! rain accreting ice (and freezing), or by an explicit freezing of raindrops + liq2snow(i,k) = max(prodprec(i,k)*fsacw(i,k), fsnow(i,k)*liq2pr(i,k)) + + ! bounds + nice2pr = min(ice2pr(i,k),(cwat(i,k)+cme(i,k)*deltat)*fice(i,k)/deltat) + nliq2pr = min(liq2pr(i,k),(cwat(i,k)+cme(i,k)*deltat)*(1._r8-fice(i,k))/deltat) +! write(iulog,*) ' prodprec ', i, k, prodprec(i,k) +! write(iulog,*) ' nliq2pr, nice2pr ', nliq2pr, nice2pr + if (liq2pr(i,k).ne.0._r8) then + nliq2snow = liq2snow(i,k)*nliq2pr/liq2pr(i,k) ! correction + else + nliq2snow = liq2snow(i,k) + endif + +! avoid roundoff problems generating negatives + nliq2snow = nliq2snow*omsm + nliq2pr = nliq2pr*omsm + nice2pr = nice2pr*omsm + +! final estimates of conversion to precip and snow + prodprec(i,k) = (nliq2pr + nice2pr) + prodsnow(i,k) = (nice2pr + nliq2snow) + + rcwn(i,l,k) = cwat(i,k) + (cme(i,k)- prodprec(i,k))*deltat + rliq(i,l,k) = (cwat(i,k) + cme(i,k)*deltat)*(1._r8-fice(i,k)) - nliq2pr * deltat + rice(i,l,k) = (cwat(i,k) + cme(i,k)*deltat)* fice(i,k) - nice2pr *deltat + +! Save for sanity check later... +! Putting sanity checks inside loops 100 and 800 screws up the +! IBM compiler for reasons as yet unknown. TBH + cwnsave(i,l,k) = cwn(i) + cmesave(i,l,k) = cme(i,k) + prodprecsave(i,l,k) = prodprec(i,k) +! End of save for sanity check later... + +! final version of condensate to precip terms + liq2pr(i,k) = nliq2pr + liq2snow(i,k) = nliq2snow + ice2pr(i,k) = nice2pr + + cwn(i) = rcwn(i,l,k) +! +! update any remaining provisional values +! + cwm(i) = (cwn(i) + cwat(i,k))*0.5_r8 +! +! update in cloud water +! + if(cldm(i) > mincld) then + icwc(i) = cwm(i)/cldm(i) + else + icwc(i) = 0.0_r8 + endif +!PJR the above logic give zero icwc with nonzero cwat, dont like it! +!PJR generates problems with csigma +!PJR set the icwc to a very small number, so we can start from zero cloud cover and make some clouds +! icwc(i) = max(1.e-8_r8,cwm(i)/cldm(i)) + + end do ! end of do i = 1,ncol + +! +! calculate provisional value of cloud water for +! evaporation of precipitate (evapprec) calculation +! + do i = 1,ncol + qtmp = qn(i,k) - cme(i,k)*deltat + ttmp = tn(i,k) + deltat/cpair * ( meltheat(i,k) & + + (latvap + latice*fice(i,k)) * cme(i,k) ) + esn = estblf(ttmp) + qsn = svp_to_qsat(esn, p(i,k)) + qtl(i) = max((qsn - qtmp)/deltat,0._r8) + relhum1(i) = qtmp/qsn + end do +! + do i = 1,ncol +#ifdef PERGRO + evapprec(i,k) = conke*(1._r8 - max(cldm(i),mincld))* & + sqrt(precab(i))*(1._r8 - min(relhum1(i),1._r8)) +#else + evapprec(i,k) = conke*(1._r8 - cldm(i))*sqrt(precab(i)) & + *(1._r8 - min(relhum1(i),1._r8)) +#endif +! +! limit the evaporation to the amount which is entering the box +! or saturates the box +! + prtmp = precab(i)*gravit/pdel(i,k) + evapprec(i,k) = min(evapprec(i,k), prtmp, qtl(i))*omsm +#ifdef PERGRO +! zeroing needed for pert growth + evapprec(i,k) = 0._r8 +#endif +! +! Partition evaporation of precipitate between rain and snow using +! the fraction of snow falling into the box. Determine the heating +! due to evaporation. Note that evaporation is positive (loss of precip, +! gain of vapor) and that heating is negative. + if (evapprec(i,k) > 0._r8) then + evapsnow(i,k) = evapprec(i,k) * snowab(i) / precab(i) + evapheat(i,k) = -latvap * evapprec(i,k) - latice * evapsnow(i,k) + else + evapsnow(i,k) = 0._r8 + evapheat(i,k) = 0._r8 + end if +! Account for the latent heat of fusion for liquid drops collected by falling snow + prfzheat(i,k) = latice * liq2snow(i,k) + end do + +! now remove the residual of any over-saturation. Normally, +! the oversaturated water vapor should have been removed by +! cme formulation plus constraints by wet bulb tsp/qsp +! as computed above. However, because of non-linearity, +! addition of (cme-evapprec) to update t and q may still cause +! a very small amount of over saturation. It is called a +! residual of over-saturation because theoretically, cme +! should have taken care of all of large scale condensation. +! + + do i = 1,ncol + qtmp = qn(i,k)-(cme(i,k)-evapprec(i,k))*deltat + ttmp = tn(i,k) + deltat/cpair * ( meltheat(i,k) + evapheat(i,k) + prfzheat(i,k) & + + (latvap + latice*fice(i,k)) * cme(i,k) ) + + call qsat(ttmp, p(i,k), esn, qsn, dqsdt=dqsdt) + + if( qtmp > qsn ) then + ! + !now extra condensation to bring air to just saturation + ! + ctmp = (qtmp-qsn)/(1._r8+hlocp*dqsdt)/deltat + cme(i,k) = cme(i,k)+ctmp +! +! save residual on cmeres to addtion to cme on entering next iteration +! cme exit here contain the residual but overrided if back to iteration +! + cmeres(i) = ctmp + else + cmeres(i) = 0.0_r8 + endif + end do + + 100 continue ! end of do l = 1,iter + +! +! precipitation +! + do i = 1,ncol + precip(i) = precip(i) + pdel(i,k)/gravit * (prodprec(i,k) - evapprec(i,k)) + precab(i) = precab(i) + pdel(i,k)/gravit * (prodprec(i,k) - evapprec(i,k)) + if(precab(i).lt.0._r8) precab(i)=0._r8 +! snowab(i) = snowab(i) + pdel(i,k)/gravit * (prodprec(i,k)*fice(i,k) - evapsnow(i,k)) + snowab(i) = snowab(i) + pdel(i,k)/gravit * (prodsnow(i,k) - evapsnow(i,k)) + + ! If temperature above freezing, all precip is rain flux. if temperature below freezing, all precip is snow flux. + rkflxprc(i,k+1) = precab(i) !! making this consistent with other precip fluxes. prc = rain + snow + !!rkflxprc(i,k+1) = precab(i) - snowab(i) + rkflxsnw(i,k+1) = snowab(i) + +!!$ if ((precab(i)) < 1.e-10) then +!!$ precab(i) = 0. +!!$ snowab(i) = 0. +!!$ endif + end do + 800 continue ! level loop (k=1,pver) + +! begin sanity checks + error_found = .false. + do k = top_lev,pver + do l = 1,iter + do i = 1,ncol + if (abs(rcwn(i,l,k)).lt.1.e-300_r8) rcwn(i,l,k) = 0._r8 + if (abs(rliq(i,l,k)).lt.1.e-300_r8) rliq(i,l,k) = 0._r8 + if (abs(rice(i,l,k)).lt.1.e-300_r8) rice(i,l,k) = 0._r8 + if (rcwn(i,l,k).lt.0._r8) error_found = .true. + if (rliq(i,l,k).lt.0._r8) error_found = .true. + if (rice(i,l,k).lt.0._r8) error_found = .true. + enddo + enddo + enddo + if (error_found) then + do k = top_lev,pver + do l = 1,iter + do i = 1,ncol + if (rcwn(i,l,k).lt.0._r8) then + write(iulog,*) ' prob with neg rcwn1 ', rcwn(i,l,k), & + cwnsave(i,l,k) + write(iulog,*) ' cwat, cme*deltat, prodprec*deltat ', & + cwat(i,k), cmesave(i,l,k)*deltat, & + prodprecsave(i,l,k)*deltat, & + (cmesave(i,l,k)-prodprecsave(i,l,k))*deltat + call endrun('PCOND') + endif + if (rliq(i,l,k).lt.0._r8) then + write(iulog,*) ' prob with neg rliq1 ', rliq(i,l,k) + call endrun('PCOND') + endif + if (rice(i,l,k).lt.0._r8) then + write(iulog,*) ' prob with neg rice ', rice(i,l,k) + call endrun('PCOND') + endif + enddo + enddo + enddo + end if +! end sanity checks + + return +end subroutine pcond + +!############################################################################## + +subroutine findmcnew (lchnk ,ncol , & + k ,precab ,snowab, t ,p , & + cwm ,cldm ,cldmax ,fice ,coef , & + fwaut ,fsaut ,fracw ,fsacw ,fsaci , & + landm ,seaicef ,snowh ,pracwo ,psacwo ,psacio ) + +!----------------------------------------------------------------------- +! +! Purpose: +! calculate the conversion of condensate to precipitate +! +! Method: +! See: Rasch, P. J, and J. E. Kristjansson, A Comparison of the CCM3 +! model climate using diagnosed and +! predicted condensate parameterizations, 1998, J. Clim., 11, +! pp1587---1614. +! +! Author: P. Rasch +! +!----------------------------------------------------------------------- + use phys_grid, only: get_rlat_all_p +! +! input args +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: k ! level index + + real(r8), intent(in) :: precab(pcols) ! rate of precipitation from above (kg / (m**2 * s)) + real(r8), intent(in) :: t(pcols,pver) ! temperature (K) + real(r8), intent(in) :: p(pcols,pver) ! pressure (Pa) + real(r8), intent(in) :: cldm(pcols) ! cloud fraction + real(r8), intent(in) :: cldmax(pcols) ! max cloud fraction above this level + real(r8), intent(in) :: cwm(pcols) ! condensate mixing ratio (kg/kg) + real(r8), intent(in) :: fice(pcols) ! fraction of cwat that is ice + real(r8), intent(in) :: landm(pcols) ! Land fraction ramped over water + real(r8), intent(in) :: seaicef(pcols) ! sea ice fraction + real(r8), intent(in) :: snowab(pcols) ! rate of snow from above (kg / (m**2 * s)) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) + +! output arguments + real(r8), intent(out) :: coef(pcols) ! conversion rate (1/s) + real(r8), intent(out) :: fwaut(pcols) ! relative importance of liquid autoconversion (a diagnostic) + real(r8), intent(out) :: fsaut(pcols) ! relative importance of ice autoconversion (a diagnostic) + real(r8), intent(out) :: fracw(pcols) ! relative importance of rain accreting liquid (a diagnostic) + real(r8), intent(out) :: fsacw(pcols) ! relative importance of snow accreting liquid (a diagnostic) + real(r8), intent(out) :: fsaci(pcols) ! relative importance of snow accreting ice (a diagnostic) + real(r8), intent(out) :: pracwo(pcols) ! accretion of cloud water by rain (1/s) + real(r8), intent(out) :: psacwo(pcols) ! accretion of cloud water by snow (1/s) + real(r8), intent(out) :: psacio(pcols) ! accretion of cloud ice by snow (1/s) + + +! work variables + + integer i + integer ii + integer ind(pcols) + integer ncols + + real(r8), parameter :: degrad = 57.296_r8 ! divide by this to convert degrees to radians + real(r8) capn ! local cloud particles / cm3 + real(r8) capnoice ! local cloud particles when not over sea ice / cm3 + real(r8) ciaut ! coefficient of autoconversion of ice (1/s) + real(r8) cldloc(pcols) ! non-zero amount of cloud + real(r8) cldpr(pcols) ! assumed cloudy volume occupied by rain and cloud + real(r8) con1 ! work constant + real(r8) con2 ! work constant + real(r8) csacx ! constant used for snow accreting liquid or ice +!!$ real(r8) dtice ! interval for transition from liquid to ice + real(r8) icemr(pcols) ! in-cloud ice mixing ratio + real(r8) icrit ! threshold for autoconversion of ice + real(r8) liqmr(pcols) ! in-cloud liquid water mixing ratio + real(r8) pracw ! rate of rain accreting water + real(r8) prlloc(pcols) ! local rain flux in mm/day + real(r8) prscgs(pcols) ! local snow amount in cgs units + real(r8) psaci ! rate of collection of ice by snow (lin et al 1983) + real(r8) psacw ! rate of collection of liquid by snow (lin et al 1983) + real(r8) psaut ! rate of autoconversion of ice condensate + real(r8) ptot ! total rate of conversion + real(r8) pwaut ! rate of autoconversion of liquid condensate + real(r8) r3l ! volume radius + real(r8) rainmr(pcols) ! in-cloud rain mixing ratio + real(r8) rat1 ! work constant + real(r8) rat2 ! work constant +!!$ real(r8) rdtice ! recipricol of dtice + real(r8) rho(pcols) ! density (mks units) + real(r8) rhocgs ! density (cgs units) + real(r8) rlat(pcols) ! latitude (radians) + real(r8) snowfr ! fraction of precipate existing as snow + real(r8) totmr(pcols) ! in-cloud total condensate mixing ratio + real(r8) vfallw ! fall speed of precipitate as liquid + real(r8) wp ! weight factor used in calculating pressure dep of autoconversion + real(r8) wsi ! weight factor for sea ice + real(r8) wt ! fraction of ice + real(r8) wland ! fraction of land + +! real(r8) csaci +! real(r8) csacw +! real(r8) cwaut +! real(r8) efact +! real(r8) lamdas +! real(r8) lcrit +! real(r8) rcwm +! real(r8) r3lc2 +! real(r8) snowmr(pcols) +! real(r8) vfalls + + real(r8) ftot + +! inline statement functions + real(r8) heavy, heavym, a1, a2, heavyp, heavymp + heavy(a1,a2) = max(0._r8,sign(1._r8,a1-a2)) ! heavyside function + heavym(a1,a2) = max(0.01_r8,sign(1._r8,a1-a2)) ! modified heavyside function +! +! New heavyside functions to perhaps address error growth problems +! + heavyp(a1,a2) = a1/(a2+a1+1.e-36_r8) + heavymp(a1,a2) = (a1+0.01_r8*a2)/(a2+a1+1.e-36_r8) + +! +! find all the points where we need to do the microphysics +! and set the output variables to zero +! + ncols = 0 + do i = 1,ncol + coef(i) = 0._r8 + fwaut(i) = 0._r8 + fsaut(i) = 0._r8 + fracw(i) = 0._r8 + fsacw(i) = 0._r8 + fsaci(i) = 0._r8 + liqmr(i) = 0._r8 + rainmr(i) = 0._r8 + if (cwm(i) > 1.e-20_r8) then + ncols = ncols + 1 + ind(ncols) = i + endif + end do + + do ii = 1,ncols + i = ind(ii) +! +! the local cloudiness at this level +! + cldloc(i) = max(cldmin,cldm(i)) +! +! a weighted mean between max cloudiness above, and this layer +! + cldpr(i) = max(cldmin,(cldmax(i)+cldm(i))*0.5_r8) +! +! decompose the suspended condensate into +! an incloud liquid and ice phase component +! + totmr(i) = cwm(i)/cldloc(i) + icemr(i) = totmr(i)*fice(i) + liqmr(i) = totmr(i)*(1._r8-fice(i)) +! +! density +! + rho(i) = p(i,k)/(287._r8*t(i,k)) + rhocgs = rho(i)*1.e-3_r8 ! density in cgs units +! +! decompose the precipitate into a liquid and ice phase +! + if (t(i,k) > t0) then + vfallw = convfw/sqrt(rho(i)) + rainmr(i) = precab(i)/(rho(i)*vfallw*cldpr(i)) + snowfr = 0 +! snowmr(i) + else + snowfr = 1 + rainmr(i) = 0._r8 + endif +! rainmr(i) = (precab(i)-snowab(i))/(rho(i)*vfallw*cldpr(i)) +! +! local snow amount in cgs units +! + prscgs(i) = precab(i)/cldpr(i)*0.1_r8*snowfr +! prscgs(i) = snowab(i)/cldpr(i)*0.1 +! +! local rain amount in mm/day +! + prlloc(i) = precab(i)*86400._r8/cldpr(i) + end do + + con1 = 1._r8/(1.333_r8*pi)**0.333_r8 * 0.01_r8 ! meters +! +! calculate the conversion terms +! + call get_rlat_all_p(lchnk, ncol, rlat) + + do ii = 1,ncols + i = ind(ii) + rhocgs = rho(i)*1.e-3_r8 ! density in cgs units +! +! exponential temperature factor +! +! efact = exp(0.025*(t(i,k)-t0)) +! +! some temperature dependent constants +! +!!$ wt = min(1._r8,max(0._r8,(t0-t(i,k))*rdtice)) + wt = fice(i) + icrit = icritc*wt + icritw*(1-wt) +! +! jrm Reworked droplet number concentration algorithm + ! Start with pressure-dependent value appropriate for continental air + ! Note: reltab has a temperature dependence here + capn = capnw + (capnc-capnw) * min(1._r8,max(0._r8,1.0_r8-(p(i,k)-0.8_r8*p(i,pver))/(0.2_r8*p(i,pver)))) + ! Modify for snow depth over land + capn = capn + (capnc-capn) * min(1.0_r8,max(0.0_r8,snowh(i)*10._r8)) + ! Ramp between polluted value over land to clean value over ocean. + capn = capn + (capnc-capn) * min(1.0_r8,max(0.0_r8,1.0_r8-landm(i))) + ! Ramp between the resultant value and a sea ice value in the presence of ice. + capn = capn + (capnsi-capn) * min(1.0_r8,max(0.0_r8,seaicef(i))) +! end jrm +! +#ifdef DEBUG2 + if ( (lat(i) == latlook(1)) .or. (lat(i) == latlook(2)) ) then + if (i == ilook(1)) then + write(iulog,*) ' findmcnew: lat, k, seaicef, landm, wp, capnoice, capn ', & + lat(i), k, seaicef(i), landm(i), wp, capnoice, capn + endif + endif +#endif + +! +! useful terms in following calculations +! + rat1 = rhocgs/rhow + rat2 = liqmr(i)/capn + con2 = (rat1*rat2)**0.333_r8 +! +! volume radius +! +! r3l = (rhocgs*liqmr(i)/(1.333*pi*capn*rhow))**0.333 * 0.01 ! meters + r3l = con1*con2 +! +! critical threshold for autoconversion if modified for mixed phase +! clouds to mimic a bergeron findeisen process +! r3lc2 = r3lcrit*(1.-0.5*fice(i)*(1-fice(i))) +! +! autoconversion of liquid +! +! cwaut = 2.e-4 +! cwaut = 1.e-3 +! lcrit = 2.e-4 +! lcrit = 5.e-4 +! pwaut = max(0._r8,liqmr(i)-lcrit)*cwaut +! +! pwaut is following tripoli and cotton (and many others) +! we reduce the autoconversion below critpr, because these are regions where +! the drop size distribution is likely to imply much smaller collector drops than +! those relevant for a cloud distribution corresponding to the value of effc = 0.55 +! suggested by cotton (see austin 1995 JAS, baker 1993) + +! easy to follow form +! pwaut = capc*liqmr(i)**2*rhocgs/rhow +! $ *(liqmr(i)*rhocgs/(rhow*capn))**(.333) +! $ *heavy(r3l,r3lcrit) +! $ *max(0.10_r8,min(1._r8,prlloc(i)/critpr)) +! somewhat faster form +#define HEAVYNEW +#ifdef HEAVYNEW +!#ifdef PERGRO + pwaut = capc*liqmr(i)**2*rat1*con2*heavymp(r3l,r3lcrit) * & + max(0.10_r8,min(1._r8,prlloc(i)/critpr)) +#else + pwaut = capc*liqmr(i)**2*rat1*con2*heavym(r3l,r3lcrit)* & + max(0.10_r8,min(1._r8,prlloc(i)/critpr)) +#endif +! +! autoconversion of ice +! +! ciaut = ciautb*efact + ciaut = ciautb +! psaut = capc*totmr(i)**2*rhocgs/rhoi +! $ *(totmr(i)*rhocgs/(rhoi*capn))**(.333) +! +! autoconversion of ice condensate +! +#ifdef PERGRO + psaut = heavyp(icemr(i),icrit)*icemr(i)*ciaut +#else + psaut = max(0._r8,icemr(i)-icrit)*ciaut +#endif +! +! collection of liquid by rain +! +! pracw = cracw*rho(i)*liqmr(i)*rainmr(i) !(beheng 1994) + pracw = cracw*rho(i)*sqrt(rho(i))*liqmr(i)*rainmr(i) !(tripoli and cotton) + + pracwo(i)=pracw + +!! pracw = 0. +! +! the following lines calculate the slope parameter and snow mixing ratio +! from the precip rate using the equations found in lin et al 83 +! in the most natural form, but it is expensive, so after some tedious +! algebraic manipulation you can use the cheaper form found below +! vfalls = c*gam4pd/(6*lamdas**d)*sqrt(rhonot/rhocgs) +! $ *0.01 ! convert from cm/s to m/s +! snowmr(i) = snowfr*precab(i)/(rho(i)*vfalls*cldpr(i)) +! snowmr(i) = ( prscgs(i)*mcon02 * (rhocgs**mcon03) )**mcon04 +! lamdas = (prhonos/max(rhocgs*snowmr(i),small))**0.25 +! csacw = mcon01*sqrt(rhonot/rhocgs)/(lamdas**thrpd) +! +! coefficient for collection by snow independent of phase +! + csacx = mcon07*rhocgs**mcon08*prscgs(i)**mcon05 + +! +! collection of liquid by snow (lin et al 1983) +! + psacw = csacx*liqmr(i)*esw +#ifdef PERGRO +! this is necessary for pergro + psacw = 0._r8 +#endif + + psacwo(i)=psacw + +! +! collection of ice by snow (lin et al 1983) +! + psaci = csacx*icemr(i)*esi +! + psacio(i)=psaci + +! total conversion of condensate to precipitate +! + ptot = pwaut + psaut + pracw + psacw + psaci +! +! the recipricol of cloud water amnt (or zero if no cloud water) +! +! rcwm = totmr(i)/(max(totmr(i),small)**2) +! +! turn the tendency back into a loss rate (1/seconds) +! + if (totmr(i) > 0._r8) then + coef(i) = ptot/totmr(i) + else + coef(i) = 0._r8 + endif + + if (ptot.gt.0._r8) then + fwaut(i) = pwaut/ptot + fsaut(i) = psaut/ptot + fracw(i) = pracw/ptot + fsacw(i) = psacw/ptot + fsaci(i) = psaci/ptot + else + fwaut(i) = 0._r8 + fsaut(i) = 0._r8 + fracw(i) = 0._r8 + fsacw(i) = 0._r8 + fsaci(i) = 0._r8 + endif + + ftot = fwaut(i)+fsaut(i)+fracw(i)+fsacw(i)+fsaci(i) +! if (abs(ftot-1._r8).gt.1.e-14_r8.and.ftot.ne.0._r8) then +! write(iulog,*) ' something is wrong in findmcnew ', ftot, & +! fwaut(i),fsaut(i),fracw(i),fsacw(i),fsaci(i) +! write(iulog,*) ' unscaled ', ptot, & +! pwaut,psaut,pracw,psacw,psaci +! write(iulog,*) ' totmr, liqmr, icemr ', totmr(i), liqmr(i), icemr(i) +! call endrun() +! endif + end do +#ifdef DEBUG + i = icollook(nlook) + if (lchnk == lchnklook(nlook) ) then + write(iulog,*) + write(iulog,*) '------', k, i, lchnk + write(iulog,*) ' liqmr, rainmr,precab ', liqmr(i), rainmr(i), precab(i)*8.64e4_r8 + write(iulog,*) ' frac: waut,saut,racw,sacw,saci ', & + fwaut(i), fsaut(i), fracw(i), fsacw(i), fsaci(i) + endif +#endif + + return +end subroutine findmcnew + +!----------------------------------------------------------------------------- +! Sets rhu to a different value poleward of +/- 50 deg latitude and +! levels above the tropopause if cldwat_polstrat_rhmin is specified +! ** This is used only for special waccm/cam-chem cases with cam4 physics ** +!----------------------------------------------------------------------------- +subroutine relhum_min_adj( ncol, troplev, dlat, rhu, rhu_adj ) + + integer, intent(in) :: ncol + integer, intent(in) :: troplev(:) + real(r8), intent(in) :: dlat(:) ! latitudes in degrees + real(r8), intent(in) :: rhu(:,:) + real(r8), intent(out) :: rhu_adj(:,:) + + integer :: i,k + + rhu_adj(:,:) = rhu(:,:) + if ( .not.do_psrhmin ) return + + do k = 1,pver + do i = 1,ncol + if ((k .lt. troplev(i)) .and. & + ( abs( dlat(i) ) .gt. 50._r8 ) ) then + rhu_adj(i,k) = psrhmin + endif + enddo + enddo + +end subroutine relhum_min_adj + +end module cldwat diff --git a/src/physics/cam/cldwat2m_macro.F90 b/src/physics/cam/cldwat2m_macro.F90 new file mode 100644 index 0000000000..5359a644f8 --- /dev/null +++ b/src/physics/cam/cldwat2m_macro.F90 @@ -0,0 +1,2396 @@ + + module cldwat2m_macro + + !--------------------------------------------------- ! + ! Purpose : CAM Interface for Cloud Macrophysics ! + ! Author : Sungsu Park ! + ! Description : Park et al. 2010. ! + ! For questions, contact Sungsu Park ! + ! e-mail : sungsup@ucar.edu ! + ! phone : 303-497-1375 ! + !--------------------------------------------------- ! + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + use physconst, only: cpair, latvap, latice, rh2o, gravit, rair + use wv_saturation, only: qsat_water, svp_water, svp_ice, qsat_ice + use cam_logfile, only: iulog + use ref_pres, only: top_lev=>trop_cloud_top_lev + use cldfrc2m, only: astG_PDF_single, astG_PDF, astG_RHU_single, & + astG_RHU, aist_single, aist_vector, & + rhmini_const, rhmaxi_const + + implicit none + private + save + + public :: & + ini_macro, & + mmacro_pcond + + ! -------------- ! + ! Set Parameters ! + ! -------------- ! + + ! ------------------------------------------------------------------------------- ! + ! Parameter used for selecting generalized critical RH for liquid and ice stratus ! + ! ------------------------------------------------------------------------------- ! + + integer :: i_rhminl ! This is for liquid stratus fraction. + ! If 0 : Original fixed critical RH from the namelist. + ! If 1 : Add convective detrainment effect on the above '0' option. + ! In this case, 'tau_detw' [s] should be specified below. + ! If 2 : Use fully scale-adaptive method. + ! In this case, 'tau_detw' [s] and 'c_aniso' [no unit] should + ! be specified below. + + integer :: i_rhmini ! This is for ice stratus fraction. + ! If 0 : Original fixed critical RH from the namelist. + ! If 1 : Add convective detrainment effect on the above '0' option. + ! In this case, 'tau_deti' [s] should be specified below. + ! If 2 : Use fully scale-adaptive method. + ! In this case, 'tau_deti' [s] and 'c_aniso' [no unit] should + ! be specified below. + ! Note that 'micro_mg_cam' is using below 'rhmini_const', regardless + ! of 'i_rhmini'. This connection should be built in future. + + real(r8), parameter :: tau_detw =100._r8 ! Dissipation time scale of convective liquid condensate detrained + ! into the clear portion. [hr]. 0.5-3 hr is possible. + real(r8), parameter :: tau_deti = 1._r8 ! Dissipation time scale of convective ice condensate detrained + ! into the clear portion. [hr]. 0.5-3 hr is possible. + real(r8), parameter :: c_aniso = 1._r8 ! Inverse of anisotropic factor of PBL turbulence + + ! ----------------------------- ! + ! Parameters for Liquid Stratus ! + ! ----------------------------- ! + + logical, parameter :: CAMstfrac = .false. ! If .true. (.false.), + ! use Slingo (triangular PDF-based) liquid stratus fraction + real(r8), parameter :: qlst_min = 2.e-5_r8 ! Minimum in-stratus LWC constraint [ kg/kg ] + real(r8), parameter :: qlst_max = 3.e-3_r8 ! Maximum in-stratus LWC constraint [ kg/kg ] + real(r8), parameter :: cc = 0.1_r8 ! For newly formed/dissipated in-stratus CWC ( 0 <= cc <= 1 ) + integer, parameter :: niter = 2 ! For iterative computation of QQ with 'ramda' below. + real(r8), parameter :: ramda = 0.5_r8 ! Explicit : ramda = 0, Implicit : ramda = 1 ( 0<= ramda <= 1 ) + real(r8), private :: rhminl_const ! Critical RH for low-level liquid stratus clouds + real(r8), private :: rhminl_adj_land_const ! rhminl adjustment for snowfree land + real(r8), private :: rhminh_const ! Critical RH for high-level liquid stratus clouds + real(r8), private :: premit ! Top height for mid-level liquid stratus fraction + real(r8), private :: premib ! Bottom height for mid-level liquid stratus fraction + + real(r8), parameter :: qsmall = 1.e-18_r8 ! Smallest mixing ratio considered in the macrophysics + + contains + + ! -------------- ! + ! Initialization ! + ! -------------- ! + + subroutine ini_macro(rhminl_opt_in, rhmini_opt_in) + + !--------------------------------------------------------------------- ! + ! ! + ! Purpose: Initialize constants for the liquid stratiform macrophysics ! + ! ! + ! Author: Sungsu Park, Dec.01.2009. ! + ! ! + !--------------------------------------------------------------------- ! + + use cloud_fraction, only: cldfrc_getparams + use cam_history, only: addfld + + integer, intent(in) :: rhminl_opt_in + integer, intent(in) :: rhmini_opt_in + + i_rhminl = rhminl_opt_in + i_rhmini = rhmini_opt_in + + call cldfrc_getparams(rhminl_out=rhminl_const, rhminl_adj_land_out=rhminl_adj_land_const, & + rhminh_out=rhminh_const, premit_out=premit, premib_out=premib) + + if( masterproc ) then + write(iulog,*) 'Park Macrophysics Parameters' + write(iulog,*) ' rhminl = ', rhminl_const + write(iulog,*) ' rhminl_adj_land = ', rhminl_adj_land_const + write(iulog,*) ' rhminh = ', rhminh_const + write(iulog,*) ' premit = ', premit + write(iulog,*) ' premib = ', premib + write(iulog,*) ' i_rhminl = ', i_rhminl + write(iulog,*) ' i_rhmini = ', i_rhmini + end if + + + call addfld ('RHMIN_LIQ', (/ 'lev' /), 'A', 'fraction', 'Default critical RH for liquid-stratus') + call addfld ('RHMIN_ICE', (/ 'lev' /), 'A', 'fraction', 'Default critical RH for ice-stratus') + call addfld ('DRHMINPBL_LIQ', (/ 'lev' /), 'A', 'fraction', 'Drop of liquid-stratus critical RH by PBL turbulence') + call addfld ('DRHMINPBL_ICE', (/ 'lev' /), 'A', 'fraction', 'Drop of ice-stratus critical RH by PBL turbulence') + call addfld ('DRHMINDET_LIQ', (/ 'lev' /), 'A', 'fraction', 'Drop of liquid-stratus critical RH by convective detrainment') + call addfld ('DRHMINDET_ICE', (/ 'lev' /), 'A', 'fraction', 'Drop of ice-stratus critical RH by convective detrainment') + + end subroutine ini_macro + + ! ------------------------------ ! + ! Stratiform Liquid Macrophysics ! + ! ------------------------------ ! + + ! In the version, 'macro --> micro --> advective forcing --> macro...' + ! A_...: only 'advective forcing' without 'microphysical tendency' + ! C_...: only 'microphysical tendency' + ! D_...: only 'detrainment of cumulus condensate' + ! So, 'A' and 'C' are exclusive. + + subroutine mmacro_pcond( lchnk , ncol , dt , p , dp , & + T0 , qv0 , ql0 , qi0 , nl0 , ni0 , & + A_T , A_qv , A_ql , A_qi , A_nl , A_ni , & + C_T , C_qv , C_ql , C_qi , C_nl , C_ni , C_qlst, & + D_T , D_qv , D_ql , D_qi , D_nl , D_ni , & + a_cud , a_cu0 , clrw_old , clri_old , landfrac , snowh , & + tke , qtl_flx , qti_flx , cmfr_det , qlr_det , qir_det , & + s_tendout , qv_tendout , ql_tendout , qi_tendout , nl_tendout , ni_tendout , & + qme , qvadj , qladj , qiadj , qllim , qilim , & + cld , al_st_star , ai_st_star , ql_st_star , qi_st_star , do_cldice ) + + use constituents, only : qmin, cnst_get_ind + use wv_saturation, only : findsp_vc + use cam_history, only : outfld, hist_fld_active + + integer icol + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! Number of active columns + + ! Input-Output variables + + real(r8), intent(inout) :: T0(pcols,pver) ! Temperature [K] + real(r8), intent(inout) :: qv0(pcols,pver) ! Grid-mean water vapor specific humidity [kg/kg] + real(r8), intent(inout) :: ql0(pcols,pver) ! Grid-mean liquid water content [kg/kg] + real(r8), intent(inout) :: qi0(pcols,pver) ! Grid-mean ice water content [kg/kg] + real(r8), intent(inout) :: nl0(pcols,pver) ! Grid-mean number concentration of cloud liquid droplet [#/kg] + real(r8), intent(inout) :: ni0(pcols,pver) ! Grid-mean number concentration of cloud ice droplet [#/kg] + + ! Input variables + + real(r8), intent(in) :: dt ! Model integration time step [s] + real(r8), intent(in) :: p(pcols,pver) ! Pressure at the layer mid-point [Pa] + real(r8), intent(in) :: dp(pcols,pver) ! Pressure thickness [Pa] > 0 + + real(r8), intent(in) :: A_T(pcols,pver) ! Non-microphysical advective external forcing of T [K/s] + real(r8), intent(in) :: A_qv(pcols,pver) ! Non-microphysical advective external forcing of qv [kg/kg/s] + real(r8), intent(in) :: A_ql(pcols,pver) ! Non-microphysical advective external forcing of ql [kg/kg/s] + real(r8), intent(in) :: A_qi(pcols,pver) ! Non-microphysical advective external forcing of qi [kg/kg/s] + real(r8), intent(in) :: A_nl(pcols,pver) ! Non-microphysical advective external forcing of nl [#/kg/s] + real(r8), intent(in) :: A_ni(pcols,pver) ! Non-microphysical advective external forcing of ni [#/kg/s] + + real(r8), intent(in) :: C_T(pcols,pver) ! Microphysical advective external forcing of T [K/s] + real(r8), intent(in) :: C_qv(pcols,pver) ! Microphysical advective external forcing of qv [kg/kg/s] + real(r8), intent(in) :: C_ql(pcols,pver) ! Microphysical advective external forcing of ql [kg/kg/s] + real(r8), intent(in) :: C_qi(pcols,pver) ! Microphysical advective external forcing of qi [kg/kg/s] + real(r8), intent(in) :: C_nl(pcols,pver) ! Microphysical advective external forcing of nl [#/kg/s] + real(r8), intent(in) :: C_ni(pcols,pver) ! Microphysical advective external forcing of ni [#/kg/s] + real(r8), intent(in) :: C_qlst(pcols,pver) ! Microphysical advective external forcing of ql + ! within liquid stratus [kg/kg/s] + + real(r8), intent(in) :: D_T(pcols,pver) ! Cumulus detrainment external forcing of T [K/s] + real(r8), intent(in) :: D_qv(pcols,pver) ! Cumulus detrainment external forcing of qv [kg/kg/s] + real(r8), intent(in) :: D_ql(pcols,pver) ! Cumulus detrainment external forcing of ql [kg/kg/s] + real(r8), intent(in) :: D_qi(pcols,pver) ! Cumulus detrainment external forcing of qi [kg/kg/s] + real(r8), intent(in) :: D_nl(pcols,pver) ! Cumulus detrainment external forcing of nl [#/kg/s] + real(r8), intent(in) :: D_ni(pcols,pver) ! Cumulus detrainment external forcing of qi [#/kg/s] + + real(r8), intent(in) :: a_cud(pcols,pver) ! Old cumulus fraction before update + real(r8), intent(in) :: a_cu0(pcols,pver) ! New cumulus fraction after update + + real(r8), intent(in) :: clrw_old(pcols,pver) ! Clear sky fraction at the previous time step for liquid stratus process + real(r8), intent(in) :: clri_old(pcols,pver) ! Clear sky fraction at the previous time step for ice stratus process + real(r8), pointer :: tke(:,:) ! (pcols,pverp) TKE from the PBL scheme + real(r8), pointer :: qtl_flx(:,:) ! (pcols,pverp) overbar(w'qtl') from PBL scheme where qtl = qv + ql + real(r8), pointer :: qti_flx(:,:) ! (pcols,pverp) overbar(w'qti') from PBL scheme where qti = qv + qi + real(r8), pointer :: cmfr_det(:,:) ! (pcols,pver) Detrained mass flux from the convection scheme + real(r8), pointer :: qlr_det(:,:) ! (pcols,pver) Detrained ql from the convection scheme + real(r8), pointer :: qir_det(:,:) ! (pcols,pver) Detrained qi from the convection scheme + + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: snowh(pcols) ! Snow depth (liquid water equivalent) + logical, intent(in) :: do_cldice ! Whether or not cldice should be prognosed + + ! Output variables + + real(r8), intent(out) :: s_tendout(pcols,pver) ! Net tendency of grid-mean s from 'Micro+Macro' processes [J/kg/s] + real(r8), intent(out) :: qv_tendout(pcols,pver) ! Net tendency of grid-mean qv from 'Micro+Macro' processes [kg/kg/s] + real(r8), intent(out) :: ql_tendout(pcols,pver) ! Net tendency of grid-mean ql from 'Micro+Macro' processes [kg/kg/s] + real(r8), intent(out) :: qi_tendout(pcols,pver) ! Net tendency of grid-mean qi from 'Micro+Macro' processes [kg/kg/s] + real(r8), intent(out) :: nl_tendout(pcols,pver) ! Net tendency of grid-mean nl from 'Micro+Macro' processes [#/kg/s] + real(r8), intent(out) :: ni_tendout(pcols,pver) ! Net tendency of grid-mean ni from 'Micro+Macro' processes [#/kg/s] + + real(r8), intent(out) :: qme (pcols,pver) ! Net condensation rate [kg/kg/s] + real(r8), intent(out) :: qvadj(pcols,pver) ! adjustment tendency from "positive_moisture" call (vapor) + real(r8), intent(out) :: qladj(pcols,pver) ! adjustment tendency from "positive_moisture" call (liquid) + real(r8), intent(out) :: qiadj(pcols,pver) ! adjustment tendency from "positive_moisture" call (ice) + real(r8), intent(out) :: qllim(pcols,pver) ! tendency from "instratus_condensate" call (liquid) + real(r8), intent(out) :: qilim(pcols,pver) ! tendency from "instratus_condensate" call (ice) + + real(r8), intent(out) :: cld(pcols,pver) ! Net cloud fraction ( 0 <= cld <= 1 ) + real(r8), intent(out) :: al_st_star(pcols,pver) ! Physical liquid stratus fraction + real(r8), intent(out) :: ai_st_star(pcols,pver) ! Physical ice stratus fraction + real(r8), intent(out) :: ql_st_star(pcols,pver) ! In-stratus LWC [kg/kg] + real(r8), intent(out) :: qi_st_star(pcols,pver) ! In-stratus IWC [kg/kg] + + ! --------------- ! + ! Local variables ! + ! --------------- ! + integer :: ixcldliq, ixcldice + + integer :: i, j, k, iter, ii, jj ! Loop indexes + + ! Thermodynamic state variables + + real(r8) T(pcols,pver) ! Temperature of equilibrium reference state + ! from which 'Micro & Macro' are computed [K] + real(r8) T1(pcols,pver) ! Temperature after 'fice_force' on T01 + real(r8) T_0(pcols,pver) ! Temperature after 'instratus_condensate' on T1 + real(r8) T_05(pcols,pver) ! Temperature after 'advection' on T_0 + real(r8) T_prime0(pcols,pver) ! Temperature after 'Macrophysics (QQ)' on T_05star + real(r8) T_dprime(pcols,pver) ! Temperature after 'fice_force' on T_prime + real(r8) T_star(pcols,pver) ! Temperature after 'instratus_condensate' on T_dprime + + real(r8) qv(pcols,pver) ! Grid-mean qv of equilibrium reference state from which + ! 'Micro & Macro' are computed [kg/kg] + real(r8) qv1(pcols,pver) ! Grid-mean qv after 'fice_force' on qv01 + real(r8) qv_0(pcols,pver) ! Grid-mean qv after 'instratus_condensate' on qv1 + real(r8) qv_05(pcols,pver) ! Grid-mean qv after 'advection' on qv_0 + real(r8) qv_prime0(pcols,pver) ! Grid-mean qv after 'Macrophysics (QQ)' on qv_05star + real(r8) qv_dprime(pcols,pver) ! Grid-mean qv after 'fice_force' on qv_prime + real(r8) qv_star(pcols,pver) ! Grid-mean qv after 'instratus_condensate' on qv_dprime + + real(r8) ql(pcols,pver) ! Grid-mean ql of equilibrium reference state from which + ! 'Micro & Macro' are computed [kg/kg] + real(r8) ql1(pcols,pver) ! Grid-mean ql after 'fice_force' on ql01 + real(r8) ql_0(pcols,pver) ! Grid-mean ql after 'instratus_condensate' on ql1 + real(r8) ql_05(pcols,pver) ! Grid-mean ql after 'advection' on ql_0 + real(r8) ql_prime0(pcols,pver) ! Grid-mean ql after 'Macrophysics (QQ)' on ql_05star + real(r8) ql_dprime(pcols,pver) ! Grid-mean ql after 'fice_force' on ql_prime + real(r8) ql_star(pcols,pver) ! Grid-mean ql after 'instratus_condensate' on ql_dprime + + real(r8) qi(pcols,pver) ! Grid-mean qi of equilibrium reference state from which + ! 'Micro & Macro' are computed [kg/kg] + real(r8) qi1(pcols,pver) ! Grid-mean qi after 'fice_force' on qi01 + real(r8) qi_0(pcols,pver) ! Grid-mean qi after 'instratus_condensate' on qi1 + real(r8) qi_05(pcols,pver) ! Grid-mean qi after 'advection' on qi_0 + real(r8) qi_prime0(pcols,pver) ! Grid-mean qi after 'Macrophysics (QQ)' on qi_05star + real(r8) qi_dprime(pcols,pver) ! Grid-mean qi after 'fice_force' on qi_prime + real(r8) qi_star(pcols,pver) ! Grid-mean qi after 'instratus_condensate' on qi_dprime + + real(r8) nl(pcols,pver) ! Grid-mean nl of equilibrium reference state from which + ! 'Micro & Macro' are computed [kg/kg] + real(r8) nl1(pcols,pver) ! Grid-mean nl after 'fice_force' on nl01 + real(r8) nl_0(pcols,pver) ! Grid-mean nl after 'instratus_condensate' on nl1 + real(r8) nl_05(pcols,pver) ! Grid-mean nl after 'advection' on nl_0 + real(r8) nl_prime0(pcols,pver) ! Grid-mean nl after 'Macrophysics (QQ)' on nl_05star + real(r8) nl_dprime(pcols,pver) ! Grid-mean nl after 'fice_force' on nl_prime + real(r8) nl_star(pcols,pver) ! Grid-mean nl after 'instratus_condensate' on nl_dprime + + real(r8) ni(pcols,pver) ! Grid-mean ni of equilibrium reference state from which + ! 'Micro & Macro' are computed [kg/kg] + real(r8) ni1(pcols,pver) ! Grid-mean ni after 'fice_force' on ni01 + real(r8) ni_0(pcols,pver) ! Grid-mean ni after 'instratus_condensate' on ni1 + real(r8) ni_05(pcols,pver) ! Grid-mean ni after 'advection' on ni_0 + real(r8) ni_prime0(pcols,pver) ! Grid-mean ni after 'Macrophysics (QQ)' on ni_05star + real(r8) ni_dprime(pcols,pver) ! Grid-mean ni after 'fice_force' on ni_prime + real(r8) ni_star(pcols,pver) ! Grid-mean ni after 'instratus_condensate' on ni_dprime + + real(r8) a_st(pcols,pver) ! Stratus fraction of equilibrium reference state + real(r8) a_st_0(pcols,pver) ! Stratus fraction at '_0' state + real(r8) a_st_star(pcols,pver) ! Stratus fraction at '_star' state + + real(r8) al_st(pcols,pver) ! Liquid stratus fraction of equilibrium reference state + real(r8) al_st_0(pcols,pver) ! Liquid stratus fraction at '_0' state + real(r8) al_st_nc(pcols,pver) ! Non-physical liquid stratus fraction in the non-cumulus pixels + + real(r8) ai_st(pcols,pver) ! Ice stratus fraction of equilibrium reference state + real(r8) ai_st_0(pcols,pver) ! Ice stratus fraction at '_0' state + real(r8) ai_st_nc(pcols,pver) ! Non-physical ice stratus fraction in the non-cumulus pixels + + real(r8) ql_st(pcols,pver) ! In-stratus LWC of equilibrium reference state [kg/kg] + real(r8) ql_st_0(pcols,pver) ! In-stratus LWC at '_0' state + + real(r8) qi_st(pcols,pver) ! In-stratus IWC of equilibrium reference state [kg/kg] + real(r8) qi_st_0(pcols,pver) ! In-stratus IWC at '_0' state + + ! Cumulus properties + + real(r8) dacudt(pcols,pver) + real(r8) a_cu(pcols,pver) + + ! Adjustment tendency in association with 'positive_moisture' + + real(r8) Tten_pwi1(pcols,pver) ! Pre-process T tendency of input equilibrium state [K/s] + real(r8) qvten_pwi1(pcols,pver) ! Pre-process qv tendency of input equilibrium state [kg/kg/s] + real(r8) qlten_pwi1(pcols,pver) ! Pre-process ql tendency of input equilibrium state [kg/kg/s] + real(r8) qiten_pwi1(pcols,pver) ! Pre-process qi tendency of input equilibrium state [kg/kg/s] + real(r8) nlten_pwi1(pcols,pver) ! Pre-process nl tendency of input equilibrium state [#/kg/s] + real(r8) niten_pwi1(pcols,pver) ! Pre-process ni tendency of input equilibrium state [#/kg/s] + + real(r8) Tten_pwi2(pcols,pver) ! Post-process T tendency of provisional equilibrium state [K/s] + real(r8) qvten_pwi2(pcols,pver) ! Post-process qv tendency of provisional equilibrium state [kg/kg/s] + real(r8) qlten_pwi2(pcols,pver) ! Post-process ql tendency of provisional equilibrium state [kg/kg/s] + real(r8) qiten_pwi2(pcols,pver) ! Post-process qi tendency of provisional equilibrium state [kg/kg/s] + real(r8) nlten_pwi2(pcols,pver) ! Post-process nl tendency of provisoonal equilibrium state [#/kg/s] + real(r8) niten_pwi2(pcols,pver) ! Post-process ni tendency of provisional equilibrium state [#/kg/s] + + real(r8) A_T_adj(pcols,pver) ! After applying external advective forcing [K/s] + real(r8) A_qv_adj(pcols,pver) ! After applying external advective forcing [kg/kg/s] + real(r8) A_ql_adj(pcols,pver) ! After applying external advective forcing [kg/kg/s] + real(r8) A_qi_adj(pcols,pver) ! After applying external advective forcing [kg/kg/s] + real(r8) A_nl_adj(pcols,pver) ! After applying external advective forcing [#/kg/s] + real(r8) A_ni_adj(pcols,pver) ! After applying external advective forcing [#/kg/s] + + ! Adjustment tendency in association with 'instratus_condensate' + + real(r8) QQw1(pcols,pver) ! Effective adjustive condensation into water due to 'instratus_condensate' [kg/kg/s] + real(r8) QQi1(pcols,pver) ! Effective adjustive condensation into ice due to 'instratus_condensate' [kg/kg/s] + real(r8) QQw2(pcols,pver) ! Effective adjustive condensation into water due to 'instratus_condensate' [kg/kg/s] + real(r8) QQi2(pcols,pver) ! Effective adjustive condensation into ice due to 'instratus_condensate' [kg/kg/s] + + real(r8) QQnl1(pcols,pver) ! Tendency of nl associated with QQw1 only when QQw1<0 (net evaporation) [#/kg/s] + real(r8) QQni1(pcols,pver) ! Tendency of ni associated with QQi1 only when QQw1<0 (net evaporation) [#/kg/s] + real(r8) QQnl2(pcols,pver) ! Tendency of nl associated with QQw2 only when QQw2<0 (net evaporation) [#/kg/s] + real(r8) QQni2(pcols,pver) ! Tendency of ni associated with QQi2 only when QQw2<0 (net evaporation) [#/kg/s] + + ! Macrophysical process tendency variables + + real(r8) QQ(pcols,pver) ! Net condensation rate into water+ice [kg/kg/s] + real(r8) QQw(pcols,pver) ! Net condensation rate into water [kg/kg/s] + real(r8) QQi(pcols,pver) ! Net condensation rate into ice [kg/kg/s] + real(r8) QQnl(pcols,pver) ! Tendency of nl associated with QQw both for condensation and evaporation [#/kg/s] + real(r8) QQni(pcols,pver) ! Tendency of ni associated with QQi both for condensation and evaporation [#/kg/s] + real(r8) ACnl(pcols,pver) ! Cloud liquid droplet (nl) activation tendency [#/kg/s] + real(r8) ACni(pcols,pver) ! Cloud ice droplet (ni) activation tendency [#/kg/s] + + real(r8) QQw_prev(pcols,pver) + real(r8) QQi_prev(pcols,pver) + real(r8) QQnl_prev(pcols,pver) + real(r8) QQni_prev(pcols,pver) + + real(r8) QQw_prog(pcols,pver) + real(r8) QQi_prog(pcols,pver) + real(r8) QQnl_prog(pcols,pver) + real(r8) QQni_prog(pcols,pver) + + real(r8) QQ_final(pcols,pver) + real(r8) QQw_final(pcols,pver) + real(r8) QQi_final(pcols,pver) + real(r8) QQn_final(pcols,pver) + real(r8) QQnl_final(pcols,pver) + real(r8) QQni_final(pcols,pver) + + real(r8) QQ_all(pcols,pver) ! QQw_all + QQi_all + real(r8) QQw_all(pcols,pver) ! QQw_final + QQw1 + QQw2 + qlten_pwi1 + qlten_pwi2 + A_ql_adj [kg/kg/s] + real(r8) QQi_all(pcols,pver) ! QQi_final + QQi1 + QQi2 + qiten_pwi1 + qiten_pwi2 + A_qi_adj [kg/kg/s] + real(r8) QQn_all(pcols,pver) ! QQnl_all + QQni_all + real(r8) QQnl_all(pcols,pver) ! QQnl_final + QQnl1 + QQnl2 + nlten_pwi1 + nlten_pwi2 + ACnl [#/kg/s] + real(r8) QQni_all(pcols,pver) ! QQni_final + QQni1 + QQni2 + niten_pwi1 + niten_pwi2 + ACni [#/kg/s] + + ! Coefficient for computing QQ and related processes + + real(r8) U(pcols,pver) ! Grid-mean RH + real(r8) U_nc(pcols,pver) ! Mean RH of non-cumulus pixels + real(r8) G_nc(pcols,pver) ! d(U_nc)/d(a_st_nc) + real(r8) F_nc(pcols,pver) ! A function of second parameter for a_st_nc + real(r8) alpha ! = 1/qs + real(r8) beta ! = (qv/qs**2)*dqsdT + real(r8) betast ! = alpha*dqsdT + real(r8) gammal ! = alpha + (latvap/cpair)*beta + real(r8) gammai ! = alpha + ((latvap+latice)/cpair)*beta + real(r8) gammaQ ! = alpha + (latvap/cpair)*beta + real(r8) deltal ! = 1 + a_st*(latvap/cpair)*(betast/alpha) + real(r8) deltai ! = 1 + a_st*((latvap+latice)/cpair)*(betast/alpha) + real(r8) A_Tc ! Advective external forcing of Tc [K/s] + real(r8) A_qt ! Advective external forcing of qt [kg/kg/s] + real(r8) C_Tc ! Microphysical forcing of Tc [K/s] + real(r8) C_qt ! Microphysical forcing of qt [kg/kg/s] + real(r8) dTcdt ! d(Tc)/dt [K/s] + real(r8) dqtdt ! d(qt)/dt [kg/kg/s] + real(r8) dqtstldt ! d(qt_alst)/dt [kg/kg/s] + real(r8) dqidt ! d(qi)/dt [kg/kg/s] + + real(r8) dqlstdt ! d(ql_st)/dt [kg/kg/s] + real(r8) dalstdt ! d(al_st)/dt [1/s] + real(r8) dastdt ! d(a_st)/dt [1/s] + + real(r8) anic ! Fractional area of non-cumulus and non-ice stratus fraction + real(r8) GG ! G_nc(i,k)/anic + + real(r8) aa(2,2) + real(r8) bb(2,1) + + real(r8) zeros(pcols,pver) + + real(r8) qmin1(pcols,pver) + real(r8) qmin2(pcols,pver) + real(r8) qmin3(pcols,pver) + + real(r8) esat_a(pcols) ! Saturation water vapor pressure [Pa] + real(r8) qsat_a(pcols,pver) ! Saturation water vapor specific humidity [kg/kg] + real(r8) Twb_aw(pcols) ! Wet-bulb temperature [K] + real(r8) qvwb_aw(pcols,pver) ! Wet-bulb water vapor specific humidity [kg/kg] + + real(r8) esat_b(pcols) + real(r8) qsat_b(pcols) + real(r8) dqsdT_b(pcols) + + logical land + real(r8) tmp + + real(r8) d_rhmin_liq_PBL(pcols,pver) + real(r8) d_rhmin_ice_PBL(pcols,pver) + real(r8) d_rhmin_liq_det(pcols,pver) + real(r8) d_rhmin_ice_det(pcols,pver) + real(r8) rhmaxi_arr(pcols,pver) + real(r8) rhmini_arr(pcols,pver) + real(r8) rhminl_arr(pcols,pver) + real(r8) rhminl_adj_land_arr(pcols,pver) + real(r8) rhminh_arr(pcols,pver) + real(r8) rhmin_liq_diag(pcols,pver) + real(r8) rhmin_ice_diag(pcols,pver) + + real(r8) QQmax,QQmin,QQwmin,QQimin ! For limiting QQ + real(r8) cone ! Number close to but smaller than 1 + + cone = 0.999_r8 + zeros(:ncol,:) = 0._r8 + + ! ------------------------------------ ! + ! Global initialization of main output ! + ! ------------------------------------ ! + + s_tendout(:ncol,:) = 0._r8 + qv_tendout(:ncol,:) = 0._r8 + ql_tendout(:ncol,:) = 0._r8 + qi_tendout(:ncol,:) = 0._r8 + nl_tendout(:ncol,:) = 0._r8 + ni_tendout(:ncol,:) = 0._r8 + + qme(:ncol,:) = 0._r8 + + cld(:ncol,:) = 0._r8 + al_st_star(:ncol,:) = 0._r8 + ai_st_star(:ncol,:) = 0._r8 + ql_st_star(:ncol,:) = 0._r8 + qi_st_star(:ncol,:) = 0._r8 + + ! --------------------------------------- ! + ! Initialization of internal 2D variables ! + ! --------------------------------------- ! + + T(:ncol,:) = 0._r8 + T1(:ncol,:) = 0._r8 + T_0(:ncol,:) = 0._r8 + T_05(:ncol,:) = 0._r8 + T_prime0(:ncol,:) = 0._r8 + T_dprime(:ncol,:) = 0._r8 + T_star(:ncol,:) = 0._r8 + + qv(:ncol,:) = 0._r8 + qv1(:ncol,:) = 0._r8 + qv_0(:ncol,:) = 0._r8 + qv_05(:ncol,:) = 0._r8 + qv_prime0(:ncol,:) = 0._r8 + qv_dprime(:ncol,:) = 0._r8 + qv_star(:ncol,:) = 0._r8 + + ql(:ncol,:) = 0._r8 + ql1(:ncol,:) = 0._r8 + ql_0(:ncol,:) = 0._r8 + ql_05(:ncol,:) = 0._r8 + ql_prime0(:ncol,:) = 0._r8 + ql_dprime(:ncol,:) = 0._r8 + ql_star(:ncol,:) = 0._r8 + + qi(:ncol,:) = 0._r8 + qi1(:ncol,:) = 0._r8 + qi_0(:ncol,:) = 0._r8 + qi_05(:ncol,:) = 0._r8 + qi_prime0(:ncol,:) = 0._r8 + qi_dprime(:ncol,:) = 0._r8 + qi_star(:ncol,:) = 0._r8 + + nl(:ncol,:) = 0._r8 + nl1(:ncol,:) = 0._r8 + nl_0(:ncol,:) = 0._r8 + nl_05(:ncol,:) = 0._r8 + nl_prime0(:ncol,:) = 0._r8 + nl_dprime(:ncol,:) = 0._r8 + nl_star(:ncol,:) = 0._r8 + + ni(:ncol,:) = 0._r8 + ni1(:ncol,:) = 0._r8 + ni_0(:ncol,:) = 0._r8 + ni_05(:ncol,:) = 0._r8 + ni_prime0(:ncol,:) = 0._r8 + ni_dprime(:ncol,:) = 0._r8 + ni_star(:ncol,:) = 0._r8 + + a_st(:ncol,:) = 0._r8 + a_st_0(:ncol,:) = 0._r8 + a_st_star(:ncol,:) = 0._r8 + + al_st(:ncol,:) = 0._r8 + al_st_0(:ncol,:) = 0._r8 + al_st_nc(:ncol,:) = 0._r8 + + ai_st(:ncol,:) = 0._r8 + ai_st_0(:ncol,:) = 0._r8 + ai_st_nc(:ncol,:) = 0._r8 + + ql_st(:ncol,:) = 0._r8 + ql_st_0(:ncol,:) = 0._r8 + + qi_st(:ncol,:) = 0._r8 + qi_st_0(:ncol,:) = 0._r8 + + ! Cumulus properties + + dacudt(:ncol,:) = 0._r8 + a_cu(:ncol,:) = 0._r8 + + ! Adjustment tendency in association with 'positive_moisture' + + Tten_pwi1(:ncol,:) = 0._r8 + qvten_pwi1(:ncol,:) = 0._r8 + qlten_pwi1(:ncol,:) = 0._r8 + qiten_pwi1(:ncol,:) = 0._r8 + nlten_pwi1(:ncol,:) = 0._r8 + niten_pwi1(:ncol,:) = 0._r8 + + Tten_pwi2(:ncol,:) = 0._r8 + qvten_pwi2(:ncol,:) = 0._r8 + qlten_pwi2(:ncol,:) = 0._r8 + qiten_pwi2(:ncol,:) = 0._r8 + nlten_pwi2(:ncol,:) = 0._r8 + niten_pwi2(:ncol,:) = 0._r8 + + A_T_adj(:ncol,:) = 0._r8 + A_qv_adj(:ncol,:) = 0._r8 + A_ql_adj(:ncol,:) = 0._r8 + A_qi_adj(:ncol,:) = 0._r8 + A_nl_adj(:ncol,:) = 0._r8 + A_ni_adj(:ncol,:) = 0._r8 + + qvadj (:ncol,:) = 0._r8 + qladj (:ncol,:) = 0._r8 + qiadj (:ncol,:) = 0._r8 + + ! Adjustment tendency in association with 'instratus_condensate' + + QQw1(:ncol,:) = 0._r8 + QQi1(:ncol,:) = 0._r8 + QQw2(:ncol,:) = 0._r8 + QQi2(:ncol,:) = 0._r8 + + QQnl1(:ncol,:) = 0._r8 + QQni1(:ncol,:) = 0._r8 + QQnl2(:ncol,:) = 0._r8 + QQni2(:ncol,:) = 0._r8 + + QQnl(:ncol,:) = 0._r8 + QQni(:ncol,:) = 0._r8 + + ! Macrophysical process tendency variables + + QQ(:ncol,:) = 0._r8 + QQw(:ncol,:) = 0._r8 + QQi(:ncol,:) = 0._r8 + QQnl(:ncol,:) = 0._r8 + QQni(:ncol,:) = 0._r8 + ACnl(:ncol,:) = 0._r8 + ACni(:ncol,:) = 0._r8 + + QQw_prev(:ncol,:) = 0._r8 + QQi_prev(:ncol,:) = 0._r8 + QQnl_prev(:ncol,:) = 0._r8 + QQni_prev(:ncol,:) = 0._r8 + + QQw_prog(:ncol,:) = 0._r8 + QQi_prog(:ncol,:) = 0._r8 + QQnl_prog(:ncol,:) = 0._r8 + QQni_prog(:ncol,:) = 0._r8 + + QQ_final(:ncol,:) = 0._r8 + QQw_final(:ncol,:) = 0._r8 + QQi_final(:ncol,:) = 0._r8 + QQn_final(:ncol,:) = 0._r8 + QQnl_final(:ncol,:) = 0._r8 + QQni_final(:ncol,:) = 0._r8 + + QQ_all(:ncol,:) = 0._r8 + QQw_all(:ncol,:) = 0._r8 + QQi_all(:ncol,:) = 0._r8 + QQn_all(:ncol,:) = 0._r8 + QQnl_all(:ncol,:) = 0._r8 + QQni_all(:ncol,:) = 0._r8 + + ! Coefficient for computing QQ and related processes + + U(:ncol,:) = 0._r8 + U_nc(:ncol,:) = 0._r8 + G_nc(:ncol,:) = 0._r8 + F_nc(:ncol,:) = 0._r8 + + ! Other + + qmin1(:ncol,:) = 0._r8 + qmin2(:ncol,:) = 0._r8 + qmin3(:ncol,:) = 0._r8 + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + ! Compute critical RH for stratus + rhmaxi_arr(:ncol,:pver) = rhmaxi_const + call rhcrit_calc( & + ncol, dp, T0, p, & + clrw_old, clri_old, tke, qtl_flx, & + qti_flx, cmfr_det, qlr_det, qir_det, & + rhmaxi_arr, rhmini_arr, rhminl_arr, rhminl_adj_land_arr, rhminh_arr, & + d_rhmin_liq_PBL, d_rhmin_ice_PBL, d_rhmin_liq_det, d_rhmin_ice_det) + + ! ---------------------------------- ! + ! Compute cumulus-related properties ! + ! ---------------------------------- ! + + dacudt(:ncol,top_lev:pver) = & + (a_cu0(:ncol,top_lev:pver) - a_cud(:ncol,top_lev:pver))/dt + + ! ---------------------------------------------------------------------- ! + ! set to zero for levels above + ! ---------------------------------------------------------------------- ! + ql0(:ncol,:top_lev-1) = 0._r8 + qi0(:ncol,:top_lev-1) = 0._r8 + nl0(:ncol,:top_lev-1) = 0._r8 + ni0(:ncol,:top_lev-1) = 0._r8 + + ! ---------------------------------------------------------------------- ! + ! Check if input non-cumulus pixels satisfie a non-negative constraint. ! + ! If not, force all water vapor substances to be positive in all layers. ! + ! We should use 'old' cumulus properties for this routine. ! + ! ---------------------------------------------------------------------- ! + + T1(:ncol,:) = T0(:ncol,:) + qv1(:ncol,:) = qv0(:ncol,:) + ql1(:ncol,:) = ql0(:ncol,:) + qi1(:ncol,:) = qi0(:ncol,:) + nl1(:ncol,:) = nl0(:ncol,:) + ni1(:ncol,:) = ni0(:ncol,:) + + + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + + + qmin1(:ncol,:) = qmin(1) + qmin2(:ncol,:) = qmin(ixcldliq) + qmin3(:ncol,:) = qmin(ixcldice) + + call positive_moisture( ncol, dt, qmin1, qmin2, qmin3, dp, & + qv1, ql1, qi1, T1, qvten_pwi1, qlten_pwi1, & + qiten_pwi1, Tten_pwi1, do_cldice) + + do k = top_lev, pver + do i = 1, ncol + if( ql1(i,k) .lt. qsmall ) then + nlten_pwi1(i,k) = -nl1(i,k)/dt + nl1(i,k) = 0._r8 + endif + if( qi1(i,k) .lt. qsmall ) then + niten_pwi1(i,k) = -ni1(i,k)/dt + ni1(i,k) = 0._r8 + endif + enddo + enddo + + ! ------------------------------------------------------------- ! + ! Impose 'in-stratus condensate amount constraint' ! + ! such that it is bounded by two limiting values. ! + ! This should also use 'old' cumulus properties since it is ! + ! before applying external forcings. ! + ! Below 'QQw1,QQi1' are effective adjustive condensation ! + ! Although this process also involves freezing of cloud ! + ! liquid into ice, they can be and only can be expressed ! + ! in terms of effective condensation. ! + ! ------------------------------------------------------------- ! + + do k = top_lev, pver + call instratus_condensate( lchnk, ncol, k, & + p(:,k), T1(:,k), qv1(:,k), ql1(:,k), qi1(:,k), & + ni1(:,k), & + a_cud(:,k), zeros(:,k), zeros(:,k), & + zeros(:,k), zeros(:,k), zeros(:,k), & + landfrac, snowh, & + rhmaxi_arr(:,k),rhmini_arr(:,k), rhminl_arr(:,k), rhminl_adj_land_arr(:,k), rhminh_arr(:,k), & + T_0(:,k), qv_0(:,k), ql_0(:,k), qi_0(:,k), & + al_st_0(:,k), ai_st_0(:,k), ql_st_0(:,k), qi_st_0(:,k) ) + a_st_0(:ncol,k) = max(al_st_0(:ncol,k),ai_st_0(:ncol,k)) + QQw1(:ncol,k) = (ql_0(:ncol,k) - ql1(:ncol,k))/dt + QQi1(:ncol,k) = (qi_0(:ncol,k) - qi1(:ncol,k))/dt + ! -------------------------------------------------- ! + ! Reduce droplet concentration if evaporation occurs ! + ! Set a limit such that negative state not happens. ! + ! -------------------------------------------------- ! + do i = 1, ncol + if( QQw1(i,k) .le. 0._r8 ) then + if( ql1(i,k) .gt. qsmall ) then + QQnl1(i,k) = QQw1(i,k)*nl1(i,k)/ql1(i,k) + QQnl1(i,k) = min(0._r8,cone*max(QQnl1(i,k),-nl1(i,k)/dt)) + else + QQnl1(i,k) = 0._r8 + endif + endif + if( QQi1(i,k) .le. 0._r8 ) then + if( qi1(i,k) .gt. qsmall ) then + QQni1(i,k) = QQi1(i,k)*ni1(i,k)/qi1(i,k) + QQni1(i,k) = min(0._r8,cone*max(QQni1(i,k),-ni1(i,k)/dt)) + else + QQni1(i,k) = 0._r8 + endif + endif + enddo + enddo + nl_0(:ncol,top_lev:) = max(0._r8,nl1(:ncol,top_lev:)+QQnl1(:ncol,top_lev:)*dt) + ni_0(:ncol,top_lev:) = max(0._r8,ni1(:ncol,top_lev:)+QQni1(:ncol,top_lev:)*dt) + + ! ----------------------------------------------------------------------------- ! + ! Check if non-cumulus pixels of '_05' state satisfies non-negative constraint. ! + ! If not, force all water substances of '_05' state to be positive by imposing ! + ! adjustive advection. We should use 'new' cumulus properties for this routine. ! + ! ----------------------------------------------------------------------------- ! + + T_05(:ncol,top_lev:) = T_0(:ncol,top_lev:) + ( A_T(:ncol,top_lev:) + C_T(:ncol,top_lev:) ) * dt + qv_05(:ncol,top_lev:) = qv_0(:ncol,top_lev:) + ( A_qv(:ncol,top_lev:) + C_qv(:ncol,top_lev:) ) * dt + ql_05(:ncol,top_lev:) = ql_0(:ncol,top_lev:) + ( A_ql(:ncol,top_lev:) + C_ql(:ncol,top_lev:) ) * dt + qi_05(:ncol,top_lev:) = qi_0(:ncol,top_lev:) + ( A_qi(:ncol,top_lev:) + C_qi(:ncol,top_lev:) ) * dt + nl_05(:ncol,top_lev:) = max(0._r8, nl_0(:ncol,top_lev:) + ( A_nl(:ncol,top_lev:) + C_nl(:ncol,top_lev:) ) * dt ) + ni_05(:ncol,top_lev:) = max(0._r8, ni_0(:ncol,top_lev:) + ( A_ni(:ncol,top_lev:) + C_ni(:ncol,top_lev:) ) * dt ) + + call positive_moisture( ncol, dt, qmin1, qmin2, qmin3, dp, & + qv_05, ql_05, qi_05, T_05, A_qv_adj, & + A_ql_adj, A_qi_adj, A_T_adj, do_cldice) + + ! -------------------------------------------------------------- ! + ! Define reference state at the first iteration. This will be ! + ! continuously updated within the iteration loop below. ! + ! While equlibrium state properties are already output from the ! + ! 'instratus_condensate', they will be re-computed within the ! + ! each iteration process. At the first iteration, they will ! + ! produce exactly identical results. Note that except at the ! + ! very first iteration iter = 1, we must use updated cumulus ! + ! properties at all the other iteration processes. Even at the ! + ! first iteration, we should use updated cumulus properties ! + ! when computing limiters for (Q,P,E). ! + ! -------------------------------------------------------------- ! + + ! -------------------------------------------------------------- ! + ! Define variables at the reference state of the first iteration ! + ! -------------------------------------------------------------- ! + + T(:ncol,top_lev:) = T_0(:ncol,top_lev:) + qv(:ncol,top_lev:) = qv_0(:ncol,top_lev:) + ql(:ncol,top_lev:) = ql_0(:ncol,top_lev:) + qi(:ncol,top_lev:) = qi_0(:ncol,top_lev:) + al_st(:ncol,top_lev:) = al_st_0(:ncol,top_lev:) + ai_st(:ncol,top_lev:) = ai_st_0(:ncol,top_lev:) + a_st(:ncol,top_lev:) = a_st_0(:ncol,top_lev:) + ql_st(:ncol,top_lev:) = ql_st_0(:ncol,top_lev:) + qi_st(:ncol,top_lev:) = qi_st_0(:ncol,top_lev:) + nl(:ncol,top_lev:) = nl_0(:ncol,top_lev:) + ni(:ncol,top_lev:) = ni_0(:ncol,top_lev:) + + ! -------------------------- ! + ! Main iterative computation ! + ! -------------------------- ! + + do k = top_lev, pver + call findsp_vc(qv_05(:ncol,k), T_05(:ncol,k), p(:ncol,k), .false., & + Twb_aw(:ncol), qvwb_aw(:ncol,k)) + call qsat_water(T_05(1:ncol,k), p(1:ncol,k), & + esat_a(1:ncol), qsat_a(1:ncol,k)) + enddo + + do iter = 1, niter + + ! ------------------------------------------ ! + ! Initialize array within the iteration loop ! + ! ------------------------------------------ ! + + QQ(:,:) = 0._r8 + QQw(:,:) = 0._r8 + QQi(:,:) = 0._r8 + QQnl(:,:) = 0._r8 + QQni(:,:) = 0._r8 + QQw2(:,:) = 0._r8 + QQi2(:,:) = 0._r8 + QQnl2(:,:) = 0._r8 + QQni2(:,:) = 0._r8 + nlten_pwi2(:,:) = 0._r8 + niten_pwi2(:,:) = 0._r8 + ACnl(:,:) = 0._r8 + ACni(:,:) = 0._r8 + aa(:,:) = 0._r8 + bb(:,:) = 0._r8 + + do k = top_lev, pver + + call qsat_water(T(1:ncol,k), p(1:ncol,k), & + esat_b(1:ncol), qsat_b(1:ncol), dqsdt=dqsdT_b(1:ncol)) + + if( iter .eq. 1 ) then + a_cu(:ncol,k) = a_cud(:ncol,k) + else + a_cu(:ncol,k) = a_cu0(:ncol,k) + endif + do i = 1, ncol + U(i,k) = qv(i,k)/qsat_b(i) + U_nc(i,k) = U(i,k) + enddo + if( CAMstfrac ) then + call astG_RHU(U_nc(:,k),p(:,k),qv(:,k),landfrac(:),snowh(:),al_st_nc(:,k),G_nc(:,k),ncol,& + rhminl_arr(:,k), rhminl_adj_land_arr(:,k), rhminh_arr(:,k)) + else + call astG_PDF(U_nc(:,k),p(:,k),qv(:,k),landfrac(:),snowh(:),al_st_nc(:,k),G_nc(:,k),ncol,& + rhminl_arr(:,k), rhminl_adj_land_arr(:,k), rhminh_arr(:,k)) + endif + call aist_vector(qv(:,k),T(:,k),p(:,k),qi(:,k),ni(:,k),landfrac(:),snowh(:),ai_st_nc(:,k),ncol,& + rhmaxi_arr(:,k), rhmini_arr(:,k), rhminl_arr(:,k), rhminl_adj_land_arr(:,k), rhminh_arr(:,k)) + + ai_st(:ncol,k) = (1._r8-a_cu(:ncol,k))*ai_st_nc(:ncol,k) + al_st(:ncol,k) = (1._r8-a_cu(:ncol,k))*al_st_nc(:ncol,k) + a_st(:ncol,k) = max(al_st(:ncol,k),ai_st(:ncol,k)) + + do i = 1, ncol + + ! -------------------------------------------------------- ! + ! Compute basic thermodynamic coefficients for computing Q ! + ! -------------------------------------------------------- ! + + alpha = 1._r8/qsat_b(i) + beta = dqsdT_b(i)*(qv(i,k)/qsat_b(i)**2) + betast = alpha*dqsdT_b(i) + gammal = alpha + (latvap/cpair)*beta + gammai = alpha + ((latvap+latice)/cpair)*beta + gammaQ = alpha + (latvap/cpair)*beta + deltal = 1._r8 + a_st(i,k)*(latvap/cpair)*(betast/alpha) + deltai = 1._r8 + a_st(i,k)*((latvap+latice)/cpair)*(betast/alpha) + A_Tc = A_T(i,k)+A_T_adj(i,k)-(latvap/cpair)*(A_ql(i,k)+A_ql_adj(i,k))-((latvap+latice)/cpair)*(A_qi(i,k)+A_qi_adj(i,k)) + A_qt = A_qv(i,k) + A_qv_adj(i,k) + A_ql(i,k) + A_ql_adj(i,k) + A_qi(i,k) + A_qi_adj(i,k) + C_Tc = C_T(i,k) - (latvap/cpair)*C_ql(i,k) - ((latvap+latice)/cpair)*C_qi(i,k) + C_qt = C_qv(i,k) + C_ql(i,k) + C_qi(i,k) + dTcdt = A_Tc + C_Tc + dqtdt = A_qt + C_qt + ! dqtstldt = A_qt + C_ql(i,k)/max(1.e-2_r8,al_st(i,k)) ! Original + ! dqtstldt = A_qt - A_qi(i,k) - A_qi_adj(i,k) + C_ql(i,k)/max(1.e-2_r8,al_st(i,k)) ! New 1 on Dec.30.2009. + dqtstldt = A_qt - A_qi(i,k) - A_qi_adj(i,k) + C_qlst(i,k) ! New 2 on Dec.30.2009. + ! dqtstldt = A_qt + C_qt ! Original Conservative treatment + ! dqtstldt = A_qt - A_qi(i,k) - A_qi_adj(i,k) + C_qt - C_qi(i,k) ! New Conservative treatment on Dec.30.2009 + dqidt = A_qi(i,k) + A_qi_adj(i,k) + C_qi(i,k) + + anic = max(1.e-8_r8,(1._r8-a_cu(i,k))) + GG = G_nc(i,k)/anic + aa(1,1) = gammal*al_st(i,k) + aa(1,2) = GG + gammal*cc*ql_st(i,k) + aa(2,1) = alpha + (latvap/cpair)*betast*al_st(i,k) + aa(2,2) = (latvap/cpair)*betast*cc*ql_st(i,k) + bb(1,1) = alpha*dqtdt - beta*dTcdt - gammai*dqidt - GG*al_st_nc(i,k)*dacudt(i,k) + F_nc(i,k) + bb(2,1) = alpha*dqtstldt - betast*(dTcdt + ((latvap+latice)/cpair)*dqidt) + call gaussj(aa(1:2,1:2),2,2,bb(1:2,1),1,1) + dqlstdt = bb(1,1) + dalstdt = bb(2,1) + QQ(i,k) = al_st(i,k)*dqlstdt + cc*ql_st(i,k)*dalstdt - ( A_ql(i,k) + A_ql_adj(i,k) + C_ql(i,k) ) + + ! ------------------------------------------------------------ ! + ! Limiter for QQ ! + ! Here, 'fice' should be from the reference equilibrium state ! + ! since QQ itself is computed from the reference state. ! + ! From the assumption used for derivation of QQ(i), it must be ! + ! that QQw(i) = QQ(i)*(1._r8-fice(i)), QQi(i) = QQ(i)*fice(i) ! + ! ------------------------------------------------------------ ! + + if( QQ(i,k) .ge. 0._r8 ) then + QQmax = (qv_05(i,k) - qmin(1))/dt ! For ghost cumulus & semi-ghost ice stratus + QQmax = max(0._r8,QQmax) + QQ(i,k) = min(QQ(i,k),QQmax) + QQw(i,k) = QQ(i,k) + QQi(i,k) = 0._r8 + else + QQmin = 0._r8 + if( qv_05(i,k) .lt. qsat_a(i,k) ) QQmin = min(0._r8,cone*(qv_05(i,k)-qvwb_aw(i,k))/dt) + QQ(i,k) = max(QQ(i,k),QQmin) + QQw(i,k) = QQ(i,k) + QQi(i,k) = 0._r8 + QQwmin = min(0._r8,-cone*ql_05(i,k)/dt) + QQimin = min(0._r8,-cone*qi_05(i,k)/dt) + QQw(i,k) = min(0._r8,max(QQw(i,k),QQwmin)) + QQi(i,k) = min(0._r8,max(QQi(i,k),QQimin)) + endif + + ! -------------------------------------------------- ! + ! Reduce droplet concentration if evaporation occurs ! + ! Note 'QQnl1,QQni1' are computed from the reference ! + ! equilibrium state but limiter is from 'nl_05'. ! + ! -------------------------------------------------- ! + + if( QQw(i,k) .lt. 0._r8 ) then + if( ql_05(i,k) .gt. qsmall ) then + QQnl(i,k) = QQw(i,k)*nl_05(i,k)/ql_05(i,k) + QQnl(i,k) = min(0._r8,cone*max(QQnl(i,k),-nl_05(i,k)/dt)) + else + QQnl(i,k) = 0._r8 + endif + endif + + if( QQi(i,k) .lt. 0._r8 ) then + if( qi_05(i,k) .gt. qsmall ) then + QQni(i,k) = QQi(i,k)*ni_05(i,k)/qi_05(i,k) + QQni(i,k) = min(0._r8,cone*max(QQni(i,k),-ni_05(i,k)/dt)) + else + QQni(i,k) = 0._r8 + endif + endif + + enddo + enddo + + ! -------------------------------------------------------------------- ! + ! Until now, we have finished computing all necessary tendencies ! + ! from the equilibrium input state (T_0). ! + ! If ramda = 0 : fully explicit scheme ! + ! ramda = 1 : fully implicit scheme ! + ! Note that 'ramda = 0.5 with niter = 2' can mimic ! + ! -------------------------------------------------------------------- ! + + if( iter .eq. 1 ) then + QQw_prev(:ncol,top_lev:) = QQw(:ncol,top_lev:) + QQi_prev(:ncol,top_lev:) = QQi(:ncol,top_lev:) + QQnl_prev(:ncol,top_lev:) = QQnl(:ncol,top_lev:) + QQni_prev(:ncol,top_lev:) = QQni(:ncol,top_lev:) + endif + + QQw_prog(:ncol,top_lev:) = ramda*QQw(:ncol,top_lev:) + (1._r8-ramda)*QQw_prev(:ncol,top_lev:) + QQi_prog(:ncol,top_lev:) = ramda*QQi(:ncol,top_lev:) + (1._r8-ramda)*QQi_prev(:ncol,top_lev:) + QQnl_prog(:ncol,top_lev:) = ramda*QQnl(:ncol,top_lev:) + (1._r8-ramda)*QQnl_prev(:ncol,top_lev:) + QQni_prog(:ncol,top_lev:) = ramda*QQni(:ncol,top_lev:) + (1._r8-ramda)*QQni_prev(:ncol,top_lev:) + + QQw_prev(:ncol,top_lev:) = QQw_prog(:ncol,top_lev:) + QQi_prev(:ncol,top_lev:) = QQi_prog(:ncol,top_lev:) + QQnl_prev(:ncol,top_lev:) = QQnl_prog(:ncol,top_lev:) + QQni_prev(:ncol,top_lev:) = QQni_prog(:ncol,top_lev:) + + ! -------------------------------------------------------- ! + ! Compute final prognostic state on which final diagnostic ! + ! in-stratus condensate adjustment is applied in the below.! + ! Important : I must check whether there are any external ! + ! advective forcings of 'A_nl(i,k),A_ni(i,k)'. ! + ! Even they are (i.e., advection of aerosol), ! + ! actual droplet activation will be performd ! + ! in microphysics, so it will be completely ! + ! reasonable to 'A_nl(i,k)=A_ni(i,k)=0'. ! + ! -------------------------------------------------------- ! + + do k = top_lev, pver + do i = 1, ncol + T_prime0(i,k) = T_0(i,k) + dt*( A_T(i,k) + A_T_adj(i,k) + C_T(i,k) + & + (latvap*QQw_prog(i,k)+(latvap+latice)*QQi_prog(i,k))/cpair ) + qv_prime0(i,k) = qv_0(i,k) + dt*( A_qv(i,k) + A_qv_adj(i,k) + C_qv(i,k) - QQw_prog(i,k) - QQi_prog(i,k) ) + ql_prime0(i,k) = ql_0(i,k) + dt*( A_ql(i,k) + A_ql_adj(i,k) + C_ql(i,k) + QQw_prog(i,k) ) + qi_prime0(i,k) = qi_0(i,k) + dt*( A_qi(i,k) + A_qi_adj(i,k) + C_qi(i,k) + QQi_prog(i,k) ) + nl_prime0(i,k) = max(0._r8,nl_0(i,k) + dt*( A_nl(i,k) + C_nl(i,k) + QQnl_prog(i,k) )) + ni_prime0(i,k) = max(0._r8,ni_0(i,k) + dt*( A_ni(i,k) + C_ni(i,k) + QQni_prog(i,k) )) + if( ql_prime0(i,k) .lt. qsmall ) nl_prime0(i,k) = 0._r8 + if( qi_prime0(i,k) .lt. qsmall ) ni_prime0(i,k) = 0._r8 + enddo + enddo + + ! -------------------------------------------------- ! + ! Perform diagnostic 'positive_moisture' constraint. ! + ! -------------------------------------------------- ! + + T_dprime(:ncol,top_lev:) = T_prime0(:ncol,top_lev:) + qv_dprime(:ncol,top_lev:) = qv_prime0(:ncol,top_lev:) + ql_dprime(:ncol,top_lev:) = ql_prime0(:ncol,top_lev:) + qi_dprime(:ncol,top_lev:) = qi_prime0(:ncol,top_lev:) + nl_dprime(:ncol,top_lev:) = nl_prime0(:ncol,top_lev:) + ni_dprime(:ncol,top_lev:) = ni_prime0(:ncol,top_lev:) + + call positive_moisture( ncol, dt, qmin1, qmin2, qmin3, dp, & + qv_dprime, ql_dprime, qi_dprime, T_dprime, & + qvten_pwi2, qlten_pwi2, qiten_pwi2, Tten_pwi2, do_cldice) + + do k = top_lev, pver + do i = 1, ncol + if( ql_dprime(i,k) .lt. qsmall ) then + nlten_pwi2(i,k) = -nl_dprime(i,k)/dt + nl_dprime(i,k) = 0._r8 + endif + if( qi_dprime(i,k) .lt. qsmall ) then + niten_pwi2(i,k) = -ni_dprime(i,k)/dt + ni_dprime(i,k) = 0._r8 + endif + enddo + enddo + + ! -------------------------------------------------------------- ! + ! Add tendency associated with detrainment of cumulus condensate ! + ! This tendency is not used in computing Q ! + ! Since D_ql,D_qi,D_nl,D_ni > 0, don't need to worry about ! + ! negative scalar. ! + ! This tendency is not reflected into Fzs2, which is OK. ! + ! -------------------------------------------------------------- ! + + T_dprime(:ncol,top_lev:) = T_dprime(:ncol,top_lev:) + D_T(:ncol,top_lev:) * dt + qv_dprime(:ncol,top_lev:) = qv_dprime(:ncol,top_lev:) + D_qv(:ncol,top_lev:) * dt + ql_dprime(:ncol,top_lev:) = ql_dprime(:ncol,top_lev:) + D_ql(:ncol,top_lev:) * dt + qi_dprime(:ncol,top_lev:) = qi_dprime(:ncol,top_lev:) + D_qi(:ncol,top_lev:) * dt + nl_dprime(:ncol,top_lev:) = nl_dprime(:ncol,top_lev:) + D_nl(:ncol,top_lev:) * dt + ni_dprime(:ncol,top_lev:) = ni_dprime(:ncol,top_lev:) + D_ni(:ncol,top_lev:) * dt + + ! ---------------------------------------------------------- ! + ! Impose diagnostic upper and lower limits on the in-stratus ! + ! condensate amount. This produces a final equilibrium state ! + ! at the end of each iterative process. ! + ! ---------------------------------------------------------- ! + + do k = top_lev, pver + call instratus_condensate( lchnk , ncol , k , p(:,k) , & + T_dprime(:,k) , qv_dprime(:,k) , ql_dprime(:,k) , qi_dprime(:,k), & + ni_dprime(:,k) , & + a_cu0(:,k) , zeros(:,k) , zeros(:,k) , & + zeros(:,k) , zeros(:,k) , zeros(:,k) , & + landfrac , snowh , & + rhmaxi_arr(:,k),rhmini_arr(:,k), rhminl_arr(:,k), rhminl_adj_land_arr(:,k), rhminh_arr(:,k), & + T_star(:,k) , qv_star(:,k) , ql_star(:,k) , qi_star(:,k) , & + al_st_star(:,k), ai_st_star(:,k), ql_st_star(:,k), qi_st_star(:,k) ) + a_st_star(:ncol,k) = max(al_st_star(:ncol,k),ai_st_star(:ncol,k)) + QQw2(:ncol,k) = (ql_star(:ncol,k) - ql_dprime(:ncol,k))/dt + QQi2(:ncol,k) = (qi_star(:ncol,k) - qi_dprime(:ncol,k))/dt + ! -------------------------------------------------- ! + ! Reduce droplet concentration if evaporation occurs ! + ! -------------------------------------------------- ! + do i = 1, ncol + if( QQw2(i,k) .le. 0._r8 ) then + if( ql_dprime(i,k) .ge. qsmall ) then + QQnl2(i,k) = QQw2(i,k)*nl_dprime(i,k)/ql_dprime(i,k) + QQnl2(i,k) = min(0._r8,cone*max(QQnl2(i,k),-nl_dprime(i,k)/dt)) + else + QQnl2(i,k) = 0._r8 + endif + endif + if( QQi2(i,k) .le. 0._r8 ) then + if( qi_dprime(i,k) .gt. qsmall ) then + QQni2(i,k) = QQi2(i,k)*ni_dprime(i,k)/qi_dprime(i,k) + QQni2(i,k) = min(0._r8,cone*max(QQni2(i,k),-ni_dprime(i,k)/dt)) + else + QQni2(i,k) = 0._r8 + endif + endif + enddo + enddo + nl_star(:ncol,top_lev:) = max(0._r8,nl_dprime(:ncol,top_lev:)+QQnl2(:ncol,top_lev:)*dt) + ni_star(:ncol,top_lev:) = max(0._r8,ni_dprime(:ncol,top_lev:)+QQni2(:ncol,top_lev:)*dt) + + ! ------------------------------------------ ! + ! Final adjustment of droplet concentration. ! + ! Set # to zero if there is no cloud. ! + ! ------------------------------------------ ! + + do k = top_lev, pver + do i = 1, ncol + if( ql_star(i,k) .lt. qsmall ) then + ACnl(i,k) = - nl_star(i,k)/dt + nl_star(i,k) = 0._r8 + endif + if( qi_star(i,k) .lt. qsmall ) then + ACni(i,k) = - ni_star(i,k)/dt + ni_star(i,k) = 0._r8 + endif + enddo + enddo + + ! ----------------------------------------------------- ! + ! Define equilibrium reference state for next iteration ! + ! ----------------------------------------------------- ! + + T(:ncol,top_lev:) = T_star(:ncol,top_lev:) + qv(:ncol,top_lev:) = qv_star(:ncol,top_lev:) + ql(:ncol,top_lev:) = ql_star(:ncol,top_lev:) + qi(:ncol,top_lev:) = qi_star(:ncol,top_lev:) + al_st(:ncol,top_lev:) = al_st_star(:ncol,top_lev:) + ai_st(:ncol,top_lev:) = ai_st_star(:ncol,top_lev:) + a_st(:ncol,top_lev:) = a_st_star(:ncol,top_lev:) + ql_st(:ncol,top_lev:) = ql_st_star(:ncol,top_lev:) + qi_st(:ncol,top_lev:) = qi_st_star(:ncol,top_lev:) + nl(:ncol,top_lev:) = nl_star(:ncol,top_lev:) + ni(:ncol,top_lev:) = ni_star(:ncol,top_lev:) + + enddo ! End of 'iter' prognostic iterative computation + + ! ------------------------------------------------------------------------ ! + ! Compute final tendencies of main output variables and diagnostic outputs ! + ! Note that the very input state [T0,qv0,ql0,qi0] are ! + ! marched to [T_star,qv_star,ql_star,qi_star] with equilibrium ! + ! stratus informations of [a_st_star,ql_st_star,qi_st_star] by ! + ! below final tendencies and [A_T,A_qv,A_ql,A_qi] ! + ! ------------------------------------------------------------------------ ! + + ! ------------------ ! + ! Process tendencies ! + ! ------------------ ! + + QQw_final(:ncol,top_lev:) = QQw_prog(:ncol,top_lev:) + QQi_final(:ncol,top_lev:) = QQi_prog(:ncol,top_lev:) + QQ_final(:ncol,top_lev:) = QQw_final(:ncol,top_lev:) + QQi_final(:ncol,top_lev:) + QQw_all(:ncol,top_lev:) = QQw_prog(:ncol,top_lev:) + QQw1(:ncol,top_lev:) + QQw2(:ncol,top_lev:) + & + qlten_pwi1(:ncol,top_lev:) + qlten_pwi2(:ncol,top_lev:) + A_ql_adj(:ncol,top_lev:) + QQi_all(:ncol,top_lev:) = QQi_prog(:ncol,top_lev:) + QQi1(:ncol,top_lev:) + QQi2(:ncol,top_lev:) + & + qiten_pwi1(:ncol,top_lev:) + qiten_pwi2(:ncol,top_lev:) + A_qi_adj(:ncol,top_lev:) + QQ_all(:ncol,top_lev:) = QQw_all(:ncol,top_lev:) + QQi_all(:ncol,top_lev:) + QQnl_final(:ncol,top_lev:) = QQnl_prog(:ncol,top_lev:) + QQni_final(:ncol,top_lev:) = QQni_prog(:ncol,top_lev:) + QQn_final(:ncol,top_lev:) = QQnl_final(:ncol,top_lev:) + QQni_final(:ncol,top_lev:) + QQnl_all(:ncol,top_lev:) = QQnl_prog(:ncol,top_lev:) + QQnl1(:ncol,top_lev:) + QQnl2(:ncol,top_lev:) + & + nlten_pwi1(:ncol,top_lev:) + nlten_pwi2(:ncol,top_lev:) + ACnl(:ncol,top_lev:) + A_nl_adj(:ncol,top_lev:) + QQni_all(:ncol,top_lev:) = QQni_prog(:ncol,top_lev:) + QQni1(:ncol,top_lev:) + QQni2(:ncol,top_lev:) + & + niten_pwi1(:ncol,top_lev:) + niten_pwi2(:ncol,top_lev:) + ACni(:ncol,top_lev:) + A_ni_adj(:ncol,top_lev:) + QQn_all(:ncol,top_lev:) = QQnl_all(:ncol,top_lev:) + QQni_all(:ncol,top_lev:) + qme(:ncol,top_lev:) = QQ_final(:ncol,top_lev:) + qvadj(:ncol,top_lev:) = qvten_pwi1(:ncol,top_lev:) + qvten_pwi2(:ncol,top_lev:) + A_qv_adj(:ncol,top_lev:) + qladj(:ncol,top_lev:) = qlten_pwi1(:ncol,top_lev:) + qlten_pwi2(:ncol,top_lev:) + A_ql_adj(:ncol,top_lev:) + qiadj(:ncol,top_lev:) = qiten_pwi1(:ncol,top_lev:) + qiten_pwi2(:ncol,top_lev:) + A_qi_adj(:ncol,top_lev:) + qllim(:ncol,top_lev:) = QQw1 (:ncol,top_lev:) + QQw2 (:ncol,top_lev:) + qilim(:ncol,top_lev:) = QQi1 (:ncol,top_lev:) + QQi2 (:ncol,top_lev:) + + ! ----------------- ! + ! Output tendencies ! + ! ----------------- ! + + s_tendout(:ncol,top_lev:) = cpair*( T_star(:ncol,top_lev:) - T0(:ncol,top_lev:) )/dt - & + cpair*(A_T(:ncol,top_lev:)+C_T(:ncol,top_lev:)) + qv_tendout(:ncol,top_lev:) = ( qv_star(:ncol,top_lev:) - qv0(:ncol,top_lev:) )/dt - & + (A_qv(:ncol,top_lev:)+C_qv(:ncol,top_lev:)) + ql_tendout(:ncol,top_lev:) = ( ql_star(:ncol,top_lev:) - ql0(:ncol,top_lev:) )/dt - & + (A_ql(:ncol,top_lev:)+C_ql(:ncol,top_lev:)) + qi_tendout(:ncol,top_lev:) = ( qi_star(:ncol,top_lev:) - qi0(:ncol,top_lev:) )/dt - & + (A_qi(:ncol,top_lev:)+C_qi(:ncol,top_lev:)) + nl_tendout(:ncol,top_lev:) = ( nl_star(:ncol,top_lev:) - nl0(:ncol,top_lev:) )/dt - & + (A_nl(:ncol,top_lev:)+C_nl(:ncol,top_lev:)) + ni_tendout(:ncol,top_lev:) = ( ni_star(:ncol,top_lev:) - ni0(:ncol,top_lev:) )/dt - & + (A_ni(:ncol,top_lev:)+C_ni(:ncol,top_lev:)) + + if (.not. do_cldice) then + do k = top_lev, pver + do i = 1, ncol + + ! Don't want either qi or ni tendencies, but the code above is somewhat convoluted and + ! is trying to adjust both (small numbers). Just force it to zero here. + qi_tendout(i,k) = 0._r8 + ni_tendout(i,k) = 0._r8 + end do + end do + end if + + ! ------------------ ! + ! Net cloud fraction ! + ! ------------------ ! + + cld(:ncol,top_lev:) = a_st_star(:ncol,top_lev:) + a_cu0(:ncol,top_lev:) + + ! --------------------------------- ! + ! Updated grid-mean state variables ! + ! --------------------------------- ! + + T0(:ncol,top_lev:) = T_star(:ncol,top_lev:) + qv0(:ncol,top_lev:) = qv_star(:ncol,top_lev:) + ql0(:ncol,top_lev:) = ql_star(:ncol,top_lev:) + qi0(:ncol,top_lev:) = qi_star(:ncol,top_lev:) + nl0(:ncol,top_lev:) = nl_star(:ncol,top_lev:) + ni0(:ncol,top_lev:) = ni_star(:ncol,top_lev:) + + if (hist_fld_active('RHMIN_LIQ')) then + ! Compute default critical RH as a function of height and surface type as in the current code. + rhmin_liq_diag(:,:) = 0._r8 + do k = top_lev, pver + do i = 1, ncol + land = nint(landfrac(i)) == 1 + if( p(i,k) .ge. premib ) then + if( land .and. (snowh(i).le.0.000001_r8) ) then + rhmin_liq_diag(i,k) = rhminl_const - rhminl_adj_land_const + else + rhmin_liq_diag(i,k) = rhminl_const + endif + elseif( p(i,k) .lt. premit ) then + rhmin_liq_diag(i,k) = rhminh_const + else + tmp = (premib-(max(p(i,k),premit)))/(premib-premit) + rhmin_liq_diag(i,k) = rhminh_const*tmp + rhminl_const*(1.0_r8-tmp) + endif + end do + end do + call outfld( 'RHMIN_LIQ', rhmin_liq_diag, pcols, lchnk ) + end if + + rhmin_ice_diag(:,:) = rhminh_const + call outfld( 'RHMIN_ICE', rhmin_ice_diag, pcols, lchnk ) + + call outfld( 'DRHMINPBL_LIQ', d_rhmin_liq_PBL, pcols, lchnk ) + call outfld( 'DRHMINPBL_ICE', d_rhmin_ice_PBL, pcols, lchnk ) + call outfld( 'DRHMINDET_LIQ', d_rhmin_liq_det, pcols, lchnk ) + call outfld( 'DRHMINDET_ICE', d_rhmin_ice_det, pcols, lchnk ) + + end subroutine mmacro_pcond + + +!======================================================================================================= + +subroutine rhcrit_calc( & + ncol, dp, T0, p, & + clrw_old, clri_old, tke, qtl_flx, & + qti_flx, cmfr_det, qlr_det, qir_det, & + rhmaxi_arr, rhmini_arr, rhminl_arr, rhminl_adj_land_arr, rhminh_arr, & + d_rhmin_liq_PBL, d_rhmin_ice_PBL, d_rhmin_liq_det, d_rhmin_ice_det) + + ! ------------------------------------------------- ! + ! Compute a drop of critical RH for stratus by ! + ! (1) PBL turbulence, and ! + ! (2) convective detrainment. ! + ! Note that all of 'd_rhmin...' terms are positive. ! + ! ------------------------------------------------- ! + + integer, intent(in) :: ncol ! Number of active columns + real(r8), intent(in) :: dp(pcols,pver) ! Pressure thickness [Pa] > 0 + real(r8), intent(in) :: T0(pcols,pver) ! Temperature [K] + real(r8), intent(in) :: p(pcols,pver) ! Pressure at the layer mid-point [Pa] + real(r8), intent(in) :: clrw_old(pcols,pver) ! Clear sky fraction at the previous time step for liquid stratus process + real(r8), intent(in) :: clri_old(pcols,pver) ! Clear sky fraction at the previous time step for ice stratus process + real(r8), pointer :: tke(:,:) ! (pcols,pverp) TKE from the PBL scheme + real(r8), pointer :: qtl_flx(:,:) ! (pcols,pverp) overbar(w'qtl') from PBL scheme where qtl = qv + ql + real(r8), pointer :: qti_flx(:,:) ! (pcols,pverp) overbar(w'qti') from PBL scheme where qti = qv + qi + real(r8), pointer :: cmfr_det(:,:) ! (pcols,pver) Detrained mass flux from the convection scheme + real(r8), pointer :: qlr_det(:,:) ! (pcols,pver) Detrained ql from the convection scheme + real(r8), pointer :: qir_det(:,:) ! (pcols,pver) Detrained qi from the convection scheme + + real(r8), intent(in) :: rhmaxi_arr(pcols,pver) + + real(r8), intent(out) :: rhmini_arr(pcols,pver) + real(r8), intent(out) :: rhminl_arr(pcols,pver) + real(r8), intent(out) :: rhminl_adj_land_arr(pcols,pver) + real(r8), intent(out) :: rhminh_arr(pcols,pver) + real(r8), intent(out) :: d_rhmin_liq_PBL(pcols,pver) + real(r8), intent(out) :: d_rhmin_ice_PBL(pcols,pver) + real(r8), intent(out) :: d_rhmin_liq_det(pcols,pver) + real(r8), intent(out) :: d_rhmin_ice_det(pcols,pver) + + ! local variables + + integer :: i, k + + real(r8) :: esat_tmp(pcols) ! Dummy for saturation vapor pressure calc. + real(r8) :: qsat_tmp(pcols) ! Saturation water vapor specific humidity [kg/kg] + real(r8) :: sig_tmp + !--------------------------------------------------------------------------------------------------- + + + + ! ---------------------------------- ! + ! Calc critical RH for ice stratus ! + ! ---------------------------------- ! + + rhmini_arr(:,:) = rhmini_const + + if (i_rhmini > 0) then + + ! Compute the drop of critical RH by convective detrainment of cloud condensate + + do k = top_lev, pver + do i = 1, ncol + d_rhmin_ice_det(i,k) = tau_deti*(gravit/dp(i,k))*cmfr_det(i,k)*clri_old(i,k)*qir_det(i,k)*3.6e6_r8 + d_rhmin_ice_det(i,k) = max(0._r8,min(0.5_r8,d_rhmin_ice_det(i,k))) + end do + end do + + if (i_rhmini == 1) then + rhmini_arr(:ncol,:) = rhmini_const - d_rhmin_ice_det(:ncol,:) + end if + + end if + + if (i_rhmini == 2) then + + ! Compute the drop of critical RH by the variability induced by PBL turbulence + + do k = top_lev, pver + call qsat_ice(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol)) + + do i = 1, ncol + sig_tmp = 0.5_r8 * ( qti_flx(i,k) / sqrt(max(qsmall,tke(i,k))) + & + qti_flx(i,k+1) / sqrt(max(qsmall,tke(i,k+1))) ) + d_rhmin_ice_PBL(i,k) = c_aniso*sig_tmp/max(qsmall,qsat_tmp(i)) + d_rhmin_ice_PBL(i,k) = max(0._r8,min(0.5_r8,d_rhmin_ice_PBL(i,k))) + + rhmini_arr(i,k) = 1._r8 - d_rhmin_ice_PBL(i,k) - d_rhmin_ice_det(i,k) + end do + end do + end if + + if (i_rhmini > 0) then + do k = top_lev, pver + do i = 1, ncol + rhmini_arr(i,k) = max(0._r8,min(rhmaxi_arr(i,k),rhmini_arr(i,k))) + end do + end do + end if + + ! ------------------------------------- ! + ! Choose critical RH for liquid stratus ! + ! ------------------------------------- ! + + rhminl_arr(:,:) = rhminl_const + rhminl_adj_land_arr(:,:) = rhminl_adj_land_const + rhminh_arr(:,:) = rhminh_const + + if (i_rhminl > 0) then + + ! Compute the drop of critical RH by convective detrainment of cloud condensate + + do k = top_lev, pver + do i = 1, ncol + d_rhmin_liq_det(i,k) = tau_detw*(gravit/dp(i,k))*cmfr_det(i,k)*clrw_old(i,k)*qlr_det(i,k)*3.6e6_r8 + d_rhmin_liq_det(i,k) = max(0._r8,min(0.5_r8,d_rhmin_liq_det(i,k))) + end do + end do + + if (i_rhminl == 1) then + rhminl_arr(:ncol,top_lev:) = rhminl_const - d_rhmin_liq_det(:ncol,top_lev:) + rhminh_arr(:ncol,top_lev:) = rhminh_const - d_rhmin_liq_det(:ncol,top_lev:) + end if + + end if + + if (i_rhminl == 2) then + + ! Compute the drop of critical RH by the variability induced by PBL turbulence + + do k = top_lev, pver + call qsat_water(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol)) + + do i = 1, ncol + sig_tmp = 0.5_r8 * ( qtl_flx(i,k) / sqrt(max(qsmall,tke(i,k))) + & + qtl_flx(i,k+1) / sqrt(max(qsmall,tke(i,k+1))) ) + d_rhmin_liq_PBL(i,k) = c_aniso*sig_tmp/max(qsmall,qsat_tmp(i)) + d_rhmin_liq_PBL(i,k) = max(0._r8,min(0.5_r8,d_rhmin_liq_PBL(i,k))) + + rhminl_arr(i,k) = 1._r8 - d_rhmin_liq_PBL(i,k) - d_rhmin_liq_det(i,k) + rhminl_adj_land_arr(i,k) = 0._r8 + rhminh_arr(i,k) = rhminl_arr(i,k) + end do + end do + end if + + if (i_rhminl > 0) then + do k = top_lev, pver + do i = 1, ncol + rhminl_arr(i,k) = max(rhminl_adj_land_arr(i,k),min(1._r8,rhminl_arr(i,k))) + rhminh_arr(i,k) = max(0._r8,min(1._r8,rhminh_arr(i,k))) + end do + end do + end if + +end subroutine rhcrit_calc + +!======================================================================================================= + + subroutine instratus_condensate( lchnk, ncol, k, & + p_in, T0_in, qv0_in, ql0_in, qi0_in, & + ni0_in, & + a_dc_in, ql_dc_in, qi_dc_in, & + a_sc_in, ql_sc_in, qi_sc_in, & + landfrac, snowh, & + rhmaxi_in, rhmini_in, rhminl_in, rhminl_adj_land_in, rhminh_in, & + T_out, qv_out, ql_out, qi_out, & + al_st_out, ai_st_out, ql_st_out, qi_st_out ) + + ! ------------------------------------------------------- ! + ! Diagnostically force in-stratus condensate to be ! + ! in the range of 'qlst_min < qc_st < qlst_max' ! + ! whenever stratus exists in the equilibrium state ! + ! ------------------------------------------------------- ! + + integer, intent(in) :: lchnk ! Chunk identifier + integer, intent(in) :: ncol ! Number of atmospheric columns + integer, intent(in) :: k ! Layer index + + real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa] + real(r8), intent(in) :: T0_in(pcols) ! Temperature [K] + real(r8), intent(in) :: qv0_in(pcols) ! Grid-mean water vapor [kg/kg] + real(r8), intent(in) :: ql0_in(pcols) ! Grid-mean LWC [kg/kg] + real(r8), intent(in) :: qi0_in(pcols) ! Grid-mean IWC [kg/kg] + real(r8), intent(in) :: ni0_in(pcols) + + real(r8), intent(in) :: a_dc_in(pcols) ! Deep cumulus cloud fraction + real(r8), intent(in) :: ql_dc_in(pcols) ! In-deep cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_dc_in(pcols) ! In-deep cumulus IWC [kg/kg] + real(r8), intent(in) :: a_sc_in(pcols) ! Shallow cumulus cloud fraction + real(r8), intent(in) :: ql_sc_in(pcols) ! In-shallow cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_sc_in(pcols) ! In-shallow cumulus IWC [kg/kg] + + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: snowh(pcols) ! Snow depth (liquid water equivalent) + + real(r8), intent(in) :: rhmaxi_in(pcols) + real(r8), intent(in) :: rhmini_in(pcols) + real(r8), intent(in) :: rhminl_in(pcols) + real(r8), intent(in) :: rhminl_adj_land_in(pcols) + real(r8), intent(in) :: rhminh_in(pcols) + + real(r8), intent(out) :: T_out(pcols) ! Temperature [K] + real(r8), intent(out) :: qv_out(pcols) ! Grid-mean water vapor [kg/kg] + real(r8), intent(out) :: ql_out(pcols) ! Grid-mean LWC [kg/kg] + real(r8), intent(out) :: qi_out(pcols) ! Grid-mean IWC [kg/kg] + + real(r8), intent(out) :: al_st_out(pcols) ! Liquid stratus fraction + real(r8), intent(out) :: ai_st_out(pcols) ! Ice stratus fraction + real(r8), intent(out) :: ql_st_out(pcols) ! In-stratus LWC [kg/kg] + real(r8), intent(out) :: qi_st_out(pcols) ! In-stratus IWC [kg/kg] + + ! Local variables + + integer i ! Column index + + real(r8) p + real(r8) T0 + real(r8) qv0 + real(r8) ql0 + real(r8) qi0 + real(r8) a_dc + real(r8) ql_dc + real(r8) qi_dc + real(r8) a_sc + real(r8) ql_sc + real(r8) qi_sc + real(r8) esat0 + real(r8) qsat0 + real(r8) U0 + real(r8) U0_nc + real(r8) G0_nc + real(r8) al0_st_nc + real(r8) al0_st + real(r8) ai0_st_nc + real(r8) ai0_st + real(r8) a0_st + real(r8) ql0_nc + real(r8) qi0_nc + real(r8) qc0_nc + real(r8) ql0_st + real(r8) qi0_st + real(r8) qc0_st + real(r8) T + real(r8) qv + real(r8) ql + real(r8) qi + real(r8) ql_st + real(r8) qi_st + real(r8) es + real(r8) qs + real(r8) esat_in(pcols) + real(r8) qsat_in(pcols) + real(r8) U0_in(pcols) + real(r8) al0_st_nc_in(pcols) + real(r8) ai0_st_nc_in(pcols) + real(r8) G0_nc_in(pcols) + integer idxmod + real(r8) U + real(r8) U_nc + real(r8) al_st_nc + real(r8) ai_st_nc + real(r8) G_nc + real(r8) a_st + real(r8) al_st + real(r8) ai_st + real(r8) Tmin0 + real(r8) Tmax0 + real(r8) Tmin + real(r8) Tmax + integer caseid + + real(r8) rhmaxi + real(r8) rhmini + real(r8) rhminl + real(r8) rhminl_adj_land + real(r8) rhminh + + ! ---------------- ! + ! Main Computation ! + ! ---------------- ! + + call qsat_water(T0_in(1:ncol), p_in(1:ncol), & + esat_in(1:ncol), qsat_in(1:ncol)) + U0_in(:ncol) = qv0_in(:ncol)/qsat_in(:ncol) + if( CAMstfrac ) then + call astG_RHU(U0_in(:),p_in(:),qv0_in(:),landfrac(:),snowh(:),al0_st_nc_in(:),G0_nc_in(:),ncol,& + rhminl_in(:), rhminl_adj_land_in(:), rhminh_in(:)) + else + call astG_PDF(U0_in(:),p_in(:),qv0_in(:),landfrac(:),snowh(:),al0_st_nc_in(:),G0_nc_in(:),ncol,& + rhminl_in(:), rhminl_adj_land_in(:), rhminh_in(:)) + endif + call aist_vector(qv0_in(:),T0_in(:),p_in(:),qi0_in(:),ni0_in(:),landfrac(:),snowh(:),ai0_st_nc_in(:),ncol,& + rhmaxi_in(:), rhmini_in(:), rhminl_in(:), rhminl_adj_land_in(:), rhminh_in(:)) + + do i = 1, ncol + + ! ---------------------- ! + ! Define local variables ! + ! ---------------------- ! + + p = p_in(i) + + T0 = T0_in(i) + qv0 = qv0_in(i) + ql0 = ql0_in(i) + qi0 = qi0_in(i) + + a_dc = a_dc_in(i) + ql_dc = ql_dc_in(i) + qi_dc = qi_dc_in(i) + + a_sc = a_sc_in(i) + ql_sc = ql_sc_in(i) + qi_sc = qi_sc_in(i) + + ql_dc = 0._r8 + qi_dc = 0._r8 + ql_sc = 0._r8 + qi_sc = 0._r8 + + es = esat_in(i) + qs = qsat_in(i) + + rhmaxi = rhmaxi_in(i) + rhmini = rhmini_in(i) + rhminl = rhminl_in(i) + rhminl_adj_land = rhminl_adj_land_in(i) + rhminh = rhminh_in(i) + + idxmod = 0 + caseid = -1 + + ! ------------------------------------------------------------ ! + ! Force the grid-mean RH to be smaller than 1 if oversaturated ! + ! In order to be compatible with reduced 3x3 QQ, condensation ! + ! should occur only into the liquid in gridmean_RH. ! + ! ------------------------------------------------------------ ! + + if( qv0 .gt. qs ) then + call gridmean_RH( lchnk, i, k, p, T0, qv0, ql0, qi0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, & + landfrac(i), snowh(i) ) + call qsat_water(T0, p, esat0, qsat0) + U0 = (qv0/qsat0) + U0_nc = U0 + if( CAMstfrac ) then + call astG_RHU_single(U0_nc, p, qv0, landfrac(i), snowh(i), al0_st_nc, G0_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + else + call astG_PDF_single(U0_nc, p, qv0, landfrac(i), snowh(i), al0_st_nc, G0_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + endif + call aist_single(qv0,T0,p,qi0,landfrac(i),snowh(i),ai0_st_nc,& + rhmaxi, rhmini, rhminl, rhminl_adj_land, rhminh) + ai0_st = (1._r8-a_dc-a_sc)*ai0_st_nc + al0_st = (1._r8-a_dc-a_sc)*al0_st_nc + a0_st = max(ai0_st,al0_st) + idxmod = 1 + else + ai0_st = (1._r8-a_dc-a_sc)*ai0_st_nc_in(i) + al0_st = (1._r8-a_dc-a_sc)*al0_st_nc_in(i) + endif + a0_st = max(ai0_st,al0_st) + + ! ----------------------- ! + ! Handling of input state ! + ! ----------------------- ! + + ql0_nc = max(0._r8,ql0-a_dc*ql_dc-a_sc*ql_sc) + qi0_nc = max(0._r8,qi0-a_dc*qi_dc-a_sc*qi_sc) + qc0_nc = ql0_nc + qi0_nc + + Tmin0 = T0 - (latvap/cpair)*ql0 + Tmax0 = T0 + ((latvap+latice)/cpair)*qv0 + + ! ------------------------------------------------------------- ! + ! Do nothing and just exit if generalized in-stratus condensate ! + ! condition is satisfied. This includes the case I. ! + ! For 4x4 liquid stratus, a0_st --> al0_st. ! + ! ------------------------------------------------------------- ! + if( ( ql0_nc .ge. qlst_min*al0_st ) .and. ( ql0_nc .le. qlst_max*al0_st ) ) then + + ! ------------------ ! + ! This is the case I ! + ! ------------------ ! + T = T0 + qv = qv0 + ql = ql0 + qi = qi0 + caseid = 0 + goto 10 + else + ! ----------------------------- ! + ! This is case II : Dense Cloud ! + ! ----------------------------- ! + if( al0_st .eq. 0._r8 .and. ql0_nc .gt. 0._r8 ) then + ! ------------------------------------- ! + ! Compute hypothetical full evaporation ! + ! ------------------------------------- ! + T = Tmin0 + qv = qv0 + ql0 + call qsat_water(T, p, es, qs) + U = qv/qs + U_nc = U + if( CAMstfrac ) then + call astG_RHU_single(U_nc, p, qv, landfrac(i), snowh(i), al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + else + call astG_PDF_single(U_nc, p, qv, landfrac(i), snowh(i), al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + endif + al_st = (1._r8-a_dc-a_sc)*al_st_nc + caseid = 0 + + if( al_st .eq. 0._r8 ) then + ql = 0._r8 + qi = qi0 + idxmod = 1 + caseid = 1 + goto 10 + else + ! ------------------------------------------- ! + ! Evaporate until qc_st decreases to qlst_max ! + ! ------------------------------------------- ! + Tmin = Tmin0 + Tmax = T0 + call instratus_core( lchnk, i, k, p, & + T0, qv0, ql0, 0._r8, & + a_dc, ql_dc, qi_dc, & + a_sc, ql_sc, qi_sc, ai0_st, & + qlst_max, Tmin, Tmax, landfrac(i), snowh(i), & + rhminl, rhminl_adj_land, rhminh, & + T, qv, ql, qi ) + idxmod = 1 + caseid = 2 + goto 10 + endif + ! ------------------------------ ! + ! This is case III : Empty Cloud ! + ! ------------------------------ ! + elseif( al0_st .gt. 0._r8 .and. ql0_nc .eq. 0._r8 ) then + ! ------------------------------------------ ! + ! Condense until qc_st increases to qlst_min ! + ! ------------------------------------------ ! + Tmin = Tmin0 + Tmax = Tmax0 + call instratus_core( lchnk, i, k, p, & + T0, qv0, ql0, 0._r8, & + a_dc, ql_dc, qi_dc, & + a_sc, ql_sc, qi_sc, ai0_st, & + qlst_min, Tmin, Tmax, landfrac(i), snowh(i), & + rhminl, rhminl_adj_land, rhminh, & + T, qv, ql, qi ) + idxmod = 1 + caseid = 3 + goto 10 + ! --------------- ! + ! This is case IV ! + ! --------------- ! + elseif( al0_st .gt. 0._r8 .and. ql0_nc .gt. 0._r8 ) then + + if( ql0_nc .gt. qlst_max*al0_st ) then + ! --------------------------------------- ! + ! Evaporate until qc_st drops to qlst_max ! + ! --------------------------------------- ! + Tmin = Tmin0 + Tmax = Tmax0 + call instratus_core( lchnk, i, k, p, & + T0, qv0, ql0, 0._r8, & + a_dc, ql_dc, qi_dc, & + a_sc, ql_sc, qi_sc, ai0_st, & + qlst_max, Tmin, Tmax, landfrac(i), snowh(i), & + rhminl, rhminl_adj_land, rhminh, & + T, qv, ql, qi ) + idxmod = 1 + caseid = 4 + goto 10 + elseif( ql0_nc .lt. qlst_min*al0_st ) then + ! -------------------------------------------- ! + ! Condensate until qc_st increases to qlst_min ! + ! -------------------------------------------- ! + Tmin = Tmin0 + Tmax = Tmax0 + call instratus_core( lchnk, i, k, p, & + T0, qv0, ql0, 0._r8, & + a_dc, ql_dc, qi_dc, & + a_sc, ql_sc, qi_sc, ai0_st, & + qlst_min, Tmin, Tmax, landfrac(i), snowh(i), & + rhminl, rhminl_adj_land, rhminh, & + T, qv, ql, qi ) + idxmod = 1 + caseid = 5 + goto 10 + else + ! ------------------------------------------------ ! + ! This case should not happen. Issue error message ! + ! ------------------------------------------------ ! + write(iulog,*) 'Impossible case1 in instratus_condensate' + call endrun + endif + ! ------------------------------------------------ ! + ! This case should not happen. Issue error message ! + ! ------------------------------------------------ ! + else + write(iulog,*) 'Impossible case2 in instratus_condensate' + write(iulog,*) al0_st, a_sc, a_dc + write(iulog,*) 1000*ql0_nc, 1000*(ql0+qi0) + call endrun + endif + endif + +10 continue + + ! -------------------------------------------------- ! + ! Force final energy-moisture conserving consistency ! + ! -------------------------------------------------- ! + + qi = qi0 + + if( idxmod .eq. 1 ) then + call aist_single(qv,T,p,qi,landfrac(i),snowh(i),ai_st_nc,& + rhmaxi, rhmini, rhminl, rhminl_adj_land, rhminh) + ai_st = (1._r8-a_dc-a_sc)*ai_st_nc + call qsat_water(T, p, es, qs) + U = (qv/qs) + U_nc = U + if( CAMstfrac ) then + call astG_RHU_single(U_nc, p, qv, landfrac(i), snowh(i), al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + else + call astG_PDF_single(U_nc, p, qv, landfrac(i), snowh(i), al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + endif + al_st = (1._r8-a_dc-a_sc)*al_st_nc + else + ai_st = (1._r8-a_dc-a_sc)*ai0_st_nc_in(i) + al_st = (1._r8-a_dc-a_sc)*al0_st_nc_in(i) + endif + + a_st = max(ai_st,al_st) + + if( al_st .eq. 0._r8 ) then + ql_st = 0._r8 + else + ql_st = ql/al_st + ql_st = min(qlst_max,max(qlst_min,ql_st)) ! PJR + endif + if( ai_st .eq. 0._r8 ) then + qi_st = 0._r8 + else + qi_st = qi/ai_st + endif + + qi = ai_st*qi_st + ql = al_st*ql_st + + T = T0 - (latvap/cpair)*(ql0-ql) - ((latvap+latice)/cpair)*(qi0-qi) + qv = qv0 + ql0 - ql + qi0 - qi + + ! -------------- ! + ! Send to output ! + ! -------------- ! + + T_out(i) = T + qv_out(i) = qv + ql_out(i) = ql + qi_out(i) = qi + al_st_out(i) = al_st + ai_st_out(i) = ai_st + ql_st_out(i) = ql_st + qi_st_out(i) = qi_st + + enddo + + return + end subroutine instratus_condensate + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + + subroutine instratus_core( lchnk, icol, k, p, & + T0, qv0, ql0, qi0, & + a_dc, ql_dc, qi_dc, & + a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, Tmin, Tmax, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + T, qv, ql, qi ) + + ! ------------------------------------------------------ ! + ! Subroutine to find saturation equilibrium state using ! + ! a Newton iteration method, so that 'qc_st = qcst_crit' ! + ! is satisfied. ! + ! ------------------------------------------------------ ! + + integer, intent(in) :: lchnk ! Chunk identifier + integer, intent(in) :: icol ! Number of atmospheric columns + integer, intent(in) :: k ! Layer index + + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(in) :: T0 ! Temperature [K] + real(r8), intent(in) :: qv0 ! Grid-mean water vapor [kg/kg] + real(r8), intent(in) :: ql0 ! Grid-mean LWC [kg/kg] + real(r8), intent(in) :: qi0 ! Grid-mean IWC [kg/kg] + + real(r8), intent(in) :: a_dc ! Deep cumulus cloud fraction + real(r8), intent(in) :: ql_dc ! In-deep cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_dc ! In-deep cumulus IWC [kg/kg] + real(r8), intent(in) :: a_sc ! Shallow cumulus cloud fraction + real(r8), intent(in) :: ql_sc ! In-shallow cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_sc ! In-shallow cumulus IWC [kg/kg] + + real(r8), intent(in) :: ai_st ! Ice stratus fraction (fixed) + + real(r8), intent(in) :: Tmin ! Minimum temperature system can have [K] + real(r8), intent(in) :: Tmax ! Maximum temperature system can have [K] + real(r8), intent(in) :: qcst_crit ! Critical in-stratus condensate [kg/kg] + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + real(r8), intent(in) :: rhminl + real(r8), intent(in) :: rhminl_adj_land + real(r8), intent(in) :: rhminh + + real(r8), intent(out) :: T ! Temperature [K] + real(r8), intent(out) :: qv ! Grid-mean water vapor [kg/kg] + real(r8), intent(out) :: ql ! Grid-mean LWC [kg/kg] + real(r8), intent(out) :: qi ! Grid-mean IWC [kg/kg] + + ! Local variables + + integer i ! Iteration index + + real(r8) muQ0, muQ + real(r8) ql_nc0, qi_nc0, qc_nc0, qc_nc + real(r8) fice0, fice + real(r8) ficeg0, ficeg + real(r8) esat0 + real(r8) qsat0 + real(r8) dqcncdt, dastdt, dUdt + real(r8) alpha, beta + real(r8) U, U_nc + real(r8) al_st_nc, G_nc + real(r8) al_st + + ! Variables for root-finding algorithm + + integer j + real(r8) x1, x2 + real(r8) rtsafe + real(r8) df, dx, dxold, f, fh, fl, temp, xh, xl + real(r8), parameter :: xacc = 1.e-3_r8 + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + ql_nc0 = max(0._r8,ql0-a_dc*ql_dc-a_sc*ql_sc) + qi_nc0 = max(0._r8,qi0-a_dc*qi_dc-a_sc*qi_sc) + qc_nc0 = max(0._r8,ql0+qi0-a_dc*(ql_dc+qi_dc)-a_sc*(ql_sc+qi_sc)) + fice0 = 0._r8 + ficeg0 = 0._r8 + muQ0 = 1._r8 + + ! ------------ ! + ! Root finding ! + ! ------------ ! + + x1 = Tmin + x2 = Tmax + call funcd_instratus( x1, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + fl, df, qc_nc, fice, al_st ) + call funcd_instratus( x2, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + fh, df, qc_nc, fice, al_st ) + if((fl > 0._r8 .and. fh > 0._r8) .or. (fl < 0._r8 .and. fh < 0._r8)) then + call funcd_instratus( T0, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + fl, df, qc_nc, fice, al_st ) + rtsafe = T0 + goto 10 + endif + if( fl == 0._r8) then + rtsafe = x1 + goto 10 + elseif( fh == 0._r8) then + rtsafe = x2 + goto 10 + elseif( fl < 0._r8) then + xl = x1 + xh = x2 + else + xh = x1 + xl = x2 + end if + rtsafe = 0.5_r8*(x1+x2) + dxold = abs(x2-x1) + dx = dxold + call funcd_instratus( rtsafe, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + f, df, qc_nc, fice, al_st ) + do j = 1, 20 + if(((rtsafe-xh)*df-f)*((rtsafe-xl)*df-f) > 0._r8 .or. abs(2.0_r8*f) > abs(dxold*df) ) then + dxold = dx + dx = 0.5_r8*(xh-xl) + rtsafe = xl + dx + if(xl == rtsafe) goto 10 + else + dxold = dx + dx = f/df + temp = rtsafe + rtsafe = rtsafe - dx + if (temp == rtsafe) goto 10 + end if + ! if(abs(dx) < xacc) goto 10 + call funcd_instratus( rtsafe, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + f, df, qc_nc, fice, al_st ) + ! Sep.21.2010. Sungsu modified to enhance convergence and guarantee 'qlst_min < qlst < qlst_max'. + if( qcst_crit < 0.5_r8 * ( qlst_min + qlst_max ) ) then + if( ( qc_nc*(1._r8-fice) .gt. qlst_min*al_st .and. & + qc_nc*(1._r8-fice) .lt. 1.1_r8 * qlst_min*al_st ) ) goto 10 + else + if( ( qc_nc*(1._r8-fice) .gt. 0.9_r8 * qlst_max*al_st .and. & + qc_nc*(1._r8-fice) .lt. qlst_max*al_st ) ) goto 10 + endif + if(f < 0._r8) then + xl = rtsafe + else + xh = rtsafe + endif + + enddo + +10 continue + + ! ------------------------------------------- ! + ! Final safety check before sending to output ! + ! ------------------------------------------- ! + + qc_nc = max(0._r8,qc_nc) + + T = rtsafe + ql = qc_nc*(1._r8-fice) + a_dc*ql_dc + a_sc*ql_sc + qi = qc_nc*fice + a_dc*qi_dc + a_sc*qi_sc + qv = qv0 + ql0 + qi0 - (qc_nc + a_dc*(ql_dc+qi_dc) + a_sc*(ql_sc+qi_sc)) + qv = max(qv,1.e-12_r8) + + return + end subroutine instratus_core + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + + subroutine funcd_instratus( T, p, T0, qv0, ql0, qi0, fice0, muQ0, qc_nc0, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, ai_st, & + qcst_crit, landfrac, snowh, & + rhminl, rhminl_adj_land, rhminh, & + f, fg, qc_nc, fice, al_st ) + + ! --------------------------------------------------- ! + ! Subroutine to find function value and gradient at T ! + ! --------------------------------------------------- ! + + implicit none + + real(r8), intent(in) :: T ! Iteration temperature [K] + + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(in) :: T0 ! Initial temperature [K] + real(r8), intent(in) :: qv0 ! Grid-mean water vapor [kg/kg] + real(r8), intent(in) :: ql0 ! Grid-mean LWC [kg/kg] + real(r8), intent(in) :: qi0 ! Grid-mean IWC [kg/kg] + real(r8), intent(in) :: fice0 ! + real(r8), intent(in) :: muQ0 ! + real(r8), intent(in) :: qc_nc0 ! + + real(r8), intent(in) :: a_dc ! Deep cumulus cloud fraction + real(r8), intent(in) :: ql_dc ! In-deep cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_dc ! In-deep cumulus IWC [kg/kg] + real(r8), intent(in) :: a_sc ! Shallow cumulus cloud fraction + real(r8), intent(in) :: ql_sc ! In-shallow cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_sc ! In-shallow cumulus IWC [kg/kg] + + real(r8), intent(in) :: ai_st ! Ice stratus fraction (fixed) + + real(r8), intent(in) :: qcst_crit ! Critical in-stratus condensate [kg/kg] + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + real(r8), intent(in) :: rhminl + real(r8), intent(in) :: rhminl_adj_land + real(r8), intent(in) :: rhminh + + real(r8), intent(out) :: f ! Value of minimization function at T + real(r8), intent(out) :: fg ! Gradient of minimization function + real(r8), intent(out) :: qc_nc ! + real(r8), intent(out) :: al_st ! + real(r8), intent(out) :: fice ! + + ! Local variables + + real(r8) es + real(r8) qs + real(r8) dqsdT + real(r8) dqcncdt + real(r8) alpha + real(r8) beta + real(r8) U + real(r8) U_nc + real(r8) al_st_nc + real(r8) G_nc + real(r8) dUdt + real(r8) dalstdt + real(r8) qv + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + call qsat_water(T, p, es, qs, dqsdt=dqsdT) + + fice = fice0 + qc_nc = (cpair/latvap)*(T-T0)+muQ0*qc_nc0 + dqcncdt = (cpair/latvap) + qv = (qv0 + ql0 + qi0 - (qc_nc + a_dc*(ql_dc+qi_dc) + a_sc*(ql_sc+qi_sc))) + alpha = (1._r8/qs) + beta = (qv/qs**2._r8)*dqsdT + + U = (qv/qs) + U_nc = U + if( CAMstfrac ) then + call astG_RHU_single(U_nc, p, qv, landfrac, snowh, al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + else + call astG_PDF_single(U_nc, p, qv, landfrac, snowh, al_st_nc, G_nc, & + rhminl_in=rhminl, rhminl_adj_land_in=rhminl_adj_land, rhminh_in=rhminh) + endif + al_st = (1._r8-a_dc-a_sc)*al_st_nc + dUdt = -(alpha*dqcncdt+beta) + dalstdt = (1._r8/G_nc)*dUdt + if( U_nc .eq. 1._r8 ) dalstdt = 0._r8 + + f = qc_nc - qcst_crit*al_st + fg = dqcncdt - qcst_crit*dalstdt + + return + end subroutine funcd_instratus + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + + subroutine gridmean_RH( lchnk, icol, k, p, T, qv, ql, qi, & + a_dc, ql_dc, qi_dc, a_sc, ql_sc, qi_sc, & + landfrac, snowh ) + + ! ------------------------------------------------------------- ! + ! Subroutine to force grid-mean RH = 1 when RH > 1 ! + ! This is condensation process similar to instratus_condensate. ! + ! During condensation, we assume 'fice' is maintained in this ! + ! verison for MG not for RK. ! + ! ------------------------------------------------------------- ! + + integer, intent(in) :: lchnk ! Chunk identifier + integer, intent(in) :: icol ! Number of atmospheric columns + integer, intent(in) :: k ! Layer index + + real(r8), intent(in) :: p ! Pressure [Pa] + real(r8), intent(inout) :: T ! Temperature [K] + real(r8), intent(inout) :: qv ! Grid-mean water vapor [kg/kg] + real(r8), intent(inout) :: ql ! Grid-mean LWC [kg/kg] + real(r8), intent(inout) :: qi ! Grid-mean IWC [kg/kg] + + real(r8), intent(in) :: a_dc ! Deep cumulus cloud fraction + real(r8), intent(in) :: ql_dc ! In-deep cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_dc ! In-deep cumulus IWC [kg/kg] + real(r8), intent(in) :: a_sc ! Shallow cumulus cloud fraction + real(r8), intent(in) :: ql_sc ! In-shallow cumulus LWC [kg/kg] + real(r8), intent(in) :: qi_sc ! In-shallow cumulus IWC [kg/kg] + + real(r8), intent(in) :: landfrac ! Land fraction + real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent) + + ! Local variables + + integer m ! Iteration index + + real(r8) ql_nc0, qi_nc0, qc_nc0 + real(r8) Tscale + real(r8) Tc, qt, qc, dqcdt, qc_nc + real(r8) es, qs, dqsdT + real(r8) al_st_nc, G_nc + real(r8) f, fg + real(r8), parameter :: xacc = 1.e-3_r8 + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + ql_nc0 = max(0._r8,ql-a_dc*ql_dc-a_sc*ql_sc) + qi_nc0 = max(0._r8,qi-a_dc*qi_dc-a_sc*qi_sc) + qc_nc0 = max(0._r8,ql+qi-a_dc*(ql_dc+qi_dc)-a_sc*(ql_sc+qi_sc)) + Tc = T - (latvap/cpair)*ql + qt = qv + ql + + do m = 1, 20 + call qsat_water(T, p, es, qs, dqsdt=dqsdT) + Tscale = latvap/cpair + qc = (T-Tc)/Tscale + dqcdt = 1._r8/Tscale + f = qs + qc - qt + fg = dqsdT + dqcdt + fg = sign(1._r8,fg)*max(1.e-10_r8,abs(fg)) + ! Sungsu modified convergence criteria to speed up convergence and guarantee RH <= 1. + if( qc .ge. 0._r8 .and. ( qt - qc ) .ge. 0.999_r8*qs .and. ( qt - qc ) .le. 1._r8*qs ) then + goto 10 + endif + T = T - f/fg + enddo + ! write(iulog,*) 'Convergence in gridmean_RH is not reached. RH = ', ( qt - qc ) / qs +10 continue + + call qsat_water(T, p, es, qs) + ! Sungsu modified 'qv = qs' in consistent with the modified convergence criteria above. + qv = min(qt,qs) ! Modified + ql = qt - qv + T = Tc + (latvap/cpair)*ql + + return + end subroutine gridmean_RH + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + + subroutine positive_moisture( ncol, dt, qvmin, qlmin, qimin, dp, & + qv, ql, qi, t, qvten, & + qlten, qiten, tten, do_cldice) + + ! ------------------------------------------------------------------------------- ! + ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, ! + ! force them to be larger than minimum value by (1) condensating water vapor ! + ! into liquid or ice, and (2) by transporting water vapor from the very lower ! + ! layer. '2._r8' is multiplied to the minimum values for safety. ! + ! Update final state variables and tendencies associated with this correction. ! + ! If any condensation happens, update (s,t) too. ! + ! Note that (qv,ql,qi,t,s) are final state variables after applying corresponding ! + ! input tendencies. ! + ! Be careful the order of k : '1': top layer, 'pver' : near-surface layer ! + ! ------------------------------------------------------------------------------- ! + + implicit none + integer, intent(in) :: ncol + real(r8), intent(in) :: dt + real(r8), intent(in) :: dp(pcols,pver), qvmin(pcols,pver), qlmin(pcols,pver), qimin(pcols,pver) + real(r8), intent(inout) :: qv(pcols,pver), ql(pcols,pver), qi(pcols,pver), t(pcols,pver) + real(r8), intent(out) :: qvten(pcols,pver), qlten(pcols,pver), qiten(pcols,pver), tten(pcols,pver) + logical, intent(in) :: do_cldice + integer i, k + real(r8) dql, dqi, dqv, sum, aa, dum + + tten(:ncol,:pver) = 0._r8 + qvten(:ncol,:pver) = 0._r8 + qlten(:ncol,:pver) = 0._r8 + qiten(:ncol,:pver) = 0._r8 + + do i = 1, ncol + do k = top_lev, pver + if( qv(i,k) .lt. qvmin(i,k) .or. ql(i,k) .lt. qlmin(i,k) .or. qi(i,k) .lt. qimin(i,k) ) then + goto 10 + endif + enddo + goto 11 + 10 continue + do k = top_lev, pver ! From the top to the 1st (lowest) layer from the surface + dql = max(0._r8,1._r8*qlmin(i,k)-ql(i,k)) + + if (do_cldice) then + dqi = max(0._r8,1._r8*qimin(i,k)-qi(i,k)) + else + dqi = 0._r8 + end if + + qlten(i,k) = qlten(i,k) + dql/dt + qiten(i,k) = qiten(i,k) + dqi/dt + qvten(i,k) = qvten(i,k) - (dql+dqi)/dt + tten(i,k) = tten(i,k) + (latvap/cpair)*(dql/dt) + ((latvap+latice)/cpair)*(dqi/dt) + ql(i,k) = ql(i,k) + dql + qi(i,k) = qi(i,k) + dqi + qv(i,k) = qv(i,k) - dql - dqi + t(i,k) = t(i,k) + (latvap * dql + (latvap+latice) * dqi)/cpair + dqv = max(0._r8,1._r8*qvmin(i,k)-qv(i,k)) + qvten(i,k) = qvten(i,k) + dqv/dt + qv(i,k) = qv(i,k) + dqv + if( k .ne. pver ) then + qv(i,k+1) = qv(i,k+1) - dqv*dp(i,k)/dp(i,k+1) + qvten(i,k+1) = qvten(i,k+1) - dqv*dp(i,k)/dp(i,k+1)/dt + endif + qv(i,k) = max(qv(i,k),qvmin(i,k)) + ql(i,k) = max(ql(i,k),qlmin(i,k)) + qi(i,k) = max(qi(i,k),qimin(i,k)) + end do + ! Extra moisture used to satisfy 'qv(i,pver)=qvmin' is proportionally + ! extracted from all the layers that has 'qv > 2*qvmin'. This fully + ! preserves column moisture. + if( dqv .gt. 1.e-20_r8 ) then + sum = 0._r8 + do k = top_lev, pver + if( qv(i,k) .gt. 2._r8*qvmin(i,k) ) sum = sum + qv(i,k)*dp(i,k) + enddo + aa = dqv*dp(i,pver)/max(1.e-20_r8,sum) + if( aa .lt. 0.5_r8 ) then + do k = top_lev, pver + if( qv(i,k) .gt. 2._r8*qvmin(i,k) ) then + dum = aa*qv(i,k) + qv(i,k) = qv(i,k) - dum + qvten(i,k) = qvten(i,k) - dum/dt + endif + enddo + else + write(iulog,*) 'Full positive_moisture is impossible in Park Macro' + endif + endif +11 continue + enddo + return + + end subroutine positive_moisture + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + + SUBROUTINE gaussj(a,n,np,b,m,mp) + INTEGER m,mp,n,np,NMAX + real(r8) a(np,np),b(np,mp) + real(r8) aa(np,np),bb(np,mp) + PARAMETER (NMAX=50) + INTEGER i,icol,irow,j,k,l,ll,ii,jj,indxc(NMAX),indxr(NMAX),ipiv(NMAX) + real(r8) big,dum,pivinv + + aa(:,:) = a(:,:) + bb(:,:) = b(:,:) + + do 11 j=1,n + ipiv(j)=0 +11 continue + do 22 i=1,n + big=0._r8 + do 13 j=1,n + if(ipiv(j).ne.1)then + do 12 k=1,n + if (ipiv(k).eq.0) then + if (abs(a(j,k)).ge.big)then + big=abs(a(j,k)) + irow=j + icol=k + endif + else if (ipiv(k).gt.1) then + write(iulog,*) 'singular matrix in gaussj 1' + do ii = 1, np + do jj = 1, np + write(iulog,*) ii, jj, aa(ii,jj), bb(ii,1) + end do + end do + call endrun + endif +12 continue + endif +13 continue + ipiv(icol)=ipiv(icol)+1 + if (irow.ne.icol) then + do 14 l=1,n + dum=a(irow,l) + a(irow,l)=a(icol,l) + a(icol,l)=dum +14 continue + do 15 l=1,m + dum=b(irow,l) + b(irow,l)=b(icol,l) + b(icol,l)=dum +15 continue + endif + indxr(i)=irow + indxc(i)=icol + if (a(icol,icol).eq.0._r8) then + write(iulog,*) 'singular matrix in gaussj 2' + do ii = 1, np + do jj = 1, np + write(iulog,*) ii, jj, aa(ii,jj), bb(ii,1) + end do + end do + call endrun + endif + pivinv=1._r8/a(icol,icol) + a(icol,icol)=1._r8 + do 16 l=1,n + a(icol,l)=a(icol,l)*pivinv +16 continue + do 17 l=1,m + b(icol,l)=b(icol,l)*pivinv +17 continue + do 21 ll=1,n + if(ll.ne.icol)then + dum=a(ll,icol) + a(ll,icol)=0._r8 + do 18 l=1,n + a(ll,l)=a(ll,l)-a(icol,l)*dum +18 continue + do 19 l=1,m + b(ll,l)=b(ll,l)-b(icol,l)*dum +19 continue + endif +21 continue +22 continue + do 24 l=n,1,-1 + if(indxr(l).ne.indxc(l))then + do 23 k=1,n + dum=a(k,indxr(l)) + a(k,indxr(l))=a(k,indxc(l)) + a(k,indxc(l))=dum +23 continue + endif +24 continue + + return + end subroutine gaussj + + ! ----------------- ! + ! End of subroutine ! + ! ----------------- ! + +end module cldwat2m_macro diff --git a/src/physics/cam/cloud_cover_diags.F90 b/src/physics/cam/cloud_cover_diags.F90 new file mode 100644 index 0000000000..6fee6af868 --- /dev/null +++ b/src/physics/cam/cloud_cover_diags.F90 @@ -0,0 +1,192 @@ +!=============================================================================== +! cloud cover output +!=============================================================================== +module cloud_cover_diags + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver,pverp + use cam_history, only: addfld, add_default, outfld, horiz_only + use phys_control, only: phys_getopts + + implicit none + + private + + public :: cloud_cover_diags_init + public :: cloud_cover_diags_out + +contains + +!=============================================================================== +!=============================================================================== +subroutine cloud_cover_diags_init(sampling_seq) + + character(len=*), intent(in) :: sampling_seq + logical :: history_amwg ! output the variables used by the AMWG diag package + + call addfld ('CLOUD', (/ 'lev' /), 'A','fraction','Cloud fraction' , sampling_seq=sampling_seq) + call addfld ('CLDTOT',horiz_only, 'A','fraction','Vertically-integrated total cloud' , sampling_seq=sampling_seq) + call addfld ('CLDLOW',horiz_only, 'A','fraction','Vertically-integrated low cloud' , sampling_seq=sampling_seq) + call addfld ('CLDMED',horiz_only, 'A','fraction','Vertically-integrated mid-level cloud' , sampling_seq=sampling_seq) + call addfld ('CLDHGH',horiz_only, 'A','fraction','Vertically-integrated high cloud' , sampling_seq=sampling_seq) + + ! determine the add_default fields + call phys_getopts(history_amwg_out = history_amwg ) + + if (history_amwg) then + call add_default ('CLOUD ', 1, ' ') + call add_default ('CLDTOT ', 1, ' ') + call add_default ('CLDLOW ', 1, ' ') + call add_default ('CLDMED ', 1, ' ') + call add_default ('CLDHGH ', 1, ' ') + endif + + +end subroutine cloud_cover_diags_init + +!=============================================================================== +!=============================================================================== +subroutine cloud_cover_diags_out(lchnk, ncol, cld, pmid, nmxrgn, pmxrgn ) + + integer, intent(in) :: lchnk, ncol + real(r8), intent(in) :: cld(pcols,pver) + real(r8), intent(in) :: pmid(pcols,pver) + integer, intent(in) :: nmxrgn(pcols) + real(r8), intent(in) :: pmxrgn(pcols,pverp) + + real(r8) :: cltot(pcols) ! Diagnostic total cloud cover + real(r8) :: cllow(pcols) ! " low cloud cover + real(r8) :: clmed(pcols) ! " mid cloud cover + real(r8) :: clhgh(pcols) ! " hgh cloud cover + + call cldsav (lchnk, ncol, cld, pmid, cltot, cllow, clmed, clhgh, nmxrgn, pmxrgn) + + ! + ! Dump cloud field information to history tape buffer (diagnostics) + ! + call outfld('CLDTOT ',cltot ,pcols,lchnk) + call outfld('CLDLOW ',cllow ,pcols,lchnk) + call outfld('CLDMED ',clmed ,pcols,lchnk) + call outfld('CLDHGH ',clhgh ,pcols,lchnk) + + call outfld('CLOUD ',cld ,pcols,lchnk) + +end subroutine cloud_cover_diags_out + +!=============================================================================== +!=============================================================================== +subroutine cldsav(lchnk ,ncol , & + cld ,pmid ,cldtot ,cldlow ,cldmed , & + cldhgh ,nmxrgn ,pmxrgn ) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute total & 3 levels of cloud fraction assuming maximum-random overlap. +! Pressure ranges for the 3 cloud levels are specified. +! +! Method: +! +! +! +! Author: W. Collins +! +!----------------------------------------------------------------------- + + implicit none +! +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: cld(pcols,pver) ! Cloud fraction + real(r8), intent(in) :: pmid(pcols,pver) ! Level pressures + real(r8), intent(in) :: pmxrgn(pcols,pverp) ! Maximum values of pressure for each +! maximally overlapped region. +! 0->pmxrgn(i,1) is range of pressure for +! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for +! 2nd region, etc + + integer, intent(in) :: nmxrgn(pcols) ! Number of maximally overlapped regions +! +! Output arguments +! + real(r8), intent(out) :: cldtot(pcols) ! Total random overlap cloud cover + real(r8), intent(out) :: cldlow(pcols) ! Low random overlap cloud cover + real(r8), intent(out) :: cldmed(pcols) ! Middle random overlap cloud cover + real(r8), intent(out) :: cldhgh(pcols) ! High random overlap cloud cover + +! +!---------------------------Local workspace----------------------------- +! + integer i,k ! Longitude,level indices + integer irgn(pcols) ! Max-overlap region index + integer max_nmxrgn ! maximum value of nmxrgn over columns + integer ityp ! Type counter + real(r8) clrsky(pcols) ! Max-random clear sky fraction + real(r8) clrskymax(pcols) ! Maximum overlap clear sky fraction +!------------------------------Parameters------------------------------- + real(r8) plowmax ! Max prs for low cloud cover range + real(r8) plowmin ! Min prs for low cloud cover range + real(r8) pmedmax ! Max prs for mid cloud cover range + real(r8) pmedmin ! Min prs for mid cloud cover range + real(r8) phghmax ! Max prs for hgh cloud cover range + real(r8) phghmin ! Min prs for hgh cloud cover range +! + parameter (plowmax = 120000._r8,plowmin = 70000._r8, & + pmedmax = 70000._r8,pmedmin = 40000._r8, & + phghmax = 40000._r8,phghmin = 5000._r8) + + real(r8) ptypmin(4) + real(r8) ptypmax(4) + + data ptypmin /phghmin, plowmin, pmedmin, phghmin/ + data ptypmax /plowmax, plowmax, pmedmax, phghmax/ +! +!----------------------------------------------------------------------- +! +! Initialize region number +! + max_nmxrgn = -1 + do i=1,ncol + max_nmxrgn = max(max_nmxrgn,nmxrgn(i)) + end do + + do ityp = 1, 4 + irgn(1:ncol) = 1 + do k =1,max_nmxrgn-1 + do i=1,ncol + if (pmxrgn(i,irgn(i)) < ptypmin(ityp) .and. irgn(i) < nmxrgn(i)) then + irgn(i) = irgn(i) + 1 + end if + end do + end do +! +! Compute cloud amount by estimating clear-sky amounts +! + clrsky(1:ncol) = 1.0_r8 + clrskymax(1:ncol) = 1.0_r8 + do k = 1, pver + do i=1,ncol + if (pmid(i,k) >= ptypmin(ityp) .and. pmid(i,k) <= ptypmax(ityp)) then + if (pmxrgn(i,irgn(i)) < pmid(i,k) .and. irgn(i) < nmxrgn(i)) then + irgn(i) = irgn(i) + 1 + clrsky(i) = clrsky(i) * clrskymax(i) + clrskymax(i) = 1.0_r8 + endif + clrskymax(i) = min(clrskymax(i),1.0_r8-cld(i,k)) + endif + end do + end do + if (ityp == 1) cldtot(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol)) + if (ityp == 2) cldlow(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol)) + if (ityp == 3) cldmed(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol)) + if (ityp == 4) cldhgh(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol)) + end do + + return +end subroutine cldsav + +end module cloud_cover_diags diff --git a/src/physics/cam/cloud_diagnostics.F90 b/src/physics/cam/cloud_diagnostics.F90 new file mode 100644 index 0000000000..f7a5115914 --- /dev/null +++ b/src/physics/cam/cloud_diagnostics.F90 @@ -0,0 +1,521 @@ +module cloud_diagnostics + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Put cloud physical specifications on the history tape +! Modified from code that computed cloud optics +! +! Author: Byron Boville Sept 06, 2002 +! Modified Oct 15, 2008 +! +! +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver,pverp + use physconst, only: gravit + use cam_history, only: outfld + use cam_history, only: addfld, add_default, horiz_only + + implicit none + private + save + + public :: cloud_diagnostics_init + public :: cloud_diagnostics_calc + public :: cloud_diagnostics_register + +! Local variables + integer :: dei_idx, mu_idx, lambda_idx, iciwp_idx, iclwp_idx, cld_idx ! index into pbuf for cloud fields + integer :: ixcldice, ixcldliq, rei_idx, rel_idx + + logical :: do_cld_diag, mg_clouds, rk_clouds, camrt_rad, spcam_m2005_clouds, spcam_sam1mom_clouds + logical :: one_mom_clouds, two_mom_clouds + + integer :: cicewp_idx = -1 + integer :: cliqwp_idx = -1 + integer :: cldemis_idx = -1 + integer :: cldtau_idx = -1 + integer :: nmxrgn_idx = -1 + integer :: pmxrgn_idx = -1 + + ! Index fields for precipitation efficiency. + integer :: acpr_idx, acgcme_idx, acnum_idx + + logical :: use_spcam + +contains + +!=============================================================================== + subroutine cloud_diagnostics_register + + use phys_control, only: phys_getopts + use physics_buffer,only: pbuf_add_field, dtype_r8, dtype_i4 + + character(len=16) :: rad_pkg, microp_pgk + + call phys_getopts(radiation_scheme_out=rad_pkg,microp_scheme_out=microp_pgk) + camrt_rad = rad_pkg .eq. 'camrt' + rk_clouds = microp_pgk == 'RK' + mg_clouds = microp_pgk == 'MG' + spcam_m2005_clouds = microp_pgk == 'SPCAM_m2005' + spcam_sam1mom_clouds = microp_pgk == 'SPCAM_sam1mom' + one_mom_clouds = (rk_clouds .or. spcam_sam1mom_clouds) + two_mom_clouds = (mg_clouds .or. spcam_m2005_clouds) + + if (one_mom_clouds) then + call pbuf_add_field('CLDEMIS','physpkg', dtype_r8,(/pcols,pver/), cldemis_idx) + call pbuf_add_field('CLDTAU', 'physpkg', dtype_r8,(/pcols,pver/), cldtau_idx) + + call pbuf_add_field('CICEWP', 'physpkg', dtype_r8,(/pcols,pver/), cicewp_idx) + call pbuf_add_field('CLIQWP', 'physpkg', dtype_r8,(/pcols,pver/), cliqwp_idx) + + call pbuf_add_field('PMXRGN', 'physpkg', dtype_r8,(/pcols,pverp/), pmxrgn_idx) + call pbuf_add_field('NMXRGN', 'physpkg', dtype_i4,(/pcols /), nmxrgn_idx) + else if (two_mom_clouds) then + ! In cloud ice water path for radiation + call pbuf_add_field('ICIWP', 'global', dtype_r8,(/pcols,pver/), iciwp_idx) + ! In cloud liquid water path for radiation + call pbuf_add_field('ICLWP', 'global', dtype_r8,(/pcols,pver/), iclwp_idx) + endif + end subroutine cloud_diagnostics_register + +!=============================================================================== + subroutine cloud_diagnostics_init() +!----------------------------------------------------------------------- + use physics_buffer,only: pbuf_get_index + use phys_control, only: phys_getopts + use constituents, only: cnst_get_ind + use cloud_cover_diags, only: cloud_cover_diags_init + + implicit none + +!----------------------------------------------------------------------- + + character(len=16) :: wpunits, sampling_seq + logical :: history_amwg ! output the variables used by the AMWG diag package + + + !----------------------------------------------------------------------- + + cld_idx = pbuf_get_index('CLD') + + call phys_getopts(use_spcam_out=use_spcam) + + if (two_mom_clouds) then + + call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud water mixing ratio') + call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud ice mixing ratio' ) + call addfld ('IWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average ice water content' ) + call addfld ('LWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average liquid water content' ) + + ! determine the add_default fields + call phys_getopts(history_amwg_out = history_amwg) + + if (history_amwg) then + call add_default ('ICWMR', 1, ' ') + call add_default ('ICIMR', 1, ' ') + call add_default ('IWC ', 1, ' ') + end if + + dei_idx = pbuf_get_index('DEI') + mu_idx = pbuf_get_index('MU') + lambda_idx = pbuf_get_index('LAMBDAC') + + elseif (one_mom_clouds) then + + rei_idx = pbuf_get_index('REI') + rel_idx = pbuf_get_index('REL') + + endif + + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + do_cld_diag = one_mom_clouds .or. two_mom_clouds + + if (.not.do_cld_diag) return + + if (rk_clouds) then + wpunits = 'gram/m2' + sampling_seq='rad_lwsw' + else if (two_mom_clouds .or. spcam_sam1mom_clouds) then + wpunits = 'kg/m2' + sampling_seq='' + end if + + call addfld ('ICLDIWP', (/ 'lev' /), 'A', wpunits,'In-cloud ice water path' , sampling_seq=sampling_seq) + call addfld ('ICLDTWP', (/ 'lev' /), 'A',wpunits,'In-cloud cloud total water path (liquid and ice)', & + sampling_seq=sampling_seq) + + call addfld ('GCLDLWP', (/ 'lev' /), 'A',wpunits,'Grid-box cloud water path' , & + sampling_seq=sampling_seq) + call addfld ('TGCLDCWP',horiz_only, 'A',wpunits,'Total grid-box cloud water path (liquid and ice)', & + sampling_seq=sampling_seq) + call addfld ('TGCLDLWP',horiz_only, 'A',wpunits,'Total grid-box cloud liquid water path', & + sampling_seq=sampling_seq) + call addfld ('TGCLDIWP',horiz_only, 'A',wpunits,'Total grid-box cloud ice water path' , & + sampling_seq=sampling_seq) + + if(two_mom_clouds) then + call addfld ('lambda_cloud',(/ 'lev' /),'I','1/meter','lambda in cloud') + call addfld ('mu_cloud', (/ 'lev' /),'I','1','mu in cloud') + call addfld ('dei_cloud', (/ 'lev' /),'I','micrometers','ice radiative effective diameter in cloud') + endif + + if(one_mom_clouds) then + call addfld ('rel_cloud',(/ 'lev' /),'I','1/meter','effective radius of liq in cloud', sampling_seq=sampling_seq) + call addfld ('rei_cloud',(/ 'lev' /),'I','1','effective radius of ice in cloud', sampling_seq=sampling_seq) + endif + + call addfld ('SETLWP',(/ 'lev' /), 'A','gram/m2','Prescribed liquid water path' , sampling_seq=sampling_seq) + call addfld ('LWSH',horiz_only, 'A','m','Liquid water scale height' , sampling_seq=sampling_seq) + + call addfld ('EFFCLD',(/ 'lev' /), 'A','fraction','Effective cloud fraction' , sampling_seq=sampling_seq) + + if (camrt_rad) then + call addfld ('EMIS', (/ 'lev' /), 'A', '1','cloud emissivity' , sampling_seq=sampling_seq) + else + call addfld ('EMISCLD', (/ 'lev' /), 'A', '1','cloud emissivity' , sampling_seq=sampling_seq) + endif + + call cloud_cover_diags_init(sampling_seq) + + ! ---------------------------- + ! determine default variables + ! ---------------------------- + call phys_getopts( history_amwg_out = history_amwg) + + if (history_amwg) then + call add_default ('TGCLDLWP', 1, ' ') + call add_default ('TGCLDIWP', 1, ' ') + call add_default ('TGCLDCWP', 1, ' ') + if(rk_clouds) then + if (camrt_rad) then + call add_default ('EMIS', 1, ' ') + else + call add_default ('EMISCLD', 1, ' ') + endif + endif + endif + + return + end subroutine cloud_diagnostics_init + +subroutine cloud_diagnostics_calc(state, pbuf) +!=============================================================================== +! +! Compute (liquid+ice) water path and cloud water/ice diagnostics +! *** soon this code will compute liquid and ice paths from input liquid and ice mixing ratios +! +! **** mixes interface and physics code temporarily +!----------------------------------------------------------------------- + use physics_types, only: physics_state + use physics_buffer,only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use pkg_cldoptics, only: cldovrlap, cldclw, cldems + use conv_water, only: conv_water_in_rad, conv_water_4rad + use radiation, only: radiation_do + use cloud_cover_diags, only: cloud_cover_diags_out + + use ref_pres, only: top_lev=>trop_cloud_top_lev + + implicit none + +! Arguments + type(physics_state), intent(in) :: state ! state variables + type(physics_buffer_desc), pointer :: pbuf(:) + +! Local variables + + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: iciwp(:,:) ! in-cloud cloud ice water path + real(r8), pointer :: iclwp(:,:) ! in-cloud cloud liquid water path + real(r8), pointer :: dei(:,:) ! effective radiative diameter of ice + real(r8), pointer :: mu(:,:) ! gamma distribution for liq clouds + real(r8), pointer :: lambda(:,:) ! gamma distribution for liq clouds + real(r8), pointer :: rei(:,:) ! effective radiative radius of ice + real(r8), pointer :: rel(:,:) ! effective radiative radius of liq + + real(r8), pointer :: cldemis(:,:) ! cloud emissivity + real(r8), pointer :: cldtau(:,:) ! cloud optical depth + real(r8), pointer :: cicewp(:,:) ! in-cloud cloud ice water path + real(r8), pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path + + integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions + real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + + integer :: itim_old + + real(r8) :: cwp (pcols,pver) ! in-cloud cloud (total) water path + real(r8) :: gicewp(pcols,pver) ! grid-box cloud ice water path + real(r8) :: gliqwp(pcols,pver) ! grid-box cloud liquid water path + real(r8) :: gwp (pcols,pver) ! grid-box cloud (total) water path + real(r8) :: tgicewp(pcols) ! Vertically integrated ice water path + real(r8) :: tgliqwp(pcols) ! Vertically integrated liquid water path + real(r8) :: tgwp (pcols) ! Vertically integrated (total) cloud water path + + real(r8) :: ficemr (pcols,pver) ! Ice fraction from ice and liquid mixing ratios + + real(r8) :: icimr(pcols,pver) ! In cloud ice mixing ratio + real(r8) :: icwmr(pcols,pver) ! In cloud water mixing ratio + real(r8) :: iwc(pcols,pver) ! Grid box average ice water content + real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content + +! old data + real(r8) :: tpw (pcols) ! total precipitable water + real(r8) :: clwpold(pcols,pver) ! Presribed cloud liq. h2o path + real(r8) :: hl (pcols) ! Liquid water scale height + + integer :: i,k ! loop indexes + integer :: ncol, lchnk + real(r8) :: rgrav + + real(r8) :: allcld_ice (pcols,pver) ! Convective cloud ice + real(r8) :: allcld_liq (pcols,pver) ! Convective cloud liquid + + real(r8) :: effcld(pcols,pver) ! effective cloud=cld*emis + + logical :: dosw,dolw + +!----------------------------------------------------------------------- + if (.not.do_cld_diag) return + + if(one_mom_clouds) then + dosw = radiation_do('sw') ! do shortwave heating calc this timestep? + dolw = radiation_do('lw') ! do longwave heating calc this timestep? + else + dosw = .true. + dolw = .true. + endif + + if (.not.(dosw .or. dolw)) return + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + if(two_mom_clouds)then + + call pbuf_get_field(pbuf, iclwp_idx, iclwp ) + call pbuf_get_field(pbuf, iciwp_idx, iciwp ) + call pbuf_get_field(pbuf, dei_idx, dei ) + call pbuf_get_field(pbuf, mu_idx, mu ) + call pbuf_get_field(pbuf, lambda_idx, lambda ) + + call outfld('dei_cloud',dei(:,:),pcols,lchnk) + call outfld('mu_cloud',mu(:,:),pcols,lchnk) + call outfld('lambda_cloud',lambda(:,:),pcols,lchnk) + + elseif(one_mom_clouds) then + + call pbuf_get_field(pbuf, rei_idx, rei ) + call pbuf_get_field(pbuf, rel_idx, rel ) + + call outfld('rel_cloud', rel, pcols, lchnk) + call outfld('rei_cloud', rei, pcols, lchnk) + + if (cldemis_idx>0) then + call pbuf_get_field(pbuf, cldemis_idx, cldemis ) + else + allocate(cldemis(pcols,pver)) + endif + if (cldtau_idx>0) then + call pbuf_get_field(pbuf, cldtau_idx, cldtau ) + else + allocate(cldtau(pcols,pver)) + endif + + endif + + if (cicewp_idx>0) then + call pbuf_get_field(pbuf, cicewp_idx, cicewp ) + else + allocate(cicewp(pcols,pver)) + endif + if (cliqwp_idx>0) then + call pbuf_get_field(pbuf, cliqwp_idx, cliqwp ) + else + allocate(cliqwp(pcols,pver)) + endif + + if (nmxrgn_idx>0) then + call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn ) + else + allocate(nmxrgn(pcols)) + endif + + if (pmxrgn_idx>0) then + call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn ) + else + allocate(pmxrgn(pcols,pverp)) + endif + +! Compute liquid and ice water paths + if(two_mom_clouds) then + + ! ----------------------------------------------------------- ! + ! Adjust in-cloud water values to take account of convective ! + ! in-cloud water. It is used to calculate the values of ! + ! iclwp and iciwp to pass to the radiation. ! + ! ----------------------------------------------------------- ! + if( conv_water_in_rad /= 0 ) then + allcld_ice(:ncol,:) = 0._r8 ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = 0._r8 ! Grid-avg all cloud ice + + call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + else + allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid + allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice) ! " ice + end if + + ! ------------------------------------------------------------ ! + ! Compute in cloud ice and liquid mixing ratios ! + ! Note that 'iclwp, iciwp' are used for radiation computation. ! + ! ------------------------------------------------------------ ! + + + iciwp = 0._r8 + iclwp = 0._r8 + icimr = 0._r8 + icwmr = 0._r8 + iwc = 0._r8 + lwc = 0._r8 + + do k = top_lev, pver + do i = 1, ncol + ! Limits for in-cloud mixing ratios consistent with MG microphysics + ! in-cloud mixing ratio maximum limit of 0.005 kg/kg + icimr(i,k) = min( allcld_ice(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 ) + icwmr(i,k) = min( allcld_liq(i,k) / max(0.0001_r8,cld(i,k)),0.005_r8 ) + iwc(i,k) = allcld_ice(i,k) * state%pmid(i,k) / (287.15_r8*state%t(i,k)) + lwc(i,k) = allcld_liq(i,k) * state%pmid(i,k) / (287.15_r8*state%t(i,k)) + ! Calculate total cloud water paths in each layer + iciwp(i,k) = icimr(i,k) * state%pdel(i,k) / gravit + iclwp(i,k) = icwmr(i,k) * state%pdel(i,k) / gravit + end do + end do + + do k=1,pver + do i = 1,ncol + gicewp(i,k) = iciwp(i,k)*cld(i,k) + gliqwp(i,k) = iclwp(i,k)*cld(i,k) + cicewp(i,k) = iciwp(i,k) + cliqwp(i,k) = iclwp(i,k) + end do + end do + + elseif(one_mom_clouds) then + + if (conv_water_in_rad /= 0) then + call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + else + allcld_liq = state%q(:,:,ixcldliq) + allcld_ice = state%q(:,:,ixcldice) + end if + + do k=1,pver + do i = 1,ncol + gicewp(i,k) = allcld_ice(i,k)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = allcld_liq(i,k)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = allcld_ice(i,k) / max(1.e-10_r8,(allcld_ice(i,k) + allcld_liq(i,k))) + end do + end do + endif + +! Determine parameters for maximum/random overlap + call cldovrlap(lchnk, ncol, state%pint, cld, nmxrgn, pmxrgn) + + if(.not. use_spcam) then ! in spcam, these diagnostics are calcluated in crm_physics.F90 +! Cloud cover diagnostics (done in radiation_tend for camrt) + if (.not.camrt_rad) then + call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) + endif + end if + + tgicewp(:ncol) = 0._r8 + tgliqwp(:ncol) = 0._r8 + + do k=1,pver + tgicewp(:ncol) = tgicewp(:ncol) + gicewp(:ncol,k) + tgliqwp(:ncol) = tgliqwp(:ncol) + gliqwp(:ncol,k) + end do + + tgwp(:ncol) = tgicewp(:ncol) + tgliqwp(:ncol) + gwp(:ncol,:pver) = gicewp(:ncol,:pver) + gliqwp(:ncol,:pver) + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + + if(one_mom_clouds) then + + ! Cloud emissivity. + call cldems(lchnk, ncol, cwp, ficemr, rei, cldemis, cldtau) + + ! Effective cloud cover + do k=1,pver + do i=1,ncol + effcld(i,k) = cld(i,k)*cldemis(i,k) + end do + end do + + call outfld('EFFCLD' ,effcld , pcols,lchnk) + if (camrt_rad) then + call outfld('EMIS' ,cldemis, pcols,lchnk) + else + call outfld('EMISCLD' ,cldemis, pcols,lchnk) + endif + + else if (two_mom_clouds) then + + ! --------------------------------------------- ! + ! General outfield calls for microphysics ! + ! --------------------------------------------- ! + + call outfld( 'IWC' , iwc, pcols, lchnk ) + call outfld( 'LWC' , lwc, pcols, lchnk ) + call outfld( 'ICIMR' , icimr, pcols, lchnk ) + call outfld( 'ICWMR' , icwmr, pcols, lchnk ) + + endif + + if (.not. use_spcam) then + ! for spcam, these are diagnostics in crm_physics.F90 + call outfld('GCLDLWP' ,gwp , pcols,lchnk) + call outfld('TGCLDCWP',tgwp , pcols,lchnk) + call outfld('TGCLDLWP',tgliqwp, pcols,lchnk) + call outfld('TGCLDIWP',tgicewp, pcols,lchnk) + call outfld('ICLDTWP' ,cwp , pcols,lchnk) + call outfld('ICLDIWP' ,cicewp , pcols,lchnk) + endif + +! Compute total preciptable water in column (in mm) + tpw(:ncol) = 0.0_r8 + rgrav = 1.0_r8/gravit + do k=1,pver + do i=1,ncol + tpw(i) = tpw(i) + state%pdel(i,k)*state%q(i,k,1)*rgrav + end do + end do + +! Diagnostic liquid water path (old specified form) + + call cldclw(lchnk, ncol, state%zi, clwpold, tpw, hl) + call outfld('SETLWP' ,clwpold, pcols,lchnk) + call outfld('LWSH' ,hl , pcols,lchnk) + + if(one_mom_clouds) then + if (cldemis_idx<0) deallocate(cldemis) + if (cldtau_idx<0) deallocate(cldtau) + endif + if (cicewp_idx<0) deallocate(cicewp) + if (cliqwp_idx<0) deallocate(cliqwp) + if (pmxrgn_idx<0) deallocate(pmxrgn) + if (nmxrgn_idx<0) deallocate(nmxrgn) + + return +end subroutine cloud_diagnostics_calc + +end module cloud_diagnostics diff --git a/src/physics/cam/cloud_fraction.F90 b/src/physics/cam/cloud_fraction.F90 new file mode 100644 index 0000000000..047043cc84 --- /dev/null +++ b/src/physics/cam/cloud_fraction.F90 @@ -0,0 +1,813 @@ +module cloud_fraction + + ! Cloud fraction parameterization. + + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use ref_pres, only: pref_mid + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use ref_pres, only: trop_cloud_top_lev + + implicit none + private + save + + ! Public interfaces + public & + cldfrc_readnl, &! read cldfrc_nl namelist + cldfrc_register, &! add fields to pbuf + cldfrc_init, &! Inititialization of cloud_fraction run-time parameters + cldfrc_getparams, &! public access of tuning parameters + cldfrc, &! Computation of cloud fraction + cldfrc_fice ! Calculate fraction of condensate in ice phase (radiation partitioning) + + ! Private data + real(r8), parameter :: unset_r8 = huge(1.0_r8) + + ! Top level + integer :: top_lev = 1 + + ! Physics buffer indices + integer :: sh_frac_idx = 0 + integer :: dp_frac_idx = 0 + + ! Namelist variables + logical :: cldfrc_freeze_dry ! switch for Vavrus correction + logical :: cldfrc_ice ! switch to compute ice cloud fraction + real(r8) :: cldfrc_rhminl = unset_r8 ! minimum rh for low stable clouds + real(r8) :: cldfrc_rhminl_adj_land = unset_r8 ! rhminl adjustment for snowfree land + real(r8) :: cldfrc_rhminh = unset_r8 ! minimum rh for high stable clouds + real(r8) :: cldfrc_sh1 = unset_r8 ! parameter for shallow convection cloud fraction + real(r8) :: cldfrc_sh2 = unset_r8 ! parameter for shallow convection cloud fraction + real(r8) :: cldfrc_dp1 = unset_r8 ! parameter for deep convection cloud fraction + real(r8) :: cldfrc_dp2 = unset_r8 ! parameter for deep convection cloud fraction + real(r8) :: cldfrc_premit = unset_r8 ! top pressure bound for mid level cloud + real(r8) :: cldfrc_premib = unset_r8 ! bottom pressure bound for mid level cloud + integer :: cldfrc_iceopt ! option for ice cloud closure + ! 1=wang & sassen 2=schiller (iciwc) + ! 3=wood & field, 4=Wilson (based on smith) + real(r8) :: cldfrc_icecrit = unset_r8 ! Critical RH for ice clouds in Wilson & Ballard closure (smaller = more ice clouds) + + real(r8) :: rhminl ! set from namelist input cldfrc_rhminl + real(r8) :: rhminl_adj_land ! set from namelist input cldfrc_rhminl_adj_land + real(r8) :: rhminh ! set from namelist input cldfrc_rhminh + real(r8) :: sh1, sh2 ! set from namelist input cldfrc_sh1, cldfrc_sh2 + real(r8) :: dp1,dp2 ! set from namelist input cldfrc_dp1, cldfrc_dp2 + real(r8) :: premit ! set from namelist input cldfrc_premit + real(r8) :: premib ! set from namelist input cldfrc_premib + integer :: iceopt ! set from namelist input cldfrc_iceopt + real(r8) :: icecrit ! set from namelist input cldfrc_icecrit + + ! constants + real(r8), parameter :: pnot = 1.e5_r8 ! reference pressure + real(r8), parameter :: lapse = 6.5e-3_r8 ! U.S. Standard Atmosphere lapse rate + real(r8), parameter :: pretop = 1.0e2_r8 ! pressure bounding high cloud + + integer count + + logical :: inversion_cld_off ! Turns off stratification-based cld frc + + integer :: k700 ! model level nearest 700 mb + +!================================================================================================ + contains +!================================================================================================ + +subroutine cldfrc_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cldfrc_readnl' + + namelist /cldfrc_nl/ cldfrc_freeze_dry, cldfrc_ice, cldfrc_rhminl, & + cldfrc_rhminl_adj_land, cldfrc_rhminh, cldfrc_sh1, & + cldfrc_sh2, cldfrc_dp1, cldfrc_dp2, & + cldfrc_premit, cldfrc_premib, cldfrc_iceopt, & + cldfrc_icecrit + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cldfrc_nl', status=ierr) + if (ierr == 0) then + read(unitn, cldfrc_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + rhminl = cldfrc_rhminl + rhminl_adj_land = cldfrc_rhminl_adj_land + rhminh = cldfrc_rhminh + sh1 = cldfrc_sh1 + sh2 = cldfrc_sh2 + dp1 = cldfrc_dp1 + dp2 = cldfrc_dp2 + premit = cldfrc_premit + premib = cldfrc_premib + iceopt = cldfrc_iceopt + icecrit = cldfrc_icecrit + + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(cldfrc_freeze_dry, 1, mpilog, 0, mpicom) + call mpibcast(cldfrc_ice, 1, mpilog, 0, mpicom) + call mpibcast(rhminl, 1, mpir8, 0, mpicom) + call mpibcast(rhminl_adj_land, 1, mpir8, 0, mpicom) + call mpibcast(rhminh, 1, mpir8, 0, mpicom) + call mpibcast(sh1 , 1, mpir8, 0, mpicom) + call mpibcast(sh2 , 1, mpir8, 0, mpicom) + call mpibcast(dp1 , 1, mpir8, 0, mpicom) + call mpibcast(dp2 , 1, mpir8, 0, mpicom) + call mpibcast(premit, 1, mpir8, 0, mpicom) + call mpibcast(premib, 1, mpir8, 0, mpicom) + call mpibcast(iceopt, 1, mpiint, 0, mpicom) + call mpibcast(icecrit, 1, mpir8, 0, mpicom) +#endif + +end subroutine cldfrc_readnl + +!================================================================================================ + +subroutine cldfrc_register + + ! Register fields in the physics buffer. + + use physics_buffer, only : pbuf_add_field, dtype_r8 + + !----------------------------------------------------------------------- + + call pbuf_add_field('SH_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), sh_frac_idx) + call pbuf_add_field('DP_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), dp_frac_idx) + +end subroutine cldfrc_register + +!================================================================================================ + +subroutine cldfrc_getparams(rhminl_out, rhminl_adj_land_out, rhminh_out, premit_out, & + premib_out, iceopt_out, icecrit_out) +!----------------------------------------------------------------------- +! Purpose: Return cldfrc tuning parameters +!----------------------------------------------------------------------- + + real(r8), intent(out), optional :: rhminl_out + real(r8), intent(out), optional :: rhminl_adj_land_out + real(r8), intent(out), optional :: rhminh_out + real(r8), intent(out), optional :: premit_out + real(r8), intent(out), optional :: premib_out + integer, intent(out), optional :: iceopt_out + real(r8), intent(out), optional :: icecrit_out + + if ( present(rhminl_out) ) rhminl_out = rhminl + if ( present(rhminl_adj_land_out) ) rhminl_adj_land_out = rhminl_adj_land + if ( present(rhminh_out) ) rhminh_out = rhminh + if ( present(premit_out) ) premit_out = premit + if ( present(premib_out) ) premib_out = premib + if ( present(iceopt_out) ) iceopt_out = iceopt + if ( present(icecrit_out) ) icecrit_out = icecrit + +end subroutine cldfrc_getparams + +!=============================================================================== + +subroutine cldfrc_init + + ! Initialize cloud fraction run-time parameters + + use cam_history, only: addfld + use phys_control, only: phys_getopts + + ! query interfaces for scheme settings + character(len=16) :: shallow_scheme, eddy_scheme, macrop_scheme + + integer :: k + !----------------------------------------------------------------------------- + + call phys_getopts(shallow_scheme_out = shallow_scheme ,& + eddy_scheme_out = eddy_scheme ,& + macrop_scheme_out = macrop_scheme ) + + ! Limit CAM5 cloud physics to below top cloud level. + if ( .not. (macrop_scheme == "rk" .or. macrop_scheme == "SPCAM_sam1mom")) top_lev = trop_cloud_top_lev + + ! Turn off inversion_cld if any UW PBL scheme is being used + if ( (eddy_scheme .eq. 'diag_TKE' ) .or. (shallow_scheme .eq. 'UW' ) .or.& + (shallow_scheme .eq. 'SPCAM_m2005') ) then + inversion_cld_off = .true. + else + inversion_cld_off = .false. + endif + + if ( masterproc ) then + write(iulog,*)'tuning parameters cldfrc_init: inversion_cld_off',inversion_cld_off + write(iulog,*)'tuning parameters cldfrc_init: dp1',dp1,'dp2',dp2,'sh1',sh1,'sh2',sh2 + if (shallow_scheme .ne. 'UW' .or. shallow_scheme .eq. 'SPCAM_m2005' ) then + write(iulog,*)'tuning parameters cldfrc_init: rhminl',rhminl,'rhminl_adj_land',rhminl_adj_land, & + 'rhminh',rhminh,'premit',premit,'premib',premib + write(iulog,*)'tuning parameters cldfrc_init: iceopt',iceopt,'icecrit',icecrit + endif + endif + + if (pref_mid(top_lev) > 7.e4_r8) & + call endrun ('cldfrc_init: model levels bracketing 700 mb not found') + + ! Find vertical level nearest 700 mb. + k700 = minloc(abs(pref_mid(top_lev:pver) - 7.e4_r8), 1) + + if (masterproc) then + write(iulog,*)'cldfrc_init: model level nearest 700 mb is',k700,'which is',pref_mid(k700),'pascals' + end if + + call addfld ('SH_CLD', (/ 'lev' /), 'A', 'fraction', 'Shallow convective cloud cover' ) + call addfld ('DP_CLD', (/ 'lev' /), 'A', 'fraction', 'Deep convective cloud cover' ) + +end subroutine cldfrc_init + +!=============================================================================== + +subroutine cldfrc(lchnk ,ncol , pbuf, & + pmid ,temp ,q ,omga , phis, & + shfrc ,use_shfrc, & + cloud ,rhcloud, clc ,pdel , & + cmfmc ,cmfmc2 ,landfrac,snowh ,concld ,cldst , & + ts ,sst ,ps ,zdu ,ocnfrac ,& + rhu00 ,cldice ,icecldf ,liqcldf ,relhum ,dindex ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute cloud fraction + ! + ! + ! Method: + ! This calculate cloud fraction using a relative humidity threshold + ! The threshold depends upon pressure, and upon the presence or absence + ! of convection as defined by a reasonably large vertical mass flux + ! entering that layer from below. + ! + ! Author: Many. Last modified by Jim McCaa + ! + !----------------------------------------------------------------------- + use cam_history, only: outfld + use physconst, only: cappa, gravit, rair, tmelt + use wv_saturation, only: qsat, qsat_water, svp_ice + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + + +!RBN - Need this to write shallow,deep fraction to phys buffer. +!PJR - we should probably make seperate modules for determining convective +! clouds and make this one just responsible for relative humidity clouds + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + + ! Arguments + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: dindex ! 0 or 1 to perturb rh + + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures + real(r8), intent(in) :: temp(pcols,pver) ! temperature + real(r8), intent(in) :: q(pcols,pver) ! specific humidity + real(r8), intent(in) :: omga(pcols,pver) ! vertical pressure velocity + real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c + real(r8), intent(in) :: cmfmc2(pcols,pverp) ! shallow convective mass flux--m sub c + real(r8), intent(in) :: snowh(pcols) ! snow depth (liquid water equivalent) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure depth of layer + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: ocnfrac(pcols) ! Ocean fraction + real(r8), intent(in) :: ts(pcols) ! surface temperature + real(r8), intent(in) :: sst(pcols) ! sea surface temperature + real(r8), intent(in) :: ps(pcols) ! surface pressure + real(r8), intent(in) :: zdu(pcols,pver) ! detrainment rate from deep convection + real(r8), intent(in) :: phis(pcols) ! surface geopotential + real(r8), intent(in) :: shfrc(pcols,pver) ! cloud fraction from convect_shallow + real(r8), intent(in) :: cldice(pcols,pver) ! cloud ice mixing ratio + logical, intent(in) :: use_shfrc + + ! Output arguments + real(r8), intent(out) :: cloud(pcols,pver) ! cloud fraction + real(r8), intent(out) :: rhcloud(pcols,pver) ! cloud fraction + real(r8), intent(out) :: clc(pcols) ! column convective cloud amount + real(r8), intent(out) :: cldst(pcols,pver) ! cloud fraction + real(r8), intent(out) :: rhu00(pcols,pver) ! RH threshold for cloud + real(r8), intent(out) :: relhum(pcols,pver) ! RH + real(r8), intent(out) :: icecldf(pcols,pver) ! ice cloud fraction + real(r8), intent(out) :: liqcldf(pcols,pver) ! liquid cloud fraction (combined into cloud) + + !---------------------------Local workspace----------------------------- + ! + real(r8) concld(pcols,pver) ! convective cloud cover + real(r8) cld ! intermediate scratch variable (low cld) + real(r8) dthdpmn(pcols) ! most stable lapse rate below 750 mb + real(r8) dthdp ! lapse rate (intermediate variable) + real(r8) es(pcols,pver) ! saturation vapor pressure + real(r8) qs(pcols,pver) ! saturation specific humidity + real(r8) rhwght ! weighting function for rhlim transition + real(r8) rh(pcols,pver) ! relative humidity + real(r8) rhdif ! intermediate scratch variable + real(r8) strat ! intermediate scratch variable + real(r8) theta(pcols,pver) ! potential temperature + real(r8) rhlim ! local rel. humidity threshold estimate + real(r8) coef1 ! coefficient to convert mass flux to mb/d + real(r8) clrsky(pcols) ! temporary used in random overlap calc + real(r8) rpdeli(pcols,pver-1) ! 1./(pmid(k+1)-pmid(k)) + real(r8) rhpert !the specified perturbation to rh + + real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction + real(r8), pointer, dimension(:,:) :: shallowcu ! shallow convection cloud fraction + + logical cldbnd(pcols) ! region below high cloud boundary + + integer i, ierror, k ! column, level indices + integer kp1, ifld + integer kdthdp(pcols) + integer numkcld ! number of levels in which to allow clouds + + ! In Cloud Ice Content variables + real(r8) :: a,b,c,as,bs,cs !fit parameters + real(r8) :: Kc !constant for ice cloud calc (wood & field) + real(r8) :: ttmp !limited temperature + real(r8) :: icicval !empirical iwc value + real(r8) :: rho !local air density + real(r8) :: esl(pcols,pver) !liq sat vapor pressure + real(r8) :: esi(pcols,pver) !ice sat vapor pressure + real(r8) :: ncf,phi !Wilson and Ballard parameters + + real(r8) thetas(pcols) ! ocean surface potential temperature + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + + ! Statement functions + logical land + land(i) = nint(landfrac(i)) == 1 + + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + + call pbuf_get_field(pbuf, sh_frac_idx, shallowcu ) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu ) + + ! Initialise cloud fraction + shallowcu = 0._r8 + deepcu = 0._r8 + + !================================================================================== + ! PHILOSOPHY OF PRESENT IMPLEMENTATION + !++ag ice3 + ! Modification to philosophy for ice supersaturation + ! philosophy below is based on RH water only. This is 'liquid condensation' + ! or liquid cloud (even though it will freeze immediately to ice) + ! The idea is that the RH limits for condensation are strict only for + ! water saturation + ! + ! Ice clouds are formed by explicit parameterization of ice nucleation. + ! Closure for ice cloud fraction is done on available cloud ice, such that + ! the in-cloud ice content matches an empirical fit + ! thus, icecldf = min(cldice/icicval,1) where icicval = f(temp,cldice,numice) + ! for a first cut, icicval=f(temp) only. + ! Combined cloud fraction is maximum overlap cloud=max(1,max(icecldf,liqcldf)) + ! No dA/dt term for ice? + !--ag + ! + ! There are three co-existing cloud types: convective, inversion related low-level + ! stratocumulus, and layered cloud (based on relative humidity). Layered and + ! stratocumulus clouds do not compete with convective cloud for which one creates + ! the most cloud. They contribute collectively to the total grid-box average cloud + ! amount. This is reflected in the way in which the total cloud amount is evaluated + ! (a sum as opposed to a logical "or" operation) + ! + !================================================================================== + ! set defaults for rhu00 + rhu00(:,:) = 2.0_r8 + ! define rh perturbation in order to estimate rhdfda + rhpert = 0.01_r8 + + !set Wang and Sassen IWC paramters + a=26.87_r8 + b=0.569_r8 + c=0.002892_r8 + !set schiller parameters + as=-68.4202_r8 + bs=0.983917_r8 + cs=2.81795_r8 + !set wood and field paramters... + Kc=75._r8 + + ! Evaluate potential temperature and relative humidity + ! If not computing ice cloud fraction then hybrid RH, if MG then water RH + if ( cldfrc_ice ) then + call qsat_water(temp(1:ncol,top_lev:pver), pmid(1:ncol,top_lev:pver), & + esl(1:ncol,top_lev:pver), qs(1:ncol,top_lev:pver)) + + esi(1:ncol,top_lev:pver) = svp_ice(temp(1:ncol,top_lev:pver)) + else + call qsat(temp(1:ncol,top_lev:pver), pmid(1:ncol,top_lev:pver), & + es(1:ncol,top_lev:pver), qs(1:ncol,top_lev:pver)) + endif + + cloud = 0._r8 + icecldf = 0._r8 + liqcldf = 0._r8 + rhcloud = 0._r8 + cldst = 0._r8 + concld = 0._r8 + + do k=top_lev,pver + theta(:ncol,k) = temp(:ncol,k)*(pnot/pmid(:ncol,k))**cappa + + do i=1,ncol + rh(i,k) = q(i,k)/qs(i,k)*(1.0_r8+real(dindex,r8)*rhpert) + ! record relhum, rh itself will later be modified related with concld + relhum(i,k) = rh(i,k) + end do + end do + + ! Initialize other temporary variables + ierror = 0 + do i=1,ncol + ! Adjust thetas(i) in the presence of non-zero ocean heights. + ! This reduces the temperature for positive heights according to a standard lapse rate. + if(ocnfrac(i).gt.0.01_r8) thetas(i) = & + ( sst(i) - lapse * phis(i) / gravit) * (pnot/ps(i))**cappa + if(ocnfrac(i).gt.0.01_r8.and.sst(i).lt.260._r8) ierror = i + clc(i) = 0.0_r8 + end do + coef1 = gravit*864.0_r8 ! conversion to millibars/day + + if (ierror > 0) then + write(iulog,*) 'COLDSST: encountered in cldfrc:', lchnk,ierror,ocnfrac(ierror),sst(ierror) + endif + + do k=top_lev,pver-1 + rpdeli(:ncol,k) = 1._r8/(pmid(:ncol,k+1) - pmid(:ncol,k)) + end do + + ! + ! Estimate of local convective cloud cover based on convective mass flux + ! Modify local large-scale relative humidity to account for presence of + ! convective cloud when evaluating relative humidity based layered cloud amount + ! + concld(:ncol,top_lev:pver) = 0.0_r8 + ! + ! cloud mass flux in SI units of kg/m2/s; should produce typical numbers of 20% + ! shallow and deep convective cloudiness are evaluated separately (since processes + ! are evaluated separately) and summed + ! +#ifndef PERGRO + do k=top_lev,pver + do i=1,ncol + if ( .not. use_shfrc ) then + shallowcu(i,k) = max(0.0_r8,min(sh1*log(1.0_r8+sh2*cmfmc2(i,k+1)),0.30_r8)) + else + shallowcu(i,k) = shfrc(i,k) + endif + deepcu(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc2(i,k+1))),0.60_r8)) + concld(i,k) = min(shallowcu(i,k) + deepcu(i,k),0.80_r8) + rh(i,k) = (rh(i,k) - concld(i,k))/(1.0_r8 - concld(i,k)) + end do + end do +#endif + !================================================================================== + ! + ! ****** Compute layer cloudiness ****** + ! + !==================================================================== + ! Begin the evaluation of layered cloud amount based on (modified) RH + !==================================================================== + ! + numkcld = pver + do k=top_lev+1,numkcld + kp1 = min(k + 1,pver) + do i=1,ncol + + !++ag This is now designed to apply FOR LIQUID CLOUDS (condensation > RH water) + + cldbnd(i) = pmid(i,k).ge.pretop + + if ( pmid(i,k).ge.premib ) then + !============================================================== + ! This is the low cloud (below premib) block + !============================================================== + ! enhance low cloud activation over land with no snow cover + if (land(i) .and. (snowh(i) <= 0.000001_r8)) then + rhlim = rhminl - rhminl_adj_land + else + rhlim = rhminl + endif + + rhdif = (rh(i,k) - rhlim)/(1.0_r8-rhlim) + rhcloud(i,k) = min(0.999_r8,(max(rhdif,0.0_r8))**2) + + ! SJV: decrease cloud amount if very low water vapor content + ! (thus very cold): "freeze dry" + if (cldfrc_freeze_dry) then + rhcloud(i,k) = rhcloud(i,k)*max(0.15_r8,min(1.0_r8,q(i,k)/0.0030_r8)) + endif + + else if ( pmid(i,k).lt.premit ) then + !============================================================== + ! This is the high cloud (above premit) block + !============================================================== + ! + rhlim = rhminh + ! + rhdif = (rh(i,k) - rhlim)/(1.0_r8-rhlim) + rhcloud(i,k) = min(0.999_r8,(max(rhdif,0.0_r8))**2) + else + !============================================================== + ! This is the middle cloud block + !============================================================== + ! + ! linear rh threshold transition between thresholds for low & high cloud + ! + rhwght = (premib-(max(pmid(i,k),premit)))/(premib-premit) + + if (land(i) .and. (snowh(i) <= 0.000001_r8)) then + rhlim = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) + else + rhlim = rhminh*rhwght + rhminl*(1.0_r8-rhwght) + endif + rhdif = (rh(i,k) - rhlim)/(1.0_r8-rhlim) + rhcloud(i,k) = min(0.999_r8,(max(rhdif,0.0_r8))**2) + end if + !================================================================================== + ! WE NEED TO DOCUMENT THE PURPOSE OF THIS TYPE OF CODE (ASSOCIATED WITH 2ND CALL) + !================================================================================== + ! ! + ! ! save rhlim to rhu00, it handles well by itself for low/high cloud + ! ! + rhu00(i,k)=rhlim + !================================================================================== + + if (cldfrc_ice) then + + ! Evaluate ice cloud fraction based on in-cloud ice content + + !--------ICE CLOUD OPTION 1--------Wang & Sassen 2002 + ! Evaluate desired in-cloud water content + ! icicval = f(temp,cldice,numice) + ! Start with a function of temperature. + ! Wang & Sassen 2002 (JAS), based on ARM site MMCR (midlat cirrus) + ! parameterization valid for 203-253K + ! icival > 0 for t>195K + if (iceopt.lt.3) then + if (iceopt.eq.1) then + ttmp=max(195._r8,min(temp(i,k),253._r8)) - 273.16_r8 + icicval=a + b * ttmp + c * ttmp**2._r8 + !convert units + rho=pmid(i,k)/(rair*temp(i,k)) + icicval= icicval * 1.e-6_r8 / rho + else + !--------ICE CLOUD OPTION 2--------Schiller 2008 (JGR) + ! Use a curve based on FISH measurements in + ! tropics, mid-lats and arctic. Curve is for 180-250K (raise to 273K?) + ! use median all flights + + ttmp=max(190._r8,min(temp(i,k),273.16_r8)) + icicval = 10._r8 **(as * bs**ttmp + cs) + !convert units from ppmv to kg/kg + icicval= icicval * 1.e-6_r8 * 18._r8 / 28.97_r8 + endif + !set icecldfraction for OPTION 1 or OPTION2 + icecldf(i,k) = max(0._r8,min(cldice(i,k)/icicval,1._r8)) + + else if (iceopt.eq.3) then + + !--------ICE CLOUD OPTION 3--------Wood & Field 2000 (JAS) + ! eq 6: cloud fraction = 1 - exp (-K * qc/qsati) + + icecldf(i,k)=1._r8 - exp(-Kc*cldice(i,k)/(qs(i,k)*(esi(i,k)/esl(i,k)))) + icecldf(i,k)=max(0._r8,min(icecldf(i,k),1._r8)) + else + !--------ICE CLOUD OPTION 4--------Wilson and ballard 1999 + ! inversion of smith.... + ! ncf = cldice / ((1-RHcrit)*qs) + ! then a function of ncf.... + ncf =cldice(i,k)/((1._r8 - icecrit)*qs(i,k)) + if (ncf.le.0._r8) then + icecldf(i,k)=0._r8 + else if (ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8) then + icecldf(i,k)=0.5_r8*(6._r8 * ncf)**(2._r8/3._r8) + else if (ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8) then + phi=(acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8 + icecldf(i,k)=(1._r8 - 4._r8 * cos(phi) * cos(phi)) + else + icecldf(i,k)=1._r8 + endif + icecldf(i,k)=max(0._r8,min(icecldf(i,k),1._r8)) + endif + !TEST: if ice present, icecldf=1. + ! if (cldice(i,k).ge.1.e-8_r8) then + ! icecldf(i,k) = 0.99_r8 + ! endif + + !! if ((cldice(i,k) .gt. icicval) .or. ((cldice(i,k) .gt. 0._r8) .and. (icecldf(i,k) .eq. 0._r8))) then + ! if (cldice(i,k) .gt. 1.e-8_r8) then + ! write(iulog,*) 'i,k,pmid,rho,t,cldice,icicval,icecldf,rhcloud: ', & + ! i,k,pmid(i,k),rho,temp(i,k),cldice(i,k),icicval,icecldf(i,k),rhcloud(i,k) + ! endif + + ! Combine ice and liquid cloud fraction assuming maximum overlap. + ! Combined cloud fraction is maximum overlap + ! cloud(i,k)=min(1._r8,max(icecldf(i,k),rhcloud(i,k))) + + liqcldf(i,k)=(1._r8 - icecldf(i,k))* rhcloud(i,k) + cloud(i,k)=liqcldf(i,k) + icecldf(i,k) + else + ! For RK microphysics + cloud(i,k) = rhcloud(i,k) + end if + end do + end do + ! + ! Add in the marine strat + ! MARINE STRATUS SHOULD BE A SPECIAL CASE OF LAYERED CLOUD + ! CLOUD CURRENTLY CONTAINS LAYERED CLOUD DETERMINED BY RH CRITERIA + ! TAKE THE MAXIMUM OF THE DIAGNOSED LAYERED CLOUD OR STRATOCUMULUS + ! + !=================================================================================== + ! + ! SOME OBSERVATIONS ABOUT THE FOLLOWING SECTION OF CODE (missed in earlier look) + ! K700 IS SET AS A CONSTANT BASED ON HYBRID COORDINATE: IT DOES NOT DEPEND ON + ! LOCAL PRESSURE; THERE IS NO PRESSURE RAMP => LOOKS LEVEL DEPENDENT AND + ! DISCONTINUOUS IN SPACE (I.E., STRATUS WILL END SUDDENLY WITH NO TRANSITION) + ! + ! IT APPEARS THAT STRAT IS EVALUATED ACCORDING TO KLEIN AND HARTMANN; HOWEVER, + ! THE ACTUAL STRATUS AMOUNT (CLDST) APPEARS TO DEPEND DIRECTLY ON THE RH BELOW + ! THE STRONGEST PART OF THE LOW LEVEL INVERSION. + !PJR answers: 1) the rh limitation is a physical/mathematical limitation + ! cant have more cloud than there is RH + ! allowed the cloud to exist two layers below the inversion + ! because the numerics frequently make 50% relative humidity + ! in level below the inversion which would allow no cloud + ! 2) since the cloud is only allowed over ocean, it should + ! be very insensitive to surface pressure (except due to + ! spectral ringing, which also causes so many other problems + ! I didnt worry about it. + ! + !================================================================================== + if (.not.inversion_cld_off) then + ! + ! Find most stable level below 750 mb for evaluating stratus regimes + ! + do i=1,ncol + ! Nothing triggers unless a stability greater than this minimum threshold is found + dthdpmn(i) = -0.125_r8 + kdthdp(i) = 0 + end do + ! + do k=top_lev+1,pver + do i=1,ncol + if (pmid(i,k) >= premib .and. ocnfrac(i).gt. 0.01_r8) then + ! I think this is done so that dtheta/dp is in units of dg/mb (JJH) + dthdp = 100.0_r8*(theta(i,k) - theta(i,k-1))*rpdeli(i,k-1) + if (dthdp < dthdpmn(i)) then + dthdpmn(i) = dthdp + kdthdp(i) = k ! index of interface of max inversion + end if + end if + end do + end do + + ! Also check between the bottom layer and the surface + ! Only perform this check if the criteria were not met above + + do i = 1,ncol + if ( kdthdp(i) .eq. 0 .and. ocnfrac(i).gt.0.01_r8) then + dthdp = 100.0_r8 * (thetas(i) - theta(i,pver)) / (ps(i)-pmid(i,pver)) + if (dthdp < dthdpmn(i)) then + dthdpmn(i) = dthdp + kdthdp(i) = pver ! index of interface of max inversion + endif + endif + enddo + + do i=1,ncol + if (kdthdp(i) /= 0) then + k = kdthdp(i) + kp1 = min(k+1,pver) + ! Note: strat will be zero unless ocnfrac > 0.01 + strat = min(1._r8,max(0._r8, ocnfrac(i) * ((theta(i,k700)-thetas(i))*.057_r8-.5573_r8) ) ) + ! + ! assign the stratus to the layer just below max inversion + ! the relative humidity changes so rapidly across the inversion + ! that it is not safe to just look immediately below the inversion + ! so limit the stratus cloud by rh in both layers below the inversion + ! + cldst(i,k) = min(strat,max(rh(i,k),rh(i,kp1))) + end if + end do + end if ! .not.inversion_cld_off + + do k=top_lev,pver + do i=1,ncol + ! + ! which is greater; standard layered cloud amount or stratocumulus diagnosis + ! + cloud(i,k) = max(rhcloud(i,k),cldst(i,k)) + ! + ! add in the contributions of convective cloud (determined separately and accounted + ! for by modifications to the large-scale relative humidity. + ! + cloud(i,k) = min(cloud(i,k)+concld(i,k), 1.0_r8) + end do + end do + + call outfld( 'SH_CLD ', shallowcu , pcols, lchnk ) + call outfld( 'DP_CLD ', deepcu , pcols, lchnk ) + + ! + return + end subroutine cldfrc + +!================================================================================================ + + subroutine cldfrc_fice(ncol, t, fice, fsnow) +! +! Compute the fraction of the total cloud water which is in ice phase. +! The fraction depends on temperature only. +! This is the form that was used for radiation, the code came from cldefr originally +! +! Author: B. A. Boville Sept 10, 2002 +! modified: PJR 3/13/03 (added fsnow to ascribe snow production for convection ) +!----------------------------------------------------------------------- + use physconst, only: tmelt + +! Arguments + integer, intent(in) :: ncol ! number of active columns + real(r8), intent(in) :: t(pcols,pver) ! temperature + + real(r8), intent(out) :: fice(pcols,pver) ! Fractional ice content within cloud + real(r8), intent(out) :: fsnow(pcols,pver) ! Fractional snow content for convection + +! Local variables + real(r8) :: tmax_fice ! max temperature for cloud ice formation + real(r8) :: tmin_fice ! min temperature for cloud ice formation + real(r8) :: tmax_fsnow ! max temperature for transition to convective snow + real(r8) :: tmin_fsnow ! min temperature for transition to convective snow + + integer :: i,k ! loop indexes + +!----------------------------------------------------------------------- + + tmax_fice = tmelt - 10._r8 ! max temperature for cloud ice formation + tmin_fice = tmax_fice - 30._r8 ! min temperature for cloud ice formation + tmax_fsnow = tmelt ! max temperature for transition to convective snow + tmin_fsnow = tmelt - 5._r8 ! min temperature for transition to convective snow + + fice(:,:top_lev-1) = 0._r8 + fsnow(:,:top_lev-1) = 0._r8 + +! Define fractional amount of cloud that is ice + do k=top_lev,pver + do i=1,ncol + +! If warmer than tmax then water phase + if (t(i,k) > tmax_fice) then + fice(i,k) = 0.0_r8 + +! If colder than tmin then ice phase + else if (t(i,k) < tmin_fice) then + fice(i,k) = 1.0_r8 + +! Otherwise mixed phase, with ice fraction decreasing linearly from tmin to tmax + else + fice(i,k) =(tmax_fice - t(i,k)) / (tmax_fice - tmin_fice) + end if + +! snow fraction partitioning + +! If warmer than tmax then water phase + if (t(i,k) > tmax_fsnow) then + fsnow(i,k) = 0.0_r8 + +! If colder than tmin then ice phase + else if (t(i,k) < tmin_fsnow) then + fsnow(i,k) = 1.0_r8 + +! Otherwise mixed phase, with ice fraction decreasing linearly from tmin to tmax + else + fsnow(i,k) =(tmax_fsnow - t(i,k)) / (tmax_fsnow - tmin_fsnow) + end if + + end do + end do + + end subroutine cldfrc_fice + +end module cloud_fraction diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 new file mode 100644 index 0000000000..08d0bf673c --- /dev/null +++ b/src/physics/cam/clubb_intr.F90 @@ -0,0 +1,3665 @@ +module clubb_intr + + !----------------------------------------------------------------------------------------------------- ! + ! Module to interface CAM with Cloud Layers Unified by Bi-normals (CLUBB), developed ! + ! by the University of Wisconsin Milwaukee Group (UWM). ! + ! ! + ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 ! + ! ! + ! Lastly, a implicit diffusion solver is called, and tendencies retrieved by ! + ! differencing the diffused and initial states. ! + ! ! + ! Calling sequence: ! + ! ! + !---------------------------Code history-------------------------------------------------------------- ! + ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! + ! ! + !----------------------------------------------------------------------------------------------------- ! + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pver, pverp, pcols + use phys_control, only: phys_getopts + use physconst, only: rair, cpair, gravit, latvap, latice, zvir, rh2o, karman + use spmd_utils, only: masterproc + use constituents, only: pcnst, cnst_add + use pbl_utils, only: calc_ustar, calc_obklen + use ref_pres, only: top_lev => trop_cloud_top_lev + use zm_conv_intr, only: zmconv_microp + implicit none + + private + save + + ! ----------------- ! + ! Public interfaces ! + ! ----------------- ! + + public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, & +#ifdef CLUBB_SGS + ! This utilizes CLUBB specific variables in its interface + stats_init_clubb, & +#endif + stats_end_timestep_clubb, & + clubb_readnl, & + clubb_init_cnst, & + clubb_implements_cnst + +#ifdef CLUBB_SGS + ! Both of these utilize CLUBB specific variables in their interface + private :: stats_zero, stats_avg +#endif + + logical, public :: do_cldcool + + ! ------------ ! + ! Private data ! + ! ------------ ! + + integer, parameter :: & + grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels + hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements + + real(r8), parameter, dimension(0) :: & + sclr_tol = 1.e-8_r8 ! Total water in kg/kg + + character(len=6), parameter :: & + saturation_equation = "gfdl" ! Goff & Gratch (1946) approximation for SVP + + real(r8), parameter :: & + theta0 = 300._r8, & ! Reference temperature [K] + ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] + p0_clubb = 100000._r8 + + integer, parameter :: & + sclr_dim = 0 ! Higher-order scalars, set to zero + + real(r8), parameter :: & + wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected + + real(r8), parameter :: & + wpthlp_const = 10.0_r8 ! Constant to add to wpthlp when moments are advected + + real(r8), parameter :: & + wprtp_const = 0.01_r8 ! Constant to add to wprtp when moments are advected + + real(r8), parameter :: & + rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected + + real(r8), parameter :: unset_r8 = huge(1.0_r8) + + real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist + real(r8) :: clubb_rnevap_effic = unset_r8 + + real(r8) :: clubb_c11 = unset_r8 + real(r8) :: clubb_c11b = unset_r8 + real(r8) :: clubb_c14 = unset_r8 + real(r8) :: clubb_gamma_coef = unset_r8 + real(r8) :: clubb_c_K10 = unset_r8 + real(r8) :: clubb_c_K10h = unset_r8 + real(r8) :: clubb_beta = unset_r8 + real(r8) :: clubb_C2rt = unset_r8 + real(r8) :: clubb_C2thl = unset_r8 + real(r8) :: clubb_C2rtthl = unset_r8 + real(r8) :: clubb_C8 = unset_r8 + real(r8) :: clubb_C7 = unset_r8 + real(r8) :: clubb_C7b = unset_r8 + real(r8) :: clubb_Skw_denom_coef = unset_r8 + real(r8) :: clubb_lambda0_stability_coef = unset_r8 + real(r8) :: clubb_mult_coef = unset_r8 + +! Constant parameters + logical, parameter, private :: & + l_uv_nudge = .false., & ! Use u/v nudging (not used) + l_implemented = .true., & ! Implemented in a host model (always true) + l_host_applies_sfc_fluxes = .false. ! Whether the host model applies the surface fluxes + + logical, parameter, private :: & + apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) + + logical :: lq(pcnst) + logical :: prog_modal_aero + logical :: do_rainturb + logical :: do_expldiff + logical :: clubb_do_adv + logical :: clubb_do_liqsupersat = .false. + logical :: history_budget + + logical :: clubb_l_lscale_plume_centered + logical :: clubb_l_use_ice_latent + + integer :: history_budget_histfile_num + integer :: edsclr_dim ! Number of scalars to transport in CLUBB + integer :: offset + +! define physics buffer indicies here + integer :: & + wp2_idx, & ! vertical velocity variances + wp3_idx, & ! third moment of vertical velocity + wpthlp_idx, & ! turbulent flux of thetal + wprtp_idx, & ! turbulent flux of total water + rtpthlp_idx, & ! covariance of thetal and rt + rtp2_idx, & ! variance of total water + thlp2_idx, & ! variance of thetal + up2_idx, & ! variance of east-west wind + vp2_idx, & ! variance of north-south wind + upwp_idx, & ! east-west momentum flux + vpwp_idx, & ! north-south momentum flux + thlm_idx, & ! mean thetal + rtm_idx, & ! mean total water mixing ratio + um_idx, & ! mean of east-west wind + vm_idx, & ! mean of north-south wind + cld_idx, & ! Cloud fraction + concld_idx, & ! Convective cloud fraction + ast_idx, & ! Stratiform cloud fraction + alst_idx, & ! Liquid stratiform cloud fraction + aist_idx, & ! Ice stratiform cloud fraction + qlst_idx, & ! Physical in-cloud LWC + qist_idx, & ! Physical in-cloud IWC + dp_frac_idx, & ! deep convection cloud fraction + sh_frac_idx, & ! shallow convection cloud fraction + kvh_idx, & ! Eddy diffusivity of heat/moisture on interface levels + pblh_idx, & ! PBL pbuf + icwmrdp_idx, & ! In cloud mixing ratio for deep convection + tke_idx, & ! turbulent kinetic energy + tpert_idx, & ! temperature perturbation from PBL + fice_idx, & ! fice_idx index in physics buffer + cmeliq_idx, & ! cmeliq_idx index in physics buffer + relvar_idx, & ! relative cloud water variance + accre_enhan_idx, & ! optional accretion enhancement factor for MG + npccn_idx, & ! liquid ccn number concentration + naai_idx, & ! ice number concentration + prer_evap_idx, & ! rain evaporation rate + qrl_idx, & ! longwave cooling rate + radf_idx , & + qsatfac_idx ! subgrid cloud water saturation scaling factor + + integer, public :: & + ixthlp2 = 0, & + ixwpthlp = 0, & + ixwprtp = 0, & + ixwp2 = 0, & + ixwp3 = 0, & + ixrtpthlp = 0, & + ixrtp2 = 0, & + ixup2 = 0, & + ixvp2 = 0 + + integer :: cmfmc_sh_idx = 0 + + integer :: & + dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. + difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio. + dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. + dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. + + ! Output arrays for CLUBB statistics + real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc + + character(len=16) :: eddy_scheme ! Default set in phys_control.F90 + character(len=16) :: deep_scheme ! Default set in phys_control.F90 + + integer, parameter :: ncnst=9 + character(len=8) :: cnst_names(ncnst) + logical :: do_cnst=.false. + + contains + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine clubb_register_cam( ) +!------------------------------------------------------------------------------- +! Description: +! Register the constituents and fields in the physics buffer +! Author: P. Bogenschutz, C. Craig, A. Gettelman +! +!------------------------------------------------------------------------------- +#ifdef CLUBB_SGS + + !------------------------------------------------ ! + ! Register physics buffer fields and constituents ! + !------------------------------------------------ ! + + ! Add CLUBB fields to pbuf + use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls + + call phys_getopts( eddy_scheme_out = eddy_scheme, & + deep_scheme_out = deep_scheme, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num ) + + if (clubb_do_adv) then + cnst_names =(/'THLP2 ','RTP2 ','RTPTHLP','WPTHLP ','WPRTP ','WP2 ','WP3 ','UP2 ','VP2 '/) + do_cnst=.true. + ! If CLUBB moments are advected, do not output them automatically which is typically done. Some moments + ! need a constant added to them before they are advected, thus this would corrupt the output. + ! Users should refer to the "XXXX_CLUBB" (THLP2_CLUBB for instance) output variables for these moments + call cnst_add(trim(cnst_names(1)),0._r8,0._r8,0._r8,ixthlp2,longname='second moment vertical velocity',cam_outfld=.false.) + call cnst_add(trim(cnst_names(2)),0._r8,0._r8,0._r8,ixrtp2,longname='second moment rtp',cam_outfld=.false.) + call cnst_add(trim(cnst_names(3)),0._r8,0._r8,-999999._r8,ixrtpthlp,longname='covariance rtp thlp',cam_outfld=.false.) + call cnst_add(trim(cnst_names(4)),0._r8,0._r8,-999999._r8,ixwpthlp,longname='CLUBB heat flux',cam_outfld=.false.) + call cnst_add(trim(cnst_names(5)),0._r8,0._r8,-999999._r8,ixwprtp,longname='CLUBB moisture flux',cam_outfld=.false.) + call cnst_add(trim(cnst_names(6)),0._r8,0._r8,0._r8,ixwp2,longname='CLUBB wp2',cam_outfld=.false.) + call cnst_add(trim(cnst_names(7)),0._r8,0._r8,-999999._r8,ixwp3,longname='CLUBB 3rd moment vert velocity',cam_outfld=.false.) + call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.) + call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.) + end if + + ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top + call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) + call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) + call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) + call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) + call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) + call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) + call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) + call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) + call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) + call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) + call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx) + call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) + call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) + + + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) + call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx) + call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) + call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx) + call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx) + call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx) + call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx) + call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) + + call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx) + call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx) + call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlm_idx) + call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtm_idx) + call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), um_idx) + call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx) + +#endif + + end subroutine clubb_register_cam + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + +function clubb_implements_cnst(name) + + !----------------------------------------------------------------------------- ! + ! ! + ! Return true if specified constituent is implemented by this package ! + ! ! + !----------------------------------------------------------------------------- ! + + character(len=*), intent(in) :: name ! constituent name + logical :: clubb_implements_cnst ! return value + + !----------------------------------------------------------------------- + + clubb_implements_cnst = (do_cnst .and. any(name == cnst_names)) + +end function clubb_implements_cnst + + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + +subroutine clubb_init_cnst(name, latvals, lonvals, mask, q) +#ifdef CLUBB_SGS + use constants_clubb, only: w_tol_sqd, rt_tol, thl_tol +#endif + + !----------------------------------------------------------------------- ! + ! ! + ! Initialize the state if clubb_do_adv ! + ! ! + !----------------------------------------------------------------------- ! + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + + !----------------------------------------------------------------------- + integer :: k, nlev + +#ifdef CLUBB_SGS + if (clubb_do_adv) then + nlev = size(q, 2) + do k = 1, nlev + if (trim(name) == trim(cnst_names(1))) then + where(mask) + q(:,k) = thl_tol**2 + end where + end if + if (trim(name) == trim(cnst_names(2))) then + where(mask) + q(:,k) = rt_tol**2 + end where + end if + if (trim(name) == trim(cnst_names(3))) then + where(mask) + q(:,k) = 0.0_r8 + end where + end if + if (trim(name) == trim(cnst_names(4))) then + where(mask) + q(:,k) = 0.0_r8 + end where + end if + if (trim(name) == trim(cnst_names(5))) then + where(mask) + q(:,k) = 0.0_r8 + end where + end if + if (trim(name) == trim(cnst_names(6))) then + where(mask) + q(:,k) = w_tol_sqd + end where + end if + if (trim(name) == trim(cnst_names(7))) then + where(mask) + q(:,k) = 0.0_r8 + end where + end if + if (trim(name) == trim(cnst_names(8))) then + where(mask) + q(:,k) = w_tol_sqd + end where + end if + if (trim(name) == trim(cnst_names(9))) then + where(mask) + q(:,k) = w_tol_sqd + end where + end if + end do + end if +#endif + +end subroutine clubb_init_cnst + + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine clubb_readnl(nlfile) + +#ifdef CLUBB_SGS + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cam_abortutils, only: endrun + use stats_variables, only: l_stats, l_output_rad_files + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8 + use clubb_api_module, only: l_diffuse_rtm_and_thlm, l_stability_correct_Kh_N2_zm +#endif + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + +#ifdef CLUBB_SGS + + character(len=*), parameter :: sub = 'clubb_readnl' + + logical :: clubb_history, clubb_rad_history, clubb_cloudtop_cooling, clubb_rainevap_turb, & + clubb_stabcorrect, clubb_expldiff ! Stats enabled (T/F) + + integer :: iunit, read_status, ierr + + namelist /clubb_his_nl/ clubb_history, clubb_rad_history + namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_expldiff, & + clubb_do_adv, clubb_timestep, clubb_stabcorrect, & + clubb_rnevap_effic + namelist /clubb_params_nl/ clubb_c11, clubb_c11b, clubb_c14, clubb_mult_coef, clubb_gamma_coef, & + clubb_c_K10, clubb_c_K10h, clubb_beta, clubb_C2rt, clubb_C2thl, & + clubb_C2rtthl, clubb_C8, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & + clubb_lambda0_stability_coef, clubb_l_lscale_plume_centered, & + clubb_l_use_ice_latent, clubb_do_liqsupersat + + !----- Begin Code ----- + + ! Determine if we want clubb_history to be output + clubb_history = .false. ! Initialize to false + l_stats = .false. ! Initialize to false + l_output_rad_files = .false. ! Initialize to false + do_cldcool = .false. ! Initialize to false + do_rainturb = .false. ! Initialize to false + do_expldiff = .false. ! Initialize to false + + clubb_l_lscale_plume_centered = .false. ! Initialize to false! + clubb_l_use_ice_latent = .false. ! Initialize to false! + + ! Read namelist to determine if CLUBB history should be called + if (masterproc) then + iunit = getunit() + open( iunit, file=trim(nlfile), status='old' ) + + call find_group_name(iunit, 'clubb_his_nl', status=read_status) + if (read_status == 0) then + read(unit=iunit, nml=clubb_his_nl, iostat=read_status) + if (read_status /= 0) then + call endrun('clubb_readnl: error reading namelist') + end if + end if + + call find_group_name(iunit, 'clubb_params_nl', status=read_status) + if (read_status == 0) then + read(unit=iunit, nml=clubb_params_nl, iostat=read_status) + if (read_status /= 0) then + call endrun('clubb_readnl: error reading namelist') + end if + else + call endrun('clubb_readnl: error reading namelist') + end if + + call find_group_name(iunit, 'clubbpbl_diff_nl', status=read_status) + if (read_status == 0) then + read(unit=iunit, nml=clubbpbl_diff_nl, iostat=read_status) + if (read_status /= 0) then + call endrun('clubb_readnl: error reading namelist') + end if + end if + + close(unit=iunit) + call freeunit(iunit) + end if + + ! Broadcast namelist variables + call mpi_bcast(clubb_history, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_history") + call mpi_bcast(clubb_rad_history, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rad_history") + call mpi_bcast(clubb_cloudtop_cooling, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling") + call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") + call mpi_bcast(clubb_expldiff, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_expldiff") + call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") + call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_timestep") + call mpi_bcast(clubb_stabcorrect, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_stabcorrect") + call mpi_bcast(clubb_rnevap_effic, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rnevap_effic") + + call mpi_bcast(clubb_c11, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11") + call mpi_bcast(clubb_c11b, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b") + call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14") + call mpi_bcast(clubb_mult_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mult_coef") + call mpi_bcast(clubb_gamma_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coef") + call mpi_bcast(clubb_c_K10, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10") + call mpi_bcast(clubb_c_K10h, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h") + call mpi_bcast(clubb_beta, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_beta") + call mpi_bcast(clubb_C2rt, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rt") + call mpi_bcast(clubb_C2thl, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2thl") + call mpi_bcast(clubb_C2rtthl, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rtthl") + call mpi_bcast(clubb_C8, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C8") + call mpi_bcast(clubb_C7, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7") + call mpi_bcast(clubb_C7b, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b") + call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef") + call mpi_bcast(clubb_lambda0_stability_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef") + call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered") + call mpi_bcast(clubb_l_use_ice_latent, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_ice_latent") + call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat") + + ! Overwrite defaults if they are true + if (clubb_history) l_stats = .true. + if (clubb_rad_history) l_output_rad_files = .true. + if (clubb_cloudtop_cooling) do_cldcool = .true. + if (clubb_rainevap_turb) do_rainturb = .true. + if (clubb_expldiff) do_expldiff = .true. + + if (clubb_stabcorrect .and. clubb_expldiff) then + call endrun('clubb_readnl: clubb_stabcorrect and clubb_expldiff may not both be set to true at the same time') + end if + + if (clubb_stabcorrect) then + l_diffuse_rtm_and_thlm = .true. ! CLUBB flag set to true + l_stability_correct_Kh_N2_zm = .true. ! CLUBB flag set to true + endif + +#endif + end subroutine clubb_readnl + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine clubb_ini_cam(pbuf2d) +!------------------------------------------------------------------------------- +! Description: +! Initialize UWM CLUBB. +! Author: Cheryl Craig March 2011 +! Modifications: Pete Bogenschutz 2011 March and onward +! Origin: Based heavily on UWM clubb_init.F90 +! References: +! None +!------------------------------------------------------------------------------- + + + +#ifdef CLUBB_SGS + + ! From CAM libraries + use cam_history, only: addfld, add_default, horiz_only + use ref_pres, only: pref_mid + use hb_diff, only: init_hb_diff + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx + use cam_abortutils, only: endrun + + ! From the CLUBB libraries + use clubb_api_module, only: & + setup_clubb_core_api, & + time_precision, & + core_rknd, & + set_clubb_debug_level_api, & + nparams, & + read_parameters_api, & + l_stats, & + l_stats_samp, & + l_grads, & + stats_zt, & + stats_zm, & + stats_sfc, & + stats_rad_zt, & + stats_rad_zm, & + w_tol_sqd, & + rt_tol, & + thl_tol + + ! These are only needed if we're using a passive scalar + use clubb_api_module, only: & + iisclr_rt, & + iisclr_thl, & + iisclr_CO2, & + iiedsclr_rt, & + iiedsclr_thl, & + iiedsclr_CO2 + + ! These are needed to set parameters + use clubb_api_module, only: & + ilambda0_stability_coef, ic_K10, ic_K10h, iC2rtthl, iC7, iC7b, iC8, iC11, iC11b, & + iC14, igamma_coef, imult_coef, ilmin_coef, iSkw_denom_coef, ibeta, & + iC2rt, iC2thl, iC2rtthl, l_do_expldiff_rtm_thlm, l_Lscale_plume_centered, & + l_use_ice_latent + + use time_manager, only: is_first_step + + use constituents, only: cnst_get_ind + use phys_control, only: phys_getopts + +#endif + + use physics_buffer, only: pbuf_get_index, pbuf_set_field, physics_buffer_desc + implicit none + ! Input Variables + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +#ifdef CLUBB_SGS + + real(kind=time_precision) :: dum1, dum2, dum3 + + real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) + + ! The similar name to clubb_history is unfortunate... + logical :: history_amwg, history_clubb + + integer :: err_code ! Code for when CLUBB fails + integer :: k, l ! Indices + integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 ) + integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) + integer :: nmodes, nspec, m + integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice + integer :: lptr + + real(r8) :: zt_g(pverp+1-top_lev) ! Height dummy array + real(r8) :: zi_g(pverp+1-top_lev) ! Height dummy array + + ! CAM defines zi at the surface to be zero. + real(r8), parameter :: sfc_elevation = 0._r8 + + integer :: nlev + + !----- Begin Code ----- + + nlev = pver + 1 - top_lev + + if (core_rknd /= r8) then + call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not') + end if + + ! ----------------------------------------------------------------- ! + ! Determine how many constituents CLUBB will transport. Note that + ! CLUBB does not transport aerosol consituents. Therefore, need to + ! determine how many aerosols constituents there are and subtract that + ! off of pcnst (the total consituents) + ! ----------------------------------------------------------------- ! + + call phys_getopts(prog_modal_aero_out=prog_modal_aero, & + history_amwg_out=history_amwg, & + history_clubb_out=history_clubb) + + ! Select variables to apply tendencies back to CAM + + ! Initialize all consituents to true to start + lq(1:pcnst) = .true. + edsclr_dim = pcnst + + call cnst_get_ind('Q',ixq) + call cnst_get_ind('NUMICE',ixnumice) + call cnst_get_ind('NUMLIQ',ixnumliq) + call cnst_get_ind('CLDLIQ',ixcldliq) + call cnst_get_ind('CLDICE',ixcldice) + + if (prog_modal_aero) then + ! Turn off modal aerosols and decrement edsclr_dim accordingly + call rad_cnst_get_info(0, nmodes=nmodes) + + do m = 1, nmodes + call rad_cnst_get_mode_num_idx(m, lptr) + lq(lptr)=.false. + edsclr_dim = edsclr_dim-1 + + call rad_cnst_get_info(0, m, nspec=nspec) + do l = 1, nspec + call rad_cnst_get_mam_mmr_idx(m, l, lptr) + lq(lptr)=.false. + edsclr_dim = edsclr_dim-1 + end do + end do + + ! In addition, if running with MAM, droplet number is transported + ! in dropmixnuc, therefore we do NOT want CLUBB to apply transport + ! tendencies to avoid double counted. Else, we apply tendencies. + lq(ixnumliq) = .false. + edsclr_dim = edsclr_dim-1 + endif + + ! ----------------------------------------------------------------- ! + ! Set the debug level. Level 2 has additional computational expense since + ! it checks the array variables in CLUBB for invalid values. + ! ----------------------------------------------------------------- ! + call set_clubb_debug_level_api( 0 ) + + ! ----------------------------------------------------------------- ! + ! use pbuf_get_fld_idx to get existing physics buffer fields from other + ! physics packages (e.g. tke) + ! ----------------------------------------------------------------- ! + + + ! Defaults + l_stats_samp = .false. + l_grads = .false. + + ! Overwrite defaults if needbe + if (l_stats) l_stats_samp = .true. + + ! Define physics buffers indexes + cld_idx = pbuf_get_index('CLD') ! Cloud fraction + concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover + ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction + alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction + aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction + qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC + qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC + dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction + icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio + sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction + relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance + accre_enhan_idx = pbuf_get_index('ACCRE_ENHAN') ! accretion enhancement for MG + prer_evap_idx = pbuf_get_index('PRER_EVAP') + qrl_idx = pbuf_get_index('QRL') + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + + + iisclr_rt = -1 + iisclr_thl = -1 + iisclr_CO2 = -1 + + iiedsclr_rt = -1 + iiedsclr_thl = -1 + iiedsclr_CO2 = -1 + + if (zmconv_microp) then + dlfzm_idx = pbuf_get_index('DLFZM') + difzm_idx = pbuf_get_index('DIFZM') + dnlfzm_idx = pbuf_get_index('DNLFZM') + dnifzm_idx = pbuf_get_index('DNIFZM') + end if + + ! ----------------------------------------------------------------- ! + ! Define number of tracers for CLUBB to diffuse + ! ----------------------------------------------------------------- ! + + if (do_expldiff) then + offset = 2 ! diffuse temperature and moisture explicitly + edsclr_dim = edsclr_dim + offset + endif + + ! ----------------------------------------------------------------- ! + ! Setup CLUBB core + ! ----------------------------------------------------------------- ! + + ! Read in parameters for CLUBB. Just read in default values + call read_parameters_api( -99, "", clubb_params ) + + ! Fill in dummy arrays for height. Note that these are overwrote + ! at every CLUBB step to physical values. + do k=1,nlev+1 + zt_g(k) = ((k-1)*1000._r8)-500._r8 ! this is dummy garbage + zi_g(k) = (k-1)*1000._r8 ! this is dummy garbage + enddo + + ! Set CLUBB parameters + clubb_params(ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params(ic_K10) = clubb_c_K10 + clubb_params(ic_K10h) = clubb_c_K10h + clubb_params(iC2rtthl) = clubb_C2rtthl + clubb_params(iC2rt) = clubb_C2rt + clubb_params(iC2thl) = clubb_C2thl + clubb_params(ibeta) = clubb_beta + clubb_params(iC7) = clubb_C7 + clubb_params(iC7b) = clubb_C7b + clubb_params(iC8) = clubb_C8 + clubb_params(iC11) = clubb_c11 + clubb_params(iC11b) = clubb_c11b + clubb_params(iC14) = clubb_c14 + clubb_params(igamma_coef) = clubb_gamma_coef + clubb_params(imult_coef) = clubb_mult_coef + clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params(ilmin_coef) = 0.1_r8 + +!$OMP PARALLEL + l_do_expldiff_rtm_thlm = do_expldiff + l_Lscale_plume_centered = clubb_l_lscale_plume_centered + l_use_ice_latent = clubb_l_use_ice_latent + + ! Set up CLUBB core. Note that some of these inputs are overwritten + ! when clubb_tend_cam is called. The reason is that heights can change + ! at each time step, which is why dummy arrays are read in here for heights + ! as they are immediately overwrote. + call setup_clubb_core_api & + ( nlev+1, theta0, ts_nudge, & ! In + hydromet_dim, sclr_dim, & ! In + sclr_tol, edsclr_dim, clubb_params, & ! In + l_host_applies_sfc_fluxes, & ! In + l_uv_nudge, saturation_equation, & ! In + l_implemented, grid_type, zi_g(2), zi_g(1), zi_g(nlev+1),& ! In + zi_g(1:nlev+1), zt_g(1:nlev+1), sfc_elevation, & ! In + err_code ) +!$OMP END PARALLEL + + ! ----------------------------------------------------------------- ! + ! Set-up HB diffusion. Only initialized to diagnose PBL depth ! + ! ----------------------------------------------------------------- ! + + ! Initialize eddy diffusivity module + + ntop_eddy = 1 ! if >1, must be <= nbot_molec + nbot_eddy = pver ! currently always pver + + call init_hb_diff( gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme ) + + ! ----------------------------------------------------------------- ! + ! Add output fields for the history files + ! ----------------------------------------------------------------- ! + + ! These are default CLUBB output. Not the higher order history budgets + call addfld ('RHO_CLUBB', (/ 'ilev' /), 'A', 'kg/m3', 'Air Density') + call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance') + call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance') + call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance') + call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux') + call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux') + call addfld ('WP3_CLUBB', (/ 'ilev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity') + call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux') + call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux') + call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'g^2/kg^2', 'Moisture Variance') + call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance') + call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K g/kg', 'Temp. Moist. Covariance') + call addfld ('RCM_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water Mixing Ratio') + call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux') + call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction') + call addfld ('RCMINLAYER_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water in Layer') + call addfld ('CLOUDCOVER_CLUBB', (/ 'ilev' /), 'A', 'fraction', 'Cloud Cover') + call addfld ('WPTHVP_CLUBB', (/ 'lev' /), 'A', 'W/m2', 'Buoyancy Flux') + call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Water vapor tendency') + call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'k/s', 'Temperature tendency') + call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Liquid Water Tendency') + call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Ice Tendency') + call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency') + call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency') + call addfld ('ZT_CLUBB', (/ 'ilev' /), 'A', 'm', 'Thermodynamic Heights') + call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights') + call addfld ('UM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Zonal Wind') + call addfld ('VM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Meridional Wind') + call addfld ('THETAL', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature') + call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height') + call addfld ('QT', (/ 'lev' /), 'A', 'kg/kg', 'Total water mixing ratio') + call addfld ('SL', (/ 'lev' /), 'A', 'J/kg', 'Liquid water static energy') + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction') + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection') + call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment') + call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment') + call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment') + call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment') + call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment') + + call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection') + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection') + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment') + call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance') + call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB') + + + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover') + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud') + + call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor') + call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels') + + ! Initialize statistics, below are dummy variables + dum1 = 300._r8 + dum2 = 1200._r8 + dum3 = 300._r8 + + if (l_stats) then + + call stats_init_clubb( .true., dum1, dum2, & + nlev+1, nlev+1, nlev+1, dum3 ) + + allocate(out_zt(pcols,pverp,stats_zt%num_output_fields)) + allocate(out_zm(pcols,pverp,stats_zm%num_output_fields)) + allocate(out_sfc(pcols,1,stats_sfc%num_output_fields)) + + allocate(out_radzt(pcols,pverp,stats_rad_zt%num_output_fields)) + allocate(out_radzm(pcols,pverp,stats_rad_zm%num_output_fields)) + + endif + + ! ----------------------------------------------------------------- ! + ! Make all of this output default, this is not CLUBB history + ! ----------------------------------------------------------------- ! + if (clubb_do_adv .or. history_clubb) then + call add_default('WP2_CLUBB', 1, ' ') + call add_default('WP3_CLUBB', 1, ' ') + call add_default('WPTHLP_CLUBB', 1, ' ') + call add_default('WPRTP_CLUBB', 1, ' ') + call add_default('RTP2_CLUBB', 1, ' ') + call add_default('THLP2_CLUBB', 1, ' ') + call add_default('RTPTHLP_CLUBB', 1, ' ') + call add_default('UP2_CLUBB', 1, ' ') + call add_default('VP2_CLUBB', 1, ' ') + end if + + if (history_clubb) then + + call add_default('RELVAR', 1, ' ') + call add_default('RHO_CLUBB', 1, ' ') + call add_default('UPWP_CLUBB', 1, ' ') + call add_default('VPWP_CLUBB', 1, ' ') + call add_default('RCM_CLUBB', 1, ' ') + call add_default('WPRCP_CLUBB', 1, ' ') + call add_default('CLOUDFRAC_CLUBB', 1, ' ') + call add_default('RCMINLAYER_CLUBB', 1, ' ') + call add_default('CLOUDCOVER_CLUBB', 1, ' ') + call add_default('WPTHVP_CLUBB', 1, ' ') + call add_default('RVMTEND_CLUBB', 1, ' ') + call add_default('STEND_CLUBB', 1, ' ') + call add_default('RCMTEND_CLUBB', 1, ' ') + call add_default('RIMTEND_CLUBB', 1, ' ') + call add_default('UTEND_CLUBB', 1, ' ') + call add_default('VTEND_CLUBB', 1, ' ') + call add_default('ZT_CLUBB', 1, ' ') + call add_default('ZM_CLUBB', 1, ' ') + call add_default('UM_CLUBB', 1, ' ') + call add_default('VM_CLUBB', 1, ' ') + call add_default('SL', 1, ' ') + call add_default('QT', 1, ' ') + call add_default('CONCLD', 1, ' ') + + end if + + if (history_amwg) then + call add_default('PBLH', 1, ' ') + end if + + if (history_budget) then + call add_default('DPDLFLIQ', history_budget_histfile_num, ' ') + call add_default('DPDLFICE', history_budget_histfile_num, ' ') + call add_default('DPDLFT', history_budget_histfile_num, ' ') + call add_default('STEND_CLUBB', history_budget_histfile_num, ' ') + call add_default('RCMTEND_CLUBB', history_budget_histfile_num, ' ') + call add_default('RIMTEND_CLUBB', history_budget_histfile_num, ' ') + call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ') + call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ') + call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ') + endif + + + ! --------------- ! + ! First step? ! + ! Initialization ! + ! --------------- ! + + ! Is this the first time step? If so then initialize CLUBB variables as follows + if (is_first_step()) then + + call pbuf_set_field(pbuf2d, wp2_idx, w_tol_sqd) + call pbuf_set_field(pbuf2d, wp3_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wprtp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rtpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rtp2_idx, rt_tol**2) + call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2) + call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd) + call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd) + + call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) + + endif + + ! The following is physpkg, so it needs to be initialized every time + call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) + + ! --------------- ! + ! End ! + ! Initialization ! + ! --------------- ! + +#endif + end subroutine clubb_ini_cam + + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine clubb_tend_cam( & + state, ptend_all, pbuf, hdtime, & + cmfmc, cam_in, & + macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice) + +!------------------------------------------------------------------------------- +! Description: Provide tendencies of shallow convection, turbulence, and +! macrophysics from CLUBB to CAM +! +! Author: Cheryl Craig, March 2011 +! Modifications: Pete Bogenschutz, March 2011 and onward +! Origin: Based heavily on UWM clubb_init.F90 +! References: +! None +!------------------------------------------------------------------------------- + + use physics_types, only: physics_state, physics_ptend, & + physics_state_copy, physics_ptend_init, & + physics_ptend_sum, physics_update + + use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field, & + physics_buffer_desc + + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + use time_manager, only: is_first_step + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use tropopause, only: tropopause_findChemTrop + +#ifdef CLUBB_SGS + use hb_diff, only: pblintd + use scamMOD, only: single_column,scm_clubb_iop_name + use clubb_api_module, only: & + nparams, & + read_parameters_api, & + setup_parameters_api, & + setup_grid_heights_api, & + w_tol_sqd, & + rt_tol, & + thl_tol, & + l_stats, & + stats_tsamp, & + stats_tout, & + stats_zt, & + stats_sfc, & + stats_zm, & + stats_rad_zt, & + stats_rad_zm, & + l_output_rad_files, & + pdf_parameter, & + stats_begin_timestep_api, & + advance_clubb_core_api, & + calculate_thlp2_rad_api, & + update_xp2_mc_api, & + zt2zm_api, zm2zt_api + + ! These are not exposed by the api module, but we want them anyway! + use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const + use cam_history, only: outfld + + use macrop_driver, only: liquid_macro_tend +#endif + + implicit none + + ! --------------- ! + ! Input Auguments ! + ! --------------- ! + + type(physics_state), intent(in) :: state ! Physics state variables [vary] + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: hdtime ! Host model timestep [s] + real(r8), intent(in) :: dlf(pcols,pver) ! Detraining cld H20 from deep convection [kg/ks/s] + real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s] + integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations + integer, intent(in) :: macmic_it ! number of mac-mic iterations + + ! ---------------------- ! + ! Input-Output Auguments ! + ! ---------------------- ! + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! ---------------------- ! + ! Output Auguments ! + ! ---------------------- ! + + type(physics_ptend), intent(out) :: ptend_all ! package tendencies + + ! These two variables are needed for energy check + real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice + real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check + + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + +#ifdef CLUBB_SGS + + type(physics_state) :: state1 ! Local copy of state variable + type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all + + integer :: i, k, t, ixind, nadv + integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq + integer :: itim_old + integer :: ncol, lchnk ! # of columns, and chunk identifier + integer :: err_code ! Diagnostic, for if some calculation goes amiss. + integer :: icnt, clubbtop + logical :: lq2(pcnst) + + + real(r8) :: frac_limit, ic_limit + + real(r8) :: dtime ! CLUBB time step [s] + real(r8) :: edsclr_in(pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: wp2_in(pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] + real(r8) :: wp3_in(pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] + real(r8) :: wpthlp_in(pverp+1-top_lev) ! turbulent flux of thetal [K m/s] + real(r8) :: wprtp_in(pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] + real(r8) :: rtpthlp_in(pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] + real(r8) :: rtp2_in(pverp+1-top_lev) ! total water variance [kg^2/k^2] + real(r8) :: rtp3_in(pverp+1-top_lev) ! r_t'^3 (thermodynamic levels) (unused) [(kg/kg)^3] + real(r8) :: thlp2_in(pverp+1-top_lev) ! thetal variance [K^2] + real(r8) :: thlp3_in(pverp+1-top_lev) ! th_l'^3 (thermodynamic levels) (unused) [K^3] + real(r8) :: up2_in(pverp+1-top_lev) ! meridional wind variance [m^2/s^2] + real(r8) :: vp2_in(pverp+1-top_lev) ! zonal wind variance [m^2/s^2] + real(r8) :: upwp_in(pverp+1-top_lev) ! meridional wind flux [m^2/s^2] + real(r8) :: vpwp_in(pverp+1-top_lev) ! zonal wind flux [m^2/s^2] + real(r8) :: thlm_in(pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] + real(r8) :: rtm_in(pverp+1-top_lev) ! total water mixing ratio [kg/kg] + real(r8) :: rvm_in(pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] + real(r8) :: um_in(pverp+1-top_lev) ! meridional wind [m/s] + real(r8) :: vm_in(pverp+1-top_lev) ! zonal wind [m/s] + real(r8) :: rho_in(pverp+1-top_lev) ! mid-point density [kg/m^3] + real(r8) :: pre_in(pverp+1-top_lev) ! input for precip evaporation + real(r8) :: rtp2_mc_out(pverp+1-top_lev) ! total water tendency from rain evap + real(r8) :: thlp2_mc_out(pverp+1-top_lev) ! thetal tendency from rain evap + real(r8) :: wprtp_mc_out(pverp+1-top_lev) + real(r8) :: wpthlp_mc_out(pverp+1-top_lev) + real(r8) :: rtpthlp_mc_out(pverp+1-top_lev) + real(r8) :: rcm_out(pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] + real(r8) :: rcm_out_zm(pverp+1-top_lev) + real(r8) :: wprcp_out(pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] + real(r8) :: cloud_frac_out(pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] + real(r8) :: rcm_in_layer_out(pverp+1-top_lev)! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + real(r8) :: cloud_cover_out(pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] + real(r8) :: thlprcp_out(pverp+1-top_lev) + real(r8) :: rho_ds_zm(pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] + real(r8) :: rho_ds_zt(pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] + real(r8) :: invrs_rho_ds_zm(pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] + real(r8) :: invrs_rho_ds_zt(pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] + real(r8) :: thv_ds_zm(pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] + real(r8) :: thv_ds_zt(pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] + real(r8) :: rfrzm(pverp+1-top_lev) + real(r8) :: radf(pverp+1-top_lev) + real(r8) :: wprtp_forcing(pverp+1-top_lev) + real(r8) :: wpthlp_forcing(pverp+1-top_lev) + real(r8) :: rtp2_forcing(pverp+1-top_lev) + real(r8) :: thlp2_forcing(pverp+1-top_lev) + real(r8) :: rtpthlp_forcing(pverp+1-top_lev) + real(r8) :: ice_supersat_frac(pverp+1-top_lev) + real(r8) :: zt_g(pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] + real(r8) :: zi_g(pverp+1-top_lev) ! Momentum grid of CLUBB [m] + real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] + real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] + real(r8) :: fcor ! Coriolis forcing [s^-1] + real(r8) :: sfc_elevation ! Elevation of ground [m AMSL] + real(r8) :: ubar ! surface wind [m/s] + real(r8) :: ustar ! surface stress [m/s] + real(r8) :: thlm_forcing(pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] + real(r8) :: rtm_forcing(pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + real(r8) :: um_forcing(pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: vm_forcing(pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: wm_zm(pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] + real(r8) :: wm_zt(pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] + real(r8) :: p_in_Pa(pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] + real(r8) :: rho_zt(pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] + real(r8) :: rho_zm(pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] + real(r8) :: exner(pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] + real(r8) :: wpthlp_sfc ! w' theta_l' at surface [(m K)/s] + real(r8) :: wprtp_sfc ! w' r_t' at surface [(kg m)/( kg s)] + real(r8) :: upwp_sfc ! u'w' at surface [m^2/s^2] + real(r8) :: vpwp_sfc ! v'w' at surface [m^2/s^2] + real(r8) :: sclrm_forcing(pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] + real(r8) :: wpsclrp_sfc(sclr_dim) ! Scalar flux at surface [{units vary} m/s] + real(r8) :: edsclrm_forcing(pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] + real(r8) :: wpedsclrp_sfc(edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] + real(r8) :: sclrm(pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] + real(r8) :: wpsclrp(pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] + real(r8) :: sclrp2(pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] + real(r8) :: sclrprtp(pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + real(r8) :: sclrpthlp(pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] + real(r8) :: hydromet(pverp+1-top_lev,hydromet_dim) + real(r8) :: wphydrometp(pverp+1-top_lev,hydromet_dim) + real(r8) :: wp2hmp(pverp+1-top_lev,hydromet_dim) + real(r8) :: rtphmp_zt(pverp+1-top_lev,hydromet_dim) + real(r8) :: thlphmp_zt (pverp+1-top_lev,hydromet_dim) + real(r8) :: bflx22 ! Variable for buoyancy flux for pbl [K m/s] + real(r8) :: khzm_out(pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8) :: khzt_out(pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] + real(r8) :: qclvar_out(pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] + real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] + real(r8) :: zo ! roughness height [m] + real(r8) :: dz_g(pver) ! thickness of layer [m] + real(r8) :: relvarmax + real(r8) :: se_upper_a, se_upper_b, se_upper_diss + real(r8) :: tw_upper_a, tw_upper_b, tw_upper_diss + real(r8) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] + real(r8) :: host_dx, host_dy ! CAM grid [m] + + ! Variables below are needed to compute energy integrals for conservation + real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols) + real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols) + real(r8) :: se_dis, se_a(pcols), se_b(pcols), clubb_s(pver) + + real(r8) :: exner_clubb(pcols,pverp) ! Exner function consistent with CLUBB [-] + real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] + real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] + real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3] + real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] + real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] + real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] + real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] + real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] + real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] + real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] + real(r8) :: edsclr_out(pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: rcm(pcols,pverp) ! CLUBB cloud water mixing ratio [kg/kg] + real(r8) :: cloud_frac(pcols,pverp) ! CLUBB cloud fraction [fraction] + real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] + real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] + real(r8) :: wpthvp(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] + real(r8) :: rvm(pcols,pverp) + real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] + real(r8) :: eps ! Rv/Rd [-] + real(r8) :: dum1 ! dummy variable [units vary] + real(r8) :: obklen(pcols) ! Obukov length [m] + real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s] + real(r8) :: th(pcols,pver) ! potential temperature [K] + real(r8) :: dummy2(pcols) ! dummy variable [units vary] + real(r8) :: dummy3(pcols) ! dummy variable [units vary] + real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s] + real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] + real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] + real(r8) :: latsub + real(r8) :: qrl_clubb(pverp+1-top_lev) + real(r8) :: qrl_zm(pverp+1-top_lev) + real(r8) :: thlp2_rad_out(pverp+1-top_lev) + real(r8) :: apply_const, rtm_test + + integer :: time_elapsed ! time keep track of stats [s] + real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) + type(pdf_parameter), dimension(pverp) :: pdf_params ! PDF parameters [units vary] + character(len=200) :: temp1, sub ! Strings needed for CLUBB output + + + ! --------------- ! + ! Pointers ! + ! --------------- ! + + real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] + real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] + real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg] + real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K] + real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2] + real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2] + real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2] + + real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] + real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s] + real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s] + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] + real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] + real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] + real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] + real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] + real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] + real(r8), pointer, dimension(:,:) :: cmeliq + real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] + + real(r8), pointer, dimension(:,:) :: qsatfac + real(r8), pointer, dimension(:,:) :: npccn + real(r8), pointer, dimension(:,:) :: prer_evap + real(r8), pointer, dimension(:,:) :: qrl + real(r8), pointer, dimension(:,:) :: radf_clubb + + ! ZM microphysics + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio. + real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. + real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. + + real(r8) :: stend(pcols,pver) + real(r8) :: qvtend(pcols,pver) + real(r8) :: qctend(pcols,pver) + real(r8) :: inctend(pcols,pver) + real(r8) :: fqtend(pcols,pver) + real(r8) :: rhmini(pcols) + real(r8) :: rhmaxi(pcols) + integer :: troplev(pcols) + logical :: lqice(pcnst) + logical :: apply_to_surface + + real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs + + integer :: nlev + + intrinsic :: max + + character(len=*), parameter :: subr='clubb_tend_cam' + +#endif + det_s(:) = 0.0_r8 + det_ice(:) = 0.0_r8 +#ifdef CLUBB_SGS + + !-----------------------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------------------! + ! MAIN COMPUTATION BEGINS HERE ! + !-----------------------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------------------! + + nlev = pver + 1 - top_lev + + frac_limit = 0.01_r8 + ic_limit = 1.e-12_r8 + + if (clubb_do_adv) then + apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected + else + apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected + endif + + ! Get indicees for cloud and ice mass and cloud and ice number + + call cnst_get_ind('Q',ixq) + call cnst_get_ind('CLDLIQ',ixcldliq) + call cnst_get_ind('CLDICE',ixcldice) + call cnst_get_ind('NUMLIQ',ixnumliq) + call cnst_get_ind('NUMICE',ixnumice) + + ! Copy the state to state1 array to use in this routine + + ! Initialize physics tendency arrays, copy the state to state1 array to use in this routine + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq) + call physics_ptend_init(ptend_all, state%psetcols, 'clubb') + + call physics_state_copy(state,state1) + + if (clubb_do_liqsupersat) then + npccn_idx = pbuf_get_index('NPCCN') + call pbuf_get_field(pbuf, npccn_idx, npccn) + endif + + ! Determine number of columns and which chunk computation is to be performed on + + ncol = state%ncol + lchnk = state%lchnk + + ! Determine time step of physics buffer + + itim_old = pbuf_old_tim_idx() + + ! Establish associations between pointers and physics buffer fields + + call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, tke_idx, tke) + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, radf_idx, radf_clubb) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) + + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) + call pbuf_get_field(pbuf, relvar_idx, relvar) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu) + call pbuf_get_field(pbuf, sh_frac_idx, shalcu) + call pbuf_get_field(pbuf, kvh_idx, khzm) + call pbuf_get_field(pbuf, pblh_idx, pblh) + call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr) + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + + ! Initialize the apply_const variable (note special logic is due to eularian backstepping) + if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) .eq. 0._r8))) then + apply_const = 0._r8 ! On first time through do not remove constant + ! from moments since it has not been added yet + endif + + ! Define the grid box size. CLUBB needs this information to determine what + ! the maximum length scale should be. This depends on the column for + ! variable mesh grids and lat-lon grids + if (single_column) then + ! If single column specify grid box size to be something + ! similar to a GCM run + grid_dx(:) = 100000._r8 + grid_dy(:) = 100000._r8 + else + + call grid_size(state1, grid_dx, grid_dy) + + endif + + ! Determine CLUBB time step and make it sub-step friendly + ! For now we want CLUBB time step to be 5 min since that is + ! what has been scientifically validated. However, there are certain + ! instances when a 5 min time step will not be possible (based on + ! host model time step or on macro-micro sub-stepping + + dtime = clubb_timestep + + ! Now check to see if dtime is greater than the host model + ! (or sub stepped) time step. If it is, then simply + ! set it equal to the host (or sub step) time step. + ! This section is mostly to deal with small host model + ! time steps (or small sub-steps) + + if (dtime .gt. hdtime) then + dtime = hdtime + endif + + ! Now check to see if CLUBB time step divides evenly into + ! the host model time step. If not, force it to divide evenly. + ! We also want it to be 5 minutes or less. This section is + ! mainly for host model time steps that are not evenly divisible + ! by 5 minutes + + if (mod(hdtime,dtime) .ne. 0) then + dtime = hdtime/2._r8 + do while (dtime .gt. clubb_timestep) + dtime = dtime/2._r8 + end do + endif + + ! If resulting host model time step and CLUBB time step do not divide evenly + ! into each other, have model throw a fit. + + if (mod(hdtime,dtime) .ne. 0) then + call endrun(subr//': CLUBB time step and HOST time step NOT compatible') + endif + + ! Since CLUBB has only been scientifically validated for a 5 minute timestep + ! (the default value of clubb_timestep), we have decided to error out if the + ! final value of dtime is less than clubb_timestep. Thus to use a non-validated + ! value for dtime the user will need to explicitly change the value of clubb_timestep + ! in the namelist, or comment this check. + if (dtime < clubb_timestep) then + if (masterproc) then + write(iulog,*) subr//':ERROR: The computed CLUBB timestep = ', dtime + write(iulog,*) subr//':ERROR: The namelist CLUBB timestep = ', clubb_timestep + write(iulog,*) ' The only validated value for the clubb timestep is 300 seconds.' + write(iulog,*) ' To run at any other value the namelist variable clubb_timestep must be set.' + write(iulog,*) ' Also consider adjusting the namelist variable cld_macmic_num_steps which' + write(iulog,*) ' determines the macro/micro substepping.' + end if + call endrun(subr//': computed CLUBB time step is less than clubb_timestep') + end if + + ! determine number of timesteps CLUBB core should be advanced, + ! host time step divided by CLUBB time step + nadv = max(hdtime/dtime,1._r8) + + ! Initialize forcings for transported scalars to zero + + sclrm_forcing(:,:) = 0._r8 + edsclrm_forcing(:,:) = 0._r8 + sclrm(:,:) = 0._r8 + + ! Compute exner function consistent with CLUBB's definition, which uses a constant + ! surface pressure. CAM's exner (in state does not). Therefore, for consistent + ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables + ! (such as thlm), use "exner_clubb" other wise use the exner in state + + do k=1,pver + do i=1,ncol + exner_clubb(i,k) = 1._r8/((state1%pmid(i,k)/p0_clubb)**(rair/cpair)) + enddo + enddo + + ! At each CLUBB call, initialize mean momentum and thermo CLUBB state + ! from the CAM state + + do k=1,pver ! loop over levels + do i=1,ncol ! loop over columns + + rtm(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq) + rvm(i,k) = state1%q(i,k,ixq) + um(i,k) = state1%u(i,k) + vm(i,k) = state1%v(i,k) + thlm(i,k) = state1%t(i,k)*exner_clubb(i,k)-(latvap/cpair)*state1%q(i,k,ixcldliq) + + if (clubb_do_adv) then + if (macmic_it .eq. 1) then + + ! Note that some of the moments below can be positive or negative. + ! Remove a constant that was added to prevent dynamics from clipping + ! them to prevent dynamics from making them positive. + thlp2(i,k) = state1%q(i,k,ixthlp2) + rtp2(i,k) = state1%q(i,k,ixrtp2) + rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - (rtpthlp_const*apply_const) + wpthlp(i,k) = state1%q(i,k,ixwpthlp) - (wpthlp_const*apply_const) + wprtp(i,k) = state1%q(i,k,ixwprtp) - (wprtp_const*apply_const) + wp2(i,k) = state1%q(i,k,ixwp2) + wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const) + up2(i,k) = state1%q(i,k,ixup2) + vp2(i,k) = state1%q(i,k,ixvp2) + endif + endif + + enddo + enddo + + if (clubb_do_adv) then + ! If not last step of macmic loop then set apply_const back to + ! zero to prevent output from being corrupted. + if (macmic_it .eq. cld_macmic_num_steps) then + apply_const = 1._r8 + else + apply_const = 0._r8 + endif + endif + + rtm(1:ncol,pverp) = rtm(1:ncol,pver) + um(1:ncol,pverp) = state1%u(1:ncol,pver) + vm(1:ncol,pverp) = state1%v(1:ncol,pver) + thlm(1:ncol,pverp) = thlm(1:ncol,pver) + + if (clubb_do_adv) then + thlp2(1:ncol,pverp)=thlp2(1:ncol,pver) + rtp2(1:ncol,pverp)=rtp2(1:ncol,pver) + rtpthlp(1:ncol,pverp)=rtpthlp(1:ncol,pver) + wpthlp(1:ncol,pverp)=wpthlp(1:ncol,pver) + wprtp(1:ncol,pverp)=wprtp(1:ncol,pver) + wp2(1:ncol,pverp)=wp2(1:ncol,pver) + wp3(1:ncol,pverp)=wp3(1:ncol,pver) + up2(1:ncol,pverp)=up2(1:ncol,pver) + vp2(1:ncol,pverp)=vp2(1:ncol,pver) + endif + + ! Compute virtual potential temperature, which is needed for CLUBB + do k=1,pver + do i=1,ncol + thv(i,k) = state1%t(i,k)*exner_clubb(i,k)*(1._r8+zvir*state1%q(i,k,ixq)& + -state1%q(i,k,ixcldliq)) + enddo + enddo + + ! Initialize physics tendencies + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq) + + call tropopause_findChemTrop(state, troplev) + + ! Loop over all columns in lchnk to advance CLUBB core + do i=1,ncol ! loop over columns + + ! Set time_elapsed to host model time step, this is for + ! CLUBB's budget stats + time_elapsed = hdtime + + ! Determine Coriolis force at given latitude. This is never used + ! when CLUBB is implemented in a host model, therefore just set + ! to zero. + fcor = 0._r8 + + ! Define the CLUBB momentum grid (in height, units of m) + do k=1,nlev+1 + zi_g(k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) + enddo + + ! Define the CLUBB thermodynamic grid (in units of m) + do k=1,nlev + zt_g(k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + end do + + do k=1,pver + dz_g(k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness + enddo + + ! Thermodynamic ghost point is below surface + zt_g(1) = -1._r8*zt_g(2) + + ! Set the elevation of the surface + sfc_elevation = state1%zi(i,pver+1) + + ! Set the grid size + host_dx = grid_dx(i) + host_dy = grid_dy(i) + + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. + ! Inputs for the momentum levels are set below setup_clubb core + do k=1,nlev + p_in_Pa(k+1) = state1%pmid(i,pver-k+1) ! Pressure profile + exner(k+1) = 1._r8/exner_clubb(i,pver-k+1) + rho_ds_zt(k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(pver-k+1)) + invrs_rho_ds_zt(k+1) = 1._r8/(rho_ds_zt(k+1)) ! Inverse ds rho at thermo + rho_in(k+1) = rho_ds_zt(k+1) ! rho on thermo + thv_ds_zt(k+1) = thv(i,pver-k+1) ! thetav on thermo + rfrzm(k+1) = state1%q(i,pver-k+1,ixcldice) + radf(k+1) = radf_clubb(i,pver-k+1) + qrl_clubb(k+1) = qrl(i,pver-k+1)/(cpair*state1%pdel(i,pver-k+1)) + enddo + + ! Below computes the same stuff for the ghost point. May or may + ! not be needed, just to be safe to avoid NaN's + rho_ds_zt(1) = rho_ds_zt(2) + invrs_rho_ds_zt(1) = invrs_rho_ds_zt(2) + rho_in(1) = rho_ds_zt(2) + thv_ds_zt(1) = thv_ds_zt(2) + rho_zt(:) = rho_in(:) + p_in_Pa(1) = p_in_Pa(2) + exner(1) = exner(2) + rfrzm(1) = rfrzm(2) + radf(1) = radf(2) + qrl_clubb(1) = qrl_clubb(2) + + ! Compute mean w wind on thermo grid, convert from omega to w + wm_zt(1) = 0._r8 + do k=1,nlev + wm_zt(k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(k+1)*gravit) + enddo + + ! ------------------------------------------------- ! + ! Begin case specific code for SCAM cases. ! + ! This section of code block NOT called in ! + ! global simulations ! + ! ------------------------------------------------- ! + + if (single_column) then + + ! Initialize zo if variable ustar is used + + if (cam_in%landfrac(i) .ge. 0.5_r8) then + zo = 0.035_r8 + else + zo = 0.0001_r8 + endif + + ! Compute surface wind (ubar) + ubar = sqrt(um(i,pver)**2+vm(i,pver)**2) + if (ubar .lt. 0.25_r8) ubar = 0.25_r8 + + ! Below denotes case specifics for surface momentum + ! and thermodynamic fluxes, depending on the case + + ! Define ustar (based on case, if not variable) + ustar = 0.25_r8 ! Initialize ustar in case no case + + if(trim(scm_clubb_iop_name) .eq. 'BOMEX_5day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) .eq. 'ATEX_48hr') then + ustar = 0.30_r8 + endif + + if(trim(scm_clubb_iop_name) .eq. 'RICO_3day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) .eq. 'arm97' .or. trim(scm_clubb_iop_name) .eq. 'gate' .or. & + trim(scm_clubb_iop_name) .eq. 'toga' .or. trim(scm_clubb_iop_name) .eq. 'mpace' .or. & + trim(scm_clubb_iop_name) .eq. 'ARM_CC') then + + bflx22 = (gravit/theta0)*wpthlp_sfc + ustar = diag_ustar(zt_g(2),bflx22,ubar,zo) + endif + + ! Compute the surface momentum fluxes, if this is a SCAM simulation + upwp_sfc = -um(i,pver)*ustar**2/ubar + vpwp_sfc = -vm(i,pver)*ustar**2/ubar + + endif + + ! Define surface sources for transported variables for diffusion, will + ! be zero as these tendencies are done in vertical_diffusion + do ixind=1,edsclr_dim + wpedsclrp_sfc(ixind) = 0._r8 + enddo + + ! Define forcings from CAM to CLUBB as zero for momentum and thermo, + ! forcings already applied through CAM + thlm_forcing = 0._r8 + rtm_forcing = 0._r8 + um_forcing = 0._r8 + vm_forcing = 0._r8 + + wprtp_forcing = 0._r8 + wpthlp_forcing = 0._r8 + rtp2_forcing = 0._r8 + thlp2_forcing = 0._r8 + rtpthlp_forcing = 0._r8 + + ice_supersat_frac = 0._r8 + + ! Set stats output and increment equal to CLUBB and host dt + stats_tsamp = dtime + stats_tout = hdtime + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and setup_parameters for this. + + ! Read in parameters for CLUBB. Just read in default values + call read_parameters_api( -99, "", clubb_params ) + + ! Set-up CLUBB core at each CLUBB call because heights can change + call setup_grid_heights_api(l_implemented, grid_type, zi_g(2), & + zi_g(1), zi_g, zt_g) + + call setup_parameters_api(zi_g(2), clubb_params, nlev+1, grid_type, & + zi_g, zt_g, err_code) + + ! Compute some inputs from the thermodynamic grid + ! to the momentum grid + rho_ds_zm = zt2zm_api(rho_ds_zt) + rho_zm = zt2zm_api(rho_zt) + invrs_rho_ds_zm = zt2zm_api(invrs_rho_ds_zt) + thv_ds_zm = zt2zm_api(thv_ds_zt) + wm_zm = zt2zm_api(wm_zt) + + ! Surface fluxes provided by host model + wpthlp_sfc = cam_in%shf(i)/(cpair*rho_ds_zm(1)) ! Sensible heat flux + wprtp_sfc = cam_in%cflx(i,1)/rho_ds_zm(1) ! Moisture flux (check rho) + upwp_sfc = cam_in%wsx(i)/rho_ds_zm(1) ! Surface meridional momentum flux + vpwp_sfc = cam_in%wsy(i)/rho_ds_zm(1) ! Surface zonal momentum flux + + ! Need to flip arrays around for CLUBB core + do k=1,nlev+1 + um_in(k) = um(i,pverp-k+1) + vm_in(k) = vm(i,pverp-k+1) + upwp_in(k) = upwp(i,pverp-k+1) + vpwp_in(k) = vpwp(i,pverp-k+1) + up2_in(k) = up2(i,pverp-k+1) + vp2_in(k) = vp2(i,pverp-k+1) + wp2_in(k) = wp2(i,pverp-k+1) + wp3_in(k) = wp3(i,pverp-k+1) + rtp2_in(k) = rtp2(i,pverp-k+1) + thlp2_in(k) = thlp2(i,pverp-k+1) + thlm_in(k) = thlm(i,pverp-k+1) + rtm_in(k) = rtm(i,pverp-k+1) + rvm_in(k) = rvm(i,pverp-k+1) + wprtp_in(k) = wprtp(i,pverp-k+1) + wpthlp_in(k) = wpthlp(i,pverp-k+1) + rtpthlp_in(k) = rtpthlp(i,pverp-k+1) + + if (k .ne. 1) then + pre_in(k) = prer_evap(i,pverp-k+1) + endif + + ! Initialize these to prevent crashing behavior + rcm_out(k) = 0._r8 + wprcp_out(k) = 0._r8 + cloud_frac_out(k) = 0._r8 + rcm_in_layer_out(k) = 0._r8 + cloud_cover_out(k) = 0._r8 + edsclr_in(k,:) = 0._r8 + khzm_out(k) = 0._r8 + khzt_out(k) = 0._r8 + + ! higher order scalar stuff, put to zero + sclrm(k,:) = 0._r8 + wpsclrp(k,:) = 0._r8 + sclrp2(k,:) = 0._r8 + sclrprtp(k,:) = 0._r8 + sclrpthlp(k,:) = 0._r8 + wpsclrp_sfc(:) = 0._r8 + hydromet(k,:) = 0._r8 + wphydrometp(k,:) = 0._r8 + wp2hmp(k,:) = 0._r8 + rtphmp_zt(k,:) = 0._r8 + thlphmp_zt(k,:) = 0._r8 + + enddo + + pre_in(1) = pre_in(2) + + if (clubb_do_adv) then + if (macmic_it .eq. 1) then + wp2_in=zt2zm_api(wp2_in) + wpthlp_in=zt2zm_api(wpthlp_in) + wprtp_in=zt2zm_api(wprtp_in) + up2_in=zt2zm_api(up2_in) + vp2_in=zt2zm_api(vp2_in) + thlp2_in=zt2zm_api(thlp2_in) + rtp2_in=zt2zm_api(rtp2_in) + rtpthlp_in=zt2zm_api(rtpthlp_in) + + do k=1,nlev+1 + thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) + rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) + wp2_in(k)=max(w_tol_sqd,wp2_in(k)) + up2_in(k)=max(w_tol_sqd,up2_in(k)) + vp2_in(k)=max(w_tol_sqd,vp2_in(k)) + enddo + endif + endif + + ! rtp3_in and thlp3_in are not currently used in CLUBB's default code. + rtp3_in(:) = 0.0_r8 + thlp3_in(:) = 0.0_r8 + + ! Do the same for tracers + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + do k=1,nlev + edsclr_in(k+1,icnt) = state1%q(i,pver-k+1,ixind) + enddo + edsclr_in(1,icnt) = edsclr_in(2,icnt) + end if + enddo + + if (do_expldiff) then + do k=1,nlev + edsclr_in(k+1,icnt+1) = thlm(i,pver-k+1) + edsclr_in(k+1,icnt+2) = rtm(i,pver-k+1) + enddo + + edsclr_in(1,icnt+1) = edsclr_in(2,icnt+1) + edsclr_in(1,icnt+2) = edsclr_in(2,icnt+2) + endif + + do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + + ! Increment the statistics then being stats timestep + if (l_stats) then + time_elapsed = time_elapsed+dtime + call stats_begin_timestep_api(time_elapsed, 1, 1) + endif + + ! Advance CLUBB CORE one timestep in the future + call advance_clubb_core_api & + ( l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & + thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & + sclrm_forcing, edsclrm_forcing, wprtp_forcing, & + wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + rtpthlp_forcing, wm_zm, wm_zt, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + wpsclrp_sfc, wpedsclrp_sfc, & + p_in_Pa, rho_zm, rho_in, exner, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, & + rfrzm, radf, & + wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & + host_dx, host_dy, & + um_in, vm_in, upwp_in, & + vpwp_in, up2_in, vp2_in, & + thlm_in, rtm_in, wprtp_in, wpthlp_in, & + wp2_in, wp3_in, rtp2_in, rtp3_in, & + thlp2_in, thlp3_in, rtpthlp_in, & + sclrm, sclrp2, sclrprtp, sclrpthlp, & + wpsclrp, edsclr_in, err_code, & + rcm_out, wprcp_out, cloud_frac_out, ice_supersat_frac, & + rcm_in_layer_out, cloud_cover_out, & + khzm_out, khzt_out, qclvar_out, thlprcp_out, & + pdf_params) + + if (do_rainturb) then + rvm_in = rtm_in - rcm_out + call update_xp2_mc_api(nlev+1, dtime, cloud_frac_out, & + rcm_out, rvm_in, thlm_in, wm_zt, exner, pre_in, pdf_params, & + rtp2_mc_out, thlp2_mc_out, & + wprtp_mc_out, wpthlp_mc_out, & + rtpthlp_mc_out) + + dum1 = (1._r8 - cam_in%landfrac(i)) + + ! update turbulent moments based on rain evaporation + rtp2_in = rtp2_in + clubb_rnevap_effic * dum1 * rtp2_mc_out * dtime + thlp2_in = thlp2_in + clubb_rnevap_effic * dum1 * thlp2_mc_out * dtime + wprtp_in = wprtp_in + clubb_rnevap_effic * dum1 * wprtp_mc_out * dtime + wpthlp_in = wpthlp_in + clubb_rnevap_effic * dum1 * wpthlp_mc_out * dtime + endif + + if (do_cldcool) then + + rcm_out_zm = zt2zm_api(rcm_out) + qrl_zm = zt2zm_api(qrl_clubb) + thlp2_rad_out(:) = 0._r8 + call calculate_thlp2_rad_api(nlev+1, rcm_out_zm, thlprcp_out, qrl_zm, thlp2_rad_out) + thlp2_in = thlp2_in + thlp2_rad_out * dtime + thlp2_in = max(thl_tol**2,thlp2_in) + endif + + ! Check to see if stats should be output, here stats are read into + ! output arrays to make them conformable to CAM output + if (l_stats) call stats_end_timestep_clubb(i,out_zt,out_zm,& + out_radzt,out_radzm,out_sfc) + + enddo ! end time loop + + if (clubb_do_adv) then + if (macmic_it .eq. cld_macmic_num_steps) then + wp2_in=zm2zt_api(wp2_in) + wpthlp_in=zm2zt_api(wpthlp_in) + wprtp_in=zm2zt_api(wprtp_in) + up2_in=zm2zt_api(up2_in) + vp2_in=zm2zt_api(vp2_in) + thlp2_in=zm2zt_api(thlp2_in) + rtp2_in=zm2zt_api(rtp2_in) + rtpthlp_in=zm2zt_api(rtpthlp_in) + + do k=1,nlev+1 + thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) + rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) + wp2_in(k)=max(w_tol_sqd,wp2_in(k)) + up2_in(k)=max(w_tol_sqd,up2_in(k)) + vp2_in(k)=max(w_tol_sqd,vp2_in(k)) + enddo + endif + endif + + ! Arrays need to be "flipped" to CAM grid + do k=1,nlev+1 + + um(i,pverp-k+1) = um_in(k) + vm(i,pverp-k+1) = vm_in(k) + upwp(i,pverp-k+1) = upwp_in(k) + vpwp(i,pverp-k+1) = vpwp_in(k) + up2(i,pverp-k+1) = up2_in(k) + vp2(i,pverp-k+1) = vp2_in(k) + thlm(i,pverp-k+1) = thlm_in(k) + rtm(i,pverp-k+1) = rtm_in(k) + wprtp(i,pverp-k+1)= wprtp_in(k) + wpthlp(i,pverp-k+1) = wpthlp_in(k) + wp2(i,pverp-k+1) = wp2_in(k) + wp3(i,pverp-k+1) = wp3_in(k) + rtp2(i,pverp-k+1) = rtp2_in(k) + thlp2(i,pverp-k+1)= thlp2_in(k) + rtpthlp(i,pverp-k+1) = rtpthlp_in(k) + rcm(i,pverp-k+1) = rcm_out(k) + wprcp(i,pverp-k+1)= wprcp_out(k) + cloud_frac(i,pverp-k+1) = min(cloud_frac_out(k),1._r8) + rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(k) + zt_out(i,pverp-k+1) = zt_g(k) + zi_out(i,pverp-k+1) = zi_g(k) + khzm(i,pverp-k+1) = khzm_out(k) + qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(k)) + + do ixind=1,edsclr_dim + edsclr_out(pverp-k+1,ixind) = edsclr_in(k,ixind) + enddo + + enddo + + ! Values to use above top_lev, for variables that have not already been + ! set up there. These are mostly fill values that should not actually be + ! used in the run, but may end up in diagnostic output. + upwp(i,:top_lev-1) = 0._r8 + vpwp(i,:top_lev-1) = 0._r8 + rcm(i,:top_lev-1) = 0._r8 + wprcp(i,:top_lev-1) = 0._r8 + cloud_frac(i,:top_lev-1) = 0._r8 + rcm_in_layer(i,:top_lev-1) = 0._r8 + zt_out(i,:top_lev-1) = 0._r8 + zi_out(i,:top_lev-1) = 0._r8 + khzm(i,:top_lev-1) = 0._r8 + qclvar(i,:top_lev-1) = 2._r8 + + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + edsclr_out(:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) + end if + enddo + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + + zi_out(i,1) = 0._r8 + + ! Section below is concentrated on energy fixing for conservation. + ! There are two steps to this process. The first is to remove any tendencies + ! CLUBB may have produced above where it is active due to roundoff. + ! The second is to provider a fixer because CLUBB and CAM's thermodynamic + ! variables are different. + + ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from + ! firing up in the stratosphere + clubbtop = troplev(i) + do while ((rtp2(i,clubbtop) .le. 1.e-15_r8 .and. rcm(i,clubbtop) .eq. 0._r8) .and. clubbtop .lt. pver-1) + clubbtop = clubbtop + 1 + enddo + + ! Compute static energy using CLUBB's variables + do k=1,pver + clubb_s(k) = cpair*((thlm(i,k)+(latvap/cpair)*rcm(i,k))/exner_clubb(i,k))+ & + gravit*state1%zm(i,k)+state1%phis(i) + enddo + + ! Compute integrals above layer where CLUBB is active + se_upper_a = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called + se_upper_b = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called + tw_upper_a = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called + tw_upper_b = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called + do k=1,clubbtop + se_upper_a = se_upper_a + (clubb_s(k)+0.5_r8*(um(i,k)**2+vm(i,k)**2)+(latvap+latice)* & + (rtm(i,k)-rcm(i,k))+(latice)*rcm(i,k))*state1%pdel(i,k)/gravit + se_upper_b = se_upper_b + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)+(latvap+latice)* & + state1%q(i,k,ixq)+(latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + tw_upper_a = tw_upper_a + rtm(i,k)*state1%pdel(i,k)/gravit + tw_upper_b = tw_upper_b + (state1%q(i,k,ixq)+state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + enddo + + ! Compute the disbalance of total energy and water in upper levels, + ! divide by the thickness in the lower atmosphere where we will + ! evenly distribute this disbalance + se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) + tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) + + ! Perform a test to see if there will be any negative RTM errors + ! in the column. If so, apply the disbalance to the surface + apply_to_surface = .false. + if (tw_upper_diss .lt. 0._r8) then + do k=clubbtop+1,pver + rtm_test = (rtm(i,k) + tw_upper_diss*gravit) - rcm(i,k) + if (rtm_test .lt. 0._r8) then + apply_to_surface = .true. + endif + enddo + endif + + if (apply_to_surface) then + tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) + se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) + rtm(i,pver) = rtm(i,pver) + tw_upper_diss*gravit + if (apply_to_heat) clubb_s(pver) = clubb_s(pver) + se_upper_diss*gravit + else + ! Apply the disbalances above to layers where CLUBB is active + do k=clubbtop+1,pver + rtm(i,k) = rtm(i,k) + tw_upper_diss*gravit + if (apply_to_heat) clubb_s(k) = clubb_s(k) + se_upper_diss*gravit + enddo + endif + + ! Essentially "zero" out tendencies in the layers above where CLUBB is active + do k=1,clubbtop + if (apply_to_heat) clubb_s(k) = state1%s(i,k) + rcm(i,k) = state1%q(i,k,ixcldliq) + rtm(i,k) = state1%q(i,k,ixq) + rcm(i,k) + enddo + + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. + se_a = 0._r8 + ke_a = 0._r8 + wv_a = 0._r8 + wl_a = 0._r8 + + ! Do the same as above, but for before CLUBB was called. + se_b = 0._r8 + ke_b = 0._r8 + wv_b = 0._r8 + wl_b = 0._r8 + do k=1,pver + se_a(i) = se_a(i) + clubb_s(k)*state1%pdel(i,k)/gravit + ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit + wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit + wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit + + se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit + ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit + wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit + wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + enddo + + ! Based on these integrals, compute the total energy before and after CLUBB call + te_a(i) = se_a(i) + ke_a(i) + (latvap+latice)*wv_a(i)+latice*wl_a(i) + te_b(i) = se_b(i) + ke_b(i) + (latvap+latice)*wv_b(i)+latice*wl_b(i) + + ! Take into account the surface fluxes of heat and moisture + ! Use correct qflux from cam_in, not lhf/latvap as was done previously + te_b(i) = te_b(i)+(cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice))*hdtime + + ! Compute the disbalance of total energy, over depth where CLUBB is active + se_dis = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) + + ! Fix the total energy coming out of CLUBB so it achieves enery conservation. + ! Apply this fixer throughout the column evenly, but only at layers where + ! CLUBB is active. + do k=clubbtop+1,pver + clubb_s(k) = clubb_s(k) - se_dis*gravit + enddo + + ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point + ! for all variables and therefore is never called in this loop + do k=1,pver + + ptend_loc%u(i,k) = (um(i,k)-state1%u(i,k))/hdtime ! east-west wind + ptend_loc%v(i,k) = (vm(i,k)-state1%v(i,k))/hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm(i,k)-rcm(i,k)-state1%q(i,k,ixq))/hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm(i,k)-state1%q(i,k,ixcldliq))/hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(k)-state1%s(i,k))/hdtime ! Tendency of static energy + + if (clubb_do_adv) then + if (macmic_it .eq. cld_macmic_num_steps) then + + ! Here add a constant to moments which can be either positive or + ! negative. This is to prevent clipping when dynamics tries to + ! make all constituents positive + wp3(i,k) = wp3(i,k) + wp3_const + rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const + wpthlp(i,k) = wpthlp(i,k) + wpthlp_const + wprtp(i,k) = wprtp(i,k) + wprtp_const + + ptend_loc%q(i,k,ixthlp2)=(thlp2(i,k)-state1%q(i,k,ixthlp2))/hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2)=(rtp2(i,k)-state1%q(i,k,ixrtp2))/hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp)=(rtpthlp(i,k)-state1%q(i,k,ixrtpthlp))/hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp)=(wpthlp(i,k)-state1%q(i,k,ixwpthlp))/hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp)=(wprtp(i,k)-state1%q(i,k,ixwprtp))/hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2)=(wp2(i,k)-state1%q(i,k,ixwp2))/hdtime ! WP2 + ptend_loc%q(i,k,ixwp3)=(wp3(i,k)-state1%q(i,k,ixwp3))/hdtime ! WP3 + ptend_loc%q(i,k,ixup2)=(up2(i,k)-state1%q(i,k,ixup2))/hdtime ! UP2 + ptend_loc%q(i,k,ixvp2)=(vp2(i,k)-state1%q(i,k,ixvp2))/hdtime ! VP2 + else + ptend_loc%q(i,k,ixthlp2)=0._r8 + ptend_loc%q(i,k,ixrtp2)=0._r8 + ptend_loc%q(i,k,ixrtpthlp)=0._r8 + ptend_loc%q(i,k,ixwpthlp)=0._r8 + ptend_loc%q(i,k,ixwprtp)=0._r8 + ptend_loc%q(i,k,ixwp2)=0._r8 + ptend_loc%q(i,k,ixwp3)=0._r8 + ptend_loc%q(i,k,ixup2)=0._r8 + ptend_loc%q(i,k,ixvp2)=0._r8 + endif + + endif + + ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. + ! Loading up this array doesn't mean the tendencies are applied. + ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& + (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& + (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& + (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& + (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then + ptend_loc%q(i,k,ixind) = (edsclr_out(k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + end if + end if + enddo + + enddo + + + enddo ! end column loop + + call outfld('KVH_CLUBB', khzm, pcols, lchnk) + + ! Add constant to ghost point so that output is not corrupted + if (clubb_do_adv) then + if (macmic_it .eq. cld_macmic_num_steps) then + wp3(:,pverp) = wp3(:,pverp) + wp3_const + rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const + wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const + wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const + endif + endif + + cmeliq(:,:) = ptend_loc%q(:,:,ixcldliq) + + ! ------------------------------------------------- ! + ! End column computation of CLUBB, begin to apply ! + ! and compute output, etc ! + ! ------------------------------------------------- ! + + ! Output CLUBB tendencies + call outfld( 'RVMTEND_CLUBB', ptend_loc%q(:,:,ixq), pcols, lchnk) + call outfld( 'RCMTEND_CLUBB', ptend_loc%q(:,:,ixcldliq), pcols, lchnk) + call outfld( 'RIMTEND_CLUBB', ptend_loc%q(:,:,ixcldice), pcols, lchnk) + call outfld( 'STEND_CLUBB', ptend_loc%s,pcols, lchnk) + call outfld( 'UTEND_CLUBB', ptend_loc%u,pcols, lchnk) + call outfld( 'VTEND_CLUBB', ptend_loc%v,pcols, lchnk) + + call outfld( 'CMELIQ', cmeliq, pcols, lchnk) + + ! Update physics tendencies + call physics_ptend_sum(ptend_loc,ptend_all,ncol) + call physics_update(state1,ptend_loc,hdtime) + + ! Due to the order of operation of CLUBB, which closes on liquid first, + ! then advances it's predictive equations second, this can lead to + ! RHliq > 1 directly before microphysics is called. Therefore, we use + ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. + + if (clubb_do_liqsupersat) then + + ! -------------------------------------- ! + ! Ice Saturation Adjustment Computation ! + ! -------------------------------------- ! + + latsub = latvap + latice + + lq2(:) = .FALSE. + lq2(ixq) = .TRUE. + lq2(ixcldliq) = .TRUE. + lq2(ixnumliq) = .TRUE. + + call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) + + stend(:ncol,:)=0._r8 + qvtend(:ncol,:)=0._r8 + qctend(:ncol,:)=0._r8 + inctend(:ncol,:)=0._r8 + + call liquid_macro_tend(npccn(:ncol,top_lev:pver),state1%t(:ncol,top_lev:pver), & + state1%pmid(:ncol,top_lev:pver),state1%q(:ncol,top_lev:pver,ixq),state1%q(:ncol,top_lev:pver,ixcldliq),& + state1%q(:ncol,top_lev:pver,ixnumliq),latvap,hdtime,& + stend(:ncol,top_lev:pver),qvtend(:ncol,top_lev:pver),qctend(:ncol,top_lev:pver),& + inctend(:ncol,top_lev:pver)) + + ! update local copy of state with the tendencies + ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver) + ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) + + ! Add the ice tendency to the output tendency + call physics_ptend_sum(ptend_loc, ptend_all, ncol) + + ! ptend_loc is reset to zero by this call + call physics_update(state1, ptend_loc, hdtime) + + ! Write output for tendencies: + ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE + call outfld( 'TTENDICE', stend/cpair, pcols, lchnk ) + call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) + call outfld( 'QCTENDICE', qctend, pcols, lchnk ) + call outfld( 'NCTENDICE', inctend, pcols, lchnk ) + + where(qctend .ne. 0._r8) + fqtend = 1._r8 + elsewhere + fqtend = 0._r8 + end where + + call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) + end if + + ! ------------------------------------------------------------ ! + ! ------------------------------------------------------------ ! + ! ------------------------------------------------------------ ! + ! The rest of the code deals with diagnosing variables ! + ! for microphysics/radiation computation and macrophysics ! + ! ------------------------------------------------------------ ! + ! ------------------------------------------------------------ ! + ! ------------------------------------------------------------ ! + + + ! --------------------------------------------------------------------------------- ! + ! COMPUTE THE ICE CLOUD DETRAINMENT ! + ! Detrainment of convective condensate into the environment or stratiform cloud ! + ! --------------------------------------------------------------------------------- ! + + ! Initialize the shallow convective detrainment rate, will always be zero + dlf2(:,:) = 0.0_r8 + + lqice(:) = .false. + lqice(ixcldliq) = .true. + lqice(ixcldice) = .true. + lqice(ixnumliq) = .true. + lqice(ixnumice) = .true. + + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) + + if (zmconv_microp) then + call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) + call pbuf_get_field(pbuf, difzm_idx, difzm) + call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) + call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) + end if + + do k=1,pver + do i=1,ncol + if( state1%t(i,k) > 268.15_r8 ) then + dum1 = 0.0_r8 + elseif ( state1%t(i,k) < 238.15_r8 ) then + dum1 = 1.0_r8 + else + dum1 = ( 268.15_r8 - state1%t(i,k) ) / 30._r8 + endif + + if (zmconv_microp) then + ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 + + ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & + / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection + ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice + else + + ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & + / (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * dum1 ) & + / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection + ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice + end if + + ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep + ! track of the integrals of ice and static energy that is effected from conversion to ice + ! so that the energy checker doesn't complain. + det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)/gravit + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/gravit + + enddo + enddo + + det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water + + call outfld( 'DPDLFLIQ', ptend_loc%q(:,:,ixcldliq), pcols, lchnk) + call outfld( 'DPDLFICE', ptend_loc%q(:,:,ixcldice), pcols, lchnk) + + temp2dp(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair + call outfld( 'DPDLFT', temp2dp, pcols, lchnk) + + call physics_ptend_sum(ptend_loc,ptend_all,ncol) + call physics_update(state1,ptend_loc,hdtime) + + ! ------------------------------------------------- ! + ! Diagnose relative cloud water variance ! + ! ------------------------------------------------- ! + + if (deep_scheme .eq. 'CLUBB_SGS') then + relvarmax = 2.0_r8 + else + relvarmax = 10.0_r8 + endif + + relvar(:,:) = relvarmax ! default + + if (deep_scheme .ne. 'CLUBB_SGS') then + where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) & + relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver))) + endif + + ! ------------------------------------------------- ! + ! Optional Accretion enhancement factor ! + ! ------------------------------------------------- ! + + accre_enhan(:ncol,:pver) = 1._r8 + + ! ------------------------------------------------- ! + ! Diagnose some output variables ! + ! ------------------------------------------------- ! + + ! density + rho(:ncol,1:pver) = state1%pmid(:ncol,1:pver)/(rair*state1%t(:ncol,1:pver)) + rho(:ncol,pverp) = state1%ps(:ncol)/(rair*state1%t(:ncol,pver)) + + eps = rair/rh2o + wpthvp(:,:) = 0.0_r8 + do k=1,pver + do i=1,ncol + ! buoyancy flux + wpthvp(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* & + (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpair)* & + state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k) + + ! total water mixing ratio + qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice) + ! liquid water potential temperature + thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpair)*state1%q(i,k,ixcldliq) + ! liquid water static energy + sl_output(i,k) = cpair*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) + enddo + enddo + + do k=1,pverp + do i=1,ncol + wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux + wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output + wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output + tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! Diagnose some quantities that are computed in macrop_tend here. ! + ! These are inputs required for the microphysics calculation. ! + ! ! + ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + ! initialize variables + alst(:,:) = 0.0_r8 + qlst(:,:) = 0.0_r8 + + do k=1,pver + do i=1,ncol + alst(i,k) = cloud_frac(i,k) + qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + deepcu(:,pver) = 0.0_r8 + shalcu(:,pver) = 0.0_r8 + + do k=1,pver-1 + do i=1,ncol + ! diagnose the deep convective cloud fraction, as done in macrophysics based on the + ! deep convective mass flux, read in from pbuf. Since shallow convection is never + ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud + ! fraction is purely from deep convection scheme. + deepcu(i,k) = max(0.0_r8,min(0.1_r8*log(1.0_r8+500.0_r8*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) + shalcu(i,k) = 0._r8 + + if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then + deepcu(i,k) = 0._r8 + endif + + ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable + ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation + ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud + ! from CLUBB plus the deep convective cloud fraction + concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) + enddo + enddo + + if (single_column) then + if (trim(scm_clubb_iop_name) .eq. 'ATEX_48hr' .or. & + trim(scm_clubb_iop_name) .eq. 'BOMEX_5day' .or. & + trim(scm_clubb_iop_name) .eq. 'DYCOMSrf01_4day' .or. & + trim(scm_clubb_iop_name) .eq. 'DYCOMSrf02_06hr' .or. & + trim(scm_clubb_iop_name) .eq. 'RICO_3day' .or. & + trim(scm_clubb_iop_name) .eq. 'ARM_CC') then + + deepcu(:,:) = 0.0_r8 + concld(:,:) = 0.0_r8 + + endif + endif + + ! --------------------------------------------------------------------------------- ! + ! COMPUTE THE ICE CLOUD FRACTION PORTION ! + ! use the aist_vector function to compute the ice cloud fraction ! + ! --------------------------------------------------------------------------------- ! + + aist(:,:top_lev-1) = 0._r8 + qsatfac(:, :top_lev-1) = 0._r8 + + do k = top_lev, pver + + ! For Type II PSC and for thin cirrus, the clouds can be thin, but + ! extensive and they should start forming when the gridbox mean saturation + ! reaches 1.0. + ! + ! For now, use the tropopause diagnostic to determine where the Type II + ! PSC should be, but in the future wold like a better metric that can also + ! identify the level for thin cirrus. Include the tropopause level so that + ! the cold point tropopause will use the stratospheric values. + where (k <= troplev) + rhmini = rhminis_const + rhmaxi = rhmaxis_const + elsewhere + rhmini = rhmini_const + rhmaxi = rhmaxi_const + end where + + call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & + state1%q(:,k,ixnumice),cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& + qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) + enddo + + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION ! + ! ! + ! For now leave the computation of ice stratus fraction from macrop_driver intact ! + ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus ! + ! fraction that was coded in macrop_driver ! + ! --------------------------------------------------------------------------------- ! + + ! Recompute net stratus fraction using maximum over-lapping assumption, as done + ! in macrophysics code, using alst computed above and aist read in from physics buffer + + do k=1,pver + do i=1,ncol + + ast(i,k) = max(alst(i,k),aist(i,k)) + + qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) + enddo + enddo + + ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just + ! be outputting the shallow convective cloud fraction + + do k=1,pver + do i=1,ncol + cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! DIAGNOSE THE PBL DEPTH ! + ! this is needed for aerosol code ! + ! --------------------------------------------------------------------------------- ! + + do i=1,ncol + do k=1,pver + th(i,k) = state1%t(i,k)*state1%exner(i,k) + thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq)) + enddo + enddo + + ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) + call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & + rrho(1:ncol), ustar2(1:ncol)) + ! use correct qflux from coupler + call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%cflx(1:ncol,1), cam_in%shf(1:ncol), & + rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), & + obklen(1:ncol)) + + dummy2(:) = 0._r8 + dummy3(:) = 0._r8 + + where (kbfs(:ncol) .eq. -0.0_r8) kbfs(:ncol) = 0.0_r8 + + ! Compute PBL depth according to Holtslag-Boville Scheme + call pblintd(ncol, thv, state1%zm, state1%u, state1%v, & + ustar2, obklen, kbfs, pblh, dummy2, & + state1%zi, cloud_frac(:,1:pver), 1._r8-cam_in%landfrac, dummy3) + + ! Output the PBL depth + call outfld('PBLH', pblh, pcols, lchnk) + + ! Assign the first pver levels of cloud_frac back to cld + cld(:,1:pver) = cloud_frac(:,1:pver) + + ! --------------------------------------------------------------------------------- ! + ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! + ! --------------------------------------------------------------------------------- ! + + ! Output calls of variables goes here + call outfld( 'RELVAR', relvar, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho, pcols, lchnk ) + call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) + call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) + call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) + call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) + call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) + call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) + + temp2dp(:ncol,:) = rtp2(:ncol,:)*1000._r8 + call outfld( 'RTP2_CLUBB', temp2dp, pcols, lchnk ) + + call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) + + rtpthlp_output(:ncol,:) = rtpthlp_output(:ncol,:) * 1000._r8 + call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) + + temp2dp(:ncol,:) = rcm(:ncol,:) * 1000._r8 + call outfld( 'RCM_CLUBB', temp2dp, pcols, lchnk ) + + temp2dp(:ncol,:) = wprcp(:ncol,:) * latvap + call outfld( 'WPRCP_CLUBB', temp2dp, pcols, lchnk ) + + temp2dp(:ncol,:) = rcm_in_layer(:ncol,:) * 1000._r8 + call outfld( 'RCMINLAYER_CLUBB', temp2dp, pcols, lchnk ) + + temp2dp(:ncol,:) = wpthvp(:ncol,:) * cpair + call outfld( 'WPTHVP_CLUBB', temp2dp, pcols, lchnk ) + + call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk ) + call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) + call outfld( 'UM_CLUBB', um, pcols, lchnk ) + call outfld( 'VM_CLUBB', vm, pcols, lchnk ) + call outfld( 'THETAL', thetal_output, pcols, lchnk ) + call outfld( 'QT', qt_output, pcols, lchnk ) + call outfld( 'SL', sl_output, pcols, lchnk ) + call outfld( 'CONCLD', concld, pcols, lchnk ) + call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) + call outfld( 'QSATFAC', qsatfac, pcols, lchnk) + + ! Output CLUBB history here + if (l_stats) then + + do i=1,stats_zt%num_output_fields + + temp1 = trim(stats_zt%file%var(i)%name) + sub = temp1 + if (len(temp1) .gt. 16) sub = temp1(1:16) + + call outfld(trim(sub), out_zt(:,:,i), pcols, lchnk ) + enddo + + do i=1,stats_zm%num_output_fields + + temp1 = trim(stats_zm%file%var(i)%name) + sub = temp1 + if (len(temp1) .gt. 16) sub = temp1(1:16) + + call outfld(trim(sub),out_zm(:,:,i), pcols, lchnk) + enddo + + if (l_output_rad_files) then + do i=1,stats_rad_zt%num_output_fields + call outfld(trim(stats_rad_zt%file%var(i)%name), out_radzt(:,:,i), pcols, lchnk) + enddo + + do i=1,stats_rad_zm%num_output_fields + call outfld(trim(stats_rad_zm%file%var(i)%name), out_radzm(:,:,i), pcols, lchnk) + enddo + endif + + do i=1,stats_sfc%num_output_fields + call outfld(trim(stats_sfc%file%var(i)%name), out_sfc(:,:,i), pcols, lchnk) + enddo + + endif + + return +#endif + end subroutine clubb_tend_cam + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + +#ifdef CLUBB_SGS +! ---------------------------------------------------------------------- +! +! DISCLAIMER : this code appears to be correct but has not been +! very thouroughly tested. If you do notice any +! anomalous behaviour then please contact Andy and/or +! Bjorn +! +! Function diag_ustar: returns value of ustar using the below +! similarity functions and a specified buoyancy flux (bflx) given in +! kinematic units +! +! phi_m (zeta > 0) = (1 + am * zeta) +! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) +! +! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) +! +! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface +! Layer, in Workshop on Micormeteorology, pages 67-100. +! +! Code writen March, 1999 by Bjorn Stevens +! + +real(r8) function diag_ustar( z, bflx, wnd, z0 ) + +use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g + +implicit none + +real(r8), parameter :: am = 4.8_r8 ! " " " +real(r8), parameter :: bm = 19.3_r8 ! " " " + +real(r8), parameter :: grav = shr_const_g +real(r8), parameter :: vonk = shr_const_karman +real(r8), parameter :: pi = shr_const_pi + +real(r8), intent (in) :: z ! height where u locates +real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) +real(r8), intent (in) :: wnd ! wind speed at z +real(r8), intent (in) :: z0 ! momentum roughness height + + +integer :: iterate +real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar + +lnz = log( z / z0 ) +klnz = vonk/lnz +c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 ) + +ustar = wnd*klnz +if (abs(bflx) > 1.e-6_r8) then + do iterate=1,4 + + if (ustar > 1.e-6_r8) then + lmo = -ustar**3 / ( vonk * bflx ) + zeta = z/lmo + if (zeta > 0._r8) then + ustar = vonk*wnd /(lnz + am*zeta) + else + x = sqrt( sqrt( 1.0_r8 - bm*zeta ) ) + psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1 + ustar = wnd*vonk/(lnz - psi1) + end if + + endif + + end do +end if + + +diag_ustar = ustar + +return + + +end function diag_ustar +#endif + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + +#ifdef CLUBB_SGS + + subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & + nnzp, nnrad_zt,nnrad_zm, delt ) + ! + ! Description: Initializes the statistics saving functionality of + ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here + ! the traditional stats_init of CLUBB is not called, as it is not compatible + ! with CAM output. + + !----------------------------------------------------------------------- + + + use stats_variables, only: & + stats_zt, & ! Variables + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use stats_variables, only: & + stats_zm, & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + stats_rad_zt, & + stats_rad_zm, & + stats_sfc, & + l_stats, & + l_output_rad_files, & + stats_tsamp, & + stats_tout, & + l_stats_samp, & + l_stats_last, & + l_netcdf, & + l_grads + + use clubb_precision, only: time_precision ! + use stats_zm_module, only: nvarmax_zm, stats_init_zm ! + use stats_zt_module, only: nvarmax_zt, stats_init_zt ! + use stats_rad_zt_module, only: nvarmax_rad_zt, stats_init_rad_zt ! + use stats_rad_zm_module, only: nvarmax_rad_zm, stats_init_rad_zm ! + use stats_sfc_module, only: nvarmax_sfc, stats_init_sfc ! + use constants_clubb, only: fstderr, var_length ! + use cam_history, only: addfld, horiz_only + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character + + implicit none + + ! Input Variables + + logical, intent(in) :: l_stats_in ! Stats on? T/F + + real(kind=time_precision), intent(in) :: & + stats_tsamp_in, & ! Sampling interval [s] + stats_tout_in ! Output interval [s] + + integer, intent(in) :: nnzp ! Grid points in the vertical [count] + integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] + integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] + + real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] + + + ! Local Variables + + ! Namelist Variables + + character(len=*), parameter :: subr = 'stats_init_clubb' + + character(len=var_length), dimension(nvarmax_zt) :: clubb_vars_zt ! Variables on the thermodynamic levels + character(len=var_length), dimension(nvarmax_zm) :: clubb_vars_zm ! Variables on the momentum levels + character(len=var_length), dimension(nvarmax_rad_zt) :: clubb_vars_rad_zt ! Variables on the radiation levels + character(len=var_length), dimension(nvarmax_rad_zm) :: clubb_vars_rad_zm ! Variables on the radiation levels + character(len=var_length), dimension(nvarmax_sfc) :: clubb_vars_sfc ! Variables at the model surface + + namelist /clubb_stats_nl/ & + clubb_vars_zt, & + clubb_vars_zm, & + clubb_vars_rad_zt, & + clubb_vars_rad_zm, & + clubb_vars_sfc + + ! Local Variables + + logical :: l_error + + character(len=200) :: temp1, sub + + integer :: i, ntot, read_status + integer :: iunit, ierr + + ! Initialize + l_error = .false. + + ! Set stats_variables variables with inputs from calling subroutine + l_stats = l_stats_in + + stats_tsamp = stats_tsamp_in + stats_tout = stats_tout_in + + if ( .not. l_stats ) then + l_stats_samp = .false. + l_stats_last = .false. + return + end if + + ! Initialize namelist variables + + clubb_vars_zt = '' + clubb_vars_zm = '' + clubb_vars_rad_zt = '' + clubb_vars_rad_zm = '' + clubb_vars_sfc = '' + + ! Read variables to compute from the namelist + if (masterproc) then + iunit= getunit() + open(unit=iunit,file="atm_in",status='old') + call find_group_name(iunit, 'clubb_stats_nl', status=read_status) + if (read_status == 0) then + read(unit=iunit, nml=clubb_stats_nl, iostat=read_status) + if (read_status /= 0) then + call endrun('stats_init_clubb: error reading namelist') + end if + end if + close(unit=iunit) + call freeunit(iunit) + end if + + ! Broadcast namelist variables + call mpi_bcast(clubb_vars_zt, var_length*nvarmax_zt, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zt") + call mpi_bcast(clubb_vars_zm, var_length*nvarmax_zm, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zm") + call mpi_bcast(clubb_vars_rad_zt, var_length*nvarmax_rad_zt, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zt") + call mpi_bcast(clubb_vars_rad_zm, var_length*nvarmax_rad_zm, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zm") + call mpi_bcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_sfc") + + ! Hardcode these for use in CAM-CLUBB, don't want either + l_netcdf = .false. + l_grads = .false. + + ! Check sampling and output frequencies + + ! The model time step length, delt (which is dtmain), should multiply + ! evenly into the statistical sampling time step length, stats_tsamp. + if ( abs( stats_tsamp/delt - floor(stats_tsamp/delt) ) > 1.e-8_r8 ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & + 'delt (which is dtmain). Check the appropriate ', & + 'model.in file.' + write(fstderr,*) 'stats_tsamp = ', stats_tsamp + write(fstderr,*) 'delt = ', delt + endif + + ! Initialize zt (mass points) + + i = 1 + do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zt(i)) /= 0 .and. & + i <= nvarmax_zt ) + i = i + 1 + enddo + ntot = i - 1 + if ( ntot == nvarmax_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zt than allowed for by nvarmax_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & + "in the stats namelist, or change nvarmax_zt." + write(fstderr,*) "nvarmax_zt = ", nvarmax_zt + call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") + endif + + stats_zt%num_output_fields = ntot + stats_zt%kk = nnzp + + allocate( stats_zt%z( stats_zt%kk ) ) + + allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) + allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) + allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) + call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & + stats_zt%accum_num_samples, stats_zt%l_in_update ) + + allocate( stats_zt%file%var( stats_zt%num_output_fields ) ) + allocate( stats_zt%file%z( stats_zt%kk ) ) + + ! Allocate scratch space + + allocate( ztscr01(stats_zt%kk) ) + allocate( ztscr02(stats_zt%kk) ) + allocate( ztscr03(stats_zt%kk) ) + allocate( ztscr04(stats_zt%kk) ) + allocate( ztscr05(stats_zt%kk) ) + allocate( ztscr06(stats_zt%kk) ) + allocate( ztscr07(stats_zt%kk) ) + allocate( ztscr08(stats_zt%kk) ) + allocate( ztscr09(stats_zt%kk) ) + allocate( ztscr10(stats_zt%kk) ) + allocate( ztscr11(stats_zt%kk) ) + allocate( ztscr12(stats_zt%kk) ) + allocate( ztscr13(stats_zt%kk) ) + allocate( ztscr14(stats_zt%kk) ) + allocate( ztscr15(stats_zt%kk) ) + allocate( ztscr16(stats_zt%kk) ) + allocate( ztscr17(stats_zt%kk) ) + allocate( ztscr18(stats_zt%kk) ) + allocate( ztscr19(stats_zt%kk) ) + allocate( ztscr20(stats_zt%kk) ) + allocate( ztscr21(stats_zt%kk) ) + + ztscr01 = 0.0_r8 + ztscr02 = 0.0_r8 + ztscr03 = 0.0_r8 + ztscr04 = 0.0_r8 + ztscr05 = 0.0_r8 + ztscr06 = 0.0_r8 + ztscr07 = 0.0_r8 + ztscr08 = 0.0_r8 + ztscr09 = 0.0_r8 + ztscr10 = 0.0_r8 + ztscr11 = 0.0_r8 + ztscr12 = 0.0_r8 + ztscr13 = 0.0_r8 + ztscr14 = 0.0_r8 + ztscr15 = 0.0_r8 + ztscr16 = 0.0_r8 + ztscr17 = 0.0_r8 + ztscr18 = 0.0_r8 + ztscr19 = 0.0_r8 + ztscr20 = 0.0_r8 + ztscr21 = 0.0_r8 + + ! Default initialization for array indices for zt + + call stats_init_zt( clubb_vars_zt, l_error ) + + ! Initialize zm (momentum points) + + i = 1 + do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zm(i)) /= 0 .and. & + i <= nvarmax_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zm than allowed for by nvarmax_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & + "in the stats namelist, or change nvarmax_zm." + write(fstderr,*) "nvarmax_zm = ", nvarmax_zm + call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") + endif + + stats_zm%num_output_fields = ntot + stats_zm%kk = nnzp + + allocate( stats_zm%z( stats_zm%kk ) ) + + allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) + allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) + allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) + call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & + stats_zm%accum_num_samples, stats_zm%l_in_update ) + + allocate( stats_zm%file%var( stats_zm%num_output_fields ) ) + allocate( stats_zm%file%z( stats_zm%kk ) ) + + ! Allocate scratch space + + allocate( zmscr01(stats_zm%kk) ) + allocate( zmscr02(stats_zm%kk) ) + allocate( zmscr03(stats_zm%kk) ) + allocate( zmscr04(stats_zm%kk) ) + allocate( zmscr05(stats_zm%kk) ) + allocate( zmscr06(stats_zm%kk) ) + allocate( zmscr07(stats_zm%kk) ) + allocate( zmscr08(stats_zm%kk) ) + allocate( zmscr09(stats_zm%kk) ) + allocate( zmscr10(stats_zm%kk) ) + allocate( zmscr11(stats_zm%kk) ) + allocate( zmscr12(stats_zm%kk) ) + allocate( zmscr13(stats_zm%kk) ) + allocate( zmscr14(stats_zm%kk) ) + allocate( zmscr15(stats_zm%kk) ) + allocate( zmscr16(stats_zm%kk) ) + allocate( zmscr17(stats_zm%kk) ) + + zmscr01 = 0.0_r8 + zmscr02 = 0.0_r8 + zmscr03 = 0.0_r8 + zmscr04 = 0.0_r8 + zmscr05 = 0.0_r8 + zmscr06 = 0.0_r8 + zmscr07 = 0.0_r8 + zmscr08 = 0.0_r8 + zmscr09 = 0.0_r8 + zmscr10 = 0.0_r8 + zmscr11 = 0.0_r8 + zmscr12 = 0.0_r8 + zmscr13 = 0.0_r8 + zmscr14 = 0.0_r8 + zmscr15 = 0.0_r8 + zmscr16 = 0.0_r8 + zmscr17 = 0.0_r8 + + call stats_init_zm( clubb_vars_zm, l_error ) + + ! Initialize rad_zt (radiation points) + + if (l_output_rad_files) then + + i = 1 + do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & + i <= nvarmax_rad_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & + "in the stats namelist, or change nvarmax_rad_zt." + write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt + call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") + endif + + stats_rad_zt%num_output_fields = ntot + stats_rad_zt%kk = nnrad_zt + + allocate( stats_rad_zt%z( stats_rad_zt%kk ) ) + + allocate( stats_rad_zt%accum_field_values( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt%accum_num_samples( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt%l_in_update( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) + + call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & + stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) + + allocate( stats_rad_zt%file%var( stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) ) + + call stats_init_rad_zt( clubb_vars_rad_zt, l_error ) + + ! Initialize rad_zm (radiation points) + + i = 1 + do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & + i <= nvarmax_rad_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & + "in the stats namelist, or change nvarmax_rad_zm." + write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm + call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") + endif + + stats_rad_zm%num_output_fields = ntot + stats_rad_zm%kk = nnrad_zm + + allocate( stats_rad_zm%z( stats_rad_zm%kk ) ) + + allocate( stats_rad_zm%accum_field_values( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) + allocate( stats_rad_zm%accum_num_samples( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) + allocate( stats_rad_zm%l_in_update( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) + + call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & + stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) + + allocate( stats_rad_zm%file%var( stats_rad_zm%num_output_fields ) ) + allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) + + call stats_init_rad_zm( clubb_vars_rad_zm, l_error ) + end if ! l_output_rad_files + + + ! Initialize sfc (surface point) + + i = 1 + do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_sfc(i)) /= 0 .and. & + i <= nvarmax_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_sfc ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_sfc than allowed for by nvarmax_sfc." + write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & + "in the stats namelist, or change nvarmax_sfc." + write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc + call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") + endif + + stats_sfc%num_output_fields = ntot + stats_sfc%kk = 1 + + allocate( stats_sfc%z( stats_sfc%kk ) ) + + allocate( stats_sfc%accum_field_values( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) + allocate( stats_sfc%accum_num_samples( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) + allocate( stats_sfc%l_in_update( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) + + call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & + stats_sfc%accum_num_samples, stats_sfc%l_in_update ) + + allocate( stats_sfc%file%var( stats_sfc%num_output_fields ) ) + allocate( stats_sfc%file%z( stats_sfc%kk ) ) + + call stats_init_sfc( clubb_vars_sfc, l_error ) + + ! Check for errors + + if ( l_error ) then + call endrun ('stats_init: errors found') + endif + +! Now call add fields + do i = 1, stats_zt%num_output_fields + + temp1 = trim(stats_zt%file%var(i)%name) + sub = temp1 + if (len(temp1) .gt. 16) sub = temp1(1:16) + +!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zt%file%var(i)%units),trim(stats_zt%file%var(i)%description)) + enddo + + do i = 1, stats_zm%num_output_fields + + temp1 = trim(stats_zm%file%var(i)%name) + sub = temp1 + if (len(temp1) .gt. 16) sub = temp1(1:16) + +!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zm%file%var(i)%units),trim(stats_zm%file%var(i)%description)) + enddo + + if (l_output_rad_files) then +!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical + do i = 1, stats_rad_zt%num_output_fields + call addfld(trim(stats_rad_zt%file%var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zt%file%var(i)%units),trim(stats_rad_zt%file%var(i)%description)) + enddo + + do i = 1, stats_rad_zm%num_output_fields + call addfld(trim(stats_rad_zm%file%var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zm%file%var(i)%units),trim(stats_rad_zm%file%var(i)%description)) + enddo + endif + + do i = 1, stats_sfc%num_output_fields + call addfld(trim(stats_sfc%file%var(i)%name),horiz_only,& + 'A',trim(stats_sfc%file%var(i)%units),trim(stats_sfc%file%var(i)%description)) + enddo + + return + + + end subroutine stats_init_clubb + +#endif + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + + !----------------------------------------------------------------------- + subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out_sfc) + + ! Description: Called when the stats timestep has ended. This subroutine + ! is responsible for calling statistics to be written to the output + ! format. + !----------------------------------------------------------------------- + +#ifdef CLUBB_SGS + + use shr_infnan_mod, only: is_nan => shr_infnan_isnan + + use constants_clubb, only: & + fstderr ! Constant(s) + + use stats_variables, only: & + stats_zt, & ! Variable(s) + stats_zm, & + stats_rad_zt, & + stats_rad_zm, & + stats_sfc, & + l_stats_last, & + stats_tsamp, & + stats_tout, & + l_output_rad_files + + use error_code, only: & + clubb_at_least_debug_level ! Procedure(s) + + use cam_abortutils, only: endrun + + implicit none + + +#endif + + integer :: thecol + + real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,zt%nn) + real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,zt%nn) + real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,rad_zt%nn) + real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%nn) + real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%nn) + +#ifdef CLUBB_SGS + ! Local Variables + + integer :: i, k + logical :: l_error + + ! Check if it is time to write to file + + if ( .not. l_stats_last ) return + + ! Initialize + l_error = .false. + + ! Look for errors by checking the number of sampling points + ! for each variable in the zt statistics at each vertical level. + do i = 1, stats_zt%num_output_fields + do k = 1, stats_zt%kk + + if ( stats_zt%accum_num_samples(1,1,k,i) /= 0 .and. & + stats_zt%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(stats_zt%file%var(i)%name), ' in zt ', & + 'at k = ', k, & + '; stats_zt%accum_num_samples(',k,',',i,') = ', stats_zt%accum_num_samples(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Look for errors by checking the number of sampling points + ! for each variable in the zm statistics at each vertical level. + do i = 1, stats_zm%num_output_fields + do k = 1, stats_zm%kk + + if ( stats_zm%accum_num_samples(1,1,k,i) /= 0 .and. & + stats_zm%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(stats_zm%file%var(i)%name), ' in zm ', & + 'at k = ', k, & + '; stats_zm%accum_num_samples(',k,',',i,') = ', stats_zm%accum_num_samples(1,1,k,i) + endif + + endif + + enddo + enddo + + if (l_output_rad_files) then + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zt statistics at each vertical level. + do i = 1, stats_rad_zt%num_output_fields + do k = 1, stats_rad_zt%kk + + if ( stats_rad_zt%accum_num_samples(1,1,k,i) /= 0 .and. & + stats_rad_zt%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(stats_rad_zt%file%var(i)%name), ' in rad_zt ', & + 'at k = ', k, & + '; stats_rad_zt%accum_num_samples(',k,',',i,') = ', stats_rad_zt%accum_num_samples(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zm statistics at each vertical level. + do i = 1, stats_rad_zm%num_output_fields + do k = 1, stats_rad_zm%kk + + if ( stats_rad_zm%accum_num_samples(1,1,k,i) /= 0 .and. & + stats_rad_zm%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(stats_rad_zm%file%var(i)%name), ' in rad_zm ', & + 'at k = ', k, & + '; stats_rad_zm%accum_num_samples(',k,',',i,') = ', stats_rad_zm%accum_num_samples(1,1,k,i) + endif + + endif + + enddo + enddo + end if ! l_output_rad_files + + ! Look for errors by checking the number of sampling points + ! for each variable in the sfc statistics at each vertical level. + do i = 1, stats_sfc%num_output_fields + do k = 1, stats_sfc%kk + + if ( stats_sfc%accum_num_samples(1,1,k,i) /= 0 .and. & + stats_sfc%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(stats_sfc%file%var(i)%name), ' in sfc ', & + 'at k = ', k, & + '; stats_sfc%accum_num_samples(',k,',',i,') = ', stats_sfc%accum_num_samples(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Stop the run if errors are found. + if ( l_error ) then + write(fstderr,*) 'Possible statistical sampling error' + write(fstderr,*) 'For details, set debug_level to a value of at ', & + 'least 1 in the appropriate model.in file.' + call endrun ('stats_end_timestep: error(s) found') + endif + + ! Compute averages + call stats_avg( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, stats_zt%accum_num_samples ) + call stats_avg( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, stats_zm%accum_num_samples ) + if (l_output_rad_files) then + call stats_avg( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & + stats_rad_zt%accum_num_samples ) + call stats_avg( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & + stats_rad_zm%accum_num_samples ) + end if + call stats_avg( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, stats_sfc%accum_num_samples ) + + ! Here we are not outputting the data, rather reading the stats into + ! arrays which are conformable to CAM output. Also, the data is "flipped" + ! in the vertical level to be the same as CAM output. + do i = 1, stats_zt%num_output_fields + do k = 1, stats_zt%kk + out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i) + if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 + enddo + enddo + + do i = 1, stats_zm%num_output_fields + do k = 1, stats_zt%kk + out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) + if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 + enddo + enddo + + if (l_output_rad_files) then + do i = 1, stats_rad_zt%num_output_fields + do k = 1, stats_rad_zt%kk + out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) + if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 + enddo + enddo + + do i = 1, stats_rad_zm%num_output_fields + do k = 1, stats_rad_zm%kk + out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i) + if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 + enddo + enddo + + ! Fill in values above the CLUBB top. + out_zt(thecol,:top_lev-1,:) = 0.0_r8 + out_zm(thecol,:top_lev-1,:) = 0.0_r8 + out_radzt(thecol,:top_lev-1,:) = 0.0_r8 + out_radzm(thecol,:top_lev-1,:) = 0.0_r8 + + endif + + do i = 1, stats_sfc%num_output_fields + out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) + if(is_nan(out_sfc(thecol,1,i))) out_sfc(thecol,1,i) = 0.0_r8 + enddo + + ! Reset sample fields + call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & + stats_zt%accum_num_samples, stats_zt%l_in_update ) + call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & + stats_zm%accum_num_samples, stats_zm%l_in_update ) + if (l_output_rad_files) then + call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & + stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) + call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & + stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) + end if + call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & + stats_sfc%accum_num_samples, stats_sfc%l_in_update ) + + return + +#endif + + end subroutine stats_end_timestep_clubb + + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + +#ifdef CLUBB_SGS + + !----------------------------------------------------------------------- + subroutine stats_zero( kk, nn, x, n, l_in_update ) + + ! Description: + ! Initialize stats to zero + !----------------------------------------------------------------------- + + use clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + + implicit none + + ! Input + integer, intent(in) :: kk, nn + + ! Output + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n + logical, dimension(1,1,kk,nn), intent(out) :: l_in_update + + ! Zero out arrays + + if ( nn > 0 ) then + x(:,:,:,:) = 0.0_r8 + n(:,:,:,:) = 0 + l_in_update(:,:,:,:) = .false. + end if + + return + + end subroutine stats_zero + +#endif + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + +#ifdef CLUBB_SGS + !----------------------------------------------------------------------- + subroutine stats_avg( kk, nn, x, n ) + + ! Description: + ! Compute the average of stats fields + !----------------------------------------------------------------------- + use clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + implicit none + + ! Input + integer, intent(in) :: nn, kk + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: n + + ! Output + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: x + + ! Internal + + integer k,m + + ! Compute averages + + do m=1,nn + do k=1,kk + + if ( n(1,1,k,m) > 0 ) then + x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m) ) + end if + + end do + end do + + return + + end subroutine stats_avg + + subroutine grid_size(state, grid_dx, grid_dy) + ! Determine the size of the grid for each of the columns in state + + use phys_grid, only: get_area_p + use shr_const_mod, only: shr_const_pi + use physics_types, only: physics_state + + + type(physics_state), intent(in) :: state + real(r8), intent(out) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] + + real(r8), parameter :: earth_ellipsoid1 = 111132.92_r8 ! first coefficient, meters per degree longitude at equator + real(r8), parameter :: earth_ellipsoid2 = 559.82_r8 ! second expansion coefficient for WGS84 ellipsoid + real(r8), parameter :: earth_ellipsoid3 = 1.175_r8 ! third expansion coefficient for WGS84 ellipsoid + + real(r8) :: mpdeglat, column_area, degree + integer :: i + + ! determine the column area in radians + do i=1,state%ncol + column_area = get_area_p(state%lchnk,i) + degree = sqrt(column_area)*(180._r8/shr_const_pi) + + ! Now find meters per degree latitude + ! Below equation finds distance between two points on an ellipsoid, derived from expansion + ! taking into account ellipsoid using World Geodetic System (WGS84) reference + mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*state%lat(i)) + earth_ellipsoid3 * cos(4._r8*state%lat(i)) + grid_dx(i) = mpdeglat * degree + grid_dy(i) = grid_dx(i) ! Assume these are the same + enddo + + end subroutine grid_size + +#endif + +end module clubb_intr diff --git a/src/physics/cam/cmparray_mod.F90 b/src/physics/cam/cmparray_mod.F90 new file mode 100644 index 0000000000..d2b316be61 --- /dev/null +++ b/src/physics/cam/cmparray_mod.F90 @@ -0,0 +1,483 @@ +module cmparray_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + save + + public expdaynite, cmpdaynite + + interface CmpDayNite + module procedure CmpDayNite_1d_R + module procedure CmpDayNite_2d_R + module procedure CmpDayNite_3d_R + module procedure CmpDayNite_1d_R_Copy + module procedure CmpDayNite_2d_R_Copy + module procedure CmpDayNite_3d_R_Copy + module procedure CmpDayNite_1d_I + module procedure CmpDayNite_2d_I + module procedure CmpDayNite_3d_I + end interface ! CmpDayNite + + interface ExpDayNite + module procedure ExpDayNite_1d_R + module procedure ExpDayNite_2d_R + module procedure ExpDayNite_3d_R + module procedure ExpDayNite_1d_I + module procedure ExpDayNite_2d_I + module procedure ExpDayNite_3d_I + end interface ! ExpDayNite + + interface cmparray + module procedure cmparray_1d_R + module procedure cmparray_2d_R + module procedure cmparray_3d_R + end interface ! cmparray + + interface chksum + module procedure chksum_1d_R + module procedure chksum_2d_R + module procedure chksum_3d_R + module procedure chksum_1d_I + module procedure chksum_2d_I + module procedure chksum_3d_I + end interface ! chksum + + contains + + subroutine CmpDayNite_1d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1) :: Array + + call CmpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, 1, 1, 1, 1) + + return + end subroutine CmpDayNite_1d_R + + subroutine CmpDayNite_2d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1,il2:iu2) :: Array + + call CmpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2, 1, 1) + + return + end subroutine CmpDayNite_2d_R + + subroutine CmpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2,iu2, il3, iu3) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in) :: il3, iu3 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1,il2:iu2,il3:iu3) :: Array + + real(r8), dimension(il1:iu1) :: tmp + integer :: i, j, k + + + do k = il3, iu3 + do j = il2, iu2 + + tmp(1:Nnite) = Array(IdxNite(1:Nnite),j,k) + Array(il1:il1+Nday-1,j,k) = Array(IdxDay(1:Nday),j,k) + Array(il1+Nday:il1+Nday+Nnite-1,j,k) = tmp(1:Nnite) + + end do + end do + + return + end subroutine CmpDayNite_3d_R + + subroutine CmpDayNite_1d_R_Copy(InArray, OutArray, Nday, IdxDay, Nnite, IdxNite, il1, iu1) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(in), dimension(il1:iu1) :: InArray + real(r8), intent(out), dimension(il1:iu1) :: OutArray + + call CmpDayNite_3d_R_Copy(InArray, OutArray, Nday, IdxDay, Nnite, IdxNite, il1, iu1, 1, 1, 1, 1) + + return + end subroutine CmpDayNite_1d_R_Copy + + subroutine CmpDayNite_2d_R_Copy(InArray, OutArray, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(in), dimension(il1:iu1,il2:iu2) :: InArray + real(r8), intent(out), dimension(il1:iu1,il2:iu2) :: OutArray + + call CmpDayNite_3d_R_Copy(InArray, OutArray, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2, 1, 1) + + return + end subroutine CmpDayNite_2d_R_Copy + + subroutine CmpDayNite_3d_R_Copy(InArray, OutArray, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2,iu2, il3, iu3) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in) :: il3, iu3 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(in), dimension(il1:iu1,il2:iu2,il3:iu3) :: InArray + real(r8), intent(out), dimension(il1:iu1,il2:iu2,il3:iu3) :: OutArray + + integer :: i, j, k + + + do k = il3, iu3 + do j = il2, iu2 + + do i=il1,il1+Nday-1 + OutArray(i,j,k) = InArray(IdxDay(i-il1+1),j,k) + enddo + do i=il1+Nday,il1+Nday+Nnite-1 + OutArray(i,j,k) = InArray(IdxNite(i-(il1+Nday)+1),j,k) + enddo + + + end do + end do + + return + end subroutine CmpDayNite_3d_R_Copy + + subroutine CmpDayNite_1d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1) :: Array + + call CmpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, 1, 1, 1, 1) + + return + end subroutine CmpDayNite_1d_I + + subroutine CmpDayNite_2d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1,il2:iu2) :: Array + + call CmpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2, 1, 1) + + return + end subroutine CmpDayNite_2d_I + + subroutine CmpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2,iu2, il3, iu3) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in) :: il3, iu3 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1,il2:iu2,il3:iu3) :: Array + + integer, dimension(il1:iu1) :: tmp + integer :: i, j, k + + + do k = il3, iu3 + do j = il2, iu2 + + tmp(1:Nnite) = Array(IdxNite(1:Nnite),j,k) + Array(il1:il1+Nday-1,j,k) = Array(IdxDay(1:Nday),j,k) + Array(il1+Nday:il1+Nday+Nnite-1,j,k) = tmp(1:Nnite) + + end do + end do + + return + end subroutine CmpDayNite_3d_I + + subroutine ExpDayNite_1d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1) :: Array + + call ExpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, 1, 1, 1, 1) + + return + end subroutine ExpDayNite_1d_R + + subroutine ExpDayNite_2d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1,il2:iu2) :: Array + + call ExpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2, 1, 1) + + return + end subroutine ExpDayNite_2d_R + + subroutine ExpDayNite_3d_R(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2,iu2, il3, iu3) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in) :: il3, iu3 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + real(r8), intent(inout), dimension(il1:iu1,il2:iu2,il3:iu3) :: Array + + real(r8), dimension(il1:iu1) :: tmp + integer :: i, j, k + + + do k = il3, iu3 + do j = il2, iu2 + + tmp(1:Nday) = Array(1:Nday,j,k) + Array(IdxNite(1:Nnite),j,k) = Array(il1+Nday:il1+Nday+Nnite-1,j,k) + Array(IdxDay(1:Nday),j,k) = tmp(1:Nday) + + end do + end do + + return + end subroutine ExpDayNite_3d_R + + subroutine ExpDayNite_1d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1) :: Array + + call ExpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, 1, 1, 1, 1) + + return + end subroutine ExpDayNite_1d_I + + subroutine ExpDayNite_2d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1,il2:iu2) :: Array + + call ExpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2, iu2, 1, 1) + + return + end subroutine ExpDayNite_2d_I + + subroutine ExpDayNite_3d_I(Array, Nday, IdxDay, Nnite, IdxNite, il1, iu1, il2,iu2, il3, iu3) + integer, intent(in) :: Nday, Nnite + integer, intent(in) :: il1, iu1 + integer, intent(in) :: il2, iu2 + integer, intent(in) :: il3, iu3 + integer, intent(in), dimension(Nday) :: IdxDay + integer, intent(in), dimension(Nnite) :: IdxNite + integer, intent(inout), dimension(il1:iu1,il2:iu2,il3:iu3) :: Array + + integer, dimension(il1:iu1) :: tmp + integer :: i, j, k + + + do k = il3, iu3 + do j = il2, iu2 + + tmp(1:Nday) = Array(1:Nday,j,k) + Array(IdxNite(1:Nnite),j,k) = Array(il1+Nday:il1+Nday+Nnite-1,j,k) + Array(IdxDay(1:Nday),j,k) = tmp(1:Nday) + + end do + end do + + return + end subroutine ExpDayNite_3d_I + +!******************************************************************************! +! ! +! DEBUG ! +! ! +!******************************************************************************! + + subroutine cmparray_1d_R(name, Ref, New, id1, is1, ie1) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + real(r8), intent(in), dimension(id1) :: Ref + real(r8), intent(in), dimension(id1) :: New + + call cmparray_3d_R(name, Ref, New, id1, is1, ie1, 1, 1, 1, 1, 1, 1) + end subroutine cmparray_1d_R + + subroutine cmparray_2d_R(name, Ref, New, id1, is1, ie1, id2, is2, ie2) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + real(r8), intent(in), dimension(id1, id2) :: Ref + real(r8), intent(in), dimension(id1, id2) :: New + + call cmparray_3d_R(name, Ref, New, id1, is1, ie1, id2, is2, ie2, 1, 1, 1) + end subroutine cmparray_2d_R + + subroutine cmparray_3d_R(name, Ref, New, id1, is1, ie1, id2, is2, ie2, id3, is3, ie3) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + integer, intent(in) :: id3, is3, ie3 + real(r8), intent(in), dimension(id1, id2, id3) :: Ref + real(r8), intent(in), dimension(id1, id2, id3) :: New + + integer :: i, j, k + integer :: nerr + logical :: found + real(r8):: rdiff + real(r8), parameter :: rtol = 1.0e-13_r8 + + nerr = 0 + + do k = is3, ie3 + do j = is2, ie2 + + found = .false. + do i = is1, ie1 + rdiff = abs(New(i,j,k)-Ref(i,j,k)) + rdiff = rdiff / merge(abs(Ref(i,j,k)), 1.0_r8, Ref(i,j,k) /= 0.0_r8) + if ( rdiff > rtol ) then + found = .true. + exit + end if + end do + + if ( found ) then + do i = is1, ie1 + rdiff = abs(New(i,j,k)-Ref(i,j,k)) + rdiff = rdiff / merge(abs(Ref(i,j,k)), 1.0_r8, Ref(i,j,k) /= 0.0_r8) + if ( rdiff > rtol ) then + print 666, name, i, j, k, Ref(i, j, k), New(i, j, k), rdiff + nerr = nerr + 1 + if ( nerr > 10 ) stop + end if + end do + end if + + end do + end do + + return +666 format('cmp3d: ', a10, 3(1x, i4), 3(1x, e20.14)) + + end subroutine cmparray_3d_R + + subroutine chksum_1d_R(name, Ref, id1, is1, ie1) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + real(r8), intent(in), dimension(id1) :: Ref + + call chksum_3d_R(name, Ref, id1, is1, ie1, 1, 1, 1, 1, 1, 1) + end subroutine chksum_1d_R + + subroutine chksum_1d_I(name, Ref, id1, is1, ie1) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in), dimension(id1) :: Ref + + call chksum_3d_I(name, Ref, id1, is1, ie1, 1, 1, 1, 1, 1, 1) + end subroutine chksum_1d_I + + subroutine chksum_2d_R(name, Ref, id1, is1, ie1, id2, is2, ie2) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + real(r8), intent(in), dimension(id1, id2) :: Ref + + call chksum_3d_R(name, Ref, id1, is1, ie1, id2, is2, ie2, 1, 1, 1) + end subroutine chksum_2d_R + + subroutine chksum_2d_I(name, Ref, id1, is1, ie1, id2, is2, ie2) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + integer, intent(in), dimension(id1, id2) :: Ref + + call chksum_3d_I(name, Ref, id1, is1, ie1, id2, is2, ie2, 1, 1, 1) + end subroutine chksum_2d_I + + subroutine chksum_3d_R(name, Ref, id1, is1, ie1, id2, is2, ie2, id3, is3, ie3) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + integer, intent(in) :: id3, is3, ie3 +!orig real(r8), intent(in), dimension(id1, id2, id3) :: Ref + real(r8), intent(in), dimension(is1:ie1, is2:ie2, is3:ie3) :: Ref + + real(r8) :: chksum + real(r8) :: rmin, rmax + integer :: i, j, k + integer :: imin, jmin, kmin + integer :: imax, jmax, kmax + + imin = is1 ; jmin = is2 ; kmin = is3 + imax = is1 ; jmax = is2 ; kmax = is3 + rmin = Ref(is1, is2, is3) ; rmax = rmin + + chksum = 0.0_r8 + + do k = is3, ie3 + do j = is2, ie2 + do i = is1, ie1 + chksum = chksum + abs(Ref(i,j,k)) + if ( Ref(i,j,k) < rmin ) then + rmin = Ref(i,j,k) + imin = i ; jmin = j ; kmin = k + end if + if ( Ref(i,j,k) > rmax ) then + rmax = Ref(i,j,k) + imax = i ; jmax = j ; kmax = k + end if + end do + end do + end do + + print 666, name, chksum, imin, jmin, kmin, imax, jmax, kmax +666 format('chksum: ', a8, 1x, e20.14, 6(1x, i4)) + + end subroutine chksum_3d_R + + subroutine chksum_3d_I(name, Ref, id1, is1, ie1, id2, is2, ie2, id3, is3, ie3) + character(*), intent(in) :: name + integer, intent(in) :: id1, is1, ie1 + integer, intent(in) :: id2, is2, ie2 + integer, intent(in) :: id3, is3, ie3 + integer, intent(in), dimension(id1, id2, id3) :: Ref + + integer :: i, j, k + integer :: chksum + chksum = 0 + + do k = is3, ie3 + do j = is2, ie2 + do i = is1, ie1 + chksum = chksum + abs(Ref(i,j,k)) + end do + end do + end do + + print 666, name, chksum +666 format('chksum: ', a8, 1x, i8) + + end subroutine chksum_3d_I + +end module cmparray_mod diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 new file mode 100644 index 0000000000..3779a6508a --- /dev/null +++ b/src/physics/cam/co2_cycle.F90 @@ -0,0 +1,340 @@ + +module co2_cycle + +!------------------------------------------------------------------------------------------------ + +! CO2 was used in radiation calculation. +! +! Purpose: +! Provides distributions of CO2_LND, CO2_OCN, CO2_FF, CO2 +! Read co2 flux from ocn and fossil fuel. +! Get co2 flux from lnd through coupler. +! +! Author: Jeff Lee +! +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use physconst, only: mwco2, cpair +use constituents, only: cnst_add, cnst_get_ind, cnst_name, cnst_longname, sflxnam +use chem_surfvals, only: chem_surfvals_get +use co2_data_flux +use cam_cpl_indices, only: index_x2a_Faoo_fco2_ocn +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +! Public interfaces +public co2_cycle_readnl ! read the namelist +public co2_register ! register consituents +public co2_transport ! turn on co2 tracers transport +public co2_implements_cnst ! returns true if consituent is implemented by this package +public co2_init_cnst ! initialize mixing ratios if not read from initial file +public co2_init ! initialize (history) variables +public co2_time_interp_ocn ! time interpolate co2 flux +public co2_time_interp_fuel ! time interpolate co2 flux + +! Public data + +public data_flux_ocn ! data read in for co2 flux from ocn +public data_flux_fuel ! data read in for co2 flux from fuel + +TYPE(read_interp) :: data_flux_ocn +TYPE(read_interp) :: data_flux_fuel + +public c_i ! global index for new constituents +public co2_readFlux_ocn ! read co2 flux from data file +public co2_readFlux_fuel ! read co2 flux from data file + + +! Namelist variables +logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable +logical :: co2_readFlux_ocn = .false. ! true => read co2 flux from ocn, namelist variable +logical :: co2_readFlux_fuel = .false. ! true => read co2 flux from fuel, namelist variable +character(len=256) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn +character(len=256) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel + +!----------------------------------------------------------------------- +! new constituents +integer, parameter :: ncnst=4 ! number of constituents implemented + +character(len=7), dimension(ncnst), parameter :: & ! constituent names + c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) + +real(r8), dimension(ncnst), parameter :: & ! molecular weights + c_mw = (/mwco2, mwco2, mwco2, mwco2/) + +real(r8), dimension(ncnst) :: c_cp ! heat capacities + +real(r8), dimension(ncnst), parameter :: & ! minimum mmr + c_qmin = (/1.e-20_r8, 1.e-20_r8, 1.e-20_r8, 1.e-20_r8/) + +integer, dimension(ncnst) :: c_i ! global index + +!================================================================================================ +contains +!================================================================================================ + +subroutine co2_cycle_readnl(nlfile) + + ! Read co2_cycle_nl namelist group. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, i + character(len=*), parameter :: subname = 'co2_cycle_readnl' + + namelist /co2_cycle_nl/ co2_flag, co2_readFlux_ocn, co2_readFlux_fuel, & + co2flux_ocn_file, co2flux_fuel_file + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'co2_cycle_nl', status=ierr) + if (ierr == 0) then + read(unitn, co2_cycle_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast (co2_flag, 1, mpilog, 0, mpicom) + call mpibcast (co2_readFlux_ocn, 1, mpilog, 0, mpicom) + call mpibcast (co2_readFlux_fuel, 1, mpilog, 0, mpicom) + call mpibcast (co2flux_ocn_file, len(co2flux_ocn_file), mpichar, 0, mpicom) + call mpibcast (co2flux_fuel_file, len(co2flux_fuel_file), mpichar, 0, mpicom) +#endif + + ! Consistency check + if (co2_readFlux_ocn .and. index_x2a_Faoo_fco2_ocn /= 0) then + write(iulog,*)'error co2_readFlux_ocn and index_x2a_Faoo_fco2_ocn cannot both be active' + call endrun(subname // ':: error co2_readFlux_ocn and index_x2a_Faoo_fco2_ocn cannot both be active') + end if + +end subroutine co2_cycle_readnl + +!================================================================================================ + +subroutine co2_register + +!----------------------------------------------------------------------- +! +! Purpose: register advected constituents +! +!----------------------------------------------------------------------- + integer :: i + + if (.not. co2_flag) return + + ! CO2 as dry tracer + c_cp = (/cpair, cpair, cpair, cpair/) + do i = 1, ncnst + call cnst_add(c_names(i), c_mw(i), c_cp(i), c_qmin(i), c_i(i), longname=c_names(i), mixtype='dry') + end do + +end subroutine co2_register + +!================================================================================================ + +function co2_transport() + +!----------------------------------------------------------------------- + +! Purpose: return true if this package is active + +!----------------------------------------------------------------------- + logical :: co2_transport +!----------------------------------------------------------------------- + + co2_transport = co2_flag + +end function co2_transport + +!================================================================================================ + +function co2_implements_cnst(name) + +!----------------------------------------------------------------------- +! +! Purpose: return true if specified constituent is implemented by this package +! +!----------------------------------------------------------------------- + implicit none +!-----------------------------Arguments--------------------------------- + + character(len=*), intent(in) :: name ! constituent name + logical :: co2_implements_cnst ! return value + + integer :: m + + co2_implements_cnst = .false. + + if (.not. co2_flag) return + + do m = 1, ncnst + if (name == c_names(m)) then + co2_implements_cnst = .true. + return + end if + end do + end function co2_implements_cnst + +!=============================================================================== +subroutine co2_init + +!----------------------------------------------------------------------- +! +! Purpose: initialize co2, +! declare history variables, +! read co2 flux form ocn, as data_flux_ocn +! read co2 flux form fule, as data_flux_fuel +! +!----------------------------------------------------------------------- + + use cam_history, only: addfld, add_default, horiz_only + + integer :: m, mm + + if (.not. co2_flag) return + + ! Add constituents and fluxes to history file + do m = 1, ncnst + call cnst_get_ind(c_names(m), mm) + + call addfld(trim(cnst_name(mm))//'_BOT', horiz_only, 'A', 'kg/kg', trim(cnst_longname(mm))//', Bottom Layer') + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm)) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux') + + call add_default(cnst_name(mm), 1, ' ') + call add_default(sflxnam(mm), 1, ' ') + + ! The addfld call for the 'TM*' fields are made by default in the + ! constituent_burden module. + call add_default('TM'//trim(cnst_name(mm)), 1, ' ') + end do + + ! Read flux data + if (co2_readFlux_ocn) then + call read_data_flux ( co2flux_ocn_file, data_flux_ocn ) + end if + + if (co2_readFlux_fuel) then + call read_data_flux ( co2flux_fuel_file, data_flux_fuel ) + end if + + end subroutine co2_init + +!========================================================================================== + + subroutine co2_time_interp_ocn + +!----------------------------------------------------------------------- +! +! Purpose: Time interpolate co2 flux to current time. +! Read in new monthly data if necessary +! +!----------------------------------------------------------------------- + + use time_manager, only: is_first_step + + if (.not. co2_flag) return + + if (co2_readFlux_ocn) then + if (is_first_step()) then + call interp_time_flux ( data_flux_ocn, prev_timestep=.true. ) + else + call interp_time_flux ( data_flux_ocn, prev_timestep=.false. ) + end if + endif + + end subroutine co2_time_interp_ocn + +!=========================================================================================== + + subroutine co2_time_interp_fuel + +!----------------------------------------------------------------------- +! +! Purpose: Time interpolate co2 flux to current time. +! Read in new monthly data if necessary +! +!----------------------------------------------------------------------- + + use time_manager, only: is_first_step + + if (.not. co2_flag) return + + if (co2_readFlux_fuel) then + if (is_first_step()) then + call interp_time_flux ( data_flux_fuel, prev_timestep=.true. ) + else + call interp_time_flux ( data_flux_fuel, prev_timestep=.false. ) + endif + endif + + end subroutine co2_time_interp_fuel + +!=========================================================================================== + +subroutine co2_init_cnst(name, latvals, lonvals, mask, q) + +!----------------------------------------------------------------------- +! +! Purpose: +! Set initial values of CO2_OCN, CO2_FFF, CO2_LND, CO2 +! Need to be called from process_inidat in inidat.F90 +! (or, initialize co2 in co2_timestep_init) +! +!----------------------------------------------------------------------- +! Arguments + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev +!----------------------------------------------------------------------- + integer :: k, nlev + + if (.not. co2_flag) return + + nlev = size(q, 2) + do k = 1, nlev + select case (name) + case ('CO2_OCN') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2_FFF') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2_LND') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + end select + end do + +end subroutine co2_init_cnst +!=============================================================================== + +end module co2_cycle diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 new file mode 100644 index 0000000000..af102a874a --- /dev/null +++ b/src/physics/cam/co2_data_flux.F90 @@ -0,0 +1,409 @@ + +module co2_data_flux + +!------------------------------------------------------------------------------------------------ +! for data reading and interpolation +!------------------------------------------------------------------------------------------------ + + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmd_utils, only : masterproc + use ppgrid, only : begchunk, endchunk, pcols + use phys_grid, only : scatter_field_to_chunk, get_ncols_p + use error_messages, only : alloc_err, handle_ncerr, handle_err + use cam_abortutils, only : endrun + use netcdf + use error_messages, only : handle_ncerr + use cam_logfile, only : iulog + use bnddyi_mod, only : bnddyi + +#if ( defined SPMD ) + use mpishorthand, only: mpicom, mpiint, mpir8 +#endif + + implicit none + +! public data + +! public type + + public read_interp + +! public interface + + public read_data_flux + public interp_time_flux + +! private data + + private +! integer, parameter :: totsz=2000 ! number greater than data time sample + real(r8), parameter :: daysperyear = 365.0_r8 ! Number of days in a year + integer :: lonsiz ! size of longitude dimension, dataset is 2d(lat,lon), in CAM grid + integer :: latsiz ! size of latitude dimension + +!-------------------------------------------------------------------------------------------------- +TYPE :: read_interp + + real(r8), pointer, dimension(:,:) :: co2flx + ! Interpolated output (pcols,begchunk:endchunk) + real(r8), pointer, dimension(:,:,:) :: co2bdy + ! bracketing data (pcols,begchunk:endchunk,2) + real(r8) :: cdayfm ! Calendar day for prv. month read in + real(r8) :: cdayfp ! Calendar day for nxt. month read in + integer :: nm_f ! Array indices for prv. month data + integer :: np_f ! Array indices for nxt. month data + integer :: np1_f ! current forward time index of dataset + integer :: timesz ! size of time dimension on dataset + integer, pointer :: date_f(:) ! Date on dataset (YYYYMMDD) + integer, pointer :: sec_f(:) ! seconds of date on dataset (0-86399) + character(len=256) :: locfn ! dataset name + integer :: ncid_f ! netcdf id for dataset + integer :: fluxid ! netcdf id for dataset flux + real(r8), pointer :: xvar(:,:,:) ! work space for dataset + +END TYPE read_interp +!------------------------------------------------------------------------------------------------- + +contains + +!=============================================================================== + +subroutine read_data_flux (input_file, xin) + +!------------------------------------------------------------------------------- +! Do initial read of time-varying 2d(lat,lon NetCDF dataset, +! reading two data bracketing current timestep +!------------------------------------------------------------------------------- + + use time_manager, only : get_curr_date, get_curr_calday, & + is_perpetual, get_perp_date, get_step_size, is_first_step + use ioFileMod, only : getfil + + implicit none + +!---------------------------Common blocks------------------------------- +! Dummy arguments + character(len=*), intent(in) :: input_file + TYPE(read_interp), intent(inout) :: xin + + integer lonid ! netcdf id for longitude variable + integer latid ! netcdf id for latitude variable + integer timeid ! netcdf id for time variable + integer dateid ! netcdf id for date variable + integer secid ! netcdf id for seconds variable + integer londimid ! netcdf id for longitude variable + integer latdimid ! netcdf id for latitude variable + + integer dtime ! timestep size [seconds] + integer cnt3(3) ! array of counts for each dimension + integer strt3(3) ! array of starting indices + integer n ! indices + integer j ! latitude index + integer istat ! error return + integer :: yr, mon, day ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + real(r8) calday ! calendar day (includes yr if no cycling) + real(r8) caldayloc ! calendar day (includes yr if no cycling) + + xin%nm_f = 1 + xin%np_f = 2 + +! Allocate space for data. + + allocate( xin%co2flx(pcols,begchunk:endchunk), stat=istat ) + call alloc_err( istat, 'CO2FLUX_READ', 'co2flx', & + pcols*(endchunk-begchunk+1) ) + + allocate( xin%co2bdy(pcols,begchunk:endchunk,2), stat=istat ) + call alloc_err( istat, 'CO2FLUX_READ', 'co2bdy', & + pcols*(endchunk-begchunk+1)*2 ) + +! SPMD: Master does all the work. + + if (masterproc) then +! +! Use year information only if not cycling sst dataset +! + if (is_first_step()) then + dtime = get_step_size() + dtime = -dtime + calday = get_curr_calday(offset=dtime) + else + calday = get_curr_calday() + endif + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + if (is_first_step()) then + call get_curr_date(yr, mon, day, ncsec,offset=dtime) + else + call get_curr_date(yr, mon, day, ncsec) + endif + end if + + ncdate = yr*10000 + mon*100 + day + + caldayloc = calday + yr*daysperyear + +! Open NetCDF File + + call getfil(input_file, xin%locfn) + call handle_ncerr( nf90_open(xin%locfn, 0, xin%ncid_f),& + 'co2_data_flux.F90:154') + write(iulog,*)'CO2FLUX_READ: NCOPN returns id ',xin%ncid_f,' for file ',trim(xin%locfn) + +! Get and check dimension info + + call handle_ncerr( nf90_inq_dimid( xin%ncid_f, 'lon', londimid ),& + 'co2_data_flux.F90:160') + call handle_ncerr( nf90_inq_dimid( xin%ncid_f, 'lat', latdimid ),& + 'co2_data_flux.F90:162') + call handle_ncerr( nf90_inq_dimid( xin%ncid_f, 'time', timeid ),& + 'co2_data_flux.F90:164') + + call handle_ncerr( nf90_inquire_dimension( xin%ncid_f, londimid, len=lonsiz ),& + 'co2_data_flux.F90:167') + call handle_ncerr( nf90_inquire_dimension( xin%ncid_f, latdimid, len=latsiz ),& + 'co2_data_flux.F90:169') + call handle_ncerr( nf90_inquire_dimension( xin%ncid_f, timeid, len=xin%timesz ),& + 'co2_data_flux.F90:171') + + allocate(xin%date_f(xin%timesz), xin%sec_f(xin%timesz)) +! Get data id + + call handle_ncerr( nf90_inq_varid( xin%ncid_f, 'date', dateid ),& + 'co2_data_flux.F90:192') + call handle_ncerr( nf90_inq_varid( xin%ncid_f, 'datesec', secid ),& + 'co2_data_flux.F90:194') + call handle_ncerr( nf90_inq_varid( xin%ncid_f, 'CO2_flux', xin%fluxid ),& + 'co2_data_flux.F90:196') + +! Retrieve entire date and sec variables. + + call handle_ncerr( nf90_get_var ( xin%ncid_f, dateid, xin%date_f ),& + 'co2_data_flux.F90:201') + call handle_ncerr( nf90_get_var ( xin%ncid_f, secid, xin%sec_f ),& + 'co2_data_flux.F90:203') + +! initialize + + strt3(1) = 1 + strt3(2) = 1 + strt3(3) = 1 + cnt3(1) = lonsiz + cnt3(2) = latsiz + cnt3(3) = 1 + + endif + +#ifdef SPMD + call mpibcast( cnt3, 2, mpiint, 0, mpicom ) +#endif + allocate(xin%xvar(cnt3(1),cnt3(2),2)) + if (masterproc) then +! Normal interpolation between consecutive time slices. + + do n=1,xin%timesz-1 + + xin%np1_f = n + 1 + + call bnddyi(xin%date_f(n ), xin%sec_f(n ), xin%cdayfm) + call bnddyi(xin%date_f(xin%np1_f), xin%sec_f(xin%np1_f), xin%cdayfp) + + yr = xin%date_f(n)/10000 + xin%cdayfm = xin%cdayfm + yr*daysperyear + + yr = xin%date_f(xin%np1_f)/10000 + xin%cdayfp = xin%cdayfp + yr*daysperyear + +! read 2 time sample bracketing ncdate + + if ( caldayloc > xin%cdayfm .and. caldayloc <= xin%cdayfp ) then + + strt3(3) = n + call handle_ncerr( nf90_get_var ( xin%ncid_f, xin%fluxid, xin%xvar(:,:,xin%nm_f), strt3, cnt3), & + 'co2_data_flux.F90:235') + strt3(3) = xin%np1_f + call handle_ncerr( nf90_get_var ( xin%ncid_f, xin%fluxid, xin%xvar(:,:,xin%np_f), strt3, cnt3),& + 'co2_data_flux.F90:238') + + goto 10 + + end if + + end do + + write(iulog,*)'CO2FLUX_READ: Failed to find dates bracketing ncdate, ncsec=', ncdate, ncsec + call endrun + +10 continue + write(iulog,*)'CO2FLUX_READ: Read ', trim(xin%locfn), ' for dates ', xin%date_f(n), xin%sec_f(n), & + ' and ', xin%date_f(xin%np1_f), xin%sec_f(xin%np1_f) + +#if (defined SPMD ) + call mpibcast( xin%timesz, 1, mpiint, 0, mpicom ) + call mpibcast( xin%date_f, xin%timesz, mpiint, 0, mpicom ) + call mpibcast( xin%sec_f, xin%timesz, mpiint, 0, mpicom ) + call mpibcast( xin%cdayfm, 1, mpir8 , 0, mpicom ) + call mpibcast( xin%cdayfp, 1, mpir8, 0, mpicom ) + call mpibcast( xin%np1_f, 1, mpiint, 0, mpicom ) + else + call mpibcast( xin%timesz, 1, mpiint, 0, mpicom ) + allocate(xin%date_f(xin%timesz), xin%sec_f(xin%timesz)) + call mpibcast( xin%date_f, xin%timesz, mpiint, 0, mpicom ) + call mpibcast( xin%sec_f, xin%timesz, mpiint, 0, mpicom ) + call mpibcast( xin%cdayfm, 1, mpir8 , 0, mpicom ) + call mpibcast( xin%cdayfp, 1, mpir8, 0, mpicom ) + call mpibcast( xin%np1_f, 1, mpiint, 0, mpicom ) +#endif + end if + + call scatter_field_to_chunk ( 1,1,2,cnt3(1), xin%xvar, xin%co2bdy ) + + return +end subroutine read_data_flux + +!=============================================================================== + +subroutine interp_time_flux (xin, prev_timestep) + +!----------------------------------------------------------------------- +! Time interpolate data to current time. +! Reading in new monthly data if necessary. +! +!----------------------------------------------------------------------- + + use time_manager, only : get_curr_date, get_curr_calday, & + is_perpetual, get_perp_date, get_step_size, is_first_step + use interpolate_data, only : get_timeinterp_factors + + logical, intent(in), optional :: prev_timestep ! If using previous timestep, set to true + TYPE(read_interp), intent(inout) :: xin + +!---------------------------Local variables----------------------------- + integer dtime ! timestep size [seconds] + integer cnt3(3) ! array of counts for each dimension + integer strt3(3) ! array of starting indices + integer i,j,lchnk ! indices + integer ncol ! number of columns in current chunk + integer ntmp ! temporary + real(r8) fact1, fact2 ! time interpolation factors + integer :: yr, mon, day! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + real(r8) :: calday ! current calendar day + real(r8) caldayloc ! calendar day (includes yr if no cycling) + real(r8) deltat ! time (days) between interpolating data + logical :: previous + logical :: co2cyc=.false. + +!----------------------------------------------------------------------- + +! SPMD: Master does all the work. Sends needed info to slaves + +! Use year information only if a multiyear dataset + + if ( .not. present(prev_timestep) ) then + previous = .false. + else + previous = prev_timestep + end if + + if (previous .and. is_first_step()) then + dtime = get_step_size() + dtime = -dtime + calday = get_curr_calday(offset=dtime) + else + calday = get_curr_calday() + endif + + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + if (previous .and. is_first_step()) then + call get_curr_date(yr, mon, day, ncsec,offset=dtime) + else + call get_curr_date(yr, mon, day, ncsec) + endif + end if + + ncdate = yr*10000 + mon*100 + day + + caldayloc = calday + yr*daysperyear + + if (masterproc) then + + strt3(1) = 1 + strt3(2) = 1 + strt3(3) = 1 + cnt3(1) = lonsiz + cnt3(2) = latsiz + cnt3(3) = 1 + + endif + +#ifdef SPMD + call mpibcast(cnt3, 2, mpiint, 0, mpicom) +#endif + +! If model time is past current forward data timeslice, read in the next +! timeslice for time interpolation. + + if ( caldayloc > xin%cdayfp .and. .not. (xin%np1_f==1 .and. caldayloc > xin%cdayfm) ) then + + xin%np1_f = xin%np1_f + 1 + + if ( xin%np1_f > xin%timesz ) then + call endrun ('CO2FLUX_INTERP: Attempt to read past end of dataset') + end if + + xin%cdayfm = xin%cdayfp + + call bnddyi( xin%date_f(xin%np1_f), xin%sec_f(xin%np1_f), xin%cdayfp ) + + yr = xin%date_f(xin%np1_f)/10000 + xin%cdayfp = xin%cdayfp + yr*daysperyear + + if ( .not. (xin%np1_f == 1 .or. caldayloc <= xin%cdayfp) ) then + + if (masterproc) then + write(iulog,*)'CO2FLUX_INTERP: Input data for date', xin%date_f(xin%np1_f), ' sec ', xin%sec_f(xin%np1_f), & + ' does not exceed model date', ncdate, ' sec ', ncsec, ' Stopping.' + end if + call endrun () + end if + + ntmp = xin%nm_f + xin%nm_f = xin%np_f + xin%np_f = ntmp + + if (masterproc) then + strt3(3) = xin%np1_f + call handle_ncerr( nf90_get_var ( xin%ncid_f, xin%fluxid, xin%xvar(:,:,xin%np_f), strt3, cnt3 ),& + 'co2_data_flux.F90:391') + write(iulog,*)'CO2FLUX_INTERP: Read ', trim(xin%locfn),' for date (yyyymmdd) ', xin%date_f(xin%np1_f), & + ' sec ', xin%sec_f(xin%np1_f) + endif + + call scatter_field_to_chunk ( 1,1,2,cnt3(1), xin%xvar, xin%co2bdy ) + end if + +! Determine time interpolation factors. + + call get_timeinterp_factors ( co2cyc, xin%np1_f, xin%cdayfm, xin%cdayfp, caldayloc, fact1, fact2, 'CO2FLUX_INTERP:' ) + + do lchnk=begchunk,endchunk + ncol = get_ncols_p(lchnk) + do i=1,ncol + xin%co2flx(i,lchnk) = xin%co2bdy(i,lchnk,xin%nm_f)*fact1 + xin%co2bdy(i,lchnk,xin%np_f)*fact2 + end do + end do + + return +end subroutine interp_time_flux + +!============================================================================================================ + +end module co2_data_flux + diff --git a/src/physics/cam/const_init.F90 b/src/physics/cam/const_init.F90 new file mode 100644 index 0000000000..b83f6aa883 --- /dev/null +++ b/src/physics/cam/const_init.F90 @@ -0,0 +1,223 @@ +module const_init + +! Initialize constituents to default values + +use shr_kind_mod, only: r8 => shr_kind_r8, max_chars=>shr_kind_cl +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public :: cnst_init_default + +interface cnst_init_default + module procedure cnst_init_default_col + module procedure cnst_init_default_cblock +end interface cnst_init_default + +!============================================================================== +CONTAINS +!============================================================================== + + subroutine cnst_init_default_col(m_cnst, latvals, lonvals, q, mask, & + verbose, notfound) + use constituents, only: cnst_name + use aoa_tracers, only: aoa_tracers_implements_cnst, aoa_tracers_init_cnst + use carma_intr, only: carma_implements_cnst, carma_init_cnst + use chemistry, only: chem_implements_cnst, chem_init_cnst + use clubb_intr, only: clubb_implements_cnst, clubb_init_cnst + use co2_cycle, only: co2_implements_cnst, co2_init_cnst + use microp_driver, only: microp_driver_implements_cnst, microp_driver_init_cnst + use rk_stratiform, only: rk_stratiform_implements_cnst, rk_stratiform_init_cnst + use tracers, only: tracers_implements_cnst, tracers_init_cnst + use unicon_cam, only: unicon_implements_cnst, unicon_init_cnst + + !----------------------------------------------------------------------- + ! + ! Purpose: initialize named tracer mixing ratio field + ! This subroutine should be called ONLY at the beginning of an initial run + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + integer, intent(in) :: m_cnst ! Constant index + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + real(r8), intent(out) :: q(:,:) ! mixing ratio (ncol, plev) + logical, optional, intent(in) :: mask(:) ! Only initialize where .true. + logical, optional, intent(in) :: verbose ! For internal use + logical, optional, intent(in) :: notfound ! Turn off initial dataset warn + + ! Local variables + logical, allocatable :: mask_use(:) + character(len=max_chars) :: name + logical :: verbose_use + logical :: notfound_use + + name = cnst_name(m_cnst) + + allocate(mask_use(size(latvals))) + if (present(mask)) then + if (size(mask_use) /= size(mask)) then + call endrun('cnst_init_default: input, mask, is wrong size') + end if + mask_use = mask + else + mask_use = .true. + end if + + if (present(verbose)) then + verbose_use = verbose + else + verbose_use = .true. + end if + + if (present(notfound)) then + notfound_use = notfound + else + notfound_use = .true. + end if + + q = 0.0_r8 ! Make sure we start fresh (insurance) + + if(masterproc .and. verbose_use .and. notfound_use) then + write(iulog, *) 'Field ',trim(trim(name)),' not found on initial dataset' + end if + + if (aoa_tracers_implements_cnst(trim(name))) then + call aoa_tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "aoa_tracers_init_cnst"' + end if + else if (carma_implements_cnst(trim(name))) then + call carma_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "carma_init_cnst"' + end if + else if (chem_implements_cnst(trim(name))) then + call chem_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "chem_init_cnst"' + end if + else if (clubb_implements_cnst(trim(name))) then + call clubb_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "clubb_init_cnst"' + end if + else if (co2_implements_cnst(trim(name))) then + call co2_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "co2_init_cnst"' + end if + else if (microp_driver_implements_cnst(trim(name))) then + call microp_driver_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "microp_driver_init_cnst"' + end if + else if (rk_stratiform_implements_cnst(trim(name))) then + call rk_stratiform_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "rk_stratiform_init_cnst"' + end if + else if (tracers_implements_cnst(trim(name))) then + call tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "tracers_init_cnst"' + end if + else if (unicon_implements_cnst(trim(name))) then + call unicon_init_cnst(trim(name), latvals, lonvals, mask_use, q) + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' initialized by "unicon_init_cnst"' + end if + else + if(masterproc .and. verbose_use) then + write(iulog,*) ' ', trim(name), ' set to minimum value' + end if + ! Q already set to zero + end if + + end subroutine cnst_init_default_col + + subroutine cnst_init_default_cblock(m_cnst, latvals, lonvals, q, mask) + + !----------------------------------------------------------------------- + ! + ! Purpose: initialize named tracer mixing ratio field + ! This subroutine should be called ONLY at the beginning of an initial run + ! + !----------------------------------------------------------------------- + + ! Dummy arguments + integer, intent(in) :: m_cnst ! Constant index + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol*blk) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol*blk) + real(r8), intent(out) :: q(:,:,:) ! mix ratio (ncol, plev, blk) + logical, optional, intent(in) :: mask(:) ! Only initialize where .true. + + ! Local variables + real(r8), allocatable :: latblk(:) + integer :: i, bbeg, bend + integer :: size1, size2, size3 + integer :: nblks, blksize + logical :: verbose + + verbose = .true. + size1 = size(q, 1) + size2 = size(q, 2) + size3 = size(q, 3) + if ((size(latvals) == size1*size3) .and. (size(lonvals) == size1*size3)) then + ! Case: unstructured with blocks in 3rd dim + nblks = size3 + blksize = size1 + bend = 0 + do i = 1, nblks + bbeg = bend + 1 + bend = bbeg + blksize - 1 + if (present(mask)) then + if (size(mask) /= size(latvals)) then + call endrun('cnst_init_default_cblock: incorrect mask size') + end if + call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), mask=mask(bbeg:bend), verbose=verbose) + else + call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), verbose=verbose) + end if + verbose = .false. + end do + else if ((size(latvals) == size2) .and. (size(lonvals) == size1)) then + ! Case: lon,lat,lev + if (present(mask)) then + call endrun('cnst_init_default_cblock: mask not supported for lon/lat') + else + nblks = size2 + allocate(latblk(size1)) + do i = 1, nblks + latblk(:) = latvals(i) + call cnst_init_default(m_cnst, latblk, lonvals, q(:,i,:), verbose=verbose) + verbose = .false. + end do + deallocate(latblk) + end if + else if ((size(latvals) == size3) .and. (size(lonvals) == size1)) then + ! Case: lon,lev,lat + if (present(mask)) then + call endrun('cnst_init_default_cblock: mask not supported for lon/lat') + else + nblks = size3 + allocate(latblk(size1)) + do i = 1, nblks + latblk(:) = latvals(i) + call cnst_init_default(m_cnst, latblk, lonvals, q(:,:,i), verbose=verbose) + verbose = .false. + end do + deallocate(latblk) + end if + else + call endrun('cnst_init_default_cblock: Unknown q layout') + end if + + end subroutine cnst_init_default_cblock + +end module const_init diff --git a/src/physics/cam/constituent_burden.F90 b/src/physics/cam/constituent_burden.F90 new file mode 100644 index 0000000000..bfa659f00f --- /dev/null +++ b/src/physics/cam/constituent_burden.F90 @@ -0,0 +1,88 @@ + +module constituent_burden + +!----------------------------------------------------------------------------------------- +! Purpose: subroutines to generate constituent burden history variables +! +! Revision history: +! 2005-12-21 K. Lindsay Original version +!----------------------------------------------------------------------------------------- + + use constituents, only: pcnst + + implicit none + +! Public interfaces + + public constituent_burden_init + public constituent_burden_comp + + private + + character(len=18) :: burdennam(pcnst) ! name of burden history variables + + save + +!========================================================================================= + +contains + +!========================================================================================= + +subroutine constituent_burden_init + + use cam_history, only: addfld, horiz_only + use constituents, only: cnst_name + + integer :: m + + do m = 2, pcnst + burdennam(m) = 'TM'//cnst_name(m) + call addfld (burdennam(m), horiz_only, 'A', 'kg/m2', & + trim(cnst_name(m)) // ' column burden') + end do + +end subroutine constituent_burden_init + +!========================================================================================= + +subroutine constituent_burden_comp(state) + + use physics_types, only: physics_state + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: cnst_type + use ppgrid, only: pcols + use physconst, only: rga + use cam_history, only: outfld, hist_fld_active + +!----------------------------------------------------------------------- +! +! Arguments +! + type(physics_state), intent(inout) :: state +! +!---------------------------Local workspace----------------------------- + + real(r8) :: ftem(pcols) ! temporary workspace + + integer :: m, lchnk, ncol + + lchnk = state%lchnk + ncol = state%ncol + + do m = 2, pcnst + if (.not. hist_fld_active(burdennam(m))) cycle + if (cnst_type(m) .eq. 'dry') then + ftem(:ncol) = sum(state%q(:ncol,:,m) * state%pdeldry(:ncol,:), dim=2) * rga + else + ftem(:ncol) = sum(state%q(:ncol,:,m) * state%pdel(:ncol,:), dim=2) * rga + endif + call outfld (burdennam(m), ftem, pcols, lchnk) + end do + +end subroutine constituent_burden_comp + +!========================================================================================= + +end module constituent_burden + diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 new file mode 100644 index 0000000000..4f26c10988 --- /dev/null +++ b/src/physics/cam/constituents.F90 @@ -0,0 +1,533 @@ + +module constituents + +! Metadata manager for the advected constituents. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_const_mod, only: shr_const_rgas +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +! Public interfaces +public :: & + cnst_readnl, &! read namelist + cnst_add, &! add a constituent to the list of advected constituents + cnst_num_avail, &! returns the number of available slots in the constituent array + cnst_get_ind, &! get the index of a constituent + cnst_get_type_byind, &! return mixing ratio type of a constituent + cnst_get_molec_byind,&! return molecular diffusion type of a constituent + cnst_read_iv, &! query whether constituent initial values are read from initial file + cnst_chk_dim, &! check that number of constituents added equals dimensions (pcnst) + cnst_cam_outfld, &! Returns true if default CAM output was specified in the cnst_add calls. + cnst_set_spec_class, &! Sets the type of species class + cnst_set_convtran2 ! Override for convtran2 values set by the cnst_add routine + +! Public data + +integer, parameter, public :: pcnst = PCNST ! number of advected constituents (including water vapor) + +character(len=16), public, protected :: cnst_name(pcnst) ! constituent names +character(len=128),public, protected :: cnst_longname(pcnst) ! long name of constituents + +! Namelist variables +logical, public, protected :: readtrace = .true. ! true => obtain initial tracer data from IC file + +integer, public, parameter :: cnst_spec_class_undefined = 0 +integer, public, parameter :: cnst_spec_class_cldphysics = 1 +integer, public, parameter :: cnst_spec_class_aerosol = 2 +integer, public, parameter :: cnst_spec_class_gas = 3 +integer, public, parameter :: cnst_spec_class_other = 4 + +! +! Constants for each tracer + +integer, public, protected :: cnst_species_class(pcnst) = cnst_spec_class_undefined ! indicates species class & + ! (cldphysics, aerosol, gas ) +real(r8), public :: cnst_cp (pcnst) ! specific heat at constant pressure (J/kg/K) +real(r8), public :: cnst_cv (pcnst) ! specific heat at constant volume (J/kg/K) +real(r8), public :: cnst_mw (pcnst) ! molecular weight (kg/kmole) +character*3, public :: cnst_type(pcnst) ! wet or dry mixing ratio +character*5, public :: cnst_molec(pcnst) ! major or minor species molecular diffusion +real(r8), public :: cnst_rgas(pcnst) ! gas constant () +real(r8), public :: qmin (pcnst) ! minimum permitted constituent concentration (kg/kg) +real(r8), public :: qmincg (pcnst) ! for backward compatibility only +logical, public :: cnst_fixed_ubc(pcnst) = .false. ! upper bndy condition = fixed ? +logical, public :: cnst_fixed_ubflx(pcnst) = .false.! upper boundary non-zero fixed constituent flux +logical, public, protected :: cnst_is_convtran1(pcnst) = .false. ! do convective transport in phase 1 +logical, public, protected :: cnst_is_convtran2(pcnst) = .false. ! do convective transport in phase 2 + +!++bee - temporary... These names should be declared in the module that makes the addfld and outfld calls. +! Lists of tracer names and diagnostics +character(len=16), public :: apcnst (pcnst) ! constituents after physics (FV core only) +character(len=16), public :: bpcnst (pcnst) ! constituents before physics (FV core only) +character(len=16), public :: hadvnam (pcnst) ! names of horizontal advection tendencies +character(len=16), public :: vadvnam (pcnst) ! names of vertical advection tendencies +character(len=16), public :: dcconnam (pcnst) ! names of convection tendencies +character(len=16), public :: fixcnam (pcnst) ! names of species slt fixer tendencies +character(len=16), public :: tendnam (pcnst) ! names of total tendencies of species +character(len=16), public :: ptendnam (pcnst) ! names of total physics tendencies of species +character(len=16), public :: dmetendnam(pcnst) ! names of dme adjusted tracers (FV) +character(len=16), public :: sflxnam (pcnst) ! names of surface fluxes of species +character(len=16), public :: tottnam (pcnst) ! names for horz + vert + fixer tendencies + +! Private data + +integer :: padv = 0 ! index pointer to last advected tracer +logical :: read_init_vals(pcnst) ! true => read initial values from initial file +logical :: cam_outfld_(pcnst) ! true => default CAM output of constituents in kg/kg + ! false => chemistry is responsible for making outfld + ! calls for constituents + +!============================================================================================== +CONTAINS +!============================================================================================== + +subroutine cnst_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical + + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'cnst_readnl' + + namelist /constituents_nl/ readtrace + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'constituents_nl', status=ierr) + if (ierr == 0) then + read(unitn, constituents_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(readtrace, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: readtrace") + + if (masterproc) then + write(iulog,*)'Summary of constituent module options:' + write(iulog,*)' Read constituent initial values from initial file by default: ', readtrace + end if + +end subroutine cnst_readnl + +!========================================================================================= + + +subroutine cnst_add (name, mwc, cpc, qminc, & + ind, longname, readiv, mixtype, molectype, cam_outfld, & + fixed_ubc, fixed_ubflx, is_convtran1, is_convtran2, cnst_spec_class) + + ! Register a constituent. + + character(len=*), intent(in) :: & + name ! constituent name used as variable name in history file output (8 char max) + real(r8),intent(in) :: mwc ! constituent molecular weight (kg/kmol) + real(r8),intent(in) :: cpc ! constituent specific heat at constant pressure (J/kg/K) + real(r8),intent(in) :: qminc ! minimum value of mass mixing ratio (kg/kg) + ! normally 0., except water 1.E-12, for radiation. + integer, intent(out) :: ind ! global constituent index (in q array) + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + logical, intent(in), optional :: & + readiv ! true => read initial values from initial file (default: true) + character(len=*), intent(in), optional :: & + mixtype ! mixing ratio type (dry, wet) + character(len=*), intent(in), optional :: & + molectype ! molecular diffusion type (minor, major) + logical, intent(in), optional :: & + cam_outfld ! true => default CAM output of constituent in kg/kg + logical, intent(in), optional :: & + fixed_ubc ! true => const has a fixed upper bndy condition + logical, intent(in), optional :: & + fixed_ubflx ! true => const has a non-zero fixed upper bndy flux value + logical, intent(in), optional :: & + is_convtran1 ! true => convective transport in convtran1 + logical, intent(in), optional :: & + is_convtran2 ! true => convective transport in convtran2 + integer, intent(in), optional :: & + cnst_spec_class ! type of species class + + character(len=*), parameter :: sub='cnst_add' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! set tracer index and check validity + padv = padv+1 + ind = padv + if (padv > pcnst) then + write(errmsg, *) sub//': FATAL: advected tracer index greater than pcnst=', pcnst + call endrun(errmsg) + end if + + ! set tracer name and constants + cnst_name(ind) = name + if (present(longname)) then + cnst_longname(ind) = longname + else + cnst_longname(ind) = name + end if + + ! set whether to read initial values from initial file + if (present(readiv)) then + read_init_vals(ind) = readiv + else + read_init_vals(ind) = readtrace + end if + + ! set constituent mixing ratio type + if (present(mixtype)) then + cnst_type(ind) = mixtype + else + cnst_type(ind) = 'wet' + end if + + ! set constituent molecular diffusion type + if (present(molectype)) then + cnst_molec(ind) = molectype + else + cnst_molec(ind) = 'minor' + end if + + ! set outfld type + ! (false: the module declaring the constituent is responsible for outfld calls) + if (present(cam_outfld)) then + cam_outfld_(ind) = cam_outfld + else + cam_outfld_(ind) = .true. + end if + + ! set upper boundary condition type + if (present(fixed_ubc)) then + cnst_fixed_ubc(ind) = fixed_ubc + else + cnst_fixed_ubc(ind) = .false. + end if + + ! set upper boundary flux type + if (present(fixed_ubflx)) then + cnst_fixed_ubflx(ind) = fixed_ubflx + else + cnst_fixed_ubflx(ind) = .false. + end if + + ! Set flag for convective transport by first call to convtran (phase 1). + if (present(is_convtran1)) then + cnst_is_convtran1(ind) = is_convtran1 + else + cnst_is_convtran1(ind) = .false. + end if + ! Set flag for convective transport after wetdep (phase 2). + if (present(is_convtran2)) then + cnst_is_convtran2(ind) = is_convtran2 + else + ! The default is that all constituents except water vapor are transported in phase 2 + ! unless they were transported in phase 1 (typically the condensed water species) + if (ind > 1) cnst_is_convtran2(ind) = .not. cnst_is_convtran1(ind) + end if + ! consistency check -- It is OK to completely turn off the deep scheme transport by setting + ! both cnst_is_convtran1 and cnst_is_convtran2 to FALSE. But it is an error to + ! have both set TRUE. + if (cnst_is_convtran1(ind) .and. cnst_is_convtran2(ind)) then + call endrun(sub//': FATAL: cannot set both cnst_is_convtran1 and cnst_is_convtran2 to TRUE') + end if + + ! Set type for species class + if ( present(cnst_spec_class) ) then + cnst_species_class(ind) = cnst_spec_class + else + cnst_species_class(ind) = cnst_spec_class_undefined + end if + + cnst_cp (ind) = cpc + cnst_mw (ind) = mwc + qmin (ind) = qminc + if (ind == 1) then + ! qmincg for water vapor set to zero + qmincg(ind) = 0._r8 + else + qmincg(ind) = qminc + end if + + cnst_rgas(ind) = shr_const_rgas * mwc + cnst_cv (ind) = cpc - cnst_rgas(ind) + +end subroutine cnst_add + +!---------------------------------------------------------------------------------------------- + +subroutine cnst_set_convtran2(ind, is_convtran2) + + ! Allow user to override the value of cnst_is_convtran2 set by a previous cnst_add call. + + integer, intent(in) :: ind ! global constituent index (in q array) + logical, intent(in) :: is_convtran2 ! true => convect in convtran2 + + character(len=*), parameter :: sub = 'cnst_set_convtran2' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! check index + if (ind <= 0 .or. ind > padv) then + write(errmsg,*) sub//': FATAL: bad tracer index: padv, ind = ', padv, ind + call endrun(errmsg) + end if + + ! Set flag for convective transport after wetdep (phase 2). + cnst_is_convtran2(ind) = is_convtran2 + + ! consistency check -- It is OK to completely turn off the tracer convection by setting + ! both cnst_is_convtran1 and cnst_is_convtran2 to FALSE. But it is an error to + ! have both set TRUE. + if (cnst_is_convtran1(ind) .and. cnst_is_convtran2(ind)) then + call endrun(sub//': FATAL: cannot set both cnst_is_convtran1 and cnst_is_convtran2 to TRUE') + end if + +end subroutine cnst_set_convtran2 + +!---------------------------------------------------------------------------------------------- + +subroutine cnst_set_spec_class(ind, cnst_spec_class_in) + + ! Allow user to override the value of cnst_spec_class set by a previous cnst_add call. + + integer, intent(in) :: ind ! global constituent index (in q array) + integer, intent(in) :: cnst_spec_class_in ! species class designator + + character(len=*), parameter :: subname = 'cnst_set_spec_class' + !----------------------------------------------------------------------- + + ! check index + if (ind <= 0 .or. ind > padv) then + write(iulog,*) subname//': illegal tracer index: padv, ind = ', padv, ind + call endrun(subname//': illegal tracer index') + end if + + ! Check designator + if (cnst_spec_class_in /= cnst_spec_class_undefined .and. & + cnst_spec_class_in /= cnst_spec_class_cldphysics .and. & + cnst_spec_class_in /= cnst_spec_class_aerosol .and. & + cnst_spec_class_in /= cnst_spec_class_gas .and. & + cnst_spec_class_in /= cnst_spec_class_other ) then + write(iulog,*) subname//': trying to use invalid cnst_spec_class designator', cnst_spec_class_in + call endrun(subname//': invalid cnst_spec_class designator') + end if + + ! Set flag for convective transport after wetdep (phase 2). + cnst_species_class(ind) = cnst_spec_class_in + + end subroutine cnst_set_spec_class + +!============================================================================== + +function cnst_num_avail() + + ! return number of available slots in the constituent array + + integer cnst_num_avail + + cnst_num_avail = pcnst - padv + +end function cnst_num_avail + +!============================================================================== + +subroutine cnst_get_ind (name, ind, abort) + + ! Get the index of a constituent. Optional abort argument allows returning + ! control to caller when constituent name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! constituent name + integer, intent(out) :: ind ! global constituent index (in q array) + logical, optional, intent(in) :: abort ! optional flag controlling abort + + !---------------------------Local workspace----------------------------- + integer :: m ! tracer index + logical :: abort_on_error + character(len=*), parameter :: sub='cnst_get_ind' + !----------------------------------------------------------------------- + + ! Find tracer name in list + do m = 1, pcnst + if (name == cnst_name(m)) then + ind = m + return + end if + end do + + ! Unrecognized name + abort_on_error = .true. + if (present(abort)) abort_on_error = abort + + if (abort_on_error) then + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', cnst_name(:) + call endrun(sub//': FATAL: name not found') + end if + + ! error return + ind = -1 + +end subroutine cnst_get_ind + +!============================================================================================== + +character*3 function cnst_get_type_byind(ind) + + ! Return the mixing ratio type of a constituent + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global constituent index (in q array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='cnst_get_type_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= pcnst) then + cnst_get_type_byind = cnst_type(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for constituent index=', ind + call endrun(errmsg) + end if + +end function cnst_get_type_byind + +!============================================================================================== + +character*5 function cnst_get_molec_byind (ind) + + ! Return the molecular diffusion type of a constituent + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global constituent index (in q array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='cnst_get_molec_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= pcnst) then + cnst_get_molec_byind = cnst_molec(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for constituent index=', ind + call endrun(errmsg) + end if + +end function cnst_get_molec_byind + +!============================================================================== + +function cnst_read_iv(m) + + ! Query whether to attempt to read constituent initial values from initial file. + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: m ! constituent index + + logical :: cnst_read_iv ! true => read initial values from inital file + + character(len=*), parameter :: sub='cnst_read_iv' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (m > 0 .and. m <= pcnst) then + cnst_read_iv = read_init_vals(m) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for constiuent index=', m + call endrun(errmsg) + end if + +end function cnst_read_iv + +!============================================================================== + +subroutine cnst_chk_dim + + ! Check that the number of registered constituents is pcnst + ! Write constituent list to log file. + + integer :: i, m + character(len=*), parameter :: sub='cnst_chk_dim' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (padv /= pcnst) then + write(errmsg, *) sub//': FATAL: number of advected tracer (',padv, & + ') not equal to pcnst (', pcnst, ')' + call endrun (errmsg) + endif + + if (masterproc) then + write(iulog,*) 'Advected constituent list:' + do i = 1, pcnst + write(iulog,'(2x,i4,2x,a8,2x,a128,2x,a3)') i, cnst_name(i), cnst_longname(i), & + cnst_type(i) + end do + end if + + ! Set names of advected tracer diagnostics + do m=1,pcnst + apcnst (m) = trim(cnst_name(m))//'AP' + bpcnst (m) = trim(cnst_name(m))//'BP' + hadvnam (m) = 'HA'//cnst_name(m) + vadvnam (m) = 'VA'//cnst_name(m) + fixcnam (m) = 'DF'//cnst_name(m) + tendnam (m) = 'TE'//cnst_name(m) + ptendnam (m) = 'PTE'//cnst_name(m) + dmetendnam(m) = 'DME'//cnst_name(m) + tottnam (m) = 'TA'//cnst_name(m) + sflxnam(m) = 'SF'//cnst_name(m) + end do + +end subroutine cnst_chk_dim + +!============================================================================== + +function cnst_cam_outfld(m) + + ! Query whether default CAM outfld calls should be made. + + !----------------------------------------------------------------------- + integer, intent(in) :: m ! constituent index + + logical :: cnst_cam_outfld ! true => use default CAM outfld calls + + character(len=*), parameter :: sub='cnst_cam_outfld' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (m > 0 .and. m <= pcnst) then + cnst_cam_outfld = cam_outfld_(m) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for constiuent index=', m + call endrun(errmsg) + end if + +end function cnst_cam_outfld + +!============================================================================== + +end module constituents diff --git a/src/physics/cam/conv_water.F90 b/src/physics/cam/conv_water.F90 new file mode 100644 index 0000000000..623569b8ac --- /dev/null +++ b/src/physics/cam/conv_water.F90 @@ -0,0 +1,435 @@ + module conv_water + + ! --------------------------------------------------------------------- ! + ! Purpose: ! + ! Computes grid-box average liquid (and ice) from stratus and cumulus ! + ! Just for the purposes of radiation. ! + ! ! + ! Method: ! + ! Extract information about deep+shallow liquid and cloud fraction from ! + ! the physics buffer. ! + ! ! + ! Author: Rich Neale, August 2006 ! + ! October 2006: Allow averaging of liquid to give a linear ! + ! average in emissivity. ! + ! Andrew Gettelman October 2010 Separate module ! + !---------------------------------------------------------------------- ! + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use physconst, only: gravit, latvap, latice + use cam_abortutils, only: endrun + + use perf_mod + use cam_logfile, only: iulog + + implicit none + private + save + + public :: & + conv_water_readnl, & + conv_water_register, & + conv_water_init, & + conv_water_4rad, & + conv_water_in_rad + +! pbuf indices + + integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, & + ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx + + integer :: ixcldice, ixcldliq + +! Namelist +integer, parameter :: unset_int = huge(1) + +integer :: conv_water_in_rad = unset_int ! 0==> No; 1==> Yes-Arithmetic average; + ! 2==> Yes-Average in emissivity. +integer :: conv_water_mode +real(r8) :: frac_limit + +!============================================================================================= +contains +!============================================================================================= + +subroutine conv_water_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'conv_water_readnl' + + real(r8) :: conv_water_frac_limit + + namelist /conv_water_nl/ conv_water_in_rad, conv_water_frac_limit + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'conv_water_nl', status=ierr) + if (ierr == 0) then + read(unitn, conv_water_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(conv_water_in_rad, 1, mpiint, 0, mpicom) + call mpibcast(conv_water_frac_limit, 1, mpir8, 0, mpicom) +#endif + + conv_water_mode = conv_water_in_rad + frac_limit = conv_water_frac_limit + +end subroutine conv_water_readnl + +!============================================================================================= + + subroutine conv_water_register + + !---------------------------------------------------------------------- ! + ! ! + ! Register the fields in the physics buffer. ! + ! ! + !---------------------------------------------------------------------- ! + + use constituents, only: cnst_add, pcnst + use physconst, only: mwdry, cpair + + use physics_buffer, only : pbuf_add_field, dtype_r8 + + !----------------------------------------------------------------------- + + ! these calls were already done in convect_shallow...so here I add the same fields to the physics buffer with a "1" at the end +! shallow gbm cloud liquid water (kg/kg) + call pbuf_add_field('SH_CLDLIQ1','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq1_idx) +! shallow gbm cloud ice water (kg/kg) + call pbuf_add_field('SH_CLDICE1','physpkg',dtype_r8,(/pcols,pver/),sh_cldice1_idx) + + end subroutine conv_water_register + + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine conv_water_init() + ! --------------------------------------------------------------------- ! + ! Purpose: ! + ! Initializes the pbuf indices required by conv_water + ! --------------------------------------------------------------------- ! + + + use physics_buffer, only : pbuf_get_index + use cam_history, only : addfld + + use constituents, only: cnst_get_ind + + implicit none + + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + icwmrsh_idx = pbuf_get_index('ICWMRSH') + icwmrdp_idx = pbuf_get_index('ICWMRDP') + fice_idx = pbuf_get_index('FICE') + sh_frac_idx = pbuf_get_index('SH_FRAC') + dp_frac_idx = pbuf_get_index('DP_FRAC') + ast_idx = pbuf_get_index('AST') + rei_idx = pbuf_get_index('REI') + + ! Convective cloud water variables. + call addfld ('ICIMRCU', (/ 'lev' /), 'A', 'kg/kg', 'Convection in-cloud ice mixing ratio ' ) + call addfld ('ICLMRCU', (/ 'lev' /), 'A', 'kg/kg', 'Convection in-cloud liquid mixing ratio ') + call addfld ('ICIMRTOT', (/ 'lev' /), 'A', 'kg/kg', 'Total in-cloud ice mixing ratio ' ) + call addfld ('ICLMRTOT', (/ 'lev' /), 'A', 'kg/kg', 'Total in-cloud liquid mixing ratio ' ) + + call addfld ('GCLMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Grid-mean deep convective LWC' ) + call addfld ('GCIMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Grid-mean deep convective IWC' ) + call addfld ('GCLMRSH', (/ 'lev' /), 'A', 'kg/kg', 'Grid-mean shallow convective LWC' ) + call addfld ('GCIMRSH', (/ 'lev' /), 'A', 'kg/kg', 'Grid-mean shallow convective IWC' ) + call addfld ('FRESH', (/ 'lev' /), 'A', '1', 'Fractional occurrence of shallow cumulus with condensate') + call addfld ('FREDP', (/ 'lev' /), 'A', '1', 'Fractional occurrence of deep cumulus with condensate') + call addfld ('FRECU', (/ 'lev' /), 'A', '1', 'Fractional occurrence of cumulus with condensate') + call addfld ('FRETOT', (/ 'lev' /), 'A', '1', 'Fractional occurrence of cloud with condensate') + + end subroutine conv_water_init + + subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) + + ! --------------------------------------------------------------------- ! + ! Purpose: ! + ! Computes grid-box average liquid (and ice) from stratus and cumulus ! + ! Just for the purposes of radiation. ! + ! ! + ! Method: ! + ! Extract information about deep+shallow liquid and cloud fraction from ! + ! the physics buffer. ! + ! ! + ! Author: Rich Neale, August 2006 ! + ! October 2006: Allow averaging of liquid to give a linear ! + ! average in emissivity. ! + ! ! + !---------------------------------------------------------------------- ! + + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + + use physics_types, only: physics_state + use cam_history, only: outfld + use phys_control, only: phys_getopts + + implicit none + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + + type(physics_state), target, intent(in) :: state ! state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(out):: totg_ice(pcols,pver) ! Total GBA in-cloud ice + real(r8), intent(out):: totg_liq(pcols,pver) ! Total GBA in-cloud liquid + + ! --------------- ! + ! Local Workspace ! + ! --------------- ! + + real(r8), pointer, dimension(:,:) :: pdel ! Moist pressure difference across layer + real(r8), pointer, dimension(:,:) :: ls_liq ! Large-scale contributions to GBA cloud liq + real(r8), pointer, dimension(:,:) :: ls_ice ! Large-scale contributions to GBA cloud ice + + ! Physics buffer fields + real(r8), pointer, dimension(:,:) :: ast ! Physical liquid+ice stratus cloud fraction + real(r8), pointer, dimension(:,:) :: sh_frac ! Shallow convective cloud fraction + real(r8), pointer, dimension(:,:) :: dp_frac ! Deep convective cloud fraction + real(r8), pointer, dimension(:,:) :: rei ! Ice effective drop size (microns) + + real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water + real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water + real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio + real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow convection gbx liq cld mixing ratio for COSP + real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow convection gbx ice cld mixing ratio for COSP + + real(r8) :: conv_ice(pcols,pver) ! Convective contributions to IC cloud ice + real(r8) :: conv_liq(pcols,pver) ! Convective contributions to IC cloud liquid + real(r8) :: tot_ice(pcols,pver) ! Total IC ice + real(r8) :: tot_liq(pcols,pver) ! Total IC liquid + + integer :: i,k,itim_old ! Lon, lev indices buff stuff. + real(r8) :: cu_icwmr ! Convective water for this grid-box. + real(r8) :: ls_icwmr ! Large-scale water for this grid-box. + real(r8) :: tot_icwmr ! Large-scale water for this grid-box. + real(r8) :: ls_frac ! Large-scale cloud frac for this grid-box. + real(r8) :: tot0_frac, cu0_frac, dp0_frac, sh0_frac + real(r8) :: kabs, kabsi, kabsl, alpha, dp0, sh0, ic_limit + real(r8) :: wrk1 + + real(r8) :: totg_ice_sh(pcols,pver) ! Grid-mean IWP from shallow convective cloud + real(r8) :: totg_liq_sh(pcols,pver) ! Grid-mean LWP from shallow convective cloud + real(r8) :: totg_ice_dp(pcols,pver) ! Grid-mean IWP from deep convective cloud + real(r8) :: totg_liq_dp(pcols,pver) ! Grid-mean LWP from deep convective cloud + real(r8) :: fresh(pcols,pver) ! Fractional occurrence of shallow cumulus + real(r8) :: fredp(pcols,pver) ! Fractional occurrence of deep cumulus + real(r8) :: frecu(pcols,pver) ! Fractional occurrence of cumulus + real(r8) :: fretot(pcols,pver) ! Fractional occurrence of cloud + + integer :: lchnk + integer :: ncol + + ! --------- ! + ! Parameter ! + ! --------- ! + + parameter( kabsl = 0.090361_r8, ic_limit = 1.e-12_r8 ) + character(len=16) :: microp_scheme + + ncol = state%ncol + lchnk = state%lchnk + pdel => state%pdel + ls_liq => state%q(:,:,ixcldliq) + ls_ice => state%q(:,:,ixcldice) + + ! Get microphysics option + call phys_getopts( microp_scheme_out = microp_scheme ) + + ! Get convective in-cloud water and ice/water temperature partitioning. + + call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr ) + call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr ) + call pbuf_get_field(pbuf, fice_idx, fice ) + + ! Get convective in-cloud fraction + + call pbuf_get_field(pbuf, sh_frac_idx, sh_frac ) + call pbuf_get_field(pbuf, dp_frac_idx, dp_frac ) + call pbuf_get_field(pbuf, rei_idx, rei ) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ! --------------------------------------------------------------- ! + ! Loop through grid-boxes and determine: ! + ! 1. Effective mean in-cloud convective ice/liquid (deep+shallow) ! + ! 2. Effective mean in-cloud total ice/liquid (ls+convective) ! + ! --------------------------------------------------------------- ! + + fresh(:,:) = 0._r8 + fredp(:,:) = 0._r8 + frecu(:,:) = 0._r8 + fretot(:,:) = 0._r8 + + do k = 1, pver + do i = 1, ncol + + if( sh_frac(i,k) <= frac_limit .or. sh_icwmr(i,k) <= ic_limit ) then + sh0_frac = 0._r8 + else + sh0_frac = sh_frac(i,k) + endif + if( dp_frac(i,k) <= frac_limit .or. dp_icwmr(i,k) <= ic_limit ) then + dp0_frac = 0._r8 + else + dp0_frac = dp_frac(i,k) + endif + cu0_frac = sh0_frac + dp0_frac + + ! For the moment calculate the emissivity based upon the ls clouds ice fraction + + wrk1 = min(1._r8,max(0._r8, ls_ice(i,k)/(ls_ice(i,k)+ls_liq(i,k)+1.e-36_r8))) + + if( ( cu0_frac < frac_limit ) .or. ( ( sh_icwmr(i,k) + dp_icwmr(i,k) ) < ic_limit ) ) then + + cu0_frac = 0._r8 + cu_icwmr = 0._r8 + + ls_frac = ast(i,k) + if( ls_frac < frac_limit ) then + ls_frac = 0._r8 + ls_icwmr = 0._r8 + else + ls_icwmr = ( ls_liq(i,k) + ls_ice(i,k) )/max(frac_limit,ls_frac) ! Convert to IC value. + end if + + tot0_frac = ls_frac + tot_icwmr = ls_icwmr + + else + + ! Select radiation constants (effective radii) for emissivity averaging. + + if( microp_scheme == 'RK' .or. microp_scheme == 'SPCAM_sam1mom') then + kabsi = 0.005_r8 + 1._r8/rei(i,k) + else + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,rei(i,k)),130._r8) + endif + kabs = kabsl * ( 1._r8 - wrk1 ) + kabsi * wrk1 + alpha = -1.66_r8*kabs*pdel(i,k)/gravit*1000.0_r8 + + ! Selecting cumulus in-cloud water. + + select case (conv_water_mode) ! Type of average + case (1) ! Area weighted arithmetic average + cu_icwmr = ( sh0_frac * sh_icwmr(i,k) + dp0_frac*dp_icwmr(i,k))/max(frac_limit,cu0_frac) + case (2) + sh0 = exp(alpha*sh_icwmr(i,k)) + dp0 = exp(alpha*dp_icwmr(i,k)) + cu_icwmr = log((sh0_frac*sh0+dp0_frac*dp0)/max(frac_limit,cu0_frac)) + cu_icwmr = cu_icwmr/alpha + case default ! Area weighted 'arithmetic in emissivity' average. +! call endrun ('CONV_WATER_4_RAD: Unknown option for conv_water_in_rad - exiting') + end select + + ! Selecting total in-cloud water. + ! Attribute large-scale/convective area fraction differently from default. + + ls_frac = ast(i,k) + ls_icwmr = (ls_liq(i,k) + ls_ice(i,k))/max(frac_limit,ls_frac) ! Convert to IC value. + tot0_frac = (ls_frac + cu0_frac) + + select case (conv_water_mode) ! Type of average + case (1) ! Area weighted 'arithmetic in emissivity' average + tot_icwmr = (ls_frac*ls_icwmr + cu0_frac*cu_icwmr)/max(frac_limit,tot0_frac) + case (2) + tot_icwmr = log((ls_frac*exp(alpha*ls_icwmr)+cu0_frac*exp(alpha*cu_icwmr))/max(frac_limit,tot0_frac)) + tot_icwmr = tot_icwmr/alpha + case default ! Area weighted 'arithmetic in emissivity' average. +! call endrun ('CONV_WATER_4_RAD: Unknown option for conv_water_in_rad - exiting') + end select + + end if + + ! Repartition convective cloud water into liquid and ice phase. + ! Currently, this partition is made using the ice fraction of stratus condensate. + ! In future, we should use ice fraction explicitly computed from the convection scheme. + + conv_ice(i,k) = cu_icwmr * wrk1 + conv_liq(i,k) = cu_icwmr * (1._r8-wrk1) + + tot_ice(i,k) = tot_icwmr * wrk1 + tot_liq(i,k) = tot_icwmr * (1._r8-wrk1) + + totg_ice(i,k) = tot0_frac * tot_icwmr * wrk1 + totg_liq(i,k) = tot0_frac * tot_icwmr * (1._r8-wrk1) + + ! Grid-mean convective water + totg_ice_sh(i,k) = sh0_frac * sh_icwmr(i,k) * wrk1 + totg_ice_dp(i,k) = dp0_frac * dp_icwmr(i,k) * wrk1 + totg_liq_sh(i,k) = sh0_frac * sh_icwmr(i,k) * (1._r8-wrk1) + totg_liq_dp(i,k) = dp0_frac * dp_icwmr(i,k) * (1._r8-wrk1) + if( sh0_frac > frac_limit ) then + fresh(i,k) = 1._r8 + endif + if( dp0_frac > frac_limit ) then + fredp(i,k) = 1._r8 + endif + if( cu0_frac > frac_limit ) then + frecu(i,k) = 1._r8 + endif + if( tot0_frac > frac_limit ) then + fretot(i,k) = 1._r8 + endif + + end do + end do + +!add pbuff calls for COSP + call pbuf_get_field(pbuf, sh_cldliq1_idx, sh_cldliq ) + call pbuf_get_field(pbuf, sh_cldice1_idx, sh_cldice ) + + sh_cldliq(:ncol,:pver)=sh_icwmr(:ncol,:pver)*(1-fice(:ncol,:pver))*sh_frac(:ncol,:pver) + sh_cldice(:ncol,:pver)=sh_icwmr(:ncol,:pver)*fice(:ncol,:pver)*sh_frac(:ncol,:pver) + + ! Output convective IC WMRs + + call outfld( 'ICLMRCU ', conv_liq , pcols, lchnk ) + call outfld( 'ICIMRCU ', conv_ice , pcols, lchnk ) + call outfld( 'ICLMRTOT', tot_liq , pcols, lchnk ) + call outfld( 'ICIMRTOT', tot_ice , pcols, lchnk ) + + call outfld('GCLMRDP', totg_liq_dp, pcols, lchnk) + call outfld('GCIMRDP', totg_ice_dp, pcols, lchnk) + call outfld('GCLMRSH', totg_liq_sh, pcols, lchnk) + call outfld('GCIMRSH', totg_ice_sh, pcols, lchnk) + call outfld('FRESH', fresh, pcols, lchnk) + call outfld('FREDP', fredp, pcols, lchnk) + call outfld('FRECU', frecu, pcols, lchnk) + call outfld('FRETOT', fretot, pcols, lchnk) + + end subroutine conv_water_4rad + +end module conv_water diff --git a/src/physics/cam/convect_deep.F90 b/src/physics/cam/convect_deep.F90 new file mode 100644 index 0000000000..edd2043623 --- /dev/null +++ b/src/physics/cam/convect_deep.F90 @@ -0,0 +1,318 @@ + +module convect_deep +!--------------------------------------------------------------------------------- +! Purpose: +! +! CAM interface to several deep convection interfaces. Currently includes: +! Zhang-McFarlane (default) +! Kerry Emanuel +! +! +! Author: D.B. Coleman, Sep 2004 +! +!--------------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pver, pcols, pverp + use cam_logfile, only: iulog + + implicit none + + save + private ! Make default type private to the module + +! Public methods + + public ::& + convect_deep_register, &! register fields in physics buffer + convect_deep_init, &! initialize donner_deep module + convect_deep_tend, &! return tendencies + convect_deep_tend_2, &! return tendencies + deep_scheme_does_scav_trans ! = .t. if scheme does scavenging and conv. transport + +! Private module data + character(len=16) :: deep_scheme ! default set in phys_control.F90, use namelist to change +! Physics buffer indices + integer :: icwmrdp_idx = 0 + integer :: rprddp_idx = 0 + integer :: nevapr_dpcu_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cld_idx = 0 + integer :: fracis_idx = 0 + + integer :: pblh_idx = 0 + integer :: tpert_idx = 0 + integer :: prec_dp_idx = 0 + integer :: snow_dp_idx = 0 + + integer :: ttend_dp_idx = 0 + +!========================================================================================= + contains + +!========================================================================================= +function deep_scheme_does_scav_trans() +! +! Function called by tphysbc to determine if it needs to do scavenging and convective transport +! or if those have been done by the deep convection scheme. Each scheme could have its own +! identical query function for a less-knowledgable interface but for now, we know that KE +! does scavenging & transport, and ZM doesn't +! + + logical deep_scheme_does_scav_trans + + deep_scheme_does_scav_trans = .false. + + if ( deep_scheme .eq. 'KE' ) deep_scheme_does_scav_trans = .true. + + return + +end function deep_scheme_does_scav_trans + +!========================================================================================= +subroutine convect_deep_register + +!---------------------------------------- +! Purpose: register fields with the physics buffer +!---------------------------------------- + + + use physics_buffer, only : pbuf_add_field, dtype_r8 + use zm_conv_intr, only: zm_conv_register + use phys_control, only: phys_getopts, use_gw_convect_dp + + implicit none + + integer idx + + ! get deep_scheme setting from phys_control + call phys_getopts(deep_scheme_out = deep_scheme) + + select case ( deep_scheme ) + case('ZM') ! Zhang-McFarlane (default) + call zm_conv_register + + case('off', 'UNICON') ! Off needs to setup the following fields + call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) + call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) + call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx) + call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx) + call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx) + + end select + + ! If gravity waves from deep convection are on, output this field. + if (use_gw_convect_dp .and. deep_scheme == 'ZM') then + call pbuf_add_field('TTEND_DP','physpkg',dtype_r8,(/pcols,pver/),ttend_dp_idx) + end if + +end subroutine convect_deep_register + +!========================================================================================= + + + +subroutine convect_deep_init(pref_edge) + +!---------------------------------------- +! Purpose: declare output fields, initialize variables needed by convection +!---------------------------------------- + + use cam_history, only: addfld + use pmgrid, only: plevp + use spmd_utils, only: masterproc + use zm_conv_intr, only: zm_conv_init + use cam_abortutils, only: endrun + + use physics_buffer, only: physics_buffer_desc, pbuf_get_index + + implicit none + + real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces + + select case ( deep_scheme ) + case('off') + if (masterproc) write(iulog,*)'convect_deep: no deep convection selected' + case('CLUBB_SGS') + if (masterproc) write(iulog,*)'convect_deep: CLUBB_SGS selected' + case('ZM') + if (masterproc) write(iulog,*)'convect_deep initializing Zhang-McFarlane convection' + call zm_conv_init(pref_edge) + case('UNICON') + if (masterproc) write(iulog,*)'convect_deep: deep convection done by UNICON' + case('SPCAM') + if (masterproc) write(iulog,*)'convect_deep: deep convection done by SPCAM' + return + case default + if (masterproc) write(iulog,*)'WARNING: convect_deep: no deep convection scheme. May fail.' + end select + + icwmrdp_idx = pbuf_get_index('ICWMRDP') + rprddp_idx = pbuf_get_index('RPRDDP') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + prec_dp_idx = pbuf_get_index('PREC_DP') + snow_dp_idx = pbuf_get_index('SNOW_DP') + + cldtop_idx = pbuf_get_index('CLDTOP') + cldbot_idx = pbuf_get_index('CLDBOT') + cld_idx = pbuf_get_index('CLD') + fracis_idx = pbuf_get_index('FRACIS') + + pblh_idx = pbuf_get_index('pblh') + tpert_idx = pbuf_get_index('tpert') + + call addfld ('ICWMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Deep Convection in-cloud water mixing ratio ' ) + +end subroutine convect_deep_init +!========================================================================================= +!subroutine convect_deep_tend(state, ptend, tdt, pbuf) + +subroutine convect_deep_tend( & + mcon ,cme , & + pflx ,zdu , & + rliq ,rice , & + ztodt , & + state ,ptend ,landfrac ,pbuf) + + + use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init + + use cam_history, only: outfld + use constituents, only: pcnst + use zm_conv_intr, only: zm_conv_tend + use cam_history, only: outfld + use physconst, only: cpair + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + +! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies + + + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + + + real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c + real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level + real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation + real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux + + real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals + real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals + + real(r8), pointer :: prec(:) ! total precipitation + real(r8), pointer :: snow(:) ! snow from ZM convection + + real(r8), pointer, dimension(:) :: jctop + real(r8), pointer, dimension(:) :: jcbot + real(r8), pointer, dimension(:,:,:) :: cld + real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water. + real(r8), pointer, dimension(:,:) :: rprd ! rain production rate + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + + real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation + + real(r8), pointer :: pblh(:) ! Planetary boundary layer height + real(r8), pointer :: tpert(:) ! Thermal temperature excess + + ! Temperature tendency from deep convection (pbuf pointer). + real(r8), pointer, dimension(:,:) :: ttend_dp + + real(r8) zero(pcols, pver) + + integer i, k + + call pbuf_get_field(pbuf, cldtop_idx, jctop ) + call pbuf_get_field(pbuf, cldbot_idx, jcbot ) + call pbuf_get_field(pbuf, icwmrdp_idx, ql ) + + select case ( deep_scheme ) + case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend + zero = 0 + mcon = 0 + pflx = 0 + cme = 0 + zdu = 0 + rliq = 0 + rice = 0 + + call physics_ptend_init(ptend, state%psetcols, 'convect_deep') + +! +! Associate pointers with physics buffer fields +! + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) ) + call pbuf_get_field(pbuf, rprddp_idx, rprd ) + call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + call pbuf_get_field(pbuf, prec_dp_idx, prec ) + call pbuf_get_field(pbuf, snow_dp_idx, snow ) + + prec=0 + snow=0 + + jctop = pver + jcbot = 1._r8 + cld = 0 + ql = 0 + rprd = 0 + fracis = 0 + evapcdp = 0 + + case('ZM') ! 1 ==> Zhang-McFarlane (default) + call pbuf_get_field(pbuf, pblh_idx, pblh) + call pbuf_get_field(pbuf, tpert_idx, tpert) + + call zm_conv_tend( pblh ,mcon ,cme , & + tpert ,pflx ,zdu , & + rliq ,rice , & + ztodt , & + jctop, jcbot , & + state ,ptend ,landfrac, pbuf) + + end select + + ! If we added temperature tendency to pbuf, set it now. + + if (ttend_dp_idx > 0) then + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + ttend_dp(:state%ncol,:pver) = ptend%s(:state%ncol,:pver)/cpair + end if + + call outfld( 'ICWMRDP ', ql , pcols, state%lchnk ) + +end subroutine convect_deep_tend +!========================================================================================= + + +subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + + use physics_buffer, only: physics_buffer_desc + use constituents, only: pcnst + use zm_conv_intr, only: zm_conv_tend_2 + +! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + + if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane + call zm_conv_tend_2( state, ptend, ztodt, pbuf) + else + call physics_ptend_init(ptend, state%psetcols, 'convect_deep') + end if + + +end subroutine convect_deep_tend_2 + + +end module convect_deep diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 new file mode 100644 index 0000000000..f4f40d7d50 --- /dev/null +++ b/src/physics/cam/convect_shallow.F90 @@ -0,0 +1,922 @@ + module convect_shallow + + !----------------------------------------------- ! + ! Purpose: ! + ! ! + ! CAM interface to the shallow convection scheme ! + ! ! + ! Author: D.B. Coleman ! + ! Sungsu Park. Jan. 2010. ! + ! ! + !----------------------------------------------- ! + + use shr_kind_mod, only : r8=>shr_kind_r8 + use physconst, only : cpair, zvir + use ppgrid, only : pver, pcols, pverp + use zm_conv, only : zm_conv_evap + use cam_history, only : outfld, addfld, horiz_only + use cam_logfile, only : iulog + use phys_control, only : phys_getopts + + implicit none + private + save + + public :: & + convect_shallow_register, & ! Register fields in physics buffer + convect_shallow_init, & ! Initialize shallow module + convect_shallow_tend, & ! Return tendencies + convect_shallow_use_shfrc ! + + ! The following namelist variable controls which shallow convection package is used. + ! 'Hack' = Hack shallow convection (default) + ! 'UW' = UW shallow convection by Sungsu Park and Christopher S. Bretherton + ! 'UNICON' = General Convection Model by Sungsu Park + ! 'off' = No shallow convection + + character(len=16) :: shallow_scheme ! Default set in phys_control.F90, use namelist to change + character(len=16) :: microp_scheme ! Microphysics scheme + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi + integer :: history_budget_histfile_num ! output history file number for budget fields + + ! Physics buffer indices + integer :: icwmrsh_idx = 0 + integer :: rprdsh_idx = 0 + integer :: rprdtot_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cush_idx = 0 + integer :: nevapr_shcu_idx = 0 + integer :: shfrc_idx = 0 + integer :: cld_idx = 0 + integer :: concld_idx = 0 + integer :: rprddp_idx = 0 + integer :: tke_idx = 0 + + integer :: qpert_idx = 0 + integer :: pblh_idx = 0 + integer :: prec_sh_idx = 0 + integer :: snow_sh_idx = 0 + integer :: cmfmc_sh_idx = 0 + integer :: sh_e_ed_ratio_idx = 0 + + integer :: ttend_sh_idx = 0 + + integer :: & ! field index in physics buffer + sh_flxprc_idx, & + sh_flxsnw_idx, & + sh_cldliq_idx, & + sh_cldice_idx + + contains + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine convect_shallow_register + + !-------------------------------------------------- ! + ! Purpose : Register fields with the physics buffer ! + !-------------------------------------------------- ! + + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls + use phys_control, only: use_gw_convect_sh + use unicon_cam, only: unicon_cam_register + + call phys_getopts( shallow_scheme_out = shallow_scheme, microp_scheme_out = microp_scheme) + + ! SPCAM registers its own fields + if (shallow_scheme == 'SPCAM') return + + call pbuf_add_field('ICWMRSH', 'physpkg' ,dtype_r8,(/pcols,pver/), icwmrsh_idx ) + call pbuf_add_field('RPRDSH', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdsh_idx ) + call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdtot_idx ) + call pbuf_add_field('CLDTOP', 'physpkg' ,dtype_r8,(/pcols,1/), cldtop_idx ) + call pbuf_add_field('CLDBOT', 'physpkg' ,dtype_r8,(/pcols,1/), cldbot_idx ) + call pbuf_add_field('cush', 'global' ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx ) + call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/), nevapr_shcu_idx ) + call pbuf_add_field('PREC_SH', 'physpkg' ,dtype_r8,(/pcols/), prec_sh_idx ) + call pbuf_add_field('SNOW_SH', 'physpkg' ,dtype_r8,(/pcols/), snow_sh_idx ) + ! Updraft mass flux by shallow convection [ kg/s/m2 ] + call pbuf_add_field('CMFMC_SH', 'physpkg' ,dtype_r8,(/pcols,pverp/), cmfmc_sh_idx ) + + if (shallow_scheme .eq. 'UW' .or. shallow_scheme .eq. 'UNICON') then + call pbuf_add_field('shfrc', 'physpkg', dtype_r8, (/pcols,pver/), shfrc_idx) + end if + if( shallow_scheme .eq. 'UW' ) then + call pbuf_add_field('SH_E_ED_RATIO', 'physpkg', dtype_r8, (/pcols,pver/), sh_e_ed_ratio_idx) + endif + +! shallow interface gbm flux_convective_cloud_rain+snow (kg/m2/s) + call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx) + +! shallow interface gbm flux_convective_cloud_snow (kg/m2/s) + call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx) + +! shallow gbm cloud liquid water (kg/kg) + call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx) + +! shallow gbm cloud ice water (kg/kg) + call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx) + + ! If gravity waves from shallow convection are on, output this field. + if (use_gw_convect_sh) then + call pbuf_add_field('TTEND_SH','physpkg',dtype_r8,(/pcols,pver/),ttend_sh_idx) + end if + + if (shallow_scheme .eq. 'UNICON') then + call unicon_cam_register() + end if + + end subroutine convect_shallow_register + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + + subroutine convect_shallow_init(pref_edge, pbuf2d) + + !------------------------------------------------------------------------------- ! + ! Purpose : Declare output fields, and initialize variables needed by convection ! + !------------------------------------------------------------------------------- ! + + use cam_history, only : addfld, add_default + use ppgrid, only : pcols, pver + use hk_conv, only : mfinti + use uwshcu, only : init_uwshcu + use unicon_cam, only : unicon_cam_init + use physconst, only : rair, gravit, latvap, rhoh2o, zvir, & + cappa, latice, mwdry, mwh2o + use pmgrid, only : plev, plevp + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use phys_control, only : cam_physpkg_is + + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_set_field + + real(r8), intent(in) :: pref_edge(plevp) ! Reference pressures at interfaces + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer limcnv ! Top interface level limit for convection + integer k + character(len=16) :: eddy_scheme + + ! SPCAM does its own convection + if (shallow_scheme == 'SPCAM') return + + ! ------------------------------------------------- ! + ! Variables for detailed abalysis of UW-ShCu scheme ! + ! ------------------------------------------------- ! + + call addfld( 'qt_pre_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qt_preCU' ) + call addfld( 'sl_pre_Cu', (/ 'lev' /), 'I', 'J/kg', 'sl_preCU' ) + call addfld( 'slv_pre_Cu', (/ 'lev' /), 'I', 'J/kg', 'slv_preCU' ) + call addfld( 'u_pre_Cu', (/ 'lev' /), 'I', 'm/s', 'u_preCU' ) + call addfld( 'v_pre_Cu', (/ 'lev' /), 'I', 'm/s', 'v_preCU' ) + call addfld( 'qv_pre_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qv_preCU' ) + call addfld( 'ql_pre_Cu', (/ 'lev' /), 'I', 'kg/kg', 'ql_preCU' ) + call addfld( 'qi_pre_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qi_preCU' ) + call addfld( 't_pre_Cu', (/ 'lev' /), 'I', 'K', 't_preCU' ) + call addfld( 'rh_pre_Cu', (/ 'lev' /), 'I', '%', 'rh_preCU' ) + + call addfld( 'qt_aft_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qt_afterCU' ) + call addfld( 'sl_aft_Cu', (/ 'lev' /), 'I', 'J/kg', 'sl_afterCU' ) + call addfld( 'slv_aft_Cu', (/ 'lev' /), 'I', 'J/kg', 'slv_afterCU' ) + call addfld( 'u_aft_Cu', (/ 'lev' /), 'I', 'm/s', 'u_afterCU' ) + call addfld( 'v_aft_Cu', (/ 'lev' /), 'I', 'm/s', 'v_afterCU' ) + call addfld( 'qv_aft_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qv_afterCU' ) + call addfld( 'ql_aft_Cu', (/ 'lev' /), 'I', 'kg/kg', 'ql_afterCU' ) + call addfld( 'qi_aft_Cu', (/ 'lev' /), 'I', 'kg/kg', 'qi_afterCU' ) + call addfld( 't_aft_Cu', (/ 'lev' /), 'I', 'K', 't_afterCU' ) + call addfld( 'rh_aft_Cu', (/ 'lev' /), 'I', '%', 'rh_afterCU' ) + + call addfld( 'tten_Cu', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency by cumulus convection' ) + call addfld( 'rhten_Cu', (/ 'lev' /), 'I', '%/s', 'RH tendency by cumumus convection' ) + + ! ------------------------------------------- ! + ! Common Output for Shallow Convection Scheme ! + ! ------------------------------------------- ! + + call addfld( 'CMFDT', (/ 'lev' /), 'A', 'K/s', 'T tendency - shallow convection' ) + call addfld( 'CMFDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'QV tendency - shallow convection' ) + call addfld( 'CMFDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud liq tendency - shallow convection' ) + call addfld( 'CMFDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice tendency - shallow convection' ) + call addfld( 'CMFDQR', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - shallow convection rainout' ) + call addfld( 'EVAPTCM', (/ 'lev' /), 'A', 'K/s', 'T tendency - Evaporation/snow prod from Hack convection' ) + call addfld( 'FZSNTCM', (/ 'lev' /), 'A', 'K/s', 'T tendency - Rain to snow conversion from Hack convection' ) + call addfld( 'EVSNTCM', (/ 'lev' /), 'A', 'K/s', 'T tendency - Snow to rain prod from Hack convection' ) + call addfld( 'EVAPQCM', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Evaporation from Hack convection' ) + call addfld( 'QC', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - shallow convection LW export' ) + call addfld( 'PRECSH', horiz_only, 'A', 'm/s', 'Shallow Convection precipitation rate' ) + call addfld( 'CMFMC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Moist convection (deep+shallow) mass flux' ) + call addfld( 'CMFSL', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection liquid water static energy flux' ) + call addfld( 'CMFLQ', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection total water flux' ) + call addfld( 'CIN', horiz_only, 'A', 'J/kg', 'Convective inhibition' ) + call addfld( 'CBMF', horiz_only, 'A', 'kg/m2/s', 'Cloud base mass flux' ) + call addfld( 'CLDTOP', horiz_only, 'I', '1', 'Vertical index of cloud top' ) + call addfld( 'CLDBOT', horiz_only, 'I', '1', 'Vertical index of cloud base' ) + call addfld( 'PCLDTOP', horiz_only, 'A', '1', 'Pressure of cloud top' ) + call addfld( 'PCLDBOT', horiz_only, 'A', '1', 'Pressure of cloud base' ) + + call addfld( 'FREQSH', horiz_only, 'A', 'fraction', 'Fractional occurance of shallow convection' ) + + call addfld( 'HKFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of precipitation from HK convection' ) + call addfld( 'HKFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of snow from HK convection' ) + call addfld( 'HKNTPRPD', (/ 'lev' /), 'A', 'kg/kg/s', 'Net precipitation production from HK convection' ) + call addfld( 'HKNTSNPD', (/ 'lev' /), 'A', 'kg/kg/s', 'Net snow production from HK convection' ) + call addfld( 'HKEIHEAT', (/ 'lev' /), 'A', 'W/kg', 'Heating by ice and evaporation in HK convection' ) + + call addfld ('ICWMRSH', (/ 'lev' /), 'A', 'kg/kg', 'Shallow Convection in-cloud water mixing ratio ' ) + + if( shallow_scheme .eq. 'UW' ) then + call addfld( 'UWFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of precipitation from UW shallow convection' ) + call addfld( 'UWFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of snow from UW shallow convection' ) + end if + + + + call phys_getopts( eddy_scheme_out = eddy_scheme , & + history_amwg_out = history_amwg , & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + + if( history_budget ) then + call add_default( 'CMFDLIQ ', history_budget_histfile_num, ' ' ) + call add_default( 'CMFDICE ', history_budget_histfile_num, ' ' ) + call add_default( 'CMFDT ', history_budget_histfile_num, ' ' ) + call add_default( 'CMFDQ ', history_budget_histfile_num, ' ' ) + if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + call add_default( 'EVAPQCM ', history_budget_histfile_num, ' ' ) + call add_default( 'EVAPTCM ', history_budget_histfile_num, ' ' ) + end if + end if + pblh_idx = pbuf_get_index('pblh') + + + select case (shallow_scheme) + + case('off') ! None + + if( masterproc ) write(iulog,*) 'convect_shallow_init: shallow convection OFF' + continue + + case('Hack') ! Hack scheme + + qpert_idx = pbuf_get_index('qpert') + + if( masterproc ) write(iulog,*) 'convect_shallow_init: Hack shallow convection' + ! Limit shallow convection to regions below 40 mb + ! Note this calculation is repeated in the deep convection interface + if( pref_edge(1) >= 4.e3_r8 ) then + limcnv = 1 + else + do k = 1, plev + if( pref_edge(k) < 4.e3_r8 .and. pref_edge(k+1) >= 4.e3_r8 ) then + limcnv = k + goto 10 + end if + end do + limcnv = plevp + end if +10 continue + + if( masterproc ) then + write(iulog,*) 'MFINTI: Convection will be capped at intfc ', limcnv, ' which is ', pref_edge(limcnv), ' pascals' + end if + + call mfinti( rair, cpair, gravit, latvap, rhoh2o, limcnv) ! Get args from inti.F90 + + case('UW') ! Park and Bretherton shallow convection scheme + + if( masterproc ) write(iulog,*) 'convect_shallow_init: UW shallow convection scheme (McCaa)' + if( eddy_scheme .ne. 'diag_TKE' ) then + write(iulog,*) 'ERROR: shallow convection scheme ', shallow_scheme, ' is incompatible with eddy scheme ', eddy_scheme + call endrun( 'convect_shallow_init: shallow_scheme and eddy_scheme are incompatible' ) + endif + call init_uwshcu( r8, latvap, cpair, latice, zvir, rair, gravit, mwh2o/mwdry ) + + tke_idx = pbuf_get_index('tke') + + case('UNICON') ! Sungsu Park's General Convection Model + + if ( masterproc ) write(iulog,*) 'convect_shallow_init: General Convection Model by Sungsu Park' + if ( eddy_scheme .ne. 'diag_TKE' ) then + write(iulog,*) eddy_scheme + write(iulog,*) 'ERROR: shallow convection scheme ',shallow_scheme,' is incompatible with eddy scheme ', eddy_scheme + call endrun( 'convect_shallow_init: shallow_scheme and eddy_scheme are incompatible' ) + endif + call unicon_cam_init(pbuf2d) + + end select + + cld_idx = pbuf_get_index('CLD') + concld_idx = pbuf_get_index('CONCLD') + rprddp_idx = pbuf_get_index('RPRDDP') + + call pbuf_set_field(pbuf2d, sh_flxprc_idx, 0._r8) + call pbuf_set_field(pbuf2d, sh_flxsnw_idx, 0._r8) + + end subroutine convect_shallow_init + +!================================================================================================== + + function convect_shallow_use_shfrc() + !-------------------------------------------------------------- ! + ! Return true if cloud fraction should use shallow convection ! + ! calculated convective clouds. ! + !-------------------------------------------------------------- ! + implicit none + logical :: convect_shallow_use_shfrc ! Return value + + if (shallow_scheme .eq. 'UW' .or. shallow_scheme .eq. 'UNICON') then + convect_shallow_use_shfrc = .true. + else + convect_shallow_use_shfrc = .false. + endif + + return + + end function convect_shallow_use_shfrc + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine convect_shallow_tend( ztodt , cmfmc , & + qc , qc2 , rliq , rliq2 , & + state , ptend_all, pbuf, cam_in) + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field, pbuf_old_tim_idx + use cam_history, only : outfld + use physics_types, only : physics_state, physics_ptend + use physics_types, only : physics_ptend_init, physics_update + use physics_types, only : physics_state_copy, physics_state_dealloc + use physics_types, only : physics_ptend_dealloc + use physics_types, only : physics_ptend_sum + use camsrfexch, only : cam_in_t + + use constituents, only : pcnst, cnst_get_ind, cnst_get_type_byind + use hk_conv, only : cmfmca + use uwshcu, only : compute_uwshcu_inv + use unicon_cam, only : unicon_out_t, unicon_cam_tend + + use time_manager, only : get_nstep + use wv_saturation, only : qsat + use physconst, only : latice, latvap, rhoh2o + + use spmd_utils, only : iam + implicit none + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: ztodt ! 2 delta-t [ s ] + + type(physics_ptend), intent(out) :: ptend_all ! Indivdual parameterization tendencies + real(r8), intent(out) :: rliq2(pcols) ! Vertically-integrated reserved cloud condensate [ m/s ] + real(r8), intent(out) :: qc2(pcols,pver) ! Same as qc but only from shallow convection scheme + + + + real(r8), intent(inout) :: cmfmc(pcols,pverp) ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ] + real(r8), intent(inout) :: qc(pcols,pver) ! dq/dt due to export of cloud water into environment by shallow + ! and deep convection [ kg/kg/s ] + real(r8), intent(inout) :: rliq(pcols) ! Vertical integral of qc [ m/s ] + + type(cam_in_t), intent(in) :: cam_in + + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + integer :: i, k, m + integer :: n, x + integer :: ilon ! Global longitude index of a column + integer :: ilat ! Global latitude index of a column + integer :: lchnk ! Chunk identifier + integer :: ncol ! Number of atmospheric columns + integer :: nstep ! Current time step index + integer :: ixcldice, ixcldliq ! Constituent indices for cloud liquid and ice water. + integer :: ixnumice, ixnumliq ! Constituent indices for cloud liquid and ice number concentration + + real(r8), pointer :: precc(:) ! Shallow convective precipitation (rain+snow) rate at surface [ m/s ] + real(r8), pointer :: snow(:) ! Shallow convective snow rate at surface [ m/s ] + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + real(r8) :: cnt2(pcols) ! Top level of shallow convective activity + real(r8) :: cnb2(pcols) ! Bottom level of convective activity + real(r8) :: tpert(pcols) ! PBL perturbation theta + + real(r8), pointer :: pblh(:) ! PBL height [ m ] + real(r8), pointer :: qpert(:,:) ! PBL perturbation specific humidity + + ! Temperature tendency from shallow convection (pbuf pointer). + real(r8), pointer, dimension(:,:) :: ttend_sh + + real(r8) :: ntprprd(pcols,pver) ! Net precip production in layer + real(r8) :: ntsnprd(pcols,pver) ! Net snow production in layer + real(r8) :: tend_s_snwprd(pcols,pver) ! Heating rate of snow production + real(r8) :: tend_s_snwevmlt(pcols,pver) ! Heating rate of evap/melting of snow + real(r8) :: slflx(pcols,pverp) ! Shallow convective liquid water static energy flux + real(r8) :: qtflx(pcols,pverp) ! Shallow convective total water flux + real(r8) :: cmfdqs(pcols, pver) ! Shallow convective snow production + real(r8) :: zero(pcols) ! Array of zeros + real(r8) :: cbmf(pcols) ! Shallow cloud base mass flux [ kg/s/m2 ] + real(r8) :: freqsh(pcols) ! Frequency of shallow convection occurence + real(r8) :: pcnt(pcols) ! Top pressure level of shallow + deep convective activity + real(r8) :: pcnb(pcols) ! Bottom pressure level of shallow + deep convective activity + real(r8) :: cmfsl(pcols,pverp ) ! Convective flux of liquid water static energy + real(r8) :: cmflq(pcols,pverp ) ! Convective flux of total water in energy unit + + real(r8) :: ftem_preCu(pcols,pver) ! Saturation vapor pressure after shallow Cu convection + real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH + real(r8) :: t_preCu(pcols,pver) ! Temperature after shallow Cu convection + real(r8) :: tten(pcols,pver) ! Temperature tendency after shallow Cu convection + real(r8) :: rhten(pcols,pver) ! RH tendency after shallow Cu convection + real(r8) :: iccmr_UW(pcols,pver) ! In-cloud Cumulus LWC+IWC [ kg/m2 ] + real(r8) :: icwmr_UW(pcols,pver) ! In-cloud Cumulus LWC [ kg/m2 ] + real(r8) :: icimr_UW(pcols,pver) ! In-cloud Cumulus IWC [ kg/m2 ] + real(r8) :: ptend_tracer(pcols,pver,pcnst) ! Tendencies of tracers + real(r8) :: sum1, sum2, sum3, pdelx + real(r8) :: landfracdum(pcols) + + real(r8), dimension(pcols,pver) :: sl, qt, slv + real(r8), dimension(pcols,pver) :: sl_preCu, qt_preCu, slv_preCu + + type(physics_state) :: state1 ! Locally modify for evaporation to use, not returned + type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all + + integer itim_old, ifld + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:,:) :: concld + real(r8), pointer, dimension(:,:) :: icwmr ! In cloud water + ice mixing ratio + real(r8), pointer, dimension(:,:) :: rprddp ! dq/dt due to deep convective rainout + real(r8), pointer, dimension(:,:) :: rprdsh ! dq/dt due to deep and shallow convective rainout + real(r8), pointer, dimension(:,:) :: evapcsh ! Evaporation of shallow convective precipitation >= 0. + real(r8), pointer, dimension(:) :: cnt + real(r8), pointer, dimension(:) :: cnb + real(r8), pointer, dimension(:) :: cush + real(r8), pointer, dimension(:,:) :: tke + real(r8), pointer, dimension(:,:) :: shfrc + real(r8), pointer, dimension(:,:) :: flxprec ! Shallow convective-scale flux of precip (rain+snow) at interfaces [ kg/m2/s ] + real(r8), pointer, dimension(:,:) :: flxsnow ! Shallow convective-scale flux of snow at interfaces [ kg/m2/s ] + real(r8), pointer, dimension(:,:) :: sh_cldliq + real(r8), pointer, dimension(:,:) :: sh_cldice + + real(r8), pointer, dimension(:,:) :: cmfmc2 ! (pcols,pverp) Updraft mass flux by shallow convection [ kg/s/m2 ] + real(r8), pointer, dimension(:,:) :: sh_e_ed_ratio ! (pcols,pver) fer/(fer+fdr) from uwschu + + logical :: lq(pcnst) + + type(unicon_out_t) :: unicon_out + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + zero = 0._r8 + nstep = get_nstep() + lchnk = state%lchnk + ncol = state%ncol + + call physics_state_copy( state, state1 ) ! Copy state to local state1. + + ! Associate pointers with physics buffer fields + + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, icwmrsh_idx, icwmr) + + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + call pbuf_get_field(pbuf, cldtop_idx, cnt ) + + call pbuf_get_field(pbuf, cldbot_idx, cnb ) + + call pbuf_get_field(pbuf, prec_sh_idx, precc ) + + call pbuf_get_field(pbuf, snow_sh_idx, snow ) + + if( convect_shallow_use_shfrc() ) then + call pbuf_get_field(pbuf, shfrc_idx, shfrc ) + endif + + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc2) + + ! Initialization + + + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + + call pbuf_get_field(pbuf, pblh_idx, pblh) + + ! This field probably should reference the pbuf tpert field but it doesnt + tpert(:ncol) = 0._r8 + landfracdum(:ncol) = 0._r8 + + select case (shallow_scheme) + + case('off', 'CLUBB_SGS') ! None + + lq(:) = .TRUE. + call physics_ptend_init( ptend_loc, state%psetcols, 'convect_shallow (off)', ls=.true., lq=lq ) ! Initialize local ptend type + + cmfmc2 = 0._r8 + ptend_loc%q = 0._r8 + ptend_loc%s = 0._r8 + rprdsh = 0._r8 + cmfdqs = 0._r8 + precc = 0._r8 + slflx = 0._r8 + qtflx = 0._r8 + icwmr = 0._r8 + rliq2 = 0._r8 + qc2 = 0._r8 + cmfsl = 0._r8 + cmflq = 0._r8 + cnt2 = pver + cnb2 = 1._r8 + evapcsh = 0._r8 + snow = 0._r8 + + case('Hack') ! Hack scheme + + lq(:) = .TRUE. + call physics_ptend_init( ptend_loc, state%psetcols, 'cmfmca', ls=.true., lq=lq ) ! Initialize local ptend type + + call pbuf_get_field(pbuf, qpert_idx, qpert) + qpert(:ncol,2:pcnst) = 0._r8 + + call cmfmca( lchnk , ncol , & + nstep , ztodt , state%pmid , state%pdel , & + state%rpdel , state%zm , tpert , qpert , state%phis , & + pblh , state%t , state%q , ptend_loc%s , ptend_loc%q , & + cmfmc2 , rprdsh , cmfsl , cmflq , precc , & + qc2 , cnt2 , cnb2 , icwmr , rliq2 , & + state%pmiddry, state%pdeldry, state%rpdeldry ) + + case('UW') ! UW shallow convection scheme + + ! -------------------------------------- ! + ! uwshcu does momentum transport as well ! + ! -------------------------------------- ! + + ! Initialize local ptend type + lq(:) = .TRUE. + call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq ) + + call pbuf_get_field(pbuf, cush_idx, cush ,(/1,itim_old/), (/pcols,1/)) + call pbuf_get_field(pbuf, tke_idx, tke) + + + call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec) + call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow) + call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) + + call compute_uwshcu_inv( pcols , pver , ncol , pcnst , ztodt , & + state%pint, state%zi, state%pmid , state%zm , state%pdel , & + state%u , state%v , state%q(:,:,1) , state%q(:,:,ixcldliq), state%q(:,:,ixcldice), & + state%t , state%s , state%q(:,:,:) , & + tke , cld , concld , pblh , cush , & + cmfmc2 , slflx , qtflx , & + flxprec, flxsnow, & + ptend_loc%q(:,:,1) , ptend_loc%q(:,:,ixcldliq), ptend_loc%q(:,:,ixcldice), & + ptend_loc%s , ptend_loc%u , ptend_loc%v , ptend_tracer , & + rprdsh , cmfdqs , precc , snow , & + evapcsh , shfrc , iccmr_UW , icwmr_UW , & + icimr_UW , cbmf , qc2 , rliq2 , & + cnt2 , cnb2 , lchnk , state%pdeldry , & + sh_e_ed_ratio ) + + ! --------------------------------------------------------------------- ! + ! Here, 'rprdsh = qrten', 'cmfdqs = qsten' both in unit of [ kg/kg/s ] ! + ! In addition, define 'icwmr' which includes both liquid and ice. ! + ! --------------------------------------------------------------------- ! + + icwmr(:ncol,:) = iccmr_UW(:ncol,:) + rprdsh(:ncol,:) = rprdsh(:ncol,:) + cmfdqs(:ncol,:) + do m = 4, pcnst + ptend_loc%q(:ncol,:pver,m) = ptend_tracer(:ncol,:pver,m) + enddo + + ! Conservation check + + ! do i = 1, ncol + ! do m = 1, pcnst + ! sum1 = 0._r8 + ! sum2 = 0._r8 + ! sum3 = 0._r8 + ! do k = 1, pver + ! if(cnst_get_type_byind(m).eq.'wet') then + ! pdelx = state%pdel(i,k) + ! else + ! pdelx = state%pdeldry(i,k) + ! endif + ! sum1 = sum1 + state%q(i,k,m)*pdelx + ! sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx + ! sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx + ! enddo + ! if( m .gt. 3 .and. abs(sum1) .gt. 1.e-13_r8 .and. abs(sum2-sum1)/sum1 .gt. 1.e-12_r8 ) then + !! if( m .gt. 3 .and. abs(sum3) .gt. 1.e-13_r8 ) then + ! write(iulog,*) 'Sungsu : convect_shallow.F90 does not conserve tracers : ', m, sum1, sum2, abs(sum2-sum1)/sum1 + !! write(iulog,*) 'Sungsu : convect_shallow.F90 does not conserve tracers : ', m, sum3 + ! endif + ! enddo + ! enddo + + ! ------------------------------------------------- ! + ! Convective fluxes of 'sl' and 'qt' in energy unit ! + ! ------------------------------------------------- ! + + cmfsl(:ncol,:) = slflx(:ncol,:) + cmflq(:ncol,:) = qtflx(:ncol,:) * latvap + + call outfld( 'PRECSH' , precc , pcols, lchnk ) + + + case('UNICON') + + icwmr = 0.0_r8 + + call unicon_cam_tend(ztodt, state, cam_in, & + pbuf, ptend_loc, unicon_out) + + cmfmc2(:ncol,:) = unicon_out%cmfmc(:ncol,:) + qc2(:ncol,:) = unicon_out%rqc(:ncol,:) + rliq2(:ncol) = unicon_out%rliq(:ncol) + cnt2(:ncol) = unicon_out%cnt(:ncol) + cnb2(:ncol) = unicon_out%cnb(:ncol) + + ! ------------------------------------------------- ! + ! Convective fluxes of 'sl' and 'qt' in energy unit ! + ! ------------------------------------------------- ! + + cmfsl(:ncol,:) = unicon_out%slflx(:ncol,:) + cmflq(:ncol,:) = unicon_out%qtflx(:ncol,:) * latvap + + call outfld( 'PRECSH' , precc , pcols, lchnk ) + + end select + + ! --------------------------------------------------------! + ! Calculate fractional occurance of shallow convection ! + ! --------------------------------------------------------! + + ! Modification : I should check whether below computation of freqsh is correct. + + freqsh(:) = 0._r8 + do i = 1, ncol + if( maxval(cmfmc2(i,:pver)) <= 0._r8 ) then + freqsh(i) = 1._r8 + end if + end do + + ! ------------------------------------------------------------------------------ ! + ! Merge shallow convection output with prior results from deep convection scheme ! + ! ------------------------------------------------------------------------------ ! + + ! ----------------------------------------------------------------------- ! + ! Combine cumulus updraft mass flux : 'cmfmc2'(shallow) + 'cmfmc'(deep) ! + ! ----------------------------------------------------------------------- ! + + cmfmc(:ncol,:) = cmfmc(:ncol,:) + cmfmc2(:ncol,:) + + ! -------------------------------------------------------------- ! + ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep ! + ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! + ! cnt2 = float(kpen) ! + ! cnb2 = float(krel - 1) ! + ! Note that indices decreases with height. ! + ! -------------------------------------------------------------- ! + + do i = 1, ncol + if( cnt2(i) < cnt(i)) cnt(i) = cnt2(i) + if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i) + pcnt(i) = state%pmid(i,int(cnt(i))) + pcnb(i) = state%pmid(i,int(cnb(i))) + end do + + ! ----------------------------------------------- ! + ! This quantity was previously known as CMFDQR. ! + ! Now CMFDQR is the shallow rain production only. ! + ! ----------------------------------------------- ! + + + call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/)) + + ! ----------------------------------------------------------------------- ! + ! Add shallow reserved cloud condensate to deep reserved cloud condensate ! + ! qc [ kg/kg/s] , rliq [ m/s ] ! + ! ----------------------------------------------------------------------- ! + + qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver) + rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) + + ! ---------------------------------------------------------------------------- ! + ! Output new partition of cloud condensate variables, as well as precipitation ! + ! ---------------------------------------------------------------------------- ! + + if( microp_scheme == 'MG' ) then + call cnst_get_ind( 'NUMLIQ', ixnumliq ) + call cnst_get_ind( 'NUMICE', ixnumice ) + endif + + ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair + + call outfld( 'ICWMRSH ', icwmr , pcols , lchnk ) + + call outfld( 'CMFDT ', ftem , pcols , lchnk ) + call outfld( 'CMFDQ ', ptend_loc%q(1,1,1) , pcols , lchnk ) + call outfld( 'CMFDICE', ptend_loc%q(1,1,ixcldice) , pcols , lchnk ) + call outfld( 'CMFDLIQ', ptend_loc%q(1,1,ixcldliq) , pcols , lchnk ) + call outfld( 'CMFMC' , cmfmc , pcols , lchnk ) + call outfld( 'QC' , qc2 , pcols , lchnk ) + call outfld( 'CMFDQR' , rprdsh , pcols , lchnk ) + call outfld( 'CMFSL' , cmfsl , pcols , lchnk ) + call outfld( 'CMFLQ' , cmflq , pcols , lchnk ) + call outfld( 'DQP' , qc2 , pcols , lchnk ) + call outfld( 'CLDTOP' , cnt , pcols , lchnk ) + call outfld( 'CLDBOT' , cnb , pcols , lchnk ) + call outfld( 'PCLDTOP', pcnt , pcols , lchnk ) + call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) + call outfld( 'FREQSH' , freqsh , pcols , lchnk ) + + if( shallow_scheme .eq. 'UW' ) then + call outfld( 'CBMF' , cbmf , pcols , lchnk ) + call outfld( 'UWFLXPRC', flxprec , pcols , lchnk ) + call outfld( 'UWFLXSNW' , flxsnow , pcols , lchnk ) + endif + + ! ---------------------------------------------------------------- ! + ! Add tendency from this process to tend from other processes here ! + ! ---------------------------------------------------------------- ! + + call physics_ptend_init(ptend_all, state1%psetcols, 'convect_shallow') + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + + ! ----------------------------------------------------------------------------- ! + ! For diagnostic purpose, print out 'QT,SL,SLV,T,RH' just before cumulus scheme ! + ! ----------------------------------------------------------------------------- ! + + sl_preCu(:ncol,:pver) = state1%s(:ncol,:pver) - latvap * state1%q(:ncol,:pver,ixcldliq) & + - ( latvap + latice) * state1%q(:ncol,:pver,ixcldice) + qt_preCu(:ncol,:pver) = state1%q(:ncol,:pver,1) + state1%q(:ncol,:pver,ixcldliq) & + + state1%q(:ncol,:pver,ixcldice) + slv_preCu(:ncol,:pver) = sl_preCu(:ncol,:pver) * ( 1._r8 + zvir * qt_preCu(:ncol,:pver) ) + + t_preCu(:ncol,:) = state1%t(:ncol,:pver) + call qsat(state1%t(:ncol,:), state1%pmid(:ncol,:), & + tem2(:ncol,:), ftem(:ncol,:)) + ftem_preCu(:ncol,:) = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8 + + call outfld( 'qt_pre_Cu ', qt_preCu , pcols, lchnk ) + call outfld( 'sl_pre_Cu ', sl_preCu , pcols, lchnk ) + call outfld( 'slv_pre_Cu ', slv_preCu , pcols, lchnk ) + call outfld( 'u_pre_Cu ', state1%u , pcols, lchnk ) + call outfld( 'v_pre_Cu ', state1%v , pcols, lchnk ) + call outfld( 'qv_pre_Cu ', state1%q(:,:,1) , pcols, lchnk ) + call outfld( 'ql_pre_Cu ', state1%q(:,:,ixcldliq) , pcols, lchnk ) + call outfld( 'qi_pre_Cu ', state1%q(:,:,ixcldice) , pcols, lchnk ) + call outfld( 't_pre_Cu ', state1%t , pcols, lchnk ) + call outfld( 'rh_pre_Cu ', ftem_preCu , pcols, lchnk ) + + ! ----------------------------------------------- ! + ! Update physics state type state1 with ptend_loc ! + ! ----------------------------------------------- ! + + call physics_update( state1, ptend_loc, ztodt ) + + ! ----------------------------------------------------------------------------- ! + ! For diagnostic purpose, print out 'QT,SL,SLV,t,RH' just after cumulus scheme ! + ! ----------------------------------------------------------------------------- ! + + sl(:ncol,:pver) = state1%s(:ncol,:pver) - latvap * state1%q(:ncol,:pver,ixcldliq) & + - ( latvap + latice) * state1%q(:ncol,:pver,ixcldice) + qt(:ncol,:pver) = state1%q(:ncol,:pver,1) + state1%q(:ncol,:pver,ixcldliq) & + + state1%q(:ncol,:pver,ixcldice) + slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir * qt(:ncol,:pver) ) + + call qsat(state1%t(:ncol,:), state1%pmid(:ncol,:), & + tem2(:ncol,:), ftem(:ncol,:)) + ftem(:ncol,:) = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8 + + call outfld( 'qt_aft_Cu ', qt , pcols, lchnk ) + call outfld( 'sl_aft_Cu ', sl , pcols, lchnk ) + call outfld( 'slv_aft_Cu ', slv , pcols, lchnk ) + call outfld( 'u_aft_Cu ', state1%u , pcols, lchnk ) + call outfld( 'v_aft_Cu ', state1%v , pcols, lchnk ) + call outfld( 'qv_aft_Cu ', state1%q(:,:,1) , pcols, lchnk ) + call outfld( 'ql_aft_Cu ', state1%q(:,:,ixcldliq) , pcols, lchnk ) + call outfld( 'qi_aft_Cu ', state1%q(:,:,ixcldice) , pcols, lchnk ) + call outfld( 't_aft_Cu ', state1%t , pcols, lchnk ) + call outfld( 'rh_aft_Cu ', ftem , pcols, lchnk ) + + tten(:ncol,:) = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt + rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt + + call outfld( 'tten_Cu ', tten , pcols, lchnk ) + call outfld( 'rhten_Cu ', rhten , pcols, lchnk ) + + + ! ------------------------------------------------------------------------ ! + ! UW-Shallow Cumulus scheme includes ! + ! evaporation physics inside in it. So when 'shallow_scheme = UW', we must ! + ! NOT perform below 'zm_conv_evap'. ! + ! ------------------------------------------------------------------------ ! + + if( shallow_scheme .eq. 'Hack' ) then + + ! ------------------------------------------------------------------------------- ! + ! Determine the phase of the precipitation produced and add latent heat of fusion ! + ! Evaporate some of the precip directly into the environment (Sundqvist) ! + ! Allow this to use the updated state1 and a fresh ptend_loc type ! + ! Heating and specific humidity tendencies produced ! + ! ------------------------------------------------------------------------------- ! + + ! --------------------------------- ! + ! initialize ptend for next process ! + ! --------------------------------- ! + + lq(1) = .TRUE. + lq(2:) = .FALSE. + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + + call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec ) + call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow ) + call pbuf_get_field(pbuf, sh_cldliq_idx, sh_cldliq ) + call pbuf_get_field(pbuf, sh_cldice_idx, sh_cldice ) + + !! clouds have no water... :) + sh_cldliq(:ncol,:) = 0._r8 + sh_cldice(:ncol,:) = 0._r8 + + call zm_conv_evap( state1%ncol, state1%lchnk, & + state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & + landfracdum, & + ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & + ptend_loc%q(:pcols,:pver,1), & + rprdsh, cld, ztodt, & + precc, snow, ntprprd, ntsnprd , flxprec, flxsnow ) + + ! ------------------------------------------ ! + ! record history variables from zm_conv_evap ! + ! ------------------------------------------ ! + + evapcsh(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) + + ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver) / cpair + call outfld( 'EVAPTCM ' , ftem , pcols, lchnk ) + ftem(:ncol,:pver) = tend_s_snwprd(:ncol,:pver) / cpair + call outfld( 'FZSNTCM ' , ftem , pcols, lchnk ) + ftem(:ncol,:pver) = tend_s_snwevmlt(:ncol,:pver) / cpair + call outfld( 'EVSNTCM ' , ftem , pcols, lchnk ) + call outfld( 'EVAPQCM ' , ptend_loc%q(1,1,1) , pcols, lchnk ) + call outfld( 'PRECSH ' , precc , pcols, lchnk ) + call outfld( 'HKFLXPRC' , flxprec , pcols, lchnk ) + call outfld( 'HKFLXSNW' , flxsnow , pcols, lchnk ) + call outfld( 'HKNTPRPD' , ntprprd , pcols, lchnk ) + call outfld( 'HKNTSNPD' , ntsnprd , pcols, lchnk ) + call outfld( 'HKEIHEAT' , ptend_loc%s , pcols, lchnk ) + + ! ---------------------------------------------------------------- ! + ! Add tendency from this process to tend from other processes here ! + ! ---------------------------------------------------------------- ! + + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + call physics_ptend_dealloc(ptend_loc) + + ! -------------------------------------------- ! + ! Do not perform evaporation process for UW-Cu ! + ! -------------------------------------------- ! + + end if + + ! ------------------------------------------------------------- ! + ! Update name of parameterization tendencies to send to tphysbc ! + ! ------------------------------------------------------------- ! + + call physics_state_dealloc(state1) + + ! If we added temperature tendency to pbuf, set it now. + if (ttend_sh_idx > 0) then + call pbuf_get_field(pbuf, ttend_sh_idx, ttend_sh) + ttend_sh(:ncol,:pver) = ptend_all%s(:ncol,:pver)/cpair + end if + + end subroutine convect_shallow_tend + + end module convect_shallow diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 new file mode 100644 index 0000000000..b92f592fd8 --- /dev/null +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -0,0 +1,3543 @@ +module cospsimulator_intr + ! ###################################################################################### + ! Purpose: CAM interface to + ! Name: CFMIP Observational Simulator Package Version 2 (COSP2) + ! What: Simulate ISCCP/CloudSat/CALIPSO/MISR/MODIS cloud products from + ! GCM inputs + ! Version: v2.0 (August 2017) + ! Authors: Dustin Swales (dustin.swales@noaa.gov) + ! + ! Modifications: + ! + ! ###################################################################################### + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use perf_mod, only: t_startf, t_stopf + use cam_abortutils, only: endrun + use phys_control, only: cam_physpkg_is + use cam_logfile, only: iulog +#ifdef USE_COSP + use quickbeam, only: radar_cfg + use mod_quickbeam_optics, only: size_distribution + use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs + use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, & + tau_binEdges, & + cloudsat_binCenters, & + cloudsat_binEdges, & + calipso_binCenters, & + calipso_binEdges, & + misr_histHgtCenters, & + misr_histHgtEdges, & + nsza_cosp => PARASOL_NREFL, & + PARASOL_SZA, & + nprs_cosp => npres, & + ntau_cosp => ntau, & + ntau_cosp_modis => ntau, & + ndbze_cosp => DBZE_BINS, & + nsr_cosp => SR_BINS, & + nhtmisr_cosp => numMISRHgtBins, & + nhydro => N_HYDRO, & + R_UNDEF,PARASOL_NREFL,LIDAR_NCAT,SR_BINS, & + N_HYDRO,RTTOV_MAX_CHANNELS,numMISRHgtBins,& + DBZE_BINS,LIDAR_NTEMP,calipso_histBsct, & + numMODISTauBins,numMODISPresBins, & + numMODISReffIceBins,numMODISReffLiqBins, & + numISCCPTauBins,numISCCPPresBins, & + numMISRTauBins,reffICE_binEdges, & + reffICE_binCenters,reffLIQ_binEdges, & + reffLIQ_binCenters +#endif + + implicit none + private + save + + ! Public functions/subroutines + public :: & + cospsimulator_intr_readnl, & + cospsimulator_intr_register,& + cospsimulator_intr_init, & + cospsimulator_intr_run + + ! ###################################################################################### + ! Public declarations + ! ###################################################################################### + ! Whether to do COSP calcs and I/O, default is false. If docosp is specified in + ! the atm_in namelist, this value is overwritten and cosp is run + logical, public :: docosp = .false. + + ! Frequency at which cosp is called, every cosp_nradsteps radiation timestep + integer, public :: cosp_nradsteps = 1! CAM namelist variable default, not in COSP namelist + +#ifdef USE_COSP + + ! ###################################################################################### + ! Local declarations + ! ###################################################################################### + integer, parameter :: & + nhtml_cosp = pver ! Mumber of model levels is pver + integer :: & + nscol_cosp, & ! Number of subcolumns, use namelist input Ncolumns to set. + nht_cosp ! Number of height for COSP radar and lidar simulator outputs. + ! *set to 40 if csat_vgrid=.true., else set to Nlr* + + ! ###################################################################################### + ! Bin-boundaries for mixed dimensions. Calculated in cospsetupvales OR in cosp_config.F90 + ! ###################################################################################### + real(r8), target :: prsmid_cosp(nprs_cosp) ! pressure midpoints of COSP ISCCP output + real(r8), target :: prslim_cosp(2,nprs_cosp) + real(r8), target :: taumid_cosp(ntau_cosp) ! optical depth midpoints of COSP ISCCP output + real(r8), target :: taulim_cosp(2,ntau_cosp) + real(r8), target :: srmid_cosp(nsr_cosp) ! sr midpoints of COSP lidar output + real(r8), target :: srlim_cosp(2,nsr_cosp) + real(r8), target :: sza_cosp(nsza_cosp) + real(r8), target :: dbzemid_cosp(ndbze_cosp) ! dbze midpoints of COSP radar output + real(r8), target :: dbzelim_cosp(2,ndbze_cosp) + real(r8), target :: htmisrmid_cosp(nhtmisr_cosp) ! htmisr midpoints of COSP misr simulator output + real(r8), target :: htmisrlim_cosp(2,nhtmisr_cosp) + real(r8), target :: taumid_cosp_modis(ntau_cosp_modis)! optical depth midpoints of COSP MODIS output + real(r8), target :: taulim_cosp_modis(2,ntau_cosp_modis) + real(r8), target :: reffICE_binEdges_cosp(2,numMODISReffIceBins) + real(r8), target :: reffLIQ_binEdges_cosp(2,numMODISReffLiqBins) + real(r8), target :: reffICE_binCenters_cosp(numMODISReffIceBins) + real(r8), target :: reffLIQ_binCenters_cosp(numMODISReffLiqBins) + + real(r8) :: htmlmid_cosp(nhtml_cosp) ! Model level height midpoints for output + integer :: prstau_cosp(nprs_cosp*ntau_cosp) ! ISCCP mixed output dimension index + integer :: prstau_cosp_modis(nprs_cosp*ntau_cosp_modis) ! MODIS mixed output dimension index + integer :: htmisrtau_cosp(nhtmisr_cosp*ntau_cosp) ! MISR mixed output dimension index + real(r8) :: prstau_prsmid_cosp(nprs_cosp*ntau_cosp) + real(r8) :: prstau_taumid_cosp(nprs_cosp*ntau_cosp) + real(r8) :: prstau_prsmid_cosp_modis(nprs_cosp*ntau_cosp_modis) + real(r8) :: prstau_taumid_cosp_modis(nprs_cosp*ntau_cosp_modis) + real(r8) :: htmisrtau_htmisrmid_cosp(nhtmisr_cosp*ntau_cosp) + real(r8) :: htmisrtau_taumid_cosp(nhtmisr_cosp*ntau_cosp) + real(r8),allocatable, public :: htdbze_dbzemid_cosp(:) ! (nht_cosp*ndbze_cosp) + real(r8),allocatable, target :: htlim_cosp(:,:) ! height limits for COSP outputs (nht_cosp+1) + real(r8),allocatable, target :: htmid_cosp(:) ! height midpoints of COSP radar/lidar output (nht_cosp) + real(r8),allocatable :: htlim_cosp_1d(:) ! height limits for COSP outputs (nht_cosp+1) + real(r8),allocatable :: htdbze_htmid_cosp(:) ! (nht_cosp*ndbze_cosp) + real(r8),allocatable :: htsr_htmid_cosp(:) ! (nht_cosp*nsr_cosp) + real(r8),allocatable :: htsr_srmid_cosp(:) ! (nht_cosp*nsr_cosp) + real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nhtml_cosp*nscol_cosp) + real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nhtml_cosp*nscol_cosp) + integer, allocatable, target :: scol_cosp(:) ! sub-column number (nscol_cosp) + integer, allocatable :: htdbze_cosp(:) ! radar CFAD mixed output dimension index (nht_cosp*ndbze_cosp) + integer, allocatable :: htsr_cosp(:) ! lidar CFAD mixed output dimension index (nht_cosp*nsr_cosp) + integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nhtml_cosp*nscol_cosp) + + ! ###################################################################################### + ! Default namelists + ! The CAM and COSP namelists defaults are set below. Some of the COSP namelist + ! variables are part of the CAM namelist - they all begin with "cosp_" to keep their + ! names specific to COSP. I set their CAM namelist defaults here, not in namelist_defaults_cam.xml + ! Variables identified as namelist variables are defined in + ! ../models/atm/cam/bld/namelist_files/namelist_definition.xml + ! ###################################################################################### + ! CAM + logical :: cosp_sample_atrain = .false. ! CAM namelist variable default, not in COSP namelist + character(len=256) :: cosp_atrainorbitdata ! CAM namelist variable, no default, need to specify! + logical :: cosp_amwg = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_lite = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_passive = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_active = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_isccp = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_cfmip_3hr = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_cfmip_da = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_cfmip_off = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_cfmip_mon = .false. ! CAM namelist variable default, not in COSP namelist + logical :: cosp_lradar_sim = .false. ! CAM namelist variable default + logical :: cosp_llidar_sim = .false. ! CAM namelist variable default + logical :: cosp_lisccp_sim = .false. ! CAM namelist variable default + logical :: cosp_lmisr_sim = .false. ! CAM namelist variable default + logical :: cosp_lmodis_sim = .false. ! CAM namelist variable default + logical :: cosp_histfile_aux = .false. ! CAM namelist variable default + logical :: cosp_lfrac_out = .false. ! CAM namelist variable default + logical :: cosp_runall = .false. ! flag to run all of the cosp simulator package + integer :: cosp_ncolumns = 50 ! CAM namelist variable default + integer :: cosp_histfile_num =1 ! CAM namelist variable default, not in COSP namelist + integer :: cosp_histfile_aux_num =-1 ! CAM namelist variable default, not in COSP namelist + + ! COSP + logical :: lradar_sim = .false. ! COSP namelist variable, can be changed from default by CAM namelist + logical :: llidar_sim = .false. ! "" + logical :: lparasol_sim = .false. ! +cosp2 + logical :: lisccp_sim = .false. ! "" + logical :: lmisr_sim = .false. ! "" + logical :: lmodis_sim = .false. ! "" + logical :: lrttov_sim = .false. ! not running rttov, always set to .false. + logical :: lfrac_out = .false. ! COSP namelist variable, can be changed from default by CAM namelist + + ! ###################################################################################### + ! COSP parameters + ! ###################################################################################### + ! Note: Unless otherwise specified, these are parameters that cannot be set by the CAM namelist. + integer, parameter :: Npoints_it = 10000 ! Max # gridpoints to be processed in one iteration (10,000) + integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50), can be changed from default by CAM namelist + integer :: nlr = 40 ! Number of levels in statistical outputs + ! (only used if USE_VGRID=.true.) (40) + logical :: use_vgrid = .true. ! Use fixed vertical grid for outputs? + ! (if .true. then define # of levels with nlr) (.true.) + logical :: csat_vgrid = .true. ! CloudSat vertical grid? + ! (if .true. then the CloudSat standard grid is used. + ! If set, overides use_vgrid.) (.true.) + ! namelist variables for COSP input related to radar simulator + real(r8) :: radar_freq = 94.0_r8 ! CloudSat radar frequency (GHz) (94.0) + integer :: surface_radar = 0 ! surface=1, spaceborne=0 (0) + integer :: use_mie_tables = 0 ! use a precomputed lookup table? yes=1,no=0 (0) + integer :: use_gas_abs = 1 ! include gaseous absorption? yes=1,no=0 (1) + integer :: do_ray = 0 ! calculate/output Rayleigh refl=1, not=0 (0) + integer :: melt_lay = 0 ! melting layer model off=0, on=1 (0) + real(r8) :: k2 = -1 ! |K|^2, -1=use frequency dependent default (-1) + ! namelist variables for COSP input related to lidar simulator + integer, parameter :: Nprmts_max_hydro = 12 ! Max # params for hydrometeor size distributions (12) + integer, parameter :: Naero = 1 ! Number of aerosol species (Not used) (1) + integer, parameter :: Nprmts_max_aero = 1 ! Max # params for aerosol size distributions (not used) (1) + integer :: lidar_ice_type = 0 ! Ice particle shape in lidar calculations + ! (0=ice-spheres ; 1=ice-non-spherical) (0) + integer, parameter :: overlap = 3 ! overlap type: 1=max, 2=rand, 3=max/rand (3) + + !! namelist variables for COSP input related to ISCCP simulator + integer :: isccp_topheight = 1 ! 1 = adjust top height using both a computed infrared + ! brightness temperature and the visible + ! optical depth to adjust cloud top pressure. + ! Note that this calculation is most appropriate to compare + ! to ISCCP data during sunlit hours. + ! 2 = do not adjust top height, that is cloud top pressure + ! is the actual cloud top pressure in the model + ! 3 = adjust top height using only the computed infrared + ! brightness temperature. Note that this calculation is most + ! appropriate to compare to ISCCP IR only algortihm (i.e. + ! you can compare to nighttime ISCCP data with this option) (1) + integer :: isccp_topheight_direction = 2 ! direction for finding atmosphere pressure level with + ! interpolated temperature equal to the radiance + ! determined cloud-top temperature + ! 1 = find the *lowest* altitude (highest pressure) level + ! with interpolated temperature + ! equal to the radiance determined cloud-top temperature + ! 2 = find the *highest* altitude (lowest pressure) level + ! with interpolated temperature + ! equal to the radiance determined cloud-top temperature + ! ONLY APPLICABLE IF top_height EQUALS 1 or 3 + ! 1 = default setting in COSP v1.1, matches all versions of + ! ISCCP simulator with versions numbers 3.5.1 and lower + ! 2 = default setting in COSP v1.3. default since V4.0 of ISCCP simulator + + ! ###################################################################################### + ! Other variables + ! ###################################################################################### + logical,allocatable :: first_run_cosp(:) !.true. if run_cosp has been populated (allocatable->begchunk:endchunk) + logical,allocatable :: run_cosp(:,:) !.true. if cosp should be run by column and + ! chunk (allocatable->1:pcols,begchunk:endchunk) + ! pbuf indices + integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx + integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx + integer :: shcldliq_idx, shcldice_idx, shcldliq1_idx, shcldice1_idx, dpflxprc_idx + integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx + integer :: rei_idx, rel_idx + + ! ###################################################################################### + ! Declarations specific to COSP2 + ! ###################################################################################### + type(radar_cfg) :: rcfg_cloudsat ! Radar configuration (Cloudsat) + type(radar_cfg), allocatable :: rcfg_cs(:) ! chunked version of rcfg_cloudsat + type(size_distribution) :: sd ! Size distribution used by radar simulator + type(size_distribution), allocatable :: sd_cs(:) ! chunked version of sd + character(len=64) :: cloudsat_micro_scheme = 'MMF_v3.5_single_moment' + + integer,parameter :: & + I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid + I_LSCICE = 2, & ! Large-scale (stratiform) ice + I_LSRAIN = 3, & ! Large-scale (stratiform) rain + I_LSSNOW = 4, & ! Large-scale (stratiform) snow + I_CVCLIQ = 5, & ! Convective liquid + I_CVCICE = 6, & ! Convective ice + I_CVRAIN = 7, & ! Convective rain + I_CVSNOW = 8, & ! Convective snow + I_LSGRPL = 9 ! Large-scale (stratiform) groupel + + ! Stratiform and convective clouds in frac_out (scops output). + integer, parameter :: & + I_LSC = 1, & ! Large-scale clouds + I_CVC = 2 ! Convective clouds + + ! Microphysical settings for the precipitation flux to mixing ratio conversion + real(r8),parameter,dimension(nhydro) :: & + ! LSL LSI LSR LSS CVL CVI CVR CVS LSG + N_ax = (/-1._r8, -1._r8, 8.e6_r8, 3.e6_r8, -1._r8, -1._r8, 8.e6_r8, 3.e6_r8, 4.e6_r8/),& + N_bx = (/-1._r8, -1._r8, 0.0_r8, 0.0_r8, -1._r8, -1._r8, 0.0_r8, 0.0_r8, 0.0_r8/),& + alpha_x = (/-1._r8, -1._r8, 0.0_r8, 0.0_r8, -1._r8, -1._r8, 0.0_r8, 0.0_r8, 0.0_r8/),& + c_x = (/-1._r8, -1._r8, 842.0_r8, 4.84_r8, -1._r8, -1._r8, 842.0_r8, 4.84_r8, 94.5_r8/),& + d_x = (/-1._r8, -1._r8, 0.8_r8, 0.25_r8, -1._r8, -1._r8, 0.8_r8, 0.25_r8, 0.5_r8/),& + g_x = (/-1._r8, -1._r8, 0.5_r8, 0.5_r8, -1._r8, -1._r8, 0.5_r8, 0.5_r8, 0.5_r8/),& + a_x = (/-1._r8, -1._r8, 524.0_r8, 52.36_r8, -1._r8, -1._r8, 524.0_r8, 52.36_r8, 209.44_r8/),& + b_x = (/-1._r8, -1._r8, 3.0_r8, 3.0_r8, -1._r8, -1._r8, 3.0_r8, 3.0_r8, 3.0_r8/),& + gamma_1 = (/-1._r8, -1._r8, 17.83725_r8, 8.284701_r8, -1._r8, -1._r8, 17.83725_r8, 8.284701_r8, 11.63230_r8/),& + gamma_2 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/),& + gamma_3 = (/-1._r8, -1._r8, 2.0_r8, 2.0_r8, -1._r8, -1._r8, 2.0_r8, 2.0_r8, 2.0_r8/),& + gamma_4 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/) +#endif + +CONTAINS + + ! ###################################################################################### + ! SUBROUTINE setcosp2values + ! ###################################################################################### +#ifdef USE_COSP + subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nradsteps_in) + use mod_cosp, only: cosp_init + use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z + use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init + ! Inputs + integer, intent(in) :: Nlr_in ! Number of vertical levels for CALIPSO and Cloudsat products + integer, intent(in) :: Ncolumns_in ! Number of sub-columns + integer, intent(in) :: cosp_nradsteps_in ! How often to call COSP? + logical, intent(in) :: use_vgrid_in ! Logical switch to use interpolated, to Nlr_in, grid for CALIPSO and Cloudsat + logical, intent(in) :: csat_vgrid_in ! + + ! Local + logical :: ldouble=.false. + logical :: lsingle=.true. ! Default is to use single moment + integer :: i,k + + prsmid_cosp = pres_binCenters + prslim_cosp = pres_binEdges + taumid_cosp = tau_binCenters + taulim_cosp = tau_binEdges + srmid_cosp = calipso_binCenters + srlim_cosp = calipso_binEdges + sza_cosp = parasol_sza + dbzemid_cosp = cloudsat_binCenters + dbzelim_cosp = cloudsat_binEdges + htmisrmid_cosp = misr_histHgtCenters + htmisrlim_cosp = misr_histHgtEdges + taumid_cosp_modis = tau_binCenters + taulim_cosp_modis = tau_binEdges + reffICE_binCenters_cosp = reffICE_binCenters + reffICE_binEdges_cosp = reffICE_binEdges + reffLIQ_binCenters_cosp = reffLIQ_binCenters + reffLIQ_binEdges_cosp = reffLIQ_binEdges + + ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in + ! cosp_defs.f. + if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then + ldouble = .true. + lsingle = .false. + endif + call hydro_class_init(lsingle,ldouble,sd) + call quickbeam_optics_init() + + ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is + ! now donein cosp_init, but these fields are stored in cosp_config.F90. + ! Additionally all static fields used by the individual simulators are set up by calls + ! to _init functions in cosp_init. + call COSP_INIT(Lisccp_sim,Lmodis_sim,Lmisr_sim,Lradar_sim,Llidar_sim,Lparasol_sim,Lrttov_sim, & + radar_freq,k2,use_gas_abs,do_ray,isccp_topheight,isccp_topheight_direction, & + surface_radar,rcfg_cloudsat,use_vgrid_in,csat_vgrid_in,Nlr_in,pver, & + cloudsat_micro_scheme) + + ! Set number of sub-columns, from namelist + nscol_cosp = Ncolumns_in + + if (use_vgrid_in) then !! using fixed vertical grid + if (csat_vgrid_in) then + nht_cosp = 40 + else + nht_cosp = Nlr_in + endif + endif + + ! Set COSP call frequency, from namelist. + cosp_nradsteps = cosp_nradsteps_in + + ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90. + ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM + ! are calculated here. + ! Allocate + allocate(htlim_cosp(2,nht_cosp),htlim_cosp_1d(nht_cosp+1),htmid_cosp(nht_cosp),scol_cosp(nscol_cosp), & + htdbze_cosp(nht_cosp*ndbze_cosp),htsr_cosp(nht_cosp*nsr_cosp),htmlscol_cosp(nhtml_cosp*nscol_cosp),& + htdbze_htmid_cosp(nht_cosp*ndbze_cosp),htdbze_dbzemid_cosp(nht_cosp*ndbze_cosp), & + htsr_htmid_cosp(nht_cosp*nsr_cosp),htsr_srmid_cosp(nht_cosp*nsr_cosp), & + htmlscol_htmlmid_cosp(nhtml_cosp*nscol_cosp),htmlscol_scol_cosp(nhtml_cosp*nscol_cosp)) + + ! DJS2017: Just pull from cosp_config + if (use_vgrid_in) then + htlim_cosp_1d(1) = vgrid_zu(1) + htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl + endif + htmid_cosp = vgrid_z + htlim_cosp(1,:) = vgrid_zu + htlim_cosp(2,:) = vgrid_zl + + scol_cosp(:) = (/(k,k=1,nscol_cosp)/) + + ! Just using an index here, model height is a prognostic variable + htmlmid_cosp(:) = (/(k,k=1,nhtml_cosp)/) + + ! assign mixed dimensions an integer index for cam_history.F90 + do k=1,nprs_cosp*ntau_cosp + prstau_cosp(k) = k + end do + do k=1,nprs_cosp*ntau_cosp_modis + prstau_cosp_modis(k) = k + end do + do k=1,nht_cosp*ndbze_cosp + htdbze_cosp(k) = k + end do + do k=1,nht_cosp*nsr_cosp + htsr_cosp(k) = k + end do + do k=1,nhtml_cosp*nscol_cosp + htmlscol_cosp(k) = k + end do + do k=1,nhtmisr_cosp*ntau_cosp + htmisrtau_cosp(k) = k + end do + + ! next, assign collapsed reference vectors for cam_history.F90 + ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc. + ! actual output is specified in cospsimulator1_intr.F90 + do k=1,nprs_cosp + prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k) + prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis) + prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k) + enddo + + do k=1,nht_cosp + htdbze_dbzemid_cosp(ndbze_cosp*(k-1)+1:k*ndbze_cosp)=dbzemid_cosp(1:ndbze_cosp) + htdbze_htmid_cosp(ndbze_cosp*(k-1)+1:k*ndbze_cosp)=htmid_cosp(k) + enddo + + do k=1,nht_cosp + htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp) + htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k) + enddo + + do k=1,nhtml_cosp + htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp) + htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k) + enddo + + do k=1,nhtmisr_cosp + htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k) + enddo + + end subroutine setcosp2values +#endif + + ! ###################################################################################### + ! SUBROUTINE cospsimulator_intr_readnl + ! + ! PURPOSE: to read namelist variables and run setcospvalues subroutine.note: cldfrc_readnl + ! is a good template in cloud_fraction.F90. Make sure that this routine is reading in a + ! namelist. models/atm/cam/bld/build-namelist is the perl script to check. + ! ###################################################################################### + subroutine cospsimulator_intr_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit +#ifdef SPMD + use mpishorthand, only: mpicom, mpilog, mpiint, mpichar +#endif + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in) + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cospsimulator_intr_readnl' + +#ifdef USE_COSP +!!! this list should include any variable that you might want to include in the namelist +!!! philosophy is to not include COSP output flags but just important COSP settings and cfmip controls. + namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, cosp_atrainorbitdata, cosp_cfmip_3hr, cosp_cfmip_da, & + cosp_cfmip_mon, cosp_cfmip_off, cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & + cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_ncolumns, & + cosp_nradsteps, cosp_passive, cosp_sample_atrain, cosp_runall + + !! read in the namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) !! presumably opens the namelist file "nlfile" + !! position the file to write to the cospsimulator portion of the cam_in namelist + call find_group_name(unitn, 'cospsimulator_nl', status=ierr) + if (ierr == 0) then + read(unitn, cospsimulator_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(docosp, 1, mpilog, 0, mpicom) + ! call mpibcast(cosp_atrainorbitdata, len(cosp_atrainorbitdata), mpichar, 0, mpicom) + call mpibcast(cosp_amwg, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lite, 1, mpilog, 0, mpicom) + call mpibcast(cosp_passive, 1, mpilog, 0, mpicom) + call mpibcast(cosp_active, 1, mpilog, 0, mpicom) + call mpibcast(cosp_isccp, 1, mpilog, 0, mpicom) + call mpibcast(cosp_runall, 1, mpilog, 0, mpicom) + call mpibcast(cosp_cfmip_3hr, 1, mpilog, 0, mpicom) + call mpibcast(cosp_cfmip_da, 1, mpilog, 0, mpicom) + call mpibcast(cosp_cfmip_mon, 1, mpilog, 0, mpicom) + call mpibcast(cosp_cfmip_off, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lfrac_out, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lradar_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_llidar_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lisccp_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lmisr_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_lmodis_sim, 1, mpilog, 0, mpicom) + call mpibcast(cosp_ncolumns, 1, mpiint, 0, mpicom) + ! call mpibcast(cosp_sample_atrain, 1, mpilog, 0, mpicom) + call mpibcast(cosp_histfile_num, 1, mpiint, 0, mpicom) + call mpibcast(cosp_histfile_aux_num,1, mpiint, 0, mpicom) + call mpibcast(cosp_histfile_aux, 1, mpilog, 0, mpicom) + call mpibcast(cosp_nradsteps, 1, mpiint, 0, mpicom) +#endif + + !! reset COSP namelist variables based on input from cam namelist variables + !DJS2017: The parasol simulator is now separate from the lidar simulator. To maintain consistency, just + ! mirror whatever the lidar simulator is doing + if (cosp_cfmip_3hr) then + lradar_sim = .true. + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + end if + if (cosp_cfmip_da) then + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + end if + if (cosp_cfmip_off) then + lradar_sim = .true. + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + end if + if (cosp_cfmip_mon) then + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + end if + + if (cosp_lfrac_out) then + lfrac_out = .true. + end if + if (cosp_lradar_sim) then + lradar_sim = .true. + end if + if (cosp_llidar_sim) then + llidar_sim = .true. + lparasol_sim = .true. + end if + if (cosp_lisccp_sim) then + lisccp_sim = .true. + end if + if (cosp_lmisr_sim) then + lmisr_sim = .true. + end if + if (cosp_lmodis_sim) then + lmodis_sim = .true. + end if + + if (cosp_histfile_aux .and. cosp_histfile_aux_num == -1) then + cosp_histfile_aux_num = cosp_histfile_num + end if + + if (cosp_lite) then + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + lmisr_sim = .true. + lmodis_sim = .true. + cosp_ncolumns = 10 + cosp_nradsteps = 3 + end if + + if (cosp_passive) then + lisccp_sim = .true. + lmisr_sim = .true. + lmodis_sim = .true. + cosp_ncolumns = 10 + cosp_nradsteps = 3 + end if + + if (cosp_active) then + lradar_sim = .true. + llidar_sim = .true. + lparasol_sim = .true. + cosp_ncolumns = 10 + cosp_nradsteps = 3 + end if + + if (cosp_isccp) then + lisccp_sim = .true. + cosp_ncolumns = 10 + cosp_nradsteps = 3 + end if + + if (cosp_runall) then + lradar_sim = .true. + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + lmisr_sim = .true. + lmodis_sim = .true. + lfrac_out = .true. + end if + + !! if no simulators are turned on at all and docosp is, set cosp_amwg = .true. + if((docosp) .and. (.not.lradar_sim) .and. (.not.llidar_sim) .and. (.not.lisccp_sim) .and. & + (.not.lmisr_sim) .and. (.not.lmodis_sim)) then + cosp_amwg = .true. + end if + if (cosp_amwg) then + lradar_sim = .true. + llidar_sim = .true. + lparasol_sim = .true. + lisccp_sim = .true. + lmisr_sim = .true. + lmodis_sim = .true. + cosp_ncolumns = 10 + cosp_nradsteps = 3 + end if + + !! reset COSP namelist variables based on input from cam namelist variables + if (cosp_ncolumns .ne. ncolumns) then + ncolumns = cosp_ncolumns + end if + + ! *NOTE* COSP is configured in CAM such that if a simulator is requested, all diagnostics + ! are output. So no need turn on/aff outputs if simulator is requested. + + ! Set vertical coordinate, subcolumn, and calculation frequency cosp options based on namelist inputs + call setcosp2values(nlr,use_vgrid,csat_vgrid,ncolumns,cosp_nradsteps) + + if (masterproc) then + if (docosp) then + write(iulog,*)'COSP configuration:' + write(iulog,*)' Number of COSP subcolumns = ', cosp_ncolumns + write(iulog,*)' Frequency at which cosp is called = ', cosp_nradsteps + write(iulog,*)' Enable radar simulator = ', lradar_sim + write(iulog,*)' Enable lidar simulator = ', llidar_sim + write(iulog,*)' Enable ISCCP simulator = ', lisccp_sim + write(iulog,*)' Enable MISR simulator = ', lmisr_sim + write(iulog,*)' Enable MODIS simulator = ', lmodis_sim + write(iulog,*)' RADAR_SIM microphysics scheme = ', trim(cloudsat_micro_scheme) + write(iulog,*)' Write COSP output to history file = ', cosp_histfile_num + write(iulog,*)' Write COSP input fields = ', cosp_histfile_aux + write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num + write(iulog,*)' Write COSP subcolumn fields = ', cosp_lfrac_out + else + write(iulog,*)'COSP not enabled' + end if + end if +#endif + end subroutine cospsimulator_intr_readnl + + ! ###################################################################################### + ! SUBROUTINE cospsimulator_intr_register + ! ###################################################################################### + subroutine cospsimulator_intr_register() + + use cam_history_support, only: add_hist_coord + +#ifdef USE_COSP + ! register non-standard variable dimensions + if (lisccp_sim .or. lmodis_sim) then + call add_hist_coord('cosp_prs', nprs_cosp, 'COSP Mean ISCCP pressure', & + 'hPa', prsmid_cosp, bounds_name='cosp_prs_bnds', bounds=prslim_cosp) + end if + + if (lisccp_sim .or. lmisr_sim) then + call add_hist_coord('cosp_tau', ntau_cosp, & + 'COSP Mean ISCCP optical depth', '1', taumid_cosp, & + bounds_name='cosp_tau_bnds', bounds=taulim_cosp) + end if + + if (lisccp_sim .or. llidar_sim .or. lradar_sim .or. lmisr_sim) then + call add_hist_coord('cosp_scol', nscol_cosp, 'COSP subcolumn', & + values=scol_cosp) + end if + + if (llidar_sim .or. lradar_sim) then + call add_hist_coord('cosp_ht', nht_cosp, & + 'COSP Mean Height for lidar and radar simulator outputs', 'm', & + htmid_cosp, bounds_name='cosp_ht_bnds', bounds=htlim_cosp, & + vertical_coord=.true.) + end if + + if (llidar_sim) then + call add_hist_coord('cosp_sr', nsr_cosp, & + 'COSP Mean Scattering Ratio for lidar simulator CFAD output', '1', & + srmid_cosp, bounds_name='cosp_sr_bnds', bounds=srlim_cosp) + end if + + if (llidar_sim) then + call add_hist_coord('cosp_sza', nsza_cosp, 'COSP Parasol SZA', & + 'degrees', sza_cosp) + end if + + if (lradar_sim) then + call add_hist_coord('cosp_dbze', ndbze_cosp, & + 'COSP Mean dBZe for radar simulator CFAD output', 'dBZ', & + dbzemid_cosp, bounds_name='cosp_dbze_bnds', bounds=dbzelim_cosp) + end if + + if (lmisr_sim) then + call add_hist_coord('cosp_htmisr', nhtmisr_cosp, 'COSP MISR height', & + 'km', htmisrmid_cosp, & + bounds_name='cosp_htmisr_bnds', bounds=htmisrlim_cosp) + end if + + if (lmodis_sim) then + call add_hist_coord('cosp_tau_modis', ntau_cosp_modis, & + 'COSP Mean MODIS optical depth', '1', taumid_cosp_modis, & + bounds_name='cosp_tau_modis_bnds', bounds=taulim_cosp_modis) + call add_hist_coord('cosp_reffice',numMODISReffIceBins, & + 'COSP Mean MODIS effective radius (ice)', 'microns', reffICE_binCenters_cosp, & + bounds_name='cosp_reffice_bnds',bounds=reffICE_binEdges_cosp) + call add_hist_coord('cosp_reffliq',numMODISReffLiqBins, & + 'COSP Mean MODIS effective radius (liquid)', 'microns', reffLIQ_binCenters_cosp, & + bounds_name='cosp_reffliq_bnds',bounds=reffLIQ_binEdges_cosp) + end if + +#endif + end subroutine cospsimulator_intr_register + + ! ###################################################################################### + ! SUBROUTINE cospsimulator_intr_init + ! ###################################################################################### + subroutine cospsimulator_intr_init() + +#ifdef USE_COSP + + use cam_history, only: addfld, add_default, horiz_only +#ifdef SPMD + use mpishorthand, only : mpir8, mpiint, mpicom +#endif + use netcdf, only : nf90_open, nf90_inq_varid, nf90_get_var, nf90_close, nf90_nowrite + use error_messages, only : handle_ncerr, alloc_err + + use physics_buffer, only: pbuf_get_index + + use mod_cosp_config, only : R_UNDEF + + integer :: ncid,latid,lonid,did,hrid,minid,secid, istat + integer :: i + + ! ISCCP OUTPUTS + if (lisccp_sim) then + !! addfld calls for all + !*cfMon,cfDa* clisccp2 (time,tau,plev,profile), CFMIP wants 7 p bins, 7 tau bins + call addfld('FISCCP1_COSP',(/'cosp_tau','cosp_prs'/),'A','percent', & + 'Grid-box fraction covered by each ISCCP D level cloud type',& + flag_xyfill=.true., fill_value=R_UNDEF) + + !*cfMon,cfDa* tclisccp (time,profile), CFMIP wants "gridbox mean cloud cover from ISCCP" + call addfld('CLDTOT_ISCCP', horiz_only,'A','percent', & + 'Total Cloud Fraction Calculated by the ISCCP Simulator ',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfDa* albisccp (time,profile) + ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) + call addfld('MEANCLDALB_ISCCP',horiz_only,'A','1','Mean cloud albedo*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfDa* ctpisccp (time,profile) + ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) + call addfld('MEANPTOP_ISCCP',horiz_only,'A','Pa','Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., & + fill_value=R_UNDEF) + ! tauisccp (time,profile) + ! For averaging, weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) + call addfld ('MEANTAU_ISCCP',horiz_only,'A','1','Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., & + fill_value=R_UNDEF) + ! meantbisccp (time,profile), at 10.5 um + call addfld ('MEANTB_ISCCP',horiz_only,'A','K','Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., & + fill_value=R_UNDEF) + ! meantbclrisccp (time,profile) + call addfld ('MEANTBCLR_ISCCP',horiz_only,'A','K','Mean Clear-sky Infrared Tb from ISCCP simulator', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! boxtauisccp (time,column,profile) + call addfld ('TAU_ISCCP',(/'cosp_scol'/),'I','1','Optical Depth in each Subcolumn',flag_xyfill=.true., fill_value=R_UNDEF) + ! boxptopisccp (time,column,profile) + call addfld ('CLDPTOP_ISCCP',(/'cosp_scol'/),'I','Pa','Cloud Top Pressure in each Subcolumn', & + flag_xyfill=.true., fill_value=R_UNDEF) + + ! add_default calls for CFMIP experiments or else all fields are added to history file + ! except those with sub-column dimension + if (cosp_cfmip_mon.or.cosp_cfmip_da) then + !! add cfmip-requested variables to two separate cam history files + if (cosp_cfmip_da) then + call add_default ('FISCCP1_COSP',2,' ') + call add_default ('CLDTOT_ISCCP',2,' ') + call add_default ('MEANCLDALB_ISCCP',2,' ') + call add_default ('MEANPTOP_ISCCP',2,' ') + end if + if (cosp_cfmip_mon) then + call add_default ('FISCCP1_COSP',1,' ') + call add_default ('CLDTOT_ISCCP',1,' ') + call add_default ('MEANCLDALB_ISCCP',1,' ') + call add_default ('MEANPTOP_ISCCP',1,' ') + end if + else + !! add all isccp outputs to the history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('FISCCP1_COSP',cosp_histfile_num,' ') + call add_default ('CLDTOT_ISCCP',cosp_histfile_num,' ') + call add_default ('MEANCLDALB_ISCCP',cosp_histfile_num,' ') + call add_default ('MEANPTOP_ISCCP',cosp_histfile_num,' ') + call add_default ('MEANTAU_ISCCP',cosp_histfile_num,' ') + call add_default ('MEANTB_ISCCP',cosp_histfile_num,' ') + call add_default ('MEANTBCLR_ISCCP',cosp_histfile_num,' ') + end if + end if + + ! LIDAR SIMULATOR OUTPUTS + if (llidar_sim) then + !! addfld calls for all + !*cfMon,cfOff,cfDa,cf3hr* cllcalipso (time,profile) + call addfld('CLDLOW_CAL',horiz_only,'A','percent','Lidar Low-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfOff,cfDa,cf3hr* clmcalipso (time,profile) + call addfld('CLDMED_CAL',horiz_only,'A','percent','Lidar Mid-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfOff,cfDa,cf3hr* clhcalipso (time,profile) + call addfld('CLDHGH_CAL',horiz_only,'A','percent','Lidar High-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfOff,cfDa,cf3hr* cltcalipso (time,profile) + call addfld('CLDTOT_CAL',horiz_only,'A','percent','Lidar Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfOff,cfDa,cf3hr* clcalipso (time,height,profile) + call addfld('CLD_CAL',(/'cosp_ht'/),'A','percent','Lidar Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) + !*cfMon,cfOff,cfDa,cf3hr* parasol_refl (time,sza,profile) + call addfld ('RFL_PARASOL',(/'cosp_sza'/),'A','fraction','PARASOL-like mono-directional reflectance ', & + flag_xyfill=.true., fill_value=R_UNDEF) + !*cfOff,cf3hr* cfad_lidarsr532 (time,height,scat_ratio,profile), %11%, default is 40 vert levs, 15 SR bins + call addfld('CFAD_SR532_CAL',(/'cosp_sr','cosp_ht'/),'A','fraction', & + 'Lidar Scattering Ratio CFAD (532 nm)', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! beta_mol532 (time,height_mlev,profile) + call addfld ('MOL532_CAL',(/'lev'/),'A','m-1sr-1','Lidar Molecular Backscatter (532 nm) ', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! atb532 (time,height_mlev,column,profile) + call addfld ('ATB532_CAL',(/'cosp_scol','lev '/),'I','no_unit_log10(x)', & + 'Lidar Attenuated Total Backscatter (532 nm) in each Subcolumn', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsoliq (time,alt40,loc) !!+cosp1.4 + call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A','percent', 'Lidar Liquid Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsoice (time,alt40,loc) + call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A','percent', 'Lidar Ice Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsoun (time,alt40,loc) + call addfld('CLD_CAL_UN', (/'cosp_ht'/),'A','percent', 'Lidar Undefined-Phase Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsotmp (time,alt40,loc) + call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsotmpliq (time,alt40,loc) + call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsotmpice (time,alt40,loc) + call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclcalipsotmpun (time,alt40,loc) + call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcltcalipsoice (time,loc) + call addfld('CLDTOT_CAL_ICE', horiz_only,'A','percent','Lidar Total Ice Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcltcalipsoliq (time,loc) + call addfld('CLDTOT_CAL_LIQ', horiz_only,'A','percent','Lidar Total Liquid Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcltcalipsoun (time,loc) + call addfld('CLDTOT_CAL_UN',horiz_only,'A','percent','Lidar Total Undefined-Phase Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclhcalipsoice (time,loc) + call addfld('CLDHGH_CAL_ICE',horiz_only,'A','percent','Lidar High-level Ice Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclhcalipsoliq (time,loc) + call addfld('CLDHGH_CAL_LIQ',horiz_only,'A','percent','Lidar High-level Liquid Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclhcalipsoun (time,loc) + call addfld('CLDHGH_CAL_UN',horiz_only,'A','percent','Lidar High-level Undefined-Phase Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclmcalipsoice (time,loc) + call addfld('CLDMED_CAL_ICE',horiz_only,'A','percent','Lidar Mid-level Ice Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclmcalipsoliq (time,loc) + call addfld('CLDMED_CAL_LIQ',horiz_only,'A','percent','Lidar Mid-level Liquid Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lclmcalipsoun (time,loc) + call addfld('CLDMED_CAL_UN',horiz_only,'A','percent','Lidar Mid-level Undefined-Phase Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcllcalipsoice (time,loc) + call addfld('CLDLOW_CAL_ICE',horiz_only,'A','percent','Lidar Low-level Ice Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcllcalipsoliq (time,loc) + call addfld('CLDLOW_CAL_LIQ',horiz_only,'A','percent','Lidar Low-level Liquid Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! lcllcalipsoun (time,loc) !+cosp1.4 + call addfld('CLDLOW_CAL_UN',horiz_only,'A','percent','Lidar Low-level Undefined-Phase Cloud Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + + ! add_default calls for CFMIP experiments or else all fields are added to history file + ! except those with sub-column dimension/experimental variables + if (cosp_cfmip_mon .or. cosp_cfmip_off .or. cosp_cfmip_da .or. cosp_cfmip_3hr) then + if (cosp_cfmip_da) then + call add_default ('CLDLOW_CAL',2,' ') + call add_default ('CLDMED_CAL',2,' ') + call add_default ('CLDHGH_CAL',2,' ') + call add_default ('CLDTOT_CAL',2,' ') + call add_default ('CLD_CAL',2,' ') + call add_default ('RFL_PARASOL',2,' ') + end if + if (cosp_cfmip_mon.or.cosp_cfmip_off) then + call add_default ('CLDLOW_CAL',1,' ') + call add_default ('CLDMED_CAL',1,' ') + call add_default ('CLDHGH_CAL',1,' ') + call add_default ('CLDTOT_CAL',1,' ') + call add_default ('CLD_CAL',1,' ') + call add_default ('RFL_PARASOL',1,' ') + end if + if (cosp_cfmip_3hr) then + call add_default ('CFAD_SR532_CAL',3,' ') + call add_default ('CLDLOW_CAL',3,' ') + call add_default ('CLDMED_CAL',3,' ') + call add_default ('CLDHGH_CAL',3,' ') + call add_default ('CLDTOT_CAL',3,' ') + call add_default ('CLD_CAL',3,' ') + call add_default ('RFL_PARASOL',3,' ') + end if + if (cosp_cfmip_off) then + call add_default ('CFAD_SR532_CAL',1,' ') + end if + else + !! add all lidar outputs to the history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('CLDLOW_CAL',cosp_histfile_num,' ') + call add_default ('CLDMED_CAL',cosp_histfile_num,' ') + call add_default ('CLDHGH_CAL',cosp_histfile_num,' ') + call add_default ('CLDTOT_CAL',cosp_histfile_num,' ') + call add_default ('CLD_CAL',cosp_histfile_num,' ') + call add_default ('RFL_PARASOL',cosp_histfile_num,' ') + call add_default ('CFAD_SR532_CAL',cosp_histfile_num,' ') + call add_default ('CLD_CAL_LIQ',cosp_histfile_num,' ') !+COSP1.4 + call add_default ('CLD_CAL_ICE',cosp_histfile_num,' ') + call add_default ('CLD_CAL_UN',cosp_histfile_num,' ') + call add_default ('CLDTOT_CAL_ICE',cosp_histfile_num,' ') + call add_default ('CLDTOT_CAL_LIQ',cosp_histfile_num,' ') + call add_default ('CLDTOT_CAL_UN',cosp_histfile_num,' ') + call add_default ('CLDHGH_CAL_ICE',cosp_histfile_num,' ') + call add_default ('CLDHGH_CAL_LIQ',cosp_histfile_num,' ') + call add_default ('CLDHGH_CAL_UN',cosp_histfile_num,' ') + call add_default ('CLDMED_CAL_ICE',cosp_histfile_num,' ') + call add_default ('CLDMED_CAL_LIQ',cosp_histfile_num,' ') + call add_default ('CLDMED_CAL_UN',cosp_histfile_num,' ') + call add_default ('CLDLOW_CAL_ICE',cosp_histfile_num,' ') + call add_default ('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') + call add_default ('CLDLOW_CAL_UN',cosp_histfile_num,' ') !!+COSP1.4 + + if ((.not.cosp_amwg) .and. (.not.cosp_lite) .and. (.not.cosp_passive) .and. (.not.cosp_active) & + .and. (.not.cosp_isccp)) then + call add_default ('MOL532_CAL',cosp_histfile_num,' ') + end if + end if + end if + + ! RADAR SIMULATOR OUTPUTS + if (lradar_sim) then + + allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk)) + do i = begchunk, endchunk + sd_cs(i) = sd + rcfg_cs(i) = rcfg_cloudsat + end do + + ! addfld calls + !*cfOff,cf3hr* cfad_dbze94 (time,height,dbze,profile), default is 40 vert levs, 15 dBZ bins + call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/),'A','fraction',& + 'Radar Reflectivity Factor CFAD (94 GHz)',& + flag_xyfill=.true., fill_value=R_UNDEF) + !*cfOff,cf3hr* clcalipso2 (time,height,profile) + call addfld ('CLD_CAL_NOTCS',(/'cosp_ht'/),'A','percent','Cloud occurrence seen by CALIPSO but not CloudSat ', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! cltlidarradar (time,profile) + call addfld ('CLDTOT_CALCS',horiz_only,'A','percent',' Lidar and Radar Total Cloud Fraction ',flag_xyfill=.true., & + fill_value=R_UNDEF) + call addfld ('CLDTOT_CS',horiz_only,'A','percent',' Radar total cloud amount ',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CLDTOT_CS2',horiz_only,'A','percent', & + ' Radar total cloud amount without the data for the first kilometer above surface ', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! dbze94 (time,height_mlev,column,profile),! height_mlevel = height when vgrid_in = .true. (default) + call addfld ('DBZE_CS',(/'cosp_scol','lev '/),'I','dBZe',' Radar dBZe (94 GHz) in each Subcolumn',& + flag_xyfill=.true., fill_value=R_UNDEF) + + ! add_default calls for CFMIP experiments or else all fields are added to history file except those with sub-column dimension + if (cosp_cfmip_off.or.cosp_cfmip_3hr) then + if (cosp_cfmip_3hr) then + call add_default ('CFAD_DBZE94_CS',3,' ') + call add_default ('CLD_CAL_NOTCS',3,' ') + end if + if (cosp_cfmip_off) then + call add_default ('CFAD_DBZE94_CS',1,' ') + call add_default ('CLD_CAL_NOTCS',1,' ') + end if + else + !! add all radar outputs to the history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('CFAD_DBZE94_CS',cosp_histfile_num,' ') + call add_default ('CLD_CAL_NOTCS',cosp_histfile_num,' ') + call add_default ('CLDTOT_CALCS',cosp_histfile_num,' ') + call add_default ('CLDTOT_CS',cosp_histfile_num,' ') + call add_default ('CLDTOT_CS2',cosp_histfile_num,' ') + end if + end if + + ! MISR SIMULATOR OUTPUTS + if (lmisr_sim) then + ! clMISR (time,tau,CTH_height_bin,profile) + call addfld ('CLD_MISR',(/'cosp_tau ','cosp_htmisr'/),'A','percent','Cloud Fraction from MISR Simulator', & + flag_xyfill=.true., fill_value=R_UNDEF) + !! add all misr outputs to the history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('CLD_MISR',cosp_histfile_num,' ') + end if + + ! MODIS OUTPUT + if (lmodis_sim) then + ! float cltmodis ( time, loc ) + call addfld ('CLTMODIS',horiz_only,'A','%','MODIS Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float clwmodis ( time, loc ) + call addfld ('CLWMODIS',horiz_only,'A','%','MODIS Liquid Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float climodis ( time, loc ) + call addfld ('CLIMODIS',horiz_only,'A','%','MODIS Ice Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float clhmodis ( time, loc ) + call addfld ('CLHMODIS',horiz_only,'A','%','MODIS High Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float clmmodis ( time, loc ) + call addfld ('CLMMODIS',horiz_only,'A','%','MODIS Mid Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float cllmodis ( time, loc ) + call addfld ('CLLMODIS',horiz_only,'A','%','MODIS Low Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) + ! float tautmodis ( time, loc ) + call addfld ('TAUTMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness*CLTMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float tauwmodis ( time, loc ) + call addfld ('TAUWMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness*CLWMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float tauimodis ( time, loc ) + call addfld ('TAUIMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness*CLIMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float tautlogmodis ( time, loc ) + call addfld ('TAUTLOGMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float tauwlogmodis ( time, loc ) + call addfld ('TAUWLOGMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float tauilogmodis ( time, loc ) + call addfld ('TAUILOGMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float reffclwmodis ( time, loc ) + call addfld ('REFFCLWMODIS',horiz_only,'A','m','MODIS Liquid Cloud Particle Size*CLWMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float reffclimodis ( time, loc ) + call addfld ('REFFCLIMODIS',horiz_only,'A','m','MODIS Ice Cloud Particle Size*CLIMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float pctmodis ( time, loc ) + call addfld ('PCTMODIS',horiz_only,'A','Pa','MODIS Cloud Top Pressure*CLTMODIS',flag_xyfill=.true., fill_value=R_UNDEF) + ! float lwpmodis ( time, loc ) + call addfld ('LWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Liquid Water Path*CLWMODIS', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float iwpmodis ( time, loc ) + call addfld ('IWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Ice Water Path*CLIMODIS',flag_xyfill=.true., fill_value=R_UNDEF) + ! float clmodis ( time, plev, tau, loc ) + call addfld ('CLMODIS',(/'cosp_tau_modis','cosp_prs '/),'A','%','MODIS Cloud Area Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float clrimodis ( time, plev, tau, loc ) + call addfld ('CLRIMODIS',(/'cosp_tau_modis','cosp_reffice '/),'A','%','MODIS Cloud Area Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + ! float clrlmodis ( time, plev, tau, loc ) + call addfld ('CLRLMODIS',(/'cosp_tau_modis','cosp_reffliq '/),'A','%','MODIS Cloud Area Fraction', & + flag_xyfill=.true., fill_value=R_UNDEF) + + !! add MODIS output to history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('CLTMODIS',cosp_histfile_num,' ') + call add_default ('CLWMODIS',cosp_histfile_num,' ') + call add_default ('CLIMODIS',cosp_histfile_num,' ') + call add_default ('CLHMODIS',cosp_histfile_num,' ') + call add_default ('CLMMODIS',cosp_histfile_num,' ') + call add_default ('CLLMODIS',cosp_histfile_num,' ') + call add_default ('TAUTMODIS',cosp_histfile_num,' ') + call add_default ('TAUWMODIS',cosp_histfile_num,' ') + call add_default ('TAUIMODIS',cosp_histfile_num,' ') + call add_default ('TAUTLOGMODIS',cosp_histfile_num,' ') + call add_default ('TAUWLOGMODIS',cosp_histfile_num,' ') + call add_default ('TAUILOGMODIS',cosp_histfile_num,' ') + call add_default ('REFFCLWMODIS',cosp_histfile_num,' ') + call add_default ('REFFCLIMODIS',cosp_histfile_num,' ') + call add_default ('PCTMODIS',cosp_histfile_num,' ') + call add_default ('LWPMODIS',cosp_histfile_num,' ') + call add_default ('IWPMODIS',cosp_histfile_num,' ') + call add_default ('CLMODIS',cosp_histfile_num,' ') + call add_default ('CLRIMODIS',cosp_histfile_num,' ') + call add_default ('CLRLMODIS',cosp_histfile_num,' ') + end if + + ! SUB-COLUMN OUTPUT + if (lfrac_out) then + ! frac_out (time,height_mlev,column,profile) + call addfld ('SCOPS_OUT',(/'cosp_scol','lev '/),'I','0=nocld,1=strcld,2=cnvcld','SCOPS Subcolumn output', & + flag_xyfill=.true., fill_value=R_UNDEF) + !! add scops ouptut to history file specified by the CAM namelist variable cosp_histfile_num + call add_default ('SCOPS_OUT',cosp_histfile_num,' ') + ! save sub-column outputs from ISCCP if ISCCP is run + if (lisccp_sim) then + call add_default ('TAU_ISCCP',cosp_histfile_num,' ') + call add_default ('CLDPTOP_ISCCP',cosp_histfile_num,' ') + end if + ! save sub-column outputs from lidar if lidar is run + if (llidar_sim) then + call add_default ('ATB532_CAL',cosp_histfile_num,' ') + end if + ! save sub-column outputs from radar if radar is run + if (lradar_sim) then + call add_default ('DBZE_CS',cosp_histfile_num,' ') + end if + end if + + !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE + !! Note: A suggestion was to add all of the CAM variables needed to add to make it possible to run COSP off-line + !! These fields are available and can be called from the namelist though. Here, when the cosp_runall mode is invoked + !! all of the inputs are saved on the cam history file. This is good de-bugging functionality we should maintain. + if (cosp_histfile_aux) then + call addfld ('PS_COSP', horiz_only, 'I','Pa', 'PS_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('TS_COSP', horiz_only, 'I','K', 'TS_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('P_COSP', (/ 'lev'/), 'I','Pa', 'P_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('PH_COSP', (/ 'lev'/), 'I','Pa', 'PH_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_COSP', (/ 'lev'/), 'I','m', 'ZLEV_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_HALF_COSP', (/ 'lev'/), 'I','m', 'ZLEV_HALF_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('T_COSP', (/ 'lev'/), 'I','K', 'T_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('RH_COSP', (/ 'lev'/), 'I','percent','RH_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('Q_COSP', (/ 'lev'/), 'I','kg/kg', 'Q_COSP', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('TAU_067', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 0.67micron optical depth', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('EMISS_11', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 11micron emissivity', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Assymetry parameter (MODIS)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_betatot', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_betatot_ice', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_betatot_liq', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_tautot', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_tautot_ice', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CAL_tautot_liq', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_z_vol', (/'cosp_scol','lev '/), 'I','1', 'Effective reflectivity factor (CLOUDSAT)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_kr_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (hydro) (CLOUDSAT)', & + flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_g_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (gases) (CLOUDSAT)', & + flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default ('PS_COSP', cosp_histfile_aux_num,' ') + call add_default ('TS_COSP', cosp_histfile_aux_num,' ') + call add_default ('P_COSP', cosp_histfile_aux_num,' ') + call add_default ('PH_COSP', cosp_histfile_aux_num,' ') + call add_default ('ZLEV_COSP', cosp_histfile_aux_num,' ') + call add_default ('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ') + call add_default ('T_COSP', cosp_histfile_aux_num,' ') + call add_default ('RH_COSP', cosp_histfile_aux_num,' ') + call add_default ('TAU_067', cosp_histfile_aux_num,' ') + call add_default ('EMISS_11', cosp_histfile_aux_num,' ') + call add_default ('MODIS_fracliq', cosp_histfile_aux_num,' ') + call add_default ('MODIS_asym', cosp_histfile_aux_num,' ') + call add_default ('MODIS_ssa', cosp_histfile_aux_num,' ') + call add_default ('CAL_betatot', cosp_histfile_aux_num,' ') + call add_default ('CAL_betatot_ice', cosp_histfile_aux_num,' ') + call add_default ('CAL_betatot_liq', cosp_histfile_aux_num,' ') + call add_default ('CAL_tautot', cosp_histfile_aux_num,' ') + call add_default ('CAL_tautot_ice', cosp_histfile_aux_num,' ') + call add_default ('CAL_tautot_liq', cosp_histfile_aux_num,' ') + call add_default ('CS_z_vol', cosp_histfile_aux_num,' ') + call add_default ('CS_kr_vol', cosp_histfile_aux_num,' ') + call add_default ('CS_g_vol', cosp_histfile_aux_num,' ') + end if + + rei_idx = pbuf_get_index('REI') + rel_idx = pbuf_get_index('REL') + cld_idx = pbuf_get_index('CLD') + concld_idx = pbuf_get_index('CONCLD') + lsreffrain_idx = pbuf_get_index('LS_REFFRAIN') + lsreffsnow_idx = pbuf_get_index('LS_REFFSNOW') + cvreffliq_idx = pbuf_get_index('CV_REFFLIQ') + cvreffice_idx = pbuf_get_index('CV_REFFICE') + dpcldliq_idx = pbuf_get_index('DP_CLDLIQ') + dpcldice_idx = pbuf_get_index('DP_CLDICE') + shcldliq_idx = pbuf_get_index('SH_CLDLIQ') + shcldice_idx = pbuf_get_index('SH_CLDICE') + shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1') + shcldice1_idx = pbuf_get_index('SH_CLDICE1') + dpflxprc_idx = pbuf_get_index('DP_FLXPRC') + dpflxsnw_idx = pbuf_get_index('DP_FLXSNW') + shflxprc_idx = pbuf_get_index('SH_FLXPRC') + shflxsnw_idx = pbuf_get_index('SH_FLXSNW') + lsflxprc_idx = pbuf_get_index('LS_FLXPRC') + lsflxsnw_idx = pbuf_get_index('LS_FLXSNW') + + allocate(first_run_cosp(begchunk:endchunk)) + first_run_cosp(begchunk:endchunk)=.true. + allocate(run_cosp(1:pcols,begchunk:endchunk)) + run_cosp(1:pcols,begchunk:endchunk)=.false. + +#endif + end subroutine cospsimulator_intr_init + + ! ###################################################################################### + ! SUBROUTINE cospsimulator_intr_run + ! ###################################################################################### + subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,snow_tau_in,snow_emis_in) + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use camsrfexch, only: cam_in_t + use constituents, only: cnst_get_ind + use rad_constituents, only: rad_cnst_get_gas + use wv_saturation, only: qsat_water + use interpolate_data, only: lininterp_init,lininterp,lininterp_finish,interp_type + use physconst, only: pi, gravit + use cam_history, only: outfld,hist_fld_col_active + use cam_history_support, only: max_fieldname_len + use cmparray_mod, only: CmpDayNite, ExpDayNite +#ifdef USE_COSP + use mod_cosp_config, only: R_UNDEF,parasol_nrefl,Nlvgrid + use mod_cosp, only: cosp_simulator + use mod_quickbeam_optics, only: size_distribution +#endif + + ! ###################################################################################### + ! Inputs + ! ###################################################################################### + type(physics_state), intent(in),target :: state + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: emis(pcols,pver) ! cloud longwave emissivity + real(r8), intent(in) :: coszrs(pcols) ! cosine solar zenith angle (to tell if day or night) + real(r8), intent(in),optional :: cld_swtau_in(pcols,pver) ! RRTM cld_swtau_in, read in using this variable + real(r8), intent(in),optional :: snow_tau_in(pcols,pver) ! RRTM grid-box mean SW snow optical depth, used for CAM5 simulations + real(r8), intent(in),optional :: snow_emis_in(pcols,pver) ! RRTM grid-box mean LW snow optical depth, used for CAM5 simulations + +#ifdef USE_COSP + ! ###################################################################################### + ! Local variables + ! ###################################################################################### + integer :: lchnk ! chunk identifier + integer :: ncol ! number of active atmospheric columns + integer :: i,k,ip,it,ipt,ih,id,ihd,is,ihs,isc,ihsc,ihm,ihmt,ihml,itim_old,ifld + + ! Variables for day/nite and orbital subsetting + ! Gathered indicies of day and night columns + ! chunk_column_index = IdxDay(daylight_column_index) + integer :: Nday ! Number of daylight columns + integer :: Nno ! Number of columns not using for simulator + integer, dimension(pcols) :: IdxDay ! Indices of daylight columns + integer, dimension(pcols) :: IdxNo ! Indices of columns not using for simulator + real(r8) :: tmp(pcols) ! tempororary variable for array expansion + real(r8) :: tmp1(pcols,pver) ! tempororary variable for array expansion + real(r8) :: tmp2(pcols,pver) ! tempororary variable for array expansion + real(r8) :: lon_cosp_day(pcols) ! tempororary variable for sunlit lons + real(r8) :: lat_cosp_day(pcols) ! tempororary variable for sunlit lats + real(r8) :: ptop_day(pcols,pver) ! tempororary variable for sunlit ptop + real(r8) :: pmid_day(pcols,pver) ! tempororary variable for sunlit pmid + real(r8) :: ztop_day(pcols,pver) ! tempororary variable for sunlit ztop + real(r8) :: zmid_day(pcols,pver) ! tempororary variable for sunlit zmid + real(r8) :: t_day(pcols,pver) ! tempororary variable for sunlit t + real(r8) :: rh_day(pcols,pver) ! tempororary variable for sunlit rh + real(r8) :: q_day(pcols,pver) ! tempororary variable for sunlit q + real(r8) :: concld_day(pcols,pver) ! tempororary variable for sunlit concld + real(r8) :: cld_day(pcols,pver) ! tempororary variable for sunlit cld + real(r8) :: ps_day(pcols) ! tempororary variable for sunlit ps + real(r8) :: ts_day(pcols) ! tempororary variable for sunlit ts + real(r8) :: landmask_day(pcols) ! tempororary variable for sunlit landmask + real(r8) :: o3_day(pcols,pver) ! tempororary variable for sunlit o3 + real(r8) :: us_day(pcols) ! tempororary variable for sunlit us + real(r8) :: vs_day(pcols) ! tempororary variable for sunlit vs + real(r8) :: mr_lsliq_day(pcols,pver) ! tempororary variable for sunlit mr_lsliq + real(r8) :: mr_lsice_day(pcols,pver) ! tempororary variable for sunlit mr_lsice + real(r8) :: mr_ccliq_day(pcols,pver) ! tempororary variable for sunlit mr_ccliq + real(r8) :: mr_ccice_day(pcols,pver) ! tempororary variable for sunlit mr_ccice + real(r8) :: rain_ls_interp_day(pcols,pver) ! tempororary variable for sunlit rain_ls_interp + real(r8) :: snow_ls_interp_day(pcols,pver) ! tempororary variable for sunlit snow_ls_interp + real(r8) :: grpl_ls_interp_day(pcols,pver) ! tempororary variable for sunlit grpl_ls_interp + real(r8) :: rain_cv_interp_day(pcols,pver) ! tempororary variable for sunlit rain_cv_interp + real(r8) :: snow_cv_interp_day(pcols,pver) ! tempororary variable for sunlit snow_cv_interp + real(r8) :: reff_cosp_day(pcols,pver,nhydro) ! tempororary variable for sunlit reff_cosp(:,:,:) + real(r8) :: dtau_s_day(pcols,pver) ! tempororary variable for sunlit dtau_s + real(r8) :: dtau_c_day(pcols,pver) ! tempororary variable for sunlit dtau_c + real(r8) :: dtau_s_snow_day(pcols,pver) ! tempororary variable for sunlit dtau_s_snow + real(r8) :: dem_s_day(pcols,pver) ! tempororary variable for sunlit dem_s + real(r8) :: dem_c_day(pcols,pver) ! tempororary variable for sunlit dem_c + real(r8) :: dem_s_snow_day(pcols,pver) ! tempororary variable for sunlit dem_s_snow + + ! Constants for optical depth calculation (from radcswmx.F90) + real(r8), parameter :: abarl = 2.817e-02_r8 ! A coefficient for extinction optical depth + real(r8), parameter :: bbarl = 1.305_r8 ! b coefficient for extinction optical depth + real(r8), parameter :: abari = 3.448e-03_r8 ! A coefficient for extinction optical depth + real(r8), parameter :: bbari = 2.431_r8 ! b coefficient for extinction optical depth + real(r8), parameter :: cldmin = 1.0e-80_r8 ! note: cldmin much less than cldmin from cldnrh + real(r8), parameter :: cldeps = 0.0_r8 + + ! Microphysics variables + integer, parameter :: ncnstmax=4 ! number of constituents + character(len=8), dimension(ncnstmax), parameter :: & ! constituent names + cnst_names = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/) + integer :: ncnst ! number of constituents (can vary) + integer :: ixcldliq ! cloud liquid amount index for state%q + integer :: ixcldice ! cloud ice amount index + integer :: ixnumliq ! cloud liquid number index + integer :: ixnumice ! cloud ice water index + + ! COSP-related local vars + type(cosp_outputs) :: cospOUT ! COSP simulator outputs + type(cosp_optical_inputs) :: cospIN ! COSP optical (or derived?) fields needed by simulators + type(cosp_column_inputs) :: cospstateIN ! COSP model fields needed by simulators + + ! COSP input variables that depend on CAM + ! 1) Npoints = number of gridpoints COSP will process (without subsetting, Npoints=ncol) + ! 2) Nlevels = number of model levels (Nlevels=pver) + real(r8), parameter :: time = 1.0_r8 ! time ! Time since start of run [days], set to 1 bc running over single CAM timestep + real(r8), parameter :: time_bnds(2)=(/0.5_r8,1.5_r8/) ! time_bnds ! Time boundaries - new in cosp v1.3, set following cosp_test.f90 line 121 + integer :: Npoints ! Number of gridpoints COSP will process + integer :: Nlevels ! Nlevels + logical :: use_reff ! True if effective radius to be used by radar simulator + ! (always used by lidar) + logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm + real(r8), parameter :: emsfc_lw = 0.99_r8 ! longwave emissivity of surface at 10.5 microns + ! set value same as in cloudsimulator.F90 + + ! Local vars related to calculations to go from CAM input to COSP input + ! cosp convective value includes both deep and shallow convection + real(r8) :: ptop(pcols,pver) ! top interface pressure (Pa) + real(r8) :: ztop(pcols,pver) ! top interface height asl (m) + real(r8) :: pbot(pcols,pver) ! bottom interface pressure (Pa) + real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) + real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) + real(r8) :: lat_cosp(pcols) ! lat for cosp (degrees_north) + real(r8) :: lon_cosp(pcols) ! lon for cosp (degrees_east) + real(r8) :: landmask(pcols) ! landmask (0 or 1) + real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) + real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) + real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) + real(r8) :: rain_cv(pcols,pverp) ! interface flux_convective_cloud_rain (kg m^-2 s^-1) + real(r8) :: snow_cv(pcols,pverp) ! interface flux_convective_cloud_snow (kg m^-2 s^-1) + real(r8) :: rain_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) + real(r8) :: snow_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1) + real(r8) :: grpl_ls_interp(pcols,pver) ! midpoint ls grp flux, should be 0 + real(r8) :: rain_ls_interp(pcols,pver) ! midpoint ls rain flux (kg m^-2 s^-1) + real(r8) :: snow_ls_interp(pcols,pver) ! midpoint ls snow flux + real(r8) :: reff_cosp(pcols,pver,nhydro) ! effective radius for cosp input + real(r8) :: rh(pcols,pver) ! relative_humidity_liquid_water (%) + real(r8) :: es(pcols,pver) ! saturation vapor pressure + real(r8) :: qs(pcols,pver) ! saturation mixing ratio (kg/kg), saturation specific humidity + real(r8) :: cld_swtau(pcols,pver) ! incloud sw tau for input to COSP + real(r8) :: dtau_s(pcols,pver) ! dtau_s - Optical depth of stratiform cloud at 0.67 um + real(r8) :: dtau_c(pcols,pver) ! dtau_c - Optical depth of convective cloud at 0.67 um + real(r8) :: dtau_s_snow(pcols,pver) ! dtau_s_snow - Grid-box mean Optical depth of stratiform snow at 0.67 um + real(r8) :: dem_s(pcols,pver) ! dem_s - Longwave emis of stratiform cloud at 10.5 um + real(r8) :: dem_c(pcols,pver) ! dem_c - Longwave emis of convective cloud at 10.5 um + real(r8) :: dem_s_snow(pcols,pver) ! dem_s_snow - Grid-box mean Optical depth of stratiform snow at 10.5 um + integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). + integer :: nSunLit,nNoSunLit ! Number of sunlit (not sunlit) scenes. + + ! ###################################################################################### + ! Simulator output info + ! ###################################################################################### + integer, parameter :: nf_radar=6 ! number of radar outputs + integer, parameter :: nf_lidar=28 ! number of lidar outputs !!+cosp1.4 + integer, parameter :: nf_isccp=9 ! number of isccp outputs + integer, parameter :: nf_misr=1 ! number of misr outputs + integer, parameter :: nf_modis=20 ! number of modis outputs + + ! Cloudsat outputs + character(len=max_fieldname_len),dimension(nf_radar),parameter :: & + fname_radar = (/'CFAD_DBZE94_CS','CLD_CAL_NOTCS ','DBZE_CS ', & + 'CLDTOT_CALCS ','CLDTOT_CS ','CLDTOT_CS2 '/) + ! CALIPSO outputs + character(len=max_fieldname_len),dimension(nf_lidar),parameter :: & + fname_lidar=(/'CLDLOW_CAL ','CLDMED_CAL ','CLDHGH_CAL ','CLDTOT_CAL ','CLD_CAL ',& + 'RFL_PARASOL ','CFAD_SR532_CAL ','ATB532_CAL ','MOL532_CAL ','CLD_CAL_LIQ ',& + 'CLD_CAL_ICE ','CLD_CAL_UN ','CLD_CAL_TMP ','CLD_CAL_TMPLIQ ','CLD_CAL_TMPICE ',& + 'CLD_CAL_TMPUN ','CLDTOT_CAL_ICE ','CLDTOT_CAL_LIQ ','CLDTOT_CAL_UN ','CLDHGH_CAL_ICE ',& + 'CLDHGH_CAL_LIQ ','CLDHGH_CAL_UN ','CLDMED_CAL_ICE ','CLDMED_CAL_LIQ ','CLDMED_CAL_UN ',& + 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/) !+COSP1.4 (all same # characters!) + ! ISCCP outputs + character(len=max_fieldname_len),dimension(nf_isccp),parameter :: & + fname_isccp=(/'FISCCP1_COSP ','CLDTOT_ISCCP ','MEANCLDALB_ISCCP',& + 'MEANPTOP_ISCCP ','TAU_ISCCP ','CLDPTOP_ISCCP ','MEANTAU_ISCCP ',& + 'MEANTB_ISCCP ','MEANTBCLR_ISCCP '/) + ! MISR outputs + character(len=max_fieldname_len),dimension(nf_misr),parameter :: & + fname_misr=(/'CLD_MISR '/) + ! MODIS outputs + character(len=max_fieldname_len),dimension(nf_modis) :: & + fname_modis=(/'CLTMODIS ','CLWMODIS ','CLIMODIS ','CLHMODIS ','CLMMODIS ',& + 'CLLMODIS ','TAUTMODIS ','TAUWMODIS ','TAUIMODIS ','TAUTLOGMODIS',& + 'TAUWLOGMODIS','TAUILOGMODIS','REFFCLWMODIS','REFFCLIMODIS',& + 'PCTMODIS ','LWPMODIS ','IWPMODIS ','CLMODIS ','CLRIMODIS ',& + 'CLRLMODIS '/) + + logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator + logical :: run_lidar(nf_lidar,pcols) ! logical telling you if you should run lidar simulator + logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator + logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator + logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator + + ! CAM pointers to get variables from radiation interface (get from rad_cnst_get_gas) + real(r8), pointer, dimension(:,:) :: q ! specific humidity (kg/kg) + real(r8), pointer, dimension(:,:) :: o3 ! Mass mixing ratio 03 + real(r8), pointer, dimension(:,:) :: co2 ! Mass mixing ratio C02 + real(r8), pointer, dimension(:,:) :: ch4 ! Mass mixing ratio CH4 + real(r8), pointer, dimension(:,:) :: n2o ! Mass mixing ratio N20 + + ! CAM pointers to get variables from the physics buffer + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction, tca - total_cloud_amount (0-1) + real(r8), pointer, dimension(:,:) :: concld ! concld fraction, cca - convective_cloud_amount (0-1) + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: ls_reffrain ! rain effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: ls_reffsnow ! snow effective drop size (microns) + real(r8), pointer, dimension(:,:) :: cv_reffliq ! convective cld liq effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: cv_reffice ! convective cld ice effective drop size (microns) + + !! precip flux pointers (use for cam4 or cam5) + ! Added pointers; pbuff in zm_conv_intr.F90, calc in zm_conv.F90 + real(r8), pointer, dimension(:,:) :: dp_flxprc ! deep interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) + real(r8), pointer, dimension(:,:) :: dp_flxsnw ! deep interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) + ! More pointers; pbuf in convect_shallow.F90, calc in hk_conv.F90/convect_shallow.F90 (CAM4), uwshcu.F90 (CAM5) + real(r8), pointer, dimension(:,:) :: sh_flxprc ! shallow interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) + real(r8), pointer, dimension(:,:) :: sh_flxsnw ! shallow interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) + ! More pointers; pbuf in stratiform.F90, getting from pbuf here + ! a) added as output to pcond subroutine in cldwat.F90 and to nmicro_pcond subroutine in cldwat2m_micro.F90 + real(r8), pointer, dimension(:,:) :: ls_flxprc ! stratiform interface gbm flux_cloud_rain+snow (kg m^-2 s^-1) + real(r8), pointer, dimension(:,:) :: ls_flxsnw ! stratiform interface gbm flux_cloud_snow (kg m^-2 s^-1) + + !! cloud mixing ratio pointers (note: large-scale in state) + ! More pointers; pbuf in convect_shallow.F90 (cam4) or stratiform.F90 (cam5) + ! calc in hk_conv.F90 (CAM4 should be 0!), uwshcu.F90 but then affected by micro so values from stratiform.F90 (CAM5) + real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow gbm cloud liquid water (kg/kg) + real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow gbm cloud ice water (kg/kg) + ! More pointers; pbuf in zm_conv_intr.F90, calc in zm_conv.F90, 0 for CAM4 and CAM5 (same convection scheme) + real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg) + real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg) + + ! Output CAM variables + ! Notes: + ! 1) use pcols (maximum number of columns that code could use, maybe 16) + ! pcols vs. ncol. ncol is the number of columns a chunk is actually using, pcols is maximum number + ! 2) Mixed variables rules/notes, need to collapse because CAM history does not support increased dimensionality + ! MIXED DIMS: ntau_cosp*nprs_cosp, ndbze_cosp*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nhtml_cosp, ntau_cosp*nhtmisr_cosp + ! a) always making mixed variables VERTICAL*OTHER, e.g., pressure*tau or ht*dbze + ! b) always collapsing output as V1_1/V2_1...V1_1/V2_N ; V1_2/V2_1 ...V1_2/V2_N etc. to V1_N/V2_1 ... V1_N/V2_N + ! c) here, need vars for both multi-dimensional output from COSP, and two-dimensional output from CAM + ! 3) ntime=1, nprofile=ncol + ! 4) dimensions listed in COSP units are from netcdf output from cosp test case, and are not necessarily in the + ! correct order. In fact, most of them are not as I discovered after trying to run COSP in-line. + ! BE says this could be because FORTRAN and C (netcdf defaults to C) have different conventions. + ! 5) !! Note: after running COSP, it looks like height_mlev is actually the model levels after all!! + real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) ! clisccp2 (time,tau,plev,profile) + real(r8) :: cfad_dbze94(pcols,ndbze_cosp,nht_cosp) ! cfad_dbze94 (time,height,dbze,profile) + real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) ! cfad_lidarsr532 (time,height,scat_ratio,profile) + real(r8) :: dbze94(pcols,nscol_cosp,nhtml_cosp) ! dbze94 (time,height_mlev,column,profile) + real(r8) :: atb532(pcols,nscol_cosp,nhtml_cosp) ! atb532 (time,height_mlev,column,profile) + real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) ! clMISR (time,tau,CTH_height_bin,profile) + real(r8) :: frac_out(pcols,nscol_cosp,nhtml_cosp) ! frac_out (time,height_mlev,column,profile) + real(r8) :: cldtot_isccp(pcols) ! CAM tclisccp (time,profile) + real(r8) :: meancldalb_isccp(pcols) ! CAM albisccp (time,profile) + real(r8) :: meanptop_isccp(pcols) ! CAM ctpisccp (time,profile) + real(r8) :: cldlow_cal(pcols) ! CAM cllcalipso (time,profile) + real(r8) :: cldmed_cal(pcols) ! CAM clmcalipso (time,profile) + real(r8) :: cldhgh_cal(pcols) ! CAM clhcalipso (time,profile) + real(r8) :: cldtot_cal(pcols) ! CAM cltcalipso (time,profile) + real(r8) :: cldtot_cal_ice(pcols) ! CAM (time,profile) !!+cosp1.4 + real(r8) :: cldtot_cal_liq(pcols) ! CAM (time,profile) + real(r8) :: cldtot_cal_un(pcols) ! CAM (time,profile) + real(r8) :: cldhgh_cal_ice(pcols) ! CAM (time,profile) + real(r8) :: cldhgh_cal_liq(pcols) ! CAM (time,profile) + real(r8) :: cldhgh_cal_un(pcols) ! CAM (time,profile) + real(r8) :: cldmed_cal_ice(pcols) ! CAM (time,profile) + real(r8) :: cldmed_cal_liq(pcols) ! CAM (time,profile) + real(r8) :: cldmed_cal_un(pcols) ! CAM (time,profile) + real(r8) :: cldlow_cal_ice(pcols) ! CAM (time,profile) + real(r8) :: cldlow_cal_liq(pcols) ! CAM (time,profile) + real(r8) :: cldlow_cal_un(pcols) ! CAM (time,profile) !+cosp1.4 + real(r8) :: cld_cal(pcols,nht_cosp) ! CAM clcalipso (time,height,profile) + real(r8) :: cld_cal_liq(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 + real(r8) :: cld_cal_ice(pcols,nht_cosp) ! CAM (time,height,profile) + real(r8) :: cld_cal_un(pcols,nht_cosp) ! CAM (time,height,profile) + real(r8) :: cld_cal_tmp(pcols,nht_cosp) ! CAM (time,height,profile) + real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) ! CAM (time,height,profile) + real(r8) :: cld_cal_tmpice(pcols,nht_cosp) ! CAM (time,height,profile) + real(r8) :: cld_cal_tmpun(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 + real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*ndbze_cosp)! CAM cfad_dbze94 (time,height,dbze,profile) + real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) + real(r8) :: tau_isccp(pcols,nscol_cosp) ! CAM boxtauisccp (time,column,profile) + real(r8) :: cldptop_isccp(pcols,nscol_cosp) ! CAM boxptopisccp (time,column,profile) + real(r8) :: meantau_isccp(pcols) ! CAM tauisccp (time,profile) + real(r8) :: meantb_isccp(pcols) ! CAM meantbisccp (time,profile) + real(r8) :: meantbclr_isccp(pcols) ! CAM meantbclrisccp (time,profile) + real(r8) :: dbze_cs(pcols,nhtml_cosp*nscol_cosp) ! CAM dbze94 (time,height_mlev,column,profile) + real(r8) :: cldtot_calcs(pcols) ! CAM cltlidarradar (time,profile) + real(r8) :: cldtot_cs(pcols) ! CAM cltradar (time,profile) + real(r8) :: cldtot_cs2(pcols) ! CAM cltradar2 (time,profile) + real(r8) :: cld_cal_notcs(pcols,nht_cosp) ! CAM clcalipso2 (time,height,profile) + real(r8) :: atb532_cal(pcols,nhtml_cosp*nscol_cosp) ! CAM atb532 (time,height_mlev,column,profile) + real(r8) :: mol532_cal(pcols,nhtml_cosp) ! CAM beta_mol532 (time,height_mlev,profile) + real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) ! CAM clMISR (time,tau,CTH_height_bin,profile) + real(r8) :: refl_parasol(pcols,nsza_cosp) ! CAM parasol_refl (time,sza,profile) + real(r8) :: scops_out(pcols,nhtml_cosp*nscol_cosp) ! CAM frac_out (time,height_mlev,column,profile) + real(r8) :: cltmodis(pcols) + real(r8) :: clwmodis(pcols) + real(r8) :: climodis(pcols) + real(r8) :: clhmodis(pcols) + real(r8) :: clmmodis(pcols) + real(r8) :: cllmodis(pcols) + real(r8) :: tautmodis(pcols) + real(r8) :: tauwmodis(pcols) + real(r8) :: tauimodis(pcols) + real(r8) :: tautlogmodis(pcols) + real(r8) :: tauwlogmodis(pcols) + real(r8) :: tauilogmodis(pcols) + real(r8) :: reffclwmodis(pcols) + real(r8) :: reffclimodis(pcols) + real(r8) :: pctmodis(pcols) + real(r8) :: lwpmodis(pcols) + real(r8) :: iwpmodis(pcols) + real(r8) :: clmodis_cam(pcols,ntau_cosp_modis*nprs_cosp) + real(r8) :: clmodis(pcols,ntau_cosp_modis,nprs_cosp) + real(r8) :: clrimodis_cam(pcols,ntau_cosp*numMODISReffIceBins) + real(r8) :: clrimodis(pcols,ntau_cosp,numMODISReffIceBins) + real(r8) :: clrlmodis_cam(pcols,ntau_cosp*numMODISReffLiqBins) + real(r8) :: clrlmodis(pcols,ntau_cosp,numMODISReffLiqBins) + !real(r8) :: tau067_out(pcols,nhtml_cosp*nscol_cosp),emis11_out(pcols,nhtml_cosp*nscol_cosp) + real(r8),dimension(pcols,nhtml_cosp*nscol_cosp) :: & + tau067_out,emis11_out,fracliq_out,cal_betatot,cal_betatot_ice, & + cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,& + asym34_out,ssa34_out + + type(interp_type) :: interp_wgts + integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) + + ! COSPv2 stuff + character(len=256),dimension(100) :: cosp_status + integer :: nerror + + call t_startf("init_and_stuff") + ! ###################################################################################### + ! Initialization + ! ###################################################################################### + ! Find the chunk and ncol from the state vector + lchnk = state%lchnk ! state variable contains a number of columns, one chunk + ncol = state%ncol ! number of columns in the chunk + + ! Initialize temporary variables as R_UNDEF - need to do this otherwise array expansion puts garbage in history + ! file for columns over which COSP did make calculations. + tmp(1:pcols) = R_UNDEF + tmp1(1:pcols,1:pver) = R_UNDEF + tmp2(1:pcols,1:pver) = R_UNDEF + + ! Initialize CAM variables as R_UNDEF, important for history files because it will exclude these from averages + ! (multi-dimensional output that will be collapsed) + ! initialize over all pcols, not just ncol. missing values needed in chunks where ncol 0.0_r8) .and. (run_cosp(i,lchnk))) then + cam_sunlit(i) = 1 + nSunLit = nSunLit+1 + else + nNoSunLit = nNoSunlit+1 + endif + enddo + endif + call t_stopf("init_and_stuff") + + ! ###################################################################################### + ! ###################################################################################### + ! END TRANSLATE CAM VARIABLES TO COSP INPUT VARIABLES + ! ###################################################################################### + ! ###################################################################################### + + ! ###################################################################################### + ! Construct COSP output derived type. + ! ###################################################################################### + call t_startf("construct_cosp_outputs") + call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,0,cospOUT) + call t_stopf("construct_cosp_outputs") + + ! ###################################################################################### + ! Construct and populate COSP input types + ! ###################################################################################### + ! Model state + call t_startf("construct_cospstateIN") + call construct_cospstateIN(ncol,pver,0,cospstateIN) + cospstateIN%lat = lat_cosp(1:ncol) + cospstateIN%lon = lon_cosp(1:ncol) + cospstateIN%at = state%t(1:ncol,1:pver) + cospstateIN%qv = q(1:ncol,1:pver) + cospstateIN%o3 = o3(1:ncol,1:pver) + cospstateIN%sunlit = cam_sunlit(1:ncol) + cospstateIN%skt = cam_in%ts(1:ncol) + cospstateIN%land = landmask(1:ncol) + cospstateIN%pfull = state%pmid(1:ncol,1:pver) + cospstateIN%phalf(1:ncol,1) = 0._r8 + cospstateIN%phalf(1:ncol,2:pver+1) = pbot(1:ncol,pver:1:-1) +! cospstateIN%phalf(1:ncol,1:pver+1) = pbot(1:ncol,pver+1:1:-1) + cospstateIN%hgt_matrix = zmid(1:ncol,1:pver) + cospstateIN%hgt_matrix_half(1:ncol,pver+1) = 0._r8 + cospstateIN%hgt_matrix_half(1:ncol,1:pver) = zbot(1:ncol,pver:1:-1) + call t_stopf("construct_cospstateIN") + + ! Optical inputs + call t_startf("construct_cospIN") + call construct_cospIN(ncol,nscol_cosp,pver,cospIN) + cospIN%emsfc_lw = emsfc_lw + cospIN%rcfg_cloudsat = rcfg_cs(lchnk) + call t_stopf("construct_cospIN") + + ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. + call t_startf("subsample_and_optics") + call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & + use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& + concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & + snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & + rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & + mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & + mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & + reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & + dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & + dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & + dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) + call t_stopf("subsample_and_optics") + + ! ###################################################################################### + ! Call COSP + ! ###################################################################################### + call t_startf("cosp_simulator") + cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx=1, stop_idx=ncol,debug=.false.) + + ! Check status flags + nerror = 0 + do i = 1, ubound(cosp_status, 1) + if (len_trim(cosp_status(i)) > 0) then + write(iulog,*) "cosp_simulator: ERROR: "//trim(cosp_status(i)) + nerror = nerror + 1 + end if + end do + if (nerror > 0) then + call endrun('cospsimulator_intr_run: error return from cosp_simulator') + end if + call t_stopf("cosp_simulator") + + ! ###################################################################################### + ! Write COSP inputs to output file for offline use. + ! ###################################################################################### + call t_startf("cosp_histfile_aux") + if (cosp_histfile_aux) then + ! 1D outputs + call outfld('PS_COSP', state%ps(1:ncol), ncol,lchnk) + call outfld('TS_COSP', cospstateIN%skt, ncol,lchnk) + + ! 2D outputs + call outfld('P_COSP', cospstateIN%pfull, ncol,lchnk) + call outfld('PH_COSP', cospstateIN%phalf, ncol,lchnk) + call outfld('ZLEV_COSP', cospstateIN%hgt_matrix, ncol,lchnk) + call outfld('ZLEV_HALF_COSP', cospstateIN%hgt_matrix_half, ncol,lchnk) + call outfld('T_COSP', cospstateIN%at, ncol,lchnk) + call outfld('RH_COSP', cospstateIN%qv, ncol,lchnk) + call outfld('Q_COSP', q(1:ncol,1:pver), ncol,lchnk) + + ! 3D outputs, but first compress to 2D + do i=1,ncol + do ihml=1,nhtml_cosp + do isc=1,nscol_cosp + ihsc = (ihml-1)*nscol_cosp+isc + tau067_out(i,ihsc) = cospIN%tau_067(i,isc,ihml) + emis11_out(i,ihsc) = cospIN%emiss_11(i,isc,ihml) + ssa34_out(i,ihsc) = cospIN%ss_alb(i,isc,ihml) + asym34_out(i,ihsc) = cospIN%asym(i,isc,ihml) + fracLiq_out(i,ihsc) = cospIN%fracLiq(i,isc,ihml) + end do + end do + end do + call outfld('TAU_067', tau067_out, pcols,lchnk) + call outfld('EMISS_11', emis11_out, pcols,lchnk) + call outfld('MODIS_asym', asym34_out, pcols,lchnk) + call outfld('MODIS_ssa', ssa34_out, pcols,lchnk) + call outfld('MODIS_fracliq',fracLiq_out,pcols,lchnk) + end if + call t_stopf("cosp_histfile_aux") + + ! ###################################################################################### + ! Set dark-scenes to fill value. Only done for passive simulators and when cosp_runall=F + ! ###################################################################################### + call t_startf("sunlit_passive") + if (.not. cosp_runall) then + ! ISCCP simulator + if (lisccp_sim) then + ! 1D + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%isccp_totalcldarea(1:ncol) = R_UNDEF + cospOUT%isccp_meanptop(1:ncol) = R_UNDEF + cospOUT%isccp_meantaucld(1:ncol) = R_UNDEF + cospOUT%isccp_meanalbedocld(1:ncol) = R_UNDEF + cospOUT%isccp_meantb(1:ncol) = R_UNDEF + cospOUT%isccp_meantbclr(1:ncol) = R_UNDEF + end where + ! 2D + do i=1,nscol_cosp + where (cam_sunlit(1:ncol) .eq. 0) + cospOUT%isccp_boxtau(1:ncol,i) = R_UNDEF + cospOUT%isccp_boxptop(1:ncol,i) = R_UNDEF + end where + enddo + ! 3D + do i=1,nprs_cosp + do k=1,ntau_cosp + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%isccp_fq(1:ncol,k,i) = R_UNDEF + end where + end do + end do + endif + + ! MISR simulator + if (lmisr_sim) then + do i=1,nhtmisr_cosp + do k=1,ntau_cosp + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%misr_fq(1:ncol,k,i) = R_UNDEF + end where + end do + end do + end if + + ! MODIS simulator + if (lmodis_sim) then + ! 1D + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%modis_Cloud_Fraction_Total_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Fraction_Water_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Fraction_Ice_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Fraction_High_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Fraction_Mid_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Fraction_Low_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Total_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Water_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Ice_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Total_LogMean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Water_LogMean(1:ncol) = R_UNDEF + cospOUT%modis_Optical_Thickness_Ice_LogMean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Particle_Size_Water_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Particle_Size_Ice_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Cloud_Top_Pressure_Total_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Liquid_Water_Path_Mean(1:ncol) = R_UNDEF + cospOUT%modis_Ice_Water_Path_Mean(1:ncol) = R_UNDEF + endwhere + ! 3D + do i=1,ntau_cosp_modis + do k=1,nprs_cosp + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(1:ncol,i,k) = R_UNDEF + end where + enddo + do k=1,numMODISReffIceBins + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%modis_Optical_Thickness_vs_ReffICE(1:ncol,i,k) = R_UNDEF + end where + end do + do k=1,numMODISReffLiqBins + where(cam_sunlit(1:ncol) .eq. 0) + cospOUT%modis_Optical_Thickness_vs_ReffLIQ(1:ncol,i,k) = R_UNDEF + end where + enddo + enddo + end if + end if + call t_stopf("sunlit_passive") + + ! ###################################################################################### + ! Copy COSP outputs to CAM fields. + ! ###################################################################################### + call t_startf("output_copying") + if (allocated(cospIN%frac_out)) & + frac_out(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospIN%frac_out ! frac_out (time,height_mlev,column,profile) + + ! Cloudsat + if (lradar_sim) then + cfad_dbze94(1:ncol,1:ndbze_cosp,1:nht_cosp) = cospOUT%cloudsat_cfad_ze(:,:,nht_cosp:1:-1) ! cfad_dbze94 (time,height,dbze,profile) + dbze94(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%cloudsat_Ze_tot ! dbze94 (time,height_mlev,column,profile) + cldtot_cs(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc ! CAM version of cltradar (time,profile) ! NOT COMPUTED IN COSP2 + cldtot_cs2(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc2 ! CAM version of cltradar2 (time,profile) ! NOT COMPUTED IN COSP2 + ! *NOTE* These two fields are joint-simulator products, but in CAM they are controlled + ! by the radar simulator control. + cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc ! CAM version of cltlidarradar (time,profile) + cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! CAM version of clcalipso2 (time,height,profile) + endif + + ! CALIPSO + if (llidar_sim) then + cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) ! CAM version of cllcalipso (time,profile) + cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) ! CAM version of clmcalipso (time,profile) + cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) ! CAM version of clhcalipso (time,profile) + cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) ! CAM version of cltcalipso (time,profile) + cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) ! CAM version of cllcalipsoice !+cosp1.4 + cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) ! CAM version of clmcalipsoice + cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) ! CAM version of clhcalipsoice + cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) ! CAM version of cltcalipsoice + cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) ! CAM version of cllcalipsoliq + cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) ! CAM version of clmcalipsoliq + cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) ! CAM version of clhcalipsoliq + cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) ! CAM version of cltcalipsoliq + cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) ! CAM version of cllcalipsoun + cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) ! CAM version of clmcalipsoun + cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) ! CAM version of clhcalipsoun + cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) ! CAM version of cltcalipsoun, !+cosp1.4 + cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,nht_cosp:1:-1,1) ! CAM version of clcalipsoice !+cosp1.4 + cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,nht_cosp:1:-1,2) ! CAM version of clcalipsoliq + cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,nht_cosp:1:-1,3) ! CAM version of clcalipsoun + cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) ! CAM version of clcalipsotmp + cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) ! CAM version of clcalipsotmpice + cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) ! CAM version of clcalipsotmpliq + cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) ! CAM version of clcalipsotmpun, !+cosp1.4 + cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,nht_cosp:1:-1) ! CAM version of clcalipso (time,height,profile) + mol532_cal(1:ncol,1:nhtml_cosp) = cospOUT%calipso_beta_mol ! CAM version of beta_mol532 (time,height_mlev,profile) + atb532(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%calipso_beta_tot ! atb532 (time,height_mlev,column,profile) + cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,nht_cosp:1:-1) ! cfad_lidarsr532 (time,height,scat_ratio,profile) + ! PARASOL. In COSP2, the Parasol simulator is independent of the lidar simulator. + refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl ! CAM version of parasolrefl (time,sza,profile) + endif + + ! ISCCP + if (lisccp_sim) then + clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq ! CAM version of clisccp2 (time,tau,plev,profile) + tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau ! CAM version of boxtauisccp (time,column,profile) + cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop ! CAM version of boxptopisccp (time,column,profile) + cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea ! CAM version of tclisccp (time, profile) + meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop ! CAM version of ctpisccp (time, profile) + meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld ! CAM version of meantbisccp (time, profile) + meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld ! CAM version of albisccp (time, profile) + meantb_isccp(1:ncol) = cospOUT%isccp_meantb ! CAM version of meantbisccp (time, profile) + meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr ! CAM version of meantbclrisccp (time, profile) + endif + + ! MISR + if (lmisr_sim) then + clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq ! CAM version of clMISR (time,tau,CTH_height_bin,profile) + endif + + ! MODIS + if (lmodis_sim) then + cltmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Total_Mean + clwmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Water_Mean + climodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Ice_Mean + clhmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_High_Mean + clmmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Mid_Mean + cllmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Low_Mean + tautmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Total_Mean + tauwmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Water_Mean + tauimodis(1:ncol) = cospOUT%modis_Optical_Thickness_Ice_Mean + tautlogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Total_LogMean + tauwlogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Water_LogMean + tauilogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Ice_LogMean + reffclwmodis(1:ncol) = cospOUT%modis_Cloud_Particle_Size_Water_Mean + reffclimodis(1:ncol) = cospOUT%modis_Cloud_Particle_Size_Ice_Mean + pctmodis(1:ncol) = cospOUT%modis_Cloud_Top_Pressure_Total_Mean + lwpmodis(1:ncol) = cospOUT%modis_Liquid_Water_Path_Mean + iwpmodis(1:ncol) = cospOUT%modis_Ice_Water_Path_Mean + clmodis(1:ncol,1:ntau_cosp_modis,1:nprs_cosp) = cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure + clrimodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffIceBins) = cospOUT%modis_Optical_Thickness_vs_ReffICE + clrlmodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffLiqBins) = cospOUT%modis_Optical_Thickness_vs_ReffLIQ + endif + + ! Use high-dimensional output to populate CAM collapsed output variables + ! see above for mixed dimension definitions + ! i am using the convention of starting vertical coordinates at the surface, up to down, COSP convention, not CAM. + do i=1,ncol + if (lradar_sim) then + ! CAM cfad_dbze94 (time,height,dbze,profile) + do ih=1,nht_cosp + do id=1,ndbze_cosp + ihd=(ih-1)*ndbze_cosp+id + cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) ! cfad_dbze94_cs(pcols,nht_cosp*ndbze_cosp) + end do + end do + ! CAM dbze94 (time,height_mlev,column,profile) + do ihml=1,nhtml_cosp + do isc=1,nscol_cosp + ihsc=(ihml-1)*nscol_cosp+isc + dbze_cs(i,ihsc) = dbze94(i,isc,ihml) ! dbze_cs(pcols,pver*nscol_cosp) + end do + end do + endif + + if (llidar_sim) then + ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) + do ih=1,nht_cosp + do is=1,nsr_cosp + ihs=(ih-1)*nsr_cosp+is + cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) ! cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) + end do + end do + ! CAM atb532 (time,height_mlev,column,profile) FIX + do ihml=1,nhtml_cosp + do isc=1,nscol_cosp + ihsc=(ihml-1)*nscol_cosp+isc + atb532_cal(i,ihsc) = atb532(i,isc,ihml) ! atb532_cal(pcols,nht_cosp*nscol_cosp) + end do + end do + endif + + if (lmisr_sim) then + ! CAM clMISR (time,tau,CTH_height_bin,profile) + do ihm=1,nhtmisr_cosp + do it=1,ntau_cosp + ihmt=(ihm-1)*ntau_cosp+it + cld_misr(i,ihmt) = clMISR(i,it,ihm) + end do + end do + endif + + if (lmodis_sim) then + ! CAM clmodis + do ip=1,nprs_cosp + do it=1,ntau_cosp_modis + ipt=(ip-1)*ntau_cosp_modis+it + clmodis_cam(i,ipt) = clmodis(i,it,ip) + end do + end do + ! CAM clrimodis + do ip=1,numMODISReffIceBins + do it=1,ntau_cosp_modis + ipt=(ip-1)*ntau_cosp_modis+it + clrimodis_cam(i,ipt) = clrimodis(i,it,ip) + end do + end do + ! CAM clrlmodis + do ip=1,numMODISReffLiqBins + do it=1,ntau_cosp_modis + ipt=(ip-1)*ntau_cosp_modis+it + clrlmodis_cam(i,ipt) = clrlmodis(i,it,ip) + end do + end do + endif + + ! Subcolums + do ihml=1,nhtml_cosp + do isc=1,nscol_cosp + ihsc=(ihml-1)*nscol_cosp+isc + scops_out(i,ihsc) = frac_out(i,isc,ihml) ! scops_out(pcols,nht_cosp*nscol_cosp) + end do + end do + end do + call t_stopf("output_copying") + + ! ###################################################################################### + ! Clean up + ! ###################################################################################### + call t_startf("destroy_cospIN") + call destroy_cospIN(cospIN) + call t_stopf("destroy_cospIN") + call t_startf("destroy_cospstateIN") + call destroy_cospstateIN(cospstateIN) + call t_stopf("destroy_cospstateIN") + call t_startf("destroy_cospOUT") + call destroy_cosp_outputs(cospOUT) + call t_stopf("destroy_cospOUT") + + ! ###################################################################################### + ! OUTPUT + ! ###################################################################################### + call t_startf("writing_output") + ! ISCCP OUTPUTS + if (lisccp_sim) then + call outfld('FISCCP1_COSP',clisccp2, pcols,lchnk) + call outfld('CLDTOT_ISCCP',cldtot_isccp, pcols,lchnk) + !! weight meancldalb_isccp by the cloud fraction + !! where there is no isccp cloud fraction, set meancldalb_isccp = R_UNDEF + !! weight meanptop_isccp by the cloud fraction + !! where there is no isccp cloud fraction, set meanptop_isccp = R_UNDEF + !! weight meantau_isccp by the cloud fraction + !! where there is no isccp cloud fraction, set meantau_isccp = R_UNDEF + where (cldtot_isccp(:ncol) .eq. R_UNDEF) + meancldalb_isccp(:ncol) = R_UNDEF + meanptop_isccp(:ncol) = R_UNDEF + meantau_isccp(:ncol) = R_UNDEF + elsewhere + meancldalb_isccp(:ncol) = meancldalb_isccp(:ncol)*cldtot_isccp(:ncol) + meanptop_isccp(:ncol) = meanptop_isccp(:ncol)*cldtot_isccp(:ncol) + meantau_isccp(:ncol) = meantau_isccp(:ncol)*cldtot_isccp(:ncol) + end where + call outfld('MEANCLDALB_ISCCP',meancldalb_isccp,pcols,lchnk) + call outfld('MEANPTOP_ISCCP', meanptop_isccp, pcols,lchnk) + call outfld('MEANTAU_ISCCP', meantau_isccp, pcols,lchnk) + call outfld('MEANTB_ISCCP', meantb_isccp, pcols,lchnk) + call outfld('MEANTBCLR_ISCCP', meantbclr_isccp, pcols,lchnk) + end if + + ! LIDAR SIMULATOR OUTPUTS + if (llidar_sim) then + call outfld('CLDLOW_CAL', cldlow_cal, pcols,lchnk) + call outfld('CLDMED_CAL', cldmed_cal, pcols,lchnk) + call outfld('CLDHGH_CAL', cldhgh_cal, pcols,lchnk) + call outfld('CLDTOT_CAL', cldtot_cal, pcols,lchnk) + call outfld('CLDTOT_CAL_ICE',cldtot_cal_ice, pcols,lchnk) !+1.4 + call outfld('CLDTOT_CAL_LIQ',cldtot_cal_liq, pcols,lchnk) + call outfld('CLDTOT_CAL_UN', cldtot_cal_un, pcols,lchnk) + call outfld('CLDHGH_CAL_ICE',cldhgh_cal_ice, pcols,lchnk) + call outfld('CLDHGH_CAL_LIQ',cldhgh_cal_liq, pcols,lchnk) + call outfld('CLDHGH_CAL_UN', cldhgh_cal_un, pcols,lchnk) + call outfld('CLDMED_CAL_ICE',cldmed_cal_ice, pcols,lchnk) + call outfld('CLDMED_CAL_LIQ',cldmed_cal_liq, pcols,lchnk) + call outfld('CLDMED_CAL_UN', cldmed_cal_un, pcols,lchnk) + call outfld('CLDLOW_CAL_ICE',cldlow_cal_ice, pcols,lchnk) + call outfld('CLDLOW_CAL_LIQ',cldlow_cal_liq, pcols,lchnk) + call outfld('CLDLOW_CAL_UN', cldlow_cal_un, pcols,lchnk) !+1.4 + where (cld_cal(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air). + !! I'm not sure why COSP produces a mix of R_UNDEF and realvalue in the nht_cosp dimension. + cld_cal(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL', cld_cal, pcols,lchnk) !! fails check_accum if 'A' + call outfld('MOL532_CAL', mol532_cal, pcols,lchnk) + + where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) .eq. R_UNDEF) + !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue + !! cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = R_UNDEF + cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = 0.0_r8 + end where + call outfld('CFAD_SR532_CAL',cfad_sr532_cal ,pcols,lchnk) + + where (refl_parasol(:ncol,:nsza_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air). + refl_parasol(:ncol,:nsza_cosp) = 0 + end where + call outfld('RFL_PARASOL',refl_parasol ,pcols,lchnk) !! + + where (cld_cal_liq(:ncol,:nht_cosp) .eq. R_UNDEF) !+cosp1.4 + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_liq(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_LIQ',cld_cal_liq ,pcols,lchnk) !! + + where (cld_cal_ice(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_ice(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_ICE',cld_cal_ice ,pcols,lchnk) !! + + where (cld_cal_un(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_un(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !! + + where (cld_cal_tmp(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_tmp(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_TMP',cld_cal_tmp ,pcols,lchnk) !! + + where (cld_cal_tmpliq(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_tmpliq(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_TMPLIQ',cld_cal_tmpliq ,pcols,lchnk) !! + + where (cld_cal_tmpice(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_tmpice(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_TMPICE',cld_cal_tmpice ,pcols,lchnk) !! + + where (cld_cal_tmpun(:ncol,:nht_cosp) .eq. R_UNDEF) + !! setting missing values to 0 (clear air), likely below sea level + cld_cal_tmpun(:ncol,:nht_cosp) = 0.0_r8 + end where + call outfld('CLD_CAL_TMPUN',cld_cal_tmpun ,pcols,lchnk) !! !+cosp1.4 + end if + + ! RADAR SIMULATOR OUTPUTS + if (lradar_sim) then + where (cfad_dbze94_cs(:ncol,:nht_cosp*ndbze_cosp) .eq. R_UNDEF) + !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue + ! cfad_dbze94_cs(:ncol,:nht_cosp*ndbze_cosp) = R_UNDEF + cfad_dbze94_cs(:ncol,:nht_cosp*ndbze_cosp) = 0.0_r8 + end where + call outfld('CFAD_DBZE94_CS',cfad_dbze94_cs,pcols,lchnk) + call outfld('CLDTOT_CALCS', cldtot_calcs, pcols,lchnk) + call outfld('CLDTOT_CS', cldtot_cs, pcols,lchnk) + call outfld('CLDTOT_CS2', cldtot_cs2, pcols,lchnk) + call outfld('CLD_CAL_NOTCS', cld_cal_notcs, pcols,lchnk) + end if + + ! MISR SIMULATOR OUTPUTS + if (lmisr_sim) then + call outfld('CLD_MISR',cld_misr ,pcols,lchnk) + end if + + ! MODIS SIMULATOR OUTPUTS + if (lmodis_sim) then + call outfld('CLTMODIS',cltmodis ,pcols,lchnk) + call outfld('CLWMODIS',clwmodis ,pcols,lchnk) + call outfld('CLIMODIS',climodis ,pcols,lchnk) + call outfld('CLHMODIS',clhmodis ,pcols,lchnk) + call outfld('CLMMODIS',clmmodis ,pcols,lchnk) + call outfld('CLLMODIS',cllmodis ,pcols,lchnk) + + !! where there is no cloud fraction or no retrieval, set to R_UNDEF, + !! otherwise weight retrieval by cloud fraction + where ((cltmodis(:ncol) .eq. R_UNDEF) .or. (tautmodis(:ncol) .eq. R_UNDEF)) + tautmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction cltmodis + tautmodis(:ncol) = tautmodis(:ncol)*cltmodis(:ncol) + end where + call outfld('TAUTMODIS',tautmodis ,pcols,lchnk) + + where ((tauwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + tauwmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction clwmodis + tauwmodis(:ncol) = tauwmodis(:ncol)*clwmodis(:ncol) + end where + call outfld('TAUWMODIS',tauwmodis ,pcols,lchnk) + + where ((tauimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + tauimodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction climodis + tauimodis(:ncol) = tauimodis(:ncol)*climodis(:ncol) + end where + call outfld('TAUIMODIS',tauimodis ,pcols,lchnk) + + where ((tautlogmodis(:ncol) .eq. R_UNDEF) .or. (cltmodis(:ncol) .eq. R_UNDEF)) + tautlogmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction cltmodis + tautlogmodis(:ncol) = tautlogmodis(:ncol)*cltmodis(:ncol) + end where + call outfld('TAUTLOGMODIS',tautlogmodis ,pcols,lchnk) + + where ((tauwlogmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + tauwlogmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction clwmodis + tauwlogmodis(:ncol) = tauwlogmodis(:ncol)*clwmodis(:ncol) + end where + call outfld('TAUWLOGMODIS',tauwlogmodis ,pcols,lchnk) + + where ((tauilogmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + tauilogmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction climodis + tauilogmodis(:ncol) = tauilogmodis(:ncol)*climodis(:ncol) + end where + call outfld('TAUILOGMODIS',tauilogmodis ,pcols,lchnk) + + where ((reffclwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + reffclwmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction clwmodis + reffclwmodis(:ncol) = reffclwmodis(:ncol)*clwmodis(:ncol) + end where + call outfld('REFFCLWMODIS',reffclwmodis ,pcols,lchnk) + + where ((reffclimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + reffclimodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction climodis + reffclimodis(:ncol) = reffclimodis(:ncol)*climodis(:ncol) + end where + call outfld('REFFCLIMODIS',reffclimodis ,pcols,lchnk) + + where ((pctmodis(:ncol) .eq. R_UNDEF) .or. ( cltmodis(:ncol) .eq. R_UNDEF)) + pctmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction cltmodis + pctmodis(:ncol) = pctmodis(:ncol)*cltmodis(:ncol) + end where + call outfld('PCTMODIS',pctmodis ,pcols,lchnk) + + where ((lwpmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF)) + lwpmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction clwmodis + lwpmodis(:ncol) = lwpmodis(:ncol)*clwmodis(:ncol) + end where + call outfld('LWPMODIS',lwpmodis ,pcols,lchnk) + + where ((iwpmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF)) + iwpmodis(:ncol) = R_UNDEF + elsewhere + !! weight by the cloud fraction climodis + iwpmodis(:ncol) = iwpmodis(:ncol)*climodis(:ncol) + end where + call outfld('IWPMODIS',iwpmodis ,pcols,lchnk) + + call outfld('CLMODIS',clmodis_cam ,pcols,lchnk) + call outfld('CLRIMODIS',clrimodis_cam ,pcols,lchnk) + call outfld('CLRLMODIS',clrlmodis_cam ,pcols,lchnk) + end if + + ! SUB-COLUMN OUTPUT + if (lfrac_out) then + call outfld('SCOPS_OUT',scops_out ,pcols,lchnk)!!!-1.00000E+30 !! fails check_accum if 'A' + if (lisccp_sim) then + call outfld('TAU_ISCCP', tau_isccp, pcols,lchnk) !! fails check_accum if 'A' + call outfld('CLDPTOP_ISCCP',cldptop_isccp,pcols,lchnk) !! fails check_accum if 'A' + end if + if (llidar_sim) then + call outfld('ATB532_CAL',atb532_cal,pcols,lchnk) !! fails check_accum if 'A' + end if + if (lradar_sim) then + call outfld('DBZE_CS',dbze_cs,pcols,lchnk) !! fails check_accum if 'A' + end if + end if + call t_stopf("writing_output") +#endif + end subroutine cospsimulator_intr_run + +#ifdef USE_COSP + ! ###################################################################################### + ! SUBROUTINE subsample_and_optics + ! ###################################################################################### + subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, & + use_precipitation_fluxes, lidar_ice_type, sd, tca, cca,& + fl_lsrainIN, fl_lssnowIN, fl_lsgrplIN, fl_ccrainIN, & + fl_ccsnowIN, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & + reffIN, dtau_c, dtau_s, dem_c, dem_s, dtau_s_snow, & + dem_s_snow, sfcP, cospstateIN, cospIN) + ! Dependencies + use cosp_kinds, only: wp + use mod_rng, only: rng_state, init_rng + use mod_cosp_config, only: R_UNDEF + use mod_scops, only: scops + use mod_prec_scops, only: prec_scops + use mod_cosp_utils, only: cosp_precip_mxratio + use mod_quickbeam_optics, only: quickbeam_optics, gases + use cosp_optics, only: cosp_simulator_optics,lidar_optics,modis_optics, & + modis_optics_partition + + ! Inputs + logical,intent(in) :: & + use_precipitation_fluxes + integer,intent(in) :: & + nPoints, & ! Number of gridpoints + nLevels, & ! Number of vertical levels + nColumns, & ! Number of subcolumns + nHydro, & ! Number pf hydrometeor types + overlap, & ! Overlap assumption (1/2/3) + lidar_ice_type ! Ice type assumption used by lidar optics + real(wp),intent(in),dimension(nPoints,nLevels) :: & + tca, & ! Total cloud amount (0-1) + cca, & ! Convective cloud amount (0-1) + mr_lsliq, & ! Mixing ratio (kg/kg) + mr_lsice, & ! Mixing ratio (kg/kg) + mr_ccliq, & ! Mixing ratio (kg/kg) + mr_ccice, & ! Mixing ratio (kg/kg) + dtau_c, & ! 0.67-micron optical depth (convective) + dtau_s, & ! 0.67-micron optical depth (stratiform) + dem_c, & ! 11-micron emissivity (convective) + dem_s, & ! 11-micron emissivity (stratiform) + fl_lsrainIN, & ! Precipitation flux + fl_lssnowIN, & ! Precipitation flux + fl_lsgrplIN, & ! Precipitation flux + fl_ccrainIN, & ! Precipitation flux + fl_ccsnowIN ! Precipitation flux + real(wp),intent(inout),dimension(nPoints,nLevels) :: & + dtau_s_snow, & ! 0.67-micron optical depth (snow) + dem_s_snow ! 11-micron emissivity (snow) + real(wp),intent(in),dimension(nPoints,nLevels,nHydro) :: & + reffIN ! + real(wp),intent(in),dimension(nPoints) :: & + sfcP ! Surface pressure + type(size_distribution),intent(inout) :: & + sd + + ! Outputs + type(cosp_optical_inputs),intent(inout) :: cospIN + type(cosp_column_inputs),intent(inout) :: cospstateIN + + ! Local variables + integer :: i,j,k + real(wp),dimension(nPoints,nLevels) :: column_frac_out,column_prec_out, & + fl_lsrain,fl_lssnow,fl_lsgrpl,fl_ccrain, & + fl_ccsnow + real(wp),dimension(nPoints,nLevels,nHydro) :: ReffTemp + type(rng_state),allocatable,dimension(:) :: rngs ! Seeds for random number generator + integer,dimension(:),allocatable :: seed + real(wp),dimension(:,:),allocatable :: ls_p_rate,cv_p_rate,frac_ls,frac_cv, & + prec_ls,prec_cv,g_vol + real(wp),dimension(:,:,:), allocatable :: frac_prec,& + MODIS_cloudWater,MODIS_cloudIce, & + MODIS_watersize,MODIS_iceSize, & + MODIS_snowSize,MODIS_cloudSnow, & + MODIS_opticalThicknessLiq, & + MODIS_opticalThicknessSnow, & + MODIS_opticalThicknessIce + real(wp),dimension(:,:,:,:),allocatable :: mr_hydro,Reff,Np + + call t_startf("scops") + if (Ncolumns .gt. 1) then + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS) + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! RNG used for subcolumn generation + allocate(rngs(nPoints),seed(nPoints)) + seed = int(sfcP) + if (Npoints .gt. 1) seed=(sfcP-int(sfcP))*1000000 + call init_rng(rngs, seed) + + ! Call scops + call scops(NPoints,Nlevels,Ncolumns,rngs,tca,cca,overlap,cospIN%frac_out,0) + deallocate(seed,rngs) + + ! Sum up precipitation rates. If not using preciitation fluxes, mixing ratios are + ! stored in _rate variables. + allocate(ls_p_rate(nPoints,nLevels),cv_p_rate(nPoints,Nlevels)) + if(use_precipitation_fluxes) then + ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN + cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN + else + ls_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + mixing_ratio (groupel) + cv_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + endif + + ! Call PREC_SCOPS + allocate(frac_prec(nPoints,nColumns,nLevels)) + call prec_scops(nPoints,nLevels,nColumns,ls_p_rate,cv_p_rate,cospIN%frac_out,frac_prec) + deallocate(ls_p_rate,cv_p_rate) + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Compute precipitation fraction in each gridbox + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Allocate + allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & + frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels)) + + ! Initialize + frac_ls(1:nPoints,1:nLevels) = 0._wp + prec_ls(1:nPoints,1:nLevels) = 0._wp + frac_cv(1:nPoints,1:nLevels) = 0._wp + prec_cv(1:nPoints,1:nLevels) = 0._wp + do j=1,nPoints + do k=1,nLevels + do i=1,nColumns + if (cospIN%frac_out(j,i,k) .eq. 1) frac_ls(j,k) = frac_ls(j,k)+1._wp + if (cospIN%frac_out(j,i,k) .eq. 2) frac_cv(j,k) = frac_cv(j,k)+1._wp + if (frac_prec(j,i,k) .eq. 1) prec_ls(j,k) = prec_ls(j,k)+1._wp + if (frac_prec(j,i,k) .eq. 2) prec_cv(j,k) = prec_cv(j,k)+1._wp + if (frac_prec(j,i,k) .eq. 3) prec_cv(j,k) = prec_cv(j,k)+1._wp + if (frac_prec(j,i,k) .eq. 3) prec_ls(j,k) = prec_ls(j,k)+1._wp + enddo + frac_ls(j,k)=frac_ls(j,k)/nColumns + frac_cv(j,k)=frac_cv(j,k)/nColumns + prec_ls(j,k)=prec_ls(j,k)/nColumns + prec_cv(j,k)=prec_cv(j,k)/nColumns + + ! Adjust grid-box mean snow properties to local properties + ! Convert longwave optical depth to longwave emissivity + if (prec_ls(j,k) .ne. 0._r8 .and. dtau_s_snow(j,k) .gt. 0._r8) then + dtau_s_snow(j,k) = dtau_s_snow(j,k)/prec_ls(j,k) + end if + if (prec_ls(j,k) .ne. 0._r8 .and. dem_s_snow(j,k) .gt. 0._r8) then + dem_s_snow(j,k) = dem_s_snow(j,k)/prec_ls(j,k) + dem_s_snow(j,k) = 1._r8 - exp ( -1._r8*dem_s_snow(j,k)) + end if !!+JEK + enddo + enddo + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Compute mixing ratios, effective radii and precipitation fluxes for clouds + ! and precipitation + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & + Reff(nPoints,nColumns,nLevels,nHydro), & + Np(nPoints,nColumns,nLevels,nHydro)) + + ! Initialize + mr_hydro(:,:,:,:) = 0._wp + Reff(:,:,:,:) = 0._wp + Np(:,:,:,:) = 0._wp + + do k=1,nColumns + ! Subcolumn clouds + column_frac_out = cospIN%frac_out(:,k,:) + + ! LS clouds + where (column_frac_out == I_LSC) + mr_hydro(:,k,:,I_LSCLIQ) = mr_lsliq + mr_hydro(:,k,:,I_LSCICE) = mr_lsice + Reff(:,k,:,I_LSCLIQ) = ReffIN(:,:,I_LSCLIQ) + Reff(:,k,:,I_LSCICE) = ReffIN(:,:,I_LSCICE) + ! CONV clouds + elsewhere (column_frac_out == I_CVC) + mr_hydro(:,k,:,I_CVCLIQ) = mr_ccliq + mr_hydro(:,k,:,I_CVCICE) = mr_ccice + Reff(:,k,:,I_CVCLIQ) = ReffIN(:,:,I_CVCLIQ) + Reff(:,k,:,I_CVCICE) = ReffIN(:,:,I_CVCICE) + end where + + ! Subcolumn precipitation + column_prec_out = frac_prec(:,k,:) + + ! LS Precipitation + where ((column_prec_out == 1) .or. (column_prec_out == 3) ) + Reff(:,k,:,I_LSRAIN) = ReffIN(:,:,I_LSRAIN) + Reff(:,k,:,I_LSSNOW) = ReffIN(:,:,I_LSSNOW) + Reff(:,k,:,I_LSGRPL) = ReffIN(:,:,I_LSGRPL) + ! CONV precipitation + elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) + Reff(:,k,:,I_CVRAIN) = ReffIN(:,:,I_CVRAIN) + Reff(:,k,:,I_CVSNOW) = ReffIN(:,:,I_CVSNOW) + end where + enddo + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Convert the mixing ratio and precipitation fluxes from gridbox mean to + ! the fraction-based values + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + do k=1,nLevels + do j=1,nPoints + ! Clouds + if (frac_ls(j,k) .ne. 0._r8) then + mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k) + mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k) + endif + if (frac_cv(j,k) .ne. 0._r8) then + mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k) + mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k) + endif + + ! Precipitation + if (use_precipitation_fluxes) then + if (prec_ls(j,k) .ne. 0._r8) then + fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) + fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) + fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) + endif + if (prec_cv(j,k) .ne. 0._r8) then + fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) + fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) + endif + else + if (prec_ls(j,k) .ne. 0._r8) then + mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k) + mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k) + mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k) + endif + if (prec_cv(j,k) .ne. 0._r8) then + mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k) + mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k) + endif + endif + enddo + enddo + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Convert precipitation fluxes to mixing ratios + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if (use_precipitation_fluxes) then + ! LS rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & + alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & + a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & + gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & + mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) + ! LS snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & + alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & + a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & + gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & + mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) + ! CV rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & + alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & + a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & + gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & + mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) + ! CV snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & + alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & + a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & + gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & + mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) + ! LS groupel. + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & + alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & + a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & + gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & + mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) + endif + + else + cospIN%frac_out(:,:,:) = 1 + allocate(mr_hydro(nPoints, 1,nLevels,nHydro),Reff(nPoints,1,nLevels,nHydro), & + Np(nPoints,1,nLevels,nHydro)) + mr_hydro(:,1,:,I_LSCLIQ) = mr_lsliq + mr_hydro(:,1,:,I_LSCICE) = mr_lsice + mr_hydro(:,1,:,I_CVCLIQ) = mr_ccliq + mr_hydro(:,1,:,I_CVCICE) = mr_ccice + Reff(:,1,:,:) = ReffIN + endif + call t_stopf("scops") + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! CLOUDSAT RADAR OPTICS + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call t_startf("cloudsat_optics") + if (lradar_sim) then + ! Compute gaseous absorption (assume identical for each subcolun) + allocate(g_vol(nPoints,nLevels)) + g_vol(:,:)=0._wp + do i = 1, nPoints + do j = 1, nLevels + if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. & + (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j == 1)) then + g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j), & + cospstateIN%qv(i,j), cospIN%rcfg_cloudsat%freq) + endif + cospIN%g_vol_cloudsat(i,:,j) = g_vol(i,j) + end do + end do + + ! Loop over all subcolumns + do k=1,nColumns + call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF, & + mr_hydro(:,k,:,1:nHydro)*1000._wp, Reff(:,k,:,1:nHydro)*1.e6_wp, & + Np(:,k,:,1:nHydro), cospstateIN%pfull, cospstateIN%at, & + cospstateIN%qv, cospIN%z_vol_cloudsat(1:nPoints,k,:), & + cospIN%kr_vol_cloudsat(1:nPoints,k,:)) + enddo + endif + call t_stopf("cloudsat_optics") + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! LIDAR Polarized optics + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call t_startf("calipso_optics") + if (Llidar_sim) then + ReffTemp = ReffIN + call lidar_optics(nPoints,nColumns,nLevels,5,lidar_ice_type, & + mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSCLIQ), & + mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSCICE), & + mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_CVCLIQ), & + mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_CVCICE), & + mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSSNOW), & + ReffTemp(1:nPoints,1:nLevels,I_LSCLIQ), & + ReffTemp(1:nPoints,1:nLevels,I_LSCICE), & + ReffTemp(1:nPoints,1:nLevels,I_CVCLIQ), & + ReffTemp(1:nPoints,1:nLevels,I_CVCICE), & + ReffTemp(1:nPoints,1:nLevels,I_LSSNOW), & + cospstateIN%pfull(1:nPoints,1:nLevels), & + cospstateIN%phalf(1:nPoints,1:nLevels+1), & + cospstateIN%at(1:nPoints,1:nLevels), & + cospIN%beta_mol(1:nPoints,1:nLevels), & + cospIN%betatot(1:nPoints,1:nColumns,1:nLevels), & + cospIN%tau_mol(1:nPoints,1:nLevels), & + cospIN%tautot(1:nPoints,1:nColumns,1:nLevels), & + cospIN%tautot_S_liq(1:nPoints,1:nColumns), & + cospIN%tautot_S_ice(1:nPoints,1:nColumns), & + cospIN%betatot_ice(1:nPoints,1:nColumns,1:nLevels), & + cospIN%betatot_liq(1:nPoints,1:nColumns,1:nLevels), & + cospIN%tautot_ice(1:nPoints,1:nColumns,1:nLevels), & + cospIN%tautot_liq(1:nPoints,1:nColumns,1:nLevels)) + endif + call t_stopf("calipso_optics") + + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Compute optical fields for passive simulators (i.e. only sunlit points) + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 11 micron emissivity (needed by the ISCCP simulator) + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call t_startf("11micron_emissivity") + if (Lisccp_sim) then + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dem_c,dem_s, & + cospIN%emiss_11) + ! Add in contributions from radiative snow + do j=1,nColumns + where(frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) + cospIN%emiss_11(:,j,:) = 1._wp - (1- cospIN%emiss_11(:,j,:))*(1-dem_s_snow) + endwhere + enddo + endif + call t_stopf("11micron_emissivity") + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! 0.67 micron optical depth (needed by ISCCP, MISR and MODIS simulators) + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call t_startf("067tau") + if (Lisccp_sim .or. Lmisr_sim .or. Lmodis_sim) then + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dtau_c,dtau_s,& + cospIN%tau_067) + + ! Add in contributions from snow + do j=1,nColumns + where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. & + Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8) + cospIN%tau_067(:,j,:) = cospIN%tau_067(:,j,:)+dtau_s_snow + endwhere + enddo + endif + call t_stopf("067tau") + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! MODIS optics + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call t_startf("modis_optics") + if (lmodis_sim) then + allocate(MODIS_cloudWater(nPoints,nColumns,nLevels), & + MODIS_cloudIce(nPoints,nColumns,nLevels), & + MODIS_cloudSnow(nPoints,nColumns,nLevels), & + MODIS_waterSize(nPoints,nColumns,nLevels), & + MODIS_iceSize(nPoints,nColumns,nLevels), & + MODIS_snowSize(nPoints,nColumns,nLevels), & + MODIS_opticalThicknessLiq(nPoints,nColumns,nLevels), & + MODIS_opticalThicknessIce(nPoints,nColumns,nLevels), & + MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels)) + + ! Cloud water + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & + mr_hydro(:,:,:,I_CVCLIQ),mr_hydro(:,:,:,I_LSCLIQ),MODIS_cloudWater) + ! Cloud ice + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & + mr_hydro(:,:,:,I_CVCICE),mr_hydro(:,:,:,I_LSCICE),MODIS_cloudIce) + ! Cloud water droplet size + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & + Reff(:,:,:,I_CVCLIQ),Reff(:,:,:,I_LSCLIQ),MODIS_waterSize) + ! Cloud ice crystal size + call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & + Reff(:,:,:,I_CVCICE),Reff(:,:,:,I_LSCICE),MODIS_iceSize) + + ! Cloud snow and size + MODIS_snowSize(:,:,:) = Reff(:,:,:,I_LSSNOW) + do j=1,nColumns + where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. & + Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8) + MODIS_cloudSnow(:,j,:) = mr_hydro(:,j,:,I_LSSNOW) + MODIS_snowSize(:,j,:) = Reff(:,j,:,I_LSSNOW) + elsewhere + MODIS_snowSize(:,j,:) = 0._wp + MODIS_cloudSnow(:,j,:) = 0._wp + endwhere + enddo + + ! Partition optical thickness into liquid and ice parts + call modis_optics_partition(nPoints, nLevels, nColumns, MODIS_cloudWater, & + MODIS_cloudIce, MODIS_cloudSnow, MODIS_waterSize, MODIS_iceSize, & + MODIS_snowSize, cospIN%tau_067, MODIS_opticalThicknessLiq, & + MODIS_opticalThicknessIce, MODIS_opticalThicknessSnow) + + ! Compute assymetry parameter and single scattering albedo + call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, & + MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, & + MODIS_iceSize*1.0e6_wp, MODIS_opticalThicknessSnow, & + MODIS_snowSize*1.0e6_wp, cospIN%fracLiq, cospIN%asym, cospIN%ss_alb) + + endif ! MODIS simulator optics + call t_stopf("modis_optics") + + end subroutine subsample_and_optics + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE construct_cospIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine construct_cospIN(npoints,ncolumns,nlevels,y) + ! Inputs + integer,intent(in) :: & + npoints, & ! Number of horizontal gridpoints + ncolumns, & ! Number of subcolumns + nlevels ! Number of vertical levels + ! Outputs + type(cosp_optical_inputs),intent(out) :: y + + ! Dimensions + y%Npoints = Npoints + y%Ncolumns = Ncolumns + y%Nlevels = Nlevels + y%Npart = 4 + y%Nrefl = PARASOL_NREFL + + allocate(y%tau_067(npoints, ncolumns,nlevels),& + y%emiss_11(npoints, ncolumns,nlevels),& + y%frac_out(npoints, ncolumns,nlevels),& + y%betatot(npoints, ncolumns,nlevels),& + y%betatot_ice(npoints, ncolumns,nlevels),& + y%fracLiq(npoints, ncolumns,nlevels),& + y%betatot_liq(npoints, ncolumns,nlevels),& + y%tautot(npoints, ncolumns,nlevels),& + y%tautot_ice(npoints, ncolumns,nlevels),& + y%tautot_liq(npoints, ncolumns,nlevels),& + y%z_vol_cloudsat(npoints, ncolumns,nlevels),& + y%kr_vol_cloudsat(npoints,ncolumns,nlevels),& + y%g_vol_cloudsat(npoints, ncolumns,nlevels),& + y%asym(npoints, ncolumns,nlevels),& + y%ss_alb(npoints, ncolumns,nlevels),& + y%beta_mol(npoints, nlevels),& + y%tau_mol(npoints, nlevels),& + y%tautot_S_ice(npoints, ncolumns ),& + y%tautot_S_liq(npoints, ncolumns)) + end subroutine construct_cospIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE construct_cospstateIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine construct_cospstateIN(npoints,nlevels,nchan,y) + ! Inputs + integer,intent(in) :: & + npoints, & ! Number of horizontal gridpoints + nlevels, & ! Number of vertical levels + nchan ! Number of channels + ! Outputs + type(cosp_column_inputs),intent(out) :: y + + allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels), & + y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels), & + y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints), & + y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan), & + y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels), & + y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints), & + y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1)) + + end subroutine construct_cospstateIN + ! ###################################################################################### + ! SUBROUTINE construct_cosp_outputs + ! + ! This subroutine allocates output fields based on input logical flag switches. + ! ###################################################################################### + subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) + ! Inputs + integer,intent(in) :: & + Npoints, & ! Number of sampled points + Ncolumns, & ! Number of subgrid columns + Nlevels, & ! Number of model levels + Nlvgrid, & ! Number of levels in L3 stats computation + Nchan ! Number of RTTOV channels + + ! Outputs + type(cosp_outputs),intent(out) :: & + x ! COSP output structure + + ! ISCCP simulator outputs + if (lisccp_sim) then + allocate(x%isccp_boxtau(Npoints,Ncolumns)) + allocate(x%isccp_boxptop(Npoints,Ncolumns)) + allocate(x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins)) + allocate(x%isccp_totalcldarea(Npoints)) + allocate(x%isccp_meanptop(Npoints)) + allocate(x%isccp_meantaucld(Npoints)) + allocate(x%isccp_meantb(Npoints)) + allocate(x%isccp_meantbclr(Npoints)) + allocate(x%isccp_meanalbedocld(Npoints)) + endif + + ! MISR simulator + if (lmisr_sim) then + allocate(x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins)) + ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so + ! they are still computed. Should probably have a logical to control these + ! outputs. + allocate(x%misr_dist_model_layertops(Npoints,numMISRHgtBins)) + allocate(x%misr_meanztop(Npoints)) + allocate(x%misr_cldarea(Npoints)) + endif + + ! MODIS simulator + if (lmodis_sim) then + allocate(x%modis_Cloud_Fraction_Total_Mean(Npoints)) + allocate(x%modis_Cloud_Fraction_Water_Mean(Npoints)) + allocate(x%modis_Cloud_Fraction_Ice_Mean(Npoints)) + allocate(x%modis_Cloud_Fraction_High_Mean(Npoints)) + allocate(x%modis_Cloud_Fraction_Mid_Mean(Npoints)) + allocate(x%modis_Cloud_Fraction_Low_Mean(Npoints)) + allocate(x%modis_Optical_Thickness_Total_Mean(Npoints)) + allocate(x%modis_Optical_Thickness_Water_Mean(Npoints)) + allocate(x%modis_Optical_Thickness_Ice_Mean(Npoints)) + allocate(x%modis_Optical_Thickness_Total_LogMean(Npoints)) + allocate(x%modis_Optical_Thickness_Water_LogMean(Npoints)) + allocate(x%modis_Optical_Thickness_Ice_LogMean(Npoints)) + allocate(x%modis_Cloud_Particle_Size_Water_Mean(Npoints)) + allocate(x%modis_Cloud_Particle_Size_Ice_Mean(Npoints)) + allocate(x%modis_Cloud_Top_Pressure_Total_Mean(Npoints)) + allocate(x%modis_Liquid_Water_Path_Mean(Npoints)) + allocate(x%modis_Ice_Water_Path_Mean(Npoints)) + allocate(x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins)) + allocate(x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins)) + allocate(x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins)) + endif + + ! LIDAR simulator + if (llidar_sim) then + allocate(x%calipso_beta_mol(Npoints,Nlevels)) + allocate(x%calipso_beta_tot(Npoints,Ncolumns,Nlevels)) + allocate(x%calipso_srbval(SR_BINS+1)) + allocate(x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid)) + allocate(x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels)) + allocate(x%calipso_lidarcld(Npoints,Nlvgrid)) + allocate(x%calipso_cldlayer(Npoints,LIDAR_NCAT)) + allocate(x%calipso_lidarcldphase(Npoints,Nlvgrid,6)) + allocate(x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5)) + allocate(x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6)) + ! These 2 outputs are part of the calipso output type, but are not controlled by an + ! logical switch in the output namelist, so if all other fields are on, then allocate + allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels)) + allocate(x%calipso_temp_tot(Npoints,Nlevels)) + endif + + ! PARASOL + if (lparasol_sim) then + allocate(x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL)) + allocate(x%parasolGrid_refl(Npoints,PARASOL_NREFL)) + endif + + ! Cloudsat simulator + if (lradar_sim) then + allocate(x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels)) + allocate(x%cloudsat_cfad_ze(Npoints,DBZE_BINS,Nlvgrid)) + allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid)) + allocate(x%radar_lidar_tcc(Npoints)) + endif + + end subroutine construct_cosp_outputs + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE destroy_cospIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine destroy_cospIN(y) + type(cosp_optical_inputs),intent(inout) :: y + + if (allocated(y%tau_067)) deallocate(y%tau_067) + if (allocated(y%emiss_11)) deallocate(y%emiss_11) + if (allocated(y%frac_out)) deallocate(y%frac_out) + if (allocated(y%beta_mol)) deallocate(y%beta_mol) + if (allocated(y%tau_mol)) deallocate(y%tau_mol) + if (allocated(y%betatot)) deallocate(y%betatot) + if (allocated(y%betatot_ice)) deallocate(y%betatot_ice) + if (allocated(y%betatot_liq)) deallocate(y%betatot_liq) + if (allocated(y%tautot)) deallocate(y%tautot) + if (allocated(y%tautot_ice)) deallocate(y%tautot_ice) + if (allocated(y%tautot_liq)) deallocate(y%tautot_liq) + if (allocated(y%tautot_S_liq)) deallocate(y%tautot_S_liq) + if (allocated(y%tautot_S_ice)) deallocate(y%tautot_S_ice) + if (allocated(y%z_vol_cloudsat)) deallocate(y%z_vol_cloudsat) + if (allocated(y%kr_vol_cloudsat)) deallocate(y%kr_vol_cloudsat) + if (allocated(y%g_vol_cloudsat)) deallocate(y%g_vol_cloudsat) + if (allocated(y%asym)) deallocate(y%asym) + if (allocated(y%ss_alb)) deallocate(y%ss_alb) + if (allocated(y%fracLiq)) deallocate(y%fracLiq) + + end subroutine destroy_cospIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE destroy_cospstateIN + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine destroy_cospstateIN(y) + type(cosp_column_inputs),intent(inout) :: y + + if (allocated(y%sunlit)) deallocate(y%sunlit) + if (allocated(y%skt)) deallocate(y%skt) + if (allocated(y%land)) deallocate(y%land) + if (allocated(y%at)) deallocate(y%at) + if (allocated(y%pfull)) deallocate(y%pfull) + if (allocated(y%phalf)) deallocate(y%phalf) + if (allocated(y%qv)) deallocate(y%qv) + if (allocated(y%o3)) deallocate(y%o3) + if (allocated(y%hgt_matrix)) deallocate(y%hgt_matrix) + if (allocated(y%u_sfc)) deallocate(y%u_sfc) + if (allocated(y%v_sfc)) deallocate(y%v_sfc) + if (allocated(y%lat)) deallocate(y%lat) + if (allocated(y%lon)) deallocate(y%lon) + if (allocated(y%emis_sfc)) deallocate(y%emis_sfc) + if (allocated(y%cloudIce)) deallocate(y%cloudIce) + if (allocated(y%cloudLiq)) deallocate(y%cloudLiq) + if (allocated(y%seaice)) deallocate(y%seaice) + if (allocated(y%fl_rain)) deallocate(y%fl_rain) + if (allocated(y%fl_snow)) deallocate(y%fl_snow) + if (allocated(y%tca)) deallocate(y%tca) + if (allocated(y%hgt_matrix_half)) deallocate(y%hgt_matrix_half) + + end subroutine destroy_cospstateIN + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! SUBROUTINE destroy_cosp_outputs + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + subroutine destroy_cosp_outputs(y) + type(cosp_outputs),intent(inout) :: y + + ! Deallocate and nullify + if (associated(y%calipso_beta_mol)) then + deallocate(y%calipso_beta_mol) + nullify(y%calipso_beta_mol) + endif + if (associated(y%calipso_temp_tot)) then + deallocate(y%calipso_temp_tot) + nullify(y%calipso_temp_tot) + endif + if (associated(y%calipso_betaperp_tot)) then + deallocate(y%calipso_betaperp_tot) + nullify(y%calipso_betaperp_tot) + endif + if (associated(y%calipso_beta_tot)) then + deallocate(y%calipso_beta_tot) + nullify(y%calipso_beta_tot) + endif + if (associated(y%calipso_tau_tot)) then + deallocate(y%calipso_tau_tot) + nullify(y%calipso_tau_tot) + endif + if (associated(y%calipso_lidarcldphase)) then + deallocate(y%calipso_lidarcldphase) + nullify(y%calipso_lidarcldphase) + endif + if (associated(y%calipso_cldlayerphase)) then + deallocate(y%calipso_cldlayerphase) + nullify(y%calipso_cldlayerphase) + endif + if (associated(y%calipso_lidarcldtmp)) then + deallocate(y%calipso_lidarcldtmp) + nullify(y%calipso_lidarcldtmp) + endif + if (associated(y%calipso_cldlayer)) then + deallocate(y%calipso_cldlayer) + nullify(y%calipso_cldlayer) + endif + if (associated(y%calipso_lidarcld)) then + deallocate(y%calipso_lidarcld) + nullify(y%calipso_lidarcld) + endif + if (associated(y%calipso_srbval)) then + deallocate(y%calipso_srbval) + nullify(y%calipso_srbval) + endif + if (associated(y%calipso_cfad_sr)) then + deallocate(y%calipso_cfad_sr) + nullify(y%calipso_cfad_sr) + endif + if (associated(y%parasolPix_refl)) then + deallocate(y%parasolPix_refl) + nullify(y%parasolPix_refl) + endif + if (associated(y%parasolGrid_refl)) then + deallocate(y%parasolGrid_refl) + nullify(y%parasolGrid_refl) + endif + if (associated(y%cloudsat_Ze_tot)) then + deallocate(y%cloudsat_Ze_tot) + nullify(y%cloudsat_Ze_tot) + endif + if (associated(y%cloudsat_cfad_ze)) then + deallocate(y%cloudsat_cfad_ze) + nullify(y%cloudsat_cfad_ze) + endif + if (associated(y%radar_lidar_tcc)) then + deallocate(y%radar_lidar_tcc) + nullify(y%radar_lidar_tcc) + endif + if (associated(y%lidar_only_freq_cloud)) then + deallocate(y%lidar_only_freq_cloud) + nullify(y%lidar_only_freq_cloud) + endif + if (associated(y%isccp_totalcldarea)) then + deallocate(y%isccp_totalcldarea) + nullify(y%isccp_totalcldarea) + endif + if (associated(y%isccp_meantb)) then + deallocate(y%isccp_meantb) + nullify(y%isccp_meantb) + endif + if (associated(y%isccp_meantbclr)) then + deallocate(y%isccp_meantbclr) + nullify(y%isccp_meantbclr) + endif + if (associated(y%isccp_meanptop)) then + deallocate(y%isccp_meanptop) + nullify(y%isccp_meanptop) + endif + if (associated(y%isccp_meantaucld)) then + deallocate(y%isccp_meantaucld) + nullify(y%isccp_meantaucld) + endif + if (associated(y%isccp_meanalbedocld)) then + deallocate(y%isccp_meanalbedocld) + nullify(y%isccp_meanalbedocld) + endif + if (associated(y%isccp_boxtau)) then + deallocate(y%isccp_boxtau) + nullify(y%isccp_boxtau) + endif + if (associated(y%isccp_boxptop)) then + deallocate(y%isccp_boxptop) + nullify(y%isccp_boxptop) + endif + if (associated(y%isccp_fq)) then + deallocate(y%isccp_fq) + nullify(y%isccp_fq) + endif + if (associated(y%misr_fq)) then + deallocate(y%misr_fq) + nullify(y%misr_fq) + endif + if (associated(y%misr_dist_model_layertops)) then + deallocate(y%misr_dist_model_layertops) + nullify(y%misr_dist_model_layertops) + endif + if (associated(y%misr_meanztop)) then + deallocate(y%misr_meanztop) + nullify(y%misr_meanztop) + endif + if (associated(y%misr_cldarea)) then + deallocate(y%misr_cldarea) + nullify(y%misr_cldarea) + endif + if (associated(y%rttov_tbs)) then + deallocate(y%rttov_tbs) + nullify(y%rttov_tbs) + endif + if (associated(y%modis_Cloud_Fraction_Total_Mean)) then + deallocate(y%modis_Cloud_Fraction_Total_Mean) + nullify(y%modis_Cloud_Fraction_Total_Mean) + endif + if (associated(y%modis_Cloud_Fraction_Ice_Mean)) then + deallocate(y%modis_Cloud_Fraction_Ice_Mean) + nullify(y%modis_Cloud_Fraction_Ice_Mean) + endif + if (associated(y%modis_Cloud_Fraction_Water_Mean)) then + deallocate(y%modis_Cloud_Fraction_Water_Mean) + nullify(y%modis_Cloud_Fraction_Water_Mean) + endif + if (associated(y%modis_Cloud_Fraction_High_Mean)) then + deallocate(y%modis_Cloud_Fraction_High_Mean) + nullify(y%modis_Cloud_Fraction_High_Mean) + endif + if (associated(y%modis_Cloud_Fraction_Mid_Mean)) then + deallocate(y%modis_Cloud_Fraction_Mid_Mean) + nullify(y%modis_Cloud_Fraction_Mid_Mean) + endif + if (associated(y%modis_Cloud_Fraction_Low_Mean)) then + deallocate(y%modis_Cloud_Fraction_Low_Mean) + nullify(y%modis_Cloud_Fraction_Low_Mean) + endif + if (associated(y%modis_Optical_Thickness_Total_Mean)) then + deallocate(y%modis_Optical_Thickness_Total_Mean) + nullify(y%modis_Optical_Thickness_Total_Mean) + endif + if (associated(y%modis_Optical_Thickness_Water_Mean)) then + deallocate(y%modis_Optical_Thickness_Water_Mean) + nullify(y%modis_Optical_Thickness_Water_Mean) + endif + if (associated(y%modis_Optical_Thickness_Ice_Mean)) then + deallocate(y%modis_Optical_Thickness_Ice_Mean) + nullify(y%modis_Optical_Thickness_Ice_Mean) + endif + if (associated(y%modis_Optical_Thickness_Total_LogMean)) then + deallocate(y%modis_Optical_Thickness_Total_LogMean) + nullify(y%modis_Optical_Thickness_Total_LogMean) + endif + if (associated(y%modis_Optical_Thickness_Water_LogMean)) then + deallocate(y%modis_Optical_Thickness_Water_LogMean) + nullify(y%modis_Optical_Thickness_Water_LogMean) + endif + if (associated(y%modis_Optical_Thickness_Ice_LogMean)) then + deallocate(y%modis_Optical_Thickness_Ice_LogMean) + nullify(y%modis_Optical_Thickness_Ice_LogMean) + endif + if (associated(y%modis_Cloud_Particle_Size_Water_Mean)) then + deallocate(y%modis_Cloud_Particle_Size_Water_Mean) + nullify(y%modis_Cloud_Particle_Size_Water_Mean) + endif + if (associated(y%modis_Cloud_Particle_Size_Ice_Mean)) then + deallocate(y%modis_Cloud_Particle_Size_Ice_Mean) + nullify(y%modis_Cloud_Particle_Size_Ice_Mean) + endif + if (associated(y%modis_Cloud_Top_Pressure_Total_Mean)) then + deallocate(y%modis_Cloud_Top_Pressure_Total_Mean) + nullify(y%modis_Cloud_Top_Pressure_Total_Mean) + endif + if (associated(y%modis_Liquid_Water_Path_Mean)) then + deallocate(y%modis_Liquid_Water_Path_Mean) + nullify(y%modis_Liquid_Water_Path_Mean) + endif + if (associated(y%modis_Ice_Water_Path_Mean)) then + deallocate(y%modis_Ice_Water_Path_Mean) + nullify(y%modis_Ice_Water_Path_Mean) + endif + if (associated(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)) then + deallocate(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure) + nullify(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure) + endif + if (associated(y%modis_Optical_thickness_vs_ReffLIQ)) then + deallocate(y%modis_Optical_thickness_vs_ReffLIQ) + nullify(y%modis_Optical_thickness_vs_ReffLIQ) + endif + if (associated(y%modis_Optical_thickness_vs_ReffICE)) then + deallocate(y%modis_Optical_thickness_vs_ReffICE) + nullify(y%modis_Optical_thickness_vs_ReffICE) + endif + + end subroutine destroy_cosp_outputs +#endif + +!####################################################################### +end module cospsimulator_intr diff --git a/src/physics/cam/cpslec.F90 b/src/physics/cam/cpslec.F90 new file mode 100644 index 0000000000..cb29dc29e7 --- /dev/null +++ b/src/physics/cam/cpslec.F90 @@ -0,0 +1,81 @@ + +subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) + +!----------------------------------------------------------------------- +! +! Purpose: +! Hybrid coord version: Compute sea level pressure for a latitude line +! +! Method: +! CCM2 hybrid coord version using ECMWF formulation +! Algorithm: See section 3.1.b in NCAR NT-396 "Vertical +! Interpolation and Truncation of Model-Coordinate Data +! +! Author: Stolen from the Processor by Erik Kluzek +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + + implicit none + +!-----------------------------Arguments--------------------------------- + integer , intent(in) :: ncol ! longitude dimension + + real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) + real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m**2/sec**2) + real(r8), intent(in) :: ps(pcols) ! Surface pressure (pascals) + real(r8), intent(in) :: T(pcols,pver) ! Vertical slice of temperature (top to bot) + real(r8), intent(in) :: gravit ! Gravitational acceleration + real(r8), intent(in) :: rair ! gas constant for dry air + + real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) +!----------------------------------------------------------------------- + +!-----------------------------Parameters-------------------------------- + real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) +!----------------------------------------------------------------------- + +!-----------------------------Local Variables--------------------------- + integer i ! Loop index + real(r8) alpha ! Temperature lapse rate in terms of pressure ratio (unitless) + real(r8) Tstar ! Computed surface temperature + real(r8) TT0 ! Computed temperature at sea-level + real(r8) alph ! Power to raise P/Ps to get rate of increase of T with pressure + real(r8) beta ! alpha*phis/(R*T) term used in approximation of PSL +!----------------------------------------------------------------------- +! + alpha = rair*xlapse/gravit + do i=1,ncol + if ( abs(phis(i)/gravit) < 1.e-4_r8 )then + psl(i)=ps(i) + else + Tstar=T(i,pver)*(1._r8+alpha*(ps(i)/pmid(i,pver)-1._r8)) ! pg 7 eq 5 + + TT0=Tstar + xlapse*phis(i)/gravit ! pg 8 eq 13 + + if ( Tstar<=290.5_r8 .and. TT0>290.5_r8 ) then ! pg 8 eq 14.1 + alph=rair/phis(i)*(290.5_r8-Tstar) + else if (Tstar>290.5_r8 .and. TT0>290.5_r8) then ! pg 8 eq 14.2 + alph=0._r8 + Tstar= 0.5_r8 * (290.5_r8 + Tstar) + else + alph=alpha + if (Tstar<255._r8) then + Tstar= 0.5_r8 * (255._r8 + Tstar) ! pg 8 eq 14.3 + endif + endif + + beta = phis(i)/(rair*Tstar) + psl(i)=ps(i)*exp( beta*(1._r8-alph*beta/2._r8+((alph*beta)**2)/3._r8)) + end if + enddo + + return +end subroutine cpslec diff --git a/src/physics/cam/dadadj.F90 b/src/physics/cam/dadadj.F90 new file mode 100644 index 0000000000..b9762f8f5f --- /dev/null +++ b/src/physics/cam/dadadj.F90 @@ -0,0 +1,174 @@ +module dadadj +!----------------------------------------------------------------------- +! +! Purpose: +! GFDL style dry adiabatic adjustment +! +! Method: +! if stratification is unstable, adjustment to the dry adiabatic lapse +! rate is forced subject to the condition that enthalpy is conserved. +! +! Author: J.Hack +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +private +save + +public :: & + dadadj_initial, & + dadadj_calc + +integer :: nlvdry ! number of layers from top of model to apply the adjustment +integer :: niter ! number of iterations for convergence + +!=============================================================================== +contains +!=============================================================================== + +subroutine dadadj_initial(nlvdry_in, niter_in) + + integer, intent(in) :: nlvdry_in + integer, intent(in) :: niter_in + + nlvdry = nlvdry_in + niter = niter_in + +end subroutine dadadj_initial + +!=============================================================================== + +subroutine dadadj_calc( & + ncol, pmid, pint, pdel, cappav, t, & + q, dadpdf, icol_err) + + ! Arguments + + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: pmid(:,:) ! pressure at model levels + real(r8), intent(in) :: pint(:,:) ! pressure at model interfaces + real(r8), intent(in) :: pdel(:,:) ! vertical delta-p + real(r8), intent(in) :: cappav(:,:) ! variable Kappa + + real(r8), intent(inout) :: t(:,:) ! temperature (K) + real(r8), intent(inout) :: q(:,:) ! specific humidity + + real(r8), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened + + integer, intent(out) :: icol_err ! index of column in which error occurred + + !---------------------------Local workspace----------------------------- + + integer :: i,k ! longitude, level indices + integer :: jiter ! iteration index + + real(r8), allocatable :: c1dad(:) ! intermediate constant + real(r8), allocatable :: c2dad(:) ! intermediate constant + real(r8), allocatable :: c3dad(:) ! intermediate constant + real(r8), allocatable :: c4dad(:) ! intermediate constant + real(r8) :: gammad ! dry adiabatic lapse rate (deg/Pa) + real(r8) :: zeps ! convergence criterion (deg/Pa) + real(r8) :: rdenom ! reciprocal of denominator of expression + real(r8) :: dtdp ! delta-t/delta-p + real(r8) :: zepsdp ! zeps*delta-p + real(r8) :: zgamma ! intermediate constant + real(r8) :: qave ! mean q between levels + real(r8) :: cappa ! Kappa at level intefaces + + logical :: ilconv ! .TRUE. ==> convergence was attained + logical :: dodad(ncol) ! .TRUE. ==> do dry adjustment + + !----------------------------------------------------------------------- + + icol_err = 0 + zeps = 2.0e-5_r8 ! set convergence criteria + + allocate(c1dad(nlvdry), c2dad(nlvdry), c3dad(nlvdry), c4dad(nlvdry)) + + ! Find gridpoints with unstable stratification + + do i = 1, ncol + cappa = 0.5_r8*(cappav(i,2) + cappav(i,1)) + gammad = cappa*0.5_r8*(t(i,2) + t(i,1))/pint(i,2) + dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) + dodad(i) = (dtdp + zeps) .gt. gammad + end do + + dadpdf(:ncol,:) = 0._r8 + do k= 2, nlvdry + do i = 1, ncol + cappa = 0.5_r8*(cappav(i,k+1) + cappav(i,k)) + gammad = cappa*0.5_r8*(t(i,k+1) + t(i,k))/pint(i,k+1) + dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) + dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad + if ((dtdp + zeps).gt.gammad) then + dadpdf(i,k) = 1._r8 + end if + end do + end do + + ! Make a dry adiabatic adjustment + ! Note: nlvdry ****MUST**** be < pver + + COL: do i = 1, ncol + + if (dodad(i)) then + + zeps = 2.0e-5_r8 + + do k = 1, nlvdry + c1dad(k) = cappa*0.5_r8*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) + c2dad(k) = (1._r8 - c1dad(k))/(1._r8 + c1dad(k)) + rdenom = 1._r8/(pdel(i,k)*c2dad(k) + pdel(i,k+1)) + c3dad(k) = rdenom*pdel(i,k) + c4dad(k) = rdenom*pdel(i,k+1) + end do + +50 continue + + do jiter = 1, niter + ilconv = .true. + + do k = 1, nlvdry + zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) + zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) + + if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then + ilconv = .false. + t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) + t(i,k) = c2dad(k)*t(i,k+1) + qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) + q(i,k+1) = qave + q(i,k) = qave + end if + + end do + + if (ilconv) cycle COL ! convergence => next longitude + end do + + ! Double convergence criterion if no convergence in niter iterations + + zeps = zeps + zeps + if (zeps > 1.e-4_r8) then + icol_err = i + return ! error return + else + go to 50 + end if + + end if + + end do COL + + deallocate(c1dad, c2dad, c3dad, c4dad) + +end subroutine dadadj_calc + +!=============================================================================== + +end module dadadj diff --git a/src/physics/cam/dadadj_cam.F90 b/src/physics/cam/dadadj_cam.F90 new file mode 100644 index 0000000000..31bcb324c8 --- /dev/null +++ b/src/physics/cam/dadadj_cam.F90 @@ -0,0 +1,137 @@ +module dadadj_cam + +! CAM interfaces for the dry adiabatic adjustment parameterization + +use shr_kind_mod, only: r8=>shr_kind_r8, cs=>shr_kind_cs +use ppgrid, only: pcols, pver, pverp +use constituents, only: pcnst +use physconst, only: cappav, cpairv, pi +use physics_types, only: physics_state, physics_ptend, physics_ptend_init +use phys_control, only: use_simple_phys +use cam_abortutils, only: endrun +use cam_logfile, only: iulog +use error_messages, only: handle_errmsg + +use spmd_utils, only: masterproc, masterprocid, mpicom, mpi_integer +use namelist_utils, only: find_group_name +use units, only: getunit, freeunit + +use dadadj, only: dadadj_initial, dadadj_calc + +implicit none +private +save + +public :: & + dadadj_readnl, & + dadadj_init, & + dadadj_tend + +! Namelist variables +integer :: dadadj_nlvdry = 3 ! number of layers from top of model to apply the adjustment +integer :: dadadj_niter = 15 ! number of iterations for convergence + +!=============================================================================== +contains +!=============================================================================== + +subroutine dadadj_readnl(filein) + + character(len=cs), intent(in) :: filein ! Input namelist filename + + namelist /dadadj_nl/ dadadj_nlvdry, dadadj_niter + + integer :: unitn, ierr + character(len=*), parameter :: sub='dadadj_readnl' + !------------------------------------------------------------------ + + ! Read namelist + if (masterproc) then + unitn = getunit() + open(unitn, file=trim(filein), status='old') + call find_group_name(unitn, 'dadadj_nl', status=ierr) + if (ierr == 0) then + read(unitn, dadadj_nl, iostat=ierr) + if (ierr /= 0) then + call endrun( sub//':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(dadadj_nlvdry, 1, mpi_integer, masterprocid, mpicom) + call mpibcast(dadadj_niter, 1, mpi_integer, masterprocid, mpicom) +#endif + + call dadadj_initial(dadadj_nlvdry, dadadj_niter) + + if (masterproc .and. .not. use_simple_phys) then + write(iulog,*)'Dry adiabatic adjustment applied to top N layers; N=', & + dadadj_nlvdry + write(iulog,*)'Dry adiabatic adjustment number of iterations for convergence =', & + dadadj_niter + end if + +end subroutine dadadj_readnl + + +!=============================================================================== + +subroutine dadadj_init() + use cam_history, only: addfld + + call addfld('DADADJ_PD', (/ 'lev' /), 'A', 'probability', 'dry adiabatic adjustment probability') + +end subroutine dadadj_init + + +!=============================================================================== + +subroutine dadadj_tend(dt, state, ptend) + use cam_history, only: outfld + + real(r8), intent(in) :: dt ! Time step [s] + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! parameterization tendencies + + logical :: lq(pcnst) + real(r8) :: dadpdf(pcols, pver) + integer :: ncol, lchnk, icol_err + character(len=128) :: errstring ! Error string + + ncol = state%ncol + lchnk = state%lchnk + lq(:) = .FALSE. + lq(1) = .TRUE. + call physics_ptend_init(ptend, state%psetcols, 'dadadj', ls=.true., lq=lq) + + ! use the ptend components for temporary storate and copy state info for input to + ! dadadj_calc which directly updates the temperature and moisture input arrays. + + ptend%s(:ncol,:pver) = state%t(:ncol,:pver) + ptend%q(:ncol,:pver,1) = state%q(:ncol,:pver,1) + + call dadadj_calc( & + ncol, state%pmid, state%pint, state%pdel, cappav(:,:,lchnk), ptend%s, & + ptend%q(:,:,1), dadpdf, icol_err) + + call outfld('DADADJ_PD', dadpdf(:ncol,:), ncol, lchnk) + + if (icol_err > 0) then + ! error exit + write(errstring, *) & + 'dadadj_calc: No convergence in column at lat,lon:', & + state%lat(icol_err)*180._r8/pi, state%lon(icol_err)*180._r8/pi + call handle_errmsg(errstring, subname="dadadj_tend") + end if + + ptend%s(:ncol,:) = (ptend%s(:ncol,:) - state%t(:ncol,:) )/dt * cpairv(:ncol,:,lchnk) + ptend%q(:ncol,:,1) = (ptend%q(:ncol,:,1) - state%q(:ncol,:,1))/dt + +end subroutine dadadj_tend + +!=============================================================================== +end module dadadj_cam diff --git a/src/physics/cam/diffusion_solver.F90 b/src/physics/cam/diffusion_solver.F90 new file mode 100644 index 0000000000..fd33773066 --- /dev/null +++ b/src/physics/cam/diffusion_solver.F90 @@ -0,0 +1,989 @@ + + module diffusion_solver + + !------------------------------------------------------------------------------------ ! + ! Module to solve vertical diffusion equations using a tri-diagonal solver. ! + ! The module will also apply countergradient fluxes, and apply molecular ! + ! diffusion for constituents. ! + ! ! + ! Public interfaces : ! + ! init_vdiff initializes time independent coefficients ! + ! compute_vdiff solves diffusion equations ! + ! vdiff_selector type for storing fields selected to be diffused ! + ! vdiff_select selects fields to be diffused ! + ! operator(.not.) extends .not. to operate on type vdiff_selector ! + ! any provides functionality of intrinsic any for type vdiff_selector ! + ! ! + !------------------------------------ Code History ---------------------------------- ! + ! Initial subroutines : B. Boville and others, 1991-2004 ! + ! Modularization : J. McCaa, September 2004 ! + ! Most Recent Code : Sungsu Park, Aug. 2006, Dec. 2008, Jan. 2010. ! + !------------------------------------------------------------------------------------ ! + + implicit none + private + save + + integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + + ! ----------------- ! + ! Public interfaces ! + ! ----------------- ! + + public init_vdiff ! Initialization + public new_fieldlist_vdiff ! Returns an empty fieldlist + public compute_vdiff ! Full routine + public vdiff_selector ! Type for storing fields selected to be diffused + public vdiff_select ! Selects fields to be diffused + public operator(.not.) ! Extends .not. to operate on type vdiff_selector + public any ! Provides functionality of intrinsic any for type vdiff_selector + + ! Below stores logical array of fields to be diffused + + type vdiff_selector + private + logical, allocatable, dimension(:) :: fields + end type vdiff_selector + + ! Below extends .not. to operate on type vdiff_selector + + interface operator(.not.) + module procedure not + end interface + + ! Below provides functionality of intrinsic any for type vdiff_selector + + interface any + module procedure my_any + end interface + + ! ------------ ! + ! Private data ! + ! ------------ ! + + ! Unit number for log output + integer :: iulog = -1 + + real(r8), private :: cpair ! Specific heat of dry air + real(r8), private :: gravit ! Acceleration due to gravity + real(r8), private :: rair ! Gas constant for dry air + + logical, private :: do_iss ! Use implicit turbulent surface stress computation + + ! Parameters used for Turbulent Mountain Stress + + real(r8), parameter :: z0fac = 0.025_r8 ! Factor determining z_0 from orographic standard deviation + real(r8), parameter :: z0max = 100._r8 ! Max value of z_0 for orography + real(r8), parameter :: horomin = 10._r8 ! Min value of subgrid orographic height for mountain stress + real(r8), parameter :: dv2min = 0.01_r8 ! Minimum shear squared + + logical :: am_correction ! logical switch for AM correction + + contains + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine init_vdiff( kind, iulog_in, rair_in, cpair_in, gravit_in, do_iss_in, & + am_correction_in, errstring ) + + integer, intent(in) :: kind ! Kind used for reals + integer, intent(in) :: iulog_in ! Unit number for log output. + real(r8), intent(in) :: rair_in ! Input gas constant for dry air + real(r8), intent(in) :: cpair_in ! Input heat capacity for dry air + real(r8), intent(in) :: gravit_in ! Input gravitational acceleration + logical, intent(in) :: do_iss_in ! Input ISS flag + logical, intent(in) :: am_correction_in! for angular momentum conservation + character(128), intent(out) :: errstring ! Output status + + errstring = '' + iulog = iulog_in + if( kind .ne. r8 ) then + write(iulog,*) 'KIND of reals passed to init_vdiff -- exiting.' + errstring = 'init_vdiff' + return + endif + + rair = rair_in + cpair = cpair_in + gravit = gravit_in + do_iss = do_iss_in + am_correction = am_correction_in + + end subroutine init_vdiff + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + type(vdiff_selector) pure function new_fieldlist_vdiff(ncnst) + + integer, intent(in) :: ncnst ! Number of constituents + + allocate( new_fieldlist_vdiff%fields( 3 + ncnst ) ) + new_fieldlist_vdiff%fields = .false. + + end function new_fieldlist_vdiff + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + subroutine compute_vdiff( lchnk , & + pcols , pver , ncnst , ncol , tint , & + p , t , rhoi , ztodt , taux , & + tauy , shflx , cflx , & + kvh , kvm , kvq , cgs , cgh , & + zi , ksrftms , dragblj , & + qmincg , fieldlist , fieldlistm , & + u , v , q , dse , & + tautmsx , tautmsy , dtk , topflx , errstring , & + tauresx , tauresy , itaures , cpairv , dse_top, & + do_molec_diff , use_temperature_molec_diff, vd_lu_qdecomp, & + ubc_mmr, ubc_flux, kvt, pmid, & + cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, & + kq_scal, mw_fac) + + !-------------------------------------------------------------------------- ! + ! Driver routine to compute vertical diffusion of momentum, moisture, trace ! + ! constituents and dry static energy. The new temperature is computed from ! + ! the diffused dry static energy. ! + ! Turbulent diffusivities and boundary layer nonlocal transport terms are ! + ! obtained from the turbulence module. ! + !-------------------------------------------------------------------------- ! + +! Used for CAM debugging. +! use phys_debug_util, only : phys_debug_col +! use time_manager, only : is_first_step, get_nstep + + use coords_1d, only: Coords1D + use linear_1d_operators, only : BoundaryType, BoundaryFixedLayer, & + BoundaryData, BoundaryFlux, TriDiagDecomp + use vdiff_lu_solver, only : fin_vol_lu_decomp + use beljaars_drag_cam, only : do_beljaars + ! FIXME: This should not be needed + use physconst, only: rairv + + use phys_control, only : phys_getopts + + ! Modification : Ideally, we should diffuse 'liquid-ice static energy' (sl), not the dry static energy. + ! Also, vertical diffusion of cloud droplet number concentration and aerosol number + ! concentration should be done very carefully in the future version. + + ! --------------- ! + ! Input Arguments ! + ! --------------- ! + + integer, intent(in) :: lchnk + integer, intent(in) :: pcols + integer, intent(in) :: pver + integer, intent(in) :: ncnst + integer, intent(in) :: ncol ! Number of atmospheric columns + integer, intent(in) :: itaures ! Indicator determining whether 'tauresx,tauresy' + ! is updated (1) or non-updated (0) in this subroutine. + + type(Coords1D), intent(in) :: p ! Pressure coordinates [ Pa ] + real(r8), intent(in) :: tint(pcols,pver+1) ! Temperature [ K ] + real(r8), intent(in) :: t(pcols,pver) ! Temperature [ K ] + real(r8), intent(in) :: rhoi(pcols,pver+1) ! Density of air at interfaces [ kg/m3 ] + real(r8), intent(in) :: ztodt ! 2 delta-t [ s ] + real(r8), intent(in) :: taux(pcols) ! Surface zonal stress. + ! Input u-momentum per unit time per unit area into the atmosphere [ N/m2 ] + real(r8), intent(in) :: tauy(pcols) ! Surface meridional stress. + ! Input v-momentum per unit time per unit area into the atmosphere [ N/m2 ] + real(r8), intent(in) :: shflx(pcols) ! Surface sensible heat flux [ W/m2 ] + real(r8), intent(in) :: cflx(pcols,ncnst) ! Surface constituent flux [ kg/m2/s ] + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface heights [ m ] + real(r8), intent(in) :: ksrftms(pcols) ! Surface drag coefficient for turbulent mountain stress. > 0. [ kg/s/m2 ] + real(r8), intent(in) :: dragblj(pcols,pver) ! Drag profile from Beljaars SGO form drag > 0. [ 1/s ] + real(r8), intent(in) :: qmincg(ncnst) ! Minimum constituent mixing ratios from cg fluxes + real(r8), intent(in) :: cpairv(pcols,pver) ! Specific heat at constant pressure + real(r8), intent(in) :: kvh(pcols,pver+1) ! Eddy diffusivity for heat [ m2/s ] + + logical, intent(in) :: do_molec_diff ! Flag indicating multiple constituent diffusivities + logical, intent(in) :: use_temperature_molec_diff! Flag indicating that molecular diffusion should apply to temperature, not + ! dry static energy. + + type(vdiff_selector), intent(in) :: fieldlist ! Array of flags selecting which fields to diffuse + type(vdiff_selector), intent(in) :: fieldlistm ! Array of flags selecting which fields for molecular diffusion + + ! Dry static energy top boundary condition. + real(r8), intent(in) :: dse_top(pcols) + + real(r8), intent(in) :: kvm(pcols,pver+1) ! Eddy viscosity ( Eddy diffusivity for momentum ) [ m2/s ] + real(r8), intent(in) :: kvq(pcols,pver+1) ! Eddy diffusivity for constituents + real(r8), intent(in) :: cgs(pcols,pver+1) ! Counter-gradient star [ cg/flux ] + real(r8), intent(in) :: cgh(pcols,pver+1) ! Counter-gradient term for heat + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + real(r8), intent(inout) :: u(pcols,pver) ! U wind. This input is the 'raw' input wind to + ! PBL scheme without iterative provisional update. [ m/s ] + real(r8), intent(inout) :: v(pcols,pver) ! V wind. This input is the 'raw' input wind to PBL scheme + ! without iterative provisional update. [ m/s ] + real(r8), intent(inout) :: q(pcols,pver,ncnst) ! Moisture and trace constituents [ kg/kg, #/kg ? ] + real(r8), intent(inout) :: dse(pcols,pver) ! Dry static energy [ J/kg ] + + real(r8), intent(inout) :: tauresx(pcols) ! Input : Reserved surface stress at previous time step + real(r8), intent(inout) :: tauresy(pcols) ! Output : Reserved surface stress at current time step + + ! ---------------- ! + ! Output Arguments ! + ! ---------------- ! + + real(r8), intent(out) :: dtk(pcols,pver) ! T tendency from KE dissipation + real(r8), intent(out) :: tautmsx(pcols) ! Implicit zonal turbulent mountain surface stress + ! [ N/m2 = kg m/s /s/m2 ] + real(r8), intent(out) :: tautmsy(pcols) ! Implicit meridional turbulent mountain surface stress + ! [ N/m2 = kg m/s /s/m2 ] + real(r8), intent(out) :: topflx(pcols) ! Molecular heat flux at the top interface + character(128), intent(out) :: errstring ! Output status + + ! ------------------ ! + ! Optional Arguments ! + ! ------------------ ! + + ! The molecular diffusion module will likely change significantly in + ! the future, and this module may directly depend on it after that. + ! Until then, we have these highly specific interfaces hard-coded. + + optional :: vd_lu_qdecomp ! Constituent-dependent molecular diffusivity routine + + interface + function vd_lu_qdecomp( & + pcols , pver , ncol , fixed_ubc , mw , & + kv , kq_scal, mw_facm , dpidz_sq , coords , & + interface_boundary, molec_boundary, & + tint , ztodt , nbot_molec , & + lchnk , t , m , no_molec_decomp) result(decomp) + import + integer, intent(in) :: pcols + integer, intent(in) :: pver + integer, intent(in) :: ncol + integer, intent(in) :: nbot_molec + logical, intent(in) :: fixed_ubc + real(r8), intent(in) :: kv(pcols,pver+1) + real(r8), intent(in) :: kq_scal(pcols,pver+1) + real(r8), intent(in) :: mw + real(r8), intent(in) :: mw_facm(pcols,pver+1) + real(r8), intent(in) :: dpidz_sq(ncol,pver+1) + type(Coords1D), intent(in) :: coords + type(BoundaryType), intent(in) :: interface_boundary + type(BoundaryType), intent(in) :: molec_boundary + real(r8), intent(in) :: tint(pcols,pver+1) + real(r8), intent(in) :: ztodt + integer, intent(in) :: lchnk + real(r8), intent(in) :: t(pcols,pver) + integer, intent(in) :: m + type(TriDiagDecomp), intent(in) :: no_molec_decomp + type(TriDiagDecomp) :: decomp + end function vd_lu_qdecomp + end interface + + real(r8), intent(in), optional :: ubc_mmr(pcols,ncnst) ! Upper boundary mixing ratios [ kg/kg ] + real(r8), intent(in), optional :: ubc_flux(pcols,ncnst) ! Upper boundary flux [ kg/s/m^2 ] + + real(r8), intent(in), optional :: kvt(pcols,pver+1) ! Kinematic molecular conductivity + + ! FIXME: This input should not be needed (and should not be passed in in vertical_diffusion). + real(r8), intent(in), optional :: pmid(pcols,pver) + + real(r8), intent(in), optional :: cnst_mw(ncnst) ! Molecular weight [ kg/kmole ] + logical, intent(in), optional :: cnst_fixed_ubc(ncnst) ! Whether upper boundary condition is fixed + logical, intent(in), optional :: cnst_fixed_ubflx(ncnst) ! Whether upper boundary flux is a fixed non-zero value + + integer, intent(in), optional :: nbot_molec ! Bottom level where molecular diffusivity is applied + + ! kq_fac*sqrt(T)*m_d/rho for molecular diffusivity + real(r8), intent(in), optional :: kq_scal(pcols,pver+1) + ! Local sqrt(1/M_q + 1/M_d) for each constituent + real(r8), intent(in), optional :: mw_fac(pcols,pver+1,ncnst) + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer :: i, k, m ! Longitude, level, constituent indices + logical :: lqtst(pcols) ! Adjust vertical profiles + + ! LU decomposition information. + type(TriDiagDecomp) :: decomp + type(TriDiagDecomp) :: no_molec_decomp + + ! Square of derivative of pressure with height (on interfaces). + real(r8) :: dpidz_sq(ncol,pver+1) + + ! Pressure coordinates over the molecular diffusion range only. + type(Coords1D) :: p_molec + + ! Boundary layer objects + type(BoundaryType) :: interface_boundary + type(BoundaryType) :: molec_boundary + + real(r8) :: tmp1(pcols) ! Temporary storage + real(r8) :: tmpi1(pcols,pver+1) ! Interface KE dissipation + real(r8) :: tmpi2(pcols,pver+1) ! dt*(g*rho)**2/dp at interfaces + real(r8) :: keg_in(pcols,pver) ! KE on entry to subroutine + real(r8) :: keg_out(pcols,pver) ! KE after U and V dissipation/diffusion + real(r8) :: rrho(pcols) ! 1./bottom level density + + real(r8) :: tautotx(pcols) ! Total surface stress ( zonal ) + real(r8) :: tautoty(pcols) ! Total surface stress ( meridional ) + + real(r8) :: dinp_u(pcols,pver+1) ! Vertical difference at interfaces, input u + real(r8) :: dinp_v(pcols,pver+1) ! Vertical difference at interfaces, input v + real(r8) :: dout_u ! Vertical difference at interfaces, output u + real(r8) :: dout_v ! Vertical difference at interfaces, output v + + real(r8) :: qtm(pcols,pver) ! Temporary copy of q + + real(r8) :: ws(pcols) ! Lowest-level wind speed [ m/s ] + real(r8) :: tau(pcols) ! Turbulent surface stress ( not including mountain stress ) + real(r8) :: ksrfturb(pcols) ! Surface drag coefficient of 'normal' stress. > 0. + ! Virtual mass input per unit time per unit area [ kg/s/m2 ] + real(r8) :: ksrf(pcols) ! Surface drag coefficient of 'normal' stress + + ! Surface drag coefficient of 'tms' stress. > 0. [ kg/s/m2 ] + real(r8) :: usum_in(pcols) ! Vertical integral of input u-momentum. Total zonal + ! momentum per unit area in column [ sum of u*dp/g = kg m/s m-2 ] + real(r8) :: vsum_in(pcols) ! Vertical integral of input v-momentum. Total meridional + ! momentum per unit area in column [ sum of v*dp/g = kg m/s m-2 ] + real(r8) :: usum_mid(pcols) ! Vertical integral of u-momentum after adding explicit residual stress + real(r8) :: vsum_mid(pcols) ! Vertical integral of v-momentum after adding explicit residual stress + real(r8) :: usum_out(pcols) ! Vertical integral of u-momentum after doing implicit diffusion + real(r8) :: vsum_out(pcols) ! Vertical integral of v-momentum after doing implicit diffusion + real(r8) :: tauimpx(pcols) ! Actual net stress added at the current step other than mountain stress + real(r8) :: tauimpy(pcols) ! Actual net stress added at the current step other than mountain stress + real(r8) :: ramda ! dt/timeres [ no unit ] + + real(r8) :: taubljx(pcols) ! recomputed explicit/residual beljaars stress + real(r8) :: taubljy(pcols) ! recomputed explicit/residual beljaars stress + + ! Rate at which external (surface) stress damps wind speeds (1/s). + real(r8) :: tau_damp_rate(ncol, pver) + + ! Combined molecular and eddy diffusion. + real(r8) :: kv_total(pcols,pver+1) + + logical :: use_spcam + + !-------------------------------- + ! Variables needed for WACCM-X + !-------------------------------- + real(r8) :: ttemp(ncol,pver) ! temporary temperature array + real(r8) :: ttemp0(ncol,pver) ! temporary temperature array + + ! ------------------------------------------------ ! + ! Parameters for implicit surface stress treatment ! + ! ------------------------------------------------ ! + + real(r8), parameter :: wsmin = 1._r8 ! Minimum sfc wind speed for estimating frictional + ! transfer velocity ksrf. [ m/s ] + real(r8), parameter :: ksrfmin = 1.e-4_r8 ! Minimum surface drag coefficient [ kg/s/m^2 ] + real(r8), parameter :: timeres = 7200._r8 ! Relaxation time scale of residual stress ( >= dt ) [ s ] + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + call phys_getopts(use_spcam_out = use_spcam) + + errstring = '' + if( ( diffuse(fieldlist,'u') .or. diffuse(fieldlist,'v') ) .and. .not. diffuse(fieldlist,'s') ) then + errstring = 'diffusion_solver.compute_vdiff: must diffuse s if diffusing u or v' + return + end if + + !--------------------------------------- ! + ! Computation of Molecular Diffusivities ! + !--------------------------------------- ! + + ! Modification : Why 'kvq' is not changed by molecular diffusion ? + + if( do_molec_diff ) then + + if( (.not.present(vd_lu_qdecomp)) .or. (.not.present(kvt)) & + .or. (.not. present(ubc_mmr)) .or. (.not. present(ubc_flux)) ) then + errstring = 'compute_vdiff: do_molec_diff true but vd_lu_qdecomp or kvt missing' + return + endif + + p_molec = p%section([1, ncol], [1, nbot_molec]) + molec_boundary = BoundaryFixedLayer(p%del(:,nbot_molec+1)) + + endif + + ! Boundary condition for a fixed concentration directly on a boundary + ! interface (i.e. a boundary layer of size 0). + interface_boundary = BoundaryFixedLayer(spread(0._r8, 1, ncol)) + + ! Note that the *derivative* dp/dz is g*rho + dpidz_sq = gravit*rhoi(:ncol,:) + dpidz_sq = dpidz_sq * dpidz_sq + + rrho(:ncol) = rair * t(:ncol,pver) / p%mid(:,pver) + + tmpi2(:ncol,1) = ztodt * dpidz_sq(:,1) / ( p%mid(:,1) - p%ifc(:,1) ) + tmpi2(:ncol,2:pver) = ztodt * dpidz_sq(:,2:pver) * p%rdst + + ! FIXME: The following four lines are kept in only to preserve answers; + ! they really should be taken out completely. + if (do_molec_diff) & + tmpi2(:ncol,1) = ztodt * (gravit * rhoi(:ncol,1))**2 / ( pmid(:ncol,1) - p%ifc(:,1) ) + dpidz_sq(:,1) = gravit*(p%ifc(:,1) / (rairv(:ncol,1,lchnk)*t(:ncol,1))) + dpidz_sq(:,1) = dpidz_sq(:,1)*dpidz_sq(:,1) + + tmp1(:ncol) = ztodt * gravit * p%rdel(:,pver) + + !---------------------------- ! + ! Diffuse Horizontal Momentum ! + !---------------------------- ! + + do k = 1, pver + do i = 1, ncol + keg_in(i,k) = 0.5_r8 * ( u(i,k)*u(i,k) + v(i,k)*v(i,k) ) + end do + end do + + if( diffuse(fieldlist,'u') .or. diffuse(fieldlist,'v') ) then + + ! Compute the vertical upward differences of the input u,v for KE dissipation + ! at each interface. + ! Velocity = 0 at surface, so difference at the bottom interface is -u,v(pver) + ! These 'dinp_u, dinp_v' are computed using the non-diffused input wind. + + do i = 1, ncol + dinp_u(i,1) = 0._r8 + dinp_v(i,1) = 0._r8 + dinp_u(i,pver+1) = -u(i,pver) + dinp_v(i,pver+1) = -v(i,pver) + end do + do k = 2, pver + do i = 1, ncol + dinp_u(i,k) = u(i,k) - u(i,k-1) + dinp_v(i,k) = v(i,k) - v(i,k-1) + end do + end do + + ! -------------------------------------------------------------- ! + ! Do 'Implicit Surface Stress' treatment for numerical stability ! + ! in the lowest model layer. ! + ! -------------------------------------------------------------- ! + + if( do_iss ) then + + ! Compute surface drag coefficient for implicit diffusion + ! including turbulent mountain stress. + + do i = 1, ncol + ws(i) = max( sqrt( u(i,pver)**2._r8 + v(i,pver)**2._r8 ), wsmin ) + tau(i) = sqrt( taux(i)**2._r8 + tauy(i)**2._r8 ) + ksrfturb(i) = max( tau(i) / ws(i), ksrfmin ) + end do + ksrf(:ncol) = ksrfturb(:ncol) + ksrftms(:ncol) ! Do all surface stress ( normal + tms ) implicitly + + ! Vertical integration of input momentum. + ! This is total horizontal momentum per unit area [ kg*m/s/m2 ] in each column. + ! Note (u,v) are the raw input to the PBL scheme, not the + ! provisionally-marched ones within the iteration loop of the PBL scheme. + + do i = 1, ncol + usum_in(i) = 0._r8 + vsum_in(i) = 0._r8 + do k = 1, pver + usum_in(i) = usum_in(i) + (1._r8/gravit)*u(i,k)*p%del(i,k) + vsum_in(i) = vsum_in(i) + (1._r8/gravit)*v(i,k)*p%del(i,k) + end do + end do + + ! Add residual stress of previous time step explicitly into the lowest + ! model layer with a relaxation time scale of 'timeres'. + + if (am_correction) then + ! preserve time-mean torque + ramda = 1._r8 + else + ramda = ztodt / timeres + endif + + u(:ncol,pver) = u(:ncol,pver) + tmp1(:ncol)*tauresx(:ncol)*ramda + v(:ncol,pver) = v(:ncol,pver) + tmp1(:ncol)*tauresy(:ncol)*ramda + + ! Vertical integration of momentum after adding explicit residual stress + ! into the lowest model layer. + + do i = 1, ncol + usum_mid(i) = 0._r8 + vsum_mid(i) = 0._r8 + do k = 1, pver + usum_mid(i) = usum_mid(i) + (1._r8/gravit)*u(i,k)*p%del(i,k) + vsum_mid(i) = vsum_mid(i) + (1._r8/gravit)*v(i,k)*p%del(i,k) + end do + end do + + else + + ! In this case, do 'turbulent mountain stress' implicitly, + ! but do 'normal turbulent stress' explicitly. + ! In this case, there is no 'residual stress' as long as 'tms' is + ! treated in a fully implicit way, which is true. + + ! 1. Do 'tms' implicitly + + ksrf(:ncol) = ksrftms(:ncol) + + ! 2. Do 'normal stress' explicitly + + u(:ncol,pver) = u(:ncol,pver) + tmp1(:ncol)*taux(:ncol) + v(:ncol,pver) = v(:ncol,pver) + tmp1(:ncol)*tauy(:ncol) + + end if ! End of 'do iss' ( implicit surface stress ) + + ! --------------------------------------------------------------------------------------- ! + ! Diffuse horizontal momentum implicitly using tri-diagnonal matrix. ! + ! The 'u,v' are input-output: the output 'u,v' are implicitly diffused winds. ! + ! For implicit 'normal' stress : ksrf = ksrftms + ksrfturb, ! + ! u(pver) : explicitly include 'residual normal' stress ! + ! For explicit 'normal' stress : ksrf = ksrftms ! + ! u(pver) : explicitly include 'normal' stress ! + ! Note that in all the two cases above, 'tms' is fully implicitly treated. ! + ! --------------------------------------------------------------------------------------- ! + + ! In most layers, no damping at all. + tau_damp_rate = 0._r8 + + ! Physical interpretation: + ! ksrf is stress per unit wind speed. + ! p%del / gravit is approximately the mass in the layer per unit of + ! surface area. + ! Therefore, gravit*ksrf/p%del is the acceleration of wind per unit + ! wind speed, i.e. the rate at which wind is exponentially damped by + ! surface stress. + + ! Beljaars et al SGO scheme incorporated here. It + ! appears as a "3D" tau_damp_rate specification. + + tau_damp_rate(:,pver) = -gravit*ksrf(:ncol)*p%rdel(:,pver) + do k=1,pver + tau_damp_rate(:,k) = tau_damp_rate(:,k) + dragblj(:ncol,k) + end do + + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q=tau_damp_rate, coef_q_diff=kvm(:ncol,:)*dpidz_sq) + + call decomp%left_div(u(:ncol,:)) + call decomp%left_div(v(:ncol,:)) + call decomp%finalize() + + ! ---------------------------------------------------------------------- ! + ! Calculate 'total' ( tautotx ) and 'tms' ( tautmsx ) stresses that ! + ! have been actually added into the atmosphere at the current time step. ! + ! Also, update residual stress, if required. ! + ! ---------------------------------------------------------------------- ! + + do i = 1, ncol + + ! Compute the implicit 'tms' using the updated winds. + ! Below 'tautmsx(i),tautmsy(i)' are pure implicit mountain stresses + ! that has been actually added into the atmosphere both for explicit + ! and implicit approach. + + tautmsx(i) = -ksrftms(i)*u(i,pver) + tautmsy(i) = -ksrftms(i)*v(i,pver) + + ! We want to add vertically-integrated Beljaars drag to residual stress. + ! So this has to be calculated locally. + ! We may want to rethink the residual drag calculation performed here on. (jtb) + taubljx(i) = 0._r8 + taubljy(i) = 0._r8 + do k = 1, pver + taubljx(i) = taubljx(i) + (1._r8/gravit)*dragblj(i,k)*u(i,k)*p%del(i,k) + taubljy(i) = taubljy(i) + (1._r8/gravit)*dragblj(i,k)*v(i,k)*p%del(i,k) + end do + + if( do_iss ) then + + ! Compute vertical integration of final horizontal momentum + + usum_out(i) = 0._r8 + vsum_out(i) = 0._r8 + do k = 1, pver + usum_out(i) = usum_out(i) + (1._r8/gravit)*u(i,k)*p%del(i,k) + vsum_out(i) = vsum_out(i) + (1._r8/gravit)*v(i,k)*p%del(i,k) + end do + + ! Compute net stress added into the atmosphere at the current time step. + ! Note that the difference between 'usum_in' and 'usum_out' are induced + ! by 'explicit residual stress + implicit total stress' for implicit case, while + ! by 'explicit normal stress + implicit tms stress' for explicit case. + ! Here, 'tautotx(i)' is net stress added into the air at the current time step. + + tauimpx(i) = ( usum_out(i) - usum_in(i) ) / ztodt + tauimpy(i) = ( vsum_out(i) - vsum_in(i) ) / ztodt + + tautotx(i) = tauimpx(i) + tautoty(i) = tauimpy(i) + + ! Compute residual stress and update if required. + ! Note that the total stress we should have added at the current step is + ! the sum of 'taux(i) - ksrftms(i)*u(i,pver) + tauresx(i)'. + + if( itaures .eq. 1 ) then + tauresx(i) = taux(i) + tautmsx(i) + taubljx(i) + tauresx(i)- tauimpx(i) + tauresy(i) = tauy(i) + tautmsy(i) + taubljy(i) + tauresy(i)- tauimpy(i) + endif + + else + + tautotx(i) = tautmsx(i) + taux(i) + tautoty(i) = tautmsy(i) + tauy(i) + tauresx(i) = 0._r8 + tauresy(i) = 0._r8 + + end if ! End of 'do_iss' if + + end do ! End of 'do i = 1, ncol' loop + + ! ------------------------------------ ! + ! Calculate kinetic energy dissipation ! + ! ------------------------------------ ! + + ! Modification : In future, this should be set exactly same as + ! the ones in the convection schemes + + ! 1. Compute dissipation term at interfaces + ! Note that 'u,v' are already diffused wind, and 'tautotx,tautoty' are + ! implicit stress that has been actually added. On the other hand, + ! 'dinp_u, dinp_v' were computed using non-diffused input wind. + + ! Modification : I should check whether non-consistency between 'u' and 'dinp_u' + ! is correctly intended approach. I think so. + + k = pver + 1 + do i = 1, ncol + tmpi1(i,1) = 0._r8 + tmpi1(i,k) = 0.5_r8 * ztodt * gravit * & + ( (-u(i,k-1) + dinp_u(i,k))*tautotx(i) + (-v(i,k-1) + dinp_v(i,k))*tautoty(i) ) + end do + + do k = 2, pver + do i = 1, ncol + dout_u = u(i,k) - u(i,k-1) + dout_v = v(i,k) - v(i,k-1) + tmpi1(i,k) = 0.25_r8 * tmpi2(i,k) * kvm(i,k) * & + ( dout_u**2 + dout_v**2 + dout_u*dinp_u(i,k) + dout_v*dinp_v(i,k) ) + end do + end do + + if (do_beljaars) then + + ! 2. Add Kinetic Energy change across dissipation to Static Energy + do k = 1, pver + do i = 1, ncol + keg_out(i,k) = 0.5_r8 * ( u(i,k)*u(i,k) + v(i,k)*v(i,k) ) + end do + end do + + do k = 1, pver + do i = 1, ncol + dtk(i,k) = keg_in(i,k) - keg_out(i,k) + dse(i,k) = dse(i,k) + dtk(i,k) ! + dkeblj(i,k) + end do + end do + + else + + ! 2. Compute dissipation term at midpoints, add to dry static energy + do k = 1, pver + do i = 1, ncol + dtk(i,k) = ( tmpi1(i,k+1) + tmpi1(i,k) ) * p%rdel(i,k) + dse(i,k) = dse(i,k) + dtk(i,k) + end do + end do + + end if + + end if ! End of diffuse horizontal momentum, diffuse(fieldlist,'u') routine + + !-------------------------- ! + ! Diffuse Dry Static Energy ! + !-------------------------- ! + + ! Modification : In future, we should diffuse the fully conservative + ! moist static energy,not the dry static energy. + + if( diffuse(fieldlist,'s') ) then + if (.not. use_spcam) then + + ! Add counter-gradient to input static energy profiles + + do k = 1, pver + dse(:ncol,k) = dse(:ncol,k) + ztodt * p%rdel(:,k) * gravit * & + ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgh(:ncol,k+1) & + - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgh(:ncol,k ) ) + end do + endif + ! Add the explicit surface fluxes to the lowest layer + dse(:ncol,pver) = dse(:ncol,pver) + tmp1(:ncol) * shflx(:ncol) + + ! Diffuse dry static energy + + !--------------------------------------------------- + ! Solve for temperature using thermal conductivity + !--------------------------------------------------- + if ( use_temperature_molec_diff ) then + !---------------------------------------------------------------------------------------------------- + ! In Extended WACCM, kvt is calculated rather kvh. This is because molecular diffusion operates on + ! temperature, while eddy diffusion operates on dse. Also, pass in constituent dependent "constants" + !---------------------------------------------------------------------------------------------------- + + ! Boundary layer thickness of "0._r8" signifies that the boundary + ! condition is defined directly on the top interface. + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=kvh(:ncol,:)*dpidz_sq, & + upper_bndry=interface_boundary) + + if (.not. use_spcam) then + call decomp%left_div(dse(:ncol,:), & + l_cond=BoundaryData(dse_top(:ncol))) + endif + + call decomp%finalize() + + ! Calculate flux at top interface + + ! Modification : Why molecular diffusion does not work for dry static energy in all layers ? + + topflx(:ncol) = - kvh(:ncol,1) * tmpi2(:ncol,1) / (ztodt*gravit) * & + ( dse(:ncol,1) - dse_top(:ncol) ) + + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=kvt(:ncol,:)*dpidz_sq, & + coef_q_weight=cpairv(:ncol,:)) + + ttemp0 = t(:ncol,:) + ttemp = ttemp0 + + ! upper boundary is zero flux for extended model + if (.not. use_spcam) then + call decomp%left_div(ttemp) + end if + + call decomp%finalize() + + !------------------------------------- + ! Update dry static energy + !------------------------------------- + do k = 1,pver + dse(:ncol,k) = dse(:ncol,k) + & + cpairv(:ncol,k)*(ttemp(:,k) - ttemp0(:,k)) + enddo + + else + + if (do_molec_diff) then + kv_total(:ncol,:) = kvh(:ncol,:) + kvt(:ncol,:)/cpair + else + kv_total(:ncol,:) = kvh(:ncol,:) + end if + + ! Boundary layer thickness of "0._r8" signifies that the boundary + ! condition is defined directly on the top interface. + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=kv_total(:ncol,:)*dpidz_sq, & + upper_bndry=interface_boundary) + + if (.not. use_spcam) then + call decomp%left_div(dse(:ncol,:), & + l_cond=BoundaryData(dse_top(:ncol))) + end if + + call decomp%finalize() + + ! Calculate flux at top interface + + ! Modification : Why molecular diffusion does not work for dry static energy in all layers ? + + if( do_molec_diff ) then + topflx(:ncol) = - kv_total(:ncol,1) * tmpi2(:ncol,1) / (ztodt*gravit) * & + ( dse(:ncol,1) - dse_top(:ncol) ) + else + topflx(:ncol) = 0._r8 + end if + + endif + + endif + + !---------------------------- ! + ! Diffuse Water Vapor Tracers ! + !---------------------------- ! + + ! Modification : For aerosols, I need to use separate treatment + ! for aerosol mass and aerosol number. + + ! Loop through constituents + + no_molec_decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=kvq(:ncol,:)*dpidz_sq) + + do m = 1, ncnst + + if( diffuse(fieldlist,'q',m) ) then + if (.not. use_spcam) then + + ! Add the nonlocal transport terms to constituents in the PBL. + ! Check for neg q's in each constituent and put the original vertical + ! profile back if a neg value is found. A neg value implies that the + ! quasi-equilibrium conditions assumed for the countergradient term are + ! strongly violated. + + qtm(:ncol,:pver) = q(:ncol,:pver,m) + + do k = 1, pver + q(:ncol,k,m) = q(:ncol,k,m) + & + ztodt * p%rdel(:,k) * gravit * ( cflx(:ncol,m) * rrho(:ncol) ) * & + ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgs(:ncol,k+1) & + - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgs(:ncol,k ) ) + end do + lqtst(:ncol) = all(q(:ncol,1:pver,m) >= qmincg(m), 2) + do k = 1, pver + q(:ncol,k,m) = merge( q(:ncol,k,m), qtm(:ncol,k), lqtst(:ncol) ) + end do + endif + + ! Add the explicit surface fluxes to the lowest layer + + q(:ncol,pver,m) = q(:ncol,pver,m) + tmp1(:ncol) * cflx(:ncol,m) + + ! Diffuse constituents. + + ! This is for solving molecular diffusion of minor species, thus, for WACCM-X, bypass O and O2 (major species) + ! Major species diffusion is calculated separately. -Hanli Liu + + if( do_molec_diff .and. diffuse(fieldlistm,'q',m)) then + + decomp = vd_lu_qdecomp( pcols , pver , ncol , cnst_fixed_ubc(m), cnst_mw(m), & + kvq , kq_scal, mw_fac(:,:,m) ,dpidz_sq , p_molec, & + interface_boundary, molec_boundary, & + tint , ztodt , nbot_molec , & + lchnk , t , m , no_molec_decomp) + + ! This to calculate the upper boundary flux of H. -Hanli Liu + if ((cnst_fixed_ubflx(m))) then + + ! ubc_flux is a flux of mass density through space, i.e.: + ! ubc_flux = rho_i * dz/dt = q_i * rho * dz/dt + ! For flux of mmr through pressure level, multiply by g: + ! q_i * rho * gravit * dz/dt = q_i * dp/dt + + call decomp%left_div(q(:ncol,:,m), & + l_cond=BoundaryFlux( & + -gravit*ubc_flux(:ncol,m), ztodt, & + p%del(:,1))) + + else + call decomp%left_div(q(:ncol,:,m), & + l_cond=BoundaryData(ubc_mmr(:ncol,m))) + end if + + call decomp%finalize() + + else + + if (.not. use_spcam) then + ! Currently, no ubc for constituents without molecular + ! diffusion (they cannot diffuse out the top of the model). + call no_molec_decomp%left_div(q(:ncol,:,m)) + end if + + end if + + end if + end do + + call no_molec_decomp%finalize() + + end subroutine compute_vdiff + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + character(128) function vdiff_select( fieldlist, name, qindex ) + ! --------------------------------------------------------------------- ! + ! This function sets the field with incoming name as one to be diffused ! + ! --------------------------------------------------------------------- ! + type(vdiff_selector), intent(inout) :: fieldlist + character(*), intent(in) :: name + integer, intent(in), optional :: qindex + + vdiff_select = '' + select case (name) + case ('u','U') + fieldlist%fields(1) = .true. + case ('v','V') + fieldlist%fields(2) = .true. + case ('s','S') + fieldlist%fields(3) = .true. + case ('q','Q') + if( present(qindex) ) then + fieldlist%fields(3 + qindex) = .true. + else + fieldlist%fields(4) = .true. + endif + case default + write(vdiff_select,*) 'Bad argument to vdiff_index: ', name + end select + return + + end function vdiff_select + + type(vdiff_selector) function not(a) + ! ------------------------------------------------------------- ! + ! This function extends .not. to operate on type vdiff_selector ! + ! ------------------------------------------------------------- ! + type(vdiff_selector), intent(in) :: a + allocate(not%fields(size(a%fields))) + not%fields = .not. a%fields + end function not + + logical function my_any(a) + ! -------------------------------------------------- ! + ! This function extends the intrinsic function 'any' ! + ! to operate on type vdiff_selector ! + ! -------------------------------------------------- ! + type(vdiff_selector), intent(in) :: a + my_any = any(a%fields) + end function my_any + + logical function diffuse(fieldlist,name,qindex) + ! ---------------------------------------------------------------------------- ! + ! This function reports whether the field with incoming name is to be diffused ! + ! ---------------------------------------------------------------------------- ! + type(vdiff_selector), intent(in) :: fieldlist + character(*), intent(in) :: name + integer, intent(in), optional :: qindex + + select case (name) + case ('u','U') + diffuse = fieldlist%fields(1) + case ('v','V') + diffuse = fieldlist%fields(2) + case ('s','S') + diffuse = fieldlist%fields(3) + case ('q','Q') + if( present(qindex) ) then + diffuse = fieldlist%fields(3 + qindex) + else + diffuse = fieldlist%fields(4) + endif + case default + diffuse = .false. + end select + return + end function diffuse + +end module diffusion_solver diff --git a/src/physics/cam/eddy_diff.F90 b/src/physics/cam/eddy_diff.F90 new file mode 100644 index 0000000000..48f57e4a97 --- /dev/null +++ b/src/physics/cam/eddy_diff.F90 @@ -0,0 +1,3326 @@ + module eddy_diff + + !--------------------------------------------------------------------------------- ! + ! ! + ! The University of Washington Moist Turbulence Scheme to compute eddy diffusion ! + ! coefficients associated with dry and moist turbulences in the whole ! + ! atmospheric layers. ! + ! ! + ! For detailed description of the code and its performances, see ! + ! ! + ! 1.'A new moist turbulence parametrization in the Community Atmosphere Model' ! + ! by Christopher S. Bretherton and Sungsu Park. J. Climate. 2009. 22. 3422-3448 ! + ! 2.'The University of Washington shallow convection and moist turbulence schemes ! + ! and their impact on climate simulations with the Community Atmosphere Model' ! + ! by Sungsu Park and Christopher S. Bretherton. J. Climate. 2009. 22. 3449-3469 ! + ! ! + ! For questions on the scheme and code, send an email to ! + ! Sungsu Park at sungsup@ucar.edu (tel: 303-497-1375) ! + ! Chris Bretherton at breth@washington.edu ! + ! ! + ! Developed by Chris Bretherton at the University of Washington, Seattle, WA. ! + ! Sungsu Park at the CGD/NCAR, Boulder, CO. ! + ! Last coded on May.2006, Dec.2009 by Sungsu Park. ! + ! ! + !--------------------------------------------------------------------------------- ! + + use wv_saturation, only: qsat + + implicit none + private + save + + public :: init_eddy_diff + public :: trbintd + public :: caleddy + public :: ncvmax + + integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + integer, parameter :: i4 = selected_int_kind( 6) ! 4 byte integer + ! --------------------------------- ! + ! PBL Parameters used in the UW PBL ! + ! --------------------------------- ! + + character, parameter :: sftype = 'l' ! Method for calculating saturation fraction + + character(len=4), parameter :: choice_evhc = 'maxi' ! 'orig', 'ramp', 'maxi' : recommended to be used with choice_radf + character(len=6), parameter :: choice_radf = 'maxi' ! 'orig', 'ramp', 'maxi' : recommended to be used with choice_evhc + character(len=6), parameter :: choice_SRCL = 'nonamb' ! 'origin', 'remove', 'nonamb' + + character(len=6), parameter :: choice_tunl = 'rampcl' ! 'origin', 'rampsl'(Sungsu), 'rampcl'(Chris) + real(r8), parameter :: ctunl = 2._r8 ! Maximum asympt leng = ctunl*tunl when choice_tunl = 'rampsl(cl)' + ! [ no unit ] + character(len=6), parameter :: choice_leng = 'origin' ! 'origin', 'takemn' + real(r8), parameter :: cleng = 3._r8 ! Order of 'leng' when choice_leng = 'origin' [ no unit ] + character(len=6), parameter :: choice_tkes = 'ibprod' ! 'ibprod' (include tkes in computing bprod), 'ebprod'(exclude) + + real(r8) :: lbulk_max = 40.e3_r8 ! Maximum master length scale designed to address issues in the + ! upper atmosphere where vertical model resolution is coarse [ m ]. + ! In order not to disturb turbulence characteristics in the lower + ! troposphere, this should be set at least larger than ~ a few km. + real(r8), allocatable :: leng_max(:) ! Maximum length scale designed to address issues in the upper + ! atmosphere. + + ! Parameters for 'sedimentation-entrainment feedback' for liquid stratus + ! If .false., no sedimentation entrainment feedback ( i.e., use default evhc ) + + logical, parameter :: id_sedfact = .false. + real(r8), parameter :: ased = 9._r8 ! Valid only when id_sedfact = .true. + + ! --------------------------------------------------------------------------------------------------- ! + ! Parameters governing entrainment efficiency A = a1l(i)*evhc, evhc = 1 + a2l * a3l * L * ql / jt2slv ! + ! Here, 'ql' is cloud-top LWC and 'jt2slv' is the jump in 'slv' across ! + ! the cloud-top entrainment zone ( across two grid layers to consider full mixture ) ! + ! --------------------------------------------------------------------------------------------------- ! + + real(r8), parameter :: a1l = 0.10_r8 ! Dry entrainment efficiency for TKE closure + ! a1l = 0.2*tunl*erat^-1.5, + ! where erat = /wstar^2 for dry CBL = 0.3. + + real(r8), parameter :: a1i = 0.2_r8 ! Dry entrainment efficiency for wstar closure + real(r8), parameter :: ccrit = 0.5_r8 ! Minimum allowable sqrt(tke)/wstar. + ! Used in solving cubic equation for 'ebrk' + real(r8), parameter :: wstar3factcrit = 0.5_r8 ! 1/wstar3factcrit is the maximally allowed enhancement of + ! 'wstar3' due to entrainment. + + real(r8) :: a2l ! Moist entrainment enhancement param (recommended range : 10~30 ) + real(r8), parameter :: a3l = 0.8_r8 ! Approximation to a complicated thermodynamic parameters + + real(r8), parameter :: jbumin = .001_r8 ! Minimum buoyancy jump at an entrainment jump, [m/s2] + real(r8), parameter :: evhcmax = 10._r8 ! Upper limit of evaporative enhancement factor + + real(r8), parameter :: onet = 1._r8/3._r8 ! 1/3 power in wind gradient expression [ no unit ] + integer :: ncvmax ! Max numbers of CLs (good to set to 'pver') + real(r8), parameter :: qmin = 1.e-5_r8 ! Minimum grid-mean LWC counted as clouds [kg/kg] + real(r8), parameter :: ntzero = 1.e-12_r8 ! Not zero (small positive number used in 's2') + real(r8), parameter :: b1 = 5.8_r8 ! TKE dissipation D = e^3/(b1*leng), e = b1*W. + real(r8) :: b123 ! b1**(2/3) + real(r8), parameter :: tunl = 0.085_r8 ! Asympt leng = tunl*(turb lay depth) + real(r8), parameter :: alph1 = 0.5562_r8 ! alph1~alph5 : Galperin instability function parameters + real(r8), parameter :: alph2 = -4.3640_r8 ! These coefficients are used to calculate + real(r8), parameter :: alph3 = -34.6764_r8 ! 'sh' and 'sm' from 'gh'. + real(r8), parameter :: alph4 = -6.1272_r8 ! + real(r8), parameter :: alph5 = 0.6986_r8 ! + real(r8), parameter :: ricrit = 0.19_r8 ! Critical Richardson number for turbulence. + ! Can be any value >= 0.19. + real(r8), parameter :: ae = 1._r8 ! TKE transport efficiency [no unit] + real(r8), parameter :: rinc = -0.04_r8 ! Minimum W/ used for CL merging test + real(r8), parameter :: wpertmin = 1.e-6_r8 ! Minimum PBL eddy vertical velocity perturbation + real(r8), parameter :: wfac = 1._r8 ! Ratio of 'wpert' to sqrt(tke) for CL. + real(r8), parameter :: tfac = 1._r8 ! Ratio of 'tpert' to (w't')/wpert for CL. + ! Same ratio also used for q + real(r8), parameter :: fak = 8.5_r8 ! Constant in surface temperature excess for stable STL. + ! [ no unit ] + real(r8), parameter :: rcapmin = 0.1_r8 ! Minimum allowable e/ in a CL + real(r8), parameter :: rcapmax = 2.0_r8 ! Maximum allowable e/ in a CL + real(r8), parameter :: tkemax = 20._r8 ! TKE is capped at tkemax [m2/s2] + + logical, parameter :: use_dw_surf = .true. ! Used in 'zisocl'. Default is 'true' + ! If 'true', surface interfacial energy does not contribute + ! to the CL mean stability functions after finishing merging. + ! For this case, 'dl2n2_surf' is only used for a merging test + ! based on 'l2n2' + ! If 'false',surface interfacial enery explicitly contribute to + ! CL mean stability functions after finishing merging. + ! For this case, 'dl2n2_surf' and 'dl2s2_surf' are directly used + ! for calculating surface interfacial layer energetics + + logical, parameter :: set_qrlzero = .false. ! .true. ( .false.) : turning-off ( on) radiative-turbulence + ! interaction by setting qrl = 0. + + ! ------------------------------------------------------- ! + ! PBL constants set using values from other parts of code ! + ! ------------------------------------------------------- ! + + real(r8) :: cpair ! Specific heat of dry air + real(r8) :: rair ! Gas const for dry air + real(r8) :: zvir ! rh2o/rair - 1 + real(r8) :: latvap ! Latent heat of vaporization + real(r8) :: latice ! Latent heat of fusion + real(r8) :: latsub ! Latent heat of sublimation + real(r8) :: g ! Gravitational acceleration + real(r8) :: vk ! Von Karman's constant + + integer :: ntop_turb ! Top interface level to which turbulent vertical diffusion + ! is applied ( = 1 ) + integer :: nbot_turb ! Bottom interface level to which turbulent vertical diff + ! is applied ( = pver ) + + CONTAINS + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine init_eddy_diff( pver, gravx, cpairx, rairx, zvirx, & + latvapx, laticex, ntop_eddy, nbot_eddy, vkx, & + eddy_lbulk_max, leng_max_in, & + eddy_moist_entrain_a2l, errstring) + !---------------------------------------------------------------- ! + ! Purpose: ! + ! Initialize time independent constants/variables of PBL package. ! + !---------------------------------------------------------------- ! + + ! --------- ! + ! Arguments ! + ! --------- ! + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: ntop_eddy ! Top interface level to which eddy vertical diffusivity is applied ( = 1 ) + integer, intent(in) :: nbot_eddy ! Bottom interface level to which eddy vertical diffusivity is applied ( = pver ) + real(r8), intent(in) :: gravx ! Acceleration of gravity + real(r8), intent(in) :: cpairx ! Specific heat of dry air + real(r8), intent(in) :: rairx ! Gas constant for dry air + real(r8), intent(in) :: zvirx ! rh2o/rair - 1 + real(r8), intent(in) :: latvapx ! Latent heat of vaporization + real(r8), intent(in) :: laticex ! Latent heat of fusion + real(r8), intent(in) :: vkx ! Von Karman's constant + real(r8), intent(in) :: eddy_lbulk_max ! Maximum master length scale + real(r8), intent(in) :: leng_max_in(pver) ! Maximum length scale for upper atmosphere + real(r8), intent(in) :: eddy_moist_entrain_a2l ! Moist entrainment enhancement param + + character(len=*), intent(out) :: errstring + + integer :: k ! Vertical loop index + + errstring = "" + + ! --------------- ! + ! Basic constants ! + ! --------------- ! + + ncvmax = pver + + cpair = cpairx + rair = rairx + g = gravx + zvir = zvirx + latvap = latvapx + latice = laticex + latsub = latvap + latice + vk = vkx + ntop_turb = ntop_eddy + nbot_turb = nbot_eddy + b123 = b1**(2._r8/3._r8) + a2l = eddy_moist_entrain_a2l + + lbulk_max = eddy_lbulk_max + + allocate(leng_max(pver)) + leng_max = leng_max_in + + end subroutine init_eddy_diff + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine sfdiag( pcols , pver , ncol , qt , ql , sl , & + pi , pm , zi , cld , sfi , sfuh , & + sflh , slslope , qtslope ) + !----------------------------------------------------------------------- ! + ! ! + ! Purpose: Interface for calculating saturation fractions at upper and ! + ! lower-half layers, & interfaces for use by turbulence scheme ! + ! ! + ! Method : Various but 'l' should be chosen for consistency. ! + ! ! + ! Author : B. Stevens and C. Bretherton (August 2000) ! + ! Sungsu Park. August 2006. ! + ! May. 2008. ! + ! ! + ! S.Park : The computed saturation fractions are repeatedly ! + ! used to compute buoyancy coefficients in'trbintd' & 'caleddy'.! + !----------------------------------------------------------------------- ! + + implicit none + + ! --------------- ! + ! Input arguments ! + ! --------------- ! + + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ncol ! Number of atmospheric columns + + real(r8), intent(in) :: sl(pcols,pver) ! Liquid water static energy [ J/kg ] + real(r8), intent(in) :: qt(pcols,pver) ! Total water specific humidity [ kg/kg ] + real(r8), intent(in) :: ql(pcols,pver) ! Liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: pi(pcols,pver+1) ! Interface pressures [ Pa ] + real(r8), intent(in) :: pm(pcols,pver) ! Layer mid-point pressures [ Pa ] + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface heights [ m ] + real(r8), intent(in) :: cld(pcols,pver) ! Stratiform cloud fraction [ fraction ] + real(r8), intent(in) :: slslope(pcols,pver) ! Slope of 'sl' in each layer + real(r8), intent(in) :: qtslope(pcols,pver) ! Slope of 'qt' in each layer + + ! ---------------- ! + ! Output arguments ! + ! ---------------- ! + + real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] + real(r8), intent(out) :: sfuh(pcols,pver) ! Saturation fraction in upper half-layer [ fraction ] + real(r8), intent(out) :: sflh(pcols,pver) ! Saturation fraction in lower half-layer [ fraction ] + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer :: i ! Longitude index + integer :: k ! Vertical index + integer :: km1 ! k-1 + integer :: status ! Status returned by function calls + real(r8) :: sltop, slbot ! sl at top/bot of grid layer + real(r8) :: qttop, qtbot ! qt at top/bot of grid layer + real(r8) :: tltop, tlbot ! Liquid water temperature at top/bot of grid layer + real(r8) :: qxtop, qxbot ! Sat excess at top/bot of grid layer + real(r8) :: qxm ! Sat excess at midpoint + real(r8) :: es ! Saturation vapor pressure + real(r8) :: qs ! Saturation spec. humidity + real(r8) :: cldeff(pcols,pver) ! Effective Cloud Fraction [ fraction ] + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + sfi(1:ncol,:) = 0._r8 + sfuh(1:ncol,:) = 0._r8 + sflh(1:ncol,:) = 0._r8 + cldeff(1:ncol,:) = 0._r8 + + select case (sftype) + case ('d') + ! ----------------------------------------------------------------------- ! + ! Simply use the given stratus fraction ('horizontal' cloud partitioning) ! + ! ----------------------------------------------------------------------- ! + do k = ntop_turb + 1, nbot_turb + km1 = k - 1 + do i = 1, ncol + sfuh(i,k) = cld(i,k) + sflh(i,k) = cld(i,k) + sfi(i,k) = 0.5_r8 * ( sflh(i,km1) + min( sflh(i,km1), sfuh(i,k) ) ) + end do + end do + do i = 1, ncol + sfi(i,pver+1) = sflh(i,pver) + end do + case ('l') + ! ------------------------------------------ ! + ! Use modified stratus fraction partitioning ! + ! ------------------------------------------ ! + do k = ntop_turb + 1, nbot_turb + km1 = k - 1 + do i = 1, ncol + cldeff(i,k) = cld(i,k) + sfuh(i,k) = cld(i,k) + sflh(i,k) = cld(i,k) + if( ql(i,k) .lt. qmin ) then + sfuh(i,k) = 0._r8 + sflh(i,k) = 0._r8 + end if + ! Modification : The contribution of ice should be carefully considered. + if( choice_evhc .eq. 'ramp' .or. choice_radf .eq. 'ramp' ) then + cldeff(i,k) = cld(i,k) * min( ql(i,k) / qmin, 1._r8 ) + sfuh(i,k) = cldeff(i,k) + sflh(i,k) = cldeff(i,k) + elseif( choice_evhc .eq. 'maxi' .or. choice_radf .eq. 'maxi' ) then + cldeff(i,k) = cld(i,k) + sfuh(i,k) = cldeff(i,k) + sflh(i,k) = cldeff(i,k) + endif + ! At the stratus top, take the minimum interfacial saturation fraction + sfi(i,k) = 0.5_r8 * ( sflh(i,km1) + min( sfuh(i,k), sflh(i,km1) ) ) + ! Modification : Currently sfi at the top and surface interfaces are set to be zero. + ! Also, sfuh and sflh in the top model layer is set to be zero. + ! However, I may need to set + ! do i = 1, ncol + ! sfi(i,pver+1) = sflh(i,pver) + ! end do + ! for treating surface-based fog. + ! OK. I added below block similar to the other cases. + end do + end do + do i = 1, ncol + sfi(i,pver+1) = sflh(i,pver) + end do + case ('u') + ! ------------------------------------------------------------------------- ! + ! Use unsaturated buoyancy - since sfi, sfuh, sflh have already been zeroed ! + ! nothing more need be done for this case. ! + ! ------------------------------------------------------------------------- ! + case ('z') + ! ------------------------------------------------------------------------- ! + ! Calculate saturation fraction based on whether the air just above or just ! + ! below the interface is saturated, i.e. with vertical cloud partitioning. ! + ! The saturation fraction of the interfacial layer between mid-points k and ! + ! k+1 is computed by averaging the saturation fraction of the half-layers ! + ! above and below the interface, with a special provision for cloud tops ! + ! (more cloud in the half-layer below than in the half-layer above).In each ! + ! half-layer, vertical partitioning of cloud based on the slopes diagnosed ! + ! above is used. Loop down through the layers, computing the saturation ! + ! fraction in each half-layer (sfuh for upper half, sflh for lower half). ! + ! Once sfuh(i,k) is computed, use with sflh(i,k-1) to determine saturation ! + ! fraction sfi(i,k) for interfacial layer k-0.5. ! + ! This is 'not' chosen for full consistent treatment of stratus fraction in ! + ! all physics schemes. ! + ! ------------------------------------------------------------------------- ! + do k = ntop_turb + 1, nbot_turb + km1 = k - 1 + do i = 1, ncol + ! Compute saturation excess at the mid-point of layer k + sltop = sl(i,k) + slslope(i,k) * ( pi(i,k) - pm(i,k) ) + qttop = qt(i,k) + qtslope(i,k) * ( pi(i,k) - pm(i,k) ) + tltop = ( sltop - g * zi(i,k) ) / cpair + call qsat( tltop, pi(i,k), es, qs) + qxtop = qttop - qs + slbot = sl(i,k) + slslope(i,k) * ( pi(i,k+1) - pm(i,k) ) + qtbot = qt(i,k) + qtslope(i,k) * ( pi(i,k+1) - pm(i,k) ) + tlbot = ( slbot - g * zi(i,k+1) ) / cpair + call qsat( tlbot, pi(i,k+1), es, qs) + qxbot = qtbot - qs + qxm = qxtop + ( qxbot - qxtop ) * ( pm(i,k) - pi(i,k) ) / ( pi(i,k+1) - pi(i,k) ) + ! Find the saturation fraction sfuh(i,k) of the upper half of layer k. + if( ( qxtop .lt. 0._r8 ) .and. ( qxm .lt. 0._r8 ) ) then + sfuh(i,k) = 0._r8 + else if( ( qxtop .gt. 0._r8 ) .and. ( qxm .gt. 0._r8 ) ) then + sfuh(i,k) = 1._r8 + else ! Either qxm < 0 and qxtop > 0 or vice versa + sfuh(i,k) = max( qxtop, qxm ) / abs( qxtop - qxm ) + end if + ! Combine with sflh(i) (still for layer k-1) to get interfac layer saturation fraction + sfi(i,k) = 0.5_r8 * ( sflh(i,k-1) + min( sflh(i,k-1), sfuh(i,k) ) ) + ! Update sflh to be for the lower half of layer k. + if( ( qxbot .lt. 0._r8 ) .and. ( qxm .lt. 0._r8 ) ) then + sflh(i,k) = 0._r8 + else if( ( qxbot .gt. 0._r8 ) .and. ( qxm .gt. 0._r8 ) ) then + sflh(i,k) = 1._r8 + else ! Either qxm < 0 and qxbot > 0 or vice versa + sflh(i,k) = max( qxbot, qxm ) / abs( qxbot - qxm ) + end if + end do ! i + end do ! k + do i = 1, ncol + sfi(i,pver+1) = sflh(i,pver) ! Saturation fraction in the lowest half-layer. + end do + end select + + return + end subroutine sfdiag + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine trbintd( pcols , pver , ncol , & + z , u , v , & + t , pmid , & + s2 , n2 , ri , & + zi , pi , cld , & + qt , qv , ql , qi , sfi , sfuh , & + sflh , sl , slv , slslope , qtslope , & + chs , chu , cms , cmu ) + !----------------------------------------------------------------------- ! + ! Purpose: Calculate buoyancy coefficients at all interfaces including ! + ! surface. Also, computes the profiles of ( sl,qt,n2,s2,ri ). ! + ! Note that (n2,s2,ri) are defined at each interfaces except ! + ! surface. ! + ! ! + ! Author: B. Stevens ( Extracted from pbldiff, August, 2000 ) ! + ! Sungsu Park ( August 2006, May. 2008 ) ! + !----------------------------------------------------------------------- ! + + implicit none + + ! --------------- ! + ! Input arguments ! + ! --------------- ! + + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ncol ! Number of atmospheric columns + real(r8), intent(in) :: z(pcols,pver) ! Layer mid-point height above surface [ m ] + real(r8), intent(in) :: u(pcols,pver) ! Layer mid-point u [ m/s ] + real(r8), intent(in) :: v(pcols,pver) ! Layer mid-point v [ m/s ] + real(r8), intent(in) :: t(pcols,pver) ! Layer mid-point temperature [ K ] + real(r8), intent(in) :: pmid(pcols,pver) ! Layer mid-point pressure [ Pa ] + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface height [ m ] + real(r8), intent(in) :: pi(pcols,pver+1) ! Interface pressure [ Pa ] + real(r8), intent(in) :: cld(pcols,pver) ! Stratus fraction + real(r8), intent(in) :: qv(pcols,pver) ! Water vapor specific humidity [ kg/kg ] + real(r8), intent(in) :: ql(pcols,pver) ! Liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: qi(pcols,pver) ! Ice water specific humidity [ kg/kg ] + + ! ---------------- ! + ! Output arguments ! + ! ---------------- ! + + real(r8), intent(out) :: s2(pcols,pver) ! Interfacial ( except surface ) shear squared [ s-2 ] + real(r8), intent(out) :: n2(pcols,pver) ! Interfacial ( except surface ) buoyancy frequency [ s-2 ] + real(r8), intent(out) :: ri(pcols,pver) ! Interfacial ( except surface ) Richardson number, 'n2/s2' + + real(r8), intent(out) :: qt(pcols,pver) ! Total specific humidity [ kg/kg ] + real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] + real(r8), intent(out) :: sfuh(pcols,pver) ! Saturation fraction in upper half-layer [ fraction ] + real(r8), intent(out) :: sflh(pcols,pver) ! Saturation fraction in lower half-layer [ fraction ] + real(r8), intent(out) :: sl(pcols,pver) ! Liquid water static energy [ J/kg ] + real(r8), intent(out) :: slv(pcols,pver) ! Liquid water virtual static energy [ J/kg ] + + real(r8), intent(out) :: chu(pcols,pver+1) ! Heat buoyancy coef for dry states at all interfaces, finally. + ! [ unit ? ] + real(r8), intent(out) :: chs(pcols,pver+1) ! heat buoyancy coef for sat states at all interfaces, finally. + ! [ unit ? ] + real(r8), intent(out) :: cmu(pcols,pver+1) ! Moisture buoyancy coef for dry states at all interfaces, finally. + ! [ unit ? ] + real(r8), intent(out) :: cms(pcols,pver+1) ! Moisture buoyancy coef for sat states at all interfaces, finally. + ! [ unit ? ] + real(r8), intent(out) :: slslope(pcols,pver) ! Slope of 'sl' in each layer + real(r8), intent(out) :: qtslope(pcols,pver) ! Slope of 'qt' in each layer + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer :: i ! Longitude index + integer :: k, km1 ! Level index + integer :: status ! Status returned by function calls + + real(r8) :: qs(pcols,pver) ! Saturation specific humidity + real(r8) :: es(pcols,pver) ! Saturation vapor pressure + real(r8) :: gam(pcols,pver) ! (l/cp)*(d(qs)/dT) + real(r8) :: rdz ! 1 / (delta z) between midpoints + real(r8) :: dsldz ! 'delta sl / delta z' at interface + real(r8) :: dqtdz ! 'delta qt / delta z' at interface + real(r8) :: ch ! 'sfi' weighted ch at the interface + real(r8) :: cm ! 'sfi' weighted cm at the interface + real(r8) :: bfact ! Buoyancy factor in n2 calculations + real(r8) :: product ! Intermediate vars used to find slopes + real(r8) :: dsldp_a, dqtdp_a ! Slopes across interface above + real(r8) :: dsldp_b(pcols), dqtdp_b(pcols) ! Slopes across interface below + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + ! Calculate conservative scalars (qt,sl,slv) and buoyancy coefficients at the layer mid-points. + ! Note that 'ntop_turb = 1', 'nbot_turb = pver' + + do k = ntop_turb, nbot_turb + call qsat( t(:ncol,k), pmid(:ncol,k), es(:ncol,k), qs(:ncol,k), gam=gam(:ncol,k)) + do i = 1, ncol + qt(i,k) = qv(i,k) + ql(i,k) + qi(i,k) + sl(i,k) = cpair * t(i,k) + g * z(i,k) - latvap * ql(i,k) - latsub * qi(i,k) + slv(i,k) = sl(i,k) * ( 1._r8 + zvir * qt(i,k) ) + ! Thermodynamic coefficients for buoyancy flux - in this loop these are + ! calculated at mid-points; later, they will be averaged to interfaces, + ! where they will ultimately be used. At the surface, the coefficients + ! are taken from the lowest mid point. + bfact = g / ( t(i,k) * ( 1._r8 + zvir * qv(i,k) - ql(i,k) - qi(i,k) ) ) + chu(i,k) = ( 1._r8 + zvir * qt(i,k) ) * bfact / cpair + chs(i,k) = ( ( 1._r8 + ( 1._r8 + zvir ) * gam(i,k) * cpair * t(i,k) / latvap ) / ( 1._r8 + gam(i,k) ) ) * bfact / cpair + cmu(i,k) = zvir * bfact * t(i,k) + cms(i,k) = latvap * chs(i,k) - bfact * t(i,k) + end do + end do + + do i = 1, ncol + chu(i,pver+1) = chu(i,pver) + chs(i,pver+1) = chs(i,pver) + cmu(i,pver+1) = cmu(i,pver) + cms(i,pver+1) = cms(i,pver) + end do + + ! Compute slopes of conserved variables sl, qt within each layer k. + ! 'a' indicates the 'above' gradient from layer k-1 to layer k and + ! 'b' indicates the 'below' gradient from layer k to layer k+1. + ! We take a smaller (in absolute value) of these gradients as the + ! slope within layer k. If they have opposite signs, gradient in + ! layer k is taken to be zero. I should re-consider whether this + ! profile reconstruction is the best or not. + ! This is similar to the profile reconstruction used in the UWShCu. + + do i = 1, ncol + ! Slopes at endpoints determined by extrapolation + slslope(i,pver) = ( sl(i,pver) - sl(i,pver-1) ) / ( pmid(i,pver) - pmid(i,pver-1) ) + qtslope(i,pver) = ( qt(i,pver) - qt(i,pver-1) ) / ( pmid(i,pver) - pmid(i,pver-1) ) + slslope(i,1) = ( sl(i,2) - sl(i,1) ) / ( pmid(i,2) - pmid(i,1) ) + qtslope(i,1) = ( qt(i,2) - qt(i,1) ) / ( pmid(i,2) - pmid(i,1) ) + dsldp_b(i) = slslope(i,1) + dqtdp_b(i) = qtslope(i,1) + end do + + do k = 2, pver - 1 + do i = 1, ncol + dsldp_a = dsldp_b(i) + dqtdp_a = dqtdp_b(i) + dsldp_b(i) = ( sl(i,k+1) - sl(i,k) ) / ( pmid(i,k+1) - pmid(i,k) ) + dqtdp_b(i) = ( qt(i,k+1) - qt(i,k) ) / ( pmid(i,k+1) - pmid(i,k) ) + product = dsldp_a * dsldp_b(i) + if( product .le. 0._r8 ) then + slslope(i,k) = 0._r8 + else if( product .gt. 0._r8 .and. dsldp_a .lt. 0._r8 ) then + slslope(i,k) = max( dsldp_a, dsldp_b(i) ) + else if( product .gt. 0._r8 .and. dsldp_a .gt. 0._r8 ) then + slslope(i,k) = min( dsldp_a, dsldp_b(i) ) + end if + product = dqtdp_a*dqtdp_b(i) + if( product .le. 0._r8 ) then + qtslope(i,k) = 0._r8 + else if( product .gt. 0._r8 .and. dqtdp_a .lt. 0._r8 ) then + qtslope(i,k) = max( dqtdp_a, dqtdp_b(i) ) + else if( product .gt. 0._r8 .and. dqtdp_a .gt. 0._r8 ) then + qtslope(i,k) = min( dqtdp_a, dqtdp_b(i) ) + end if + end do ! i + end do ! k + + ! Compute saturation fraction at the interfacial layers for use in buoyancy + ! flux computation. + + call sfdiag( pcols , pver , ncol , qt , ql , sl , & + pi , pmid , zi , cld , sfi , sfuh , & + sflh , slslope , qtslope ) + + ! Calculate buoyancy coefficients at all interfaces (1:pver+1) and (n2,s2,ri) + ! at all interfaces except surface. Note 'nbot_turb = pver', 'ntop_turb = 1'. + ! With the previous definition of buoyancy coefficients at the surface, the + ! resulting buoyancy coefficients at the top and surface interfaces becomes + ! identical to the buoyancy coefficients at the top and bottom layers. Note + ! that even though the dimension of (s2,n2,ri) is 'pver', they are defined + ! at interfaces ( not at the layer mid-points ) except the surface. + + do k = nbot_turb, ntop_turb + 1, -1 + km1 = k - 1 + do i = 1, ncol + rdz = 1._r8 / ( z(i,km1) - z(i,k) ) + dsldz = ( sl(i,km1) - sl(i,k) ) * rdz + dqtdz = ( qt(i,km1) - qt(i,k) ) * rdz + chu(i,k) = ( chu(i,km1) + chu(i,k) ) * 0.5_r8 + chs(i,k) = ( chs(i,km1) + chs(i,k) ) * 0.5_r8 + cmu(i,k) = ( cmu(i,km1) + cmu(i,k) ) * 0.5_r8 + cms(i,k) = ( cms(i,km1) + cms(i,k) ) * 0.5_r8 + ch = chu(i,k) * ( 1._r8 - sfi(i,k) ) + chs(i,k) * sfi(i,k) + cm = cmu(i,k) * ( 1._r8 - sfi(i,k) ) + cms(i,k) * sfi(i,k) + n2(i,k) = ch * dsldz + cm * dqtdz + s2(i,k) = ( ( u(i,km1) - u(i,k) )**2 + ( v(i,km1) - v(i,k) )**2) * rdz**2 + s2(i,k) = max( ntzero, s2(i,k) ) + ri(i,k) = n2(i,k) / s2(i,k) + end do + end do + do i = 1, ncol + n2(i,1) = n2(i,2) + s2(i,1) = s2(i,2) + ri(i,1) = ri(i,2) + end do + + return + + end subroutine trbintd + + ! ---------------------------------------------------------------------------- ! + ! ! + ! The University of Washington Moist Turbulence Scheme ! + ! ! + ! Authors : Chris Bretherton at the University of Washington, Seattle, WA ! + ! Sungsu Park at the CGD/NCAR, Boulder, CO ! + ! ! + ! ---------------------------------------------------------------------------- ! + + subroutine caleddy( pcols , pver , ncol , & + sl , qt , ql , slv , u , & + v , pi , z , zi , & + qflx , shflx , slslope , qtslope , & + chu , chs , cmu , cms , sfuh , & + sflh , n2 , s2 , ri , rrho , & + pblh , ustar , & + kvh_in , kvm_in , kvh , kvm , & + tpert , qpert , qrlin , kvf , tke , & + wstarent , bprod , sprod , minpblh , wpert , & + tkes , went , turbtype , sm_aw , & + kbase_o , ktop_o , ncvfin_o , & + kbase_mg , ktop_mg , ncvfin_mg , & + kbase_f , ktop_f , ncvfin_f , & + wet_CL , web_CL , jtbu_CL , jbbu_CL , & + evhc_CL , jt2slv_CL , n2ht_CL , n2hb_CL , lwp_CL , & + opt_depth_CL , radinvfrac_CL, radf_CL , wstar_CL , wstar3fact_CL, & + ebrk , wbrk , lbrk , ricl , ghcl , & + shcl , smcl , & + gh_a , sh_a , sm_a , ri_a , leng , & + wcap , pblhp , cld , ipbl , kpblh , & + wsedl , wsed_CL , warnstring , errstring) + + !--------------------------------------------------------------------------------- ! + ! ! + ! Purpose : This is a driver routine to compute eddy diffusion coefficients ! + ! for heat (sl), momentum (u, v), moisture (qt), and other trace ! + ! constituents. This scheme uses first order closure for stable ! + ! turbulent layers (STL). For convective layers (CL), entrainment ! + ! closure is used at the CL external interfaces, which is coupled ! + ! to the diagnosis of a CL regime mean TKE from the instantaneous ! + ! thermodynamic and velocity profiles. The CLs are diagnosed by ! + ! extending original CL layers of moist static instability into ! + ! adjacent weakly stably stratified interfaces, stopping if the ! + ! stability is too strong. This allows a realistic depiction of ! + ! dry convective boundary layers with a downgradient approach. ! + ! ! + ! NOTE: This routine currently assumes ntop_turb = 1, nbot_turb = pver ! + ! ( turbulent diffusivities computed at all interior interfaces ) ! + ! and will require modification to handle a different ntop_turb. ! + ! ! + ! Authors: Sungsu Park and Chris Bretherton. 08/2006, 05/2008. ! + ! ! + ! For details, see ! + ! ! + ! 1. 'A new moist turbulence parametrization in the Community Atmosphere Model' ! + ! by Christopher S. Bretherton & Sungsu Park. J. Climate. 22. 3422-3448. 2009. ! + ! ! + ! 2. 'The University of Washington shallow convection and moist turbulence schemes ! + ! and their impact on climate simulations with the Community Atmosphere Model' ! + ! by Sungsu Park & Christopher S. Bretherton. J. Climate. 22. 3449-3469. 2009. ! + ! ! + ! For questions on the scheme and code, send an email to ! + ! sungsup@ucar.edu or breth@washington.edu ! + ! ! + !--------------------------------------------------------------------------------- ! + + use pbl_utils, only: & + compute_radf ! Subroutine for computing radf + + ! ---------------- ! + ! Inputs variables ! + ! ---------------- ! + + implicit none + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ncol ! Number of atmospheric columns + real(r8), intent(in) :: u(pcols,pver) ! U wind [ m/s ] + real(r8), intent(in) :: v(pcols,pver) ! V wind [ m/s ] + real(r8), intent(in) :: sl(pcols,pver) ! Liquid water static energy, cp * T + g * z - Lv * ql - Ls * qi [ J/kg ] + real(r8), intent(in) :: slv(pcols,pver) ! Liquid water virtual static energy, sl * ( 1 + 0.608 * qt ) [ J/kg ] + real(r8), intent(in) :: qt(pcols,pver) ! Total speccific humidity qv + ql + qi [ kg/kg ] + real(r8), intent(in) :: ql(pcols,pver) ! Liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: pi(pcols,pver+1) ! Interface pressures [ Pa ] + real(r8), intent(in) :: z(pcols,pver) ! Layer midpoint height above surface [ m ] + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface height above surface, i.e., zi(pver+1) = 0 all over the globe + ! [ m ] + real(r8), intent(in) :: chu(pcols,pver+1) ! Buoyancy coeffi. unsaturated sl (heat) coef. at all interfaces. + ! [ unit ? ] + real(r8), intent(in) :: chs(pcols,pver+1) ! Buoyancy coeffi. saturated sl (heat) coef. at all interfaces. + ! [ unit ? ] + real(r8), intent(in) :: cmu(pcols,pver+1) ! Buoyancy coeffi. unsaturated qt (moisture) coef. at all interfaces + ! [ unit ? ] + real(r8), intent(in) :: cms(pcols,pver+1) ! Buoyancy coeffi. saturated qt (moisture) coef. at all interfaces + ! [ unit ? ] + real(r8), intent(in) :: sfuh(pcols,pver) ! Saturation fraction in upper half-layer [ fraction ] + real(r8), intent(in) :: sflh(pcols,pver) ! Saturation fraction in lower half-layer [ fraction ] + real(r8), intent(in) :: n2(pcols,pver) ! Interfacial (except surface) moist buoyancy frequency [ s-2 ] + real(r8), intent(in) :: s2(pcols,pver) ! Interfacial (except surface) shear frequency [ s-2 ] + real(r8), intent(in) :: ri(pcols,pver) ! Interfacial (except surface) Richardson number + real(r8), intent(in) :: qflx(pcols) ! Kinematic surface constituent ( water vapor ) flux [ kg/m2/s ] + real(r8), intent(in) :: shflx(pcols) ! Kinematic surface heat flux [ unit ? ] + real(r8), intent(in) :: slslope(pcols,pver) ! Slope of 'sl' in each layer [ J/kg/Pa ] + real(r8), intent(in) :: qtslope(pcols,pver) ! Slope of 'qt' in each layer [ kg/kg/Pa ] + real(r8), intent(in) :: qrlin(pcols,pver) ! Input grid-mean LW heating rate : [ K/s ] * cpair * dp = [ W/kg*Pa ] + real(r8), intent(in) :: wsedl(pcols,pver) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] + real(r8), intent(in) :: ustar(pcols) ! Surface friction velocity [ m/s ] + real(r8), intent(in) :: rrho(pcols) ! 1./bottom mid-point density. Specific volume [ m3/kg ] + real(r8), intent(in) :: kvf(pcols,pver+1) ! Free atmosphere eddy diffusivity [ m2/s ] + logical, intent(in) :: wstarent ! Switch for choosing wstar3 entrainment parameterization + real(r8), intent(in) :: minpblh(pcols) ! Minimum PBL height based on surface stress [ m ] + real(r8), intent(in) :: kvh_in(pcols,pver+1) ! kvh saved from last timestep or last iterative step [ m2/s ] + real(r8), intent(in) :: kvm_in(pcols,pver+1) ! kvm saved from last timestep or last iterative step [ m2/s ] + real(r8), intent(in) :: cld(pcols,pver) ! Stratus Cloud Fraction [ fraction ] + + ! ---------------- ! + ! Output variables ! + ! ---------------- ! + + real(r8), intent(out) :: kvh(pcols,pver+1) ! Eddy diffusivity for heat, moisture, and tracers [ m2/s ] + real(r8), intent(out) :: kvm(pcols,pver+1) ! Eddy diffusivity for momentum [ m2/s ] + real(r8), intent(out) :: pblh(pcols) ! PBL top height [ m ] + real(r8), intent(out) :: pblhp(pcols) ! PBL top height pressure [ Pa ] + real(r8), intent(out) :: tpert(pcols) ! Convective temperature excess [ K ] + real(r8), intent(out) :: qpert(pcols) ! Convective humidity excess [ kg/kg ] + real(r8), intent(out) :: wpert(pcols) ! Turbulent velocity excess [ m/s ] + real(r8), intent(out) :: tkes(pcols) ! TKE at surface [ m2/s2 ] + real(r8), intent(out) :: went(pcols) ! Entrainment rate at the PBL top interface [ m/s ] + real(r8), intent(out) :: tke(pcols,pver+1) ! Turbulent kinetic energy [ m2/s2 ], 'tkes' at surface, pver+1. + real(r8), intent(out) :: bprod(pcols,pver+1) ! Buoyancy production [ m2/s3 ], 'bflxs' at surface, pver+1. + real(r8), intent(out) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ], (ustar(i)**3)/(vk*z(i,pver)) + ! at surface, pver+1. + integer(i4), intent(out) :: turbtype(pcols,pver+1) ! Turbulence type at each interface: + ! 0. = Non turbulence interface + ! 1. = Stable turbulence interface + ! 2. = CL interior interface ( if bflxs > 0, surface is this ) + ! 3. = Bottom external interface of CL + ! 4. = Top external interface of CL. + ! 5. = Double entraining CL external interface + real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Galperin instability function of momentum for use in the microphysics + ! [ no unit ] + integer(i4), intent(out) :: ipbl(pcols) ! If 1, PBL is CL, while if 0, PBL is STL. + integer(i4), intent(out) :: kpblh(pcols) ! Layer index containing PBL within or at the base interface + real(r8), intent(out) :: wsed_CL(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] + + character(len=*), intent(out) :: warnstring + character(len=*), intent(out) :: errstring + + ! --------------------------- ! + ! Diagnostic output variables ! + ! --------------------------- ! + + real(r8) :: kbase_o(pcols,ncvmax) ! Original external base interface index of CL just after 'exacol' + real(r8) :: ktop_o(pcols,ncvmax) ! Original external top interface index of CL just after 'exacol' + real(r8) :: ncvfin_o(pcols) ! Original number of CLs just after 'exacol' + real(r8) :: kbase_mg(pcols,ncvmax) ! kbase just after extending-merging (after 'zisocl') but without SRCL + real(r8) :: ktop_mg(pcols,ncvmax) ! ktop just after extending-merging (after 'zisocl') but without SRCL + real(r8) :: ncvfin_mg(pcols) ! ncvfin just after extending-merging (after 'zisocl') but without SRCL + real(r8) :: kbase_f(pcols,ncvmax) ! Final kbase after adding SRCL + real(r8) :: ktop_f(pcols,ncvmax) ! Final ktop after adding SRCL + real(r8) :: ncvfin_f(pcols) ! Final ncvfin after adding SRCL + real(r8) :: wet_CL(pcols,ncvmax) ! Entrainment rate at the CL top [ m/s ] + real(r8) :: web_CL(pcols,ncvmax) ! Entrainment rate at the CL base [ m/s ] + real(r8) :: jtbu_CL(pcols,ncvmax) ! Buoyancy jump across the CL top [ m/s2 ] + real(r8) :: jbbu_CL(pcols,ncvmax) ! Buoyancy jump across the CL base [ m/s2 ] + real(r8) :: evhc_CL(pcols,ncvmax) ! Evaporative enhancement factor at the CL top + real(r8) :: jt2slv_CL(pcols,ncvmax) ! Jump of slv ( across two layers ) at CL top for use only in evhc [ J/kg ] + real(r8) :: n2ht_CL(pcols,ncvmax) ! n2 defined at the CL top interface + ! but using sfuh(kt) instead of sfi(kt) [ s-2 ] + real(r8) :: n2hb_CL(pcols,ncvmax) ! n2 defined at the CL base interface + ! but using sflh(kb-1) instead of sfi(kb) [ s-2 ] + real(r8) :: lwp_CL(pcols,ncvmax) ! LWP in the CL top layer [ kg/m2 ] + real(r8) :: opt_depth_CL(pcols,ncvmax) ! Optical depth of the CL top layer + real(r8) :: radinvfrac_CL(pcols,ncvmax) ! Fraction of LW radiative cooling confined in the top portion of CL + real(r8) :: radf_CL(pcols,ncvmax) ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ] + real(r8) :: wstar_CL(pcols,ncvmax) ! Convective velocity of CL including entrainment contribution finally [ m/s ] + real(r8) :: wstar3fact_CL(pcols,ncvmax) ! "wstar3fact" of CL. Entrainment enhancement of wstar3 (inverse) + + real(r8) :: gh_a(pcols,pver+1) ! Half of normalized buoyancy production, -l2n2/2e. [ no unit ] + real(r8) :: sh_a(pcols,pver+1) ! Galperin instability function of heat-moisture at all interfaces [ no unit ] + real(r8) :: sm_a(pcols,pver+1) ! Galperin instability function of momentum at all interfaces [ no unit ] + real(r8) :: ri_a(pcols,pver+1) ! Interfacial Richardson number at all interfaces [ no unit ] + + real(r8) :: ebrk(pcols,ncvmax) ! Net CL mean TKE [ m2/s2 ] + real(r8) :: wbrk(pcols,ncvmax) ! Net CL mean normalized TKE [ m2/s2 ] + real(r8) :: lbrk(pcols,ncvmax) ! Net energetic integral thickness of CL [ m ] + real(r8) :: ricl(pcols,ncvmax) ! Mean Richardson number of CL ( l2n2/l2s2 ) + real(r8) :: ghcl(pcols,ncvmax) ! Half of normalized buoyancy production of CL + real(r8) :: shcl(pcols,ncvmax) ! Instability function of heat and moisture of CL + real(r8) :: smcl(pcols,ncvmax) ! Instability function of momentum of CL + + real(r8) :: leng(pcols,pver+1) ! Turbulent length scale [ m ], 0 at the surface. + real(r8) :: wcap(pcols,pver+1) ! Normalized TKE [m2/s2], 'tkes/b1' at the surface and 'tke/b1' at + ! the top/bottom entrainment interfaces of CL assuming no transport. + ! ------------------------ ! + ! Local Internal Variables ! + ! ------------------------ ! + + logical :: belongcv(pcols,pver+1) ! True for interfaces in a CL (both interior and exterior are included) + logical :: belongst(pcols,pver+1) ! True for stable turbulent layer interfaces (STL) + logical :: in_CL ! True if interfaces k,k+1 both in same CL. + logical :: extend ! True when CL is extended in zisocl + logical :: extend_up ! True when CL is extended upward in zisocl + logical :: extend_dn ! True when CL is extended downward in zisocl + + integer :: i ! Longitude index + integer :: k ! Vertical index + integer :: ks ! Vertical index + integer :: ncvfin(pcols) ! Total number of CL in column + integer :: ncvf ! Total number of CL in column prior to adding SRCL + integer :: ncv ! Index of current CL + integer :: ncvnew ! Index of added SRCL appended after regular CLs from 'zisocl' + integer :: ncvsurf ! If nonzero, CL index based on surface + ! (usually 1, but can be > 1 when SRCL is based at sfc) + integer :: kbase(pcols,ncvmax) ! Vertical index of CL base interface + integer :: ktop(pcols,ncvmax) ! Vertical index of CL top interface + integer :: kb, kt ! kbase and ktop for current CL + integer :: ktblw ! ktop of the CL located at just below the current CL + + integer :: ktopbl(pcols) ! PBL top height or interface index + real(r8) :: bflxs(pcols) ! Surface buoyancy flux [ m2/s3 ] + real(r8) :: rcap ! 'tke/ebrk' at all interfaces of CL. + ! Set to 1 at the CL entrainment interfaces + real(r8) :: jtzm ! Interface layer thickness of CL top interface [ m ] + real(r8) :: jtsl ! Jump of s_l across CL top interface [ J/kg ] + real(r8) :: jtqt ! Jump of q_t across CL top interface [ kg/kg ] + real(r8) :: jtbu ! Jump of buoyancy across CL top interface [ m/s2 ] + real(r8) :: jtu ! Jump of u across CL top interface [ m/s ] + real(r8) :: jtv ! Jump of v across CL top interface [ m/s ] + real(r8) :: jt2slv ! Jump of slv ( across two layers ) at CL top for use only in evhc [ J/kg ] + real(r8) :: radf ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ] + real(r8) :: jbzm ! Interface layer thickness of CL base interface [ m ] + real(r8) :: jbsl ! Jump of s_l across CL base interface [ J/kg ] + real(r8) :: jbqt ! Jump of q_t across CL top interface [ kg/kg ] + real(r8) :: jbbu ! Jump of buoyancy across CL base interface [ m/s2 ] + real(r8) :: jbu ! Jump of u across CL base interface [ m/s ] + real(r8) :: jbv ! Jump of v across CL base interface [ m/s ] + real(r8) :: ch ! Buoyancy coefficients defined at the CL top and base interfaces + ! using CL internal + real(r8) :: cm ! sfuh(kt) and sflh(kb-1) instead of sfi(kt) and sfi(kb), respectively. + ! These are used for entrainment calculation at CL external interfaces + ! and SRCL identification. + real(r8) :: n2ht ! n2 defined at the CL top interface + ! but using sfuh(kt) instead of sfi(kt) [ s-2 ] + real(r8) :: n2hb ! n2 defined at the CL base interface + ! but using sflh(kb-1) instead of sfi(kb) [ s-2 ] + real(r8) :: n2htSRCL ! n2 defined at the upper-half layer of SRCL. + ! This is used only for identifying SRCL. + ! n2htSRCL use SRCL internal slope sl and qt + ! as well as sfuh(kt) instead of sfi(kt) [ s-2 ] + real(r8) :: gh ! Half of normalized buoyancy production ( -l2n2/2e ) [ no unit ] + real(r8) :: sh ! Galperin instability function for heat and moisture + real(r8) :: sm ! Galperin instability function for momentum + real(r8) :: lbulk ! Depth of turbulent layer, Master length scale (not energetic length) + real(r8) :: dzht ! Thickness of top half-layer [ m ] + real(r8) :: dzhb ! Thickness of bottom half-layer [ m ] + real(r8) :: rootp ! Sqrt(net CL-mean TKE including entrainment contribution) [ m/s ] + real(r8) :: evhc ! Evaporative enhancement factor: (1+E) + ! with E = evap. cool. efficiency [ no unit ] + real(r8) :: kentr ! Effective entrainment diffusivity 'wet*dz', 'web*dz' [ m2/s ] + real(r8) :: lwp ! Liquid water path in the layer kt [ kg/m2 ] + real(r8) :: opt_depth ! Optical depth of the layer kt [ no unit ] + real(r8) :: radinvfrac ! Fraction of LW cooling in the layer kt + ! concentrated at the CL top [ no unit ] + real(r8) :: wet ! CL top entrainment rate [ m/s ] + real(r8) :: web ! CL bot entrainment rate [ m/s ]. Set to zero if CL is based at surface. + real(r8) :: vyt ! n2ht/n2 at the CL top interface + real(r8) :: vyb ! n2hb/n2 at the CL base interface + real(r8) :: vut ! Inverse Ri (=s2/n2) at the CL top interface + real(r8) :: vub ! Inverse Ri (=s2/n2) at the CL base interface + real(r8) :: fact ! Factor relating TKE generation to entrainment [ no unit ] + real(r8) :: trma ! Intermediate variables used for solving quadratic ( for gh from ri ) + real(r8) :: trmb ! and cubic equations ( for ebrk: the net CL mean TKE ) + real(r8) :: trmc ! + real(r8) :: trmp ! + real(r8) :: trmq ! + real(r8) :: qq ! + real(r8) :: det ! + real(r8) :: gg ! Intermediate variable used for calculating stability functions of + ! SRCL or SBCL based at the surface with bflxs > 0. + real(r8) :: dzhb5 ! Half thickness of the bottom-most layer of current CL regime + real(r8) :: dzht5 ! Half thickness of the top-most layer of adjacent CL regime + ! just below current CL + real(r8) :: qrlw(pcols,pver) ! Local grid-mean LW heating rate : [K/s] * cpair * dp = [ W/kg*Pa ] + + real(r8) :: cldeff(pcols,pver) ! Effective stratus fraction + real(r8) :: qleff ! Used for computing evhc + real(r8) :: tunlramp ! Ramping tunl + real(r8) :: leng_imsi ! For Kv = max(Kv_STL, Kv_entrain) + real(r8) :: tke_imsi ! + real(r8) :: kvh_imsi ! + real(r8) :: kvm_imsi ! + real(r8) :: alph4exs ! For extended stability function in the stable regime + real(r8) :: ghmin ! + + real(r8) :: sedfact ! For 'sedimentation-entrainment feedback' + + ! Local variables specific for 'wstar' entrainment closure + + real(r8) :: cet ! Proportionality coefficient between wet and wstar3 + real(r8) :: ceb ! Proportionality coefficient between web and wstar3 + real(r8) :: wstar ! Convective velocity for CL [ m/s ] + real(r8) :: wstar3 ! Cubed convective velocity for CL [ m3/s3 ] + real(r8) :: wstar3fact ! 1/(relative change of wstar^3 by entrainment) + real(r8) :: rmin ! sqrt(p) + real(r8) :: fmin ! f(rmin), where f(r) = r^3 - 3*p*r - 2q + real(r8) :: rcrit ! ccrit*wstar + real(r8) :: fcrit ! f(rcrit) + logical noroot ! True if f(r) has no root r > rcrit + + character(128) :: temp_string + + !-----------------------! + ! Start of Main Program ! + !-----------------------! + + warnstring = "" + errstring = "" + + ! Option: Turn-off LW radiative-turbulence interaction in PBL scheme + ! by setting qrlw = 0. Logical parameter 'set_qrlzero' was + ! defined in the first part of 'eddy_diff.F90' module. + + if( set_qrlzero ) then + qrlw(:,:) = 0._r8 + else + qrlw(:ncol,:pver) = qrlin(:ncol,:pver) + endif + + ! Define effective stratus fraction using the grid-mean ql. + ! Modification : The contribution of ice should be carefully considered. + ! This should be done in combination with the 'qrlw' and + ! overlapping assumption of liquid and ice stratus. + + do k = 1, pver + do i = 1, ncol + if( choice_evhc .eq. 'ramp' .or. choice_radf .eq. 'ramp' ) then + cldeff(i,k) = cld(i,k) * min( ql(i,k) / qmin, 1._r8 ) + else + cldeff(i,k) = cld(i,k) + endif + end do + end do + + ! For an extended stability function in the stable regime, re-define + ! alph4exe and ghmin. This is for future work. + + if( ricrit .eq. 0.19_r8 ) then + alph4exs = alph4 + ghmin = -3.5334_r8 + elseif( ricrit .gt. 0.19_r8 ) then + alph4exs = -2._r8 * b1 * alph2 / ( alph3 - 2._r8 * b1 * alph5 ) / ricrit + ghmin = -1.e10_r8 + else + errstring = 'ricrit should be larger than 0.19 in UW PBL' + return + endif + + ! + ! Initialization of Diagnostic Output + ! + + do i = 1, ncol + went(i) = 0._r8 + wet_CL(i,:ncvmax) = 0._r8 + web_CL(i,:ncvmax) = 0._r8 + jtbu_CL(i,:ncvmax) = 0._r8 + jbbu_CL(i,:ncvmax) = 0._r8 + evhc_CL(i,:ncvmax) = 0._r8 + jt2slv_CL(i,:ncvmax) = 0._r8 + n2ht_CL(i,:ncvmax) = 0._r8 + n2hb_CL(i,:ncvmax) = 0._r8 + lwp_CL(i,:ncvmax) = 0._r8 + opt_depth_CL(i,:ncvmax) = 0._r8 + radinvfrac_CL(i,:ncvmax) = 0._r8 + radf_CL(i,:ncvmax) = 0._r8 + wstar_CL(i,:ncvmax) = 0._r8 + wstar3fact_CL(i,:ncvmax) = 0._r8 + ricl(i,:ncvmax) = 0._r8 + ghcl(i,:ncvmax) = 0._r8 + shcl(i,:ncvmax) = 0._r8 + smcl(i,:ncvmax) = 0._r8 + ebrk(i,:ncvmax) = 0._r8 + wbrk(i,:ncvmax) = 0._r8 + lbrk(i,:ncvmax) = 0._r8 + gh_a(i,:pver+1) = 0._r8 + sh_a(i,:pver+1) = 0._r8 + sm_a(i,:pver+1) = 0._r8 + ri_a(i,:pver+1) = 0._r8 + sm_aw(i,:pver+1) = 0._r8 + ipbl(i) = 0 + kpblh(i) = pver + wsed_CL(i,:ncvmax) = 0._r8 + end do + + ! kvh and kvm are stored over timesteps in 'vertical_diffusion.F90' and + ! passed in as kvh_in and kvm_in. However, at the first timestep they + ! need to be computed and these are done just before calling 'caleddy'. + ! kvm and kvh are also stored over iterative time step in the first part + ! of 'eddy_diff.F90' + + ! Initialize kvh and kvm to kvf + kvh(:,:) = kvf(:,:) + kvm(:,:) = kvf(:,:) + ! Zero diagnostic quantities for the new diffusion step. + wcap(:,:) = 0._r8 + leng(:,:) = 0._r8 + tke(:,:) = 0._r8 + turbtype(:,:) = 0 + + + ! Initialize 'bprod' [ m2/s3 ] and 'sprod' [ m2/s3 ] at all interfaces. + ! Note this initialization is a hybrid initialization since 'n2' [s-2] and 's2' [s-2] + ! are calculated from the given current initial profile, while 'kvh_in' [m2/s] and + ! 'kvm_in' [m2/s] are from the previous iteration or previous time step. + ! This initially guessed 'bprod' and 'sprod' will be updated at the end of this + ! 'caleddy' subroutine for diagnostic output. + ! This computation of 'brpod,sprod' below is necessary for wstar-based entrainment closure. + + do k = 2, pver + do i = 1, ncol + bprod(i,k) = -kvh_in(i,k) * n2(i,k) + sprod(i,k) = kvm_in(i,k) * s2(i,k) + end do + end do + + ! Set 'bprod' and 'sprod' at top and bottom interface. + ! In calculating 'surface' (actually lowest half-layer) buoyancy flux, + ! 'chu' at surface is defined to be the same as 'chu' at the mid-point + ! of lowest model layer (pver) at the end of 'trbind'. The same is for + ! the other buoyancy coefficients. 'sprod(i,pver+1)' is defined in a + ! consistent way as the definition of 'tkes' in the original code. + ! ( Important Option ) If I want to isolate surface buoyancy flux from + ! the other parts of CL regimes energetically even though bflxs > 0, + ! all I should do is to re-define 'bprod(i,pver+1)=0' in the below 'do' + ! block. Additionally for merging test of extending SBCL based on 'l2n2' + ! in 'zisocl', I should use 'l2n2 = - wint / sh' for similar treatment + ! as previous code. All other parts of the code are fully consistently + ! treated by these change only. + ! My future general convection scheme will use bflxs(i). + + do i = 1, ncol + bprod(i,1) = 0._r8 ! Top interface + sprod(i,1) = 0._r8 ! Top interface + ch = chu(i,pver+1) * ( 1._r8 - sflh(i,pver) ) + chs(i,pver+1) * sflh(i,pver) + cm = cmu(i,pver+1) * ( 1._r8 - sflh(i,pver) ) + cms(i,pver+1) * sflh(i,pver) + bflxs(i) = ch * shflx(i) * rrho(i) + cm * qflx(i) * rrho(i) + if( choice_tkes .eq. 'ibprod' ) then + bprod(i,pver+1) = bflxs(i) + else + bprod(i,pver+1) = 0._r8 + endif + sprod(i,pver+1) = (ustar(i)**3)/(vk*z(i,pver)) + end do + + ! Initially identify CL regimes in 'exacol' + ! ktop : Interface index of the CL top external interface + ! kbase : Interface index of the CL base external interface + ! ncvfin: Number of total CLs + ! Note that if surface buoyancy flux is positive ( bflxs = bprod(i,pver+1) > 0 ), + ! surface interface is identified as an internal interface of CL. However, even + ! though bflxs <= 0, if 'pver' interface is a CL internal interface (ri(pver)<0), + ! surface interface is identified as an external interface of CL. If bflxs =< 0 + ! and ri(pver) >= 0, then surface interface is identified as a stable turbulent + ! intereface (STL) as shown at the end of 'caleddy'. Even though a 'minpblh' is + ! passed into 'exacol', it is not used in the 'exacol'. + + call exacol( pcols, pver, ncol, ri, bflxs, minpblh, zi, ktop, kbase, ncvfin ) + + ! Diagnostic output of CL interface indices before performing 'extending-merging' + ! of CL regimes in 'zisocl' + do i = 1, ncol + do k = 1, ncvmax + kbase_o(i,k) = real(kbase(i,k),r8) + ktop_o(i,k) = real(ktop(i,k),r8) + ncvfin_o(i) = real(ncvfin(i),r8) + end do + end do + + ! ----------------------------------- ! + ! Perform calculation for each column ! + ! ----------------------------------- ! + + do i = 1, ncol + + ! Define Surface Interfacial Layer TKE, 'tkes'. + ! In the current code, 'tkes' is used as representing TKE of surface interfacial + ! layer (low half-layer of surface-based grid layer). In the code, when bflxs>0, + ! surface interfacial layer is assumed to be energetically coupled to the other + ! parts of the CL regime based at the surface. In this sense, it is conceptually + ! more reasonable to include both 'bprod' and 'sprod' in the definition of 'tkes'. + ! Since 'tkes' cannot be negative, it is lower bounded by small positive number. + ! Note that inclusion of 'bprod' in the definition of 'tkes' may increase 'ebrk' + ! and 'wstar3', and eventually, 'wet' at the CL top, especially when 'bflxs>0'. + ! This might help to solve the problem of too shallow PBLH over the overcast Sc + ! regime. If I want to exclude 'bprod(i,pver+1)' in calculating 'tkes' even when + ! bflxs > 0, all I should to do is to set 'bprod(i,pver+1) = 0' in the above + ! initialization 'do' loop (explained above), NOT changing the formulation of + ! tkes(i) in the below block. This is because for consistent treatment in the + ! other parts of the code also. + + ! tkes(i) = (b1*vk*z(i,pver)*sprod(i,pver+1))**(2._r8/3._r8) + tkes(i) = max(b1*vk*z(i,pver)*(bprod(i,pver+1)+sprod(i,pver+1)), 1.e-7_r8)**(2._r8/3._r8) + tkes(i) = min(tkes(i), tkemax) + tke(i,pver+1) = tkes(i) + wcap(i,pver+1) = tkes(i)/b1 + + ! Extend and merge the initially identified CLs, relabel the CLs, and calculate + ! CL internal mean energetics and stability functions in 'zisocl'. + ! The CL nearest to the surface is CL(1) and the CL index, ncv, increases + ! with height. The following outputs are from 'zisocl'. Here, the dimension + ! of below outputs are (pcols,ncvmax) (except the 'ncvfin(pcols)' and + ! 'belongcv(pcols,pver+1)) and 'ncv' goes from 1 to 'ncvfin'. + ! For 'ncv = ncvfin+1, ncvmax', below output are already initialized to be zero. + ! ncvfin : Total number of CLs + ! kbase(ncv) : Base external interface index of CL + ! ktop : Top external interface index of CL + ! belongcv : True if the interface (either internal or external) is CL + ! ricl : Mean Richardson number of internal CL + ! ghcl : Normalized buoyancy production '-l2n2/2e' [no unit] of internal CL + ! shcl : Galperin instability function of heat-moisture of internal CL + ! smcl : Galperin instability function of momentum of internal CL + ! lbrk, int : Thickness of (energetically) internal CL (lint, [m]) + ! wbrk, int : Mean normalized TKE of internal CL ([m2/s2]) + ! ebrk, int : Mean TKE of internal CL (b1*wbrk,[m2/s2]) + ! The ncvsurf is an identifier saying which CL regime is based at the surface. + ! If 'ncvsurf=1', then the first CL regime is based at the surface. If surface + ! interface is not a part of CL (neither internal nor external), 'ncvsurf = 0'. + ! After identifying and including SRCLs into the normal CL regimes (where newly + ! identified SRCLs are simply appended to the normal CL regimes using regime + ! indices of 'ncvfin+1','ncvfin+2' (as will be shown in the below SRCL part),.. + ! where 'ncvfin' is the final CL regime index produced after extending-merging + ! in 'zisocl' but before adding SRCLs), if any newly identified SRCL (e.g., + ! 'ncvfin+1') is based at surface, then 'ncvsurf = ncvfin+1'. Thus 'ncvsurf' can + ! be 0, 1, or >1. 'ncvsurf' can be a useful diagnostic output. + + ncvsurf = 0 + if( ncvfin(i) .gt. 0 ) then + call zisocl( pcols , pver , i , & + z , zi , n2 , s2 , & + bprod , sprod , bflxs , tkes , & + ncvfin , kbase , ktop , belongcv, & + ricl , ghcl , shcl , smcl , & + lbrk , wbrk , ebrk , & + extend , extend_up, extend_dn, & + errstring) + if (trim(errstring) /= "") return + if( kbase(i,1) .eq. pver + 1 ) ncvsurf = 1 + else + belongcv(i,:) = .false. + endif + + ! Diagnostic output after finishing extending-merging process in 'zisocl' + ! Since we are adding SRCL additionally, we need to print out these here. + + do k = 1, ncvmax + kbase_mg(i,k) = real(kbase(i,k)) + ktop_mg(i,k) = real(ktop(i,k)) + ncvfin_mg(i) = real(ncvfin(i)) + end do + + ! ----------------------- ! + ! Identification of SRCLs ! + ! ----------------------- ! + + ! Modification : This cannot identify the 'cirrus' layer due to the condition of + ! ql(i,k) .gt. qmin. This should be modified in future to identify + ! a single thin cirrus layer. + ! Instead of ql, we may use cldn in future, including ice + ! contribution. + + ! ------------------------------------------------------------------------------ ! + ! Find single-layer radiatively-driven cloud-topped convective layers (SRCLs). ! + ! SRCLs extend through a single model layer k, with entrainment at the top and ! + ! bottom interfaces, unless bottom interface is the surface. ! + ! The conditions for an SRCL is identified are: ! + ! ! + ! 1. Cloud in the layer, k : ql(i,k) .gt. qmin = 1.e-5 [ kg/kg ] ! + ! 2. No cloud in the above layer (else assuming that some fraction of the LW ! + ! flux divergence in layer k is concentrated at just below top interface ! + ! of layer k is invalid). Then, this condition might be sensitive to the ! + ! vertical resolution of grid. ! + ! 3. LW radiative cooling (SW heating is assumed uniformly distributed through ! + ! layer k, so not relevant to buoyancy production) in the layer k. However, ! + ! SW production might also contribute, which may be considered in a future. ! + ! 4. Internal stratification 'n2ht' of upper-half layer should be unstable. ! + ! The 'n2ht' is pure internal stratification of upper half layer, obtained ! + ! using internal slopes of sl, qt in layer k (in contrast to conventional ! + ! interfacial slope) and saturation fraction in the upper-half layer, ! + ! sfuh(k) (in contrast to sfi(k)). ! + ! 5. Top and bottom interfaces not both in the same existing convective layer. ! + ! If SRCL is within the previouisly identified CL regimes, we don't define ! + ! a new SRCL. ! + ! 6. k >= ntop_turb + 1 = 2 ! + ! 7. Ri at the top interface > ricrit = 0.19 (otherwise turbulent mixing will ! + ! broadly distribute the cloud top in the vertical, preventing localized ! + ! radiative destabilization at the top interface). ! + ! ! + ! Note if 'k = pver', it identifies a surface-based single fog layer, possibly, ! + ! warm advection fog. Note also the CL regime index of SRCLs itself increases ! + ! with height similar to the regular CLs indices identified from 'zisocl'. ! + ! ------------------------------------------------------------------------------ ! + + ncv = 1 + ncvf = ncvfin(i) + + if( choice_SRCL .eq. 'remove' ) goto 222 + + do k = nbot_turb, ntop_turb + 1, -1 ! 'k = pver, 2, -1' is a layer index. + + if( ql(i,k) .gt. qmin .and. ql(i,k-1) .lt. qmin .and. qrlw(i,k) .lt. 0._r8 & + .and. ri(i,k) .ge. ricrit ) then + + ! In order to avoid any confliction with the treatment of ambiguous layer, + ! I need to impose an additional constraint that ambiguous layer cannot be + ! SRCL. So, I added constraint that 'k+1' interface (base interface of k + ! layer) should not be a part of previously identified CL. Since 'belongcv' + ! is even true for external entrainment interfaces, below constraint is + ! fully sufficient. + + if( choice_SRCL .eq. 'nonamb' .and. belongcv(i,k+1) ) then + go to 220 + endif + + ch = ( 1._r8 - sfuh(i,k) ) * chu(i,k) + sfuh(i,k) * chs(i,k) + cm = ( 1._r8 - sfuh(i,k) ) * cmu(i,k) + sfuh(i,k) * cms(i,k) + + n2htSRCL = ch * slslope(i,k) + cm * qtslope(i,k) + + if( n2htSRCL .le. 0._r8 ) then + + ! Test if bottom and top interfaces are part of the pre-existing CL. + ! If not, find appropriate index for the new SRCL. Note that this + ! calculation makes use of 'ncv set' obtained from 'zisocl'. The + ! 'in_CL' is a parameter testing whether the new SRCL is already + ! within the pre-existing CLs (.true.) or not (.false.). + + in_CL = .false. + + do while ( ncv .le. ncvf ) + if( ktop(i,ncv) .le. k ) then + if( kbase(i,ncv) .gt. k ) then + in_CL = .true. + endif + exit ! Exit from 'do while' loop if SRCL is within the CLs. + else + ncv = ncv + 1 ! Go up one CL + end if + end do ! ncv + + if( .not. in_CL ) then ! SRCL is not within the pre-existing CLs. + + ! Identify a new SRCL and add it to the pre-existing CL regime group. + + ncvfin(i) = ncvfin(i) + 1 + ncvnew = ncvfin(i) + ktop(i,ncvnew) = k + kbase(i,ncvnew) = k+1 + belongcv(i,k) = .true. + belongcv(i,k+1) = .true. + + ! Calculate internal energy of SRCL. There is no internal energy if + ! SRCL is elevated from the surface. Also, we simply assume neutral + ! stability function. Note that this assumption of neutral stability + ! does not influence numerical calculation- stability functions here + ! are just for diagnostic output. In general SRCLs other than a SRCL + ! based at surface with bflxs <= 0, there is no other way but to use + ! neutral stability function. However, in case of SRCL based at the + ! surface, we can explicitly calculate non-zero stability functions + ! in a consistent way. Even though stability functions of SRCL are + ! just diagnostic outputs not influencing numerical calculations, it + ! would be informative to write out correct reasonable values rather + ! than simply assuming neutral stability. I am doing this right now. + ! Similar calculations were done for the SBCL and when surface inter + ! facial layer was merged by overlying CL in 'ziscol'. + + if( k .lt. pver ) then + + wbrk(i,ncvnew) = 0._r8 + ebrk(i,ncvnew) = 0._r8 + lbrk(i,ncvnew) = 0._r8 + ghcl(i,ncvnew) = 0._r8 + shcl(i,ncvnew) = 0._r8 + smcl(i,ncvnew) = 0._r8 + ricl(i,ncvnew) = 0._r8 + + else ! Surface-based fog + + if( bflxs(i) .gt. 0._r8 ) then ! Incorporate surface TKE into CL interior energy + ! It is likely that this case cannot exist since + ! if surface buoyancy flux is positive, it would + ! have been identified as SBCL in 'zisocl' ahead. + ebrk(i,ncvnew) = tkes(i) + lbrk(i,ncvnew) = z(i,pver) + wbrk(i,ncvnew) = tkes(i) / b1 + + write(temp_string,*) 'Major mistake in SRCL: bflxs > 0 for surface-based SRCL' + warnstring = trim(warnstring)//temp_string + write(temp_string,*) 'bflxs = ', bflxs(i), & + 'ncvfin_o = ', ncvfin_o(i), & + 'ncvfin_mg = ', ncvfin_mg(i) + warnstring = trim(warnstring)//temp_string + do ks = 1, ncvmax + write(temp_string,*) 'ncv =', ks, ' ', kbase_o(i,ks), & + ktop_o(i,ks), kbase_mg(i,ks), ktop_mg(i,ks) + warnstring = trim(warnstring)//temp_string + end do + errstring = 'CALEDDY: Major mistake in SRCL: bflxs > 0 for surface-based SRCL' + return + else ! Don't incorporate surface interfacial TKE into CL interior energy + + ebrk(i,ncvnew) = 0._r8 + lbrk(i,ncvnew) = 0._r8 + wbrk(i,ncvnew) = 0._r8 + + endif + + ! Calculate stability functions (ghcl, shcl, smcl, ricl) explicitly + ! using an reverse procedure starting from tkes(i). Note that it is + ! possible to calculate stability functions even when bflxs < 0. + ! Previous code just assumed neutral stability functions. Note that + ! since alph5 = 0.7 > 0, alph3 = -35 < 0, the denominator of gh is + ! always positive if bflxs > 0. However, if bflxs < 0, denominator + ! can be zero. For this case, we provide a possible maximum negative + ! value (the most stable state) to gh. Note also tkes(i) is always a + ! positive value by a limiter. Also, sprod(i,pver+1) > 0 by limiter. + + gg = 0.5_r8 * vk * z(i,pver) * bprod(i,pver+1) / ( tkes(i)**(3._r8/2._r8) ) + if( abs(alph5-gg*alph3) .le. 1.e-7_r8 ) then + ! gh = -0.28_r8 + ! gh = -3.5334_r8 + gh = ghmin + else + gh = gg / ( alph5 - gg * alph3 ) + end if + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + ! gh = min(max(gh,-3.5334_r8),0.0233_r8) + gh = min(max(gh,ghmin),0.0233_r8) + ghcl(i,ncvnew) = gh + shcl(i,ncvnew) = max(0._r8,alph5/(1._r8+alph3*gh)) + smcl(i,ncvnew) = max(0._r8,(alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) + ricl(i,ncvnew) = -(smcl(i,ncvnew)/shcl(i,ncvnew))*(bprod(i,pver+1)/sprod(i,pver+1)) + + ! 'ncvsurf' is CL regime index based at the surface. If there is no + ! such regime, then 'ncvsurf = 0'. + + ncvsurf = ncvnew + + end if + + end if + + end if + + end if + + 220 continue + + end do ! End of 'k' loop where 'k' is a grid layer index running from 'pver' to 2 + + 222 continue + + ! -------------------------------------------------------------------------- ! + ! Up to this point, we identified all kinds of CL regimes : ! + ! 1. A SBCL. By construction, 'bflxs > 0' for SBCL. ! + ! 2. Surface-based CL with multiple layers and 'bflxs =< 0' ! + ! 3. Surface-based CL with multiple layers and 'bflxs > 0' ! + ! 4. Regular elevated CL with two entraining interfaces ! + ! 5. SRCLs. If SRCL is based at surface, it will be bflxs < 0. ! + ! '1-4' were identified from 'zisocl' while '5' were identified separately ! + ! after performing 'zisocl'. CL regime index of '1-4' increases with height ! + ! ( e.g., CL = 1 is the CL regime nearest to the surface ) while CL regime ! + ! index of SRCL is simply appended after the final index of CL regimes from ! + ! 'zisocl'. However, CL regime indices of SRCLs itself increases with height ! + ! when there are multiple SRCLs, similar to the regular CLs from 'zisocl'. ! + ! -------------------------------------------------------------------------- ! + + ! Diagnostic output of final CL regimes indices + + do k = 1, ncvmax + kbase_f(i,k) = real(kbase(i,k)) + ktop_f(i,k) = real(ktop(i,k)) + ncvfin_f(i) = real(ncvfin(i)) + end do + + ! --------------------------------------------------------------------- ! + ! Compute radf for each CL in column by calling subroutine compute_radf ! + ! --------------------------------------------------------------------- ! + call compute_radf( choice_radf, i, pcols, pver, ncvmax, ncvfin, ktop, qmin, & + ql, pi, qrlw, g, cldeff, zi, chs, lwp_CL(i,:), opt_depth_CL(i,:), & + radinvfrac_CL(i,:), radf_CL(i,:) ) + + ! ---------------------------------------- ! + ! Perform do loop for individual CL regime ! + ! ---------------------------------------- ! -------------------------------- ! + ! For individual CLs, compute ! + ! 1. Entrainment rates at the CL top and (if any) base interfaces using ! + ! appropriate entrainment closure (current code use 'wstar' closure). ! + ! 2. Net CL mean (i.e., including entrainment contribution) TKE (ebrk) ! + ! and normalized TKE (wbrk). ! + ! 3. TKE (tke) and normalized TKE (wcap) profiles at all CL interfaces. ! + ! 4. ( kvm, kvh ) profiles at all CL interfaces. ! + ! 5. ( bprod, sprod ) profiles at all CL interfaces. ! + ! Also calculate ! + ! 1. PBL height as the top external interface of surface-based CL, if any. ! + ! 2. Characteristic excesses of convective 'updraft velocity (wpert)', ! + ! 'temperature (tpert)', and 'moisture (qpert)' in the surface-based CL, ! + ! if any, for use in the separate convection scheme. ! + ! If there is no surface-based CL, 'PBL height' and 'convective excesses' are ! + ! calculated later from surface-based STL (Stable Turbulent Layer) properties.! + ! --------------------------------------------------------------------------- ! + + ktblw = 0 + do ncv = 1, ncvfin(i) + + kt = ktop(i,ncv) + kb = kbase(i,ncv) + + lwp = lwp_CL(i,ncv) + opt_depth = opt_depth_CL(i,ncv) + radinvfrac = radinvfrac_CL(i,ncv) + radf = radf_CL(i, ncv) + + ! Check whether surface interface is energetically interior or not. + if( kb .eq. (pver+1) .and. bflxs(i) .le. 0._r8 ) then + lbulk = zi(i,kt) - z(i,pver) + else + lbulk = zi(i,kt) - zi(i,kb) + end if + lbulk = min( lbulk, lbulk_max ) + + ! Calculate 'turbulent length scale (leng)' and 'normalized TKE (wcap)' + ! at all CL interfaces except the surface. Note that below 'wcap' at + ! external interfaces are not correct. However, it does not influence + ! numerical calculation and correct normalized TKE at the entraining + ! interfaces will be re-calculated at the end of this 'do ncv' loop. + + do k = min(kb,pver), kt, -1 + if( choice_tunl .eq. 'rampcl' ) then + ! In order to treat the case of 'ricl(i,ncv) >> 0' of surface-based SRCL + ! with 'bflxs(i) < 0._r8', I changed ricl(i,ncv) -> min(0._r8,ricl(i,ncv)) + ! in the below exponential. This is necessary to prevent the model crash + ! by too large values (e.g., 700) of ricl(i,ncv) + tunlramp = ctunl*tunl*(1._r8-(1._r8-1._r8/ctunl)*exp(min(0._r8,ricl(i,ncv)))) + tunlramp = min(max(tunlramp,tunl),ctunl*tunl) + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + leng(i,k) = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! leng(i,k) = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + leng(i,k) = min( vk*zi(i,k), tunlramp*lbulk ) + endif + leng(i,k) = min(leng_max(k), leng(i,k)) + wcap(i,k) = (leng(i,k)**2) * (-shcl(i,ncv)*n2(i,k)+smcl(i,ncv)*s2(i,k)) + end do ! k + + ! Calculate basic cross-interface variables ( jump condition ) across the + ! base external interface of CL. + + if( kb .lt. pver+1 ) then + + jbzm = z(i,kb-1) - z(i,kb) ! Interfacial layer thickness [m] + jbsl = sl(i,kb-1) - sl(i,kb) ! Interfacial jump of 'sl' [J/kg] + jbqt = qt(i,kb-1) - qt(i,kb) ! Interfacial jump of 'qt' [kg/kg] + jbbu = n2(i,kb) * jbzm ! Interfacial buoyancy jump [m/s2] + ! considering saturation ( > 0 ) + jbbu = max(jbbu,jbumin) ! Set minimum buoyancy jump, jbumin = 1.e-3 + jbu = u(i,kb-1) - u(i,kb) ! Interfacial jump of 'u' [m/s] + jbv = v(i,kb-1) - v(i,kb) ! Interfacial jump of 'v' [m/s] + ch = (1._r8 -sflh(i,kb-1))*chu(i,kb) + sflh(i,kb-1)*chs(i,kb) ! Buoyancy coefficient just above the base interface + cm = (1._r8 -sflh(i,kb-1))*cmu(i,kb) + sflh(i,kb-1)*cms(i,kb) ! Buoyancy coefficient just above the base interface + n2hb = (ch*jbsl + cm*jbqt)/jbzm ! Buoyancy frequency [s-2] + ! just above the base interface + vyb = n2hb*jbzm/jbbu ! Ratio of 'n2hb/n2' at 'kb' interface + vub = min(1._r8,(jbu**2+jbv**2)/(jbbu*jbzm) ) ! Ratio of 's2/n2 = 1/Ri' at 'kb' interface + + else + + ! Below setting is necessary for consistent treatment when 'kb' is at the surface. + jbbu = 0._r8 + n2hb = 0._r8 + vyb = 0._r8 + vub = 0._r8 + web = 0._r8 + + end if + + ! Calculate basic cross-interface variables ( jump condition ) across the + ! top external interface of CL. The meanings of variables are similar to + ! the ones at the base interface. + + jtzm = z(i,kt-1) - z(i,kt) + jtsl = sl(i,kt-1) - sl(i,kt) + jtqt = qt(i,kt-1) - qt(i,kt) + jtbu = n2(i,kt)*jtzm ! Note : 'jtbu' is guaranteed positive by definition of CL top. + jtbu = max(jtbu,jbumin) ! But threshold it anyway to be sure. + jtu = u(i,kt-1) - u(i,kt) + jtv = v(i,kt-1) - v(i,kt) + ch = (1._r8 -sfuh(i,kt))*chu(i,kt) + sfuh(i,kt)*chs(i,kt) + cm = (1._r8 -sfuh(i,kt))*cmu(i,kt) + sfuh(i,kt)*cms(i,kt) + n2ht = (ch*jtsl + cm*jtqt)/jtzm + vyt = n2ht*jtzm/jtbu + vut = min(1._r8,(jtu**2+jtv**2)/(jtbu*jtzm)) + + ! Evaporative enhancement factor of entrainment rate at the CL top interface, evhc. + ! We take the full inversion strength to be 'jt2slv = slv(i,kt-2)-slv(i,kt)' + ! where 'kt-1' is in the ambiguous layer. However, for a cloud-topped CL overlain + ! by another CL, it is possible that 'slv(i,kt-2) < slv(i,kt)'. To avoid negative + ! or excessive evhc, we lower-bound jt2slv and upper-bound evhc. Note 'jtslv' is + ! used only for calculating 'evhc' : when calculating entrainment rate, we will + ! use normal interfacial buoyancy jump across CL top interface. + + evhc = 1._r8 + jt2slv = 0._r8 + + ! Modification : I should check whether below 'jbumin' produces reasonable limiting value. + ! In addition, our current formulation does not consider ice contribution. + + if( choice_evhc .eq. 'orig' ) then + + if( ql(i,kt) .gt. qmin .and. ql(i,kt-1) .lt. qmin ) then + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g ) + evhc = 1._r8 + a2l * a3l * latvap * ql(i,kt) / jt2slv + evhc = min( evhc, evhcmax ) + end if + + elseif( choice_evhc .eq. 'ramp' ) then + + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g ) + evhc = 1._r8 + max(cldeff(i,kt)-cldeff(i,kt-1),0._r8) * a2l * a3l * latvap * ql(i,kt) / jt2slv + evhc = min( evhc, evhcmax ) + + elseif( choice_evhc .eq. 'maxi' ) then + + qleff = max( ql(i,kt-1), ql(i,kt) ) + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g ) + evhc = 1._r8 + a2l * a3l * latvap * qleff / jt2slv + evhc = min( evhc, evhcmax ) + + endif + + ! ------------------------------------------------------------------- ! + ! Calculate 'wstar3' by summing buoyancy productions within CL from ! + ! 1. Interior buoyancy production ( bprod: fcn of TKE ) ! + ! 2. Cloud-top radiative cooling ! + ! 3. Surface buoyancy flux contribution only when bflxs > 0. ! + ! Note that master length scale, lbulk, has already been ! + ! corrctly defined at the first part of this 'do ncv' loop ! + ! considering the sign of bflxs. ! + ! This 'wstar3' is used for calculation of entrainment rate. ! + ! Note that this 'wstar3' formula does not include shear production ! + ! and the effect of drizzle, which should be included later. ! + ! Q : Strictly speaking, in calculating interior buoyancy production, ! + ! the use of 'bprod' is not correct, since 'bprod' is not correct ! + ! value but initially guessed value. More reasonably, we should ! + ! use '-leng(i,k)*sqrt(b1*wcap(i,k))*shcl(i,ncv)*n2(i,k)' instead ! + ! of 'bprod(i,k)', although this is still an approximation since ! + ! tke(i,k) is not exactly 'b1*wcap(i,k)' due to a transport term.! + ! However since iterative calculation will be performed after all,! + ! below might also be OK. But I should test this alternative. ! + ! ------------------------------------------------------------------- ! + + dzht = zi(i,kt) - z(i,kt) ! Thickness of CL top half-layer + dzhb = z(i,kb-1) - zi(i,kb) ! Thickness of CL bot half-layer + wstar3 = radf * dzht + do k = kt + 1, kb - 1 ! If 'kt = kb - 1', this loop will not be performed. + wstar3 = wstar3 + bprod(i,k) * ( z(i,k-1) - z(i,k) ) + ! Below is an alternative which may speed up convergence. + ! However, for interfaces merged into original CL, it can + ! be 'wcap(i,k)<0' since 'n2(i,k)>0'. Thus, I should use + ! the above original one. + ! wstar3 = wstar3 - leng(i,k)*sqrt(b1*wcap(i,k))*shcl(i,ncv)*n2(i,k)* & + ! (z(i,k-1) - z(i,k)) + end do + if( kb .eq. (pver+1) .and. bflxs(i) .gt. 0._r8 ) then + wstar3 = wstar3 + bflxs(i) * dzhb + ! wstar3 = wstar3 + bprod(i,pver+1) * dzhb + end if + wstar3 = max( 2.5_r8 * wstar3, 0._r8 ) + + ! -------------------------------------------------------------- ! + ! Below single block is for 'sedimentation-entrainment feedback' ! + ! -------------------------------------------------------------- ! + + if( id_sedfact ) then + ! wsed = 7.8e5_r8*(ql(i,kt)/ncliq(i,kt))**(2._r8/3._r8) + sedfact = exp(-ased*wsedl(i,kt)/(wstar3**(1._r8/3._r8)+1.e-6_r8)) + wsed_CL(i,ncv) = wsedl(i,kt) + if( choice_evhc .eq. 'orig' ) then + if (ql(i,kt).gt.qmin .and. ql(i,kt-1).lt.qmin) then + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g) + evhc = 1._r8+sedfact*a2l*a3l*latvap*ql(i,kt) / jt2slv + evhc = min(evhc,evhcmax) + end if + elseif( choice_evhc .eq. 'ramp' ) then + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g) + evhc = 1._r8+max(cldeff(i,kt)-cldeff(i,kt-1),0._r8)*sedfact*a2l*a3l*latvap*ql(i,kt) / jt2slv + evhc = min(evhc,evhcmax) + elseif( choice_evhc .eq. 'maxi' ) then + qleff = max(ql(i,kt-1),ql(i,kt)) + jt2slv = slv(i,max(kt-2,1)) - slv(i,kt) + jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g) + evhc = 1._r8+sedfact*a2l*a3l*latvap*qleff / jt2slv + evhc = min(evhc,evhcmax) + endif + endif + + ! -------------------------------------------------------------------------- ! + ! Now diagnose CL top and bottom entrainment rates (and the contribution of ! + ! top/bottom entrainments to wstar3) using entrainment closures of the form ! + ! ! + ! wet = cet*wstar3, web = ceb*wstar3 ! + ! ! + ! where cet and ceb depend on the entrainment interface jumps, ql, etc. ! + ! No entrainment is diagnosed unless the wstar3 > 0. Note '1/wstar3fact' is ! + ! a factor indicating the enhancement of wstar3 due to entrainment process. ! + ! Q : Below setting of 'wstar3fact = max(..,0.5)'might prevent the possible ! + ! case when buoyancy consumption by entrainment is stronger than cloud ! + ! top radiative cooling production. Is that OK ? No. According to bulk ! + ! modeling study, entrainment buoyancy consumption was always a certain ! + ! fraction of other net productions, rather than a separate sum. Thus, ! + ! below max limit of wstar3fact is correct. 'wstar3fact = max(.,0.5)' ! + ! prevents unreasonable enhancement of CL entrainment rate by cloud-top ! + ! entrainment instability, CTEI. ! + ! Q : Use of the same dry entrainment coefficient, 'a1i' both at the CL top ! + ! and base interfaces may result in too small 'wstar3' and 'ebrk' below, ! + ! as was seen in my generalized bulk modeling study. This should be re- ! + ! considered later ! + ! -------------------------------------------------------------------------- ! + + if( wstar3 .gt. 0._r8 ) then + cet = a1i * evhc / ( jtbu * lbulk ) + if( kb .eq. pver + 1 ) then + wstar3fact = max( 1._r8 + 2.5_r8 * cet * n2ht * jtzm * dzht, wstar3factcrit ) + else + ceb = a1i / ( jbbu * lbulk ) + wstar3fact = max( 1._r8 + 2.5_r8 * cet * n2ht * jtzm * dzht & + + 2.5_r8 * ceb * n2hb * jbzm * dzhb, wstar3factcrit ) + end if + wstar3 = wstar3 / wstar3fact + else ! wstar3 == 0 + wstar3fact = 0._r8 ! This is just for dianostic output + cet = 0._r8 + ceb = 0._r8 + end if + + ! ---------------------------------------------------------------------------- ! + ! Calculate net CL mean TKE including entrainment contribution by solving a ! + ! canonical cubic equation. The solution of cubic equ. is 'rootp**2 = ebrk' ! + ! where 'ebrk' originally (before solving cubic eq.) was interior CL mean TKE, ! + ! but after solving cubic equation, it is replaced by net CL mean TKE in the ! + ! same variable 'ebrk'. ! + ! ---------------------------------------------------------------------------- ! + ! Solve cubic equation (canonical form for analytic solution) ! + ! r^3 - 3*trmp*r - 2*trmq = 0, r = sqrt ! + ! to estimate for CL, derived from layer-mean TKE balance: ! + ! ! + ! ^(3/2)/(b_1*) \approx (*) ! + ! = (_int * l_int + _et * dzt + _eb * dzb)/lbulk ! + ! _int = ^(1/2)/(b_1*)*_int ! + ! _et = (-vyt+vut)*wet*jtbu + radf ! + ! _eb = (-vyb+vub)*web*jbbu ! + ! ! + ! where: ! + ! <> denotes a vertical avg (over the whole CL unless indicated) ! + ! l_int (called lbrk below) is aggregate thickness of interior CL layers ! + ! dzt = zi(i,kt)-z(i,kt) is thickness of top entrainment layer ! + ! dzb = z(i,kb-1)-zi(i,kb) is thickness of bot entrainment layer ! + ! _int (called ebrk below) is the CL-mean TKE if only interior ! + ! interfaces contributed. ! + ! wet, web are top. bottom entrainment rates ! + ! ! + ! For a single-level radiatively-driven convective layer, there are no ! + ! interior interfaces so 'ebrk' = 'lbrk' = 0. If the CL goes to the ! + ! surface, 'vyb' and 'vub' are set to zero before and 'ebrk' and 'lbrk' ! + ! have already incorporated the surface interfacial layer contribution, ! + ! so the same formulas still apply. ! + ! ! + ! In the original formulation based on TKE, ! + ! wet*jtbu = a1l*evhc*^3/2/leng(i,kt) ! + ! web*jbbu = a1l*^3/2/leng(i,kt) ! + ! ! + ! In the wstar formulation ! + ! wet*jtbu = a1i*evhc*wstar3/lbulk ! + ! web*jbbu = a1i*wstar3/lbulk, ! + ! ---------------------------------------------------------------------------- ! + + fact = ( evhc * ( -vyt + vut ) * dzht + ( -vyb + vub ) * dzhb * leng(i,kb) / leng(i,kt) ) / lbulk + + if( wstarent ) then + + ! (Option 1) 'wstar' entrainment formulation + ! Here trmq can have either sign, and will usually be nonzero even for non- + ! cloud topped CLs. If trmq > 0, there will be two positive roots r; we take + ! the larger one. Why ? If necessary, we limit entrainment and wstar to prevent + ! a solution with r < ccrit*wstar ( Why ? ) where we take ccrit = 0.5. + + trma = 1._r8 + trmp = ebrk(i,ncv) * ( lbrk(i,ncv) / lbulk ) / 3._r8 + ntzero + trmq = 0.5_r8 * b1 * ( leng(i,kt) / lbulk ) * ( radf * dzht + a1i * fact * wstar3 ) + + ! Check if there is an acceptable root with r > rcrit = ccrit*wstar. + ! To do this, first find local minimum fmin of the cubic f(r) at sqrt(p), + ! and value fcrit = f(rcrit). + + rmin = sqrt(trmp) + fmin = rmin * ( rmin * rmin - 3._r8 * trmp ) - 2._r8 * trmq + wstar = wstar3**onet + rcrit = ccrit * wstar + fcrit = rcrit * ( rcrit * rcrit - 3._r8 * trmp ) - 2._r8 * trmq + + ! No acceptable root exists (noroot = .true.) if either: + ! 1) rmin < rcrit (in which case cubic is monotone increasing for r > rcrit) + ! and f(rcrit) > 0. + ! or 2) rmin > rcrit (in which case min of f(r) in r > rcrit is at rmin) + ! and f(rmin) > 0. + ! In this case, we reduce entrainment and wstar3 such that r/wstar = ccrit; + ! this changes the coefficients of the cubic. It might be informative to + ! check when and how many 'noroot' cases occur, since when 'noroot', we + ! will impose arbitrary limit on 'wstar3, wet, web, and ebrk' using ccrit. + + noroot = ( ( rmin .lt. rcrit ) .and. ( fcrit .gt. 0._r8 ) ) & + .or. ( ( rmin .ge. rcrit ) .and. ( fmin .gt. 0._r8 ) ) + if( noroot ) then ! Solve cubic for r + trma = 1._r8 - b1 * ( leng(i,kt) / lbulk ) * a1i * fact / ccrit**3 + trma = max( trma, 0.5_r8 ) ! Limit entrainment enhancement of ebrk + trmp = trmp / trma + trmq = 0.5_r8 * b1 * ( leng(i,kt) / lbulk ) * radf * dzht / trma + end if ! noroot + + ! Solve the cubic equation + + qq = trmq**2 - trmp**3 + if( qq .ge. 0._r8 ) then + rootp = ( trmq + sqrt(qq) )**(1._r8/3._r8) + ( max( trmq - sqrt(qq), 0._r8 ) )**(1._r8/3._r8) + else + rootp = 2._r8 * sqrt(trmp) * cos( acos( trmq / sqrt(trmp**3) ) / 3._r8 ) + end if + + ! Adjust 'wstar3' only if there is 'noroot'. + ! And calculate entrainment rates at the top and base interfaces. + + if( noroot ) wstar3 = ( rootp / ccrit )**3 ! Adjust wstar3 + wet = cet * wstar3 ! Find entrainment rates + if( kb .lt. pver + 1 ) web = ceb * wstar3 ! When 'kb.eq.pver+1', it was set to web=0. + + else ! + + ! (Option.2) wstarentr = .false. Use original entrainment formulation. + ! trmp > 0 if there are interior interfaces in CL, trmp = 0 otherwise. + ! trmq > 0 if there is cloudtop radiative cooling, trmq = 0 otherwise. + + trma = 1._r8 - b1 * a1l * fact + trma = max( trma, 0.5_r8 ) ! Prevents runaway entrainment instability + trmp = ebrk(i,ncv) * ( lbrk(i,ncv) / lbulk ) / ( 3._r8 * trma ) + trmq = 0.5_r8 * b1 * ( leng(i,kt) / lbulk ) * radf * dzht / trma + + qq = trmq**2 - trmp**3 + if( qq .ge. 0._r8 ) then + rootp = ( trmq + sqrt(qq) )**(1._r8/3._r8) + ( max( trmq - sqrt(qq), 0._r8 ) )**(1._r8/3._r8) + else ! Also part of case 3 + rootp = 2._r8 * sqrt(trmp) * cos( acos( trmq / sqrt(trmp**3) ) / 3._r8 ) + end if ! qq + + ! Find entrainment rates and limit them by free-entrainment values a1l*sqrt(e) + + wet = a1l * rootp * min( evhc * rootp**2 / ( leng(i,kt) * jtbu ), 1._r8 ) + if( kb .lt. pver + 1 ) web = a1l * rootp * min( evhc * rootp**2 / ( leng(i,kb) * jbbu ), 1._r8 ) + + end if ! wstarentr + + ! ---------------------------------------------------- ! + ! Finally, get the net CL mean TKE and normalized TKE ! + ! ---------------------------------------------------- ! + + ebrk(i,ncv) = rootp**2 + ebrk(i,ncv) = min(ebrk(i,ncv),tkemax) ! Limit CL-avg TKE used for entrainment + wbrk(i,ncv) = ebrk(i,ncv)/b1 + + ! The only way ebrk = 0 is for SRCL which are actually radiatively cooled + ! at top interface. In this case, we remove 'convective' label from the + ! interfaces around this layer. This case should now be impossible, so + ! we flag it. Q: I can't understand why this case is impossible now. Maybe, + ! due to various limiting procedures used in solving cubic equation ? + ! In case of SRCL, 'ebrk' should be positive due to cloud top LW radiative + ! cooling contribution, although 'ebrk(internal)' of SRCL before including + ! entrainment contribution (which include LW cooling contribution also) is + ! zero. + + if( ebrk(i,ncv) .le. 0._r8 ) then + write(temp_string,*) 'CALEDDY: Warning, CL with zero TKE, i, kt, kb ', i, kt, kb + warnstring = trim(warnstring)//temp_string + belongcv(i,kt) = .false. + belongcv(i,kb) = .false. + end if + + ! ----------------------------------------------------------------------- ! + ! Calculate complete TKE profiles at all CL interfaces, capped by tkemax. ! + ! We approximate TKE = at entrainment interfaces. However when CL is ! + ! based at surface, correct 'tkes' will be inserted to tke(i,pver+1). ! + ! Note that this approximation at CL external interfaces do not influence ! + ! numerical calculation since 'e' at external interfaces are not used in ! + ! actual numerical calculation afterward. In addition in order to extract ! + ! correct TKE averaged over the PBL in the cumulus scheme,it is necessary ! + ! to set e = at the top entrainment interface. Since net CL mean TKE ! + ! 'ebrk' obtained by solving cubic equation already includes tkes ( tkes ! + ! is included when bflxs > 0 but not when bflxs <= 0 into internal ebrk ),! + ! 'tkes' should be written to tke(i,pver+1) ! + ! ----------------------------------------------------------------------- ! + + ! 1. At internal interfaces + do k = kb - 1, kt + 1, -1 + rcap = ( b1 * ae + wcap(i,k) / wbrk(i,ncv) ) / ( b1 * ae + 1._r8 ) + rcap = min( max(rcap,rcapmin), rcapmax ) + tke(i,k) = ebrk(i,ncv) * rcap + tke(i,k) = min( tke(i,k), tkemax ) + kvh(i,k) = leng(i,k) * sqrt(tke(i,k)) * shcl(i,ncv) + kvm(i,k) = leng(i,k) * sqrt(tke(i,k)) * smcl(i,ncv) + bprod(i,k) = -kvh(i,k) * n2(i,k) + sprod(i,k) = kvm(i,k) * s2(i,k) + turbtype(i,k) = 2 ! CL interior interfaces. + sm_aw(i,k) = smcl(i,ncv)/alph1 ! Diagnostic output for microphysics + end do + + ! 2. At CL top entrainment interface + kentr = wet * jtzm + kvh(i,kt) = kentr + kvm(i,kt) = kentr + bprod(i,kt) = -kentr * n2ht + radf ! I must use 'n2ht' not 'n2' + sprod(i,kt) = kentr * s2(i,kt) + turbtype(i,kt) = 4 ! CL top entrainment interface + trmp = -b1 * ae / ( 1._r8 + b1 * ae ) + trmq = -(bprod(i,kt)+sprod(i,kt))*b1*leng(i,kt)/(1._r8+b1*ae)/(ebrk(i,ncv)**(3._r8/2._r8)) + rcap = compute_cubic(0._r8,trmp,trmq)**2._r8 + rcap = min( max(rcap,rcapmin), rcapmax ) + tke(i,kt) = ebrk(i,ncv) * rcap + tke(i,kt) = min( tke(i,kt), tkemax ) + sm_aw(i,kt) = smcl(i,ncv) / alph1 ! Diagnostic output for microphysics + + ! 3. At CL base entrainment interface and double entraining interfaces + ! When current CL base is also the top interface of CL regime below, + ! simply add the two contributions for calculating eddy diffusivity + ! and buoyancy/shear production. Below code correctly works because + ! we (CL regime index) always go from surface upward. + + if( kb .lt. pver + 1 ) then + + kentr = web * jbzm + + if( kb .ne. ktblw ) then + + kvh(i,kb) = kentr + kvm(i,kb) = kentr + bprod(i,kb) = -kvh(i,kb)*n2hb ! I must use 'n2hb' not 'n2' + sprod(i,kb) = kvm(i,kb)*s2(i,kb) + turbtype(i,kb) = 3 ! CL base entrainment interface + trmp = -b1*ae/(1._r8+b1*ae) + trmq = -(bprod(i,kb)+sprod(i,kb))*b1*leng(i,kb)/(1._r8+b1*ae)/(ebrk(i,ncv)**(3._r8/2._r8)) + rcap = compute_cubic(0._r8,trmp,trmq)**2._r8 + rcap = min( max(rcap,rcapmin), rcapmax ) + tke(i,kb) = ebrk(i,ncv) * rcap + tke(i,kb) = min( tke(i,kb),tkemax ) + + else + + kvh(i,kb) = kvh(i,kb) + kentr + kvm(i,kb) = kvm(i,kb) + kentr + ! dzhb5 : Half thickness of the lowest layer of current CL regime + ! dzht5 : Half thickness of the highest layer of adjacent CL regime just below current CL. + dzhb5 = z(i,kb-1) - zi(i,kb) + dzht5 = zi(i,kb) - z(i,kb) + bprod(i,kb) = ( dzht5*bprod(i,kb) - dzhb5*kentr*n2hb ) / ( dzhb5 + dzht5 ) + sprod(i,kb) = ( dzht5*sprod(i,kb) + dzhb5*kentr*s2(i,kb) ) / ( dzhb5 + dzht5 ) + trmp = -b1*ae/(1._r8+b1*ae) + trmq = -kentr*(s2(i,kb)-n2hb)*b1*leng(i,kb)/(1._r8+b1*ae)/(ebrk(i,ncv)**(3._r8/2._r8)) + rcap = compute_cubic(0._r8,trmp,trmq)**2._r8 + rcap = min( max(rcap,rcapmin), rcapmax ) + tke_imsi = ebrk(i,ncv) * rcap + tke_imsi = min( tke_imsi, tkemax ) + tke(i,kb) = ( dzht5*tke(i,kb) + dzhb5*tke_imsi ) / ( dzhb5 + dzht5 ) + tke(i,kb) = min(tke(i,kb),tkemax) + turbtype(i,kb) = 5 ! CL double entraining interface + + end if + + else + + ! If CL base interface is surface, compute similarly using wcap(i,kb)=tkes/b1 + ! Even when bflx < 0, use the same formula in order to impose consistency of + ! tke(i,kb) at bflx = 0._r8 + + rcap = (b1*ae + wcap(i,kb)/wbrk(i,ncv))/(b1*ae + 1._r8) + rcap = min( max(rcap,rcapmin), rcapmax ) + tke(i,kb) = ebrk(i,ncv) * rcap + tke(i,kb) = min( tke(i,kb),tkemax ) + + end if + + ! For double entraining interface, simply use smcl(i,ncv) of the overlying CL. + ! Below 'sm_aw' is a diagnostic output for use in the microphysics. + ! When 'kb' is surface, 'sm' will be over-written later below. + + sm_aw(i,kb) = smcl(i,ncv)/alph1 + + ! Calculate wcap at all interfaces of CL. Put a minimum threshold on TKE + ! to prevent possible division by zero. 'wcap' at CL internal interfaces + ! are already calculated in the first part of 'do ncv' loop correctly. + ! When 'kb.eq.pver+1', below formula produces the identical result to the + ! 'tkes(i)/b1' if leng(i,kb) is set to vk*z(i,pver). Note wcap(i,pver+1) + ! is already defined as 'tkes(i)/b1' at the first part of caleddy. + + wcap(i,kt) = (bprod(i,kt)+sprod(i,kt))*leng(i,kt)/sqrt(max(tke(i,kt),1.e-6_r8)) + if( kb .lt. pver + 1 ) then + wcap(i,kb) = (bprod(i,kb)+sprod(i,kb))*leng(i,kb)/sqrt(max(tke(i,kb),1.e-6_r8)) + end if + + ! Save the index of upper external interface of current CL-regime in order to + ! handle the case when this interface is also the lower external interface of + ! CL-regime located just above. + + ktblw = kt + + ! Diagnostic Output + + wet_CL(i,ncv) = wet + web_CL(i,ncv) = web + jtbu_CL(i,ncv) = jtbu + jbbu_CL(i,ncv) = jbbu + evhc_CL(i,ncv) = evhc + jt2slv_CL(i,ncv) = jt2slv + n2ht_CL(i,ncv) = n2ht + n2hb_CL(i,ncv) = n2hb + wstar_CL(i,ncv) = wstar + wstar3fact_CL(i,ncv) = wstar3fact + + end do ! ncv + + ! Calculate PBL height and characteristic cumulus excess for use in the + ! cumulus convection shceme. Also define turbulence type at the surface + ! when the lowest CL is based at the surface. These are just diagnostic + ! outputs, not influencing numerical calculation of current PBL scheme. + ! If the lowest CL is based at the surface, define the PBL depth as the + ! CL top interface. The same rule is applied for all CLs including SRCL. + + if( ncvsurf .gt. 0 ) then + + ktopbl(i) = ktop(i,ncvsurf) + pblh(i) = zi(i, ktopbl(i)) + pblhp(i) = pi(i, ktopbl(i)) + wpert(i) = max(wfac*sqrt(ebrk(i,ncvsurf)),wpertmin) + tpert(i) = max(abs(shflx(i)*rrho(i)/cpair)*tfac/wpert(i),0._r8) + qpert(i) = max(abs(qflx(i)*rrho(i))*tfac/wpert(i),0._r8) + + if( bflxs(i) .gt. 0._r8 ) then + turbtype(i,pver+1) = 2 ! CL interior interface + else + turbtype(i,pver+1) = 3 ! CL external base interface + endif + + ipbl(i) = 1 + kpblh(i) = max(ktopbl(i)-1, 1) + went(i) = wet_CL(i,ncvsurf) + end if ! End of the calculationf of te properties of surface-based CL. + + ! -------------------------------------------- ! + ! Treatment of Stable Turbulent Regime ( STL ) ! + ! -------------------------------------------- ! + + ! Identify top and bottom most (internal) interfaces of STL except surface. + ! Also, calculate 'turbulent length scale (leng)' at each STL interfaces. + + belongst(i,1) = .false. ! k = 1 (top interface) is assumed non-turbulent + do k = 2, pver ! k is an interface index + belongst(i,k) = ( ri(i,k) .lt. ricrit ) .and. ( .not. belongcv(i,k) ) + if( belongst(i,k) .and. ( .not. belongst(i,k-1) ) ) then + kt = k ! Top interface index of STL + elseif( .not. belongst(i,k) .and. belongst(i,k-1) ) then + kb = k - 1 ! Base interface index of STL + lbulk = z(i,kt-1) - z(i,kb) + lbulk = min( lbulk, lbulk_max ) + do ks = kt, kb + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = max( 1.e-3_r8, ctunl * tunl * exp(-log(ctunl)*ri(i,ks)/ricrit) ) + ! tunlramp = 0.065_r8 + 0.7_r8 * exp(-20._r8*ri(i,ks)) + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + leng(i,ks) = ( (vk*zi(i,ks))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! leng(i,ks) = vk*zi(i,ks) / (1._r8+vk*zi(i,ks)/(tunlramp*lbulk)) + else + leng(i,ks) = min( vk*zi(i,ks), tunlramp*lbulk ) + endif + leng(i,ks) = min(leng_max(ks), leng(i,ks)) + end do + end if + end do ! k + + ! Now look whether STL extends to ground. If STL extends to surface, + ! re-define master length scale,'lbulk' including surface interfacial + ! layer thickness, and re-calculate turbulent length scale, 'leng' at + ! all STL interfaces again. Note that surface interface is assumed to + ! always be STL if it is not CL. + + belongst(i,pver+1) = .not. belongcv(i,pver+1) + + if( belongst(i,pver+1) ) then ! kb = pver+1 (surface STL) + + turbtype(i,pver+1) = 1 ! Surface is STL interface + + if( belongst(i,pver) ) then ! STL includes interior + ! 'kt' already defined above as the top interface of STL + lbulk = z(i,kt-1) + else ! STL with no interior turbulence + kt = pver+1 + lbulk = z(i,kt-1) + end if + lbulk = min( lbulk, lbulk_max ) + + ! PBL height : Layer mid-point just above the highest STL interface + ! Note in contrast to the surface based CL regime where PBL height + ! was defined at the top external interface, PBL height of surface + ! based STL is defined as the layer mid-point. + + ktopbl(i) = kt - 1 + pblh(i) = z(i,ktopbl(i)) + pblhp(i) = 0.5_r8 * ( pi(i,ktopbl(i)) + pi(i,ktopbl(i)+1) ) + + ! Re-calculate turbulent length scale including surface interfacial + ! layer contribution to lbulk. + + do ks = kt, pver + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = max(1.e-3_r8,ctunl*tunl*exp(-log(ctunl)*ri(i,ks)/ricrit)) + ! tunlramp = 0.065_r8 + 0.7_r8 * exp(-20._r8*ri(i,ks)) + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + leng(i,ks) = ( (vk*zi(i,ks))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! leng(i,ks) = vk*zi(i,ks) / (1._r8+vk*zi(i,ks)/(tunlramp*lbulk)) + else + leng(i,ks) = min( vk*zi(i,ks), tunlramp*lbulk ) + endif + leng(i,ks) = min(leng_max(ks), leng(i,ks)) + end do ! ks + + ! Characteristic cumulus excess of surface-based STL. + ! We may be able to use ustar for wpert. + + wpert(i) = 0._r8 + tpert(i) = max(shflx(i)*rrho(i)/cpair*fak/ustar(i),0._r8) ! CCM stable-layer forms + qpert(i) = max(qflx(i)*rrho(i)*fak/ustar(i),0._r8) + + ipbl(i) = 0 + kpblh(i) = ktopbl(i) + + end if + + ! Calculate stability functions and energetics at the STL interfaces + ! except the surface. Note that tke(i,pver+1) and wcap(i,pver+1) are + ! already calculated in the first part of 'caleddy', kvm(i,pver+1) & + ! kvh(i,pver+1) were already initialized to be zero, bprod(i,pver+1) + ! & sprod(i,pver+1) were direcly calculated from the bflxs and ustar. + ! Note transport term is assumed to be negligible at STL interfaces. + + do k = 2, pver + + if( belongst(i,k) ) then + + turbtype(i,k) = 1 ! STL interfaces + trma = alph3*alph4exs*ri(i,k) + 2._r8*b1*(alph2-alph4exs*alph5*ri(i,k)) + trmb = (alph3+alph4exs)*ri(i,k) + 2._r8*b1*(-alph5*ri(i,k)+alph1) + trmc = ri(i,k) + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + ! Sanity Check + if( det .lt. 0._r8 ) then + errstring = 'The det < 0. for the STL in UW eddy_diff' + return + end if + gh = (-trmb + sqrt(det))/(2._r8*trma) + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + ! gh = min(max(gh,-3.5334_r8),0.0233_r8) + gh = min(max(gh,ghmin),0.0233_r8) + sh = max(0._r8,alph5/(1._r8+alph3*gh)) + sm = max(0._r8,(alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) + + tke(i,k) = b1*(leng(i,k)**2)*(-sh*n2(i,k)+sm*s2(i,k)) + tke(i,k) = min(tke(i,k),tkemax) + wcap(i,k) = tke(i,k)/b1 + kvh(i,k) = leng(i,k) * sqrt(tke(i,k)) * sh + kvm(i,k) = leng(i,k) * sqrt(tke(i,k)) * sm + bprod(i,k) = -kvh(i,k) * n2(i,k) + sprod(i,k) = kvm(i,k) * s2(i,k) + + sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics + + end if + + end do ! k + + ! --------------------------------------------------- ! + ! End of treatment of Stable Turbulent Regime ( STL ) ! + ! --------------------------------------------------- ! + + ! --------------------------------------------------------------- ! + ! Re-computation of eddy diffusivity at the entrainment interface ! + ! assuming that it is purely STL (00.19, ! + ! turbulent can exist at the entrainment interface since 'Sh,Sm' ! + ! do not necessarily go to zero even when Ri>0.19. Since Ri can ! + ! be fairly larger than 0.19 at the entrainment interface, I ! + ! should set minimum value of 'tke' to be 0. in order to prevent ! + ! sqrt(tke) from being imaginary. ! + ! --------------------------------------------------------------- ! + + ! goto 888 + + do k = 2, pver + + if( ( turbtype(i,k) .eq. 3 ) .or. ( turbtype(i,k) .eq. 4 ) .or. & + ( turbtype(i,k) .eq. 5 ) ) then + + trma = alph3*alph4exs*ri(i,k) + 2._r8*b1*(alph2-alph4exs*alph5*ri(i,k)) + trmb = (alph3+alph4exs)*ri(i,k) + 2._r8*b1*(-alph5*ri(i,k)+alph1) + trmc = ri(i,k) + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + gh = (-trmb + sqrt(det))/(2._r8*trma) + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + ! gh = min(max(gh,-3.5334_r8),0.0233_r8) + gh = min(max(gh,ghmin),0.0233_r8) + sh = max(0._r8,alph5/(1._r8+alph3*gh)) + sm = max(0._r8,(alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) + + lbulk = z(i,k-1) - z(i,k) + lbulk = min( lbulk, lbulk_max ) + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = max(1.e-3_r8,ctunl*tunl*exp(-log(ctunl)*ri(i,k)/ricrit)) + ! tunlramp = 0.065_r8 + 0.7_r8*exp(-20._r8*ri(i,k)) + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + leng_imsi = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! leng_imsi = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + leng_imsi = min( vk*zi(i,k), tunlramp*lbulk ) + endif + leng_imsi = min(leng_max(k), leng_imsi) + + tke_imsi = b1*(leng_imsi**2)*(-sh*n2(i,k)+sm*s2(i,k)) + tke_imsi = min(max(tke_imsi,0._r8),tkemax) + kvh_imsi = leng_imsi * sqrt(tke_imsi) * sh + kvm_imsi = leng_imsi * sqrt(tke_imsi) * sm + + if( kvh(i,k) .lt. kvh_imsi ) then + kvh(i,k) = kvh_imsi + kvm(i,k) = kvm_imsi + leng(i,k) = leng_imsi + tke(i,k) = tke_imsi + wcap(i,k) = tke_imsi / b1 + bprod(i,k) = -kvh_imsi * n2(i,k) + sprod(i,k) = kvm_imsi * s2(i,k) + sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics + turbtype(i,k) = 1 ! This was added on Dec.10.2009 for use in microphysics. + endif + + end if + + end do + + ! 888 continue + + ! ------------------------------------------------------------------ ! + ! End of recomputation of eddy diffusivity at entrainment interfaces ! + ! ------------------------------------------------------------------ ! + + ! As an option, we can impose a certain minimum back-ground diffusivity. + + ! do k = 1, pver+1 + ! kvh(i,k) = max(0.01_r8,kvh(i,k)) + ! kvm(i,k) = max(0.01_r8,kvm(i,k)) + ! enddo + + ! --------------------------------------------------------------------- ! + ! Diagnostic Output ! + ! Just for diagnostic purpose, calculate stability functions at each ! + ! interface including surface. Instead of assuming neutral stability, ! + ! explicitly calculate stability functions using an reverse procedure ! + ! starting from tkes(i) similar to the case of SRCL and SBCL in zisocl. ! + ! Note that it is possible to calculate stability functions even when ! + ! bflxs < 0. Note that this inverse method allows us to define Ri even ! + ! at the surface. Note also tkes(i) and sprod(i,pver+1) are always ! + ! positive values by limiters (e.g., ustar_min = 0.01). ! + ! Dec.12.2006 : Also just for diagnostic output, re-set ! + ! 'bprod(i,pver+1)= bflxs(i)' here. Note that this setting does not ! + ! influence numerical calculation at all - it is just for diagnostic ! + ! output. ! + ! --------------------------------------------------------------------- ! + + bprod(i,pver+1) = bflxs(i) + + gg = 0.5_r8*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._r8/2._r8)) + if( abs(alph5-gg*alph3) .le. 1.e-7_r8 ) then + ! gh = -0.28_r8 + if( bprod(i,pver+1) .gt. 0._r8 ) then + gh = -3.5334_r8 + else + gh = ghmin + endif + else + gh = gg/(alph5-gg*alph3) + end if + + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + if( bprod(i,pver+1) .gt. 0._r8 ) then + gh = min(max(gh,-3.5334_r8),0.0233_r8) + else + gh = min(max(gh,ghmin),0.0233_r8) + endif + + gh_a(i,pver+1) = gh + sh_a(i,pver+1) = max(0._r8,alph5/(1._r8+alph3*gh)) + if( bprod(i,pver+1) .gt. 0._r8 ) then + sm_a(i,pver+1) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh)) + else + sm_a(i,pver+1) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) + endif + sm_aw(i,pver+1) = sm_a(i,pver+1)/alph1 + ri_a(i,pver+1) = -(sm_a(i,pver+1)/sh_a(i,pver+1))*(bprod(i,pver+1)/sprod(i,pver+1)) + + do k = 1, pver + if( ri(i,k) .lt. 0._r8 ) then + trma = alph3*alph4*ri(i,k) + 2._r8*b1*(alph2-alph4*alph5*ri(i,k)) + trmb = (alph3+alph4)*ri(i,k) + 2._r8*b1*(-alph5*ri(i,k)+alph1) + trmc = ri(i,k) + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + gh = (-trmb + sqrt(det))/(2._r8*trma) + gh = min(max(gh,-3.5334_r8),0.0233_r8) + gh_a(i,k) = gh + sh_a(i,k) = max(0._r8,alph5/(1._r8+alph3*gh)) + sm_a(i,k) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh)) + ri_a(i,k) = ri(i,k) + else + if( ri(i,k) .gt. ricrit ) then + gh_a(i,k) = ghmin + sh_a(i,k) = 0._r8 + sm_a(i,k) = 0._r8 + ri_a(i,k) = ri(i,k) + else + trma = alph3*alph4exs*ri(i,k) + 2._r8*b1*(alph2-alph4exs*alph5*ri(i,k)) + trmb = (alph3+alph4exs)*ri(i,k) + 2._r8*b1*(-alph5*ri(i,k)+alph1) + trmc = ri(i,k) + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + gh = (-trmb + sqrt(det))/(2._r8*trma) + gh = min(max(gh,ghmin),0.0233_r8) + gh_a(i,k) = gh + sh_a(i,k) = max(0._r8,alph5/(1._r8+alph3*gh)) + sm_a(i,k) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) + ri_a(i,k) = ri(i,k) + endif + endif + + end do + + end do ! End of column index loop, i + + return + + end subroutine caleddy + + !============================================================================== ! + ! ! + !============================================================================== ! + + subroutine exacol( pcols, pver, ncol, ri, bflxs, minpblh, zi, ktop, kbase, ncvfin ) + + ! ---------------------------------------------------------------------------- ! + ! Object : Find unstable CL regimes and determine the indices ! + ! kbase, ktop which delimit these unstable layers : ! + ! ri(kbase) > 0 and ri(ktop) > 0, but ri(k) < 0 for ktop < k < kbase. ! + ! Author : Chris Bretherton 08/2000, ! + ! Sungsu Park 08/2006, 11/2008 ! + !----------------------------------------------------------------------------- ! + + implicit none + + ! --------------- ! + ! Input variables ! + ! --------------- ! + + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric vertical layers + integer, intent(in) :: ncol ! Number of atmospheric columns + + real(r8), intent(in) :: ri(pcols,pver) ! Moist gradient Richardson no. + real(r8), intent(in) :: bflxs(pcols) ! Buoyancy flux at surface + real(r8), intent(in) :: minpblh(pcols) ! Minimum PBL height based on surface stress + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface heights + + ! ---------------- ! + ! Output variables ! + ! ---------------- ! + + integer, intent(out) :: kbase(pcols,ncvmax) ! External interface index of CL base + integer, intent(out) :: ktop(pcols,ncvmax) ! External interface index of CL top + integer, intent(out) :: ncvfin(pcols) ! Total number of CLs + + ! --------------- ! + ! Local variables ! + ! --------------- ! + + integer :: i + integer :: k + integer :: ncv + real(r8) :: rimaxentr + real(r8) :: riex(pver+1) ! Column Ri profile extended to surface + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + do i = 1, ncol + ncvfin(i) = 0 + do ncv = 1, ncvmax + ktop(i,ncv) = 0 + kbase(i,ncv) = 0 + end do + end do + + ! ------------------------------------------------------ ! + ! Find CL regimes starting from the surface going upward ! + ! ------------------------------------------------------ ! + + rimaxentr = 0._r8 + + do i = 1, ncol + + riex(2:pver) = ri(i,2:pver) + + ! Below allows consistent treatment of surface and other interfaces. + ! Simply, if surface buoyancy flux is positive, Ri of surface is set to be negative. + + riex(pver+1) = rimaxentr - bflxs(i) + + ncv = 0 + k = pver + 1 ! Work upward from surface interface + + do while ( k .gt. ntop_turb + 1 ) + + ! Below means that if 'bflxs > 0' (do not contain '=' sign), surface + ! interface is energetically interior surface. + + if( riex(k) .lt. rimaxentr ) then + + ! Identify a new CL + + ncv = ncv + 1 + + ! First define 'kbase' as the first interface below the lower-most unstable interface + ! Thus, Richardson number at 'kbase' is positive. + + kbase(i,ncv) = min(k+1,pver+1) + + ! Decrement k until top unstable level + + do while( riex(k) .lt. rimaxentr .and. k .gt. ntop_turb + 1 ) + k = k - 1 + end do + + ! ktop is the first interface above upper-most unstable interface + ! Thus, Richardson number at 'ktop' is positive. + + ktop(i,ncv) = k + + else + + ! Search upward for a CL. + + k = k - 1 + + end if + + end do ! End of CL regime finding for each atmospheric column + + ncvfin(i) = ncv + + end do ! End of atmospheric column do loop + + return + + end subroutine exacol + + !============================================================================== ! + ! ! + !============================================================================== ! + + subroutine zisocl( pcols , pver , long , & + z , zi , n2 , s2 , & + bprod , sprod , bflxs, tkes , & + ncvfin , kbase , ktop , belongcv, & + ricl , ghcl , shcl , smcl , & + lbrk , wbrk , ebrk , extend , extend_up, extend_dn,& + errstring) + + !------------------------------------------------------------------------ ! + ! Object : This 'zisocl' vertically extends original CLs identified from ! + ! 'exacol' using a merging test based on either 'wint' or 'l2n2' ! + ! and identify new CL regimes. Similar to the case of 'exacol', ! + ! CL regime index increases with height. After identifying new ! + ! CL regimes ( kbase, ktop, ncvfin ),calculate CL internal mean ! + ! energetics (lbrk : energetic thickness integral, wbrk, ebrk ) ! + ! and stability functions (ricl, ghcl, shcl, smcl) by including ! + ! surface interfacial layer contribution when bflxs > 0. Note ! + ! that there are two options in the treatment of the energetics ! + ! of surface interfacial layer (use_dw_surf= 'true' or 'false') ! + ! Author : Sungsu Park 08/2006, 11/2008 ! + !------------------------------------------------------------------------ ! + + implicit none + + ! --------------- ! + ! Input variables ! + ! --------------- ! + + integer, intent(in) :: long ! Longitude of the column + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric vertical layers + real(r8), intent(in) :: z(pcols, pver) ! Layer mid-point height [ m ] + real(r8), intent(in) :: zi(pcols, pver+1) ! Interface height [ m ] + real(r8), intent(in) :: n2(pcols, pver) ! Buoyancy frequency at interfaces except surface [ s-2 ] + real(r8), intent(in) :: s2(pcols, pver) ! Shear frequency at interfaces except surface [ s-2 ] + real(r8), intent(in) :: bprod(pcols,pver+1) ! Buoyancy production [ m2/s3 ]. bprod(i,pver+1) = bflxs + real(r8), intent(in) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ]. sprod(i,pver+1) = usta**3/(vk*z(i,pver)) + real(r8), intent(in) :: bflxs(pcols) ! Surface buoyancy flux [ m2/s3 ]. bprod(i,pver+1) = bflxs + real(r8), intent(in) :: tkes(pcols) ! TKE at the surface [ s2/s2 ] + + ! ---------------------- ! + ! Input/output variables ! + ! ---------------------- ! + + integer, intent(inout) :: kbase(pcols,ncvmax) ! Base external interface index of CL + integer, intent(inout) :: ktop(pcols,ncvmax) ! Top external interface index of CL + integer, intent(inout) :: ncvfin(pcols) ! Total number of CLs + + ! ---------------- ! + ! Output variables ! + ! ---------------- ! + + logical, intent(out) :: belongcv(pcols,pver+1) ! True if interface is in a CL ( either internal or external ) + real(r8), intent(out) :: ricl(pcols,ncvmax) ! Mean Richardson number of internal CL + real(r8), intent(out) :: ghcl(pcols,ncvmax) ! Half of normalized buoyancy production of internal CL + real(r8), intent(out) :: shcl(pcols,ncvmax) ! Galperin instability function of heat-moisture of internal CL + real(r8), intent(out) :: smcl(pcols,ncvmax) ! Galperin instability function of momentum of internal CL + real(r8), intent(out) :: lbrk(pcols,ncvmax) ! Thickness of (energetically) internal CL ( lint, [m] ) + real(r8), intent(out) :: wbrk(pcols,ncvmax) ! Mean normalized TKE of internal CL [ m2/s2 ] + real(r8), intent(out) :: ebrk(pcols,ncvmax) ! Mean TKE of internal CL ( b1*wbrk, [m2/s2] ) + + character(len=*), intent(out) :: errstring + ! ------------------ ! + ! Internal variables ! + ! ------------------ ! + + logical :: extend ! True when CL is extended in zisocl + logical :: extend_up ! True when CL is extended upward in zisocl + logical :: extend_dn ! True when CL is extended downward in zisocl + logical :: bottom ! True when CL base is at surface ( kb = pver + 1 ) + + integer :: i ! Local index for the longitude + integer :: ncv ! CL Index increasing with height + integer :: incv + integer :: k + integer :: kb ! Local index for kbase + integer :: kt ! Local index for ktop + integer :: ncvinit ! Value of ncv at routine entrance + integer :: cntu ! Number of merged CLs during upward extension of individual CL + integer :: cntd ! Number of merged CLs during downward extension of individual CL + integer :: kbinc ! Index for incorporating underlying CL + integer :: ktinc ! Index for incorporating overlying CL + + real(r8) :: wint ! Normalized TKE of internal CL + real(r8) :: dwinc ! Normalized TKE of CL external interfaces + real(r8) :: dw_surf ! Normalized TKE of surface interfacial layer + real(r8) :: dzinc + real(r8) :: gh + real(r8) :: sh + real(r8) :: sm + real(r8) :: gh_surf ! Half of normalized buoyancy production in surface interfacial layer + real(r8) :: sh_surf ! Galperin instability function in surface interfacial layer + real(r8) :: sm_surf ! Galperin instability function in surface interfacial layer + real(r8) :: l2n2 ! Vertical integral of 'l^2N^2' over CL. Include thickness product + real(r8) :: l2s2 ! Vertical integral of 'l^2S^2' over CL. Include thickness product + real(r8) :: dl2n2 ! Vertical integration of 'l^2*N^2' of CL external interfaces + real(r8) :: dl2s2 ! Vertical integration of 'l^2*S^2' of CL external interfaces + real(r8) :: dl2n2_surf ! 'dl2n2' defined in the surface interfacial layer + real(r8) :: dl2s2_surf ! 'dl2s2' defined in the surface interfacial layer + real(r8) :: lint ! Thickness of (energetically) internal CL + real(r8) :: dlint ! Interfacial layer thickness of CL external interfaces + real(r8) :: dlint_surf ! Surface interfacial layer thickness + real(r8) :: lbulk ! Master Length Scale : Whole CL thickness from top to base external interface + real(r8) :: lz ! Turbulent length scale + real(r8) :: ricll ! Mean Richardson number of internal CL + real(r8) :: trma + real(r8) :: trmb + real(r8) :: trmc + real(r8) :: det + real(r8) :: zbot ! Height of CL base + real(r8) :: l2rat ! Square of ratio of actual to initial CL (not used) + real(r8) :: gg ! Intermediate variable used for calculating stability functions of SBCL + real(r8) :: tunlramp ! Ramping tunl + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + i = long + + ! Initialize main output variables + + do k = 1, ncvmax + ricl(i,k) = 0._r8 + ghcl(i,k) = 0._r8 + shcl(i,k) = 0._r8 + smcl(i,k) = 0._r8 + lbrk(i,k) = 0._r8 + wbrk(i,k) = 0._r8 + ebrk(i,k) = 0._r8 + end do + extend = .false. + extend_up = .false. + extend_dn = .false. + + ! ----------------------------------------------------------- ! + ! Loop over each CL to see if any of them need to be extended ! + ! ----------------------------------------------------------- ! + + ncv = 1 + + do while( ncv .le. ncvfin(i) ) + + ncvinit = ncv + cntu = 0 + cntd = 0 + kb = kbase(i,ncv) + kt = ktop(i,ncv) + + ! ---------------------------------------------------------------------------- ! + ! Calculation of CL interior energetics including surface before extension ! + ! ---------------------------------------------------------------------------- ! + ! Note that the contribution of interior interfaces (not surface) to 'wint' is ! + ! accounted by using '-sh*l2n2 + sm*l2s2' while the contribution of surface is ! + ! accounted by using 'dwsurf = tkes/b1' when bflxs > 0. This approach is fully ! + ! reasonable. Another possible alternative, which seems to be also consistent ! + ! is to calculate 'dl2n2_surf' and 'dl2s2_surf' of surface interfacial layer ! + ! separately, and this contribution is explicitly added by initializing 'l2n2' ! + ! 'l2s2' not by zero, but by 'dl2n2_surf' and 'ds2n2_surf' below. At the same ! + ! time, 'dwsurf' should be excluded in 'wint' calculation below. The only diff.! + ! between two approaches is that in case of the latter approach, contributions ! + ! of surface interfacial layer to the CL mean stability function (ri,gh,sh,sm) ! + ! are explicitly included while the first approach is not. In this sense, the ! + ! second approach seems to be more conceptually consistent, but currently, I ! + ! (Sungsu) will keep the first default approach. There is a switch ! + ! 'use_dw_surf' at the first part of eddy_diff.F90 chosing one of ! + ! these two options. ! + ! ---------------------------------------------------------------------------- ! + + ! ------------------------------------------------------ ! + ! Step 0: Calculate surface interfacial layer energetics ! + ! ------------------------------------------------------ ! + + lbulk = zi(i,kt) - zi(i,kb) + lbulk = min( lbulk, lbulk_max ) + dlint_surf = 0._r8 + dl2n2_surf = 0._r8 + dl2s2_surf = 0._r8 + dw_surf = 0._r8 + if( kb .eq. pver+1 ) then + + if( bflxs(i) .gt. 0._r8 ) then + + ! Calculate stability functions of surface interfacial layer + ! from the given 'bprod(i,pver+1)' and 'sprod(i,pver+1)' using + ! inverse approach. Since alph5>0 and alph3<0, denominator of + ! gg is always positive if bprod(i,pver+1)>0. + + gg = 0.5_r8*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._r8/2._r8)) + gh = gg/(alph5-gg*alph3) + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + gh = min(max(gh,-3.5334_r8),0.0233_r8) + sh = alph5/(1._r8+alph3*gh) + sm = (alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh) + ricll = min(-(sm/sh)*(bprod(i,pver+1)/sprod(i,pver+1)),ricrit) + + ! Calculate surface interfacial layer contribution to CL internal + ! energetics. By construction, 'dw_surf = -dl2n2_surf + ds2n2_surf' + ! is exactly satisfied, which corresponds to assuming turbulent + ! length scale of surface interfacial layer = vk * z(i,pver). Note + ! 'dl2n2_surf','dl2s2_surf','dw_surf' include thickness product. + + dlint_surf = z(i,pver) + dl2n2_surf = -vk*(z(i,pver)**2)*bprod(i,pver+1)/(sh*sqrt(tkes(i))) + dl2s2_surf = vk*(z(i,pver)**2)*sprod(i,pver+1)/(sm*sqrt(tkes(i))) + dw_surf = (tkes(i)/b1)*z(i,pver) + + else + + ! Note that this case can happen when surface is an external + ! interface of CL. + lbulk = zi(i,kt) - z(i,pver) + lbulk = min( lbulk, lbulk_max ) + + end if + + end if + + ! ------------------------------------------------------ ! + ! Step 1: Include surface interfacial layer contribution ! + ! ------------------------------------------------------ ! + + lint = dlint_surf + l2n2 = dl2n2_surf + l2s2 = dl2s2_surf + wint = dw_surf + if( use_dw_surf ) then + l2n2 = 0._r8 + l2s2 = 0._r8 + else + wint = 0._r8 + end if + + ! --------------------------------------------------------------------------------- ! + ! Step 2. Include the contribution of 'pure internal interfaces' other than surface ! + ! --------------------------------------------------------------------------------- ! + + if( kt .lt. kb - 1 ) then ! The case of non-SBCL. + + do k = kb - 1, kt + 1, -1 + if( choice_tunl .eq. 'rampcl' ) then + ! Modification : I simply used the average tunlramp between the two limits. + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,k), tunlramp*lbulk ) + endif + lz = min(leng_max(k), lz) + dzinc = z(i,k-1) - z(i,k) + l2n2 = l2n2 + lz*lz*n2(i,k)*dzinc + l2s2 = l2s2 + lz*lz*s2(i,k)*dzinc + lint = lint + dzinc + end do + + ! Calculate initial CL stability functions (gh,sh,sm) and net + ! internal energy of CL including surface contribution if any. + + ! Modification : It seems that below cannot be applied when ricrit > 0.19. + ! May need future generalization. + + ricll = min(l2n2/max(l2s2,ntzero),ricrit) ! Mean Ri of internal CL + trma = alph3*alph4*ricll+2._r8*b1*(alph2-alph4*alph5*ricll) + trmb = ricll*(alph3+alph4)+2._r8*b1*(-alph5*ricll+alph1) + trmc = ricll + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + gh = (-trmb + sqrt(det))/2._r8/trma + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + gh = min(max(gh,-3.5334_r8),0.0233_r8) + sh = alph5/(1._r8+alph3*gh) + sm = (alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh) + wint = wint - sh*l2n2 + sm*l2s2 + + else ! The case of SBCL + + ! If there is no pure internal interface, use only surface interfacial + ! values. However, re-set surface interfacial values such that it can + ! be used in the merging tests (either based on 'wint' or 'l2n2') and + ! in such that surface interfacial energy is not double-counted. + ! Note that regardless of the choise of 'use_dw_surf', below should be + ! kept as it is below, for consistent merging test of extending SBCL. + + lint = dlint_surf + l2n2 = dl2n2_surf + l2s2 = dl2s2_surf + wint = dw_surf + + ! Aug.29.2006 : Only for the purpose of merging test of extending SRCL + ! based on 'l2n2', re-define 'l2n2' of surface interfacial layer using + ! 'wint'. This part is designed for similar treatment of merging as in + ! the original 'eddy_diff.F90' code, where 'l2n2' of SBCL was defined + ! as 'l2n2 = - wint / sh'. Note that below block is used only when (1) + ! surface buoyancy production 'bprod(i,pver+1)' is NOT included in the + ! calculation of surface TKE in the initialization of 'bprod(i,pver+1)' + ! in the main subroutine ( even though bflxs > 0 ), and (2) to force + ! current scheme be similar to the previous scheme in the treatment of + ! extending-merging test of SBCL based on 'l2n2'. Otherwise below line + ! must be commented out. Note at this stage, correct non-zero value of + ! 'sh' has been already computed. + + if( choice_tkes .eq. 'ebprod' ) then + l2n2 = - wint / sh + endif + + endif + + ! Set consistent upper limits on 'l2n2' and 'l2s2'. Below limits are + ! reasonable since l2n2 of CL interior interface is always negative. + + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = min( l2s2, tkemax*lint/(b1*sm)) + + ! Note that at this stage, ( gh, sh, sm ) are the values of surface + ! interfacial layer if there is no pure internal interface, while if + ! there is pure internal interface, ( gh, sh, sm ) are the values of + ! pure CL interfaces or the values that include both the CL internal + ! interfaces and surface interfaces, depending on the 'use_dw_surf'. + + ! ----------------------------------------------------------------------- ! + ! Perform vertical extension-merging process ! + ! ----------------------------------------------------------------------- ! + ! During the merging process, we assumed ( lbulk, sh, sm ) of CL external ! + ! interfaces are the same as the ones of the original merging CL. This is ! + ! an inevitable approximation since we don't know ( sh, sm ) of external ! + ! interfaces at this stage. Note that current default merging test is ! + ! purely based on buoyancy production without including shear production, ! + ! since we used 'l2n2' instead of 'wint' as a merging parameter. However, ! + ! merging test based on 'wint' maybe conceptually more attractable. ! + ! Downward CL merging process is identical to the upward merging process, ! + ! but when the base of extended CL reaches to the surface, surface inter ! + ! facial layer contribution to the energetic of extended CL must be done ! + ! carefully depending on the sign of surface buoyancy flux. The contribu ! + ! tion of surface interfacial layer energetic is included to the internal ! + ! energetics of merging CL only when bflxs > 0. ! + ! ----------------------------------------------------------------------- ! + + ! ---------------------------- ! + ! Step 1. Extend the CL upward ! + ! ---------------------------- ! + + extend = .false. ! This will become .true. if CL top or base is extended + + ! Calculate contribution of potentially incorporable CL top interface + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,kt))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,kt) / (1._r8+vk*zi(i,kt)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,kt), tunlramp*lbulk ) + endif + lz = min(leng_max(kt), lz) + + dzinc = z(i,kt-1)-z(i,kt) + dl2n2 = lz*lz*n2(i,kt)*dzinc + dl2s2 = lz*lz*s2(i,kt)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + ! ------------ ! + ! Merging Test ! + ! ------------ ! + + ! The part of the below test that involves kt and z has different + ! effects based on the model top. + ! If the model top is in the stratosphere, we want the loop to + ! continue until it either completes normally, or kt is pushed to + ! the top of the model. The latter case should not happen, so this + ! causes an error. + ! If the model top is higher, as in WACCM and WACCM-X, if kt is + ! pushed close to the model top, this may not represent an error at + ! all, because of very different and more variable temperature/wind + ! profiles at the model top. Therefore we simply exit the loop early + ! and continue with no errors. + + ! do while ( dwinc .gt. ( rinc*dzinc*wint/(lint+(1._r8-rinc)*dzinc)) ) ! Merging test based on wint + ! do while ( -dl2n2 .gt. (-rinc*dzinc*l2n2/(lint+(1._r8-rinc)*dzinc)) ) ! Merging test based on l2n2 + do while ( -dl2n2 .gt. (-rinc*l2n2/(1._r8-rinc)) & ! Integral merging test + .and. (kt > ntop_turb+2 .or. z(i,kt) < 50000._r8) ) + + ! Add contribution of top external interface to interior energy. + ! Note even when we chose 'use_dw_surf='true.', the contribution + ! of surface interfacial layer to 'l2n2' and 'l2s2' are included + ! here. However it is not double counting of surface interfacial + ! energy : surface interfacial layer energy is counted in 'wint' + ! formula and 'l2n2' is just used for performing merging test in + ! this 'do while' loop. + + lint = lint + dzinc + l2n2 = l2n2 + dl2n2 + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = l2s2 + dl2s2 + wint = wint + dwinc + + ! Extend top external interface of CL upward after merging + + kt = kt - 1 + extend = .true. + extend_up = .true. + if( kt .eq. ntop_turb ) then + errstring = 'zisocl: Error: Tried to extend CL to the model top' + return + end if + + ! If the top external interface of extending CL is the same as the + ! top interior interface of the overlying CL, overlying CL will be + ! automatically merged. Then,reduce total number of CL regime by 1. + ! and increase 'cntu'(number of merged CLs during upward extension) + ! by 1. + + ktinc = kbase(i,ncv+cntu+1) - 1 ! Lowest interior interface of overlying CL + + if( kt .eq. ktinc ) then + + do k = kbase(i,ncv+cntu+1) - 1, ktop(i,ncv+cntu+1) + 1, -1 + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,k), tunlramp*lbulk ) + endif + lz = min(leng_max(k), lz) + + dzinc = z(i,k-1)-z(i,k) + dl2n2 = lz*lz*n2(i,k)*dzinc + dl2s2 = lz*lz*s2(i,k)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + lint = lint + dzinc + l2n2 = l2n2 + dl2n2 + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = l2s2 + dl2s2 + wint = wint + dwinc + + end do + + kt = ktop(i,ncv+cntu+1) + ncvfin(i) = ncvfin(i) - 1 + cntu = cntu + 1 + + end if + + ! Again, calculate the contribution of potentially incorporatable CL + ! top external interface of CL regime. + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,kt))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,kt) / (1._r8+vk*zi(i,kt)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,kt), tunlramp*lbulk ) + endif + lz = min(leng_max(kt), lz) + + dzinc = z(i,kt-1)-z(i,kt) + dl2n2 = lz*lz*n2(i,kt)*dzinc + dl2s2 = lz*lz*s2(i,kt)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + end do ! End of upward merging test 'do while' loop + + ! Update CL interface indices appropriately if any CL was merged. + ! Note that below only updated the interface index of merged CL, + ! not the original merging CL. Updates of 'kbase' and 'ktop' of + ! the original merging CL will be done after finishing downward + ! extension also later. + + if( cntu .gt. 0 ) then + do incv = 1, ncvfin(i) - ncv + kbase(i,ncv+incv) = kbase(i,ncv+cntu+incv) + ktop(i,ncv+incv) = ktop(i,ncv+cntu+incv) + end do + end if + + ! ------------------------------ ! + ! Step 2. Extend the CL downward ! + ! ------------------------------ ! + + if( kb .ne. pver + 1 ) then + + ! Calculate contribution of potentially incorporable CL base interface + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,kb))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,kb) / (1._r8+vk*zi(i,kb)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,kb), tunlramp*lbulk ) + endif + lz = min(leng_max(kb), lz) + + dzinc = z(i,kb-1)-z(i,kb) + dl2n2 = lz*lz*n2(i,kb)*dzinc + dl2s2 = lz*lz*s2(i,kb)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + ! ------------ ! + ! Merging test ! + ! ------------ ! + + ! In the below merging tests, I must keep '.and.(kb.ne.pver+1)', + ! since 'kb' is continuously updated within the 'do while' loop + ! whenever CL base is merged. + + ! do while( ( dwinc .gt. ( rinc*dzinc*wint/(lint+(1._r8-rinc)*dzinc)) ) & ! Merging test based on wint + ! do while( ( -dl2n2 .gt. (-rinc*dzinc*l2n2/(lint+(1._r8-rinc)*dzinc)) ) & ! Merging test based on l2n2 + ! .and.(kb.ne.pver+1)) + do while( ( -dl2n2 .gt. (-rinc*l2n2/(1._r8-rinc)) ) & ! Integral merging test + .and.(kb.ne.pver+1)) + + ! Add contributions from interfacial layer kb to CL interior + + lint = lint + dzinc + l2n2 = l2n2 + dl2n2 + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = l2s2 + dl2s2 + wint = wint + dwinc + + ! Extend the base external interface of CL downward after merging + + kb = kb + 1 + extend = .true. + extend_dn = .true. + + ! If the base external interface of extending CL is the same as the + ! base interior interface of the underlying CL, underlying CL will + ! be automatically merged. Then, reduce total number of CL by 1. + ! For a consistent treatment with 'upward' extension, I should use + ! 'kbinc = kbase(i,ncv-1) - 1' instead of 'ktop(i,ncv-1) + 1' below. + ! However, it seems that these two methods produce the same results. + ! Note also that in contrast to upward merging, the decrease of ncv + ! should be performed here. + ! Note that below formula correctly works even when upperlying CL + ! regime incorporates below SBCL. + + kbinc = 0 + if( ncv .gt. 1 ) kbinc = ktop(i,ncv-1) + 1 + if( kb .eq. kbinc ) then + + do k = ktop(i,ncv-1) + 1, kbase(i,ncv-1) - 1 + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,k), tunlramp*lbulk ) + endif + lz = min(leng_max(k), lz) + + dzinc = z(i,k-1)-z(i,k) + dl2n2 = lz*lz*n2(i,k)*dzinc + dl2s2 = lz*lz*s2(i,k)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + lint = lint + dzinc + l2n2 = l2n2 + dl2n2 + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = l2s2 + dl2s2 + wint = wint + dwinc + + end do + + ! We are incorporating interior of CL ncv-1, so merge + ! this CL into the current CL. + + kb = kbase(i,ncv-1) + ncv = ncv - 1 + ncvfin(i) = ncvfin(i) -1 + cntd = cntd + 1 + + end if + + ! Calculate the contribution of potentially incorporatable CL + ! base external interface. Calculate separately when the base + ! of extended CL is surface and non-surface. + + if( kb .eq. pver + 1 ) then + + if( bflxs(i) .gt. 0._r8 ) then + ! Calculate stability functions of surface interfacial layer + gg = 0.5_r8*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._r8/2._r8)) + gh_surf = gg/(alph5-gg*alph3) + ! gh_surf = min(max(gh_surf,-0.28_r8),0.0233_r8) + gh_surf = min(max(gh_surf,-3.5334_r8),0.0233_r8) + sh_surf = alph5/(1._r8+alph3*gh_surf) + sm_surf = (alph1 + alph2*gh_surf)/(1._r8+alph3*gh_surf)/(1._r8+alph4*gh_surf) + ! Calculate surface interfacial layer contribution. By construction, + ! it exactly becomes 'dw_surf = -dl2n2_surf + ds2n2_surf' + dlint_surf = z(i,pver) + dl2n2_surf = -vk*(z(i,pver)**2._r8)*bprod(i,pver+1)/(sh_surf*sqrt(tkes(i))) + dl2s2_surf = vk*(z(i,pver)**2._r8)*sprod(i,pver+1)/(sm_surf*sqrt(tkes(i))) + dw_surf = (tkes(i)/b1)*z(i,pver) + else + dlint_surf = 0._r8 + dl2n2_surf = 0._r8 + dl2s2_surf = 0._r8 + dw_surf = 0._r8 + end if + ! If (kb.eq.pver+1), updating of CL internal energetics should be + ! performed here inside of 'do while' loop, since 'do while' loop + ! contains the constraint of '.and.(kb.ne.pver+1)',so updating of + ! CL internal energetics cannot be performed within this do while + ! loop when kb.eq.pver+1. Even though I updated all 'l2n2','l2s2', + ! 'wint' below, only the updated 'wint' is used in the following + ! numerical calculation. + lint = lint + dlint_surf + l2n2 = l2n2 + dl2n2_surf + l2n2 = -min(-l2n2, tkemax*lint/(b1*sh)) + l2s2 = l2s2 + dl2s2_surf + wint = wint + dw_surf + + else + + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,kb))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,kb) / (1._r8+vk*zi(i,kb)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,kb), tunlramp*lbulk ) + endif + lz = min(leng_max(kb), lz) + + dzinc = z(i,kb-1)-z(i,kb) + dl2n2 = lz*lz*n2(i,kb)*dzinc + dl2s2 = lz*lz*s2(i,kb)*dzinc + dwinc = -sh*dl2n2 + sm*dl2s2 + + end if + + end do ! End of merging test 'do while' loop + + if( (kb.eq.pver+1) .and. (ncv.ne.1) ) then + errstring = 'Major mistake zisocl: the CL based at surface is not indexed 1' + return + end if + + end if ! Done with bottom extension of CL + + ! Update CL interface indices appropriately if any CL was merged. + ! Note that below only updated the interface index of merged CL, + ! not the original merging CL. Updates of 'kbase' and 'ktop' of + ! the original merging CL will be done later below. I should + ! check in detail if below index updating is correct or not. + + if( cntd .gt. 0 ) then + do incv = 1, ncvfin(i) - ncv + kbase(i,ncv+incv) = kbase(i,ncvinit+incv) + ktop(i,ncv+incv) = ktop(i,ncvinit+incv) + end do + end if + + ! Sanity check for positive wint. + + if( wint .lt. 0.01_r8 ) then + wint = 0.01_r8 + end if + + ! -------------------------------------------------------------------------- ! + ! Finally update CL mean internal energetics including surface contribution ! + ! after finishing all the CL extension-merging process. As mentioned above, ! + ! there are two possible ways in the treatment of surface interfacial layer, ! + ! either through 'dw_surf' or 'dl2n2_surf and dl2s2_surf' by setting logical ! + ! variable 'use_dw_surf' =.true. or .false. In any cases, we should avoid ! + ! double counting of surface interfacial layer and one single consistent way ! + ! should be used throughout the program. ! + ! -------------------------------------------------------------------------- ! + + if( extend ) then + + ktop(i,ncv) = kt + kbase(i,ncv) = kb + + ! ------------------------------------------------------ ! + ! Step 1: Include surface interfacial layer contribution ! + ! ------------------------------------------------------ ! + + lbulk = zi(i,kt) - zi(i,kb) + lbulk = min( lbulk, lbulk_max ) + dlint_surf = 0._r8 + dl2n2_surf = 0._r8 + dl2s2_surf = 0._r8 + dw_surf = 0._r8 + if( kb .eq. pver + 1 ) then + if( bflxs(i) .gt. 0._r8 ) then + ! Calculate stability functions of surface interfacial layer + gg = 0.5_r8*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._r8/2._r8)) + gh = gg/(alph5-gg*alph3) + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + gh = min(max(gh,-3.5334_r8),0.0233_r8) + sh = alph5/(1._r8+alph3*gh) + sm = (alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh) + ! Calculate surface interfacial layer contribution. By construction, + ! it exactly becomes 'dw_surf = -dl2n2_surf + ds2n2_surf' + dlint_surf = z(i,pver) + dl2n2_surf = -vk*(z(i,pver)**2._r8)*bprod(i,pver+1)/(sh*sqrt(tkes(i))) + dl2s2_surf = vk*(z(i,pver)**2._r8)*sprod(i,pver+1)/(sm*sqrt(tkes(i))) + dw_surf = (tkes(i)/b1)*z(i,pver) + else + lbulk = zi(i,kt) - z(i,pver) + lbulk = min( lbulk, lbulk_max ) + end if + end if + lint = dlint_surf + l2n2 = dl2n2_surf + l2s2 = dl2s2_surf + wint = dw_surf + if( use_dw_surf ) then + l2n2 = 0._r8 + l2s2 = 0._r8 + else + wint = 0._r8 + end if + + ! -------------------------------------------------------------- ! + ! Step 2. Include the contribution of 'pure internal interfaces' ! + ! -------------------------------------------------------------- ! + + do k = kt + 1, kb - 1 + if( choice_tunl .eq. 'rampcl' ) then + tunlramp = 0.5_r8*(1._r8+ctunl)*tunl + elseif( choice_tunl .eq. 'rampsl' ) then + tunlramp = ctunl*tunl + ! tunlramp = 0.765_r8 + else + tunlramp = tunl + endif + if( choice_leng .eq. 'origin' ) then + lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._r8/cleng) + ! lz = vk*zi(i,k) / (1._r8+vk*zi(i,k)/(tunlramp*lbulk)) + else + lz = min( vk*zi(i,k), tunlramp*lbulk ) + endif + lz = min(leng_max(k), lz) + dzinc = z(i,k-1) - z(i,k) + lint = lint + dzinc + l2n2 = l2n2 + lz*lz*n2(i,k)*dzinc + l2s2 = l2s2 + lz*lz*s2(i,k)*dzinc + end do + + ricll = min(l2n2/max(l2s2,ntzero),ricrit) + trma = alph3*alph4*ricll+2._r8*b1*(alph2-alph4*alph5*ricll) + trmb = ricll*(alph3+alph4)+2._r8*b1*(-alph5*ricll+alph1) + trmc = ricll + det = max(trmb*trmb-4._r8*trma*trmc,0._r8) + gh = (-trmb + sqrt(det))/2._r8/trma + ! gh = min(max(gh,-0.28_r8),0.0233_r8) + gh = min(max(gh,-3.5334_r8),0.0233_r8) + sh = alph5 / (1._r8+alph3*gh) + sm = (alph1 + alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4*gh) + ! Even though the 'wint' after finishing merging was positive, it is + ! possible that re-calculated 'wint' here is negative. In this case, + ! correct 'wint' to be a small positive number + wint = max( wint - sh*l2n2 + sm*l2s2, 0.01_r8 ) + + end if + + ! ---------------------------------------------------------------------- ! + ! Calculate final output variables of each CL (either has merged or not) ! + ! ---------------------------------------------------------------------- ! + + lbrk(i,ncv) = lint + wbrk(i,ncv) = wint/lint + ebrk(i,ncv) = b1*wbrk(i,ncv) + ebrk(i,ncv) = min(ebrk(i,ncv),tkemax) + ricl(i,ncv) = ricll + ghcl(i,ncv) = gh + shcl(i,ncv) = sh + smcl(i,ncv) = sm + + ! Increment counter for next CL. I should check if the increament of 'ncv' + ! below is reasonable or not, since whenever CL is merged during downward + ! extension process, 'ncv' is lowered down continuously within 'do' loop. + ! But it seems that below 'ncv = ncv + 1' is perfectly correct. + + ncv = ncv + 1 + + end do ! End of loop over each CL regime, ncv. + + ! ---------------------------------------------------------- ! + ! Re-initialize external interface indices which are not CLs ! + ! ---------------------------------------------------------- ! + + do ncv = ncvfin(i) + 1, ncvmax + ktop(i,ncv) = 0 + kbase(i,ncv) = 0 + end do + + ! ------------------------------------------------ ! + ! Update CL interface identifiers, 'belongcv' ! + ! CL external interfaces are also identified as CL ! + ! ------------------------------------------------ ! + + do k = 1, pver + 1 + belongcv(i,k) = .false. + end do + + do ncv = 1, ncvfin(i) + do k = ktop(i,ncv), kbase(i,ncv) + belongcv(i,k) = .true. + end do + end do + + return + + end subroutine zisocl + + real(r8) function compute_cubic(a,b,c) + ! ------------------------------------------------------------------------- ! + ! Solve canonical cubic : x^3 + a*x^2 + b*x + c = 0, x = sqrt(e)/sqrt() ! + ! Set x = max(xmin,x) at the end ! + ! ------------------------------------------------------------------------- ! + implicit none + real(r8), intent(in) :: a, b, c + real(r8) qq, rr, dd, theta, aa, bb, x1, x2, x3 + real(r8), parameter :: xmin = 1.e-2_r8 + + qq = (a**2-3._r8*b)/9._r8 + rr = (2._r8*a**3 - 9._r8*a*b + 27._r8*c)/54._r8 + + dd = rr**2 - qq**3 + if( dd .le. 0._r8 ) then + theta = acos(rr/qq**(3._r8/2._r8)) + x1 = -2._r8*sqrt(qq)*cos(theta/3._r8) - a/3._r8 + x2 = -2._r8*sqrt(qq)*cos((theta+2._r8*3.141592_r8)/3._r8) - a/3._r8 + x3 = -2._r8*sqrt(qq)*cos((theta-2._r8*3.141592_r8)/3._r8) - a/3._r8 + compute_cubic = max(max(max(x1,x2),x3),xmin) + return + else + if( rr .ge. 0._r8 ) then + aa = -(sqrt(rr**2-qq**3)+rr)**(1._r8/3._r8) + else + aa = (sqrt(rr**2-qq**3)-rr)**(1._r8/3._r8) + endif + if( aa .eq. 0._r8 ) then + bb = 0._r8 + else + bb = qq/aa + endif + compute_cubic = max((aa+bb)-a/3._r8,xmin) + return + endif + + return + end function compute_cubic + +END MODULE eddy_diff diff --git a/src/physics/cam/eddy_diff_cam.F90 b/src/physics/cam/eddy_diff_cam.F90 new file mode 100644 index 0000000000..fa0d6053d6 --- /dev/null +++ b/src/physics/cam/eddy_diff_cam.F90 @@ -0,0 +1,955 @@ +module eddy_diff_cam + +use shr_kind_mod, only: i4 => shr_kind_i4, r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use physconst, only: gravit, cpair, rair, zvir, latvap, latice, karman +use diffusion_solver, only: vdiff_selector +use eddy_diff, only: ncvmax +use time_manager, only: is_first_step +use physics_buffer, only: physics_buffer_desc +use spmd_utils, only: masterproc +use phys_control, only: phys_getopts + +implicit none +private + +public :: eddy_diff_readnl +public :: eddy_diff_register +public :: eddy_diff_init +public :: eddy_diff_tend + +! Is UNICON switched on (and thus interacting with eddy_diff via pbuf)? +logical :: unicon_is_on + +! Number of iterations for solution +integer, parameter :: nturb = 5 + +! Logical switches for moist mixing ratio diffusion +type(vdiff_selector) :: fieldlist_wet +! Logical switches for molecular diffusion +! (Molecular diffusion is not done here.) +type(vdiff_selector) :: fieldlist_molec + +integer :: ntop_eddy, nbot_eddy + +! Cloud mass constituent indices +integer :: ixcldliq, ixcldice + +! input pbuf field indices +integer :: qrl_idx = -1 +integer :: wsedl_idx = -1 + +! output pbuf field indices for UNICON +integer :: bprod_idx = -1 +integer :: ipbl_idx = -1 +integer :: kpblh_idx = -1 +integer :: wstarPBL_idx = -1 +integer :: tkes_idx = -1 +integer :: went_idx = -1 + +! Mixing lengths squared. +! Used for computing free air diffusivity. +real(r8) :: ml2(pver+1) + +! Various namelist options to limit or tweak the effects of eddy diffusion. + +! Pressure defining the bottom of the upper atmosphere for kvh scaling (Pa) +real(r8) :: kv_top_pressure = 0._r8 +! Eddy diffusivity scale factor for upper atmosphere +real(r8) :: kv_top_scale = 1._r8 +! Eddy diffusivity scale factor for the free troposphere +real(r8) :: kv_freetrop_scale = 1._r8 + +! The following all have to be set in all cases. +real(r8), parameter :: unset_r8 = huge(1._r8) +! Maximum master length for diag_TKE +real(r8) :: eddy_lbulk_max = unset_r8 +! Maximum dissipation length for diag_TKE +real(r8) :: eddy_leng_max = unset_r8 +! Bottom pressure level (hPa) for eddy_leng_max +real(r8) :: eddy_max_bot_pressure = unset_r8 +! Moist entrainment enhancement param +real(r8) :: eddy_moist_entrain_a2l = unset_r8 + +contains + +subroutine eddy_diff_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterprocid, mpi_real8, mpicom + use shr_log_mod, only: errMsg => shr_log_errMsg + + ! filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! file unit and error code + integer :: unitn, ierr + + character(len=*), parameter :: subname = 'eddy_diff_readnl' + + namelist /eddy_diff_nl/ kv_top_pressure, kv_top_scale, & + kv_freetrop_scale, eddy_lbulk_max, eddy_leng_max, & + eddy_max_bot_pressure, eddy_moist_entrain_a2l + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'eddy_diff_nl', status=ierr) + if (ierr == 0) then + read(unitn, eddy_diff_nl, iostat=ierr) + end if + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(kv_top_pressure, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(kv_top_scale, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(kv_freetrop_scale, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + + call mpi_bcast(eddy_lbulk_max, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(eddy_leng_max, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(eddy_max_bot_pressure, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(eddy_moist_entrain_a2l, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + +end subroutine eddy_diff_readnl + +subroutine eddy_diff_register() + use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4 + + character(len=16) :: shallow_scheme + + ! Check for UNICON and add relevant pbuf entries. + call phys_getopts(shallow_scheme_out=shallow_scheme) + + unicon_is_on = (shallow_scheme == "UNICON") + + if (unicon_is_on) then + call pbuf_add_field('bprod', 'global', dtype_r8, (/pcols,pverp/), bprod_idx) + call pbuf_add_field('ipbl', 'global', dtype_i4, (/pcols/), ipbl_idx) + call pbuf_add_field('kpblh', 'global', dtype_i4, (/pcols/), kpblh_idx) + call pbuf_add_field('wstarPBL', 'global', dtype_r8, (/pcols/), wstarPBL_idx) + call pbuf_add_field('tkes', 'global', dtype_r8, (/pcols/), tkes_idx) + call pbuf_add_field('went', 'global', dtype_r8, (/pcols/), went_idx) + end if + +end subroutine eddy_diff_register + +subroutine eddy_diff_init(pbuf2d, ntop_eddy_in, nbot_eddy_in) + + use error_messages, only: handle_errmsg + use cam_history, only: addfld, add_default, horiz_only + use constituents, only: cnst_get_ind + use ref_pres, only: pref_mid + use diffusion_solver, only: new_fieldlist_vdiff, vdiff_select + use eddy_diff, only: init_eddy_diff + use physics_buffer, only: pbuf_set_field, pbuf_get_index + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Physics buffer + integer, intent(in) :: ntop_eddy_in ! Top interface level to which eddy vertical diffusivity is applied ( = 1 ) + integer, intent(in) :: nbot_eddy_in ! Bottom interface level to which eddy vertical diffusivity is applied ( = pver ) + + character(len=128) :: errstring + + real(r8) :: leng_max(pver) + integer :: k + + logical :: history_amwg + + ntop_eddy = ntop_eddy_in + nbot_eddy = nbot_eddy_in + + do k = 1, pver + if (pref_mid(k) <= eddy_max_bot_pressure*1.e2_r8) then + leng_max(k) = eddy_leng_max + else + leng_max(k) = 40.e3_r8 + end if + end do + + if (masterproc) then + write(iulog,*)'init_eddy_diff: nturb=',nturb + write(iulog,*)'init_eddy_diff: eddy_leng_max=',eddy_leng_max,' lbulk_max=',eddy_lbulk_max + do k = 1,pver + write(iulog,*)'init_eddy_diff:',k,pref_mid(k),'leng_max=',leng_max(k) + end do + end if + + call init_eddy_diff(pver, gravit, cpair, rair, zvir, & + latvap, latice, ntop_eddy, nbot_eddy, karman, & + eddy_lbulk_max, leng_max, & + eddy_moist_entrain_a2l, errstring) + + call handle_errmsg(errstring, subname="init_eddy_diff") + + ! Set the square of the mixing lengths. + ml2(1:ntop_eddy) = 0._r8 + do k = ntop_eddy + 1, nbot_eddy + ml2(k) = 30.0_r8**2 + end do + ml2(nbot_eddy+1:pver+1) = 0._r8 + + ! Get fieldlists to pass to diffusion solver. + fieldlist_wet = new_fieldlist_vdiff(1) + fieldlist_molec = new_fieldlist_vdiff(1) + + call handle_errmsg(vdiff_select(fieldlist_wet,'s'), & + subname="vdiff_select") + call handle_errmsg(vdiff_select(fieldlist_wet,'q',1), & + subname="vdiff_select") + call handle_errmsg(vdiff_select(fieldlist_wet,'u'), & + subname="vdiff_select") + call handle_errmsg(vdiff_select(fieldlist_wet,'v'), & + subname="vdiff_select") + + ! Cloud mass constituents + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + ! Input pbuf fields + qrl_idx = pbuf_get_index('QRL') + wsedl_idx = pbuf_get_index('WSEDL') + + ! Initialize output pbuf fields + if (is_first_step() .and. unicon_is_on) then + call pbuf_set_field(pbuf2d, bprod_idx, 1.0e-5_r8) + call pbuf_set_field(pbuf2d, ipbl_idx, 0 ) + call pbuf_set_field(pbuf2d, kpblh_idx, 1 ) + call pbuf_set_field(pbuf2d, wstarPBL_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, tkes_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, went_idx, 0.0_r8) + end if + + ! Scheme-specific default output. + call phys_getopts(history_amwg_out=history_amwg) + + call addfld('WGUSTD', horiz_only, 'A', 'm/s', 'wind gusts from turbulence' ) + if (history_amwg) then + call add_default( 'WGUSTD ', 1, ' ' ) + end if + + ! ------------------------------------------------------------------- ! + ! Writing outputs for detailed analysis of UW moist turbulence scheme ! + ! ------------------------------------------------------------------- ! + + call addfld( 'BPROD', ['ilev'], 'A', 'm2/s3', 'Buoyancy Production' ) + call addfld( 'SFI', ['ilev'], 'A', '1', 'Interface-layer sat frac' ) + call addfld( 'SPROD', ['ilev'], 'A', 'm2/s3', 'Shear Production' ) + + + call addfld('UW_errorPBL',horiz_only,'A', 'm2/s', 'Error function of UW PBL') + call addfld('UW_n2', ['lev'], 'A', 's-2', 'Buoyancy Frequency, LI') + call addfld('UW_s2', ['lev'], 'A', 's-2', 'Shear Frequency, LI') + call addfld('UW_ri', ['lev'], 'A', '1', 'Interface Richardson Number, I') + call addfld('UW_sfuh', ['lev'], 'A', '1', 'Upper-Half Saturation Fraction, L') + call addfld('UW_sflh', ['lev'], 'A', '1', 'Lower-Half Saturation Fraction, L') + call addfld('UW_sfi', ['ilev'], 'A', '1', 'Interface Saturation Fraction, I') + call addfld('UW_cldn', ['lev'], 'A', '1', 'Cloud Fraction, L') + call addfld('UW_qrl', ['lev'], 'A', 'gravity W/m2', 'LW cooling rate, L') + call addfld('UW_ql', ['lev'], 'A', 'kg/kg', 'ql(LWC), L') + call addfld('UW_chu', ['ilev'], 'A', 'gravity kg/J', 'Buoyancy Coefficient, chu, I') + call addfld('UW_chs', ['ilev'], 'A', 'gravity kg/J', 'Buoyancy Coefficient, chs, I') + call addfld('UW_cmu', ['ilev'], 'A','gravity/kg/kg', 'Buoyancy Coefficient, cmu, I') + call addfld('UW_cms', ['ilev'], 'A','gravity/kg/kg', 'Buoyancy Coefficient, cms, I') + call addfld('UW_tke', ['ilev'], 'A', 'm2/s2', 'TKE, I') + call addfld('UW_wcap', ['ilev'], 'A', 'm2/s2', 'Wcap, I') + call addfld('UW_bprod', ['ilev'], 'A', 'm2/s3', 'Buoyancy production, I') + call addfld('UW_sprod', ['ilev'], 'A', 'm2/s3', 'Shear production, I') + call addfld('UW_kvh', ['ilev'], 'A', 'm2/s', 'Eddy diffusivity of heat, I') + call addfld('UW_kvm', ['ilev'], 'A', 'm2/s', 'Eddy diffusivity of uv, I') + call addfld('UW_pblh', horiz_only, 'A', 'm', 'PBLH, 1') + call addfld('UW_pblhp', horiz_only, 'A', 'Pa', 'PBLH pressure, 1') + call addfld('UW_tpert', horiz_only, 'A', 'K', 'Convective T excess, 1') + call addfld('UW_qpert', horiz_only, 'A', 'kg/kg', 'Convective qt excess, I') + call addfld('UW_wpert', horiz_only, 'A', 'm/s', 'Convective W excess, I') + call addfld('UW_ustar', horiz_only, 'A', 'm/s', 'Surface Frictional Velocity, 1') + call addfld('UW_tkes', horiz_only, 'A', 'm2/s2', 'Surface TKE, 1') + call addfld('UW_minpblh',horiz_only, 'A', 'm', 'Minimum PBLH, 1') + call addfld('UW_turbtype', ['ilev'], 'A', '1', 'Interface Turbulence Type, I') + call addfld('UW_kbase_o', ['lev'], 'A', '1', 'Initial CL Base Exterbal Interface Index, CL') + call addfld('UW_ktop_o', ['lev'], 'A', '1', 'Initial Top Exterbal Interface Index, CL') + call addfld('UW_ncvfin_o',horiz_only,'A', '1', 'Initial Total Number of CL regimes, CL') + call addfld('UW_kbase_mg', ['lev'], 'A', '1', 'kbase after merging, CL') + call addfld('UW_ktop_mg', ['lev'], 'A', '1', 'ktop after merging, CL') + call addfld('UW_ncvfin_mg',horiz_only,'A', '1', 'ncvfin after merging, CL') + call addfld('UW_kbase_f', ['lev'], 'A', '1', 'Final kbase with SRCL, CL') + call addfld('UW_ktop_f', ['lev'], 'A', '1', 'Final ktop with SRCL, CL') + call addfld('UW_ncvfin_f',horiz_only,'A', '1', 'Final ncvfin with SRCL, CL') + call addfld('UW_wet', ['lev'], 'A', 'm/s', 'Entrainment rate at CL top, CL') + call addfld('UW_web', ['lev'], 'A', 'm/s', 'Entrainment rate at CL base, CL') + call addfld('UW_jtbu', ['lev'], 'A', 'm/s2', 'Buoyancy jump across CL top, CL') + call addfld('UW_jbbu', ['lev'], 'A', 'm/s2', 'Buoyancy jump across CL base, CL') + call addfld('UW_evhc', ['lev'], 'A', '1', 'Evaporative enhancement factor, CL') + call addfld('UW_jt2slv', ['lev'], 'A', 'J/kg', 'slv jump for evhc, CL') + call addfld('UW_n2ht', ['lev'], 'A', 's-2', 'n2 at just below CL top interface, CL') + call addfld('UW_n2hb', ['lev'], 'A', 's-2', 'n2 at just above CL base interface') + call addfld('UW_lwp', ['lev'], 'A', 'kg/m2', 'LWP in the CL top layer, CL') + call addfld('UW_optdepth', ['lev'], 'A', '1', 'Optical depth of the CL top layer, CL') + call addfld('UW_radfrac', ['lev'], 'A', '1', 'Fraction of radiative cooling confined in the CL top') + call addfld('UW_radf', ['lev'], 'A', 'm2/s3', 'Buoyancy production at the CL top by radf, I') + call addfld('UW_wstar', ['lev'], 'A', 'm/s', 'Convective velocity, Wstar, CL') + call addfld('UW_wstar3fact',['lev'], 'A', '1', 'Enhancement of wstar3 due to entrainment, CL') + call addfld('UW_ebrk', ['lev'], 'A', 'm2/s2', 'CL-averaged TKE, CL') + call addfld('UW_wbrk', ['lev'], 'A', 'm2/s2', 'CL-averaged W, CL') + call addfld('UW_lbrk', ['lev'], 'A', 'm', 'CL internal thickness, CL') + call addfld('UW_ricl', ['lev'], 'A', '1', 'CL-averaged Ri, CL') + call addfld('UW_ghcl', ['lev'], 'A', '1', 'CL-averaged gh, CL') + call addfld('UW_shcl', ['lev'], 'A', '1', 'CL-averaged sh, CL') + call addfld('UW_smcl', ['lev'], 'A', '1', 'CL-averaged sm, CL') + call addfld('UW_gh', ['ilev'], 'A', '1', 'gh at all interfaces, I') + call addfld('UW_sh', ['ilev'], 'A', '1', 'sh at all interfaces, I') + call addfld('UW_sm', ['ilev'], 'A', '1', 'sm at all interfaces, I') + call addfld('UW_ria', ['ilev'], 'A', '1', 'ri at all interfaces, I') + call addfld('UW_leng', ['ilev'], 'A', 'm/s', 'Turbulence length scale, I') + ! For sedimentation-entrainment feedback analysis + call addfld('UW_wsed', ['lev'], 'A', 'm/s', 'Sedimentation velocity at CL top, CL') + +end subroutine eddy_diff_init + +subroutine eddy_diff_tend(state, pbuf, cam_in, & + ztodt, p, tint, rhoi, cldn, wstarent, & + kvm_in, kvh_in, ksrftms, dragblj,tauresx, tauresy, & + rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & + tke, sprod, sfi, turbtype, sm_aw) + + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use coords_1d, only: Coords1D + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: ztodt + type(Coords1D), intent(in) :: p + real(r8), intent(in) :: tint(pcols,pver+1) + real(r8), intent(in) :: rhoi(pcols,pver+1) + real(r8), intent(in) :: cldn(pcols,pver) + logical, intent(in) :: wstarent + real(r8), intent(in) :: kvm_in(pcols,pver+1) + real(r8), intent(in) :: kvh_in(pcols,pver+1) + real(r8), intent(in) :: ksrftms(pcols) + real(r8), intent(in) :: dragblj(pcols,pver) ! Drag profile from Beljaars SGO form drag [ 1/s ] + real(r8), intent(inout) :: tauresx(pcols) + real(r8), intent(inout) :: tauresy(pcols) + real(r8), intent(out) :: rrho(pcols) + real(r8), intent(out) :: ustar(pcols) + real(r8), intent(out) :: pblh(pcols) + real(r8), intent(out) :: kvm(pcols,pver+1) + real(r8), intent(out) :: kvh(pcols,pver+1) + real(r8), intent(out) :: kvq(pcols,pver+1) + real(r8), intent(out) :: cgh(pcols,pver+1) + real(r8), intent(out) :: cgs(pcols,pver+1) + real(r8), intent(out) :: tpert(pcols) + real(r8), intent(out) :: qpert(pcols) + real(r8), intent(out) :: tke(pcols,pver+1) + real(r8), intent(out) :: sprod(pcols,pver+1) + real(r8), intent(out) :: sfi(pcols,pver+1) + integer(i4), intent(out) :: turbtype(pcols,pver+1) + real(r8), intent(out) :: sm_aw(pcols,pver+1) + + integer :: i, k + + call compute_eddy_diff( pbuf, state%lchnk , & + pcols , pver , state%ncol , state%t , tint, state%q(:,:,1) , ztodt , & + state%q(:,:,ixcldliq) , state%q(:,:,ixcldice) , & + state%s , p , rhoi, cldn , & + state%zm , state%zi , state%pmid , state%pint , state%u , state%v , & + cam_in%wsx, cam_in%wsy , cam_in%shf , cam_in%cflx(:,1) , wstarent , & + rrho , ustar , pblh , kvm_in , kvh_in , kvm , & + kvh , kvq , cgh , & + cgs , tpert , qpert , tke , & + sprod , sfi , & + tauresx , tauresy , ksrftms , dragblj , turbtype , sm_aw ) + + ! The diffusivities from diag_TKE can be much larger than from HB in the free + ! troposphere and upper atmosphere. These seem to be larger than observations, + ! and in WACCM the gw_drag code is already applying an eddy diffusivity in the + ! upper atmosphere. Optionally, adjust the diffusivities in the free troposphere + ! or the upper atmosphere. + ! + ! NOTE: Further investigation should be done as to why the diffusivities are + ! larger in diag_TKE. + if ((kv_freetrop_scale /= 1._r8) .or. ((kv_top_scale /= 1._r8) .and. (kv_top_pressure > 0._r8))) then + do i = 1, state%ncol + do k = 1, pverp + ! Outside of the boundary layer? + if (state%zi(i,k) > pblh(i)) then + ! In the upper atmosphere? + if (state%pint(i,k) <= kv_top_pressure) then + kvh(i,k) = kvh(i,k) * kv_top_scale + kvm(i,k) = kvm(i,k) * kv_top_scale + kvq(i,k) = kvq(i,k) * kv_top_scale + else + kvh(i,k) = kvh(i,k) * kv_freetrop_scale + kvm(i,k) = kvm(i,k) * kv_freetrop_scale + kvq(i,k) = kvq(i,k) * kv_freetrop_scale + end if + else + exit + end if + end do + end do + end if + +end subroutine eddy_diff_tend + +!=============================================================================== ! +! ! +!=============================================================================== ! + +subroutine compute_eddy_diff( pbuf, lchnk , & + pcols , pver , ncol , t , tint, qv , ztodt , & + ql , qi , s , p , rhoi, cldn , & + z , zi , pmid , pi , u , v , & + taux , tauy , shflx , qflx , wstarent , rrho , & + ustar , pblh , kvm_in , kvh_in , kvm_out , kvh_out , kvq , & + cgh , cgs , tpert , qpert , tke , & + sprod , sfi , & + tauresx, tauresy, ksrftms, dragblj, turbtype, sm_aw ) + + !-------------------------------------------------------------------- ! + ! Purpose: Interface to compute eddy diffusivities. ! + ! Eddy diffusivities are calculated in a fully implicit way ! + ! through iteration process. ! + ! Author: Sungsu Park. August. 2006. ! + ! May. 2008. ! + !-------------------------------------------------------------------- ! + + use diffusion_solver, only: compute_vdiff + use cam_history, only: outfld + use phys_debug_util, only: phys_debug_col + use physconst, only: cpairv + use pbl_utils, only: calc_ustar, austausch_atm + use error_messages, only: handle_errmsg + use coords_1d, only: Coords1D + use wv_saturation, only: qsat + use eddy_diff, only: trbintd, caleddy + use physics_buffer, only: pbuf_get_field + + ! --------------- ! + ! Input Variables ! + ! --------------- ! + + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + integer, intent(in) :: lchnk + integer, intent(in) :: pcols ! Number of atmospheric columns [ # ] + integer, intent(in) :: pver ! Number of atmospheric layers [ # ] + integer, intent(in) :: ncol ! Number of atmospheric columns [ # ] + logical, intent(in) :: wstarent ! .true. means use the 'wstar' entrainment closure. + real(r8), intent(in) :: ztodt ! Physics integration time step 2 delta-t [ s ] + real(r8), intent(in) :: t(pcols,pver) ! Temperature [ K ] + real(r8), intent(in) :: tint(pcols,pver+1) ! Temperature defined on interfaces [ K ] + real(r8), intent(in) :: qv(pcols,pver) ! Water vapor specific humidity [ kg/kg ] + real(r8), intent(in) :: ql(pcols,pver) ! Liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: qi(pcols,pver) ! Ice specific humidity [ kg/kg ] + real(r8), intent(in) :: s(pcols,pver) ! Dry static energy [ J/kg ] + type(Coords1D), intent(in) :: p ! Pressure coordinates for solver [ Pa ] + real(r8), intent(in) :: rhoi(pcols,pver+1) ! Density at interfaces [ kg/m3 ] + real(r8), intent(in) :: cldn(pcols,pver) ! Stratiform cloud fraction [ fraction ] + real(r8), intent(in) :: z(pcols,pver) ! Layer mid-point height above surface [ m ] + real(r8), intent(in) :: zi(pcols,pver+1) ! Interface height above surface [ m ] + real(r8), intent(in) :: pmid(pcols,pver) ! Layer mid-point pressure [ Pa ] + real(r8), intent(in) :: pi(pcols,pver+1) ! Interface pressure [ Pa ] + real(r8), intent(in) :: u(pcols,pver) ! Zonal velocity [ m/s ] + real(r8), intent(in) :: v(pcols,pver) ! Meridional velocity [ m/s ] + real(r8), intent(in) :: taux(pcols) ! Zonal wind stress at surface [ N/m2 ] + real(r8), intent(in) :: tauy(pcols) ! Meridional wind stress at surface [ N/m2 ] + real(r8), intent(in) :: shflx(pcols) ! Sensible heat flux at surface [ unit ? ] + real(r8), intent(in) :: qflx(pcols) ! Water vapor flux at surface [ unit ? ] + real(r8), intent(in) :: kvm_in(pcols,pver+1) ! kvm saved from last timestep [ m2/s ] + real(r8), intent(in) :: kvh_in(pcols,pver+1) ! kvh saved from last timestep [ m2/s ] + real(r8), intent(in) :: ksrftms(pcols) ! Surface drag coefficient of turbulent mountain stress [ unit ? ] + real(r8), intent(in) :: dragblj(pcols,pver) ! Drag profile from Beljaars SGO form drag [ 1/s ] + + ! ---------------- ! + ! Output Variables ! + ! ---------------- ! + + real(r8), intent(out) :: kvm_out(pcols,pver+1) ! Eddy diffusivity for momentum [ m2/s ] + real(r8), intent(out) :: kvh_out(pcols,pver+1) ! Eddy diffusivity for heat [ m2/s ] + real(r8), intent(out) :: kvq(pcols,pver+1) ! Eddy diffusivity for constituents, moisture and tracers [ m2/s ] + ! (note not having '_out') + real(r8), intent(out) :: rrho(pcols) ! Reciprocal of density at the lowest layer + real(r8), intent(out) :: ustar(pcols) ! Surface friction velocity [ m/s ] + real(r8), intent(out) :: pblh(pcols) ! PBL top height [ m ] + real(r8), intent(out) :: cgh(pcols,pver+1) ! Counter-gradient term for heat [ J/kg/m ] + real(r8), intent(out) :: cgs(pcols,pver+1) ! Counter-gradient star [ cg/flux ] + real(r8), intent(out) :: tpert(pcols) ! Convective temperature excess [ K ] + real(r8), intent(out) :: qpert(pcols) ! Convective humidity excess [ kg/kg ] + real(r8), intent(out) :: tke(pcols,pver+1) ! Turbulent kinetic energy [ m2/s2 ] + real(r8), intent(out) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ] + real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] + integer(i4), intent(out):: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] + real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Normalized Galperin instability function for momentum [ no unit ] + ! This is 1 when neutral condition (Ri=0), + ! 4.964 for maximum unstable case, and 0 when Ri > Ricrit=0.19. + + ! ---------------------- ! + ! Input-Output Variables ! + ! ---------------------- ! + + real(r8), intent(inout) :: tauresx(pcols) ! Residual stress to be added in vdiff to correct for turb + real(r8), intent(inout) :: tauresy(pcols) ! Stress mismatch between sfc and atm accumulated in prior timesteps + + ! -------------- ! + ! pbuf Variables ! + ! -------------- ! + + real(r8), pointer :: qrl(:,:) ! LW radiative cooling rate + real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity + ! of stratiform liquid cloud droplet [ m/s ] + + real(r8), pointer :: bprod(:,:) ! Buoyancy production of tke [ m2/s3 ] + integer(i4), pointer :: ipbl(:) ! If 1, PBL is CL, while if 0, PBL is STL. + integer(i4), pointer :: kpblh(:) ! Layer index containing PBL top within or at the base interface + real(r8), pointer :: wstarPBL(:) ! Convective velocity within PBL [ m/s ] + real(r8), pointer :: tkes(:) ! TKE at surface interface [ m2/s2 ] + real(r8), pointer :: went(:) ! Entrainment rate at the PBL top interface [ m/s ] + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer icol + integer i, k, iturb, status + + character(2048) :: warnstring ! Warning(s) to print + character(128) :: errstring ! Error message + + real(r8) :: kvf(pcols,pver+1) ! Free atmospheric eddy diffusivity [ m2/s ] + real(r8) :: kvm(pcols,pver+1) ! Eddy diffusivity for momentum [ m2/s ] + real(r8) :: kvh(pcols,pver+1) ! Eddy diffusivity for heat [ m2/s ] + real(r8) :: kvm_preo(pcols,pver+1) ! Eddy diffusivity for momentum [ m2/s ] + real(r8) :: kvh_preo(pcols,pver+1) ! Eddy diffusivity for heat [ m2/s ] + real(r8) :: kvm_pre(pcols,pver+1) ! Eddy diffusivity for momentum [ m2/s ] + real(r8) :: kvh_pre(pcols,pver+1) ! Eddy diffusivity for heat [ m2/s ] + real(r8) :: errorPBL(pcols) ! Error function showing whether PBL produced convergent solution or not. + ! [ unit ? ] + real(r8) :: s2(pcols,pver) ! Shear squared, defined at interfaces except surface [ s-2 ] + real(r8) :: n2(pcols,pver) ! Buoyancy frequency, defined at interfaces except surface [ s-2 ] + real(r8) :: ri(pcols,pver) ! Richardson number, 'n2/s2', defined at interfaces except surface [ s-2 ] + real(r8) :: pblhp(pcols) ! PBL top pressure [ Pa ] + real(r8) :: minpblh(pcols) ! Minimum PBL height based on surface stress + + real(r8) :: qt(pcols,pver) ! Total specific humidity [ kg/kg ] + real(r8) :: sfuh(pcols,pver) ! Saturation fraction in upper half-layer [ fraction ] + real(r8) :: sflh(pcols,pver) ! Saturation fraction in lower half-layer [ fraction ] + real(r8) :: sl(pcols,pver) ! Liquid water static energy [ J/kg ] + real(r8) :: slv(pcols,pver) ! Liquid water virtual static energy [ J/kg ] + real(r8) :: slslope(pcols,pver) ! Slope of 'sl' in each layer + real(r8) :: qtslope(pcols,pver) ! Slope of 'qt' in each layer + real(r8) :: qvfd(pcols,pver) ! Specific humidity for diffusion [ kg/kg ] + real(r8) :: tfd(pcols,pver) ! Temperature for diffusion [ K ] + real(r8) :: slfd(pcols,pver) ! Liquid static energy [ J/kg ] + real(r8) :: qtfd(pcols,pver) ! Total specific humidity [ kg/kg ] + real(r8) :: qlfd(pcols,pver) ! Liquid water specific humidity for diffusion [ kg/kg ] + real(r8) :: ufd(pcols,pver) ! U-wind for diffusion [ m/s ] + real(r8) :: vfd(pcols,pver) ! V-wind for diffusion [ m/s ] + + ! Buoyancy coefficients : w'b' = ch * w'sl' + cm * w'qt' + + real(r8) :: chu(pcols,pver+1) ! Heat buoyancy coef for dry states, defined at each interface, finally. + real(r8) :: chs(pcols,pver+1) ! Heat buoyancy coef for sat states, defined at each interface, finally. + real(r8) :: cmu(pcols,pver+1) ! Moisture buoyancy coef for dry states, + ! defined at each interface, finally. + real(r8) :: cms(pcols,pver+1) ! Moisture buoyancy coef for sat states, + ! defined at each interface, finally. + + real(r8) :: jnk1d(pcols) + real(r8) :: jnk2d(pcols,pver+1) + real(r8) :: zero(pcols) + real(r8) :: zero2d(pcols,pver+1) + real(r8) :: es ! Saturation vapor pressure + real(r8) :: qs ! Saturation specific humidity + real(r8) :: ep2, templ, temps + + ! ------------------------------- ! + ! Variables for diagnostic output ! + ! ------------------------------- ! + + real(r8) :: wpert(pcols) ! Turbulent velocity excess [ m/s ] + + real(r8) :: kbase_o(pcols,ncvmax) ! Original external base interface index of CL from 'exacol' + real(r8) :: ktop_o(pcols,ncvmax) ! Original external top interface index of CL from 'exacol' + real(r8) :: ncvfin_o(pcols) ! Original number of CLs from 'exacol' + real(r8) :: kbase_mg(pcols,ncvmax) ! 'kbase' after extending-merging from 'zisocl' + real(r8) :: ktop_mg(pcols,ncvmax) ! 'ktop' after extending-merging from 'zisocl' + real(r8) :: ncvfin_mg(pcols) ! 'ncvfin' after extending-merging from 'zisocl' + real(r8) :: kbase_f(pcols,ncvmax) ! Final 'kbase' after extending-merging & including SRCL + real(r8) :: ktop_f(pcols,ncvmax) ! Final 'ktop' after extending-merging & including SRCL + real(r8) :: ncvfin_f(pcols) ! Final 'ncvfin' after extending-merging & including SRCL + real(r8) :: wet(pcols,ncvmax) ! Entrainment rate at the CL top [ m/s ] + real(r8) :: web(pcols,ncvmax) ! Entrainment rate at the CL base [ m/s ]. + ! Set to zero if CL is based at surface. + real(r8) :: jtbu(pcols,ncvmax) ! Buoyancy jump across the CL top [ m/s2 ] + real(r8) :: jbbu(pcols,ncvmax) ! Buoyancy jump across the CL base [ m/s2 ] + real(r8) :: evhc(pcols,ncvmax) ! Evaporative enhancement factor at the CL top + real(r8) :: jt2slv(pcols,ncvmax) ! Jump of slv ( across two layers ) at CL top used only for evhc [ J/kg ] + real(r8) :: n2ht(pcols,ncvmax) ! n2 defined at the CL top interface but using + ! sfuh(kt) instead of sfi(kt) [ s-2 ] + real(r8) :: n2hb(pcols,ncvmax) ! n2 defined at the CL base interface but using + ! sflh(kb-1) instead of sfi(kb) [ s-2 ] + real(r8) :: lwp(pcols,ncvmax) ! LWP in the CL top layer [ kg/m2 ] + real(r8) :: opt_depth(pcols,ncvmax) ! Optical depth of the CL top layer + real(r8) :: radinvfrac(pcols,ncvmax) ! Fraction of radiative cooling confined in the top portion of CL top layer + real(r8) :: radf(pcols,ncvmax) ! Buoyancy production at the CL top due to LW radiative cooling [ m2/s3 ] + real(r8) :: wstar(pcols,ncvmax) ! Convective velocity in each CL [ m/s ] + real(r8) :: wstar3fact(pcols,ncvmax) ! Enhancement of 'wstar3' due to entrainment (inverse) [ no unit ] + real(r8) :: ebrk(pcols,ncvmax) ! Net mean TKE of CL including entrainment effect [ m2/s2 ] + real(r8) :: wbrk(pcols,ncvmax) ! Net mean normalized TKE (W) of CL, + ! 'ebrk/b1' including entrainment effect [ m2/s2 ] + real(r8) :: lbrk(pcols,ncvmax) ! Energetic internal thickness of CL [m] + real(r8) :: ricl(pcols,ncvmax) ! CL internal mean Richardson number + real(r8) :: ghcl(pcols,ncvmax) ! Half of normalized buoyancy production of CL + real(r8) :: shcl(pcols,ncvmax) ! Galperin instability function of heat-moisture of CL + real(r8) :: smcl(pcols,ncvmax) ! Galperin instability function of mementum of CL + real(r8) :: ghi(pcols,pver+1) ! Half of normalized buoyancy production at all interfaces + real(r8) :: shi(pcols,pver+1) ! Galperin instability function of heat-moisture at all interfaces + real(r8) :: smi(pcols,pver+1) ! Galperin instability function of heat-moisture at all interfaces + real(r8) :: rii(pcols,pver+1) ! Interfacial Richardson number defined at all interfaces + real(r8) :: lengi(pcols,pver+1) ! Turbulence length scale at all interfaces [ m ] + real(r8) :: wcap(pcols,pver+1) ! Normalized TKE at all interfaces [ m2/s2 ] + ! For sedimentation-entrainment feedback + real(r8) :: wsed(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] + + ! ---------- ! + ! Parameters ! + ! ---------- ! + + logical, parameter :: use_kvf = .false. ! .true. (.false.) : initialize kvh/kvm = kvf ( 0. ) + real(r8), parameter :: lambda = 0.5_r8 ! Under-relaxation factor ( 0 < lambda =< 1 ) + + ! ---------- ! + ! Initialize ! + ! ---------- ! + + zero(:) = 0._r8 + zero2d(:,:) = 0._r8 + + ! ---------------------------------------------- ! + ! Get LW radiative heating out of physics buffer ! + ! ---------------------------------------------- ! + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, wsedl_idx, wsedl) + + ! These fields are put into the pbuf for UNICON only. + if (unicon_is_on) then + call pbuf_get_field(pbuf, bprod_idx, bprod) + call pbuf_get_field(pbuf, ipbl_idx, ipbl) + call pbuf_get_field(pbuf, kpblh_idx, kpblh) + call pbuf_get_field(pbuf, wstarPBL_idx, wstarPBL) + call pbuf_get_field(pbuf, tkes_idx, tkes) + call pbuf_get_field(pbuf, went_idx, went) + else + allocate(bprod(pcols,pverp), ipbl(pcols), kpblh(pcols), wstarPBL(pcols), tkes(pcols), went(pcols)) + end if + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + ufd(:ncol,:) = u(:ncol,:) + vfd(:ncol,:) = v(:ncol,:) + tfd(:ncol,:) = t(:ncol,:) + qvfd(:ncol,:) = qv(:ncol,:) + qlfd(:ncol,:) = ql(:ncol,:) + + do iturb = 1, nturb + + ! Total stress includes 'tms'. + ! Here, in computing 'tms', we can use either iteratively changed 'ufd,vfd' or the + ! initially given 'u,v' to the PBL scheme. Note that normal stress, 'taux, tauy' + ! are not changed by iteration. In order to treat 'tms' in a fully implicit way, + ! I am using updated wind, here. + + ! Compute ustar + call calc_ustar( ncol, tfd(:ncol,pver), pmid(:ncol,pver), & + taux(:ncol) - ksrftms(:ncol) * ufd(:ncol,pver), & ! Zonal wind stress + tauy(:ncol) - ksrftms(:ncol) * vfd(:ncol,pver), & ! Meridional wind stress + rrho(:ncol), ustar(:ncol)) + minpblh(:ncol) = 100.0_r8 * ustar(:ncol) ! By construction, 'minpblh' is larger than 1 [m] when 'ustar_min = 0.01'. + + ! Calculate (qt,sl,n2,s2,ri) from a given set of (t,qv,ql,qi,u,v) + + call trbintd( & + pcols , pver , ncol , z , ufd , vfd , tfd , pmid , & + s2 , n2 , ri , zi , pi , cldn , qtfd , qvfd , & + qlfd , qi , sfi , sfuh , sflh , slfd , slv , slslope , & + qtslope , chs , chu , cms , cmu ) + + ! Save initial (i.e., before iterative diffusion) profile of (qt,sl) at each iteration. + ! Only necessary for (qt,sl) not (u,v) because (qt,sl) are newly calculated variables. + + if( iturb == 1 ) then + qt(:ncol,:) = qtfd(:ncol,:) + sl(:ncol,:) = slfd(:ncol,:) + endif + + ! Get free atmosphere exchange coefficients. This 'kvf' is not used in UW moist PBL scheme + if (use_kvf) then + call austausch_atm(pcols, ncol, pver, ntop_eddy, nbot_eddy, & + ml2, ri, s2, kvf ) + else + kvf = 0._r8 + end if + + ! Initialize kvh/kvm to send to caleddy, depending on model timestep and iteration number + ! This is necessary for 'wstar-based' entrainment closure. + + if( iturb == 1 ) then + if( is_first_step() ) then + ! First iteration of first model timestep : Use free tropospheric value or zero. + kvh(:ncol,:) = kvf(:ncol,:) + kvm(:ncol,:) = kvf(:ncol,:) + else + ! First iteration on any model timestep except the first : Use value from previous timestep + kvh(:ncol,:) = kvh_in(:ncol,:) + kvm(:ncol,:) = kvm_in(:ncol,:) + endif + else + ! Not the first iteration : Use from previous iteration + kvh(:ncol,:) = kvh_out(:ncol,:) + kvm(:ncol,:) = kvm_out(:ncol,:) + endif + + ! Calculate eddy diffusivity (kvh_out,kvm_out) and (tke,bprod,sprod) using + ! a given (kvh,kvm) which are used only for initializing (bprod,sprod) at + ! the first part of caleddy. (bprod,sprod) are fully updated at the end of + ! caleddy after calculating (kvh_out,kvm_out) + + call caleddy( pcols , pver , ncol , & + slfd , qtfd , qlfd , slv ,ufd , & + vfd , pi , z , zi , & + qflx , shflx , slslope , qtslope , & + chu , chs , cmu , cms ,sfuh , & + sflh , n2 , s2 , ri ,rrho , & + pblh , ustar , & + kvh , kvm , kvh_out , kvm_out , & + tpert , qpert , qrl , kvf , tke , & + wstarent , bprod , sprod , minpblh , wpert , & + tkes , went , turbtype , sm_aw , & + kbase_o , ktop_o , ncvfin_o , & + kbase_mg , ktop_mg , ncvfin_mg , & + kbase_f , ktop_f , ncvfin_f , & + wet , web , jtbu , jbbu , & + evhc , jt2slv , n2ht , n2hb , & + lwp , opt_depth , radinvfrac, radf , & + wstar , wstar3fact, & + ebrk , wbrk , lbrk , ricl , ghcl , & + shcl , smcl , ghi , shi , smi , & + rii , lengi , wcap , pblhp , cldn , & + ipbl , kpblh , wsedl , wsed, & + warnstring, errstring) + + if (trim(warnstring) /= "") then + write(iulog,*) "eddy_diff_cam: Messages from caleddy follow." + write(iulog,*) warnstring + end if + + call handle_errmsg(errstring, subname="caleddy") + + ! Calculate errorPBL to check whether PBL produced convergent solutions or not. + + if( iturb == nturb ) then + do i = 1, ncol + errorPBL(i) = 0._r8 + do k = 1, pver + errorPBL(i) = errorPBL(i) + ( kvh(i,k) - kvh_out(i,k) )**2 + end do + errorPBL(i) = sqrt(errorPBL(i)/pver) + end do + end if + + ! Eddy diffusivities which will be used for the initialization of (bprod, + ! sprod) in 'caleddy' at the next iteration step. + + if( iturb > 1 .and. iturb < nturb ) then + kvm_out(:ncol,:) = lambda * kvm_out(:ncol,:) + ( 1._r8 - lambda ) * kvm(:ncol,:) + kvh_out(:ncol,:) = lambda * kvh_out(:ncol,:) + ( 1._r8 - lambda ) * kvh(:ncol,:) + endif + + ! Set nonlocal terms to zero for flux diagnostics, since not used by caleddy. + + cgh(:ncol,:) = 0._r8 + cgs(:ncol,:) = 0._r8 + + if( iturb < nturb ) then + + ! Each time we diffuse the original state + + slfd(:ncol,:) = sl(:ncol,:) + qtfd(:ncol,:) = qt(:ncol,:) + ufd(:ncol,:) = u(:ncol,:) + vfd(:ncol,:) = v(:ncol,:) + + ! Diffuse initial profile of each time step using a given (kvh_out,kvm_out) + ! In the below 'compute_vdiff', (slfd,qtfd,ufd,vfd) are 'inout' variables. + + call compute_vdiff( lchnk , & + pcols , pver , 1 , ncol , tint, & + p , t , rhoi, ztodt , taux , & + tauy , shflx , qflx , & + kvh_out , kvm_out , kvh_out , cgs , cgh , & + zi , ksrftms , dragblj , & + zero , fieldlist_wet, fieldlist_molec, & + ufd , vfd , qtfd , slfd , & + jnk1d , jnk1d , jnk2d , jnk1d , errstring , & + tauresx , tauresy , 0 , cpairv(:,:,lchnk), zero, & + .false., .false. ) + + call handle_errmsg(errstring, subname="compute_vdiff", & + extra_msg="compute_vdiff called from eddy_diff_cam") + + ! Retrieve (tfd,qvfd,qlfd) from (slfd,qtfd) in order to + ! use 'trbintd' at the next iteration. + + do k = 1, pver + do i = 1, ncol + ! ----------------------------------------------------- ! + ! Compute the condensate 'qlfd' in the updated profiles ! + ! ----------------------------------------------------- ! + ! Option.1 : Assume grid-mean condensate is homogeneously diffused by the moist turbulence scheme. + ! This should be used if 'pseudodiff = .false.' in vertical_diffusion.F90. + ! Modification : Need to be check whether below is correct in the presence of ice, qi. + ! I should understand why the variation of ice, qi is neglected during diffusion. + templ = ( slfd(i,k) - gravit*z(i,k) ) / cpair + call qsat( templ, pmid(i,k), es, qs) + ep2 = .622_r8 + temps = templ + ( qtfd(i,k) - qs ) / ( cpair / latvap + latvap * qs / ( rair * templ**2 ) ) + call qsat( temps, pmid(i,k), es, qs) + qlfd(i,k) = max( qtfd(i,k) - qi(i,k) - qs ,0._r8 ) + ! Option.2 : Assume condensate is not diffused by the moist turbulence scheme. + ! This should bs used if 'pseudodiff = .true.' in vertical_diffusion.F90. + ! qlfd(i,k) = ql(i,k) + ! ----------------------------- ! + ! Compute the other 'qvfd, tfd' ! + ! ----------------------------- ! + qvfd(i,k) = max( 0._r8, qtfd(i,k) - qi(i,k) - qlfd(i,k) ) + tfd(i,k) = ( slfd(i,k) + latvap * qlfd(i,k) + (latvap+latice) * qi(i,k) - gravit*z(i,k)) / cpair + end do + end do + endif + + end do ! End of 'iturb' iteration + + kvq(:ncol,:) = kvh_out(:ncol,:) + + ! Compute 'wstar' within the PBL for use in the future convection scheme. + + do i = 1, ncol + if(ipbl(i) == 1) then + wstarPBL(i) = max( 0._r8, wstar(i,1) ) + else + wstarPBL(i) = 0._r8 + endif + end do + + ! --------------------------------------------------------------- ! + ! Writing for detailed diagnostic analysis of UW moist PBL scheme ! + ! --------------------------------------------------------------- ! + + call outfld( 'WGUSTD' , wpert, pcols, lchnk ) + + call outfld( 'BPROD ', bprod, pcols, lchnk ) + call outfld( 'SPROD ', sprod, pcols, lchnk ) + call outfld( 'SFI ', sfi, pcols, lchnk ) + + call outfld( 'UW_errorPBL', errorPBL, pcols, lchnk ) + + call outfld( 'UW_n2', n2, pcols, lchnk ) + call outfld( 'UW_s2', s2, pcols, lchnk ) + call outfld( 'UW_ri', ri, pcols, lchnk ) + + call outfld( 'UW_sfuh', sfuh, pcols, lchnk ) + call outfld( 'UW_sflh', sflh, pcols, lchnk ) + call outfld( 'UW_sfi', sfi, pcols, lchnk ) + + call outfld( 'UW_cldn', cldn, pcols, lchnk ) + call outfld( 'UW_qrl', qrl, pcols, lchnk ) + call outfld( 'UW_ql', qlfd, pcols, lchnk ) + + call outfld( 'UW_chu', chu, pcols, lchnk ) + call outfld( 'UW_chs', chs, pcols, lchnk ) + call outfld( 'UW_cmu', cmu, pcols, lchnk ) + call outfld( 'UW_cms', cms, pcols, lchnk ) + + call outfld( 'UW_tke', tke, pcols, lchnk ) + call outfld( 'UW_wcap', wcap, pcols, lchnk ) + call outfld( 'UW_bprod', bprod, pcols, lchnk ) + call outfld( 'UW_sprod', sprod, pcols, lchnk ) + + call outfld( 'UW_kvh', kvh_out, pcols, lchnk ) + call outfld( 'UW_kvm', kvm_out, pcols, lchnk ) + + call outfld( 'UW_pblh', pblh, pcols, lchnk ) + call outfld( 'UW_pblhp', pblhp, pcols, lchnk ) + call outfld( 'UW_tpert', tpert, pcols, lchnk ) + call outfld( 'UW_qpert', qpert, pcols, lchnk ) + call outfld( 'UW_wpert', wpert, pcols, lchnk ) + + call outfld( 'UW_ustar', ustar, pcols, lchnk ) + call outfld( 'UW_tkes', tkes, pcols, lchnk ) + call outfld( 'UW_minpblh', minpblh, pcols, lchnk ) + + call outfld( 'UW_turbtype', real(turbtype,r8), pcols, lchnk ) + + call outfld( 'UW_kbase_o', kbase_o, pcols, lchnk ) + call outfld( 'UW_ktop_o', ktop_o, pcols, lchnk ) + call outfld( 'UW_ncvfin_o', ncvfin_o, pcols, lchnk ) + + call outfld( 'UW_kbase_mg', kbase_mg, pcols, lchnk ) + call outfld( 'UW_ktop_mg', ktop_mg, pcols, lchnk ) + call outfld( 'UW_ncvfin_mg', ncvfin_mg, pcols, lchnk ) + + call outfld( 'UW_kbase_f', kbase_f, pcols, lchnk ) + call outfld( 'UW_ktop_f', ktop_f, pcols, lchnk ) + call outfld( 'UW_ncvfin_f', ncvfin_f, pcols, lchnk ) + + call outfld( 'UW_wet', wet, pcols, lchnk ) + call outfld( 'UW_web', web, pcols, lchnk ) + call outfld( 'UW_jtbu', jtbu, pcols, lchnk ) + call outfld( 'UW_jbbu', jbbu, pcols, lchnk ) + call outfld( 'UW_evhc', evhc, pcols, lchnk ) + call outfld( 'UW_jt2slv', jt2slv, pcols, lchnk ) + call outfld( 'UW_n2ht', n2ht, pcols, lchnk ) + call outfld( 'UW_n2hb', n2hb, pcols, lchnk ) + call outfld( 'UW_lwp', lwp, pcols, lchnk ) + call outfld( 'UW_optdepth', opt_depth, pcols, lchnk ) + call outfld( 'UW_radfrac', radinvfrac, pcols, lchnk ) + call outfld( 'UW_radf', radf, pcols, lchnk ) + call outfld( 'UW_wstar', wstar, pcols, lchnk ) + call outfld( 'UW_wstar3fact', wstar3fact, pcols, lchnk ) + call outfld( 'UW_ebrk', ebrk, pcols, lchnk ) + call outfld( 'UW_wbrk', wbrk, pcols, lchnk ) + call outfld( 'UW_lbrk', lbrk, pcols, lchnk ) + call outfld( 'UW_ricl', ricl, pcols, lchnk ) + call outfld( 'UW_ghcl', ghcl, pcols, lchnk ) + call outfld( 'UW_shcl', shcl, pcols, lchnk ) + call outfld( 'UW_smcl', smcl, pcols, lchnk ) + + call outfld( 'UW_gh', ghi, pcols, lchnk ) + call outfld( 'UW_sh', shi, pcols, lchnk ) + call outfld( 'UW_sm', smi, pcols, lchnk ) + call outfld( 'UW_ria', rii, pcols, lchnk ) + call outfld( 'UW_leng', lengi, pcols, lchnk ) + + call outfld( 'UW_wsed', wsed, pcols, lchnk ) + + if (.not. unicon_is_on) then + deallocate(bprod, ipbl, kpblh, wstarPBL, tkes, went) + end if + +end subroutine compute_eddy_diff + +end module eddy_diff_cam diff --git a/src/physics/cam/flux_avg.F90 b/src/physics/cam/flux_avg.F90 new file mode 100644 index 0000000000..38f0c1de6e --- /dev/null +++ b/src/physics/cam/flux_avg.F90 @@ -0,0 +1,224 @@ +module flux_avg + +!--------------------------------------------------------------------------------- +! Purpose: Contains code to smooth the surface fluxes to reduce +! instabilities in the surface layer. +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: begchunk, endchunk, pcols + + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use phys_grid, only: get_ncols_p + use physics_buffer, only : pbuf_add_field, dtype_r8 + implicit none + private + save + + ! Public interfaces + + public :: flux_avg_register + public :: flux_avg_init + public :: flux_avg_run + + ! Private module data + + integer :: lhflx_idx ! lhflx index in physics buffer + integer :: shflx_idx ! shflx index in physics buffer + integer :: qflx_idx ! qflx index in physics buffer + integer :: taux_idx ! taux index in physics buffer + integer :: tauy_idx ! tauy index in physics buffer + integer :: lhflx_res_idx ! lhflx_res index in physics buffer + integer :: shflx_res_idx ! shflx_res index in physics buffer + integer :: qflx_res_idx ! qflx_res index in physics buffer + integer :: taux_res_idx ! taux_res index in physics buffer + integer :: tauy_res_idx ! tauy_res index in physics buffer + +!=============================================================================== +contains +!=============================================================================== + +subroutine flux_avg_register() + + !---------------------------------------------------------------------- + ! + ! Register the fluxes in the physics buffer. + ! + !----------------------------------------------------------------------- + + ! Request physics buffer space for fields that persist across timesteps. + call pbuf_add_field('LHFLX', 'global',dtype_r8,(/pcols,1/),lhflx_idx) + call pbuf_add_field('SHFLX', 'global',dtype_r8,(/pcols,1/),shflx_idx) + call pbuf_add_field('TAUX', 'global',dtype_r8,(/pcols,1/),taux_idx) + call pbuf_add_field('TAUY', 'global',dtype_r8,(/pcols,1/),tauy_idx) + call pbuf_add_field('QFLX', 'global',dtype_r8,(/pcols,1/),qflx_idx) + call pbuf_add_field('LHFLX_RES','global',dtype_r8,(/pcols,1/),lhflx_res_idx) + call pbuf_add_field('SHFLX_RES','global',dtype_r8,(/pcols,1/),shflx_res_idx) + call pbuf_add_field('TAUX_RES', 'global',dtype_r8,(/pcols,1/),taux_res_idx) + call pbuf_add_field('TAUY_RES', 'global',dtype_r8,(/pcols,1/),tauy_res_idx) + call pbuf_add_field('QFLX_RES', 'global',dtype_r8,(/pcols,1/),qflx_res_idx) + +end subroutine flux_avg_register + +!=============================================================================== + +subroutine flux_avg_init(cam_in, pbuf2d) + use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk + ! Initialize the surface fluxes in the physics buffer using the cam import state + + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer :: lchnk + integer :: ncol + type(physics_buffer_desc), pointer :: pbuf2d_chunk(:) + + !----------------------------------------------------------------------- + + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + pbuf2d_chunk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_set_field(pbuf2d_chunk, lhflx_idx, cam_in(lchnk)%lhf(:ncol)) + call pbuf_set_field(pbuf2d_chunk, shflx_idx, cam_in(lchnk)%shf(:ncol)) + call pbuf_set_field(pbuf2d_chunk, qflx_idx, cam_in(lchnk)%cflx(:ncol,1)) + call pbuf_set_field(pbuf2d_chunk, taux_idx, cam_in(lchnk)%wsx(:ncol)) + call pbuf_set_field(pbuf2d_chunk, tauy_idx, cam_in(lchnk)%wsy(:ncol)) + + call pbuf_set_field(pbuf2d, shflx_res_idx, 0.0_r8) + call pbuf_set_field(pbuf2d_chunk, lhflx_res_idx, 0.0_r8) + call pbuf_set_field(pbuf2d_chunk, qflx_res_idx, 0.0_r8) + call pbuf_set_field(pbuf2d_chunk, taux_res_idx, 0.0_r8) + call pbuf_set_field(pbuf2d_chunk, tauy_res_idx, 0.0_r8) + end do + + +end subroutine flux_avg_init + +!=============================================================================== + +subroutine flux_avg_run(state, cam_in, pbuf, nstep, deltat) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + !----------------------------------------------------------------------- + ! + ! Purpose: + ! + !----------------------------------------------------------------------- + + ! Input arguments + + type(physics_state), intent(in) :: state + type(cam_in_t), intent(inout) :: cam_in + type(physics_buffer_desc), pointer :: pbuf(:) + + integer, intent(in) :: nstep + real(r8), intent(in) :: deltat + + ! Local variables + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + ! physics buffer fields + real(r8), pointer, dimension(:) :: lhflx ! latent heat flux + real(r8), pointer, dimension(:) :: shflx ! sensible heat flux + real(r8), pointer, dimension(:) :: qflx ! water vapor heat flux + real(r8), pointer, dimension(:) :: taux ! x momentum flux + real(r8), pointer, dimension(:) :: tauy ! y momentum flux + real(r8), pointer, dimension(:) :: lhflx_res ! latent heat flux + real(r8), pointer, dimension(:) :: shflx_res ! sensible heat flux + real(r8), pointer, dimension(:) :: qflx_res ! water vapor heat flux + real(r8), pointer, dimension(:) :: taux_res ! x momentum flux + real(r8), pointer, dimension(:) :: tauy_res ! y momentum flux + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, lhflx_idx, lhflx ) + call pbuf_get_field(pbuf, shflx_idx, shflx ) + call pbuf_get_field(pbuf, qflx_idx, qflx ) + call pbuf_get_field(pbuf, taux_idx, taux ) + call pbuf_get_field(pbuf, tauy_idx, tauy ) + + call pbuf_get_field(pbuf, lhflx_res_idx, lhflx_res ) + call pbuf_get_field(pbuf, shflx_res_idx, shflx_res ) + call pbuf_get_field(pbuf, qflx_res_idx, qflx_res ) + call pbuf_get_field(pbuf, taux_res_idx, taux_res ) + call pbuf_get_field(pbuf, tauy_res_idx, tauy_res ) + + call smooth (cam_in%lhf, lhflx, lhflx_res, nstep, deltat, ncol) + call smooth (cam_in%shf, shflx, shflx_res, nstep, deltat, ncol) + call smooth (cam_in%wsx, taux, taux_res, nstep, deltat, ncol) + call smooth (cam_in%wsy, tauy, tauy_res, nstep, deltat, ncol) + call smooth (cam_in%cflx(:pcols,1), qflx, qflx_res, nstep, deltat, ncol) + +end subroutine flux_avg_run + +!=============================================================================== + +subroutine smooth(new, old, res, nstep, deltat, ncol) + + real(r8), intent(inout) :: new(pcols) + real(r8), intent(inout) :: old(pcols) + real(r8), intent(inout) :: res(pcols) + real(r8), intent(in) :: deltat + integer, intent(in) :: nstep + integer, intent(in) :: ncol + + real(r8) :: temp(pcols) + integer i + + temp(1:ncol) = new(1:ncol) + if (nstep > 0) then + new(1:ncol) = 0.5_r8*(new(1:ncol)+old(1:ncol)) + else + old(1:ncol) = new(1:ncol) + res(1:ncol) = 0._r8 + endif + + ! storing the old value for smoothing on the next step + ! doesnt seem to be stable + ! old(1:ncol) = temp(1:ncol) + + ! storing the smoothed value for the next step + + ! first add the flux that the surface model wanted to provide less + ! the flux the atmosphere will actually see to the residual + res(1:ncol) = res(1:ncol) + temp(1:ncol)-new(1:ncol) + + ! now calculate the amount that we might increment the new flux + ! to include some of the residual + ! If the residual is small we will just add it all, + ! but if it is large we will add it at the rate required to put + ! the residual back into the flux over a 2 hour period + do i = 1,ncol + if (abs(res(i)).lt.max(abs(new(i)),abs(old(i)))*0.05_r8) then + temp(i) = res(i) + res(i) = 0._r8 + else + temp(i) = res(i)*deltat/7200._r8 + ! temp(i) = res(i)*deltat*0.5/7200. + res(i) = res(i)-temp(i) + endif + end do + + ! dont do conservative smoothing for first 12 hours + if (nstep*deltat/86400._r8 < 0.5_r8) then + ! use this line if your dont want to use the residual + !if (.true.) then + temp = 0._r8 + res = 0._r8 + endif + + ! make the new flux the average of the sfc model and last timestep + ! plus some of the residual + new(1:ncol) = new(1:ncol) + temp(1:ncol) + old(1:ncol) = new(1:ncol) + +end subroutine smooth + +!=============================================================================== + +end module flux_avg + diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 new file mode 100644 index 0000000000..554663a5ad --- /dev/null +++ b/src/physics/cam/geopotential.F90 @@ -0,0 +1,215 @@ + +module geopotential + +!--------------------------------------------------------------------------------- +! Compute geopotential from temperature or +! compute geopotential and temperature from dry static energy. +! +! The hydrostatic matrix elements must be consistent with the dynamics algorithm. +! The diagonal element is the itegration weight from interface k+1 to midpoint k. +! The offdiagonal element is the weight between interfaces. +! +! Author: B.Boville, Feb 2001 from earlier code by Boville and S.J. Lin +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pver, pverp + use dycore, only: dycore_is + + implicit none + private + save + + public geopotential_dse + public geopotential_t + +contains +!=============================================================================== + subroutine geopotential_dse( & + piln , pmln , pint , pmid , pdel , rpdel , & + dse , q , phis , rair , gravit , cpair , & + zvir , t , zi , zm , ncol ) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the temperature and geopotential height (above the surface) at the +! midpoints and interfaces from the input dry static energy and pressures. +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- +! +! Input arguments + integer, intent(in) :: ncol ! Number of longitudes + + ! rair, and cpair are passed in as slices of rank 3 arrays allocated + ! at runtime. Don't specify size to avoid temporary copy. + real(r8), intent(in) :: piln (:,:) ! (pcols,pverp) - Log interface pressures + real(r8), intent(in) :: pmln (:,:) ! (pcols,pver) - Log midpoint pressures + real(r8), intent(in) :: pint (:,:) ! (pcols,pverp) - Interface pressures + real(r8), intent(in) :: pmid (:,:) ! (pcols,pver) - Midpoint pressures + real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness + real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness + real(r8), intent(in) :: dse (:,:) ! (pcols,pver) - dry static energy + real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity + real(r8), intent(in) :: phis (:) ! (pcols) - surface geopotential + real(r8), intent(in) :: rair (:,:) ! - Gas constant for dry air + real(r8), intent(in) :: gravit ! - Acceleration of gravity + real(r8), intent(in) :: cpair(:,:) ! - specific heat at constant p for dry air + real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 + +! Output arguments + + real(r8), intent(out) :: t(:,:) ! (pcols,pver) - temperature + real(r8), intent(out) :: zi(:,:) ! (pcols,pverp) - Height above surface at interfaces + real(r8), intent(out) :: zm(:,:) ! (pcols,pver) - Geopotential height at mid level +! +!---------------------------Local variables----------------------------------------- +! + logical :: fvdyn ! finite volume dynamics + integer :: i,k ! Lon, level, level indices + real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix + real(r8) :: hkl(ncol) ! off-diagonal element + real(r8) :: rog(ncol,pver) ! Rair / gravit + real(r8) :: tv ! virtual temperature + real(r8) :: tvfac ! Tv/T +! +!---------------------------------------------------------------------------------- + rog(:ncol,:) = rair(:ncol,:) / gravit + +! Set dynamics flag + fvdyn = dycore_is ('LR') + +! The surface height is zero by definition. + do i = 1,ncol + zi(i,pverp) = 0.0_r8 + end do + +! Compute the virtual temperature, zi, zm from bottom up +! Note, zi(i,k) is the interface above zm(i,k) + do k = pver, 1, -1 + +! First set hydrostatic elements consistent with dynamics + if (fvdyn) then + do i = 1,ncol + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + end do + else + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + end if + +! Now compute tv, t, zm, zi + do i = 1,ncol + tvfac = 1._r8 + zvir(i,k) * q(i,k) + tv = (dse(i,k) - phis(i) - gravit*zi(i,k+1)) / ((cpair(i,k) / tvfac) + & + rair(i,k)*hkk(i)) + + t (i,k) = tv / tvfac + + zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) + zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) + end do + end do + + return + end subroutine geopotential_dse + +!=============================================================================== + subroutine geopotential_t( & + piln , pmln , pint , pmid , pdel , rpdel , & + t , q , rair , gravit , zvir , & + zi , zm , ncol ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the geopotential height (above the surface) at the midpoints and +! interfaces using the input temperatures and pressures. +! +!----------------------------------------------------------------------- + +use ppgrid, only : pcols + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! Number of longitudes + + real(r8), intent(in) :: piln (:,:) ! (pcols,pverp) - Log interface pressures + real(r8), intent(in) :: pmln (:,:) ! (pcols,pver) - Log midpoint pressures + real(r8), intent(in) :: pint (:,:) ! (pcols,pverp) - Interface pressures + real(r8), intent(in) :: pmid (:,:) ! (pcols,pver) - Midpoint pressures + real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness + real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness + real(r8), intent(in) :: t (:,:) ! (pcols,pver) - temperature + real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity + real(r8), intent(in) :: rair (:,:) ! (pcols,pver) - Gas constant for dry air + real(r8), intent(in) :: gravit ! - Acceleration of gravity + real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 + +! Output arguments + + real(r8), intent(out) :: zi(:,:) ! (pcols,pverp) - Height above surface at interfaces + real(r8), intent(out) :: zm(:,:) ! (pcols,pver) - Geopotential height at mid level +! +!---------------------------Local variables----------------------------- +! + logical :: fvdyn ! finite volume dynamics + integer :: i,k ! Lon, level indices + real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix + real(r8) :: hkl(ncol) ! off-diagonal element + real(r8) :: rog(ncol,pver) ! Rair / gravit + real(r8) :: tv ! virtual temperature + real(r8) :: tvfac ! Tv/T +! +!----------------------------------------------------------------------- +! + rog(:ncol,:) = rair(:ncol,:) / gravit + +! Set dynamics flag + + fvdyn = dycore_is ('LR') + +! The surface height is zero by definition. + + do i = 1,ncol + zi(i,pverp) = 0.0_r8 + end do + +! Compute zi, zm from bottom up. +! Note, zi(i,k) is the interface above zm(i,k) + + do k = pver, 1, -1 + +! First set hydrostatic elements consistent with dynamics + + if (fvdyn) then + do i = 1,ncol + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + end do + else + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + end if + +! Now compute tv, zm, zi + + do i = 1,ncol + tvfac = 1._r8 + zvir(i,k) * q(i,k) + tv = t(i,k) * tvfac + + zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) + zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) + end do + end do + + return + end subroutine geopotential_t +end module geopotential diff --git a/src/physics/cam/ghg_data.F90 b/src/physics/cam/ghg_data.F90 new file mode 100644 index 0000000000..199f1eb455 --- /dev/null +++ b/src/physics/cam/ghg_data.F90 @@ -0,0 +1,268 @@ + +module ghg_data + +!------------------------------------------------------------------------------------------------ +! Purpose: +! Provide default distributions of CH4, N2O, CFC11 and CFC12 to the radiation routines. +! **NOTE** CO2 is assumed by the radiation to a be constant value. This value is +! currently supplied directly by the chem_surfvals module. +! +! Revision history: +! 2004-08-29 B. Eaton Create CAM interface to trcmix. +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, begchunk, endchunk +use physics_types, only: physics_state +use physconst, only: mwdry, mwch4, mwn2o, mwf11, mwf12, mwco2 +use chem_surfvals, only: chem_surfvals_get, chem_surfvals_co2_rad +use cam_abortutils, only: endrun +use error_messages, only: handle_err + + +implicit none +private +save + +! Public interfaces +public ::& + ghg_data_register, &! register ghg's with pbuf2d + ghg_data_timestep_init ! place data model of ghg's in pbuf2d + +! Private variables + +real(r8) :: rmwn2o ! = mwn2o/mwdry ! ratio of molecular weight n2o to dry air +real(r8) :: rmwch4 ! = mwch4/mwdry ! ratio of molecular weight ch4 to dry air +real(r8) :: rmwf11 ! = mwf11/mwdry ! ratio of molecular weight cfc11 to dry air +real(r8) :: rmwf12 ! = mwf12/mwdry ! ratio of molecular weight cfc12 to dry air +real(r8) :: rmwco2 ! = mwco2/mwdry ! ratio of molecular weights of co2 to dry air + +integer, parameter :: ncnst = 6 ! number of constituents +character(len=8), dimension(ncnst), parameter :: & + cnst_names = (/'N2O ', 'CH4 ', 'CFC11', 'CFC12', 'CO2 ', 'O2 '/) ! constituent names +integer :: pbuf_idx(ncnst) + +!================================================================================================ +contains +!================================================================================================ + +subroutine ghg_data_register() +!------------------------------------------------------------------------------- +! register ghg's with pbuf2d +!------------------------------------------------------------------------------- + use physics_buffer, only : pbuf_add_field, dtype_r8 + + integer iconst + + + do iconst = 1,ncnst + call pbuf_add_field(cnst_names(iconst),'physpkg',dtype_r8,(/pcols,pver/),pbuf_idx(iconst)) + enddo + +end subroutine ghg_data_register + +subroutine ghg_data_timestep_init(pbuf2d, state) +!------------------------------------------------------------------------------- +! place data model of ghg's in pbuf2d at each timestep +!------------------------------------------------------------------------------- + use ppgrid, only: begchunk, endchunk, pcols, pver + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + + + type(physics_state), intent(in), dimension(begchunk:endchunk) :: state + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + real(r8), pointer :: tmpptr(:,:) + + integer iconst + integer lchnk + + rmwn2o = mwn2o/mwdry ! ratio of molecular weight n2o to dry air + rmwch4 = mwch4/mwdry ! ratio of molecular weight ch4 to dry air + rmwf11 = mwf11/mwdry ! ratio of molecular weight cfc11 to dry air + rmwf12 = mwf12/mwdry ! ratio of molecular weight cfc12 to dry air + rmwco2 = mwco2/mwdry ! ratio of molecular weights of co2 to dry air + + do iconst = 1,ncnst +!$OMP PARALLEL DO PRIVATE (LCHNK,tmpptr,pbuf_chnk) + do lchnk = begchunk, endchunk + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, pbuf_idx(iconst), tmpptr) + call trcmix(cnst_names(iconst), state(lchnk)%ncol, & + state(lchnk)%lat, state(lchnk)%pmid, & + tmpptr) + enddo + enddo + +end subroutine ghg_data_timestep_init + + +!================================================================================================ + +subroutine trcmix(name, ncol, clat, pmid, q) +!----------------------------------------------------------------------- +! +! Purpose: +! Specify zonal mean mass mixing ratios of CH4, N2O, CFC11 and +! CFC12 +! +! Method: +! Distributions assume constant mixing ratio in the troposphere +! and a decrease of mixing ratio in the stratosphere. Tropopause +! defined by ptrop. The scale height of the particular trace gas +! depends on latitude. This assumption produces a more realistic +! stratospheric distribution of the various trace gases. +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- + + ! Arguments + character(len=*), intent(in) :: name ! constituent name + integer, intent(in) :: ncol ! number of columns + real(r8), intent(in) :: clat(pcols) ! latitude in radians for columns + real(r8), intent(in) :: pmid(pcols,pver) ! model pressures + real(r8), intent(out) :: q(pcols,pver) ! constituent mass mixing ratio + + integer i ! longitude loop index + integer k ! level index + + real(r8) coslat(pcols) ! cosine of latitude + real(r8) dlat ! latitude in degrees + real(r8) ptrop ! pressure level of tropopause + real(r8) pratio ! pressure divided by ptrop + real(r8) trop_mmr ! tropospheric mass mixing ratio + real(r8) scale ! pressure scale height +!----------------------------------------------------------------------- + + do i = 1, ncol + coslat(i) = cos(clat(i)) + end do + + if (name == 'O2') then + + q = chem_surfvals_get('O2MMR') + + else if (name == 'CO2') then + + q = chem_surfvals_co2_rad() + + else if (name == 'CH4') then + + ! set tropospheric mass mixing ratios + trop_mmr = rmwch4 * chem_surfvals_get('CH4VMR') + + do k = 1,pver + do i = 1,ncol + ! set stratospheric scale height factor for gases + dlat = abs(57.2958_r8 * clat(i)) + if(dlat.le.45.0_r8) then + scale = 0.2353_r8 + else + scale = 0.2353_r8 + 0.0225489_r8 * (dlat - 45) + end if + + ! pressure of tropopause + ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8 + + ! determine output mass mixing ratios + if (pmid(i,k) >= ptrop) then + q(i,k) = trop_mmr + else + pratio = pmid(i,k)/ptrop + q(i,k) = trop_mmr * (pratio)**scale + end if + end do + end do + + else if (name == 'N2O') then + + ! set tropospheric mass mixing ratios + trop_mmr = rmwn2o * chem_surfvals_get('N2OVMR') + + do k = 1,pver + do i = 1,ncol + ! set stratospheric scale height factor for gases + dlat = abs(57.2958_r8 * clat(i)) + if(dlat.le.45.0_r8) then + scale = 0.3478_r8 + 0.00116_r8 * dlat + else + scale = 0.4000_r8 + 0.013333_r8 * (dlat - 45) + end if + + ! pressure of tropopause + ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8 + + ! determine output mass mixing ratios + if (pmid(i,k) >= ptrop) then + q(i,k) = trop_mmr + else + pratio = pmid(i,k)/ptrop + q(i,k) = trop_mmr * (pratio)**scale + end if + end do + end do + + else if (name == 'CFC11') then + + ! set tropospheric mass mixing ratios + trop_mmr = rmwf11 * chem_surfvals_get('F11VMR') + + do k = 1,pver + do i = 1,ncol + ! set stratospheric scale height factor for gases + dlat = abs(57.2958_r8 * clat(i)) + if(dlat.le.45.0_r8) then + scale = 0.7273_r8 + 0.00606_r8 * dlat + else + scale = 1.00_r8 + 0.013333_r8 * (dlat - 45) + end if + + ! pressure of tropopause + ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8 + + ! determine output mass mixing ratios + if (pmid(i,k) >= ptrop) then + q(i,k) = trop_mmr + else + pratio = pmid(i,k)/ptrop + q(i,k) = trop_mmr * (pratio)**scale + end if + end do + end do + + else if (name == 'CFC12') then + + ! set tropospheric mass mixing ratios + trop_mmr = rmwf12 * chem_surfvals_get('F12VMR') + + do k = 1,pver + do i = 1,ncol + ! set stratospheric scale height factor for gases + dlat = abs(57.2958_r8 * clat(i)) + if(dlat.le.45.0_r8) then + scale = 0.4000_r8 + 0.00222_r8 * dlat + else + scale = 0.50_r8 + 0.024444_r8 * (dlat - 45) + end if + + ! pressure of tropopause + ptrop = 250.0e2_r8 - 150.0e2_r8*coslat(i)**2.0_r8 + + ! determine output mass mixing ratios + if (pmid(i,k) >= ptrop) then + q(i,k) = trop_mmr + else + pratio = pmid(i,k)/ptrop + q(i,k) = trop_mmr * (pratio)**scale + end if + end do + end do + + end if + +end subroutine trcmix + +end module ghg_data diff --git a/src/physics/cam/gw_common.F90 b/src/physics/cam/gw_common.F90 new file mode 100644 index 0000000000..55500d57b1 --- /dev/null +++ b/src/physics/cam/gw_common.F90 @@ -0,0 +1,983 @@ +module gw_common + +! +! This module contains code common to different gravity wave +! parameterizations. +! +use gw_utils, only: r8 +use coords_1d, only: Coords1D + + +implicit none +private +save + +! Public interface. + +public :: GWBand + +public :: gw_common_init +public :: gw_prof +public :: gw_drag_prof +public :: qbo_hdepth_scaling +public :: calc_taucd, momentum_flux, momentum_fixer +public :: energy_change, energy_fixer +public :: coriolis_speed, adjust_inertial + +public :: pver +public :: west, east, north, south +public :: pi +public :: gravit +public :: rair + +! Number of levels in the atmosphere. +integer, protected :: pver = 0 + +! Whether or not to enforce an upper boundary condition of tau = 0. +logical :: tau_0_ubc = .false. + +! Index the cardinal directions. +integer, parameter :: west = 1 +integer, parameter :: east = 2 +integer, parameter :: south = 3 +integer, parameter :: north = 4 + +! Scaling factor for generating QBO +real(r8), protected :: qbo_hdepth_scaling + +! 3.14159... +real(r8), parameter :: pi = acos(-1._r8) + +! Acceleration due to gravity. +real(r8), protected :: gravit = huge(1._r8) + +! Gas constant for dry air. +real(r8), protected :: rair = huge(1._r8) + +! +! Private variables +! + +! Interface levels for gravity wave sources. +integer :: ktop = huge(1) + +! Background diffusivity. +real(r8), parameter :: dback = 0.05_r8 + +! rair/gravit +real(r8) :: rog = huge(1._r8) + +! Newtonian cooling coefficients. +real(r8), allocatable :: alpha(:) + +! Inverse Prandtl number. +real(r8) :: prndl + +! +! Limits to keep values reasonable. +! + +! Minimum non-zero stress. +real(r8), parameter :: taumin = 1.e-10_r8 +! Maximum wind tendency from stress divergence (before efficiency applied). +! 400 m/s/day +real(r8), parameter :: tndmax = 400._r8 / 86400._r8 +! Maximum allowed change in u-c (before efficiency applied). +real(r8), parameter :: umcfac = 0.5_r8 +! Minimum value of (u-c)**2. +real(r8), parameter :: ubmc2mn = 0.01_r8 + +! Type describing a band of wavelengths into which gravity waves can be +! emitted. +! Currently this has to have uniform spacing (i.e. adjacent elements of +! cref are exactly dc apart). +type :: GWBand + ! Dimension of the spectrum. + integer :: ngwv + ! Delta between nearest phase speeds [m/s]. + real(r8) :: dc + ! Reference speeds [m/s]. + real(r8), allocatable :: cref(:) + ! Critical Froude number, squared (usually 1, but CAM3 used 0.5). + real(r8) :: fcrit2 + ! Horizontal wave number [1/m]. + real(r8) :: kwv + ! Effective horizontal wave number [1/m] (fcrit2*kwv). + real(r8) :: effkwv +end type GWBand + +interface GWBand + module procedure new_GWBand +end interface + +contains + +!========================================================================== + +! Constructor for a GWBand that calculates derived components. +function new_GWBand(ngwv, dc, fcrit2, wavelength) result(band) + ! Used directly to set the type's components. + integer, intent(in) :: ngwv + real(r8), intent(in) :: dc + real(r8), intent(in) :: fcrit2 + ! Wavelength in meters. + real(r8), intent(in) :: wavelength + + ! Output. + type(GWBand) :: band + + ! Wavenumber index. + integer :: l + + ! Simple assignments. + band%ngwv = ngwv + band%dc = dc + band%fcrit2 = fcrit2 + + ! Uniform phase speed reference grid. + allocate(band%cref(-ngwv:ngwv)) + band%cref = [( dc * l, l = -ngwv, ngwv )] + + ! Wavenumber and effective wavenumber come from the wavelength. + band%kwv = 2._r8*pi / wavelength + band%effkwv = band%fcrit2 * band%kwv + +end function new_GWBand + +!========================================================================== + +subroutine gw_common_init(pver_in, & + tau_0_ubc_in, ktop_in, gravit_in, rair_in, alpha_in, & + prndl_in, qbo_hdepth_scaling_in, errstring) + + integer, intent(in) :: pver_in + logical, intent(in) :: tau_0_ubc_in + integer, intent(in) :: ktop_in + real(r8), intent(in) :: gravit_in + real(r8), intent(in) :: rair_in + real(r8), intent(in) :: alpha_in(:) + real(r8), intent(in) :: prndl_in + real(r8), intent(in) :: qbo_hdepth_scaling_in + ! Report any errors from this routine. + character(len=*), intent(out) :: errstring + + integer :: ierr + + errstring = "" + + pver = pver_in + tau_0_ubc = tau_0_ubc_in + ktop = ktop_in + gravit = gravit_in + rair = rair_in + allocate(alpha(pver+1), stat=ierr, errmsg=errstring) + if (ierr /= 0) return + alpha = alpha_in + prndl = prndl_in + qbo_hdepth_scaling = qbo_hdepth_scaling_in + + rog = rair/gravit + +end subroutine gw_common_init + +!========================================================================== + +subroutine gw_prof (ncol, p, cpair, t, rhoi, nm, ni) + !----------------------------------------------------------------------- + ! Compute profiles of background state quantities for the multiple + ! gravity wave drag parameterization. + ! + ! The parameterization is assumed to operate only where water vapor + ! concentrations are negligible in determining the density. + !----------------------------------------------------------------------- + use gw_utils, only: midpoint_interp + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + + ! Specific heat of dry air, constant pressure. + real(r8), intent(in) :: cpair + ! Midpoint temperatures. + real(r8), intent(in) :: t(ncol,pver) + + ! Interface density. + real(r8), intent(out) :: rhoi(ncol,pver+1) + ! Midpoint and interface Brunt-Vaisalla frequencies. + real(r8), intent(out) :: nm(ncol,pver), ni(ncol,pver+1) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i,k + + ! dt/dp + real(r8) :: dtdp + ! Brunt-Vaisalla frequency squared. + real(r8) :: n2 + + ! Interface temperature. + real(r8) :: ti(ncol,pver+1) + + ! Minimum value of Brunt-Vaisalla frequency squared. + real(r8), parameter :: n2min = 5.e-5_r8 + + !------------------------------------------------------------------------ + ! Determine the interface densities and Brunt-Vaisala frequencies. + !------------------------------------------------------------------------ + + ! The top interface values are calculated assuming an isothermal + ! atmosphere above the top level. + k = 1 + do i = 1, ncol + ti(i,k) = t(i,k) + rhoi(i,k) = p%ifc(i,k) / (rair*ti(i,k)) + ni(i,k) = sqrt(gravit*gravit / (cpair*ti(i,k))) + end do + + ! Interior points use centered differences. + ti(:,2:pver) = midpoint_interp(t) + do k = 2, pver + do i = 1, ncol + rhoi(i,k) = p%ifc(i,k) / (rair*ti(i,k)) + dtdp = (t(i,k)-t(i,k-1)) * p%rdst(i,k-1) + n2 = gravit*gravit/ti(i,k) * (1._r8/cpair - rhoi(i,k)*dtdp) + ni(i,k) = sqrt(max(n2min, n2)) + end do + end do + + ! Bottom interface uses bottom level temperature, density; next interface + ! B-V frequency. + k = pver+1 + do i = 1, ncol + ti(i,k) = t(i,k-1) + rhoi(i,k) = p%ifc(i,k) / (rair*ti(i,k)) + ni(i,k) = ni(i,k-1) + end do + + !------------------------------------------------------------------------ + ! Determine the midpoint Brunt-Vaisala frequencies. + !------------------------------------------------------------------------ + nm = midpoint_interp(ni) + +end subroutine gw_prof + +!========================================================================== + +subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, ro_adjust, & + kwvrdg, satfac_in, lapply_effgw_in, lapply_vdiff ) + + !----------------------------------------------------------------------- + ! Solve for the drag profile from the multiple gravity wave drag + ! parameterization. + ! 1. scan up from the wave source to determine the stress profile + ! 2. scan down the stress profile to determine the tendencies + ! => apply bounds to the tendency + ! a. from wkb solution + ! b. from computational stability constraints + ! => adjust stress on interface below to reflect actual bounded + ! tendency + !----------------------------------------------------------------------- + + use gw_diffusion, only: gw_ediff, gw_diff_tend + use linear_1d_operators, only: TriDiagDecomp + + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + ! Wavelengths. + type(GWBand), intent(in) :: band + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + ! Level from which gravity waves are propagated upward. + integer, intent(in) :: src_level(ncol) + ! Lowest level where wind tendencies are calculated. + integer, intent(in) :: tend_level(ncol) + ! Using tend_level > src_level allows the orographic waves to prescribe + ! wave propagation up to a certain level, but then allow wind tendencies + ! and adjustments to tau below that level. + + ! Time step. + real(r8), intent(in) :: dt + + ! Midpoint and interface temperatures. + real(r8), intent(in) :: t(ncol,pver) + ! Log of interface pressures. + real(r8), intent(in) :: piln(ncol,pver+1) + ! Interface densities. + real(r8), intent(in) :: rhoi(ncol,pver+1) + ! Midpoint and interface Brunt-Vaisalla frequencies. + real(r8), intent(in) :: nm(ncol,pver), ni(ncol,pver+1) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(in) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(in) :: xv(ncol), yv(ncol) + ! Tendency efficiency. + real(r8), intent(in) :: effgw(ncol) + ! Wave phase speeds for each column. + real(r8), intent(in) :: c(ncol,-band%ngwv:band%ngwv) + ! Molecular thermal diffusivity. + real(r8), intent(in) :: kvtt(ncol,pver+1) + ! Constituent array. + real(r8), intent(in) :: q(:,:,:) + ! Dry static energy. + real(r8), intent(in) :: dse(ncol,pver) + + ! Wave Reynolds stress. + real(r8), intent(inout) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Zonal/meridional wind tendencies. + real(r8), intent(out) :: utgw(ncol,pver), vtgw(ncol,pver) + ! Gravity wave heating tendency. + real(r8), intent(out) :: ttgw(ncol,pver) + ! Gravity wave constituent tendency. + real(r8), intent(out) :: qtgw(:,:,:) + + ! Effective gravity wave diffusivity at interfaces. + real(r8), intent(out) :: egwdffi(ncol,pver+1) + + ! Gravity wave wind tendency for each wave. + real(r8), intent(out) :: gwut(ncol,pver,-band%ngwv:band%ngwv) + + ! Temperature tendencies from diffusion and kinetic energy. + real(r8), intent(out) :: dttdf(ncol,pver) + real(r8), intent(out) :: dttke(ncol,pver) + + ! Adjustment parameter for IGWs. + real(r8), intent(in), optional :: & + ro_adjust(ncol,-band%ngwv:band%ngwv,pver+1) + + ! Diagnosed horizontal wavenumber for ridges. + real(r8), intent(in), optional :: & + kwvrdg(ncol) + + ! Factor for saturation calculation. Here backwards + ! compatibility. I believe it should be 1.0 (jtb). + ! Looks like it has been 2.0 for a while in CAM. + real(r8), intent(in), optional :: & + satfac_in + + logical, intent(in), optional :: lapply_effgw_in, lapply_vdiff + + !---------------------------Local storage------------------------------- + + ! Level, wavenumber, constituent and column loop indices. + integer :: k, l, m, i + + ! Lowest tendency and source levels. + integer :: kbot_tend, kbot_src + + ! "Total" and saturation diffusivity. + real(r8) :: d(ncol) + ! Imaginary part of vertical wavenumber. + real(r8) :: mi(ncol) + ! Stress after damping. + real(r8) :: taudmp(ncol) + ! Saturation stress. + real(r8) :: tausat(ncol) + ! (ub-c) and (ub-c)**2 + real(r8) :: ubmc(ncol), ubmc2(ncol) + ! Temporary ubar tendencies (overall, and at wave l). + real(r8) :: ubt(ncol,pver), ubtl(ncol) + real(r8) :: wrk(ncol) + ! Ratio used for ubt tndmax limiting. + real(r8) :: ubt_lim_ratio(ncol) + + ! saturation factor. Defaults to 2.0 + ! unless overidden by satfac_in + real(r8) :: satfac + + logical :: lapply_effgw,do_vertical_diffusion + + ! LU decomposition. + type(TriDiagDecomp) :: decomp + + !------------------------------------------------------------------------ + + if (present(satfac_in)) then + satfac = satfac_in + else + satfac = 2._r8 + endif + + ! Default behavior is to apply vertical diffusion. + ! The user has the option to turn off vert diffusion + do_vertical_diffusion = .true. + if (present(lapply_vdiff)) then + do_vertical_diffusion = lapply_vdiff + endif + + ! Default behavior is to apply effgw and + ! tendency limiters as designed by Sean + ! Santos (lapply_effgw=.TRUE.). However, + ! WACCM non-oro GW need to be retuned before + ! this can done to them. --jtb 03/02/16 + if (present(lapply_effgw_in)) then + lapply_effgw = lapply_effgw_in + else + lapply_effgw = .TRUE. + endif + + + ! Lowest levels that loops need to iterate over. + kbot_tend = maxval(tend_level) + kbot_src = maxval(src_level) + + ! Initialize gravity wave drag tendencies to zero. + + utgw = 0._r8 + vtgw = 0._r8 + + gwut = 0._r8 + + dttke = 0._r8 + ttgw = 0._r8 + + dttdf = 0._r8 + qtgw = 0._r8 + + ! Workaround floating point exception issues on Intel by initializing + ! everything that's first set in a where block. + mi = 0._r8 + taudmp = 0._r8 + tausat = 0._r8 + ubmc = 0._r8 + ubmc2 = 0._r8 + wrk = 0._r8 + + !------------------------------------------------------------------------ + ! Compute the stress profiles and diffusivities + !------------------------------------------------------------------------ + + ! Loop from bottom to top to get stress profiles. + ! do k = kbot_src-1, ktop, -1 !++jtb I think this is right + do k = kbot_src, ktop, -1 !++ but this is in model now + + ! Determine the diffusivity for each column. + + d = dback + kvtt(:,k) + + do l = -band%ngwv, band%ngwv + + ! Determine the absolute value of the saturation stress. + ! Define critical levels where the sign of (u-c) changes between + ! interfaces. + ubmc = ubi(:,k) - c(:,l) + + tausat = 0.0_r8 + + if (present(kwvrdg)) then + where (src_level >= k) + ! Test to see if u-c has the same sign here as the level below. + where (ubmc > 0.0_r8 .eqv. ubi(:,k+1) > c(:,l)) + tausat = abs( kwvrdg * rhoi(:,k) * ubmc**3 / & + (satfac*ni(:,k))) + end where + end where + else + where (src_level >= k) + ! Test to see if u-c has the same sign here as the level below. + where (ubmc > 0.0_r8 .eqv. ubi(:,k+1) > c(:,l)) + tausat = abs(band%effkwv * rhoi(:,k) * ubmc**3 / & + (satfac*ni(:,k))) + end where + end where + end if + + if (present(ro_adjust)) then + where (src_level >= k) + tausat = tausat * sqrt(ro_adjust(:,l,k)) + end where + end if + + if (present(kwvrdg)) then + where (src_level >= k) + ! Compute stress for each wave. The stress at this level is the + ! min of the saturation stress and the stress at the level below + ! reduced by damping. The sign of the stress must be the same as + ! at the level below. + + ubmc2 = max(ubmc**2, ubmc2mn) + mi = ni(:,k) / (2._r8 * kwvrdg * ubmc2) * & ! Is this 2._r8 related to satfac? + (alpha(k) + ni(:,k)**2/ubmc2 * d) + wrk = -2._r8*mi*rog*t(:,k)*(piln(:,k+1) - piln(:,k)) + + taudmp = tau(:,l,k+1) + + ! For some reason, PGI 14.1 loses bit-for-bit reproducibility if + ! we limit tau, so instead limit the arrays used to set it. + where (tausat <= taumin) tausat = 0._r8 + where (taudmp <= taumin) taudmp = 0._r8 + + tau(:,l,k) = min(taudmp, tausat) + end where + + else + + where (src_level >= k) + + ! Compute stress for each wave. The stress at this level is the + ! min of the saturation stress and the stress at the level below + ! reduced by damping. The sign of the stress must be the same as + ! at the level below. + + ubmc2 = max(ubmc**2, ubmc2mn) + mi = ni(:,k) / (2._r8 * band%kwv * ubmc2) * & + (alpha(k) + ni(:,k)**2/ubmc2 * d) + wrk = -2._r8*mi*rog*t(:,k)*(piln(:,k+1) - piln(:,k)) + + taudmp = tau(:,l,k+1) * exp(wrk) + + ! For some reason, PGI 14.1 loses bit-for-bit reproducibility if + ! we limit tau, so instead limit the arrays used to set it. + where (tausat <= taumin) tausat = 0._r8 + where (taudmp <= taumin) taudmp = 0._r8 + + tau(:,l,k) = min(taudmp, tausat) + end where + endif + + end do + end do + + ! Force tau at the top of the model to zero, if requested. + if (tau_0_ubc) tau(:,:,ktop) = 0._r8 + + ! Apply efficiency to completed stress profile. + if (lapply_effgw) then + do k = ktop, kbot_tend+1 + do l = -band%ngwv, band%ngwv + where (k-1 <= tend_level) + tau(:,l,k) = tau(:,l,k) * effgw + end where + end do + end do + end if + + !------------------------------------------------------------------------ + ! Compute the tendencies from the stress divergence. + !------------------------------------------------------------------------ + + ! Loop over levels from top to bottom + do k = ktop, kbot_tend + + ! Accumulate the mean wind tendency over wavenumber. + ubt(:,k) = 0.0_r8 + + do l = -band%ngwv, band%ngwv ! loop over wave + + ! Determine the wind tendency, including excess stress carried down + ! from above. + ubtl = gravit * (tau(:,l,k+1)-tau(:,l,k)) * p%rdel(:,k) + + ! Apply first tendency limit to maintain numerical stability. + ! Enforce du/dt < |c-u|/dt so u-c cannot change sign + ! (u^n+1 = u^n + du/dt * dt) + ! The limiter is somewhat stricter, so that we don't come anywhere + ! near reversing c-u. + ubtl = min(ubtl, umcfac * abs(c(:,l)-ubm(:,k)) / dt) + + if (.not. lapply_effgw) ubtl = min(ubtl, tndmax) + + where (k <= tend_level) + + ! Save tendency for each wave (for later computation of kzz). + ! sign function returns magnitude of ubtl with sign of c-ubm + ! Renders ubt/ubm check for mountain waves unecessary + gwut(:,k,l) = sign(ubtl, c(:,l)-ubm(:,k)) + ubt(:,k) = ubt(:,k) + gwut(:,k,l) + + end where + + end do + + if (lapply_effgw) then + ! Apply second tendency limit to maintain numerical stability. + ! Enforce du/dt < tndmax so that ridicuously large tendencies are not + ! permitted. + ! This can only happen above tend_level, so don't bother checking the + ! level explicitly. + where (abs(ubt(:,k)) > tndmax) + ubt_lim_ratio = tndmax/abs(ubt(:,k)) + ubt(:,k) = ubt_lim_ratio * ubt(:,k) + elsewhere + ubt_lim_ratio = 1._r8 + end where + else + ubt_lim_ratio = 1._r8 + end if + + do l = -band%ngwv, band%ngwv + gwut(:,k,l) = ubt_lim_ratio*gwut(:,k,l) + ! Redetermine the effective stress on the interface below from the + ! wind tendency. If the wind tendency was limited above, then the + ! new stress will be smaller than the old stress, causing stress + ! divergence in the next layer down. This smoothes large stress + ! divergences downward while conserving total stress. + where (k <= tend_level) + tau(:,l,k+1) = tau(:,l,k) + & + abs(gwut(:,k,l)) * p%del(:,k) / gravit + end where + end do + + ! Project the mean wind tendency onto the components. + where (k <= tend_level) + utgw(:,k) = ubt(:,k) * xv + vtgw(:,k) = ubt(:,k) * yv + end where + + ! End of level loop. + end do + + + ! Block to undo Sean Santos mods to effgw and limiters. + ! Here because non-oro GW in WACCM need extensive re-tuning + ! before Sean's mods can be adopted. --jtb 03/02/16 + !========================================== + if (.not.(lapply_effgw)) then + do k = ktop, kbot_tend+1 + do l = -band%ngwv, band%ngwv + where (k-1 <= tend_level) + tau(:,l,k) = tau(:,l,k) * effgw + end where + end do + end do + do k = ktop, kbot_tend + do l = -band%ngwv, band%ngwv + gwut(:,k,l) = gwut(:,k,l) * effgw + end do + utgw(:,k) = utgw(:,k) * effgw + vtgw(:,k) = vtgw(:,k) * effgw + end do + end if + !=========================================== + + if (do_vertical_diffusion) then + + ! Calculate effective diffusivity and LU decomposition for the + ! vertical diffusion solver. + call gw_ediff (ncol, pver, band%ngwv, kbot_tend, ktop, tend_level, & + gwut, ubm, nm, rhoi, dt, prndl, gravit, p, c, & + egwdffi, decomp, ro_adjust=ro_adjust) + + ! Calculate tendency on each constituent. + do m = 1, size(q,3) + + call gw_diff_tend(ncol, pver, kbot_tend, ktop, q(:,:,m), & + dt, decomp, qtgw(:,:,m)) + + enddo + + ! Calculate tendency from diffusing dry static energy (dttdf). + call gw_diff_tend(ncol, pver, kbot_tend, ktop, dse, dt, decomp, dttdf) + + endif + + ! Evaluate second temperature tendency term: Conversion of kinetic + ! energy into thermal. + do l = -band%ngwv, band%ngwv + do k = ktop, kbot_tend + dttke(:,k) = dttke(:,k) - (ubm(:,k) - c(:,l)) * gwut(:,k,l) + end do + end do + + ttgw = dttke + dttdf + + ! Deallocate decomp. + call decomp%finalize() + +end subroutine gw_drag_prof + +!========================================================================== + +! Calculate Reynolds stress for waves propagating in each cardinal +! direction. + +function calc_taucd(ncol, ngwv, tend_level, tau, c, xv, yv, ubi) & + result(taucd) + + ! Column and gravity wave wavenumber dimensions. + integer, intent(in) :: ncol, ngwv + ! Lowest level where wind tendencies are calculated. + integer, intent(in) :: tend_level(:) + ! Wave Reynolds stress. + real(r8), intent(in) :: tau(:,-ngwv:,:) + ! Wave phase speeds for each column. + real(r8), intent(in) :: c(:,-ngwv:) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(in) :: xv(:), yv(:) + ! Projection of wind at interfaces. + real(r8), intent(in) :: ubi(:,:) + + real(r8) :: taucd(ncol,pver+1,4) + + ! Indices. + integer :: i, k, l + + ! ubi at tend_level. + real(r8) :: ubi_tend(ncol) + + ! Signed wave Reynolds stress. + real(r8) :: tausg(ncol) + + ! Reynolds stress for waves propagating behind and forward of the wind. + real(r8) :: taub(ncol) + real(r8) :: tauf(ncol) + + taucd = 0._r8 + tausg = 0._r8 + + ubi_tend = (/ (ubi(i,tend_level(i)+1), i = 1, ncol) /) + + do k = ktop, maxval(tend_level)+1 + + taub = 0._r8 + tauf = 0._r8 + + do l = -ngwv, ngwv + where (k-1 <= tend_level) + + tausg = sign(tau(:,l,k), c(:,l)-ubi(:,k)) + + where ( c(:,l) < ubi_tend ) + taub = taub + tausg + elsewhere + tauf = tauf + tausg + end where + + end where + end do + + where (k-1 <= tend_level) + where (xv > 0._r8) + taucd(:,k,east) = tauf * xv + taucd(:,k,west) = taub * xv + elsewhere + taucd(:,k,east) = taub * xv + taucd(:,k,west) = tauf * xv + end where + + where ( yv > 0._r8) + taucd(:,k,north) = tauf * yv + taucd(:,k,south) = taub * yv + elsewhere + taucd(:,k,north) = taub * yv + taucd(:,k,south) = tauf * yv + end where + end where + + end do + +end function calc_taucd + +!========================================================================== + +! Calculate the amount of momentum conveyed from below the gravity wave +! region, to the region where gravity waves are calculated. +subroutine momentum_flux(tend_level, taucd, um_flux, vm_flux) + + ! Bottom stress level. + integer, intent(in) :: tend_level(:) + ! Projected stresses. + real(r8), intent(in) :: taucd(:,:,:) + ! Components of momentum change sourced from the bottom. + real(r8), intent(out) :: um_flux(:), vm_flux(:) + + integer :: i + + ! Tendency for U & V below source level. + do i = 1, size(tend_level) + um_flux(i) = taucd(i,tend_level(i)+1, east) + & + taucd(i,tend_level(i)+1, west) + vm_flux(i) = taucd(i,tend_level(i)+1,north) + & + taucd(i,tend_level(i)+1,south) + end do + +end subroutine momentum_flux + +!========================================================================== + +! Subtracts a change in momentum in the gravity wave levels from wind +! tendencies in lower levels, ensuring momentum conservation. +subroutine momentum_fixer(tend_level, p, um_flux, vm_flux, utgw, vtgw) + + ! Bottom stress level. + integer, intent(in) :: tend_level(:) + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + ! Components of momentum change sourced from the bottom. + real(r8), intent(in) :: um_flux(:), vm_flux(:) + ! Wind tendencies. + real(r8), intent(inout) :: utgw(:,:), vtgw(:,:) + + ! Indices. + integer :: i, k + ! Reciprocal of total mass. + real(r8) :: rdm(size(tend_level)) + ! Average changes in velocity from momentum change being spread over + ! total mass. + real(r8) :: du(size(tend_level)), dv(size(tend_level)) + + ! Total mass from ground to source level: rho*dz = dp/gravit + do i = 1, size(tend_level) + rdm(i) = gravit/(p%ifc(i,pver+1)-p%ifc(i,tend_level(i)+1)) + end do + + ! Average velocity changes. + du = -um_flux*rdm + dv = -vm_flux*rdm + + do k = minval(tend_level)+1, pver + where (k > tend_level) + utgw(:,k) = utgw(:,k) + du + vtgw(:,k) = vtgw(:,k) + dv + end where + end do + +end subroutine momentum_fixer + +!========================================================================== + +! Calculate the change in total energy from tendencies up to this point. +subroutine energy_change(dt, p, u, v, dudt, dvdt, dsdt, de) + + ! Time step. + real(r8), intent(in) :: dt + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + ! Winds at start of time step. + real(r8), intent(in) :: u(:,:), v(:,:) + ! Wind tendencies. + real(r8), intent(in) :: dudt(:,:), dvdt(:,:) + ! Heating tendency. + real(r8), intent(in) :: dsdt(:,:) + ! Change in energy. + real(r8), intent(out) :: de(:) + + ! Level index. + integer :: k + + ! Net gain/loss of total energy in the column. + de = 0.0_r8 + do k = 1, pver + de = de + p%del(:,k)/gravit * (dsdt(:,k) + & + dudt(:,k)*(u(:,k)+dudt(:,k)*0.5_r8*dt) + & + dvdt(:,k)*(v(:,k)+dvdt(:,k)*0.5_r8*dt) ) + end do + +end subroutine energy_change + +!========================================================================== + +! Subtract change in energy from the heating tendency in the levels below +! the gravity wave region. +subroutine energy_fixer(tend_level, p, de, ttgw) + + ! Bottom stress level. + integer, intent(in) :: tend_level(:) + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + ! Change in energy. + real(r8), intent(in) :: de(:) + ! Heating tendency. + real(r8), intent(inout) :: ttgw(:,:) + + ! Column/level indices. + integer :: i, k + ! Energy change to apply divided by all the mass it is spread across. + real(r8) :: de_dm(size(tend_level)) + + do i = 1, size(tend_level) + de_dm(i) = -de(i)*gravit/(p%ifc(i,pver+1)-p%ifc(i,tend_level(i)+1)) + end do + + ! Subtract net gain/loss of total energy below tend_level. + do k = minval(tend_level)+1, pver + where (k > tend_level) + ttgw(:,k) = ttgw(:,k) + de_dm + end where + end do + +end subroutine energy_fixer + +!========================================================================== + +! Calculates absolute value of the local Coriolis frequency divided by the +! spatial frequency kwv, which gives a characteristic speed in m/s. +function coriolis_speed(band, lat) + ! Inertial gravity wave lengths. + type(GWBand), intent(in) :: band + ! Latitude in radians. + real(r8), intent(in) :: lat(:) + + real(r8) :: coriolis_speed(size(lat)) + + ! 24*3600 = 86400 seconds in a day. + real(r8), parameter :: omega_earth = 2._r8*pi/86400._r8 + + coriolis_speed = abs(sin(lat) * 2._r8 * omega_earth / band%kwv) + +end function coriolis_speed + +!========================================================================== + +subroutine adjust_inertial(band, tend_level, & + u_coriolis, c, ubi, tau, ro_adjust) + ! Inertial gravity wave lengths. + type(GWBand), intent(in) :: band + ! Levels above which tau is calculated. + integer, intent(in) :: tend_level(:) + ! Absolute value of the Coriolis frequency for each column, + ! divided by kwv [m/s]. + real(r8), intent(in) :: u_coriolis(:) + ! Wave propagation speed. + real(r8), intent(in) :: c(:,-band%ngwv:) + ! Wind speed in the direction of wave propagation. + real(r8), intent(in) :: ubi(:,:) + + ! Tau will be adjusted by blocking wave propagation through cells where + ! the Coriolis effect prevents it. + real(r8), intent(inout) :: tau(:,-band%ngwv:,:) + ! Dimensionless Coriolis term used to reduce gravity wave strength. + ! Equal to max(0, 1 - (1/ro)^2), where ro is the Rossby number of the + ! wind with respect to inertial waves. + real(r8), intent(out) :: ro_adjust(:,-band%ngwv:,:) + + ! Column/level/wavenumber indices. + integer :: i, k, l + + ! For each column and wavenumber, are we clear of levels that block + ! upward propagation? + logical :: unblocked_mask(size(tend_level),-band%ngwv:band%ngwv) + + unblocked_mask = .true. + ro_adjust = 0._r8 + + ! Iterate from the bottom up, through every interface level where tau is + ! set. + do k = maxval(tend_level)+1, ktop, -1 + do l = -band%ngwv, band%ngwv + do i = 1, size(tend_level) + ! Only operate on valid levels for this column. + if (k <= tend_level(i) + 1) then + ! Block waves if Coriolis is too strong. + ! By setting the mask in this way, we avoid division by zero. + unblocked_mask(i,l) = unblocked_mask(i,l) .and. & + (abs(ubi(i,k) - c(i,l)) > u_coriolis(i)) + if (unblocked_mask(i,l)) then + ro_adjust(i,l,k) = & + 1._r8 - (u_coriolis(i)/(ubi(i,k)-c(i,l)))**2 + else + tau(i,l,k) = 0._r8 + end if + end if + end do + end do + end do + +end subroutine adjust_inertial + +end module gw_common diff --git a/src/physics/cam/gw_convect.F90 b/src/physics/cam/gw_convect.F90 new file mode 100644 index 0000000000..09ca64a016 --- /dev/null +++ b/src/physics/cam/gw_convect.F90 @@ -0,0 +1,327 @@ +module gw_convect + +! +! This module handles gravity waves from convection, and was extracted from +! gw_drag in May 2013. +! + +use gw_utils, only: r8 + +implicit none +private +save + +public :: BeresSourceDesc +public :: gw_beres_src + +type :: BeresSourceDesc + ! Whether wind speeds are shifted to be relative to storm cells. + logical :: storm_shift + ! Index for level where wind speed is used as the source speed. + integer :: k + ! Heating depths below this value [m] will be ignored. + real(r8) :: min_hdepth + ! Table bounds, for convenience. (Could be inferred from shape(mfcc).) + integer :: maxh + integer :: maxuh + ! Heating depths [m]. + real(r8), allocatable :: hd(:) + ! Table of source spectra. + real(r8), allocatable :: mfcc(:,:,:) +end type BeresSourceDesc + +contains + +!========================================================================== + +subroutine gw_beres_src(ncol, band, desc, u, v, & + netdt, zm, src_level, tend_level, tau, ubm, ubi, xv, yv, & + c, hdepth, maxq0) +!----------------------------------------------------------------------- +! Driver for multiple gravity wave drag parameterization. +! +! The parameterization is assumed to operate only where water vapor +! concentrations are negligible in determining the density. +! +! Beres, J.H., M.J. Alexander, and J.R. Holton, 2004: "A method of +! specifying the gravity wave spectrum above convection based on latent +! heating properties and background wind". J. Atmos. Sci., Vol 61, No. 3, +! pp. 324-337. +! +!----------------------------------------------------------------------- + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp + use gw_common, only: GWBand, pver, qbo_hdepth_scaling + +!------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + + ! Wavelengths triggered by convection. + type(GWBand), intent(in) :: band + + ! Settings for convection type (e.g. deep vs shallow). + type(BeresSourceDesc), intent(in) :: desc + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + + ! Heating depth [m] and maximum heating in each column. + real(r8), intent(out) :: hdepth(ncol), maxq0(ncol) + +!---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + ! Zonal/meridional wind at roughly the level where the convection occurs. + real(r8) :: uconv(ncol), vconv(ncol) + + ! Maximum heating rate. + real(r8) :: q0(ncol) + + ! Bottom/top heating range index. + integer :: boti(ncol), topi(ncol) + ! Index for looking up heating depth dimension in the table. + integer :: hd_idx(ncol) + ! Mean wind in heating region. + real(r8) :: uh(ncol) + ! Min/max wavenumber for critical level filtering. + integer :: Umini(ncol), Umaxi(ncol) + ! Source level tau for a column. + real(r8) :: tau0(-band%ngwv:band%ngwv) + ! Speed of convective cells relative to storm. + real(r8) :: CS(ncol) + ! Index to shift spectra relative to ground. + integer :: shift + + ! Heating rate conversion factor. + real(r8), parameter :: CF = 20._r8 + ! Averaging length. + real(r8), parameter :: AL = 1.0e5_r8 + + !---------------------------------------------------------------------- + ! Initialize tau array + !---------------------------------------------------------------------- + + tau = 0.0_r8 + hdepth = 0.0_r8 + q0 = 0.0_r8 + tau0 = 0.0_r8 + + !------------------------------------------------------------------------ + ! Determine wind and unit vectors approximately at the source level, then + ! project winds. + !------------------------------------------------------------------------ + + ! Source wind speed and direction. + uconv = u(:,desc%k) + vconv = v(:,desc%k) + + ! Get the unit vector components and magnitude at the source level. + call get_unit_vector(uconv, vconv, xv, yv, ubi(:,desc%k+1)) + + ! Project the local wind at midpoints onto the source wind. + do k = 1, pver + ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv) + end do + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:pver) = midpoint_interp(ubm) + + !----------------------------------------------------------------------- + ! Calculate heating depth. + ! + ! Heating depth is defined as the first height range from the bottom in + ! which heating rate is continuously positive. + !----------------------------------------------------------------------- + + ! First find the indices for the top and bottom of the heating range. + boti = 0 + topi = 0 + do k = pver, 1, -1 + do i = 1, ncol + if (boti(i) == 0) then + ! Detect if we are outside the maximum range (where z = 20 km). + if (zm(i,k) >= 20000._r8) then + boti(i) = k + topi(i) = k + else + ! First spot where heating rate is positive. + if (netdt(i,k) > 0.0_r8) boti(i) = k + end if + else if (topi(i) == 0) then + ! Detect if we are outside the maximum range (z = 20 km). + if (zm(i,k) >= 20000._r8) then + topi(i) = k + else + ! First spot where heating rate is no longer positive. + if (.not. (netdt(i,k) > 0.0_r8)) topi(i) = k + end if + end if + end do + ! When all done, exit. + if (all(topi /= 0)) exit + end do + + ! Heating depth in m. + hdepth = [ ( (zm(i,topi(i))-zm(i,boti(i))), i = 1, ncol ) ] + + ! J. Richter: this is an effective reduction of the GW phase speeds (needed to drive the QBO) + hdepth = hdepth*qbo_hdepth_scaling + + hd_idx = index_of_nearest(hdepth, desc%hd) + + ! hd_idx=0 signals that a heating depth is too shallow, i.e. that it is + ! either not big enough for the lowest table entry, or it is below the + ! minimum allowed for this convection type. + ! Values above the max in the table still get the highest value, though. + where (hdepth < max(desc%min_hdepth, desc%hd(1))) hd_idx = 0 + + ! Maximum heating rate. + do k = minval(topi), maxval(boti) + where (k >= topi .and. k <= boti) + q0 = max(q0, netdt(:,k)) + end where + end do + + !output max heating rate in K/day + maxq0 = q0*24._r8*3600._r8 + + ! Multipy by conversion factor + q0 = q0 * CF + + if (desc%storm_shift) then + + ! Find the cell speed where the storm speed is > 10 m/s. + ! Storm speed is taken to be the source wind speed. + CS = sign(max(abs(ubm(:,desc%k))-10._r8, 0._r8), ubm(:,desc%k)) + + ! Average wind in heating region, relative to storm cells. + uh = 0._r8 + do k = minval(topi), maxval(boti) + where (k >= topi .and. k <= boti) + uh = uh + ubm(:,k)/(boti-topi+1) + end where + end do + + uh = uh - CS + + else + + ! For shallow convection, wind is relative to ground, and "heating + ! region" wind is just the source level wind. + uh = ubm(:,desc%k) + + end if + + ! Limit uh to table range. + uh = min(uh, real(desc%maxuh, r8)) + uh = max(uh, -real(desc%maxuh, r8)) + + ! Speeds for critical level filtering. + Umini = band%ngwv + Umaxi = -band%ngwv + do k = minval(topi), maxval(boti) + where (k >= topi .and. k <= boti) + Umini = min(Umini, nint(ubm(:,k)/band%dc)) + Umaxi = max(Umaxi, nint(ubm(:,k)/band%dc)) + end where + end do + + Umini = max(Umini, -band%ngwv) + Umaxi = min(Umaxi, band%ngwv) + + !----------------------------------------------------------------------- + ! Gravity wave sources + !----------------------------------------------------------------------- + ! Start loop over all columns. + !----------------------------------------------------------------------- + do i=1,ncol + + !--------------------------------------------------------------------- + ! Look up spectrum only if the heating depth is large enough, else set + ! tau0 = 0. + !--------------------------------------------------------------------- + + if (hd_idx(i) > 0) then + + !------------------------------------------------------------------ + ! Look up the spectrum using depth and uh. + !------------------------------------------------------------------ + + tau0 = desc%mfcc(hd_idx(i),nint(uh(i)),:) + + if (desc%storm_shift) then + ! For deep convection, the wind was relative to storm cells, so + ! shift the spectrum so that it is now relative to the ground. + shift = -nint(CS(i)/band%dc) + tau0 = eoshift(tau0, shift) + end if + + ! Adjust magnitude. + tau0 = tau0*q0(i)*q0(i)/AL + + ! Adjust for critical level filtering. + tau0(Umini(i):Umaxi(i)) = 0.0_r8 + + tau(i,:,topi(i)+1) = tau0 + + end if ! heating depth above min and not at the pole + + enddo + + !----------------------------------------------------------------------- + ! End loop over all columns. + !----------------------------------------------------------------------- + + ! Output the source level. + src_level = topi + tend_level = topi + + ! Set phase speeds; just use reference speeds. + c = spread(band%cref, 1, ncol) + +end subroutine gw_beres_src + +! Short routine to get the indices of a set of values rounded to their +! nearest points on a grid. +function index_of_nearest(x, grid) result(idx) + real(r8), intent(in) :: x(:) + real(r8), intent(in) :: grid(:) + + integer :: idx(size(x)) + + real(r8) :: interfaces(size(grid)-1) + integer :: i, n + + n = size(grid) + interfaces = (grid(:n-1) + grid(2:))/2._r8 + + idx = 1 + do i = 1, n-1 + where (x > interfaces(i)) idx = i + 1 + end do + +end function index_of_nearest + +end module gw_convect diff --git a/src/physics/cam/gw_diffusion.F90 b/src/physics/cam/gw_diffusion.F90 new file mode 100644 index 0000000000..fc509e8bd4 --- /dev/null +++ b/src/physics/cam/gw_diffusion.F90 @@ -0,0 +1,192 @@ +module gw_diffusion + +! +! This module contains code computing the effective diffusion of +! constituents and dry static energy due to gravity wave breaking. +! + +use gw_utils, only: r8 +use linear_1d_operators, only: TriDiagDecomp + +implicit none +private +save + +public :: gw_ediff +public :: gw_diff_tend + +contains + +!========================================================================== + +subroutine gw_ediff(ncol, pver, ngwv, kbot, ktop, tend_level, & + gwut, ubm, nm, rho, dt, prndl, gravit, p, c, & + egwdffi, decomp, ro_adjust) +! +! Calculate effective diffusivity associated with GW forcing. +! +! Author: F. Sassi, Jan 31, 2001 +! + use gw_utils, only: midpoint_interp + use coords_1d, only: Coords1D + use vdiff_lu_solver, only: fin_vol_lu_decomp + +!-------------------------------Input Arguments---------------------------- + + ! Column, level, and gravity wave spectrum dimensions. + integer, intent(in) :: ncol, pver, ngwv + ! Bottom and top levels to operate on. + integer, intent(in) :: kbot, ktop + ! Per-column bottom index where tendencies are applied. + integer, intent(in) :: tend_level(ncol) + ! GW zonal wind tendencies at midpoint. + real(r8), intent(in) :: gwut(ncol,pver,-ngwv:ngwv) + ! Projection of wind at midpoints. + real(r8), intent(in) :: ubm(ncol,pver) + ! Brunt-Vaisalla frequency. + real(r8), intent(in) :: nm(ncol,pver) + + ! Density at interfaces. + real(r8), intent(in) :: rho(ncol,pver+1) + ! Time step. + real(r8), intent(in) :: dt + ! Inverse Prandtl number. + real(r8), intent(in) :: prndl + ! Acceleration due to gravity. + real(r8), intent(in) :: gravit + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + ! Wave phase speeds for each column. + real(r8), intent(in) :: c(ncol,-ngwv:ngwv) + + ! Adjustment parameter for IGWs. + real(r8), intent(in), optional :: & + ro_adjust(ncol,-ngwv:ngwv,pver+1) + +!-----------------------------Output Arguments----------------------------- + ! Effective gw diffusivity at interfaces. + real(r8), intent(out) :: egwdffi(ncol,pver+1) + ! LU decomposition. + type(TriDiagDecomp), intent(out) :: decomp + +!-----------------------------Local Workspace------------------------------ + + ! Effective gw diffusivity at midpoints. + real(r8) :: egwdffm(ncol,pver) + ! Temporary used to hold gw_diffusivity for one level and wavenumber. + real(r8) :: egwdff_lev(ncol) + ! (dp/dz)^2 == (gravit*rho)^2 + real(r8) :: dpidz_sq(ncol,pver+1) + ! Level and wave indices. + integer :: k, l + + ! Density scale height. + real(r8), parameter :: dscale=7000._r8 + +!-------------------------------------------------------------------------- + + egwdffi = 0._r8 + egwdffm = 0._r8 + + ! Calculate effective diffusivity at midpoints. + do l = -ngwv, ngwv + do k = ktop, kbot + + egwdff_lev = & + prndl * 0.5_r8 * gwut(:,k,l) * (c(:,l)-ubm(:,k)) / nm(:,k)**2 + + ! IGWs need ro_adjust factor. + if (present(ro_adjust)) then + egwdff_lev = egwdff_lev * ro_adjust(:,l,k)**2 + end if + + egwdffm(:,k) = egwdffm(:,k) + egwdff_lev + + end do + end do + + + ! Interpolate effective diffusivity to interfaces. + ! Assume zero at top and bottom interfaces. + egwdffi(:,ktop+1:kbot) = midpoint_interp(egwdffm(:,ktop:kbot)) + + ! Do not calculate diffusivities below level where tendencies are + ! actually allowed. + do k = ktop+1, kbot + where (k > tend_level) egwdffi(:,k) = 0.0_r8 + enddo + + ! Calculate (dp/dz)^2. + dpidz_sq = rho*gravit + dpidz_sq = dpidz_sq*dpidz_sq + + ! Decompose the diffusion matrix. + decomp = fin_vol_lu_decomp(dt, p%section([1,ncol],[ktop,kbot]), & + coef_q_diff=egwdffi(:,ktop:kbot+1)*dpidz_sq(:,ktop:kbot+1)) + +end subroutine gw_ediff + +!========================================================================== + +subroutine gw_diff_tend(ncol, pver, kbot, ktop, q, dt, decomp, dq) + +! +! Calculates tendencies from effective diffusion due to gravity wave +! breaking. +! +! Method: +! A constituent flux on interfaces is given by: +! +! rho * (w'q') = rho * Deff qz +! +! where (all evaluated on interfaces): +! +! rho = density +! qz = constituent vertical gradient +! Deff = effective diffusivity +! +! An effective diffusivity is calculated by adding up the diffusivities +! from all waves (see gw_ediff). The tendency is calculated by invoking LU +! decomposition and solving as for a regular diffusion equation. +! +! Author: Sassi - Jan 2001 +!-------------------------------------------------------------------------- + +!---------------------------Input Arguments-------------------------------- + + ! Column and level dimensions. + integer, intent(in) :: ncol, pver + ! Bottom and top levels to operate on. + integer, intent(in) :: kbot, ktop + + ! Constituent to diffuse. + real(r8), intent(in) :: q(ncol,pver) + ! Time step. + real(r8), intent(in) :: dt + + ! LU decomposition. + type(TriDiagDecomp), intent(in) :: decomp + +!--------------------------Output Arguments-------------------------------- + + ! Constituent tendencies. + real(r8), intent(out) :: dq(ncol,pver) + +!--------------------------Local Workspace--------------------------------- + + ! Temporary storage for constituent. + real(r8) :: qnew(ncol,pver) + +!-------------------------------------------------------------------------- + + dq = 0.0_r8 + qnew = q + + call decomp%left_div(qnew(:,ktop:kbot)) + + ! Evaluate tendency to be reported back. + dq = (qnew-q) / dt + +end subroutine gw_diff_tend + +end module gw_diffusion diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 new file mode 100644 index 0000000000..a3d3a83573 --- /dev/null +++ b/src/physics/cam/gw_drag.F90 @@ -0,0 +1,2500 @@ +module gw_drag + +!-------------------------------------------------------------------------- +! CAM and WACCM gravity wave parameterizations were merged by Sean Patrick +! Santos in Summer 2013, and at the same time, gw_drag was split into +! various modules. This is the CAM interface and driver module. The below +! notes are for the old CAM and WACCM versions of gw_drag. +!-------------------------------------------------------------------------- +! This file came from wa17 and was modified by Fabrizio: 07-02-2004 +! Standard gw_drag with modification (6) of latitude profile of gw spectrum +!-------------------------------------------------------------------------- +! Purpose: +! +! Module to compute the forcing due to parameterized gravity waves. Both an +! orographic and an internal source spectrum are considered. +! +! Author: Byron Boville +! +!-------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl + use shr_log_mod, only: errMsg => shr_log_errMsg + use shr_assert_mod, only: shr_assert + + use ppgrid, only: pcols, pver, begchunk, endchunk + use constituents, only: pcnst + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use spmd_utils, only: masterproc + use cam_history, only: outfld + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + use ref_pres, only: do_molec_diff, nbot_molec + use physconst, only: cpair + + ! These are the actual switches for different gravity wave sources. + use phys_control, only: use_gw_oro, use_gw_front, use_gw_front_igw, & + use_gw_convect_dp, use_gw_convect_sh, & + use_simple_phys + + use gw_common, only: GWBand + use gw_convect, only: BeresSourceDesc + use gw_front, only: CMSourceDesc + +! Typical module header + implicit none + private + save + +! +! PUBLIC: interfaces +! + public :: gw_drag_readnl ! Read namelist + public :: gw_init ! Initialization + public :: gw_tend ! interface to actual parameterization + +! +! PRIVATE: Rest of the data and interfaces are private to this module +! + real(r8), parameter :: unset_r8 = huge(1._r8) + + ! A mid-scale "band" with only stationary waves (l = 0). + type(GWBand) :: band_oro + ! Medium scale waves. + type(GWBand) :: band_mid + ! Long scale waves for IGWs. + type(GWBand) :: band_long + + ! Top level for gravity waves. + integer, parameter :: ktop = 1 + ! Bottom level for frontal waves. + integer :: kbot_front + + ! Factor for SH orographic waves. + real(r8) :: gw_oro_south_fac = 1._r8 + + ! Frontogenesis function critical threshold. + real(r8) :: frontgfc = unset_r8 + + ! Tendency efficiencies. + + ! Ridge scheme. + logical :: use_gw_rdg_beta = .false. + integer :: n_rdg_beta = 1 + real(r8) :: effgw_rdg_beta = unset_r8 + real(r8) :: effgw_rdg_beta_max = unset_r8 + real(r8) :: rdg_beta_cd_llb = unset_r8 ! Low-level obstacle drag coefficient Ridge scheme. + logical :: trpd_leewv_rdg_beta = .false. + + logical :: use_gw_rdg_gamma = .false. + integer :: n_rdg_gamma = -1 + real(r8) :: effgw_rdg_gamma = unset_r8 + real(r8) :: effgw_rdg_gamma_max = unset_r8 + real(r8) :: rdg_gamma_cd_llb = unset_r8 + logical :: trpd_leewv_rdg_gamma = .false. + character(len=cl) :: bnd_rdggm = 'bnd_rdggm' ! full pathname for meso-Gamma ridge dataset + + ! Orography. + real(r8) :: effgw_oro = unset_r8 + ! C&M scheme. + real(r8) :: effgw_cm = unset_r8 + ! C&M scheme (inertial waves). + real(r8) :: effgw_cm_igw = unset_r8 + ! Beres (deep convection). + real(r8) :: effgw_beres_dp = unset_r8 + ! Beres (shallow convection). + real(r8) :: effgw_beres_sh = unset_r8 + + ! Horzontal wavelengths [m]. + real(r8), parameter :: wavelength_mid = 1.e5_r8 + real(r8), parameter :: wavelength_long = 3.e5_r8 + + ! Background stress source strengths. + real(r8) :: taubgnd = unset_r8 + real(r8) :: taubgnd_igw = unset_r8 + + ! Whether or not to use a polar taper for frontally generated waves. + logical :: gw_polar_taper = .false. + + ! Whether or not to enforce an upper boundary condition of tau = 0. + ! (Like many variables, this is only here to hold the value between + ! the readnl phase and the init phase of the CAM physics; only gw_common + ! should actually use it.) + logical :: tau_0_ubc = .false. + + ! Whether or not to limit tau *before* applying any efficiency factors. + logical :: gw_limit_tau_without_eff = .false. + + ! Whether or not to apply tendency max + logical :: gw_apply_tndmax = .true. + + ! Files to read Beres source spectra from. + character(len=256) :: gw_drag_file = "" + character(len=256) :: gw_drag_file_sh = "" + + ! Beres settings and table. + type(BeresSourceDesc) :: beres_dp_desc + type(BeresSourceDesc) :: beres_sh_desc + + ! Width of gaussian used to create frontogenesis tau profile [m/s]. + real(r8), parameter :: front_gaussian_width = 30._r8 + + ! Frontogenesis wave settings. + type(CMSourceDesc) :: cm_desc + type(CMSourceDesc) :: cm_igw_desc + + ! Indices into pbuf + integer :: kvt_idx = -1 + integer :: ttend_dp_idx = -1 + integer :: ttend_sh_idx = -1 + integer :: frontgf_idx = -1 + integer :: frontga_idx = -1 + integer :: sgh_idx = -1 + + ! anisotropic ridge fields + integer, parameter :: prdg = 16 + + real(r8), allocatable, dimension(:,:), target :: & + rdg_gbxar + + ! Meso Beta + real(r8), allocatable, dimension(:,:,:), target :: & + rdg_hwdth, & + rdg_clngt, & + rdg_mxdis, & + rdg_anixy, & + rdg_angll + + ! Meso Gamma + real(r8), allocatable, dimension(:,:,:), target :: & + rdg_hwdthg, & + rdg_clngtg, & + rdg_mxdisg, & + rdg_anixyg, & + rdg_angllg + + ! Water constituent indices for budget + integer :: ixcldliq = -1 + integer :: ixcldice = -1 + + ! Prefixes for history field names + character(len=1), parameter :: cm_pf = " " + character(len=1), parameter :: cm_igw_pf = "I" + character(len=1), parameter :: beres_dp_pf = "B" + character(len=1), parameter :: beres_sh_pf = "S" + + ! namelist + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: gw_lndscl_sgh = .true. ! scale SGH by land frac + real(r8) :: gw_prndl = 0.25_r8 + real(r8) :: gw_qbo_hdepth_scaling = 1._r8 ! heating depth scaling factor + +!========================================================================== +contains +!========================================================================== + +subroutine gw_drag_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, & + mpi_character, mpi_logical, mpi_integer + use gw_rdg, only: gw_rdg_readnl + + ! File containing namelist input. + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'gw_drag_readnl' + + ! Maximum wave number and width of spectrum bins. + integer :: pgwv = -1 + real(r8) :: gw_dc = unset_r8 + integer :: pgwv_long = -1 + real(r8) :: gw_dc_long = unset_r8 + + ! fcrit2 for the mid-scale waves has been made a namelist variable to + ! facilitate backwards compatibility with the CAM3 version of this + ! parameterization. In CAM3, fcrit2=0.5. + real(r8) :: fcrit2 = unset_r8 ! critical froude number squared + + namelist /gw_drag_nl/ pgwv, gw_dc, pgwv_long, gw_dc_long, tau_0_ubc, & + effgw_beres_dp, effgw_beres_sh, effgw_cm, effgw_cm_igw, effgw_oro, & + fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, taubgnd, & + taubgnd_igw, gw_polar_taper, & + use_gw_rdg_beta, n_rdg_beta, effgw_rdg_beta, effgw_rdg_beta_max, & + rdg_beta_cd_llb, trpd_leewv_rdg_beta, & + use_gw_rdg_gamma, n_rdg_gamma, effgw_rdg_gamma, effgw_rdg_gamma_max, & + rdg_gamma_cd_llb, trpd_leewv_rdg_gamma, bnd_rdggm, & + gw_oro_south_fac, gw_limit_tau_without_eff, & + gw_lndscl_sgh, gw_prndl, gw_apply_tndmax, gw_qbo_hdepth_scaling + !---------------------------------------------------------------------- + + if (use_simple_phys) return + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'gw_drag_nl', status=ierr) + if (ierr == 0) then + read(unitn, gw_drag_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(pgwv, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: pgwv") + call mpi_bcast(gw_dc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_dc") + call mpi_bcast(pgwv_long, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: pgwv_long") + call mpi_bcast(gw_dc_long, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_dc_long") + call mpi_bcast(tau_0_ubc, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: tau_0_ubc") + call mpi_bcast(effgw_beres_dp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_beres_dp") + call mpi_bcast(effgw_beres_sh, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_beres_sh") + call mpi_bcast(effgw_cm, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_cm") + call mpi_bcast(effgw_cm_igw, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_cm_igw") + call mpi_bcast(effgw_oro, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_oro") + + call mpi_bcast(use_gw_rdg_beta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_gw_rdg_beta") + call mpi_bcast(n_rdg_beta, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: n_rdg_beta") + call mpi_bcast(effgw_rdg_beta, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_rdg_beta") + call mpi_bcast(effgw_rdg_beta_max, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_rdg_beta_max") + call mpi_bcast(rdg_beta_cd_llb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rdg_beta_cd_llb") + call mpi_bcast(trpd_leewv_rdg_beta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: trpd_leewv_rdg_beta") + + call mpi_bcast(use_gw_rdg_gamma, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_gw_rdg_gamma") + call mpi_bcast(n_rdg_gamma, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: n_rdg_gamma") + call mpi_bcast(effgw_rdg_gamma, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_rdg_gamma") + call mpi_bcast(effgw_rdg_gamma_max, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_rdg_gamma_max") + call mpi_bcast(rdg_gamma_cd_llb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rdg_gamma_cd_llb") + call mpi_bcast(trpd_leewv_rdg_gamma, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: trpd_leewv_rdg_gamma") + call mpi_bcast(bnd_rdggm, len(bnd_rdggm), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: bnd_rdggm") + + call mpi_bcast(gw_oro_south_fac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_oro_south_fac") + call mpi_bcast(fcrit2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fcrit2") + call mpi_bcast(frontgfc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frontgfc") + call mpi_bcast(taubgnd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: taubgnd") + call mpi_bcast(taubgnd_igw, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: taubgnd_igw") + + call mpi_bcast(gw_polar_taper, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_polar_taper") + call mpi_bcast(gw_limit_tau_without_eff, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_limit_tau_without_eff") + call mpi_bcast(gw_apply_tndmax, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_apply_tndmax") + call mpi_bcast(gw_lndscl_sgh, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_lndscl_sgh") + call mpi_bcast(gw_prndl, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_prndl") + call mpi_bcast(gw_qbo_hdepth_scaling, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_qbo_hdepth_scaling") + + call mpi_bcast(gw_drag_file, len(gw_drag_file), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file") + call mpi_bcast(gw_drag_file_sh, len(gw_drag_file_sh), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file_sh") + + + ! Check if fcrit2 was set. + call shr_assert(fcrit2 /= unset_r8, & + "gw_drag_readnl: fcrit2 must be set via the namelist."// & + errMsg(__FILE__, __LINE__)) + + ! Check if pgwv was set. + call shr_assert(pgwv >= 0, & + "gw_drag_readnl: pgwv must be set via the namelist and & + &non-negative."// & + errMsg(__FILE__, __LINE__)) + + ! Check if gw_dc was set. + call shr_assert(gw_dc /= unset_r8, & + "gw_drag_readnl: gw_dc must be set via the namelist."// & + errMsg(__FILE__, __LINE__)) + + band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) + band_mid = GWBand(pgwv, gw_dc, 1.0_r8, wavelength_mid) + band_long = GWBand(pgwv_long, gw_dc_long, 1.0_r8, wavelength_long) + + if (use_gw_rdg_gamma .or. use_gw_rdg_beta) then + call gw_rdg_readnl(nlfile) + end if + +end subroutine gw_drag_readnl + +!========================================================================== + +subroutine gw_init() + !----------------------------------------------------------------------- + ! Time independent initialization for multiple gravity wave + ! parameterization. + !----------------------------------------------------------------------- + + use cam_history, only: addfld, add_default, horiz_only + use cam_history, only: register_vector_field + use interpolate_data, only: lininterp + use phys_control, only: phys_getopts + use physics_buffer, only: pbuf_get_index + use constituents, only: cnst_get_ind + + use cam_initfiles, only: topo_file_get_id + + ! temporary for restart with ridge scheme + use cam_initfiles, only: bnd_topo + + use cam_pio_utils, only: cam_pio_openfile + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + use pio, only: file_desc_t, pio_nowrite, pio_closefile + use ncdio_atm, only: infld + use ioFileMod, only: getfil + + use ref_pres, only: pref_edge + use physconst, only: gravit, rair, rearth + + use gw_common, only: gw_common_init + use gw_front, only: gaussian_cm_desc + + !---------------------------Local storage------------------------------- + + integer :: i, l, k + character(len=1) :: cn + + ! Index for levels at specific pressures. + integer :: kfront + + ! output tendencies and state variables for CAM4 temperature, + ! water vapor, cloud ice and cloud liquid budgets. + logical :: history_budget + ! output history file number for budget fields + integer :: history_budget_histfile_num + ! output variables of interest in WACCM runs + logical :: history_waccm + + ! Interpolated Newtonian cooling coefficients. + real(r8) :: alpha(pver+1) + + ! Levels of pre-calculated Newtonian cooling (1/day). + ! The following profile is digitized from: + ! Wehrbein and Leovy (JAS, 39, 1532-1544, 1982) figure 5 + + integer, parameter :: nalph = 71 + real(r8) :: alpha0(nalph) = [ & + 0.1_r8, 0.1_r8, 0.1_r8, 0.1_r8, & + 0.1_r8, 0.1_r8, 0.1_r8, 0.1_r8, & + 0.1_r8, 0.1_r8, 0.10133333_r8, 0.104_r8, & + 0.108_r8, 0.112_r8, 0.116_r8, 0.12066667_r8, & + 0.126_r8, 0.132_r8, 0.138_r8, 0.144_r8, & + 0.15133333_r8, 0.16_r8, 0.17_r8, 0.18_r8, & + 0.19_r8, 0.19933333_r8, 0.208_r8, 0.216_r8, & + 0.224_r8, 0.232_r8, 0.23466667_r8, 0.232_r8, & + 0.224_r8, 0.216_r8, 0.208_r8, 0.20133333_r8, & + 0.196_r8, 0.192_r8, 0.188_r8, 0.184_r8, & + 0.18266667_r8, 0.184_r8, 0.188_r8, 0.192_r8, & + 0.196_r8, 0.19333333_r8, 0.184_r8, 0.168_r8, & + 0.152_r8, 0.136_r8, 0.12133333_r8, 0.108_r8, & + 0.096_r8, 0.084_r8, 0.072_r8, 0.061_r8, & + 0.051_r8, 0.042_r8, 0.033_r8, 0.024_r8, & + 0.017666667_r8, 0.014_r8, 0.013_r8, 0.012_r8, & + 0.011_r8, 0.010333333_r8, 0.01_r8, 0.01_r8, & + 0.01_r8, 0.01_r8, 0.01_r8 & + ] + + ! Pressure levels that were used to calculate alpha0 (hPa). + real(r8) :: palph(nalph) = [ & + 2.06115E-06_r8, 2.74280E-06_r8, 3.64988E-06_r8, 4.85694E-06_r8, & + 6.46319E-06_r8, 8.60065E-06_r8, 1.14450E-05_r8, 1.52300E-05_r8, & + 2.02667E-05_r8, 2.69692E-05_r8, 3.58882E-05_r8, 4.77568E-05_r8, & + 6.35507E-05_r8, 8.45676E-05_r8, 0.000112535_r8, 0.000149752_r8, & + 0.000199277_r8, 0.000265180_r8, 0.000352878_r8, 0.000469579_r8, & + 0.000624875_r8, 0.000831529_r8, 0.00110653_r8, 0.00147247_r8, & + 0.00195943_r8, 0.00260744_r8, 0.00346975_r8, 0.00461724_r8, & + 0.00614421_r8, 0.00817618_r8, 0.0108801_r8, 0.0144783_r8, & + 0.0192665_r8, 0.0256382_r8, 0.0341170_r8, 0.0453999_r8, & + 0.0604142_r8, 0.0803939_r8, 0.106981_r8, 0.142361_r8, & + 0.189442_r8, 0.252093_r8, 0.335463_r8, 0.446404_r8, & + 0.594036_r8, 0.790490_r8, 1.05192_r8, 1.39980_r8, & + 1.86273_r8, 2.47875_r8, 3.29851_r8, 4.38936_r8, & + 5.84098_r8, 7.77266_r8, 10.3432_r8, 13.7638_r8, & + 18.3156_r8, 24.3728_r8, 32.4332_r8, 43.1593_r8, & + 57.4326_r8, 76.4263_r8, 101.701_r8, 135.335_r8, & + 180.092_r8, 239.651_r8, 318.907_r8, 424.373_r8, & + 564.718_r8, 751.477_r8, 1000._r8 & + ] + + ! Read data from file + type(file_desc_t), pointer :: fh_topo + type(file_desc_t) :: fh_rdggm + integer :: grid_id + character(len=8) :: dim1name, dim2name + logical :: found + character(len=256) :: bnd_rdggm_loc ! filepath of topo file on local disk + + ! Allow reporting of error messages. + character(len=128) :: errstring + character(len=*), parameter :: sub = 'gw_init' + + ! temporary workaround for restart w/ ridge scheme + character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + !----------------------------------------------------------------------- + + if (do_molec_diff) then + kvt_idx = pbuf_get_index('kvt') + end if + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) "GW_DRAG: band_mid%ngwv = ", band_mid%ngwv + do l = -band_mid%ngwv, band_mid%ngwv + write (iulog,'(A,I0,A,F7.2)') & + "GW_DRAG: band_mid%cref(",l,") = ",band_mid%cref(l) + enddo + write(iulog,*) 'GW_DRAG: band_mid%kwv = ', band_mid%kwv + write(iulog,*) 'GW_DRAG: band_mid%fcrit2 = ', band_mid%fcrit2 + write(iulog,*) ' ' + write(iulog,*) "GW_DRAG: band_long%ngwv = ", band_long%ngwv + do l = -band_long%ngwv, band_long%ngwv + write (iulog,'(A,I2,A,F7.2)') & + "GW_DRAG: band_long%cref(",l,") = ",band_long%cref(l) + enddo + write(iulog,*) 'GW_DRAG: band_long%kwv = ', band_long%kwv + write(iulog,*) 'GW_DRAG: band_long%fcrit2 = ', band_long%fcrit2 + write(iulog,*) ' ' + end if + + ! pre-calculated newtonian damping: + ! * convert to 1/s + ! * ensure it is not smaller than 1e-6 + ! * convert palph from hpa to pa + + do k=1,nalph + alpha0(k) = alpha0(k) / 86400._r8 + alpha0(k) = max(alpha0(k), 1.e-6_r8) + palph(k) = palph(k)*1.e2_r8 + end do + + ! interpolate to current vertical grid and obtain alpha + + call lininterp (alpha0 ,palph, nalph , alpha , pref_edge , pver+1) + if (masterproc) then + write (iulog,*) 'gw_init: newtonian damping (1/day):' + write (iulog,fmt='(a4,a12,a10)') ' k ',' pref_edge ', & + ' alpha ' + do k = 1, pver+1 + write (iulog,fmt='(i4,1e12.5,1f10.2)') k,pref_edge(k), & + alpha(k)*86400._r8 + end do + end if + + if (masterproc) then + write(iulog,*) 'KTOP =',ktop + end if + + ! Used to decide whether temperature tendencies should be output. + call phys_getopts( history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_waccm_out = history_waccm, & + history_amwg_out = history_amwg ) + + ! Initialize subordinate modules. + call gw_common_init(pver,& + tau_0_ubc, ktop, gravit, rair, alpha, gw_prndl, & + gw_qbo_hdepth_scaling, errstring ) + call shr_assert(trim(errstring) == "", "gw_common_init: "//errstring// & + errMsg(__FILE__, __LINE__)) + + if ( use_gw_oro ) then + + if (effgw_oro == unset_r8) then + call endrun("gw_drag_init: Orographic gravity waves enabled, & + &but effgw_oro was not set.") + end if + end if + + if (use_gw_oro .or. use_gw_rdg_beta .or. use_gw_rdg_gamma) then + + sgh_idx = pbuf_get_index('SGH') + + ! Declare history variables for orographic term + call addfld ('TAUAORO', (/ 'ilev' /), 'I','N/m2', & + 'Total stress from original OGW scheme') + call addfld ('TTGWORO', (/ 'lev' /), 'A','K/s', & + 'T tendency - orographic gravity wave drag') + call addfld ('TTGWSDFORO', (/ 'lev' /), 'A','K/s', & + 'T tendency - orographic gravity wave, diffusion.') + call addfld ('TTGWSKEORO', (/ 'lev' /), 'A','K/s', & + 'T tendency - orographic gravity wave, breaking KE.') + call addfld ('UTGWORO', (/ 'lev' /), 'A','m/s2', & + 'U tendency - orographic gravity wave drag') + call addfld ('VTGWORO', (/ 'lev' /), 'A','m/s2', & + 'V tendency - orographic gravity wave drag') + call register_vector_field('UTGWORO', 'VTGWORO') + call addfld ('TAUGWX', horiz_only, 'A','N/m2', & + 'Zonal gravity wave surface stress') + call addfld ('TAUGWY', horiz_only, 'A','N/m2', & + 'Meridional gravity wave surface stress') + + if (history_amwg) then + call add_default('TAUGWX ', 1, ' ') + call add_default('TAUGWY ', 1, ' ') + end if + + if (history_waccm) then + call add_default('UTGWORO ', 1, ' ') + call add_default('VTGWORO ', 1, ' ') + call add_default('TAUGWX ', 1, ' ') + call add_default('TAUGWY ', 1, ' ') + end if + + end if + + if (use_gw_rdg_beta .or. use_gw_rdg_gamma) then + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(sub//': ERROR: no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + end if + + if (use_gw_rdg_beta) then + + if (effgw_rdg_beta == unset_r8) then + call endrun(sub//": ERROR: Anisotropic OGW enabled, & + &but effgw_rdg_beta was not set.") + end if + + fh_topo => topo_file_get_id() + bnd_topo_loc = ' ' + if (.not. associated(fh_topo)) then + + ! Try to open topo file here. This workaround will not be needed + ! once the refactored initialization sequence is on trunk. + + allocate(fh_topo) + ! Error exit is from getfil if file not found. + call getfil(bnd_topo, bnd_topo_loc) + call cam_pio_openfile(fh_topo, bnd_topo_loc, PIO_NOWRITE) + + end if + + ! Get beta ridge data + allocate( & + rdg_gbxar(pcols,begchunk:endchunk), & + rdg_hwdth(pcols,prdg,begchunk:endchunk), & + rdg_clngt(pcols,prdg,begchunk:endchunk), & + rdg_mxdis(pcols,prdg,begchunk:endchunk), & + rdg_anixy(pcols,prdg,begchunk:endchunk), & + rdg_angll(pcols,prdg,begchunk:endchunk) ) + + call infld('GBXAR', fh_topo, dim1name, dim2name, 1, pcols, & + begchunk, endchunk, rdg_gbxar, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: GBXAR not found on topo file') + rdg_gbxar = rdg_gbxar * (rearth/1000._r8)*(rearth/1000._r8) ! transform to km^2 + + call infld('HWDTH', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_hwdth, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: HWDTH not found on topo file') + + call infld('CLNGT', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_clngt, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: CLNGT not found on topo file') + + call infld('MXDIS', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_mxdis, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: MXDIS not found on topo file') + + call infld('ANIXY', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_anixy, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: ANIXY not found on topo file') + + call infld('ANGLL', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_angll, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: ANGLL not found on topo file') + + ! close topo file only if it was opened here + if (len_trim(bnd_topo_loc) > 0) then + call pio_closefile(fh_topo) + end if + + call addfld('UEGW', (/ 'lev' /) , 'A' ,'1/s' , & + 'Zonal wind profile-entry to GW ' ) + call addfld('VEGW', (/ 'lev' /) , 'A' ,'1/s' , & + 'Merdional wind profile-entry to GW ' ) + call addfld('TEGW', (/ 'lev' /) , 'A' ,'K' , & + 'Temperature profile-entry to GW ' ) + + call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + call addfld('UBM1BETA', (/ 'lev' /) , 'A' ,'1/s' , & + 'On-ridge wind profile ' ) + call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m/s' , & + 'On-ridge wind tendency from ridge 1 ') + + do i = 1, 6 + write(cn, '(i1)') i + call addfld('TAU'//cn//'RDGBETAY' , (/ 'ilev' /), 'I', 'N/m2', & + 'Ridge based momentum flux profile') + call addfld('TAU'//cn//'RDGBETAX' , (/ 'ilev' /), 'I', 'N/m2', & + 'Ridge based momentum flux profile') + call addfld('UT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + 'U wind tendency from ridge '//cn) + call addfld('VT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + 'V wind tendency from ridge '//cn) + end do + + call addfld('TAUARDGBETAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + call addfld('TAUARDGBETAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + + if (history_waccm) then + call add_default('TAUARDGBETAX', 1, ' ') + call add_default('TAUARDGBETAY ', 1, ' ') + end if + + end if + + if (use_gw_rdg_gamma) then + + if (effgw_rdg_gamma == unset_r8) then + call endrun(sub//": ERROR: Anisotropic OGW enabled, but effgw_rdg_gamma was not set.") + end if + + call getfil(bnd_rdggm, bnd_rdggm_loc, iflag=1, lexist=found) + if (found) then + call cam_pio_openfile(fh_rdggm, bnd_rdggm_loc, PIO_NOWRITE) + else + call endrun(sub//': ERROR: file for gamma ridges not found: bnd_rdggm='// & + trim(bnd_rdggm)) + end if + + if (.not. allocated(rdg_gbxar)) then + allocate(rdg_gbxar(pcols,begchunk:endchunk)) + call infld('GBXAR', fh_rdggm, dim1name, dim2name, 1, pcols, & + begchunk, endchunk, rdg_gbxar, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: GBXAR not found on bnd_rdggm') + rdg_gbxar = rdg_gbxar * (rearth/1000._r8)*(rearth/1000._r8) ! transform to km^2 + end if + + ! Get meso-gamma ridge data + allocate( & + rdg_hwdthg(pcols,prdg,begchunk:endchunk), & + rdg_clngtg(pcols,prdg,begchunk:endchunk), & + rdg_mxdisg(pcols,prdg,begchunk:endchunk), & + rdg_anixyg(pcols,prdg,begchunk:endchunk), & + rdg_angllg(pcols,prdg,begchunk:endchunk) ) + + call infld('HWDTH', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_hwdthg, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: HWDTH not found on bnd_rdggm') + + call infld('CLNGT', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_clngtg, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: CLNGT not found on bnd_rdggm') + + call infld('MXDIS', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_mxdisg, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: MXDIS not found on bnd_rdggm') + + call infld('ANIXY', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_anixyg, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: ANIXY not found on bnd_rdggm') + + call infld('ANGLL', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & + 1, prdg, begchunk, endchunk, rdg_angllg, found, gridname='physgrid') + if (.not. found) call endrun(sub//': ERROR: ANGLL not found on bnd_rdggm') + + call pio_closefile(fh_rdggm) + + call addfld ('TAU1RDGGAMMAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + call addfld ('UBM1GAMMA', (/ 'lev' /) , 'A' ,'1/s' , & + 'On-ridge wind profile ' ) + call addfld ('UBT1RDGGAMMA' , (/ 'lev' /) , 'I' ,'m/s' , & + 'On-ridge wind tendency from ridge 1 ') + + do i = 1, 6 + write(cn, '(i1)') i + call addfld('TAU'//cn//'RDGGAMMAY', (/ 'ilev' /), 'I', 'N/m2', & + 'Ridge based momentum flux profile') + call addfld('TAU'//cn//'RDGGAMMAX', (/ 'ilev' /), 'I', 'N/m2', & + 'Ridge based momentum flux profile') + call addfld('UT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + 'U wind tendency from ridge '//cn) + call addfld('VT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + 'V wind tendency from ridge '//cn) + end do + + call addfld ('TAUARDGGAMMAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + call addfld ('TAUARDGGAMMAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + 'Ridge based momentum flux profile') + call addfld ('TAURDGGMX', horiz_only, 'A','N/m2', & + 'Zonal gravity wave surface stress') + call addfld ('TAURDGGMY', horiz_only, 'A','N/m2', & + 'Meridional gravity wave surface stress') + call addfld ('UTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + 'U wind tendency from ridge 6 ') + call addfld ('VTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + 'U wind tendency from ridge 6 ') + + end if + + if (use_gw_front .or. use_gw_front_igw) then + + frontgf_idx = pbuf_get_index('FRONTGF') + frontga_idx = pbuf_get_index('FRONTGA') + + call shr_assert(unset_r8 /= frontgfc, & + "gw_drag_init: Frontogenesis enabled, but frontgfc was & + & not set!"// & + errMsg(__FILE__, __LINE__)) + + do k = 0, pver + ! Check frontogenesis at 600 hPa. + if (pref_edge(k+1) < 60000._r8) kfront = k+1 + end do + + ! Source waves from 500 hPa. + kbot_front = maxloc(pref_edge, 1, (pref_edge < 50000._r8)) - 1 + + if (masterproc) then + write (iulog,*) 'KFRONT =',kfront + write (iulog,*) 'KBOT_FRONT =',kbot_front + write(iulog,*) ' ' + end if + + call addfld ('FRONTGF', (/ 'lev' /), 'A', 'K^2/M^2/S', & + 'Frontogenesis function at gws src level') + call addfld ('FRONTGFA', (/ 'lev' /), 'A', 'K^2/M^2/S', & + 'Frontogenesis function at gws src level') + + if (history_waccm) then + call add_default('FRONTGF', 1, ' ') + call add_default('FRONTGFA', 1, ' ') + end if + + end if + + if (use_gw_front) then + + call shr_assert(all(unset_r8 /= [ effgw_cm, taubgnd ]), & + "gw_drag_init: Frontogenesis mid-scale waves enabled, but not & + &all required namelist variables were set!"// & + errMsg(__FILE__, __LINE__)) + + if (masterproc) then + write(iulog,*) 'gw_init: gw spectrum taubgnd, ', & + 'effgw_cm = ',taubgnd, effgw_cm + write(iulog,*) ' ' + end if + + cm_desc = gaussian_cm_desc(band_mid, kbot_front, kfront, frontgfc, & + taubgnd, front_gaussian_width) + + ! Output for gravity waves from frontogenesis. + call gw_spec_addflds(prefix=cm_pf, scheme="C&M", band=band_mid, & + history_defaults=history_waccm) + + end if + + if (use_gw_front_igw) then + + call shr_assert(all(unset_r8 /= [ effgw_cm_igw, taubgnd_igw ]), & + "gw_drag_init: Frontogenesis inertial waves enabled, but not & + &all required namelist variables were set!"// & + errMsg(__FILE__, __LINE__)) + + if (masterproc) then + write(iulog,*) 'gw_init: gw spectrum taubgnd_igw, ', & + 'effgw_cm_igw = ',taubgnd_igw, effgw_cm_igw + write(iulog,*) ' ' + end if + + cm_igw_desc = gaussian_cm_desc(band_long, kbot_front, kfront, frontgfc, & + taubgnd_igw, front_gaussian_width) + + ! Output for gravity waves from frontogenesis. + call gw_spec_addflds(prefix=cm_igw_pf, scheme="C&M IGW", & + band=band_long, history_defaults=history_waccm) + + end if + + if (use_gw_convect_dp) then + + ttend_dp_idx = pbuf_get_index('TTEND_DP') + + ! Set the deep scheme specification components. + beres_dp_desc%storm_shift = .true. + + do k = 0, pver + ! 700 hPa index + if (pref_edge(k+1) < 70000._r8) beres_dp_desc%k = k+1 + end do + + if (masterproc) then + write (iulog,*) 'Beres deep level =',beres_dp_desc%k + end if + + ! Don't use deep convection heating depths below this limit. + ! This is important for QBO. Bad result if left at 2.5 km. + beres_dp_desc%min_hdepth = 1000._r8 + + ! Read Beres file. + + call shr_assert(trim(gw_drag_file) /= "", & + "gw_drag_init: No gw_drag_file provided for Beres deep & + &scheme. Set this via namelist."// & + errMsg(__FILE__, __LINE__)) + + call gw_init_beres(gw_drag_file, band_mid, beres_dp_desc) + + ! Output for gravity waves from the Beres scheme (deep). + call gw_spec_addflds(prefix=beres_dp_pf, scheme="Beres (deep)", & + band=band_mid, history_defaults=history_waccm) + + call addfld ('NETDT',(/ 'lev' /), 'A','K/s', & + 'Net heating rate') + call addfld ('MAXQ0',horiz_only , 'A','K/day', & + 'Max column heating rate') + call addfld ('HDEPTH',horiz_only, 'A','km', & + 'Heating Depth') + + if (history_waccm) then + call add_default('NETDT ', 1, ' ') + call add_default('HDEPTH ', 1, ' ') + call add_default('MAXQ0 ', 1, ' ') + end if + + end if + + if (use_gw_convect_sh) then + + ttend_sh_idx = pbuf_get_index('TTEND_SH') + + ! Set the shallow scheme specification components. + beres_sh_desc%storm_shift = .false. + + do k = 0, pver + ! 900 hPa index + if (pref_edge(k+1) < 90000._r8) beres_sh_desc%k = k+1 + end do + + if (masterproc) then + write (iulog,*) 'Beres shallow level =',beres_sh_desc%k + end if + + ! Use all heating depths for shallow convection. + beres_sh_desc%min_hdepth = 0._r8 + + ! Read Beres file. + + call shr_assert(trim(gw_drag_file_sh) /= "", & + "gw_drag_init: No gw_drag_file_sh provided for Beres shallow & + &scheme. Set this via namelist."// & + errMsg(__FILE__, __LINE__)) + + call gw_init_beres(gw_drag_file_sh, band_mid, beres_sh_desc) + + ! Output for gravity waves from the Beres scheme (shallow). + call gw_spec_addflds(prefix=beres_sh_pf, scheme="Beres (shallow)", & + band=band_mid, history_defaults=history_waccm) + + call addfld ('SNETDT',(/ 'lev' /), 'A','K/s', & + 'Net heating rate') + call addfld ('SMAXQ0',horiz_only , 'A','K/day', & + 'Max column heating rate') + call addfld ('SHDEPTH',horiz_only, 'A','km', & + 'Heating Depth') + + if (history_waccm) then + call add_default('SNETDT ', 1, ' ') + call add_default('SHDEPTH ', 1, ' ') + call add_default('SMAXQ0 ', 1, ' ') + end if + + end if + + call addfld ('EKGW' ,(/ 'ilev' /), 'A','M2/S', & + 'Effective Kzz due to diffusion by gravity waves') + + if (history_waccm) then + call add_default('EKGW', 1, ' ') + end if + + call addfld ('UTGW_TOTAL', (/ 'lev' /), 'A','m/s2', & + 'Total U tendency due to gravity wave drag') + + ! Total temperature tendency output. + call addfld ('TTGW', (/ 'lev' /), 'A', 'K/s', & + 'T tendency - gravity wave drag') + + ! Water budget terms. + call addfld('QTGW',(/ 'lev' /), 'A','kg/kg/s', & + 'Q tendency - gravity wave drag') + call addfld('CLDLIQTGW',(/ 'lev' /), 'A','kg/kg/s', & + 'CLDLIQ tendency - gravity wave drag') + call addfld('CLDICETGW',(/ 'lev' /), 'A','kg/kg/s', & + 'CLDICE tendency - gravity wave drag') + + if ( history_budget ) then + call add_default('TTGW', history_budget_histfile_num, ' ') + call add_default('QTGW', history_budget_histfile_num, ' ') + call add_default('CLDLIQTGW', history_budget_histfile_num, ' ') + call add_default('CLDICETGW', history_budget_histfile_num, ' ') + end if + + ! Get indices to actually output the above. + call cnst_get_ind("CLDLIQ", ixcldliq) + call cnst_get_ind("CLDICE", ixcldice) + +end subroutine gw_init + +!========================================================================== + +subroutine gw_init_beres(file_name, band, desc) + + use ioFileMod, only: getfil + use pio, only: file_desc_t, pio_nowrite, pio_inq_varid, pio_get_var, & + pio_closefile + use cam_pio_utils, only: cam_pio_openfile + + character(len=*), intent(in) :: file_name + type(GWBand), intent(in) :: band + + type(BeresSourceDesc), intent(inout) :: desc + + type(file_desc_t) :: gw_file_desc + + ! PIO variable ids and error code. + integer :: mfccid, hdid, stat + + ! Number of wavenumbers in the input file. + integer :: ngwv_file + + ! Full path to gw_drag_file. + character(len=256) :: file_path + + character(len=256) :: msg + + !---------------------------------------------------------------------- + ! read in look-up table for source spectra + !----------------------------------------------------------------------- + + call getfil(file_name, file_path) + call cam_pio_openfile(gw_file_desc, file_path, pio_nowrite) + + ! Get HD (heating depth) dimension. + + desc%maxh = get_pio_dimlen(gw_file_desc, "HD", file_path) + + ! Get MW (mean wind) dimension. + + desc%maxuh = get_pio_dimlen(gw_file_desc, "MW", file_path) + + ! Get PS (phase speed) dimension. + + ngwv_file = get_pio_dimlen(gw_file_desc, "PS", file_path) + + ! Number in each direction is half of total (and minus phase speed of 0). + desc%maxuh = (desc%maxuh-1)/2 + ngwv_file = (ngwv_file-1)/2 + + call shr_assert(ngwv_file >= band%ngwv, & + "gw_beres_init: PS in lookup table file does not cover the whole & + &spectrum implied by the model's ngwv.") + + ! Allocate hd and get data. + + allocate(desc%hd(desc%maxh), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_beres: Allocation error (hd): "//msg// & + errMsg(__FILE__, __LINE__)) + + stat = pio_inq_varid(gw_file_desc,'HD',hdid) + + call handle_pio_error(stat, & + 'Error finding HD in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, hdid, start=[1], count=[desc%maxh], & + ival=desc%hd) + + call handle_pio_error(stat, & + 'Error reading HD from: '//trim(file_path)) + + ! While not currently documented in the file, it uses kilometers. Convert + ! to meters. + desc%hd = desc%hd*1000._r8 + + ! Allocate mfcc. "desc%maxh" and "desc%maxuh" are from the file, but the + ! model determines wavenumber dimension. + + allocate(desc%mfcc(desc%maxh,-desc%maxuh:desc%maxuh,& + -band%ngwv:band%ngwv), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_beres: Allocation error (mfcc): "//msg// & + errMsg(__FILE__, __LINE__)) + + ! Get mfcc data. + + stat = pio_inq_varid(gw_file_desc,'mfcc',mfccid) + + call handle_pio_error(stat, & + 'Error finding mfcc in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, mfccid, & + start=[1,1,ngwv_file-band%ngwv+1], count=shape(desc%mfcc), & + ival=desc%mfcc) + + call handle_pio_error(stat, & + 'Error reading mfcc from: '//trim(file_path)) + + call pio_closefile(gw_file_desc) + + if (masterproc) then + + write(iulog,*) "Read in source spectra from file." + write(iulog,*) "mfcc max, min = ", & + maxval(desc%mfcc),", ",minval(desc%mfcc) + + endif + +end subroutine gw_init_beres + +!========================================================================== + +! Utility to reduce the repetitiveness of reads during initialization. +function get_pio_dimlen(file_desc, dim_name, file_path) result(dimlen) + + use pio, only: file_desc_t, pio_inq_dimid, pio_inq_dimlen + + type(file_desc_t), intent(in) :: file_desc + character(len=*), intent(in) :: dim_name + + ! File path, for use in error messages only. + character(len=*), intent(in) :: file_path + + integer :: dimlen + + integer :: dimid, stat + + stat = pio_inq_dimid(file_desc, dim_name, dimid) + + call handle_pio_error(stat, & + "Error finding dimension "//dim_name//" in: "//file_path) + + stat = pio_inq_dimlen(file_desc, dimid, dimlen) + + call handle_pio_error(stat, & + "Error reading dimension "//dim_name//" from: "//file_path) + +end function get_pio_dimlen + +!========================================================================== + +! In fact, we'd usually expect PIO errors to abort the run before you can +! even check the error code. But just in case, use this little assert. +subroutine handle_pio_error(stat, message) + use pio, only: pio_noerr + integer, intent(in) :: stat + character(len=*) :: message + + call shr_assert(stat == pio_noerr, & + "PIO error in gw_init_beres: "//trim(message)// & + errMsg(__FILE__, __LINE__)) + +end subroutine handle_pio_error + +!========================================================================== + +subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) + !----------------------------------------------------------------------- + ! Interface for multiple gravity wave drag parameterization. + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use camsrfexch, only: cam_in_t + ! Location-dependent cpair + use physconst, only: cpairv, pi + use coords_1d, only: Coords1D + use gw_common, only: gw_prof, gw_drag_prof, calc_taucd, & + momentum_flux, momentum_fixer, energy_change, energy_fixer, & + coriolis_speed, adjust_inertial + use gw_oro, only: gw_oro_src + use gw_front, only: gw_cm_src + use gw_convect, only: gw_beres_src + !------------------------------Arguments-------------------------------- + type(physics_state), intent(in) :: state ! physics state structure + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + real(r8), intent(in) :: dt ! time step + ! Parameterization net tendencies. + type(physics_ptend), intent(out):: ptend + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(out) :: flx_heat(pcols) + + !---------------------------Local storage------------------------------- + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + integer :: i, k ! loop indices + + type(Coords1D) :: p ! Pressure coordinates + + real(r8) :: ttgw(state%ncol,pver) ! temperature tendency + real(r8) :: utgw(state%ncol,pver) ! zonal wind tendency + real(r8) :: vtgw(state%ncol,pver) ! meridional wind tendency + + real(r8) :: ni(state%ncol,pver+1) ! interface Brunt-Vaisalla frequency + real(r8) :: nm(state%ncol,pver) ! midpoint Brunt-Vaisalla frequency + real(r8) :: rhoi(state%ncol,pver+1) ! interface density + real(r8), allocatable :: tau(:,:,:) ! wave Reynolds stress + real(r8) :: tau0x(state%ncol) ! c=0 sfc. stress (zonal) + real(r8) :: tau0y(state%ncol) ! c=0 sfc. stress (meridional) + real(r8) :: ubi(state%ncol,pver+1)! projection of wind at interfaces + real(r8) :: ubm(state%ncol,pver) ! projection of wind at midpoints + real(r8) :: xv(state%ncol) ! unit vector of source wind (x) + real(r8) :: yv(state%ncol) ! unit vector of source wind (y) + + integer :: m ! dummy integers + real(r8) :: qtgw(state%ncol,pver,pcnst) ! constituents tendencies + + ! Reynolds stress for waves propagating in each cardinal direction. + real(r8) :: taucd(state%ncol,pver+1,4) + + ! gravity wave wind tendency for each wave + real(r8), allocatable :: gwut(:,:,:) + + ! Temperature tendencies from diffusion and kinetic energy. + real(r8) :: dttdf(state%ncol,pver) + real(r8) :: dttke(state%ncol,pver) + + ! Wave phase speeds for each column + real(r8), allocatable :: c(:,:) + + ! Efficiency for a gravity wave source. + real(r8) :: effgw(state%ncol) + + ! Coriolis characteristic speed. + real(r8) :: u_coriolis(state%ncol) + + ! Adjustment for inertial gravity waves. + real(r8), allocatable :: ro_adjust(:,:,:) + + ! pbuf fields + ! Molecular diffusivity + real(r8), pointer :: kvt_in(:,:) + real(r8) :: kvtt(state%ncol,pver+1) + + ! Frontogenesis + real(r8), pointer :: frontgf(:,:) + real(r8), pointer :: frontga(:,:) + + ! Temperature change due to deep convection. + real(r8), pointer :: ttend_dp(:,:) + ! Temperature change due to shallow convection. + real(r8), pointer :: ttend_sh(:,:) + + ! Standard deviation of orography. + real(r8), pointer :: sgh(:) + + ! gridbox area + real(r8), pointer :: gbxar(:) + + ! Beta ridges + ! width of ridges. + real(r8), pointer :: hwdth(:,:) + ! length of ridges. + real(r8), pointer :: clngt(:,:) + ! Maximum deviations of ridges. + real(r8), pointer :: mxdis(:,:) + ! orientation of ridges. + real(r8), pointer :: angll(:,:) + ! anisotropy of ridges. + real(r8), pointer :: anixy(:,:) + + ! Gamma ridges + ! width of ridges. + real(r8), pointer :: hwdthg(:,:) + ! length of ridges. + real(r8), pointer :: clngtg(:,:) + ! Maximum deviations of ridges. + real(r8), pointer :: mxdisg(:,:) + ! orientation of ridges. + real(r8), pointer :: angllg(:,:) + ! anisotropy of ridges. + real(r8), pointer :: anixyg(:,:) + + ! Indices of gravity wave source and lowest level where wind tendencies + ! are allowed. + integer :: src_level(state%ncol) + integer :: tend_level(state%ncol) + + ! Convective source heating depth. + ! heating depth + real(r8) :: hdepth(state%ncol) + ! maximum heating rate + real(r8) :: maxq0(state%ncol) + + ! Scale sgh to account for landfrac. + real(r8) :: sgh_scaled(state%ncol) + + ! Parameters for the IGW polar taper. + real(r8), parameter :: degree2radian = pi/180._r8 + real(r8), parameter :: al0 = 82.5_r8 * degree2radian + real(r8), parameter :: dlat0 = 5.0_r8 * degree2radian + + ! effective gw diffusivity at interfaces needed for output + real(r8) :: egwdffi(state%ncol,pver+1) + ! sum from the two types of spectral GW + real(r8) :: egwdffi_tot(state%ncol,pver+1) + + ! Momentum fluxes used by fixer. + real(r8) :: um_flux(state%ncol), vm_flux(state%ncol) + ! Energy change used by fixer. + real(r8) :: de(state%ncol) + + ! Which constituents are being affected by diffusion. + logical :: lq(pcnst) + + ! Contiguous copies of state arrays. + real(r8) :: dse(state%ncol,pver) + real(r8) :: t(state%ncol,pver) + real(r8) :: u(state%ncol,pver) + real(r8) :: v(state%ncol,pver) + real(r8) :: q(state%ncol,pver,pcnst) + real(r8) :: piln(state%ncol,pver+1) + real(r8) :: zm(state%ncol,pver) + real(r8) :: zi(state%ncol,pver+1) + + !------------------------------------------------------------------------ + + lchnk = state%lchnk + ncol = state%ncol + + p = Coords1D(state%pint(:ncol,:)) + + dse = state%s(:ncol,:) + t = state%t(:ncol,:) + u = state%u(:ncol,:) + v = state%v(:ncol,:) + q = state%q(:ncol,:,:) + piln = state%lnpint(:ncol,:) + zm = state%zm(:ncol,:) + zi = state%zi(:ncol,:) + + lq = .true. + call physics_ptend_init(ptend, state%psetcols, "Gravity wave drag", & + ls=.true., lu=.true., lv=.true., lq=lq) + + ! Profiles of background state variables + call gw_prof(ncol, p, cpair, t, rhoi, nm, ni) + + if (do_molec_diff) then + !-------------------------------------------------------- + ! Initialize and calculate local molecular diffusivity + !-------------------------------------------------------- + + call pbuf_get_field(pbuf, kvt_idx, kvt_in) ! kvt_in(1:pcols,1:pver+1) + + ! Set kvtt from pbuf field; kvtt still needs a factor of 1/cpairv. + kvtt = kvt_in(:ncol,:) + + ! Use linear extrapolation of cpairv to top interface. + kvtt(:,1) = kvtt(:,1) / & + (1.5_r8*cpairv(:ncol,1,lchnk) - & + 0.5_r8*cpairv(:ncol,2,lchnk)) + + ! Interpolate cpairv to other interfaces. + do k = 2, nbot_molec + kvtt(:,k) = kvtt(:,k) / & + (cpairv(:ncol,k+1,lchnk)+cpairv(:ncol,k,lchnk)) * 2._r8 + enddo + + else + + kvtt = 0._r8 + + end if + + if (use_gw_front_igw) then + u_coriolis = coriolis_speed(band_long, state%lat(:ncol)) + end if + + ! Totals that accumulate over different sources. + egwdffi_tot = 0._r8 + flx_heat = 0._r8 + + if (use_gw_convect_dp) then + !------------------------------------------------------------------ + ! Convective gravity waves (Beres scheme, deep). + !------------------------------------------------------------------ + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) + allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + + ! Set up heating + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + + ! Efficiency of gravity wave momentum transfer. + ! This is really only to remove the pole points. + where (pi/2._r8 - abs(state%lat(:ncol)) >= 4*epsilon(1._r8)) + effgw = effgw_beres_dp + elsewhere + effgw = 0._r8 + end where + + ! Determine wave sources for Beres deep scheme + call gw_beres_src(ncol, band_mid, beres_dp_desc, & + u, v, ttend_dp(:ncol,:), zm, src_level, tend_level, tau, & + ubm, ubi, xv, yv, c, hdepth, maxq0) + + ! Solve for the drag profile with Beres source spectrum. + call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + ! Store constituents tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Find momentum flux, and use it to fix the wind tendencies below + ! the gravity wave region. + call momentum_flux(tend_level, taucd, um_flux, vm_flux) + call momentum_fixer(tend_level, p, um_flux, vm_flux, utgw, vtgw) + + ! Add the momentum tendencies to the output tendency arrays. + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + end do + + ! Find energy change in the current state, and use fixer to apply + ! the difference in lower levels. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:)+ttgw, de) + call energy_fixer(tend_level, p, de-flx_heat(:ncol), ttgw) + + do k = 1, pver + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + ! Change ttgw to a temperature tendency before outputing it. + ttgw = ttgw / cpair + call gw_spec_outflds(beres_dp_pf, lchnk, ncol, band_mid, c, u, v, & + xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & + taucd) + + ! Diagnostic outputs (convert hdepth to km). + call outfld('NETDT', ttend_dp, pcols, lchnk) + call outfld('HDEPTH', hdepth/1000._r8, ncol, lchnk) + call outfld('MAXQ0', maxq0, ncol, lchnk) + + deallocate(tau, gwut, c) + + end if + + if (use_gw_convect_sh) then + !------------------------------------------------------------------ + ! Convective gravity waves (Beres scheme, shallow). + !------------------------------------------------------------------ + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) + allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + + ! Set up heating + call pbuf_get_field(pbuf, ttend_sh_idx, ttend_sh) + + ! Efficiency of gravity wave momentum transfer. + ! This is really only to remove the pole points. + where (pi/2._r8 - abs(state%lat(:ncol)) >= 4*epsilon(1._r8)) + effgw = effgw_beres_sh + elsewhere + effgw = 0._r8 + end where + + ! Determine wave sources for Beres shallow scheme + call gw_beres_src(ncol, band_mid, beres_sh_desc, & + u, v, ttend_sh(:ncol,:), zm, src_level, tend_level, tau, & + ubm, ubi, xv, yv, c, hdepth, maxq0) + + ! Solve for the drag profile with Beres source spectrum. + call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + ! Store constituents tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Add the momentum tendencies to the output tendency arrays. + ! Don't calculate fixers, since we are too close to the ground to + ! spread momentum/energy differences across low layers. + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + ! Calculate energy change for output to CAM's energy checker. + ! This is sort of cheating; we don't have a good a priori idea of the + ! energy coming from surface stress, so we just integrate what we and + ! actually have so far and overwrite flx_heat with that. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:), de) + flx_heat(:ncol) = de + + ! Change ttgw to a temperature tendency before outputing it. + ttgw = ttgw / cpair + call gw_spec_outflds(beres_sh_pf, lchnk, ncol, band_mid, c, u, v, & + xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & + taucd) + + ! Diagnostic outputs (convert SHDEPTH to km). + call outfld ('SNETDT', ttend_sh, pcols, lchnk) + call outfld ('SHDEPTH', hdepth/1000._r8, ncol, lchnk) + call outfld ('SMAXQ0', maxq0, ncol, lchnk) + + deallocate(tau, gwut, c) + + end if + + if (use_gw_front .or. use_gw_front_igw) then + ! Get frontogenesis physics buffer fields set by dynamics. + call pbuf_get_field(pbuf, frontgf_idx, frontgf) + call pbuf_get_field(pbuf, frontga_idx, frontga) + + ! Output for diagnostics. + call outfld ('FRONTGF', frontgf, pcols, lchnk) + call outfld ('FRONTGFA', frontga, pcols, lchnk) + end if + + if (use_gw_front) then + !------------------------------------------------------------------ + ! Frontally generated gravity waves + !------------------------------------------------------------------ + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) + allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + + ! Efficiency of gravity wave momentum transfer. + effgw = effgw_cm + ! Frontogenesis is too high at the poles (at least for the FV + ! dycore), so introduce a polar taper. + if (gw_polar_taper) effgw = effgw * cos(state%lat(:ncol)) + + ! Determine the wave source for C&M background spectrum + call gw_cm_src(ncol, band_mid, cm_desc, u, v, frontgf(:ncol,:), & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + + ! Solve for the drag profile with C&M source spectrum. + call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + !Add the constituent tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Find momentum flux, and use it to fix the wind tendencies below + ! the gravity wave region. + call momentum_flux(tend_level, taucd, um_flux, vm_flux) + call momentum_fixer(tend_level, p, um_flux, vm_flux, utgw, vtgw) + + ! add the momentum tendencies to the output tendency arrays + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + end do + + ! Find energy change in the current state, and use fixer to apply + ! the difference in lower levels. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:)+ttgw, de) + call energy_fixer(tend_level, p, de-flx_heat(:ncol), ttgw) + + do k = 1, pver + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + ! Change ttgw to a temperature tendency before outputing it. + ttgw = ttgw / cpair + call gw_spec_outflds(cm_pf, lchnk, ncol, band_mid, c, u, v, & + xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & + taucd) + + deallocate(tau, gwut, c) + + end if + + if (use_gw_front_igw) then + !------------------------------------------------------------------ + ! Frontally generated inertial gravity waves + !------------------------------------------------------------------ + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) + allocate(gwut(ncol,pver,-band_long%ngwv:band_long%ngwv)) + allocate(c(ncol,-band_long%ngwv:band_long%ngwv)) + allocate(ro_adjust(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) + + ! Efficiency of gravity wave momentum transfer. + effgw = effgw_cm_igw + + ! Frontogenesis is too high at the poles (at least for the FV + ! dycore), so introduce a polar taper. + if (gw_polar_taper) then + where (abs(state%lat(:ncol)) <= 89._r8*degree2radian) + effgw = effgw * 0.25_r8 * & + (1._r8+tanh((state%lat(:ncol)+al0)/dlat0)) * & + (1._r8-tanh((state%lat(:ncol)-al0)/dlat0)) + elsewhere + effgw = 0._r8 + end where + end if + + ! Determine the wave source for C&M background spectrum + call gw_cm_src(ncol, band_long, cm_igw_desc, u, v, frontgf(:ncol,:), & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + + call adjust_inertial(band_long, tend_level, u_coriolis, c, ubi, & + tau, ro_adjust) + + ! Solve for the drag profile with C&M source spectrum. + call gw_drag_prof(ncol, band_long, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, ro_adjust=ro_adjust, & + lapply_effgw_in=gw_apply_tndmax) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_long%ngwv, tend_level, tau, c, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + !Add the constituent tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Find momentum flux, and use it to fix the wind tendencies below + ! the gravity wave region. + call momentum_flux(tend_level, taucd, um_flux, vm_flux) + call momentum_fixer(tend_level, p, um_flux, vm_flux, utgw, vtgw) + + ! add the momentum tendencies to the output tendency arrays + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + end do + + ! Find energy change in the current state, and use fixer to apply + ! the difference in lower levels. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:)+ttgw, de) + call energy_fixer(tend_level, p, de-flx_heat(:ncol), ttgw) + + do k = 1, pver + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + ! Change ttgw to a temperature tendency before outputing it. + ttgw = ttgw / cpair + call gw_spec_outflds(cm_igw_pf, lchnk, ncol, band_long, c, u, v, & + xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & + taucd) + + deallocate(tau, gwut, c, ro_adjust) + + end if + + if (use_gw_oro) then + !--------------------------------------------------------------------- + ! Orographic stationary gravity waves + !--------------------------------------------------------------------- + + ! Allocate wavenumber fields. + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) + allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + + ! Efficiency of gravity wave momentum transfer. + ! Take into account that wave sources are only over land. + call pbuf_get_field(pbuf, sgh_idx, sgh) + + if (gw_lndscl_sgh) then + where (cam_in%landfrac(:ncol) >= epsilon(1._r8)) + effgw = effgw_oro * cam_in%landfrac(:ncol) + sgh_scaled = sgh(:ncol) / sqrt(cam_in%landfrac(:ncol)) + elsewhere + effgw = 0._r8 + sgh_scaled = 0._r8 + end where + + ! Determine the orographic wave source + call gw_oro_src(ncol, band_oro, p, & + u, v, t, sgh_scaled, zm, nm, & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + else + effgw = effgw_oro + + ! Determine the orographic wave source + call gw_oro_src(ncol, band_oro, p, & + u, v, t, sgh(:ncol), zm, nm, & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + endif + do i = 1, ncol + if (state%lat(i) < 0._r8) then + tau(i,:,:) = tau(i,:,:) * gw_oro_south_fac + end if + end do + + ! Solve for the drag profile with orographic sources. + call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw,c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax) + + ! For orographic waves, don't bother with taucd, since there are no + ! momentum conservation routines or directional diagnostics. + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + ! Add the orographic tendencies to the spectrum tendencies. + ! Don't calculate fixers, since we are too close to the ground to + ! spread momentum/energy differences across low layers. + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + ! Convert to temperature tendency for output. + ttgw(:,k) = ttgw(:,k) / cpairv(:ncol, k, lchnk) + end do + + ! Calculate energy change for output to CAM's energy checker. + ! This is sort of cheating; we don't have a good a priori idea of the + ! energy coming from surface stress, so we just integrate what we and + ! actually have so far and overwrite flx_heat with that. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:), de) + flx_heat(:ncol) = de + + do m = 1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Write output fields to history file + call outfld('TAUAORO', tau(:,0,:), ncol, lchnk) + call outfld('UTGWORO', utgw, ncol, lchnk) + call outfld('VTGWORO', vtgw, ncol, lchnk) + call outfld('TTGWORO', ttgw, ncol, lchnk) + call outfld('TTGWSDFORO', dttdf / cpair, ncol, lchnk) + call outfld('TTGWSKEORO', dttke / cpair, ncol, lchnk) + tau0x = tau(:,0,pver+1) * xv + tau0y = tau(:,0,pver+1) * yv + call outfld('TAUGWX', tau0x, ncol, lchnk) + call outfld('TAUGWY', tau0y, ncol, lchnk) + + deallocate(tau, gwut, c) + + end if + + if (use_gw_rdg_beta) then + !--------------------------------------------------------------------- + ! Orographic stationary gravity waves + !--------------------------------------------------------------------- + + ! Efficiency of gravity wave momentum transfer. + ! Take into account that wave sources are only over land. + + hwdth => rdg_hwdth(:ncol,:,lchnk) + clngt => rdg_clngt(:ncol,:,lchnk) + gbxar => rdg_gbxar(:ncol,lchnk) + mxdis => rdg_mxdis(:ncol,:,lchnk) + angll => rdg_angll(:ncol,:,lchnk) + anixy => rdg_anixy(:ncol,:,lchnk) + + where(mxdis < 0._r8) + mxdis = 0._r8 + end where + + ! Save state at top of routine + ! Useful for unit testing checks + call outfld('UEGW', u , ncol, lchnk) + call outfld('VEGW', v , ncol, lchnk) + call outfld('TEGW', t , ncol, lchnk) + + call gw_rdg_calc(& + 'BETA ', ncol, lchnk, n_rdg_beta, dt, & + u, v, t, p, piln, zm, zi, & + nm, ni, rhoi, kvtt, q, dse, & + effgw_rdg_beta, effgw_rdg_beta_max, & + hwdth, clngt, gbxar, mxdis, angll, anixy, & + rdg_beta_cd_llb, trpd_leewv_rdg_beta, & + ptend, flx_heat) + + end if + + if (use_gw_rdg_gamma) then + !--------------------------------------------------------------------- + ! Orographic stationary gravity waves + !--------------------------------------------------------------------- + + ! Efficiency of gravity wave momentum transfer. + ! Take into account that wave sources are only over land. + + hwdthg => rdg_hwdthg(:ncol,:,lchnk) + clngtg => rdg_clngtg(:ncol,:,lchnk) + gbxar => rdg_gbxar(:ncol,lchnk) + mxdisg => rdg_mxdisg(:ncol,:,lchnk) + angllg => rdg_angllg(:ncol,:,lchnk) + anixyg => rdg_anixyg(:ncol,:,lchnk) + + where(mxdisg < 0._r8) + mxdisg = 0._r8 + end where + + call gw_rdg_calc(& + 'GAMMA', ncol, lchnk, n_rdg_gamma, dt, & + u, v, t, p, piln, zm, zi, & + nm, ni, rhoi, kvtt, q, dse, & + effgw_rdg_gamma, effgw_rdg_gamma_max, & + hwdthg, clngtg, gbxar, mxdisg, angllg, anixyg, & + rdg_gamma_cd_llb, trpd_leewv_rdg_gamma, & + ptend, flx_heat) + + endif + + ! Write totals to history file. + call outfld('EKGW', egwdffi_tot , ncol, lchnk) + call outfld('TTGW', ptend%s/cpairv(:,:,lchnk), pcols, lchnk) + + call outfld('UTGW_TOTAL', ptend%u, pcols, lchnk) + + call outfld('QTGW', ptend%q(:,:,1), pcols, lchnk) + call outfld('CLDLIQTGW', ptend%q(:,:,ixcldliq), pcols, lchnk) + call outfld('CLDICETGW', ptend%q(:,:,ixcldice), pcols, lchnk) + + ! Destroy objects. + call p%finalize() + +end subroutine gw_tend + +!========================================================================== + +subroutine gw_rdg_calc( & + type, ncol, lchnk, n_rdg, dt, & + u, v, t, p, piln, zm, zi, & + nm, ni, rhoi, kvtt, q, dse, & + effgw_rdg, effgw_rdg_max, & + hwdth, clngt, gbxar, & + mxdis, angll, anixy, & + rdg_cd_llb, trpd_leewv, & + ptend, flx_heat) + + use coords_1d, only: Coords1D + use gw_rdg, only: gw_rdg_src, gw_rdg_belowpeak, gw_rdg_break_trap, gw_rdg_do_vdiff + use gw_common, only: gw_drag_prof, energy_change + + character(len=5), intent(in) :: type ! BETA or GAMMA + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: n_rdg + real(r8), intent(in) :: dt ! Time step. + + real(r8), intent(in) :: u(ncol,pver) ! Midpoint zonal winds. ( m s-1) + real(r8), intent(in) :: v(ncol,pver) ! Midpoint meridional winds. ( m s-1) + real(r8), intent(in) :: t(ncol,pver) ! Midpoint temperatures. (K) + type(Coords1D), intent(in) :: p ! Pressure coordinates. + real(r8), intent(in) :: piln(ncol,pver+1) ! Log of interface pressures. + real(r8), intent(in) :: zm(ncol,pver) ! Midpoint altitudes above ground (m). + real(r8), intent(in) :: zi(ncol,pver+1) ! Interface altitudes above ground (m). + real(r8), intent(in) :: nm(ncol,pver) ! Midpoint Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: ni(ncol,pver+1) ! Interface Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: rhoi(ncol,pver+1) ! Interface density (kg m-3). + real(r8), intent(in) :: kvtt(ncol,pver+1) ! Molecular thermal diffusivity. + real(r8), intent(in) :: q(:,:,:) ! Constituent array. + real(r8), intent(in) :: dse(ncol,pver) ! Dry static energy. + + + real(r8), intent(in) :: effgw_rdg ! Tendency efficiency. + real(r8), intent(in) :: effgw_rdg_max + real(r8), intent(in) :: hwdth(ncol,prdg) ! width of ridges. + real(r8), intent(in) :: clngt(ncol,prdg) ! length of ridges. + real(r8), intent(in) :: gbxar(ncol) ! gridbox area + + real(r8), intent(in) :: mxdis(ncol,prdg) ! Height estimate for ridge (m). + real(r8), intent(in) :: angll(ncol,prdg) ! orientation of ridges. + real(r8), intent(in) :: anixy(ncol,prdg) ! Anisotropy parameter. + + real(r8), intent(in) :: rdg_cd_llb ! Drag coefficient for low-level flow + logical, intent(in) :: trpd_leewv + + type(physics_ptend), intent(inout):: ptend ! Parameterization net tendencies. + + real(r8), intent(out) :: flx_heat(pcols) + + !---------------------------Local storage------------------------------- + + integer :: k, m, nn + + real(r8), allocatable :: tau(:,:,:) ! wave Reynolds stress + ! gravity wave wind tendency for each wave + real(r8), allocatable :: gwut(:,:,:) + ! Wave phase speeds for each column + real(r8), allocatable :: c(:,:) + + ! Isotropic source flag [anisotropic orography]. + integer :: isoflag(ncol) + + ! horiz wavenumber [anisotropic orography]. + real(r8) :: kwvrdg(ncol) + + ! Efficiency for a gravity wave source. + real(r8) :: effgw(ncol) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer :: src_level(ncol) + integer :: tend_level(ncol) + integer :: bwv_level(ncol) + integer :: tlb_level(ncol) + + ! Projection of wind at midpoints and interfaces. + real(r8) :: ubm(ncol,pver) + real(r8) :: ubi(ncol,pver+1) + + ! Unit vectors of source wind (zonal and meridional components). + real(r8) :: xv(ncol) + real(r8) :: yv(ncol) + + ! Averages over source region. + real(r8) :: ubmsrc(ncol) ! On-ridge wind. + real(r8) :: usrc(ncol) ! Zonal wind. + real(r8) :: vsrc(ncol) ! Meridional wind. + real(r8) :: nsrc(ncol) ! B-V frequency. + real(r8) :: rsrc(ncol) ! Density. + + ! normalized wavenumber + real(r8) :: m2src(ncol) + + ! Top of low-level flow layer. + real(r8) :: tlb(ncol) + + ! Bottom of linear wave region. + real(r8) :: bwv(ncol) + + ! Froude numbers for flow/drag regimes + real(r8) :: Fr1(ncol) + real(r8) :: Fr2(ncol) + real(r8) :: Frx(ncol) + + ! Wave Reynolds stresses at source level + real(r8) :: tauoro(ncol) + real(r8) :: taudsw(ncol) + + ! Surface streamline displacement height for linear waves. + real(r8) :: hdspwv(ncol) + + ! Surface streamline displacement height for downslope wind regime. + real(r8) :: hdspdw(ncol) + + ! Wave breaking level + real(r8) :: wbr(ncol) + + real(r8) :: utgw(ncol,pver) ! zonal wind tendency + real(r8) :: vtgw(ncol,pver) ! meridional wind tendency + real(r8) :: ttgw(ncol,pver) ! temperature tendency + real(r8) :: qtgw(ncol,pver,pcnst) ! constituents tendencies + + ! Effective gravity wave diffusivity at interfaces. + real(r8) :: egwdffi(ncol,pver+1) + + ! Temperature tendencies from diffusion and kinetic energy. + real(r8) :: dttdf(ncol,pver) + real(r8) :: dttke(ncol,pver) + + ! Wave stress in zonal/meridional direction + real(r8) :: taurx(ncol,pver+1) + real(r8) :: taurx0(ncol,pver+1) + real(r8) :: taury(ncol,pver+1) + real(r8) :: taury0(ncol,pver+1) + + ! U,V tendency accumulators + real(r8) :: utrdg(ncol,pver) + real(r8) :: vtrdg(ncol,pver) + + ! Energy change used by fixer. + real(r8) :: de(ncol) + + character(len=1) :: cn + character(len=9) :: fname(4) + !---------------------------------------------------------------------------- + + ! Allocate wavenumber fields. + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) + allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + + ! initialize accumulated momentum fluxes and tendencies + taurx = 0._r8 + taury = 0._r8 + utrdg = 0._r8 + vtrdg = 0._r8 + + do nn = 1, n_rdg + + kwvrdg = 0.001_r8 / ( hwdth(:,nn) + 0.001_r8 ) ! this cant be done every time step !!! + isoflag = 0 + effgw = effgw_rdg * ( hwdth(1:ncol,nn)* clngt(1:ncol,nn) ) / gbxar(1:ncol) + effgw = min( effgw_rdg_max , effgw ) + + call gw_rdg_src(ncol, band_oro, p, & + u, v, t, mxdis(:,nn), angll(:,nn), anixy(:,nn), kwvrdg, isoflag, zi, nm, & + src_level, tend_level, bwv_level, tlb_level, tau, ubm, ubi, xv, yv, & + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, c) + + call gw_rdg_belowpeak(ncol, band_oro, rdg_cd_llb, & + t, mxdis(:,nn), anixy(:,nn), kwvrdg, & + zi, nm, ni, rhoi, & + src_level, tau, & + ubmsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, & + tauoro, taudsw, hdspwv, hdspdw) + + call gw_rdg_break_trap(ncol, band_oro, & + zi, nm, ni, ubm, ubi, rhoi, kwvrdg , bwv, tlb, wbr, & + src_level, tlb_level, hdspwv, hdspdw, mxdis(:,nn), & + tauoro, taudsw, tau, & + ldo_trapped_waves=trpd_leewv) + + call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & + t, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + kwvrdg=kwvrdg, & + satfac_in = 1._r8, lapply_vdiff=gw_rdg_do_vdiff ) + + ! Add the tendencies from each ridge to the totals. + do k = 1, pver + ! diagnostics + utrdg(:,k) = utrdg(:,k) + utgw(:,k) + vtrdg(:,k) = vtrdg(:,k) + vtgw(:,k) + ! physics tendencies + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + do m = 1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + do k = 1, pver+1 + taurx0(:,k) = tau(:,0,k)*xv + taury0(:,k) = tau(:,0,k)*yv + taurx(:,k) = taurx(:,k) + taurx0(:,k) + taury(:,k) = taury(:,k) + taury0(:,k) + end do + + if (nn == 1) then + call outfld('TAU1RDG'//trim(type)//'M', tau(:,0,:), ncol, lchnk) + call outfld('UBM1'//trim(type), ubm, ncol, lchnk) + call outfld('UBT1RDG'//trim(type), gwut, ncol, lchnk) + end if + + if (nn <= 6) then + write(cn, '(i1)') nn + call outfld('TAU'//cn//'RDG'//trim(type)//'X', taurx0, ncol, lchnk) + call outfld('TAU'//cn//'RDG'//trim(type)//'Y', taury0, ncol, lchnk) + call outfld('UT'//cn//'RDG'//trim(type), utgw, ncol, lchnk) + call outfld('VT'//cn//'RDG'//trim(type), vtgw, ncol, lchnk) + end if + + end do ! end of loop over multiple ridges + + ! Calculate energy change for output to CAM's energy checker. + call energy_change(dt, p, u, v, ptend%u(:ncol,:), & + ptend%v(:ncol,:), ptend%s(:ncol,:), de) + flx_heat(:ncol) = de + + call outfld('TAUARDG'//trim(type)//'X', taurx, ncol, lchnk) + call outfld('TAUARDG'//trim(type)//'Y', taury, ncol, lchnk) + + if (trim(type) == 'BETA') then + fname(1) = 'TAUGWX' + fname(2) = 'TAUGWY' + fname(3) = 'UTGWORO' + fname(4) = 'VTGWORO' + else if (trim(type) == 'GAMMA') then + fname(1) = 'TAURDGGMX' + fname(2) = 'TAURDGGMY' + fname(3) = 'UTRDGGM' + fname(4) = 'VTRDGGM' + else + call endrun('gw_rdg_calc: FATAL: type must be either BETA or GAMMA'& + //' type= '//type) + end if + + call outfld(fname(1), taurx(:,pver+1), ncol, lchnk) + call outfld(fname(2), taury(:,pver+1), ncol, lchnk) + call outfld(fname(3), utrdg, ncol, lchnk) + call outfld(fname(4), vtrdg, ncol, lchnk) + + deallocate(tau, gwut, c) + +end subroutine gw_rdg_calc + +!========================================================================== + +! Add all history fields for a gravity wave spectrum source. +subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) + use cam_history, only: addfld, add_default + + !------------------------------Arguments-------------------------------- + + ! One character prefix prepended to output fields. + character(len=1), intent(in) :: prefix + ! Gravity wave scheme name prepended to output field descriptions. + character(len=*), intent(in) :: scheme + ! Wave speeds. + type(GWBand), intent(in) :: band + ! Whether or not to call add_default for fields output by WACCM. + logical, intent(in) :: history_defaults + + !---------------------------Local storage------------------------------- + + integer :: l + ! 7 chars is enough for "-100.00" + character(len=7) :: fnum + ! 10 chars is enough for "BTAUXSn32" + character(len=10) :: dumc1x, dumc1y + ! Allow 80 chars for description + character(len=80) dumc2 + + !----------------------------------------------------------------------- + + ! Overall wind tendencies. + call addfld (trim(prefix)//'UTGWSPEC',(/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency - gravity wave spectrum') + call addfld (trim(prefix)//'VTGWSPEC',(/ 'lev' /), 'A','m/s2', & + trim(scheme)//' V tendency - gravity wave spectrum') + call addfld (trim(prefix)//'TTGWSPEC',(/ 'lev' /), 'A','K/s', & + trim(scheme)//' T tendency - gravity wave spectrum') + + ! Wind tendencies broken across five spectral bins. + call addfld (trim(prefix)//'UTEND1', (/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency c < -40') + call addfld (trim(prefix)//'UTEND2', (/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency -40 < c < -15') + call addfld (trim(prefix)//'UTEND3', (/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency -15 < c < 15') + call addfld (trim(prefix)//'UTEND4', (/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency 15 < c < 40') + call addfld (trim(prefix)//'UTEND5', (/ 'lev' /), 'A','m/s2', & + trim(scheme)//' U tendency 40 < c ') + + ! Reynold's stress toward each cardinal direction, and net zonal stress. + call addfld (trim(prefix)//'TAUE' , (/ 'ilev' /), 'A','Pa', & + trim(scheme)//' Eastward Reynolds stress') + call addfld (trim(prefix)//'TAUW' , (/ 'ilev' /), 'A','Pa', & + trim(scheme)//' Westward Reynolds stress') + call addfld (trim(prefix)//'TAUNET' , (/ 'ilev' /), 'A','Pa', & + trim(scheme)//' E+W Reynolds stress') + call addfld (trim(prefix)//'TAUN' , (/ 'ilev' /), 'A','Pa', & + trim(scheme)//' Northward Reynolds stress') + call addfld (trim(prefix)//'TAUS' , (/ 'ilev' /), 'A','Pa', & + trim(scheme)//' Southward Reynolds stress') + + ! Momentum flux in each direction. + call addfld (trim(prefix)//'EMF', (/ 'lev' /), 'A','Pa', & + trim(scheme)//' Eastward MF') + call addfld (trim(prefix)//'WMF', (/ 'lev' /), 'A','Pa', & + trim(scheme)//' Westward MF') + call addfld (trim(prefix)//'NMF', (/ 'lev' /), 'A','Pa', & + trim(scheme)//' Northward MF') + call addfld (trim(prefix)//'SMF', (/ 'lev' /), 'A','Pa', & + trim(scheme)//' Southward MF') + + ! Temperature tendency terms. + call addfld (trim(prefix)//'TTGWSDF' , (/ 'lev' /), 'A','K/s', & + trim(scheme)//' t tendency - diffusion term') + call addfld (trim(prefix)//'TTGWSKE' , (/ 'lev' /), 'A','K/s', & + trim(scheme)//' t tendency - kinetic energy conversion term') + + ! Gravity wave source spectra by wave number. + do l=-band%ngwv,band%ngwv + ! String containing reference speed. + write (fnum,fmt='(f7.2)') band%cref(l) + + dumc1x = tau_fld_name(l, prefix, x_not_y=.true.) + dumc1y = tau_fld_name(l, prefix, x_not_y=.false.) + dumc2 = trim(scheme)//" tau at c= "//trim(fnum)//" m/s" + call addfld (trim(dumc1x),(/ 'lev' /), 'A','Pa',dumc2) + call addfld (trim(dumc1y),(/ 'lev' /), 'A','Pa',dumc2) + + end do + + if (history_defaults) then + call add_default(trim(prefix)//'UTGWSPEC', 1, ' ') + call add_default(trim(prefix)//'VTGWSPEC', 1, ' ') + call add_default(trim(prefix)//'TTGWSPEC', 1, ' ') + call add_default(trim(prefix)//'TAUE', 1, ' ') + call add_default(trim(prefix)//'TAUW', 1, ' ') + call add_default(trim(prefix)//'TAUNET', 1, ' ') + call add_default(trim(prefix)//'TAUN', 1, ' ') + call add_default(trim(prefix)//'TAUS', 1, ' ') + end if + +end subroutine gw_spec_addflds + +!========================================================================== + +! Outputs for spectral waves. +subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & + gwut, dttdf, dttke, tau, utgw, vtgw, ttgw, taucd) + + use gw_common, only: west, east, south, north + + ! One-character prefix prepended to output fields. + character(len=1), intent(in) :: prefix + ! Chunk and number of columns in the chunk. + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + ! Wave speeds. + type(GWBand), intent(in) :: band + ! Wave phase speeds for each column. + real(r8), intent(in) :: c(ncol,-band%ngwv:band%ngwv) + ! Winds at cell midpoints. + real(r8), intent(in) :: u(ncol,pver) + real(r8), intent(in) :: v(ncol,pver) + ! Unit vector in the direction of wind at source level. + real(r8), intent(in) :: xv(ncol) + real(r8), intent(in) :: yv(ncol) + ! Wind tendency for each wave. + real(r8), intent(in) :: gwut(ncol,pver,-band%ngwv:band%ngwv) + ! Temperature tendencies from diffusion and kinetic energy. + real(r8) :: dttdf(ncol,pver) + real(r8) :: dttke(ncol,pver) + ! Wave Reynolds stress. + real(r8), intent(in) :: tau(ncol,-band%ngwv:band%ngwv,pver) + ! Zonal and meridional total wind tendencies. + real(r8), intent(in) :: utgw(ncol,pver) + real(r8), intent(in) :: vtgw(ncol,pver) + ! Temperature tendencies. + real(r8), intent(in) :: ttgw(ncol,pver) + ! Reynolds stress for waves propagating in each cardinal direction. + real(r8), intent(in) :: taucd(ncol,pver+1,4) + + ! Indices + integer :: i, k, l + integer :: ix(ncol, -band%ngwv:band%ngwv), iy(ncol, -band%ngwv:band%ngwv) + integer :: iu(ncol), iv(ncol) + + ! Zonal wind tendency, broken up into five bins. + real(r8) :: utb(ncol, pver, 5) + ! Definition of the bin boundaries. + real(r8), parameter :: bounds(4) = (/ -40._r8, -15._r8, & + 15._r8, 40._r8 /) + + ! Momentum flux in the four cardinal directions. + real(r8) :: mf(ncol, pver, 4) + + ! Wave stress in zonal/meridional direction + real(r8) :: taux(ncol,-band%ngwv:band%ngwv,pver) + real(r8) :: tauy(ncol,-band%ngwv:band%ngwv,pver) + + ! Temporaries for output + real(r8) :: dummyx(ncol,pver) + real(r8) :: dummyy(ncol,pver) + ! Variable names + character(len=10) :: dumc1x, dumc1y + + + ! Accumulate wind tendencies binned according to phase speed. + + utb = 0._r8 + + ! Find which output bin the phase speed corresponds to. + ix = find_bin(c) + + ! Put the wind tendency in that bin. + do l = -band%ngwv, band%ngwv + do k = 1, pver + do i = 1, ncol + utb(i,k,ix(i,l)) = utb(i,k,ix(i,l)) + gwut(i,k,l) + end do + end do + end do + + ! Find just the zonal part. + do l = 1, 5 + do k = 1, pver + utb(:, k, l) = utb(:, k, l) * xv + end do + end do + + call outfld(trim(prefix)//'UTEND1', utb(:,:,1), ncol, lchnk) + call outfld(trim(prefix)//'UTEND2', utb(:,:,2), ncol, lchnk) + call outfld(trim(prefix)//'UTEND3', utb(:,:,3), ncol, lchnk) + call outfld(trim(prefix)//'UTEND4', utb(:,:,4), ncol, lchnk) + call outfld(trim(prefix)//'UTEND5', utb(:,:,5), ncol, lchnk) + + ! Output temperature tendencies due to diffusion and from kinetic energy. + call outfld(trim(prefix)//'TTGWSDF', dttdf / cpair, ncol, lchnk) + call outfld(trim(prefix)//'TTGWSKE', dttke / cpair, ncol, lchnk) + + + ! Output tau broken down into zonal and meridional components. + + taux = 0._r8 + tauy = 0._r8 + + ! Project c, and convert each component to a wavenumber index. + ! These are mappings from the wavenumber index of tau to those of taux + ! and tauy, respectively. + do l=-band%ngwv,band%ngwv + ix(:,l) = c_to_l(c(:,l)*xv) + iy(:,l) = c_to_l(c(:,l)*yv) + end do + + ! Find projection of tau. + do k = 1, pver + do l = -band%ngwv,band%ngwv + do i = 1, ncol + taux(i,ix(i,l),k) = taux(i,ix(i,l),k) & + + abs(tau(i,l,k)*xv(i)) + tauy(i,iy(i,l),k) = tauy(i,iy(i,l),k) & + + abs(tau(i,l,k)*yv(i)) + end do + end do + end do + + do l=-band%ngwv,band%ngwv + + dummyx = taux(:,l,:) + dummyy = tauy(:,l,:) + + dumc1x = tau_fld_name(l, prefix, x_not_y=.true.) + dumc1y = tau_fld_name(l, prefix, x_not_y=.false.) + + call outfld(dumc1x,dummyx,ncol,lchnk) + call outfld(dumc1y,dummyy,ncol,lchnk) + + enddo + + + ! Output momentum flux in each cardinal direction. + mf = 0._r8 + + do k = 1, pver + + ! Convert wind speed components to wavenumber indices. + iu = c_to_l(u(:,k)) + iv = c_to_l(v(:,k)) + + ! Sum tau components in each cardinal direction. + ! Split west/east and north/south based on whether wave speed exceeds + ! wind speed. + do l = -band%ngwv, band%ngwv + + where (iu > l) + mf(:,k,west) = mf(:,k,west) + taux(:,l,k) + elsewhere + mf(:,k,east) = mf(:,k,east) + taux(:,l,k) + end where + + where (iv > l) + mf(:,k,south) = mf(:,k,south) + tauy(:,l,k) + elsewhere + mf(:,k,north) = mf(:,k,north) + tauy(:,l,k) + end where + + end do + + end do + + call outfld(trim(prefix)//'WMF',mf(:,:,west),ncol,lchnk) + call outfld(trim(prefix)//'EMF',mf(:,:,east),ncol,lchnk) + call outfld(trim(prefix)//'SMF',mf(:,:,south),ncol,lchnk) + call outfld(trim(prefix)//'NMF',mf(:,:,north),ncol,lchnk) + + ! Simple output fields written to history file. + ! Total wind tendencies. + call outfld (trim(prefix)//'UTGWSPEC', utgw , ncol, lchnk) + call outfld (trim(prefix)//'VTGWSPEC', vtgw , ncol, lchnk) + call outfld (trim(prefix)//'TTGWSPEC', ttgw , ncol, lchnk) + + ! Tau in each direction. + call outfld (trim(prefix)//'TAUE', taucd(:,:,east), ncol, lchnk) + call outfld (trim(prefix)//'TAUW', taucd(:,:,west), ncol, lchnk) + call outfld (trim(prefix)//'TAUN', taucd(:,:,north), ncol, lchnk) + call outfld (trim(prefix)//'TAUS', taucd(:,:,south), ncol, lchnk) + + call outfld (trim(prefix)//'TAUNET', taucd(:,:,east)+taucd(:,:,west), & + ncol, lchnk) + +contains + + ! Given a value, finds which bin marked by "bounds" the value falls + ! into. + elemental function find_bin(val) result(idx) + real(r8), intent(in) :: val + + integer :: idx + + ! We just have to count how many bounds are exceeded. + if (val >= 0._r8) then + idx = count(val > bounds) + 1 + else + idx = count(val >= bounds) + 1 + end if + + end function find_bin + + ! Convert a speed to a wavenumber between -ngwv and ngwv. + elemental function c_to_l(c) result(l) + real(r8), intent(in) :: c + + integer :: l + + l = min( max(int(c/band%dc),-band%ngwv), band%ngwv ) + + end function c_to_l + +end subroutine gw_spec_outflds + +!========================================================================== + +! Generates names for tau output across the wave spectrum (e.g. +! BTAUXSn01 or TAUYSp05). +! Probably this should use a wavenumber dimension on one field rather +! than creating a ton of numbered fields. +character(len=9) pure function tau_fld_name(l, prefix, x_not_y) + ! Wavenumber + integer, intent(in) :: l + ! Single-character prefix for output + character(len=1), intent(in) :: prefix + ! X or Y? + logical, intent(in) :: x_not_y + + character(len=2) :: num_str + + tau_fld_name = trim(prefix) + + tau_fld_name = trim(tau_fld_name)//"TAU" + + if (x_not_y) then + tau_fld_name = trim(tau_fld_name)//"XS" + else + tau_fld_name = trim(tau_fld_name)//"YS" + end if + + if (l < 0) then + tau_fld_name = trim(tau_fld_name)//"n" + else + tau_fld_name = trim(tau_fld_name)//"p" + end if + + write(num_str,'(I2.2)') abs(l) + + tau_fld_name = trim(tau_fld_name)//num_str + +end function tau_fld_name + +!========================================================================== + +end module gw_drag diff --git a/src/physics/cam/gw_front.F90 b/src/physics/cam/gw_front.F90 new file mode 100644 index 0000000000..64e973818d --- /dev/null +++ b/src/physics/cam/gw_front.F90 @@ -0,0 +1,209 @@ +module gw_front + +! +! This module handles gravity waves from frontal sources, and was extracted +! from gw_drag in May 2013. +! + +use gw_utils, only: r8 +use gw_common, only: GWBand, pi, pver + +implicit none +private +save + +public :: CMSourceDesc +public :: flat_cm_desc +public :: gaussian_cm_desc +public :: gw_cm_src + +! Tuneable settings. +type CMSourceDesc + ! Source level. + integer :: ksrc + ! Level at which to check whether the frontogenesis function is above + ! the critical threshold. + integer :: kfront + ! Frontogenesis function critical threshold. + real(r8) :: frontgfc = huge(1._r8) + ! The stress spectrum to produce at the source level. + real(r8), allocatable :: src_tau(:) +end type CMSourceDesc + +contains + +! Create a flat profile to be launched (all wavenumbers have the same +! source strength, except that l=0 is excluded). +function flat_cm_desc(band, ksrc, kfront, frontgfc, taubgnd) result(desc) + ! Wavelengths triggered by frontogenesis. + type(GWBand), intent(in) :: band + ! The following are used to set the corresponding object components. + integer, intent(in) :: ksrc + integer, intent(in) :: kfront + real(r8), intent(in) :: frontgfc + ! Amount of stress to launch from each wavelength. + real(r8), intent(in) :: taubgnd + + type(CMSourceDesc) :: desc + + desc%ksrc = ksrc + desc%kfront = kfront + desc%frontgfc = frontgfc + + allocate(desc%src_tau(-band%ngwv:band%ngwv)) + desc%src_tau = taubgnd + + ! Prohibit wavenumber 0. + desc%src_tau(0) = 0._r8 + +end function flat_cm_desc + +! Create a source tau profile that is a gaussian over wavenumbers (l=0 is +! excluded). +function gaussian_cm_desc(band, ksrc, kfront, frontgfc, height, width) & + result(desc) + + use shr_spfn_mod, only: erfc => shr_spfn_erfc + + ! Wavelengths triggered by frontogenesis. + type(GWBand), intent(in) :: band + ! The following are used to set the corresponding object components. + integer, intent(in) :: ksrc + integer, intent(in) :: kfront + real(r8), intent(in) :: frontgfc + ! Parameters of gaussian. + real(r8), intent(in) :: height + real(r8), intent(in) :: width + + type(CMSourceDesc) :: desc + + ! Bounds used to average bins of the gaussian. + real(r8) :: gaussian_bounds(2*band%ngwv+2) + + ! Wavenumber index. + integer :: l + + desc%ksrc = ksrc + desc%kfront = kfront + desc%frontgfc = frontgfc + + allocate(desc%src_tau(-band%ngwv:band%ngwv)) + + ! Find the boundaries of each bin. + gaussian_bounds(:2*band%ngwv+1) = band%cref - 0.5_r8*band%dc + gaussian_bounds(2*band%ngwv+2) = band%cref(band%ngwv) + 0.5_r8*band%dc + + ! Integral of the gaussian at bin interfaces (from the point to + ! positive infinity). + gaussian_bounds = & + [( erfc(gaussian_bounds(l)/width)*height*width*sqrt(pi)/2._r8, & + l = 1, 2*band%ngwv+2 )] + + ! Get average in each bin using integral from right to left side. + desc%src_tau = & + (gaussian_bounds(:2*band%ngwv+1) - gaussian_bounds(2:)) / band%dc + + ! Prohibit wavenumber 0. + desc%src_tau(0) = 0._r8 + +end function gaussian_cm_desc + +!========================================================================== +subroutine gw_cm_src(ncol, band, desc, u, v, frontgf, & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp + !----------------------------------------------------------------------- + ! Driver for multiple gravity wave drag parameterization. + ! + ! The parameterization is assumed to operate only where water vapor + ! concentrations are negligible in determining the density. + !----------------------------------------------------------------------- + + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + + ! Wavelengths triggered by frontogenesis. + type(GWBand), intent(in) :: band + + ! Bandification of how to produce the gravity wave bandtrum. + type(CMSourceDesc), intent(in) :: desc + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Frontogenesis function. + real(r8), intent(in) :: frontgf(:,:) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + + !---------------------------Local Storage------------------------------- + ! Column and wavenumber indices. + integer :: k, l + + ! Whether or not to launch waves in this column. + logical :: launch_wave(ncol) + + ! Zonal/meridional wind averaged over source region. + real(r8) :: usrc(ncol), vsrc(ncol) + + !------------------------------------------------------------------------ + ! Determine the source layer wind and unit vectors, then project winds. + !------------------------------------------------------------------------ + + ! Just use the source level interface values for the source wind speed + ! and direction (unit vector). + src_level = desc%ksrc + tend_level = desc%ksrc + usrc = 0.5_r8*(u(:,desc%ksrc+1)+u(:,desc%ksrc)) + vsrc = 0.5_r8*(v(:,desc%ksrc+1)+v(:,desc%ksrc)) + + ! Get the unit vector components and magnitude at the surface. + call get_unit_vector(usrc, vsrc, xv, yv, ubi(:,desc%ksrc+1)) + + ! Project the local wind at midpoints onto the source wind. + do k = 1, desc%ksrc + ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv) + end do + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:desc%ksrc) = midpoint_interp(ubm(:,1:desc%ksrc)) + + !----------------------------------------------------------------------- + ! Gravity wave sources + !----------------------------------------------------------------------- + + tau = 0._r8 + + ! GW generation depends on frontogenesis at specified level (may be below + ! actual source level). + launch_wave = (frontgf(:,desc%kfront) > desc%frontgfc) + + do l = -band%ngwv, band%ngwv + where (launch_wave) + tau(:,l,desc%ksrc+1) = desc%src_tau(l) + end where + end do + + ! Set phase speeds as reference speeds plus the wind speed at the source + ! level. + c = spread(band%cref, 1, ncol) + & + spread(ubi(:,desc%ksrc+1), 2, 2*band%ngwv+1) + +end subroutine gw_cm_src + +end module gw_front diff --git a/src/physics/cam/gw_oro.F90 b/src/physics/cam/gw_oro.F90 new file mode 100644 index 0000000000..450171526e --- /dev/null +++ b/src/physics/cam/gw_oro.F90 @@ -0,0 +1,177 @@ +module gw_oro + +! +! This module handles gravity waves from orographic sources, and was +! extracted from gw_drag in May 2013. +! +use gw_utils, only: r8 +use coords_1d, only: Coords1D + +implicit none +private +save + +! Public interface +public :: gw_oro_src + +contains + +!========================================================================== + +subroutine gw_oro_src(ncol, band, p, & + u, v, t, sgh, zm, nm, & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + use gw_common, only: GWBand, pver, rair + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp + !----------------------------------------------------------------------- + ! Orographic source for multiple gravity wave drag parameterization. + ! + ! The stress is returned for a single wave with c=0, over orography. + ! For points where the orographic variance is small (including ocean), + ! the returned stress is zero. + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + ! Band to emit orographic waves in. + ! Regardless, we will only ever emit into l = 0. + type(GWBand), intent(in) :: band + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Midpoint temperatures. + real(r8), intent(in) :: t(ncol,pver) + ! Standard deviation of orography. + real(r8), intent(in) :: sgh(ncol) + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + ! Midpoint Brunt-Vaisalla frequencies. + real(r8), intent(in) :: nm(ncol,pver) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + ! Surface streamline displacement height (2*sgh). + real(r8) :: hdsp(ncol) + ! Max orographic standard deviation to use. + real(r8) :: sghmax + ! c=0 stress from orography. + real(r8) :: tauoro(ncol) + ! Averages over source region. + real(r8) :: nsrc(ncol) ! B-V frequency. + real(r8) :: rsrc(ncol) ! Density. + real(r8) :: usrc(ncol) ! Zonal wind. + real(r8) :: vsrc(ncol) ! Meridional wind. + + ! Difference in interface pressure across source region. + real(r8) :: dpsrc(ncol) + + ! Limiters (min/max values) + ! min surface displacement height for orographic waves + real(r8), parameter :: orohmin = 10._r8 + ! min wind speed for orographic waves + real(r8), parameter :: orovmin = 2._r8 + +!-------------------------------------------------------------------------- +! Average the basic state variables for the wave source over the depth of +! the orographic standard deviation. Here we assume that the appropiate +! values of wind, stability, etc. for determining the wave source are +! averages over the depth of the atmosphere penterated by the typical +! mountain. +! Reduces to the bottom midpoint values when sgh=0, such as over ocean. +!-------------------------------------------------------------------------- + + hdsp = 2.0_r8 * sgh + + k = pver + src_level = k-1 + rsrc = p%mid(:,k)/(rair*t(:,k)) * p%del(:,k) + usrc = u(:,k) * p%del(:,k) + vsrc = v(:,k) * p%del(:,k) + nsrc = nm(:,k)* p%del(:,k) + + do k = pver-1, 1, -1 + do i = 1, ncol + if (hdsp(i) > sqrt(zm(i,k)*zm(i,k+1))) then + src_level(i) = k-1 + rsrc(i) = rsrc(i) + & + p%mid(i,k) / (rair*t(i,k)) * p%del(i,k) + usrc(i) = usrc(i) + u(i,k) * p%del(i,k) + vsrc(i) = vsrc(i) + v(i,k) * p%del(i,k) + nsrc(i) = nsrc(i) + nm(i,k)* p%del(i,k) + end if + end do + ! Break the loop when all source levels found. + if (all(src_level >= k)) exit + end do + + do i = 1, ncol + dpsrc(i) = p%ifc(i,pver+1) - p%ifc(i,src_level(i)+1) + end do + + rsrc = rsrc / dpsrc + usrc = usrc / dpsrc + vsrc = vsrc / dpsrc + nsrc = nsrc / dpsrc + + ! Get the unit vector components and magnitude at the surface. + call get_unit_vector(usrc, vsrc, xv, yv, ubi(:,pver+1)) + + ! Project the local wind at midpoints onto the source wind. + do k = 1, pver + ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv) + end do + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:pver) = midpoint_interp(ubm) + + ! Determine the orographic c=0 source term following McFarlane (1987). + ! Set the source top interface index to pver, if the orographic term is + ! zero. + do i = 1, ncol + if ((ubi(i,pver+1) > orovmin) .and. (hdsp(i) > orohmin)) then + sghmax = band%fcrit2 * (ubi(i,pver+1) / nsrc(i))**2 + tauoro(i) = 0.5_r8 * band%kwv * min(hdsp(i)**2, sghmax) * & + rsrc(i) * nsrc(i) * ubi(i,pver+1) + else + tauoro(i) = 0._r8 + src_level(i) = pver + end if + end do + + ! Set the phase speeds and wave numbers in the direction of the source + ! wind. Set the source stress magnitude (positive only, note that the + ! sign of the stress is the same as (c-u). + tau = 0._r8 + do k = pver, minval(src_level), -1 + where (src_level <= k) tau(:,0,k+1) = tauoro + end do + + ! Allow wind tendencies all the way to the model bottom. + tend_level = pver + + ! No spectrum; phase speed is just 0. + c = 0._r8 + +end subroutine gw_oro_src + +end module gw_oro diff --git a/src/physics/cam/gw_rdg.F90 b/src/physics/cam/gw_rdg.F90 new file mode 100644 index 0000000000..6d1a56db93 --- /dev/null +++ b/src/physics/cam/gw_rdg.F90 @@ -0,0 +1,1048 @@ +module gw_rdg + +! +! This module handles gravity waves from orographic sources, and was +! extracted from gw_drag in May 2013. +! +use shr_const_mod, only: pii => shr_const_pi +use gw_utils, only: r8 +use gw_common, only: pver +use coords_1d, only: Coords1D +use spmd_utils,only: masterproc +use cam_abortutils, only: endrun + + +implicit none +private +save + +! Public interface +public :: gw_rdg_readnl +public :: gw_rdg_src +public :: gw_rdg_belowpeak +public :: gw_rdg_break_trap +public :: gw_rdg_do_vdiff + +! Tunable Parameters +!-------------------- +logical :: do_divstream + +!=========================================== +! Parameters for DS2017 (do_divstream=.T.) +!=========================================== +! Amplification factor - 1.0 for +! high-drag/windstorm regime +real(r8), protected :: C_BetaMax_DS + +! Max Ratio Fr2:Fr1 - 1.0 +real(r8), protected :: C_GammaMax + +! Normalized limits for Fr2(Frx) function +real(r8), protected :: Frx0 +real(r8), protected :: Frx1 + + +!=========================================== +! Parameters for SM2000 +!=========================================== +! Amplification factor - 1.0 for +! high-drag/windstorm regime +real(r8), protected :: C_BetaMax_SM + + + +! NOTE: Critical inverse Froude number Fr_c is +! 1./(SQRT(2.)~0.707 in SM2000 +! (should be <= 1) +real(r8), protected :: Fr_c + +logical, protected :: gw_rdg_do_vdiff=.true. + +logical :: do_smooth_regimes +logical :: do_adjust_tauoro +logical :: do_backward_compat + + +! Limiters (min/max values) +! min surface displacement height for orographic waves (m) +real(r8), protected :: orohmin +! min wind speed for orographic waves +real(r8), protected :: orovmin +! min stratification allowing wave behavior +real(r8), protected :: orostratmin +! min stratification allowing wave behavior +real(r8), protected :: orom2min + +!========================================================================== +contains +!========================================================================== + +subroutine gw_rdg_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_logical + + ! File containing namelist input. + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'gw_rdg_readnl' + + logical :: gw_rdg_do_divstream, gw_rdg_do_smooth_regimes, gw_rdg_do_adjust_tauoro, & + gw_rdg_do_backward_compat + + + real(r8) :: gw_rdg_C_BetaMax_DS, gw_rdg_C_GammaMax, & + gw_rdg_Frx0, gw_rdg_Frx1, gw_rdg_C_BetaMax_SM, gw_rdg_Fr_c, & + gw_rdg_orohmin, gw_rdg_orovmin, gw_rdg_orostratmin, gw_rdg_orom2min + + namelist /gw_rdg_nl/ gw_rdg_do_divstream, gw_rdg_C_BetaMax_DS, gw_rdg_C_GammaMax, & + gw_rdg_Frx0, gw_rdg_Frx1, gw_rdg_C_BetaMax_SM, gw_rdg_Fr_c, & + gw_rdg_do_smooth_regimes, gw_rdg_do_adjust_tauoro, & + gw_rdg_do_backward_compat, gw_rdg_orohmin, gw_rdg_orovmin, & + gw_rdg_orostratmin, gw_rdg_orom2min, gw_rdg_do_vdiff + + !---------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'gw_rdg_nl', status=ierr) + if (ierr == 0) then + read(unitn, gw_rdg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! Set the local variables + do_divstream = gw_rdg_do_divstream + C_BetaMax_DS = gw_rdg_C_BetaMax_DS + C_GammaMax = gw_rdg_C_GammaMax + Frx0 = gw_rdg_Frx0 + Frx1 = gw_rdg_Frx1 + C_BetaMax_SM = gw_rdg_C_BetaMax_SM + Fr_c = gw_rdg_Fr_c + do_smooth_regimes = gw_rdg_do_smooth_regimes + do_adjust_tauoro = gw_rdg_do_adjust_tauoro + do_backward_compat = gw_rdg_do_backward_compat + orohmin = gw_rdg_orohmin + orovmin = gw_rdg_orovmin + orostratmin = gw_rdg_orostratmin + orom2min = gw_rdg_orom2min + end if + + ! Broadcast the local variables + + call mpi_bcast(do_divstream, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_divstream") + call mpi_bcast(do_smooth_regimes, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_smooth_regimes") + call mpi_bcast(do_adjust_tauoro, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_adjust_tauoro") + call mpi_bcast(do_backward_compat, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_backward_compat") + + call mpi_bcast(C_BetaMax_DS, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: C_BetaMax_DS") + call mpi_bcast(C_GammaMax, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: C_GammaMax") + call mpi_bcast(Frx0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: Frx0") + call mpi_bcast(Frx1, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: Frx1") + call mpi_bcast(C_BetaMax_SM, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: C_BetaMax_SM") + call mpi_bcast(Fr_c, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: Fr_c") + call mpi_bcast(orohmin, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: orohmin") + call mpi_bcast(orovmin, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: orovmin") + call mpi_bcast(orostratmin, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: orostratmin") + call mpi_bcast(orom2min, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: orom2min") + + call mpi_bcast(gw_rdg_do_vdiff, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_rdg_do_vdiff") + + if (Fr_c > 1.0_r8) call endrun(sub//": FATAL: Fr_c must be <= 1") + +end subroutine gw_rdg_readnl + + +subroutine gw_rdg_src(ncol, band, p, & + u, v, t, mxdis, angxy, anixy, kwvrdg, iso, zi, nm, & + src_level, tend_level, bwv_level ,tlb_level , tau, ubm, ubi, xv, yv, & + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, c) + use gw_common, only: rair, GWBand + use gw_utils, only: dot_2d, midpoint_interp + !----------------------------------------------------------------------- + ! Orographic source for multiple gravity wave drag parameterization. + ! + ! The stress is returned for a single wave with c=0, over orography. + ! For points where the orographic variance is small (including ocean), + ! the returned stress is zero. + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + + ! Band to emit orographic waves in. + ! Regardless, we will only ever emit into l = 0. + type(GWBand), intent(in) :: band + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + + + ! Midpoint zonal/meridional winds. ( m s-1) + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Midpoint temperatures. (K) + real(r8), intent(in) :: t(ncol,pver) + ! Height estimate for ridge (m) [anisotropic orography]. + real(r8), intent(in) :: mxdis(ncol) + ! Angle of ridge axis w/resp to north (degrees) [anisotropic orography]. + real(r8), intent(in) :: angxy(ncol) + ! Anisotropy parameter [anisotropic orography]. + real(r8), intent(in) :: anixy(ncol) + ! horiz wavenumber [anisotropic orography]. + real(r8), intent(in) :: kwvrdg(ncol) + ! Isotropic source flag [anisotropic orography]. + integer, intent(in) :: iso(ncol) + ! Interface altitudes above ground (m). + real(r8), intent(in) :: zi(ncol,pver+1) + ! Midpoint Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: nm(ncol,pver) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + integer, intent(out) :: bwv_level(ncol),tlb_level(ncol) + + ! Averages over source region. + real(r8), intent(out) :: nsrc(ncol) ! B-V frequency. + real(r8), intent(out) :: rsrc(ncol) ! Density. + real(r8), intent(out) :: usrc(ncol) ! Zonal wind. + real(r8), intent(out) :: vsrc(ncol) ! Meridional wind. + real(r8), intent(out) :: ubmsrc(ncol) ! On-ridge wind. + ! Top of low-level flow layer. + real(r8), intent(out) :: tlb(ncol) + ! Bottom of linear wave region. + real(r8), intent(out) :: bwv(ncol) + ! normalized wavenumber + real(r8), intent(out) :: m2src(ncol) + + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + ! Froude numbers for flow/drag regimes + real(r8), intent(out) :: Fr1(ncol), Fr2(ncol), Frx(ncol) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + ! Surface streamline displacement height (2*sgh). + real(r8) :: hdsp(ncol) + + ! Difference in interface pressure across source region. + real(r8) :: dpsrc(ncol) + ! Thickness of downslope wind region. + real(r8) :: ddw(ncol) + ! Thickness of linear wave region. + real(r8) :: dwv(ncol) + ! Wind speed in source region. + real(r8) :: wmsrc(ncol) + + real(r8) :: ragl(ncol) + +!-------------------------------------------------------------------------- +! Check that ngwav is equal to zero, otherwise end the job +!-------------------------------------------------------------------------- + if (band%ngwv /= 0) call endrun(' gw_rdg_src :: ERROR - band%ngwv must be zero and it is not') + +!-------------------------------------------------------------------------- +! Average the basic state variables for the wave source over the depth of +! the orographic standard deviation. Here we assume that the appropiate +! values of wind, stability, etc. for determining the wave source are +! averages over the depth of the atmosphere penterated by the typical +! mountain. +! Reduces to the bottom midpoint values when mxdis=0, such as over ocean. +!-------------------------------------------------------------------------- + + hdsp = mxdis ! no longer multipied by 2 + src_level = pver+1 + bwv_level = -1 + tlb_level = -1 + + tau(:,0,:) = 0.0_r8 + + ! Find depth of "source layer" for mountain waves + ! i.e., between ground and mountain top + do k = pver, 1, -1 + do i = 1, ncol + ! Need to have h >= z(k+1) here or code will bomb when h=0. + if ( (hdsp(i) >= zi(i,k+1)) .and. (hdsp(i) < zi(i,k)) ) then + src_level(i) = k + end if + end do + end do + + rsrc = 0._r8 + usrc = 0._r8 + vsrc = 0._r8 + nsrc = 0._r8 + do i = 1, ncol + do k = pver, src_level(i), -1 + rsrc(i) = rsrc(i) + p%mid(i,k) / (rair*t(i,k))* p%del(i,k) + usrc(i) = usrc(i) + u(i,k) * p%del(i,k) + vsrc(i) = vsrc(i) + v(i,k) * p%del(i,k) + nsrc(i) = nsrc(i) + nm(i,k)* p%del(i,k) + end do + end do + + + do i = 1, ncol + dpsrc(i) = p%ifc(i,pver+1) - p%ifc(i,src_level(i)) + end do + + rsrc = rsrc / dpsrc + usrc = usrc / dpsrc + vsrc = vsrc / dpsrc + nsrc = nsrc / dpsrc + + wmsrc = sqrt( usrc**2 + vsrc**2 ) + + + ! Get the unit vector components + ! Want agl=0 with U>0 to give xv=1 + + ragl = angxy * pii/180._r8 + + ! protect from wierd "bad" angles + ! that may occur if hdsp is zero + where( hdsp <= orohmin ) + ragl = 0._r8 + end where + + yv =-sin( ragl ) + xv = cos( ragl ) + + + ! Kluge in possible "isotropic" obstacle. + where( ( iso == 1 ) .and. (wmsrc > orovmin) ) + xv = usrc/wmsrc + yv = vsrc/wmsrc + end where + + + ! Project the local wind at midpoints into the on-ridge direction + do k = 1, pver + ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv) + end do + ubmsrc = dot_2d(usrc , vsrc , xv, yv) + + ! Ensure on-ridge wind is positive at source level + do k = 1, pver + ubm(:,k) = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * ubm(:,k) + end do + + ! Sean says just use 1._r8 as + ! first argument + xv = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * xv + yv = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * yv + + ! Now make ubmsrc positive and protect + ! against zero + ubmsrc = abs(ubmsrc) + ubmsrc = max( 0.01_r8 , ubmsrc ) + + + ! The minimum stratification allowing GW behavior + ! should really depend on horizontal scale since + ! + ! m^2 ~ (N/U)^2 - k^2 + ! + ! Should also think about parameterizing + ! trapped lee-waves. + + + ! This needs to be made constistent with later + ! treatment of nonhydrostatic effects. + m2src = ( (nsrc/(ubmsrc+0.01_r8))**2 - kwvrdg**2 ) /((nsrc/(ubmsrc+0.01_r8))**2) + + + !------------------------------------------------------------- + ! Calculate provisional limits (in Z [m]) for 3 regimes. This + ! will modified later if wave breaking or trapping are + ! diagnosed + ! + ! ^ + ! | *** linear propagation *** + ! (H) -------- mountain top ------------- | *** or wave breaking **** + ! | *** regimes ************* + ! (BWV)------ bottom of linear waves ---- | + ! : | + ! ******* | + ! : | + ! (TLB)--- top of flow diversion layer--- ' + ! : + ! **** flow diversion ***** + ! : + !============================================ + + !============================================ + ! For Dividing streamline para (DS2017) + !-------------------------------------------- + ! High-drag downslope wind regime exists + ! between bottom of linear waves and top of + ! flow diversion. Linear waves can only + ! attain vertical displacment of f1*U/N. So, + ! bottom of linear waves is given by + ! + ! BWV = H - Fr1*U/N + ! + ! Downslope wind layer begins at BWV and + ! extends below it until some maximum high + ! drag obstacle height Fr2*U/N is attained + ! (where Fr2 >= f1). Below downslope wind + ! there is flow diversion, so top of + ! diversion layer (TLB) is equivalent to + ! bottom of downslope wind layer and is; + ! + ! TLB = H - Fr2*U/N + ! + !----------------------------------------- + + ! Critical inverse Froude number + !----------------------------------------------- + Fr1(:) = Fr_c * 1.00_r8 + Frx(:) = hdsp(:)*nsrc(:)/abs( ubmsrc(:) ) / Fr_c + + if ( do_divstream ) then + !------------------------------------------------ + ! Calculate Fr2(Frx) for DS2017 + !------------------------------------------------ + where(Frx <= Frx0) + Fr2(:) = Fr1(:) + Fr1(:)* C_GammaMax * anixy(:) + elsewhere((Frx > Frx0).and.(Frx <= Frx1) ) + Fr2(:) = Fr1(:) + Fr1(:)* C_GammaMax * anixy(:) & + * (Frx1 - Frx(:))/(Frx1-Frx0) + elsewhere(Frx > Frx1) + Fr2(:)=Fr1(:) + endwhere + else + !------------------------------------------ + ! Regime distinctions entirely carried by + ! amplification of taudsw (next subr) + !------------------------------------------ + Fr2(:)=Fr1(:) + end if + + + + where( m2src > orom2min ) + ddw = Fr2 * ( abs(ubmsrc) )/nsrc + elsewhere + ddw = 0._r8 + endwhere + + + ! If TLB is less than zero then obstacle is not + ! high enough to produce an low-level diversion layer + tlb = mxdis - ddw + where( tlb < 0._r8) + tlb = 0._r8 + endwhere + do k = pver, pver/2, -1 + do i = 1, ncol + if ( (tlb(i) > zi(i,k+1)) .and. (tlb(i) <= zi(i,k)) ) then + tlb_level(i) = k + end if + end do + end do + + + ! Find *BOTTOM* of linear wave layer (BWV) + !where ( nsrc > orostratmin ) + where( m2src > orom2min ) + dwv = Fr1 * ( abs(ubmsrc) )/nsrc + elsewhere + dwv = -9.999e9_r8 ! if weak strat - no waves + endwhere + + bwv = mxdis - dwv + where(( bwv < 0._r8) .or. (dwv < 0._r8) ) + bwv = 0._r8 + endwhere + do k = pver,1, -1 + do i = 1, ncol + if ( (bwv(i) > zi(i,k+1)) .and. (bwv(i) <= zi(i,k)) ) then + bwv_level(i) = k+1 + end if + end do + end do + + + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + ubi(:,2:pver) = midpoint_interp(ubm) + ubi(:,pver+1) = ubm(:,pver) + + ! Allow wind tendencies all the way to the model bottom. + tend_level = pver + + ! No spectrum; phase speed is just 0. + c = 0._r8 + + where( m2src < orom2min ) + tlb = mxdis + tlb_level = src_level + endwhere + + +end subroutine gw_rdg_src + + +!========================================================================== + +subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & + t, mxdis, anixy, kwvrdg, zi, nm, ni, rhoi, & + src_level , tau, & + ubmsrc, nsrc, rsrc, m2src,tlb,bwv,Fr1,Fr2,Frx, & + tauoro,taudsw, hdspwv,hdspdw ) + + use gw_common, only: GWBand + !----------------------------------------------------------------------- + ! Orographic source for multiple gravity wave drag parameterization. + ! + ! The stress is returned for a single wave with c=0, over orography. + ! For points where the orographic variance is small (including ocean), + ! the returned stress is zero. + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + ! Band to emit orographic waves in. + ! Regardless, we will only ever emit into l = 0. + type(GWBand), intent(in) :: band + ! Drag coefficient for low-level flow + real(r8), intent(in) :: rdg_cd_llb + + + ! Midpoint temperatures. (K) + real(r8), intent(in) :: t(ncol,pver) + ! Height estimate for ridge (m) [anisotropic orography]. + real(r8), intent(in) :: mxdis(ncol) + ! Anisotropy parameter [0-1] [anisotropic orography]. + real(r8), intent(in) :: anixy(ncol) + ! Inverse cross-ridge lengthscale (m-1) [anisotropic orography]. + real(r8), intent(inout) :: kwvrdg(ncol) + ! Interface altitudes above ground (m). + real(r8), intent(in) :: zi(ncol,pver+1) + ! Midpoint Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: nm(ncol,pver) + ! Interface Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: ni(ncol,pver+1) + ! Interface density (kg m-3). + real(r8), intent(in) :: rhoi(ncol,pver+1) + + ! Indices of top gravity wave source level + integer, intent(inout) :: src_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(inout) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Top of low-level flow layer. + real(r8), intent(inout) :: tlb(ncol) + ! Bottom of linear wave region. + real(r8), intent(inout) :: bwv(ncol) + ! surface stress from linear waves. + real(r8), intent(out) :: tauoro(ncol) + ! surface stress for downslope wind regime. + real(r8), intent(out) :: taudsw(ncol) + + ! Surface streamline displacement height for linear waves. + real(r8), intent(out) :: hdspwv(ncol) + ! Surface streamline displacement height for downslope wind regime. + real(r8), intent(out) :: hdspdw(ncol) + + + + ! Froude numbers for flow/drag regimes + real(r8), intent(in) :: Fr1(ncol), Fr2(ncol),Frx(ncol) + + ! Averages over source region. + real(r8), intent(in) :: m2src(ncol) ! normalized non-hydro wavenumber + real(r8), intent(in) :: nsrc(ncol) ! B-V frequency. + real(r8), intent(in) :: rsrc(ncol) ! Density. + real(r8), intent(in) :: ubmsrc(ncol) ! On-ridge wind. + + + !logical, intent(in), optional :: forcetlb + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + real(r8) :: Coeff_LB(ncol),tausat,ubsrcx(ncol),dswamp + real(r8) :: taulin(ncol),BetaMax + + ! ubsrcx introduced to account for situations with high shear, strong strat. + do i = 1, ncol + ubsrcx(i) = max( ubmsrc(i) , 0._r8 ) + end do + + do i = 1, ncol + if ( m2src(i) > orom2min ) then + hdspwv(i) = min( mxdis(i) , Fr1(i) * ubsrcx(i) / nsrc(i) ) + else + hdspwv(i) = 0._r8 + end if + end do + + if (do_divstream) then + do i = 1, ncol + if ( m2src(i) > orom2min ) then + hdspdw(i) = min( mxdis(i) , Fr2(i) * ubsrcx(i) / nsrc(i) ) + else + hdspdw(i) = 0._r8 + end if + end do + else + do i = 1, ncol + ! Needed only to mark where a DSW occurs + if ( m2src(i) > orom2min ) then + hdspdw(i) = mxdis(i) + else + hdspdw(i) = 0._r8 + end if + end do + end if + + ! Calculate form drag coefficient ("CD") + !-------------------------------------- + Coeff_LB = rdg_cd_llb*anixy + + ! Determine the orographic c=0 source term following McFarlane (1987). + ! Set the source top interface index to pver, if the orographic term is + ! zero. + ! + ! This formula is basically from + ! + ! tau(src) = rho * u' * w' + ! where + ! u' ~ N*h' and w' ~ U*h'/b (b="breite") + ! + ! and 1/b has been replaced with k (kwvrdg) + ! + do i = 1, ncol + if ( ( src_level(i) > 0 ) .and. ( m2src(i) > orom2min ) ) then + tauoro(i) = kwvrdg(i) * ( hdspwv(i)**2 ) * rsrc(i) * nsrc(i) & + * ubsrcx(i) + taudsw(i) = kwvrdg(i) * ( hdspdw(i)**2 ) * rsrc(i) * nsrc(i) & + * ubsrcx(i) + else + tauoro(i) = 0._r8 + taudsw(i) = 0._r8 + end if + end do + + if (do_divstream) then + do i = 1, ncol + taulin(i) = 0._r8 + end do + !--------------------------------------- + ! Need linear drag when divstream is not used is used + !--------------------------------------- + else + do i = 1, ncol + if ( ( src_level(i) > 0 ) .and. ( m2src(i) > orom2min ) ) then + taulin(i) = kwvrdg(i) * ( mxdis(i)**2 ) * rsrc(i) * nsrc(i) & + * ubsrcx(i) + else + taulin(i) = 0._r8 + end if + end do + end if + + if ( do_divstream ) then + ! Amplify DSW between Frx=1. and Frx=Frx1 + do i = 1,ncol + dswamp=0._r8 + BetaMax = C_BetaMax_DS * anixy(i) + if ( (Frx(i)>1._r8).and.(Frx(i)<=Frx1)) then + dswamp = (Frx(i)-1._r8)*(Frx1-Frx(i))/(0.25_r8*(Frx1-1._r8)**2) + end if + taudsw(i) = (1._r8 + BetaMax*dswamp)*taudsw(i) + end do + else + !------------------- + ! Scinocca&McFarlane + !-------------------- + do i = 1, ncol + BetaMax = C_BetaMax_SM * anixy(i) + if ( (Frx(i) >=1._r8) .and. (Frx(i) < 1.5_r8) ) then + dswamp = 2._r8 * BetaMax * (Frx(i) -1._r8) + else if ( ( Frx(i) >= 1.5_r8 ) .and. (Frx(i) < 3._r8 ) ) then + dswamp = ( 1._r8 + BetaMax - (0.666_r8**2) ) * ( 0.666_r8*(3._r8 - Frx(i) ))**2 & + + ( 1._r8 / Frx(i) )**2 -1._r8 + else + dswamp = 0._r8 + end if + if ( (Frx(i) >=1._r8) .and. (Frx(i) < 3._r8) ) then + taudsw(i) = (1._r8 + dswamp )*taulin(i) - tauoro(i) + else + taudsw(i) = 0._r8 + endif + ! This code defines "taudsw" as SUM of freely-propagating + ! DSW enhancement. Different than in SM2000 + taudsw(i) = taudsw(i) + tauoro(i) + end do + !---------------------------------------------------- + end if + + + do i = 1, ncol + if ( m2src(i) > orom2min ) then + where ( ( zi(i,:) < mxdis(i) ) .and. ( zi(i,:) >= bwv(i) ) ) + tau(i,0,:) = tauoro(i) + else where ( ( zi(i,:) < bwv(i) ) .and. ( zi(i,:) >= tlb(i) ) ) + tau(i,0,:) = tauoro(i) +( taudsw(i)-tauoro(i) )* & + ( bwv(i) - zi(i,:) ) / & + ( bwv(i) - tlb(i) ) + endwhere + ! low-level form drag on obstacle. Quantity kwvrdg (~1/b) appears for consistency + ! with tauoro and taudsw forms. Should be weighted by L*b/A_g before applied to flow. + where ( ( zi(i,:) < tlb(i) ) .and. ( zi(i,:) >= 0._r8 ) ) + tau(i,0,:) = taudsw(i) + & + Coeff_LB(i) * kwvrdg(i) * rsrc(i) * 0.5_r8 * (ubsrcx(i)**2) * ( tlb(i) - zi(i,:) ) + endwhere + + if (do_smooth_regimes) then + ! This blocks accounts for case where both mxdis and tlb fall + ! between adjacent edges + do k=1,pver + if ( (zi(i,k) >= tlb(i)).and.(zi(i,k+1) < tlb(i)).and. & + (zi(i,k) >= mxdis(i)).and.(zi(i,k+1) < mxdis(i)) ) then + src_level(i) = src_level(i)-1 + tau(i,0,k) = tauoro(i) + end if + end do + end if + + else !---------------------------------------------- + ! This block allows low-level dynamics to occur + ! even if m2 is less than orom2min + where ( ( zi(i,:) < tlb(i) ) .and. ( zi(i,:) >= 0._r8 ) ) + tau(i,0,:) = taudsw(i) + & + Coeff_LB(i) * kwvrdg(i) * rsrc(i) * 0.5_r8 * & + (ubsrcx(i)**2) * ( tlb(i) - zi(i,:) ) + endwhere + endif + end do + + ! This may be redundant with newest version of gw_drag_prof. + ! That code reaches down to level k=src_level+1. (jtb 1/5/16) + do i = 1, ncol + k=src_level(i) + if ( ni(i,k) > orostratmin ) then + tausat = (Fr_c**2) * kwvrdg(i) * rhoi(i,k) * ubsrcx(i)**3 / & + (1._r8*ni(i,k)) + else + tausat = 0._r8 + endif + tau(i,0,src_level(i)) = min( tauoro(i), tausat ) + end do + + + + ! Final clean-up. Do nothing if obstacle less than orohmin + do i = 1, ncol + if ( mxdis(i) < orohmin ) then + tau(i,0,:) = 0._r8 + tauoro(i) = 0._r8 + taudsw(i) = 0._r8 + endif + end do + + ! Disable vertical propagation if Scorer param is + ! too small. + do i = 1, ncol + if ( m2src(i) <= orom2min ) then + src_level(i)=1 + endif + end do + + + +end subroutine gw_rdg_belowpeak + +!========================================================================== +subroutine gw_rdg_break_trap(ncol, band, & + zi, nm, ni, ubm, ubi, rhoi, kwvrdg, bwv, tlb, wbr, & + src_level, tlb_level, & + hdspwv, hdspdw, mxdis, & + tauoro, taudsw, tau, & + ldo_trapped_waves, wdth_kwv_scale_in ) + use gw_common, only: GWBand + !----------------------------------------------------------------------- + ! Parameterization of high-drag regimes and trapped lee-waves for CAM + ! + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + ! Band to emit orographic waves in. + ! Regardless, we will only ever emit into l = 0. + type(GWBand), intent(in) :: band + + + ! Height estimate for ridge (m) [anisotropic orography]. + !real(r8), intent(in) :: mxdis(ncol) + ! Horz wavenumber for ridge (1/m) [anisotropic orography]. + real(r8), intent(in) :: kwvrdg(ncol) + ! Interface altitudes above ground (m). + real(r8), intent(in) :: zi(ncol,pver+1) + ! Midpoint Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: nm(ncol,pver) + ! Interface Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: ni(ncol,pver+1) + + ! Indices of gravity wave sources. + integer, intent(inout) :: src_level(ncol), tlb_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(inout) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! Wave Reynolds stresses at source. + real(r8), intent(inout) :: taudsw(ncol),tauoro(ncol) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(in) :: ubm(ncol,pver) + real(r8), intent(in) :: ubi(ncol,pver+1) + ! Interface density (kg m-3). + real(r8), intent(in) :: rhoi(ncol,pver+1) + + ! Top of low-level flow layer. + real(r8), intent(in) :: tlb(ncol) + ! Bottom of linear wave region. + real(r8), intent(in) :: bwv(ncol) + + ! Surface streamline displacement height for linear waves. + real(r8), intent(in) :: hdspwv(ncol) + ! Surface streamline displacement height for downslope wind regime. + real(r8), intent(in) :: hdspdw(ncol) + ! Ridge height. + real(r8), intent(in) :: mxdis(ncol) + + + ! Wave breaking level + real(r8), intent(out) :: wbr(ncol) + + logical, intent(in), optional :: ldo_trapped_waves + real(r8), intent(in), optional :: wdth_kwv_scale_in + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k, kp1, non_hydro + real(r8):: m2(ncol,pver),delz(ncol),tausat(ncol),trn(ncol) + real(r8):: wbrx(ncol) + real(r8):: phswkb(ncol,pver+1) + logical :: lldo_trapped_waves + real(r8):: wdth_kwv_scale + ! Indices of important levels. + integer :: trn_level(ncol) + + if (present(ldo_trapped_waves)) then + lldo_trapped_waves = ldo_trapped_waves + if(lldo_trapped_waves) then + non_hydro = 1 + else + non_hydro = 0 + endif + else + lldo_trapped_waves = .false. + non_hydro = 0 + endif + + if (present(wdth_kwv_scale_in)) then + wdth_kwv_scale = wdth_kwv_scale_in + else + wdth_kwv_scale = 1._r8 + endif + + ! Calculate vertical wavenumber**2 + !--------------------------------- + m2 = (nm / (abs(ubm)+.01_r8))**2 + do k=pver,1,-1 + m2(:,k) = m2(:,k) - non_hydro*(wdth_kwv_scale*kwvrdg)**2 + ! sweeping up, zero out m2 above first occurence + ! of m2(:,k)<=0 + kp1=min( k+1, pver ) + where( (m2(:,k) <= 0.0_r8 ).or.(m2(:,kp1) <= 0.0_r8 ) ) + m2(:,k) = 0._r8 + endwhere + end do + + ! Take square root of m**2 and + ! do vertical integral to find + ! WKB phase. + !----------------------------- + m2 = SQRT( m2 ) + phswkb(:,:)=0 + do k=pver,1,-1 + where( zi(:,k) > tlb(:) ) + delz(:) = min( zi(:,k)-zi(:,k+1) , zi(:,k)-tlb(:) ) + phswkb(:,k) = phswkb(:,k+1) + m2(:,k)*delz(:) + endwhere + end do + + ! Identify top edge of layer in which phswkb reaches 3*pi/2 + ! - approximately the "breaking level" + !---------------------------------------------------------- + wbr(:)=0._r8 + wbrx(:)=0._r8 + if (do_smooth_regimes) then + do k=pver,1,-1 + where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & + .and.(hdspdw(:)>hdspwv(:)) ) + wbr(:) = zi(:,k) + ! Extrapolation to make regime + ! transitions smoother + wbrx(:) = zi(:,k) - ( phswkb(:,k) - 1.5_r8*pii ) & + / ( m2(:,k) + 1.e-6_r8 ) + src_level(:) = k-1 + endwhere + end do + else + do k=pver,1,-1 + where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & + .and.(hdspdw(:)>hdspwv(:)) ) + wbr(:) = zi(:,k) + src_level(:) = k + endwhere + end do + end if + + ! Adjust tauoro at new source levels if needed. + ! This is problematic if Fr_c<1.0. Not sure why. + !---------------------------------------------------------- + if (do_adjust_tauoro) then + do i = 1,ncol + if (wbr(i) > 0._r8 ) then + tausat(i) = (Fr_c**2) * kwvrdg(i) * rhoi( i, src_level(i) ) & + * abs(ubi(i , src_level(i) ))**3 & + / ni( i , src_level(i) ) + tauoro(i) = min( tauoro(i), tausat(i) ) + end if + end do + end if + + if (do_smooth_regimes) then + do i = 1, ncol + do k=1,pver+1 + if ( ( zi(i,k) <= wbr(i) ) .and. ( zi(i,k) > tlb(i) ) ) then + tau(i,0,k) = tauoro(i) + (taudsw(i)-tauoro(i)) * & + ( wbrx(i) - zi(i,k) ) / & + ( wbrx(i) - tlb(i) ) + tau(i,0,k) = max( tau(i,0,k), tauoro(i) ) + endif + end do + end do + else + ! Following is for backwards B4B compatibility with earlier versions + ! ("N1" and "N5" -- Note: "N5" used do_backward_compat=.true.) + if (.not.do_backward_compat) then + do i = 1, ncol + do k=1,pver+1 + if ( ( zi(i,k) < wbr(i) ) .and. ( zi(i,k) >= tlb(i) ) ) then + tau(i,0,k) = tauoro(i) + (taudsw(i)-tauoro(i)) * & + ( wbr(i) - zi(i,k) ) / & + ( wbr(i) - tlb(i) ) + endif + end do + end do + else + do i = 1, ncol + do k=1,pver+1 + if ( ( zi(i,k) <= wbr(i) ) .and. ( zi(i,k) > tlb(i) ) ) then + tau(i,0,k) = tauoro(i) + (taudsw(i)-tauoro(i)) * & + ( wbr(i) - zi(i,k) ) / & + ( wbr(i) - tlb(i) ) + endif + end do + end do + end if + end if + + if (lldo_trapped_waves) then + + ! Identify top edge of layer in which Scorer param drops below 0 + ! - approximately the "turning level" + !---------------------------------------------------------- + trn(:)=1.e8_r8 + trn_level(:) = 0 ! pver+1 + where( m2(:,pver)<= 0._r8 ) + trn(:) = zi(:,pver) + trn_level(:) = pver + endwhere + do k=pver-1,1,-1 + where( (m2(:,k+1)> 0._r8).and.(m2(:,k)<= 0._r8) ) + trn(:) = zi(:,k) + trn_level(:) = k + endwhere + end do + + do i = 1,ncol + ! Case: Turning below mountain top + if ( (trn(i) < mxdis(i)).and.(trn_level(i)>=1) ) then + tau(i,0,:) = tau(i,0,:) - max( tauoro(i),taudsw(i) ) + tau(i,0,:) = max( tau(i,0,:) , 0._r8 ) + tau(i,0,1:tlb_level(i))=0._r8 + src_level(i) = 1 ! disable any more tau calculation + end if + ! Case: Turning but no breaking + if ( (wbr(i) == 0._r8 ).and.(trn(i)>mxdis(i)).and.(trn_level(i)>=1) ) then + where ( ( zi(i,:) <= trn(i) ) .and. ( zi(i,:) >= bwv(i) ) ) + tau(i,0,:) = tauoro(i) * & + ( trn(i) - zi(i,:) ) / & + ( trn(i) - bwv(i) ) + end where + src_level(i) = 1 ! disable any more tau calculation + end if + ! Case: Turning AND breaking. Turning ABOVE breaking + if ( (wbr(i) > 0._r8 ).and.(trn(i) >= wbr(i)).and.(trn_level(i)>=1) ) then + where ( ( zi(i,:) <= trn(i) ) .and. ( zi(i,:) >= wbr(i) ) ) + tau(i,0,:) = tauoro(i) * & + ( trn(i) - zi(i,:) ) / & + ( trn(i) - wbr(i) ) + endwhere + src_level(i) = 1 ! disable any more tau calculation + end if + ! Case: Turning AND breaking. Turning BELOW breaking + if ( (wbr(i) > 0._r8 ).and.(trn(i) < wbr(i)).and.(trn_level(i)>=1) ) then + tauoro(i) = 0._r8 + where ( ( zi(i,:) < wbr(i) ) .and. ( zi(i,:) >= tlb(i) ) ) + tau(i,0,:) = tauoro(i) + (taudsw(i)-tauoro(i)) * & + ( wbr(i) - zi(i,:) ) / & + ( wbr(i) - tlb(i) ) + endwhere + src_level(i) = 1 ! disable any more tau calculation + end if + end do + end if + + end subroutine gw_rdg_break_trap +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + +end module gw_rdg diff --git a/src/physics/cam/gw_utils.F90 b/src/physics/cam/gw_utils.F90 new file mode 100644 index 0000000000..c4a61aa5de --- /dev/null +++ b/src/physics/cam/gw_utils.F90 @@ -0,0 +1,77 @@ +module gw_utils + +! +! This module contains utility code for the gravity wave modules. +! + +implicit none +private +save + +! Real kind for gravity wave parameterization. +integer, public, parameter :: r8 = selected_real_kind(12) + +! Public interface +public :: get_unit_vector +public :: dot_2d +public :: midpoint_interp + +contains + +! Take two components of a vector, and find the unit vector components and +! total magnitude. +subroutine get_unit_vector(u, v, u_n, v_n, mag) + real(r8), intent(in) :: u(:) + real(r8), intent(in) :: v(:) + real(r8), intent(out) :: u_n(:) + real(r8), intent(out) :: v_n(:) + real(r8), intent(out) :: mag(:) + + integer :: i + + mag = sqrt(u*u + v*v) + + ! Has to be a loop/if instead of a where, because floating point + ! exceptions can trigger even on a masked divide-by-zero operation + ! (especially on Intel). + do i = 1, size(mag) + if (mag(i) > 0._r8) then + u_n(i) = u(i)/mag(i) + v_n(i) = v(i)/mag(i) + else + u_n(i) = 0._r8 + v_n(i) = 0._r8 + end if + end do + +end subroutine get_unit_vector + +! Vectorized version of a 2D dot product (since the intrinsic dot_product +! is more suitable for arrays of contiguous vectors). +function dot_2d(u1, v1, u2, v2) + real(r8), intent(in) :: u1(:), v1(:) + real(r8), intent(in) :: u2(:), v2(:) + + real(r8) :: dot_2d(size(u1)) + + dot_2d = u1*u2 + v1*v2 + +end function dot_2d + +! Pure function that interpolates the values of the input array along +! dimension 2. This is obviously not a very generic routine, unlike, say, +! CAM's lininterp. But it's used often enough that it seems worth providing +! here. +pure function midpoint_interp(arr) result(interp) + real(r8), intent(in) :: arr(:,:) + real(r8) :: interp(size(arr,1),size(arr,2)-1) + + integer :: i + + do i = 1, size(interp,2) + interp(:,i) = 0.5_r8 * (arr(:,i)+arr(:,i+1)) + end do + +end function midpoint_interp + +end module gw_utils diff --git a/src/physics/cam/hb_diff.F90 b/src/physics/cam/hb_diff.F90 new file mode 100644 index 0000000000..f1b67d68a0 --- /dev/null +++ b/src/physics/cam/hb_diff.F90 @@ -0,0 +1,690 @@ +module hb_diff + !--------------------------------------------------------------------------------- + ! Module to compute mixing coefficients associated with turbulence in the + ! planetary boundary layer and elsewhere. PBL coefficients are based on Holtslag + ! and Boville, 1991. + ! + ! Public interfaces: + ! init_hb_diff initializes time independent coefficients + ! compute_hb_diff computes eddy diffusivities and counter-gradient fluxes + ! + ! Private methods: + ! trbintd initializes time dependent variables + ! pblintd initializes time dependent variables that depend pbl depth + ! austausch_atm computes free atmosphere exchange coefficients + ! austausch_pbl computes pbl exchange coefficients + ! + !---------------------------Code history-------------------------------- + ! Standardized: J. Rosinski, June 1992 + ! Reviewed: P. Rasch, B. Boville, August 1992 + ! Reviewed: P. Rasch, April 1996 + ! Reviewed: B. Boville, April 1996 + ! rewritten: B. Boville, May 2000 + ! rewritten: B. Stevens, August 2000 + ! modularized: J. McCaa, September 2004 + !--------------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc ! output from hb_init should be eliminated + use ppgrid, only: pver, pverp, pcols ! these should be passed in + use cam_logfile, only: iulog + + implicit none + private + save + + ! Public interfaces + public init_hb_diff + public compute_hb_diff + public pblintd + ! + ! PBL limits + ! + real(r8), parameter :: pblmaxp = 4.e4_r8 ! pbl max depth in pressure units + real(r8), parameter :: zkmin = 0.01_r8 ! Minimum kneutral*f(ri) + ! + ! PBL Parameters + ! + real(r8), parameter :: onet = 1._r8/3._r8 ! 1/3 power in wind gradient expression + real(r8), parameter :: betam = 15.0_r8 ! Constant in wind gradient expression + real(r8), parameter :: betas = 5.0_r8 ! Constant in surface layer gradient expression + real(r8), parameter :: betah = 15.0_r8 ! Constant in temperature gradient expression + real(r8), parameter :: fakn = 7.2_r8 ! Constant in turbulent prandtl number + real(r8), parameter :: fak = 8.5_r8 ! Constant in surface temperature excess + real(r8), parameter :: ricr = 0.3_r8 ! Critical richardson number + real(r8), parameter :: sffrac= 0.1_r8 ! Surface layer fraction of boundary layer + real(r8), parameter :: binm = betam*sffrac ! betam * sffrac + real(r8), parameter :: binh = betah*sffrac ! betah * sffrac + + ! Pbl constants set using values from other parts of code + + real(r8) :: cpair ! Specific heat of dry air + real(r8) :: g ! Gravitational acceleration + real(r8) :: ml2(pverp) ! Mixing lengths squared + real(r8) :: vk ! Von Karman's constant + real(r8) :: ccon ! fak * sffrac * vk + + integer :: npbl ! Maximum number of levels in pbl from surface + integer :: ntop_turb ! Top level to which turbulent vertical diffusion is applied. + integer :: nbot_turb ! Bottom level to which turbulent vertical diff is applied. + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine init_hb_diff(gravx, cpairx, ntop_eddy, nbot_eddy, pref_mid, & + vkx, eddy_scheme) + + !----------------------------------------------------------------------- + ! + ! Initialize time independent variables of turbulence/pbl package. + ! + !----------------------------------------------------------------------- + + !------------------------------Arguments-------------------------------- + real(r8), intent(in) :: gravx ! acceleration of gravity + real(r8), intent(in) :: cpairx ! specific heat of dry air + real(r8), intent(in) :: pref_mid(pver)! reference pressures at midpoints + real(r8), intent(in) :: vkx ! Von Karman's constant + integer, intent(in) :: ntop_eddy ! Top level to which eddy vert diff is applied. + integer, intent(in) :: nbot_eddy ! Bottom level to which eddy vert diff is applied. + character(len=16), intent(in) :: eddy_scheme + + !---------------------------Local workspace----------------------------- + integer :: k ! vertical loop index + !----------------------------------------------------------------------- + + ! Basic constants + cpair = cpairx + g = gravx + vk = vkx + ccon = fak*sffrac*vk + ntop_turb = ntop_eddy + nbot_turb = nbot_eddy + + ! Set the square of the mixing lengths. + ml2(ntop_turb) = 0._r8 + do k = ntop_turb+1, nbot_turb + ml2(k) = 30.0_r8**2 ! HB scheme: length scale = 30m + if ( eddy_scheme .eq. 'HBR' ) then + ml2(k) = 1.0_r8**2 ! HBR scheme: length scale = 1m + end if + end do + ml2(nbot_turb+1) = 0._r8 + + ! Limit pbl height to regions below 400 mb + ! npbl = max number of levels (from bottom) in pbl + + npbl = 0 + do k=nbot_turb,ntop_turb,-1 + if (pref_mid(k) >= pblmaxp) then + npbl = npbl + 1 + end if + end do + npbl = max(npbl,1) + + if (masterproc) then + write(iulog,*)'INIT_HB_DIFF: PBL height will be limited to bottom ',npbl, & + ' model levels. Top is ',pref_mid(pverp-npbl),' pascals' + end if + +end subroutine init_hb_diff + +!=============================================================================== + + subroutine compute_hb_diff(lchnk, ncol, & + th ,t ,q ,z ,zi , & + pmid ,u ,v ,taux ,tauy , & + shflx ,qflx ,obklen ,ustar ,pblh , & + kvm ,kvh ,kvq ,cgh ,cgs , & + tpert ,qpert ,cldn ,ocnfrac ,tke , & + ri , & + eddy_scheme) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Interface routines for calcualtion and diatnostics of turbulence related + ! coefficients + ! + ! Author: B. Stevens (rewrite August 2000) + ! + !----------------------------------------------------------------------- + + use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm + + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: lchnk ! chunk index (for debug only) + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: th(pcols,pver) ! potential temperature [K] + real(r8), intent(in) :: t(pcols,pver) ! temperature (used for density) + real(r8), intent(in) :: q(pcols,pver) ! specific humidity [kg/kg] + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: zi(pcols,pverp) ! height above surface [m] + real(r8), intent(in) :: u(pcols,pver) ! zonal velocity + real(r8), intent(in) :: v(pcols,pver) ! meridional velocity + real(r8), intent(in) :: taux(pcols) ! zonal stress [N/m2] + real(r8), intent(in) :: tauy(pcols) ! meridional stress [N/m2] + real(r8), intent(in) :: shflx(pcols) ! sensible heat flux + real(r8), intent(in) :: qflx(pcols) ! water vapor flux + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures + real(r8), intent(in) :: cldn(pcols,pver) ! new cloud fraction + real(r8), intent(in) :: ocnfrac(pcols) ! Land fraction + character(len=16), intent(in) :: eddy_scheme + + ! + ! Output arguments + ! + real(r8), intent(out) :: kvm(pcols,pverp) ! eddy diffusivity for momentum [m2/s] + real(r8), intent(out) :: kvh(pcols,pverp) ! eddy diffusivity for heat [m2/s] + real(r8), intent(out) :: kvq(pcols,pverp) ! eddy diffusivity for constituents [m2/s] + real(r8), intent(out) :: cgh(pcols,pverp) ! counter-gradient term for heat [J/kg/m] + real(r8), intent(out) :: cgs(pcols,pverp) ! counter-gradient star (cg/flux) + real(r8), intent(out) :: tpert(pcols) ! convective temperature excess + real(r8), intent(out) :: qpert(pcols) ! convective humidity excess + real(r8), intent(out) :: ustar(pcols) ! surface friction velocity [m/s] + real(r8), intent(out) :: obklen(pcols) ! Obukhov length + real(r8), intent(out) :: pblh(pcols) ! boundary-layer height [m] + real(r8), intent(out) :: tke(pcols,pverp) ! turbulent kinetic energy (estimated) + real(r8), intent(out) :: ri(pcols,pver) ! richardson number: n2/s2 + ! + !---------------------------Local workspace----------------------------- + ! + real(r8) :: thv(pcols,pver) ! virtual temperature + real(r8) :: rrho(pcols) ! 1./bottom level density + real(r8) :: wstar(pcols) ! convective velocity scale [m/s] + real(r8) :: kqfs(pcols) ! kinematic surf constituent flux (kg/m2/s) + real(r8) :: khfs(pcols) ! kinimatic surface heat flux + real(r8) :: kbfs(pcols) ! surface buoyancy flux + real(r8) :: kvf(pcols,pverp) ! free atmospheric eddy diffsvty [m2/s] + real(r8) :: s2(pcols,pver) ! shear squared + real(r8) :: n2(pcols,pver) ! brunt vaisaila frequency + real(r8) :: bge(pcols) ! buoyancy gradient enhancment + integer :: ktopbl(pcols) ! index of first midpoint inside pbl + ! + ! Initialize time dependent variables that do not depend on pbl height + ! + + ! virtual temperature + call virtem(ncol, (pver-ntop_turb+1), th(:ncol,ntop_turb:),q(:ncol,ntop_turb:), thv(:ncol,ntop_turb:)) + + ! Compute ustar, Obukhov length, and kinematic surface fluxes. + call calc_ustar(ncol, t(:ncol,pver),pmid(:ncol,pver),taux(:ncol),tauy(:ncol), & + rrho(:ncol),ustar(:ncol)) + call calc_obklen(ncol, th(:ncol,pver), thv(:ncol,pver), qflx(:ncol), & + shflx(:ncol), rrho(:ncol), ustar(:ncol), & + khfs(:ncol), kqfs(:ncol), kbfs(:ncol), & + obklen(:ncol)) + ! Calculate s2, n2, and Richardson number. + call trbintd(ncol , & + thv ,z ,u ,v , & + s2 ,n2 ,ri ) + ! + ! Initialize time dependent variables that do depend on pbl height + ! + call pblintd(ncol , & + thv ,z ,u ,v , & + ustar ,obklen ,kbfs ,pblh ,wstar , & + zi ,cldn ,ocnfrac ,bge ) + ! + ! Get free atmosphere exchange coefficients + ! + call austausch_atm(pcols, ncol, pver, ntop_turb, nbot_turb, & + ml2, ri, s2, kvf) + ! + ! Get pbl exchange coefficients + ! + call austausch_pbl(lchnk, ncol, & + z ,kvf ,kqfs ,khfs ,kbfs , & + obklen ,ustar ,wstar ,pblh ,kvm , & + kvh ,cgh ,cgs ,tpert ,qpert , & + ktopbl ,tke ,bge ,eddy_scheme) + ! + + kvq(:ncol,:) = kvh(:ncol,:) + + return + end subroutine compute_hb_diff + ! + !=============================================================================== + subroutine trbintd(ncol , & + thv ,z ,u ,v , & + s2 ,n2 ,ri ) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Time dependent initialization + ! + ! Method: + ! Diagnosis of variables that do not depend on mixing assumptions or + ! PBL depth + ! + ! Author: B. Stevens (extracted from pbldiff, August, 2000) + ! + !----------------------------------------------------------------------- + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: thv(pcols,pver) ! virtual temperature + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: u(pcols,pver) ! windspeed x-direction [m/s] + real(r8), intent(in) :: v(pcols,pver) ! windspeed y-direction [m/s] + + ! + ! Output arguments + ! + real(r8), intent(out) :: s2(pcols,pver) ! shear squared + real(r8), intent(out) :: n2(pcols,pver) ! brunt vaisaila frequency + real(r8), intent(out) :: ri(pcols,pver) ! richardson number: n2/s2 + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i ! longitude index + integer :: k ! level index + + real(r8) :: vvk ! velocity magnitude squared + real(r8) :: dvdz2 ! velocity shear squared + real(r8) :: dz ! delta z between midpoints + ! + ! Compute shear squared (s2), brunt vaisaila frequency (n2) and related richardson + ! number (ri). Use virtual temperature to compute n2. + ! + + do k=ntop_turb,nbot_turb-1 + do i=1,ncol + dvdz2 = (u(i,k)-u(i,k+1))**2 + (v(i,k)-v(i,k+1))**2 + dvdz2 = max(dvdz2,1.e-36_r8) + dz = z(i,k) - z(i,k+1) + s2(i,k) = dvdz2/(dz**2) + n2(i,k) = g*2.0_r8*( thv(i,k) - thv(i,k+1))/((thv(i,k) + thv(i,k+1))*dz) + ri(i,k) = n2(i,k)/s2(i,k) + end do + end do + + return + end subroutine trbintd + ! + !=============================================================================== + subroutine pblintd(ncol , & + thv ,z ,u ,v , & + ustar ,obklen ,kbfs ,pblh ,wstar , & + zi ,cldn ,ocnfrac ,bge ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Diagnose standard PBL variables + ! + ! Method: + ! Diagnosis of PBL depth and related variables. In this case only wstar. + ! The PBL depth follows: + ! Holtslag, A.A.M., and B.A. Boville, 1993: + ! Local versus Nonlocal Boundary-Layer Diffusion in a Global Climate + ! Model. J. Clim., vol. 6., p. 1825--1842. + ! + ! Updated by Holtslag and Hack to exclude the surface layer from the + ! definition of the boundary layer Richardson number. Ri is now defined + ! across the outer layer of the pbl (between the top of the surface + ! layer and the pbl top) instead of the full pbl (between the surface and + ! the pbl top). For simiplicity, the surface layer is assumed to be the + ! region below the first model level (otherwise the boundary layer depth + ! determination would require iteration). + ! + ! Modified for boundary layer height diagnosis: Bert Holtslag, june 1994 + ! >>>>>>>>> (Use ricr = 0.3 in this formulation) + ! + ! Author: B. Stevens (extracted from pbldiff, August 2000) + ! + !----------------------------------------------------------------------- + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: thv(pcols,pver) ! virtual temperature + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: u(pcols,pver) ! windspeed x-direction [m/s] + real(r8), intent(in) :: v(pcols,pver) ! windspeed y-direction [m/s] + real(r8), intent(in) :: ustar(pcols) ! surface friction velocity [m/s] + real(r8), intent(in) :: obklen(pcols) ! Obukhov length + real(r8), intent(in) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3] + real(r8), intent(in) :: zi(pcols,pverp) ! height above surface [m] + real(r8), intent(in) :: cldn(pcols,pver) ! new cloud fraction + real(r8), intent(in) :: ocnfrac(pcols) ! Land fraction + + ! + ! Output arguments + ! + real(r8), intent(out) :: wstar(pcols) ! convective sclae velocity [m/s] + real(r8), intent(out) :: pblh(pcols) ! boundary-layer height [m] + real(r8), intent(out) :: bge(pcols) ! buoyancy gradient enhancment + ! + !---------------------------Local parameters---------------------------- + ! + real(r8), parameter :: tiny = 1.e-36_r8 ! lower bound for wind magnitude + real(r8), parameter :: fac = 100._r8 ! ustar parameter in height diagnosis + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i ! longitude index + integer :: k ! level index + + real(r8) :: phiminv(pcols) ! inverse phi function for momentum + real(r8) :: phihinv(pcols) ! inverse phi function for heat + real(r8) :: rino(pcols,pver) ! bulk Richardson no. from level to ref lev + real(r8) :: tlv(pcols) ! ref. level pot tmp + tmp excess + real(r8) :: vvk ! velocity magnitude squared + + logical :: unstbl(pcols) ! pts w/unstbl pbl (positive virtual ht flx) + logical :: check(pcols) ! True=>chk if Richardson no.>critcal + logical :: ocncldcheck(pcols) ! True=>if ocean surface and cloud in lowest layer + ! + ! Compute Obukhov length virtual temperature flux and various arrays for use later: + ! + do i=1,ncol + check(i) = .true. + rino(i,pver) = 0.0_r8 + pblh(i) = z(i,pver) + end do + ! + ! + ! PBL height calculation: Scan upward until the Richardson number between + ! the first level and the current level exceeds the "critical" value. + ! + do k=pver-1,pver-npbl+1,-1 + do i=1,ncol + if (check(i)) then + vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino(i,k) = g*(thv(i,k) - thv(i,pver))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + if (rino(i,k) >= ricr) then + pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1)) * & + (z(i,k) - z(i,k+1)) + check(i) = .false. + end if + end if + end do + end do + ! + ! Estimate an effective surface temperature to account for surface fluctuations + ! + do i=1,ncol + if (check(i)) pblh(i) = z(i,pverp-npbl) + unstbl(i) = (kbfs(i) > 0._r8) + check(i) = (kbfs(i) > 0._r8) + if (check(i)) then + phiminv(i) = (1._r8 - binm*pblh(i)/obklen(i))**onet + rino(i,pver) = 0.0_r8 + tlv(i) = thv(i,pver) + kbfs(i)*fak/( ustar(i)*phiminv(i) ) + end if + end do + ! + ! Improve pblh estimate for unstable conditions using the convective temperature excess: + ! + do i = 1,ncol + bge(i) = 1.e-8_r8 + end do + do k=pver-1,pver-npbl+1,-1 + do i=1,ncol + if (check(i)) then + vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino(i,k) = g*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + if (rino(i,k) >= ricr) then + pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1))* & + (z(i,k) - z(i,k+1)) + bge(i) = 2._r8*g/(thv(i,k)+thv(i,k+1))*(thv(i,k)-thv(i,k+1))/(z(i,k)-z(i,k+1))*pblh(i) + if (bge(i).lt.0._r8) then + bge(i) = 1.e-8_r8 + endif + check(i) = .false. + end if + end if + end do + end do + ! + ! PBL height must be greater than some minimum mechanical mixing depth + ! Several investigators have proposed minimum mechanical mixing depth + ! relationships as a function of the local friction velocity, u*. We + ! make use of a linear relationship of the form h = c u* where c=700. + ! The scaling arguments that give rise to this relationship most often + ! represent the coefficient c as some constant over the local coriolis + ! parameter. Here we make use of the experimental results of Koracin + ! and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f + ! where f was evaluated at 39.5 N and 52 N. Thus we use a typical mid + ! latitude value for f so that c = 0.07/f = 700. Also, do not allow + ! PBL to exceed some maximum (npbl) number of allowable points + ! + do i=1,ncol + if (check(i)) pblh(i) = z(i,pverp-npbl) + pblh(i) = max(pblh(i),700.0_r8*ustar(i)) + wstar(i) = (max(0._r8,kbfs(i))*g*pblh(i)/thv(i,pver))**onet + end do + ! + ! Final requirement on PBL heightis that it must be greater than the depth + ! of the lowest model level over ocean if there is any cloud diagnosed in + ! the lowest model level. This is to deal with the inadequacies of the + ! current "dry" formulation of the boundary layer, where this test is + ! used to identify circumstances where there is marine stratus in the + ! lowest level, and to provide a weak ventilation of the layer to avoid + ! a pathology in the cloud scheme (locking in low-level stratiform cloud) + ! If over an ocean surface, and any cloud is diagnosed in the + ! lowest level, set pblh to 50 meters higher than top interface of lowest level + ! + ! jrm This is being applied everywhere (not just ocean)! + do i=1,ncol + ocncldcheck(i) = .false. + if (cldn(i,pver).ge.0.0_r8) ocncldcheck(i) = .true. + if (ocncldcheck(i)) pblh(i) = max(pblh(i),zi(i,pver) + 50._r8) + end do + ! + return + end subroutine pblintd + ! + !=============================================================================== + subroutine austausch_pbl(lchnk ,ncol , & + z ,kvf ,kqfs ,khfs ,kbfs , & + obklen ,ustar ,wstar ,pblh ,kvm , & + kvh ,cgh ,cgs ,tpert ,qpert , & + ktopbl ,tke ,bge ,eddy_scheme) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Atmospheric Boundary Layer Computation + ! + ! Method: + ! Nonlocal scheme that determines eddy diffusivities based on a + ! specified boundary layer height and a turbulent velocity scale; + ! also, countergradient effects for heat and moisture, and constituents + ! are included, along with temperature and humidity perturbations which + ! measure the strength of convective thermals in the lower part of the + ! atmospheric boundary layer. + ! + ! For more information, see Holtslag, A.A.M., and B.A. Boville, 1993: + ! Local versus Nonlocal Boundary-Layer Diffusion in a Global Climate + ! Model. J. Clim., vol. 6., p. 1825--1842. + ! + ! Updated by Holtslag and Hack to exclude the surface layer from the + ! definition of the boundary layer Richardson number. Ri is now defined + ! across the outer layer of the pbl (between the top of the surface + ! layer and the pbl top) instead of the full pbl (between the surface and + ! the pbl top). For simiplicity, the surface layer is assumed to be the + ! region below the first model level (otherwise the boundary layer depth + ! determination would require iteration). + ! + ! Author: B. Boville, B. Stevens (rewrite August 2000) + ! + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: lchnk ! local chunk index (for debug only) + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: kvf(pcols,pverp) ! free atmospheric eddy diffsvty [m2/s] + real(r8), intent(in) :: kqfs(pcols) ! kinematic surf cnstituent flux (kg/m2/s) + real(r8), intent(in) :: khfs(pcols) ! kinimatic surface heat flux + real(r8), intent(in) :: kbfs(pcols) ! surface buoyancy flux + real(r8), intent(in) :: pblh(pcols) ! boundary-layer height [m] + real(r8), intent(in) :: obklen(pcols) ! Obukhov length + real(r8), intent(in) :: ustar(pcols) ! surface friction velocity [m/s] + real(r8), intent(in) :: wstar(pcols) ! convective velocity scale [m/s] + real(r8), intent(in) :: bge(pcols) ! buoyancy gradient enhancment + character(len=16), intent(in) :: eddy_scheme + + ! + ! Output arguments + ! + real(r8), intent(out) :: kvm(pcols,pverp) ! eddy diffusivity for momentum [m2/s] + real(r8), intent(out) :: kvh(pcols,pverp) ! eddy diffusivity for heat [m2/s] + real(r8), intent(out) :: cgh(pcols,pverp) ! counter-gradient term for heat [J/kg/m] + real(r8), intent(out) :: cgs(pcols,pverp) ! counter-gradient star (cg/flux) + real(r8), intent(out) :: tpert(pcols) ! convective temperature excess + real(r8), intent(out) :: qpert(pcols) ! convective humidity excess + + integer, intent(out) :: ktopbl(pcols) ! index of first midpoint inside pbl + real(r8), intent(out) :: tke(pcols,pverp) ! turbulent kinetic energy (estimated) + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i ! longitude index + integer :: k ! level index + + real(r8) :: phiminv(pcols) ! inverse phi function for momentum + real(r8) :: phihinv(pcols) ! inverse phi function for heat + real(r8) :: wm(pcols) ! turbulent velocity scale for momentum + real(r8) :: zp(pcols) ! current level height + one level up + real(r8) :: fak1(pcols) ! k*ustar*pblh + real(r8) :: fak2(pcols) ! k*wm*pblh + real(r8) :: fak3(pcols) ! fakn*wstar/wm + real(r8) :: pblk(pcols) ! level eddy diffusivity for momentum + real(r8) :: pr(pcols) ! Prandtl number for eddy diffusivities + real(r8) :: zl(pcols) ! zmzp / Obukhov length + real(r8) :: zh(pcols) ! zmzp / pblh + real(r8) :: zzh(pcols) ! (1-(zmzp/pblh))**2 + real(r8) :: zmzp ! level height halfway between zm and zp + real(r8) :: term ! intermediate calculation + real(r8) :: kve ! diffusivity at entrainment layer in unstable cases + + logical :: unstbl(pcols) ! pts w/unstbl pbl (positive virtual ht flx) + logical :: pblpt(pcols) ! pts within pbl + ! + ! Initialize height independent arrays + ! + + !drb initialize variables for runtime error checking + kvm = 0._r8 + kvh = 0._r8 + kve = 0._r8 + cgh = 0._r8 + cgs = 0._r8 + tpert = 0._r8 + qpert = 0._r8 + ktopbl = 0._r8 + tke = 0._r8 + + do i=1,ncol + unstbl(i) = (kbfs(i) > 0._r8) + pblk(i) = 0.0_r8 + fak1(i) = ustar(i)*pblh(i)*vk + if (unstbl(i)) then + phiminv(i) = (1._r8 - binm*pblh(i)/obklen(i))**onet + phihinv(i) = sqrt(1._r8 - binh*pblh(i)/obklen(i)) + wm(i) = ustar(i)*phiminv(i) + fak2(i) = wm(i)*pblh(i)*vk + fak3(i) = fakn*wstar(i)/wm(i) + tpert(i) = max(khfs(i)*fak/wm(i),0._r8) + qpert(i) = max(kqfs(i)*fak/wm(i),0._r8) + else + tpert(i) = max(khfs(i)*fak/ustar(i),0._r8) + qpert(i) = max(kqfs(i)*fak/ustar(i),0._r8) + end if + end do + ! + ! Initialize output arrays with free atmosphere values + ! + do k=1,pverp + do i=1,ncol + kvm(i,k) = kvf(i,k) + kvh(i,k) = kvf(i,k) + cgh(i,k) = 0.0_r8 + cgs(i,k) = 0.0_r8 + end do + end do + ! + ! Main level loop to compute the diffusivities and counter-gradient terms. These terms are + ! only calculated at points determined to be in the interior of the pbl (pblpt(i)==.true.), + ! and then calculations are directed toward regime: stable vs unstable, surface vs outer + ! layer. + ! + do k=pver,pver-npbl+2,-1 + do i=1,ncol + pblpt(i) = (z(i,k) < pblh(i)) + if (pblpt(i)) then + ktopbl(i) = k + zp(i) = z(i,k-1) + if (zkmin == 0.0_r8 .and. zp(i) > pblh(i)) zp(i) = pblh(i) + zmzp = 0.5_r8*(z(i,k) + zp(i)) ! we think this is an approximation to the interface height (where KVs are calculated) + zh(i) = zmzp/pblh(i) + zl(i) = zmzp/obklen(i) + zzh(i) = zh(i)*max(0._r8,(1._r8 - zh(i)))**2 + if (unstbl(i)) then + if (zh(i) < sffrac) then + term = (1._r8 - betam*zl(i))**onet + pblk(i) = fak1(i)*zzh(i)*term + pr(i) = term/sqrt(1._r8 - betah*zl(i)) + else + pblk(i) = fak2(i)*zzh(i) + pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak + cgs(i,k) = fak3(i)/(pblh(i)*wm(i)) + cgh(i,k) = khfs(i)*cgs(i,k)*cpair + end if + else + if (zl(i) <= 1._r8) then + pblk(i) = fak1(i)*zzh(i)/(1._r8 + betas*zl(i)) + else + pblk(i) = fak1(i)*zzh(i)/(betas + zl(i)) + end if + pr(i) = 1._r8 + end if + kvm(i,k) = max(pblk(i),kvf(i,k)) + kvh(i,k) = max(pblk(i)/pr(i),kvf(i,k)) + end if + end do + end do + + ! + ! Check whether last allowed midpoint is within pbl + ! + + if ( eddy_scheme .eq. 'HBR' ) then + ! apply new diffusivity at entrainment zone + do i = 1,ncol + if (bge(i) > 1.e-7_r8) then + k = ktopbl(i) + kve = 0.2_r8*(wstar(i)**3+5._r8*ustar(i)**3)/bge(i) + kvm(i,k) = kve + kvh(i,k) = kve + end if + end do + end if + + ! Crude estimate of tke (tke=0 above boundary layer) + do k = max(pverp-npbl,2),pverp + do i = 1, ncol + if (z(i,k-1) < pblh(i)) then + tke(i,k) = ( kvm(i,k) / pblh(i) ) ** 2 + endif + end do + end do + return + end subroutine austausch_pbl + +end module hb_diff diff --git a/src/physics/cam/hetfrz_classnuc.F90 b/src/physics/cam/hetfrz_classnuc.F90 new file mode 100644 index 0000000000..f0afa46525 --- /dev/null +++ b/src/physics/cam/hetfrz_classnuc.F90 @@ -0,0 +1,733 @@ +module hetfrz_classnuc + +!----------------------------------------------------------------------- +! +! Purpose: Calculate heterogeneous freezing rates from classical nucleation theory +! +! Public interfaces: +! +! hetfrz_classnuc_init +! hetfrz_classnuc_calc +! +! Author: +! Corinna Hoose, UiO, May 2009 +! Yong Wang and Xiaohong Liu, UWyo, 12/2012, +! implement in CAM5 and constrain uncertain parameters using natural dust and +! BC(soot) datasets. +! Yong Wang and Xiaohong Liu, UWyo, 05/2013, implement the PDF-contact angle +! approach: Y. Wang et al., Atmos. Chem. Phys., 2014. +! Jack Chen, NCAR, 09/2015, modify calculation of dust activation fraction. +! +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use wv_saturation, only: svp_water, svp_ice +use shr_spfn_mod, only: erf => shr_spfn_erf + +implicit none +private +save + +public :: hetfrz_classnuc_init, hetfrz_classnuc_calc + +real(r8) :: rair +real(r8) :: cpair +real(r8) :: rh2o +real(r8) :: rhoh2o +real(r8) :: mwh2o +real(r8) :: tmelt +real(r8) :: pi + +!***************************************************************************** +! PDF theta model +!***************************************************************************** +! some variables for PDF theta model +! immersion freezing +! +! With the original value of pdf_n_theta set to 101 the dust activation +! fraction between -15 and 0 C could be overestimated. This problem was +! eliminated by increasing pdf_n_theta to 301. To reduce the expense of +! computing the dust activation fraction the integral is only evaluated +! where dim_theta is non-zero. This was determined to be between +! dim_theta index values of 53 through 113. These loop bounds are +! hardcoded in the variables i1 and i2. + +logical :: pdf_imm_in = .true. +integer, parameter :: pdf_n_theta = 301 +integer, parameter :: i1 = 53 +integer, parameter :: i2 = 113 +real(r8) :: dim_theta(pdf_n_theta) = 0.0_r8 +real(r8) :: pdf_imm_theta(pdf_n_theta) = 0.0_r8 +real(r8) :: pdf_d_theta +real(r8) :: dim_f_imm_dust_a1(pdf_n_theta) = 0.0_r8 +real(r8) :: dim_f_imm_dust_a3(pdf_n_theta) = 0.0_r8 + +integer :: iulog + +!=================================================================================================== +contains +!=================================================================================================== + +subroutine hetfrz_classnuc_init( & + rair_in, cpair_in, rh2o_in, rhoh2o_in, mwh2o_in, & + tmelt_in, pi_in, iulog_in) + + real(r8), intent(in) :: rair_in + real(r8), intent(in) :: cpair_in + real(r8), intent(in) :: rh2o_in + real(r8), intent(in) :: rhoh2o_in + real(r8), intent(in) :: mwh2o_in + real(r8), intent(in) :: tmelt_in + real(r8), intent(in) :: pi_in + integer, intent(in) :: iulog_in + + rair = rair_in + cpair = cpair_in + rh2o = rh2o_in + rhoh2o = rhoh2o_in + mwh2o = mwh2o_in + tmelt = tmelt_in + pi = pi_in + iulog = iulog_in + + ! Initialize all the PDF theta variables: + if (pdf_imm_in) then + call hetfrz_classnuc_init_pdftheta() + end if + +end subroutine hetfrz_classnuc_init + +!=================================================================================================== + +subroutine hetfrz_classnuc_calc( & + deltat, t, p, supersatice, & + fn, & + r3lx, icnlx, & + frzbcimm, frzduimm, & + frzbccnt, frzducnt, & + frzbcdep, frzdudep, & + hetraer, awcam, awfacm, dstcoat, & + total_aer_num, coated_aer_num, uncoated_aer_num, & + total_interstitial_aer_num, total_cloudborne_aer_num, errstring) + + real(r8), intent(in) :: deltat ! timestep [s] + real(r8), intent(in) :: t ! temperature [K] + real(r8), intent(in) :: p ! pressure [Pa] + real(r8), intent(in) :: supersatice ! supersaturation ratio wrt ice at 100%rh over water [ ] + real(r8), intent(in) :: r3lx ! volume mean drop radius [m] + real(r8), intent(in) :: icnlx ! in-cloud droplet concentration [cm-3] + + real(r8), intent(in) :: fn(3) ! fraction activated [ ] for cloud borne aerosol number + ! index values are 1:bc, 2:dust_a1, 3:dust_a3 + real(r8), intent(in) :: hetraer(3) ! bc and dust mass mean radius [m] + real(r8), intent(in) :: awcam(3) ! modal added mass [mug m-3] + real(r8), intent(in) :: awfacm(3) ! (OC+BC)/(OC+BC+SO4) + real(r8), intent(in) :: dstcoat(3) ! coated fraction + real(r8), intent(in) :: total_aer_num(3) ! total bc and dust number concentration(interstitial+cloudborne) [#/cm^3] + real(r8), intent(in) :: coated_aer_num(3) ! coated bc and dust number concentration(interstitial) + real(r8), intent(in) :: uncoated_aer_num(3) ! uncoated bc and dust number concentration(interstitial) + real(r8), intent(in) :: total_interstitial_aer_num(3) ! total bc and dust concentration(interstitial) + real(r8), intent(in) :: total_cloudborne_aer_num(3) ! total bc and dust concentration(cloudborne) + + real(r8), intent(out) :: frzbcimm ! het. frz by BC immersion nucleation [cm-3 s-1] + real(r8), intent(out) :: frzduimm ! het. frz by dust immersion nucleation [cm-3 s-1] + real(r8), intent(out) :: frzbccnt ! het. frz by BC contact nucleation [cm-3 s-1] + real(r8), intent(out) :: frzducnt ! het. frz by dust contact nucleation [cm-3 s-1] + real(r8), intent(out) :: frzbcdep ! het. frz by BC deposition nucleation [cm-3 s-1] + real(r8), intent(out) :: frzdudep ! het. frz by dust deposition nucleation [cm-3 s-1] + + character(len=*), intent(out) :: errstring + + ! local variables + + real(r8) :: aw(3) ! water activity [ ] + real(r8) :: molal(3) ! molality [moles/kg] + real(r8), parameter :: Mso4 = 96.06_r8 + + integer, parameter :: id_bc = 1 + integer, parameter :: id_dst1 = 2 + integer, parameter :: id_dst3 = 3 + logical :: do_bc, do_dst1, do_dst3 + + real(r8), parameter :: n1 = 1.e19_r8 ! number of water molecules in contact with unit area of substrate [m-2] + real(r8), parameter :: kboltz = 1.38e-23_r8 + real(r8), parameter :: hplanck = 6.63e-34_r8 + real(r8), parameter :: rhplanck = 1._r8/hplanck + real(r8), parameter :: amu = 1.66053886e-27_r8 + real(r8), parameter :: nus = 1.e13_r8 ! frequ. of vibration [s-1] higher freq. (as in P&K, consistent with Anupam's data) + real(r8), parameter :: taufrz = 195.435_r8 ! time constant for falloff of freezing rate [s] + real(r8), parameter :: rhwincloud = 0.98_r8 ! 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) + real(r8), parameter :: limfacbc = 0.01_r8 ! max. ice nucleating fraction soot + real(r8) :: tc + real(r8) :: vwice + real(r8) :: rhoice + real(r8) :: sigma_iw ! [J/m2] + real(r8) :: sigma_iv ! [J/m2] + real(r8) :: esice ! [Pa] + real(r8) :: eswtr ! [Pa] + real(r8) :: rgimm + real(r8) :: rgdep + real(r8) :: dg0dep + real(r8) :: Adep + real(r8) :: dg0cnt + real(r8) :: Acnt + real(r8) :: rgimm_bc + real(r8) :: rgimm_dust_a1, rgimm_dust_a3 + real(r8) :: dg0imm_bc + real(r8) :: dg0imm_dust_a1, dg0imm_dust_a3 + real(r8) :: Aimm_bc + real(r8) :: Aimm_dust_a1, Aimm_dust_a3 + real(r8) :: q, m, phi + real(r8) :: r_bc ! model radii of BC modes [m] + real(r8) :: r_dust_a1, r_dust_a3 ! model radii of dust modes [m] + real(r8) :: f_imm_bc + real(r8) :: f_imm_dust_a1, f_imm_dust_a3 + real(r8) :: Jimm_bc + real(r8) :: Jimm_dust_a1, Jimm_dust_a3 + real(r8) :: f_dep_bc + real(r8) :: f_dep_dust_a1, f_dep_dust_a3 + real(r8) :: Jdep_bc + real(r8) :: Jdep_dust_a1, Jdep_dust_a3 + real(r8) :: f_cnt_bc + real(r8) :: f_cnt_dust_a1,f_cnt_dust_a3 + real(r8) :: Jcnt_bc + real(r8) :: Jcnt_dust_a1,Jcnt_dust_a3 + integer :: i + + !******************************************************** + ! Hoose et al., 2010 fitting parameters + !******************************************************** + !freezing parameters for immersion freezing + !real(r8),parameter :: theta_imm_bc = 40.17 ! contact angle [deg], converted to rad later + !real(r8),parameter :: dga_imm_bc = 14.4E-20 ! activation energy [J] + !real(r8),parameter :: theta_imm_dust = 30.98 ! contact angle [deg], converted to rad later + !real(r8),parameter :: dga_imm_dust = 15.7E-20 ! activation energy [J] + !freezing parameters for deposition nucleation + !real(r8),parameter :: theta_dep_dust = 12.7 ! contact angle [deg], converted to rad later !Zimmermann et al (2008), illite + !real(r8),parameter :: dga_dep_dust = -6.21E-21 ! activation energy [J] + !real(r8),parameter :: theta_dep_bc = 28. ! contact angle [deg], converted to rad later !Moehler et al (2005), soot + !real(r8),parameter :: dga_dep_bc = -2.E-19 ! activation energy [J] + !******************************************************** + ! Wang et al., 2014 fitting parameters + !******************************************************** + ! freezing parameters for immersion freezing + real(r8),parameter :: theta_imm_bc = 48.0_r8 ! contact angle [deg], converted to rad later !DeMott et al (1990) + real(r8),parameter :: dga_imm_bc = 14.15E-20_r8 ! activation energy [J] + real(r8),parameter :: theta_imm_dust = 46.0_r8 ! contact angle [deg], converted to rad later !DeMott et al (2011) SD + real(r8),parameter :: dga_imm_dust = 14.75E-20_r8 ! activation energy [J] + ! freezing parameters for deposition nucleation + real(r8),parameter :: theta_dep_dust = 20.0_r8 ! contact angle [deg], converted to rad later !Koehler et al (2010) SD + real(r8),parameter :: dga_dep_dust = -8.1E-21_r8 ! activation energy [J] + real(r8),parameter :: theta_dep_bc = 28._r8 ! contact angle [deg], converted to rad later !Moehler et al (2005), soot + real(r8),parameter :: dga_dep_bc = -2.E-19_r8 ! activation energy [J] + + real(r8) :: Kcoll_bc ! collision kernel [cm3 s-1] + real(r8) :: Kcoll_dust_a1 ! collision kernel [cm3 s-1] + real(r8) :: Kcoll_dust_a3 ! collision kernel [cm3 s-1] + + logical :: tot_in = .false. + + real(r8) :: dim_Jimm_dust_a1(pdf_n_theta), dim_Jimm_dust_a3(pdf_n_theta) + real(r8) :: sum_imm_dust_a1, sum_imm_dust_a3 + + !------------------------------------------------------------------------------------------------ + + errstring = ' ' + + ! get saturation vapor pressures + eswtr = svp_water(t) ! 0 for liquid + esice = svp_ice(t) ! 1 for ice + + tc = t - tmelt + rhoice = 916.7_r8-0.175_r8*tc-5.e-4_r8*tc**2 + vwice = mwh2o*amu/rhoice + sigma_iw = (28.5_r8+0.25_r8*tc)*1E-3_r8 + sigma_iv = (76.1_r8-0.155_r8*tc + 28.5_r8+0.25_r8*tc)*1E-3_r8 + + ! get mass mean radius + r_bc = hetraer(1) + r_dust_a1 = hetraer(2) + r_dust_a3 = hetraer(3) + + ! calculate collision kernels as a function of environmental parameters and aerosol/droplet sizes + call collkernel(t, p, eswtr, rhwincloud, r3lx, & + r_bc, & ! BC modes + r_dust_a1, r_dust_a3, & ! dust modes + Kcoll_bc, & ! collision kernel [cm3 s-1] + Kcoll_dust_a1, Kcoll_dust_a3) + + !***************************************************************************** + ! take water activity into account + !***************************************************************************** + ! solute effect + aw(:) = 1._r8 + molal(:) = 0._r8 + + ! The heterogeneous ice freezing temperatures of all IN generally decrease with + ! increasing total solute mole fraction. Therefore, the large solution concentration + ! will cause the freezing point depression and the ice freezing temperatures of all + ! IN will get close to the homogeneous ice freezing temperatures. Since we take into + ! account water activity for three heterogeneous freezing modes(immersion, deposition, + ! and contact), we utilize interstitial aerosols(not cloudborne aerosols) to calculate + ! water activity. + ! If the index of IN is 0, it means three freezing modes of this aerosol are depressed. + + do i = 1, 3 + !calculate molality + if ( total_interstitial_aer_num(i) > 0._r8 ) then + molal(i) = (1.e-6_r8*awcam(i)*(1._r8-awfacm(i))/(Mso4*total_interstitial_aer_num(i)*1.e6_r8))/ & + (4*pi/3*rhoh2o*(MAX(r3lx,4.e-6_r8))**3) + aw(i) = 1._r8/(1._r8+2.9244948e-2_r8*molal(i)+2.3141243e-3_r8*molal(i)**2+7.8184854e-7_r8*molal(i)**3) + end if + end do + + !***************************************************************************** + ! immersion freezing begin + !***************************************************************************** + + frzbcimm = 0._r8 + frzduimm = 0._r8 + frzbccnt = 0._r8 + frzducnt = 0._r8 + frzbcdep = 0._r8 + frzdudep = 0._r8 + + ! critical germ size + rgimm = 2*vwice*sigma_iw/(kboltz*t*LOG(supersatice)) + ! take solute effect into account + rgimm_bc = rgimm + rgimm_dust_a1 = rgimm + rgimm_dust_a3 = rgimm + + ! if aw*Si<=1, the freezing point depression is strong enough to prevent freezing + + if (aw(id_bc)*supersatice > 1._r8 ) then + do_bc = .true. + rgimm_bc = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_bc)*supersatice)) + else + do_bc = .false. + end if + + if (aw(id_dst1)*supersatice > 1._r8 ) then + do_dst1 = .true. + rgimm_dust_a1 = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_dst1)*supersatice)) + else + do_dst1 = .false. + end if + + if (aw(id_dst3)*supersatice > 1._r8 ) then + do_dst3 = .true. + rgimm_dust_a3 = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_dst3)*supersatice)) + else + do_dst3 = .false. + end if + + ! form factor + ! only consider flat surfaces due to uncertainty of curved surfaces + + m = COS(theta_imm_bc*pi/180._r8) + f_imm_bc = (2+m)*(1-m)**2/4._r8 + if (.not. pdf_imm_in) then + m = COS(theta_imm_dust*pi/180._r8) + f_imm_dust_a1 = (2+m)*(1-m)**2/4._r8 + + m = COS(theta_imm_dust*pi/180._r8) + f_imm_dust_a3 = (2+m)*(1-m)**2/4._r8 + end if + + ! homogeneous energy of germ formation + dg0imm_bc = 4*pi/3._r8*sigma_iw*rgimm_bc**2 + dg0imm_dust_a1 = 4*pi/3._r8*sigma_iw*rgimm_dust_a1**2 + dg0imm_dust_a3 = 4*pi/3._r8*sigma_iw*rgimm_dust_a3**2 + + ! prefactor + Aimm_bc = n1*((vwice*rhplanck)/(rgimm_bc**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_bc)) + Aimm_dust_a1 = n1*((vwice*rhplanck)/(rgimm_dust_a1**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_dust_a1)) + Aimm_dust_a3 = n1*((vwice*rhplanck)/(rgimm_dust_a3**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_dust_a3)) + + ! nucleation rate per particle + + Jimm_bc = Aimm_bc*r_bc**2/SQRT(f_imm_bc)*EXP((-dga_imm_bc-f_imm_bc*dg0imm_bc)/(kboltz*T)) + if (.not. pdf_imm_in) then + ! 1/sqrt(f) + ! the expression of Chen et al. (sqrt(f)) may however lead to unphysical + ! behavior as it implies J->0 when f->0 (i.e. ice nucleation would be + ! more difficult on easily wettable materials). + Jimm_dust_a1 = Aimm_dust_a1*r_dust_a1**2/SQRT(f_imm_dust_a1)*EXP((-dga_imm_dust-f_imm_dust_a1*dg0imm_dust_a1)/(kboltz*T)) + Jimm_dust_a3 = Aimm_dust_a3*r_dust_a3**2/SQRT(f_imm_dust_a3)*EXP((-dga_imm_dust-f_imm_dust_a3*dg0imm_dust_a3)/(kboltz*T)) + end if + + if (pdf_imm_in) then + dim_Jimm_dust_a1 = 0.0_r8 + dim_Jimm_dust_a3 = 0.0_r8 + do i = i1,i2 + ! 1/sqrt(f) + dim_Jimm_dust_a1(i) = Aimm_dust_a1*r_dust_a1**2/SQRT(dim_f_imm_dust_a1(i))*EXP((-dga_imm_dust-dim_f_imm_dust_a1(i)* & + dg0imm_dust_a1)/(kboltz*T)) + dim_Jimm_dust_a1(i) = max(dim_Jimm_dust_a1(i), 0._r8) + + dim_Jimm_dust_a3(i) = Aimm_dust_a3*r_dust_a3**2/SQRT(dim_f_imm_dust_a3(i))*EXP((-dga_imm_dust-dim_f_imm_dust_a3(i)* & + dg0imm_dust_a3)/(kboltz*T)) + dim_Jimm_dust_a3(i) = max(dim_Jimm_dust_a3(i), 0._r8) + end do + end if + + ! Limit to 1% of available potential IN (for BC), no limit for dust + if (pdf_imm_in) then + sum_imm_dust_a1 = 0._r8 + sum_imm_dust_a3 = 0._r8 + do i = i1,i2-1 + sum_imm_dust_a1 = sum_imm_dust_a1+0.5_r8*((pdf_imm_theta(i)*exp(-dim_Jimm_dust_a1(i)*deltat)+ & + pdf_imm_theta(i+1)*exp(-dim_Jimm_dust_a1(i+1)*deltat)))*pdf_d_theta + sum_imm_dust_a3 = sum_imm_dust_a3+0.5_r8*((pdf_imm_theta(i)*exp(-dim_Jimm_dust_a3(i)*deltat)+ & + pdf_imm_theta(i+1)*exp(-dim_Jimm_dust_a3(i+1)*deltat)))*pdf_d_theta + end do + do i = i1,i2 + if (sum_imm_dust_a1 > 0.99_r8) then + sum_imm_dust_a1 = 1.0_r8 + end if + if (sum_imm_dust_a3 > 0.99_r8) then + sum_imm_dust_a3 = 1.0_r8 + end if + end do + + end if + + if (.not.tot_in) then + if (do_bc) frzbcimm = frzbcimm+MIN(limfacbc*total_cloudborne_aer_num(id_bc)/deltat, & + total_cloudborne_aer_num(id_bc)/deltat*(1._r8-exp(-Jimm_bc*deltat))) + + if (.not. pdf_imm_in) then + if (do_dst1) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst1)/deltat, & + total_cloudborne_aer_num(id_dst1)/deltat*(1._r8-exp(-Jimm_dust_a1*deltat))) + if (do_dst3) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst3)/deltat, & + total_cloudborne_aer_num(id_dst3)/deltat*(1._r8-exp(-Jimm_dust_a3*deltat))) + else + if (do_dst1) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst1)/deltat, & + total_cloudborne_aer_num(id_dst1)/deltat*(1._r8-sum_imm_dust_a1)) + if (do_dst3) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst3)/deltat, & + total_cloudborne_aer_num(id_dst3)/deltat*(1._r8-sum_imm_dust_a3)) + end if + + else + if (do_bc) frzbcimm = frzbcimm+MIN(limfacbc*fn(id_bc)*total_aer_num(id_bc)/deltat, & + fn(id_bc)*total_aer_num(id_bc)/deltat*(1._r8-exp(-Jimm_bc*deltat))) + + if (.not. pdf_imm_in) then + if (do_dst1) frzduimm = frzduimm+MIN(1*fn(id_dst1)*total_aer_num(id_dst1)/deltat, & + fn(id_dst1)*total_aer_num(id_dst1)/deltat*(1._r8-exp(-Jimm_dust_a1*deltat))) + if (do_dst3) frzduimm = frzduimm+MIN(1*fn(id_dst3)*total_aer_num(id_dst3)/deltat, & + fn(id_dst3)*total_aer_num(id_dst3)/deltat*(1._r8-exp(-Jimm_dust_a3*deltat))) + else + if (do_dst1) frzduimm = frzduimm+MIN(1*fn(id_dst1)*total_aer_num(id_dst1)/deltat, & + fn(id_dst1)*total_aer_num(id_dst1)/deltat*(1._r8-sum_imm_dust_a1)) + if (do_dst3) frzduimm = frzduimm+MIN(1*fn(id_dst3)*total_aer_num(id_dst3)/deltat, & + fn(id_dst3)*total_aer_num(id_dst3)/deltat*(1._r8-sum_imm_dust_a3)) + end if + end if + + if (t > 263.15_r8) then + frzduimm = 0._r8 + frzbcimm = 0._r8 + end if + + !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Deposition nucleation + !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! critical germ size + ! assume 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) + rgdep=2*vwice*sigma_iv/(kboltz*t*LOG(rhwincloud*supersatice)) + + ! form factor + m = COS(theta_dep_bc*pi/180._r8) + f_dep_bc = (2+m)*(1-m)**2/4._r8 + + m = COS(theta_dep_dust*pi/180._r8) + f_dep_dust_a1 = (2+m)*(1-m)**2/4._r8 + + m = COS(theta_dep_dust*pi/180._r8) + f_dep_dust_a3 = (2+m)*(1-m)**2/4._r8 + + ! homogeneous energy of germ formation + dg0dep = 4*pi/3._r8*sigma_iv*rgdep**2 + + ! prefactor + ! attention: division of small numbers + Adep = (rhwincloud*eswtr)**2*(vwice/(mwh2o*amu))/(kboltz*T*nus)*SQRT(sigma_iv/(kboltz*T)) + + ! nucleation rate per particle + if (rgdep > 0) then + Jdep_bc = Adep*r_bc**2/SQRT(f_dep_bc)*EXP((-dga_dep_bc-f_dep_bc*dg0dep)/(kboltz*T)) + Jdep_dust_a1 = Adep*r_dust_a1**2/SQRT(f_dep_dust_a1)*EXP((-dga_dep_dust-f_dep_dust_a1*dg0dep)/(kboltz*T)) + Jdep_dust_a3 = Adep*r_dust_a3**2/SQRT(f_dep_dust_a3)*EXP((-dga_dep_dust-f_dep_dust_a3*dg0dep)/(kboltz*T)) + else + Jdep_bc = 0._r8 + Jdep_dust_a1 = 0._r8 + Jdep_dust_a3 = 0._r8 + end if + + ! Limit to 1% of available potential IN (for BC), no limit for dust + if (.not.tot_in) then + if (do_bc) frzbcdep = frzbcdep+MIN(limfacbc*uncoated_aer_num(id_bc)/deltat, & + uncoated_aer_num(id_bc)/deltat & + *(1._r8-exp(-Jdep_bc*deltat))) + if (do_dst1) frzdudep = frzdudep+MIN(uncoated_aer_num(id_dst1)/deltat, & + uncoated_aer_num(id_dst1)/deltat & + *(1._r8-exp(-Jdep_dust_a1*deltat))) + if (do_dst3) frzdudep = frzdudep+MIN(uncoated_aer_num(id_dst3)/deltat, & + uncoated_aer_num(id_dst3)/deltat & + *(1._r8-exp(-Jdep_dust_a3*deltat))) + else + if (do_bc) frzbcdep = frzbcdep+MIN(limfacbc*(1._r8-fn(id_bc)) & + *(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat, & + (1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat & + *(1._r8-exp(-Jdep_bc*deltat))) + if (do_dst1) frzdudep = frzdudep+MIN((1._r8-fn(id_dst1)) & + *(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat, & + (1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat & + *(1._r8-exp(-Jdep_dust_a1*deltat))) + if (do_dst3) frzdudep = frzdudep+MIN((1._r8-fn(id_dst3)) & + *(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat, & + (1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat & + *(1._r8-exp(-Jdep_dust_a3*deltat))) + end if + + !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! contact nucleation + !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! form factor + m = COS(theta_dep_bc*pi/180._r8) + f_cnt_bc = (2+m)*(1-m)**2/4._r8 + + m = COS(theta_dep_dust*pi/180._r8) + f_cnt_dust_a1 = (2+m)*(1-m)**2/4._r8 + + m = COS(theta_dep_dust*pi/180._r8) + f_cnt_dust_a3 = (2+m)*(1-m)**2/4._r8 + + ! homogeneous energy of germ formation + dg0cnt = 4*pi/3._r8*sigma_iv*rgimm**2 + + ! prefactor + ! attention: division of small numbers + Acnt = rhwincloud*eswtr*4*pi/(nus*SQRT(2*pi*mwh2o*amu*kboltz*T)) + + ! nucleation rate per particle + Jcnt_bc = Acnt*r_bc**2*EXP((-dga_dep_bc-f_cnt_bc*dg0cnt)/(kboltz*T))*Kcoll_bc*icnlx + Jcnt_dust_a1 = Acnt*r_dust_a1**2*EXP((-dga_dep_dust-f_cnt_dust_a1*dg0cnt)/(kboltz*T))*Kcoll_dust_a1*icnlx + Jcnt_dust_a3 = Acnt*r_dust_a3**2*EXP((-dga_dep_dust-f_cnt_dust_a3*dg0cnt)/(kboltz*T))*Kcoll_dust_a3*icnlx + + ! Limit to 1% of available potential IN (for BC), no limit for dust + if (.not.tot_in) then + if (do_bc) frzbccnt = frzbccnt+MIN(limfacbc*uncoated_aer_num(id_bc)/deltat, & + uncoated_aer_num(id_bc)/deltat & + *(1._r8-exp(-Jcnt_bc*deltat))) + if (do_dst1) frzducnt = frzducnt+MIN(uncoated_aer_num(id_dst1)/deltat, & + uncoated_aer_num(id_dst1)/deltat & + *(1._r8-exp(-Jcnt_dust_a1*deltat))) + if (do_dst3) frzducnt = frzducnt+MIN(uncoated_aer_num(id_dst3)/deltat, & + uncoated_aer_num(id_dst3)/deltat & + *(1._r8-exp(-Jcnt_dust_a3*deltat))) + else + if (do_bc) frzbccnt = frzbccnt+MIN(limfacbc*(1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat, & + (1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat & + *(1._r8-exp(-Jcnt_bc*deltat))) + if (do_dst1) frzducnt = frzducnt+MIN((1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat, & + (1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat & + *(1._r8-exp(-Jcnt_dust_a1*deltat))) + if (do_dst3) frzducnt = frzducnt+MIN((1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat, & + (1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat & + *(1._r8-exp(-Jcnt_dust_a3*deltat))) + end if + + if (frzducnt <= -1._r8) then + write(iulog,*) 'hetfrz_classnuc_calc: frzducnt', frzducnt, Jcnt_dust_a1,Jcnt_dust_a3, & + Kcoll_dust_a1, Kcoll_dust_a3 + errstring = 'ERROR in hetfrz_classnuc_calc::frzducnt' + return + end if + +end subroutine hetfrz_classnuc_calc + +!=================================================================================================== + +!----------------------------------------------------------------------- +! +! Purpose: calculate collision kernels as a function of environmental parameters and aerosol/droplet sizes +! +! Author: Corinna Hoose, UiO, October 2009 +! +! Modifications: Yong Wang and Xiaohong Liu, UWyo, 12/2012 +!----------------------------------------------------------------------- + +subroutine collkernel( & + t, pres, eswtr, rhwincloud, r3lx, & + r_bc, & ! BC modes + r_dust_a1, r_dust_a3, & ! dust modes + Kcoll_bc, & ! collision kernel [cm3 s-1] + Kcoll_dust_a1, Kcoll_dust_a3) + + real(r8), intent(in) :: t ! temperature [K] + real(r8), intent(in) :: pres ! pressure [Pa] + real(r8), intent(in) :: eswtr ! saturation vapor pressure of water [Pa] + real(r8), intent(in) :: r3lx ! volume mean drop radius [m] + real(r8), intent(in) :: rhwincloud ! in-cloud relative humidity over water [ ] + real(r8), intent(in) :: r_bc ! model radii of BC modes [m] + real(r8), intent(in) :: r_dust_a1 ! model radii of dust modes [m] + real(r8), intent(in) :: r_dust_a3 ! model radii of dust modes [m] + + real(r8), intent(out) :: Kcoll_bc ! collision kernel [cm3 s-1] + real(r8), intent(out) :: Kcoll_dust_a1 + real(r8), intent(out) :: Kcoll_dust_a3 + + ! local variables + real(r8) :: a, b, c, a_f, b_f, c_f, f + real(r8) :: tc ! temperature [deg C] + real(r8) :: rho_air ! air density [kg m-3] + real(r8) :: viscos_air ! dynamic viscosity of air [kg m-1 s-1] + real(r8) :: Ktherm_air ! thermal conductivity of air [J/(m s K)] + real(r8) :: lambda ! mean free path [m] + real(r8) :: Kn ! Knudsen number [ ] + real(r8) :: Re ! Reynolds number [ ] + real(r8) :: Pr ! Prandtl number [ ] + real(r8) :: Sc ! Schmidt number [ ] + real(r8) :: vterm ! terminal velocity [m s-1] + real(r8) :: Ktherm ! thermal conductivity of aerosol [J/(m s K)] + real(r8) :: Dvap ! water vapor diffusivity [m2 s-1] + real(r8) :: Daer ! aerosol diffusivity [m2 s-1] + real(r8) :: latvap ! latent heat of vaporization [J kg-1] + real(r8) :: kboltz ! Boltzmann constant [J K-1] + real(r8) :: G ! thermodynamic function in Cotton et al. [kg m-1 s-1] + real(r8) :: r_a ! aerosol radius [m] + real(r8) :: f_t ! factor by Waldmann & Schmidt [ ] + real(r8) :: Q_heat ! heat flux [J m-2 s-1] + real(r8) :: Tdiff_cotton ! temperature difference between droplet and environment [K] + real(r8) :: K_brownian,K_thermo_cotton,K_diffusio_cotton ! collision kernels [m3 s-1] + real(r8) :: K_total ! total collision kernel [cm3 s-1] + integer :: i + !------------------------------------------------------------------------------------------------ + + Kcoll_bc = 0._r8 + Kcoll_dust_a1 = 0._r8 + Kcoll_dust_a3 = 0._r8 + + tc = t - tmelt + kboltz = 1.38065e-23_r8 + + ! air viscosity for tc<0, from depvel_part.F90 + viscos_air = (1.718_r8+0.0049_r8*tc-1.2e-5_r8*tc*tc)*1.e-5_r8 + ! air density + rho_air = pres/(rair*t) + ! mean free path: Seinfeld & Pandis 8.6 + lambda = 2*viscos_air/(pres*SQRT(8/(pi*rair*t))) + ! latent heat of vaporization, varies with T + latvap = 1000*(-0.0000614342_r8*tc**3 + 0.00158927_r8*tc**2 - 2.36418_r8*tc + 2500.79_r8) + ! droplet terminal velocity after Chen & Liu, QJRMS 2004 + a = 8.8462e2_r8 + b = 9.7593e7_r8 + c = -3.4249e-11_r8 + a_f = 3.1250e-1_r8 + b_f = 1.0552e-3_r8 + c_f = -2.4023_r8 + f = EXP(EXP(a_f + b_f*(LOG(r3lx))**3 + c_f*rho_air**1.5_r8)) + vterm = (a+ (b + c*r3lx)*r3lx)*r3lx*f + + ! Reynolds number + Re = 2*vterm*r3lx*rho_air/viscos_air + ! thermal conductivity of air: Seinfeld & Pandis eq. 15.75 + Ktherm_air = 1.e-3_r8*(4.39_r8+0.071_r8*t) !J/(m s K) + ! Prandtl number + Pr = viscos_air*cpair/Ktherm_air + ! water vapor diffusivity: Pruppacher & Klett 13-3 + Dvap = 0.211e-4_r8*(t/273.15_r8)*(101325._r8/pres) + ! G-factor = rhoh2o*Xi in Rogers & Yau, p. 104 + G = rhoh2o/((latvap/(rh2o*t) - 1)*latvap*rhoh2o/(Ktherm_air*t) & + + rhoh2o*rh2o*t/(Dvap*eswtr)) + + ! variables depending on aerosol radius + ! loop over 3 aerosol modes + do i = 1, 3 + if (i == 1) r_a = r_bc + if (i == 2) r_a = r_dust_a1 + if (i == 3) r_a = r_dust_a3 + ! Knudsen number (Seinfeld & Pandis 8.1) + Kn = lambda/r_a + ! aerosol diffusivity + Daer = kboltz*t*(1 + Kn)/(6*pi*r_a*viscos_air) + ! Schmidt number + Sc = viscos_air/(Daer*rho_air) + + ! Young (1974) first equ. on page 771 + K_brownian = 4*pi*r3lx*Daer*(1 + 0.3_r8*Re**0.5_r8*Sc**0.33_r8) + + ! thermal conductivities from Seinfeld & Pandis, Table 8.6 + if (i == 1) Ktherm = 4.2_r8 ! Carbon + if (i == 2 .or. i == 3) Ktherm = 0.72_r8 ! clay + ! form factor + f_t = 0.4_r8*(1._r8 + 1.45_r8*Kn + 0.4_r8*Kn*EXP(-1._r8/Kn)) & + *(Ktherm_air + 2.5_r8*Kn*Ktherm) & + /((1._r8 + 3._r8*Kn)*(2._r8*Ktherm_air + 5._r8*Kn*Ktherm+Ktherm)) + ! calculate T-Tc as in Cotton et al. + Tdiff_cotton = -G*(rhwincloud - 1._r8)*latvap/Ktherm_air + Q_heat = Ktherm_air/r3lx*(1._r8 + 0.3_r8*Re**0.5_r8*Pr**0.33_r8)*Tdiff_cotton + K_thermo_cotton = 4._r8*pi*r3lx*r3lx*f_t*Q_heat/pres + K_diffusio_cotton = -(1._r8/f_t)*(rh2o*t/latvap)*K_thermo_cotton + K_total = 1.e6_r8*(K_brownian + K_thermo_cotton + K_diffusio_cotton) ! convert m3/s -> cm3/s + ! set K to 0 if negative + if (K_total .lt. 0._r8) K_total = 0._r8 + + if (i == 1) Kcoll_bc = K_total + if (i == 2) Kcoll_dust_a1 = K_total + if (i == 3) Kcoll_dust_a3 = K_total + + end do + +end subroutine collkernel + +!=================================================================================================== + +subroutine hetfrz_classnuc_init_pdftheta() + + ! Local variables: + real(r8) :: theta_min, theta_max + real(r8) :: x1_imm, x2_imm + real(r8) :: norm_theta_imm + real(r8) :: imm_dust_mean_theta + real(r8) :: imm_dust_var_theta + integer :: i + real(r8) :: m + real(r8) :: temp + !---------------------------------------------------------------------------- + + theta_min = pi/180._r8 + theta_max = 179._r8/180._r8*pi + imm_dust_mean_theta = 46.0_r8/180.0_r8*pi + imm_dust_var_theta = 0.01_r8 + + pdf_d_theta = (179._r8-1._r8)/180._r8*pi/(pdf_n_theta-1) + + x1_imm = (LOG(theta_min) - LOG(imm_dust_mean_theta))/(sqrt(2.0_r8)*imm_dust_var_theta) + x2_imm = (LOG(theta_max) - LOG(imm_dust_mean_theta))/(sqrt(2.0_r8)*imm_dust_var_theta) + norm_theta_imm = (ERF(x2_imm) - ERF(x1_imm))*0.5_r8 + dim_theta = 0.0_r8 + pdf_imm_theta = 0.0_r8 + do i = i1, i2 + dim_theta(i) = 1._r8/180._r8*pi + (i-1)*pdf_d_theta + pdf_imm_theta(i) = exp(-((LOG(dim_theta(i)) - LOG(imm_dust_mean_theta))**2._r8) / & + (2._r8*imm_dust_var_theta**2._r8) ) / & + (dim_theta(i)*imm_dust_var_theta*SQRT(2*pi))/norm_theta_imm + end do + + do i = i1, i2 + m = cos(dim_theta(i)) + temp = (2+m)*(1-m)**2/4._r8 + dim_f_imm_dust_a1(i) = temp + dim_f_imm_dust_a3(i) = temp + end do + +end subroutine hetfrz_classnuc_init_pdftheta + +!=================================================================================================== + +end module hetfrz_classnuc diff --git a/src/physics/cam/hetfrz_classnuc_cam.F90 b/src/physics/cam/hetfrz_classnuc_cam.F90 new file mode 100644 index 0000000000..8de3fa96ec --- /dev/null +++ b/src/physics/cam/hetfrz_classnuc_cam.F90 @@ -0,0 +1,1365 @@ +module hetfrz_classnuc_cam + +!--------------------------------------------------------------------------------- +! +! CAM Interfaces for hetfrz_classnuc module. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, begchunk, endchunk +use physconst, only: rair, cpair, rh2o, rhoh2o, mwh2o, tmelt, pi +use constituents, only: cnst_get_ind +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use phys_control, only: phys_getopts, use_hetfrz_classnuc +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_idx, rad_cnst_get_spec_idx, & + rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & + rad_cnst_get_mode_num, rad_cnst_get_mode_props + +use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, & + pbuf_get_index, pbuf_get_field +use cam_history, only: addfld, add_default, outfld + +use ref_pres, only: top_lev => trop_cloud_top_lev +use wv_saturation, only: svp_water, svp_ice + +use cam_logfile, only: iulog +use error_messages, only: handle_errmsg, alloc_err +use cam_abortutils, only: endrun + +use hetfrz_classnuc, only: hetfrz_classnuc_init, hetfrz_classnuc_calc + +implicit none +private +save + +public :: & + hetfrz_classnuc_cam_readnl, & + hetfrz_classnuc_cam_register, & + hetfrz_classnuc_cam_init, & + hetfrz_classnuc_cam_calc, & + hetfrz_classnuc_cam_save_cbaero + +! Namelist variables +logical :: hist_hetfrz_classnuc = .false. + +! Vars set via init method. +real(r8) :: mincld ! minimum allowed cloud fraction + +! constituent indices +integer :: & + cldliq_idx = -1, & + cldice_idx = -1, & + numliq_idx = -1, & + numice_idx = -1 + +! pbuf indices for fields provided by heterogeneous freezing +integer :: & + frzimm_idx, & + frzcnt_idx, & + frzdep_idx + +! pbuf indices for fields needed by heterogeneous freezing +integer :: & + ast_idx = -1 + +! modal aerosols +integer, parameter :: MAM3_nmodes = 3 +integer, parameter :: MAM7_nmodes = 7 +integer, parameter :: MAM4_nmodes = 4 +integer :: nmodes = -1 ! number of aerosol modes + +! mode indices +integer :: mode_accum_idx = -1 ! accumulation mode +integer :: mode_coarse_idx = -1 ! coarse mode +integer :: mode_finedust_idx = -1 ! fine dust mode +integer :: mode_coardust_idx = -1 ! coarse dust mode +integer :: mode_pcarbon_idx = -1 ! primary carbon mode + +! mode properties +real(r8) :: alnsg_mode_accum +real(r8) :: alnsg_mode_coarse +real(r8) :: alnsg_mode_finedust +real(r8) :: alnsg_mode_coardust +real(r8) :: alnsg_mode_pcarbon + +! specie properties +real(r8) :: specdens_dust +real(r8) :: specdens_so4 +real(r8) :: specdens_bc +real(r8) :: specdens_soa +real(r8) :: specdens_pom + +! List all species +integer :: ncnst = 0 ! Total number of constituents (mass and number) needed + ! by the parameterization (depends on aerosol model used) + +integer :: so4_accum ! sulfate in accumulation mode +integer :: bc_accum ! black-c in accumulation mode +integer :: pom_accum ! p-organic in accumulation mode +integer :: soa_accum ! s-organic in accumulation mode +integer :: dst_accum ! dust in accumulation mode +integer :: ncl_accum ! seasalt in accumulation mode +integer :: num_accum ! number in accumulation mode + +integer :: dst_coarse ! dust in coarse mode +integer :: ncl_coarse ! seasalt in coarse mode +integer :: so4_coarse ! sulfate in coarse mode +integer :: num_coarse ! number in coarse mode + +integer :: dst_finedust ! dust in finedust mode +integer :: so4_finedust ! sulfate in finedust mode +integer :: num_finedust ! number in finedust mode + +integer :: dst_coardust ! dust in coardust mode +integer :: so4_coardust ! sulfate in coardust mode +integer :: num_coardust ! number in coardust mode + +integer :: bc_pcarbon ! black-c in primary carbon mode +integer :: pom_pcarbon ! p-organic in primary carbon mode +integer :: num_pcarbon ! number in primary carbon mode + +! Index arrays for looping over all constituents +integer, allocatable :: mode_idx(:) +integer, allocatable :: spec_idx(:) + +! Copy of cloud borne aerosols before modification by droplet nucleation +! The basis is converted from mass to volume. +real(r8), allocatable :: aer_cb(:,:,:,:) + +! Copy of interstitial aerosols with basis converted from mass to volume. +real(r8), allocatable :: aer(:,:,:,:) + +!=============================================================================== +contains +!=============================================================================== + +subroutine hetfrz_classnuc_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'hetfrz_classnuc_cam_readnl' + + namelist /hetfrz_classnuc_nl/ hist_hetfrz_classnuc + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'hetfrz_classnuc_nl', status=ierr) + if (ierr == 0) then + read(unitn, hetfrz_classnuc_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(hist_hetfrz_classnuc, 1, mpilog, 0, mpicom) +#endif + +end subroutine hetfrz_classnuc_cam_readnl + +!================================================================================================ + +subroutine hetfrz_classnuc_cam_register() + + if (.not. use_hetfrz_classnuc) return + + ! pbuf fields provided by hetfrz_classnuc + call pbuf_add_field('FRZIMM', 'physpkg', dtype_r8, (/pcols,pver/), frzimm_idx) + call pbuf_add_field('FRZCNT', 'physpkg', dtype_r8, (/pcols,pver/), frzcnt_idx) + call pbuf_add_field('FRZDEP', 'physpkg', dtype_r8, (/pcols,pver/), frzdep_idx) + +end subroutine hetfrz_classnuc_cam_register + +!================================================================================================ + +subroutine hetfrz_classnuc_cam_init(mincld_in) + + real(r8), intent(in) :: mincld_in + + ! local variables + logical :: prog_modal_aero + integer :: m, n, nspec + integer :: istat + + real(r8) :: sigma_logr_aer + + character(len=32) :: str32 + character(len=*), parameter :: routine = 'hetfrz_classnuc_cam_init' + !-------------------------------------------------------------------------------------------- + + if (.not. use_hetfrz_classnuc) return + + ! This parameterization currently assumes that prognostic modal aerosols are on. Check... + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + if (.not. prog_modal_aero) call endrun(routine//': cannot use hetfrz_classnuc without prognostic modal aerosols') + + mincld = mincld_in + + call cnst_get_ind('CLDLIQ', cldliq_idx) + call cnst_get_ind('CLDICE', cldice_idx) + call cnst_get_ind('NUMLIQ', numliq_idx) + call cnst_get_ind('NUMICE', numice_idx) + + ! pbuf fields used by hetfrz_classnuc + ast_idx = pbuf_get_index('AST') + + call addfld('bc_num', (/ 'lev' /), 'A', '#/cm3', 'total bc number') + call addfld('dst1_num', (/ 'lev' /), 'A', '#/cm3', 'total dst1 number') + call addfld('dst3_num', (/ 'lev' /), 'A', '#/cm3', 'total dst3 number') + call addfld('bcc_num', (/ 'lev' /), 'A', '#/cm3', 'coated bc number') + call addfld('dst1c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst1 number') + call addfld('dst3c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst3 number') + call addfld('bcuc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated bc number') + call addfld('dst1uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst1 number') + call addfld('dst3uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst3 number') + + call addfld('bc_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial bc number') + call addfld('dst_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst1 number') + call addfld('dst_a3_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst3 number') + call addfld('bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number') + call addfld('dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number') + call addfld('dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number') + + call addfld('fn_bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number derived from fn') + call addfld('fn_dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number derived from fn') + call addfld('fn_dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number derived from fn') + + call addfld('na500', (/ 'lev' /), 'A', '#/cm3', 'interstitial aerosol number with D>500 nm') + call addfld('totna500', (/ 'lev' /), 'A', '#/cm3', 'total aerosol number with D>500 nm') + + call addfld('FREQIMM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of immersion freezing') + call addfld('FREQCNT', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of contact freezing') + call addfld('FREQDEP', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of deposition freezing') + call addfld('FREQMIX', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of mixed-phase clouds' ) + + call addfld('DSTFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'dust immersion freezing rate') + call addfld('DSTFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'dust contact freezing rate') + call addfld('DSTFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'dust deposition freezing rate') + + call addfld('BCFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'bc immersion freezing rate') + call addfld('BCFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'bc contact freezing rate') + call addfld('BCFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'bc deposition freezing rate') + + call addfld('NIMIX_IMM', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to het immersion freezing in Mixed Clouds') + call addfld('NIMIX_CNT', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to het contact freezing in Mixed Clouds') + call addfld('NIMIX_DEP', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to het deposition freezing in Mixed Clouds') + + call addfld('DSTNIDEP', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to dst dep freezing in Mixed Clouds') + call addfld('DSTNICNT', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to dst cnt freezing in Mixed Clouds') + call addfld('DSTNIIMM', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to dst imm freezing in Mixed Clouds') + + call addfld('BCNIDEP', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to bc dep freezing in Mixed Clouds') + call addfld('BCNICNT', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to bc cnt freezing in Mixed Clouds') + call addfld('BCNIIMM', (/ 'lev' /), 'A', '#/m3', & + 'Activated Ice Number Concentration due to bc imm freezing in Mixed Clouds') + + call addfld('NUMICE10s', (/ 'lev' /), 'A', '#/m3', & + 'Ice Number Concentration due to het freezing in Mixed Clouds during 10-s period') + call addfld('NUMIMM10sDST', (/ 'lev' /), 'A', '#/m3', & + 'Ice Number Concentration due to imm freezing by dst in Mixed Clouds during 10-s period') + call addfld('NUMIMM10sBC', (/ 'lev' /), 'A', '#/m3', & + 'Ice Number Concentration due to imm freezing by bc in Mixed Clouds during 10-s period') + + if (hist_hetfrz_classnuc) then + + call add_default('bc_num', 1, ' ') + call add_default('dst1_num', 1, ' ') + call add_default('dst3_num', 1, ' ') + call add_default('bcc_num', 1, ' ') + call add_default('dst1c_num', 1, ' ') + call add_default('dst3c_num', 1, ' ') + call add_default('bcuc_num', 1, ' ') + call add_default('dst1uc_num', 1, ' ') + call add_default('dst3uc_num', 1, ' ') + + call add_default('bc_a1_num', 1, ' ') + call add_default('dst_a1_num', 1, ' ') + call add_default('dst_a3_num', 1, ' ') + call add_default('bc_c1_num', 1, ' ') + call add_default('dst_c1_num', 1, ' ') + call add_default('dst_c3_num', 1, ' ') + + call add_default('fn_bc_c1_num', 1, ' ') + call add_default('fn_dst_c1_num', 1, ' ') + call add_default('fn_dst_c3_num', 1, ' ') + + call add_default('na500', 1, ' ') + call add_default('totna500', 1, ' ') + + call add_default('FREQIMM', 1, ' ') + call add_default('FREQCNT', 1, ' ') + call add_default('FREQDEP', 1, ' ') + call add_default('FREQMIX', 1, ' ') + + call add_default('DSTFREZIMM', 1, ' ') + call add_default('DSTFREZCNT', 1, ' ') + call add_default('DSTFREZDEP', 1, ' ') + + call add_default('BCFREZIMM', 1, ' ') + call add_default('BCFREZCNT', 1, ' ') + call add_default('BCFREZDEP', 1, ' ') + + call add_default('NIMIX_IMM', 1, ' ') + call add_default('NIMIX_CNT', 1, ' ') + call add_default('NIMIX_DEP', 1, ' ') + + call add_default('DSTNIDEP', 1, ' ') + call add_default('DSTNICNT', 1, ' ') + call add_default('DSTNIIMM', 1, ' ') + + call add_default('BCNIDEP', 1, ' ') + call add_default('BCNICNT', 1, ' ') + call add_default('BCNIIMM', 1, ' ') + + call add_default('NUMICE10s', 1, ' ') + call add_default('NUMIMM10sDST', 1, ' ') + call add_default('NUMIMM10sBC', 1, ' ') + + end if + + ! The following code sets indices of the mode specific species used + ! in the module. Having a list of the species needed allows us to + ! allocate temporary space for just those species rather than for all the + ! CAM species (pcnst) which may be considerably more than needed. + ! + ! The indices set below are for use with the CAM rad_constituents + ! interfaces. Using the rad_constituents interfaces isolates the physics + ! parameterization which requires constituent information from the chemistry + ! code which provides that information. + + ! nmodes is the total number of modes + call rad_cnst_get_info(0, nmodes=nmodes) + + ! Determine mode indices for all modes referenced in this module. + mode_accum_idx = rad_cnst_get_mode_idx(0, 'accum') + mode_coarse_idx = rad_cnst_get_mode_idx(0, 'coarse') + mode_finedust_idx = rad_cnst_get_mode_idx(0, 'fine_dust') + mode_coardust_idx = rad_cnst_get_mode_idx(0, 'coarse_dust') + mode_pcarbon_idx = rad_cnst_get_mode_idx(0, 'primary_carbon') + + ! Check that required mode types were found + if (nmodes == MAM3_nmodes) then + if (mode_accum_idx == -1 .or. mode_coarse_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + mode_accum_idx, mode_coarse_idx + call endrun(routine//': ERROR required mode type not found') + end if + + else if (nmodes == MAM7_nmodes) then + if (mode_coardust_idx == -1 .or. mode_finedust_idx == -1 .or. mode_pcarbon_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + mode_coardust_idx, mode_finedust_idx, mode_pcarbon_idx + call endrun(routine//': ERROR required mode type not found') + end if + else if (nmodes == MAM4_nmodes) then + if (mode_accum_idx == -1 .or. mode_coarse_idx == -1 .or. mode_pcarbon_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + mode_accum_idx, mode_coarse_idx, mode_pcarbon_idx + call endrun(routine//': ERROR required mode type not found') + end if + end if + + ! Set some mode properties + + call rad_cnst_get_mode_props(0, mode_accum_idx, sigmag=sigma_logr_aer) + alnsg_mode_accum = log(sigma_logr_aer) + + if (nmodes == MAM3_nmodes) then + call rad_cnst_get_mode_props(0, mode_coarse_idx, sigmag=sigma_logr_aer) + alnsg_mode_coarse = log(sigma_logr_aer) + + else if (nmodes == MAM7_nmodes) then + call rad_cnst_get_mode_props(0, mode_finedust_idx, sigmag=sigma_logr_aer) + alnsg_mode_finedust = log(sigma_logr_aer) + + call rad_cnst_get_mode_props(0, mode_coardust_idx, sigmag=sigma_logr_aer) + alnsg_mode_coardust = log(sigma_logr_aer) + + call rad_cnst_get_mode_props(0, mode_pcarbon_idx, sigmag=sigma_logr_aer) + alnsg_mode_pcarbon = log(sigma_logr_aer) + + else if (nmodes == MAM4_nmodes) then + call rad_cnst_get_mode_props(0, mode_coarse_idx, sigmag=sigma_logr_aer) + alnsg_mode_coarse = log(sigma_logr_aer) + + call rad_cnst_get_mode_props(0, mode_pcarbon_idx, sigmag=sigma_logr_aer) + alnsg_mode_pcarbon = log(sigma_logr_aer) + end if + + ! Set list indices for all constituents (mass and number) used in this module. + ! The list is specific to the aerosol model used. Note that the order of the + ! constituents in these lists is arbitrary. + + if (nmodes == MAM3_nmodes) then + ncnst = 11 + so4_accum = 1 + bc_accum = 2 + pom_accum = 3 + soa_accum = 4 + dst_accum = 5 + ncl_accum = 6 + num_accum = 7 + dst_coarse = 8 + ncl_coarse = 9 + so4_coarse = 10 + num_coarse = 11 + else if (nmodes == MAM7_nmodes) then + ncnst = 15 + so4_accum = 1 + bc_accum = 2 + pom_accum = 3 + soa_accum = 4 + ncl_accum = 6 + num_accum = 7 + dst_finedust = 8 + so4_finedust = 9 + num_finedust = 10 + dst_coardust = 11 + so4_coardust = 12 + num_coardust = 13 + bc_pcarbon = 5 + pom_pcarbon = 14 + num_pcarbon = 15 + else if (nmodes == MAM4_nmodes) then + ncnst = 14 + so4_accum = 1 + bc_accum = 2 + pom_accum = 3 + soa_accum = 4 + dst_accum = 5 + ncl_accum = 6 + num_accum = 7 + dst_coarse = 8 + ncl_coarse = 9 + so4_coarse = 10 + num_coarse = 11 + bc_pcarbon = 12 + pom_pcarbon = 13 + num_pcarbon = 14 + end if + + ! Allocate arrays to hold specie and mode indices for all constitutents (mass and number) + ! needed in this module. + allocate(mode_idx(ncnst), spec_idx(ncnst), stat=istat) + call alloc_err(istat, routine, 'mode_idx, spec_idx', ncnst) + mode_idx = -1 + spec_idx = -1 + + ! Allocate space for copy of cloud borne aerosols before modification by droplet nucleation. + allocate(aer_cb(pcols,pver,ncnst,begchunk:endchunk), stat=istat) + call alloc_err(istat, routine, 'aer_cb', pcols*pver*ncnst*(endchunk-begchunk+1)) + + ! Allocate space for copy of interstitial aerosols with modified basis + allocate(aer(pcols,pver,ncnst,begchunk:endchunk), stat=istat) + call alloc_err(istat, routine, 'aer', pcols*pver*ncnst*(endchunk-begchunk+1)) + + ! The following code sets the species and mode indices for each constituent + ! in the list. The indices are identical in the interstitial and the cloud + ! borne phases. + ! Specie index 0 is used to indicate the mode number mixing ratio + + ! Indices for species in accumulation mode (so4, bc, pom, soa, nacl, dust) + spec_idx(num_accum) = 0 + mode_idx(num_accum) = mode_accum_idx + spec_idx(so4_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'sulfate') + mode_idx(so4_accum) = mode_accum_idx + spec_idx(bc_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'black-c') + mode_idx(bc_accum) = mode_accum_idx + spec_idx(pom_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'p-organic') + mode_idx(pom_accum) = mode_accum_idx + spec_idx(soa_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 's-organic') + mode_idx(soa_accum) = mode_accum_idx + spec_idx(ncl_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'seasalt') + mode_idx(ncl_accum) = mode_accum_idx + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + spec_idx(dst_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'dust') + mode_idx(dst_accum) = mode_accum_idx + end if + + ! Indices for species in coarse mode (dust, nacl, so4) + if (mode_coarse_idx > 0) then + spec_idx(num_coarse) = 0 + mode_idx(num_coarse) = mode_coarse_idx + spec_idx(ncl_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'seasalt') + mode_idx(ncl_coarse) = mode_coarse_idx + spec_idx(dst_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'dust') + mode_idx(dst_coarse) = mode_coarse_idx + spec_idx(so4_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'sulfate') + mode_idx(so4_coarse) = mode_coarse_idx + end if + + ! Indices for species in fine dust mode (dust, so4) + if (mode_finedust_idx > 0) then + spec_idx(num_finedust) = 0 + mode_idx(num_finedust) = mode_finedust_idx + spec_idx(dst_finedust) = rad_cnst_get_spec_idx(0, mode_finedust_idx, 'dust') + mode_idx(dst_finedust) = mode_finedust_idx + spec_idx(so4_finedust) = rad_cnst_get_spec_idx(0, mode_finedust_idx, 'sulfate') + mode_idx(so4_finedust) = mode_finedust_idx + end if + + ! Indices for species in coarse dust mode (dust, so4) + if (mode_coardust_idx > 0) then + spec_idx(num_coardust) = 0 + mode_idx(num_coardust) = mode_coardust_idx + spec_idx(dst_coardust) = rad_cnst_get_spec_idx(0, mode_coardust_idx, 'dust') + mode_idx(dst_coardust) = mode_coardust_idx + spec_idx(so4_coardust) = rad_cnst_get_spec_idx(0, mode_coardust_idx, 'sulfate') + mode_idx(so4_coardust) = mode_coardust_idx + end if + + ! Indices for species in primary carbon mode (bc, pom) + if (mode_pcarbon_idx > 0) then + spec_idx(num_pcarbon) = 0 + mode_idx(num_pcarbon) = mode_pcarbon_idx + spec_idx(bc_pcarbon) = rad_cnst_get_spec_idx(0, mode_pcarbon_idx, 'black-c') + mode_idx(bc_pcarbon) = mode_pcarbon_idx + spec_idx(pom_pcarbon) = rad_cnst_get_spec_idx(0, mode_pcarbon_idx, 'p-organic') + mode_idx(pom_pcarbon) = mode_pcarbon_idx + end if + + ! Check that all required specie types were found + if (any(spec_idx == -1)) then + write(iulog,*) routine//': ERROR required species type not found - indicies:', spec_idx + call endrun(routine//': ERROR required species type not found') + end if + + ! Get some specie specific properties. + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + call rad_cnst_get_aer_props(0, mode_idx(dst_accum), spec_idx(dst_accum), density_aer=specdens_dust) + else if (nmodes == MAM7_nmodes) then + call rad_cnst_get_aer_props(0, mode_idx(dst_finedust), spec_idx(dst_finedust), density_aer=specdens_dust) + end if + call rad_cnst_get_aer_props(0, mode_idx(so4_accum), spec_idx(so4_accum), density_aer=specdens_so4) + call rad_cnst_get_aer_props(0, mode_idx(bc_accum), spec_idx(bc_accum), density_aer=specdens_bc) + call rad_cnst_get_aer_props(0, mode_idx(soa_accum), spec_idx(soa_accum), density_aer=specdens_soa) + call rad_cnst_get_aer_props(0, mode_idx(pom_accum), spec_idx(pom_accum), density_aer=specdens_pom) + + call hetfrz_classnuc_init( & + rair, cpair, rh2o, rhoh2o, mwh2o, & + tmelt, pi, iulog) + +end subroutine hetfrz_classnuc_cam_init + +!================================================================================================ + +subroutine hetfrz_classnuc_cam_calc( & + state, deltatin, factnum, pbuf) + + ! arguments + type(physics_state), target, intent(in) :: state + real(r8), intent(in) :: deltatin ! time step (s) + real(r8), intent(in) :: factnum(:,:,:) ! activation fraction for aerosol number + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local workspace + + ! outputs shared with the microphysics via the pbuf + real(r8), pointer :: frzimm(:,:) + real(r8), pointer :: frzcnt(:,:) + real(r8), pointer :: frzdep(:,:) + + integer :: itim_old + integer :: i, k + + real(r8) :: rho(pcols,pver) ! air density (kg m-3) + + real(r8), pointer :: ast(:,:) + + real(r8) :: lcldm(pcols,pver) + + real(r8), pointer :: ptr2d(:,:) + + real(r8) :: fn(3) + real(r8) :: awcam(pcols,pver,3) + real(r8) :: awfacm(pcols,pver,3) + real(r8) :: hetraer(pcols,pver,3) + real(r8) :: dstcoat(pcols,pver,3) + real(r8) :: total_interstitial_aer_num(pcols,pver,3) + real(r8) :: total_cloudborne_aer_num(pcols,pver,3) + real(r8) :: total_aer_num(pcols,pver,3) + real(r8) :: coated_aer_num(pcols,pver,3) + real(r8) :: uncoated_aer_num(pcols,pver,3) + + real(r8) :: fn_cloudborne_aer_num(pcols,pver,3) + + + real(r8) :: con1, r3lx, supersatice + + real(r8) :: qcic + real(r8) :: ncic + + real(r8) :: frzbcimm(pcols,pver), frzduimm(pcols,pver) + real(r8) :: frzbccnt(pcols,pver), frzducnt(pcols,pver) + real(r8) :: frzbcdep(pcols,pver), frzdudep(pcols,pver) + + real(r8) :: freqimm(pcols,pver), freqcnt(pcols,pver), freqdep(pcols,pver), freqmix(pcols,pver) + real(r8) :: nnuccc_bc(pcols,pver), nnucct_bc(pcols,pver), nnudep_bc(pcols,pver) + real(r8) :: nnuccc_dst(pcols,pver), nnucct_dst(pcols,pver), nnudep_dst(pcols,pver) + real(r8) :: niimm_bc(pcols,pver), nicnt_bc(pcols,pver), nidep_bc(pcols,pver) + real(r8) :: niimm_dst(pcols,pver), nicnt_dst(pcols,pver), nidep_dst(pcols,pver) + real(r8) :: numice10s(pcols,pver) + real(r8) :: numice10s_imm_dst(pcols,pver) + real(r8) :: numice10s_imm_bc(pcols,pver) + + real(r8) :: na500(pcols,pver) + real(r8) :: tot_na500(pcols,pver) + + character(128) :: errstring ! Error status + !------------------------------------------------------------------------------- + + associate( & + lchnk => state%lchnk, & + ncol => state%ncol, & + t => state%t, & + qc => state%q(:pcols,:pver,cldliq_idx), & + nc => state%q(:pcols,:pver,numliq_idx), & + pmid => state%pmid ) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + rho(:,:) = 0._r8 + + do k = top_lev, pver + do i = 1, ncol + rho(i,k) = pmid(i,k)/(rair*t(i,k)) + end do + end do + + do k = top_lev, pver + do i = 1, ncol + lcldm(i,k) = max(ast(i,k), mincld) + end do + end do + + ! Convert interstitial and cloud borne aerosols from a mass to a volume basis before + ! being used in get_aer_num + do i = 1, ncnst + aer_cb(:ncol,:,i,lchnk) = aer_cb(:ncol,:,i,lchnk) * rho(:ncol,:) + + ! Check whether constituent is a mass or number mixing ratio + if (spec_idx(i) == 0) then + call rad_cnst_get_mode_num(0, mode_idx(i), 'a', state, pbuf, ptr2d) + else + call rad_cnst_get_aer_mmr(0, mode_idx(i), spec_idx(i), 'a', state, pbuf, ptr2d) + end if + aer(:ncol,:,i,lchnk) = ptr2d(:ncol,:) * rho(:ncol,:) + end do + + ! Init top levels of outputs of get_aer_num + total_aer_num = 0._r8 + coated_aer_num = 0._r8 + uncoated_aer_num = 0._r8 + total_interstitial_aer_num = 0._r8 + total_cloudborne_aer_num = 0._r8 + hetraer = 0._r8 + awcam = 0._r8 + awfacm = 0._r8 + dstcoat = 0._r8 + na500 = 0._r8 + tot_na500 = 0._r8 + + ! output aerosols as reference information for heterogeneous freezing + do i = 1, ncol + do k = top_lev, pver + call get_aer_num(i, k, ncnst, aer(:,:,:,lchnk), aer_cb(:,:,:,lchnk), rho(i,k), & + total_aer_num(i,k,:), coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), & + total_interstitial_aer_num(i,k,:), total_cloudborne_aer_num(i,k,:), & + hetraer(i,k,:), awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), & + na500(i,k), tot_na500(i,k)) + + fn_cloudborne_aer_num(i,k,1) = total_aer_num(i,k,1)*factnum(i,k,mode_accum_idx) ! bc + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + fn_cloudborne_aer_num(i,k,2) = total_aer_num(i,k,2)*factnum(i,k,mode_accum_idx) ! dst_a1 + fn_cloudborne_aer_num(i,k,3) = total_aer_num(i,k,3)*factnum(i,k,mode_coarse_idx) ! dst_a3 + else if (nmodes == MAM7_nmodes) then + fn_cloudborne_aer_num(i,k,2) = total_aer_num(i,k,2)*factnum(i,k,mode_finedust_idx) + fn_cloudborne_aer_num(i,k,3) = total_aer_num(i,k,3)*factnum(i,k,mode_coardust_idx) + end if + end do + end do + + call outfld('bc_num', total_aer_num(:,:,1), pcols, lchnk) + call outfld('dst1_num', total_aer_num(:,:,2), pcols, lchnk) + call outfld('dst3_num', total_aer_num(:,:,3), pcols, lchnk) + + call outfld('bcc_num', coated_aer_num(:,:,1), pcols, lchnk) + call outfld('dst1c_num', coated_aer_num(:,:,2), pcols, lchnk) + call outfld('dst3c_num', coated_aer_num(:,:,3), pcols, lchnk) + + call outfld('bcuc_num', uncoated_aer_num(:,:,1), pcols, lchnk) + call outfld('dst1uc_num', uncoated_aer_num(:,:,2), pcols, lchnk) + call outfld('dst3uc_num', uncoated_aer_num(:,:,3), pcols, lchnk) + + call outfld('bc_a1_num', total_interstitial_aer_num(:,:,1), pcols, lchnk) + call outfld('dst_a1_num', total_interstitial_aer_num(:,:,2), pcols, lchnk) + call outfld('dst_a3_num', total_interstitial_aer_num(:,:,3), pcols, lchnk) + + call outfld('bc_c1_num', total_cloudborne_aer_num(:,:,1), pcols, lchnk) + call outfld('dst_c1_num', total_cloudborne_aer_num(:,:,2), pcols, lchnk) + call outfld('dst_c3_num', total_cloudborne_aer_num(:,:,3), pcols, lchnk) + + call outfld('fn_bc_c1_num', fn_cloudborne_aer_num(:,:,1), pcols, lchnk) + call outfld('fn_dst_c1_num', fn_cloudborne_aer_num(:,:,2), pcols, lchnk) + call outfld('fn_dst_c3_num', fn_cloudborne_aer_num(:,:,3), pcols, lchnk) + + call outfld('na500', na500, pcols, lchnk) + call outfld('totna500', tot_na500, pcols, lchnk) + + ! frzimm, frzcnt, frzdep are the outputs of this parameterization used by the microphysics + call pbuf_get_field(pbuf, frzimm_idx, frzimm) + call pbuf_get_field(pbuf, frzcnt_idx, frzcnt) + call pbuf_get_field(pbuf, frzdep_idx, frzdep) + + frzimm(:ncol,:) = 0._r8 + frzcnt(:ncol,:) = 0._r8 + frzdep(:ncol,:) = 0._r8 + + frzbcimm(:ncol,:) = 0._r8 + frzduimm(:ncol,:) = 0._r8 + frzbccnt(:ncol,:) = 0._r8 + frzducnt(:ncol,:) = 0._r8 + frzbcdep(:ncol,:) = 0._r8 + frzdudep(:ncol,:) = 0._r8 + + freqimm(:ncol,:) = 0._r8 + freqcnt(:ncol,:) = 0._r8 + freqdep(:ncol,:) = 0._r8 + freqmix(:ncol,:) = 0._r8 + + numice10s(:ncol,:) = 0._r8 + numice10s_imm_dst(:ncol,:) = 0._r8 + numice10s_imm_bc(:ncol,:) = 0._r8 + + nnuccc_bc(:,:) = 0._r8 + nnucct_bc(:,:) = 0._r8 + nnudep_bc(:,:) = 0._r8 + + nnuccc_dst(:,:) = 0._r8 + nnucct_dst(:,:) = 0._r8 + nnudep_dst(:,:) = 0._r8 + + niimm_bc(:,:) = 0._r8 + nicnt_bc(:,:) = 0._r8 + nidep_bc(:,:) = 0._r8 + + niimm_dst(:,:) = 0._r8 + nicnt_dst(:,:) = 0._r8 + nidep_dst(:,:) = 0._r8 + + do i = 1, ncol + do k = top_lev, pver + + if (t(i,k) > 235.15_r8 .and. t(i,k) < 269.15_r8) then + qcic = min(qc(i,k)/lcldm(i,k), 5.e-3_r8) + ncic = max(nc(i,k)/lcldm(i,k), 0._r8) + + con1 = 1._r8/(1.333_r8*pi)**0.333_r8 + r3lx = con1*(rho(i,k)*qcic/(rhoh2o*max(ncic*rho(i,k), 1.0e6_r8)))**0.333_r8 ! in m + r3lx = max(4.e-6_r8, r3lx) + supersatice = svp_water(t(i,k))/svp_ice(t(i,k)) + + fn(1) = factnum(i,k,mode_accum_idx) ! bc accumulation mode + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + fn(2) = factnum(i,k,mode_accum_idx) ! dust_a1 accumulation mode + fn(3) = factnum(i,k,mode_coarse_idx) ! dust_a3 coarse mode + else if (nmodes == MAM7_nmodes) then + fn(2) = factnum(i,k,mode_finedust_idx) + fn(3) = factnum(i,k,mode_coardust_idx) + end if + + call hetfrz_classnuc_calc( & + deltatin, t(i,k), pmid(i,k), supersatice, & + fn, r3lx, ncic*rho(i,k)*1.0e-6_r8, frzbcimm(i,k), frzduimm(i,k), & + frzbccnt(i,k), frzducnt(i,k), frzbcdep(i,k), frzdudep(i,k), hetraer(i,k,:), & + awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), total_aer_num(i,k,:), & + coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), total_interstitial_aer_num(i,k,:), & + total_cloudborne_aer_num(i,k,:), errstring) + + call handle_errmsg(errstring, subname="hetfrz_classnuc_calc") + + frzimm(i,k) = frzbcimm(i,k) + frzduimm(i,k) + frzcnt(i,k) = frzbccnt(i,k) + frzducnt(i,k) + frzdep(i,k) = frzbcdep(i,k) + frzdudep(i,k) + + if (frzimm(i,k) > 0._r8) freqimm(i,k) = 1._r8 + if (frzcnt(i,k) > 0._r8) freqcnt(i,k) = 1._r8 + if (frzdep(i,k) > 0._r8) freqdep(i,k) = 1._r8 + if ((frzimm(i,k) + frzcnt(i,k) + frzdep(i,k)) > 0._r8) freqmix(i,k) = 1._r8 + else + frzimm(i,k) = 0._r8 + frzcnt(i,k) = 0._r8 + frzdep(i,k) = 0._r8 + end if + + nnuccc_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*ast(i,k) + nnucct_bc(i,k) = frzbccnt(i,k)*1.0e6_r8*ast(i,k) + nnudep_bc(i,k) = frzbcdep(i,k)*1.0e6_r8*ast(i,k) + + nnuccc_dst(i,k) = frzduimm(i,k)*1.0e6_r8*ast(i,k) + nnucct_dst(i,k) = frzducnt(i,k)*1.0e6_r8*ast(i,k) + nnudep_dst(i,k) = frzdudep(i,k)*1.0e6_r8*ast(i,k) + + niimm_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*deltatin + nicnt_bc(i,k) = frzbccnt(i,k)*1.0e6_r8*deltatin + nidep_bc(i,k) = frzbcdep(i,k)*1.0e6_r8*deltatin + + niimm_dst(i,k) = frzduimm(i,k)*1.0e6_r8*deltatin + nicnt_dst(i,k) = frzducnt(i,k)*1.0e6_r8*deltatin + nidep_dst(i,k) = frzdudep(i,k)*1.0e6_r8*deltatin + + numice10s(i,k) = (frzimm(i,k)+frzcnt(i,k)+frzdep(i,k))*1.0e6_r8*deltatin*(10._r8/deltatin) + numice10s_imm_dst(i,k) = frzduimm(i,k)*1.0e6_r8*deltatin*(10._r8/deltatin) + numice10s_imm_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*deltatin*(10._r8/deltatin) + end do + end do + + call outfld('FREQIMM', freqimm, pcols, lchnk) + call outfld('FREQCNT', freqcnt, pcols, lchnk) + call outfld('FREQDEP', freqdep, pcols, lchnk) + call outfld('FREQMIX', freqmix, pcols, lchnk) + + call outfld('DSTFREZIMM', nnuccc_dst, pcols, lchnk) + call outfld('DSTFREZCNT', nnucct_dst, pcols, lchnk) + call outfld('DSTFREZDEP', nnudep_dst, pcols, lchnk) + + call outfld('BCFREZIMM', nnuccc_bc, pcols, lchnk) + call outfld('BCFREZCNT', nnucct_bc, pcols, lchnk) + call outfld('BCFREZDEP', nnudep_bc, pcols, lchnk) + + call outfld('NIMIX_IMM', niimm_bc+niimm_dst, pcols, lchnk) + call outfld('NIMIX_CNT', nicnt_bc+nicnt_dst, pcols, lchnk) + call outfld('NIMIX_DEP', nidep_bc+nidep_dst, pcols, lchnk) + + call outfld('DSTNICNT', nicnt_dst, pcols, lchnk) + call outfld('DSTNIDEP', nidep_dst, pcols, lchnk) + call outfld('DSTNIIMM', niimm_dst, pcols, lchnk) + + call outfld('BCNICNT', nicnt_bc, pcols, lchnk) + call outfld('BCNIDEP', nidep_bc, pcols, lchnk) + call outfld('BCNIIMM', niimm_bc, pcols, lchnk) + + call outfld('NUMICE10s', numice10s, pcols, lchnk) + call outfld('NUMIMM10sDST', numice10s_imm_dst, pcols, lchnk) + call outfld('NUMIMM10sBC', numice10s_imm_bc, pcols, lchnk) + + end associate + +end subroutine hetfrz_classnuc_cam_calc + +!==================================================================================================== + +subroutine hetfrz_classnuc_cam_save_cbaero(state, pbuf) + + ! Save the required cloud borne aerosol constituents. + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local variables + integer :: i, lchnk + real(r8), pointer :: ptr2d(:,:) + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + + ! loop over the cloud borne constituents required by this module and save + ! a local copy + + do i = 1, ncnst + + ! Check whether constituent is a mass or number mixing ratio + if (spec_idx(i) == 0) then + call rad_cnst_get_mode_num(0, mode_idx(i), 'c', state, pbuf, ptr2d) + else + call rad_cnst_get_aer_mmr(0, mode_idx(i), spec_idx(i), 'c', state, pbuf, ptr2d) + end if + aer_cb(:,:,i,lchnk) = ptr2d + end do + +end subroutine hetfrz_classnuc_cam_save_cbaero + +!==================================================================================================== + +subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& + total_aer_num, & + coated_aer_num, & + uncoated_aer_num, & + total_interstial_aer_num, & + total_cloudborne_aer_num, & + hetraer, awcam, awfacm, dstcoat, & + na500, tot_na500) + + !***************************************************************************** + ! Purpose: Calculate BC and Dust number, including total number(interstitial+ + ! cloud borne), one monolayer coated number, and uncoated number + ! + ! Author: Yong Wang and Xiaohong Liu, UWyo, 12/2012 + !***************************************************************************** + + ! input + integer, intent(in) :: ii, kk, ncnst + real(r8), intent(in) :: aer(pcols,pver,ncnst) ! interstitial aerosols, volume basis + real(r8), intent(in) :: aer_cb(pcols,pver,ncnst) ! cloud borne aerosols, volume basis + real(r8), intent(in) :: rhoair ! air density (kg/m3) + + ! The interstitial and cloud borne aerosol concentrations are accessed from + ! module variables local to this module. + + ! output + real(r8), intent(out) :: total_aer_num(3) ! #/cm^3 + real(r8), intent(out) :: total_interstial_aer_num(3) ! #/cm^3 + real(r8), intent(out) :: total_cloudborne_aer_num(3) ! #/cm^3 + real(r8), intent(out) :: coated_aer_num(3) ! #/cm^3 + real(r8), intent(out) :: uncoated_aer_num(3) ! #/cm^3 + real(r8), intent(out) :: hetraer(3) ! BC and Dust mass mean radius [m] + real(r8), intent(out) :: awcam(3) ! modal added mass [mug m-3] + real(r8), intent(out) :: awfacm(3) ! (OC+BC)/(OC+BC+SO4) + real(r8), intent(out) :: dstcoat(3) ! coated fraction + real(r8), intent(out) :: na500 ! #/cm^3 interstitial aerosol number with D>500 nm (#/cm^3) + real(r8), intent(out) :: tot_na500 ! #/cm^3 total aerosol number with D>500 nm (#/cm^3) + + + !local variables + !------------coated variables-------------------- + real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle + real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10_r8 + real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity + real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity + real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity + real(r8), parameter :: soa_equivso4_factor = spechygro_soa/spechygro_so4 + real(r8), parameter :: pom_equivso4_factor = spechygro_pom/spechygro_so4 + real(r8) :: vol_shell(3) + real(r8) :: vol_core(3) + real(r8) :: fac_volsfc_dust_a1, fac_volsfc_dust_a3, fac_volsfc_bc + real(r8) :: tmp1, tmp2 + real(r8) :: bc_num ! bc number in accumulation mode for MAM3 + ! bc number in accumulation and primary carbon mode for MAM7 and MAM4 + real(r8) :: dst1_num, dst3_num ! dust number in accumulation and corase mode for MAM3 + ! dust number in fine dust and corase dust mode for MAM7 and MAM4 + logical :: num_to_mass_in = .true. + real(r8), parameter :: bc_num_to_mass = 4.669152e+17_r8 ! #/kg from emission + real(r8), parameter :: dst1_num_to_mass = 3.484e+15_r8 ! #/kg for dust in accumulation mode + + real(r8) :: dmc, ssmc + + real(r8) :: as_so4, as_du, as_soa + real(r8) :: dst1_num_imm, dst3_num_imm, bc_num_imm + real(r8) :: dmc_imm, ssmc_imm + real(r8) :: as_bc, as_pom, as_ss + + real(r8) :: r_bc ! model radii of BC modes [m] + real(r8) :: r_dust_a1, r_dust_a3 ! model radii of dust modes [m] + + integer :: i + real(r8) :: dst1_scale + !------------------------------------------------------------------------------- + + ! init output vars + total_aer_num = 0._r8 + total_interstial_aer_num = 0._r8 + total_cloudborne_aer_num = 0._r8 + coated_aer_num = 0._r8 + uncoated_aer_num = 0._r8 + hetraer = 0._r8 + awcam = 0._r8 + awfacm = 0._r8 + dstcoat = 0._r8 + na500 = 0._r8 + tot_na500 = 0._r8 + + !***************************************************************************** + ! calculate intersitial aerosol + !***************************************************************************** + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + + if (.not. num_to_mass_in) then + + as_so4 = aer(ii,kk,so4_accum) + as_bc = aer(ii,kk,bc_accum) + as_pom = aer(ii,kk,pom_accum) + as_soa = aer(ii,kk,soa_accum) + as_ss = aer(ii,kk,ncl_accum) + as_du = aer(ii,kk,dst_accum) + + if (as_du > 0._r8) then + dst1_num = as_du/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & + * aer(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 + else + dst1_num = 0.0_r8 + end if + + if (as_bc > 0._r8) then + bc_num = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & + * aer(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 + else + bc_num = 0.0_r8 + end if + + else + + dst1_num = aer(ii,kk,dst_accum) * dst1_num_to_mass*1.0e-6_r8 ! #/cm^3, dust # in accumulation mode + bc_num = aer(ii,kk,bc_accum) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 + end if + dmc = aer(ii,kk,dst_coarse) + ssmc = aer(ii,kk,ncl_coarse) + + if (dmc > 0._r8 ) then + dst3_num = dmc/(ssmc+dmc) * aer(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 + else + dst3_num = 0.0_r8 + end if + + if (nmodes == MAM4_nmodes) then + bc_num = bc_num+(aer(ii,kk,bc_pcarbon)) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 + end if + else if (nmodes == MAM7_nmodes) then + bc_num = (aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon)) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 + dst1_num = aer(ii,kk,num_finedust)*1.0e-6_r8 ! #/cm^3 + dst3_num = aer(ii,kk,num_coardust)*1.0e-6_r8 ! #/cm^3 + end if + + !***************************************************************************** + ! calculate cloud borne aerosol + !***************************************************************************** + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + + as_so4 = aer_cb(ii,kk,so4_accum) + as_bc = aer_cb(ii,kk,bc_accum) + as_pom = aer_cb(ii,kk,pom_accum) + as_soa = aer_cb(ii,kk,soa_accum) + as_ss = aer_cb(ii,kk,ncl_accum) + as_du = aer_cb(ii,kk,dst_accum) + + if (as_du > 0._r8) then + dst1_num_imm = as_du/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & + * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 + else + dst1_num_imm = 0.0_r8 + end if + + if (as_bc > 0._r8) then + bc_num_imm = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & + * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 + else + bc_num_imm = 0.0_r8 + end if + + dmc_imm = aer_cb(ii,kk,dst_coarse) + ssmc_imm = aer_cb(ii,kk,ncl_coarse) + + if (dmc_imm > 0._r8) then + dst3_num_imm = dmc_imm/(ssmc_imm+dmc_imm) * aer_cb(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 + else + dst3_num_imm = 0.0_r8 + end if + + else if (nmodes == MAM7_nmodes) then + ! primary carbon mode is insoluble and thus don't consider its cloud-borne state + as_so4 = aer_cb(ii,kk,so4_accum) + as_bc = aer_cb(ii,kk,bc_accum) + as_pom = aer_cb(ii,kk,pom_accum) + as_soa = aer_cb(ii,kk,soa_accum) + as_ss = aer_cb(ii,kk,ncl_accum) + if (as_bc > 0._r8) then + bc_num_imm = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss) & + * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 + else + bc_num_imm = 0.0_r8 + end if + dst1_num_imm = aer_cb(ii,kk,num_finedust)*1.0e-6_r8 ! #/cm^3 + dst3_num_imm = aer_cb(ii,kk,num_coardust)*1.0e-6_r8 ! #/cm^3 + end if + + total_interstial_aer_num(1) = bc_num + total_interstial_aer_num(2) = dst1_num + total_interstial_aer_num(3) = dst3_num + + total_cloudborne_aer_num(1) = bc_num_imm + total_cloudborne_aer_num(2) = dst1_num_imm + total_cloudborne_aer_num(3) = dst3_num_imm + + !***************************************************************************** + ! calculate mass mean radius + !***************************************************************************** + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + + if (nmodes == MAM3_nmodes) then + + if (aer(ii,kk,bc_accum)*1.0e-3_r8 > 1.0e-30_r8 .and. bc_num > 1.0e-3_r8) then + r_bc = ( 3._r8/(4*pi*specdens_bc)*aer(ii,kk,bc_accum)/(bc_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_bc = 0.04e-6_r8 + end if + + else + if ((aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))*1.0e-3_r8 > 1.0e-30_r8 & + .and. bc_num > 1.0e-3_r8) then + r_bc = ( 3._r8/(4*pi*specdens_bc)*(aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))/ & + (bc_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_bc = 0.067e-6_r8 ! from emission size + end if + + end if + + if (aer(ii,kk,dst_accum)*1.0e-3_r8 > 1.0e-30_r8 .and. dst1_num > 1.0e-3_r8) then + r_dust_a1 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_accum)/(dst1_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_dust_a1 = 0.258e-6_r8 + end if + + if (aer(ii,kk,dst_coarse)*1.0e-3_r8 > 1.0e-30_r8 .and. dst3_num > 1.0e-3_r8) then + r_dust_a3 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_coarse)/(dst3_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_dust_a3 = 1.576e-6_r8 + end if + + else if (nmodes == MAM7_nmodes) then + + if ((aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))*1.0e-3_r8 > 1.0e-30_r8 & + .and. bc_num > 1.0e-3_r8) then + r_bc = ( 3._r8/(4*pi*specdens_bc)*(aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))/ & + (bc_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_bc = 0.067e-6_r8 ! from emission size + end if + + if (aer(ii,kk,dst_finedust)*1.0e-3_r8 > 1.0e-30_r8 .and. dst1_num > 1.0e-3_r8) then + r_dust_a1 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_finedust)/(dst1_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_dust_a1 = 0.258e-6_r8 + end if + + if (aer(ii,kk,dst_coardust)*1.0e-3_r8 > 1.0e-30_r8 .and. dst3_num > 1.0e-3_r8) then + r_dust_a3 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_coardust)/(dst3_num*1.0e6_r8) )**(1._r8/3._r8) + else + r_dust_a3 = 1.576e-6_r8 + end if + end if + + hetraer(1) = r_bc + hetraer(2) = r_dust_a1 + hetraer(3) = r_dust_a3 + + !***************************************************************************** + ! calculate coated fraction + !***************************************************************************** + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + + fac_volsfc_bc = exp(2.5_r8*alnsg_mode_accum**2) + fac_volsfc_dust_a1 = exp(2.5_r8*alnsg_mode_accum**2) + fac_volsfc_dust_a3 = exp(2.5_r8*alnsg_mode_coarse**2) + + vol_shell(2) = ( aer(ii,kk,so4_accum)/specdens_so4 + & + aer(ii,kk,pom_accum)*pom_equivso4_factor/specdens_pom + & + aer(ii,kk,soa_accum)*soa_equivso4_factor/specdens_soa )/rhoair + + vol_core(2) = aer(ii,kk,dst_accum)/(specdens_dust*rhoair) + + ! ratio1 = vol_shell/vol_core = + ! actual hygroscopic-shell-volume/dust-core-volume + ! ratio2 = 6.0_r8*dr_so4_monolayers_pcage/(dgncur_a*fac_volsfc_dust) + ! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume + ! The 6.0/(dgncur_a*fac_volsfc_dust) = (mode-surface-area/mode-volume) + ! Note that vol_shell includes both so4, pom, AND soa as "equivalent so4", + ! The soa_equivso4_factor accounts for the lower hygroscopicity of soa. + ! + ! Define xferfrac_pcage = min( 1.0, ratio1/ratio2) + ! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow + + ! bc + if (nmodes == MAM3_nmodes) then + vol_shell(1) = vol_shell(2) + vol_core(1) = aer(ii,kk,bc_accum)/(specdens_bc*rhoair) + tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) + dstcoat(1) = tmp1/tmp2 + else + fac_volsfc_bc = exp(2.5_r8*alnsg_mode_pcarbon**2) + vol_shell(1) = ( aer(ii,kk,pom_pcarbon)*pom_equivso4_factor/specdens_pom )/rhoair + vol_core(1) = aer(ii,kk,bc_pcarbon)/(specdens_bc*rhoair) + tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) + dstcoat(1) = tmp1/tmp2 + end if + + ! dust_a1 + tmp1 = vol_shell(2)*(r_dust_a1*2._r8)*fac_volsfc_dust_a1 + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(2), 0.0_r8) + dstcoat(2) = tmp1/tmp2 + + ! dust_a3 + vol_shell(3) = aer(ii,kk,so4_coarse)/(specdens_so4*rhoair) + vol_core(3) = aer(ii,kk,dst_coarse)/(specdens_dust*rhoair) + tmp1 = vol_shell(3)*(r_dust_a3*2._r8)*fac_volsfc_dust_a3 + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(3), 0.0_r8) + dstcoat(3) = tmp1/tmp2 + + else if (nmodes == MAM7_nmodes) then + + ! for BC, only consider primary carbon mode, + ! because most of particles in this mode are uncoated + ! and nearly all particles in accumulation mode are coated + fac_volsfc_bc = exp(2.5_r8*alnsg_mode_pcarbon**2) + + vol_shell(1) = ( aer(ii,kk,pom_pcarbon)*pom_equivso4_factor/specdens_pom )/rhoair + vol_core(1) = aer(ii,kk,bc_pcarbon)/(specdens_bc*rhoair) + tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) + dstcoat(1) = tmp1/tmp2 + + fac_volsfc_dust_a1 = exp(2.5_r8*alnsg_mode_finedust**2) + fac_volsfc_dust_a3 = exp(2.5_r8*alnsg_mode_coardust**2) + + vol_shell(2) = aer(ii,kk,so4_finedust)/(specdens_so4*rhoair) + vol_core(2) = aer(ii,kk,dst_finedust)/(specdens_dust*rhoair) + + tmp1 = vol_shell(2)*(r_dust_a1*2._r8)*fac_volsfc_dust_a1 + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(2), 0.0_r8) + dstcoat(2) = tmp1/tmp2 + + vol_shell(3) = aer(ii,kk,so4_coardust)/(specdens_so4*rhoair) + vol_core(3) = aer(ii,kk,dst_coardust)/(specdens_dust*rhoair) + tmp1 = vol_shell(3)*(r_dust_a3*2._r8)*fac_volsfc_dust_a3 + tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(3), 0.0_r8) + dstcoat(3) = tmp1/tmp2 + + end if + + if (dstcoat(1) > 1._r8) dstcoat(1) = 1._r8 + if (dstcoat(1) < 0.001_r8) dstcoat(1) = 0.001_r8 + if (dstcoat(2) > 1._r8) dstcoat(2) = 1._r8 + if (dstcoat(2) < 0.001_r8) dstcoat(2) = 0.001_r8 + if (dstcoat(3) > 1._r8) dstcoat(3) = 1._r8 + if (dstcoat(3) < 0.001_r8) dstcoat(3) = 0.001_r8 + + do i = 1, 3 + total_aer_num(i) = total_interstial_aer_num(i) + total_cloudborne_aer_num(i) + coated_aer_num(i) = total_interstial_aer_num(i)*dstcoat(i) + uncoated_aer_num(i) = total_interstial_aer_num(i)*(1._r8-dstcoat(i)) + end do + + if (nmodes == MAM4_nmodes .or. nmodes == MAM7_nmodes) then + coated_aer_num(1) = (aer(ii,kk,bc_pcarbon)*bc_num_to_mass*1.0e-6_r8)*dstcoat(1)+ & + (aer(ii,kk,bc_accum)*bc_num_to_mass*1.0e-6_r8) + uncoated_aer_num(1) = (aer(ii,kk,bc_pcarbon)*bc_num_to_mass*1.0e-6_r8)*(1._r8-dstcoat(1)) + end if + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + dst1_scale = 0.488_r8 ! scaled for D>0.5-1 um from 0.1-1 um + else if (nmodes == MAM7_nmodes) then + dst1_scale = 0.566_r8 ! scaled for D>0.5-2 um from 0.1-2 um + end if + + tot_na500 = total_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6 + + total_aer_num(2)*dst1_scale + total_aer_num(3) + + na500 = total_interstial_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6 + + total_interstial_aer_num(2)*dst1_scale + total_interstial_aer_num(3) + + !***************************************************************************** + ! prepare some variables for water activity + !***************************************************************************** + + if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then + ! accumulation mode for dust_a1 + if (aer(ii,kk,num_accum) > 0._r8) then + awcam(2) = (dst1_num*1.0e6_r8)/aer(ii,kk,num_accum)* & + ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + & + aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] + else + awcam(2) = 0._r8 + end if + + if (awcam(2) > 0._r8) then + awfacm(2) = ( aer(ii,kk,bc_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) )/ & + ( aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,so4_accum) + aer(ii,kk,bc_accum) ) + else + awfacm(2) = 0._r8 + end if + + ! accumulation mode for bc (if MAM4, primary carbon mode is insoluble) + if (aer(ii,kk,num_accum) > 0._r8) then + awcam(1) = (bc_num*1.0e6_r8)/aer(ii,kk,num_accum)* & + ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] + else + awcam(1) = 0._r8 + end if + awfacm(1) = awfacm(2) + + ! coarse mode for dust_a3 + if (aer(ii,kk,num_coarse) > 0._r8) then + awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coarse)* aer(ii,kk,so4_coarse)*1.0e9_r8 + else + awcam(3) = 0._r8 + end if + awfacm(3) = 0._r8 + + else if (nmodes == MAM7_nmodes) then + + ! accumulation mode for bc (primary carbon mode is insoluble) + if (aer(ii,kk,num_accum) > 0._r8) then + awcam(1) = (bc_num*1.0e6_r8)/aer(ii,kk,num_accum)* & + ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] + else + awcam(1) = 0._r8 + end if + + if (awcam(1) > 0._r8) then + awfacm(1) = ( aer(ii,kk,bc_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) )/ & + ( aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,so4_accum) + aer(ii,kk,bc_accum) ) + else + awfacm(1) = 0._r8 + end if + + if (aer(ii,kk,num_finedust) > 0._r8) then + awcam(2) = (dst1_num*1.0e6_r8)/aer(ii,kk,num_finedust)* aer(ii,kk,so4_finedust)*1.0e9_r8 + else + awcam(2) = 0._r8 + end if + awfacm(2) = 0._r8 + + if (aer(ii,kk,num_coardust) > 0._r8) then + awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coardust)* aer(ii,kk,so4_coardust)*1.0e9_r8 + else + awcam(3) = 0._r8 + end if + awfacm(3) = 0._r8 + + end if + +end subroutine get_aer_num + +!==================================================================================================== + +end module hetfrz_classnuc_cam diff --git a/src/physics/cam/hk_conv.F90 b/src/physics/cam/hk_conv.F90 new file mode 100644 index 0000000000..67955a08f7 --- /dev/null +++ b/src/physics/cam/hk_conv.F90 @@ -0,0 +1,1109 @@ + +module hk_conv +! +! Moist convection. Primarily data used by both Zhang-McFarlane convection +! and Hack shallow convective schemes. +! +! $Id$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + implicit none + + private + save +! +! Public interfaces +! + public mfinti ! Initialization of data for moist convection + public cmfmca ! Hack shallow convection + public hkconv_readnl ! read hkconv_nl namelist + +! +! Private data used for Hack shallow convection +! + real(r8), parameter :: unset_r8 = huge(1.0_r8) + + ! Namelist variables + real(r8) :: hkconv_c0 = unset_r8 + real(r8) :: hkconv_cmftau = unset_r8 + + real(r8) :: hlat ! latent heat of vaporization + real(r8) :: c0 ! rain water autoconversion coefficient set from namelist input hkconv_c0 + real(r8) :: betamn ! minimum overshoot parameter + real(r8) :: rhlat ! reciprocal of hlat + real(r8) :: rcp ! reciprocal of cp + real(r8) :: cmftau ! characteristic adjustment time scale set from namelist input hkconv_cmftau + real(r8) :: rhoh2o ! density of liquid water (STP) + real(r8) :: dzmin ! minimum convective depth for precipitation + real(r8) :: tiny ! arbitrary small num used in transport estimates + real(r8) :: eps ! convergence criteria (machine dependent) + real(r8) :: tpmax ! maximum acceptable t perturbation (degrees C) + real(r8) :: shpmax ! maximum acceptable q perturbation (g/g) + + integer :: iloc ! longitude location for diagnostics + integer :: jloc ! latitude location for diagnostics + integer :: nsloc ! nstep for which to produce diagnostics +! + logical :: rlxclm ! logical to relax column versus cloud triplet + + real(r8) cp ! specific heat of dry air + real(r8) grav ! gravitational constant + real(r8) rgrav ! reciprocal of grav + real(r8) rgas ! gas constant for dry air + integer limcnv ! top interface level limit for convection + + + + +contains +subroutine hkconv_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'hkconv_readnl' + + namelist /hkconv_nl/ hkconv_cmftau, hkconv_c0 + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'hkconv_nl', status=ierr) + if (ierr == 0) then + read(unitn, hkconv_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + cmftau = hkconv_cmftau + c0 = hkconv_c0 + + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(cmftau, 1, mpir8, 0, mpicom) + call mpibcast(c0, 1, mpir8, 0, mpicom) +#endif + +end subroutine hkconv_readnl + +!================================================================================================ + +subroutine mfinti (rair ,cpair ,gravit ,latvap ,rhowtr,limcnv_in ) +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize moist convective mass flux procedure common block, cmfmca +! +! Method: +! +! +! +! Author: J. Hack +! +!----------------------------------------------------------------------- + use spmd_utils, only: masterproc +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: rair ! gas constant for dry air + real(r8), intent(in) :: cpair ! specific heat of dry air + real(r8), intent(in) :: gravit ! acceleration due to gravity + real(r8), intent(in) :: latvap ! latent heat of vaporization + real(r8), intent(in) :: rhowtr ! density of liquid water (STP) + integer, intent(in) :: limcnv_in ! top interface level limit for convection + + ! local variables + character(len=32) :: hgrid ! horizontal grid specifier +! +!----------------------------------------------------------------------- +! +! Initialize physical constants for moist convective mass flux procedure +! + cp = cpair ! specific heat of dry air + hlat = latvap ! latent heat of vaporization + grav = gravit ! gravitational constant + rgas = rair ! gas constant for dry air + rhoh2o = rhowtr ! density of liquid water (STP) + + limcnv = limcnv_in + + ! Initialize free parameters for moist convective mass flux procedure + ! cmftau - characteristic adjustment time scale + ! c0 - rain water autoconversion coeff (1/m) + + if (masterproc) then + write(iulog,*) 'tuning parameters hk_conv: cmftau',cmftau + write(iulog,*) 'tuning parameters hk_conv: c0',c0 + endif + dzmin = 0.0_r8 ! minimum cloud depth to precipitate (m) + betamn = 0.10_r8 ! minimum overshoot parameter + + + tpmax = 1.50_r8 ! maximum acceptable t perturbation (deg C) + shpmax = 1.50e-3_r8 ! maximum acceptable q perturbation (g/g) + rlxclm = .true. ! logical variable to specify that relaxation +! time scale should applied to column as +! opposed to triplets individually +! +! Initialize miscellaneous (frequently used) constants +! + rhlat = 1.0_r8/hlat ! reciprocal latent heat of vaporization + rcp = 1.0_r8/cp ! reciprocal specific heat of dry air + rgrav = 1.0_r8/grav ! reciprocal gravitational constant +! +! Initialize diagnostic location information for moist convection scheme +! + iloc = 1 ! longitude point for diagnostic info + jloc = 1 ! latitude point for diagnostic info + nsloc = 1 ! nstep value at which to begin diagnostics +! +! Initialize other miscellaneous parameters +! + tiny = 1.0e-36_r8 ! arbitrary small number (scalar transport) + eps = 1.0e-13_r8 ! convergence criteria (machine dependent) +! + return +end subroutine mfinti + +subroutine cmfmca(lchnk ,ncol , & + nstep ,ztodt ,pmid ,pdel , & + rpdel ,zm ,tpert ,qpert ,phis , & + pblh ,t ,q ,cmfdt ,dq , & + cmfmc ,cmfdqr ,cmfsl ,cmflq ,precc , & + qc ,cnt ,cnb ,icwmr ,rliq , & + pmiddry ,pdeldry ,rpdeldry) +!----------------------------------------------------------------------- +! +! Purpose: +! Moist convective mass flux procedure: +! +! Method: +! If stratification is unstable to nonentraining parcel ascent, +! complete an adjustment making successive use of a simple cloud model +! consisting of three layers (sometimes referred to as a triplet) +! +! Code generalized to allow specification of parcel ("updraft") +! properties, as well as convective transport of an arbitrary +! number of passive constituents (see q array). The code +! is written so the water vapor field is passed independently +! in the calling list from the block of other transported +! constituents, even though as currently designed, it is the +! first component in the constituents field. +! +! Author: J. Hack +! +! BAB: changed code to report tendencies in cmfdt and dq, instead of +! updating profiles. Cmfdq contains water only, made it a local variable +! made dq (all constituents) the argument. +! +!----------------------------------------------------------------------- + +!####################################################################### +!# # +!# Debugging blocks are marked this way for easy identification # +!# # +!####################################################################### + use constituents, only: pcnst + use constituents, only: cnst_get_type_byind + use ppgrid, only: pcols, pver, pverp + use phys_grid, only: get_lat_all_p, get_lon_all_p + use wv_saturation, only: qsat + + real(r8) ssfac ! supersaturation bound (detrained air) + parameter (ssfac = 1.001_r8) + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: nstep ! current time step index + + real(r8), intent(in) :: ztodt ! 2 delta-t (seconds) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure + real(r8), intent(in) :: pdel(pcols,pver) ! delta-p + real(r8), intent(in) :: pmiddry(pcols,pver) ! pressure + real(r8), intent(in) :: pdeldry(pcols,pver) ! delta-p + real(r8), intent(in) :: rpdel(pcols,pver) ! 1./pdel + real(r8), intent(in) :: rpdeldry(pcols,pver) ! 1./pdel + real(r8), intent(in) :: zm(pcols,pver) ! height abv sfc at midpoints + real(r8), intent(in) :: tpert(pcols) ! PBL perturbation theta + real(r8), intent(in) :: qpert(pcols,pcnst) ! PBL perturbation specific humidity + real(r8), intent(in) :: phis(pcols) ! surface geopotential + real(r8), intent(in) :: pblh(pcols) ! PBL height (provided by PBL routine) + real(r8), intent(in) :: t(pcols,pver) ! temperature (t bar) + real(r8), intent(in) :: q(pcols,pver,pcnst) ! specific humidity (sh bar) +! +! Output arguments +! + real(r8), intent(out) :: cmfdt(pcols,pver) ! dt/dt due to moist convection + real(r8), intent(out) :: cmfmc(pcols,pverp) ! moist convection cloud mass flux + real(r8), intent(out) :: cmfdqr(pcols,pver) ! dq/dt due to convective rainout + real(r8), intent(out) :: cmfsl(pcols,pver ) ! convective lw static energy flux + real(r8), intent(out) :: cmflq(pcols,pver ) ! convective total water flux + real(r8), intent(out) :: precc(pcols) ! convective precipitation rate +! JJH mod to explicitly export cloud water + real(r8), intent(out) :: qc(pcols,pver) ! dq/dt due to export of cloud water + real(r8), intent(out) :: cnt(pcols) ! top level of convective activity + real(r8), intent(out) :: cnb(pcols) ! bottom level of convective activity + real(r8), intent(out) :: dq(pcols,pver,pcnst) ! constituent tendencies + real(r8), intent(out) :: icwmr(pcols,pver) + real(r8), intent(out) :: rliq(pcols) +! +!---------------------------Local workspace----------------------------- +! + real(r8) pm(pcols,pver) ! pressure + real(r8) pd(pcols,pver) ! delta-p + real(r8) rpd(pcols,pver) ! 1./pdel + + real(r8) cmfdq(pcols,pver) ! dq/dt due to moist convection + real(r8) gam(pcols,pver) ! 1/cp (d(qsat)/dT) + real(r8) sb(pcols,pver) ! dry static energy (s bar) + real(r8) hb(pcols,pver) ! moist static energy (h bar) + real(r8) shbs(pcols,pver) ! sat. specific humidity (sh bar star) + real(r8) hbs(pcols,pver) ! sat. moist static energy (h bar star) + real(r8) shbh(pcols,pverp) ! specific humidity on interfaces + real(r8) sbh(pcols,pverp) ! s bar on interfaces + real(r8) hbh(pcols,pverp) ! h bar on interfaces + real(r8) cmrh(pcols,pverp) ! interface constituent mixing ratio + real(r8) prec(pcols) ! instantaneous total precipitation + real(r8) dzcld(pcols) ! depth of convective layer (m) + real(r8) beta(pcols) ! overshoot parameter (fraction) + real(r8) betamx(pcols) ! local maximum on overshoot + real(r8) eta(pcols) ! convective mass flux (kg/m^2 s) + real(r8) etagdt(pcols) ! eta*grav*dt + real(r8) cldwtr(pcols) ! cloud water (mass) + real(r8) rnwtr(pcols) ! rain water (mass) +! JJH extension to facilitate export of cloud liquid water + real(r8) totcond(pcols) ! total condensate; mix of precip and cloud water (mass) + real(r8) sc (pcols) ! dry static energy ("in-cloud") + real(r8) shc (pcols) ! specific humidity ("in-cloud") + real(r8) hc (pcols) ! moist static energy ("in-cloud") + real(r8) cmrc(pcols) ! constituent mix rat ("in-cloud") + real(r8) dq1(pcols) ! shb convective change (lower lvl) + real(r8) dq2(pcols) ! shb convective change (mid level) + real(r8) dq3(pcols) ! shb convective change (upper lvl) + real(r8) ds1(pcols) ! sb convective change (lower lvl) + real(r8) ds2(pcols) ! sb convective change (mid level) + real(r8) ds3(pcols) ! sb convective change (upper lvl) + real(r8) dcmr1(pcols) ! q convective change (lower lvl) + real(r8) dcmr2(pcols) ! q convective change (mid level) + real(r8) dcmr3(pcols) ! q convective change (upper lvl) + real(r8) estemp(pcols,pver) ! saturation vapor pressure (scratch) + real(r8) vtemp1(2*pcols) ! intermediate scratch vector + real(r8) vtemp2(2*pcols) ! intermediate scratch vector + real(r8) vtemp3(2*pcols) ! intermediate scratch vector + real(r8) vtemp4(2*pcols) ! intermediate scratch vector + real(r8) vtemp5(2*pcols) ! intermediate scratch vector + integer indx1(pcols) ! longitude indices for condition true + logical etagt0 ! true if eta > 0.0 + real(r8) sh1 ! dummy arg in qhalf statement func. + real(r8) sh2 ! dummy arg in qhalf statement func. + real(r8) shbs1 ! dummy arg in qhalf statement func. + real(r8) shbs2 ! dummy arg in qhalf statement func. + real(r8) cats ! modified characteristic adj. time + real(r8) rtdt ! 1./ztodt + real(r8) qprime ! modified specific humidity pert. + real(r8) tprime ! modified thermal perturbation + real(r8) pblhgt ! bounded pbl height (max[pblh,1m]) + real(r8) fac1 ! intermediate scratch variable + real(r8) shprme ! intermediate specific humidity pert. + real(r8) qsattp ! sat mix rat for thermally pert PBL parcels + real(r8) dz ! local layer depth + real(r8) temp1 ! intermediate scratch variable + real(r8) b1 ! bouyancy measure in detrainment lvl + real(r8) b2 ! bouyancy measure in condensation lvl + real(r8) temp2 ! intermediate scratch variable + real(r8) temp3 ! intermediate scratch variable + real(r8) g ! bounded vertical gradient of hb + real(r8) tmass ! total mass available for convective exch + real(r8) denom ! intermediate scratch variable + real(r8) qtest1 ! used in negative q test (middle lvl) + real(r8) qtest2 ! used in negative q test (lower lvl) + real(r8) fslkp ! flux lw static energy (bot interface) + real(r8) fslkm ! flux lw static energy (top interface) + real(r8) fqlkp ! flux total water (bottom interface) + real(r8) fqlkm ! flux total water (top interface) + real(r8) botflx ! bottom constituent mixing ratio flux + real(r8) topflx ! top constituent mixing ratio flux + real(r8) efac1 ! ratio q to convectively induced chg (btm lvl) + real(r8) efac2 ! ratio q to convectively induced chg (mid lvl) + real(r8) efac3 ! ratio q to convectively induced chg (top lvl) + real(r8) tb(pcols,pver) ! working storage for temp (t bar) + real(r8) shb(pcols,pver) ! working storage for spec hum (sh bar) + real(r8) adjfac ! adjustment factor (relaxation related) + real(r8) rktp + real(r8) rk +#if ( defined DIAGNS ) +! +! Following 7 real variables are used in diagnostics calculations +! + real(r8) rh ! relative humidity + real(r8) es ! sat vapor pressure + real(r8) hsum1 ! moist static energy integral + real(r8) qsum1 ! total water integral + real(r8) hsum2 ! final moist static energy integral + real(r8) qsum2 ! final total water integral + real(r8) fac ! intermediate scratch variable +#endif + integer i,k ! longitude, level indices + integer ii ! index on "gathered" vectors + integer len1 ! vector length of "gathered" vectors + integer m ! constituent index + integer ktp ! tmp indx used to track top of convective layer +#if ( defined DIAGNS ) + integer n ! vertical index (diagnostics) + integer kp ! vertical index (diagnostics) + integer kpp ! index offset, kp+1 (diagnostics) + integer kpm1 ! index offset, kp-1 (diagnostics) + integer lat(pcols) ! latitude indices + integer lon(pcols) ! longitude indices +#endif +! +!---------------------------Statement functions------------------------- +! + real(r8) qhalf + qhalf(sh1,sh2,shbs1,shbs2) = min(max(sh1,sh2),(shbs2*sh1 + shbs1*sh2)/(shbs1+shbs2)) +! +!----------------------------------------------------------------------- + +!** BAB initialize output tendencies here +! copy q to dq; use dq below for passive tracer transport + cmfdt(:ncol,:) = 0._r8 + cmfdq(:ncol,:) = 0._r8 + dq(:ncol,:,2:) = q(:ncol,:,2:) + cmfmc(:ncol,:) = 0._r8 + cmfdqr(:ncol,:) = 0._r8 + cmfsl(:ncol,:) = 0._r8 + cmflq(:ncol,:) = 0._r8 + qc(:ncol,:) = 0._r8 + rliq(:ncol) = 0._r8 +! +#if ( defined DIAGNS ) +! Determine chunk latitudes and longitudes + call get_lat_all_p(lchnk, ncol, lat) + call get_lon_all_p(lchnk, ncol, lon) +#endif +! +! Ensure that characteristic adjustment time scale (cmftau) assumed +! in estimate of eta isn't smaller than model time scale (ztodt) +! The time over which the convection is assumed to act (the adjustment +! time scale) can be applied with each application of the three-level +! cloud model, or applied to the column tendencies after a "hard" +! adjustment (i.e., on a 2-delta t time scale) is evaluated +! + if (rlxclm) then + cats = ztodt ! relaxation applied to column + adjfac = ztodt/(max(ztodt,cmftau)) + else + cats = max(ztodt,cmftau) ! relaxation applied to triplet + adjfac = 1.0_r8 + endif + rtdt = 1.0_r8/ztodt +! +! Move temperature and moisture into working storage +! + do k=limcnv,pver + do i=1,ncol + tb (i,k) = t(i,k) + shb(i,k) = q(i,k,1) + end do + end do + do k=1,pver + do i=1,ncol + icwmr(i,k) = 0._r8 + end do + end do +! +! Compute sb,hb,shbs,hbs +! + call qsat(tb(:ncol,limcnv:pver), pmid(:ncol,limcnv:pver), & + estemp(:ncol,limcnv:pver), shbs(:ncol,limcnv:pver), & + gam=gam(:ncol,limcnv:pver)) +! + do k=limcnv,pver + do i=1,ncol + sb (i,k) = cp*tb(i,k) + zm(i,k)*grav + phis(i) + hb (i,k) = sb(i,k) + hlat*shb(i,k) + hbs(i,k) = sb(i,k) + hlat*shbs(i,k) + end do + end do +! +! Compute sbh, shbh +! + do k=limcnv+1,pver + do i=1,ncol + sbh (i,k) = 0.5_r8*(sb(i,k-1) + sb(i,k)) + shbh(i,k) = qhalf(shb(i,k-1),shb(i,k),shbs(i,k-1),shbs(i,k)) + hbh (i,k) = sbh(i,k) + hlat*shbh(i,k) + end do + end do +! +! Specify properties at top of model (not used, but filling anyway) +! + do i=1,ncol + sbh (i,limcnv) = sb(i,limcnv) + shbh(i,limcnv) = shb(i,limcnv) + hbh (i,limcnv) = hb(i,limcnv) + end do +! +! Zero vertically independent control, tendency & diagnostic arrays +! + do i=1,ncol + prec(i) = 0.0_r8 + dzcld(i) = 0.0_r8 + cnb(i) = 0.0_r8 + cnt(i) = real(pver+1,r8) + end do +#if ( defined DIAGNS ) +!####################################################################### +!# # +!# output initial thermodynamic profile if debug diagnostics # +!# # + do i=1,ncol + if ((lat(i).eq.jloc) .and. (lon(i).eq.iloc) & + .and. (nstep.ge.nsloc)) then +!# # +!# approximate vertical integral of moist static energy # +!# and total preciptable water # +!# # + hsum1 = 0.0_r8 + qsum1 = 0.0_r8 + do k=limcnv,pver + hsum1 = hsum1 + pdel(i,k)*rgrav*hb(i,k) + qsum1 = qsum1 + pdel(i,k)*rgrav*shb(i,k) + end do +!# # + write(iulog,8010) + fac = grav*864._r8 + do k=limcnv,pver + rh = shb(i,k)/shbs(i,k) + write(iulog,8020) shbh(i,k),sbh(i,k),hbh(i,k),fac*cmfmc(i,k),cmfsl(i,k), cmflq(i,k) + write(iulog,8040) tb(i,k),shb(i,k),rh,sb(i,k),hb(i,k),hbs(i,k),ztodt*cmfdt(i,k), & + ztodt*cmfdq(i,k),ztodt*cmfdqr(i,k) + end do + write(iulog, 8000) prec(i) + end if + enddo +#endif +!# # +!# # +!####################################################################### +! +! Begin moist convective mass flux adjustment procedure. +! Formalism ensures that negative cloud liquid water can never occur +! + do 70 k=pver-1,limcnv+1,-1 + do 10 i=1,ncol + etagdt(i) = 0.0_r8 + eta (i) = 0.0_r8 + beta (i) = 0.0_r8 + ds1 (i) = 0.0_r8 + ds2 (i) = 0.0_r8 + ds3 (i) = 0.0_r8 + dq1 (i) = 0.0_r8 + dq2 (i) = 0.0_r8 + dq3 (i) = 0.0_r8 +! +! Specification of "cloud base" conditions +! + qprime = 0.0_r8 + tprime = 0.0_r8 +! +! Assign tprime within the PBL to be proportional to the quantity +! tpert (which will be bounded by tpmax), passed to this routine by +! the PBL routine. Don't allow perturbation to produce a dry +! adiabatically unstable parcel. Assign qprime within the PBL to be +! an appropriately modified value of the quantity qpert (which will be +! bounded by shpmax) passed to this routine by the PBL routine. The +! quantity qprime should be less than the local saturation value +! (qsattp=qsat[t+tprime,p]). In both cases, tpert and qpert are +! linearly reduced toward zero as the PBL top is approached. +! + pblhgt = max(pblh(i),1.0_r8) + if ( (zm(i,k+1) <= pblhgt) .and. dzcld(i) == 0.0_r8 ) then + fac1 = max(0.0_r8,1.0_r8-zm(i,k+1)/pblhgt) + tprime = min(tpert(i),tpmax)*fac1 + qsattp = shbs(i,k+1) + cp*rhlat*gam(i,k+1)*tprime + shprme = min(min(qpert(i,1),shpmax)*fac1,max(qsattp-shb(i,k+1),0.0_r8)) + qprime = max(qprime,shprme) + else + tprime = 0.0_r8 + qprime = 0.0_r8 + end if +! +! Specify "updraft" (in-cloud) thermodynamic properties +! + sc (i) = sb (i,k+1) + cp*tprime + shc(i) = shb(i,k+1) + qprime + hc (i) = sc (i ) + hlat*shc(i) + vtemp4(i) = hc(i) - hbs(i,k) + dz = pdel(i,k)*rgas*tb(i,k)*rgrav/pmid(i,k) + if (vtemp4(i) > 0.0_r8) then + dzcld(i) = dzcld(i) + dz + else + dzcld(i) = 0.0_r8 + end if +10 continue +#if ( defined DIAGNS ) +!####################################################################### +!# # +!# output thermodynamic perturbation information # +!# # + do i=1,ncol + if ((lat(i)==jloc).and.(lon(i)==iloc).and.(nstep>=nsloc)) then + write(iulog,8090) k+1,sc(iloc),shc(iloc),hc(iloc) + end if + enddo +!# # +!####################################################################### +#endif +! +! Check on moist convective instability +! Build index vector of points where instability exists +! + len1 = 0 + do i=1,ncol + if (vtemp4(i) > 0.0_r8) then + len1 = len1 + 1 + indx1(len1) = i + end if + end do + if (len1 <= 0) go to 70 +! +! Current level just below top level => no overshoot +! + if (k <= limcnv+1) then + do ii=1,len1 + i = indx1(ii) + temp1 = vtemp4(i)/(1.0_r8 + gam(i,k)) + cldwtr(i) = max(0.0_r8,(sb(i,k) - sc(i) + temp1)) + beta(i) = 0.0_r8 + vtemp3(i) = (1.0_r8 + gam(i,k))*(sc(i) - sbh(i,k)) + end do + else +! +! First guess at overshoot parameter using crude buoyancy closure +! 10% overshoot assumed as a minimum and 1-c0*dz maximum to start +! If pre-existing supersaturation in detrainment layer, beta=0 +! cldwtr is temporarily equal to hlat*l (l=> liquid water) +! + do ii=1,len1 + i = indx1(ii) + temp1 = vtemp4(i)/(1.0_r8 + gam(i,k)) + cldwtr(i) = max(0.0_r8,(sb(i,k)-sc(i)+temp1)) + betamx(i) = 1.0_r8 - c0*max(0.0_r8,(dzcld(i)-dzmin)) + b1 = (hc(i) - hbs(i,k-1))*pdel(i,k-1) + b2 = (hc(i) - hbs(i,k ))*pdel(i,k ) + beta(i) = max(betamn,min(betamx(i), 1.0_r8 + b1/b2)) + if (hbs(i,k-1) <= hb(i,k-1)) beta(i) = 0.0_r8 +! +! Bound maximum beta to ensure physically realistic solutions +! +! First check constrains beta so that eta remains positive +! (assuming that eta is already positive for beta equal zero) +! + vtemp1(i) = -(hbh(i,k+1) - hc(i))*pdel(i,k)*rpdel(i,k+1)+ & + (1.0_r8 + gam(i,k))*(sc(i) - sbh(i,k+1) + cldwtr(i)) + vtemp2(i) = (1.0_r8 + gam(i,k))*(sc(i) - sbh(i,k)) + vtemp3(i) = vtemp2(i) + if ((beta(i)*vtemp2(i) - vtemp1(i)) > 0._r8) then + betamx(i) = 0.99_r8*(vtemp1(i)/vtemp2(i)) + beta(i) = max(0.0_r8,min(betamx(i),beta(i))) + end if + end do +! +! Second check involves supersaturation of "detrainment layer" +! small amount of supersaturation acceptable (by ssfac factor) +! + do ii=1,len1 + i = indx1(ii) + if (hb(i,k-1) < hbs(i,k-1)) then + vtemp1(i) = vtemp1(i)*rpdel(i,k) + temp2 = gam(i,k-1)*(sbh(i,k) - sc(i) + cldwtr(i)) - & + hbh(i,k) + hc(i) - sc(i) + sbh(i,k) + temp3 = vtemp3(i)*rpdel(i,k) + vtemp2(i) = (ztodt/cats)*(hc(i) - hbs(i,k))*temp2/ & + (pdel(i,k-1)*(hbs(i,k-1) - hb(i,k-1))) + temp3 + if ((beta(i)*vtemp2(i) - vtemp1(i)) > 0._r8) then + betamx(i) = ssfac*(vtemp1(i)/vtemp2(i)) + beta(i) = max(0.0_r8,min(betamx(i),beta(i))) + end if + else + beta(i) = 0.0_r8 + end if + end do +! +! Third check to avoid introducing 2 delta x thermodynamic +! noise in the vertical ... constrain adjusted h (or theta e) +! so that the adjustment doesn't contribute to "kinks" in h +! + do ii=1,len1 + i = indx1(ii) + g = min(0.0_r8,hb(i,k) - hb(i,k-1)) + temp1 = (hb(i,k) - hb(i,k-1) - g)*(cats/ztodt)/(hc(i) - hbs(i,k)) + vtemp1(i) = temp1*vtemp1(i) + (hc(i) - hbh(i,k+1))*rpdel(i,k) + vtemp2(i) = temp1*vtemp3(i)*rpdel(i,k) + (hc(i) - hbh(i,k) - cldwtr(i))* & + (rpdel(i,k) + rpdel(i,k+1)) + if ((beta(i)*vtemp2(i) - vtemp1(i)) > 0._r8) then + if (vtemp2(i) /= 0.0_r8) then + betamx(i) = vtemp1(i)/vtemp2(i) + else + betamx(i) = 0.0_r8 + end if + beta(i) = max(0.0_r8,min(betamx(i),beta(i))) + end if + end do + end if +! +! Calculate mass flux required for stabilization. +! +! Ensure that the convective mass flux, eta, is positive by +! setting negative values of eta to zero.. +! Ensure that estimated mass flux cannot move more than the +! minimum of total mass contained in either layer k or layer k+1. +! Also test for other pathological cases that result in non- +! physical states and adjust eta accordingly. +! + do ii=1,len1 + i = indx1(ii) + beta(i) = max(0.0_r8,beta(i)) + temp1 = hc(i) - hbs(i,k) + temp2 = ((1.0_r8 + gam(i,k))*(sc(i) - sbh(i,k+1) + cldwtr(i)) - & + beta(i)*vtemp3(i))*rpdel(i,k) - (hbh(i,k+1) - hc(i))*rpdel(i,k+1) + eta(i) = temp1/(temp2*grav*cats) + tmass = min(pdel(i,k),pdel(i,k+1))*rgrav + if (eta(i) > tmass*rtdt .or. eta(i) <= 0.0_r8) eta(i) = 0.0_r8 +! +! Check on negative q in top layer (bound beta) +! + if (shc(i)-shbh(i,k) < 0.0_r8 .and. beta(i)*eta(i) /= 0.0_r8) then + denom = eta(i)*grav*ztodt*(shc(i) - shbh(i,k))*rpdel(i,k-1) + beta(i) = max(0.0_r8,min(-0.999_r8*shb(i,k-1)/denom,beta(i))) + end if +! +! Check on negative q in middle layer (zero eta) +! + qtest1 = shb(i,k) + eta(i)*grav*ztodt*((shc(i) - shbh(i,k+1)) - & + (1.0_r8 - beta(i))*cldwtr(i)*rhlat - beta(i)*(shc(i) - shbh(i,k)))* & + rpdel(i,k) + if (qtest1 <= 0.0_r8) eta(i) = 0.0_r8 +! +! Check on negative q in lower layer (bound eta) +! + fac1 = -(shbh(i,k+1) - shc(i))*rpdel(i,k+1) + qtest2 = shb(i,k+1) - eta(i)*grav*ztodt*fac1 + if (qtest2 < 0.0_r8) then + eta(i) = 0.99_r8*shb(i,k+1)/(grav*ztodt*fac1) + end if + etagdt(i) = eta(i)*grav*ztodt + end do +! +#if ( defined DIAGNS ) +!####################################################################### +!# # + do i=1,ncol + if ((lat(i)==jloc).and.(lon(i)==iloc).and.(nstep >= nsloc)) then + write(iulog,8080) beta(iloc), eta(iloc) + end if + enddo +!# # +!####################################################################### +#endif +! +! Calculate cloud water, rain water, and thermodynamic changes +! + do 30 ii=1,len1 + i = indx1(ii) + icwmr(i,k) = cldwtr(i)*rhlat + cldwtr(i) = etagdt(i)*cldwtr(i)*rhlat*rgrav +! JJH changes to facilitate export of cloud liquid water -------------------------------- + totcond(i) = (1.0_r8 - beta(i))*cldwtr(i) + rnwtr(i) = min(totcond(i),c0*(dzcld(i)-dzmin)*cldwtr(i)) + ds1(i) = etagdt(i)*(sbh(i,k+1) - sc(i))*rpdel(i,k+1) + dq1(i) = etagdt(i)*(shbh(i,k+1) - shc(i))*rpdel(i,k+1) + ds2(i) = (etagdt(i)*(sc(i) - sbh(i,k+1)) + & + hlat*grav*cldwtr(i) - beta(i)*etagdt(i)*(sc(i) - sbh(i,k)))*rpdel(i,k) +! JJH change for export of cloud liquid water; must use total condensate +! since rainwater no longer represents total condensate + dq2(i) = (etagdt(i)*(shc(i) - shbh(i,k+1)) - grav*totcond(i) - beta(i)* & + etagdt(i)*(shc(i) - shbh(i,k)))*rpdel(i,k) + ds3(i) = beta(i)*(etagdt(i)*(sc(i) - sbh(i,k)) - hlat*grav*cldwtr(i))* & + rpdel(i,k-1) + dq3(i) = beta(i)*etagdt(i)*(shc(i) - shbh(i,k))*rpdel(i,k-1) +! +! Isolate convective fluxes for later diagnostics +! + fslkp = eta(i)*(sc(i) - sbh(i,k+1)) + fslkm = beta(i)*(eta(i)*(sc(i) - sbh(i,k)) - hlat*cldwtr(i)*rtdt) + fqlkp = eta(i)*(shc(i) - shbh(i,k+1)) + fqlkm = beta(i)*eta(i)*(shc(i) - shbh(i,k)) +! +! Update thermodynamic profile (update sb, hb, & hbs later) +! + tb (i,k+1) = tb(i,k+1) + ds1(i)*rcp + tb (i,k ) = tb(i,k ) + ds2(i)*rcp + tb (i,k-1) = tb(i,k-1) + ds3(i)*rcp + shb(i,k+1) = shb(i,k+1) + dq1(i) + shb(i,k ) = shb(i,k ) + dq2(i) + shb(i,k-1) = shb(i,k-1) + dq3(i) +! +! ** Update diagnostic information for final budget ** +! Tracking precipitation, temperature & specific humidity tendencies, +! rainout term, convective mass flux, convective liquid +! water static energy flux, and convective total water flux +! The variable afac makes the necessary adjustment to the +! diagnostic fluxes to account for adjustment time scale based on +! how relaxation time scale is to be applied (column vs. triplet) +! + prec(i) = prec(i) + (rnwtr(i)/rhoh2o)*adjfac +! +! The following variables have units of "units"/second +! + cmfdt (i,k+1) = cmfdt (i,k+1) + ds1(i)*rtdt*adjfac + cmfdt (i,k ) = cmfdt (i,k ) + ds2(i)*rtdt*adjfac + cmfdt (i,k-1) = cmfdt (i,k-1) + ds3(i)*rtdt*adjfac + cmfdq (i,k+1) = cmfdq (i,k+1) + dq1(i)*rtdt*adjfac + cmfdq (i,k ) = cmfdq (i,k ) + dq2(i)*rtdt*adjfac + cmfdq (i,k-1) = cmfdq (i,k-1) + dq3(i)*rtdt*adjfac +! JJH changes to export cloud liquid water -------------------------------- + qc (i,k ) = (grav*(totcond(i)-rnwtr(i))*rpdel(i,k))*rtdt*adjfac + cmfdqr(i,k ) = cmfdqr(i,k ) + (grav*rnwtr(i)*rpdel(i,k))*rtdt*adjfac + cmfmc (i,k+1) = cmfmc (i,k+1) + eta(i)*adjfac + cmfmc (i,k ) = cmfmc (i,k ) + beta(i)*eta(i)*adjfac +! +! The following variables have units of w/m**2 +! + cmfsl (i,k+1) = cmfsl (i,k+1) + fslkp*adjfac + cmfsl (i,k ) = cmfsl (i,k ) + fslkm*adjfac + cmflq (i,k+1) = cmflq (i,k+1) + hlat*fqlkp*adjfac + cmflq (i,k ) = cmflq (i,k ) + hlat*fqlkm*adjfac +30 continue +! +! Next, convectively modify passive constituents +! For now, when applying relaxation time scale to thermal fields after +! entire column has undergone convective overturning, constituents will +! be mixed using a "relaxed" value of the mass flux determined above +! Although this will be inconsistant with the treatment of the thermal +! fields, it's computationally much cheaper, no more-or-less justifiable, +! and consistent with how the history tape mass fluxes would be used in +! an off-line mode (i.e., using an off-line transport model) +! + do 50 m=2,pcnst ! note: indexing assumes water is first field + if (cnst_get_type_byind(m).eq.'dry') then + pd(:ncol,:) = pdeldry(:ncol,:) + rpd(:ncol,:) = rpdeldry(:ncol,:) + pm(:ncol,:) = pmiddry(:ncol,:) + else + pd(:ncol,:) = pdel(:ncol,:) + rpd(:ncol,:) = rpdel(:ncol,:) + pm(:ncol,:) = pmid(:ncol,:) + endif + do 40 ii=1,len1 + i = indx1(ii) +! +! If any of the reported values of the constituent is negative in +! the three adjacent levels, nothing will be done to the profile +! + if ((dq(i,k+1,m) < 0.0_r8) .or. (dq(i,k,m) < 0.0_r8) .or. (dq(i,k-1,m) < 0.0_r8)) go to 40 +! +! Specify constituent interface values (linear interpolation) +! + cmrh(i,k ) = 0.5_r8*(dq(i,k-1,m) + dq(i,k ,m)) + cmrh(i,k+1) = 0.5_r8*(dq(i,k ,m) + dq(i,k+1,m)) +! +! Specify perturbation properties of constituents in PBL +! + pblhgt = max(pblh(i),1.0_r8) + if ( (zm(i,k+1) <= pblhgt) .and. dzcld(i) == 0.0_r8 ) then + fac1 = max(0.0_r8,1.0_r8-zm(i,k+1)/pblhgt) + cmrc(i) = dq(i,k+1,m) + qpert(i,m)*fac1 + else + cmrc(i) = dq(i,k+1,m) + end if +! +! Determine fluxes, flux divergence => changes due to convection +! Logic must be included to avoid producing negative values. A bit +! messy since there are no a priori assumptions about profiles. +! Tendency is modified (reduced) when pending disaster detected. +! + botflx = etagdt(i)*(cmrc(i) - cmrh(i,k+1))*adjfac + topflx = beta(i)*etagdt(i)*(cmrc(i)-cmrh(i,k))*adjfac + dcmr1(i) = -botflx*rpd(i,k+1) + efac1 = 1.0_r8 + efac2 = 1.0_r8 + efac3 = 1.0_r8 +! + if (dq(i,k+1,m)+dcmr1(i) < 0.0_r8) then + if ( abs(dcmr1(i)) > 1.e-300_r8 ) then + efac1 = max(tiny,abs(dq(i,k+1,m)/dcmr1(i)) - eps) + else + efac1 = tiny + endif + end if +! + if (efac1 == tiny .or. efac1 > 1.0_r8) efac1 = 0.0_r8 + dcmr1(i) = -efac1*botflx*rpd(i,k+1) + dcmr2(i) = (efac1*botflx - topflx)*rpd(i,k) +! + if (dq(i,k,m)+dcmr2(i) < 0.0_r8) then + if ( abs(dcmr2(i)) > 1.e-300_r8 ) then + efac2 = max(tiny,abs(dq(i,k ,m)/dcmr2(i)) - eps) + else + efac2 = tiny + endif + end if +! + if (efac2 == tiny .or. efac2 > 1.0_r8) efac2 = 0.0_r8 + dcmr2(i) = (efac1*botflx - efac2*topflx)*rpd(i,k) + dcmr3(i) = efac2*topflx*rpd(i,k-1) +! + if ( (dq(i,k-1,m)+dcmr3(i) < 0.0_r8 ) ) then + if ( abs(dcmr3(i)) > 1.e-300_r8 ) then + efac3 = max(tiny,abs(dq(i,k-1,m)/dcmr3(i)) - eps) + else + efac3 = tiny + endif + end if +! + if (efac3 == tiny .or. efac3 > 1.0_r8) efac3 = 0.0_r8 + efac3 = min(efac2,efac3) + dcmr2(i) = (efac1*botflx - efac3*topflx)*rpd(i,k) + dcmr3(i) = efac3*topflx*rpd(i,k-1) +! + dq(i,k+1,m) = dq(i,k+1,m) + dcmr1(i) + dq(i,k ,m) = dq(i,k ,m) + dcmr2(i) + dq(i,k-1,m) = dq(i,k-1,m) + dcmr3(i) +40 continue +50 continue ! end of m=2,pcnst loop +! +! Constituent modifications complete +! + if (k == limcnv+1) go to 60 +! +! Complete update of thermodynamic structure at integer levels +! gather/scatter points that need new values of shbs and gamma +! + do ii=1,len1 + i = indx1(ii) + vtemp1(ii ) = tb(i,k) + vtemp1(ii+len1) = tb(i,k-1) + vtemp2(ii ) = pmid(i,k) + vtemp2(ii+len1) = pmid(i,k-1) + end do + call qsat(vtemp1(:2*len1), vtemp2(:2*len1), & + vtemp5(:2*len1), vtemp3(:2*len1), gam=vtemp4(:2*len1)) + do ii=1,len1 + i = indx1(ii) + shbs(i,k ) = vtemp3(ii ) + shbs(i,k-1) = vtemp3(ii+len1) + gam(i,k ) = vtemp4(ii ) + gam(i,k-1) = vtemp4(ii+len1) + sb (i,k ) = sb(i,k ) + ds2(i) + sb (i,k-1) = sb(i,k-1) + ds3(i) + hb (i,k ) = sb(i,k ) + hlat*shb(i,k ) + hb (i,k-1) = sb(i,k-1) + hlat*shb(i,k-1) + hbs(i,k ) = sb(i,k ) + hlat*shbs(i,k ) + hbs(i,k-1) = sb(i,k-1) + hlat*shbs(i,k-1) + end do +! +! Update thermodynamic information at half (i.e., interface) levels +! + do ii=1,len1 + i = indx1(ii) + sbh (i,k) = 0.5_r8*(sb(i,k) + sb(i,k-1)) + shbh(i,k) = qhalf(shb(i,k-1),shb(i,k),shbs(i,k-1),shbs(i,k)) + hbh (i,k) = sbh(i,k) + hlat*shbh(i,k) + sbh (i,k-1) = 0.5_r8*(sb(i,k-1) + sb(i,k-2)) + shbh(i,k-1) = qhalf(shb(i,k-2),shb(i,k-1),shbs(i,k-2),shbs(i,k-1)) + hbh (i,k-1) = sbh(i,k-1) + hlat*shbh(i,k-1) + end do +! +#if ( defined DIAGNS ) +!####################################################################### +!# # +!# this update necessary, only if debugging diagnostics requested # +!# # + do i=1,ncol + if (lat(i) == jloc .and. nstep >= nsloc) then + call qsat(tb(i,k+1), pmid(i,k+1), & + es, shbs(i,k+1), gam=gam(i,k+1)) + sb (i,k+1) = sb(i,k+1) + ds1(i) + hb (i,k+1) = sb(i,k+1) + hlat*shb(i,k+1) + hbs(i,k+1) = sb(i,k+1) + hlat*shbs(i,k+1) + kpp = k + 2 + if (k+1 == pver) kpp = k + 1 + do kp=k+1,kpp + kpm1 = kp-1 + sbh(i,kp) = 0.5_r8*(sb(i,kpm1) + sb(i,kp)) + shbh(i,kp) = qhalf(shb(i,kpm1),shb(i,kp),shbs(i,kpm1),shbs(i,kp)) + hbh(i,kp) = sbh(i,kp) + hlat*shbh(i,kp) + end do + end if + end do +!# # +!# diagnostic output # +!# # + do i=1,ncol + if ((lat(i)== jloc).and.(lon(i)==iloc).and.(nstep>=nsloc)) then + write(iulog, 8060) k + fac = grav*864._r8 + do n=limcnv,pver + rh = shb(i,n)/shbs(i,n) + write(iulog,8020)shbh(i,n),sbh(i,n),hbh(i,n),fac*cmfmc(i,n), & + cmfsl(i,n), cmflq(i,n) +!--------------write(iulog, 8050) +!--------------write(iulog, 8030) fac*cmfmc(i,n),cmfsl(i,n), cmflq(i,n) + write(iulog, 8040) tb(i,n),shb(i,n),rh,sb(i,n),hb(i,n), & + hbs(i,n), ztodt*cmfdt(i,n),ztodt*cmfdq(i,n), & + ztodt*cmfdqr(i,n) + end do + write(iulog, 8000) prec(i) + end if + end do +!# # +!# # +!####################################################################### +#endif +! +! Ensure that dzcld is reset if convective mass flux zero +! specify the current vertical extent of the convective activity +! top of convective layer determined by size of overshoot param. +! +60 do i=1,ncol + etagt0 = eta(i).gt.0.0_r8 + if ( .not. etagt0) dzcld(i) = 0.0_r8 + if (etagt0 .and. beta(i) > betamn) then + ktp = k-1 + else + ktp = k + end if + if (etagt0) then + rk=k + rktp=ktp + cnt(i) = min(cnt(i),rktp) + cnb(i) = max(cnb(i),rk) + end if + end do +70 continue ! end of k loop +! +! ** apply final thermodynamic tendencies ** +! +!**BAB don't update input profiles +!!$ do k=limcnv,pver +!!$ do i=1,ncol +!!$ t (i,k) = t (i,k) + cmfdt(i,k)*ztodt +!!$ q(i,k,1) = q(i,k,1) + cmfdq(i,k)*ztodt +!!$ end do +!!$ end do +! Set output q tendencies + dq(:ncol,:,1 ) = cmfdq(:ncol,:) + dq(:ncol,:,2:) = (dq(:ncol,:,2:) - q(:ncol,:,2:))/ztodt +! +! Kludge to prevent cnb-cnt from being zero (in the event +! someone decides that they want to divide by this quantity) +! + do i=1,ncol + if (cnb(i) /= 0.0_r8 .and. cnb(i) == cnt(i)) then + cnt(i) = cnt(i) - 1.0_r8 + end if + end do +! + do i=1,ncol + precc(i) = prec(i)*rtdt + end do +! +! Compute reserved liquid (not yet in cldliq) for energy integrals. +! Treat rliq as flux out bottom, to be added back later. + do k = 1, pver + do i = 1, ncol + rliq(i) = rliq(i) + qc(i,k)*pdel(i,k)/grav + end do + end do + rliq(:ncol) = rliq(:ncol) /1000._r8 + +#if ( defined DIAGNS ) +!####################################################################### +!# # +!# we're done ... show final result if debug diagnostics requested # +!# # + do i=1,ncol + if ((lat(i)==jloc).and.(lon(i)==iloc).and.(nstep>=nsloc)) then + fac = grav*864._r8 + write(iulog, 8010) + do k=limcnv,pver + rh = shb(i,k)/shbs(i,k) + write(iulog, 8020) shbh(i,k),sbh(i,k),hbh(i,k),fac*cmfmc(i,k), & + cmfsl(i,k), cmflq(i,k) + write(iulog, 8040) tb(i,k),shb(i,k),rh ,sb(i,k),hb(i,k), & + hbs(i,k), ztodt*cmfdt(i,k),ztodt*cmfdq(i,k), & + ztodt*cmfdqr(i,k) + end do + write(iulog, 8000) prec(i) +!# # +!# approximate vertical integral of moist static energy and # +!# total preciptable water after adjustment and output changes # +!# # + hsum2 = 0.0_r8 + qsum2 = 0.0_r8 + do k=limcnv,pver + hsum2 = hsum2 + pdel(i,k)*rgrav*hb(i,k) + qsum2 = qsum2 + pdel(i,k)*rgrav*shb(i,k) + end do +!# # + write(iulog,8070) hsum1, hsum2, abs(hsum2-hsum1)/hsum2, & + qsum1, qsum2, abs(qsum2-qsum1)/qsum2 + end if + enddo +!# # +!# # +!####################################################################### +#endif + return ! we're all done ... return to calling procedure +#if ( defined DIAGNS ) +! +! Formats +! +8000 format(///,10x,'PREC = ',3pf12.6,/) +8010 format('1** TB SHB RH SB', & + ' HB HBS CAH CAM PRECC ', & + ' ETA FSL FLQ **', /) +8020 format(' ----- ', 9x,3p,f7.3,2x,2p, 9x,-3p,f7.3,2x, & + f7.3, 37x, 0p,2x,f8.2, 0p,2x,f8.2,2x,f8.2, ' ----- ') +8030 format(' ----- ', 0p,82x,f8.2, 0p,2x,f8.2,2x,f8.2, & + ' ----- ') +8040 format(' - - - ',f7.3,2x,3p,f7.3,2x,2p,f7.3,2x,-3p,f7.3,2x, & + f7.3, 2x,f8.3,2x,0p,f7.3,3p,2x,f7.3,2x,f7.3,30x, & + ' - - - ') +8050 format(' ----- ',110x,' ----- ') +8060 format('1 K =>', i4,/, & + ' TB SHB RH SB', & + ' HB HBS CAH CAM PREC ', & + ' ETA FSL FLQ', /) +8070 format(' VERTICALLY INTEGRATED MOIST STATIC ENERGY BEFORE, AFTER', & + ' AND PERCENTAGE DIFFERENCE => ',1p,2e15.7,2x,2p,f7.3,/, & + ' VERTICALLY INTEGRATED MOISTURE BEFORE, AFTER' &, + ' AND PERCENTAGE DIFFERENCE => ',1p,2e15_r8.7_r8,2x,2p,f7.3,/) +8080 format(' BETA, ETA => ', 1p,2e12.3) +8090 format (' k+1, sc, shc, hc => ', 1x, i2, 1p, 3e12.4) +#endif +! +end subroutine cmfmca +end module hk_conv diff --git a/src/physics/cam/iondrag.F90 b/src/physics/cam/iondrag.F90 new file mode 100644 index 0000000000..69c88916e3 --- /dev/null +++ b/src/physics/cam/iondrag.F90 @@ -0,0 +1,97 @@ +module iondrag + !------------------------------------------------------------------------------- + ! Dummy interface for waccm/iondrag module + !------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid ,only: pver + use physics_types,only: physics_state, physics_ptend + use physics_buffer ,only: physics_buffer_desc + + implicit none + + save + + private ! Make default type private to the module + + !------------------------------------------------------------------------------- + ! Public interfaces: + !------------------------------------------------------------------------------- + public :: iondrag_register ! Register variables in pbuf physics buffer + public :: iondrag_init ! Initialization + public :: iondrag_calc ! ion drag tensors lxx,lyy,lxy,lyx + public :: iondrag_readnl + public :: iondrag_timestep_init + public :: do_waccm_ions + + interface iondrag_calc + module procedure iondrag_calc_ions + module procedure iondrag_calc_ghg + end interface + + logical, parameter :: do_waccm_ions = .false. + +contains + + !================================================================================================ + + subroutine iondrag_readnl(nlfile) + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + end subroutine iondrag_readnl + + !============================================================================== + + subroutine iondrag_register + + end subroutine iondrag_register + + !================================================================================================ + + subroutine iondrag_init( pref_mid ) + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + real(r8), intent(in) :: pref_mid(pver) + + end subroutine iondrag_init + + !================================================================================================ + + subroutine iondrag_timestep_init + end subroutine iondrag_timestep_init + + !================================================================================================ + subroutine iondrag_calc_ions( lchnk, ncol, state, ptend, pbuf, delt ) + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + integer,intent(in) :: lchnk ! current chunk index + integer,intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: delt ! time step (s) + type(physics_state), intent(in), target :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! Physics tendencies + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + end subroutine iondrag_calc_ions + + !========================================================================= + + subroutine iondrag_calc_ghg (lchnk,ncol,state,ptend) + + !--------------------Input arguments------------------------------------ + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out):: ptend + + end subroutine iondrag_calc_ghg + + !=================================================================================== + +end module iondrag diff --git a/src/physics/cam/iop_forcing.F90 b/src/physics/cam/iop_forcing.F90 new file mode 100644 index 0000000000..55259685b5 --- /dev/null +++ b/src/physics/cam/iop_forcing.F90 @@ -0,0 +1,97 @@ + + module iop_forcing + + ! ----------------------------------------------- ! + ! User-defined manipulation of forcings for SCAM. ! + ! ! + ! Author : Sungsu Park and John Truesdale ! + ! ! + ! ----------------------------------------------- ! + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + private + + public scam_use_iop_srf + public scam_set_iop_Tg + + contains + + subroutine scam_use_iop_srf( cam_in ) + ! ------------------------------------------------------- ! + ! Use the SCAM-IOP specified surface LHFLX/SHFLX/ustar/Tg ! + ! instead of using internally-computed values. ! + ! ! + ! Author : John Truesdale and Sungsu Park ! + ! ------------------------------------------------------- ! + use ppgrid, only: begchunk, endchunk + use camsrfexch, only: cam_in_t + use physconst, only: stebol, latvap + use scamMod + use cam_abortutils, only: endrun + + implicit none + save + + type(cam_in_t), intent(INOUT) :: cam_in(begchunk:endchunk) + integer :: c ! Chunk index + integer :: ncol ! Number of columns + + if( scm_iop_lhflxshflxTg .and. scm_iop_Tg ) then + call endrun( 'scam_use_iop_srf : scm_iop_lhflxshflxTg and scm_iop_Tg must not be specified at the same time.') + end if + + if( scm_iop_lhflxshflxTg ) then + do c = begchunk, endchunk + ncol = cam_in(c)%ncol + if( have_lhflx ) then + cam_in(c)%lhf(1) = lhflxobs(1) + cam_in(c)%cflx(1,1) = lhflxobs(1) / latvap + endif + if( have_shflx ) cam_in(c)%shf(1) = shflxobs(1) + if( have_Tg ) then + cam_in(c)%ts(1) = tground(1) + cam_in(c)%lwup(1) = stebol * tground(1)**4 + endif + end do + endif + + if( scm_iop_Tg .or. scm_crm_mode) then + do c = begchunk, endchunk + ncol = cam_in(c)%ncol + if( have_Tg ) then + cam_in(c)%ts(1) = tground(1) + cam_in(c)%lwup(1) = stebol * tground(1)**4 + endif + end do + endif + + end subroutine scam_use_iop_srf + + subroutine scam_set_iop_Tg( cam_out ) + ! ----------------------------- ! + ! USE the SCAM-IOP specified Tg ! + ! ----------------------------- ! + use ppgrid, only: begchunk, endchunk + use camsrfexch, only: cam_out_t + use scamMod + use cam_abortutils, only: endrun + + implicit none + save + + type(cam_out_t), intent(INOUT) :: cam_out(begchunk:endchunk) + integer :: c ! Chunk index + + if( scm_iop_lhflxshflxTg .and. scm_iop_Tg ) then + call endrun( 'scam_use_iop_srf : scm_iop_lhflxshflxTg and scm_iop_Tg must not be specified at the same time.') + end if + if( scm_iop_Tg .or. scm_crm_mode ) then + do c = begchunk, endchunk + cam_out(c)%tbot(1) = tground(1) + end do + endif + + end subroutine scam_set_iop_Tg + + end module iop_forcing diff --git a/src/physics/cam/macrop_driver.F90 b/src/physics/cam/macrop_driver.F90 new file mode 100644 index 0000000000..c707d0a961 --- /dev/null +++ b/src/physics/cam/macrop_driver.F90 @@ -0,0 +1,1182 @@ + module macrop_driver + + !------------------------------------------------------------------------------------------------------- + ! Purpose: + ! + ! Provides the CAM interface to the prognostic cloud macrophysics + ! + ! Author: Andrew Gettelman, Cheryl Craig October 2010 + ! Origin: modified from stratiform.F90 elements + ! (Boville 2002, Coleman 2004, Park 2009, Kay 2010) + !------------------------------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use physconst, only: latice, latvap + use phys_control, only: phys_getopts + use constituents, only: cnst_get_ind, pcnst + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx + use time_manager, only: is_first_step + use cldwat2m_macro, only: ini_macro + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use zm_conv_intr, only: zmconv_microp + + implicit none + private + save + + public :: macrop_driver_readnl + public :: macrop_driver_register + public :: macrop_driver_init + public :: macrop_driver_tend + public :: liquid_macro_tend + + logical, public :: do_cldice ! .true., park macrophysics is prognosing cldice + logical, public :: do_cldliq ! .true., park macrophysics is prognosing cldliq + logical, public :: do_detrain ! .true., park macrophysics is detraining ice into stratiform + + ! ------------------------- ! + ! Private Module Parameters ! + ! ------------------------- ! + + ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus + ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus, + ! evaporate cumulus liquid condensate. This option only influences the treatment of cumulus + ! liquid condensate, not cumulus ice condensate. + + logical, parameter :: cu_det_st = .false. + + ! Parameters used for selecting generalized critical RH for liquid and ice stratus + integer :: rhminl_opt = 0 + integer :: rhmini_opt = 0 + + + character(len=16) :: shallow_scheme + logical :: use_shfrc ! Local copy of flag from convect_shallow_use_shfrc + + integer :: & + ixcldliq, &! cloud liquid amount index + ixcldice, &! cloud ice amount index + ixnumliq, &! cloud liquid number index + ixnumice, &! cloud ice water index + qcwat_idx, &! qcwat index in physics buffer + lcwat_idx, &! lcwat index in physics buffer + iccwat_idx, &! iccwat index in physics buffer + nlwat_idx, &! nlwat index in physics buffer + niwat_idx, &! niwat index in physics buffer + tcwat_idx, &! tcwat index in physics buffer + CC_T_idx, &! + CC_qv_idx, &! + CC_ql_idx, &! + CC_qi_idx, &! + CC_nl_idx, &! + CC_ni_idx, &! + CC_qlst_idx, &! + cld_idx, &! cld index in physics buffer + ast_idx, &! stratiform cloud fraction index in physics buffer + aist_idx, &! ice stratiform cloud fraction index in physics buffer + alst_idx, &! liquid stratiform cloud fraction index in physics buffer + qist_idx, &! ice stratiform in-cloud IWC + qlst_idx, &! liquid stratiform in-cloud LWC + concld_idx, &! concld index in physics buffer + fice_idx, & + cmeliq_idx, & + shfrc_idx + + integer :: & + dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. + difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio. + dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. + dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. + + + integer :: & + tke_idx = -1, &! tke defined at the model interfaces + qtl_flx_idx = -1, &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme + qti_flx_idx = -1, &! overbar(w'qti' where qti = qv + qi) from the PBL scheme + cmfr_det_idx = -1, &! detrained convective mass flux from UNICON + qlr_det_idx = -1, &! detrained convective ql from UNICON + qir_det_idx = -1, &! detrained convective qi from UNICON + cmfmc_sh_idx = -1 + + contains + + ! =============================================================================== + subroutine macrop_driver_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Namelist variables + logical :: macro_park_do_cldice = .true. ! do_cldice = .true., park macrophysics is prognosing cldice + logical :: macro_park_do_cldliq = .true. ! do_cldliq = .true., park macrophysics is prognosing cldliq + logical :: macro_park_do_detrain = .true. ! do_detrain = .true., park macrophysics is detraining ice into stratiform + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'macrop_driver_readnl' + + namelist /macro_park_nl/ macro_park_do_cldice, macro_park_do_cldliq, macro_park_do_detrain + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'macro_park_nl', status=ierr) + if (ierr == 0) then + read(unitn, macro_park_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + + do_cldice = macro_park_do_cldice + do_cldliq = macro_park_do_cldliq + do_detrain = macro_park_do_detrain + + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(do_cldice, 1, mpilog, 0, mpicom) + call mpibcast(do_cldliq, 1, mpilog, 0, mpicom) + call mpibcast(do_detrain, 1, mpilog, 0, mpicom) +#endif + +end subroutine macrop_driver_readnl + + !================================================================================================ + + subroutine macrop_driver_register + + !---------------------------------------------------------------------- ! + ! ! + ! Register the constituents (cloud liquid and cloud ice) and the fields ! + ! in the physics buffer. ! + ! ! + !---------------------------------------------------------------------- ! + + + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls + + !----------------------------------------------------------------------- + + call phys_getopts(shallow_scheme_out=shallow_scheme) + + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) + call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) + call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) + call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) + call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) + call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) + call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) + + call pbuf_add_field('QCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qcwat_idx) + call pbuf_add_field('LCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), lcwat_idx) + call pbuf_add_field('ICCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), iccwat_idx) + call pbuf_add_field('NLWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), nlwat_idx) + call pbuf_add_field('NIWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), niwat_idx) + call pbuf_add_field('TCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), tcwat_idx) + + call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) + + call pbuf_add_field('CMELIQ', 'physpkg', dtype_r8, (/pcols,pver/), cmeliq_idx) + + end subroutine macrop_driver_register + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine macrop_driver_init(pbuf2d) + + !-------------------------------------------- ! + ! ! + ! Initialize the cloud water parameterization ! + ! ! + !-------------------------------------------- ! + use physics_buffer, only : pbuf_get_index + use cam_history, only: addfld, add_default + use convect_shallow, only: convect_shallow_use_shfrc + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + logical :: history_aerosol ! Output the MAM aerosol tendencies + logical :: history_budget ! Output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + integer :: istat + + character(len=*), parameter :: subname = 'macrop_driver_init' + !----------------------------------------------------------------------- + + ! Initialization routine for cloud macrophysics + if (shallow_scheme .eq. 'UNICON') rhminl_opt = 1 + call ini_macro(rhminl_opt, rhmini_opt) + + call phys_getopts(history_aerosol_out = history_aerosol , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num ) + + ! Find out whether shfrc from convect_shallow will be used in cldfrc + + if( convect_shallow_use_shfrc() ) then + use_shfrc = .true. + shfrc_idx = pbuf_get_index('shfrc') + else + use_shfrc = .false. + endif + + call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection' ) + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection' ) + call addfld ('SHDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from shallow convection' ) + call addfld ('SHDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from shallow convection' ) + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment' ) + call addfld ('SHDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to shallow convective detrainment' ) + + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection' ) + + call addfld ('MACPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Revised macrophysics' ) + call addfld ('MACPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Revised macrophysics' ) + call addfld ('MACPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Revised macrophysics' ) + call addfld ('MACPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Revised macrophysics' ) + + call addfld ('CLDVAPADJ', (/ 'lev' /), 'A', 'kg/kg/s', & + 'Q tendency associated with liq/ice adjustment - Revised macrophysics' ) + call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ adjustment tendency - Revised macrophysics' ) + call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE adjustment tendency - Revised macrophysics' ) + call addfld ('CLDLIQDET', (/ 'lev' /), 'A', 'kg/kg/s', & + 'Detrainment of conv cld liq into envrionment - Revised macrophysics' ) + call addfld ('CLDICEDET', (/ 'lev' /), 'A', 'kg/kg/s', & + 'Detrainment of conv cld ice into envrionment - Revised macrophysics' ) + call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ limiting tendency - Revised macrophysics' ) + call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE limiting tendency - Revised macrophysics' ) + + call addfld ('AST', (/ 'lev' /), 'A', '1', 'Stratus cloud fraction' ) + call addfld ('LIQCLDF', (/ 'lev' /), 'A', '1', 'Stratus Liquid cloud fraction' ) + call addfld ('ICECLDF', (/ 'lev' /), 'A', '1', 'Stratus ICE cloud fraction' ) + + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) + + call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus' ) + call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus' ) + + call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ' ) + call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE' ) + call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ' ) + call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE' ) + + call addfld ('CLDSICE', (/ 'lev' /), 'A', 'kg/kg', 'CloudSat equivalent ice mass mixing ratio' ) + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud' ) + + call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment' ) + call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment' ) + call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment' ) + call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment' ) + if ( history_budget ) then + + call add_default ('DPDLFLIQ ', history_budget_histfile_num, ' ') + call add_default ('DPDLFICE ', history_budget_histfile_num, ' ') + call add_default ('SHDLFLIQ ', history_budget_histfile_num, ' ') + call add_default ('SHDLFICE ', history_budget_histfile_num, ' ') + call add_default ('DPDLFT ', history_budget_histfile_num, ' ') + call add_default ('SHDLFT ', history_budget_histfile_num, ' ') + call add_default ('ZMDLF ', history_budget_histfile_num, ' ') + + call add_default ('MACPDT ', history_budget_histfile_num, ' ') + call add_default ('MACPDQ ', history_budget_histfile_num, ' ') + call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ') + call add_default ('MACPDICE ', history_budget_histfile_num, ' ') + + call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ') + call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ') + call add_default ('CLDLIQDET', history_budget_histfile_num, ' ') + call add_default ('CLDLIQADJ', history_budget_histfile_num, ' ') + call add_default ('CLDICELIM', history_budget_histfile_num, ' ') + call add_default ('CLDICEDET', history_budget_histfile_num, ' ') + call add_default ('CLDICEADJ', history_budget_histfile_num, ' ') + + call add_default ('CMELIQ ', history_budget_histfile_num, ' ') + + end if + + ! Get constituent indices + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMLIQ', ixnumliq) + call cnst_get_ind('NUMICE', ixnumice) + + ! Get physics buffer indices + CC_T_idx = pbuf_get_index('CC_T') + CC_qv_idx = pbuf_get_index('CC_qv') + CC_ql_idx = pbuf_get_index('CC_ql') + CC_qi_idx = pbuf_get_index('CC_qi') + CC_nl_idx = pbuf_get_index('CC_nl') + CC_ni_idx = pbuf_get_index('CC_ni') + CC_qlst_idx = pbuf_get_index('CC_qlst') + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + + if (zmconv_microp) then + dlfzm_idx = pbuf_get_index('DLFZM') + difzm_idx = pbuf_get_index('DIFZM') + dnlfzm_idx = pbuf_get_index('DNLFZM') + dnifzm_idx = pbuf_get_index('DNIFZM') + end if + + + if (rhminl_opt > 0 .or. rhmini_opt > 0) then + cmfr_det_idx = pbuf_get_index('cmfr_det', istat) + if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf') + if (rhminl_opt > 0) then + qlr_det_idx = pbuf_get_index('qlr_det', istat) + if (istat < 0) call endrun(subname//': macrop option requires qlr_det in pbuf') + end if + if (rhmini_opt > 0) then + qir_det_idx = pbuf_get_index('qir_det', istat) + if (istat < 0) call endrun(subname//': macrop option requires qir_det in pbuf') + end if + end if + + if (rhminl_opt == 2 .or. rhmini_opt == 2) then + tke_idx = pbuf_get_index('tke') + if (rhminl_opt == 2) then + qtl_flx_idx = pbuf_get_index('qtl_flx', istat) + if (istat < 0) call endrun(subname//': macrop option requires qtl_flx in pbuf') + end if + if (rhmini_opt == 2) then + qti_flx_idx = pbuf_get_index('qti_flx', istat) + if (istat < 0) call endrun(subname//': macrop option requires qti_flx in pbuf') + end if + end if + + ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT, + ! ICCWAT, and TCWAT are initialized in phys_inidat. + if (is_first_step()) then + call pbuf_set_field(pbuf2d, ast_idx, 0._r8) + call pbuf_set_field(pbuf2d, aist_idx, 0._r8) + call pbuf_set_field(pbuf2d, alst_idx, 0._r8) + call pbuf_set_field(pbuf2d, qist_idx, 0._r8) + call pbuf_set_field(pbuf2d, qlst_idx, 0._r8) + call pbuf_set_field(pbuf2d, nlwat_idx, 0._r8) + call pbuf_set_field(pbuf2d, niwat_idx, 0._r8) + end if + + ! the following are physpkg, so they need to be init every time + call pbuf_set_field(pbuf2d, fice_idx, 0._r8) + call pbuf_set_field(pbuf2d, cmeliq_idx, 0._r8) + + end subroutine macrop_driver_init + + !============================================================================ ! + ! ! + !============================================================================ ! + + + subroutine macrop_driver_tend( & + state, ptend, dtime, landfrac, & + ocnfrac, snowh, & + dlf, dlf2, cmfmc, ts, & + sst, zdu, & + pbuf, & + det_s, det_ice) + + !-------------------------------------------------------- ! + ! ! + ! Purpose: ! + ! ! + ! Interface to detrain, cloud fraction and ! + ! cloud macrophysics subroutines ! + ! ! + ! Author: A. Gettelman, C. Craig, Oct 2010 ! + ! based on stratiform_tend by D.B. Coleman 4/2010 ! + ! ! + !-------------------------------------------------------- ! + + use cloud_fraction, only: cldfrc, cldfrc_fice + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init, physics_update + use physics_types, only: physics_ptend_sum, physics_state_copy + use physics_types, only: physics_state_dealloc + use cam_history, only: outfld + use constituents, only: cnst_get_ind, pcnst + use cldwat2m_macro, only: mmacro_pcond + use physconst, only: cpair, tmelt, gravit + use time_manager, only: get_nstep + + use ref_pres, only: top_lev => trop_cloud_top_lev + + ! + ! Input arguments + ! + + type(physics_state), intent(in) :: state ! State variables + type(physics_ptend), intent(out) :: ptend ! macrophysics parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + + real(r8), intent(in) :: dtime ! Timestep + real(r8), intent(in) :: landfrac(pcols) ! Land fraction (fraction) + real(r8), intent(in) :: ocnfrac (pcols) ! Ocean fraction (fraction) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) + real(r8), intent(in) :: dlf(pcols,pver) ! Detrained water from convection schemes + real(r8), intent(in) :: dlf2(pcols,pver) ! Detrained water from shallow convection scheme + real(r8), intent(in) :: cmfmc(pcols,pverp) ! Deep + Shallow Convective mass flux [ kg /s/m^2 ] + + real(r8), intent(in) :: ts(pcols) ! Surface temperature + real(r8), intent(in) :: sst(pcols) ! Sea surface temperature + real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection + + + ! These two variables are needed for energy check + real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice + real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check + + ! + ! Local variables + ! + + type(physics_state) :: state_loc ! Local copy of the state variable + type(physics_ptend) :: ptend_loc ! Local parameterization tendencies + + integer i,k + integer :: lchnk ! Chunk identifier + integer :: ncol ! Number of atmospheric columns + + ! Physics buffer fields + + integer itim_old + real(r8), pointer, dimension(:,:) :: qcwat ! Cloud water old q + real(r8), pointer, dimension(:,:) :: tcwat ! Cloud water old temperature + real(r8), pointer, dimension(:,:) :: lcwat ! Cloud liquid water old q + real(r8), pointer, dimension(:,:) :: iccwat ! Cloud ice water old q + real(r8), pointer, dimension(:,:) :: nlwat ! Cloud liquid droplet number condentration. old. + real(r8), pointer, dimension(:,:) :: niwat ! Cloud ice droplet number condentration. old. + real(r8), pointer, dimension(:,:) :: CC_T ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_qv ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_ql ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_qi ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_nl ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_ni ! Grid-mean microphysical tendency + real(r8), pointer, dimension(:,:) :: CC_qlst ! In-liquid stratus microphysical tendency + real(r8), pointer, dimension(:,:) :: cld ! Total cloud fraction + real(r8), pointer, dimension(:,:) :: ast ! Relative humidity cloud fraction + real(r8), pointer, dimension(:,:) :: aist ! Physical ice stratus fraction + real(r8), pointer, dimension(:,:) :: alst ! Physical liquid stratus fraction + real(r8), pointer, dimension(:,:) :: qist ! Physical in-cloud IWC + real(r8), pointer, dimension(:,:) :: qlst ! Physical in-cloud LWC + real(r8), pointer, dimension(:,:) :: concld ! Convective cloud fraction + + real(r8), pointer, dimension(:,:) :: shfrc ! Cloud fraction from shallow convection scheme + real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux (pcols,pverp) [ kg/s/m^2 ] + + real(r8), pointer, dimension(:,:) :: cmeliq + + real(r8), pointer, dimension(:,:) :: tke + real(r8), pointer, dimension(:,:) :: qtl_flx + real(r8), pointer, dimension(:,:) :: qti_flx + real(r8), pointer, dimension(:,:) :: cmfr_det + real(r8), pointer, dimension(:,:) :: qlr_det + real(r8), pointer, dimension(:,:) :: qir_det + + ! Convective cloud to the physics buffer for purposes of ql contrib. to radn. + + real(r8), pointer, dimension(:,:) :: fice_ql ! Cloud ice/water partitioning ratio. + + ! ZM microphysics + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio. + real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. + real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. + + real(r8) :: latsub + + ! tendencies for ice saturation adjustment + real(r8) :: stend(pcols,pver) + real(r8) :: qvtend(pcols,pver) + real(r8) :: qitend(pcols,pver) + real(r8) :: initend(pcols,pver) + + ! Local variables for cldfrc + + real(r8) cldst(pcols,pver) ! Stratus cloud fraction + real(r8) rhcloud(pcols,pver) ! Relative humidity cloud (last timestep) + real(r8) clc(pcols) ! Column convective cloud amount + real(r8) rhu00(pcols,pver) ! RH threshold for cloud + real(r8) icecldf(pcols,pver) ! Ice cloud fraction + real(r8) liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud) + real(r8) relhum(pcols,pver) ! RH, output to determine drh/da + + ! Local variables for macrophysics + + real(r8) rdtime ! 1./dtime + real(r8) qtend(pcols,pver) ! Moisture tendencies + real(r8) ttend(pcols,pver) ! Temperature tendencies + real(r8) ltend(pcols,pver) ! Cloud liquid water tendencies + real(r8) fice(pcols,pver) ! Fractional ice content within cloud + real(r8) fsnow(pcols,pver) ! Fractional snow production + real(r8) homoo(pcols,pver) + real(r8) qcreso(pcols,pver) + real(r8) prcio(pcols,pver) + real(r8) praio(pcols,pver) + real(r8) qireso(pcols,pver) + real(r8) ftem(pcols,pver) + real(r8) pracso (pcols,pver) + real(r8) dpdlfliq(pcols,pver) + real(r8) dpdlfice(pcols,pver) + real(r8) shdlfliq(pcols,pver) + real(r8) shdlfice(pcols,pver) + real(r8) dpdlft (pcols,pver) + real(r8) shdlft (pcols,pver) + + real(r8) dum1 + real(r8) qc(pcols,pver) + real(r8) qi(pcols,pver) + real(r8) nc(pcols,pver) + real(r8) ni(pcols,pver) + + logical lq(pcnst) + + ! Output from mmacro_pcond + + real(r8) tlat(pcols,pver) + real(r8) qvlat(pcols,pver) + real(r8) qcten(pcols,pver) + real(r8) qiten(pcols,pver) + real(r8) ncten(pcols,pver) + real(r8) niten(pcols,pver) + + ! Output from mmacro_pcond + + real(r8) qvadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (vapor) + real(r8) qladj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (liquid) + real(r8) qiadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (ice) + real(r8) qllim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (liquid) + real(r8) qilim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (ice) + + ! For revised macophysics, mmacro_pcond + + real(r8) itend(pcols,pver) + real(r8) lmitend(pcols,pver) + real(r8) zeros(pcols,pver) + real(r8) t_inout(pcols,pver) + real(r8) qv_inout(pcols,pver) + real(r8) ql_inout(pcols,pver) + real(r8) qi_inout(pcols,pver) + real(r8) concld_old(pcols,pver) + + ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the + ! liquid condensation process which is using 'alst' not 'ast'. + ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'. + ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used. + ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old' + real(r8) clrw_old(pcols,pver) ! (1 - concld_old - alst_old) + real(r8) clri_old(pcols,pver) ! (1 - concld_old - ast_old) + + real(r8) nl_inout(pcols,pver) + real(r8) ni_inout(pcols,pver) + + real(r8) nltend(pcols,pver) + real(r8) nitend(pcols,pver) + + + ! For detraining cumulus condensate into the 'stratus' without evaporation + ! This is for use in mmacro_pcond + + real(r8) dlf_T(pcols,pver) + real(r8) dlf_qv(pcols,pver) + real(r8) dlf_ql(pcols,pver) + real(r8) dlf_qi(pcols,pver) + real(r8) dlf_nl(pcols,pver) + real(r8) dlf_ni(pcols,pver) + + ! Local variables for CFMIP calculations + real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) + real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) + real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) + + ! CloudSat equivalent ice mass mixing ratio (kg/kg) + real(r8) :: cldsice(pcols,pver) + + ! ====================================================================== + + lchnk = state%lchnk + ncol = state%ncol + + call physics_state_copy(state, state_loc) ! Copy state to local state_loc. + + ! Associate pointers with physics buffer fields + + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, qcwat_idx, qcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, tcwat_idx, tcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, lcwat_idx, lcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, iccwat_idx, iccwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, nlwat_idx, nlwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, niwat_idx, niwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, cc_t_idx, cc_t, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_qv_idx, cc_qv, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_ql_idx, cc_ql, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_qi_idx, cc_qi, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_nl_idx, cc_nl, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_ni_idx, cc_ni, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cc_qlst_idx, cc_qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) + +! For purposes of convective ql. + + call pbuf_get_field(pbuf, fice_idx, fice_ql ) + + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + + ! check that qcwat and tcwat were initialized; if not then do it now. + if (qcwat(1,1) == huge(1._r8)) then + qcwat(:ncol,:) = state%q(:ncol,:,1) + end if + if (tcwat(1,1) == huge(1._r8)) then + tcwat(:ncol,:) = state%t(:ncol,:) + end if + + ! Initialize convective detrainment tendency + + dlf_T(:,:) = 0._r8 + dlf_qv(:,:) = 0._r8 + dlf_ql(:,:) = 0._r8 + dlf_qi(:,:) = 0._r8 + dlf_nl(:,:) = 0._r8 + dlf_ni(:,:) = 0._r8 + + ! ------------------------------------- ! + ! From here, process computation begins ! + ! ------------------------------------- ! + + ! ----------------------------------------------------------------------------- ! + ! Detrainment of convective condensate into the environment or stratiform cloud ! + ! ----------------------------------------------------------------------------- ! + + lq(:) = .FALSE. + lq(ixcldliq) = .TRUE. + lq(ixcldice) = .TRUE. + lq(ixnumliq) = .TRUE. + lq(ixnumice) = .TRUE. + call physics_ptend_init(ptend_loc, state%psetcols, 'pcwdetrain', ls=.true., lq=lq) ! Initialize local physics_ptend object + + ! Procedures : + ! (1) Partition detrained convective cloud water into liquid and ice based on T. + ! This also involves heating. + ! If convection scheme can handle this internally, this step is not necssary. + ! (2) Assuming a certain effective droplet radius, computes number concentration + ! of detrained convective cloud liquid and ice. + ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into + ! the pre-existing 'liquid' stratus ( mean environment ). The former does + ! not involve any macrophysical evaporation while the latter does. This is + ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded + ! by qcst_min and qcst_max in mmacro_pcond. + ! (4) In contrast to liquid, convective ice is detrained into the environment + ! and involved in the sublimation. Similar bounds as liquid stratus are imposed. + ! This is the key procesure generating upper-level cirrus clouds. + ! The unit of dlf : [ kg/kg/s ] + + if (zmconv_microp) then + call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) + call pbuf_get_field(pbuf, difzm_idx, difzm) + call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) + call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) + end if + + det_s(:) = 0._r8 + det_ice(:) = 0._r8 + + dpdlfliq = 0._r8 + dpdlfice = 0._r8 + shdlfliq = 0._r8 + shdlfice = 0._r8 + dpdlft = 0._r8 + shdlft = 0._r8 + + do k = top_lev, pver + do i = 1, state_loc%ncol + if( state_loc%t(i,k) > 268.15_r8 ) then + dum1 = 0.0_r8 + elseif( state_loc%t(i,k) < 238.15_r8 ) then + dum1 = 1.0_r8 + else + dum1 = ( 268.15_r8 - state_loc%t(i,k) ) / 30._r8 + endif + + ! If detrainment was done elsewhere, still update the variables used for output + ! assuming that the temperature split between liquid and ice is the same as assumed + ! here. + if (zmconv_microp) then + ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 + + ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & + / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection + ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice + + else + if (do_detrain) then + ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 + ! dum2 = dlf(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / & + (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / & + (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ! dum2 = dlf(i,k) * dum1 + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / & + (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * dum1 ) / & + (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection + ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice + else + ptend_loc%q(i,k,ixcldliq) = 0._r8 + ptend_loc%q(i,k,ixcldice) = 0._r8 + ptend_loc%q(i,k,ixnumliq) = 0._r8 + ptend_loc%q(i,k,ixnumice) = 0._r8 + ptend_loc%s(i,k) = 0._r8 + end if + + + end if + + ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep + ! track of the integrals of ice and static energy that is effected from conversion to ice + ! so that the energy checker doesn't complain. + det_s(i) = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit + + ! Targetted detrainment of convective liquid water either directly into the + ! existing liquid stratus or into the environment. + if( cu_det_st ) then + dlf_T(i,k) = ptend_loc%s(i,k)/cpair + dlf_qv(i,k) = 0._r8 + dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq) + dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice) + dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq) + dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice) + ptend_loc%q(i,k,ixcldliq) = 0._r8 + ptend_loc%q(i,k,ixcldice) = 0._r8 + ptend_loc%q(i,k,ixnumliq) = 0._r8 + ptend_loc%q(i,k,ixnumice) = 0._r8 + ptend_loc%s(i,k) = 0._r8 + dpdlfliq(i,k) = 0._r8 + dpdlfice(i,k) = 0._r8 + shdlfliq(i,k) = 0._r8 + shdlfice(i,k) = 0._r8 + dpdlft (i,k) = 0._r8 + shdlft (i,k) = 0._r8 + else + if (zmconv_microp) then + dpdlfliq(i,k) = dlfzm(i,k) + dpdlfice(i,k) = difzm(i,k) + dpdlft (i,k) = 0._r8 + else + dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 ) + dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 ) + dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair + end if + + shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 ) + shdlfice(i,k) = dlf2(i,k) * ( dum1 ) + shdlft (i,k) = dlf2(i,k) * dum1 * latice/cpair + endif + end do + end do + + call outfld( 'DPDLFLIQ ', dpdlfliq, pcols, lchnk ) + call outfld( 'DPDLFICE ', dpdlfice, pcols, lchnk ) + call outfld( 'SHDLFLIQ ', shdlfliq, pcols, lchnk ) + call outfld( 'SHDLFICE ', shdlfice, pcols, lchnk ) + call outfld( 'DPDLFT ', dpdlft , pcols, lchnk ) + call outfld( 'SHDLFT ', shdlft , pcols, lchnk ) + + call outfld( 'ZMDLF', dlf , pcols, state_loc%lchnk ) + + det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water + + ! Add the detrainment tendency to the output tendency + call physics_ptend_init(ptend, state%psetcols, 'macrop') + call physics_ptend_sum(ptend_loc, ptend, ncol) + + ! update local copy of state with the detrainment tendency + ! ptend_loc is reset to zero by this call + call physics_update(state_loc, ptend_loc, dtime) + + ! -------------------------------------- ! + ! Computation of Various Cloud Fractions ! + ! -------------------------------------- ! + + ! ----------------------------------------------------------------------------- ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! (1) CAM4 ! + ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! + ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! + ! . Stratus AMT = max( RH stratus AMT, Stability Stratus AMT ) ! + ! . Cumulus and Stratus are 'minimally' overlapped without hierarchy. ! + ! . Cumulus LWC,IWC is assumed to be the same as Stratus LWC,IWC ! + ! (2) CAM5 ! + ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! + ! Shallow Cumulus AMT ( internally fcn of mass flux and w ) ! + ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! + ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! + ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! + ! ----------------------------------------------------------------------------- ! + + concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver) + + nullify(tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det) + if (tke_idx > 0) call pbuf_get_field(pbuf, tke_idx, tke) + if (qtl_flx_idx > 0) call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx) + if (qti_flx_idx > 0) call pbuf_get_field(pbuf, qti_flx_idx, qti_flx) + if (cmfr_det_idx > 0) call pbuf_get_field(pbuf, cmfr_det_idx, cmfr_det) + if (qlr_det_idx > 0) call pbuf_get_field(pbuf, qlr_det_idx, qlr_det) + if (qir_det_idx > 0) call pbuf_get_field(pbuf, qir_det_idx, qir_det) + + clrw_old(:ncol,:top_lev-1) = 0._r8 + clri_old(:ncol,:top_lev-1) = 0._r8 + do k = top_lev, pver + do i = 1, ncol + clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) ) + clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) ) + end do + end do + + if( use_shfrc ) then + call pbuf_get_field(pbuf, shfrc_idx, shfrc ) + else + allocate(shfrc(pcols,pver)) + shfrc(:,:) = 0._r8 + endif + + ! CAM5 only uses 'concld' output from the below subroutine. + ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. + + call t_startf("cldfrc") + + call cldfrc( lchnk, ncol, pbuf, & + state_loc%pmid, state_loc%t, state_loc%q(:,:,1), state_loc%omega, & + state_loc%phis, shfrc, use_shfrc, & + cld, rhcloud, clc, state_loc%pdel, & + cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, & + ts, sst, state_loc%pint(:,pverp), zdu, ocnfrac, rhu00, & + state_loc%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + + call t_stopf("cldfrc") + + ! ---------------------------------------------- ! + ! Stratiform Cloud Macrophysics and Microphysics ! + ! ---------------------------------------------- ! + + lchnk = state_loc%lchnk + ncol = state_loc%ncol + rdtime = 1._r8/dtime + + ! Define fractional amount of stratus condensate and precipitation in ice phase. + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! The ramp within convective cloud may be different + + call cldfrc_fice( ncol, state_loc%t, fice, fsnow ) + + + lq(:) = .FALSE. + + lq(1) = .true. + lq(ixcldice) = .true. + lq(ixcldliq) = .true. + + lq(ixnumliq) = .true. + lq(ixnumice) = .true. + + ! Initialize local physics_ptend object again + call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', & + ls=.true., lq=lq ) + + ! --------------------------------- ! + ! Liquid Macrop_Driver Macrophysics ! + ! --------------------------------- ! + + call t_startf('mmacro_pcond') + + zeros(:ncol,top_lev:pver) = 0._r8 + qc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldliq) + qi(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldice) + nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq) + ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice) + + ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... ) + ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an + ! attempt to resolve in-cloud and out-cloud forcings. + + if( get_nstep() .le. 1 ) then + tcwat(:ncol,top_lev:pver) = state_loc%t(:ncol,top_lev:pver) + qcwat(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,1) + lcwat(:ncol,top_lev:pver) = qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) + iccwat(:ncol,top_lev:pver) = qi(:ncol,top_lev:pver) + nlwat(:ncol,top_lev:pver) = nc(:ncol,top_lev:pver) + niwat(:ncol,top_lev:pver) = ni(:ncol,top_lev:pver) + ttend(:ncol,:) = 0._r8 + qtend(:ncol,:) = 0._r8 + ltend(:ncol,:) = 0._r8 + itend(:ncol,:) = 0._r8 + nltend(:ncol,:) = 0._r8 + nitend(:ncol,:) = 0._r8 + CC_T(:ncol,:) = 0._r8 + CC_qv(:ncol,:) = 0._r8 + CC_ql(:ncol,:) = 0._r8 + CC_qi(:ncol,:) = 0._r8 + CC_nl(:ncol,:) = 0._r8 + CC_ni(:ncol,:) = 0._r8 + CC_qlst(:ncol,:) = 0._r8 + else + ttend(:ncol,top_lev:pver) = ( state_loc%t(:ncol,top_lev:pver) - tcwat(:ncol,top_lev:pver)) * rdtime & + - CC_T(:ncol,top_lev:pver) + qtend(:ncol,top_lev:pver) = ( state_loc%q(:ncol,top_lev:pver,1) - qcwat(:ncol,top_lev:pver)) * rdtime & + - CC_qv(:ncol,top_lev:pver) + ltend(:ncol,top_lev:pver) = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime & + - (CC_ql(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver)) + itend(:ncol,top_lev:pver) = ( qi(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)) * rdtime & + - CC_qi(:ncol,top_lev:pver) + nltend(:ncol,top_lev:pver) = ( nc(:ncol,top_lev:pver) - nlwat(:ncol,top_lev:pver)) * rdtime & + - CC_nl(:ncol,top_lev:pver) + nitend(:ncol,top_lev:pver) = ( ni(:ncol,top_lev:pver) - niwat(:ncol,top_lev:pver)) * rdtime & + - CC_ni(:ncol,top_lev:pver) + endif + lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver) + + t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver) + qv_inout(:ncol,top_lev:pver) = qcwat(:ncol,top_lev:pver) + ql_inout(:ncol,top_lev:pver) = lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver) + qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver) + nl_inout(:ncol,top_lev:pver) = nlwat(:ncol,top_lev:pver) + ni_inout(:ncol,top_lev:pver) = niwat(:ncol,top_lev:pver) + + ! Liquid Microp_Driver Macrophysics. + ! The main roles of this subroutines are + ! (1) compute net condensation rate of stratiform liquid ( cmeliq ) + ! (2) compute liquid stratus and ice stratus fractions. + ! Note 'ttend...' are advective tendencies except microphysical process while + ! 'CC...' are microphysical tendencies. + + call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel, & + t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, & + ttend, qtend, lmitend, itend, nltend, nitend, & + CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, & + dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni, & + concld_old, concld, clrw_old, clri_old, landfrac, snowh, & + tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det, & + tlat, qvlat, qcten, qiten, ncten, niten, & + cmeliq, qvadj, qladj, qiadj, qllim, qilim, & + cld, alst, aist, qlst, qist, do_cldice ) + + ! Copy of concld/fice to put in physics buffer + ! Below are used only for convective cloud. + + fice_ql(:ncol,:top_lev-1) = 0._r8 + fice_ql(:ncol,top_lev:pver) = fice(:ncol,top_lev:pver) + + + ! Compute net stratus fraction using maximum over-lapping assumption + ast(:ncol,:top_lev-1) = 0._r8 + ast(:ncol,top_lev:pver) = max( alst(:ncol,top_lev:pver), aist(:ncol,top_lev:pver) ) + + call t_stopf('mmacro_pcond') + + do k = top_lev, pver + do i = 1, ncol + ptend_loc%s(i,k) = tlat(i,k) + ptend_loc%q(i,k,1) = qvlat(i,k) + ptend_loc%q(i,k,ixcldliq) = qcten(i,k) + ptend_loc%q(i,k,ixcldice) = qiten(i,k) + ptend_loc%q(i,k,ixnumliq) = ncten(i,k) + ptend_loc%q(i,k,ixnumice) = niten(i,k) + + ! Check to make sure that the macrophysics code is respecting the flags that control + ! whether cldwat should be prognosing cloud ice and cloud liquid or not. + if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then + call endrun("macrop_driver:ERROR - "// & + "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.") + end if + if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then + call endrun("macrop_driver:ERROR -"// & + " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.") + end if + + if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then + call endrun("macrop_driver:ERROR - "// & + "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.") + end if + if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then + call endrun("macrop_driver:ERROR - "// & + "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.") + end if + end do + end do + + ! update the output tendencies with the mmacro_pcond tendencies + call physics_ptend_sum(ptend_loc, ptend, ncol) + + ! state_loc is the equlibrium state after macrophysics + call physics_update(state_loc, ptend_loc, dtime) + + call outfld('CLR_LIQ', clrw_old, pcols, lchnk) + call outfld('CLR_ICE', clri_old, pcols, lchnk) + + call outfld( 'MACPDT ', tlat , pcols, lchnk ) + call outfld( 'MACPDQ ', qvlat, pcols, lchnk ) + call outfld( 'MACPDLIQ ', qcten, pcols, lchnk ) + call outfld( 'MACPDICE ', qiten, pcols, lchnk ) + call outfld( 'CLDVAPADJ', qvadj, pcols, lchnk ) + call outfld( 'CLDLIQADJ', qladj, pcols, lchnk ) + call outfld( 'CLDICEADJ', qiadj, pcols, lchnk ) + call outfld( 'CLDLIQDET', dlf_ql, pcols, lchnk ) + call outfld( 'CLDICEDET', dlf_qi, pcols, lchnk ) + call outfld( 'CLDLIQLIM', qllim, pcols, lchnk ) + call outfld( 'CLDICELIM', qilim, pcols, lchnk ) + + call outfld( 'ICECLDF ', aist, pcols, lchnk ) + call outfld( 'LIQCLDF ', alst, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) + + call outfld( 'CONCLD ', concld, pcols, lchnk ) + call outfld( 'CLDST ', cldst, pcols, lchnk ) + + call outfld( 'CMELIQ' , cmeliq, pcols, lchnk ) + + + ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP + + ! initialize local variables + mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0 + mr_ccice = 0._r8 !! not seen by radiation, so setting to 0 + mr_lsliq = 0._r8 + mr_lsice = 0._r8 + + do k=top_lev,pver + do i=1,ncol + if (cld(i,k) .gt. 0._r8) then + mr_lsliq(i,k) = state_loc%q(i,k,ixcldliq) + mr_lsice(i,k) = state_loc%q(i,k,ixcldice) + else + mr_lsliq(i,k) = 0._r8 + mr_lsice(i,k) = 0._r8 + end if + end do + end do + + call outfld( 'CLDLIQSTR ', mr_lsliq, pcols, lchnk ) + call outfld( 'CLDICESTR ', mr_lsice, pcols, lchnk ) + call outfld( 'CLDLIQCON ', mr_ccliq, pcols, lchnk ) + call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk ) + + ! ------------------------------------------------- ! + ! Save equilibrium state variables for macrophysics ! + ! at the next time step ! + ! ------------------------------------------------- ! + cldsice = 0._r8 + do k = top_lev, pver + tcwat(:ncol,k) = state_loc%t(:ncol,k) + qcwat(:ncol,k) = state_loc%q(:ncol,k,1) + lcwat(:ncol,k) = state_loc%q(:ncol,k,ixcldliq) + state_loc%q(:ncol,k,ixcldice) + iccwat(:ncol,k) = state_loc%q(:ncol,k,ixcldice) + nlwat(:ncol,k) = state_loc%q(:ncol,k,ixnumliq) + niwat(:ncol,k) = state_loc%q(:ncol,k,ixnumice) + cldsice(:ncol,k) = lcwat(:ncol,k) * min(1.0_r8, max(0.0_r8, (tmelt - tcwat(:ncol,k)) / 20._r8)) + end do + + call outfld( 'CLDSICE' , cldsice, pcols, lchnk ) + + ! ptend_loc is deallocated in physics_update above + call physics_state_dealloc(state_loc) + +end subroutine macrop_driver_tend + + +! Saturation adjustment for liquid +! +! With CLUBB, we are seeing relative humidity with respect to water +! greater than 1. This should not be happening and is not what the +! microphsyics expects from the macrophysics. As a work around while +! this issue is investigated in CLUBB, this routine will enfornce a +! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will +! be converted into cloud drops. +elemental subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend) + + use wv_sat_methods, only: wv_sat_qsat_ice, wv_sat_qsat_water + use micro_mg_utils, only: rhow + use physconst, only: rair + use cldfrc2m, only: rhmini_const, rhmaxi_const + + real(r8), intent(in) :: npccn !Activated number of cloud condensation nuclei + real(r8), intent(in) :: t !temperature (k) + real(r8), intent(in) :: p !pressure (pa) + real(r8), intent(in) :: qv !water vapor mixing ratio + real(r8), intent(in) :: qc !liquid mixing ratio + real(r8), intent(in) :: nc !liquid number concentration + real(r8), intent(in) :: xxlv !latent heat of vaporization + real(r8), intent(in) :: deltat !timestep + real(r8), intent(out) :: stend ! 'temperature' tendency + real(r8), intent(out) :: qvtend !vapor tendency + real(r8), intent(out) :: qctend !liquid mass tendency + real(r8), intent(out) :: nctend !liquid number tendency + + + real(r8) :: ESL + real(r8) :: QSL + + stend = 0._r8 + qvtend = 0._r8 + qctend = 0._r8 + nctend = 0._r8 + + ! calculate qsatl from t,p,q + call wv_sat_qsat_water(t, p, ESL, QSL) + + ! Don't allow supersaturation with respect to liquid. + if (qv.gt.QSL) then + + qctend = (qv - QSL) / deltat + qvtend = 0._r8 - qctend + stend = qctend * xxlv ! moist static energy tend...[J/kg/s] ! + + ! If drops exists (more than 1 L-1) and there is condensation, + ! do not add to number (= growth), otherwise add 6um drops. + ! + ! This is somewhat arbitrary, but ensures that some reasonable droplet + ! size is create to remove the excess water. This could be enhanced to + ! look at npccn, but ideally this entire routine should go away. + if (nc*p/rair/t.lt.1e3_r8.and.(qc+qctend*deltat).gt.1e-18_r8) then + nctend = nctend + 3._r8 * qctend/(4._r8*3.14_r8*6.e-6_r8**3*rhow) + endif + endif +end subroutine liquid_macro_tend + +end module macrop_driver diff --git a/src/physics/cam/micro_mg1_0.F90 b/src/physics/cam/micro_mg1_0.F90 new file mode 100644 index 0000000000..eb252fc0ce --- /dev/null +++ b/src/physics/cam/micro_mg1_0.F90 @@ -0,0 +1,3742 @@ +module micro_mg1_0 + +!--------------------------------------------------------------------------------- +! Purpose: +! MG microphysics +! +! Author: Andrew Gettelman, Hugh Morrison. +! Contributions from: Xiaohong Liu and Steve Ghan +! December 2005-May 2010 +! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) +! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +! +! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice +! microphysics in cooperation with the MG liquid microphysics. This is +! controlled by the do_cldice variable. +! +! NOTE: If do_cldice is false, then MG microphysics should not update CLDICE +! or NUMICE; however, it is assumed that the other microphysics scheme will have +! updated CLDICE and NUMICE. The other microphysics should handle the following +! processes that would have been done by MG: +! - Detrainment (liquid and ice) +! - Homogeneous ice nucleation +! - Heterogeneous ice nucleation +! - Bergeron process +! - Melting of ice +! - Freezing of cloud drops +! - Autoconversion (ice -> snow) +! - Growth/Sublimation of ice +! - Sedimentation of ice +!--------------------------------------------------------------------------------- +! modification for sub-columns, HM, (orig 8/11/10) +! This is done using the logical 'microp_uniform' set to .true. = uniform for subcolumns +!--------------------------------------------------------------------------------- + +! Procedures required: +! 1) An implementation of the gamma function (if not intrinsic). +! 2) saturation vapor pressure to specific humidity formula +! 3) svp over water +! 4) svp over ice + +#ifndef HAVE_GAMMA_INTRINSICS +use shr_spfn_mod, only: gamma => shr_spfn_gamma +#endif + + use wv_sat_methods, only: & + svp_water => wv_sat_svp_water, & + svp_ice => wv_sat_svp_ice, & + svp_to_qsat => wv_sat_svp_to_qsat + + use phys_control, only: phys_getopts + +implicit none +private +save + +! Note: The liu_in option has been removed, as there was a serious bug with this +! option being set to false. The code now behaves as if the default liu_in=.true. +! is always on. Addition/reinstatement of ice nucleation options will likely be +! done outside of this module. + +public :: & + micro_mg_init, & + micro_mg_get_cols, & + micro_mg_tend + +integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + +real(r8) :: g !gravity +real(r8) :: r !Dry air Gas constant +real(r8) :: rv !water vapor gas contstant +real(r8) :: cpp !specific heat of dry air +real(r8) :: rhow !density of liquid water +real(r8) :: tmelt ! Freezing point of water (K) +real(r8) :: xxlv ! latent heat of vaporization +real(r8) :: xlf !latent heat of freezing +real(r8) :: xxls !latent heat of sublimation + +real(r8) :: rhosn ! bulk density snow +real(r8) :: rhoi ! bulk density ice + +real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters +real(r8) :: ci,di !ice mass-diameter relation parameters +real(r8) :: cs,ds !snow mass-diameter relation parameters +real(r8) :: cr,dr !drop mass-diameter relation parameters +real(r8) :: f1s,f2s !ventilation param for snow +real(r8) :: Eii !collection efficiency aggregation of ice +real(r8) :: Ecr !collection efficiency cloud droplets/rain +real(r8) :: f1r,f2r !ventilation param for rain +real(r8) :: DCS !autoconversion size threshold +real(r8) :: qsmall !min mixing ratio +real(r8) :: bimm,aimm !immersion freezing +real(r8) :: rhosu !typical 850mn air density +real(r8) :: mi0 ! new crystal mass +real(r8) :: rin ! radius of contact nuclei +real(r8) :: pi ! pi + +! Additional constants to help speed up code + +real(r8) :: cons1 +real(r8) :: cons4 +real(r8) :: cons5 +real(r8) :: cons6 +real(r8) :: cons7 +real(r8) :: cons8 +real(r8) :: cons11 +real(r8) :: cons13 +real(r8) :: cons14 +real(r8) :: cons16 +real(r8) :: cons17 +real(r8) :: cons22 +real(r8) :: cons23 +real(r8) :: cons24 +real(r8) :: cons25 +real(r8) :: cons27 +real(r8) :: cons28 + +real(r8) :: lammini +real(r8) :: lammaxi +real(r8) :: lamminr +real(r8) :: lammaxr +real(r8) :: lammins +real(r8) :: lammaxs + +! parameters for snow/rain fraction for convective clouds +real(r8) :: tmax_fsnow ! max temperature for transition to convective snow +real(r8) :: tmin_fsnow ! min temperature for transition to convective snow + +!needed for findsp +real(r8) :: tt0 ! Freezing temperature + +real(r8) :: csmin,csmax,minrefl,mindbz + +real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0. + +logical :: use_hetfrz_classnuc ! option to use heterogeneous freezing + +character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method +real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor + +! Switches for specification rather than prediction of droplet and crystal number +! note: number will be adjusted as needed to keep mean size within bounds, +! even when specified droplet or ice number is used +! +! If constant cloud ice number is set (nicons = .true.), +! then all microphysical processes except mass transfer due to ice nucleation +! (mnuccd) are based on the fixed cloud ice number. Calculation of +! mnuccd follows from the prognosed ice crystal number ni. +logical :: nccons ! nccons=.true. to specify constant cloud droplet number +logical :: nicons ! nicons=.true. to specify constant cloud ice number + +! parameters for specified ice and droplet number concentration +! note: these are local in-cloud values, not grid-mean +real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3) +real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3) + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_mg_init( & + kind, gravit, rair, rh2o, cpair, & + rhoh2o, tmelt_in, latvap, latice, & + rhmini_in, micro_mg_dcs, use_hetfrz_classnuc_in, & + micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & + nccons_in, nicons_in, ncnst_in, ninst_in, errstring) + +!----------------------------------------------------------------------- +! +! Purpose: +! initialize constants for the morrison microphysics +! +! Author: Andrew Gettelman Dec 2005 +! +!----------------------------------------------------------------------- + +integer, intent(in) :: kind ! Kind used for reals +real(r8), intent(in) :: gravit +real(r8), intent(in) :: rair +real(r8), intent(in) :: rh2o +real(r8), intent(in) :: cpair +real(r8), intent(in) :: rhoh2o +real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) +real(r8), intent(in) :: latvap +real(r8), intent(in) :: latice +real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0. +real(r8), intent(in) :: micro_mg_dcs +logical, intent(in) :: use_hetfrz_classnuc_in +character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method +real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor +logical, intent(in) :: nccons_in +logical, intent(in) :: nicons_in +real(r8), intent(in) :: ncnst_in +real(r8), intent(in) :: ninst_in + +character(128), intent(out) :: errstring ! Output status (non-blank for error return) + +integer k + +integer l,m, iaer +real(r8) surften ! surface tension of water w/respect to air (N/m) +real(r8) arg +!----------------------------------------------------------------------- + +errstring = ' ' + +if( kind .ne. r8 ) then + errstring = 'micro_mg_init: KIND of reals does not match' + return +end if + +!declarations for morrison codes (transforms variable names) + +g= gravit !gravity +r= rair !Dry air Gas constant: note units(phys_constants are in J/K/kmol) +rv= rh2o !water vapor gas contstant +cpp = cpair !specific heat of dry air +rhow = rhoh2o !density of liquid water +tmelt = tmelt_in +rhmini = rhmini_in +micro_mg_precip_frac_method = micro_mg_precip_frac_method_in +micro_mg_berg_eff_factor = micro_mg_berg_eff_factor_in + +nccons = nccons_in +nicons = nicons_in +ncnst = ncnst_in +ninst = ninst_in + +! latent heats + +xxlv = latvap ! latent heat vaporization +xlf = latice ! latent heat freezing +xxls = xxlv + xlf ! latent heat of sublimation + +! flags +use_hetfrz_classnuc = use_hetfrz_classnuc_in + +! parameters for snow/rain fraction for convective clouds + +tmax_fsnow = tmelt +tmin_fsnow = tmelt-5._r8 + +! parameters below from Reisner et al. (1998) +! density parameters (kg/m3) + +rhosn = 250._r8 ! bulk density snow (++ ceh) +rhoi = 500._r8 ! bulk density ice +rhow = 1000._r8 ! bulk density liquid + + +! fall speed parameters, V = aD^b +! V is in m/s + +! droplets +ac = 3.e7_r8 +bc = 2._r8 + +! snow +as = 11.72_r8 +bs = 0.41_r8 + +! cloud ice +ai = 700._r8 +bi = 1._r8 + +! rain +ar = 841.99667_r8 +br = 0.8_r8 + +! particle mass-diameter relationship +! currently we assume spherical particles for cloud ice/snow +! m = cD^d + +pi= 3.1415927_r8 + +! cloud ice mass-diameter relationship + +ci = rhoi*pi/6._r8 +di = 3._r8 + +! snow mass-diameter relationship + +cs = rhosn*pi/6._r8 +ds = 3._r8 + +! drop mass-diameter relationship + +cr = rhow*pi/6._r8 +dr = 3._r8 + +! ventilation parameters for snow +! hall and prupacher + +f1s = 0.86_r8 +f2s = 0.28_r8 + +! collection efficiency, aggregation of cloud ice and snow + +Eii = 0.1_r8 + +! collection efficiency, accretion of cloud water by rain + +Ecr = 1.0_r8 + +! ventilation constants for rain + +f1r = 0.78_r8 +f2r = 0.32_r8 + +! autoconversion size threshold for cloud ice to snow (m) + +Dcs = micro_mg_dcs + +! smallest mixing ratio considered in microphysics + +qsmall = 1.e-18_r8 + +! immersion freezing parameters, bigg 1953 + +bimm = 100._r8 +aimm = 0.66_r8 + +! typical air density at 850 mb + +rhosu = 85000._r8/(rair * tmelt) + +! mass of new crystal due to aerosol freezing and growth (kg) + +mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) + +! radius of contact nuclei aerosol (m) + +rin = 0.1e-6_r8 + +! freezing temperature +tt0=273.15_r8 + +pi=4._r8*atan(1.0_r8) + +!Range of cloudsat reflectivities (dBz) for analytic simulator +csmin= -30._r8 +csmax= 26._r8 +mindbz = -99._r8 +! minrefl = 10._r8**(mindbz/10._r8) +minrefl = 1.26e-10_r8 + +! Define constants to help speed up code (limit calls to gamma function) + +cons1=gamma(1._r8+di) +cons4=gamma(1._r8+br) +cons5=gamma(4._r8+br) +cons6=gamma(1._r8+ds) +cons7=gamma(1._r8+bs) +cons8=gamma(4._r8+bs) +cons11=gamma(3._r8+bs) +cons13=gamma(5._r8/2._r8+br/2._r8) +cons14=gamma(5._r8/2._r8+bs/2._r8) +cons16=gamma(1._r8+bi) +cons17=gamma(4._r8+bi) +cons22=(4._r8/3._r8*pi*rhow*(25.e-6_r8)**3) +cons23=dcs**3 +cons24=dcs**2 +cons25=dcs**bs +cons27=xxlv**2 +cons28=xxls**2 + +lammaxi = 1._r8/10.e-6_r8 +lammini = 1._r8/(2._r8*dcs) +lammaxr = 1._r8/20.e-6_r8 +lamminr = 1._r8/500.e-6_r8 +lammaxs = 1._r8/10.e-6_r8 +lammins = 1._r8/2000.e-6_r8 + +end subroutine micro_mg_init + +!=============================================================================== +!microphysics routine for each timestep goes here... + +subroutine micro_mg_tend ( & + microp_uniform, pcols, pver, ncol, top_lev, deltatin,& + tn, qn, qc, qi, nc, & + ni, p, pdel, cldn, liqcldf, & + relvar, accre_enhan, & + icecldf, rate1ord_cw2pr_st, naai, npccnin, & + rndst, nacon, tlat, qvlat, qctend, & + qitend, nctend, nitend, effc, effc_fn, & + effi, prect, preci, nevapr, evapsnow, am_evp_st, & + prain, prodsnow, cmeout, deffi, pgamrad, & + lamcrad, qsout, dsout, rflx, sflx, & + qrout, reff_rain, reff_snow, qcsevap, qisevap, & + qvres, cmeiout, vtrmc, vtrmi, qcsedten, & + qisedten, prao, prco, mnuccco, mnuccto, & + msacwio, psacwso, bergso, bergo, melto, & + homoo, qcreso, prcio, praio, qireso, & + mnuccro, pracso, meltsdt, frzrdt, mnuccdo, & + nrout, nsout, refl, arefl, areflz, & + frefl, csrfl, acsrfl, fcsrfl, rercld, & + ncai, ncal, qrout2, qsout2, nrout2, & + nsout2, drout2, dsout2, freqs, freqr, & + nfice, prer_evap, do_cldice, errstring, & + tnd_qsnow, tnd_nsnow, re_ice, & + frzimm, frzcnt, frzdep) + +! input arguments +logical, intent(in) :: microp_uniform ! True = configure uniform for sub-columns False = use w/o sub-columns (standard) +integer, intent(in) :: pcols ! size of column (first) index +integer, intent(in) :: pver ! number of layers in columns +integer, intent(in) :: ncol ! number of columns +integer, intent(in) :: top_lev ! top level microphys is applied +real(r8), intent(in) :: deltatin ! time step (s) +real(r8), intent(in) :: tn(pcols,pver) ! input temperature (K) +real(r8), intent(in) :: qn(pcols,pver) ! input h20 vapor mixing ratio (kg/kg) +real(r8), intent(in) :: relvar(pcols,pver) ! relative variance of cloud water (-) +real(r8), intent(in) :: accre_enhan(pcols,pver) ! optional accretion enhancement factor (-) + +! note: all input cloud variables are grid-averaged +real(r8), intent(inout) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg) +real(r8), intent(inout) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg) +real(r8), intent(inout) :: nc(pcols,pver) ! cloud water number conc (1/kg) +real(r8), intent(inout) :: ni(pcols,pver) ! cloud ice number conc (1/kg) +real(r8), intent(in) :: p(pcols,pver) ! air pressure (pa) +real(r8), intent(in) :: pdel(pcols,pver) ! pressure difference across level (pa) +real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction +real(r8), intent(in) :: icecldf(pcols,pver) ! ice cloud fraction +real(r8), intent(in) :: liqcldf(pcols,pver) ! liquid cloud fraction + +real(r8), intent(out) :: rate1ord_cw2pr_st(pcols,pver) ! 1st order rate for direct cw to precip conversion +! used for scavenging +! Inputs for aerosol activation +real(r8), intent(in) :: naai(pcols,pver) ! ice nulceation number (from microp_aero_ts) +real(r8), intent(in) :: npccnin(pcols,pver) ! ccn activated number tendency (from microp_aero_ts) +real(r8), intent(in) :: rndst(pcols,pver,4) ! radius of 4 dust bins for contact freezing (from microp_aero_ts) +real(r8), intent(in) :: nacon(pcols,pver,4) ! number in 4 dust bins for contact freezing (from microp_aero_ts) + +! Used with CARMA cirrus microphysics +! (or similar external microphysics model) +logical, intent(in) :: do_cldice ! Prognosing cldice + +! output arguments + +real(r8), intent(out) :: tlat(pcols,pver) ! latent heating rate (W/kg) +real(r8), intent(out) :: qvlat(pcols,pver) ! microphysical tendency qv (1/s) +real(r8), intent(out) :: qctend(pcols,pver) ! microphysical tendency qc (1/s) +real(r8), intent(out) :: qitend(pcols,pver) ! microphysical tendency qi (1/s) +real(r8), intent(out) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s)) +real(r8), intent(out) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s)) +real(r8), intent(out) :: effc(pcols,pver) ! droplet effective radius (micron) +real(r8), intent(out) :: effc_fn(pcols,pver) ! droplet effective radius, assuming nc = 1.e8 kg-1 +real(r8), intent(out) :: effi(pcols,pver) ! cloud ice effective radius (micron) +real(r8), intent(out) :: prect(pcols) ! surface precip rate (m/s) +real(r8), intent(out) :: preci(pcols) ! cloud ice/snow precip rate (m/s) +real(r8), intent(out) :: nevapr(pcols,pver) ! evaporation rate of rain + snow +real(r8), intent(out) :: evapsnow(pcols,pver)! sublimation rate of snow +real(r8), intent(out) :: am_evp_st(pcols,pver)! stratiform evaporation area +real(r8), intent(out) :: prain(pcols,pver) ! production of rain + snow +real(r8), intent(out) :: prodsnow(pcols,pver)! production of snow +real(r8), intent(out) :: cmeout(pcols,pver) ! evap/sub of cloud +real(r8), intent(out) :: deffi(pcols,pver) ! ice effective diameter for optics (radiation) +real(r8), intent(out) :: pgamrad(pcols,pver) ! ice gamma parameter for optics (radiation) +real(r8), intent(out) :: lamcrad(pcols,pver) ! slope of droplet distribution for optics (radiation) +real(r8), intent(out) :: qsout(pcols,pver) ! snow mixing ratio (kg/kg) +real(r8), intent(out) :: dsout(pcols,pver) ! snow diameter (m) +real(r8), intent(out) :: rflx(pcols,pver+1) ! grid-box average rain flux (kg m^-2 s^-1) +real(r8), intent(out) :: sflx(pcols,pver+1) ! grid-box average snow flux (kg m^-2 s^-1) +real(r8), intent(out) :: qrout(pcols,pver) ! grid-box average rain mixing ratio (kg/kg) +real(r8), intent(inout) :: reff_rain(pcols,pver) ! rain effective radius (micron) +real(r8), intent(inout) :: reff_snow(pcols,pver) ! snow effective radius (micron) +real(r8), intent(out) :: qcsevap(pcols,pver) ! cloud water evaporation due to sedimentation +real(r8), intent(out) :: qisevap(pcols,pver) ! cloud ice sublimation due to sublimation +real(r8), intent(out) :: qvres(pcols,pver) ! residual condensation term to ensure RH < 100% +real(r8), intent(out) :: cmeiout(pcols,pver) ! grid-mean cloud ice sub/dep +real(r8), intent(out) :: vtrmc(pcols,pver) ! mass-weighted cloud water fallspeed +real(r8), intent(out) :: vtrmi(pcols,pver) ! mass-weighted cloud ice fallspeed +real(r8), intent(out) :: qcsedten(pcols,pver) ! qc sedimentation tendency +real(r8), intent(out) :: qisedten(pcols,pver) ! qi sedimentation tendency +! microphysical process rates for output (mixing ratio tendencies) +real(r8), intent(out) :: prao(pcols,pver) ! accretion of cloud by rain +real(r8), intent(out) :: prco(pcols,pver) ! autoconversion of cloud to rain +real(r8), intent(out) :: mnuccco(pcols,pver) ! mixing rat tend due to immersion freezing +real(r8), intent(out) :: mnuccto(pcols,pver) ! mixing ratio tend due to contact freezing +real(r8), intent(out) :: msacwio(pcols,pver) ! mixing ratio tend due to H-M splintering +real(r8), intent(out) :: psacwso(pcols,pver) ! collection of cloud water by snow +real(r8), intent(out) :: bergso(pcols,pver) ! bergeron process on snow +real(r8), intent(out) :: bergo(pcols,pver) ! bergeron process on cloud ice +real(r8), intent(out) :: melto(pcols,pver) ! melting of cloud ice +real(r8), intent(out) :: homoo(pcols,pver) ! homogeneos freezign cloud water +real(r8), intent(out) :: qcreso(pcols,pver) ! residual cloud condensation due to removal of excess supersat +real(r8), intent(out) :: prcio(pcols,pver) ! autoconversion of cloud ice to snow +real(r8), intent(out) :: praio(pcols,pver) ! accretion of cloud ice by snow +real(r8), intent(out) :: qireso(pcols,pver) ! residual ice deposition due to removal of excess supersat +real(r8), intent(out) :: mnuccro(pcols,pver) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) +real(r8), intent(out) :: pracso (pcols,pver) ! mixing ratio tendency due to accretion of rain by snow (1/s) +real(r8), intent(out) :: meltsdt(pcols,pver) ! latent heating rate due to melting of snow (W/kg) +real(r8), intent(out) :: frzrdt (pcols,pver) ! latent heating rate due to homogeneous freezing of rain (W/kg) +real(r8), intent(out) :: mnuccdo(pcols,pver) ! mass tendency from ice nucleation +real(r8), intent(out) :: nrout(pcols,pver) ! rain number concentration (1/m3) +real(r8), intent(out) :: nsout(pcols,pver) ! snow number concentration (1/m3) +real(r8), intent(out) :: refl(pcols,pver) ! analytic radar reflectivity +real(r8), intent(out) :: arefl(pcols,pver) !average reflectivity will zero points outside valid range +real(r8), intent(out) :: areflz(pcols,pver) !average reflectivity in z. +real(r8), intent(out) :: frefl(pcols,pver) +real(r8), intent(out) :: csrfl(pcols,pver) !cloudsat reflectivity +real(r8), intent(out) :: acsrfl(pcols,pver) !cloudsat average +real(r8), intent(out) :: fcsrfl(pcols,pver) +real(r8), intent(out) :: rercld(pcols,pver) ! effective radius calculation for rain + cloud +real(r8), intent(out) :: ncai(pcols,pver) ! output number conc of ice nuclei available (1/m3) +real(r8), intent(out) :: ncal(pcols,pver) ! output number conc of CCN (1/m3) +real(r8), intent(out) :: qrout2(pcols,pver) +real(r8), intent(out) :: qsout2(pcols,pver) +real(r8), intent(out) :: nrout2(pcols,pver) +real(r8), intent(out) :: nsout2(pcols,pver) +real(r8), intent(out) :: drout2(pcols,pver) ! mean rain particle diameter (m) +real(r8), intent(out) :: dsout2(pcols,pver) ! mean snow particle diameter (m) +real(r8), intent(out) :: freqs(pcols,pver) +real(r8), intent(out) :: freqr(pcols,pver) +real(r8), intent(out) :: nfice(pcols,pver) +real(r8), intent(out) :: prer_evap(pcols,pver) + +real(r8) :: nevapr2(pcols,pver) + +character(128), intent(out) :: errstring ! Output status (non-blank for error return) + +! Tendencies calculated by external schemes that can replace MG's native +! process tendencies. + +! Used with CARMA cirrus microphysics +! (or similar external microphysics model) +real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s) +real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s) +real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m) + +! From external ice nucleation. +real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3) +real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3) +real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3) + +! local workspace +! all units mks unless otherwise stated + +! Additional constants to help speed up code +real(r8) :: cons2 +real(r8) :: cons3 +real(r8) :: cons9 +real(r8) :: cons10 +real(r8) :: cons12 +real(r8) :: cons15 +real(r8) :: cons18 +real(r8) :: cons19 +real(r8) :: cons20 + +! temporary variables for sub-stepping +real(r8) :: t1(pcols,pver) +real(r8) :: q1(pcols,pver) +real(r8) :: qc1(pcols,pver) +real(r8) :: qi1(pcols,pver) +real(r8) :: nc1(pcols,pver) +real(r8) :: ni1(pcols,pver) +real(r8) :: tlat1(pcols,pver) +real(r8) :: qvlat1(pcols,pver) +real(r8) :: qctend1(pcols,pver) +real(r8) :: qitend1(pcols,pver) +real(r8) :: nctend1(pcols,pver) +real(r8) :: nitend1(pcols,pver) +real(r8) :: prect1(pcols) +real(r8) :: preci1(pcols) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +real(r8) :: deltat ! sub-time step (s) +real(r8) :: omsm ! number near unity for round-off issues +real(r8) :: dto2 ! dt/2 (s) +real(r8) :: mincld ! minimum allowed cloud fraction +real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg) +real(r8) :: t(pcols,pver) ! temperature (K) +real(r8) :: rho(pcols,pver) ! air density (kg m-3) +real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air +real(r8) :: mu(pcols,pver) ! viscocity of air +real(r8) :: sc(pcols,pver) ! schmidt number +real(r8) :: kap(pcols,pver) ! thermal conductivity of air +real(r8) :: rhof(pcols,pver) ! air density correction factor for fallspeed +real(r8) :: cldmax(pcols,pver) ! precip fraction assuming maximum overlap +real(r8) :: cldm(pcols,pver) ! cloud fraction +real(r8) :: icldm(pcols,pver) ! ice cloud fraction +real(r8) :: lcldm(pcols,pver) ! liq cloud fraction +real(r8) :: icwc(pcols) ! in cloud water content (liquid+ice) +real(r8) :: calpha(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cbeta(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cbetah(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cgamma(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cgamah(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: rcgama(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cmec1(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cmec2(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cmec3(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: cmec4(pcols) ! parameter for cond/evap (Zhang et al. 2003) +real(r8) :: qtmp ! dummy qv +real(r8) :: dum ! temporary dummy variable + +real(r8) :: cme(pcols,pver) ! total (liquid+ice) cond/evap rate of cloud + +real(r8) :: cmei(pcols,pver) ! dep/sublimation rate of cloud ice +real(r8) :: cwml(pcols,pver) ! cloud water mixing ratio +real(r8) :: cwmi(pcols,pver) ! cloud ice mixing ratio +real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing +real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation +real(r8) :: qcld ! total cloud water +real(r8) :: lcldn(pcols,pver) ! fractional coverage of new liquid cloud +real(r8) :: lcldo(pcols,pver) ! fractional coverage of old liquid cloud +real(r8) :: nctend_mixnuc(pcols,pver) +real(r8) :: arg ! argument of erfc + +! for calculation of rate1ord_cw2pr_st +real(r8) :: qcsinksum_rate1ord(pver) ! sum over iterations of cw to precip sink +real(r8) :: qcsum_rate1ord(pver) ! sum over iterations of cloud water + +real(r8) :: alpha + +real(r8) :: dum1,dum2 !general dummy variables + +real(r8) :: npccn(pver) ! droplet activation rate +real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio +real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio +real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio +real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio +real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc +real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc +real(r8) :: nsic(pcols,pver) ! in-precip snow number conc +real(r8) :: nric(pcols,pver) ! in-precip rain number conc +real(r8) :: lami(pver) ! slope of cloud ice size distr +real(r8) :: n0i(pver) ! intercept of cloud ice size distr +real(r8) :: lamc(pver) ! slope of cloud liquid size distr +real(r8) :: n0c(pver) ! intercept of cloud liquid size distr +real(r8) :: lams(pver) ! slope of snow size distr +real(r8) :: n0s(pver) ! intercept of snow size distr +real(r8) :: lamr(pver) ! slope of rain size distr +real(r8) :: n0r(pver) ! intercept of rain size distr +real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing +! combined size of precip & cloud drops +real(r8) :: arcld(pcols,pver) ! averaging control flag +real(r8) :: Actmp !area cross section of drops +real(r8) :: Artmp !area cross section of rain + +real(r8) :: pgam(pver) ! spectral width parameter of droplet size distr +real(r8) :: lammax ! maximum allowed slope of size distr +real(r8) :: lammin ! minimum allowed slope of size distr +real(r8) :: nacnt ! number conc of contact ice nuclei +real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water +real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water + +real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water +real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water +real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication +real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication + +real(r8) :: prc(pver) ! qc tendency due to autoconversion of cloud droplets +real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets +real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets +real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow +real(r8) :: dc0 ! mean size droplet size distr +real(r8) :: ds0 ! mean size snow size distr (area weighted) +real(r8) :: eci ! collection efficiency for riming of snow by droplets +real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow +real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow +real(r8) :: uni ! number-weighted cloud ice fallspeed +real(r8) :: umi ! mass-weighted cloud ice fallspeed +real(r8) :: uns(pver) ! number-weighted snow fallspeed +real(r8) :: ums(pver) ! mass-weighted snow fallspeed +real(r8) :: unr(pver) ! number-weighted rain fallspeed +real(r8) :: umr(pver) ! mass-weighted rain fallspeed +real(r8) :: unc ! number-weighted cloud droplet fallspeed +real(r8) :: umc ! mass-weighted cloud droplet fallspeed +real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow +real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow +real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain +real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain +real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain +real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain +real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain +real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow +real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow +real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow +real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow +real(r8) :: qvs ! liquid saturation vapor mixing ratio +real(r8) :: qvi ! ice saturation vapor mixing ratio +real(r8) :: dqsdt ! change of sat vapor mixing ratio with temperature +real(r8) :: dqsidt ! change of ice sat vapor mixing ratio with temperature +real(r8) :: ab ! correction factor for rain evap to account for latent heat +real(r8) :: qclr ! water vapor mixing ratio in clear air +real(r8) :: abi ! correction factor for snow sublimation to account for latent heat +real(r8) :: epss ! 1/ sat relaxation timescale for snow +real(r8) :: epsr ! 1/ sat relaxation timescale for rain +real(r8) :: pre(pver) ! rain mixing rat tendency due to evaporation +real(r8) :: prds(pver) ! snow mixing rat tendency due to sublimation +real(r8) :: qce ! dummy qc for conservation check +real(r8) :: qie ! dummy qi for conservation check +real(r8) :: nce ! dummy nc for conservation check +real(r8) :: nie ! dummy ni for conservation check +real(r8) :: ratio ! parameter for conservation check +real(r8) :: dumc(pcols,pver) ! dummy in-cloud qc +real(r8) :: dumnc(pcols,pver) ! dummy in-cloud nc +real(r8) :: dumi(pcols,pver) ! dummy in-cloud qi +real(r8) :: dumni(pcols,pver) ! dummy in-cloud ni +real(r8) :: dums(pcols,pver) ! dummy in-cloud snow mixing rat +real(r8) :: dumns(pcols,pver) ! dummy in-cloud snow number conc +real(r8) :: dumr(pcols,pver) ! dummy in-cloud rain mixing rat +real(r8) :: dumnr(pcols,pver) ! dummy in-cloud rain number conc +! below are parameters for cloud water and cloud ice sedimentation calculations +real(r8) :: fr(pver) +real(r8) :: fnr(pver) +real(r8) :: fc(pver) +real(r8) :: fnc(pver) +real(r8) :: fi(pver) +real(r8) :: fni(pver) +real(r8) :: fs(pver) +real(r8) :: fns(pver) +real(r8) :: faloutr(pver) +real(r8) :: faloutnr(pver) +real(r8) :: faloutc(pver) +real(r8) :: faloutnc(pver) +real(r8) :: falouti(pver) +real(r8) :: faloutni(pver) +real(r8) :: falouts(pver) +real(r8) :: faloutns(pver) +real(r8) :: faltndr +real(r8) :: faltndnr +real(r8) :: faltndc +real(r8) :: faltndnc +real(r8) :: faltndi +real(r8) :: faltndni +real(r8) :: faltnds +real(r8) :: faltndns +real(r8) :: faltndqie +real(r8) :: faltndqce +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +real(r8) :: relhum(pcols,pver) ! relative humidity +real(r8) :: csigma(pcols) ! parameter for cond/evap of cloud water/ice +real(r8) :: rgvm ! max fallspeed for all species +real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter +real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter +real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter +real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter +real(r8) :: nsubi(pver) ! evaporation of cloud ice number +real(r8) :: nsubc(pver) ! evaporation of droplet number +real(r8) :: nsubs(pver) ! evaporation of snow number +real(r8) :: nsubr(pver) ! evaporation of rain number +real(r8) :: mtime ! factor to account for droplet activation timescale +real(r8) :: dz(pcols,pver) ! height difference across model vertical level + + +!! add precip flux variables for sub-stepping +real(r8) :: rflx1(pcols,pver+1) +real(r8) :: sflx1(pcols,pver+1) + +! returns from function/subroutine calls +real(r8) :: tsp(pcols,pver) ! saturation temp (K) +real(r8) :: qsp(pcols,pver) ! saturation mixing ratio (kg/kg) +real(r8) :: qsphy(pcols,pver) ! saturation mixing ratio (kg/kg): hybrid rh +real(r8) :: qs(pcols) ! liquid-ice weighted sat mixing rat (kg/kg) +real(r8) :: es(pcols) ! liquid-ice weighted sat vapor press (pa) +real(r8) :: esl(pcols,pver) ! liquid sat vapor pressure (pa) +real(r8) :: esi(pcols,pver) ! ice sat vapor pressure (pa) + +! sum of source/sink terms for diagnostic precip + +real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term +real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term +real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term +real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term +real(r8) :: qrtot ! vertically-integrated rain mixing rat source/sink term +real(r8) :: nrtot ! vertically-integrated rain number conc source/sink term +real(r8) :: qstot ! vertically-integrated snow mixing rat source/sink term +real(r8) :: nstot ! vertically-integrated snow number conc source/sink term + +! new terms for Bergeron process + +real(r8) :: dumnnuc ! provisional ice nucleation rate (for calculating bergeron) +real(r8) :: ninew ! provisional cloud ice number conc (for calculating bergeron) +real(r8) :: qinew ! provisional cloud ice mixing ratio (for calculating bergeron) +real(r8) :: qvl ! liquid sat mixing ratio +real(r8) :: epsi ! 1/ sat relaxation timecale for cloud ice +real(r8) :: prd ! provisional deposition rate of cloud ice at water sat +real(r8) :: berg(pcols,pver) ! mixing rat tendency due to bergeron process for cloud ice +real(r8) :: bergs(pver) ! mixing rat tendency due to bergeron process for snow + +!bergeron terms +real(r8) :: bergtsf !bergeron timescale to remove all liquid +real(r8) :: rhin !modified RH for vapor deposition + +! diagnostic rain/snow for output to history +! values are in-precip (local) !!!! + +real(r8) :: drout(pcols,pver) ! rain diameter (m) + +!averageed rain/snow for history +real(r8) :: dumfice + +!ice nucleation, droplet activation +real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg) +real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg) +real(r8) :: ncmax +real(r8) :: nimax + +real(r8) :: qcvar ! 1/relative variance of sub-grid qc + +! loop array variables +integer i,k,nstep,n, l +integer ii,kk, m + +! loop variables for sub-step solution +integer iter,it,ltrue(pcols) + +! used in contact freezing via dust particles +real(r8) tcnt, viscosity, mfp +real(r8) slip1, slip2, slip3, slip4 +! real(r8) dfaer1, dfaer2, dfaer3, dfaer4 +! real(r8) nacon1,nacon2,nacon3,nacon4 +real(r8) ndfaer1, ndfaer2, ndfaer3, ndfaer4 +real(r8) nslip1, nslip2, nslip3, nslip4 + +! used in ice effective radius +real(r8) bbi, cci, ak, iciwc, rvi + +! used in Bergeron processe and water vapor deposition +real(r8) Tk, deles, Aprpr, Bprpr, Cice, qi0, Crate, qidep + +! mean cloud fraction over the time step +real(r8) cldmw(pcols,pver) + +! used in secondary ice production +real(r8) ni_secp + +! variabels to check for RH after rain evap + +real(r8) :: esn +real(r8) :: qsn +real(r8) :: ttmp + + + +real(r8) :: rainrt(pcols,pver) ! rain rate for reflectivity calculation +real(r8) :: rainrt1(pcols,pver) +real(r8) :: tmp + +real(r8) dmc,ssmc,dstrn ! variables for modal scheme. + +real(r8), parameter :: cdnl = 0.e6_r8 ! cloud droplet number limiter + +! heterogeneous freezing +real(r8) :: mnudep(pver) ! mixing ratio tendency due to deposition of water vapor +real(r8) :: nnudep(pver) ! number conc tendency due to deposition of water vapor +real(r8) :: con1 ! work cnstant +real(r8) :: r3lx ! Mean volume radius (m) +real(r8) :: mi0l +real(r8) :: frztmp + +logical :: do_clubb_sgs + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +! Return error message +errstring = ' ' + +call phys_getopts(do_clubb_sgs_out = do_clubb_sgs) + +! initialize output fields for number conc qand ice nucleation +ncai(1:ncol,1:pver)=0._r8 +ncal(1:ncol,1:pver)=0._r8 + +!Initialize rain size +rercld(1:ncol,1:pver)=0._r8 +arcld(1:ncol,1:pver)=0._r8 + +!initialize radiation output variables +pgamrad(1:ncol,1:pver)=0._r8 ! liquid gamma parameter for optics (radiation) +lamcrad(1:ncol,1:pver)=0._r8 ! slope of droplet distribution for optics (radiation) +deffi (1:ncol,1:pver)=0._r8 ! slope of droplet distribution for optics (radiation) +!initialize radiation output variables +!initialize water vapor tendency term output +qcsevap(1:ncol,1:pver)=0._r8 +qisevap(1:ncol,1:pver)=0._r8 +qvres (1:ncol,1:pver)=0._r8 +cmeiout (1:ncol,1:pver)=0._r8 +vtrmc (1:ncol,1:pver)=0._r8 +vtrmi (1:ncol,1:pver)=0._r8 +qcsedten (1:ncol,1:pver)=0._r8 +qisedten (1:ncol,1:pver)=0._r8 + +prao(1:ncol,1:pver)=0._r8 +prco(1:ncol,1:pver)=0._r8 +mnuccco(1:ncol,1:pver)=0._r8 +mnuccto(1:ncol,1:pver)=0._r8 +msacwio(1:ncol,1:pver)=0._r8 +psacwso(1:ncol,1:pver)=0._r8 +bergso(1:ncol,1:pver)=0._r8 +bergo(1:ncol,1:pver)=0._r8 +melto(1:ncol,1:pver)=0._r8 +homoo(1:ncol,1:pver)=0._r8 +qcreso(1:ncol,1:pver)=0._r8 +prcio(1:ncol,1:pver)=0._r8 +praio(1:ncol,1:pver)=0._r8 +qireso(1:ncol,1:pver)=0._r8 +mnuccro(1:ncol,1:pver)=0._r8 +pracso (1:ncol,1:pver)=0._r8 +meltsdt(1:ncol,1:pver)=0._r8 +frzrdt (1:ncol,1:pver)=0._r8 +mnuccdo(1:ncol,1:pver)=0._r8 + +rflx(:,:)=0._r8 +sflx(:,:)=0._r8 +effc(:,:)=0._r8 +effc_fn(:,:)=0._r8 +effi(:,:)=0._r8 + +! assign variable deltat for sub-stepping... +deltat=deltatin + +! parameters for scheme + +omsm=0.99999_r8 +dto2=0.5_r8*deltat +mincld=0.0001_r8 + +! initialize multi-level fields +q(1:ncol,1:pver)=qn(1:ncol,1:pver) +t(1:ncol,1:pver)=tn(1:ncol,1:pver) + +! initialize time-varying parameters + +do k=1,pver + do i=1,ncol + rho(i,k)=p(i,k)/(r*t(i,k)) + dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/p(i,k) + mu(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/(t(i,k)+120._r8) + sc(i,k) = mu(i,k)/(rho(i,k)*dv(i,k)) + kap(i,k) = 1.414e3_r8*1.496e-6_r8*t(i,k)**1.5_r8/(t(i,k)+120._r8) + + ! air density adjustment for fallspeed parameters + ! includes air density correction factor to the + ! power of 0.54 following Heymsfield and Bansemer 2007 + + rhof(i,k)=(rhosu/rho(i,k))**0.54_r8 + + arn(i,k)=ar*rhof(i,k) + asn(i,k)=as*rhof(i,k) + acn(i,k)=ac*rhof(i,k) + ain(i,k)=ai*rhof(i,k) + + ! get dz from dp and hydrostatic approx + ! keep dz positive (define as layer k-1 - layer k) + + dz(i,k)= pdel(i,k)/(rho(i,k)*g) + + end do +end do + +! initialization +qc(1:ncol,1:top_lev-1) = 0._r8 +qi(1:ncol,1:top_lev-1) = 0._r8 +nc(1:ncol,1:top_lev-1) = 0._r8 +ni(1:ncol,1:top_lev-1) = 0._r8 +t1(1:ncol,1:pver) = t(1:ncol,1:pver) +q1(1:ncol,1:pver) = q(1:ncol,1:pver) +qc1(1:ncol,1:pver) = qc(1:ncol,1:pver) +qi1(1:ncol,1:pver) = qi(1:ncol,1:pver) +nc1(1:ncol,1:pver) = nc(1:ncol,1:pver) +ni1(1:ncol,1:pver) = ni(1:ncol,1:pver) + +! initialize tendencies to zero +tlat1(1:ncol,1:pver)=0._r8 +qvlat1(1:ncol,1:pver)=0._r8 +qctend1(1:ncol,1:pver)=0._r8 +qitend1(1:ncol,1:pver)=0._r8 +nctend1(1:ncol,1:pver)=0._r8 +nitend1(1:ncol,1:pver)=0._r8 + +! initialize precip output +qrout(1:ncol,1:pver)=0._r8 +qsout(1:ncol,1:pver)=0._r8 +nrout(1:ncol,1:pver)=0._r8 +nsout(1:ncol,1:pver)=0._r8 +dsout(1:ncol,1:pver)=0._r8 + +drout(1:ncol,1:pver)=0._r8 + +reff_rain(1:ncol,1:pver)=0._r8 +reff_snow(1:ncol,1:pver)=0._r8 + +! initialize variables for trop_mozart +nevapr(1:ncol,1:pver) = 0._r8 +nevapr2(1:ncol,1:pver) = 0._r8 +evapsnow(1:ncol,1:pver) = 0._r8 +prain(1:ncol,1:pver) = 0._r8 +prodsnow(1:ncol,1:pver) = 0._r8 +cmeout(1:ncol,1:pver) = 0._r8 + +am_evp_st(1:ncol,1:pver) = 0._r8 + +! for refl calc +rainrt1(1:ncol,1:pver) = 0._r8 + +! initialize precip fraction and output tendencies +cldmax(1:ncol,1:pver)=mincld + +!initialize aerosol number +! naer2(1:ncol,1:pver,:)=0._r8 +dum2l(1:ncol,1:pver)=0._r8 +dum2i(1:ncol,1:pver)=0._r8 + +! initialize avg precip rate +prect1(1:ncol)=0._r8 +preci1(1:ncol)=0._r8 + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!Get humidity and saturation vapor pressures + +do k=top_lev,pver + + do i=1,ncol + + ! find wet bulk temperature and saturation value for provisional t and q without + ! condensation + + es(i) = svp_water(t(i,k)) + qs(i) = svp_to_qsat(es(i), p(i,k)) + + ! Prevents negative values. + if (qs(i) < 0.0_r8) then + qs(i) = 1.0_r8 + es(i) = p(i,k) + end if + + esl(i,k)=svp_water(t(i,k)) + esi(i,k)=svp_ice(t(i,k)) + + ! hm fix, make sure when above freezing that esi=esl, not active yet + if (t(i,k).gt.tmelt)esi(i,k)=esl(i,k) + + relhum(i,k)=q(i,k)/qs(i) + + ! get cloud fraction, check for minimum + + cldm(i,k)=max(cldn(i,k),mincld) + cldmw(i,k)=max(cldn(i,k),mincld) + + icldm(i,k)=max(icecldf(i,k),mincld) + lcldm(i,k)=max(liqcldf(i,k),mincld) + + ! subcolumns, set cloud fraction variables to one + ! if cloud water or ice is present, if not present + ! set to mincld (mincld used instead of zero, to prevent + ! possible division by zero errors + + if (microp_uniform) then + + cldm(i,k)=mincld + cldmw(i,k)=mincld + icldm(i,k)=mincld + lcldm(i,k)=mincld + + if (qc(i,k).ge.qsmall) then + lcldm(i,k)=1._r8 + cldm(i,k)=1._r8 + cldmw(i,k)=1._r8 + end if + + if (qi(i,k).ge.qsmall) then + cldm(i,k)=1._r8 + icldm(i,k)=1._r8 + end if + + end if ! sub-columns + + ! calculate nfice based on liquid and ice mmr (no rain and snow mmr available yet) + + nfice(i,k)=0._r8 + dumfice=qc(i,k)+qi(i,k) + if (dumfice.gt.qsmall .and. qi(i,k).gt.qsmall) then + nfice(i,k)=qi(i,k)/dumfice + endif + + if (do_cldice .and. (t(i,k).lt.tmelt - 5._r8)) then + + ! if aerosols interact with ice set number of activated ice nuclei + dum2=naai(i,k) + + dumnnuc=(dum2-ni(i,k)/icldm(i,k))/deltat*icldm(i,k) + dumnnuc=max(dumnnuc,0._r8) + ! get provisional ni and qi after nucleation in order to calculate + ! Bergeron process below + ninew=ni(i,k)+dumnnuc*deltat + qinew=qi(i,k)+dumnnuc*deltat*mi0 + + !T>268 + else + ninew=ni(i,k) + qinew=qi(i,k) + end if + + ! Initialize CME components + + cme(i,k) = 0._r8 + cmei(i,k)=0._r8 + + + !------------------------------------------------------------------- + !Bergeron process + + ! make sure to initialize bergeron process to zero + berg(i,k)=0._r8 + prd = 0._r8 + + !condensation loop. + + ! get in-cloud qi and ni after nucleation + if (icldm(i,k) .gt. 0._r8) then + qiic(i,k)=qinew/icldm(i,k) + niic(i,k)=ninew/icldm(i,k) + else + qiic(i,k)=0._r8 + niic(i,k)=0._r8 + endif + + if (nicons) then + niic(i,k) = ninst/rho(i,k) + end if + + !if T < 0 C then bergeron. + if (do_cldice .and. (t(i,k).lt.273.15_r8)) then + + !if ice exists + if (qi(i,k).gt.qsmall) then + + bergtsf = 0._r8 ! bergeron time scale (fraction of timestep) + + qvi = svp_to_qsat(esi(i,k), p(i,k)) + qvl = svp_to_qsat(esl(i,k), p(i,k)) + + dqsidt = xxls*qvi/(rv*t(i,k)**2) + abi = 1._r8+dqsidt*xxls/cpp + + ! get ice size distribution parameters + + if (qiic(i,k).ge.qsmall) then + lami(k) = (cons1*ci* & + niic(i,k)/qiic(i,k))**(1._r8/di) + n0i(k) = niic(i,k)*lami(k) + + ! check for slope + ! adjust vars + if (lami(k).lt.lammini) then + + lami(k) = lammini + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + else if (lami(k).gt.lammaxi) then + lami(k) = lammaxi + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + end if + + epsi = 2._r8*pi*n0i(k)*rho(i,k)*Dv(i,k)/(lami(k)*lami(k)) + + !if liquid exists + if (qc(i,k).gt. qsmall) then + + !begin bergeron process + ! do bergeron (vapor deposition with RHw=1) + ! code to find berg (a rate) goes here + + ! calculate Bergeron process + + prd = epsi*(qvl-qvi)/abi + + else + prd = 0._r8 + end if + + ! multiply by cloud fraction + + prd = prd*min(icldm(i,k),lcldm(i,k)) + + ! transfer of existing cloud liquid to ice + + berg(i,k)=max(0._r8,prd) + + end if !end liquid exists bergeron + + if (berg(i,k).gt.0._r8) then + bergtsf=max(0._r8,(qc(i,k)/berg(i,k))/deltat) + + if(bergtsf.lt.1._r8) berg(i,k) = max(0._r8,qc(i,k)/deltat) + + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (bergtsf.lt.1._r8.or.icldm(i,k).gt.lcldm(i,k)) then + + if (qiic(i,k).ge.qsmall) then + + ! first case is for case when liquid water is present, but is completely depleted + ! in time step, i.e., bergrsf > 0 but < 1 + + if (qc(i,k).ge.qsmall) then + rhin = (1.0_r8 + relhum(i,k)) / 2._r8 + if ((rhin*esl(i,k)/esi(i,k)) > 1._r8) then + prd = epsi*(rhin*qvl-qvi)/abi + + ! multiply by cloud fraction assuming liquid/ice maximum overlap + prd = prd*min(icldm(i,k),lcldm(i,k)) + + ! add to cmei + cmei(i,k) = cmei(i,k) + (prd * (1._r8- bergtsf)) + + end if ! rhin + end if ! qc > qsmall + + ! second case is for pure ice cloud, either no liquid, or icldm > lcldm + + if (qc(i,k).lt.qsmall.or.icldm(i,k).gt.lcldm(i,k)) then + + ! note: for case of no liquid, need to set liquid cloud fraction to zero + ! store liquid cloud fraction in 'dum' + + if (qc(i,k).lt.qsmall) then + dum=0._r8 + else + dum=lcldm(i,k) + end if + + ! set RH to grid-mean value for pure ice cloud + rhin = relhum(i,k) + + if ((rhin*esl(i,k)/esi(i,k)) > 1._r8) then + + prd = epsi*(rhin*qvl-qvi)/abi + + ! multiply by relevant cloud fraction for pure ice cloud + ! assuming maximum overlap of liquid/ice + prd = prd*max((icldm(i,k)-dum),0._r8) + cmei(i,k) = cmei(i,k) + prd + + end if ! rhin + end if ! qc or icldm > lcldm + end if ! qiic + end if ! bergtsf or icldm > lcldm + + ! if deposition, it should not reduce grid mean rhi below 1.0 + if(cmei(i,k) > 0.0_r8 .and. (relhum(i,k)*esl(i,k)/esi(i,k)) > 1._r8 ) & + cmei(i,k)=min(cmei(i,k),(q(i,k)-qs(i)*esi(i,k)/esl(i,k))/abi/deltat) + + end if !end ice exists loop + !this ends temperature < 0. loop + + !------------------------------------------------------------------- + end if ! + !.............................................................. + + ! evaporation should not exceed available water + + if ((-berg(i,k)).lt.-qc(i,k)/deltat) berg(i,k) = max(qc(i,k)/deltat,0._r8) + + !sublimation process... + if (do_cldice .and. ((relhum(i,k)*esl(i,k)/esi(i,k)).lt.1._r8 .and. qiic(i,k).ge.qsmall )) then + + qvi = svp_to_qsat(esi(i,k), p(i,k)) + qvl = svp_to_qsat(esl(i,k), p(i,k)) + dqsidt = xxls*qvi/(rv*t(i,k)**2) + abi = 1._r8+dqsidt*xxls/cpp + + ! get ice size distribution parameters + + lami(k) = (cons1*ci* & + niic(i,k)/qiic(i,k))**(1._r8/di) + n0i(k) = niic(i,k)*lami(k) + + ! check for slope + ! adjust vars + if (lami(k).lt.lammini) then + + lami(k) = lammini + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + else if (lami(k).gt.lammaxi) then + lami(k) = lammaxi + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + end if + + epsi = 2._r8*pi*n0i(k)*rho(i,k)*Dv(i,k)/(lami(k)*lami(k)) + + ! modify for ice fraction below + prd = epsi*(relhum(i,k)*qvl-qvi)/abi * icldm(i,k) + cmei(i,k)=min(prd,0._r8) + + endif + + ! sublimation should not exceed available ice + if (cmei(i,k).lt.-qi(i,k)/deltat) cmei(i,k)=-qi(i,k)/deltat + + ! sublimation should not increase grid mean rhi above 1.0 + if(cmei(i,k) < 0.0_r8 .and. (relhum(i,k)*esl(i,k)/esi(i,k)) < 1._r8 ) & + cmei(i,k)=min(0._r8,max(cmei(i,k),(q(i,k)-qs(i)*esi(i,k)/esl(i,k))/abi/deltat)) + + ! limit cmei due for roundoff error + + cmei(i,k)=cmei(i,k)*omsm + + ! conditional for ice nucleation + if (do_cldice .and. (t(i,k).lt.(tmelt - 5._r8))) then + + ! using Liu et al. (2007) ice nucleation with hooks into simulated aerosol + ! ice nucleation rate (dum2) has already been calculated and read in (naai) + + dum2i(i,k)=naai(i,k) + else + dum2i(i,k)=0._r8 + end if + + end do ! i loop +end do ! k loop + + +!! initialize sub-step precip flux variables +do i=1,ncol + !! flux is zero at top interface, so these should stay as 0. + rflx1(i,1)=0._r8 + sflx1(i,1)=0._r8 + do k=top_lev,pver + + ! initialize normal and sub-step precip flux variables + rflx1(i,k+1)=0._r8 + sflx1(i,k+1)=0._r8 + end do ! i loop +end do ! k loop +!! initialize final precip flux variables. +do i=1,ncol + !! flux is zero at top interface, so these should stay as 0. + rflx(i,1)=0._r8 + sflx(i,1)=0._r8 + do k=top_lev,pver + ! initialize normal and sub-step precip flux variables + rflx(i,k+1)=0._r8 + sflx(i,k+1)=0._r8 + end do ! i loop +end do ! k loop + +do i=1,ncol + ltrue(i)=0 + do k=top_lev,pver + ! skip microphysical calculations if no cloud water + + if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1 + end do +end do + +! assign number of sub-steps to iter +! use 2 sub-steps, following tests described in MG2008 +iter = 2 + +! get sub-step time step +deltat=deltat/real(iter) + +! since activation/nucleation processes are fast, need to take into account +! factor mtime = mixing timescale in cloud / model time step +! mixing time can be interpreted as cloud depth divided by sub-grid vertical velocity +! for now mixing timescale is assumed to be 1 timestep for modal aerosols, 20 min bulk + +! note: mtime for bulk aerosols was set to: mtime=deltat/1200._r8 + +mtime=1._r8 +rate1ord_cw2pr_st(:,:)=0._r8 ! rce 2010/05/01 + +!!!! skip calculations if no cloud water +do i=1,ncol + if (ltrue(i).eq.0) then + tlat(i,1:pver)=0._r8 + qvlat(i,1:pver)=0._r8 + qctend(i,1:pver)=0._r8 + qitend(i,1:pver)=0._r8 + qnitend(i,1:pver)=0._r8 + qrtend(i,1:pver)=0._r8 + nctend(i,1:pver)=0._r8 + nitend(i,1:pver)=0._r8 + nrtend(i,1:pver)=0._r8 + nstend(i,1:pver)=0._r8 + prect(i)=0._r8 + preci(i)=0._r8 + rflx(i,1:pver+1)=0._r8 + sflx(i,1:pver+1)=0._r8 + qniic(i,1:pver)=0._r8 + qric(i,1:pver)=0._r8 + nsic(i,1:pver)=0._r8 + nric(i,1:pver)=0._r8 + rainrt(i,1:pver)=0._r8 + goto 300 + end if + + qcsinksum_rate1ord(1:pver)=0._r8 + qcsum_rate1ord(1:pver)=0._r8 + + +!!!!!!!!! begin sub-step!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !..................................................................................................... + do it=1,iter + + ! initialize sub-step microphysical tendencies + + tlat(i,1:pver)=0._r8 + qvlat(i,1:pver)=0._r8 + qctend(i,1:pver)=0._r8 + qitend(i,1:pver)=0._r8 + qnitend(i,1:pver)=0._r8 + qrtend(i,1:pver)=0._r8 + nctend(i,1:pver)=0._r8 + nitend(i,1:pver)=0._r8 + nrtend(i,1:pver)=0._r8 + nstend(i,1:pver)=0._r8 + + ! initialize diagnostic precipitation to zero + + qniic(i,1:pver)=0._r8 + qric(i,1:pver)=0._r8 + nsic(i,1:pver)=0._r8 + nric(i,1:pver)=0._r8 + + rainrt(i,1:pver)=0._r8 + + + ! begin new i,k loop, calculate new cldmax after adjustment to cldm above + + ! initialize vertically-integrated rain and snow tendencies + + qrtot = 0._r8 + nrtot = 0._r8 + qstot = 0._r8 + nstot = 0._r8 + + ! initialize precip at surface + + prect(i)=0._r8 + preci(i)=0._r8 + + ! initialize fluxes + rflx(i,1:pver+1)=0._r8 + sflx(i,1:pver+1)=0._r8 + + do k=top_lev,pver + + qcvar=relvar(i,k) + cons2=gamma(qcvar+2.47_r8) + cons3=gamma(qcvar) + cons9=gamma(qcvar+2._r8) + cons10=gamma(qcvar+1._r8) + cons12=gamma(qcvar+1.15_r8) + cons15=gamma(qcvar+bc/3._r8) + cons18=qcvar**2.47_r8 + cons19=qcvar**2 + cons20=qcvar**1.15_r8 + + ! set cwml and cwmi to current qc and qi + + cwml(i,k)=qc(i,k) + cwmi(i,k)=qi(i,k) + + ! initialize precip fallspeeds to zero + + ums(k)=0._r8 + uns(k)=0._r8 + umr(k)=0._r8 + unr(k)=0._r8 + + ! calculate precip fraction based on maximum overlap assumption + + ! for sub-columns cldm has already been set to 1 if cloud + ! water or ice is present, so cldmax will be correctly set below + ! and nothing extra needs to be done here + + if (k.eq.top_lev) then + cldmax(i,k)=cldm(i,k) + else + ! if rain or snow mix ratio is smaller than + ! threshold, then set cldmax to cloud fraction at current level + + if (do_clubb_sgs) then + if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall) then + cldmax(i,k)=cldm(i,k) + else + cldmax(i,k)=cldmax(i,k-1) + end if + else + + if (qric(i,k-1).ge.qsmall.or.qniic(i,k-1).ge.qsmall) then + cldmax(i,k)=max(cldmax(i,k-1),cldm(i,k)) + else + cldmax(i,k)=cldm(i,k) + end if + endif + end if + + ! decrease in number concentration due to sublimation/evap + ! divide by cloud fraction to get in-cloud decrease + ! don't reduce Nc due to bergeron process + + if (cmei(i,k) < 0._r8 .and. qi(i,k) > qsmall .and. cldm(i,k) > mincld) then + nsubi(k)=cmei(i,k)/qi(i,k)*ni(i,k)/cldm(i,k) + else + nsubi(k)=0._r8 + end if + nsubc(k)=0._r8 + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! ice nucleation if activated nuclei exist at t<-5C AND rhmini + 5% + + if (do_cldice .and. dum2i(i,k).gt.0._r8.and.t(i,k).lt.(tmelt - 5._r8).and. & + relhum(i,k)*esl(i,k)/esi(i,k).gt. rhmini+0.05_r8) then + + !if NCAI > 0. then set numice = ncai (as before) + !note: this is gridbox averaged + + nnuccd(k)=(dum2i(i,k)-ni(i,k)/icldm(i,k))/deltat*icldm(i,k) + nnuccd(k)=max(nnuccd(k),0._r8) + nimax = dum2i(i,k)*icldm(i,k) + + !Calc mass of new particles using new crystal mass... + !also this will be multiplied by mtime as nnuccd is... + + mnuccd(k) = nnuccd(k) * mi0 + + ! add mnuccd to cmei.... + cmei(i,k)= cmei(i,k) + mnuccd(k) * mtime + + ! limit cmei + + qvi = svp_to_qsat(esi(i,k), p(i,k)) + dqsidt = xxls*qvi/(rv*t(i,k)**2) + abi = 1._r8+dqsidt*xxls/cpp + cmei(i,k)=min(cmei(i,k),(q(i,k)-qvi)/abi/deltat) + + ! limit for roundoff error + cmei(i,k)=cmei(i,k)*omsm + + else + nnuccd(k)=0._r8 + nimax = 0._r8 + mnuccd(k) = 0._r8 + end if + + !c............................................................................ + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations + ! for microphysical process calculations + ! units are kg/kg for mixing ratio, 1/kg for number conc + + ! limit in-cloud values to 0.005 kg/kg + + qcic(i,k)=min(cwml(i,k)/lcldm(i,k),5.e-3_r8) + qiic(i,k)=min(cwmi(i,k)/icldm(i,k),5.e-3_r8) + ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8) + niic(i,k)=max(ni(i,k)/icldm(i,k),0._r8) + + if (nccons) then + ncic(i,k) = ncnst/rho(i,k) + end if + if (nicons) then + niic(i,k) = ninst/rho(i,k) + end if + + if (qc(i,k) - berg(i,k)*deltat.lt.qsmall) then + qcic(i,k)=0._r8 + ncic(i,k)=0._r8 + if (qc(i,k)-berg(i,k)*deltat.lt.0._r8) then + berg(i,k)=qc(i,k)/deltat*omsm + end if + end if + + if (do_cldice .and. qi(i,k)+(cmei(i,k)+berg(i,k))*deltat.lt.qsmall) then + qiic(i,k)=0._r8 + niic(i,k)=0._r8 + if (qi(i,k)+(cmei(i,k)+berg(i,k))*deltat.lt.0._r8) then + cmei(i,k)=(-qi(i,k)/deltat-berg(i,k))*omsm + end if + end if + + ! add to cme output + + cmeout(i,k) = cmeout(i,k)+cmei(i,k) + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! droplet activation + ! calculate potential for droplet activation if cloud water is present + ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98 + ! number tendency (npccnin) is read in from companion routine + + ! assume aerosols already activated are equal to number of existing droplets for simplicity + ! multiply by cloud fraction to obtain grid-average tendency + + if (qcic(i,k).ge.qsmall) then + npccn(k) = max(0._r8,npccnin(i,k)) + dum2l(i,k)=(nc(i,k)+npccn(k)*deltat)/lcldm(i,k) + dum2l(i,k)=max(dum2l(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3 + ncmax = dum2l(i,k)*lcldm(i,k) + else + npccn(k)=0._r8 + dum2l(i,k)=0._r8 + ncmax = 0._r8 + end if + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get size distribution parameters based on in-cloud cloud water/ice + ! these calculations also ensure consistency between number and mixing ratio + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + !...................................................................... + ! cloud ice + + if (qiic(i,k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8) + + lami(k) = (cons1*ci*niic(i,k)/qiic(i,k))**(1._r8/di) + n0i(k) = niic(i,k)*lami(k) + + ! check for slope + ! adjust vars + + if (lami(k).lt.lammini) then + + lami(k) = lammini + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + niic(i,k) = n0i(k)/lami(k) + else if (lami(k).gt.lammaxi) then + lami(k) = lammaxi + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1) + niic(i,k) = n0i(k)/lami(k) + end if + + else + lami(k) = 0._r8 + n0i(k) = 0._r8 + end if + + if (qcic(i,k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8) + + ncic(i,k)=max(ncic(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm + + ! get pgam from fit to observations of martin et al. 1994 + + pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8 + pgam(k)=1._r8/(pgam(k)**2)-1._r8 + pgam(k)=max(pgam(k),2._r8) + pgam(k)=min(pgam(k),15._r8) + + ! calculate lamc + + lamc(k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(k)+4._r8)/ & + (qcic(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8) + + ! lammin, 50 micron diameter max mean size + + lammin = (pgam(k)+1._r8)/50.e-6_r8 + lammax = (pgam(k)+1._r8)/2.e-6_r8 + + if (lamc(k).lt.lammin) then + lamc(k) = lammin + ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* & + gamma(pgam(k)+1._r8)/(pi*rhow*gamma(pgam(k)+4._r8)) + else if (lamc(k).gt.lammax) then + lamc(k) = lammax + ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* & + gamma(pgam(k)+1._r8)/(pi*rhow*gamma(pgam(k)+4._r8)) + end if + + ! parameter to calculate droplet freezing + + cdist1(k) = ncic(i,k)/gamma(pgam(k)+1._r8) + + else + lamc(k) = 0._r8 + cdist1(k) = 0._r8 + end if + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! begin micropysical process calculations + !................................................................. + ! autoconversion of cloud liquid water to rain + ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc + ! minimum qc of 1 x 10^-8 prevents floating point error + + if (qcic(i,k).ge.1.e-8_r8) then + + ! nprc is increase in rain number conc due to autoconversion + ! nprc1 is decrease in cloud droplet conc due to autoconversion + + ! assume exponential sub-grid distribution of qc, resulting in additional + ! factor related to qcvar below + + ! hm switch for sub-columns, don't include sub-grid qc + if (microp_uniform) then + + prc(k) = 1350._r8*qcic(i,k)**2.47_r8* & + (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8) + nprc(k) = prc(k)/(4._r8/3._r8*pi*rhow*(25.e-6_r8)**3) + nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k)) + + else + + prc(k) = cons2/(cons3*cons18)*1350._r8*qcic(i,k)**2.47_r8* & + (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8) + nprc(k) = prc(k)/cons22 + nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k)) + + end if ! sub-column switch + + else + prc(k)=0._r8 + nprc(k)=0._r8 + nprc1(k)=0._r8 + end if + + ! add autoconversion to precip from above to get provisional rain mixing ratio + ! and number concentration (qric and nric) + + ! 0.45 m/s is fallspeed of new rain drop (80 micron diameter) + + dum=0.45_r8 + dum1=0.45_r8 + + if (k.eq.top_lev) then + qric(i,k)=prc(k)*lcldm(i,k)*dz(i,k)/cldmax(i,k)/dum + nric(i,k)=nprc(k)*lcldm(i,k)*dz(i,k)/cldmax(i,k)/dum + else + if (qric(i,k-1).ge.qsmall) then + dum=umr(k-1) + dum1=unr(k-1) + end if + + ! no autoconversion of rain number if rain/snow falling from above + ! this assumes that new drizzle drops formed by autoconversion are rapidly collected + ! by the existing rain/snow particles from above + + if (qric(i,k-1).ge.1.e-9_r8.or.qniic(i,k-1).ge.1.e-9_r8) then + nprc(k)=0._r8 + end if + + qric(i,k) = (rho(i,k-1)*umr(k-1)*qric(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*((pra(k-1)+prc(k))*lcldm(i,k)+(pre(k-1)-pracs(k-1)-mnuccr(k-1))*cldmax(i,k))))& + /(dum*rho(i,k)*cldmax(i,k)) + nric(i,k) = (rho(i,k-1)*unr(k-1)*nric(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*(nprc(k)*lcldm(i,k)+(nsubr(k-1)-npracs(k-1)-nnuccr(k-1)+nragg(k-1))*cldmax(i,k))))& + /(dum1*rho(i,k)*cldmax(i,k)) + + end if + + !....................................................................... + ! Autoconversion of cloud ice to snow + ! similar to Ferrier (1994) + + if (do_cldice) then + if (t(i,k).le.273.15_r8.and.qiic(i,k).ge.qsmall) then + + ! note: assumes autoconversion timescale of 180 sec + + nprci(k) = n0i(k)/(lami(k)*180._r8)*exp(-lami(k)*dcs) + + prci(k) = pi*rhoi*n0i(k)/(6._r8*180._r8)* & + (cons23/lami(k)+3._r8*cons24/lami(k)**2+ & + 6._r8*dcs/lami(k)**3+6._r8/lami(k)**4)*exp(-lami(k)*dcs) + else + prci(k)=0._r8 + nprci(k)=0._r8 + end if + else + ! Add in the particles that we have already converted to snow, and + ! don't do any further autoconversion of ice. + prci(k) = tnd_qsnow(i, k) / cldm(i,k) + nprci(k) = tnd_nsnow(i, k) / cldm(i,k) + end if + + ! add autoconversion to flux from level above to get provisional snow mixing ratio + ! and number concentration (qniic and nsic) + + dum=(asn(i,k)*cons25) + dum1=(asn(i,k)*cons25) + + if (k.eq.top_lev) then + qniic(i,k)=prci(k)*icldm(i,k)*dz(i,k)/cldmax(i,k)/dum + nsic(i,k)=nprci(k)*icldm(i,k)*dz(i,k)/cldmax(i,k)/dum + else + if (qniic(i,k-1).ge.qsmall) then + dum=ums(k-1) + dum1=uns(k-1) + end if + + qniic(i,k) = (rho(i,k-1)*ums(k-1)*qniic(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*((prci(k)+prai(k-1)+psacws(k-1)+bergs(k-1))*icldm(i,k)+(prds(k-1)+ & + pracs(k-1)+mnuccr(k-1))*cldmax(i,k))))& + /(dum*rho(i,k)*cldmax(i,k)) + + nsic(i,k) = (rho(i,k-1)*uns(k-1)*nsic(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*(nprci(k)*icldm(i,k)+(nsubs(k-1)+nsagg(k-1)+nnuccr(k-1))*cldmax(i,k))))& + /(dum1*rho(i,k)*cldmax(i,k)) + + end if + + ! if precip mix ratio is zero so should number concentration + + if (qniic(i,k).lt.qsmall) then + qniic(i,k)=0._r8 + nsic(i,k)=0._r8 + end if + + if (qric(i,k).lt.qsmall) then + qric(i,k)=0._r8 + nric(i,k)=0._r8 + end if + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + + nric(i,k)=max(nric(i,k),0._r8) + nsic(i,k)=max(nsic(i,k),0._r8) + + !....................................................................... + ! get size distribution parameters for precip + !...................................................................... + ! rain + + if (qric(i,k).ge.qsmall) then + lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8) + n0r(k) = nric(i,k)*lamr(k) + + ! check for slope + ! adjust vars + + if (lamr(k).lt.lamminr) then + + lamr(k) = lamminr + + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + else if (lamr(k).gt.lammaxr) then + lamr(k) = lammaxr + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + end if + + ! provisional rain number and mass weighted mean fallspeed (m/s) + + unr(k) = min(arn(i,k)*cons4/lamr(k)**br,9.1_r8*rhof(i,k)) + umr(k) = min(arn(i,k)*cons5/(6._r8*lamr(k)**br),9.1_r8*rhof(i,k)) + + else + lamr(k) = 0._r8 + n0r(k) = 0._r8 + umr(k) = 0._r8 + unr(k) = 0._r8 + end if + + !...................................................................... + ! snow + + if (qniic(i,k).ge.qsmall) then + lams(k) = (cons6*cs*nsic(i,k)/qniic(i,k))**(1._r8/ds) + n0s(k) = nsic(i,k)*lams(k) + + ! check for slope + ! adjust vars + + if (lams(k).lt.lammins) then + lams(k) = lammins + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6) + nsic(i,k) = n0s(k)/lams(k) + + else if (lams(k).gt.lammaxs) then + lams(k) = lammaxs + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6) + nsic(i,k) = n0s(k)/lams(k) + end if + + ! provisional snow number and mass weighted mean fallspeed (m/s) + + ums(k) = min(asn(i,k)*cons8/(6._r8*lams(k)**bs),1.2_r8*rhof(i,k)) + uns(k) = min(asn(i,k)*cons7/lams(k)**bs,1.2_r8*rhof(i,k)) + + else + lams(k) = 0._r8 + n0s(k) = 0._r8 + ums(k) = 0._r8 + uns(k) = 0._r8 + end if + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! heterogeneous freezing of cloud water + + if (.not. use_hetfrz_classnuc) then + + if (do_cldice .and. qcic(i,k).ge.qsmall .and. t(i,k).lt.269.15_r8) then + + ! immersion freezing (Bigg, 1953) + + + ! subcolumns + + if (microp_uniform) then + + mnuccc(k) = & + pi*pi/36._r8*rhow* & + cdist1(k)*gamma(7._r8+pgam(k))* & + bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ & + lamc(k)**3/lamc(k)**3 + + nnuccc(k) = & + pi/6._r8*cdist1(k)*gamma(pgam(k)+4._r8) & + *bimm* & + (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(k)**3 + + else + + mnuccc(k) = cons9/(cons3*cons19)* & + pi*pi/36._r8*rhow* & + cdist1(k)*gamma(7._r8+pgam(k))* & + bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ & + lamc(k)**3/lamc(k)**3 + + nnuccc(k) = cons10/(cons3*qcvar)* & + pi/6._r8*cdist1(k)*gamma(pgam(k)+4._r8) & + *bimm* & + (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(k)**3 + end if ! sub-columns + + + ! contact freezing (-40= qsmall) then + con1 = 1._r8/(1.333_r8*pi)**0.333_r8 + r3lx = con1*(rho(i,k)*qcic(i,k)/(rhow*max(ncic(i,k)*rho(i,k), 1.0e6_r8)))**0.333_r8 ! in m + r3lx = max(4.e-6_r8, r3lx) + mi0l = 4._r8/3._r8*pi*rhow*r3lx**3_r8 + + nnuccc(k) = frzimm(i,k)*1.0e6_r8/rho(i,k) + mnuccc(k) = nnuccc(k)*mi0l + + nnucct(k) = frzcnt(i,k)*1.0e6_r8/rho(i,k) + mnucct(k) = nnucct(k)*mi0l + + nnudep(k) = frzdep(i,k)*1.0e6_r8/rho(i,k) + mnudep(k) = nnudep(k)*mi0 + else + nnuccc(k) = 0._r8 + mnuccc(k) = 0._r8 + + nnucct(k) = 0._r8 + mnucct(k) = 0._r8 + + nnudep(k) = 0._r8 + mnudep(k) = 0._r8 + end if + endif + + + !....................................................................... + ! snow self-aggregation from passarelli, 1978, used by reisner, 1998 + ! this is hard-wired for bs = 0.4 for now + ! ignore self-collection of cloud ice + + if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8) then + nsagg(k) = -1108._r8*asn(i,k)*Eii* & + pi**((1._r8-bs)/3._r8)*rhosn**((-2._r8-bs)/3._r8)*rho(i,k)** & + ((2._r8+bs)/3._r8)*qniic(i,k)**((2._r8+bs)/3._r8)* & + (nsic(i,k)*rho(i,k))**((4._r8-bs)/3._r8)/ & + (4._r8*720._r8*rho(i,k)) + else + nsagg(k)=0._r8 + end if + + !....................................................................... + ! accretion of cloud droplets onto snow/graupel + ! here use continuous collection equation with + ! simple gravitational collection kernel + ! ignore collisions between droplets/cloud ice + ! since minimum size ice particle for accretion is 50 - 150 micron + + ! ignore collision of snow with droplets above freezing + + if (qniic(i,k).ge.qsmall .and. t(i,k).le.tmelt .and. & + qcic(i,k).ge.qsmall) then + + ! put in size dependent collection efficiency + ! mean diameter of snow is area-weighted, since + ! accretion is function of crystal geometric area + ! collection efficiency is approximation based on stoke's law (Thompson et al. 2004) + + dc0 = (pgam(k)+1._r8)/lamc(k) + ds0 = 1._r8/lams(k) + dum = dc0*dc0*uns(k)*rhow/(9._r8*mu(i,k)*ds0) + eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8)) + + eci = max(eci,0._r8) + eci = min(eci,1._r8) + + + ! no impact of sub-grid distribution of qc since psacws + ! is linear in qc + + psacws(k) = pi/4._r8*asn(i,k)*qcic(i,k)*rho(i,k)* & + n0s(k)*Eci*cons11/ & + lams(k)**(bs+3._r8) + npsacws(k) = pi/4._r8*asn(i,k)*ncic(i,k)*rho(i,k)* & + n0s(k)*Eci*cons11/ & + lams(k)**(bs+3._r8) + else + psacws(k)=0._r8 + npsacws(k)=0._r8 + end if + + ! add secondary ice production due to accretion of droplets by snow + ! (Hallet-Mossop process) (from Cotton et al., 1986) + + if (.not. do_cldice) then + ni_secp = 0.0_r8 + nsacwi(k) = 0.0_r8 + msacwi(k) = 0.0_r8 + else if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.268.16_r8)) then + ni_secp = 3.5e8_r8*(270.16_r8-t(i,k))/2.0_r8*psacws(k) + nsacwi(k) = ni_secp + msacwi(k) = min(ni_secp*mi0,psacws(k)) + else if((t(i,k).lt.268.16_r8) .and. (t(i,k).ge.265.16_r8)) then + ni_secp = 3.5e8_r8*(t(i,k)-265.16_r8)/3.0_r8*psacws(k) + nsacwi(k) = ni_secp + msacwi(k) = min(ni_secp*mi0,psacws(k)) + else + ni_secp = 0.0_r8 + nsacwi(k) = 0.0_r8 + msacwi(k) = 0.0_r8 + endif + psacws(k) = max(0.0_r8,psacws(k)-ni_secp*mi0) + + !....................................................................... + ! accretion of rain water by snow + ! formula from ikawa and saito, 1991, used by reisner et al., 1998 + + if (qric(i,k).ge.1.e-8_r8 .and. qniic(i,k).ge.1.e-8_r8 .and. & + t(i,k).le.273.15_r8) then + + pracs(k) = pi*pi*ecr*(((1.2_r8*umr(k)-0.95_r8*ums(k))**2+ & + 0.08_r8*ums(k)*umr(k))**0.5_r8*rhow*rho(i,k)* & + n0r(k)*n0s(k)* & + (5._r8/(lamr(k)**6*lams(k))+ & + 2._r8/(lamr(k)**5*lams(k)**2)+ & + 0.5_r8/(lamr(k)**4*lams(k)**3))) + + npracs(k) = pi/2._r8*rho(i,k)*ecr*(1.7_r8*(unr(k)-uns(k))**2+ & + 0.3_r8*unr(k)*uns(k))**0.5_r8*n0r(k)*n0s(k)* & + (1._r8/(lamr(k)**3*lams(k))+ & + 1._r8/(lamr(k)**2*lams(k)**2)+ & + 1._r8/(lamr(k)*lams(k)**3)) + + else + pracs(k)=0._r8 + npracs(k)=0._r8 + end if + + !....................................................................... + ! heterogeneous freezing of rain drops + ! follows from Bigg (1953) + + if (t(i,k).lt.269.15_r8 .and. qric(i,k).ge.qsmall) then + + mnuccr(k) = 20._r8*pi*pi*rhow*nric(i,k)*bimm* & + (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamr(k)**3 & + /lamr(k)**3 + + nnuccr(k) = pi*nric(i,k)*bimm* & + (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamr(k)**3 + else + mnuccr(k)=0._r8 + nnuccr(k)=0._r8 + end if + + !....................................................................... + ! accretion of cloud liquid water by rain + ! formula from Khrouditnov and Kogan (2000) + ! gravitational collection kernel, droplet fall speed neglected + + if (qric(i,k).ge.qsmall .and. qcic(i,k).ge.qsmall) then + + ! include sub-grid distribution of cloud water + + ! add sub-column switch + + if (microp_uniform) then + + pra(k) = 67._r8*(qcic(i,k)*qric(i,k))**1.15_r8 + npra(k) = pra(k)/(qcic(i,k)/ncic(i,k)) + + else + + pra(k) = accre_enhan(i,k)*(cons12/(cons3*cons20)*67._r8*(qcic(i,k)*qric(i,k))**1.15_r8) + npra(k) = pra(k)/(qcic(i,k)/ncic(i,k)) + + end if ! sub-column switch + + else + pra(k)=0._r8 + npra(k)=0._r8 + end if + + !....................................................................... + ! Self-collection of rain drops + ! from Beheng(1994) + + if (qric(i,k).ge.qsmall) then + nragg(k) = -8._r8*nric(i,k)*qric(i,k)*rho(i,k) + else + nragg(k)=0._r8 + end if + + !....................................................................... + ! Accretion of cloud ice by snow + ! For this calculation, it is assumed that the Vs >> Vi + ! and Ds >> Di for continuous collection + + if (do_cldice .and. qniic(i,k).ge.qsmall.and.qiic(i,k).ge.qsmall & + .and.t(i,k).le.273.15_r8) then + + prai(k) = pi/4._r8*asn(i,k)*qiic(i,k)*rho(i,k)* & + n0s(k)*Eii*cons11/ & + lams(k)**(bs+3._r8) + nprai(k) = pi/4._r8*asn(i,k)*niic(i,k)* & + rho(i,k)*n0s(k)*Eii*cons11/ & + lams(k)**(bs+3._r8) + else + prai(k)=0._r8 + nprai(k)=0._r8 + end if + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! calculate evaporation/sublimation of rain and snow + ! note: evaporation/sublimation occurs only in cloud-free portion of grid cell + ! in-cloud condensation/deposition of rain and snow is neglected + ! except for transfer of cloud water to snow through bergeron process + + ! initialize evap/sub tendncies + pre(k)=0._r8 + prds(k)=0._r8 + + ! evaporation of rain + ! only calculate if there is some precip fraction > cloud fraction + + if (qcic(i,k)+qiic(i,k).lt.1.e-6_r8.or.cldmax(i,k).gt.lcldm(i,k)) then + + ! set temporary cloud fraction to zero if cloud water + ice is very small + ! this will ensure that evaporation/sublimation of precip occurs over + ! entire grid cell, since min cloud fraction is specified otherwise + if (qcic(i,k)+qiic(i,k).lt.1.e-6_r8) then + dum=0._r8 + else + dum=lcldm(i,k) + end if + + ! saturation vapor pressure + esn=svp_water(t(i,k)) + qsn=svp_to_qsat(esn, p(i,k)) + + ! recalculate saturation vapor pressure for liquid and ice + esl(i,k)=esn + esi(i,k)=svp_ice(t(i,k)) + ! hm fix, make sure when above freezing that esi=esl, not active yet + if (t(i,k).gt.tmelt)esi(i,k)=esl(i,k) + + ! calculate q for out-of-cloud region + qclr=(q(i,k)-dum*qsn)/(1._r8-dum) + + if (qric(i,k).ge.qsmall) then + + qvs=svp_to_qsat(esl(i,k), p(i,k)) + dqsdt = xxlv*qvs/(rv*t(i,k)**2) + ab = 1._r8+dqsdt*xxlv/cpp + epsr = 2._r8*pi*n0r(k)*rho(i,k)*Dv(i,k)* & + (f1r/(lamr(k)*lamr(k))+ & + f2r*(arn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* & + sc(i,k)**(1._r8/3._r8)*cons13/ & + (lamr(k)**(5._r8/2._r8+br/2._r8))) + + pre(k) = epsr*(qclr-qvs)/ab + + ! only evaporate in out-of-cloud region + ! and distribute across cldmax + pre(k)=min(pre(k)*(cldmax(i,k)-dum),0._r8) + pre(k)=pre(k)/cldmax(i,k) + am_evp_st(i,k) = max(cldmax(i,k)-dum, 0._r8) + end if + + ! sublimation of snow + if (qniic(i,k).ge.qsmall) then + qvi=svp_to_qsat(esi(i,k), p(i,k)) + dqsidt = xxls*qvi/(rv*t(i,k)**2) + abi = 1._r8+dqsidt*xxls/cpp + epss = 2._r8*pi*n0s(k)*rho(i,k)*Dv(i,k)* & + (f1s/(lams(k)*lams(k))+ & + f2s*(asn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* & + sc(i,k)**(1._r8/3._r8)*cons14/ & + (lams(k)**(5._r8/2._r8+bs/2._r8))) + prds(k) = epss*(qclr-qvi)/abi + + ! only sublimate in out-of-cloud region and distribute over cldmax + prds(k)=min(prds(k)*(cldmax(i,k)-dum),0._r8) + prds(k)=prds(k)/cldmax(i,k) + am_evp_st(i,k) = max(cldmax(i,k)-dum, 0._r8) + end if + + ! make sure RH not pushed above 100% due to rain evaporation/snow sublimation + ! get updated RH at end of time step based on cloud water/ice condensation/evap + + qtmp=q(i,k)-(cmei(i,k)+(pre(k)+prds(k))*cldmax(i,k))*deltat + ttmp=t(i,k)+((pre(k)*cldmax(i,k))*xxlv+ & + (cmei(i,k)+prds(k)*cldmax(i,k))*xxls)*deltat/cpp + + !limit range of temperatures! + ttmp=max(180._r8,min(ttmp,323._r8)) + + esn=svp_water(ttmp) ! use rhw to allow ice supersaturation + qsn=svp_to_qsat(esn, p(i,k)) + + ! modify precip evaporation rate if q > qsat + if (qtmp.gt.qsn) then + if (pre(k)+prds(k).lt.-1.e-20_r8) then + dum1=pre(k)/(pre(k)+prds(k)) + ! recalculate q and t after cloud water cond but without precip evap + qtmp=q(i,k)-(cmei(i,k))*deltat + ttmp=t(i,k)+(cmei(i,k)*xxls)*deltat/cpp + esn=svp_water(ttmp) ! use rhw to allow ice supersaturation + qsn=svp_to_qsat(esn, p(i,k)) + dum=(qtmp-qsn)/(1._r8 + cons27*qsn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by cldmax to get local (in-precip) value + pre(k)=dum*dum1/deltat/cldmax(i,k) + + ! do separately using RHI for prds.... + esn=svp_ice(ttmp) ! use rhi to allow ice supersaturation + qsn=svp_to_qsat(esn, p(i,k)) + dum=(qtmp-qsn)/(1._r8 + cons28*qsn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by cldmax to get local (in-precip) value + prds(k)=dum*(1._r8-dum1)/deltat/cldmax(i,k) + end if + end if + end if + + ! bergeron process - evaporation of droplets and deposition onto snow + + if (qniic(i,k).ge.qsmall.and.qcic(i,k).ge.qsmall.and.t(i,k).lt.tmelt) then + qvi=svp_to_qsat(esi(i,k), p(i,k)) + qvs=svp_to_qsat(esl(i,k), p(i,k)) + dqsidt = xxls*qvi/(rv*t(i,k)**2) + abi = 1._r8+dqsidt*xxls/cpp + epss = 2._r8*pi*n0s(k)*rho(i,k)*Dv(i,k)* & + (f1s/(lams(k)*lams(k))+ & + f2s*(asn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* & + sc(i,k)**(1._r8/3._r8)*cons14/ & + (lams(k)**(5._r8/2._r8+bs/2._r8))) + bergs(k)=epss*(qvs-qvi)/abi + else + bergs(k)=0._r8 + end if + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! conservation to ensure no negative values of cloud water/precipitation + ! in case microphysical process rates are large + + ! make sure and use end-of-time step values for cloud water, ice, due + ! condensation/deposition + + ! note: for check on conservation, processes are multiplied by omsm + ! to prevent problems due to round off error + + ! include mixing timescale (mtime) + + qce=(qc(i,k) - berg(i,k)*deltat) + nce=(nc(i,k)+npccn(k)*deltat*mtime) + qie=(qi(i,k)+(cmei(i,k)+berg(i,k))*deltat) + nie=(ni(i,k)+nnuccd(k)*deltat*mtime) + + ! conservation of qc + + dum = (prc(k)+pra(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & + psacws(k)+bergs(k))*lcldm(i,k)*deltat + + if (dum.gt.qce) then + ratio = qce/deltat/lcldm(i,k)/(prc(k)+pra(k)+mnuccc(k)+mnucct(k)+msacwi(k)+psacws(k)+bergs(k))*omsm + + prc(k) = prc(k)*ratio + pra(k) = pra(k)*ratio + mnuccc(k) = mnuccc(k)*ratio + mnucct(k) = mnucct(k)*ratio + msacwi(k) = msacwi(k)*ratio + psacws(k) = psacws(k)*ratio + bergs(k) = bergs(k)*ratio + end if + + ! conservation of nc + + dum = (nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ & + npsacws(k)-nsubc(k))*lcldm(i,k)*deltat + + if (dum.gt.nce) then + ratio = nce/deltat/((nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+& + npsacws(k)-nsubc(k))*lcldm(i,k))*omsm + + nprc1(k) = nprc1(k)*ratio + npra(k) = npra(k)*ratio + nnuccc(k) = nnuccc(k)*ratio + nnucct(k) = nnucct(k)*ratio + npsacws(k) = npsacws(k)*ratio + nsubc(k)=nsubc(k)*ratio + end if + + ! conservation of qi + + if (do_cldice) then + + frztmp = -mnuccc(k) - mnucct(k) - msacwi(k) + if (use_hetfrz_classnuc) frztmp = -mnuccc(k)-mnucct(k)-mnudep(k)-msacwi(k) + dum = ( frztmp*lcldm(i,k) + (prci(k)+prai(k))*icldm(i,k) )*deltat + + if (dum.gt.qie) then + + frztmp = mnuccc(k) + mnucct(k) + msacwi(k) + if (use_hetfrz_classnuc) frztmp = mnuccc(k) + mnucct(k) + mnudep(k) + msacwi(k) + ratio = (qie/deltat + frztmp*lcldm(i,k))/((prci(k)+prai(k))*icldm(i,k))*omsm + prci(k) = prci(k)*ratio + prai(k) = prai(k)*ratio + end if + + ! conservation of ni + frztmp = -nnucct(k) - nsacwi(k) + if (use_hetfrz_classnuc) frztmp = -nnucct(k) - nnuccc(k) - nnudep(k) - nsacwi(k) + dum = ( frztmp*lcldm(i,k) + (nprci(k)+nprai(k)-nsubi(k))*icldm(i,k) )*deltat + + if (dum.gt.nie) then + + frztmp = nnucct(k) + nsacwi(k) + if (use_hetfrz_classnuc) frztmp = nnucct(k) + nnuccc(k) + nnudep(k) + nsacwi(k) + ratio = (nie/deltat + frztmp*lcldm(i,k))/ & + ((nprci(k)+nprai(k)-nsubi(k))*icldm(i,k))*omsm + nprci(k) = nprci(k)*ratio + nprai(k) = nprai(k)*ratio + nsubi(k) = nsubi(k)*ratio + end if + end if + + ! for precipitation conservation, use logic that vertical integral + ! of tendency from current level to top of model (i.e., qrtot) cannot be negative + + ! conservation of rain mixing rat + + if (((prc(k)+pra(k))*lcldm(i,k)+(-mnuccr(k)+pre(k)-pracs(k))*& + cldmax(i,k))*dz(i,k)*rho(i,k)+qrtot.lt.0._r8) then + + if (-pre(k)+pracs(k)+mnuccr(k).ge.qsmall) then + + ratio = (qrtot/(dz(i,k)*rho(i,k))+(prc(k)+pra(k))*lcldm(i,k))/& + ((-pre(k)+pracs(k)+mnuccr(k))*cldmax(i,k))*omsm + + pre(k) = pre(k)*ratio + pracs(k) = pracs(k)*ratio + mnuccr(k) = mnuccr(k)*ratio + end if + end if + + ! conservation of nr + ! for now neglect evaporation of nr + nsubr(k)=0._r8 + + if ((nprc(k)*lcldm(i,k)+(-nnuccr(k)+nsubr(k)-npracs(k)& + +nragg(k))*cldmax(i,k))*dz(i,k)*rho(i,k)+nrtot.lt.0._r8) then + + if (-nsubr(k)-nragg(k)+npracs(k)+nnuccr(k).ge.qsmall) then + + ratio = (nrtot/(dz(i,k)*rho(i,k))+nprc(k)*lcldm(i,k))/& + ((-nsubr(k)-nragg(k)+npracs(k)+nnuccr(k))*cldmax(i,k))*omsm + + nsubr(k) = nsubr(k)*ratio + npracs(k) = npracs(k)*ratio + nnuccr(k) = nnuccr(k)*ratio + nragg(k) = nragg(k)*ratio + end if + end if + + ! conservation of snow mix ratio + + if (((bergs(k)+psacws(k))*lcldm(i,k)+(prai(k)+prci(k))*icldm(i,k)+(pracs(k)+& + mnuccr(k)+prds(k))*cldmax(i,k))*dz(i,k)*rho(i,k)+qstot.lt.0._r8) then + + if (-prds(k).ge.qsmall) then + + ratio = (qstot/(dz(i,k)*rho(i,k))+(bergs(k)+psacws(k))*lcldm(i,k)+(prai(k)+prci(k))*icldm(i,k)+& + (pracs(k)+mnuccr(k))*cldmax(i,k))/(-prds(k)*cldmax(i,k))*omsm + + prds(k) = prds(k)*ratio + end if + end if + + ! conservation of ns + + ! calculate loss of number due to sublimation + ! for now neglect sublimation of ns + nsubs(k)=0._r8 + + if ((nprci(k)*icldm(i,k)+(nnuccr(k)+nsubs(k)+nsagg(k))*cldmax(i,k))*& + dz(i,k)*rho(i,k)+nstot.lt.0._r8) then + + if (-nsubs(k)-nsagg(k).ge.qsmall) then + + ratio = (nstot/(dz(i,k)*rho(i,k))+nprci(k)*icldm(i,k)+& + nnuccr(k)*cldmax(i,k))/((-nsubs(k)-nsagg(k))*cldmax(i,k))*omsm + + nsubs(k) = nsubs(k)*ratio + nsagg(k) = nsagg(k)*ratio + end if + end if + + ! get tendencies due to microphysical conversion processes + ! note: tendencies are multiplied by appropaiate cloud/precip + ! fraction to get grid-scale values + ! note: cmei is already grid-average values + + qvlat(i,k) = qvlat(i,k)-(pre(k)+prds(k))*cldmax(i,k)-cmei(i,k) + + tlat(i,k) = tlat(i,k)+((pre(k)*cldmax(i,k)) & + *xxlv+(prds(k)*cldmax(i,k)+cmei(i,k))*xxls+ & + ((bergs(k)+psacws(k)+mnuccc(k)+mnucct(k)+msacwi(k))*lcldm(i,k)+(mnuccr(k)+ & + pracs(k))*cldmax(i,k)+berg(i,k))*xlf) + + qctend(i,k) = qctend(i,k)+ & + (-pra(k)-prc(k)-mnuccc(k)-mnucct(k)-msacwi(k)- & + psacws(k)-bergs(k))*lcldm(i,k)-berg(i,k) + + if (do_cldice) then + + frztmp = mnuccc(k) + mnucct(k) + msacwi(k) + if (use_hetfrz_classnuc) frztmp = mnuccc(k) + mnucct(k) + mnudep(k) + msacwi(k) + qitend(i,k) = qitend(i,k) + frztmp*lcldm(i,k) + & + (-prci(k)-prai(k))*icldm(i,k) + cmei(i,k) + berg(i,k) + + end if + + qrtend(i,k) = qrtend(i,k)+ & + (pra(k)+prc(k))*lcldm(i,k)+(pre(k)-pracs(k)- & + mnuccr(k))*cldmax(i,k) + + qnitend(i,k) = qnitend(i,k)+ & + (prai(k)+prci(k))*icldm(i,k)+(psacws(k)+bergs(k))*lcldm(i,k)+(prds(k)+ & + pracs(k)+mnuccr(k))*cldmax(i,k) + + ! add output for cmei (accumulate) + cmeiout(i,k) = cmeiout(i,k) + cmei(i,k) + + ! assign variables for trop_mozart, these are grid-average + ! evaporation/sublimation is stored here as positive term + + evapsnow(i,k) = evapsnow(i,k)-prds(k)*cldmax(i,k) + nevapr(i,k) = nevapr(i,k)-pre(k)*cldmax(i,k) + nevapr2(i,k) = nevapr2(i,k)-pre(k)*cldmax(i,k) + + ! change to make sure prain is positive: do not remove snow from + ! prain used for wet deposition + prain(i,k) = prain(i,k)+(pra(k)+prc(k))*lcldm(i,k)+(-pracs(k)- & + mnuccr(k))*cldmax(i,k) + prodsnow(i,k) = prodsnow(i,k)+(prai(k)+prci(k))*icldm(i,k)+(psacws(k)+bergs(k))*lcldm(i,k)+(& + pracs(k)+mnuccr(k))*cldmax(i,k) + + ! following are used to calculate 1st order conversion rate of cloud water + ! to rain and snow (1/s), for later use in aerosol wet removal routine + ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc + ! used to calculate pra, prc, ... in this routine + ! qcsinksum_rate1ord = sum over iterations{ rate of direct transfer of cloud water to rain & snow } + ! (no cloud ice or bergeron terms) + ! qcsum_rate1ord = sum over iterations{ qc used in calculation of the transfer terms } + + qcsinksum_rate1ord(k) = qcsinksum_rate1ord(k) + (pra(k)+prc(k)+psacws(k))*lcldm(i,k) + qcsum_rate1ord(k) = qcsum_rate1ord(k) + qc(i,k) + + ! microphysics output, note this is grid-averaged + prao(i,k)=prao(i,k)+pra(k)*lcldm(i,k) + prco(i,k)=prco(i,k)+prc(k)*lcldm(i,k) + mnuccco(i,k)=mnuccco(i,k)+mnuccc(k)*lcldm(i,k) + mnuccto(i,k)=mnuccto(i,k)+mnucct(k)*lcldm(i,k) + mnuccdo(i,k)=mnuccdo(i,k)+mnuccd(k)*lcldm(i,k) + msacwio(i,k)=msacwio(i,k)+msacwi(k)*lcldm(i,k) + psacwso(i,k)=psacwso(i,k)+psacws(k)*lcldm(i,k) + bergso(i,k)=bergso(i,k)+bergs(k)*lcldm(i,k) + bergo(i,k)=bergo(i,k)+berg(i,k) + prcio(i,k)=prcio(i,k)+prci(k)*icldm(i,k) + praio(i,k)=praio(i,k)+prai(k)*icldm(i,k) + mnuccro(i,k)=mnuccro(i,k)+mnuccr(k)*cldmax(i,k) + pracso (i,k)=pracso (i,k)+pracs (k)*cldmax(i,k) + + ! multiply activation/nucleation by mtime to account for fast timescale + + nctend(i,k) = nctend(i,k)+ npccn(k)*mtime+& + (-nnuccc(k)-nnucct(k)-npsacws(k)+nsubc(k) & + -npra(k)-nprc1(k))*lcldm(i,k) + + if (do_cldice) then + + frztmp = nnucct(k) + nsacwi(k) + if (use_hetfrz_classnuc) frztmp = nnucct(k) + nnuccc(k) + nnudep(k) + nsacwi(k) + nitend(i,k) = nitend(i,k) + nnuccd(k)*mtime + & + frztmp*lcldm(i,k) + (nsubi(k)-nprci(k)-nprai(k))*icldm(i,k) + + end if + + nstend(i,k) = nstend(i,k)+(nsubs(k)+ & + nsagg(k)+nnuccr(k))*cldmax(i,k)+nprci(k)*icldm(i,k) + + nrtend(i,k) = nrtend(i,k)+ & + nprc(k)*lcldm(i,k)+(nsubr(k)-npracs(k)-nnuccr(k) & + +nragg(k))*cldmax(i,k) + + ! make sure that nc and ni at advanced time step do not exceed + ! maximum (existing N + source terms*dt), which is possible due to + ! fast nucleation timescale + + if (nctend(i,k).gt.0._r8.and.nc(i,k)+nctend(i,k)*deltat.gt.ncmax) then + nctend(i,k)=max(0._r8,(ncmax-nc(i,k))/deltat) + end if + + if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax) then + nitend(i,k)=max(0._r8,(nimax-ni(i,k))/deltat) + end if + + ! get final values for precipitation q and N, based on + ! flux of precip from above, source/sink term, and terminal fallspeed + ! see eq. 15-16 in MG2008 + + ! rain + + if (qric(i,k).ge.qsmall) then + if (k.eq.top_lev) then + qric(i,k)=qrtend(i,k)*dz(i,k)/cldmax(i,k)/umr(k) + nric(i,k)=nrtend(i,k)*dz(i,k)/cldmax(i,k)/unr(k) + else + qric(i,k) = (rho(i,k-1)*umr(k-1)*qric(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*qrtend(i,k)))/(umr(k)*rho(i,k)*cldmax(i,k)) + nric(i,k) = (rho(i,k-1)*unr(k-1)*nric(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*nrtend(i,k)))/(unr(k)*rho(i,k)*cldmax(i,k)) + + end if + else + qric(i,k)=0._r8 + nric(i,k)=0._r8 + end if + + ! snow + + if (qniic(i,k).ge.qsmall) then + if (k.eq.top_lev) then + qniic(i,k)=qnitend(i,k)*dz(i,k)/cldmax(i,k)/ums(k) + nsic(i,k)=nstend(i,k)*dz(i,k)/cldmax(i,k)/uns(k) + else + qniic(i,k) = (rho(i,k-1)*ums(k-1)*qniic(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*qnitend(i,k)))/(ums(k)*rho(i,k)*cldmax(i,k)) + nsic(i,k) = (rho(i,k-1)*uns(k-1)*nsic(i,k-1)*cldmax(i,k-1)+ & + (rho(i,k)*dz(i,k)*nstend(i,k)))/(uns(k)*rho(i,k)*cldmax(i,k)) + end if + else + qniic(i,k)=0._r8 + nsic(i,k)=0._r8 + end if + + ! calculate precipitation flux at surface + ! divide by density of water to get units of m/s + + prect(i) = prect(i)+(qrtend(i,k)*dz(i,k)*rho(i,k)+& + qnitend(i,k)*dz(i,k)*rho(i,k))/rhow + preci(i) = preci(i)+qnitend(i,k)*dz(i,k)*rho(i,k)/rhow + + ! convert rain rate from m/s to mm/hr + + rainrt(i,k)=qric(i,k)*rho(i,k)*umr(k)/rhow*3600._r8*1000._r8 + + ! vertically-integrated precip source/sink terms (note: grid-averaged) + + qrtot = max(qrtot+qrtend(i,k)*dz(i,k)*rho(i,k),0._r8) + qstot = max(qstot+qnitend(i,k)*dz(i,k)*rho(i,k),0._r8) + nrtot = max(nrtot+nrtend(i,k)*dz(i,k)*rho(i,k),0._r8) + nstot = max(nstot+nstend(i,k)*dz(i,k)*rho(i,k),0._r8) + + ! calculate melting and freezing of precip + + ! melt snow at +2 C + + if (t(i,k)+tlat(i,k)/cpp*deltat > 275.15_r8) then + if (qstot > 0._r8) then + + ! make sure melting snow doesn't reduce temperature below threshold + dum = -xlf/cpp*qstot/(dz(i,k)*rho(i,k)) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.275.15_r8) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-275.15_r8)*cpp/xlf + dum = dum/(xlf/cpp*qstot/(dz(i,k)*rho(i,k))) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qric(i,k)=qric(i,k)+dum*qniic(i,k) + nric(i,k)=nric(i,k)+dum*nsic(i,k) + qniic(i,k)=(1._r8-dum)*qniic(i,k) + nsic(i,k)=(1._r8-dum)*nsic(i,k) + ! heating tendency + tmp=-xlf*dum*qstot/(dz(i,k)*rho(i,k)) + meltsdt(i,k)=meltsdt(i,k) + tmp + + tlat(i,k)=tlat(i,k)+tmp + qrtot=qrtot+dum*qstot + nrtot=nrtot+dum*nstot + qstot=(1._r8-dum)*qstot + nstot=(1._r8-dum)*nstot + preci(i)=(1._r8-dum)*preci(i) + end if + end if + + ! freeze all rain at -5C for Arctic + + if (t(i,k)+tlat(i,k)/cpp*deltat < (tmelt - 5._r8)) then + + if (qrtot > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cpp*qrtot/(dz(i,k)*rho(i,k)) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.(tmelt - 5._r8)) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-(tmelt-5._r8))*cpp/xlf + dum = dum/(xlf/cpp*qrtot/(dz(i,k)*rho(i,k))) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qniic(i,k)=qniic(i,k)+dum*qric(i,k) + nsic(i,k)=nsic(i,k)+dum*nric(i,k) + qric(i,k)=(1._r8-dum)*qric(i,k) + nric(i,k)=(1._r8-dum)*nric(i,k) + ! heating tendency + tmp = xlf*dum*qrtot/(dz(i,k)*rho(i,k)) + frzrdt(i,k)=frzrdt(i,k) + tmp + + tlat(i,k)=tlat(i,k)+tmp + qstot=qstot+dum*qrtot + qrtot=(1._r8-dum)*qrtot + nstot=nstot+dum*nrtot + nrtot=(1._r8-dum)*nrtot + preci(i)=preci(i)+dum*(prect(i)-preci(i)) + end if + end if + + ! Precip Flux Calculation (Diagnostic) + rflx(i,k+1)=(prect(i)-preci(i)) * rhow + sflx(i,k+1)=preci(i) * rhow + + ! if rain/snow mix ratio is zero so should number concentration + + if (qniic(i,k).lt.qsmall) then + qniic(i,k)=0._r8 + nsic(i,k)=0._r8 + end if + + if (qric(i,k).lt.qsmall) then + qric(i,k)=0._r8 + nric(i,k)=0._r8 + end if + + ! make sure number concentration is a positive number to avoid + ! taking root of negative + + nric(i,k)=max(nric(i,k),0._r8) + nsic(i,k)=max(nsic(i,k),0._r8) + + !....................................................................... + ! get size distribution parameters for fallspeed calculations + !...................................................................... + ! rain + + if (qric(i,k).ge.qsmall) then + lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8) + n0r(k) = nric(i,k)*lamr(k) + + ! check for slope + ! change lammax and lammin for rain and snow + ! adjust vars + + if (lamr(k).lt.lamminr) then + + lamr(k) = lamminr + + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + else if (lamr(k).gt.lammaxr) then + lamr(k) = lammaxr + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + end if + + + ! 'final' values of number and mass weighted mean fallspeed for rain (m/s) + + unr(k) = min(arn(i,k)*cons4/lamr(k)**br,9.1_r8*rhof(i,k)) + umr(k) = min(arn(i,k)*cons5/(6._r8*lamr(k)**br),9.1_r8*rhof(i,k)) + + else + lamr(k) = 0._r8 + n0r(k) = 0._r8 + umr(k)=0._r8 + unr(k)=0._r8 + end if + + !calculate mean size of combined rain and snow + + if (lamr(k).gt.0._r8) then + Artmp = n0r(k) * pi / (2._r8 * lamr(k)**3._r8) + else + Artmp = 0._r8 + endif + + if (lamc(k).gt.0._r8) then + Actmp = cdist1(k) * pi * gamma(pgam(k)+3._r8)/(4._r8 * lamc(k)**2._r8) + else + Actmp = 0._r8 + endif + + if (Actmp.gt.0_r8.or.Artmp.gt.0) then + rercld(i,k)=rercld(i,k) + 3._r8 *(qric(i,k) + qcic(i,k)) / (4._r8 * rhow * (Actmp + Artmp)) + arcld(i,k)=arcld(i,k)+1._r8 + endif + + !...................................................................... + ! snow + + if (qniic(i,k).ge.qsmall) then + lams(k) = (cons6*cs*nsic(i,k)/ & + qniic(i,k))**(1._r8/ds) + n0s(k) = nsic(i,k)*lams(k) + + ! check for slope + ! adjust vars + + if (lams(k).lt.lammins) then + lams(k) = lammins + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6) + nsic(i,k) = n0s(k)/lams(k) + + else if (lams(k).gt.lammaxs) then + lams(k) = lammaxs + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6) + nsic(i,k) = n0s(k)/lams(k) + end if + + ! 'final' values of number and mass weighted mean fallspeed for snow (m/s) + + ums(k) = min(asn(i,k)*cons8/(6._r8*lams(k)**bs),1.2_r8*rhof(i,k)) + uns(k) = min(asn(i,k)*cons7/lams(k)**bs,1.2_r8*rhof(i,k)) + + else + lams(k) = 0._r8 + n0s(k) = 0._r8 + ums(k) = 0._r8 + uns(k) = 0._r8 + end if + + !c........................................................................ + ! sum over sub-step for average process rates + + ! convert rain/snow q and N for output to history, note, + ! output is for gridbox average + + qrout(i,k)=qrout(i,k)+qric(i,k)*cldmax(i,k) + qsout(i,k)=qsout(i,k)+qniic(i,k)*cldmax(i,k) + nrout(i,k)=nrout(i,k)+nric(i,k)*rho(i,k)*cldmax(i,k) + nsout(i,k)=nsout(i,k)+nsic(i,k)*rho(i,k)*cldmax(i,k) + + tlat1(i,k)=tlat1(i,k)+tlat(i,k) + qvlat1(i,k)=qvlat1(i,k)+qvlat(i,k) + qctend1(i,k)=qctend1(i,k)+qctend(i,k) + qitend1(i,k)=qitend1(i,k)+qitend(i,k) + nctend1(i,k)=nctend1(i,k)+nctend(i,k) + nitend1(i,k)=nitend1(i,k)+nitend(i,k) + + t(i,k)=t(i,k)+tlat(i,k)*deltat/cpp + q(i,k)=q(i,k)+qvlat(i,k)*deltat + qc(i,k)=qc(i,k)+qctend(i,k)*deltat + qi(i,k)=qi(i,k)+qitend(i,k)*deltat + nc(i,k)=nc(i,k)+nctend(i,k)*deltat + ni(i,k)=ni(i,k)+nitend(i,k)*deltat + + rainrt1(i,k)=rainrt1(i,k)+rainrt(i,k) + + !divide rain radius over substeps for average + if (arcld(i,k) .gt. 0._r8) then + rercld(i,k)=rercld(i,k)/arcld(i,k) + end if + + !! add to summing sub-stepping variable + rflx1(i,k+1)=rflx1(i,k+1)+rflx(i,k+1) + sflx1(i,k+1)=sflx1(i,k+1)+sflx(i,k+1) + + !c........................................................................ + + end do ! k loop + + prect1(i)=prect1(i)+prect(i) + preci1(i)=preci1(i)+preci(i) + + end do ! it loop, sub-step + + do k = top_lev, pver + rate1ord_cw2pr_st(i,k) = qcsinksum_rate1ord(k)/max(qcsum_rate1ord(k),1.0e-30_r8) + end do + +300 continue ! continue if no cloud water +end do ! i loop + +! convert dt from sub-step back to full time step +deltat=deltat*real(iter) + +!c............................................................................. + +do i=1,ncol + + ! skip all calculations if no cloud water + if (ltrue(i).eq.0) then + + do k=1,top_lev-1 + ! assign zero values for effective radius above 1 mbar + effc(i,k)=0._r8 + effi(i,k)=0._r8 + effc_fn(i,k)=0._r8 + lamcrad(i,k)=0._r8 + pgamrad(i,k)=0._r8 + deffi(i,k)=0._r8 + end do + + do k=top_lev,pver + ! assign default values for effective radius + effc(i,k)=10._r8 + effi(i,k)=25._r8 + effc_fn(i,k)=10._r8 + lamcrad(i,k)=0._r8 + pgamrad(i,k)=0._r8 + deffi(i,k)=0._r8 + end do + goto 500 + end if + + ! initialize nstep for sedimentation sub-steps + nstep = 1 + + ! divide precip rate by number of sub-steps to get average over time step + + prect(i)=prect1(i)/real(iter) + preci(i)=preci1(i)/real(iter) + + do k=top_lev,pver + + ! assign variables back to start-of-timestep values before updating after sub-steps + + t(i,k)=t1(i,k) + q(i,k)=q1(i,k) + qc(i,k)=qc1(i,k) + qi(i,k)=qi1(i,k) + nc(i,k)=nc1(i,k) + ni(i,k)=ni1(i,k) + + ! divide microphysical tendencies by number of sub-steps to get average over time step + + tlat(i,k)=tlat1(i,k)/real(iter) + qvlat(i,k)=qvlat1(i,k)/real(iter) + qctend(i,k)=qctend1(i,k)/real(iter) + qitend(i,k)=qitend1(i,k)/real(iter) + nctend(i,k)=nctend1(i,k)/real(iter) + nitend(i,k)=nitend1(i,k)/real(iter) + + rainrt(i,k)=rainrt1(i,k)/real(iter) + + ! divide by number of sub-steps to find final values + rflx(i,k+1)=rflx1(i,k+1)/real(iter) + sflx(i,k+1)=sflx1(i,k+1)/real(iter) + + ! divide output precip q and N by number of sub-steps to get average over time step + + qrout(i,k)=qrout(i,k)/real(iter) + qsout(i,k)=qsout(i,k)/real(iter) + nrout(i,k)=nrout(i,k)/real(iter) + nsout(i,k)=nsout(i,k)/real(iter) + + ! divide trop_mozart variables by number of sub-steps to get average over time step + + nevapr(i,k) = nevapr(i,k)/real(iter) + nevapr2(i,k) = nevapr2(i,k)/real(iter) + evapsnow(i,k) = evapsnow(i,k)/real(iter) + prain(i,k) = prain(i,k)/real(iter) + prodsnow(i,k) = prodsnow(i,k)/real(iter) + cmeout(i,k) = cmeout(i,k)/real(iter) + + cmeiout(i,k) = cmeiout(i,k)/real(iter) + meltsdt(i,k) = meltsdt(i,k)/real(iter) + frzrdt (i,k) = frzrdt (i,k)/real(iter) + + + ! microphysics output + prao(i,k)=prao(i,k)/real(iter) + prco(i,k)=prco(i,k)/real(iter) + mnuccco(i,k)=mnuccco(i,k)/real(iter) + mnuccto(i,k)=mnuccto(i,k)/real(iter) + msacwio(i,k)=msacwio(i,k)/real(iter) + psacwso(i,k)=psacwso(i,k)/real(iter) + bergso(i,k)=bergso(i,k)/real(iter) + bergo(i,k)=bergo(i,k)/real(iter) + prcio(i,k)=prcio(i,k)/real(iter) + praio(i,k)=praio(i,k)/real(iter) + + mnuccro(i,k)=mnuccro(i,k)/real(iter) + pracso (i,k)=pracso (i,k)/real(iter) + + mnuccdo(i,k)=mnuccdo(i,k)/real(iter) + + ! modify to include snow. in prain & evap (diagnostic here: for wet dep) + nevapr(i,k) = nevapr(i,k) + evapsnow(i,k) + prer_evap(i,k) = nevapr2(i,k) + prain(i,k) = prain(i,k) + prodsnow(i,k) + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! calculate sedimentation for cloud water and ice + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! update in-cloud cloud mixing ratio and number concentration + ! with microphysical tendencies to calculate sedimentation, assign to dummy vars + ! note: these are in-cloud values***, hence we divide by cloud fraction + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8) + + if (nccons) then + dumnc(i,k) = ncnst/rho(i,k) + end if + if (nicons) then + dumni(i,k) = ninst/rho(i,k) + end if + + ! obtain new slope parameter to avoid possible singularity + + if (dumi(i,k).ge.qsmall) then + ! add upper limit to in-cloud number concentration to prevent numerical error + dumni(i,k)=min(dumni(i,k),dumi(i,k)*1.e20_r8) + + lami(k) = (cons1*ci* & + dumni(i,k)/dumi(i,k))**(1._r8/di) + lami(k)=max(lami(k),lammini) + lami(k)=min(lami(k),lammaxi) + else + lami(k)=0._r8 + end if + + if (dumc(i,k).ge.qsmall) then + ! add upper limit to in-cloud number concentration to prevent numerical error + dumnc(i,k)=min(dumnc(i,k),dumc(i,k)*1.e20_r8) + ! add lower limit to in-cloud number concentration + dumnc(i,k)=max(dumnc(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3 + pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8 + pgam(k)=1._r8/(pgam(k)**2)-1._r8 + pgam(k)=max(pgam(k),2._r8) + pgam(k)=min(pgam(k),15._r8) + + lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ & + (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8) + lammin = (pgam(k)+1._r8)/50.e-6_r8 + lammax = (pgam(k)+1._r8)/2.e-6_r8 + lamc(k)=max(lamc(k),lammin) + lamc(k)=min(lamc(k),lammax) + else + lamc(k)=0._r8 + end if + + ! calculate number and mass weighted fall velocity for droplets + ! include effects of sub-grid distribution of cloud water + + + if (dumc(i,k).ge.qsmall) then + unc = acn(i,k)*gamma(1._r8+bc+pgam(k))/(lamc(k)**bc*gamma(pgam(k)+1._r8)) + umc = acn(i,k)*gamma(4._r8+bc+pgam(k))/(lamc(k)**bc*gamma(pgam(k)+4._r8)) + ! fallspeed for output + vtrmc(i,k)=umc + else + umc = 0._r8 + unc = 0._r8 + end if + + ! calculate number and mass weighted fall velocity for cloud ice + + if (dumi(i,k).ge.qsmall) then + uni = ain(i,k)*cons16/lami(k)**bi + umi = ain(i,k)*cons17/(6._r8*lami(k)**bi) + uni=min(uni,1.2_r8*rhof(i,k)) + umi=min(umi,1.2_r8*rhof(i,k)) + + ! fallspeed + vtrmi(i,k)=umi + else + umi = 0._r8 + uni = 0._r8 + end if + + fi(k) = g*rho(i,k)*umi + fni(k) = g*rho(i,k)*uni + fc(k) = g*rho(i,k)*umc + fnc(k) = g*rho(i,k)*unc + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + + rgvm = max(fi(k),fc(k),fni(k),fnc(k)) + nstep = max(int(rgvm*deltat/pdel(i,k)+1._r8),nstep) + + ! redefine dummy variables - sedimentation is calculated over grid-scale + ! quantities to ensure conservation + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8) + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + + end do !!! vertical loop + do n = 1,nstep !! loop over sub-time step to ensure stability + + do k = top_lev,pver + if (do_cldice) then + falouti(k) = fi(k)*dumi(i,k) + faloutni(k) = fni(k)*dumni(i,k) + else + falouti(k) = 0._r8 + faloutni(k) = 0._r8 + end if + + faloutc(k) = fc(k)*dumc(i,k) + faloutnc(k) = fnc(k)*dumnc(i,k) + end do + + ! top of model + + k = top_lev + faltndi = falouti(k)/pdel(i,k) + faltndni = faloutni(k)/pdel(i,k) + faltndc = faloutc(k)/pdel(i,k) + faltndnc = faloutnc(k)/pdel(i,k) + + ! add fallout terms to microphysical tendencies + + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendencies for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + do k = top_lev+1,pver + + ! for cloud liquid and ice, if cloud fraction increases with height + ! then add flux from above to both vapor and cloud water of current level + ! this means that flux entering clear portion of cell from above evaporates + ! instantly + + dum=lcldm(i,k)/lcldm(i,k-1) + dum=min(dum,1._r8) + dum1=icldm(i,k)/icldm(i,k-1) + dum1=min(dum1,1._r8) + + faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k) + faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k) + faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k) + faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k) + faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k) + faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendencies for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + + ! add terms to to evap/sub of cloud water + + qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep + ! for output + qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep + qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep + ! for output + qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep + + tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep + tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + Fni(K)=MAX(Fni(K)/pdel(i,K),Fni(K-1)/pdel(i,K-1))*pdel(i,K) + FI(K)=MAX(FI(K)/pdel(i,K),FI(K-1)/pdel(i,K-1))*pdel(i,K) + fnc(k)=max(fnc(k)/pdel(i,k),fnc(k-1)/pdel(i,k-1))*pdel(i,k) + Fc(K)=MAX(Fc(K)/pdel(i,K),Fc(K-1)/pdel(i,K-1))*pdel(i,K) + + end do !! k loop + + ! units below are m/s + ! cloud water/ice sedimentation flux at surface + ! is added to precip flux at surface to get total precip (cloud + precip water) + ! rate + + prect(i) = prect(i)+(faloutc(pver)+falouti(pver))/g/nstep/1000._r8 + preci(i) = preci(i)+(falouti(pver))/g/nstep/1000._r8 + + ! Add fallout to Precip Flux: note unit change m/s *kg/m3 = kg/m2 + do k = top_lev,pver + rflx(i,k+1)=rflx(i,k+1)+(faloutc(k))/g/nstep/1000._r8 * rhow + sflx(i,k+1)=sflx(i,k+1)+(falouti(k))/g/nstep/1000._r8 * rhow + end do + + end do !! nstep loop + + ! end sedimentation + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! get new update for variables that includes sedimentation tendency + ! note : here dum variables are grid-average, NOT in-cloud + + do k=top_lev,pver + + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8) + + if (nccons) then + dumnc(i,k) = ncnst/rho(i,k)*lcldm(i,k) + end if + if (nicons) then + dumni(i,k) = ninst/rho(i,k)*icldm(i,k) + end if + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + + ! calculate instantaneous processes (melting, homogeneous freezing) + if (do_cldice) then + + if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then + if (dumi(i,k) > 0._r8) then + + ! limit so that melting does not push temperature below freezing + dum = -dumi(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf + dum = dum/dumi(i,k)*xlf/cpp + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat + + ! for output + melto(i,k)=dum*dumi(i,k)/deltat + + ! assume melting ice produces droplet + ! mean volume radius of 8 micron + + nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ & + (4._r8*pi*5.12e-16_r8*rhow) + + qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat + nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat + tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat + end if + end if + + ! homogeneously freeze droplets at -40 C + + if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then + if (dumc(i,k) > 0._r8) then + + ! limit so that freezing does not push temperature above threshold + dum = dumc(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf + dum = dum/dumc(i,k)*xlf/cpp + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat + ! for output + homoo(i,k)=dum*dumc(i,k)/deltat + + ! assume 25 micron mean volume radius of homogeneously frozen droplets + ! consistent with size of detrained ice in stratiform.F90 + nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* & + 500._r8)/deltat + qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat + nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat + tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat + end if + end if + + ! remove any excess over-saturation, which is possible due to non-linearity when adding + ! together all microphysical processes + ! follow code similar to old CAM scheme + + qtmp=q(i,k)+qvlat(i,k)*deltat + ttmp=t(i,k)+tlat(i,k)/cpp*deltat + + esn = svp_water(ttmp) ! use rhw to allow ice supersaturation + qsn = svp_to_qsat(esn, p(i,k)) + + if (qtmp > qsn .and. qsn > 0) then + ! expression below is approximate since there may be ice deposition + dum = (qtmp-qsn)/(1._r8+cons27*qsn/(cpp*rv*ttmp**2))/deltat + ! add to output cme + cmeout(i,k) = cmeout(i,k)+dum + ! now add to tendencies, partition between liquid and ice based on temperature + if (ttmp > 268.15_r8) then + dum1=0.0_r8 + ! now add to tendencies, partition between liquid and ice based on te + else if (ttmp < 238.15_r8) then + dum1=1.0_r8 + else + dum1=(268.15_r8-ttmp)/30._r8 + end if + + dum = (qtmp-qsn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 & + *qsn/(cpp*rv*ttmp**2))/deltat + qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1) + ! for output + qcreso(i,k)=dum*(1._r8-dum1) + qitend(i,k)=qitend(i,k)+dum*dum1 + qireso(i,k)=dum*dum1 + qvlat(i,k)=qvlat(i,k)-dum + ! for output + qvres(i,k)=-dum + tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls + end if + end if + + !............................................................................... + ! calculate effective radius for pass to radiation code + ! if no cloud water, default value is 10 micron for droplets, + ! 25 micron for cloud ice + + ! update cloud variables after instantaneous processes to get effective radius + ! variables are in-cloud to calculate size dist parameters + + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k) + + if (nccons) then + dumnc(i,k) = ncnst/rho(i,k) + end if + if (nicons) then + dumni(i,k) = ninst/rho(i,k) + end if + + ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1 + + dumc(i,k)=min(dumc(i,k),5.e-3_r8) + dumi(i,k)=min(dumi(i,k),5.e-3_r8) + + !................... + ! cloud ice effective radius + + if (dumi(i,k).ge.qsmall) then + + if (nicons) then + ! make sure ni is consistent with the constant N by adjusting + ! tendency, need to multiply by cloud fraction + ! note that nitend may be further adjusted below if mean crystal + ! size is out of bounds + nitend(i,k) = (ninst/rho(i,k)*icldm(i,k) - ni(i,k))/deltat + end if + + ! add upper limit to in-cloud number concentration to prevent numerical error + dumni(i,k)=min(dumni(i,k),dumi(i,k)*1.e20_r8) + lami(k) = (cons1*ci*dumni(i,k)/dumi(i,k))**(1._r8/di) + + if (lami(k).lt.lammini) then + lami(k) = lammini + n0i(k) = lami(k)**(di+1._r8)*dumi(i,k)/(ci*cons1) + niic(i,k) = n0i(k)/lami(k) + ! adjust number conc if needed to keep mean size in reasonable range + if (do_cldice) nitend(i,k)=(niic(i,k)*icldm(i,k)-ni(i,k))/deltat + + else if (lami(k).gt.lammaxi) then + lami(k) = lammaxi + n0i(k) = lami(k)**(di+1._r8)*dumi(i,k)/(ci*cons1) + niic(i,k) = n0i(k)/lami(k) + ! adjust number conc if needed to keep mean size in reasonable range + if (do_cldice) nitend(i,k)=(niic(i,k)*icldm(i,k)-ni(i,k))/deltat + end if + effi(i,k) = 1.5_r8/lami(k)*1.e6_r8 + + else + effi(i,k) = 25._r8 + end if + + ! NOTE: If CARMA is doing the ice microphysics, then the ice effective + ! radius has already been determined from the size distribution. + if (.not. do_cldice) then + effi(i,k) = re_ice(i,k) * 1e6_r8 ! m -> um + end if + + !................... + ! cloud droplet effective radius + + if (dumc(i,k).ge.qsmall) then + + if (nccons) then + ! make sure nc is consistent with the constant N by adjusting + ! tendency, need to multiply by cloud fraction + ! note that nctend may be further adjusted below if mean droplet + ! size is out of bounds + nctend(i,k) = (ncnst/rho(i,k)*lcldm(i,k) - nc(i,k))/deltat + end if + + ! add upper limit to in-cloud number concentration to prevent numerical error + dumnc(i,k)=min(dumnc(i,k),dumc(i,k)*1.e20_r8) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! set tendency to ensure minimum droplet concentration + ! after update by microphysics, except when lambda exceeds bounds on mean drop + ! size or if there is no cloud water + if (dumnc(i,k).lt.cdnl/rho(i,k)) then + nctend(i,k)=(cdnl/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat + end if + dumnc(i,k)=max(dumnc(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8 + pgam(k)=1._r8/(pgam(k)**2)-1._r8 + pgam(k)=max(pgam(k),2._r8) + pgam(k)=min(pgam(k),15._r8) + + lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ & + (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8) + lammin = (pgam(k)+1._r8)/50.e-6_r8 + ! Multiply by omsm to fit within RRTMG's table. + lammax = (pgam(k)+1._r8)*omsm/2.e-6_r8 + if (lamc(k).lt.lammin) then + lamc(k) = lammin + ncic(i,k) = 6._r8*lamc(k)**3*dumc(i,k)* & + gamma(pgam(k)+1._r8)/ & + (pi*rhow*gamma(pgam(k)+4._r8)) + ! adjust number conc if needed to keep mean size in reasonable range + nctend(i,k)=(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat + + else if (lamc(k).gt.lammax) then + lamc(k) = lammax + ncic(i,k) = 6._r8*lamc(k)**3*dumc(i,k)* & + gamma(pgam(k)+1._r8)/ & + (pi*rhow*gamma(pgam(k)+4._r8)) + ! adjust number conc if needed to keep mean size in reasonable range + nctend(i,k)=(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat + end if + + effc(i,k) = & + gamma(pgam(k)+4._r8)/ & + gamma(pgam(k)+3._r8)/lamc(k)/2._r8*1.e6_r8 + !assign output fields for shape here + lamcrad(i,k)=lamc(k) + pgamrad(i,k)=pgam(k) + + else + effc(i,k) = 10._r8 + lamcrad(i,k)=0._r8 + pgamrad(i,k)=0._r8 + end if + + ! ice effective diameter for david mitchell's optics + if (do_cldice) then + deffi(i,k)=effi(i,k)*rhoi/917._r8*2._r8 + else + deffi(i,k)=effi(i,k) * 2._r8 + end if + + +!!! recalculate effective radius for constant number, in order to separate + ! first and second indirect effects + ! assume constant number of 10^8 kg-1 + + dumnc(i,k)=1.e8_r8 + + if (dumc(i,k).ge.qsmall) then + pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8 + pgam(k)=1._r8/(pgam(k)**2)-1._r8 + pgam(k)=max(pgam(k),2._r8) + pgam(k)=min(pgam(k),15._r8) + + lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ & + (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8) + lammin = (pgam(k)+1._r8)/50.e-6_r8 + lammax = (pgam(k)+1._r8)/2.e-6_r8 + if (lamc(k).lt.lammin) then + lamc(k) = lammin + else if (lamc(k).gt.lammax) then + lamc(k) = lammax + end if + effc_fn(i,k) = & + gamma(pgam(k)+4._r8)/ & + gamma(pgam(k)+3._r8)/lamc(k)/2._r8*1.e6_r8 + + else + effc_fn(i,k) = 10._r8 + end if + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1! + + end do ! vertical k loop + +500 continue + + do k=top_lev,pver + ! if updated q (after microphysics) is zero, then ensure updated n is also zero + + if (qc(i,k)+qctend(i,k)*deltat.lt.qsmall) nctend(i,k)=-nc(i,k)/deltat + if (do_cldice .and. qi(i,k)+qitend(i,k)*deltat.lt.qsmall) nitend(i,k)=-ni(i,k)/deltat + end do + +end do ! i loop + +! add snow ouptut +do i = 1,ncol + do k=top_lev,pver + if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then + dsout(i,k)=3._r8*rhosn/917._r8*(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8) + endif + end do +end do + +!calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual +do i = 1,ncol + do k=top_lev,pver + !! RAIN + if (qrout(i,k).gt.1.e-7_r8.and.nrout(i,k).gt.0._r8) then + reff_rain(i,k)=1.5_r8*(pi * rhow * nrout(i,k)/qrout(i,k))**(-1._r8/3._r8)*1.e6_r8 + endif + !! SNOW + if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then + reff_snow(i,k)=1.5_r8*(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8)*1.e6_r8 + end if + end do +end do + +! analytic radar reflectivity +! formulas from Matthew Shupe, NOAA/CERES +! *****note: radar reflectivity is local (in-precip average) +! units of mm^6/m^3 + +do i = 1,ncol + do k=top_lev,pver + if (qc(i,k)+qctend(i,k)*deltat.ge.qsmall .and. nc(i,k)+nctend(i,k)*deltat.gt.10._r8) then + dum=((qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)*1000._r8)**2 & + /(0.109_r8*(nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)/1.e6_r8)*lcldm(i,k)/cldmax(i,k) + else + dum=0._r8 + end if + if (qi(i,k)+qitend(i,k)*deltat.ge.qsmall) then + dum1=((qi(i,k)+qitend(i,k)*deltat)*rho(i,k)/icldm(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)*icldm(i,k)/cldmax(i,k) + else + dum1=0._r8 + end if + + if (qsout(i,k).ge.qsmall) then + dum1=dum1+(qsout(i,k)*rho(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8) + end if + + refl(i,k)=dum+dum1 + + ! add rain rate, but for 37 GHz formulation instead of 94 GHz + ! formula approximated from data of Matrasov (2007) + ! rainrt is the rain rate in mm/hr + ! reflectivity (dum) is in DBz + + if (rainrt(i,k).ge.0.001_r8) then + dum=log10(rainrt(i,k)**6._r8)+16._r8 + + ! convert from DBz to mm^6/m^3 + + dum = 10._r8**(dum/10._r8) + else + ! don't include rain rate in R calculation for values less than 0.001 mm/hr + dum=0._r8 + end if + + ! add to refl + + refl(i,k)=refl(i,k)+dum + + !output reflectivity in Z. + areflz(i,k)=refl(i,k) + + ! convert back to DBz + + if (refl(i,k).gt.minrefl) then + refl(i,k)=10._r8*log10(refl(i,k)) + else + refl(i,k)=-9999._r8 + end if + + !set averaging flag + if (refl(i,k).gt.mindbz) then + arefl(i,k)=refl(i,k) + frefl(i,k)=1.0_r8 + else + arefl(i,k)=0._r8 + areflz(i,k)=0._r8 + frefl(i,k)=0._r8 + end if + + ! bound cloudsat reflectivity + + csrfl(i,k)=min(csmax,refl(i,k)) + + !set averaging flag + if (csrfl(i,k).gt.csmin) then + acsrfl(i,k)=refl(i,k) + fcsrfl(i,k)=1.0_r8 + else + acsrfl(i,k)=0._r8 + fcsrfl(i,k)=0._r8 + end if + + end do +end do + + +! averaging for snow and rain number and diameter + +qrout2(:,:)=0._r8 +qsout2(:,:)=0._r8 +nrout2(:,:)=0._r8 +nsout2(:,:)=0._r8 +drout2(:,:)=0._r8 +dsout2(:,:)=0._r8 +freqs(:,:)=0._r8 +freqr(:,:)=0._r8 +do i = 1,ncol + do k=top_lev,pver + if (qrout(i,k).gt.1.e-7_r8.and.nrout(i,k).gt.0._r8) then + qrout2(i,k)=qrout(i,k) + nrout2(i,k)=nrout(i,k) + drout2(i,k)=(pi * rhow * nrout(i,k)/qrout(i,k))**(-1._r8/3._r8) + freqr(i,k)=1._r8 + endif + if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then + qsout2(i,k)=qsout(i,k) + nsout2(i,k)=nsout(i,k) + dsout2(i,k)=(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8) + freqs(i,k)=1._r8 + endif + end do +end do + +! output activated liquid and ice (convert from #/kg -> #/m3) +do i = 1,ncol + do k=top_lev,pver + ncai(i,k)=dum2i(i,k)*rho(i,k) + ncal(i,k)=dum2l(i,k)*rho(i,k) + end do +end do + + +!redefine fice here.... +nfice(:,:)=0._r8 +do k=top_lev,pver + do i=1,ncol + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat) + dumfice=qsout(i,k) + qrout(i,k) + dumc(i,k) + dumi(i,k) + + if (dumfice.gt.qsmall.and.(qsout(i,k)+dumi(i,k).gt.qsmall)) then + nfice(i,k)=(qsout(i,k) + dumi(i,k))/dumfice + endif + + if (nfice(i,k).gt.1._r8) then + nfice(i,k)=1._r8 + endif + + enddo +enddo + + +end subroutine micro_mg_tend + +!======================================================================== +!UTILITIES +!======================================================================== + +pure subroutine micro_mg_get_cols(ncol, nlev, top_lev, qcn, qin, & + mgncol, mgcols) + + ! Determines which columns microphysics should operate over by + ! checking for non-zero cloud water/ice. + + integer, intent(in) :: ncol ! Number of columns with meaningful data + integer, intent(in) :: nlev ! Number of levels to use + integer, intent(in) :: top_lev ! Top level for microphysics + + real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg) + + integer, intent(out) :: mgncol ! Number of columns MG will use + integer, allocatable, intent(out) :: mgcols(:) ! column indices + + integer :: lev_offset ! top_lev - 1 (defined here for consistency) + logical :: ltrue(ncol) ! store tests for each column + + integer :: i, ii ! column indices + + if (allocated(mgcols)) deallocate(mgcols) + + lev_offset = top_lev - 1 + + ! Using "any" along dimension 2 collapses across levels, but + ! not columns, so we know if water is present at any level + ! in each column. + + ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + + ! Scan for true values to get a usable list of indices. + + mgncol = count(ltrue) + allocate(mgcols(mgncol)) + i = 0 + do ii = 1,ncol + if (ltrue(ii)) then + i = i + 1 + mgcols(i) = ii + end if + end do + +end subroutine micro_mg_get_cols + +end module micro_mg1_0 diff --git a/src/physics/cam/micro_mg2_0.F90 b/src/physics/cam/micro_mg2_0.F90 new file mode 100644 index 0000000000..698f7bc046 --- /dev/null +++ b/src/physics/cam/micro_mg2_0.F90 @@ -0,0 +1,3170 @@ +module micro_mg2_0 +!--------------------------------------------------------------------------------- +! Purpose: +! MG microphysics version 2.0 - Update of MG microphysics with +! prognostic precipitation. +! +! Author: Andrew Gettelman, Hugh Morrison, Sean Santos +! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +! Version 2 history: Sep 2011: Development begun. +! Feb 2013: Added of prognostic precipitation. +! Aug 2015: Published and released version +! +! invoked in CAM by specifying -microphys=mg2.0 +! +! References: +! +! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. +! +! Part I: Off line tests and comparisons with other schemes. +! +! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. +! +! +! +! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell +! +! Advanced Two-Moment Microphysics for Global Models. +! +! Part II: Global model solutions and Aerosol-Cloud Interactions. +! +! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. +! +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +!--------------------------------------------------------------------------------- +! +! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice +! microphysics in cooperation with the MG liquid microphysics. This is +! controlled by the do_cldice variable. +! +! If do_cldice is false, then MG microphysics should not update CLDICE or +! NUMICE; it is assumed that the other microphysics scheme will have updated +! CLDICE and NUMICE. The other microphysics should handle the following +! processes that would have been done by MG: +! - Detrainment (liquid and ice) +! - Homogeneous ice nucleation +! - Heterogeneous ice nucleation +! - Bergeron process +! - Melting of ice +! - Freezing of cloud drops +! - Autoconversion (ice -> snow) +! - Growth/Sublimation of ice +! - Sedimentation of ice +! +! This option has not been updated since the introduction of prognostic +! precipitation, and probably should be adjusted to cover snow as well. +! +!--------------------------------------------------------------------------------- +! Based on micro_mg (restructuring of former cldwat2m_micro) +! Author: Andrew Gettelman, Hugh Morrison. +! Contributions from: Xiaohong Liu and Steve Ghan +! December 2005-May 2010 +! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) +! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +!--------------------------------------------------------------------------------- +! Code comments added by HM, 093011 +! General code structure: +! +! Code is divided into two main subroutines: +! subroutine micro_mg_init --> initializes microphysics routine, should be called +! once at start of simulation +! subroutine micro_mg_tend --> main microphysics routine to be called each time step +! this also calls several smaller subroutines to calculate +! microphysical processes and other utilities +! +! List of external functions: +! qsat_water --> for calculating saturation vapor pressure with respect to liquid water +! qsat_ice --> for calculating saturation vapor pressure with respect to ice +! gamma --> standard mathematical gamma function +! ......................................................................... +! List of inputs through use statement in fortran90: +! Variable Name Description Units +! ......................................................................... +! gravit acceleration due to gravity m s-2 +! rair dry air gas constant for air J kg-1 K-1 +! tmelt temperature of melting point for water K +! cpair specific heat at constant pressure for dry air J kg-1 K-1 +! rh2o gas constant for water vapor J kg-1 K-1 +! latvap latent heat of vaporization J kg-1 +! latice latent heat of fusion J kg-1 +! qsat_water external function for calculating liquid water +! saturation vapor pressure/humidity - +! qsat_ice external function for calculating ice +! saturation vapor pressure/humidity pa +! rhmini relative humidity threshold parameter for +! nucleating ice - +! ......................................................................... +! NOTE: List of all inputs/outputs passed through the call/subroutine statement +! for micro_mg_tend is given below at the start of subroutine micro_mg_tend. +!--------------------------------------------------------------------------------- + +! Procedures required: +! 1) An implementation of the gamma function (if not intrinsic). +! 2) saturation vapor pressure and specific humidity over water +! 3) svp over ice + +#ifndef HAVE_GAMMA_INTRINSICS +use shr_spfn_mod, only: gamma => shr_spfn_gamma +#endif + +use wv_sat_methods, only: & + qsat_water => wv_sat_qsat_water, & + qsat_ice => wv_sat_qsat_ice + +! Parameters from the utilities module. +use micro_mg_utils, only: & + r8, & + pi, & + omsm, & + qsmall, & + mincld, & + rhosn, & + rhoi, & + rhow, & + rhows, & + ac, bc, & + ai, bi, & + aj, bj, & + ar, br, & + as, bs, & + mi0, & + rising_factorial + +implicit none +private +save + +public :: & + micro_mg_init, & + micro_mg_get_cols, & + micro_mg_tend + +! Switches for specification rather than prediction of droplet and crystal number +! note: number will be adjusted as needed to keep mean size within bounds, +! even when specified droplet or ice number is used +! +! If constant cloud ice number is set (nicons = .true.), +! then all microphysical processes except mass transfer due to ice nucleation +! (mnuccd) are based on the fixed cloud ice number. Calculation of +! mnuccd follows from the prognosed ice crystal number ni. + +logical :: nccons ! nccons = .true. to specify constant cloud droplet number +logical :: nicons ! nicons = .true. to specify constant cloud ice number + +! specified ice and droplet number concentrations +! note: these are local in-cloud values, not grid-mean +real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3) +real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3) + +!========================================================= +! Private module parameters +!========================================================= + +!Range of cloudsat reflectivities (dBz) for analytic simulator +real(r8), parameter :: csmin = -30._r8 +real(r8), parameter :: csmax = 26._r8 +real(r8), parameter :: mindbz = -99._r8 +real(r8), parameter :: minrefl = 1.26e-10_r8 ! minrefl = 10._r8**(mindbz/10._r8) + +! autoconversion size threshold for cloud ice to snow (m) +real(r8) :: dcs + +! minimum mass of new crystal due to freezing of cloud droplets done +! externally (kg) +real(r8), parameter :: mi0l_min = 4._r8/3._r8*pi*rhow*(4.e-6_r8)**3 + +! Ice number sublimation parameter. Assume some decrease in ice number with sublimation if non-zero. Else, no decrease in number with sublimation. + real(r8), parameter :: sublim_factor =0.0_r8 !number sublimation factor. + + +!========================================================= +! Constants set in initialization +!========================================================= + +! Set using arguments to micro_mg_init +real(r8) :: g ! gravity +real(r8) :: r ! dry air gas constant +real(r8) :: rv ! water vapor gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: tmelt ! freezing point of water (K) + +! latent heats of: +real(r8) :: xxlv ! vaporization +real(r8) :: xlf ! freezing +real(r8) :: xxls ! sublimation + +real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0. + +! flags +logical :: microp_uniform +logical :: do_cldice +logical :: use_hetfrz_classnuc + +real(r8) :: rhosu ! typical 850mn air density + +real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C + +real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C +real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C + +! additional constants to help speed up code +real(r8) :: gamma_br_plus1 +real(r8) :: gamma_br_plus4 +real(r8) :: gamma_bs_plus1 +real(r8) :: gamma_bs_plus4 +real(r8) :: gamma_bi_plus1 +real(r8) :: gamma_bi_plus4 +real(r8) :: gamma_bj_plus1 +real(r8) :: gamma_bj_plus4 +real(r8) :: xxlv_squared +real(r8) :: xxls_squared + +character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method +real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor + +logical :: allow_sed_supersat ! Allow supersaturated conditions after sedimentation loop +logical :: do_sb_physics ! do SB 2001 autoconversion or accretion physics + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_mg_init( & + kind, gravit, rair, rh2o, cpair, & + tmelt_in, latvap, latice, & + rhmini_in, micro_mg_dcs, & + microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & + micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & + allow_sed_supersat_in, do_sb_physics_in, & + nccons_in, nicons_in, ncnst_in, ninst_in, errstring) + + use micro_mg_utils, only: micro_mg_utils_init + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! initialize constants for MG microphysics + ! + ! Author: Andrew Gettelman Dec 2005 + ! + !----------------------------------------------------------------------- + + integer, intent(in) :: kind ! Kind used for reals + real(r8), intent(in) :: gravit + real(r8), intent(in) :: rair + real(r8), intent(in) :: rh2o + real(r8), intent(in) :: cpair + real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) + real(r8), intent(in) :: latvap + real(r8), intent(in) :: latice + real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0. + real(r8), intent(in) :: micro_mg_dcs + + logical, intent(in) :: microp_uniform_in ! .true. = configure uniform for sub-columns + ! .false. = use w/o sub-columns (standard) + logical, intent(in) :: do_cldice_in ! .true. = do all processes (standard) + ! .false. = skip all processes affecting + ! cloud ice + logical, intent(in) :: use_hetfrz_classnuc_in ! use heterogeneous freezing + + character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method + real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor + logical, intent(in) :: allow_sed_supersat_in ! allow supersaturated conditions after sedimentation loop + logical, intent(in) :: do_sb_physics_in ! do SB autoconversion and accretion physics + + logical, intent(in) :: nccons_in + logical, intent(in) :: nicons_in + real(r8), intent(in) :: ncnst_in + real(r8), intent(in) :: ninst_in + + character(128), intent(out) :: errstring ! Output status (non-blank for error return) + + !----------------------------------------------------------------------- + + dcs = micro_mg_dcs + + ! Initialize subordinate utilities module. + call micro_mg_utils_init(kind, rh2o, cpair, tmelt_in, latvap, latice, & + dcs, errstring) + + if (trim(errstring) /= "") return + + ! declarations for MG code (transforms variable names) + + g= gravit ! gravity + r= rair ! dry air gas constant: note units(phys_constants are in J/K/kmol) + rv= rh2o ! water vapor gas constant + cpp = cpair ! specific heat of dry air + tmelt = tmelt_in + rhmini = rhmini_in + micro_mg_precip_frac_method = micro_mg_precip_frac_method_in + micro_mg_berg_eff_factor = micro_mg_berg_eff_factor_in + allow_sed_supersat = allow_sed_supersat_in + do_sb_physics = do_sb_physics_in + + nccons = nccons_in + nicons = nicons_in + ncnst = ncnst_in + ninst = ninst_in + + ! latent heats + + xxlv = latvap ! latent heat vaporization + xlf = latice ! latent heat freezing + xxls = xxlv + xlf ! latent heat of sublimation + + ! flags + microp_uniform = microp_uniform_in + do_cldice = do_cldice_in + use_hetfrz_classnuc = use_hetfrz_classnuc_in + + ! typical air density at 850 mb + + rhosu = 85000._r8/(rair * tmelt) + + ! Maximum temperature at which snow is allowed to exist + snowmelt = tmelt + 2._r8 + ! Minimum temperature at which rain is allowed to exist + rainfrze = tmelt - 40._r8 + + ! Ice nucleation temperature + icenuct = tmelt - 5._r8 + + ! Define constants to help speed up code (this limits calls to gamma function) + gamma_br_plus1=gamma(1._r8+br) + gamma_br_plus4=gamma(4._r8+br) + gamma_bs_plus1=gamma(1._r8+bs) + gamma_bs_plus4=gamma(4._r8+bs) + gamma_bi_plus1=gamma(1._r8+bi) + gamma_bi_plus4=gamma(4._r8+bi) + gamma_bj_plus1=gamma(1._r8+bj) + gamma_bj_plus4=gamma(4._r8+bj) + + xxlv_squared=xxlv**2 + xxls_squared=xxls**2 + +end subroutine micro_mg_init + +!=============================================================================== +!microphysics routine for each timestep goes here... + +subroutine micro_mg_tend ( & + mgncol, nlev, deltatin, & + t, q, & + qcn, qin, & + ncn, nin, & + qrn, qsn, & + nrn, nsn, & + relvar, accre_enhan, & + p, pdel, & + cldn, liqcldf, icecldf, qsatfac, & + qcsinksum_rate1ord, & + naai, npccn, & + rndst, nacon, & + tlat, qvlat, & + qctend, qitend, & + nctend, nitend, & + qrtend, qstend, & + nrtend, nstend, & + effc, effc_fn, effi, & + sadice, sadsnow, & + prect, preci, & + nevapr, evapsnow, & + am_evp_st, & + prain, prodsnow, & + cmeout, deffi, & + pgamrad, lamcrad, & + qsout, dsout, & + lflx, iflx, & + rflx, sflx, qrout, & + reff_rain, reff_snow, & + qcsevap, qisevap, qvres, & + cmeitot, vtrmc, vtrmi, & + umr, ums, & + qcsedten, qisedten, & + qrsedten, qssedten, & + pratot, prctot, & + mnuccctot, mnuccttot, msacwitot, & + psacwstot, bergstot, bergtot, & + melttot, homotot, & + qcrestot, prcitot, praitot, & + qirestot, mnuccrtot, pracstot, & + meltsdttot, frzrdttot, mnuccdtot, & + nrout, nsout, & + refl, arefl, areflz, & + frefl, csrfl, acsrfl, & + fcsrfl, rercld, & + ncai, ncal, & + qrout2, qsout2, & + nrout2, nsout2, & + drout2, dsout2, & + freqs, freqr, & + nfice, qcrat, & + errstring, & ! Below arguments are "optional" (pass null pointers to omit). + tnd_qsnow, tnd_nsnow, re_ice, & + prer_evap, & + frzimm, frzcnt, frzdep) + + ! Constituent properties. + use micro_mg_utils, only: & + mg_liq_props, & + mg_ice_props, & + mg_rain_props, & + mg_snow_props + + ! Size calculation functions. + use micro_mg_utils, only: & + size_dist_param_liq, & + size_dist_param_basic, & + avg_diameter + + ! Microphysical processes. + use micro_mg_utils, only: & + ice_deposition_sublimation, & + sb2001v2_liq_autoconversion,& + sb2001v2_accre_cld_water_rain,& + kk2000_liq_autoconversion, & + ice_autoconversion, & + immersion_freezing, & + contact_freezing, & + snow_self_aggregation, & + accrete_cloud_water_snow, & + secondary_ice_production, & + accrete_rain_snow, & + heterogeneous_rain_freezing, & + accrete_cloud_water_rain, & + self_collection_rain, & + accrete_cloud_ice_snow, & + evaporate_sublimate_precip, & + bergeron_process_snow + + !Authors: Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL + ! e-mail: morrison@ucar.edu, andrew@ucar.edu + + ! input arguments + integer, intent(in) :: mgncol ! number of microphysics columns + integer, intent(in) :: nlev ! number of layers + real(r8), intent(in) :: deltatin ! time step (s) + real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K) + real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) + + ! note: all input cloud variables are grid-averaged + real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg) + real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg) + + real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg) + real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg) + + real(r8), intent(in) :: relvar(mgncol,nlev) ! cloud water relative variance (-) + real(r8), intent(in) :: accre_enhan(mgncol,nlev) ! optional accretion + ! enhancement factor (-) + + real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa) + real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa) + + real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units) + real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) + real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) + real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units) + + ! used for scavenging + ! Inputs for aerosol activation + real(r8), intent(in) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg) + real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) + + ! Note that for these variables, the dust bin is assumed to be the last index. + ! (For example, in CAM, the last dimension is always size 4.) + real(r8), intent(in) :: rndst(:,:,:) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) + real(r8), intent(in) :: nacon(:,:,:) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) + + ! output arguments + + real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for + ! direct cw to precip conversion + real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg) + real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s) + real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s) + real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s) + real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s)) + real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s)) + + real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s) + real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s) + real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s)) + real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s)) + real(r8), intent(out) :: effc(mgncol,nlev) ! droplet effective radius (micron) + real(r8), intent(out) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1 + real(r8), intent(out) :: effi(mgncol,nlev) ! cloud ice effective radius (micron) + real(r8), intent(out) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3) + real(r8), intent(out) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3) + real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s) + real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s) + real(r8), intent(out) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s) + real(r8), intent(out) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s) + real(r8), intent(out) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac) + real(r8), intent(out) :: prain(mgncol,nlev) ! production of rain + snow (1/s) + real(r8), intent(out) :: prodsnow(mgncol,nlev) ! production of snow (1/s) + real(r8), intent(out) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s) + real(r8), intent(out) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron) + real(r8), intent(out) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units) + real(r8), intent(out) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m) + real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(out) :: dsout(mgncol,nlev) ! snow diameter (m) + real(r8), intent(out) :: lflx(mgncol,nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: iflx(mgncol,nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: rflx(mgncol,nlev+1) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8), intent(out) :: sflx(mgncol,nlev+1) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg) + real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron) + real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron) + real(r8), intent(out) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s) + real(r8), intent(out) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sublimation (1/s) + real(r8), intent(out) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s) + real(r8), intent(out) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s) + real(r8), intent(out) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s) + real(r8), intent(out) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s) + real(r8), intent(out) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s) + real(r8), intent(out) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s) + real(r8), intent(out) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s) + real(r8), intent(out) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s) + real(r8), intent(out) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s) + real(r8), intent(out) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s) + + ! microphysical process rates for output (mixing ratio tendencies) (all have units of 1/s) + real(r8), intent(out) :: pratot(mgncol,nlev) ! accretion of cloud by rain + real(r8), intent(out) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain + real(r8), intent(out) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing + real(r8), intent(out) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing + real(r8), intent(out) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering + real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow + real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow + real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice + real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice + real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water + real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat + real(r8), intent(out) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow + real(r8), intent(out) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow + real(r8), intent(out) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat + real(r8), intent(out) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) + real(r8), intent(out) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s) + real(r8), intent(out) :: meltsdttot(mgncol,nlev) ! latent heating rate due to melting of snow (W/kg) + real(r8), intent(out) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg) + real(r8), intent(out) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation + real(r8), intent(out) :: nrout(mgncol,nlev) ! rain number concentration (1/m3) + real(r8), intent(out) :: nsout(mgncol,nlev) ! snow number concentration (1/m3) + real(r8), intent(out) :: refl(mgncol,nlev) ! analytic radar reflectivity + real(r8), intent(out) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range + real(r8), intent(out) :: areflz(mgncol,nlev) ! average reflectivity in z. + real(r8), intent(out) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity + real(r8), intent(out) :: csrfl(mgncol,nlev) ! cloudsat reflectivity + real(r8), intent(out) :: acsrfl(mgncol,nlev) ! cloudsat average + real(r8), intent(out) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity + real(r8), intent(out) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud + real(r8), intent(out) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3) + real(r8), intent(out) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3) + real(r8), intent(out) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2 + real(r8), intent(out) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2 + real(r8), intent(out) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2 + real(r8), intent(out) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2 + real(r8), intent(out) :: drout2(mgncol,nlev) ! mean rain particle diameter (m) + real(r8), intent(out) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m) + real(r8), intent(out) :: freqs(mgncol,nlev) ! fractional occurrence of snow + real(r8), intent(out) :: freqr(mgncol,nlev) ! fractional occurrence of rain + real(r8), intent(out) :: nfice(mgncol,nlev) ! fractional occurrence of ice + real(r8), intent(out) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc) + + real(r8), intent(out) :: prer_evap(mgncol,nlev) + + character(128), intent(out) :: errstring ! output status (non-blank for error return) + + ! Tendencies calculated by external schemes that can replace MG's native + ! process tendencies. + + ! Used with CARMA cirrus microphysics + ! (or similar external microphysics model) + real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s) + real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s) + real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m) + + ! From external ice nucleation. + real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3) + real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3) + real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3) + + ! local workspace + ! all units mks unless otherwise stated + + ! local copies of input variables + real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg) + real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg) + real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg) + + ! general purpose variables + real(r8) :: deltat ! sub-time step (s) + real(r8) :: mtime ! the assumed ice nucleation timescale + + ! physical properties of the air at a given point + real(r8) :: rho(mgncol,nlev) ! density (kg m-3) + real(r8) :: dv(mgncol,nlev) ! diffusivity of water vapor + real(r8) :: mu(mgncol,nlev) ! viscosity + real(r8) :: sc(mgncol,nlev) ! schmidt number + real(r8) :: rhof(mgncol,nlev) ! density correction factor for fallspeed + + ! cloud fractions + real(r8) :: precip_frac(mgncol,nlev) ! precip fraction assuming maximum overlap + real(r8) :: cldm(mgncol,nlev) ! cloud fraction + real(r8) :: icldm(mgncol,nlev) ! ice cloud fraction + real(r8) :: lcldm(mgncol,nlev) ! liq cloud fraction + real(r8) :: qsfm(mgncol,nlev) ! subgrid cloud water saturation scaling factor + + ! mass mixing ratios + real(r8) :: qcic(mgncol,nlev) ! in-cloud cloud liquid + real(r8) :: qiic(mgncol,nlev) ! in-cloud cloud ice + real(r8) :: qsic(mgncol,nlev) ! in-precip snow + real(r8) :: qric(mgncol,nlev) ! in-precip rain + + ! number concentrations + real(r8) :: ncic(mgncol,nlev) ! in-cloud droplet + real(r8) :: niic(mgncol,nlev) ! in-cloud cloud ice + real(r8) :: nsic(mgncol,nlev) ! in-precip snow + real(r8) :: nric(mgncol,nlev) ! in-precip rain + ! maximum allowed ni value + real(r8) :: nimax(mgncol,nlev) + + ! Size distribution parameters for: + ! cloud ice + real(r8) :: lami(mgncol,nlev) ! slope + real(r8) :: n0i(mgncol,nlev) ! intercept + ! cloud liquid + real(r8) :: lamc(mgncol,nlev) ! slope + real(r8) :: pgam(mgncol,nlev) ! spectral width parameter + ! snow + real(r8) :: lams(mgncol,nlev) ! slope + real(r8) :: n0s(mgncol,nlev) ! intercept + ! rain + real(r8) :: lamr(mgncol,nlev) ! slope + real(r8) :: n0r(mgncol,nlev) ! intercept + + ! Rates/tendencies due to: + + ! Instantaneous snow melting + real(r8) :: minstsm(mgncol,nlev) ! mass mixing ratio + real(r8) :: ninstsm(mgncol,nlev) ! number concentration + ! Instantaneous rain freezing + real(r8) :: minstrf(mgncol,nlev) ! mass mixing ratio + real(r8) :: ninstrf(mgncol,nlev) ! number concentration + + ! deposition of cloud ice + real(r8) :: vap_dep(mgncol,nlev) ! deposition from vapor to ice PMC 12/3/12 + ! sublimation of cloud ice + real(r8) :: ice_sublim(mgncol,nlev) ! sublimation from ice to vapor PMC 12/3/12 + ! ice nucleation + real(r8) :: nnuccd(mgncol,nlev) ! number rate from deposition/cond.-freezing + real(r8) :: mnuccd(mgncol,nlev) ! mass mixing ratio + ! freezing of cloud water + real(r8) :: mnuccc(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccc(mgncol,nlev) ! number concentration + ! contact freezing of cloud water + real(r8) :: mnucct(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnucct(mgncol,nlev) ! number concentration + ! deposition nucleation in mixed-phase clouds (from external scheme) + real(r8) :: mnudep(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnudep(mgncol,nlev) ! number concentration + ! ice multiplication + real(r8) :: msacwi(mgncol,nlev) ! mass mixing ratio + real(r8) :: nsacwi(mgncol,nlev) ! number concentration + ! autoconversion of cloud droplets + real(r8) :: prc(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprc(mgncol,nlev) ! number concentration (rain) + real(r8) :: nprc1(mgncol,nlev) ! number concentration (cloud droplets) + ! self-aggregation of snow + real(r8) :: nsagg(mgncol,nlev) ! number concentration + ! self-collection of rain + real(r8) :: nragg(mgncol,nlev) ! number concentration + ! collection of droplets by snow + real(r8) :: psacws(mgncol,nlev) ! mass mixing ratio + real(r8) :: npsacws(mgncol,nlev) ! number concentration + ! collection of rain by snow + real(r8) :: pracs(mgncol,nlev) ! mass mixing ratio + real(r8) :: npracs(mgncol,nlev) ! number concentration + ! freezing of rain + real(r8) :: mnuccr(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccr(mgncol,nlev) ! number concentration + ! freezing of rain to form ice (mg add 4/26/13) + real(r8) :: mnuccri(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccri(mgncol,nlev) ! number concentration + ! accretion of droplets by rain + real(r8) :: pra(mgncol,nlev) ! mass mixing ratio + real(r8) :: npra(mgncol,nlev) ! number concentration + ! autoconversion of cloud ice to snow + real(r8) :: prci(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprci(mgncol,nlev) ! number concentration + ! accretion of cloud ice by snow + real(r8) :: prai(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprai(mgncol,nlev) ! number concentration + ! evaporation of rain + real(r8) :: pre(mgncol,nlev) ! mass mixing ratio + ! sublimation of snow + real(r8) :: prds(mgncol,nlev) ! mass mixing ratio + ! number evaporation + real(r8) :: nsubi(mgncol,nlev) ! cloud ice + real(r8) :: nsubc(mgncol,nlev) ! droplet + real(r8) :: nsubs(mgncol,nlev) ! snow + real(r8) :: nsubr(mgncol,nlev) ! rain + ! bergeron process + real(r8) :: berg(mgncol,nlev) ! mass mixing ratio (cloud ice) + real(r8) :: bergs(mgncol,nlev) ! mass mixing ratio (snow) + + ! fallspeeds + ! number-weighted + real(r8) :: uns(mgncol,nlev) ! snow + real(r8) :: unr(mgncol,nlev) ! rain + ! air density corrected fallspeed parameters + real(r8) :: arn(mgncol,nlev) ! rain + real(r8) :: asn(mgncol,nlev) ! snow + real(r8) :: acn(mgncol,nlev) ! cloud droplet + real(r8) :: ain(mgncol,nlev) ! cloud ice + real(r8) :: ajn(mgncol,nlev) ! cloud small ice + + ! Mass of liquid droplets used with external heterogeneous freezing. + real(r8) :: mi0l(mgncol) + + ! saturation vapor pressures + real(r8) :: esl(mgncol,nlev) ! liquid + real(r8) :: esi(mgncol,nlev) ! ice + real(r8) :: esn ! checking for RH after rain evap + + ! saturation vapor mixing ratios + real(r8) :: qvl(mgncol,nlev) ! liquid + real(r8) :: qvi(mgncol,nlev) ! ice + real(r8) :: qvn ! checking for RH after rain evap + + ! relative humidity + real(r8) :: relhum(mgncol,nlev) + + ! parameters for cloud water and cloud ice sedimentation calculations + real(r8) :: fc(mgncol,nlev) + real(r8) :: fnc(mgncol,nlev) + real(r8) :: fi(mgncol,nlev) + real(r8) :: fni(mgncol,nlev) + + real(r8) :: fr(mgncol,nlev) + real(r8) :: fnr(mgncol,nlev) + real(r8) :: fs(mgncol,nlev) + real(r8) :: fns(mgncol,nlev) + + real(r8) :: faloutc(nlev) + real(r8) :: faloutnc(nlev) + real(r8) :: falouti(nlev) + real(r8) :: faloutni(nlev) + + real(r8) :: faloutr(nlev) + real(r8) :: faloutnr(nlev) + real(r8) :: falouts(nlev) + real(r8) :: faloutns(nlev) + + real(r8) :: faltndc + real(r8) :: faltndnc + real(r8) :: faltndi + real(r8) :: faltndni + real(r8) :: faltndqie + real(r8) :: faltndqce + + real(r8) :: faltndr + real(r8) :: faltndnr + real(r8) :: faltnds + real(r8) :: faltndns + + real(r8) :: rainrt(mgncol,nlev) ! rain rate for reflectivity calculation + + ! dummy variables + real(r8) :: dum + real(r8) :: dum1 + real(r8) :: dum2 + real(r8) :: dumni0 + real(r8) :: dumns0 + ! dummies for checking RH + real(r8) :: qtmp + real(r8) :: ttmp + ! dummies for conservation check + real(r8) :: ratio + real(r8) :: tmpfrz + ! dummies for in-cloud variables + real(r8) :: dumc(mgncol,nlev) ! qc + real(r8) :: dumnc(mgncol,nlev) ! nc + real(r8) :: dumi(mgncol,nlev) ! qi + real(r8) :: dumni(mgncol,nlev) ! ni + real(r8) :: dumr(mgncol,nlev) ! rain mixing ratio + real(r8) :: dumnr(mgncol,nlev) ! rain number concentration + real(r8) :: dums(mgncol,nlev) ! snow mixing ratio + real(r8) :: dumns(mgncol,nlev) ! snow number concentration + ! Array dummy variable + real(r8) :: dum_2D(mgncol,nlev) + real(r8) :: pdel_inv(mgncol,nlev) + + ! loop array variables + ! "i" and "k" are column/level iterators for internal (MG) variables + ! "n" is used for other looping (currently just sedimentation) + integer i, k, n + + ! number of sub-steps for loops over "n" (for sedimentation) + integer nstep + integer mdust + + ! Varaibles to scale fall velocity between small and regular ice regimes. + real(r8) :: irad + real(r8) :: ifrac + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! Return error message + errstring = ' ' + + ! Process inputs + + ! assign variable deltat to deltatin + deltat = deltatin + + ! Copies of input concentrations that may be changed internally. + qc = qcn + nc = ncn + qi = qin + ni = nin + qr = qrn + nr = nrn + qs = qsn + ns = nsn + + ! cldn: used to set cldm, unused for subcolumns + ! liqcldf: used to set lcldm, unused for subcolumns + ! icecldf: used to set icldm, unused for subcolumns + + if (microp_uniform) then + ! subcolumns, set cloud fraction variables to one + ! if cloud water or ice is present, if not present + ! set to mincld (mincld used instead of zero, to prevent + ! possible division by zero errors). + + where (qc >= qsmall) + lcldm = 1._r8 + elsewhere + lcldm = mincld + end where + + where (qi >= qsmall) + icldm = 1._r8 + elsewhere + icldm = mincld + end where + + cldm = max(icldm, lcldm) + qsfm = 1._r8 + + else + ! get cloud fraction, check for minimum + cldm = max(cldn,mincld) + lcldm = max(liqcldf,mincld) + icldm = max(icecldf,mincld) + qsfm = qsatfac + end if + + ! Initialize local variables + + ! local physical properties + rho = p/(r*t) + dv = 8.794E-5_r8 * t**1.81_r8 / p + mu = 1.496E-6_r8 * t**1.5_r8 / (t + 120._r8) + sc = mu/(rho*dv) + + ! air density adjustment for fallspeed parameters + ! includes air density correction factor to the + ! power of 0.54 following Heymsfield and Bansemer 2007 + + rhof=(rhosu/rho)**0.54_r8 + + arn=ar*rhof + asn=as*rhof + acn=g*rhow/(18._r8*mu) + ain=ai*(rhosu/rho)**0.35_r8 + ajn=aj*(rhosu/rho)**0.35_r8 + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! Get humidity and saturation vapor pressures + + do k=1,nlev + do i=1,mgncol + + call qsat_water(t(i,k), p(i,k), esl(i,k), qvl(i,k)) + + ! make sure when above freezing that esi=esl, not active yet + if (t(i,k) >= tmelt) then + esi(i,k)=esl(i,k) + qvi(i,k)=qvl(i,k) + else + call qsat_ice(t(i,k), p(i,k), esi(i,k), qvi(i,k)) + + ! Scale the water saturation values to reflect subgrid scale + ! ice cloud fraction, where ice clouds begin forming at a + ! gridbox average relative humidity of rhmini (not 1). + ! + ! NOTE: For subcolumns and other non-subgrid clouds, qsfm willi + ! be 1. + qvi(i,k) = qsfm(i,k) * qvi(i,k) + esi(i,k) = qsfm(i,k) * esi(i,k) + qvl(i,k) = qsfm(i,k) * qvl(i,k) + esl(i,k) = qsfm(i,k) * esl(i,k) + end if + + end do + end do + + relhum = q / max(qvl, qsmall) + + !=============================================== + + ! set mtime here to avoid answer-changing + mtime=deltat + + ! initialize microphysics output + qcsevap=0._r8 + qisevap=0._r8 + qvres =0._r8 + cmeitot =0._r8 + vtrmc =0._r8 + vtrmi =0._r8 + qcsedten =0._r8 + qisedten =0._r8 + qrsedten =0._r8 + qssedten =0._r8 + + pratot=0._r8 + prctot=0._r8 + mnuccctot=0._r8 + mnuccttot=0._r8 + msacwitot=0._r8 + psacwstot=0._r8 + bergstot=0._r8 + bergtot=0._r8 + melttot=0._r8 + homotot=0._r8 + qcrestot=0._r8 + prcitot=0._r8 + praitot=0._r8 + qirestot=0._r8 + mnuccrtot=0._r8 + pracstot=0._r8 + meltsdttot=0._r8 + frzrdttot=0._r8 + mnuccdtot=0._r8 + + rflx=0._r8 + sflx=0._r8 + lflx=0._r8 + iflx=0._r8 + + ! initialize precip output + + qrout=0._r8 + qsout=0._r8 + nrout=0._r8 + nsout=0._r8 + + ! for refl calc + rainrt = 0._r8 + + ! initialize rain size + rercld=0._r8 + + qcsinksum_rate1ord = 0._r8 + + ! initialize variables for trop_mozart + nevapr = 0._r8 + prer_evap = 0._r8 + evapsnow = 0._r8 + am_evp_st = 0._r8 + prain = 0._r8 + prodsnow = 0._r8 + cmeout = 0._r8 + + precip_frac = mincld + + lamc=0._r8 + + ! initialize microphysical tendencies + + tlat=0._r8 + qvlat=0._r8 + qctend=0._r8 + qitend=0._r8 + qstend = 0._r8 + qrtend = 0._r8 + nctend=0._r8 + nitend=0._r8 + nrtend = 0._r8 + nstend = 0._r8 + + ! initialize in-cloud and in-precip quantities to zero + qcic = 0._r8 + qiic = 0._r8 + qsic = 0._r8 + qric = 0._r8 + + ncic = 0._r8 + niic = 0._r8 + nsic = 0._r8 + nric = 0._r8 + + ! initialize precip at surface + + prect = 0._r8 + preci = 0._r8 + + ! initialize precip fallspeeds to zero + ums = 0._r8 + uns = 0._r8 + umr = 0._r8 + unr = 0._r8 + + ! initialize limiter for output + qcrat = 1._r8 + + ! Many outputs have to be initialized here at the top to work around + ! ifort problems, even if they are always overwritten later. + effc = 10._r8 + lamcrad = 0._r8 + pgamrad = 0._r8 + effc_fn = 10._r8 + effi = 25._r8 + sadice = 0._r8 + sadsnow = 0._r8 + deffi = 50._r8 + + qrout2 = 0._r8 + nrout2 = 0._r8 + drout2 = 0._r8 + qsout2 = 0._r8 + nsout2 = 0._r8 + dsout = 0._r8 + dsout2 = 0._r8 + + freqr = 0._r8 + freqs = 0._r8 + + reff_rain = 0._r8 + reff_snow = 0._r8 + + refl = -9999._r8 + arefl = 0._r8 + areflz = 0._r8 + frefl = 0._r8 + csrfl = 0._r8 + acsrfl = 0._r8 + fcsrfl = 0._r8 + + ncal = 0._r8 + ncai = 0._r8 + + nfice = 0._r8 + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! droplet activation + ! get provisional droplet number after activation. This is used for + ! all microphysical process calculations, for consistency with update of + ! droplet mass before microphysics + + ! calculate potential for droplet activation if cloud water is present + ! tendency from activation (npccn) is read in from companion routine + + ! output activated liquid and ice (convert from #/kg -> #/m3) + !-------------------------------------------------- + where (qc >= qsmall) + nc = max(nc + npccn*deltat, 0._r8) + ncal = nc*rho/lcldm ! sghan minimum in #/cm3 + elsewhere + ncal = 0._r8 + end where + + where (t < icenuct) + ncai = naai*rho + elsewhere + ncai = 0._r8 + end where + + !=============================================== + + ! ice nucleation if activated nuclei exist at t<-5C AND rhmini + 5% + ! + ! NOTE: If using gridbox average values, condensation will not occur until rh=1, + ! so the threshold seems like it should be 1.05 and not rhmini + 0.05. For subgrid + ! clouds (using rhmini and qsfacm), the relhum has already been adjusted, and thus + ! the nucleation threshold should also be 1.05 and not rhmini + 0.05. + + !------------------------------------------------------- + + if (do_cldice) then + where (naai > 0._r8 .and. t < icenuct .and. & + relhum*esl/esi > 1.05_r8) + + !if NAAI > 0. then set numice = naai (as before) + !note: this is gridbox averaged + nnuccd = (naai-ni/icldm)/mtime*icldm + nnuccd = max(nnuccd,0._r8) + nimax = naai*icldm + + !Calc mass of new particles using new crystal mass... + !also this will be multiplied by mtime as nnuccd is... + + mnuccd = nnuccd * mi0 + + elsewhere + nnuccd = 0._r8 + nimax = 0._r8 + mnuccd = 0._r8 + end where + + end if + + + !============================================================================= + do k=1,nlev + + do i=1,mgncol + + ! calculate instantaneous precip processes (melting and homogeneous freezing) + + ! melting of snow at +2 C + + if (t(i,k) > snowmelt) then + if (qs(i,k) > 0._r8) then + + ! make sure melting snow doesn't reduce temperature below threshold + dum = -xlf/cpp*qs(i,k) + if (t(i,k)+dum < snowmelt) then + dum = (t(i,k)-snowmelt)*cpp/xlf + dum = dum/qs(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + minstsm(i,k) = dum*qs(i,k) + ninstsm(i,k) = dum*ns(i,k) + + dum1=-xlf*minstsm(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + meltsdttot(i,k)=meltsdttot(i,k) + dum1 + + qs(i,k) = max(qs(i,k) - minstsm(i,k), 0._r8) + ns(i,k) = max(ns(i,k) - ninstsm(i,k), 0._r8) + qr(i,k) = max(qr(i,k) + minstsm(i,k), 0._r8) + nr(i,k) = max(nr(i,k) + ninstsm(i,k), 0._r8) + end if + end if + + end do + end do + + do k=1,nlev + do i=1,mgncol + ! freezing of rain at -5 C + + if (t(i,k) < rainfrze) then + + if (qr(i,k) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cpp*qr(i,k) + if (t(i,k)+dum > rainfrze) then + dum = -(t(i,k)-rainfrze)*cpp/xlf + dum = dum/qr(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + minstrf(i,k) = dum*qr(i,k) + ninstrf(i,k) = dum*nr(i,k) + + ! heating tendency + dum1 = xlf*minstrf(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + frzrdttot(i,k)=frzrdttot(i,k) + dum1 + + qr(i,k) = max(qr(i,k) - minstrf(i,k), 0._r8) + nr(i,k) = max(nr(i,k) - ninstrf(i,k), 0._r8) + qs(i,k) = max(qs(i,k) + minstrf(i,k), 0._r8) + ns(i,k) = max(ns(i,k) + ninstrf(i,k), 0._r8) + + end if + end if + end do + end do + + do k=1,nlev + do i=1,mgncol + ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations + !------------------------------------------------------- + ! for microphysical process calculations + ! units are kg/kg for mixing ratio, 1/kg for number conc + + if (qc(i,k).ge.qsmall) then + ! limit in-cloud values to 0.005 kg/kg + qcic(i,k)=min(qc(i,k)/lcldm(i,k),5.e-3_r8) + ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8) + + ! specify droplet concentration + if (nccons) then + ncic(i,k)=ncnst/rho(i,k) + end if + else + qcic(i,k)=0._r8 + ncic(i,k)=0._r8 + end if + + if (qi(i,k).ge.qsmall) then + ! limit in-cloud values to 0.005 kg/kg + qiic(i,k)=min(qi(i,k)/icldm(i,k),5.e-3_r8) + niic(i,k)=max(ni(i,k)/icldm(i,k),0._r8) + + ! switch for specification of cloud ice number + if (nicons) then + niic(i,k)=ninst/rho(i,k) + end if + else + qiic(i,k)=0._r8 + niic(i,k)=0._r8 + end if + + end do + end do + + !======================================================================== + + ! for sub-columns cldm has already been set to 1 if cloud + ! water or ice is present, so precip_frac will be correctly set below + ! and nothing extra needs to be done here + + precip_frac = cldm + + micro_vert_loop: do k=1,nlev + + if (trim(micro_mg_precip_frac_method) == 'in_cloud') then + + if (k /= 1) then + where (qc(:,k) < qsmall .and. qi(:,k) < qsmall) + precip_frac(:,k) = precip_frac(:,k-1) + end where + endif + + else if (trim(micro_mg_precip_frac_method) == 'max_overlap') then + + ! calculate precip fraction based on maximum overlap assumption + + ! if rain or snow mix ratios are smaller than threshold, + ! then leave precip_frac as cloud fraction at current level + if (k /= 1) then + where (qr(:,k-1) >= qsmall .or. qs(:,k-1) >= qsmall) + precip_frac(:,k)=max(precip_frac(:,k-1),precip_frac(:,k)) + end where + end if + + endif + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get size distribution parameters based on in-cloud cloud water + ! these calculations also ensure consistency between number and mixing ratio + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! cloud liquid + !------------------------------------------- + + call size_dist_param_liq(mg_liq_props, qcic(1:mgncol,k), ncic(1:mgncol,k),& + rho(1:mgncol,k), pgam(1:mgncol,k), lamc(1:mgncol,k), mgncol) + + + !======================================================================== + ! autoconversion of cloud liquid water to rain + ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc + ! minimum qc of 1 x 10^-8 prevents floating point error + + if (.not. do_sb_physics) then + call kk2000_liq_autoconversion(microp_uniform, qcic(1:mgncol,k), & + ncic(:,k), rho(:,k), relvar(:,k), prc(:,k), nprc(:,k), nprc1(:,k), mgncol) + endif + + ! assign qric based on prognostic qr, using assumed precip fraction + ! note: this could be moved above for consistency with qcic and qiic calculations + qric(:,k) = qr(:,k)/precip_frac(:,k) + nric(:,k) = nr(:,k)/precip_frac(:,k) + + ! limit in-precip mixing ratios to 10 g/kg + qric(:,k)=min(qric(:,k),0.01_r8) + + ! add autoconversion to precip from above to get provisional rain mixing ratio + ! and number concentration (qric and nric) + + where (qric(:,k).lt.qsmall) + qric(:,k)=0._r8 + nric(:,k)=0._r8 + end where + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + + nric(:,k)=max(nric(:,k),0._r8) + + ! Get size distribution parameters for cloud ice + + call size_dist_param_basic(mg_ice_props, qiic(:,k), niic(:,k), & + lami(:,k), mgncol, n0=n0i(:,k)) + + ! Alternative autoconversion + if (do_sb_physics) then + call sb2001v2_liq_autoconversion(pgam(:,k),qcic(1:mgncol,k),ncic(:,k), & + qric(:,k),rho(:,k),relvar(:,k),prc(:,k),nprc(:,k),nprc1(:,k), mgncol) + endif + + !....................................................................... + ! Autoconversion of cloud ice to snow + ! similar to Ferrier (1994) + + if (do_cldice) then + call ice_autoconversion(t(:,k), qiic(:,k), lami(:,k), n0i(:,k), & + dcs, prci(:,k), nprci(:,k), mgncol) + else + ! Add in the particles that we have already converted to snow, and + ! don't do any further autoconversion of ice. + prci(:,k) = tnd_qsnow(:,k) / cldm(:,k) + nprci(:,k) = tnd_nsnow(:,k) / cldm(:,k) + end if + + ! note, currently we don't have this + ! inside the do_cldice block, should be changed later + ! assign qsic based on prognostic qs, using assumed precip fraction + qsic(:,k) = qs(:,k)/precip_frac(:,k) + nsic(:,k) = ns(:,k)/precip_frac(:,k) + + ! limit in-precip mixing ratios to 10 g/kg + qsic(:,k)=min(qsic(:,k),0.01_r8) + + ! if precip mix ratio is zero so should number concentration + + where (qsic(:,k) < qsmall) + qsic(:,k)=0._r8 + nsic(:,k)=0._r8 + end where + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + + nsic(:,k)=max(nsic(:,k),0._r8) + + !....................................................................... + ! get size distribution parameters for precip + !...................................................................... + ! rain + + call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), & + lamr(:,k), mgncol, n0=n0r(:,k)) + + where (lamr(:,k) >= qsmall) + + ! provisional rain number and mass weighted mean fallspeed (m/s) + + unr(:,k) = min(arn(:,k)*gamma_br_plus1/lamr(:,k)**br,9.1_r8*rhof(:,k)) + umr(:,k) = min(arn(:,k)*gamma_br_plus4/(6._r8*lamr(:,k)**br),9.1_r8*rhof(:,k)) + + elsewhere + umr(:,k) = 0._r8 + unr(:,k) = 0._r8 + end where + + !...................................................................... + ! snow + + call size_dist_param_basic(mg_snow_props, qsic(:,k), nsic(:,k), & + lams(:,k), mgncol, n0=n0s(:,k)) + + where (lams(:,k) > 0._r8) + + ! provisional snow number and mass weighted mean fallspeed (m/s) + + ums(:,k) = min(asn(:,k)*gamma_bs_plus4/(6._r8*lams(:,k)**bs),1.2_r8*rhof(:,k)) + uns(:,k) = min(asn(:,k)*gamma_bs_plus1/lams(:,k)**bs,1.2_r8*rhof(:,k)) + + elsewhere + ums(:,k) = 0._r8 + uns(:,k) = 0._r8 + end where + + if (do_cldice) then + if (.not. use_hetfrz_classnuc) then + + ! heterogeneous freezing of cloud water + !---------------------------------------------- + + call immersion_freezing(microp_uniform, t(:,k), pgam(:,k), lamc(:,k), & + qcic(1:mgncol,k), ncic(:,k), relvar(:,k), mnuccc(:,k), nnuccc(:,k), mgncol) + + ! make sure number of droplets frozen does not exceed available ice nuclei concentration + ! this prevents 'runaway' droplet freezing + + where (qcic(1:mgncol,k).ge.qsmall .and. t(:,k).lt.269.15_r8) + where (nnuccc(:,k)*lcldm(:,k).gt.nnuccd(:,k)) + ! scale mixing ratio of droplet freezing with limit + mnuccc(:,k)=mnuccc(:,k)*(nnuccd(:,k)/(nnuccc(:,k)*lcldm(:,k))) + nnuccc(:,k)=nnuccd(:,k)/lcldm(:,k) + end where + end where + + mdust = size(rndst,3) + call contact_freezing(microp_uniform, t(:,k), p(:,k), rndst(:,k,:), & + nacon(:,k,:), pgam(:,k), lamc(:,k), qcic(1:mgncol,k), ncic(:,k), & + relvar(:,k), mnucct(:,k), nnucct(:,k), mgncol, mdust) + + mnudep(:,k)=0._r8 + nnudep(:,k)=0._r8 + + else + + ! Mass of droplets frozen is the average droplet mass, except + ! with two limiters: concentration must be at least 1/cm^3, and + ! mass must be at least the minimum defined above. + mi0l = qcic(1:mgncol,k)/max(ncic(:,k), 1.0e6_r8/rho(:,k)) + mi0l = max(mi0l_min, mi0l) + + where (qcic(1:mgncol,k) >= qsmall) + nnuccc(:,k) = frzimm(:,k)*1.0e6_r8/rho(:,k) + mnuccc(:,k) = nnuccc(:,k)*mi0l + + nnucct(:,k) = frzcnt(:,k)*1.0e6_r8/rho(:,k) + mnucct(:,k) = nnucct(:,k)*mi0l + + nnudep(:,k) = frzdep(:,k)*1.0e6_r8/rho(:,k) + mnudep(:,k) = nnudep(:,k)*mi0 + elsewhere + nnuccc(:,k) = 0._r8 + mnuccc(:,k) = 0._r8 + + nnucct(:,k) = 0._r8 + mnucct(:,k) = 0._r8 + + nnudep(:,k) = 0._r8 + mnudep(:,k) = 0._r8 + end where + + end if + + else + mnuccc(:,k)=0._r8 + nnuccc(:,k)=0._r8 + mnucct(:,k)=0._r8 + nnucct(:,k)=0._r8 + mnudep(:,k)=0._r8 + nnudep(:,k)=0._r8 + end if + + call snow_self_aggregation(t(:,k), rho(:,k), asn(:,k), rhosn, qsic(:,k), nsic(:,k), & + nsagg(:,k), mgncol) + + call accrete_cloud_water_snow(t(:,k), rho(:,k), asn(:,k), uns(:,k), mu(:,k), & + qcic(1:mgncol,k), ncic(:,k), qsic(:,k), pgam(:,k), lamc(:,k), lams(:,k), n0s(:,k), & + psacws(:,k), npsacws(:,k), mgncol) + + if (do_cldice) then + call secondary_ice_production(t(:,k), psacws(:,k), msacwi(:,k), nsacwi(:,k), mgncol) + else + nsacwi(:,k) = 0.0_r8 + msacwi(:,k) = 0.0_r8 + end if + + call accrete_rain_snow(t(:,k), rho(:,k), umr(:,k), ums(:,k), unr(:,k), uns(:,k), & + qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & + pracs(:,k), npracs(:,k), mgncol) + + call heterogeneous_rain_freezing(t(:,k), qric(:,k), nric(:,k), lamr(:,k), & + mnuccr(:,k), nnuccr(:,k), mgncol) + + if (do_sb_physics) then + call sb2001v2_accre_cld_water_rain(qcic(1:mgncol,k), ncic(:,k), qric(:,k), & + rho(:,k), relvar(:,k), pra(:,k), npra(:,k), mgncol) + else + call accrete_cloud_water_rain(microp_uniform, qric(:,k), qcic(1:mgncol,k), & + ncic(:,k), relvar(:,k), accre_enhan(:,k), pra(:,k), npra(:,k), mgncol) + endif + + call self_collection_rain(rho(:,k), qric(:,k), nric(:,k), nragg(:,k), mgncol) + + if (do_cldice) then + call accrete_cloud_ice_snow(t(:,k), rho(:,k), asn(:,k), qiic(:,k), niic(:,k), & + qsic(:,k), lams(:,k), n0s(:,k), prai(:,k), nprai(:,k), mgncol) + else + prai(:,k) = 0._r8 + nprai(:,k) = 0._r8 + end if + + call evaporate_sublimate_precip(t(:,k), rho(:,k), & + dv(:,k), mu(:,k), sc(:,k), q(:,k), qvl(:,k), qvi(:,k), & + lcldm(:,k), precip_frac(:,k), arn(:,k), asn(:,k), qcic(1:mgncol,k), qiic(:,k), & + qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & + pre(:,k), prds(:,k), am_evp_st(:,k), mgncol) + + call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & + qvl(:,k), qvi(:,k), asn(:,k), qcic(1:mgncol,k), qsic(:,k), lams(:,k), n0s(:,k), & + bergs(:,k), mgncol) + + bergs(:,k)=bergs(:,k)*micro_mg_berg_eff_factor + + !+++PMC 12/3/12 - NEW VAPOR DEP/SUBLIMATION GOES HERE!!! + if (do_cldice) then + + call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), & + icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & + berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) + + berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor + + where (ice_sublim(:,k) < 0._r8 .and. qi(:,k) > qsmall .and. icldm(:,k) > mincld) + nsubi(:,k) = sublim_factor*ice_sublim(:,k) / qi(:,k) * ni(:,k) / icldm(:,k) + + elsewhere + nsubi(:,k) = 0._r8 + end where + + ! bergeron process should not reduce nc unless + ! all ql is removed (which is handled elsewhere) + !in fact, nothing in this entire file makes nsubc nonzero. + nsubc(:,k) = 0._r8 + + end if !do_cldice + !---PMC 12/3/12 + + do i=1,mgncol + + ! conservation to ensure no negative values of cloud water/precipitation + ! in case microphysical process rates are large + !=================================================================== + + ! note: for check on conservation, processes are multiplied by omsm + ! to prevent problems due to round off error + + ! conservation of qc + !------------------------------------------------------------------- + + dum = ((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k)+ & + psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*deltat + + if (dum.gt.qc(i,k)) then + ratio = qc(i,k)/deltat/((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+ & + msacwi(i,k)+psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*omsm + prc(i,k) = prc(i,k)*ratio + pra(i,k) = pra(i,k)*ratio + mnuccc(i,k) = mnuccc(i,k)*ratio + mnucct(i,k) = mnucct(i,k)*ratio + msacwi(i,k) = msacwi(i,k)*ratio + psacws(i,k) = psacws(i,k)*ratio + bergs(i,k) = bergs(i,k)*ratio + berg(i,k) = berg(i,k)*ratio + qcrat(i,k) = ratio + else + qcrat(i,k) = 1._r8 + end if + + !PMC 12/3/12: ratio is also frac of step w/ liquid. + !thus we apply berg for "ratio" of timestep and vapor + !deposition for the remaining frac of the timestep. + if (qc(i,k) >= qsmall) then + vap_dep(i,k) = vap_dep(i,k)*(1._r8-qcrat(i,k)) + end if + + end do + + do i=1,mgncol + + !================================================================= + ! apply limiter to ensure that ice/snow sublimation and rain evap + ! don't push conditions into supersaturation, and ice deposition/nucleation don't + ! push conditions into sub-saturation + ! note this is done after qc conservation since we don't know how large + ! vap_dep is before then + ! estimates are only approximate since other process terms haven't been limited + ! for conservation yet + + ! first limit ice deposition/nucleation vap_dep + mnuccd + dum1 = vap_dep(i,k) + mnuccd(i,k) + if (dum1 > 1.e-20_r8) then + dum = (q(i,k)-qvi(i,k))/(1._r8 + xxls_squared*qvi(i,k)/(cpp*rv*t(i,k)**2))/deltat + dum = max(dum,0._r8) + if (dum1 > dum) then + ! Allocate the limited "dum" tendency to mnuccd and vap_dep + ! processes. Don't divide by cloud fraction; these are grid- + ! mean rates. + dum1 = mnuccd(i,k) / (vap_dep(i,k)+mnuccd(i,k)) + mnuccd(i,k) = dum*dum1 + vap_dep(i,k) = dum - mnuccd(i,k) + end if + end if + + end do + + do i=1,mgncol + + !=================================================================== + ! conservation of nc + !------------------------------------------------------------------- + dum = (nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+ & + npsacws(i,k)-nsubc(i,k))*lcldm(i,k)*deltat + + if (dum.gt.nc(i,k)) then + ratio = nc(i,k)/deltat/((nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+& + npsacws(i,k)-nsubc(i,k))*lcldm(i,k))*omsm + + nprc1(i,k) = nprc1(i,k)*ratio + npra(i,k) = npra(i,k)*ratio + nnuccc(i,k) = nnuccc(i,k)*ratio + nnucct(i,k) = nnucct(i,k)*ratio + npsacws(i,k) = npsacws(i,k)*ratio + nsubc(i,k)=nsubc(i,k)*ratio + end if + + mnuccri(i,k)=0._r8 + nnuccri(i,k)=0._r8 + + if (do_cldice) then + + ! freezing of rain to produce ice if mean rain size is smaller than Dcs + if (lamr(i,k) > qsmall .and. 1._r8/lamr(i,k) < Dcs) then + mnuccri(i,k)=mnuccr(i,k) + nnuccri(i,k)=nnuccr(i,k) + mnuccr(i,k)=0._r8 + nnuccr(i,k)=0._r8 + end if + end if + + end do + + do i=1,mgncol + + ! conservation of rain mixing ratio + !------------------------------------------------------------------- + dum = ((-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*precip_frac(i,k)- & + (pra(i,k)+prc(i,k))*lcldm(i,k))*deltat + + ! note that qrtend is included below because of instantaneous freezing/melt + if (dum.gt.qr(i,k).and. & + (-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k)).ge.qsmall) then + ratio = (qr(i,k)/deltat+(pra(i,k)+prc(i,k))*lcldm(i,k))/ & + precip_frac(i,k)/(-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*omsm + pre(i,k)=pre(i,k)*ratio + pracs(i,k)=pracs(i,k)*ratio + mnuccr(i,k)=mnuccr(i,k)*ratio + mnuccri(i,k)=mnuccri(i,k)*ratio + end if + + end do + + do i=1,mgncol + + ! conservation of rain number + !------------------------------------------------------------------- + + ! Add evaporation of rain number. + if (pre(i,k) < 0._r8) then + dum = pre(i,k)*deltat/qr(i,k) + dum = max(-1._r8,dum) + nsubr(i,k) = dum*nr(i,k)/deltat + else + nsubr(i,k) = 0._r8 + end if + + end do + + do i=1,mgncol + + dum = ((-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*precip_frac(i,k)- & + nprc(i,k)*lcldm(i,k))*deltat + + if (dum.gt.nr(i,k)) then + ratio = (nr(i,k)/deltat+nprc(i,k)*lcldm(i,k))/precip_frac(i,k)/ & + (-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*omsm + + nragg(i,k)=nragg(i,k)*ratio + npracs(i,k)=npracs(i,k)*ratio + nnuccr(i,k)=nnuccr(i,k)*ratio + nsubr(i,k)=nsubr(i,k)*ratio + nnuccri(i,k)=nnuccri(i,k)*ratio + end if + + end do + + if (do_cldice) then + + do i=1,mgncol + + ! conservation of qi + !------------------------------------------------------------------- + + dum = ((-mnuccc(i,k)-mnucct(i,k)-mnudep(i,k)-msacwi(i,k))*lcldm(i,k)+(prci(i,k)+ & + prai(i,k))*icldm(i,k)-mnuccri(i,k)*precip_frac(i,k) & + -ice_sublim(i,k)-vap_dep(i,k)-berg(i,k)-mnuccd(i,k))*deltat + + if (dum.gt.qi(i,k)) then + ratio = (qi(i,k)/deltat+vap_dep(i,k)+berg(i,k)+mnuccd(i,k)+ & + (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+ & + mnuccri(i,k)*precip_frac(i,k))/ & + ((prci(i,k)+prai(i,k))*icldm(i,k)-ice_sublim(i,k))*omsm + prci(i,k) = prci(i,k)*ratio + prai(i,k) = prai(i,k)*ratio + ice_sublim(i,k) = ice_sublim(i,k)*ratio + end if + + end do + + end if + + if (do_cldice) then + + do i=1,mgncol + + ! conservation of ni + !------------------------------------------------------------------- + if (use_hetfrz_classnuc) then + tmpfrz = nnuccc(i,k) + else + tmpfrz = 0._r8 + end if + dum = ((-nnucct(i,k)-tmpfrz-nnudep(i,k)-nsacwi(i,k))*lcldm(i,k)+(nprci(i,k)+ & + nprai(i,k)-nsubi(i,k))*icldm(i,k)-nnuccri(i,k)*precip_frac(i,k)- & + nnuccd(i,k))*deltat + + if (dum.gt.ni(i,k)) then + ratio = (ni(i,k)/deltat+nnuccd(i,k)+ & + (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+ & + nnuccri(i,k)*precip_frac(i,k))/ & + ((nprci(i,k)+nprai(i,k)-nsubi(i,k))*icldm(i,k))*omsm + nprci(i,k) = nprci(i,k)*ratio + nprai(i,k) = nprai(i,k)*ratio + nsubi(i,k) = nsubi(i,k)*ratio + end if + + end do + + end if + + do i=1,mgncol + + ! conservation of snow mixing ratio + !------------------------------------------------------------------- + dum = (-(prds(i,k)+pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)-(prai(i,k)+prci(i,k))*icldm(i,k) & + -(bergs(i,k)+psacws(i,k))*lcldm(i,k))*deltat + + if (dum.gt.qs(i,k).and.-prds(i,k).ge.qsmall) then + ratio = (qs(i,k)/deltat+(prai(i,k)+prci(i,k))*icldm(i,k)+ & + (bergs(i,k)+psacws(i,k))*lcldm(i,k)+(pracs(i,k)+mnuccr(i,k))*precip_frac(i,k))/ & + precip_frac(i,k)/(-prds(i,k))*omsm + prds(i,k)=prds(i,k)*ratio + end if + + end do + + do i=1,mgncol + + ! conservation of snow number + !------------------------------------------------------------------- + ! calculate loss of number due to sublimation + ! for now neglect sublimation of ns + nsubs(i,k)=0._r8 + + dum = ((-nsagg(i,k)-nsubs(i,k)-nnuccr(i,k))*precip_frac(i,k)-nprci(i,k)*icldm(i,k))*deltat + + if (dum.gt.ns(i,k)) then + ratio = (ns(i,k)/deltat+nnuccr(i,k)* & + precip_frac(i,k)+nprci(i,k)*icldm(i,k))/precip_frac(i,k)/ & + (-nsubs(i,k)-nsagg(i,k))*omsm + nsubs(i,k)=nsubs(i,k)*ratio + nsagg(i,k)=nsagg(i,k)*ratio + end if + + end do + + do i=1,mgncol + + ! next limit ice and snow sublimation and rain evaporation + ! get estimate of q and t at end of time step + ! don't include other microphysical processes since they haven't + ! been limited via conservation checks yet + + if ((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k) < -1.e-20_r8) then + + qtmp=q(i,k)-(ice_sublim(i,k)+vap_dep(i,k)+mnuccd(i,k)+ & + (pre(i,k)+prds(i,k))*precip_frac(i,k))*deltat + ttmp=t(i,k)+((pre(i,k)*precip_frac(i,k))*xxlv+ & + (prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k))*xxls)*deltat/cpp + + ! use rhw to allow ice supersaturation + call qsat_water(ttmp, p(i,k), esn, qvn) + + ! modify ice/precip evaporation rate if q > qsat + if (qtmp > qvn) then + + dum1=pre(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) + dum2=prds(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) + ! recalculate q and t after vap_dep and mnuccd but without evap or sublim + qtmp=q(i,k)-(vap_dep(i,k)+mnuccd(i,k))*deltat + ttmp=t(i,k)+((vap_dep(i,k)+mnuccd(i,k))*xxls)*deltat/cpp + + ! use rhw to allow ice supersaturation + call qsat_water(ttmp, p(i,k), esn, qvn) + + dum=(qtmp-qvn)/(1._r8 + xxlv_squared*qvn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by precip_frac to get local (in-precip) value + pre(i,k)=dum*dum1/deltat/precip_frac(i,k) + + ! do separately using RHI for prds and ice_sublim + call qsat_ice(ttmp, p(i,k), esn, qvn) + + dum=(qtmp-qvn)/(1._r8 + xxls_squared*qvn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by precip_frac to get local (in-precip) value + prds(i,k) = dum*dum2/deltat/precip_frac(i,k) + + ! don't divide ice_sublim by cloud fraction since it is grid-averaged + dum1 = (1._r8-dum1-dum2) + ice_sublim(i,k) = dum*dum1/deltat + end if + end if + + end do + + ! Big "administration" loop enforces conservation, updates variables + ! that accumulate over substeps, and sets output variables. + + do i=1,mgncol + + ! get tendencies due to microphysical conversion processes + !========================================================== + ! note: tendencies are multiplied by appropriate cloud/precip + ! fraction to get grid-scale values + ! note: vap_dep is already grid-average values + + ! The net tendencies need to be added to rather than overwritten, + ! because they may have a value already set for instantaneous + ! melting/freezing. + + qvlat(i,k) = qvlat(i,k)-(pre(i,k)+prds(i,k))*precip_frac(i,k)-& + vap_dep(i,k)-ice_sublim(i,k)-mnuccd(i,k)-mnudep(i,k)*lcldm(i,k) + + tlat(i,k) = tlat(i,k)+((pre(i,k)*precip_frac(i,k)) & + *xxlv+(prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k)+mnudep(i,k)*lcldm(i,k))*xxls+ & + ((bergs(i,k)+psacws(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k))*lcldm(i,k)+(mnuccr(i,k)+ & + pracs(i,k)+mnuccri(i,k))*precip_frac(i,k)+berg(i,k))*xlf) + + qctend(i,k) = qctend(i,k)+ & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) + + if (do_cldice) then + qitend(i,k) = qitend(i,k)+ & + (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+(-prci(i,k)- & + prai(i,k))*icldm(i,k)+vap_dep(i,k)+berg(i,k)+ice_sublim(i,k)+ & + mnuccd(i,k)+mnuccri(i,k)*precip_frac(i,k) + end if + + qrtend(i,k) = qrtend(i,k)+ & + (pra(i,k)+prc(i,k))*lcldm(i,k)+(pre(i,k)-pracs(i,k)- & + mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) + + qstend(i,k) = qstend(i,k)+ & + (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(prds(i,k)+ & + pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) + + + cmeout(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) + + ! add output for cmei (accumulate) + cmeitot(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) + + ! assign variables for trop_mozart, these are grid-average + !------------------------------------------------------------------- + ! evaporation/sublimation is stored here as positive term + + evapsnow(i,k) = -prds(i,k)*precip_frac(i,k) + nevapr(i,k) = -pre(i,k)*precip_frac(i,k) + prer_evap(i,k) = -pre(i,k)*precip_frac(i,k) + + ! change to make sure prain is positive: do not remove snow from + ! prain used for wet deposition + prain(i,k) = (pra(i,k)+prc(i,k))*lcldm(i,k)+(-pracs(i,k)- & + mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) + prodsnow(i,k) = (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(& + pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) + + ! following are used to calculate 1st order conversion rate of cloud water + ! to rain and snow (1/s), for later use in aerosol wet removal routine + ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc + ! used to calculate pra, prc, ... in this routine + ! qcsinksum_rate1ord = { rate of direct transfer of cloud water to rain & snow } + ! (no cloud ice or bergeron terms) + qcsinksum_rate1ord(i,k) = (pra(i,k)+prc(i,k)+psacws(i,k))*lcldm(i,k) + ! Avoid zero/near-zero division. + qcsinksum_rate1ord(i,k) = qcsinksum_rate1ord(i,k) / & + max(qc(i,k),1.0e-30_r8) + + + ! microphysics output, note this is grid-averaged + pratot(i,k) = pra(i,k)*lcldm(i,k) + prctot(i,k) = prc(i,k)*lcldm(i,k) + mnuccctot(i,k) = mnuccc(i,k)*lcldm(i,k) + mnuccttot(i,k) = mnucct(i,k)*lcldm(i,k) + msacwitot(i,k) = msacwi(i,k)*lcldm(i,k) + psacwstot(i,k) = psacws(i,k)*lcldm(i,k) + bergstot(i,k) = bergs(i,k)*lcldm(i,k) + bergtot(i,k) = berg(i,k) + prcitot(i,k) = prci(i,k)*icldm(i,k) + praitot(i,k) = prai(i,k)*icldm(i,k) + mnuccdtot(i,k) = mnuccd(i,k)*icldm(i,k) + + pracstot(i,k) = pracs(i,k)*precip_frac(i,k) + mnuccrtot(i,k) = mnuccr(i,k)*precip_frac(i,k) + + + nctend(i,k) = nctend(i,k)+& + (-nnuccc(i,k)-nnucct(i,k)-npsacws(i,k)+nsubc(i,k) & + -npra(i,k)-nprc1(i,k))*lcldm(i,k) + + if (do_cldice) then + if (use_hetfrz_classnuc) then + tmpfrz = nnuccc(i,k) + else + tmpfrz = 0._r8 + end if + nitend(i,k) = nitend(i,k)+ nnuccd(i,k)+ & + (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+(nsubi(i,k)-nprci(i,k)- & + nprai(i,k))*icldm(i,k)+nnuccri(i,k)*precip_frac(i,k) + end if + + nstend(i,k) = nstend(i,k)+(nsubs(i,k)+ & + nsagg(i,k)+nnuccr(i,k))*precip_frac(i,k)+nprci(i,k)*icldm(i,k) + + nrtend(i,k) = nrtend(i,k)+ & + nprc(i,k)*lcldm(i,k)+(nsubr(i,k)-npracs(i,k)-nnuccr(i,k) & + -nnuccri(i,k)+nragg(i,k))*precip_frac(i,k) + + ! make sure that ni at advanced time step does not exceed + ! maximum (existing N + source terms*dt), which is possible if mtime < deltat + ! note that currently mtime = deltat + !================================================================ + + if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax(i,k)) then + nitend(i,k)=max(0._r8,(nimax(i,k)-ni(i,k))/deltat) + end if + + end do + + ! End of "administration" loop + + end do micro_vert_loop ! end k loop + + !----------------------------------------------------- + ! convert rain/snow q and N for output to history, note, + ! output is for gridbox average + + qrout = qr + nrout = nr * rho + qsout = qs + nsout = ns * rho + + ! calculate n0r and lamr from rain mass and number + ! divide by precip fraction to get in-precip (local) values of + ! rain mass and number, divide by rhow to get rain number in kg^-1 + + do k=1,nlev + + call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), lamr(:,k), mgncol, n0=n0r(:,k)) + + ! Calculate rercld + + ! calculate mean size of combined rain and cloud water + + call calc_rercld(lamr(:,k), n0r(:,k), lamc(:,k), pgam(:,k), qric(:,k), qcic(1:mgncol,k), ncic(:,k), & + rercld(:,k), mgncol) + + enddo + + ! Assign variables back to start-of-timestep values + ! Some state variables are changed before the main microphysics loop + ! to make "instantaneous" adjustments. Afterward, we must move those changes + ! back into the tendencies. + ! These processes: + ! - Droplet activation (npccn, impacts nc) + ! - Instantaneous snow melting (minstsm/ninstsm, impacts qr/qs/nr/ns) + ! - Instantaneous rain freezing (minstfr/ninstrf, impacts qr/qs/nr/ns) + !================================================================================ + + ! Re-apply droplet activation tendency + nc = ncn + nctend = nctend + npccn + + ! Re-apply rain freezing and snow melting. + dum_2D = qs + qs = qsn + qstend = qstend + (dum_2D-qs)/deltat + + dum_2D = ns + ns = nsn + nstend = nstend + (dum_2D-ns)/deltat + + dum_2D = qr + qr = qrn + qrtend = qrtend + (dum_2D-qr)/deltat + + dum_2D = nr + nr = nrn + nrtend = nrtend + (dum_2D-nr)/deltat + + !............................................................................. + + !================================================================================ + + ! modify to include snow. in prain & evap (diagnostic here: for wet dep) + nevapr = nevapr + evapsnow + prain = prain + prodsnow + + + + do k=1,nlev + + do i=1,mgncol + + ! calculate sedimentation for cloud water and ice + !================================================================================ + + ! update in-cloud cloud mixing ratio and number concentration + ! with microphysical tendencies to calculate sedimentation, assign to dummy vars + ! note: these are in-cloud values***, hence we divide by cloud fraction + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8) + + dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat)/precip_frac(i,k) + dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat)/precip_frac(i,k),0._r8) + dums(i,k) = (qs(i,k)+qstend(i,k)*deltat)/precip_frac(i,k) + dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat)/precip_frac(i,k),0._r8) + + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k) + end if + enddo + enddo + + do k=1,nlev + + ! obtain new slope parameter to avoid possible singularity + + call size_dist_param_basic(mg_ice_props, dumi(:,k), dumni(:,k), & + lami(:,k), mgncol) + + call size_dist_param_liq(mg_liq_props, dumc(:,k), dumnc(:,k), rho(:,k), & + pgam(:,k), lamc(:,k), mgncol) + + enddo + + do k=1,nlev + do i=1,mgncol + + ! calculate number and mass weighted fall velocity for droplets and cloud ice + !------------------------------------------------------------------- + + + if (dumc(i,k).ge.qsmall) then + + vtrmc(i,k)=acn(i,k)*gamma(4._r8+bc+pgam(i,k))/ & + (lamc(i,k)**bc*gamma(pgam(i,k)+4._r8)) + + fc(i,k) = g*rho(i,k)*vtrmc(i,k) + + fnc(i,k) = g*rho(i,k)* & + acn(i,k)*gamma(1._r8+bc+pgam(i,k))/ & + (lamc(i,k)**bc*gamma(pgam(i,k)+1._r8)) + else + fc(i,k) = 0._r8 + fnc(i,k)= 0._r8 + end if + + ! calculate number and mass weighted fall velocity for cloud ice + + if (dumi(i,k).ge.qsmall) then + + vtrmi(i,k)=min(ain(i,k)*gamma_bi_plus4/(6._r8*lami(i,k)**bi), & + 1.2_r8*rhof(i,k)) + + fi(i,k) = g*rho(i,k)*vtrmi(i,k) + fni(i,k) = g*rho(i,k)* & + min(ain(i,k)*gamma_bi_plus1/lami(i,k)**bi,1.2_r8*rhof(i,k)) + + ! adjust the ice fall velocity for smaller (r < 20 um) ice + ! particles (blend over 18-20 um) + irad = 1.5_r8 / lami(i,k) * 1e6_r8 + ifrac = min(1._r8, max(0._r8, (irad - 18._r8) / 2._r8)) + + if (ifrac .lt. 1._r8) then + vtrmi(i,k) = ifrac * vtrmi(i,k) + & + (1._r8 - ifrac) * & + min(ajn(i,k)*gamma_bj_plus4/(6._r8*lami(i,k)**bj), & + 1.2_r8*rhof(i,k)) + + fi(i,k) = g*rho(i,k)*vtrmi(i,k) + fni(i,k) = ifrac * fni(i,k) + & + (1._r8 - ifrac) * & + g*rho(i,k)* & + min(ajn(i,k)*gamma_bj_plus1/lami(i,k)**bj,1.2_r8*rhof(i,k)) + end if + else + fi(i,k) = 0._r8 + fni(i,k)= 0._r8 + end if + + enddo + + enddo + + do k=1,nlev + + ! fallspeed for rain + + call size_dist_param_basic(mg_rain_props, dumr(:,k), dumnr(:,k), & + lamr(:,k), mgncol) + enddo + + do k=1,nlev + + do i=1,mgncol + if (lamr(i,k).ge.qsmall) then + + ! 'final' values of number and mass weighted mean fallspeed for rain (m/s) + + unr(i,k) = min(arn(i,k)*gamma_br_plus1/lamr(i,k)**br,9.1_r8*rhof(i,k)) + umr(i,k) = min(arn(i,k)*gamma_br_plus4/(6._r8*lamr(i,k)**br),9.1_r8*rhof(i,k)) + + fr(i,k) = g*rho(i,k)*umr(i,k) + fnr(i,k) = g*rho(i,k)*unr(i,k) + + else + fr(i,k)=0._r8 + fnr(i,k)=0._r8 + end if + + ! fallspeed for snow + + call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & + lams(i,k)) + + if (lams(i,k).ge.qsmall) then + + ! 'final' values of number and mass weighted mean fallspeed for snow (m/s) + ums(i,k) = min(asn(i,k)*gamma_bs_plus4/(6._r8*lams(i,k)**bs),1.2_r8*rhof(i,k)) + uns(i,k) = min(asn(i,k)*gamma_bs_plus1/lams(i,k)**bs,1.2_r8*rhof(i,k)) + + fs(i,k) = g*rho(i,k)*ums(i,k) + fns(i,k) = g*rho(i,k)*uns(i,k) + + else + fs(i,k)=0._r8 + fns(i,k)=0._r8 + end if + + ! redefine dummy variables - sedimentation is calculated over grid-scale + ! quantities to ensure conservation + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8) + dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat) + dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat),0._r8) + dums(i,k) = (qs(i,k)+qstend(i,k)*deltat) + dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat),0._r8) + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 + if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 + + enddo + end do !!! vertical loop + + do k=1,nlev + do i=1,mgncol + pdel_inv(i,k) = 1._r8/pdel(i,k) + enddo + enddo + + ! initialize nstep for sedimentation sub-steps + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + do i=1,mgncol + nstep = 1 + int(max( & + maxval( fi(i,:)*pdel_inv(i,:)), & + maxval(fni(i,:)*pdel_inv(i,:))) & + * deltat) + + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + if (do_cldice) then + falouti = fi(i,:) * dumi(i,:) + faloutni = fni(i,:) * dumni(i,:) + else + falouti = 0._r8 + faloutni = 0._r8 + end if + + ! top of model + + k = 1 + + ! add fallout terms to microphysical tendencies + faltndi = falouti(k)/pdel(i,k) + faltndni = faloutni(k)/pdel(i,k) + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + + ! sedimentation tendency for output + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + + do k = 2,nlev + + ! for cloud liquid and ice, if cloud fraction increases with height + ! then add flux from above to both vapor and cloud water of current level + ! this means that flux entering clear portion of cell from above evaporates + ! instantly + + ! note: this is not an issue with precip, since we assume max overlap + dum1=icldm(i,k)/icldm(i,k-1) + dum1=min(dum1,1._r8) + + faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k) + faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k) + faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + + ! sedimentation tendency for output + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + + ! add terms to to evap/sub of cloud water + + qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep + ! for output + qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep + + tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + + end do + + ! Ice flux + do k = 1,nlev + iflx(i,k+1) = iflx(i,k+1) + falouti(k) / g / real(nstep) + end do + + ! units below are m/s + ! sedimentation flux at surface is added to precip flux at surface + ! to get total precip (cloud + precip water) rate + + prect(i) = prect(i)+falouti(nlev)/g/real(nstep)/1000._r8 + preci(i) = preci(i)+falouti(nlev)/g/real(nstep)/1000._r8 + + end do + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fc(i,:)*pdel_inv(i,:)), & + maxval(fnc(i,:)*pdel_inv(i,:))) & + * deltat) + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + faloutc = fc(i,:) * dumc(i,:) + faloutnc = fnc(i,:) * dumnc(i,:) + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltndc = faloutc(k)/pdel(i,k) + faltndnc = faloutnc(k)/pdel(i,k) + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendency for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + do k = 2,nlev + + dum=lcldm(i,k)/lcldm(i,k-1) + dum=min(dum,1._r8) + faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k) + faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k) + faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendency for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + + ! add terms to to evap/sub of cloud water + qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep + ! for output + qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep + + tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep + + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + end do + + !Liquid condensate flux here + do k = 1,nlev + lflx(i,k+1) = lflx(i,k+1) + faloutc(k) / g / real(nstep) + end do + + prect(i) = prect(i)+faloutc(nlev)/g/real(nstep)/1000._r8 + + end do + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fr(i,:)*pdel_inv(i,:)), & + maxval(fnr(i,:)*pdel_inv(i,:))) & + * deltat) + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + faloutr = fr(i,:) * dumr(i,:) + faloutnr = fnr(i,:) * dumnr(i,:) + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltndr = faloutr(k)/pdel(i,k) + faltndnr = faloutnr(k)/pdel(i,k) + qrtend(i,k) = qrtend(i,k)-faltndr/nstep + nrtend(i,k) = nrtend(i,k)-faltndnr/nstep + + ! sedimentation tendency for output + qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep + + dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) + dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) + + do k = 2,nlev + + faltndr=(faloutr(k)-faloutr(k-1))/pdel(i,k) + faltndnr=(faloutnr(k)-faloutnr(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qrtend(i,k) = qrtend(i,k)-faltndr/nstep + nrtend(i,k) = nrtend(i,k)-faltndnr/nstep + + ! sedimentation tendency for output + qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep + + dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) + dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) + + end do + + ! Rain Flux + do k = 1,nlev + rflx(i,k+1) = rflx(i,k+1) + faloutr(k) / g / real(nstep) + end do + + prect(i) = prect(i)+faloutr(nlev)/g/real(nstep)/1000._r8 + + end do + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fs(i,:)*pdel_inv(i,:)), & + maxval(fns(i,:)*pdel_inv(i,:))) & + * deltat) + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + falouts = fs(i,:) * dums(i,:) + faloutns = fns(i,:) * dumns(i,:) + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltnds = falouts(k)/pdel(i,k) + faltndns = faloutns(k)/pdel(i,k) + qstend(i,k) = qstend(i,k)-faltnds/nstep + nstend(i,k) = nstend(i,k)-faltndns/nstep + + ! sedimentation tendency for output + qssedten(i,k)=qssedten(i,k)-faltnds/nstep + + dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) + dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) + + do k = 2,nlev + + faltnds=(falouts(k)-falouts(k-1))/pdel(i,k) + faltndns=(faloutns(k)-faloutns(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qstend(i,k) = qstend(i,k)-faltnds/nstep + nstend(i,k) = nstend(i,k)-faltndns/nstep + + ! sedimentation tendency for output + qssedten(i,k)=qssedten(i,k)-faltnds/nstep + + dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) + dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) + + end do !! k loop + + ! Snow Flux + do k = 1,nlev + sflx(i,k+1) = sflx(i,k+1) + falouts(k) / g / real(nstep) + end do + + prect(i) = prect(i)+falouts(nlev)/g/real(nstep)/1000._r8 + preci(i) = preci(i)+falouts(nlev)/g/real(nstep)/1000._r8 + + end do !! nstep loop + + enddo + ! end sedimentation + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! get new update for variables that includes sedimentation tendency + ! note : here dum variables are grid-average, NOT in-cloud + + do k=1,nlev + do i=1,mgncol + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8) + + dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8) + dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8) + dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8) + dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8) + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k)*lcldm(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k)*icldm(i,k) + end if + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 + if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 + + enddo + + enddo + + ! calculate instantaneous processes (melting, homogeneous freezing) + !==================================================================== + + ! melting of snow at +2 C + do k=1,nlev + + do i=1,mgncol + + if (t(i,k)+tlat(i,k)/cpp*deltat > snowmelt) then + if (dums(i,k) > 0._r8) then + + ! make sure melting snow doesn't reduce temperature below threshold + dum = -xlf/cpp*dums(i,k) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt. snowmelt) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-snowmelt)*cpp/xlf + dum = dum/dums(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qstend(i,k)=qstend(i,k)-dum*dums(i,k)/deltat + nstend(i,k)=nstend(i,k)-dum*dumns(i,k)/deltat + qrtend(i,k)=qrtend(i,k)+dum*dums(i,k)/deltat + nrtend(i,k)=nrtend(i,k)+dum*dumns(i,k)/deltat + + dum1=-xlf*dum*dums(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + meltsdttot(i,k)=meltsdttot(i,k) + dum1 + end if + end if + enddo + enddo + do k=1,nlev + do i=1,mgncol + + ! freezing of rain at -5 C + + if (t(i,k)+tlat(i,k)/cpp*deltat < rainfrze) then + + if (dumr(i,k) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cpp*dumr(i,k) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.rainfrze) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-rainfrze)*cpp/xlf + dum = dum/dumr(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qrtend(i,k)=qrtend(i,k)-dum*dumr(i,k)/deltat + nrtend(i,k)=nrtend(i,k)-dum*dumnr(i,k)/deltat + + ! get mean size of rain = 1/lamr, add frozen rain to either snow or cloud ice + ! depending on mean rain size + + call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & + lamr(i,k)) + + if (lamr(i,k) < 1._r8/Dcs) then + qstend(i,k)=qstend(i,k)+dum*dumr(i,k)/deltat + nstend(i,k)=nstend(i,k)+dum*dumnr(i,k)/deltat + else + qitend(i,k)=qitend(i,k)+dum*dumr(i,k)/deltat + nitend(i,k)=nitend(i,k)+dum*dumnr(i,k)/deltat + end if + + ! heating tendency + dum1 = xlf*dum*dumr(i,k)/deltat + frzrdttot(i,k)=frzrdttot(i,k) + dum1 + tlat(i,k)=tlat(i,k)+dum1 + + end if + end if + + enddo + enddo + if (do_cldice) then + do k=1,nlev + do i=1,mgncol + if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then + if (dumi(i,k) > 0._r8) then + + ! limit so that melting does not push temperature below freezing + !----------------------------------------------------------------- + dum = -dumi(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf + dum = dum/dumi(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat + + ! for output + melttot(i,k)=dum*dumi(i,k)/deltat + + ! assume melting ice produces droplet + ! mean volume radius of 8 micron + + nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ & + (4._r8*pi*5.12e-16_r8*rhow) + + qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat + nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat + tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat + end if + end if + enddo + enddo + + ! homogeneously freeze droplets at -40 C + !----------------------------------------------------------------- + + do k=1,nlev + do i=1,mgncol + if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then + if (dumc(i,k) > 0._r8) then + + ! limit so that freezing does not push temperature above threshold + dum = dumc(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf + dum = dum/dumc(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat + ! for output + homotot(i,k)=dum*dumc(i,k)/deltat + + ! assume 25 micron mean volume radius of homogeneously frozen droplets + ! consistent with size of detrained ice in stratiform.F90 + nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* & + 500._r8)/deltat + qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat + nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat + tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat + end if + end if + enddo + enddo + ! remove any excess over-saturation, which is possible due to non-linearity when adding + ! together all microphysical processes + !----------------------------------------------------------------- + ! follow code similar to old CAM scheme + do k=1,nlev + do i=1,mgncol + + qtmp=q(i,k)+qvlat(i,k)*deltat + ttmp=t(i,k)+tlat(i,k)/cpp*deltat + + ! use rhw to allow ice supersaturation + call qsat_water(ttmp, p(i,k), esn, qvn) + + if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then + ! expression below is approximate since there may be ice deposition + dum = (qtmp-qvn)/(1._r8+xxlv_squared*qvn/(cpp*rv*ttmp**2))/deltat + ! add to output cme + cmeout(i,k) = cmeout(i,k)+dum + ! now add to tendencies, partition between liquid and ice based on temperature + if (ttmp > 268.15_r8) then + dum1=0.0_r8 + ! now add to tendencies, partition between liquid and ice based on te + !------------------------------------------------------- + else if (ttmp < 238.15_r8) then + dum1=1.0_r8 + else + dum1=(268.15_r8-ttmp)/30._r8 + end if + + dum = (qtmp-qvn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 & + *qvn/(cpp*rv*ttmp**2))/deltat + qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1) + ! for output + qcrestot(i,k)=dum*(1._r8-dum1) + qitend(i,k)=qitend(i,k)+dum*dum1 + qirestot(i,k)=dum*dum1 + qvlat(i,k)=qvlat(i,k)-dum + ! for output + qvres(i,k)=-dum + tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls + end if + enddo + enddo + end if + + ! calculate effective radius for pass to radiation code + !========================================================= + ! if no cloud water, default value is 10 micron for droplets, + ! 25 micron for cloud ice + + ! update cloud variables after instantaneous processes to get effective radius + ! variables are in-cloud to calculate size dist parameters + do k=1,nlev + do i=1,mgncol + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k) + + dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8)/precip_frac(i,k) + dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8)/precip_frac(i,k) + dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8)/precip_frac(i,k) + dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8)/precip_frac(i,k) + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k) + end if + + ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1 + dumc(i,k)=min(dumc(i,k),5.e-3_r8) + dumi(i,k)=min(dumi(i,k),5.e-3_r8) + ! limit in-precip mixing ratios + dumr(i,k)=min(dumr(i,k),10.e-3_r8) + dums(i,k)=min(dums(i,k),10.e-3_r8) + enddo + enddo + ! cloud ice effective radius + !----------------------------------------------------------------- + + if (do_cldice) then + do k=1,nlev + do i=1,mgncol + if (dumi(i,k).ge.qsmall) then + + dum_2D(i,k) = dumni(i,k) + call size_dist_param_basic(mg_ice_props, dumi(i,k), dumni(i,k), & + lami(i,k), dumni0) + + if (dumni(i,k) /=dum_2D(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + nitend(i,k)=(dumni(i,k)*icldm(i,k)-ni(i,k))/deltat + end if + + effi(i,k) = 1.5_r8/lami(i,k)*1.e6_r8 + sadice(i,k) = 2._r8*pi*(lami(i,k)**(-3))*dumni0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 + + else + effi(i,k) = 25._r8 + sadice(i,k) = 0._r8 + end if + + ! ice effective diameter for david mitchell's optics + deffi(i,k)=effi(i,k)*rhoi/rhows*2._r8 + enddo + enddo + else + do k=1,nlev + do i=1,mgncol + ! NOTE: If CARMA is doing the ice microphysics, then the ice effective + ! radius has already been determined from the size distribution. + effi(i,k) = re_ice(i,k) * 1.e6_r8 ! m -> um + deffi(i,k)=effi(i,k) * 2._r8 + sadice(i,k) = 4._r8*pi*(effi(i,k)**2)*ni(i,k)*rho(i,k)*1e-2_r8 + enddo + enddo + end if + + ! cloud droplet effective radius + !----------------------------------------------------------------- + do k=1,nlev + do i=1,mgncol + if (dumc(i,k).ge.qsmall) then + + + ! switch for specification of droplet and crystal number + if (nccons) then + ! make sure nc is consistence with the constant N by adjusting tendency, need + ! to multiply by cloud fraction + ! note that nctend may be further adjusted below if mean droplet size is + ! out of bounds + + nctend(i,k)=(ncnst/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat + + end if + + dum = dumnc(i,k) + + call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & + pgam(i,k), lamc(i,k)) + + if (dum /= dumnc(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + nctend(i,k)=(dumnc(i,k)*lcldm(i,k)-nc(i,k))/deltat + end if + + effc(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 + !assign output fields for shape here + lamcrad(i,k)=lamc(i,k) + pgamrad(i,k)=pgam(i,k) + + + ! recalculate effective radius for constant number, in order to separate + ! first and second indirect effects + !====================================== + ! assume constant number of 10^8 kg-1 + + dumnc(i,k)=1.e8_r8 + + ! Pass in "false" adjust flag to prevent number from being changed within + ! size distribution subroutine. + call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & + pgam(i,k), lamc(i,k)) + + effc_fn(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 + + else + effc(i,k) = 10._r8 + lamcrad(i,k)=0._r8 + pgamrad(i,k)=0._r8 + effc_fn(i,k) = 10._r8 + end if + enddo + enddo + ! recalculate 'final' rain size distribution parameters + ! to ensure that rain size is in bounds, adjust rain number if needed + do k=1,nlev + do i=1,mgncol + + if (dumr(i,k).ge.qsmall) then + + dum = dumnr(i,k) + + call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & + lamr(i,k)) + + if (dum /= dumnr(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + nrtend(i,k)=(dumnr(i,k)*precip_frac(i,k)-nr(i,k))/deltat + end if + + end if + enddo + enddo + ! recalculate 'final' snow size distribution parameters + ! to ensure that snow size is in bounds, adjust snow number if needed + do k=1,nlev + do i=1,mgncol + if (dums(i,k).ge.qsmall) then + + dum = dumns(i,k) + + call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & + lams(i,k), n0=dumns0) + + if (dum /= dumns(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + nstend(i,k)=(dumns(i,k)*precip_frac(i,k)-ns(i,k))/deltat + end if + + sadsnow(i,k) = 2._r8*pi*(lams(i,k)**(-3))*dumns0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 + + end if + + + end do ! vertical k loop + enddo + do k=1,nlev + do i=1,mgncol + ! if updated q (after microphysics) is zero, then ensure updated n is also zero + !================================================================================= + if (qc(i,k)+qctend(i,k)*deltat.lt.qsmall) nctend(i,k)=-nc(i,k)/deltat + if (do_cldice .and. qi(i,k)+qitend(i,k)*deltat.lt.qsmall) nitend(i,k)=-ni(i,k)/deltat + if (qr(i,k)+qrtend(i,k)*deltat.lt.qsmall) nrtend(i,k)=-nr(i,k)/deltat + if (qs(i,k)+qstend(i,k)*deltat.lt.qsmall) nstend(i,k)=-ns(i,k)/deltat + + end do + + end do + + ! DO STUFF FOR OUTPUT: + !================================================== + + ! qc and qi are only used for output calculations past here, + ! so add qctend and qitend back in one more time + qc = qc + qctend*deltat + qi = qi + qitend*deltat + + ! averaging for snow and rain number and diameter + !-------------------------------------------------- + + ! drout2/dsout2: + ! diameter of rain and snow + ! dsout: + ! scaled diameter of snow (passed to radiation in CAM) + ! reff_rain/reff_snow: + ! calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual + + where (qrout .gt. 1.e-7_r8 & + .and. nrout.gt.0._r8) + qrout2 = qrout * precip_frac + nrout2 = nrout * precip_frac + ! The avg_diameter call does the actual calculation; other diameter + ! outputs are just drout2 times constants. + drout2 = avg_diameter(qrout, nrout, rho, rhow) + freqr = precip_frac + + reff_rain=1.5_r8*drout2*1.e6_r8 + elsewhere + qrout2 = 0._r8 + nrout2 = 0._r8 + drout2 = 0._r8 + freqr = 0._r8 + reff_rain = 0._r8 + end where + + where (qsout .gt. 1.e-7_r8 & + .and. nsout.gt.0._r8) + qsout2 = qsout * precip_frac + nsout2 = nsout * precip_frac + ! The avg_diameter call does the actual calculation; other diameter + ! outputs are just dsout2 times constants. + dsout2 = avg_diameter(qsout, nsout, rho, rhosn) + freqs = precip_frac + + dsout=3._r8*rhosn/rhows*dsout2 + + reff_snow=1.5_r8*dsout2*1.e6_r8 + elsewhere + dsout = 0._r8 + qsout2 = 0._r8 + nsout2 = 0._r8 + dsout2 = 0._r8 + freqs = 0._r8 + reff_snow=0._r8 + end where + + ! analytic radar reflectivity + !-------------------------------------------------- + ! formulas from Matthew Shupe, NOAA/CERES + ! *****note: radar reflectivity is local (in-precip average) + ! units of mm^6/m^3 + + do i = 1,mgncol + do k=1,nlev + if (qc(i,k).ge.qsmall .and. (nc(i,k)+nctend(i,k)*deltat).gt.10._r8) then + dum=(qc(i,k)/lcldm(i,k)*rho(i,k)*1000._r8)**2 & + /(0.109_r8*(nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)/1.e6_r8)*lcldm(i,k)/precip_frac(i,k) + else + dum=0._r8 + end if + if (qi(i,k).ge.qsmall) then + dum1=(qi(i,k)*rho(i,k)/icldm(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)*icldm(i,k)/precip_frac(i,k) + else + dum1=0._r8 + end if + + if (qsout(i,k).ge.qsmall) then + dum1=dum1+(qsout(i,k)*rho(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8) + end if + + refl(i,k)=dum+dum1 + + ! add rain rate, but for 37 GHz formulation instead of 94 GHz + ! formula approximated from data of Matrasov (2007) + ! rainrt is the rain rate in mm/hr + ! reflectivity (dum) is in DBz + + if (rainrt(i,k).ge.0.001_r8) then + dum=log10(rainrt(i,k)**6._r8)+16._r8 + + ! convert from DBz to mm^6/m^3 + + dum = 10._r8**(dum/10._r8) + else + ! don't include rain rate in R calculation for values less than 0.001 mm/hr + dum=0._r8 + end if + + ! add to refl + + refl(i,k)=refl(i,k)+dum + + !output reflectivity in Z. + areflz(i,k)=refl(i,k) * precip_frac(i,k) + + ! convert back to DBz + + if (refl(i,k).gt.minrefl) then + refl(i,k)=10._r8*log10(refl(i,k)) + else + refl(i,k)=-9999._r8 + end if + + !set averaging flag + if (refl(i,k).gt.mindbz) then + arefl(i,k)=refl(i,k) * precip_frac(i,k) + frefl(i,k)=precip_frac(i,k) + else + arefl(i,k)=0._r8 + areflz(i,k)=0._r8 + frefl(i,k)=0._r8 + end if + + ! bound cloudsat reflectivity + + csrfl(i,k)=min(csmax,refl(i,k)) + + !set averaging flag + if (csrfl(i,k).gt.csmin) then + acsrfl(i,k)=refl(i,k) * precip_frac(i,k) + fcsrfl(i,k)=precip_frac(i,k) + else + acsrfl(i,k)=0._r8 + fcsrfl(i,k)=0._r8 + end if + + end do + end do + + !redefine fice here.... + dum_2D = qsout + qrout + qc + qi + dumi = qsout + qi + where (dumi .gt. qsmall .and. dum_2D .gt. qsmall) + nfice=min(dumi/dum_2D,1._r8) + elsewhere + nfice=0._r8 + end where + +end subroutine micro_mg_tend + +!======================================================================== +!OUTPUT CALCULATIONS +!======================================================================== + +subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol) + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: lamr ! rain size parameter (slope) + real(r8), dimension(mgncol), intent(in) :: n0r ! rain size parameter (intercept) + real(r8), dimension(mgncol), intent(in) :: lamc ! size distribution parameter (slope) + real(r8), dimension(mgncol), intent(in) :: pgam ! droplet size parameter + real(r8), dimension(mgncol), intent(in) :: qric ! in-cloud rain mass mixing ratio + real(r8), dimension(mgncol), intent(in) :: qcic ! in-cloud cloud liquid + real(r8), dimension(mgncol), intent(in) :: ncic ! in-cloud droplet number concentration + + real(r8), dimension(mgncol), intent(inout) :: rercld ! effective radius calculation for rain + cloud + + ! combined size of precip & cloud drops + real(r8) :: Atmp + + integer :: i + + do i=1,mgncol + ! Rain drops + if (lamr(i) > 0._r8) then + Atmp = n0r(i) * pi / (2._r8 * lamr(i)**3._r8) + else + Atmp = 0._r8 + end if + + ! Add cloud drops + if (lamc(i) > 0._r8) then + Atmp = Atmp + & + ncic(i) * pi * rising_factorial(pgam(i)+1._r8, 2)/(4._r8 * lamc(i)**2._r8) + end if + + if (Atmp > 0._r8) then + rercld(i) = rercld(i) + 3._r8 *(qric(i) + qcic(i)) / (4._r8 * rhow * Atmp) + end if + enddo +end subroutine calc_rercld + +!======================================================================== +!UTILITIES +!======================================================================== + +pure subroutine micro_mg_get_cols(ncol, nlev, top_lev, qcn, qin, & + qrn, qsn, mgncol, mgcols) + + ! Determines which columns microphysics should operate over by + ! checking for non-zero cloud water/ice. + + integer, intent(in) :: ncol ! Number of columns with meaningful data + integer, intent(in) :: nlev ! Number of levels to use + integer, intent(in) :: top_lev ! Top level for microphysics + + real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: qrn(:,:) ! rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(:,:) ! snow mixing ratio (kg/kg) + + integer, intent(out) :: mgncol ! Number of columns MG will use + integer, allocatable, intent(out) :: mgcols(:) ! column indices + + integer :: lev_offset ! top_lev - 1 (defined here for consistency) + logical :: ltrue(ncol) ! store tests for each column + + integer :: i, ii ! column indices + + if (allocated(mgcols)) deallocate(mgcols) + + lev_offset = top_lev - 1 + + ! Using "any" along dimension 2 collapses across levels, but + ! not columns, so we know if water is present at any level + ! in each column. + + ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qrn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qsn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + + ! Scan for true values to get a usable list of indices. + + mgncol = count(ltrue) + allocate(mgcols(mgncol)) + i = 0 + do ii = 1,ncol + if (ltrue(ii)) then + i = i + 1 + mgcols(i) = ii + end if + end do + +end subroutine micro_mg_get_cols + +end module micro_mg2_0 diff --git a/src/physics/cam/micro_mg_cam.F90 b/src/physics/cam/micro_mg_cam.F90 new file mode 100644 index 0000000000..d36978ac29 --- /dev/null +++ b/src/physics/cam/micro_mg_cam.F90 @@ -0,0 +1,3046 @@ +module micro_mg_cam + +!--------------------------------------------------------------------------------- +! +! CAM Interfaces for MG microphysics +! +!--------------------------------------------------------------------------------- +! +! How to add new packed MG inputs to micro_mg_cam_tend: +! +! If you have an input with first dimension [psetcols, pver], the procedure +! for adding inputs is as follows: +! +! 1) In addition to any variables you need to declare for the "unpacked" +! (CAM format) version, you must declare an array for the "packed" +! (MG format) version. +! +! 2) Add a call similar to the following line (look before the +! micro_mg_tend calls to see similar lines): +! +! packed_array = packer%pack(original_array) +! +! The packed array can then be passed into any of the MG schemes. +! +! This same procedure will also work for 1D arrays of size psetcols, 3-D +! arrays with psetcols and pver as the first dimensions, and for arrays of +! dimension [psetcols, pverp]. You only have to modify the allocation of +! the packed array before the "pack" call. +! +!--------------------------------------------------------------------------------- +! +! How to add new packed MG outputs to micro_mg_cam_tend: +! +! 1) As with inputs, in addition to the unpacked outputs you must declare +! an array for packed data. The unpacked and packed arrays must *also* +! be targets or pointers (but cannot be both). +! +! 2) Add the field to post-processing as in the following line (again, +! there are many examples before the micro_mg_tend calls): +! +! call post_proc%add_field(p(final_array),p(packed_array)) +! +! *** IMPORTANT ** If the fields are only being passed to a certain version of +! MG, you must only add them if that version is being called (see +! the "if (micro_mg_version >1)" sections below +! +! This registers the field for post-MG averaging, and to scatter to the +! final, unpacked version of the array. +! +! By default, any columns/levels that are not operated on by MG will be +! set to 0 on output; this value can be adjusted using the "fillvalue" +! optional argument to post_proc%add_field. +! +! Also by default, outputs from multiple substeps will be averaged after +! MG's substepping is complete. Passing the optional argument +! "accum_method=accum_null" will change this behavior so that the last +! substep is always output. +! +! This procedure works on 1-D and 2-D outputs. Note that the final, +! unpacked arrays are not set until the call to +! "post_proc%process_and_unpack", which sets every single field that was +! added with post_proc%add_field. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, psubcols +use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, & + latvap, latice, mwh2o +use phys_control, only: phys_getopts, use_hetfrz_classnuc + + +use physics_types, only: physics_state, physics_ptend, & + physics_ptend_init, physics_state_copy, & + physics_update, physics_state_dealloc, & + physics_ptend_sum, physics_ptend_scale + +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, & + pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, & + pbuf_get_field, pbuf_set_field, col_type_subcol, & + pbuf_register_subcol +use constituents, only: cnst_add, cnst_get_ind, & + cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst + +use cldfrc2m, only: rhmini=>rhmini_const + +use cam_history, only: addfld, add_default, outfld, horiz_only + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use scamMod, only: single_column +use error_messages, only: handle_errmsg +use ref_pres, only: top_lev=>trop_cloud_top_lev + +use subcol_utils, only: subcol_get_scheme + +implicit none +private +save + +public :: & + micro_mg_cam_readnl, & + micro_mg_cam_register, & + micro_mg_cam_init_cnst, & + micro_mg_cam_implements_cnst, & + micro_mg_cam_init, & + micro_mg_cam_tend, & + micro_mg_version + +integer :: micro_mg_version = 1 ! Version number for MG. +integer :: micro_mg_sub_version = 0 ! Second part of version number. + +real(r8) :: micro_mg_dcs = -1._r8 + +logical :: microp_uniform = .false. +logical :: micro_mg_adjust_cpt = .false. + +character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method + +real(r8) :: micro_mg_berg_eff_factor = 1.0_r8 ! berg efficiency factor + +logical, public :: do_cldliq ! Prognose cldliq flag +logical, public :: do_cldice ! Prognose cldice flag + +integer :: num_steps ! Number of MG substeps + +integer :: ncnst = 4 ! Number of constituents + +! Namelist variables for option to specify constant cloud droplet/ice number +logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number +logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number +! parameters for specified ice and droplet number concentration +! note: these are local in-cloud values, not grid-mean +real(r8) :: micro_mg_ncnst = 100.e6_r8 ! constant droplet num concentration (m-3) +real(r8) :: micro_mg_ninst = 0.1e6_r8 ! constant ice num concentration (m-3) + +character(len=8), parameter :: & ! Constituent names + cnst_names(8) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', & + 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO'/) + +integer :: & + ixcldliq = -1, &! cloud liquid amount index + ixcldice = -1, &! cloud ice amount index + ixnumliq = -1, &! cloud liquid number index + ixnumice = -1, &! cloud ice water index + ixrain = -1, &! rain index + ixsnow = -1, &! snow index + ixnumrain = -1, &! rain number index + ixnumsnow = -1 ! snow number index + +! Physics buffer indices for fields registered by this module +integer :: & + cldo_idx, & + qme_idx, & + prain_idx, & + nevapr_idx, & + wsedl_idx, & + rei_idx, & + sadice_idx, & + sadsnow_idx, & + rel_idx, & + dei_idx, & + mu_idx, & + prer_evap_idx, & + lambdac_idx, & + iciwpst_idx, & + iclwpst_idx, & + des_idx, & + icswp_idx, & + cldfsnow_idx, & + rate1_cw2pr_st_idx = -1, & + ls_flxprc_idx, & + ls_flxsnw_idx, & + relvar_idx, & + cmeliq_idx, & + accre_enhan_idx + +! Fields for UNICON +integer :: & + am_evp_st_idx, &! Evaporation area of stratiform precipitation + evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0. + evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0. + +! Fields needed as inputs to COSP +integer :: & + ls_mrprc_idx, ls_mrsnw_idx, & + ls_reffrain_idx, ls_reffsnow_idx, & + cv_reffliq_idx, cv_reffice_idx + +! Fields needed by Park macrophysics +integer :: & + cc_t_idx, cc_qv_idx, & + cc_ql_idx, cc_qi_idx, & + cc_nl_idx, cc_ni_idx, & + cc_qlst_idx + +! Used to replace aspects of MG microphysics +! (e.g. by CARMA) +integer :: & + tnd_qsnow_idx = -1, & + tnd_nsnow_idx = -1, & + re_ice_idx = -1 + +! Index fields for precipitation efficiency. +integer :: & + acpr_idx = -1, & + acgcme_idx = -1, & + acnum_idx = -1 + +! Physics buffer indices for fields registered by other modules +integer :: & + ast_idx = -1, & + cld_idx = -1, & + concld_idx = -1, & + qsatfac_idx = -1 + +! Pbuf fields needed for subcol_SILHS +integer :: & + qrain_idx=-1, qsnow_idx=-1, & + nrain_idx=-1, nsnow_idx=-1 + +integer :: & + naai_idx = -1, & + naai_hom_idx = -1, & + npccn_idx = -1, & + rndst_idx = -1, & + nacon_idx = -1, & + prec_str_idx = -1, & + snow_str_idx = -1, & + prec_pcw_idx = -1, & + snow_pcw_idx = -1, & + prec_sed_idx = -1, & + snow_sed_idx = -1 + +! pbuf fields for heterogeneous freezing +integer :: & + frzimm_idx = -1, & + frzcnt_idx = -1, & + frzdep_idx = -1 + + logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop + logical :: micro_do_sb_physics = .false. ! do SB 2001 autoconversion and accretion + +interface p + module procedure p1 + module procedure p2 +end interface p + + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_mg_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, & + mpi_logical, mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Namelist variables + logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice + logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq + integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now). + + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'micro_mg_cam_readnl' + + namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, & + micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, & + microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, & + micro_mg_berg_eff_factor, micro_do_sb_physics, micro_mg_adjust_cpt, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'micro_mg_nl', status=ierr) + if (ierr == 0) then + read(unitn, micro_mg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + do_cldice = micro_mg_do_cldice + do_cldliq = micro_mg_do_cldliq + num_steps = micro_mg_num_steps + + ! Verify that version numbers are valid. + select case (micro_mg_version) + case (1) + select case (micro_mg_sub_version) + case(0) + ! MG version 1.0 + case default + call bad_version_endrun() + end select + case (2) + select case (micro_mg_sub_version) + case(0) + ! MG version 2.0 + case default + call bad_version_endrun() + end select + case default + call bad_version_endrun() + end select + + if (micro_mg_dcs < 0._r8) call endrun( "micro_mg_cam_readnl: & + µ_mg_dcs has not been set to a valid value.") + end if + + ! Broadcast namelist variables + call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version") + + call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version") + + call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice") + + call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq") + + call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps") + + call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform") + + call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs") + + call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor") + + call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method") + + call mpi_bcast(micro_do_sb_physics, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_sb_physics") + + call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt") + + call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons") + + call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons") + + call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst") + + call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst") + + if (masterproc) then + + write(iulog,*) 'MG microphysics namelist:' + write(iulog,*) ' micro_mg_version = ', micro_mg_version + write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version + write(iulog,*) ' micro_mg_do_cldice = ', do_cldice + write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq + write(iulog,*) ' micro_mg_num_steps = ', num_steps + write(iulog,*) ' microp_uniform = ', microp_uniform + write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs + write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor + write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method + write(iulog,*) ' micro_do_sb_physics = ', micro_do_sb_physics + write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt + write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons + write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons + write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst + write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst + end if + +contains + + subroutine bad_version_endrun + ! Endrun wrapper with a more useful error message. + character(len=128) :: errstring + write(errstring,*) "Invalid version number specified for MG microphysics: ", & + micro_mg_version,".",micro_mg_sub_version + call endrun(errstring) + end subroutine bad_version_endrun + +end subroutine micro_mg_cam_readnl + +!================================================================================================ + +subroutine micro_mg_cam_register + + ! Register microphysics constituents and fields in the physics buffer. + !----------------------------------------------------------------------- + + logical :: prog_modal_aero + logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics + + call phys_getopts(use_subcol_microp_out = use_subcol_microp, & + prog_modal_aero_out = prog_modal_aero) + + ! Register microphysics constituents and save indices. + + call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & + longname='Grid box averaged cloud ice amount', is_convtran1=.true.) + + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & + longname='Grid box averaged cloud liquid number', is_convtran1=.true.) + call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & + longname='Grid box averaged cloud ice number', is_convtran1=.true.) + + ! Note is_convtran1 is set to .true. + if (micro_mg_version > 1) then + call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, & + longname='Grid box averaged rain amount', is_convtran1=.true.) + call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, & + longname='Grid box averaged snow amount', is_convtran1=.true.) + call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, & + longname='Grid box averaged rain number', is_convtran1=.true.) + call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, & + longname='Grid box averaged snow number', is_convtran1=.true.) + end if + + ! Request physics buffer space for fields that persist across timesteps. + + call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx) + + ! Physics buffer variables for convective cloud properties. + + call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx) + call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx) + call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx) + call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx) + + call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx) + + call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx) + call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx) + call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx) + call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx) + ! In cloud snow water path for radiation + call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) + + if (prog_modal_aero) then + call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx) + endif + + call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx) + call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx) + + + ! Fields needed as inputs to COSP + call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx) + call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx) + call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx) + call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx) + call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx) + call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx) + call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx) + call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx) + call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx) + call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx) + call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx) + call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx) + + ! Fields for UNICON + call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx) + call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx) + call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx) + + ! Register subcolumn pbuf fields + if (use_subcol_microp) then + ! Global pbuf fields + call pbuf_register_subcol('CLDO', 'micro_mg_cam_register', cldo_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_register_subcol('CC_T', 'micro_mg_cam_register', cc_t_idx) + call pbuf_register_subcol('CC_qv', 'micro_mg_cam_register', cc_qv_idx) + call pbuf_register_subcol('CC_ql', 'micro_mg_cam_register', cc_ql_idx) + call pbuf_register_subcol('CC_qi', 'micro_mg_cam_register', cc_qi_idx) + call pbuf_register_subcol('CC_nl', 'micro_mg_cam_register', cc_nl_idx) + call pbuf_register_subcol('CC_ni', 'micro_mg_cam_register', cc_ni_idx) + call pbuf_register_subcol('CC_qlst', 'micro_mg_cam_register', cc_qlst_idx) + + ! Physpkg pbuf fields + ! Physics buffer variables for convective cloud properties. + + call pbuf_register_subcol('QME', 'micro_mg_cam_register', qme_idx) + call pbuf_register_subcol('PRAIN', 'micro_mg_cam_register', prain_idx) + call pbuf_register_subcol('NEVAPR', 'micro_mg_cam_register', nevapr_idx) + call pbuf_register_subcol('PRER_EVAP', 'micro_mg_cam_register', prer_evap_idx) + + call pbuf_register_subcol('WSEDL', 'micro_mg_cam_register', wsedl_idx) + + call pbuf_register_subcol('REI', 'micro_mg_cam_register', rei_idx) + call pbuf_register_subcol('SADICE', 'micro_mg_cam_register', sadice_idx) + call pbuf_register_subcol('SADSNOW', 'micro_mg_cam_register', sadsnow_idx) + call pbuf_register_subcol('REL', 'micro_mg_cam_register', rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_register_subcol('DEI', 'micro_mg_cam_register', dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('MU', 'micro_mg_cam_register', mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('LAMBDAC', 'micro_mg_cam_register', lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_register_subcol('ICIWPST', 'micro_mg_cam_register', iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_register_subcol('ICLWPST', 'micro_mg_cam_register', iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_register_subcol('DES', 'micro_mg_cam_register', des_idx) + ! In cloud snow water path for radiation + call pbuf_register_subcol('ICSWP', 'micro_mg_cam_register', icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_register_subcol('CLDFSNOW ', 'micro_mg_cam_register', cldfsnow_idx) + + if (prog_modal_aero) then + call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_mg_cam_register', rate1_cw2pr_st_idx) + end if + + call pbuf_register_subcol('LS_FLXPRC', 'micro_mg_cam_register', ls_flxprc_idx) + call pbuf_register_subcol('LS_FLXSNW', 'micro_mg_cam_register', ls_flxsnw_idx) + + ! Fields needed as inputs to COSP + call pbuf_register_subcol('LS_MRPRC', 'micro_mg_cam_register', ls_mrprc_idx) + call pbuf_register_subcol('LS_MRSNW', 'micro_mg_cam_register', ls_mrsnw_idx) + call pbuf_register_subcol('LS_REFFRAIN', 'micro_mg_cam_register', ls_reffrain_idx) + call pbuf_register_subcol('LS_REFFSNOW', 'micro_mg_cam_register', ls_reffsnow_idx) + call pbuf_register_subcol('CV_REFFLIQ', 'micro_mg_cam_register', cv_reffliq_idx) + call pbuf_register_subcol('CV_REFFICE', 'micro_mg_cam_register', cv_reffice_idx) + end if + + ! Additional pbuf for CARMA interface + if (.not. do_cldice) then + call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx) + call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx) + call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx) + end if + + ! Precipitation efficiency fields across timesteps. + call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip + call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation + call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps + + ! SGS variability -- These could be reset by CLUBB so they need to be grid only + call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx) + call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx) + + ! Diagnostic fields needed for subcol_SILHS, need to be grid-only + if (subcol_get_scheme() == 'SILHS') then + call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx) + call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx) + call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx) + call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx) + end if + +end subroutine micro_mg_cam_register + +!=============================================================================== + +function micro_mg_cam_implements_cnst(name) + + ! Return true if specified constituent is implemented by the + ! microphysics package + + character(len=*), intent(in) :: name ! constituent name + logical :: micro_mg_cam_implements_cnst ! return value + + !----------------------------------------------------------------------- + + micro_mg_cam_implements_cnst = any(name == cnst_names) + +end function micro_mg_cam_implements_cnst + +!=============================================================================== + +subroutine micro_mg_cam_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize the microphysics constituents, if they are + ! not read from the initial file. + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + integer :: k + + if (micro_mg_cam_implements_cnst(name)) then + do k = 1, size(q, 2) + where(mask) + q(:, k) = 0.0_r8 + end where + end do + end if + +end subroutine micro_mg_cam_init_cnst + +!=============================================================================== + +subroutine micro_mg_cam_init(pbuf2d) + use time_manager, only: is_first_step + use micro_mg_utils, only: micro_mg_utils_init + use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init + use micro_mg2_0, only: micro_mg_init2_0 => micro_mg_init + + !----------------------------------------------------------------------- + ! + ! Initialization for MG microphysics + ! + !----------------------------------------------------------------------- + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: m, mm + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_budget ! Output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + logical :: use_subcol_microp + logical :: do_clubb_sgs + integer :: budget_histfile ! output history file number for budget fields + integer :: ierr + character(128) :: errstring ! return status (non-blank for error return) + + !----------------------------------------------------------------------- + + call phys_getopts(use_subcol_microp_out=use_subcol_microp, & + do_clubb_sgs_out =do_clubb_sgs) + + if (do_clubb_sgs) then + allow_sed_supersat = .false. + else + allow_sed_supersat = .true. + endif + + if (masterproc) then + write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version + if (.not. do_cldliq) & + write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist." + if (.not. do_cldice) & + write(iulog,*) "MG prognostic cloud ice has been turned off via namelist." + write(iulog,*) "Number of microphysics substeps is: ",num_steps + end if + + select case (micro_mg_version) + case (1) + ! Set constituent number for later loops. + ncnst = 4 + + select case (micro_mg_sub_version) + case (0) + ! MG 1 does not initialize micro_mg_utils, so have to do it here. + call micro_mg_utils_init(r8, rh2o, cpair, tmelt, latvap, latice, & + micro_mg_dcs, errstring) + call handle_errmsg(errstring, subname="micro_mg_utils_init") + + call micro_mg_init1_0( & + r8, gravit, rair, rh2o, cpair, & + rhoh2o, tmelt, latvap, latice, & + rhmini, micro_mg_dcs, use_hetfrz_classnuc, & + micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & + micro_mg_ninst, errstring) + end select + case (2) + ! Set constituent number for later loops. + ncnst = 8 + + select case (micro_mg_sub_version) + case (0) + call micro_mg_init2_0( & + r8, gravit, rair, rh2o, cpair, & + tmelt, latvap, latice, rhmini, & + micro_mg_dcs, & + microp_uniform, do_cldice, use_hetfrz_classnuc, & + micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + allow_sed_supersat, micro_do_sb_physics, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & + micro_mg_ninst, errstring) + end select + end select + + call handle_errmsg(errstring, subname="micro_mg_init") + + ! Register history variables + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow /)) ) then + ! mass mixing ratios + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm) ) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux') + else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow /)) ) then + ! number concentrations + call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm) ) + call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux') + else + call endrun( "micro_mg_cam_init: & + &Could not call addfld for constituent with unknown units.") + endif + end do + + call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' ) + call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' ) + call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' ) + call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' ) + + if (micro_mg_version > 1) then + call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics' ) + call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics' ) + call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics' ) + call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics' ) + end if + + call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud' ) + call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip' ) + call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip' ) + call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow' ) + call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds' ) + call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud' ) + call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow' ) + call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio' ) + call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio' ) + + ! MG microphysics diagnostics + call addfld ('QCSEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water' ) + call addfld ('QISEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice' ) + call addfld ('QVRES', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term' ) + call addfld ('CMEIOUT', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice' ) + call addfld ('VTRMC', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed' ) + call addfld ('VTRMI', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed' ) + call addfld ('QCSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation' ) + call addfld ('QISEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation' ) + call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain' ) + call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water' ) + call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water' ) + call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water' ) + call addfld ('MNUCCDO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor' ) + call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor' ) + call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering' ) + call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow' ) + call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron' ) + call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron' ) + call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice' ) + call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water' ) + call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water' ) + call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice' ) + call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice by rain' ) + call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice' ) + call addfld ('MNUCCRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow' ) + call addfld ('PRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow' ) + call addfld ('MELTSDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow' ) + call addfld ('FRZRDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain' ) + if (micro_mg_version > 1) then + call addfld ('QRSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation' ) + call addfld ('QSSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation' ) + end if + + ! History variables for CAM5 microphysics + call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' ) + call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' ) + call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics' ) + call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics' ) + call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics' ) + call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics' ) + call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics' ) + call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics' ) + call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics' ) + call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics' ) + call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc' ) + call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc' ) + call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)' ) + call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration' ) + call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Liquid WP (Before Micro)' ) + call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Ice WP (Before Micro)' ) + + ! This is provided as an example on how to write out subcolumn output + ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step + if (use_subcol_microp) then + call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', & + 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8) + end if + + + ! This is only if the coldpoint temperatures are being adjusted. + ! NOTE: Some fields related to these and output later are added in tropopause.F90. + if (micro_mg_adjust_cpt) then + call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment' ) + call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment' ) + call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment' ) + call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level' ) + end if + + + ! Averaging for cloud particle number and size + call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc' ) + call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc' ) + call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius' ) + call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius' ) + ! Frequency arrays for above + call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid' ) + call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice' ) + + ! Average cloud top particle size and number (liq, ice) and frequency + call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius' ) + call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius' ) + call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number' ) + call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number' ) + + call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid' ) + call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice' ) + + ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere.. + call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase' ) + call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid' ) + call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice' ) + call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase' ) + call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid' ) + call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice' ) + + call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux' ) + call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux' ) + + call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid' ) + call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice' ) + call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius' ) + call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius' ) + call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius' ) + call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius' ) + call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice' ) + call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow' ) + + ! diagnostic precip + call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio' ) + call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio' ) + call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc' ) + call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc' ) + + ! size of precip + call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain' ) + call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter' ) + + ! diagnostic radar reflectivity, cloud-averaged + call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity' ) + call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity' ) + call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity' ) + + call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)' ) + call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)' ) + call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)' ) + + call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity' ) + + ! Aerosol information + call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid' ) + call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice' ) + + ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency + call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio' ) + call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio' ) + call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc' ) + call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc' ) + call addfld ('ADRAIN', (/ 'lev' /), 'A', 'Micron', 'Average rain effective Diameter' ) + call addfld ('ADSNOW', (/ 'lev' /), 'A', 'Micron', 'Average snow effective Diameter' ) + call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain' ) + call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow' ) + + ! precipitation efficiency & other diagnostic fields + call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)' ) + call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation' ) + call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported' ) + call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate' ) + call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate' ) + call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average' ) + + if (micro_mg_version > 1) then + call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed' ) + call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed' ) + end if + + ! qc limiter (only output in versions 1.5 and later) + if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then + call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied') + end if + + ! determine the add_default fields + call phys_getopts(history_amwg_out = history_amwg , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = budget_histfile) + + if (history_amwg) then + call add_default ('FICE ', 1, ' ') + call add_default ('AQRAIN ', 1, ' ') + call add_default ('AQSNOW ', 1, ' ') + call add_default ('ANRAIN ', 1, ' ') + call add_default ('ANSNOW ', 1, ' ') + call add_default ('ADRAIN ', 1, ' ') + call add_default ('ADSNOW ', 1, ' ') + call add_default ('AREI ', 1, ' ') + call add_default ('AREL ', 1, ' ') + call add_default ('AWNC ', 1, ' ') + call add_default ('AWNI ', 1, ' ') + call add_default ('CDNUMC ', 1, ' ') + call add_default ('FREQR ', 1, ' ') + call add_default ('FREQS ', 1, ' ') + call add_default ('FREQL ', 1, ' ') + call add_default ('FREQI ', 1, ' ') + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + call add_default(cnst_name(mm), 1, ' ') + ! call add_default(sflxnam(mm), 1, ' ') + end do + end if + + if ( history_budget ) then + call add_default ('EVAPSNOW ', budget_histfile, ' ') + call add_default ('EVAPPREC ', budget_histfile, ' ') + call add_default ('QVRES ', budget_histfile, ' ') + call add_default ('QISEVAP ', budget_histfile, ' ') + call add_default ('QCSEVAP ', budget_histfile, ' ') + call add_default ('QISEDTEN ', budget_histfile, ' ') + call add_default ('QCSEDTEN ', budget_histfile, ' ') + call add_default ('QIRESO ', budget_histfile, ' ') + call add_default ('QCRESO ', budget_histfile, ' ') + if (micro_mg_version > 1) then + call add_default ('QRSEDTEN ', budget_histfile, ' ') + call add_default ('QSSEDTEN ', budget_histfile, ' ') + end if + call add_default ('PSACWSO ', budget_histfile, ' ') + call add_default ('PRCO ', budget_histfile, ' ') + call add_default ('PRCIO ', budget_histfile, ' ') + call add_default ('PRAO ', budget_histfile, ' ') + call add_default ('PRAIO ', budget_histfile, ' ') + call add_default ('PRACSO ', budget_histfile, ' ') + call add_default ('MSACWIO ', budget_histfile, ' ') + call add_default ('MPDW2V ', budget_histfile, ' ') + call add_default ('MPDW2P ', budget_histfile, ' ') + call add_default ('MPDW2I ', budget_histfile, ' ') + call add_default ('MPDT ', budget_histfile, ' ') + call add_default ('MPDQ ', budget_histfile, ' ') + call add_default ('MPDLIQ ', budget_histfile, ' ') + call add_default ('MPDICE ', budget_histfile, ' ') + call add_default ('MPDI2W ', budget_histfile, ' ') + call add_default ('MPDI2V ', budget_histfile, ' ') + call add_default ('MPDI2P ', budget_histfile, ' ') + call add_default ('MNUCCTO ', budget_histfile, ' ') + call add_default ('MNUCCRO ', budget_histfile, ' ') + call add_default ('MNUCCCO ', budget_histfile, ' ') + call add_default ('MELTSDT ', budget_histfile, ' ') + call add_default ('MELTO ', budget_histfile, ' ') + call add_default ('HOMOO ', budget_histfile, ' ') + call add_default ('FRZRDT ', budget_histfile, ' ') + call add_default ('CMEIOUT ', budget_histfile, ' ') + call add_default ('BERGSO ', budget_histfile, ' ') + call add_default ('BERGO ', budget_histfile, ' ') + + call add_default(cnst_name(ixcldliq), budget_histfile, ' ') + call add_default(cnst_name(ixcldice), budget_histfile, ' ') + call add_default(apcnst (ixcldliq), budget_histfile, ' ') + call add_default(apcnst (ixcldice), budget_histfile, ' ') + call add_default(bpcnst (ixcldliq), budget_histfile, ' ') + call add_default(bpcnst (ixcldice), budget_histfile, ' ') + if (micro_mg_version > 1) then + call add_default(cnst_name(ixrain), budget_histfile, ' ') + call add_default(cnst_name(ixsnow), budget_histfile, ' ') + call add_default(apcnst (ixrain), budget_histfile, ' ') + call add_default(apcnst (ixsnow), budget_histfile, ' ') + call add_default(bpcnst (ixrain), budget_histfile, ' ') + call add_default(bpcnst (ixsnow), budget_histfile, ' ') + end if + + end if + + ! physics buffer indices + ast_idx = pbuf_get_index('AST') + cld_idx = pbuf_get_index('CLD') + concld_idx = pbuf_get_index('CONCLD') + + naai_idx = pbuf_get_index('NAAI') + naai_hom_idx = pbuf_get_index('NAAI_HOM') + npccn_idx = pbuf_get_index('NPCCN') + rndst_idx = pbuf_get_index('RNDST') + nacon_idx = pbuf_get_index('NACON') + + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + prec_sed_idx = pbuf_get_index('PREC_SED') + snow_sed_idx = pbuf_get_index('SNOW_SED') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + + cmeliq_idx = pbuf_get_index('CMELIQ') + + ! These fields may have been added, so don't abort if they have not been + qsatfac_idx = pbuf_get_index('QSATFAC', ierr) + qrain_idx = pbuf_get_index('QRAIN', ierr) + qsnow_idx = pbuf_get_index('QSNOW', ierr) + nrain_idx = pbuf_get_index('NRAIN', ierr) + nsnow_idx = pbuf_get_index('NSNOW', ierr) + + ! fields for heterogeneous freezing + frzimm_idx = pbuf_get_index('FRZIMM', ierr) + frzcnt_idx = pbuf_get_index('FRZCNT', ierr) + frzdep_idx = pbuf_get_index('FRZDEP', ierr) + + ! Initialize physics buffer grid fields for accumulating precip and condensation + if (is_first_step()) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8) + call pbuf_set_field(pbuf2d, acpr_idx, 0._r8) + call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8) + call pbuf_set_field(pbuf2d, acnum_idx, 0) + call pbuf_set_field(pbuf2d, relvar_idx, 2._r8) + call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8) + call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8) + + if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8) + if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8) + if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8) + if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8) + + ! If sub-columns turned on, need to set the sub-column fields as well + if (use_subcol_microp) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8, col_type=col_type_subcol) + end if + + end if + +end subroutine micro_mg_cam_init + +!=============================================================================== + +subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) + + use micro_mg1_0, only: micro_mg_get_cols1_0 => micro_mg_get_cols + use micro_mg2_0, only: micro_mg_get_cols2_0 => micro_mg_get_cols + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend + real(r8), intent(in) :: dtime + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables + integer :: ncol, nlev, mgncol + integer, allocatable :: mgcols(:) ! Columns with microphysics performed + + ! Find the number of levels used in the microphysics. + nlev = pver - top_lev + 1 + ncol = state%ncol + + select case (micro_mg_version) + case (1) + call micro_mg_get_cols1_0(ncol, nlev, top_lev, state%q(:,:,ixcldliq), & + state%q(:,:,ixcldice), mgncol, mgcols) + case (2) + call micro_mg_get_cols2_0(ncol, nlev, top_lev, state%q(:,:,ixcldliq), & + state%q(:,:,ixcldice), state%q(:,:,ixrain), state%q(:,:,ixsnow), & + mgncol, mgcols) + end select + + call micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) + +end subroutine micro_mg_cam_tend + +subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) + + use micro_mg_utils, only: size_dist_param_basic, size_dist_param_liq, & + mg_liq_props, mg_ice_props, avg_diameter, rhoi, rhosn, rhow, rhows, & + qsmall, mincld + + use micro_mg_data, only: MGPacker, MGPostProc, accum_null, accum_mean + + use micro_mg1_0, only: micro_mg_tend1_0 => micro_mg_tend + use micro_mg2_0, only: micro_mg_tend2_0 => micro_mg_tend + + use physics_buffer, only: pbuf_col_type_index + use subcol, only: subcol_field_avg + use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND + use wv_saturation, only: qsat + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend + real(r8), intent(in) :: dtime + type(physics_buffer_desc), pointer :: pbuf(:) + + integer, intent(in) :: nlev + integer, intent(in) :: mgncol + integer, intent(in) :: mgcols(:) + + ! Local variables + integer :: lchnk, ncol, psetcols, ngrdcol + + integer :: i, k, itim_old, it + + real(r8), pointer :: naai(:,:) ! ice nucleation number + real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous) + real(r8), pointer :: npccn(:,:) ! liquid activation number tendency + real(r8), pointer :: rndst(:,:,:) + real(r8), pointer :: nacon(:,:,:) + real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1. + real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s] + real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s] + + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] + real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation + real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation + real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ] + real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ] + + real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction + real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. + real(r8), pointer :: alst_mic(:,:) + real(r8), pointer :: aist_mic(:,:) + real(r8), pointer :: cldo(:,:) ! Old cloud fraction + real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow) + real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate + real(r8), pointer :: relvar(:,:) ! relative variance of cloud water + real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation + real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow) + real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters) (AG: microns?) + real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation + real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation + real(r8), pointer :: des(:,:) ! Snow effective diameter (m) + + real(r8) :: rho(state%psetcols,pver) + real(r8) :: cldmax(state%psetcols,pver) + + real(r8), target :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics + + real(r8), target :: tlat(state%psetcols,pver) + real(r8), target :: qvlat(state%psetcols,pver) + real(r8), target :: qcten(state%psetcols,pver) + real(r8), target :: qiten(state%psetcols,pver) + real(r8), target :: ncten(state%psetcols,pver) + real(r8), target :: niten(state%psetcols,pver) + + real(r8), target :: qrten(state%psetcols,pver) + real(r8), target :: qsten(state%psetcols,pver) + real(r8), target :: nrten(state%psetcols,pver) + real(r8), target :: nsten(state%psetcols,pver) + + real(r8), target :: prect(state%psetcols) + real(r8), target :: preci(state%psetcols) + real(r8), target :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates + real(r8), target :: evapsnow(state%psetcols,pver) ! Local evaporation of snow + real(r8), target :: prodsnow(state%psetcols,pver) ! Local production of snow + real(r8), target :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud + real(r8), target :: qsout(state%psetcols,pver) ! Snow mixing ratio + real(r8), target :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1) + real(r8), target :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1) + real(r8), target :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8), target :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8), target :: qrout(state%psetcols,pver) ! Rain mixing ratio + real(r8), target :: qcsevap(state%psetcols,pver) ! Evaporation of falling cloud water + real(r8), target :: qisevap(state%psetcols,pver) ! Sublimation of falling cloud ice + real(r8), target :: qvres(state%psetcols,pver) ! Residual condensation term to remove excess saturation + real(r8), target :: cmeiout(state%psetcols,pver) ! Deposition/sublimation rate of cloud ice + real(r8), target :: vtrmc(state%psetcols,pver) ! Mass-weighted cloud water fallspeed + real(r8), target :: vtrmi(state%psetcols,pver) ! Mass-weighted cloud ice fallspeed + real(r8), target :: umr(state%psetcols,pver) ! Mass-weighted rain fallspeed + real(r8), target :: ums(state%psetcols,pver) ! Mass-weighted snow fallspeed + real(r8), target :: qcsedten(state%psetcols,pver) ! Cloud water mixing ratio tendency from sedimentation + real(r8), target :: qisedten(state%psetcols,pver) ! Cloud ice mixing ratio tendency from sedimentation + real(r8), target :: qrsedten(state%psetcols,pver) ! Rain mixing ratio tendency from sedimentation + real(r8), target :: qssedten(state%psetcols,pver) ! Snow mixing ratio tendency from sedimentation + + real(r8), target :: prao(state%psetcols,pver) + real(r8), target :: prco(state%psetcols,pver) + real(r8), target :: mnuccco(state%psetcols,pver) + real(r8), target :: mnuccto(state%psetcols,pver) + real(r8), target :: msacwio(state%psetcols,pver) + real(r8), target :: psacwso(state%psetcols,pver) + real(r8), target :: bergso(state%psetcols,pver) + real(r8), target :: bergo(state%psetcols,pver) + real(r8), target :: melto(state%psetcols,pver) + real(r8), target :: homoo(state%psetcols,pver) + real(r8), target :: qcreso(state%psetcols,pver) + real(r8), target :: prcio(state%psetcols,pver) + real(r8), target :: praio(state%psetcols,pver) + real(r8), target :: qireso(state%psetcols,pver) + real(r8), target :: mnuccro(state%psetcols,pver) + real(r8), target :: pracso (state%psetcols,pver) + real(r8), target :: meltsdt(state%psetcols,pver) + real(r8), target :: frzrdt (state%psetcols,pver) + real(r8), target :: mnuccdo(state%psetcols,pver) + real(r8), target :: nrout(state%psetcols,pver) + real(r8), target :: nsout(state%psetcols,pver) + real(r8), target :: refl(state%psetcols,pver) ! analytic radar reflectivity + real(r8), target :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range + real(r8), target :: areflz(state%psetcols,pver) ! average reflectivity in z. + real(r8), target :: frefl(state%psetcols,pver) + real(r8), target :: csrfl(state%psetcols,pver) ! cloudsat reflectivity + real(r8), target :: acsrfl(state%psetcols,pver) ! cloudsat average + real(r8), target :: fcsrfl(state%psetcols,pver) + real(r8), target :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud + real(r8), target :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3) + real(r8), target :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3) + real(r8), target :: qrout2(state%psetcols,pver) + real(r8), target :: qsout2(state%psetcols,pver) + real(r8), target :: nrout2(state%psetcols,pver) + real(r8), target :: nsout2(state%psetcols,pver) + real(r8), target :: freqs(state%psetcols,pver) + real(r8), target :: freqr(state%psetcols,pver) + real(r8), target :: nfice(state%psetcols,pver) + real(r8), target :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit) + + ! Object that packs columns with clouds/precip. + type(MGPacker) :: packer + + ! Packed versions of inputs. + real(r8) :: packed_t(mgncol,nlev) + real(r8) :: packed_q(mgncol,nlev) + real(r8) :: packed_qc(mgncol,nlev) + real(r8) :: packed_nc(mgncol,nlev) + real(r8) :: packed_qi(mgncol,nlev) + real(r8) :: packed_ni(mgncol,nlev) + real(r8) :: packed_qr(mgncol,nlev) + real(r8) :: packed_nr(mgncol,nlev) + real(r8) :: packed_qs(mgncol,nlev) + real(r8) :: packed_ns(mgncol,nlev) + + real(r8) :: packed_relvar(mgncol,nlev) + real(r8) :: packed_accre_enhan(mgncol,nlev) + + real(r8) :: packed_p(mgncol,nlev) + real(r8) :: packed_pdel(mgncol,nlev) + + real(r8) :: packed_cldn(mgncol,nlev) + real(r8) :: packed_liqcldf(mgncol,nlev) + real(r8) :: packed_icecldf(mgncol,nlev) + real(r8), allocatable :: packed_qsatfac(:,:) + + real(r8) :: packed_naai(mgncol,nlev) + real(r8) :: packed_npccn(mgncol,nlev) + + real(r8), allocatable :: packed_rndst(:,:,:) + real(r8), allocatable :: packed_nacon(:,:,:) + + ! Optional outputs. + real(r8) :: packed_tnd_qsnow(mgncol,nlev) + real(r8) :: packed_tnd_nsnow(mgncol,nlev) + real(r8) :: packed_re_ice(mgncol,nlev) + + real(r8) :: packed_frzimm(mgncol,nlev) + real(r8) :: packed_frzcnt(mgncol,nlev) + real(r8) :: packed_frzdep(mgncol,nlev) + + ! Output field post-processing. + type(MGPostProc) :: post_proc + + ! Packed versions of outputs. + real(r8), target :: packed_rate1ord_cw2pr_st(mgncol,nlev) + real(r8), target :: packed_tlat(mgncol,nlev) + real(r8), target :: packed_qvlat(mgncol,nlev) + real(r8), target :: packed_qctend(mgncol,nlev) + real(r8), target :: packed_qitend(mgncol,nlev) + real(r8), target :: packed_nctend(mgncol,nlev) + real(r8), target :: packed_nitend(mgncol,nlev) + + real(r8), target :: packed_qrtend(mgncol,nlev) + real(r8), target :: packed_qstend(mgncol,nlev) + real(r8), target :: packed_nrtend(mgncol,nlev) + real(r8), target :: packed_nstend(mgncol,nlev) + + real(r8), target :: packed_prect(mgncol) + real(r8), target :: packed_preci(mgncol) + real(r8), target :: packed_nevapr(mgncol,nlev) + real(r8), target :: packed_am_evp_st(mgncol,nlev) + real(r8), target :: packed_evapsnow(mgncol,nlev) + real(r8), target :: packed_prain(mgncol,nlev) + real(r8), target :: packed_prodsnow(mgncol,nlev) + real(r8), target :: packed_cmeout(mgncol,nlev) + real(r8), target :: packed_qsout(mgncol,nlev) + real(r8), target :: packed_cflx(mgncol,nlev+1) + real(r8), target :: packed_iflx(mgncol,nlev+1) + real(r8), target :: packed_rflx(mgncol,nlev+1) + real(r8), target :: packed_sflx(mgncol,nlev+1) + real(r8), target :: packed_qrout(mgncol,nlev) + real(r8), target :: packed_qcsevap(mgncol,nlev) + real(r8), target :: packed_qisevap(mgncol,nlev) + real(r8), target :: packed_qvres(mgncol,nlev) + real(r8), target :: packed_cmei(mgncol,nlev) + real(r8), target :: packed_vtrmc(mgncol,nlev) + real(r8), target :: packed_vtrmi(mgncol,nlev) + real(r8), target :: packed_qcsedten(mgncol,nlev) + real(r8), target :: packed_qisedten(mgncol,nlev) + real(r8), target :: packed_qrsedten(mgncol,nlev) + real(r8), target :: packed_qssedten(mgncol,nlev) + real(r8), target :: packed_umr(mgncol,nlev) + real(r8), target :: packed_ums(mgncol,nlev) + real(r8), target :: packed_pra(mgncol,nlev) + real(r8), target :: packed_prc(mgncol,nlev) + real(r8), target :: packed_mnuccc(mgncol,nlev) + real(r8), target :: packed_mnucct(mgncol,nlev) + real(r8), target :: packed_msacwi(mgncol,nlev) + real(r8), target :: packed_psacws(mgncol,nlev) + real(r8), target :: packed_bergs(mgncol,nlev) + real(r8), target :: packed_berg(mgncol,nlev) + real(r8), target :: packed_melt(mgncol,nlev) + real(r8), target :: packed_homo(mgncol,nlev) + real(r8), target :: packed_qcres(mgncol,nlev) + real(r8), target :: packed_prci(mgncol,nlev) + real(r8), target :: packed_prai(mgncol,nlev) + real(r8), target :: packed_qires(mgncol,nlev) + real(r8), target :: packed_mnuccr(mgncol,nlev) + real(r8), target :: packed_pracs(mgncol,nlev) + real(r8), target :: packed_meltsdt(mgncol,nlev) + real(r8), target :: packed_frzrdt(mgncol,nlev) + real(r8), target :: packed_mnuccd(mgncol,nlev) + real(r8), target :: packed_nrout(mgncol,nlev) + real(r8), target :: packed_nsout(mgncol,nlev) + real(r8), target :: packed_refl(mgncol,nlev) + real(r8), target :: packed_arefl(mgncol,nlev) + real(r8), target :: packed_areflz(mgncol,nlev) + real(r8), target :: packed_frefl(mgncol,nlev) + real(r8), target :: packed_csrfl(mgncol,nlev) + real(r8), target :: packed_acsrfl(mgncol,nlev) + real(r8), target :: packed_fcsrfl(mgncol,nlev) + real(r8), target :: packed_rercld(mgncol,nlev) + real(r8), target :: packed_ncai(mgncol,nlev) + real(r8), target :: packed_ncal(mgncol,nlev) + real(r8), target :: packed_qrout2(mgncol,nlev) + real(r8), target :: packed_qsout2(mgncol,nlev) + real(r8), target :: packed_nrout2(mgncol,nlev) + real(r8), target :: packed_nsout2(mgncol,nlev) + real(r8), target :: packed_freqs(mgncol,nlev) + real(r8), target :: packed_freqr(mgncol,nlev) + real(r8), target :: packed_nfice(mgncol,nlev) + real(r8), target :: packed_prer_evap(mgncol,nlev) + real(r8), target :: packed_qcrat(mgncol,nlev) + + real(r8), target :: packed_rel(mgncol,nlev) + real(r8), target :: packed_rei(mgncol,nlev) + real(r8), target :: packed_sadice(mgncol,nlev) + real(r8), target :: packed_sadsnow(mgncol,nlev) + real(r8), target :: packed_lambdac(mgncol,nlev) + real(r8), target :: packed_mu(mgncol,nlev) + real(r8), target :: packed_des(mgncol,nlev) + real(r8), target :: packed_dei(mgncol,nlev) + + ! Dummy arrays for cases where we throw away the MG version and + ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging + ! issues. + real(r8) :: rel_fn_dum(mgncol,nlev) + real(r8) :: dsout2_dum(mgncol,nlev) + real(r8) :: drout_dum(mgncol,nlev) + real(r8) :: reff_rain_dum(mgncol,nlev) + real(r8) :: reff_snow_dum(mgncol,nlev) + + ! Heterogeneous-only version of mnuccdo. + real(r8) :: mnuccdohet(state%psetcols,pver) + + ! physics buffer fields for COSP simulator + real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) + real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) + real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg) + real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg) + real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um) + real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um) + real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um) + real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um) + + ! physics buffer fields used with CARMA + real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) + real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) + real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) + + real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of + ! strat. cloud water to precip (1/s) ! rce 2010/05/01 + real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] + + + real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency + + ! variables for heterogeneous freezing + real(r8), pointer :: frzimm(:,:) + real(r8), pointer :: frzcnt(:,:) + real(r8), pointer :: frzdep(:,:) + + real(r8), pointer :: qme(:,:) + + ! A local copy of state is used for diagnostic calculations + type(physics_state) :: state_loc + type(physics_ptend) :: ptend_loc + + real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud) + + real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns) + real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns) + real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3) + real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3) + + + real(r8), pointer :: cmeliq(:,:) + + real(r8), pointer :: cld(:,:) ! Total cloud fraction + real(r8), pointer :: concld(:,:) ! Convective cloud fraction + real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation + real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation + real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow + real(r8), pointer :: icswp(:,:) ! In-cloud snow water path + + real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio + real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc + real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc + + real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics + real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics + + ! Averaging arrays for effective radius and number.... + real(r8) :: efiout_grid(pcols,pver) + real(r8) :: efcout_grid(pcols,pver) + real(r8) :: ncout_grid(pcols,pver) + real(r8) :: niout_grid(pcols,pver) + real(r8) :: freqi_grid(pcols,pver) + real(r8) :: freql_grid(pcols,pver) + +! Averaging arrays for supercooled liquid + real(r8) :: freqm_grid(pcols,pver) + real(r8) :: freqsl_grid(pcols,pver) + real(r8) :: freqslm_grid(pcols,pver) + real(r8) :: fctm_grid(pcols) + real(r8) :: fctsl_grid(pcols) + real(r8) :: fctslm_grid(pcols) + + real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration + real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio + + ! Cloud fraction used for precipitation. + real(r8) :: cldmax_grid(pcols,pver) + + ! Average cloud top radius & number + real(r8) :: ctrel_grid(pcols) + real(r8) :: ctrei_grid(pcols) + real(r8) :: ctnl_grid(pcols) + real(r8) :: ctni_grid(pcols) + real(r8) :: fcti_grid(pcols) + real(r8) :: fctl_grid(pcols) + + real(r8) :: ftem_grid(pcols,pver) + + ! Variables for precip efficiency calculation + real(r8) :: minlwp ! LWP threshold + + real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps + real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps + integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated + + ! Variables for liquid water path and column condensation + real(r8) :: tgliqwp_grid(pcols) ! column liquid + real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units) + + real(r8) :: pe_grid(pcols) ! precip efficiency for output + real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out + real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation + + ! variables for autoconversion and accretion vertical averages + real(r8) :: vprco_grid(pcols) ! vertical average autoconversion + real(r8) :: vprao_grid(pcols) ! vertical average accretion + real(r8) :: racau_grid(pcols) ! ratio of vertical averages + integer :: cnt_grid(pcols) ! counters + + logical :: lq(pcnst) + + real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid + real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid + + real(r8), pointer :: lambdac_grid(:,:) + real(r8), pointer :: mu_grid(:,:) + real(r8), pointer :: rel_grid(:,:) + real(r8), pointer :: rei_grid(:,:) + real(r8), pointer :: sadice_grid(:,:) + real(r8), pointer :: sadsnow_grid(:,:) + real(r8), pointer :: dei_grid(:,:) + real(r8), pointer :: des_grid(:,:) + real(r8), pointer :: iclwpst_grid(:,:) + + real(r8) :: rho_grid(pcols,pver) + real(r8) :: liqcldf_grid(pcols,pver) + real(r8) :: qsout_grid(pcols,pver) + real(r8) :: ncic_grid(pcols,pver) + real(r8) :: niic_grid(pcols,pver) + real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid + real(r8) :: qrout_grid(pcols,pver) + real(r8) :: drout2_grid(pcols,pver) + real(r8) :: dsout2_grid(pcols,pver) + real(r8) :: nsout_grid(pcols,pver) + real(r8) :: nrout_grid(pcols,pver) + real(r8) :: reff_rain_grid(pcols,pver) + real(r8) :: reff_snow_grid(pcols,pver) + real(r8) :: cld_grid(pcols,pver) + real(r8) :: pdel_grid(pcols,pver) + real(r8) :: prco_grid(pcols,pver) + real(r8) :: prao_grid(pcols,pver) + real(r8) :: icecldf_grid(pcols,pver) + real(r8) :: icwnc_grid(pcols,pver) + real(r8) :: icinc_grid(pcols,pver) + real(r8) :: qcreso_grid(pcols,pver) + real(r8) :: melto_grid(pcols,pver) + real(r8) :: mnuccco_grid(pcols,pver) + real(r8) :: mnuccto_grid(pcols,pver) + real(r8) :: bergo_grid(pcols,pver) + real(r8) :: homoo_grid(pcols,pver) + real(r8) :: msacwio_grid(pcols,pver) + real(r8) :: psacwso_grid(pcols,pver) + real(r8) :: bergso_grid(pcols,pver) + real(r8) :: cmeiout_grid(pcols,pver) + real(r8) :: qireso_grid(pcols,pver) + real(r8) :: prcio_grid(pcols,pver) + real(r8) :: praio_grid(pcols,pver) + + real(r8) :: nc_grid(pcols,pver) + real(r8) :: ni_grid(pcols,pver) + real(r8) :: qr_grid(pcols,pver) + real(r8) :: nr_grid(pcols,pver) + real(r8) :: qs_grid(pcols,pver) + real(r8) :: ns_grid(pcols,pver) + + real(r8) :: cp_rh(pcols,pver) + real(r8) :: cp_t(pcols) + real(r8) :: cp_z(pcols) + real(r8) :: cp_dt(pcols) + real(r8) :: cp_dz(pcols) + integer :: troplev(pcols) + real(r8) :: es + real(r8) :: qs + + real(r8), pointer :: cmeliq_grid(:,:) + + real(r8), pointer :: prec_str_grid(:) + real(r8), pointer :: snow_str_grid(:) + real(r8), pointer :: prec_pcw_grid(:) + real(r8), pointer :: snow_pcw_grid(:) + real(r8), pointer :: prec_sed_grid(:) + real(r8), pointer :: snow_sed_grid(:) + real(r8), pointer :: cldo_grid(:,:) + real(r8), pointer :: nevapr_grid(:,:) + real(r8), pointer :: prain_grid(:,:) + real(r8), pointer :: mgflxprc_grid(:,:) + real(r8), pointer :: mgflxsnw_grid(:,:) + real(r8), pointer :: mgmrprc_grid(:,:) + real(r8), pointer :: mgmrsnw_grid(:,:) + real(r8), pointer :: cvreffliq_grid(:,:) + real(r8), pointer :: cvreffice_grid(:,:) + real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:) + real(r8), pointer :: wsedl_grid(:,:) + real(r8), pointer :: CC_t_grid(:,:) + real(r8), pointer :: CC_qv_grid(:,:) + real(r8), pointer :: CC_ql_grid(:,:) + real(r8), pointer :: CC_qi_grid(:,:) + real(r8), pointer :: CC_nl_grid(:,:) + real(r8), pointer :: CC_ni_grid(:,:) + real(r8), pointer :: CC_qlst_grid(:,:) + real(r8), pointer :: qme_grid(:,:) + real(r8), pointer :: iciwpst_grid(:,:) + real(r8), pointer :: icswp_grid(:,:) + real(r8), pointer :: ast_grid(:,:) + real(r8), pointer :: cldfsnow_grid(:,:) + + real(r8), pointer :: qrout_grid_ptr(:,:) + real(r8), pointer :: qsout_grid_ptr(:,:) + real(r8), pointer :: nrout_grid_ptr(:,:) + real(r8), pointer :: nsout_grid_ptr(:,:) + + + logical :: use_subcol_microp + integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field + + character(128) :: errstring ! return status (non-blank for error return) + + ! For rrtmg optics. specified distribution. + real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters) + real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter + real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) + + real(r8), pointer :: pckdptr(:,:) + + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + psetcols = state%psetcols + ngrdcol = state%ngrdcol + + itim_old = pbuf_old_tim_idx() + + call phys_getopts(use_subcol_microp_out=use_subcol_microp) + + ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp + call pbuf_col_type_index(use_subcol_microp, col_type=col_type) + + !----------------------- + ! These physics buffer fields are read only and not set in this parameterization + ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on + ! If subcolumns is not turned on, then these fields will be grid data + + call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + + if (.not. do_cldice) then + call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp) + end if + + if (use_hetfrz_classnuc) then + call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp) + end if + + if (qsatfac_idx > 0) call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp) + + !----------------------- + ! These physics buffer fields are calculated and set in this parameterization + ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid + + call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type) + call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type) + call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type) + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type) + call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type) + call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type) + call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type) + call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type) + call pbuf_get_field(pbuf, des_idx, des, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type) + call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type) + call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type) + call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type) + call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type) + call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type) + call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type) + + call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type) + end if + + if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr) + if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr) + if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr) + if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr) + + !----------------------- + ! If subcolumns is turned on, all calculated fields which are on subcolumns + ! need to be retrieved on the grid as well for storing averaged values + + if (use_subcol_microp) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid) + call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid) + call pbuf_get_field(pbuf, prain_idx, prain_grid) + call pbuf_get_field(pbuf, dei_idx, dei_grid) + call pbuf_get_field(pbuf, mu_idx, mu_grid) + call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid) + call pbuf_get_field(pbuf, des_idx, des_grid) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid) + call pbuf_get_field(pbuf, icswp_idx, icswp_grid) + call pbuf_get_field(pbuf, rel_idx, rel_grid) + call pbuf_get_field(pbuf, rei_idx, rei_grid) + call pbuf_get_field(pbuf, sadice_idx, sadice_grid) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid) + call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid) + call pbuf_get_field(pbuf, qme_idx, qme_grid) + + call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid) + end if + + end if + + !----------------------- + ! These are only on the grid regardless of whether subcolumns are turned on or not + call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid) + call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid) + call pbuf_get_field(pbuf, acpr_idx, acprecl_grid) + call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid) + call pbuf_get_field(pbuf, acnum_idx, acnum_grid) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid) + call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid) + call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) + call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) + + !------------------------------------------------------------------------------------- + ! Microphysics assumes 'liquid stratus frac = ice stratus frac + ! = max( liquid stratus frac, ice stratus frac )'. + alst_mic => ast + aist_mic => ast + + ! Output initial in-cloud LWP (before microphysics) + + iclwpi = 0._r8 + iciwpi = 0._r8 + + do i = 1, ncol + do k = top_lev, pver + iclwpi(i) = iclwpi(i) + & + min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + iciwpi(i) = iciwpi(i) + & + min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + end do + end do + + cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver) + + ! Initialize local state from input. + call physics_state_copy(state, state_loc) + + ! Because of the of limited vertical resolution, there can be a signifcant + ! warm bias at the cold point tropopause, which can create a wet bias in the + ! stratosphere. For the microphysics only, update the cold point temperature, with + ! an estimate of the coldest point between the model layers. + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + cp_dt(:ncol) = 0._r8 + cp_dz(:ncol) = 0._r8 + + call tropopause_find(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, & + tropZ=cp_z, tropT=cp_t) + + do i = 1, ncol + + ! Update statistics and output results. + if (troplev(i) .ne. NOTFOUND) then + cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i)) + cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i)) + + ! NOTE: This change in temperature is just for the microphysics + ! and should not be added to any tendencies or used to update + ! any states + state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i) + end if + end do + + ! Output all of the statistics related to the cold point + ! tropopause adjustment. Th cold point information itself is + ! output in tropopause.F90. + call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk) + call outfld("TROPF_CDT", cp_dt, pcols, lchnk) + call outfld("TROPF_CDZ", cp_dz, pcols, lchnk) + end if + + ! Initialize ptend for output. + lq = .false. + lq(1) = .true. + lq(ixcldliq) = .true. + lq(ixcldice) = .true. + lq(ixnumliq) = .true. + lq(ixnumice) = .true. + if (micro_mg_version > 1) then + lq(ixrain) = .true. + lq(ixsnow) = .true. + lq(ixnumrain) = .true. + lq(ixnumsnow) = .true. + end if + + ! the name 'cldwat' triggers special tests on cldliq + ! and cldice in physics_update + call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq) + + packer = MGPacker(psetcols, pver, mgcols, top_lev) + post_proc = MGPostProc(packer) + + pckdptr => packed_rate1ord_cw2pr_st ! workaround an apparent pgi compiler bug + call post_proc%add_field(p(rate1cld), pckdptr) + call post_proc%add_field(p(tlat) , p(packed_tlat)) + call post_proc%add_field(p(qvlat), p(packed_qvlat)) + call post_proc%add_field(p(qcten), p(packed_qctend)) + call post_proc%add_field(p(qiten), p(packed_qitend)) + call post_proc%add_field(p(ncten), p(packed_nctend)) + call post_proc%add_field(p(niten), p(packed_nitend)) + + if (micro_mg_version > 1) then + call post_proc%add_field(p(qrten), p(packed_qrtend)) + call post_proc%add_field(p(qsten), p(packed_qstend)) + call post_proc%add_field(p(nrten), p(packed_nrtend)) + call post_proc%add_field(p(nsten), p(packed_nstend)) + call post_proc%add_field(p(umr), p(packed_umr)) + call post_proc%add_field(p(ums), p(packed_ums)) + call post_proc%add_field(p(cflx), p(packed_cflx)) + call post_proc%add_field(p(iflx), p(packed_iflx)) + end if + + call post_proc%add_field(p(am_evp_st), p(packed_am_evp_st)) + + call post_proc%add_field(p(prect), p(packed_prect)) + call post_proc%add_field(p(preci), p(packed_preci)) + call post_proc%add_field(p(nevapr), p(packed_nevapr)) + call post_proc%add_field(p(evapsnow), p(packed_evapsnow)) + call post_proc%add_field(p(prain), p(packed_prain)) + call post_proc%add_field(p(prodsnow), p(packed_prodsnow)) + call post_proc%add_field(p(cmeice), p(packed_cmeout)) + call post_proc%add_field(p(qsout), p(packed_qsout)) + call post_proc%add_field(p(rflx), p(packed_rflx)) + call post_proc%add_field(p(sflx), p(packed_sflx)) + call post_proc%add_field(p(qrout), p(packed_qrout)) + call post_proc%add_field(p(qcsevap), p(packed_qcsevap)) + call post_proc%add_field(p(qisevap), p(packed_qisevap)) + call post_proc%add_field(p(qvres), p(packed_qvres)) + call post_proc%add_field(p(cmeiout), p(packed_cmei)) + call post_proc%add_field(p(vtrmc), p(packed_vtrmc)) + call post_proc%add_field(p(vtrmi), p(packed_vtrmi)) + call post_proc%add_field(p(qcsedten), p(packed_qcsedten)) + call post_proc%add_field(p(qisedten), p(packed_qisedten)) + if (micro_mg_version > 1) then + call post_proc%add_field(p(qrsedten), p(packed_qrsedten)) + call post_proc%add_field(p(qssedten), p(packed_qssedten)) + end if + + call post_proc%add_field(p(prao), p(packed_pra)) + call post_proc%add_field(p(prco), p(packed_prc)) + call post_proc%add_field(p(mnuccco), p(packed_mnuccc)) + call post_proc%add_field(p(mnuccto), p(packed_mnucct)) + call post_proc%add_field(p(msacwio), p(packed_msacwi)) + call post_proc%add_field(p(psacwso), p(packed_psacws)) + call post_proc%add_field(p(bergso), p(packed_bergs)) + call post_proc%add_field(p(bergo), p(packed_berg)) + call post_proc%add_field(p(melto), p(packed_melt)) + call post_proc%add_field(p(homoo), p(packed_homo)) + call post_proc%add_field(p(qcreso), p(packed_qcres)) + call post_proc%add_field(p(prcio), p(packed_prci)) + call post_proc%add_field(p(praio), p(packed_prai)) + call post_proc%add_field(p(qireso), p(packed_qires)) + call post_proc%add_field(p(mnuccro), p(packed_mnuccr)) + call post_proc%add_field(p(pracso), p(packed_pracs)) + call post_proc%add_field(p(meltsdt), p(packed_meltsdt)) + call post_proc%add_field(p(frzrdt), p(packed_frzrdt)) + call post_proc%add_field(p(mnuccdo), p(packed_mnuccd)) + call post_proc%add_field(p(nrout), p(packed_nrout)) + call post_proc%add_field(p(nsout), p(packed_nsout)) + + call post_proc%add_field(p(refl), p(packed_refl), fillvalue=-9999._r8) + call post_proc%add_field(p(arefl), p(packed_arefl)) + call post_proc%add_field(p(areflz), p(packed_areflz)) + call post_proc%add_field(p(frefl), p(packed_frefl)) + call post_proc%add_field(p(csrfl), p(packed_csrfl), fillvalue=-9999._r8) + call post_proc%add_field(p(acsrfl), p(packed_acsrfl)) + call post_proc%add_field(p(fcsrfl), p(packed_fcsrfl)) + + call post_proc%add_field(p(rercld), p(packed_rercld)) + call post_proc%add_field(p(ncai), p(packed_ncai)) + call post_proc%add_field(p(ncal), p(packed_ncal)) + call post_proc%add_field(p(qrout2), p(packed_qrout2)) + call post_proc%add_field(p(qsout2), p(packed_qsout2)) + call post_proc%add_field(p(nrout2), p(packed_nrout2)) + call post_proc%add_field(p(nsout2), p(packed_nsout2)) + call post_proc%add_field(p(freqs), p(packed_freqs)) + call post_proc%add_field(p(freqr), p(packed_freqr)) + call post_proc%add_field(p(nfice), p(packed_nfice)) + if (micro_mg_version /= 1) then + call post_proc%add_field(p(qcrat), p(packed_qcrat), fillvalue=1._r8) + end if + + ! The following are all variables related to sizes, where it does not + ! necessarily make sense to average over time steps. Instead, we keep + ! the value from the last substep, which is what "accum_null" does. + call post_proc%add_field(p(rel), p(packed_rel), & + fillvalue=10._r8, accum_method=accum_null) + call post_proc%add_field(p(rei), p(packed_rei), & + fillvalue=25._r8, accum_method=accum_null) + call post_proc%add_field(p(sadice), p(packed_sadice), & + accum_method=accum_null) + call post_proc%add_field(p(sadsnow), p(packed_sadsnow), & + accum_method=accum_null) + call post_proc%add_field(p(lambdac), p(packed_lambdac), & + accum_method=accum_null) + call post_proc%add_field(p(mu), p(packed_mu), & + accum_method=accum_null) + call post_proc%add_field(p(des), p(packed_des), & + accum_method=accum_null) + call post_proc%add_field(p(dei), p(packed_dei), & + accum_method=accum_null) + call post_proc%add_field(p(prer_evap), p(packed_prer_evap), & + accum_method=accum_null) + + ! Pack input variables that are not updated during substeps. + packed_relvar = packer%pack(relvar) + packed_accre_enhan = packer%pack(accre_enhan) + + packed_p = packer%pack(state_loc%pmid) + packed_pdel = packer%pack(state_loc%pdel) + + packed_cldn = packer%pack(ast) + packed_liqcldf = packer%pack(alst_mic) + packed_icecldf = packer%pack(aist_mic) + allocate(packed_qsatfac(mgncol,nlev)) + if (qsatfac_idx > 0) then + packed_qsatfac = packer%pack(qsatfac) + else + packed_qsatfac = 1._r8 + endif + packed_naai = packer%pack(naai) + packed_npccn = packer%pack(npccn) + + allocate(packed_rndst(mgncol,nlev,size(rndst, 3))) + packed_rndst = packer%pack(rndst) + + allocate(packed_nacon(mgncol,nlev,size(nacon, 3))) + packed_nacon = packer%pack(nacon) + + if (.not. do_cldice) then + packed_tnd_qsnow = packer%pack(tnd_qsnow) + packed_tnd_nsnow = packer%pack(tnd_nsnow) + packed_re_ice = packer%pack(re_ice) + end if + + if (use_hetfrz_classnuc) then + packed_frzimm = packer%pack(frzimm) + packed_frzcnt = packer%pack(frzcnt) + packed_frzdep = packer%pack(frzdep) + end if + + do it = 1, num_steps + + ! Pack input variables that are updated during substeps. + packed_t = packer%pack(state_loc%t) + packed_q = packer%pack(state_loc%q(:,:,1)) + packed_qc = packer%pack(state_loc%q(:,:,ixcldliq)) + packed_nc = packer%pack(state_loc%q(:,:,ixnumliq)) + packed_qi = packer%pack(state_loc%q(:,:,ixcldice)) + packed_ni = packer%pack(state_loc%q(:,:,ixnumice)) + if (micro_mg_version > 1) then + packed_qr = packer%pack(state_loc%q(:,:,ixrain)) + packed_nr = packer%pack(state_loc%q(:,:,ixnumrain)) + packed_qs = packer%pack(state_loc%q(:,:,ixsnow)) + packed_ns = packer%pack(state_loc%q(:,:,ixnumsnow)) + end if + + select case (micro_mg_version) + case (1) + select case (micro_mg_sub_version) + case (0) + call micro_mg_tend1_0( & + microp_uniform, mgncol, nlev, mgncol, 1, dtime/num_steps, & + packed_t, packed_q, packed_qc, packed_qi, packed_nc, & + packed_ni, packed_p, packed_pdel, packed_cldn, packed_liqcldf,& + packed_relvar, packed_accre_enhan, & + packed_icecldf, packed_rate1ord_cw2pr_st, packed_naai, packed_npccn, & + packed_rndst, packed_nacon, packed_tlat, packed_qvlat, packed_qctend, & + packed_qitend, packed_nctend, packed_nitend, packed_rel, rel_fn_dum, & + packed_rei, packed_prect, packed_preci, packed_nevapr, packed_evapsnow, packed_am_evp_st, & + packed_prain, packed_prodsnow, packed_cmeout, packed_dei, packed_mu, & + packed_lambdac, packed_qsout, packed_des, packed_rflx, packed_sflx, & + packed_qrout, reff_rain_dum, reff_snow_dum, packed_qcsevap, packed_qisevap, & + packed_qvres, packed_cmei, packed_vtrmc, packed_vtrmi, packed_qcsedten, & + packed_qisedten, packed_pra, packed_prc, packed_mnuccc, packed_mnucct, & + packed_msacwi, packed_psacws, packed_bergs, packed_berg, packed_melt, & + packed_homo, packed_qcres, packed_prci, packed_prai, packed_qires, & + packed_mnuccr, packed_pracs, packed_meltsdt, packed_frzrdt, packed_mnuccd, & + packed_nrout, packed_nsout, packed_refl, packed_arefl, packed_areflz, & + packed_frefl, packed_csrfl, packed_acsrfl, packed_fcsrfl, packed_rercld, & + packed_ncai, packed_ncal, packed_qrout2, packed_qsout2, packed_nrout2, & + packed_nsout2, drout_dum, dsout2_dum, packed_freqs,packed_freqr, & + packed_nfice, packed_prer_evap, do_cldice, errstring, & + packed_tnd_qsnow, packed_tnd_nsnow, packed_re_ice, & + packed_frzimm, packed_frzcnt, packed_frzdep) + + end select + case(2) + select case (micro_mg_sub_version) + case (0) + + call micro_mg_tend2_0( & + mgncol, nlev, dtime/num_steps,& + packed_t, packed_q, & + packed_qc, packed_qi, & + packed_nc, packed_ni, & + packed_qr, packed_qs, & + packed_nr, packed_ns, & + packed_relvar, packed_accre_enhan, & + packed_p, packed_pdel, & + packed_cldn, packed_liqcldf, packed_icecldf, packed_qsatfac, & + packed_rate1ord_cw2pr_st, & + packed_naai, packed_npccn, & + packed_rndst, packed_nacon, & + packed_tlat, packed_qvlat, & + packed_qctend, packed_qitend, & + packed_nctend, packed_nitend, & + packed_qrtend, packed_qstend, & + packed_nrtend, packed_nstend, & + packed_rel, rel_fn_dum, packed_rei, & + packed_sadice, packed_sadsnow, & + packed_prect, packed_preci, & + packed_nevapr, packed_evapsnow, & + packed_am_evp_st, & + packed_prain, packed_prodsnow, & + packed_cmeout, packed_dei, & + packed_mu, packed_lambdac, & + packed_qsout, packed_des, & + packed_cflx, packed_iflx, & + packed_rflx, packed_sflx, packed_qrout, & + reff_rain_dum, reff_snow_dum, & + packed_qcsevap, packed_qisevap, packed_qvres, & + packed_cmei, packed_vtrmc, packed_vtrmi, & + packed_umr, packed_ums, & + packed_qcsedten, packed_qisedten, & + packed_qrsedten, packed_qssedten, & + packed_pra, packed_prc, & + packed_mnuccc, packed_mnucct, packed_msacwi, & + packed_psacws, packed_bergs, packed_berg, & + packed_melt, packed_homo, & + packed_qcres, packed_prci, packed_prai, & + packed_qires, packed_mnuccr, packed_pracs, & + packed_meltsdt, packed_frzrdt, packed_mnuccd, & + packed_nrout, packed_nsout, & + packed_refl, packed_arefl, packed_areflz, & + packed_frefl, packed_csrfl, packed_acsrfl, & + packed_fcsrfl, packed_rercld, & + packed_ncai, packed_ncal, & + packed_qrout2, packed_qsout2, & + packed_nrout2, packed_nsout2, & + drout_dum, dsout2_dum, & + packed_freqs, packed_freqr, & + packed_nfice, packed_qcrat, & + errstring, & + packed_tnd_qsnow,packed_tnd_nsnow,packed_re_ice,& + packed_prer_evap, & + packed_frzimm, packed_frzcnt, packed_frzdep ) + end select + end select + + call handle_errmsg(errstring, subname="micro_mg_tend") + + call physics_ptend_init(ptend_loc, psetcols, "micro_mg", & + ls=.true., lq=lq) + + ! Set local tendency. + ptend_loc%s = packer%unpack(packed_tlat, 0._r8) + ptend_loc%q(:,:,1) = packer%unpack(packed_qvlat, 0._r8) + ptend_loc%q(:,:,ixcldliq) = packer%unpack(packed_qctend, 0._r8) + ptend_loc%q(:,:,ixcldice) = packer%unpack(packed_qitend, 0._r8) + ptend_loc%q(:,:,ixnumliq) = packer%unpack(packed_nctend, & + -state_loc%q(:,:,ixnumliq)/(dtime/num_steps)) + if (do_cldice) then + ptend_loc%q(:,:,ixnumice) = packer%unpack(packed_nitend, & + -state_loc%q(:,:,ixnumice)/(dtime/num_steps)) + else + ! In this case, the tendency should be all 0. + if (any(packed_nitend /= 0._r8)) & + call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_mg_tend has ice number tendencies.") + ptend_loc%q(:,:,ixnumice) = 0._r8 + end if + + if (micro_mg_version > 1) then + ptend_loc%q(:,:,ixrain) = packer%unpack(packed_qrtend, 0._r8) + ptend_loc%q(:,:,ixsnow) = packer%unpack(packed_qstend, 0._r8) + ptend_loc%q(:,:,ixnumrain) = packer%unpack(packed_nrtend, & + -state_loc%q(:,:,ixnumrain)/(dtime/num_steps)) + ptend_loc%q(:,:,ixnumsnow) = packer%unpack(packed_nstend, & + -state_loc%q(:,:,ixnumsnow)/(dtime/num_steps)) + end if + + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + + ! Update local state + call physics_update(state_loc, ptend_loc, dtime/num_steps) + + ! Sum all outputs for averaging. + call post_proc%accumulate() + + end do + + ! Divide ptend by substeps. + call physics_ptend_scale(ptend, 1._r8/num_steps, ncol) + + ! Use summed outputs to produce averages + call post_proc%process_and_unpack() + + call post_proc%finalize() + + ! Check to make sure that the microphysics code is respecting the flags that control + ! whether MG should be prognosing cloud ice and cloud liquid or not. + if (.not. do_cldice) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) & + call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_mg_tend has ice mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) & + call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_mg_tend has ice number tendencies.") + end if + if (.not. do_cldliq) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) & + call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_mg_tend has liquid mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) & + call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_mg_tend has liquid number tendencies.") + end if + + mnuccdohet = 0._r8 + do k=top_lev,pver + do i=1,ncol + if (naai(i,k) > 0._r8) then + mnuccdohet(i,k) = mnuccdo(i,k) - (naai_hom(i,k)/naai(i,k))*mnuccdo(i,k) + end if + end do + end do + + mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp) + + !add condensate fluxes for MG2 (ice and snow already added for MG1) + if (micro_mg_version >= 2) then + mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp) + end if + + + mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver) + mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver) + + !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP) + !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505) + cvreffliq(:ncol,top_lev:pver) = 9.0_r8 + cvreffice(:ncol,top_lev:pver) = 37.0_r8 + + ! Reassign rate1 if modal aerosols + if (rate1_cw2pr_st_idx > 0) then + rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver) + end if + + ! Sedimentation velocity for liquid stratus cloud droplet + wsedl(:ncol,top_lev:pver) = vtrmc(:ncol,top_lev:pver) + + ! Microphysical tendencies for use in the macrophysics at the next time step + CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair + CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver) + CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver) + CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver) + CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver) + CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver)) + + ! Net micro_mg_cam condensation rate + qme(:ncol,:top_lev-1) = 0._r8 + qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + cmeiout(:ncol,top_lev:pver) + + ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables. + ! Other precip output variables are set to 0 + ! Do not subscript by ncol here, because in physpkg we divide the whole + ! array and need to avoid an FPE due to uninitialized data. + prec_pcw = prect + snow_pcw = preci + prec_sed = 0._r8 + snow_sed = 0._r8 + prec_str = prec_pcw + prec_sed + snow_str = snow_pcw + snow_sed + + icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + + ! ------------------------------------------------------------ ! + ! Compute in cloud ice and liquid mixing ratios ! + ! Note that 'iclwp, iciwp' are used for radiation computation. ! + ! ------------------------------------------------------------ ! + + icinc = 0._r8 + icwnc = 0._r8 + iciwpst = 0._r8 + iclwpst = 0._r8 + icswp = 0._r8 + cldfsnow = 0._r8 + + do k = top_lev, pver + do i = 1, ncol + ! Limits for in-cloud mixing ratios consistent with MG microphysics + ! in-cloud mixing ratio maximum limit of 0.005 kg/kg + icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 ) + icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 ) + icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + ! Calculate micro_mg_cam cloud water paths in each layer + ! Note: uses stratiform cloud fraction! + iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + + ! ------------------------------ ! + ! Adjust cloud fraction for snow ! + ! ------------------------------ ! + cldfsnow(i,k) = cld(i,k) + ! If cloud and only ice ( no convective cloud or ice ), then set to 0. + if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. & + ( concld(i,k) .lt. 1.e-4_r8 ) .and. & + ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then + cldfsnow(i,k) = 0._r8 + end if + ! If no cloud and snow, then set to 0.25 + if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then + cldfsnow(i,k) = 0.25_r8 + end if + ! Calculate in-cloud snow water path + icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit + end do + end do + + ! Calculate cloud fraction for prognostic precip sizes. + if (micro_mg_version > 1) then + ! Cloud fraction for purposes of precipitation is maximum cloud + ! fraction out of all the layers that the precipitation may be + ! falling down from. + cldmax(:ncol,:) = max(mincld, ast(:ncol,:)) + do k = top_lev+1, pver + where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. & + state_loc%q(:ncol,k-1,ixsnow) >= qsmall) + cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k)) + end where + end do + end if + + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + ! All code from here to the end is on grid columns only ! + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + + ! Average the fields which are needed later in this paramterization to be on the grid + if (use_subcol_microp) then + call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid) + call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid) + call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid) + call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid) + call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid) + call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid) + call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid) + call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid) + call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid) + call subcol_field_avg(evapsnow, ngrdcol, lchnk, evpsnow_st_grid) + + call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid) + + ! Average fields which are not in pbuf + call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid) + call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid) + call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid) + call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid) + call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid) + call subcol_field_avg(qcreso, ngrdcol, lchnk, qcreso_grid) + call subcol_field_avg(melto, ngrdcol, lchnk, melto_grid) + call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid) + call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid) + call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid) + call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid) + call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid) + call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid) + call subcol_field_avg(bergso, ngrdcol, lchnk, bergso_grid) + call subcol_field_avg(cmeiout, ngrdcol, lchnk, cmeiout_grid) + call subcol_field_avg(qireso, ngrdcol, lchnk, qireso_grid) + call subcol_field_avg(prcio, ngrdcol, lchnk, prcio_grid) + call subcol_field_avg(praio, ngrdcol, lchnk, praio_grid) + call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid) + call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid) + call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid) + call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid) + call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid) + call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid) + call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid) + call subcol_field_avg(prao, ngrdcol, lchnk, prao_grid) + call subcol_field_avg(prco, ngrdcol, lchnk, prco_grid) + + call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid) + + if (micro_mg_version > 1) then + call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid) + + call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid) + call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid) + end if + + else + ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg + ! as they are reset before being used, so it would be a needless calculation + lambdac_grid => lambdac + mu_grid => mu + rel_grid => rel + rei_grid => rei + sadice_grid => sadice + sadsnow_grid => sadsnow + dei_grid => dei + des_grid => des + + ! fields already on grids, so just assign + prec_str_grid => prec_str + iclwpst_grid => iclwpst + cvreffliq_grid => cvreffliq + cvreffice_grid => cvreffice + mgflxprc_grid => mgflxprc + mgflxsnw_grid => mgflxsnw + qme_grid => qme + nevapr_grid => nevapr + prain_grid => prain + + am_evp_st_grid = am_evp_st + + evpsnow_st_grid = evapsnow + qrout_grid = qrout + qsout_grid = qsout + nsout_grid = nsout + nrout_grid = nrout + cld_grid = cld + qcreso_grid = qcreso + melto_grid = melto + mnuccco_grid = mnuccco + mnuccto_grid = mnuccto + bergo_grid = bergo + homoo_grid = homoo + msacwio_grid = msacwio + psacwso_grid = psacwso + bergso_grid = bergso + cmeiout_grid = cmeiout + qireso_grid = qireso + prcio_grid = prcio + praio_grid = praio + icwmrst_grid = icwmrst + icimrst_grid = icimrst + liqcldf_grid = liqcldf + icecldf_grid = icecldf + icwnc_grid = icwnc + icinc_grid = icinc + pdel_grid = state_loc%pdel + prao_grid = prao + prco_grid = prco + + nc_grid = state_loc%q(:,:,ixnumliq) + ni_grid = state_loc%q(:,:,ixnumice) + + if (micro_mg_version > 1) then + cldmax_grid = cldmax + + qr_grid = state_loc%q(:,:,ixrain) + nr_grid = state_loc%q(:,:,ixnumrain) + qs_grid = state_loc%q(:,:,ixsnow) + ns_grid = state_loc%q(:,:,ixnumsnow) + end if + + end if + + ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in + ! this parameterization (no need to assign in the non-subcolumn case -- the else step) + if (use_subcol_microp) then + call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid) + call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid) + call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid) + call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid) + call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid) + call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid) + call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid) + call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid) + call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid) + call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid) + call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid) + call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid) + call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid) + call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid) + call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid) + call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid) + call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid) + call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid) + call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid) + + if (rate1_cw2pr_st_idx > 0) then + call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid) + end if + + end if + + ! ------------------------------------- ! + ! Size distribution calculation ! + ! ------------------------------------- ! + + ! Calculate rho (on subcolumns if turned on) for size distribution + ! parameter calculations and average it if needed + ! + ! State instead of state_loc to preserve answers for MG1 (and in any + ! case, it is unlikely to make much difference). + rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / & + (rair*state%t(:ncol,top_lev:)) + if (use_subcol_microp) then + call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid) + else + rho_grid = rho + end if + + ! Effective radius for cloud liquid, fixed number. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_fn_grid = 10._r8 + + ncic_grid = 1.e8_r8 + + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), & + ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), & + mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:)) + + where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) + rel_fn_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + end where + + ! Effective radius for cloud liquid, and size parameters + ! mu_grid and lambdac_grid. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_grid = 10._r8 + + ! Calculate ncic on the grid + ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & + max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) + + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), & + ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), & + mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:)) + + where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) + rel_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + elsewhere + ! Deal with the fact that size_dist_param_liq sets mu_grid to -100 + ! wherever there is no cloud. + mu_grid(:ngrdcol,top_lev:) = 0._r8 + end where + + ! Rain/Snow effective diameter. + drout2_grid = 0._r8 + reff_rain_grid = 0._r8 + des_grid = 0._r8 + dsout2_grid = 0._r8 + reff_snow_grid = 0._r8 + + if (micro_mg_version > 1) then + ! Prognostic precipitation + + where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qr_grid(:ngrdcol,top_lev:), & + nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhow) + + reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qs_grid(:ngrdcol,top_lev:), & + ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhosn) + + des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *& + 3._r8 * rhosn/rhows + + reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + else + ! Diagnostic precipitation + + where (qrout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qrout_grid(:ngrdcol,top_lev:), & + nrout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhow) + + reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + where (qsout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qsout_grid(:ngrdcol,top_lev:), & + nsout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhosn) + + des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) & + * 3._r8 * rhosn/rhows + + reff_snow_grid(:ngrdcol,top_lev:) = & + dsout2_grid(:ngrdcol,top_lev:) * 1.5_r8 * 1.e6_r8 + end where + + end if + + ! Effective radius and diameter for cloud ice. + rei_grid = 25._r8 + + niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & + max(mincld,icecldf_grid(:ngrdcol,top_lev:)) + + call size_dist_param_basic(mg_ice_props, icimrst_grid(:ngrdcol,top_lev:), & + niic_grid(:ngrdcol,top_lev:), rei_grid(:ngrdcol,top_lev:)) + + where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) + rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & + * 1.e6_r8 + elsewhere + rei_grid(:ngrdcol,top_lev:) = 25._r8 + end where + + dei_grid = rei_grid * rhoi/rhows * 2._r8 + + ! Limiters for low cloud fraction. + do k = top_lev, pver + do i = 1, ngrdcol + ! Convert snow effective diameter to microns + des_grid(i,k) = des_grid(i,k) * 1.e6_r8 + if ( ast_grid(i,k) < 1.e-4_r8 ) then + mu_grid(i,k) = mucon + lambdac_grid(i,k) = (mucon + 1._r8)/dcon + dei_grid(i,k) = deicon + end if + end do + end do + + mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver) + mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver) + + ! ------------------------------------- ! + ! Precipitation efficiency Calculation ! + ! ------------------------------------- ! + + !----------------------------------------------------------------------- + ! Liquid water path + + ! Compute liquid water paths, and column condensation + tgliqwp_grid(:ngrdcol) = 0._r8 + tgcmeliq_grid(:ngrdcol) = 0._r8 + do k = top_lev, pver + do i = 1, ngrdcol + tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k) + + if (cmeliq_grid(i,k) > 1.e-12_r8) then + !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s + tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * & + (pdel_grid(i,k) / gravit) / rhoh2o + end if + end do + end do + + ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s + ! this is 1ppmv of h2o in 10hpa + ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9 + + !----------------------------------------------------------------------- + ! precipitation efficiency calculation (accumulate cme and precip) + + minlwp = 0.01_r8 !minimum lwp threshold (kg/m3) + + ! zero out precip efficiency and total averaged precip + pe_grid(:ngrdcol) = 0._r8 + tpr_grid(:ngrdcol) = 0._r8 + pefrac_grid(:ngrdcol) = 0._r8 + + ! accumulate precip and condensation + do i = 1, ngrdcol + + acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i) + acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i) + acnum_grid(i) = acnum_grid(i) + 1 + + ! if LWP is zero, then 'end of cloud': calculate precip efficiency + if (tgliqwp_grid(i) < minlwp) then + if (acprecl_grid(i) > 5.e-8_r8) then + tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8) + if (acgcme_grid(i) > 1.e-10_r8) then + pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8) + pefrac_grid(i) = 1._r8 + end if + end if + + ! reset counters +! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then +! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', & +! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i) +! endif + + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + acnum_grid(i) = 0 + end if ! end LWP zero conditional + + ! if never find any rain....(after 10^3 timesteps...) + if (acnum_grid(i) > 1000) then + acnum_grid(i) = 0 + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + end if + + end do + + !----------------------------------------------------------------------- + ! vertical average of non-zero accretion, autoconversion and ratio. + ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid + + vprao_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k) + where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid + + vprco_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k) + where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) + vprco_grid = vprco_grid/cnt_grid + racau_grid = vprao_grid/vprco_grid + elsewhere + racau_grid = 0._r8 + end where + + racau_grid = min(racau_grid, 1.e10_r8) + + ! --------------------- ! + ! History Output Fields ! + ! --------------------- ! + + ! Column droplet concentration + cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * & + pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2) + + ! Averaging for new output fields + efcout_grid = 0._r8 + efiout_grid = 0._r8 + ncout_grid = 0._r8 + niout_grid = 0._r8 + freql_grid = 0._r8 + freqi_grid = 0._r8 + icwmrst_grid_out = 0._r8 + icimrst_grid_out = 0._r8 + freqm_grid = 0._r8 + freqsl_grid = 0._r8 + freqslm_grid = 0._r8 + + do k = top_lev, pver + do i = 1, ngrdcol + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then + efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k) + ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k) + freql_grid(i,k) = liqcldf_grid(i,k) + icwmrst_grid_out(i,k) = icwmrst_grid(i,k) + end if + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then + efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k) + niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k) + freqi_grid(i,k) = icecldf_grid(i,k) + icimrst_grid_out(i,k) = icimrst_grid(i,k) + end if + + ! Supercooled liquid + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then + freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqsl_grid(i,k)=liqcldf_grid(i,k) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqslm_grid(i,k)=liqcldf_grid(i,k) + end if + + end do + end do + + ! Cloud top effective radius and number. + fcti_grid = 0._r8 + fctl_grid = 0._r8 + ctrel_grid = 0._r8 + ctrei_grid = 0._r8 + ctnl_grid = 0._r8 + ctni_grid = 0._r8 + fctm_grid = 0._r8 + fctsl_grid = 0._r8 + fctslm_grid= 0._r8 + + do i = 1, ngrdcol + do k = top_lev, pver + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then + ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k) + ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k) + fctl_grid(i) = liqcldf_grid(i,k) + + ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed + if (freqi_grid(i,k) > 0.01_r8) then + fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctsl_grid(i)=liqcldf_grid(i,k) + end if + if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctslm_grid(i)=liqcldf_grid(i,k) + end if + + exit + end if + + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then + ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k) + ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k) + fcti_grid(i) = icecldf_grid(i,k) + exit + end if + end do + end do + + ! Evaporation of stratiform precipitation fields for UNICON + evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver) + do k = top_lev, pver + do i = 1, ngrdcol + evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8) + evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8) + end do + end do + + ! Assign the values to the pbuf pointers if they exist in pbuf + if (qrain_idx > 0) qrout_grid_ptr = qrout_grid + if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid + if (nrain_idx > 0) nrout_grid_ptr = nrout_grid + if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid + + ! --------------------------------------------- ! + ! General outfield calls for microphysics ! + ! --------------------------------------------- ! + + ! Output a handle of variables which are calculated on the fly + ftem_grid = 0._r8 + + ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2V', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)& + - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)& + - msacwio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2I', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& + - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2P', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2V', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & + + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& + + msacwio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2W', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2P', ftem_grid, pcols, lchnk) + + ! Output fields which have not been averaged already, averaging if use_subcol_microp is true + call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('EVAPSNOW', evapsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEVAP', qcsevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEVAP', qisevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QVRES', qvres, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMC', vtrmc, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMI', vtrmi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEDTEN', qcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEDTEN', qisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + if (micro_mg_version > 1) then + call outfld('QRSEDTEN', qrsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QSSEDTEN', qssedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + call outfld('MNUCCDO', mnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCRO', mnuccro, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('PRACSO', pracso , psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTSDT', meltsdt, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FRZRDT', frzrdt , psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + if (micro_mg_version > 1) then + call outfld('UMR', umr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('UMS', ums, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + + if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then + call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + + ! Example subcolumn outfld call + if (use_subcol_microp) then + call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk) + end if + + ! Output fields which are already on the grid + call outfld('QRAIN', qrout_grid, pcols, lchnk) + call outfld('QSNOW', qsout_grid, pcols, lchnk) + call outfld('NRAIN', nrout_grid, pcols, lchnk) + call outfld('NSNOW', nsout_grid, pcols, lchnk) + call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk) + call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk) + call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk) + call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk) + call outfld('CME', qme_grid, pcols, lchnk) + call outfld('PRODPREC', prain_grid, pcols, lchnk) + call outfld('EVAPPREC', nevapr_grid, pcols, lchnk) + call outfld('QCRESO', qcreso_grid, pcols, lchnk) + call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk) + call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk) + call outfld('DSNOW', des_grid, pcols, lchnk) + call outfld('ADRAIN', drout2_grid, pcols, lchnk) + call outfld('ADSNOW', dsout2_grid, pcols, lchnk) + call outfld('PE', pe_grid, pcols, lchnk) + call outfld('PEFRAC', pefrac_grid, pcols, lchnk) + call outfld('APRL', tpr_grid, pcols, lchnk) + call outfld('VPRAO', vprao_grid, pcols, lchnk) + call outfld('VPRCO', vprco_grid, pcols, lchnk) + call outfld('RACAU', racau_grid, pcols, lchnk) + call outfld('AREL', efcout_grid, pcols, lchnk) + call outfld('AREI', efiout_grid, pcols, lchnk) + call outfld('AWNC' , ncout_grid, pcols, lchnk) + call outfld('AWNI' , niout_grid, pcols, lchnk) + call outfld('FREQL', freql_grid, pcols, lchnk) + call outfld('FREQI', freqi_grid, pcols, lchnk) + call outfld('ACTREL', ctrel_grid, pcols, lchnk) + call outfld('ACTREI', ctrei_grid, pcols, lchnk) + call outfld('ACTNL', ctnl_grid, pcols, lchnk) + call outfld('ACTNI', ctni_grid, pcols, lchnk) + call outfld('FCTL', fctl_grid, pcols, lchnk) + call outfld('FCTI', fcti_grid, pcols, lchnk) + call outfld('ICINC', icinc_grid, pcols, lchnk) + call outfld('ICWNC', icwnc_grid, pcols, lchnk) + call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk) + call outfld('CDNUMC', cdnumc_grid, pcols, lchnk) + call outfld('REL', rel_grid, pcols, lchnk) + call outfld('REI', rei_grid, pcols, lchnk) + call outfld('MG_SADICE', sadice_grid, pcols, lchnk) + call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk) + call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk) + call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk) + call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk) + call outfld('PRAO', prao_grid, pcols, lchnk) + call outfld('PRCO', prco_grid, pcols, lchnk) + call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk) + call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk) + call outfld('MSACWIO', msacwio_grid, pcols, lchnk) + call outfld('PSACWSO', psacwso_grid, pcols, lchnk) + call outfld('BERGSO', bergso_grid, pcols, lchnk) + call outfld('BERGO', bergo_grid, pcols, lchnk) + call outfld('MELTO', melto_grid, pcols, lchnk) + call outfld('HOMOO', homoo_grid, pcols, lchnk) + call outfld('PRCIO', prcio_grid, pcols, lchnk) + call outfld('PRAIO', praio_grid, pcols, lchnk) + call outfld('QIRESO', qireso_grid, pcols, lchnk) + call outfld('FREQM', freqm_grid, pcols, lchnk) + call outfld('FREQSL', freqsl_grid, pcols, lchnk) + call outfld('FREQSLM', freqslm_grid, pcols, lchnk) + call outfld('FCTM', fctm_grid, pcols, lchnk) + call outfld('FCTSL', fctsl_grid, pcols, lchnk) + call outfld('FCTSLM', fctslm_grid, pcols, lchnk) + + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + + do i = 1, ncol + + ! Calculate the RH including any T change that we make. + do k = top_lev, pver + call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs) + cp_rh(i,k) = state_loc%q(i, k, 1) / qs * 100._r8 + end do + end do + + call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk) + end if + + ! ptend_loc is deallocated in physics_update above + call physics_state_dealloc(state_loc) + +end subroutine micro_mg_cam_tend_pack + +function p1(tin) result(pout) + real(r8), target, intent(in) :: tin(:) + real(r8), pointer :: pout(:) + pout => tin +end function p1 + +function p2(tin) result(pout) + real(r8), target, intent(in) :: tin(:,:) + real(r8), pointer :: pout(:,:) + pout => tin +end function p2 + +end module micro_mg_cam diff --git a/src/physics/cam/micro_mg_data.F90 b/src/physics/cam/micro_mg_data.F90 new file mode 100644 index 0000000000..9a4d0c4a5e --- /dev/null +++ b/src/physics/cam/micro_mg_data.F90 @@ -0,0 +1,550 @@ +module micro_mg_data + +! +! Packing and time averaging for the MG interface. +! +! Use is as follows: +! +! 1) Figure out which columns will do averaging (mgncol) and the number of +! levels where the microphysics will run (nlev). +! +! 2) Create an MGPacker object and assign it as follows: +! +! packer = MGPacker(pcols, pver, mgcols, top_lev) +! +! Where [pcols, pver] is the shape of the ultimate input/output arrays +! that are defined at level midpoints. +! +! 3) Create a post-processing array of type MGPostProc: +! +! post_proc = MGPostProc(packer) +! +! 4) Add pairs of pointers for packed and unpacked representations, already +! associated with buffers of the correct dimensions: +! +! call post_proc%add_field(unpacked_pointer, packed_pointer, & +! fillvalue, accum_mean) +! +! The third value is the default value used to "unpack" for points with +! no "packed" part, and the fourth value is the method used to +! accumulate values over time steps. These two arguments can be omitted, +! in which case the default value will be 0 and the accumulation method +! will take the mean. +! +! 5) Use the packed fields in MG, and for each MG iteration, do: +! +! call post_proc%accumulate() +! +! 6) Perform final accumulation and scatter values into the unpacked arrays: +! +! call post_proc%process_and_unpack() +! +! 7) Destroy the object when complete: +! +! call post_proc%finalize() +! +! Caveat: MGFieldPostProc will hit a divide-by-zero error if you try to +! take the mean over 0 steps. +! + +! This include header defines CPP macros that only have an effect for debug +! builds. +#include "shr_assert.h" + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_log_mod, only: & + errMsg => shr_log_errMsg, & + OOBMsg => shr_log_OOBMsg +use shr_sys_mod, only: shr_sys_abort + +implicit none +private + +public :: MGPacker +public :: MGFieldPostProc +public :: accum_null +public :: accum_mean +public :: MGPostProc + +type :: MGPacker + ! Unpacked array dimensions. + integer :: pcols + integer :: pver + ! Calculated packed dimensions, stored for convenience. + integer :: mgncol + integer :: nlev + ! Which columns are packed. + integer, allocatable :: mgcols(:) + ! Topmost level to copy into the packed array. + integer :: top_lev + contains + procedure, private :: pack_1D + procedure, private :: pack_2D + procedure, private :: pack_3D + generic :: pack => pack_1D, pack_2D, pack_3D + procedure :: pack_interface + procedure, private :: unpack_1D + procedure, private :: unpack_1D_array_fill + procedure, private :: unpack_2D + procedure, private :: unpack_2D_array_fill + procedure, private :: unpack_3D + procedure, private :: unpack_3D_array_fill + generic :: unpack => unpack_1D, unpack_1D_array_fill, & + unpack_2D, unpack_2D_array_fill, unpack_3D, unpack_3D_array_fill + procedure :: finalize => MGPacker_finalize +end type MGPacker + +interface MGPacker + module procedure new_MGPacker +end interface + +! Enum for time accumulation/averaging methods. +integer, parameter :: accum_null = 0 +integer, parameter :: accum_mean = 1 + +type :: MGFieldPostProc + integer :: accum_method = -1 + integer :: rank = -1 + integer :: num_steps = 0 + real(r8) :: fillvalue = 0._r8 + real(r8), pointer :: unpacked_1D(:) => null() + real(r8), pointer :: packed_1D(:) => null() + real(r8), allocatable :: buffer_1D(:) + real(r8), pointer :: unpacked_2D(:,:) => null() + real(r8), pointer :: packed_2D(:,:) => null() + real(r8), allocatable :: buffer_2D(:,:) + contains + procedure :: accumulate => MGFieldPostProc_accumulate + procedure :: process_and_unpack => MGFieldPostProc_process_and_unpack + procedure :: unpack_only => MGFieldPostProc_unpack_only + procedure :: finalize => MGFieldPostProc_finalize +end type MGFieldPostProc + +interface MGFieldPostProc + module procedure MGFieldPostProc_1D + module procedure MGFieldPostProc_2D +end interface MGFieldPostProc + +#define VECTOR_NAME MGFieldPostProcVec +#define TYPE_NAME type(MGFieldPostProc) +#define THROW(string) call shr_sys_abort(string) + +public :: VECTOR_NAME + +#include "dynamic_vector_typedef.inc" + +type MGPostProc + type(MGPacker) :: packer + type(MGFieldPostProcVec) :: field_procs + contains + procedure, private :: add_field_1D + procedure, private :: add_field_2D + generic :: add_field => add_field_1D, add_field_2D + procedure :: accumulate => MGPostProc_accumulate + procedure :: process_and_unpack => MGPostProc_process_and_unpack + procedure :: unpack_only => MGPostProc_unpack_only + procedure :: finalize => MGPostProc_finalize + procedure, private :: MGPostProc_copy + generic :: assignment(=) => MGPostProc_copy +end type MGPostProc + +interface MGPostProc + module procedure new_MGPostProc +end interface MGPostProc + +contains + +function new_MGPacker(pcols, pver, mgcols, top_lev) + integer, intent(in) :: pcols, pver + integer, intent(in) :: mgcols(:) + integer, intent(in) :: top_lev + + type(MGPacker) :: new_MGPacker + + new_MGPacker%pcols = pcols + new_MGPacker%pver = pver + new_MGPacker%mgncol = size(mgcols) + new_MGPacker%nlev = pver - top_lev + 1 + + allocate(new_MGPacker%mgcols(new_MGPacker%mgncol)) + new_MGPacker%mgcols = mgcols + new_MGPacker%top_lev = top_lev + +end function new_MGPacker + +! Rely on the fact that intent(out) forces the compiler to deallocate all +! allocatable components and restart the type from scratch. Although +! compiler support for finalization varies, this seems to be one of the few +! cases where all major compilers are reliable, and humans are not. +subroutine MGPacker_finalize(self) + class(MGPacker), intent(out) :: self +end subroutine MGPacker_finalize + +function pack_1D(self, unpacked) result(packed) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: unpacked(:) + + real(r8) :: packed(self%mgncol) + + SHR_ASSERT(size(unpacked) == self%pcols, errMsg(__FILE__, __LINE__)) + + packed = unpacked(self%mgcols) + +end function pack_1D + +! Separation of pack and pack_interface is to workaround a PGI bug. +function pack_2D(self, unpacked) result(packed) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: unpacked(:,:) + + real(r8) :: packed(self%mgncol,self%nlev) + + SHR_ASSERT(size(unpacked, 1) == self%pcols, errMsg(__FILE__, __LINE__)) + + packed = unpacked(self%mgcols,self%top_lev:) + +end function pack_2D + +function pack_interface(self, unpacked) result(packed) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: unpacked(:,:) + + real(r8) :: packed(self%mgncol,self%nlev+1) + + packed = unpacked(self%mgcols,self%top_lev:) + +end function pack_interface + +function pack_3D(self, unpacked) result(packed) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: unpacked(:,:,:) + + real(r8) :: packed(self%mgncol,self%nlev,size(unpacked, 3)) + + SHR_ASSERT(size(unpacked,1) == self%pcols, errMsg(__FILE__, __LINE__)) + + packed = unpacked(self%mgcols,self%top_lev:,:) + +end function pack_3D + +function unpack_1D(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:) + real(r8), intent(in) :: fill + + real(r8) :: unpacked(self%pcols) + + SHR_ASSERT(size(packed) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols) = packed + +end function unpack_1D + +function unpack_1D_array_fill(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:) + real(r8), intent(in) :: fill(:) + + real(r8) :: unpacked(self%pcols) + + SHR_ASSERT(size(packed) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols) = packed + +end function unpack_1D_array_fill + +function unpack_2D(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:,:) + real(r8), intent(in) :: fill + + real(r8) :: unpacked(self%pcols,self%pver+size(packed, 2)-self%nlev) + + SHR_ASSERT(size(packed, 1) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols,self%top_lev:) = packed + +end function unpack_2D + +function unpack_2D_array_fill(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:,:) + real(r8), intent(in) :: fill(:,:) + + real(r8) :: unpacked(self%pcols,self%pver+size(packed, 2)-self%nlev) + + SHR_ASSERT(size(packed, 1) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols,self%top_lev:) = packed + +end function unpack_2D_array_fill + +function unpack_3D(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:,:,:) + real(r8), intent(in) :: fill + + real(r8) :: unpacked(self%pcols,self%pver,size(packed, 3)) + + SHR_ASSERT(size(packed, 1) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols,self%top_lev:,:) = packed + +end function unpack_3D + +function unpack_3D_array_fill(self, packed, fill) result(unpacked) + class(MGPacker), intent(in) :: self + real(r8), intent(in) :: packed(:,:,:) + real(r8), intent(in) :: fill(:,:,:) + + real(r8) :: unpacked(self%pcols,self%pver,size(packed, 3)) + + SHR_ASSERT(size(packed, 1) == self%mgncol, errMsg(__FILE__, __LINE__)) + + unpacked = fill + unpacked(self%mgcols,self%top_lev:,:) = packed + +end function unpack_3D_array_fill + +function MGFieldPostProc_1D(unpacked_ptr, packed_ptr, fillvalue, & + accum_method) result(field_proc) + real(r8), pointer, intent(in) :: unpacked_ptr(:) + real(r8), pointer, intent(in) :: packed_ptr(:) + real(r8), intent(in), optional :: fillvalue + integer, intent(in), optional :: accum_method + type(MGFieldPostProc) :: field_proc + + field_proc%rank = 1 + field_proc%unpacked_1D => unpacked_ptr + field_proc%packed_1D => packed_ptr + if (present(fillvalue)) then + field_proc%fillvalue = fillvalue + else + field_proc%fillvalue = 0._r8 + end if + if (present(accum_method)) then + field_proc%accum_method = accum_method + else + field_proc%accum_method = accum_mean + end if + +end function MGFieldPostProc_1D + +function MGFieldPostProc_2D(unpacked_ptr, packed_ptr, fillvalue, & + accum_method) result(field_proc) + real(r8), pointer, intent(in) :: unpacked_ptr(:,:) + real(r8), pointer, intent(in) :: packed_ptr(:,:) + real(r8), intent(in), optional :: fillvalue + integer, intent(in), optional :: accum_method + type(MGFieldPostProc) :: field_proc + + field_proc%rank = 2 + field_proc%unpacked_2D => unpacked_ptr + field_proc%packed_2D => packed_ptr + if (present(fillvalue)) then + field_proc%fillvalue = fillvalue + else + field_proc%fillvalue = 0._r8 + end if + if (present(accum_method)) then + field_proc%accum_method = accum_method + else + field_proc%accum_method = accum_mean + end if + +end function MGFieldPostProc_2D + +! Use the same intent(out) trick as for MGPacker, which is actually more +! useful here. +subroutine MGFieldPostProc_finalize(self) + class(MGFieldPostProc), intent(out) :: self +end subroutine MGFieldPostProc_finalize + +subroutine MGFieldPostProc_accumulate(self) + class(MGFieldPostProc), intent(inout) :: self + + select case (self%accum_method) + case (accum_null) + ! "Null" method does nothing. + case (accum_mean) + ! Allocation is done on the first accumulation step to allow the + ! MGFieldPostProc to be copied after construction without copying the + ! allocated array (until this function is first called). + self%num_steps = self%num_steps + 1 + select case (self%rank) + case (1) + SHR_ASSERT(associated(self%packed_1D), errMsg(__FILE__, __LINE__)) + if (.not. allocated(self%buffer_1D)) then + allocate(self%buffer_1D(size(self%packed_1D))) + self%buffer_1D = 0._r8 + end if + self%buffer_1D = self%buffer_1D + self%packed_1D + case (2) + SHR_ASSERT(associated(self%packed_2D), errMsg(__FILE__, __LINE__)) + if (.not. allocated(self%buffer_2D)) then + ! Awkward; in F2008 can be replaced by source/mold. + allocate(self%buffer_2D(& + size(self%packed_2D, 1),size(self%packed_2D, 2))) + self%buffer_2D = 0._r8 + end if + self%buffer_2D = self%buffer_2D + self%packed_2D + case default + call shr_sys_abort(errMsg(__FILE__, __LINE__) // & + " Unsupported rank for MGFieldPostProc accumulation.") + end select + case default + call shr_sys_abort(errMsg(__FILE__, __LINE__) // & + " Unrecognized MGFieldPostProc accumulation method.") + end select + +end subroutine MGFieldPostProc_accumulate + +subroutine MGFieldPostProc_process_and_unpack(self, packer) + class(MGFieldPostProc), intent(inout) :: self + class(MGPacker), intent(in) :: packer + + select case (self%accum_method) + case (accum_null) + ! "Null" method just leaves the value as the last time step, so don't + ! actually need to do anything. + case (accum_mean) + select case (self%rank) + case (1) + SHR_ASSERT(associated(self%packed_1D), errMsg(__FILE__, __LINE__)) + self%packed_1D = self%buffer_1D/self%num_steps + case (2) + SHR_ASSERT(associated(self%packed_2D), errMsg(__FILE__, __LINE__)) + self%packed_2D = self%buffer_2D/self%num_steps + case default + call shr_sys_abort(errMsg(__FILE__, __LINE__) // & + " Unsupported rank for MGFieldPostProc accumulation.") + end select + case default + call shr_sys_abort(errMsg(__FILE__, __LINE__) // & + " Unrecognized MGFieldPostProc accumulation method.") + end select + + call self%unpack_only(packer) + +end subroutine MGFieldPostProc_process_and_unpack + +subroutine MGFieldPostProc_unpack_only(self, packer) + class(MGFieldPostProc), intent(inout) :: self + class(MGPacker), intent(in) :: packer + + select case (self%rank) + case (1) + SHR_ASSERT(associated(self%unpacked_1D), errMsg(__FILE__, __LINE__)) + self%unpacked_1D = packer%unpack(self%packed_1D, self%fillvalue) + case (2) + SHR_ASSERT(associated(self%unpacked_2D), errMsg(__FILE__, __LINE__)) + self%unpacked_2D = packer%unpack(self%packed_2D, self%fillvalue) + case default + call shr_sys_abort(errMsg(__FILE__, __LINE__) // & + " Unsupported rank for MGFieldPostProc unpacking.") + end select + +end subroutine MGFieldPostProc_unpack_only + +#include "dynamic_vector_procdef.inc" + +function new_MGPostProc(packer) result(post_proc) + type(MGPacker), intent(in) :: packer + + type(MGPostProc) :: post_proc + + post_proc%packer = packer + call post_proc%field_procs%clear() + +end function new_MGPostProc + +! Can't use the same intent(out) trick, because PGI doesn't get the +! recursive deallocation right. +subroutine MGPostProc_finalize(self) + class(MGPostProc), intent(inout) :: self + + integer :: i + + call self%packer%finalize() + do i = 1, self%field_procs%vsize() + call self%field_procs%data(i)%finalize() + end do + call self%field_procs%clear() + call self%field_procs%shrink_to_fit() + +end subroutine MGPostProc_finalize + +subroutine add_field_1D(self, unpacked_ptr, packed_ptr, fillvalue, & + accum_method) + class(MGPostProc), intent(inout) :: self + real(r8), pointer, intent(in) :: unpacked_ptr(:) + real(r8), pointer, intent(in) :: packed_ptr(:) + real(r8), intent(in), optional :: fillvalue + integer, intent(in), optional :: accum_method + + call self%field_procs%push_back(MGFieldPostProc(unpacked_ptr, & + packed_ptr, fillvalue, accum_method)) + +end subroutine add_field_1D + +subroutine add_field_2D(self, unpacked_ptr, packed_ptr, fillvalue, & + accum_method) + class(MGPostProc), intent(inout) :: self + real(r8), pointer, intent(in) :: unpacked_ptr(:,:) + real(r8), pointer, intent(in) :: packed_ptr(:,:) + real(r8), intent(in), optional :: fillvalue + integer, intent(in), optional :: accum_method + + call self%field_procs%push_back(MGFieldPostProc(unpacked_ptr, & + packed_ptr, fillvalue, accum_method)) + +end subroutine add_field_2D + +subroutine MGPostProc_accumulate(self) + class(MGPostProc), intent(inout) :: self + + integer :: i + + do i = 1, self%field_procs%vsize() + call self%field_procs%data(i)%accumulate() + end do + +end subroutine MGPostProc_accumulate + +subroutine MGPostProc_process_and_unpack(self) + class(MGPostProc), intent(inout) :: self + + integer :: i + + do i = 1, self%field_procs%vsize() + call self%field_procs%data(i)%process_and_unpack(self%packer) + end do + +end subroutine MGPostProc_process_and_unpack + +subroutine MGPostProc_unpack_only(self) + class(MGPostProc), intent(inout) :: self + + integer :: i + + do i = 1, self%field_procs%vsize() + call self%field_procs%data(i)%unpack_only(self%packer) + end do + +end subroutine MGPostProc_unpack_only + +! This is necessary only to work around Intel/PGI bugs. +subroutine MGPostProc_copy(lhs, rhs) + class(MGPostProc), intent(out) :: lhs + type(MGPostProc), intent(in) :: rhs + + lhs%packer = rhs%packer + lhs%field_procs = rhs%field_procs +end subroutine MGPostProc_copy + +end module micro_mg_data diff --git a/src/physics/cam/micro_mg_utils.F90 b/src/physics/cam/micro_mg_utils.F90 new file mode 100644 index 0000000000..fee464c069 --- /dev/null +++ b/src/physics/cam/micro_mg_utils.F90 @@ -0,0 +1,1607 @@ +module micro_mg_utils + +!-------------------------------------------------------------------------- +! +! This module contains process rates and utility functions used by the MG +! microphysics. +! +! Original MG authors: Andrew Gettelman, Hugh Morrison +! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +! +! Separated from MG 1.5 by B. Eaton. +! Separated module switched to MG 2.0 and further changes by S. Santos. +! +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +! +!-------------------------------------------------------------------------- +! +! List of required external functions that must be supplied: +! gamma --> standard mathematical gamma function (if gamma is an +! intrinsic, define HAVE_GAMMA_INTRINSICS) +! +!-------------------------------------------------------------------------- +! +! Constants that must be specified in the "init" method (module variables): +! +! kind kind of reals (to verify correct linkage only) - +! gravit acceleration due to gravity m s-2 +! rair dry air gas constant for air J kg-1 K-1 +! rh2o gas constant for water vapor J kg-1 K-1 +! cpair specific heat at constant pressure for dry air J kg-1 K-1 +! tmelt temperature of melting point for water K +! latvap latent heat of vaporization J kg-1 +! latice latent heat of fusion J kg-1 +! +!-------------------------------------------------------------------------- + +#ifndef HAVE_GAMMA_INTRINSICS +use shr_spfn_mod, only: gamma => shr_spfn_gamma +#endif + +implicit none +private +save + +public :: & + micro_mg_utils_init, & + size_dist_param_liq, & + size_dist_param_basic, & + avg_diameter, & + rising_factorial, & + ice_deposition_sublimation, & + sb2001v2_liq_autoconversion,& + sb2001v2_accre_cld_water_rain,& + kk2000_liq_autoconversion, & + ice_autoconversion, & + immersion_freezing, & + contact_freezing, & + snow_self_aggregation, & + accrete_cloud_water_snow, & + secondary_ice_production, & + accrete_rain_snow, & + heterogeneous_rain_freezing, & + accrete_cloud_water_rain, & + self_collection_rain, & + accrete_cloud_ice_snow, & + evaporate_sublimate_precip, & + bergeron_process_snow + +! 8 byte real and integer +integer, parameter, public :: r8 = selected_real_kind(12) +integer, parameter, public :: i8 = selected_int_kind(18) + +public :: MGHydrometeorProps + +type :: MGHydrometeorProps + ! Density (kg/m^3) + real(r8) :: rho + ! Information for size calculations. + ! Basic calculation of mean size is: + ! lambda = (shape_coef*nic/qic)^(1/eff_dim) + ! Then lambda is constrained by bounds. + real(r8) :: eff_dim + real(r8) :: shape_coef + real(r8) :: lambda_bounds(2) + ! Minimum average particle mass (kg). + ! Limit is applied at the beginning of the size distribution calculations. + real(r8) :: min_mean_mass +end type MGHydrometeorProps + +interface MGHydrometeorProps + module procedure NewMGHydrometeorProps +end interface + +type(MGHydrometeorProps), public :: mg_liq_props +type(MGHydrometeorProps), public :: mg_ice_props +type(MGHydrometeorProps), public :: mg_rain_props +type(MGHydrometeorProps), public :: mg_snow_props + +interface size_dist_param_liq + module procedure size_dist_param_liq_vect + module procedure size_dist_param_liq_line +end interface +interface size_dist_param_basic + module procedure size_dist_param_basic_vect + module procedure size_dist_param_basic_line +end interface + +!================================================= +! Public module parameters (mostly for MG itself) +!================================================= + +! Pi to 20 digits; more than enough to reach the limit of double precision. +real(r8), parameter, public :: pi = 3.14159265358979323846_r8 + +! "One minus small number": number near unity for round-off issues. +real(r8), parameter, public :: omsm = 1._r8 - 1.e-5_r8 + +! Smallest mixing ratio considered in microphysics. +real(r8), parameter, public :: qsmall = 1.e-18_r8 + +! minimum allowed cloud fraction +real(r8), parameter, public :: mincld = 0.0001_r8 + +real(r8), parameter, public :: rhosn = 250._r8 ! bulk density snow +real(r8), parameter, public :: rhoi = 500._r8 ! bulk density ice +real(r8), parameter, public :: rhow = 1000._r8 ! bulk density liquid +real(r8), parameter, public :: rhows = 917._r8 ! bulk density water solid + +! fall speed parameters, V = aD^b (V is in m/s) +! droplets +real(r8), parameter, public :: ac = 3.e7_r8 +real(r8), parameter, public :: bc = 2._r8 +! snow +real(r8), parameter, public :: as = 11.72_r8 +real(r8), parameter, public :: bs = 0.41_r8 +! cloud ice +real(r8), parameter, public :: ai = 700._r8 +real(r8), parameter, public :: bi = 1._r8 +! small cloud ice (r< 10 um) - sphere, bulk density +real(r8), parameter, public :: aj = ac*((rhoi/rhows)**(bc/3._r8))*rhows/rhow +real(r8), parameter, public :: bj = bc +! rain +real(r8), parameter, public :: ar = 841.99667_r8 +real(r8), parameter, public :: br = 0.8_r8 + +! mass of new crystal due to aerosol freezing and growth (kg) +! Make this consistent with the lower bound, to support UTLS and +! stratospheric ice, and the smaller ice size limit. +real(r8), parameter, public :: mi0 = 4._r8/3._r8*pi*rhoi*(1.e-6_r8)**3 + +!================================================= +! Private module parameters +!================================================= + +! Signaling NaN bit pattern that represents a limiter that's turned off. +integer(i8), parameter :: limiter_off = int(Z'7FF1111111111111', i8) + +! alternate threshold used for some in-cloud mmr +real(r8), parameter :: icsmall = 1.e-8_r8 + +! particle mass-diameter relationship +! currently we assume spherical particles for cloud ice/snow +! m = cD^d +! exponent +real(r8), parameter :: dsph = 3._r8 + +! Bounds for mean diameter for different constituents. +real(r8), parameter :: lam_bnd_rain(2) = 1._r8/[500.e-6_r8, 20.e-6_r8] +real(r8), parameter :: lam_bnd_snow(2) = 1._r8/[2000.e-6_r8, 10.e-6_r8] + +! Minimum average mass of particles. +real(r8), parameter :: min_mean_mass_liq = 1.e-20_r8 +real(r8), parameter :: min_mean_mass_ice = 1.e-20_r8 + +! ventilation parameters +! for snow +real(r8), parameter :: f1s = 0.86_r8 +real(r8), parameter :: f2s = 0.28_r8 +! for rain +real(r8), parameter :: f1r = 0.78_r8 +real(r8), parameter :: f2r = 0.308_r8 + +! collection efficiencies +! aggregation of cloud ice and snow +real(r8), parameter :: eii = 0.5_r8 + +! immersion freezing parameters, bigg 1953 +real(r8), parameter :: bimm = 100._r8 +real(r8), parameter :: aimm = 0.66_r8 + +! Mass of each raindrop created from autoconversion. +real(r8), parameter :: droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 +real(r8), parameter :: droplet_mass_40um = 4._r8/3._r8*pi*rhow*(40.e-6_r8)**3 + +!========================================================= +! Constants set in initialization +!========================================================= + +! Set using arguments to micro_mg_init +real(r8) :: rv ! water vapor gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: tmelt ! freezing point of water (K) + +! latent heats of: +real(r8) :: xxlv ! vaporization +real(r8) :: xlf ! freezing +real(r8) :: xxls ! sublimation + +! additional constants to help speed up code +real(r8) :: gamma_bs_plus3 +real(r8) :: gamma_half_br_plus5 +real(r8) :: gamma_half_bs_plus5 + +!========================================================= +! Utilities that are cheaper if the compiler knows that +! some argument is an integer. +!========================================================= + +interface rising_factorial + module procedure rising_factorial_r8 + module procedure rising_factorial_integer +end interface rising_factorial + +interface var_coef + module procedure var_coef_r8 + module procedure var_coef_integer +end interface var_coef + +!========================================================================== +contains +!========================================================================== + +! Initialize module variables. +! +! "kind" serves no purpose here except to check for unlikely linking +! issues; always pass in the kind for a double precision real. +! +! "errstring" is the only output; it is blank if there is no error, or set +! to a message if there is an error. +! +! Check the list at the top of this module for descriptions of all other +! arguments. +subroutine micro_mg_utils_init( kind, rh2o, cpair, tmelt_in, latvap, & + latice, dcs, errstring) + + integer, intent(in) :: kind + real(r8), intent(in) :: rh2o + real(r8), intent(in) :: cpair + real(r8), intent(in) :: tmelt_in + real(r8), intent(in) :: latvap + real(r8), intent(in) :: latice + real(r8), intent(in) :: dcs + + character(128), intent(out) :: errstring + + ! Name this array to workaround an XLF bug (otherwise could just use the + ! expression that sets it). + real(r8) :: ice_lambda_bounds(2) + + !----------------------------------------------------------------------- + + errstring = ' ' + + if( kind .ne. r8 ) then + errstring = 'micro_mg_init: KIND of reals does not match' + return + endif + + ! declarations for MG code (transforms variable names) + + rv= rh2o ! water vapor gas constant + cpp = cpair ! specific heat of dry air + tmelt = tmelt_in + + ! latent heats + + xxlv = latvap ! latent heat vaporization + xlf = latice ! latent heat freezing + xxls = xxlv + xlf ! latent heat of sublimation + + ! Define constants to help speed up code (this limits calls to gamma function) + gamma_bs_plus3=gamma(3._r8+bs) + gamma_half_br_plus5=gamma(5._r8/2._r8+br/2._r8) + gamma_half_bs_plus5=gamma(5._r8/2._r8+bs/2._r8) + + ! Don't specify lambda bounds for cloud liquid, as they are determined by + ! pgam dynamically. + mg_liq_props = MGHydrometeorProps(rhow, dsph, & + min_mean_mass=min_mean_mass_liq) + + ! Mean ice diameter can not grow bigger than twice the autoconversion + ! threshold for snow. + ice_lambda_bounds = 1._r8/[2._r8*dcs, 1.e-6_r8] + + mg_ice_props = MGHydrometeorProps(rhoi, dsph, & + ice_lambda_bounds, min_mean_mass_ice) + + mg_rain_props = MGHydrometeorProps(rhow, dsph, lam_bnd_rain) + mg_snow_props = MGHydrometeorProps(rhosn, dsph, lam_bnd_snow) + +end subroutine micro_mg_utils_init + +! Constructor for a constituent property object. +function NewMGHydrometeorProps(rho, eff_dim, lambda_bounds, min_mean_mass) & + result(res) + real(r8), intent(in) :: rho, eff_dim + real(r8), intent(in), optional :: lambda_bounds(2), min_mean_mass + type(MGHydrometeorProps) :: res + + res%rho = rho + res%eff_dim = eff_dim + if (present(lambda_bounds)) then + res%lambda_bounds = lambda_bounds + else + res%lambda_bounds = no_limiter() + end if + if (present(min_mean_mass)) then + res%min_mean_mass = min_mean_mass + else + res%min_mean_mass = no_limiter() + end if + + res%shape_coef = rho*pi*gamma(eff_dim+1._r8)/6._r8 + +end function NewMGHydrometeorProps + +!======================================================================== +!FORMULAS +!======================================================================== + +! Use gamma function to implement rising factorial extended to the reals. +pure function rising_factorial_r8(x, n) result(res) + real(r8), intent(in) :: x, n + real(r8) :: res + + res = gamma(x+n)/gamma(x) + +end function rising_factorial_r8 + +! Rising factorial can be performed much cheaper if n is a small integer. +pure function rising_factorial_integer(x, n) result(res) + real(r8), intent(in) :: x + integer, intent(in) :: n + real(r8) :: res + + integer :: i + real(r8) :: factor + + res = 1._r8 + factor = x + + do i = 1, n + res = res * factor + factor = factor + 1._r8 + end do + +end function rising_factorial_integer + +! Calculate correction due to latent heat for evaporation/sublimation +elemental function calc_ab(t, qv, xxl) result(ab) + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: qv ! Saturation vapor pressure + real(r8), intent(in) :: xxl ! Latent heat + + real(r8) :: ab + + real(r8) :: dqsdt + + dqsdt = xxl*qv / (rv * t**2) + ab = 1._r8 + dqsdt*xxl/cpp + +end function calc_ab + +! get cloud droplet size distribution parameters +elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc) + type(MGHydrometeorProps), intent(in) :: props + real(r8), intent(in) :: qcic + real(r8), intent(inout) :: ncic + real(r8), intent(in) :: rho + + real(r8), intent(out) :: pgam + real(r8), intent(out) :: lamc + + type(MGHydrometeorProps) :: props_loc + + if (qcic > qsmall) then + + ! Local copy of properties that can be modified. + ! (Elemental routines that operate on arrays can't modify scalar + ! arguments.) + props_loc = props + + ! Get pgam from fit to observations of martin et al. 1994 + pgam = 1.0_r8 - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic*rho) + pgam = 1._r8/(pgam**2) - 1._r8 + pgam = max(pgam, 2._r8) + + ! Set coefficient for use in size_dist_param_basic. + ! The 3D case is so common and optimizable that we specialize it: + if (props_loc%eff_dim == 3._r8) then + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + rising_factorial(pgam+1._r8, 3) + else + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + rising_factorial(pgam+1._r8, props_loc%eff_dim) + end if + + ! Limit to between 2 and 50 microns mean size. + props_loc%lambda_bounds = (pgam+1._r8)*1._r8/[50.e-6_r8, 2.e-6_r8] + + call size_dist_param_basic(props_loc, qcic, ncic, lamc) + + else + ! pgam not calculated in this case, so set it to a value likely to + ! cause an error if it is accidentally used + ! (gamma function undefined for negative integers) + pgam = -100._r8 + lamc = 0._r8 + end if + +end subroutine size_dist_param_liq_line + +! get cloud droplet size distribution parameters + +subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) + + type(mghydrometeorprops), intent(in) :: props + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(inout) :: ncic + real(r8), dimension(mgncol), intent(in) :: rho + real(r8), dimension(mgncol), intent(out) :: pgam + real(r8), dimension(mgncol), intent(out) :: lamc + type(mghydrometeorprops) :: props_loc + integer :: i + + do i=1,mgncol + if (qcic(i) > qsmall) then + ! Local copy of properties that can be modified. + ! (Elemental routines that operate on arrays can't modify scalar + ! arguments.) + props_loc = props + ! Get pgam from fit to observations of martin et al. 1994 + pgam(i) = 1.0_r8 - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic(i)*rho(i)) + pgam(i) = 1._r8/(pgam(i)**2) - 1._r8 + pgam(i) = max(pgam(i), 2._r8) + endif + enddo + do i=1,mgncol + if (qcic(i) > qsmall) then + ! Set coefficient for use in size_dist_param_basic. + ! The 3D case is so common and optimizable that we specialize + ! it: + if (props_loc%eff_dim == 3._r8) then + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + rising_factorial(pgam(i)+1._r8, 3) + else + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + rising_factorial(pgam(i)+1._r8, props_loc%eff_dim) + end if + ! Limit to between 2 and 50 microns mean size. + props_loc%lambda_bounds(1) = (pgam(i)+1._r8)*1._r8/50.e-6_r8 + props_loc%lambda_bounds(2) = (pgam(i)+1._r8)*1._r8/2.e-6_r8 + call size_dist_param_basic(props_loc, qcic(i), ncic(i), lamc(i)) + endif + enddo + do i=1,mgncol + if (qcic(i) <= qsmall) then + ! pgam not calculated in this case, so set it to a value likely to + ! cause an error if it is accidentally used + ! (gamma function undefined for negative integers) + pgam(i) = -100._r8 + lamc(i) = 0._r8 + end if + enddo + +end subroutine size_dist_param_liq_vect + +! Basic routine for getting size distribution parameters. +elemental subroutine size_dist_param_basic_line(props, qic, nic, lam, n0) + type(MGHydrometeorProps), intent(in) :: props + real(r8), intent(in) :: qic + real(r8), intent(inout) :: nic + + real(r8), intent(out) :: lam + real(r8), intent(out), optional :: n0 + + if (qic > qsmall) then + + ! add upper limit to in-cloud number concentration to prevent + ! numerical error + if (limiter_is_on(props%min_mean_mass)) then + nic = min(nic, qic / props%min_mean_mass) + end if + + ! lambda = (c n/q)^(1/d) + lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim) + + ! check for slope + ! adjust vars + if (lam < props%lambda_bounds(1)) then + lam = props%lambda_bounds(1) + nic = lam**(props%eff_dim) * qic/props%shape_coef + else if (lam > props%lambda_bounds(2)) then + lam = props%lambda_bounds(2) + nic = lam**(props%eff_dim) * qic/props%shape_coef + end if + + else + lam = 0._r8 + end if + + if (present(n0)) n0 = nic * lam + +end subroutine size_dist_param_basic_line + +subroutine size_dist_param_basic_vect(props, qic, nic, lam, mgncol, n0) + + type (mghydrometeorprops), intent(in) :: props + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: qic + real(r8), dimension(mgncol), intent(inout) :: nic + real(r8), dimension(mgncol), intent(out) :: lam + real(r8), dimension(mgncol), intent(out), optional :: n0 + integer :: i + do i=1,mgncol + + if (qic(i) > qsmall) then + + ! add upper limit to in-cloud number concentration to prevent + ! numerical error + if (limiter_is_on(props%min_mean_mass)) then + nic(i) = min(nic(i), qic(i) / props%min_mean_mass) + end if + + ! lambda = (c n/q)^(1/d) + lam(i) = (props%shape_coef * nic(i)/qic(i))**(1._r8/props%eff_dim) + + ! check for slope + ! adjust vars + if (lam(i) < props%lambda_bounds(1)) then + lam(i) = props%lambda_bounds(1) + nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef + else if (lam(i) > props%lambda_bounds(2)) then + lam(i) = props%lambda_bounds(2) + nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef + end if + + else + lam(i) = 0._r8 + end if + + enddo + + if (present(n0)) n0 = nic * lam + +end subroutine size_dist_param_basic_vect + + +real(r8) elemental function avg_diameter(q, n, rho_air, rho_sub) + ! Finds the average diameter of particles given their density, and + ! mass/number concentrations in the air. + ! Assumes that diameter follows an exponential distribution. + real(r8), intent(in) :: q ! mass mixing ratio + real(r8), intent(in) :: n ! number concentration (per volume) + real(r8), intent(in) :: rho_air ! local density of the air + real(r8), intent(in) :: rho_sub ! density of the particle substance + + avg_diameter = (pi * rho_sub * n/(q*rho_air))**(-1._r8/3._r8) + +end function avg_diameter + +elemental function var_coef_r8(relvar, a) result(res) + ! Finds a coefficient for process rates based on the relative variance + ! of cloud water. + real(r8), intent(in) :: relvar + real(r8), intent(in) :: a + real(r8) :: res + + res = rising_factorial(relvar, a) / relvar**a + +end function var_coef_r8 + +elemental function var_coef_integer(relvar, a) result(res) + ! Finds a coefficient for process rates based on the relative variance + ! of cloud water. + real(r8), intent(in) :: relvar + integer, intent(in) :: a + real(r8) :: res + + res = rising_factorial(relvar, a) / relvar**a + +end function var_coef_integer + +!======================================================================== +!MICROPHYSICAL PROCESS CALCULATIONS +!======================================================================== +!======================================================================== +! Initial ice deposition and sublimation loop. +! Run before the main loop +! This subroutine written by Peter Caldwell + +subroutine ice_deposition_sublimation(t, qv, qi, ni, & + icldm, rho, dv,qvl, qvi, & + berg, vap_dep, ice_sublim, mgncol) + + !INPUT VARS: + !=============================================== + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t + real(r8), dimension(mgncol), intent(in) :: qv + real(r8), dimension(mgncol), intent(in) :: qi + real(r8), dimension(mgncol), intent(in) :: ni + real(r8), dimension(mgncol), intent(in) :: icldm + real(r8), dimension(mgncol), intent(in) :: rho + real(r8), dimension(mgncol), intent(in) :: dv + real(r8), dimension(mgncol), intent(in) :: qvl + real(r8), dimension(mgncol), intent(in) :: qvi + + !OUTPUT VARS: + !=============================================== + real(r8), dimension(mgncol), intent(out) :: vap_dep !ice deposition (cell-ave value) + real(r8), dimension(mgncol), intent(out) :: ice_sublim !ice sublimation (cell-ave value) + real(r8), dimension(mgncol), intent(out) :: berg !bergeron enhancement (cell-ave value) + + !INTERNAL VARS: + !=============================================== + real(r8) :: ab + real(r8) :: epsi + real(r8) :: qiic + real(r8) :: niic + real(r8) :: lami + real(r8) :: n0i + integer :: i + + do i=1,mgncol + if (qi(i)>=qsmall) then + + !GET IN-CLOUD qi, ni + !=============================================== + qiic = qi(i)/icldm(i) + niic = ni(i)/icldm(i) + + !Compute linearized condensational heating correction + ab=calc_ab(t(i), qvi(i), xxls) + !Get slope and intercept of gamma distn for ice. + call size_dist_param_basic(mg_ice_props, qiic, niic, lami, n0i) + !Get depletion timescale=1/eps + epsi = 2._r8*pi*n0i*rho(i)*Dv(i)/(lami*lami) + + !Compute deposition/sublimation + vap_dep(i) = epsi/ab*(qv(i) - qvi(i)) + + !Make this a grid-averaged quantity + vap_dep(i)=vap_dep(i)*icldm(i) + + !Split into deposition or sublimation. + if (t(i) < tmelt .and. vap_dep(i)>0._r8) then + ice_sublim(i)=0._r8 + else + ! make ice_sublim negative for consistency with other evap/sub processes + ice_sublim(i)=min(vap_dep(i),0._r8) + vap_dep(i)=0._r8 + end if + + !sublimation occurs @ any T. Not so for berg. + if (t(i) < tmelt) then + + !Compute bergeron rate assuming cloud for whole step. + berg(i) = max(epsi/ab*(qvl(i) - qvi(i)), 0._r8) + else !T>frz + berg(i)=0._r8 + end if !Tqsmall + enddo +end subroutine ice_deposition_sublimation + +!======================================================================== +! autoconversion of cloud liquid water to rain +! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc +! minimum qc of 1 x 10^-8 prevents floating point error + +subroutine kk2000_liq_autoconversion(microp_uniform, qcic, & + ncic, rho, relvar, prc, nprc, nprc1, mgncol) + + integer, intent(in) :: mgncol + logical, intent(in) :: microp_uniform + + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(in) :: ncic + real(r8), dimension(mgncol), intent(in) :: rho + + real(r8), dimension(mgncol), intent(in) :: relvar + + real(r8), dimension(mgncol), intent(out) :: prc + real(r8), dimension(mgncol), intent(out) :: nprc + real(r8), dimension(mgncol), intent(out) :: nprc1 + + real(r8), dimension(mgncol) :: prc_coef + integer :: i + + ! Take variance into account, or use uniform value. + if (.not. microp_uniform) then + prc_coef(:) = var_coef(relvar(:), 2.47_r8) + else + prc_coef(:) = 1._r8 + end if + + do i=1,mgncol + if (qcic(i) >= icsmall) then + + ! nprc is increase in rain number conc due to autoconversion + ! nprc1 is decrease in cloud droplet conc due to autoconversion + + ! assume exponential sub-grid distribution of qc, resulting in additional + ! factor related to qcvar below + ! switch for sub-columns, don't include sub-grid qc + + prc(i) = prc_coef(i) * & + 0.01_r8 * 1350._r8 * qcic(i)**2.47_r8 * (ncic(i)*1.e-6_r8*rho(i))**(-1.1_r8) + nprc(i) = prc(i) * (1._r8/droplet_mass_25um) + nprc1(i) = prc(i)*ncic(i)/qcic(i) + + else + prc(i)=0._r8 + nprc(i)=0._r8 + nprc1(i)=0._r8 + end if + enddo +end subroutine kk2000_liq_autoconversion + + !======================================================================== +subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mgncol) + ! + ! --------------------------------------------------------------------- + ! AUTO_SB: calculates the evolution of mass- and number mxg-ratio for + ! drizzle drops due to autoconversion. The autoconversion rate assumes + ! f(x)=A*x**(nu_c)*exp(-Bx) in drop MASS x. + + ! Code from Hugh Morrison, Sept 2014 + + ! autoconversion + ! use simple lookup table of dnu values to get mass spectral shape parameter + ! equivalent to the size spectral shape parameter pgam + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent (in) :: pgam + real(r8), dimension(mgncol), intent (in) :: qc ! = qc (cld water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: nc ! = nc (cld water number conc /kg) + real(r8), dimension(mgncol), intent (in) :: qr ! = qr (rain water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: rho ! = rho : density profile + real(r8), dimension(mgncol), intent (in) :: relvar + + real(r8), dimension(mgncol), intent (out) :: au ! = prc autoconversion rate + real(r8), dimension(mgncol), intent (out) :: nprc1 ! = number tendency + real(r8), dimension(mgncol), intent (out) :: nprc ! = number tendency fixed size for rain + + ! parameters for droplet mass spectral shape, + !used by Seifert and Beheng (2001) + ! warm rain scheme only (iparam = 1) + real(r8), parameter :: dnu(16) = [0._r8,-0.557_r8,-0.430_r8,-0.307_r8, & + -0.186_r8,-0.067_r8,0.050_r8,0.167_r8,0.282_r8,0.397_r8,0.512_r8, & + 0.626_r8,0.739_r8,0.853_r8,0.966_r8,0.966_r8] + + ! parameters for Seifert and Beheng (2001) autoconversion/accretion + real(r8), parameter :: kc = 9.44e9_r8 + real(r8), parameter :: kr = 5.78e3_r8 + real(r8) :: dum, dum1, nu, pra_coef + integer :: dumi, i + + do i=1,mgncol + + pra_coef = var_coef(relvar(i), 2.47_r8) + + if (qc(i) > qsmall) then + dumi=int(pgam(i)) + nu=dnu(dumi)+(dnu(dumi+1)-dnu(dumi))* & + (pgam(i)-dumi) + + dum = 1._r8-qc(i)/(qc(i)+qr(i)) + dum1 = 600._r8*dum**0.68_r8*(1._r8-dum**0.68_r8)**3 + + au(i) = kc/(20._r8*2.6e-7_r8)* & + (nu+2._r8)*(nu+4._r8)/(nu+1._r8)**2._r8* & + (rho(i)*qc(i)/1000._r8)**4._r8/(rho(i)*nc(i)/1.e6_r8)**2._r8* & + (1._r8+dum1/(1._r8-dum)**2)*1000._r8 / rho(i) + + nprc1(i) = au(i)*2._r8/2.6e-7_r8*1000._r8 + nprc(i) = au(i)/droplet_mass_40um + else + au(i) = 0._r8 + nprc1(i) = 0._r8 + nprc(i)=0._r8 + end if + + enddo + + end subroutine sb2001v2_liq_autoconversion + +!======================================================================== +!SB2001 Accretion V2 + +subroutine sb2001v2_accre_cld_water_rain(qc,nc,qr,rho,relvar,pra,npra,mgncol) + ! + ! --------------------------------------------------------------------- + ! ACCR_SB calculates the evolution of mass mxng-ratio due to accretion + ! and self collection following Seifert & Beheng (2001). + ! + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent (in) :: qc ! = qc (cld water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: nc ! = nc (cld water number conc /kg) + real(r8), dimension(mgncol), intent (in) :: qr ! = qr (rain water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: rho ! = rho : density profile + real(r8), dimension(mgncol), intent (in) :: relvar + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pra ! MMR + real(r8), dimension(mgncol), intent(out) :: npra ! Number + + ! parameters for Seifert and Beheng (2001) autoconversion/accretion + real(r8), parameter :: kc = 9.44e9_r8 + real(r8), parameter :: kr = 5.78e3_r8 + + real(r8) :: dum, dum1 + integer :: i + + ! accretion + + do i =1,mgncol + + if (qc(i) > qsmall) then + dum = 1._r8-qc(i)/(qc(i)+qr(i)) + dum1 = (dum/(dum+5.e-4_r8))**4._r8 + pra(i) = kr*rho(i)*0.001_r8*qc(i)*qr(i)*dum1 + npra(i) = pra(i)*rho(i)*0.001_r8*(nc(i)*rho(i)*1.e-6_r8)/ & + (qc(i)*rho(i)*0.001_r8)*1.e6_r8 / rho(i) + else + pra(i) = 0._r8 + npra(i) = 0._r8 + end if + + enddo + + end subroutine sb2001v2_accre_cld_water_rain + +!======================================================================== +! Autoconversion of cloud ice to snow +! similar to Ferrier (1994) + +subroutine ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t + real(r8), dimension(mgncol), intent(in) :: qiic + real(r8), dimension(mgncol), intent(in) :: lami + real(r8), dimension(mgncol), intent(in) :: n0i + real(r8), intent(in) :: dcs + + real(r8), dimension(mgncol), intent(out) :: prci + real(r8), dimension(mgncol), intent(out) :: nprci + + ! Assume autoconversion timescale of 180 seconds. + real(r8), parameter :: ac_time = 180._r8 + + ! Average mass of an ice particle. + real(r8) :: m_ip + ! Ratio of autoconversion diameter to average diameter. + real(r8) :: d_rat + integer :: i + + do i=1,mgncol + if (t(i) <= tmelt .and. qiic(i) >= qsmall) then + + d_rat = lami(i)*dcs + + ! Rate of ice particle conversion (number). + nprci(i) = n0i(i)/(lami(i)*ac_time)*exp(-d_rat) + + m_ip = (rhoi*pi/6._r8) / lami(i)**3 + + ! Rate of mass conversion. + ! Note that this is: + ! m n (d^3 + 3 d^2 + 6 d + 6) + prci(i) = m_ip * nprci(i) * & + (((d_rat + 3._r8)*d_rat + 6._r8)*d_rat + 6._r8) + + else + prci(i) = 0._r8 + nprci(i) = 0._r8 + end if + enddo +end subroutine ice_autoconversion + +! immersion freezing (Bigg, 1953) +!=================================== + +subroutine immersion_freezing(microp_uniform, t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc, mgncol) + + integer, intent(in) :: mgncol + logical, intent(in) :: microp_uniform + + ! Temperature + real(r8), dimension(mgncol), intent(in) :: t + + ! Cloud droplet size distribution parameters + real(r8), dimension(mgncol), intent(in) :: pgam + real(r8), dimension(mgncol), intent(in) :: lamc + + ! MMR and number concentration of in-cloud liquid water + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(in) :: ncic + + ! Relative variance of cloud water + real(r8), dimension(mgncol), intent(in) :: relvar + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: mnuccc ! MMR + real(r8), dimension(mgncol), intent(out) :: nnuccc ! Number + + ! Coefficients that will be omitted for sub-columns + real(r8), dimension(mgncol) :: dum + integer :: i + + if (.not. microp_uniform) then + dum(:) = var_coef(relvar, 2) + else + dum(:) = 1._r8 + end if + do i=1,mgncol + + if (qcic(i) >= qsmall .and. t(i) < 269.15_r8) then + + nnuccc(i) = & + pi/6._r8*ncic(i)*rising_factorial(pgam(i)+1._r8, 3)* & + bimm*(exp(aimm*(tmelt - t(i)))-1._r8)/lamc(i)**3 + + mnuccc(i) = dum(i) * nnuccc(i) * & + pi/6._r8*rhow* & + rising_factorial(pgam(i)+4._r8, 3)/lamc(i)**3 + + else + mnuccc(i) = 0._r8 + nnuccc(i) = 0._r8 + end if ! qcic > qsmall and t < 4 deg C + enddo + +end subroutine immersion_freezing + +! contact freezing (-40= qsmall .and. t(i) < 269.15_r8) then + + if (.not. microp_uniform) then + dum = var_coef(relvar(i), 4._r8/3._r8) + dum1 = var_coef(relvar(i), 1._r8/3._r8) + else + dum = 1._r8 + dum1 = 1._r8 + endif + + tcnt=(270.16_r8-t(i))**1.3_r8 + viscosity = 1.8e-5_r8*(t(i)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) + mfp = 2.0_r8*viscosity/ & ! Mean free path (m) + (p(i)*sqrt( 8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i)) )) + + ! Note that these two are vectors. + nslip = 1.0_r8+(mfp/rndst(i,:))*(1.257_r8+(0.4_r8*exp(-(1.1_r8*rndst(i,:)/mfp))))! Slip correction factor + + ndfaer = 1.381e-23_r8*t(i)*nslip/(6._r8*pi*viscosity*rndst(i,:)) ! aerosol diffusivity (m2/s) + + contact_factor = dot_product(ndfaer,nacon(i,:)*tcnt) * pi * & + ncic(i) * (pgam(i) + 1._r8) / lamc(i) + + mnucct(i) = dum * contact_factor * & + pi/3._r8*rhow*rising_factorial(pgam(i)+2._r8, 3)/lamc(i)**3 + + nnucct(i) = dum1 * 2._r8 * contact_factor + + else + + mnucct(i)=0._r8 + nnucct(i)=0._r8 + + end if ! qcic > qsmall and t < 4 deg C + end do + +end subroutine contact_freezing + +! snow self-aggregation from passarelli, 1978, used by reisner, 1998 +!=================================================================== +! this is hard-wired for bs = 0.4 for now +! ignore self-collection of cloud ice + +subroutine snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + real(r8), dimension(mgncol), intent(in) :: asn ! fall speed parameter for snow + real(r8), intent(in) :: rhosn ! density of snow + + ! In-cloud snow + real(r8), dimension(mgncol), intent(in) :: qsic ! MMR + real(r8), dimension(mgncol), intent(in) :: nsic ! Number + + ! Output number tendency + real(r8), dimension(mgncol), intent(out) :: nsagg + + integer :: i + + do i=1,mgncol + if (qsic(i) >= qsmall .and. t(i) <= tmelt) then + nsagg(i) = -1108._r8*eii/(4._r8*720._r8*rhosn)*asn(i)*qsic(i)*nsic(i)*rho(i)*& + ((qsic(i)/nsic(i))*(1._r8/(rhosn*pi)))**((bs-1._r8)/3._r8) + else + nsagg(i)=0._r8 + end if + enddo +end subroutine snow_self_aggregation + +! accretion of cloud droplets onto snow/graupel +!=================================================================== +! here use continuous collection equation with +! simple gravitational collection kernel +! ignore collisions between droplets/cloud ice +! since minimum size ice particle for accretion is 50 - 150 micron + +subroutine accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + real(r8), dimension(mgncol), intent(in) :: asn ! Fallspeed parameter (snow) + real(r8), dimension(mgncol), intent(in) :: uns ! Current fallspeed (snow) + real(r8), dimension(mgncol), intent(in) :: mu ! Viscosity + + ! In-cloud liquid water + real(r8), dimension(mgncol), intent(in) :: qcic ! MMR + real(r8), dimension(mgncol), intent(in) :: ncic ! Number + + ! In-cloud snow + real(r8), dimension(mgncol), intent(in) :: qsic ! MMR + + ! Cloud droplet size parameters + real(r8), dimension(mgncol), intent(in) :: pgam + real(r8), dimension(mgncol), intent(in) :: lamc + + ! Snow size parameters + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: psacws ! Mass mixing ratio + real(r8), dimension(mgncol), intent(out) :: npsacws ! Number concentration + + real(r8) :: dc0 ! Provisional mean droplet size + real(r8) :: dum + real(r8) :: eci ! collection efficiency for riming of snow by droplets + + ! Fraction of cloud droplets accreted per second + real(r8) :: accrete_rate + integer :: i + + ! ignore collision of snow with droplets above freezing + + do i=1,mgncol + if (qsic(i) >= qsmall .and. t(i) <= tmelt .and. qcic(i) >= qsmall) then + + ! put in size dependent collection efficiency + ! mean diameter of snow is area-weighted, since + ! accretion is function of crystal geometric area + ! collection efficiency is approximation based on stoke's law (Thompson et al. 2004) + + dc0 = (pgam(i)+1._r8)/lamc(i) + dum = dc0*dc0*uns(i)*rhow*lams(i)/(9._r8*mu(i)) + eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8)) + + eci = max(eci,0._r8) + eci = min(eci,1._r8) + + ! no impact of sub-grid distribution of qc since psacws + ! is linear in qc + accrete_rate = pi/4._r8*asn(i)*rho(i)*n0s(i)*eci*gamma_bs_plus3 / lams(i)**(bs+3._r8) + psacws(i) = accrete_rate*qcic(i) + npsacws(i) = accrete_rate*ncic(i) + else + psacws(i) = 0._r8 + npsacws(i) = 0._r8 + end if + enddo +end subroutine accrete_cloud_water_snow + +! add secondary ice production due to accretion of droplets by snow +!=================================================================== +! (Hallet-Mossop process) (from Cotton et al., 1986) + +subroutine secondary_ice_production(t, psacws, msacwi, nsacwi, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + + ! Accretion of cloud water to snow tendencies + real(r8), dimension(mgncol), intent(inout) :: psacws ! MMR + + ! Output (ice) tendencies + real(r8), dimension(mgncol), intent(out) :: msacwi ! MMR + real(r8), dimension(mgncol), intent(out) :: nsacwi ! Number + integer :: i + + do i=1,mgncol + if((t(i) < 270.16_r8) .and. (t(i) >= 268.16_r8)) then + nsacwi(i) = 3.5e8_r8*(270.16_r8-t(i))/2.0_r8*psacws(i) + else if((t(i) < 268.16_r8) .and. (t(i) >= 265.16_r8)) then + nsacwi(i) = 3.5e8_r8*(t(i)-265.16_r8)/3.0_r8*psacws(i) + else + nsacwi(i) = 0.0_r8 + endif + enddo + + do i=1,mgncol + msacwi(i) = min(nsacwi(i)*mi0, psacws(i)) + psacws(i) = psacws(i) - msacwi(i) + enddo +end subroutine secondary_ice_production + +! accretion of rain water by snow +!=================================================================== +! formula from ikawa and saito, 1991, used by reisner et al., 1998 + +subroutine accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + + ! Fallspeeds + ! mass-weighted + real(r8), dimension(mgncol), intent(in) :: umr ! rain + real(r8), dimension(mgncol), intent(in) :: ums ! snow + ! number-weighted + real(r8), dimension(mgncol), intent(in) :: unr ! rain + real(r8), dimension(mgncol), intent(in) :: uns ! snow + + ! In cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qric ! rain + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size distribution parameters + ! rain + real(r8), dimension(mgncol), intent(in) :: lamr + real(r8), dimension(mgncol), intent(in) :: n0r + ! snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pracs ! MMR + real(r8), dimension(mgncol), intent(out) :: npracs ! Number + + ! Collection efficiency for accretion of rain by snow + real(r8), parameter :: ecr = 1.0_r8 + + ! Ratio of average snow diameter to average rain diameter. + real(r8) :: d_rat + ! Common factor between mass and number expressions + real(r8) :: common_factor + integer :: i + + do i=1,mgncol + if (qric(i) >= icsmall .and. qsic(i) >= icsmall .and. t(i) <= tmelt) then + + common_factor = pi*ecr*rho(i)*n0r(i)*n0s(i)/(lamr(i)**3 * lams(i)) + + d_rat = lamr(i)/lams(i) + + pracs(i) = common_factor*pi*rhow* & + sqrt((1.2_r8*umr(i)-0.95_r8*ums(i))**2 + 0.08_r8*ums(i)*umr(i)) / lamr(i)**3 * & + ((0.5_r8*d_rat + 2._r8)*d_rat + 5._r8) + + npracs(i) = common_factor*0.5_r8* & + sqrt(1.7_r8*(unr(i)-uns(i))**2 + 0.3_r8*unr(i)*uns(i)) * & + ((d_rat + 1._r8)*d_rat + 1._r8) + + else + pracs(i) = 0._r8 + npracs(i) = 0._r8 + end if + enddo +end subroutine accrete_rain_snow + +! heterogeneous freezing of rain drops +!=================================================================== +! follows from Bigg (1953) + +subroutine heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + + ! In-cloud rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + real(r8), dimension(mgncol), intent(in) :: nric ! Number + real(r8), dimension(mgncol), intent(in) :: lamr ! size parameter + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: mnuccr ! MMR + real(r8), dimension(mgncol), intent(out) :: nnuccr ! Number + integer :: i + + do i=1,mgncol + + if (t(i) < 269.15_r8 .and. qric(i) >= qsmall) then + nnuccr(i) = pi*nric(i)*bimm* & + (exp(aimm*(tmelt - t(i)))-1._r8)/lamr(i)**3 + + mnuccr(i) = nnuccr(i) * 20._r8*pi*rhow/lamr(i)**3 + + else + mnuccr(i) = 0._r8 + nnuccr(i) = 0._r8 + end if + enddo +end subroutine heterogeneous_rain_freezing + +! accretion of cloud liquid water by rain +!=================================================================== +! formula from Khrouditnov and Kogan (2000) +! gravitational collection kernel, droplet fall speed neglected + +subroutine accrete_cloud_water_rain(microp_uniform, qric, qcic, & + ncic, relvar, accre_enhan, pra, npra, mgncol) + + logical, intent(in) :: microp_uniform + integer, intent(in) :: mgncol + ! In-cloud rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + + ! Cloud droplets + real(r8), dimension(mgncol), intent(in) :: qcic ! MMR + real(r8), dimension(mgncol), intent(in) :: ncic ! Number + + ! SGS variability + real(r8), dimension(mgncol), intent(in) :: relvar + real(r8), dimension(mgncol), intent(in) :: accre_enhan + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pra ! MMR + real(r8), dimension(mgncol), intent(out) :: npra ! Number + + ! Coefficient that varies for subcolumns + real(r8), dimension(mgncol) :: pra_coef + + integer :: i + + if (.not. microp_uniform) then + pra_coef(:) = accre_enhan * var_coef(relvar(:), 1.15_r8) + else + pra_coef(:) = 1._r8 + end if + + do i=1,mgncol + + if (qric(i) >= qsmall .and. qcic(i) >= qsmall) then + + ! include sub-grid distribution of cloud water + pra(i) = pra_coef(i) * 67._r8*(qcic(i)*qric(i))**1.15_r8 + + npra(i) = pra(i)*ncic(i)/qcic(i) + + else + pra(i) = 0._r8 + npra(i) = 0._r8 + end if + end do +end subroutine accrete_cloud_water_rain + +! Self-collection of rain drops +!=================================================================== +! from Beheng(1994) + +subroutine self_collection_rain(rho, qric, nric, nragg, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: rho ! Air density + + ! Rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + real(r8), dimension(mgncol), intent(in) :: nric ! Number + + ! Output number tendency + real(r8), dimension(mgncol), intent(out) :: nragg + + integer :: i + + do i=1,mgncol + if (qric(i) >= qsmall) then + nragg(i) = -8._r8*nric(i)*qric(i)*rho(i) + else + nragg(i) = 0._r8 + end if + enddo +end subroutine self_collection_rain + + +! Accretion of cloud ice by snow +!=================================================================== +! For this calculation, it is assumed that the Vs >> Vi +! and Ds >> Di for continuous collection + +subroutine accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + + real(r8), dimension(mgncol), intent(in) :: asn ! Snow fallspeed parameter + + ! Cloud ice + real(r8), dimension(mgncol), intent(in) :: qiic ! MMR + real(r8), dimension(mgncol), intent(in) :: niic ! Number + + real(r8), dimension(mgncol), intent(in) :: qsic ! Snow MMR + + ! Snow size parameters + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: prai ! MMR + real(r8), dimension(mgncol), intent(out) :: nprai ! Number + + ! Fraction of cloud ice particles accreted per second + real(r8) :: accrete_rate + + integer :: i + + do i=1,mgncol + if (qsic(i) >= qsmall .and. qiic(i) >= qsmall .and. t(i) <= tmelt) then + + accrete_rate = pi/4._r8 * eii * asn(i) * rho(i) * n0s(i) * gamma_bs_plus3/ & + lams(i)**(bs+3._r8) + + prai(i) = accrete_rate * qiic(i) + nprai(i) = accrete_rate * niic(i) + + else + prai(i) = 0._r8 + nprai(i) = 0._r8 + end if + enddo +end subroutine accrete_cloud_ice_snow + +! calculate evaporation/sublimation of rain and snow +!=================================================================== +! note: evaporation/sublimation occurs only in cloud-free portion of grid cell +! in-cloud condensation/deposition of rain and snow is neglected +! except for transfer of cloud water to snow through bergeron process + +subroutine evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, & + lcldm, precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds, am_evp_st, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! temperature + real(r8), dimension(mgncol), intent(in) :: rho ! air density + real(r8), dimension(mgncol), intent(in) :: dv ! water vapor diffusivity + real(r8), dimension(mgncol), intent(in) :: mu ! viscosity + real(r8), dimension(mgncol), intent(in) :: sc ! schmidt number + real(r8), dimension(mgncol), intent(in) :: q ! humidity + real(r8), dimension(mgncol), intent(in) :: qvl ! saturation humidity (water) + real(r8), dimension(mgncol), intent(in) :: qvi ! saturation humidity (ice) + real(r8), dimension(mgncol), intent(in) :: lcldm ! liquid cloud fraction + real(r8), dimension(mgncol), intent(in) :: precip_frac ! precipitation fraction (maximum overlap) + + ! fallspeed parameters + real(r8), dimension(mgncol), intent(in) :: arn ! rain + real(r8), dimension(mgncol), intent(in) :: asn ! snow + + ! In-cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qcic ! cloud liquid + real(r8), dimension(mgncol), intent(in) :: qiic ! cloud ice + real(r8), dimension(mgncol), intent(in) :: qric ! rain + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size parameters + ! rain + real(r8), dimension(mgncol), intent(in) :: lamr + real(r8), dimension(mgncol), intent(in) :: n0r + ! snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pre + real(r8), dimension(mgncol), intent(out) :: prds + real(r8), dimension(mgncol), intent(out) :: am_evp_st ! Fractional area where rain evaporates. + + real(r8) :: qclr ! water vapor mixing ratio in clear air + real(r8) :: ab ! correction to account for latent heat + real(r8) :: eps ! 1/ sat relaxation timescale + + real(r8), dimension(mgncol) :: dum + + integer :: i + + am_evp_st = 0._r8 + ! set temporary cloud fraction to zero if cloud water + ice is very small + ! this will ensure that evaporation/sublimation of precip occurs over + ! entire grid cell, since min cloud fraction is specified otherwise + do i=1,mgncol + if (qcic(i)+qiic(i) < 1.e-6_r8) then + dum(i) = 0._r8 + else + dum(i) = lcldm(i) + end if + enddo + do i=1,mgncol + ! only calculate if there is some precip fraction > cloud fraction + + if (precip_frac(i) > dum(i)) then + + if (qric(i) >= qsmall .or. qsic(i) >= qsmall) then + am_evp_st(i) = precip_frac(i) - dum(i) + + ! calculate q for out-of-cloud region + qclr=(q(i)-dum(i)*qvl(i))/(1._r8-dum(i)) + end if + + ! evaporation of rain + if (qric(i) >= qsmall) then + + ab = calc_ab(t(i), qvl(i), xxlv) + eps = 2._r8*pi*n0r(i)*rho(i)*Dv(i)* & + (f1r/(lamr(i)*lamr(i))+ & + f2r*(arn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_br_plus5/ & + (lamr(i)**(5._r8/2._r8+br/2._r8))) + + pre(i) = eps*(qclr-qvl(i))/ab + + ! only evaporate in out-of-cloud region + ! and distribute across precip_frac + pre(i)=min(pre(i)*am_evp_st(i),0._r8) + pre(i)=pre(i)/precip_frac(i) + else + pre(i) = 0._r8 + end if + + ! sublimation of snow + if (qsic(i) >= qsmall) then + ab = calc_ab(t(i), qvi(i), xxls) + eps = 2._r8*pi*n0s(i)*rho(i)*Dv(i)* & + (f1s/(lams(i)*lams(i))+ & + f2s*(asn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_bs_plus5/ & + (lams(i)**(5._r8/2._r8+bs/2._r8))) + prds(i) = eps*(qclr-qvi(i))/ab + + ! only sublimate in out-of-cloud region and distribute over precip_frac + prds(i)=min(prds(i)*am_evp_st(i),0._r8) + prds(i)=prds(i)/precip_frac(i) + else + prds(i) = 0._r8 + end if + + else + prds(i) = 0._r8 + pre(i) = 0._r8 + end if + enddo + +end subroutine evaporate_sublimate_precip + +! bergeron process - evaporation of droplets and deposition onto snow +!=================================================================== + +subroutine bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! temperature + real(r8), dimension(mgncol), intent(in) :: rho ! air density + real(r8), dimension(mgncol), intent(in) :: dv ! water vapor diffusivity + real(r8), dimension(mgncol), intent(in) :: mu ! viscosity + real(r8), dimension(mgncol), intent(in) :: sc ! schmidt number + real(r8), dimension(mgncol), intent(in) :: qvl ! saturation humidity (water) + real(r8), dimension(mgncol), intent(in) :: qvi ! saturation humidity (ice) + + ! fallspeed parameter for snow + real(r8), dimension(mgncol), intent(in) :: asn + + ! In-cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qcic ! cloud liquid + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size parameters for snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: bergs + + real(r8) :: ab ! correction to account for latent heat + real(r8) :: eps ! 1/ sat relaxation timescale + + integer :: i + + do i=1,mgncol + if (qsic(i) >= qsmall.and. qcic(i) >= qsmall .and. t(i) < tmelt) then + ab = calc_ab(t(i), qvi(i), xxls) + eps = 2._r8*pi*n0s(i)*rho(i)*Dv(i)* & + (f1s/(lams(i)*lams(i))+ & + f2s*(asn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_bs_plus5/ & + (lams(i)**(5._r8/2._r8+bs/2._r8))) + bergs(i) = eps*(qvl(i)-qvi(i))/ab + else + bergs(i) = 0._r8 + end if + enddo +end subroutine bergeron_process_snow + +!======================================================================== +!UTILITIES +!======================================================================== + +pure function no_limiter() + real(r8) :: no_limiter + + no_limiter = transfer(limiter_off, no_limiter) + +end function no_limiter + +pure function limiter_is_on(lim) + real(r8), intent(in) :: lim + logical :: limiter_is_on + + limiter_is_on = transfer(lim, limiter_off) /= limiter_off + +end function limiter_is_on + +end module micro_mg_utils diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 new file mode 100644 index 0000000000..adc192853d --- /dev/null +++ b/src/physics/cam/microp_aero.F90 @@ -0,0 +1,737 @@ +module microp_aero + +!--------------------------------------------------------------------------------- +! Purpose: +! CAM driver layer for aerosol activation processes. +! +! ***N.B.*** This module is currently hardcoded to recognize only the aerosols/modes that +! affect the climate calculation. This is implemented by using list +! index 0 in all the calls to rad_constituent interfaces. +! +! Author: Andrew Gettelman +! Based on code from: Hugh Morrison, Xiaohong Liu and Steve Ghan +! May 2010 +! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) +! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) +! for questions contact Andrew Gettelman (andrew@ucar.edu) +! Modifications: A. Gettelman Nov 2010 - changed to support separation of +! microphysics and macrophysics and concentrate aerosol information here +! B. Eaton, Sep 2014 - Refactored to move CAM interface code into the CAM +! interface modules and preserve just the driver layer functionality here. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp +use ref_pres, only: top_lev => trop_cloud_top_lev +use physconst, only: rair +use constituents, only: cnst_get_ind +use physics_types, only: physics_state, physics_ptend, physics_ptend_init, physics_ptend_sum, & + physics_state_copy, physics_update +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use phys_control, only: phys_getopts, use_hetfrz_classnuc +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & + rad_cnst_get_mode_num + +use nucleate_ice_cam, only: use_preexisting_ice, nucleate_ice_cam_readnl, nucleate_ice_cam_register, & + nucleate_ice_cam_init, nucleate_ice_cam_calc + +use ndrop, only: ndrop_init, dropmixnuc +use ndrop_bam, only: ndrop_bam_init, ndrop_bam_run, ndrop_bam_ccn + +use hetfrz_classnuc_cam, only: hetfrz_classnuc_cam_readnl, hetfrz_classnuc_cam_register, hetfrz_classnuc_cam_init, & + hetfrz_classnuc_cam_save_cbaero, hetfrz_classnuc_cam_calc + +use cam_history, only: addfld, add_default, outfld +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: microp_aero_init, microp_aero_run, microp_aero_readnl, microp_aero_register + +! Private module data + +character(len=16) :: eddy_scheme + +! contact freezing due to dust +! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 +real(r8), parameter :: rn_dst1 = 0.258e-6_r8 +real(r8), parameter :: rn_dst2 = 0.717e-6_r8 +real(r8), parameter :: rn_dst3 = 1.576e-6_r8 +real(r8), parameter :: rn_dst4 = 3.026e-6_r8 + +real(r8) :: bulk_scale ! prescribed aerosol bulk sulfur scale factor + +! smallest mixing ratio considered in microphysics +real(r8), parameter :: qsmall = 1.e-18_r8 + +! minimum allowed cloud fraction +real(r8), parameter :: mincld = 0.0001_r8 + +! indices in state%q and pbuf structures +integer :: cldliq_idx = -1 +integer :: cldice_idx = -1 +integer :: numliq_idx = -1 +integer :: numice_idx = -1 +integer :: kvh_idx = -1 +integer :: tke_idx = -1 +integer :: wp2_idx = -1 +integer :: ast_idx = -1 +integer :: cldo_idx = -1 +integer :: dgnumwet_idx = -1 + +! Bulk aerosols +character(len=20), allocatable :: aername(:) +real(r8), allocatable :: num_to_mass_aer(:) + +integer :: naer_all ! number of aerosols affecting climate +integer :: idxsul = -1 ! index in aerosol list for sulfate +integer :: idxdst2 = -1 ! index in aerosol list for dust2 +integer :: idxdst3 = -1 ! index in aerosol list for dust3 +integer :: idxdst4 = -1 ! index in aerosol list for dust4 + +! modal aerosols +logical :: clim_modal_aero + +integer :: mode_accum_idx = -1 ! index of accumulation mode +integer :: mode_aitken_idx = -1 ! index of aitken mode +integer :: mode_coarse_idx = -1 ! index of coarse mode +integer :: mode_coarse_dst_idx = -1 ! index of coarse dust mode +integer :: mode_coarse_slt_idx = -1 ! index of coarse sea salt mode +integer :: coarse_dust_idx = -1 ! index of dust in coarse mode +integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode +integer :: coarse_so4_idx = -1 ! index of sulfate in coarse mode + +integer :: npccn_idx, rndst_idx, nacon_idx + +logical :: separate_dust = .false. + +!========================================================================================= +contains +!========================================================================================= + +subroutine microp_aero_register + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Register pbuf fields for aerosols needed by microphysics + ! + ! Author: Cheryl Craig October 2012 + ! + !----------------------------------------------------------------------- + use ppgrid, only: pcols + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call pbuf_add_field('NPCCN', 'physpkg',dtype_r8,(/pcols,pver/), npccn_idx) + + call pbuf_add_field('RNDST', 'physpkg',dtype_r8,(/pcols,pver,4/), rndst_idx) + call pbuf_add_field('NACON', 'physpkg',dtype_r8,(/pcols,pver,4/), nacon_idx) + + call nucleate_ice_cam_register() + call hetfrz_classnuc_cam_register() + +end subroutine microp_aero_register + +!========================================================================================= + +subroutine microp_aero_init + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Initialize constants for aerosols needed by microphysics + ! + ! Author: Andrew Gettelman May 2010 + ! + !----------------------------------------------------------------------- + + ! local variables + integer :: iaer, ierr + integer :: m, n, nmodes, nspec + + character(len=32) :: str32 + character(len=*), parameter :: routine = 'microp_aero_init' + logical :: history_amwg + !----------------------------------------------------------------------- + + ! Query the PBL eddy scheme + call phys_getopts(eddy_scheme_out = eddy_scheme, & + history_amwg_out = history_amwg ) + + ! Access the physical properties of the aerosols that are affecting the climate + ! by using routines from the rad_constituents module. + + ! get indices into state and pbuf structures + call cnst_get_ind('CLDLIQ', cldliq_idx) + call cnst_get_ind('CLDICE', cldice_idx) + call cnst_get_ind('NUMLIQ', numliq_idx) + call cnst_get_ind('NUMICE', numice_idx) + + select case(trim(eddy_scheme)) + case ('diag_TKE') + tke_idx = pbuf_get_index('tke') + case ('CLUBB_SGS') + wp2_idx = pbuf_get_index('WP2_nadv') + case default + kvh_idx = pbuf_get_index('kvh') + end select + + ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. + ! The modal aerosols can be either prognostic or prescribed. + call rad_cnst_get_info(0, nmodes=nmodes) + clim_modal_aero = (nmodes > 0) + + ast_idx = pbuf_get_index('AST') + + if (clim_modal_aero) then + + cldo_idx = pbuf_get_index('CLDO') + dgnumwet_idx = pbuf_get_index('DGNUMWET') + + call ndrop_init() + + ! Init indices for specific modes/species + + ! mode index for specified mode types + do m = 1, nmodes + call rad_cnst_get_info(0, m, mode_type=str32) + select case (trim(str32)) + case ('accum') + mode_accum_idx = m + case ('aitken') + mode_aitken_idx = m + case ('coarse') + mode_coarse_idx = m + case ('coarse_dust') + mode_coarse_dst_idx = m + case ('coarse_seasalt') + mode_coarse_slt_idx = m + end select + end do + + ! check if coarse dust is in separate mode + separate_dust = mode_coarse_dst_idx > 0 + + ! for 3-mode + if ( mode_coarse_dst_idx<0 ) mode_coarse_dst_idx = mode_coarse_idx + if ( mode_coarse_slt_idx<0 ) mode_coarse_slt_idx = mode_coarse_idx + + ! Check that required mode types were found + if (mode_accum_idx == -1 .or. mode_aitken_idx == -1 .or. & + mode_coarse_dst_idx == -1.or. mode_coarse_slt_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + mode_accum_idx, mode_aitken_idx, mode_coarse_dst_idx, mode_coarse_slt_idx + call endrun(routine//': ERROR required mode type not found') + end if + + ! species indices for specified types + ! find indices for the dust and seasalt species in the coarse mode + call rad_cnst_get_info(0, mode_coarse_dst_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_dst_idx, n, spec_type=str32) + select case (trim(str32)) + case ('dust') + coarse_dust_idx = n + end select + end do + call rad_cnst_get_info(0, mode_coarse_slt_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_slt_idx, n, spec_type=str32) + select case (trim(str32)) + case ('seasalt') + coarse_nacl_idx = n + end select + end do + if (mode_coarse_idx>0) then + call rad_cnst_get_info(0, mode_coarse_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_idx, n, spec_type=str32) + select case (trim(str32)) + case ('sulfate') + coarse_so4_idx = n + end select + end do + endif + + ! Check that required mode specie types were found + if ( coarse_dust_idx == -1 .or. coarse_nacl_idx == -1 ) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + coarse_dust_idx, coarse_nacl_idx + call endrun(routine//': ERROR required mode-species type not found') + end if + + else + + ! Props needed for BAM number concentration calcs. + + call rad_cnst_get_info(0, naero=naer_all) + allocate( & + aername(naer_all), & + num_to_mass_aer(naer_all) ) + + do iaer = 1, naer_all + call rad_cnst_get_aer_props(0, iaer, & + aername = aername(iaer), & + num_to_mass_aer = num_to_mass_aer(iaer) ) + + ! Look for sulfate, dust, and soot in this list (Bulk aerosol only) + if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer + if (trim(aername(iaer)) == 'DUST2') idxdst2 = iaer + if (trim(aername(iaer)) == 'DUST3') idxdst3 = iaer + if (trim(aername(iaer)) == 'DUST4') idxdst4 = iaer + end do + + call ndrop_bam_init() + + end if + + call addfld('LCLOUD', (/ 'lev' /), 'A', ' ', 'Liquid cloud fraction used in stratus activation') + + call addfld('WSUB', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity' ) + call addfld('WSUBI', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity for ice' ) + + if (history_amwg) then + call add_default ('WSUB ', 1, ' ') + end if + + call nucleate_ice_cam_init(mincld, bulk_scale) + call hetfrz_classnuc_cam_init(mincld) + +end subroutine microp_aero_init + +!========================================================================================= + +subroutine microp_aero_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Namelist variables + real(r8) :: microp_aero_bulk_scale = 2._r8 ! prescribed aerosol bulk sulfur scale factor + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'microp_aero_readnl' + + namelist /microp_aero_nl/ microp_aero_bulk_scale + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'microp_aero_nl', status=ierr) + if (ierr == 0) then + read(unitn, microp_aero_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variable + call mpibcast(microp_aero_bulk_scale, 1, mpir8, 0, mpicom) +#endif + + ! set local variables + bulk_scale = microp_aero_bulk_scale + + call nucleate_ice_cam_readnl(nlfile) + call hetfrz_classnuc_cam_readnl(nlfile) + +end subroutine microp_aero_readnl + +!========================================================================================= + +subroutine microp_aero_run ( & + state, ptend_all, deltatin, pbuf) + + ! input arguments + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend_all + real(r8), intent(in) :: deltatin ! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local workspace + ! all units mks unless otherwise stated + + integer :: i, k, m + integer :: itim_old + integer :: nmodes + + type(physics_state) :: state1 ! Local copy of state variable + type(physics_ptend) :: ptend_loc + + real(r8), pointer :: ast(:,:) + + real(r8), pointer :: npccn(:,:) ! number of CCN (liquid activated) + + real(r8), pointer :: rndst(:,:,:) ! radius of 4 dust bins for contact freezing + real(r8), pointer :: nacon(:,:,:) ! number in 4 dust bins for contact freezing + + real(r8), pointer :: num_coarse(:,:) ! number m.r. of coarse mode + real(r8), pointer :: coarse_dust(:,:) ! mass m.r. of coarse dust + real(r8), pointer :: coarse_nacl(:,:) ! mass m.r. of coarse nacl + real(r8), pointer :: coarse_so4(:,:) ! mass m.r. of coarse sulfate + + real(r8), pointer :: kvh(:,:) ! vertical eddy diff coef (m2 s-1) + real(r8), pointer :: tke(:,:) ! TKE from the UW PBL scheme (m2 s-2) + real(r8), pointer :: wp2(:,:) ! CLUBB vertical velocity variance + + real(r8), pointer :: cldn(:,:) ! cloud fraction + real(r8), pointer :: cldo(:,:) ! old cloud fraction + + real(r8), pointer :: dgnumwet(:,:,:) ! aerosol mode diameter + + real(r8), pointer :: aer_mmr(:,:) ! aerosol mass mixing ratio + + real(r8) :: rho(pcols,pver) ! air density (kg m-3) + + real(r8) :: lcldm(pcols,pver) ! liq cloud fraction + + real(r8) :: lcldn(pcols,pver) ! fractional coverage of new liquid cloud + real(r8) :: lcldo(pcols,pver) ! fractional coverage of old liquid cloud + real(r8) :: cldliqf(pcols,pver) ! fractional of total cloud that is liquid + real(r8) :: qcld ! total cloud water + real(r8) :: nctend_mixnuc(pcols,pver) + real(r8) :: dum, dum2 ! temporary dummy variable + real(r8) :: dmc, ssmc, so4mc ! variables for modal scheme. + integer :: dst_idx, num_idx + + ! bulk aerosol variables + real(r8), allocatable :: naer2(:,:,:) ! bulk aerosol number concentration (1/m3) + real(r8), allocatable :: maerosol(:,:,:) ! bulk aerosol mass conc (kg/m3) + + real(r8) :: wsub(pcols,pver) ! diagnosed sub-grid vertical velocity st. dev. (m/s) + real(r8) :: wsubi(pcols,pver) ! diagnosed sub-grid vertical velocity ice (m/s) + real(r8) :: nucboas + + real(r8) :: wght + + integer :: lchnk, ncol + + real(r8), allocatable :: factnum(:,:,:) ! activation fraction for aerosol number + !------------------------------------------------------------------------------- + + call physics_state_copy(state,state1) + + lchnk = state1%lchnk + ncol = state1%ncol + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, npccn_idx, npccn) + + call pbuf_get_field(pbuf, nacon_idx, nacon) + call pbuf_get_field(pbuf, rndst_idx, rndst) + + call physics_ptend_init(ptend_all, state%psetcols, 'microp_aero') + + if (clim_modal_aero) then + + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, ast_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call rad_cnst_get_info(0, nmodes=nmodes) + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + + allocate(factnum(pcols,pver,nmodes)) + + end if + + ! initialize output + npccn(1:ncol,1:pver) = 0._r8 + + nacon(1:ncol,1:pver,:) = 0._r8 + + ! set default or fixed dust bins for contact freezing + rndst(1:ncol,1:pver,1) = rn_dst1 + rndst(1:ncol,1:pver,2) = rn_dst2 + rndst(1:ncol,1:pver,3) = rn_dst3 + rndst(1:ncol,1:pver,4) = rn_dst4 + + ! save copy of cloud borne aerosols for use in heterogeneous freezing + if (use_hetfrz_classnuc) then + call hetfrz_classnuc_cam_save_cbaero(state1, pbuf) + end if + + ! initialize time-varying parameters + do k = top_lev, pver + do i = 1, ncol + rho(i,k) = state1%pmid(i,k)/(rair*state1%t(i,k)) + end do + end do + + if (clim_modal_aero) then + ! mode number mixing ratios + call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'a', state1, pbuf, num_coarse) + + ! mode specie mass m.r. + call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'a', state1, pbuf, coarse_dust) + call rad_cnst_get_aer_mmr(0, mode_coarse_slt_idx, coarse_nacl_idx, 'a', state1, pbuf, coarse_nacl) + if (mode_coarse_idx>0) then + call rad_cnst_get_aer_mmr(0, mode_coarse_idx, coarse_so4_idx, 'a', state1, pbuf, coarse_so4) + endif + + else + ! init number/mass arrays for bulk aerosols + allocate( & + naer2(pcols,pver,naer_all), & + maerosol(pcols,pver,naer_all)) + + do m = 1, naer_all + call rad_cnst_get_aer_mmr(0, m, state1, pbuf, aer_mmr) + maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:) + + if (m .eq. idxsul) then + naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m)*bulk_scale + else + naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m) + end if + end do + end if + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! More refined computation of sub-grid vertical velocity + ! Set to be zero at the surface by initialization. + + select case (trim(eddy_scheme)) + case ('diag_TKE') + call pbuf_get_field(pbuf, tke_idx, tke) + case ('CLUBB_SGS') + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/),kount=(/pcols,pverp,1/)) + allocate(tke(pcols,pverp)) + tke(:ncol,:) = (3._r8/2._r8)*wp2(:ncol,:) + + case default + call pbuf_get_field(pbuf, kvh_idx, kvh) + end select + + ! Set minimum values above top_lev. + wsub(:ncol,:top_lev-1) = 0.20_r8 + wsubi(:ncol,:top_lev-1) = 0.001_r8 + + do k = top_lev, pver + do i = 1, ncol + + select case (trim(eddy_scheme)) + case ('diag_TKE', 'CLUBB_SGS') + wsub(i,k) = sqrt(0.5_r8*(tke(i,k) + tke(i,k+1))*(2._r8/3._r8)) + wsub(i,k) = min(wsub(i,k),10._r8) + case default + ! get sub-grid vertical velocity from diff coef. + ! following morrison et al. 2005, JAS + ! assume mixing length of 30 m + dum = (kvh(i,k) + kvh(i,k+1))/2._r8/30._r8 + ! use maximum sub-grid vertical vel of 10 m/s + dum = min(dum, 10._r8) + ! set wsub to value at current vertical level + wsub(i,k) = dum + end select + + wsubi(i,k) = max(0.001_r8, wsub(i,k)) + if (.not. use_preexisting_ice) then + wsubi(i,k) = min(wsubi(i,k), 0.2_r8) + endif + + wsub(i,k) = max(0.20_r8, wsub(i,k)) + + end do + end do + + call outfld('WSUB', wsub, pcols, lchnk) + call outfld('WSUBI', wsubi, pcols, lchnk) + + if (trim(eddy_scheme) == 'CLUBB_SGS') deallocate(tke) + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + !ICE Nucleation + + call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc) + + call physics_ptend_sum(ptend_loc, ptend_all, ncol) + call physics_update(state1, ptend_loc, deltatin) + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get liquid cloud fraction, check for minimum + + do k = top_lev, pver + do i = 1, ncol + lcldm(i,k) = max(ast(i,k), mincld) + end do + end do + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! Droplet Activation + + if (clim_modal_aero) then + + ! for modal aerosol + + ! partition cloud fraction into liquid water part + lcldn = 0._r8 + lcldo = 0._r8 + cldliqf = 0._r8 + do k = top_lev, pver + do i = 1, ncol + qcld = state1%q(i,k,cldliq_idx) + state1%q(i,k,cldice_idx) + if (qcld > qsmall) then + lcldn(i,k) = cldn(i,k)*state1%q(i,k,cldliq_idx)/qcld + lcldo(i,k) = cldo(i,k)*state1%q(i,k,cldliq_idx)/qcld + cldliqf(i,k) = state1%q(i,k,cldliq_idx)/qcld + end if + end do + end do + + call outfld('LCLOUD', lcldn, pcols, lchnk) + + ! If not using preexsiting ice, then only use cloudbourne aerosol for the + ! liquid clouds. This is the same behavior as CAM5. + if (use_preexisting_ice) then + call dropmixnuc( & + state1, ptend_loc, deltatin, pbuf, wsub, & + cldn, cldo, cldliqf, nctend_mixnuc, factnum) + else + cldliqf = 1._r8 + call dropmixnuc( & + state1, ptend_loc, deltatin, pbuf, wsub, & + lcldn, lcldo, cldliqf, nctend_mixnuc, factnum) + end if + + npccn(:ncol,:) = nctend_mixnuc(:ncol,:) + + else + + ! for bulk aerosol + + ! no tendencies returned from ndrop_bam_run, so just init ptend here + call physics_ptend_init(ptend_loc, state1%psetcols, 'none') + + do k = top_lev, pver + do i = 1, ncol + + if (state1%q(i,k,cldliq_idx) >= qsmall) then + + ! get droplet activation rate + + call ndrop_bam_run( & + wsub(i,k), state1%t(i,k), rho(i,k), naer2(i,k,:), naer_all, & + naer_all, maerosol(i,k,:), & + dum2) + dum = dum2 + else + dum = 0._r8 + end if + + npccn(i,k) = (dum*lcldm(i,k) - state1%q(i,k,numliq_idx))/deltatin + end do + end do + + end if + + call physics_ptend_sum(ptend_loc, ptend_all, ncol) + call physics_update(state1, ptend_loc, deltatin) + + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! Contact freezing (-40 0.0_r8) then + nacon(i,k,3) = wght*num_coarse(i,k)*rho(i,k) + else + nacon(i,k,3) = 0._r8 + end if + + !also redefine parameters based on size... + + rndst(i,k,3) = 0.5_r8*dgnumwet(i,k,mode_coarse_dst_idx) + if (rndst(i,k,3) <= 0._r8) then + rndst(i,k,3) = rn_dst3 + end if + + else + + !For Bulk Aerosols: set equal to aerosol number for dust for bins 2-4 (bin 1=0) + + if (idxdst2 > 0) then + nacon(i,k,2) = naer2(i,k,idxdst2) + end if + if (idxdst3 > 0) then + nacon(i,k,3) = naer2(i,k,idxdst3) + end if + if (idxdst4 > 0) then + nacon(i,k,4) = naer2(i,k,idxdst4) + end if + end if + + end if + end do + end do + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + !bulk aerosol ccn concentration (modal does it in ndrop, from dropmixnuc) + + if (.not. clim_modal_aero) then + + ! ccn concentration as diagnostic + call ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) + + deallocate( & + naer2, & + maerosol) + + end if + + ! heterogeneous freezing + if (use_hetfrz_classnuc) then + + call hetfrz_classnuc_cam_calc(state1, deltatin, factnum, pbuf) + + end if + + if (clim_modal_aero) then + deallocate(factnum) + end if + +end subroutine microp_aero_run + +!========================================================================================= + +end module microp_aero diff --git a/src/physics/cam/microp_driver.F90 b/src/physics/cam/microp_driver.F90 new file mode 100644 index 0000000000..00e18f8364 --- /dev/null +++ b/src/physics/cam/microp_driver.F90 @@ -0,0 +1,200 @@ +module microp_driver + +!------------------------------------------------------------------------------------------------------- +! +! Driver for CAM microphysics parameterizations +! +!------------------------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pver +use physics_types, only: physics_state, physics_ptend, physics_tend, & + physics_ptend_copy, physics_ptend_sum +use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc +use phys_control, only: phys_getopts + +use micro_mg_cam, only: micro_mg_cam_readnl, micro_mg_cam_register, & + micro_mg_cam_implements_cnst, micro_mg_cam_init_cnst, & + micro_mg_cam_init, micro_mg_cam_tend +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use perf_mod, only: t_startf, t_stopf + +implicit none +private +save + +public :: & + microp_driver_readnl, & + microp_driver_register, & + microp_driver_init_cnst, & + microp_driver_implements_cnst, & + microp_driver_init, & + microp_driver_tend + +character(len=16) :: microp_scheme ! Microphysics scheme + +!=============================================================================== +contains +!=============================================================================== + +subroutine microp_driver_readnl(nlfile) + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Read in namelist for microphysics scheme + !----------------------------------------------------------------------- + + call phys_getopts(microp_scheme_out=microp_scheme) + + select case (microp_scheme) + case ('MG') + call micro_mg_cam_readnl(nlfile) + case ('NONE', 'RK', 'SPCAM_sam1mom', 'SPCAM_m2005') + continue + case default + call endrun('microp_driver_readnl:: unrecognized microp_scheme, "'//trim(microp_scheme)//'"') + end select + +end subroutine microp_driver_readnl + +subroutine microp_driver_register + + ! Register microphysics constituents and fields in the physics buffer. + !----------------------------------------------------------------------- + + + select case (microp_scheme) + case ('MG') + call micro_mg_cam_register() + case ('RK') + ! microp_driver doesn't handle this one + continue + case default + call endrun('microp_driver_register:: unrecognized microp_scheme') + end select + +end subroutine microp_driver_register + +!=============================================================================== + +function microp_driver_implements_cnst(name) + + ! Return true if specified constituent is implemented by the + ! microphysics package + + character(len=*), intent(in) :: name ! constituent name + logical :: microp_driver_implements_cnst ! return value + + ! Local workspace + integer :: m + !----------------------------------------------------------------------- + + microp_driver_implements_cnst = .false. + + select case (microp_scheme) + case ('MG') + microp_driver_implements_cnst = micro_mg_cam_implements_cnst(name) + case ('NONE', 'RK', 'SPCAM_sam1mom', 'SPCAM_m2005') + continue + case default + call endrun('microp_driver_implements_cnst:: unrecognized microp_scheme, '//trim(microp_scheme)) + end select + +end function microp_driver_implements_cnst + +!=============================================================================== + +subroutine microp_driver_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize the microphysics constituents, if they are + ! not read from the initial file. + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + + select case (microp_scheme) + case ('MG') + call micro_mg_cam_init_cnst(name, latvals, lonvals, mask, q) + case ('RK') + ! microp_driver doesn't handle this one + continue + case ('SPCAM_m2005') + ! microp_driver doesn't handle this one + continue + case ('SPCAM_sam1mom') + ! microp_driver doesn't handle this one + continue + case default + call endrun('microp_driver_init_cnst:: unrecognized microp_scheme'//trim(microp_scheme)) + end select + +end subroutine microp_driver_init_cnst + +!=============================================================================== + +subroutine microp_driver_init(pbuf2d) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Initialize the microphysics parameterizations + !----------------------------------------------------------------------- + + select case (microp_scheme) + case ('MG') + call micro_mg_cam_init(pbuf2d) + case ('RK') + ! microp_driver doesn't handle this one + continue + case default + call endrun('microp_driver_init:: unrecognized microp_scheme'//trim(microp_scheme)) + end select + + +end subroutine microp_driver_init + +!=============================================================================== + +subroutine microp_driver_tend(state, ptend, dtime, pbuf) + + ! Call the microphysics parameterization run methods. + + ! Input arguments + + type(physics_state), intent(in) :: state ! State variables + type(physics_ptend), intent(out) :: ptend ! Package tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dtime ! Timestep + + ! Local variables + + integer :: lchnk + integer :: ncol + + !====================================================================== + + lchnk = state%lchnk + ncol = state%ncol + + ! Call MG Microphysics + + select case (microp_scheme) + case ('MG') + call t_startf('microp_mg_tend') + call micro_mg_cam_tend(state, ptend, dtime, pbuf) + call t_stopf('microp_mg_tend') + case ('RK') + ! microp_driver doesn't handle this one + continue + case default + call endrun('microp_driver_tend:: unrecognized microp_scheme'//trim(microp_scheme)) + end select + +end subroutine microp_driver_tend + +end module microp_driver diff --git a/src/physics/cam/modal_aer_opt.F90 b/src/physics/cam/modal_aer_opt.F90 new file mode 100644 index 0000000000..85950a5790 --- /dev/null +++ b/src/physics/cam/modal_aer_opt.F90 @@ -0,0 +1,1613 @@ +module modal_aer_opt + +! parameterizes aerosol coefficients using chebychev polynomial +! parameterize aerosol radiative properties in terms of +! surface mode wet radius and wet refractive index + +! Ghan and Zaveri, JGR 2007. + +! uses Wiscombe's (1979) mie scattering code + + +use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl +use ppgrid, only: pcols, pver, pverp +use constituents, only: pcnst +use spmd_utils, only: masterproc +use ref_pres, only: top_lev => clim_modal_aero_top_lev +use physconst, only: rhoh2o, rga, rair +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag +use rad_constituents, only: n_diag, rad_cnst_get_call_list, rad_cnst_get_info, rad_cnst_get_aer_mmr, & + rad_cnst_get_aer_props, rad_cnst_get_mode_props +use physics_types, only: physics_state + +use physics_buffer, only : pbuf_get_index,physics_buffer_desc, pbuf_get_field +use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & + pio_get_var, pio_nowrite, pio_closefile +use cam_pio_utils, only: cam_pio_openfile +use cam_history, only: addfld, add_default, outfld, horiz_only +use cam_history_support, only: fillvalue +use cam_logfile, only: iulog +use perf_mod, only: t_startf, t_stopf +use cam_abortutils, only: endrun + +use modal_aero_wateruptake, only: modal_aero_wateruptake_dr +use modal_aero_calcsize, only: modal_aero_calcsize_diag + +implicit none +private +save + +public :: modal_aer_opt_readnl, modal_aer_opt_init, modal_aero_sw, modal_aero_lw + + +character(len=*), parameter :: unset_str = 'UNSET' + +! Namelist variables: +character(shr_kind_cl) :: modal_optics_file = unset_str ! full pathname for modal optics dataset +character(shr_kind_cl) :: water_refindex_file = unset_str ! full pathname for water refractive index dataset + +! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties +! in terms of refractive index and wet radius +integer, parameter :: ncoef=5, prefr=7, prefi=10 + +real(r8) :: xrmin, xrmax + +! refractive index for water read in read_water_refindex +complex(r8) :: crefwsw(nswbands) ! complex refractive index for water visible +complex(r8) :: crefwlw(nlwbands) ! complex refractive index for water infrared + +! physics buffer indices +integer :: dgnumwet_idx = -1 +integer :: qaerwat_idx = -1 + +character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', & + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine modal_aer_opt_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'modal_aer_opt_readnl' + + namelist /modal_aer_opt_nl/ water_refindex_file + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'modal_aer_opt_nl', status=ierr) + if (ierr == 0) then + read(unitn, modal_aer_opt_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(water_refindex_file, len(water_refindex_file), mpichar, 0, mpicom) +#endif + + +end subroutine modal_aer_opt_readnl + +!=============================================================================== + +subroutine modal_aer_opt_init() + + use ioFileMod, only: getfil + use phys_control, only: phys_getopts + + ! Local variables + + integer :: i, m + real(r8) :: rmmin, rmmax ! min, max aerosol surface mode radius treated (m) + character(len=256) :: locfile + + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_aero_optics ! output aerosol optics diagnostics + + logical :: call_list(0:n_diag) + integer :: ilist, nmodes, m_ncoef, m_prefr, m_prefi + integer :: errcode + + character(len=*), parameter :: routine='modal_aer_opt_init' + character(len=10) :: fldname + character(len=128) :: lngname + + !---------------------------------------------------------------------------- + + rmmin = 0.01e-6_r8 + rmmax = 25.e-6_r8 + xrmin = log(rmmin) + xrmax = log(rmmax) + + ! Check that dimension sizes in the coefficient arrays used to + ! parameterize aerosol radiative properties are consistent between this + ! module and the mode physprop files. + call rad_cnst_get_call_list(call_list) + do ilist = 0, n_diag + if (call_list(ilist)) then + call rad_cnst_get_info(ilist, nmodes=nmodes) + do m = 1, nmodes + call rad_cnst_get_mode_props(ilist, m, ncoef=m_ncoef, prefr=m_prefr, prefi=m_prefi) + if (m_ncoef /= ncoef .or. m_prefr /= prefr .or. m_prefi /= prefi) then + write(iulog,*) routine//': ERROR - file and module values do not match:' + write(iulog,*) ' ncoef:', ncoef, m_ncoef + write(iulog,*) ' prefr:', prefr, m_prefr + write(iulog,*) ' prefi:', prefi, m_prefi + call endrun(routine//': ERROR - file and module values do not match') + end if + end do + end if + end do + + ! Initialize physics buffer indices for dgnumwet and qaerwat. Note the implicit assumption + ! that the loops over modes in the optics calculations will use the values for dgnumwet and qaerwat + ! that are set in the aerosol_wet_intr code. + dgnumwet_idx = pbuf_get_index('DGNUMWET',errcode) + if (errcode < 0) then + call endrun(routine//' ERROR: cannot find physics buffer field DGNUMWET') + end if + qaerwat_idx = pbuf_get_index('QAERWAT',errcode) + if (errcode < 0) then + call endrun(routine//' ERROR: cannot find physics buffer field QAERWAT') + end if + + call getfil(water_refindex_file, locfile) + call read_water_refindex(locfile) + if (masterproc) write(iulog,*) "modal_aer_opt_init: read water refractive index file:", trim(locfile) + + call phys_getopts(history_amwg_out = history_amwg, & + history_aero_optics_out = history_aero_optics ) + + ! Add diagnostic fields to history output. + + call addfld ('EXTINCT', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day only', & + flag_xyfill=.true.) + call addfld ('EXTINCTUV', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day only', & + flag_xyfill=.true.) + call addfld ('EXTINCTNIR', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day only', & + flag_xyfill=.true.) + call addfld ('ABSORB', (/ 'lev' /), 'A','/m','Aerosol absorption, day only', & + flag_xyfill=.true.) + call addfld ('AODVIS', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODVISst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODUV', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODUVst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODNIR', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODNIRst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODABS', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day only', & + flag_xyfill=.true.) + call addfld ('AODxASYM', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day only',& + flag_xyfill=.true.) + call addfld ('EXTxASYM', (/ 'lev' /), 'A',' ','extinction 550 nm * asymmetry factor, day only', & + flag_xyfill=.true.) + + call addfld ('EXTINCTdn', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day night', & + flag_xyfill=.true.) + call addfld ('EXTINCTUVdn', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day night', & + flag_xyfill=.true.) + call addfld ('EXTINCTNIRdn', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day night', & + flag_xyfill=.true.) + call addfld ('ABSORBdn', (/ 'lev' /), 'A','/m','Aerosol absorption, day night', & + flag_xyfill=.true.) + call addfld ('AODVISdn', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day night', & + flag_xyfill=.true.) + call addfld ('AODVISstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day night',& + flag_xyfill=.true.) + call addfld ('AODUVdn', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day night', & + flag_xyfill=.true.) + call addfld ('AODUVstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day night',& + flag_xyfill=.true.) + call addfld ('AODNIRdn', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day night', & + flag_xyfill=.true.) + call addfld ('AODNIRstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day night',& + flag_xyfill=.true.) + call addfld ('AODABSdn', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day night', & + flag_xyfill=.true.) + call addfld ('AODxASYMdn', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day night',& + flag_xyfill=.true.) + call addfld ('EXTxASYMdn', (/ 'lev' /), 'A',' ','extinction 550 * asymmetry factor, day night', & + flag_xyfill=.true.) + + call rad_cnst_get_info(0, nmodes=nmodes) + + do m = 1, nmodes + + write(fldname,'(a,i1)') 'BURDEN', m + write(lngname,'(a,i1)') 'Aerosol burden, day only, mode ', m + call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + write(fldname,'(a,i1)') 'AODMODE', m + write(lngname,'(a,i1)') 'Aerosol optical depth, day only, 550 nm mode ', m + call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + write(fldname,'(a,i1)') 'AODDUST', m + write(lngname,'(a,i1,a)') 'Aerosol optical depth, day only, 550 nm mode ',m,' from dust' + call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + write(fldname,'(a,i1)') 'BURDENdn', m + write(lngname,'(a,i1)') 'Aerosol burden, day night, mode ', m + call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + write(fldname,'(a,i1)') 'AODdnMODE', m + write(lngname,'(a,i1)') 'Aerosol optical depth 550 nm, day night, mode ', m + call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + write(fldname,'(a,i1)') 'AODdnDUST', m + write(lngname,'(a,i1,a)') 'Aerosol optical depth 550 nm, day night, mode ',m,' from dust' + call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (m>3 .and. history_aero_optics) then + call add_default (fldname, 1, ' ') + endif + + enddo + + call addfld ('AODDUST', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day only', & + flag_xyfill=.true.) + call addfld ('AODSO4', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day only', & + flag_xyfill=.true.) + call addfld ('AODPOM', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day only', & + flag_xyfill=.true.) + call addfld ('AODSOA', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day only', & + flag_xyfill=.true.) + call addfld ('AODBC', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day only', & + flag_xyfill=.true.) + call addfld ('AODSS', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day only', & + flag_xyfill=.true.) + call addfld ('AODABSBC', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day only',& + flag_xyfill=.true.) + call addfld ('BURDENDUST', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENPOM', horiz_only, 'A','kg/m2', 'POM aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSOA', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENBC', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day only', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALT', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('SSAVIS', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day only', & + flag_xyfill=.true.) + + call addfld ('AODDUSTdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day night', & + flag_xyfill=.true.) + call addfld ('AODSO4dn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day night', & + flag_xyfill=.true.) + call addfld ('AODPOMdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day night', & + flag_xyfill=.true.) + call addfld ('AODSOAdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day night', & + flag_xyfill=.true.) + call addfld ('AODBCdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day night', & + flag_xyfill=.true.) + call addfld ('AODSSdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day night', & + flag_xyfill=.true.) + call addfld ('AODABSBCdn', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day night',& + flag_xyfill=.true.) + call addfld ('BURDENDUSTdn', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4dn', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENPOMdn', horiz_only, 'A','kg/m2', 'POM aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSOAdn', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENBCdn', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day night', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALTdn', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & + flag_xyfill=.true.) + + + if (history_amwg) then + call add_default ('AODDUST1' , 1, ' ') + call add_default ('AODDUST3' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + end if + + if (history_aero_optics) then + call add_default ('AODDUST1' , 1, ' ') + call add_default ('AODDUST3' , 1, ' ') + call add_default ('ABSORB' , 1, ' ') + call add_default ('AODMODE1' , 1, ' ') + call add_default ('AODMODE2' , 1, ' ') + call add_default ('AODMODE3' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + call add_default ('AODUV' , 1, ' ') + call add_default ('AODNIR' , 1, ' ') + call add_default ('AODABS' , 1, ' ') + call add_default ('AODABSBC' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODSO4' , 1, ' ') + call add_default ('AODPOM' , 1, ' ') + call add_default ('AODSOA' , 1, ' ') + call add_default ('AODBC' , 1, ' ') + call add_default ('AODSS' , 1, ' ') + call add_default ('BURDEN1' , 1, ' ') + call add_default ('BURDEN2' , 1, ' ') + call add_default ('BURDEN3' , 1, ' ') + call add_default ('BURDENDUST' , 1, ' ') + call add_default ('BURDENSO4' , 1, ' ') + call add_default ('BURDENPOM' , 1, ' ') + call add_default ('BURDENSOA' , 1, ' ') + call add_default ('BURDENBC' , 1, ' ') + call add_default ('BURDENSEASALT', 1, ' ') + call add_default ('SSAVIS' , 1, ' ') + call add_default ('EXTINCT' , 1, ' ') + call add_default ('AODxASYM' , 1, ' ') + call add_default ('EXTxASYM' , 1, ' ') + + call add_default ('AODdnDUST1' , 1, ' ') + call add_default ('AODdnDUST3' , 1, ' ') + call add_default ('ABSORBdn' , 1, ' ') + call add_default ('AODdnMODE1' , 1, ' ') + call add_default ('AODdnMODE2' , 1, ' ') + call add_default ('AODdnMODE3' , 1, ' ') + call add_default ('AODVISdn' , 1, ' ') + call add_default ('AODUVdn' , 1, ' ') + call add_default ('AODNIRdn' , 1, ' ') + call add_default ('AODABSdn' , 1, ' ') + call add_default ('AODABSBCdn' , 1, ' ') + call add_default ('AODDUSTdn' , 1, ' ') + call add_default ('AODSO4dn' , 1, ' ') + call add_default ('AODPOMdn' , 1, ' ') + call add_default ('AODSOAdn' , 1, ' ') + call add_default ('AODBCdn' , 1, ' ') + call add_default ('AODSSdn' , 1, ' ') + call add_default ('BURDENdn1' , 1, ' ') + call add_default ('BURDENdn2' , 1, ' ') + call add_default ('BURDENdn3' , 1, ' ') + call add_default ('BURDENDUSTdn' , 1, ' ') + call add_default ('BURDENSO4dn' , 1, ' ') + call add_default ('BURDENPOMdn' , 1, ' ') + call add_default ('BURDENSOAdn' , 1, ' ') + call add_default ('BURDENBCdn' , 1, ' ') + call add_default ('BURDENSEASALTdn', 1, ' ') + call add_default ('SSAVISdn' , 1, ' ') + call add_default ('EXTINCTdn' , 1, ' ') + call add_default ('AODxASYMdn' , 1, ' ') + call add_default ('EXTxASYMdn' , 1, ' ') + end if + + do ilist = 1, n_diag + if (call_list(ilist)) then + + call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m', & + 'Aerosol extinction', flag_xyfill=.true.) + call addfld ('ABSORB'//diag(ilist), (/ 'lev' /), 'A','/m', & + 'Aerosol absorption', flag_xyfill=.true.) + call addfld ('AODVIS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 nm', flag_xyfill=.true.) + call addfld ('AODVISst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 550 nm', flag_xyfill=.true.) + call addfld ('AODABS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol absorption optical depth 550 nm', flag_xyfill=.true.) + + call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 550 nm, day night', flag_xyfill=.true.) + call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol absorption, day night', flag_xyfill=.true.) + call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ',& + 'Aerosol optical depth 550 nm, day night', flag_xyfill=.true.) + call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ',& + 'Stratospheric aerosol optical depth 550 nm, day night', flag_xyfill=.true.) + call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ',& + 'Aerosol absorption optical depth 550 nm, day night', flag_xyfill=.true.) + call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ',& + 'extinction 550 * asymmetry factor, day night', flag_xyfill=.true.) + call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ',& + 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) + + if (history_aero_optics) then + call add_default ('EXTINCT'//diag(ilist), 1, ' ') + call add_default ('ABSORB'//diag(ilist), 1, ' ') + call add_default ('AODVIS'//diag(ilist), 1, ' ') + call add_default ('AODVISst'//diag(ilist), 1, ' ') + call add_default ('AODABS'//diag(ilist), 1, ' ') + end if + + end if + end do + +end subroutine modal_aer_opt_init + +!=============================================================================== + +subroutine modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & + tauxar, wa, ga, fa) + + ! calculates aerosol sw radiative properties + + use tropopause, only : tropopause_findChemTrop + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(nnite) ! local column indices of night columns + + real(r8), intent(out) :: tauxar(pcols,0:pver,nswbands) ! layer extinction optical depth + real(r8), intent(out) :: wa(pcols,0:pver,nswbands) ! layer single-scatter albedo + real(r8), intent(out) :: ga(pcols,0:pver,nswbands) ! asymmetry factor + real(r8), intent(out) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction + + ! Local variables + integer :: i, ifld, isw, k, l, m, nc, ns + integer :: lchnk ! chunk id + integer :: ncol ! number of active columns in the chunk + integer :: nmodes + integer :: nspec + integer :: troplevchem(pcols) ! Chemical tropopause level + integer :: istat + + real(r8) :: mass(pcols,pver) ! layer mass + real(r8) :: air_density(pcols,pver) ! (kg/m3) + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + real(r8) :: specdens ! species density (kg/m3) + complex(r8), pointer :: specrefindex(:) ! species refractive index + character*32 :: spectype ! species type + real(r8) :: hygro_aer ! + + real(r8), pointer :: dgnumwet(:,:) ! number mode wet diameter + real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) + + real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + real(r8), pointer :: wetdens_m(:,:,:) ! + real(r8), pointer :: hygro_m(:,:,:) ! + real(r8), pointer :: dryvol_m(:,:,:) ! + real(r8), pointer :: dryrad_m(:,:,:) ! + real(r8), pointer :: drymass_m(:,:,:) ! + real(r8), pointer :: so4dryvol_m(:,:,:) ! + real(r8), pointer :: naer_m(:,:,:) ! + + real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution + real(r8) :: radsurf(pcols,pver) ! aerosol surface mode radius + real(r8) :: logradsurf(pcols,pver) ! log(aerosol surface mode radius) + real(r8) :: cheb(ncoef,pcols,pver) + + real(r8) :: refr(pcols) ! real part of refractive index + real(r8) :: refi(pcols) ! imaginary part of refractive index + complex(r8) :: crefin(pcols) ! complex refractive index + real(r8), pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols + real(r8), pointer :: refitabsw(:,:) ! table of imag refractive indices for aerosols + real(r8), pointer :: extpsw(:,:,:,:) ! specific extinction + real(r8), pointer :: abspsw(:,:,:,:) ! specific absorption + real(r8), pointer :: asmpsw(:,:,:,:) ! asymmetry factor + + real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) + real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) + real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) + + integer :: itab(pcols), jtab(pcols) + real(r8) :: ttab(pcols), utab(pcols) + real(r8) :: cext(pcols,ncoef), cabs(pcols,ncoef), casm(pcols,ncoef) + real(r8) :: pext(pcols) ! parameterized specific extinction (m2/kg) + real(r8) :: specpext(pcols) ! specific extinction (m2/kg) + real(r8) :: dopaer(pcols) ! aerosol optical depth in layer + real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) + real(r8) :: pasm(pcols) ! parameterized asymmetry factor + real(r8) :: palb(pcols) ! parameterized single scattering albedo + + ! Diagnostics + real(r8) :: extinct(pcols,pver) + real(r8) :: extinctnir(pcols,pver) + real(r8) :: extinctuv(pcols,pver) + real(r8) :: absorb(pcols,pver) + real(r8) :: aodvis(pcols) ! extinction optical depth + real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth + real(r8) :: aodabs(pcols) ! absorption optical depth + real(r8) :: asymvis(pcols) ! asymmetry factor * optical depth + real(r8) :: asymext(pcols,pver) ! asymmetry factor * extinction + + real(r8) :: aodabsbc(pcols) ! absorption optical depth of BC + + real(r8) :: ssavis(pcols) + real(r8) :: dustvol(pcols) ! volume concentration of dust in aerosol mode (m3/kg) + + real(r8) :: burden(pcols) + real(r8) :: burdendust(pcols), burdenso4(pcols), burdenbc(pcols), & + burdenpom(pcols), burdensoa(pcols), burdenseasalt(pcols) + + real(r8) :: aodmode(pcols) + real(r8) :: dustaodmode(pcols) ! dust aod in aerosol mode + + real(r8) :: specrefr, specrefi + real(r8) :: scatdust(pcols), scatso4(pcols), scatbc(pcols), & + scatpom(pcols), scatsoa(pcols), scatseasalt(pcols) + real(r8) :: absdust(pcols), absso4(pcols), absbc(pcols), & + abspom(pcols), abssoa(pcols), absseasalt(pcols) + real(r8) :: hygrodust(pcols), hygroso4(pcols), hygrobc(pcols), & + hygropom(pcols), hygrosoa(pcols), hygroseasalt(pcols) + + real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro + real(r8) :: aodc ! aod of component + + ! total species AOD + real(r8) :: dustaod(pcols), so4aod(pcols), bcaod(pcols), & + pomaod(pcols), soaaod(pcols), seasaltaod(pcols) + + + + + logical :: savaervis ! true if visible wavelength (0.55 micron) + logical :: savaernir ! true if near ir wavelength (~0.88 micron) + logical :: savaeruv ! true if uv wavelength (~0.35 micron) + + real(r8) :: aoduv(pcols) ! extinction optical depth in uv + real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv + real(r8) :: aodnir(pcols) ! extinction optical depth in nir + real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir + + + character(len=32) :: outname + + ! debug output + integer, parameter :: nerrmax_dopaer=1000 + integer :: nerr_dopaer = 0 + real(r8) :: volf ! volume fraction of insoluble aerosol + character(len=*), parameter :: subname = 'modal_aero_sw' + !---------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! initialize output variables + tauxar(:ncol,:,:) = 0._r8 + wa(:ncol,:,:) = 0._r8 + ga(:ncol,:,:) = 0._r8 + fa(:ncol,:,:) = 0._r8 + + ! zero'th layer does not contain aerosol + tauxar(1:ncol,0,:) = 0._r8 + wa(1:ncol,0,:) = 0.925_r8 + ga(1:ncol,0,:) = 0.850_r8 + fa(1:ncol,0,:) = 0.7225_r8 + + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + + ! diagnostics for visible band summed over modes + extinct(1:ncol,:) = 0.0_r8 + absorb(1:ncol,:) = 0.0_r8 + aodvis(1:ncol) = 0.0_r8 + aodvisst(1:ncol) = 0.0_r8 + aodabs(1:ncol) = 0.0_r8 + burdendust(:ncol) = 0.0_r8 + burdenso4(:ncol) = 0.0_r8 + burdenpom(:ncol) = 0.0_r8 + burdensoa(:ncol) = 0.0_r8 + burdenbc(:ncol) = 0.0_r8 + burdenseasalt(:ncol) = 0.0_r8 + ssavis(1:ncol) = 0.0_r8 + asymvis(1:ncol) = 0.0_r8 + asymext(1:ncol,:) = 0.0_r8 + + aodabsbc(:ncol) = 0.0_r8 + dustaod(:ncol) = 0.0_r8 + so4aod(:ncol) = 0.0_r8 + pomaod(:ncol) = 0.0_r8 + soaaod(:ncol) = 0.0_r8 + bcaod(:ncol) = 0.0_r8 + seasaltaod(:ncol) = 0.0_r8 + + ! diags for other bands + extinctuv(1:ncol,:) = 0.0_r8 + extinctnir(1:ncol,:) = 0.0_r8 + aoduv(:ncol) = 0.0_r8 + aodnir(:ncol) = 0.0_r8 + aoduvst(:ncol) = 0.0_r8 + aodnirst(:ncol) = 0.0_r8 + call tropopause_findChemTrop(state, troplevchem) + + ! loop over all aerosol modes + call rad_cnst_get_info(list_idx, nmodes=nmodes) + + if (list_idx == 0) then + ! water uptake and wet radius for the climate list has already been calculated + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) + else + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & + qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & + hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & + dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & + so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) + if (istat > 0) then + call endrun('modal_aero_sw: allocation FAILURE: arrays for diagnostic calcs') + end if + call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & + dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & + drymass_m, so4dryvol_m, naer_m) + endif + + do m = 1, nmodes + + ! diagnostics for visible band for each mode + burden(:ncol) = 0._r8 + aodmode(1:ncol) = 0.0_r8 + dustaodmode(1:ncol) = 0.0_r8 + + dgnumwet => dgnumwet_m(:,:,m) + qaerwat => qaerwat_m(:,:,m) + + ! get mode properties + call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtabsw=refrtabsw , & + refitabsw=refitabsw, extpsw=extpsw, abspsw=abspsw, asmpsw=asmpsw) + + ! get mode info + call rad_cnst_get_info(list_idx, m, nspec=nspec) + + ! calc size parameter for all columns + call modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) + + do isw = 1, nswbands + savaervis = (isw .eq. idx_sw_diag) + savaeruv = (isw .eq. idx_uv_diag) + savaernir = (isw .eq. idx_nir_diag) + + do k = top_lev, pver + + ! form bulk refractive index + crefin(:ncol) = (0._r8, 0._r8) + dryvol(:ncol) = 0._r8 + dustvol(:ncol) = 0._r8 + + scatdust(:ncol) = 0._r8 + absdust(:ncol) = 0._r8 + hygrodust(:ncol) = 0._r8 + scatso4(:ncol) = 0._r8 + absso4(:ncol) = 0._r8 + hygroso4(:ncol) = 0._r8 + scatbc(:ncol) = 0._r8 + absbc(:ncol) = 0._r8 + hygrobc(:ncol) = 0._r8 + scatpom(:ncol) = 0._r8 + abspom(:ncol) = 0._r8 + hygropom(:ncol) = 0._r8 + scatsoa(:ncol) = 0._r8 + abssoa(:ncol) = 0._r8 + hygrosoa(:ncol) = 0._r8 + scatseasalt(:ncol) = 0._r8 + absseasalt(:ncol) = 0._r8 + hygroseasalt(:ncol) = 0._r8 + + ! aerosol species loop + do l = 1, nspec + call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + refindex_aer_sw=specrefindex, spectype=spectype, & + hygro_aer=hygro_aer) + + do i = 1, ncol + vol(i) = specmmr(i,k)/specdens + dryvol(i) = dryvol(i) + vol(i) + crefin(i) = crefin(i) + vol(i)*specrefindex(isw) + end do + + ! compute some diagnostics for visible band only + if (savaervis) then + + specrefr = real(specrefindex(isw)) + specrefi = aimag(specrefindex(isw)) + + do i = 1, ncol + burden(i) = burden(i) + specmmr(i,k)*mass(i,k) + end do + + if (trim(spectype) == 'dust') then + do i = 1, ncol + burdendust(i) = burdendust(i) + specmmr(i,k)*mass(i,k) + dustvol(i) = vol(i) + scatdust(i) = vol(i)*specrefr + absdust(i) = -vol(i)*specrefi + hygrodust(i) = vol(i)*hygro_aer + end do + end if + + if (trim(spectype) == 'sulfate') then + do i = 1, ncol + burdenso4(i) = burdenso4(i) + specmmr(i,k)*mass(i,k) + scatso4(i) = vol(i)*specrefr + absso4(i) = -vol(i)*specrefi + hygroso4(i) = vol(i)*hygro_aer + end do + end if + if (trim(spectype) == 'black-c') then + do i = 1, ncol + burdenbc(i) = burdenbc(i) + specmmr(i,k)*mass(i,k) + scatbc(i) = vol(i)*specrefr + absbc(i) = -vol(i)*specrefi + hygrobc(i) = vol(i)*hygro_aer + end do + end if + if (trim(spectype) == 'p-organic') then + do i = 1, ncol + burdenpom(i) = burdenpom(i) + specmmr(i,k)*mass(i,k) + scatpom(i) = vol(i)*specrefr + abspom(i) = -vol(i)*specrefi + hygropom(i) = vol(i)*hygro_aer + end do + end if + if (trim(spectype) == 's-organic') then + do i = 1, ncol + burdensoa(i) = burdensoa(i) + specmmr(i,k)*mass(i,k) + scatsoa(i) = vol(i)*specrefr + abssoa(i) = -vol(i)*specrefi + hygrosoa(i) = vol(i)*hygro_aer + end do + end if + if (trim(spectype) == 'seasalt') then + do i = 1, ncol + burdenseasalt(i) = burdenseasalt(i) + specmmr(i,k)*mass(i,k) + scatseasalt(i) = vol(i)*specrefr + absseasalt(i) = -vol(i)*specrefi + hygroseasalt(i) = vol(i)*hygro_aer + end do + end if + + end if + end do ! species loop + + do i = 1, ncol + watervol(i) = qaerwat(i,k)/rhoh2o + wetvol(i) = watervol(i) + dryvol(i) + if (watervol(i) < 0._r8) then + if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then + write(iulog,'(a,2e10.2,a)') 'watervol,wetvol=', & + watervol(i), wetvol(i), ' in '//subname + end if + watervol(i) = 0._r8 + wetvol(i) = dryvol(i) + end if + + ! volume mixing + crefin(i) = crefin(i) + watervol(i)*crefwsw(isw) + crefin(i) = crefin(i)/max(wetvol(i),1.e-60_r8) + refr(i) = real(crefin(i)) + refi(i) = abs(aimag(crefin(i))) + end do + + ! call t_startf('binterp') + + ! interpolate coefficients linear in refractive index + ! first call calcs itab,jtab,ttab,utab + itab(:ncol) = 0 + call binterp(extpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & + refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & + itab, jtab, ttab, utab, cext) + call binterp(abspsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & + refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & + itab, jtab, ttab, utab, cabs) + call binterp(asmpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & + refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & + itab, jtab, ttab, utab, casm) + + ! call t_stopf('binterp') + + ! parameterized optical properties + do i=1,ncol + + if (logradsurf(i,k) .le. xrmax) then + pext(i) = 0.5_r8*cext(i,1) + do nc = 2, ncoef + pext(i) = pext(i) + cheb(nc,i,k)*cext(i,nc) + enddo + pext(i) = exp(pext(i)) + else + pext(i) = 1.5_r8/(radsurf(i,k)*rhoh2o) ! geometric optics + endif + + ! convert from m2/kg water to m2/kg aerosol + specpext(i) = pext(i) + pext(i) = pext(i)*wetvol(i)*rhoh2o + pabs(i) = 0.5_r8*cabs(i,1) + pasm(i) = 0.5_r8*casm(i,1) + do nc = 2, ncoef + pabs(i) = pabs(i) + cheb(nc,i,k)*cabs(i,nc) + pasm(i) = pasm(i) + cheb(nc,i,k)*casm(i,nc) + enddo + pabs(i) = pabs(i)*wetvol(i)*rhoh2o + pabs(i) = max(0._r8,pabs(i)) + pabs(i) = min(pext(i),pabs(i)) + + palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) + palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) + + dopaer(i) = pext(i)*mass(i,k) + end do + + if (savaeruv) then + do i = 1, ncol + extinctuv(i,k) = extinctuv(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) + aoduv(i) = aoduv(i) + dopaer(i) + if (k.le.troplevchem(i)) then + aoduvst(i) = aoduvst(i) + dopaer(i) + end if + end do + end if + + if (savaernir) then + do i = 1, ncol + extinctnir(i,k) = extinctnir(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) + aodnir(i) = aodnir(i) + dopaer(i) + if (k.le.troplevchem(i)) then + aodnirst(i) = aodnirst(i) + dopaer(i) + end if + end do + endif + + ! Save aerosol optical depth at longest visible wavelength + ! sum over layers + if (savaervis) then + ! aerosol extinction (/m) + do i = 1, ncol + extinct(i,k) = extinct(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) + absorb(i,k) = absorb(i,k) + pabs(i)*air_density(i,k) + aodvis(i) = aodvis(i) + dopaer(i) + aodabs(i) = aodabs(i) + pabs(i)*mass(i,k) + aodmode(i) = aodmode(i) + dopaer(i) + ssavis(i) = ssavis(i) + dopaer(i)*palb(i) + asymvis(i) = asymvis(i) + dopaer(i)*pasm(i) + asymext(i,k) = asymext(i,k) + dopaer(i)*pasm(i)*air_density(i,k)/mass(i,k) + if (k.le.troplevchem(i)) then + aodvisst(i) = aodvisst(i) + dopaer(i) + end if + + if (wetvol(i) > 1.e-40_r8) then + + dustaodmode(i) = dustaodmode(i) + dopaer(i)*dustvol(i)/wetvol(i) + + ! partition optical depth into contributions from each constituent + ! assume contribution is proportional to refractive index X volume + + scath2o = watervol(i)*real(crefwsw(isw)) + absh2o = -watervol(i)*aimag(crefwsw(isw)) + sumscat = scatso4(i) + scatpom(i) + scatsoa(i) + scatbc(i) + & + scatdust(i) + scatseasalt(i) + scath2o + sumabs = absso4(i) + abspom(i) + abssoa(i) + absbc(i) + & + absdust(i) + absseasalt(i) + absh2o + sumhygro = hygroso4(i) + hygropom(i) + hygrosoa(i) + hygrobc(i) + & + hygrodust(i) + hygroseasalt(i) + + scatdust(i) = (scatdust(i) + scath2o*hygrodust(i)/sumhygro)/sumscat + absdust(i) = (absdust(i) + absh2o*hygrodust(i)/sumhygro)/sumabs + + scatso4(i) = (scatso4(i) + scath2o*hygroso4(i)/sumhygro)/sumscat + absso4(i) = (absso4(i) + absh2o*hygroso4(i)/sumhygro)/sumabs + + scatpom(i) = (scatpom(i) + scath2o*hygropom(i)/sumhygro)/sumscat + abspom(i) = (abspom(i) + absh2o*hygropom(i)/sumhygro)/sumabs + + scatsoa(i) = (scatsoa(i) + scath2o*hygrosoa(i)/sumhygro)/sumscat + abssoa(i) = (abssoa(i) + absh2o*hygrosoa(i)/sumhygro)/sumabs + + scatbc(i) = (scatbc(i) + scath2o*hygrobc(i)/sumhygro)/sumscat + absbc(i) = (absbc(i) + absh2o*hygrobc(i)/sumhygro)/sumabs + + scatseasalt(i) = (scatseasalt(i) + scath2o*hygroseasalt(i)/sumhygro)/sumscat + absseasalt(i) = (absseasalt(i) + absh2o*hygroseasalt(i)/sumhygro)/sumabs + + aodabsbc(i) = aodabsbc(i) + absbc(i)*dopaer(i)*(1.0_r8-palb(i)) + + aodc = (absdust(i)*(1.0_r8 - palb(i)) + palb(i)*scatdust(i))*dopaer(i) + dustaod(i) = dustaod(i) + aodc + + aodc = (absso4(i)*(1.0_r8 - palb(i)) + palb(i)*scatso4(i))*dopaer(i) + so4aod(i) = so4aod(i) + aodc + + aodc = (abspom(i)*(1.0_r8 - palb(i)) + palb(i)*scatpom(i))*dopaer(i) + pomaod(i) = pomaod(i) + aodc + + aodc = (abssoa(i)*(1.0_r8 - palb(i)) + palb(i)*scatsoa(i))*dopaer(i) + soaaod(i) = soaaod(i) + aodc + + aodc = (absbc(i)*(1.0_r8 - palb(i)) + palb(i)*scatbc(i))*dopaer(i) + bcaod(i) = bcaod(i) + aodc + + aodc = (absseasalt(i)*(1.0_r8 - palb(i)) + palb(i)*scatseasalt(i))*dopaer(i) + seasaltaod(i) = seasaltaod(i) + aodc + + endif + + end do + endif + + do i = 1, ncol + + if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 30._r8)) then + + if (dopaer(i) <= -1.e-10_r8) then + write(iulog,*) "ERROR: Negative aerosol optical depth & + &in this layer." + else + write(iulog,*) "WARNING: Aerosol optical depth is & + &unreasonably high in this layer." + end if + + write(iulog,*) 'dopaer(', i, ',', k, ',', m, ',', lchnk, ')=', dopaer(i) + ! write(iulog,*) 'itab,jtab,ttab,utab=',itab(i),jtab(i),ttab(i),utab(i) + write(iulog,*) 'k=', k, ' pext=', pext(i), ' specext=', specpext(i) + write(iulog,*) 'wetvol=', wetvol(i), ' dryvol=', dryvol(i), ' watervol=', watervol(i) + ! write(iulog,*) 'cext=',(cext(i,l),l=1,ncoef) + ! write(iulog,*) 'crefin=',crefin(i) + write(iulog,*) 'nspec=', nspec + ! write(iulog,*) 'cheb=', (cheb(nc,m,i,k),nc=2,ncoef) + do l = 1, nspec + call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + refindex_aer_sw=specrefindex) + volf = specmmr(i,k)/specdens + write(iulog,*) 'l=', l, 'vol(l)=', volf + write(iulog,*) 'isw=', isw, 'specrefindex(isw)=', specrefindex(isw) + write(iulog,*) 'specdens=', specdens + end do + + nerr_dopaer = nerr_dopaer + 1 +! if (nerr_dopaer >= nerrmax_dopaer) then + if (dopaer(i) < -1.e-10_r8) then + write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer + call endrun('exit from '//subname) + end if + + end if + end do + + do i=1,ncol + tauxar(i,k,isw) = tauxar(i,k,isw) + dopaer(i) + wa(i,k,isw) = wa(i,k,isw) + dopaer(i)*palb(i) + ga(i,k,isw) = ga(i,k,isw) + dopaer(i)*palb(i)*pasm(i) + fa(i,k,isw) = fa(i,k,isw) + dopaer(i)*palb(i)*pasm(i)*pasm(i) + end do + + end do ! pver + + end do ! sw bands + + ! mode diagnostics + ! The diagnostics are currently only output for the climate list. Code mods will + ! be necessary to provide output for the rad_diag lists. + if (list_idx == 0) then + + write(outname,'(a,i1)') 'BURDENdn', m + call outfld(trim(outname), burden, pcols, lchnk) + + write(outname,'(a,i1)') 'AODdnMODE', m + call outfld(trim(outname), aodmode, pcols, lchnk) + + write(outname,'(a,i1)') 'AODdnDUST', m + call outfld(trim(outname), dustaodmode, pcols, lchnk) + + do i = 1, nnite + burden(idxnite(i)) = fillvalue + aodmode(idxnite(i)) = fillvalue + dustaodmode(idxnite(i)) = fillvalue + end do + + write(outname,'(a,i1)') 'BURDEN', m + call outfld(trim(outname), burden, pcols, lchnk) + + write(outname,'(a,i1)') 'AODMODE', m + call outfld(trim(outname), aodmode, pcols, lchnk) + + write(outname,'(a,i1)') 'AODDUST', m + call outfld(trim(outname), dustaodmode, pcols, lchnk) + + end if + + end do ! nmodes + + if (list_idx > 0) then + deallocate(dgnumdry_m) + deallocate(dgnumwet_m) + deallocate(qaerwat_m) + deallocate(wetdens_m) + deallocate(hygro_m) + deallocate(dryvol_m) + deallocate(dryrad_m) + deallocate(drymass_m) + deallocate(so4dryvol_m) + deallocate(naer_m) + end if + + ! Output visible band diagnostics for quantities summed over the modes + ! These fields are put out for diagnostic lists as well as the climate list. + + call outfld('EXTINCTdn'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORBdn'//diag(list_idx), absorb, pcols, lchnk) + call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODVISstdn'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('EXTxASYMdn'//diag(list_idx), asymext, pcols, lchnk) + + do i = 1, nnite + extinct(idxnite(i),:) = fillvalue + absorb(idxnite(i),:) = fillvalue + aodvis(idxnite(i)) = fillvalue + aodabs(idxnite(i)) = fillvalue + aodvisst(idxnite(i)) = fillvalue + asymext(idxnite(i),:) = fillvalue + end do + + call outfld('EXTINCT'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORB'//diag(list_idx), absorb, pcols, lchnk) + call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODVISst'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('EXTxASYM'//diag(list_idx), asymext, pcols, lchnk) + + ! These diagnostics are output only for climate list + if (list_idx == 0) then + do i = 1, ncol + if (aodvis(i) > 1.e-10_r8) then + ssavis(i) = ssavis(i)/aodvis(i) + else + ssavis(i) = 0.925_r8 + endif + end do + + call outfld('SSAVISdn', ssavis, pcols, lchnk) + call outfld('AODxASYMdn', asymvis, pcols, lchnk) + + call outfld('EXTINCTUVdn', extinctuv, pcols, lchnk) + call outfld('EXTINCTNIRdn', extinctnir, pcols, lchnk) + call outfld('AODUVdn', aoduv, pcols, lchnk) + call outfld('AODNIRdn', aodnir, pcols, lchnk) + call outfld('AODUVstdn', aoduvst, pcols, lchnk) + call outfld('AODNIRstdn', aodnirst, pcols, lchnk) + + call outfld('BURDENDUSTdn', burdendust, pcols, lchnk) + call outfld('BURDENSO4dn' , burdenso4, pcols, lchnk) + call outfld('BURDENPOMdn' , burdenpom, pcols, lchnk) + call outfld('BURDENSOAdn' , burdensoa, pcols, lchnk) + call outfld('BURDENBCdn' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALTdn', burdenseasalt, pcols, lchnk) + + call outfld('AODABSBCdn', aodabsbc, pcols, lchnk) + + call outfld('AODDUSTdn', dustaod, pcols, lchnk) + call outfld('AODSO4dn', so4aod, pcols, lchnk) + call outfld('AODPOMdn', pomaod, pcols, lchnk) + call outfld('AODSOAdn', soaaod, pcols, lchnk) + call outfld('AODBCdn', bcaod, pcols, lchnk) + call outfld('AODSSdn', seasaltaod, pcols, lchnk) + + + do i = 1, nnite + ssavis(idxnite(i)) = fillvalue + asymvis(idxnite(i)) = fillvalue + + aoduv(idxnite(i)) = fillvalue + aodnir(idxnite(i)) = fillvalue + aoduvst(idxnite(i)) = fillvalue + aodnirst(idxnite(i)) = fillvalue + extinctuv(idxnite(i),:) = fillvalue + extinctnir(idxnite(i),:) = fillvalue + + burdendust(idxnite(i)) = fillvalue + burdenso4(idxnite(i)) = fillvalue + burdenpom(idxnite(i)) = fillvalue + burdensoa(idxnite(i)) = fillvalue + burdenbc(idxnite(i)) = fillvalue + burdenseasalt(idxnite(i)) = fillvalue + + aodabsbc(idxnite(i)) = fillvalue + + dustaod(idxnite(i)) = fillvalue + so4aod(idxnite(i)) = fillvalue + pomaod(idxnite(i)) = fillvalue + soaaod(idxnite(i)) = fillvalue + bcaod(idxnite(i)) = fillvalue + seasaltaod(idxnite(i)) = fillvalue + end do + + call outfld('SSAVIS', ssavis, pcols, lchnk) + call outfld('AODxASYM', asymvis, pcols, lchnk) + + call outfld('EXTINCTUV', extinctuv, pcols, lchnk) + call outfld('EXTINCTNIR', extinctnir, pcols, lchnk) + call outfld('AODUV', aoduv, pcols, lchnk) + call outfld('AODNIR', aodnir, pcols, lchnk) + call outfld('AODUVst', aoduvst, pcols, lchnk) + call outfld('AODNIRst', aodnirst, pcols, lchnk) + + call outfld('BURDENDUST', burdendust, pcols, lchnk) + call outfld('BURDENSO4' , burdenso4, pcols, lchnk) + call outfld('BURDENPOM' , burdenpom, pcols, lchnk) + call outfld('BURDENSOA' , burdensoa, pcols, lchnk) + call outfld('BURDENBC' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) + + call outfld('AODABSBC', aodabsbc, pcols, lchnk) + + call outfld('AODDUST', dustaod, pcols, lchnk) + call outfld('AODSO4', so4aod, pcols, lchnk) + call outfld('AODPOM', pomaod, pcols, lchnk) + call outfld('AODSOA', soaaod, pcols, lchnk) + call outfld('AODBC', bcaod, pcols, lchnk) + call outfld('AODSS', seasaltaod, pcols, lchnk) + end if + +end subroutine modal_aero_sw + +!=============================================================================== + +subroutine modal_aero_lw(list_idx, state, pbuf, tauxar) + + ! calculates aerosol lw radiative properties + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(out) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth + + ! Local variables + integer :: i, ifld, ilw, k, l, m, nc, ns + integer :: lchnk ! chunk id + integer :: ncol ! number of active columns in the chunk + integer :: nmodes + integer :: nspec + integer :: istat + + real(r8), pointer :: dgnumwet(:,:) ! wet number mode diameter (m) + real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) + + real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + real(r8), pointer :: wetdens_m(:,:,:) ! + real(r8), pointer :: hygro_m(:,:,:) ! + real(r8), pointer :: dryvol_m(:,:,:) ! + real(r8), pointer :: dryrad_m(:,:,:) ! + real(r8), pointer :: drymass_m(:,:,:) ! + real(r8), pointer :: so4dryvol_m(:,:,:) ! + real(r8), pointer :: naer_m(:,:,:) ! + + real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution + real(r8) :: alnsg_amode ! log of geometric standard deviation of number distribution + real(r8) :: xrad(pcols) + real(r8) :: cheby(ncoef,pcols,pver) ! chebychef polynomials + + real(r8) :: mass(pcols,pver) ! layer mass + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + real(r8) :: specdens ! species density (kg/m3) + complex(r8), pointer :: specrefindex(:) ! species refractive index + + real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) + real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) + real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) + real(r8) :: refr(pcols) ! real part of refractive index + real(r8) :: refi(pcols) ! imaginary part of refractive index + complex(r8) :: crefin(pcols) ! complex refractive index + real(r8), pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols + real(r8), pointer :: refitablw(:,:) ! table of imag refractive indices for aerosols + real(r8), pointer :: absplw(:,:,:,:) ! specific absorption + + integer :: itab(pcols), jtab(pcols) + real(r8) :: ttab(pcols), utab(pcols) + real(r8) :: cabs(pcols,ncoef) + real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) + real(r8) :: dopaer(pcols) ! aerosol optical depth in layer + + integer, parameter :: nerrmax_dopaer=1000 + integer :: nerr_dopaer = 0 + real(r8) :: volf ! volume fraction of insoluble aerosol + + character(len=*), parameter :: subname = 'modal_aero_lw' + !---------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! initialize output variables + tauxar(:ncol,:,:) = 0._r8 + + ! dry mass in each cell + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + + ! loop over all aerosol modes + call rad_cnst_get_info(list_idx, nmodes=nmodes) + + if (list_idx == 0) then + ! water uptake and wet radius for the climate list has already been calculated + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) + else + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & + qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & + hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & + dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & + so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) + + if (istat > 0) then + call endrun('modal_aero_lw: allocation FAILURE: arrays for diagnostic calcs') + end if + call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & + dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & + drymass_m, so4dryvol_m, naer_m) + endif + + do m = 1, nmodes + + dgnumwet => dgnumwet_m(:,:,m) + qaerwat => qaerwat_m(:,:,m) + + ! get mode properties + call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtablw=refrtablw , & + refitablw=refitablw, absplw=absplw) + + ! get mode info + call rad_cnst_get_info(list_idx, m, nspec=nspec) + + ! calc size parameter for all columns + ! this is the same calculation that's done in modal_size_parameters, but there + ! some intermediate results are saved and the chebyshev polynomials are stored + ! in a array with different index order. Could be unified. + do k = top_lev, pver + do i = 1, ncol + alnsg_amode = log( sigma_logr_aer ) + ! convert from number diameter to surface area + xrad(i) = log(0.5_r8*dgnumwet(i,k)) + 2.0_r8*alnsg_amode*alnsg_amode + ! normalize size parameter + xrad(i) = max(xrad(i), xrmin) + xrad(i) = min(xrad(i), xrmax) + xrad(i) = (2*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) + ! chebyshev polynomials + cheby(1,i,k) = 1.0_r8 + cheby(2,i,k) = xrad(i) + do nc = 3, ncoef + cheby(nc,i,k) = 2.0_r8*xrad(i)*cheby(nc-1,i,k)-cheby(nc-2,i,k) + end do + end do + end do + + do ilw = 1, nlwbands + + do k = top_lev, pver + + ! form bulk refractive index. Use volume mixing for infrared + crefin(:ncol) = (0._r8, 0._r8) + dryvol(:ncol) = 0._r8 + + ! aerosol species loop + do l = 1, nspec + call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + refindex_aer_lw=specrefindex) + + do i = 1, ncol + vol(i) = specmmr(i,k)/specdens + dryvol(i) = dryvol(i) + vol(i) + crefin(i) = crefin(i) + vol(i)*specrefindex(ilw) + end do + end do + + do i = 1, ncol + watervol(i) = qaerwat(i,k)/rhoh2o + wetvol(i) = watervol(i) + dryvol(i) + if (watervol(i) < 0.0_r8) then + if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then + write(iulog,*) 'watervol,wetvol,dryvol=',watervol(i),wetvol(i),dryvol(i),' in '//subname + end if + watervol(i) = 0._r8 + wetvol(i) = dryvol(i) + end if + + crefin(i) = crefin(i) + watervol(i)*crefwlw(ilw) + if (wetvol(i) > 1.e-40_r8) crefin(i) = crefin(i)/wetvol(i) + refr(i) = real(crefin(i)) + refi(i) = aimag(crefin(i)) + end do + + ! interpolate coefficients linear in refractive index + ! first call calcs itab,jtab,ttab,utab + itab(:ncol) = 0 + call binterp(absplw(:,:,:,ilw), ncol, ncoef, prefr, prefi, & + refr, refi, refrtablw(:,ilw), refitablw(:,ilw), & + itab, jtab, ttab, utab, cabs) + + ! parameterized optical properties + do i = 1, ncol + pabs(i) = 0.5_r8*cabs(i,1) + do nc = 2, ncoef + pabs(i) = pabs(i) + cheby(nc,i,k)*cabs(i,nc) + end do + pabs(i) = pabs(i)*wetvol(i)*rhoh2o + pabs(i) = max(0._r8,pabs(i)) + dopaer(i) = pabs(i)*mass(i,k) + end do + + do i = 1, ncol + + if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 20._r8)) then + + if (dopaer(i) <= -1.e-10_r8) then + write(iulog,*) "ERROR: Negative aerosol optical depth & + &in this layer." + else + write(iulog,*) "WARNING: Aerosol optical depth is & + &unreasonably high in this layer." + end if + + write(iulog,*) 'dopaer(',i,',',k,',',m,',',lchnk,')=', dopaer(i) + write(iulog,*) 'k=',k,' pabs=', pabs(i) + write(iulog,*) 'wetvol=',wetvol(i),' dryvol=',dryvol(i), & + ' watervol=',watervol(i) + write(iulog,*) 'cabs=', (cabs(i,l),l=1,ncoef) + write(iulog,*) 'crefin=', crefin(i) + write(iulog,*) 'nspec=', nspec + do l = 1,nspec + call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) + call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & + refindex_aer_lw=specrefindex) + volf = specmmr(i,k)/specdens + write(iulog,*) 'l=',l,'vol(l)=',volf + write(iulog,*) 'ilw=',ilw,' specrefindex(ilw)=',specrefindex(ilw) + write(iulog,*) 'specdens=',specdens + end do + + nerr_dopaer = nerr_dopaer + 1 + if (nerr_dopaer >= nerrmax_dopaer .or. dopaer(i) < -1.e-10_r8) then + write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer + call endrun() + end if + + end if + end do + + do i = 1, ncol + tauxar(i,k,ilw) = tauxar(i,k,ilw) + dopaer(i) + end do + + end do ! k = top_lev, pver + + end do ! nlwbands + + end do ! m = 1, nmodes + + if (list_idx > 0) then + deallocate(dgnumdry_m) + deallocate(dgnumwet_m) + deallocate(qaerwat_m) + deallocate(wetdens_m) + deallocate(hygro_m) + deallocate(dryvol_m) + deallocate(dryrad_m) + deallocate(drymass_m) + deallocate(so4dryvol_m) + deallocate(naer_m) + end if + +end subroutine modal_aero_lw + +!=============================================================================== +! Private routines +!=============================================================================== + +subroutine read_water_refindex(infilename) + + ! read water refractive index file and set module data + + character*(*), intent(in) :: infilename ! modal optics filename + + ! Local variables + + integer :: i, ierr + type(file_desc_t) :: ncid ! pio file handle + integer :: did ! dimension ids + integer :: dimlen ! dimension lengths + type(var_desc_t) :: vid ! variable ids + real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible + real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared + !---------------------------------------------------------------------------- + + ! open file + call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) + + ! inquire dimensions. Check that file values match parameter values. + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (dimlen .ne. nlwbands) then + write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands + call endrun('read_modal_optics: bad lw_band value') + endif + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (dimlen .ne. nswbands) then + write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands + call endrun('read_modal_optics: bad sw_band value') + endif + + ! read variables + ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) + ierr = pio_get_var(ncid, vid, refrwsw) + + ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) + ierr = pio_get_var(ncid, vid, refiwsw) + + ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) + ierr = pio_get_var(ncid, vid, refrwlw) + + ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) + ierr = pio_get_var(ncid, vid, refiwlw) + + ! set complex representation of refractive indices as module data + do i = 1, nswbands + crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)),kind=r8) + end do + do i = 1, nlwbands + crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)),kind=r8) + end do + + call pio_closefile(ncid) + +end subroutine read_water_refindex + +!=============================================================================== + +subroutine modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) + + integer, intent(in) :: ncol + real(r8), intent(in) :: sigma_logr_aer ! geometric standard deviation of number distribution + real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) + real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius + real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) + real(r8), intent(out) :: cheb(:,:,:) + + integer :: i, k, nc + real(r8) :: alnsg_amode + real(r8) :: explnsigma + real(r8) :: xrad(pcols) ! normalized aerosol radius + !------------------------------------------------------------------------------- + + alnsg_amode = log(sigma_logr_aer) + explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) + + do k = top_lev, pver + do i = 1, ncol + ! convert from number mode diameter to surface area + radsurf(i,k) = 0.5_r8*dgnumwet(i,k)*explnsigma + logradsurf(i,k) = log(radsurf(i,k)) + ! normalize size parameter + xrad(i) = max(logradsurf(i,k),xrmin) + xrad(i) = min(xrad(i),xrmax) + xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) + ! chebyshev polynomials + cheb(1,i,k) = 1._r8 + cheb(2,i,k) = xrad(i) + do nc = 3, ncoef + cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) + end do + end do + end do + +end subroutine modal_size_parameters + +!=============================================================================== + + subroutine binterp(table,ncol,km,im,jm,x,y,xtab,ytab,ix,jy,t,u,out) + + ! bilinear interpolation of table + ! + implicit none + integer im,jm,km,ncol + real(r8) table(km,im,jm),xtab(im),ytab(jm),out(pcols,km) + integer i,ix(pcols),ip1,j,jy(pcols),jp1,k,ic,ip1m(pcols),jp1m(pcols),ixc,jyc + real(r8) x(pcols),dx,t(pcols),y(pcols),dy,u(pcols),tu(pcols),tuc(pcols),tcu(pcols),tcuc(pcols) + + if(ix(1).gt.0) go to 30 + if(im.gt.1)then + do ic=1,ncol + do i=1,im + if(x(ic).lt.xtab(i))go to 10 + enddo + 10 ix(ic)=max0(i-1,1) + ip1=min(ix(ic)+1,im) + dx=(xtab(ip1)-xtab(ix(ic))) + if(abs(dx).gt.1.e-20_r8)then + t(ic)=(x(ic)-xtab(ix(ic)))/dx + else + t(ic)=0._r8 + endif + end do + else + ix(:ncol)=1 + t(:ncol)=0._r8 + endif + if(jm.gt.1)then + do ic=1,ncol + do j=1,jm + if(y(ic).lt.ytab(j))go to 20 + enddo + 20 jy(ic)=max0(j-1,1) + jp1=min(jy(ic)+1,jm) + dy=(ytab(jp1)-ytab(jy(ic))) + if(abs(dy).gt.1.e-20_r8)then + u(ic)=(y(ic)-ytab(jy(ic)))/dy + else + u(ic)=0._r8 + endif + end do + else + jy(:ncol)=1 + u(:ncol)=0._r8 + endif + 30 continue + do ic=1,ncol + tu(ic)=t(ic)*u(ic) + tuc(ic)=t(ic)-tu(ic) + tcuc(ic)=1._r8-tuc(ic)-u(ic) + tcu(ic)=u(ic)-tu(ic) + jp1m(ic)=min(jy(ic)+1,jm) + ip1m(ic)=min(ix(ic)+1,im) + enddo + do ic=1,ncol + jyc=jy(ic) + ixc=ix(ic) + jp1=jp1m(ic) + ip1=ip1m(ic) + do k=1,km + out(ic,k) = tcuc(ic) * table(k,ixc,jyc) + tuc(ic) * table(k,ip1,jyc) + & + tu(ic) * table(k,ip1,jp1) + tcu(ic) * table(k,ixc,jp1) + end do + end do + return + end subroutine binterp + +end module modal_aer_opt diff --git a/src/physics/cam/molec_diff.F90 b/src/physics/cam/molec_diff.F90 new file mode 100644 index 0000000000..bcb55c3d4f --- /dev/null +++ b/src/physics/cam/molec_diff.F90 @@ -0,0 +1,394 @@ +module molec_diff + + !------------------------------------------------------------------------------------------------- ! + ! Module to compute molecular diffusivity for various constituents ! + ! ! + ! Public interfaces : ! + ! ! + ! init_molec_diff Initializes time independent coefficients ! + ! init_timestep_molec_diff Time-step initialization for molecular diffusivity ! + ! compute_molec_diff Computes constituent-independent terms for moleculuar diffusivity ! + ! vd_lu_qdecomp Computes constituent-dependent terms for moleculuar diffusivity and ! + ! updates terms in the triadiagonal matrix used for the implicit ! + ! solution of the diffusion equation ! + ! ! + !---------------------------Code history---------------------------------------------------------- ! + ! Modularized : J. McCaa, September 2004 ! + ! Lastly Arranged : S. Park, January. 2010 ! + ! M. Mills, November 2011 + !------------------------------------------------------------------------------------------------- ! + + use perf_mod + use physconst, only : mbarv + use phys_control, only : waccmx_is !WACCM-X runtime switch + + implicit none + private + save + + public init_molec_diff + public compute_molec_diff + public vd_lu_qdecomp + + ! ---------- ! + ! Parameters ! + ! ---------- ! + + integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + + real(r8), parameter :: km_fac = 3.55E-7_r8 ! Molecular viscosity constant [ unit ? ] + real(r8), parameter :: pwr = 2._r8/3._r8 ! Exponentiation factor [ no unit ] + real(r8), parameter :: d0 = 1.52E20_r8 ! Diffusion factor [ m-1 s-1 ] molec sqrt(kg/kmol/K) [ unit ? ] + ! Aerononmy, Part B, Banks and Kockarts (1973), p39 + ! Note text cites 1.52E18 cm-1 ... + + real(r8) :: mw_dry ! Molecular weight of dry air + real(r8) :: n_avog ! Avogadro's number [ molec/kmol ] + + real(r8), allocatable :: mw_fac(:) ! sqrt(1/M_q + 1/M_d) in constituent diffusivity [ unit ? ] + real(r8), allocatable :: alphath(:) ! Thermal diffusion factor, -0.38 for H, 0 for others + + logical :: waccmx_mode = .false. + +contains + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine init_molec_diff( kind, ncnst, mw_dry_in, n_avog_in, & + errstring) + + use constituents, only : cnst_mw, cnst_get_ind + + integer, intent(in) :: kind ! Kind of reals being passed in + integer, intent(in) :: ncnst ! Number of constituents + real(r8), intent(in) :: mw_dry_in ! Molecular weight of dry air + real(r8), intent(in) :: n_avog_in ! Avogadro's number [ molec/kmol ] + + character(len=*), intent(out) :: errstring + + ! Local + + integer :: m ! Constituent index + integer :: indx_H ! Constituent index for H + integer :: ierr ! Allocate error check + + errstring = ' ' + + mw_dry = mw_dry_in + n_avog = n_avog_in + + if( kind /= r8 ) then + errstring = 'inconsistent KIND of reals passed to init_molec_diff' + return + end if + + ! Determine whether WACCM-X is on. + waccmx_mode = waccmx_is('ionosphere') .or. waccmx_is('neutral') + + ! Molecular weight factor in constitutent diffusivity + ! ***** FAKE THIS FOR NOW USING MOLECULAR WEIGHT OF DRY AIR FOR ALL TRACERS **** + + allocate(mw_fac(ncnst)) + do m = 1, ncnst + mw_fac(m) = d0 * mw_dry * sqrt(1._r8/mw_dry + 1._r8/cnst_mw(m)) / n_avog + end do + + !-------------------------------------------------------------------------------------------- + ! For WACCM-X, get H data index and initialize thermal diffusion coefficient + !-------------------------------------------------------------------------------------------- + if ( waccmx_mode ) then + + call cnst_get_ind('H', indx_H) + + allocate(alphath(ncnst), stat=ierr) + if ( ierr /= 0 ) then + errstring = 'allocate failed in init_molec_diff' + return + end if + alphath(:ncnst) = 0._r8 + alphath(indx_H) = -0.38_r8 + + endif + + end subroutine init_molec_diff + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine compute_molec_diff(lchnk, pcols, pver, ncnst, ncol, & + kvm, kvt, tint, rhoi, kq_scal, cnst_mw, & + mw_fac_out, nbot_molec) + + use physconst, only : cpairv, kmvis, kmcnd + + ! --------------------- ! + ! Input-Output Argument ! + ! --------------------- ! + + integer, intent(in) :: pcols + integer, intent(in) :: pver + integer, intent(in) :: ncnst + integer, intent(in) :: ncol ! Number of atmospheric columns + integer, intent(in) :: lchnk ! Chunk identifier + + real(r8), intent(inout) :: kvm(pcols,pver+1) ! Viscosity ( diffusivity for momentum ) + real(r8), intent(out) :: kvt(pcols,pver+1) ! Kinematic molecular conductivity + real(r8), intent(in) :: tint(pcols,pver+1) ! Interface temperature [ K ] + real(r8), intent(in) :: rhoi(pcols,pver+1) ! Density ( rho ) at interfaces + real(r8), intent(in) :: cnst_mw(ncnst) ! Constituent molecular weight + + real(r8), intent(out) :: kq_scal(pcols,pver+1) ! kq_fac*sqrt(T)*m_d/rho for molecular diffusivity + real(r8), intent(out) :: mw_fac_out(pcols,pver+1,ncnst) ! composition dependent mw_fac on interface level + integer, intent(in) :: nbot_molec + + ! --------------- ! + ! Local variables ! + ! --------------- ! + + integer :: m ! Constituent index + integer :: k ! Level index + + real(r8) :: mbarvi(pcols,nbot_molec,ncnst) ! mbarv on interface level + + real(r8) :: mkvisc(ncol) ! Molecular kinematic viscosity c*tint**(2/3)/rho + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + ! + ! Need variable mw_fac for kvt and constant otherwise. + ! + ! Then compute molecular kinematic viscosity, heat diffusivity and + ! factor for constituent diffusivity. + ! This is a key part of the code. For WACCM-X, use constituent + ! dependent molecular viscosity and conductivity. + ! + + kvt = 0._r8 + kq_scal = 0._r8 + if (waccmx_mode) then + do m = 1, ncnst + mbarvi(:ncol,1,m) = .75_r8*mbarv(:ncol,1,lchnk)+0.5_r8*mbarv(:ncol,2,lchnk) & + -.25_r8*mbarv(:ncol,3,lchnk) + do k = 2, nbot_molec + mbarvi(:ncol,k,m) = 0.5_r8 * (mbarv(:ncol,k-1,lchnk)+mbarv(:ncol,k,lchnk)) + mw_fac_out(:ncol,k,m) = d0 * mbarvi(:ncol,k,m) * & + sqrt(1._r8/mbarvi(:ncol,k,m) + 1._r8/cnst_mw(m)) / n_avog + enddo + mw_fac_out(:ncol,1,m) = 1.5_r8*mw_fac_out(:ncol,2,m)-.5_r8*mw_fac_out(:ncol,3,m) + do k = nbot_molec+1, pver+1 + mw_fac_out(:ncol,k,m) = mw_fac_out(:ncol,nbot_molec,m) + enddo + end do + + do k = 1, nbot_molec + mkvisc = kmvis(:ncol,k,lchnk) / rhoi(:ncol,k) + kvm(:ncol,k) = kvm(:ncol,k) + mkvisc + mkvisc = kmcnd(:ncol,k,lchnk) / rhoi(:ncol,k) + kvt(:ncol,k) = mkvisc + kq_scal(:ncol,k) = sqrt(tint(:ncol,k)) / rhoi(:ncol,k) + end do + + else + do m = 1, ncnst + mw_fac_out(:,:,m) = mw_fac(m) + end do + + do k = 1, nbot_molec + mkvisc = km_fac * tint(:ncol,k)**pwr / rhoi(:ncol,k) + kvm(:ncol,k) = kvm(:ncol,k) + mkvisc + kvt(:ncol,k) = mkvisc * cpairv(:ncol,k,lchnk) + kq_scal(:ncol,k) = sqrt(tint(:ncol,k)) / rhoi(:ncol,k) + end do + endif + + end subroutine compute_molec_diff + + !============================================================================ ! + ! ! + !============================================================================ ! + + function vd_lu_qdecomp( & + pcols , pver , ncol , fixed_ubc , mw , & + kv , kq_scal, mw_facm , dpidz_sq , p , & + interface_boundary, molec_boundary, & + tint , ztodt , nbot_molec , & + lchnk , t , m , no_molec_decomp) result(decomp) + + use coords_1d, only: Coords1D + use linear_1d_operators, only: BoundaryType, TriDiagDecomp + use vdiff_lu_solver, only: fin_vol_lu_decomp + + !------------------------------------------------------------------------------ ! + ! Add the molecular diffusivity to the turbulent diffusivity for a consitutent. ! + ! Update the superdiagonal (ca(k)), diagonal (cb(k)) and subdiagonal (cc(k)) ! + ! coefficients of the tridiagonal diffusion matrix, also ze and denominator. ! + !------------------------------------------------------------------------------ ! + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + integer, intent(in) :: pcols + integer, intent(in) :: pver + integer, intent(in) :: ncol ! Number of atmospheric columns + + integer, intent(in) :: nbot_molec + + logical, intent(in) :: fixed_ubc ! Fixed upper boundary condition flag + real(r8), intent(in) :: kv(pcols,pver+1) ! Eddy diffusivity + real(r8), intent(in) :: kq_scal(pcols,pver+1) ! Molecular diffusivity ( kq_fac*sqrt(T)*m_d/rho ) + real(r8), intent(in) :: mw ! Molecular weight for this constituent + real(r8), intent(in) :: mw_facm(pcols,pver+1) ! composition dependent sqrt(1/M_q + 1/M_d) for this constituent + real(r8), intent(in) :: dpidz_sq(ncol,pver+1) ! (g*rho)**2 (square of vertical derivative of pint) + type(Coords1D), intent(in) :: p ! Pressure coordinates + type(BoundaryType), intent(in) :: interface_boundary ! Boundary on grid edge. + type(BoundaryType), intent(in) :: molec_boundary ! Boundary at edge of molec_diff region. + real(r8), intent(in) :: tint(pcols,pver+1) ! Interface temperature [ K ] + real(r8), intent(in) :: ztodt ! 2 delta-t [ s ] + + integer, intent(in) :: lchnk ! Chunk number + real(r8), intent(in) :: t(pcols,pver) ! temperature + integer, intent(in) :: m ! cnst index + + ! Decomposition covering levels without vertical diffusion. + type(TriDiagDecomp), intent(in) :: no_molec_decomp + + ! LU decomposition information for solver. + type(TriDiagDecomp) :: decomp + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + ! Level index. + integer :: k + + ! Molecular diffusivity for constituent. + real(r8) :: kmq(ncol,nbot_molec+1) + + ! Term for drift due to molecular separation: (m_i/m - 1) / p + real(r8) :: mw_term(ncol,nbot_molec+1) + + ! Diffusion coefficient. + real(r8) :: diff_coef(ncol,nbot_molec+1) + ! Advection velocity. + real(r8) :: advect_v(ncol,nbot_molec+1) + + ! 1/mbar * d(mbar)/dp + real(r8) :: gradm(ncol,nbot_molec+1) + + ! alphaTh/T * dT/dp, for now alphaTh is non-zero only for H. + real(r8) :: gradt(ncol,nbot_molec+1) + + ! mbarv at interface + real(r8) :: mbarvi(ncol) + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + ! --------------------------------------------------------------------- ! + ! Determine superdiagonal (ca(k)) and subdiagonal (cc(k)) coeffs of the ! + ! tridiagonal diffusion matrix. The diagonal elements (cb=1+ca+cc) are ! + ! a combination of ca and cc; they are not required by the solver. ! + !---------------------------------------------------------------------- ! + + call t_startf('vd_lu_qdecomp') + + kmq = 0._r8 + mw_term = 0._r8 + gradm = 0._r8 + gradt = 0._r8 + + ! Compute difference between scale heights of constituent and dry air + + if ( waccmx_mode ) then + + ! Top level first. + k = 1 + mbarvi = .75_r8*mbarv(:ncol,k,lchnk)+0.5_r8*mbarv(:ncol,k+1,lchnk) & + -.25_r8*mbarv(:ncol,k+2,lchnk) + mw_term(:,k) = (mw/mbarvi - 1._r8) / p%ifc(:,k) + gradm(:,k) = (mbarv(:ncol,k,lchnk)-mbarvi)/ & + (p%mid(:,k)-p%ifc(:,k))/ & + (mbarv(:ncol,k,lchnk)+mbarvi)*2._r8 + + if (alphath(m) /= 0._r8) then + gradt(:,k) = alphath(m)*(t(:ncol,k)-tint(:ncol,k))/ & + (p%mid(:ncol,k)-p%ifc(:ncol,k))/ & + (t(:ncol,k)+tint(:ncol,k))*2._r8 + end if + + ! Interior of molecular diffusion region. + do k = 2, nbot_molec + mbarvi = 0.5_r8 * (mbarv(:ncol,k-1,lchnk)+mbarv(:ncol,k,lchnk)) + mw_term(:,k) = (mw/mbarvi - 1._r8) / p%ifc(:,k) + gradm(:,k) = (mbarv(:ncol,k,lchnk)-mbarv(:ncol,k-1,lchnk)) * & + p%rdst(:,k-1)/mbarvi + enddo + + if (alphath(m) /= 0._r8) then + do k = 2, nbot_molec + gradt(:,k) = alphath(m)*(t(:ncol,k)-t(:ncol,k-1)) & + *p%rdst(:,k-1)/tint(:ncol,k) + end do + end if + + ! Leave nbot_molec+1 terms as zero, because molecular diffusion is + ! small at the lower boundary. + + else + + do k = 1, nbot_molec + mw_term(:,k) = (mw/mw_dry - 1._r8) / p%ifc(:ncol,k) + enddo + + endif + + !-------------------- ! + ! Molecular diffusion ! + !-------------------- ! + + ! Start with non-molecular portion of diffusion. + + ! Molecular diffusion coefficient. + do k = 1, nbot_molec + kmq(:,k) = kq_scal(:ncol,k) * mw_facm(:ncol,k) + end do + + diff_coef = kv(:ncol,:nbot_molec+1) + kmq + + ! "Drift" terms. + advect_v = kmq*mw_term + if ( waccmx_mode ) then + advect_v = advect_v - kmq*gradt - & + (kv(:ncol,:nbot_molec+1) + kmq)*gradm + end if + + ! Convert from z to pressure representation. + diff_coef = dpidz_sq(:,:nbot_molec+1) * diff_coef + advect_v = dpidz_sq(:,:nbot_molec+1) * advect_v + + if( fixed_ubc ) then + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=diff_coef, coef_q_adv=advect_v, & + upper_bndry=interface_boundary, & + lower_bndry=molec_boundary, & + graft_decomp=no_molec_decomp) + else + decomp = fin_vol_lu_decomp(ztodt, p, & + coef_q_diff=diff_coef, coef_q_adv=advect_v, & + lower_bndry=molec_boundary, & + graft_decomp=no_molec_decomp) + end if + + call t_stopf('vd_lu_qdecomp') + + end function vd_lu_qdecomp + +end module molec_diff diff --git a/src/physics/cam/ndrop.F90 b/src/physics/cam/ndrop.F90 new file mode 100644 index 0000000000..b6368d18df --- /dev/null +++ b/src/physics/cam/ndrop.F90 @@ -0,0 +1,1971 @@ +module ndrop + +!--------------------------------------------------------------------------------- +! Purpose: +! CAM Interface for droplet activation by modal aerosols +! +! ***N.B.*** This module is currently hardcoded to recognize only the modes that +! affect the climate calculation. This is implemented by using list +! index 0 in all the calls to rad_constituent interfaces. +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp +use physconst, only: pi, rhoh2o, mwh2o, r_universal, rh2o, & + gravit, latvap, cpair, epsilo, rair +use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_spec_class_gas, cnst_species_class +use physics_types, only: physics_state, physics_ptend, physics_ptend_init +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + +use wv_saturation, only: qsat +use phys_control, only: phys_getopts +use ref_pres, only: top_lev => trop_cloud_top_lev +use shr_spfn_mod, only: erf => shr_spfn_erf +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & + rad_cnst_get_aer_props, rad_cnst_get_mode_props, & + rad_cnst_get_mam_mmr_idx, rad_cnst_get_mode_num_idx +use cam_history, only: addfld, add_default, horiz_only, fieldname_len, outfld +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public ndrop_init, dropmixnuc, activate_modal, loadaer + +real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol +real(r8), allocatable :: exp45logsig(:) +real(r8), allocatable :: f1(:) ! abdul-razzak functions of width +real(r8), allocatable :: f2(:) ! abdul-razzak functions of width + +real(r8) :: t0 ! reference temperature +real(r8) :: aten +real(r8) :: surften ! surface tension of water w/respect to air (N/m) +real(r8) :: alog2, alog3, alogaten +real(r8) :: third, twothird, sixth, zero +real(r8) :: sq2, sqpi + +! CCN diagnostic fields +integer, parameter :: psat=6 ! number of supersaturations to calc ccn concentration +real(r8), parameter :: supersat(psat)= & ! supersaturation (%) to determine ccn concentration + (/ 0.02_r8, 0.05_r8, 0.1_r8, 0.2_r8, 0.5_r8, 1.0_r8 /) +character(len=8) :: ccn_name(psat)= & + (/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6'/) + +! indices in state and pbuf structures +integer :: numliq_idx = -1 +integer :: kvh_idx = -1 + +! description of modal aerosols +integer :: ntot_amode ! number of aerosol modes +integer, allocatable :: nspec_amode(:) ! number of chemical species in each aerosol mode +real(r8), allocatable :: sigmag_amode(:)! geometric standard deviation for each aerosol mode +real(r8), allocatable :: dgnumlo_amode(:) +real(r8), allocatable :: dgnumhi_amode(:) +real(r8), allocatable :: voltonumblo_amode(:) +real(r8), allocatable :: voltonumbhi_amode(:) + +logical :: history_aerosol ! Output the MAM aerosol tendencies +character(len=fieldname_len), allocatable :: fieldname(:) ! names for drop nuc tendency output fields +character(len=fieldname_len), allocatable :: fieldname_cw(:) ! names for drop nuc tendency output fields + +! local indexing for MAM +integer, allocatable :: mam_idx(:,:) ! table for local indexing of modal aero number and mmr +integer :: ncnst_tot ! total number of mode number conc + mode species + +! Indices for MAM species in the ptend%q array. Needed for prognostic aerosol case. +integer, allocatable :: mam_cnst_idx(:,:) + + +! ptr2d_t is used to create arrays of pointers to 2D fields +type ptr2d_t + real(r8), pointer :: fld(:,:) +end type ptr2d_t + +! modal aerosols +logical :: prog_modal_aero ! true when modal aerosols are prognostic +logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies + ! in the ptend object + +!=============================================================================== +contains +!=============================================================================== + +subroutine ndrop_init + + integer :: ii, l, lptr, m, mm + integer :: nspec_max ! max number of species in a mode + character(len=32) :: tmpname + character(len=32) :: tmpname_cw + character(len=128) :: long_name + character(len=8) :: unit + logical :: history_amwg ! output the variables used by the AMWG diag package + + !------------------------------------------------------------------------------- + + ! get indices into state%q and pbuf structures + call cnst_get_ind('NUMLIQ', numliq_idx) + + kvh_idx = pbuf_get_index('kvh') + + zero = 0._r8 + third = 1._r8/3._r8 + twothird = 2._r8*third + sixth = 1._r8/6._r8 + sq2 = sqrt(2._r8) + sqpi = sqrt(pi) + + t0 = 273._r8 + surften = 0.076_r8 + aten = 2._r8*mwh2o*surften/(r_universal*t0*rhoh2o) + alogaten = log(aten) + alog2 = log(2._r8) + alog3 = log(3._r8) + + ! get info about the modal aerosols + ! get ntot_amode + call rad_cnst_get_info(0, nmodes=ntot_amode) + + allocate( & + nspec_amode(ntot_amode), & + sigmag_amode(ntot_amode), & + dgnumlo_amode(ntot_amode), & + dgnumhi_amode(ntot_amode), & + alogsig(ntot_amode), & + exp45logsig(ntot_amode), & + f1(ntot_amode), & + f2(ntot_amode), & + voltonumblo_amode(ntot_amode), & + voltonumbhi_amode(ntot_amode) ) + + do m = 1, ntot_amode + ! use only if width of size distribution is prescribed + + ! get mode info + call rad_cnst_get_info(0, m, nspec=nspec_amode(m)) + + ! get mode properties + call rad_cnst_get_mode_props(0, m, sigmag=sigmag_amode(m), & + dgnumhi=dgnumhi_amode(m), dgnumlo=dgnumlo_amode(m)) + + alogsig(m) = log(sigmag_amode(m)) + exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) + f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m)) + f2(m) = 1._r8 + 0.25_r8*alogsig(m) + + voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + end do + + ! Init the table for local indexing of mam number conc and mmr. + ! This table uses species index 0 for the number conc. + + ! Find max number of species in all the modes, and the total + ! number of mode number concentrations + mode species + nspec_max = nspec_amode(1) + ncnst_tot = nspec_amode(1) + 1 + do m = 2, ntot_amode + nspec_max = max(nspec_max, nspec_amode(m)) + ncnst_tot = ncnst_tot + nspec_amode(m) + 1 + end do + + allocate( & + mam_idx(ntot_amode,0:nspec_max), & + mam_cnst_idx(ntot_amode,0:nspec_max), & + fieldname(ncnst_tot), & + fieldname_cw(ncnst_tot) ) + + ! Local indexing compresses the mode and number/mass indicies into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. + ii = 0 + do m = 1, ntot_amode + do l = 0, nspec_amode(m) + ii = ii + 1 + mam_idx(m,l) = ii + end do + end do + + ! Add dropmixnuc tendencies for all modal aerosol species + + call phys_getopts(history_amwg_out = history_amwg, & + history_aerosol_out = history_aerosol, & + prog_modal_aero_out=prog_modal_aero) + + + do m = 1, ntot_amode + do l = 0, nspec_amode(m) ! loop over number + chem constituents + + mm = mam_idx(m,l) + + unit = 'kg/m2/s' + if (l == 0) then ! number + unit = '#/m2/s' + end if + + if (l == 0) then ! number + call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw) + else + call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw) + end if + + fieldname(mm) = trim(tmpname) // '_mixnuc1' + fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1' + + if (prog_modal_aero) then + + ! To set tendencies in the ptend object need to get the constituent indices + ! for the prognostic species + if (l == 0) then ! number + call rad_cnst_get_mode_num_idx(m, lptr) + else + call rad_cnst_get_mam_mmr_idx(m, l, lptr) + end if + mam_cnst_idx(m,l) = lptr + lq(lptr) = .true. + + ! Add tendency fields to the history only when prognostic MAM is enabled. + long_name = trim(tmpname) // ' dropmixnuc mixnuc column tendency' + call addfld(fieldname(mm), horiz_only, 'A', unit, long_name) + + long_name = trim(tmpname_cw) // ' dropmixnuc mixnuc column tendency' + call addfld(fieldname_cw(mm), horiz_only, 'A', unit, long_name) + + if (history_aerosol) then + call add_default(fieldname(mm), 1, ' ') + call add_default(fieldname_cw(mm), 1, ' ') + end if + + + + end if + + end do + end do + + call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%') + call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%') + call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%') + call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%') + call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%') + call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%') + + + call addfld('WTKE', (/ 'lev' /), 'A', 'm/s', 'Standard deviation of updraft velocity') + call addfld('NDROPMIX', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number mixing') + call addfld('NDROPSRC', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number source') + call addfld('NDROPSNK', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number loss by microphysics') + call addfld('NDROPCOL', horiz_only, 'A', '#/m2', 'Column droplet number') + + ! set the add_default fields + if (history_amwg) then + call add_default('CCN3', 1, ' ') + endif + + if (history_aerosol .and. prog_modal_aero) then + do m = 1, ntot_amode + do l = 0, nspec_amode(m) ! loop over number + chem constituents + mm = mam_idx(m,l) + if (l == 0) then ! number + call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw) + else + call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw) + end if + fieldname(mm) = trim(tmpname) // '_mixnuc1' + fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1' + end do + end do + endif + + + +end subroutine ndrop_init + +!=============================================================================== + +subroutine dropmixnuc( & + state, ptend, dtmicro, pbuf, wsub, & + cldn, cldo, cldliqf, tendnd, factnum, from_spcam) + + ! vertical diffusion and nucleation of cloud droplets + ! assume cloud presence controlled by cloud fraction + ! doesn't distinguish between warm, cold clouds + + ! arguments + type(physics_state), target, intent(in) :: state + type(physics_ptend), intent(out) :: ptend + real(r8), intent(in) :: dtmicro ! time step for microphysics (s) + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! arguments + real(r8), intent(in) :: wsub(pcols,pver) ! subgrid vertical velocity + real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction + real(r8), intent(in) :: cldo(pcols,pver) ! cloud fraction on previous time step + real(r8), intent(in) :: cldliqf(pcols,pver) ! liquid cloud fraction (liquid / (liquid + ice)) + logical, intent(in),optional :: from_spcam ! value insignificant - if variable present, is called from spcam + + ! output arguments + real(r8), intent(out) :: tendnd(pcols,pver) ! change in droplet number concentration (#/kg/s) + real(r8), intent(out) :: factnum(:,:,:) ! activation fraction for aerosol number + !--------------------Local storage------------------------------------- + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns + + real(r8), pointer :: ncldwtr(:,:) ! droplet number concentration (#/kg) + real(r8), pointer :: temp(:,:) ! temperature (K) + real(r8), pointer :: omega(:,:) ! vertical velocity (Pa/s) + real(r8), pointer :: pmid(:,:) ! mid-level pressure (Pa) + real(r8), pointer :: pint(:,:) ! pressure at layer interfaces (Pa) + real(r8), pointer :: pdel(:,:) ! pressure thickess of layer (Pa) + real(r8), pointer :: rpdel(:,:) ! inverse of pressure thickess of layer (/Pa) + real(r8), pointer :: zm(:,:) ! geopotential height of level (m) + + real(r8), pointer :: kvh(:,:) ! vertical diffusivity (m2/s) + + type(ptr2d_t), allocatable :: raer(:) ! aerosol mass, number mixing ratios + type(ptr2d_t), allocatable :: qqcw(:) + real(r8) :: raertend(pver) ! tendency of aerosol mass, number mixing ratios + real(r8) :: qqcwtend(pver) ! tendency of cloudborne aerosol mass, number mixing ratios + + + real(r8), parameter :: zkmin = 0.01_r8, zkmax = 100._r8 + real(r8), parameter :: wmixmin = 0.1_r8 ! minimum turbulence vertical velocity (m/s) + real(r8) :: sq2pi + + integer :: i, k, l, m, mm, n + integer :: km1, kp1 + integer :: nnew, nsav, ntemp + integer :: lptr + integer :: nsubmix, nsubmix_bnd + integer, save :: count_submix(100) + integer :: phase ! phase of aerosol + + real(r8) :: arg + real(r8) :: dtinv + real(r8) :: dtmin, tinv, dtt + real(r8) :: lcldn(pcols,pver) + real(r8) :: lcldo(pcols,pver) + + real(r8) :: zs(pver) ! inverse of distance between levels (m) + real(r8) :: qcld(pver) ! cloud droplet number mixing ratio (#/kg) + real(r8) :: qncld(pver) ! droplet number nucleated on cloud boundaries + real(r8) :: srcn(pver) ! droplet source rate (/s) + real(r8) :: cs(pcols,pver) ! air density (kg/m3) + real(r8) :: csbot(pver) ! air density at bottom (interface) of layer (kg/m3) + real(r8) :: csbot_cscen(pver) ! csbot(i)/cs(i,k) + real(r8) :: dz(pcols,pver) ! geometric thickness of layers (m) + + real(r8) :: wtke(pcols,pver) ! turbulent vertical velocity at base of layer k (m/s) + real(r8) :: wtke_cen(pcols,pver) ! turbulent vertical velocity at center of layer k (m/s) + real(r8) :: wbar, wmix, wmin, wmax + + real(r8) :: zn(pver) ! g/pdel (m2/g) for layer + real(r8) :: flxconv ! convergence of flux into lowest layer + + real(r8) :: wdiab ! diabatic vertical velocity + real(r8) :: ekd(pver) ! diffusivity for droplets (m2/s) + real(r8) :: ekk(0:pver) ! density*diffusivity for droplets (kg/m3 m2/s) + real(r8) :: ekkp(pver) ! zn*zs*density*diffusivity + real(r8) :: ekkm(pver) ! zn*zs*density*diffusivity + + real(r8) :: dum, dumc + real(r8) :: tmpa + real(r8) :: dact + real(r8) :: fluxntot ! (#/cm2/s) + real(r8) :: dtmix + real(r8) :: alogarg + real(r8) :: overlapp(pver), overlapm(pver) ! cloud overlap + + real(r8) :: nsource(pcols,pver) ! droplet number source (#/kg/s) + real(r8) :: ndropmix(pcols,pver) ! droplet number mixing (#/kg/s) + real(r8) :: ndropcol(pcols) ! column droplet number (#/m2) + real(r8) :: cldo_tmp, cldn_tmp + real(r8) :: tau_cld_regenerate + real(r8) :: zeroaer(pver) + real(r8) :: taumix_internal_pver_inv ! 1/(internal mixing time scale for k=pver) (1/s) + + + real(r8), allocatable :: nact(:,:) ! fractional aero. number activation rate (/s) + real(r8), allocatable :: mact(:,:) ! fractional aero. mass activation rate (/s) + + real(r8), allocatable :: raercol(:,:,:) ! single column of aerosol mass, number mixing ratios + real(r8), allocatable :: raercol_cw(:,:,:) ! same as raercol but for cloud-borne phase + + + real(r8) :: na(pcols), va(pcols), hy(pcols) + real(r8), allocatable :: naermod(:) ! (1/m3) + real(r8), allocatable :: hygro(:) ! hygroscopicity of aerosol mode + real(r8), allocatable :: vaerosol(:) ! interstit+activated aerosol volume conc (cm3/cm3) + + real(r8) :: source(pver) + + real(r8), allocatable :: fn(:) ! activation fraction for aerosol number + real(r8), allocatable :: fm(:) ! activation fraction for aerosol mass + + real(r8), allocatable :: fluxn(:) ! number activation fraction flux (cm/s) + real(r8), allocatable :: fluxm(:) ! mass activation fraction flux (cm/s) + real(r8) :: flux_fullact(pver) ! 100% activation fraction flux (cm/s) + ! note: activation fraction fluxes are defined as + ! fluxn = [flux of activated aero. number into cloud (#/cm2/s)] + ! / [aero. number conc. in updraft, just below cloudbase (#/cm3)] + + + real(r8), allocatable :: coltend(:,:) ! column tendency for diagnostic output + real(r8), allocatable :: coltend_cw(:,:) ! column tendency + real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat + + !for gas species turbulent mixing + real(r8), pointer :: rgas(:, :, :) + real(r8), allocatable :: rgascol(:, :, :) + real(r8), allocatable :: coltendgas(:) + real(r8) :: zerogas(pver) + character*200 fieldnamegas + + logical :: called_from_spcam + !------------------------------------------------------------------------------- + + sq2pi = sqrt(2._r8*pi) + + lchnk = state%lchnk + ncol = state%ncol + + ncldwtr => state%q(:,:,numliq_idx) + temp => state%t + omega => state%omega + pmid => state%pmid + pint => state%pint + pdel => state%pdel + rpdel => state%rpdel + zm => state%zm + + call pbuf_get_field(pbuf, kvh_idx, kvh) + + ! Create the liquid weighted cloud fractions that were passsed in + ! before. This doesn't seem like the best variable, since the cloud could + ! have liquid condensate, but the part of it that is changing could be the + ! ice portion; however, this is what was done before. + lcldo(:ncol,:) = cldo(:ncol,:) * cldliqf(:ncol,:) + lcldn(:ncol,:) = cldn(:ncol,:) * cldliqf(:ncol,:) + + + arg = 1.0_r8 + if (abs(0.8427_r8 - erf(arg))/0.8427_r8 > 0.001_r8) then + write(iulog,*) 'erf(1.0) = ',ERF(arg) + call endrun('dropmixnuc: Error function error') + endif + arg = 0.0_r8 + if (erf(arg) /= 0.0_r8) then + write(iulog,*) 'erf(0.0) = ',erf(arg) + write(iulog,*) 'dropmixnuc: Error function error' + call endrun('dropmixnuc: Error function error') + endif + + dtinv = 1._r8/dtmicro + + allocate( & + nact(pver,ntot_amode), & + mact(pver,ntot_amode), & + raer(ncnst_tot), & + qqcw(ncnst_tot), & + raercol(pver,ncnst_tot,2), & + raercol_cw(pver,ncnst_tot,2), & + coltend(pcols,ncnst_tot), & + coltend_cw(pcols,ncnst_tot), & + naermod(ntot_amode), & + hygro(ntot_amode), & + vaerosol(ntot_amode), & + fn(ntot_amode), & + fm(ntot_amode), & + fluxn(ntot_amode), & + fluxm(ntot_amode) ) + + ! Init pointers to mode number and specie mass mixing ratios in + ! intersitial and cloud borne phases. + do m = 1, ntot_amode + mm = mam_idx(m, 0) + call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer(mm)%fld) + call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol + do l = 1, nspec_amode(m) + mm = mam_idx(m, l) + call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer(mm)%fld) + call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol + end do + end do + + called_from_spcam = (present(from_spcam)) + + if (called_from_spcam) then + rgas => state%q + allocate(rgascol(pver, pcnst, 2)) + allocate(coltendgas(pcols)) + endif + + factnum = 0._r8 + wtke = 0._r8 + + if (prog_modal_aero) then + ! aerosol tendencies + call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq) + else + ! no aerosol tendencies + call physics_ptend_init(ptend, state%psetcols, 'ndrop') + end if + + ! overall_main_i_loop + do i = 1, ncol + + do k = top_lev, pver-1 + zs(k) = 1._r8/(zm(i,k) - zm(i,k+1)) + end do + zs(pver) = zs(pver-1) + + ! load number nucleated into qcld on cloud boundaries + + do k = top_lev, pver + + qcld(k) = ncldwtr(i,k) + qncld(k) = 0._r8 + srcn(k) = 0._r8 + cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3) + dz(i,k) = 1._r8/(cs(i,k)*gravit*rpdel(i,k)) ! layer thickness in m + + do m = 1, ntot_amode + nact(k,m) = 0._r8 + mact(k,m) = 0._r8 + end do + + zn(k) = gravit*rpdel(i,k) + + if (k < pver) then + ekd(k) = kvh(i,k+1) + ekd(k) = max(ekd(k), zkmin) + ekd(k) = min(ekd(k), zkmax) + csbot(k) = 2.0_r8*pint(i,k+1)/(rair*(temp(i,k) + temp(i,k+1))) + csbot_cscen(k) = csbot(k)/cs(i,k) + else + ekd(k) = 0._r8 + csbot(k) = cs(i,k) + csbot_cscen(k) = 1.0_r8 + end if + + ! rce-comment - define wtke at layer centers for new-cloud activation + ! and at layer boundaries for old-cloud activation + !++ag + wtke_cen(i,k) = wsub(i,k) + wtke(i,k) = wsub(i,k) + !--ag + wtke_cen(i,k) = max(wtke_cen(i,k), wmixmin) + wtke(i,k) = max(wtke(i,k), wmixmin) + + nsource(i,k) = 0._r8 + + end do + + nsav = 1 + nnew = 2 + do m = 1, ntot_amode + mm = mam_idx(m,0) + raercol_cw(:,mm,nsav) = 0.0_r8 + raercol(:,mm,nsav) = 0.0_r8 + raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver) + raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver) + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver) + raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver) + end do + end do + + + if (called_from_spcam) then + ! + ! In the MMF model, turbulent mixing for tracer species are turned off. + ! So the turbulent for gas species mixing are added here. + ! (Previously, it had the turbulent mixing for aerosol species) + ! + do m=1, pcnst + if (cnst_species_class(m) == cnst_spec_class_gas) rgascol(:,m,nsav) = rgas(i,:,m) + end do + + endif + + ! droplet nucleation/aerosol activation + + ! tau_cld_regenerate = time scale for regeneration of cloudy air + ! by (horizontal) exchange with clear air + tau_cld_regenerate = 3600.0_r8 * 3.0_r8 + + if (called_from_spcam) then + ! when this is called in the MMF part, no cloud regeneration and decay. + ! set the time scale be very long so that no cloud regeneration. + tau_cld_regenerate = 3600.0_r8 * 24.0_r8 * 365.0_r8 + endif + + + ! k-loop for growing/shrinking cloud calcs ............................. + ! grow_shrink_main_k_loop: & + do k = top_lev, pver + + ! This code was designed for liquid clouds, but the cloudbourne + ! aerosol can be either from liquid or ice clouds. For the ice clouds, + ! we do not do regeneration, but as cloud fraction decreases the + ! aerosols should be returned interstitial. The lack of a liquid cloud + ! should not mean that all of the aerosol is realease. Therefor a + ! section has been added for shrinking ice clouds and checks were added + ! to protect ice cloudbourne aerosols from being released when no + ! liquid cloud is present. + + ! shrinking ice cloud ...................................................... + cldo_tmp = cldo(i,k) * (1._r8 - cldliqf(i,k)) + cldn_tmp = cldn(i,k) * (1._r8 - cldliqf(i,k)) + + if (cldn_tmp < cldo_tmp) then + + ! convert activated aerosol to interstitial in decaying cloud + + dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * (1._r8 - cldliqf(i,k)) + do m = 1, ntot_amode + mm = mam_idx(m,0) + dact = raercol_cw(k,mm,nsav)*dumc + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + dact = raercol_cw(k,mm,nsav)*dumc + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + end do + end do + end if + + ! shrinking liquid cloud ...................................................... + ! treat the reduction of cloud fraction from when cldn(i,k) < cldo(i,k) + ! and also dissipate the portion of the cloud that will be regenerated + cldo_tmp = lcldo(i,k) + cldn_tmp = lcldn(i,k) * exp( -dtmicro/tau_cld_regenerate ) + ! alternate formulation + ! cldn_tmp = cldn(i,k) * max( 0.0_r8, (1.0_r8-dtmicro/tau_cld_regenerate) ) + + ! fraction is also provided. + if (cldn_tmp < cldo_tmp) then + ! droplet loss in decaying cloud + !++ sungsup + nsource(i,k) = nsource(i,k) + qcld(k)*(cldn_tmp - cldo_tmp)/cldo_tmp*cldliqf(i,k)*dtinv + qcld(k) = qcld(k)*(1._r8 + (cldn_tmp - cldo_tmp)/cldo_tmp) + !-- sungsup + + ! convert activated aerosol to interstitial in decaying cloud + + dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * cldliqf(i,k) + do m = 1, ntot_amode + mm = mam_idx(m,0) + dact = raercol_cw(k,mm,nsav)*dumc + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + dact = raercol_cw(k,mm,nsav)*dumc + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + end do + end do + end if + + ! growing liquid cloud ...................................................... + ! treat the increase of cloud fraction from when cldn(i,k) > cldo(i,k) + ! and also regenerate part of the cloud + cldo_tmp = cldn_tmp + cldn_tmp = lcldn(i,k) + + if (cldn_tmp-cldo_tmp > 0.01_r8) then + + ! rce-comment - use wtke at layer centers for new-cloud activation + wbar = wtke_cen(i,k) + wmix = 0._r8 + wmin = 0._r8 + wmax = 10._r8 + wdiab = 0._r8 + + ! load aerosol properties, assuming external mixtures + + phase = 1 ! interstitial + do m = 1, ntot_amode + call loadaer( & + state, pbuf, i, i, k, & + m, cs, phase, na, va, & + hy) + naermod(m) = na(i) + vaerosol(m) = va(i) + hygro(m) = hy(i) + end do + + call activate_modal( & + wbar, wmix, wdiab, wmin, wmax, & + temp(i,k), cs(i,k), naermod, ntot_amode, & + vaerosol, hygro, fn, fm, fluxn, & + fluxm,flux_fullact(k)) + + factnum(i,k,:) = fn + + dumc = (cldn_tmp - cldo_tmp) + do m = 1, ntot_amode + mm = mam_idx(m,0) + dact = dumc*fn(m)*raer(mm)%fld(i,k) ! interstitial only + qcld(k) = qcld(k) + dact + nsource(i,k) = nsource(i,k) + dact*dtinv + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + dum = dumc*fm(m) + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + dact = dum*raer(mm)%fld(i,k) ! interstitial only + raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol + raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact + enddo + enddo + endif + + enddo ! grow_shrink_main_k_loop + ! end of k-loop for growing/shrinking cloud calcs ...................... + + ! ...................................................................... + ! start of k-loop for calc of old cloud activation tendencies .......... + ! + ! rce-comment + ! changed this part of code to use current cloud fraction (cldn) exclusively + ! consider case of cldo(:)=0, cldn(k)=1, cldn(k+1)=0 + ! previous code (which used cldo below here) would have no cloud-base activation + ! into layer k. however, activated particles in k mix out to k+1, + ! so they are incorrectly depleted with no replacement + + ! old_cloud_main_k_loop + do k = top_lev, pver + kp1 = min0(k+1, pver) + taumix_internal_pver_inv = 0.0_r8 + + if (lcldn(i,k) > 0.01_r8) then + + wdiab = 0._r8 + wmix = 0._r8 ! single updraft + wbar = wtke(i,k) ! single updraft + if (k == pver) wbar = wtke_cen(i,k) ! single updraft + wmax = 10._r8 + wmin = 0._r8 + + if (lcldn(i,k) - lcldn(i,kp1) > 0.01_r8 .or. k == pver) then + + ! cloud base + + ! ekd(k) = wtke(i,k)*dz(i,k)/sq2pi + ! rce-comments + ! first, should probably have 1/zs(k) here rather than dz(i,k) because + ! the turbulent flux is proportional to ekd(k)*zs(k), + ! while the dz(i,k) is used to get flux divergences + ! and mixing ratio tendency/change + ! second and more importantly, using a single updraft velocity here + ! means having monodisperse turbulent updraft and downdrafts. + ! The sq2pi factor assumes a normal draft spectrum. + ! The fluxn/fluxm from activate must be consistent with the + ! fluxes calculated in explmix. + ekd(k) = wbar/zs(k) + + alogarg = max(1.e-20_r8, 1._r8/lcldn(i,k) - 1._r8) + wmin = wbar + wmix*0.25_r8*sq2pi*log(alogarg) + phase = 1 ! interstitial + + do m = 1, ntot_amode + ! rce-comment - use kp1 here as old-cloud activation involves + ! aerosol from layer below + call loadaer( & + state, pbuf, i, i, kp1, & + m, cs, phase, na, va, & + hy) + naermod(m) = na(i) + vaerosol(m) = va(i) + hygro(m) = hy(i) + end do + + call activate_modal( & + wbar, wmix, wdiab, wmin, wmax, & + temp(i,k), cs(i,k), naermod, ntot_amode, & + vaerosol, hygro, fn, fm, fluxn, & + fluxm, flux_fullact(k)) + + factnum(i,k,:) = fn + + if (k < pver) then + dumc = lcldn(i,k) - lcldn(i,kp1) + else + dumc = lcldn(i,k) + endif + + fluxntot = 0 + + ! rce-comment 1 + ! flux of activated mass into layer k (in kg/m2/s) + ! = "actmassflux" = dumc*fluxm*raercol(kp1,lmass)*csbot(k) + ! source of activated mass (in kg/kg/s) = flux divergence + ! = actmassflux/(cs(i,k)*dz(i,k)) + ! so need factor of csbot_cscen = csbot(k)/cs(i,k) + ! dum=1./(dz(i,k)) + dum=csbot_cscen(k)/(dz(i,k)) + + ! rce-comment 2 + ! code for k=pver was changed to use the following conceptual model + ! in k=pver, there can be no cloud-base activation unless one considers + ! a scenario such as the layer being partially cloudy, + ! with clear air at bottom and cloudy air at top + ! assume this scenario, and that the clear/cloudy portions mix with + ! a timescale taumix_internal = dz(i,pver)/wtke_cen(i,pver) + ! in the absence of other sources/sinks, qact (the activated particle + ! mixratio) attains a steady state value given by + ! qact_ss = fcloud*fact*qtot + ! where fcloud is cloud fraction, fact is activation fraction, + ! qtot=qact+qint, qint is interstitial particle mixratio + ! the activation rate (from mixing within the layer) can now be + ! written as + ! d(qact)/dt = (qact_ss - qact)/taumix_internal + ! = qtot*(fcloud*fact*wtke/dz) - qact*(wtke/dz) + ! note that (fcloud*fact*wtke/dz) is equal to the nact/mact + ! also, d(qact)/dt can be negative. in the code below + ! it is forced to be >= 0 + ! + ! steve -- + ! you will likely want to change this. i did not really understand + ! what was previously being done in k=pver + ! in the cam3_5_3 code, wtke(i,pver) appears to be equal to the + ! droplet deposition velocity which is quite small + ! in the cam3_5_37 version, wtke is done differently and is much + ! larger in k=pver, so the activation is stronger there + ! + if (k == pver) then + taumix_internal_pver_inv = flux_fullact(k)/dz(i,k) + end if + + do m = 1, ntot_amode + mm = mam_idx(m,0) + fluxn(m) = fluxn(m)*dumc + fluxm(m) = fluxm(m)*dumc + nact(k,m) = nact(k,m) + fluxn(m)*dum + mact(k,m) = mact(k,m) + fluxm(m)*dum + if (k < pver) then + ! note that kp1 is used here + fluxntot = fluxntot & + + fluxn(m)*raercol(kp1,mm,nsav)*cs(i,k) + else + tmpa = raercol(kp1,mm,nsav)*fluxn(m) & + + raercol_cw(kp1,mm,nsav)*(fluxn(m) & + - taumix_internal_pver_inv*dz(i,k)) + fluxntot = fluxntot + max(0.0_r8, tmpa)*cs(i,k) + end if + end do + srcn(k) = srcn(k) + fluxntot/(cs(i,k)*dz(i,k)) + nsource(i,k) = nsource(i,k) + fluxntot/(cs(i,k)*dz(i,k)) + + endif ! (cldn(i,k) - cldn(i,kp1) > 0.01 .or. k == pver) + + else + + ! no liquid cloud + nsource(i,k) = nsource(i,k) - qcld(k)*dtinv + qcld(k) = 0 + + if (cldn(i,k) < 0.01_r8) then + ! no ice cloud either + + ! convert activated aerosol to interstitial in decaying cloud + + do m = 1, ntot_amode + mm = mam_idx(m,0) + raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol + raercol_cw(k,mm,nsav) = 0._r8 + + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol + raercol_cw(k,mm,nsav) = 0._r8 + end do + end do + end if + end if + + end do ! old_cloud_main_k_loop + + ! switch nsav, nnew so that nnew is the updated aerosol + ntemp = nsav + nsav = nnew + nnew = ntemp + + ! load new droplets in layers above, below clouds + + dtmin = dtmicro + ekk(top_lev-1) = 0.0_r8 + ekk(pver) = 0.0_r8 + do k = top_lev, pver-1 + ! rce-comment -- ekd(k) is eddy-diffusivity at k/k+1 interface + ! want ekk(k) = ekd(k) * (density at k/k+1 interface) + ! so use pint(i,k+1) as pint is 1:pverp + ! ekk(k)=ekd(k)*2.*pint(i,k)/(rair*(temp(i,k)+temp(i,k+1))) + ! ekk(k)=ekd(k)*2.*pint(i,k+1)/(rair*(temp(i,k)+temp(i,k+1))) + ekk(k) = ekd(k)*csbot(k) + end do + + do k = top_lev, pver + km1 = max0(k-1, top_lev) + ekkp(k) = zn(k)*ekk(k)*zs(k) + ekkm(k) = zn(k)*ekk(k-1)*zs(km1) + tinv = ekkp(k) + ekkm(k) + + ! rce-comment -- tinv is the sum of all first-order-loss-rates + ! for the layer. for most layers, the activation loss rate + ! (for interstitial particles) is accounted for by the loss by + ! turb-transfer to the layer above. + ! k=pver is special, and the loss rate for activation within + ! the layer must be added to tinv. if not, the time step + ! can be too big, and explmix can produce negative values. + ! the negative values are reset to zero, resulting in an + ! artificial source. + if (k == pver) tinv = tinv + taumix_internal_pver_inv + + if (tinv .gt. 1.e-6_r8) then + dtt = 1._r8/tinv + dtmin = min(dtmin, dtt) + end if + end do + + dtmix = 0.9_r8*dtmin + nsubmix = dtmicro/dtmix + 1 + if (nsubmix > 100) then + nsubmix_bnd = 100 + else + nsubmix_bnd = nsubmix + end if + count_submix(nsubmix_bnd) = count_submix(nsubmix_bnd) + 1 + dtmix = dtmicro/nsubmix + + do k = top_lev, pver + kp1 = min(k+1, pver) + km1 = max(k-1, top_lev) + ! maximum overlap assumption + if (cldn(i,kp1) > 1.e-10_r8) then + overlapp(k) = min(cldn(i,k)/cldn(i,kp1), 1._r8) + else + overlapp(k) = 1._r8 + end if + if (cldn(i,km1) > 1.e-10_r8) then + overlapm(k) = min(cldn(i,k)/cldn(i,km1), 1._r8) + else + overlapm(k) = 1._r8 + end if + end do + + + ! rce-comment + ! the activation source(k) = mact(k,m)*raercol(kp1,lmass) + ! should not exceed the rate of transfer of unactivated particles + ! from kp1 to k which = ekkp(k)*raercol(kp1,lmass) + ! however it might if things are not "just right" in subr activate + ! the following is a safety measure to avoid negatives in explmix + do k = top_lev, pver-1 + do m = 1, ntot_amode + nact(k,m) = min( nact(k,m), ekkp(k) ) + mact(k,m) = min( mact(k,m), ekkp(k) ) + end do + end do + + + ! old_cloud_nsubmix_loop + do n = 1, nsubmix + qncld(:) = qcld(:) + ! switch nsav, nnew so that nsav is the updated aerosol + ntemp = nsav + nsav = nnew + nnew = ntemp + srcn(:) = 0.0_r8 + + do m = 1, ntot_amode + mm = mam_idx(m,0) + + ! update droplet source + ! rce-comment- activation source in layer k involves particles from k+1 + ! srcn(:)=srcn(:)+nact(:,m)*(raercol(:,mm,nsav)) + srcn(top_lev:pver-1) = srcn(top_lev:pver-1) + nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav)) + + ! rce-comment- new formulation for k=pver + ! srcn( pver )=srcn( pver )+nact( pver ,m)*(raercol( pver,mm,nsav)) + tmpa = raercol(pver,mm,nsav)*nact(pver,m) & + + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv) + srcn(pver) = srcn(pver) + max(0.0_r8,tmpa) + end do + call explmix( & + qcld, srcn, ekkp, ekkm, overlapp, & + overlapm, qncld, zero, zero, pver, & + dtmix, .false.) + + ! rce-comment + ! the interstitial particle mixratio is different in clear/cloudy portions + ! of a layer, and generally higher in the clear portion. (we have/had + ! a method for diagnosing the the clear/cloudy mixratios.) the activation + ! source terms involve clear air (from below) moving into cloudy air (above). + ! in theory, the clear-portion mixratio should be used when calculating + ! source terms + do m = 1, ntot_amode + mm = mam_idx(m,0) + ! rce-comment - activation source in layer k involves particles from k+1 + ! source(:)= nact(:,m)*(raercol(:,mm,nsav)) + source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav)) + ! rce-comment - new formulation for k=pver + ! source( pver )= nact( pver, m)*(raercol( pver,mm,nsav)) + tmpa = raercol(pver,mm,nsav)*nact(pver,m) & + + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv) + source(pver) = max(0.0_r8, tmpa) + flxconv = 0._r8 + + call explmix( & + raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & + dtmix, .false.) + + call explmix( & + raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & + dtmix, .true., raercol_cw(:,mm,nsav)) + + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + ! rce-comment - activation source in layer k involves particles from k+1 + ! source(:)= mact(:,m)*(raercol(:,mm,nsav)) + source(top_lev:pver-1) = mact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav)) + ! rce-comment- new formulation for k=pver + ! source( pver )= mact( pver ,m)*(raercol( pver,mm,nsav)) + tmpa = raercol(pver,mm,nsav)*mact(pver,m) & + + raercol_cw(pver,mm,nsav)*(mact(pver,m) - taumix_internal_pver_inv) + source(pver) = max(0.0_r8, tmpa) + flxconv = 0._r8 + + call explmix( & + raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & + dtmix, .false.) + + call explmix( & + raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & + dtmix, .true., raercol_cw(:,mm,nsav)) + + end do + end do + + if (called_from_spcam) then + ! + ! turbulent mixing for gas species . + ! + do m=1, pcnst + if (cnst_species_class(m) == cnst_spec_class_gas) then + flxconv = 0.0_r8 + zerogas(:) = 0.0_r8 + call explmix(rgascol(1,m,nnew),zerogas,ekkp,ekkm,overlapp,overlapm, & + rgascol(1,m,nsav),zero, flxconv, pver,dtmix,& + .true., zerogas) + end if + end do + endif + + end do ! old_cloud_nsubmix_loop + + ! evaporate particles again if no cloud (either ice or liquid) + + do k = top_lev, pver + if (cldn(i,k) == 0._r8) then + ! no ice or liquid cloud + qcld(k)=0._r8 + + ! convert activated aerosol to interstitial in decaying cloud + do m = 1, ntot_amode + mm = mam_idx(m,0) + raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew) + raercol_cw(k,mm,nnew) = 0._r8 + + do l = 1, nspec_amode(m) + mm = mam_idx(m,l) + raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew) + raercol_cw(k,mm,nnew) = 0._r8 + end do + end do + end if + end do + + ! droplet number + + ndropcol(i) = 0._r8 + do k = top_lev, pver + ndropmix(i,k) = (qcld(k) - ncldwtr(i,k))*dtinv - nsource(i,k) + tendnd(i,k) = (max(qcld(k), 1.e-6_r8) - ncldwtr(i,k))*dtinv + ndropcol(i) = ndropcol(i) + ncldwtr(i,k)*pdel(i,k) + end do + ndropcol(i) = ndropcol(i)/gravit + + if (prog_modal_aero) then + + raertend = 0._r8 + qqcwtend = 0._r8 + + do m = 1, ntot_amode + do l = 0, nspec_amode(m) + + mm = mam_idx(m,l) + lptr = mam_cnst_idx(m,l) + + raertend(top_lev:pver) = (raercol(top_lev:pver,mm,nnew) - raer(mm)%fld(i,top_lev:pver))*dtinv + qqcwtend(top_lev:pver) = (raercol_cw(top_lev:pver,mm,nnew) - qqcw(mm)%fld(i,top_lev:pver))*dtinv + + coltend(i,mm) = sum( pdel(i,:)*raertend )/gravit + coltend_cw(i,mm) = sum( pdel(i,:)*qqcwtend )/gravit + + ptend%q(i,:,lptr) = 0.0_r8 + ptend%q(i,top_lev:pver,lptr) = raertend(top_lev:pver) ! set tendencies for interstitial aerosol + qqcw(mm)%fld(i,:) = 0.0_r8 + qqcw(mm)%fld(i,top_lev:pver) = raercol_cw(top_lev:pver,mm,nnew) ! update cloud-borne aerosol + end do + end do + + end if + + if (called_from_spcam) then + ! + ! Gas tendency + ! + do m=1, pcnst + if (cnst_species_class(m) == cnst_spec_class_gas) then + ptend%lq(m) = .true. + ptend%q(i, :, m) = (rgascol(:,m,nnew)-rgas(i,:,m)) * dtinv + end if + end do + endif + + end do ! overall_main_i_loop + ! end of main loop over i/longitude .................................... + + call outfld('NDROPCOL', ndropcol, pcols, lchnk) + call outfld('NDROPSRC', nsource, pcols, lchnk) + call outfld('NDROPMIX', ndropmix, pcols, lchnk) + call outfld('WTKE ', wtke, pcols, lchnk) + + if(called_from_spcam) then + call outfld('SPLCLOUD ', cldn , pcols, lchnk ) + call outfld('SPKVH ', kvh , pcols, lchnk ) + endif + + call ccncalc(state, pbuf, cs, ccn) + do l = 1, psat + call outfld(ccn_name(l), ccn(1,1,l), pcols, lchnk) + enddo + + ! do column tendencies + if (prog_modal_aero) then + do m = 1, ntot_amode + do l = 0, nspec_amode(m) + mm = mam_idx(m,l) + call outfld(fieldname(mm), coltend(:,mm), pcols, lchnk) + call outfld(fieldname_cw(mm), coltend_cw(:,mm), pcols, lchnk) + end do + end do + end if + + if(called_from_spcam) then + ! + ! output column-integrated Gas tendency (this should be zero) + ! + do m=1, pcnst + if (cnst_species_class(m) == cnst_spec_class_gas) then + do i=1, ncol + coltendgas(i) = sum( pdel(i,:)*ptend%q(i,:,m) )/gravit + end do + fieldnamegas = trim(cnst_name(m)) // '_mixnuc1sp' + call outfld( trim(fieldnamegas), coltendgas, pcols, lchnk) + end if + end do + deallocate(rgascol, coltendgas) + end if + + deallocate( & + nact, & + mact, & + raer, & + qqcw, & + raercol, & + raercol_cw, & + coltend, & + coltend_cw, & + naermod, & + hygro, & + vaerosol, & + fn, & + fm, & + fluxn, & + fluxm ) + +end subroutine dropmixnuc + +!=============================================================================== + +subroutine explmix( q, src, ekkp, ekkm, overlapp, overlapm, & + qold, surfrate, flxconv, pver, dt, is_unact, qactold ) + + ! explicit integration of droplet/aerosol mixing + ! with source due to activation/nucleation + + + integer, intent(in) :: pver ! number of levels + real(r8), intent(out) :: q(pver) ! mixing ratio to be updated + real(r8), intent(in) :: qold(pver) ! mixing ratio from previous time step + real(r8), intent(in) :: src(pver) ! source due to activation/nucleation (/s) + real(r8), intent(in) :: ekkp(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface + ! below layer k (k,k+1 interface) + real(r8), intent(in) :: ekkm(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface + ! above layer k (k,k+1 interface) + real(r8), intent(in) :: overlapp(pver) ! cloud overlap below + real(r8), intent(in) :: overlapm(pver) ! cloud overlap above + real(r8), intent(in) :: surfrate ! surface exchange rate (/s) + real(r8), intent(in) :: flxconv ! convergence of flux from surface + real(r8), intent(in) :: dt ! time step (s) + logical, intent(in) :: is_unact ! true if this is an unactivated species + real(r8), intent(in),optional :: qactold(pver) + ! mixing ratio of ACTIVATED species from previous step + ! *** this should only be present + ! if the current species is unactivated number/sfc/mass + + integer k,kp1,km1 + + if ( is_unact ) then + ! the qactold*(1-overlap) terms are resuspension of activated material + do k=top_lev,pver + kp1=min(k+1,pver) + km1=max(k-1,top_lev) + q(k) = qold(k) + dt*( - src(k) + ekkp(k)*(qold(kp1) - qold(k) + & + qactold(kp1)*(1.0_r8-overlapp(k))) & + + ekkm(k)*(qold(km1) - qold(k) + & + qactold(km1)*(1.0_r8-overlapm(k))) ) + ! force to non-negative + ! if(q(k)<-1.e-30)then + ! write(iulog,*)'q=',q(k),' in explmix' + q(k)=max(q(k),0._r8) + ! endif + end do + + ! diffusion loss at base of lowest layer + q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt + ! force to non-negative + ! if(q(pver)<-1.e-30)then + ! write(iulog,*)'q=',q(pver),' in explmix' + q(pver)=max(q(pver),0._r8) + ! endif + else + do k=top_lev,pver + kp1=min(k+1,pver) + km1=max(k-1,top_lev) + q(k) = qold(k) + dt*(src(k) + ekkp(k)*(overlapp(k)*qold(kp1)-qold(k)) + & + ekkm(k)*(overlapm(k)*qold(km1)-qold(k)) ) + ! force to non-negative + ! if(q(k)<-1.e-30)then + ! write(iulog,*)'q=',q(k),' in explmix' + q(k)=max(q(k),0._r8) + ! endif + end do + ! diffusion loss at base of lowest layer + q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt + ! force to non-negative + ! if(q(pver)<-1.e-30)then + ! write(iulog,*)'q=',q(pver),' in explmix' + q(pver)=max(q(pver),0._r8) + + end if + +end subroutine explmix + +!=============================================================================== + +subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + na, nmode, volume, hygro, & + fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed, in_cloud_in, smax_f) + + ! calculates number, surface, and mass fraction of aerosols activated as CCN + ! calculates flux of cloud droplets, surface area, and aerosol mass into cloud + ! assumes an internal mixture within each of up to nmode multiple aerosol modes + ! a gaussiam spectrum of updrafts can be treated. + + ! mks units + + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. + + + ! input + + real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s) + real(r8), intent(in) :: sigw ! subgrid standard deviation of vertical vel (m/s) + real(r8), intent(in) :: wdiab ! diabatic vertical velocity (0 if adiabatic) + real(r8), intent(in) :: wminf ! minimum updraft velocity for integration (m/s) + real(r8), intent(in) :: wmaxf ! maximum updraft velocity for integration (m/s) + real(r8), intent(in) :: tair ! air temperature (K) + real(r8), intent(in) :: rhoair ! air density (kg/m3) + real(r8), intent(in) :: na(:) ! aerosol number concentration (/m3) + integer, intent(in) :: nmode ! number of aerosol modes + real(r8), intent(in) :: volume(:) ! aerosol volume concentration (m3/m3) + real(r8), intent(in) :: hygro(:) ! hygroscopicity of aerosol mode + + ! output + + real(r8), intent(out) :: fn(:) ! number fraction of aerosols activated + real(r8), intent(out) :: fm(:) ! mass fraction of aerosols activated + real(r8), intent(out) :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s) + real(r8), intent(out) :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s) + real(r8), intent(out) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) + ! rce-comment + ! used for consistency check -- this should match (ekd(k)*zs(k)) + ! also, fluxm/flux_fullact gives fraction of aerosol mass flux + ! that is activated + + ! optional + real(r8), optional, intent(in) :: smax_prescribed ! prescribed max. supersaturation for secondary activation + logical, optional, intent(in) :: in_cloud_in ! switch to modify calculations when above cloud base + real(r8), optional, intent(in) :: smax_f ! droplet and rain size distr factor in the smax calculation + ! used when in_cloud=.true. + + ! local + + integer, parameter:: nx=200 + integer iquasisect_option, isectional + real(r8) integ,integf + real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa) + real(r8) xmin(nmode),xmax(nmode) ! ln(r) at section interfaces + real(r8) volmin(nmode),volmax(nmode) ! volume at interfaces + real(r8) tmass ! total aerosol mass concentration (g/cm3) + real(r8) sign(nmode) ! geometric standard deviation of size distribution + real(r8) rm ! number mode radius of aerosol at max supersat (cm) + real(r8) pres ! pressure (Pa) + real(r8) path ! mean free path (m) + real(r8) diff ! diffusivity (m2/s) + real(r8) conduct ! thermal conductivity (Joule/m/sec/deg) + real(r8) diff0,conduct0 + real(r8) es ! saturation vapor pressure + real(r8) qs ! water vapor saturation mixing ratio + real(r8) dqsdt ! change in qs with temperature + real(r8) dqsdp ! change in qs with pressure + real(r8) g ! thermodynamic function (m2/s) + real(r8) zeta(nmode), eta(nmode) + real(r8) lnsmax ! ln(smax) + real(r8) alpha + real(r8) gamma + real(r8) beta + real(r8) sqrtg + real(r8) :: amcube(nmode) ! cube of dry mode radius (m) + real(r8) :: smcrit(nmode) ! critical supersatuation for activation + real(r8) :: lnsm(nmode) ! ln(smcrit) + real(r8) smc(nmode) ! critical supersaturation for number mode radius + real(r8) sumflx_fullact + real(r8) sumflxn(nmode) + real(r8) sumflxm(nmode) + real(r8) sumfn(nmode) + real(r8) sumfm(nmode) + real(r8) fnold(nmode) ! number fraction activated + real(r8) fmold(nmode) ! mass fraction activated + real(r8) wold,gold + real(r8) alogam + real(r8) rlo,rhi,xint1,xint2,xint3,xint4 + real(r8) wmin,wmax,w,dw,dwmax,dwmin,wnuc,dwnew,wb + real(r8) dfmin,dfmax,fnew,fold,fnmin,fnbar,fsbar,fmbar + real(r8) alw,sqrtalw + real(r8) smax + real(r8) x,arg + real(r8) xmincoeff,xcut,volcut,surfcut + real(r8) z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf + real(r8) etafactor1,etafactor2(nmode),etafactor2max + real(r8) grow + character(len=*), parameter :: subname='activate_modal' + + logical :: in_cloud + integer m,n + ! numerical integration parameters + real(r8), parameter :: eps=0.3_r8,fmax=0.99_r8,sds=3._r8 + + real(r8), parameter :: namin=1.e6_r8 ! minimum aerosol number concentration (/m3) + + integer ndist(nx) ! accumulates frequency distribution of integration bins required + data ndist/nx*0/ + save ndist + + if (present(in_cloud_in)) then + if (.not. present(smax_f)) call endrun('activate_modal error: smax_f must be supplied when in_cloud is used') + in_cloud = in_cloud_in + else + in_cloud = .false. + end if + + fn(:)=0._r8 + fm(:)=0._r8 + fluxn(:)=0._r8 + fluxm(:)=0._r8 + flux_fullact=0._r8 + + if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return + + if(sigw.le.1.e-5_r8.and.wbar.le.0._r8)return + + if ( present( smax_prescribed ) ) then + if (smax_prescribed <= 0.0_r8) return + end if + + pres=rair*rhoair*tair + diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94_r8 + conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg + call qsat(tair, pres, es, qs) + dqsdt=latvap/(rh2o*tair*tair)*qs + alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1._r8/(rair*tair)) + gamma=(1.0_r8+latvap/cpair*dqsdt)/(rhoair*qs) + etafactor2max=1.e10_r8/(alpha*wmaxf)**1.5_r8 ! this should make eta big if na is very small. + + grow = 1._r8/(rhoh2o/(diff0*rhoair*qs) & + + latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair) - 1._r8)) + sqrtg = sqrt(grow) + beta = 2._r8*pi*rhoh2o*grow*gamma + + do m=1,nmode + + if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then + ! number mode radius (m) + ! write(iulog,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m) + amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist + ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 + ! should depend on mean radius of mode to account for gas kinetic effects + ! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006 + ! for approriate size to use for effective diffusivity. + etafactor2(m)=1._r8/(na(m)*beta*sqrtg) + if(hygro(m).gt.1.e-10_r8)then + smc(m)=2._r8*aten*sqrt(aten/(27._r8*hygro(m)*amcube(m))) ! only if variable size dist + else + smc(m)=100._r8 + endif + ! write(iulog,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m) + else + smc(m)=1._r8 + etafactor2(m)=etafactor2max ! this should make eta big if na is very small. + endif + lnsm(m)=log(smc(m)) ! only if variable size dist + ! write(iulog,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', & + ! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m) + enddo + + if(sigw.gt.1.e-5_r8)then ! spectrum of updrafts + + wmax=min(wmaxf,wbar+sds*sigw) + wmin=max(wminf,-wdiab) + wmin=max(wmin,wbar-sds*sigw) + w=wmin + dwmax=eps*sigw + dw=dwmax + dfmax=0.2_r8 + dfmin=0.1_r8 + if (wmax <= w) return + do m=1,nmode + sumflxn(m)=0._r8 + sumfn(m)=0._r8 + fnold(m)=0._r8 + sumflxm(m)=0._r8 + sumfm(m)=0._r8 + fmold(m)=0._r8 + enddo + sumflx_fullact=0._r8 + + fold=0._r8 + wold=0._r8 + gold=0._r8 + + dwmin = min( dwmax, 0.01_r8 ) + do n = 1, nx + +100 wnuc=w+wdiab + ! write(iulog,*)'wnuc=',wnuc + alw=alpha*wnuc + sqrtalw=sqrt(alw) + etafactor1=alw*sqrtalw + + do m=1,nmode + eta(m)=etafactor1*etafactor2(m) + zeta(m)=twothird*sqrtalw*aten/sqrtg + enddo + + if ( present( smax_prescribed ) ) then + smax = smax_prescribed + else + call maxsat(zeta,eta,nmode,smc,smax) + endif + ! write(iulog,*)'w,smax=',w,smax + + lnsmax=log(smax) + + x=twothird*(lnsm(nmode)-lnsmax)/(sq2*alogsig(nmode)) + fnew=0.5_r8*(1._r8-erf(x)) + + + dwnew = dw + if(fnew-fold.gt.dfmax.and.n.gt.1)then + ! reduce updraft increment for greater accuracy in integration + if (dw .gt. 1.01_r8*dwmin) then + dw=0.7_r8*dw + dw=max(dw,dwmin) + w=wold+dw + go to 100 + else + dwnew = dwmin + endif + endif + + if(fnew-fold.lt.dfmin)then + ! increase updraft increment to accelerate integration + dwnew=min(1.5_r8*dw,dwmax) + endif + fold=fnew + + z=(w-wbar)/(sigw*sq2) + g=exp(-z*z) + fnmin=1._r8 + xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 + + do m=1,nmode + ! modal + x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) + fn(m)=0.5_r8*(1._r8-erf(x)) + fnmin=min(fn(m),fnmin) + ! integration is second order accurate + ! assumes linear variation of f*g with w + fnbar=(fn(m)*g+fnold(m)*gold) + arg=x-1.5_r8*sq2*alogsig(m) + fm(m)=0.5_r8*(1._r8-erf(arg)) + fmbar=(fm(m)*g+fmold(m)*gold) + wb=(w+wold) + if(w.gt.0._r8)then + sumflxn(m)=sumflxn(m)+sixth*(wb*fnbar & + +(fn(m)*g*w+fnold(m)*gold*wold))*dw + sumflxm(m)=sumflxm(m)+sixth*(wb*fmbar & + +(fm(m)*g*w+fmold(m)*gold*wold))*dw + endif + sumfn(m)=sumfn(m)+0.5_r8*fnbar*dw + ! write(iulog,'(a,9g10.2)')'lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw=',lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw + fnold(m)=fn(m) + sumfm(m)=sumfm(m)+0.5_r8*fmbar*dw + fmold(m)=fm(m) + enddo + ! same form as sumflxm but replace the fm with 1.0 + sumflx_fullact = sumflx_fullact & + + sixth*(wb*(g+gold) + (g*w+gold*wold))*dw + ! sumg=sumg+0.5_r8*(g+gold)*dw + gold=g + wold=w + dw=dwnew + if (n > 1 .and. (w > wmax .or. fnmin > fmax)) exit + w=w+dw + if (n == nx) then + write(iulog,*)'do loop is too short in activate' + write(iulog,*)'wmin=',wmin,' w=',w,' wmax=',wmax,' dw=',dw + write(iulog,*)'wbar=',wbar,' sigw=',sigw,' wdiab=',wdiab + write(iulog,*)'wnuc=',wnuc + write(iulog,*)'na=',(na(m),m=1,nmode) + write(iulog,*)'fn=',(fn(m),m=1,nmode) + ! dump all subr parameters to allow testing with standalone code + ! (build a driver that will read input and call activate) + write(iulog,*)'wbar,sigw,wdiab,tair,rhoair,nmode=' + write(iulog,*) wbar,sigw,wdiab,tair,rhoair,nmode + write(iulog,*)'na=',na + write(iulog,*)'volume=', (volume(m),m=1,nmode) + write(iulog,*)'hydro=' + write(iulog,*) hygro + call endrun(subname) + end if + + enddo + + ndist(n)=ndist(n)+1 + if(w.lt.wmaxf)then + + ! contribution from all updrafts stronger than wmax + ! assuming constant f (close to fmax) + wnuc=w+wdiab + + z1=(w-wbar)/(sigw*sq2) + z2=(wmaxf-wbar)/(sigw*sq2) + g=exp(-z1*z1) + integ=sigw*0.5_r8*sq2*sqpi*(erf(z2)-erf(z1)) + ! consider only upward flow into cloud base when estimating flux + wf1=max(w,zero) + zf1=(wf1-wbar)/(sigw*sq2) + gf1=exp(-zf1*zf1) + wf2=max(wmaxf,zero) + zf2=(wf2-wbar)/(sigw*sq2) + gf2=exp(-zf2*zf2) + gf=(gf1-gf2) + integf=wbar*sigw*0.5_r8*sq2*sqpi*(erf(zf2)-erf(zf1))+sigw*sigw*gf + + do m=1,nmode + sumflxn(m)=sumflxn(m)+integf*fn(m) + sumfn(m)=sumfn(m)+fn(m)*integ + sumflxm(m)=sumflxm(m)+integf*fm(m) + sumfm(m)=sumfm(m)+fm(m)*integ + enddo + ! same form as sumflxm but replace the fm with 1.0 + sumflx_fullact = sumflx_fullact + integf + ! sumg=sumg+integ + endif + + + do m=1,nmode + fn(m)=sumfn(m)/(sq2*sqpi*sigw) + ! fn(m)=sumfn(m)/(sumg) + if(fn(m).gt.1.01_r8)then + write(iulog,*)'fn=',fn(m),' > 1 in activate' + write(iulog,*)'w,m,na,amcube=',w,m,na(m),amcube(m) + write(iulog,*)'integ,sumfn,sigw=',integ,sumfn(m),sigw + call endrun('activate') + endif + fluxn(m)=sumflxn(m)/(sq2*sqpi*sigw) + fm(m)=sumfm(m)/(sq2*sqpi*sigw) + ! fm(m)=sumfm(m)/(sumg) + if(fm(m).gt.1.01_r8)then + write(iulog,*)'fm=',fm(m),' > 1 in activate' + endif + fluxm(m)=sumflxm(m)/(sq2*sqpi*sigw) + enddo + ! same form as fluxm + flux_fullact = sumflx_fullact/(sq2*sqpi*sigw) + + else + + ! single updraft + wnuc=wbar+wdiab + + if(wnuc.gt.0._r8)then + + w=wbar + + if(in_cloud) then + + if (smax_f > 0._r8) then + smax = alpha*w/(2.0_r8*pi*rhoh2o*grow*gamma*smax_f) + else + smax = 1.e-20_r8 + end if + + else ! at cloud base + alw = alpha*wnuc + sqrtalw = sqrt(alw) + etafactor1 = alw*sqrtalw + + do m = 1, nmode + eta(m) = etafactor1*etafactor2(m) + zeta(m) = twothird*sqrtalw*aten/sqrtg + end do + if ( present(smax_prescribed) ) then + smax = smax_prescribed + else + call maxsat(zeta, eta, nmode, smc, smax) + end if + end if + + lnsmax=log(smax) + xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 + + + do m=1,nmode + ! modal + x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) + fn(m)=0.5_r8*(1._r8-erf(x)) + arg=x-1.5_r8*sq2*alogsig(m) + fm(m)=0.5_r8*(1._r8-erf(arg)) + if(wbar.gt.0._r8)then + fluxn(m)=fn(m)*w + fluxm(m)=fm(m)*w + endif + enddo + flux_fullact = w + endif + + endif + +end subroutine activate_modal + +!=============================================================================== + +subroutine maxsat(zeta,eta,nmode,smc,smax) + + ! calculates maximum supersaturation for multiple + ! competing aerosol modes. + + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. + + integer, intent(in) :: nmode ! number of modes + real(r8), intent(in) :: smc(nmode) ! critical supersaturation for number mode radius + real(r8), intent(in) :: zeta(nmode) + real(r8), intent(in) :: eta(nmode) + real(r8), intent(out) :: smax ! maximum supersaturation + integer :: m ! mode index + real(r8) :: sum, g1, g2, g1sqrt, g2sqrt + + do m=1,nmode + if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then + ! weak forcing. essentially none activated + smax=1.e-20_r8 + else + ! significant activation of this mode. calc activation all modes. + exit + endif + ! No significant activation in any mode. Do nothing. + if (m == nmode) return + + enddo + + sum=0.0_r8 + do m=1,nmode + if(eta(m).gt.1.e-20_r8)then + g1=zeta(m)/eta(m) + g1sqrt=sqrt(g1) + g1=g1sqrt*g1 + g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) + g2sqrt=sqrt(g2) + g2=g2sqrt*g2 + sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m)) + else + sum=1.e20_r8 + endif + enddo + + smax=1._r8/sqrt(sum) + +end subroutine maxsat + +!=============================================================================== + +subroutine ccncalc(state, pbuf, cs, ccn) + + ! calculates number concentration of aerosols activated as CCN at + ! supersaturation supersat. + ! assumes an internal mixture of a multiple externally-mixed aerosol modes + ! cgs units + + ! Ghan et al., Atmos. Res., 1993, 198-221. + + ! arguments + + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + + real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3) + real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3) + + ! local + + integer :: lchnk ! chunk index + integer :: ncol ! number of columns + real(r8), pointer :: tair(:,:) ! air temperature (K) + + real(r8) naerosol(pcols) ! interstit+activated aerosol number conc (/m3) + real(r8) vaerosol(pcols) ! interstit+activated aerosol volume conc (m3/m3) + + real(r8) amcube(pcols) + real(r8) super(psat) ! supersaturation + real(r8), allocatable :: amcubecoef(:) + real(r8), allocatable :: argfactor(:) + real(r8) :: surften ! surface tension of water w/respect to air (N/m) + real(r8) surften_coef + real(r8) a(pcols) ! surface tension parameter + real(r8) hygro(pcols) ! aerosol hygroscopicity + real(r8) sm(pcols) ! critical supersaturation at mode radius + real(r8) arg(pcols) + ! mathematical constants + real(r8) twothird,sq2 + integer l,m,n,i,k + real(r8) log,cc + real(r8) smcoefcoef,smcoef(pcols) + integer phase ! phase of aerosol + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + tair => state%t + + allocate( & + amcubecoef(ntot_amode), & + argfactor(ntot_amode) ) + + super(:)=supersat(:)*0.01_r8 + sq2=sqrt(2._r8) + twothird=2._r8/3._r8 + surften=0.076_r8 + surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o) + smcoefcoef=2._r8/sqrt(27._r8) + + do m=1,ntot_amode + amcubecoef(m)=3._r8/(4._r8*pi*exp45logsig(m)) + argfactor(m)=twothird/(sq2*alogsig(m)) + end do + + ccn = 0._r8 + do k=top_lev,pver + + do i=1,ncol + a(i)=surften_coef/tair(i,k) + smcoef(i)=smcoefcoef*a(i)*sqrt(a(i)) + end do + + do m=1,ntot_amode + + phase=3 ! interstitial+cloudborne + + call loadaer( & + state, pbuf, 1, ncol, k, & + m, cs, phase, naerosol, vaerosol, & + hygro) + + where(naerosol(:ncol)>1.e-3_r8) + amcube(:ncol)=amcubecoef(m)*vaerosol(:ncol)/naerosol(:ncol) + sm(:ncol)=smcoef(:ncol)/sqrt(hygro(:ncol)*amcube(:ncol)) ! critical supersaturation + elsewhere + sm(:ncol)=1._r8 ! value shouldn't matter much since naerosol is small + endwhere + do l=1,psat + do i=1,ncol + arg(i)=argfactor(m)*log(sm(i)/super(l)) + ccn(i,k,l)=ccn(i,k,l)+naerosol(i)*0.5_r8*(1._r8-erf(arg(i))) + enddo + enddo + enddo + enddo + ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3 + + deallocate( & + amcubecoef, & + argfactor ) + +end subroutine ccncalc + +!=============================================================================== + +subroutine loadaer( & + state, pbuf, istart, istop, k, & + m, cs, phase, naerosol, & + vaerosol, hygro) + + ! return aerosol number, volume concentrations, and bulk hygroscopicity + + ! input arguments + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode index + integer, intent(in) :: k ! level index + real(r8), intent(in) :: cs(:,:) ! air density (kg/m3) + integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum + + ! output arguments + real(r8), intent(out) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3) + real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode + + ! internal + integer :: lchnk ! chunk identifier + + real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios + real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios + real(r8) :: specdens, spechygro + + real(r8) :: vol(pcols) ! aerosol volume mixing ratio + integer :: i, l + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + + do i = istart, istop + vaerosol(i) = 0._r8 + hygro(i) = 0._r8 + end do + + do l = 1, nspec_amode(m) + + call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer) + call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw) + call rad_cnst_get_aer_props(0, m, l, density_aer=specdens, hygro_aer=spechygro) + + if (phase == 3) then + do i = istart, istop + vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 2) then + do i = istart, istop + vol(i) = max(qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 1) then + do i = istart, istop + vol(i) = max(raer(i,k), 0._r8)/specdens + end do + else + write(iulog,*)'phase=',phase,' in loadaer' + call endrun('phase error in loadaer') + end if + + do i = istart, istop + vaerosol(i) = vaerosol(i) + vol(i) + hygro(i) = hygro(i) + vol(i)*spechygro + end do + + end do + + do i = istart, istop + if (vaerosol(i) > 1.0e-30_r8) then ! +++xl add 8/2/2007 + hygro(i) = hygro(i)/(vaerosol(i)) + vaerosol(i) = vaerosol(i)*cs(i,k) + else + hygro(i) = 0.0_r8 + vaerosol(i) = 0.0_r8 + end if + end do + + ! aerosol number + call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer) + call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw) + if (phase == 3) then + do i = istart, istop + naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k) + end do + else if (phase == 2) then + do i = istart, istop + naerosol(i) = qqcw(i,k)*cs(i,k) + end do + else + do i = istart, istop + naerosol(i) = raer(i,k)*cs(i,k) + end do + end if + ! adjust number so that dgnumlo < dgnum < dgnumhi + do i = istart, istop + naerosol(i) = max(naerosol(i), vaerosol(i)*voltonumbhi_amode(m)) + naerosol(i) = min(naerosol(i), vaerosol(i)*voltonumblo_amode(m)) + end do + +end subroutine loadaer + +!=============================================================================== + +end module ndrop + + + + diff --git a/src/physics/cam/ndrop_bam.F90 b/src/physics/cam/ndrop_bam.F90 new file mode 100644 index 0000000000..6cd8231356 --- /dev/null +++ b/src/physics/cam/ndrop_bam.F90 @@ -0,0 +1,499 @@ +module ndrop_bam + +!--------------------------------------------------------------------------------- +! +! CAM Interface for droplet activation by bulk aerosols. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp +use physconst, only: gravit, rair, tmelt, cpair, rh2o, & + r_universal, mwh2o, rhoh2o, latvap + +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_props + +use shr_spfn_mod, only: erf => shr_spfn_erf, & + erfc => shr_spfn_erfc +use wv_saturation, only: qsat +use cam_history, only: addfld, add_default, outfld +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use ref_pres, only: top_lev=>trop_cloud_top_lev + +implicit none +private +save + +public :: ndrop_bam_init, ndrop_bam_run, ndrop_bam_ccn + +! activate parameters + +real(r8) :: pi ! pi +integer, parameter :: psat = 6 ! number of supersaturations to calc ccn concentration +real(r8), parameter :: supersat(psat) = & ! supersaturation (%) to determine ccn concentration + (/0.02_r8,0.05_r8,0.1_r8,0.2_r8,0.5_r8,1.0_r8/) +real(r8) :: super(psat) +real(r8), allocatable :: ccnfact(:,:) + +real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol +real(r8), allocatable :: exp45logsig(:) +real(r8), allocatable :: argfactor(:) +real(r8), allocatable :: amcube(:) ! cube of dry mode radius (m) +real(r8), allocatable :: smcrit(:) ! critical supersatuation for activation +real(r8), allocatable :: lnsm(:) ! ln(smcrit) +real(r8), allocatable :: amcubefactor(:) ! factors for calculating mode radius +real(r8), allocatable :: smcritfactor(:) ! factors for calculating critical supersaturation +real(r8), allocatable :: f1(:), f2(:) ! abdul-razzak functions of width + +real(r8) :: aten +real(r8) :: third, sixth +real(r8) :: sq2, sqpi +real(r8) :: alogten, alog2, alog3, alogaten + +real(r8) :: pref = 1013.25e2_r8 ! reference pressure (Pa) + +! aerosol properties +character(len=20), allocatable :: aername(:) +real(r8), allocatable :: dryrad_aer(:) +real(r8), allocatable :: density_aer(:) +real(r8), allocatable :: hygro_aer(:) +real(r8), allocatable :: dispersion_aer(:) +real(r8), allocatable :: num_to_mass_aer(:) + +integer :: naer_all ! number of aerosols affecting climate +integer :: idxsul = -1 ! index in aerosol list for sulfate + +!=============================================================================== +contains +!=============================================================================== + +subroutine ndrop_bam_init + + use phys_control, only: phys_getopts + + !----------------------------------------------------------------------- + ! + ! Initialize constants for droplet activation by bulk aerosols + ! + !----------------------------------------------------------------------- + + integer :: l, m, iaer + real(r8) :: surften ! surface tension of water w/respect to air (N/m) + real(r8) :: arg + logical :: history_amwg + !------------------------------------------------------------------------------- + + call phys_getopts(history_amwg_out=history_amwg) + + ! Access the physical properties of the bulk aerosols that are affecting the climate + ! by using routines from the rad_constituents module. + + call rad_cnst_get_info(0, naero=naer_all) + allocate( & + aername(naer_all), & + dryrad_aer(naer_all), & + density_aer(naer_all), & + hygro_aer(naer_all), & + dispersion_aer(naer_all), & + num_to_mass_aer(naer_all) ) + + do iaer = 1, naer_all + call rad_cnst_get_aer_props(0, iaer, & + aername = aername(iaer), & + dryrad_aer = dryrad_aer(iaer), & + density_aer = density_aer(iaer), & + hygro_aer = hygro_aer(iaer), & + dispersion_aer = dispersion_aer(iaer), & + num_to_mass_aer = num_to_mass_aer(iaer) ) + + ! Look for sulfate aerosol in this list (Bulk aerosol only) + if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer + + ! aerosol number concentration + call addfld(trim(aername(iaer))//'_m3', (/ 'lev' /), 'A', 'm-3', 'aerosol number concentration') + + end do + + if (masterproc) then + write(iulog,*) 'ndrop_bam_init: iaer, name, dryrad, density, hygro, dispersion, num_to_mass' + do iaer = 1, naer_all + write(iulog,*) iaer, aername(iaer), dryrad_aer(iaer), density_aer(iaer), hygro_aer(iaer), & + dispersion_aer(iaer), num_to_mass_aer(iaer) + end do + if (idxsul < 1) then + write(iulog,*) 'ndrop_bam_init: SULFATE aerosol properties NOT FOUND' + else + write(iulog,*) 'ndrop_bam_init: SULFATE aerosol properties FOUND at index ',idxsul + end if + end if + + call addfld ('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%') + call addfld ('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%') + call addfld ('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%') + call addfld ('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%') + call addfld ('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%') + call addfld ('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%') + + if (history_amwg) then + call add_default('CCN3', 1, ' ') + end if + + ! set parameters for droplet activation, following abdul-razzak and ghan 2000, JGR + + third = 1._r8/3._r8 + sixth = 1._r8/6._r8 + sq2 = sqrt(2._r8) + pi = 4._r8*atan(1.0_r8) + sqpi = sqrt(pi) + surften = 0.076_r8 + aten = 2._r8*mwh2o*surften/(r_universal*tmelt*rhoh2o) + alogaten= log(aten) + alog2 = log(2._r8) + alog3 = log(3._r8) + super(:)= 0.01_r8*supersat(:) + + allocate( & + alogsig(naer_all), & + exp45logsig(naer_all), & + argfactor(naer_all), & + f1(naer_all), & + f2(naer_all), & + amcubefactor(naer_all), & + smcritfactor(naer_all), & + amcube(naer_all), & + smcrit(naer_all), & + lnsm(naer_all), & + ccnfact(psat,naer_all) ) + + + do m = 1, naer_all + + ! Skip aerosols that don't have a dispersion defined. + if (dispersion_aer(m) == 0._r8) cycle + + alogsig(m) = log(dispersion_aer(m)) + exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) + argfactor(m) = 2._r8/(3._r8*sqrt(2._r8)*alogsig(m)) + f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m)) + f2(m) = 1._r8 + 0.25_r8*alogsig(m) + amcubefactor(m)= 3._r8/(4._r8*pi*exp45logsig(m)*density_aer(m)) + smcritfactor(m)= 2._r8*aten*sqrt(aten/(27._r8*max(1.e-10_r8,hygro_aer(m)))) + amcube(m) = amcubefactor(m)/num_to_mass_aer(m) + + if (hygro_aer(m) .gt. 1.e-10_r8) then + smcrit(m) = smcritfactor(m)/sqrt(amcube(m)) + else + smcrit(m) = 100._r8 + endif + lnsm(m) = log(smcrit(m)) + + do l = 1, psat + arg = argfactor(m)*log(smcrit(m)/super(l)) + if (arg < 2) then + if (arg < -2) then + ccnfact(l,m) = 1.e-6_r8 + else + ccnfact(l,m) = 1.e-6_r8*0.5_r8*erfc(arg) + endif + else + ccnfact(l,m) = 0._r8 + endif + enddo + + end do + +end subroutine ndrop_bam_init + +!=============================================================================== + +subroutine ndrop_bam_run( & + wbar, tair, rhoair, na, pmode, & + nmode, ma, nact) + + ! calculates number fraction of aerosols activated as CCN + ! assumes an internal mixture within each of up to pmode multiple aerosol modes + ! a gaussian spectrum of updrafts can be treated. + + ! mks units + + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. + + ! input + integer, intent(in) :: pmode ! dimension of modes + integer, intent(in) :: nmode ! number of aerosol modes + real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s) + real(r8), intent(in) :: tair ! air temperature (K) + real(r8), intent(in) :: rhoair ! air density (kg/m3) + real(r8), intent(in) :: na(pmode) ! aerosol number concentration (1/m3) + real(r8), intent(in) :: ma(pmode) ! aerosol mass concentration (kg/m3) + + ! output + real(r8), intent(out) :: nact ! number fraction of aerosols activated + + ! local variables + integer :: maxmodes + + real(r8), allocatable :: volc(:) ! total aerosol volume concentration (m3/m3) + real(r8), allocatable :: eta(:) + real(r8), allocatable :: smc(:) + real(r8), allocatable :: etafactor2(:) + real(r8), allocatable :: amcubeloc(:) + real(r8), allocatable :: lnsmloc(:) + + real(r8) :: pres ! pressure (Pa) + real(r8) :: diff0 + real(r8) :: conduct0 ! thermal conductivity (Joule/m/sec/deg) + real(r8) :: qs ! water vapor saturation mixing ratio + real(r8) :: dqsdt ! change in qs with temperature + real(r8) :: gloc ! thermodynamic function (m2/s) + real(r8) :: zeta + real(r8) :: lnsmax ! ln(smax) + real(r8) :: alpha + real(r8) :: gammaloc + real(r8) :: beta + real(r8) :: sqrtg + real(r8) :: wnuc + real(r8) :: alw + real(r8) :: sqrtalw + real(r8) :: smax + real(r8) :: x + real(r8) :: etafactor1 + real(r8) :: etafactor2max + real(r8) :: es + integer :: m + !------------------------------------------------------------------------------- + + maxmodes = naer_all + allocate( & + volc(maxmodes), & + eta(maxmodes), & + smc(maxmodes), & + etafactor2(maxmodes), & + amcubeloc(maxmodes), & + lnsmloc(maxmodes) ) + + if (maxmodes < pmode) then + write(iulog,*)'ndrop_bam_run: maxmodes,pmode=',maxmodes,pmode + call endrun('ndrop_bam_run') + endif + + nact = 0._r8 + + if (nmode .eq. 1 .and. na(1) .lt. 1.e-20_r8) return + + if (wbar .le. 0._r8) return + + pres = rair*rhoair*tair + diff0 = 0.211e-4_r8*(pref/pres)*(tair/tmelt)**1.94_r8 + conduct0 = (5.69_r8 + 0.017_r8*(tair-tmelt))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg + call qsat(tair, pres, es, qs) + dqsdt = latvap/(rh2o*tair*tair)*qs + alpha = gravit*(latvap/(cpair*rh2o*tair*tair) - 1._r8/(rair*tair)) + gammaloc = (1 + latvap/cpair*dqsdt)/(rhoair*qs) + ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 + ! should depend on mean radius of mode to account for gas kinetic effects + gloc = 1._r8/(rhoh2o/(diff0*rhoair*qs) & + + latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair) - 1._r8)) + sqrtg = sqrt(gloc) + beta = 4._r8*pi*rhoh2o*gloc*gammaloc + etafactor2max = 1.e10_r8/(alpha*wbar)**1.5_r8 ! this should make eta big if na is very small. + + do m = 1, nmode + ! skip aerosols with no dispersion, since they aren't meant to be CCN + if (dispersion_aer(m) == 0._r8) then + smc(m)=100._r8 + cycle + end if + ! internal mixture of aerosols + volc(m) = ma(m)/(density_aer(m)) ! only if variable size dist + if (volc(m) > 1.e-39_r8 .and. na(m) > 1.e-39_r8) then + etafactor2(m) = 1._r8/(na(m)*beta*sqrtg) !fixed or variable size dist + ! number mode radius (m) + amcubeloc(m) = (3._r8*volc(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist + smc(m) = smcrit(m) ! only for prescribed size dist + + if (hygro_aer(m) > 1.e-10_r8) then ! loop only if variable size dist + smc(m) = 2._r8*aten*sqrt(aten/(27._r8*hygro_aer(m)*amcubeloc(m))) + else + smc(m) = 100._r8 + endif + else + smc(m) = 1._r8 + etafactor2(m) = etafactor2max ! this should make eta big if na is very small. + end if + lnsmloc(m) = log(smc(m)) ! only if variable size dist + end do + + ! single updraft + wnuc = wbar + alw = alpha*wnuc + sqrtalw = sqrt(alw) + zeta = 2._r8*sqrtalw*aten/(3._r8*sqrtg) + etafactor1 = 2._r8*alw*sqrtalw + + do m = 1, nmode + ! skip aerosols with no dispersion, since they aren't meant to be CCN + if (dispersion_aer(m) /= 0._r8) eta(m) = etafactor1*etafactor2(m) + end do + + call maxsat(zeta, eta, nmode, smc, smax) + lnsmax = log(smax) + + nact = 0._r8 + do m = 1, nmode + ! skip aerosols with no dispersion, since they aren't meant to be CCN + if (dispersion_aer(m) == 0._r8) cycle + x = 2*(lnsmloc(m) - lnsmax)/(3*sq2*alogsig(m)) + nact = nact + 0.5_r8*(1._r8 - erf(x))*na(m) + end do + nact = nact/rhoair ! convert from #/m3 to #/kg + + deallocate( & + volc, & + eta, & + smc, & + etafactor2, & + amcubeloc, & + lnsmloc ) + +end subroutine ndrop_bam_run + +!=============================================================================== + +subroutine ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) + + !------------------------------------------------------------------------------- + ! + ! Write diagnostic bulk aerosol ccn concentration + ! + !------------------------------------------------------------------------------- + + ! Input arguments + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns + real(r8), intent(in) :: naer2(:,:,:) ! aerosol number concentration (1/m3) + real(r8), intent(in) :: maerosol(:,:,:) ! aerosol mass conc (kg/m3) + + ! Local variables + integer :: i, k, l, m + real(r8) :: arg + + character*8, parameter :: ccn_name(psat)=(/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6'/) + real(r8) :: amcubesulfate(pcols) ! cube of dry mode radius (m) of sulfate + real(r8) :: smcritsulfate(pcols) ! critical supersatuation for activation of sulfate + real(r8) :: ccnfactsulfate + real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat + !------------------------------------------------------------------------------- + + ccn(:ncol,:,:) = 0._r8 + + do k = top_lev, pver + + do m = 1, naer_all + + if (m == idxsul) then + ! Lohmann treatment for sulfate has variable size distribution + do i = 1, ncol + if (naer2(i,k,m) > 0._r8) then + amcubesulfate(i) = amcubefactor(m)*maerosol(i,k,m)/(naer2(i,k,m)) + smcritsulfate(i) = smcritfactor(m)/sqrt(amcubesulfate(i)) + else + smcritsulfate(i) = 1._r8 + end if + end do + end if + + do l = 1, psat + + if (m == idxsul) then + ! This code is modifying ccnfact for sulfate only. + do i = 1, ncol + arg = argfactor(m)*log(smcritsulfate(i)/super(l)) + if (arg < 2) then + if (arg < -2) then + ccnfactsulfate = 1.0e-6_r8 + else + ccnfactsulfate = 0.5e-6_r8*erfc(arg) + end if + else + ccnfactsulfate = 0.0_r8 + end if + ccn(i,k,l) = ccn(i,k,l) + naer2(i,k,m)*ccnfactsulfate + end do + else + ! Non-sulfate species use ccnfact computed by the init routine + ccn(:ncol,k,l) = ccn(:ncol,k,l) + naer2(:ncol,k,m)*ccnfact(l,m) + end if + + end do ! supersaturation + end do ! bulk aerosol + end do ! level + + do l = 1, psat + call outfld(ccn_name(l), ccn(1,1,l), pcols, lchnk) + end do + + do l = 1, naer_all + call outfld(trim(aername(l))//'_m3', naer2(:,:,l), pcols, lchnk) + end do + +end subroutine ndrop_bam_ccn + +!=============================================================================== + +subroutine maxsat(zeta, eta, nmode, smc, smax) + + ! calculates maximum supersaturation for multiple + ! competing aerosol modes. + + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. + + real(r8), intent(in) :: zeta + integer, intent(in) :: nmode ! number of modes + real(r8), intent(in) :: smc(:) ! critical supersaturation for number mode radius + real(r8), intent(in) :: eta(:) + + real(r8), intent(out) :: smax ! maximum supersaturation + + integer :: m ! mode index + real(r8) :: sum, g1, g2 + + do m=1,nmode + if(zeta.gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then + ! weak forcing. essentially none activated + smax=1.e-20_r8 + else + ! significant activation of this mode. calc activation all modes. + go to 1 + endif + enddo + + return + +1 continue + + sum=0 + do m=1,nmode + if(eta(m).gt.1.e-20_r8)then + g1=sqrt(zeta/eta(m)) + g1=g1*g1*g1 + g2=smc(m)/sqrt(eta(m)+3*zeta) + g2=sqrt(g2) + g2=g2*g2*g2 + sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m)) + else + sum=1.e20_r8 + endif + enddo + + smax=1._r8/sqrt(sum) + +end subroutine maxsat + +!=============================================================================== + +end module ndrop_bam diff --git a/src/physics/cam/nucleate_ice.F90 b/src/physics/cam/nucleate_ice.F90 new file mode 100644 index 0000000000..b005305123 --- /dev/null +++ b/src/physics/cam/nucleate_ice.F90 @@ -0,0 +1,573 @@ +module nucleate_ice + +!------------------------------------------------------------------------------- +! Purpose: +! A parameterization of ice nucleation. +! +! *** This module is intended to be a "portable" code layer. Ideally it should +! *** not contain any use association of modules that belong to the model framework. +! +! +! Method: +! The current method is based on Liu & Penner (2005) & Liu et al. (2007) +! It related the ice nucleation with the aerosol number, temperature and the +! updraft velocity. It includes homogeneous freezing of sulfate & immersion +! freezing on mineral dust (soot disabled) in cirrus clouds, and +! Meyers et al. (1992) deposition nucleation in mixed-phase clouds +! +! The effect of preexisting ice crystals on ice nucleation in cirrus clouds is included, +! and also consider the sub-grid variability of temperature in cirrus clouds, +! following X. Shi et al. ACP (2014). +! +! Ice nucleation in mixed-phase clouds now uses classical nucleation theory (CNT), +! follows Y. Wang et al. ACP (2014), Hoose et al. (2010). +! +! Authors: +! Xiaohong Liu, 01/2005, modifications by A. Gettelman 2009-2010 +! Xiangjun Shi & Xiaohong Liu, 01/2014. +! +! With help from C. C. Chen and B. Eaton (2014) +!------------------------------------------------------------------------------- + +use wv_saturation, only: svp_water, svp_ice + +implicit none +private +save + +integer, parameter :: r8 = selected_real_kind(12) + +public :: nucleati_init, nucleati + +logical :: use_preexisting_ice +logical :: use_hetfrz_classnuc +logical :: use_incloud_nuc +integer :: iulog +real(r8) :: pi +real(r8) :: mincld + +real(r8), parameter :: Shet = 1.3_r8 ! het freezing threshold +real(r8), parameter :: rhoice = 0.5e3_r8 ! kg/m3, Wpice is not sensitive to rhoice +real(r8), parameter :: minweff= 0.001_r8 ! m/s +real(r8), parameter :: gamma1=1.0_r8 +real(r8), parameter :: gamma2=1.0_r8 +real(r8), parameter :: gamma3=2.0_r8 +real(r8), parameter :: gamma4=6.0_r8 + +real(r8) :: ci + +!=============================================================================== +contains +!=============================================================================== + +subroutine nucleati_init( & + use_preexisting_ice_in, use_hetfrz_classnuc_in, use_incloud_nuc_in, iulog_in, pi_in, & + mincld_in) + + logical, intent(in) :: use_preexisting_ice_in + logical, intent(in) :: use_hetfrz_classnuc_in + logical, intent(in) :: use_incloud_nuc_in + integer, intent(in) :: iulog_in + real(r8), intent(in) :: pi_in + real(r8), intent(in) :: mincld_in + + use_preexisting_ice = use_preexisting_ice_in + use_hetfrz_classnuc = use_hetfrz_classnuc_in + use_incloud_nuc = use_incloud_nuc_in + iulog = iulog_in + pi = pi_in + mincld = mincld_in + + ci = rhoice*pi/6._r8 + +end subroutine nucleati_init + +!=============================================================================== + +subroutine nucleati( & + wbar, tair, pmid, relhum, cldn, & + qc, qi, ni_in, rhoair, & + so4_num, dst_num, soot_num, subgrid, & + nuci, onihf, oniimm, onidep, onimey, & + wpice, weff, fhom, regm, & + oso4_num, odst_num, osoot_num, call_frm_zm_in) + + ! Input Arguments + real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s) + real(r8), intent(in) :: tair ! temperature (K) + real(r8), intent(in) :: pmid ! pressure at layer midpoints (pa) + real(r8), intent(in) :: relhum ! relative humidity with respective to liquid + real(r8), intent(in) :: cldn ! new value of cloud fraction (fraction) + real(r8), intent(in) :: qc ! liquid water mixing ratio (kg/kg) + real(r8), intent(in) :: qi ! grid-mean preexisting cloud ice mass mixing ratio (kg/kg) + real(r8), intent(in) :: ni_in ! grid-mean preexisting cloud ice number conc (#/kg) + real(r8), intent(in) :: rhoair ! air density (kg/m3) + real(r8), intent(in) :: so4_num ! so4 aerosol number (#/cm^3) + real(r8), intent(in) :: dst_num ! total dust aerosol number (#/cm^3) + real(r8), intent(in) :: soot_num ! soot (hydrophilic) aerosol number (#/cm^3) + real(r8), intent(in) :: subgrid ! subgrid saturation scaling factor + + ! Output Arguments + real(r8), intent(out) :: nuci ! ice number nucleated (#/kg) + real(r8), intent(out) :: onihf ! nucleated number from homogeneous freezing of so4 + real(r8), intent(out) :: oniimm ! nucleated number from immersion freezing + real(r8), intent(out) :: onidep ! nucleated number from deposition nucleation + real(r8), intent(out) :: onimey ! nucleated number from deposition nucleation (meyers: mixed phase) + real(r8), intent(out) :: wpice ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at Shom + real(r8), intent(out) :: weff ! effective Vertical velocity for ice nucleation (m/s); weff=wbar-wpice + real(r8), intent(out) :: fhom ! how much fraction of cloud can reach Shom + real(r8), intent(out) :: regm ! nucleation regime indiator + real(r8), intent(out) :: oso4_num ! so4 aerosol number (#/cm^3) + real(r8), intent(out) :: odst_num ! total dust aerosol number (#/cm^3) + real(r8), intent(out) :: osoot_num ! soot (hydrophilic) aerosol number (#/cm^3) + + ! Optional Arguments + logical, intent(in), optional :: call_frm_zm_in ! true if called from ZM convection scheme + + ! Local workspace + real(r8) :: nihf ! nucleated number from homogeneous freezing of so4 + real(r8) :: niimm ! nucleated number from immersion freezing + real(r8) :: nidep ! nucleated number from deposition nucleation + real(r8) :: nimey ! nucleated number from deposition nucleation (meyers) + real(r8) :: n1, ni ! nucleated number + real(r8) :: tc, A, B ! work variable + real(r8) :: esl, esi, deles ! work variable + real(r8) :: wbar1, wbar2 + + ! used in SUBROUTINE Vpreice + real(r8) :: Ni_preice ! cloud ice number conc (1/m3) + real(r8) :: lami,Ri_preice ! mean cloud ice radius (m) + real(r8) :: Shom ! initial ice saturation ratio; if <1, use hom threshold Si + real(r8) :: detaT,RHimean ! temperature standard deviation, mean cloudy RHi + real(r8) :: wpicehet ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at shet + + real(r8) :: weffhet ! effective Vertical velocity for ice nucleation (m/s) weff=wbar-wpicehet + + logical :: call_frm_zm + !------------------------------------------------------------------------------- + + RHimean = relhum*svp_water(tair)/svp_ice(tair)*subgrid + + ! temp variables that depend on use_preexisting_ice + wbar1 = wbar + wbar2 = wbar + + ! If not using prexisting ice, the homogeneous freezing happens in the + ! entire gridbox. + fhom = 1._r8 + + if (present(call_frm_zm_in)) then + call_frm_zm = call_frm_zm_in + else + call_frm_zm = .false. + end if + + if (use_preexisting_ice .and. (.not. call_frm_zm)) then + + Ni_preice = ni_in*rhoair ! (convert from #/kg -> #/m3) + Ni_preice = Ni_preice / max(mincld,cldn) ! in-cloud ice number density + + if (Ni_preice > 10.0_r8 .and. qi > 1.e-10_r8) then ! > 0.01/L = 10/m3 + Shom = -1.5_r8 ! if Shom<1 , Shom will be recalculated in SUBROUTINE Vpreice, according to Ren & McKenzie, 2005 + lami = (gamma4*ci*ni_in/qi)**(1._r8/3._r8) + Ri_preice = 0.5_r8/lami ! radius + Ri_preice = max(Ri_preice, 1e-8_r8) ! >0.01micron + call Vpreice(pmid, tair, Ri_preice, Ni_preice, Shom, wpice) + call Vpreice(pmid, tair, Ri_preice, Ni_preice, Shet, wpicehet) + else + wpice = 0.0_r8 + wpicehet = 0.0_r8 + endif + + weff = max(wbar-wpice, minweff) + wpice = min(wpice, wbar) + weffhet = max(wbar-wpicehet,minweff) + wpicehet = min(wpicehet, wbar) + + wbar1 = weff + wbar2 = weffhet + + detaT = wbar/0.23_r8 + if (use_incloud_nuc) then + call frachom(tair, 1._r8, detaT, fhom) + else + call frachom(tair, RHimean, detaT, fhom) + end if + end if + + ni = 0._r8 + tc = tair - 273.15_r8 + + ! initialize + niimm = 0._r8 + nidep = 0._r8 + nihf = 0._r8 + deles = 0._r8 + esi = 0._r8 + regm = 0._r8 + + oso4_num = 0._r8 + odst_num = 0._r8 + osoot_num = 0._r8 + + if ((so4_num >= 1.0e-10_r8 .or. (soot_num+dst_num) >= 1.0e-10_r8) .and. cldn > 0._r8) then + + if (RHimean.ge.1.2_r8) then + + if ( ((tc.le.0.0_r8).and.(tc.ge.-37.0_r8).and.(qc.lt.1.e-12_r8)).or.(tc.le.-37.0_r8)) then + + A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 + B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 + regm = A * log(wbar1) + B + + ! heterogeneous nucleation only + if (tc .gt. regm .or. so4_num < 1.0e-10_r8) then + + if(tc.lt.-40._r8 .and. wbar1.gt.1._r8 .and. so4_num >= 1.0e-10_r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation + + call hf(tc,wbar1,relhum*subgrid,so4_num,nihf) + niimm=0._r8 + nidep=0._r8 + + ! If some homogeneous nucleation happened, assume all of the that heterogeneous + ! and coarse mode sulfate particles nucleated. + if (nihf.gt.1e-3_r8) then ! hom occur, add preexisting ice + niimm = dst_num + soot_num ! assuming dst_num freeze firstly + odst_num = dst_num + osoot_num = soot_num + + oso4_num = nihf + endif + + nihf = nihf * fhom + oso4_num = oso4_num * fhom + + n1 = nihf + niimm + else + + call hetero(tc,wbar2,soot_num+dst_num,niimm,nidep) + + nihf = 0._r8 + n1 = niimm + nidep + + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + endif + + ! homogeneous nucleation only + else if (tc.lt.regm-5._r8 .or. (soot_num+dst_num) < 1.0e-10_r8) then + + call hf(tc,wbar1,relhum*subgrid,so4_num,nihf) + niimm=0._r8 + nidep=0._r8 + + ! If some homogeneous nucleation happened, assume all of the that + ! heterogeneous and coarse mode sulfate particles nucleated. + if (nihf.gt.1e-3_r8) then ! hom occur, add preexisting ice + niimm = dst_num + soot_num ! assuming dst_num freeze firstly + odst_num = dst_num + osoot_num = soot_num + + oso4_num = nihf + endif + + nihf = nihf * fhom + oso4_num = oso4_num * fhom + + n1 = nihf + niimm + + ! transition between homogeneous and heterogeneous: interpolate in-between + else + + if (tc.lt.-40._r8 .and. wbar1.gt.1._r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation + + call hf(tc, wbar1, relhum*subgrid, so4_num, nihf) + niimm = 0._r8 + nidep = 0._r8 + + ! If some homogeneous nucleation happened, assume all of the + ! that heterogeneous and coarse mode sulfate particles nucleated. + if (nihf.gt.1e-3_r8) then ! hom occur, add preexisting ice + niimm = dst_num + soot_num ! assuming dst_num freeze firstly + odst_num = dst_num + osoot_num = soot_num + + oso4_num = nihf + endif + + nihf = nihf * fhom + oso4_num = oso4_num * fhom + + n1 = nihf + niimm + + else + + call hf(regm-5._r8,wbar1,relhum*subgrid,so4_num,nihf) + call hetero(regm,wbar2,soot_num+dst_num,niimm,nidep) + + ! If some homogeneous nucleation happened, assume all of the + ! heterogeneous particles nucleated and add in a fraction of + ! the homogeneous freezing. + if (nihf.gt.1e-3_r8) then ! hom occur, add preexisting ice + oso4_num = nihf + endif + + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + + nihf = nihf * fhom * ((regm - tc) / 5._r8)**2 + oso4_num = oso4_num * fhom * ((regm - tc) / 5._r8)**2 + + n1 = niimm + nidep + nihf + + end if + end if + + ! Scale the rates for in-cloud number, since this is what + ! MG is expecting to find. + ni = n1 + + ! If using prexsiting ice, then add it to the total. + if (use_preexisting_ice .and. (.not. call_frm_zm)) then + ni = ni + Ni_preice * 1e-6_r8 + end if + end if + end if + end if + + ! deposition/condensation nucleation in mixed clouds (-37-64 deg) + A22_fast =-6.045_r8 !(T<=-64 deg) + B1_fast =-0.008_r8 + B21_fast =-0.042_r8 !(T>-64 deg) + B22_fast =-0.112_r8 !(T<=-64 deg) + C1_fast =0.0739_r8 + C2_fast =1.2372_r8 + + A1_slow =-0.3949_r8 + A2_slow =1.282_r8 + B1_slow =-0.0156_r8 + B2_slow =0.0111_r8 + B3_slow =0.0217_r8 + C1_slow =0.120_r8 + C2_slow =2.312_r8 + + Ni = 0.0_r8 + +!---------------------------- +!RHw parameters + A = 6.0e-4_r8*log(ww)+6.6e-3_r8 + B = 6.0e-2_r8*log(ww)+1.052_r8 + C = 1.68_r8 *log(ww)+129.35_r8 + RHw=(A*T*T+B*T+C)*0.01_r8 + + if((T.le.-37.0_r8) .and. ((RH).ge.RHw)) then + + regm = 6.07_r8*log(ww)-55.0_r8 + + if(T.ge.regm) then ! fast-growth regime + + if(T.gt.-64.0_r8) then + A2_fast=A21_fast + B2_fast=B21_fast + else + A2_fast=A22_fast + B2_fast=B22_fast + endif + + k1_fast = exp(A2_fast + B2_fast*T + C2_fast*log(ww)) + k2_fast = A1_fast+B1_fast*T+C1_fast*log(ww) + + Ni = k1_fast*Na**(k2_fast) + Ni = min(Ni,Na) + + else ! slow-growth regime + + k1_slow = exp(A2_slow + (B2_slow+B3_slow*log(ww))*T + C2_slow*log(ww)) + k2_slow = A1_slow+B1_slow*T+C1_slow*log(ww) + + Ni = k1_slow*Na**(k2_slow) + Ni = min(Ni,Na) + + endif + + end if + +end subroutine hf + +!=============================================================================== + +SUBROUTINE Vpreice(P_in, T_in, R_in, C_in, S_in, V_out) + + ! based on Karcher et al. (2006) + ! VERTICAL VELOCITY CALCULATED FROM DEPOSITIONAL LOSS TERM + + ! SUBROUTINE arguments + REAL(r8), INTENT(in) :: P_in ! [Pa],INITIAL AIR pressure + REAL(r8), INTENT(in) :: T_in ! [K] ,INITIAL AIR temperature + REAL(r8), INTENT(in) :: R_in ! [m],INITIAL MEAN ICE CRYSTAL NUMBER RADIUS + REAL(r8), INTENT(in) :: C_in ! [m-3],INITIAL TOTAL ICE CRYSTAL NUMBER DENSITY, [1/cm3] + REAL(r8), INTENT(in) :: S_in ! [-],INITIAL ICE SATURATION RATIO;; if <1, use hom threshold Si + REAL(r8), INTENT(out) :: V_out ! [m/s], VERTICAL VELOCITY REDUCTION (caused by preexisting ice) + + ! SUBROUTINE parameters + REAL(r8), PARAMETER :: ALPHAc = 0.5_r8 ! density of ice (g/cm3), !!!V is not related to ALPHAc + REAL(r8), PARAMETER :: FA1c = 0.601272523_r8 + REAL(r8), PARAMETER :: FA2c = 0.000342181855_r8 + REAL(r8), PARAMETER :: FA3c = 1.49236645E-12_r8 + REAL(r8), PARAMETER :: WVP1c = 3.6E+10_r8 + REAL(r8), PARAMETER :: WVP2c = 6145.0_r8 + REAL(r8), PARAMETER :: FVTHc = 11713803.0_r8 + REAL(r8), PARAMETER :: THOUBKc = 7.24637701E+18_r8 + REAL(r8), PARAMETER :: SVOLc = 3.23E-23_r8 ! SVOL=XMW/RHOICE + REAL(r8), PARAMETER :: FDc = 249.239822_r8 + REAL(r8), PARAMETER :: FPIVOLc = 3.89051704E+23_r8 + REAL(r8) :: T,P,S,R,C + REAL(r8) :: A1,A2,A3,B1,B2 + REAL(r8) :: T_1,PICE,FLUX,ALP4,CISAT,DLOSS,VICE + + T = T_in ! K , K + P = P_in*1e-2_r8 ! Pa , hpa + + IF (S_in.LT.1.0_r8) THEN + S = 2.349_r8 - (T/259.0_r8) ! homogeneous freezing threshold, according to Ren & McKenzie, 2005 + ELSE + S = S_in ! INPUT ICE SATURATION RATIO, -, >1 + ENDIF + + R = R_in*1e2_r8 ! m => cm + C = C_in*1e-6_r8 ! m-3 => cm-3 + T_1 = 1.0_r8/ T + PICE = WVP1c * EXP(-(WVP2c*T_1)) + ALP4 = 0.25_r8 * ALPHAc + FLUX = ALP4 * SQRT(FVTHc*T) + CISAT = THOUBKc * PICE * T_1 + A1 = ( FA1c * T_1 - FA2c ) * T_1 + A2 = 1.0_r8/ CISAT + A3 = FA3c * T_1 / P + B1 = FLUX * SVOLc * CISAT * ( S-1.0_r8 ) + B2 = FLUX * FDc * P * T_1**1.94_r8 + DLOSS = FPIVOLc * C * B1 * R**2 / ( 1.0_r8+ B2 * R ) + VICE = ( A2 + A3 * S ) * DLOSS / ( A1 * S ) ! 2006,(19) + V_out = VICE*1e-2_r8 ! cm/s => m/s + +END SUBROUTINE Vpreice + +subroutine frachom(Tmean,RHimean,detaT,fhom) + ! How much fraction of cirrus might reach Shom + ! base on "A cirrus cloud scheme for general circulation models", + ! B. Karcher and U. Burkhardt 2008 + + real(r8), intent(in) :: Tmean, RHimean, detaT + real(r8), intent(out) :: fhom + + real(r8), parameter :: seta = 6132.9_r8 ! K + integer, parameter :: Nbin=200 ! (Tmean - 3*detaT, Tmean + 3*detaT) + + real(r8) :: PDF_T(Nbin) ! temperature PDF; ! PDF_T=0 outside (Tmean-3*detaT, Tmean+3*detaT) + real(r8) :: Sbin(Nbin) ! the fluctuations of Si that are driven by the T variations + real(r8) :: Sihom, deta + integer :: i + + Sihom = 2.349_r8-Tmean/259.0_r8 ! homogeneous freezing threshold, according to Ren & McKenzie, 2005 + fhom = 0.0_r8 + + do i = Nbin, 1, -1 + + deta = (i - 0.5_r8 - Nbin/2)*6.0_r8/Nbin ! PDF_T=0 outside (Tmean-3*detaT, Tmean+3*detaT) + Sbin(i) = RHimean*exp(deta*detaT*seta/Tmean**2.0_r8) + PDF_T(i) = exp(-deta**2.0_r8/2.0_r8)*6.0_r8/(sqrt(2.0_r8*Pi)*Nbin) + + + if (Sbin(i).ge.Sihom) then + fhom = fhom + PDF_T(i) + else + exit + end if + end do + + fhom = min(1.0_r8, fhom/0.997_r8) ! accounting for the finite limits (-3 , 3) +end subroutine frachom + +end module nucleate_ice + diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 new file mode 100644 index 0000000000..dcc59f0c4e --- /dev/null +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -0,0 +1,856 @@ +module nucleate_ice_cam + +!--------------------------------------------------------------------------------- +! +! CAM Interfaces for nucleate_ice module. +! +! B. Eaton - Sept 2014 +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver +use physconst, only: pi, rair, tmelt +use constituents, only: pcnst, cnst_get_ind +use physics_types, only: physics_state, physics_ptend, physics_ptend_init +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use phys_control, only: use_hetfrz_classnuc +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & + rad_cnst_get_mode_num, rad_cnst_get_mode_props, rad_cnst_get_mode_num_idx, & + rad_cnst_get_mam_mmr_idx + +use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, & + pbuf_get_index, pbuf_get_field +use cam_history, only: addfld, add_default, outfld + +use ref_pres, only: top_lev => trop_cloud_top_lev +use wv_saturation, only: qsat_water, svp_water, svp_ice +use shr_spfn_mod, only: erf => shr_spfn_erf + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use nucleate_ice, only: nucleati_init, nucleati + + +implicit none +private +save + +public :: & + nucleate_ice_cam_readnl, & + nucleate_ice_cam_register, & + nucleate_ice_cam_init, & + nucleate_ice_cam_calc + + +! Namelist variables +logical, public, protected :: use_preexisting_ice = .false. +logical :: hist_preexisting_ice = .false. +logical :: nucleate_ice_incloud = .false. +logical :: nucleate_ice_use_troplev = .false. +real(r8) :: nucleate_ice_subgrid = -1._r8 +real(r8) :: nucleate_ice_subgrid_strat = -1._r8 +real(r8) :: nucleate_ice_strat = 0.0_r8 + +! Vars set via init method. +real(r8) :: mincld ! minimum allowed cloud fraction +real(r8) :: bulk_scale ! prescribed aerosol bulk sulfur scale factor + +! constituent indices +integer :: & + cldliq_idx = -1, & + cldice_idx = -1, & + numice_idx = -1 + +integer :: & + naai_idx, & + naai_hom_idx + +integer :: & + ast_idx = -1, & + dgnum_idx = -1 + +integer :: & + qsatfac_idx + +! Bulk aerosols +character(len=20), allocatable :: aername(:) +real(r8), allocatable :: num_to_mass_aer(:) + +integer :: naer_all ! number of aerosols affecting climate +integer :: idxsul = -1 ! index in aerosol list for sulfate +integer :: idxdst1 = -1 ! index in aerosol list for dust1 +integer :: idxdst2 = -1 ! index in aerosol list for dust2 +integer :: idxdst3 = -1 ! index in aerosol list for dust3 +integer :: idxdst4 = -1 ! index in aerosol list for dust4 +integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHIL) + +! modal aerosols +logical :: clim_modal_aero +logical :: prog_modal_aero + +integer :: nmodes = -1 +integer :: mode_accum_idx = -1 ! index of accumulation mode +integer :: mode_aitken_idx = -1 ! index of aitken mode +integer :: mode_coarse_idx = -1 ! index of coarse mode +integer :: mode_coarse_dst_idx = -1 ! index of coarse dust mode +integer :: mode_coarse_slt_idx = -1 ! index of coarse sea salt mode +integer :: coarse_dust_idx = -1 ! index of dust in coarse mode +integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode +integer :: coarse_so4_idx = -1 ! index of sulfate in coarse mode + +logical :: separate_dust = .false. +real(r8) :: sigmag_aitken +real(r8) :: sigmag_accum + +logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies +integer :: cnum_idx, cdst_idx, cso4_idx + +!=============================================================================== +contains +!=============================================================================== + +subroutine nucleate_ice_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'nucleate_ice_cam_readnl' + + namelist /nucleate_ice_nl/ use_preexisting_ice, hist_preexisting_ice, & + nucleate_ice_subgrid, nucleate_ice_subgrid_strat, nucleate_ice_strat, & + nucleate_ice_incloud, nucleate_ice_use_troplev + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'nucleate_ice_nl', status=ierr) + if (ierr == 0) then + read(unitn, nucleate_ice_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + + ! Broadcast namelist variables + call mpi_bcast(use_preexisting_ice, 1, mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(hist_preexisting_ice, 1, mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(nucleate_ice_subgrid, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(nucleate_ice_subgrid_strat, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(nucleate_ice_strat, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(nucleate_ice_incloud, 1, mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(nucleate_ice_use_troplev, 1, mpi_logical,masterprocid, mpicom, ierr) + +end subroutine nucleate_ice_cam_readnl + +!================================================================================================ + +subroutine nucleate_ice_cam_register() + + call pbuf_add_field('NAAI', 'physpkg', dtype_r8, (/pcols,pver/), naai_idx) + call pbuf_add_field('NAAI_HOM', 'physpkg', dtype_r8, (/pcols,pver/), naai_hom_idx) + +end subroutine nucleate_ice_cam_register + +!================================================================================================ + +subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in) + use phys_control, only: phys_getopts + + real(r8), intent(in) :: mincld_in + real(r8), intent(in) :: bulk_scale_in + + ! local variables + integer :: iaer + integer :: ierr + integer :: m, n, nspec + + character(len=32) :: str32 + character(len=*), parameter :: routine = 'nucleate_ice_cam_init' + logical :: history_cesm_forcing + !-------------------------------------------------------------------------------------------- + call phys_getopts(prog_modal_aero_out = prog_modal_aero, history_cesm_forcing_out = history_cesm_forcing) + + mincld = mincld_in + bulk_scale = bulk_scale_in + + if( masterproc ) then + write(iulog,*) 'nucleate_ice parameters:' + write(iulog,*) ' mincld = ', mincld_in + write(iulog,*) ' bulk_scale = ', bulk_scale_in + write(iulog,*) ' use_preexisiting_ice = ', use_preexisting_ice + write(iulog,*) ' hist_preexisiting_ice = ', hist_preexisting_ice + write(iulog,*) ' nucleate_ice_subgrid = ', nucleate_ice_subgrid + write(iulog,*) ' nucleate_ice_subgrid_strat = ', nucleate_ice_subgrid_strat + write(iulog,*) ' nucleate_ice_strat = ', nucleate_ice_strat + write(iulog,*) ' nucleate_ice_incloud = ', nucleate_ice_incloud + write(iulog,*) ' nucleate_ice_use_troplev = ', nucleate_ice_use_troplev + end if + + call cnst_get_ind('CLDLIQ', cldliq_idx) + call cnst_get_ind('CLDICE', cldice_idx) + call cnst_get_ind('NUMICE', numice_idx) + qsatfac_idx = pbuf_get_index('QSATFAC', ierr) + + if (((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) .and. (qsatfac_idx .eq. -1)) then + call endrun(routine//': ERROR qsatfac is required when subgrid = -1 or subgrid_strat = -1') + end if + + call addfld('NIHF', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to homogenous freezing') + call addfld('NIDEP', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to deposition nucleation') + call addfld('NIIMM', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to immersion freezing') + call addfld('NIMEY', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to meyers deposition') + + call addfld('NIREGM',(/ 'lev' /), 'A', 'C', 'Ice Nucleation Temperature Threshold for Regime') + call addfld('NISUBGRID',(/ 'lev' /), 'A', '', 'Ice Nucleation subgrid saturation factor') + call addfld('NITROP_PD',(/ 'lev' /), 'A', '', 'Chemical Tropopause probability') + if ( history_cesm_forcing ) then + call add_default('NITROP_PD',8,' ') + endif + + if (use_preexisting_ice) then + call addfld('fhom', (/ 'lev' /), 'A','fraction', 'Fraction of cirrus where homogeneous freezing occur' ) + call addfld ('WICE', (/ 'lev' /), 'A','m/s','Vertical velocity Reduction caused by preexisting ice' ) + call addfld ('WEFF', (/ 'lev' /), 'A','m/s','Effective Vertical velocity for ice nucleation' ) + call addfld ('INnso4', (/ 'lev' /), 'A','1/m3','Number Concentation so4 (in) to ice_nucleation') + call addfld ('INnbc', (/ 'lev' /), 'A','1/m3','Number Concentation bc (in) to ice_nucleation') + call addfld ('INndust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (in) ice_nucleation') + call addfld ('INondust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (out) from ice_nucleation') + call addfld ('INhet', (/ 'lev' /), 'A','1/m3', & + 'contribution for in-cloud ice number density increase by het nucleation in ice cloud') + call addfld ('INhom', (/ 'lev' /), 'A','1/m3', & + 'contribution for in-cloud ice number density increase by hom nucleation in ice cloud') + call addfld ('INFrehom', (/ 'lev' /), 'A','frequency','hom IN frequency ice cloud') + call addfld ('INFreIN', (/ 'lev' /), 'A','frequency','frequency of ice nucleation occur') + + if (hist_preexisting_ice) then + call add_default ('WSUBI ', 1, ' ') ! addfld/outfld calls are in microp_aero + + call add_default ('fhom ', 1, ' ') + call add_default ('WICE ', 1, ' ') + call add_default ('WEFF ', 1, ' ') + call add_default ('INnso4 ', 1, ' ') + call add_default ('INnbc ', 1, ' ') + call add_default ('INndust ', 1, ' ') + call add_default ('INhet ', 1, ' ') + call add_default ('INhom ', 1, ' ') + call add_default ('INFrehom', 1, ' ') + call add_default ('INFreIN ', 1, ' ') + end if + end if + + ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. + ! The modal aerosols can be either prognostic or prescribed. + call rad_cnst_get_info(0, nmodes=nmodes) + clim_modal_aero = (nmodes > 0) + + if (clim_modal_aero) then + + dgnum_idx = pbuf_get_index('DGNUM' ) + + ! Init indices for specific modes/species + + ! mode index for specified mode types + do m = 1, nmodes + call rad_cnst_get_info(0, m, mode_type=str32) + select case (trim(str32)) + case ('accum') + mode_accum_idx = m + case ('aitken') + mode_aitken_idx = m + case ('coarse') + mode_coarse_idx = m + case ('coarse_dust') + mode_coarse_dst_idx = m + case ('coarse_seasalt') + mode_coarse_slt_idx = m + end select + end do + + ! check if coarse dust is in separate mode + separate_dust = mode_coarse_dst_idx > 0 + + ! for 3-mode + if (mode_coarse_dst_idx < 0) mode_coarse_dst_idx = mode_coarse_idx + if (mode_coarse_slt_idx < 0) mode_coarse_slt_idx = mode_coarse_idx + + ! Check that required mode types were found + if (mode_accum_idx == -1 .or. mode_aitken_idx == -1 .or. & + mode_coarse_dst_idx == -1.or. mode_coarse_slt_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + mode_accum_idx, mode_aitken_idx, mode_coarse_dst_idx, mode_coarse_slt_idx + call endrun(routine//': ERROR required mode type not found') + end if + + ! species indices for specified types + ! find indices for the dust, seasalt and sulfate species in the coarse mode + call rad_cnst_get_info(0, mode_coarse_dst_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_dst_idx, n, spec_type=str32) + select case (trim(str32)) + case ('dust') + coarse_dust_idx = n + end select + end do + call rad_cnst_get_info(0, mode_coarse_slt_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_slt_idx, n, spec_type=str32) + select case (trim(str32)) + case ('seasalt') + coarse_nacl_idx = n + end select + end do + if (mode_coarse_idx>0) then + call rad_cnst_get_info(0, mode_coarse_idx, nspec=nspec) + do n = 1, nspec + call rad_cnst_get_info(0, mode_coarse_idx, n, spec_type=str32) + select case (trim(str32)) + case ('sulfate') + coarse_so4_idx = n + end select + end do + endif + + ! Check that required mode specie types were found + if ( coarse_dust_idx == -1 .or. coarse_nacl_idx == -1 ) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + coarse_dust_idx, coarse_nacl_idx + call endrun(routine//': ERROR required mode-species type not found') + end if + + + ! get specific mode properties + call rad_cnst_get_mode_props(0, mode_aitken_idx, sigmag=sigmag_aitken) + call rad_cnst_get_mode_props(0, mode_accum_idx, sigmag=sigmag_accum) + + if (prog_modal_aero) then + call rad_cnst_get_mode_num_idx(mode_coarse_dst_idx, cnum_idx) + call rad_cnst_get_mam_mmr_idx(mode_coarse_dst_idx, coarse_dust_idx, cdst_idx) + if (mode_coarse_idx>0) then + call rad_cnst_get_mam_mmr_idx(mode_coarse_idx, coarse_so4_idx, cso4_idx) + end if + lq(cnum_idx) = .true. + lq(cdst_idx) = .true. + endif + + else + + ! Props needed for BAM number concentration calcs. + + call rad_cnst_get_info(0, naero=naer_all) + allocate( & + aername(naer_all), & + num_to_mass_aer(naer_all) ) + + do iaer = 1, naer_all + call rad_cnst_get_aer_props(0, iaer, & + aername = aername(iaer), & + num_to_mass_aer = num_to_mass_aer(iaer)) + ! Look for sulfate, dust, and soot in this list (Bulk aerosol only) + if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer + if (trim(aername(iaer)) == 'DUST1') idxdst1 = iaer + if (trim(aername(iaer)) == 'DUST2') idxdst2 = iaer + if (trim(aername(iaer)) == 'DUST3') idxdst3 = iaer + if (trim(aername(iaer)) == 'DUST4') idxdst4 = iaer + if (trim(aername(iaer)) == 'BCPHIL') idxbcphi = iaer + end do + end if + + + call nucleati_init(use_preexisting_ice, use_hetfrz_classnuc, nucleate_ice_incloud, iulog, pi, & + mincld) + + ! get indices for fields in the physics buffer + ast_idx = pbuf_get_index('AST') + +end subroutine nucleate_ice_cam_init + +!================================================================================================ + +subroutine nucleate_ice_cam_calc( & + state, wsubi, pbuf, dtime, ptend) + + use tropopause, only: tropopause_findChemTrop + + ! arguments + type(physics_state), target, intent(in) :: state + real(r8), intent(in) :: wsubi(:,:) + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: dtime + type(physics_ptend), intent(out) :: ptend + + ! local workspace + + ! naai and naai_hom are the outputs shared with the microphysics + real(r8), pointer :: naai(:,:) ! number of activated aerosol for ice nucleation + real(r8), pointer :: naai_hom(:,:) ! number of activated aerosol for ice nucleation (homogeneous freezing only) + + integer :: lchnk, ncol + integer :: itim_old + integer :: i, k, m + + real(r8), pointer :: t(:,:) ! input temperature (K) + real(r8), pointer :: qn(:,:) ! input water vapor mixing ratio (kg/kg) + real(r8), pointer :: qc(:,:) ! cloud water mixing ratio (kg/kg) + real(r8), pointer :: qi(:,:) ! cloud ice mixing ratio (kg/kg) + real(r8), pointer :: ni(:,:) ! cloud ice number conc (1/kg) + real(r8), pointer :: pmid(:,:) ! pressure at layer midpoints (pa) + + real(r8), pointer :: num_accum(:,:) ! number m.r. of accumulation mode + real(r8), pointer :: num_aitken(:,:) ! number m.r. of aitken mode + real(r8), pointer :: num_coarse(:,:) ! number m.r. of coarse mode + real(r8), pointer :: coarse_dust(:,:) ! mass m.r. of coarse dust + real(r8), pointer :: coarse_nacl(:,:) ! mass m.r. of coarse nacl + real(r8), pointer :: coarse_so4(:,:) ! mass m.r. of coarse sulfate + real(r8), pointer :: aer_mmr(:,:) ! aerosol mass mixing ratio + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius + real(r8), pointer :: cld_num_coarse(:,:) ! number m.r. of coarse mode + real(r8), pointer :: cld_coarse_dust(:,:) ! mass m.r. of coarse dust + + real(r8), pointer :: ast(:,:) + real(r8) :: icecldf(pcols,pver) ! ice cloud fraction + real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. + + real(r8) :: rho(pcols,pver) ! air density (kg m-3) + + real(r8), allocatable :: naer2(:,:,:) ! bulk aerosol number concentration (1/m3) + real(r8), allocatable :: maerosol(:,:,:) ! bulk aerosol mass conc (kg/m3) + + real(r8) :: qs(pcols) ! liquid-ice weighted sat mixing rat (kg/kg) + real(r8) :: es(pcols) ! liquid-ice weighted sat vapor press (pa) + real(r8) :: gammas(pcols) ! parameter for cond/evap of cloud water + integer :: troplev(pcols) ! tropopause level + + real(r8) :: relhum(pcols,pver) ! relative humidity + real(r8) :: icldm(pcols,pver) ! ice cloud fraction + + real(r8) :: so4_num ! so4 aerosol number (#/cm^3) + real(r8) :: soot_num ! soot (hydrophilic) aerosol number (#/cm^3) + real(r8) :: dst1_num,dst2_num,dst3_num,dst4_num ! dust aerosol number (#/cm^3) + real(r8) :: dst_num ! total dust aerosol number (#/cm^3) + real(r8) :: wght + real(r8) :: dmc + real(r8) :: ssmc + real(r8) :: so4mc + real(r8) :: oso4_num + real(r8) :: odst_num + real(r8) :: osoot_num + real(r8) :: dso4_num + real(r8) :: so4_num_ac + real(r8) :: so4_num_cr + real(r8) :: ramp + + real(r8) :: subgrid(pcols,pver) + real(r8) :: trop_pd(pcols,pver) + + ! For pre-existing ice + real(r8) :: fhom(pcols,pver) ! how much fraction of cloud can reach Shom + real(r8) :: wice(pcols,pver) ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at Shom + real(r8) :: weff(pcols,pver) ! effective Vertical velocity for ice nucleation (m/s); weff=wsubi-wice + real(r8) :: INnso4(pcols,pver) ! #/m3, so4 aerosol number used for ice nucleation + real(r8) :: INnbc(pcols,pver) ! #/m3, bc aerosol number used for ice nucleation + real(r8) :: INndust(pcols,pver) ! #/m3, dust aerosol number used for ice nucleation + real(r8) :: INondust(pcols,pver) ! #/m3, dust aerosol number used for ice nucleation + real(r8) :: INhet(pcols,pver) ! #/m3, ice number from het freezing + real(r8) :: INhom(pcols,pver) ! #/m3, ice number from hom freezing + real(r8) :: INFrehom(pcols,pver) ! hom freezing occurence frequency. 1 occur, 0 not occur. + real(r8) :: INFreIN(pcols,pver) ! ice nucleation occerence frequency. 1 occur, 0 not occur. + + ! history output for ice nucleation + real(r8) :: nihf(pcols,pver) !output number conc of ice nuclei due to heterogenous freezing (1/m3) + real(r8) :: niimm(pcols,pver) !output number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3) + real(r8) :: nidep(pcols,pver) !output number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3) + real(r8) :: nimey(pcols,pver) !output number conc of ice nuclei due to meyers deposition (1/m3) + real(r8) :: regm(pcols,pver) !output temperature thershold for nucleation regime + + + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + t => state%t + qn => state%q(:,:,1) + qc => state%q(:,:,cldliq_idx) + qi => state%q(:,:,cldice_idx) + ni => state%q(:,:,numice_idx) + pmid => state%pmid + + do k = top_lev, pver + do i = 1, ncol + rho(i,k) = pmid(i,k)/(rair*t(i,k)) + end do + end do + + if (clim_modal_aero) then + ! mode number mixing ratios + call rad_cnst_get_mode_num(0, mode_accum_idx, 'a', state, pbuf, num_accum) + call rad_cnst_get_mode_num(0, mode_aitken_idx, 'a', state, pbuf, num_aitken) + call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'a', state, pbuf, num_coarse) + + ! mode specie mass m.r. + call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'a', state, pbuf, coarse_dust) + call rad_cnst_get_aer_mmr(0, mode_coarse_slt_idx, coarse_nacl_idx, 'a', state, pbuf, coarse_nacl) + if (mode_coarse_idx>0) then + call rad_cnst_get_aer_mmr(0, mode_coarse_idx, coarse_so4_idx, 'a', state, pbuf, coarse_so4) + endif + + ! Get the cloudbourne coarse mode fields, so aerosol used for nucleated + ! can be moved from interstial to cloudbourne. + call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'c', state, pbuf, cld_num_coarse) + call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'c', state, pbuf, cld_coarse_dust) + + call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) + else + ! init number/mass arrays for bulk aerosols + allocate( & + naer2(pcols,pver,naer_all), & + maerosol(pcols,pver,naer_all)) + + do m = 1, naer_all + call rad_cnst_get_aer_mmr(0, m, state, pbuf, aer_mmr) + maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:) + + if (m .eq. idxsul) then + naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m)*bulk_scale + else + naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m) + end if + end do + + call physics_ptend_init(ptend, state%psetcols, 'nucleatei') + end if + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + icecldf(:ncol,:pver) = ast(:ncol,:pver) + + if (clim_modal_aero) then + call pbuf_get_field(pbuf, dgnum_idx, dgnum) + end if + + ! naai and naai_hom are the outputs from this parameterization + call pbuf_get_field(pbuf, naai_idx, naai) + call pbuf_get_field(pbuf, naai_hom_idx, naai_hom) + naai(1:ncol,1:pver) = 0._r8 + naai_hom(1:ncol,1:pver) = 0._r8 + + ! Use the same criteria that is used in chemistry and in CLUBB (for cloud fraction) + ! to determine whether to use tropospheric or stratospheric settings. Include the + ! tropopause level so that the cold point tropopause will use the stratospheric values. + call tropopause_findChemTrop(state, troplev) + + if ((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) then + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) + end if + + trop_pd(:,:) = 0._r8 + + do k = top_lev, pver + do i = 1, ncol + trop_pd(i, troplev(i)) = 1._r8 + + if (k <= troplev(i)) then + if (nucleate_ice_subgrid_strat .eq. -1._r8) then + subgrid(i, k) = 1._r8 / qsatfac(i, k) + else + subgrid(i, k) = nucleate_ice_subgrid_strat + end if + else + if (nucleate_ice_subgrid .eq. -1._r8) then + subgrid(i, k) = 1._r8 / qsatfac(i, k) + else + subgrid(i, k) = nucleate_ice_subgrid + end if + end if + end do + end do + + + ! initialize history output fields for ice nucleation + nihf(1:ncol,1:pver) = 0._r8 + niimm(1:ncol,1:pver) = 0._r8 + nidep(1:ncol,1:pver) = 0._r8 + nimey(1:ncol,1:pver) = 0._r8 + + if (use_preexisting_ice) then + fhom(:,:) = 0.0_r8 + wice(:,:) = 0.0_r8 + weff(:,:) = 0.0_r8 + INnso4(:,:) = 0.0_r8 + INnbc(:,:) = 0.0_r8 + INndust(:,:) = 0.0_r8 + INondust(:,:) = 0.0_r8 + INhet(:,:) = 0.0_r8 + INhom(:,:) = 0.0_r8 + INFrehom(:,:) = 0.0_r8 + INFreIN(:,:) = 0.0_r8 + endif + + do k = top_lev, pver + + ! Get humidity and saturation vapor pressures + call qsat_water(t(:ncol,k), pmid(:ncol,k), & + es(:ncol), qs(:ncol), gam=gammas(:ncol)) + + do i = 1, ncol + + relhum(i,k) = qn(i,k)/qs(i) + + ! get cloud fraction, check for minimum + icldm(i,k) = max(icecldf(i,k), mincld) + + end do + end do + + + do k = top_lev, pver + do i = 1, ncol + + if (t(i,k) < tmelt - 5._r8) then + + ! compute aerosol number for so4, soot, and dust with units #/cm^3 + so4_num = 0._r8 + soot_num = 0._r8 + dst1_num = 0._r8 + dst2_num = 0._r8 + dst3_num = 0._r8 + dst4_num = 0._r8 + dst_num = 0._r8 + so4_num_cr = 0._r8 + + if (clim_modal_aero) then + !For modal aerosols, assume for the upper troposphere: + ! soot = accumulation mode + ! sulfate = aiken mode + ! dust = coarse mode + ! since modal has internal mixtures. + soot_num = num_accum(i,k)*rho(i,k)*1.0e-6_r8 + dmc = coarse_dust(i,k)*rho(i,k) + ssmc = coarse_nacl(i,k)*rho(i,k) + + if (dmc > 0._r8) then + if ( separate_dust ) then + ! 7-mode -- has separate dust and seasalt mode types and + ! no need for weighting + wght = 1._r8 + else + ! 3-mode -- needs weighting for dust since dust, seasalt, + ! and sulfate are combined in the "coarse" mode type + so4mc = coarse_so4(i,k)*rho(i,k) + wght = dmc/(ssmc + dmc + so4mc) + endif + dst_num = wght * num_coarse(i,k)*rho(i,k)*1.0e-6_r8 + else + dst_num = 0.0_r8 + end if + + if ( separate_dust ) then + ! 7-mode -- the 7 mode scheme does not support + ! stratospheric sulfates, and the sulfates are mixed in + ! with the separate soot and dust modes, so just ignore + ! for now. + so4_num_cr = 0.0_r8 + else + ! 3-mode -- needs weighting for dust since dust, seasalt, + ! and sulfate are combined in the "coarse" mode + ! type + so4mc = coarse_so4(i,k)*rho(i,k) + + if (so4mc > 0._r8) then + wght = so4mc/(ssmc + dmc + so4mc) + so4_num_cr = wght * num_coarse(i,k)*rho(i,k)*1.0e-6_r8 + else + so4_num_cr = 0.0_r8 + end if + endif + + so4_num = 0.0_r8 + if (.not. use_preexisting_ice) then + if (dgnum(i,k,mode_aitken_idx) > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + so4_num = so4_num + max(0._r8, num_aitken(i,k)*rho(i,k)*1.0e-6_r8 & + * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum(i,k,mode_aitken_idx))/ & + (2._r8**0.5_r8*log(sigmag_aitken))))) + end if + else + ! all so4 from aitken + so4_num = num_aitken(i,k)*rho(i,k)*1.0e-6_r8 + end if + + else + + if (idxsul > 0) then + so4_num = naer2(i,k,idxsul)/25._r8 *1.0e-6_r8 + end if + if (idxbcphi > 0) then + soot_num = naer2(i,k,idxbcphi)/25._r8 *1.0e-6_r8 + end if + if (idxdst1 > 0) then + dst1_num = naer2(i,k,idxdst1)/25._r8 *1.0e-6_r8 + end if + if (idxdst2 > 0) then + dst2_num = naer2(i,k,idxdst2)/25._r8 *1.0e-6_r8 + end if + if (idxdst3 > 0) then + dst3_num = naer2(i,k,idxdst3)/25._r8 *1.0e-6_r8 + end if + if (idxdst4 > 0) then + dst4_num = naer2(i,k,idxdst4)/25._r8 *1.0e-6_r8 + end if + dst_num = dst1_num + dst2_num + dst3_num + dst4_num + + end if + + ! *** Turn off soot nucleation *** + soot_num = 0.0_r8 + + call nucleati( & + wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), & + qc(i,k), qi(i,k), ni(i,k), rho(i,k), & + so4_num, dst_num, soot_num, subgrid(i,k), & + naai(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & + wice(i,k), weff(i,k), fhom(i,k), regm(i,k), & + oso4_num, odst_num, osoot_num) + + ! Move aerosol used for nucleation from interstial to cloudborne, + ! otherwise the same coarse mode aerosols will be available again + ! in the next timestep and will supress homogeneous freezing. + if (prog_modal_aero .and. use_preexisting_ice) then + if (separate_dust) then + call endrun('nucleate_ice_cam: use_preexisting_ice is not supported in separate_dust mode (MAM7)') + endif + ptend%q(i,k,cnum_idx) = -(odst_num * icldm(i,k))/rho(i,k)/1e-6_r8/dtime + cld_num_coarse(i,k) = cld_num_coarse(i,k) + (odst_num * icldm(i,k))/rho(i,k)/1e-6_r8 + + ptend%q(i,k,cdst_idx) = - odst_num / dst_num * icldm(i,k) * coarse_dust(i,k) / dtime + cld_coarse_dust(i,k) = cld_coarse_dust(i,k) + odst_num / dst_num *icldm(i,k) * coarse_dust(i,k) + end if + + ! Liu&Penner does not generate enough nucleation in the polar winter + ! stratosphere, which affects surface area density, dehydration and + ! ozone chemistry. Part of this is that there are a larger number of + ! particles in the accumulation mode than in the Aitken mode. In volcanic + ! periods, the coarse mode may also be important. As a short + ! term work around, include the accumulation and coarse mode particles + ! and assume a larger fraction of the sulfates nucleate in the polar + ! stratosphere. + ! + ! Do not include the tropopause level, as stratospheric aerosols + ! only exist above the tropopause level. + ! + ! NOTE: This may still not represent the proper particles that + ! participate in nucleation, because it doesn't include STS and NAT + ! particles. It may not represent the proper saturation threshold for + ! nucleation, and wsubi from CLUBB is probably not representative of + ! wave driven varaibility in the polar stratosphere. + if (nucleate_ice_use_troplev .and. clim_modal_aero) then + if ((k < troplev(i)) .and. (nucleate_ice_strat > 0._r8)) then + if (oso4_num > 0._r8) then + so4_num_ac = num_accum(i,k)*rho(i,k)*1.0e-6_r8 + dso4_num = max(0._r8, (nucleate_ice_strat * (so4_num_cr + so4_num_ac)) - oso4_num) * 1e6_r8 / rho(i,k) + naai(i,k) = naai(i,k) + dso4_num + nihf(i,k) = nihf(i,k) + dso4_num + end if + end if + else + + ! This maintains backwards compatibility with the previous version. + if (pmid(i,k) <= 12500._r8 .and. pmid(i,k) > 100._r8 .and. abs(state%lat(i)) >= 60._r8 * pi / 180._r8) then + ramp = 1._r8 - min(1._r8, max(0._r8, (pmid(i,k) - 10000._r8) / 2500._r8)) + + if (oso4_num > 0._r8) then + dso4_num = (max(oso4_num, ramp * nucleate_ice_strat * so4_num) - oso4_num) * 1e6_r8 / rho(i,k) + naai(i,k) = naai(i,k) + dso4_num + nihf(i,k) = nihf(i,k) + dso4_num + end if + end if + end if + + naai_hom(i,k) = nihf(i,k) + + ! output activated ice (convert from #/kg -> #/m3) + nihf(i,k) = nihf(i,k) *rho(i,k) + niimm(i,k) = niimm(i,k)*rho(i,k) + nidep(i,k) = nidep(i,k)*rho(i,k) + nimey(i,k) = nimey(i,k)*rho(i,k) + + if (use_preexisting_ice) then + INnso4(i,k) =so4_num*1e6_r8 ! (convert from #/cm3 -> #/m3) + INnbc(i,k) =soot_num*1e6_r8 + INndust(i,k)=dst_num*1e6_r8 + INondust(i,k)=odst_num*1e6_r8 + INFreIN(i,k)=1.0_r8 ! 1,ice nucleation occur + INhet(i,k) = (niimm(i,k) + nidep(i,k)) ! #/m3, nimey not in cirrus + INhom(i,k) = nihf(i,k) ! #/m3 + if (INhom(i,k).gt.1e3_r8) then ! > 1/L + INFrehom(i,k)=1.0_r8 ! 1, hom freezing occur + endif + + ! exclude no ice nucleaton + if ((INFrehom(i,k) < 0.5_r8) .and. (INhet(i,k) < 1.0_r8)) then + INnso4(i,k) =0.0_r8 + INnbc(i,k) =0.0_r8 + INndust(i,k)=0.0_r8 + INondust(i,k)=0.0_r8 + INFreIN(i,k)=0.0_r8 + INhet(i,k) = 0.0_r8 + INhom(i,k) = 0.0_r8 + INFrehom(i,k)=0.0_r8 + wice(i,k) = 0.0_r8 + weff(i,k) = 0.0_r8 + fhom(i,k) = 0.0_r8 + endif + end if + + end if + end do + end do + + if (.not. clim_modal_aero) then + + deallocate( & + naer2, & + maerosol) + + end if + + call outfld('NIHF', nihf, pcols, lchnk) + call outfld('NIIMM', niimm, pcols, lchnk) + call outfld('NIDEP', nidep, pcols, lchnk) + call outfld('NIMEY', nimey, pcols, lchnk) + call outfld('NIREGM', regm, pcols, lchnk) + call outfld('NISUBGRID', subgrid, pcols, lchnk) + call outfld('NITROP_PD', trop_pd, pcols, lchnk) + + if (use_preexisting_ice) then + call outfld( 'fhom' , fhom, pcols, lchnk) + call outfld( 'WICE' , wice, pcols, lchnk) + call outfld( 'WEFF' , weff, pcols, lchnk) + call outfld('INnso4 ',INnso4 , pcols,lchnk) + call outfld('INnbc ',INnbc , pcols,lchnk) + call outfld('INndust ',INndust, pcols,lchnk) + call outfld('INondust ',INondust, pcols,lchnk) + call outfld('INhet ',INhet , pcols,lchnk) + call outfld('INhom ',INhom , pcols,lchnk) + call outfld('INFrehom',INFrehom,pcols,lchnk) + call outfld('INFreIN ',INFreIN, pcols,lchnk) + end if + +end subroutine nucleate_ice_cam_calc + +!================================================================================================ + +end module nucleate_ice_cam diff --git a/src/physics/cam/pbl_utils.F90 b/src/physics/cam/pbl_utils.F90 new file mode 100644 index 0000000000..c6d9efc750 --- /dev/null +++ b/src/physics/cam/pbl_utils.F90 @@ -0,0 +1,411 @@ +module pbl_utils +!-----------------------------------------------------------------------! +! Module to hold PBL-related subprograms that may be used with multiple ! +! different vertical diffusion schemes. ! +! ! +! Public subroutines: ! +! +! calc_obklen ! +! ! +!------------------ History --------------------------------------------! +! Created: Apr. 2012, by S. Santos ! +!-----------------------------------------------------------------------! + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +private + +! Public Procedures +!----------------------------------------------------------------------! +! Excepting the initialization procedure, these are elemental +! procedures, so they can accept scalars or any dimension of array as +! arguments, as long as all arguments have the same number of +! elements. +public pbl_utils_init +public calc_ustar +public calc_obklen +public virtem +public compute_radf +public austausch_atm + +real(r8), parameter :: ustar_min = 0.01_r8 + +real(r8) :: g ! acceleration of gravity +real(r8) :: vk ! Von Karman's constant +real(r8) :: cpair ! specific heat of dry air +real(r8) :: rair ! gas constant for dry air +real(r8) :: zvir ! rh2o/rair - 1 + + +!------------------------------------------------------------------------! +! Purpose: Compilers aren't creating optimized vector versions of ! +! elemental routines, so we'll explicitly create them and bind ! +! them via an interface for transparent use ! +!------------------------------------------------------------------------! +interface calc_ustar + module procedure calc_ustar_scalar + module procedure calc_ustar_vector +end interface + +interface calc_obklen + module procedure calc_obklen_scalar + module procedure calc_obklen_vector +end interface + +interface virtem + module procedure virtem_vector1D + module procedure virtem_vector2D ! Used in hb_diff.F90 +end interface + + + +contains + +subroutine pbl_utils_init(g_in,vk_in,cpair_in,rair_in,zvir_in) + + !-----------------------------------------------------------------------! + ! Purpose: Set constants to be used in calls to later functions ! + !-----------------------------------------------------------------------! + + real(r8), intent(in) :: g_in ! acceleration of gravity + real(r8), intent(in) :: vk_in ! Von Karman's constant + real(r8), intent(in) :: cpair_in ! specific heat of dry air + real(r8), intent(in) :: rair_in ! gas constant for dry air + real(r8), intent(in) :: zvir_in ! rh2o/rair - 1 + + g = g_in + vk = vk_in + cpair = cpair_in + rair = rair_in + zvir = zvir_in + +end subroutine pbl_utils_init + +subroutine calc_ustar_scalar( t, pmid, taux, tauy, & + rrho, ustar) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate ustar and bottom level density (necessary for ! + ! Obukhov length calculation). ! + !-----------------------------------------------------------------------! + + real(r8), intent(in) :: t ! surface temperature + real(r8), intent(in) :: pmid ! midpoint pressure (bottom level) + real(r8), intent(in) :: taux ! surface u stress [N/m2] + real(r8), intent(in) :: tauy ! surface v stress [N/m2] + + real(r8), intent(out) :: rrho ! 1./bottom level density + real(r8), intent(out) :: ustar ! surface friction velocity [m/s] + + rrho = rair * t / pmid + ustar = max( sqrt( sqrt(taux**2 + tauy**2)*rrho ), ustar_min ) + +end subroutine calc_ustar_scalar + +subroutine calc_ustar_vector(n, t, pmid, taux, tauy, & + rrho, ustar) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate ustar and bottom level density (necessary for ! + ! Obukhov length calculation). ! + !-----------------------------------------------------------------------! + integer, intent(in) :: n ! Length of vectors + + real(r8), intent(in) :: t(n) ! surface temperature + real(r8), intent(in) :: pmid(n) ! midpoint pressure (bottom level) + real(r8), intent(in) :: taux(n) ! surface u stress [N/m2] + real(r8), intent(in) :: tauy(n) ! surface v stress [N/m2] + + + real(r8), intent(out) :: rrho(n) ! 1./bottom level density + real(r8), intent(out) :: ustar(n) ! surface friction velocity [m/s] + + + rrho = rair * t / pmid + ustar = max( sqrt( sqrt(taux**2 + tauy**2)*rrho ), ustar_min ) + +end subroutine calc_ustar_vector + +subroutine calc_obklen_scalar( ths, thvs, qflx, shflx, rrho, ustar, & + khfs, kqfs, kbfs, obklen) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate Obukhov length and kinematic fluxes. ! + !-----------------------------------------------------------------------! + + real(r8), intent(in) :: ths ! potential temperature at surface [K] + real(r8), intent(in) :: thvs ! virtual potential temperature at surface + real(r8), intent(in) :: qflx ! water vapor flux (kg/m2/s) + real(r8), intent(in) :: shflx ! surface heat flux (W/m2) + + real(r8), intent(in) :: rrho ! 1./bottom level density [ m3/kg ] + real(r8), intent(in) :: ustar ! Surface friction velocity [ m/s ] + + real(r8), intent(out) :: khfs ! sfc kinematic heat flux [mK/s] + real(r8), intent(out) :: kqfs ! sfc kinematic water vapor flux [m/s] + real(r8), intent(out) :: kbfs ! sfc kinematic buoyancy flux [m^2/s^3] + real(r8), intent(out) :: obklen ! Obukhov length + + ! Need kinematic fluxes for Obukhov: + khfs = shflx*rrho/cpair + kqfs = qflx*rrho + kbfs = khfs + zvir*ths*kqfs + + ! Compute Obukhov length: + obklen = -thvs * ustar**3 / (g*vk*(kbfs + sign(1.e-10_r8,kbfs))) + +end subroutine calc_obklen_scalar + +subroutine calc_obklen_vector(n, ths, thvs, qflx, shflx, rrho, ustar, & + khfs, kqfs, kbfs, obklen) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate Obukhov length and kinematic fluxes. ! + !-----------------------------------------------------------------------! + integer, intent(in) :: n ! Length of vectors + + real(r8), intent(in) :: ths(n) ! potential temperature at surface [K] + real(r8), intent(in) :: thvs(n) ! virtual potential temperature at surface + real(r8), intent(in) :: qflx(n) ! water vapor flux (kg/m2/s) + real(r8), intent(in) :: shflx(n) ! surface heat flux (W/m2) + + real(r8), intent(in) :: rrho(n) ! 1./bottom level density [ m3/kg ] + real(r8), intent(in) :: ustar(n) ! Surface friction velocity [ m/s ] + + real(r8), intent(out) :: khfs(n) ! sfc kinematic heat flux [mK/s] + real(r8), intent(out) :: kqfs(n) ! sfc kinematic water vapor flux [m/s] + real(r8), intent(out) :: kbfs(n) ! sfc kinematic buoyancy flux [m^2/s^3] + real(r8), intent(out) :: obklen(n) ! Obukhov length + + + ! Need kinematic fluxes for Obukhov: + khfs = shflx*rrho/cpair + kqfs = qflx*rrho + kbfs = khfs + zvir*ths*kqfs + + ! Compute Obukhov length: + obklen = -thvs * ustar**3 / (g*vk*(kbfs + sign(1.e-10_r8,kbfs))) + +end subroutine calc_obklen_vector + +subroutine virtem_vector1D(n, t,q, virtem) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate virtual temperature from temperature and specific ! + ! humidity. ! + !-----------------------------------------------------------------------! + + integer, intent(in) :: n ! vector length + + real(r8), intent(in) :: t(n), q(n) + real(r8), intent(out):: virtem(n) + + virtem = t * (1.0_r8 + zvir*q) + +end subroutine virtem_vector1D + +subroutine virtem_vector2D(n, m, t, q, virtem) + + !-----------------------------------------------------------------------! + ! Purpose: Calculate virtual temperature from temperature and specific ! + ! humidity. ! + !-----------------------------------------------------------------------! + + integer, intent(in) :: n, m ! vector lengths + + real(r8), intent(in) :: t(n,m), q(n,m) + real(r8), intent(out):: virtem(n,m) + + virtem = t * (1.0_r8 + zvir*q) + +end subroutine virtem_vector2D + + +subroutine compute_radf( choice_radf, i, pcols, pver, ncvmax, ncvfin, ktop, qmin, & + ql, pi, qrlw, g, cldeff, zi, chs, lwp_CL, opt_depth_CL, & + radinvfrac_CL, radf_CL ) + ! -------------------------------------------------------------------------- ! + ! Purpose: ! + ! Calculate cloud-top radiative cooling contribution to buoyancy production. ! + ! Here, 'radf' [m2/s3] is additional buoyancy flux at the CL top interface ! + ! associated with cloud-top LW cooling being mainly concentrated near the CL ! + ! top interface ( just below CL top interface ). Contribution of SW heating ! + ! within the cloud is not included in this radiative buoyancy production ! + ! since SW heating is more broadly distributed throughout the CL top layer. ! + ! -------------------------------------------------------------------------- ! + + !-----------------! + ! Input variables ! + !-----------------! + character(len=6), intent(in) :: choice_radf ! Method for calculating radf + integer, intent(in) :: i ! Index of current column + integer, intent(in) :: pcols ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ncvmax ! Max numbers of CLs (perhaps equal to pver) + integer, intent(in) :: ncvfin(pcols) ! Total number of CL in column + integer, intent(in) :: ktop(pcols, ncvmax) ! ktop for current column + real(r8), intent(in) :: qmin ! Minimum grid-mean LWC counted as clouds [kg/kg] + real(r8), intent(in) :: ql(pcols, pver) ! Liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: pi(pcols, pver+1) ! Interface pressures [ Pa ] + real(r8), intent(in) :: qrlw(pcols, pver) ! Input grid-mean LW heating rate : [ K/s ] * cpair * dp = [ W/kg*Pa ] + real(r8), intent(in) :: g ! Gravitational acceleration + real(r8), intent(in) :: cldeff(pcols,pver) ! Effective Cloud Fraction [fraction] + real(r8), intent(in) :: zi(pcols, pver+1) ! Interface heights [ m ] + real(r8), intent(in) :: chs(pcols, pver+1) ! Buoyancy coeffi. saturated sl (heat) coef. at all interfaces. + + !------------------! + ! Output variables ! + !------------------! + real(r8), intent(out) :: lwp_CL(ncvmax) ! LWP in the CL top layer [ kg/m2 ] + real(r8), intent(out) :: opt_depth_CL(ncvmax) ! Optical depth of the CL top layer + real(r8), intent(out) :: radinvfrac_CL(ncvmax) ! Fraction of LW radiative cooling confined in the top portion of CL + real(r8), intent(out) :: radf_CL(ncvmax) ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ] + + !-----------------! + ! Local variables ! + !-----------------! + integer :: kt, ncv + real(r8) :: lwp, opt_depth, radinvfrac, radf + + + !-----------------! + ! Begin main code ! + !-----------------! + lwp_CL = 0._r8 + opt_depth_CL = 0._r8 + radinvfrac_CL = 0._r8 + radf_CL = 0._r8 + + ! ---------------------------------------- ! + ! Perform do loop for individual CL regime ! + ! ---------------------------------------- ! + do ncv = 1, ncvfin(i) + kt = ktop(i,ncv) + !-----------------------------------------------------! + ! Compute radf for each CL regime and for each column ! + !-----------------------------------------------------! + if( choice_radf .eq. 'orig' ) then + if( ql(i,kt) .gt. qmin .and. ql(i,kt-1) .lt. qmin ) then + lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g + opt_depth = 156._r8 * lwp ! Estimated LW optical depth in the CL top layer + ! Approximate LW cooling fraction concentrated at the inversion by using + ! polynomial approx to exact formula 1-2/opt_depth+2/(exp(opt_depth)-1)) + + radinvfrac = opt_depth * ( 4._r8 + opt_depth ) / ( 6._r8 * ( 4._r8 + opt_depth ) + opt_depth**2 ) + radf = qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) ! Cp*radiative cooling = [ W/kg ] + radf = max( radinvfrac * radf * ( zi(i,kt) - zi(i,kt+1) ), 0._r8 ) * chs(i,kt) + ! We can disable cloud LW cooling contribution to turbulence by uncommenting: + ! radf = 0._r8 + end if + + elseif( choice_radf .eq. 'ramp' ) then + + lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g + opt_depth = 156._r8 * lwp ! Estimated LW optical depth in the CL top layer + radinvfrac = opt_depth * ( 4._r8 + opt_depth ) / ( 6._r8 * ( 4._r8 + opt_depth ) + opt_depth**2 ) + radinvfrac = max(cldeff(i,kt)-cldeff(i,kt-1),0._r8) * radinvfrac + radf = qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) ! Cp*radiative cooling [W/kg] + radf = max( radinvfrac * radf * ( zi(i,kt) - zi(i,kt+1) ), 0._r8 ) * chs(i,kt) + + elseif( choice_radf .eq. 'maxi' ) then + + ! Radiative flux divergence both in 'kt' and 'kt-1' layers are included + ! 1. From 'kt' layer + lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g + opt_depth = 156._r8 * lwp ! Estimated LW optical depth in the CL top layer + radinvfrac = opt_depth * ( 4._r8 + opt_depth ) / ( 6._r8 * ( 4._r8 + opt_depth ) + opt_depth**2 ) + radf = max( radinvfrac * qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) * ( zi(i,kt) - zi(i,kt+1) ), 0._r8 ) + ! 2. From 'kt-1' layer and add the contribution from 'kt' layer + lwp = ql(i,kt-1) * ( pi(i,kt) - pi(i,kt-1) ) / g + opt_depth = 156._r8 * lwp ! Estimated LW optical depth in the CL top layer + radinvfrac = opt_depth * ( 4._r8 + opt_depth ) / ( 6._r8 * ( 4._r8 + opt_depth) + opt_depth**2 ) + radf = radf + max( radinvfrac * qrlw(i,kt-1) / ( pi(i,kt-1) - pi(i,kt) ) * ( zi(i,kt-1) - zi(i,kt) ), 0._r8 ) + radf = max( radf, 0._r8 ) * chs(i,kt) + + endif + + lwp_CL(ncv) = lwp + opt_depth_CL(ncv) = opt_depth + radinvfrac_CL(ncv) = radinvfrac + radf_CL(ncv) = radf + end do ! ncv = 1, ncvfin(i) +end subroutine compute_radf + +subroutine austausch_atm(pcols, ncol, pver, ntop, nbot, ml2, ri, s2, kvf) + + !---------------------------------------------------------------------- ! + ! ! + ! Purpose: Computes exchange coefficients for free turbulent flows. ! + ! ! + ! Method: ! + ! ! + ! The free atmosphere diffusivities are based on standard mixing length ! + ! forms for the neutral diffusivity multiplied by functns of Richardson ! + ! number. K = l^2 * |dV/dz| * f(Ri). The same functions are used for ! + ! momentum, potential temperature, and constitutents. ! + ! ! + ! The stable Richardson num function (Ri>0) is taken from Holtslag and ! + ! Beljaars (1989), ECMWF proceedings. f = 1 / (1 + 10*Ri*(1 + 8*Ri)) ! + ! The unstable Richardson number function (Ri<0) is taken from CCM1. ! + ! f = sqrt(1 - 18*Ri) ! + ! ! + ! Author: B. Stevens (rewrite, August 2000) ! + ! ! + !---------------------------------------------------------------------- ! + + ! --------------- ! + ! Input arguments ! + ! --------------- ! + + integer, intent(in) :: pcols ! Atmospheric columns dimension size + integer, intent(in) :: ncol ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ntop ! Top layer for calculation + integer, intent(in) :: nbot ! Bottom layer for calculation + + real(r8), intent(in) :: ml2(pver+1) ! Mixing lengths squared + real(r8), intent(in) :: s2(pcols,pver) ! Shear squared + real(r8), intent(in) :: ri(pcols,pver) ! Richardson no + + ! ---------------- ! + ! Output arguments ! + ! ---------------- ! + + real(r8), intent(out) :: kvf(pcols,pver+1) ! Eddy diffusivity for heat and tracers + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + real(r8) :: fofri ! f(ri) + real(r8) :: kvn ! Neutral Kv + + integer :: i ! Longitude index + integer :: k ! Vertical index + + real(r8), parameter :: zkmin = 0.01_r8 ! Minimum kneutral*f(ri). + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + kvf(:ncol,:) = 0.0_r8 + + ! Compute the free atmosphere vertical diffusion coefficients: kvh = kvq = kvm. + + do k = ntop, nbot - 1 + do i = 1, ncol + if( ri(i,k) < 0.0_r8 ) then + fofri = sqrt( max( 1._r8 - 18._r8 * ri(i,k), 0._r8 ) ) + else + fofri = 1.0_r8 / ( 1.0_r8 + 10.0_r8 * ri(i,k) * ( 1.0_r8 + 8.0_r8 * ri(i,k) ) ) + end if + kvn = ml2(k) * sqrt(s2(i,k)) + kvf(i,k+1) = max( zkmin, kvn * fofri ) + end do + end do + +end subroutine austausch_atm + +end module pbl_utils diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 new file mode 100644 index 0000000000..ff17e5b4e3 --- /dev/null +++ b/src/physics/cam/phys_control.F90 @@ -0,0 +1,399 @@ +module phys_control +!----------------------------------------------------------------------- +! Purpose: +! +! Provides a control interface to CAM physics packages +! +! Revision history: +! 2006-05-01 D. B. Coleman, Creation of module +! 2009-02-13 Eaton Replace *_{default,set}opts methods with module namelist. +! Add vars to indicate physics version and chemistry type. +!----------------------------------------------------------------------- + +use spmd_utils, only: masterproc +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +private +save + +public :: & + phys_ctl_readnl, &! read namelist from file + phys_getopts, &! generic query method + phys_setopts, &! generic set method + phys_deepconv_pbl, &! return true if deep convection is allowed in the PBL + phys_do_flux_avg, &! return true to average surface fluxes + cam_physpkg_is, &! query for the name of the physics package + cam_chempkg_is, &! query for the name of the chemistry package + waccmx_is + +! Private module data + +character(len=16), parameter :: unset_str = 'UNSET' +integer, parameter :: unset_int = huge(1) + +! Namelist variables: +character(len=16) :: cam_physpkg = unset_str ! CAM physics package +character(len=32) :: cam_chempkg = unset_str ! CAM chemistry package +character(len=16) :: waccmx_opt = unset_str ! WACCMX run option [ionosphere | neutral | off +character(len=16) :: deep_scheme = unset_str ! deep convection package +character(len=16) :: shallow_scheme = unset_str ! shallow convection package +character(len=16) :: eddy_scheme = unset_str ! vertical diffusion package +character(len=16) :: microp_scheme = unset_str ! microphysics package +character(len=16) :: macrop_scheme = unset_str ! macrophysics package +character(len=16) :: radiation_scheme = unset_str ! radiation package +integer :: srf_flux_avg = unset_int ! 1 => smooth surface fluxes, 0 otherwise + +logical :: use_subcol_microp = .false. ! if .true. then use sub-columns in microphysics + +logical :: atm_dep_flux = .true. ! true => deposition fluxes will be provided + ! to the coupler +logical :: history_amwg = .true. ! output the variables used by the AMWG diag package +logical :: history_vdiag = .false. ! output the variables used by the AMWG variability diag package +logical :: history_aerosol = .false. ! output the MAM aerosol variables and tendencies +logical :: history_aero_optics = .false. ! output the aerosol +logical :: history_eddy = .false. ! output the eddy variables +logical :: history_budget = .false. ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. +logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols + +integer :: history_budget_histfile_num = 1 ! output history file number for budget fields +logical :: history_waccm = .false. ! output variables of interest for WACCM runs +logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs +logical :: history_chemistry = .true. ! output default chemistry-related variables +logical :: history_carma = .false. ! output default CARMA-related variables +logical :: history_clubb = .true. ! output default CLUBB-related variables +logical :: history_cesm_forcing = .false. +logical :: history_scwaccm_forcing = .false. +logical :: history_chemspecies_srf = .false. + +logical :: do_clubb_sgs +! Check validity of physics_state objects in physics_update. +logical :: state_debug_checks = .false. + +! Macro/micro-physics co-substeps +integer :: cld_macmic_num_steps = 1 + +logical :: offline_driver = .false. ! true => offline driver is being used + + +logical, public, protected :: use_simple_phys = .false. ! true => simple physics configuration + +logical :: use_spcam ! true => use super parameterized CAM + +logical :: prog_modal_aero ! determines whether prognostic modal aerosols are present in the run. + +! Option to use heterogeneous freezing +logical, public, protected :: use_hetfrz_classnuc = .false. + +! Which gravity wave sources are used? +logical, public, protected :: use_gw_oro = .true. ! Orography. +logical, public, protected :: use_gw_front = .false. ! Frontogenesis. +logical, public, protected :: use_gw_front_igw = .false. ! Frontogenesis to inertial spectrum. +logical, public, protected :: use_gw_convect_dp = .false. ! Deep convection. +logical, public, protected :: use_gw_convect_sh = .false. ! Shallow convection. + +! FV dycore angular momentum correction +logical, public, protected :: fv_am_correction = .false. + +!======================================================================= +contains +!======================================================================= + +subroutine phys_ctl_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpi_character, mpi_integer, mpi_logical, masterprocid, mpicom + use cam_control_mod, only: cam_ctrl_set_physics_type + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'phys_ctl_readnl' + + namelist /phys_ctl_nl/ cam_physpkg, use_simple_phys, cam_chempkg, waccmx_opt, & + deep_scheme, shallow_scheme, & + eddy_scheme, microp_scheme, macrop_scheme, radiation_scheme, srf_flux_avg, & + use_subcol_microp, atm_dep_flux, history_amwg, history_vdiag, history_aerosol, history_aero_optics, & + history_eddy, history_budget, history_budget_histfile_num, history_waccm, & + history_waccmx, history_chemistry, history_carma, history_clubb, & + history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, & + do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & + use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, & + offline_driver, convproc_do_aer + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'phys_ctl_nl', status=ierr) + if (ierr == 0) then + read(unitn, phys_ctl_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(deep_scheme, len(deep_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(cam_physpkg, len(cam_physpkg), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(use_simple_phys, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(cam_chempkg, len(cam_chempkg), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(waccmx_opt, len(waccmx_opt), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(shallow_scheme, len(shallow_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(eddy_scheme, len(eddy_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(microp_scheme, len(microp_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(radiation_scheme, len(radiation_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(macrop_scheme, len(macrop_scheme), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(srf_flux_avg, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(use_subcol_microp, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(atm_dep_flux, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_amwg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_vdiag, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_eddy, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_aerosol, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_aero_optics, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_budget, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_budget_histfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(history_waccm, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_carma, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_clubb, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_cesm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_chemspecies_srf, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_scwaccm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(do_clubb_sgs, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(state_debug_checks, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_hetfrz_classnuc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_oro, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_front, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_front_igw, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_convect_dp, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_convect_sh, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(cld_macmic_num_steps, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(offline_driver, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(convproc_do_aer, 1, mpi_logical, masterprocid, mpicom, ierr) + + use_spcam = ( cam_physpkg_is('spcam_sam1mom') & + .or. cam_physpkg_is('spcam_m2005')) + + call cam_ctrl_set_physics_type(cam_physpkg) + + ! Error checking: + + ! Check compatibility of eddy & shallow schemes + if (( shallow_scheme .eq. 'UW' ) .and. ( eddy_scheme .ne. 'diag_TKE' )) then + write(iulog,*)'Do you really want to run UW shallow scheme without diagnostic TKE eddy scheme? Quiting' + call endrun('shallow convection and eddy scheme may be incompatible') + endif + + if (( shallow_scheme .eq. 'Hack' ) .and. ( ( eddy_scheme .ne. 'HB' ) .and. ( eddy_scheme .ne. 'HBR' ))) then + write(iulog,*)'Do you really want to run Hack shallow scheme with a non-standard eddy scheme? Quiting.' + call endrun('shallow convection and eddy scheme may be incompatible') + endif + + ! Check compatibility of PBL and Microphysics schemes + if (( eddy_scheme .eq. 'diag_TKE' ) .and. ( microp_scheme .eq. 'RK' )) then + write(iulog,*)'UW PBL is not compatible with RK microphysics. Quiting' + call endrun('PBL and Microphysics schemes incompatible') + endif + + ! Add a check to make sure CLUBB and MG are used together + if ( do_clubb_sgs .and. ( microp_scheme .ne. 'MG') .and. .not. use_spcam) then + write(iulog,*)'CLUBB is only compatible with MG microphysics. Quiting' + call endrun('CLUBB and microphysics schemes incompatible') + endif + + ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB_SGS if do_clubb_sgs is true + if (do_clubb_sgs .and. .not. use_spcam) then + if (eddy_scheme .ne. 'CLUBB_SGS' .or. macrop_scheme .ne. 'CLUBB_SGS' .or. shallow_scheme .ne. 'CLUBB_SGS') then + write(iulog,*)'eddy_scheme, macrop_scheme and shallow_scheme must all be CLUBB_SGS. Quiting' + call endrun('CLUBB and eddy, macrop or shallow schemes incompatible') + endif + endif + + ! Macro/micro co-substepping support. + if (cld_macmic_num_steps > 1) then + if (microp_scheme /= "MG" .or. (macrop_scheme /= "park" .and. macrop_scheme /= "CLUBB_SGS")) then + call endrun ("Setting cld_macmic_num_steps > 1 is only & + &supported with Park or CLUBB macrophysics and MG microphysics.") + end if + end if + + ! prog_modal_aero determines whether prognostic modal aerosols are present in the run. + prog_modal_aero = index(cam_chempkg,'_mam')>0 + +end subroutine phys_ctl_readnl + +!=============================================================================== + +logical function cam_physpkg_is(name) + + ! query for the name of the physics package + + character(len=*) :: name + + cam_physpkg_is = (trim(name) == trim(cam_physpkg)) +end function cam_physpkg_is + +!=============================================================================== + +logical function cam_chempkg_is(name) + + ! query for the name of the chemics package + + character(len=*) :: name + + cam_chempkg_is = (trim(name) == trim(cam_chempkg)) +end function cam_chempkg_is + +!=============================================================================== + +logical function waccmx_is(name) + + ! query for the name of the waccmx run option + + character(len=*) :: name + + waccmx_is = (trim(name) == trim(waccmx_opt)) +end function waccmx_is + +!=============================================================================== + +subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, microp_scheme_out, & + radiation_scheme_out, use_subcol_microp_out, atm_dep_flux_out, & + history_amwg_out, history_vdiag_out, history_aerosol_out, history_aero_optics_out, history_eddy_out, & + history_budget_out, history_budget_histfile_num_out, & + history_waccm_out, history_waccmx_out, history_chemistry_out, & + history_carma_out, history_clubb_out, & + history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, & + cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & + do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & + offline_driver_out, convproc_do_aer_out) +!----------------------------------------------------------------------- +! Purpose: Return runtime settings +! deep_scheme_out : deep convection scheme +! shallow_scheme_out: shallow convection scheme +! eddy_scheme_out : vertical diffusion scheme +! microp_scheme_out : microphysics scheme +! radiation_scheme_out : radiation_scheme +! SPCAM_microp_scheme_out : SPCAM microphysics scheme +!----------------------------------------------------------------------- + + character(len=16), intent(out), optional :: deep_scheme_out + character(len=16), intent(out), optional :: shallow_scheme_out + character(len=16), intent(out), optional :: eddy_scheme_out + character(len=16), intent(out), optional :: microp_scheme_out + character(len=16), intent(out), optional :: radiation_scheme_out + character(len=16), intent(out), optional :: macrop_scheme_out + logical, intent(out), optional :: use_subcol_microp_out + logical, intent(out), optional :: use_spcam_out + logical, intent(out), optional :: atm_dep_flux_out + logical, intent(out), optional :: history_amwg_out + logical, intent(out), optional :: history_vdiag_out + logical, intent(out), optional :: history_eddy_out + logical, intent(out), optional :: history_aerosol_out + logical, intent(out), optional :: history_aero_optics_out + logical, intent(out), optional :: history_budget_out + integer, intent(out), optional :: history_budget_histfile_num_out + logical, intent(out), optional :: history_waccm_out + logical, intent(out), optional :: history_waccmx_out + logical, intent(out), optional :: history_chemistry_out + logical, intent(out), optional :: history_carma_out + logical, intent(out), optional :: history_clubb_out + logical, intent(out), optional :: history_cesm_forcing_out + logical, intent(out), optional :: history_chemspecies_srf_out + logical, intent(out), optional :: history_scwaccm_forcing_out + logical, intent(out), optional :: do_clubb_sgs_out + character(len=32), intent(out), optional :: cam_chempkg_out + logical, intent(out), optional :: prog_modal_aero_out + logical, intent(out), optional :: state_debug_checks_out + integer, intent(out), optional :: cld_macmic_num_steps_out + logical, intent(out), optional :: offline_driver_out + logical, intent(out), optional :: convproc_do_aer_out + + if ( present(deep_scheme_out ) ) deep_scheme_out = deep_scheme + if ( present(shallow_scheme_out ) ) shallow_scheme_out = shallow_scheme + if ( present(eddy_scheme_out ) ) eddy_scheme_out = eddy_scheme + if ( present(microp_scheme_out ) ) microp_scheme_out = microp_scheme + if ( present(radiation_scheme_out ) ) radiation_scheme_out = radiation_scheme + if ( present(use_subcol_microp_out ) ) use_subcol_microp_out = use_subcol_microp + if ( present(use_spcam_out ) ) use_spcam_out = use_spcam + + if ( present(macrop_scheme_out ) ) macrop_scheme_out = macrop_scheme + if ( present(atm_dep_flux_out ) ) atm_dep_flux_out = atm_dep_flux + if ( present(history_aerosol_out ) ) history_aerosol_out = history_aerosol + if ( present(history_aero_optics_out ) ) history_aero_optics_out = history_aero_optics + if ( present(history_budget_out ) ) history_budget_out = history_budget + if ( present(history_amwg_out ) ) history_amwg_out = history_amwg + if ( present(history_vdiag_out ) ) history_vdiag_out = history_vdiag + if ( present(history_eddy_out ) ) history_eddy_out = history_eddy + if ( present(history_budget_histfile_num_out ) ) history_budget_histfile_num_out = history_budget_histfile_num + if ( present(history_waccm_out ) ) history_waccm_out = history_waccm + if ( present(history_waccmx_out ) ) history_waccmx_out = history_waccmx + if ( present(history_chemistry_out ) ) history_chemistry_out = history_chemistry + if ( present(history_cesm_forcing_out) ) history_cesm_forcing_out = history_cesm_forcing + if ( present(history_chemspecies_srf_out) ) history_chemspecies_srf_out = history_chemspecies_srf + if ( present(history_scwaccm_forcing_out) ) history_scwaccm_forcing_out = history_scwaccm_forcing + if ( present(history_carma_out ) ) history_carma_out = history_carma + if ( present(history_clubb_out ) ) history_clubb_out = history_clubb + if ( present(do_clubb_sgs_out ) ) do_clubb_sgs_out = do_clubb_sgs + if ( present(cam_chempkg_out ) ) cam_chempkg_out = cam_chempkg + if ( present(prog_modal_aero_out ) ) prog_modal_aero_out = prog_modal_aero + if ( present(state_debug_checks_out ) ) state_debug_checks_out = state_debug_checks + if ( present(cld_macmic_num_steps_out) ) cld_macmic_num_steps_out = cld_macmic_num_steps + if ( present(offline_driver_out ) ) offline_driver_out = offline_driver + if ( present(convproc_do_aer_out ) ) convproc_do_aer_out = convproc_do_aer + +end subroutine phys_getopts + +!=============================================================================== + +subroutine phys_setopts(fv_am_correction_in) + + logical, intent(in), optional :: fv_am_correction_in + + if ( present(fv_am_correction_in) ) fv_am_correction = fv_am_correction_in + +end subroutine phys_setopts + +!=============================================================================== + +function phys_deepconv_pbl() + + logical phys_deepconv_pbl + + ! Don't allow deep convection in PBL if running UW PBL scheme + if ( (eddy_scheme .eq. 'diag_TKE' ) .or. (shallow_scheme .eq. 'UW' ) ) then + phys_deepconv_pbl = .true. + else + phys_deepconv_pbl = .false. + endif + + return + +end function phys_deepconv_pbl + +!=============================================================================== + +function phys_do_flux_avg() + + logical :: phys_do_flux_avg + !---------------------------------------------------------------------- + + phys_do_flux_avg = .false. + if (srf_flux_avg == 1) phys_do_flux_avg = .true. + +end function phys_do_flux_avg + +!=============================================================================== +end module phys_control diff --git a/src/physics/cam/phys_debug.F90 b/src/physics/cam/phys_debug.F90 new file mode 100644 index 0000000000..4ed47d3724 --- /dev/null +++ b/src/physics/cam/phys_debug.F90 @@ -0,0 +1,424 @@ +module phys_debug + +! This module contains subroutines that are intended to print diagnostic +! information about a single column to the log file. The module uses the +! phys_debug_util module to locate the column using local indices of the +! physics decomposition. The reason to encapsulate the debug print +! statements into a subroutine is to minimize the impact of the debugging +! code on the development code. This makes it easier to maintain debug +! code on a branch which can be updated to the head of the trunk when +! convenient. Minimizing the footprint of debug code helps to minimize the +! chances of conflicts that can occur while updating between the debug code +! and changes that have occurred on the trunk. + +! This module also contains some generic code to write a collection of variables +! from the physics state object to the history file. + + +use shr_kind_mod, only: r8 => shr_kind_r8 +use phys_debug_util, only: phys_debug_col +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state, physics_ptend +use camsrfexch, only: cam_in_t +use cam_logfile, only: iulog +use cam_history, only: addfld, add_default, outfld +use constituents, only: pcnst, cnst_get_ind, cnst_name +use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx + +implicit none +private +save + +! Generic routines for writing physics state to history +public :: & + phys_debug_state_init, & + phys_debug_state_out + + +! The following routines are intended as examples for printing various diagnostic +! information from a single column +public :: & + phys_debug_vdiff1, & + phys_debug_shallow1, & + phys_debug_strat1, & + phys_debug_srf1, & + phys_debug_hbdiff1, & + phys_debug_flux1, & + phys_debug_flux2 + +! constituent indices +integer :: ixcldliq, ixcldice, ixnumliq, ixnumice +! logical array to identify constituents that are mode number concentrations +logical :: cnst_is_mam_num(pcnst) +! logical array to identify constituents that are mode specie mass mixing ratios +logical :: cnst_is_mam_mmr(pcnst) + + +!=================================================================================================== +contains +!=================================================================================================== + +subroutine phys_debug_state_init(tags) + + ! Write selected state variables from locations corresponding to the 'tags'. + ! This method does the addfld/add_default calls. + + ! ** Note ** This init needs to be called after the rad_constituent module has finished + ! its init. + + + character(len=8), dimension(:), intent(in) :: tags + + ! local variables + integer :: i, icnst, j, nmodes, nspec, ntags + character(len=5) :: unit + !----------------------------------------------------------------------------------------------- + + ! Initialize some constituent indices and names + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('NUMLIQ', ixnumliq, abort=.false.) + call cnst_get_ind('NUMICE', ixnumice, abort=.false.) + + ! Set arrays to identify the modal aerosol constituents + cnst_is_mam_num = .false. + cnst_is_mam_mmr = .false. + call rad_cnst_get_info(0, nmodes=nmodes) + do i = 1, nmodes + call rad_cnst_get_mode_num_idx(i, icnst) + cnst_is_mam_num(icnst) = .true. + call rad_cnst_get_info(0, i, nspec=nspec) + do j = 1, nspec + call rad_cnst_get_mam_mmr_idx(i, j, icnst) + cnst_is_mam_mmr(icnst) = .true. + end do + end do + + ! For each supplied tag, issue addfld/add_default calls for the state variables + ! with the tag name appended. + ntags = size(tags) + do i = 1, ntags + + call addfld('T_'//trim(tags(i)), (/ 'lev' /), 'A', 'K', 'T at tag '//trim(tags(i))) + call add_default('T_'//trim(tags(i)), 1, ' ') + + call addfld('U_'//trim(tags(i)), (/ 'lev' /), 'A', 'm/s', 'U at tag '//trim(tags(i))) + call add_default('U_'//trim(tags(i)), 1, ' ') + + call addfld('V_'//trim(tags(i)), (/ 'lev' /), 'A', 'm/s', 'V at tag '//trim(tags(i))) + call add_default('V_'//trim(tags(i)), 1, ' ') + + call addfld('QV_'//trim(tags(i)), (/ 'lev' /), 'A', 'kg/kg', 'QV at tag '//trim(tags(i))) + call add_default('QV_'//trim(tags(i)), 1, ' ') + + if (ixcldliq > 0) then + call addfld('QL_'//trim(tags(i)), (/ 'lev' /), 'A', 'kg/kg', 'QL at tag '//trim(tags(i))) + call add_default('QL_'//trim(tags(i)), 1, ' ') + end if + + if (ixcldice > 0) then + call addfld('QI_'//trim(tags(i)), (/ 'lev' /), 'A', 'kg/kg', 'QI at tag '//trim(tags(i))) + call add_default('QI_'//trim(tags(i)), 1, ' ') + end if + + if (ixnumliq > 0) then + call addfld('NL_'//trim(tags(i)), (/ 'lev' /), 'A', '1/kg', 'NL at tag '//trim(tags(i))) + call add_default('NL_'//trim(tags(i)), 1, ' ') + end if + + if (ixnumice > 0) then + call addfld('NI_'//trim(tags(i)), (/ 'lev' /), 'A', '1/kg', 'NI at tag '//trim(tags(i))) + call add_default('NI_'//trim(tags(i)), 1, ' ') + end if + + do j = 1, pcnst + + if (cnst_is_mam_num(j) .or. cnst_is_mam_mmr(j)) then + + unit = '1/kg' + if (cnst_is_mam_mmr(j)) unit = 'kg/kg' + + call addfld(trim(cnst_name(j))//'_'//trim(tags(i)), (/ 'lev' /), & + 'A', trim(unit), trim(cnst_name(j))//' at tag '//trim(tags(i))) + call add_default(trim(cnst_name(j))//'_'//trim(tags(i)), 1, ' ') + + end if + end do + + end do + +end subroutine phys_debug_state_init + +!=================================================================================================== + +subroutine phys_debug_state_out(tag, state) + + ! Dump selected state variables at location corresponding to given tag. + + character(len=*), intent(in) :: tag + type(physics_state), intent(in) :: state + + ! Local variables + integer :: lchnk, j + !----------------------------------------------------------------------------------------------- + + lchnk = state%lchnk + + call outfld('T_'//trim(tag), state%t, pcols, lchnk) + call outfld('U_'//trim(tag), state%u, pcols, lchnk) + call outfld('V_'//trim(tag), state%v, pcols, lchnk) + call outfld('QV_'//trim(tag), state%q(:,:,1), pcols, lchnk) + if (ixcldliq > 0) call outfld('QL_'//trim(tag), state%q(:,:,ixcldliq), pcols, lchnk) + if (ixcldice > 0) call outfld('QI_'//trim(tag), state%q(:,:,ixcldice), pcols, lchnk) + if (ixnumliq > 0) call outfld('NL_'//trim(tag), state%q(:,:,ixnumliq), pcols, lchnk) + if (ixnumice > 0) call outfld('NI_'//trim(tag), state%q(:,:,ixnumice), pcols, lchnk) + + do j = 1, pcnst + if (cnst_is_mam_num(j) .or. cnst_is_mam_mmr(j)) then + call outfld(trim(cnst_name(j))//'_'//trim(tag), state%q(:,:,j), pcols, lchnk) + end if + end do + +end subroutine phys_debug_state_out + + +!=================================================================================================== + +subroutine phys_debug_vdiff1(state, kvm, tautotx, tautoty) + + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: kvm(pcols,pverp) ! eddy diffusivity for momentum [m2/s] + real(r8), intent(in) :: tautotx(pcols) ! u component of total surface stress + real(r8), intent(in) :: tautoty(pcols) ! v component of total surface stress + + integer :: icol + !----------------------------------------------------------------------------- + + icol = phys_debug_col(state%lchnk) + if (icol > 0) then + write(iulog,*) ' vert_diff: kvm, u ', kvm(icol,pver), kvm(icol,pver-1), & + state%u(icol, pver), state%u(icol,pver-1), & + state%v(icol, pver), state%v(icol,pver-1) + write(iulog,*) ' vert_diff: taux, tauy ', tautotx(icol), tautoty(icol) + endif + +end subroutine phys_debug_vdiff1 + +!================================================================================ + +subroutine phys_debug_shallow1(state, ptend, nstep, prec_cmf, rliq2, ztodt, kmx) + + use constituents, only: cnst_get_ind + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(in) :: ptend ! Physics process tendencies + integer, intent(in) :: nstep + real(r8), intent(in) :: prec_cmf(pcols) ! total precipitation from Hack convection + real(r8), intent(in) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme + real(r8), intent(in) :: ztodt ! physics time step + integer, intent(out) :: kmx + + integer :: icol, k, kmn, ixcldliq + real(r8) :: qtmx, qtmn + !----------------------------------------------------------------------------- + + icol = phys_debug_col(state%lchnk) + if (icol > 0) then + qtmx = 0._r8 + kmx = 0 + qtmn = 0._r8 + kmn = 0 + do k = 1,pver + ! write (iulog,*) 'aaa ', k, ptend%q(icol,k,1), ptend%q(icol,k,2) + if (ptend%q(icol,k,1).ge.qtmx) then + kmx = k + qtmx = ptend%q(icol,k,1) + endif + if (ptend%q(icol,k,1).le.qtmn) then + kmn = k + qtmn = ptend%q(icol,k,1) + endif + end do + k = kmx +66 format ('tphysbc, aft shallow:', 4i5, 6f9.4) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + write (iulog,66) nstep, icol, & + kmx, kmn, & + prec_cmf(icol)*8.64e7_r8, rliq2(icol)*8.64e7_r8, & + qtmx*8.64e7_r8, qtmn*8.64e7_r8, & + (state%q(icol,k,1)+ptend%q(icol,k,1)*ztodt)*1.e3_r8, & + (state%q(icol,k,ixcldliq)+ptend%q(icol,k,ixcldliq)*ztodt)*1.e3_r8 + + endif + +end subroutine phys_debug_shallow1 + +!================================================================================ + +subroutine phys_debug_strat1(state, ptend, nstep, prec_str, rliq, ztodt, kmx) + + use constituents, only: cnst_get_ind + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(in) :: ptend ! Physics process tendencies + integer, intent(in) :: nstep + real(r8), intent(in) :: prec_str(pcols) ! sfc flux of precip from stratiform (m/s) + real(r8), intent(in) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(in) :: ztodt ! physics time step + integer, intent(in) :: kmx + + integer :: icol, k, ixcldliq + !----------------------------------------------------------------------------- + + icol = phys_debug_col(state%lchnk) + if (icol > 0) then + + k = kmx +67 format ('tphysbc, aft strat:', i5, 6f9.4) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + write (iulog,67) nstep, prec_str(icol)*8.64e7_r8, rliq(icol)*8.64e7_r8, & + (ptend%q(icol,k,1)*ztodt)*1.e3_r8, & + (ptend%q(icol,k,ixcldliq)*ztodt)*1.e3_r8, & + (state%q(icol,k,1)+ptend%q(icol,k,1)*ztodt)*1.e3_r8, & + (state%q(icol,k,ixcldliq)+ptend%q(icol,k,ixcldliq)*ztodt)*1.e3_r8 + + endif + +end subroutine phys_debug_strat1 + +!================================================================================ + +subroutine phys_debug_srf1(lchnk, cam_in) + + integer, intent(in) :: lchnk ! local chunk index + type(cam_in_t), intent(in) :: cam_in ! CAM's import state + + integer :: icol + !----------------------------------------------------------------------------- + + icol = phys_debug_col(lchnk) + if (icol > 0) then + + write(iulog,*) 'bot tphysbc: cam_in%tref', cam_in%tref(icol) + + endif + +end subroutine phys_debug_srf1 + +!================================================================================ + +subroutine phys_debug_hbdiff1(lchnk, pblh, zl, zh) + + integer, intent(in) :: lchnk ! local chunk index + real(r8), intent(in) :: pblh(pcols) ! boundary-layer height [m] + real(r8), intent(in) :: zl(pcols) ! zmzp / Obukhov length + real(r8), intent(in) :: zh(pcols) ! zmzp / pblh + + integer :: icol + !----------------------------------------------------------------------------- + + icol = phys_debug_col(lchnk) + if (icol > 0) then + + write(iulog,*) ' austach_pbl, pblh, zl, zh: ', pblh(icol), zl(icol), zh(icol) + + endif + +end subroutine phys_debug_hbdiff1 + +!================================================================================ + +subroutine phys_debug_flux1(lchnk, srfflx, lhflx, shflx, taux, tauy, qflx, & + lhflx_res, shflx_res, taux_res, tauy_res, qflx_res) + + integer, intent(in) :: lchnk ! local chunk index + type(cam_in_t), intent(in) :: srfflx ! cam import state + real(r8), intent(in) :: lhflx(:) ! latent heat flux + real(r8), intent(in) :: shflx(:) ! sensible heat flux + real(r8), intent(in) :: taux(:) ! x momentum flux + real(r8), intent(in) :: tauy(:) ! y momentum flux + real(r8), intent(in) :: qflx(:) ! water vapor heat flux + real(r8), intent(in) :: lhflx_res(:) ! latent heat flux + real(r8), intent(in) :: shflx_res(:) ! sensible heat flux + real(r8), intent(in) :: taux_res(:) ! x momentum flux + real(r8), intent(in) :: tauy_res(:) ! y momentum flux + real(r8), intent(in) :: qflx_res(:) ! water vapor heat flux + + integer :: icol + !----------------------------------------------------------------------------- + + icol = phys_debug_col(lchnk) + if (icol > 0) then + + write(iulog,*) ' b flux_tweak called, lhflx, oldlhflx ', & + srfflx%lhf(icol), lhflx(icol) + write(iulog,*) ' sfmodel fluxes lhf, shf, taux, tauy, q: ', & + srfflx%lhf(icol), & + srfflx%shf(icol), & + srfflx%wsx(icol), & + srfflx%wsy(icol), & + srfflx%cflx(icol,1) + write(iulog,*) ' last fluxes used lhf, shf, taux, tauy, q: ', & + lhflx(icol), & + shflx(icol), & + taux(icol), & + tauy(icol), & + qflx(icol) + write(iulog,*) ' current residuals lhf, shf, taux, tauy, q: ', & + lhflx_res(icol), & + shflx_res(icol), & + taux_res(icol), & + tauy_res(icol), & + qflx_res(icol) + + endif + +end subroutine phys_debug_flux1 + +!================================================================================ + +subroutine phys_debug_flux2(lchnk, srfflx, lhflx, & + lhflx_res, shflx_res, taux_res, tauy_res, qflx_res) + + integer, intent(in) :: lchnk ! local chunk index + type(cam_in_t), intent(in) :: srfflx ! cam import state + real(r8), intent(in) :: lhflx(:) ! latent heat flux + real(r8), intent(in) :: lhflx_res(:) ! latent heat flux + real(r8), intent(in) :: shflx_res(:) ! sensible heat flux + real(r8), intent(in) :: taux_res(:) ! x momentum flux + real(r8), intent(in) :: tauy_res(:) ! y momentum flux + real(r8), intent(in) :: qflx_res(:) ! water vapor heat flux + + integer :: icol + !----------------------------------------------------------------------------- + + icol = phys_debug_col(lchnk) + if (icol > 0) then + + write(iulog,*) ' a flux_tweak called, lhflx, oldlhflx ', & + srfflx%lhf(icol), lhflx(icol) + write (iulog,66) ' residual fractions lhf, shf, taux, tauy, q ', & + lhflx_res(icol)/srfflx%lhf(icol), & + shflx_res(icol)/srfflx%shf(icol), & + taux_res(icol)/srfflx%wsx(icol), & + tauy_res(icol)/srfflx%wsy(icol), & + qflx_res(icol)/srfflx%cflx(icol,1) + write(iulog,66) ' residual lhf, shf, taux, tauy, q: ', & + lhflx_res(icol), & + shflx_res(icol), & + taux_res(icol), & + tauy_res(icol), & + qflx_res(icol) + write(iulog,*) ' used fluxes lhf, shf, taux, tauy, q: ', & + srfflx%lhf(icol), & + srfflx%shf(icol), & + srfflx%wsx(icol), & + srfflx%wsy(icol), & + srfflx%cflx(icol,1) +66 format (a, 1p, 5e15.5) + + endif + +end subroutine phys_debug_flux2 + +end module phys_debug diff --git a/src/physics/cam/phys_debug_util.F90 b/src/physics/cam/phys_debug_util.F90 new file mode 100644 index 0000000000..a7775c2202 --- /dev/null +++ b/src/physics/cam/phys_debug_util.F90 @@ -0,0 +1,129 @@ +module phys_debug_util + +!---------------------------------------------------------------------------------------- + +! Module to facilitate debugging of physics parameterizations. +! +! The user requests a location for debugging in lat/lon coordinates +! (degrees). The initialization routine does a global search to find the +! column in the physics grid closest to the requested location. The local +! indices of that column in the physics decomposition are stored as module +! data. The user code then passes the local chunk index of the chunked +! data into the subroutine that will write diagnostic information for the +! column. The function phys_debug_col returns the local column index if +! the column of interest is contained in the chunk, and zero otherwise. +! Printing is done only if a column index >0 is returned. +! +! Phil Rasch, B. Eaton, Feb 2008 +!---------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use phys_grid, only: phys_grid_find_col, get_rlat_p, get_rlon_p +use spmd_utils, only: masterproc, iam +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +real(r8), parameter :: uninit_r8 = huge(1._r8) + +! Public methods +public phys_debug_readnl ! read namelist input +public phys_debug_init ! initialize the method to a chunk and column +public phys_debug_col ! return local column index in debug chunk + +! Namelist variables +real(r8) :: phys_debug_lat = uninit_r8 ! latitude of requested debug column location in degrees +real(r8) :: phys_debug_lon = uninit_r8 ! longitude of requested debug column location in degrees + + +integer :: debchunk = -999 ! local index of the chuck we will debug +integer :: debcol = -999 ! the column within the chunk we will debug + +!================================================================================ +contains +!================================================================================ + +subroutine phys_debug_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'phys_debug_readnl' + + namelist /phys_debug_nl/ phys_debug_lat, phys_debug_lon + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'phys_debug_nl', status=ierr) + if (ierr == 0) then + read(unitn, phys_debug_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(phys_debug_lat, 1, mpir8, 0, mpicom) + call mpibcast(phys_debug_lon, 1, mpir8, 0, mpicom) +#endif + +end subroutine phys_debug_readnl + +!================================================================================ + +subroutine phys_debug_init() + + integer :: owner, lchunk, icol + real(r8) :: deblat, deblon + !----------------------------------------------------------------------------- + + ! If no debug column specified then do nothing + if (phys_debug_lat == uninit_r8 .or. phys_debug_lon == uninit_r8) return + + ! User has specified a column location for debugging. Find the closest + ! column in the physics grid. + call phys_grid_find_col(phys_debug_lat, phys_debug_lon, owner, lchunk, icol) + + ! If the column is owned by this process then save its local indices + if (iam == owner) then + debchunk = lchunk + debcol = icol + deblat = get_rlat_p(lchunk, icol)*57.296_r8 ! approximate conversion for log output only + deblon = get_rlon_p(lchunk, icol)*57.296_r8 + write(iulog,*) 'phys_debug_init: debugging column at lat=', deblat, ' lon=', deblon + end if + +end subroutine phys_debug_init + +!================================================================================ + +integer function phys_debug_col(chunk) + + integer, intent(in) :: chunk + !----------------------------------------------------------------------------- + + if (chunk == debchunk) then + phys_debug_col = debcol + else + phys_debug_col = 0 + endif + +end function phys_debug_col + +!================================================================================ + +end module phys_debug_util diff --git a/src/physics/cam/phys_gmean.F90 b/src/physics/cam/phys_gmean.F90 new file mode 100644 index 0000000000..2fd003b96e --- /dev/null +++ b/src/physics/cam/phys_gmean.F90 @@ -0,0 +1,147 @@ +module phys_gmean +!----------------------------------------------------------------------- +! +! Purpose: +! Perform mixed layer global calculations for energy conservation checks. +! +! Methods: +! Reproducible (nonscalable): +! Gather to a master processor who does all the work. +! Reproducible (scalable): +! Convert to fixed point (integer representation) to enable +! reproducibility when using MPI collectives. Results compared with +! a nonreproducible (but scalable) algorithm using floating point +! and MPI_Allreduce to verify the results are good enough. +! +! Author: Byron Boville from SOM code by Jim Rosinski/Bruce Briegleb +! Modified: P. Worley to aggregate calculations (4/04) +! Modified: J. White/P. Worley to introduce scalable algorithms; +! B. Eaton to remove dycore-specific dependencies and to +! introduce gmean_mass (10/07) +! Modified: P. Worley to replace in-place implementation with call +! to repro_sum. +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use spmd_utils, only: masterproc, MPI_REAL8, MPI_MAX, MPI_MIN, mpicom + use gmean_mod, only: gmean + use ppgrid, only: pcols, begchunk, endchunk + use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, shr_reprosum_recompute + use perf_mod + use cam_logfile, only: iulog + + implicit none + private + save + + public :: gmean_mass ! compute global mean mass of constituent fields on physics decomposition + + CONTAINS + +! +!======================================================================== +! + + subroutine gmean_mass(title, state) +!----------------------------------------------------------------------- +! +! Purpose: +! Computes global mean mass, max and min mmr, of constituents on the +! physics decomposition. Prints diagnostics to log file. +! +! Author: B. Eaton (based on gavglook) +! +!----------------------------------------------------------------------- + use ppgrid, only: pver + use physconst, only: gravit + use phys_grid, only: get_ncols_p + use physics_types, only: physics_state + use constituents, only: pcnst, cnst_name +! +! Arguments +! + character(len=*), intent(in) :: title ! location of this call + type(physics_state), intent(in) :: state(begchunk:endchunk) +! +! Local workspace +! + character(len=*), parameter :: sub_name='gmean_mass: ' + + integer :: c, i, k, m + integer :: ierr + integer :: ncols + + real(r8), pointer :: mass_wet(:,:,:) ! constituent masses assuming moist mmr + real(r8), pointer :: mass_dry(:,:,:) ! constituent masses assuming dry mmr + real(r8) :: mass_wet_mean(pcnst) ! global mean constituent masses assuming moist mmr + real(r8) :: mass_dry_mean(pcnst) ! global mean constituent masses assuming dry mmr + real(r8) :: mmr_max(pcnst) ! maximum constituent mmr in this process + real(r8) :: mmr_min(pcnst) ! minimum constituent mmr in this process + real(r8) :: mmr_max_glob(pcnst) ! global maximum constituent mmr + real(r8) :: mmr_min_glob(pcnst) ! global minimum constituent mmr +! +!----------------------------------------------------------------------- +! + allocate(mass_wet(pcols,begchunk:endchunk,pcnst), stat=ierr) + if (ierr /= 0) write(iulog,*) sub_name // 'FAIL to allocate mass_wet' + + allocate(mass_dry(pcols,begchunk:endchunk,pcnst), stat=ierr) + if (ierr /= 0) write(iulog,*) sub_name // 'FAIL to allocate mass_wet' + + mmr_max(:) = -1.e36_r8 + mmr_min(:) = 1.e36_r8 + do m = 1, pcnst + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1, ncols + + ! Compute column masses assuming both dry and wet mixing ratios + + mass_wet(i,c,m) = 0.0_r8 + do k = 1, pver + mass_wet(i,c,m) = mass_wet(i,c,m) + & + state(c)%pdel(i,k)*state(c)%q(i,k,m) + mmr_max(m) = max(mmr_max(m), state(c)%q(i,k,m)) + mmr_min(m) = min(mmr_min(m), state(c)%q(i,k,m)) + end do + mass_wet(i,c,m) = mass_wet(i,c,m)/gravit + + mass_dry(i,c,m) = 0.0_r8 + do k = 1, pver + mass_dry(i,c,m) = mass_dry(i,c,m) + & + state(c)%pdeldry(i,k)*state(c)%q(i,k,m) + end do + mass_dry(i,c,m) = mass_dry(i,c,m)/gravit + + end do + end do + end do + + ! compute global mean mass + call gmean(mass_wet, mass_wet_mean, pcnst) + call gmean(mass_dry, mass_dry_mean, pcnst) + + ! global min/max mmr + call mpi_reduce(mmr_max, mmr_max_glob, pcnst, MPI_REAL8, MPI_MAX, 0, mpicom, ierr) + call mpi_reduce(mmr_min, mmr_min_glob, pcnst, MPI_REAL8, MPI_MIN, 0, mpicom, ierr) + + ! report to log file + if (masterproc) then + + do m = 1, pcnst + write (6,66) trim(title)//' m=',m, & + 'name='//trim(cnst_name(m))//' gavg dry, wet, min, max ', & + mass_dry_mean(m), mass_wet_mean(m), mmr_min_glob(m), mmr_max_glob(m) +66 format (a24,i2,a36,1p,4e25.13) + end do + + endif + + deallocate(mass_wet) + deallocate(mass_dry) + + end subroutine gmean_mass + +end module phys_gmean diff --git a/src/physics/cam/phys_grid.F90 b/src/physics/cam/phys_grid.F90 new file mode 100644 index 0000000000..e04dd34826 --- /dev/null +++ b/src/physics/cam/phys_grid.F90 @@ -0,0 +1,4934 @@ +module phys_grid +!----------------------------------------------------------------------- +! +! Purpose: Definition of physics computational horizontal grid. +! +! Method: Variables are private; interface routines used to extract +! information for use in user code. +! +! Entry points: +! phys_grid_readnl read namelist options +! +! phys_grid_init initialize chunk'ed data structure +! phys_grid_initialized get physgrid_set flag +! +! get_chunk_indices_p get local chunk index range +! get_ncols_p get number of columns for a given chunk +! get_xxx_all_p get global indices, coordinates, or values +! for a given chunk +! get_xxx_vec_p get global indices, coordinates, or values +! for a subset of the columns in a chunk +! get_xxx_p get global indices, coordinates, or values +! for a single column +! where xxx is +! area for column surface area (in radians squared) +! gcol for global column index +! lat for global latitude index +! lon for global longitude index +! rlat for latitude coordinate (in radians) +! rlon for longitude coordinate (in radians) +! wght for column integration weight +! +! scatter_field_to_chunk +! distribute field +! to decomposed chunk data structure +! gather_chunk_to_field +! reconstruct field +! from decomposed chunk data structure +! +! read_chunk_from_field +! read and distribute field +! to decomposed chunk data structure +! write_field_from_chunk +! write field +! from decomposed chunk data structure +! +! block_to_chunk_send_pters +! return pointers into send buffer where data +! from decomposed fields should +! be copied to +! block_to_chunk_recv_pters +! return pointers into receive buffer where data +! for decomposed chunk data structures should +! be copied from +! transpose_block_to_chunk +! transpose buffer containing decomposed +! fields to buffer +! containing decomposed chunk data structures +! +! chunk_to_block_send_pters +! return pointers into send buffer where data +! from decomposed chunk data structures should +! be copied to +! chunk_to_block_recv_pters +! return pointers into receive buffer where data +! for decomposed fields should +! be copied from +! transpose_chunk_to_block +! transpose buffer containing decomposed +! chunk data structures to buffer +! containing decomposed fields +! +! chunk_index identify whether index is for a latitude or +! a chunk +! +! FOLLOWING ARE NO LONGER USED, AND ARE CURRENTLY COMMENTED OUT +! get_gcol_owner_p get owner of column +! for given global physics column index +! +! buff_to_chunk Copy from local buffer to local chunk data +! structure. (Needed for cpl6.) +! +! chunk_to_buff Copy from local chunk data structure to +! local buffer. (Needed for cpl6.) +! +! Author: Patrick Worley and John Drake +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use physconst, only: pi + use ppgrid, only: pcols, pver, begchunk, endchunk +#if ( defined SPMD ) + use spmd_dyn, only: block_buf_nrecs, chunk_buf_nrecs, & + local_dp_map + use mpishorthand +#endif + use spmd_utils, only: iam, masterproc, npes, proc_smp_map, nsmps + use m_MergeSorts, only: IndexSet, IndexSort + use cam_abortutils, only: endrun + use perf_mod + use cam_logfile, only: iulog + + implicit none + save + +#if ( ! defined SPMD ) + integer, private :: block_buf_nrecs + integer, private :: chunk_buf_nrecs + logical, private :: local_dp_map=.true. +#endif + +! The identifier for the physics grid + integer, parameter, public :: phys_decomp = 100 + +! dynamics field grid information + integer, private :: hdim1_d, hdim2_d + ! dimensions of rectangular horizontal grid + ! data structure, If 1D data structure, then + ! hdim2_d == 1. + +! physics field data structures + integer :: ngcols ! global column count in physics grid (all) + integer, public :: ngcols_p ! global column count in physics grid + ! (without holes) + + integer, dimension(:), allocatable, private :: dyn_to_latlon_gcol_map + ! map from unsorted (dynamics) to lat/lon sorted grid indices + integer, dimension(:), allocatable, private :: latlon_to_dyn_gcol_map + ! map from lat/lon sorted grid to unsorted (dynamics) indices + integer, dimension(:), allocatable, private :: lonlat_to_dyn_gcol_map + ! map from lon/lat sorted grid to unsorted (dynamics) indices + + integer, private :: clat_p_tot ! number of unique latitudes + integer, private :: clon_p_tot ! number of unique longitudes + + integer, dimension(:), allocatable, private :: clat_p_cnt ! number of repeats for each latitude + integer, dimension(:), allocatable, private :: clat_p_idx ! index in latlon ordering for first occurence + ! of latitude corresponding to given + ! latitude index + real(r8), dimension(:), allocatable :: clat_p ! unique latitudes (radians, increasing) + + + integer, dimension(:), allocatable, private :: clon_p_cnt ! number of repeats for each longitude + real(r8), dimension(:), allocatable :: clon_p ! unique longitudes (radians, increasing) + + integer, dimension(:), allocatable, private :: lat_p ! index into list of unique column latitudes + integer, dimension(:), allocatable, private :: lon_p ! index into list of unique column longitudes + +! chunk data structures + type chunk + integer :: ncols ! number of vertical columns + integer :: gcol(pcols) ! global physics column indices + integer :: lon(pcols) ! global longitude indices + integer :: lat(pcols) ! global latitude indices + integer :: owner ! id of process where chunk assigned + integer :: lcid ! local chunk index + end type chunk + + integer :: nchunks ! global chunk count + type (chunk), dimension(:), allocatable, public :: chunks + ! global computational grid + + integer, dimension(:), allocatable, private :: npchunks + ! number of chunks assigned to each process + + type lchunk + integer :: ncols ! number of vertical columns + integer :: cid ! global chunk index + integer :: gcol(pcols) ! global physics column indices + real(r8) :: area(pcols) ! column surface area (from dynamics) + real(r8) :: wght(pcols) ! column integration weight (from dynamics) + end type lchunk + + integer, private :: nlchunks ! local chunk count + type (lchunk), dimension(:), allocatable, private :: lchunks + ! local chunks + + type knuhc + integer :: chunkid ! chunk id + integer :: col ! column index in chunk + end type knuhc + + type (knuhc), dimension(:), allocatable, private :: knuhcs + ! map from global column indices + ! to chunk'ed grid + +! column mapping data structures + type column_map + integer :: chunk ! global chunk index + integer :: ccol ! column ordering in chunk + end type column_map + + integer, private :: nlcols ! local column count + type (column_map), dimension(:), allocatable, private :: pgcols + ! ordered list of columns (for use in gather/scatter) + ! NOTE: consistent with local ordering + +! column remap data structures + integer, dimension(:), allocatable, private :: gs_col_num + ! number of columns scattered to each process in + ! field_to_chunk scatter + integer, dimension(:), allocatable, private :: gs_col_offset + ! offset of columns (-1) in pgcols scattered to + ! each process in field_to_chunk scatter + + integer, dimension(:), allocatable, private :: btofc_blk_num + ! number of grid points scattered to each process in + ! block_to_chunk alltoallv, and gathered from each + ! process in chunk_to_block alltoallv + + integer, dimension(:), allocatable, private :: btofc_chk_num + ! number of grid points gathered from each process in + ! block_to_chunk alltoallv, and scattered to each + ! process in chunk_to_block alltoallv + + type btofc_pters + integer :: ncols ! number of columns in block + integer :: nlvls ! number of levels in columns + integer, dimension(:,:), pointer :: pter + end type btofc_pters + type (btofc_pters), dimension(:), allocatable, private :: btofc_blk_offset + ! offset in btoc send array (-1) where + ! (blockid, bcid, k) column should be packed in + ! block_to_chunk alltoallv, AND + ! offset in ctob receive array (-1) from which + ! (blockid, bcid, k) column should be unpacked in + ! chunk_to_block alltoallv + + type (btofc_pters), dimension(:), allocatable, private :: btofc_chk_offset + ! offset in btoc receive array (-1) from which + ! (lcid, i, k) data should be unpacked in + ! block_to_chunk alltoallv, AND + ! offset in ctob send array (-1) where + ! (lcid, i, k) data should be packed in + ! chunk_to_block alltoallv + +! miscellaneous phys_grid data + integer, private :: dp_coup_steps ! number of swaps in transpose algorithm + integer, dimension(:), private, allocatable :: dp_coup_proc + ! swap partner in each step of + ! transpose algorithm + logical :: physgrid_set = .false. ! flag indicates physics grid has been set + integer, private :: max_nproc_smpx ! maximum number of processes assigned to a + ! single virtual SMP used to define physics + ! load balancing + integer, private :: nproc_busy_d ! number of processes active during the dynamics + ! (assigned a dynamics block) + +! Physics grid decomposition options: +! -1: each chunk is a dynamics block +! 0: chunk definitions and assignments do not require interprocess comm. +! 1: chunk definitions and assignments do not require internode comm. +! 2: chunk definitions and assignments may require communication between all processes +! 3: chunk definitions and assignments only require communication with one other process +! 4: concatenated blocks, no load balancing, no interprocess communication + integer, private, parameter :: min_lbal_opt = -1 + integer, private, parameter :: max_lbal_opt = 5 + integer, private, parameter :: def_lbal_opt = 2 ! default + integer, private :: lbal_opt = def_lbal_opt + +! Physics grid load balancing options: +! 0: assign columns to chunks as single columns, wrap mapped across chunks +! 1: use (day/night; north/south) twin algorithm to determine load-balanced pairs of +! columns and assign columns to chunks in pairs, wrap mapped + integer, private, parameter :: min_twin_alg = 0 + integer, private, parameter :: max_twin_alg = 1 + integer, private, parameter :: def_twin_alg_lonlat = 1 ! default + integer, private, parameter :: def_twin_alg_unstructured = 0 + integer, private :: twin_alg = def_twin_alg_lonlat + +! target number of chunks per thread + integer, private, parameter :: min_chunks_per_thread = 1 + integer, private, parameter :: def_chunks_per_thread = & + min_chunks_per_thread ! default + integer, private :: chunks_per_thread = def_chunks_per_thread + +! Dynamics/physics transpose method for nonlocal load-balance: +! -1: use "0" if max_nproc_smpx and nproc_busy_d are both > npes/2; otherwise use "1" +! 0: use mpi_alltoallv +! 1: use point-to-point MPI-1 two-sided implementation +! 2: use point-to-point MPI-2 one-sided implementation if supported, +! otherwise use MPI-1 implementation +! 3: use Co-Array Fortran implementation if supported, +! otherwise use MPI-1 implementation +! 11-13: use mod_comm, choosing any of several methods internal to mod_comm. +! The method within mod_comm (denoted mod_method) has possible values 0,1,2 and +! is set according to mod_method = phys_alltoall - modmin_alltoall, where +! modmin_alltoall is 11. + integer, private, parameter :: min_alltoall = -1 + integer, private, parameter :: max_alltoall = 3 +# if defined(MODCM_DP_TRANSPOSE) + integer, private, parameter :: modmin_alltoall = 11 + integer, private, parameter :: modmax_alltoall = 13 +# endif + integer, private, parameter :: def_alltoall = -1 ! default + integer, private :: phys_alltoall = def_alltoall + +!======================================================================== +contains +!======================================================================== + +subroutine phys_grid_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, & + phys_mirror_decomp_req +#if defined(MODCM_DP_TRANSPOSE) + use mod_comm, only: phys_transpose_mod +#endif + use dycore, only: dycore_is + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'phys_grid_readnl' + + integer :: phys_loadbalance + integer :: phys_twin_algorithm + integer :: phys_chnk_per_thd + + namelist /phys_grid_nl/ phys_alltoall, phys_loadbalance, phys_twin_algorithm, & + phys_chnk_per_thd + !----------------------------------------------------------------------------- + + ! Initialize namelist vars + phys_loadbalance = def_lbal_opt + + if (dycore_is('UNSTRUCTURED')) then + phys_twin_algorithm = def_twin_alg_unstructured + else + phys_twin_algorithm = def_twin_alg_lonlat + endif + + phys_chnk_per_thd = def_chunks_per_thread + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'phys_grid_nl', status=ierr) + if (ierr == 0) then + read(unitn, phys_grid_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(phys_alltoall, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: phys_alltoall") + call mpi_bcast(phys_loadbalance, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: phys_loadbalance") + call mpi_bcast(phys_twin_algorithm, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: phys_twin_algorithm") + call mpi_bcast(phys_chnk_per_thd, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: phys_chnk_per_thd") + + ! set module variables from namelist vars + + lbal_opt = phys_loadbalance + + if (lbal_opt .eq. 3) then + phys_mirror_decomp_req = .true. + else + phys_mirror_decomp_req = .false. + endif + + twin_alg = phys_twin_algorithm + + chunks_per_thread = phys_chnk_per_thd + + ! Some consistency checks + + if (((phys_alltoall .lt. min_alltoall) .or. & + (phys_alltoall .gt. max_alltoall)) & +# if defined(MODCM_DP_TRANSPOSE) + .and. & + ((phys_alltoall .lt. modmin_alltoall) .or. & + (phys_alltoall .gt. modmax_alltoall)) & +# endif + ) then + if (masterproc) then + write(iulog,*) sub//': ERROR: phys_alltoall=', phys_alltoall, & + ' is out of range. It must be between ', min_alltoall, ' and ', max_alltoall + endif + call endrun(sub//': ERROR setting phys_alltoall') + endif +#if defined(SPMD) +#if defined(MODCM_DP_TRANSPOSE) + phys_transpose_mod = phys_alltoall +#endif +#endif + + if ((lbal_opt < min_lbal_opt).or.(lbal_opt > max_lbal_opt)) then + if (masterproc) then + write(iulog,*) sub//': ERROR: phys_loadbalance=', phys_loadbalance, & + ' is out of range. It must be between ', min_lbal_opt, ' and ', max_lbal_opt + endif + call endrun(sub//': ERROR setting phys_loadbalance') + endif + + if ((twin_alg < min_twin_alg).or.(twin_alg > max_twin_alg)) then + if (masterproc) then + write(iulog,*) sub//': ERROR: phys_twin_algorithm=', phys_twin_algorithm, & + ' is out of range. It must be between ', min_twin_alg, ' and ', max_twin_alg + endif + call endrun(sub//': ERROR setting phys_twin_algorithm') + endif + + if (chunks_per_thread < min_chunks_per_thread) then + if (masterproc) then + write(iulog,*) sub//': ERROR: phys_chnk_per_thd=', phys_chnk_per_thd, & + ' is too small. It must not be smaller than ', min_chunks_per_thread + endif + call endrun(sub//': ERROR setting phys_chnk_per_thd') + endif + + + if (masterproc) then + write(iulog,*) 'PHYS_GRID options:' + write(iulog,*) ' Using PCOLS =', pcols + write(iulog,*) ' phys_loadbalance =', lbal_opt + write(iulog,*) ' phys_twin_algorithm =', twin_alg + write(iulog,*) ' phys_alltoall =', phys_alltoall + write(iulog,*) ' chunks_per_thread =', chunks_per_thread + end if + +end subroutine phys_grid_readnl + +!=============================================================================== + + integer function get_nlcols_p() + get_nlcols_p = nlcols + end function get_nlcols_p + + subroutine phys_grid_init( ) + !----------------------------------------------------------------------- + ! + ! Purpose: Physics mapping initialization routine: + ! + ! Method: + ! + ! Author: John Drake and Patrick Worley + ! + !----------------------------------------------------------------------- + use pmgrid, only: plev + use dycore, only: dycore_is + use dyn_grid, only: get_block_bounds_d, & + get_block_gcol_d, get_block_gcol_cnt_d, & + get_block_levels_d, get_block_lvl_cnt_d, & + get_block_owner_d, & + get_gcol_block_d, get_gcol_block_cnt_d, & + get_horiz_grid_dim_d, get_horiz_grid_d, physgrid_copy_attributes_d + use spmd_utils, only: pair, ceil2 + use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + use cam_grid_support, only: iMap, max_hcoordname_len + use cam_grid_support, only: horiz_coord_t, horiz_coord_create + use cam_grid_support, only: cam_grid_attribute_copy, cam_grid_attr_exists + + ! + !------------------------------Arguments-------------------------------- + ! + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i, j, jb, k, p ! loop indices + integer :: pre_i ! earlier index in loop iteration + integer :: clat_p_dex, clon_p_dex ! indices into unique lat. and lon. arrays + integer :: maxblksiz ! maximum number of columns in a dynamics block + integer :: beg_dex, end_dex ! index range + integer :: cid, lcid ! global and local chunk ids + integer :: max_ncols ! upper bound on number of columns in a block + integer :: ncols ! number of columns in current chunk + integer :: curgcol, curgcol_d ! current global column index + integer :: firstblock, lastblock ! global block indices + integer :: blksiz ! current block size + integer :: glbcnt, curcnt ! running grid point counts + integer :: curp ! current process id + integer :: block_cnt ! number of blocks containing data + ! for a given vertical column + integer :: numlvl ! number of vertical levels in block + ! column + integer :: levels(plev+1) ! vertical level indices + integer :: owner_d ! process owning given block column + integer :: owner_p ! process owning given chunk column + integer :: blockids(plev+1) ! block indices + integer :: bcids(plev+1) ! block column indices + + + ! column surface area (from dynamics) + real(r8), dimension(:), pointer :: area_d + + ! column integration weight (from dynamics) + real(r8), dimension(:), allocatable :: wght_d + + ! chunk global ordering + integer, dimension(:), allocatable :: pchunkid + + ! permutation array used in physics column sorting; + ! reused later as work space in (lbal_opt == -1) logic + integer, dimension(:), allocatable :: cdex + + ! latitudes and longitudes and column area for dynamics columns + real(r8), dimension(:), allocatable :: clat_d + real(r8), dimension(:), allocatable :: clon_d + real(r8), dimension(:), allocatable :: lat_d + real(r8), dimension(:), allocatable :: lon_d + real(r8) :: clat_p_tmp + real(r8) :: clon_p_tmp + + ! Maps and values for physics grid + real(r8), pointer :: lonvals(:) + real(r8), pointer :: latvals(:) + real(r8), allocatable :: latdeg_p(:) + real(r8), allocatable :: londeg_p(:) + integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: coord_map(:) + type(horiz_coord_t), pointer :: lat_coord + type(horiz_coord_t), pointer :: lon_coord + integer :: gcols(pcols) + character(len=max_hcoordname_len), pointer :: copy_attributes(:) + character(len=max_hcoordname_len) :: copy_gridname + logical :: unstructured + real(r8) :: lonmin, latmin + + nullify(area_d) + nullify(lonvals) + nullify(latvals) + nullify(grid_map) + nullify(coord_map) + nullify(lat_coord) + nullify(lon_coord) + + call t_adj_detailf(-2) + call t_startf("phys_grid_init") + + !----------------------------------------------------------------------- + ! + ! Initialize physics grid, using dynamics grid + ! a) column coordinates + + call get_horiz_grid_dim_d(hdim1_d,hdim2_d) + ngcols = hdim1_d*hdim2_d + allocate( clat_d(1:ngcols) ) + allocate( clon_d(1:ngcols) ) + allocate( lat_d(1:ngcols) ) + allocate( lon_d(1:ngcols) ) + allocate( cdex(1:ngcols) ) + clat_d = 100000.0_r8 + clon_d = 100000.0_r8 + call get_horiz_grid_d(ngcols, clat_d_out=clat_d, clon_d_out=clon_d, lat_d_out=lat_d, lon_d_out=lon_d) + latmin = MINVAL(ABS(lat_d)) + lonmin = MINVAL(ABS(lon_d)) +!!XXgoldyXX: To do: replace collection above with local physics points + + ! count number of "real" column indices + ngcols_p = 0 + do i=1,ngcols + if (clon_d(i) < 100000.0_r8) then + ngcols_p = ngcols_p + 1 + endif + enddo + + ! sort over longitude and identify unique longitude coordinates + call IndexSet(ngcols,cdex) + call IndexSort(ngcols,cdex,clon_d,descend=.false.) + clon_p_tmp = clon_d(cdex(1)) + clon_p_tot = 1 + + do i=2,ngcols_p + if (clon_d(cdex(i)) > clon_p_tmp) then + clon_p_tot = clon_p_tot + 1 + clon_p_tmp = clon_d(cdex(i)) + endif + enddo + + allocate( clon_p(1:clon_p_tot) ) + allocate( clon_p_cnt(1:clon_p_tot) ) + allocate( londeg_p(1:clon_p_tot) ) + + pre_i = 1 + clon_p_tot = 1 + clon_p(1) = clon_d(cdex(1)) + londeg_p(1) = lon_d(cdex(1)) + do i=2,ngcols_p + if (clon_d(cdex(i)) > clon_p(clon_p_tot)) then + clon_p_cnt(clon_p_tot) = i-pre_i + pre_i = i + clon_p_tot = clon_p_tot + 1 + clon_p(clon_p_tot) = clon_d(cdex(i)) + londeg_p(clon_p_tot) = lon_d(cdex(i)) + endif + enddo + clon_p_cnt(clon_p_tot) = (ngcols_p+1)-pre_i + + ! sort over latitude and identify unique latitude coordinates + call IndexSet(ngcols,cdex) + call IndexSort(ngcols,cdex,clat_d,descend=.false.) + clat_p_tmp = clat_d(cdex(1)) + clat_p_tot = 1 + do i=2,ngcols_p + if (clat_d(cdex(i)) > clat_p_tmp) then + clat_p_tot = clat_p_tot + 1 + clat_p_tmp = clat_d(cdex(i)) + endif + enddo + + allocate( clat_p(1:clat_p_tot) ) + allocate( clat_p_cnt(1:clat_p_tot) ) + allocate( clat_p_idx(1:clat_p_tot) ) + allocate( latdeg_p(1:clat_p_tot) ) + + pre_i = 1 + clat_p_tot = 1 + clat_p(1) = clat_d(cdex(1)) + latdeg_p(1) = lat_d(cdex(1)) + do i=2,ngcols_p + if (clat_d(cdex(i)) > clat_p(clat_p_tot)) then + clat_p_cnt(clat_p_tot) = i-pre_i + pre_i = i + clat_p_tot = clat_p_tot + 1 + clat_p(clat_p_tot) = clat_d(cdex(i)) + latdeg_p(clat_p_tot) = lat_d(cdex(i)) + endif + enddo + clat_p_cnt(clat_p_tot) = (ngcols_p+1)-pre_i + + clat_p_idx(1) = 1 + do j=2,clat_p_tot + clat_p_idx(j) = clat_p_idx(j-1) + clat_p_cnt(j-1) + enddo + + deallocate(lat_d) + deallocate(lon_d) + + ! sort by longitude within latitudes + end_dex = 0 + do j=1,clat_p_tot + beg_dex = end_dex + 1 + end_dex = end_dex + clat_p_cnt(j) + call IndexSort(cdex(beg_dex:end_dex),clon_d,descend=.false.) + enddo + + ! Early clean-up, to minimize memory high water mark + ! (not executing find_partner or find_twin) + if (((twin_alg .ne. 1) .and. (lbal_opt .ne. 3)) .or. & + (lbal_opt .eq. -1)) deallocate( clat_p_cnt) + + ! save "longitude within latitude" column ordering + ! and determine mapping from unsorted global column index to + ! unique latitude/longitude indices + allocate( lat_p(1:ngcols) ) + allocate( lon_p(1:ngcols) ) + allocate( dyn_to_latlon_gcol_map(1:ngcols) ) + if (lbal_opt .ne. -1) allocate( latlon_to_dyn_gcol_map(1:ngcols_p) ) + + clat_p_dex = 1 + lat_p = -1 + dyn_to_latlon_gcol_map = -1 + do i=1,ngcols_p + if (lbal_opt .ne. -1) latlon_to_dyn_gcol_map(i) = cdex(i) + dyn_to_latlon_gcol_map(cdex(i)) = i + + do while ((clat_p(clat_p_dex) < clat_d(cdex(i))) .and. & + (clat_p_dex < clat_p_tot)) + clat_p_dex = clat_p_dex + 1 + enddo + lat_p(cdex(i)) = clat_p_dex + enddo + + ! sort by latitude within longitudes + call IndexSet(ngcols,cdex) + call IndexSort(ngcols,cdex,clon_d,descend=.false.) + end_dex = 0 + do i=1,clon_p_tot + beg_dex = end_dex + 1 + end_dex = end_dex + clon_p_cnt(i) + call IndexSort(cdex(beg_dex:end_dex),clat_d,descend=.false.) + enddo + + ! Early clean-up, to minimize memory high water mark + ! (not executing find_twin) + if ((twin_alg .ne. 1) .or. (lbal_opt .eq. -1)) deallocate( clon_p_cnt ) + + ! save "latitude within longitude" column ordering + ! (only need in find_twin) + if ((twin_alg .eq. 1) .and. (lbal_opt .ne. -1)) & + allocate( lonlat_to_dyn_gcol_map(1:ngcols_p) ) + + clon_p_dex = 1 + lon_p = -1 + do i=1,ngcols_p + if ((twin_alg .eq. 1) .and. (lbal_opt .ne. -1)) & + lonlat_to_dyn_gcol_map(i) = cdex(i) + do while ((clon_p(clon_p_dex) < clon_d(cdex(i))) .and. & + (clon_p_dex < clon_p_tot)) + clon_p_dex = clon_p_dex + 1 + enddo + lon_p(cdex(i)) = clon_p_dex + enddo + + ! Clean-up + deallocate( clat_d ) + deallocate( clon_d ) + deallocate( cdex ) + + ! + ! Determine block index bounds + ! + call get_block_bounds_d(firstblock,lastblock) + + ! Allocate storage to save number of chunks and columns assigned to each + ! process during chunk creation and assignment + ! + allocate( npchunks(0:npes-1) ) + allocate( gs_col_num(0:npes-1) ) + npchunks(:) = 0 + gs_col_num(:) = 0 + + ! + ! Option -1: each dynamics block is a single chunk + ! + if (lbal_opt == -1) then + ! + ! Check that pcols >= maxblksiz + ! + maxblksiz = 0 + do jb=firstblock,lastblock + maxblksiz = max(maxblksiz,get_block_gcol_cnt_d(jb)) + enddo + if (pcols < maxblksiz) then + write(iulog,*) 'pcols = ',pcols, ' maxblksiz=',maxblksiz + call endrun ('PHYS_GRID_INIT error: phys_loadbalance -1 specified but PCOLS < MAXBLKSIZ') + endif + + ! + ! Determine total number of chunks + ! + nchunks = (lastblock-firstblock+1) + + ! + ! Set max virtual SMP node size + ! + max_nproc_smpx = 1 + + ! + ! Allocate and initialize chunks data structure + ! + allocate( cdex(1:maxblksiz) ) + allocate( chunks(1:nchunks) ) + + do cid=1,nchunks + ! get number of global column indices in block + max_ncols = get_block_gcol_cnt_d(cid+firstblock-1) + ! fill cdex array with global indices from current block + call get_block_gcol_d(cid+firstblock-1,max_ncols,cdex) + + ncols = 0 + do i=1,max_ncols + ! check whether global index is for a column that dynamics + ! intends to pass to the physics + curgcol_d = cdex(i) + if (dyn_to_latlon_gcol_map(curgcol_d) .ne. -1) then + ! yes - then save the information + ncols = ncols + 1 + chunks(cid)%gcol(ncols) = curgcol_d + chunks(cid)%lat(ncols) = lat_p(curgcol_d) + chunks(cid)%lon(ncols) = lon_p(curgcol_d) + endif + enddo + chunks(cid)%ncols = ncols + enddo + + ! Clean-up + deallocate( cdex ) + deallocate( lat_p ) + deallocate( lon_p ) + + ! + ! Specify parallel decomposition + ! + do cid=1,nchunks +#if (defined SPMD) + p = get_block_owner_d(cid+firstblock-1) +#else + p = 0 +#endif + chunks(cid)%owner = p + npchunks(p) = npchunks(p) + 1 + gs_col_num(p) = gs_col_num(p) + chunks(cid)%ncols + enddo + ! + ! Set flag indicating columns in physics and dynamics + ! decompositions reside on the same processes + ! + local_dp_map = .true. + ! + else + ! + ! Option == 0: split local blocks into chunks, + ! while attempting to create load-balanced chunks. + ! Does not work with vertically decomposed blocks. + ! (default) + ! Option == 1: split SMP-local blocks into chunks, + ! while attempting to create load-balanced chunks. + ! Does not work with vertically decomposed blocks. + ! Option == 2: load balance chunks with respect to diurnal and + ! seaonsal cycles and wth respect to latitude, + ! and assign chunks to processes + ! in a way that attempts to minimize communication costs + ! Option == 3: divide processes into pairs and split + ! blocks assigned to these pairs into + ! chunks, attempting to create load-balanced chunks. + ! The process pairs are chosen to maximize load balancing + ! opportunities. + ! Does not work with vertically decomposed blocks. + ! Option == 4: concatenate local blocks, then + ! divide into chunks. + ! Does not work with vertically decomposed blocks. + ! Option == 5: split indiviudal blocks into chunks, + ! assigning columns using block ordering + ! + ! + ! Allocate and initialize chunks data structure, then + ! assign chunks to processes. + ! + call create_chunks(lbal_opt, chunks_per_thread) + + ! Early clean-up, to minimize memory high water mark + deallocate( lat_p ) + deallocate( lon_p ) + deallocate( latlon_to_dyn_gcol_map ) + if (twin_alg .eq. 1) deallocate( lonlat_to_dyn_gcol_map ) + if (twin_alg .eq. 1) deallocate( clon_p_cnt ) + if ((twin_alg .eq. 1) .or. (lbal_opt .eq. 3)) deallocate( clat_p_cnt ) + + ! + ! Determine whether dynamics and physics decompositions + ! are colocated, not requiring any interprocess communication + ! in the coupling. + local_dp_map = .true. + do cid=1,nchunks + do i=1,chunks(cid)%ncols + curgcol_d = chunks(cid)%gcol(i) + block_cnt = get_gcol_block_cnt_d(curgcol_d) + call get_gcol_block_d(curgcol_d,block_cnt,blockids,bcids) + do jb=1,block_cnt + owner_d = get_block_owner_d(blockids(jb)) + if (owner_d .ne. chunks(cid)%owner) then + local_dp_map = .false. + endif + enddo + enddo + enddo + endif + ! + ! Allocate and initialize data structures for gather/scatter + ! + allocate( pgcols(1:ngcols_p) ) + allocate( gs_col_offset(0:npes) ) + allocate( pchunkid(0:npes) ) + + ! Initialize pchunkid and gs_col_offset by summing + ! number of chunks and columns per process, respectively + pchunkid(0) = 0 + gs_col_offset(0) = 0 + do p=1,npes-1 + pchunkid(p) = pchunkid(p-1) + npchunks(p-1) + gs_col_offset(p) = gs_col_offset(p-1) + gs_col_num(p-1) + enddo + + ! Determine local ordering via "process id" bin sort + do cid=1,nchunks + p = chunks(cid)%owner + pchunkid(p) = pchunkid(p) + 1 + + chunks(cid)%lcid = pchunkid(p) + lastblock + + curgcol = gs_col_offset(p) + do i=1,chunks(cid)%ncols + curgcol = curgcol + 1 + pgcols(curgcol)%chunk = cid + pgcols(curgcol)%ccol = i + enddo + gs_col_offset(p) = curgcol + enddo + + ! Reinitialize pchunkid and gs_col_offset (for real) + pchunkid(0) = 1 + gs_col_offset(0) = 1 + do p=1,npes-1 + pchunkid(p) = pchunkid(p-1) + npchunks(p-1) + gs_col_offset(p) = gs_col_offset(p-1) + gs_col_num(p-1) + enddo + pchunkid(npes) = pchunkid(npes-1) + npchunks(npes-1) + gs_col_offset(npes) = gs_col_offset(npes-1) + gs_col_num(npes-1) + + ! Save local information + ! (Local chunk index range chosen so that it does not overlap + ! {begblock,...,endblock}) + ! + nlcols = gs_col_num(iam) + nlchunks = npchunks(iam) + begchunk = pchunkid(iam) + lastblock + endchunk = pchunkid(iam+1) + lastblock - 1 + ! + allocate( lchunks(begchunk:endchunk) ) + do cid=1,nchunks + if (chunks(cid)%owner == iam) then + lcid = chunks(cid)%lcid + lchunks(lcid)%ncols = chunks(cid)%ncols + lchunks(lcid)%cid = cid + do i=1,chunks(cid)%ncols + lchunks(lcid)%gcol(i) = chunks(cid)%gcol(i) + enddo + endif + enddo + + deallocate( pchunkid ) + deallocate( npchunks ) + ! + !----------------------------------------------------------------------- + ! + ! Initialize physics grid, using dynamics grid + ! b) column area and integration weight + + allocate( area_d(1:ngcols) ) + allocate( wght_d(1:ngcols) ) + area_d = 0.0_r8 + wght_d = 0.0_r8 + + call get_horiz_grid_d(ngcols, area_d_out=area_d, wght_d_out=wght_d) + + + if ( abs(sum(area_d) - 4.0_r8*pi) > 1.e-10_r8 ) then + write(iulog,*) ' ERROR: sum of areas on globe does not equal 4*pi' + write(iulog,*) ' sum of areas = ', sum(area_d), sum(area_d)-4.0_r8*pi + call endrun('phys_grid') + end if + + if ( abs(sum(wght_d) - 4.0_r8*pi) > 1.e-10_r8 ) then + write(iulog,*) ' ERROR: sum of integration weights on globe does not equal 4*pi' + write(iulog,*) ' sum of weights = ', sum(wght_d), sum(wght_d)-4.0_r8*pi + call endrun('phys_grid') + end if + + do lcid=begchunk,endchunk + do i=1,lchunks(lcid)%ncols + lchunks(lcid)%area(i) = area_d(lchunks(lcid)%gcol(i)) + lchunks(lcid)%wght(i) = wght_d(lchunks(lcid)%gcol(i)) + enddo + enddo + + deallocate( area_d ) + nullify(area_d) + deallocate( wght_d ) + + if (.not. local_dp_map) then + ! + ! allocate and initialize data structures for transposes + ! + allocate( btofc_blk_num(0:npes-1) ) + btofc_blk_num = 0 + allocate( btofc_blk_offset(firstblock:lastblock) ) + do jb = firstblock,lastblock + nullify( btofc_blk_offset(jb)%pter ) + enddo + ! + glbcnt = 0 + curcnt = 0 + curp = 0 + do curgcol=1,ngcols_p + cid = pgcols(curgcol)%chunk + i = pgcols(curgcol)%ccol + owner_p = chunks(cid)%owner + do while (curp < owner_p) + btofc_blk_num(curp) = curcnt + curcnt = 0 + curp = curp + 1 + enddo + curgcol_d = chunks(cid)%gcol(i) + block_cnt = get_gcol_block_cnt_d(curgcol_d) + call get_gcol_block_d(curgcol_d,block_cnt,blockids,bcids) + do jb = 1,block_cnt + owner_d = get_block_owner_d(blockids(jb)) + if (iam == owner_d) then + if (.not. associated(btofc_blk_offset(blockids(jb))%pter)) then + blksiz = get_block_gcol_cnt_d(blockids(jb)) + numlvl = get_block_lvl_cnt_d(blockids(jb),bcids(jb)) + btofc_blk_offset(blockids(jb))%ncols = blksiz + btofc_blk_offset(blockids(jb))%nlvls = numlvl + allocate( btofc_blk_offset(blockids(jb))%pter(blksiz,numlvl) ) + endif + do k=1,btofc_blk_offset(blockids(jb))%nlvls + btofc_blk_offset(blockids(jb))%pter(bcids(jb),k) = glbcnt + curcnt = curcnt + 1 + glbcnt = glbcnt + 1 + enddo + endif + enddo + enddo + btofc_blk_num(curp) = curcnt + block_buf_nrecs = glbcnt + ! + allocate( btofc_chk_num(0:npes-1) ) + btofc_chk_num = 0 + allocate( btofc_chk_offset(begchunk:endchunk) ) + do lcid=begchunk,endchunk + ncols = lchunks(lcid)%ncols + btofc_chk_offset(lcid)%ncols = ncols + btofc_chk_offset(lcid)%nlvls = pver+1 + allocate( btofc_chk_offset(lcid)%pter(ncols,pver+1) ) + enddo + ! + curcnt = 0 + glbcnt = 0 + do p=0,npes-1 + do curgcol=gs_col_offset(iam),gs_col_offset(iam+1)-1 + cid = pgcols(curgcol)%chunk + owner_p = chunks(cid)%owner + if (iam == owner_p) then + i = pgcols(curgcol)%ccol + lcid = chunks(cid)%lcid + curgcol_d = chunks(cid)%gcol(i) + block_cnt = get_gcol_block_cnt_d(curgcol_d) + call get_gcol_block_d(curgcol_d,block_cnt,blockids,bcids) + do jb = 1,block_cnt + owner_d = get_block_owner_d(blockids(jb)) + if (p == owner_d) then + numlvl = get_block_lvl_cnt_d(blockids(jb),bcids(jb)) + call get_block_levels_d(blockids(jb),bcids(jb),numlvl,levels) + do k=1,numlvl + btofc_chk_offset(lcid)%pter(i,levels(k)+1) = glbcnt + curcnt = curcnt + 1 + glbcnt = glbcnt + 1 + enddo + endif + enddo + endif + enddo + btofc_chk_num(p) = curcnt + curcnt = 0 + enddo + chunk_buf_nrecs = glbcnt + ! + ! Precompute swap partners and number of steps in point-to-point + ! implementations of alltoall algorithm. + ! First, determine number of swaps. + ! + dp_coup_steps = 0 + do i=1,ceil2(npes)-1 + p = pair(npes,i,iam) + if (p >= 0) then + if ((btofc_blk_num(p) > 0 .or. btofc_chk_num(p) > 0)) then + dp_coup_steps = dp_coup_steps + 1 + end if + end if + end do + ! + ! Second, determine swap partners. + ! + allocate( dp_coup_proc(dp_coup_steps) ) + dp_coup_steps = 0 + do i=1,ceil2(npes)-1 + p = pair(npes,i,iam) + if (p >= 0) then + if ((btofc_blk_num(p) > 0 .or. btofc_chk_num(p) > 0)) then + dp_coup_steps = dp_coup_steps + 1 + dp_coup_proc(dp_coup_steps) = p + end if + end if + end do + ! + endif + + ! Final clean-up + deallocate( gs_col_offset ) + ! (if eliminate get_lon_xxx, can also deallocate + ! clat_p_idx, and grid_latlon?)) + + ! Add physics-package grid to set of CAM grids + ! physgrid always uses 'lat' and 'lon' as coordinate names; If dynamics + ! grid is different, it will use different coordinate names + + ! First, create a map for the physics grid + ! It's structure will depend on whether or not the physics grid is + ! unstructured + unstructured = dycore_is('UNSTRUCTURED') + if (unstructured) then + allocate(grid_map(3, pcols * (endchunk - begchunk + 1))) + else + allocate(grid_map(4, pcols * (endchunk - begchunk + 1))) + end if + grid_map = 0 + allocate(latvals(size(grid_map, 2))) + allocate(lonvals(size(grid_map, 2))) + p = 0 + do lcid = begchunk, endchunk + ncols = lchunks(lcid)%ncols + call get_gcol_all_p(lcid, pcols, gcols) + ! collect latvals and lonvals + cid = lchunks(lcid)%cid + do i = 1, chunks(cid)%ncols + latvals(p + i) = latdeg_p(chunks(cid)%lat(i)) + lonvals(p + i) = londeg_p(chunks(cid)%lon(i)) + end do + if (pcols > ncols) then + ! Need to set these to detect unused columns + latvals(p+ncols+1:p+pcols) = 1000.0_r8 + lonvals(p+ncols+1:p+pcols) = 1000.0_r8 + end if + + ! Set grid values for this chunk + do i = 1, pcols + p = p + 1 + grid_map(1, p) = i + grid_map(2, p) = lcid + if ((i <= ncols) .and. (gcols(i) > 0)) then + if (unstructured) then + grid_map(3, p) = gcols(i) + else + grid_map(3, p) = get_lon_p(lcid, i) + grid_map(4, p) = get_lat_p(lcid, i) + end if + else + if (i <= ncols) then + call endrun("phys_grid_init: unmapped column") + end if + end if + end do + end do + + ! Note that if the dycore is using the same points as the physics grid, + ! it will have already set up 'lat' and 'lon' axes for the physics grid + ! However, these will be in the dynamics decomposition + + if (unstructured) then + coord_map => grid_map(3,:) + lon_coord => horiz_coord_create('lon', 'ncol', ngcols_p, 'longitude', & + 'degrees_east', 1, size(lonvals), lonvals, map=coord_map) + lat_coord => horiz_coord_create('lat', 'ncol', ngcols_p, 'latitude', & + 'degrees_north', 1, size(latvals), latvals, map=coord_map) + else + ! Create a lon coord map which only writes from one of each unique lon + allocate(coord_map(size(grid_map, 2))) + where(latvals == latmin) + coord_map(:) = grid_map(3, :) + elsewhere + coord_map(:) = 0_iMap + end where + lon_coord => horiz_coord_create('lon', 'lon', hdim1_d, 'longitude', & + 'degrees_east', 1, size(lonvals), lonvals, map=coord_map) + nullify(coord_map) + ! Create a lat coord map which only writes from one of each unique lat + allocate(coord_map(size(grid_map, 2))) + where(lonvals == lonmin) + coord_map(:) = grid_map(4, :) + elsewhere + coord_map(:) = 0_iMap + end where + lat_coord => horiz_coord_create('lat', 'lat', hdim2_d, 'latitude', & + 'degrees_north', 1, size(latvals), latvals, map=coord_map) + end if + call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, & + grid_map, unstruct=unstructured, block_indexed=.true.) + ! Copy required attributes from the dynamics array + nullify(copy_attributes) + call physgrid_copy_attributes_d(copy_gridname, copy_attributes) + do i = 1, size(copy_attributes) + call cam_grid_attribute_copy(copy_gridname, 'physgrid', copy_attributes(i)) + end do + + if ((.not. cam_grid_attr_exists('physgrid', 'area')) .and. unstructured) then + ! Physgrid always needs an area attribute. If we did not inherit one + ! from the dycore (i.e., physics and dynamics are on different grids), + ! create that attribute here (unstructured grids only, physgrid is + ! not supported for structured grids). + allocate(area_d(size(grid_map, 2))) + p = 0 + do lcid = begchunk, endchunk + ncols = lchunks(lcid)%ncols + call get_gcol_all_p(lcid, pcols, gcols) + ! collect latvals and lonvals + cid = lchunks(lcid)%cid + do i = 1, chunks(cid)%ncols + area_d(p + i) = lchunks(lcid)%area(i) + end do + if (pcols > ncols) then + ! Need to set these to detect unused columns + area_d(p+ncols+1:p+pcols) = 0.0_r8 + end if + p = p + pcols + end do + call cam_grid_attribute_register('physgrid', 'area', & + 'physics column areas', 'ncol', area_d, map=coord_map) + nullify(area_d) ! Belongs to attribute now + end if + ! Cleanup pointers (they belong to the grid now) + nullify(coord_map) + nullify(grid_map) + deallocate(latvals) + nullify(latvals) + deallocate(lonvals) + nullify(lonvals) + ! Cleanup, we are responsible for copy attributes + if (associated(copy_attributes)) then + deallocate(copy_attributes) + nullify(copy_attributes) + end if + + ! + physgrid_set = .true. ! Set flag indicating physics grid is now set + ! + call t_stopf("phys_grid_init") + call t_adj_detailf(+2) + return + end subroutine phys_grid_init + +!======================================================================== + +subroutine phys_grid_find_col(lat, lon, owner, lcid, icol) + + !----------------------------------------------------------------------- + ! + ! Purpose: Find the global column closest to the point specified by lat + ! and lon. Return indices of owning process, local chunk, and + ! column. + ! + ! Authors: Phil Rasch / Patrick Worley / B. Eaton + ! + !----------------------------------------------------------------------- + + real(r8), intent(in) :: lat, lon ! requested location in degrees + integer, intent(out) :: owner ! rank of chunk owner + integer, intent(out) :: lcid ! local chunk index + integer, intent(out) :: icol ! column index within the chunk + + ! local + real(r8) dist2 ! the distance (in radians**2 from lat, lon) + real(r8) distmin ! the distance (in radians**2 from closest column) + real(r8) latr, lonr ! lat, lon (in radians) of requested location + real(r8) clat, clon ! lat, lon (in radians) of column being tested + real(r8) const + + integer i + integer cid + !----------------------------------------------------------------------- + + ! Check that input lat and lon are in valid range + if (lon < 0.0_r8 .or. lon >= 360._r8 .or. & + lat < -90._r8 .or. lat > 90._r8) then + if (masterproc) then + write(iulog,*) & + 'phys_grid_find_col: ERROR: lon must satisfy 0.<=lon<360. and lat must satisfy -90<=lat<=90.' + write(iulog,*) & + 'input lon=', lon, ' input lat=', lat + endif + call endrun('phys_grid_find_col: input ERROR') + end if + + const = 180._r8/pi ! degrees per radian + latr = lat/const ! to radians + lonr = lon/const ! to radians + + owner = -999 + lcid = -999 + icol = -999 + distmin = 1.e10_r8 + + ! scan all chunks for closest point to lat, lon + do cid = 1, nchunks + do i = 1, chunks(cid)%ncols + clat = clat_p(chunks(cid)%lat(i)) + clon = clon_p(chunks(cid)%lon(i)) + dist2 = (clat-latr)**2 + (clon-lonr)**2 + if (dist2 < distmin ) then + distmin = dist2 + owner = chunks(cid)%owner + lcid = chunks(cid)%lcid + icol = i + endif + enddo + end do + +end subroutine phys_grid_find_col + +!======================================================================== + +subroutine phys_grid_find_cols(lat, lon, nclosest, owner, lcid, icol, distmin, mlats, mlons) + + !----------------------------------------------------------------------- + ! + ! Purpose: Find the global columns closest to the point specified by lat + ! and lon. Return indices of owning process, local chunk, and + ! column. + ! + ! Authors: Phil Rasch / Patrick Worley / B. Eaton + ! + !----------------------------------------------------------------------- + use physconst, only : rearth + + real(r8), intent(in) :: lat, lon ! requested location in degrees + integer, intent(in) :: nclosest ! number of closest points to find + integer, intent(out) :: owner(nclosest) ! rank of chunk owner + integer, intent(out) :: lcid(nclosest) ! local chunk index + integer, intent(out) :: icol(nclosest) ! column index within the chunk + real(r8),intent(out) :: distmin(nclosest) ! the distance (m) of the closest column(s) + real(r8),intent(out) :: mlats(nclosest) ! the latitude of the closest column(s) + real(r8),intent(out) :: mlons(nclosest) ! the longitude of the closest column(s) + + ! local + real(r8) dist2 ! the distance (in radians**2 from lat, lon) + real(r8) latr, lonr ! lat, lon (in radians) of requested location + real(r8) clat, clon ! lat, lon (in radians) of column being tested + real(r8) const + + integer i, j + integer cid + !----------------------------------------------------------------------- + + ! Check that input lat and lon are in valid range + if (lon < 0.0_r8 .or. lon >= 360._r8 .or. & + lat < -90._r8 .or. lat > 90._r8) then + if (masterproc) then + write(iulog,*) & + 'phys_grid_find_cols: ERROR: lon must satisfy 0.<=lon<360. and lat must satisfy -90<=lat<=90.' + write(iulog,*) & + 'input lon=', lon, ' input lat=', lat + endif + call endrun('phys_grid_find_cols: input ERROR') + end if + + const = 180._r8/pi ! degrees per radian + latr = lat/const ! to radians + lonr = lon/const ! to radians + + owner(:) = -999 + lcid(:) = -999 + icol(:) = -999 + mlats(:) = -999 + mlons(:) = -999 + distmin(:) = 1.e10_r8 + + ! scan all chunks for closest point to lat, lon + do cid = 1, nchunks + do i = 1, chunks(cid)%ncols + clat = clat_p(chunks(cid)%lat(i)) + clon = clon_p(chunks(cid)%lon(i)) + dist2 = acos(sin(latr) * sin(clat) + cos(latr) * cos(clat) * cos(clon - lonr)) * rearth + + do j = nclosest, 1, -1 + if (dist2 < distmin(j)) then + + if (j < nclosest) then + distmin(j+1) = distmin(j) + owner(j+1) = owner(j) + lcid(j+1) = lcid(j) + icol(j+1) = icol(j) + mlats(j+1) = mlats(j) + mlons(j+1) = mlons(j) + end if + + distmin(j) = dist2 + owner(j) = chunks(cid)%owner + lcid(j) = chunks(cid)%lcid + icol(j) = i + mlats(j) = clat * const + mlons(j) = clon * const + else + exit + end if + enddo + enddo + end do + +end subroutine phys_grid_find_cols +! +!======================================================================== + +logical function phys_grid_initialized () +!----------------------------------------------------------------------- +! +! Purpose: Identify whether phys_grid has been called yet or not +! +! Method: Return physgrid_set +! +! Author: Pat Worley +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + phys_grid_initialized = physgrid_set +! + return + end function phys_grid_initialized + +! +!======================================================================== +! + subroutine get_chunk_indices_p(index_beg, index_end) +!----------------------------------------------------------------------- +! +! Purpose: Return range of indices for local chunks +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(out) :: index_beg ! first index used for local chunks + integer, intent(out) :: index_end ! last index used for local chunks +!----------------------------------------------------------------------- + + index_beg = begchunk + index_end = endchunk + + return + end subroutine get_chunk_indices_p +! +!======================================================================== +! + subroutine get_gcol_all_p(lcid, latdim, gcols) +!----------------------------------------------------------------------- +! +! Purpose: Return all global column indices for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: latdim ! declared size of output array + + integer, intent(out) :: gcols(:) ! array of global latitude indices +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + +!----------------------------------------------------------------------- + gcols=-1 + do i=1,lchunks(lcid)%ncols + gcols(i) = lchunks(lcid)%gcol(i) + enddo + return + end subroutine get_gcol_all_p + +! +!======================================================================== +! + integer function get_gcol_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return global physics column index for chunk column +! +! Method: +! +! Author: Jim Edwards / Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!----------------------------------------------------------------------- + get_gcol_p = lchunks(lcid)%gcol(col) + + return + end function get_gcol_p + +! +!======================================================================== + + subroutine get_gcol_vec_p(lcid, lth, cols, gcols) +!----------------------------------------------------------------------- +! +! Purpose: Return global physics column indices for set of chunk columns +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: lth ! number of column indices + integer, intent(in) :: cols(lth) ! column indices + + integer, intent(out) :: gcols(lth) ! array of global physics + ! columns indices + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + +!----------------------------------------------------------------------- + do i=1,lth + gcols(i) = lchunks(lcid)%gcol(cols(i)) + enddo + + return + end subroutine get_gcol_vec_p + +! +!======================================================================== +! + integer function get_ncols_p(lcid) +!----------------------------------------------------------------------- +! +! Purpose: Return number of columns in chunk given the local chunk id. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + +!---------------------------Local workspace----------------------------- + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + get_ncols_p = lchunks(lcid)%ncols + + return + end function get_ncols_p +! +!======================================================================== +! + subroutine get_lat_all_p(lcid, latdim, lats) +!----------------------------------------------------------------------- +! +! Purpose: Return all global latitude indices for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: latdim ! declared size of output array + + integer, intent(out) :: lats(latdim) ! array of global latitude indices + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,chunks(cid)%ncols + lats(i) = chunks(cid)%lat(i) + enddo + + return + end subroutine get_lat_all_p +! +!======================================================================== + + subroutine get_lat_vec_p(lcid, lth, cols, lats) +!----------------------------------------------------------------------- +! +! Purpose: Return global latitude indices for set of chunk columns +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: lth ! number of column indices + integer, intent(in) :: cols(lth) ! column indices + + integer, intent(out) :: lats(lth) ! array of global latitude indices + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,lth + lats(i) = chunks(cid)%lat(cols(i)) + enddo + + return + end subroutine get_lat_vec_p +! +!======================================================================== + + integer function get_lat_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return global latitude index for chunk column +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!---------------------------Local workspace----------------------------- + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + get_lat_p = chunks(cid)%lat(col) + + return + end function get_lat_p +! +!======================================================================== +! + subroutine get_lon_all_p(lcid, londim, lons) +!----------------------------------------------------------------------- +! +! Purpose: +! Was: Return all global longitude indices for chunk +! Now: Return all longitude offsets (+1) for chunk. These are offsets +! in ordered list of global columns from first +! column with given latitude to column with given latitude +! and longitude. This corresponds to the usual longitude indices +! for full and reduced lon/lat grids. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: londim ! declared size of output array + + integer, intent(out) :: lons(londim) ! array of global longitude + ! indices + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: lat ! latitude index + integer :: cid ! global chunk id + integer :: gcol ! global column id in latlon + ! ordering + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,chunks(cid)%ncols + lat = chunks(cid)%lat(i) + gcol = dyn_to_latlon_gcol_map(chunks(cid)%gcol(i)) + lons(i) = (gcol - clat_p_idx(lat)) + 1 + enddo + + return + end subroutine get_lon_all_p +! +!======================================================================== + + subroutine get_lon_vec_p(lcid, lth, cols, lons) +!----------------------------------------------------------------------- +! +! Purpose: +! Was: Return global longitude indices for set of chunk columns. +! Now: Return longitude offsets (+1) for set of chunk columns. +! These are offsets in ordered list of global columns from first +! column with given latitude to column with given latitude +! and longitude. This corresponds to the usual longitude indices +! for full and reduced lon/lat grids. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: lth ! number of column indices + integer, intent(in) :: cols(lth) ! column indices + + integer, intent(out) :: lons(lth) ! array of global longitude indices + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: lat ! latitude index + integer :: cid ! global chunk id + integer :: gcol ! global column id in latlon + ! ordering + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,lth + lat = chunks(cid)%lat(cols(i)) + gcol = dyn_to_latlon_gcol_map(chunks(cid)%gcol(i)) + lons(i) = (gcol - clat_p_idx(lat)) + 1 + enddo + + return + end subroutine get_lon_vec_p +! +!======================================================================== + + integer function get_lon_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: +! Was: Return global longitude index for chunk column. +! Now: Return longitude offset (+1) for chunk column. This is the +! offset in ordered list of global columns from first +! column with given latitude to column with given latitude +! and longitude. This corresponds to the usual longitude index +! for full and reduced lon/lat grids. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!---------------------------Local workspace----------------------------- + integer :: cid ! global chunk id + integer :: lat ! latitude index + integer :: gcol ! global column id in latlon + ! ordering + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + lat = chunks(cid)%lat(col) + gcol = dyn_to_latlon_gcol_map(chunks(cid)%gcol(col)) + get_lon_p = (gcol - clat_p_idx(lat)) + 1 + + return + end function get_lon_p +! +!======================================================================== +! + subroutine get_rlat_all_p(lcid, rlatdim, rlats) +!----------------------------------------------------------------------- +! +! Purpose: Return all latitudes (in radians) for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rlatdim ! declared size of output array + + real(r8), intent(out) :: rlats(rlatdim)! array of latitudes + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,chunks(cid)%ncols + rlats(i) = clat_p(chunks(cid)%lat(i)) + enddo + + return + end subroutine get_rlat_all_p +! +!======================================================================== +! + subroutine get_area_all_p(lcid, rdim, area) +!----------------------------------------------------------------------- +! +! Purpose: Return all areas for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rdim ! declared size of output array + + real(r8), intent(out) :: area(rdim) ! array of areas + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + +!----------------------------------------------------------------------- + do i=1,lchunks(lcid)%ncols + area(i) = lchunks(lcid)%area(i) + enddo + + return + end subroutine get_area_all_p +! +!======================================================================== +! + real(r8) function get_area_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return area for chunk column +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!----------------------------------------------------------------------- + get_area_p = lchunks(lcid)%area(col) + + return + end function get_area_p +! +!======================================================================== +! + subroutine get_wght_all_p(lcid, rdim, wght) +!----------------------------------------------------------------------- +! +! Purpose: Return all integration weights for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rdim ! declared size of output array + + real(r8), intent(out) :: wght(rdim) ! array of integration weights + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + +!----------------------------------------------------------------------- + do i=1,lchunks(lcid)%ncols + wght(i) = lchunks(lcid)%wght(i) + enddo + + return + end subroutine get_wght_all_p +! +!======================================================================== +! + real(r8) function get_wght_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return integration weight for chunk column +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!----------------------------------------------------------------------- + get_wght_p = lchunks(lcid)%wght(col) + + return + end function get_wght_p +! +!======================================================================== +! + subroutine get_rlat_vec_p(lcid, lth, cols, rlats) +!----------------------------------------------------------------------- +! +! Purpose: Return latitudes (in radians) for set of chunk columns +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: lth ! number of column indices + integer, intent(in) :: cols(lth) ! column indices + + real(r8), intent(out) :: rlats(lth) ! array of latitudes + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,lth + rlats(i) = clat_p(chunks(cid)%lat(cols(i))) + enddo + + return + end subroutine get_rlat_vec_p +! +!======================================================================== + + real(r8) function get_rlat_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return latitude (in radians) for chunk column +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!---------------------------Local workspace----------------------------- + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + get_rlat_p = clat_p(chunks(cid)%lat(col)) + + return + end function get_rlat_p +! +!======================================================================== +! + subroutine get_rlon_all_p(lcid, rlondim, rlons) +!----------------------------------------------------------------------- +! +! Purpose: Return all longitudes (in radians) for chunk +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rlondim ! declared size of output array + + real(r8), intent(out) :: rlons(rlondim)! array of longitudes + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,chunks(cid)%ncols + rlons(i) = clon_p(chunks(cid)%lon(i)) + enddo + + return + end subroutine get_rlon_all_p +! +!======================================================================== + + subroutine get_rlon_vec_p(lcid, lth, cols, rlons) +!----------------------------------------------------------------------- +! +! Purpose: Return longitudes (in radians) for set of chunk columns +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: lth ! number of column indices + integer, intent(in) :: cols(lth) ! column indices + + real(r8), intent(out) :: rlons(lth) ! array of longitudes + +!---------------------------Local workspace----------------------------- + integer :: i ! loop index + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + do i=1,lth + rlons(i) = clon_p(chunks(cid)%lon(cols(i))) + enddo + + return + end subroutine get_rlon_vec_p +! +!======================================================================== + + real(r8) function get_rlon_p(lcid, col) +!----------------------------------------------------------------------- +! +! Purpose: Return longitude (in radians) for chunk column +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use ppgrid +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + +!---------------------------Local workspace----------------------------- + integer :: cid ! global chunk id + +!----------------------------------------------------------------------- + cid = lchunks(lcid)%cid + get_rlon_p = clon_p(chunks(cid)%lon(col)) + + return + end function get_rlon_p +! +!======================================================================== +! +! integer function get_gcol_owner_p(gcol) +!----------------------------------------------------------------------- +! +! Purpose: Return owner of physics column with indicate index +! +! Method: +! +! Author: P. Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- +! integer, intent(in) :: gcol ! physics column index +! +!----------------------------------------------------------------------- +! +! get_gcol_owner_p = chunks(knuhcs(gcol)%chunkid)%owner +! +! return +! end function get_gcol_owner_p +! +!======================================================================== + +! subroutine buff_to_chunk(fdim,mdim,lbuff,localchunks) +!----------------------------------------------------------------------- +! +! Purpose: Copy from local buffer +! to local chunk data structure. +! Needed for cpl6. +! +! Method: +! +! Author: Pat Worley and Robert Jacob +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- +! integer, intent(in) :: fdim ! declared length of first lbuff dimension +! integer, intent(in) :: mdim ! declared length of middle lbuff dimension +! real(r8), intent(in) :: lbuff(fdim, mdim) ! local lon/lat buffer +! +! real(r8), intent(out):: localchunks(pcols,mdim,begchunk:endchunk) ! local chunks +! +! +!---------------------------Local workspace----------------------------- +! integer :: i,j,m,n ! loop indices +! +! integer, save :: numcols = 0 +! integer, allocatable, save :: columnid(:), chunkid(:) +!----------------------------------------------------------------------- +! +! if (numcols .eq. 0) then +! n = 0 +! do i=1,ngcols +! if (dyn_to_latlon_gcol_map(i) .ne. -1) then +! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then +! n = n + 1 +! endif +! endif +! enddo +! allocate(columnid(1:n)) +! allocate(chunkid(1:n)) +! +! n = 0 +! do i=1,ngcols +! if (dyn_to_latlon_gcol_map(i) .ne. -1) then +! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then +! n = n + 1 +! columnid(n) = knuhcs(i)%col +! chunkid(n) = chunks(knuhcs(i)%chunkid)%lcid +! endif +! endif +! end do +! +! numcols = n +! endif +! +! if (numcols .gt. fdim) call endrun('buff_to_chunk') +! do m=1,mdim +! do n = 1, numcols +! localchunks(columnid(n),m,chunkid(n)) = lbuff(n,m) +! end do +! end do +! +! return +! end subroutine buff_to_chunk +! +!======================================================================== + + subroutine scatter_field_to_chunk(fdim,mdim,ldim, & + hdim1d,globalfield,localchunks) +!----------------------------------------------------------------------- +! +! Purpose: Distribute field +! to decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + real(r8), intent(in) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + ! global field + + real(r8), intent(out):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + ! local chunks + +!---------------------------Local workspace----------------------------- + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + real(r8) gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be scattered + real(r8) lfield_p(fdim,mdim,ldim,nlcols) + ! local component of scattered + ! vector + integer :: displs(0:npes-1) ! scatter displacements + integer :: sndcnts(0:npes-1) ! scatter send counts + integer :: recvcnt ! scatter receive count + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + write(iulog,*) __FILE__,__LINE__,hdim1d,hdim1_d + call endrun ('SCATTER_FIELD_TO_CHUNK error: hdim1d < hdim1_d') + endif + localchunks(:,:,:,:,:) = 0 +#if ( defined SPMD ) + displs(0) = 0 + sndcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + sndcnts(p-1) + sndcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + recvcnt = fdim*mdim*ldim*nlcols + + if (masterproc) then + +! copy field into global (process-ordered) chunked data structure + + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + gfield_p(f,m,l,i) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + endif + +! scatter to other processes +! (pgcols ordering consistent with begchunk:endchunk +! local ordering) + + call t_barrierf('sync_scat_ftoc', mpicom) + call mpiscatterv(gfield_p, sndcnts, displs, mpir8, & + lfield_p, recvcnt, mpir8, 0, mpicom) + +! copy into local chunked data structure + + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do l=1,ldim + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + lfield_p(f, m, l, i) + end do + end do + end do + end do +#else + +! copy field into chunked data structure +! (pgcol ordering chosen to reflect begchunk:endchunk +! local ordering) + + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + +#endif + + return + end subroutine scatter_field_to_chunk +!======================================================================== + + subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & + hdim1d,globalfield,localchunks) +!----------------------------------------------------------------------- +! +! Purpose: Distribute field +! to decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + real(r4), intent(in) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + ! global field + + real(r4), intent(out):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + ! local chunks + +!---------------------------Local workspace----------------------------- + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + real(r4) gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be scattered + real(r4) lfield_p(fdim,mdim,ldim,nlcols) + ! local component of scattered + ! vector + integer :: displs(0:npes-1) ! scatter displacements + integer :: sndcnts(0:npes-1) ! scatter send counts + integer :: recvcnt ! scatter receive count + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + call endrun ('SCATTER_FIELD_TO_CHUNK4 error: hdim1d < hdim1_d') + endif +#if ( defined SPMD ) + displs(0) = 0 + sndcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + sndcnts(p-1) + sndcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + recvcnt = fdim*mdim*ldim*nlcols + + if (masterproc) then + ! copy field into global (process-ordered) chunked data structure + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + gfield_p(f,m,l,i) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + endif + +! scatter to other processes +! (pgcols ordering consistent with begchunk:endchunk +! local ordering) + + call t_barrierf('sync_scat_ftoc', mpicom) + call mpiscatterv(gfield_p, sndcnts, displs, mpir4, & + lfield_p, recvcnt, mpir4, 0, mpicom) + +! copy into local chunked data structure + + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do l=1,ldim + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + lfield_p(f, m, l, i) + end do + end do + end do + end do +#else + + ! copy field into chunked data structure + ! (pgcol ordering chosen to reflect begchunk:endchunk + ! local ordering) + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + +#endif + + return + end subroutine scatter_field_to_chunk4 +!======================================================================== + + subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & + hdim1d,globalfield,localchunks) +!----------------------------------------------------------------------- +! +! Purpose: Distribute field +! to decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + integer, intent(in) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + ! global field + + integer, intent(out):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + ! local chunks + +!---------------------------Local workspace----------------------------- + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + integer gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be scattered + integer lfield_p(fdim,mdim,ldim,nlcols) + ! local component of scattered + ! vector + integer :: displs(0:npes-1) ! scatter displacements + integer :: sndcnts(0:npes-1) ! scatter send counts + integer :: recvcnt ! scatter receive count + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + call endrun ('SCATTER_FIELD_TO_CHUNK_INT error: hdim1d < hdim1_d') + endif +#if ( defined SPMD ) + displs(0) = 0 + sndcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + sndcnts(p-1) + sndcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + recvcnt = fdim*mdim*ldim*nlcols + + if (masterproc) then + +! copy field into global (process-ordered) chunked data structure + + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + gfield_p(f,m,l,i) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + endif + +! scatter to other processes +! (pgcols ordering consistent with begchunk:endchunk +! local ordering) + + call t_barrierf('sync_scat_ftoc', mpicom) + call mpiscatterv(gfield_p, sndcnts, displs, mpiint, & + lfield_p, recvcnt, mpiint, 0, mpicom) + +! copy into local chunked data structure + + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do l=1,ldim + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + lfield_p(f, m, l, i) + end do + end do + end do + end do +#else + +! copy field into chunked data structure +! (pgcol ordering chosen to reflect begchunk:endchunk +! local ordering) + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + localchunks(f,lid,m,lcid,l) = & + globalfield(f, h1, m, h2, l) + end do + end do + end do + end do + +#endif + + return + end subroutine scatter_field_to_chunk_int +! +!======================================================================== +! +! subroutine chunk_to_buff(fdim,mdim,localchunks,lbuff) +! +!----------------------------------------------------------------------- +! +! Purpose: Copy from local chunk data structure +! to local buffer. Needed for cpl6. +! (local = assigned to same process) +! +! Method: +! +! Author: Pat Worley and Robert Jacob +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- +! integer, intent(in) :: fdim ! declared length of first lbuff dimension +! integer, intent(in) :: mdim ! declared length of middle lbuff dimension +! real(r8), intent(in):: localchunks(pcols,mdim, begchunk:endchunk) ! local chunks +! +! real(r8), intent(out) :: lbuff(fdim,mdim) ! local buff +! +!---------------------------Local workspace----------------------------- +! integer :: i,j,m,n ! loop indices +! +! integer, save :: numcols = 0 +! integer, allocatable, save :: columnid(:), chunkid(:) +!----------------------------------------------------------------------- +! +! if (numcols .eq. 0) then +! n = 0 +! do i=1,ngcols +! if (dyn_to_latlon_gcol_map(i) .ne. -1) then +! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then +! n = n + 1 +! endif +! endif +! enddo +! allocate(columnid(1:n)) +! allocate(chunkid(1:n)) +! +! n = 0 +! do i=1,ngcols +! if (dyn_to_latlon_gcol_map(i) .ne. -1) then +! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then +! n = n + 1 +! columnid(n) = knuhcs(i)%col +! chunkid(n) = chunks(knuhcs(i)%chunkid)%lcid +! endif +! endif +! end do +! +! numcols = n +! endif +! +! if (numcols .gt. fdim) call endrun('chunk_to_buff') +! do m=1,mdim +! do n = 1, numcols +! lbuff(n,m) = localchunks(columnid(n),m,chunkid(n)) +! end do +! end do +! +! return +! end subroutine chunk_to_buff +! +! +!======================================================================== +! + subroutine gather_chunk_to_field(fdim,mdim,ldim, & + hdim1d,localchunks,globalfield) + +!----------------------------------------------------------------------- +! +! Purpose: Reconstruct field +! from decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) + use spmd_utils, only: fc_gatherv +#endif +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + real(r8), intent(in):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + ! local chunks + + real(r8), intent(out) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + ! global field + +!---------------------------Local workspace----------------------------- + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + real(r8) gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be gathered + real(r8) lfield_p(fdim,mdim,ldim,nlcols) + ! local component of gather + ! vector + integer :: displs(0:npes-1) ! gather displacements + integer :: rcvcnts(0:npes-1) ! gather receive count + integer :: sendcnt ! gather send counts + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + call endrun ('GATHER_CHUNK_TO_FIELD error: hdim1d < hdim1_d') + endif +#if ( defined SPMD ) + displs(0) = 0 + rcvcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + rcvcnts(p-1) + rcvcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + sendcnt = fdim*mdim*ldim*nlcols + +! copy into local gather data structure + + do l=1,ldim + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do m=1,mdim + do f=1,fdim + lfield_p(f, m, l, i) = & + localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +! gather from other processes + + call t_barrierf('sync_gath_ctof', mpicom) + call fc_gatherv(lfield_p, sendcnt, mpir8, & + gfield_p, rcvcnts, displs, mpir8, 0, mpicom) + + if (masterproc) then + +! copy gathered columns into lon/lat field + + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do l=1,ldim + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = gfield_p(f,m,l,i) + end do + end do + end do + end do + endif + call mpibarrier(mpicom) +#else + + ! copy chunked data structure into dynamics field + ! (pgcol ordering chosen to reflect begchunk:endchunk + ! local ordering) + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +#endif + + return + end subroutine gather_chunk_to_field + +! +!======================================================================== +! + subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & + hdim1d,localchunks,globalfield) + +!----------------------------------------------------------------------- +! +! Purpose: Reconstruct field +! from decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) + use spmd_utils, only: fc_gathervr4 +#endif +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + real(r4), intent(in):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + ! local chunks + + real(r4), intent(out) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + ! global field + +!---------------------------Local workspace----------------------------- + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + real(r4) gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be gathered + real(r4) lfield_p(fdim,mdim,ldim,nlcols) + ! local component of gather + ! vector + integer :: displs(0:npes-1) ! gather displacements + integer :: rcvcnts(0:npes-1) ! gather receive count + integer :: sendcnt ! gather send counts + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + call endrun ('GATHER_CHUNK_TO_FIELD4 error: hdim1d < hdim1_d') + endif +#if ( defined SPMD ) + displs(0) = 0 + rcvcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + rcvcnts(p-1) + rcvcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + sendcnt = fdim*mdim*ldim*nlcols + +! copy into local gather data structure + + do l=1,ldim + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do m=1,mdim + do f=1,fdim + lfield_p(f, m, l, i) = & + localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +! gather from other processes + + call t_barrierf('sync_gath_ctof', mpicom) + call fc_gathervr4(lfield_p, sendcnt, mpir4, & + gfield_p, rcvcnts, displs, mpir4, 0, mpicom) + + if (masterproc) then + +! copy gathered columns into lon/lat field + + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do l=1,ldim + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = gfield_p(f,m,l,i) + end do + end do + end do + end do + endif + +#else + +! copy chunked data structure into dynamics field +! (pgcol ordering chosen to reflect begchunk:endchunk +! local ordering) + + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +#endif + + return + end subroutine gather_chunk_to_field4 + +! +!======================================================================== +! + subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & + hdim1d,localchunks,globalfield) + +!----------------------------------------------------------------------- +! +! Purpose: Reconstruct field +! from decomposed chunk data structure +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) + use spmd_utils, only: fc_gathervint +#endif +!------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + ! dimension + integer, intent(in):: localchunks(fdim,pcols,mdim,begchunk:endchunk,ldim) ! local chunks + + integer, intent(out) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) ! global field + +!---------------------------Local workspace----------------------------- + + integer :: f,i,m,l,p ! loop indices + integer :: cid ! global chunk id + integer :: lcid ! local chunk id + integer :: lid ! local column index + integer :: gcol ! global column index + integer :: h1 ! first horizontal dimension index + integer :: h2 ! second horizontal dimension index + +#if ( defined SPMD ) + integer gfield_p(fdim,mdim,ldim,ngcols) + ! vector to be gathered + integer lfield_p(fdim,mdim,ldim,nlcols) + ! local component of gather + ! vector + integer :: displs(0:npes-1) ! gather displacements + integer :: rcvcnts(0:npes-1) ! gather receive count + integer :: sendcnt ! gather send counts + integer :: beglcol ! beginning index for local columns + ! in global column ordering +#endif + +!----------------------------------------------------------------------- + if (hdim1d < hdim1_d) then + call endrun ('GATHER_CHUNK_TO_FIELD_INT error: hdim1d < hdim1_d') + endif +#if ( defined SPMD ) + displs(0) = 0 + rcvcnts(0) = fdim*mdim*ldim*gs_col_num(0) + beglcol = 0 + do p=1,npes-1 + displs(p) = displs(p-1) + rcvcnts(p-1) + rcvcnts(p) = fdim*mdim*ldim*gs_col_num(p) + if (p <= iam) then + beglcol = beglcol + gs_col_num(p-1) + endif + enddo + sendcnt = fdim*mdim*ldim*nlcols + +! copy into local gather data structure + + do l=1,ldim + do i=1,nlcols + cid = pgcols(beglcol+i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(beglcol+i)%ccol + do m=1,mdim + do f=1,fdim + lfield_p(f, m, l, i) = & + localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +! gather from other processes + + call t_barrierf('sync_gath_ctof', mpicom) + call fc_gathervint(lfield_p, sendcnt, mpiint, & + gfield_p, rcvcnts, displs, mpiint, 0, mpicom) + + if (masterproc) then + +! copy gathered columns into lon/lat field + + do i=1,ngcols_p + cid = pgcols(i)%chunk + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do l=1,ldim + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = gfield_p(f,m,l,i) + end do + end do + end do + end do + endif + +#else + + ! copy chunked data structure into lon/lat field + ! (pgcol ordering chosen to reflect begchunk:endchunk + ! local ordering) + do l=1,ldim + do i=1,ngcols_p + cid = pgcols(i)%chunk + lcid = chunks(cid)%lcid + lid = pgcols(i)%ccol + gcol = chunks(cid)%gcol(lid) + h2 = (gcol-1)/hdim1_d + 1 + h1 = mod((gcol-1),hdim1_d) + 1 + do m=1,mdim + do f=1,fdim + globalfield(f, h1, m, h2, l) & + = localchunks(f,lid,m,lcid,l) + end do + end do + end do + end do + +#endif + + return + end subroutine gather_chunk_to_field_int + +! +!======================================================================== +! + subroutine write_field_from_chunk(iu,fdim,mdim,ldim,localchunks) + +!----------------------------------------------------------------------- +! +! +! Purpose: Write field from decomposed chunk data +! structure +! +! Method: +! +! Author: Patrick Worley +! +!------------------------------Arguments-------------------------------- + integer, intent(in) :: iu ! logical unit + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + real(r8), intent(in):: localchunks(fdim,pcols,mdim,begchunk:endchunk,ldim) ! local chunks + +!---------------------------Local workspace----------------------------- + + integer :: ioerr ! error return + + real(r8), allocatable :: globalfield(:,:,:,:,:) + ! global field +!----------------------------------------------------------------------- + + allocate(globalfield(fdim,hdim1_d,mdim,hdim2_d,ldim)) + + call gather_chunk_to_field (fdim,mdim,ldim,hdim1_d,localchunks,globalfield) + + if (masterproc) then + write (iu,iostat=ioerr) globalfield + if (ioerr /= 0 ) then + write(iulog,*) 'WRITE_FIELD_FROM_CHUNK ioerror ', ioerr,' on i/o unit = ',iu + call endrun + end if + endif + + deallocate(globalfield) + + return + end subroutine write_field_from_chunk + +! +!======================================================================== +! + subroutine read_chunk_from_field(iu,fdim,mdim,ldim,localchunks) + +!----------------------------------------------------------------------- +! +! +! Purpose: Write field from decomposed chunk data +! structure +! +! Method: +! +! Author: Patrick Worley +! +!------------------------------Arguments-------------------------------- + integer, intent(in) :: iu ! logical unit + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + + real(r8), intent(out):: localchunks(fdim,pcols,mdim,begchunk:endchunk,ldim) ! local chunks + +!---------------------------Local workspace----------------------------- + + integer :: ioerr ! error return + + real(r8), allocatable :: globalfield(:,:,:,:,:) + ! global field +!----------------------------------------------------------------------- + + allocate(globalfield(fdim,hdim1_d,mdim,hdim2_d,ldim)) + + if (masterproc) then + read (iu,iostat=ioerr) globalfield + if (ioerr /= 0 ) then + write(iulog,*) 'READ_CHUNK_FROM_FIELD ioerror ', ioerr,' on i/o unit = ',iu + call endrun + end if + endif + + call scatter_field_to_chunk (fdim,mdim,ldim,hdim1_d,globalfield,localchunks) + + deallocate(globalfield) + + return + end subroutine read_chunk_from_field +! +!======================================================================== + + subroutine transpose_block_to_chunk(record_size, block_buffer, & + chunk_buffer, window) + +!----------------------------------------------------------------------- +! +! Purpose: Transpose buffer containing decomposed +! fields to buffer +! containing decomposed chunk data structures +! +! Method: +! +! Author: Patrick Worley +! Modified: Art Mirin, Jan 04, to add support for mod_comm +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) +# if defined(MODCM_DP_TRANSPOSE) + use mod_comm, only: blockdescriptor, mp_sendirr, mp_recvirr, & + get_partneroffset, max_nparcels + use mpishorthand, only : mpicom +# endif + use spmd_utils, only: altalltoallv +#endif +!------------------------------Parameters------------------------------- +! + integer, parameter :: msgtag = 6000 +!------------------------------Arguments-------------------------------- + integer, intent(in) :: record_size ! per column amount of data + real(r8), intent(in) :: block_buffer(record_size*block_buf_nrecs) + ! buffer of block data to be + ! transposed + real(r8), intent(out):: chunk_buffer(record_size*chunk_buf_nrecs) + ! buffer of chunk data + ! transposed into + integer, intent(in), optional :: window + ! MPI-2 window id for + ! chunk_buffer + +!---------------------------Local workspace----------------------------- +#if ( defined SPMD ) + integer :: p ! loop indices + integer :: bbuf_siz ! size of block_buffer + integer :: cbuf_siz ! size of chunk_buffer + integer :: lwindow ! placeholder for missing window + integer :: lopt ! local copy of phys_alltoall +! + logical, save :: first = .true. + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: pdispls(:) + integer, save :: prev_record_size = 0 +# if defined(MODCM_DP_TRANSPOSE) + type (blockdescriptor), allocatable, save :: sendbl(:), recvbl(:) + integer ione, ierror, mod_method +# endif +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv/put counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! +# if defined(MODCM_DP_TRANSPOSE) +! This branch uses mod_comm. Admissable values of phys_alltoall are +! 11,12 and 13. Each value corresponds to a different option +! within mod_comm of implementing the communication. That option is expressed +! internally to mod_comm using the variable mod_method defined below; +! mod_method will have values 0,1 or 2 and is defined as +! phys_alltoall - modmin_alltoall, where modmin_alltoall equals 11. +! Also, sendbl and recvbl must have exactly npes elements, to match +! this size of the communicator, or the transpose will fail. +! + if (phys_alltoall .ge. modmin_alltoall) then + mod_method = phys_alltoall - modmin_alltoall + ione = 1 + allocate( sendbl(0:npes-1) ) + allocate( recvbl(0:npes-1) ) + + do p = 0,npes-1 + + sendbl(p)%method = mod_method + recvbl(p)%method = mod_method + + allocate( sendbl(p)%blocksizes(1) ) + allocate( sendbl(p)%displacements(1) ) + allocate( recvbl(p)%blocksizes(1) ) + allocate( recvbl(p)%displacements(1) ) + + enddo + + endif +# endif + + first = .false. + endif +! + if (record_size .ne. prev_record_size) then +! +! Compute send/recv/put counts and displacements + sdispls(0) = 0 + sndcnts(0) = record_size*btofc_blk_num(0) + do p=1,npes-1 + sdispls(p) = sdispls(p-1) + sndcnts(p-1) + sndcnts(p) = record_size*btofc_blk_num(p) + enddo +! + rdispls(0) = 0 + rcvcnts(0) = record_size*btofc_chk_num(0) + do p=1,npes-1 + rdispls(p) = rdispls(p-1) + rcvcnts(p-1) + rcvcnts(p) = record_size*btofc_chk_num(p) + enddo +! + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! +# if defined(MODCM_DP_TRANSPOSE) + if (phys_alltoall .ge. modmin_alltoall) then + do p = 0,npes-1 + + sendbl(p)%type = MPI_DATATYPE_NULL + if ( sndcnts(p) .ne. 0 ) then + + if (phys_alltoall .gt. modmin_alltoall) then + call MPI_TYPE_INDEXED(ione, sndcnts(p), & + sdispls(p), mpir8, & + sendbl(p)%type, ierror) + call MPI_TYPE_COMMIT(sendbl(p)%type, ierror) + endif + + sendbl(p)%blocksizes(1) = sndcnts(p) + sendbl(p)%displacements(1) = sdispls(p) + sendbl(p)%partneroffset = 0 + + else + + sendbl(p)%blocksizes(1) = 0 + sendbl(p)%displacements(1) = 0 + sendbl(p)%partneroffset = 0 + + endif + sendbl(p)%nparcels = size(sendbl(p)%displacements) + sendbl(p)%tot_size = sum(sendbl(p)%blocksizes) + max_nparcels = max(max_nparcels, sendbl(p)%nparcels) + + recvbl(p)%type = MPI_DATATYPE_NULL + if ( rcvcnts(p) .ne. 0) then + + if (phys_alltoall .gt. modmin_alltoall) then + call MPI_TYPE_INDEXED(ione, rcvcnts(p), & + rdispls(p), mpir8, & + recvbl(p)%type, ierror) + call MPI_TYPE_COMMIT(recvbl(p)%type, ierror) + endif + + recvbl(p)%blocksizes(1) = rcvcnts(p) + recvbl(p)%displacements(1) = rdispls(p) + recvbl(p)%partneroffset = 0 ! not properly initialized - do not use Mpi2 + else + + recvbl(p)%blocksizes(1) = 0 + recvbl(p)%displacements(1) = 0 + recvbl(p)%partneroffset = 0 + + endif + recvbl(p)%nparcels = size(recvbl(p)%displacements) + recvbl(p)%tot_size = sum(recvbl(p)%blocksizes) + max_nparcels = max(max_nparcels, recvbl(p)%nparcels) + + enddo + + call get_partneroffset(mpicom, sendbl, recvbl) + + endif +# endif +! + prev_record_size = record_size + endif +! + call t_barrierf('sync_tran_btoc', mpicom) + if (phys_alltoall < 0) then + if ((max_nproc_smpx > npes/2) .and. (nproc_busy_d > npes/2)) then + lopt = 0 + else + lopt = 1 + endif + else + lopt = phys_alltoall + if ((lopt .eq. 2) .and. ( .not. present(window) )) lopt = 1 + endif + if (lopt < 4) then +! + bbuf_siz = record_size*block_buf_nrecs + cbuf_siz = record_size*chunk_buf_nrecs + if ( present(window) ) then + call altalltoallv(lopt, iam, npes, & + dp_coup_steps, dp_coup_proc, & + block_buffer, bbuf_siz, sndcnts, sdispls, mpir8, & + chunk_buffer, cbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, window, mpicom) + else + call altalltoallv(lopt, iam, npes, & + dp_coup_steps, dp_coup_proc, & + block_buffer, bbuf_siz, sndcnts, sdispls, mpir8, & + chunk_buffer, cbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, lwindow, mpicom) + endif +! + else +! +# if defined(MODCM_DP_TRANSPOSE) + call mp_sendirr(mpicom, sendbl, recvbl, block_buffer, chunk_buffer) + call mp_recvirr(mpicom, sendbl, recvbl, block_buffer, chunk_buffer) +# else + call mpialltoallv(block_buffer, sndcnts, sdispls, mpir8, & + chunk_buffer, rcvcnts, rdispls, mpir8, & + mpicom) +# endif +! + endif +! +#endif + return + end subroutine transpose_block_to_chunk +! +!======================================================================== + + subroutine block_to_chunk_send_pters(blockid, fdim, ldim, & + record_size, pter) +!----------------------------------------------------------------------- +! +! Purpose: Return pointers into send buffer where column from decomposed +! fields should be copied to +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! block index + integer, intent(in) :: fdim ! first dimension of pter array + integer, intent(in) :: ldim ! last dimension of pter array + integer, intent(in) :: record_size ! per coordinate amount of data + + integer, intent(out) :: pter(fdim,ldim) ! buffer offsets +!---------------------------Local workspace----------------------------- + integer :: i, k ! loop indices +!----------------------------------------------------------------------- + if ((btofc_blk_offset(blockid)%ncols > fdim) .or. & + (btofc_blk_offset(blockid)%nlvls > ldim)) then + write(iulog,*) "BLOCK_TO_CHUNK_SEND_PTERS: pter array dimensions ", & + "not large enough: (",fdim,",",ldim,") not >= (", & + btofc_blk_offset(blockid)%ncols,",", & + btofc_blk_offset(blockid)%nlvls,")" + call endrun() + endif +! + do k=1,btofc_blk_offset(blockid)%nlvls + do i=1,btofc_blk_offset(blockid)%ncols + pter(i,k) = 1 + record_size* & + (btofc_blk_offset(blockid)%pter(i,k)) + enddo + do i=btofc_blk_offset(blockid)%ncols+1,fdim + pter(i,k) = -1 + enddo + enddo +! + do k=btofc_blk_offset(blockid)%nlvls+1,ldim + do i=1,fdim + pter(i,k) = -1 + enddo + enddo +! + return + end subroutine block_to_chunk_send_pters +! +!======================================================================== + + subroutine block_to_chunk_recv_pters(lcid, fdim, ldim, & + record_size, pter) +!----------------------------------------------------------------------- +! +! Purpose: Return pointers into receive buffer where data for +! decomposed chunk data structures should be copied from +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: fdim ! first dimension of pter array + integer, intent(in) :: ldim ! last dimension of pter array + integer, intent(in) :: record_size ! per coordinate amount of data + + integer, intent(out) :: pter(fdim,ldim) ! buffer offset +!---------------------------Local workspace----------------------------- + integer :: i, k ! loop indices +!----------------------------------------------------------------------- + if ((btofc_chk_offset(lcid)%ncols > fdim) .or. & + (btofc_chk_offset(lcid)%nlvls > ldim)) then + write(iulog,*) "BLOCK_TO_CHUNK_RECV_PTERS: pter array dimensions ", & + "not large enough: (",fdim,",",ldim,") not >= (", & + btofc_chk_offset(lcid)%ncols,",", & + btofc_chk_offset(lcid)%nlvls,")" + call endrun() + endif +! + do k=1,btofc_chk_offset(lcid)%nlvls + do i=1,btofc_chk_offset(lcid)%ncols + pter(i,k) = 1 + record_size* & + (btofc_chk_offset(lcid)%pter(i,k)) + enddo + do i=btofc_chk_offset(lcid)%ncols+1,fdim + pter(i,k) = -1 + enddo + enddo +! + do k=btofc_chk_offset(lcid)%nlvls+1,ldim + do i=1,fdim + pter(i,k) = -1 + enddo + enddo +! + return + end subroutine block_to_chunk_recv_pters +! +!======================================================================== + + subroutine transpose_chunk_to_block(record_size, chunk_buffer, & + block_buffer, window) +!----------------------------------------------------------------------- +! +! Purpose: Transpose buffer containing decomposed +! chunk data structures to buffer +! containing decomposed fields +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +#if ( defined SPMD ) +# if defined(MODCM_DP_TRANSPOSE) + use mod_comm, only: blockdescriptor, mp_sendirr, mp_recvirr, & + get_partneroffset, max_nparcels + use mpishorthand, only : mpicom +# endif + use spmd_utils, only: altalltoallv +#endif +!------------------------------Parameters------------------------------- +! + integer, parameter :: msgtag = 7000 +!------------------------------Arguments-------------------------------- + integer, intent(in) :: record_size ! per column amount of data + real(r8), intent(in):: chunk_buffer(record_size*chunk_buf_nrecs) + ! buffer of chunk data to be + ! transposed + real(r8), intent(out) :: block_buffer(record_size*block_buf_nrecs) + ! buffer of block data to + ! transpose into + integer, intent(in), optional :: window + ! MPI-2 window id for + ! chunk_buffer + +!---------------------------Local workspace----------------------------- +#if ( defined SPMD ) + integer :: p ! loop indices + integer :: bbuf_siz ! size of block_buffer + integer :: cbuf_siz ! size of chunk_buffer + integer :: lwindow ! placeholder for missing window + integer :: lopt ! local copy of phys_alltoall +! + logical, save :: first = .true. + integer, allocatable, save :: sndcnts(:), sdispls(:) + integer, allocatable, save :: rcvcnts(:), rdispls(:) + integer, allocatable, save :: pdispls(:) + integer, save :: prev_record_size = 0 +# if defined(MODCM_DP_TRANSPOSE) + type (blockdescriptor), allocatable, save :: sendbl(:), recvbl(:) + integer ione, ierror, mod_method +# endif +!----------------------------------------------------------------------- + if (first) then +! Compute send/recv/put counts and displacements + allocate(sndcnts(0:npes-1)) + allocate(sdispls(0:npes-1)) + allocate(rcvcnts(0:npes-1)) + allocate(rdispls(0:npes-1)) + allocate(pdispls(0:npes-1)) +! +# if defined(MODCM_DP_TRANSPOSE) +! This branch uses mod_comm. Admissable values of phys_alltoall are +! 11,12 and 13. Each value corresponds to a differerent option +! within mod_comm of implementing the communication. That option is expressed +! internally to mod_comm using the variable mod_method defined below; +! mod_method will have values 0,1 or 2 and is defined as +! phys_alltoall - modmin_alltoall, where modmin_alltoall equals 11. +! Also, sendbl and recvbl must have exactly npes elements, to match +! this size of the communicator, or the transpose will fail. +! + if (phys_alltoall .ge. modmin_alltoall) then + mod_method = phys_alltoall - modmin_alltoall + ione = 1 + allocate( sendbl(0:npes-1) ) + allocate( recvbl(0:npes-1) ) + + do p = 0,npes-1 + + sendbl(p)%method = mod_method + recvbl(p)%method = mod_method + + allocate( sendbl(p)%blocksizes(1) ) + allocate( sendbl(p)%displacements(1) ) + allocate( recvbl(p)%blocksizes(1) ) + allocate( recvbl(p)%displacements(1) ) + + enddo + + endif +# endif +! + first = .false. + endif +! + if (record_size .ne. prev_record_size) then +! +! Compute send/recv/put counts and displacements + sdispls(0) = 0 + sndcnts(0) = record_size*btofc_chk_num(0) + do p=1,npes-1 + sdispls(p) = sdispls(p-1) + sndcnts(p-1) + sndcnts(p) = record_size*btofc_chk_num(p) + enddo +! + rdispls(0) = 0 + rcvcnts(0) = record_size*btofc_blk_num(0) + do p=1,npes-1 + rdispls(p) = rdispls(p-1) + rcvcnts(p-1) + rcvcnts(p) = record_size*btofc_blk_num(p) + enddo +! + call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) +! +# if defined(MODCM_DP_TRANSPOSE) + if (phys_alltoall .ge. modmin_alltoall) then + do p = 0,npes-1 + + sendbl(p)%type = MPI_DATATYPE_NULL + if ( sndcnts(p) .ne. 0 ) then + + if (phys_alltoall .gt. modmin_alltoall) then + call MPI_TYPE_INDEXED(ione, sndcnts(p), & + sdispls(p), mpir8, & + sendbl(p)%type, ierror) + call MPI_TYPE_COMMIT(sendbl(p)%type, ierror) + endif + + sendbl(p)%blocksizes(1) = sndcnts(p) + sendbl(p)%displacements(1) = sdispls(p) + sendbl(p)%partneroffset = 0 + + else + + sendbl(p)%blocksizes(1) = 0 + sendbl(p)%displacements(1) = 0 + sendbl(p)%partneroffset = 0 + + endif + sendbl(p)%nparcels = size(sendbl(p)%displacements) + sendbl(p)%tot_size = sum(sendbl(p)%blocksizes) + max_nparcels = max(max_nparcels, sendbl(p)%nparcels) + + recvbl(p)%type = MPI_DATATYPE_NULL + if ( rcvcnts(p) .ne. 0) then + + if (phys_alltoall .gt. modmin_alltoall) then + call MPI_TYPE_INDEXED(ione, rcvcnts(p), & + rdispls(p), mpir8, & + recvbl(p)%type, ierror) + call MPI_TYPE_COMMIT(recvbl(p)%type, ierror) + endif + + recvbl(p)%blocksizes(1) = rcvcnts(p) + recvbl(p)%displacements(1) = rdispls(p) + recvbl(p)%partneroffset = 0 ! not properly initialized - do not use Mpi2 + else + + recvbl(p)%blocksizes(1) = 0 + recvbl(p)%displacements(1) = 0 + recvbl(p)%partneroffset = 0 + + endif + recvbl(p)%nparcels = size(recvbl(p)%displacements) + recvbl(p)%tot_size = sum(recvbl(p)%blocksizes) + max_nparcels = max(max_nparcels, recvbl(p)%nparcels) + + enddo + + call get_partneroffset(mpicom, sendbl, recvbl) + + endif +# endif +! + prev_record_size = record_size + endif +! + call t_barrierf('sync_tran_ctob', mpicom) + if (phys_alltoall < 0) then + if ((max_nproc_smpx > npes/2) .and. (nproc_busy_d > npes/2)) then + lopt = 0 + else + lopt = 1 + endif + else + lopt = phys_alltoall + if ((lopt .eq. 2) .and. ( .not. present(window) )) lopt = 1 + endif + if (lopt < 4) then +! + bbuf_siz = record_size*block_buf_nrecs + cbuf_siz = record_size*chunk_buf_nrecs + if ( present(window) ) then + call altalltoallv(lopt, iam, npes, & + dp_coup_steps, dp_coup_proc, & + chunk_buffer, cbuf_siz, sndcnts, sdispls, mpir8, & + block_buffer, bbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, window, mpicom) + else + call altalltoallv(lopt, iam, npes, & + dp_coup_steps, dp_coup_proc, & + chunk_buffer, cbuf_siz, sndcnts, sdispls, mpir8, & + block_buffer, bbuf_siz, rcvcnts, rdispls, mpir8, & + msgtag, pdispls, mpir8, lwindow, mpicom) + endif +! + else +# if defined(MODCM_DP_TRANSPOSE) + call mp_sendirr(mpicom, sendbl, recvbl, block_buffer, chunk_buffer) + call mp_recvirr(mpicom, sendbl, recvbl, block_buffer, chunk_buffer) +# else + call mpialltoallv(chunk_buffer, sndcnts, sdispls, mpir8, & + block_buffer, rcvcnts, rdispls, mpir8, & + mpicom) +# endif +! + endif +! +#endif + + return + end subroutine transpose_chunk_to_block +! +!======================================================================== + + subroutine chunk_to_block_send_pters(lcid, fdim, ldim, & + record_size, pter) +!----------------------------------------------------------------------- +! +! Purpose: Return pointers into send buffer where data for +! decomposed chunk data structures should be copied to +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: fdim ! first dimension of pter array + integer, intent(in) :: ldim ! last dimension of pter array + integer, intent(in) :: record_size ! per coordinate amount of data + + integer, intent(out) :: pter(fdim,ldim) ! buffer offset +!---------------------------Local workspace----------------------------- + integer :: i, k ! loop indices +!----------------------------------------------------------------------- + if ((btofc_chk_offset(lcid)%ncols > fdim) .or. & + (btofc_chk_offset(lcid)%nlvls > ldim)) then + write(iulog,*) "CHUNK_TO_BLOCK_SEND_PTERS: pter array dimensions ", & + "not large enough: (",fdim,",",ldim,") not >= (", & + btofc_chk_offset(lcid)%ncols,",", & + btofc_chk_offset(lcid)%nlvls,")" + call endrun() + endif +! + do k=1,btofc_chk_offset(lcid)%nlvls + do i=1,btofc_chk_offset(lcid)%ncols + pter(i,k) = 1 + record_size* & + (btofc_chk_offset(lcid)%pter(i,k)) + enddo + do i=btofc_chk_offset(lcid)%ncols+1,fdim + pter(i,k) = -1 + enddo + enddo +! + do k=btofc_chk_offset(lcid)%nlvls+1,ldim + do i=1,fdim + pter(i,k) = -1 + enddo + enddo +! + return + end subroutine chunk_to_block_send_pters +! +!======================================================================== + + subroutine chunk_to_block_recv_pters(blockid, fdim, ldim, & + record_size, pter) +!----------------------------------------------------------------------- +! +! Purpose: Return pointers into receive buffer where column from decomposed +! fields should be copied from +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + integer, intent(in) :: blockid ! block index + integer, intent(in) :: fdim ! first dimension of pter array + integer, intent(in) :: ldim ! last dimension of pter array + integer, intent(in) :: record_size ! per coordinate amount of data + + integer, intent(out) :: pter(fdim,ldim) ! buffer offsets +!---------------------------Local workspace----------------------------- + integer :: i, k ! loop indices +!----------------------------------------------------------------------- + if ((btofc_blk_offset(blockid)%ncols > fdim) .or. & + (btofc_blk_offset(blockid)%nlvls > ldim)) then + write(iulog,*) "CHUNK_TO_BLOCK_RECV_PTERS: pter array dimensions ", & + "not large enough: (",fdim,",",ldim,") not >= (", & + btofc_blk_offset(blockid)%ncols,",", & + btofc_blk_offset(blockid)%nlvls,")" + call endrun() + endif +! + do k=1,btofc_blk_offset(blockid)%nlvls + do i=1,btofc_blk_offset(blockid)%ncols + pter(i,k) = 1 + record_size* & + (btofc_blk_offset(blockid)%pter(i,k)) + enddo + do i=btofc_blk_offset(blockid)%ncols+1,fdim + pter(i,k) = -1 + enddo + enddo +! + do k=btofc_blk_offset(blockid)%nlvls+1,ldim + do i=1,fdim + pter(i,k) = -1 + enddo + enddo +! + return + end subroutine chunk_to_block_recv_pters +! +!======================================================================== + + subroutine create_chunks(opt, chunks_per_thread) +!----------------------------------------------------------------------- +! +! Purpose: Decompose physics computational grid into chunks, for +! improved serial efficiency and parallel load balance. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plev + use dyn_grid, only: get_block_bounds_d, get_block_gcol_cnt_d, & + get_gcol_block_cnt_d, get_gcol_block_d, & + get_block_owner_d, get_block_gcol_d +!------------------------------Arguments-------------------------------- + integer, intent(in) :: opt ! chunking option + ! 0: chunks may cross block boundaries, but retain same + ! process mapping as blocks. If possible, columns assigned + ! as day/night pairs. Columns (or pairs) are wrap-mapped. + ! May not work with vertically decomposed blocks. (default) + ! 1: chunks may cross block boundaries, but retain same + ! SMP-node mapping as blocks. If possible, columns assigned + ! as day/night pairs. Columns (or pairs) are wrap-mapped. + ! May not work with vertically decomposed blocks. + ! 2: 2-column day/night and season column pairs wrap-mapped + ! to chunks to also balance assignment of polar, mid-latitude, + ! and equatorial columns across chunks. + ! 3: same as 1 except that SMP defined to be pairs of consecutive + ! processes + ! 4: chunks may cross block boundaries, but retain same + ! process mapping as blocks. Columns assigned to chunks + ! in block ordering. + ! May not work with vertically decomposed blocks. + ! 5: Chunks do not cross latitude boundaries, and are block-mapped. + integer, intent(in) :: chunks_per_thread + ! target number of chunks per + ! thread +!---------------------------Local workspace----------------------------- + integer :: i, j, p ! loop indices + integer :: nlthreads ! number of local OpenMP threads + integer :: npthreads(0:npes-1) ! number of OpenMP threads per process + integer :: proc_smp_mapx(0:npes-1) ! process/virtual SMP node map + integer :: firstblock, lastblock ! global block index bounds + integer :: maxblksiz ! maximum number of columns in a dynamics block + integer :: block_cnt ! number of blocks containing data + ! for a given vertical column + integer :: blockids(plev+1) ! block indices + integer :: bcids(plev+1) ! block column indices + integer :: nsmpx, nsmpy ! virtual SMP node counts and indices + integer :: curgcol, twingcol ! global physics and dynamics column indices + integer :: smp ! SMP node index + integer :: cid ! chunk id + integer :: jb, ib ! global block and columns indices + integer :: blksiz ! current block size + integer :: ntmp1, ntmp2, nlchunks ! work variables + integer :: max_ncols ! upper bound on number of columns in a block + integer :: ncols ! number of columns in current chunk + logical :: error ! error flag + + ! indices for dynamics columns in given block + integer, dimension(:), allocatable :: cols + + ! number of MPI processes per virtual SMP node (0:nsmpx-1) + integer, dimension(:), allocatable :: nsmpprocs + + ! flag indicating whether a process is busy or idle during the dynamics (0:npes-1) + logical, dimension(:), allocatable :: proc_busy_d + + ! flag indicating whether any of the processes assigned to an SMP node are busy + ! during the dynamics, or whether all of them are idle (0:nsmps-1) + logical, dimension(:), allocatable :: smp_busy_d + + ! actual SMP node/virtual SMP node map (0:nsmps-1) + integer, dimension(:), allocatable :: smp_smp_mapx + + ! column/virtual SMP node map (ngcols) + integer, dimension(:), allocatable :: col_smp_mapx + + ! number of columns assigned to a given virtual SMP node (0:nsmpx-1) + integer, dimension(:), allocatable :: nsmpcolumns + + ! number of OpenMP threads per virtual SMP node (0:nsmpx-1) + integer, dimension(:), allocatable :: nsmpthreads + + ! number of chunks assigned to a given virtual SMP node (0:nsmpx-1) + integer, dimension(:), allocatable :: nsmpchunks + + ! maximum number of columns assigned to a chunk in a given virtual SMP node (0:nsmpx-1) + integer, dimension(:), allocatable :: maxcol_chk + + ! number of chunks in given virtual SMP node receiving maximum number of columns + ! (0:nsmpx-1) + integer, dimension(:), allocatable :: maxcol_chks + + ! chunk id virtual offset (0:nsmpx-1) + integer, dimension(:), allocatable :: cid_offset + + ! process-local chunk id (0:nsmpx-1) + integer, dimension(:), allocatable :: local_cid + +#if ( defined _OPENMP ) + integer omp_get_max_threads + external omp_get_max_threads +#endif + +!----------------------------------------------------------------------- +! +! Determine number of threads per process +! + nlthreads = 1 +#if ( defined _OPENMP ) + nlthreads = OMP_GET_MAX_THREADS() +#endif +! +#if ( defined SPMD ) + call mpiallgatherint(nlthreads, 1, npthreads, 1, mpicom) +#else + npthreads(0) = nlthreads + proc_smp_map(0) = 0 +#endif + +! +! Determine index range for dynamics blocks +! + call get_block_bounds_d(firstblock,lastblock) + +! +! Determine maximum number of columns in a block +! + maxblksiz = 0 + do jb=firstblock,lastblock + maxblksiz = max(maxblksiz,get_block_gcol_cnt_d(jb)) + enddo + +! +! determine which (and how many) processes are assigned +! dynamics blocks +! + allocate( proc_busy_d(0:npes-1) ) + proc_busy_d = .false. + nproc_busy_d = 0 + do jb=firstblock,lastblock + p = get_block_owner_d(jb) + if (.not. proc_busy_d(p) ) then + proc_busy_d(p) = .true. + nproc_busy_d = nproc_busy_d + 1 + endif + enddo + +! +! Determine virtual SMP count and processes/virtual SMP map. +! If option 0 or >3, pretend that each SMP has only one process. +! If option 1, use SMP information. +! If option 2, pretend that all processes are in one SMP node. +! If option 3, pretend that each SMP node is made up of two +! processes, chosen to maximize load-balancing opportunities. +! +! For all options < 5, if there are "idle" dynamics processes, +! assign them to the virtual SMP nodes in wrap fashion. +! Communication between the active and idle dynamics +! processes is scatter/gather (no communications between +! idle dynamics processes) so there is no advantage to +! blocking the idle processes in these assignments. +! + if ((opt <= 0) .or. (opt == 4)) then + +! assign active dynamics processes to virtual SMP nodes + nsmpx = 0 + do p=0,npes-1 + if (proc_busy_d(p)) then + proc_smp_mapx(p) = nsmpx + nsmpx = nsmpx + 1 + endif + enddo +! +! assign idle dynamics processes to virtual SMP nodes (wrap map) + nsmpy = 0 + do p=0,npes-1 + if (.not. proc_busy_d(p)) then + proc_smp_mapx(p) = nsmpy + nsmpy = mod(nsmpy+1,nsmpx) + endif + enddo + + elseif (opt == 1) then + + allocate( smp_busy_d(0:nsmps-1) ) + allocate( smp_smp_mapx(0:nsmps-1) ) + +! +! determine SMP nodes assigned dynamics blocks + smp_busy_d = .false. + do p=0,npes-1 + if ( proc_busy_d(p) ) then + smp = proc_smp_map(p) + smp_busy_d(smp) = .true. + endif + enddo + +! +! determine number of SMP nodes assigned dynamics blocks + nsmpx = 0 + do smp=0,nsmps-1 + if (smp_busy_d(smp)) then + smp_smp_mapx(smp) = nsmpx + nsmpx = nsmpx + 1 + endif + enddo +! +! assign processes in active dynamics SMP nodes to virtual SMP nodes + do p=0,npes-1 + smp = proc_smp_map(p) + if (smp_busy_d(smp)) then + proc_smp_mapx(p) = smp_smp_mapx(smp) + endif + enddo +! +! assign processes in idle dynamics SMP nodes to virtual SMP nodes (wrap map) + nsmpy = 0 + do p=0,npes-1 + smp = proc_smp_map(p) + if (.not. smp_busy_d(smp)) then + proc_smp_mapx(p) = nsmpy + nsmpy = mod(nsmpy+1,nsmpx) + endif + enddo +! + deallocate( smp_busy_d ) + deallocate( smp_smp_mapx ) + + elseif (opt == 2) then + + nsmpx = 1 + do p=0,npes-1 + proc_smp_mapx(p) = 0 + enddo + + elseif (opt == 3) then + +! find active process partners + proc_smp_mapx = -1 + call find_partners(opt,proc_busy_d,nsmpx,proc_smp_mapx) +! +! assign unassigned (idle dynamics) processes to virtual SMP nodes +! (wrap map) + nsmpy = 0 + do p=0,npes-1 + if (proc_smp_mapx(p) .eq. -1) then + proc_smp_mapx(p) = nsmpy + nsmpy = mod(nsmpy+1,nsmpx) + endif + enddo + + else + + nsmpx = npes + do p=0,npes-1 + proc_smp_mapx(p) = p + enddo + + endif +! + deallocate( proc_busy_d ) + +! +! Determine maximum number of processes assigned to a single +! virtual SMP node +! + allocate( nsmpprocs(0:nsmpx-1) ) +! + nsmpprocs(:) = 0 + do p=0,npes-1 + smp = proc_smp_mapx(p) + nsmpprocs(smp) = nsmpprocs(smp) + 1 + enddo + max_nproc_smpx = maxval(nsmpprocs) +! + deallocate( nsmpprocs ) + +! +! Determine number of columns assigned to each +! virtual SMP in block decomposition + + allocate( col_smp_mapx(ngcols) ) +! + col_smp_mapx(:) = -1 + error = .false. + do i=1,ngcols_p + curgcol = latlon_to_dyn_gcol_map(i) + block_cnt = get_gcol_block_cnt_d(curgcol) + call get_gcol_block_d(curgcol,block_cnt,blockids,bcids) + do jb=1,block_cnt + p = get_block_owner_d(blockids(jb)) + if (col_smp_mapx(i) .eq. -1) then + col_smp_mapx(i) = proc_smp_mapx(p) + elseif (col_smp_mapx(i) .ne. proc_smp_mapx(p)) then + error = .true. + endif + enddo + end do + if (error) then + write(iulog,*) "PHYS_GRID_INIT error: opt", opt, "specified, ", & + "but vertical decomposition not limited to virtual SMP" + call endrun() + endif +! + allocate( nsmpcolumns(0:nsmpx-1) ) + nsmpcolumns(:) = 0 + do i=1,ngcols_p + curgcol = latlon_to_dyn_gcol_map(i) + smp = col_smp_mapx(curgcol) + nsmpcolumns(smp) = nsmpcolumns(smp) + 1 + end do +! + deallocate( col_smp_mapx ) + +! +! Allocate other work space +! + allocate( nsmpthreads(0:nsmpx-1) ) + allocate( nsmpchunks (0:nsmpx-1) ) + allocate( maxcol_chk (0:nsmpx-1) ) + allocate( maxcol_chks(0:nsmpx-1) ) + allocate( cid_offset (0:nsmpx-1) ) + allocate( local_cid (0:nsmpx-1) ) + allocate( cols(1:maxblksiz) ) +! +! Options 0-3: split local dynamics blocks into chunks, +! using wrap-map assignment of columns and +! day/night and north/south column pairs +! to chunks to improve load balance +! Option 0: local is per process +! Option 1: local is subset of`processes assigned to same SMP node +! Option 2: local is global +! Option 3: local is pair of processes chosen to maximize load-balance +! wrt restriction that only communicate with one other +! process. +! Option 4: split local dynamics blocks into chunks, +! using block-map assignment of columns +! + if ((opt >= 0) .and. (opt <= 4)) then +! +! Calculate number of threads available in each SMP node. +! + nsmpthreads(:) = 0 + do p=0,npes-1 + smp = proc_smp_mapx(p) + nsmpthreads(smp) = nsmpthreads(smp) + npthreads(p) + enddo +! +! Determine number of chunks to keep all threads busy +! + nchunks = 0 + do smp=0,nsmpx-1 + nsmpchunks(smp) = nsmpcolumns(smp)/pcols + if (mod(nsmpcolumns(smp), pcols) .ne. 0) then + nsmpchunks(smp) = nsmpchunks(smp) + 1 + endif + if (nsmpchunks(smp) < chunks_per_thread*nsmpthreads(smp)) then + nsmpchunks(smp) = chunks_per_thread*nsmpthreads(smp) + endif + do while (mod(nsmpchunks(smp), nsmpthreads(smp)) .ne. 0) + nsmpchunks(smp) = nsmpchunks(smp) + 1 + enddo + if (nsmpchunks(smp) > nsmpcolumns(smp)) then + nsmpchunks(smp) = nsmpcolumns(smp) + endif + nchunks = nchunks + nsmpchunks(smp) + enddo +! +! Determine maximum number of columns to assign to chunks +! in a given SMP +! + do smp=0,nsmpx-1 + if (nsmpchunks(smp) /= 0) then + ntmp1 = nsmpcolumns(smp)/nsmpchunks(smp) + ntmp2 = mod(nsmpcolumns(smp),nsmpchunks(smp)) + if (ntmp2 > 0) then + maxcol_chk(smp) = ntmp1 + 1 + maxcol_chks(smp) = ntmp2 + else + maxcol_chk(smp) = ntmp1 + maxcol_chks(smp) = nsmpchunks(smp) + endif + else + maxcol_chk(smp) = 0 + maxcol_chks(smp) = 0 + endif + enddo +! +! Allocate chunks and knuhcs data structures +! + allocate( chunks(1:nchunks) ) + allocate( knuhcs(1:ngcols) ) +! +! Initialize chunks and knuhcs data structures +! + chunks(:)%ncols = 0 + knuhcs(:)%chunkid = -1 + knuhcs(:)%col = -1 +! +! Determine chunk id ranges for each SMP +! + cid_offset(0) = 1 + local_cid(0) = 0 + do smp=1,nsmpx-1 + cid_offset(smp) = cid_offset(smp-1) + nsmpchunks(smp-1) + local_cid(smp) = 0 + enddo +! +! Assign columns to chunks +! + do jb=firstblock,lastblock + p = get_block_owner_d(jb) + smp = proc_smp_mapx(p) + blksiz = get_block_gcol_cnt_d(jb) + call get_block_gcol_d(jb,blksiz,cols) + do ib = 1,blksiz +! +! Assign column to a chunk if not already assigned + curgcol = cols(ib) + if ((dyn_to_latlon_gcol_map(curgcol) .ne. -1) .and. & + (knuhcs(curgcol)%chunkid == -1)) then +! +! Find next chunk with space +! (maxcol_chks > 0 test necessary for opt=4 block map) + cid = cid_offset(smp) + local_cid(smp) + if (maxcol_chks(smp) > 0) then + do while (chunks(cid)%ncols >= maxcol_chk(smp)) + local_cid(smp) = mod(local_cid(smp)+1,nsmpchunks(smp)) + cid = cid_offset(smp) + local_cid(smp) + enddo + else + do while (chunks(cid)%ncols >= maxcol_chk(smp)-1) + local_cid(smp) = mod(local_cid(smp)+1,nsmpchunks(smp)) + cid = cid_offset(smp) + local_cid(smp) + enddo + endif + chunks(cid)%ncols = chunks(cid)%ncols + 1 + if (chunks(cid)%ncols .eq. maxcol_chk(smp)) & + maxcol_chks(smp) = maxcol_chks(smp) - 1 +! + i = chunks(cid)%ncols + chunks(cid)%gcol(i) = curgcol + chunks(cid)%lon(i) = lon_p(curgcol) + chunks(cid)%lat(i) = lat_p(curgcol) + knuhcs(curgcol)%chunkid = cid + knuhcs(curgcol)%col = i +! + if (opt < 4) then +! +! If space available, look to assign a load-balancing "twin" to same chunk + if ( (chunks(cid)%ncols < maxcol_chk(smp)) .and. & + (maxcol_chks(smp) > 0) .and. (twin_alg > 0)) then + + call find_twin(curgcol, smp, & + proc_smp_mapx, twingcol) + + if (twingcol > 0) then + chunks(cid)%ncols = chunks(cid)%ncols + 1 + if (chunks(cid)%ncols .eq. maxcol_chk(smp)) & + maxcol_chks(smp) = maxcol_chks(smp) - 1 +! + i = chunks(cid)%ncols + chunks(cid)%gcol(i) = twingcol + chunks(cid)%lon(i) = lon_p(twingcol) + chunks(cid)%lat(i) = lat_p(twingcol) + knuhcs(twingcol)%chunkid = cid + knuhcs(twingcol)%col = i + endif +! + endif +! +! Move on to next chunk (wrap map) + local_cid(smp) = mod(local_cid(smp)+1,nsmpchunks(smp)) +! + endif +! + endif + enddo + enddo +! + else +! +! Option 5: split individual dynamics blocks into chunks, +! assigning consecutive columns to the same chunk +! +! Determine total number of chunks and +! number of chunks in each "SMP node" +! (assuming no vertical decomposition) + nchunks = 0 + nsmpchunks(:) = 0 + do j=firstblock,lastblock + blksiz = get_block_gcol_cnt_d(j) + nlchunks = blksiz/pcols + if (pcols*(blksiz/pcols) /= blksiz) then + nlchunks = nlchunks + 1 + endif + nchunks = nchunks + nlchunks + p = get_block_owner_d(j) + nsmpchunks(p) = nsmpchunks(p) + nlchunks + enddo +! +! Determine chunk id ranges for each SMP +! + cid_offset(0) = 1 + local_cid(0) = 0 + do smp=1,nsmpx-1 + cid_offset(smp) = cid_offset(smp-1) + nsmpchunks(smp-1) + local_cid(smp) = 0 + enddo +! +! Allocate chunks and knuhcs data structures +! + allocate( chunks(1:nchunks) ) + allocate( knuhcs(1:ngcols) ) +! +! Initialize chunks and knuhcs data structures +! + knuhcs(:)%chunkid = -1 + knuhcs(:)%col = -1 + cid = 0 + do jb=firstblock,lastblock + p = get_block_owner_d(jb) + smp = proc_smp_mapx(p) + blksiz = get_block_gcol_cnt_d(jb) + call get_block_gcol_d(jb,blksiz,cols) + + ib = 0 + do while (ib < blksiz) + + cid = cid_offset(smp) + local_cid(smp) + max_ncols = min(pcols,blksiz-ib) + + ncols = 0 + do i=1,max_ncols + ib = ib + 1 + ! check whether global index is for a column that dynamics + ! intends to pass to the physics + curgcol = cols(ib) + if (dyn_to_latlon_gcol_map(curgcol) .ne. -1) then + ! yes - then save the information + ncols = ncols + 1 + chunks(cid)%gcol(ncols) = curgcol + chunks(cid)%lon(ncols) = lon_p(curgcol) + chunks(cid)%lat(ncols) = lat_p(curgcol) + knuhcs(curgcol)%chunkid = cid + knuhcs(curgcol)%col = ncols + endif + enddo + chunks(cid)%ncols = ncols + + local_cid(smp) = local_cid(smp) + 1 + enddo + enddo +! +! Set number of threads available in each "SMP node". +! + do p=0,npes-1 + nsmpthreads(p) = npthreads(p) + enddo +! + endif +! +! Assign chunks to processes. +! + call assign_chunks(npthreads, nsmpx, proc_smp_mapx, & + nsmpthreads, nsmpchunks) +! +! Clean up +! + deallocate( nsmpcolumns ) + deallocate( nsmpthreads ) + deallocate( nsmpchunks ) + deallocate( maxcol_chk ) + deallocate( maxcol_chks ) + deallocate( cid_offset ) + deallocate( local_cid ) + deallocate( cols ) + deallocate( knuhcs ) + + return + end subroutine create_chunks +! +!======================================================================== + + subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) +!----------------------------------------------------------------------- +! +! Purpose: Divide processes into pairs, attempting to maximize the +! the number of columns in one process whose twins are in the +! other process. +! +! Method: The day/night and north/south hemisphere complement is defined +! to be the column twin. +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use dyn_grid, only: get_gcol_block_cnt_d, get_gcol_block_d, & + get_block_owner_d + use pmgrid, only: plev +!------------------------------Arguments-------------------------------- + integer, intent(in) :: opt ! chunking option + logical, intent(in) :: proc_busy_d(0:npes-1) + ! active/idle dynamics process flags + integer, intent(out) :: nsmpx ! calculated number of virtual + ! SMP nodes + integer, intent(out) :: proc_smp_mapx(0:npes-1) + ! process/virtual smp map +!---------------------------Local workspace----------------------------- + integer :: gcol_latlon ! physics column index (latlon sorted) + integer :: twingcol_latlon ! physics column index (latlon sorted) + integer :: gcol, twingcol ! physics column indices + integer :: lon, lat, twinlat ! longitude and latitude indices + integer :: twinlon_off ! estimate as to offset of twinlon + ! on a latitude line + integer :: block_cnt ! number of blocks containing data + ! for a given vertical column + integer :: blockids(plev+1) ! block indices + integer :: bcids(plev+1) ! block column indices + integer :: jb ! block index + integer :: p, twp ! process indices + integer :: col_proc_mapx(ngcols) ! location of columns in + ! dynamics decomposition + integer :: twin_proc_mapx(ngcols) ! location of column twins in + ! dynamics decomposition + integer :: twin_cnt(0:npes-1) ! for each process, number of twins + ! in each of the other processes + logical :: assigned(0:npes-1) ! flag indicating whether process + ! assigned to an SMP node yet + integer :: maxpartner, maxcnt ! process with maximum number of + ! twins and this count + + logical :: error ! error flag +!----------------------------------------------------------------------- +! +! Determine process location of column and its twin in dynamics decomposition +! + col_proc_mapx(:) = -1 + twin_proc_mapx(:) = -1 + + error = .false. + do gcol_latlon=1,ngcols_p + + ! Assume latitude and longitude symmetries and that index manipulations + ! are sufficient to find partners. (Will be true for lon/lat grids.) + gcol = latlon_to_dyn_gcol_map(gcol_latlon) + lat = lat_p(gcol) + twinlat = clat_p_tot+1-lat + lon = lon_p(gcol) + twinlon_off = mod((lon-1)+(clat_p_cnt(twinlat)/2), clat_p_cnt(twinlat)) + twingcol_latlon = clat_p_idx(twinlat) + twinlon_off + twingcol = latlon_to_dyn_gcol_map(twingcol_latlon) + + block_cnt = get_gcol_block_cnt_d(gcol) + call get_gcol_block_d(gcol,block_cnt,blockids,bcids) + do jb=1,block_cnt + p = get_block_owner_d(blockids(jb)) + if (col_proc_mapx(gcol) .eq. -1) then + col_proc_mapx(gcol) = p + elseif (col_proc_mapx(gcol) .ne. p) then + error = .true. + endif + enddo + + block_cnt = get_gcol_block_cnt_d(twingcol) + call get_gcol_block_d(twingcol,block_cnt,blockids,bcids) + do jb=1,block_cnt + p = get_block_owner_d(blockids(jb)) + if (twin_proc_mapx(gcol) .eq. -1) then + twin_proc_mapx(gcol) = p + elseif (twin_proc_mapx(gcol) .ne. p) then + error = .true. + endif + enddo + + end do + + if (error) then + if (masterproc) then + write(iulog,*) "PHYS_GRID_INIT error: opt", opt, "specified, ", & + "but vertical decomposition not limited to single process" + endif + call endrun() + endif + +! +! Assign process pairs to SMPs, attempting to maximize the number of column,twin +! pairs in same SMP. +! + assigned(:) = .false. + twin_cnt(:) = 0 + nsmpx = 0 + do p=0,npes-1 + if ((.not. assigned(p)) .and. (proc_busy_d(p))) then +! +! For each process, determine number of twins in each of the other processes +! (running over all columns multiple times to minimize memory requirements). +! + do gcol_latlon=1,ngcols_p + gcol = latlon_to_dyn_gcol_map(gcol_latlon) + if (col_proc_mapx(gcol) .eq. p) then + twin_cnt(twin_proc_mapx(gcol)) = & + twin_cnt(twin_proc_mapx(gcol)) + 1 + endif + enddo +! +! Find process with maximum number of twins that has not yet been designated +! a partner. +! + maxpartner = -1 + maxcnt = 0 + do twp=0,npes-1 + if ((.not. assigned(twp)) .and. (twp .ne. p)) then + if (twin_cnt(twp) >= maxcnt) then + maxcnt = twin_cnt(twp) + maxpartner = twp + endif + endif + enddo +! +! Assign p and twp to the same SMP node +! + if (maxpartner .ne. -1) then + assigned(p) = .true. + assigned(maxpartner) = .true. + proc_smp_mapx(p) = nsmpx + proc_smp_mapx(maxpartner) = nsmpx + nsmpx = nsmpx + 1 + else + if (masterproc) then + write(iulog,*) "PHYS_GRID_INIT error: opt", opt, "specified, ", & + "but could not divide processes into pairs." + endif + call endrun() + endif +! + endif +! + enddo +! + return + end subroutine find_partners +! +!======================================================================== + + subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) +!----------------------------------------------------------------------- +! +! Purpose: Find column that when paired with gcol in a chunk +! balances the load. A column is a candidate to be paired with +! gcol if it is in the same SMP node as gcol as defined +! by proc_smp_mapx. +! +! Method: The day/night and north/south hemisphere complement is +! tried first. If it is not a candidate or if it has already been +! assigned, then the day/night complement is tried next. If that +! also is not available, then nothing is returned. +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use dyn_grid, only: get_gcol_block_d, get_block_owner_d + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: gcol ! global column index for column + ! seeking a twin for + integer, intent(in) :: smp ! index of SMP node + ! currently assigned to + integer, intent(in) :: proc_smp_mapx(0:npes-1) + ! process/virtual smp map + integer, intent(out) :: twingcol_f + ! global column index for twin +!---------------------------Local workspace----------------------------- + integer :: lon, lat ! global lon/lat indices for column + ! seeking a twin for + integer :: twinlon, twinlat ! lon/lat indices of twin candidate + integer :: twinlon_off ! estimate as to offset of twinlon + ! on a latitude line + logical :: found ! found flag + integer :: i ! loop index + integer :: upper, lower ! search temporaries + integer :: twingcol_latlon ! global physics column index (latlon sorted) + integer :: twingcol_lonlat ! global physics column index (lonlat sorted) + integer :: twingcol ! global physics column indes + integer :: diff, min_diff, min_i ! search temporaries + integer :: jbtwin(npes) ! global block indices + integer :: ibtwin(npes) ! global column indices + integer :: twinproc, twinsmp ! process and smp ids + + integer :: clon_p_idx(clon_p_tot) ! index in lonlat ordering for first + ! occurrence of longitude corresponding to + ! given latitude index + + real(r8):: twopi ! 2*pi + real(r8):: clat, twinclat ! latitude and twin + real(r8):: clon, twinclon ! longitude and twin + +!----------------------------------------------------------------------- + twingcol_f = -1 + + ! precompute clon_p_idx + clon_p_idx(1) = 1 + do i=2,clon_p_tot + clon_p_idx(i) = clon_p_idx(i-1) + clon_p_cnt(i-1) + enddo +! +! Try day/night and north/south hemisphere complement first +! + ! determine twin latitude + lat = lat_p(gcol) + clat = clat_p(lat) + twinclat = -clat + twinlat = clat_p_tot+1-lat + if (clat_p(twinlat) .eq. twinclat) then + found = .true. + else + found = .false. + upper = twinlat + lower = twinlat + if (upper < clat_p_tot) upper = twinlat + 1 + if (lower > 1) lower = twinlat - 1 + endif + do while (.not. found) + if ((abs(clat_p(upper)-twinclat) < abs(clat_p(twinlat)-twinclat)) .and. & + (upper .ne. twinlat)) then + twinlat = upper + if (upper < clat_p_tot) then + upper = twinlat + 1 + else + found = .true. + endif + else if ((abs(clat_p(lower)-twinclat) < abs(clat_p(twinlat)-twinclat)) .and. & + (lower .ne. twinlat)) then + twinlat = lower + if (lower > 1) then + lower = twinlat - 1 + else + found = .true. + endif + else + found = .true. + endif + enddo + + ! determine twin longitude + twopi = 2.0_r8*pi + lon = lon_p(gcol) + clon = clon_p(lon) + twinclon = mod(clon+pi,twopi) + twinlon = mod((lon-1)+(clon_p_tot/2), clon_p_tot) + 1 + if (clon_p(twinlon) .eq. twinclon) then + found = .true. + else + found = .false. + upper = twinlon + lower = twinlon + if (upper < clon_p_tot) upper = twinlon + 1 + if (lower > 1) lower = twinlon - 1 + endif + do while (.not. found) + if ((abs(clon_p(upper)-twinclon) < abs(clon_p(twinlon)-twinclon)) .and. & + (upper .ne. twinlon)) then + twinlon = upper + if (upper < clon_p_tot) then + upper = twinlon + 1 + else + found = .true. + endif + else if ((abs(clon_p(lower)-twinclon) < abs(clon_p(twinlon)-twinclon)) .and. & + (lower .ne. twinlon)) then + twinlon = lower + if (lower > 1) then + lower = twinlon - 1 + else + found = .true. + endif + else + found = .true. + endif + enddo + + ! first, look for an exact match (assuming latitude and longitude symmetries) + twinlon_off = mod((lon-1)+(clat_p_cnt(twinlat)/2), clat_p_cnt(twinlat)) + twingcol_latlon = clat_p_idx(twinlat) + twinlon_off + twingcol = latlon_to_dyn_gcol_map(twingcol_latlon) + + ! otherwise, look around for an approximate match using lonlat sorted indices + if ((lon_p(twingcol) .ne. twinlon) .or. (lat_p(twingcol) .ne. twinlat)) then + twingcol_lonlat = clon_p_idx(twinlon) + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + min_diff = abs(lat_p(twingcol) - twinlat) + min_i = 0 + do i = 1, clon_p_cnt(twinlon)-1 + twingcol_lonlat = clon_p_idx(twinlon)+i + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + diff = abs(lat_p(twingcol) - twinlat) + if (diff < min_diff) then + min_diff = diff + min_i = i + endif + enddo + twingcol_lonlat = clon_p_idx(twinlon) + min_i + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + endif + + ! Check whether twin and original are in same smp + found = .false. + call get_gcol_block_d(twingcol,npes,jbtwin,ibtwin) + twinproc = get_block_owner_d(jbtwin(1)) + twinsmp = proc_smp_mapx(twinproc) +! + if ((twinsmp .eq. smp) .and. & + (knuhcs(twingcol)%chunkid == -1)) then + found = .true. + twingcol_f = twingcol + endif +! +! Try day/night complement next + if (.not. found) then + + ! first, look for an exact match (assuming longitude symmetries) + twinlon_off = mod((lon-1)+(clat_p_cnt(lat)/2), clat_p_cnt(lat)) + twingcol_latlon = clat_p_idx(lat) + twinlon_off + twingcol = latlon_to_dyn_gcol_map(twingcol_latlon) + + ! otherwise, look around for an approximate match using lonlat + ! column ordering + if ((lon_p(twingcol) .ne. twinlon) .or. & + (lat_p(twingcol) .ne. lat)) then + twingcol_lonlat = clon_p_idx(twinlon) + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + min_diff = abs(lat_p(twingcol) - lat) + min_i = 0 + do i = 1, clon_p_cnt(twinlon)-1 + twingcol_lonlat = clon_p_idx(twinlon)+i + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + diff = abs(lat_p(twingcol) - lat) + if (diff < min_diff) then + min_diff = diff + min_i = i + endif + enddo + twingcol_lonlat = clon_p_idx(twinlon) + min_i + twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) + endif +! + call get_gcol_block_d(twingcol,npes,jbtwin,ibtwin) + twinproc = get_block_owner_d(jbtwin(1)) + twinsmp = proc_smp_mapx(twinproc) +! + if ((twinsmp .eq. smp) .and. & + (knuhcs(twingcol)%chunkid == -1)) then + found = .true. + twingcol_f = twingcol + endif +! + endif +! + return + end subroutine find_twin +! +!======================================================================== + + subroutine assign_chunks(npthreads, nsmpx, proc_smp_mapx, & + nsmpthreads, nsmpchunks) +!----------------------------------------------------------------------- +! +! Purpose: Assign chunks to processes, balancing the number of +! chunks per thread and minimizing the communication costs +! in dp_coupling subject to the restraint that columns +! do not migrate outside of the current SMP node. +! +! Method: +! +! Author: Patrick Worley +! +!----------------------------------------------------------------------- + use pmgrid, only: plev + use dyn_grid, only: get_gcol_block_cnt_d, get_gcol_block_d,& + get_block_owner_d +!------------------------------Arguments-------------------------------- + integer, intent(in) :: npthreads(0:npes-1) + ! number of OpenMP threads per process + integer, intent(in) :: nsmpx ! virtual smp count + integer, intent(in) :: proc_smp_mapx(0:npes-1) + ! process/virtual smp map + integer, intent(in) :: nsmpthreads(0:nsmpx-1) + ! number of OpenMP threads + ! per virtual SMP + integer, intent(in) :: nsmpchunks(0:nsmpx-1) + ! number of chunks assigned + ! to a given virtual SMP +!---------------------------Local workspace----------------------------- + integer :: i, jb, p ! loop indices + integer :: cid ! chunk id + integer :: smp ! SMP index + integer :: curgcol ! global column index + integer :: block_cnt ! number of blocks containing data + ! for a given vertical column + integer :: blockids(plev+1) ! block indices + integer :: bcids(plev+1) ! block column indices + integer :: ntsks_smpx(0:nsmpx-1) ! number of processes per virtual SMP + integer :: smp_proc_mapx(0:nsmpx-1,max_nproc_smpx) + ! virtual smp to process id map + integer :: cid_offset(0:nsmpx) ! chunk id virtual smp offset + integer :: ntmp1_smp(0:nsmpx-1) ! minimum number of chunks per thread + ! in a virtual SMP + integer :: ntmp2_smp(0:nsmpx-1) ! number of extra chunks to be assigned + ! in a virtual SMP + integer :: ntmp3_smp(0:nsmpx-1) ! number of processes in a virtual + ! SMP that get more extra chunks + ! than the others + integer :: ntmp4_smp(0:nsmpx-1) ! number of extra chunks per process + ! in a virtual SMP + integer :: ntmp1, ntmp2 ! work variables +! integer :: npchunks(0:npes-1) ! number of chunks to be assigned to +! ! a given process + integer :: cur_npchunks(0:npes-1) ! current number of chunks assigned + ! to a given process + integer :: column_count(0:npes-1) ! number of columns from current chunk + ! assigned to each process in dynamics + ! decomposition +!----------------------------------------------------------------------- +! +! Count number of processes per virtual SMP and determine virtual SMP +! to process id map +! + ntsks_smpx(:) = 0 + smp_proc_mapx(:,:) = -1 + do p=0,npes-1 + smp = proc_smp_mapx(p) + ntsks_smpx(smp) = ntsks_smpx(smp) + 1 + smp_proc_mapx(smp,ntsks_smpx(smp)) = p + enddo +! +! Determine chunk id ranges for each virtual SMP +! + cid_offset(0) = 1 + do smp=1,nsmpx + cid_offset(smp) = cid_offset(smp-1) + nsmpchunks(smp-1) + enddo +! +! Determine number of chunks to assign to each process +! + do smp=0,nsmpx-1 +! +! Minimum number of chunks per thread + ntmp1_smp(smp) = nsmpchunks(smp)/nsmpthreads(smp) + +! Number of extra chunks to be assigned + ntmp2_smp(smp) = mod(nsmpchunks(smp),nsmpthreads(smp)) + +! Number of processes that get more extra chunks than the others + ntmp3_smp(smp) = mod(ntmp2_smp(smp),ntsks_smpx(smp)) + +! Number of extra chunks per process + ntmp4_smp(smp) = ntmp2_smp(smp)/ntsks_smpx(smp) + if (ntmp3_smp(smp) > 0) then + ntmp4_smp(smp) = ntmp4_smp(smp) + 1 + endif + enddo + + do p=0,npes-1 + smp = proc_smp_mapx(p) + +! Update number of extra chunks + if (ntmp2_smp(smp) > ntmp4_smp(smp)) then + ntmp2_smp(smp) = ntmp2_smp(smp) - ntmp4_smp(smp) + else + ntmp4_smp(smp) = ntmp2_smp(smp) + ntmp2_smp(smp) = 0 + ntmp3_smp(smp) = 0 + endif + +! Set number of chunks + npchunks(p) = ntmp1_smp(smp)*npthreads(p) + ntmp4_smp(smp) + +! Update extra chunk increment + if (ntmp3_smp(smp) > 0) then + ntmp3_smp(smp) = ntmp3_smp(smp) - 1 + if (ntmp3_smp(smp) .eq. 0) then + ntmp4_smp(smp) = ntmp4_smp(smp) - 1 + endif + endif + enddo + +! +! Assign chunks to processes: +! + cur_npchunks(:) = 0 +! + do smp=0,nsmpx-1 + do cid=cid_offset(smp),cid_offset(smp+1)-1 +! + do i=1,ntsks_smpx(smp) + p = smp_proc_mapx(smp,i) + column_count(p) = 0 + enddo +! +! For each chunk, determine number of columns in each +! process within the dynamics. + do i=1,chunks(cid)%ncols + curgcol = chunks(cid)%gcol(i) + block_cnt = get_gcol_block_cnt_d(curgcol) + call get_gcol_block_d(curgcol,block_cnt,blockids,bcids) + do jb=1,block_cnt + p = get_block_owner_d(blockids(jb)) + column_count(p) = column_count(p) + 1 + enddo + enddo +! +! Eliminate processes that already have their quota of chunks + do i=1,ntsks_smpx(smp) + p = smp_proc_mapx(smp,i) + if (cur_npchunks(p) == npchunks(p)) then + column_count(p) = -1 + endif + enddo +! +! Assign chunk to process with most +! columns from chunk, from among those still available + ntmp1 = -1 + ntmp2 = -1 + do i=1,ntsks_smpx(smp) + p = smp_proc_mapx(smp,i) + if (column_count(p) > ntmp1) then + ntmp1 = column_count(p) + ntmp2 = p + endif + enddo + cur_npchunks(ntmp2) = cur_npchunks(ntmp2) + 1 + chunks(cid)%owner = ntmp2 + +! Update total number of columns assigned to this process + gs_col_num(ntmp2) = gs_col_num(ntmp2) + chunks(cid)%ncols +! + enddo +! + enddo +! + return + end subroutine assign_chunks +! +!======================================================================== + +!####################################################################### + +end module phys_grid diff --git a/src/physics/cam/phys_prop.F90 b/src/physics/cam/phys_prop.F90 new file mode 100644 index 0000000000..568427e44e --- /dev/null +++ b/src/physics/cam/phys_prop.F90 @@ -0,0 +1,1314 @@ +module phys_prop + +! Properties of aerosols that are used by radiation and other parameterizations. + +! *****N.B.***** +! This module is a utility used by the rad_constituents module. The properties stored +! here are meant to be accessed via that module. This module knows nothing about how +! this data is associated with the constituents that are radiatively active or those that +! are being used for diagnostic calculations. That is the responsibility of the +! rad_constituents module. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use radconstants, only: nrh, nlwbands, nswbands, idx_sw_diag +use ioFileMod, only: getfil +use cam_pio_utils, only: cam_pio_openfile +use pio, only: file_desc_t, var_desc_t, pio_get_var, pio_inq_varid, & + pio_inq_dimlen, pio_inq_dimid , pio_nowrite, pio_closefile, & + pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_NOERR + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +integer, parameter, public :: ot_length = 32 +public :: & + physprop_accum_unique_files, &! Make a list of the unique set of files that contain properties + ! This is an initialization step that must be done before calling physprop_init + physprop_init, &! Initialization -- read the input datasets + physprop_get_id, &! Return ID used to access the property data from the input files + physprop_get ! Return data for specified ID + +! Data from one input dataset is stored in a structure of type(physprop_type). +type :: physprop_type + character(len=256) :: sourcefile ! Absolute pathname of data file. + character(len=ot_length) :: opticsmethod ! one of {hygro,nonhygro} + + ! for hygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_hygro_ext(:,:) + real(r8), pointer :: sw_hygro_ssa(:,:) + real(r8), pointer :: sw_hygro_asm(:,:) + real(r8), pointer :: lw_hygro_abs(:,:) + + ! for nonhygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_nonhygro_ext(:) + real(r8), pointer :: sw_nonhygro_ssa(:) + real(r8), pointer :: sw_nonhygro_asm(:) + real(r8), pointer :: sw_nonhygro_scat(:) + real(r8), pointer :: sw_nonhygro_ascat(:) + real(r8), pointer :: lw_abs(:) + + ! complex refractive index + complex(r8), pointer :: refindex_aer_sw(:) + complex(r8), pointer :: refindex_aer_lw(:) + + ! for radius-dependent mass-specific quantities + real(r8), pointer :: r_sw_ext(:,:) + real(r8), pointer :: r_sw_scat(:,:) + real(r8), pointer :: r_sw_ascat(:,:) + real(r8), pointer :: r_lw_abs(:,:) + real(r8), pointer :: mu(:) + + ! for modal optics + real(r8), pointer :: extpsw(:,:,:,:) ! specific extinction + real(r8), pointer :: abspsw(:,:,:,:) ! specific absorption + real(r8), pointer :: asmpsw(:,:,:,:) ! asymmetry factor + real(r8), pointer :: absplw(:,:,:,:) ! specific absorption + real(r8), pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols visible + real(r8), pointer :: refitabsw(:,:) ! table of imag refractive indices for aerosols visible + real(r8), pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols infrared + real(r8), pointer :: refitablw(:,:) ! table of imag refractive indices for aerosols infrared + + ! microphysics parameters. + character(len=32) :: aername ! for output of number concentration + real(r8) :: density_aer ! density of aerosol (kg/m3) + real(r8) :: hygro_aer ! hygroscopicity of aerosol + real(r8) :: dryrad_aer ! number mode radius (m) of aerosol size distribution + real(r8) :: dispersion_aer ! geometric standard deviation of aerosol size distribution + real(r8) :: num_to_mass_aer ! ratio of number concentration to mass concentration (#/kg) + ! *** Is this actually (kg/#) ??? + ! mode parameters + integer :: ncoef ! number of Chebyshev coefficients + integer :: prefr ! dimension in table of real refractive indices + integer :: prefi ! dimension in table of imag refractive indices + real(r8) :: sigmag ! geometric standard deviation of the number distribution for aerosol mode + real(r8) :: dgnum ! geometric dry mean diameter of the number distribution for aerosol mode + real(r8) :: dgnumlo ! lower limit of dgnum + real(r8) :: dgnumhi ! upper limit of dgnum + real(r8) :: rhcrystal ! crystalization relative humidity for mode + real(r8) :: rhdeliques ! deliquescence relative humidity for mode + +endtype physprop_type + +! This module stores data in an array of physprop_type structures. The way this data +! is accessed outside the module is via a physprop ID, which is an index into the array. +integer :: numphysprops = 0 ! an incremental total across ALL clim and diag constituents +type (physprop_type), pointer :: physprop(:) + +! Temporary storage location for filenames in namelist, and construction of dynamic index +! to properties. The unique filenames specified in the namelist are the identifiers of +! the properties. Searching the uniquefilenames array provides the index into the physprop +! array. +character(len=256), allocatable :: uniquefilenames(:) + +!================================================================================================ +contains +!================================================================================================ + +subroutine physprop_accum_unique_files(radname, type) + + ! Count number of aerosols in input radname array. Aerosols are identified + ! as strings with a ".nc" suffix. + ! Construct a cumulative list of unique filenames containing physical property data. + + character(len=*), intent(in) :: radname(:) + character(len=1), intent(in) :: type(:) + + integer :: ncnst, i + character(len=*), parameter :: subname = 'physprop_accum_unique_files' + !------------------------------------------------------------------------------------ + + ! Initial guess for number of files we need. + if (.not. allocated(uniquefilenames)) allocate(uniquefilenames(50)) + + ncnst = ubound(radname, 1) + + do i = 1, ncnst + + ! check if radname is either a bulk aerosol or a mode + if (type(i) == 'A' .or. type(i) == 'M') then + + ! check if this filename has been used by another aerosol. If not + ! then add it to the list of unique names. + if (physprop_get_id(radname(i)) < 0) then + numphysprops = numphysprops + 1 + if (numphysprops > size(uniquefilenames)) then + call double_capacity(uniquefilenames) + end if + uniquefilenames(numphysprops) = trim(radname(i)) + endif + + endif + enddo + + contains + + ! Simple routine to re-allocate an array with twice the size, but with + ! the inital values being preserved. + subroutine double_capacity(array) + character(len=256), intent(inout), allocatable :: array(:) + + character(len=256), allocatable :: tmp(:) + integer :: ierr + + allocate(tmp(size(array)*2), stat=ierr) + if ( ierr /= 0 ) then + call endrun('physprop_accum_unique_files: Allocation error.') + end if + + tmp(:size(array)) = array + + deallocate(array, stat=ierr) + if ( ierr /= 0 ) then + call endrun('physprop_accum_unique_files: Deallocation error.') + end if + + call move_alloc(tmp, array) + + end subroutine double_capacity + +end subroutine physprop_accum_unique_files + +!================================================================================================ + +subroutine physprop_init() + + ! Read properties from the aerosol data files. + + ! ***N.B.*** The calls to physprop_accum_unique_files must be made before calling + ! this init routine. physprop_accum_unique_files is responsible for building + ! the list of files to be read here. + + ! Local variables + integer :: fileindex + type(file_desc_t) :: nc_id ! index to netcdf file + character(len=256) :: locfn ! path to actual file used + character(len=32) :: aername_str ! string read from netCDF file -- may contain trailing + ! nulls which aren't dealt with by trim() + + integer :: ierr ! error codes from mpi + + !------------------------------------------------------------------------------------ + + allocate(physprop(numphysprops)) + + do fileindex = 1, numphysprops + nullify(physprop(fileindex)%sw_hygro_ext) + nullify(physprop(fileindex)%sw_hygro_ssa) + nullify(physprop(fileindex)%sw_hygro_asm) + nullify(physprop(fileindex)%lw_hygro_abs) + + nullify(physprop(fileindex)%sw_nonhygro_ext) + nullify(physprop(fileindex)%sw_nonhygro_ssa) + nullify(physprop(fileindex)%sw_nonhygro_asm) + nullify(physprop(fileindex)%sw_nonhygro_scat) + nullify(physprop(fileindex)%sw_nonhygro_ascat) + nullify(physprop(fileindex)%lw_abs) + + nullify(physprop(fileindex)%refindex_aer_sw) + nullify(physprop(fileindex)%refindex_aer_lw) + + nullify(physprop(fileindex)%r_sw_ext) + nullify(physprop(fileindex)%r_sw_scat) + nullify(physprop(fileindex)%r_sw_ascat) + nullify(physprop(fileindex)%r_lw_abs) + nullify(physprop(fileindex)%mu) + + nullify(physprop(fileindex)%extpsw) + nullify(physprop(fileindex)%abspsw) + nullify(physprop(fileindex)%asmpsw) + nullify(physprop(fileindex)%absplw) + nullify(physprop(fileindex)%refrtabsw) + nullify(physprop(fileindex)%refitabsw) + nullify(physprop(fileindex)%refrtablw) + nullify(physprop(fileindex)%refitablw) + + call getfil(uniquefilenames(fileindex), locfn, 0) + physprop(fileindex)%sourcefile = locfn + + ! Open the physprop file + call cam_pio_openfile(nc_id, locfn, PIO_NOWRITE) + + call aerosol_optics_init(physprop(fileindex), nc_id) + + ! Close the physprop file + call pio_closefile(nc_id) + + end do +end subroutine physprop_init + +!================================================================================================ + +integer function physprop_get_id(filename) + + ! Look for filename in the global list of unique filenames (module data uniquefilenames). + ! If found, return it's index in the list. Otherwise return -1. + + character(len=*), intent(in) :: filename + integer iphysprop + + physprop_get_id = -1 + do iphysprop = 1, numphysprops + if(trim(uniquefilenames(iphysprop)) == trim(filename) ) then + physprop_get_id = iphysprop + return + endif + enddo + +end function physprop_get_id + +!================================================================================================ + +subroutine physprop_get(id, sourcefile, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_abs, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_abs, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, ncoef, prefr, prefi, sigmag, & + dgnum, dgnumlo, dgnumhi, rhcrystal, rhdeliques) + + ! Return requested properties for specified ID. + + ! Arguments + integer, intent(in) :: id + character(len=256), optional, intent(out) :: sourcefile ! Absolute pathname of data file. + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_abs(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_abs(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: extpsw(:,:,:,:) + real(r8), optional, pointer :: abspsw(:,:,:,:) + real(r8), optional, pointer :: asmpsw(:,:,:,:) + real(r8), optional, pointer :: absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:) + real(r8), optional, pointer :: refitabsw(:,:) + real(r8), optional, pointer :: refrtablw(:,:) + real(r8), optional, pointer :: refitablw(:,:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + + ! Local variables + character(len=*), parameter :: subname = 'physprop_get' + !------------------------------------------------------------------------------------ + + if (id <= 0 .or. id > numphysprops) then + write(iulog,*) subname//': illegal ID value: ', id + call endrun('physprop_get: ID out of range') + end if + + if (present(sourcefile)) sourcefile = physprop(id)%sourcefile + if (present(opticstype)) opticstype = physprop(id)%opticsmethod + if (present(sw_hygro_ext)) sw_hygro_ext => physprop(id)%sw_hygro_ext + if (present(sw_hygro_ssa)) sw_hygro_ssa => physprop(id)%sw_hygro_ssa + if (present(sw_hygro_asm)) sw_hygro_asm => physprop(id)%sw_hygro_asm + if (present(lw_hygro_abs)) lw_hygro_abs => physprop(id)%lw_hygro_abs + if (present(sw_nonhygro_ext)) sw_nonhygro_ext => physprop(id)%sw_nonhygro_ext + if (present(sw_nonhygro_ssa)) sw_nonhygro_ssa => physprop(id)%sw_nonhygro_ssa + if (present(sw_nonhygro_asm)) sw_nonhygro_asm => physprop(id)%sw_nonhygro_asm + if (present(sw_nonhygro_scat)) sw_nonhygro_scat => physprop(id)%sw_nonhygro_scat + if (present(sw_nonhygro_ascat)) sw_nonhygro_ascat => physprop(id)%sw_nonhygro_ascat + if (present(lw_abs)) lw_abs => physprop(id)%lw_abs + + if (present(refindex_aer_sw)) refindex_aer_sw => physprop(id)%refindex_aer_sw + if (present(refindex_aer_lw)) refindex_aer_lw => physprop(id)%refindex_aer_lw + + if (present(r_sw_ext)) r_sw_ext => physprop(id)%r_sw_ext + if (present(r_sw_scat)) r_sw_scat => physprop(id)%r_sw_scat + if (present(r_sw_ascat)) r_sw_ascat => physprop(id)%r_sw_ascat + if (present(r_lw_abs)) r_lw_abs => physprop(id)%r_lw_abs + if (present(mu)) mu => physprop(id)%mu + + if (present(extpsw)) extpsw => physprop(id)%extpsw + if (present(abspsw)) abspsw => physprop(id)%abspsw + if (present(asmpsw)) asmpsw => physprop(id)%asmpsw + if (present(absplw)) absplw => physprop(id)%absplw + if (present(refrtabsw)) refrtabsw => physprop(id)%refrtabsw + if (present(refitabsw)) refitabsw => physprop(id)%refitabsw + if (present(refrtablw)) refrtablw => physprop(id)%refrtablw + if (present(refitablw)) refitablw => physprop(id)%refitablw + + if (present(aername)) aername = physprop(id)%aername + if (present(density_aer)) density_aer = physprop(id)%density_aer + if (present(hygro_aer)) hygro_aer = physprop(id)%hygro_aer + if (present(dryrad_aer)) dryrad_aer = physprop(id)%dryrad_aer + if (present(dispersion_aer)) dispersion_aer = physprop(id)%dispersion_aer + if (present(num_to_mass_aer)) num_to_mass_aer = physprop(id)%num_to_mass_aer + + if (present(ncoef)) ncoef = physprop(id)%ncoef + if (present(prefr)) prefr = physprop(id)%prefr + if (present(prefi)) prefi = physprop(id)%prefi + if (present(sigmag)) sigmag = physprop(id)%sigmag + if (present(dgnum)) dgnum = physprop(id)%dgnum + if (present(dgnumlo)) dgnumlo = physprop(id)%dgnumlo + if (present(dgnumhi)) dgnumhi = physprop(id)%dgnumhi + if (present(rhcrystal)) rhcrystal = physprop(id)%rhcrystal + if (present(rhdeliques)) rhdeliques = physprop(id)%rhdeliques + +end subroutine physprop_get + +!================================================================================================ +! Private methods +!================================================================================================ + +subroutine aerosol_optics_init(phys_prop, nc_id) + + ! Determine the opticstype, then call the + ! appropriate routine to read the data. + + type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type(file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + integer :: opticslength_id, opticslength + type(var_desc_t) :: op_type_id + integer :: ierr ! mpi error codes + character(len=ot_length) :: opticstype_str ! string read from netCDF file -- may contain trailing + ! nulls which aren't dealt with by trim() + !------------------------------------------------------------------------------------ + + ierr = pio_inq_dimid(nc_id, 'opticsmethod_len', opticslength_id) + ierr = pio_inq_dimlen(nc_id, opticslength_id, opticslength) + if ( opticslength .gt. ot_length ) then + call endrun(" optics type length in "//phys_prop%sourcefile//" excedes maximum length of 32") + endif + ierr = pio_inq_varid(nc_id, 'opticsmethod', op_type_id) + ierr = pio_get_var(nc_id, op_type_id,phys_prop%opticsmethod ) + + select case (phys_prop%opticsmethod) + case ('zero') + call zero_optics_init(phys_prop, nc_id) + + case ('hygro') + call hygro_optics_init(phys_prop, nc_id) + + case ('hygroscopic') + call hygroscopic_optics_init(phys_prop, nc_id) + + case ('nonhygro') + call nonhygro_optics_init(phys_prop, nc_id) + + case ('insoluble') + call insoluble_optics_init(phys_prop, nc_id) + + case ('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') + call volcanic_radius_optics_init(phys_prop, nc_id) + + case ('volcanic') + call volcanic_optics_init(phys_prop, nc_id) + + case ('modal') + call modal_optics_init(phys_prop, nc_id) + + ! other types of optics can be added here + + case default + call endrun('aerosol_optics_init: unsupported optics type '//& + trim(phys_prop%opticsmethod)//' in file '//phys_prop%sourcefile) + end select + +end subroutine aerosol_optics_init + +!================================================================================================ + +subroutine hygro_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'hygro' and interpolate it to CAM's rh mesh. + + type (physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type (file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_idx_id, lw_band_id, sw_band_id + integer :: kbnd, krh + integer :: rh_id, sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: nbnd, swbands + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nfilerh ! number of rh values in file + real(r8), allocatable, dimension(:) :: frh + real(r8), allocatable, dimension(:,:) :: fsw_ext + real(r8), allocatable, dimension(:,:) :: fsw_ssa + real(r8), allocatable, dimension(:,:) :: fsw_asm + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + !------------------------------------------------------------------------------------ + + allocate(phys_prop%sw_hygro_ext(nrh,nswbands)) + allocate(phys_prop%sw_hygro_ssa(nrh,nswbands)) + allocate(phys_prop%sw_hygro_asm(nrh,nswbands)) + allocate(phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_idx_id) + + ierr = pio_inq_dimlen(nc_id, rh_idx_id, nfilerh) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if(swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ! specific optical properties on file's rh mesh + allocate(fsw_ext(nfilerh,nswbands)) + allocate(fsw_asm(nfilerh,nswbands)) + allocate(fsw_ssa(nfilerh,nswbands)) + allocate(frh(nfilerh)) + + ierr = pio_get_var(nc_id, rh_id, frh) + + ierr = pio_get_var(nc_id, sw_ext_id, fsw_ext) + + ierr = pio_get_var(nc_id, sw_ssa_id, fsw_ssa) + + ierr = pio_get_var(nc_id, sw_asm_id, fsw_asm) + + ierr = pio_get_var(nc_id, lw_ext_id, phys_prop%lw_abs) + + ! interpolate onto cam's rh mesh + do kbnd = 1,nswbands + do krh = 1, nrh + rh = 1.0_r8 / nrh * (krh - 1) + phys_prop%sw_hygro_ext(krh,kbnd) = & + exp_interpol( frh, fsw_ext(:,kbnd) / fsw_ext(1,kbnd), rh ) & + * fsw_ext(1, kbnd) + phys_prop%sw_hygro_ssa(krh,kbnd) = & + lin_interpol( frh, fsw_ssa(:,kbnd) / fsw_ssa(1,kbnd), rh ) & + * fsw_ssa(1, kbnd) + phys_prop%sw_hygro_asm(krh,kbnd) = & + lin_interpol( frh, fsw_asm(:,kbnd) / fsw_asm(1,kbnd), rh ) & + * fsw_asm(1, kbnd) + enddo + enddo + + deallocate (fsw_ext, fsw_asm, fsw_ssa, frh) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine hygro_optics_init + +!================================================================================================ + +subroutine zero_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'nonhygro' + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + ! perhaps this doesn't even need allocated. + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + phys_prop%sw_nonhygro_ext = 0._r8 + phys_prop%sw_nonhygro_ssa = 0._r8 + phys_prop%sw_nonhygro_asm = 0._r8 + phys_prop%lw_abs = 0._r8 + +end subroutine zero_optics_init + +!================================================================================================ + +subroutine insoluble_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'nonhygro' + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + integer :: start(2), count(2) + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + start = 1 + count=(/1,swbands/) + + ierr = pio_get_var(nc_id, sw_ext_id, start, count, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, start, count, phys_prop%sw_nonhygro_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, start, count, phys_prop%sw_nonhygro_asm) + count = (/1,nbnd/) + ierr = pio_get_var(nc_id, lw_ext_id, start, count, phys_prop%lw_abs) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine insoluble_optics_init + +!================================================================================================ + +subroutine volcanic_radius_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'volcanic_radius' + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_t), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id, mu_id, mu_did + integer :: sw_ext_id, sw_scat_id, sw_ascat_id, lw_abs_id + integer :: swbands, nbnd, n_mu_samples + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + ierr = pio_inq_dimid(nc_id, 'mu_samples', mu_did) + ierr = pio_inq_dimlen(nc_id, mu_did, n_mu_samples) + + allocate (phys_prop%r_sw_ext(nswbands,n_mu_samples)) + allocate (phys_prop%r_sw_scat(nswbands,n_mu_samples)) + allocate (phys_prop%r_sw_ascat(nswbands,n_mu_samples)) + allocate (phys_prop%r_lw_abs(nlwbands,n_mu_samples)) + allocate (phys_prop%mu(n_mu_samples)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'bext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'bsca_sw', sw_scat_id) + ierr = pio_inq_varid(nc_id, 'basc_sw', sw_ascat_id) + ierr = pio_inq_varid(nc_id, 'babs_lw', lw_abs_id) + ierr = pio_inq_varid(nc_id, 'mu_samples', mu_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%r_sw_ext) + ierr = pio_get_var(nc_id, sw_scat_id, phys_prop%r_sw_scat) + ierr = pio_get_var(nc_id, sw_ascat_id, phys_prop%r_sw_ascat) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%r_lw_abs) + ierr = pio_get_var(nc_id, mu_id, phys_prop%mu) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine volcanic_radius_optics_init + +!================================================================================================ + +subroutine volcanic_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'volcanic' + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_t) , intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_scat_id, sw_ascat_id, lw_abs_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_scat(nswbands)) + allocate (phys_prop%sw_nonhygro_ascat(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if(masterproc) write(iulog,*) 'swbands',swbands + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'bext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'bsca_sw', sw_scat_id) + ierr = pio_inq_varid(nc_id, 'basc_sw', sw_ascat_id) + ierr = pio_inq_varid(nc_id, 'babs_lw', lw_abs_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_scat_id, phys_prop%sw_nonhygro_scat) + ierr = pio_get_var(nc_id, sw_ascat_id, phys_prop%sw_nonhygro_ascat) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%lw_abs) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine volcanic_optics_init + +!================================================================================================ + +subroutine hygroscopic_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'hygroscopic' and interpolate it to CAM's rh mesh. + + type (physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type (file_desc_T), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_idx_id, lw_band_id, sw_band_id + integer :: kbnd, krh + integer :: rh_id, sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: nbnd, swbands + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nfilerh ! number of rh values in file + real(r8), allocatable, dimension(:) :: frh + real(r8), allocatable, dimension(:,:) :: fsw_ext + real(r8), allocatable, dimension(:,:) :: fsw_ssa + real(r8), allocatable, dimension(:,:) :: fsw_asm + real(r8), allocatable, dimension(:,:) :: flw_abs + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_optics_init' + !------------------------------------------------------------------------------------ + + allocate(phys_prop%sw_hygro_ext(nrh,nswbands)) + allocate(phys_prop%sw_hygro_ssa(nrh,nswbands)) + allocate(phys_prop%sw_hygro_asm(nrh,nswbands)) + allocate(phys_prop%lw_hygro_abs(nrh,nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_idx_id) + ierr = pio_inq_dimlen(nc_id, rh_idx_id, nfilerh) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if(swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ! specific optical properties on file's rh mesh + allocate(fsw_ext(nfilerh,nswbands)) + allocate(fsw_asm(nfilerh,nswbands)) + allocate(fsw_ssa(nfilerh,nswbands)) + allocate(flw_abs(nfilerh,nlwbands)) + allocate(frh(nfilerh)) + + ierr = pio_get_var(nc_id, rh_id, frh) + ierr = pio_get_var(nc_id, sw_ext_id, fsw_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, fsw_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, fsw_asm) + ierr = pio_get_var(nc_id, lw_ext_id, flw_abs) + + ! interpolate onto cam's rh mesh + do kbnd = 1,nswbands + do krh = 1, nrh + rh = 1.0_r8 / nrh * (krh - 1) + phys_prop%sw_hygro_ext(krh,kbnd) = & + exp_interpol( frh, fsw_ext(:,kbnd) / fsw_ext(1,kbnd), rh ) & + * fsw_ext(1, kbnd) + phys_prop%sw_hygro_ssa(krh,kbnd) = & + lin_interpol( frh, fsw_ssa(:,kbnd) / fsw_ssa(1,kbnd), rh ) & + * fsw_ssa(1, kbnd) + phys_prop%sw_hygro_asm(krh,kbnd) = & + lin_interpol( frh, fsw_asm(:,kbnd) / fsw_asm(1,kbnd), rh ) & + * fsw_asm(1, kbnd) + enddo + enddo + do kbnd = 1,nlwbands + do krh = 1, nrh + rh = 1.0_r8 / nrh * (krh - 1) + phys_prop%lw_hygro_abs(krh,kbnd) = & + exp_interpol( frh, flw_abs(:,kbnd) / flw_abs(1,kbnd), rh ) & + * flw_abs(1, kbnd) + enddo + enddo + + deallocate (fsw_ext, fsw_asm, fsw_ssa, flw_abs, frh) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine hygroscopic_optics_init + +!================================================================================================ + +subroutine nonhygro_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'nonhygro' + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_t) , intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: lw_band_id, sw_band_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_ext_id + integer :: swbands, nbnd + integer :: ierr ! error flag + !------------------------------------------------------------------------------------ + + allocate (phys_prop%sw_nonhygro_ext(nswbands)) + allocate (phys_prop%sw_nonhygro_ssa(nswbands)) + allocate (phys_prop%sw_nonhygro_asm(nswbands)) + allocate (phys_prop%lw_abs(nlwbands)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + + if (swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ! read file data + ierr = pio_inq_varid(nc_id, 'ext_sw', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw', lw_ext_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_nonhygro_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, phys_prop%sw_nonhygro_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, phys_prop%sw_nonhygro_asm) + ierr = pio_get_var(nc_id, lw_ext_id, phys_prop%lw_abs) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine nonhygro_optics_init + +!================================================================================================ + +subroutine refindex_aer_init(phys_prop, nc_id) + +! Read refractive indices of aerosol + + type (physprop_type), intent(inout) :: phys_prop ! storage for file data + type (file_desc_T), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: i + integer :: istat1, istat2, istat3 ! status flags + integer :: vid_real, vid_im ! variable ids + real(r8), pointer :: ref_real(:), ref_im(:) ! tmp storage for components of complex index + character(len=*), parameter :: subname = 'refindex_aer_init' + !------------------------------------------------------------------------------------ + + ! assume that the dimensions lw_band and sw_band have already been checked + ! by the calling subroutine + + ! Check that the variables are present before allocating storage and reading. + ! Since we're setting complex data values, both the real and imaginary parts must + ! be present or neither will be read. + + ! set PIO to return control to the caller when variable not found + call pio_seterrorhandling(nc_id, PIO_BCAST_ERROR) + + istat1 = pio_inq_varid(nc_id, 'refindex_real_aer_sw', vid_real) + istat2 = pio_inq_varid(nc_id, 'refindex_im_aer_sw', vid_im) + + if (istat1 == PIO_NOERR .and. istat2 == PIO_NOERR) then + + allocate(ref_real(nswbands), ref_im(nswbands)) + + istat3 = pio_get_var(nc_id, vid_real, ref_real) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_real_aer_sw') + end if + + istat3 = pio_get_var(nc_id, vid_im, ref_im) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_im_aer_sw') + end if + + ! successfully read refindex data -- set complex values in physprop object + allocate(phys_prop%refindex_aer_sw(nswbands)) + do i = 1, nswbands + phys_prop%refindex_aer_sw(i) = cmplx(ref_real(i), abs(ref_im(i)),& + kind=r8) + end do + + deallocate(ref_real, ref_im) + + end if + + istat1 = pio_inq_varid(nc_id, 'refindex_real_aer_lw', vid_real) + istat2 = pio_inq_varid(nc_id, 'refindex_im_aer_lw', vid_im) + + if (istat1 == PIO_NOERR .and. istat2 == PIO_NOERR) then + + allocate(ref_real(nlwbands), ref_im(nlwbands)) + + istat3 = pio_get_var(nc_id, vid_real, ref_real) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_real_aer_lw') + end if + + istat3 = pio_get_var(nc_id, vid_im, ref_im) + if (istat3 /= PIO_NOERR) then + call endrun(subname//': ERROR reading refindex_im_aer_lw') + end if + + ! successfully read refindex data -- set complex value in physprop object + allocate(phys_prop%refindex_aer_lw(nlwbands)) + do i = 1, nlwbands + phys_prop%refindex_aer_lw(i) = cmplx(ref_real(i), abs(ref_im(i)),& + kind=r8) + end do + + deallocate(ref_real, ref_im) + + end if + + ! reset PIO to handle errors internally + call pio_seterrorhandling(nc_id, PIO_INTERNAL_ERROR) + +end subroutine refindex_aer_init + +!================================================================================================ + +subroutine modal_optics_init(props, ncid) + +! Read optics data for modal aerosols + + type (physprop_type), intent(inout) :: props ! storage for file data + type (file_desc_T), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + real(r8), pointer :: rval(:,:,:,:,:) ! temp array used to eliminate a singleton dimension + + character(len=*), parameter :: subname = 'modal_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ! Get other dimensions + ierr = pio_inq_dimid(ncid, 'coef_number', did) + ierr = pio_inq_dimlen(ncid, did, props%ncoef) + + ierr = pio_inq_dimid(ncid, 'refindex_real', did) + ierr = pio_inq_dimlen(ncid, did, props%prefr) + + ierr = pio_inq_dimid(ncid, 'refindex_im', did) + ierr = pio_inq_dimlen(ncid, did, props%prefi) + + ! Allocate arrays + allocate( & + props%extpsw(props%ncoef,props%prefr,props%prefi,nswbands), & + props%abspsw(props%ncoef,props%prefr,props%prefi,nswbands), & + props%asmpsw(props%ncoef,props%prefr,props%prefi,nswbands), & + props%absplw(props%ncoef,props%prefr,props%prefi,nlwbands), & + props%refrtabsw(props%prefr,nswbands), & + props%refitabsw(props%prefi,nswbands), & + props%refrtablw(props%prefr,nlwbands), & + props%refitablw(props%prefi,nlwbands) ) + + + ! allocate temp to remove the mode dimension from the sw variables + allocate(rval(props%ncoef,props%prefr,props%prefi,1,nswbands)) + + ierr = pio_inq_varid(ncid, 'extpsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%extpsw = rval(:,:,:,1,:) + + ierr = pio_inq_varid(ncid, 'abspsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%abspsw = rval(:,:,:,1,:) + + ierr = pio_inq_varid(ncid, 'asmpsw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%asmpsw = rval(:,:,:,1,:) + + deallocate(rval) + + ! allocate temp to remove the mode dimension from the lw variables + allocate(rval(props%ncoef,props%prefr,props%prefi,1,nlwbands)) + + ierr = pio_inq_varid(ncid, 'absplw', vid) + ierr = pio_get_var(ncid, vid, rval) + props%absplw = rval(:,:,:,1,:) + + deallocate(rval) + + ierr = pio_inq_varid(ncid, 'refindex_real_sw', vid) + ierr = pio_get_var(ncid, vid, props%refrtabsw) + + ierr = pio_inq_varid(ncid, 'refindex_im_sw', vid) + ierr = pio_get_var(ncid, vid, props%refitabsw) + + ierr = pio_inq_varid(ncid, 'refindex_real_lw', vid) + ierr = pio_get_var(ncid, vid, props%refrtablw) + + ierr = pio_inq_varid(ncid, 'refindex_im_lw', vid) + ierr = pio_get_var(ncid, vid, props%refitablw) + + ierr = pio_inq_varid(ncid, 'sigmag', vid) + ierr = pio_get_var(ncid, vid, props%sigmag) + + ierr = pio_inq_varid(ncid, 'dgnum', vid) + ierr = pio_get_var(ncid, vid, props%dgnum) + + ierr = pio_inq_varid(ncid, 'dgnumlo', vid) + ierr = pio_get_var(ncid, vid, props%dgnumlo) + + ierr = pio_inq_varid(ncid, 'dgnumhi', vid) + ierr = pio_get_var(ncid, vid, props%dgnumhi) + + ierr = pio_inq_varid(ncid, 'rhcrystal', vid) + ierr = pio_get_var(ncid, vid, props%rhcrystal) + + ierr = pio_inq_varid(ncid, 'rhdeliques', vid) + ierr = pio_get_var(ncid, vid, props%rhdeliques) + +end subroutine modal_optics_init + +!================================================================================================ + +subroutine bulk_props_init(physprop, nc_id) + +! Read props for bulk aerosols + + type (physprop_type), intent(inout) :: physprop ! storage for file data + type (file_desc_T), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr + + type(var_desc_T) :: vid + + logical :: debug = .true. + + character(len=*), parameter :: subname = 'bulk_props_init' + !------------------------------------------------------------------------------------ + + ! read microphys + ierr = pio_inq_varid(nc_id, 'name', vid) + ierr = pio_get_var(nc_id, vid, physprop%aername) + + ! use GLC function to remove trailing nulls and blanks. + ! physprop%aername = aername_str(:GLC(aername_str)) + + ierr = pio_inq_varid(nc_id, 'density', vid) + ierr = pio_get_var(nc_id, vid, physprop%density_aer) + + ierr = pio_inq_varid(nc_id, 'sigma_logr', vid) + ierr = pio_get_var(nc_id, vid, physprop%dispersion_aer) + + ierr = pio_inq_varid(nc_id, 'dryrad', vid) + ierr = pio_get_var(nc_id, vid, physprop%dryrad_aer) + + ierr = pio_inq_varid(nc_id, 'hygroscopicity', vid) + ierr = pio_get_var(nc_id, vid, physprop%hygro_aer) + + ierr = pio_inq_varid(nc_id, 'num_to_mass_ratio', vid) + ierr = pio_get_var(nc_id, vid, physprop%num_to_mass_aer) + + ! Output select data to log file + if (debug .and. masterproc) then + if (trim(physprop%aername) == 'SULFATE') then + write(iulog, '(2x, a)') '_______ hygroscopic growth in visible band _______' + call aer_optics_log_rh('SO4', physprop%sw_hygro_ext(:,idx_sw_diag), & + physprop%sw_hygro_ssa(:,idx_sw_diag), physprop%sw_hygro_asm(:,idx_sw_diag)) + end if + write(iulog, *) subname//': finished for ', trim(physprop%aername) + end if + +end subroutine bulk_props_init + +!================================================================================================ + +function exp_interpol(x, f, y) result(g) +! Purpose: +! interpolates f(x) to point y +! assuming f(x) = f(x0) exp a(x - x0) +! where a = ( ln f(x1) - ln f(x0) ) / (x1 - x0) +! x0 <= x <= x1 +! assumes x is monotonically increasing +! Author: D. Fillmore + + implicit none + + real(r8), intent(in), dimension(:) :: x ! grid points + real(r8), intent(in), dimension(:) :: f ! grid function values + real(r8), intent(in) :: y ! interpolation point + real(r8) :: g ! interpolated function value + + integer :: k ! interpolation point index + integer :: n ! length of x + real(r8) :: a + + n = size(x) + + ! find k such that x(k) < y =< x(k+1) + ! set k = 1 if y <= x(1) and k = n-1 if y > x(n) + + if (y <= x(1)) then + k = 1 + else if (y >= x(n)) then + k = n - 1 + else + k = 1 + do while (y > x(k+1) .and. k < n) + k = k + 1 + end do + end if + + ! interpolate + a = ( log( f(k+1) / f(k) ) ) / ( x(k+1) - x(k) ) + g = f(k) * exp( a * (y - x(k)) ) + return +end function exp_interpol + +!================================================================================================ + +function lin_interpol(x, f, y) result(g) +! Purpose: +! interpolates f(x) to point y +! assuming f(x) = f(x0) + a * (x - x0) +! where a = ( f(x1) - f(x0) ) / (x1 - x0) +! x0 <= x <= x1 +! assumes x is monotonically increasing +! Author: D. Fillmore + + implicit none + + real(r8), intent(in), dimension(:) :: x ! grid points + real(r8), intent(in), dimension(:) :: f ! grid function values + real(r8), intent(in) :: y ! interpolation point + real(r8) :: g ! interpolated function value + + integer :: k ! interpolation point index + integer :: n ! length of x + real(r8) :: a + + n = size(x) + + ! find k such that x(k) < y =< x(k+1) + ! set k = 1 if y <= x(1) and k = n-1 if y > x(n) + + if (y <= x(1)) then + k = 1 + else if (y >= x(n)) then + k = n - 1 + else + k = 1 + do while (y > x(k+1) .and. k < n) + k = k + 1 + end do + end if + + ! interpolate + a = ( f(k+1) - f(k) ) / ( x(k+1) - x(k) ) + g = f(k) + a * (y - x(k)) + return +end function lin_interpol + +!================================================================================================ + +subroutine aer_optics_log(name, ext, ssa, asm) + + ! Purpose: + ! write aerosol optical constants to log file + + ! Author: D. Fillmore + + character(len=*), intent(in) :: name + real(r8), intent(in) :: ext(:) + real(r8), intent(in) :: ssa(:) + real(r8), intent(in) :: asm(:) + + integer :: kbnd, nbnd + !------------------------------------------------------------------------------------ + + nbnd = ubound(ext, 1) + + write(iulog, '(2x, a)') name + write(iulog, '(2x, a, 4x, a, 4x, a, 4x, a)') 'SW band', 'ext (m^2 kg^-1)', ' ssa', ' asm' + do kbnd = 1, nbnd + write(iulog, '(2x, i7, 4x, f13.2, 4x, f4.2, 4x, f4.2)') kbnd, ext(kbnd), ssa(kbnd), asm(kbnd) + end do + +end subroutine aer_optics_log + +!================================================================================================ + + +subroutine aer_optics_log_rh(name, ext, ssa, asm) + + ! Purpose: + ! write out aerosol optical properties + ! for a set of test rh values + ! to test hygroscopic growth interpolation + + ! Author: D. Fillmore + + character(len=*), intent(in) :: name + real(r8), intent(in) :: ext(nrh) + real(r8), intent(in) :: ssa(nrh) + real(r8), intent(in) :: asm(nrh) + + integer :: krh_test + integer, parameter :: nrh_test = 36 + integer :: krh + real(r8) :: rh + real(r8) :: rh_test(nrh_test) + real(r8) :: exti + real(r8) :: ssai + real(r8) :: asmi + real(r8) :: wrh + !------------------------------------------------------------------------------------ + + do krh_test = 1, nrh_test + rh_test(krh_test) = sqrt(sqrt(sqrt(sqrt(((krh_test - 1.0_r8) / (nrh_test - 1)))))) + enddo + write(iulog, '(2x, a)') name + write(iulog, '(2x, a, 4x, a, 4x, a, 4x, a)') ' rh', 'ext (m^2 kg^-1)', ' ssa', ' asm' + + ! loop through test rh values + do krh_test = 1, nrh_test + ! find corresponding rh index + rh = rh_test(krh_test) + krh = min(floor( (rh) * nrh ) + 1, nrh - 1) + wrh = (rh) *nrh - krh + exti = ext(krh + 1) * (wrh + 1) - ext(krh) * wrh + ssai = ssa(krh + 1) * (wrh + 1) - ssa(krh) * wrh + asmi = asm(krh + 1) * (wrh + 1) - asm(krh) * wrh + write(iulog, '(2x, f5.3, 4x, f13.3, 4x, f5.3, 4x, f5.3)') rh_test(krh_test), exti, ssai, asmi + end do + +end subroutine aer_optics_log_rh + + +!================================================================================================ + +end module phys_prop diff --git a/src/physics/cam/physics_buffer.F90.in b/src/physics/cam/physics_buffer.F90.in new file mode 100644 index 0000000000..f791d1ddf7 --- /dev/null +++ b/src/physics/cam/physics_buffer.F90.in @@ -0,0 +1,1714 @@ +!#define DEBUG 1 +module physics_buffer + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Buffer managment for persistant variables + ! + ! Author: J. Edwards + ! + ! This file is used with genf90.pl to generate buffer.F90 + ! + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8, r4=> shr_kind_r4, i4=> shr_kind_i4 + use ppgrid, only: pcols, begchunk, endchunk, psubcols + use cam_logfile, only: iulog + use pio, only: var_desc_t + use dyn_grid, only: ptimelevels + use cam_abortutils, only: endrun + use buffer, only: buffer_field_allocate, buffer_field_deallocate, buffer_get_field_ptr, buffer_set_field, & + dtype_i4, dtype_r4, dtype_r8, buffer_field_default_type, buffer_field_is_alloc + + implicit none + private + + ! ngrid_types is a private parameter denoting how many types of a field + ! (e.g., grid, subcol) a pbuf can hold + integer, parameter :: ngrid_types = 2 + + ! --col_type parameters -- see pbuf_add_field and pbuf_get_field + ! -- These indices should start at 1 and increment by 1 so that they + ! -- may be used in a loop from 1 to ngrid_types + + integer, parameter, public :: col_type_grid = 1 + integer, parameter, public :: col_type_subcol = 2 + + ! + ! PBUF field suffix strings for different grid types for restart files + ! NB: There should be ngrid_types entries + ! + character(len=5), parameter :: field_grid_suff(ngrid_types) = (/ " ", "_SCOL" /) + + integer :: old_time_idx = 1 + + ! The API has strings 'GLOBAL' and 'PHYSPKG' which correspond to these + ! integer constants if global_allocate_all is false fields allocated with + ! PHYSPKG persistence are deallocated at the end of each physics time step + ! and reallocated at the beginning of the next. + ! If global_allocate_all is true then all fields are allocated at model + ! start and persist until model completion. + + integer, parameter :: persistence_global = 1 + integer, parameter :: persistence_physpkg = 2 + logical :: global_allocate_all = .true. + + ! + ! physics_buffer_hdr carries the description info for each buffer, only one header + ! is allocated for each field and each chunk of the field points to it. + ! It is carried as a linkedlist for initialization only. + ! + + type physics_buffer_hdr + character(len=16) :: name = '' + integer :: dtype = -1 + integer :: persistence = -1 + integer :: dimsizes(6,ngrid_types) = 0 + type(var_desc_t) :: vardesc(ngrid_types) ! var id for restart files + logical :: is_copy(ngrid_types) = .false. + logical :: added = .false. + type(physics_buffer_hdr), pointer :: nexthdr => null() + + end type physics_buffer_hdr + + ! + ! The default type for a buffer field is buffer_field_double (r8) since that is the + ! type most often used in the model. The F90 transfer function is used to move + ! data of other types into and out of the pbuf2d + ! + + type physics_buffer_desc + private + integer :: lchnk + type(physics_buffer_hdr), pointer :: hdr => null() + type(buffer_field_default_type) :: bfg(ngrid_types) + end type physics_buffer_desc + + interface pbuf_get_field + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + module procedure get_pbuf1d_field_by_index_{DIMS}d_{TYPE} + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + module procedure get_pbuf2d_field_by_index_{DIMS}d_{TYPE} + end interface + + interface pbuf_get_field_restart + ! TYPE int,double,real + module procedure get_pbuf2d_field_restart_{TYPE} + end interface + + interface pbuf_set_field + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + module procedure set_pbuf2d_field_by_index_{DIMS}d_{TYPE} + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + module procedure set_pbuf1d_field_by_index_{DIMS}d_{TYPE} + ! TYPE int,double,real + module procedure set_pbuf1d_field_const_by_index_{TYPE} + ! TYPE int,double,real + module procedure set_pbuf2d_field_const_by_index_{TYPE} + end interface + + interface pbuf_add_field + ! TYPE int,double,real + module procedure pbuf_add_field_{TYPE} + end interface + + public :: pbuf_initialize, & + pbuf_readnl, &! read namelist options + pbuf_init_time, &! Initialize dyn_time_lvls + pbuf_old_tim_idx, &! return the index for the oldest time + pbuf_update_tim_idx, &! update the index for the oldest time + pbuf_col_type_index, & + pbuf_get_field_name, & + pbuf_get_field, & + pbuf_add_field, & + pbuf_register_subcol, & + physics_buffer_desc, & + pbuf_get_index, & + pbuf_get_chunk, & + pbuf_allocate, & + pbuf_deallocate, & + pbuf_set_field, & + pbuf_init_restart, & + pbuf_write_restart, & + pbuf_read_restart, & + dtype_r8, dtype_r4, dtype_i4 + + ! For help debugging code + public :: pbuf_dump_pbuf + + integer, public :: dyn_time_lvls ! number of time levels in physics buffer (dycore dependent) + + + ! + ! Currentpbufflds is incremented in calls to pbuf_add_field and determines the size + ! of the allocated pbuf2d + ! + + integer :: currentpbufflds=0 + type(physics_buffer_hdr), pointer :: hdrbuffertop => null() + + ! + ! Insures that we do not attempt to allocate physics_buffer more than once + ! + + logical :: buffer_initialized =.false. + + ! + ! private pio descriptor for time + ! + + type(var_desc_t) :: timeidx_desc + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine pbuf_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, mpicom, mstrid=>masterprocid, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'pbuf_readnl' + + logical :: pbuf_global_allocate + + namelist /pbuf_nl/ pbuf_global_allocate + !----------------------------------------------------------------------------- + + pbuf_global_allocate = global_allocate_all + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'pbuf_nl', status=ierr) + if (ierr == 0) then + read(unitn, pbuf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(pbuf_global_allocate, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: pbuf_global_allocate") + + global_allocate_all = pbuf_global_allocate + + if (masterproc) then + write(iulog,*) 'physics buffer options:' + write(iulog,*) ' pbuf_global_allocate =', global_allocate_all + end if + +end subroutine pbuf_readnl + +!=============================================================================== + + ! + ! Initialize dyn_time_lvls + ! + subroutine pbuf_init_time() + dyn_time_lvls = ptimelevels - 1 + end subroutine pbuf_init_time + + ! + ! Return index of oldest time sample in the physics buffer. + ! + + function pbuf_old_tim_idx() + integer :: pbuf_old_tim_idx + pbuf_old_tim_idx = old_time_idx + end function pbuf_old_tim_idx + + ! + ! Update index of old time sample in the physics buffer. + ! + + subroutine pbuf_update_tim_idx() + old_time_idx = mod(old_time_idx, dyn_time_lvls) + 1 + end subroutine pbuf_update_tim_idx + + ! + ! pbuf_col_type_index returns an index for use with pbuf calls + ! + ! * col_type: is set to col_type_grid (if use_subcol=.false.) or + ! col_type_subcol (if (use_subcol=.true.). + ! + + subroutine pbuf_col_type_index(use_subcol, col_type) + + logical, intent(in) :: use_subcol + integer, intent(out) :: col_type + + if (use_subcol) then + col_type = col_type_subcol + else + col_type = col_type_grid + end if + + end subroutine pbuf_col_type_index + + ! + ! Return a pointer to the current chunks physics_buffer. + ! + + function pbuf_get_field_name(index) + integer, intent(in) :: index + character(len=16) :: pbuf_get_field_name + integer :: i + type(physics_buffer_hdr), pointer :: hdrbuffer + + hdrbuffer => hdrbuffertop + do i=2,index + hdrbuffer=>hdrbuffer%nexthdr + end do + pbuf_get_field_name = hdrbuffer%name + + end function pbuf_get_field_name + + + function pbuf_get_chunk(pbuf2d, lchnk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: lchnk + + type(physics_buffer_desc), pointer :: pbuf_get_chunk(:) + + pbuf_get_chunk => pbuf2d(:,lchnk) + + + end function pbuf_get_chunk + + ! + ! Return .true. iff pbuf has an allocated grid field + ! + + logical function pbuf_field_has_gridcols(pbuf, index) result(rval) + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: index + + ! If the field is a copy, return .false. even if it is allocated + if (pbuf(index)%hdr%is_copy(col_type_grid)) then + rval = .false. + else + rval = buffer_field_is_alloc(pbuf(index)%bfg(col_type_grid)) + end if + + end function pbuf_field_has_gridcols + + ! + ! Return .true. iff pbuf has an allocated subcolumn field + ! + + logical function pbuf_field_has_subcols(pbuf, index) result(rval) + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: index + + ! If the field is a copy, return .false. even if it is allocated + if (pbuf(index)%hdr%is_copy(col_type_subcol)) then + rval = .false. + else + rval = buffer_field_is_alloc(pbuf(index)%bfg(col_type_subcol)) + end if + + end function pbuf_field_has_subcols + + ! + ! Return .true. iff pbuf has an allocated col_type column field + ! + + logical function pbuf_field_has_col_type(pbuf, index, col_type) result(rval) + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: index + integer, intent(in) :: col_type + + if (col_type == col_type_grid) then + rval = pbuf_field_has_gridcols(pbuf, index) + else if(col_type == col_type_subcol) then + rval = pbuf_field_has_subcols(pbuf, index) + else + call endrun('pbuf_field_has_col_type: Invalid col_type') + end if + + end function pbuf_field_has_col_type + + ! + ! Initialize the buffer, should be called after all pbuf_add_field calls + ! have been completed and should only be called once in a run + ! + subroutine pbuf_initialize(pbuf2d) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: i, c + type(physics_buffer_hdr), pointer :: hdrbuffer + + ! + ! Allocate memory + ! + if(buffer_initialized) return + ! Allocate at least 1 to avoid unallocated error in ideal physics + allocate(pbuf2d(max(1,currentpbufflds),begchunk:endchunk)) + if(currentpbufflds<1) return + + do c = begchunk, endchunk + hdrbuffer => hdrbuffertop + do i = 1, currentpbufflds + if(.not. hdrbuffer%added) then + call endrun('pbuf_initialize: pbuf, '//trim(hdrbuffer%name)//', not added') + end if + pbuf2d(i,c)%lchnk = c + pbuf2d(i,c)%hdr => hdrbuffer + hdrbuffer => hdrbuffer%nexthdr + end do + end do + + buffer_initialized=.true. + call pbuf_allocate(pbuf2d, 'global') +#ifdef DEBUG + call pbuf2d_print(pbuf2d) +#endif + return + end subroutine pbuf_initialize + + + subroutine pbuf_allocate(pbuf2d, persistence) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + character(len=*), intent(in) :: persistence + integer :: i + logical :: allocate_all + + ! allocate_all is used to force allocation of all fields at same time as allocation + ! for global scope. + allocate_all = .false. + if ( global_allocate_all ) then + if ( persistence == 'global' ) then + allocate_all = .true. + else + return + end if + end if + + if(allocate_all) then + do i=1,currentpbufflds + select case(pbuf2d(i,begchunk)%hdr%dtype) + case(TYPEDOUBLE) + call pbuf_allocate_field_double(pbuf2d, i, dtype_r8) + case(TYPEREAL) + call pbuf_allocate_field_real(pbuf2d, i, dtype_r4) +! case(i8) +! call pbuf_allocate_field_long(pbuf2d, i) + case(TYPEINT) + call pbuf_allocate_field_int(pbuf2d, i, dtype_i4) + end select + end do + else if(persistence .eq. 'physpkg') then + do i=1,currentpbufflds + if(pbuf2d(i,begchunk)%hdr%persistence==persistence_physpkg) then + select case(pbuf2d(i,begchunk)%hdr%dtype) + case(TYPEDOUBLE) + call pbuf_allocate_field_double(pbuf2d, i, dtype_r8) + case(TYPEREAL) + call pbuf_allocate_field_real(pbuf2d, i, dtype_r4) +! case(i8) +! call pbuf_allocate_field_long(pbuf2d, i) + case(TYPEINT) + call pbuf_allocate_field_int(pbuf2d, i, dtype_i4) + end select + end if + end do + else if(persistence .eq. 'global') then + do i=1,currentpbufflds + if(pbuf2d(i,begchunk)%hdr%persistence==persistence_global) then + + select case(pbuf2d(i,begchunk)%hdr%dtype) + case(TYPEDOUBLE) + call pbuf_allocate_field_double(pbuf2d, i, dtype_r8) + case(TYPEREAL) + call pbuf_allocate_field_real(pbuf2d, i, dtype_r4) +! case(i8) +! call pbuf_allocate_field_long(pbuf2d, i) + case(TYPEINT) + call pbuf_allocate_field_int(pbuf2d, i, dtype_i4) + end select + end if + end do + end if + end subroutine pbuf_allocate + + ! TYPE int,double,real + subroutine pbuf_allocate_field_{TYPE}(pbuf2d, index, dtype) + {VTYPE}, intent(in) :: dtype + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: index + + integer, pointer :: dimsizes(:) + integer :: c, i + logical :: is_copy + + do i = 1, ngrid_types + ! Note - dimsizes(:)=0 is special case to indicate "do not allocate" and is not fatal + ! Since this is called by a single thread, setting the dimsizes pointer to first chunk is okay + dimsizes => pbuf2d(index,begchunk)%hdr%dimsizes(:,i) + ! Note - We may have dimsizes /= 0 but still don't allocate if copy + is_copy = pbuf2d(index,begchunk)%hdr%is_copy(i) + + if (any(dimsizes(:) < 0)) & + call endrun('pbuf_allocate_field: dimsizes must be greater than 0 for pbuf field '& + //trim(pbuf2d(index,begchunk)%hdr%name)) + + if (all(dimsizes(:) /= 0) .and. (.not. is_copy)) then + do c = begchunk, endchunk + call buffer_field_allocate(pbuf2d(index,c)%bfg(i), dimsizes, dtype) + end do + end if + end do + + end subroutine pbuf_allocate_field_{TYPE} + + pure logical function pbuf_do_deallocate(hdr, persistence, col_type) result(rval) + type(physics_buffer_hdr), pointer :: hdr + character(len=*), intent(in) :: persistence + integer, intent(in) :: col_type + + if (persistence .eq. 'physpkg') then + if (hdr%is_copy(col_type)) then + ! If this is a copied field, it is always deallocated + rval = .true. + else if (global_allocate_all) then + ! This is an all-global run so no deallocation + rval = .false. + else if(hdr%persistence == persistence_physpkg) then + ! This pbuf is a physpkg type, deallocate + rval = .true. + else + ! This pbuf is global, do not deallocate + rval = .false. + end if + else + ! We are doing a global deallocate, everything must go! + rval = .true. + end if + end function pbuf_do_deallocate + + subroutine pbuf_deallocate(pbuf2d, persistence) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + character(len=*) :: persistence + + integer :: i, j, c + + do i = 1, currentpbufflds + do j = 1, ngrid_types + if (pbuf_do_deallocate(pbuf2d(i,begchunk)%hdr, persistence, j)) then + if (buffer_field_is_alloc(pbuf2d(i,begchunk)%bfg(j))) then + select case(pbuf2d(i,begchunk)%hdr%dtype) + case(TYPEDOUBLE) + do c = begchunk,endchunk + call buffer_field_deallocate(pbuf2d(i,c)%bfg(j), dtype_r8) + end do + case(TYPEREAL) + do c = begchunk,endchunk + call buffer_field_deallocate(pbuf2d(i,c)%bfg(j), dtype_r4) + end do + case(TYPEINT) + do c = begchunk,endchunk + call buffer_field_deallocate(pbuf2d(i,c)%bfg(j), dtype_i4) + end do + end select + end if + end if + end do ! ngrid_types + end do ! currentpbufflds + end subroutine pbuf_deallocate + + ! Find a pbuf header pointer based on the name input + ! Automatically tacks on an extra header if is not found. + subroutine find_pbuf_header(name, index, bufptr) + character(len=*), intent(in) :: name + type(physics_buffer_hdr), pointer :: bufptr + integer, intent(out) :: index + + ! Local Variables + logical :: buf_found + + if(.not. associated(hdrbuffertop)) then + ! This is the very first pbuf, allocate and set + allocate(hdrbuffertop) + currentpbufflds = 1 + hdrbuffertop%name = name + end if + + bufptr=>hdrbuffertop + buf_found = .false. + index = 1 + do while(.not. buf_found) + if(trim(bufptr%name) == trim(name)) then + buf_found = .true. + else + if (associated(bufptr%nexthdr)) then + bufptr=>bufptr%nexthdr + index = index + 1 + else + ! We ran off the end of the buffers, make a new one for + ! Sanity check, we should have checked exactly currentpbufflds + if (index /= currentpbufflds) then + call endrun("find_pbuf_header: currentpbufflds indexing off") + end if + currentpbufflds = currentpbufflds + 1 + index = currentpbufflds + allocate(bufptr%nexthdr) + bufptr=>bufptr%nexthdr + bufptr%name = trim(name) + buf_found = .true. + end if + end if + end do + end subroutine find_pbuf_header + ! + ! Register a field in the pbuf + ! This should be called from physics register routines. + ! persistence must be 'global' or 'physpkg' + ! dtype can be any of r8, r4, i4 as defined in shr_kinds_mod.F90 + ! col_type is either col_type_grid or col_type_subcol. + ! If no col_type, then grid field is defined (i.e., dimsizes set) + + subroutine pbuf_register_field_int(name, pname, index, persistence, & + dtype, dimsizes, col_type, pbuf_add) + + ! Dummy Arguments + character(len=*), intent(in) :: name + character(len=*), intent(in) :: pname ! name of calling parameterization + integer, intent(out) :: index + character(len=*), optional, intent(in) :: persistence + integer, optional, intent(in) :: dtype ! used to differentiate specific calls + integer, optional, intent(in) :: dimsizes(:) ! dimension sizes of grid field + integer, optional, intent(in) :: col_type + logical, optional, intent(in) :: pbuf_add + + + ! Local Variables + type(physics_buffer_hdr), pointer :: bufptr + integer :: dimcnt, col_type_use + character(len=128) :: errmsg + + if(buffer_initialized) then + call endrun('Attempt to register pbuf field after buffer initialized') + end if + + call find_pbuf_header(name, index, bufptr) + + if (present(persistence)) then + if(persistence .eq. "global") then + bufptr%persistence = persistence_global + else + bufptr%persistence = persistence_physpkg + end if + end if + + if (present(dtype)) then + bufptr%dtype = dtype + end if + + if (present(dimsizes)) then + ! Normally, we only set buffer dimsizes if dimsizes is passed + dimcnt = size(dimsizes) + + if (present(col_type)) then + col_type_use = col_type + else + col_type_use = col_type_grid + end if + + ! Only allow up to 5 dimensions. #6 is reserved for subcolumn umpacking + ! and #7 is for the physics chunk index. + if (dimcnt > 5) then + call endrun('pbuf_register_field: Attempt to exceed maximum of 5 dimensions for '//trim(name)) + end if + + ! Assign dimensions dependent on col_types input + ! Note that dimensions are initialized to zero and set if being used + if (col_type_use == col_type_grid) then + ! grid is requested + bufptr%dimsizes(:,col_type_grid) = 1 + bufptr%dimsizes(1:dimcnt,col_type_grid) = dimsizes + ! If someone previously registered the subcol, reset those dims + if (bufptr%dimsizes(1,col_type_subcol) == pcols*psubcols) then + bufptr%dimsizes(2:dimcnt,col_type_subcol) = dimsizes(2:dimcnt) + end if + else if (col_type_use == col_type_subcol) then + bufptr%dimsizes(:,col_type_subcol) = 1 + bufptr%dimsizes(1,col_type_subcol) = pcols*psubcols + ! This case should only be used for a pbuf_add_field call adding a subcolumn-only field + if (dimcnt > 1) then + bufptr%dimsizes(2:dimcnt,col_type_subcol) = dimsizes(2:dimcnt) + else if (bufptr%dimsizes(1,col_type_grid) > 0) then + ! If grid field previously registered or added, update dims + bufptr%dimsizes(2:,col_type_subcol) = bufptr%dimsizes(2:,col_type_grid) + end if + end if + end if + + if (present(pbuf_add)) then + if (pbuf_add) then + ! An add request has been made but we have to make sure we have all info + if (all(bufptr%dimsizes(:,:) == 0)) then + write(errmsg, *) 'pbuf_add_field: trying to add field with no dimensions' + call endrun(errmsg) + end if + if (bufptr%dtype < 0) then + write(errmsg, *) 'pbuf_add_field: trying to add field with no type' + call endrun(errmsg) + end if + if (bufptr%persistence < 0) then + write(errmsg, *) 'pbuf_add_field: trying to add field with bad persistence' + call endrun(errmsg) + end if + bufptr%added = .true. + end if + end if + + end subroutine pbuf_register_field_int + + ! + ! Add a field to the pbuf, this should be called from physics register routines + ! name is required to be unique, + ! persistence must be 'global' or 'physpkg' + ! dtype can be any of r8, r4, i4 as defined in shr_kinds_mod.F90 + ! If present, col_type must be either col_type_grid or col_type_subcol + + ! TYPE int,double,real + subroutine pbuf_add_field_{TYPE}(name, persistence, dtype, dimsizes, index, col_type) + + character(len=*), intent(in) :: name, persistence + {VTYPE}, intent(in) :: dtype ! used only to differentiate specific calls + integer, intent(in) :: dimsizes(:) ! dimension sizes of grid field + integer, intent(in), optional :: col_type + integer, intent(out) :: index + + ! Local Variables + integer :: col_type_use + + if(buffer_initialized) then + call endrun('Attempt to add pbuf field after buffer initialized') + end if + + if (present(col_type)) then + col_type_use = col_type + else + col_type_use = col_type_grid + end if + + call pbuf_register_field_int(trim(name), '', index, & + persistence=persistence, dtype={ITYPE}, & + dimsizes=dimsizes, col_type=col_type_use, pbuf_add=.true.) + + end subroutine pbuf_add_field_{TYPE} + + subroutine pbuf_register_subcol(name, pname, index) + use subcol_utils, only: is_subcol_on + + ! Dummy Arguments + character(len=*), intent(in) :: name + character(len=*), intent(in) :: pname ! name of calling parameterization + integer, intent(out) :: index + + ! Local variables + integer :: dimsizes(1) + + ! You really should not call this routine if subcolumns are not on + if (.not. is_subcol_on()) then + call endrun('pbuf_register_subcol: subcolumns are not active') + end if + ! Create and pass dimsizes so that subcolums are registered + dimsizes(1) = pcols * psubcols + call pbuf_register_field_int(trim(name), trim(pname), index, & + dimsizes=dimsizes, col_type=col_type_subcol) + + end subroutine pbuf_register_subcol + + subroutine pbuf2d_print(pbuf2d) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + call pbuf1d_print(pbuf_get_chunk(pbuf2d,begchunk)) + + + end subroutine pbuf2d_print + + subroutine pbuf1d_print(pbuf) + type(physics_buffer_desc), pointer :: pbuf(:) + integer :: i + type(physics_buffer_desc), pointer :: pbufPtr + + print *,__FILE__,__LINE__,currentpbufflds,size(pbuf) + do i=1,currentpbufflds + pbufPtr => pbuf(i) + print *,__FILE__,__LINE__,i,trim(pbufPtr%hdr%name),pbufPtr%hdr%dtype,pbufPtr%hdr%persistence,pbufPtr%hdr%dimsizes + end do + + end subroutine pbuf1d_print + ! + ! Given a pbuf field name return an integer index to the field. + ! This index can be used to retrieve the field and is much faster + ! than using the name in most cases + ! + + function pbuf_get_index(name, errcode) result(index) + character(len=*), intent(in) :: name + integer, intent(inout), optional :: errcode + integer :: index + integer :: i + type(physics_buffer_hdr), pointer :: bufptr + + + bufptr=>hdrbuffertop + index = -1 + do i=1,currentpbufflds + if(bufptr%name .eq. name) then + index=i + exit + end if + bufptr=>bufptr%nexthdr + end do + + if (present(errcode)) then + errcode = index + else if(index<0) then + call endrun('Attempt to find undefined name in pbuf '//trim(name)) + end if + + + end function pbuf_get_index + + !========================================================================================= + + ! + ! Given a pbuf2d chunk and an index return a pointer to a field chunk + ! + ! + + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine get_pbuf1d_field_by_index_{DIMS}d_{TYPE}(pbuf, index, field, start,kount, col_type, copy_if_needed, errcode) + + ! Get the data based on the col_type which is specified. If no col_type, then grid field is returned + use subcol_utils, only: subcol_field_copy + + type(physics_buffer_desc), pointer:: pbuf(:) + integer, intent(in) :: index + {VTYPE}, pointer :: field{DIMSTR} + integer, intent(in), optional :: start(:),kount(:) + integer, intent(in), optional :: col_type + logical, intent(in), optional :: copy_if_needed + integer, intent(out), optional :: errcode + + integer, pointer :: dimsizes(:) + {VTYPE}, pointer :: gfield{DIMSTR} + {VTYPE}, pointer :: sfield{DIMSTR} + integer :: col_type_use + integer, allocatable :: kount_grid(:) ! For use in copy_if_needed + logical :: subset + character(len=*), parameter :: subname='GET_PBUF1D_FIELD_BY_INDEX' + character(len=128) :: errmsg + + ! Copy the generic type to one compatable with the request + if((index < 1) .or. (index > size(pbuf))) then + write(errmsg, '(2a,i0,a)') subname,': index (',index,') out of range' + call endrun(errmsg) + end if + + ! Default col_type is grid columns + if (present(col_type)) then + col_type_use = col_type + else + col_type_use = col_type_grid + end if + + ! If there is an errcode, start with an OK status (zero) + if (present(errcode)) then + errcode = 0 + end if + + ! Check whether subset of data requested (default is false) + subset = .false. + if (present(start) .and. present(kount)) subset = .true. + + ! Check for ill-formed request + if ( (present(start) .and. .not. present(kount)) .or. & + (.not. present(start) .and. present(kount)) ) then + call endrun('pbuf_get_field: Both start and kount must be present for '//trim(pbuf(index)%hdr%name)) + end if + + ! See if we need to copy the grid field to subcolumns + if (present(copy_if_needed)) then + if (copy_if_needed) then + if (col_type_use == col_type_subcol) then + ! If a subcolumn field buffer does not exist, allocate one. + ! Even if start and kount are being passed, allocate and copy the + ! full grid field buffer so that a future access will succeed. + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_use))) then + dimsizes => pbuf(index)%hdr%dimsizes(:,col_type_use) + dimsizes(2:) = pbuf(index)%hdr%dimsizes(2:,col_type_grid) + dimsizes(1) = pcols * psubcols + select case(pbuf(index)%hdr%dtype) + case(TYPEDOUBLE) + call buffer_field_allocate(pbuf(index)%bfg(col_type_subcol), & + dimsizes, dtype_r8) + case(TYPEREAL) + call buffer_field_allocate(pbuf(index)%bfg(col_type_subcol), & + dimsizes, dtype_r4) + case(TYPEINT) + call buffer_field_allocate(pbuf(index)%bfg(col_type_subcol), & + dimsizes, dtype_i4) + end select + ! Set copy only if we did the allocation after init time + pbuf(index)%hdr%is_copy(col_type_subcol) = .true. + end if + else + call endrun('pbuf_get_field: copy_if_needed only supported for subcolumns') + end if + if (pbuf(index)%hdr%is_copy(col_type_subcol)) then + ! Only do the copy if we did the alloc (i.e., set the is_copy flag) + ! Only copy the portion we are going to hand back (i.e., start, kount) + ! Chances are that kount(1) = pcols*psubcols because we are looking + ! for a subcolumn field (or we wouldn't be here). Now, + ! subcol_field_copy requires kount(1) = pcols for the input and + ! therefore, kount(1) = pcols*psubcols for the output. Check and + ! make it work + + if (subset) then + + ! Create kount array for grid field + ! Use input subcol kount array, replacing the first dimension with pcols + if (size(kount) > size(pbuf(index)%hdr%dimsizes(:,col_type_subcol))) then + call endrun('pbuf_get_field: kount input has too many dimensions') + end if + if (kount(1) /= pcols * psubcols) then + call endrun('pbuf_get_field: kount(1) must be pcols*psubcols when using copy_if_needed=.true.') + endif + + allocate(kount_grid(size(kount))) + kount_grid(2:) = kount(2:) + kount_grid(1) = pcols + + ! Don't need to create start array for grid field as start array for subcolumn field is identical + if (size(start) > size(pbuf(index)%hdr%dimsizes(:,col_type_subcol))) then + call endrun('pbuf_get_field: start input has too many dimensions') + end if + if (start(1) /= 1) then + call endrun('pbuf_get_field: start(1) must be 1 when using copy_if_needed=.true.') + end if + + ! Get the grid field + call buffer_get_field_ptr(pbuf(index)%bfg(col_type_grid), & + gfield, start, kount_grid) + + deallocate(kount_grid) + + else + ! Get the grid field + call buffer_get_field_ptr(pbuf(index)%bfg(col_type_grid), & + gfield) + end if + + ! Get the subcol field pointer (note optional start/kount retain their status in this call) + call buffer_get_field_ptr(pbuf(index)%bfg(col_type_subcol), & + sfield, start, kount) + + call subcol_field_copy(gfield, pbuf(index)%lchnk, sfield) + + end if + end if + end if + + ! Copy or not, retrieve the requested field pointer + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_use))) then + if (present(errcode)) then + errcode = -1 + else + if (col_type_use == col_type_grid) then + call endrun('pbuf_get_field: probably missing a pbuf_add_field call. field not allocated for '& + //trim(pbuf(index)%hdr%name)) + else if (col_type_use == col_type_subcol) then + call endrun('pbuf_get_field: probably missing a pbuf_register_subcol. field not allocated for '& + //trim(pbuf(index)%hdr%name)) + else + call endrun('pbuf_get_field: field not allocated for '//trim(pbuf(index)%hdr%name)) + end if + end if + else + ! Get the field pointer (note optional start/kount retain their status in this call) + call buffer_get_field_ptr(pbuf(index)%bfg(col_type_use),field,start,kount ) + end if + + end subroutine get_pbuf1d_field_by_index_{DIMS}d_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine get_pbuf2d_field_by_index_{DIMS}d_{TYPE}(pbuf2d, lchnk, index, field, start, kount, col_type, errcode) + + ! Get the data based on the col_type which is specified. If no col_type, then grid field is returned + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: lchnk + integer, intent(in) :: index + integer, intent(in), optional :: start(:),kount(:) + integer, intent(in), optional :: col_type + integer, intent(out), optional :: errcode + + {VTYPE}, pointer :: field{DIMSTR} + + ! Check for ill-formed request + if ( (present(start) .and. .not. present(kount)) .or.& + (.not. present(start) .and. present(kount)) ) then + call endrun('pbuf_get_field: Both start and kount must be present for '//trim(pbuf2d(index,begchunk)%hdr%name)) + end if + + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), index, field, & + start=start, kount=kount, col_type=col_type, errcode=errcode) + end subroutine get_pbuf2d_field_by_index_{DIMS}d_{TYPE} + + ! TYPE int,double,real + subroutine get_pbuf2d_field_restart_{TYPE}(pbuf2d, lchnk, index, field, mdimsize, col_type) + use subcol_pack_mod, only: subcol_unpack + + ! NB: This routine is really only useful for write_restart_field + ! Get the data based on the col_type which is specified. + ! If no col_type, then grid field is assumed + ! For grid field, reference buffer and copy into chunk (field) + ! If col_type is a subcol, unpack subcolumn data + ! Field is then reshaped into (/pcols, psubcols*mdims/). + + ! Dummy variables + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: lchnk + integer, intent(in) :: index + integer, intent(in) :: mdimsize + integer, intent(in) :: col_type + {VTYPE}, intent(inout) :: field(:,:) + + ! Local variables + {VTYPE}, allocatable :: exp_fld(:,:,:,:,:,:) + {VTYPE}, pointer :: buf(:,:,:,:,:) + {VTYPE} :: fillvalue + character(len=128) :: errmsg + integer, pointer :: dimsizes(:) + +#if ({ITYPE}==TYPEREAL) + fillvalue = 0._r4 +#elif ({ITYPE}==TYPEDOUBLE) + fillvalue = 0._r8 +#else + fillvalue = 0 +#endif + + if (col_type == col_type_grid) then + call pbuf_get_field(pbuf2d, lchnk, index, buf, col_type=col_type) + field(:,:) = reshape(buf, (/pcols, mdimsize/)) + else if (col_type == col_type_subcol) then + ! Don't initialize field, unpack will fill in unused slots + call pbuf_get_field(pbuf2d, lchnk, index, buf, col_type=col_type) + dimsizes => pbuf2d(index, lchnk)%hdr%dimsizes(:,col_type_subcol) + allocate(exp_fld(pcols, psubcols, dimsizes(2), dimsizes(3), dimsizes(4), dimsizes(5))) + ! unpack the subcolumns into their own dimension + call subcol_unpack(lchnk, buf, exp_fld, fillvalue) + ! Reshape back to pcols for outputting + field(:,:) = reshape(exp_fld, (/pcols, mdimsize/)) + deallocate(exp_fld) + else + write(errmsg, *) "get_pbuf2d_field_restart_{TYPE}: Bad col_type:",col_type + call endrun(errmsg) + end if + end subroutine get_pbuf2d_field_restart_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine set_pbuf2d_field_const_by_index_{TYPE}(pbuf2d,index,const, col_type) + + ! Set the field specified by the col_type + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: index + {VTYPE},intent(in) :: const + integer,intent(in) ,optional :: col_type + + integer :: c + + do c=begchunk,endchunk + if(present(col_type)) then + call set_pbuf1d_field_const_by_index_{TYPE}(pbuf_get_chunk(pbuf2d,c),index,const, col_type=col_type) + else + call set_pbuf1d_field_const_by_index_{TYPE}(pbuf_get_chunk(pbuf2d,c),index,const) + end if + end do + + end subroutine set_pbuf2d_field_const_by_index_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine set_pbuf1d_field_const_by_index_{TYPE}(pbuf,index,const,start,kount, col_type) + + ! Set the field(s) specified by the col_type + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: index + {VTYPE},intent(in) :: const + integer, intent(in), optional :: start(:),kount(:) + integer, intent(in), optional :: col_type + + integer :: col_type_use + logical :: subset + + ! Default col_type is grid + if (present(col_type)) then + col_type_use = col_type + else + col_type_use = col_type_grid + end if + + ! Check whether subset of data requested (default is false) + subset = .false. + if (present(start) .and. present(kount)) subset = .true. + + ! Check for ill-formed request + if ( (present(start) .and. .not. present(kount)) .or.& + (.not. present(start) .and. present(kount)) ) then + call endrun('pbuf_set_field: Both start and kount must be present for '//trim(pbuf(index)%hdr%name)) + end if + + ! Set the appropriate grid or sub-column field. Check that the fields have been allocated. + if(subset) then + + if (col_type_use == col_type_subcol) then + ! Set sub-column field + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_subcol))) & + call endrun('pbuf_set_field: sub-column field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_subcol),const,start,kount) + + else if (col_type_use == col_type_grid) then + ! Set grid field + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_grid))) & + call endrun('pbuf_set_field: grid field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_grid),const,start,kount) + else + call endrun('pbuf_set_field: Trying to set '//trim(pbuf(index)%hdr%name)//& + ' but col_type is neither col_type_grid nor col_type_subcol') + end if + + else + + if (col_type_use == col_type_subcol) then + ! Set sub-column field + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_subcol))) & + call endrun('pbuf_set_field: sub-column field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_subcol),const) + + else if (col_type_use == col_type_grid) then + ! Set grid field + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_grid))) & + call endrun('pbuf_set_field: grid field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_grid),const) + else + call endrun('pbuf_set_field: Trying to set '//trim(pbuf(index)%hdr%name)//& + ' but col_type is neither col_type_grid nor col_type_subcol') + end if + + end if + + end subroutine set_pbuf1d_field_const_by_index_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine set_pbuf2d_field_by_index_{DIMS}d_{TYPE}(pbuf2d,index,field, start, kount, col_type) + + ! Set the field(s) specified by the col_type + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: index + integer,intent(in),optional :: start(:), kount(:) + integer,intent(in),optional :: col_type + + logical :: subset + + integer :: c + {VTYPE}, pointer :: fld{DIMSTR} + + +#if ({DIMS}==1) + {VTYPE},pointer :: field(:,:) +#elif ({DIMS}==2) + {VTYPE},pointer :: field(:,:,:) +#elif ({DIMS}==3) + {VTYPE},pointer :: field(:,:,:,:) +#elif ({DIMS}==4) + {VTYPE},pointer :: field(:,:,:,:,:) +#elif ({DIMS}==5) + {VTYPE},pointer :: field(:,:,:,:,:,:) +#endif + + ! Check whether subset of data requested (default is false) + subset = .false. + if (present(start) .and. present(kount)) subset = .true. + + ! Check for ill-formed request + if ( (present(start) .and. .not. present(kount)) .or.& + (.not. present(start) .and. present(kount)) ) then + call endrun('pbuf_set_field: Both start and kount must be present for '//trim(pbuf2d(index,begchunk)%hdr%name)) + end if + + do c=begchunk,endchunk + fld => get_field_chunk_{DIMS}d_{TYPE}(field,c) + if(subset .and. present(col_type)) then + call pbuf_set_field(pbuf_get_chunk(pbuf2d,c),index,fld,start,kount, col_type) + else if(subset) then + call pbuf_set_field(pbuf_get_chunk(pbuf2d,c),index,fld,start,kount) + else if(present(col_type)) then + call pbuf_set_field(pbuf_get_chunk(pbuf2d,c),index,fld,col_type=col_type) + else + call pbuf_set_field(pbuf_get_chunk(pbuf2d,c),index,fld) + end if + end do + end subroutine set_pbuf2d_field_by_index_{DIMS}d_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + function get_field_chunk_{DIMS}d_{TYPE}(field, c) result(fld) + ! module private helper function + {VTYPE}, pointer :: fld{DIMSTR} + integer, intent(in) :: c + +#if ({DIMS}==1) + {VTYPE},pointer :: field(:,:) + fld => field(:,c) +#elif ({DIMS}==2) + {VTYPE},pointer :: field(:,:,:) + fld => field(:,:,c) +#elif ({DIMS}==3) + {VTYPE},pointer :: field(:,:,:,:) + fld => field(:,:,:,c) +#elif ({DIMS}==4) + {VTYPE},pointer :: field(:,:,:,:,:) + fld => field(:,:,:,:,c) +#elif ({DIMS}==5) + {VTYPE},pointer :: field(:,:,:,:,:,:) + fld => field(:,:,:,:,:,c) +#endif + + end function get_field_chunk_{DIMS}d_{TYPE} + + + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine set_pbuf1d_field_by_index_{DIMS}d_{TYPE}(pbuf,index,field, start, kount, col_type) + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: index + {VTYPE}, intent(in) :: field{DIMSTR} + integer,intent(in),optional :: start(:), kount(:) + integer,intent(in),optional :: col_type + + integer :: col_type_use + logical :: subset + + ! Default col_type is grid only + if (present(col_type)) then + col_type_use = col_type + else + col_type_use = col_type_grid + end if + + ! Check whether subset of data requested (default is false) + subset = .false. + if (present(start) .and. present(kount)) subset = .true. + + ! Check for ill-formed request + if ( (present(start) .and. .not. present(kount)) .or.& + (.not. present(start) .and. present(kount)) ) then + call endrun('pbuf_set_field: Both start and kount must be present for '//trim(pbuf(index)%hdr%name)) + end if + + if(subset) then + + ! Set sub-column field + if (col_type_use == col_type_subcol) then + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_subcol))) & + call endrun('pbuf_set_field: sub-column field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_subcol),field,start,kount) + + ! Set grid field + else if (col_type_use == col_type_grid) then + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_grid))) & + call endrun('pbuf_set_field: grid field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_grid),field,start,kount) + else + call endrun('pbuf_set_field: Trying to set '//trim(pbuf(index)%hdr%name)//& + ' but col_type is neigher col_type_grid nor col_type_subcol ') + end if + else + + ! Set sub-column field + if (col_type_use == col_type_subcol) then + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_subcol))) & + call endrun('pbuf_set_field: sub-column field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_subcol),field) + + ! Set grid field + else if (col_type_use == col_type_grid) then + if (.not. buffer_field_is_alloc(pbuf(index)%bfg(col_type_grid))) & + call endrun('pbuf_set_field: grid field not allocated for '//trim(pbuf(index)%hdr%name)) + call buffer_set_field(pbuf(index)%bfg(col_type_grid),field) + else + call endrun('pbuf_set_field: Trying to set '//trim(pbuf(index)%hdr%name)//& + ' but col_type is neither col_type_grid nor col_type_subcol ') + end if + endif + + end subroutine set_pbuf1d_field_by_index_{DIMS}d_{TYPE} + + + function pbuftype2piotype(pbuftype) result(piotype) + use pio, only : pio_double, pio_int, pio_real + + integer, intent(in) :: pbuftype + integer :: piotype + + select case(pbuftype) + case (TYPEDOUBLE) + piotype = pio_double + case(TYPEINT) + piotype = pio_int + case(TYPEREAL) + piotype = pio_real +! case(TYPELONG) +! piotype = pio_int + case default + write(iulog, *) 'Dtype = ', pbuftype + call endrun('No restart support for dtype') + end select + end function pbuftype2piotype + + +! +! Initialize a restart file to write - all additional dims in a field are +! bundled into a single dimension for output and a dim pbuf_xxxxx is declared +! in the file if it does not already exist. +! + subroutine pbuf_init_restart(File, pbuf2d) + use pio, only: file_desc_t, pio_int + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + use phys_grid, only: phys_decomp + use cam_grid_support, only: cam_grid_get_file_dimids, cam_grid_dimensions + + + ! Dummy Variables + type(file_desc_t), intent(inout) :: file + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Local Variables + type(physics_buffer_desc), pointer :: pbuf + integer :: i, grid_select + integer :: adimid(3) ! PIO IDs + integer :: hdimcnt ! # grid dims + integer :: dimcnt ! # array dims + integer :: mdimsize, piodtype + + character(len=10) :: dimname + character(len=24) :: varname + + ! Use adimid as a temp to find number of horizontal dims + call cam_grid_dimensions(phys_decomp, adimid(1:2), hdimcnt) + call cam_grid_get_file_dimids(phys_decomp, File, adimid) + + do i = 1, currentpbufflds + pbuf => pbuf2d(i,begchunk) + + ! Only save global pbufs for restart + if(pbuf%hdr%persistence /= persistence_global) cycle + + piodtype = pbuftype2piotype(pbuf%hdr%dtype) + + do grid_select = 1, ngrid_types + ! For subcol fields, mdimsize includes psubcols in size + mdimsize = product(pbuf%hdr%dimsizes(:,grid_select))/pcols + if(mdimsize > 1) then + write(dimname,'(a,i5.5)') 'pbuf_',mdimsize + call cam_pio_def_dim(File, dimname, mdimsize, adimid(hdimcnt+1), & + existOK=.true.) + dimcnt = hdimcnt + 1 + else + dimcnt = hdimcnt + end if + if (mdimsize > 0) then + varname = trim(pbuf%hdr%name)//trim(field_grid_suff(grid_select)) + call cam_pio_def_var(File, varname, piodtype, adimid(1:dimcnt), & + pbuf%hdr%vardesc(grid_select), existOK=.false.) + end if + end do + + end do + + call cam_pio_def_var(File, 'pbuf_time_idx', pio_int, timeidx_desc, & + existOK=.false.) + + end subroutine pbuf_init_restart + + + subroutine pbuf_write_restart(File, pbuf2d) + use pio, only: file_desc_t, pio_put_var + use cam_grid_support, only: cam_grid_dimensions + use phys_grid, only: phys_decomp + + ! Dummy Variables + type(file_desc_t), intent(inout) :: file + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Local Variables + type(physics_buffer_desc), pointer :: pbufhdr(:) + + integer :: index, dtype, ierr + integer :: gdimlens(2) + integer :: grank + + pbufhdr => pbuf_get_chunk(pbuf2d, begchunk) + gdimlens = 1 + call cam_grid_dimensions(phys_decomp, gdimlens(1:2), grank) + + do index = 1, currentpbufflds + if(pbufhdr(index)%hdr%persistence == persistence_global) then + dtype = pbufhdr(index)%hdr%dtype + select case(dtype) + case (TYPEDOUBLE) + call write_restart_field_double(File, pbuf2d, index, gdimlens, grank) + case (TYPEREAL) + call write_restart_field_real(File, pbuf2d, index, gdimlens, grank) + case (TYPEINT) + call write_restart_field_int(File, pbuf2d, index, gdimlens, grank) + end select + end if + end do + ierr = pio_put_var(File, timeidx_desc, (/old_time_idx/)) + + end subroutine pbuf_write_restart + + subroutine pbuf_restart_dimsizes(pbuf, gdimlens, grank, gridnum, adimlens, & + fdimlens, frank) + + ! Dummy arguments + type(physics_buffer_desc), pointer :: pbuf + integer, intent(in) :: gdimlens(2) ! Grid horiz. dim sizes + integer, intent(in) :: grank ! Array rank on file + integer, intent(in) :: gridnum ! pbuf grid selector + integer, intent(out) :: adimlens(3) ! Array dims + integer, intent(out) :: fdimlens(3) ! Array dims on file + integer, intent(out) :: frank ! array rank on file + + ! Local variable + integer :: mdimsize + + mdimsize = PRODUCT(pbuf%hdr%dimsizes(:,gridnum)) / pcols + fdimlens(1:2) = gdimlens + if (grank == 1) then + ! Unstructured grid + fdimlens(2) = mdimsize + fdimlens(3) = 1 + frank = 2 + else + fdimlens(3) = mdimsize + frank = 3 + end if + ! Restart does not write a dimension if mdimsize == 1 + if (mdimsize == 1) then + frank = frank - 1 + end if + + adimlens(1) = pcols + adimlens(2) = mdimsize + adimlens(3) = endchunk - begchunk + 1 + + end subroutine pbuf_restart_dimsizes + + ! TYPE int,double,real + subroutine write_restart_field_{TYPE}(File, pbuf2d, index, gdimlens, grank) + use cam_grid_support, only: cam_grid_write_dist_array + use phys_grid, only: phys_decomp + use pio, only: file_desc_t + + ! Dummy Variables + type(file_desc_t), intent(inout) :: File + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: index + integer, intent(in) :: gdimlens(2) + integer, intent(in) :: grank + + ! Local Variables + type(physics_buffer_desc), pointer :: pbuf + {VTYPE}, allocatable :: field(:,:,:) + + integer :: grid_select ! 1=grid, 2=subcol + integer :: c ! Chunk index + integer :: fdimlens(3) ! Array dimensions on NetCDF file + integer :: adimlens(3) ! Array dimensions + integer :: frank + + pbuf => pbuf2d(index, begchunk) + + do grid_select = 1, ngrid_types + call pbuf_restart_dimsizes(pbuf, gdimlens, grank, grid_select, & + adimlens, fdimlens, frank) + if ((PRODUCT(adimlens) > 0) .and. (.not. pbuf%hdr%is_copy(grid_select))) then + allocate(field(adimlens(1), adimlens(2), begchunk:endchunk)) + do c = begchunk, endchunk + call pbuf_get_field_restart(pbuf2d, c, index, field(:,:,c), & + adimlens(2), grid_select) + end do + if (size(field,2) == 1) then + ! Special case for 2-D pbuf fields + adimlens(2) = adimlens(3) + call cam_grid_write_dist_array(File, phys_decomp, adimlens(1:2), & + fdimlens(1:frank), field(:,1,:), pbuf%hdr%vardesc(grid_select)) + else + call cam_grid_write_dist_array(File, phys_decomp, adimlens, & + fdimlens(1:frank), field, pbuf%hdr%vardesc(grid_select)) + end if + deallocate(field) + end if + end do + + end subroutine write_restart_field_{TYPE} + + + subroutine pbuf_read_restart(File, pbuf2d) + use cam_grid_support, only: cam_grid_dimensions + use phys_grid, only: phys_decomp + use pio, only: file_desc_t, pio_inq_varid, pio_get_var + + ! Dummy Variables + type(File_desc_t), intent(inout) :: File + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Local Variables + type(physics_buffer_desc), pointer :: pbufhdr(:) + + integer :: index, dtype, ierr + integer :: gdimlens(2) ! Horizontal grid dimensions + integer :: grank + + call pbuf_initialize(pbuf2d) + + pbufhdr => pbuf_get_chunk(pbuf2d, begchunk) + + gdimlens = 1 + call cam_grid_dimensions(phys_decomp, gdimlens(1:2), grank) + ierr = pio_inq_varid(File, 'pbuf_time_idx', timeidx_desc) + ierr = pio_get_var(File, timeidx_desc, old_time_idx) + + do index = 1, currentpbufflds + if(pbufhdr(index)%hdr%persistence == persistence_global) then + dtype = pbufhdr(index)%hdr%dtype + select case(dtype) + case (TYPEDOUBLE) + call read_restart_field_double(File, pbuf2d, index, gdimlens, grank) + case (TYPEREAL) + call read_restart_field_real(File, pbuf2d, index, gdimlens, grank) + case (TYPEINT) + call read_restart_field_int(File, pbuf2d, index, gdimlens, grank) + end select + end if + end do + + end subroutine pbuf_read_restart + + ! TYPE int,double,real + subroutine read_restart_field_{TYPE} (File, pbuf2d, index, gdimlens, grank) + use pio, only: file_desc_t + use pio, only: pio_inq_varid + use cam_pio_utils, only: cam_pio_handle_error + use cam_grid_support, only: cam_grid_read_dist_array + use subcol_pack_mod, only: subcol_pack + use phys_grid, only: phys_decomp + + ! Dummy Variables + type(file_desc_t), intent(inout) :: File + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: index + integer, intent(in) :: gdimlens(2) + integer, intent(in) :: grank + + ! Local Variables + type(physics_buffer_desc), pointer :: pbuf + {VTYPE}, pointer :: fld6(:,:,:,:,:,:) + {VTYPE}, allocatable :: fld5_pack(:,:,:,:,:) + {VTYPE}, allocatable :: field(:,:,:) + + integer :: grid_select ! (1=grid, 2=subcol) + integer :: ierr, c + integer :: start(6) + integer :: dimsizes(6) + integer :: fdimlens(3) ! Array dimensions on NetCDF file + integer :: frank ! Array rank on file + integer :: adimlens(3) ! Array dimensions + + character(len=24) :: varname + character(len=*), parameter :: subname = 'read_restart_field_{TYPE}' + + pbuf => pbuf2d(index, begchunk) + start = 1 + + do grid_select = 1, ngrid_types + + dimsizes(:) = pbuf%hdr%dimsizes(:, grid_select) + if(all(dimsizes(:) == 0)) then + ! None of this grid type for this variable + cycle + end if + + call pbuf_restart_dimsizes(pbuf, gdimlens, grank, grid_select, & + adimlens, fdimlens, frank) + ! Fix up dimensions for subcolumn field + if (grid_select == col_type_subcol) then + ! Field stored as (pcols, psubcols*restDims, chunks) + ! Read then pack to (pcols*psubcols,restDims, chunks) + allocate(fld5_pack(dimsizes(1),dimsizes(2),dimsizes(3),dimsizes(4),dimsizes(5))) + do c = 5, 2, -1 + dimsizes(c + 1) = dimsizes(c) + end do + dimsizes(1) = pcols + dimsizes(2) = psubcols + end if + + varname = trim(pbuf%hdr%name)//trim(field_grid_suff(grid_select)) + ierr = pio_inq_varid(File, varname, pbuf%hdr%vardesc(grid_select)) + call cam_pio_handle_error(ierr, trim(subname)//': '//trim(varname)//' not found') + + allocate(field(adimlens(1), adimlens(2), begchunk:endchunk)) + if (size(field,2) == 1) then + ! Special case for 2-D pbuf fields + adimlens(2) = adimlens(3) + call cam_grid_read_dist_array(File, phys_decomp, adimlens(1:2), & + fdimlens(1:frank), field(:,1,:), pbuf%hdr%vardesc(grid_select)) + else + call cam_grid_read_dist_array(File, phys_decomp, adimlens, & + fdimlens(1:frank), field, pbuf%hdr%vardesc(grid_select)) + end if + + do c = begchunk, endchunk + if (grid_select == col_type_grid) then + call buffer_get_field_ptr(pbuf2d(index,c)%bfg(grid_select), fld6, & + start, dimsizes) + fld6 = reshape(field(:,:,c), dimsizes) + else if (grid_select == col_type_subcol) then + call subcol_pack(c, reshape(field(:,:,c), dimsizes), fld5_pack) + call buffer_set_field(pbuf2d(index,c)%bfg(grid_select), fld5_pack) + else + call endrun('read_restart_field_{TYPE}: invalid grid selector - must be either 1 or 2') + end if + end do + nullify(fld6) + deallocate(field) + if (allocated(fld5_pack)) then + deallocate(fld5_pack) + end if + end do + + end subroutine read_restart_field_{TYPE} + + subroutine pbuf_dump_pbuf(pbuf2d, name, num) + use cam_pio_utils, only: cam_pio_dump_field + use spmd_utils, only: masterproc + + ! Dummy arguments + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + character(len=*), optional, intent(in) :: name + integer, optional, intent(in) :: num + + ! Local variables + integer, parameter :: max_name = 64 + character(len=max_name) :: field_name + integer :: index, grid_select, c + integer :: namelen + integer :: dimstart(6), dimend(6) + integer :: ierr + integer :: dtype + type(physics_buffer_desc), pointer :: pbufhdr(:) + real(r8), allocatable :: field(:,:,:,:,:,:) + real(r8), pointer :: fld5(:,:,:,:,:) + + pbufhdr => pbuf_get_chunk(pbuf2d, begchunk) + dimstart = 1 + + do index = 1, currentpbufflds + dtype = pbufhdr(index)%hdr%dtype + do grid_select = 1, ngrid_types + namelen = len_trim(pbufhdr(index)%hdr%name) + namelen = namelen + len_trim(field_grid_suff(grid_select)) + if (present(name)) then + namelen = namelen + len_trim(name) + end if + if (present(num)) then + namelen = namelen + int(log10(real(num))) + 2 + end if + if (namelen > 64) then + call endrun("PBUF_DUMP_PBUF: Name string too long") + end if + if (present(name)) then + if (present(num)) then + write(field_name, '(4a,i0)') trim(pbufhdr(index)%hdr%name), & + trim(field_grid_suff(grid_select)), trim(name), '_', num + else + write(field_name, '(3a)') trim(pbufhdr(index)%hdr%name), & + trim(field_grid_suff(grid_select)), trim(name) + end if + else if (present(num)) then + write(field_name, '(3a,i0)') trim(pbufhdr(index)%hdr%name), & + trim(field_grid_suff(grid_select)), '_', num + else + write(field_name, '(2a)') trim(pbufhdr(index)%hdr%name), & + trim(field_grid_suff(grid_select)) + end if + dimend = pbufhdr(index)%hdr%dimsizes(:, grid_select) + if (PRODUCT(dimend) > 0) then + if (dimend(6) /= 1) then + if (masterproc) then + write(iulog, *) 'PBUF_DUMP_PBUF: ', trim(field_name), dimend + end if + call endrun("PBUF_DUMP_PBUF: No support for 6D pbuf field") + end if + dimend(6) = endchunk - begchunk + 1 + select case(dtype) + case (TYPEDOUBLE) + allocate(field(dimend(1), dimend(2), dimend(3), dimend(4), & + dimend(5), dimend(6))) + do c = begchunk, endchunk + call pbuf_get_field(pbuf2d, c, index, fld5, & + col_type=grid_select, errcode=ierr) + field(:,:,:,:,:,c-begchunk+1) = fld5(:,:,:,:,:) + end do + call cam_pio_dump_field(field_name, dimstart, dimend, & + field, compute_maxdim_in=.false.) + deallocate(field) + case (TYPEREAL) + if (masterproc) then + write(iulog, *) 'PBUF_DUMP_PBUF: No support for real fields' + end if + case (TYPEINT) + if (masterproc) then + write(iulog, *) 'PBUF_DUMP_PBUF: No support for integer fields' + end if + end select + end if + end do + end do + end subroutine pbuf_dump_pbuf + +end module physics_buffer diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 new file mode 100644 index 0000000000..f08911ad50 --- /dev/null +++ b/src/physics/cam/physics_types.F90 @@ -0,0 +1,1943 @@ +!------------------------------------------------------------------------------- +!physics data types module +!------------------------------------------------------------------------------- +module physics_types + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, psubcols + use constituents, only: pcnst, qmin, cnst_name + use geopotential, only: geopotential_dse, geopotential_t + use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv + use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use phys_control, only: waccmx_is + use shr_const_mod, only: shr_const_rwv + + implicit none + private ! Make default type private to the module + + logical, parameter :: adjust_te = .FALSE. + +! Public types: + + public physics_state + public physics_tend + public physics_ptend + +! Public interfaces + + public physics_update + public physics_state_check ! Check state object for invalid data. + public physics_ptend_reset + public physics_ptend_init + public physics_state_set_grid + public physics_dme_adjust ! adjust dry mass and energy for change in water + ! cannot be applied to eul or sld dycores + public physics_state_copy ! copy a physics_state object + public physics_ptend_copy ! copy a physics_ptend object + public physics_ptend_sum ! accumulate physics_ptend objects + public physics_ptend_scale ! Multiply physics_ptend objects by a constant factor. + public physics_tend_init ! initialize a physics_tend object + + public set_state_pdry ! calculate dry air masses in state variable + public set_wet_to_dry + public set_dry_to_wet + public physics_type_alloc + + public physics_state_alloc ! allocate individual components within state + public physics_state_dealloc ! deallocate individual components within state + public physics_tend_alloc ! allocate individual components within tend + public physics_tend_dealloc ! deallocate individual components within tend + public physics_ptend_alloc ! allocate individual components within tend + public physics_ptend_dealloc ! deallocate individual components within tend + +!------------------------------------------------------------------------------- + type physics_state + integer :: & + lchnk, &! chunk index + ngrdcol, &! -- Grid -- number of active columns (on the grid) + psetcols=0, &! -- -- max number of columns set - if subcols = pcols*psubcols, else = pcols + ncol=0 ! -- -- sum of nsubcol for all ngrdcols - number of active columns + real(r8), dimension(:), allocatable :: & + lat, &! latitude (radians) + lon, &! longitude (radians) + ps, &! surface pressure + psdry, &! dry surface pressure + phis, &! surface geopotential + ulat, &! unique latitudes (radians) + ulon ! unique longitudes (radians) + real(r8), dimension(:,:),allocatable :: & + t, &! temperature (K) + u, &! zonal wind (m/s) + v, &! meridional wind (m/s) + s, &! dry static energy + omega, &! vertical pressure velocity (Pa/s) + pmid, &! midpoint pressure (Pa) + pmiddry, &! midpoint pressure dry (Pa) + pdel, &! layer thickness (Pa) + pdeldry, &! layer thickness dry (Pa) + rpdel, &! reciprocal of layer thickness (Pa) + rpdeldry,&! recipricol layer thickness dry (Pa) + lnpmid, &! ln(pmid) + lnpmiddry,&! log midpoint pressure dry (Pa) + exner, &! inverse exner function w.r.t. surface pressure (ps/p)^(R/cp) + zm ! geopotential height above surface at midpoints (m) + + real(r8), dimension(:,:,:),allocatable :: & + q ! constituent mixing ratio (kg/kg moist or dry air depending on type) + + real(r8), dimension(:,:),allocatable :: & + pint, &! interface pressure (Pa) + pintdry, &! interface pressure dry (Pa) + lnpint, &! ln(pint) + lnpintdry,&! log interface pressure dry (Pa) + zi ! geopotential height above surface at interfaces (m) + + real(r8), dimension(:),allocatable :: & + te_ini, &! vertically integrated total (kinetic + static) energy of initial state + te_cur, &! vertically integrated total (kinetic + static) energy of current state + tw_ini, &! vertically integrated total water of initial state + tw_cur ! vertically integrated total water of new state + integer :: count ! count of values with significant energy or water imbalances + integer, dimension(:),allocatable :: & + latmapback, &! map from column to unique lat for that column + lonmapback, &! map from column to unique lon for that column + cid ! unique column id + integer :: ulatcnt, &! number of unique lats in chunk + uloncnt ! number of unique lons in chunk + + end type physics_state + +!------------------------------------------------------------------------------- + type physics_tend + + integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols + + real(r8), dimension(:,:),allocatable :: dtdt, dudt, dvdt + real(r8), dimension(:), allocatable :: flx_net + real(r8), dimension(:), allocatable :: & + te_tnd, &! cumulative boundary flux of total energy + tw_tnd ! cumulative boundary flux of total water + end type physics_tend + +!------------------------------------------------------------------------------- +! This is for tendencies returned from individual parameterizations + type physics_ptend + + integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols + + character*24 :: name ! name of parameterization which produced tendencies. + + logical :: & + ls = .false., &! true if dsdt is returned + lu = .false., &! true if dudt is returned + lv = .false. ! true if dvdt is returned + + logical,dimension(pcnst) :: lq = .false. ! true if dqdt() is returned + + integer :: & + top_level, &! top level index for which nonzero tendencies have been set + bot_level ! bottom level index for which nonzero tendencies have been set + + real(r8), dimension(:,:),allocatable :: & + s, &! heating rate (J/kg/s) + u, &! u momentum tendency (m/s/s) + v ! v momentum tendency (m/s/s) + real(r8), dimension(:,:,:),allocatable :: & + q ! consituent tendencies (kg/kg/s) + +! boundary fluxes + real(r8), dimension(:),allocatable ::& + hflux_srf, &! net heat flux at surface (W/m2) + hflux_top, &! net heat flux at top of model (W/m2) + taux_srf, &! net zonal stress at surface (Pa) + taux_top, &! net zonal stress at top of model (Pa) + tauy_srf, &! net meridional stress at surface (Pa) + tauy_top ! net meridional stress at top of model (Pa) + real(r8), dimension(:,:),allocatable ::& + cflx_srf, &! constituent flux at surface (kg/m2/s) + cflx_top ! constituent flux top of model (kg/m2/s) + + end type physics_ptend + + +!=============================================================================== +contains +!=============================================================================== + subroutine physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, psetcols) + implicit none + type(physics_state), pointer :: phys_state(:) + type(physics_tend), pointer :: phys_tend(:) + integer, intent(in) :: begchunk, endchunk + integer, intent(in) :: psetcols + + integer :: ierr=0, lchnk + type(physics_state), pointer :: state + type(physics_tend), pointer :: tend + + allocate(phys_state(begchunk:endchunk), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'physics_types: phys_state allocation error = ',ierr + call endrun('physics_types: failed to allocate physics_state array') + end if + + do lchnk=begchunk,endchunk + call physics_state_alloc(phys_state(lchnk),lchnk,pcols) + end do + + allocate(phys_tend(begchunk:endchunk), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'physics_types: phys_tend allocation error = ',ierr + call endrun('physics_types: failed to allocate physics_tend array') + end if + + do lchnk=begchunk,endchunk + call physics_tend_alloc(phys_tend(lchnk),phys_state(lchnk)%psetcols) + end do + + end subroutine physics_type_alloc +!=============================================================================== + subroutine physics_update(state, ptend, dt, tend) +!----------------------------------------------------------------------- +! Update the state and or tendency structure with the parameterization tendencies +!----------------------------------------------------------------------- + use shr_sys_mod, only: shr_sys_flush + use constituents, only: cnst_get_ind, cnst_mw + use scamMod, only: scm_crm_mode, single_column + use phys_control, only: phys_getopts + use physconst, only: physconst_update ! Routine which updates physconst variables (WACCM-X) + use ppgrid, only: begchunk, endchunk + use qneg_module, only: qneg3 + +!------------------------------Arguments-------------------------------- + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies + + type(physics_state), intent(inout) :: state ! Physics state variables + + real(r8), intent(in) :: dt ! time step + + type(physics_tend ), intent(inout), optional :: tend ! Physics tendencies over timestep + ! This is usually only needed by calls from physpkg. +! +!---------------------------Local storage------------------------------- + integer :: i,k,m ! column,level,constituent indices + integer :: ixcldice, ixcldliq ! indices for CLDICE and CLDLIQ + integer :: ixnumice, ixnumliq + integer :: ixnumsnow, ixnumrain + integer :: ncol ! number of columns + integer :: ixh, ixh2 ! constituent indices for H, H2 + + real(r8) :: zvirv(state%psetcols,pver) ! Local zvir array pointer + + real(r8),allocatable :: cpairv_loc(:,:,:) + real(r8),allocatable :: rairv_loc(:,:,:) + + ! PERGRO limits cldliq/ice for macro/microphysics: + character(len=24), parameter :: pergro_cldlim_names(4) = & + (/ "stratiform", "cldwat ", "micro_mg ", "macro_park" /) + + ! cldliq/ice limits that are always on. + character(len=24), parameter :: cldlim_names(2) = & + (/ "convect_deep", "zm_conv_tend" /) + + ! Whether to do validation of state on each call. + logical :: state_debug_checks + + !----------------------------------------------------------------------- + + ! The column radiation model does not update the state + if(single_column.and.scm_crm_mode) return + + + !----------------------------------------------------------------------- + ! If no fields are set, then return + if (.not. (any(ptend%lq(:)) .or. ptend%ls .or. ptend%lu .or. ptend%lv)) then + ptend%name = "none" + ptend%psetcols = 0 + return + end if + + !----------------------------------------------------------------------- + ! Check that the state/tend/ptend are all dimensioned with the same number of columns + if (state%psetcols /= ptend%psetcols) then + call endrun('ERROR in physics_update with ptend%name='//trim(ptend%name) & + //': state and ptend must have the same number of psetcols.') + end if + + if (present(tend)) then + if (state%psetcols /= tend%psetcols) then + call endrun('ERROR in physics_update with ptend%name='//trim(ptend%name) & + //': state and tend must have the same number of psetcols.') + end if + end if + + !----------------------------------------------------------------------- + ! cpairv_loc and rairv_loc need to be allocated to a size which matches state and ptend + ! If psetcols == pcols, the cpairv is the correct size and just copy + ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair + if (state%psetcols == pcols) then + allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpairv(:,:,:) + else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then + allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpair + else + call endrun('physics_update: cpairv is not allowed to vary when subcolumns are turned on') + end if + if (state%psetcols == pcols) then + allocate (rairv_loc(state%psetcols,pver,begchunk:endchunk)) + rairv_loc(:,:,:) = rairv(:,:,:) + else if (state%psetcols > pcols .and. all(rairv(:,:,:) == rair)) then + allocate(rairv_loc(state%psetcols,pver,begchunk:endchunk)) + rairv_loc(:,:,:) = rair + else + call endrun('physics_update: rairv_loc is not allowed to vary when subcolumns are turned on') + end if + + !----------------------------------------------------------------------- + call phys_getopts(state_debug_checks_out=state_debug_checks) + + ncol = state%ncol + + ! Update u,v fields + if(ptend%lu) then + do k = ptend%top_level, ptend%bot_level + state%u (:ncol,k) = state%u (:ncol,k) + ptend%u(:ncol,k) * dt + if (present(tend)) & + tend%dudt(:ncol,k) = tend%dudt(:ncol,k) + ptend%u(:ncol,k) + end do + end if + + if(ptend%lv) then + do k = ptend%top_level, ptend%bot_level + state%v (:ncol,k) = state%v (:ncol,k) + ptend%v(:ncol,k) * dt + if (present(tend)) & + tend%dvdt(:ncol,k) = tend%dvdt(:ncol,k) + ptend%v(:ncol,k) + end do + end if + + ! Update constituents, all schemes use time split q: no tendency kept + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + ! Check for number concentration of cloud liquid and cloud ice (if not present + ! the indices will be set to -1) + call cnst_get_ind('NUMICE', ixnumice, abort=.false.) + call cnst_get_ind('NUMLIQ', ixnumliq, abort=.false.) + call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) + call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) + + do m = 1, pcnst + if(ptend%lq(m)) then + do k = ptend%top_level, ptend%bot_level + state%q(:ncol,k,m) = state%q(:ncol,k,m) + ptend%q(:ncol,k,m) * dt + end do + + ! now test for mixing ratios which are too small + ! don't call qneg3 for number concentration variables + if (m /= ixnumice .and. m /= ixnumliq .and. & + m /= ixnumrain .and. m /= ixnumsnow ) then + call qneg3(trim(ptend%name), state%lchnk, ncol, state%psetcols, pver, m, m, qmin(m:m), state%q(:,1:pver,m:m)) + else + do k = ptend%top_level, ptend%bot_level + ! checks for number concentration + state%q(:ncol,k,m) = max(1.e-12_r8,state%q(:ncol,k,m)) + state%q(:ncol,k,m) = min(1.e10_r8,state%q(:ncol,k,m)) + end do + end if + + end if + + end do + + !------------------------------------------------------------------------ + ! This is a temporary fix for the large H, H2 in WACCM-X + ! Well, it was supposed to be temporary, but it has been here + ! for a while now. + !------------------------------------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call cnst_get_ind('H', ixh) + do k = ptend%top_level, ptend%bot_level + state%q(:ncol,k,ixh) = min(state%q(:ncol,k,ixh), 0.01_r8) + end do + + call cnst_get_ind('H2', ixh2) + do k = ptend%top_level, ptend%bot_level + state%q(:ncol,k,ixh2) = min(state%q(:ncol,k,ixh2), 6.e-5_r8) + end do + endif + + ! Special tests for cloud liquid and ice: + ! Enforce a minimum non-zero value. + if (ixcldliq > 1) then + if(ptend%lq(ixcldliq)) then +#ifdef PERGRO + if ( any(ptend%name == pergro_cldlim_names) ) & + call state_cnst_min_nz(1.e-12_r8, ixcldliq, ixnumliq) +#endif + if ( any(ptend%name == cldlim_names) ) & + call state_cnst_min_nz(1.e-36_r8, ixcldliq, ixnumliq) + end if + end if + + if (ixcldice > 1) then + if(ptend%lq(ixcldice)) then +#ifdef PERGRO + if ( any(ptend%name == pergro_cldlim_names) ) & + call state_cnst_min_nz(1.e-12_r8, ixcldice, ixnumice) +#endif + if ( any(ptend%name == cldlim_names) ) & + call state_cnst_min_nz(1.e-36_r8, ixcldice, ixnumice) + end if + end if + + !------------------------------------------------------------------------ + ! Get indices for molecular weights and call WACCM-X physconst_update + !------------------------------------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call physconst_update(state%q, state%t, state%lchnk, ncol) + endif + + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + zvirv(:,:) = shr_const_rwv / rairv_loc(:,:,state%lchnk) - 1._r8 + else + zvirv(:,:) = zvir + endif + + !------------------------------------------------------------------------------------------------------------- + ! Update temperature from dry static energy (moved from above for WACCM-X so updating after cpairv_loc update) + !------------------------------------------------------------------------------------------------------------- + + if(ptend%ls) then + do k = ptend%top_level, ptend%bot_level + state%t(:ncol,k) = state%t(:ncol,k) + ptend%s(:ncol,k)*dt/cpairv_loc(:ncol,k,state%lchnk) + if (present(tend)) & + tend%dtdt(:ncol,k) = tend%dtdt(:ncol,k) + ptend%s(:ncol,k)/cpairv_loc(:ncol,k,state%lchnk) + end do + end if + + ! Derive new geopotential fields if heating or water tendency not 0. + + if (ptend%ls .or. ptend%lq(1)) then + call geopotential_t ( & + state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , & + state%t , state%q(:,:,1), rairv_loc(:,:,state%lchnk), gravit , zvirv , & + state%zi , state%zm , ncol ) + ! update dry static energy for use in next process + do k = ptend%top_level, ptend%bot_level + state%s(:ncol,k) = state%t(:ncol,k )*cpairv_loc(:ncol,k,state%lchnk) & + + gravit*state%zm(:ncol,k) + state%phis(:ncol) + end do + end if + + ! Good idea to do this regularly. + call shr_sys_flush(iulog) + + if (state_debug_checks) call physics_state_check(state, ptend%name) + + deallocate(cpairv_loc, rairv_loc) + + ! Deallocate ptend + call physics_ptend_dealloc(ptend) + + ptend%name = "none" + ptend%lq(:) = .false. + ptend%ls = .false. + ptend%lu = .false. + ptend%lv = .false. + ptend%psetcols = 0 + + contains + + subroutine state_cnst_min_nz(lim, qix, numix) + ! Small utility function for setting minimum nonzero + ! constituent concentrations. + + ! Lower limit and constituent index + real(r8), intent(in) :: lim + integer, intent(in) :: qix + ! Number concentration that goes with qix. + ! Ignored if <= 0 (and therefore constituent is not present). + integer, intent(in) :: numix + + if (numix > 0) then + ! Where q is too small, zero mass and number + ! concentration. + where (state%q(:ncol,:,qix) < lim) + state%q(:ncol,:,qix) = 0._r8 + state%q(:ncol,:,numix) = 0._r8 + end where + else + ! If no number index, just do mass. + where (state%q(:ncol,:,qix) < lim) + state%q(:ncol,:,qix) = 0._r8 + end where + end if + + end subroutine state_cnst_min_nz + + + end subroutine physics_update + +!=============================================================================== + + subroutine physics_state_check(state, name) +!----------------------------------------------------------------------- +! Check a physics_state object for invalid data (e.g NaNs, negative +! temperatures). +!----------------------------------------------------------------------- + use shr_infnan_mod, only: shr_infnan_inf_type, assignment(=), & + shr_infnan_posinf, shr_infnan_neginf + use shr_assert_mod, only: shr_assert, shr_assert_in_domain + use physconst, only: pi + use constituents, only: pcnst, qmin + +!------------------------------Arguments-------------------------------- + ! State to check. + type(physics_state), intent(in) :: state + ! Name of the package responsible for this state. + character(len=*), intent(in), optional :: name + +!---------------------------Local storage------------------------------- + ! Shortened name for ncol. + integer :: ncol + ! Double precision positive/negative infinity. + real(r8) :: posinf_r8, neginf_r8 + ! Canned message. + character(len=64) :: msg + ! Constituent index + integer :: m + +!----------------------------------------------------------------------- + + ncol = state%ncol + + posinf_r8 = shr_infnan_posinf + neginf_r8 = shr_infnan_neginf + + ! It may be reasonable to check some of the integer components of the + ! state as well, but this is not yet implemented. + + ! Check for NaN first to avoid any IEEE exceptions. + + if (present(name)) then + msg = "NaN produced in physics_state by package "// & + trim(name)//"." + else + msg = "NaN found in physics_state." + end if + + ! 1-D variables + call shr_assert_in_domain(state%ps(:ncol), is_nan=.false., & + varname="state%ps", msg=msg) + call shr_assert_in_domain(state%psdry(:ncol), is_nan=.false., & + varname="state%psdry", msg=msg) + call shr_assert_in_domain(state%phis(:ncol), is_nan=.false., & + varname="state%phis", msg=msg) + call shr_assert_in_domain(state%te_ini(:ncol), is_nan=.false., & + varname="state%te_ini", msg=msg) + call shr_assert_in_domain(state%te_cur(:ncol), is_nan=.false., & + varname="state%te_cur", msg=msg) + call shr_assert_in_domain(state%tw_ini(:ncol), is_nan=.false., & + varname="state%tw_ini", msg=msg) + call shr_assert_in_domain(state%tw_cur(:ncol), is_nan=.false., & + varname="state%tw_cur", msg=msg) + + ! 2-D variables (at midpoints) + call shr_assert_in_domain(state%t(:ncol,:), is_nan=.false., & + varname="state%t", msg=msg) + call shr_assert_in_domain(state%u(:ncol,:), is_nan=.false., & + varname="state%u", msg=msg) + call shr_assert_in_domain(state%v(:ncol,:), is_nan=.false., & + varname="state%v", msg=msg) + call shr_assert_in_domain(state%s(:ncol,:), is_nan=.false., & + varname="state%s", msg=msg) + call shr_assert_in_domain(state%omega(:ncol,:), is_nan=.false., & + varname="state%omega", msg=msg) + call shr_assert_in_domain(state%pmid(:ncol,:), is_nan=.false., & + varname="state%pmid", msg=msg) + call shr_assert_in_domain(state%pmiddry(:ncol,:), is_nan=.false., & + varname="state%pmiddry", msg=msg) + call shr_assert_in_domain(state%pdel(:ncol,:), is_nan=.false., & + varname="state%pdel", msg=msg) + call shr_assert_in_domain(state%pdeldry(:ncol,:), is_nan=.false., & + varname="state%pdeldry", msg=msg) + call shr_assert_in_domain(state%rpdel(:ncol,:), is_nan=.false., & + varname="state%rpdel", msg=msg) + call shr_assert_in_domain(state%rpdeldry(:ncol,:), is_nan=.false., & + varname="state%rpdeldry", msg=msg) + call shr_assert_in_domain(state%lnpmid(:ncol,:), is_nan=.false., & + varname="state%lnpmid", msg=msg) + call shr_assert_in_domain(state%lnpmiddry(:ncol,:), is_nan=.false., & + varname="state%lnpmiddry", msg=msg) + call shr_assert_in_domain(state%exner(:ncol,:), is_nan=.false., & + varname="state%exner", msg=msg) + call shr_assert_in_domain(state%zm(:ncol,:), is_nan=.false., & + varname="state%zm", msg=msg) + + ! 2-D variables (at interfaces) + call shr_assert_in_domain(state%pint(:ncol,:), is_nan=.false., & + varname="state%pint", msg=msg) + call shr_assert_in_domain(state%pintdry(:ncol,:), is_nan=.false., & + varname="state%pintdry", msg=msg) + call shr_assert_in_domain(state%lnpint(:ncol,:), is_nan=.false., & + varname="state%lnpint", msg=msg) + call shr_assert_in_domain(state%lnpintdry(:ncol,:), is_nan=.false., & + varname="state%lnpintdry", msg=msg) + call shr_assert_in_domain(state%zi(:ncol,:), is_nan=.false., & + varname="state%zi", msg=msg) + + ! 3-D variables + call shr_assert_in_domain(state%q(:ncol,:,:), is_nan=.false., & + varname="state%q", msg=msg) + + ! Now run other checks (i.e. values are finite and within a range that + ! is physically meaningful). + + if (present(name)) then + msg = "Invalid value produced in physics_state by package "// & + trim(name)//"." + else + msg = "Invalid value found in physics_state." + end if + + ! 1-D variables + call shr_assert_in_domain(state%ps(:ncol), lt=posinf_r8, gt=0._r8, & + varname="state%ps", msg=msg) + call shr_assert_in_domain(state%psdry(:ncol), lt=posinf_r8, gt=0._r8, & + varname="state%psdry", msg=msg) + call shr_assert_in_domain(state%phis(:ncol), lt=posinf_r8, gt=neginf_r8, & + varname="state%phis", msg=msg) + call shr_assert_in_domain(state%te_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_ini", msg=msg) + call shr_assert_in_domain(state%te_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_cur", msg=msg) + call shr_assert_in_domain(state%tw_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & + varname="state%tw_ini", msg=msg) + call shr_assert_in_domain(state%tw_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & + varname="state%tw_cur", msg=msg) + + ! 2-D variables (at midpoints) + call shr_assert_in_domain(state%t(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%t", msg=msg) + call shr_assert_in_domain(state%u(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%u", msg=msg) + call shr_assert_in_domain(state%v(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%v", msg=msg) + call shr_assert_in_domain(state%s(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%s", msg=msg) + call shr_assert_in_domain(state%omega(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%omega", msg=msg) + call shr_assert_in_domain(state%pmid(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%pmid", msg=msg) + call shr_assert_in_domain(state%pmiddry(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%pmiddry", msg=msg) + call shr_assert_in_domain(state%pdel(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%pdel", msg=msg) + call shr_assert_in_domain(state%pdeldry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%pdeldry", msg=msg) + call shr_assert_in_domain(state%rpdel(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%rpdel", msg=msg) + call shr_assert_in_domain(state%rpdeldry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%rpdeldry", msg=msg) + call shr_assert_in_domain(state%lnpmid(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%lnpmid", msg=msg) + call shr_assert_in_domain(state%lnpmiddry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%lnpmiddry", msg=msg) + call shr_assert_in_domain(state%exner(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%exner", msg=msg) + call shr_assert_in_domain(state%zm(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%zm", msg=msg) + + ! 2-D variables (at interfaces) + call shr_assert_in_domain(state%pint(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%pint", msg=msg) + call shr_assert_in_domain(state%pintdry(:ncol,:), lt=posinf_r8, gt=0._r8, & + varname="state%pintdry", msg=msg) + call shr_assert_in_domain(state%lnpint(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%lnpint", msg=msg) + call shr_assert_in_domain(state%lnpintdry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%lnpintdry", msg=msg) + call shr_assert_in_domain(state%zi(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%zi", msg=msg) + + ! 3-D variables + do m = 1,pcnst + call shr_assert_in_domain(state%q(:ncol,:,m), lt=posinf_r8, ge=qmin(m), & + varname="state%q ("//trim(cnst_name(m))//")", msg=msg) + end do + + end subroutine physics_state_check + +!=============================================================================== + + subroutine physics_ptend_sum(ptend, ptend_sum, ncol) +!----------------------------------------------------------------------- +! Add ptend fields to ptend_sum for ptend logical flags = .true. +! Where ptend logical flags = .false, don't change ptend_sum +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + type(physics_ptend), intent(in) :: ptend ! New parameterization tendencies + type(physics_ptend), intent(inout) :: ptend_sum ! Sum of incoming ptend_sum and ptend + integer, intent(in) :: ncol ! number of columns + +!---------------------------Local storage------------------------------- + integer :: i,k,m ! column,level,constituent indices + integer :: psetcols ! maximum number of columns + integer :: ierr = 0 + +!----------------------------------------------------------------------- + if (ptend%psetcols /= ptend_sum%psetcols) then + call endrun('physics_ptend_sum error: ptend and ptend_sum must have the same value for psetcols') + end if + + if (ncol > ptend_sum%psetcols) then + call endrun('physics_ptend_sum error: ncol must be less than or equal to psetcols') + end if + + psetcols = ptend_sum%psetcols + + ptend_sum%top_level = ptend%top_level + ptend_sum%bot_level = ptend%bot_level + +! Update u,v fields + if(ptend%lu) then + if (.not. allocated(ptend_sum%u)) then + allocate(ptend_sum%u(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%u') + ptend_sum%u=0.0_r8 + + allocate(ptend_sum%taux_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%taux_srf') + ptend_sum%taux_srf=0.0_r8 + + allocate(ptend_sum%taux_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%taux_top') + ptend_sum%taux_top=0.0_r8 + end if + ptend_sum%lu = .true. + + do k = ptend%top_level, ptend%bot_level + do i = 1, ncol + ptend_sum%u(i,k) = ptend_sum%u(i,k) + ptend%u(i,k) + end do + end do + do i = 1, ncol + ptend_sum%taux_srf(i) = ptend_sum%taux_srf(i) + ptend%taux_srf(i) + ptend_sum%taux_top(i) = ptend_sum%taux_top(i) + ptend%taux_top(i) + end do + end if + + if(ptend%lv) then + if (.not. allocated(ptend_sum%v)) then + allocate(ptend_sum%v(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%v') + ptend_sum%v=0.0_r8 + + allocate(ptend_sum%tauy_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%tauy_srf') + ptend_sum%tauy_srf=0.0_r8 + + allocate(ptend_sum%tauy_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%tauy_top') + ptend_sum%tauy_top=0.0_r8 + end if + ptend_sum%lv = .true. + + do k = ptend%top_level, ptend%bot_level + do i = 1, ncol + ptend_sum%v(i,k) = ptend_sum%v(i,k) + ptend%v(i,k) + end do + end do + do i = 1, ncol + ptend_sum%tauy_srf(i) = ptend_sum%tauy_srf(i) + ptend%tauy_srf(i) + ptend_sum%tauy_top(i) = ptend_sum%tauy_top(i) + ptend%tauy_top(i) + end do + end if + + + if(ptend%ls) then + if (.not. allocated(ptend_sum%s)) then + allocate(ptend_sum%s(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%s') + ptend_sum%s=0.0_r8 + + allocate(ptend_sum%hflux_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%hflux_srf') + ptend_sum%hflux_srf=0.0_r8 + + allocate(ptend_sum%hflux_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%hflux_top') + ptend_sum%hflux_top=0.0_r8 + end if + ptend_sum%ls = .true. + + do k = ptend%top_level, ptend%bot_level + do i = 1, ncol + ptend_sum%s(i,k) = ptend_sum%s(i,k) + ptend%s(i,k) + end do + end do + do i = 1, ncol + ptend_sum%hflux_srf(i) = ptend_sum%hflux_srf(i) + ptend%hflux_srf(i) + ptend_sum%hflux_top(i) = ptend_sum%hflux_top(i) + ptend%hflux_top(i) + end do + end if + + if (any(ptend%lq(:))) then + + if (.not. allocated(ptend_sum%q)) then + allocate(ptend_sum%q(psetcols,pver,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%q') + ptend_sum%q=0.0_r8 + + allocate(ptend_sum%cflx_srf(psetcols,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_srf') + ptend_sum%cflx_srf=0.0_r8 + + allocate(ptend_sum%cflx_top(psetcols,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_top') + ptend_sum%cflx_top=0.0_r8 + end if + + do m = 1, pcnst + if(ptend%lq(m)) then + ptend_sum%lq(m) = .true. + do k = ptend%top_level, ptend%bot_level + do i = 1,ncol + ptend_sum%q(i,k,m) = ptend_sum%q(i,k,m) + ptend%q(i,k,m) + end do + end do + do i = 1,ncol + ptend_sum%cflx_srf(i,m) = ptend_sum%cflx_srf(i,m) + ptend%cflx_srf(i,m) + ptend_sum%cflx_top(i,m) = ptend_sum%cflx_top(i,m) + ptend%cflx_top(i,m) + end do + end if + end do + + end if + + end subroutine physics_ptend_sum + +!=============================================================================== + + subroutine physics_ptend_scale(ptend, fac, ncol) +!----------------------------------------------------------------------- +! Scale ptend fields for ptend logical flags = .true. +! Where ptend logical flags = .false, don't change ptend. +! +! Assumes that input ptend is valid (e.g. that +! ptend%lu .eqv. allocated(ptend%u)), and therefore +! does not check allocation status of individual arrays. +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + type(physics_ptend), intent(inout) :: ptend ! Incoming ptend + real(r8), intent(in) :: fac ! Factor to multiply ptend by. + integer, intent(in) :: ncol ! number of columns + +!---------------------------Local storage------------------------------- + integer :: m ! constituent index + +!----------------------------------------------------------------------- + +! Update u,v fields + if (ptend%lu) & + call multiply_tendency(ptend%u, & + ptend%taux_srf, ptend%taux_top) + + if (ptend%lv) & + call multiply_tendency(ptend%v, & + ptend%tauy_srf, ptend%tauy_top) + +! Heat + if (ptend%ls) & + call multiply_tendency(ptend%s, & + ptend%hflux_srf, ptend%hflux_top) + +! Update constituents + do m = 1, pcnst + if (ptend%lq(m)) & + call multiply_tendency(ptend%q(:,:,m), & + ptend%cflx_srf(:,m), ptend%cflx_top(:,m)) + end do + + + contains + + subroutine multiply_tendency(tend_arr, flx_srf, flx_top) + real(r8), intent(inout) :: tend_arr(:,:) ! Tendency array (pcols, plev) + real(r8), intent(inout) :: flx_srf(:) ! Surface flux (or stress) + real(r8), intent(inout) :: flx_top(:) ! Top-of-model flux (or stress) + + integer :: k + + do k = ptend%top_level, ptend%bot_level + tend_arr(:ncol,k) = tend_arr(:ncol,k) * fac + end do + flx_srf(:ncol) = flx_srf(:ncol) * fac + flx_top(:ncol) = flx_top(:ncol) * fac + + end subroutine multiply_tendency + + end subroutine physics_ptend_scale + +!=============================================================================== + +subroutine physics_ptend_copy(ptend, ptend_cp) + + !----------------------------------------------------------------------- + ! Copy a physics_ptend object. Allocate ptend_cp internally before copy. + !----------------------------------------------------------------------- + + type(physics_ptend), intent(in) :: ptend ! ptend source + type(physics_ptend), intent(out) :: ptend_cp ! copy of ptend + + !----------------------------------------------------------------------- + + ptend_cp%name = ptend%name + + ptend_cp%ls = ptend%ls + ptend_cp%lu = ptend%lu + ptend_cp%lv = ptend%lv + ptend_cp%lq = ptend%lq + + call physics_ptend_alloc(ptend_cp, ptend%psetcols) + + ptend_cp%top_level = ptend%top_level + ptend_cp%bot_level = ptend%bot_level + + if (ptend_cp%ls) then + ptend_cp%s = ptend%s + ptend_cp%hflux_srf = ptend%hflux_srf + ptend_cp%hflux_top = ptend%hflux_top + end if + + if (ptend_cp%lu) then + ptend_cp%u = ptend%u + ptend_cp%taux_srf = ptend%taux_srf + ptend_cp%taux_top = ptend%taux_top + end if + + if (ptend_cp%lv) then + ptend_cp%v = ptend%v + ptend_cp%tauy_srf = ptend%tauy_srf + ptend_cp%tauy_top = ptend%tauy_top + end if + + if (any(ptend_cp%lq(:))) then + ptend_cp%q = ptend%q + ptend_cp%cflx_srf = ptend%cflx_srf + ptend_cp%cflx_top = ptend%cflx_top + end if + +end subroutine physics_ptend_copy + +!=============================================================================== + + subroutine physics_ptend_reset(ptend) +!----------------------------------------------------------------------- +! Reset the parameterization tendency structure to "empty" +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies +!----------------------------------------------------------------------- + integer :: m ! Index for constiuent +!----------------------------------------------------------------------- + + if(ptend%ls) then + ptend%s = 0._r8 + ptend%hflux_srf = 0._r8 + ptend%hflux_top = 0._r8 + endif + if(ptend%lu) then + ptend%u = 0._r8 + ptend%taux_srf = 0._r8 + ptend%taux_top = 0._r8 + endif + if(ptend%lv) then + ptend%v = 0._r8 + ptend%tauy_srf = 0._r8 + ptend%tauy_top = 0._r8 + endif + if(any (ptend%lq(:))) then + ptend%q = 0._r8 + ptend%cflx_srf = 0._r8 + ptend%cflx_top = 0._r8 + end if + + ptend%top_level = 1 + ptend%bot_level = pver + + return + end subroutine physics_ptend_reset + +!=============================================================================== + subroutine physics_ptend_init(ptend, psetcols, name, ls, lu, lv, lq) +!----------------------------------------------------------------------- +! Allocate the fields in the structure which are specified. +! Initialize the parameterization tendency structure to "empty" +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + type(physics_ptend), intent(out) :: ptend ! Parameterization tendencies + integer, intent(in) :: psetcols ! maximum number of columns + character(len=*) :: name ! optional name of parameterization which produced tendencies. + logical, optional :: ls ! if true, then fields to support dsdt are allocated + logical, optional :: lu ! if true, then fields to support dudt are allocated + logical, optional :: lv ! if true, then fields to support dvdt are allocated + logical, dimension(pcnst),optional :: lq ! if true, then fields to support dqdt are allocated + +!----------------------------------------------------------------------- + + if (allocated(ptend%s)) then + call endrun(' physics_ptend_init: ptend should not be allocated before calling this routine') + end if + + ptend%name = name + ptend%psetcols = psetcols + + ! If no fields being stored, initialize all values to appropriate nulls and return + if (.not. present(ls) .and. .not. present(lu) .and. .not. present(lv) .and. .not. present(lq) ) then + ptend%ls = .false. + ptend%lu = .false. + ptend%lv = .false. + ptend%lq(:) = .false. + ptend%top_level = 1 + ptend%bot_level = pver + return + end if + + if (present(ls)) then + ptend%ls = ls + else + ptend%ls = .false. + end if + + if (present(lu)) then + ptend%lu = lu + else + ptend%lu = .false. + end if + + if (present(lv)) then + ptend%lv = lv + else + ptend%lv = .false. + end if + + if (present(lq)) then + ptend%lq(:) = lq(:) + else + ptend%lq(:) = .false. + end if + + call physics_ptend_alloc(ptend, psetcols) + + call physics_ptend_reset(ptend) + + return + end subroutine physics_ptend_init + +!=============================================================================== + + subroutine physics_state_set_grid(lchnk, phys_state) +!----------------------------------------------------------------------- +! Set the grid components of the physics_state object +!----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + type(physics_state), intent(inout) :: phys_state + + ! local variables + integer :: i, ncol + real(r8) :: rlon(pcols) + real(r8) :: rlat(pcols) + + !----------------------------------------------------------------------- + ! get_ncols_p requires a state which does not have sub-columns + if (phys_state%psetcols .ne. pcols) then + call endrun('physics_state_set_grid: cannot pass in a state which has sub-columns') + end if + + ncol = get_ncols_p(lchnk) + + if(ncol<=0) then + write(iulog,*) lchnk, ncol + call endrun('physics_state_set_grid') + end if + + call get_rlon_all_p(lchnk, ncol, rlon) + call get_rlat_all_p(lchnk, ncol, rlat) + phys_state%ncol = ncol + phys_state%lchnk = lchnk + do i=1,ncol + phys_state%lat(i) = rlat(i) + phys_state%lon(i) = rlon(i) + end do + call init_geo_unique(phys_state,ncol) + + end subroutine physics_state_set_grid + + + subroutine init_geo_unique(phys_state,ncol) + integer, intent(in) :: ncol + type(physics_state), intent(inout) :: phys_state + logical :: match + integer :: i, j, ulatcnt, uloncnt + + phys_state%ulat=-999._r8 + phys_state%ulon=-999._r8 + phys_state%latmapback=0 + phys_state%lonmapback=0 + match=.false. + ulatcnt=0 + uloncnt=0 + match=.false. + do i=1,ncol + do j=1,ulatcnt + if(phys_state%lat(i) .eq. phys_state%ulat(j)) then + match=.true. + phys_state%latmapback(i)=j + end if + end do + if(.not. match) then + ulatcnt=ulatcnt+1 + phys_state%ulat(ulatcnt)=phys_state%lat(i) + phys_state%latmapback(i)=ulatcnt + end if + + match=.false. + do j=1,uloncnt + if(phys_state%lon(i) .eq. phys_state%ulon(j)) then + match=.true. + phys_state%lonmapback(i)=j + end if + end do + if(.not. match) then + uloncnt=uloncnt+1 + phys_state%ulon(uloncnt)=phys_state%lon(i) + phys_state%lonmapback(i)=uloncnt + end if + match=.false. + + end do + phys_state%uloncnt=uloncnt + phys_state%ulatcnt=ulatcnt + + call get_gcol_all_p(phys_state%lchnk,pcols,phys_state%cid) + + + end subroutine init_geo_unique + +!=============================================================================== + subroutine physics_dme_adjust(state, tend, qini, dt) + !----------------------------------------------------------------------- + ! + ! Purpose: Adjust the dry mass in each layer back to the value of physics input state + ! + ! Method: Conserve the integrated mass, momentum and total energy in each layer + ! by scaling the specific mass of consituents, specific momentum (velocity) + ! and specific total energy by the relative change in layer mass. Solve for + ! the new temperature by subtracting the new kinetic energy from total energy + ! and inverting the hydrostatic equation + ! + ! The mass in each layer is modified, changing the relationship of the layer + ! interfaces and midpoints to the surface pressure. The result is no longer in + ! the original hybrid coordinate. + ! + ! This procedure cannot be applied to the "eul" or "sld" dycores because they + ! require the hybrid coordinate. + ! + ! Author: Byron Boville + + ! !REVISION HISTORY: + ! 03.03.28 Boville Created, partly from code by Lin in p_d_adjust + ! + !----------------------------------------------------------------------- + + use constituents, only : cnst_get_type_byind + use ppgrid, only : begchunk, endchunk + + implicit none + ! + ! Arguments + ! + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity + real(r8), intent(in ) :: dt ! model physics timestep + ! + !---------------------------Local workspace----------------------------- + ! + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i,k,m ! Longitude, level indices + real(r8) :: fdq(pcols) ! mass adjustment factor + real(r8) :: te(pcols) ! total energy in a layer + real(r8) :: utmp(pcols) ! temp variable for recalculating the initial u values + real(r8) :: vtmp(pcols) ! temp variable for recalculating the initial v values + + real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + + real(r8),allocatable :: cpairv_loc(:,:,:) + ! + !----------------------------------------------------------------------- + + if (state%psetcols .ne. pcols) then + call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns') + end if + if (adjust_te) then + call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"') + end if + + lchnk = state%lchnk + ncol = state%ncol + + ! adjust dry mass in each layer back to input value, while conserving + ! constituents, momentum, and total energy + state%ps(:ncol) = state%pint(:ncol,1) + do k = 1, pver + + ! adjusment factor is just change in water vapor + fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) + + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst + state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + end do + + if (adjust_te) then + ! compute specific total energy of unadjusted state (J/kg) + te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) + + ! recompute initial u,v from the new values and the tendencies + utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k) + vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k) + ! adjust specific total energy and specific momentum (velocity) to conserve each + te (:ncol) = te (:ncol) / fdq(:ncol) + state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol) + state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol) + ! compute adjusted u,v tendencies + tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt + tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt + + ! compute adjusted static energy + state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) + end if + +! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + end do + + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8 + else + zvirv(:,:) = zvir + endif + +! compute new T,z from new s,q,dp + if (adjust_te) then + +! cpairv_loc needs to be allocated to a size which matches state and ptend +! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc +! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair + + if (state%psetcols == pcols) then + allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpairv(:,:,:) + else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then + allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) + cpairv_loc(:,:,:) = cpair + else + call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on') + end if + + call geopotential_dse(state%lnpint, state%lnpmid, state%pint, & + state%pmid , state%pdel , state%rpdel, & + state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), & + gravit, cpairv_loc(:,:,state%lchnk), zvirv, & + state%t , state%zi , state%zm , ncol) + + deallocate(cpairv_loc) + + end if + + end subroutine physics_dme_adjust +!----------------------------------------------------------------------- + +!=============================================================================== + subroutine physics_state_copy(state_in, state_out) + + use ppgrid, only: pver, pverp + use constituents, only: pcnst + + implicit none + + ! + ! Arguments + ! + type(physics_state), intent(in) :: state_in + type(physics_state), intent(out) :: state_out + + ! + ! Local variables + ! + integer i, k, m, ncol + + ! Allocate state_out with same subcol dimension as state_in + call physics_state_alloc ( state_out, state_in%lchnk, state_in%psetcols) + + ncol = state_in%ncol + + state_out%psetcols = state_in%psetcols + state_out%ngrdcol = state_in%ngrdcol + state_out%lchnk = state_in%lchnk + state_out%ncol = state_in%ncol + state_out%count = state_in%count + + do i = 1, ncol + state_out%lat(i) = state_in%lat(i) + state_out%lon(i) = state_in%lon(i) + state_out%ps(i) = state_in%ps(i) + state_out%phis(i) = state_in%phis(i) + state_out%te_ini(i) = state_in%te_ini(i) + state_out%te_cur(i) = state_in%te_cur(i) + state_out%tw_ini(i) = state_in%tw_ini(i) + state_out%tw_cur(i) = state_in%tw_cur(i) + end do + + do k = 1, pver + do i = 1, ncol + state_out%t(i,k) = state_in%t(i,k) + state_out%u(i,k) = state_in%u(i,k) + state_out%v(i,k) = state_in%v(i,k) + state_out%s(i,k) = state_in%s(i,k) + state_out%omega(i,k) = state_in%omega(i,k) + state_out%pmid(i,k) = state_in%pmid(i,k) + state_out%pdel(i,k) = state_in%pdel(i,k) + state_out%rpdel(i,k) = state_in%rpdel(i,k) + state_out%lnpmid(i,k) = state_in%lnpmid(i,k) + state_out%exner(i,k) = state_in%exner(i,k) + state_out%zm(i,k) = state_in%zm(i,k) + end do + end do + + do k = 1, pverp + do i = 1, ncol + state_out%pint(i,k) = state_in%pint(i,k) + state_out%lnpint(i,k) = state_in%lnpint(i,k) + state_out%zi(i,k) = state_in% zi(i,k) + end do + end do + + + do i = 1, ncol + state_out%psdry(i) = state_in%psdry(i) + end do + do k = 1, pver + do i = 1, ncol + state_out%lnpmiddry(i,k) = state_in%lnpmiddry(i,k) + state_out%pmiddry(i,k) = state_in%pmiddry(i,k) + state_out%pdeldry(i,k) = state_in%pdeldry(i,k) + state_out%rpdeldry(i,k) = state_in%rpdeldry(i,k) + end do + end do + do k = 1, pverp + do i = 1, ncol + state_out%pintdry(i,k) = state_in%pintdry(i,k) + state_out%lnpintdry(i,k) = state_in%lnpintdry(i,k) + end do + end do + + do m = 1, pcnst + do k = 1, pver + do i = 1, ncol + state_out%q(i,k,m) = state_in%q(i,k,m) + end do + end do + end do + + end subroutine physics_state_copy +!=============================================================================== + + subroutine physics_tend_init(tend) + + implicit none + + ! + ! Arguments + ! + type(physics_tend), intent(inout) :: tend + + ! + ! Local variables + ! + + if (.not. allocated(tend%dtdt)) then + call endrun('physics_tend_init: tend must be allocated before it can be initialized') + end if + + tend%dtdt = 0._r8 + tend%dudt = 0._r8 + tend%dvdt = 0._r8 + tend%flx_net = 0._r8 + tend%te_tnd = 0._r8 + tend%tw_tnd = 0._r8 + +end subroutine physics_tend_init + +!=============================================================================== + +subroutine set_state_pdry (state,pdeld_calc) + + use ppgrid, only: pver + use pmgrid, only: plev, plevp + implicit none + + type(physics_state), intent(inout) :: state + logical, optional, intent(in) :: pdeld_calc ! .true. do calculate pdeld [default] + ! .false. don't calculate pdeld + integer ncol + integer i, k + logical do_pdeld_calc + + if ( present(pdeld_calc) ) then + do_pdeld_calc = pdeld_calc + else + do_pdeld_calc = .true. + endif + + ncol = state%ncol + + + state%psdry(:ncol) = state%pint(:ncol,1) + state%pintdry(:ncol,1) = state%pint(:ncol,1) + + if (do_pdeld_calc) then + do k = 1, pver + state%pdeldry(:ncol,k) = state%pdel(:ncol,k)*(1._r8-state%q(:ncol,k,1)) + end do + endif + do k = 1, pver + state%pintdry(:ncol,k+1) = state%pintdry(:ncol,k)+state%pdeldry(:ncol,k) + state%pmiddry(:ncol,k) = (state%pintdry(:ncol,k+1)+state%pintdry(:ncol,k))/2._r8 + state%psdry(:ncol) = state%psdry(:ncol) + state%pdeldry(:ncol,k) + end do + + state%rpdeldry(:ncol,:) = 1._r8/state%pdeldry(:ncol,:) + state%lnpmiddry(:ncol,:) = log(state%pmiddry(:ncol,:)) + state%lnpintdry(:ncol,:) = log(state%pintdry(:ncol,:)) + +end subroutine set_state_pdry + +!=============================================================================== + +subroutine set_wet_to_dry (state) + + use constituents, only: pcnst, cnst_type + + type(physics_state), intent(inout) :: state + + integer m, ncol + + ncol = state%ncol + + do m = 1,pcnst + if (cnst_type(m).eq.'dry') then + state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdel(:ncol,:)/state%pdeldry(:ncol,:) + endif + end do + +end subroutine set_wet_to_dry + +!=============================================================================== + +subroutine set_dry_to_wet (state) + + use constituents, only: pcnst, cnst_type + + type(physics_state), intent(inout) :: state + + integer m, ncol + + ncol = state%ncol + + do m = 1,pcnst + if (cnst_type(m).eq.'dry') then + state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdeldry(:ncol,:)/state%pdel(:ncol,:) + endif + end do + +end subroutine set_dry_to_wet + +!=============================================================================== + +subroutine physics_state_alloc(state,lchnk,psetcols) + + use infnan, only : inf, assignment(=) + +! allocate the individual state components + + type(physics_state), intent(inout) :: state + integer,intent(in) :: lchnk + + integer, intent(in) :: psetcols + + integer :: ierr=0, i + + state%lchnk = lchnk + state%psetcols = psetcols + state%ngrdcol = get_ncols_p(lchnk) ! Number of grid columns + + !---------------------------------- + ! Following variables will be overwritten by sub-column generator, if sub-columns are being used + + ! state%ncol - is initialized in physics_state_set_grid, if not using sub-columns + + !---------------------------------- + + allocate(state%lat(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lat') + + allocate(state%lon(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lon') + + allocate(state%ps(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ps') + + allocate(state%psdry(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%psdry') + + allocate(state%phis(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%phis') + + allocate(state%ulat(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulat') + + allocate(state%ulon(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulon') + + allocate(state%t(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%t') + + allocate(state%u(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%u') + + allocate(state%v(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%v') + + allocate(state%s(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%s') + + allocate(state%omega(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%omega') + + allocate(state%pmid(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmid') + + allocate(state%pmiddry(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmiddry') + + allocate(state%pdel(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdel') + + allocate(state%pdeldry(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdeldry') + + allocate(state%rpdel(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdel') + + allocate(state%rpdeldry(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdeldry') + + allocate(state%lnpmid(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmid') + + allocate(state%lnpmiddry(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmiddry') + + allocate(state%exner(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%exner') + + allocate(state%zm(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zm') + + allocate(state%q(psetcols,pver,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q') + + allocate(state%pint(psetcols,pver+1), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint') + + allocate(state%pintdry(psetcols,pver+1), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pintdry') + + allocate(state%lnpint(psetcols,pver+1), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpint') + + allocate(state%lnpintdry(psetcols,pver+1), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpintdry') + + allocate(state%zi(psetcols,pver+1), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zi') + + allocate(state%te_ini(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_ini') + + allocate(state%te_cur(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') + + allocate(state%tw_ini(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini') + + allocate(state%tw_cur(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_cur') + + allocate(state%latmapback(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%latmapback') + + allocate(state%lonmapback(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lonmapback') + + allocate(state%cid(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%cid') + + state%lat(:) = inf + state%lon(:) = inf + state%ulat(:) = inf + state%ulon(:) = inf + state%ps(:) = inf + state%psdry(:) = inf + state%phis(:) = inf + state%t(:,:) = inf + state%u(:,:) = inf + state%v(:,:) = inf + state%s(:,:) = inf + state%omega(:,:) = inf + state%pmid(:,:) = inf + state%pmiddry(:,:) = inf + state%pdel(:,:) = inf + state%pdeldry(:,:) = inf + state%rpdel(:,:) = inf + state%rpdeldry(:,:) = inf + state%lnpmid(:,:) = inf + state%lnpmiddry(:,:) = inf + state%exner(:,:) = inf + state%zm(:,:) = inf + state%q(:,:,:) = inf + + state%pint(:,:) = inf + state%pintdry(:,:) = inf + state%lnpint(:,:) = inf + state%lnpintdry(:,:) = inf + state%zi(:,:) = inf + + state%te_ini(:) = inf + state%te_cur(:) = inf + state%tw_ini(:) = inf + state%tw_cur(:) = inf + +end subroutine physics_state_alloc + +!=============================================================================== + +subroutine physics_state_dealloc(state) + +! deallocate the individual state components + + type(physics_state), intent(inout) :: state + integer :: ierr = 0 + + deallocate(state%lat, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lat') + + deallocate(state%lon, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lon') + + deallocate(state%ps, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ps') + + deallocate(state%psdry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%psdry') + + deallocate(state%phis, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%phis') + + deallocate(state%ulat, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulat') + + deallocate(state%ulon, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulon') + + deallocate(state%t, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%t') + + deallocate(state%u, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%u') + + deallocate(state%v, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%v') + + deallocate(state%s, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%s') + + deallocate(state%omega, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%omega') + + deallocate(state%pmid, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmid') + + deallocate(state%pmiddry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmiddry') + + deallocate(state%pdel, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdel') + + deallocate(state%pdeldry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdeldry') + + deallocate(state%rpdel, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdel') + + deallocate(state%rpdeldry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdeldry') + + deallocate(state%lnpmid, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmid') + + deallocate(state%lnpmiddry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmiddry') + + deallocate(state%exner, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%exner') + + deallocate(state%zm, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zm') + + deallocate(state%q, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%q') + + deallocate(state%pint, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pint') + + deallocate(state%pintdry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pintdry') + + deallocate(state%lnpint, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpint') + + deallocate(state%lnpintdry, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpintdry') + + deallocate(state%zi, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zi') + + deallocate(state%te_ini, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_ini') + + deallocate(state%te_cur, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_cur') + + deallocate(state%tw_ini, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_ini') + + deallocate(state%tw_cur, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_cur') + + deallocate(state%latmapback, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback') + + deallocate(state%lonmapback, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lonmapback') + + deallocate(state%cid, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%cid') + +end subroutine physics_state_dealloc + +!=============================================================================== + +subroutine physics_tend_alloc(tend,psetcols) + + use infnan, only : inf, assignment(=) +! allocate the individual tend components + + type(physics_tend), intent(inout) :: tend + + integer, intent(in) :: psetcols + + integer :: ierr = 0 + + tend%psetcols = psetcols + + allocate(tend%dtdt(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dtdt') + + allocate(tend%dudt(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dudt') + + allocate(tend%dvdt(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dvdt') + + allocate(tend%flx_net(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%flx_net') + + allocate(tend%te_tnd(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%te_tnd') + + allocate(tend%tw_tnd(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%tw_tnd') + + tend%dtdt(:,:) = inf + tend%dudt(:,:) = inf + tend%dvdt(:,:) = inf + tend%flx_net(:) = inf + tend%te_tnd(:) = inf + tend%tw_tnd(:) = inf + +end subroutine physics_tend_alloc + +!=============================================================================== + +subroutine physics_tend_dealloc(tend) + +! deallocate the individual tend components + + type(physics_tend), intent(inout) :: tend + integer :: psetcols + integer :: ierr = 0 + + deallocate(tend%dtdt, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dtdt') + + deallocate(tend%dudt, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dudt') + + deallocate(tend%dvdt, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dvdt') + + deallocate(tend%flx_net, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%flx_net') + + deallocate(tend%te_tnd, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%te_tnd') + + deallocate(tend%tw_tnd, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%tw_tnd') +end subroutine physics_tend_dealloc + +!=============================================================================== + +subroutine physics_ptend_alloc(ptend,psetcols) + +! allocate the individual ptend components + + type(physics_ptend), intent(inout) :: ptend + + integer, intent(in) :: psetcols + + integer :: ierr = 0 + + ptend%psetcols = psetcols + + if (ptend%ls) then + allocate(ptend%s(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%s') + + allocate(ptend%hflux_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%hflux_srf') + + allocate(ptend%hflux_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%hflux_top') + end if + + if (ptend%lu) then + allocate(ptend%u(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%u') + + allocate(ptend%taux_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%taux_srf') + + allocate(ptend%taux_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%taux_top') + end if + + if (ptend%lv) then + allocate(ptend%v(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%v') + + allocate(ptend%tauy_srf(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%tauy_srf') + + allocate(ptend%tauy_top(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%tauy_top') + end if + + if (any(ptend%lq)) then + allocate(ptend%q(psetcols,pver,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%q') + + allocate(ptend%cflx_srf(psetcols,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%cflx_srf') + + allocate(ptend%cflx_top(psetcols,pcnst), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%cflx_top') + end if + +end subroutine physics_ptend_alloc + +!=============================================================================== + +subroutine physics_ptend_dealloc(ptend) + +! deallocate the individual ptend components + + type(physics_ptend), intent(inout) :: ptend + integer :: ierr = 0 + + ptend%psetcols = 0 + + if (allocated(ptend%s)) deallocate(ptend%s, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%s') + + if (allocated(ptend%hflux_srf)) deallocate(ptend%hflux_srf, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%hflux_srf') + + if (allocated(ptend%hflux_top)) deallocate(ptend%hflux_top, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%hflux_top') + + if (allocated(ptend%u)) deallocate(ptend%u, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%u') + + if (allocated(ptend%taux_srf)) deallocate(ptend%taux_srf, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%taux_srf') + + if (allocated(ptend%taux_top)) deallocate(ptend%taux_top, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%taux_top') + + if (allocated(ptend%v)) deallocate(ptend%v, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%v') + + if (allocated(ptend%tauy_srf)) deallocate(ptend%tauy_srf, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%tauy_srf') + + if (allocated(ptend%tauy_top)) deallocate(ptend%tauy_top, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%tauy_top') + + if (allocated(ptend%q)) deallocate(ptend%q, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%q') + + if (allocated(ptend%cflx_srf)) deallocate(ptend%cflx_srf, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%cflx_srf') + + if(allocated(ptend%cflx_top)) deallocate(ptend%cflx_top, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%cflx_top') + +end subroutine physics_ptend_dealloc + +end module physics_types diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 new file mode 100644 index 0000000000..c324303f94 --- /dev/null +++ b/src/physics/cam/physpkg.F90 @@ -0,0 +1,2374 @@ +module physpkg + !----------------------------------------------------------------------- + ! Purpose: + ! + ! Provides the interface to CAM physics package + ! + ! Revision history: + ! Aug 2005, E. B. Kluzek, Creation of module from physpkg subroutine + ! 2005-10-17 B. Eaton Add contents of inti.F90 to phys_init(). Add + ! initialization of grid info in phys_state. + ! Nov 2010 A. Gettelman Put micro/macro physics into separate routines + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use physconst, only: latvap, latice, rh2o + use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & + physics_ptend, physics_tend_init, physics_update, & + physics_type_alloc, physics_ptend_dealloc,& + physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc + use phys_grid, only: get_ncols_p + use phys_gmean, only: gmean_mass + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols + use constituents, only: pcnst, cnst_name, cnst_get_ind + use camsrfexch, only: cam_out_t, cam_in_t + + use cam_control_mod, only: ideal_phys, adiabatic + use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is + use scamMod, only: single_column, scm_crm_mode + use flux_avg, only: flux_avg_init + use infnan, only: posinf, assignment(=) + use perf_mod + use cam_logfile, only: iulog + use camsrfexch, only: cam_export + + use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg + use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg + + implicit none + private + save + + ! Public methods + public phys_register ! was initindx - register physics methods + public phys_init ! Public initialization method + public phys_run1 ! First phase of the public run method + public phys_run2 ! Second phase of the public run method + public phys_final ! Public finalization method + + ! Private module data + + ! Physics package options + character(len=16) :: shallow_scheme + character(len=16) :: macrop_scheme + character(len=16) :: microp_scheme + integer :: cld_macmic_num_steps ! Number of macro/micro substeps + logical :: do_clubb_sgs + logical :: use_subcol_microp ! if true, use subcolumns in microphysics + logical :: state_debug_checks ! Debug physics_state. + logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols + logical :: prog_modal_aero ! Prognostic modal aerosols present + + ! Physics buffer index + integer :: teout_idx = 0 + + integer :: landm_idx = 0 + integer :: sgh_idx = 0 + integer :: sgh30_idx = 0 + + integer :: qini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 + + integer :: prec_str_idx = 0 + integer :: snow_str_idx = 0 + integer :: prec_sed_idx = 0 + integer :: snow_sed_idx = 0 + integer :: prec_pcw_idx = 0 + integer :: snow_pcw_idx = 0 + integer :: prec_dp_idx = 0 + integer :: snow_dp_idx = 0 + integer :: prec_sh_idx = 0 + integer :: snow_sh_idx = 0 + integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. + +!======================================================================= +contains +!======================================================================= + + subroutine phys_register + !----------------------------------------------------------------------- + ! + ! Purpose: Register constituents and physics buffer fields. + ! + ! Author: CSM Contact: M. Vertenstein, Aug. 1997 + ! B.A. Boville, Oct 2001 + ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines + ! + !----------------------------------------------------------------------- + use cam_abortutils, only: endrun + use physics_buffer, only: pbuf_init_time + use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name + + use cam_control_mod, only: moist_physics + use chemistry, only: chem_register + use cloud_fraction, only: cldfrc_register + use rk_stratiform, only: rk_stratiform_register + use microp_driver, only: microp_driver_register + use microp_aero, only: microp_aero_register + use macrop_driver, only: macrop_driver_register + use clubb_intr, only: clubb_register_cam + use conv_water, only: conv_water_register + use physconst, only: mwdry, cpair, mwh2o, cpwv + use tracers, only: tracers_register + use check_energy, only: check_energy_register + use carma_intr, only: carma_register + use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register + use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register + use ghg_data, only: ghg_data_register + use vertical_diffusion, only: vd_register + use convect_deep, only: convect_deep_register + use convect_shallow, only: convect_shallow_register + use radiation, only: radiation_register + use co2_cycle, only: co2_register + use flux_avg, only: flux_avg_register + use iondrag, only: iondrag_register + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg + use string_utils, only: to_lower + use prescribed_ozone, only: prescribed_ozone_register + use prescribed_volcaero,only: prescribed_volcaero_register + use prescribed_strataero,only: prescribed_strataero_register + use prescribed_aero, only: prescribed_aero_register + use prescribed_ghg, only: prescribed_ghg_register + use sslt_rebin, only: sslt_rebin_register + use aoa_tracers, only: aoa_tracers_register + use aircraft_emit, only: aircraft_emit_register + use cam_diagnostics, only: diag_register + use cloud_diagnostics, only: cloud_diagnostics_register + use cospsimulator_intr, only: cospsimulator_intr_register + use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use subcol, only: subcol_register + use subcol_utils, only: is_subcol_on + use dyn_comp, only: dyn_register + use spcam_drivers, only: spcam_register + use offline_driver, only: offline_driver_reg + + !---------------------------Local variables----------------------------- + ! + integer :: m ! loop index + integer :: mm ! constituent index + integer :: nmodes + !----------------------------------------------------------------------- + + ! Get physics options + call phys_getopts(shallow_scheme_out = shallow_scheme, & + macrop_scheme_out = macrop_scheme, & + microp_scheme_out = microp_scheme, & + cld_macmic_num_steps_out = cld_macmic_num_steps, & + do_clubb_sgs_out = do_clubb_sgs, & + use_subcol_microp_out = use_subcol_microp, & + state_debug_checks_out = state_debug_checks) + + ! Initialize dyn_time_lvls + call pbuf_init_time() + + ! Register the subcol scheme + call subcol_register() + + ! Register water vapor. + ! ***** N.B. ***** This must be the first call to cnst_add so that + ! water vapor is constituent 1. + if (moist_physics) then + call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, & + longname='Specific humidity', readiv=.true., is_convtran1=.true.) + else + call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, & + longname='Specific humidity', readiv=.false., is_convtran1=.true.) + end if + + ! Topography file fields. + call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx) + call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx) + call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx) + + ! Fields for physics package diagnostics + call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + + ! check energy package + call check_energy_register + + ! If using a simple physics option (e.g., held_suarez, adiabatic), + ! the normal CAM physics parameterizations are not called. + if (moist_physics) then + + ! register fluxes for saving across time + if (phys_do_flux_avg()) call flux_avg_register() + + call cldfrc_register() + + ! cloud water + if( microp_scheme == 'RK' ) then + call rk_stratiform_register() + elseif( microp_scheme == 'MG' ) then + if (.not. do_clubb_sgs) call macrop_driver_register() + call microp_aero_register() + call microp_driver_register() + end if + + ! Register CLUBB_SGS here + if (do_clubb_sgs) call clubb_register_cam() + + + call pbuf_add_field('PREC_STR', 'physpkg',dtype_r8,(/pcols/),prec_str_idx) + call pbuf_add_field('SNOW_STR', 'physpkg',dtype_r8,(/pcols/),snow_str_idx) + call pbuf_add_field('PREC_PCW', 'physpkg',dtype_r8,(/pcols/),prec_pcw_idx) + call pbuf_add_field('SNOW_PCW', 'physpkg',dtype_r8,(/pcols/),snow_pcw_idx) + call pbuf_add_field('PREC_SED', 'physpkg',dtype_r8,(/pcols/),prec_sed_idx) + call pbuf_add_field('SNOW_SED', 'physpkg',dtype_r8,(/pcols/),snow_sed_idx) + if (is_subcol_on()) then + call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx) + call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx) + call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx) + call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx) + call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx) + call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx) + end if + + ! Who should add FRACIS? + ! -- It does not seem that aero_intr should add it since FRACIS is used in convection + ! even if there are no prognostic aerosols ... so do it here for now + call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m) + + call conv_water_register() + + ! Determine whether its a 'modal' aerosol simulation or not + call rad_cnst_get_info(0, nmodes=nmodes) + clim_modal_aero = (nmodes > 0) + + if (clim_modal_aero) then + call modal_aero_calcsize_reg() + call modal_aero_wateruptake_reg() + endif + + ! register chemical constituents including aerosols ... + call chem_register() + + ! co2 constituents + call co2_register() + + ! register data model ozone with pbuf + if (cam3_ozone_data_on) then + call cam3_ozone_data_register() + end if + call prescribed_volcaero_register() + call prescribed_strataero_register() + call prescribed_ozone_register() + call prescribed_aero_register() + call prescribed_ghg_register() + call sslt_rebin_register + + ! CAM3 prescribed aerosols + if (cam3_aero_data_on) then + call cam3_aero_data_register() + end if + + ! register various data model gasses with pbuf + call ghg_data_register() + + ! carma microphysics + ! + call carma_register() + + ! Register iondrag variables with pbuf + call iondrag_register() + + ! Register ionosphere variables with pbuf if mode set to ionosphere + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_reg() + endif + + call aircraft_emit_register() + + ! deep convection + call convect_deep_register + + ! shallow convection + call convect_shallow_register + + + call spcam_register + + ! radiation + call radiation_register + call cloud_diagnostics_register + + ! COSP + call cospsimulator_intr_register + + ! vertical diffusion + call vd_register() + else + ! held_suarez/adiabatic physics option should be in simple_physics + call endrun('phys_register: moist_physics configuration error') + end if + + ! Register diagnostics PBUF + call diag_register() + + ! Register age of air tracers + call aoa_tracers_register() + + ! Register test tracers + call tracers_register() + + call dyn_register() + + ! All tracers registered, check that the dimensions are correct + call cnst_chk_dim() + + ! ***NOTE*** No registering constituents after the call to cnst_chk_dim. + + call offline_driver_reg() + + end subroutine phys_register + + + + !======================================================================= + + subroutine phys_inidat( cam_out, pbuf2d ) + use cam_abortutils, only: endrun + + use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls + + + use cam_initfiles, only: initial_file_get_id, topo_file_get_id + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + use pio, only: file_desc_t + use ncdio_atm, only: infld + use dycore, only: dycore_is + use polar_avg, only: polar_average + use short_lived_species, only: initialize_short_lived_species + use cam_control_mod, only: aqua_planet + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat + + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer :: lchnk, m, n, i, k, ncol + type(file_desc_t), pointer :: fh_ini, fh_topo + character(len=8) :: fieldname + real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:) + real(r8), pointer :: qpert(:,:) + + character(len=11) :: subname='phys_inidat' ! subroutine name + integer :: tpert_idx, qpert_idx, pblh_idx + + logical :: found=.false., found2=.false. + integer :: ierr + character(len=8) :: dim1name, dim2name + integer :: ixcldice, ixcldliq + integer :: grid_id ! grid ID for data mapping + + nullify(tptr,tptr_2,tptr3d,tptr3d_2) + + fh_ini => initial_file_get_id() + fh_topo => topo_file_get_id() + + ! dynamics variables are handled in dyn_init - here we read variables needed for physics + ! but not dynamics + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + allocate(tptr(1:pcols,begchunk:endchunk)) + + if (associated(fh_topo) .and. .not. aqua_planet) then + call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not. found) call endrun('ERROR: SGH not found on topo file') + + call pbuf_set_field(pbuf2d, sgh_idx, tptr) + + allocate(tptr_2(1:pcols,begchunk:endchunk)) + call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr_2, found, gridname='physgrid') + if(found) then + call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2) + else + if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.' + if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.' + call pbuf_set_field(pbuf2d, sgh30_idx, tptr) + end if + + deallocate(tptr_2) + + call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + + if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.') + + call pbuf_set_field(pbuf2d, landm_idx, tptr) + + else + call pbuf_set_field(pbuf2d, sgh_idx, 0._r8) + call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8) + call pbuf_set_field(pbuf2d, landm_idx, 0._r8) + end if + + call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr(:,:), found, gridname='physgrid') + if(.not. found) then + tptr(:,:) = 0._r8 + if (masterproc) write(iulog,*) 'PBLH initialized to 0.' + end if + pblh_idx = pbuf_get_index('pblh') + + call pbuf_set_field(pbuf2d, pblh_idx, tptr) + + call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr(:,:), found, gridname='physgrid') + if(.not. found) then + tptr(:,:) = 0._r8 + if (masterproc) write(iulog,*) 'TPERT initialized to 0.' + end if + tpert_idx = pbuf_get_index( 'tpert') + call pbuf_set_field(pbuf2d, tpert_idx, tptr) + + fieldname='QPERT' + qpert_idx = pbuf_get_index( 'qpert',ierr) + if (qpert_idx > 0) then + call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not. found) then + tptr=0_r8 + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + allocate(tptr3d_2(pcols,pcnst,begchunk:endchunk)) + tptr3d_2 = 0_r8 + tptr3d_2(:,1,:) = tptr(:,:) + + call pbuf_set_field(pbuf2d, qpert_idx, tptr3d_2) + deallocate(tptr3d_2) + end if + + fieldname='CUSH' + m = pbuf_get_index('cush', ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not.found) then + if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.' + tptr=1000._r8 + end if + do n=1,dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/)) + end do + deallocate(tptr) + end if + + do lchnk=begchunk,endchunk + cam_out(lchnk)%tbot(:) = posinf + end do + + ! + ! 3-D fields + ! + + allocate(tptr3d(pcols,pver,begchunk:endchunk)) + + fieldname='CLOUD' + m = pbuf_get_index('CLD') + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + fieldname='QCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(.not. found) then + call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q' + if(dycore_is('LR')) call polar_average(pver, tptr3d) + else + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' + tptr3d = huge(1.0_r8) + end if + end if + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + end if + + fieldname = 'ICCWAT' + m = pbuf_get_index(fieldname, ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call cnst_get_ind('CLDICE', ixcldice) + call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + end if + if (masterproc) then + if (found) then + write(iulog,*) trim(fieldname), ' initialized with CLDICE' + else + write(iulog,*) trim(fieldname), ' initialized to 0.0' + end if + end if + end if + end if + + fieldname = 'LCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + allocate(tptr3d_2(pcols,pver,begchunk:endchunk)) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d_2, found2, gridname='physgrid') + if(found .and. found2) then + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk) + end do + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ' + else if (found) then ! Data already loaded in tptr3d + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only' + else if (found2) then + tptr3d(:,:,:)=tptr3d_2(:,:,:) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only' + end if + + if (found .or. found2) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + if(dycore_is('LR')) call polar_average(pver, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0' + end if + deallocate(tptr3d_2) + end if + end if + + deallocate(tptr3d) + allocate(tptr3d(pcols,pver,begchunk:endchunk)) + + fieldname = 'TCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(.not.found) then + call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + if(dycore_is('LR')) call polar_average(pver, tptr3d) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T' + else + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' + tptr3d = huge(1._r8) + end if + end if + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + end if + + deallocate(tptr3d) + allocate(tptr3d(pcols,pverp,begchunk:endchunk)) + + fieldname = 'TKE' + m = pbuf_get_index( 'tke') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0.01_r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01' + end if + + + fieldname = 'KVM' + m = pbuf_get_index('kvm') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + + fieldname = 'KVH' + m = pbuf_get_index('kvh') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + deallocate(tptr3d) + allocate(tptr3d(pcols,pver,begchunk:endchunk)) + + fieldname = 'CONCLD' + m = pbuf_get_index('CONCLD',ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + deallocate (tptr3d) + end if + + call initialize_short_lived_species(fh_ini, pbuf2d) + + !--------------------------------------------------------------------------------- + ! If needed, get ion and electron temperature fields from initial condition file + !--------------------------------------------------------------------------------- + + call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d) + + end subroutine phys_inidat + + + subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out ) + + !----------------------------------------------------------------------- + ! + ! Initialization of physics package. + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index + use physconst, only: rair, cpair, gravit, stebol, tmelt, & + latvap, latice, rh2o, rhoh2o, pstd, zvir, & + karman, rhodair, physconst_init + use ref_pres, only: pref_edge, pref_mid + + use carma_intr, only: carma_init + use cam_control_mod, only: initial_run + use check_energy, only: check_energy_init + use chemistry, only: chem_init + use prescribed_ozone, only: prescribed_ozone_init + use prescribed_ghg, only: prescribed_ghg_init + use prescribed_aero, only: prescribed_aero_init + use aerodep_flx, only: aerodep_flx_init + use aircraft_emit, only: aircraft_emit_init + use prescribed_volcaero,only: prescribed_volcaero_init + use prescribed_strataero,only: prescribed_strataero_init + use cloud_fraction, only: cldfrc_init + use cldfrc2m, only: cldfrc2m_init + use co2_cycle, only: co2_init, co2_transport + use convect_deep, only: convect_deep_init + use convect_shallow, only: convect_shallow_init + use cam_diagnostics, only: diag_init + use gw_drag, only: gw_init + use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init + use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init + use radheat, only: radheat_init + use radiation, only: radiation_init + use cloud_diagnostics, only: cloud_diagnostics_init + use rk_stratiform, only: rk_stratiform_init + use wv_saturation, only: wv_sat_init + use microp_driver, only: microp_driver_init + use microp_aero, only: microp_aero_init + use macrop_driver, only: macrop_driver_init + use conv_water, only: conv_water_init + use spcam_drivers, only: spcam_init + use tracers, only: tracers_init + use aoa_tracers, only: aoa_tracers_init + use rayleigh_friction, only: rayleigh_friction_init + use pbl_utils, only: pbl_utils_init + use vertical_diffusion, only: vertical_diffusion_init + use phys_debug_util, only: phys_debug_init + use phys_debug, only: phys_debug_state_init + use rad_constituents, only: rad_cnst_init + use aer_rad_props, only: aer_rad_props_init + use subcol, only: subcol_init + use qbo, only: qbo_init + use qneg_module, only: qneg_init + use iondrag, only: iondrag_init, do_waccm_ions +#if ( defined OFFLINE_DYN ) + use metdata, only: metdata_phys_init +#endif + use epp_ionization, only: epp_ionization_init, epp_ionization_active + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X) + use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X) + use clubb_intr, only: clubb_ini_cam + use sslt_rebin, only: sslt_rebin_init + use tropopause, only: tropopause_init + use solar_data, only: solar_data_init + use dadadj_cam, only: dadadj_init + use cam_abortutils, only: endrun + + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk) + + ! local variables + integer :: lchnk + integer :: ierr + + !----------------------------------------------------------------------- + + call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) + + do lchnk = begchunk, endchunk + call physics_state_set_grid(lchnk, phys_state(lchnk)) + end do + + !------------------------------------------------------------------------------------------- + ! Initialize any variables in physconst which are not temporally and/or spatially constant + !------------------------------------------------------------------------------------------- + call physconst_init() + + ! Initialize debugging a physics column + call phys_debug_init() + + call pbuf_initialize(pbuf2d) + + ! Initialize subcol scheme + call subcol_init(pbuf2d) + + ! diag_init makes addfld calls for dynamics fields that are output from + ! the physics decomposition + call diag_init(pbuf2d) + + call check_energy_init() + + call tracers_init() + + ! age of air tracers + call aoa_tracers_init() + + teout_idx = pbuf_get_index( 'TEOUT') + + ! adiabatic or ideal physics should be only used if in simple_physics + if (adiabatic .or. ideal_phys) then + if (adiabatic) then + call endrun('phys_init: adiabatic configuration error') + else + call endrun('phys_init: ideal_phys configuration error') + end if + end if + + if (initial_run) then + call phys_inidat(cam_out, pbuf2d) + end if + + ! wv_saturation is relatively independent of everything else and + ! low level, so init it early. Must at least do this before radiation. + call wv_sat_init + + ! CAM3 prescribed aerosols + if (cam3_aero_data_on) call cam3_aero_data_init(phys_state) + + ! Initialize rad constituents and their properties + call rad_cnst_init() + call aer_rad_props_init() + + ! initialize carma + call carma_init() + + ! solar irradiance data modules + call solar_data_init() + + ! Prognostic chemistry. + call chem_init(phys_state,pbuf2d) + + ! Prescribed tracers + call prescribed_ozone_init() + call prescribed_ghg_init() + call prescribed_aero_init() + call aerodep_flx_init() + call aircraft_emit_init() + call prescribed_volcaero_init() + call prescribed_strataero_init() + + ! co2 cycle + if (co2_transport()) then + call co2_init() + end if + + ! CAM3 prescribed ozone + if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) + + call gw_init() + + call rayleigh_friction_init() + + call pbl_utils_init(gravit, karman, cpair, rair, zvir) + call vertical_diffusion_init(pbuf2d) + + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call waccmx_phys_mspd_init () + ! Initialization of ionosphere module if mode set to ionosphere + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_init(pbuf2d) + endif + endif + + call radiation_init(pbuf2d) + + call cloud_diagnostics_init() + + call radheat_init(pref_mid) + + call convect_shallow_init(pref_edge, pbuf2d) + + call cldfrc_init() + call cldfrc2m_init() + + call convect_deep_init(pref_edge) + + if( microp_scheme == 'RK' ) then + call rk_stratiform_init() + elseif( microp_scheme == 'MG' ) then + if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d) + call microp_aero_init() + call microp_driver_init(pbuf2d) + call conv_water_init + elseif( microp_scheme == 'SPCAM_m2005') then + call conv_water_init + end if + + + ! initiate CLUBB within CAM + if (do_clubb_sgs) call clubb_ini_cam(pbuf2d) + + call spcam_init(pbuf2d) + + call qbo_init + + call iondrag_init(pref_mid) + ! Geomagnetic module -- after iondrag_init + if (epp_ionization_active) then + call epp_ionization_init() + endif + +#if ( defined OFFLINE_DYN ) + call metdata_phys_init() +#endif + call sslt_rebin_init() + call tropopause_init() + call dadadj_init() + + prec_dp_idx = pbuf_get_index('PREC_DP') + snow_dp_idx = pbuf_get_index('SNOW_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') + snow_sh_idx = pbuf_get_index('SNOW_SH') + + dlfzm_idx = pbuf_get_index('DLFZM', ierr) + + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + + if (clim_modal_aero) then + + ! If climate calculations are affected by prescribed modal aerosols, the + ! the initialization routine for the dry mode radius calculation is called + ! here. For prognostic MAM the initialization is called from + ! modal_aero_initialize + if (.not. prog_modal_aero) then + call modal_aero_calcsize_init(pbuf2d) + endif + + call modal_aero_wateruptake_init(pbuf2d) + + end if + + ! Initialize qneg3 and qneg4 + call qneg_init() + + end subroutine phys_init + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! First part of atmospheric physics package before updating of surface models + ! + !----------------------------------------------------------------------- + use time_manager, only: get_nstep + use cam_diagnostics,only: diag_allocate, diag_physvar_ic + use check_energy, only: check_energy_gmean + use phys_control, only: phys_getopts + use spcam_drivers, only: tphysbc_spcam + use spmd_utils, only: mpicom + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate +#if (defined BFB_CAM_SCAM_IOP ) + use cam_history, only: outfld +#endif + use cam_abortutils, only: endrun +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_srf1 +#endif + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + type(cam_in_t), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), dimension(begchunk:endchunk) :: cam_out + !----------------------------------------------------------------------- + ! + !---------------------------Local workspace----------------------------- + ! + integer :: c ! indices + integer :: ncol ! number of columns + integer :: nstep ! current timestep number + logical :: use_spcam + type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) + + call t_startf ('physpkg_st1') + nstep = get_nstep() + +#if ( defined OFFLINE_DYN ) + ! + ! if offline mode set SNOWH and TS for micro-phys + ! + call get_met_srf1( cam_in ) +#endif + + ! The following initialization depends on the import state (cam_in) + ! being initialized. This isn't true when cam_init is called, so need + ! to postpone this initialization to here. + if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d) + + ! Compute total energy of input state and previous output state + call t_startf ('chk_en_gmean') + call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) + call t_stopf ('chk_en_gmean') + + call t_stopf ('physpkg_st1') + + call t_startf ('physpkg_st1') + + call pbuf_allocate(pbuf2d, 'physpkg') + call diag_allocate() + + !----------------------------------------------------------------------- + ! Advance time information + !----------------------------------------------------------------------- + + call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) + + call t_stopf ('physpkg_st1') + +#ifdef TRACER_CHECK + call gmean_mass ('before tphysbc DRY', phys_state) +#endif + + + !----------------------------------------------------------------------- + ! Tendency physics before flux coupler invocation + !----------------------------------------------------------------------- + ! + +#if (defined BFB_CAM_SCAM_IOP ) + do c=begchunk, endchunk + call outfld('Tg',cam_in(c)%ts,pcols ,c ) + end do +#endif + + call t_barrierf('sync_bc_physics', mpicom) + call t_startf ('bc_physics') + call t_adj_detailf(+1) + + call phys_getopts( use_spcam_out = use_spcam) + +!$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk) + do c=begchunk, endchunk + ! + ! Output physics terms to IC file + ! + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + + call t_startf ('diag_physvar_ic') + call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) ) + call t_stopf ('diag_physvar_ic') + + if (use_spcam) then + call tphysbc_spcam (ztodt, phys_state(c), & + phys_tend(c), phys_buffer_chunk, & + cam_out(c), cam_in(c) ) + else + call tphysbc (ztodt, phys_state(c), & + phys_tend(c), phys_buffer_chunk, & + cam_out(c), cam_in(c) ) + end if + + end do + + call t_adj_detailf(-1) + call t_stopf ('bc_physics') + + ! Don't call the rest in CRM mode + if(single_column.and.scm_crm_mode) return + +#ifdef TRACER_CHECK + call gmean_mass ('between DRY', phys_state) +#endif + + end subroutine phys_run1 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & + cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Second part of atmospheric physics package after updating of surface models + ! + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx + use mo_lightning, only: lightning_no_prod + use cam_diagnostics, only: diag_deallocate, diag_surf + use physconst, only: stebol, latvap + use carma_intr, only: carma_accumulate_stats + use spmd_utils, only: mpicom +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_srf2 +#endif + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d + + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + ! + !----------------------------------------------------------------------- + !---------------------------Local workspace----------------------------- + ! + integer :: c ! chunk index + integer :: ncol ! number of columns + type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk + ! + ! If exit condition just return + ! + + if(single_column.and.scm_crm_mode) return + + !----------------------------------------------------------------------- + ! Tendency physics after coupler + ! Not necessary at terminal timestep. + !----------------------------------------------------------------------- + ! +#if ( defined OFFLINE_DYN ) + ! + ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion + ! + call get_met_srf2( cam_in ) +#endif + ! Set lightning production of NO + call t_startf ('lightning_no_prod') + call lightning_no_prod( phys_state, pbuf2d, cam_in ) + call t_stopf ('lightning_no_prod') + + call t_barrierf('sync_ac_physics', mpicom) + call t_startf ('ac_physics') + call t_adj_detailf(+1) + +!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk) + + do c=begchunk,endchunk + ncol = get_ncols_p(c) + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + ! + ! surface diagnostics for history files + ! + call t_startf('diag_surf') + call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk) + call t_stopf('diag_surf') + + call tphysac(ztodt, cam_in(c), & + cam_out(c), & + phys_state(c), phys_tend(c), phys_buffer_chunk) + end do ! Chunk loop + + call t_adj_detailf(-1) + call t_stopf('ac_physics') + +#ifdef TRACER_CHECK + call gmean_mass ('after tphysac FV:WET)', phys_state) +#endif + + call t_startf ('carma_accumulate_stats') + call carma_accumulate_stats() + call t_stopf ('carma_accumulate_stats') + + call t_startf ('physpkg_st2') + call pbuf_deallocate(pbuf2d, 'physpkg') + + call pbuf_update_tim_idx() + call diag_deallocate() + call t_stopf ('physpkg_st2') + + end subroutine phys_run2 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_final( phys_state, phys_tend, pbuf2d ) + use physics_buffer, only : physics_buffer_desc, pbuf_deallocate + use chemistry, only : chem_final + use carma_intr, only : carma_final + use wv_saturation, only : wv_sat_final + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Finalization of physics package + ! + !----------------------------------------------------------------------- + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if(associated(pbuf2d)) then + call pbuf_deallocate(pbuf2d,'global') + deallocate(pbuf2d) + end if + deallocate(phys_state) + deallocate(phys_tend) + call chem_final + call carma_final + call wv_sat_final + + end subroutine phys_final + + + subroutine tphysac (ztodt, cam_in, & + cam_out, state, tend, pbuf) + !----------------------------------------------------------------------- + ! + ! Tendency physics after coupling to land, sea, and ice models. + ! + ! Computes the following: + ! + ! o Aerosol Emission at Surface + ! o Source-Sink for Advected Tracers + ! o Symmetric Turbulence Scheme - Vertical Diffusion + ! o Rayleigh Friction + ! o Dry Deposition of Aerosol + ! o Enforce Charge Neutrality ( Only for WACCM ) + ! o Gravity Wave Drag + ! o QBO Relaxation ( Only for WACCM ) + ! o Ion Drag ( Only for WACCM ) + ! o Scale Dry Mass Energy + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx + use shr_kind_mod, only: r8 => shr_kind_r8 + use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions + use cam_diagnostics, only: diag_phys_tend_writeout + use gw_drag, only: gw_tend + use vertical_diffusion, only: vertical_diffusion_tend + use rayleigh_friction, only: rayleigh_friction_tend + use constituents, only: cnst_get_ind + use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & + physics_dme_adjust, set_dry_to_wet, physics_state_check + use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X + use aoa_tracers, only: aoa_tracers_timestep_tend + use physconst, only: rhoh2o, latvap,latice + use aero_model, only: aero_model_drydep + use carma_intr, only: carma_emission_tend, carma_timestep_tend + use carma_flags_mod, only: carma_do_aerosol, carma_do_emission + use check_energy, only: check_energy_chng, calc_te_and_aam_budgets + use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng + use time_manager, only: get_nstep + use cam_abortutils, only: endrun + use dycore, only: dycore_is + use cam_control_mod, only: aqua_planet + use mo_gas_phase_chemdr,only: map2chm + use clybry_fam, only: clybry_fam_set + use charge_neutrality, only: charge_balance + use qbo, only: qbo_relax + use iondrag, only: iondrag_calc, do_waccm_ions + use perf_mod + use flux_avg, only: flux_avg_run + use unicon_cam, only: unicon_cam_org_diags + use cam_history, only: hist_fld_active + use qneg_module, only: qneg4 + ! + ! Arguments + ! + real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) + + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(inout) :: cam_out + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + + type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes + + ! + !---------------------------Local workspace----------------------------- + ! + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + + integer :: nstep ! current timestep number + real(r8) :: zero(pcols) ! array of zeros + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer i,k,m ! Longitude, level indices + integer :: yr, mon, day, tod ! components of a date + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + + logical :: labort ! abort flag + + real(r8) tvm(pcols,pver) ! virtual temperature + real(r8) prect(pcols) ! total precipitation + real(r8) surfric(pcols) ! surface friction velocity + real(r8) obklen(pcols) ! Obukhov length + real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry + real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. + real(r8) :: tmp_q (pcols,pver) ! tmp space + real(r8) :: tmp_cldliq(pcols,pver) ! tmp space + real(r8) :: tmp_cldice(pcols,pver) ! tmp space + real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space + real(r8) :: tmp_pdel (pcols,pver) ! tmp space + real(r8) :: tmp_ps (pcols) ! tmp space + + ! physics buffer fields for total energy and mass adjustment + integer itim_old, ifld + + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:,:) :: qini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction + + !----------------------------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + + ! Adjust the surface fluxes to reduce instabilities in near sfc layer + if (phys_do_flux_avg()) then + call flux_avg_run(state, cam_in, pbuf, nstep, ztodt) + endif + + ! Validate the physics state. + if (state_debug_checks) & + call physics_state_check(state, name="before tphysac") + + call t_startf('tphysac_init') + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + + + ifld = pbuf_get_index('DTCORE') + call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qini_idx, qini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) + + ifld = pbuf_get_index('AST') + call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ! + ! accumulate fluxes into net flux array for spectral dycores + ! jrm Include latent heat of fusion for snow + ! + do i=1,ncol + tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) & + + cam_out%precl(i))*latvap*rhoh2o & + + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o + end do + + ! emissions of aerosols and gas-phase chemistry constituents at surface + call chem_emissions( state, cam_in ) + + if (carma_do_emission) then + ! carma emissions + call carma_emission_tend (state, ptend, cam_in, ztodt) + call physics_update(state, ptend, ztodt, tend) + end if + + ! get nstep and zero array for energy checker + zero = 0._r8 + nstep = get_nstep() + call check_tracers_init(state, tracerint) + + ! Check if latent heat flux exceeds the total moisture content of the + ! lowest model layer, thereby creating negative moisture. + + call qneg4('TPHYSAC', lchnk, ncol, ztodt , & + state%q(1,pver,1), state%rpdel(1,pver), & + cam_in%shf, cam_in%lhf, cam_in%cflx) + + call t_stopf('tphysac_init') + !=================================================== + ! Source/sink terms for advected tracers. + !=================================================== + call t_startf('adv_tracer_src_snk') + ! Test tracers + + call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call physics_update(state, ptend, ztodt, tend) + call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, & + cam_in%cflx) + + !=================================================== + ! Chemistry and MAM calculation + ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'. + ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and + ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before + ! Gas chemistry and MAM core aerosol conversion. + ! Note that surface flux is not added into the atmosphere, but elevated emission is + ! added into the atmosphere as tendency. + !=================================================== + if (chem_is_active()) then + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & + pbuf, fh2o=fh2o) + + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero) + call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, & + cam_in%cflx) + end if + call t_stopf('adv_tracer_src_snk') + + !=================================================== + ! Vertical diffusion/pbl calculation + ! Call vertical diffusion code (pbl, free atmosphere and molecular) + !=================================================== + + call t_startf('vertical_diffusion_tend') + call vertical_diffusion_tend (ztodt ,state , cam_in, & + surfric ,obklen ,ptend ,ast ,pbuf ) + + !------------------------------------------ + ! Call major diffusion for extended model + !------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call waccmx_phys_mspd_tend (ztodt ,state ,ptend) + endif + + call physics_update(state, ptend, ztodt, tend) + + call t_stopf ('vertical_diffusion_tend') + + !=================================================== + ! Rayleigh friction calculation + !=================================================== + call t_startf('rayleigh_friction') + call rayleigh_friction_tend( ztodt, state, ptend) + call physics_update(state, ptend, ztodt, tend) + call t_stopf('rayleigh_friction') + + if (do_clubb_sgs) then + call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) + else + call check_energy_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, & + zero, cam_in%shf) + endif + + call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx) + + ! aerosol dry deposition processes + call t_startf('aero_drydep') + call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend ) + call physics_update(state, ptend, ztodt, tend) + call t_stopf('aero_drydep') + + ! CARMA microphysics + ! + ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing the dry + ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, so that + ! obklen and surfric have been calculated. It needs to follow aero_model_drydep, so + ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out + ! can be added to for CARMA aerosols. + if (carma_do_aerosol) then + call t_startf('carma_timestep_tend') + call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) + call physics_update(state, ptend, ztodt, tend) + + call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) + call t_stopf('carma_timestep_tend') + end if + + + !--------------------------------------------------------------------------------- + ! ... enforce charge neutrality + !--------------------------------------------------------------------------------- + call charge_balance(state, pbuf) + + !=================================================== + ! Gravity wave drag + !=================================================== + call t_startf('gw_tend') + + call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat) + + call physics_update(state, ptend, ztodt, tend) + ! Check energy integrals + call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, & + zero, zero, flx_heat) + call t_stopf('gw_tend') + + ! QBO relaxation + call qbo_relax(state, pbuf, ptend) + call physics_update(state, ptend, ztodt, tend) + ! Check energy integrals + call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) + + ! Ion drag calculation + call t_startf ( 'iondrag' ) + + if ( do_waccm_ions ) then + call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt ) + else + call iondrag_calc( lchnk, ncol, state, ptend) + endif + !---------------------------------------------------------------------------- + ! Call ionosphere routines for extended model if mode is set to ionosphere + !---------------------------------------------------------------------------- + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) + endif + + call physics_update(state, ptend, ztodt, tend) + call calc_te_and_aam_budgets(state, 'pAP') + + !--------------------------------------------------------------------------------- + ! Enforce charge neutrality after O+ change from ionos_tend + !--------------------------------------------------------------------------------- + if( waccmx_is('ionosphere') ) then + call charge_balance(state, pbuf) + endif + + ! Check energy integrals + call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) + + call t_stopf ( 'iondrag' ) + + !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv + + ! Save total energy for global fixer in next timestep (FV and SE dycores) + call pbuf_set_field(pbuf, teout_idx, state%te_cur, (/1,itim_old/),(/pcols,1/)) + + if (shallow_scheme .eq. 'UNICON') then + + ! ------------------------------------------------------------------------ + ! Insert the organization-related heterogeneities computed inside the + ! UNICON into the tracer arrays here before performing advection. + ! This is necessary to prevent any modifications of organization-related + ! heterogeneities by non convection-advection process, such as + ! dry and wet deposition of aerosols, MAM, etc. + ! Again, note that only UNICON and advection schemes are allowed to + ! changes to organization at this stage, although we can include the + ! effects of other physical processes in future. + ! ------------------------------------------------------------------------ + + call unicon_cam_org_diags(state, pbuf) + + end if + ! + ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust + ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. + if ( dycore_is('LR')) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist + + ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) + tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + ! For 'SE', physics_dme_adjust is called for energy diagnostic purposes only. So, save off tracers + if (dycore_is('SE').and.hist_fld_active('SE_pAM').or.hist_fld_active('KE_pAM').or.hist_fld_active('WV_pAM').or.& + hist_fld_active('WL_pAM').or.hist_fld_active('WI_pAM')) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + ! + ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE + ! we do not reset them to pre-dme_adjust values + ! + if (dycore_is('SE')) call set_dry_to_wet(state) + call physics_dme_adjust(state, tend, qini, ztodt) + call calc_te_and_aam_budgets(state, 'pAM') + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) + end if + + if (dycore_is('LR')) call physics_dme_adjust(state, tend, qini, ztodt) + +!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS +!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero) + + ! store T in buffer for use in computing dynamics T-tendency in next timestep + do k = 1,pver + dtcore(:ncol,k) = state%t(:ncol,k) + end do + + !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + + if (aqua_planet) then + labort = .false. + do i=1,ncol + if (cam_in%ocnfrac(i) /= 1._r8) labort = .true. + end do + if (labort) then + call endrun ('TPHYSAC error: grid contains non-ocean point') + endif + endif + + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & + qini, cldliqini, cldiceini) + + call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) + + end subroutine tphysac + + subroutine tphysbc (ztodt, state, & + tend, pbuf, & + cam_out, cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Evaluate and apply physical processes that are calculated BEFORE + ! coupling to land, sea, and ice models. + ! + ! Processes currently included are: + ! + ! o Resetting Negative Tracers to Positive + ! o Global Mean Total Energy Fixer + ! o Dry Adjustment + ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection + ! o Stratiform Macro-Microphysics + ! o Wet Scavenging of Aerosol + ! o Radiation + ! + ! Method: + ! + ! Each parameterization should be implemented with this sequence of calls: + ! 1) Call physics interface + ! 2) Check energy + ! 3) Call physics_update + ! See Interface to Column Physics and Chemistry Packages + ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx + use physics_buffer, only: col_type_subcol, dyn_time_lvls + use shr_kind_mod, only: r8 => shr_kind_r8 + + use dadadj_cam, only: dadadj_tend + use rk_stratiform, only: rk_stratiform_tend + use microp_driver, only: microp_driver_tend + use microp_aero, only: microp_aero_run + use macrop_driver, only: macrop_driver_tend + use physics_types, only: physics_state, physics_tend, physics_ptend, & + physics_update, physics_ptend_init, physics_ptend_sum, & + physics_state_check, physics_ptend_scale + use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write + use cam_history, only: outfld + use physconst, only: cpair, latvap + use constituents, only: pcnst, qmin, cnst_get_ind + use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans + use time_manager, only: is_first_step, get_nstep + use convect_shallow, only: convect_shallow_tend + use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init + use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng + use check_energy, only: calc_te_and_aam_budgets + use dycore, only: dycore_is + use aero_model, only: aero_model_wetdep + use carma_intr, only: carma_wetdep_tend, carma_timestep_tend + use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep + use radiation, only: radiation_tend + use cloud_diagnostics, only: cloud_diagnostics_calc + use perf_mod + use mo_gas_phase_chemdr,only: map2chm + use clybry_fam, only: clybry_fam_adj + use clubb_intr, only: clubb_tend_cam + use sslt_rebin, only: sslt_rebin_adv + use tropopause, only: tropopause_output + use cam_abortutils, only: endrun + use subcol, only: subcol_gen, subcol_ptend_avg + use subcol_utils, only: subcol_ptend_copy, is_subcol_on + use qneg_module, only: qneg3 + + ! Arguments + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + + + ! + !---------------------------Local workspace----------------------------- + ! + + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + type(physics_state) :: state_sc ! state for sub-columns + type(physics_ptend) :: ptend_sc ! ptend for sub-columns + type(physics_ptend) :: ptend_aero ! ptend for microp_aero + type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns + type(physics_tend) :: tend_sc ! tend for sub-columns + + integer :: nstep ! current timestep number + + real(r8) :: net_flx(pcols) + + real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection + real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c + + real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation + + real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections + real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections + real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + + integer :: i ! column indicex + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + ! for macro/micro co-substepping + integer :: macmic_it ! iteration variables + real(r8) :: cld_macmic_ztodt ! modified timestep + ! physics buffer fields to compute tendencies for stratiform package + integer itim_old, ifld + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + + + ! physics buffer fields for total energy and mass adjustment + real(r8), pointer, dimension(: ) :: teout + real(r8), pointer, dimension(:,:) :: qini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: dtcore + + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + + ! convective precipitation variables + real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection + real(r8),pointer :: snow_dp(:) ! snow from ZM convection + real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection + real(r8),pointer :: snow_sh(:) ! snow from Hack convection + + ! carma precipitation variables + real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) + real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) + + ! stratiform precipitation variables + real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) + real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s) + real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns + real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns + real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme + real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme + real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation + real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation + + ! Local copies for substepping + real(r8) :: prec_pcw_macmic(pcols) + real(r8) :: snow_pcw_macmic(pcols) + real(r8) :: prec_sed_macmic(pcols) + real(r8) :: snow_sed_macmic(pcols) + + ! energy checking variables + real(r8) :: zero(pcols) ! array of zeros + real(r8) :: zero_sc(pcols*psubcols) ! array of zeros + real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice) + real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme + real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice + real(r8) :: det_ice(pcols) ! vertical integral of detrained ice + real(r8) :: flx_cnd(pcols) + real(r8) :: flx_heat(pcols) + type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes + real(r8) :: zero_tracers(pcols,pcnst) + + logical :: lq(pcnst) + !----------------------------------------------------------------------- + + call t_startf('bc_init') + + zero = 0._r8 + zero_tracers(:,:) = 0._r8 + zero_sc(:) = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) + + call pbuf_get_field(pbuf, qini_idx, qini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + + ifld = pbuf_get_index('DTCORE') + call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ifld = pbuf_get_index('FRACIS') + call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + fracis (:ncol,:,1:pcnst) = 1._r8 + + ! Set physics tendencies to 0 + tend %dTdt(:ncol,:pver) = 0._r8 + tend %dudt(:ncol,:pver) = 0._r8 + tend %dvdt(:ncol,:pver) = 0._r8 + + ! Verify state coming from the dynamics + if (state_debug_checks) & + call physics_state_check(state, name="before tphysbc (dycore?)") + + call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf ) + + ! Since clybry_fam_adj operates directly on the tracers, and has no + ! physics_update call, re-run qneg3. + + call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,state%q ) + + ! Validate output of clybry_fam_adj. + if (state_debug_checks) & + call physics_state_check(state, name="clybry_fam_adj") + + ! + ! Dump out "before physics" state + ! + call diag_state_b4_phys_write (state) + + ! compute mass integrals of input tracers state + call check_tracers_init(state, tracerint) + + call t_stopf('bc_init') + + !=================================================== + ! Global mean total energy fixer + !=================================================== + call t_startf('energy_fixer') + + call calc_te_and_aam_budgets(state, 'pBF') + if (dycore_is('LR') .or. dycore_is('SE')) then + call check_energy_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call outfld( 'EFIX', flx_heat , pcols, lchnk ) + end if + call calc_te_and_aam_budgets(state, 'pBP') + ! Save state for convective tendency calculations. + call diag_conv_tend_ini(state, pbuf) + + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + + call outfld('TEOUT', teout , pcols, lchnk ) + call outfld('TEINP', state%te_ini, pcols, lchnk ) + call outfld('TEFIX', state%te_cur, pcols, lchnk ) + + ! T tendency due to dynamics + if( nstep > dyn_time_lvls-1 ) then + dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt + call outfld( 'DTCORE', dtcore, pcols, lchnk ) + end if + + call t_stopf('energy_fixer') + ! + !=================================================== + ! Dry adjustment + !=================================================== + call t_startf('dry_adjustment') + + call dadadj_tend(ztodt, state, ptend) + + call physics_update(state, ptend, ztodt, tend) + + call t_stopf('dry_adjustment') + + !=================================================== + ! Moist convection + !=================================================== + call t_startf('moist_convection') + + call t_startf ('convect_deep_tend') + + call convect_deep_tend( & + cmfmc, cmfcme, & + pflx, zdu, & + rliq, rice, & + ztodt, & + state, ptend, cam_in%landfrac, pbuf) + + call physics_update(state, ptend, ztodt, tend) + + call t_stopf('convect_deep_tend') + + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + call pbuf_get_field(pbuf, prec_str_idx, prec_str ) + call pbuf_get_field(pbuf, snow_str_idx, snow_str ) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed ) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed ) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw ) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw ) + + if (use_subcol_microp) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol) + end if + + ! Check energy integrals, including "reserved liquid" + flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol) + snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol) + call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero) + snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol) + + ! + ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection + ! + call t_startf ('convect_shallow_tend') + + if (dlfzm_idx > 0) then + call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) + dlf(:ncol,:) = dlfzm(:ncol,:) + else + dlf(:,:) = 0._r8 + end if + + call convect_shallow_tend (ztodt , cmfmc, & + dlf , dlf2 , rliq , rliq2, & + state , ptend , pbuf, cam_in) + call t_stopf ('convect_shallow_tend') + + call physics_update(state, ptend, ztodt, tend) + + flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol) + call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero) + + call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers) + + call t_stopf('moist_convection') + + ! Rebin the 4-bin version of sea salt into bins for coarse and accumulation + ! modes that correspond to the available optics data. This is only necessary + ! for CAM-RT. But it's done here so that the microphysics code which is called + ! from the stratiform interface has access to the same aerosols as the radiation + ! code. + call sslt_rebin_adv(pbuf, state) + + !=================================================== + ! Calculate tendencies from CARMA bin microphysics. + !=================================================== + ! + ! If CARMA is doing detrainment, then on output, rliq no longer represents water reserved + ! for detrainment, but instead represents potential snow fall. The mass and number of the + ! snow are stored in the physics buffer and will be incorporated by the MG microphysics. + ! + ! Currently CARMA cloud microphysics is only supported with the MG microphysics. + call t_startf('carma_timestep_tend') + + if (carma_do_cldice .or. carma_do_cldliq) then + call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & + prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) + call physics_update(state, ptend, ztodt, tend) + + ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing + ! detrainment, then the reserved condensate is snow. + if (carma_do_detrain) then + call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero) + else + call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) + end if + end if + + call t_stopf('carma_timestep_tend') + + if( microp_scheme == 'RK' ) then + + !=================================================== + ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics ) + !=================================================== + call t_startf('rk_stratiform_tend') + + call rk_stratiform_tend(state, ptend, pbuf, ztodt, & + cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, & + cam_in%snowhland, & ! sediment + dlf, dlf2, & ! detrain + rliq , & ! check energy after detrain + cmfmc, & + cam_in%ts, cam_in%sst, zdu) + + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero) + + call t_stopf('rk_stratiform_tend') + + elseif( microp_scheme == 'MG' ) then + ! Start co-substepping of macrophysics and microphysics + cld_macmic_ztodt = ztodt/cld_macmic_num_steps + + ! Clear precip fields that should accumulate. + prec_sed_macmic = 0._r8 + snow_sed_macmic = 0._r8 + prec_pcw_macmic = 0._r8 + snow_pcw_macmic = 0._r8 + + do macmic_it = 1, cld_macmic_num_steps + + !=================================================== + ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction) + !=================================================== + + call t_startf('macrop_tend') + + ! don't call Park macrophysics if CLUBB is called + if (macrop_scheme .ne. 'CLUBB_SGS') then + + call macrop_driver_tend( & + state, ptend, cld_macmic_ztodt, & + cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment + dlf, dlf2, & ! detrain + cmfmc, & + cam_in%ts, cam_in%sst, zdu, & + pbuf, det_s, det_ice) + + ! Since we "added" the reserved liquid back in this routine, we need + ! to account for it in the energy checker + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + flx_heat(:ncol) = det_s(:ncol) + + ! Unfortunately, physics_update does not know what time period + ! "tend" is supposed to cover, and therefore can't update it + ! with substeps correctly. For now, work around this by scaling + ! ptend down by the number of substeps, then applying it for + ! the full time (ztodt). + call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, & + zero, flx_cnd(:ncol)/cld_macmic_num_steps, & + det_ice(:ncol)/cld_macmic_num_steps, & + flx_heat(:ncol)/cld_macmic_num_steps) + + else ! Calculate CLUBB macrophysics + + ! ===================================================== + ! CLUBB call (PBL, shallow convection, macrophysics) + ! ===================================================== + + call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& + cmfmc, cam_in, macmic_it, cld_macmic_num_steps, & + dlf, det_s, det_ice) + + ! Since we "added" the reserved liquid back in this routine, we need + ! to account for it in the energy checker + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) + + ! Unfortunately, physics_update does not know what time period + ! "tend" is supposed to cover, and therefore can't update it + ! with substeps correctly. For now, work around this by scaling + ! ptend down by the number of substeps, then applying it for + ! the full time (ztodt). + call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) + + ! Update physics tendencies and copy state to state_eq, because that is + ! input for microphysics + call physics_update(state, ptend, ztodt, tend) + + ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code + call check_energy_chng(state, tend, "clubb_tend", nstep, ztodt, & + cam_in%cflx(:ncol,1)/cld_macmic_num_steps, & + flx_cnd(:ncol)/cld_macmic_num_steps, & + det_ice(:ncol)/cld_macmic_num_steps, & + flx_heat(:ncol)/cld_macmic_num_steps) + + endif + + call t_stopf('macrop_tend') + + !=================================================== + ! Calculate cloud microphysics + !=================================================== + + if (is_subcol_on()) then + ! Allocate sub-column structures. + call physics_state_alloc(state_sc, lchnk, psubcols*pcols) + call physics_tend_alloc(tend_sc, psubcols*pcols) + + ! Generate sub-columns using the requested scheme + call subcol_gen(state, tend, state_sc, tend_sc, pbuf) + + !Initialize check energy for subcolumns + call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol) + end if + + call t_startf('microp_aero_run') + call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) + call t_stopf('microp_aero_run') + + call t_startf('microp_tend') + + if (use_subcol_microp) then + call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) + + ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero + call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend) + + ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend + call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc) + call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol) + call physics_ptend_dealloc(ptend_aero_sc) + + ! Have to scale and apply for full timestep to get tend right + ! (see above note for macrophysics). + call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol) + + call physics_update (state_sc, ptend_sc, ztodt, tend_sc) + call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", & + nstep, ztodt, zero_sc, & + prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, & + snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc) + + call physics_state_dealloc(state_sc) + call physics_tend_dealloc(tend_sc) + call physics_ptend_dealloc(ptend_sc) + else + call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + end if + ! combine aero and micro tendencies for the grid + call physics_ptend_sum(ptend_aero, ptend, ncol) + call physics_ptend_dealloc(ptend_aero) + + ! Have to scale and apply for full timestep to get tend right + ! (see above note for macrophysics). + call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) + + call physics_update (state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, & + zero, prec_str(:ncol)/cld_macmic_num_steps, & + snow_str(:ncol)/cld_macmic_num_steps, zero) + + call t_stopf('microp_tend') + prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol) + snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol) + prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol) + snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol) + + end do ! end substepping over macrophysics/microphysics + + prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps + snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps + prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps + snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps + prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) + snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) + + endif + + ! Add the precipitation from CARMA to the precipitation from stratiform. + if (carma_do_cldice .or. carma_do_cldliq) then + prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol) + snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol) + end if + + if ( .not. deep_scheme_does_scav_trans() ) then + + ! ------------------------------------------------------------------------------- + ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation. + ! 2. Convective Transport of Non-Water Aerosol Species. + ! + ! . Aerosol wet chemistry determines scavenging fractions, and transformations + ! . Then do convective transport of all trace species except qv,ql,qi. + ! . We needed to do the scavenging first to determine the interstitial fraction. + ! . When UNICON is used as unified convection, we should still perform + ! wet scavenging but not 'convect_deep_tend2'. + ! ------------------------------------------------------------------------------- + + call t_startf('bc_aerosols') + if (clim_modal_aero .and. .not. prog_modal_aero) then + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif + call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) + call physics_update(state, ptend, ztodt, tend) + + + if (carma_do_wetdep) then + ! CARMA wet deposition + ! + ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx + ! fields have already been set for CAM aerosols and cam_out can be added + ! to for CARMA aerosols. + call t_startf ('carma_wetdep_tend') + call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) + call physics_update(state, ptend, ztodt, tend) + call t_stopf ('carma_wetdep_tend') + end if + + call t_startf ('convect_deep_tend2') + call convect_deep_tend_2( state, ptend, ztodt, pbuf ) + call physics_update(state, ptend, ztodt, tend) + call t_stopf ('convect_deep_tend2') + + ! check tracer integrals + call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) + + call t_stopf('bc_aerosols') + + endif + + !=================================================== + ! Moist physical parameteriztions complete: + ! send dynamical variables, and derived variables to history file + !=================================================== + + call t_startf('bc_history_write') + call diag_phys_writeout(state, cam_out%psl) + call diag_conv(state, ztodt, pbuf) + + call t_stopf('bc_history_write') + + !=================================================== + ! Write cloud diagnostics on history file + !=================================================== + + call t_startf('bc_cld_diag_history_write') + + call cloud_diagnostics_calc(state, pbuf) + + call t_stopf('bc_cld_diag_history_write') + + !=================================================== + ! Radiation computations + !=================================================== + call t_startf('radiation') + + + call radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx) + + ! Set net flux used by spectral dycores + do i=1,ncol + tend%flx_net(i) = net_flx(i) + end do + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) + + call t_stopf('radiation') + + ! Diagnose the location of the tropopause and its location to the history file(s). + call t_startf('tropopause') + call tropopause_output(state) + call t_stopf('tropopause') + + ! Save atmospheric fields to force surface models + call t_startf('cam_export') + call cam_export (state,cam_out,pbuf) + call t_stopf('cam_export') + + ! Write export state to history file + call t_startf('diag_export') + call diag_export(cam_out) + call t_stopf('diag_export') + + end subroutine tphysbc + +subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) +!----------------------------------------------------------------------------------- +! +! Purpose: The place for parameterizations to call per timestep initializations. +! Generally this is used to update time interpolated fields from boundary +! datasets. +! +!----------------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use chemistry, only: chem_timestep_init + use chem_surfvals, only: chem_surfvals_set + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use carma_intr, only: carma_timestep_init + use ghg_data, only: ghg_data_timestep_init + use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init + use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init + use aoa_tracers, only: aoa_tracers_timestep_init + use vertical_diffusion, only: vertical_diffusion_ts_init + use radheat, only: radheat_timestep_init + use solar_data, only: solar_data_advance + use qbo, only: qbo_timestep_init + use iondrag, only: do_waccm_ions, iondrag_timestep_init + use perf_mod + + use prescribed_ozone, only: prescribed_ozone_adv + use prescribed_ghg, only: prescribed_ghg_adv + use prescribed_aero, only: prescribed_aero_adv + use aerodep_flx, only: aerodep_flx_adv + use aircraft_emit, only: aircraft_emit_adv + use prescribed_volcaero, only: prescribed_volcaero_adv + use prescribed_strataero,only: prescribed_strataero_adv + use mo_apex, only: mo_apex_init + use epp_ionization, only: epp_ionization_active + use iop_forcing, only: scam_use_iop_srf + + implicit none + + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------------- + + if (single_column) call scam_use_iop_srf(cam_in) + + ! update geomagnetic coordinates + if (epp_ionization_active .or. do_waccm_ions) then + call mo_apex_init(phys_state) + endif + + ! Chemistry surface values + call chem_surfvals_set() + + ! Solar irradiance + call solar_data_advance() + + ! Time interpolate for chemistry. + call chem_timestep_init(phys_state, pbuf2d) + + ! Prescribed tracers + call prescribed_ozone_adv(phys_state, pbuf2d) + call prescribed_ghg_adv(phys_state, pbuf2d) + call prescribed_aero_adv(phys_state, pbuf2d) + call aircraft_emit_adv(phys_state, pbuf2d) + call prescribed_volcaero_adv(phys_state, pbuf2d) + call prescribed_strataero_adv(phys_state, pbuf2d) + + ! prescribed aerosol deposition fluxes + call aerodep_flx_adv(phys_state, pbuf2d, cam_out) + + ! CAM3 prescribed aerosol masses + if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state) + + ! CAM3 prescribed ozone data + if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state) + + ! Time interpolate data models of gasses in pbuf2d + call ghg_data_timestep_init(pbuf2d, phys_state) + + ! Upper atmosphere radiative processes + call radheat_timestep_init(phys_state, pbuf2d) + + ! Time interpolate for vertical diffusion upper boundary condition + call vertical_diffusion_ts_init(pbuf2d, phys_state) + + !---------------------------------------------------------------------- + ! update QBO data for this time step + !---------------------------------------------------------------------- + call qbo_timestep_init + + call iondrag_timestep_init() + + call carma_timestep_init() + + ! age of air tracers + call aoa_tracers_timestep_init(phys_state) + +end subroutine phys_timestep_init + +end module physpkg diff --git a/src/physics/cam/pkg_cld_sediment.F90 b/src/physics/cam/pkg_cld_sediment.F90 new file mode 100644 index 0000000000..665a22bc26 --- /dev/null +++ b/src/physics/cam/pkg_cld_sediment.F90 @@ -0,0 +1,784 @@ +#undef OLDLIQSED +module pkg_cld_sediment + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Contains routines to compute tendencies from sedimentation of cloud liquid and +! ice particles +! +! Author: Byron Boville Sept 19, 2002 from code by P. J. Rasch +! +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use physconst, only: gravit, latvap, latice, rair, rhoh2o + use cldwat, only: icritc + use pkg_cldoptics, only: reitab, reltab + use phys_control, only: use_simple_phys + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + private + save + + public :: cld_sediment_readnl, cld_sediment_vel, cld_sediment_tend + + + real (r8), parameter :: vland = 1.5_r8 ! liquid fall velocity over land (cm/s) + real (r8), parameter :: vocean = 2.8_r8 ! liquid fall velocity over ocean (cm/s) + real (r8), parameter :: mxsedfac = 0.99_r8 ! maximum sedimentation flux factor + + logical, parameter :: stokes = .true. ! use Stokes velocity instead of McFarquhar and Heymsfield + +! parameter for modified McFarquhar and Heymsfield + real (r8), parameter :: vice_small = 1._r8 ! ice fall velocity for small concentration (cm/s) + +! parameters for Stokes velocity + real (r8), parameter :: eta = 1.7e-5_r8 ! viscosity of air (kg m / s) + real (r8), parameter :: r40 = 40._r8 ! 40 micron radius + real (r8), parameter :: r400= 400._r8 ! 400 micron radius + real (r8), parameter :: v400= 1.00_r8 ! fall velocity of 400 micron sphere (m/s) + real (r8) :: v40 ! = (2._r8/9._r8) * rhoh2o * gravit/eta * r40**2 * 1.e-12_r8 + ! Stokes fall velocity of 40 micron sphere (m/s) + real (r8) :: vslope ! = (v400 - v40)/(r400 -r40) ! linear slope for large particles m/s/micron + + ! namelist variables + real(r8) :: cldsed_ice_stokes_fac = huge(1._r8) ! factor applied to the ice fall velocity computed from + ! stokes terminal velocity + +!=============================================================================== +contains +!=============================================================================== + +subroutine cld_sediment_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cld_sediment_readnl' + + namelist /cldsed_nl/ cldsed_ice_stokes_fac + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'cldsed_nl', status=ierr) + if (ierr == 0) then + read(unitn, cldsed_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(cldsed_ice_stokes_fac, 1, mpir8, 0, mpicom) +#endif + + if (masterproc .and. .not. use_simple_phys) then + write(iulog,*) subname//': cldsed_ice_stokes_fac = ', cldsed_ice_stokes_fac + end if + +end subroutine cld_sediment_readnl + +!=============================================================================== + + subroutine cld_sediment_vel (ncol, & + icefrac , landfrac, ocnfrac , pmid , pdel , t , & + cloud , cldliq , cldice , pvliq , pvice , landm, snowh) + +!---------------------------------------------------------------------- + +! Compute gravitational sedimentation velocities for cloud liquid water +! and ice, based on Lawrence and Crutzen (1998). + +! LIQUID + +! The fall velocities assume that droplets have a gamma distribution +! with effective radii for land and ocean as assessed by Han et al.; +! see Lawrence and Crutzen (1998) for a derivation. + +! ICE + +! The fall velocities are based on data from McFarquhar and Heymsfield +! or on Stokes terminal velocity for spheres and the effective radius. + +! NEED TO BE CAREFUL - VELOCITIES SHOULD BE AT THE *LOWER* INTERFACE +! (THAT IS, FOR K+1), FLUXES ARE ALSO AT THE LOWER INTERFACE (K+1), +! BUT MIXING RATIOS ARE AT THE MIDPOINTS (K)... + +! NOTE THAT PVEL IS ON PVERP (INTERFACES), WHEREAS VFALL IS FOR THE CELL +! AVERAGES (I.E., MIDPOINTS); ASSUME THE FALL VELOCITY APPLICABLE TO THE +! LOWER INTERFACE (K+1) IS THE SAME AS THAT APPLICABLE FOR THE CELL (V(K)) + +!----------------------------------------------------------------------- +! MATCH-MPIC version 2.0, Author: mgl, March 1998 +! adapted by P. J. Rasch +! B. A. Boville, September 19, 2002 +! P. J. Rasch May 22, 2003 (added stokes flow calc for liquid +! drops based on effect radii) +!----------------------------------------------------------------------- + + +! Arguments + integer, intent(in) :: ncol ! number of colums to process + + real(r8), intent(in) :: icefrac (pcols) ! sea ice fraction (fraction) + real(r8), intent(in) :: landfrac(pcols) ! land fraction (fraction) + real(r8), intent(in) :: ocnfrac (pcols) ! ocean fraction (fraction) + real(r8), intent(in) :: pmid (pcols,pver) ! pressure of midpoint levels (Pa) + real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa) + real(r8), intent(in) :: cloud (pcols,pver) ! cloud fraction (fraction) + real(r8), intent(in) :: t (pcols,pver) ! temperature (K) + real(r8), intent(in) :: cldliq(pcols,pver) ! cloud water, liquid (kg/kg) + real(r8), intent(in) :: cldice(pcols,pver) ! cloud water, ice (kg/kg) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) + + real(r8), intent(out) :: pvliq (pcols,pverp) ! vertical velocity of cloud liquid drops (Pa/s) + real(r8), intent(out) :: pvice (pcols,pverp) ! vertical velocity of cloud ice particles (Pa/s) + real(r8), intent(in) :: landm(pcols) ! land fraction ramped over water +! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1)) + +! Local variables + real (r8) :: rho(pcols,pver) ! air density in kg/m3 + real (r8) :: vfall ! settling velocity of cloud particles (m/s) + real (r8) :: icice ! in cloud ice water content (kg/kg) + real (r8) :: iciwc ! in cloud ice water content in g/m3 + real (r8) :: icefac + real (r8) :: logiwc + + real (r8) :: rei(pcols,pver) ! effective radius of ice particles (microns) + real (r8) :: rel(pcols,pver) ! effective radius of liq particles (microns) + real(r8) pvliq2 (pcols,pverp) ! vertical velocity of cloud liquid drops (Pa/s) + + integer i,k + + real (r8) :: lbound, ac, bc, cc + +!----------------------------------------------------------------------- +!------- initialize linear ramp variables for fall velocity ------------ +!----------------------------------------------------------------------- + + v40 = (2._r8/9._r8) * rhoh2o * gravit/eta * r40**2 * 1.e-12_r8 + vslope = (v400 - v40)/(r400 -r40) + +!----------------------------------------------------------------------- +!--------------------- liquid fall velocity ---------------------------- +!----------------------------------------------------------------------- + + ! compute air density + rho(:ncol,:) = pmid(:ncol,:) / (rair * t(:ncol,:)) + + pvliq(:ncol,:) = 0._r8 + + ! get effective radius of liquid drop + call reltab(ncol, t, landfrac, landm, icefrac, rel, snowh) + + do k = 1,pver + do i = 1,ncol + if (cloud(i,k) > 0._r8 .and. cldliq(i,k) > 0._r8) then + +#ifdef OLDLIQSED +! oldway + ! merge the liquid fall velocities for land and ocean (cm/s) + ! SHOULD ALSO ACCOUNT FOR ICEFRAC + vfall = vland*landfrac(i) + vocean*(1._r8-landfrac(i)) +!!$ vfall = vland*landfrac(i) + vocean*ocnfrac(i) + vseaice*icefrac(i) + + ! convert the fall speed to pressure units, but do not apply the traditional + ! negative convention for pvel. + pvliq(i,k+1) = vfall & + * 0.01_r8 & ! cm to meters + * rho(i,k)*gravit ! meters/sec to pascals/sec +#else + +! newway + if (rel(i,k) < 40._r8 ) then + vfall = 2._r8/9._r8 * rhoh2o * gravit * rel(i,k)**2 / eta * 1.e-12_r8 ! micons^2 -> m^2 + else + vfall = v40 + vslope * (rel(i,k)-r40) ! linear above 40 microns + end if + ! convert the fall speed to pressure units + ! but do not apply the traditional + ! negative convention for pvel. +! pvliq2(i,k+1) = vfall * rho(i,k)*gravit ! meters/sec to pascals/sec + pvliq(i,k+1) = vfall * rho(i,k)*gravit ! meters/sec to pascals/sec +#endif + end if + end do + end do + + !----------------------------------------------------------------------- + !--------------------- ice fall velocity ------------------------------- + !----------------------------------------------------------------------- + + pvice(:ncol,:) = 0._r8 + + if (stokes) then + + !----------------------------------------------------------------------- + !--------------------- stokes terminal velocity < 40 microns ----------- + !----------------------------------------------------------------------- + + ! get effective radius + call reitab(ncol, t, rei) + + do k = 1,pver + do i = 1,ncol + if (cloud(i,k) > 0._r8 .and. cldice(i,k) > 0._r8) then + if (rei(i,k) < 40._r8 ) then + vfall = 2._r8/9._r8 * rhoh2o * gravit * rei(i,k)**2 / eta * 1.e-12_r8 ! micons^2 -> m^2 + vfall = vfall * cldsed_ice_stokes_fac + else + vfall = v40 + vslope * (rei(i,k)-r40) ! linear above 40 microns + end if + + ! convert the fall speed to pressure units, but do not apply the traditional + ! negative convention for pvel. + pvice(i,k+1) = vfall * rho(i,k)*gravit ! meters/sec to pascals/sec + end if + end do + end do + + else + + !----------------------------------------------------------------------- + !--------------------- McFarquhar and Heymsfield > icritc -------------- + !----------------------------------------------------------------------- + + ! lower bound for iciwc + + cc = 128.64_r8 + bc = 53.242_r8 + ac = 5.4795_r8 + lbound = (-bc + sqrt(bc*bc-4*ac*cc))/(2*ac) + lbound = 10._r8**lbound + + do k = 1,pver + do i = 1,ncol + if (cloud(i,k) > 0._r8 .and. cldice(i,k) > 0._r8) then + + ! compute the in-cloud ice concentration (kg/kg) + icice = cldice(i,k) / cloud(i,k) + + ! compute the ice water content in g/m3 + iciwc = icice * rho(i,k) * 1.e3_r8 + + ! set the fall velocity (cm/s) to depend on the ice water content in g/m3, + if (iciwc > lbound) then ! need this because of log10 + logiwc = log10(iciwc) + ! Median - + vfall = 128.64_r8 + 53.242_r8*logiwc + 5.4795_r8*logiwc**2 + ! Average - + !!$ vfall = 122.63 + 44.111*logiwc + 4.2144*logiwc**2 + else + vfall = 0._r8 + end if + + ! set ice velocity to 1 cm/s if ice mixing ratio < icritc, ramp to value + ! calculated above at 2*icritc + if (icice <= icritc) then + vfall = vice_small + else if(icice < 2*icritc) then + icefac = (icice-icritc)/icritc + vfall = vice_small * (1._r8-icefac) + vfall * icefac + end if + + ! bound the terminal velocity of ice particles at high concentration + vfall = min(100.0_r8, vfall) + + ! convert the fall speed to pressure units, but do not apply the traditional + ! negative convention for pvel. + pvice(i,k+1) = vfall & + * 0.01_r8 & ! cm to meters + * rho(i,k)*gravit ! meters/sec to pascals/sec + end if + end do + end do + + end if + + end subroutine cld_sediment_vel + + +!=============================================================================== + subroutine cld_sediment_tend (ncol, dtime , & + pint , pmid , pdel , t , & + cloud , cldliq , cldice , pvliq , pvice , & + liqtend, icetend, wvtend , htend , sfliq , sfice ) + +!---------------------------------------------------------------------- +! Apply Cloud Particle Gravitational Sedimentation to Condensate +!---------------------------------------------------------------------- + + +! Arguments + integer, intent(in) :: ncol ! number of colums to process + + real(r8), intent(in) :: dtime ! time step + real(r8), intent(in) :: pint (pcols,pverp) ! interfaces pressure (Pa) + real(r8), intent(in) :: pmid (pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa) + real(r8), intent(in) :: cloud (pcols,pver) ! cloud fraction (fraction) + real(r8), intent(in) :: t (pcols,pver) ! temperature (K) + real(r8), intent(in) :: cldliq(pcols,pver) ! cloud liquid water (kg/kg) + real(r8), intent(in) :: cldice(pcols,pver) ! cloud ice water (kg/kg) + real(r8), intent(in) :: pvliq (pcols,pverp) ! vertical velocity of liquid drops (Pa/s) + real(r8), intent(in) :: pvice (pcols,pverp) ! vertical velocity of ice particles (Pa/s) +! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1)) + + real(r8), intent(out) :: liqtend(pcols,pver) ! liquid condensate tend + real(r8), intent(out) :: icetend(pcols,pver) ! ice condensate tend + real(r8), intent(out) :: wvtend (pcols,pver) ! water vapor tend + real(r8), intent(out) :: htend (pcols,pver) ! heating rate + real(r8), intent(out) :: sfliq (pcols) ! surface flux of liquid (rain, kg/m/s) + real(r8), intent(out) :: sfice (pcols) ! surface flux of ice (snow, kg/m/s) + +! Local variables + real(r8) :: fxliq(pcols,pverp) ! fluxes at the interfaces, liquid (positive = down) + real(r8) :: fxice(pcols,pverp) ! fluxes at the interfaces, ice (positive = down) + real(r8) :: cldab(pcols) ! cloud in layer above + real(r8) :: evapliq ! evaporation of cloud liquid into environment + real(r8) :: evapice ! evaporation of cloud ice into environment + real(r8) :: cldovrl ! cloud overlap factor + + integer :: i,k +!---------------------------------------------------------------------- + +! initialize variables + fxliq (:ncol,:) = 0._r8 ! flux at interfaces (liquid) + fxice (:ncol,:) = 0._r8 ! flux at interfaces (ice) + liqtend(:ncol,:) = 0._r8 ! condensate tend (liquid) + icetend(:ncol,:) = 0._r8 ! condensate tend (ice) + wvtend(:ncol,:) = 0._r8 ! environmental moistening + htend(:ncol,:) = 0._r8 ! evaporative cooling + sfliq(:ncol) = 0._r8 ! condensate sedimentation flux out bot of column (liquid) + sfice(:ncol) = 0._r8 ! condensate sedimentation flux out bot of column (ice) + +! fluxes at interior points + call getflx(ncol, pint, cldliq, pvliq, dtime, fxliq) + call getflx(ncol, pint, cldice, pvice, dtime, fxice) + +! calculate fluxes at boundaries + do i = 1,ncol + fxliq(i,1) = 0._r8 + fxice(i,1) = 0._r8 +! surface flux by upstream scheme + fxliq(i,pverp) = cldliq(i,pver) * pvliq(i,pverp) * dtime + fxice(i,pverp) = cldice(i,pver) * pvice(i,pverp) * dtime + end do + +! filter out any negative fluxes from the getflx routine +! (typical fluxes are of order > 1e-3 when clouds are present) + do k = 2,pver + fxliq(:ncol,k) = max(0._r8, fxliq(:ncol,k)) + fxice(:ncol,k) = max(0._r8, fxice(:ncol,k)) + end do + +! Limit the flux out of the bottom of each cell to the water content in each phase. +! Apply mxsedfac to prevent generating very small negative cloud water/ice +! NOTE, REMOVED CLOUD FACTOR FROM AVAILABLE WATER. ALL CLOUD WATER IS IN CLOUDS. +! ***Should we include the flux in the top, to allow for thin surface layers? +! ***Requires simple treatment of cloud overlap, already included below. + do k = 1,pver + do i = 1,ncol + fxliq(i,k+1) = min( fxliq(i,k+1), mxsedfac * cldliq(i,k) * pdel(i,k) ) + fxice(i,k+1) = min( fxice(i,k+1), mxsedfac * cldice(i,k) * pdel(i,k) ) +!!$ fxliq(i,k+1) = min( fxliq(i,k+1), cldliq(i,k) * pdel(i,k) + fxliq(i,k)) +!!$ fxice(i,k+1) = min( fxice(i,k+1), cldice(i,k) * pdel(i,k) + fxice(i,k)) +!!$ fxliq(i,k+1) = min( fxliq(i,k+1), cloud(i,k) * cldliq(i,k) * pdel(i,k) ) +!!$ fxice(i,k+1) = min( fxice(i,k+1), cloud(i,k) * cldice(i,k) * pdel(i,k) ) + end do + end do + +! Now calculate the tendencies assuming that condensate evaporates when +! it falls into environment, and does not when it falls into cloud. +! All flux out of the layer comes from the cloudy part. +! Assume maximum overlap for stratiform clouds +! if cloud above < cloud, all water falls into cloud below +! if cloud above > cloud, water split between cloud and environment + do k = 1,pver + cldab(:ncol) = 0._r8 + do i = 1,ncol +! cloud overlap cloud factor + cldovrl = min( cloud(i,k) / (cldab(i)+.0001_r8), 1._r8 ) + cldab(i) = cloud(i,k) +! evaporation into environment cause moistening and cooling + evapliq = fxliq(i,k) * (1._r8-cldovrl) / (dtime * pdel(i,k)) ! into env (kg/kg/s) + evapice = fxice(i,k) * (1._r8-cldovrl) / (dtime * pdel(i,k)) ! into env (kg/kg/s) + wvtend(i,k) = evapliq + evapice ! evaporation into environment (kg/kg/s) + htend (i,k) = -latvap*evapliq -(latvap+latice)*evapice ! evaporation (W/kg) +! net flux into cloud changes cloud liquid/ice (all flux is out of cloud) + liqtend(i,k) = (fxliq(i,k)*cldovrl - fxliq(i,k+1)) / (dtime * pdel(i,k)) + icetend(i,k) = (fxice(i,k)*cldovrl - fxice(i,k+1)) / (dtime * pdel(i,k)) + end do + end do + +! convert flux out the bottom to mass units Pa -> kg/m2/s + sfliq(:ncol) = fxliq(:ncol,pverp) / (dtime*gravit) + sfice(:ncol) = fxice(:ncol,pverp) / (dtime*gravit) + + return + end subroutine cld_sediment_tend + +!=============================================================================== + subroutine getflx(ncol, xw, phi, vel, deltat, flux) + +!.....xw1.......xw2.......xw3.......xw4.......xw5.......xw6 +!....psiw1.....psiw2.....psiw3.....psiw4.....psiw5.....psiw6 +!....velw1.....velw2.....velw3.....velw4.....velw5.....velw6 +!.........phi1......phi2.......phi3.....phi4.......phi5....... + + + + integer, intent(in) :: ncol ! number of colums to process + + integer i + integer k + + real (r8), intent(in) :: vel(pcols,pverp) + real (r8) flux(pcols,pverp) + real (r8) xw(pcols,pverp) + real (r8) psi(pcols,pverp) + real (r8), intent(in) :: phi(pcols,pverp-1) + real (r8) fdot(pcols,pverp) + real (r8) xx(pcols) + real (r8) fxdot(pcols) + real (r8) fxdd(pcols) + + real (r8) psistar(pcols) + real (r8) deltat + + real (r8) xxk(pcols,pver) + + do i = 1,ncol +! integral of phi + psi(i,1) = 0._r8 +! fluxes at boundaries + flux(i,1) = 0._r8 + flux(i,pverp) = 0._r8 + end do + +! integral function + do k = 2,pverp + do i = 1,ncol + psi(i,k) = phi(i,k-1)*(xw(i,k)-xw(i,k-1)) + psi(i,k-1) + end do + end do + + +! calculate the derivatives for the interpolating polynomial + call cfdotmc_pro (ncol, xw, psi, fdot) + +! NEW WAY +! calculate fluxes at interior pts + do k = 2,pver + do i = 1,ncol + xxk(i,k) = xw(i,k)-vel(i,k)*deltat + end do + end do + do k = 2,pver + call cfint2(ncol, xw, psi, fdot, xxk(1,k), fxdot, fxdd, psistar) + do i = 1,ncol + flux(i,k) = (psi(i,k)-psistar(i)) + end do + end do + + + return + end subroutine getflx + + + +!############################################################################## + + subroutine cfint2 (ncol, x, f, fdot, xin, fxdot, fxdd, psistar) + + + +! input + integer ncol ! number of colums to process + + real (r8) x(pcols, pverp) + real (r8) f(pcols, pverp) + real (r8) fdot(pcols, pverp) + real (r8) xin(pcols) + +! output + real (r8) fxdot(pcols) + real (r8) fxdd(pcols) + real (r8) psistar(pcols) + + integer i + integer k + integer intz(pcols) + real (r8) dx + real (r8) s + real (r8) c2 + real (r8) c3 + real (r8) xx + real (r8) xinf + real (r8) psi1, psi2, psi3, psim + real (r8) cfint + real (r8) cfnew + real (r8) xins(pcols) + +! the minmod function + real (r8) a, b, c + real (r8) minmod + real (r8) medan + logical found_error + + minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b)) + medan(a,b,c) = a + minmod(b-a,c-a) + + do i = 1,ncol + xins(i) = medan(x(i,1), xin(i), x(i,pverp)) + intz(i) = 0 + end do + +! first find the interval + do k = 1,pverp-1 + do i = 1,ncol + if ((xins(i)-x(i,k))*(x(i,k+1)-xins(i)).ge.0) then + intz(i) = k + endif + end do + end do + + found_error=.false. + do i = 1,ncol + if (intz(i).eq.0._r8) found_error=.true. + end do + if(found_error) then + do i = 1,ncol + if (intz(i).eq.0._r8) then + write(iulog,*) ' interval was not found for col i ', i + call endrun('CFINT2') + endif + end do + endif + +! now interpolate + do i = 1,ncol + k = intz(i) + dx = (x(i,k+1)-x(i,k)) + s = (f(i,k+1)-f(i,k))/dx + c2 = (3*s-2*fdot(i,k)-fdot(i,k+1))/dx + c3 = (fdot(i,k)+fdot(i,k+1)-2*s)/dx**2 + xx = (xins(i)-x(i,k)) + fxdot(i) = (3*c3*xx + 2*c2)*xx + fdot(i,k) + fxdd(i) = 6*c3*xx + 2*c2 + cfint = ((c3*xx + c2)*xx + fdot(i,k))*xx + f(i,k) + +! limit the interpolant + psi1 = f(i,k)+(f(i,k+1)-f(i,k))*xx/dx + if (k.eq.1) then + psi2 = f(i,1) + else + psi2 = f(i,k) + (f(i,k)-f(i,k-1))*xx/(x(i,k)-x(i,k-1)) + endif + if (k+1.eq.pverp) then + psi3 = f(i,pverp) + else + psi3 = f(i,k+1) - (f(i,k+2)-f(i,k+1))*(dx-xx)/(x(i,k+2)-x(i,k+1)) + endif + psim = medan(psi1, psi2, psi3) + cfnew = medan(cfint, psi1, psim) + if (abs(cfnew-cfint)/(abs(cfnew)+abs(cfint)+1.e-36_r8) .gt..03_r8) then +! CHANGE THIS BACK LATER!!! +! $ .gt..1) then + + +! UNCOMMENT THIS LATER!!! +! write(iulog,*) ' cfint2 limiting important ', cfint, cfnew + + + endif + psistar(i) = cfnew + end do + + return + end subroutine cfint2 + + + +!############################################################################## + + subroutine cfdotmc_pro (ncol, x, f, fdot) + +! prototype version; eventually replace with final SPITFIRE scheme + +! calculate the derivative for the interpolating polynomial +! multi column version + + + +! input + integer ncol ! number of colums to process + + real (r8) x(pcols, pverp) + real (r8) f(pcols, pverp) +! output + real (r8) fdot(pcols, pverp) ! derivative at nodes + +! assumed variable distribution +! x1.......x2.......x3.......x4.......x5.......x6 1,pverp points +! f1.......f2.......f3.......f4.......f5.......f6 1,pverp points +! ...sh1.......sh2......sh3......sh4......sh5.... 1,pver points +! .........d2.......d3.......d4.......d5......... 2,pver points +! .........s2.......s3.......s4.......s5......... 2,pver points +! .............dh2......dh3......dh4............. 2,pver-1 points +! .............eh2......eh3......eh4............. 2,pver-1 points +! ..................e3.......e4.................. 3,pver-1 points +! .................ppl3......ppl4................ 3,pver-1 points +! .................ppr3......ppr4................ 3,pver-1 points +! .................t3........t4.................. 3,pver-1 points +! ................fdot3.....fdot4................ 3,pver-1 points + + +! work variables + + + integer i + integer k + + real (r8) a ! work var + real (r8) b ! work var + real (r8) c ! work var + real (r8) s(pcols,pverp) ! first divided differences at nodes + real (r8) sh(pcols,pverp) ! first divided differences between nodes + real (r8) d(pcols,pverp) ! second divided differences at nodes + real (r8) dh(pcols,pverp) ! second divided differences between nodes + real (r8) e(pcols,pverp) ! third divided differences at nodes + real (r8) eh(pcols,pverp) ! third divided differences between nodes + real (r8) pp ! p prime + real (r8) ppl(pcols,pverp) ! p prime on left + real (r8) ppr(pcols,pverp) ! p prime on right + real (r8) qpl + real (r8) qpr + real (r8) ttt + real (r8) t + real (r8) tmin + real (r8) tmax + real (r8) delxh(pcols,pverp) + + +! the minmod function + real (r8) minmod + real (r8) medan + minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b)) + medan(a,b,c) = a + minmod(b-a,c-a) + + do k = 1,pver + + +! first divided differences between nodes + do i = 1, ncol + delxh(i,k) = (x(i,k+1)-x(i,k)) + sh(i,k) = (f(i,k+1)-f(i,k))/delxh(i,k) + end do + +! first and second divided differences at nodes + if (k.ge.2) then + do i = 1,ncol + d(i,k) = (sh(i,k)-sh(i,k-1))/(x(i,k+1)-x(i,k-1)) + s(i,k) = minmod(sh(i,k),sh(i,k-1)) + end do + endif + end do + +! second and third divided diffs between nodes + do k = 2,pver-1 + do i = 1, ncol + eh(i,k) = (d(i,k+1)-d(i,k))/(x(i,k+2)-x(i,k-1)) + dh(i,k) = minmod(d(i,k),d(i,k+1)) + end do + end do + +! treat the boundaries + do i = 1,ncol + e(i,2) = eh(i,2) + e(i,pver) = eh(i,pver-1) +! outside level + fdot(i,1) = sh(i,1) - d(i,2)*delxh(i,1) & + - eh(i,2)*delxh(i,1)*(x(i,1)-x(i,3)) + fdot(i,1) = minmod(fdot(i,1),3*sh(i,1)) + fdot(i,pverp) = sh(i,pver) + d(i,pver)*delxh(i,pver) & + + eh(i,pver-1)*delxh(i,pver)*(x(i,pverp)-x(i,pver-1)) + fdot(i,pverp) = minmod(fdot(i,pverp),3*sh(i,pver)) +! one in from boundary + fdot(i,2) = sh(i,1) + d(i,2)*delxh(i,1) - eh(i,2)*delxh(i,1)*delxh(i,2) + fdot(i,2) = minmod(fdot(i,2),3*s(i,2)) + fdot(i,pver) = sh(i,pver) - d(i,pver)*delxh(i,pver) & + - eh(i,pver-1)*delxh(i,pver)*delxh(i,pver-1) + fdot(i,pver) = minmod(fdot(i,pver),3*s(i,pver)) + end do + + + do k = 3,pver-1 + do i = 1,ncol + e(i,k) = minmod(eh(i,k),eh(i,k-1)) + end do + end do + + + + do k = 3,pver-1 + + do i = 1,ncol + +! p prime at k-0.5 + ppl(i,k)=sh(i,k-1) + dh(i,k-1)*delxh(i,k-1) +! p prime at k+0.5 + ppr(i,k)=sh(i,k) - dh(i,k) *delxh(i,k) + + t = minmod(ppl(i,k),ppr(i,k)) + +! derivate from parabola thru f(i,k-1), f(i,k), and f(i,k+1) + pp = sh(i,k-1) + d(i,k)*delxh(i,k-1) + +! quartic estimate of fdot + fdot(i,k) = pp & + - delxh(i,k-1)*delxh(i,k) & + *( eh(i,k-1)*(x(i,k+2)-x(i,k )) & + + eh(i,k )*(x(i,k )-x(i,k-2)) & + )/(x(i,k+2)-x(i,k-2)) + +! now limit it + qpl = sh(i,k-1) & + + delxh(i,k-1)*minmod(d(i,k-1)+e(i,k-1)*(x(i,k)-x(i,k-2)), & + d(i,k) -e(i,k)*delxh(i,k)) + qpr = sh(i,k) & + + delxh(i,k )*minmod(d(i,k) +e(i,k)*delxh(i,k-1), & + d(i,k+1)+e(i,k+1)*(x(i,k)-x(i,k+2))) + + fdot(i,k) = medan(fdot(i,k), qpl, qpr) + + ttt = minmod(qpl, qpr) + tmin = min(0._r8,3*s(i,k),1.5_r8*t,ttt) + tmax = max(0._r8,3*s(i,k),1.5_r8*t,ttt) + + fdot(i,k) = fdot(i,k) + minmod(tmin-fdot(i,k), tmax-fdot(i,k)) + + end do + + end do + + return + end subroutine cfdotmc_pro +end module pkg_cld_sediment diff --git a/src/physics/cam/pkg_cldoptics.F90 b/src/physics/cam/pkg_cldoptics.F90 new file mode 100644 index 0000000000..aa40dae6c3 --- /dev/null +++ b/src/physics/cam/pkg_cldoptics.F90 @@ -0,0 +1,400 @@ +module pkg_cldoptics + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Compute cloud optical properties: liquid and ice partical size; emissivity +! +! Author: Byron Boville Sept 06, 2002, assembled from existing subroutines +! +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + + implicit none + private + save + + public :: cldefr, cldems, cldovrlap, cldclw, reitab, reltab + +contains + +!=============================================================================== + subroutine cldefr(lchnk ,ncol , & + landfrac,t ,rel ,rei ,ps ,pmid , landm, icefrac, snowh) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute cloud water and ice particle size +! +! Method: +! use empirical formulas to construct effective radii +! +! Author: J.T. Kiehl, B. A. Boville, P. Rasch +! +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: icefrac(pcols) ! Ice fraction + real(r8), intent(in) :: t(pcols,pver) ! Temperature + real(r8), intent(in) :: ps(pcols) ! Surface pressure + real(r8), intent(in) :: pmid(pcols,pver) ! Midpoint pressures + real(r8), intent(in) :: landm(pcols) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) +! +! Output arguments +! + real(r8), intent(out) :: rel(pcols,pver) ! Liquid effective drop size (microns) + real(r8), intent(out) :: rei(pcols,pver) ! Ice effective drop size (microns) +! +! following Kiehl + call reltab(ncol, t, landfrac, landm, icefrac, rel, snowh) + +! following Kristjansson and Mitchell + call reitab(ncol, t, rei) + + return + end subroutine cldefr + +!=============================================================================== + subroutine cldems(lchnk ,ncol ,clwp ,fice ,rei ,emis ,cldtau) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute cloud emissivity using cloud liquid water path (g/m**2) +! +! Method: +! +! +! +! Author: J.T. Kiehl +! +!----------------------------------------------------------------------- + + use phys_control, only: phys_getopts + +!------------------------------Parameters------------------------------- +! + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) +! +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: clwp(pcols,pver) ! cloud liquid water path (g/m**2) + real(r8), intent(in) :: rei(pcols,pver) ! ice effective drop size (microns) + real(r8), intent(in) :: fice(pcols,pver) ! fractional ice content within cloud +! +! Output arguments +! + real(r8), intent(out) :: emis(pcols,pver) ! cloud emissivity (fraction) + real(r8), intent(out) :: cldtau(pcols,pver) ! cloud optical depth +! +!---------------------------Local workspace----------------------------- +! + integer i,k ! longitude, level indices + real(r8) kabs ! longwave absorption coeff (m**2/g) + real(r8) kabsi ! ice absorption coefficient + + character(len=16) :: microp_scheme ! microphysics scheme +!----------------------------------------------------------------------- +! + call phys_getopts(microp_scheme_out=microp_scheme) + + do k=1,pver + do i=1,ncol + + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + if ( microp_scheme == 'RK' .or. microp_scheme == 'SPCAM_sam1mom') then + kabsi = 0.005_r8 + 1._r8/rei(i,k) + else + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,rei(i,k)),130._r8) + end if + kabs = kabsl*(1._r8-fice(i,k)) + kabsi*fice(i,k) + emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*clwp(i,k) + end do + end do +! + return + end subroutine cldems + +!=============================================================================== + subroutine cldovrlap(lchnk ,ncol ,pint ,cld ,nmxrgn ,pmxrgn ) +!----------------------------------------------------------------------- +! +! Purpose: +! Partitions each column into regions with clouds in neighboring layers. +! This information is used to implement maximum overlap in these regions +! with random overlap between them. +! On output, +! nmxrgn contains the number of regions in each column +! pmxrgn contains the interface pressures for the lower boundaries of +! each region! +! Method: + +! +! Author: W. Collins +! +!----------------------------------------------------------------------- + +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: pint(pcols,pverp) ! Interface pressure + real(r8), intent(in) :: cld(pcols,pver) ! Fractional cloud cover +! +! Output arguments +! + integer, intent(out) :: nmxrgn(pcols) ! Number of maximally overlapped regions + real(r8), intent(out) :: pmxrgn(pcols,pverp)! Maximum values of pressure for each +! maximally overlapped region. +! 0->pmxrgn(i,1) is range of pressure for +! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for +! 2nd region, etc +! +!---------------------------Local variables----------------------------- +! + integer i ! Longitude index + integer k ! Level index + integer n ! Max-overlap region counter + + real(r8) pnm(pcols,pverp) ! Interface pressure + + logical cld_found ! Flag for detection of cloud + logical cld_layer(pver) ! Flag for cloud in layer +! +!------------------------------------------------------------------------ +! + + do i = 1, ncol + cld_found = .false. + cld_layer(:) = cld(i,:) > 0.0_r8 + pmxrgn(i,:) = 0.0_r8 + pnm(i,:)=pint(i,:)*10._r8 + n = 1 + do k = 1, pver + if (cld_layer(k) .and. .not. cld_found) then + cld_found = .true. + else if ( .not. cld_layer(k) .and. cld_found) then + cld_found = .false. + if (count(cld_layer(k:pver)) == 0) then + exit + endif + pmxrgn(i,n) = pnm(i,k) + n = n + 1 + endif + end do + pmxrgn(i,n) = pnm(i,pverp) + nmxrgn(i) = n + end do + + return + end subroutine cldovrlap + +!=============================================================================== + subroutine cldclw(lchnk ,ncol ,zi ,clwp ,tpw ,hl ) +!----------------------------------------------------------------------- +! +! Purpose: +! Evaluate cloud liquid water path clwp (g/m**2) +! +! Method: +! +! +! +! Author: J.T. Kiehl +! +!----------------------------------------------------------------------- + + +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: zi(pcols,pverp) ! height at layer interfaces(m) + real(r8), intent(in) :: tpw(pcols) ! total precipitable water (mm) +! +! Output arguments +! + real(r8), intent(out) :: clwp(pcols,pver) ! cloud liquid water path (g/m**2) + real(r8), intent(out) :: hl(pcols) ! liquid water scale height + +! +!---------------------------Local workspace----------------------------- +! + integer :: i,k ! longitude, level indices + real(r8) :: clwc0 ! reference liquid water concentration (g/m**3) + real(r8) :: emziohl(pcols,pverp) ! exp(-zi/hl) + real(r8) :: rhl(pcols) ! 1/hl +! +!----------------------------------------------------------------------- +! +! Set reference liquid water concentration +! + clwc0 = 0.21_r8 +! +! Diagnose liquid water scale height from precipitable water +! + do i=1,ncol + hl(i) = 700.0_r8*log(max(tpw(i)+1.0_r8,1.0_r8)) + rhl(i) = 1.0_r8/hl(i) + end do +! +! Evaluate cloud liquid water path (vertical integral of exponential fn) +! + do k=1,pverp + do i=1,ncol + emziohl(i,k) = exp(-zi(i,k)*rhl(i)) + end do + end do + do k=1,pver + do i=1,ncol + clwp(i,k) = clwc0*hl(i)*(emziohl(i,k+1) - emziohl(i,k)) + end do + end do +! + return + end subroutine cldclw + + +!=============================================================================== + subroutine reltab(ncol, t, landfrac, landm, icefrac, rel, snowh) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute cloud water size +! +! Method: +! analytic formula following the formulation originally developed by J. T. Kiehl +! +! Author: Phil Rasch +! +!----------------------------------------------------------------------- + use physconst, only: tmelt +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol + real(r8), intent(in) :: landfrac(pcols) ! Land fraction + real(r8), intent(in) :: icefrac(pcols) ! Ice fraction + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) + real(r8), intent(in) :: landm(pcols) ! Land fraction ramping to zero over ocean + real(r8), intent(in) :: t(pcols,pver) ! Temperature + +! +! Output arguments +! + real(r8), intent(out) :: rel(pcols,pver) ! Liquid effective drop size (microns) +! +!---------------------------Local workspace----------------------------- +! + integer i,k ! Lon, lev indices + real(r8) rliqland ! liquid drop size if over land + real(r8) rliqocean ! liquid drop size if over ocean + real(r8) rliqice ! liquid drop size if over sea ice +! +!----------------------------------------------------------------------- +! + rliqocean = 14.0_r8 + rliqice = 14.0_r8 + rliqland = 8.0_r8 + do k=1,pver + do i=1,ncol +! jrm Reworked effective radius algorithm + ! Start with temperature-dependent value appropriate for continental air + ! Note: findmcnew has a pressure dependence here + rel(i,k) = rliqland + (rliqocean-rliqland) * min(1.0_r8,max(0.0_r8,(tmelt-t(i,k))*0.05_r8)) + ! Modify for snow depth over land + rel(i,k) = rel(i,k) + (rliqocean-rel(i,k)) * min(1.0_r8,max(0.0_r8,snowh(i)*10._r8)) + ! Ramp between polluted value over land to clean value over ocean. + rel(i,k) = rel(i,k) + (rliqocean-rel(i,k)) * min(1.0_r8,max(0.0_r8,1.0_r8-landm(i))) + ! Ramp between the resultant value and a sea ice value in the presence of ice. + rel(i,k) = rel(i,k) + (rliqice-rel(i,k)) * min(1.0_r8,max(0.0_r8,icefrac(i))) +! end jrm + end do + end do + end subroutine reltab + +!=============================================================================== + subroutine reitab(ncol, t, re) + + integer, intent(in) :: ncol + real(r8), intent(out) :: re(pcols,pver) + real(r8), intent(in) :: t(pcols,pver) + integer , parameter :: len_retab = 138 + real(r8), parameter :: min_retab = 136._r8 + real(r8) retab(len_retab) + real(r8) corr + integer i + integer k + integer index + ! + ! Tabulated values of re(T) in the temperature interval + ! 180 K -- 274 K; hexagonal columns assumed: + ! + ! Modified for pmc formation: 136K -- 274K + ! + data retab / & + 0.05_r8, 0.05_r8, 0.05_r8, 0.05_r8, 0.05_r8, 0.05_r8, & + 0.055_r8, 0.06_r8, 0.07_r8, 0.08_r8, 0.09_r8, 0.1_r8, & + 0.2_r8, 0.3_r8, 0.40_r8, 0.50_r8, 0.60_r8, 0.70_r8, & + 0.8_r8 , 0.9_r8, 1.0_r8, 1.1_r8, 1.2_r8, 1.3_r8, & + 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 2.0_r8, 2.2_r8, & + 2.4_r8, 2.6_r8, 2.8_r8, 3.0_r8, 3.2_r8, 3.5_r8, & + 3.8_r8, 4.1_r8, 4.4_r8, 4.7_r8, 5.0_r8, 5.3_r8, & + 5.6_r8, & + 5.92779_r8, 6.26422_r8, 6.61973_r8, 6.99539_r8, 7.39234_r8, & + 7.81177_r8, 8.25496_r8, 8.72323_r8, 9.21800_r8, 9.74075_r8, 10.2930_r8, & + 10.8765_r8, 11.4929_r8, 12.1440_r8, 12.8317_r8, 13.5581_r8, 14.2319_r8, & + 15.0351_r8, 15.8799_r8, 16.7674_r8, 17.6986_r8, 18.6744_r8, 19.6955_r8, & + 20.7623_r8, 21.8757_r8, 23.0364_r8, 24.2452_r8, 25.5034_r8, 26.8125_r8, & + 27.7895_r8, 28.6450_r8, 29.4167_r8, 30.1088_r8, 30.7306_r8, 31.2943_r8, & + 31.8151_r8, 32.3077_r8, 32.7870_r8, 33.2657_r8, 33.7540_r8, 34.2601_r8, & + 34.7892_r8, 35.3442_r8, 35.9255_r8, 36.5316_r8, 37.1602_r8, 37.8078_r8, & + 38.4720_r8, 39.1508_r8, 39.8442_r8, 40.5552_r8, 41.2912_r8, 42.0635_r8, & + 42.8876_r8, 43.7863_r8, 44.7853_r8, 45.9170_r8, 47.2165_r8, 48.7221_r8, & + 50.4710_r8, 52.4980_r8, 54.8315_r8, 57.4898_r8, 60.4785_r8, 63.7898_r8, & + 65.5604_r8, 71.2885_r8, 75.4113_r8, 79.7368_r8, 84.2351_r8, 88.8833_r8, & + 93.6658_r8, 98.5739_r8, 103.603_r8, 108.752_r8, 114.025_r8, 119.424_r8, & + 124.954_r8, 130.630_r8, 136.457_r8, 142.446_r8, 148.608_r8, 154.956_r8, & + 161.503_r8, 168.262_r8, 175.248_r8, 182.473_r8, 189.952_r8, 197.699_r8, & + 205.728_r8, 214.055_r8, 222.694_r8, 231.661_r8, 240.971_r8, 250.639_r8/ + ! + save retab + ! + + do k=1,pver + do i=1,ncol + index = int(t(i,k)-min_retab) + index = min(max(index,1),len_retab-1) + corr = t(i,k) - int(t(i,k)) + re(i,k) = retab(index)*(1._r8-corr) & + +retab(index+1)*corr + ! re(i,k) = amax1(amin1(re(i,k),30.),10.) + end do + end do + ! + return + end subroutine reitab + +end module pkg_cldoptics diff --git a/src/physics/cam/polar_avg.F90 b/src/physics/cam/polar_avg.F90 new file mode 100644 index 0000000000..7fb62c27cc --- /dev/null +++ b/src/physics/cam/polar_avg.F90 @@ -0,0 +1,221 @@ +module polar_avg +!----------------------------------------------------------------------- +! +! Purpose: +! These routines are used by the fv dycore to set the collocated +! pole points at the limits of the latitude dimension to the same +! value. +! +! Methods: +! The reprosum reproducible distributed sum is used for these +! calculations. +! +! Author: A. Mirin +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!- use statements ------------------------------------------------------ +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use dycore, only: dycore_is + use dyn_grid, only: get_dyn_grid_parm + use phys_grid, only: get_ncols_p, get_lat_all_p + use ppgrid, only: begchunk, endchunk, pcols + use shr_reprosum_mod, only: shr_reprosum_calc +#if ( defined SPMD ) + use mpishorthand, only: mpicom +#endif + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + private + save + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- + public :: & + polar_average ! support for LR dycore polar averaging + + interface polar_average + module procedure polar_average2d, polar_average3d + end interface + + CONTAINS +! +!======================================================================== +! + subroutine polar_average2d(field) +!----------------------------------------------------------------------- +! Purpose: Set the collocated pole points at the limits of the latitude +! dimension to the same value. +! Author: J. Edwards +!----------------------------------------------------------------------- +! +! Arguments +! + real(r8), intent(inout) :: field(pcols,begchunk:endchunk) +! +! Local workspace +! + integer :: i, c, ln, ls, ncols + integer :: plat, plon + integer, allocatable :: lats(:) +#if (! defined SPMD) + integer :: mpicom = 0 +#endif + + real(r8) :: sum(2) + real(r8), allocatable :: n_pole(:), s_pole(:) +! +!----------------------------------------------------------------------- +! + if(.not. dycore_is('LR')) return + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + allocate(lats(pcols), n_pole(plon), s_pole(plon)) + ln=0 + ls=0 + n_pole = 0._r8 + s_pole = 0._r8 + + do c=begchunk,endchunk + call get_lat_all_p(c,pcols,lats) + ncols = get_ncols_p(c) + + do i=1,ncols + if(lats(i).eq.1) then + ln=ln+1 + n_pole(ln) = field(i,c) + else if(lats(i).eq.plat) then + ls=ls+1 + s_pole(ls) = field(i,c) + end if + enddo + + end do + + call shr_reprosum_calc(n_pole, sum(1:1), ln, plon, 1, & + gbl_count=plon, commid=mpicom) + + call shr_reprosum_calc(s_pole, sum(2:2), ls, plon, 1, & + gbl_count=plon, commid=mpicom) + + ln=0 + ls=0 + do c=begchunk,endchunk + call get_lat_all_p(c,pcols,lats) + ncols = get_ncols_p(c) + + do i=1,ncols + if(lats(i).eq.1) then + ln=ln+1 + field(i,c) = sum(1)/plon + else if(lats(i).eq.plat) then + ls=ls+1 + field(i,c) = sum(2)/plon + end if + enddo + + end do + + deallocate(lats, n_pole, s_pole) + + end subroutine polar_average2d + +! +!======================================================================== +! + + subroutine polar_average3d(nlev, field) +!----------------------------------------------------------------------- +! Purpose: Set the collocated pole points at the limits of the latitude +! dimension to the same value. +! Author: J. Edwards +!----------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: nlev + real(r8), intent(inout) :: field(pcols,nlev,begchunk:endchunk) +! +! Local workspace +! + integer :: i, c, ln, ls, ncols, k + integer :: plat, plon + integer, allocatable :: lats(:) +#if (! defined SPMD) + integer :: mpicom = 0 +#endif + + real(r8) :: sum(nlev,2) + real(r8), allocatable :: n_pole(:,:), s_pole(:,:) +! +!----------------------------------------------------------------------- +! + if(.not. dycore_is('LR')) return + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + allocate(lats(pcols), n_pole(plon,nlev), s_pole(plon,nlev)) + ln=0 + ls=0 + n_pole = 0._r8 + s_pole = 0._r8 + + do c=begchunk,endchunk + call get_lat_all_p(c,pcols,lats) + ncols = get_ncols_p(c) + + do i=1,ncols + if(lats(i).eq.1) then + ln=ln+1 + do k=1,nlev + n_pole(ln,k) = field(i,k,c) + end do + else if(lats(i).eq.plat) then + ls=ls+1 + do k=1,nlev + s_pole(ls,k) = field(i,k,c) + end do + end if + enddo + end do + + call shr_reprosum_calc(n_pole, sum(:,1), ln, plon, nlev, & + gbl_count=plon, commid=mpicom) + + call shr_reprosum_calc(s_pole, sum(:,2), ls, plon, nlev, & + gbl_count=plon, commid=mpicom) + + ln=0 + ls=0 + do c=begchunk,endchunk + call get_lat_all_p(c,pcols,lats) + ncols = get_ncols_p(c) + + do i=1,ncols + if(lats(i).eq.1) then + ln=ln+1 + do k=1,nlev + field(i,k,c) = sum(k,1)/plon + end do + else if(lats(i).eq.plat) then + ls=ls+1 + do k=1,nlev + field(i,k,c) = sum(k,2)/plon + end do + end if + enddo + + end do + + deallocate(lats, n_pole, s_pole) + + end subroutine polar_average3d + +end module polar_avg diff --git a/src/physics/cam/ppgrid.F90 b/src/physics/cam/ppgrid.F90 new file mode 100644 index 0000000000..ceaa5a1aa8 --- /dev/null +++ b/src/physics/cam/ppgrid.F90 @@ -0,0 +1,44 @@ + +module ppgrid + +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize physics grid resolution parameters +! for a chunked data structure +! +! Author: +! +!----------------------------------------------------------------------- + + implicit none + private + save + + public begchunk + public endchunk + public pcols + public psubcols + public pver + public pverp + + +! Grid point resolution parameters + + integer pcols ! number of columns (max) + integer psubcols ! number of sub-columns (max) + integer pver ! number of vertical levels + integer pverp ! pver + 1 + + parameter (pcols = PCOLS) + parameter (psubcols = PSUBCOLS) + parameter (pver = PLEV) + parameter (pverp = pver + 1 ) +! +! start, end indices for chunks owned by a given MPI task +! (set in phys_grid_init). +! + integer :: begchunk = 0 ! + integer :: endchunk = -1 ! + +end module ppgrid diff --git a/src/physics/cam/qbo.F90 b/src/physics/cam/qbo.F90 new file mode 100644 index 0000000000..8bf745d02b --- /dev/null +++ b/src/physics/cam/qbo.F90 @@ -0,0 +1,57 @@ +module qbo + +! Stub version of qbo module + +implicit none +private +save + +!--------------------------------------------------------------------- +! Public methods +!--------------------------------------------------------------------- +public :: qbo_readnl ! read namelist +public :: qbo_init ! initialize qbo package +public :: qbo_timestep_init ! interpolate to current time +public :: qbo_relax ! relax zonal mean wind + +logical, public, parameter :: qbo_use_forcing = .FALSE. + +contains + +subroutine qbo_readnl(nlfile) + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Stub; do nothing. + +end subroutine qbo_readnl + +subroutine qbo_init + + ! Stub; do nothing. + +end subroutine qbo_init + +subroutine qbo_timestep_init + + ! Stub; do nothing. + +end subroutine qbo_timestep_init + +subroutine qbo_relax( state, pbuf, ptend ) + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc +!-------------------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies + + ! Stub; do nothing except init unused ptend. + call physics_ptend_init(ptend, state%psetcols, 'qbo (stub)') + +end subroutine qbo_relax + +end module qbo diff --git a/src/physics/cam/qneg_module.F90 b/src/physics/cam/qneg_module.F90 new file mode 100644 index 0000000000..f3e14f52fd --- /dev/null +++ b/src/physics/cam/qneg_module.F90 @@ -0,0 +1,491 @@ +module qneg_module + + use shr_kind_mod, only: r8 => shr_kind_r8, CS => SHR_KIND_CS + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use shr_sys_mod, only: shr_sys_flush + use cam_history_support, only: max_fieldname_len + use ppgrid, only: pcols + use constituents, only: pcnst, cnst_name + + implicit none + private + save + + ! Public interface. + + public :: qneg_readnl + public :: qneg_init + public :: qneg3 + public :: qneg4 + public :: qneg_print_summary + + ! Private module variables + character(len=8) :: print_qneg_warn + logical :: log_warnings = .false. + logical :: collect_stats = .false. + logical :: timestep_reset = .false. + + real(r8), parameter :: tol = 1.e-12_r8 + real(r8), parameter :: worst_reset = 1.e35_r8 + + ! Diagnostic field names + integer, parameter :: num_diag_fields = (2 * pcnst) + 1 + character(len=max_fieldname_len) :: diag_names(num_diag_fields) + logical :: cnst_out_calc = .false. + logical :: cnst_outfld(num_diag_fields) = .false. + + ! Summary buffers + integer, parameter :: num3_bins = 24 + integer, parameter :: num4_bins = 4 + character(len=CS) :: qneg3_warn_labels(num3_bins) = '' + character(len=CS) :: qneg4_warn_labels(num4_bins) = '' + integer :: qneg3_warn_num(pcnst, num3_bins) = 0 + integer :: qneg4_warn_num(num4_bins) = 0 + real(r8) :: qneg3_warn_worst(pcnst, num3_bins) = worst_reset + real(r8) :: qneg4_warn_worst(num4_bins) = worst_reset + + private :: calc_cnst_out + private :: find_index3 + private :: find_index4 + interface reset_stats + module procedure reset_stats_scalar + module procedure reset_stats_array + end interface reset_stats + +contains + + subroutine qneg_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character, masterproc + ! File containing namelist input. + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'qneg_readnl' + + namelist /qneg_nl/ print_qneg_warn + + print_qneg_warn = '' + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'qneg_nl', status=ierr) + if (ierr == 0) then + read(unitn, qneg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist qneg_nl') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(print_qneg_warn, len(print_qneg_warn), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: print_qneg_warn") + + select case(trim(print_qneg_warn)) + case('summary') + collect_stats = .true. + timestep_reset = .false. + case('timestep') + collect_stats = .true. + timestep_reset = .true. + case('off') + collect_stats = .false. + timestep_reset = .false. + case default + call endrun(sub//" FATAL: '"//trim(print_qneg_warn)//"' is not a valid value for print_qneg_warn") + end select + + if (masterproc) then + if (collect_stats) then + if (timestep_reset) then + write(iulog, *) sub, ": QNEG statistics will be collected and printed for each timestep" + else + write(iulog, *) sub, ": QNEG statistics will be collected and printed at the end of the run" + end if + else + write(iulog, *) sub, ": QNEG statistics will not be collected" + end if + end if + + end subroutine qneg_readnl + + subroutine qneg_init() + use cam_history, only: addfld, horiz_only + use constituents, only: cnst_longname + + integer :: index + + do index = 1, pcnst + diag_names(index) = trim(cnst_name(index))//'_qneg3' + call addfld(diag_names(index), (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname(index))//' QNEG3 error (cell)') + diag_names(pcnst+index) = trim(cnst_name(index))//'_qneg3_col' + call addfld(diag_names(pcnst+index), horiz_only, 'I', 'kg/kg', & + trim(cnst_longname(index))//' QNEG3 error (column)') + end do + diag_names((2*pcnst) + 1) = 'qflux_exceeded' + call addfld(diag_names((2*pcnst) + 1), horiz_only, 'I', 'kg/m^2/s', & + 'qflux excess (QNEG4)') + + end subroutine qneg_init + + subroutine calc_cnst_out() + use cam_history, only: hist_fld_active, history_initialized + integer :: index + + if (history_initialized()) then + ! to protect against routines that call qneg3 too early + do index = 1, num_diag_fields + cnst_outfld(index) = hist_fld_active(trim(diag_names(index))) + end do + cnst_out_calc = .true. + end if + + end subroutine calc_cnst_out + + integer function find_index3(nam) result(index) + ! Find a valid or new index for 'nam' entries + character(len=*), intent(in) :: nam + + integer :: i + + index = -1 + do i = 1, num3_bins + if (trim(nam) == trim(qneg3_warn_labels(i))) then + ! We found this entry, return its index + index = i + exit + else if (len_trim(qneg3_warn_labels(i)) == 0) then + ! We have run out of known entries, use a new one and reset its stats + qneg3_warn_labels(i) = nam + index = i + call reset_stats(qneg3_warn_num(:, index), qneg3_warn_worst(:,index)) + exit + end if + end do + end function find_index3 + + integer function find_index4(nam) result(index) + ! Find a valid or new index for 'nam' entries + character(len=*), intent(in) :: nam + + integer :: i + + index = -1 + do i = 1, num4_bins + if (trim(nam) == trim(qneg4_warn_labels(i))) then + ! We found this entry, return its index + index = i + exit + else if (len_trim(qneg4_warn_labels(i)) == 0) then + ! We have run out of known entries, use a new one and reset its stats + qneg4_warn_labels(i) = nam + index = i + call reset_stats(qneg4_warn_num(index), qneg4_warn_worst(index)) + exit + end if + end do + end function find_index4 + + subroutine qneg3 (subnam, idx, ncol, ncold, lver, lconst_beg, & + lconst_end, qmin, q) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Check moisture and tracers for minimum value, reset any below + ! minimum value to minimum value and return information to allow + ! warning message to be printed. The global average is NOT preserved. + ! + ! Method: + ! + ! + ! + ! Author: J. Rosinski + ! + !----------------------------------------------------------------------- + use cam_history, only: outfld + + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + character(len=*), intent(in) :: subnam ! name of calling routine + + integer, intent(in) :: idx ! chunk/latitude index + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: ncold ! declared number of atmospheric columns + integer, intent(in) :: lver ! number of vertical levels in column + integer, intent(in) :: lconst_beg ! beginning constituent + integer, intent(in) :: lconst_end ! ending constituent + + real(r8), intent(in) :: qmin(lconst_beg:lconst_end) ! Global minimum constituent concentration + + ! + ! Input/Output arguments + ! + real(r8), intent(inout) :: q(ncold,lver,lconst_beg:lconst_end) ! moisture/tracer field + ! + !---------------------------Local workspace----------------------------- + ! + integer :: nvals ! number of values found < qmin + integer :: i, k ! longitude, level indices + integer :: index ! For storing stats + integer :: m ! constituent index + integer :: iw,kw ! i,k indices of worst violator + + logical :: found ! true => at least 1 minimum violator found + + real(r8) :: badvals(ncold, lver) ! Collector for outfld calls + real(r8) :: badcols(ncold) ! Column sum for outfld + real(r8) :: worst ! biggest violator + ! + !----------------------------------------------------------------------- + ! + + call t_startf ('qneg3') + ! The first time we call this, we need to determine whether to call outfld + if (.not. cnst_out_calc) then + call calc_cnst_out() + end if + + if (collect_stats) then + index = find_index3(trim(subnam)) + else + index = -1 + end if + + do m = lconst_beg, lconst_end + nvals = 0 + found = .false. + worst = worst_reset + badvals(:,:) = 0.0_r8 + iw = -1 + kw = -1 + ! + ! Test all field values for being less than minimum value. Set q = qmin + ! for all such points. Trace offenders and identify worst one. + ! + do k = 1, lver + do i = 1, ncol + if (q(i,k,m) < qmin(m)) then + found = .true. + nvals = nvals + 1 + badvals(i, k) = q(i, k, m) + if (index > 0) then + qneg3_warn_num(m, index) = qneg3_warn_num(m, index) + 1 + end if + if (q(i,k,m) < worst) then + worst = q(i,k,m) + iw = i + kw = k + if (index > 0) then + qneg3_warn_worst(m, index) = worst + end if + end if + q(i,k,m) = qmin(m) + end if + end do + end do + ! Maybe output bad values + if ((cnst_outfld(m)) .and. (worst < worst_reset)) then + call outfld(trim(diag_names(m)), badvals, pcols, idx) + end if + if ((cnst_outfld(pcnst+m)) .and. (worst < worst_reset)) then + do i = 1, pcols + badcols(i) = SUM(badvals(i,:)) + end do + call outfld(trim(diag_names(pcnst+m)), badcols, pcols, idx) + end if + end do + call t_stopf ('qneg3') + + end subroutine qneg3 + + subroutine qneg4 (subnam, lchnk, ncol, ztodt, & + qbot, srfrpdel, shflx, lhflx, qflx) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Check if moisture flux into the ground is exceeding the total + ! moisture content of the lowest model layer (creating negative moisture + ! values). If so, then subtract the excess from the moisture and + ! latent heat fluxes and add it to the sensible heat flux. + ! + ! Method: + ! + ! + ! + ! Author: J. Olson + ! + !----------------------------------------------------------------------- +! use phys_grid, only: get_lat_p, get_lon_p + use physconst, only: gravit, latvap + use constituents, only: qmin + use cam_history, only: outfld + + ! + ! Input arguments + ! + character(len=*), intent(in) :: subnam ! name of calling routine + ! + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: ncol ! number of atmospheric columns + ! + real(r8), intent(in) :: ztodt ! two times model timestep (2 delta-t) + real(r8), intent(in) :: qbot(ncol,pcnst) ! moisture at lowest model level + real(r8), intent(in) :: srfrpdel(ncol) ! 1./(pint(K+1)-pint(K)) + ! + ! Input/Output arguments + ! + real(r8), intent(inout) :: shflx(ncol) ! Surface sensible heat flux (J/m2/s) + real(r8), intent(inout) :: lhflx(ncol) ! Surface latent heat flux (J/m2/s) + real(r8), intent(inout) :: qflx (ncol,pcnst) ! surface water flux (kg/m^2/s) + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i ! column index + integer :: iw ! i index of worst violator + integer :: index ! caller bin index + ! + real(r8):: worst ! biggest violator + real(r8):: excess(ncol) ! Excess downward sfc latent heat flux + ! + !----------------------------------------------------------------------- + + call t_startf ('qneg4') + ! The first time we call this, we need to determine whether to call outfld + if (.not. cnst_out_calc) then + call calc_cnst_out() + end if + + if (collect_stats) then + index = find_index4(trim(subnam)) + else + index = -1 + end if + + ! + ! Compute excess downward (negative) q flux compared to a theoretical + ! maximum downward q flux. The theoretical max is based upon the + ! given moisture content of lowest level of the model atmosphere. + ! + worst = worst_reset + do i = 1, ncol + excess(i) = qflx(i,1) - (qmin(1) - qbot(i,1))/(ztodt*gravit*srfrpdel(i)) + ! + ! If there is an excess downward (negative) q flux, then subtract + ! excess from "qflx" and "lhflx" and add to "shflx". + ! + if (excess(i) < 0._r8) then + if (excess(i) < worst) then + iw = i + worst = excess(i) + end if + qflx (i,1) = qflx (i,1) - excess(i) + lhflx(i) = lhflx(i) - excess(i)*latvap + shflx(i) = shflx(i) + excess(i)*latvap + if (index > 0) then + qneg4_warn_num(index) = qneg4_warn_num(index) + 1 + end if + end if + end do + ! Maybe output bad values + if ((cnst_outfld((2*pcnst)+1)) .and. (worst < worst_reset)) then + do i = 1, ncol + if (excess(i) > 0.0_r8) then + excess(i) = 0.0_r8 + end if + end do + call outfld(trim(diag_names((2*pcnst)+1)), excess(1:ncol), ncol, lchnk) + end if + call t_stopf ('qneg4') + + end subroutine qneg4 + + subroutine qneg_print_summary(end_of_run) + use spmd_utils, only: mpicom, masterprocid, masterproc + use spmd_utils, only: MPI_MIN, MPI_SUM, MPI_INTEGER, MPI_REAL8 + + logical, intent(in) :: end_of_run + + integer :: global_warn_num(pcnst) + real(r8) :: global_warn_worst(pcnst) + integer :: index, m + integer :: ierr + + if (collect_stats) then + if (timestep_reset .or. end_of_run) then + do index = 1, num3_bins + ! QNEG3 + call reset_stats(global_warn_num(:), global_warn_worst(:)) + call MPI_REDUCE(qneg3_warn_num(:, index), global_warn_num(:), & + pcnst, MPI_INTEGER, MPI_SUM, masterprocid, mpicom, ierr) + call MPI_REDUCE(qneg3_warn_worst(:, index), global_warn_worst(:),& + pcnst, MPI_REAL8, MPI_MIN, masterprocid, mpicom, ierr) + if (masterproc) then + do m = 1, pcnst + if ( (global_warn_num(m) > 0) .and. & + (abs(global_warn_worst(m)) > tol)) then + write(iulog, 9100) trim(qneg3_warn_labels(index)), & + trim(cnst_name(m)), global_warn_num(m), & + global_warn_worst(m) + end if + call shr_sys_flush(iulog) + end do + end if + call reset_stats(qneg3_warn_num(:,index), qneg3_warn_worst(:,index)) + end do + do index = 1, num4_bins + ! QNEG4 + call reset_stats(qneg4_warn_num(index), qneg4_warn_worst(index)) + call reset_stats(global_warn_num(1), global_warn_worst(1)) + call MPI_REDUCE(qneg4_warn_num(index), global_warn_num(1), & + 1, MPI_INTEGER, MPI_SUM, masterprocid, mpicom, ierr) + call MPI_REDUCE(qneg4_warn_worst(index), global_warn_worst(1), & + 1, MPI_REAL8, MPI_MIN, masterprocid, mpicom, ierr) + if (masterproc) then + if ( (global_warn_num(1) > 0) .and. & + (abs(global_warn_worst(1)) > tol)) then + write(iulog, 9101) trim(qneg4_warn_labels(index)), & + global_warn_num(1), global_warn_worst(1) + end if + call shr_sys_flush(iulog) + end if + call reset_stats(qneg4_warn_num(index), qneg4_warn_worst(index)) + end do + end if + end if + + return +9100 format(' QNEG3 from ', a, ':', a, & + ' Min. mixing ratio violated at ', i9, ' points. Worst = ', e10.1) +9101 format(' QNEG4 from ',a,': moisture flux exceeded at', & + i9, ' points. Worst = ', e10.1) + end subroutine qneg_print_summary + + subroutine reset_stats_array(num_array, worst_array) + ! Private routine to reset statistics + integer, intent(inout) :: num_array(:) + real(r8), intent(inout) :: worst_array(:) + + num_array(:) = 0 + worst_array(:) = worst_reset + end subroutine reset_stats_array + + subroutine reset_stats_scalar(num, worst) + ! Private routine to reset statistics + integer, intent(inout) :: num + real(r8), intent(inout) :: worst + + num = 0 + worst = worst_reset + end subroutine reset_stats_scalar + +end module qneg_module diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 new file mode 100644 index 0000000000..da2c705ee0 --- /dev/null +++ b/src/physics/cam/rad_constituents.F90 @@ -0,0 +1,2517 @@ +module rad_constituents + +!------------------------------------------------------------------------------------------------ +! +! Provide constituent distributions and properties to the radiation and +! cloud microphysics routines. +! +! The logic to control which constituents are used in the climate calculations +! and which are used in diagnostic radiation calculations is contained in this module. +! +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver +use physconst, only: rga +use physics_types, only: physics_state +use phys_control, only: use_simple_phys +use constituents, only: cnst_get_ind +use radconstants, only: nradgas, rad_gas_index, ot_length +use phys_prop, only: physprop_accum_unique_files, physprop_init, & + physprop_get_id +use cam_history, only: addfld, fieldname_len, outfld, horiz_only +use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + + +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +! Public interfaces + +public :: & + rad_cnst_readnl, &! read namelist values and parse + rad_cnst_init, &! find optics files and all constituents + rad_cnst_get_info, &! return info about climate/diagnostic lists + rad_cnst_get_mode_idx, &! return mode index of specified mode type + rad_cnst_get_spec_idx, &! return specie index of specified specie type + rad_cnst_get_gas, &! return pointer to mmr for gasses + rad_cnst_get_aer_mmr, &! return pointer to mmr for aerosols + rad_cnst_get_mam_mmr_idx, &! get constituent index of mam specie mmr (climate list only) + rad_cnst_get_aer_props, &! return physical properties for aerosols + rad_cnst_get_mode_props, &! return physical properties for aerosol modes + rad_cnst_get_mode_num, &! return mode number mixing ratio + rad_cnst_get_mode_num_idx, &! get constituent index of mode number m.r. (climate list only) + rad_cnst_out, &! output constituent diagnostics (mass per layer and column burden) + rad_cnst_get_call_list ! return list of active climate/diagnostic calls to radiation + +public :: rad_cnst_num_name + +integer, parameter :: cs1 = 256 +integer, public, parameter :: N_DIAG = 10 +character(len=cs1), public :: iceopticsfile, liqopticsfile +character(len=32), public :: icecldoptics,liqcldoptics +logical, public :: oldcldoptics = .false. + +! Private module data + +! max number of strings in mode definitions +integer, parameter :: n_mode_str = 60 + +! max number of externally mixed entities in the climate/diag lists +integer, parameter :: n_rad_cnst = N_RAD_CNST + +! Namelist variables +character(len=cs1), dimension(n_mode_str) :: mode_defs = ' ' +character(len=cs1) :: rad_climate(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_1(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_2(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_3(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_4(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_5(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_6(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_7(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_8(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_9(n_rad_cnst) = ' ' +character(len=cs1) :: rad_diag_10(n_rad_cnst) = ' ' + +! type to provide access to the components of a mode +type :: mode_component_t + integer :: nspec + ! For "source" variables below, value is: + ! 'N' if in pbuf (non-advected) + ! 'A' if in state (advected) + character(len= 1) :: source_num_a ! source of interstitial number conc field + character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 1) :: source_num_c ! source of cloud borne number conc field + character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! specie type (as used in MAM code) + character(len=cs1), pointer :: props(:) ! file containing specie properties + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module +end type mode_component_t + +! type to provide access to all modes +type :: modes_t + integer :: nmodes + character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists + character(len= 32), pointer :: types(:) ! type of mode (as used in MAM code) + type(mode_component_t), pointer :: comps(:) ! components which define the mode +end type modes_t + +type(modes_t), target :: modes ! mode definitions + +! type to provide access to the data parsed from the rad_climate and rad_diag_* strings +type :: rad_cnst_namelist_t + integer :: ncnst + character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), + ! 'M' for mode, 'Z' for zero + character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents + character(len=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation, + ! must be one of (rgaslist if a gas) or + ! (/fullpath/filename.nc if an aerosol) + character(len= 1), pointer :: type(:) ! 'A' if aerosol, 'G' if gas, 'M' if mode +end type rad_cnst_namelist_t + +type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in + ! climate/diagnostic calculations + +logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is + ! specified. Note that the 0th call is for the climate + ! calculation which is always made. + +! Storage for gas components in the climate/diagnostic lists + +type :: gas_t + character(len=1) :: source ! A for state (advected), N for pbuf (non-advected), Z for zero + character(len=64) :: camname ! name of constituent in physics state or buffer + character(len=32) :: mass_name ! name for mass per layer field in history output + integer :: idx ! index from constituents or from pbuf +end type gas_t + +type :: gaslist_t + integer :: ngas + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + type(gas_t), pointer :: gas(:) ! dimension(ngas) where ngas = nradgas is from radconstants +end type gaslist_t + +type(gaslist_t), target :: gaslist(0:N_DIAG) ! gasses used in climate/diagnostic calculations + +! Storage for bulk aerosol components in the climate/diagnostic lists + +type :: aerosol_t + character(len=1) :: source ! A for state (advected), N for pbuf (non-advected), Z for zero + character(len=64) :: camname ! name of constituent in physics state or buffer + character(len=cs1) :: physprop_file ! physprop filename + character(len=32) :: mass_name ! name for mass per layer field in history output + integer :: idx ! index of constituent in physics state or buffer + integer :: physprop_id ! ID used to access physical properties from phys_prop module +end type aerosol_t + +type :: aerlist_t + integer :: numaerosols ! number of aerosols + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + type(aerosol_t), pointer :: aer(:) ! dimension(numaerosols) +end type aerlist_t + +type(aerlist_t), target :: aerosollist(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs + +! storage for modal aerosol components in the climate/diagnostic lists + +type :: modelist_t + integer :: nmodes ! number of modes + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the mode in the mode definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object +end type modelist_t + +type(modelist_t), target :: ma_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs + + +! values for constituents with requested value of zero +real(r8), allocatable, target :: zero_cols(:,:) + +! define generic interface routines +interface rad_cnst_get_info + module procedure rad_cnst_get_info + module procedure rad_cnst_get_info_by_mode + module procedure rad_cnst_get_info_by_mode_spec + module procedure rad_cnst_get_info_by_spectype +end interface + +interface rad_cnst_get_aer_mmr + module procedure rad_cnst_get_aer_mmr_by_idx + module procedure rad_cnst_get_mam_mmr_by_idx +end interface + +interface rad_cnst_get_aer_props + module procedure rad_cnst_get_aer_props_by_idx + module procedure rad_cnst_get_mam_props_by_idx +end interface + +logical :: verbose = .true. +character(len=1), parameter :: nl = achar(10) + +integer, parameter :: num_mode_types = 8 +integer, parameter :: num_spec_types = 8 +character(len=14), parameter :: mode_type_names(num_mode_types) = (/ & + 'accum ', 'aitken ', 'primary_carbon', 'fine_seasalt ', & + 'fine_dust ', 'coarse ', 'coarse_seasalt', 'coarse_dust ' /) +character(len=9), parameter :: spec_type_names(num_spec_types) = (/ & + 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', & + 's-organic', 'black-c ', 'seasalt ', 'dust '/) + + +!============================================================================== +contains +!============================================================================== + +subroutine rad_cnst_readnl(nlfile) + + ! Read rad_cnst_nl namelist group. Parse input. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, i + character(len=2) :: suffix + character(len=1), pointer :: ctype(:) + character(len=*), parameter :: subname = 'rad_cnst_readnl' + + namelist /rad_cnst_nl/ mode_defs, & + rad_climate, & + rad_diag_1, & + rad_diag_2, & + rad_diag_3, & + rad_diag_4, & + rad_diag_5, & + rad_diag_6, & + rad_diag_7, & + rad_diag_8, & + rad_diag_9, & + rad_diag_10, & + iceopticsfile, & + liqopticsfile, & + icecldoptics, & + liqcldoptics, & + oldcldoptics + + !----------------------------------------------------------------------------- + + if (use_simple_phys) return + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rad_cnst_nl', status=ierr) + if (ierr == 0) then + read(unitn, rad_cnst_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast (mode_defs, len(mode_defs(1))*n_mode_str, mpichar, 0, mpicom) + call mpibcast (rad_climate, len(rad_climate(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_1, len(rad_diag_1(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_2, len(rad_diag_2(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_3, len(rad_diag_3(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_4, len(rad_diag_4(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_5, len(rad_diag_5(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_6, len(rad_diag_6(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_7, len(rad_diag_7(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_8, len(rad_diag_8(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_9, len(rad_diag_9(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (rad_diag_10, len(rad_diag_10(1))*n_rad_cnst, mpichar, 0, mpicom) + call mpibcast (iceopticsfile, len(iceopticsfile), mpichar, 0, mpicom) + call mpibcast (liqopticsfile, len(liqopticsfile), mpichar, 0, mpicom) + call mpibcast (liqcldoptics, len(liqcldoptics), mpichar, 0, mpicom) + call mpibcast (icecldoptics, len(icecldoptics), mpichar, 0, mpicom) + call mpibcast (oldcldoptics, 1, mpilog , 0, mpicom) +#endif + + ! Parse the namelist input strings + + ! Mode definition stings + call parse_mode_defs(mode_defs, modes) + + ! Lists of externally mixed entities for climate and diagnostic calculations + do i = 0,N_DIAG + select case (i) + case(0) + call parse_rad_specifier(rad_climate, namelist(i)) + case (1) + call parse_rad_specifier(rad_diag_1, namelist(i)) + case (2) + call parse_rad_specifier(rad_diag_2, namelist(i)) + case (3) + call parse_rad_specifier(rad_diag_3, namelist(i)) + case (4) + call parse_rad_specifier(rad_diag_4, namelist(i)) + case (5) + call parse_rad_specifier(rad_diag_5, namelist(i)) + case (6) + call parse_rad_specifier(rad_diag_6, namelist(i)) + case (7) + call parse_rad_specifier(rad_diag_7, namelist(i)) + case (8) + call parse_rad_specifier(rad_diag_8, namelist(i)) + case (9) + call parse_rad_specifier(rad_diag_9, namelist(i)) + case (10) + call parse_rad_specifier(rad_diag_10, namelist(i)) + end select + enddo + + ! were there any constituents specified for the nth diagnostic call? + ! if so, radiation will make a call with those consituents + active_calls(:) = (namelist(:)%ncnst > 0) + + ! Initialize the gas and aerosol lists with the information from the + ! namelist. This is done here so that this information is available via + ! the query functions at the time when the register methods are called. + + ! Set the list_id fields which distinquish the climate and diagnostic lists + do i = 0, N_DIAG + if (active_calls(i)) then + if (i > 0) then + write(suffix, fmt = '(i2.2)') i + else + suffix=' ' + end if + aerosollist(i)%list_id = suffix + gaslist(i)%list_id = suffix + ma_list(i)%list_id = suffix + end if + end do + + ! Create a list of the unique set of filenames containing property data + + ! Start with the bulk aerosol species in the climate/diagnostic lists. + ! The physprop_accum_unique_files routine has the side effect of returning the number + ! of bulk aerosols in each list (they're identified by type='A'). + do i = 0, N_DIAG + if (active_calls(i)) then + call physprop_accum_unique_files(namelist(i)%radname, namelist(i)%type) + endif + enddo + + ! Add physprop files for the species from the mode definitions. + do i = 1, modes%nmodes + allocate(ctype(modes%comps(i)%nspec)) + ctype = 'A' + call physprop_accum_unique_files(modes%comps(i)%props, ctype) + deallocate(ctype) + end do + + ! Initialize the gas, bulk aerosol, and modal aerosol lists. This step splits the + ! input climate/diagnostic lists into the corresponding gas, bulk and modal aerosol + ! lists. + if (masterproc) write(iulog,*) nl//subname//': Radiation constituent lists:' + do i = 0, N_DIAG + if (active_calls(i)) then + call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i)) + + if (masterproc .and. verbose) then + call print_lists(gaslist(i), aerosollist(i), ma_list(i)) + end if + + end if + end do + + if (masterproc .and. verbose) call print_modes(modes) + +end subroutine rad_cnst_readnl + +!================================================================================================ + +subroutine rad_cnst_init() + + ! The initialization of the gas and aerosol lists is finished by + ! 1) read the physprop files + ! 2) find the index of each constituent in the constituent or physics buffer arrays + ! 3) find the index of the aerosol constituents used to access its properties from the + ! physprop module. + + integer :: i + logical, parameter :: stricttest = .true. + character(len=*), parameter :: subname = 'rad_cnst_init' + !----------------------------------------------------------------------------- + + ! memory to point to if zero value requested + allocate(zero_cols(pcols,pver)) + zero_cols = 0._r8 + + ! Allocate storage for the physical properties of each aerosol; read properties from + ! the data files. + call physprop_init() + + ! Start checking that specified radiative constituents are present in the constituent + ! or physics buffer arrays. + if (masterproc) write(iulog,*) nl//subname//': checking for radiative constituents' + + ! Finish initializing the mode definitions. + call init_mode_comps(modes) + + ! Finish initializing the gas, bulk aerosol, and mode lists. + do i = 0, N_DIAG + if (active_calls(i)) then + call list_init2(gaslist(i), aerosollist(i), ma_list(i)) + end if + end do + + ! Check that all gases supported by the radiative transfer code have been specified. + if (stricttest) then + do i = 1, nradgas + if (gaslist(0)%gas(i)%source .eq. 'Z' ) then + call endrun(subname//': list of radiative gasses must include all radiation gasses for the climate specication') + endif + enddo + endif + + ! Initialize history output of climate diagnostic quantities + call rad_gas_diag_init(gaslist(0)) + call rad_aer_diag_init(aerosollist(0)) + + +end subroutine rad_cnst_init + +!================================================================================================ + +subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the gas from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: gasname + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: lchnk + integer :: igas + integer :: idx + character(len=1) :: source + type(gaslist_t), pointer :: list + character(len=*), parameter :: subname = 'rad_cnst_get_gas' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + list => gaslist(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + lchnk = state%lchnk + + ! Get index of gas in internal arrays. rad_gas_index will abort if the + ! specified gasname is not recognized by the radiative transfer code. + igas = rad_gas_index(trim(gasname)) + + ! Get data source + source = list%gas(igas)%source + idx = list%gas(igas)%idx + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_gas + +!================================================================================================ + +function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_out ) result(found) + + ! for a given species name spc_name_in return (optionals): + ! num_name_out -- corresponding number density species name + ! mode_out -- corresponding mode number + ! spec_out -- corresponding species number within the mode + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*),intent(in) :: spc_name_in + character(len=*),intent(out):: num_name_out + integer,optional,intent(out):: mode_out + integer,optional,intent(out):: spec_out + + logical :: found + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + integer :: n,m, mm + integer :: nmodes + integer :: nspecs + character(len= 32) :: spec_name + + found = .false. + + m_list => ma_list(list_idx) + nmodes = m_list%nmodes + + do n = 1,nmodes + mm = m_list%idx(n) + nspecs = modes%comps(mm)%nspec + do m = 1,nspecs + spec_name = modes%comps(mm)%camname_mmr_a(m) + if (spc_name_in == spec_name) then + num_name_out = modes%comps(mm)%camname_num_a + found = .true. + if (present(mode_out)) then + mode_out = n + endif + if (present(spec_out)) then + spec_out = m + endif + return + endif + enddo + enddo + + return + +end function + +!================================================================================================ + +subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & + use_data_o3, ngas, naero, nmodes) + + ! Return info about gas and aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=64), optional, intent(out) :: gasnames(:) + character(len=64), optional, intent(out) :: aernames(:) + logical, optional, intent(out) :: use_data_o3 + integer, optional, intent(out) :: naero + integer, optional, intent(out) :: ngas + integer, optional, intent(out) :: nmodes + + ! Local variables + type(gaslist_t), pointer :: g_list ! local pointer to gas list of interest + type(aerlist_t), pointer :: a_list ! local pointer to aerosol list of interest + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: i + integer :: arrlen ! length of assumed shape array + integer :: gaslen ! length of assumed shape array + integer :: igas ! index of a gas in the gas list + character(len=1) :: source ! A for state, N for pbuf, Z for zero + + character(len=*), parameter :: subname = 'rad_cnst_get_info' + !----------------------------------------------------------------------------- + + g_list => gaslist(list_idx) + a_list => aerosollist(list_idx) + m_list => ma_list(list_idx) + + ! number of bulk aerosols in list + if (present(naero)) then + naero = a_list%numaerosols + endif + + ! number of aerosol modes in list + if (present(nmodes)) then + nmodes = m_list%nmodes + endif + + ! number of gases in list + if (present(ngas)) then + ngas = g_list%ngas + endif + + ! names of aerosols in list + if (present(aernames)) then + + ! check that output array is long enough + arrlen = size(aernames) + if (arrlen < a_list%numaerosols) then + write(iulog,*) subname//': ERROR: naero=', a_list%numaerosols, ' arrlen=', arrlen + call endrun(subname//': ERROR: aernames too short') + end if + + do i = 1, a_list%numaerosols + aernames(i) = a_list%aer(i)%camname + end do + + end if + + ! names of gas in list + if (present(gasnames)) then + + ! check that output array is long enough + gaslen = size(gasnames) + if (gaslen < g_list%ngas) then + write(iulog,*) subname//': ERROR: ngas=', g_list%ngas, ' gaslen=', gaslen + call endrun(subname//': ERROR: gasnames too short') + end if + + do i = 1, g_list%ngas + gasnames(i) = g_list%gas(i)%camname + end do + + end if + + ! Does the climate calculation use data ozone? + if (present(use_data_o3)) then + + ! get index of O3 in gas list + igas = rad_gas_index('O3') + + ! Get data source + source = g_list%gas(igas)%source + + use_data_o3 = .false. + if (source == 'N') use_data_o3 = .true. + endif + +end subroutine rad_cnst_get_info + +!================================================================================================ + +subroutine rad_cnst_get_info_by_mode(list_idx, m_idx, & + mode_type, num_name, num_name_cw, nspec) + + ! Return info about modal aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of mode in the specified list + character(len=32), optional, intent(out) :: mode_type ! type of mode (as used in MAM code) + character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio + character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio + integer, optional, intent(out) :: nspec ! number of species in the mode + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: nmodes + integer :: mm + + character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode' + !----------------------------------------------------------------------------- + + m_list => ma_list(list_idx) + + ! check for valid mode index + nmodes = m_list%nmodes + if (m_idx < 1 .or. m_idx > nmodes) then + write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx + call endrun(subname//': ERROR - invalid mode index') + end if + + ! get index into the mode definition object + mm = m_list%idx(m_idx) + + ! mode type + if (present(mode_type)) then + mode_type = modes%types(mm) + endif + + ! number of species in the mode + if (present(nspec)) then + nspec = modes%comps(mm)%nspec + endif + + ! name of interstitial number mixing ratio + if (present(num_name)) then + num_name = modes%comps(mm)%camname_num_a + endif + + ! name of cloud borne number mixing ratio + if (present(num_name_cw)) then + num_name_cw = modes%comps(mm)%camname_num_c + endif + +end subroutine rad_cnst_get_info_by_mode + +!================================================================================================ + +subroutine rad_cnst_get_info_by_mode_spec(list_idx, m_idx, s_idx, & + spec_type, spec_name, spec_name_cw) + + ! Return info about modal aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of mode in the specified list + integer, intent(in) :: s_idx ! index of specie in the specified mode + character(len=32), optional, intent(out) :: spec_type ! type of specie + character(len=32), optional, intent(out) :: spec_name ! name of interstitial specie + character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne specie + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: nmodes + integer :: nspec + integer :: mm + + character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode_spec' + !----------------------------------------------------------------------------- + + m_list => ma_list(list_idx) + + ! check for valid mode index + nmodes = m_list%nmodes + if (m_idx < 1 .or. m_idx > nmodes) then + write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx + call endrun(subname//': ERROR - invalid mode index') + end if + + ! get index into the mode definition object + mm = m_list%idx(m_idx) + + ! check for valid specie index + nspec = modes%comps(mm)%nspec + if (s_idx < 1 .or. s_idx > nspec) then + write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx + call endrun(subname//': ERROR - invalid specie index') + end if + + ! specie type + if (present(spec_type)) then + spec_type = modes%comps(mm)%type(s_idx) + endif + + ! interstitial specie name + if (present(spec_name)) then + spec_name = modes%comps(mm)%camname_mmr_a(s_idx) + endif + + ! cloud borne specie name + if (present(spec_name_cw)) then + spec_name_cw = modes%comps(mm)%camname_mmr_c(s_idx) + endif + +end subroutine rad_cnst_get_info_by_mode_spec + +!================================================================================================ + +subroutine rad_cnst_get_info_by_spectype(list_idx, spectype, mode_idx, spec_idx) + + ! Return info about modes in the specified climate/diagnostics list + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: spectype ! species type + integer, optional, intent(out) :: mode_idx ! index of a mode that contains a specie of spectype + integer, optional, intent(out) :: spec_idx ! index of the species of spectype + + ! Local variables + type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + + integer :: i, nmodes, m_idx, nspec, ispec + logical :: found_spectype + + character(len=*), parameter :: subname = 'rad_cnst_get_info_by_spectype' + !----------------------------------------------------------------------------- + + m_list => ma_list(list_idx) + + ! number of modes in specified list + nmodes = m_list%nmodes + + ! loop through modes in specified climate/diagnostic list + found_spectype = .false. + do i = 1, nmodes + + ! get index of the mode in the definition object + m_idx = m_list%idx(i) + + ! number of species in the mode + nspec = modes%comps(m_idx)%nspec + + ! loop through species looking for spectype + do ispec = 1, nspec + + if (trim(modes%comps(m_idx)%type(ispec)) == trim(spectype)) then + if (present(mode_idx)) mode_idx = i + if (present(spec_idx)) spec_idx = ispec + found_spectype = .true. + exit + end if + end do + + if (found_spectype) exit + end do + + if (.not. found_spectype) then + if (present(mode_idx)) mode_idx = -1 + if (present(spec_idx)) spec_idx = -1 + end if + +end subroutine rad_cnst_get_info_by_spectype + +!================================================================================================ + +function rad_cnst_get_mode_idx(list_idx, mode_type) result(mode_idx) + + ! Return mode index of the specified type in the specified climate/diagnostics list. + ! Return -1 if not found. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + character(len=*), intent(in) :: mode_type ! mode type + + ! Return value + integer :: mode_idx ! mode index + + ! Local variables + type(modelist_t), pointer :: m_list + + integer :: i, nmodes, m_idx + + character(len=*), parameter :: subname = 'rad_cnst_get_mode_idx' + !----------------------------------------------------------------------------- + + ! if mode type not found return -1 + mode_idx = -1 + + ! specified mode list + m_list => ma_list(list_idx) + + ! number of modes in specified list + nmodes = m_list%nmodes + + ! loop through modes in specified climate/diagnostic list + do i = 1, nmodes + + ! get index of the mode in the definition object + m_idx = m_list%idx(i) + + ! look in mode definition object (modes) for the mode types + if (trim(modes%types(m_idx)) == trim(mode_type)) then + mode_idx = i + exit + end if + end do + +end function rad_cnst_get_mode_idx + +!================================================================================================ + +function rad_cnst_get_spec_idx(list_idx, mode_idx, spec_type) result(spec_idx) + + ! Return specie index of the specified type in the specified mode of the specified + ! climate/diagnostics list. Return -1 if not found. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + character(len=*), intent(in) :: spec_type ! specie type + + ! Return value + integer :: spec_idx ! specie index + + ! Local variables + type(modelist_t), pointer :: m_list + type(mode_component_t), pointer :: mode_comps + + integer :: i, m_idx, nspec + + character(len=*), parameter :: subname = 'rad_cnst_get_spec_idx' + !----------------------------------------------------------------------------- + + ! if specie type not found return -1 + spec_idx = -1 + + ! modes in specified list + m_list => ma_list(list_idx) + + ! get index of the specified mode in the definition object + m_idx = m_list%idx(mode_idx) + + ! object containing the components of the mode + mode_comps => modes%comps(m_idx) + + ! number of species in specified mode + nspec = mode_comps%nspec + + ! loop through species in specified mode + do i = 1, nspec + + ! look in mode definition object (modes) for the mode types + if (trim(mode_comps%type(i)) == trim(spec_type)) then + spec_idx = i + exit + end if + end do + +end function rad_cnst_get_spec_idx + +!================================================================================================ + +subroutine rad_cnst_get_call_list(call_list) + + ! Return info about which climate/diagnostic calculations are requested + + ! Arguments + logical, intent(out) :: call_list(0:N_DIAG) + !----------------------------------------------------------------------------- + + call_list(:) = active_calls(:) + +end subroutine rad_cnst_get_call_list + +!================================================================================================ + +subroutine rad_cnst_out(list_idx, state, pbuf) + + ! Output the mass per layer, and total column burdens for gas and aerosol + ! constituents in either the climate or diagnostic lists + + ! Arguments + integer, intent(in) :: list_idx + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + + ! Local variables + integer :: i, naer, ngas, lchnk, ncol + integer :: idx + character(len=1) :: source + character(len=32) :: name, cbname + real(r8) :: mass(pcols,pver) + real(r8) :: cb(pcols) + real(r8), pointer :: mmr(:,:) + type(aerlist_t), pointer :: aerlist + type(gaslist_t), pointer :: g_list + character(len=*), parameter :: subname = 'rad_cnst_out' + !----------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ! Associate pointer with requested aerosol list + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => aerosollist(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + naer = aerlist%numaerosols + do i = 1, naer + + source = aerlist%aer(i)%source + idx = aerlist%aer(i)%idx + name = aerlist%aer(i)%mass_name + ! construct name for column burden field by replacing the 'm_' prefix by 'cb_' + cbname = 'cb_' // name(3:len_trim(name)) + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + end select + + mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga + call outfld(trim(name), mass, pcols, lchnk) + + cb(:ncol) = sum(mass(:ncol,:),2) + call outfld(trim(cbname), cb, pcols, lchnk) + + end do + + ! Associate pointer with requested gas list + g_list => gaslist(list_idx) + + ngas = g_list%ngas + do i = 1, ngas + + source = g_list%gas(i)%source + idx = g_list%gas(i)%idx + name = g_list%gas(i)%mass_name + cbname = 'cb_' // name(3:len_trim(name)) + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + end select + + mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga + call outfld(trim(name), mass, pcols, lchnk) + + cb(:ncol) = sum(mass(:ncol,:),2) + call outfld(trim(cbname), cb, pcols, lchnk) + + end do + +end subroutine rad_cnst_out + +!================================================================================================ +! Private methods +!================================================================================================ + +subroutine init_mode_comps(modes) + + ! Initialize the mode definitions by looking up the relevent indices in the + ! constituent and pbuf arrays, and getting the physprop IDs + + ! Arguments + type(modes_t), intent(inout) :: modes + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'init_modes' + !----------------------------------------------------------------------------- + + do m = 1, modes%nmodes + + ! indices for number mixing ratio components + modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine) + modes%comps(m)%idx_num_c = get_cam_idx(modes%comps(m)%source_num_c, modes%comps(m)%camname_num_c, routine) + + ! allocate memory for species + nspec = modes%comps(m)%nspec + allocate( & + modes%comps(m)%idx_mmr_a(nspec), & + modes%comps(m)%idx_mmr_c(nspec), & + modes%comps(m)%idx_props(nspec) ) + + do ispec = 1, nspec + + ! indices for species mixing ratio components + modes%comps(m)%idx_mmr_a(ispec) = get_cam_idx(modes%comps(m)%source_mmr_a(ispec), & + modes%comps(m)%camname_mmr_a(ispec), routine) + modes%comps(m)%idx_mmr_c(ispec) = get_cam_idx(modes%comps(m)%source_mmr_c(ispec), & + modes%comps(m)%camname_mmr_c(ispec), routine) + + ! get physprop ID + modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) + if (modes%comps(m)%idx_props(ispec) == -1) then + call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec))) + end if + + end do + + end do + +end subroutine init_mode_comps + +!================================================================================================ + +integer function get_cam_idx(source, name, routine) + + ! get index of name in internal CAM array; either the constituent array + ! or the physics buffer + + character(len=*), intent(in) :: source + character(len=*), intent(in) :: name + character(len=*), intent(in) :: routine ! name of calling routine + + integer :: idx + integer :: errcode + !----------------------------------------------------------------------------- + + if (source(1:1) == 'N') then + + idx = pbuf_get_index(trim(name),errcode) + if (errcode < 0) then + call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name)) + end if + + else if (source(1:1) == 'A') then + + call cnst_get_ind(trim(name), idx, abort=.false.) + if (idx < 0) then + call endrun(routine//' ERROR: cannot find constituent field '//trim(name)) + end if + + else if (source(1:1) == 'Z') then + + idx = -1 + + else + + call endrun(routine//' ERROR: invalid source for specie '//trim(name)) + + end if + + get_cam_idx = idx + +end function get_cam_idx + +!================================================================================================ + +subroutine list_init1(namelist, gaslist, aerlist, ma_list) + + ! Initialize the gas and bulk and modal aerosol lists with the + ! entities specified in the climate or diagnostic lists. + + ! This first phase initialization just sets the information that + ! is available at the time the namelist is read. + + type(rad_cnst_namelist_t), intent(in) :: namelist ! parsed namelist input for climate or diagnostic lists + + type(gaslist_t), intent(inout) :: gaslist + type(aerlist_t), intent(inout) :: aerlist + type(modelist_t), intent(inout) :: ma_list + + + ! Local variables + integer :: ii, m, naero, nmodes + integer :: igas, ba_idx, ma_idx + integer :: istat + character(len=*), parameter :: routine = 'list_init1' + !----------------------------------------------------------------------------- + + ! nradgas is set by the radiative transfer code + gaslist%ngas = nradgas + + ! Determine the number of bulk aerosols and aerosol modes in the list + naero = 0 + nmodes = 0 + do ii = 1, namelist%ncnst + if (trim(namelist%type(ii)) == 'A') naero = naero + 1 + if (trim(namelist%type(ii)) == 'M') nmodes = nmodes + 1 + end do + aerlist%numaerosols = naero + ma_list%nmodes = nmodes + + ! allocate storage for the aerosol, gas, and mode lists + allocate( & + aerlist%aer(aerlist%numaerosols), & + gaslist%gas(gaslist%ngas), & + ma_list%idx(ma_list%nmodes), & + ma_list%physprop_files(ma_list%nmodes), & + ma_list%idx_props(ma_list%nmodes), & + stat=istat) + if (istat /= 0) call endrun(routine//': allocate ERROR; aero and gas list components') + + if (masterproc .and. verbose) then + if (len_trim(gaslist%list_id) == 0) then + write(iulog,*) nl//' '//routine//': namelist input for climate list' + else + write(iulog,*) nl//' '//routine//': namelist input for diagnostic list:'//gaslist%list_id + end if + end if + + ! Loop over the radiatively active components specified in the namelist + ba_idx = 0 + ma_idx = 0 + do ii = 1, namelist%ncnst + + if (masterproc .and. verbose) & + write(iulog,*) " rad namelist spec: "// trim(namelist%source(ii)) & + //":"//trim(namelist%camname(ii))//":"//trim(namelist%radname(ii)) + + ! Check that the source specifier is legal. + if (namelist%source(ii) /= 'A' .and. namelist%source(ii) /= 'M' .and. & + namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' ) then + call endrun(routine//": source must either be A, M, N or Z:"//& + " illegal specifier in namelist input: "//namelist%source(ii)) + end if + + ! Add component to appropriate list (gas, modal or bulk aerosol) + if (namelist%type(ii) == 'A') then + + ! Add to bulk aerosol list + ba_idx = ba_idx + 1 + + aerlist%aer(ba_idx)%source = namelist%source(ii) + aerlist%aer(ba_idx)%camname = namelist%camname(ii) + aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii) + + else if (namelist%type(ii) == 'M') then + + ! Add to modal aerosol list + ma_idx = ma_idx + 1 + + ! Look through the mode definitions for the name of the specified mode. The + ! index into the modes object all the information relevent to the mode definition. + ma_list%idx(ma_idx) = -1 + do m = 1, modes%nmodes + if (trim(namelist%camname(ii)) == trim(modes%names(m))) then + ma_list%idx(ma_idx) = m + exit + end if + end do + if (ma_list%idx(ma_idx) == -1) & + call endrun(routine//' ERROR cannot find mode name '//trim(namelist%camname(ii))) + + ! Also save the name of the physprop file + ma_list%physprop_files(ma_idx) = namelist%radname(ii) + + else + + ! Add to gas list + + ! The radiative transfer code requires the input of a specific set of gases + ! which is hardwired into the code. The CAM interface to the RT code uses + ! the names in the radconstants module to refer to these gases. The user + ! interface (namelist) also uses these names to identify the gases treated + ! by the RT code. We use the index order set in radconstants for convenience + ! only. + + ! First check that the gas name specified by the user is allowed. + ! rad_gas_index will abort on illegal names. + igas = rad_gas_index(namelist%radname(ii)) + + ! Set values in the igas index + gaslist%gas(igas)%source = namelist%source(ii) + gaslist%gas(igas)%camname = namelist%camname(ii) + + end if + end do + +end subroutine list_init1 + +!================================================================================================ + +subroutine list_init2(gaslist, aerlist, ma_list) + + ! Final initialization phase gets the component indices in the constituent array + ! and the physics buffer, and indices into physprop module. + + type(gaslist_t), intent(inout) :: gaslist + type(aerlist_t), intent(inout) :: aerlist + type(modelist_t), intent(inout) :: ma_list + + ! Local variables + integer :: i + character(len=*), parameter :: routine = 'list_init2' + !----------------------------------------------------------------------------- + + ! Loop over gases + do i = 1, gaslist%ngas + + ! locate the specie mixing ratio in the pbuf or state + gaslist%gas(i)%idx = get_cam_idx(gaslist%gas(i)%source, gaslist%gas(i)%camname, routine) + + end do + + ! Loop over bulk aerosols + do i = 1, aerlist%numaerosols + + ! locate the specie mixing ratio in the pbuf or state + aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine) + + ! get the physprop_id from the phys_prop module + aerlist%aer(i)%physprop_id = physprop_get_id(aerlist%aer(i)%physprop_file) + + end do + + ! Loop over modes + do i = 1, ma_list%nmodes + + ! get the physprop_id from the phys_prop module + ma_list%idx_props(i) = physprop_get_id(ma_list%physprop_files(i)) + + end do + +end subroutine list_init2 + +!================================================================================================ + +subroutine rad_gas_diag_init(glist) + +! Add diagnostic fields to the master fieldlist. + + type(gaslist_t), intent(inout) :: glist + + integer :: i, ngas + character(len=64) :: name + character(len=2) :: list_id + character(len=4) :: suffix + character(len=128):: long_name + character(len=32) :: long_name_description + !----------------------------------------------------------------------------- + + ngas = glist%ngas + if (ngas == 0) return + + ! Determine whether this is a climate or diagnostic list. + list_id = glist%list_id + if (len_trim(list_id) == 0) then + suffix = '_c' + long_name_description = ' used in climate calculation' + else + suffix = '_d' // list_id + long_name_description = ' used in diagnostic calculation' + end if + + do i = 1, ngas + + ! construct names for mass per layer diagnostics + name = 'm_' // trim(glist%gas(i)%camname) // trim(suffix) + glist%gas(i)%mass_name = name + long_name = trim(glist%gas(i)%camname)//' mass per layer'//long_name_description + call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) + + ! construct names for column burden diagnostics + name = 'cb_' // trim(glist%gas(i)%camname) // trim(suffix) + long_name = trim(glist%gas(i)%camname)//' column burden'//long_name_description + call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) + + ! error check for name length + if (len_trim(name) > fieldname_len) then + write(iulog,*) 'rad_gas_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters' + call endrun('rad_gas_diag_init: name too long: '//trim(name)) + end if + + end do + +end subroutine rad_gas_diag_init + +!================================================================================================ + +subroutine rad_aer_diag_init(alist) + +! Add diagnostic fields to the master fieldlist. + + type(aerlist_t), intent(inout) :: alist + + integer :: i, naer + character(len=64) :: name + character(len=2) :: list_id + character(len=4) :: suffix + character(len=128):: long_name + character(len=32) :: long_name_description + !----------------------------------------------------------------------------- + + naer = alist%numaerosols + if (naer == 0) return + + ! Determine whether this is a climate or diagnostic list. + list_id = alist%list_id + if (len_trim(list_id) == 0) then + suffix = '_c' + long_name_description = ' used in climate calculation' + else + suffix = '_d' // list_id + long_name_description = ' used in diagnostic calculation' + end if + + do i = 1, naer + + ! construct names for mass per layer diagnostic fields + name = 'm_' // trim(alist%aer(i)%camname) // trim(suffix) + alist%aer(i)%mass_name = name + long_name = trim(alist%aer(i)%camname)//' mass per layer'//long_name_description + call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name)) + + ! construct names for column burden diagnostic fields + name = 'cb_' // trim(alist%aer(i)%camname) // trim(suffix) + long_name = trim(alist%aer(i)%camname)//' column burden'//long_name_description + call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name)) + + ! error check for name length + if (len_trim(name) > fieldname_len) then + write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters' + call endrun('rad_aer_diag_init: name too long: '//trim(name)) + end if + + end do + +end subroutine rad_aer_diag_init + + +!================================================================================================ + +subroutine parse_mode_defs(nl_in, modes) + + ! Parse the mode definition specifiers. The specifiers are of the form: + ! + ! 'mode_name:mode_type:=', + ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+', + ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,] + ! ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+]['] + ! + ! where the ':' separated fields are: + ! mode_name -- name of the mode. + ! mode_type -- type of mode. Valid values are from the MAM code. + ! = -- this line terminator identifies the initial string in a + ! mode definition + ! + -- this line terminator indicates that the mode definition is + ! continued in the next string + ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z' + ! camname_num_a -- the name of the interstitial number component. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z' + ! camname_num_c -- the name of the cloud borne number component. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z' + ! camname_mmr_a -- the name of the interstitial specie. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z' + ! camname_mmr_c -- the name of the cloud borne specie. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! spec_type -- species type. Valid values far from the MAM code, except that + ! the value 'num_mr' designates a number mixing ratio and has no + ! associated field for the prop_file. There can only be one entry + ! with the num_mr type in a mode definition. + ! prop_file -- For aerosol species this is a filename, which is + ! identified by a ".nc" suffix. The file contains optical and + ! other physical properties of the aerosol. + ! + ! A mode definition must contain only 1 string for the number mixing ratio components + ! and at least 1 string for the species. + + + character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output) + type(modes_t), intent(inout) :: modes ! structure containing parsed input + + ! Local variables + integer :: m + integer :: istat + integer :: nmodes, nstr + integer :: mbeg, mcur + integer :: nspec, ispec + integer :: strlen, iend, ipos + logical :: num_mr_found + character(len=*), parameter :: routine = 'parse_mode_defs' + character(len=len(nl_in(1))) :: tmpstr + character(len=1) :: tmp_src_a + character(len=32) :: tmp_name_a + character(len=1) :: tmp_src_c + character(len=32) :: tmp_name_c + character(len=32) :: tmp_type + !------------------------------------------------------------------------- + + ! Determine number of modes defined by counting number of strings that are + ! terminated by ':=' + ! (algorithm stops counting at first blank element). + nmodes = 0 + nstr = 0 + do m = 1, n_mode_str + + if (len_trim(nl_in(m)) == 0) exit + nstr = nstr + 1 + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(nl_in(m)) + nl_in(m) = tmpstr + do + strlen = len_trim(nl_in(m)) + ipos = index(nl_in(m), ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen) + nl_in(m) = tmpstr + end do + ! count strings with ':=' terminator + if (nl_in(m)(strlen-1:strlen) == ':=') nmodes = nmodes + 1 + + end do + modes%nmodes = nmodes + + ! return if no modes defined + if (nmodes == 0) return + + ! allocate components that depend on nmodes + allocate( & + modes%names(nmodes), & + modes%types(nmodes), & + modes%comps(nmodes), & + stat=istat ) + if (istat > 0) then + write(iulog,*) routine//': ERROR: cannot allocate storage for modes. nmodes=', nmodes + call endrun(routine//': ERROR allocating storage for modes') + end if + + + mcur = 1 ! index of current string being processed + + ! loop over modes + do m = 1, nmodes + + mbeg = mcur ! remember the first string of a mode + + ! check that first string in mode definition is ':=' terminated + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur)) + + ! count species in mode definition. definition will contain 1 string with + ! with a ':+' terminator for each specie + nspec = 0 + mcur = mcur + 1 + do + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':+') exit + nspec = nspec + 1 + mcur = mcur + 1 + end do + + ! a mode must have at least one specie + if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg)) + + ! allocate components that depend on number of species + allocate( & + modes%comps(m)%source_mmr_a(nspec), & + modes%comps(m)%camname_mmr_a(nspec), & + modes%comps(m)%source_mmr_c(nspec), & + modes%comps(m)%camname_mmr_c(nspec), & + modes%comps(m)%type(nspec), & + modes%comps(m)%props(nspec), & + stat=istat) + + if (istat > 0) then + write(iulog,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec + call endrun(routine//': ERROR allocating storage for species') + end if + + ! initialize components + modes%comps(m)%nspec = nspec + modes%comps(m)%source_num_a = ' ' + modes%comps(m)%camname_num_a = ' ' + modes%comps(m)%source_num_c = ' ' + modes%comps(m)%camname_num_c = ' ' + do ispec = 1, nspec + modes%comps(m)%source_mmr_a(ispec) = ' ' + modes%comps(m)%camname_mmr_a(ispec) = ' ' + modes%comps(m)%source_mmr_c(ispec) = ' ' + modes%comps(m)%camname_mmr_c(ispec) = ' ' + modes%comps(m)%type(ispec) = ' ' + modes%comps(m)%props(ispec) = ' ' + end do + + ! return to first string in mode definition + mcur = mbeg + tmpstr = nl_in(mcur) + + ! mode name + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('mode name not found', tmpstr) + modes%names(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! mode type + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('mode type not found', tmpstr) + ! check for valid mode type + call check_mode_type(tmpstr, 1, ipos-1) + modes%types(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! mode type must be followed by '=' + if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr) + + ! move to next string + mcur = mcur + 1 + tmpstr = nl_in(mcur) + + ! process mode component strings + num_mr_found = .false. ! keep track of whether number mixing ratio component is found + ispec = 0 ! keep track of the number of species found + do + + ! source of interstitial component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find source field first', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of interstitial component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! source of cloud borne component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find a source field', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of cloud borne component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! component type + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + if (tmpstr(:ipos-1) == 'num_mr') then + + ! there can only be one number mixing ratio component + if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur)) + + num_mr_found = .true. + modes%comps(m)%source_num_a = tmp_src_a + modes%comps(m)%camname_num_a = tmp_name_a + modes%comps(m)%source_num_c = tmp_src_c + modes%comps(m)%camname_num_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else + + ! check for valid specie type + call check_specie_type(tmpstr, 1, ipos-1) + tmp_type = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! get the properties file + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + ! check for valid filename -- must have .nc extension + if (tmpstr(ipos-3:ipos-1) /= '.nc') & + call parse_error('filename not valid', tmpstr) + + ispec = ispec + 1 + modes%comps(m)%source_mmr_a(ispec) = tmp_src_a + modes%comps(m)%camname_mmr_a(ispec) = tmp_name_a + modes%comps(m)%source_mmr_c(ispec) = tmp_src_c + modes%comps(m)%camname_mmr_c(ispec) = tmp_name_c + modes%comps(m)%type(ispec) = tmp_type + modes%comps(m)%props(ispec) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + end if + + ! check if there are more components. either the current character is + ! a ' ' which means this string is the final mode component, or the character + ! is a '+' which means there are more components + if (tmpstr(1:1) == ' ') exit + + if (tmpstr(1:1) /= '+') & + call parse_error('+ field not found', tmpstr) + + ! continue to next component... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do + + ! check that a number component was found + if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg)) + + ! check that the right number of species were found + if (ispec /= nspec) call parse_error('component parsing got wrong number of species', nl_in(mbeg)) + + ! continue to next mode... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do + + !------------------------------------------------------------------------------------------------ + contains + !------------------------------------------------------------------------------------------------ + + ! internal subroutines used for error checking and reporting + + subroutine parse_error(msg, str) + + character(len=*), intent(in) :: msg + character(len=*), intent(in) :: str + + write(iulog,*) routine//': ERROR: '//msg + write(iulog,*) ' input string: '//trim(str) + call endrun(routine//': ERROR: '//msg) + + end subroutine parse_error + + !------------------------------------------------------------------------------------------------ + + subroutine check_specie_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie + + integer :: i + + do i = 1, num_spec_types + if (str(ib:ie) == trim(spec_type_names(i))) return + end do + + call parse_error('specie type not valid', str(ib:ie)) + + end subroutine check_specie_type + + !------------------------------------------------------------------------------------------------ + + subroutine check_mode_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie ! begin, end character of mode type substring + + integer :: i + + do i = 1, num_mode_types + if (str(ib:ie) == trim(mode_type_names(i))) return + end do + + call parse_error('mode type not valid', str(ib:ie)) + + end subroutine check_mode_type + + !------------------------------------------------------------------------------------------------ + +end subroutine parse_mode_defs + +!================================================================================================ + +subroutine parse_rad_specifier(specifier, namelist_data) + +!----------------------------------------------------------------------------- +! Private method for parsing the radiation namelist specifiers. The specifiers +! are of the form 'source_camname:radname' where: +! source -- either 'N' for pbuf (non-advected) or 'A' for state (advected) +! camname -- the name of a constituent that must be found in the constituent +! component of the state when source=A or in the physics buffer +! when source=N +! radname -- For gases this is a name that identifies the constituent to the +! radiative transfer codes. These names are contained in the +! radconstants module. For aerosols this is a filename, which is +! identified by a ".nc" suffix. The file contains optical and +! other physical properties of the aerosol. +! +! This code also identifies whether the constituent is a gas or an aerosol +! and adds that info to a structure that stores the parsed data. +!----------------------------------------------------------------------------- + + character(len=*), dimension(:), intent(in) :: specifier + type(rad_cnst_namelist_t), intent(inout) :: namelist_data + + ! Local variables + integer :: number, i, j + integer :: ipos, strlen + integer :: astat + character(len=cs1) :: tmpstr + character(len=1) :: source(n_rad_cnst) + character(len=64) :: camname(n_rad_cnst) + character(len=cs1) :: radname(n_rad_cnst) + character(len=1) :: type(n_rad_cnst) + !------------------------------------------------------------------------- + + number = 0 + + parse_loop: do i = 1, n_rad_cnst + if ( len_trim(specifier(i)) == 0 ) then + exit parse_loop + endif + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(specifier(i)) + do + strlen = len_trim(tmpstr) + ipos = index(tmpstr, ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + end do + + ! Locate the ':' separating source from camname. + j = index(tmpstr, ':') + source(i) = tmpstr(:j-1) + tmpstr = tmpstr(j+1:) + + ! locate the ':' separating camname from radname + j = scan(tmpstr, ':') + + camname(i) = tmpstr(:j-1) + radname(i) = tmpstr(j+1:) + + ! determine the type of constituent + if (source(i) == 'M') then + type(i) = 'M' + else if(index(radname(i),".nc") .gt. 0) then + type(i) = 'A' + else + type(i) = 'G' + end if + + number = number+1 + end do parse_loop + + namelist_data%ncnst = number + + if (number == 0) return + + allocate(namelist_data%source (number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%source') + allocate(namelist_data%camname(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%camname') + allocate(namelist_data%radname(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%radname') + allocate(namelist_data%type(number), stat=astat) + if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%type') + + namelist_data%source(:namelist_data%ncnst) = source (:namelist_data%ncnst) + namelist_data%camname(:namelist_data%ncnst) = camname(:namelist_data%ncnst) + namelist_data%radname(:namelist_data%ncnst) = radname(:namelist_data%ncnst) + namelist_data%type(:namelist_data%ncnst) = type(:namelist_data%ncnst) + +end subroutine parse_rad_specifier + +!================================================================================================ + +subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the aerosol from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: aer_idx + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: lchnk + integer :: idx + character(len=1) :: source + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = 'rad_cnst_get_aer_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => aerosollist(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + lchnk = state%lchnk + + ! Check for valid input aerosol index + if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then + write(iulog,*) subname//': aer_idx= ', aer_idx, ' numaerosols= ', aerlist%numaerosols + call endrun(subname//': aerosol list index out of range') + end if + + ! Get data source + source = aerlist%aer(aer_idx)%source + idx = aerlist%aer(aer_idx)%idx + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_aer_mmr_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => ma_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Get data source + if (phase == 'a') then + source = modes%comps(m_idx)%source_mmr_a(spec_idx) + idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + else if (phase == 'c') then + source = modes%comps(m_idx)%source_mmr_c(spec_idx) + idx = modes%comps(m_idx)%idx_mmr_c(spec_idx) + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_mam_mmr_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) + + ! Return constituent index of mam specie mass mixing ratio for aerosol modes in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + ! Arguments + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + integer, intent(out) :: idx ! index of specie in the constituent array + + ! Local variables + integer :: m_idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' + !----------------------------------------------------------------------------- + + ! assume climate list (i.e., species are in the constituent array) + mlist => ma_list(0) + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Assume data source is interstitial since that's what's in the constituent array + idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + +end subroutine rad_cnst_get_mam_mmr_idx + +!================================================================================================ + +subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) + + ! Return pointer to number mixing ratio for the aerosol mode from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: num(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => ma_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Get data source + if (phase == 'a') then + source = modes%comps(m_idx)%source_num_a + idx = modes%comps(m_idx)%idx_num_a + else if (phase == 'c') then + source = modes%comps(m_idx)%source_num_c + idx = modes%comps(m_idx)%idx_num_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + lchnk = state%lchnk + + select case( source ) + case ('A') + num => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, num) + case ('Z') + num => zero_cols + end select + +end subroutine rad_cnst_get_mode_num + +!================================================================================================ + +subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx) + + ! Return constituent index of mode number mixing ratio for the aerosol mode in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + ! Arguments + integer, intent(in) :: mode_idx ! mode index + integer, intent(out) :: cnst_idx ! constituent index + + ! Local variables + integer :: m_idx + character(len=1) :: source + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' + !----------------------------------------------------------------------------- + + ! assume climate list + mlist => ma_list(0) + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check that source is 'A' which means the index is for the constituent array + source = modes%comps(m_idx)%source_num_a + if (source /= 'A') then + write(iulog,*) subname//': source= ', source + call endrun(subname//': requested mode number index not in constituent array') + end if + + ! Return index in constituent array + cnst_idx = modes%comps(m_idx)%idx_num_a + +end subroutine rad_cnst_get_mode_num_idx + +!================================================================================================ + +integer function rad_cnst_get_aer_idx(list_idx, aer_name) + + ! Return the index of aerosol aer_name in the list specified by list_idx. + + ! Arguments + integer, intent(in) :: list_idx ! 0 for climate list, 1-N_DIAG for diagnostic lists + character(len=*), intent(in) :: aer_name ! aerosol name (in state or pbuf) + + ! Local variables + integer :: i, aer_idx + type(aerlist_t), pointer :: aerlist + character(len=*), parameter :: subname = "rad_cnst_get_aer_idx" + !------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => aerosollist(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Get index in aerosol list for requested name + aer_idx = -1 + do i = 1, aerlist%numaerosols + if (trim(aer_name) == trim(aerlist%aer(i)%camname)) then + aer_idx = i + exit + end if + end do + + if (aer_idx == -1) call endrun(subname//": ERROR - name not found") + + rad_cnst_get_aer_idx = aer_idx + +end function rad_cnst_get_aer_idx + +!================================================================================================ + +subroutine rad_cnst_get_aer_props_by_idx(list_idx, & + aer_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, num_to_mass_aer) + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + use phys_prop, only: physprop_get + + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: aer_idx ! index of the aerosol + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + ! Local variables + integer :: id + character(len=*), parameter :: subname = 'rad_cnst_get_aer_props_by_idx' + type(aerlist_t), pointer :: aerlist + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + aerlist => aerosollist(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then + write(iulog,*) subname//': aerosol list index out of range: ', aer_idx ,' list index: ',list_idx + call endrun(subname//': aer_idx out of range') + end if + + id = aerlist%aer(aer_idx)%physprop_id + + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) + + if (present(aername)) call physprop_get(id, aername=aername) + if (present(density_aer)) call physprop_get(id, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer) + + if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(id, mu=mu) + +end subroutine rad_cnst_get_aer_props_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mam_props_by_idx(list_idx, & + mode_idx, spec_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, spectype) + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + use phys_prop, only: physprop_get + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + character(len=32), optional, intent(out) :: spectype + + ! Local variables + integer :: m_idx, id + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_props_by_idx' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => ma_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + id = modes%comps(m_idx)%idx_props(spec_idx) + + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) + + if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(id, mu=mu) + + if (present(aername)) call physprop_get(id, aername=aername) + if (present(density_aer)) call physprop_get(id, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer) + + if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx) + +end subroutine rad_cnst_get_mam_props_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & + extpsw, abspsw, asmpsw, absplw, refrtabsw, & + refitabsw, refrtablw, refitablw, ncoef, prefr, & + prefi, sigmag, dgnum, dgnumlo, dgnumhi, & + rhcrystal, rhdeliques) + + ! Return requested properties for the mode from the specified + ! climate or diagnostic list. + + use phys_prop, only: physprop_get + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + + real(r8), optional, pointer :: extpsw(:,:,:,:) + real(r8), optional, pointer :: abspsw(:,:,:,:) + real(r8), optional, pointer :: asmpsw(:,:,:,:) + real(r8), optional, pointer :: absplw(:,:,:,:) + real(r8), optional, pointer :: refrtabsw(:,:) + real(r8), optional, pointer :: refitabsw(:,:) + real(r8), optional, pointer :: refrtablw(:,:) + real(r8), optional, pointer :: refitablw(:,:) + integer, optional, intent(out) :: ncoef + integer, optional, intent(out) :: prefr + integer, optional, intent(out) :: prefi + real(r8), optional, intent(out) :: sigmag + real(r8), optional, intent(out) :: dgnum + real(r8), optional, intent(out) :: dgnumlo + real(r8), optional, intent(out) :: dgnumhi + real(r8), optional, intent(out) :: rhcrystal + real(r8), optional, intent(out) :: rhdeliques + + ! Local variables + integer :: id + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mode_props' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => ma_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the physprop index for the requested mode + id = mlist%idx_props(mode_idx) + + if (present(extpsw)) call physprop_get(id, extpsw=extpsw) + if (present(abspsw)) call physprop_get(id, abspsw=abspsw) + if (present(asmpsw)) call physprop_get(id, asmpsw=asmpsw) + if (present(absplw)) call physprop_get(id, absplw=absplw) + + if (present(refrtabsw)) call physprop_get(id, refrtabsw=refrtabsw) + if (present(refitabsw)) call physprop_get(id, refitabsw=refitabsw) + if (present(refrtablw)) call physprop_get(id, refrtablw=refrtablw) + if (present(refitablw)) call physprop_get(id, refitablw=refitablw) + + if (present(ncoef)) call physprop_get(id, ncoef=ncoef) + if (present(prefr)) call physprop_get(id, prefr=prefr) + if (present(prefi)) call physprop_get(id, prefi=prefi) + if (present(sigmag)) call physprop_get(id, sigmag=sigmag) + if (present(dgnum)) call physprop_get(id, dgnum=dgnum) + if (present(dgnumlo)) call physprop_get(id, dgnumlo=dgnumlo) + if (present(dgnumhi)) call physprop_get(id, dgnumhi=dgnumhi) + if (present(rhcrystal)) call physprop_get(id, rhcrystal=rhcrystal) + if (present(rhdeliques)) call physprop_get(id, rhdeliques=rhdeliques) + +end subroutine rad_cnst_get_mode_props + +!================================================================================================ + +subroutine print_modes(modes) + + type(modes_t), intent(inout) :: modes + + integer :: i, m + !--------------------------------------------------------------------------------------------- + + write(iulog,*)' Mode Definitions' + + do m = 1, modes%nmodes + + write(iulog,*) nl//' name=',trim(modes%names(m)),' type=',trim(modes%types(m)) + write(iulog,*) ' src_a=',trim(modes%comps(m)%source_num_a),' num_a=',trim(modes%comps(m)%camname_num_a), & + ' src_c=',trim(modes%comps(m)%source_num_c),' num_c=',trim(modes%comps(m)%camname_num_c) + + do i = 1, modes%comps(m)%nspec + + write(iulog,*) ' src_a=',trim(modes%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(modes%comps(m)%camname_mmr_a(i)), & + ' src_c=',trim(modes%comps(m)%source_mmr_c(i)), ' mmr_c=',trim(modes%comps(m)%camname_mmr_c(i)), & + ' type=',trim(modes%comps(m)%type(i)) + write(iulog,*) ' prop file=', trim(modes%comps(m)%props(i)) + end do + + end do + +end subroutine print_modes + +!================================================================================================ + +subroutine print_lists(gas_list, aer_list, ma_list) + + ! Print summary of gas, bulk and modal aerosol lists. This is just the information + ! read from the namelist. + + use radconstants, only: gascnst=>gaslist + + type(aerlist_t), intent(in) :: aer_list + type(gaslist_t), intent(in) :: gas_list + type(modelist_t), intent(in) :: ma_list + + integer :: i, id + + if (len_trim(gas_list%list_id) == 0) then + write(iulog,*) nl//' gas list for climate calculations' + else + write(iulog,*) nl//' gas list for diag'//gas_list%list_id//' calculations' + end if + + do i = 1, nradgas + if (gas_list%gas(i)%source .eq. 'N') then + write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//& + trim(gas_list%gas(i)%camname) + else if (gas_list%gas(i)%source .eq. 'A') then + write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has constituents name:'//& + trim(gas_list%gas(i)%camname) + endif + enddo + + if (len_trim(aer_list%list_id) == 0) then + write(iulog,*) nl//' bulk aerosol list for climate calculations' + else + write(iulog,*) nl//' bulk aerosol list for diag'//aer_list%list_id//' calculations' + end if + + do i = 1, aer_list%numaerosols + write(iulog,*) ' '//trim(aer_list%aer(i)%source)//':'//trim(aer_list%aer(i)%camname)//& + ' optics and phys props in :'//trim(aer_list%aer(i)%physprop_file) + enddo + + if (len_trim(ma_list%list_id) == 0) then + write(iulog,*) nl//' modal aerosol list for climate calculations' + else + write(iulog,*) nl//' modal aerosol list for diag'//ma_list%list_id//' calculations' + end if + + do i = 1, ma_list%nmodes + id = ma_list%idx(i) + write(iulog,*) ' '//trim(modes%names(id)) + enddo + +end subroutine print_lists + +!================================================================================================ + +end module rad_constituents diff --git a/src/physics/cam/radheat.F90 b/src/physics/cam/radheat.F90 new file mode 100644 index 0000000000..dabf94accf --- /dev/null +++ b/src/physics/cam/radheat.F90 @@ -0,0 +1,126 @@ + +module radheat +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use physics_types, only: physics_state, physics_ptend, physics_ptend_init + +use physics_buffer, only : physics_buffer_desc + +implicit none +private +save + +! Public interfaces +public & + radheat_readnl, &! + radheat_init, &! + radheat_timestep_init, &! + radheat_tend ! return net radiative heating + +public :: radheat_disable_waccm ! disable waccm heating in the upper atm + +!=============================================================================== +contains +!=============================================================================== + +subroutine radheat_readnl(nlfile) + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! No options for this version of radheat; this is just a stub. + +end subroutine radheat_readnl + +!================================================================================================ + +subroutine radheat_init(pref_mid) + + use pmgrid, only: plev + use physics_buffer, only : physics_buffer_desc + + real(r8), intent(in) :: pref_mid(plev) + + +end subroutine radheat_init + +!================================================================================================ + +subroutine radheat_timestep_init (state, pbuf2d) + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + +end subroutine radheat_timestep_init + +!================================================================================================ + +subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, asdir, net_flx) +#if ( defined OFFLINE_DYN ) + use metdata, only: met_rlx, met_srf_feedback +#endif +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + +! Arguments + type(physics_state), intent(in) :: state ! Physics state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencie + real(r8), intent(in) :: qrl(pcols,pver) ! longwave heating + real(r8), intent(in) :: qrs(pcols,pver) ! shortwave heating + real(r8), intent(in) :: fsns(pcols) ! Surface solar absorbed flux + real(r8), intent(in) :: fsnt(pcols) ! Net column abs solar flux at model top + real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux + real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top + real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo + real(r8), intent(out) :: net_flx(pcols) + + +! Local variables + integer :: i, k + integer :: ncol +!----------------------------------------------------------------------- + + ncol = state%ncol + + call physics_ptend_init(ptend,state%psetcols, 'radheat', ls=.true.) + +#if ( defined OFFLINE_DYN ) + ptend%s(:ncol,:) = 0._r8 + do k = 1,pver + if (met_rlx(k) < 1._r8 .or. met_srf_feedback) then + ptend%s(:ncol,k) = (qrs(:ncol,k) + qrl(:ncol,k)) + endif + enddo +#else + ptend%s(:ncol,:) = (qrs(:ncol,:) + qrl(:ncol,:)) +#endif + + do i = 1, ncol + net_flx(i) = fsnt(i) - fsns(i) - flnt(i) + flns(i) + end do + +end subroutine radheat_tend + +!================================================================================================ + subroutine radheat_disable_waccm() + end subroutine radheat_disable_waccm +end module radheat diff --git a/src/physics/cam/radiation_data.F90 b/src/physics/cam/radiation_data.F90 new file mode 100644 index 0000000000..7c138fa65f --- /dev/null +++ b/src/physics/cam/radiation_data.F90 @@ -0,0 +1,1179 @@ +!================================================================================================ +! output/input data necessary to drive radiation offline +! Francis Vitt -- Created 15 Dec 2009 +!================================================================================================ +module radiation_data + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only : pcols, pver, pverp, begchunk, endchunk + use cam_history, only: addfld, add_default, horiz_only, outfld + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_gas, rad_cnst_get_aer_mmr + use radconstants, only: nradgas, gaslist + use cam_history_support, only: fieldname_len, fillvalue + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + + use drv_input_data,only: drv_input_data_t + use drv_input_data,only: drv_input_data_get, drv_input_2d_t, drv_input_3d_t, drv_input_4d_t, drv_input_2di_t + use physics_types, only: physics_state + use physics_buffer,only: physics_buffer_desc, pbuf_get_chunk + + implicit none + private + + public :: rad_data_readnl + public :: rad_data_register + public :: rad_data_init + public :: rad_data_write + public :: rad_data_read + public :: rad_data_enable + + integer :: volcgeom_ifld, volcgeom1_ifld, volcgeom2_ifld, volcgeom3_ifld + integer :: cld_ifld,rel_ifld,rei_ifld + integer :: dei_ifld,mu_ifld,lambdac_ifld,iciwp_ifld,iclwp_ifld + integer :: des_ifld,icswp_ifld,cldfsnow_ifld + integer :: cldemis_ifld, cldtau_ifld, cicewp_ifld, cliqwp_ifld, nmxrgn_ifld, pmxrgn_ifld + integer :: qrs_ifld, qrl_ifld + integer :: dgnumwet_ifld, qaerwat_ifld + + character(len=fieldname_len), parameter :: & + lndfrc_fldn = 'rad_lndfrc ' , & + icefrc_fldn = 'rad_icefrc ' , & + snowh_fldn = 'rad_snowh ' , & + asdir_fldn = 'rad_asdir ' , & + asdif_fldn = 'rad_asdif ' , & + aldir_fldn = 'rad_aldir ' , & + aldif_fldn = 'rad_aldif ' , & + coszen_fldn = 'rad_coszen ' , & + asdir_pos_fldn = 'rad_asdir_pos ' , & + asdif_pos_fldn = 'rad_asdif_pos ' , & + aldir_pos_fldn = 'rad_aldir_pos ' , & + aldif_pos_fldn = 'rad_aldif_pos ' , & + lwup_fldn = 'rad_lwup ' , & + ts_fldn = 'rad_ts ' , & + temp_fldn = 'rad_temp ' , & + pdel_fldn = 'rad_pdel ' , & + pdeldry_fldn = 'rad_pdeldry ' , & + pmid_fldn = 'rad_pmid ' , & + watice_fldn = 'rad_watice ' , & + watliq_fldn = 'rad_watliq ' , & + watvap_fldn = 'rad_watvap ' , & + zint_fldn = 'rad_zint ' , & + pint_fldn = 'rad_pint ' , & + cld_fldn = 'rad_cld ' , & + cldemis_fldn = 'rad_cldemis ' , & + cldtau_fldn = 'rad_cldtau ' , & + cicewp_fldn = 'rad_cicewp ' , & + cliqwp_fldn = 'rad_cliqwp ' , & + nmxrgn_fldn = 'rad_nmxrgn ' , & + pmxrgn_fldn = 'rad_pmxrgn ' , & + cldfsnow_fldn = 'rad_cldfsnow ' , & + rel_fldn = 'rad_rel ' , & + rei_fldn = 'rad_rei ' , & + dei_fldn = 'rad_dei ' , & + des_fldn = 'rad_des ' , & + mu_fldn = 'rad_mu ' , & + lambdac_fldn = 'rad_lambdac ' , & + iciwp_fldn = 'rad_iciwp ' , & + iclwp_fldn = 'rad_iclwp ' , & + icswp_fldn = 'rad_icswp ' , & + qrs_fldn = 'rad_qrs ' , & + qrl_fldn = 'rad_qrl ' , & + volcgeom_fldn = 'rad_volc_geom ' , & + volcgeom1_fldn = 'rad_volc_geom1 ' , & + volcgeom2_fldn = 'rad_volc_geom2 ' , & + volcgeom3_fldn = 'rad_volc_geom3 ' + + ! for modal aerosols + character(len=fieldname_len), allocatable :: dgnumwet_fldn(:) + character(len=fieldname_len), allocatable :: qaerwat_fldn(:) + integer :: nmodes=0 + + ! rad constituents mixing ratios + integer :: ngas, naer=0 + character(len=64), allocatable :: gasnames(:) + character(len=64), allocatable :: aernames(:) + + ! control options + logical :: rad_data_output = .false. + integer :: rad_data_histfile_num = 2 + character(len=1) :: rad_data_avgflag = 'I' + + ! MG microphys check + logical :: mg_microphys + + logical :: fixed_dyn_heating = .false. + + ! for fixed dynamical heating ... + logical :: do_fdh = .false. + + integer :: tcorr_idx = -1 + integer :: qrsin_idx = -1 + integer :: qrlin_idx = -1 + integer :: tropp_idx = -1 + + logical :: enabled = .false. + logical :: gmean_3modes = .false. + +contains + + +!================================================================================================ +!================================================================================================ + subroutine rad_data_register + use physics_buffer, only: pbuf_add_field, dtype_r8 + + if ( do_fdh ) then + call pbuf_add_field('tcorr', 'global', dtype_r8, (/pcols,pver/), tcorr_idx) + call pbuf_add_field('qrsin', 'physpkg', dtype_r8, (/pcols,pver/), qrsin_idx) + call pbuf_add_field('qrlin', 'physpkg', dtype_r8, (/pcols,pver/), qrlin_idx) + call pbuf_add_field('tropp', 'physpkg', dtype_r8, (/pcols/), tropp_idx) + end if + + end subroutine rad_data_register + +!================================================================================================ +!================================================================================================ + subroutine rad_data_readnl(nlfile) + + ! Read rad_data_nl namelist group. Parse input. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + logical :: rad_data_fdh = .false. + + ! Local variables + integer :: unitn, ierr, i + character(len=*), parameter :: subname = 'rad_data_readnl' + + namelist /rad_data_nl/ rad_data_output, rad_data_histfile_num, rad_data_avgflag, rad_data_fdh + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rad_data_nl', status=ierr) + if (ierr == 0) then + read(unitn, rad_data_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast (rad_data_output, 1, mpilog , 0, mpicom) + call mpibcast (rad_data_fdh, 1, mpilog , 0, mpicom) + call mpibcast (rad_data_histfile_num, 1, mpiint , 0, mpicom) + call mpibcast (rad_data_avgflag, 1, mpichar , 0, mpicom) +#endif + do_fdh = rad_data_fdh + enabled = rad_data_output + + end subroutine rad_data_readnl + + !================================================================================================ + !================================================================================================ + subroutine rad_data_enable() + enabled = .true. + end subroutine rad_data_enable + + !================================================================================================ + !================================================================================================ + subroutine rad_data_init( pbuf2d ) + use phys_control, only: phys_getopts + use physics_buffer, only: pbuf_get_index + use physics_buffer, only: pbuf_set_field + implicit none + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + integer :: i, err + integer :: m,l, nspec + character(len=64) :: name + character(len=32) :: aername = ' ' + character(len=128):: long_name + character(len=64) :: long_name_description + character(len=16) :: microp_scheme ! microphysics scheme + character(len=16) :: rad_scheme + + if (.not.enabled) return + + call phys_getopts(microp_scheme_out=microp_scheme, radiation_scheme_out=rad_scheme) + mg_microphys = (trim(microp_scheme) == 'MG') + + volcgeom_ifld = pbuf_get_index('VOLC_RAD_GEOM',errcode=err) ! might need 3 more for 3-mode inputs + volcgeom1_ifld = pbuf_get_index('VOLC_RAD_GEOM1',errcode=err) ! might need 3 more for 3-mode inputs + volcgeom2_ifld = pbuf_get_index('VOLC_RAD_GEOM2',errcode=err) ! might need 3 more for 3-mode inputs + volcgeom3_ifld = pbuf_get_index('VOLC_RAD_GEOM3',errcode=err) ! might need 3 more for 3-mode inputs + + gmean_3modes = volcgeom1_ifld > 0 .and. volcgeom2_ifld > 0 .and. volcgeom3_ifld > 0 .and. volcgeom_ifld < 1 + + if (volcgeom_ifld > 0) then + call addfld(volcgeom_fldn, (/ 'lev' /), 'I','m', 'combined volcanic aerosol geometric-mode radius' ) + endif + if (gmean_3modes) then + call addfld(volcgeom1_fldn, (/ 'lev' /), 'I','m', 'mode 1 volcanic aerosol geometric-mode radius' ) + call addfld(volcgeom2_fldn, (/ 'lev' /), 'I','m', 'mode 2 volcanic aerosol geometric-mode radius' ) + call addfld(volcgeom3_fldn, (/ 'lev' /), 'I','m', 'mode 3 volcanic aerosol geometric-mode radius' ) + endif + + cld_ifld = pbuf_get_index('CLD') + rel_ifld = pbuf_get_index('REL') + rei_ifld = pbuf_get_index('REI') + qrs_ifld = pbuf_get_index('QRS') + qrl_ifld = pbuf_get_index('QRL') + if (mg_microphys) then + dei_ifld = pbuf_get_index('DEI') + des_ifld = pbuf_get_index('DES') + mu_ifld = pbuf_get_index('MU') + lambdac_ifld = pbuf_get_index('LAMBDAC') + iciwp_ifld = pbuf_get_index('ICIWP') + iclwp_ifld = pbuf_get_index('ICLWP') + icswp_ifld = pbuf_get_index('ICSWP') + cldfsnow_ifld = pbuf_get_index('CLDFSNOW') + else + cldemis_ifld= pbuf_get_index('CLDEMIS') + cldtau_ifld = pbuf_get_index('CLDTAU') + cicewp_ifld = pbuf_get_index('CICEWP') + cliqwp_ifld = pbuf_get_index('CLIQWP') + nmxrgn_ifld = pbuf_get_index('NMXRGN') + pmxrgn_ifld = pbuf_get_index('PMXRGN') + endif + + if ( do_fdh ) then + call addfld('rad_TROP_P', horiz_only, 'A','Pa','Pressure at which tropopause is defined for radiation' ) + call addfld('rad_TCORR', (/ 'lev' /), 'I','K', 'Fixed dynamical heating temperature correction ' ) + call pbuf_set_field(pbuf2d, tcorr_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, qrsin_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, qrlin_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, tropp_idx, -1.0_r8) + endif + + call rad_cnst_get_info(0, ngas=ngas, naero=naer, nmodes=nmodes) + + ! The code to output the gases assumes that the rad_constituents module has + ! ordered them in the same way that they are ordered in the "gaslist" array + ! in module radconstants, and that there are nradgas of them. This ordering + ! is performed in the internal init_lists routine in rad_constituents. + if (ngas /= nradgas) then + call endrun('rad_data_init: ERROR: ngas /= nradgas') + end if + + allocate( gasnames(ngas) ) + call rad_cnst_get_info(0, gasnames=gasnames) + + if (naer > 0) then + allocate( aernames(naer) ) + call rad_cnst_get_info(0, aernames=aernames) + endif + + if (nmodes>0) then + allocate(dgnumwet_fldn(nmodes),qaerwat_fldn(nmodes)) + dgnumwet_ifld = pbuf_get_index('DGNUMWET') + qaerwat_ifld = pbuf_get_index('QAERWAT') + do m = 1, nmodes + write(dgnumwet_fldn(m), 1001 ) m + write(qaerwat_fldn(m), 1003 ) m + enddo + endif + + if (.not.rad_data_output) return + + call addfld (lndfrc_fldn, horiz_only, rad_data_avgflag, 'fraction', & + 'radiation input: land fraction') + call addfld (icefrc_fldn, horiz_only, rad_data_avgflag, 'fraction', & + 'radiation input: ice fraction') + call addfld (snowh_fldn, horiz_only, rad_data_avgflag, 'm', & + 'radiation input: water equivalent snow depth') + call addfld (asdir_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: s hort wave direct albedo', flag_xyfill=.true.) + call addfld (asdif_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: s hort wave difuse albedo', flag_xyfill=.true.) + call addfld (aldir_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: long wave direct albedo', flag_xyfill=.true.) + call addfld (aldif_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: long wave difuse albedo', flag_xyfill=.true.) + + call addfld (coszen_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: cosine solar zenith when positive', flag_xyfill=.true.) + call addfld (asdir_pos_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: s hort wave direct albedo weighted by coszen', flag_xyfill=.true.) + call addfld (asdif_pos_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: s hort wave difuse albedo weighted by coszen', flag_xyfill=.true.) + call addfld (aldir_pos_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: long wave direct albedo weighted by coszen', flag_xyfill=.true.) + call addfld (aldif_pos_fldn, horiz_only, rad_data_avgflag, '1', & + 'radiation input: long wave difuse albedo weighted by coszen', flag_xyfill=.true.) + + call addfld (lwup_fldn, horiz_only, rad_data_avgflag, 'W/m2', & + 'radiation input: long wave up radiation flux ') + call addfld (ts_fldn, horiz_only, rad_data_avgflag, 'K', & + 'radiation input: surface temperature') + + call addfld (temp_fldn, (/ 'lev' /), rad_data_avgflag, 'K', & + 'radiation input: midpoint temperature') + call addfld (pdel_fldn, (/ 'lev' /), rad_data_avgflag, 'Pa', & + 'radiation input: pressure layer thickness') + call addfld (pdeldry_fldn, (/ 'lev' /), rad_data_avgflag,'Pa', & + 'radiation input: dry pressure layer thickness') + call addfld (pmid_fldn, (/ 'lev' /), rad_data_avgflag, 'Pa', & + 'radiation input: midpoint pressure') + call addfld (watice_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/kg', & + 'radiation input: cloud ice') + call addfld (watliq_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/kg', & + 'radiation input: cloud liquid water') + call addfld (watvap_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/kg', & + 'radiation input: water vapor') + + call addfld (zint_fldn, (/ 'ilev' /), rad_data_avgflag, 'km', & + 'radiation input: interface height') + call addfld (pint_fldn, (/ 'ilev' /), rad_data_avgflag, 'Pa', & + 'radiation input: interface pressure') + + call addfld (cld_fldn, (/ 'lev' /), rad_data_avgflag, 'fraction', & + 'radiation input: cloud fraction') + call addfld (rel_fldn, (/ 'lev' /), rad_data_avgflag, 'micron', & + 'radiation input: effective liquid drop radius') + call addfld (rei_fldn, (/ 'lev' /), rad_data_avgflag, 'micron', & + 'radiation input: effective ice partical radius') + call addfld (qrs_fldn, (/ 'lev' /), rad_data_avgflag, 'J/s/kg', & + 'radiation input: solar heating rate') + call addfld (qrl_fldn, (/ 'lev' /), rad_data_avgflag, 'J/s/kg', & + 'radiation input: longwave heating rate') + + if (mg_microphys) then + call addfld (dei_fldn, (/ 'lev' /), rad_data_avgflag, 'micron', & + 'radiation input: effective ice partical diameter') + call addfld (des_fldn, (/ 'lev' /), rad_data_avgflag, 'micron', & + 'radiation input: effective snow partical diameter') + call addfld (mu_fldn, (/ 'lev' /), rad_data_avgflag, ' ', & + 'radiation input: ice gamma parameter for optics (radiation)') + call addfld (lambdac_fldn, (/ 'lev' /), rad_data_avgflag,' ', & + 'radiation input: slope of droplet distribution for optics (radiation)') + call addfld (iciwp_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/m2', & + 'radiation input: In-cloud ice water path') + call addfld (iclwp_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/m2', & + 'radiation input: In-cloud liquid water path') + call addfld (icswp_fldn, (/ 'lev' /), rad_data_avgflag, 'kg/m2', & + 'radiation input: In-cloud snow water path') + call addfld (cldfsnow_fldn, (/ 'lev' /), rad_data_avgflag, 'fraction', & + 'radiation input: cloud liquid drops + snow') + else + + call addfld (nmxrgn_fldn, horiz_only, rad_data_avgflag, ' ', & + 'radiation input: ') + call addfld (pmxrgn_fldn, (/ 'ilev' /), rad_data_avgflag, 'Pa', & + 'radiation input: ') + call addfld (cldemis_fldn, (/ 'lev' /), rad_data_avgflag, ' ', & + 'radiation input: cloud property ') + call addfld (cldtau_fldn, (/ 'lev' /), rad_data_avgflag, ' ', & + 'radiation input: cloud property ') + call addfld (cicewp_fldn, (/ 'lev' /), rad_data_avgflag, ' ', & + 'radiation input: cloud property ') + call addfld (cliqwp_fldn, (/ 'lev' /), rad_data_avgflag, ' ', & + 'radiation input: cloud property ') + endif + + call add_default (lndfrc_fldn, rad_data_histfile_num, ' ') + call add_default (icefrc_fldn, rad_data_histfile_num, ' ') + call add_default (snowh_fldn, rad_data_histfile_num, ' ') + call add_default (asdir_fldn, rad_data_histfile_num, ' ') + call add_default (asdif_fldn, rad_data_histfile_num, ' ') + call add_default (aldir_fldn, rad_data_histfile_num, ' ') + call add_default (aldif_fldn, rad_data_histfile_num, ' ') + + call add_default (coszen_fldn, rad_data_histfile_num, ' ') + call add_default (asdir_pos_fldn, rad_data_histfile_num, ' ') + call add_default (asdif_pos_fldn, rad_data_histfile_num, ' ') + call add_default (aldir_pos_fldn, rad_data_histfile_num, ' ') + call add_default (aldif_pos_fldn, rad_data_histfile_num, ' ') + + call add_default (lwup_fldn, rad_data_histfile_num, ' ') + call add_default (ts_fldn, rad_data_histfile_num, ' ') + call add_default (temp_fldn, rad_data_histfile_num, ' ') + call add_default (pdel_fldn, rad_data_histfile_num, ' ') + call add_default (pdeldry_fldn, rad_data_histfile_num, ' ') + call add_default (pmid_fldn, rad_data_histfile_num, ' ') + call add_default (watice_fldn, rad_data_histfile_num, ' ') + call add_default (watliq_fldn, rad_data_histfile_num, ' ') + call add_default (watvap_fldn, rad_data_histfile_num, ' ') + call add_default (zint_fldn, rad_data_histfile_num, ' ') + call add_default (pint_fldn, rad_data_histfile_num, ' ') + + call add_default (cld_fldn, rad_data_histfile_num, ' ') + call add_default (rel_fldn, rad_data_histfile_num, ' ') + call add_default (rei_fldn, rad_data_histfile_num, ' ') + call add_default (qrs_fldn, rad_data_histfile_num, ' ') + call add_default (qrl_fldn, rad_data_histfile_num, ' ') + + if (mg_microphys) then + call add_default (dei_fldn, rad_data_histfile_num, ' ') + call add_default (des_fldn, rad_data_histfile_num, ' ') + call add_default (mu_fldn, rad_data_histfile_num, ' ') + call add_default (lambdac_fldn, rad_data_histfile_num, ' ') + call add_default (iciwp_fldn, rad_data_histfile_num, ' ') + call add_default (iclwp_fldn, rad_data_histfile_num, ' ') + call add_default (icswp_fldn, rad_data_histfile_num, ' ') + call add_default (cldfsnow_fldn, rad_data_histfile_num, ' ') + else + call add_default (cldemis_fldn, rad_data_histfile_num, ' ') + call add_default (cldtau_fldn, rad_data_histfile_num, ' ') + call add_default (cicewp_fldn, rad_data_histfile_num, ' ') + call add_default (cliqwp_fldn, rad_data_histfile_num, ' ') + call add_default (nmxrgn_fldn, rad_data_histfile_num, ' ') + call add_default (pmxrgn_fldn, rad_data_histfile_num, ' ') + endif + + ! stratospheric aersols geometric mean radius + if (volcgeom_ifld > 0) then + call add_default (volcgeom_fldn, rad_data_histfile_num, ' ') + endif + if (gmean_3modes) then + call add_default (volcgeom1_fldn, rad_data_histfile_num, ' ') + call add_default (volcgeom2_fldn, rad_data_histfile_num, ' ') + call add_default (volcgeom3_fldn, rad_data_histfile_num, ' ') + endif + + ! rad constituents + + long_name_description = ' mass mixing ratio used in rad climate calculation' + + do i = 1, ngas + long_name = trim(gasnames(i))//trim(long_name_description) + name = 'rad_'//gasnames(i) + call addfld(trim(name), (/ 'lev' /), rad_data_avgflag, 'kg/kg', trim(long_name)) + call add_default (trim(name), rad_data_histfile_num, ' ') + end do + + if (naer > 0) then + + do i = 1, naer + long_name = trim(aernames(i))//trim(long_name_description) + name = 'rad_'//aernames(i) + call addfld(trim(name), (/ 'lev' /), rad_data_avgflag, 'kg/kg', trim(long_name)) + call add_default (trim(name), rad_data_histfile_num, ' ') + end do + endif + if (nmodes>0) then + + ! for modal aerosol model + do m = 1, nmodes + write(long_name, 1002) m + call addfld ( dgnumwet_fldn(m), (/ 'lev' /), rad_data_avgflag, '', trim(long_name) ) + call add_default (dgnumwet_fldn(m), rad_data_histfile_num, ' ') + + write(long_name, 1004) m + call addfld ( qaerwat_fldn(m), (/ 'lev' /), rad_data_avgflag, '', trim(long_name) ) + call add_default (qaerwat_fldn(m), rad_data_histfile_num, ' ') + + ! get mode info + call rad_cnst_get_info(0, m, nspec=nspec) + ! aerosol species loop + do l = 1, nspec + call rad_cnst_get_info(0,m,l, spec_name=aername) + name = 'rad_'//trim(aername) + call addfld(trim(name), (/ 'lev' /), rad_data_avgflag, 'kg/kg', trim(long_name)) + call add_default (trim(name), rad_data_histfile_num, ' ') + end do + end do + endif + + 1001 format ( 'rad_dgnumwet_', I1 ) + 1002 format ( 'radiation input: DGNUMWET for mode ', I1 ) + 1003 format ( 'rad_qaerwat_', I1 ) + 1004 format ( 'radiation input: QAERWAT for mode ', I1 ) + + end subroutine rad_data_init + + !================================================================================================ + !================================================================================================ + subroutine rad_data_write( pbuf, state, cam_in, coszen ) + + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use constituents, only: cnst_get_ind + use physics_buffer, only: pbuf_get_field, pbuf_old_tim_idx + use drv_input_data, only: drv_input_data_freq + use physconst, only: cpair + + implicit none + type(physics_buffer_desc), pointer :: pbuf(:) + + type(physics_state), intent(in), target :: state + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: coszen(pcols) + + ! Local variables + integer :: i, k + integer :: m,l, nspec + character(len=32) :: name, aername + real(r8), pointer :: mmr(:,:) + + integer :: lchnk, itim_old, ifld + integer :: ixcldice ! cloud ice water index + integer :: ixcldliq ! cloud liquid water index + integer :: icol + integer :: ncol + + ! surface albedoes weighted by (positive cosine zenith angle) + real(r8):: coszrs_pos(pcols) ! = max(coszrs,0) + real(r8):: asdir_pos (pcols) ! + real(r8):: asdif_pos (pcols) ! + real(r8):: aldir_pos (pcols) ! + real(r8):: aldif_pos (pcols) ! + + real(r8), pointer, dimension(:,:) :: ptr + integer , pointer, dimension(:) :: iptr1d + real(r8), dimension(pcols) :: rptr1d + + ! for Fixed Dynamical Heating + real(r8), pointer, dimension(:,:) :: tcorr + real(r8), pointer, dimension(:,:) :: qrsin + real(r8), pointer, dimension(:,:) :: qrlin + real(r8), pointer, dimension(:) :: tropp + real(r8), pointer, dimension(:,:) :: qrs + real(r8), pointer, dimension(:,:) :: qrl + real(r8), pointer, dimension(:,:,:) :: dgnumwet_ptr + real(r8), pointer, dimension(:,:,:) :: qaerwat_ptr + + if (.not.enabled) return + call pbuf_get_field(pbuf, qrs_ifld, qrs ) + call pbuf_get_field(pbuf, qrl_ifld, qrl ) + + lchnk = state%lchnk + ncol = state%ncol + + ! store temperature correction above tropopause in pbuf for Fixed Dynamical Heating + if(do_fdh) then + + call pbuf_get_field(pbuf, tcorr_idx, tcorr) + call pbuf_get_field(pbuf, qrsin_idx, qrsin) + call pbuf_get_field(pbuf, qrlin_idx, qrlin) + call pbuf_get_field(pbuf, tropp_idx, tropp) + do k = 1, pver + do i = 1, ncol + if ( state%pmid(i,k) < tropp(i)) then + tcorr(i,k) = tcorr(i,k) + drv_input_data_freq*(qrs(i,k) - qrsin(i,k) + qrl(i,k) - qrlin(i,k)) /cpair + endif + enddo + enddo + + call outfld('rad_TROP_P', tropp(:ncol), ncol, lchnk) + call outfld('rad_TCORR', tcorr(:ncol,:), ncol, lchnk) + + end if + + if (.not.rad_data_output) return + + call outfld(qrs_fldn, qrs, pcols, lchnk ) + call outfld(qrl_fldn, qrl, pcols, lchnk ) + + ! get index of (liquid+ice) cloud water + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + do icol = 1, ncol + coszrs_pos(icol) = max(coszen(icol),0._r8) + enddo + asdir_pos(:ncol) = cam_in%asdir(:ncol) * coszrs_pos(:ncol) + asdif_pos(:ncol) = cam_in%asdif(:ncol) * coszrs_pos(:ncol) + aldir_pos(:ncol) = cam_in%aldir(:ncol) * coszrs_pos(:ncol) + aldif_pos(:ncol) = cam_in%aldif(:ncol) * coszrs_pos(:ncol) + + call outfld(lndfrc_fldn, cam_in%landfrac, pcols, lchnk) + call outfld(icefrc_fldn, cam_in%icefrac, pcols, lchnk) + call outfld(snowh_fldn, cam_in%snowhland, pcols, lchnk) + call outfld(temp_fldn, state%t, pcols, lchnk ) + call outfld(pdel_fldn, state%pdel, pcols, lchnk ) + call outfld(pdeldry_fldn,state%pdeldry, pcols, lchnk ) + call outfld(watice_fldn, state%q(:,:,ixcldice), pcols, lchnk ) + call outfld(watliq_fldn, state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld(watvap_fldn, state%q(:,:,1), pcols, lchnk ) + call outfld(zint_fldn, state%zi, pcols, lchnk ) + call outfld(pint_fldn, state%pint, pcols, lchnk ) + call outfld(pmid_fldn, state%pmid, pcols, lchnk ) + + call outfld(asdir_fldn, cam_in%asdir, pcols, lchnk ) + call outfld(asdif_fldn, cam_in%asdif, pcols, lchnk ) + call outfld(aldir_fldn, cam_in%aldir, pcols, lchnk ) + call outfld(aldif_fldn, cam_in%aldif, pcols, lchnk ) + + call outfld(coszen_fldn, coszrs_pos, pcols, lchnk ) + call outfld(asdir_pos_fldn, asdir_pos, pcols, lchnk ) + call outfld(asdif_pos_fldn, asdif_pos, pcols, lchnk ) + call outfld(aldir_pos_fldn, aldir_pos, pcols, lchnk ) + call outfld(aldif_pos_fldn, aldif_pos, pcols, lchnk ) + + call outfld(lwup_fldn, cam_in%lwup, pcols, lchnk ) + call outfld(ts_fldn, cam_in%ts, pcols, lchnk ) + + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, cld_ifld, ptr, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld(cld_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, rel_ifld, ptr ) + call outfld(rel_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, rei_ifld, ptr ) + call outfld(rei_fldn, ptr, pcols, lchnk ) + + if (mg_microphys) then + + call pbuf_get_field(pbuf, dei_ifld, ptr ) + call outfld(dei_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, des_ifld, ptr ) + call outfld(des_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, mu_ifld, ptr ) + call outfld(mu_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, lambdac_ifld, ptr ) + call outfld(lambdac_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, iciwp_ifld, ptr ) + call outfld(iciwp_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, iclwp_ifld, ptr ) + call outfld(iclwp_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, icswp_ifld, ptr ) + call outfld(icswp_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, cldfsnow_ifld, ptr, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call outfld(cldfsnow_fldn, ptr, pcols, lchnk ) + + else + + call pbuf_get_field(pbuf, cldemis_ifld, ptr ) + call outfld(cldemis_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, cldtau_ifld, ptr ) + call outfld(cldtau_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, cicewp_ifld, ptr ) + call outfld(cicewp_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, cliqwp_ifld, ptr ) + call outfld(cliqwp_fldn, ptr, pcols, lchnk ) + + call pbuf_get_field(pbuf, nmxrgn_ifld, iptr1d ) + rptr1d = dble(iptr1d) + call outfld(nmxrgn_fldn, rptr1d, pcols, lchnk ) + + call pbuf_get_field(pbuf, pmxrgn_ifld, ptr ) + call outfld(pmxrgn_fldn, ptr, pcols, lchnk ) + + endif + + ! output mixing ratio of rad constituents + + do i = 1, ngas + name = 'rad_'//gasnames(i) + call rad_cnst_get_gas(0, gaslist(i), state, pbuf, mmr) + call outfld(trim(name), mmr, pcols, lchnk) + end do + + if ( naer>0 ) then + ! bulk aerosol model + do i = 1, naer + name = 'rad_'//aernames(i) + call rad_cnst_get_aer_mmr(0, i, state, pbuf, mmr) + call outfld(trim(name), mmr, pcols, lchnk) + end do + endif + if (nmodes>0) then + + call pbuf_get_field(pbuf, dgnumwet_ifld, dgnumwet_ptr) + call pbuf_get_field(pbuf, qaerwat_ifld, qaerwat_ptr) + + ! for modal aerosol model + do m = 1, nmodes + ptr => dgnumwet_ptr(:,:,m) + call outfld( dgnumwet_fldn(m), ptr, pcols, lchnk ) + ptr => qaerwat_ptr(:,:,m) + call outfld( qaerwat_fldn(m), ptr, pcols, lchnk ) + + ! get mode info + call rad_cnst_get_info(0, m, nspec=nspec) + ! aerosol species loop + do l = 1, nspec + call rad_cnst_get_info(0,m,l, spec_name=aername) + call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, mmr) + name = 'rad_'//aername + call outfld(trim(name), mmr, pcols, lchnk) + enddo + enddo + endif + + ! stratospheric aersols geometric mean radius + if (volcgeom_ifld > 0) then + call pbuf_get_field(pbuf, volcgeom_ifld, ptr) + call outfld(volcgeom_fldn, ptr, pcols, lchnk) + endif + if (gmean_3modes) then + call pbuf_get_field(pbuf, volcgeom1_ifld, ptr) + call outfld(volcgeom1_fldn, ptr, pcols, lchnk) + call pbuf_get_field(pbuf, volcgeom2_ifld, ptr) + call outfld(volcgeom2_fldn, ptr, pcols, lchnk) + call pbuf_get_field(pbuf, volcgeom3_ifld, ptr) + call outfld(volcgeom3_fldn, ptr, pcols, lchnk) + endif + + end subroutine rad_data_write + +!================================================================================= +!================================================================================= + subroutine rad_data_read(indata, phys_state, pbuf2d, cam_in, recno ) + + use camsrfexch, only: cam_in_t + use physics_buffer, only: pbuf_get_field, pbuf_old_tim_idx + use constituents, only: cnst_get_ind + use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + + implicit none + + type(drv_input_data_t), intent(inout) :: indata + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), target, intent(inout) :: phys_state(begchunk:endchunk) + type(cam_in_t), target, intent(inout) :: cam_in(begchunk:endchunk) + integer, intent(in) :: recno + +! local vars + type(physics_buffer_desc), pointer :: pbuf(:) + + type(drv_input_3d_t) :: cld_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: cldfsnow_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: rel_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: rei_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: dei_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: des_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: mu_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: lambdac_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: iciwp_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: iclwp_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: icswp_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: qrs_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: qrl_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: watvap_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: watliq_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: watice_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: zi_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: pint_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: lnpint_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: temp_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: pdel_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: pdeldry_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: lnpmid_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: pmid_ptrs(begchunk:endchunk) + + type(drv_input_2d_t) :: lndfrac_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: icefrac_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: snowhland_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: asdir_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: asdif_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: aldir_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: aldif_ptrs(begchunk:endchunk) + + type(drv_input_2di_t):: nmxrgn_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: pmxrgn_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: cldemis_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: cldtau_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: cicewp_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: cliqwp_ptrs(begchunk:endchunk) + + type(drv_input_2d_t) :: lwup_ptrs(begchunk:endchunk) + type(drv_input_2d_t) :: ts_ptrs(begchunk:endchunk) + + type(drv_input_3d_t) :: volcgeom_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: volcgeom1_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: volcgeom2_ptrs(begchunk:endchunk) + type(drv_input_3d_t) :: volcgeom3_ptrs(begchunk:endchunk) + + integer :: i, k, c, ncol, itim + + integer :: ixcldice ! cloud ice water index + integer :: ixcldliq ! cloud liquid water index + + ! for Fixed Dynamical Heating + real(r8), pointer, dimension(:,:) :: tcorr + real(r8), pointer, dimension(:,:) :: qrsin + real(r8), pointer, dimension(:,:) :: qrlin + real(r8), pointer, dimension(:) :: tropp + integer :: troplev(pcols) + + ! for modal aerosols + type(drv_input_4d_t) :: dgnumwet_ptrs(begchunk:endchunk) + type(drv_input_4d_t) :: qaerwat_ptrs(begchunk:endchunk) + + ! get index of (liquid+ice) cloud water + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + ! phys buffer time index + itim = pbuf_old_tim_idx() + + ! setup the data pointers +!$OMP PARALLEL DO PRIVATE (C,pbuf) + do c=begchunk,endchunk + pbuf => pbuf_get_chunk(pbuf2d, c) + + watvap_ptrs (c)%array => phys_state(c)%q(:,:,1) + watliq_ptrs (c)%array => phys_state(c)%q(:,:,ixcldliq) + watice_ptrs (c)%array => phys_state(c)%q(:,:,ixcldice) + + zi_ptrs (c)%array => phys_state(c)%zi + pint_ptrs (c)%array => phys_state(c)%pint + lnpint_ptrs (c)%array => phys_state(c)%lnpint + + temp_ptrs (c)%array => phys_state(c)%t + pdel_ptrs (c)%array => phys_state(c)%pdel + pdeldry_ptrs(c)%array => phys_state(c)%pdeldry + lnpmid_ptrs (c)%array => phys_state(c)%lnpmid + pmid_ptrs (c)%array => phys_state(c)%pmid + + lndfrac_ptrs (c)%array => cam_in(c)%landfrac + icefrac_ptrs (c)%array => cam_in(c)%icefrac + snowhland_ptrs(c)%array => cam_in(c)%snowhland + asdir_ptrs (c)%array => cam_in(c)%asdir + asdif_ptrs (c)%array => cam_in(c)%asdif + aldir_ptrs (c)%array => cam_in(c)%aldir + aldif_ptrs (c)%array => cam_in(c)%aldif + lwup_ptrs (c)%array => cam_in(c)%lwup + ts_ptrs (c)%array => cam_in(c)%ts + + call pbuf_get_field(pbuf, cld_ifld, cld_ptrs (c)%array, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, rel_ifld, rel_ptrs(c)%array ) + call pbuf_get_field(pbuf, rei_ifld, rei_ptrs(c)%array ) + + call pbuf_get_field(pbuf, qrs_ifld, qrs_ptrs(c)%array ) + call pbuf_get_field(pbuf, qrl_ifld, qrl_ptrs(c)%array ) + + if (mg_microphys) then + call pbuf_get_field(pbuf, dei_ifld, dei_ptrs(c)%array ) + call pbuf_get_field(pbuf, des_ifld, des_ptrs(c)%array ) + call pbuf_get_field(pbuf, mu_ifld, mu_ptrs (c)%array ) + call pbuf_get_field(pbuf, lambdac_ifld, lambdac_ptrs(c)%array ) + call pbuf_get_field(pbuf, iciwp_ifld, iciwp_ptrs (c)%array ) + call pbuf_get_field(pbuf, iclwp_ifld, iclwp_ptrs (c)%array ) + call pbuf_get_field(pbuf, icswp_ifld, icswp_ptrs (c)%array ) + call pbuf_get_field(pbuf, cldfsnow_ifld, cldfsnow_ptrs(c)%array, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) + else + call pbuf_get_field(pbuf, nmxrgn_ifld, nmxrgn_ptrs(c)%array ) + call pbuf_get_field(pbuf, pmxrgn_ifld, pmxrgn_ptrs(c)%array ) + call pbuf_get_field(pbuf, cldemis_ifld, cldemis_ptrs(c)%array ) + call pbuf_get_field(pbuf, cldtau_ifld, cldtau_ptrs(c)%array ) + call pbuf_get_field(pbuf, cicewp_ifld, cicewp_ptrs(c)%array ) + call pbuf_get_field(pbuf, cliqwp_ifld, cliqwp_ptrs(c)%array ) + endif + + if (nmodes>0) then + call pbuf_get_field(pbuf, dgnumwet_ifld, dgnumwet_ptrs(c)%array ) + call pbuf_get_field(pbuf, qaerwat_ifld, qaerwat_ptrs(c)%array ) + endif + + ! stratospheric aersols geometric mean radius + if (volcgeom_ifld > 0) then + call pbuf_get_field(pbuf, volcgeom_ifld, volcgeom_ptrs(c)%array ) + endif + if (gmean_3modes) then + call pbuf_get_field(pbuf, volcgeom1_ifld, volcgeom1_ptrs(c)%array ) + call pbuf_get_field(pbuf, volcgeom2_ifld, volcgeom2_ptrs(c)%array ) + call pbuf_get_field(pbuf, volcgeom3_ifld, volcgeom3_ptrs(c)%array ) + endif + + enddo + + + if (nmodes>0) then + call get_aeromode_data( indata, dgnumwet_fldn, recno, dgnumwet_ptrs ) + call get_aeromode_data( indata, qaerwat_fldn, recno, qaerwat_ptrs ) + endif + + ! get the 2D data + + call drv_input_data_get( indata, lndfrc_fldn, recno, lndfrac_ptrs ) + call drv_input_data_get( indata, icefrc_fldn, recno, icefrac_ptrs ) + call drv_input_data_get( indata, snowh_fldn, recno, snowhland_ptrs ) + call drv_input_data_get( indata, asdir_fldn, recno, asdir_ptrs ) + call drv_input_data_get( indata, asdif_fldn, recno, asdif_ptrs ) + call drv_input_data_get( indata, aldir_fldn, recno, aldir_ptrs ) + call drv_input_data_get( indata, aldif_fldn, recno, aldif_ptrs ) + call drv_input_data_get( indata, lwup_fldn, recno, lwup_ptrs ) + call drv_input_data_get( indata, ts_fldn, recno, ts_ptrs ) + + ! get the 3D data + + call drv_input_data_get( indata, cld_fldn, 'lev', pver, recno, cld_ptrs ) + call drv_input_data_get( indata, rel_fldn, 'lev', pver, recno, rel_ptrs ) + call drv_input_data_get( indata, rei_fldn, 'lev', pver, recno, rei_ptrs ) + call drv_input_data_get( indata, qrs_fldn, 'lev', pver, recno, qrs_ptrs ) + call drv_input_data_get( indata, qrl_fldn, 'lev', pver, recno, qrl_ptrs ) + + if (mg_microphys) then + call drv_input_data_get( indata, dei_fldn, 'lev', pver, recno, dei_ptrs ) + call drv_input_data_get( indata, des_fldn, 'lev', pver, recno, des_ptrs ) + call drv_input_data_get( indata, mu_fldn, 'lev', pver, recno, mu_ptrs ) + call drv_input_data_get( indata, lambdac_fldn,'lev', pver, recno, lambdac_ptrs ) + call drv_input_data_get( indata, iciwp_fldn, 'lev', pver, recno, iciwp_ptrs ) + call drv_input_data_get( indata, iclwp_fldn, 'lev', pver, recno, iclwp_ptrs ) + call drv_input_data_get( indata, icswp_fldn, 'lev', pver, recno, icswp_ptrs ) + call drv_input_data_get( indata, cldfsnow_fldn,'lev',pver, recno, cldfsnow_ptrs ) + else + call drv_input_data_get( indata, nmxrgn_fldn, recno, nmxrgn_ptrs ) + call drv_input_data_get( indata, pmxrgn_fldn, 'ilev',pverp,recno, pmxrgn_ptrs ) + call drv_input_data_get( indata, cldemis_fldn,'lev', pver, recno, cldemis_ptrs ) + call drv_input_data_get( indata, cldtau_fldn, 'lev', pver, recno, cldtau_ptrs ) + call drv_input_data_get( indata, cicewp_fldn, 'lev', pver, recno, cicewp_ptrs ) + call drv_input_data_get( indata, cliqwp_fldn, 'lev', pver, recno, cliqwp_ptrs ) + endif + + ! stratospheric aersols geometric mean radius + if (volcgeom_ifld > 0) then + call drv_input_data_get( indata, volcgeom_fldn, 'lev', pver, recno, volcgeom_ptrs ) + endif + if (gmean_3modes) then + call drv_input_data_get( indata, volcgeom1_fldn, 'lev', pver, recno, volcgeom1_ptrs ) + call drv_input_data_get( indata, volcgeom2_fldn, 'lev', pver, recno, volcgeom2_ptrs ) + call drv_input_data_get( indata, volcgeom3_fldn, 'lev', pver, recno, volcgeom3_ptrs ) + endif + + call drv_input_data_get( indata, watvap_fldn, 'lev', pver, recno, watvap_ptrs ) + call drv_input_data_get( indata, watliq_fldn, 'lev', pver, recno, watliq_ptrs ) + call drv_input_data_get( indata, watice_fldn, 'lev', pver, recno, watice_ptrs ) + call drv_input_data_get( indata, temp_fldn, 'lev', pver, recno, temp_ptrs ) + call drv_input_data_get( indata, pdel_fldn, 'lev', pver, recno, pdel_ptrs ) + call drv_input_data_get( indata, pdeldry_fldn,'lev', pver, recno, pdeldry_ptrs ) + call drv_input_data_get( indata, pmid_fldn, 'lev', pver, recno, pmid_ptrs ) + + call drv_input_data_get( indata, zint_fldn, 'ilev',pverp,recno, zi_ptrs ) + call drv_input_data_get( indata, pint_fldn, 'ilev',pverp,recno, pint_ptrs ) + + do c=begchunk,endchunk + ncol = phys_state(c)%ncol + if (all(pmid_ptrs(c)%array(:ncol,:) > 0._r8 )) then + do i=1,ncol + lnpmid_ptrs(c)%array(i,:) = log(pmid_ptrs(c)%array(i,:)) + lnpint_ptrs(c)%array(i,:) = log(pint_ptrs(c)%array(i,:)) + enddo + endif + + ! adjust temperatue input above tropopause for Fixed Dynamical Heating .... + if (do_fdh) then + pbuf => pbuf_get_chunk(pbuf2d, c) + + call pbuf_get_field(pbuf, tropp_idx, tropp) + call pbuf_get_field(pbuf, tcorr_idx, tcorr) + call pbuf_get_field(pbuf, qrsin_idx, qrsin) + call pbuf_get_field(pbuf, qrlin_idx, qrlin) + + call tropopause_find(phys_state(c), troplev, tropP=tropp(:), primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + + qrsin(:,:) = qrs_ptrs(c)%array(:,:) + qrlin(:,:) = qrl_ptrs(c)%array(:,:) + + do k = 1, pver + do i = 1, ncol + if ( phys_state(c)%pmid(i,k) < tropp(i) ) then + temp_ptrs(c)%array(i,k) = temp_ptrs(c)%array(i,k) + tcorr(i,k) + endif + enddo + enddo + endif + + enddo + + call get_rad_cnst_data(indata, phys_state, pbuf2d, recno) + + end subroutine rad_data_read + +!================================================================================================ +! Private routines +!================================================================================================ + + + !================================================================================================ + !================================================================================================ + subroutine get_aeromode_data(indata, infld_names, recno, chunk_ptrs) + use drv_input_data, only: drv_input_data_read + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: infld_names(nmodes) + integer, intent(in) :: recno + type(drv_input_4d_t), intent(inout) :: chunk_ptrs(begchunk:endchunk) + + real(r8) :: data (pcols, pver, begchunk:endchunk) + + integer :: c, n + + do n = 1,nmodes + + data = drv_input_data_read( indata, infld_names(n), 'lev', pver, recno ) + do c=begchunk,endchunk + chunk_ptrs(c)%array(:,:,n) = data(:,:,c) + enddo + + enddo + + end subroutine get_aeromode_data + + !================================================================================================ + !================================================================================================ + subroutine get_rad_cnst_data(indata, state, pbuf2d, recno) + + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use rad_constituents, only: rad_cnst_get_info + + implicit none + + ! Arguments + type(drv_input_data_t), intent(inout) :: indata + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_state), intent(inout) :: state(begchunk:endchunk) + integer, intent(in) :: recno + + ! Local variables + integer :: i, ncol + integer :: m, l, nspec + integer :: idx + character(len=32) :: aername + + !----------------------------------------------------------------------------- + + ! read in mixing ratio of rad constituents + + do i = 1,ngas + call read_rad_gas_data(indata, gasnames(i), i, state, pbuf2d, recno ) + enddo + + do i = 1,naer + call read_rad_aer_data(indata, aernames(i), i, state, pbuf2d, recno ) + enddo + + ! aerosol mode loop + do m = 1, nmodes + + ! get mode info + call rad_cnst_get_info(0, m, nspec=nspec) + ! aerosol species loop + do l = 1, nspec + call rad_cnst_get_info(0,m,l, spec_name=aername) + call read_rad_mam_data( indata, aername, m, l, state, pbuf2d, recno ) + end do + end do + + end subroutine get_rad_cnst_data + + !================================================================================= + !================================================================================= + subroutine read_rad_gas_data(indata, name, idx, state, pbuf2d, recno ) + use rad_constituents, only: rad_cnst_get_gas + use drv_input_data, only: drv_input_data_read + + type(drv_input_data_t), intent(inout) :: indata + character(len=32), intent(in) :: name + integer, intent(in) :: idx + type(physics_state),target, intent(inout) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + integer, intent(in) :: recno + + type(physics_buffer_desc), pointer, dimension(:) :: phys_buffer_chunk + character(len=32) :: radname + integer :: c, ncol + real(r8) :: mass(pcols,pver,begchunk:endchunk) + real(r8), pointer :: mmr_ptr(:,:) + + radname = 'rad_'//trim(name) + mass = drv_input_data_read( indata, radname, 'lev', pver, recno ) + + do c = begchunk,endchunk + ncol = state(c)%ncol + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + call rad_cnst_get_gas(0, gaslist(idx), state(c), phys_buffer_chunk, mmr_ptr) + mmr_ptr(:ncol,:) = mass(:ncol,:,c) + enddo + + end subroutine read_rad_gas_data + + !================================================================================= + !================================================================================= + subroutine read_rad_aer_data(indata, name, idx, state, pbuf2d, recno ) + use rad_constituents, only: rad_cnst_get_aer_mmr + use drv_input_data, only: drv_input_data_read + + type(drv_input_data_t), intent(inout) :: indata + character(len=32), intent(in) :: name + integer, intent(in) :: idx + type(physics_state),target, intent(inout) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + integer, intent(in) :: recno + + type(physics_buffer_desc), pointer, dimension(:) :: phys_buffer_chunk + character(len=32) :: radname + integer :: c, ncol + real(r8) :: mass(pcols,pver,begchunk:endchunk) + real(r8), pointer :: mmr_ptr(:,:) + + radname = 'rad_'//trim(name) + mass = drv_input_data_read( indata, radname, 'lev', pver, recno ) + + do c = begchunk,endchunk + ncol = state(c)%ncol + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + call rad_cnst_get_aer_mmr(0, idx, state(c), phys_buffer_chunk, mmr_ptr) + mmr_ptr(:ncol,:) = mass(:ncol,:,c) + enddo + + end subroutine read_rad_aer_data + + !================================================================================= + !================================================================================= + subroutine read_rad_mam_data(indata, name, mode_idx, spec_idx, state, pbuf2d, recno ) + use rad_constituents, only: rad_cnst_get_aer_mmr + use drv_input_data, only: drv_input_data_read + + type(drv_input_data_t), intent(inout) :: indata + character(len=32), intent(in) :: name + integer, intent(in) :: mode_idx + integer, intent(in) :: spec_idx + type(physics_state),target, intent(inout) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + integer, intent(in) :: recno + + type(physics_buffer_desc), pointer, dimension(:) :: phys_buffer_chunk + character(len=32) :: radname + integer :: c, ncol + real(r8) :: mass(pcols,pver,begchunk:endchunk) + real(r8), pointer :: mmr_ptr(:,:) + + radname = 'rad_'//trim(name) + mass = drv_input_data_read( indata, radname, 'lev', pver, recno ) + + do c = begchunk,endchunk + ncol = state(c)%ncol + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + call rad_cnst_get_aer_mmr(0, mode_idx, spec_idx, 'a', state(c), phys_buffer_chunk, mmr_ptr) + mmr_ptr(:ncol,:) = mass(:ncol,:,c) + enddo + + end subroutine read_rad_mam_data + +end module radiation_data diff --git a/src/physics/cam/rayleigh_friction.F90 b/src/physics/cam/rayleigh_friction.F90 new file mode 100644 index 0000000000..8d70000fce --- /dev/null +++ b/src/physics/cam/rayleigh_friction.F90 @@ -0,0 +1,191 @@ + +module rayleigh_friction + +!--------------------------------------------------------------------------------- +! Module to apply rayleigh friction in region of model top. +! We specify a decay rate profile that is largest at the model top and +! drops off vertically using a hyperbolic tangent profile. +! We compute the tendencies in u and v using an Euler backward scheme. +! We then apply the negative of the kinetic energy tendency to "s", the dry +! static energy. +! +! calling sequence: +! +! rayleigh_friction_init initializes rayleigh friction constants +! rayleigh_friction_tend computes rayleigh friction tendencies +! +!---------------------------Code history-------------------------------- +! This is a new routine written by Art Mirin in collaboration with Phil Rasch. +! Initial coding for this version: Art Mirin, May 2007. +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pver +use spmd_utils, only: masterproc +use phys_control, only: use_simple_phys +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +! Public interfaces +public :: & + rayleigh_friction_readnl, &! read namelist + rayleigh_friction_init, &! Initialization + rayleigh_friction_tend ! Computation of tendencies + +! Namelist variables +integer :: rayk0 = 2 ! vertical level at which rayleigh friction term is centered +real(r8) :: raykrange = 0._r8 ! range of rayleigh friction profile + ! if 0, range is set to satisfy x=2 (see below) +real(r8) :: raytau0 = 0._r8 ! approximate value of decay time at model top (days) + ! if 0., no rayleigh friction is applied +! Local +real (r8) :: krange ! range of rayleigh friction profile +real (r8) :: tau0 ! approximate value of decay time at model top +real (r8) :: otau0 ! inverse of tau0 +real (r8) :: otau(pver) ! inverse decay time versus vertical level + +! We apply a profile of the form otau0 * [1 + tanh (x)] / 2 , where +! x = (k0 - k) / krange. The default is for x to equal 2 at k=1, meaning +! krange = (k0 - 1) / 2. The default is applied when raykrange is set to 0. +! If otau0 = 0, no term is applied. + +!=============================================================================== +contains +!=============================================================================== + +subroutine rayleigh_friction_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'rayleigh_friction_readnl' + + namelist /rayleigh_friction_nl/ rayk0, raykrange, raytau0 + !----------------------------------------------------------------------------- + + if (use_simple_phys) return + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rayleigh_friction_nl', status=ierr) + if (ierr == 0) then + read(unitn, rayleigh_friction_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(rayk0, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rayk0") + call mpi_bcast(raykrange, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raykrange") + call mpi_bcast(raytau0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raytau0") + + if (masterproc) then + if (raytau0 > 0._r8) then + write (iulog,*) 'Rayleigh friction options: ' + write (iulog,*) ' rayk0 = ', rayk0 + write (iulog,*) ' raykrange = ', raykrange + write (iulog,*) ' raytau0 = ', raytau0 + else + write (iulog,*) 'Rayleigh friction not enabled.' + end if + end if + +end subroutine rayleigh_friction_readnl + +!=============================================================================== + +subroutine rayleigh_friction_init() + + !---------------------------Local storage------------------------------- + real (r8) x + integer k + + !----------------------------------------------------------------------- + ! Compute tau array + !----------------------------------------------------------------------- + + krange = raykrange + if (raykrange .eq. 0._r8) krange = (rayk0 - 1) / 2._r8 + + tau0 = (86400._r8) * raytau0 ! convert to seconds + otau0 = 0._r8 + if (tau0 .ne. 0._r8) otau0 = 1._r8/tau0 + + do k = 1, pver + x = (rayk0 - k) / krange + otau(k) = otau0 * (1 + tanh(x)) / (2._r8) + enddo + + if (masterproc) then + if (tau0 > 0._r8) then + write (iulog,*) 'Rayleigh friction - krange = ', krange + write (iulog,*) 'Rayleigh friction - otau0 = ', otau0 + write (iulog,*) 'Rayleigh friction decay rate profile' + do k = 1, pver + write (iulog,*) ' k = ', k, ' otau = ', otau(k) + enddo + end if + end if + +end subroutine rayleigh_friction_init + +!========================================================================================= + +subroutine rayleigh_friction_tend( & + ztodt ,state ,ptend ) + + !----------------------------------------------------------------------- + ! compute tendencies for rayleigh friction + !----------------------------------------------------------------------- + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + + !------------------------------Arguments-------------------------------- + real(r8), intent(in) :: ztodt ! physics timestep + type(physics_state), intent(in) :: state ! physics state variables + + type(physics_ptend), intent(out):: ptend ! individual parameterization tendencies + + !---------------------------Local storage------------------------------- + integer :: ncol ! number of atmospheric columns + integer :: k ! level + real(r8) :: rztodt ! 1./ztodt + real(r8) :: c1, c2, c3 ! temporary variables + !----------------------------------------------------------------------- + + call physics_ptend_init(ptend, state%psetcols, 'rayleigh friction', ls=.true., lu=.true., lv=.true.) + + if (otau0 .eq. 0._r8) return + + rztodt = 1._r8/ztodt + ncol = state%ncol + + ! u, v and s are modified by rayleigh friction + + do k = 1, pver + c2 = 1._r8 / (1._r8 + otau(k)*ztodt) + c1 = -otau(k) * c2 + c3 = 0.5_r8 * (1._r8 - c2*c2) * rztodt + ptend%u(:ncol,k) = c1 * state%u(:ncol,k) + ptend%v(:ncol,k) = c1 * state%v(:ncol,k) + ptend%s(:ncol,k) = c3 * (state%u(:ncol,k)**2 + state%v(:ncol,k)**2) + enddo + +end subroutine rayleigh_friction_tend + +end module rayleigh_friction diff --git a/src/physics/cam/ref_pres.F90 b/src/physics/cam/ref_pres.F90 new file mode 100644 index 0000000000..742652db11 --- /dev/null +++ b/src/physics/cam/ref_pres.F90 @@ -0,0 +1,174 @@ +module ref_pres +!-------------------------------------------------------------------------- +! +! Provides access to reference pressures for use by the physics +! parameterizations. The pressures are provided by the dynamical core +! since it determines the grid used by the physics. +! +! Note that the init method for this module is called before the init +! method in physpkg; therefore, most physics modules can use these +! reference pressures during their init phases. +! +!-------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pver, pverp + +implicit none +public +save + +! Reference pressures (Pa) +real(r8), protected :: pref_edge(pverp) ! Layer edges +real(r8), protected :: pref_mid(pver) ! Layer midpoints +real(r8), protected :: pref_mid_norm(pver) ! Layer midpoints normalized by + ! surface pressure ('eta' coordinate) + +real(r8), protected :: ptop_ref ! Top of model +real(r8), protected :: psurf_ref ! Surface pressure + +! Number of top levels using pure pressure representation +integer, protected :: num_pr_lev + +! Pressure used to set troposphere cloud physics top (Pa) +real(r8), protected :: trop_cloud_top_press = 0._r8 +! Top level for troposphere cloud physics +integer, protected :: trop_cloud_top_lev + +! Pressure used to set MAM process top (Pa) +real(r8), protected :: clim_modal_aero_top_press = 0._r8 +! Top level for MAM processes that impact climate +integer, protected :: clim_modal_aero_top_lev + +! Molecular diffusion is calculated only if the model top is below this +! pressure (Pa). +real(r8), protected :: do_molec_press = 0.1_r8 +! Pressure used to set bottom of molecular diffusion region (Pa). +real(r8), protected :: molec_diff_bot_press = 50._r8 +! Flag for molecular diffusion, and molecular diffusion level index. +logical, protected :: do_molec_diff = .false. +integer, protected :: nbot_molec = 0 + +!==================================================================================== +contains +!==================================================================================== + +subroutine ref_pres_readnl(nlfile) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'ref_pres_readnl' + + namelist /ref_pres_nl/ trop_cloud_top_press, clim_modal_aero_top_press,& + do_molec_press, molec_diff_bot_press + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'ref_pres_nl', status=ierr) + if (ierr == 0) then + read(unitn, ref_pres_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! Check that top for modal aerosols is not lower than + ! top for clouds. + if (clim_modal_aero_top_press > trop_cloud_top_press) & + call endrun("ERROR: clim_modal_aero_top press must be less & + &than or equal to trop_cloud_top_press.") + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(trop_cloud_top_press, 1 , mpir8, 0, mpicom) + call mpibcast(clim_modal_aero_top_press, 1 , mpir8, 0, mpicom) + call mpibcast(do_molec_press, 1 , mpir8, 0, mpicom) + call mpibcast(molec_diff_bot_press, 1 , mpir8, 0, mpicom) +#endif + +end subroutine ref_pres_readnl + +!==================================================================================== + +subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) + + ! Initialize reference pressures + + ! arguments + real(r8), intent(in) :: pref_edge_in(:) ! reference pressure at layer edges (Pa) + real(r8), intent(in) :: pref_mid_in(:) ! reference pressure at layer midpoints (Pa) + integer, intent(in) :: num_pr_lev_in ! number of top levels using pure pressure representation + !--------------------------------------------------------------------------- + + pref_edge = pref_edge_in + pref_mid = pref_mid_in + num_pr_lev = num_pr_lev_in + + ptop_ref = pref_edge(1) + psurf_ref = pref_edge(pverp) + + pref_mid_norm = pref_mid/psurf_ref + + ! Find level corresponding to the top of troposphere clouds. + trop_cloud_top_lev = press_lim_idx(trop_cloud_top_press, & + top=.true.) + + ! Find level corresponding to the top for MAM processes. + clim_modal_aero_top_lev = press_lim_idx(clim_modal_aero_top_press, & + top=.true.) + + ! Find level corresponding to the molecular diffusion bottom. + do_molec_diff = (ptop_ref < do_molec_press) + if (do_molec_diff) then + nbot_molec = press_lim_idx(molec_diff_bot_press, & + top=.false.) + end if + +end subroutine ref_pres_init + +!==================================================================================== + +! Convert pressure limiters to the appropriate level. +pure function press_lim_idx(p, top) result(k_lim) + ! Pressure + real(r8), intent(in) :: p + ! Is this a top or bottom limit? + logical, intent(in) :: top + integer :: k_lim, k + + if (top) then + k_lim = pver+1 + do k = 1, pver + if (pref_mid(k) > p) then + k_lim = k + exit + end if + end do + else + k_lim = 0 + do k = pver, 1, -1 + if (pref_mid(k) < p) then + k_lim = k + exit + end if + end do + end if + +end function press_lim_idx + +!==================================================================================== + +end module ref_pres diff --git a/src/physics/cam/restart_physics.F90 b/src/physics/cam/restart_physics.F90 new file mode 100644 index 0000000000..9cf0a194f9 --- /dev/null +++ b/src/physics/cam/restart_physics.F90 @@ -0,0 +1,595 @@ +module restart_physics + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use co2_cycle, only: co2_transport + use constituents, only: pcnst + + use radiation, only: radiation_define_restart, radiation_write_restart, & + radiation_read_restart + + use ioFileMod + use cam_abortutils, only: endrun + use camsrfexch, only: cam_in_t, cam_out_t + use cam_logfile, only: iulog + use pio, only: file_desc_t, io_desc_t, var_desc_t, & + pio_double, pio_int, pio_noerr, & + pio_seterrorhandling, pio_bcast_error, & + pio_inq_varid, & + pio_def_var, pio_def_dim, & + pio_put_var, pio_get_var + + implicit none + private + save +! +! Public interfaces +! + public :: write_restart_physics ! Write the physics restart info out + public :: read_restart_physics ! Read the physics restart info in + public :: init_restart_physics + +! +! Private data +! + + type(var_desc_t) :: flwds_desc, & + solld_desc, co2prog_desc, co2diag_desc, sols_desc, soll_desc, & + solsd_desc + + type(var_desc_t) :: bcphidry_desc, bcphodry_desc, ocphidry_desc, ocphodry_desc, & + dstdry1_desc, dstdry2_desc, dstdry3_desc, dstdry4_desc + + type(var_desc_t) :: cflx_desc(pcnst) + + type(var_desc_t) :: wsx_desc + type(var_desc_t) :: wsy_desc + type(var_desc_t) :: shf_desc + + CONTAINS + subroutine init_restart_physics ( File, pbuf2d) + + use physics_buffer, only: pbuf_init_restart, physics_buffer_desc + use ppgrid, only: pver, pverp + use chemistry, only: chem_init_restart + use prescribed_ozone, only: init_prescribed_ozone_restart + use prescribed_ghg, only: init_prescribed_ghg_restart + use prescribed_aero, only: init_prescribed_aero_restart + use prescribed_volcaero, only: init_prescribed_volcaero_restart + use cam_grid_support, only: cam_grid_write_attr, cam_grid_id + use cam_grid_support, only: cam_grid_header_info_t + use cam_pio_utils, only: cam_pio_def_dim + use subcol_utils, only: is_subcol_on + use subcol, only: subcol_init_restart + + type(file_desc_t), intent(inout) :: file + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: grid_id + integer :: hdimcnt, ierr, i + integer :: dimids(4) + integer, allocatable :: hdimids(:) + type(cam_grid_header_info_t) :: info + character(len=4) :: num + + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + ! Probably should have the grid write this out. + grid_id = cam_grid_id('physgrid') + call cam_grid_write_attr(File, grid_id, info) + hdimcnt = info%num_hdims() + + do i = 1, hdimcnt + dimids(i) = info%get_hdimid(i) + end do + allocate(hdimids(hdimcnt)) + hdimids(1:hdimcnt) = dimids(1:hdimcnt) + + call pbuf_init_restart(File, pbuf2d) + + call chem_init_restart(File) + + call init_prescribed_ozone_restart(File) + call init_prescribed_ghg_restart(File) + call init_prescribed_aero_restart(File) + call init_prescribed_volcaero_restart(File) + + ierr = pio_def_var(File, 'FLWDS', pio_double, hdimids, flwds_desc) + ierr = pio_def_var(File, 'SOLS', pio_double, hdimids, sols_desc) + ierr = pio_def_var(File, 'SOLL', pio_double, hdimids, soll_desc) + ierr = pio_def_var(File, 'SOLSD', pio_double, hdimids, solsd_desc) + ierr = pio_def_var(File, 'SOLLD', pio_double, hdimids, solld_desc) + + ierr = pio_def_var(File, 'BCPHIDRY', pio_double, hdimids, bcphidry_desc) + ierr = pio_def_var(File, 'BCPHODRY', pio_double, hdimids, bcphodry_desc) + ierr = pio_def_var(File, 'OCPHIDRY', pio_double, hdimids, ocphidry_desc) + ierr = pio_def_var(File, 'OCPHODRY', pio_double, hdimids, ocphodry_desc) + ierr = pio_def_var(File, 'DSTDRY1', pio_double, hdimids, dstdry1_desc) + ierr = pio_def_var(File, 'DSTDRY2', pio_double, hdimids, dstdry2_desc) + ierr = pio_def_var(File, 'DSTDRY3', pio_double, hdimids, dstdry3_desc) + ierr = pio_def_var(File, 'DSTDRY4', pio_double, hdimids, dstdry4_desc) + + if(co2_transport()) then + ierr = pio_def_var(File, 'CO2PROG', pio_double, hdimids, co2prog_desc) + ierr = pio_def_var(File, 'CO2DIAG', pio_double, hdimids, co2diag_desc) + end if + + ! cam_import variables -- write the constituent surface fluxes as individual 2D arrays + ! rather than as a single variable with a pcnst dimension. Note that the cflx components + ! are only needed for those constituents that are not passed to the coupler. The restart + ! for constituents passed through the coupler are handled by the .rs. restart file. But + ! we don't currently have a mechanism to know whether the constituent is handled by the + ! coupler or not, so we write all of cflx to the CAM restart file. + do i = 1, pcnst + write(num,'(i4.4)') i + ierr = pio_def_var(File, 'CFLX'//num, pio_double, hdimids, cflx_desc(i)) + end do + + ierr = pio_def_var(File, 'wsx', pio_double, hdimids, wsx_desc) + ierr = pio_def_var(File, 'wsy', pio_double, hdimids, wsy_desc) + ierr = pio_def_var(File, 'shf', pio_double, hdimids, shf_desc) + + call radiation_define_restart(file) + + if (is_subcol_on()) then + call subcol_init_restart(file, hdimids) + end if + + end subroutine init_restart_physics + + subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) + + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_write_restart + use phys_grid, only: phys_decomp + + use ppgrid, only: begchunk, endchunk, pcols, pverp + use chemistry, only: chem_write_restart + use prescribed_ozone, only: write_prescribed_ozone_restart + use prescribed_ghg, only: write_prescribed_ghg_restart + use prescribed_aero, only: write_prescribed_aero_restart + use prescribed_volcaero, only: write_prescribed_volcaero_restart + + use cam_history_support, only: fillvalue + use spmd_utils, only: iam + use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_id + use cam_grid_support, only: cam_grid_get_decomp, cam_grid_dimensions + use cam_grid_support, only: cam_grid_write_var + use pio, only: pio_write_darray + use subcol_utils, only: is_subcol_on + use subcol, only: subcol_write_restart + ! + ! Input arguments + ! + type(file_desc_t), intent(inout) :: File + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) + type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + ! + ! Local workspace + ! + type(io_desc_t), pointer :: iodesc + real(r8):: tmpfield(pcols, begchunk:endchunk) + integer :: i, m ! loop index + integer :: ncol ! number of vertical columns + integer :: ierr + integer :: physgrid + integer :: dims(3), gdims(3) + integer :: nhdims + !----------------------------------------------------------------------- + + ! Write grid vars + call cam_grid_write_var(File, phys_decomp) + + ! Physics buffer + if (is_subcol_on()) then + call subcol_write_restart(File) + end if + + call pbuf_write_restart(File, pbuf2d) + + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + + ! data for chemistry + call chem_write_restart(File) + + call write_prescribed_ozone_restart(File) + call write_prescribed_ghg_restart(File) + call write_prescribed_aero_restart(File) + call write_prescribed_volcaero_restart(File) + + ! cam_in/out variables + ! This is a group of surface variables so can reuse dims + dims(1) = pcols + dims(2) = endchunk - begchunk + 1 + call cam_grid_get_decomp(physgrid, dims(1:2), gdims(1:nhdims), & + pio_double, iodesc) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%flwds(:ncol) + ! Only have to do this once (cam_in/out vars all same shape) + if (ncol < pcols) then + tmpfield(ncol+1:, i) = fillvalue + end if + end do + call pio_write_darray(File, flwds_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%sols(:ncol) + end do + call pio_write_darray(File, sols_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%soll(:ncol) + end do + call pio_write_darray(File, soll_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%solsd(:ncol) + end do + call pio_write_darray(File, solsd_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%solld(:ncol) + end do + call pio_write_darray(File, solld_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%bcphidry(:ncol) + end do + call pio_write_darray(File, bcphidry_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%bcphodry(:ncol) + end do + call pio_write_darray(File, bcphodry_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%ocphidry(:ncol) + end do + call pio_write_darray(File, ocphidry_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%ocphodry(:ncol) + end do + call pio_write_darray(File, ocphodry_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%dstdry1(:ncol) + end do + call pio_write_darray(File, dstdry1_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%dstdry2(:ncol) + end do + call pio_write_darray(File, dstdry2_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%dstdry3(:ncol) + end do + call pio_write_darray(File, dstdry3_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%dstdry4(:ncol) + end do + call pio_write_darray(File, dstdry4_desc, iodesc, tmpfield, ierr) + + if (co2_transport()) then + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%co2prog(:ncol) + end do + call pio_write_darray(File, co2prog_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_out(i)%ncol + tmpfield(:ncol, i) = cam_out(i)%co2diag(:ncol) + end do + call pio_write_darray(File, co2diag_desc, iodesc, tmpfield, ierr) + end if + + ! cam_in components + do m = 1, pcnst + do i = begchunk, endchunk + ncol = cam_in(i)%ncol + tmpfield(:ncol, i) = cam_in(i)%cflx(:ncol, m) + end do + call pio_write_darray(File, cflx_desc(m), iodesc, tmpfield, ierr) + end do + + do i = begchunk, endchunk + ncol = cam_in(i)%ncol + tmpfield(:ncol,i) = cam_in(i)%wsx(:ncol) + end do + call pio_write_darray(File, wsx_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_in(i)%ncol + tmpfield(:ncol,i) = cam_in(i)%wsy(:ncol) + end do + call pio_write_darray(File, wsy_desc, iodesc, tmpfield, ierr) + + do i = begchunk, endchunk + ncol = cam_in(i)%ncol + tmpfield(:ncol,i) = cam_in(i)%shf(:ncol) + end do + call pio_write_darray(File, shf_desc, iodesc, tmpfield, ierr) + + call radiation_write_restart(file) + + end subroutine write_restart_physics + +!####################################################################### + + subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) + + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_read_restart + + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp + use chemistry, only: chem_read_restart + use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_id + use cam_grid_support, only: cam_grid_get_decomp, cam_grid_dimensions + use cam_history_support, only: fillvalue + + use prescribed_ozone, only: read_prescribed_ozone_restart + use prescribed_ghg, only: read_prescribed_ghg_restart + use prescribed_aero, only: read_prescribed_aero_restart + use prescribed_volcaero, only: read_prescribed_volcaero_restart + use subcol_utils, only: is_subcol_on + use subcol, only: subcol_read_restart + use pio, only: pio_read_darray + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: File + type(cam_in_t), pointer :: cam_in(:) + type(cam_out_t), pointer :: cam_out(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + ! + ! Local workspace + ! + real(r8), allocatable :: tmpfield2(:,:) + integer :: i, c, m ! loop index + integer :: ierr ! I/O status + type(io_desc_t), pointer :: iodesc + type(var_desc_t) :: vardesc + integer :: csize, vsize + character(len=4) :: num + integer :: dims(3), gdims(3), nhdims + integer :: err_handling + integer :: physgrid + !----------------------------------------------------------------------- + + ! subcol_read_restart must be called before pbuf_read_restart + if (is_subcol_on()) then + call subcol_read_restart(File) + end if + + call pbuf_read_restart(File, pbuf2d) + + csize=endchunk-begchunk+1 + dims(1) = pcols + dims(2) = csize + + physgrid = cam_grid_id('physgrid') + + call cam_grid_dimensions(physgrid, gdims(1:2)) + + if (gdims(2) == 1) then + nhdims = 1 + else + nhdims = 2 + end if + call cam_grid_get_decomp(physgrid, dims(1:2), gdims(1:nhdims), pio_double, & + iodesc) + + ! data for chemistry + call chem_read_restart(File) + + call read_prescribed_ozone_restart(File) + call read_prescribed_ghg_restart(File) + call read_prescribed_aero_restart(File) + call read_prescribed_volcaero_restart(File) + + allocate(tmpfield2(pcols, begchunk:endchunk)) + tmpfield2 = fillvalue + + ierr = pio_inq_varid(File, 'FLWDS', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%flwds(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'SOLS', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%sols(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'SOLL', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%soll(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'SOLSD', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%solsd(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'SOLLD', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%solld(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'BCPHIDRY', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%bcphidry(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'BCPHODRY', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%bcphodry(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'OCPHIDRY', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%ocphidry(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'OCPHODRY', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%ocphodry(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'DSTDRY1', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%dstdry1(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'DSTDRY2', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%dstdry2(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'DSTDRY3', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%dstdry3(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'DSTDRY4', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%dstdry4(i) = tmpfield2(i, c) + end do + end do + + if (co2_transport()) then + ierr = pio_inq_varid(File, 'CO2PROG', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%co2prog(i) = tmpfield2(i, c) + end do + end do + + ierr = pio_inq_varid(File, 'CO2DIAG', vardesc) + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c=begchunk,endchunk + do i=1,pcols + cam_out(c)%co2diag(i) = tmpfield2(i, c) + end do + end do + end if + + ! Reading the CFLX* components from the restart is optional for + ! backwards compatibility. These fields were not needed for an + ! exact restart until the UNICON scheme was added. More generally, + ! these components are only needed if they are not handled by the + ! coupling layer restart (the ".rs." file), and if the values are + ! used in the tphysbc physics before the tphysac code has a chance + ! to update the values that are coming from boundary datasets. + do m = 1, pcnst + + write(num,'(i4.4)') m + + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'CFLX'//num, vardesc) + call pio_seterrorhandling(File, err_handling) + + if (ierr == PIO_NOERR) then ! CFLX variable found on restart file + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c= begchunk, endchunk + do i = 1, pcols + cam_in(c)%cflx(i,m) = tmpfield2(i, c) + end do + end do + end if + + end do + + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'wsx', vardesc) + if (ierr == PIO_NOERR) then ! variable found on restart file + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c= begchunk, endchunk + do i = 1, pcols + cam_in(c)%wsx(i) = tmpfield2(i, c) + end do + end do + end if + ierr = pio_inq_varid(File, 'wsy', vardesc) + if (ierr == PIO_NOERR) then ! variable found on restart file + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c= begchunk, endchunk + do i = 1, pcols + cam_in(c)%wsy(i) = tmpfield2(i, c) + end do + end do + end if + ierr = pio_inq_varid(File, 'shf', vardesc) + if (ierr == PIO_NOERR) then ! variable found on restart file + call pio_read_darray(File, vardesc, iodesc, tmpfield2, ierr) + do c= begchunk, endchunk + do i = 1, pcols + cam_in(c)%shf(i) = tmpfield2(i, c) + end do + end do + endif + call pio_seterrorhandling(File, err_handling) + + deallocate(tmpfield2) + + call radiation_read_restart(file) + + end subroutine read_restart_physics + + end module restart_physics diff --git a/src/physics/cam/rk_stratiform.F90 b/src/physics/cam/rk_stratiform.F90 new file mode 100644 index 0000000000..a951edd3fa --- /dev/null +++ b/src/physics/cam/rk_stratiform.F90 @@ -0,0 +1,1220 @@ +module rk_stratiform + +!------------------------------------------------------------------------------------------------------- +! +! Provides the CAM interface to the Rasch and Kristjansson (RK) +! prognostic cloud microphysics, and the cam3/4 macrophysics. +! +!------------------------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physconst, only: gravit, latvap, latice +use phys_control, only: phys_getopts +use constituents, only: pcnst +use spmd_utils, only: masterproc + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use perf_mod + +implicit none +private +save + +public :: rk_stratiform_register, rk_stratiform_init_cnst, rk_stratiform_implements_cnst +public :: rk_stratiform_init +public :: rk_stratiform_tend +public :: rk_stratiform_readnl + +! Physics buffer indices +integer :: landm_idx = 0 + +integer :: qcwat_idx = 0 +integer :: lcwat_idx = 0 +integer :: tcwat_idx = 0 + +integer :: cld_idx = 0 +integer :: ast_idx = 0 +integer :: concld_idx = 0 +integer :: fice_idx = 0 + +integer :: qme_idx = 0 +integer :: prain_idx = 0 +integer :: nevapr_idx = 0 + +integer :: wsedl_idx = 0 + +integer :: rei_idx = 0 +integer :: rel_idx = 0 + +integer :: shfrc_idx = 0 +integer :: cmfmc_sh_idx = 0 + +integer :: prec_str_idx = 0 +integer :: snow_str_idx = 0 +integer :: prec_sed_idx = 0 +integer :: snow_sed_idx = 0 +integer :: prec_pcw_idx = 0 +integer :: snow_pcw_idx = 0 + +integer :: ls_flxprc_idx = 0 +integer :: ls_flxsnw_idx = 0 + +integer, parameter :: ncnst = 2 ! Number of constituents +character(len=8), dimension(ncnst), parameter & ! Constituent names + :: cnst_names = (/'CLDLIQ', 'CLDICE'/) +logical :: use_shfrc ! Local copy of flag from convect_shallow_use_shfrc + +logical :: do_cnst = .false. ! True when this module has registered constituents. + +integer :: & + ixcldliq, &! cloud liquid amount index + ixcldice ! cloud ice amount index + +real(r8), parameter :: unset_r8 = huge(1.0_r8) +logical :: do_psrhmin + +!=============================================================================== +contains +!=============================================================================== + subroutine rk_stratiform_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cldwat, only: cldwat_init + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'rk_stratiform_readnl' + + ! Namelist variables + real(r8) :: rk_strat_icritw = unset_r8 ! icritw = threshold for autoconversion of warm ice + real(r8) :: rk_strat_icritc = unset_r8 ! icritc = threshold for autoconversion of cold ice + real(r8) :: rk_strat_conke = unset_r8 ! conke = tunable constant for evaporation of precip + real(r8) :: rk_strat_r3lcrit = unset_r8 ! r3lcrit = critical radius where liq conversion begins + real(r8) :: rk_strat_polstrat_rhmin = unset_r8 ! condensation threadhold in polar stratosphere + + namelist /rk_stratiform_nl/ rk_strat_icritw, rk_strat_icritc, rk_strat_conke, rk_strat_r3lcrit + namelist /rk_stratiform_nl/ rk_strat_polstrat_rhmin + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rk_stratiform_nl', status=ierr) + if (ierr == 0) then + read(unitn, rk_stratiform_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(rk_strat_icritw, 1, mpir8, 0, mpicom) + call mpibcast(rk_strat_icritc, 1, mpir8, 0, mpicom) + call mpibcast(rk_strat_conke, 1, mpir8, 0, mpicom) + call mpibcast(rk_strat_r3lcrit, 1, mpir8, 0, mpicom) + call mpibcast(rk_strat_polstrat_rhmin, 1, mpir8, 0, mpicom) +#endif + + do_psrhmin = rk_strat_polstrat_rhmin .ne. unset_r8 + + call cldwat_init(rk_strat_icritw,rk_strat_icritc,rk_strat_conke,& + rk_strat_r3lcrit,rk_strat_polstrat_rhmin,do_psrhmin) + +end subroutine rk_stratiform_readnl + +subroutine rk_stratiform_register + + !---------------------------------------------------------------------- ! + ! ! + ! Register the constituents (cloud liquid and cloud ice) and the fields ! + ! in the physics buffer. ! + ! ! + !---------------------------------------------------------------------- ! + + use constituents, only: cnst_add, pcnst + use physconst, only: mwh2o, cpair + + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls + + !----------------------------------------------------------------------- + + ! Take note of the fact that we are registering constituents. + do_cnst = .true. + + ! Register cloud water and save indices. + call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & + longname='Grid box averaged cloud ice amount', is_convtran1=.true.) + + call pbuf_add_field('QCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qcwat_idx) + call pbuf_add_field('LCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), lcwat_idx) + call pbuf_add_field('TCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), tcwat_idx) + + call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) + call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) + + call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) + + call pbuf_add_field('QME', 'physpkg', dtype_r8, (/pcols,pver/), qme_idx) + call pbuf_add_field('PRAIN', 'physpkg', dtype_r8, (/pcols,pver/), prain_idx) + call pbuf_add_field('NEVAPR', 'physpkg', dtype_r8, (/pcols,pver/), nevapr_idx) + + call pbuf_add_field('WSEDL', 'physpkg', dtype_r8, (/pcols,pver/), wsedl_idx) + + call pbuf_add_field('REI', 'physpkg', dtype_r8, (/pcols,pver/), rei_idx) + call pbuf_add_field('REL', 'physpkg', dtype_r8, (/pcols,pver/), rel_idx) + + call pbuf_add_field('LS_FLXPRC', 'physpkg', dtype_r8, (/pcols,pverp/), ls_flxprc_idx) + call pbuf_add_field('LS_FLXSNW', 'physpkg', dtype_r8, (/pcols,pverp/), ls_flxsnw_idx) + +end subroutine rk_stratiform_register + +!=============================================================================== + +function rk_stratiform_implements_cnst(name) + + !----------------------------------------------------------------------------- ! + ! ! + ! Return true if specified constituent is implemented by this package ! + ! ! + !----------------------------------------------------------------------------- ! + + character(len=*), intent(in) :: name ! constituent name + logical :: rk_stratiform_implements_cnst ! return value + + !----------------------------------------------------------------------- + + rk_stratiform_implements_cnst = (do_cnst .and. any(name == cnst_names)) + +end function rk_stratiform_implements_cnst + +!=============================================================================== + +subroutine rk_stratiform_init_cnst(name, latvals, lonvals, mask, q) + + !----------------------------------------------------------------------- ! + ! ! + ! Initialize the cloud water mixing ratios (liquid and ice), if they are ! + ! not read from the initial file ! + ! ! + !----------------------------------------------------------------------- ! + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + integer :: k + + if (any(name == cnst_names)) then + do k = 1, size(q, 2) + where(mask) + q(:, k) = 0.0_r8 + end where + end do + end if + +end subroutine rk_stratiform_init_cnst + +!=============================================================================== + +subroutine rk_stratiform_init() + + !-------------------------------------------- ! + ! ! + ! Initialize the cloud water parameterization ! + ! ! + !-------------------------------------------- ! + + use physics_buffer, only: physics_buffer_desc, pbuf_get_index + use constituents, only: cnst_get_ind, cnst_name, cnst_longname, sflxnam, apcnst, bpcnst + use cam_history, only: addfld, add_default, horiz_only + use convect_shallow, only: convect_shallow_use_shfrc + use phys_control, only: cam_physpkg_is + use physconst, only: tmelt, rhodair, rh2o + use cldwat, only: inimc + + integer :: m, mm + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_aerosol ! Output the MAM aerosol tendencies + logical :: history_budget ! Output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol , & + history_amwg_out = history_amwg , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num) + + landm_idx = pbuf_get_index("LANDM") + + ! Find out whether shfrc from convect_shallow will be used in cldfrc + if( convect_shallow_use_shfrc() ) then + use_shfrc = .true. + shfrc_idx = pbuf_get_index('shfrc') + else + use_shfrc = .false. + endif + + ! Register history variables + + do m = 1, ncnst + call cnst_get_ind( cnst_names(m), mm ) + call addfld( cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm) ) + call addfld( sflxnam (mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux' ) + if (history_amwg) then + call add_default( cnst_name(mm), 1, ' ' ) + call add_default( sflxnam (mm), 1, ' ' ) + endif + enddo + + call addfld (apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' ) + call addfld (apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' ) + call addfld (bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' ) + call addfld (bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' ) + + if( history_budget) then + call add_default (cnst_name(ixcldliq), history_budget_histfile_num, ' ') + call add_default (cnst_name(ixcldice), history_budget_histfile_num, ' ') + call add_default (apcnst (ixcldliq), history_budget_histfile_num, ' ') + call add_default (apcnst (ixcldice), history_budget_histfile_num, ' ') + call add_default (bpcnst (ixcldliq), history_budget_histfile_num, ' ') + call add_default (bpcnst (ixcldice), history_budget_histfile_num, ' ') + end if + + call addfld ('FWAUT', (/ 'lev' /), 'A', 'fraction', 'Relative importance of liquid autoconversion' ) + call addfld ('FSAUT', (/ 'lev' /), 'A', 'fraction', 'Relative importance of ice autoconversion' ) + call addfld ('FRACW', (/ 'lev' /), 'A', 'fraction', 'Relative importance of rain accreting liquid' ) + call addfld ('FSACW', (/ 'lev' /), 'A', 'fraction', 'Relative importance of snow accreting liquid' ) + call addfld ('FSACI', (/ 'lev' /), 'A', 'fraction', 'Relative importance of snow accreting ice' ) + call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of cond-evap within the cloud' ) + call addfld ('CMEICE', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of cond-evap of ice within the cloud' ) + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of cond-evap of liq within the cloud' ) + call addfld ('ICE2PR', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of conversion of ice to precip' ) + call addfld ('LIQ2PR', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of conversion of liq to precip' ) + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s' , 'Detrained liquid water from ZM convection' ) + call addfld ('SHDLF', (/ 'lev' /), 'A', 'kg/kg/s' , 'Detrained liquid water from shallow convection' ) + + call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of conversion of condensate to precip' ) + call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of evaporation of falling precip' ) + call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s' , 'Rate of evaporation of falling snow' ) + call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds' ) + call addfld ('HCME', (/ 'lev' /), 'A', 'W/kg' , 'Heating from cond-evap within the cloud' ) + call addfld ('HEVAP', (/ 'lev' /), 'A', 'W/kg' , 'Heating from evaporation of falling precip' ) + call addfld ('HFREEZ', (/ 'lev' /), 'A', 'W/kg' , 'Heating rate due to freezing of precip' ) + call addfld ('HMELT', (/ 'lev' /), 'A', 'W/kg' , 'Heating from snow melt' ) + call addfld ('HREPART', (/ 'lev' /), 'A', 'W/kg' , 'Heating from cloud ice/liquid repartitioning' ) + call addfld ('REPARTICE', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud ice tendency from cloud ice/liquid repartitioning' ) + call addfld ('REPARTLIQ', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud liq tendency from cloud ice/liquid repartitioning' ) + call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud' ) + call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg' , 'Prognostic in-cloud water mixing ratio' ) + call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg' , 'Prognostic in-cloud ice mixing ratio' ) + call addfld ('PCSNOW', horiz_only , 'A', 'm/s' , 'Snow fall from prognostic clouds' ) + + call addfld ('DQSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Water vapor tendency from cloud sedimentation' ) + call addfld ('DLSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud liquid tendency from sedimentation' ) + call addfld ('DISED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud ice tendency from sedimentation' ) + call addfld ('HSED', (/ 'lev' /), 'A', 'W/kg' , 'Heating from cloud sediment evaporation' ) + call addfld ('SNOWSED', horiz_only, 'A', 'm/s' , 'Snow from cloud ice sedimentation' ) + call addfld ('RAINSED', horiz_only, 'A', 'm/s' , 'Rain from cloud liquid sedimentation' ) + call addfld ('PRECSED', horiz_only, 'A', 'm/s' , 'Precipitation from cloud sedimentation' ) + + + call addfld ('CNVCLD', horiz_only, 'A', 'fraction', 'Vertically integrated convective cloud amount' ) + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) + + call addfld ('AST', (/ 'lev' /), 'A','fraction' , 'Stratus cloud fraction' ) + call addfld ('LIQCLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus Liquid cloud fraction' ) + call addfld ('ICECLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus ICE cloud fraction' ) + call addfld ('IWC', (/ 'lev' /), 'A', 'kg/m3' , 'Grid box average ice water content' ) + call addfld ('LWC', (/ 'lev' /), 'A', 'kg/m3' , 'Grid box average liquid water content' ) + call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3' , 'Prognostic in-cloud water number conc' ) + call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3' , 'Prognostic in-cloud ice number conc' ) + call addfld ('REL', (/ 'lev' /), 'A', 'micron' , 'effective liquid drop radius' ) + call addfld ('REI', (/ 'lev' /), 'A', 'micron' , 'effective ice particle radius' ) + + if ( history_budget ) then + + call add_default ('EVAPSNOW ', history_budget_histfile_num, ' ') + call add_default ('EVAPPREC ', history_budget_histfile_num, ' ') + call add_default ('CMELIQ ', history_budget_histfile_num, ' ') + + if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + + call add_default ('ZMDLF ', history_budget_histfile_num, ' ') + call add_default ('CME ', history_budget_histfile_num, ' ') + call add_default ('DQSED ', history_budget_histfile_num, ' ') + call add_default ('DISED ', history_budget_histfile_num, ' ') + call add_default ('DLSED ', history_budget_histfile_num, ' ') + call add_default ('HSED ', history_budget_histfile_num, ' ') + call add_default ('CMEICE ', history_budget_histfile_num, ' ') + call add_default ('LIQ2PR ', history_budget_histfile_num, ' ') + call add_default ('ICE2PR ', history_budget_histfile_num, ' ') + call add_default ('HCME ', history_budget_histfile_num, ' ') + call add_default ('HEVAP ', history_budget_histfile_num, ' ') + call add_default ('HFREEZ ', history_budget_histfile_num, ' ') + call add_default ('HMELT ', history_budget_histfile_num, ' ') + call add_default ('HREPART ', history_budget_histfile_num, ' ') + call add_default ('HPROGCLD ', history_budget_histfile_num, ' ') + call add_default ('REPARTLIQ', history_budget_histfile_num, ' ') + call add_default ('REPARTICE', history_budget_histfile_num, ' ') + + end if + + end if + + if (history_amwg) then + call add_default ('ICWMR', 1, ' ') + call add_default ('ICIMR', 1, ' ') + call add_default ('CONCLD ', 1, ' ') + call add_default ('FICE ', 1, ' ') + endif + + ! History Variables for COSP/CFMIP + call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux') + call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux') + call addfld ('PRACWO', (/ 'lev' /), 'A', '1/s', 'Accretion of cloud water by rain') + call addfld ('PSACWO', (/ 'lev' /), 'A', '1/s', 'Accretion of cloud water by snow') + call addfld ('PSACIO', (/ 'lev' /), 'A', '1/s', 'Accretion of cloud ice by snow') + + call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ') + call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE') + call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ') + call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE') + + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + prec_sed_idx = pbuf_get_index('PREC_SED') + snow_sed_idx = pbuf_get_index('SNOW_SED') + + ! Initialize cldwat with constants. + call inimc(tmelt, rhodair/1000.0_r8, gravit, rh2o) + +end subroutine rk_stratiform_init + +!=============================================================================== + +subroutine rk_stratiform_tend( & + state, ptend_all, pbuf, dtime, icefrac, & + landfrac, ocnfrac, snowh, dlf, & + dlf2, rliq, cmfmc, ts, & + sst, zdu) + + !-------------------------------------------------------- ! + ! ! + ! Interface to sedimentation, detrain, cloud fraction and ! + ! cloud macro - microphysics subroutines ! + ! ! + !-------------------------------------------------------- ! + + use cloud_fraction, only: cldfrc, cldfrc_fice + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init, physics_update + use physics_types, only: physics_ptend_sum, physics_state_copy + use physics_types, only: physics_state_dealloc + use cam_history, only: outfld + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use pkg_cld_sediment, only: cld_sediment_vel, cld_sediment_tend + use cldwat, only: pcond + use pkg_cldoptics, only: cldefr + use phys_control, only: cam_physpkg_is + use tropopause, only: tropopause_find, TROP_ALG_TWMO, TROP_ALG_CLIMATE + use phys_grid, only: get_rlat_all_p + use physconst, only: pi + + ! Arguments + type(physics_state), intent(in) :: state ! State variables + type(physics_ptend), intent(out) :: ptend_all ! Package tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dtime ! Timestep + real(r8), intent(in) :: icefrac (pcols) ! Sea ice fraction (fraction) + real(r8), intent(in) :: landfrac(pcols) ! Land fraction (fraction) + real(r8), intent(in) :: ocnfrac (pcols) ! Ocean fraction (fraction) + real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m) + + real(r8), intent(in) :: dlf(pcols,pver) ! Detrained water from convection schemes + real(r8), intent(in) :: dlf2(pcols,pver) ! Detrained water from shallow convection scheme + real(r8), intent(in) :: rliq(pcols) ! Vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(in) :: cmfmc(pcols,pverp) ! Deep + Shallow Convective mass flux [ kg /s/m^2 ] + + real(r8), intent(in) :: ts(pcols) ! Surface temperature + real(r8), intent(in) :: sst(pcols) ! Sea surface temperature + real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection + + ! Local variables + + type(physics_state) :: state1 ! Local copy of the state variable + type(physics_ptend) :: ptend_loc ! Package tendencies + + integer :: i, k, m + integer :: lchnk ! Chunk identifier + integer :: ncol ! Number of atmospheric columns + integer :: itim_old + + ! Physics buffer fields + real(r8), pointer :: landm(:) ! Land fraction ramped over water + + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] + real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation + real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation + real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ] + real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ] + + real(r8), pointer, dimension(:,:) :: qcwat ! Cloud water old q + real(r8), pointer, dimension(:,:) :: tcwat ! Cloud water old temperature + real(r8), pointer, dimension(:,:) :: lcwat ! Cloud liquid water old q + real(r8), pointer, dimension(:,:) :: cld ! Total cloud fraction + real(r8), pointer, dimension(:,:) :: fice ! Cloud ice/water partitioning ratio. + real(r8), pointer, dimension(:,:) :: ast ! Relative humidity cloud fraction + real(r8), pointer, dimension(:,:) :: concld ! Convective cloud fraction + real(r8), pointer, dimension(:,:) :: qme ! rate of cond-evap of condensate (1/s) + real(r8), pointer, dimension(:,:) :: prain ! Total precipitation (rain + snow) + real(r8), pointer, dimension(:,:) :: nevapr ! Evaporation of total precipitation (rain + snow) + real(r8), pointer, dimension(:,:) :: rel ! Liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! Ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: wsedl ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] + real(r8), pointer, dimension(:,:) :: shfrc ! Cloud fraction from shallow convection scheme + real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux (pcols,pverp) [ kg/s/m^2 ] + + real(r8), target :: shfrc_local(pcols,pver) + + ! physics buffer fields for COSP simulator (RK only) + real(r8), pointer, dimension(:,:) :: rkflxprc ! RK grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) + real(r8), pointer, dimension(:,:) :: rkflxsnw ! RK grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) + + ! Local variables for stratiform_sediment + real(r8) :: rain(pcols) ! Surface flux of cloud liquid + real(r8) :: pvliq(pcols,pverp) ! Vertical velocity of cloud liquid drops (Pa/s) + real(r8) :: pvice(pcols,pverp) ! Vertical velocity of cloud ice particles (Pa/s) + + ! Local variables for cldfrc + + real(r8) :: cldst(pcols,pver) ! Stratus cloud fraction + real(r8) :: rhcloud(pcols,pver) ! Relative humidity cloud (last timestep) + real(r8) :: rhcloud2(pcols,pver) ! Relative humidity cloud (perturbation) + real(r8) :: clc(pcols) ! Column convective cloud amount + real(r8) :: relhum(pcols,pver) ! RH, output to determine drh/da + real(r8) :: rhu00(pcols,pver) + real(r8) :: rhu002(pcols,pver) ! Same as rhu00 but for perturbed rh + real(r8) :: rhdfda(pcols,pver) + real(r8) :: cld2(pcols,pver) ! Same as cld but for perturbed rh + real(r8) :: concld2(pcols,pver) ! Same as concld but for perturbed rh + real(r8) :: cldst2(pcols,pver) ! Same as cldst but for perturbed rh + real(r8) :: relhum2(pcols,pver) ! RH after perturbation + real(r8) :: icecldf(pcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud) + real(r8) :: icecldf_out(pcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf_out(pcols,pver) ! Liquid cloud fraction (combined into cloud) + real(r8) :: icecldf2(pcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf2(pcols,pver) ! Liquid cloud fraction (combined into cloud) + + ! Local variables for microphysics + + real(r8) :: rdtime ! 1./dtime + real(r8) :: qtend(pcols,pver) ! Moisture tendencies + real(r8) :: ttend(pcols,pver) ! Temperature tendencies + real(r8) :: ltend(pcols,pver) ! Cloud liquid water tendencies + real(r8) :: evapheat(pcols,pver) ! Heating rate due to evaporation of precip + real(r8) :: evapsnow(pcols,pver) ! Local evaporation of snow + real(r8) :: prfzheat(pcols,pver) ! Heating rate due to freezing of precip (W/kg) + real(r8) :: meltheat(pcols,pver) ! Heating rate due to phase change of precip + real(r8) :: cmeheat (pcols,pver) ! Heating rate due to phase change of precip + real(r8) :: prodsnow(pcols,pver) ! Local production of snow + real(r8) :: totcw(pcols,pver) ! Total cloud water mixing ratio + real(r8) :: fsnow(pcols,pver) ! Fractional snow production + real(r8) :: repartht(pcols,pver) ! Heating rate due to phase repartition of input precip + real(r8) :: icimr(pcols,pver) ! In cloud ice mixing ratio + real(r8) :: icwmr(pcols,pver) ! In cloud water mixing ratio + real(r8) :: fwaut(pcols,pver) + real(r8) :: fsaut(pcols,pver) + real(r8) :: fracw(pcols,pver) + real(r8) :: fsacw(pcols,pver) + real(r8) :: fsaci(pcols,pver) + real(r8) :: cmeice(pcols,pver) ! Rate of cond-evap of ice within the cloud + real(r8) :: cmeliq(pcols,pver) ! Rate of cond-evap of liq within the cloud + real(r8) :: ice2pr(pcols,pver) ! Rate of conversion of ice to precip + real(r8) :: liq2pr(pcols,pver) ! Rate of conversion of liquid to precip + real(r8) :: liq2snow(pcols,pver) ! Rate of conversion of liquid to snow + + ! Local variables for CFMIP calculations + real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) + real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) + real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) + + real(r8) :: pracwo(pcols,pver) ! RK accretion of cloud water by rain (1/s) + real(r8) :: psacwo(pcols,pver) ! RK accretion of cloud water by snow (1/s) + real(r8) :: psacio(pcols,pver) ! RK accretion of cloud ice by snow (1/s) + + real(r8) :: iwc(pcols,pver) ! Grid box average ice water content + real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content + + logical :: lq(pcnst) + integer :: troplev(pcols) + real(r8) :: rlat(pcols) + real(r8) :: dlat(pcols) + real(r8), parameter :: rad2deg = 180._r8/pi + + ! ====================================================================== + + lchnk = state%lchnk + ncol = state%ncol + + call physics_state_copy(state,state1) ! Copy state to local state1. + + ! Associate pointers with physics buffer fields + + call pbuf_get_field(pbuf, landm_idx, landm) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, qcwat_idx, qcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, tcwat_idx, tcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, lcwat_idx, lcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, fice_idx, fice) + + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + + call pbuf_get_field(pbuf, prec_str_idx, prec_str) + call pbuf_get_field(pbuf, snow_str_idx, snow_str) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw) + + call pbuf_get_field(pbuf, qme_idx, qme ) + call pbuf_get_field(pbuf, prain_idx, prain) + call pbuf_get_field(pbuf, nevapr_idx, nevapr) + + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + + call pbuf_get_field(pbuf, wsedl_idx, wsedl) + + ! check that qcwat and tcwat were initialized; if not then do it now. + if (qcwat(1,1) == huge(1._r8)) then + qcwat(:ncol,:) = state%q(:ncol,:,1) + end if + if (tcwat(1,1) == huge(1._r8)) then + tcwat(:ncol,:) = state%t(:ncol,:) + end if + + if ( do_psrhmin ) then + call tropopause_find(state, troplev, primary=TROP_ALG_TWMO, backup=TROP_ALG_CLIMATE) + call get_rlat_all_p(lchnk,ncol,rlat) + dlat = rlat*rad2deg + endif + + ! ------------- ! + ! Sedimentation ! + ! ------------- ! + + ! Allow the cloud liquid drops and ice particles to sediment. + ! This is done before adding convectively detrained cloud water, + ! because the phase of the detrained water is unknown. + + call t_startf('stratiform_sediment') + + call cld_sediment_vel( ncol, & + icefrac, landfrac, ocnfrac, state1%pmid, state1%pdel, state1%t, & + cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), & + pvliq, pvice, landm, snowh ) + + wsedl(:ncol,:pver) = pvliq(:ncol,:pver)/gravit/(state1%pmid(:ncol,:pver)/(287.15_r8*state1%t(:ncol,:pver))) + + lq(:) = .FALSE. + lq(1) = .TRUE. + lq(ixcldice) = .TRUE. + lq(ixcldliq) = .TRUE. + call physics_ptend_init(ptend_loc, state%psetcols, 'pcwsediment', ls=.true., lq=lq)! Initialize local ptend type + + call cld_sediment_tend( ncol, dtime , & + state1%pint, state1%pmid, state1%pdel, state1%t, & + cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), pvliq, pvice, & + ptend_loc%q(:,:,ixcldliq), ptend_loc%q(:,:,ixcldice), ptend_loc%q(:,:,1), & + ptend_loc%s, rain, snow_sed ) + + ! Convert rain and snow fluxes at the surface from [kg/m2/s] to [m/s] + ! Compute total precipitation flux at the surface in [m/s] + + snow_sed(:ncol) = snow_sed(:ncol)/1000._r8 + rain(:ncol) = rain(:ncol)/1000._r8 + prec_sed(:ncol) = rain(:ncol) + snow_sed(:ncol) + + ! Record history variables + call outfld( 'DQSED' ,ptend_loc%q(:,:,1) , pcols,lchnk ) + call outfld( 'DISED' ,ptend_loc%q(:,:,ixcldice), pcols,lchnk ) + call outfld( 'DLSED' ,ptend_loc%q(:,:,ixcldliq), pcols,lchnk ) + call outfld( 'HSED' ,ptend_loc%s , pcols,lchnk ) + call outfld( 'PRECSED' ,prec_sed , pcols,lchnk ) + call outfld( 'SNOWSED' ,snow_sed , pcols,lchnk ) + call outfld( 'RAINSED' ,rain , pcols,lchnk ) + + ! Add tendency from this process to tend from other processes here + call physics_ptend_init(ptend_all, state%psetcols, 'stratiform') + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + + ! Update physics state type state1 with ptend_loc + call physics_update( state1, ptend_loc, dtime ) + + call t_stopf('stratiform_sediment') + + ! Accumulate prec and snow flux at the surface [ m/s ] + prec_str(:ncol) = prec_sed(:ncol) + snow_str(:ncol) = snow_sed(:ncol) + + ! ----------------------------------------------------------------------------- ! + ! Detrainment of convective condensate into the environment or stratiform cloud ! + ! ----------------------------------------------------------------------------- ! + + ! Put all of the detraining cloud water from convection into the large scale cloud. + ! It all goes in liquid for the moment. + ! Strictly speaking, this approach is detraining all the cconvective water into + ! the environment, not the large-scale cloud. + + lq(:) = .FALSE. + lq(ixcldliq) = .TRUE. + call physics_ptend_init( ptend_loc, state1%psetcols, 'pcwdetrain', lq=lq) + + do k = 1, pver + do i = 1, state1%ncol + ptend_loc%q(i,k,ixcldliq) = dlf(i,k) + end do + end do + + call outfld( 'ZMDLF', dlf, pcols, lchnk ) + call outfld( 'SHDLF', dlf2, pcols, lchnk ) + + ! Add hie detrainment tendency to tend from the other prior processes + + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + call physics_update( state1, ptend_loc, dtime ) + + ! Accumulate prec and snow, reserved liquid has now been used. + + prec_str(:ncol) = prec_str(:ncol) - rliq(:ncol) ! ( snow contribution is zero ) + + ! -------------------------------------- ! + ! Computation of Various Cloud Fractions ! + ! -------------------------------------- ! + + ! ----------------------------------------------------------------------------- ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! (1) CAM4 ! + ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! + ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! + ! . Stratus AMT = max( RH stratus AMT, Stability Stratus AMT ) ! + ! . Cumulus and Stratus are 'minimally' overlapped without hierarchy. ! + ! . Cumulus LWC,IWC is assumed to be the same as Stratus LWC,IWC ! + ! (2) CAM5 ! + ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! + ! Shallow Cumulus AMT ( internally fcn of mass flux and w ) ! + ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! + ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! + ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! + ! ----------------------------------------------------------------------------- ! + + if( use_shfrc ) then + call pbuf_get_field(pbuf, shfrc_idx, shfrc ) + else + shfrc=>shfrc_local + shfrc(:,:) = 0._r8 + endif + + ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. + + call t_startf("cldfrc") + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld, rhcloud, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & + state1%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + + ! Re-calculate cloud with perturbed rh add call cldfrc to estimate rhdfda. + + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld2, rhcloud2, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac, snowh, concld2, cldst2, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu002, & + state1%q(:,:,ixcldice), icecldf2, liqcldf2, & + relhum2, 1 ) + + call t_stopf("cldfrc") + + rhu00(:ncol,1) = 2.0_r8 + do k = 1, pver + do i = 1, ncol + if( relhum(i,k) < rhu00(i,k) ) then + rhdfda(i,k) = 0.0_r8 + elseif( relhum(i,k) >= 1.0_r8 ) then + rhdfda(i,k) = 0.0_r8 + else + ! Under certain circumstances, rh+ cause cld not to changed + ! when at an upper limit, or w/ strong subsidence + if( ( cld2(i,k) - cld(i,k) ) < 1.e-4_r8 ) then + rhdfda(i,k) = 0.01_r8*relhum(i,k)*1.e+4_r8 + else + rhdfda(i,k) = 0.01_r8*relhum(i,k)/(cld2(i,k)-cld(i,k)) + endif + endif + enddo + enddo + + ! ---------------------------------------------- ! + ! Stratiform Cloud Macrophysics and Microphysics ! + ! ---------------------------------------------- ! + + call t_startf('stratiform_microphys') + + rdtime = 1._r8/dtime + + ! Define fractional amount of stratus condensate and precipitation in ice phase. + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! The ramp within convective cloud may be different + + call cldfrc_fice(ncol, state1%t, fice, fsnow) + + ! Perform repartitioning of stratiform condensate. + ! Corresponding heating tendency will be added later. + + lq(:) = .FALSE. + lq(ixcldice) = .true. + lq(ixcldliq) = .true. + call physics_ptend_init( ptend_loc, state1%psetcols, 'cldwat-repartition', lq=lq ) + + totcw(:ncol,:pver) = state1%q(:ncol,:pver,ixcldice) + state1%q(:ncol,:pver,ixcldliq) + repartht(:ncol,:pver) = state1%q(:ncol,:pver,ixcldice) + ptend_loc%q(:ncol,:pver,ixcldice) = rdtime * ( totcw(:ncol,:pver)*fice(:ncol,:pver) - state1%q(:ncol,:pver,ixcldice) ) + ptend_loc%q(:ncol,:pver,ixcldliq) = rdtime * ( totcw(:ncol,:pver)*(1.0_r8-fice(:ncol,:pver)) - state1%q(:ncol,:pver,ixcldliq) ) + + call outfld( 'REPARTICE', ptend_loc%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'REPARTLIQ', ptend_loc%q(:,:,ixcldliq), pcols, lchnk ) + + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + call physics_update( state1, ptend_loc, dtime ) + + ! Determine repartition heating from change in cloud ice. + + repartht(:ncol,:pver) = (latice/dtime) * ( state1%q(:ncol,:pver,ixcldice) - repartht(:ncol,:pver) ) + + ! Non-micro and non-macrophysical external advective forcings to compute net condensation rate. + ! Note that advective forcing of condensate is aggregated into liquid phase. + + qtend(:ncol,:pver) = ( state1%q(:ncol,:pver,1) - qcwat(:ncol,:pver) ) * rdtime + ttend(:ncol,:pver) = ( state1%t(:ncol,:pver) - tcwat(:ncol,:pver) ) * rdtime + ltend(:ncol,:pver) = ( totcw (:ncol,:pver) - lcwat(:ncol,:pver) ) * rdtime + + ! Compute Stratiform Macro-Microphysical Tendencies + + ! Add rain and snow fluxes as output variables from pcond, and into physics buffer + call pbuf_get_field(pbuf, ls_flxprc_idx, rkflxprc) + call pbuf_get_field(pbuf, ls_flxsnw_idx, rkflxsnw) + + call t_startf('pcond') + call pcond( lchnk, ncol, troplev, dlat, & + state1%t, ttend, state1%q(1,1,1), qtend, state1%omega, & + totcw, state1%pmid , state1%pdel, cld, fice, fsnow, & + qme, prain, prodsnow, nevapr, evapsnow, evapheat, prfzheat, & + meltheat, prec_pcw, snow_pcw, dtime, fwaut, & + fsaut, fracw, fsacw, fsaci, ltend, & + rhdfda, rhu00, landm, icefrac, state1%zi, ice2pr, liq2pr, & + liq2snow, snowh, rkflxprc, rkflxsnw, pracwo, psacwo, psacio ) + call t_stopf('pcond') + + lq(:) = .FALSE. + lq(1) = .true. + lq(ixcldice) = .true. + lq(ixcldliq) = .true. + call physics_ptend_init( ptend_loc, state1%psetcols, 'cldwat', ls=.true., lq=lq) + + do k = 1, pver + do i = 1, ncol + ptend_loc%s(i,k) = qme(i,k)*( latvap + latice*fice(i,k) ) + & + evapheat(i,k) + prfzheat(i,k) + meltheat(i,k) + repartht(i,k) + ptend_loc%q(i,k,1) = - qme(i,k) + nevapr(i,k) + ptend_loc%q(i,k,ixcldice) = qme(i,k)*fice(i,k) - ice2pr(i,k) + ptend_loc%q(i,k,ixcldliq) = qme(i,k)*(1._r8-fice(i,k)) - liq2pr(i,k) + end do + end do + + do k = 1, pver + do i = 1, ncol + ast(i,k) = cld(i,k) + icimr(i,k) = (state1%q(i,k,ixcldice) + dtime*ptend_loc%q(i,k,ixcldice)) / max(0.01_r8,ast(i,k)) + icwmr(i,k) = (state1%q(i,k,ixcldliq) + dtime*ptend_loc%q(i,k,ixcldliq)) / max(0.01_r8,ast(i,k)) + end do + end do + + ! Convert precipitation from [ kg/m2 ] to [ m/s ] + snow_pcw(:ncol) = snow_pcw(:ncol)/1000._r8 + prec_pcw(:ncol) = prec_pcw(:ncol)/1000._r8 + + do k = 1, pver + do i = 1, ncol + cmeheat(i,k) = qme(i,k) * ( latvap + latice*fice(i,k) ) + cmeice (i,k) = qme(i,k) * fice(i,k) + cmeliq (i,k) = qme(i,k) * ( 1._r8 - fice(i,k) ) + end do + end do + + ! Record history variables + + call outfld( 'FWAUT' , fwaut, pcols, lchnk ) + call outfld( 'FSAUT' , fsaut, pcols, lchnk ) + call outfld( 'FRACW' , fracw, pcols, lchnk ) + call outfld( 'FSACW' , fsacw, pcols, lchnk ) + call outfld( 'FSACI' , fsaci, pcols, lchnk ) + + call outfld( 'PCSNOW' , snow_pcw, pcols, lchnk ) + call outfld( 'FICE' , fice, pcols, lchnk ) + call outfld( 'CMEICE' , cmeice, pcols, lchnk ) + call outfld( 'CMELIQ' , cmeliq, pcols, lchnk ) + call outfld( 'ICE2PR' , ice2pr, pcols, lchnk ) + call outfld( 'LIQ2PR' , liq2pr, pcols, lchnk ) + call outfld( 'HPROGCLD', ptend_loc%s, pcols, lchnk ) + call outfld( 'HEVAP ', evapheat, pcols, lchnk ) + call outfld( 'HMELT' , meltheat, pcols, lchnk ) + call outfld( 'HCME' , cmeheat , pcols, lchnk ) + call outfld( 'HFREEZ' , prfzheat, pcols, lchnk ) + call outfld( 'HREPART' , repartht, pcols, lchnk ) + call outfld('LS_FLXPRC', rkflxprc, pcols, lchnk ) + call outfld('LS_FLXSNW', rkflxsnw, pcols, lchnk ) + call outfld('PRACWO' , pracwo, pcols, lchnk ) + call outfld('PSACWO' , psacwo, pcols, lchnk ) + call outfld('PSACIO' , psacio, pcols, lchnk ) + + ! initialize local variables + mr_ccliq(1:ncol,1:pver) = 0._r8 + mr_ccice(1:ncol,1:pver) = 0._r8 + mr_lsliq(1:ncol,1:pver) = 0._r8 + mr_lsice(1:ncol,1:pver) = 0._r8 + + do k=1,pver + do i=1,ncol + if (cld(i,k) .gt. 0._r8) then + mr_ccliq(i,k) = (state%q(i,k,ixcldliq)/cld(i,k))*concld(i,k) + mr_ccice(i,k) = (state%q(i,k,ixcldice)/cld(i,k))*concld(i,k) + mr_lsliq(i,k) = (state%q(i,k,ixcldliq)/cld(i,k))*(cld(i,k)-concld(i,k)) + mr_lsice(i,k) = (state%q(i,k,ixcldice)/cld(i,k))*(cld(i,k)-concld(i,k)) + else + mr_ccliq(i,k) = 0._r8 + mr_ccice(i,k) = 0._r8 + mr_lsliq(i,k) = 0._r8 + mr_lsice(i,k) = 0._r8 + end if + end do + end do + + call outfld( 'CLDLIQSTR ', mr_lsliq, pcols, lchnk ) + call outfld( 'CLDICESTR ', mr_lsice, pcols, lchnk ) + call outfld( 'CLDLIQCON ', mr_ccliq, pcols, lchnk ) + call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk ) + + ! ------------------------------- ! + ! Update microphysical tendencies ! + ! ------------------------------- ! + + call physics_ptend_sum( ptend_loc, ptend_all, ncol ) + call physics_update( state1, ptend_loc, dtime ) + + if (.not. cam_physpkg_is('cam3')) then + + call t_startf("cldfrc") + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld, rhcloud, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & + state1%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + call t_stopf("cldfrc") + + endif + + call outfld( 'CONCLD ', concld, pcols, lchnk ) + call outfld( 'CLDST ', cldst, pcols, lchnk ) + call outfld( 'CNVCLD ', clc, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) + + do k = 1, pver + do i = 1, ncol + iwc(i,k) = state1%q(i,k,ixcldice)*state1%pmid(i,k)/(287.15_r8*state1%t(i,k)) + lwc(i,k) = state1%q(i,k,ixcldliq)*state1%pmid(i,k)/(287.15_r8*state1%t(i,k)) + icimr(i,k) = state1%q(i,k,ixcldice) / max(0.01_r8,rhcloud(i,k)) + icwmr(i,k) = state1%q(i,k,ixcldliq) / max(0.01_r8,rhcloud(i,k)) + end do + end do + + call outfld( 'IWC' , iwc, pcols, lchnk ) + call outfld( 'LWC' , lwc, pcols, lchnk ) + call outfld( 'ICIMR' , icimr, pcols, lchnk ) + call outfld( 'ICWMR' , icwmr, pcols, lchnk ) + call outfld( 'CME' , qme, pcols, lchnk ) + call outfld( 'PRODPREC' , prain, pcols, lchnk ) + call outfld( 'EVAPPREC' , nevapr, pcols, lchnk ) + call outfld( 'EVAPSNOW' , evapsnow, pcols, lchnk ) + + call t_stopf('stratiform_microphys') + + prec_str(:ncol) = prec_str(:ncol) + prec_pcw(:ncol) + snow_str(:ncol) = snow_str(:ncol) + snow_pcw(:ncol) + + ! Save variables for use in the macrophysics at the next time step + + do k = 1, pver + qcwat(:ncol,k) = state1%q(:ncol,k,1) + tcwat(:ncol,k) = state1%t(:ncol,k) + lcwat(:ncol,k) = state1%q(:ncol,k,ixcldice) + state1%q(:ncol,k,ixcldliq) + end do + + ! Cloud water and ice particle sizes, saved in physics buffer for radiation + + call cldefr( lchnk, ncol, landfrac, state1%t, rel, rei, state1%ps, state1%pmid, landm, icefrac, snowh ) + + call outfld('REL', rel, pcols, lchnk) + call outfld('REI', rei, pcols, lchnk) + + call physics_state_dealloc(state1) + +end subroutine rk_stratiform_tend + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine debug_microphys_1(state1,ptend,i,k, & + dtime,qme,fice,snow_pcw,prec_pcw, & + prain,nevapr,prodsnow, evapsnow, & + ice2pr,liq2pr,liq2snow) + + use physics_types, only: physics_state, physics_ptend + use physconst, only: tmelt + + implicit none + + integer, intent(in) :: i,k + type(physics_state), intent(in) :: state1 ! local copy of the state variable + type(physics_ptend), intent(in) :: ptend ! local copy of the ptend variable + real(r8), intent(in) :: dtime ! timestep + real(r8), intent(in) :: qme(pcols,pver) ! local condensation - evaporation of cloud water + + real(r8), intent(in) :: prain(pcols,pver) ! local production of precipitation + real(r8), intent(in) :: nevapr(pcols,pver) ! local evaporation of precipitation + real(r8), intent(in) :: prodsnow(pcols,pver) ! local production of snow + real(r8), intent(in) :: evapsnow(pcols,pver) ! local evaporation of snow + real(r8), intent(in) :: ice2pr(pcols,pver) ! rate of conversion of ice to precip + real(r8), intent(in) :: liq2pr(pcols,pver) ! rate of conversion of liquid to precip + real(r8), intent(in) :: liq2snow(pcols,pver) ! rate of conversion of liquid to snow + real(r8), intent(in) :: fice (pcols,pver) ! Fractional ice content within cloud + real(r8), intent(in) :: snow_pcw(pcols) + real(r8), intent(in) :: prec_pcw(pcols) + + real(r8) hs1, qv1, ql1, qi1, qs1, qr1, fice2, pr1, w1, w2, w3, fliq, res + real(r8) w4, wl, wv, wi, wlf, wvf, wif, qif, qlf, qvf + + pr1 = 0 + hs1 = 0 + qv1 = 0 + ql1 = 0 + qi1 = 0 + qs1 = 0 + qr1 = 0 + w1 = 0 + wl = 0 + wv = 0 + wi = 0 + wlf = 0 + wvf = 0 + wif = 0 + + + write(iulog,*) + write(iulog,*) ' input state, t, q, l, i ', k, state1%t(i,k), state1%q(i,k,1), state1%q(i,k,ixcldliq), state1%q(i,k,ixcldice) + write(iulog,*) ' rain, snow, total from components before accumulation ', qr1, qs1, qr1+qs1 + write(iulog,*) ' total precip before accumulation ', k, pr1 + + wv = wv + state1%q(i,k,1 )*state1%pdel(i,k)/gravit + wl = wl + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + wi = wi + state1%q(i,k,ixcldice)*state1%pdel(i,k)/gravit + + qvf = state1%q(i,k,1) + ptend%q(i,k,1)*dtime + qlf = state1%q(i,k,ixcldliq) + ptend%q(i,k,ixcldliq)*dtime + qif = state1%q(i,k,ixcldice) + ptend%q(i,k,ixcldice)*dtime + + if (qvf.lt.0._r8) then + write(iulog,*) ' qvf is negative *******', qvf + endif + if (qlf.lt.0._r8) then + write(iulog,*) ' qlf is negative *******', qlf + endif + if (qif.lt.0._r8) then + write(iulog,*) ' qif is negative *******', qif + endif + write(iulog,*) ' qvf, qlf, qif ', qvf, qlf, qif + + wvf = wvf + qvf*state1%pdel(i,k)/gravit + wlf = wlf + qlf*state1%pdel(i,k)/gravit + wif = wif + qif*state1%pdel(i,k)/gravit + + hs1 = hs1 + ptend%s(i,k)*state1%pdel(i,k)/gravit + pr1 = pr1 + state1%pdel(i,k)/gravit*(prain(i,k)-nevapr(i,k)) + qv1 = qv1 - (qme(i,k)-nevapr(i,k))*state1%pdel(i,k)/gravit ! vdot + w1 = w1 + (qme(i,k)-prain(i,k))*state1%pdel(i,k)/gravit ! cdot + qi1 = qi1 + ((qme(i,k))*fice(i,k) -ice2pr(i,k) )*state1%pdel(i,k)/gravit ! idot + ql1 = ql1 + ((qme(i,k))*(1._r8-fice(i,k))-liq2pr(i,k) )*state1%pdel(i,k)/gravit ! ldot + + qr1 = qr1 & + + ( liq2pr(i,k)-liq2snow(i,k) & ! production of rain + -(nevapr(i,k)-evapsnow(i,k)) & ! rain evaporation + )*state1%pdel(i,k)/gravit + qs1 = qs1 & + + ( ice2pr(i,k) + liq2snow(i,k) & ! production of snow.Note last term has phase change + -evapsnow(i,k) & ! snow evaporation + )*state1%pdel(i,k)/gravit + + if (state1%t(i,k).gt.tmelt) then + qr1 = qr1 + qs1 + qs1 = 0._r8 + endif + write(iulog,*) ' rain, snow, total after accumulation ', qr1, qs1, qr1+qs1 + write(iulog,*) ' total precip after accumulation ', k, pr1 + write(iulog,*) + write(iulog,*) ' layer prain, nevapr, pdel ', prain(i,k), nevapr(i,k), state1%pdel(i,k) + write(iulog,*) ' layer prodsnow, ice2pr+liq2snow ', prodsnow(i,k), ice2pr(i,k)+liq2snow(i,k) + write(iulog,*) ' layer prain-prodsnow, liq2pr-liq2snow ', prain(i,k)-prodsnow(i,k), liq2pr(i,k)-liq2snow(i,k) + write(iulog,*) ' layer evapsnow, evaprain ', k, evapsnow(i,k), nevapr(i,k)-evapsnow(i,k) + write(iulog,*) ' layer ice2pr, liq2pr, liq2snow ', ice2pr(i,k), liq2pr(i,k), liq2snow(i,k) + write(iulog,*) ' layer ice2pr+liq2pr, prain ', ice2pr(i,k)+liq2pr(i,k), prain(i,k) + write(iulog,*) + write(iulog,*) ' qv1 vapor removed from col after accum (vdot) ', k, qv1 + write(iulog,*) ' - (precip produced - vapor removed) after accum ', k, -pr1-qv1 + write(iulog,*) ' condensate produce after accum ', k, w1 + write(iulog,*) ' liq+ice tends accum ', k, ql1+qi1 + write(iulog,*) ' change in total water after accum ', k, qv1+ql1+qi1 + write(iulog,*) ' imbalance in colum after accum ', k, qs1+qr1+qv1+ql1+qi1 + write(iulog,*) ' fice at this lev ', fice(i,k) + write(iulog,*) + + res = abs((qs1+qr1+qv1+ql1+qi1)/max(abs(qv1),abs(ql1),abs(qi1),abs(qs1),abs(qr1),1.e-36_r8)) + write(iulog,*) ' relative residual in column method 1 ', k, res + + write(iulog,*) ' relative residual in column method 2 ',& + k, abs((qs1+qr1+qv1+ql1+qi1)/max(abs(qv1+ql1+qi1),1.e-36_r8)) + ! if (abs((qs1+qr1+qv1+ql1+qi1)/(qs1+qr1+1.e-36)).gt.1.e-14) then + if (res.gt.1.e-14_r8) then + call endrun ('STRATIFORM_TEND') + endif + + ! w3 = qme(i,k) * (latvap + latice*fice(i,k)) & + ! + evapheat(i,k) + prfzheat(i,k) + meltheat(i,k) + + res = qs1+qr1-pr1 + w4 = max(abs(qs1),abs(qr1),abs(pr1)) + if (w4.gt.0._r8) then + if (res/w4.gt.1.e-14_r8) then + write(iulog,*) ' imbalance in precips calculated two ways ' + write(iulog,*) ' res/w4, pr1, qr1, qs1, qr1+qs1 ', & + res/w4, pr1, qr1, qs1, qr1+qs1 + ! call endrun() + endif + endif + if (k.eq.pver) then + write(iulog,*) ' pcond returned precip, rain and snow rates ', prec_pcw(i), prec_pcw(i)-snow_pcw(i), snow_pcw(i) + write(iulog,*) ' I calculate ', pr1, qr1, qs1 + ! call endrun + write(iulog,*) ' byrons water check ', wv+wl+wi-pr1*dtime, wvf+wlf+wif + endif + write(iulog,*) + + + end subroutine debug_microphys_1 + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine debug_microphys_2(state1,& + snow_pcw,fsaut,fsacw ,fsaci, meltheat) + + use ppgrid, only: pver + use physconst, only: tmelt + use physics_types, only: physics_state + + implicit none + + type(physics_state), intent(in) :: state1 ! local copy of the state variable + real(r8), intent(in) :: snow_pcw(pcols) + real(r8), intent(in) :: fsaut(pcols,pver) + real(r8), intent(in) :: fsacw(pcols,pver) + real(r8), intent(in) :: fsaci(pcols,pver) + real(r8), intent(in) :: meltheat(pcols,pver) ! heating rate due to phase change of precip + + + integer i,ncol,lchnk + + + ncol = state1%ncol + lchnk = state1%lchnk + + do i = 1,ncol + if (snow_pcw(i) .gt. 0.01_r8/8.64e4_r8 .and. state1%t(i,pver) .gt. tmelt) then + write(iulog,*) ' stratiform: snow, temp, ', i, lchnk, & + snow_pcw(i), state1%t(i,pver) + write(iulog,*) ' t ', state1%t(i,:) + write(iulog,*) ' fsaut ', fsaut(i,:) + write(iulog,*) ' fsacw ', fsacw(i,:) + write(iulog,*) ' fsaci ', fsaci(i,:) + write(iulog,*) ' meltheat ', meltheat(i,:) + call endrun ('STRATIFORM_TEND') + endif + + if (snow_pcw(i)*8.64e4_r8 .lt. -1.e-5_r8) then + write(iulog,*) ' neg snow ', snow_pcw(i)*8.64e4_r8 + write(iulog,*) ' stratiform: snow_pcw, temp, ', i, lchnk, & + snow_pcw(i), state1%t(i,pver) + write(iulog,*) ' t ', state1%t(i,:) + write(iulog,*) ' fsaut ', fsaut(i,:) + write(iulog,*) ' fsacw ', fsacw(i,:) + write(iulog,*) ' fsaci ', fsaci(i,:) + write(iulog,*) ' meltheat ', meltheat(i,:) + call endrun ('STRATIFORM_TEND') + endif + end do + + end subroutine debug_microphys_2 + + end module rk_stratiform diff --git a/src/physics/cam/spcam_drivers.F90 b/src/physics/cam/spcam_drivers.F90 new file mode 100644 index 0000000000..d44c1db730 --- /dev/null +++ b/src/physics/cam/spcam_drivers.F90 @@ -0,0 +1,54 @@ +module spcam_drivers + +! stub module + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physics_types, only: physics_state, physics_tend +use physics_buffer, only: physics_buffer_desc +use camsrfexch, only: cam_out_t, cam_in_t +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: tphysbc_spcam, spcam_register, spcam_init + +!======================================================================================== +contains +!======================================================================================== + +subroutine tphysbc_spcam (ztodt, state, & + tend, pbuf, & + cam_out, cam_in ) + + real(r8), intent(in) :: ztodt + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + !--------------------------------------------------------------------------- + + call endrun('tphysbc_spcam: ERROR: this is a stub') + +end subroutine tphysbc_spcam + +!======================================================================================== + +subroutine spcam_register() + +end subroutine spcam_register + +!======================================================================================== + +subroutine spcam_init(pbuf2d) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +end subroutine spcam_init + +!======================================================================================== + +end module spcam_drivers + diff --git a/src/physics/cam/sslt_rebin.F90 b/src/physics/cam/sslt_rebin.F90 new file mode 100644 index 0000000000..07ed98bce9 --- /dev/null +++ b/src/physics/cam/sslt_rebin.F90 @@ -0,0 +1,142 @@ +!------------------------------------------------------------------- +! rebins the 4 sea salt bins into 2 bins for the radiation +! +! N.B. This code looks for the constituents of SSLTA and SSLTC +! in the physics buffer first, and uses those if found. +! Consequently, it is not possible to have prognostic sea +! salt be radiatively active if the prescribed sea salt is +! also present. The current (cam3_5_52) chemistry configurations +! don't allow both prescribed and prognostic to be present +! simultaneously, but a more flexible chemistry package that +! allows this would break this code. +! +! Created by: Francis Vitt +! Date: 9 May 2008 +!------------------------------------------------------------------- +module sslt_rebin + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + integer :: indices(4) + integer :: sslta_idx, ssltc_idx + + logical :: has_sslt = .false. + character(len=1) :: source + character(len=1), parameter :: DATA = 'D' + character(len=1), parameter :: PROG = 'P' + + private + public :: sslt_rebin_init, sslt_rebin_adv, sslt_rebin_register +contains + + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine sslt_rebin_register + use ppgrid, only : pver,pcols + + use physics_buffer, only : pbuf_add_field, dtype_r8 + + ! add SSLTA and SSLTC to physics buffer + call pbuf_add_field('SSLTA','physpkg',dtype_r8,(/pcols,pver/),sslta_idx) + call pbuf_add_field('SSLTC','physpkg',dtype_r8,(/pcols,pver/),ssltc_idx) + + endsubroutine sslt_rebin_register + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine sslt_rebin_init() + + use constituents, only : cnst_get_ind + + use physics_buffer, only : pbuf_get_index + use ppgrid, only : pver + use cam_history, only : addfld + + implicit none + + integer :: errcode + + + indices(1) = pbuf_get_index('sslt1',errcode) + indices(2) = pbuf_get_index('sslt2',errcode) + indices(3) = pbuf_get_index('sslt3',errcode) + indices(4) = pbuf_get_index('sslt4',errcode) + + has_sslt = all( indices(:) > 0 ) + if ( has_sslt ) source = DATA + + if ( .not. has_sslt ) then + call cnst_get_ind ('SSLT01', indices(1), abort=.false.) + call cnst_get_ind ('SSLT02', indices(2), abort=.false.) + call cnst_get_ind ('SSLT03', indices(3), abort=.false.) + call cnst_get_ind ('SSLT04', indices(4), abort=.false.) + has_sslt = all( indices(:) > 0 ) + if ( has_sslt ) source = PROG + endif + + if ( has_sslt ) then + call addfld('SSLTA', (/ 'lev' /), 'A','kg/kg', 'sea salt' ) + call addfld('SSLTC', (/ 'lev' /), 'A','kg/kg', 'sea salt' ) + endif + + end subroutine sslt_rebin_init + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine sslt_rebin_adv(pbuf, phys_state) + + use physics_types,only : physics_state + + use ppgrid, only : pver, pcols + use cam_history, only : outfld + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + + type(physics_state), target, intent(in) :: phys_state + type(physics_buffer_desc), pointer :: pbuf(:) + +!++ changed wgt_sscm declaration for roundoff validation with earlier code +! real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode + real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode + + real(r8), dimension(:,:), pointer :: sslt1, sslt2, sslt3, sslt4 + real(r8), dimension(:,:), pointer :: sslta, ssltc + integer :: lchnk, ncol + real(r8) :: sslt_sum(pcols,pver) + + lchnk = phys_state%lchnk + ncol = phys_state%ncol + + if (.not. has_sslt) return + + select case( source ) + case (PROG) + sslt1 => phys_state%q(:,:,indices(1)) + sslt2 => phys_state%q(:,:,indices(2)) + sslt3 => phys_state%q(:,:,indices(3)) + sslt4 => phys_state%q(:,:,indices(4)) + case (DATA) + call pbuf_get_field(pbuf, indices(1), sslt1) + call pbuf_get_field(pbuf, indices(2), sslt2) + call pbuf_get_field(pbuf, indices(3), sslt3) + call pbuf_get_field(pbuf, indices(4), sslt4) + end select + + call pbuf_get_field(pbuf, sslta_idx, sslta ) + call pbuf_get_field(pbuf, ssltc_idx, ssltc ) + + sslt_sum(:ncol,:) = sslt1(:ncol,:) + sslt2(:ncol,:) + sslt3(:ncol,:) + sslt4(:ncol,:) + sslta(:ncol,:) = (1._r8-wgt_sscm)*sslt_sum(:ncol,:) ! fraction of seasalt mass in accumulation mode + ssltc(:ncol,:) = wgt_sscm*sslt_sum(:ncol,:) ! fraction of seasalt mass in coagulation mode + + call outfld( 'SSLTA', sslta(:ncol,:), ncol, lchnk ) + call outfld( 'SSLTC', ssltc(:ncol,:), ncol, lchnk ) + + end subroutine sslt_rebin_adv + +end module sslt_rebin diff --git a/src/physics/cam/subcol.F90 b/src/physics/cam/subcol.F90 new file mode 100644 index 0000000000..e34309d4e2 --- /dev/null +++ b/src/physics/cam/subcol.F90 @@ -0,0 +1,500 @@ +module subcol + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Provides the infrastructure for handling the relationship between + ! grid-box-averaged (GBA) fields and Sub-column (subcol) fields + ! + ! Different methods for generating and averaging sub-column fields are + ! called sub-column schemes and are designated with the 'subcol_scheme' + ! namelist variable. + ! + ! This module provides several public interfaces (see below) which operate + ! based on the scheme. In order to implement a new scheme, you need to + ! follow the following steps: + ! I) Implement a sub-column scheme in a separate module (subcol_) + ! I.1) Implement a subcol_register_ function to register any scheme- + ! specific fields. Any pbuf_add_field and/or pbuf_register_subcol calls + ! need to go here. + ! This step is optional + ! I.2) Implement a subcol_init_ function to initialize any scheme- + ! specific variables or fields. + ! This step is optional + ! I.3) Implement a subcol_gen_ function to generate the appropriate + ! subcol fields based on the existing GBA fields and other scheme data. + ! I.4) Implement a subcol_field_avg_ function to average subcol fields + ! back into the appropriate GBA fields. + ! This step is optional + ! I.5) Implement a subcol_ptend_avg_ function to average the + ! sub-column ptend to a grid ptend + ! This step is optional + ! II) Add necessary cases in the master subcol module (this file) + ! II.1) Add a case for your scheme name in subcol_register if you are calling + ! your own subcol_ registration function. + ! II.2) Add a case for your scheme name in subcol_init if you are calling your + ! own subcol_ initialization function. + ! II.3) Add a case for your scheme name in subcol_gen and call your + ! subcol_ subcol generator. + ! II.4) Add a case for your scheme name in subcol_field_avg if you are calling your + ! own subcol_ field-averaging function. + ! II.5) Add a case for your scheme name in subcol_ptend_avg if you are calling your + ! own subcol_ ptend-averaging function. + ! + ! New schemes should be implemented in a separate file which is used by + ! this module (and thus may not 'use' any subcol module variable, function, + ! or subroutine). + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 + use physics_types, only: physics_state, physics_tend, physics_ptend + use ppgrid, only: pcols, psubcols, pver, pverp + use cam_abortutils, only: endrun + use subcol_utils, only: subcol_field_avg_shr, subcol_ptend_avg_shr, & + subcol_field_get_firstsubcol, subcol_ptend_get_firstsubcol, & + is_filter_set, is_weight_set + use subcol_tstcp , only: subcol_gen_tstcp, subcol_register_tstcp, subcol_field_avg_tstcp, subcol_ptend_avg_tstcp + +! CloudObj, SILHS and vamp are currently being developed +! References are being left in for convenience and demonstration purposes +! use subcol_CloudObj, only: cloudobj_scheme_name, subcol_register_CloudObj, & +! subcol_init_CloudObj, subcol_gen_CloudObj +! use subcol_CloudObj, only: subcol_ptend_avg_CloudObj +! use subcol_SILHS, only: subcol_register_SILHS, subcol_init_SILHS, & +! subcol_gen_SILHS +! use subcol_vamp, only: subcol_gen_vamp, subcol_register_vamp, subcol_init_vamp + + implicit none + + private + save + + !! Public interface functions which implement a sub-column scheme + public :: subcol_register ! Read scheme from namelist and initialize any scheme-global variables + public :: subcol_init ! Initialize any variables or fields specific to the active scheme + public :: subcol_gen ! Generate subcol fields from GBA fields + public :: subcol_field_avg ! Average subcol fields back into GBA fields + public :: subcol_ptend_avg ! Average sub-column ptend to grid ptend + public :: subcol_readnl ! Namelist reader for subcolumns + public :: subcol_init_restart ! Initialize restart with subcolumn specific fields + public :: subcol_read_restart ! Read subcolumn specific fields from restart + public :: subcol_write_restart ! Write subcolumn specific fields for restart + + + interface subcol_field_avg + module procedure subcol_field_avg_1dr + module procedure subcol_field_avg_1di + module procedure subcol_field_avg_2dr + end interface + +contains + subroutine subcol_readnl(nlfile) + use subcol_utils, only: subcol_get_scheme, subcol_utils_readnl + use subcol_tstcp, only: subcol_readnl_tstcp +! use subcol_SILHS, only: subcol_readnl_SILHS +! use subcol_vamp, only: subcol_readnl_vamp + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_init ! Name of subcolumn schem + !----------------------------------------------------------------------------- + + call subcol_utils_readnl(nlfile) + subcol_scheme_init = subcol_get_scheme() + + select case(trim(subcol_scheme_init)) + case('tstcp') + call subcol_readnl_tstcp(nlfile) +! case ('SILHS') +! call subcol_readnl_SILHS(nlfile) +! case (cloudobj_scheme_name) +! call subcol_readnl_CloudObj(nlfile) +! case ('vamp') +! call subcol_readnl_vamp(nlfile) + case ('off') + ! No namelist for off + case default + call endrun('subcol_register error: unsupported subcol_scheme specified') + end select + + end subroutine subcol_readnl + + subroutine subcol_register() + use phys_control, only: phys_getopts + use physics_buffer, only: pbuf_add_field, dtype_i4 + use subcol_utils, only: subcol_get_scheme + + select case(subcol_get_scheme()) + case('tstcp') + call subcol_register_tstcp() +! case ('SILHS') +! call subcol_register_SILHS() +! case (cloudobj_scheme_name) +! call subcol_register_CloudObj() +! case ('vamp') +! call subcol_register_vamp() + case ('off') + ! No registration called + case default + call endrun('subcol_register error: unsupported subcol_scheme specified') + end select + + end subroutine subcol_register + + subroutine subcol_init_restart(File, hdimids) + use subcol_utils, only: subcol_utils_init_restart + use pio, only: file_desc_t + + type(file_desc_t),intent(inout) :: File + integer ,intent(in) :: hdimids(:) + + call subcol_utils_init_restart(File, hdimids) + ! Put scheme-specific calls here (in select statement) + + end subroutine subcol_init_restart + + subroutine subcol_write_restart(File) + use subcol_utils, only: subcol_utils_write_restart + use pio, only: file_desc_t + + type(file_desc_t), intent(inout) :: File + + call subcol_utils_write_restart(File) + ! Put scheme-specific calls here (in select statement) + + end subroutine subcol_write_restart + + subroutine subcol_read_restart(File) + use subcol_utils, only: subcol_utils_read_restart + use pio, only: file_desc_t + + type(file_desc_t), intent(inout) :: File + + call subcol_utils_read_restart(File) + ! Put scheme-specific calls here (in select statement) + + end subroutine subcol_read_restart + + subroutine subcol_init(pbuf2d, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use cam_history_support, only: add_hist_coord + use subcol_utils, only: subcol_utils_init, subcol_get_scheme + use time_manager, only: is_first_step, is_first_restart_step + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_init ! Name of subcolumn scheme + + ! Set the subcol_scheme_gen to the one passed in , otherwise use the module scheme read from the namelist + if (present(subcol_scheme_in)) then + subcol_scheme_init = trim(subcol_scheme_in) + else + ! By default, use the module scheme read from the namelist + subcol_scheme_init = subcol_get_scheme() + end if + + if (is_first_step() .and. .not. is_first_restart_step()) then + ! Initialize the subcol utility data only at the beginning of the run and not at restart + call subcol_utils_init(subcol_scheme_init) + end if + + ! Set the psubcols history coordinate for output + if (trim(subcol_scheme_init) /= 'off') then + call add_hist_coord('psubcols', psubcols, 'Subcolumn Index') + end if + + ! Call the appropriate subcol init method + select case(trim(subcol_scheme_init)) + case ('tstcp') + ! none needed for this scheme +! case ('SILHS') +! call subcol_init_SILHS(pbuf2d) +! case (cloudobj_scheme_name) +! call subcol_init_CloudObj(pbuf2d) +! case ('vamp') +! call subcol_init_vamp() + case ('off') + ! No initialization needed for off + case default + call endrun('subcol_init error: unsupported subcol_scheme specified') + end select + end subroutine subcol_init + + subroutine subcol_gen(state, tend, state_sc, tend_sc, pbuf, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_get_scheme + + + !----------------------------------- + ! sub-column generator + !----------------------------------- + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + type(physics_buffer_desc), pointer :: pbuf(:) + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_gen ! Name of subcolumn scheme + + ! Set the subcol_scheme_gen to the one passed in , otherwise use the module scheme read from the namelist + if (present(subcol_scheme_in)) then + subcol_scheme_gen = trim(subcol_scheme_in) + else + subcol_scheme_gen = subcol_get_scheme() + end if + + if (subcol_scheme_gen /= 'off') then + if (.not. allocated(state_sc%lat)) then + call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') + end if + end if + + if (state_sc%psetcols /= (pcols * psubcols)) then + call endrun('subcol_gen error: state_sc%psetcols must be pcols * psubcols') + end if + + select case(trim(subcol_scheme_gen)) + case('tstcp') + call subcol_gen_tstcp(state, tend, state_sc, tend_sc, pbuf) +! case ('SILHS') +! call subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) +! case (cloudobj_scheme_name) +! call subcol_gen_CloudObj(state, tend, state_sc, tend_sc, pbuf) +! case ('vamp') +! call subcol_gen_vamp(state, tend, state_sc, tend_sc, pbuf) + case default + call endrun('subcol_gen error: unsupported subcol_scheme specified') + end select + + end subroutine subcol_gen + + subroutine subcol_field_avg_1dr (field_sc, ngrdcol, lchnk, field, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_get_scheme + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + real(r8), intent(in) :: field_sc(:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: field(:) + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_avg ! Name of subcolumn scheme + + if (present(subcol_scheme_in)) then + subcol_scheme_avg = trim(subcol_scheme_in) + else + ! By default, use the module scheme read from the namelist + subcol_scheme_avg = subcol_get_scheme() + end if + + if (size(field_sc,dim=1) .ne. pcols*psubcols) then + call endrun('subcol_field_avg error: only fields with first dimension pcols*psubcols may use this routine') + end if + + select case(trim(subcol_scheme_avg)) + ! Example of specialized averaging for specific subcolumn scheme + case ('tstcp') + call subcol_field_avg_tstcp(field_sc, ngrdcol, lchnk, field) + ! Unless specialized averaging is needed, most subcolumn schemes will be handled by the default + ! If filters and/or weights have been set, they are automatically used by this averager + case default + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end select + + end subroutine subcol_field_avg_1dr + + subroutine subcol_field_avg_1di (field_sc, ngrdcol, lchnk, field, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_get_scheme + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + integer, intent(in) :: field_sc(:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + integer, intent(out) :: field(:) + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_avg ! Name of subcolumn scheme + + if (present(subcol_scheme_in)) then + subcol_scheme_avg = trim(subcol_scheme_in) + else + ! By default, use the module scheme read from the namelist + subcol_scheme_avg = subcol_get_scheme() + end if + + if (size(field_sc,dim=1) .ne. pcols*psubcols) then + call endrun('subcol_field_avg error: only fields with first dimension pcols*psubcols may use this routine') + end if + + select case(trim(subcol_scheme_avg)) + ! Example of specialized averaging for specific subcolumn scheme + case ('tstcp') + call subcol_field_avg_tstcp(field_sc, ngrdcol, lchnk, field) + ! Unless specialized averaging is needed, most subcolumn schemes will be handled by the default + ! If filters and/or weights have been set, they are automatically used by this averager + case default + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end select + + end subroutine subcol_field_avg_1di + + subroutine subcol_field_avg_2dr (field_sc, ngrdcol, lchnk, field, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_get_scheme + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + real(r8), intent(in) :: field_sc(:,:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: field(:,:) + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_avg ! Name of subcolumn scheme + + if (present(subcol_scheme_in)) then + subcol_scheme_avg = trim(subcol_scheme_in) + else + ! By default, use the module scheme read from the namelist + subcol_scheme_avg = subcol_get_scheme() + end if + + if (size(field_sc,dim=1) .ne. pcols*psubcols) then + call endrun('subcol_field_avg error: only fields with first dimension pcols*psubcols may use this routine') + end if + + select case(trim(subcol_scheme_avg)) + ! Example of specialized averaging for specific subcolumn scheme + case ('tstcp') + call subcol_field_avg_tstcp(field_sc, ngrdcol, lchnk, field) + ! Unless specialized averaging is needed, most subcolumn schemes will be handled with the default + ! If filters and/or weights have been set, they are automatically used by this averager + case default + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end select + + end subroutine subcol_field_avg_2dr + + subroutine subcol_ptend_avg(ptend_sc, ngrdcol, lchnk, ptend, subcol_scheme_in) + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_ptend_init + use subcol_utils, only: subcol_get_scheme + + !----------------------------------------------------------------------- + ! Average a sub-column ptend to a grid ptend + !----------------------------------------------------------------------- + + type(physics_ptend), intent(in) :: ptend_sc ! sub-column ptend + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend ! grid ptend + character(len=*), optional, intent(in) :: subcol_scheme_in ! Name of subcolumn generator + + ! + ! Local variables + ! + character(len=16) :: subcol_scheme_avg ! Name of subcolumn scheme + integer :: indx, i, j + + if (present(subcol_scheme_in)) then + subcol_scheme_avg = trim(subcol_scheme_in) + else + ! By default, use the module scheme read from the namelist + subcol_scheme_avg = subcol_get_scheme() + end if + + !----------------------------------------------------------------------- + + call physics_ptend_init(ptend, pcols, name=ptend_sc%name, ls=ptend_sc%ls, lu=ptend_sc%lu, & + lv=ptend_sc%lv, lq=ptend_sc%lq) + + select case(trim(subcol_scheme_avg)) + case ('tstcp') + call subcol_ptend_avg_tstcp(ptend_sc, ngrdcol, lchnk, ptend) + case default + ! If filters and/or weights have been set, they are automatically used by this averager + call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) + end select + + end subroutine subcol_ptend_avg + +end module subcol + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! +!! subcol_field_avg_handler is an external routine used by outfld +!! It is outside the module to prevent a dependency loop +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! MAKE SURE TO UPDATE THE INTERFACE IN OUTFLD IF THIS INTERFACE IS CHANGED +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine subcol_field_avg_handler(idim, field_in, c, field_out) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, psubcols + use phys_grid, only: get_ncols_p + use subcol, only: subcol_field_avg + + implicit none + + !! Dummy arguments + integer, intent(in) :: idim + real(r8), intent(in) :: field_in(idim, *) + integer, intent(in) :: c + real(r8), intent(inout) :: field_out(:,:) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !! Local variables + real(r8), allocatable :: field_sc(:,:) + integer :: i, j, ngrdcol, dim2 + + dim2 = size(field_out, 2) + allocate(field_sc(pcols*psubcols, dim2)) + + do j = 1, dim2 + do i = 1, idim + field_sc(i, j) = field_in(i, j) + end do + end do + if (idim < (pcols * psubcols)) then + field_sc(idim+1:pcols*psubcols,:) = 0.0_r8 + end if + + ngrdcol = get_ncols_p(c) + call subcol_field_avg(field_sc, ngrdcol, c, field_out) + + deallocate(field_sc) +end subroutine subcol_field_avg_handler diff --git a/src/physics/cam/subcol_pack_mod.F90.in b/src/physics/cam/subcol_pack_mod.F90.in new file mode 100644 index 0000000000..0ad4f917a9 --- /dev/null +++ b/src/physics/cam/subcol_pack_mod.F90.in @@ -0,0 +1,325 @@ +module subcol_pack_mod + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Provides utilities to pack and unpack subcolumns + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 + use infnan, only: nan, assignment(=) + use cam_abortutils, only: endrun + use ppgrid, only: pcols, psubcols + use pio, only: var_desc_t + + implicit none + + private + save + + public :: subcol_unpack ! Unpack a subcolumn field + public :: subcol_pack ! Pack a subcolumn field + public :: subcol_get_nsubcol ! Copy chunk from nsubcol2d + public :: subcol_set_nsubcol ! Copy chunk to nsubcol2d + public :: subcol_get_indcol ! Copy chunk from indcol2d + public :: subcol_pack_allocate ! Allocate subcol packing arrays + public :: subcol_pack_init_restart + public :: subcol_pack_write_restart + public :: subcol_pack_read_restart + + !! Private variable to provide default packing and unpacking of fields + !! for use in restart functionality. Allocated as (pcols, begchunk:endchunk) + integer, target, allocatable :: nsubcol2d(:,:) + integer, target, allocatable :: indcol2d(:,:) + + interface subcol_pack + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6 + module procedure subcol_pack_{DIMS}d_{TYPE} + end interface subcol_pack + + interface subcol_unpack + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6 + module procedure subcol_unpack_{DIMS}d_{TYPE} + end interface subcol_unpack + + type(var_desc_t) :: nsubcol_desc + +contains + + subroutine subcol_pack_allocate() + use ppgrid, only: begchunk, endchunk + !----------------------------------------------------------------------- + ! Allocate nsubcol2d and indcol2d + !----------------------------------------------------------------------- + if (allocated(nsubcol2d)) then + deallocate(nsubcol2d) + end if + allocate(nsubcol2d(pcols, begchunk:endchunk)) + nsubcol2d = 0 + + if (allocated(indcol2d)) then + deallocate(indcol2d) + end if + allocate(indcol2d(pcols*psubcols, begchunk:endchunk)) + indcol2d = 0 + end subroutine subcol_pack_allocate + + subroutine subcol_pack_init_restart(File, hdimids) + + use pio, only: file_desc_t, pio_int + use cam_pio_utils, only: cam_pio_def_var + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File + integer, intent(in) :: hdimids(:) + + call cam_pio_def_var(File, 'NSUBCOL2D', pio_int, hdimids, nsubcol_desc) + end subroutine subcol_pack_init_restart + + subroutine subcol_pack_write_restart(File, grid_id, fdimlens) + use cam_grid_support, only: cam_grid_write_dist_array + use ppgrid, only: begchunk, endchunk + use pio, only: file_desc_t + + ! Dummy argument + type(file_desc_t), intent(inout) :: File + integer, intent(in) :: grid_id + integer, intent(in) :: fdimlens(:) + + ! Local variables + integer :: adimlens(2) + character(len=*), parameter :: subname = 'SUBCOL_PACK_WRITE_RESTART' + + ! Write nsubcol2d + adimlens(1) = size(nsubcol2d, 1) + adimlens(2) = endchunk - begchunk + 1 + call cam_grid_write_dist_array(File, grid_id, adimlens(1:2), & + fdimlens(:), nsubcol2d, nsubcol_desc) + end subroutine subcol_pack_write_restart + + subroutine subcol_pack_read_restart(File, grid_id, fdimlens) + use pio, only: file_desc_t, pio_inq_varid + use cam_pio_utils, only: cam_pio_handle_error + use cam_grid_support, only: cam_grid_read_dist_array + use ppgrid, only: begchunk, endchunk + + ! Dummy argument + type(file_desc_t), intent(inout) :: File + integer, intent(in) :: grid_id + integer, intent(in) :: fdimlens(:) + + integer :: ierr, c + integer :: adimlens(3) + character(len=*), parameter :: subname = 'SUBCOL_PACK_READ_RESTART' + + ! Array dimensions + adimlens(1) = size(nsubcol2d, 1) + adimlens(2) = endchunk - begchunk + 1 + ! Find nsubcol2d and read it in + ierr = pio_inq_varid(File, 'NSUBCOL2D', nsubcol_desc) + call cam_pio_handle_error(ierr, trim(subname)//': NSUBCOL2D not found') + call cam_grid_read_dist_array(File, grid_id, adimlens(1:2), & + fdimlens(:), nsubcol2d, nsubcol_desc) + + ! We need to update indcol2d so set nsubcol2d to itself + do c = begchunk, endchunk + call subcol_set_nsubcol(c, pcols, nsubcol2d(:, c)) + end do + + end subroutine subcol_pack_read_restart + + + subroutine subcol_get_nsubcol(lchnk, nsubcol) + !----------------------------------------------------------------------- + ! Retrieve a chunk from the nsubcol module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + integer, intent(out) :: nsubcol(:) + + if (.not. allocated(nsubcol2d)) then + call endrun('subcol_get_nsubcol: nsubcol2d not allocated') + end if + nsubcol(:) = nsubcol2d(:,lchnk) + end subroutine subcol_get_nsubcol + + subroutine subcol_get_indcol(lchnk, indcol) + !----------------------------------------------------------------------- + ! Retrieve a chunk from the nsubcol module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + integer, intent(out) :: indcol(:) + + if (.not. allocated(indcol2d)) then + call endrun('subcol_get_indcol: indcol2d not allocated') + end if + indcol(:) = indcol2d(:,lchnk) + end subroutine subcol_get_indcol + + subroutine subcol_set_nsubcol(lchnk, ngrdcol, nsubcol) + !----------------------------------------------------------------------- + ! Set a chunk of the nsubcol module variable + ! Also, recompute indcol for lchnk + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + integer, intent(in) :: ngrdcol + integer, intent(in) :: nsubcol(:) + + integer :: i, j, indx + + if (any(nsubcol(:) > psubcols)) then + call endrun('subcol_set_nsubcol: psubcols not set large enough to hold the number of subcolumns requested') + end if + if (any(nsubcol(:) < 0)) then + call endrun('subcol_set_nsubcol: nsubcols must be non-negative') + end if + if (ngrdcol < pcols) then + if (any(nsubcol(ngrdcol+1:) > 0)) then + call endrun('subcol_set_nsubcol: Cannot set subcolumns for columns past ngrdcol') + end if + end if + nsubcol2d(:, lchnk) = nsubcol(:) + ! Recalculate indcol for the chunk + indx = 1 + do i = 1, pcols + do j = 1, nsubcol2d(i, lchnk) + indcol2d(indx, lchnk) = i + indx = indx + 1 + end do + end do + ! Fill with zeros + if (indx <= pcols * psubcols) then + indcol2d(indx:pcols*psubcols, lchnk) = 0 + end if + end subroutine subcol_set_nsubcol + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6 + subroutine subcol_pack_{DIMS}d_{TYPE}(lchnk, field, field_sc) + !----------------------------------------------------------------------- + ! Pack the field defined on (pcols, psubcols, *) into (pcols*psubcols, *) + ! Packing is done accoding to the values in the proper chunk from nsubcol2d + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk ! Chunk index +#if ({DIMS} == 1) + {VTYPE}, intent(in) :: field(:,:) ! grid +#elif ({DIMS} == 2) + {VTYPE}, intent(in) :: field(:,:,:) ! grid +#elif ({DIMS} == 3) + {VTYPE}, intent(in) :: field(:,:,:,:) ! grid +#elif ({DIMS} == 4) + {VTYPE}, intent(in) :: field(:,:,:,:,:) ! grid +#elif ({DIMS} == 5) + {VTYPE}, intent(in) :: field(:,:,:,:,:,:) ! grid +#elif ({DIMS} == 6) + {VTYPE}, intent(in) :: field(:,:,:,:,:,:,:) ! grid +#endif + {VTYPE}, intent(out) :: field_sc{DIMSTR} ! subcols + + ! + ! Local variables + ! + integer :: indx, i, j + integer :: nsubcol(pcols) + + call subcol_get_nsubcol(lchnk, nsubcol) + indx = 1 + do i=1, pcols + do j = 1, nsubcol(i) +#if ({DIMS} == 1) + field_sc(indx) = field(i, j) +#elif ({DIMS} == 2) + field_sc(indx, :) = field(i, j, :) +#elif ({DIMS} == 3) + field_sc(indx, :, :) = field(i, j, :, :) +#elif ({DIMS} == 4) + field_sc(indx, :, :, :) = field(i, j, :, :, :) +#elif ({DIMS} == 5) + field_sc(indx, :, :, :, :) = field(i, j, :, :, :, :) +#elif ({DIMS} == 6) + field_sc(indx, :, :, :, :, :) = field(i, j, :, :, :, :, :) +#endif + indx = indx + 1 + end do + end do + end subroutine subcol_pack_{DIMS}d_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6 + subroutine subcol_unpack_{DIMS}d_{TYPE}(lchnk, field_sc, field, fillvalue) + !----------------------------------------------------------------------- + ! UnPack the field defined on (pcols*psubcols, *) into (pcols, psubcols, *) + ! Unpacking is done accoding to the values in the proper chunk from nsubcol2d + ! If fillvalue is present, unused entries in field are set. + ! NB: The output field is not initialized, if fillvalue is not passed, it + ! will end up with undefined values for columns where nsubcol < psubcols + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk ! Chunk index + {VTYPE}, intent(in) :: field_sc{DIMSTR} ! subcols +#if ({DIMS} == 1) + {VTYPE}, intent(out) :: field(:,:) ! grid +#elif ({DIMS} == 2) + {VTYPE}, intent(out) :: field(:,:,:) ! grid +#elif ({DIMS} == 3) + {VTYPE}, intent(out) :: field(:,:,:,:) ! grid +#elif ({DIMS} == 4) + {VTYPE}, intent(out) :: field(:,:,:,:,:) ! grid +#elif ({DIMS} == 5) + {VTYPE}, intent(out) :: field(:,:,:,:,:,:) ! grid +#elif ({DIMS} == 6) + {VTYPE}, intent(out) :: field(:,:,:,:,:,:,:) ! grid +#endif + {VTYPE}, intent(in), optional :: fillvalue ! fil + + ! + ! Local variables + ! + integer :: indx, i, j + integer :: nsubcol(pcols) + + call subcol_get_nsubcol(lchnk, nsubcol) + indx = 1 + do i=1, pcols + do j = 1, nsubcol(i) +#if ({DIMS} == 1) + field(i, j) = field_sc(indx) +#elif ({DIMS} == 2) + field(i, j, :) = field_sc(indx, :) +#elif ({DIMS} == 3) + field(i, j, :, :) = field_sc(indx, :, :) +#elif ({DIMS} == 4) + field(i, j, :, :, :) = field_sc(indx, :, :, :) +#elif ({DIMS} == 5) + field(i, j, :, :, :, :) = field_sc(indx, :, :, :, :) +#elif ({DIMS} == 6) + field(i, j, :, :, :, :, :) = field_sc(indx, :, :, :, :, :) +#endif + indx = indx + 1 + end do + if (present(fillvalue)) then + do j = nsubcol(i) + 1, psubcols +#if ({DIMS} == 1) + field(i, j) = fillvalue +#elif ({DIMS} == 2) + field(i, j, :) = fillvalue +#elif ({DIMS} == 3) + field(i, j, :, :) = fillvalue +#elif ({DIMS} == 4) + field(i, j, :, :, :) = fillvalue +#elif ({DIMS} == 5) + field(i, j, :, :, :, :) = fillvalue +#elif ({DIMS} == 6) + field(i, j, :, :, :, :, :) = fillvalue +#endif + end do + end if + end do + end subroutine subcol_unpack_{DIMS}d_{TYPE} + +end module subcol_pack_mod diff --git a/src/physics/cam/subcol_tstcp.F90 b/src/physics/cam/subcol_tstcp.F90 new file mode 100644 index 0000000000..0ef2a6bb49 --- /dev/null +++ b/src/physics/cam/subcol_tstcp.F90 @@ -0,0 +1,393 @@ +module subcol_tstcp + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Implement the various TestCopy schemes + ! sub-column schemes + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use physics_types, only: physics_state, physics_tend, physics_ptend + use ppgrid, only: pcols, psubcols, pver, pverp + use constituents, only: pcnst + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + implicit none + + private + save + + public :: subcol_gen_tstcp + public :: subcol_register_tstcp + public :: subcol_readnl_tstcp + public :: subcol_field_avg_tstcp + public :: subcol_ptend_avg_tstcp + + interface subcol_field_avg_tstcp + module procedure subcol_field_avg_tstcp_1dr + module procedure subcol_field_avg_tstcp_1di + module procedure subcol_field_avg_tstcp_2dr + end interface + + logical :: subcol_tstcp_noAvg ! if set, bypasses averaging and assigns back the first subcolumn to grid + + logical :: subcol_tstcp_filter ! if set, sets up a filter which yields BFB results + ! (doesn't really excercise the filter arithmetic) + + logical :: subcol_tstcp_weight ! if set, sets up a weight which yields BFB results + ! (doesn't really excercise the weight arithmetic) + + logical :: subcol_tstcp_perturb ! if set, turns on the perturbation test which changes the state temperatures + ! to make sure subcolumns differ + + logical :: subcol_tstcp_restart ! if set, sets up weights so that they are more adequately tested in restart, + ! but will not be BFB with non-subcolumnized run + + integer :: tstcpy_scol_idx ! pbuf index for subcolumn-only test field + +contains + + subroutine subcol_register_tstcp() + use physics_buffer, only: pbuf_add_field, dtype_i4, col_type_subcol + use phys_control, only: phys_getopts + + ! A subcolumn-only test field + ! pbuf is global so it will show up in restart file + call pbuf_add_field('TSTCPY_SCOL','global', dtype_i4, & + (/pcols,pver/), tstcpy_scol_idx, col_type_subcol) + + end subroutine subcol_register_tstcp + + subroutine subcol_readnl_tstcp(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, mpi_logical, masterprocid, mpicom + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + namelist /subcol_tstcp_nl/ subcol_tstcp_noAvg, subcol_tstcp_filter, subcol_tstcp_weight, subcol_tstcp_perturb, & + subcol_tstcp_restart + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'subcol_tstcp_nl', status=ierr) + if (ierr == 0) then + read(unitn, subcol_tstcp_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('subcol_readnl_tstcp: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpi_bcast(subcol_tstcp_noAvg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_tstcp_filter, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_tstcp_weight, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_tstcp_perturb, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_tstcp_restart, 1, mpi_logical, masterprocid, mpicom, ierr) +#endif + end subroutine subcol_readnl_tstcp + + subroutine subcol_gen_tstcp(state, tend, state_sc, tend_sc, pbuf) + + use subcol_utils, only: subcol_set_subcols, subcol_set_weight, subcol_set_filter + use subcol_pack_mod, only: subcol_get_nsubcol + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, col_type_subcol + use phys_grid, only: get_gcol_p + use time_manager, only: is_first_step, is_first_restart_step + + + !----------------------------------- + ! sub-column generator + !----------------------------------- + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + type(physics_buffer_desc), pointer :: pbuf(:) + + + ! + ! Local variables + ! + integer :: i, j, k, ngrdcol, indx, indx1, indx2 + integer :: nsubcol(pcols) + real(r8) :: weight(state_sc%psetcols) + integer :: filter(state_sc%psetcols) + integer, pointer :: test_field(:,:) + character(len=128) :: errmsg + + ngrdcol = state%ngrdcol + + !---------------------- + ! Set the number of subcolumns on the 0th time step -- current implementation does not allow + ! number of subcolumns to vary within a run. Cannot be done in init as ngrdcol is not known + ! at init + !---------------------- + ! Test differing number of subcolumns by setting columns > 45 degrees to + ! have 1 subcolumn, columns < -45 to 2 subcolumns and others to 3 subcols + if (is_first_step()) then + nsubcol = 0 + do i = 1, ngrdcol + if (state%lat(i) > 0.7854_r8) then + nsubcol(i) = 1 + else if (state%lat(i) < -0.7854_r8) then + nsubcol(i) = 2 + else + nsubcol(i) = psubcols + end if + end do + + ! Set up the weights once and do not modify - this will test the restart ability to correctly retrieve them + if(subcol_tstcp_restart) then + weight=0._r8 + indx=1 + do i=1,ngrdcol + weight(indx:indx+nsubcol(i)-1)=1._r8/nsubcol(i) + if (state%lon(i) < -0.5236_r8) then + if (nsubcol(i) >= 3) then + weight(indx) = 2*1._r8/nsubcol(i) + weight(indx+1) = 1._r8 - weight(indx) + weight(indx+2:indx+nsubcol(i)-1)=0._r8 + end if + end if + indx = indx+nsubcol(i) + end do + call subcol_set_weight(state%lchnk, weight) + end if + else + call subcol_get_nsubcol(state%lchnk, nsubcol) + ! Since this is a test generator, check for nsubcol correctness. +10 format(a,i3,a,i5) + do i = 1, pcols + if (i > ngrdcol) then + if (nsubcol(i) /= 0) then + write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + i,') = ',nsubcol(i),', /= 0' + call endrun(errmsg) + end if + else if (state%lat(i) > 0.7854_r8) then + if (nsubcol(i) /= 1) then + write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + i,') = ',nsubcol(i),', /= 1' + call endrun(errmsg) + end if + else if (state%lat(i) < -0.7854_r8) then + if (nsubcol(i) /= 2) then + write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + i,') = ',nsubcol(i),', /= 2' + call endrun(errmsg) + end if + else + if (nsubcol(i) /= psubcols) then + write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + i,') = ',nsubcol(i),', /=',psubcols + call endrun(errmsg) + end if + end if + end do + end if + + call subcol_set_subcols(state, tend, nsubcol, state_sc, tend_sc) + + ! For perturb case, adjust Temperature up and down one degree + if (subcol_tstcp_perturb) then + indx=1 + do i=1,ngrdcol + if (nsubcol(i) >= 2) then + state_sc%t(indx,:) = state_sc%t(indx,:)+1 + state_sc%t(indx+1,:) = state_sc%t(indx+1,:)-1 + end if + indx=indx+nsubcol(i) + end do + end if + + ! Set weight to 1 for first column, 0 for all others -- will be BFB with noUniAv case + if(subcol_tstcp_filter .and. subcol_tstcp_weight) then + weight=1._r8 + ! Initialize to 1 - will match doAv_noUni, init to 0 - will match noUniAv + filter=1 + indx=1 + do i=1,ngrdcol + weight(indx) = 1.0_r8 + filter(indx) = 1 + indx = indx+nsubcol(i) + end do + call subcol_set_weight(state%lchnk, weight) + call subcol_set_filter(state%lchnk, filter) + ! Set weight to 1 for first column, 0 for all others -- will be BFB with noUniAv case + else if(subcol_tstcp_weight) then + weight=0._r8 + indx=1 + do i=1,ngrdcol + weight(indx) = 1.0_r8 + indx = indx+nsubcol(i) + end do + call subcol_set_weight(state%lchnk, weight) + + ! Set filter to 1 for first column, 0 for all others -- will be BFB with noUniAv case + else if(subcol_tstcp_filter) then + filter=0 + indx=1 + do i=1,ngrdcol + filter(indx) = 1 + indx = indx+nsubcol(i) + end do + call subcol_set_filter(state%lchnk, filter) + end if + + + if (is_first_restart_step()) then + ! Test values for the test pbuf + call pbuf_get_field(pbuf, tstcpy_scol_idx, test_field, & + col_type=col_type_subcol, copy_if_needed=.false.) + indx = 1 + do i=1,ngrdcol + do indx1 = 1, nsubcol(i) + do k = 1, pver + indx2 = (get_gcol_p(state%lchnk, i) * 10000) + indx2 = k + (100 * (indx1 + indx2)) + if(test_field(indx, k) /= indx2) then + write(iulog, *) 'TSTCPY_SCOL check(',indx,',',k, & + '): expected',indx2,', found',test_field(indx, k) + call endrun("Restart check for TSTCPY_SCOL failed") + end if + end do + indx = indx + 1 + end do + end do + ! Unused subcolumn space is not initialized so no check + else if (is_first_step()) then + ! Set values for the test pbuf + call pbuf_get_field(pbuf, tstcpy_scol_idx, test_field, & + col_type=col_type_subcol, copy_if_needed=.false.) + test_field = -1 + indx = 1 + do i=1,ngrdcol + do indx1 = 1, nsubcol(i) + do k = 1, pver + indx2 = (get_gcol_p(state%lchnk, i) * 10000) + indx2 = k + (100 * (indx1 + indx2)) + test_field(indx, k) = indx2 + end do + indx = indx + 1 + end do + end do + end if + +end subroutine subcol_gen_tstcp + +subroutine subcol_field_avg_tstcp_1dr (field_sc, ngrdcol, lchnk, field) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_field_get_firstsubcol, subcol_field_avg_shr, is_filter_set, is_weight_set + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + real(r8), intent(in) :: field_sc(:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: field(:) + + ! + ! Local variables + ! + real(r8),pointer :: weight(:) + integer, pointer :: filter(:) + + + ! Unless specialized averaging is needed, most subcolumn schemes will be handled here + if (subcol_tstcp_noAvg) then + call subcol_field_get_firstsubcol(field_sc, .true., ngrdcol, lchnk, field) + else + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end if + +end subroutine subcol_field_avg_tstcp_1dr + +subroutine subcol_field_avg_tstcp_1di (field_sc, ngrdcol, lchnk, field) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_field_get_firstsubcol, subcol_field_avg_shr, is_filter_set, is_weight_set + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + integer, intent(in) :: field_sc(:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + integer, intent(out) :: field(:) + + ! + ! Local variables + ! + real(r8),pointer :: weight(:) + integer, pointer :: filter(:) + + + ! Unless specialized averaging is needed, most subcolumn schemes will be handled here + if (subcol_tstcp_noAvg) then + call subcol_field_get_firstsubcol(field_sc, .true., ngrdcol, lchnk, field) + else + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end if + +end subroutine subcol_field_avg_tstcp_1di + +subroutine subcol_field_avg_tstcp_2dr (field_sc, ngrdcol, lchnk, field) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_field_get_firstsubcol, subcol_field_avg_shr, is_filter_set, is_weight_set + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + real(r8), intent(in) :: field_sc(:,:) ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: field(:,:) + + ! Unless specialized averaging is needed, most subcolumn schemes will be handled here + if (subcol_tstcp_noAvg) then + call subcol_field_get_firstsubcol(field_sc, .true., ngrdcol, lchnk, field) + else + call subcol_field_avg_shr(field_sc, ngrdcol, lchnk, field, is_filter_set(), is_weight_set()) + end if + +end subroutine subcol_field_avg_tstcp_2dr + +subroutine subcol_ptend_avg_tstcp (ptend_sc, ngrdcol, lchnk, ptend) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_ptend_get_firstsubcol, subcol_ptend_avg_shr, subcol_get_weight, subcol_get_filter, & + is_filter_set, is_weight_set + + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- + + type(physics_ptend), intent(in) :: ptend_sc ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend + + if (subcol_tstcp_noAvg) then + call subcol_ptend_get_firstsubcol(ptend_sc, .true., ngrdcol, lchnk, ptend) + else + call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) + end if + +end subroutine subcol_ptend_avg_tstcp +end module subcol_tstcp diff --git a/src/physics/cam/subcol_utils.F90.in b/src/physics/cam/subcol_utils.F90.in new file mode 100644 index 0000000000..ee1dbb8379 --- /dev/null +++ b/src/physics/cam/subcol_utils.F90.in @@ -0,0 +1,1097 @@ + module subcol_utils + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Provides utilities to support subcolumns + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 + use infnan, only: nan, assignment(=) + use physics_types, only: physics_state, physics_ptend, physics_tend, physics_tend_alloc, physics_state_alloc + use ppgrid, only: pcols, psubcols, pver + use constituents, only: pcnst + use cam_abortutils, only: endrun + use pio, only: var_desc_t + use subcol_pack_mod, only: subcol_get_nsubcol, subcol_set_nsubcol, subcol_get_indcol + + implicit none + + private + save + + integer, target, allocatable :: filter2d(:,:) + real(r8),target, allocatable :: weight2d(:,:) + logical :: weight_set, filter_set + + !! The active subcolumn scheme + character(len=16) :: subcol_scheme = 'off' + + !! Public interface functions which do not depend on the subcolumn scheme + + public :: subcol_utils_init ! Initialize module data (e.g., nsubcol2d) + public :: subcol_get_filter ! return the filter values + public :: subcol_set_filter ! set the filter values + public :: subcol_get_weight ! return the weight values + public :: subcol_set_weight ! set the weight values + + public :: subcol_field_copy ! copy a physics buffer field into one with subcolumn dimensions + public :: subcol_ptend_copy ! copy a physics_ptend object into one with subcolumn dimensions + public :: subcol_set_subcols ! set nsubcols and copy state & tend objects into one with subcolumn dimensions + + public :: subcol_field_avg_shr ! Average subcol fields back into GBA fields + public :: subcol_ptend_avg_shr ! average subcolumn ptend to grid ptend + + public :: subcol_field_get_firstsubcol ! Retrieve the first subcolumn and assign to grid + public :: subcol_ptend_get_firstsubcol ! retrieve the first subcolumn from the ptend fields and assign to grid ptend + + public :: subcol_utils_init_restart ! Initialize restart with subcolumn specific fields + public :: subcol_utils_read_restart ! Read subcolumn specific fields from restart + public :: subcol_utils_write_restart ! Write subcolumn specific fields for restart + public :: is_filter_set ! True if filters for averaging have been set + public :: is_weight_set ! True if weights for averaging have been set + public :: is_subcol_on ! true is any subcol_scheme other than "off" is set + public :: subcol_get_scheme ! Return the active subcolumn scheme name + public :: subcol_utils_readnl ! Set the active scheme based on namelist + + interface subcol_field_avg_shr + ! TYPE int,double,real + ! DIMS 1,2 + module procedure subcol_field_avg_shr_{DIMS}d{TYPE} + end interface + + interface subcol_avg_inter + ! TYPE int,double,real + module procedure subcol_avg_inter_{TYPE} + end interface + + interface subcol_avg + ! TYPE int,double,real + module procedure subcol_avg_{TYPE} + end interface + + interface subcol_field_get_firstsubcol + ! TYPE int,double,real + ! DIMS 1,2 + module procedure subcol_field_get_firstsubcol_{DIMS}d{TYPE} + end interface + + interface subcol_state_field_copy + ! TYPE double + ! DIMS 1,2,3 + module procedure subcol_state_field_copy_{DIMS}d{TYPE} + end interface + + interface subcol_field_copy + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + module procedure subcol_field_copy_{DIMS}d{TYPE} + end interface + + type(var_desc_t) :: weight2d_desc, filter2d_desc + integer :: subcol_dimid = -1 ! subcol dimension for restart + + integer :: ret_nan_int + real(r8):: ret_nan_double + real(r4):: ret_nan_real + + integer :: fillval_int + real(r8):: fillval_double + real(r4):: fillval_real + +contains + + subroutine subcol_allocate_internal() + use ppgrid, only: begchunk, endchunk + use subcol_pack_mod, only: subcol_pack_allocate + + call subcol_pack_allocate() + + if (allocated(filter2d)) then + deallocate(filter2d) + end if + allocate(filter2d(pcols*psubcols, begchunk:endchunk)) + filter2d = 0 + + if (allocated(weight2d)) then + deallocate(weight2d) + end if + allocate(weight2d(pcols*psubcols, begchunk:endchunk)) + weight2d = 0._r8 + + end subroutine subcol_allocate_internal + + subroutine subcol_utils_init(subcol_scheme_init) + + character(len=*), optional, intent(in) :: subcol_scheme_init ! Name of subcolumn generator + + call subcol_allocate_internal() + + ret_nan_int = 0 + ret_nan_double = nan + ret_nan_real = nan + + fillval_int = 0 + fillval_double = 0._r8 + fillval_real = 0._r4 + + weight_set = .false. + filter_set = .false. + + end subroutine subcol_utils_init + + subroutine subcol_get_filter(lchnk, filter) + !----------------------------------------------------------------------- + ! Retrieve the filter module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + integer, intent(out) :: filter(:) + + filter(:) = filter2d(:,lchnk) + end subroutine subcol_get_filter + + subroutine subcol_get_weight(lchnk, weight) + !----------------------------------------------------------------------- + ! Retrieve the weight module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + real(r8), intent(out) :: weight(:) + + weight(:) = weight2d(:,lchnk) + end subroutine subcol_get_weight + + integer function subcol_get_ncol(lchnk) result(ncol) + !----------------------------------------------------------------------- + ! Compute the number of (sub)columns for a chunk + ! NB: This is considered an internal function so it can use nsubcol2d + !----------------------------------------------------------------------- + integer, intent(in) :: lchnk + + integer :: nsubcol(pcols) + + call subcol_get_nsubcol(lchnk, nsubcol) + ncol = SUM(nsubcol) + + end function subcol_get_ncol + + subroutine subcol_set_filter(lchnk, filter) + !----------------------------------------------------------------------- + ! Set the filter module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + integer, intent(in) :: filter(:) + + filter2d(:,lchnk) = filter(:) + filter_set = .true. + end subroutine subcol_set_filter + + subroutine subcol_set_weight(lchnk, weight) + !----------------------------------------------------------------------- + ! Set the weight module variable + !----------------------------------------------------------------------- + + integer, intent(in) :: lchnk + real(r8), intent(in) :: weight(:) + + weight2d(:,lchnk) = weight(:) + weight_set = .true. + end subroutine subcol_set_weight + + logical function is_weight_set() + is_weight_set=weight_set + end function is_weight_set + + logical function is_filter_set() + is_filter_set=filter_set + end function is_filter_set + + logical function is_subcol_on() + is_subcol_on = (trim(subcol_scheme) /= 'off') + end function is_subcol_on + + character(len=16) function subcol_get_scheme() + subcol_get_scheme = trim(subcol_scheme) + end function subcol_get_scheme + + subroutine subcol_utils_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, mpi_character, masterprocid, mpicom + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + namelist /subcol_nl/ subcol_scheme + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'subcol_nl', status=ierr) + if (ierr == 0) then + read(unitn, subcol_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('subcol_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpi_bcast(subcol_scheme, len(subcol_scheme), mpi_character, masterprocid, mpicom, ierr) +#endif + + end subroutine subcol_utils_readnl + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5 + subroutine subcol_field_copy_{DIMS}d{TYPE} (field, lchnk, field_sc) + !----------------------------------------------------------------------- + ! Copy a pbuf field dimensioned pcols to one with pcols*psubcols and fill appropriately + !----------------------------------------------------------------------- + + {VTYPE}, intent(in) :: field{DIMSTR} + integer, intent(in) :: lchnk + {VTYPE}, intent(out) :: field_sc{DIMSTR} ! intent out + + ! Local Variables + integer :: ncol + integer :: indcol(pcols*psubcols) + + if (size(field,dim=1) .ne. pcols) then + call endrun('subcol_field_copy error: only fields with first dimension pcols may use this routine') + end if + + field_sc = fillval_{TYPE} + ncol = subcol_get_ncol(lchnk) + call subcol_get_indcol(lchnk, indcol) + +#if ({DIMS} == 1) + field_sc(:ncol) = field(indcol(:ncol)) +#endif + +#if ({DIMS} == 2) + field_sc(:ncol,:) = field(indcol(:ncol),:) +#endif + +#if ({DIMS} == 3) + field_sc(:ncol,:,:) = field(indcol(:ncol),:,:) +#endif + +#if ({DIMS} == 4) + field_sc(:ncol,:,:,:) = field(indcol(:ncol),:,:,:) +#endif + +#if ({DIMS} == 5) + field_sc(:ncol,:,:,:,:) = field(indcol(:ncol),:,:,:,:) +#endif + + end subroutine subcol_field_copy_{DIMS}d{TYPE} + + ! TYPE double + ! DIMS 1,2,3 + subroutine subcol_state_field_copy_{DIMS}d{TYPE} (field, state, field_sc) + !----------------------------------------------------------------------- + ! Copy a state field dimensioned with pcols to one with pcols*psubcols and fill appropriately + !----------------------------------------------------------------------- + + {VTYPE}, intent(in) :: field{DIMSTR} + type(physics_state), intent(in) :: state + {VTYPE}, allocatable :: field_sc{DIMSTR} ! intent out + + integer :: dim2, dim3 + integer :: indcol(pcols*psubcols) + + if (size(field,dim=1) .ne. pcols) then + call endrun('subcol_state_field_copy error: only fields with first dimension pcols may use this routine') + end if + + call subcol_get_indcol(state%lchnk, indcol) + +#if ({DIMS} == 1) + if (.not. allocated(field_sc)) then + allocate(field_sc(pcols*psubcols)) + end if + + field_sc = 0._r8 + field_sc(:state%ncol) = field(indcol(:state%ncol)) +#endif + +#if ({DIMS} == 2) + if (.not. allocated(field_sc)) then + dim2 = size(field,dim=2) + allocate(field_sc(pcols*psubcols,dim2)) + end if + + field_sc = 0._r8 + field_sc(:state%ncol,:) = field(indcol(:state%ncol),:) +#endif + +#if ({DIMS} == 3) + if (.not. allocated(field_sc)) then + dim2 = size(field,dim=2) + dim3 = size(field,dim=3) + allocate(field_sc(pcols*psubcols,dim2,dim3)) + end if + + field_sc = 0._r8 + field_sc(:state%ncol,:,:) = field(indcol(:state%ncol),:,:) +#endif + + end subroutine subcol_state_field_copy_{DIMS}d{TYPE} + + subroutine subcol_tend_copy(tend, state_sc, tend_sc) + !----------------------------------------------------------------------- + ! Copy all of tend to subcolumns in tend_sc, allocating tend_sc if necessary + !----------------------------------------------------------------------- + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(in) :: state_sc ! subcolumn state + type(physics_tend), intent(inout) :: tend_sc ! subcolumn tend + + + if (.not. allocated(tend%dtdt)) then + call physics_tend_alloc(tend_sc, state_sc%psetcols) + end if + + tend_sc%psetcols = pcols*psubcols + call subcol_state_field_copy(tend%dtdt, state_sc, tend_sc%dtdt) + call subcol_state_field_copy(tend%dudt, state_sc, tend_sc%dudt) + call subcol_state_field_copy(tend%dvdt, state_sc, tend_sc%dvdt) + call subcol_state_field_copy(tend%flx_net, state_sc, tend_sc%flx_net) + call subcol_state_field_copy(tend%te_tnd, state_sc, tend_sc%te_tnd) + call subcol_state_field_copy(tend%tw_tnd, state_sc, tend_sc%tw_tnd) + + end subroutine subcol_tend_copy + + subroutine subcol_state_copy(state, state_sc) + !----------------------------------------------------------------------- + ! Copy all of state to subcolumns in state_sc, allocating state_sc if necessary + !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state + type(physics_state), intent(inout) :: state_sc ! subcolumn state + + ! + ! Local variables + ! + integer :: ngrdcol + + if (.not. allocated(state_sc%lat)) then + call endrun('subcol_state_copy: user must allocate state_sc prior to calling this routine') + end if + + ngrdcol = state%ngrdcol + + call subcol_state_hdrinit(state, state_sc) + + call subcol_state_field_copy(state%lat, state_sc, state_sc%lat) + call subcol_state_field_copy(state%lon, state_sc, state_sc%lon) + call subcol_state_field_copy(state%ps, state_sc, state_sc%ps) + call subcol_state_field_copy(state%psdry, state_sc, state_sc%psdry) + call subcol_state_field_copy(state%phis, state_sc, state_sc%phis) + call subcol_state_field_copy(state%te_ini, state_sc, state_sc%te_ini) + call subcol_state_field_copy(state%te_cur, state_sc, state_sc%te_cur) + call subcol_state_field_copy(state%tw_ini, state_sc, state_sc%tw_ini) + call subcol_state_field_copy(state%tw_cur, state_sc, state_sc%tw_cur) + call subcol_state_field_copy(state%t, state_sc, state_sc%t) + call subcol_state_field_copy(state%u, state_sc, state_sc%u) + call subcol_state_field_copy(state%v, state_sc, state_sc%v) + call subcol_state_field_copy(state%s, state_sc, state_sc%s) + call subcol_state_field_copy(state%omega, state_sc, state_sc%omega) + call subcol_state_field_copy(state%pmid, state_sc, state_sc%pmid) + call subcol_state_field_copy(state%pdel, state_sc, state_sc%pdel) + call subcol_state_field_copy(state%rpdel, state_sc, state_sc%rpdel) + call subcol_state_field_copy(state%lnpmid, state_sc, state_sc%lnpmid) + call subcol_state_field_copy(state%exner, state_sc, state_sc%exner) + call subcol_state_field_copy(state%zm, state_sc, state_sc%zm) + call subcol_state_field_copy(state%pint, state_sc, state_sc%pint) + call subcol_state_field_copy(state%lnpint, state_sc, state_sc%lnpint) + call subcol_state_field_copy(state%zi, state_sc, state_sc%zi) + call subcol_state_field_copy(state%lnpmiddry, state_sc, state_sc%lnpmiddry) + call subcol_state_field_copy(state%pmiddry, state_sc, state_sc%pmiddry) + call subcol_state_field_copy(state%pdeldry, state_sc, state_sc%pdeldry) + call subcol_state_field_copy(state%rpdeldry, state_sc, state_sc%rpdeldry) + call subcol_state_field_copy(state%pintdry, state_sc, state_sc%pintdry) + call subcol_state_field_copy(state%lnpintdry, state_sc, state_sc%lnpintdry) + call subcol_state_field_copy(state%q, state_sc, state_sc%q) + + end subroutine subcol_state_copy + + subroutine subcol_set_subcols(state, tend, nsubcol, state_sc, tend_sc) + !----------------------------------------------------------------------- + ! Propogate nsubcol information to common areas such as state, tend, + ! nsubcol2d, and indcol2d + !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state + type(physics_tend), intent(inout) :: tend + integer, intent(in) :: nsubcol(pcols) + type(physics_state), intent(inout) :: state_sc ! subcolumn state + type(physics_tend), intent(inout) :: tend_sc ! subcolumn tend + + call subcol_set_nsubcol(state%lchnk, state%ngrdcol, nsubcol) + call subcol_state_copy(state, state_sc) + call subcol_tend_copy(tend, state_sc, tend_sc) + end subroutine subcol_set_subcols + + + subroutine subcol_ptend_copy(ptend, state, ptend_cp) + !----------------------------------------------------------------------- + ! Copy a physics_ptend object into one which has subcolumns + !----------------------------------------------------------------------- + use physics_types, only: physics_ptend_init + + type(physics_ptend), intent(in) :: ptend ! ptend source, dimensioned with grid columns + type(physics_state), intent(in) :: state ! state with subcolumns + type(physics_ptend), intent(out) :: ptend_cp ! copy of ptend, dimensioned with subcolumns + + ! Local Variables + integer :: ncol + integer :: indcol(pcols*psubcols) + + !----------------------------------------------------------------------- + + if (ptend%psetcols .ne. pcols) then + call endrun('subcol_ptend_copy: ptend must be dimensioned pcols to use this routine') + end if + + call physics_ptend_init(ptend_cp,state%psetcols, ptend%name, ls=ptend%ls, lu=ptend%lu, & + lv=ptend%lv, lq=ptend%lq) + + ptend_cp%top_level = ptend%top_level + ptend_cp%bot_level = ptend%bot_level + + ncol = subcol_get_ncol(state%lchnk) + call subcol_get_indcol(state%lchnk, indcol) + + ! Copy the grid column data into each of the subcolumns - indcol contains the grid index for each subcolumn + if (ptend_cp%ls) then + ptend_cp%s(:ncol,:) = ptend%s(indcol(:ncol),:) + ptend_cp%hflux_srf(:ncol) = ptend%hflux_srf(indcol(:ncol)) + ptend_cp%hflux_top(:ncol) = ptend%hflux_top(indcol(:ncol)) + end if + + if (ptend_cp%lu) then + ptend_cp%u(:ncol,:) = ptend%u(indcol(:ncol),:) + ptend_cp%taux_srf(:ncol) = ptend%taux_srf(indcol(:ncol)) + ptend_cp%taux_top(:ncol) = ptend%taux_top(indcol(:ncol)) + end if + + if (ptend_cp%lv) then + ptend_cp%v(:ncol,:) = ptend%v(indcol(:ncol),:) + ptend_cp%tauy_srf(:ncol) = ptend%tauy_srf(indcol(:ncol)) + ptend_cp%tauy_top(:ncol) = ptend%tauy_top(indcol(:ncol)) + end if + + if (any(ptend_cp%lq(:))) then + ptend_cp%q(:ncol,:,:) = ptend%q(indcol(:ncol),:,:) + ptend_cp%cflx_srf(:ncol,:) = ptend%cflx_srf(indcol(:ncol),:) + ptend_cp%cflx_top(:ncol,:) = ptend%cflx_top(indcol(:ncol),:) + end if + + end subroutine subcol_ptend_copy + + subroutine subcol_state_hdrinit(state, state_sc) + !----------------------------------------------------------------------- + ! Initialize the subcolumn state header variables + !---------------------------------------------------------------------- + type(physics_state), intent(in) :: state + type(physics_state), intent(inout) :: state_sc ! subcolumn state + + integer :: isize + integer :: nsubcol(pcols) + + call subcol_get_nsubcol(state%lchnk, nsubcol) + isize = state%ngrdcol + if (size(nsubcol) < isize) then + call endrun('subcol_state_hdrinit error: input nsubcol array must be dimensioned at least as large as state%ngrdcol') + end if + + state_sc%ngrdcol = state%ngrdcol + state_sc%lchnk = state%lchnk + + state_sc%psetcols = pcols*psubcols + ! Set count to a too-large value. It should be correctly initialized in check_energy_timestep_init + state_sc%count = pcols*psubcols*2 + + ! Set the number of set subcolumns to the total count + state_sc%ncol = subcol_get_ncol(state%lchnk) + + end subroutine subcol_state_hdrinit + + ! TYPE int,double,real + ! DIMS 1,2 + subroutine subcol_field_avg_shr_{DIMS}d{TYPE}(field_sc, ngrdcol, lchnk, field, usefilter, useweight) + !----------------------------------------------------------------------- + ! This is the high level subcol field averaging routine which + ! averages a field dimensioned pcols*psubcols to a grid one dimensioned pcols + ! + ! Its purpose is to check filter and weight settings and to subset the + ! appropriate subsection of the field array to pass on the averaging routine + !----------------------------------------------------------------------- + + {VTYPE},intent(in) :: field_sc{DIMSTR} ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + {VTYPE}, intent(out) :: field{DIMSTR} + logical, intent(in) :: usefilter + logical, intent(in) :: useweight + + ! + ! Local variables + ! + integer :: indx, nsubcol, i, j + integer :: nsubcols(pcols) + + field = ret_nan_{TYPE} + + if (usefilter .and. .not. filter_set) then + call endrun('subcol_field_avg_shr error: Cannot specify using filters when none set') + end if + + if (useweight .and. .not. weight_set) then + call endrun('subcol_field_avg_shr error: Cannot specify using weights when none set') + end if + + call subcol_get_nsubcol(lchnk, nsubcols) + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) .gt. 0) then + nsubcol = nsubcols(i) +#if ({DIMS} >=2) + do j=1,size(field_sc,dim=2) +#endif +#if ({DIMS} == 1) + field(i)=subcol_avg_inter(field_sc(indx:indx+nsubcol-1), lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) +#endif +#if ({DIMS} == 2) + field(i,j)=subcol_avg_inter(field_sc(indx:indx+nsubcol-1,j), lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) +#endif +#if ({DIMS} >=2) + end do +#endif + indx = indx + nsubcol + end if + end do + end subroutine subcol_field_avg_shr_{DIMS}d{TYPE} + + + ! TYPE int,double,real + ! DIMS 1,2 + subroutine subcol_field_get_firstsubcol_{DIMS}d{TYPE}(field_sc, docheck, ngrdcol, lchnk, field) + !----------------------------------------------------------------------- + ! Retrieve the first subcolumn from a field dimensioned pcols*psubcols + ! and assign to one with pcols, performing optional checking that all other subcolumns are identical + !----------------------------------------------------------------------- + + {VTYPE}, intent(in) :: field_sc{DIMSTR} ! intent in + logical, intent(in) :: docheck ! true=check, false=no check + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + {VTYPE}, intent(out) :: field{DIMSTR} + + ! + ! Local variables + ! + integer :: indx, nsubcol, i, j, l + integer :: nsubcols(pcols) + + call subcol_get_nsubcol(lchnk, nsubcols) + field = 0 + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) .gt. 0) then + nsubcol = nsubcols(i) +#if ({DIMS}>=2) + do j=1,size(field_sc,dim=2) +#endif + +#if ({DIMS} == 1) + field(i) = field_sc(indx) +#elif ({DIMS} == 2) + field(i,j) = field_sc(indx,j) +#endif + if (docheck) then + do l=1,nsubcol-1 +#if ({DIMS} == 1) + if (field_sc(indx) /= field_sc(indx+l)) then +#elif ({DIMS} == 2) + if (field_sc(indx,j) /= field_sc(indx+l,j)) then +#endif + call endrun('subcol_field_get_firstsubcol error: Not all subcolumn fields are identical') + end if + end do + end if +#if ({DIMS}>=2) + end do +#endif + indx = indx + nsubcol + end if + end do + end subroutine subcol_field_get_firstsubcol_{DIMS}d{TYPE} + + subroutine subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, usefilter, useweight) + !----------------------------------------------------------------------- + ! Average a subcolumn ptend to a grid ptend + !----------------------------------------------------------------------- + + type(physics_ptend), intent(in) :: ptend_sc ! subcolumn ptend + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend ! grid ptend + logical, intent(in) :: usefilter + logical, intent(in) :: useweight + + ! + ! Local variables + ! + integer :: indx, i, j, k, nsubcol + integer :: nsubcols(pcols) + + if (usefilter .and. .not. filter_set) then + call endrun('subcol_ptend_avg_shr error: Cannot specify using filters when none set') + end if + + if (useweight .and. .not. weight_set) then + call endrun('subcol_ptend_avg_shr error: Cannot specify using weights when none set') + end if + + call subcol_get_nsubcol(lchnk, nsubcols) + ! physics_ptend_init has already been called by the master interface + if (ptend%ls) then + ptend%s(:,:) = 0._r8 + ptend%hflux_srf(:) = 0._r8 + ptend%hflux_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) > 0) then + nsubcol = nsubcols(i) + do j=1,pver + ptend%s(i,j)=subcol_avg_inter(ptend_sc%s(indx:indx+nsubcol-1,j), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + end do + ptend%hflux_srf(i) = subcol_avg_inter(ptend_sc%hflux_srf(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + ptend%hflux_top(i) = subcol_avg_inter(ptend_sc%hflux_top(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + indx = indx + nsubcol + end if + end do + end if + if (ptend%lu) then + ptend%u(:,:) = 0._r8 + ptend%taux_srf(:) = 0._r8 + ptend%taux_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) > 0) then + nsubcol = nsubcols(i) + do j=1,pver + ptend%u(i,j)=subcol_avg_inter(ptend_sc%u(indx:indx+nsubcol-1,j), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + end do + ptend%taux_srf(i) = subcol_avg_inter(ptend_sc%taux_srf(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + ptend%taux_top(i) = subcol_avg_inter(ptend_sc%taux_top(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + indx = indx + nsubcol + end if + end do + end if + if (ptend%lv) then + ptend%v(:,:) = 0._r8 + ptend%tauy_srf(:) = 0._r8 + ptend%tauy_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) > 0) then + nsubcol = nsubcols(i) + do j=1,pver + ptend%v(i,j)=subcol_avg_inter(ptend_sc%v(indx:indx+nsubcol-1,j), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + end do + ptend%tauy_srf(i) = subcol_avg_inter(ptend_sc%tauy_srf(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + ptend%tauy_top(i) = subcol_avg_inter(ptend_sc%tauy_top(indx:indx+nsubcol-1), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + indx = indx + nsubcol + end if + end do + end if + if (any(ptend%lq(:))) then + ptend%q(:,:,:) = 0._r8 + ptend%cflx_srf(:,:) = 0._r8 + ptend%cflx_top(:,:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + if (nsubcols(i) > 0) then + nsubcol = nsubcols(i) + do j=1,pver + do k=1, pcnst + ptend%q(i,j,k)=subcol_avg_inter(ptend_sc%q(indx:indx+nsubcol-1,j,k), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + end do + end do + do k=1,pcnst + ptend%cflx_srf(i,k) = subcol_avg_inter(ptend_sc%cflx_srf(indx:indx+nsubcol-1,k), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + ptend%cflx_top(i,k) = subcol_avg_inter(ptend_sc%cflx_top(indx:indx+nsubcol-1,k), & + lchnk, i, indx, indx+nsubcol-1, usefilter, useweight) + end do + indx = indx + nsubcol + end if + end do + end if + + end subroutine subcol_ptend_avg_shr + + subroutine subcol_ptend_get_firstsubcol(ptend_sc, docheck, ngrdcol, lchnk, ptend) + !----------------------------------------------------------------------- + ! Retrieve the first subcolumn from a ptend field dimensioned pcols*psubcols + ! and assign to one with pcols, performing optional check that all other subcolumns are identical + !----------------------------------------------------------------------- + + type(physics_ptend), intent(in) :: ptend_sc ! subcolumn ptend + logical, intent(in) :: docheck ! perform check that all subcolumns match + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend ! grid ptend + + ! + ! Local variables + ! + integer :: indx, i, j, l + integer :: nsubcols(pcols) + + call subcol_get_nsubcol(lchnk, nsubcols) + ! physics_ptend_init has already been called by the master interface + if (ptend%ls) then + ptend%s(:,:) = 0._r8 + ptend%hflux_srf(:) = 0._r8 + ptend%hflux_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + if (docheck) then + do l=1,nsubcols(i)-1 + if (any(ptend_sc%s(indx,:) /= ptend_sc%s(indx+l,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%s') + if (ptend_sc%hflux_srf(indx) /= ptend_sc%hflux_srf(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%hflux_srf') + if (ptend_sc%hflux_top(indx) /= ptend_sc%hflux_top(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%hflux_top') + end do + end if + ptend%s(i,:) = ptend_sc%s(indx,:) + ptend%hflux_srf(i) = ptend_sc%hflux_srf(indx) + ptend%hflux_top(i) = ptend_sc%hflux_top(indx) + indx = indx + nsubcols(i) + end do + end if + if (ptend%lu) then + ptend%u(:,:) = 0._r8 + ptend%taux_srf(:) = 0._r8 + ptend%taux_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + do l=1,nsubcols(i)-1 + if (any(ptend_sc%u(indx,:) /= ptend_sc%u(indx+l,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%u') + if (ptend_sc%taux_srf(indx) /= ptend_sc%taux_srf(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%taux_srf') + if (ptend_sc%taux_top(indx) /= ptend_sc%taux_top(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%taux_top') + end do + ptend%u(i,:) = ptend_sc%u(indx,:) + ptend%taux_srf(i) = ptend_sc%taux_srf(indx) + ptend%taux_top(i) = ptend_sc%taux_top(indx) + indx = indx + nsubcols(i) + end do + end if + if (ptend%lv) then + ptend%v(:,:) = 0._r8 + ptend%tauy_srf(:) = 0._r8 + ptend%tauy_top(:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + do l=1,nsubcols(i)-1 + if (any(ptend_sc%v(indx,:) /= ptend_sc%v(indx+l,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%v') + if (ptend_sc%tauy_srf(indx) /= ptend_sc%tauy_srf(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%tauy_srf') + if (ptend_sc%tauy_top(indx) /= ptend_sc%tauy_top(indx+l)) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%tauy_top') + end do + ptend%v(i,:) = ptend_sc%v(indx,:) + ptend%tauy_srf(i) = ptend_sc%tauy_srf(indx) + ptend%tauy_top(i) = ptend_sc%tauy_top(indx) + indx = indx + nsubcols(i) + end do + end if + if (any(ptend%lq(:))) then + ptend%q(:,:,:) = 0._r8 + ptend%cflx_srf(:,:) = 0._r8 + ptend%cflx_top(:,:) = 0._r8 + indx = 1 + do i = 1, ngrdcol + do l=1,nsubcols(i)-1 + if (any(ptend_sc%q(indx,:,:) /= ptend_sc%q(indx+l,:,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%q') + if (any(ptend_sc%cflx_srf(indx,:) /= ptend_sc%cflx_srf(indx+l,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%cflx_srf') + if (any(ptend_sc%cflx_top(indx,:) /= ptend_sc%cflx_top(indx+l,:))) & + call endrun('subcol_ptend_get_firstsubcol error: Not all subcolumn fields are identical for ptend%cflx_top') + end do + ptend%q(i,:,:) = ptend_sc%q(indx,:,:) + ptend%cflx_srf(i,:) = ptend_sc%cflx_srf(indx,:) + ptend%cflx_top(i,:) = ptend_sc%cflx_top(indx,:) + indx = indx + nsubcols(i) + end do + end if + + end subroutine subcol_ptend_get_firstsubcol + + ! TYPE int,double,real + {VTYPE} function subcol_avg_inter_{TYPE}(vals, lchnk, icol, indx1, indx2, usefilter, useweight) result(avgs) + !------------------------------------------------------------------ + ! This function handles the transformation of the usefilter and useweight logicals to passing the + ! actual fields which subcol_avg requires based on the values of the logicals + !------------------------------------------------------------------ + + {VTYPE},intent(in) :: vals(:) + integer, intent(in) :: lchnk + integer, intent(in) :: icol + integer, intent(in) :: indx1 + integer, intent(in) :: indx2 + logical, intent(in) :: usefilter + logical, intent(in) :: useweight + + integer :: nsubcol(pcols) + + call subcol_get_nsubcol(lchnk, nsubcol) + if (usefilter .and. useweight) then + avgs = subcol_avg(vals,nsubcol(icol),filter=filter2d(indx1:indx2,lchnk),weight=weight2d(indx1:indx2,lchnk)) + else if (useweight) then + avgs = subcol_avg(vals,nsubcol(icol),weight=weight2d(indx1:indx2,lchnk)) + else if (usefilter) then + avgs = subcol_avg(vals, nsubcol(icol),filter=filter2d(indx1:indx2,lchnk)) + else + avgs = subcol_avg(vals,nsubcol(icol)) + end if + + end function subcol_avg_inter_{TYPE} + + ! TYPE int,double,real + {VTYPE} function subcol_avg_{TYPE}(vals, nsubcol, filter, weight) result(avgs) + !------------------------------------------------------------------ + ! This function performs the averaging of subcolumn fields, using the optional & + ! filters and weights appropriately + !------------------------------------------------------------------ + + {VTYPE}, intent(in) :: vals(:) + integer, intent(in) :: nsubcol + integer, intent(in), optional :: filter(:) + real(r8), intent(in), optional :: weight(:) + + integer :: icnt + {VTYPE} :: fillval + + fillval = fillval_{TYPE} + + if (present(filter) .and. present(weight)) then + if (any(filter==1).and. sum(weight,mask=(filter==1)) /=0 ) then + avgs = sum(vals*weight, mask=(filter==1)) / sum(weight, mask=(filter==1)) + else + avgs = fillval + end if + else if (present(weight)) then + if (sum(weight) /=0 ) then + avgs = sum(vals*weight) / sum(weight) + else + avgs = fillval + end if + else if (present(filter)) then + if (any(filter==1)) then + icnt = count(filter==1) + avgs = sum(vals, mask=(filter==1)) / icnt + else + avgs = fillval + end if + else if (nsubcol /= 0) then + avgs = sum(vals) / nsubcol + else + avgs = fillval + end if + + end function subcol_avg_{TYPE} + + subroutine subcol_utils_init_restart(File, hdimids) + + use pio, only: file_desc_t, pio_int, pio_double + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + use subcol_pack_mod, only: subcol_pack_init_restart + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File + integer, intent(in) :: hdimids(:) + + ! Local variable + integer, allocatable :: adimids(:) + + call subcol_pack_init_restart(File, hdimids) + + ! Storing filter and weight data even if not being filled by the current + ! subcolumn generator. While these are 2-D arrays, they don't match + ! the grid so we will have to recast them as 3-D + + ! We will need a dimid for the subcol dimension + call cam_pio_def_dim(File, 'psubcols', psubcols, subcol_dimid, & + existOK=.true.) + allocate(adimids(size(hdimids,1) + 1)) + adimids(1:size(hdimids)) = hdimids(:) + adimids(size(hdimids) + 1) = subcol_dimid + + call cam_pio_def_var(File, 'FILTER2D', pio_int, adimids, filter2d_desc) + call cam_pio_def_var(File, 'WEIGHT2D', pio_double, adimids, weight2d_desc) + + end subroutine subcol_utils_init_restart + + subroutine subcol_utils_write_restart(File) + use cam_grid_support, only: cam_grid_write_dist_array + use cam_grid_support, only: cam_grid_id, cam_grid_dimensions + use ppgrid, only: begchunk, endchunk + use subcol_pack_mod, only: subcol_unpack + use subcol_pack_mod, only: subcol_pack_write_restart + use pio, only: file_desc_t + + ! Dummy argument + type(file_desc_t), intent(inout) :: File + + ! Local variables + integer :: c + integer :: adimlens(3) + integer :: fdimlens(3) + integer :: frank + integer :: grid_id + integer, allocatable :: unpacked_i(:,:,:) + real(r8), allocatable :: unpacked_r(:,:,:) + character(len=*), parameter :: subname = 'SUBCOL_UTILS_WRITE_RESTART' + + ! File dimensions + grid_id = cam_grid_id('physgrid') + call cam_grid_dimensions(grid_id, fdimlens(1:2), frank) + + ! Write nsubcol2d + call subcol_pack_write_restart(File, grid_id, fdimlens(1:frank)) + + ! filter2d and weight2d are 3-D variables + fdimlens(frank + 1) = psubcols + frank = frank + 1 + + ! Write filter2d + adimlens(1) = pcols + adimlens(2) = psubcols + adimlens(3) = endchunk - begchunk + 1 + if ((pcols * psubcols) /= size(filter2d, 1)) then + call endrun(trim(subname)//": Unsupported size for FILTER2D") + end if + ! Unpack filter2d for proper output + allocate(unpacked_i(pcols, psubcols, begchunk:endchunk)) + do c = begchunk, endchunk + call subcol_unpack(c, filter2d(:,c), unpacked_i(:,:,c), 0) + end do + call cam_grid_write_dist_array(File, grid_id, adimlens, & + fdimlens(1:frank), unpacked_i, filter2d_desc) + deallocate(unpacked_i) + + ! Write weight2d + adimlens(1) = pcols + adimlens(2) = psubcols + adimlens(3) = endchunk - begchunk + 1 + if ((pcols * psubcols) /= size(weight2d, 1)) then + call endrun(trim(subname)//": Unsupported size for WEIGHT2D") + end if + ! Unpack weight2d for proper output + allocate(unpacked_r(pcols, psubcols, begchunk:endchunk)) + do c = begchunk, endchunk + call subcol_unpack(c, weight2d(:,c), unpacked_r(:,:,c), 0.0_r8) + end do + call cam_grid_write_dist_array(File, grid_id, adimlens, & + fdimlens(1:frank), unpacked_r, weight2d_desc) + deallocate(unpacked_r) + + end subroutine subcol_utils_write_restart + + subroutine subcol_utils_read_restart(File) + use pio, only: file_desc_t, pio_inq_varid + use cam_pio_utils, only: cam_pio_handle_error + use cam_grid_support, only: cam_grid_id, cam_grid_read_dist_array + use cam_grid_support, only: cam_grid_dimensions + use ppgrid, only: begchunk, endchunk + use subcol_pack_mod, only: subcol_pack + use subcol_pack_mod, only: subcol_pack_read_restart + + ! Dummy argument + type(file_desc_t), intent(inout) :: File + + integer :: ierr, c + integer :: adimlens(3) + integer :: fdimlens(3) + integer :: grid_id + integer :: frank + integer, allocatable :: unpacked_i(:,:,:) + real(r8), allocatable :: unpacked_r(:,:,:) + character(len=*), parameter :: subname = 'SUBCOL_UTILS_READ_RESTART' + integer, allocatable :: nsubcol2d(:,:) + + call subcol_allocate_internal() + + ! File dimensions + grid_id = cam_grid_id('physgrid') + call cam_grid_dimensions(grid_id, fdimlens(1:2), frank) + call subcol_pack_read_restart(File, grid_id, fdimlens(1:frank)) + + ierr = pio_inq_varid(File, 'FILTER2D', filter2d_desc) + call cam_pio_handle_error(ierr, trim(subname)//': FILTER2D not found') + ! Array dimensions + adimlens(1) = pcols + adimlens(2) = psubcols + adimlens(3) = endchunk - begchunk + 1 + if ((pcols * psubcols) /= size(filter2d, 1)) then + call endrun(trim(subname)//": Unsupported size for FILTER2D") + end if + allocate(unpacked_i(pcols, psubcols, begchunk:endchunk)) + ! File dimensions (good for both filter2d and weight2d) + frank = frank + 1 + fdimlens(frank) = psubcols + call cam_grid_read_dist_array(File, grid_id, adimlens, & + fdimlens(1:frank), unpacked_i, filter2d_desc) + ! Pack filter2d for proper output + do c = begchunk, endchunk + call subcol_pack(c, unpacked_i(:,:,c), filter2d(:,c)) + end do + deallocate(unpacked_i) + + ierr = pio_inq_varid(File, 'WEIGHT2D', weight2d_desc) + adimlens(1) = pcols + adimlens(2) = psubcols + adimlens(3) = endchunk - begchunk + 1 + if ((pcols * psubcols) /= size(weight2d, 1)) then + call endrun(trim(subname)//": Unsupported size for WEIGHT2D") + end if + allocate(unpacked_r(pcols, psubcols, begchunk:endchunk)) + call cam_pio_handle_error(ierr, trim(subname)//': WEIGHT2D not found') + call cam_grid_read_dist_array(File, grid_id, adimlens, & + fdimlens(1:frank), unpacked_r, weight2d_desc) + ! Pack weight2d for proper output + do c = begchunk, endchunk + call subcol_pack(c, unpacked_r(:,:,c), weight2d(:,c)) + end do + deallocate(unpacked_r) + + end subroutine subcol_utils_read_restart + +end module subcol_utils diff --git a/src/physics/cam/tidal_diag.F90 b/src/physics/cam/tidal_diag.F90 new file mode 100644 index 0000000000..9f77fd8435 --- /dev/null +++ b/src/physics/cam/tidal_diag.F90 @@ -0,0 +1,233 @@ +module tidal_diag + + !--------------------------------------------------------------------------------- + ! Module to compute fourier coefficients for the diurnal and semidiurnal tide + ! + ! Created by: Dan Marsh + ! Date: 12 May 2008 + !--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + + implicit none + + private + + ! Public interfaces + + public :: tidal_diag_init ! create coefficient history file variables + public :: tidal_diag_write ! calculate and output dignostics + public :: get_tidal_coeffs + +contains + + !=============================================================================== + + subroutine tidal_diag_init() + !----------------------------------------------------------------------- + ! Purpose: create fourier coefficient history file variables + !----------------------------------------------------------------------- + + use cam_history, only: addfld, add_default, horiz_only + use phys_control,only: phys_getopts + + logical :: history_waccm + + call addfld ('T_24_COS', (/ 'lev' /), 'A','K','Temperature 24hr. cos coeff.') + call addfld ('T_24_SIN', (/ 'lev' /), 'A','K','Temperature 24hr. sin coeff.') + call addfld ('T_12_COS', (/ 'lev' /), 'A','K','Temperature 12hr. cos coeff.') + call addfld ('T_12_SIN', (/ 'lev' /), 'A','K','Temperature 12hr. sin coeff.') + call addfld ('T_08_COS', (/ 'lev' /), 'A','K','Temperature 8hr. cos coeff.') + call addfld ('T_08_SIN', (/ 'lev' /), 'A','K','Temperature 8hr. sin coeff.') + + call addfld ('U_24_COS', (/ 'lev' /), 'A','m/s','Zonal wind 24hr. cos coeff.') + call addfld ('U_24_SIN', (/ 'lev' /), 'A','m/s','Zonal wind 24hr. sin coeff.') + call addfld ('U_12_COS', (/ 'lev' /), 'A','m/s','Zonal wind 12hr. cos coeff.') + call addfld ('U_12_SIN', (/ 'lev' /), 'A','m/s','Zonal wind 12hr. sin coeff.') + call addfld ('U_08_COS', (/ 'lev' /), 'A','m/s','Zonal wind 8hr. cos coeff.') + call addfld ('U_08_SIN', (/ 'lev' /), 'A','m/s','Zonal wind 8hr. sin coeff.') + + call addfld ('V_24_COS', (/ 'lev' /), 'A','m/s','Meridional wind 24hr. cos coeff.') + call addfld ('V_24_SIN', (/ 'lev' /), 'A','m/s','Meridional wind 24hr. sin coeff.') + call addfld ('V_12_COS', (/ 'lev' /), 'A','m/s','Meridional wind 12hr. cos coeff.') + call addfld ('V_12_SIN', (/ 'lev' /), 'A','m/s','Meridional wind 12hr. sin coeff.') + call addfld ('V_08_COS', (/ 'lev' /), 'A','m/s','Meridional wind 8hr. cos coeff.') + call addfld ('V_08_SIN', (/ 'lev' /), 'A','m/s','Meridional wind 8hr. sin coeff.') + + call addfld ('PS_24_COS', horiz_only, 'A','Pa','surface pressure 24hr. cos coeff.') + call addfld ('PS_24_SIN', horiz_only, 'A','Pa','surface pressure 24hr. sin coeff.') + call addfld ('PS_12_COS', horiz_only, 'A','Pa','surface pressure 12hr. cos coeff.') + call addfld ('PS_12_SIN', horiz_only, 'A','Pa','surface pressure 12hr. sin coeff.') + call addfld ('PS_08_COS', horiz_only, 'A','Pa','surface pressure 8hr. cos coeff.') + call addfld ('PS_08_SIN', horiz_only, 'A','Pa','surface pressure 8hr. sin coeff.') + + call addfld ('OMEGA_24_COS', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 24hr. cos coeff.') + call addfld ('OMEGA_24_SIN', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 24hr. sin coeff.') + call addfld ('OMEGA_12_COS', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 12hr. cos coeff.') + call addfld ('OMEGA_12_SIN', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 12hr. sin coeff.') + call addfld ('OMEGA_08_COS', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 8hr. cos coeff.') + call addfld ('OMEGA_08_SIN', (/ 'lev' /), 'A','Pa/s','vertical pressure velocity 8hr. sin coeff.') + + call phys_getopts( history_waccm_out = history_waccm ) + + if (history_waccm) then + call add_default ('T_24_COS', 1, ' ') + call add_default ('T_24_SIN', 1, ' ') + call add_default ('T_12_COS', 1, ' ') + call add_default ('T_12_SIN', 1, ' ') + call add_default ('U_24_COS', 1, ' ') + call add_default ('U_24_SIN', 1, ' ') + call add_default ('U_12_COS', 1, ' ') + call add_default ('U_12_SIN', 1, ' ') + call add_default ('V_24_COS', 1, ' ') + call add_default ('V_24_SIN', 1, ' ') + call add_default ('V_12_COS', 1, ' ') + call add_default ('V_12_SIN', 1, ' ') + call add_default ('PS_24_COS', 1, ' ') + call add_default ('PS_24_SIN', 1, ' ') + call add_default ('PS_12_COS', 1, ' ') + call add_default ('PS_12_SIN', 1, ' ') + endif + + return + + end subroutine tidal_diag_init + + !=============================================================================== + + subroutine tidal_diag_write(state) + + !----------------------------------------------------------------------- + ! Purpose: calculate fourier coefficients and save to history files + !----------------------------------------------------------------------- + use cam_history, only: outfld, hist_fld_active + use physics_types, only: physics_state + + implicit none + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(physics_state), intent(in) :: state + ! + !---------------------------Local workspace----------------------------- + + integer :: lchnk + + real(r8) :: dcoef(6) + integer :: ncol + + !----------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + call get_tidal_coeffs( dcoef ) + + if ( hist_fld_active('T_24_COS') .or. hist_fld_active('T_24_SIN') ) then + call outfld( 'T_24_SIN', state%t(:ncol,:)*dcoef(1), ncol, lchnk ) + call outfld( 'T_24_COS', state%t(:ncol,:)*dcoef(2), ncol, lchnk ) + endif + if ( hist_fld_active('T_12_COS') .or. hist_fld_active('T_12_SIN') ) then + call outfld( 'T_12_SIN', state%t(:ncol,:)*dcoef(3), ncol, lchnk ) + call outfld( 'T_12_COS', state%t(:ncol,:)*dcoef(4), ncol, lchnk ) + endif + if ( hist_fld_active('T_08_COS') .or. hist_fld_active('T_08_SIN') ) then + call outfld( 'T_08_SIN', state%t(:ncol,:)*dcoef(5), ncol, lchnk ) + call outfld( 'T_08_COS', state%t(:ncol,:)*dcoef(6), ncol, lchnk ) + endif + + if ( hist_fld_active('U_24_COS') .or. hist_fld_active('U_24_SIN') ) then + call outfld( 'U_24_SIN', state%u(:ncol,:)*dcoef(1), ncol, lchnk ) + call outfld( 'U_24_COS', state%u(:ncol,:)*dcoef(2), ncol, lchnk ) + endif + if ( hist_fld_active('U_12_COS') .or. hist_fld_active('U_12_SIN') ) then + call outfld( 'U_12_SIN', state%u(:ncol,:)*dcoef(3), ncol, lchnk ) + call outfld( 'U_12_COS', state%u(:ncol,:)*dcoef(4), ncol, lchnk ) + endif + if ( hist_fld_active('U_08_COS') .or. hist_fld_active('U_08_SIN') ) then + call outfld( 'U_08_SIN', state%u(:ncol,:)*dcoef(5), ncol, lchnk ) + call outfld( 'U_08_COS', state%u(:ncol,:)*dcoef(6), ncol, lchnk ) + endif + + if ( hist_fld_active('V_24_COS') .or. hist_fld_active('V_24_SIN') ) then + call outfld( 'V_24_SIN', state%v(:ncol,:)*dcoef(1), ncol, lchnk ) + call outfld( 'V_24_COS', state%v(:ncol,:)*dcoef(2), ncol, lchnk ) + endif + if ( hist_fld_active('V_12_COS') .or. hist_fld_active('V_12_SIN') ) then + call outfld( 'V_12_SIN', state%v(:ncol,:)*dcoef(3), ncol, lchnk ) + call outfld( 'V_12_COS', state%v(:ncol,:)*dcoef(4), ncol, lchnk ) + endif + if ( hist_fld_active('V_08_COS') .or. hist_fld_active('V_08_SIN') ) then + call outfld( 'V_08_SIN', state%v(:ncol,:)*dcoef(5), ncol, lchnk ) + call outfld( 'V_08_COS', state%v(:ncol,:)*dcoef(6), ncol, lchnk ) + endif + + if ( hist_fld_active('PS_24_COS') .or. hist_fld_active('PS_24_SIN') ) then + call outfld( 'PS_24_SIN', state%ps(:ncol)*dcoef(1), ncol, lchnk ) + call outfld( 'PS_24_COS', state%ps(:ncol)*dcoef(2), ncol, lchnk ) + endif + if ( hist_fld_active('PS_12_COS') .or. hist_fld_active('PS_12_SIN') ) then + call outfld( 'PS_12_SIN', state%ps(:ncol)*dcoef(3), ncol, lchnk ) + call outfld( 'PS_12_COS', state%ps(:ncol)*dcoef(4), ncol, lchnk ) + endif + if ( hist_fld_active('PS_08_COS') .or. hist_fld_active('PS_08_SIN') ) then + call outfld( 'PS_08_SIN', state%ps(:ncol)*dcoef(5), ncol, lchnk ) + call outfld( 'PS_08_COS', state%ps(:ncol)*dcoef(6), ncol, lchnk ) + endif + + if ( hist_fld_active('OMEGA_24_COS') .or. hist_fld_active('OMEGA_24_SIN') ) then + call outfld( 'OMEGA_24_SIN', state%omega(:ncol,:)*dcoef(1), ncol, lchnk ) + call outfld( 'OMEGA_24_COS', state%omega(:ncol,:)*dcoef(2), ncol, lchnk ) + endif + if ( hist_fld_active('OMEGA_12_COS') .or. hist_fld_active('OMEGA_12_SIN') ) then + call outfld( 'OMEGA_12_SIN', state%omega(:ncol,:)*dcoef(3), ncol, lchnk ) + call outfld( 'OMEGA_12_COS', state%omega(:ncol,:)*dcoef(4), ncol, lchnk ) + endif + if ( hist_fld_active('OMEGA_08_COS') .or. hist_fld_active('OMEGA_08_SIN') ) then + call outfld( 'OMEGA_08_SIN', state%omega(:ncol,:)*dcoef(5), ncol, lchnk ) + call outfld( 'OMEGA_08_COS', state%omega(:ncol,:)*dcoef(6), ncol, lchnk ) + endif + + return + + end subroutine tidal_diag_write + + !=============================================================================== + subroutine get_tidal_coeffs( dcoef ) + + !----------------------------------------------------------------------- + ! Purpose: calculate fourier coefficients + !----------------------------------------------------------------------- + + use time_manager, only: get_curr_date + use physconst, only: pi, cday + + real(r8), intent(out) :: dcoef(6) + + ! variables to calculate tidal coeffs + real(r8), parameter :: pi_x_2 = 2._r8*pi + real(r8), parameter :: pi_x_4 = 4._r8*pi + real(r8), parameter :: pi_x_6 = 6._r8*pi + integer :: year, month + integer :: day ! day of month + integer :: tod ! time of day (seconds past 0Z) + real(r8) :: gmtfrac + + ! calculate multipliers for Fourier transform in time (tidal analysis) + call get_curr_date(year, month, day, tod) + gmtfrac = tod / cday + + dcoef(1) = 2._r8*sin(pi_x_2*gmtfrac) + dcoef(2) = 2._r8*cos(pi_x_2*gmtfrac) + dcoef(3) = 2._r8*sin(pi_x_4*gmtfrac) + dcoef(4) = 2._r8*cos(pi_x_4*gmtfrac) + dcoef(5) = 2._r8*sin(pi_x_6*gmtfrac) + dcoef(6) = 2._r8*cos(pi_x_6*gmtfrac) + + end subroutine get_tidal_coeffs + +end module tidal_diag + diff --git a/src/physics/cam/tracers.F90 b/src/physics/cam/tracers.F90 new file mode 100644 index 0000000000..ec2fb66daa --- /dev/null +++ b/src/physics/cam/tracers.F90 @@ -0,0 +1,454 @@ +!====================================================================== +! Module implements passive test tracers. +! +! Two options: +! +! 1) Specify only the number of tracers desired by setting the -nadv_tt option to configure. +! This results in setting up the desired number of tracers making use of the tracers_suite +! module to generate tracer names and initialize mixing ratios. +! +! 2) Specify both the number of tracers using configure's -nadv_tt option, and specify +! the same number of tracer names using the test_tracer_names namelist variable. This +! specifies a set of passive tracers that are either initialized from analytic expressions +! or by reading values from the IC file. The tracers for which analytic expressions are +! available are the following: +! +! test_tracer_names description +! ----------------- ----------- +! TT_SLOT Non-smooth scalar field (slotted cylinder) +! TT_GBALL Smooth Gaussian "ball" +! TT_TANH Zonally constant, tanh function of latitude. +! TT_EM8 Constant field of size 1.e-8. +! TT_Y2_2 Approximately Y^2_2 spherical harmonic +! TT_Y32_16 Approximately Y^32_16 spherical harmonic +! TT_LATP2 Zonally constant, latitude + 2. +! TT_LONP2 Meridionally constant, cos(longitude) + 2. +! +!====================================================================== + +module tracers + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_sys_mod, only: shr_sys_flush +use spmd_utils, only: masterproc +use ppgrid, only: pver +use physconst, only: mwdry, cpair +use constituents, only: cnst_add, cnst_name, cnst_longname +use tracers_suite, only: get_tracer_name, init_cnst_tr +use cam_history, only: addfld, add_default +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + tracers_readnl, &! read namelist + tracers_register, &! register constituent + tracers_implements_cnst, &! true if named constituent is implemented by this package + tracers_init_cnst, &! initialize constituent field + tracers_init ! initialize history fields, datasets + +integer, parameter :: num_names_max = 30 +integer, parameter :: num_analytic = 8 + +! Data from namelist variables +integer :: test_tracer_num = 0 +character(len=16) :: test_tracer_names(num_names_max) + +logical :: tracers_flag = .false. ! true => turn on test tracer code +logical :: tracers_suite_flag = .false. ! true => test tracers provided by tracers_suite module + +integer :: ixtrct=-999 ! index of 1st constituent + +character(len=16), parameter :: analytic_names(num_analytic) = & + (/'TT_SLOT ', 'TT_GBALL ', 'TT_TANH ', & + 'TT_EM8 ', 'TT_Y2_2 ', 'TT_Y32_16 ', & + 'TT_LATP2 ', 'TT_LONP2 ' /) + +logical :: analytic_tracer(num_names_max) + +!====================================================================== +contains +!====================================================================== + +subroutine tracers_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_character + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + integer :: i, j + integer :: num_names + character(len=*), parameter :: subname = 'tracers_readnl' + + namelist /test_tracers_nl/ test_tracer_num, test_tracer_names + !----------------------------------------------------------------------------- + + test_tracer_names = (/ (' ', i=1,num_names_max) /) + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'test_tracers_nl', status=ierr) + if (ierr == 0) then + read(unitn, test_tracers_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(test_tracer_names, len(test_tracer_names)*num_names_max, mpi_character, & + mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: test_tracer_names") + + call mpi_bcast(test_tracer_num, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: iradsw") + + ! If any tracers have been specified then turn on the tracers module + if (test_tracer_num > 0) then + tracers_flag = .true. + else + return + end if + + ! Determine the number of tracer names supplied: + num_names = 0 + analytic_tracer = .false. + do i = 1, num_names_max + if (len_trim(test_tracer_names(i)) > 0) then + num_names = num_names + 1 + + ! Does the tracer have an analytic IC? + do j = 1, num_analytic + if (trim(test_tracer_names(i)) == trim(analytic_names(j))) then + analytic_tracer(i) = .true. + exit + end if + end do + else + exit + end if + end do + + if (num_names > 0) then + ! If test_tracer_names have been specified, the test_tracer_num should + ! equal the number of names supplied. + if (num_names /= test_tracer_num) then + write(iulog, *) subname//' number of names, number of tracers: ', num_names, test_tracer_num + call endrun(subname // ':: number of names does not match number of tracers') + end if + else + ! If no names have been supplied then + ! the tracers will be provided by the tracers_suite module. + tracers_suite_flag = .true. + end if + + ! Print summary to log file + if (masterproc) then + + write(iulog, *) 'Test Tracers Module' + write(iulog, *) ' Number of Test Tracers:', test_tracer_num + if (tracers_suite_flag) then + write(iulog, *) ' Tracers will be provided by tracers_suite module.' + else + do i = 1, num_names + if (analytic_tracer(i)) then + write(iulog, *) ' '//trim(test_tracer_names(i))//& + ' will be initialized from an analytic expression' + else + write(iulog, *) ' '//trim(test_tracer_names(i))//& + ' will be initialized from the IC file' + end if + end do + end if + end if + +end subroutine tracers_readnl + +!====================================================================== + +subroutine tracers_register() + + ! Register advected tracers. + + ! Local variables + integer :: m, mm + logical :: read_from_file + real(r8) :: minc + character(len=16) :: name + !----------------------------------------------------------------------- + + if (.not. tracers_flag) return + + minc = -1.e36_r8 ! min mixing ratio (disable qneg3) + + do m = 1, test_tracer_num + + read_from_file = .true. + if (tracers_suite_flag) then + name = get_tracer_name(m) ! get name from suite file + read_from_file = .false. + else + name = test_tracer_names(m) + if (analytic_tracer(m)) read_from_file = .false. + end if + + ! add constituent name to list of advected, save index number ixtrct + call cnst_add(name, mwdry, cpair, minc, mm, & + readiv=read_from_file, mixtype='dry') + if (m == 1) ixtrct = mm ! save index number of first tracer + end do + +end subroutine tracers_register + +!====================================================================== + +function tracers_implements_cnst(name) + + ! return true if specified constituent is implemented by this package + + ! Arguments + character(len=*), intent(in) :: name ! constituent name + logical :: tracers_implements_cnst ! return value + + ! Local variables + integer :: m + character(len=16) :: trc_name + !----------------------------------------------------------------------- + + tracers_implements_cnst = .false. + if (.not. tracers_flag) return + + do m = 1, test_tracer_num + + if (tracers_suite_flag) then + trc_name = get_tracer_name(m) + else + trc_name = test_tracer_names(m) + end if + + if (name == trc_name) then + tracers_implements_cnst = .true. + return + end if + end do + +end function tracers_implements_cnst + +!=============================================================================== + +subroutine tracers_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize test tracer mixing ratio + + character(len=*), intent(in) :: name + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + + ! Local + integer :: m + logical :: found + character(len=*), parameter :: subname = 'tracers_init_cnst' + !---------------------------------------------------------------------------- + + if (.not. tracers_flag) return + + found = .false. + if (tracers_suite_flag) then + + do m = 1, test_tracer_num + if (name == get_tracer_name(m)) then + call init_cnst_tr(m, latvals, lonvals, mask, q) + found = .true. + exit + endif + end do + + else + + do m = 1, test_tracer_num + if (name == test_tracer_names(m)) then + if (analytic_tracer(m)) then + call test_func_set(name, latvals, lonvals, mask, q) + found = .true. + exit + else + ! The initial values were supposed to be read from the IC file. This + ! call should not have been made in that case, so it appears that a requested + ! tracer is not on the IC file. + write(iulog, *) subname//': ERROR: tracer ', trim(name), ' should be on IC file' + call endrun(subname//': ERROR: tracer missing from IC file') + end if + end if + end do + + end if + + if (.not. found) then + ! unrecognized tracer name + write(iulog, *) subname//': ERROR: ', trim(name), ' not recognized' + call endrun(subname//': ERROR: tracer name not recognized') + end if + +end subroutine tracers_init_cnst + +!=============================================================================== + +subroutine tracers_init() + + ! Add tracers to history output + + ! Local + integer m, mm + character(len=16) :: name ! constituent name + + if (.not. tracers_flag ) return + + do m = 1,test_tracer_num + mm = ixtrct + m - 1 + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm)) + call add_default(cnst_name(mm), 1, ' ') + end do + +end subroutine tracers_init + +!========================================================================================= + +subroutine test_func_set(name, latvals, lonvals, mask, q) + + ! use test_func code to set array q + + character(len=*), intent(in) :: name + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + + ! local variables + integer :: i, k + !---------------------------------------------------------------------------- + + do i = 1, size(mask) + if (mask(i)) then + do k = 1, size(q, 2) + q(i,k) = test_func(name, latvals(i), lonvals(i), k) + end do + end if + end do + +end subroutine test_func_set + +!========================================================================================= + +function test_func(name, lat, lon, k) result(fout) + + ! Analytic test functions. + + use physconst, only: pi + use hycoef, only: hyam, hybm, ps0 + + character(len=*), intent(in) :: name + real(r8), intent(in) :: lon ! radians + real(r8), intent(in) :: lat ! radians + integer, intent(in) :: k ! vertical index for layer mid-points + + real(r8) :: fout + + real(r8), parameter :: psurf_moist = 100000.0_r8 ! moist surface pressure + real(r8), parameter :: deg2rad = pi/180._r8 + + real(r8) :: lon1, lat1, R0, Rg1, Rg2, lon2, lat2 + real(r8) :: eta, eta_c + real(r8) :: cos_tmp, sin_tmp + !---------------------------------------------------------------------------- + + select case(name) + case('TT_SLOT') + ! + ! Non-smooth scalar field (slotted cylinder) + ! + R0 = 0.5_r8 + lon1 = 4.0_r8 * pi / 5.0_r8 + lat1 = 0.0_r8 + Rg1 = acos(sin(lat1)*sin(lat)+cos(lat1)*cos(lat)*cos(lon-lon1)) + lon2 = 6.0_r8 * pi / 5.0_r8 + lat2 = 0.0_r8 + Rg2 = acos(sin(lat2)*sin(lat)+cos(lat2)*cos(lat)*cos(lon-lon2)) + + if ((Rg1 <= R0) .AND. (abs(lon-lon1) >= R0/6)) then + fout = 2.0_r8 + elseif ((Rg2 <= R0) .AND. (abs(lon-lon2) >= R0/6)) then + fout = 2.0_r8 + elseif ((Rg1 <= R0) .AND. (abs(lon-lon1) < R0/6) & + .AND. (lat-lat1 < -5.0_r8*R0/12.0_r8)) then + fout = 2.0_r8 + elseif ((Rg2 <= R0) .AND. (abs(lon-lon2) < R0/6) & + .AND. (lat-lat2 > 5.0_r8*R0/12.0_r8)) then + fout = 2.0_r8 + else + fout = 1.0_r8 + endif + + case('TT_GBALL') + ! + ! Smooth Gaussian "ball" + ! + R0 = 10.0_r8 ! radius of the perturbation + lon1 = 20.0_r8*deg2rad ! longitudinal position, 20E + lat1 = 40.0_r8 *deg2rad ! latitudinal position, 40N + eta_c = 0.6_r8 + sin_tmp = SIN(lat1)*SIN(lat) + cos_tmp = COS(lat1)*COS(lat) + Rg1 = ACOS( sin_tmp + cos_tmp*COS(lon-lon1) ) ! great circle distance + eta = (hyam(k)*ps0 + hybm(k)*psurf_moist)/psurf_moist + fout = EXP(- ((Rg1*R0)**2 + ((eta-eta_c)/0.1_r8)**2)) + IF (ABS(fout) < 1.0E-8_r8) fout = 0.0_r8 + + case('TT_TANH') + ! + ! + ! + fout = 0.5_r8 * ( tanh( 3.0_r8*abs(lat)-pi ) + 1.0_r8) + + case('TT_EM8') + fout = 1.0e-8_r8 + + case('TT_Y2_2') + ! + ! approximately Y^2_2 spherical harmonic + ! + fout = 0.5_r8 + 0.5_r8*(cos(lat)*cos(lat)*cos(2.0_r8*lon)) + + case('TT_Y32_16') + ! + ! approximately Y32_16 spherical harmonic + ! + fout = 0.5_r8 + 0.5_r8*(cos(16*lon)*(sin(2_r8*lat)**16)) + + case('TT_LATP2') + fout = 2.0_r8 + lat + + case('TT_LONP2') + fout = 2.0_r8 + cos(lon) + + case default + call endrun("test_func: ERROR: name not recognized") + end select + +end function test_func + +!========================================================================================= + +end module tracers diff --git a/src/physics/cam/tracers_suite.F90 b/src/physics/cam/tracers_suite.F90 new file mode 100644 index 0000000000..3f80699a43 --- /dev/null +++ b/src/physics/cam/tracers_suite.F90 @@ -0,0 +1,357 @@ + +module tracers_suite + +!--------------------------------------------------------------- +! +! Implements artificial suite of passive tracers +! 1) low tracer with unit mixing ratio at about 800 mb +! 2) med tracer with unit mixing ratio at about 500 mb +! 3) high tracer with unit mixing ratio at about 200 mb +! 4) reverse med tracer with unit mixing ratio everywhere except about 500 mb +! 5) unit tracer with unit mixing ratio everywhere +! +! D Bundy June 2003 +! modified Feb 2004 to include TT_UN and smoothing +! +! A Mirin and B Eaton, August 2007 +! Modified to create up to 1000 distinct copies of the 5 basic tracers +! by appending up to a 3 digit number to the base tracer name. +! RESTRICTION - trac_ncnstmx cannot exceed 5000 unless the algorithm for +! constructing new tracer names is extended. +! +!--------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use ref_pres, only: pref_mid +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +public get_tracer_name ! generate names of tracers +public init_cnst_tr ! initialize tracer fields + +integer, parameter :: trac_ncnstmx=5000 ! Max no. of tracers based on current algorithm for + ! constructing tracer names. This could easily be extended. +integer, parameter :: trac_names=5 ! No. of base tracers + +logical, parameter :: smooth = .false. + +!====================================================================== +contains +!====================================================================== + +function get_tracer_name(n) + + ! The tracer names are only defined in this module. This function is for + ! outside programs to grab the name for each tracer number. + + integer, intent(in) :: n + character(len=8) :: get_tracer_name + + ! Local variables + character(len=5), dimension(trac_names), parameter :: & ! constituent names + tracer_names = (/ 'TT_LW', 'TT_MD', 'TT_HI', 'TTRMD' , 'TT_UN'/) + + integer :: nbase ! Corresponding base tracer index + integer :: ncopy ! No. of copies of base tracers + character(len=1) :: c1 + character(len=2) :: c2 + character(len=3) :: c3 + !----------------------------------------------------------------------- + + if ( n > trac_ncnstmx ) then + write(iulog,*) 'tracers_suite:get_tracer_name()','requested tracer',n + write(iulog,*) 'only ',trac_ncnstmx,' tracers available' + call endrun('tracers_suite: ERROR in get_tracer_name(); n too large') + else + nbase = mod(n-1, trac_names) + 1 + ncopy = (n-1)/trac_names + if ( ncopy == 0 ) then + get_tracer_name = tracer_names(nbase) + else if ( ncopy >= 1 .and. ncopy <= 9 ) then + write (c1,'(i1)') ncopy + get_tracer_name = tracer_names(nbase) // c1 + else if ( ncopy >= 10 .and. ncopy <= 99 ) then + write (c2,'(i2)') ncopy + get_tracer_name = tracer_names(nbase) // c2 + else if ( ncopy >= 100 .and. ncopy <= 999 ) then + write (c3,'(i3)') ncopy + get_tracer_name = tracer_names(nbase) // c3 + end if + endif + +end function get_tracer_name + +!====================================================================== + +subroutine init_cnst_tr(m, latvals, lonvals, mask, q) + + ! calls initialization routine for tracer m, returns mixing ratio in q + + integer, intent(in) :: m ! index of tracer + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol,plev) + + integer nbase ! Corresponding base tracer index + + if ( m > trac_ncnstmx ) then + write(iulog,*) 'tracers_suite:init_cnst_tr()' + write(iulog,*) ' asked to initialize tracer number ',m + write(iulog,*) ' but there are only trac_ncnstmx = ',trac_ncnstmx,' tracers' + call endrun('tracers_suite: ERROR in init_cnst_tr(); m too large') + endif + + nbase = mod(m-1,trac_names)+1 + + if ( nbase == 1 ) then + call init_cnst_lw(latvals, lonvals, mask, q) + else if ( nbase == 2 ) then + call init_cnst_md(latvals, lonvals, mask, q) + else if ( nbase == 3 ) then + call init_cnst_hi(latvals, lonvals, mask, q) + else if ( nbase == 4 ) then + call init_cnst_md(latvals, lonvals, mask, q, rev_in=1) + else if ( nbase == 5 ) then + call init_cnst_un(latvals, lonvals, mask, q) + else + write(iulog,*) 'tracers_suite:init_cnst_tr()' + write(iulog,*) 'no initialization routine specified for tracer',nbase + call endrun('tracers_suite: ERROR in init_cnst_tr(); no init routine available') + endif + +end subroutine init_cnst_tr + +!====================================================================== + +subroutine init_cnst_lw(latvals, lonvals, mask, q) + + ! Initialize test tracer TT_LW + ! Initialize low tracer to zero except at 800 level + + ! Arguments + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol,plev) + + ! Local + integer :: indx, k + !----------------------------------------------------------------------- + + indx = setpindxtr(800._r8) + + if ( smooth ) then + call setsmoothtr(indx,q,.876_r8, mask) + else + do k = 1, size(q, 2) + if (k == indx) then + where(mask) + q(:,k) = 1.0_r8 + end where + else + where(mask) + q(:,k) = 0.0_r8 + end where + end if + end do + end if + +end subroutine init_cnst_lw + +!====================================================================== + +subroutine init_cnst_md(latvals, lonvals, mask, q, rev_in) + + ! Initialize test tracer TT_MD + ! Initialize med tracer to zero except at 500 level + + ! Arguments + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air + integer, intent(in), optional :: rev_in ! reverse the mixing ratio + + ! Local + integer :: indx, k + integer :: rev + !----------------------------------------------------------------------- + + rev = 0 + if (present(rev_in)) then + if (rev_in == 1) then + rev = 1 + endif + endif + + indx = setpindxtr(500._r8) + + if ( smooth ) then + call setsmoothtr(indx,q,.876_r8,mask,rev_in=rev) + else + do k = 1, size(q, 2) + if (rev == 1 ) then + if (k == indx) then + where(mask) + q(:,indx) = 0.0_r8 + end where + else + where(mask) + q(:,k) = 1.0_r8 + end where + end if + else + if (k == indx) then + where(mask) + q(:,indx) = 1.0_r8 + end where + else + where(mask) + q(:,k) = 0.0_r8 + end where + end if + end if + end do + end if + +end subroutine init_cnst_md + +!====================================================================== + +subroutine init_cnst_hi(latvals, lonvals, mask, q) + + ! Initialize test tracer TT_HI + ! Initialize high tracer to zero except at 200 level + + ! Arguments + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air + + ! Local + integer :: indx, k + !----------------------------------------------------------------------- + + indx = setpindxtr(200._r8) + + if ( smooth ) then + call setsmoothtr(indx,q,.3_r8,mask) + else + do k = 1, size(q, 2) + if (k == indx) then + where(mask) + q(:,k) = 1.0_r8 + end where + else + where(mask) + q(:,k) = 0.0_r8 + end where + end if + end do + end if + +end subroutine init_cnst_hi + +!====================================================================== + +subroutine init_cnst_un(latvals, lonvals, mask, q) + + ! Initialize test unit tracer TT_UN + + real(r8), intent(in) :: latvals(:) ! lat in radians (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in radians (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air + !----------------------------------------------------------------------- + integer :: k + + do k = 1, size(q, 2) + where(mask) + q(:,k) = 1.0_r8 + end where + end do + +end subroutine init_cnst_un + +!====================================================================== + +subroutine setsmoothtr(indx,q,width,mask,rev_in) + + ! Arguments + integer, intent(in) :: indx ! k index of pressure level + real(r8), intent(inout) :: q(:,:) ! kg tracer/kg dry air + real(r8), intent(in) :: width ! eta difference from unit level where q = 0.1 + logical, intent(in) :: mask(:) ! Only set q where mask is .true. + integer, intent(in), optional :: rev_in ! reverse the mixing ratio + + ! Local variables + integer :: k + real(r8) :: alpha ! guassian width, determined by width, T + real(r8) :: pdist ! pressure distance (eta.e4) from k=indx + real(r8) :: T ! desired m.r. in level specified by pdiff from k=indx + integer :: rev ! = 1 then reverse (q = 1, q(k=indx) = 0 ) + + rev = 0 + if (present(rev_in)) then + if (rev_in == 1) then + rev = 1 + endif + endif + + T = 0.1_r8 + alpha = -log(T)/(width*1.e4_r8)**2 ! s.t. in level width from indx, mr = T + + ! alpha = 3.e-8 ! m.r. ~ 0.1 in adjacent levels, where change eta ~ 0.08 + + do k=1,pver + pdist = pref_mid(k) - pref_mid(indx) + + if ( rev == 1 ) then + where(mask) + q(:,k) = 1.0_r8 - exp(-alpha*(pdist**2)) + end where + else + where(mask) + q(:,k) = exp(-alpha*(pdist**2)) + end where + endif + end do + +end subroutine setsmoothtr + +!====================================================================== + +integer function setpindxtr(pmb) + + ! find the index of layer nearest pmb + + real(r8), intent(in) :: pmb + + integer :: indx, k + real(r8) :: pmin, pdist + + indx = 0 + pmin = 1.e36_r8 + pdist = 1.e36_r8 + do k=1,pver + pdist = abs(pref_mid(k) - pmb*100._r8) + if (pdist < pmin) then + indx = k + pmin = pdist + end if + end do + + setpindxtr = indx + +end function setpindxtr + +!====================================================================== + +end module tracers_suite diff --git a/src/physics/cam/trb_mtn_stress.F90 b/src/physics/cam/trb_mtn_stress.F90 new file mode 100644 index 0000000000..ff730872e4 --- /dev/null +++ b/src/physics/cam/trb_mtn_stress.F90 @@ -0,0 +1,180 @@ +module trb_mtn_stress + + implicit none + private + save + + public init_tms ! Initialization + public compute_tms ! Full routine + + ! ------------ ! + ! Private data ! + ! ------------ ! + + integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + + real(r8), parameter :: horomin= 1._r8 ! Minimum value of subgrid orographic height for mountain stress [ m ] + real(r8), parameter :: z0max = 100._r8 ! Maximum value of z_0 for orography [ m ] + real(r8), parameter :: dv2min = 0.01_r8 ! Minimum shear squared [ m2/s2 ] + real(r8) :: orocnst ! Converts from standard deviation to height [ no unit ] + real(r8) :: z0fac ! Factor determining z_0 from orographic standard deviation [ no unit ] + real(r8) :: karman ! von Karman constant + real(r8) :: gravit ! Acceleration due to gravity + real(r8) :: rair ! Gas constant for dry air + +contains + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine init_tms( kind, oro_in, z0fac_in, karman_in, gravit_in, rair_in, & + errstring) + + integer, intent(in) :: kind + + real(r8), intent(in) :: oro_in, z0fac_in, karman_in, gravit_in, rair_in + + character(len=*), intent(out) :: errstring + + errstring = ' ' + + if ( kind /= r8 ) then + errstring = 'inconsistent KIND of reals passed to init_tms' + return + endif + + orocnst = oro_in + z0fac = z0fac_in + karman = karman_in + gravit = gravit_in + rair = rair_in + + end subroutine init_tms + + !============================================================================ ! + ! ! + !============================================================================ ! + + subroutine compute_tms( pcols , pver , ncol , & + u , v , t , pmid , exner , & + zm , sgh , ksrf , taux , tauy , & + landfrac ) + + !------------------------------------------------------------------------------ ! + ! Turbulent mountain stress parameterization ! + ! ! + ! Returns surface drag coefficient and stress associated with subgrid mountains ! + ! For points where the orographic variance is small ( including ocean ), ! + ! the returned surface drag coefficient and stress is zero. ! + ! ! + ! Lastly arranged : Sungsu Park. Jan. 2010. ! + !------------------------------------------------------------------------------ ! + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + integer, intent(in) :: pcols ! Number of columns dimensioned + integer, intent(in) :: pver ! Number of model layers + integer, intent(in) :: ncol ! Number of columns actually used + + real(r8), intent(in) :: u(pcols,pver) ! Layer mid-point zonal wind [ m/s ] + real(r8), intent(in) :: v(pcols,pver) ! Layer mid-point meridional wind [ m/s ] + real(r8), intent(in) :: t(pcols,pver) ! Layer mid-point temperature [ K ] + real(r8), intent(in) :: pmid(pcols,pver) ! Layer mid-point pressure [ Pa ] + real(r8), intent(in) :: exner(pcols,pver) ! Layer mid-point exner function [ no unit ] + real(r8), intent(in) :: zm(pcols,pver) ! Layer mid-point height [ m ] + real(r8), intent(in) :: sgh(pcols) ! Standard deviation of orography [ m ] + real(r8), intent(in) :: landfrac(pcols) ! Land fraction [ fraction ] + + real(r8), intent(out) :: ksrf(pcols) ! Surface drag coefficient [ kg/s/m2 ] + real(r8), intent(out) :: taux(pcols) ! Surface zonal wind stress [ N/m2 ] + real(r8), intent(out) :: tauy(pcols) ! Surface meridional wind stress [ N/m2 ] + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + integer :: i ! Loop index + integer :: kb, kt ! Bottom and top of source region + + real(r8) :: horo ! Orographic height [ m ] + real(r8) :: z0oro ! Orographic z0 for momentum [ m ] + real(r8) :: dv2 ! (delta v)**2 [ m2/s2 ] + real(r8) :: ri ! Richardson number [ no unit ] + real(r8) :: stabfri ! Instability function of Richardson number [ no unit ] + real(r8) :: rho ! Density [ kg/m3 ] + real(r8) :: cd ! Drag coefficient [ no unit ] + real(r8) :: vmag ! Velocity magnitude [ m /s ] + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + do i = 1, ncol + + ! determine subgrid orgraphic height ( mean to peak ) + + horo = orocnst * sgh(i) + + ! No mountain stress if horo is too small + + if( horo < horomin ) then + + ksrf(i) = 0._r8 + taux(i) = 0._r8 + tauy(i) = 0._r8 + + else + + ! Determine z0m for orography + + z0oro = min( z0fac * horo, z0max ) + + ! Calculate neutral drag coefficient + + cd = ( karman / log( ( zm(i,pver) + z0oro ) / z0oro) )**2 + + ! Calculate the Richardson number over the lowest 2 layers + + kt = pver - 1 + kb = pver + dv2 = max( ( u(i,kt) - u(i,kb) )**2 + ( v(i,kt) - v(i,kb) )**2, dv2min ) + + ! Modification : Below computation of Ri is wrong. Note that 'Exner' function here is + ! inverse exner function. Here, exner function is not multiplied in + ! the denominator. Also, we should use moist Ri not dry Ri. + ! Also, this approach using the two lowest model layers can be potentially + ! sensitive to the vertical resolution. + ! OK. I only modified the part associated with exner function. + + ri = 2._r8 * gravit * ( t(i,kt) * exner(i,kt) - t(i,kb) * exner(i,kb) ) * ( zm(i,kt) - zm(i,kb) ) & + / ( ( t(i,kt) * exner(i,kt) + t(i,kb) * exner(i,kb) ) * dv2 ) + + ! ri = 2._r8 * gravit * ( t(i,kt) * exner(i,kt) - t(i,kb) * exner(i,kb) ) * ( zm(i,kt) - zm(i,kb) ) & + ! / ( ( t(i,kt) + t(i,kb) ) * dv2 ) + + ! Calculate the instability function and modify the neutral drag cofficient. + ! We should probably follow more elegant approach like Louis et al (1982) or Bretherton and Park (2009) + ! but for now we use very crude approach : just 1 for ri < 0, 0 for ri > 1, and linear ramping. + + stabfri = max( 0._r8, min( 1._r8, 1._r8 - ri ) ) + cd = cd * stabfri + + ! Compute density, velocity magnitude and stress using bottom level properties + + rho = pmid(i,pver) / ( rair * t(i,pver) ) + vmag = sqrt( u(i,pver)**2 + v(i,pver)**2 ) + ksrf(i) = rho * cd * vmag * landfrac(i) + taux(i) = -ksrf(i) * u(i,pver) + tauy(i) = -ksrf(i) * v(i,pver) + + end if + + end do + + return + end subroutine compute_tms + +end module trb_mtn_stress diff --git a/src/physics/cam/trb_mtn_stress_cam.F90 b/src/physics/cam/trb_mtn_stress_cam.F90 new file mode 100644 index 0000000000..64cd43f091 --- /dev/null +++ b/src/physics/cam/trb_mtn_stress_cam.F90 @@ -0,0 +1,158 @@ +module trb_mtn_stress_cam + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use shr_log_mod, only: errMsg => shr_log_errMsg +use cam_logfile, only: iulog +use ppgrid, only: pcols, pver + +implicit none +private + +public :: trb_mtn_stress_readnl +public :: trb_mtn_stress_register +public :: trb_mtn_stress_init +public :: trb_mtn_stress_tend + +! Is this module on at all? +logical :: do_tms = .false. + +! Tuning parameters for TMS. +real(r8) :: tms_orocnst +real(r8) :: tms_z0fac + +! pbuf field indices +integer :: & + sgh30_idx = -1, & + ksrftms_idx = -1, & + tautmsx_idx = -1, & + tautmsy_idx = -1 + +contains + +subroutine trb_mtn_stress_readnl(nlfile) + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterprocid, mpi_logical, mpi_real8, mpicom + + ! filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! file unit and error code + integer :: unitn, ierr + + character(len=*), parameter :: subname = "trb_mtn_stress_readnl" + + namelist /tms_nl/ do_tms, tms_orocnst, tms_z0fac + + ierr = 0 + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'tms_nl', status=ierr) + if (ierr == 0) then + read(unitn, tms_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(do_tms, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(tms_orocnst, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(tms_z0fac, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + +end subroutine trb_mtn_stress_readnl + +subroutine trb_mtn_stress_register() + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call pbuf_add_field("ksrftms", "physpkg", dtype_r8, [pcols], ksrftms_idx) + call pbuf_add_field("tautmsx", "physpkg", dtype_r8, [pcols], tautmsx_idx) + call pbuf_add_field("tautmsy", "physpkg", dtype_r8, [pcols], tautmsy_idx) + +end subroutine trb_mtn_stress_register + +subroutine trb_mtn_stress_init() + + use cam_history, only: addfld, add_default, horiz_only + use error_messages, only: handle_errmsg + use phys_control, only: phys_getopts + use physconst, only: karman, gravit, rair + use physics_buffer, only: pbuf_get_index + use trb_mtn_stress, only: init_tms + + logical :: history_amwg + + character(len=128) :: errstring + + if (.not. do_tms) return + + call phys_getopts(history_amwg_out=history_amwg) + + call init_tms( r8, tms_orocnst, tms_z0fac, karman, gravit, rair, errstring) + call handle_errmsg(errstring, subname="init_tms") + + call addfld('TAUTMSX', horiz_only, 'A', 'N/m2', 'Zonal turbulent mountain surface stress') + call addfld('TAUTMSY', horiz_only, 'A', 'N/m2', 'Meridional turbulent mountain surface stress') + if (history_amwg) then + call add_default( 'TAUTMSX ', 1, ' ' ) + call add_default( 'TAUTMSY ', 1, ' ' ) + end if + + if (masterproc) then + write(iulog,*)'Using turbulent mountain stress module' + write(iulog,*)' tms_orocnst = ',tms_orocnst + write(iulog,*)' tms_z0fac = ',tms_z0fac + end if + + sgh30_idx = pbuf_get_index("SGH30") + +end subroutine trb_mtn_stress_init + +subroutine trb_mtn_stress_tend(state, pbuf, cam_in) + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + use trb_mtn_stress, only: compute_tms + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + type(cam_in_t), intent(in) :: cam_in + + real(r8), pointer :: sgh30(:) + real(r8), pointer :: ksrftms(:) + real(r8), pointer :: tautmsx(:), tautmsy(:) + + call pbuf_get_field(pbuf, ksrftms_idx, ksrftms) + call pbuf_get_field(pbuf, tautmsx_idx, tautmsx) + call pbuf_get_field(pbuf, tautmsy_idx, tautmsy) + + if (.not. do_tms) then + ksrftms = 0._r8 + tautmsx = 0._r8 + tautmsy = 0._r8 + return + end if + + call pbuf_get_field(pbuf, sgh30_idx, sgh30) + + call compute_tms( pcols , pver , state%ncol , & + state%u , state%v , state%t , state%pmid , & + state%exner, state%zm , sgh30 , ksrftms , & + tautmsx , tautmsy , cam_in%landfrac ) + + call outfld("TAUTMSX", tautmsx, pcols, state%lchnk) + call outfld("TAUTMSY", tautmsy, pcols, state%lchnk) + +end subroutine trb_mtn_stress_tend + +end module trb_mtn_stress_cam diff --git a/src/physics/cam/tropopause.F90 b/src/physics/cam/tropopause.F90 new file mode 100644 index 0000000000..a2fd830817 --- /dev/null +++ b/src/physics/cam/tropopause.F90 @@ -0,0 +1,1512 @@ +! This module is used to diagnose the location of the tropopause. Multiple +! algorithms are provided, some of which may not be able to identify a +! tropopause in all situations. To handle these cases, an analytic +! definition and a climatology are provided that can be used to fill in +! when the original algorithm fails. The tropopause temperature and +! pressure are determined and can be output to the history file. +! +! These routines are based upon code in the WACCM chemistry module +! including mo_tropoause.F90 and llnl_set_chem_trop.F90. The code +! for the Reichler et al. [2003] algorithm is from: +! +! http://www.gfdl.noaa.gov/~tjr/TROPO/tropocode.htm +! +! Author: Charles Bardeen +! Created: April, 2009 + +module tropopause + !--------------------------------------------------------------- + ! ... variables for the tropopause module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod, only : pi => shr_const_pi + use ppgrid, only : pcols, pver, begchunk, endchunk + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use cam_history_support, only : fillvalue + use physics_types, only : physics_state + use physconst, only : cappa, rair, gravit + use spmd_utils, only : masterproc + + implicit none + + private + + public :: tropopause_readnl, tropopause_init, tropopause_find, tropopause_output + public :: tropopause_findChemTrop + public :: TROP_ALG_NONE, TROP_ALG_ANALYTIC, TROP_ALG_CLIMATE + public :: TROP_ALG_STOBIE, TROP_ALG_HYBSTOB, TROP_ALG_TWMO, TROP_ALG_WMO + public :: TROP_ALG_CPP + public :: NOTFOUND + + save + + ! These parameters define and enumeration to be used to define the primary + ! and backup algorithms to be used with the tropopause_find() method. The + ! backup algorithm is meant to provide a solution when the primary algorithm + ! fail. The algorithms that can't fail are: TROP_ALG_ANALYTIC, TROP_ALG_CLIMATE + ! and TROP_ALG_STOBIE. + integer, parameter :: TROP_ALG_NONE = 1 ! Don't evaluate + integer, parameter :: TROP_ALG_ANALYTIC = 2 ! Analytic Expression + integer, parameter :: TROP_ALG_CLIMATE = 3 ! Climatology + integer, parameter :: TROP_ALG_STOBIE = 4 ! Stobie Algorithm + integer, parameter :: TROP_ALG_TWMO = 5 ! WMO Definition, Reichler et al. [2003] + integer, parameter :: TROP_ALG_WMO = 6 ! WMO Definition + integer, parameter :: TROP_ALG_HYBSTOB = 7 ! Hybrid Stobie Algorithm + integer, parameter :: TROP_ALG_CPP = 8 ! Cold Point Parabolic + + integer, parameter :: TROP_NALG = 8 ! Number of Algorithms + character,parameter :: TROP_LETTER(TROP_NALG) = (/ ' ', 'A', 'C', 'S', 'T', 'W', 'H', 'F' /) + ! unique identifier for output, don't use P + + ! These variables should probably be controlled by namelist entries. + logical ,parameter :: output_all = .False. ! output tropopause info from all algorithms + integer ,parameter :: default_primary = TROP_ALG_TWMO ! default primary algorithm + integer ,parameter :: default_backup = TROP_ALG_CLIMATE ! default backup algorithm + + ! Namelist variables + character(len=256) :: tropopause_climo_file = 'trop_climo' ! absolute filepath of climatology file + + ! These variables are used to store the climatology data. + real(r8) :: days(12) ! days in the climatology + real(r8), pointer :: tropp_p_loc(:,:,:) ! climatological tropopause pressures + + integer, parameter :: NOTFOUND = -1 + + real(r8),parameter :: ALPHA = 0.03_r8 + + ! physical constants + ! These constants are set in module variables rather than as parameters + ! to support the aquaplanet mode in which the constants have values determined + ! by the experiment protocol + real(r8) :: cnst_kap ! = cappa + real(r8) :: cnst_faktor ! = -gravit/rair + real(r8) :: cnst_ka1 ! = cnst_kap - 1._r8 + +!================================================================================================ +contains +!================================================================================================ + + ! Read namelist variables. + subroutine tropopause_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'tropopause_readnl' + + namelist /tropopause_nl/ tropopause_climo_file + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'tropopause_nl', status=ierr) + if (ierr == 0) then + read(unitn, tropopause_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(tropopause_climo_file, len(tropopause_climo_file), mpichar, 0, mpicom) +#endif + + end subroutine tropopause_readnl + + + ! This routine is called during intialization and must be called before the + ! other methods in this module can be used. Its main tasks are to read in the + ! climatology from a file and to define the output fields. Much of this code + ! is taken from mo_tropopause. + subroutine tropopause_init() + + use cam_history, only: addfld, horiz_only + + + implicit none + + ! define physical constants + cnst_kap = cappa + cnst_faktor = -gravit/rair + cnst_ka1 = cnst_kap - 1._r8 + + ! Define the output fields. + call addfld('TROP_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure', flag_xyfill=.True.) + call addfld('TROP_T', horiz_only, 'A', 'K', 'Tropopause Temperature', flag_xyfill=.True.) + call addfld('TROP_Z', horiz_only, 'A', 'm', 'Tropopause Height', flag_xyfill=.True.) + call addfld('TROP_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height') + call addfld('TROP_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Probabilty') + call addfld('TROP_FD', horiz_only, 'A', 'probability', 'Tropopause Found') + + call addfld('TROPP_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (primary)', flag_xyfill=.True.) + call addfld('TROPP_T', horiz_only, 'A', 'K', 'Tropopause Temperature (primary)', flag_xyfill=.True.) + call addfld('TROPP_Z', horiz_only, 'A', 'm', 'Tropopause Height (primary)', flag_xyfill=.True.) + call addfld('TROPP_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height (primary)') + call addfld('TROPP_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (primary)') + call addfld('TROPP_FD', horiz_only, 'A', 'probability', 'Tropopause Found (primary)') + + call addfld('TROPF_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (cold point)', flag_xyfill=.True.) + call addfld('TROPF_T', horiz_only, 'A', 'K', 'Tropopause Temperature (cold point)', flag_xyfill=.True.) + call addfld('TROPF_Z', horiz_only, 'A', 'm', 'Tropopause Height (cold point)', flag_xyfill=.True.) + call addfld('TROPF_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height (cold point)', flag_xyfill=.True.) + call addfld('TROPF_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (cold point)') + call addfld('TROPF_FD', horiz_only, 'A', 'probability', 'Tropopause Found (cold point)') + + call addfld( 'hstobie_trop', (/ 'lev' /), 'I', 'fraction of model time', 'Lowest level with stratospheric chemsitry') + call addfld( 'hstobie_linoz', (/ 'lev' /), 'I', 'fraction of model time', 'Lowest possible Linoz level') + call addfld( 'hstobie_tropop', (/ 'lev' /), 'I', 'fraction of model time', & + 'Troposphere boundary calculated in chemistry' ) + + ! If requested, be prepared to output results from all of the methods. + if (output_all) then + call addfld('TROPA_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (analytic)', flag_xyfill=.True.) + call addfld('TROPA_T', horiz_only, 'A', 'K', 'Tropopause Temperature (analytic)', flag_xyfill=.True.) + call addfld('TROPA_Z', horiz_only, 'A', 'm', 'Tropopause Height (analytic)', flag_xyfill=.True.) + call addfld('TROPA_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (analytic)') + call addfld('TROPA_FD', horiz_only, 'A', 'probability', 'Tropopause Found (analytic)') + + call addfld('TROPC_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (climatology)', flag_xyfill=.True.) + call addfld('TROPC_T', horiz_only, 'A', 'K', 'Tropopause Temperature (climatology)', flag_xyfill=.True.) + call addfld('TROPC_Z', horiz_only, 'A', 'm', 'Tropopause Height (climatology)', flag_xyfill=.True.) + call addfld('TROPC_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (climatology)') + call addfld('TROPC_FD', horiz_only, 'A', 'probability', 'Tropopause Found (climatology)') + + call addfld('TROPS_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (stobie)', flag_xyfill=.True.) + call addfld('TROPS_T', horiz_only, 'A', 'K', 'Tropopause Temperature (stobie)', flag_xyfill=.True.) + call addfld('TROPS_Z', horiz_only, 'A', 'm', 'Tropopause Height (stobie)', flag_xyfill=.True.) + call addfld('TROPS_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (stobie)') + call addfld('TROPS_FD', horiz_only, 'A', 'probability', 'Tropopause Found (stobie)') + + call addfld('TROPT_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (twmo)', flag_xyfill=.True.) + call addfld('TROPT_T', horiz_only, 'A', 'K', 'Tropopause Temperature (twmo)', flag_xyfill=.True.) + call addfld('TROPT_Z', horiz_only, 'A', 'm', 'Tropopause Height (twmo)', flag_xyfill=.True.) + call addfld('TROPT_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (twmo)') + call addfld('TROPT_FD', horiz_only, 'A', 'probability', 'Tropopause Found (twmo)') + + call addfld('TROPW_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (WMO)', flag_xyfill=.True.) + call addfld('TROPW_T', horiz_only, 'A', 'K', 'Tropopause Temperature (WMO)', flag_xyfill=.True.) + call addfld('TROPW_Z', horiz_only, 'A', 'm', 'Tropopause Height (WMO)', flag_xyfill=.True.) + call addfld('TROPW_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (WMO)') + call addfld('TROPW_FD', horiz_only, 'A', 'probability', 'Tropopause Found (WMO)') + + call addfld('TROPH_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (Hybrid Stobie)', flag_xyfill=.True.) + call addfld('TROPH_T', horiz_only, 'A', 'K', 'Tropopause Temperature (Hybrid Stobie)', flag_xyfill=.True.) + call addfld('TROPH_Z', horiz_only, 'A', 'm', 'Tropopause Height (Hybrid Stobie)', flag_xyfill=.True.) + call addfld('TROPH_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (Hybrid Stobie)') + call addfld('TROPH_FD', horiz_only, 'A', 'probability', 'Tropopause Found (Hybrid Stobie)') + end if + + + call tropopause_read_file() + + + end subroutine tropopause_init + + + subroutine tropopause_read_file + !------------------------------------------------------------------ + ! ... initialize upper boundary values + !------------------------------------------------------------------ + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use dyn_grid, only : get_dyn_grid_parm + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + use ioFileMod, only : getfil + use time_manager, only : get_calday + use physconst, only : pi + use cam_pio_utils, only: cam_pio_openfile + use pio, only : file_desc_t, var_desc_t, pio_inq_dimid, pio_inq_dimlen, & + pio_inq_varid, pio_get_var, pio_closefile, pio_nowrite + + !------------------------------------------------------------------ + ! ... local variables + !------------------------------------------------------------------ + integer :: i, j, n + integer :: ierr + type(file_desc_t) :: pio_id + integer :: dimid + type(var_desc_t) :: vid + integer :: nlon, nlat, ntimes + integer :: start(3) + integer :: count(3) + integer, parameter :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + integer :: plon, plat + type(interp_type) :: lon_wgts, lat_wgts + real(r8), allocatable :: tropp_p_in(:,:,:) + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8) :: to_lats(pcols), to_lons(pcols) + real(r8), parameter :: d2r=pi/180._r8, zero=0._r8, twopi=pi*2._r8 + character(len=256) :: locfn + integer :: c, ncols + + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + + + !----------------------------------------------------------------------- + ! ... open netcdf file + !----------------------------------------------------------------------- + call getfil (tropopause_climo_file, locfn, 0) + call cam_pio_openfile(pio_id, trim(locfn), PIO_NOWRITE) + + !----------------------------------------------------------------------- + ! ... get time dimension + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( pio_id, 'time', dimid ) + ierr = pio_inq_dimlen( pio_id, dimid, ntimes ) + if( ntimes /= 12 )then + write(iulog,*) 'tropopause_init: number of months = ',ntimes,'; expecting 12' + call endrun + end if + !----------------------------------------------------------------------- + ! ... get latitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( pio_id, 'lat', dimid ) + ierr = pio_inq_dimlen( pio_id, dimid, nlat ) + allocate( lat(nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'tropopause_init: lat allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( pio_id, 'lat', vid ) + ierr = pio_get_var( pio_id, vid, lat ) + lat(:nlat) = lat(:nlat) * d2r + !----------------------------------------------------------------------- + ! ... get longitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( pio_id, 'lon', dimid ) + ierr = pio_inq_dimlen( pio_id, dimid, nlon ) + allocate( lon(nlon), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'tropopause_init: lon allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( pio_id, 'lon', vid ) + ierr = pio_get_var( pio_id, vid, lon ) + lon(:nlon) = lon(:nlon) * d2r + + !------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------ + allocate( tropp_p_in(nlon,nlat,ntimes), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'tropopause_init: tropp_p_in allocation error = ',ierr + call endrun + end if + !------------------------------------------------------------------ + ! ... read in the tropopause pressure + !------------------------------------------------------------------ + ierr = pio_inq_varid( pio_id, 'trop_p', vid ) + start = (/ 1, 1, 1 /) + count = (/ nlon, nlat, ntimes /) + ierr = pio_get_var( pio_id, vid, start, count, tropp_p_in ) + + !------------------------------------------------------------------ + ! ... close the netcdf file + !------------------------------------------------------------------ + call pio_closefile( pio_id ) + + !-------------------------------------------------------------------- + ! ... regrid + !-------------------------------------------------------------------- + + allocate( tropp_p_loc(pcols,begchunk:endchunk,ntimes), stat=ierr ) + + if( ierr /= 0 ) then + write(iulog,*) 'tropopause_init: tropp_p_loc allocation error = ',ierr + call endrun + end if + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + call lininterp_init(lon, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(lat, nlat, to_lats, ncols, 1, lat_wgts) + do n=1,ntimes + call lininterp(tropp_p_in(:,:,n), nlon, nlat, tropp_p_loc(1:ncols,c,n), ncols, lon_wgts, lat_wgts) + end do + call lininterp_finish(lon_wgts) + call lininterp_finish(lat_wgts) + end do + deallocate(lon) + deallocate(lat) + deallocate(tropp_p_in) + + !-------------------------------------------------------- + ! ... initialize the monthly day of year times + !-------------------------------------------------------- + + do n = 1,12 + days(n) = get_calday( dates(n), 0 ) + end do + if (masterproc) then + write(iulog,*) 'tropopause_init : days' + write(iulog,'(1p,5g15.8)') days(:) + endif + + end subroutine tropopause_read_file + + + ! This analytic expression closely matches the mean tropopause determined + ! by the NCEP reanalysis and has been used by the radiation code. + subroutine tropopause_analytic(pstate, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + integer :: i + integer :: k + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + real(r8) :: tP ! tropopause pressure (Pa) + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Iterate over all of the columns. + do i = 1, ncol + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + + ! Calculate the pressure of the tropopause. + tP = (25000.0_r8 - 15000.0_r8 * (cos(pstate%lat(i)))**2) + + ! Find the level that contains the tropopause. + do k = pver, 2, -1 + if (tP >= pstate%pint(i, k)) then + tropLev(i) = k + exit + end if + end do + + ! Return the optional outputs + if (present(tropP)) tropP(i) = tP + + if (present(tropT)) then + tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) + end if + + if (present(tropZ)) then + tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) + end if + end if + end do + end subroutine tropopause_analytic + + + ! Read the tropopause pressure in from a file containging a climatology. The + ! data is interpolated to the current dat of year and latitude. + ! + ! NOTE: The data is read in during tropopause_init and stored in the module + ! variable trop + subroutine tropopause_climate(pstate, tropLev, tropP, tropT, tropZ) + use time_manager, only : get_curr_calday + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + integer :: i + integer :: k + integer :: m + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + real(r8) :: tP ! tropopause pressure (Pa) + real(r8) :: calday ! day of year including fraction + real(r8) :: dels + integer :: last + integer :: next + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! If any columns remain to be indentified, the nget the current + ! day from the calendar. + + if (any(tropLev == NOTFOUND)) then + + ! Determine the calendar day. + calday = get_curr_calday() + + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + if( calday < days(1) ) then + next = 1 + last = 12 + dels = (365._r8 + calday - days(12)) / (365._r8 + days(1) - days(12)) + else if( calday >= days(12) ) then + next = 1 + last = 12 + dels = (calday - days(12)) / (365._r8 + days(1) - days(12)) + else + do m = 11,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = m + 1 + dels = (calday - days(m)) / (days(m+1) - days(m)) + end if + + dels = max( min( 1._r8,dels ),0._r8 ) + + + ! Iterate over all of the columns. + do i = 1, ncol + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + + !-------------------------------------------------------- + ! ... get tropopause level from climatology + !-------------------------------------------------------- + ! Interpolate the tropopause pressure. + tP = tropp_p_loc(i,lchnk,last) & + + dels * (tropp_p_loc(i,lchnk,next) - tropp_p_loc(i,lchnk,last)) + + ! Find the associated level. + do k = pver, 2, -1 + if (tP >= pstate%pint(i, k)) then + tropLev(i) = k + exit + end if + end do + + ! Return the optional outputs + if (present(tropP)) tropP(i) = tP + + if (present(tropT)) then + tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) + end if + + if (present(tropZ)) then + tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) + end if + end if + end do + end if + + return + end subroutine tropopause_climate + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine tropopause_hybridstobie(pstate, tropLev, tropP, tropT, tropZ) + use cam_history, only : outfld + + !----------------------------------------------------------------------- + ! Originally written by Philip Cameron-Smith, LLNL + ! + ! Stobie-Linoz hybrid: the highest altitude of + ! a) Stobie algorithm, or + ! b) minimum Linoz pressure. + ! + ! NOTE: the ltrop(i) gridbox itself is assumed to be a STRATOSPHERIC gridbox. + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + real(r8),parameter :: min_Stobie_Pressure= 40.E2_r8 !For case 2 & 4. [Pa] + real(r8),parameter :: max_Linoz_Pressure =208.E2_r8 !For case 4. [Pa] + + integer :: i, k, ncol + real(r8) :: stobie_min, shybrid_temp !temporary variable for case 2 & 3. + integer :: ltrop_linoz(pcols) !Lowest possible Linoz vertical level + integer :: ltrop_trop(pcols) !Tropopause level for hybrid case. + logical :: ltrop_linoz_set !Flag that lowest linoz level already found. + real(r8) :: trop_output(pcols,pver) !For output purposes only. + real(r8) :: trop_linoz_output(pcols,pver) !For output purposes only. + real(r8) :: trop_trop_output(pcols,pver) !For output purposes only. + + ! write(iulog,*) 'In set_chem_trop, o3_ndx =',o3_ndx + ltrop_linoz(:) = 1 ! Initialize to default value. + ltrop_trop(:) = 1 ! Initialize to default value. + ncol = pstate%ncol + + LOOP_COL4: do i=1,ncol + + ! Skip column in which the tropopause has already been found. + not_found: if (tropLev(i) == NOTFOUND) then + + stobie_min = 1.e10_r8 ! An impossibly large number + ltrop_linoz_set = .FALSE. + LOOP_LEV: do k=pver,1,-1 + IF (pstate%pmid(i,k) < min_stobie_pressure) cycle + shybrid_temp = ALPHA * pstate%t(i,k) - Log10(pstate%pmid(i,k)) + !PJC_NOTE: the units of pmid won't matter, because it is just an additive offset. + IF (shybrid_temp0) then + trop_output(i,tropLev(i))=1._r8 + trop_linoz_output(i,ltrop_linoz(i))=1._r8 + trop_trop_output(i,ltrop_trop(i))=1._r8 + endif + enddo + + call outfld( 'hstobie_trop', trop_output(:ncol,:), ncol, pstate%lchnk ) + call outfld( 'hstobie_linoz', trop_linoz_output(:ncol,:), ncol, pstate%lchnk ) + call outfld( 'hstobie_tropop', trop_trop_output(:ncol,:), ncol, pstate%lchnk ) + + endsubroutine tropopause_hybridstobie + + ! This routine originates with Stobie at NASA Goddard, but does not have a + ! known reference. It was supplied by Philip Cameron-Smith of LLNL. + ! + subroutine tropopause_stobie(pstate, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + integer :: i + integer :: k + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + integer :: tLev ! tropopause level + real(r8) :: tP ! tropopause pressure (Pa) + real(r8) :: stobie(pver) ! stobie weighted temperature + real(r8) :: sTrop ! stobie value at the tropopause + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Iterate over all of the columns. + do i = 1, ncol + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + + ! Caclulate a pressure weighted temperature. + stobie(:) = ALPHA * pstate%t(i,:) - log10(pstate%pmid(i, :)) + + ! Search from the bottom up, looking for the first minimum. + tLev = -1 + + do k = pver-1, 1, -1 + + if (pstate%pmid(i, k) <= 4000._r8) then + exit + end if + + if (pstate%pmid(i, k) >= 55000._r8) then + cycle + end if + + if ((tLev == -1) .or. (stobie(k) < sTrop)) then + tLev = k + tP = pstate%pmid(i, k) + sTrop = stobie(k) + end if + end do + + if (tLev /= -1) then + tropLev(i) = tLev + + ! Return the optional outputs + if (present(tropP)) tropP(i) = tP + + if (present(tropT)) then + tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) + end if + + if (present(tropZ)) then + tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) + end if + end if + end if + end do + + return + end subroutine tropopause_stobie + + + ! This routine is an implementation of Reichler et al. [2003] done by + ! Reichler and downloaded from his web site. Minimal modifications were + ! made to have the routine work within the CAM framework (i.e. using + ! CAM constants and types). + ! + ! NOTE: I am not a big fan of the goto's and multiple returns in this + ! code, but for the moment I have left them to preserve as much of the + ! original and presumably well tested code as possible. + ! UPDATE: The most "obvious" substitutions have been made to replace + ! goto/return statements with cycle/exit. The structure is still + ! somewhat tangled. + ! UPDATE 2: "gamma" renamed to "gam" in order to avoid confusion + ! with the Fortran 2008 intrinsic. "level" argument removed because + ! a physics column is not contiguous, so using explicit dimensions + ! will cause the data to be needlessly copied. + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! determination of tropopause height from gridded temperature data + ! + ! reference: Reichler, T., M. Dameris, and R. Sausen (2003) + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine twmo(t, p, plimu, pliml, gam, trp) + + real(r8), intent(in), dimension(:) :: t, p + real(r8), intent(in) :: plimu, pliml, gam + real(r8), intent(out) :: trp + + real(r8), parameter :: deltaz = 2000.0_r8 + + real(r8) :: pmk, pm, a, b, tm, dtdp, dtdz + real(r8) :: ag, bg, ptph + real(r8) :: pm0, pmk0, dtdz0 + real(r8) :: p2km, asum, aquer + real(r8) :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2 + integer :: level + integer :: icount, jj + integer :: j + + + trp=-99.0_r8 ! negative means not valid + + ! initialize start level + ! dt/dz + level = size(t) + pmk= .5_r8 * (p(level-1)**cnst_kap+p(level)**cnst_kap) + pm = pmk**(1/cnst_kap) + a = (t(level-1)-t(level))/(p(level-1)**cnst_kap-p(level)**cnst_kap) + b = t(level)-(a*p(level)**cnst_kap) + tm = a * pmk + b + dtdp = a * cnst_kap * (pm**cnst_ka1) + dtdz = cnst_faktor*dtdp*pm/tm + + main_loop: do j=level-1,2,-1 + pm0 = pm + pmk0 = pmk + dtdz0 = dtdz + + ! dt/dz + pmk= .5_r8 * (p(j-1)**cnst_kap+p(j)**cnst_kap) + pm = pmk**(1/cnst_kap) + a = (t(j-1)-t(j))/(p(j-1)**cnst_kap-p(j)**cnst_kap) + b = t(j)-(a*p(j)**cnst_kap) + tm = a * pmk + b + dtdp = a * cnst_kap * (pm**cnst_ka1) + dtdz = cnst_faktor*dtdp*pm/tm + ! dt/dz valid? + if (dtdz.le.gam) cycle main_loop ! no, dt/dz < -2 K/km + if (pm.gt.plimu) cycle main_loop ! no, too low + + ! dtdz is valid, calculate tropopause pressure + if (dtdz0.lt.gam) then + ag = (dtdz-dtdz0) / (pmk-pmk0) + bg = dtdz0 - (ag * pmk0) + ptph = exp(log((gam-bg)/ag)/cnst_kap) + else + ptph = pm + endif + + if (ptph.lt.pliml) cycle main_loop + if (ptph.gt.plimu) cycle main_loop + + ! 2nd test: dtdz above 2 km must not exceed gam + p2km = ptph + deltaz*(pm/tm)*cnst_faktor ! p at ptph + 2km + asum = 0.0_r8 ! dtdz above + icount = 0 ! number of levels above + + ! test until apm < p2km + in_loop: do jj=j,2,-1 + + pmk2 = .5_r8 * (p(jj-1)**cnst_kap+p(jj)**cnst_kap) ! p mean ^kappa + pm2 = pmk2**(1/cnst_kap) ! p mean + if(pm2.gt.ptph) cycle in_loop ! doesn't happen + if(pm2.lt.p2km) exit in_loop ! ptropo is valid + + a2 = (t(jj-1)-t(jj)) ! a + a2 = a2/(p(jj-1)**cnst_kap-p(jj)**cnst_kap) + b2 = t(jj)-(a2*p(jj)**cnst_kap) ! b + tm2 = a2 * pmk2 + b2 ! T mean + dtdp2 = a2 * cnst_kap * (pm2**(cnst_kap-1)) ! dt/dp + dtdz2 = cnst_faktor*dtdp2*pm2/tm2 + asum = asum+dtdz2 + icount = icount+1 + aquer = asum/float(icount) ! dt/dz mean + + ! discard ptropo ? + if (aquer.le.gam) cycle main_loop ! dt/dz above < gam + + enddo in_loop ! test next level + + trp = ptph + exit main_loop + enddo main_loop + + end subroutine twmo + + + ! This routine uses an implementation of Reichler et al. [2003] done by + ! Reichler and downloaded from his web site. This is similar to the WMO + ! routines, but is designed for GCMs with a coarse vertical grid. + subroutine tropopause_twmo(pstate, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + real(r8), parameter :: gam = -0.002_r8 ! K/m + real(r8), parameter :: plimu = 45000._r8 ! Pa + real(r8), parameter :: pliml = 7500._r8 ! Pa + + integer :: i + integer :: k + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + real(r8) :: tP ! tropopause pressure (Pa) + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Iterate over all of the columns. + do i = 1, ncol + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + + ! Use the routine from Reichler. + call twmo(pstate%t(i, :), pstate%pmid(i, :), plimu, pliml, gam, tP) + + ! if successful, store of the results and find the level and temperature. + if (tP > 0) then + + ! Find the associated level. + do k = pver, 2, -1 + if (tP >= pstate%pint(i, k)) then + tropLev(i) = k + exit + end if + end do + + ! Return the optional outputs + if (present(tropP)) tropP(i) = tP + + if (present(tropT)) then + tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) + end if + + if (present(tropZ)) then + tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) + end if + end if + end if + end do + + return + end subroutine tropopause_twmo + + ! This routine implements the WMO definition of the tropopause (WMO, 1957; Seidel and Randel, 2006). + ! This requires that the lapse rate be less than 2 K/km for an altitude range + ! of 2 km. The search starts at the surface and stops the first time this + ! criteria is met. + ! + ! NOTE: This code was modeled after the code in mo_tropopause; however, the + ! requirement that dt be greater than 0 was removed and the check to make + ! sure that the lapse rate is maintained for 2 km was added. + subroutine tropopause_wmo(pstate, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + real(r8), parameter :: ztrop_low = 5000._r8 ! lowest tropopause level allowed (m) + real(r8), parameter :: ztrop_high = 20000._r8 ! highest tropopause level allowed (m) + real(r8), parameter :: max_dtdz = 0.002_r8 ! max dt/dz for tropopause level (K/m) + real(r8), parameter :: min_trop_dz = 2000._r8 ! min tropopause thickness (m) + + integer :: i + integer :: k + integer :: k2 + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + real(r8) :: tP ! tropopause pressure (Pa) + real(r8) :: dt + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Iterate over all of the columns. + do i = 1, ncol + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + + kloop: do k = pver-1, 2, -1 + + ! Skip levels below the minimum and stop if nothing is found + ! before the maximum. + if (pstate%zm(i, k) < ztrop_low) then + cycle kloop + else if (pstate%zm(i, k) > ztrop_high) then + exit kloop + end if + + ! Compare the actual lapse rate to the threshold + dt = pstate%t(i, k) - pstate%t(i, k-1) + + if (dt <= (max_dtdz * (pstate%zm(i, k-1) - pstate%zm(i, k)))) then + + ! Make sure that the lapse rate stays below the threshold for the + ! specified range. + k2loop: do k2 = k-1, 2, -1 + if ((pstate%zm(i, k2) - pstate%zm(i, k)) >= min_trop_dz) then + tP = pstate%pmid(i, k) + tropLev(i) = k + exit k2loop + end if + + dt = pstate%t(i, k) - pstate%t(i, k2) + if (dt > (max_dtdz * (pstate%zm(i, k2) - pstate%zm(i, k)))) then + exit k2loop + end if + end do k2loop + + if (tropLev(i) == NOTFOUND) then + cycle kloop + else + + ! Return the optional outputs + if (present(tropP)) tropP(i) = tP + + if (present(tropT)) then + tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) + end if + + if (present(tropZ)) then + tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) + end if + + exit kloop + end if + end if + end do kloop + end if + end do + + return + end subroutine tropopause_wmo + + + ! This routine searches for the cold point tropopause, and uses a parabolic + ! fit of the coldest point and two adjacent points to interpolate the cold point + ! between model levels. + subroutine tropopause_cpp(pstate, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variables + real(r8), parameter :: ztrop_low = 5000._r8 ! lowest tropopause level allowed (m) + real(r8), parameter :: ztrop_high = 25000._r8 ! highest tropopause level allowed (m) + + integer :: i + integer :: k, firstk, lastk + integer :: k2 + integer :: ncol ! number of columns in the chunk + integer :: lchnk ! chunk identifier + real(r8) :: tZ ! tropopause height (m) + real(r8) :: tmin + real(r8) :: f0, f1, f2 + real(r8) :: x0, x1, x2 + real(r8) :: c0, c1, c2 + real(r8) :: a, b, c + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Iterate over all of the columns. + do i = 1, ncol + + firstk = 0 + lastk = pver+1 + + ! Skip column in which the tropopause has already been found. + if (tropLev(i) == NOTFOUND) then + tmin = 1e6_r8 + + kloop: do k = pver-1, 2, -1 + + ! Skip levels below the minimum and stop if nothing is found + ! before the maximum. + if (pstate%zm(i, k) < ztrop_low) then + firstk = k + cycle kloop + else if (pstate%zm(i, k) > ztrop_high) then + lastk = k + exit kloop + end if + + ! Find the coldest point + if (pstate%t(i, k) < tmin) then + tropLev(i) = k + tmin = pstate%t(i,k) + end if + end do kloop + + + ! If the minimum is at the edge of the search range, then don't + ! consider this to be a minima + if ((tropLev(i) >= (firstk-1)) .or. (tropLev(i) <= (lastk+1))) then + tropLev(i) = NOTFOUND + else + + ! If returning P, Z, or T, then do a parabolic fit using the + ! cold point and it its 2 surrounding points to interpolate + ! between model levels. + if (present(tropP) .or. present(tropZ) .or. present(tropT)) then + f0 = pstate%t(i, tropLev(i)-1) + f1 = pstate%t(i, tropLev(i)) + f2 = pstate%t(i, tropLev(i)+1) + + x0 = pstate%zm(i, tropLev(i)-1) + x1 = pstate%zm(i, tropLev(i)) + x2 = pstate%zm(i, tropLev(i)+1) + + c0 = (x0-x1)*(x0-x2) + c1 = (x1-x0)*(x1-x2) + c2 = (x2-x0)*(x2-x1) + + ! Determine the quadratic coefficients of: + ! T = a * z^2 - b*z + c + a = (f0/c0 + f1/c1 + f2/c2) + b = (f0/c0*(x1+x2) + f1/c1*(x0+x2) + f2/c2*(x0+x1)) + c = f0/c0*x1*x2 + f1/c1*x0*x2 + f2/c2*x0*x1 + + ! Find the altitude of the minimum temperature + tZ = 0.5_r8 * b / a + + ! The fit should be between the upper and lower points, + ! so skip the point if the fit fails. + if ((tZ >= x0) .or. (tZ <= x2)) then + tropLev(i) = NOTFOUND + else + + ! Return the optional outputs + if (present(tropP)) then + tropP(i) = tropopause_interpolateP(pstate, i, tropLev(i), tZ) + end if + + if (present(tropT)) then + tropT(i) = a * tZ*tZ - b*tZ + c + end if + + if (present(tropZ)) then + tropZ(i) = tZ + end if + end if + end if + end if + end if + end do + + return + end subroutine tropopause_cpp + + + ! Searches all the columns in the chunk and attempts to identify the tropopause. + ! Two routines can be specifed, a primary routine which is tried first and a + ! backup routine which will be tried only if the first routine fails. If the + ! tropopause can not be identified by either routine, then a NOTFOUND is returned + ! for the tropopause level, temperature and pressure. + subroutine tropopause_find(pstate, tropLev, tropP, tropT, tropZ, primary, backup) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, optional, intent(in) :: primary ! primary detection algorithm + integer, optional, intent(in) :: backup ! backup detection algorithm + integer, intent(out) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(out) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(out) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(out) :: tropZ(pcols) ! tropopause height (m) + + ! Local Variable + integer :: primAlg ! Primary algorithm + integer :: backAlg ! Backup algorithm + + ! Initialize the results to a missing value, so that the algorithms will + ! attempt to find the tropopause for all of them. + tropLev(:) = NOTFOUND + if (present(tropP)) tropP(:) = fillvalue + if (present(tropT)) tropT(:) = fillvalue + if (present(tropZ)) tropZ(:) = fillvalue + + ! Set the algorithms to be used, either the ones provided or the defaults. + if (present(primary)) then + primAlg = primary + else + primAlg = default_primary + end if + + if (present(backup)) then + backAlg = backup + else + backAlg = default_backup + end if + + ! Try to find the tropopause using the primary algorithm. + if (primAlg /= TROP_ALG_NONE) then + call tropopause_findUsing(pstate, primAlg, tropLev, tropP, tropT, tropZ) + end if + + if ((backAlg /= TROP_ALG_NONE) .and. any(tropLev(:) == NOTFOUND)) then + call tropopause_findUsing(pstate, backAlg, tropLev, tropP, tropT, tropZ) + end if + + return + end subroutine tropopause_find + + ! Searches all the columns in the chunk and attempts to identify the "chemical" + ! tropopause. This is the lapse rate tropopause, backed up by the climatology + ! if the lapse rate fails to find the tropopause at pressures higher than a certain + ! threshold. This pressure threshold depends on latitude. Between 50S and 50N, + ! the climatology is used if the lapse rate tropopause is not found at P > 75 hPa. + ! At high latitude (poleward of 50), the threshold is increased to 125 hPa to + ! eliminate false events that are sometimes detected in the cold polar stratosphere. + ! + ! NOTE: This routine was adapted from code in chemistry.F90 and mo_gasphase_chemdr.F90. + subroutine tropopause_findChemTrop(pstate, tropLev, primary, backup) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, optional, intent(in) :: primary ! primary detection algorithm + integer, optional, intent(in) :: backup ! backup detection algorithm + integer, intent(out) :: tropLev(pcols) ! tropopause level index + + ! Local Variable + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: dlats(pcols) + integer :: i + integer :: ncol + integer :: backAlg + + ! First use the lapse rate tropopause. + ncol = pstate%ncol + call tropopause_find(pstate, tropLev, primary=primary, backup=TROP_ALG_NONE) + + ! Now check high latitudes (poleward of 50) and set the level to the + ! climatology if the level was not found or is at P <= 125 hPa. + dlats(:ncol) = pstate%lat(:ncol) * rad2deg ! convert to degrees + + if (present(backup)) then + backAlg = backup + else + backAlg = default_backup + end if + + do i = 1, ncol + if (abs(dlats(i)) > 50._r8) then + if (tropLev(i) .ne. NOTFOUND) then + if (pstate%pmid(i, tropLev(i)) <= 12500._r8) then + tropLev(i) = NOTFOUND + end if + end if + end if + end do + + ! Now use the backup algorithm + if ((backAlg /= TROP_ALG_NONE) .and. any(tropLev(:) == NOTFOUND)) then + call tropopause_findUsing(pstate, backAlg, tropLev) + end if + + return + end subroutine tropopause_findChemTrop + + + ! Call the appropriate tropopause detection routine based upon the algorithm + ! specifed. + ! + ! NOTE: It is assumed that the output fields have been initialized by the + ! caller, and only output values set to fillvalue will be detected. + subroutine tropopause_findUsing(pstate, algorithm, tropLev, tropP, tropT, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(in) :: algorithm ! detection algorithm + integer, intent(inout) :: tropLev(pcols) ! tropopause level index + real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) + real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) + + ! Dispatch the request to the appropriate routine. + select case(algorithm) + case(TROP_ALG_ANALYTIC) + call tropopause_analytic(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_CLIMATE) + call tropopause_climate(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_STOBIE) + call tropopause_stobie(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_HYBSTOB) + call tropopause_hybridstobie(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_TWMO) + call tropopause_twmo(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_WMO) + call tropopause_wmo(pstate, tropLev, tropP, tropT, tropZ) + + case(TROP_ALG_CPP) + call tropopause_cpp(pstate, tropLev, tropP, tropT, tropZ) + + case default + write(iulog, *) 'tropopause: Invalid detection algorithm (', algorithm, ') specified.' + call endrun + end select + + return + end subroutine tropopause_findUsing + + + ! This routine interpolates the pressures in the physics state to + ! find the pressure at the specified tropopause altitude. + function tropopause_interpolateP(pstate, icol, tropLev, tropZ) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(in) :: icol ! column being processed + integer, intent(in) :: tropLev ! tropopause level index + real(r8), optional, intent(in) :: tropZ ! tropopause pressure (m) + real(r8) :: tropopause_interpolateP + + ! Local Variables + real(r8) :: tropP ! tropopause pressure (Pa) + real(r8) :: dlogPdZ ! dlog(p)/dZ + + ! Interpolate the temperature linearly against log(P) + + ! Is the tropopause at the midpoint? + if (tropZ == pstate%zm(icol, tropLev)) then + tropP = pstate%pmid(icol, tropLev) + + else if (tropZ > pstate%zm(icol, tropLev)) then + + ! It is above the midpoint? Make sure we aren't at the top. + if (tropLev > 1) then + dlogPdZ = (log(pstate%pmid(icol, tropLev)) - log(pstate%pmid(icol, tropLev - 1))) / & + (pstate%zm(icol, tropLev) - pstate%zm(icol, tropLev - 1)) + tropP = pstate%pmid(icol, tropLev) + exp((tropZ - pstate%zm(icol, tropLev)) * dlogPdZ) + end if + else + + ! It is below the midpoint. Make sure we aren't at the bottom. + if (tropLev < pver) then + dlogPdZ = (log(pstate%pmid(icol, tropLev + 1)) - log(pstate%pmid(icol, tropLev))) / & + (pstate%zm(icol, tropLev + 1) - pstate%zm(icol, tropLev)) + tropP = pstate%pmid(icol, tropLev) + exp((tropZ - pstate%zm(icol, tropLev)) * dlogPdZ) + end if + end if + + tropopause_interpolateP = tropP + end function tropopause_interpolateP + + + ! This routine interpolates the temperatures in the physics state to + ! find the temperature at the specified tropopause pressure. + function tropopause_interpolateT(pstate, icol, tropLev, tropP) + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(in) :: icol ! column being processed + integer, intent(in) :: tropLev ! tropopause level index + real(r8), optional, intent(in) :: tropP ! tropopause pressure (Pa) + real(r8) :: tropopause_interpolateT + + ! Local Variables + real(r8) :: tropT ! tropopause temperature (K) + real(r8) :: dTdlogP ! dT/dlog(P) + + ! Interpolate the temperature linearly against log(P) + + ! Is the tropopause at the midpoint? + if (tropP == pstate%pmid(icol, tropLev)) then + tropT = pstate%t(icol, tropLev) + + else if (tropP < pstate%pmid(icol, tropLev)) then + + ! It is above the midpoint? Make sure we aren't at the top. + if (tropLev > 1) then + dTdlogP = (pstate%t(icol, tropLev) - pstate%t(icol, tropLev - 1)) / & + (log(pstate%pmid(icol, tropLev)) - log(pstate%pmid(icol, tropLev - 1))) + tropT = pstate%t(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dTdlogP + end if + else + + ! It is below the midpoint. Make sure we aren't at the bottom. + if (tropLev < pver) then + dTdlogP = (pstate%t(icol, tropLev + 1) - pstate%t(icol, tropLev)) / & + (log(pstate%pmid(icol, tropLev + 1)) - log(pstate%pmid(icol, tropLev))) + tropT = pstate%t(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dTdlogP + end if + end if + + tropopause_interpolateT = tropT + end function tropopause_interpolateT + + + ! This routine interpolates the geopotential height in the physics state to + ! find the geopotential height at the specified tropopause pressure. + function tropopause_interpolateZ(pstate, icol, tropLev, tropP) + use physconst, only: rga + + implicit none + + type(physics_state), intent(in) :: pstate + integer, intent(in) :: icol ! column being processed + integer, intent(in) :: tropLev ! tropopause level index + real(r8), optional, intent(in) :: tropP ! tropopause pressure (Pa) + real(r8) :: tropopause_interpolateZ + + ! Local Variables + real(r8) :: tropZ ! tropopause geopotential height (m) + real(r8) :: dZdlogP ! dZ/dlog(P) + + ! Interpolate the geopotential height linearly against log(P) + + ! Is the tropoause at the midpoint? + if (tropP == pstate%pmid(icol, tropLev)) then + tropZ = pstate%zm(icol, tropLev) + + else if (tropP < pstate%pmid(icol, tropLev)) then + + ! It is above the midpoint? Make sure we aren't at the top. + dZdlogP = (pstate%zm(icol, tropLev) - pstate%zi(icol, tropLev)) / & + (log(pstate%pmid(icol, tropLev)) - log(pstate%pint(icol, tropLev))) + tropZ = pstate%zm(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dZdlogP + else + + ! It is below the midpoint. Make sure we aren't at the bottom. + dZdlogP = (pstate%zm(icol, tropLev) - pstate%zi(icol, tropLev+1)) / & + (log(pstate%pmid(icol, tropLev)) - log(pstate%pint(icol, tropLev+1))) + tropZ = pstate%zm(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dZdlogP + end if + + tropopause_interpolateZ = tropZ + pstate%phis(icol)*rga + end function tropopause_interpolateZ + + + ! Output the tropopause pressure and temperature to the history files. Two sets + ! of output will be generated, one for the default algorithm and another one + ! using the default routine, but backed by a climatology when the default + ! algorithm fails. + subroutine tropopause_output(pstate) + use cam_history, only : outfld + + implicit none + + type(physics_state), intent(in) :: pstate + + ! Local Variables + integer :: i + integer :: alg + integer :: ncol ! number of cloumns in the chunk + integer :: lchnk ! chunk identifier + integer :: tropLev(pcols) ! tropopause level index + real(r8) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8) :: tropT(pcols) ! tropopause temperature (K) + real(r8) :: tropZ(pcols) ! tropopause height (m) + real(r8) :: tropFound(pcols) ! tropopause found + real(r8) :: tropDZ(pcols, pver) ! relative tropopause height (m) + real(r8) :: tropPdf(pcols, pver) ! tropopause probability distribution + + ! Information about the chunk. + lchnk = pstate%lchnk + ncol = pstate%ncol + + ! Find the tropopause using the default algorithm backed by the climatology. + call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ) + + tropPdf(:,:) = 0._r8 + tropFound(:) = 0._r8 + tropDZ(:,:) = fillvalue + do i = 1, ncol + if (tropLev(i) /= NOTFOUND) then + tropPdf(i, tropLev(i)) = 1._r8 + tropFound(i) = 1._r8 + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + end if + end do + + call outfld('TROP_P', tropP(:ncol), ncol, lchnk) + call outfld('TROP_T', tropT(:ncol), ncol, lchnk) + call outfld('TROP_Z', tropZ(:ncol), ncol, lchnk) + call outfld('TROP_DZ', tropDZ(:ncol, :), ncol, lchnk) + call outfld('TROP_PD', tropPdf(:ncol, :), ncol, lchnk) + call outfld('TROP_FD', tropFound(:ncol), ncol, lchnk) + + + ! Find the tropopause using just the primary algorithm. + call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, backup=TROP_ALG_NONE) + + tropPdf(:,:) = 0._r8 + tropFound(:) = 0._r8 + tropDZ(:,:) = fillvalue + + do i = 1, ncol + if (tropLev(i) /= NOTFOUND) then + tropPdf(i, tropLev(i)) = 1._r8 + tropFound(i) = 1._r8 + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + end if + end do + + call outfld('TROPP_P', tropP(:ncol), ncol, lchnk) + call outfld('TROPP_T', tropT(:ncol), ncol, lchnk) + call outfld('TROPP_Z', tropZ(:ncol), ncol, lchnk) + call outfld('TROPP_DZ', tropDZ(:ncol, :), ncol, lchnk) + call outfld('TROPP_PD', tropPdf(:ncol, :), ncol, lchnk) + call outfld('TROPP_FD', tropFound(:ncol), ncol, lchnk) + + + ! Find the tropopause using just the cold point algorithm. + call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE) + + tropPdf(:,:) = 0._r8 + tropFound(:) = 0._r8 + tropDZ(:,:) = fillvalue + + do i = 1, ncol + if (tropLev(i) /= NOTFOUND) then + tropPdf(i, tropLev(i)) = 1._r8 + tropFound(i) = 1._r8 + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + end if + end do + + call outfld('TROPF_P', tropP(:ncol), ncol, lchnk) + call outfld('TROPF_T', tropT(:ncol), ncol, lchnk) + call outfld('TROPF_Z', tropZ(:ncol), ncol, lchnk) + call outfld('TROPF_DZ', tropDZ(:ncol, :), ncol, lchnk) + call outfld('TROPF_PD', tropPdf(:ncol, :), ncol, lchnk) + call outfld('TROPF_FD', tropFound(:ncol), ncol, lchnk) + + + ! If requested, do all of the algorithms. + if (output_all) then + + do alg = 2, TROP_NALG + + ! Find the tropopause using just the analytic algorithm. + call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=alg, backup=TROP_ALG_NONE) + + tropPdf(:,:) = 0._r8 + tropFound(:) = 0._r8 + + do i = 1, ncol + if (tropLev(i) /= NOTFOUND) then + tropPdf(i, tropLev(i)) = 1._r8 + tropFound(i) = 1._r8 + end if + end do + + call outfld('TROP' // TROP_LETTER(alg) // '_P', tropP(:ncol), ncol, lchnk) + call outfld('TROP' // TROP_LETTER(alg) // '_T', tropT(:ncol), ncol, lchnk) + call outfld('TROP' // TROP_LETTER(alg) // '_Z', tropZ(:ncol), ncol, lchnk) + call outfld('TROP' // TROP_LETTER(alg) // '_PD', tropPdf(:ncol, :), ncol, lchnk) + call outfld('TROP' // TROP_LETTER(alg) // '_FD', tropFound(:ncol), ncol, lchnk) + end do + end if + + return + end subroutine tropopause_output +end module tropopause diff --git a/src/physics/cam/unicon.F90 b/src/physics/cam/unicon.F90 new file mode 100644 index 0000000000..01a6c74a9a --- /dev/null +++ b/src/physics/cam/unicon.F90 @@ -0,0 +1,10302 @@ +module unicon + +! ---------------------------------------------------------- ! +! ! +! UNIFIED CONVECTION SCHEME ! +! ! +! ( UNICON ) ! +! ! +! Developed By ! +! ! +! Sungsu Park, AMP/CGD/NCAR, Boulder. ! +! ! +! Aug.2010. ! +! ! +! ---------------------------------------------------------- ! + +use shr_kind_mod, only : r8 => shr_kind_r8, i4 => shr_kind_i4 +use cam_history, only : outfld +use shr_spfn_mod, only : erfc => shr_spfn_erfc +use time_manager, only : get_nstep +use cam_abortutils, only : endrun +use cam_logfile, only : iulog +use constituents, only : qmin, cnst_get_type_byind, cnst_get_ind, cnst_name +use wv_saturation, only : qsat +use unicon_utils, only : unicon_utils_init, exnf, conden, slope, area_overlap, & + envcon_flux, prod_prep_up, evap_prep_dn, progup_thlqt, & + progup_uv, progup_wu2, compute_dp, buosort_downdraft, & + compute_pdf, compute_epsdelnod, buosorts_uw, findsp_single +#ifdef MODAL_AERO +use modal_aero_data +#endif + +implicit none +private +save + +public :: & + unicon_init, & + compute_unicon + +real(r8) :: xlv ! Latent heat of vaporization +real(r8) :: xlf ! Latent heat of fusion +real(r8) :: xls ! Latent heat of sublimation +real(r8) :: cp ! Specific heat of dry air +real(r8) :: zvir ! rh2o/rair - 1 +real(r8) :: r ! Gas constant for dry air +real(r8) :: g ! Gravitational constant +real(r8) :: p00 ! Reference pressure for exner function +real(r8) :: rovcp ! R/cp + +! -------------------------- ! +! ! +! Define Dynamic Parameters ! +! ! +! -------------------------- ! + +! ---------------------------------- ! +! 3 key parameters : au_base, Ro, mu ! +! ---------------------------------- ! + +integer, parameter :: nseg = 1 ! Number of updraft segments [ # ] +integer, parameter :: inorm = 2 ! Either 1 ( force 'au_base' is preserved ) or 2 (force 'cmfu_base' is preserved) for various nseg. +! integer, parameter :: iprpback = 1 ! Either 1 ( backward differencing ) or 0 ( centered differencing ) or -1 ( previous semi-analytical ) +! ! or -2 ( correct full analytical ) only in 'evap_prep_dn'. +integer, parameter :: iprd_prep = 5 ! -1 : Forward Numerical, 0 : Centered Numerical, 1 : Backward Numerical, + ! -5 : Forward Analytical, 10 : Centered Analytical (not available yet), 5 : Backward Analytical (Part.II Paper) +integer, parameter :: ievp_prep = 1 ! -1 : Forward Numerical, 0 : Centered Numerical, 1 : Backward Numerical (Part.II Paper) + ! -5 : Forward Analytical, 10 : Centered Analytical (not available yet), 5 : Backward Analytical (not available yet) +integer, parameter :: nacc = 1 ! Number of accretion iterations [ # ]. Can be any integer n_icc >=1. +integer, parameter :: niter = 1 ! Number of whole iterations [ # ]. Should be 1 or 2. +logical, parameter :: dbsort_con = .false. ! If .true. (.false.), do continuous (discontinuous) downdraft buoyancy sorting. .false. is the previous default. + ! This is applied only for downdraft buoyancy sorting, not the buoyancy sorting of convective updraft that generates + ! the mixing downdraft. That is, the generation (or source) of mixing downdraft is still done by using + ! previous default method using 'ithv_minE, mu_mix, offset_minE' specified in the below parameter sentences. +integer, parameter :: ithv_minE = 1 ! If 1 ( -1 ), do buoynacy sorting ( both updraft and downdraft ) using 'thv_minE' ( thvl_minE ). +real(r8), parameter :: mu_mix = 0.5_r8 ! Minimum downdraft = 0 <= mu <= 1 = Maximum Downdraft. Due to the displacement of interface, it may be set to 1. + ! In order to deepen PBL, we should use the largest value 1. + ! For mixing downdraft. +real(r8), parameter :: mu_top = 0.5_r8 ! For top downdraft. +real(r8), parameter :: mu_area = 0.5_r8 ! For area-velocity downdraft. + +real(r8), parameter :: offset_minE = 0._r8 ! Final 'thv_minE = thv_minE from mu + offset_minE'. Same for thvl_minE. [K]. Set 'offset_minE < 0' to reduce downdraft. + +real(r8), parameter :: epsz_dn = 0.e-4_r8 ! Lateral entrainment rate of downdraft [ 1 / z ]. 5.e-5 = R:1000 [m], 1.e-4 = R:500 [m], 2.e-4 = R:250 [m]. +real(r8), parameter :: delz_dn = 0.e-4_r8 ! Lateral derainment rate of downdraft [ 1 / z ]. 5.e-4 = R:100 [m], 1.e-3 = R:50 [m], 2.e-3 = R:25 [m]. + ! Jul.10.2011. These two are very impportant in controlling the properties of detrained airs at surface. + ! From ARM95, too small ( even 5.e-4 ) value produced too dry and cold detrained airs at surface. It seems that + ! I should at least use 1.e-3. + +real(r8), parameter :: eps_wk = 0.e-5_r8 ! Lateral entrainment rate from non-wake to wake area within PBL [ 1 / s ] +real(r8), parameter :: del_wk = 0.e-5_r8 ! Lateral derainment rate from wake to non-wake area within PBL [ 1 / s ]. 2.32e-4 is 3hr when awk_PBL = 0.5. + ! Previous study used 0. + ! This is valid only for below 'int_del_wk = 0'. + +integer, parameter :: i_budget_coldpool = 6 ! If 0 (1, 2), use budget-inconsistent A068j ( budget consistent with M^j_U=0, budget consistent with M^j_G=0 ) cold pool formula. + ! If 3, use clevely approximately budget consistent modified from '0' option ( ** This '3' is the best ** ) + ! If 4, budget-inconsistent A068j but with M^j_G=0 ( ** This is for sensitivity simulation for writing paper ). + ! If 5, use clevely approximately budget consistent method with with M^j_G=0 ( ** This '5' is the another best ** ) + ! If 6, use clevely approximately, budget consistent, raw cold pool formula modified from '3' option ( ** This '6' is the best ** ) +integer, parameter :: i_energy_coldpool = 1 ! If 2 (1, 0), use the full energy-consistent (partially consistent, previous default) cold pool formula. +real(r8), parameter :: eps_wk0 = 0.e-5_r8 ! Lateral entrainment rate from non-wake to wake area within PBL [ 1 / s ]. Used only when i_energy_coldpool = 1. +real(r8), parameter :: del_wk0 = 0.e-5_r8 ! Lateral derainment rate from wake to non-wake area within PBL [ 1 / s ]. Used only when i_energy_coldpool = 1. + ! This must be positive to generate organized flow. + ! 5 hr = 5.56e-5, 6 hr = 4.63e-5, 7 hr = 3.97e-5, 8 hr = 3.47e-5, 9 hr = 3.09e-5, 10 hr = 2.78e-5, + ! 15 hr = 1.85e-5, 20 hr = 1.39e-5, 1 day = 1.16e-5 +real(r8), parameter :: b1 = 15.0_r8 ! Multiplication factor for decorrelation time scale of meso-scale TKE. No unit. + ! This 'b1' is used only when 'i_energy_coldpool = 2' is chosen. + +integer, parameter :: int_del_wk = 0 ! If 1 (0), use internally computed 'del_wk_eff = c_del_wk * tmp1 * awk_PBL * cmf_u(kpblhm)' (specified del_wk above ), + ! But above eps_wk is still used in any cases. + ! Note that '0 <= c_del_wk <= 1' which is specified below. + ! Hopely, this will have an impact to retard the diurnal cycle of convective precipitation over land. + ! CAUTION : Since analytical integration is performed, not only 'del_wk_eff' but also the + ! format of 'taui,_orgforce' should be changed together. Thus, below option of 'int_del_wk .eq. 1' + ! is incomplete at this stage. This should be refined later. + +real(r8), parameter :: c_del_wk = 0._r8 ! When 'int_del_wk = 1' above, 'del_wk_eff = c_del_wk * tmp1 * awk_PBL * cmf_u(kpblhm)'. + ! Note that '0 <= c_del_wk <= 1'. + ! This is valid only when int_del_wk = 1. + +integer, parameter :: icudist_tail = 0 ! If 0 ( 1 ), use whole ( tail ) distribution for cumulus updrafts. + ! 0 : Good to simulate CIN stabilizing effect. 1 : Simulate only strong updrafts and so conceptually attractable. + ! But '1' also produces negative updraft buoyancy near cloud base. If 1, we may need to use larger Ro if sigmaR = 0. + ! In general, '1' produces non-better results, such as not to good and unstable u,v profile. Thus, recommended to use 0. + ! Feb.08.2013. I should always choose 'icudist_tail = 0' because 'inorm = 2' is only supported for icudist_tail = 0. + +real(r8), parameter :: au_base_min_ocn = 0.045_r8 ! Updraft fractional area at the launching interface [ 0 - 0.5 ] when org = 0. +real(r8), parameter :: au_base_max_ocn = 0.045_r8 ! Updraft fractional area at the launching interface [ 0 - 0.5 ] when org = 1. +real(r8), parameter :: au_base_min_lnd = 0.03_r8 ! Updraft fractional area at the launching interface [ 0 - 0.5 ] when org = 0. +real(r8), parameter :: au_base_max_lnd = 0.03_r8 ! Updraft fractional area at the launching interface [ 0 - 0.5 ] when org = 1. + +integer, parameter :: iau_base_ocn = 1 ! If '0', use above 'au_base_min,au_base_max' in computing au_base. + ! If '1', use above 'au_base = au_base_min * ( 1._r8 - cuorg * awk_PBL_max )'. In this case only above au_base_min is used. + ! Aug.03.2012. In association with the internal computation of 'cdelta_s,cdelta_w', it is definitely reasonable to use + ! iau_base_ocn = 1 instead of 0. +integer, parameter :: iau_base_lnd = 1 ! If '0', use above 'au_base_min,au_base_max' in computing au_base. + ! If '1', use above 'au_base = au_base_min * ( 1._r8 - cuorg * awk_PBL_max )'. In this case only above au_base_min is used. + ! Aug.03.2012. In association with the internal computation of 'cdelta_s,cdelta_w', it is definitely reasonable to use + ! iau_base_lnd = 1 instead of 0. +real(r8), parameter :: cadj_area_ocn = 3._r8 ! The multiplication factor of 'au_base_min_ocn' : overturning adjustment associated with convective organization occurs + ! over the 'cadj_area_ocn * au_base_ocn'. It must be '1 <= cadj_area_ocn <= ( 1. / au_base_min_ocn )'. + ! If cadj_area_ocn = ( 1. / au_base_min_ocn ), overturning adjustment occurs in 'a_U' as in the original formulation. + ! Dec.19.2012. Previous use of cdelta_s_ocn = 4 is equivalent to using cadj_area_ocn = 5 if au_base_min_ocn = 0.05. + ! Apr.05.2012. If this is set to be too small (e.g., 1 or 2), the model crashes as expected. +real(r8), parameter :: cadj_area_lnd = 3._r8 ! The multiplication factor of 'au_base_min_lnd' : overturning adjustment associated with convective organization occurs + ! over the 'cadj_area_lnd * au_base_lnd'. It must be '1 <= cadj_area_lnd <= ( 1. / au_base_min_lnd )'. + ! If cadj_area_ocn = ( 1. / au_base_min_lnd ), overturning adjustment occurs in 'a_U' as in the original formulation. + ! Dec.19.2012. Previous use of cdelta_s_lnd = 8 is equivalent to using cadj_area_lnd = 5 if au_base_min_lnd = 0.025. + ! Apr.05.2012. If this is set to be too small (e.g., 1 or 2), the model crashes as expected. + +integer, parameter :: icridis = 1 ! If '1', use internal 'cridis = rlc * cush', but if '0', use specified 'cridis = cridis_in'. + ! In order to impose positive feedback as in uwshcu, recommend to use '1' with the corresponding setting of 'rlc'. + ! Mar.11.2011. Since we are using multiple plume, 'cush' is meaningless and so good to use 'icridis = 0' +real(r8), parameter :: rlc = 0.15_r8 ! Critical distance for updraft buoyancy sorting [ 0 - 1 ]. Critical distance = rlc * cush. + ! Active only when icridis = 1. If rlc = -1._r8, use 'cridis = dz_m'. + ! May.16.2011. From BOMEX L30/L80, this 'rlc = -1' was clearly shown to be the source of resolution sensitivity. + ! Especially, when 'cuorg' was very small non-zero, this 'rlc = -1' showed very strange sensitivity + ! in the BOMEX L80 simulation. + ! Thus, I MUST NOT USE 'rlc = -1.' in any case. + ! However, in order to impose a positive feedback from shallow to deep convection ( i.e., less mixing + ! for deep convective cases ), it is good not to use 'cridis_in = 1.e8' but to use 'icridis = 1' and + ! 'rlc = 0.1' etc. Thus, from May.16.2011 today, I must use 'icridis = 1 & rlc = 0.1 etc'. +real(r8), parameter :: cridis_in = 1.e8_r8 ! Critical distance for updraft buoyancy sorting [ m ]. Default was 1.e8. + ! Active only when icridis = 0. +integer, parameter :: i_downloading = 0 ! If '1' ( '0' ), include ( exclude ) precipitating-condensate-loading in computing the buoyancy of convective downdraft. + ! This will help to increase downdraft vertical velocity. + ! Oct.27.2011. Restored to zero following the '016' case. +real(r8), parameter :: vfall_rain = 1.e1_r8 ! Fall speed of rain droplet [ m/s ]. This is used for computing (1) rain mixing ratio and (2) evaporation time scale + ! of convective rain within environment in each layer for computing tkePBLorgEV. +real(r8), parameter :: vfall_snow = 1.e1_r8 ! Fall speed of snow droplet [ m/s ]. This is used for computing (2) snow mixing ratio and (2) evaporation time scale + ! of convective snow within environment in each layer for computing tkePBLorgEV. + +real(r8), parameter :: prepminPBLH_org = 0.0_r8 ! Minimum precipitation flux at the PBL top height interface required for initiating convective organization [ mm/day ]. + ! This corresponds to 'individual' updraft segment, not the whole mean of various updrafts. + ! This should be carefully defined not to be sensitive to the choice of 'nseg'. + ! In order to completely remove the sensitivity to nseg, this should be set to zero in principle. + ! Setting this value to be positive (regardless of how small it is) will result in the sensitivity to nseg. + ! Feb.06.2013. Now, without having sensitivity to nseg, we can use small positive value for this with one line modification + ! in the main program. See the main program part with 'prepminPBLH_org'. + +logical, parameter :: iorg_adv = .true. ! If .true. (.false.), advect (do not advect) horizontal heterogeneity information associated with organization. + +logical, parameter :: orgfeedback_off = .false. ! If .true. (.false.), turn-off (turn-on) convective organization. Default is .false. + ! This switch with 'false' is used for doing sensitivity simulation without convective organization feedback. + +real(r8), parameter :: norm_sgh = 1.e3_r8 ! Normalization height for computing 'a_oro = sgh30 / norm_sgh' [ m ] +real(r8), parameter :: a_oro_max = 0._r8 ! Maximally allowed forbidden area by surface orography [ fraction ] + ! Set this to be zero if I want to turn-off the orographic effect. +real(r8), parameter :: awk_PBL_min = 0.05_r8 ! Minimum wake area used only for computing 'eps_wk_eff,del_wk_eff' to allow initial development of wake [fraction] > 0. + ! This should be set to be positive in order to allow wake development for a given set of non-zero 'eps_wk,del_wk'. + ! If we set 'eps_wk = del_wk = 0' in the parameter sentence, this does not do anything. + ! Sep.16.2011. This should be appropriately set such that it prevents the development of weak wake but allows + ! the development of reasonably strong wake. By doing this, we may be able to simulate diurnal cycle + ! very well - my impression is that we can control diurnal cycle by appropriately chosing + ! (1) 'awk_PBL_min', + ! (2) 'delta_thv_wc' + ! (3) 'sigmaR_min_lnd', 'sigmaR_max_lnd', + ! (4) 'au_base_max' , 'au_base_max' + ! (5) 'iorg_detrain' + ! If awk_PBL = 0.05 ( 0.1, 0.5 ), then 'awk_PBL / ( 1 - awk_ PBL )' = 21, 11, 4. +real(r8), parameter :: cdrag = 1.5e-3_r8 ! Surface drag coefficient for computing damping time scale of wake within PBL [ no unit ] + ! Sep.16.2011. Since this should also reflect the neglected dffect of small entrainment flux at the PBL top + ! in the wake area due to enhanced stratification at the PBL top, we should use smaller value + ! than the typical allowed value of ~ 1.5e-3. +real(r8), parameter :: delta_thv_wc = -0.1_r8 ! Critical thv difference between 'wake' and 'grid-mean' averaged over the PBL in order to be identified as the 'wake'. + ! Must be negative value. [ K ]. This is a general wake selection parameter. + ! The 'wake' with thv offset less than this value ( e.g., -0.05 K ) will be identified as 'non-wake'. + ! Sep.12.2011. Currently '-0.01' produces the best results. The '-0.05' produced too small 'cuorg' and unreasonably + ! large wake spreading velocity. Thus, let's use '-0.01'. +real(r8), parameter :: kw_omega = 1.414_r8 ! Control 'sigma_w = kw_omega * sqrt(tke_omega)'. + ! Sep.22.2011. Use 0.82 assuming isotropic meso-scale turbulence similar to kw. +real(r8), parameter :: kstar = 0.1_r8 ! Compute tke_omega = kstar * tke_omega_max. In principle, 0 < kstar < 1. + ! By setting zero, we can turn-off density current parameterization on delta_w_PBL, i.e., delta_w_PBL = 0. + ! Oct.27.2011. Set to the kstar = 1 instead of 0.5. + ! Aug.03.2012. In association with the internally computed 'cdelta_s,cdelta_w', I can use more + ! reasonably smaller values ( 0.05, 0.1 or 0.2 ) for kstar. + +integer, parameter :: iorg_ent = 1 ! If '1', use the detrained airs from previous time step as part of environmental airs for lateral mixing. + ! If '0', use the mean environmental airs at the current time step for lateral mixing. +integer, parameter :: iorg_detrain = 1 ! Choose the detrained airs that will be used for organized entrainment at the next time step. Default was 1. + ! This switch is active only when the above 'iorg_ent = 1'. + ! '1' : Detrained Updraft + Detrained Downdraft + ! '2' : Detrained Updraft + ! '3' : Detrained Downdraft + ! '4' : Updraft + ! '5' : Detrained Updraft + Detrained Downdraft + Updraft + ! '6' : Detrained Updraft + Updraft + ! '7' : Detrained Downdraft + Updraft + +integer, parameter :: i_detrain = 1 ! If '0' : Convectively detrained air contains mixing environmental airs (previous old). This cause inconsistency between + ! flux-convergence and subsidence-detrainment formula. + ! If '1' : Convectively detrained air is defined only using convective updraft (not with mixing environmental air) and convective downdraft airs + ! This impose a full constency between 'flux-convergence' and 'subsidence-detrainment' formula. + ! It is highly recommended to use '1'. + +real(r8), parameter :: fac_org_ent = 1._r8 ! Scale factor for computing 'org_ent = cuorg * fac_org_ent'. After this, we impose limits [0,1] on org_ent. + ! Active only when iorg_ent = '1'. +real(r8), parameter :: fac_org_rad = 1._r8 ! Scale factor for computing 'org_rad = cuorg * fac_org_rad'. After this, we impose limits [0,1] on org_rad. + +real(r8), parameter :: orp = 1._r8 ! Power for the plume radius associated with organization. 0 < orp. + ! If orp = 1 (0.5, 2), R is a linear (square root, square) function of organization. In order to reduce SWCF over the + ! Panama, I strongly recommend to use 'orp' smaller than 1, e.g., 0.5. + ! Apr.01.2013. If 'orp = -1', use 'sinusoidal' function. + +real(r8), parameter :: Ro_min_ocn = 100._r8 ! Minimum intercept updraft plume radius at surface at alpha = 0 [ m ] + ! This is a default value when org_Rad = 0. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: Ro_max_ocn = 4000._r8 ! Maximum intercept updraft plume radius at surface at alpha = 0 [ m ] + ! This is a default value when org_Rad = 1. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: sigmaR_min_ocn = 100._r8 ! Standard deviation of updraft plume radius ( -infinity < alpha < infinity ) at surface [ m ] + ! This is a default value when org_Rad = 0. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: sigmaR_max_ocn = 100._r8 ! Standard deviation of updraft plume radius ( -infinity < alpha < infinity ) at surface [ m ] + ! This is a default value when org_Rad = 1. + +real(r8), parameter :: Ro_min_lnd = 100._r8 ! Minimum intercept updraft plume radius at surface at alpha = 0 [ m ] + ! This is a default value when org_Rad = 0. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: Ro_max_lnd =10000._r8 ! Maximum intercept updraft plume radius at surface at alpha = 0 [ m ] + ! This is a default value when org_Rad = 1. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: sigmaR_min_lnd = 100._r8 ! Standard deviation of updraft plume radius ( -infinity < alpha < infinity ) at surface [ m ] + ! This is a default value when org_Rad = 0. + ! May.21.2011 : We may use slightly a large value in future. +real(r8), parameter :: sigmaR_max_lnd = 100._r8 ! Standard deviation of updraft plume radius ( -infinity < alpha < infinity ) at surface [ m ] + ! This is a default value when org_Rad = 1. + ! Aug.15.2011. Only this parameter is doubled compared to the ocean to compensate for the + ! relative small value of convective organization over the land. + +real(r8), parameter :: Ro_eps0 = 25._r8 ! Minimum updraft plume for computing mixing rate eps0 [ m ]. Originally 10 [ m ]. + ! Aug.15.2011. Originally 10 but relaxed to 100 following 008a. +real(r8), parameter :: eta2 = 0.1_r8 ! Frac. of convective precipitation evaporated within downdraft (=ovc(a_p,a_d)/a_p) [ 0 (zero) - 1 (whole precipitation flux) ] + ! In order to allow evaporation within environment, good to use eta2 < 1. Recommend to use eta2 = 0.5 if specified. + ! Feb.08.2013. Since precipitation area is not necessarily coinciding with downdraft area (=ovc(a_p,a_d)/a_p), this value + ! should be smaller than 1. For example, eta2 = 0.5 seems to be more reasonable choice that 0.99. + ! Apr.05.2013. Larger 'eta2' reduce MJO noise but increases PREH2O. +real(r8), parameter :: beta2 = 1.0_r8 ! Tilting parameter of convective updraft plume with height [ 0 (minimum tilting) - 1 (maximum tilting) ] + ! This control overlappings between 'evaporation ( or precipitation ) area' and 'wake area'. + ! Sep.13.2011. In principle, we can ( should ) set 'beta1 = beta2' since the same physical process is + ! controlling both 'beta1' and 'beta2'. + ! In future, we can set this as a function of low-level wind shear. + ! Apr.25.2012. This is nothing to do with the choice of 'i_ovp' above. Only 'beta1' is related to 'i_ovp = 0'. + +real(r8), parameter :: beta2_st = 0.0_r8 ! Same as the above 'beta2' but for the stratiform precipitation part. + ! Aug.08.2013. Overlapping parameter between 'stratiform evaporation area' and 'cold-pool area' + ! 0 (random overpap) <= beta2_st <= 1 (maximum overlap) + +real(r8), parameter :: sigma_wo = 0.0_r8 ! Background value as 'sigma_w = sigma_wo + kw * sqrt(tkes)'. Should be small positive value. > 0. + ! Oct.16.2011. This is designed to improve the timing of diurnal cycle of precipitation. + ! For obtaining the desirable effect, this should be accompanied by the use of smaller kw. + + +real(r8), parameter :: kw_min_ocn = 0.35_r8 ! Control 'sigma_w = sigma_wo + kw * sqrt(tkes)' when org = 0 over ocean. +real(r8), parameter :: kw_max_ocn = 0.35_r8 ! Control 'sigma_w = sigma_wo + kw * sqrt(tke1)' when org = 1 over ocean. +real(r8), parameter :: kw_min_lnd = 0.35_r8 ! Control 'sigma_w = sigma_wo + kw * sqrt(tkes)' when org = 0 over land. +real(r8), parameter :: kw_max_lnd = 0.35_r8 ! Control 'sigma_w = sigma_wo + kw * sqrt(tke1)' when org = 1 over land. + +real(r8), parameter :: PGFc_up = 0.9_r8 ! Effect of horizontal PGF on the vertical change of updraft horizonal momentum [ 0 - 1 ] +real(r8), parameter :: PGFc_dn = 0.9_r8 ! Effect of horizontal PGF on the vertical change of downdraft horizonal momentum [ 0 - 1 ] + +integer, parameter :: mclimit = 1 ! If '1' ( '0' ), impose (not impose ) 'ql + qi > criqc' at the top interface after precipitation fall-out. + ! This is only valid when microcu = 1 above. + +real(r8), parameter :: caer = 0.15_r8 ! Wet scavenging efficiency of aerosols within convective updraft [ no unit or fraction ] ( 0 < caer < 1 ). + +real(r8), parameter :: criqc_lnd = 6.5e-4_r8 ! Critical in-cumulus LWC for the formation of precipitation over land [ kg / kg ]. UWShCu used 7.e-4. + ! Active when microcu = 0 or 1 + ! Apr.11.2012. Land-Sea contrast is added to consider aerosol effects. + ! From ARM97, this value over land is definitely smaller than over ocean. +real(r8), parameter :: criqc_ocn = 6.5e-4_r8 ! Critical in-cumulus LWC for the formation of precipitation over ocean [ kg / kg ]. UWShCu used 7.e-4. + ! Active when microcu = 0 or 1 + ! Apr.11.2012. Land-Sea contrast is added to consider aerosol effects. + ! From TOGAII, this value over ocean is definitely larger than over land. +real(r8), parameter :: c0_ac_lnd = 1.0e-3_r8 ! Auto-conversion efficiency of cloud liquid ( ice ) to rain ( snow ) over land. + ! No unit between 0 and 1 (UWShCu) when microcu = 0, or '1 / m' when microcu = 1 ] + ! Active only when microcu = 0 or 1, both of them are vertical-resolution insensitive + ! if microcu = 0 (1) is used with upward (centered) computation as in the current code. + ! When microcu = 0, 0<= c0_ac <=1 where UWShCu uses 1. + ! When microcu = 1, in CAM5.1, c0_ac = 0.0059 ( LAND ) and 0.0450 ( OCEAN ) + +real(r8), parameter :: c0_ac_ocn = 1.0e-3_r8 ! Auto-conversion efficiency of cloud liquid ( ice ) to rain ( snow ) over ocean. + ! No unit between 0 and 1 (UWShCu) when microcu = 0, or '1 / m' when microcu = 1 ] + ! Active only when microcu = 0 or 1, both of them are vertical-resolution insensitive + ! if microcu = 0 (1) is used with upward (centered) computation as in the current code. + ! When microcu = 0, 0<= c0_ac <=1 where UWShCu uses 1. + ! When microcu = 1, in CAM5.1, c0_ac = 0.0059 ( LAND ) and 0.0450 ( OCEAN ) + +real(r8), parameter :: kevp_rain_dn_lnd = 2.e-5_r8 ! Evaporation efficiency of rain flux within downdraft over land [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_snow_dn_lnd = 2.e-5_r8 ! Evaporation efficiency of snow flux within downdraft over land [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_rain_lnd = 2.e-5_r8 ! Evaporation efficiency of rain flux within environment over land [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_snow_lnd = 2.e-5_r8 ! Evaporation efficiency of snow flux within environment over land [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. + +real(r8), parameter :: kevp_rain_dn_ocn = 2.e-5_r8 ! Evaporation efficiency of rain flux within downdraft over ocean [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_snow_dn_ocn = 2.e-5_r8 ! Evaporation efficiency of snow flux within downdraft over ocean [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_rain_ocn = 2.e-5_r8 ! Evaporation efficiency of rain flux within environment over ocean [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. +real(r8), parameter :: kevp_snow_ocn = 2.e-5_r8 ! Evaporation efficiency of snow flux within environment over ocean [ ( kg m^-2 s^-1 )^(-1/2) s^-1 ]. UWShCu used 1.e-6. + +real(r8), parameter :: c0 = 0.2_r8 ! For fractional mixing rate of eps0 when inverse-R formula is used [ no unit ] +integer, parameter :: i_eps0 = 1 ! Parameter for eps0 : + ! '0' : The original ramped eps0 as a function of ql_u + qi_u. + ! '1' : Evaporative enhancement of mixing as a function of 'ql_u + qi_u' and 'rh_eg'. + ! '2' : The full eps0 = c0 / R / eeps following laboratory experiment. +real(r8), parameter :: cevpeps0 = 1.0_r8 ! Evaporative enhancement of mixing. This is valid if i_eps0 = 0 or 1 [ no unit ] + ! If 'i_eps0 = 0' : 1 / 3 / 5 ( 1 maybe optimum ) + ! If 'i_eps0 = 1' : 5 / 10 / 15 ( 10 maybe optimum ) + +integer, parameter :: i_dnmixing = 0 ! If '0' ( '1', '2', '3' ), convective downdraft is mixed with mean environmental air ( + ! '1' : detrained airs at the previous time step, + ! '2' : updraft at the same current time step, + ! '3' : below PBL top, mix with 'wake' airs but above PBL top, mix with + ! the same mixing environmental airs as convective updraft ). + ! Aug.31.2011. In association with wake parameterization, I added '3' option. + ! However, it does not consider the amount of available mixing environmental + ! airs and 'wake' airs in computation. This is approximation but + ! this '3' is probably the most realistic approach even though it involves + ! an inevitable approximation. + ! Nov.15.2011. In addition, only some downdrafts falls into wake area. Thus, it is good to + ! use i_dnmixing = 0. + ! Sep.15.2011. Recommend to use '0', i.e., mean environmental airs for convective downdraft as opposed to convective updraft. + +real(r8), parameter :: rbuoy_min = 0.33_r8 ! Minimum Buoyancy coefficient [ no unit ]. Default was 0.37. + ! Aug.18.2011. Originally it was 0.33 but restored to 0.37 based on my previous LES analysis. +real(r8), parameter :: rbuoy_max = 1.00_r8 ! Maximum Buoyancy coefficient [ no unit ]. Default was 0.37. + ! Aug.18.2011. Originally it was 1 but restored to the value of 0.37 same as rbuoy_min. + ! This is for enhancing vertical velocity perturbation when org is developed, so that deep convection is well developed. + ! It might be important to use the same value for rbuoy_min and rbuoy_max to obtain the effect of reasonable org. +real(r8), parameter :: rdrag = 2.0_r8 ! Drag coefficient [ no unit ] +real(r8), parameter :: rjet = 0.0_r8 ! Jet coefficient associated with detrainment [ 0 - 1, no unit ]. 0 : No jet effect, 1 : Maximum jet effect. +real(r8), parameter :: R_buo = 100._r8 ! Scaling updraft plume radius where 0 < a(R)=0.5786 <=1. + ! Mar.27.2012. This is added on this day. +real(r8), parameter :: xc_min = 0._r8 ! Minimum critical mixing fraction from the buoyancy sorting. + ! Oct.16.2011. This must be set to be a very small positive value when i_eps0 = 1 is chosen. 1.e-3_r8. [ 0-1 ]. + ! Aug.18.2011. Originally it was 0.15 but is reduced down to 0.1. In principle, I can use any positive value even small. +real(r8), parameter :: xc_max = 1._r8 ! Maximum critical mixing fraction from the buoyancy sorting. Default = 1 [ 0-1 ]. + ! Aug.18.2011. Originally 0.85 but restored to 1.0 to remove any unclear limitation. + +real(r8), parameter :: droprad_liq = 10.e-6_r8 ! Effectie droplet radius of detrained liquid [ m ] +real(r8), parameter :: droprad_ice = 85.e-6_r8 ! Effectie droplet radius of detrained ice [ m ] + +real(r8), parameter :: density_liq = 997._r8 ! Density of cloud liquid droplets [ kg/m3 ] +real(r8), parameter :: density_ice = 500._r8 ! Density of cloud ice crystals [ kg/m3 ] + +real(r8), parameter :: droprad_rain = 10.e-6_r8 ! Effectie droplet radius of rain [ m ] +real(r8), parameter :: droprad_snow = 85.e-6_r8 ! Effectie droplet radius of snow [ m ] + +real(r8), parameter :: density_rain = 1000._r8 ! Density of rain [ kg/m3 ] +real(r8), parameter :: density_snow = 250._r8 ! Density of snow [ kg/m3 ] + +real(r8), parameter :: epsz0_max = 0.05_r8 ! Maximum effective mixing rate allowed: (M(p+dp)/M(p)-1)/dp = (exp(eps0*dp)-1)/dp <= (epsz0_max/rho/g) [1/m]. + ! Note that this has a unit of [1/m] not [1/Pa] since I should use 'densitiy' in the main body. + ! This is added on Nov.18.2013, replacing the above fmix_frac. + ! This value is computed by using the following formula of + ! epsz0_max [1/m] ~ 0.5 / Ro_minimum [m] + ! This may be potentially associated with 'Ro_eps0' but let's use 'epsz0_max' separately. + ! This is consistently applied both for convective updraft and downdraft, preventing the mass flux from + ! hugely increasing during vertical displacement in any layer. +integer, parameter :: exp_cmf = 1 ! If 1 (2,3), do original exponential ( simplified linear, combination ) computation of vertical variation of cmf_u and cmf_d. + ! If this is set to 2, above 'fmix_max, fmix_frac' are not used. + ! This linear option is critical important in the coarse resolution simulation to prevent unreasonably large + ! exponential growth of mass flux and so model crash. This inevitably induces inconsistency with the + ! corresponding computation of 'thl,qt,u,v,q' and 'w' (so that affect vertical evolution of plume radius R), + ! but in order to use physically reasonable single 'eps0' in all the vertical prognostic equations with stable state, + ! the use of this linear option is very important. + ! Jan.30.2013. With a new formulation on this day on imposing 'eps0(m), eps_dn, del_dn' with fmix_frac = ln(10) = 2.3026, + ! I 'must' use exp_cmf = 1 ( full physical exponential function ) for full physical consistency of the model. + ! Feb.06.2013. Always choose 'exp_cmf = 1' and removes this option. +real(r8), parameter :: alpha_max = 2._r8 ! Upper limit of mixing parameter of updraft mass flux PDF [ no unit ] +real(r8), parameter :: cmfmin = 1.e-5_r8 ! Minimum updraft mass flux for identification as the non-detached updraft at the top interface [ kg / s / m^2 ] + +real(r8), parameter :: au_max = 1.e-1_r8 ! Maximum updraft fractional area [ no unit ] +real(r8), parameter :: wumin = 1.e-1_r8 ! Minimum updraft vertical velocity > 0 [ m / s ] +real(r8), parameter :: wumax = 20._r8 ! Maximum updraft vertical velocity > 0 [ m / s ] + +real(r8), parameter :: wdmin = 1.e-1_r8 ! Minimum downdraft vertical velocity > 0 [ m / s ]. This also influences evaporation within downdraft. May increase to 0.3. + +real(r8), parameter :: nonzero = 1.e-20_r8 ! Non-zero minimal positive constant [ no unit ] +real(r8), parameter :: unity = 0.9999_r8 ! Constant close to 1 but smaller than 1 [ no unit ] +real(r8), parameter :: thv_ref = 300._r8 ! Reference virtual potential temperature for buoyancy computation [ K ] + +integer, parameter :: iup_par = 4 ! Partitioning of convective surface updraft flux into other layers + ! 1 : Lowest Layer, or equivalently, No Partitioning + ! 2 : Minimum of 'PBL Top' and 'Cumulus Top' + ! 3 : PBL Layers ( this degrades diurnal cycle ) + ! 4 : Cumulus Layers ( ** the best option ** ) + ! 5 : Entire Layers + ! Added on Mar.20.2014 as the most general functionality. + +integer, parameter :: idn_par = 1 ! Partitioning of convective surface downdraft flux into other layers + ! 1 : Lowest Layer, or equivalently, No Partitioning + ! 2 : Minimum of 'PBL Top' and 'Cumulus Top' ( ** the best option both for cold-pool and plumes in stable env. ** ) + ! 3 : PBL Layers + ! 4 : Cumulus Layers + ! 5 : Entire Layers + ! Added on Mar.20.2014 as the most general functionality. + +integer, parameter :: islope_on_thlqttr = 1 ! If 1 ( 0 ), turn-on ( off ) environmental profile reconstruction of 'thl, qt and tracers' in each layer. + ! Strongly recommend to use 0 to obtain stable results and prevent unreasonable reversal of environmental buoyancy at the interface. + ! In the CAM5, simulation with '1' cuases model crash due to FINSDP_SINGLE in unicon.F90 --> But the cause was not due to this. + ! Apr.03.2011 : I should do sensitivity test on this using BOMEX. + ! Sep.11.2011 : For full consistency with symmetric turbulence transport scheme, I must use 'islope_on_thlqttr = 1 ( not 0 )' + ! without no question in this asymmetric turbulence transport scheme. +integer, parameter :: islope_on_uv = 1 ! If 1 ( 0 ), turn-on ( off ) environmental profile reconstruction of 'u,v' in each layer. + ! Recommend to use 0 to reasonably treat diabatic 'PGFc' effect similar to UW. + ! Apr.03.2011 : I must use '1' for treating PGFc effect. + ! Sep.11.2011 : For full consistency with symmetric turbulence transport scheme, I must use 'islope_on_uv = 1 ( not 0 )' + ! without no question in this asymmetric turbulence transport scheme. +integer, parameter :: iflux_env = 1 ! Use the UW ( 0 ) or Park's reconstructed environmental profile ( 1 ) for flux computation. + ! Recommend to always use 1 since it is conceptually reasonable. + ! Sep.11.2011. For full conceptual consistency and consistent performance, I must absolutely use 'iflux_env = 1'. +integer, parameter :: kiss = 0 ! Launching interface : 0 ( 'surface' ) or 1 ( next interface ). In order to reduce model sensitivity to the thickness of + ! the lowest layer, recommend to choose 0, which should be accompanied by sigfac = 1. + ! Sep.11.2011. For full conceptual consistency and coherence with 'ipartition = 1' choice above, + ! I must absolutely use 'kiss = 0'. +real(r8), parameter :: sigfac = 1.0_r8 ! Reduction of surface flux from the surface to the next interface [ 0-1 ] + ! When kiss = 0, should be 1 but when kiss = 1, choose any reasonable value between [ 0 - 1 ]. + ! Sep.11.2011. Needless to say, I must use 'sigfac = 1._r8' since I will always use kiss = 0. + +!================================================================================================== +contains +!================================================================================================== + +subroutine unicon_init(xlv_in, cp_in, xlf_in, zvir_in, r_in, g_in) + + real(r8), intent(in) :: xlv_in ! Latent heat of vaporization + real(r8), intent(in) :: xlf_in ! Latent heat of fusion + real(r8), intent(in) :: cp_in ! Specific heat of dry air + real(r8), intent(in) :: zvir_in ! rh2o/rair - 1 + real(r8), intent(in) :: r_in ! Gas constant for dry air + real(r8), intent(in) :: g_in ! Gravitational constant + + call unicon_utils_init(& + xlv_in, cp_in, xlf_in, zvir_in, r_in, & + g_in, droprad_liq, droprad_ice, density_liq, density_ice, & + mclimit) + + xlv = xlv_in + xlf = xlf_in + xls = xlv + xlf + cp = cp_in + zvir = zvir_in + r = r_in + g = g_in + p00 = 1.e5_r8 + rovcp = r/cp + +end subroutine unicon_init + +!================================================================================================== + +subroutine compute_unicon( mix , mkx , iend , ncnst , dt , & + ps0_in , zs0_in , p0_in , z0_in , dp0_in , dpdry0_in , & + t0_in , qv0_in , ql0_in , qi0_in , tr0_in , & + u0_in , v0_in , ast0_in , tke0_in , bprod0_in , & + kpblh_in , pblh_in , went_in , & + qflx_in , shflx_in , taux_in , tauy_in , aflx_in , & + landfrac_in , sgh30_in , & + am_evp_st_in , evprain_st_in , evpsnow_st_in , & + cush_inout , cushavg_inout , cuorg_inout , & + awk_PBL_inout , delta_thl_PBL_inout , delta_qt_PBL_inout , & + delta_u_PBL_inout , delta_v_PBL_inout , delta_tr_PBL_inout , & + cu_cmfum_out , cu_cmfr_inout , cu_thlr_inout , cu_qtr_inout , cu_ur_inout , cu_vr_inout , & + cu_qlr_inout , cu_qir_inout , cu_trr_inout , & + cu_cmfrd_out , cu_thlrd_out , cu_qtrd_out , cu_urd_out , cu_vrd_out , & + cu_qlrd_out , cu_qird_out , cu_trrd_out , & + am_u_out , qlm_u_out , qim_u_out , & + am_d_out , qlm_d_out , qim_d_out , & + cmf_u_out , slflx_out , qtflx_out , & + qvten_out , qlten_out , qiten_out , trten_out , & + sten_out , uten_out , vten_out , & + qrten_out , qsten_out , & + rqc_l_out , rqc_i_out , rqc_out , rnc_l_out , rnc_i_out , & + rliq_out , precip_out , snow_out , evapc_out , & + cnt_out , cnb_out , cmf_det_out , ql_det_out , qi_det_out , & + lchnk ) + + !---------------------------------------------------! + ! ! + ! The Unified Convection Scheme - UNICON ! + ! Developed by Sungsu Park ! + ! For detailed description, See JAS ! + ! Copyright is owned by Sungsu Park ! + ! ! + !---------------------------------------------------! + + ! --------------------------- ! + ! Main Input-Output variables ! + ! --------------------------- ! + + integer , intent(in) :: lchnk + integer , intent(in) :: mix ! Number of columns + integer , intent(in) :: iend ! Number of columns + integer , intent(in) :: mkx ! k = 1 : Lowest layer, k = mkx : Top layer + integer , intent(in) :: ncnst ! Number of tracers + real(r8), intent(in) :: dt ! Time step in seconds: 2*delta_t [s] + + real(r8), intent(in) :: ps0_in(mix,0:mkx) ! Environmental pressure at the interface [Pa] + real(r8), intent(in) :: zs0_in(mix,0:mkx) ! Environmental height at the interface [m] + real(r8), intent(in) :: p0_in(mix,mkx) ! Environmental pressure at the mid-point [m] + real(r8), intent(in) :: z0_in(mix,mkx) ! Environmental height at the mid-point [m] + real(r8), intent(in) :: dp0_in(mix,mkx) ! Environmental layer pressure thickness [Pa] > 0 + real(r8), intent(in) :: dpdry0_in(mix,mkx) ! Environmental layer dry pressure thickness [Pa] > 0 + real(r8), intent(in) :: u0_in(mix,mkx) ! Environmental zonal wind [m/s] + real(r8), intent(in) :: v0_in(mix,mkx) ! Environmental meridional wind [m/s] + real(r8), intent(in) :: qv0_in(mix,mkx) ! Environmental water vapor specific humidity [kg/kg] + real(r8), intent(in) :: ql0_in(mix,mkx) ! Environmental liquid water specific humidity [kg/kg] + real(r8), intent(in) :: qi0_in(mix,mkx) ! Environmental ice specific humidity [kg/kg] + real(r8), intent(in) :: tr0_in(mix,mkx,ncnst) ! Environmental tracers [ #/kg, kg/kg ] + real(r8), intent(in) :: t0_in(mix,mkx) ! Environmental temperature [K] + real(r8), intent(in) :: ast0_in(mix,mkx) ! Stratiform fractional area at the layer mid-point [ fraction ] + real(r8), intent(in) :: tke0_in(mix,0:mkx) ! TKE at the interface [ m2/s2 ] + real(r8), intent(in) :: bprod0_in(mix,0:mkx) ! Buoyancy production at the interface [ m2/s3 ] + + integer(i4), intent(in) :: kpblh_in(mix) ! Layer index with PBL top in it or at the base interface + real(r8), intent(in) :: pblh_in(mix) ! PBL top height [ m ] + real(r8), intent(in) :: went_in(mix) ! Entrainment rate at the PBL top interface directly from the UW PBL scheme [ m/s ] + real(r8), intent(in) :: qflx_in(mix) ! Upward water vapor flux into atmosphere at surface [ kg/m2/s ] + real(r8), intent(in) :: shflx_in(mix) ! Upward sensible heat flux into atmosphere at surface [ J/m2/s ] + real(r8), intent(in) :: taux_in(mix) ! Upward zonal wind stress into atmosphere at surface [ kg m/s /m2/s ] + real(r8), intent(in) :: tauy_in(mix) ! Upward meridional wind stress into atmosphere at surface [ kg m/s /m2/s ] + real(r8), intent(in) :: aflx_in(mix,ncnst) ! Upward tracer fluxes into atmosphere at surface [ #/m2/s, kg/m2/s ] + + real(r8), intent(in) :: landfrac_in(mix) ! Land Fraction [ fraction ] + + real(r8), intent(in) :: sgh30_in(mix) ! Standard deviation of subgrid topographic height at 30 s horizontal area [ meter ] + ! This 'sgh30' ( not sgh ) is used for the parameterization of tms. + ! Aug.08.2013. Evaporation of stratiform precipitation + real(r8), intent(in) :: am_evp_st_in(mix,mkx) ! Evaporation area of stratiform precipitation [fraction] + real(r8), intent(in) :: evprain_st_in(mix,mkx) ! Grid-mean evaporation rate of stratiform rain [kg/kg/s] >= 0. + real(r8), intent(in) :: evpsnow_st_in(mix,mkx) ! Grid-mean evaporation rate of stratiform snow [kg/kg/s] >= 0. + + real(r8), intent(inout) :: cush_inout(mix) ! Cumulus top height [ m ] + real(r8), intent(inout) :: cushavg_inout(mix) ! Mean cumulus top height weighted by updraft masss flux at surface [ m ] + real(r8), intent(inout) :: cuorg_inout(mix) ! Covective organization parameter [ 0-1 ] + real(r8), intent(inout) :: awk_PBL_inout(mix) ! Wake area within PBL [ 0 - 1 ] + real(r8), intent(inout) :: delta_thl_PBL_inout(mix) ! Difference of thl between off-wake region and grid-mean value averaged over the PBL [ K ] + real(r8), intent(inout) :: delta_qt_PBL_inout(mix) ! Difference of qt between off-wake region and grid-mean value averaged over the PBL [ kg/kg ] + real(r8), intent(inout) :: delta_u_PBL_inout(mix) ! Difference of u between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8), intent(inout) :: delta_v_PBL_inout(mix) ! Difference of v between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8), intent(inout) :: delta_tr_PBL_inout(mix,ncnst) ! Difference of tr between off-wake region and grid-mean value averaged over the PBL [ kg/kg, #/kg ] + + real(r8), intent(out) :: cu_cmfum_out(mix,mkx) ! The amount of mass involved in the updraft buoyancy sorting at the previous time step [ kg/s/m2 ] + real(r8), intent(inout) :: cu_cmfr_inout(mix,mkx) ! The amount of detrained mass from convective updraft and downdraft at the previous time step [ kg/s/m2 ] + real(r8), intent(inout) :: cu_thlr_inout(mix,mkx) ! Mass-flux weighted mean 'thl' of detrained mass from convective updraft and downdraft at the previous time step [ K ] + real(r8), intent(inout) :: cu_qtr_inout(mix,mkx) ! Mass-flux weighted mean 'qt' of detrained mass from convective updraft and downdraft at the previous time step [ kg/kg ] + real(r8), intent(inout) :: cu_ur_inout(mix,mkx) ! Mass-flux weighted mean 'u' of detrained mass from convective updraft and downdraft at the previous time step [ m/s ] + real(r8), intent(inout) :: cu_vr_inout(mix,mkx) ! Mass-flux weighted mean 'v' of detrained mass from convective updraft and downdraft at the previous time step [ m/s ] + real(r8), intent(inout) :: cu_qlr_inout(mix,mkx) ! Mass-flux weighted mean 'ql' of detrained mass from convective updraft and downdraft at the previous time step [ kg/kg ] + real(r8), intent(inout) :: cu_qir_inout(mix,mkx) ! Mass-flux weighted mean 'qi' of detrained mass from convective updraft and downdraft at the previous time step [ kg/kg ] + real(r8), intent(inout) :: cu_trr_inout(mix,mkx,ncnst) ! Mass-flux weighted mean 'tr' of detrained mass from convective updraft and downdraft at the previous time step [ kg/kg ] + + real(r8) :: cu_thvr_inout(mix,mkx) ! Mass-flux weighted mean 'thv' of detrained mass from convective updraft and downdraft at the previous time step [ K ] + real(r8) :: cu_rhr_inout(mix,mkx) ! Mass-flux weighted mean 'rh' of detrained mass from convective updraft and downdraft at the previous time step [ ratio ] + + real(r8), intent(out) :: cu_cmfrd_out(mix,mkx) ! The amount of detrained mass from convective downdraft at the previous time step [ kg/s/m2 ] + real(r8), intent(out) :: cu_thlrd_out(mix,mkx) ! Mass-flux weighted mean 'thl' of detrained mass from convective downdraft at the previous time step [ K ] + real(r8), intent(out) :: cu_qtrd_out(mix,mkx) ! Mass-flux weighted mean 'qt' of detrained mass from convective downdraft at the previous time step [ kg/kg ] + real(r8), intent(out) :: cu_urd_out(mix,mkx) ! Mass-flux weighted mean 'u' of detrained mass from convective downdraft at the previous time step [ m/s ] + real(r8), intent(out) :: cu_vrd_out(mix,mkx) ! Mass-flux weighted mean 'v' of detrained mass from convective downdraft at the previous time step [ m/s ] + real(r8), intent(out) :: cu_qlrd_out(mix,mkx) ! Mass-flux weighted mean 'ql' of detrained mass from convective downdraft at the previous time step [ kg/kg ] + real(r8), intent(out) :: cu_qird_out(mix,mkx) ! Mass-flux weighted mean 'qi' of detrained mass from convective downdraft at the previous time step [ kg/kg ] + real(r8), intent(out) :: cu_trrd_out(mix,mkx,ncnst) ! Mass-flux weighted mean 'tr' of detrained mass from convective downdraft at the previous time step [ kg/kg ] + + ! Formal output variables + + real(r8), intent(out) :: am_u_out(mix,mkx) ! Updraft fractional area [ fraction ] + real(r8), intent(out) :: qlm_u_out(mix,mkx) ! Area-weighted in-cloud LWC within updraft fractional area [ kg / kg ] + real(r8), intent(out) :: qim_u_out(mix,mkx) ! Area-weighted in-cloud IWC within updraft fractional area [ kg / kg ] + + real(r8), intent(out) :: am_d_out(mix,mkx) ! Downdraft fractional area [ fraction ] + real(r8), intent(out) :: qlm_d_out(mix,mkx) ! Area-weighted in-cloud LWC within downdraft fractional area [ kg / kg ] + real(r8), intent(out) :: qim_d_out(mix,mkx) ! Area-weighted in-cloud IWC within downdraft fractional area [ kg / kg ] + + real(r8), intent(out) :: cmf_u_out(mix,0:mkx) ! Upward convective mass flux at the interface [ kg / s / m2 ] + real(r8), intent(out) :: slflx_out(mix,0:mkx) ! Net upward convective flux of liquid static energy [ J / s / m2 ] + real(r8), intent(out) :: qtflx_out(mix,0:mkx) ! Net upward convective flux of total specific humidity [ kg / s / m2 ] + + real(r8), intent(out) :: qvten_out(mix,mkx) ! Tendency of water vapor specific humidity [ kg / kg / s ] + real(r8), intent(out) :: qlten_out(mix,mkx) ! Tendency of liquid water mixing ratio [ kg / kg / s ] + real(r8), intent(out) :: qiten_out(mix,mkx) ! Tendency of ice mixing ratio [ kg / kg / s ] + real(r8), intent(out) :: sten_out(mix,mkx) ! Tendency of dry static energy [ J / kg / s ] + real(r8), intent(out) :: uten_out(mix,mkx) ! Tendency of zonal wind [ m / s / s ] + real(r8), intent(out) :: vten_out(mix,mkx) ! Tendency of meridional wind [ m / s / s ] + real(r8), intent(out) :: trten_out(mix,mkx,ncnst) ! Tendency of tracers [ # / kg / s, kg / kg / s ] + + real(r8), intent(out) :: qrten_out(mix,mkx) ! Production rate of rain by lateral expels of cumulus condensate [kg/kg/s] + real(r8), intent(out) :: qsten_out(mix,mkx) ! Production rate of snow by lateral expels of cumulus condensate [kg/kg/s] + real(r8), intent(out) :: precip_out(mix) ! Precipitation flux at surface in flux unit [ m / s ] + real(r8), intent(out) :: snow_out(mix) ! Snow flux at surface in flux unit [ m / s ] + real(r8), intent(out) :: evapc_out(mix,mkx) ! Evaporation rate of convective precipitation within environment [ kg/kg/s ] + + real(r8), intent(out) :: rqc_out(mix,mkx) ! Production rate of raw detrained LWC+IWC [kg/kg/s] > 0 + real(r8), intent(out) :: rqc_l_out(mix,mkx) ! Production rate of raw detrained LWC [kg/kg/s] > 0 + real(r8), intent(out) :: rqc_i_out(mix,mkx) ! Production rate of raw detrained IWC [kg/kg/s] > 0 + real(r8), intent(out) :: rliq_out(mix) ! Vertical integral of 'rqc_out' in flux unit [m/s] + real(r8), intent(out) :: rnc_l_out(mix,mkx) ! Production rate of raw detrained droplet number of cloud liquid droplets [#/kg/s] > 0 + real(r8), intent(out) :: rnc_i_out(mix,mkx) ! Production rate of raw detrained droplet number of cloud ice droplets [#/kg/s] > 0 + + real(r8), intent(out) :: cnt_out(mix) ! Cloud top interface index ( ki = kpen ) + real(r8), intent(out) :: cnb_out(mix) ! Cloud base interface index ( ki = krel-1 ) + + real(r8), intent(out) :: cmf_det_out(mix,mkx) ! Detrained mass flux only from convective updraft (not from environmental air) and downdraft [ kg / s / m2 ] + real(r8), intent(out) :: ql_det_out(mix,mkx) ! Detrained LWC without mixing with the environment ( flux-convergence & subsidence-detrainment consistent ) [ kg / kg ] + real(r8), intent(out) :: qi_det_out(mix,mkx) ! Detrained LWC without mixing with the environment ( flux-convergence & subsidence-detrainment consistent ) [ kg / kg ] + + ! ------------------------- ! + ! Internal output variables ! + ! ------------------------- ! + + real(r8) :: cmf_out(mix,0:mkx) ! Net upward convective mass flux at the interface [kg/s/m2] + real(r8) :: uflx_out(mix,0:mkx) ! Net upward convective flux of zonal momentum [m/s/s/m2] + real(r8) :: vflx_out(mix,0:mkx) ! Net upward convective flux of meridional momentum [m/s/s/m2] + + real(r8) :: slflx_u_out(mix,0:mkx) ! Upward convective flux of liquid static energy [J/s/m2] + real(r8) :: qtflx_u_out(mix,0:mkx) ! Upward convective flux of total specific humidity [kg/s/m2] + real(r8) :: uflx_u_out(mix,0:mkx) ! Upward convective flux of zonal momentum [kg m/s/s/m2] + real(r8) :: vflx_u_out(mix,0:mkx) ! Upward convective flux of meridional momentum [kg m/s/s/m2] + + real(r8) :: cmf_d_out(mix,0:mkx) ! Downward convective mass flux at the interface [kg/s/m2] + real(r8) :: slflx_d_out(mix,0:mkx) ! Downward convective flux of liquid static energy [J/s/m2] + real(r8) :: qtflx_d_out(mix,0:mkx) ! Downward convective flux of total specific humidity [kg/s/m2] + real(r8) :: uflx_d_out(mix,0:mkx) ! Downward convective flux of zonal momentum [kg m/s/s/m2] + real(r8) :: vflx_d_out(mix,0:mkx) ! Downward convective flux of meridional momentum [kg m/s/s/m2] + + real(r8) :: thl_orgforce_out(mix) ! Total organization forcing generating thl difference between 'non-wake' and 'grid-mean' areas [ K / s ] + real(r8) :: qt_orgforce_out(mix) ! Total organization forcing generating qt difference between 'non-wake' and 'grid-mean' areas [ kg / kg / s ] + real(r8) :: u_orgforce_out(mix) ! Total organization forcing generating u difference between 'non-wake' and 'grid-mean' areas [ m / s / s ] + real(r8) :: v_orgforce_out(mix) ! Total organization forcing generating v difference between 'non-wake' and 'grid-mean' areas [ m / s / s ] + real(r8) :: tr_orgforce_out(mix,ncnst) ! Total organization forcing generating thv difference between 'non-wake' and 'grid-mean' areas [ kg / kg / s or # / kg / s ] + real(r8) :: awk_orgforce_out(mix) ! Total organization forcing generating 'wake area' ( a_wk ) [ 1 / s ] + + ! Below block is for detailed diagnostic output + + real(r8) :: flxrain_out(mix,0:mkx) + real(r8) :: flxsnow_out(mix,0:mkx) + + real(r8) :: thl_orgforce_flx_out(mix) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) :: qt_orgforce_flx_out(mix) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) :: u_orgforce_flx_out(mix) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) :: v_orgforce_flx_out(mix) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) :: awk_orgforce_flx_out(mix) ! PBL top flux-related forcing for wake area [ 1 / s ] + + real(r8) :: thl_orgforce_und_out(mix) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) :: qt_orgforce_und_out(mix) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) :: u_orgforce_und_out(mix) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) :: v_orgforce_und_out(mix) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) :: awk_orgforce_mix_out(mix) ! Lateral-Mixing forcing for wake area [ 1 / s ] + + real(r8) :: thl_orgforce_env_out(mix) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) :: qt_orgforce_env_out(mix) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) :: u_orgforce_env_out(mix) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) :: v_orgforce_env_out(mix) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) :: cmf_d_org_pblh_out(mix) ! Organization-inducing downdraft mass flux at the PBL top interface [ kg / m^2 / s ] + + ! Above block is for detailed diagnostic output + + real(r8) :: taui_thl_out(mix) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' thl [ 1 / s ] + real(r8) :: taui_qt_out(mix) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' qt [ 1 / s ] + real(r8) :: taui_u_out(mix) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' u [ 1 / s ] + real(r8) :: taui_v_out(mix) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' v [ 1 / s ] + real(r8) :: taui_tr_out(mix,ncnst) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' tracers [ 1 / s ] + real(r8) :: taui_awk_out(mix) ! Inverse of damping time scale of the wake area [ 1 / s ] + + real(r8) :: del_org_out(mix) ! Detrainment rate of the cold pool [ 1 / s ] + real(r8) :: del0_org_out(mix) ! Effective detrainment rate of the cold pool [ 1 / s ] + + real(r8) :: slten_u_out(mix,mkx) + real(r8) :: qtten_u_out(mix,mkx) + real(r8) :: uten_u_out(mix,mkx) + real(r8) :: vten_u_out(mix,mkx) + real(r8) :: sten_u_out(mix,mkx) + real(r8) :: qvten_u_out(mix,mkx) + real(r8) :: qlten_u_out(mix,mkx) + real(r8) :: qiten_u_out(mix,mkx) + real(r8) :: trten_u_out(mix,mkx,ncnst) + + real(r8) :: slten_d_out(mix,mkx) + real(r8) :: qtten_d_out(mix,mkx) + real(r8) :: uten_d_out(mix,mkx) + real(r8) :: vten_d_out(mix,mkx) + real(r8) :: sten_d_out(mix,mkx) + real(r8) :: qvten_d_out(mix,mkx) + real(r8) :: qlten_d_out(mix,mkx) + real(r8) :: qiten_d_out(mix,mkx) + real(r8) :: trten_d_out(mix,mkx,ncnst) + + real(r8) :: slten_evp_out(mix,mkx) + real(r8) :: qtten_evp_out(mix,mkx) + real(r8) :: uten_evp_out(mix,mkx) + real(r8) :: vten_evp_out(mix,mkx) + real(r8) :: sten_evp_out(mix,mkx) + real(r8) :: qvten_evp_out(mix,mkx) + real(r8) :: qlten_evp_out(mix,mkx) + real(r8) :: qiten_evp_out(mix,mkx) + real(r8) :: trten_evp_out(mix,mkx,ncnst) + + real(r8) :: slten_dis_out(mix,mkx) + real(r8) :: qtten_dis_out(mix,mkx) + real(r8) :: uten_dis_out(mix,mkx) + real(r8) :: vten_dis_out(mix,mkx) + real(r8) :: sten_dis_out(mix,mkx) + real(r8) :: qvten_dis_out(mix,mkx) + real(r8) :: qlten_dis_out(mix,mkx) + real(r8) :: qiten_dis_out(mix,mkx) + real(r8) :: trten_dis_out(mix,mkx,ncnst) + + real(r8) :: qlten_sub_out(mix,mkx) + real(r8) :: qiten_sub_out(mix,mkx) + + real(r8) :: qlten_det_out(mix,mkx) + real(r8) :: qiten_det_out(mix,mkx) + + real(r8) :: thl_u_out(mix,0:mkx) ! Mass-flux weighted updraft thl [ K ] + real(r8) :: qt_u_out(mix,0:mkx) ! Mass-flux weighted updraft qt [ kg / kg ] + real(r8) :: u_u_out(mix,0:mkx) ! Mass-flux weighted updraft u [ m / s ] + real(r8) :: v_u_out(mix,0:mkx) ! Mass-flux weighted updraft v [ m / s ] + real(r8) :: w_u_out(mix,0:mkx) ! Mass-flux weighted updraft w [ m / s ] + real(r8) :: ql_u_out(mix,0:mkx) ! Mass-flux weighted updraft in-cumulus ql [ kg / kg ] + real(r8) :: qi_u_out(mix,0:mkx) ! Mass-flux weighted updraft in-cumulus qi [ kg / kg ] + real(r8) :: tr_u_out(mix,0:mkx,ncnst) ! Mass-flux weighted updraft tr [ # / kg, kg / kg ] + real(r8) :: wa_u_out(mix,0:mkx) ! Area weighted updraft w [ m / s ] + real(r8) :: qla_u_out(mix,0:mkx) ! Area weighted updraft in-cumulus ql [ kg / kg ] + real(r8) :: qia_u_out(mix,0:mkx) ! Area weighted updraft in-cumulus qi [ kg / kg ] + real(r8) :: a_u_out(mix,0:mkx) ! Updraft fractional area [ fraction ] + real(r8) :: rad_u_out(mix,0:mkx) ! Number weighted effective radius of updraft plumes [ m ] + real(r8) :: num_u_out(mix,0:mkx) ! Number concentration of updraft plumes [ # / m^2 ] + real(r8) :: gamw_u_out(mix,0:mkx) ! Ratio of 'w_u_out / wa_u_out' [ no ] + real(r8) :: thva_u_out(mix,0:mkx) ! Area weighted updraft thv [ K ] + + real(r8) :: a_p_out(mix,0:mkx) ! Convective precipitation area [ fraction ] + real(r8) :: am_evp_out(mix,mkx) ! Convective evaporation area [ fraction ] + real(r8) :: am_pu_out(mix,mkx) ! Overlapping area between convective precipitation and saturated updraft [ fraction ] + real(r8) :: x_p_out(mix,0:mkx) ! Zonal displacement of the precipitation area from the surface [ m ] + real(r8) :: y_p_out(mix,0:mkx) ! Meridional displacement of the precipitation area from the surface [ m ] + real(r8) :: x_um_out(mix,mkx) ! Zonal displacement of the updraft area from the surface [ m ] + real(r8) :: y_um_out(mix,mkx) ! Meridional displacement of the updraft area from the surface [ m ] + + real(r8) :: thl_d_out(mix,0:mkx) ! Mass-flux weighted downdraft thl [ K ] + real(r8) :: qt_d_out(mix,0:mkx) ! Mass-flux weighted downdraft qt [ kg / kg ] + real(r8) :: u_d_out(mix,0:mkx) ! Mass-flux weighted downdraft u [ m / s ] + real(r8) :: v_d_out(mix,0:mkx) ! Mass-flux weighted downdraft v [ m / s ] + real(r8) :: w_d_out(mix,0:mkx) ! Mass-flux weighted downdraft w [ m / s ] + real(r8) :: ql_d_out(mix,0:mkx) ! Mass-flux weighted downdraft in-cumulus ql [ kg / kg ] + real(r8) :: qi_d_out(mix,0:mkx) ! Mass-flux weighted downdraft in-cumulus qi [ kg / kg ] + real(r8) :: tr_d_out(mix,0:mkx,ncnst) ! Mass-flux weighted downdraft tr [ # / kg, kg / kg ] + real(r8) :: wa_d_out(mix,0:mkx) ! Area weighted downdraft w [ m / s ] + real(r8) :: qla_d_out(mix,0:mkx) ! Area weighted downdraft in-cumulus ql [ kg / kg ] + real(r8) :: qia_d_out(mix,0:mkx) ! Area weighted downdraft in-cumulus qi [ kg / kg ] + real(r8) :: a_d_out(mix,0:mkx) ! Downdraft fractional area [ fraction ] + + real(r8) :: thl_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft thl at the interface for each original updraft segment [ K ]. + real(r8) :: qt_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft qt at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: u_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft u at the interface for each original updraft segment [ m / s ]. + real(r8) :: v_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft v at the interface for each original updraft segment [ m / s ]. + real(r8) :: w_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft w at the interface for each original updraft segment [ m / s ]. + real(r8) :: ql_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: qi_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: tr_u_msfc_out(mix,0:mkx,nseg,ncnst,niter) ! Updraft tr at the interface for each original updraft segment [ # / kg, kg / kg ]. + real(r8) :: cmf_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft cmf at the interface for each original updraft segment [ kg / s / m^2 ]. + real(r8) :: a_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft a at the interface for each original updraft segment [ fraction ]. + real(r8) :: num_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft num at the interface for each original updraft segment [ # / m^2 ]. + real(r8) :: rad_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft rad at the interface for each original updraft segment [ m ]. + + real(r8) :: eps0_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft eps0 at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) :: eps_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft eps at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) :: del_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft del at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) :: eeps_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft eeps at the interface for each original updraft segment [ no ]. + real(r8) :: ddel_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft ddel at the interface for each original updraft segment [ no ]. + real(r8) :: xc_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft xc at the interface for each original updraft segment [ no ]. + real(r8) :: xs_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft xs at the interface for each original updraft segment [ no ]. + real(r8) :: xemin_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft xemin at the interface for each original updraft segment [ no ]. + real(r8) :: xemax_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft xemax at the interface for each original updraft segment [ no ]. + real(r8) :: cridis_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft cridis at the interface for each original updraft segment [ m ]. + real(r8) :: thvcuenv_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft thvcuenv at the interface for each original updraft segment [ K ]. + real(r8) :: thvegenv_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft thvegenv at the interface for each original updraft segment [ K ]. + real(r8) :: thvxsenv_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft thvxsenv at the interface for each original updraft segment [ K ]. + real(r8) :: fmix_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft fmix at the interface for each original updraft segment [ no ]. + real(r8) :: cmfumix_u_msfc_out(mix,0:mkx,nseg,niter) ! Updraft cmfumix at the interface for each original updraft segment [ kg / s / m^2 ]. + + real(r8) :: thl_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft thl at the interface for each original updraft segment [ K ]. + real(r8) :: qt_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft qt at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: u_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft u at the interface for each original updraft segment [ m / s ]. + real(r8) :: v_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft v at the interface for each original updraft segment [ m / s ]. + real(r8) :: w_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft w at the interface for each original updraft segment [ m / s ]. + real(r8) :: ql_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: qi_d_msfc_out(mix,0:mkx,nseg,niter) ! Mass-flux weighted mean downdraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: tr_d_msfc_out(mix,0:mkx,nseg,ncnst,niter) ! Mass-flux weighted mean downdraft tr at the interface for each original updraft segment [ # / kg, kg / kg ]. + real(r8) :: wa_d_msfc_out(mix,0:mkx,nseg,niter) ! Area-weighted mean downdraft w at the interface for each original updraft segment [ m / s ]. + real(r8) :: qla_d_msfc_out(mix,0:mkx,nseg,niter) ! Area-weighted mean downdraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: qia_d_msfc_out(mix,0:mkx,nseg,niter) ! Area-weighted mean downdraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) :: cmf_d_msfc_out(mix,0:mkx,nseg,niter) ! Net downdraft cmf at the interface for each original updraft segment [ kg / s / m^2 ]. + real(r8) :: a_d_msfc_out(mix,0:mkx,nseg,niter) ! Net downdraft a at the interface for each original updraft segment [ fraction ]. + + real(r8) :: ptop_msfc_out(mix,nseg,niter) ! Updraft top height of individual original updraft segment defined at surface [ Pa ] + real(r8) :: ztop_msfc_out(mix,nseg,niter) ! Updraft top height of individual original updraft segment defined at surface [ m ] + + real(r8) :: thv_b_out(mix,0:mkx) + real(r8) :: thv_t_out(mix,0:mkx) + real(r8) :: thv_mt_out(mix,0:mkx) + real(r8) :: thv_min_out(mix,0:mkx) + + ! ----------------------------------------------------------- ! + ! One-dimensional local variables defined at each grid column ! + ! k = 0 : Surface interface ! + ! k = 1 : Lowest layer ! + ! k = mkx : Top layer ! + ! ----------------------------------------------------------- ! + + ! --------------- ! + ! Input variables ! + ! --------------- ! + + real(r8) ps0(0:mkx) ! Environmental pressure at the interface [Pa] + real(r8) zs0(0:mkx) ! Environmental height at the interface [m] + real(r8) p0(mkx) ! Environmental pressure at the mid-point [Pa] + real(r8) z0(mkx) ! Environmental height at the mid-point [m] + real(r8) dp0(mkx) ! Environmental layer pressure thickness [Pa] ( > 0 ) + real(r8) dpdry0(mkx) ! Environmental layer dry pressure thickness [Pa] ( > 0 ) + + real(r8) u0(mkx) ! Environmental zonal wind [m/s] + real(r8) v0(mkx) ! Environmental meridional wind [m/s] + real(r8) qv0(mkx) ! Environmental water vapor specific humidity [kg/kg] + real(r8) ql0(mkx) ! Environmental liquid water mixing ratio [kg/kg] + real(r8) qi0(mkx) ! Environmental ice mixing ratio [kg/kg] + real(r8) tr0(mkx,ncnst) ! Environmental tracers [ #/kg, kg/kg ] + real(r8) t0(mkx) ! Environmental temperature [K] + + real(r8) ast0(mkx) ! Stratiform fractional area at the layer mid-point [ fraction ] + real(r8) tke0(0:mkx) ! TKE [ m2/s2 ] + real(r8) bprod0(0:mkx) ! Buoyancy production [ m2/s3 ] + + ! -------------------------------------------------------- ! + ! Environmental variables derived from the input variables ! + ! -------------------------------------------------------- ! + + real(r8) dptr0(mkx,ncnst) ! Environmental layer pressure thickness for each dry or moist tracers [Pa] ( > 0 ) + real(r8) dz0(mkx) ! Environmental layer thickness [m] ( > 0 ) + real(r8) dps0(0:mkx) ! Environmental interfacial layer pressure thickness [Pa] ( > 0 ) + + real(r8) qt0(mkx) ! Environmental total specific humidity [kg/kg] + real(r8) thl0(mkx) ! Environmental liquid potential temperature [K] + real(r8) thv0(mkx) ! Environmental virtual potential temperature [K] + real(r8) rh0(mkx) ! Environmental mean rh [fraction] + real(r8) ssqt0(mkx) ! Vertical gradient of qt0 [kg/kg/Pa] + real(r8) ssthl0(mkx) ! Vertical gradient of thl0 [K/Pa] + real(r8) ssu0(mkx) ! Vertical gradient of u0 [m/s/Pa] + real(r8) ssv0(mkx) ! Vertical gradient of v0 [m/s/Pa] + real(r8) rho0(mkx) ! Environmental density [kg/m3] + + real(r8) thl0bot(mkx) ! Environmental thl at the bottom interface [K] + real(r8) thl0top(mkx) ! Environmental thl at the top interface [K] + real(r8) qt0bot(mkx) ! Environmental qt at the bottom interface [kg/kg] + real(r8) qt0top(mkx) ! Environmental qt at the top interface [kg/kg] + real(r8) u0bot(mkx) ! Environmental u at the bottom interface [m/s] + real(r8) u0top(mkx) ! Environmental u at the top interface [m/s] + real(r8) v0bot(mkx) ! Environmental v at the bottom interface [m/s] + real(r8) v0top(mkx) ! Environmental v at the top interface [m/s] + real(r8) thv0bot(mkx) ! Environmental virtual potential temperature at the bottom interface [K] + real(r8) thv0top(mkx) ! Environmental virtual potential temperature at the top interface [K] + real(r8) thvl0bot(mkx) ! Environmental thvl at the bottom interface [K] + real(r8) thvl0top(mkx) ! Environmental thvl at the top interface [K] + real(r8) ql0bot(mkx) ! Environmental ql at the bottom interface [kg/kg] + real(r8) ql0top(mkx) ! Environmental ql at the top interface [kg/kg] + real(r8) qi0bot(mkx) ! Environmental qi at the bottom interface [kg/kg] + real(r8) qi0top(mkx) ! Environmental qi at the top interface [kg/kg] + real(r8) tr0bot(mkx,ncnst) ! Environmental tracer at the bottom interface [#/kg, kg/kg] + real(r8) tr0top(mkx,ncnst) ! Environmental tracer at the top interface [#/kg, kg/kg] + real(r8) rho0bot(mkx) ! Environmental density at the bottom interface [kg/m3] + real(r8) rho0top(mkx) ! Environmental density at the top interface [kg/m3] + real(r8) rh0bot(mkx) ! Environmental RH at the bottom interface [0-1] + real(r8) exn0(mkx) ! Exner function at the mid-points + real(r8) exns0(0:mkx) ! Exner function at the interfaces + real(r8) ssql0(mkx) ! Vertical gradient of ql0 [kg/kg/Pa] + real(r8) ssqi0(mkx) ! Vertical gradient of qi0 [kg/kg/Pa] + real(r8) sstr0(mkx,ncnst) ! Vertical gradient of environmental tracers [ #/kg/Pa, kg/kg/Pa ] + + ! ----------------- ! + ! Cumulus variables ! + ! ----------------- ! + + real(r8) flxrain(0:mkx) ! Grid-mean convective rain flux after evaporation within downdraft and environment [kg/m2/s] + real(r8) flxsnow(0:mkx) ! Grid-mean convective snow flux after evaporation within downdraft and environment [kg/m2/s] + real(r8) flxtrrs(0:mkx,ncnst) ! Grid-mean convective tracer flux after evaporation within downdraft and environment [kg(#)/m2/s] + + real(r8) flxrain_msfc(0:mkx,nseg) ! Grid-mean convective rain flux after evaporation within downdraft and environment for each original updraft segment [kg/m2/s] + real(r8) flxsnow_msfc(0:mkx,nseg) ! Grid-mean convective snow flux after evaporation within downdraft and environment for each original updraft segment [kg/m2/s] + real(r8) flxtrrs_msfc(0:mkx,nseg,ncnst) ! Grid-mean convective tracer flux after evaporation within downdraft and environment for each original updraft segment [kg(#)/m2/s] + + real(r8) cmf_u_mix(mkx) ! Total amount of updraft mass flux involved in the buoyancy sorting [kg/m2/s] + real(r8) cmf_r(mkx) ! Total amount of detrained mass into the environment mass [kg/m2/s] + real(r8) thl_r(mkx) ! Mass flux weighted conservative scalar of detrained airs + real(r8) qt_r(mkx) ! Same as above + real(r8) u_r(mkx) ! Same as above + real(r8) v_r(mkx) ! Same as above + real(r8) ql_r(mkx) ! Same as above + real(r8) qi_r(mkx) ! Same as above + real(r8) tr_r(mkx,ncnst) ! Same as above + + ! ------------------------------------------------------------------------------------------------------------------------ ! + ! Below '2' variables are same as the above, but only consider the detrained component purely from the convective updraft, ! + ! not from the environmental airs involved in the mixing. This approach is very important because this approach is ! + ! fully consistently connecting the 'flux-convergence formula' to the 'subsidence-detrainment form' particularly ! + ! for the budget of cloud condensate. This approach will be directly used for simulating the effect of convective ! + ! detrainment on the critical relative humidity in the stratiform macrophysics. In addition, this approach may be ! + ! used for defining the mixing environmental air, instead of the above approach. ! + ! ------------------------------------------------------------------------------------------------------------------------ ! + + real(r8) cmf_r2(mkx) + real(r8) thl_r2(mkx) + real(r8) qt_r2(mkx) + real(r8) u_r2(mkx) + real(r8) v_r2(mkx) + real(r8) ql_r2(mkx) + real(r8) qi_r2(mkx) + real(r8) tr_r2(mkx,ncnst) + + real(r8) cmf_u(0:mkx) ! Total updraft mass flux at the model interface [ kg / m2 / s ] + real(r8) w_u(0:mkx) ! Mass-flux weighted updraft vertical velocity [ m / s ] + real(r8) wa_u(0:mkx) ! Area weighted updraft vertical velocity [ m / s ] + real(r8) a_u(0:mkx) ! Physical updraft fractional area [ fraction ] + real(r8) num_u(0:mkx) ! Number density of updraft plumes [ # / m^2 ] + real(r8) rad_u(0:mkx) ! Physical mean effective radius of updraft plumes [ m ] + real(r8) thl_u(0:mkx) ! Mass-flux weighted updraft liquid potential temperature [ K ] + real(r8) qt_u(0:mkx) ! Mass-flux weighted updraft total specific humidity [ kg / kg ] + real(r8) u_u(0:mkx) ! Mass-flux weighted updraft zonal velocity [ m / s ] + real(r8) v_u(0:mkx) ! Mass-flux weighted updraft meridional velocity [ m / s ] + real(r8) ql_u(0:mkx) ! Mass-flux weighted in-cloud LWC within convective updraft [ kg / kg ] + real(r8) qi_u(0:mkx) ! Mass-flux weighted in-cloud IWC within convective updraft [ kg / kg ] + real(r8) qla_u(0:mkx) ! Area weighted in-cloud LWC within convective updraft [ kg / kg ] + real(r8) qia_u(0:mkx) ! Area weighted in-cloud IWC within convective updraft [ kg / kg ] + real(r8) tr_u(0:mkx,ncnst) ! Mass-flux weighted in-cloud tracers within convective updraft [ # / kg, kg / kg ] + real(r8) thva_u(0:mkx) ! Area weighted thv within updraft [ K ] + + real(r8) cmf_u_dia(mkx) ! Total updraft mass flux at individual cloud tops [ kg / m2 / s ] + real(r8) evp_thll_u(mkx) ! Mass-flux weighted diabatic change of updraft 'thl' at each cloud top due to evaporation of rain [ K ] <= 0. + real(r8) evp_qtl_u(mkx) ! Mass-flux weighted diabatic change of updraft 'qt' at each cloud top due to evaporation of rain [ kg / kg ] >= 0. + real(r8) evp_thli_u(mkx) ! Mass-flux weighted diabatic change of updraft 'thl' at each cloud top due to evaporation of snow [ K ] <= 0. + real(r8) evp_qti_u(mkx) ! Mass-flux weighted diabatic change of updraft 'qt' at each cloud top due to evaporation of snow [ kg / kg ] >= 0. + real(r8) evp_tr_u(mkx,ncnst) ! Mass-flux weighted diabatic change of updraft tracer at each cloud top due to evaporation of rain + snow [ # / kg, kg / kg ] + real(r8) prep_thll_u(mkx) ! Mass-flux weighted diabatic change of updraft 'thl' at each cloud top due to production of rain [ K ] >= 0. + real(r8) prep_qtl_u(mkx) ! Mass-flux weighted diabatic change of updraft 'qt' at each cloud top due to production of rain [ kg / kg ] <= 0. + real(r8) prep_thli_u(mkx) ! Mass-flux weighted diabatic change of updraft 'thl' at each cloud top due to production of snow [ K ] >= 0. + real(r8) prep_qti_u(mkx) ! Mass-flux weighted diabatic change of updraft 'qt' at each cloud top due to production of snow [ kg / kg ] <= 0. + real(r8) prep_tr_u(mkx,ncnst) ! Mass-flux weighted diabatic change of updraft tracer at each cloud top due to production of rain + snow [ # / kg, kg / kg ] + real(r8) eff_ql_u(mkx) ! Mass-flux weighted diabatic change of updraft 'ql' at each cloud top due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_qi_u(mkx) ! Mass-flux weighted diabatic change of updraft 'qi' at each cloud top due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_tr_u(mkx,ncnst) ! Mass-flux weighted diabatic change of updraft tracer at each cloud top due to effective diabatic forcing on the tracer [ # / kg, kg / kg ] + real(r8) PGF_u_u(mkx) ! Mass-flux weighted diabatic change of updraft 'u' at each cloud top due to horizontal PGF forcing [ m / s ] + real(r8) PGF_v_u(mkx) ! Mass-flux weighted diabatic change of updraft 'v' at each cloud top due to horizontal PGF forcing [ m / s ] + + real(r8) f_srcd(mkx) ! Total source of downdraft generated from the updraft. f_srcd(k) = f_dd(k) + f_dud(k) + f_nud(k). [ ratio ] >= 0. + real(r8) thl_srcd(mkx) ! Mass-flux weighted thl of net sources of downdraft [ K ] + real(r8) qt_srcd(mkx) ! Mass-flux weighted qt of net sources of downdraft [ kg / kg ] + real(r8) u_srcd(mkx) ! Mass-flux weighted u of net sources of downdraft [ m / s ] + real(r8) v_srcd(mkx) ! Mass-flux weighted v of net sources of downdraft [ m / s ] + real(r8) tr_srcd(mkx,ncnst) ! Mass-flux weighted tracer of net sources of downdraft [ # / kg, kg / kg ] + real(r8) ql_srcd(mkx) ! Mass-flux weighted ql of net sources of downdraft [ kg / kg ] + real(r8) qi_srcd(mkx) ! Mass-flux weighted qi of net sources of downdraft [ kg / kg ] + + real(r8) f_srcds(mkx,nseg,3) ! Total source of downdraft generated from the updraft. f_srcd(k) = f_dd(k) + f_dud(k) + f_nud(k). [ ratio ] >= 0. + real(r8) thl_srcds(mkx,nseg,3) ! The thl of net sources of downdraft [ K ] + real(r8) qt_srcds(mkx,nseg,3) ! The qt of net sources of downdraft [ kg / kg ] + real(r8) u_srcds(mkx,nseg,3) ! The u of net sources of downdraft [ m / s ] + real(r8) v_srcds(mkx,nseg,3) ! The v of net sources of downdraft [ m / s ] + real(r8) tr_srcds(mkx,nseg,3,ncnst) ! The tracer of net sources of downdraft [ # / kg, kg / kg ] + real(r8) ql_srcds(mkx,nseg,3) ! The ql of net sources of downdraft [ kg / kg ] + real(r8) qi_srcds(mkx,nseg,3) ! The qi of net sources of downdraft [ kg / kg ] + + real(r8) f_srcr(mkx) ! Total source of remained airs generated from the updraft. f_srcr(k) = f_dr(k) + f_dur(k) + f_nur(k). [ ratio ] >= 0. + real(r8) thl_srcr(mkx) ! Mass-flux weighted thl of net sources of remained airs [ K ] + real(r8) qt_srcr(mkx) ! Mass-flux weighted qt of net sources of remained airs [ kg / kg ] + real(r8) u_srcr(mkx) ! Mass-flux weighted u of net sources of remained airs [ m / s ] + real(r8) v_srcr(mkx) ! Mass-flux weighted v of net sources of remained airs [ m / s ] + real(r8) tr_srcr(mkx,ncnst) ! Mass-flux weighted tracer of net sources of remained airs [ # / kg, kg / kg ] + real(r8) ql_srcr(mkx) ! Mass-flux weighted ql of net sources of remained airs [ kg / kg ] + real(r8) qi_srcr(mkx) ! Mass-flux weighted qi of net sources of remained airs [ kg / kg ] + + real(r8) f_srcr2(mkx) + real(r8) thl_srcr2(mkx) + real(r8) qt_srcr2(mkx) + real(r8) u_srcr2(mkx) + real(r8) v_srcr2(mkx) + real(r8) tr_srcr2(mkx,ncnst) + real(r8) ql_srcr2(mkx) + real(r8) qi_srcr2(mkx) + + real(r8) f_srcrs(mkx,nseg,3) ! Total source of remained airs generated from the updraft. f_srcr(k) = f_dr(k) + f_dur(k) + f_nur(k). [ ratio ] >= 0. + real(r8) thl_srcrs(mkx,nseg,3) ! The thl of net sources of remained airs [ K ] + real(r8) qt_srcrs(mkx,nseg,3) ! The qt of net sources of remained airs [ kg / kg ] + real(r8) u_srcrs(mkx,nseg,3) ! The u of net sources of remained airs [ m / s ] + real(r8) v_srcrs(mkx,nseg,3) ! The v of net sources of remained airs [ m / s ] + real(r8) tr_srcrs(mkx,nseg,3,ncnst) ! The tracer of net sources of remained airs [ # / kg , kg / kg ] + real(r8) ql_srcrs(mkx,nseg,3) ! The ql of net sources of remained airs [ kg / kg ] + real(r8) qi_srcrs(mkx,nseg,3) ! The qi of net sources of remained airs [ kg / kg ] + + real(r8) f_srcrs2(mkx,nseg,3) + real(r8) thl_srcrs2(mkx,nseg,3) + real(r8) qt_srcrs2(mkx,nseg,3) + real(r8) u_srcrs2(mkx,nseg,3) + real(r8) v_srcrs2(mkx,nseg,3) + real(r8) tr_srcrs2(mkx,nseg,3,ncnst) + real(r8) ql_srcrs2(mkx,nseg,3) + real(r8) qi_srcrs2(mkx,nseg,3) + + real(r8) cmf_ru(mkx) ! f_srcr(mkx) * cmf_u(km) [ kg / m^2 / s ] + real(r8) thl_ru(mkx) ! = thl_srcr(mkx) + real(r8) qt_ru(mkx) ! = qt_srcr(mkx) + real(r8) u_ru(mkx) ! = u_srcr(mkx) + real(r8) v_ru(mkx) ! = v_srcr(mkx) + real(r8) ql_ru(mkx) ! = ql_srcr(mkx) + real(r8) qi_ru(mkx) ! = qi_srcr(mkx) + real(r8) tr_ru(mkx,ncnst) ! = tr_srcr(mkx,ncnst) + + real(r8) cmf_ru2(mkx) + real(r8) thl_ru2(mkx) + real(r8) qt_ru2(mkx) + real(r8) u_ru2(mkx) + real(r8) v_ru2(mkx) + real(r8) ql_ru2(mkx) + real(r8) qi_ru2(mkx) + real(r8) tr_ru2(mkx,ncnst) + + real(r8) cmf_ad(0:mkx,mkx,nseg,3) ! Downdraft mass flux at the model interface originated from the downdraft sources of the 'k' layer [ kg / m^2 / s ] >= 0. + real(r8) w_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft vertical velocity originated from the downdraft sources of the 'k' layer [ m / s ] + real(r8) a_ad(0:mkx,mkx,nseg,3) ! Physical downdraft fractional area originated from the downdraft sources of the 'k' layer [ fraction ] + real(r8) thl_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft thl originated from the downdraft sources of the 'k' layer [ K ] + real(r8) qt_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft qt originated from the downdraft sources of the 'k' layer [ kg / kg ] + real(r8) u_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft u originated from the downdraft sources of the 'k' layer [ m / s ] + real(r8) v_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft v originated from the downdraft sources of the 'k' layer [ m / s ] + real(r8) ql_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft ql originated from the downdraft sources of the 'k' layer [ kg / kg ] + real(r8) qi_ad(0:mkx,mkx,nseg,3) ! Mass-flux weighted downdraft qi originated from the downdraft sources of the 'k' layer [ kg / kg ] + real(r8) tr_ad(0:mkx,mkx,nseg,3,ncnst) ! Mass-flux weighted downdraft tracer originated from the downdraft sources of the 'k' layer [ # / kg, kg / kg ] + + real(r8) dpad(mkx,mkx,nseg,3) + + real(r8) cmf_d(0:mkx) ! Total downdraft mass flux at the model interface [ kg / m^2 / s ] >= 0. + real(r8) w_d(0:mkx) ! Mass-flux weighted downdraft vertical velocity [ m / s ] + real(r8) wa_d(0:mkx) ! Area weighted downdraft vertical velocity [ m / s ] + real(r8) a_d(0:mkx) ! Physical downdraft fractional area [ fraction ] + real(r8) thl_d(0:mkx) ! Mass-flux weighted downdraft thl [ K ] + real(r8) qt_d(0:mkx) ! Mass-flux weighted downdraft qt [ kg / kg ] + real(r8) u_d(0:mkx) ! Mass-flux weighted downdraft u [ m / s ] + real(r8) v_d(0:mkx) ! Mass-flux weighted downdraft v [ m / s ] + real(r8) ql_d(0:mkx) ! Mass-flux weighted in-cloud LWC within convective downdraft [ kg / kg ] + real(r8) qi_d(0:mkx) ! Mass-flux weighted in-cloud IWC within convective downdraft [ kg / kg ] + real(r8) qla_d(0:mkx) ! Area weighted in-cloud LWC within convective downdraft [ kg / kg ] + real(r8) qia_d(0:mkx) ! Area weighted in-cloud IWC within convective downdraft [ kg / kg ] + real(r8) tr_d(0:mkx,ncnst) ! Mass-flux weighted downdraft tracer [ # / kg, kg / kg ] + + real(r8) cmf_ar(mkx,mkx,nseg,3) ! The mass flux of detrained airs into environment from the downdraft originated from the downdraft sources of the 'k' layer [ kg / m^2 / s ] >= 0. + real(r8) thl_ar(mkx,mkx,nseg,3) ! Mass-flux weighted thl of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ K ] + real(r8) qt_ar(mkx,mkx,nseg,3) ! Mass-flux weighted qt of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ kg / kg ] + real(r8) u_ar(mkx,mkx,nseg,3) ! Mass-flux weighted u of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ m / s ] + real(r8) v_ar(mkx,mkx,nseg,3) ! Mass-flux weighted v of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ m / s ] + real(r8) tr_ar(mkx,mkx,nseg,3,ncnst) ! Mass-flux weighted tracer of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ # / kg, kg / kg ] + real(r8) ql_ar(mkx,mkx,nseg,3) ! Mass-flux weighted ql of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ kg / kg ] + real(r8) qi_ar(mkx,mkx,nseg,3) ! Mass-flux weighted qi of detrained airs from the downdraft originated from the downdraft sources of the 'k' layer [ kg / kg ] + + real(r8) cmf_rd(mkx) ! The mass flux of detrained airs into environment from the downdraft [ kg / m^2 / s ] >= 0. + real(r8) thl_rd(mkx) ! Mass-flux weighted thl of detrained airs from the downdraft [ K ] + real(r8) qt_rd(mkx) ! Mass-flux weighted qt of detrained airs from the downdraft [ kg / kg ] + real(r8) u_rd(mkx) ! Mass-flux weighted u of detrained airs from the downdraft [ m / s ] + real(r8) v_rd(mkx) ! Mass-flux weighted v of detrained airs from the downdraft [ m / s ] + real(r8) ql_rd(mkx) ! Mass-flux weighted ql of detrained airs from the downdraft [ kg / kg ] + real(r8) qi_rd(mkx) ! Mass-flux weighted qi of detrained airs from the downdraft [ kg / kg ] + real(r8) tr_rd(mkx,ncnst) ! Mass-flux weighted tracer of detrained airs from the downdraft [ # / kg, kg / kg ] + + real(r8) cmf_ad_dia(mkx,mkx,nseg,3) ! Downdraft mass flux at each downdraft base in each layer originated from the downdraft sources of the 'k' layer [ kg / m2 / s ] >= 0. + real(r8) evp_thll_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'thl' at each downdraft base due to evaporation of rain [ K ] <= 0. + real(r8) evp_qtl_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'qt' at each downdraft base due to evaporation of rain [ kg / kg ] >= 0. + real(r8) evp_thli_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'thl' at each downdraft base due to evaporation of snow [ K ] <= 0. + real(r8) evp_qti_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'qt' at each downdraft base due to evaporation of snow [ kg / kg ] >= 0. + real(r8) evp_tr_ad(mkx,mkx,nseg,3,ncnst) ! Diabatic change of downdraft tracer at each downdraft base due to evaporation of rain + snow [ kg / kg ] + real(r8) prep_thll_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'thl' at each downdraft base due to production of rain [ K ] >= 0. + real(r8) prep_qtl_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'qt' at each downdraft base due to production of rain [ kg / kg ] <= 0. + real(r8) prep_thli_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'thl' at each downdraft base due to production of snow [ K ] >= 0. + real(r8) prep_qti_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'qt' at each downdraft base due to production of snow [ kg / kg ] <= 0. + real(r8) prep_tr_ad(mkx,mkx,nseg,3,ncnst) ! Diabatic change of downdraft tracer at each downdraft base due to production of rain + snow [ # / kg, kg / kg ] + real(r8) eff_ql_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'ql' at each downdraft base due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_qi_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'qi' at each downdraft base due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_tr_ad(mkx,mkx,nseg,3,ncnst) ! Diabatic change of downdraft tracer at each downdraft base due to effective diabatic forcing on tracer [ # / kg, kg / kg ] + real(r8) PGF_u_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'u' at each downdraft base due to horizontal PGF forcing [ m / s ] + real(r8) PGF_v_ad(mkx,mkx,nseg,3) ! Diabatic change of downdraft 'v' at each downdraft base due to horizontal PGF forcing [ m / s ] + real(r8) wdep_tr_ad(mkx,mkx,nseg,3,ncnst) ! Diabatic change of downdraft tracer at each downdraft base due to wet deposition of aerosols within downdraft + ! including both the cloud-borne and interstitial aerosols within convective downdraft [ # / kg, kg / kg ] + + real(r8) cmf_d_dia(mkx) ! Total downdraft mass flux at the downdraft base in each layer [ kg / m2 / s ] >= 0. + real(r8) evp_thll_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'thl' at the downdraft base due to evaporation of rain [ K ] <= 0. + real(r8) evp_qtl_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'qt' at the downdraft base due to evaporation of rain [ kg / kg ] >= 0. + real(r8) evp_thli_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'thl' at the downdraft base due to evaporation of snow [ K ] <= 0. + real(r8) evp_qti_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'qt' at the downdraft base due to evaporation of snow [ kg / kg ] >= 0. + real(r8) evp_tr_d(mkx,ncnst) ! Mass-flux weighted diabatic change of downdraft tracer at the downdraft base due to evaporation of rain + snow [ # / kg, kg / kg ] + real(r8) prep_thll_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'thl' at the downdraft base due to production of rain [ K ] >= 0. + real(r8) prep_qtl_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'qt' at the downdraft base due to production of rain [ kg / kg ] <= 0. + real(r8) prep_thli_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'thl' at the downdraft base due to production of snow [ K ] >= 0. + real(r8) prep_qti_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'qt' at the downdraft base due to production of snow [ kg / kg ] <= 0. + real(r8) prep_tr_d(mkx,ncnst) ! Mass-flux weighted diabatic change of downdraft tracer at the downdraft base due to production of rain + snow [ kg / kg ] + real(r8) eff_ql_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'ql' at the downdraft base due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_qi_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'qi' at the downdraft base due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_tr_d(mkx,ncnst) ! Mass-flux weighted diabatic change of downdraft tracer at the downdraft base due to effective diabatic forcing on tracer [ # / kg, kg / kg ] + real(r8) PGF_u_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'u' at the downdraft base due to horizontal PGF forcing [ m / s ] + real(r8) PGF_v_d(mkx) ! Mass-flux weighted diabatic change of downdraft 'v' at the downdraft base due to horizontal PGF forcing [ m / s ] + + real(r8) qlten_sub(mkx) ! Environmental tendency of ql due to compensating subsidence / upwelling [ kg / kg / s ] + real(r8) qiten_sub(mkx) ! Environmental tendency of qi due to compensating subsidence / upwelling [ kg / kg / s ] + + real(r8) rqc_l(mkx) ! Environmental tendency of ql due to raw detrainment of updraft ( sum of 'cmf_dur(k)' and 'cmf_nur(k)' ) [ kg / kg / s ] + real(r8) rqc_i(mkx) ! Environmental tendency of qi due to raw detrainment of updraft ( sum of 'cmf_dur(k)' and 'cmf_nur(k)' ) [ kg / kg / s ] + real(r8) rqc(mkx) ! Environmental tendency of ql + qi due to raw detrainment of updraft ( sum of 'cmf_dur(k)' and 'cmf_nur(k)' ) [ kg / kg / s ] + real(r8) rnc_l(mkx) ! Environmental tendency of nl due to raw detrainment of updraft ( sum of 'cmf_dur(k)' and 'cmf_nur(k)' ) [ # / kg / s ] + real(r8) rnc_i(mkx) ! Environmental tendency of ni due to raw detrainment of updraft ( sum of 'cmf_dur(k)' and 'cmf_nur(k)' ) [ # / kg / s ] + + real(r8) qlten_det(mkx) ! Environmental tendency of ql due to all detrainment of updraft and downdraft [ kg / kg / s ] + real(r8) qiten_det(mkx) ! Environmental tendency of qi due to all detrainment of updraft and downdraft [ kg / kg / s ] + + real(r8) am_u_msfc(mkx,nseg) ! Updraft fractional area at the layer mid-point for each original updraft segment [ fraction ]. + real(r8) am_d_msfc(mkx,nseg) ! Downdraft fractional area at the layer mid-point for each original updraft segment [ fraction ]. + + real(r8) am_u(mkx) ! Updraft fractional area at the layer mid-point [ fraction ]. 0 <= am_u(mkx) <= au_max <= 1. + real(r8) am_d(mkx) ! Downdraft fractional area at the layer mid-point [ fraction ]. 0 <= am_d(mkx) <= ad_max <= 1. + + real(r8) qlm_u_msfc(mkx,nseg) ! Updraft LWC at the layer mid-point for each original updraft segment [ kg / kg ]. + real(r8) qim_u_msfc(mkx,nseg) ! Updraft IWC at the layer mid-point for each original updraft segment [ kg / kg ]. + real(r8) thlm_u_msfc(mkx,nseg) ! Updraft thl at the layer mid-point for each original updraft segment [ K ]. + real(r8) qtm_u_msfc(mkx,nseg) ! Updraft qt at the layer mid-point for each original updraft segment [ kg / kg ]. + real(r8) um_u_msfc(mkx,nseg) ! Updraft u at the layer mid-point for each original updraft segment [ m / s ]. + real(r8) vm_u_msfc(mkx,nseg) ! Updraft v at the layer mid-point for each original updraft segment [ m / s ]. + real(r8) trm_u_msfc(mkx,nseg,ncnst) ! Updraft tr at the layer mid-point for each original updraft segment [ kg / kg or # / kg ]. + + real(r8) qlm_u(mkx) ! Area-weighted updraft LWC at the layer mid-point [ kg / kg ]. + real(r8) qim_u(mkx) ! Area-weighted updraft IWC at the layer mid-point [ kg / kg ]. + real(r8) thlm_u(mkx) ! Area-weighted updraft thl at the layer mid-point [ K ]. + real(r8) qtm_u(mkx) ! Area-weighted updraft qt at the layer mid-point [ kg / kg ]. + real(r8) um_u(mkx) ! Area-weighted updraft u at the layer mid-point [ m / s ]. + real(r8) vm_u(mkx) ! Area-weighted updraft v at the layer mid-point [ m / s ]. + real(r8) trm_u(mkx,ncnst) ! Area-weighted updraft tr at the layer mid-point [ kg / kg or # / kg ]. + + real(r8) qlm_d_msfc(mkx,nseg) ! Downdraft LWC at the layer mid-point for each original updraft segment [ kg / kg ]. + real(r8) qim_d_msfc(mkx,nseg) ! Downdraft IWC at the layer mid-point for each original updraft segment [ kg / kg ]. + + real(r8) qlm_d(mkx) ! Area-weighted downdraft LWC at the layer mid-point [ kg / kg ]. + real(r8) qim_d(mkx) ! Area-weighted downdraft IWC at the layer mid-point [ kg / kg ]. + + real(r8) am_s(mkx) ! Stratiform fractional area at the layer mid-point [ fraction ]. 0 <= am_s(mkx) <= 1. + real(r8) am_r(mkx) ! Clear-sky fractional area at the layer mid-point [ fraction ]. 0 <= am_r(mkx)=1-am_u(mkx)-am_s(mkx)<= 1. + real(r8) am_up(mkx) ! Precipitating updraft fractional area at the layer mid-point [ fraction ]. 0 <= am_up(mkx) <= am_u(mkx) <= 1. + real(r8) am_us(mkx) ! Saturated updraft fractional area at the layer mid-point [ fraction ]. 0 <= am_us(mkx) <= am_u(mkx) <= 1. + + real(r8) am_up_msfc(mkx,nseg) ! Precipitating updraft fractional area at the layer mid-point for each original updraft segment [ fraction ]. + real(r8) am_us_msfc(mkx,nseg) ! Saturated updraft fractional area at the layer mid-point for each original updraft segment [ fraction ]. + + real(r8) a_p(0:mkx) ! Physical convective precipitation area at the interface [ fraction ] + real(r8) a_p_msfc(0:mkx,nseg) ! Physical convective precipitation area at the interface for each original updraft segment [ fraction ] + real(r8) a_pu ! Overlapping area between convective precipitation area at the top interface and updraft area at the layer mid-point [ fraction ] + real(r8) a_pd ! Overlapping area between convective precipitation area at the top interface and downdraft area at the layer mid-point [ fraction ] + real(r8) a_ps ! Overlapping area between convective precipitation area at the top interface and stratus area at the layer mid-point [ fraction ] + real(r8) a_pr ! Overlapping area between convective precipitation area at the top interface and clear area at the layer mid-point [ fraction ] + real(r8) a_evp ! Fractional area where evaporation of precipitation occurs. + real(r8) a_ovp ! + real(r8) am_evp_msfc(mkx,nseg) ! Same as 'a_evp' but into array variables. + real(r8) am_pu_msfc(mkx,nseg) + real(r8) am_pd_msfc(mkx,nseg) + real(r8) am_pr_msfc(mkx,nseg) + real(r8) am_ps_msfc(mkx,nseg) + real(r8) am_evp(mkx) + real(r8) am_pu(mkx) + real(r8) am_pd(mkx) + real(r8) am_pr(mkx) + real(r8) am_ps(mkx) + + real(r8) cmf_det(mkx) ! Detrained mass flux only from convective updraft (not from environmental air) and downdraft [ kg / s / m2 ] + real(r8) ql_det(mkx) ! Detrained LWC without mixing with the environment ( flux-convergence & subsidence-detrainment consistent ) [ kg / kg ] + real(r8) qi_det(mkx) ! Detrained LWC without mixing with the environment ( flux-convergence & subsidence-detrainment consistent ) [ kg / kg ] + + real(r8) am_evp_nw ! Overlapping area between 'evaporation area' and 'non-wake area' [ 0 - 1 ] + real(r8) am_p_nw ! Overlapping area between 'precipitation area' and 'non-wake area' [ 0 - 1 ] + + ! Aug.08.2013. Add stratiform part + real(r8) am_evp_nw_st ! Overlapping area between 'stratiform evaporation area' and 'non-wake area' [ 0 - 1 ] + real(r8) tmp2_st + real(r8) am_evp_st(mkx) + real(r8) evprain_st(mkx) + real(r8) evpsnow_st(mkx) + + ! ---------------------------------------------------------------------- ! + ! Individual Updraft Segment Variables at 'msfc' index at each interface ! + ! ---------------------------------------------------------------------- ! + + real(r8) thl_u_msfc(0:mkx,nseg) ! Updraft thl at the interface for each original updraft segment [ K ]. + real(r8) qt_u_msfc(0:mkx,nseg) ! Updraft qt at the interface for each original updraft segment [ kg / kg ]. + real(r8) u_u_msfc(0:mkx,nseg) ! Updraft u at the interface for each original updraft segment [ m / s ]. + real(r8) v_u_msfc(0:mkx,nseg) ! Updraft v at the interface for each original updraft segment [ m / s ]. + real(r8) w_u_msfc(0:mkx,nseg) ! Updraft w at the interface for each original updraft segment [ m / s ]. + real(r8) ql_u_msfc(0:mkx,nseg) ! Updraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) qi_u_msfc(0:mkx,nseg) ! Updraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) tr_u_msfc(0:mkx,nseg,ncnst) ! Updraft tr at the interface for each original updraft segment [ # / kg, kg / kg ]. + real(r8) cmf_u_msfc(0:mkx,nseg) ! Updraft cmf at the interface for each original updraft segment [ kg / s / m^2 ]. + real(r8) a_u_msfc(0:mkx,nseg) ! Updraft a at the interface for each original updraft segment [ fraction ]. + real(r8) num_u_msfc(0:mkx,nseg) ! Updraft num at the interface for each original updraft segment [ # / m^2 ]. + real(r8) rad_u_msfc(0:mkx,nseg) ! Updraft rad at the interface for each original updraft segment [ m ]. + + real(r8) eps0_u_msfc(0:mkx,nseg) ! Updraft eps0 at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) eps_u_msfc(0:mkx,nseg) ! Updraft eps at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) del_u_msfc(0:mkx,nseg) ! Updraft del at the interface for each original updraft segment [ 1 / Pa ]. + real(r8) eeps_u_msfc(0:mkx,nseg) ! Updraft eeps at the interface for each original updraft segment [ no ]. + real(r8) ddel_u_msfc(0:mkx,nseg) ! Updraft ddel at the interface for each original updraft segment [ no ]. + real(r8) xc_u_msfc(0:mkx,nseg) ! Updraft xc at the interface for each original updraft segment [ no ]. + real(r8) xs_u_msfc(0:mkx,nseg) ! Updraft xs at the interface for each original updraft segment [ no ]. + real(r8) xemin_u_msfc(0:mkx,nseg) ! Updraft xemin at the interface for each original updraft segment [ no ]. + real(r8) xemax_u_msfc(0:mkx,nseg) ! Updraft xemax at the interface for each original updraft segment [ no ]. + real(r8) cridis_u_msfc(0:mkx,nseg) ! Updraft cridis at the interface for each original updraft segment [ m ]. + real(r8) thvcuenv_u_msfc(0:mkx,nseg) ! Updraft thvcuenv at the interface for each original updraft segment [ K ]. + real(r8) thvegenv_u_msfc(0:mkx,nseg) ! Updraft thvegenv at the interface for each original updraft segment [ K ]. + real(r8) thvxsenv_u_msfc(0:mkx,nseg) ! Updraft thvxsenv at the interface for each original updraft segment [ K ]. + real(r8) fmix_u_msfc(0:mkx,nseg) ! Updraft fmix at the interface for each original updraft segment [ no ]. + real(r8) cmfumix_u_msfc(0:mkx,nseg) ! Updraft cmfumix at the interface for each original updraft segment [ kg / s / m^2 ] + + ! ------------------------------------------ ! + ! Variables associated with vertical overlap ! + ! ------------------------------------------ ! + + real(r8) x_um_msfc(mkx,nseg) ! Location ( x ) of convective updraft at the layer mid-point relative to the convective updraft at surface [ m ] + real(r8) y_um_msfc(mkx,nseg) ! Location ( y ) of convective updraft at the layer mid-point relative to the convective updraft at surface [ m ] + real(r8) x_p_msfc(0:mkx,nseg) ! Location ( x ) of convective precipitation area at the interface relative to the convective updraft at surface [ m ] + real(r8) y_p_msfc(0:mkx,nseg) ! Location ( y ) of convective precipitation area at the interface relative to the convective updraft at surface [ m ] + + ! -------------------------------------------------------------------------------------------------------- ! + ! Individual Mean Downdraft variables for each Updraft Segment Variables at 'msfc' index at each interface ! + ! -------------------------------------------------------------------------------------------------------- ! + + real(r8) thl_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft thl at the interface for each original updraft segment [ K ]. + real(r8) qt_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft qt at the interface for each original updraft segment [ kg / kg ]. + real(r8) u_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft u at the interface for each original updraft segment [ m / s ]. + real(r8) v_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft v at the interface for each original updraft segment [ m / s ]. + real(r8) w_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft w at the interface for each original updraft segment [ m / s ]. + real(r8) ql_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) qi_d_msfc(0:mkx,nseg) ! Mass-flux weighted mean downdraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) tr_d_msfc(0:mkx,nseg,ncnst) ! Mass-flux weighted mean downdraft tr at the interface for each original updraft segment [ # / kg, kg / kg ]. + real(r8) wa_d_msfc(0:mkx,nseg) ! Area-weighted mean downdraft w at the interface for each original updraft segment [ m / s ]. + real(r8) qla_d_msfc(0:mkx,nseg) ! Area-weighted mean downdraft ql at the interface for each original updraft segment [ kg / kg ]. + real(r8) qia_d_msfc(0:mkx,nseg) ! Area-weighted mean downdraft qi at the interface for each original updraft segment [ kg / kg ]. + real(r8) cmf_d_msfc(0:mkx,nseg) ! Net downdraft cmf at the interface for each original updraft segment [ kg / s / m^2 ]. + real(r8) a_d_msfc(0:mkx,nseg) ! Net downdraft a at the interface for each original updraft segment [ fraction ]. + + ! ------------------------- ! + ! Updraft Segment Variables ! + ! ------------------------- ! + + real(r8) ytop(nseg) ! If 1 ( 0 ), updraft segment does ( not ) reach to the top interface [ no unit ] + real(r8) xc(nseg) ! Critical mixing fraction for buoyancy sorting [ fraction ] 0 <= xc <= 1. + real(r8) xs(nseg) ! Saturation mixing fraction for buoyancy sorting [ fraction ] 0 <= xs <= 1. + real(r8) eeps(nseg) ! Non-dimensional fractional entrainment rate [ no unit ] + real(r8) ddel(nseg) ! Non-dimensional fractional detrainment rate [ no unit ] + real(r8) eps(nseg) ! Fractional entrainment rate [ 1 / Pa ] + real(r8) del(nseg) ! Fractional detrainment rate [ 1 / Pa ] + real(r8) eps0(nseg) ! Fractional mixing rate [ 1 / Pa ] + real(r8) eps0org(nseg) ! Fractional mixing rate [ 1 / Pa ] + real(r8) xe_min(nseg) ! Minimum mixing fraction for conversion into downdraft [ fraction ] + real(r8) xe_max(nseg) ! Maximum mixing fraction for conversion into downdraft [ fraction ] + real(r8) dpa(nseg) ! Vertical distance that updraft segment can rise in each layer [ Pa ]. 0 <= dp <= dp0. + real(r8) dza(nseg) ! Vertical distance that updraft segment can rise in each layer [ m ]. 0 <= dz <= dz0. + real(r8) ptop(nseg) ! Updraft top height [ Pa ] + real(r8) ztop(nseg) ! Updraft top height [ m ] + real(r8) ptops(mkx,nseg) ! Updraft top height for each segment in each layer [ Pa ] + real(r8) ztops(mkx,nseg) ! Updraft top height for each segment in each layer [ m ] + integer m_from_msfc(mkx,nseg) ! Get 'm' index from 'msfc' index in each layer that updraft reaches [ no unit ] + integer msfc_from_m(mkx,nseg) ! Get 'msfc' index from 'm' index in each layer that updraft reaches [ no unit ] + integer ktop_msfc(nseg) ! The top layer index of individual original updraft segment defined at surface [ no ] + real(r8) ptop_msfc(nseg) ! Updraft top height of individual original updraft segment defined at surface [ Pa ] + real(r8) ztop_msfc(nseg) ! Updraft top height of individual original updraft segment defined at surface [ m ] + real(r8) fmix(nseg) ! When multiplied by cmf_au(m), it becomes the amount of updraft mass involved in the buoyancy sorting mixing [ no unit ] + real(r8) f_wu(nseg) ! For updraft vertical velocity constraint [ no unit ] + real(r8) fmixd ! Same as 'fmix' but for downdraft. + + real(r8) alpha(nseg) ! Mixing fraction within updraft at the k = 1 interface [ no unit ] + real(r8) Pmu(nseg) ! Normalized PDF of updraft mass flux at the k = 1 interface [ 1 / d_alpha ] + real(r8) Pau(nseg) ! Normalized PDF of updraft fractional area at the k = 1 interface [ 1 / d_alpha ] + real(r8) Pnu(nseg) ! Normalized PDF of updraft number concentration at the k = 1 interface [ 1 / d_alpha ] + real(r8) rnorm_a ! Area normalization constant to force the sum of updraft fraction area at surface to be the specified 'au_base' in all cases. + real(r8) rnorm_m ! Area normalization constant to force the sum of non-organized updraft mass flux at surface to be the specified 'cmfu_base' in all cases. + real(r8) cmfu_base ! Physical analytical non-organized updraft mass flux at surface for a given 'au_base'. + + real(r8) cmf_au(nseg) ! Updraft mass flux at the base interface [ kg / s / m^2 ] + real(r8) thl_au(nseg) ! Updraft thl at the base interface [ K ] + real(r8) qt_au(nseg) ! Updraft qt at the base interface [ kg / kg ] + real(r8) u_au(nseg) ! Updraft u at the base interface [ m / s ] + real(r8) v_au(nseg) ! Updraft v at the base interface [ m / s ] + real(r8) w_au(nseg) ! Updraft vertical velocity at the base interface [ m / s ] + real(r8) ql_au(nseg) ! Updraft ql at the base interface [ kg / kg ] + real(r8) qi_au(nseg) ! Updraft qi at the base interface [ kg / kg ] + real(r8) tr_au(nseg,ncnst) ! Updraft tracers at the base interface [ # / kg, kg / kg ] + real(r8) a_au(nseg) ! Updraft fractional area at the base interface [ fraction ] + real(r8) num_au(nseg) ! Updraft number concentration at the base interface [ # / m^2 ] + real(r8) rad_au(nseg) ! Updraft radius at the base interface [ m ] + real(r8) thv_au(nseg) ! Updraft thv at the base interface [ K ] + real(r8) S_b_ql_au(nseg) ! Updraft rain production rate at the base interface [ kg / kg / Pa ] + real(r8) S_b_qi_au(nseg) ! Updraft snow production rate at the base interface [ kg / kg / Pa ] + + real(r8) cmf_aut(nseg) ! Updraft mass flux at the cloud top or top interface [ kg / s / m^2 ] + real(r8) thl_aut(nseg) ! Updraft thl at the cloud top or top interface [ K ] + real(r8) qt_aut(nseg) ! Updraft qt at the cloud top or top interface [ kg / kg ] + real(r8) u_aut(nseg) ! Updraft u at the cloud top or top interface [ m / s ] + real(r8) v_aut(nseg) ! Updraft v at the cloud top or top interface [ m / s ] + real(r8) w_aut(nseg) ! Updraft vertical velocity at the cloud top or top interface [ m / s ] + real(r8) ql_aut(nseg) ! Updraft ql at the cloud top or top interface [ kg / kg ] + real(r8) qi_aut(nseg) ! Updraft qi at the cloud top or top interface [ kg / kg ] + real(r8) a_aut(nseg) ! Updraft fractional area at the cloud top or top interface [ fraction ] + real(r8) num_aut(nseg) ! Updraft number concentration at the cloud top or top interface [ # / m^2 ] + real(r8) rad_aut(nseg) ! Updraft radius at the cloud top or top interface [ m ] + real(r8) tr_aut(nseg,ncnst) ! Updraft tracer at the cloud top or top interface [ # / kg, kg / kg ] + real(r8) thv_aut(nseg) ! Updraft thv at the cloud top or top interface [ K ] + real(r8) S_t_ql_au(nseg) ! Updraft rain production rate at the cloud top or top interface [ kg / kg / Pa ] + real(r8) S_t_qi_au(nseg) ! Updraft snow production rate at the cloud top or top interface [ kg / kg / Pa ] + + real(r8) evp_thll_au(nseg) ! Diabatic change of updraft 'thl' at each cloud top due to evaporation of rain [ K ] <= 0. + real(r8) evp_qtl_au(nseg) ! Diabatic change of updraft 'qt' at each cloud top due to evaporation of rain [ kg / kg ] >= 0. + real(r8) evp_thli_au(nseg) ! Diabatic change of updraft 'thl' at each cloud top due to evaporation of snow [ K ] <= 0. + real(r8) evp_qti_au(nseg) ! Diabatic change of updraft 'qt' at each cloud top due to evaporation of snow [ kg / kg ] >= 0. + real(r8) evp_tr_au(nseg,ncnst) ! Diabatic change of updraft tracer at each cloud top due to evaporation of rain + snow [ # / kg, kg / kg ] + real(r8) prep_thll_au(nseg) ! Diabatic change of updraft 'thl' at each cloud top due to production of rain [ K ] >= 0. + real(r8) prep_qtl_au(nseg) ! Diabatic change of updraft 'qt' at each cloud top due to production of rain [ kg / kg ] <= 0. + real(r8) prep_thli_au(nseg) ! Diabatic change of updraft 'thl' at each cloud top due to production of snow [ K ] >= 0. + real(r8) prep_qti_au(nseg) ! Diabatic change of updraft 'qt' at each cloud top due to production of snow [ kg / kg ] <= 0. + real(r8) prep_tr_au(nseg,ncnst) ! Diabatic change of updraft tracer at each cloud top due to production of rain + snow [ # / kg, kg / kg ] + real(r8) eff_ql_au(nseg) ! Diabatic change of updraft 'ql' at each cloud top due to effective diabatic forcing on cloud condensate [ K ] >= 0. + real(r8) eff_qi_au(nseg) ! Diabatic change of updraft 'qi' at each cloud top due to effective diabatic forcing on cloud condensate [ kg / kg ] + real(r8) eff_tr_au(nseg,ncnst) ! Diabatic change of updraft tracer at each cloud top due to effective diabatic forcing on tracer [ # / kg, kg / kg ] + real(r8) PGF_u_au(nseg) ! Diabatic change of updraft 'u' at each cloud top due to horizontal PGF forcing [ m / s ] + real(r8) PGF_v_au(nseg) ! Diabatic change of updraft 'v' at each cloud top due to horizontal PGF forcing [ m / s ] + + ! ---------------------------------------------------------------------------------------------------------------------------------------------- ! + ! Variables to compute effective diabatic forcings ( condensation-evaporation-freezing ) on cloud condensate and tracers and PGF on uv momentum. ! + ! ---------------------------------------------------------------------------------------------------------------------------------------------- ! + + real(r8) ql_aut_adi + real(r8) qi_aut_adi + real(r8) eff_ql + real(r8) eff_qi + real(r8) eff_tr(ncnst) + real(r8) u_aut_adi + real(r8) v_aut_adi + + ! ----------------------------------------------------------------------------- ! + ! Variables associated with the treatment of entrainment dilution of downdraft. ! + ! ----------------------------------------------------------------------------- ! + + real(r8) eps_dn, del_dn + real(r8) ql_db_adi, qi_db_adi, qv_db_adi, qv_db_adi_evp + real(r8) u_db_adi , v_db_adi + real(r8) ql_dt, qi_dt, qv_dt, th_dt + real(r8) ql_db, qi_db, qv_db, qs_db, th_db + real(r8) wd2 + + ! --------------------------------------------------------------------------------- ! + ! Variables related to the evaporation of precipitation within convective downdraft ! + ! --------------------------------------------------------------------------------- ! + + real(r8) evplflux ! Evaporation + Production of rain within downdraft in each layer [kg/s/m^2] + real(r8) evpiflux ! Evaporation + Production of snow within downdraft in each layer [kg/s/m^2] + real(r8) evptrflux(ncnst) ! Evaporation + Production + Wet Deposition of tracers within downdraft in each layer [kg(#)/s/m^2] + real(r8) fevp1_t_rate, fevp2_t_rate ! Evaporation rate of precipitation within downdraft at the top interface [(kg/kg)/Pa] >= 0. + real(r8) fevp1_b_rate, fevp2_b_rate ! Evaporation rate of precipitation within downdraft at the base interface [(kg/kg)/Pa] >= 0. + + ! ------------------------ ! + ! Turbulent flux variables ! + ! ------------------------ ! + + real(r8) slflx_u(0:mkx) ! Convective updraft liquid static energy flux [J/s/m2] + real(r8) qtflx_u(0:mkx) ! Convective updraft total water flux [kg/s/m2] + real(r8) uflx_u(0:mkx) ! Convective updraft zonal momentum flux [kg m/s/s/m2] + real(r8) vflx_u(0:mkx) ! Convective updraft meridional momentum flux [kg m/s/s/m2] + real(r8) qlflx_u(0:mkx) ! Convective updraft ql flux [kg/s/m2] + real(r8) qiflx_u(0:mkx) ! Convective updraft qi flux [kg/s/m2] + real(r8) trflx_u(0:mkx,ncnst) ! Convective updraft tracer flux [ #/s/m2, kg/s/m2 ] + + real(r8) slflx_d(0:mkx) ! Convective downdraft liquid static energy flux [J/s/m2] + real(r8) qtflx_d(0:mkx) ! Convective downdraft total water flux [kg/s/m2] + real(r8) uflx_d(0:mkx) ! Convective downdraft zonal momentum flux [kg m/s/s/m2] + real(r8) vflx_d(0:mkx) ! Convective downdraft meridional momentum flux [kg m/s/s/m2] + real(r8) qlflx_d(0:mkx) ! Convective downdraft ql flux [kg/s/m2] + real(r8) qiflx_d(0:mkx) ! Convective downdraft qi flux [kg/s/m2] + real(r8) trflx_d(0:mkx,ncnst) ! Convective downdraft tracer flux [ #/s/m2, kg/s/m2 ] + + real(r8) uflx(0:mkx) ! Reconstructed convective zonal momentum flux [kg m/s/s/m2] + real(r8) vflx(0:mkx) ! Reconstructed convective meridional momentum flux [kg m/s/s/m2] + + real(r8) thlflx_d_org_pblh ! Adiabatic organization forcing. Convective downdraft flux of thl at the PBL top [kg*K/s/m2] + real(r8) qtflx_d_org_pblh ! Adiabatic organization forcing. Convective downdraft flux of qt at the PBL top [kg*(kg/kg)/s/m2] + real(r8) uflx_d_org_pblh ! Adiabatic organization forcing. Convective downdraft flux of u at the PBL top [kg*(m/s)/s/m2] + real(r8) vflx_d_org_pblh ! Adiabatic organization forcing. Convective downdraft flux of v at the PBL top [kg*(m/s)/s/m2] + real(r8) trflx_d_org_pblh(ncnst) ! Adiabatic organization forcing. Convective downdraft flux of tr at the PBL top [kg*(kg/kg)/s/m2, kg*(#/kg)/s/m2] + + real(r8) cmf_d_org_pblh ! Organization-inducing downdraft mass flux at the PBL top interface [kg/s/m2] + real(r8) thl_d_org_pblh + real(r8) qt_d_org_pblh + real(r8) u_d_org_pblh + real(r8) v_d_org_pblh + real(r8) tr_d_org_pblh(ncnst) + + real(r8) thl_dia_d_org ! Diabatic organization forcing of thl within convective downdraft [ K / s ] + real(r8) qt_dia_d_org ! Diabatic organization forcing of qt within convective downdraft [ kg / kg / s ] + real(r8) tr_dia_d_org(ncnst) ! Diabatic organization forcing of tracers within convective downdraft [ kg / kg / s or # / kg / s ] + + real(r8) thl_dia_und_org ! Diabatic organization forcing of thl within convective updraft and downdraft [ K / s ] + real(r8) qt_dia_und_org ! Diabatic organization forcing of qt within convective updraft and downdraft [ kg / kg / s ] + real(r8) tr_dia_und_org(ncnst) ! Diabatic organization forcing of tracers within convective updraft and downdraft [ kg / kg / s or # / kg / s ] + + real(r8) thl_dia_env_org ! Diabatic organization forcing of thl within environment [ K / s ] + real(r8) qt_dia_env_org ! Diabatic organization forcing of qt within environment [ kg / kg / s ] + real(r8) tr_dia_env_org(ncnst) ! Diabatic organization forcing of tracers within environment [ kg / kg / s or # / kg / s ] + + ! May.1.2014. Below '_d_orgU' and '_u_org' variables are added for 'budget consistent coldpool' treatment (i_budget_coldpool = 1,2 ). + + real(r8) thlflx_d_orgU_pblh ! Adiabatic organization forcing. Convective downdraft flux of thl at the PBL top [kg*K/s/m2] + real(r8) qtflx_d_orgU_pblh ! Adiabatic organization forcing. Convective downdraft flux of qt at the PBL top [kg*(kg/kg)/s/m2] + real(r8) uflx_d_orgU_pblh ! Adiabatic organization forcing. Convective downdraft flux of u at the PBL top [kg*(m/s)/s/m2] + real(r8) vflx_d_orgU_pblh ! Adiabatic organization forcing. Convective downdraft flux of v at the PBL top [kg*(m/s)/s/m2] + real(r8) trflx_d_orgU_pblh(ncnst) ! Adiabatic organization forcing. Convective downdraft flux of tr at the PBL top [kg*(kg/kg)/s/m2, kg*(#/kg)/s/m2] + + real(r8) cmf_d_orgU_pblh ! Organization-inducing downdraft mass flux at the PBL top interface [kg/s/m2] + real(r8) thl_d_orgU_pblh + real(r8) qt_d_orgU_pblh + real(r8) u_d_orgU_pblh + real(r8) v_d_orgU_pblh + real(r8) tr_d_orgU_pblh(ncnst) + + real(r8) thl_dia_d_orgU ! Diabatic organization forcing of thl within convective downdraft [ K / s ] + real(r8) qt_dia_d_orgU ! Diabatic organization forcing of qt within convective downdraft [ kg / kg / s ] + real(r8) tr_dia_d_orgU(ncnst) ! Diabatic organization forcing of tracers within convective downdraft [ kg / kg / s or # / kg / s ] + + real(r8) cmf_u_org_pblh ! = cmf_u(kpblhm) + real(r8) thlflx_u_org_pblh ! Adiabatic organization forcing. Convective updraft flux of thl at the PBL top [kg*K/s/m2] + real(r8) qtflx_u_org_pblh ! Adiabatic organization forcing. Convective updraft flux of qt at the PBL top [kg*(kg/kg)/s/m2] + real(r8) uflx_u_org_pblh ! Adiabatic organization forcing. Convective updraft flux of u at the PBL top [kg*(m/s)/s/m2] + real(r8) vflx_u_org_pblh ! Adiabatic organization forcing. Convective updraft flux of v at the PBL top [kg*(m/s)/s/m2] + real(r8) trflx_u_org_pblh(ncnst) ! Adiabatic organization forcing. Convective updraft flux of tr at the PBL top [kg*(kg/kg)/s/m2, kg*(#/kg)/s/m2] + + ! ------------------ ! + ! Tendency variables ! + ! ------------------ ! + + real(r8) qvten(mkx) ! Total tendency of qv [kg/kg/s] + real(r8) qlten(mkx) ! Total tendency of ql [kg/kg/s] + real(r8) qiten(mkx) ! Total tendency of qi [kg/kg/s] + real(r8) sten(mkx) ! Total tendency of s [J/kg/s] + real(r8) uten(mkx) ! Total tendency of u [m/s/s] + real(r8) vten(mkx) ! Total tendency of v [m/s/s] + real(r8) trten(mkx,ncnst) ! Total tendency of tracers [ #/kg/s, kg/kg/s ] + + real(r8) slten_u(mkx) ! Tendency of sl by updraft mass flux [J/kg/s] + real(r8) qtten_u(mkx) ! Tendency of qt by updraft mass flux [kg/kg/s] + real(r8) uten_u(mkx) ! Tendency of u by updraft mass flux [m/s/s] + real(r8) vten_u(mkx) ! Tendency of v by updraft mass flux [m/s/s] + real(r8) sten_u(mkx) ! Tendency of s by updraft mass flux [J/kg/s] + real(r8) qvten_u(mkx) ! Tendency of qv by updraft mass flux [kg/kg/s] + real(r8) qlten_u(mkx) ! Tendency of ql by updraft mass flux [kg/kg/s] + real(r8) qiten_u(mkx) ! Tendency of qi by updraft mass flux [kg/kg/s] + real(r8) trten_u(mkx,ncnst) ! Tendency of tracer by updraft mass flux [#/kg/s, kg/kg/s] + + real(r8) slten_d(mkx) ! Tendency of sl by downdraft mass flux [J/kg/s] + real(r8) qtten_d(mkx) ! Tendency of qt by downdraft mass flux [kg/kg/s] + real(r8) uten_d(mkx) ! Tendency of u by downdraft mass flux [m/s/s] + real(r8) vten_d(mkx) ! Tendency of v by downdraft mass flux [m/s/s] + real(r8) sten_d(mkx) ! Tendency of s by downdraft mass flux [J/kg/s] + real(r8) qvten_d(mkx) ! Tendency of qv by downdraft mass flux [kg/kg/s] + real(r8) qlten_d(mkx) ! Tendency of ql by downdraft mass flux [kg/kg/s] + real(r8) qiten_d(mkx) ! Tendency of qi by downdraft mass flux [kg/kg/s] + real(r8) trten_d(mkx,ncnst) ! Tendency of tracer by downdraft mass flux [#/kg/s, kg/kg/s] + + real(r8) slten_evp(mkx) ! Tendency of sl by convective precipitation and evaporation of convective precip. [J/kg/s] + real(r8) qtten_evp(mkx) ! Tendency of qt by convective precipitation and evaporation of convective precip. [kg/kg/s] + real(r8) uten_evp(mkx) ! Tendency of u by convective precipitation and evaporation of convective precip. [m/s/s] + real(r8) vten_evp(mkx) ! Tendency of v by convective precipitation and evaporation of convective precip. [m/s/s] + real(r8) sten_evp(mkx) ! Tendency of s by convective precipitation and evaporation of convective precip. [J/kg/s] + real(r8) qvten_evp(mkx) ! Tendency of qv by convective precipitation and evaporation of convective precip. [kg/kg/s] + real(r8) qlten_evp(mkx) ! Tendency of ql by convective precipitation and evaporation of convective precip. [kg/kg/s] + real(r8) qiten_evp(mkx) ! Tendency of qi by convective precipitation and evaporation of convective precip. [kg/kg/s] + real(r8) trten_evp(mkx,ncnst) ! Tendency of tracer by convective precipitation and evaporation of convective precip. [#/kg/s, kg/kg/s] + real(r8) trten_wdep(mkx,ncnst) ! Tendency of tracer by wet deposition within environment by convective precip. [#/kg/s, kg/kg/s] + + real(r8) slten_dis(mkx) ! Tendency of sl by dissipative heating of mean kinetic energy [J/kg/s] + real(r8) qtten_dis(mkx) ! Tendency of qt by dissipative heating of mean kinetic energy [kg/kg/s] + real(r8) uten_dis(mkx) ! Tendency of u by dissipative heating of mean kinetic energy [m/s/s] + real(r8) vten_dis(mkx) ! Tendency of v by dissipative heating of mean kinetic energy [m/s/s] + real(r8) sten_dis(mkx) ! Tendency of s by dissipative heating of mean kinetic energy [J/kg/s] + real(r8) qvten_dis(mkx) ! Tendency of qv by dissipative heating of mean kinetic energy [kg/kg/s] + real(r8) qlten_dis(mkx) ! Tendency of ql by dissipative heating of mean kinetic energy [kg/kg/s] + real(r8) qiten_dis(mkx) ! Tendency of qi by dissipative heating of mean kinetic energy [kg/kg/s] + real(r8) trten_dis(mkx,ncnst) ! Tendency of tracer by dissipative heating of mean kinetic energy [#/kg/s, kg/kg/s] + + real(r8) slten_par(mkx) ! Tendency of sl by partitioning the tendency in the lowest layer in the layers within the PBL [J/kg/s] + real(r8) qtten_par(mkx) ! Tendency of qt by partitioning the tendency in the lowest layer in the layers within the PBL [kg/kg/s] + real(r8) qlten_par(mkx) ! Tendency of ql by partitioning the tendency in the lowest layer in the layers within the PBL [kg/kg/s] + real(r8) qiten_par(mkx) ! Tendency of qi by partitioning the tendency in the lowest layer in the layers within the PBL [kg/kg/s] + real(r8) uten_par(mkx) ! Tendency of u by partitioning the tendency in the lowest layer in the layers within the PBL [m/s/s] + real(r8) vten_par(mkx) ! Tendency of v by partitioning the tendency in the lowest layer in the layers within the PBL [m/s/s] + real(r8) trten_par(mkx,ncnst) ! Tendency of tracer by partitioning the tendency in the lowest layer in the layers within the PBL [#/kg/s, kg/kg/s] + + real(r8) slten_NUM(mkx) ! Final Numerical tendency of sl [J/kg/s] + real(r8) qtten_NUM(mkx) ! Final Numerical tendency of qt [kg/kg/s] + real(r8) uten_NUM(mkx) ! Final Numerical tendency of u [m/s/s] + real(r8) vten_NUM(mkx) ! Final Numerical tendency of v [m/s/s] + real(r8) qvten_NUM(mkx) ! Final Numerical tendency of qv [kg/kg/s] + real(r8) qlten_NUM(mkx) ! Final Numerical tendency of ql [kg/kg/s] + real(r8) qiten_NUM(mkx) ! Final Numerical tendency of qi [kg/kg/s] + real(r8) sten_NUM(mkx) ! Final Numerical tendency of s [J/kg/s] + real(r8) trten_NUM(mkx,ncnst) ! Final Numerical tendency of tracer [#/kg/s, kg/kg/s] + + real(r8) qrten(mkx) ! Production rate of rain by the expels of in-cumulus excessive condensate [kg/kg/s] + real(r8) qsten(mkx) ! Production rate of snow by the expels of in-cumulus excessive condensate [kg/kg/s] + + real(r8) qrten_u(mkx) ! Production rate of rain by the expels of in-cumulus excessive condensate within updraft [kg/kg/s] + real(r8) qsten_u(mkx) ! Production rate of snow by the expels of in-cumulus excessive condensate within updraft [kg/kg/s] + + real(r8) qrten_u_msfc(mkx,nseg) ! Production rate of rain by the expels of in-cumulus excessive condensate within updraft for each original updraft segment [kg/kg/s] + real(r8) qsten_u_msfc(mkx,nseg) ! Production rate of snow by the expels of in-cumulus excessive condensate within updraft for each original updraft segment [kg/kg/s] + real(r8) trrsten_u_msfc(mkx,nseg,ncnst) ! Production rate of precipitating tracers by the expels of in-cumulus tracers within updraft for each original updraft segment [kg/kg/s,#/kg/s] + + real(r8) qrten_d(mkx) ! Production rate of rain by the expels of in-cumulus excessive condensate within downdraft [kg/kg/s] + real(r8) qsten_d(mkx) ! Production rate of snow by the expels of in-cumulus excessive condensate within downdraft [kg/kg/s] + + real(r8) qrten_d_msfc(mkx,nseg) ! Production rate of rain by the expels of in-cumulus excessive condensate within downdraft for each original updraft segment [kg/kg/s] + real(r8) qsten_d_msfc(mkx,nseg) ! Production rate of snow by the expels of in-cumulus excessive condensate within downdraft for each original updraft segment [kg/kg/s] + real(r8) trrsten_d_msfc(mkx,nseg,ncnst) ! Production rate of tracers by the expels of in-cumulus excessive tracers within downdraft for each original updraft segment [kg(#)/kg/s] + + real(r8) snowmlt_e(mkx) ! Snow melting tendency within environment before evaporation within downdraft [kg/kg/s] + real(r8) snowmlt_e_msfc(mkx,nseg) ! Snow melting tendency within environment before evaporation within downdraft for each original updraft segment [kg/kg/s] + + real(r8) thlten_dia_u(mkx) ! Diabatic tendency of thl within updraft [K/s] + real(r8) thlten_dia_d(mkx) ! Diabatic tendency of thl within downdraft [K/s] + + real(r8) qtten_dia_u(mkx) ! Diabatic tendency of qt within updraft [K/s] + real(r8) qtten_dia_d(mkx) ! Diabatic tendency of qt within downdraft [K/s] + + real(r8) qlten_dia_u(mkx) ! Diabatic tendency of ql within updraft ( exclude effective tendency ) [kg/kg/s] + real(r8) qlten_dia_d(mkx) ! Diabatic tendency of ql within downdraft ( exclude effective tendency ) [kg/kg/s] + + real(r8) qiten_dia_u(mkx) ! Diabatic tendency of qi within updraft ( exclude effective tendency ) [kg/kg/s] + real(r8) qiten_dia_d(mkx) ! Diabatic tendency of qi within downdraft ( exclude effective tendency ) [kg/kg/s] + + real(r8) trten_dia_u(mkx,ncnst) ! Diabatic tendency of tracers within updraft ( exclude effective tendency ) [#/kg/s, kg/kg/s] + real(r8) trten_dia_d(mkx,ncnst) ! Diabatic tendency of tracers within downdraft ( exclude effective tendency ) [#/kg/s, kg/kg/s] + + real(r8) ntraprd(mkx) ! Net production rate of rain ( qrten(k) + snowmlt(k) - evprain(k) ) [kg/kg/s] + real(r8) ntsnprd(mkx) ! Net production rate of snow ( qsten(k) - snowmlt(k) - evpsnow(k) ) [kg/kg/s] + real(r8) nttrrsprd(mkx,ncnst) ! Net production rate of tracer ( trrsten(k) - evptrrs + wdeptrrs ) [kg(#)/kg/s] + + real(r8) ntraprd_msfc(mkx,nseg) ! Net production rate of rain ( qrten(k) + snowmlt(k) - evprain ) for each original updraft segment [kg/kg/s] + real(r8) ntsnprd_msfc(mkx,nseg) ! Net production rate of snow ( qsten(k) - snowmlt(k) - evpsnow ) for each original updraft segment [kg/kg/s] + real(r8) nttrrsprd_msfc(mkx,nseg,ncnst) ! Net production rate of tracer ( trrsten(k) - evptrrs + wdeptrrs ) for each original updraft segment [kg(#)/kg/s] + + real(r8) evprain_e(mkx) ! Evaporation rate of rain in the environment [kg/kg/s] + real(r8) evpsnow_e(mkx) ! Evaporation rate of snow in the environment [kg/kg/s] + real(r8) evptrrs_e(mkx,ncnst) ! Evaporation rate of tracers in the environment [kg(#)/kg/s] > 0. + real(r8) wdeptrrs_e(mkx,ncnst) ! Wet deposition rate of tracers in the environment [kg(#)/kg/s] > 0. + + real(r8) evprain_d(mkx) ! Evaporation rate of rain in the downdraft [kg/kg/s] + real(r8) evpsnow_d(mkx) ! Evaporation rate of snow in the downdraft [kg/kg/s] + real(r8) evptrrs_d(mkx,ncnst) ! Evaporation rate of tracers in the downdraft [kg(#)/kg/s] > 0. + + real(r8) evprain_e_msfc(mkx,nseg) ! Evaporation rate of rain for each original updraft segment in the environment [kg/kg/s] + real(r8) evpsnow_e_msfc(mkx,nseg) ! Evaporation rate of snow for each original updraft segment in the environment [kg/kg/s] + real(r8) evptrrs_e_msfc(mkx,nseg,ncnst) ! Evaporation rate of tracer for each original updraft segment in the environment [kg(#)/kg/s] > 0. + real(r8) wdeptrrs_e_msfc(mkx,nseg,ncnst) ! Wet deposition rate of tracer for each original updraft segment in the environment [kg(#)/kg/s] > 0. + + real(r8) evprain_d_msfc(mkx,nseg) ! Evaporation rate of rain for each original updraft segment in the downdraft [kg/kg/s] + real(r8) evpsnow_d_msfc(mkx,nseg) ! Evaporation rate of snow for each original updraft segment in the downdraft [kg/kg/s] + real(r8) evptrrs_d_msfc(mkx,nseg,ncnst) ! Evaporation rate of tracer for each original updraft segment in the downdraft [kg(#)/kg/s] > 0. + + real(r8) cvp_rainprd(mkx) ! Corrective production of rain from environmental qv0 [kg/kg/s] + real(r8) cvp_snowprd(mkx) ! Corrective production of snow from environmental qv0 [kg/kg/s] + real(r8) cvp_trrsprd(mkx,ncnst) ! Corrective production of tracer from environmental tr0 [kg(#)/kg/s] + + real(r8) cvp_rainprd_msfc(mkx,nseg) ! Corrective production of rain from environmental qv0 for each original updraft segment [kg/kg/s] + real(r8) cvp_snowprd_msfc(mkx,nseg) ! Corrective production of snow from environmental qv0 for each original updraft segment [kg/kg/s] + real(r8) cvp_trrsprd_msfc(mkx,nseg,ncnst) ! Corrective production of tracers from environmental tr0 for each original updraft segment [kg(#)/kg/s] + + real(r8) qlten_eff_u(mkx) ! Effective diabatic tendency on the updraft cloud condensate 'ql' [kg/kg/s] + real(r8) qiten_eff_u(mkx) ! Effective diabatic tendency on the updraft cloud condensate 'qi' [kg/kg/s] + + real(r8) qlten_eff_d(mkx) ! Effective diabatic tendency on the downdraft cloud condensate 'ql' [kg/kg/s] + real(r8) qiten_eff_d(mkx) ! Effective diabatic tendency on the downdraft cloud condensate 'qi' [kg/kg/s] + + real(r8) trten_eff_u(mkx,ncnst) ! Effective diabatic tendency on the updraft tracers [#/kg/s, kg/kg/s] + real(r8) trten_eff_d(mkx,ncnst) ! Effective diabatic tendency on the downdraft tracers [#/kg/s, kg/kg/s] + + real(r8) uf(mkx) ! Provisional environmental zonal wind + real(r8) vf(mkx) ! Provisional environmental meridional wind + + real(r8) ql_env_ua(mkx) ! ql of imported airs into the layer due to the compensating subsidence by updraft mass flux at the top interface + real(r8) qi_env_ua(mkx) ! qi of imported airs into the layer due to the compensating subsidence by updraft mass flux at the top interface + + real(r8) ql_env_da(mkx) ! ql of imported airs into the layer due to the compensating subsidence by downdraft mass flux at the top interface + real(r8) qi_env_da(mkx) ! qi of imported airs into the layer due to the compensating subsidence by downdraft mass flux at the top interface + + ! ------------------------------------------------------------------------------------ ! + ! Variables associated with mixing with multiple mixing environmental airs ( '_mxen' ) ! + ! ------------------------------------------------------------------------------------ ! + + integer ktop_mxen(niter) ! The top layer index of convective updraft + + real(r8) cuorg_mxen ! Temporary convective organization used only for multiple mixing. Either 0 ( when iter = 1 ) or 1 ( when iter = 2 ) + real(r8) cush_mxen(niter) ! Maximum updraft top height [ m ] + real(r8) cushavg_mxen(niter) ! Updraft top height weighted by updraft mass flux at surface [ m ] + + real(r8) cu_cmfum_mxen(mkx,niter) ! Total amount of updraft mass flux involved in the buoyancy sorting [kg/m2/s] + real(r8) cu_cmfr_mxen(mkx,niter) ! Total amount of detrained mass into the environment ( may also contain updraft properties ) [kg/m2/s] + real(r8) cu_thlr_mxen(mkx,niter) ! Mass flux weighted anomalous conservative scalar of detrained airs + real(r8) cu_qtr_mxen(mkx,niter) + real(r8) cu_ur_mxen(mkx,niter) + real(r8) cu_vr_mxen(mkx,niter) + real(r8) cu_qlr_mxen(mkx,niter) + real(r8) cu_qir_mxen(mkx,niter) + real(r8) cu_trr_mxen(mkx,ncnst,niter) + real(r8) cu_cmfrd_mxen(mkx,niter) ! Total amount of detrained mass into the environment from convective downdraft [kg/m2/s] + real(r8) cu_thlrd_mxen(mkx,niter) + real(r8) cu_qtrd_mxen(mkx,niter) + real(r8) cu_urd_mxen(mkx,niter) + real(r8) cu_vrd_mxen(mkx,niter) + real(r8) cu_qlrd_mxen(mkx,niter) + real(r8) cu_qird_mxen(mkx,niter) + real(r8) cu_trrd_mxen(mkx,ncnst,niter) + + real(r8) cmf_u_mxen(0:mkx,niter) + real(r8) cmf_d_mxen(0:mkx,niter) + real(r8) slflx_u_mxen(0:mkx,niter) + real(r8) slflx_d_mxen(0:mkx,niter) + real(r8) qtflx_u_mxen(0:mkx,niter) + real(r8) qtflx_d_mxen(0:mkx,niter) + real(r8) uflx_u_mxen(0:mkx,niter) + real(r8) uflx_d_mxen(0:mkx,niter) + real(r8) vflx_u_mxen(0:mkx,niter) + real(r8) vflx_d_mxen(0:mkx,niter) + + real(r8) flxrain_u_mxen(0:mkx,niter) + real(r8) flxsnow_u_mxen(0:mkx,niter) + + real(r8) thl_orgforce_mxen(niter) ! Total forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) qt_orgforce_mxen(niter) ! Total forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) u_orgforce_mxen(niter) ! Total forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) v_orgforce_mxen(niter) ! Total forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) tr_orgforce_mxen(ncnst,niter) ! Total forcing for organized difference between 'off-wake' and 'grid-mean' tracers [ kg / kg / s or # / kg / s ] + real(r8) awk_orgforce_mxen(niter) ! Total forcing for wake area [ 1 / s ] + + ! Below block is for detailed diagnostic output + + real(r8) thl_orgforce_flx_mxen(niter) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) qt_orgforce_flx_mxen(niter) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) u_orgforce_flx_mxen(niter) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) v_orgforce_flx_mxen(niter) ! PBL top flux-related forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) awk_orgforce_flx_mxen(niter) ! PBL top flux-related forcing for wake area [ 1 / s ] + + real(r8) thl_orgforce_und_mxen(niter) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) qt_orgforce_und_mxen(niter) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) u_orgforce_und_mxen(niter) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) v_orgforce_und_mxen(niter) ! Up-and-Down diabatic forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) awk_orgforce_mix_mxen(niter) ! Lateral-Mixing forcing for wake area [ 1 / s ] + + real(r8) thl_orgforce_env_mxen(niter) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' thl [ K / s ] + real(r8) qt_orgforce_env_mxen(niter) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' qt [ kg / kg / s ] + real(r8) u_orgforce_env_mxen(niter) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' u [ m / s / s ] + real(r8) v_orgforce_env_mxen(niter) ! Environment diabatic forcing for organized difference between 'off-wake' and 'grid-mean' v [ m / s / s ] + real(r8) cmf_d_org_pblh_mxen(niter) ! Organization-inducing downdraft mass flux at the PBL top interface [ kg / m^2 / s ] + + ! Above block is for detailed diagnostic output + + real(r8) taui_thl_mxen(niter) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' thl [ 1 / s ] + real(r8) taui_qt_mxen(niter) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' qt [ 1 / s ] + real(r8) taui_u_mxen(niter) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' u [ 1 / s ] + real(r8) taui_v_mxen(niter) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' v [ 1 / s ] + real(r8) taui_tr_mxen(ncnst,niter) ! Inverse of damping time scale of the difference between 'off-wake' and 'grid-mean' tracers [ 1 / s ] + real(r8) taui_awk_mxen(niter) ! Inverse of damping time scale of the wake area [ 1 / s ] + + real(r8) del_org_mxen(niter) ! Detrainment rate of the cold pool [ 1 / s ] + real(r8) del0_org_mxen(niter) ! Effective detrainment rate of the cold pool [ 1 / s ] + + real(r8) qvten_mxen(mkx,niter) + real(r8) qlten_mxen(mkx,niter) + real(r8) qiten_mxen(mkx,niter) + real(r8) trten_mxen(mkx,ncnst,niter) + real(r8) sten_mxen(mkx,niter) + real(r8) uten_mxen(mkx,niter) + real(r8) vten_mxen(mkx,niter) + real(r8) qrten_mxen(mkx,niter) + real(r8) qsten_mxen(mkx,niter) + + real(r8) rqc_l_mxen(mkx,niter) + real(r8) rqc_i_mxen(mkx,niter) + real(r8) rqc_mxen(mkx,niter) + real(r8) rnc_l_mxen(mkx,niter) + real(r8) rnc_i_mxen(mkx,niter) + + real(r8) cmf_det_mxen(mkx,niter) + real(r8) ql_det_mxen(mkx,niter) + real(r8) qi_det_mxen(mkx,niter) + + real(r8) evapc_mxen(mkx,niter) + + real(r8) am_u_mxen(mkx,niter) + real(r8) qlm_u_mxen(mkx,niter) + real(r8) qim_u_mxen(mkx,niter) + + real(r8) am_d_mxen(mkx,niter) + real(r8) qlm_d_mxen(mkx,niter) + real(r8) qim_d_mxen(mkx,niter) + + real(r8) rliq_mxen(niter) + real(r8) precip_mxen(niter) + real(r8) snow_mxen(niter) + + real(r8) cnt_mxen(niter) + real(r8) cnb_mxen(niter) + + real(r8) slten_u_mxen(mkx,niter) + real(r8) qtten_u_mxen(mkx,niter) + real(r8) uten_u_mxen(mkx,niter) + real(r8) vten_u_mxen(mkx,niter) + real(r8) sten_u_mxen(mkx,niter) + real(r8) qvten_u_mxen(mkx,niter) + real(r8) qlten_u_mxen(mkx,niter) + real(r8) qiten_u_mxen(mkx,niter) + real(r8) trten_u_mxen(mkx,ncnst,niter) + + real(r8) slten_d_mxen(mkx,niter) + real(r8) qtten_d_mxen(mkx,niter) + real(r8) uten_d_mxen(mkx,niter) + real(r8) vten_d_mxen(mkx,niter) + real(r8) sten_d_mxen(mkx,niter) + real(r8) qvten_d_mxen(mkx,niter) + real(r8) qlten_d_mxen(mkx,niter) + real(r8) qiten_d_mxen(mkx,niter) + real(r8) trten_d_mxen(mkx,ncnst,niter) + + real(r8) slten_evp_mxen(mkx,niter) + real(r8) qtten_evp_mxen(mkx,niter) + real(r8) uten_evp_mxen(mkx,niter) + real(r8) vten_evp_mxen(mkx,niter) + real(r8) sten_evp_mxen(mkx,niter) + real(r8) qvten_evp_mxen(mkx,niter) + real(r8) qlten_evp_mxen(mkx,niter) + real(r8) qiten_evp_mxen(mkx,niter) + real(r8) trten_evp_mxen(mkx,ncnst,niter) + + real(r8) qlten_sub_mxen(mkx,niter) + real(r8) qiten_sub_mxen(mkx,niter) + + real(r8) qlten_det_mxen(mkx,niter) + real(r8) qiten_det_mxen(mkx,niter) + + real(r8) thl_u_mxen(0:mkx,niter) + real(r8) qt_u_mxen(0:mkx,niter) + real(r8) u_u_mxen(0:mkx,niter) + real(r8) v_u_mxen(0:mkx,niter) + real(r8) w_u_mxen(0:mkx,niter) + real(r8) ql_u_mxen(0:mkx,niter) + real(r8) qi_u_mxen(0:mkx,niter) + real(r8) tr_u_mxen(0:mkx,ncnst,niter) + real(r8) a_u_mxen(0:mkx,niter) + real(r8) num_u_mxen(0:mkx,niter) + real(r8) wa_u_mxen(0:mkx,niter) + real(r8) qla_u_mxen(0:mkx,niter) + real(r8) qia_u_mxen(0:mkx,niter) + real(r8) rad_u_mxen(0:mkx,niter) + real(r8) thva_u_mxen(0:mkx,niter) + + real(r8) a_p_mxen(0:mkx,niter) + real(r8) am_evp_mxen(mkx,niter) + real(r8) am_pu_mxen(mkx,niter) + real(r8) x_p_mxen(0:mkx,niter) + real(r8) y_p_mxen(0:mkx,niter) + real(r8) x_um_mxen(mkx,niter) + real(r8) y_um_mxen(mkx,niter) + + real(r8) thl_d_mxen(0:mkx,niter) + real(r8) qt_d_mxen(0:mkx,niter) + real(r8) u_d_mxen(0:mkx,niter) + real(r8) v_d_mxen(0:mkx,niter) + real(r8) w_d_mxen(0:mkx,niter) + real(r8) ql_d_mxen(0:mkx,niter) + real(r8) qi_d_mxen(0:mkx,niter) + real(r8) tr_d_mxen(0:mkx,ncnst,niter) + real(r8) a_d_mxen(0:mkx,niter) + real(r8) wa_d_mxen(0:mkx,niter) + real(r8) qla_d_mxen(0:mkx,niter) + real(r8) qia_d_mxen(0:mkx,niter) + + real(r8) thl_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) qt_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) u_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) v_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) w_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) ql_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) qi_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) tr_u_msfc_mxen(0:mkx,nseg,ncnst,niter) + real(r8) cmf_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) a_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) num_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) rad_u_msfc_mxen(0:mkx,nseg,niter) + + real(r8) eps0_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) eps_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) del_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) eeps_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) ddel_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) xc_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) xs_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) xemin_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) xemax_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) cridis_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) thvcuenv_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) thvegenv_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) thvxsenv_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) fmix_u_msfc_mxen(0:mkx,nseg,niter) + real(r8) cmfumix_u_msfc_mxen(0:mkx,nseg,niter) + + real(r8) thl_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) qt_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) u_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) v_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) w_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) ql_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) qi_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) tr_d_msfc_mxen(0:mkx,nseg,ncnst,niter) + real(r8) cmf_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) a_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) wa_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) qla_d_msfc_mxen(0:mkx,nseg,niter) + real(r8) qia_d_msfc_mxen(0:mkx,nseg,niter) + + real(r8) ptop_msfc_mxen(nseg,niter) + real(r8) ztop_msfc_mxen(nseg,niter) + + ! ---------------- ! + ! Single Variables ! + ! ---------------- ! + + character(len=2) numcha + integer i, k, kv, ki, kvi, km, kp, ks, m, mm, ids, kc, mt, l, lspec, ixi, ixf + integer iter, iacc + integer nseg_det, nseg_nondet + integer ktop, ktop_up_par, ktop_dn_par, ks_top, ks_bot, msfc + integer ixcldliq, ixcldice, ixnumliq, ixnumice + integer i_awk, i_thl, i_qt, i_u, i_v + + integer N_up(0:mkx) ! # of updraft segments at the base interface [ # ] + + integer kpblh ! Layer index with PBL top in it or at the base interface + integer kpblhm ! = kpblh - 1 + real(r8) pblh ! PBL top height [ m ] + real(r8) pblhz ! Thickness of PBL depth in [ m ]. pblhz = zs0(kpblhm) - zs0(0). + real(r8) pblhp ! Thickness of PBL depth in [ Pa ]. pblhp = ps0(0) - ps0(kpblhm). + real(r8) went ! Entrainment rate at the PBL top interface directly from the UW PBL scheme [ m/s ] + real(r8) qflx ! Upward water vapor flux into atmosphere at surface [ kg/m2/s ] + real(r8) shflx ! Upward sensible heat flux into atmosphere at surface [ J/m2/s ] + real(r8) taux ! Upward zonal wind stress into atmosphere at surface [ kg m/s /m2/s ] + real(r8) tauy ! Upward meridional wind stress into atmosphere at surface [ kg m/s /m2/s ] + real(r8) aflx(ncnst) ! Upward tracer fluxes into atmosphere at surface [ #/m2/s, kg/m2/s ] + real(r8) landfrac ! Land Fraction [ fraction ] + real(r8) sgh30 ! Standard deviation of subgrid topographic height at 30 s horizontal area [ meter ] + real(r8) cush ! Input cumulus top height [ m ] + real(r8) cushavg ! Input mean cumulus top height weighted by updraft mass flux at surface [ m ] + real(r8) cuorg ! Input convective organization [ 0-1 ] + real(r8) awk_PBL_raw ! Wake area within PBL [ 0 - 1 ] + real(r8) delta_thl_PBL_raw ! Difference of thl between off-wake region and grid-mean value averaged over the PBL [ K ] + real(r8) delta_qt_PBL_raw ! Difference of qt between off-wake region and grid-mean value averaged over the PBL [ kg/kg ] + real(r8) delta_u_PBL_raw ! Difference of u between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8) delta_v_PBL_raw ! Difference of v between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8) delta_thv_PBL_raw ! Difference of thv between off-wake region and grid-mean value averaged over the PBL [ K ] + real(r8) delta_tr_PBL_raw(ncnst) ! Difference of tr between off-wake region and grid-mean value averaged over the PBL [ kg/kg, #/kg ] + real(r8) awk_PBL_max ! Maximum alloed wake area within PBL [ 0 - 1 ] + real(r8) awk_PBL ! Wake area within PBL [ 0 - 1 ] + real(r8) delta_thl_PBL ! Difference of thl between off-wake region and grid-mean value averaged over the PBL [ K ] + real(r8) delta_qt_PBL ! Difference of qt between off-wake region and grid-mean value averaged over the PBL [ kg/kg ] + real(r8) delta_u_PBL ! Difference of u between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8) delta_v_PBL ! Difference of v between off-wake region and grid-mean value averaged over the PBL [ m/s ] + real(r8) delta_thv_PBL ! Difference of thv between off-wake region and grid-mean value averaged over the PBL [ K ] + real(r8) delta_tr_PBL(ncnst) ! Difference of tr between off-wake region and grid-mean value averaged over the PBL [ kg/kg, #/kg ] + real(r8) delta_w_PBL ! Difference of w between off-wake region and grid-mean value averaged over the PBL [ m/s ] + + real(r8) cu_cmfr(mkx) + real(r8) cu_thlr(mkx) + real(r8) cu_qtr(mkx) + real(r8) cu_ur(mkx) + real(r8) cu_vr(mkx) + real(r8) cu_qlr(mkx) + real(r8) cu_qir(mkx) + real(r8) cu_trr(mkx,ncnst) + + real(r8) tke1 ! TKE in the lowest model layer [ m2/s2 ] + real(r8) wstar1 ! wstar in the lowest model layer ( = ( 2.5 integral ( bprod * dz ) )^(1/3) ) [ m/s ] + real(r8) wstar2 ! wstar2 = ( bprod_sfc * PBLH )^(1/3) [ m/s ] + real(r8) tkePBL ! TKE within the PBL [ m2/s2 ] + real(r8) wstarPBL ! wstar within the PBL [ m/s ]. In principle, should be the sams as the input wstar but not. + real(r8) dpi, dzi + real(r8) qt0PBL, thl0PBL, u0PBL, v0PBL, tr0PBL(ncnst) + real(r8) qt0min_PBL, thl0min_PBL, tr0min_PBL(ncnst) + real(r8) eps_wk_eff, del_wk_eff + real(r8) a_oro ! Forbidden area from the subgrid scale variation of topography [ fraction ] + real(r8) a_forbid ! Total forbidden area ( awk_PBL + a_oro ) [ fraction ] + real(r8) c0_ac ! Auto-conversion efficiency of CAM5 deep convection scheme [ 1 / m ] + real(r8) criqc ! Critical condensate amount that updraft can hold [ kg / kg ] + real(r8) au_base_max, au_base_min + real(r8) kevp_rain_dn, kevp_snow_dn + real(r8) kevp_rain, kevp_snow + + real(r8) cnt, cnb ! Cloud top and base interface indices + real(r8) d_alpha + real(r8) z_b, z_t + real(r8) p_b, p_t + real(r8) dz_m, dp_m + real(r8) exn_b, exn_t + real(r8) thl_b + real(r8) qt_b + real(r8) tr_b(ncnst) + real(r8) u_b + real(r8) v_b + real(r8) ql_b + real(r8) qi_b + real(r8) thv_b, thv_t + real(r8) thv_mean_b, thv_mean_t + real(r8) thvbot, thvtop + real(r8) plfc, plnb + real(r8) thvl_b, thvl_t + real(r8) rho_b, rho_m, rho_t + real(r8) thvl_minE, thv_minE + real(r8) dp, dz, rho + real(r8) thle_b(mkx) + real(r8) qte_b(mkx) + real(r8) tre_b(mkx,ncnst) + real(r8) ue_b(mkx) + real(r8) ve_b(mkx) + real(r8) we_b(mkx) + real(r8) we_t(mkx) + real(r8) qle_b(mkx) + real(r8) qie_b(mkx) + real(r8) ssthle(mkx) + real(r8) ssqte(mkx) + real(r8) ssue(mkx) + real(r8) ssve(mkx) + real(r8) ssqle(mkx) + real(r8) ssqie(mkx) + real(r8) sstre(mkx,ncnst) + real(r8) pe + real(r8) w_cu + real(r8) thl_cu, qt_cu + real(r8) ql_cu, qi_cu + real(r8) thl_eg, qt_eg, rh_eg + real(r8) thv_cu, thv_eg, thv_xs + real(r8) u_eg, v_eg, w_eg + real(r8) tr_eg(ncnst) + real(r8) thv_env + real(r8) cridis + real(r8) thl_cumC, thl_cumS + real(r8) qt_cumC, qt_cumS + real(r8) thv_cumC, thv_cumS, thv_cumE + real(r8) xdown_min, xdown_max + real(r8) zbar, zbar1, zbar2 + real(r8) zmass, zmass1, zmass2 + real(r8) zmass_up, zmass_up1, zmass_up2 + real(r8) th, qv, ql, qi, qse + real(r8) es, qs + integer id_check + real(r8) bogbot, bogtop, wu2 + real(r8) thv, thv_dt, thv_db + real(r8) thl_med, qt_med, ql_med, qi_med, qv_med, u_med, v_med + real(r8) thl_meu, qt_meu, ql_meu, qi_meu, u_meu, v_meu + real(r8) tr_med(ncnst), tr_meu(ncnst) + real(r8) fac + real(r8) f_nu + real(r8) cmf_dt, thl_dt, qt_dt, u_dt, v_dt, w_dt + real(r8) tr_dt(ncnst) + real(r8) cmf_db, thl_db, qt_db, u_db, v_db, w_db + real(r8) tr_db(ncnst) + real(r8) qw_db, tw_db + real(r8) evp_thll, evp_qtl, evp_thli, evp_qti + real(r8) evp_qt + real(r8) evp_max + real(r8) evp_tr(ncnst) + real(r8) prep_thll, prep_qtl, prep_thli, prep_qti + real(r8) prep_tr(ncnst) + real(r8) exql, exqi, extr(ncnst) + real(r8) evpR, evpS, evpRStr(ncnst) + real(r8) u_grdPGF, v_grdPGF, PGF_u, PGF_v + real(r8) um, dm + real(r8) thl_env_u, thl_env_d + real(r8) qt_env_u, qt_env_d + real(r8) u_env_u, u_env_d + real(r8) v_env_u, v_env_d + real(r8) ql_env_u, ql_env_d + real(r8) qi_env_u, qi_env_d + real(r8) tr_env_u, tr_env_d + real(r8) flxrain_top, flxsnow_top, flxrasn_top + real(r8) flxrain_top_in, flxsnow_top_in, flxrasn_top_in + real(r8) flxrain_bot_ee, flxsnow_bot_ee + real(r8) flxrain_bot_upee, flxsnow_bot_upee + real(r8) flxrain_bot_upeesm, flxsnow_bot_upeesm + real(r8) flxrain_bot, flxsnow_bot + real(r8) flxtrrs_top(ncnst) + real(r8) flxtrrs_bot_upee(ncnst) + real(r8) flxtrrs_bot_upeesm(ncnst) + real(r8) flxtrrs_bot(ncnst) + real(r8) tmp1, tmp2, tmp3, tmp4 + real(r8) tmp_th, tmp_qv, tmp_ql, tmp_qi, tmp_qse + real(r8) thl_aut_tmp, qt_aut_tmp, tr_aut_tmp(ncnst) + real(r8) ql_aut_adi_prp, qi_aut_adi_prp + real(r8) tmpx_bot, tmpx_top, tmpy_bot, tmpy_top, tmpw + real(r8) f_R, f_S + real(r8) eps_dia_L, eps_dia_I, eps_dia_V, srcg_V + real(r8) evprain_clr, evpsnow_clr, evplimit_clr_rain, evplimit_clr_snow, evplimit_clr + real(r8) subsat_clr, qw_clr, qv_clr + real(r8) tw + real(r8) precip ! Convective rain+snow flux at surface [m/s] + real(r8) snow ! Convective snow flux at surface [m/s] + real(r8) evapc(mkx) ! Evaporation rate of convective precipitation within environment [ kg/kg/s ] + real(r8) rliq ! Vertical integration of rqc in flux unit [m/s] + real(r8) sigma_w, sigma_thl, sigma_qt, sigma_u, sigma_v + real(r8) sigma_tr(ncnst) + real(r8) au_tent + real(r8) alpha_cri + real(r8) Ro, sigmaR + real(r8) Ro_min, Ro_max, sigmaR_min, sigmaR_max + real(r8) kw_min, kw_max + real(r8) cdelta_s, cdelta_w + real(r8) rbuoy_up, rbuoy_dn + real(r8) mu + real(r8) thv_max, thv_min, fddet ! For continuous downdraft buoyancy sorting + + ! ------------------------------------------------- ! + ! Variables associated with convective organization ! + ! ------------------------------------------------- ! + + real(r8) org_rad, org_ent, sum + real(r8) kw, au_base, au_base_ocn, au_base_lnd, AOVTU + real(r8) tmpm_array(mix,mkx), tmpi_array(mix,0:mkx) + real(r8) ws1, went_eff + real(r8) cd_thl, cd_qt, cd_u, cd_v, cd_tr(ncnst) + + ! --------------------------- ! + ! Diagnostic Output Variables ! + ! --------------------------- ! + + real(r8) kw_out(mix) + + real(r8) sigma_w_out(mix) + real(r8) sigma_thl_out(mix) + real(r8) sigma_qt_out(mix) + real(r8) sigma_u_out(mix) + real(r8) sigma_v_out(mix) + + real(r8) w_org_out(mix) + real(r8) thl_org_out(mix) + real(r8) qt_org_out(mix) + real(r8) u_org_out(mix) + real(r8) v_org_out(mix) + + real(r8) tkes_out(mix) + real(r8) went_out(mix) + real(r8) went_eff_out(mix) + + ! ----------------------------------------------------------------------------------- ! + ! Rain and snow mixing ratios at the top and base interface of each layer. ! + ! These are used for including condensate loading effect within convective downdraft. ! + ! ----------------------------------------------------------------------------------- ! + + real(r8) qrain_b, qsnow_b + + ! ------------------------------------------------------------------------------- ! + ! For mixing of convective downdraft with convective updraft or mean environment. ! + ! ------------------------------------------------------------------------------- ! + + real(r8) ssthl_tmp, ssqt_tmp, ssql_tmp, ssqi_tmp, ssqv_tmp, ssu_tmp, ssv_tmp + real(r8) sstr_tmp(ncnst) + real(r8) thl_tmp, qt_tmp, th_tmp, qv_tmp, ql_tmp, qi_tmp, qs_tmp, t_tmp, thv_tmp + + ! ----------------------------------------------------------------------------------------------- ! + ! Variables associated with unified treatment of various evaporation processes from top to bottom ! + ! ----------------------------------------------------------------------------------------------- ! + + integer ndb_evp + integer ix_d_src(mkx,3) + real(r8) cmfdb_evp + real(r8) cmf_d_src(mkx,3), tr_d_src(mkx,3,ncnst) + real(r8) thl_d_src(mkx,3), qt_d_src(mkx,3), ql_d_src(mkx,3), qi_d_src(mkx,3) + real(r8) u_d_src(mkx,3), v_d_src(mkx,3), w_d_src(mkx,3) + real(r8) fevp1_t_rate_src(mkx,3), fevp2_t_rate_src(mkx,3) + + ! --------------------------- ! + ! For aerosol tendency output ! + ! --------------------------- ! + + character(len=30) :: varname + + !------------------------! + ! ! + ! Start Main Calculation ! + ! ! + !------------------------! + + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + call cnst_get_ind( 'NUMLIQ', ixnumliq ) + call cnst_get_ind( 'NUMICE', ixnumice ) + + ! ----------------------------------------------------------------------------- ! + ! Define index for multiple mixing environmental airs for nter = 1 and nter = 2 ! + ! ----------------------------------------------------------------------------- ! + + if (niter .eq. 1) then + ixi = 1 + ixf = 1 + else + ixi = 1 + ixf = 2 + endif + + ! -------------------------------------------------------------- ! + ! Initialize formal output variables defined at all grid columns ! + ! -------------------------------------------------------------- ! + + cmf_u_out(:iend,0:mkx) = 0._r8 + slflx_out(:iend,0:mkx) = 0._r8 + qtflx_out(:iend,0:mkx) = 0._r8 + qvten_out(:iend,:mkx) = 0._r8 + qlten_out(:iend,:mkx) = 0._r8 + qiten_out(:iend,:mkx) = 0._r8 + sten_out(:iend,:mkx) = 0._r8 + uten_out(:iend,:mkx) = 0._r8 + vten_out(:iend,:mkx) = 0._r8 + trten_out(:iend,:mkx,:ncnst) = 0._r8 + qrten_out(:iend,:mkx) = 0._r8 + qsten_out(:iend,:mkx) = 0._r8 + rqc_l_out(:iend,:mkx) = 0._r8 + rqc_i_out(:iend,:mkx) = 0._r8 + rqc_out(:iend,:mkx) = 0._r8 + rnc_l_out(:iend,:mkx) = 0._r8 + rnc_i_out(:iend,:mkx) = 0._r8 + rliq_out(:iend) = 0._r8 + precip_out(:iend) = 0._r8 + snow_out(:iend) = 0._r8 + evapc_out(:iend,:mkx) = 0._r8 + cnt_out(:iend) = real(mkx,r8) + cnb_out(:iend) = 0._r8 + am_u_out(:iend,:mkx) = 0._r8 + qlm_u_out(:iend,:mkx) = 0._r8 + qim_u_out(:iend,:mkx) = 0._r8 + am_d_out(:iend,:mkx) = 0._r8 + qlm_d_out(:iend,:mkx) = 0._r8 + qim_d_out(:iend,:mkx) = 0._r8 + + cmf_det_out(:iend,:mkx) = 0._r8 + ql_det_out(:iend,:mkx) = 0._r8 + qi_det_out(:iend,:mkx) = 0._r8 + + ! ---------------------------------------------------------------- ! + ! Initialize internal output variables defined at all grid columns ! + ! ---------------------------------------------------------------- ! + + cmf_out(:iend,0:mkx) = 0._r8 + uflx_out(:iend,0:mkx) = 0._r8 + vflx_out(:iend,0:mkx) = 0._r8 + + slflx_u_out(:iend,0:mkx) = 0._r8 + qtflx_u_out(:iend,0:mkx) = 0._r8 + uflx_u_out(:iend,0:mkx) = 0._r8 + vflx_u_out(:iend,0:mkx) = 0._r8 + + cmf_d_out(:iend,0:mkx) = 0._r8 + slflx_d_out(:iend,0:mkx) = 0._r8 + qtflx_d_out(:iend,0:mkx) = 0._r8 + uflx_d_out(:iend,0:mkx) = 0._r8 + vflx_d_out(:iend,0:mkx) = 0._r8 + + thl_orgforce_out(:iend) = 0._r8 + qt_orgforce_out(:iend) = 0._r8 + u_orgforce_out(:iend) = 0._r8 + v_orgforce_out(:iend) = 0._r8 + tr_orgforce_out(:iend,:ncnst) = 0._r8 + awk_orgforce_out(:iend) = 0._r8 + + ! Below block is for detailed diagnostic output + + flxrain_out(:iend,0:mkx) = 0._r8 + flxsnow_out(:iend,0:mkx) = 0._r8 + + thl_orgforce_flx_out(:iend) = 0._r8 + qt_orgforce_flx_out(:iend) = 0._r8 + u_orgforce_flx_out(:iend) = 0._r8 + v_orgforce_flx_out(:iend) = 0._r8 + awk_orgforce_flx_out(:iend) = 0._r8 + + thl_orgforce_und_out(:iend) = 0._r8 + qt_orgforce_und_out(:iend) = 0._r8 + u_orgforce_und_out(:iend) = 0._r8 + v_orgforce_und_out(:iend) = 0._r8 + awk_orgforce_mix_out(:iend) = 0._r8 + + thl_orgforce_env_out(:iend) = 0._r8 + qt_orgforce_env_out(:iend) = 0._r8 + u_orgforce_env_out(:iend) = 0._r8 + v_orgforce_env_out(:iend) = 0._r8 + cmf_d_org_pblh_out(:iend) = 0._r8 + + ! Above block is for detailed diagnostic output + + taui_thl_out(:iend) = 0._r8 + taui_qt_out(:iend) = 0._r8 + taui_u_out(:iend) = 0._r8 + taui_v_out(:iend) = 0._r8 + taui_tr_out(:iend,:ncnst) = 0._r8 + taui_awk_out(:iend) = 0._r8 + + del_org_out(:iend) = 0._r8 + del0_org_out(:iend) = 0._r8 + + slten_u_out(:iend,:mkx) = 0._r8 + qtten_u_out(:iend,:mkx) = 0._r8 + uten_u_out(:iend,:mkx) = 0._r8 + vten_u_out(:iend,:mkx) = 0._r8 + sten_u_out(:iend,:mkx) = 0._r8 + qvten_u_out(:iend,:mkx) = 0._r8 + qlten_u_out(:iend,:mkx) = 0._r8 + qiten_u_out(:iend,:mkx) = 0._r8 + trten_u_out(:iend,:mkx,:ncnst) = 0._r8 + + slten_d_out(:iend,:mkx) = 0._r8 + qtten_d_out(:iend,:mkx) = 0._r8 + uten_d_out(:iend,:mkx) = 0._r8 + vten_d_out(:iend,:mkx) = 0._r8 + sten_d_out(:iend,:mkx) = 0._r8 + qvten_d_out(:iend,:mkx) = 0._r8 + qlten_d_out(:iend,:mkx) = 0._r8 + qiten_d_out(:iend,:mkx) = 0._r8 + trten_d_out(:iend,:mkx,:ncnst) = 0._r8 + + slten_evp_out(:iend,:mkx) = 0._r8 + qtten_evp_out(:iend,:mkx) = 0._r8 + uten_evp_out(:iend,:mkx) = 0._r8 + vten_evp_out(:iend,:mkx) = 0._r8 + sten_evp_out(:iend,:mkx) = 0._r8 + qvten_evp_out(:iend,:mkx) = 0._r8 + qlten_evp_out(:iend,:mkx) = 0._r8 + qiten_evp_out(:iend,:mkx) = 0._r8 + trten_evp_out(:iend,:mkx,:ncnst) = 0._r8 + + slten_dis_out(:iend,:mkx) = 0._r8 + qtten_dis_out(:iend,:mkx) = 0._r8 + uten_dis_out(:iend,:mkx) = 0._r8 + vten_dis_out(:iend,:mkx) = 0._r8 + sten_dis_out(:iend,:mkx) = 0._r8 + qvten_dis_out(:iend,:mkx) = 0._r8 + qlten_dis_out(:iend,:mkx) = 0._r8 + qiten_dis_out(:iend,:mkx) = 0._r8 + trten_dis_out(:iend,:mkx,:ncnst) = 0._r8 + + qlten_sub_out(:iend,:mkx) = 0._r8 + qiten_sub_out(:iend,:mkx) = 0._r8 + qlten_det_out(:iend,:mkx) = 0._r8 + qiten_det_out(:iend,:mkx) = 0._r8 + + thl_u_out(:iend,0:mkx) = 0._r8 + qt_u_out(:iend,0:mkx) = 0._r8 + u_u_out(:iend,0:mkx) = 0._r8 + v_u_out(:iend,0:mkx) = 0._r8 + w_u_out(:iend,0:mkx) = 0._r8 + ql_u_out(:iend,0:mkx) = 0._r8 + qi_u_out(:iend,0:mkx) = 0._r8 + tr_u_out(:iend,0:mkx,:ncnst) = 0._r8 + wa_u_out(:iend,0:mkx) = 0._r8 + qla_u_out(:iend,0:mkx) = 0._r8 + qia_u_out(:iend,0:mkx) = 0._r8 + a_u_out(:iend,0:mkx) = 0._r8 + rad_u_out(:iend,0:mkx) = 0._r8 + num_u_out(:iend,0:mkx) = 0._r8 + gamw_u_out(:iend,0:mkx) = 0._r8 + thva_u_out(:iend,0:mkx) = 0._r8 + + thl_d_out(:iend,0:mkx) = 0._r8 + qt_d_out(:iend,0:mkx) = 0._r8 + u_d_out(:iend,0:mkx) = 0._r8 + v_d_out(:iend,0:mkx) = 0._r8 + w_d_out(:iend,0:mkx) = 0._r8 + ql_d_out(:iend,0:mkx) = 0._r8 + qi_d_out(:iend,0:mkx) = 0._r8 + tr_d_out(:iend,0:mkx,:ncnst) = 0._r8 + wa_d_out(:iend,0:mkx) = 0._r8 + qla_d_out(:iend,0:mkx) = 0._r8 + qia_d_out(:iend,0:mkx) = 0._r8 + a_d_out(:iend,0:mkx) = 0._r8 + + a_p_out(:iend,0:mkx) = 0._r8 + am_evp_out(:iend,:mkx) = 0._r8 + am_pu_out(:iend,:mkx) = 0._r8 + x_p_out(:iend,0:mkx) = 0._r8 + y_p_out(:iend,0:mkx) = 0._r8 + x_um_out(:iend,:mkx) = 0._r8 + y_um_out(:iend,:mkx) = 0._r8 + + thl_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qt_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + u_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + v_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + w_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + ql_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qi_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + tr_u_msfc_out(:iend,0:mkx,:nseg,:ncnst,:niter) = 0._r8 + cmf_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + a_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + num_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + rad_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + + eps0_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + eps_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + del_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + eeps_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + ddel_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + xc_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + xs_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + xemin_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + xemax_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + cridis_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + thvcuenv_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + thvegenv_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + thvxsenv_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + fmix_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + cmfumix_u_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + + thl_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qt_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + u_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + v_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + w_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + ql_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qi_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + tr_d_msfc_out(:iend,0:mkx,:nseg,:ncnst,:niter) = 0._r8 + wa_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qla_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + qia_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + cmf_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + a_d_msfc_out(:iend,0:mkx,:nseg,:niter) = 0._r8 + + ptop_msfc_out(:iend,:nseg,:niter) = 0._r8 + ztop_msfc_out(:iend,:nseg,:niter) = 0._r8 + + thv_b_out(:iend,0:mkx) = 0._r8 + thv_t_out(:iend,0:mkx) = 0._r8 + thv_mt_out(:iend,0:mkx) = 0._r8 + thv_min_out(:iend,0:mkx) = 0._r8 + + kw_out(:iend) = 0._r8 + + sigma_w_out(:iend) = 0._r8 + sigma_thl_out(:iend) = 0._r8 + sigma_qt_out(:iend) = 0._r8 + sigma_u_out(:iend) = 0._r8 + sigma_v_out(:iend) = 0._r8 + w_org_out(:iend) = 0._r8 + thl_org_out(:iend) = 0._r8 + qt_org_out(:iend) = 0._r8 + u_org_out(:iend) = 0._r8 + v_org_out(:iend) = 0._r8 + tkes_out(:iend) = 0._r8 + went_out(:iend) = 0._r8 + went_eff_out(:iend) = 0._r8 + + ! ------------------------------------------------------ ! + ! Initialize other variables defined at all grid columns ! + ! ------------------------------------------------------ ! + + !---------------------------------------------------------! + ! ! + ! Start the big i loop where i is a horozontal grid index ! + ! ! + !---------------------------------------------------------! + + do i = 1, iend + + ! ------------------------------------------------------------------------------------------------------- ! + ! Mar.27.2012. Initialize dissipation heating variables since dissipation heating is computed after doing ! + ! ensemble-mean average of iter = 1, niter = 2. ! + ! ------------------------------------------------------------------------------------------------------- ! + + slten_dis(:mkx) = 0._r8 + qtten_dis(:mkx) = 0._r8 + uten_dis(:mkx) = 0._r8 + vten_dis(:mkx) = 0._r8 + sten_dis(:mkx) = 0._r8 + qvten_dis(:mkx) = 0._r8 + qlten_dis(:mkx) = 0._r8 + qiten_dis(:mkx) = 0._r8 + trten_dis(:mkx,:ncnst) = 0._r8 + + uf(:mkx) = 0._r8 + vf(:mkx) = 0._r8 + + uflx(0:mkx) = 0._r8 + vflx(0:mkx) = 0._r8 + + ! ----------------------------------------------------------------------------------------------- ! + ! Initialize variables associated with mixing with multiple mixing environmental airs ( '_mxen' ) ! + ! ----------------------------------------------------------------------------------------------- ! + + ktop_mxen(:niter) = 0 + cush_mxen(:niter) = 0._r8 + cushavg_mxen(:niter) = 0._r8 + + cu_cmfum_mxen(:mkx,:niter) = 0._r8 + cu_cmfr_mxen(:mkx,:niter) = 0._r8 + cu_thlr_mxen(:mkx,:niter) = 0._r8 + cu_qtr_mxen(:mkx,:niter) = 0._r8 + cu_ur_mxen(:mkx,:niter) = 0._r8 + cu_vr_mxen(:mkx,:niter) = 0._r8 + cu_qlr_mxen(:mkx,:niter) = 0._r8 + cu_qir_mxen(:mkx,:niter) = 0._r8 + cu_trr_mxen(:mkx,:ncnst,:niter) = 0._r8 + cu_cmfrd_mxen(:mkx,:niter) = 0._r8 + cu_thlrd_mxen(:mkx,:niter) = 0._r8 + cu_qtrd_mxen(:mkx,:niter) = 0._r8 + cu_urd_mxen(:mkx,:niter) = 0._r8 + cu_vrd_mxen(:mkx,:niter) = 0._r8 + cu_qlrd_mxen(:mkx,:niter) = 0._r8 + cu_qird_mxen(:mkx,:niter) = 0._r8 + cu_trrd_mxen(:mkx,:ncnst,:niter) = 0._r8 + + cmf_u_mxen(0:mkx,:niter) = 0._r8 + cmf_d_mxen(0:mkx,:niter) = 0._r8 + slflx_u_mxen(0:mkx,:niter) = 0._r8 + slflx_d_mxen(0:mkx,:niter) = 0._r8 + qtflx_u_mxen(0:mkx,:niter) = 0._r8 + qtflx_d_mxen(0:mkx,:niter) = 0._r8 + uflx_u_mxen(0:mkx,:niter) = 0._r8 + uflx_d_mxen(0:mkx,:niter) = 0._r8 + vflx_u_mxen(0:mkx,:niter) = 0._r8 + vflx_d_mxen(0:mkx,:niter) = 0._r8 + + flxrain_u_mxen(0:mkx,:niter) = 0._r8 + flxsnow_u_mxen(0:mkx,:niter) = 0._r8 + + thl_orgforce_mxen(:niter) = 0._r8 + qt_orgforce_mxen(:niter) = 0._r8 + u_orgforce_mxen(:niter) = 0._r8 + v_orgforce_mxen(:niter) = 0._r8 + tr_orgforce_mxen(:ncnst,:niter) = 0._r8 + awk_orgforce_mxen(:niter) = 0._r8 + + ! Below block is for detailed diagnostic output + + thl_orgforce_flx_mxen(:niter) = 0._r8 + qt_orgforce_flx_mxen(:niter) = 0._r8 + u_orgforce_flx_mxen(:niter) = 0._r8 + v_orgforce_flx_mxen(:niter) = 0._r8 + awk_orgforce_flx_mxen(:niter) = 0._r8 + + thl_orgforce_und_mxen(:niter) = 0._r8 + qt_orgforce_und_mxen(:niter) = 0._r8 + u_orgforce_und_mxen(:niter) = 0._r8 + v_orgforce_und_mxen(:niter) = 0._r8 + awk_orgforce_mix_mxen(:niter) = 0._r8 + + thl_orgforce_env_mxen(:niter) = 0._r8 + qt_orgforce_env_mxen(:niter) = 0._r8 + u_orgforce_env_mxen(:niter) = 0._r8 + v_orgforce_env_mxen(:niter) = 0._r8 + cmf_d_org_pblh_mxen(:niter) = 0._r8 + + ! Above block is for detailed diagnostic output + + taui_thl_mxen(:niter) = 0._r8 + taui_qt_mxen(:niter) = 0._r8 + taui_u_mxen(:niter) = 0._r8 + taui_v_mxen(:niter) = 0._r8 + taui_tr_mxen(:ncnst,:niter) = 0._r8 + taui_awk_mxen(:niter) = 0._r8 + + del_org_mxen(:niter) = 0._r8 + del0_org_mxen(:niter) = 0._r8 + + qvten_mxen(:mkx,:niter) = 0._r8 + qlten_mxen(:mkx,:niter) = 0._r8 + qiten_mxen(:mkx,:niter) = 0._r8 + trten_mxen(:mkx,:ncnst,:niter) = 0._r8 + sten_mxen(:mkx,:niter) = 0._r8 + uten_mxen(:mkx,:niter) = 0._r8 + vten_mxen(:mkx,:niter) = 0._r8 + qrten_mxen(:mkx,:niter) = 0._r8 + qsten_mxen(:mkx,:niter) = 0._r8 + + rqc_l_mxen(:mkx,:niter) = 0._r8 + rqc_i_mxen(:mkx,:niter) = 0._r8 + rqc_mxen(:mkx,:niter) = 0._r8 + rnc_l_mxen(:mkx,:niter) = 0._r8 + rnc_i_mxen(:mkx,:niter) = 0._r8 + + cmf_det_mxen(:mkx,:niter) = 0._r8 + ql_det_mxen(:mkx,:niter) = 0._r8 + qi_det_mxen(:mkx,:niter) = 0._r8 + + evapc_mxen(:mkx,:niter) = 0._r8 + + am_u_mxen(:mkx,:niter) = 0._r8 + qlm_u_mxen(:mkx,:niter) = 0._r8 + qim_u_mxen(:mkx,:niter) = 0._r8 + + am_d_mxen(:mkx,:niter) = 0._r8 + qlm_d_mxen(:mkx,:niter) = 0._r8 + qim_d_mxen(:mkx,:niter) = 0._r8 + + rliq_mxen(:niter) = 0._r8 + precip_mxen(:niter) = 0._r8 + snow_mxen(:niter) = 0._r8 + + cnt_mxen(:niter) = 0._r8 + cnb_mxen(:niter) = 0._r8 + + slten_u_mxen(:mkx,:niter) = 0._r8 + qtten_u_mxen(:mkx,:niter) = 0._r8 + uten_u_mxen(:mkx,:niter) = 0._r8 + vten_u_mxen(:mkx,:niter) = 0._r8 + sten_u_mxen(:mkx,:niter) = 0._r8 + qvten_u_mxen(:mkx,:niter) = 0._r8 + qlten_u_mxen(:mkx,:niter) = 0._r8 + qiten_u_mxen(:mkx,:niter) = 0._r8 + trten_u_mxen(:mkx,:ncnst,:niter) = 0._r8 + + slten_d_mxen(:mkx,:niter) = 0._r8 + qtten_d_mxen(:mkx,:niter) = 0._r8 + uten_d_mxen(:mkx,:niter) = 0._r8 + vten_d_mxen(:mkx,:niter) = 0._r8 + sten_d_mxen(:mkx,:niter) = 0._r8 + qvten_d_mxen(:mkx,:niter) = 0._r8 + qlten_d_mxen(:mkx,:niter) = 0._r8 + qiten_d_mxen(:mkx,:niter) = 0._r8 + trten_d_mxen(:mkx,:ncnst,:niter) = 0._r8 + + slten_evp_mxen(:mkx,:niter) = 0._r8 + qtten_evp_mxen(:mkx,:niter) = 0._r8 + uten_evp_mxen(:mkx,:niter) = 0._r8 + vten_evp_mxen(:mkx,:niter) = 0._r8 + sten_evp_mxen(:mkx,:niter) = 0._r8 + qvten_evp_mxen(:mkx,:niter) = 0._r8 + qlten_evp_mxen(:mkx,:niter) = 0._r8 + qiten_evp_mxen(:mkx,:niter) = 0._r8 + trten_evp_mxen(:mkx,:ncnst,:niter) = 0._r8 + + qlten_sub_mxen(:mkx,:niter) = 0._r8 + qiten_sub_mxen(:mkx,:niter) = 0._r8 + + qlten_det_mxen(:mkx,:niter) = 0._r8 + qiten_det_mxen(:mkx,:niter) = 0._r8 + + thl_u_mxen(0:mkx,:niter) = 0._r8 + qt_u_mxen(0:mkx,:niter) = 0._r8 + u_u_mxen(0:mkx,:niter) = 0._r8 + v_u_mxen(0:mkx,:niter) = 0._r8 + w_u_mxen(0:mkx,:niter) = 0._r8 + ql_u_mxen(0:mkx,:niter) = 0._r8 + qi_u_mxen(0:mkx,:niter) = 0._r8 + tr_u_mxen(0:mkx,:ncnst,:niter) = 0._r8 + a_u_mxen(0:mkx,:niter) = 0._r8 + num_u_mxen(0:mkx,:niter) = 0._r8 + wa_u_mxen(0:mkx,:niter) = 0._r8 + qla_u_mxen(0:mkx,:niter) = 0._r8 + qia_u_mxen(0:mkx,:niter) = 0._r8 + rad_u_mxen(0:mkx,:niter) = 0._r8 + thva_u_mxen(0:mkx,:niter) = 0._r8 + + a_p_mxen(0:mkx,:niter) = 0._r8 + am_evp_mxen(:mkx,:niter) = 0._r8 + am_pu_mxen(:mkx,:niter) = 0._r8 + x_p_mxen(0:mkx,:niter) = 0._r8 + y_p_mxen(0:mkx,:niter) = 0._r8 + x_um_mxen(:mkx,:niter) = 0._r8 + y_um_mxen(:mkx,:niter) = 0._r8 + + thl_d_mxen(0:mkx,:niter) = 0._r8 + qt_d_mxen(0:mkx,:niter) = 0._r8 + u_d_mxen(0:mkx,:niter) = 0._r8 + v_d_mxen(0:mkx,:niter) = 0._r8 + w_d_mxen(0:mkx,:niter) = 0._r8 + ql_d_mxen(0:mkx,:niter) = 0._r8 + qi_d_mxen(0:mkx,:niter) = 0._r8 + tr_d_mxen(0:mkx,:ncnst,:niter) = 0._r8 + a_d_mxen(0:mkx,:niter) = 0._r8 + wa_d_mxen(0:mkx,:niter) = 0._r8 + qla_d_mxen(0:mkx,:niter) = 0._r8 + qia_d_mxen(0:mkx,:niter) = 0._r8 + + thl_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qt_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + u_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + v_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + w_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + ql_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qi_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + tr_u_msfc_mxen(0:mkx,:nseg,:ncnst,:niter) = 0._r8 + cmf_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + a_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + num_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + rad_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + + eps0_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + eps_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + del_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + eeps_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + ddel_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + xc_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + xs_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + xemin_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + xemax_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + cridis_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + thvcuenv_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + thvegenv_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + thvxsenv_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + fmix_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + cmfumix_u_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + + thl_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qt_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + u_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + v_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + w_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + ql_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qi_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + tr_d_msfc_mxen(0:mkx,:nseg,:ncnst,:niter) = 0._r8 + cmf_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + a_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + wa_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qla_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + qia_d_msfc_mxen(0:mkx,:nseg,:niter) = 0._r8 + + ptop_msfc_mxen(:nseg,:niter) = 0._r8 + ztop_msfc_mxen(:nseg,:niter) = 0._r8 + + ! --------------------------------------------- ! + ! Define 1D input variables at each grid point ! + ! Interface index from sfc : k = 0,1,2,...,mkx ! + ! Mid-point index from sfc : k = 1,2,3,...,mkx ! + ! --------------------------------------------- ! + + kpblh = kpblh_in(i) + pblh = pblh_in(i) + went = went_in(i) + qflx = qflx_in(i) + shflx = shflx_in(i) + taux = taux_in(i) + tauy = tauy_in(i) + aflx(:ncnst) = aflx_in(i,:ncnst) + landfrac = landfrac_in(i) + sgh30 = sgh30_in(i) + + ! ------------------------------------------------------------------------------------------------------ ! + ! Aug.31.2011. In order to simplify code later, impose the condition that kpblh >=2 and ! + ! corresponding pblh >= zs0_in(i,1). This condition is always satisfied when ! + ! PBL is CL, but when PBL is STL, this is imposing conservative constraint. ! + ! since convective is likely not to very in-active in the STL, this is not an issue at all. ! + ! Even when convection is fired in STL, there is no problem at all. ! + ! Sep.09.2011. Add 'kpblhm', 'pblhz', 'pblhm' since these are used very frequently. ! + ! All the variables are replaced by these ( e.g., kpblh - 1 = kpblhm ). ! + ! Note that 'pblhz > 0' and 'pblhp > 0'. ! + ! ------------------------------------------------------------------------------------------------------ ! + + kpblh = max( kpblh, 2 ) + kpblhm = kpblh - 1 + pblh = max( pblh, zs0_in(i,1) ) + pblhz = zs0_in(i,kpblhm) - zs0_in(i,0) + pblhp = ps0_in(i,0) - ps0_in(i,kpblhm) + + ! ---------------------------------------------------------------------------------------------- ! + ! May.21.2011. Is it better to change the minimums of 'cush' and 'cushavg' from 1000 to 'pblh' ? ! + ! I should think about this later. ! + ! May.21.2011. For full consistency with the other parts of the code, it is good to use 'pblh' ! + ! instead of '1000._r8' as the minimum value of 'cush, cushavg'. So, I modified ! + ! this. ! + ! Aug.31.2011. Add delta_thl(qt,u,v,thv,tr)_PBL fields. I may need to impose a reasonable upper ! + ! and lower limits on these excessive variables. ! + ! Sep.09.2011. I don't prognose 'thv' anymore - it is now diagnostically computed from the ! + ! prognosed 'thl,qt' which imposes a full consistency as well as removing unfair ! + ! assumption that both downdraft and environment are unsaturated for computing ! + ! buoyancy flux. ! + ! ---------------------------------------------------------------------------------------------- ! + + cush = cush_inout(i) + cush = max( cush, pblhz ) + cushavg = cushavg_inout(i) + cushavg = max( cushavg, pblhz ) + cuorg = cuorg_inout(i) + cuorg = max( 0._r8, min( 1._r8, cuorg ) ) + + ! ---------------------------------------------------------------------------------------- ! + ! Jun.07.2012. Include advection of horizontal heterogeneity associated with ! + ! convective organization. ! + ! For the time being, these are treated only for ! + ! awk_PBL, delta_thl_PBL, delta_qt_PBL, delta_u_PBL, and delta_v_PBL. ! + ! That is, delta_tr_PBL(:ncnst) are neglected to save computation time, which ! + ! should be included in future. Ideally, cush and cushavg should be treated ! + ! in the same way. ! + ! Note that a constant offset of -100. is extracted when retriving 'delta_xx' ! + ! values from tracer arrays. ! + ! Advection can cause 'awk_PBL_raw > awk_PBL_max = 1._r8 - au_max'. ! + ! In this case, re-set awk_PBL_raw to awk_PBL_max. ! + ! ---------------------------------------------------------------------------------------- ! + + if( iorg_adv ) then + call cnst_get_ind( 'ORGawk', i_awk ) + call cnst_get_ind( 'ORGthl', i_thl ) + call cnst_get_ind( 'ORGqto', i_qt ) + call cnst_get_ind( 'ORGuoo', i_u ) + call cnst_get_ind( 'ORGvoo', i_v ) + + if( get_nstep() .eq. 0 ) then + awk_PBL_raw = 0._r8 + delta_thl_PBL_raw = 0._r8 + delta_qt_PBL_raw = 0._r8 + delta_u_PBL_raw = 0._r8 + delta_v_PBL_raw = 0._r8 + else + tmp1 = 0._r8 + awk_PBL_raw = 0._r8 + delta_thl_PBL_raw = 0._r8 + delta_qt_PBL_raw = 0._r8 + delta_u_PBL_raw = 0._r8 + delta_v_PBL_raw = 0._r8 + do k = 1, kpblhm ! Here, 'k' is a layer index. + tmp1 = tmp1 + dp0_in(i,k) + awk_PBL_raw = awk_PBL_raw + min( tr0_in(i,k,i_awk), 1._r8 - au_max - 1.e-5_r8 ) * dp0_in(i,k) + delta_thl_PBL_raw = delta_thl_PBL_raw + ( tr0_in(i,k,i_thl) - 100._r8 ) * dp0_in(i,k) + delta_qt_PBL_raw = delta_qt_PBL_raw + ( tr0_in(i,k, i_qt) - 100._r8 ) * dp0_in(i,k) + delta_u_PBL_raw = delta_u_PBL_raw + ( tr0_in(i,k, i_u) - 100._r8 ) * dp0_in(i,k) + delta_v_PBL_raw = delta_v_PBL_raw + ( tr0_in(i,k, i_v) - 100._r8 ) * dp0_in(i,k) + enddo + awk_PBL_raw = awk_PBL_raw / tmp1 + delta_thl_PBL_raw = delta_thl_PBL_raw / tmp1 + delta_qt_PBL_raw = delta_qt_PBL_raw / tmp1 + delta_u_PBL_raw = delta_u_PBL_raw / tmp1 + delta_v_PBL_raw = delta_v_PBL_raw / tmp1 + endif + else + awk_PBL_raw = awk_PBL_inout(i) + delta_thl_PBL_raw = delta_thl_PBL_inout(i) + delta_qt_PBL_raw = delta_qt_PBL_inout(i) + delta_u_PBL_raw = delta_u_PBL_inout(i) + delta_v_PBL_raw = delta_v_PBL_inout(i) + endif + + delta_tr_PBL_raw(:ncnst) = delta_tr_PBL_inout(i,:ncnst) + + ! ----------------------------------------------------------------------------------- ! + ! Impose consistency between the input wake area and perturbations ! + ! This is a just minimal constraint not a sufficient one. ! + ! While this is a minimal constraint, we include additional consistncy constraint ! + ! later in computing 'delta_thl_PBL' from 'delta_thl_PBL_raw' using tmp3 and tmp4 ! + ! later even though that is not perfrect either. ! + ! If there is more consistent way, I should try to find that. ! + ! ----------------------------------------------------------------------------------- ! + + if( awk_PBL_raw .lt. 1.e-5_r8 ) then + awk_PBL_raw = 0._r8 + delta_thl_PBL_raw = 0._r8 + delta_qt_PBL_raw = 0._r8 + delta_u_PBL_raw = 0._r8 + delta_v_PBL_raw = 0._r8 + delta_tr_PBL_raw(:ncnst) = 0._r8 + endif + + cu_cmfr(:mkx) = cu_cmfr_inout(i,:mkx) + cu_thlr(:mkx) = cu_thlr_inout(i,:mkx) + cu_qtr(:mkx) = cu_qtr_inout(i,:mkx) + cu_ur(:mkx) = cu_ur_inout(i,:mkx) + cu_vr(:mkx) = cu_vr_inout(i,:mkx) + cu_qlr(:mkx) = cu_qlr_inout(i,:mkx) + cu_qir(:mkx) = cu_qir_inout(i,:mkx) + cu_trr(:mkx,:ncnst) = cu_trr_inout(i,:mkx,:ncnst) + + ! ---------------------------------------- ! + ! Local environmental mean state variables ! + ! ---------------------------------------- ! + + ps0(0:mkx) = ps0_in(i,0:mkx) + zs0(0:mkx) = zs0_in(i,0:mkx) + p0(:mkx) = p0_in(i,:mkx) + z0(:mkx) = z0_in(i,:mkx) + dp0(:mkx) = dp0_in(i,:mkx) + dpdry0(:mkx) = dpdry0_in(i,:mkx) + u0(:mkx) = u0_in(i,:mkx) + v0(:mkx) = v0_in(i,:mkx) + qv0(:mkx) = qv0_in(i,:mkx) + ql0(:mkx) = ql0_in(i,:mkx) + qi0(:mkx) = qi0_in(i,:mkx) + do mt = 1, ncnst + tr0(:mkx,mt) = tr0_in(i,:mkx,mt) + enddo + t0(:mkx) = t0_in(i,:mkx) + ast0(:mkx) = ast0_in(i,:mkx) + tke0(0:mkx) = tke0_in(i,0:mkx) + bprod0(0:mkx) = bprod0_in(i,0:mkx) + + ! Aug.08.2013. Evaporation of stratiform precipitation + am_evp_st(:mkx) = am_evp_st_in(i,:mkx) + evprain_st(:mkx) = evprain_st_in(i,:mkx) + evpsnow_st(:mkx) = evpsnow_st_in(i,:mkx) + + ! --------------------------------------------------------- ! + ! Compute other basic thermodynamic variables directly from ! + ! the input variables at each grid point ! + ! --------------------------------------------------------- ! + + ! --------------------------------------------------------------- ! + ! Nov.30.2012. Layer thickness depending on dry or moist tracers. ! + ! --------------------------------------------------------------- ! + + do mt = 1, ncnst + if( cnst_get_type_byind(mt) .eq. 'wet' ) then + dptr0(:mkx,mt) = dp0(:mkx) + else + dptr0(:mkx,mt) = dpdry0(:mkx) + endif + enddo + + ! --------------------------------------------- ! + ! Compute conservative scalars at the mid-point ! + ! --------------------------------------------- ! + + exn0(:mkx) = ( p0(:mkx) / p00 )**rovcp + exns0(0:mkx) = ( ps0(0:mkx) / p00 )**rovcp + qt0(:mkx) = ( qv0(:mkx) + ql0(:mkx) + qi0(:mkx) ) + thl0(:mkx) = ( t0(:mkx) - xlv * ql0(:mkx) / cp - xls * qi0(:mkx) / cp ) / exn0(:mkx) + rho0(:mkx) = ( p0(:mkx) ) / ( r * t0(:mkx) * ( 1._r8 + zvir * qv0(:mkx) - ql0(:mkx) - qi0(:mkx) ) ) + do k = 1, mkx + call conden( p0(k), thl0(k), qt0(k), th, qv, ql, qi, qse, id_check ) + thv0(k) = th * ( 1._r8 + zvir * qv - ql - qi ) + rh0(k) = max( 0._r8, min( 1._r8, qv / max( nonzero, qse ) ) ) + enddo + do k = 1, mkx + dz0(k) = zs0(k) - zs0(k-1) + if( k .eq. mkx ) then + dps0(k) = p0(k) - ps0(k) + else + dps0(k) = p0(k) - p0(k+1) + endif + end do + dps0(0) = ps0(1) - p0(1) + + ! Dec.17.2012. Restore below block in addition to the computation of the other thermodynamic variables since + ! these PBL-averaged variables are critically used for the revised 'bulk' computation of + ! organized flux at the PBL top interface. + + tmp1 = 0._r8 + qt0PBL = 0._r8 + thl0PBL = 0._r8 + u0PBL = 0._r8 + v0PBL = 0._r8 + tr0PBL(1:ncnst) = 0._r8 + do k = 1, kpblhm ! Here, 'k' is a layer index. + dpi = ps0(k-1) - ps0(k) + tmp1 = tmp1 + dpi + qt0PBL = qt0PBL + dpi*qt0(k) + thl0PBL = thl0PBL + dpi*thl0(k) + u0PBL = u0PBL + dpi*u0(k) + v0PBL = v0PBL + dpi*v0(k) + do mt = 1, ncnst + tr0PBL(mt) = tr0PBL(mt) + dpi*tr0(k,mt) + enddo + end do + qt0PBL = qt0PBL / tmp1 + thl0PBL = thl0PBL / tmp1 + u0PBL = u0PBL / tmp1 + v0PBL = v0PBL / tmp1 + do mt = 1, ncnst + tr0PBL(mt) = tr0PBL(mt) / tmp1 + enddo + + ! ---------------------------------------------------------------------------- ! + ! Dec.20.2012. Compute reconstructed effective entrainment rate at the PBL top ! + ! interface, 'we_eff' [m/s] for use in computing damping time ! + ! scale of organized flow within PBL. ! + ! Use the average of two constructed from 'qt0' and 'thl0'. ! + ! Below computation may introduce a sensitivity to vertical ! + ! resolution but hopely that effect is likely small. ! + ! ---------------------------------------------------------------------------- ! + + tmp1 = abs( thl0(kpblh) - thl0(kpblhm) ) / max( abs( thl0(kpblh) - thl0PBL ), 1._r8 ) + & + abs( qt0(kpblh) - qt0(kpblhm) ) / max( abs( qt0(kpblh) - qt0PBL ), 1.e-3_r8 ) + went_eff = 0.5_r8 * tmp1 * went + went_eff = min( max( 0._r8, went_eff ), 1._r8 ) + went_eff_out(i) = went_eff + went_out(i) = went + + ! ------------------------------------------------------------------------- ! + ! Compute in-layer slopes of conservative scalars ! + ! Dimension of slope is implicitly (1:mkx). ! + ! Unit is [K/Pa] (for thl0) with a negative when thl increases vertically. ! + ! It turns out that using non-zero slope induces inversion of 'thv0' across ! + ! the model interface, distorting model performance, including too much ! + ! convective downdraft from updraft buoyancy sorting. Thus, it is much ! + ! better to use the zero slope, which almost always guarantees stratified ! + ! input environmental profile except in the lowest model layer. ! + ! ------------------------------------------------------------------------- ! + + ssthl0 = slope( mkx, thl0, p0 ) + ssqt0 = slope( mkx, qt0 , p0 ) + ssu0 = slope( mkx, u0 , p0 ) + ssv0 = slope( mkx, v0 , p0 ) + do mt = 1, ncnst + sstr0(:mkx,mt) = slope( mkx, tr0(:mkx,mt), p0 ) + enddo + if( islope_on_thlqttr .eq. 0 ) then + ssthl0(:mkx) = 0._r8 + ssqt0(:mkx) = 0._r8 + do mt = 1, ncnst + sstr0(:mkx,mt) = 0._r8 + enddo + endif + if( islope_on_uv .eq. 0 ) then + ssu0(:mkx) = 0._r8 + ssv0(:mkx) = 0._r8 + endif + + ! ------------------------------------------------------------- ! + ! Compute 'qt,thl,u,v,thv,thvl' at the top/bottom interfaces ! + ! Note 'thv,thvl' are consistently computed from the top/bottom ! + ! interface values of 'thl,qt'. ! + ! ------------------------------------------------------------- ! + + do k = 1, mkx + + km = k - 1 + + thl0bot(k) = thl0(k) + ssthl0(k) * ( ps0(km) - p0(k) ) + qt0bot(k) = qt0(k) + ssqt0(k) * ( ps0(km) - p0(k) ) + + qt0bot(k) = max( qt0bot(k), qmin(1) ) + + u0bot(k) = u0(k) + ssu0(k) * ( ps0(km) - p0(k) ) + v0bot(k) = v0(k) + ssv0(k) * ( ps0(km) - p0(k) ) + do mt = 1, ncnst + tr0bot(k,mt) = tr0(k,mt) + sstr0(k,mt) * ( ps0(km) - p0(k) ) + + tr0bot(k,mt) = max( tr0bot(k,mt), qmin(mt) ) + + enddo + call conden( ps0(km), thl0bot(k), qt0bot(k), th, qv, ql, qi, qse, id_check ) + thvl0bot(k) = thl0bot(k) * ( 1._r8 + zvir * qt0bot(k) ) + thv0bot(k) = th * ( 1._r8 + zvir * qv - ql - qi ) + ql0bot(k) = ql + qi0bot(k) = qi + if( islope_on_thlqttr .eq. 0 ) then + thv0bot(k) = thv0(k) + ql0bot(k) = ql0(k) + qi0bot(k) = qi0(k) + endif + rho0bot(k) = ps0(km) / ( r * thv0bot(k) * exns0(km) ) + rh0bot(k) = max( 0._r8, min( 1._r8, qv / max( nonzero, qse ) ) ) + + thl0top(k) = thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) + qt0top(k) = qt0(k) + ssqt0(k) * ( ps0(k) - p0(k) ) + + qt0top(k) = max( qt0top(k), qmin(1) ) + + u0top(k) = u0(k) + ssu0(k) * ( ps0(k) - p0(k) ) + v0top(k) = v0(k) + ssv0(k) * ( ps0(k) - p0(k) ) + do mt = 1, ncnst + tr0top(k,mt) = tr0(k,mt) + sstr0(k,mt) * ( ps0(k) - p0(k) ) + + tr0top(k,mt) = max( tr0top(k,mt), qmin(mt) ) + + enddo + call conden( ps0(k), thl0top(k), qt0top(k), th, qv, ql, qi, qse, id_check ) + thvl0top(k) = thl0top(k) * ( 1._r8 + zvir * qt0top(k) ) + thv0top(k) = th * ( 1._r8 + zvir * qv - ql - qi ) + ql0top(k) = ql + qi0top(k) = qi + if( islope_on_thlqttr .eq. 0 ) then + thv0top(k) = thv0(k) + ql0top(k) = ql0(k) + qi0top(k) = qi0(k) + endif + rho0top(k) = ps0(k) / ( r * thv0top(k) * exns0(k) ) + + ssql0(k) = ( ql0top(k) - ql0bot(k) ) / ( ps0(k) - ps0(km) ) + ssqi0(k) = ( qi0top(k) - qi0bot(k) ) / ( ps0(k) - ps0(km) ) + + end do ! k = 1, mkx + + ! ---------------------------------------------------------------------------- ! + ! Compute 'tke1' and 'wstar1' in the lowest model layer ! + ! Below compute average 'tke' and 'wstar' from the sfc ! + ! to the specified top interface, kc. ! + ! Also define 'wstar2' only using 'surface buoyancy production' ( bprod0(0) ) ! + ! and 'PBLH'. This 'wstar2' seems to be the most reasonable choice of ! + ! velocity scale to compute 'sigma_w'. This 'wstar2' is also independent of ! + ! vertical resolution of GCM model grid. ! + ! ---------------------------------------------------------------------------- ! + + tmp1 = 0._r8 + tmp2 = 0._r8 + tke1 = 0._r8 + wstar1 = 0._r8 + kc = 1 ! Top interface of the average domain. + do k = 0, kc ! Here, 'k' is an interfacial layer index. + if( k .eq. 0 ) then + dpi = ps0(0) - p0(1) + dzi = z0(1) - zs0(0) + elseif( k .eq. kc ) then + dpi = p0(kc) - ps0(kc) + dzi = zs0(kc) - z0(kc) + else + dpi = p0(k) - p0(k+1) + dzi = z0(k+1) - z0(k) + endif + tmp1 = tmp1 + dpi + tmp2 = tmp2 + dzi + tke1 = tke1 + dpi*tke0(k) + wstar1 = wstar1 + dzi*bprod0(k) + end do + tke1 = tke1 / tmp1 + wstar1 = ( 2.5_r8 * max( 0._r8, wstar1 ) )**(1._r8/3._r8) + tmp1 = ( qv0(1) + ql0(1) + qi0(1) ) + tmp2 = ( t0(1) - xlv * ql0(1) / cp - xls * qi0(1) / cp ) / ( ( p0(1) / p00 )**rovcp ) + call conden( p0(1), tmp2, tmp1, th, qv, ql, qi, qse, id_check ) + wstar2 = ( max( 0._r8, bprod0(0) ) * pblhz )**(1._r8/3._r8) + wstar2 = max( 0._r8, min( wstar2, 10._r8 ) ) + + ! OPTION + ! Re-define 'tke1' as 'tke' at the 1st interface + if( kiss .eq. 0 ) then + ! Jun.28.2011. Directly use 'tkes' from the UW PBL scheme which does not include transport term. + tke1 = tke0(0) + ! tke1 = tkes + else + tke1 = tke0(1) + endif + tke1 = max(1.e-5_r8,min(3._r8,tke1)) + ! OPTION + + tmp1 = 0._r8 + tmp2 = 0._r8 + tkePBL = 0._r8 + wstarPBL = 0._r8 + kc = kpblhm ! Top interface of the average domain. + do k = 0, kc ! Here, 'k' is an interfacial layer index. + if( k .eq. 0 ) then + dpi = ps0(0) - p0(1) + dzi = z0(1) - zs0(0) + elseif( k .eq. kc ) then + dpi = p0(kc) - ps0(kc) + dzi = zs0(kc) - z0(kc) + else + dpi = p0(k) - p0(k+1) + dzi = z0(k+1) - z0(k) + endif + tmp1 = tmp1 + dpi + tmp2 = tmp2 + dzi + tkePBL = tkePBL + dpi*tke0(k) + wstarPBL = wstarPBL + dzi*bprod0(k) + end do + tkePBL = tkePBL / tmp1 + tkePBL = max(1.e-5_r8,min(3._r8,tkePBL)) + wstarPBL = ( 2.5_r8 * max( 0._r8, wstarPBL ) )**(1._r8/3._r8) + + tke1 = tkePBL + + ! ---------------------------------------------------------------------------- ! + ! Sep.16.2011. Compute forbidden area fraction by subgrid variation of surface ! + ! topograpgic height. ! + ! Following 'tms', I am using 'sgh30' not 'sgh'. ! + ! Impose a upper limit of 'a_oro_max' on the 'a_oro'. ! + ! ---------------------------------------------------------------------------- ! + + a_oro = sgh30 / norm_sgh + a_oro = max( 0._r8, min( a_oro_max, a_oro ) ) + + ! --------------------------------------------------------------------------------------------------------- ! + ! Sep.11.2011. Insert a condition preventing negative thl, qt , tracers both within wake and non-wake areas ! + ! before wake-inhomogeneity adjustment. ! + ! --------------------------------------------------------------------------------------------------------- ! + +!lim In fact, below limiters before buoyancy adjustment are not necessary, since buoyancy adjument of cold pool +!lim can be done regardless of what is the value of 'delta_xxx_PBL'. So, I commented out below limiters. +!lim Just for computing 'delta_thv_PBL_raw' below, impose a limiter for 'delta_thl_PBL_raw, delta_qt_PBL_raw' +!lim Also add a limiter at the surface and top interface of the PBL for full consistency. + +!lim thl0min_PBL = thl0bot(1) + qt0min_PBL = qt0bot(1) + tr0min_PBL(:ncnst) = tr0bot(1,:ncnst) + do k = 1, kpblhm +!lim thl0min_PBL = min( thl0min_PBL, thl0(k) ) + qt0min_PBL = min( qt0min_PBL, qt0(k) ) + do mt = 1, ncnst + tr0min_PBL(mt) = min( tr0min_PBL(mt), tr0(k,mt) ) + enddo + enddo +!lim thl0min_PBL = min( thl0min_PBL, thl0top(kpblhm) ) + qt0min_PBL = min( qt0min_PBL, qt0top(kpblhm) ) + do mt = 1, ncnst + tr0min_PBL(mt) = min( tr0min_PBL(mt), tr0top(kpblhm,mt) ) + enddo + +!lim delta_thl_PBL_raw = min( max( -thl0min_PBL, delta_thl_PBL_raw ), thl0min_PBL * awk_PBL_raw / ( 1._r8 - awk_PBL_raw ) ) + delta_qt_PBL_raw = min( max( qmin(1) - qt0min_PBL, delta_qt_PBL_raw ), & + ( qt0min_PBL - qmin(1) ) * awk_PBL_raw / ( 1._r8 - awk_PBL_raw ) ) + do mt = 1, ncnst + delta_tr_PBL_raw(mt) = min( max( qmin(mt) - tr0min_PBL(mt), delta_tr_PBL_raw(mt) ), & + ( tr0min_PBL(mt) - qmin(mt) ) * awk_PBL_raw / ( 1._r8 - awk_PBL_raw ) ) + enddo + +!lim2 It seems that below 4 limiters are too physically restricted without influencing model crash and +!lim2 computation time. So, I removed them. + + delta_thl_PBL_raw = max( - 2.0_r8, min( 2.0_r8, delta_thl_PBL_raw ) ) + delta_qt_PBL_raw = max( - 0.2_r8*qt0min_PBL, min( 0.2_r8*qt0min_PBL, delta_qt_PBL_raw ) ) + delta_u_PBL_raw = max( - 2.0_r8, min( 2.0_r8 , delta_u_PBL_raw ) ) + delta_v_PBL_raw = max( - 2.0_r8, min( 2.0_r8 , delta_v_PBL_raw ) ) + +!lim In fact, below computation from individual layer computation is also unnecessary. +!lim We only need to do a bulk computation, which is also good for saving computation time. +!lim However, in order to use 'conden' subroutine with p0(k), it seems that below computation is inevitable. +!lim Instead of using the above block, I simply used 'max( qt0(k) + delta_qt_PBL_raw, qmin(1) )' as an argument below. + + delta_thv_PBL_raw = 0._r8 + do k = 1, kpblhm ! Here, 'k' is a layer index. + call conden( p0(k), thl0(k) + delta_thl_PBL_raw, qt0(k) + delta_qt_PBL_raw, & + th, qv, ql, qi, qse, id_check ) + thv = th * ( 1._r8 + zvir * qv - ql - qi ) + delta_thv_PBL_raw = delta_thv_PBL_raw + ( thv - thv0(k) ) * dp0(k) + enddo + delta_thv_PBL_raw = delta_thv_PBL_raw / pblhp + + awk_PBL_max = 1._r8 - au_max + if( awk_PBL_raw .lt. 0._r8 .or. awk_PBL_raw .gt. awk_PBL_max ) then + write(iulog,*) + write(iulog,*) 'UNICON : Unreasonable wake area awk_PBL_raw before inhomogeneity adjustment' + write(iulog,*) 'awk_PBL_raw = ', awk_PBL_raw + call endrun('STOP : UNICON') + write(iulog,*) + endif + if( delta_thv_PBL_raw .lt. 0._r8 ) then + awk_PBL = 0._r8 + delta_thl_PBL = 0._r8 + delta_qt_PBL = 0._r8 + delta_u_PBL = 0._r8 + delta_v_PBL = 0._r8 + delta_thv_PBL = 0._r8 + do mt = 1, ncnst + delta_tr_PBL(mt) = 0._r8 + enddo + delta_w_PBL = 0._r8 + else + tmp1 = delta_thv_wc * awk_PBL_raw / ( awk_PBL_raw - 1._r8 ) / max( nonzero, delta_thv_PBL_raw ) + tmp2 = erfc( tmp1 / sqrt( 3.141592_r8 ) ) + tmp3 = exp( - tmp1**2._r8 / 3.141592_r8 ) + tmp4 = ( 1._r8 - awk_PBL_raw ) / ( 1._r8 - tmp2 * awk_PBL_raw ) + awk_PBL = tmp2 * awk_PBL_raw + delta_thl_PBL = tmp3 * tmp4 * delta_thl_PBL_raw + delta_qt_PBL = tmp3 * tmp4 * delta_qt_PBL_raw + delta_u_PBL = tmp3 * tmp4 * delta_u_PBL_raw + delta_v_PBL = tmp3 * tmp4 * delta_v_PBL_raw + delta_thv_PBL = tmp3 * tmp4 * delta_thv_PBL_raw + do mt = 1, ncnst + delta_tr_PBL(mt) = tmp3 * tmp4 * delta_tr_PBL_raw(mt) + enddo + + !lim Oct.4. Even though we apply non-negative limiter for 'delta_qt_PBL' and 'delta_tr_PBL' here, there is no way + !lim to consistently change 'delta_thv_PBL' that influences the computation of 'delta_thv_PBL' below. + !lim Thus, the limiters for 'delta_qt_PBL' and 'delta_tr_PBL' are done later without any option. + + delta_w_PBL = kw_omega * sqrt( kstar * 0.5_r8 * ( g / thv_ref ) * pblhz * awk_PBL * max( 0._r8, delta_thv_PBL ) ) + if( i_energy_coldpool .eq. 2 ) then + delta_w_PBL = sqrt( 2._r8 ) * ( g / thv_ref ) * b1 * pblhz**2._r8 * del_wk0 * awk_PBL * max( 0._r8, delta_thv_PBL ) + delta_w_PBL = delta_w_PBL**(1._r8/3._r8) * sqrt( awk_PBL ) / max( nonzero, ( 1._r8 - awk_PBL )**(1._r8/6._r8) ) + endif + + delta_w_PBL = min( 10._r8, delta_w_PBL ) + if( awk_PBL .lt. 1.e-3_r8 ) delta_w_PBL = 0._r8 + endif + if( delta_thv_PBL .lt. 0._r8 .or. awk_PBL .lt. 0._r8 .or. awk_PBL .gt. awk_PBL_max ) then + write(iulog,*) + write(iulog,*) 'UNICON : Unreasonable wake properties after inhomogeneity adjustment' + write(iulog,*) 'delta_thv_PBL, awk_PBL = ', delta_thv_PBL, awk_PBL + call endrun('STOP : UNICON') + write(iulog,*) + endif + + ! --------------------------------------------------------------------------------------------------------- ! + ! Sep.11.2011. Insert a condition preventing negative thl, qt , tracers both within wake and non-wake areas ! + ! after wake-inhomogeneity adjustment. ! + ! Aug.03.2012. I may need to below limiters in association with the use of internally computed ! + ! cdelta_s and cdelta_w. ! + ! Oct.04.2014. Consider 'tmp1 = 1/cdelta_s' too. ! + ! Also remove the limiter for 'delta_thl_PBL' since it is highly likely that it does not ! + ! happens but takes computation time. ! + ! --------------------------------------------------------------------------------------------------------- ! + + tmp1 = au_base_min_ocn * cadj_area_ocn + ( au_base_min_lnd * cadj_area_lnd - au_base_min_ocn * cadj_area_ocn ) * landfrac + +!lim delta_thl_PBL = min( max(-tmp1 * thl0min_PBL, delta_thl_PBL ), thl0min_PBL * awk_PBL / ( 1._r8 - awk_PBL ) ) + delta_qt_PBL = min( max( tmp1 * ( qmin(1) - qt0min_PBL ), delta_qt_PBL ), & + ( qt0min_PBL - qmin(1) ) * awk_PBL / ( 1._r8 - awk_PBL ) ) + do mt = 1, ncnst + delta_tr_PBL(mt) = min( max( tmp1 * ( qmin(mt) - tr0min_PBL(mt) ), delta_tr_PBL(mt) ), & + ( tr0min_PBL(mt) - qmin(mt) ) * awk_PBL / ( 1._r8 - awk_PBL ) ) + enddo + delta_tr_PBL(ixnumliq) = 0._r8 + delta_tr_PBL(ixnumice) = 0._r8 + +!lim4 I removed below 4 limiters because it seems to be too strict without any physical reason. + + delta_thl_PBL = max( - 2.0_r8, min( 2.0_r8, delta_thl_PBL ) ) + delta_qt_PBL = max( - 0.2_r8*qt0min_PBL, min( 0.2_r8*qt0min_PBL, delta_qt_PBL ) ) + delta_u_PBL = max( - 2.0_r8, min( 2.0_r8 , delta_u_PBL ) ) + delta_v_PBL = max( - 2.0_r8, min( 2.0_r8 , delta_v_PBL ) ) + +!lim Replace the above limiter as below. +!lim Practically, only need to worry about tracer, and I should take into account of the effect of 'cdelta_s'. +!lim Note that below 'tmp1 = 1 / cdelta_s' ( I should double check this ). + +!lim delta_qt_PBL = min( max( tmp1 * ( qmin(1) - qt0PBL ), delta_qt_PBL ), & +!lim ( qt0PBL - qmin(1) ) * awk_PBL / ( 1._r8 - awk_PBL ) ) +!lim do mt = 1, ncnst +!lim delta_tr_PBL(mt) = min( max( tmp1 * ( qmin(mt) - tr0PBL(mt) ), delta_tr_PBL(mt) ), & +!lim ( tr0PBL(mt) - qmin(mt) ) * awk_PBL / ( 1._r8 - awk_PBL ) ) +!lim enddo +!lim ! Nov.28.2012. For consistent treatment in the mixing with organized detrained airs with condensate later, +!lim ! simply assume below two lines. +!lim delta_tr_PBL(ixnumliq) = 0._r8 +!lim delta_tr_PBL(ixnumice) = 0._r8 + +!lim +!lim +!lim + + ! -------------------------------------------------------------------------------------------------------------------- ! + ! Sep.16.2011. Define effective 'eps_wk_eff, del_wk_eff' to allow the initial development of wake ! + ! from zero area by effectively reduce too large detrainment dilution effect of thermodynamic ! + ! scalars, 'del_wk / awk_PBL * ( 1._r8 - awk_PBL) )' due to 'zero awk_PBL' at the beginning. ! + ! -------------------------------------------------------------------------------------------------------------------- ! + + if( i_energy_coldpool .eq. 1 .or. i_energy_coldpool .eq. 2 ) then + eps_wk_eff = eps_wk0 * awk_PBL + del_wk_eff = del_wk0 * awk_PBL + endif + + ! ------------------------------------------------------------------------------------------------------------- ! + ! Compute convective organization parameter, 0 <= org_rad <= 1. ! + ! This 'org_rad' is used for computing updraft plume radius at surface ! + ! Later 'org_ent' is defined for lateral mixing later as an option. ! + ! The 'cuorg' can be computed in many different ways ( e.g., using convective precipitation flux at surface ). ! + ! Here, I am using the ratio of 'downdraft mass flux' to 'updraft mass flux' at the previous time step because ! + ! conceptually, strong downward motion is likely to generate meso-scale organized circulation near surface. ! + ! ------------------------------------------------------------------------------------------------------------- ! + + a_forbid = a_oro + awk_PBL + a_forbid = max( 0._r8, min( awk_PBL_max, a_forbid ) ) + cuorg = a_forbid / awk_PBL_max + cuorg = max( 0._r8, min( 1._r8, cuorg ) ) + + if( orgfeedback_off ) then + cuorg = 0._r8 + endif + + org_rad = fac_org_rad * cuorg ! Mar.11.2011. Most Advanced. + org_rad = max( 0._r8, min( 1._r8, org_rad ) ) ! Force to be [0,1] after multiplication of fac_org_rad. + + if( orp .ge. 0._r8 ) then + tmp1 = org_rad**orp + else + tmp1 = 0.5_r8 * ( 1._r8 + sin( 3.141592_r8 * ( org_rad - 0.5_r8 ) ) ) + endif + + ! ------------------------------------------------------------------------------- ! + ! Compute Land-Ocean Avarage Parameters ! + ! ------------------------------------------------------------------------------- ! + + criqc = criqc_ocn + ( criqc_lnd - criqc_ocn ) * landfrac + c0_ac = c0_ac_ocn + ( c0_ac_lnd - c0_ac_ocn ) * landfrac + kevp_rain = kevp_rain_ocn + ( kevp_rain_lnd - kevp_rain_ocn ) * landfrac + kevp_snow = kevp_snow_ocn + ( kevp_snow_lnd - kevp_snow_ocn ) * landfrac + kevp_rain_dn = kevp_rain_dn_ocn + ( kevp_rain_dn_lnd - kevp_rain_dn_ocn ) * landfrac + kevp_snow_dn = kevp_snow_dn_ocn + ( kevp_snow_dn_lnd - kevp_snow_dn_ocn ) * landfrac + + tmp2 = au_base_max_lnd + if( iau_base_lnd .eq. 1 ) then + tmp2 = au_base_min_lnd * ( 1._r8 - awk_PBL_max ) + endif + tmp3 = au_base_max_ocn + if( iau_base_ocn .eq. 1 ) then + tmp3 = au_base_min_ocn * ( 1._r8 - awk_PBL_max ) + endif + + au_base_min = au_base_min_ocn + ( au_base_min_lnd - au_base_min_ocn ) * landfrac + au_base_max = tmp3 + ( tmp2 - tmp3 ) * landfrac + Ro_min = Ro_min_ocn + ( Ro_min_lnd - Ro_min_ocn ) * landfrac + Ro_max = Ro_max_ocn + ( Ro_max_lnd - Ro_max_ocn ) * landfrac + sigmaR_min = sigmaR_min_ocn + ( sigmaR_min_lnd - sigmaR_min_ocn ) * landfrac + sigmaR_max = sigmaR_max_ocn + ( sigmaR_max_lnd - sigmaR_max_ocn ) * landfrac + kw_min = kw_min_ocn + ( kw_min_lnd - kw_min_ocn ) * landfrac + kw_max = kw_max_ocn + ( kw_max_lnd - kw_max_ocn ) * landfrac + + Ro = Ro_min + ( Ro_max - Ro_min ) * tmp1 + sigmaR = sigmaR_min + ( sigmaR_max - sigmaR_min ) * tmp1 + kw = kw_min + ( kw_max - kw_min ) * tmp1 + + au_base = au_base_min + ( au_base_max - au_base_min ) * org_rad + au_base_ocn = au_base_min_ocn + ( tmp3 - au_base_min_ocn ) * org_rad + au_base_lnd = au_base_min_lnd + ( tmp2 - au_base_min_lnd ) * org_rad + + AOVTU = au_base_ocn * cadj_area_ocn + ( au_base_lnd * cadj_area_lnd - au_base_ocn * cadj_area_ocn ) * landfrac + cdelta_s = ( 1._r8 - awk_PBL ) / max( nonzero, AOVTU ) + cdelta_s = max( 1._r8, min( cdelta_s, 100._r8 ) ) + + if( orgfeedback_off ) then + cdelta_s = 0._r8 + endif + + cdelta_w = sqrt( cdelta_s ) + + if( i_energy_coldpool .eq. 2 ) then + cdelta_w = sqrt( cdelta_s ) / max( nonzero, ( AOVTU + awk_PBL )**(1._r8/6._r8) ) + endif + + alpha_cri = 0._r8 + + ! --------------------------------------------- ! + ! ! + ! Main computation of cumulus updraft evolution ! + ! ! + ! --------------------------------------------- ! + + do iter = 1, niter + + ! ------------------------------------------------------------------------------------------- ! + ! Aug.01.2011. Brian Juwon Park's Birthday. This 'do iter' routine can be used for explicit ! + ! mixing of convective updraft and downdraft with different mixing environmental ! + ! airs because vertical evolution of convective updraft and downdraft is highly ! + ! non-linear to the properties of mixing environmental airs. Thus, the simple ! + ! use of mean environmental airs for mixing is not ideal. This explicit mixing ! + ! process will inevitably increase computation time but seems to be important. ! + ! (1) iter = 1 : mixing with mean environmental airs at the current time step ! + ! ( with the probability of '1._r8 - cuorg' ) ! + ! (2) iter = 2 : mixing with detrained + cumulus updraft airs at the previous ! + ! time step ( with the probability of 'cuorg' ) ! + ! Note that this 'cuorg_mxen' is used only for 'org_ent', neither 'org_rad' nor ! + ! 'org_src' since 'cuorg_mxen' is designed to choose mixing environmental airs. ! + ! ------------------------------------------------------------------------------------------- ! + + if( niter .eq. 1 ) then + cuorg_mxen = cuorg + else + if( iter .eq. 1 ) then + cuorg_mxen = 0._r8 + elseif( iter .eq. 2 ) then + cuorg_mxen = 1._r8 + endif + endif + + ! ------------------------------------------------------------------------------------------------------- ! + ! ! + ! Iteration for treating accretion should start here. ! + ! ! + ! The variables used for the next accretion iteration computations within 'subroutine prod_prep_up' are ! + ! ! + ! 1. flxrain_msfc(k,msfc), flxsnow_msfc(k,msfc) ! + ! 2. a_p_msfc(k,msfc) ! + ! 3. am_us_msfc(k,msfc) ! + ! 4. am_pu_msfc(k,msfc) ! + ! ! + ! all of which will be computed before the end of accretion iteration loop. ! + ! ! + ! ------------------------------------------------------------------------------------------------------- ! + + do iacc = 1, nacc + + if( iacc .eq. 1 ) then + + ! -------------------------------------------------------------------------------------- ! + ! Initialize below variables only at the first iteration, since at the second iteration, ! + ! non-zero values will be used for accretion. ! + ! -------------------------------------------------------------------------------------- ! + + flxrain_msfc(0:mkx,:nseg) = 0._r8 + flxsnow_msfc(0:mkx,:nseg) = 0._r8 + flxtrrs_msfc(0:mkx,:nseg,:ncnst) = 0._r8 + + a_p_msfc(0:mkx,:nseg) = 0._r8 + + am_u_msfc(:mkx,:nseg) = 0._r8 + am_up_msfc(:mkx,:nseg) = 0._r8 + am_us_msfc(:mkx,:nseg) = 0._r8 + + am_evp_msfc(:mkx,:nseg) = 0._r8 + am_pu_msfc(:mkx,:nseg) = 0._r8 + am_pd_msfc(:mkx,:nseg) = 0._r8 + am_pr_msfc(:mkx,:nseg) = 0._r8 + am_ps_msfc(:mkx,:nseg) = 0._r8 + + endif + + ! --------------------------------------------------- ! + ! ! + ! ! + ! Iteration for treating accretion should start here. ! + ! ! + ! ! + ! --------------------------------------------------- ! + + ! --------------------------------------------------------------------------- ! + ! Initialization of ensemble-mean arrays in each layer inside the 'iter' loop ! + ! --------------------------------------------------------------------------- ! + + flxrain(0:mkx) = 0._r8 + flxsnow(0:mkx) = 0._r8 + flxtrrs(0:mkx,:ncnst) = 0._r8 + + cmf_u_mix(:mkx) = 0._r8 + cmf_r(:mkx) = 0._r8 + thl_r(:mkx) = 0._r8 + qt_r(:mkx) = 0._r8 + u_r(:mkx) = 0._r8 + v_r(:mkx) = 0._r8 + ql_r(:mkx) = 0._r8 + qi_r(:mkx) = 0._r8 + tr_r(:mkx,:ncnst) = 0._r8 + + cmf_r2(:mkx) = 0._r8 + thl_r2(:mkx) = 0._r8 + qt_r2(:mkx) = 0._r8 + u_r2(:mkx) = 0._r8 + v_r2(:mkx) = 0._r8 + ql_r2(:mkx) = 0._r8 + qi_r2(:mkx) = 0._r8 + tr_r2(:mkx,:ncnst) = 0._r8 + + thl_u(0:mkx) = 0._r8 + qt_u(0:mkx) = 0._r8 + u_u(0:mkx) = 0._r8 + v_u(0:mkx) = 0._r8 + cmf_u(0:mkx) = 0._r8 + w_u(0:mkx) = 0._r8 + wa_u(0:mkx) = 0._r8 + a_u(0:mkx) = 0._r8 + num_u(0:mkx) = 0._r8 + rad_u(0:mkx) = 0._r8 + ql_u(0:mkx) = 0._r8 + qi_u(0:mkx) = 0._r8 + tr_u(0:mkx,:ncnst) = 0._r8 + qla_u(0:mkx) = 0._r8 + qia_u(0:mkx) = 0._r8 + thva_u(0:mkx) = 0._r8 + + cmf_u_dia(:mkx) = 0._r8 + evp_thll_u(:mkx) = 0._r8 + evp_qtl_u(:mkx) = 0._r8 + evp_thli_u(:mkx) = 0._r8 + evp_qti_u(:mkx) = 0._r8 + prep_thll_u(:mkx) = 0._r8 + prep_qtl_u(:mkx) = 0._r8 + prep_thli_u(:mkx) = 0._r8 + prep_qti_u(:mkx) = 0._r8 + eff_ql_u(:mkx) = 0._r8 + eff_qi_u(:mkx) = 0._r8 + PGF_u_u(:mkx) = 0._r8 + PGF_v_u(:mkx) = 0._r8 + evp_tr_u(:mkx,:ncnst) = 0._r8 + prep_tr_u(:mkx,:ncnst) = 0._r8 + eff_tr_u(:mkx,:ncnst) = 0._r8 + + thl_srcd(:mkx) = 0._r8 + qt_srcd(:mkx) = 0._r8 + u_srcd(:mkx) = 0._r8 + v_srcd(:mkx) = 0._r8 + tr_srcd(:mkx,:ncnst) = 0._r8 + f_srcd(:mkx) = 0._r8 + ql_srcd(:mkx) = 0._r8 + qi_srcd(:mkx) = 0._r8 + + thl_srcds(:mkx,:nseg,1:3) = 0._r8 + qt_srcds(:mkx,:nseg,1:3) = 0._r8 + u_srcds(:mkx,:nseg,1:3) = 0._r8 + v_srcds(:mkx,:nseg,1:3) = 0._r8 + tr_srcds(:mkx,:nseg,1:3,:ncnst) = 0._r8 + f_srcds(:mkx,:nseg,1:3) = 0._r8 + ql_srcds(:mkx,:nseg,1:3) = 0._r8 + qi_srcds(:mkx,:nseg,1:3) = 0._r8 + + thl_srcr(:mkx) = 0._r8 + qt_srcr(:mkx) = 0._r8 + u_srcr(:mkx) = 0._r8 + v_srcr(:mkx) = 0._r8 + tr_srcr(:mkx,:ncnst) = 0._r8 + f_srcr(:mkx) = 0._r8 + ql_srcr(:mkx) = 0._r8 + qi_srcr(:mkx) = 0._r8 + + thl_srcr2(:mkx) = 0._r8 + qt_srcr2(:mkx) = 0._r8 + u_srcr2(:mkx) = 0._r8 + v_srcr2(:mkx) = 0._r8 + tr_srcr2(:mkx,:ncnst) = 0._r8 + f_srcr2(:mkx) = 0._r8 + ql_srcr2(:mkx) = 0._r8 + qi_srcr2(:mkx) = 0._r8 + + thl_srcrs(:mkx,:nseg,1:3) = 0._r8 + qt_srcrs(:mkx,:nseg,1:3) = 0._r8 + u_srcrs(:mkx,:nseg,1:3) = 0._r8 + v_srcrs(:mkx,:nseg,1:3) = 0._r8 + tr_srcrs(:mkx,:nseg,1:3,:ncnst) = 0._r8 + f_srcrs(:mkx,:nseg,1:3) = 0._r8 + ql_srcrs(:mkx,:nseg,1:3) = 0._r8 + qi_srcrs(:mkx,:nseg,1:3) = 0._r8 + + thl_srcrs2(:mkx,:nseg,1:3) = 0._r8 + qt_srcrs2(:mkx,:nseg,1:3) = 0._r8 + u_srcrs2(:mkx,:nseg,1:3) = 0._r8 + v_srcrs2(:mkx,:nseg,1:3) = 0._r8 + tr_srcrs2(:mkx,:nseg,1:3,:ncnst) = 0._r8 + f_srcrs2(:mkx,:nseg,1:3) = 0._r8 + ql_srcrs2(:mkx,:nseg,1:3) = 0._r8 + qi_srcrs2(:mkx,:nseg,1:3) = 0._r8 + + cmf_ru(:mkx) = 0._r8 + thl_ru(:mkx) = 0._r8 + qt_ru(:mkx) = 0._r8 + u_ru(:mkx) = 0._r8 + v_ru(:mkx) = 0._r8 + ql_ru(:mkx) = 0._r8 + qi_ru(:mkx) = 0._r8 + tr_ru(:mkx,:ncnst) = 0._r8 + + cmf_ru2(:mkx) = 0._r8 + thl_ru2(:mkx) = 0._r8 + qt_ru2(:mkx) = 0._r8 + u_ru2(:mkx) = 0._r8 + v_ru2(:mkx) = 0._r8 + ql_ru2(:mkx) = 0._r8 + qi_ru2(:mkx) = 0._r8 + tr_ru2(:mkx,:ncnst) = 0._r8 + + cmf_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + thl_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + qt_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + u_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + v_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + w_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + a_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + ql_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + qi_ad(0:mkx,:mkx,1:nseg,1:3) = 0._r8 + tr_ad(0:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + + dpad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + + cmf_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + thl_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + qt_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + u_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + v_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + tr_ar(:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + ql_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + qi_ar(:mkx,:mkx,1:nseg,1:3) = 0._r8 + + cmf_ad_dia(:mkx,:mkx,1:nseg,1:3) = 0._r8 + evp_thll_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + evp_qtl_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + evp_thli_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + evp_qti_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + prep_thll_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + prep_qtl_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + prep_thli_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + prep_qti_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + eff_ql_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + eff_qi_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + PGF_u_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + PGF_v_ad(:mkx,:mkx,1:nseg,1:3) = 0._r8 + evp_tr_ad(:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + prep_tr_ad(:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + wdep_tr_ad(:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + eff_tr_ad(:mkx,:mkx,1:nseg,1:3,:ncnst) = 0._r8 + + cmf_d(0:mkx) = 0._r8 + thl_d(0:mkx) = 0._r8 + qt_d(0:mkx) = 0._r8 + u_d(0:mkx) = 0._r8 + v_d(0:mkx) = 0._r8 + w_d(0:mkx) = 0._r8 + a_d(0:mkx) = 0._r8 + wa_d(0:mkx) = 0._r8 + ql_d(0:mkx) = 0._r8 + qi_d(0:mkx) = 0._r8 + tr_d(0:mkx,:ncnst) = 0._r8 + qla_d(0:mkx) = 0._r8 + qia_d(0:mkx) = 0._r8 + + cmf_d_dia(:mkx) = 0._r8 + evp_thll_d(:mkx) = 0._r8 + evp_qtl_d(:mkx) = 0._r8 + evp_thli_d(:mkx) = 0._r8 + evp_qti_d(:mkx) = 0._r8 + prep_thll_d(:mkx) = 0._r8 + prep_qtl_d(:mkx) = 0._r8 + prep_thli_d(:mkx) = 0._r8 + prep_qti_d(:mkx) = 0._r8 + eff_ql_d(:mkx) = 0._r8 + eff_qi_d(:mkx) = 0._r8 + PGF_u_d(:mkx) = 0._r8 + PGF_v_d(:mkx) = 0._r8 + evp_tr_d(:mkx,:ncnst) = 0._r8 + prep_tr_d(:mkx,:ncnst) = 0._r8 + eff_tr_d(:mkx,:ncnst) = 0._r8 + + cmf_rd(:mkx) = 0._r8 + thl_rd(:mkx) = 0._r8 + qt_rd(:mkx) = 0._r8 + u_rd(:mkx) = 0._r8 + v_rd(:mkx) = 0._r8 + ql_rd(:mkx) = 0._r8 + qi_rd(:mkx) = 0._r8 + tr_rd(:mkx,:ncnst) = 0._r8 + + qlten_sub(:mkx) = 0._r8 + qiten_sub(:mkx) = 0._r8 + + rqc_l(:mkx) = 0._r8 + rqc_i(:mkx) = 0._r8 + rqc(:mkx) = 0._r8 + rnc_l(:mkx) = 0._r8 + rnc_i(:mkx) = 0._r8 + + cmf_det(:mkx) = 0._r8 + ql_det(:mkx) = 0._r8 + qi_det(:mkx) = 0._r8 + + qlten_det(:mkx) = 0._r8 + qiten_det(:mkx) = 0._r8 + + am_d_msfc(:mkx,:nseg) = 0._r8 + + am_u(:mkx) = 0._r8 + am_d(:mkx) = 0._r8 + + qlm_u_msfc(:mkx,:nseg) = 0._r8 + qim_u_msfc(:mkx,:nseg) = 0._r8 + thlm_u_msfc(:mkx,:nseg) = 0._r8 + qtm_u_msfc(:mkx,:nseg) = 0._r8 + um_u_msfc(:mkx,:nseg) = 0._r8 + vm_u_msfc(:mkx,:nseg) = 0._r8 + trm_u_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + qlm_u(:mkx) = 0._r8 + qim_u(:mkx) = 0._r8 + thlm_u(:mkx) = 0._r8 + qtm_u(:mkx) = 0._r8 + um_u(:mkx) = 0._r8 + vm_u(:mkx) = 0._r8 + trm_u(:mkx,:ncnst) = 0._r8 + + qlm_d_msfc(:mkx,:nseg) = 0._r8 + qim_d_msfc(:mkx,:nseg) = 0._r8 + + qlm_d(:mkx) = 0._r8 + qim_d(:mkx) = 0._r8 + + am_s(:mkx) = 0._r8 + am_r(:mkx) = 0._r8 + am_up(:mkx) = 0._r8 + am_us(:mkx) = 0._r8 + + a_p(0:mkx) = 0._r8 + + am_evp(:mkx) = 0._r8 + am_pu(:mkx) = 0._r8 + am_pd(:mkx) = 0._r8 + am_pr(:mkx) = 0._r8 + am_ps(:mkx) = 0._r8 + + thl_u_msfc(0:mkx,:nseg) = 0._r8 + qt_u_msfc(0:mkx,:nseg) = 0._r8 + u_u_msfc(0:mkx,:nseg) = 0._r8 + v_u_msfc(0:mkx,:nseg) = 0._r8 + w_u_msfc(0:mkx,:nseg) = 0._r8 + ql_u_msfc(0:mkx,:nseg) = 0._r8 + qi_u_msfc(0:mkx,:nseg) = 0._r8 + tr_u_msfc(0:mkx,:nseg,:ncnst) = 0._r8 + cmf_u_msfc(0:mkx,:nseg) = 0._r8 + a_u_msfc(0:mkx,:nseg) = 0._r8 + num_u_msfc(0:mkx,:nseg) = 0._r8 + rad_u_msfc(0:mkx,:nseg) = 0._r8 + + eps0_u_msfc(0:mkx,:nseg) = 0._r8 + eps_u_msfc(0:mkx,:nseg) = 0._r8 + del_u_msfc(0:mkx,:nseg) = 0._r8 + eeps_u_msfc(0:mkx,:nseg) = 0._r8 + ddel_u_msfc(0:mkx,:nseg) = 0._r8 + xc_u_msfc(0:mkx,:nseg) = 0._r8 + xs_u_msfc(0:mkx,:nseg) = 0._r8 + xemin_u_msfc(0:mkx,:nseg) = 0._r8 + xemax_u_msfc(0:mkx,:nseg) = 0._r8 + cridis_u_msfc(0:mkx,:nseg) = 0._r8 + thvcuenv_u_msfc(0:mkx,:nseg) = 0._r8 + thvegenv_u_msfc(0:mkx,:nseg) = 0._r8 + thvxsenv_u_msfc(0:mkx,:nseg) = 0._r8 + fmix_u_msfc(0:mkx,:nseg) = 0._r8 + cmfumix_u_msfc(0:mkx,:nseg) = 0._r8 + + x_um_msfc(:mkx,:nseg) = 0._r8 + y_um_msfc(:mkx,:nseg) = 0._r8 + x_p_msfc(0:mkx,:nseg) = 0._r8 + y_p_msfc(0:mkx,:nseg) = 0._r8 + + thl_d_msfc(0:mkx,:nseg) = 0._r8 + qt_d_msfc(0:mkx,:nseg) = 0._r8 + u_d_msfc(0:mkx,:nseg) = 0._r8 + v_d_msfc(0:mkx,:nseg) = 0._r8 + w_d_msfc(0:mkx,:nseg) = 0._r8 + ql_d_msfc(0:mkx,:nseg) = 0._r8 + qi_d_msfc(0:mkx,:nseg) = 0._r8 + tr_d_msfc(0:mkx,:nseg,:ncnst) = 0._r8 + wa_d_msfc(0:mkx,:nseg) = 0._r8 + qla_d_msfc(0:mkx,:nseg) = 0._r8 + qia_d_msfc(0:mkx,:nseg) = 0._r8 + cmf_d_msfc(0:mkx,:nseg) = 0._r8 + a_d_msfc(0:mkx,:nseg) = 0._r8 + + slflx_u(0:mkx) = 0._r8 + qtflx_u(0:mkx) = 0._r8 + uflx_u(0:mkx) = 0._r8 + vflx_u(0:mkx) = 0._r8 + qlflx_u(0:mkx) = 0._r8 + qiflx_u(0:mkx) = 0._r8 + trflx_u(0:mkx,:ncnst) = 0._r8 + + slten_u(:mkx) = 0._r8 + qtten_u(:mkx) = 0._r8 + uten_u(:mkx) = 0._r8 + vten_u(:mkx) = 0._r8 + sten_u(:mkx) = 0._r8 + qvten_u(:mkx) = 0._r8 + qlten_u(:mkx) = 0._r8 + qiten_u(:mkx) = 0._r8 + trten_u(:mkx,:ncnst) = 0._r8 + + slflx_d(0:mkx) = 0._r8 + qtflx_d(0:mkx) = 0._r8 + uflx_d(0:mkx) = 0._r8 + vflx_d(0:mkx) = 0._r8 + qlflx_d(0:mkx) = 0._r8 + qiflx_d(0:mkx) = 0._r8 + trflx_d(0:mkx,:ncnst) = 0._r8 + + slten_d(:mkx) = 0._r8 + qtten_d(:mkx) = 0._r8 + uten_d(:mkx) = 0._r8 + vten_d(:mkx) = 0._r8 + sten_d(:mkx) = 0._r8 + qvten_d(:mkx) = 0._r8 + qlten_d(:mkx) = 0._r8 + qiten_d(:mkx) = 0._r8 + trten_d(:mkx,:ncnst) = 0._r8 + + slten_evp(:mkx) = 0._r8 + qtten_evp(:mkx) = 0._r8 + uten_evp(:mkx) = 0._r8 + vten_evp(:mkx) = 0._r8 + sten_evp(:mkx) = 0._r8 + qvten_evp(:mkx) = 0._r8 + qlten_evp(:mkx) = 0._r8 + qiten_evp(:mkx) = 0._r8 + trten_evp(:mkx,:ncnst) = 0._r8 + trten_wdep(:mkx,:ncnst) = 0._r8 + + qrten(:mkx) = 0._r8 + qsten(:mkx) = 0._r8 + + evapc(:mkx) = 0._r8 + + qrten_u(:mkx) = 0._r8 + qsten_u(:mkx) = 0._r8 + + qrten_u_msfc(:mkx,:nseg) = 0._r8 + qsten_u_msfc(:mkx,:nseg) = 0._r8 + trrsten_u_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + qrten_d(:mkx) = 0._r8 + qsten_d(:mkx) = 0._r8 + + qrten_d_msfc(:mkx,:nseg) = 0._r8 + qsten_d_msfc(:mkx,:nseg) = 0._r8 + trrsten_d_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + snowmlt_e(:mkx) = 0._r8 + snowmlt_e_msfc(:mkx,:nseg) = 0._r8 + + thlten_dia_u(:mkx) = 0._r8 + thlten_dia_d(:mkx) = 0._r8 + + qtten_dia_u(:mkx) = 0._r8 + qtten_dia_d(:mkx) = 0._r8 + + qlten_dia_u(:mkx) = 0._r8 + qlten_dia_d(:mkx) = 0._r8 + + qiten_dia_u(:mkx) = 0._r8 + qiten_dia_d(:mkx) = 0._r8 + + trten_dia_u(:mkx,:ncnst) = 0._r8 + trten_dia_d(:mkx,:ncnst) = 0._r8 + + ntraprd(:mkx) = 0._r8 + ntsnprd(:mkx) = 0._r8 + nttrrsprd(:mkx,:ncnst) = 0._r8 + + ntraprd_msfc(:mkx,:nseg) = 0._r8 + ntsnprd_msfc(:mkx,:nseg) = 0._r8 + nttrrsprd_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + evprain_e(:mkx) = 0._r8 + evpsnow_e(:mkx) = 0._r8 + evptrrs_e(:mkx,:ncnst) = 0._r8 + wdeptrrs_e(:mkx,:ncnst) = 0._r8 + + evprain_d(:mkx) = 0._r8 + evpsnow_d(:mkx) = 0._r8 + evptrrs_d(:mkx,:ncnst) = 0._r8 + + evprain_e_msfc(:mkx,:nseg) = 0._r8 + evpsnow_e_msfc(:mkx,:nseg) = 0._r8 + evptrrs_e_msfc(:mkx,:nseg,:ncnst) = 0._r8 + wdeptrrs_e_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + evprain_d_msfc(:mkx,:nseg) = 0._r8 + evpsnow_d_msfc(:mkx,:nseg) = 0._r8 + evptrrs_d_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + cvp_rainprd(:mkx) = 0._r8 + cvp_snowprd(:mkx) = 0._r8 + cvp_trrsprd(:mkx,:ncnst) = 0._r8 + + cvp_rainprd_msfc(:mkx,:nseg) = 0._r8 + cvp_snowprd_msfc(:mkx,:nseg) = 0._r8 + cvp_trrsprd_msfc(:mkx,:nseg,:ncnst) = 0._r8 + + qlten_eff_u(:mkx) = 0._r8 + qiten_eff_u(:mkx) = 0._r8 + + qlten_eff_d(:mkx) = 0._r8 + qiten_eff_d(:mkx) = 0._r8 + + trten_eff_u(:mkx,:ncnst) = 0._r8 + trten_eff_d(:mkx,:ncnst) = 0._r8 + + qlten_par(:mkx) = 0._r8 + qiten_par(:mkx) = 0._r8 + qtten_par(:mkx) = 0._r8 + slten_par(:mkx) = 0._r8 + uten_par(:mkx) = 0._r8 + vten_par(:mkx) = 0._r8 + trten_par(:mkx,:ncnst) = 0._r8 + + ql_env_ua(:mkx) = 0._r8 + qi_env_ua(:mkx) = 0._r8 + + ql_env_da(:mkx) = 0._r8 + qi_env_da(:mkx) = 0._r8 + + sten_NUM(:mkx) = 0._r8 + slten_NUM(:mkx) = 0._r8 + qtten_NUM(:mkx) = 0._r8 + uten_NUM(:mkx) = 0._r8 + vten_NUM(:mkx) = 0._r8 + qvten_NUM(:mkx) = 0._r8 + qlten_NUM(:mkx) = 0._r8 + qiten_NUM(:mkx) = 0._r8 + trten_NUM(:mkx,:ncnst) = 0._r8 + + qlten(:mkx) = 0._r8 + qiten(:mkx) = 0._r8 + qvten(:mkx) = 0._r8 + sten(:mkx) = 0._r8 + uten(:mkx) = 0._r8 + vten(:mkx) = 0._r8 + trten(:mkx,:ncnst) = 0._r8 + + N_up(0:mkx) = 0 + ptops(:mkx,:nseg) = 0._r8 + ztops(:mkx,:nseg) = 0._r8 + m_from_msfc(:mkx,:nseg) = 0 + msfc_from_m(:mkx,:nseg) = 0 + ktop_msfc(:nseg) = 0 + ptop_msfc(:nseg) = 0._r8 + ztop_msfc(:nseg) = 0._r8 + + thle_b(:mkx) = 0._r8 + qte_b(:mkx) = 0._r8 + tre_b(:mkx,:ncnst) = 0._r8 + ue_b(:mkx) = 0._r8 + ve_b(:mkx) = 0._r8 + we_b(:mkx) = 0._r8 + qle_b(:mkx) = 0._r8 + qie_b(:mkx) = 0._r8 + ssthle(:mkx) = 0._r8 + ssqte(:mkx) = 0._r8 + ssue(:mkx) = 0._r8 + ssve(:mkx) = 0._r8 + ssqle(:mkx) = 0._r8 + ssqie(:mkx) = 0._r8 + sstre(:mkx,:ncnst) = 0._r8 + + ! ---------------------------------------------------------------------------------------------------------------- ! + ! Nov.03.2012. REFINEMENT IS NECESSARY FOR TREATING ACCRETION OF CLOUD DROPLETS. ! + ! The iteration loop for computing accretion of cloud droplet will start here. ! + ! However, correct initialization of several summed array variables may be necessary here again. ! + ! I should be careful on this initialization. ! + ! ---------------------------------------------------------------------------------------------------------------- ! + + ! --------------------------------------- ! + ! ! + ! Beginning of Updraft Computation Upward ! + ! ! + ! --------------------------------------- ! + + do k = kiss + 1, mkx - 1 ! Here, 'k' is a layer index. + + km = k - 1 ! Here, 'km' is a base interface index. + + ! ----------------------------------------- ! + ! Define environmental structure variables. ! + ! ----------------------------------------- ! + + z_b = zs0(km) + z_t = zs0(k) + + p_b = ps0(km) + p_t = ps0(k) + + dz_m = dz0(k) + dp_m = dp0(k) + + exn_b = exns0(km) + exn_t = exns0(k) + + thl_b = thl0bot(k) + + qt_b = qt0bot(k) + + u_b = u0bot(k) + + v_b = v0bot(k) + + ql_b = ql0bot(k) + + qi_b = qi0bot(k) + + thv_b = thv0bot(k) + thv_t = thv0top(k) + + thvl_b = thvl0bot(k) + thvl_t = thvl0top(k) + + rho_b = rho0bot(k) + rho_m = rho0(k) + rho_t = rho0top(k) + + do mt = 1, ncnst + tr_b(mt) = tr0bot(k,mt) + enddo + + if( k .gt. 1 ) then + ! ------------------------------------- ! + ! Below is applied for mixing downdraft ! + ! ------------------------------------- ! + mu = mu_mix + tmp1 = ( 1._r8 - mu ) * thvl0top(km) + mu * thvl_b + tmp2 = ( 1._r8 - mu ) * thv0top(km) + mu * thv_b + thvl_minE = min( min( thvl_b, thvl_t ), tmp1 ) + thv_minE = min( min( thv_b, thv_t ), tmp2 ) + ! Apr.15.2014. Modified formula for thv_minE to obtain a reasonable solution when the mean inversion exists. + thv_minE = max( thv0top(km), tmp2 ) + ! Apr.15.2014. Modified formula for thv_minE + thvl_minE = thvl_minE + offset_minE + thv_minE = thv_minE + offset_minE + ! ----------------- ! + ! Diagnostic Output ! + ! ----------------- ! + thv_b_out(i,km) = thv_b + thv_t_out(i,km) = thv_t + thv_mt_out(i,km) = tmp2 + thv_min_out(i,km) = thv_minE + ! ----------------- ! + ! Diagnostic Output ! + ! ----------------- ! + else + thvl_minE = -1.e8_r8 ! Always detrain downdraft in the lowest model layer after all diabatic forcings + thv_minE = -1.e8_r8 ! Always detrain downdraft in the lowest model layer after all diabatic forcings + endif + + ! -------------------------------------------------------- ! + ! ! + ! Closure Conditions at the first interface k = 0 or k = 1 ! + ! Use 'rho_b,thl_b,...' not 'rho_m,thl_m'. ! + ! ! + ! -------------------------------------------------------- ! + + if( k .eq. kiss + 1 ) then ! Here, 'k' is a layer-index. + + d_alpha = ( alpha_max - alpha_cri ) / nseg + sigma_w = sigma_wo + min( kw, 1.4142_r8 ) * sqrt( tke1 ) + sigma_w = max( 1.e-1_r8, min( 1.0_r8, sigma_w ) ) + sigma_thl = sigfac * shflx / ( rho_b * cp * exn_b * sigma_w ) + sigma_qt = sigfac * qflx / ( rho_b * sigma_w ) + sigma_u = sigfac * taux / ( rho_b * sigma_w ) + sigma_v = sigfac * tauy / ( rho_b * sigma_w ) + do mt = 1, ncnst + sigma_tr(mt) = sigfac * aflx(mt) / ( rho_b * sigma_w ) + enddo +#ifdef MODAL_AERO + sigma_tr(lptr_dust_a_amode(modeptr_coarse)) = 0._r8 + sigma_tr(lptr_dust_a_amode(modeptr_accum)) = 0._r8 + sigma_tr(lptr_nacl_a_amode(modeptr_coarse)) = 0._r8 + sigma_tr(lptr_nacl_a_amode(modeptr_accum)) = 0._r8 + sigma_tr(lptr_nacl_a_amode(modeptr_aitken)) = 0._r8 +#endif + + sigma_w = sigma_wo + min( kw, 1.4142_r8 ) * sqrt( tke1 ) + tmp1 = alpha_max + sigma_w = max( 1.e-1_r8, min( 1.0_r8, sigma_w ) ) + + !lim Oct.3. I commented out below limiter block. But instead, impose non-negative limiters later + !lim further below. + + !lim sigma_thl = max( - thl_b / tmp1, min( thl_b / tmp1 , sigma_thl ) ) + sigma_thl = max( - 2.0_r8, min( 2.0_r8, sigma_thl ) ) + !lim sigma_qt = max( - qt_b / tmp1, min( qt_b / tmp1 , sigma_qt ) ) + !lim ! sigma_qt = max( - 5.e-4_r8, min( 1.e-3_r8, sigma_qt ) ) + sigma_qt = max( - 0.2_r8*qt_b, min( 0.2_r8*qt_b, sigma_qt ) ) + sigma_u = max( - 2.0_r8, min( 2.0_r8 , sigma_u ) ) + sigma_v = max( - 2.0_r8, min( 2.0_r8 , sigma_v ) ) + !lim do mt = 1, ncnst + !lim sigma_tr(mt) = max( - tr_b(mt) / tmp1, min( tr_b(mt) / tmp1 , sigma_tr(mt) ) ) + !lim enddo + + cmfu_base = au_base * rho_b * ( sigma_w * sqrt( 2._r8 / 3.141592_r8 ) ) + rnorm_a = 0._r8 + rnorm_m = 0._r8 + do m = 1, nseg + alpha(m) = alpha_cri + d_alpha * ( m - 0.5_r8 ) + if( nseg .eq. 1 ) alpha(m) = 1._r8 + Pau(m) = exp(-0.5_r8*alpha(m)**2._r8)/sqrt(2._r8*3.141592_r8) + Pau(m) = 2._r8 * au_base * Pau(m) + Pmu(m) = Pau(m) * rho_b * ( sigma_w * alpha(m) ) + + rnorm_a = rnorm_a + Pau(m) * d_alpha + rnorm_m = rnorm_m + Pmu(m) * d_alpha + enddo + + tmp1 = 0._r8 + sum = 0._r8 + do m = 1, nseg + alpha(m) = alpha_cri + d_alpha * ( m - 0.5_r8 ) + if( nseg .eq. 1 ) alpha(m) = 1._r8 + Pau(m) = exp(-0.5_r8*alpha(m)**2._r8)/sqrt(2._r8*3.141592_r8) + Pau(m) = 2._r8 * au_base * Pau(m) + if( inorm .eq. 1 ) then + Pau(m) = Pau(m) * ( au_base / rnorm_a ) + elseif( inorm .eq. 2 ) then + Pau(m) = Pau(m) * ( cmfu_base / rnorm_m ) + endif + Pmu(m) = Pau(m) * rho_b * ( sigma_w * alpha(m) + delta_w_PBL * cdelta_w ) + Pnu(m) = Pau(m) / ( 3.141592_r8 * ( Ro + sigmaR * alpha(m) )**2._r8 ) + a_au(m) = Pau(m) * d_alpha ! Updraft fractional area [ no unit ] + cmf_au(m) = Pmu(m) * d_alpha ! Updraft mass flux [ kg / s / m^2 ] + num_au(m) = Pnu(m) * d_alpha ! Number of updraft plumes [ # / m^2 ] + rad_au(m) = Ro + sigmaR * alpha(m) ! Physical radius of updraft plume [ m ] + sum = sum + cmf_au(m) + tmp1 = tmp1 + a_au(m) + enddo + + do m = 1, nseg + + thl_au(m) = thl_b + sigma_thl * alpha(m) + delta_thl_PBL * cdelta_s + qt_au(m) = qt_b + sigma_qt * alpha(m) + delta_qt_PBL * cdelta_s + !lim + qt_au(m) = max( qt_au(m), qmin(1) ) + !lim + u_au(m) = u_b + sigma_u * alpha(m) + delta_u_PBL * cdelta_s + v_au(m) = v_b + sigma_v * alpha(m) + delta_v_PBL * cdelta_s + w_au(m) = sigma_w * alpha(m) + delta_w_PBL * cdelta_w + call conden( p_b, thl_au(m), qt_au(m), th, qv, ql, qi, qse, id_check ) + ql_au(m) = ql + qi_au(m) = qi + thv_au(m) = th * ( 1._r8 + zvir * qv - ql - qi ) + do mt = 1, ncnst + tr_au(m,mt) = tr_b(mt) + sigma_tr(mt) * alpha(m) + delta_tr_PBL(mt) * cdelta_s + !lim + tr_au(m,mt) = max( tr_au(m,mt), qmin(mt) ) + !lim + enddo + + ! Initialize 'S_b_ql_au(m) = S_b_qi_au(m) = 0' at surface. + + S_b_ql_au(m) = 0._r8 + S_b_qi_au(m) = 0._r8 + + ! -------------------------------------------------------------------------------------------------------------- ! + ! Nov.28.2012. Imposing Consistency between 'droplet mass' and 'droplet number' ! + ! For the fully consistent treatment of microphysics process, it is important to ! + ! impose a full consistency between 'ql_au(m),tr_au(m,ixnumliq)' and 'qi_au(m),tr_au(m,ixnumice)' ! + ! here from the surface. Similar consistency will be imposed at all the interfaces above too as ! + ! well as for convective downdraft. ! + ! Consistency should be imposed based on the 'ql_au(m),qi_au(m)' not on 'tr_au(m,ixnumliq),tr_au(m,ixnumice)' ! + ! since computation of 'droplet mass' is more reliable than 'droplet number' in the current situation. ! + ! If air is already saturated at surface with non-zero condensate, compute tr_au(m,ixnumliq) and ! + ! tr_au(m,ixnumice) with a externally specified droplet radius. This can be done later using aerosol information ! + ! or using stratiform cloud information at surface. However, this case will happen in a very rare way. ! + ! -------------------------------------------------------------------------------------------------------------- ! + + if( ql_au(m) .eq. 0._r8 ) then + tr_au(m,ixnumliq) = 0._r8 + else + tr_au(m,ixnumliq) = ql_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + endif + + if( qi_au(m) .eq. 0._r8 ) then + tr_au(m,ixnumice) = 0._r8 + else + tr_au(m,ixnumice) = qi_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + endif + + ! ----------------------------------------------------- ! + ! Compute the original updraft segment index at surface ! + ! ----------------------------------------------------- ! + + msfc_from_m(k,m) = m + + thl_u(kiss) = thl_u(kiss) + thl_au(m) * cmf_au(m) + qt_u(kiss) = qt_u(kiss) + qt_au(m) * cmf_au(m) + u_u(kiss) = u_u(kiss) + u_au(m) * cmf_au(m) + v_u(kiss) = v_u(kiss) + v_au(m) * cmf_au(m) + w_u(kiss) = w_u(kiss) + w_au(m) * cmf_au(m) + wa_u(kiss) = wa_u(kiss) + w_au(m) * a_au(m) + ql_u(kiss) = ql_u(kiss) + ql_au(m) * cmf_au(m) + qi_u(kiss) = qi_u(kiss) + qi_au(m) * cmf_au(m) + do mt = 1, ncnst + tr_u(kiss,mt) = tr_u(kiss,mt) + tr_au(m,mt) * cmf_au(m) + enddo + qla_u(kiss) = qla_u(kiss) + ql_au(m) * a_au(m) + qia_u(kiss) = qia_u(kiss) + qi_au(m) * a_au(m) + rad_u(kiss) = rad_u(kiss) + rad_au(m)**2._r8 * num_au(m) ! Effective plume radius [ m ] + cmf_u(kiss) = cmf_u(kiss) + cmf_au(m) + a_u(kiss) = a_u(kiss) + a_au(m) + num_u(kiss) = num_u(kiss) + num_au(m) + thva_u(kiss) =thva_u(kiss) + thv_au(m) * a_au(m) + + ! ------------------------------------------------------------------------------------- ! + ! Compute discretized surface flux being considered in the current convection scheme. ! + ! Below discrete computation is fully appropriate and should be used since the input ! + ! surface flux can be unreasonably large for some cases. ! + ! Sep.12.2011. I double checked that my below 'ipartition' formula is perfect because ! + ! (1) it conserves column-integrated energy, and (2) it completely remove ! + ! the generation of unreasonable convective tendency in the lowest model ! + ! layer by convection, so that it grauantees computation of reasonable ! + ! surface heat, moisture, momentum, and tracer fluxes at surface in the ! + ! following surface flux computation routine in the CAM. Also, I don't ! + ! need to modify any parts of CAM5 ( e.g., PBL scheme, surface flux ! + ! routine ), since all the required modifications are contained in the ! + ! UNICON in a fully reasonable way. ! + ! By using 'ipartition = 1' option, I don't need to combine 'symmetric ! + ! moist turbulence scheme' with the 'asymmetric moist turbulence scheme' ! + ! within the implicit iteration loop, so that I can save tremendous amount ! + ! of computation time. ! + ! Mar.19.2014. I added 'qlflx_u(0),qiflx_u(0)' in the below lines for fully consistent ! + ! treatment in association with 'ipartition=1' and with the same tratment ! + ! for convective downdraft flux later. ! + ! ------------------------------------------------------------------------------------- ! + + slflx_u(0) = slflx_u(0) + cp * exns0(0) * cmf_au(m) * ( thl_au(m) - thl_b ) + qtflx_u(0) = qtflx_u(0) + cmf_au(m) * ( qt_au(m) - qt_b ) + uflx_u(0) = uflx_u(0) + cmf_au(m) * ( u_au(m) - u_b ) + vflx_u(0) = vflx_u(0) + cmf_au(m) * ( v_au(m) - v_b ) + qlflx_u(0) = qlflx_u(0) + cmf_au(m) * ( ql_au(m) - ql_b ) + qiflx_u(0) = qiflx_u(0) + cmf_au(m) * ( qi_au(m) - qi_b ) + do mt = 1, ncnst + trflx_u(0,mt) = trflx_u(0,mt) + cmf_au(m) * ( tr_au(m,mt) - tr_b(mt) ) + enddo + + enddo ! do m = 1, nseg + + + ! Mean convective updraft values at the launching interface + ! By construction, 'cmf_u(kiss),a_u(kiss),num_u(kiss)' are non-zero. + + thl_u(kiss) = thl_u(kiss) / cmf_u(kiss) + qt_u(kiss) = qt_u(kiss) / cmf_u(kiss) + u_u(kiss) = u_u(kiss) / cmf_u(kiss) + v_u(kiss) = v_u(kiss) / cmf_u(kiss) + w_u(kiss) = w_u(kiss) / cmf_u(kiss) + wa_u(kiss) = wa_u(kiss) / a_u(kiss) + ql_u(kiss) = ql_u(kiss) / cmf_u(kiss) + qi_u(kiss) = qi_u(kiss) / cmf_u(kiss) + do mt = 1, ncnst + tr_u(kiss,mt) = tr_u(kiss,mt) / cmf_u(kiss) + enddo + qla_u(kiss) = qla_u(kiss) / a_u(kiss) + qia_u(kiss) = qia_u(kiss) / a_u(kiss) + rad_u(kiss) = sqrt( rad_u(kiss) / num_u(kiss) ) ! Effective plume radius [ m ] + N_up(kiss) = nseg ! Total number of updraft plumes at the launching interface + thva_u(kiss) =thva_u(kiss) / a_u(kiss) ! Mean potential temperature within convective updraft. + + ! ---------------------------------------------------------- ! + ! Diagnostic Output for Checking Final Source Air Properties ! + ! ---------------------------------------------------------- ! + + + kw_out(i) = kw + + sigma_w_out(i) = sigma_w + sigma_thl_out(i) = sigma_thl + sigma_qt_out(i) = sigma_qt * 1.e3_r8 + sigma_u_out(i) = sigma_u + sigma_v_out(i) = sigma_v + + tkes_out(i) = tke1 + w_org_out(i) = delta_w_PBL * cdelta_w + thl_org_out(i) = delta_thl_PBL * cdelta_s + qt_org_out(i) = delta_qt_PBL * cdelta_s + u_org_out(i) = delta_u_PBL * cdelta_s + v_org_out(i) = delta_v_PBL * cdelta_s + + ! ---------------------------------------------------------- ! + ! Diagnostic Output for Checking Final Source Air Properties ! + ! ---------------------------------------------------------- ! + + else ! 'if( k .eq. 1 )' + + N_up(km) = nseg_nondet + + endif ! 'if( k .eq. 1 )' + + ! ---------------------------------------------------------------------------------------------------------- ! + ! Mar.07.2013. ! + ! Compute grid-mean (which includes both environment and convective updraft) virtual potential temperature ! + ! at the base interface for use in computing vertical evolution of vertical velocity of convective ! + ! updraft and downdraft for developing a full scale-adaptive parameterization. ! + ! Note that 'thv_mean_t' will be computed later in a separate way depending on 'thv_au(m)' for each updraft. ! + ! ---------------------------------------------------------------------------------------------------------- ! + + thv_mean_b = a_u(km) * thva_u(km) + ( 1._r8 - a_u(km) ) * thv_b + + ! --------------------------------------------------------------------------- ! + ! Environmental airs involved in buoyancy sorting via mesoscale organization. ! + ! This can be mixtures of ensemble-mean environmental air and detrained airs. ! + ! This is used only for the mixing purpose not for diabatic buoyancy forcing. ! + ! Assuming each updraft equally reaches to dp0(k), solve discrete ( not ! + ! continuous ) mass flux equation to compute total amount of updraft mass that! + ! is involved in the buoyancy sorting. ! + ! The available mass per unit time per unit area [ kg/s/m^2 ] ! + ! Environmental airs : ae(k)*dp_m/g/dt ! + ! Detrained airs : cmf_r_org(k) ! + ! The updraft mass involved in the buoyancy sorting : sum ! + ! --------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------------------- ! + ! Compute (1) fractional mixing rate, eps0 and (2) organization factor for lateral entrainment. ! + ! . sum : The estimate of updraft mass flux that will be involved in ! + ! buoyancy sorting at the current time step. [ kg/m^2/s ] ! + ! . cu_cmfr : Total amount of detrained mass at the previous time [ kg/m^2/s ] ! + ! --------------------------------------------------------------------------------------------- ! + + sum = 0._r8 + do m = 1, N_up(km) + ! -------------------------------------------------------------------- ! + ! Fractional Mixing Rates eps0 [ 1/Pa ] : This is the key of the model ! + ! -------------------------------------------------------------------- ! + + tmp1 = sqrt( ( ( ql_au(m) + qi_au(m) ) / 1.e-3_r8 ) * ( 1._r8 - max( 0.0_r8, min( 1.00_r8, rh0bot(k) ) ) ) ) + tmp2 = 1._r8 + cevpeps0 * tmp1 + eps0(m) = tmp2 * c0 / max( rad_au(m), Ro_eps0 ) / ( rho_b * g ) + eps0(m) = min( eps0(m), log( 1._r8 + epsz0_max * dz_m ) / dp_m ) + sum = sum + dp_m * eps0(m) * cmf_au(m) + enddo + + ! ----------------------------------------------------------------------------------------- ! + ! Aug.01.2011. Brian Juwon Park's 10th Birthday. ! + ! 'cuorg' is replaced by 'cuorg_mxen' in the below line computing 'org_ent' for ! + ! treating mixing with several mixing environmental airs. ! + ! cuorg_mxen = 0 ( iter = 1 ) or 1 ( iter = 2 ). ! + ! ----------------------------------------------------------------------------------------- ! + + org_ent = min( fac_org_ent * cuorg_mxen , cu_cmfr(k) / max( sum, nonzero ) ) ! The second argument sets the upper limit of org. + org_ent = max( 0._r8, min( 1._r8, org_ent ) ) + + ! ----------------------------------------------- ! + ! Define environmental properties using 'org_ent' ! + ! ----------------------------------------------- ! + + tmp1 = org_ent + + if( k .lt. kpblh ) then + + thle_b(k) = max( 0._r8, thl_b + cdelta_s * delta_thl_PBL ) + + qte_b(k) = max( qmin(1), qt_b + cdelta_s * delta_qt_PBL ) + + ue_b(k) = ( u_b + cdelta_s * delta_u_PBL ) + + ve_b(k) = ( v_b + cdelta_s * delta_v_PBL ) + + we_b(k) = ( cdelta_w * delta_w_PBL ) + + qle_b(k) = max( 0._r8, ql_b + 0._r8 ) + + qie_b(k) = max( 0._r8, qi_b + 0._r8 ) + + do mt = 1, ncnst + tre_b(k,mt) = max( qmin(mt), tr_b(mt) + cdelta_s * delta_tr_PBL(mt) ) + enddo + + ssthle(k) = ssthl0(k) + ssqte(k) = ssqt0(k) + ssue(k) = ssu0(k) + ssve(k) = ssv0(k) + ssqle(k) = ssql0(k) + ssqie(k) = ssqi0(k) + do mt = 1, ncnst + sstre(k,mt) = sstr0(k,mt) + enddo + + + elseif( k .ge. kpblh ) then + + thle_b(k) = max( 0._r8, thl_b + tmp1 * cu_thlr(k) ) + + qte_b(k) = max( qmin(1), qt_b + tmp1 * cu_qtr(k) ) + + ue_b(k) = ( u_b + tmp1 * cu_ur(k) ) + + ve_b(k) = ( v_b + tmp1 * cu_vr(k) ) + + we_b(k) = 0._r8 + + qle_b(k) = max( 0._r8, ql_b + tmp1 * cu_qlr(k) ) + + qie_b(k) = max( 0._r8, qi_b + tmp1 * cu_qir(k) ) + + do mt = 1, ncnst + tre_b(k,mt) = max( qmin(mt), tr_b(mt) + tmp1 * cu_trr(k,mt) ) + enddo + + ssthle(k) = ssthl0(k) * ( 1._r8 - tmp1 ) + ssqte(k) = ssqt0(k) * ( 1._r8 - tmp1 ) + ssue(k) = ssu0(k) * ( 1._r8 - tmp1 ) + ssve(k) = ssv0(k) * ( 1._r8 - tmp1 ) + ssqle(k) = ssql0(k) * ( 1._r8 - tmp1 ) + ssqie(k) = ssqi0(k) * ( 1._r8 - tmp1 ) + do mt = 1, ncnst + sstre(k,mt) = sstr0(k,mt) * ( 1._r8 - tmp1 ) + enddo + + endif ! End of 'if( k .lt. kpblh )' and 'elseif( k .ge. kpblh)' blocks to define the properties of mixing environmental airs. + + ! ------------------------------------ ! + ! ! + ! Individual Updraft Plume Computation ! + ! ! + ! ------------------------------------ ! + + ! ---------------------------------------- ! + ! Initialization of updraft segment arrays ! + ! ---------------------------------------- ! + + ytop(:nseg) = 0._r8 ! 0 : Not reach the top interface, 1 : Reach the top interface + xc(:nseg) = 0._r8 + xs(:nseg) = 0._r8 + eeps(:nseg) = 0._r8 + ddel(:nseg) = 0._r8 + eps(:nseg) = 0._r8 + del(:nseg) = 0._r8 + xe_min(:nseg) = 0._r8 + xe_max(:nseg) = 0._r8 + dpa(:nseg) = 0._r8 + dza(:nseg) = 0._r8 + ptop(:nseg) = 0._r8 + ztop(:nseg) = 0._r8 + fmix(:nseg) = 0._r8 + f_wu(:nseg) = 0._r8 + + thl_aut(:nseg) = 0._r8 + qt_aut(:nseg) = 0._r8 + u_aut(:nseg) = 0._r8 + v_aut(:nseg) = 0._r8 + ql_aut(:nseg) = 0._r8 + qi_aut(:nseg) = 0._r8 + cmf_aut(:nseg) = 0._r8 + w_aut(:nseg) = 0._r8 + a_aut(:nseg) = 0._r8 + num_aut(:nseg) = 0._r8 + rad_aut(:nseg) = 0._r8 + tr_aut(:nseg,:ncnst) = 0._r8 + thv_aut(:nseg) = 0._r8 + S_t_ql_au(:nseg) = 0._r8 + S_t_qi_au(:nseg) = 0._r8 + + evp_thll_au(:nseg) = 0._r8 + evp_qtl_au(:nseg) = 0._r8 + evp_thli_au(:nseg) = 0._r8 + evp_qti_au(:nseg) = 0._r8 + prep_thll_au(:nseg) = 0._r8 + prep_qtl_au(:nseg) = 0._r8 + prep_thli_au(:nseg) = 0._r8 + prep_qti_au(:nseg) = 0._r8 + eff_ql_au(:nseg) = 0._r8 + eff_qi_au(:nseg) = 0._r8 + PGF_u_au(:nseg) = 0._r8 + PGF_v_au(:nseg) = 0._r8 + evp_tr_au(:nseg,:ncnst) = 0._r8 + prep_tr_au(:nseg,:ncnst) = 0._r8 + eff_tr_au(:nseg,:ncnst) = 0._r8 + + do m = 1, N_up(km) + + ! -------------------------------------------------- ! + ! Compute R-dependent buoyancy coefficient, rbuoy_up ! + ! -------------------------------------------------- ! + + rbuoy_up = rbuoy_min * ( 1._r8 + ( rbuoy_max / rbuoy_min - 1._r8 ) * exp( - rad_au(m) / R_buo ) ) + + ! --------------------------------------------------------------------------- ! + ! Updraft Buoyancy Sorting ! + ! --------------------------------------------------------------------------- ! + + pe = p_b + w_cu = w_au(m) + thl_cu = thl_au(m) + qt_cu = qt_au(m) + thl_eg = thle_b(k) + qt_eg = qte_b(k) + u_eg = ue_b(k) ! Not used here, but for consistent treatment of buoyancy sorting + v_eg = ve_b(k) ! with the detrained airs : 'thl_dd, etc.' later + w_eg = we_b(k) + do mt = 1, ncnst + tr_eg(mt) = tre_b(k,mt) ! Not used here in this buoyancy sorting but for defining tr_eg(mt). + enddo + thv_env = thv_b + cridis = rlc * cushavg ! [ m ]. New for positive feedback. + if( rlc .eq. -1._r8 ) cridis = dz_m + call conden( pe, thl_cu, qt_cu, th, qv, ql, qi, qse, id_check ) + ql_cu = ql + qi_cu = qi + thv = th * ( 1._r8 + zvir * qv - ql - qi ) + + ! --------------------------------------------------------------------------- ! + ! Mar.11.2013. Add 'w_eg' within PBL for treating the effect of organized flow! + ! on the buoyancy sorting. ! + ! Note that 'w_eg' is added only for 'buosorts_UW' subroutine, ! + ! so that the other buoyancy sorting subroutines should be ! + ! modified in future if I want to use them. ! + ! --------------------------------------------------------------------------- ! + + call buosorts_UW( rbuoy_up, pe, w_cu, thl_cu, qt_cu, w_eg, thl_eg, qt_eg, & + thv_env, cridis, xc(m), xs(m), thv_cu, thv_eg, thv_xs ) + + ! -------------------------------------------------------- ! + ! We can impose a lower and upper limit on xc(m) as below. ! + ! -------------------------------------------------------- ! + xc(m) = max( xc_min, min( xc_max, xc(m) ) ) + ! -------------------------------------------------------- ! + ! Compute non-dimensional entrainment and detrainment rate ! + ! -------------------------------------------------------- ! + call compute_epsdelnod( 'PDFbsQ', xc(m), eeps(m), ddel(m) ) + ! -------------------------------------------------------------------- ! + ! ! + ! Fractional Mixing Rates eps0 [ 1/Pa] : This is the key of the model ! + ! Aug.15.2011. In contrast to the computation in the above block for ! + ! limiting org_ent, precise value of eps0(m) should be ! + ! computed here. ! + ! ! + ! -------------------------------------------------------------------- ! + + call conden( pe, thl_eg, qt_eg, th, qv, ql, qi, qse, id_check ) + rh_eg = max( 0._r8, min( 1._r8, qv / max( nonzero, qse ) ) ) + tmp1 = sqrt( ( ( ql_au(m) + qi_au(m) ) / 1.e-3_r8 ) * ( 1._r8 - max( 0.0_r8, min( 1.00_r8, rh_eg ) ) ) ) + tmp2 = 1._r8 + cevpeps0 * tmp1 + eps0(m) = tmp2 * c0 / max( rad_au(m), Ro_eps0 ) / ( rho_b * g ) + + ! -------------------------------------------------------------------- ! + ! ! + ! Fractional Mixing Rates eps0 [ 1/Pa ] : This is the key of the model ! + ! ! + ! -------------------------------------------------------------------- ! + + eps0(m) = max( 0._r8, eps0(m) ) + + ! ----------------------------------------------------------------------------------------------------------------------- ! + ! CRITICALLY IMPORTANT : IMPOSING A REASONABLE LIMIT FOR eps0(m) ! + ! ----------------------------------------------------------------------------------------------------------------------- ! + + ! Feb.06.2013. Always choose physically reasonable exp_cmf = 1 as of this day. + + eps0(m) = min( eps0(m), log( 1._r8 + epsz0_max * dz_m ) / dp_m ) + eps(m) = eps0(m) * eeps(m) + del(m) = eps0(m) * ddel(m) + + ! ----------------------------------------------------------------------------- ! + ! Compute which mixtures can be the source of downdraft ( xe_min < x < xe_max ) ! + ! ----------------------------------------------------------------------------- ! + + thl_cumC = thl_cu + xc(m) * ( thl_eg - thl_cu ) + qt_cumC = qt_cu + xc(m) * ( qt_eg - qt_cu ) + call conden( pe, thl_cumC, qt_cumC, th, qv, ql, qi, qse, id_check ) + thv_cumC = th * ( 1._r8 + zvir * qv - ql - qi ) + + thl_cumS = thl_cu + xs(m) * ( thl_eg - thl_cu ) + qt_cumS = qt_cu + xs(m) * ( qt_eg - qt_cu ) + call conden( pe, thl_cumS, qt_cumS, th, qv, ql, qi, qse, id_check ) + thv_cumS = th * ( 1._r8 + zvir * qv - ql - qi ) + + call conden( pe, thl_eg, qt_eg, th, qv, ql, qi, qse, id_check ) + thv_cumE = th * ( 1._r8 + zvir * qv - ql - qi ) + + if( xc(m) .ge. xs(m) ) then + call buosort_downdraft( thv_cumC, thv_cumE, thv_minE, xdown_min, xdown_max ) + xe_min(m) = xc(m) + ( 1._r8 - xc(m) ) * xdown_min + xe_max(m) = xc(m) + ( 1._r8 - xc(m) ) * xdown_max + else + call buosort_downdraft( thv_cumC, thv_cumS, thv_minE, xdown_min, tmp1 ) + xe_min(m) = xc(m) + ( xs(m) - xc(m) ) * xdown_min + call buosort_downdraft( thv_cumS, thv_cumE, thv_minE, tmp2, xdown_max ) + xe_max(m) = xs(m) + ( 1._r8 - xs(m) ) * xdown_max + endif + + ! ---------------------------------------------------------------------------------- ! + ! Updraft Top Height & Vertical Velocity at the Top Interface ! + ! ---------------------------------------------------------------------------------- ! + + thvbot = thv_au(m) + bogbot = rbuoy_up * ( thvbot / thv_mean_b - 1._r8 ) + + ! ------------------------------------------------------------------------- ! + ! In this case, entrainment mixing occurs. So, simply use the previous code ! + ! by assuming a simple linear profile of buoyancy from the base to the top ! + ! interface. ! + ! Apr.17.2012. In order to remove ambiguity, I am using thl_meu, qt_meu ! + ! in the below block. ! + ! ------------------------------------------------------------------------- ! + thl_meu = thle_b(k) + ssthle(k) * 0.5_r8 * ( p_t - p_b ) + qt_meu = qte_b(k) + ssqte(k) * 0.5_r8 * ( p_t - p_b ) + ql_meu = qle_b(k) + ssqle(k) * 0.5_r8 * ( p_t - p_b ) + qi_meu = qie_b(k) + ssqie(k) * 0.5_r8 * ( p_t - p_b ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, p_t, thl_meu, ssthle(k), thl_au(m), thl_aut_tmp ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, p_t, qt_meu, ssqte(k), qt_au(m), qt_aut_tmp ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, p_t, ql_meu, ssqle(k), ql_au(m), ql_aut_adi ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, p_t, qi_meu, ssqie(k), qi_au(m), qi_aut_adi ) + call conden( p_t, thl_aut_tmp, qt_aut_tmp, th, qv, ql, qi, qse, id_check ) + do mt = 1, ncnst + tr_meu(mt) = tre_b(k,mt) + sstre(k,mt) * 0.5_r8 * ( p_t - p_b ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, p_t, tr_meu(mt), sstre(k,mt), tr_au(m,mt), tr_aut_tmp(mt) ) + enddo + + ! ------------------------------------------------------------------------------------ ! + ! Feb.07.2013. ! + ! Compute precipitation production at the top interface. ! + ! ------------------------------------------------------------------------------------ ! + + ! ------------------------------------------------------------------------- ! + ! Compute 'exql,exqi' by solving analytical vertical integration of 'ql,qi' ! + ! by including differential precipitation fall-out in the integration. ! + ! In the below simplified microphysics, 'eps_dia_L = eps_dia_I'. However, ! + ! in the future refined microphysics, they can differ. Thus, I am keeping ! + ! both 'eps_dia_L' and 'eps_dia_I'. ! + ! ------------------------------------------------------------------------- ! + + if( iprd_prep .eq. 5 ) then ! Backward Analytical Method + + if( ( ql_cu + qi_cu ) .gt. criqc ) then + eps_dia_L = c0_ac * ( ( ql_cu + qi_cu ) - criqc ) / ( ql_cu + qi_cu ) + eps_dia_I = c0_ac * ( ( ql_cu + qi_cu ) - criqc ) / ( ql_cu + qi_cu ) + else + eps_dia_L = 0._r8 + eps_dia_I = 0._r8 + endif + call progup_thlqt( eps(m), eps_dia_L, 0._r8, p_b, p_t, ql_meu, ssqle(k), ql_au(m), ql_aut_adi_prp ) + call progup_thlqt( eps(m), eps_dia_I, 0._r8, p_b, p_t, qi_meu, ssqie(k), qi_au(m), qi_aut_adi_prp ) + exql = min( max( ql_aut_adi - ql_aut_adi_prp, 0._r8 ), 0.99_r8 * ql ) ! This should be guaranteed to be positive at this stage. + exqi = min( max( qi_aut_adi - qi_aut_adi_prp, 0._r8 ), 0.99_r8 * qi ) ! This should be guaranteed to be positive at this stage. + if( mclimit .eq. 1 ) then + tmp1 = exql + exqi + tmp2 = min( tmp1, max( ql + qi - criqc, 0._r8 ) ) ! To impose a continuous variation across ql + qi = criqc. + exql = exql * ( tmp2 / max( tmp1, nonzero ) ) + exqi = exqi * ( tmp2 / max( tmp1, nonzero ) ) + endif + ! -------------------------------------------------- ! + ! Evaporation within Updraft. ! + ! Set it to be zero, but can be refined in future. ! + ! -------------------------------------------------- ! + evpR = 0._r8 + evpS = 0._r8 + + else ! The others of Backward Analytical Method + + ! ------------------------------------------------------------------------- ! + ! Below is previous block replaced by the above full ! + ! analytical treatment of precipitation fall-out within convective updraft. ! + ! ------------------------------------------------------------------------- ! + + msfc = msfc_from_m(k,m) + call prod_prep_up( z_b, z_t, p_b, p_t, exn_t, exn0(k), & + w_au(m), w_au(m), & + thl_aut_tmp, qt_aut_tmp, ql, qi, tr_aut_tmp(1:ncnst), & + S_b_ql_au(m), S_b_qi_au(m), iprd_prep, & + ql_cu, qi_cu, eps(m), & + thl_meu, ssthle(k), thl_au(m), qt_meu, ssqte(k), qt_au(m), & + ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, i, k, lchnk, & + flxrain_msfc(k,msfc), flxsnow_msfc(k,msfc), & + a_p_msfc(k,msfc), am_u_msfc(k,msfc), am_pu_msfc(k,msfc), & + caer, criqc, c0_ac, & + exql, exqi, extr(1:ncnst), S_t_ql_au(m), S_t_qi_au(m), & + evpR, evpS, evpRStr(1:ncnst) ) + + endif ! End of Backward Analytical Method + + ! ----------------------------------------------------------------------------------- ! + ! Jun.16.2012. I should recompute the buoyancy using updated state variables as below ! + ! similar to CAM5 shallow convection scheme. It turns out that ! + ! this update is important and has non-negligible impact on the ! + ! simulation. Comment-out above two lines. ! + ! For simplicity, use exner function defined at the top interface since ! + ! p_t is defined at the top model interface. ! + ! The correct cumulus top is computed later below. ! + ! It turns out that computation of 'thvtop' has huge influences on the ! + ! CLDLOW and SWCF in the trade cumulus regime. ! + ! ----------------------------------------------------------------------------------- ! + call conden( p_t, thl_aut_tmp + ( xlv / cp / exn_t ) * ( exql - evpR ) + ( xls / cp / exn_t ) * ( exqi - evpS ), & + qt_aut_tmp - exql - exqi + evpR + evpS, & + th, qv, ql, qi, qse, id_check ) + thvtop = th * ( 1._r8 + zvir * qv - ql - qi ) + thv_mean_t = a_u(km) * thvtop + ( 1._r8 - a_u(km) ) * thv_t + bogtop = rbuoy_up * ( thvtop / thv_mean_t - 1._r8 ) + + ! --------------------------------------------------------------------------------------------- ! + ! Below block is generally formulated to treat the special case of 'bogbot < 0 and bogtop > 0'. ! + ! So, even when 'OPTION.3' is selected above, below block itself can treat all the cases in a ! + ! most reasonable way. So, the CIN structure ( other than resolving LCL explicitly ) can be ! + ! resolved in a most reasonable way. ! + ! Mar.11.2013. Add 'we_b(k)**2._r8' as the argument of 'progup_wu2' and 'compute_dp'. ! + ! --------------------------------------------------------------------------------------------- ! + + if( bogbot .lt. 0._r8 .and. bogtop .gt. 0._r8 ) then + plfc = p_b - ( p_b - p_t ) * ( bogbot / ( bogbot - bogtop ) ) + call progup_wu2( rdrag*eps(m) - rjet*del(m), rho_m, p_b, plfc, bogbot, 0._r8, w_au(m)**2._r8, & + we_b(k)**2._r8, wu2 ) + if( wu2 .ge. 0._r8 ) then + dpa(m) = p_b - p_t + call progup_wu2( rdrag*eps(m) - rjet*del(m), rho_m, p_b, p_t, bogbot, bogtop, w_au(m)**2._r8, & + we_b(k)**2._r8, wu2 ) + w_aut(m) = max( sqrt( max( wu2, nonzero ) ), wumin ) + else + dpa(m) = compute_dp( rdrag*eps(m) - rjet*del(m), rho_m, p_b, plfc, bogbot, 0._r8, w_au(m)**2._r8, & + we_b(k)**2._r8 ) ! '0 <= dpa(m) <= p_b-plfc' + w_aut(m) = 0._r8 + endif + else + call progup_wu2( rdrag*eps(m) - rjet*del(m), rho_m, p_b, p_t, bogbot, bogtop, w_au(m)**2._r8, & + we_b(k)**2._r8, wu2 ) + if( wu2 .ge. 0._r8 ) then + dpa(m) = p_b - p_t + w_aut(m) = max( sqrt( max( wu2, nonzero ) ), wumin ) + else + if( .not. ( ( bogbot .ge. 0._r8 .and. bogtop .lt. 0._r8 ) .or. & + ( bogbot .lt. 0._r8 .and. bogtop .le. 0._r8 ) ) ) then + write(iulog,*) 'bogbot, bogtop = ', bogbot, bogtop + write(iulog,*) 'awk_PBL_raw, delta_thl_PBL_raw, delta_qt_PBL_raw, delta_u_PBL_raw, delta_v_PBL_raw = ', & + awk_PBL_raw, delta_thl_PBL_raw, delta_qt_PBL_raw, delta_u_PBL_raw, delta_v_PBL_raw + write(iulog,*) 'awk_PBL, delta_thl_PBL, delta_qt_PBL, delta_u_PBL, delta_v_PBL, delta_w_PBL = ', & + awk_PBL, delta_thl_PBL, delta_qt_PBL, delta_u_PBL, delta_v_PBL, delta_w_PBL + call endrun('UNICON : Impossible buoyancy case before compute_dp') + endif + if( bogbot .ge. 0._r8 .and. bogtop .lt. 0._r8 ) then + plnb = p_b - ( p_b - p_t ) * ( bogbot / ( bogbot - bogtop ) ) + call progup_wu2( rdrag*eps(m) - rjet*del(m), rho_m, p_b, plnb, bogbot, 0._r8, w_au(m)**2._r8, & + we_b(k)**2._r8, tmp1 ) + dpa(m) = compute_dp( rdrag*eps(m) - rjet*del(m), rho_m, plnb, p_t, 0._r8, bogtop, tmp1, & + we_b(k)**2._r8 ) ! '0 <= dpa(m) <= plnb-p_t' + dpa(m) = dpa(m) + ( p_b - plnb ) + else + dpa(m) = compute_dp( rdrag*eps(m) - rjet*del(m), rho_m, p_b, p_t, bogbot, bogtop, w_au(m)**2._r8, & + we_b(k)**2._r8 ) ! '0 <= dpa(m) <= p_b-p_t' + endif + w_aut(m) = 0._r8 + endif + endif + + dza(m) = min( dz_m, max( 0._r8, dpa(m) / rho_m / g ) ) + ptop(m) = p_b - dpa(m) + ztop(m) = z_b + dza(m) + + + tmp1 = cmf_au(m) * exp( dpa(m) * ( eps(m) - del(m) ) ) + + if( w_aut(m) .gt. nonzero .and. tmp1 .ge. cmfmin .and. k .ne. mkx ) then + ytop(m) = 1._r8 + cmf_aut(m) = cmf_au(m) * exp( dp_m * ( eps(m) - del(m) ) ) + a_aut(m) = cmf_aut(m) / rho_t / w_aut(m) + num_aut(m) = num_au(m) + rad_aut(m) = sqrt( a_aut(m) / num_aut(m) / 3.141592_r8 ) ! Physical radius of updraft plume [ m ] + + else + + ytop(m) = 0._r8 + w_aut(m) = 0._r8 + + cmf_aut(m) = cmf_au(m) * exp( dpa(m) * ( eps(m) - del(m) ) ) ! For the purpose of computing diabatic forcing later, retain this. + a_aut(m) = a_au(m) + num_aut(m) = num_au(m) + rad_aut(m) = rad_au(m) + + endif + + ! ------------------------------------------------------------------ ! + ! fmix(m) * dpa(m) * eps0(m) * cmf_au(m) : ! + ! The amount of updraft mass involved in the buoyancy sorting mixing ! + ! Oct.05.2010. This 'fmix' can be enormously large ( e.g., 500 ), ! + ! causing CAM5 crash. Thus, I used the discrete value of 1 by ! + ! commenting out the below 'if' block. This was the biggest bug. ! + ! Jan.30.2013. With a new constraint on eps0(m) on this day, ! + ! we don't need to use 'fmix_max' constraint in the ! + ! below case of 'exp_cmf .eq. 1'. So, I commented out ! + ! corresponding line. ! + ! ------------------------------------------------------------------ ! + + if( dpa(m) * abs( eps(m) - del(m) ) .ge. 1.e-3_r8 ) then + fmix(m) = ( exp( dpa(m) * ( eps(m) - del(m) ) ) - 1._r8 ) / ( dpa(m) * ( eps(m) - del(m) ) ) + else + fmix(m) = 1._r8 + endif + + ! ------------------------------------------------------------------------ ! + ! Adiabatic Vertical Prognostic Equation ! + ! 1. This should not include diabatic forcing. ! + ! 2. This should use the organized 'thle_m' not the 'thl_m'. ! + ! 3. We are performing vertical integration upto the cloud top, not the ! + ! top interface. Thus, this is performed for all updraft plumes ! + ! including detached as well as non-detached updrafts. ! + ! 4. Also compute cloud condensate. ! + ! Apr.17.2012. In order to remove ambiguity due to variable use, I define ! + ! 'thl_meu, qt_meu, u_meu, v_meu, ql_meu, qi_meu, tr_met(mt)' ! + ! similar to 'thl_med,...' for use in the below blocks. ! + ! Nov.28.2012. In order to clarify adiabatic and diabatic processes, ! + ! any droplet activation due to lateral mixing SHOULD NOT be ! + ! treated in the 'progup_thlqt' below even though this ! + ! subroutine has a functionality to handle this by using ! + ! additional 'dia' input argument as the second argument. ! + ! In fact, we can handle diabatic process of 'nl,ni' in below ! + ! but for that case, we should apply twice 'progup_thlqt' for ! + ! each of the 'tr_au(m,ixnumliq)' and 'tr_au(m,ixnumice)', ! + ! first with dia = 0 and second with dia > 0 or < 0. Then by ! + ! subtracting the two, we should compute diabatic forcing ! + ! on each of 'nl,ni'. This can be done in future. ! + ! ------------------------------------------------------------------------ ! + + thl_meu = thle_b(k) + ssthle(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + qt_meu = qte_b(k) + ssqte(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + u_meu = ue_b(k) + ssue(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + v_meu = ve_b(k) + ssve(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + ql_meu = qle_b(k) + ssqle(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + qi_meu = qie_b(k) + ssqie(k) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + do mt = 1, ncnst + tr_meu(mt) = tre_b(k,mt) + sstre(k,mt) * ( 0.5_r8 * ( ptop(m) + p_b ) - p_b ) + enddo + + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, ptop(m), thl_meu, ssthle(k), thl_au(m), thl_aut(m) ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, ptop(m), qt_meu, ssqte(k), qt_au(m), qt_aut(m) ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, ptop(m), ql_meu, ssqle(k), ql_au(m), ql_aut_adi ) + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, ptop(m), qi_meu, ssqie(k), qi_au(m), qi_aut_adi ) + do mt = 1, ncnst + call progup_thlqt( eps(m), 0._r8, 0._r8, p_b, ptop(m), tr_meu(mt), sstre(k,mt), tr_au(m,mt), tr_aut(m,mt) ) + enddo + + ! Nov.28.2012. Impose consistency between droplet mass and droplet number. + ! Note that physically, droplet activation should not be performed here but + ! performed later in association with 'CEF' process. + ! In principle, I only need below two constraint lines. + ! However, in order to impose a constraint that in-cloud droplet radius is fixed + ! by the externally specified value for this version of code, I need two additional + ! lines further below. + + ! Below should be used for future generalized cloud microphysics. + ! if( ql_aut_adi .eq. 0._r8 ) tr_aut(m,ixnumliq) = 0._r8 + ! if( qi_aut_adi .eq. 0._r8 ) tr_aut(m,ixnumice) = 0._r8 + + ! Below is used instead of the above two lines to satisfy the constraint of constant in-cumulus + ! droplet radius. In future's generalized microphysics, above two lines should be used instead of below two lines. + tr_aut(m,ixnumliq) = ql_aut_adi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + tr_aut(m,ixnumice) = qi_aut_adi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + + ! CORRECTION + ! Note that the effect of PGFc is separately trested later. Thus, in order to + ! prevent double counting, we should set ssue = ssve = 0 below. + ! Considering the case of non-constructed profile, I should definitely use the + ! separate one at the top later below. + + u_grdPGF = ssu0(k) + v_grdPGF = ssv0(k) + + call progup_uv( eps(m), PGFc_up, p_b, ptop(m), u_meu, ssue(k), u_grdPGF, u_au(m), u_aut(m) ) + call progup_uv( eps(m), PGFc_up, p_b, ptop(m), v_meu, ssve(k), v_grdPGF, v_au(m), v_aut(m) ) + call progup_uv( eps(m), 0._r8, p_b, ptop(m), u_meu, ssue(k), u_grdPGF, u_au(m), u_aut_adi ) + call progup_uv( eps(m), 0._r8, p_b, ptop(m), v_meu, ssve(k), v_grdPGF, v_au(m), v_aut_adi ) + + ! -------------------------------------------------------------------- ! + ! ! + ! Treatment of Diabatic Forcings at the cloud top or the top interface ! + ! ! + ! -------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------- ! + ! Apr.08.2013. ! + ! Below block computing ! + ! (1) 'exql, exqi, extr(mt)', ! + ! (2) 'evpR, evpS, evpRStr(mt)', ! + ! (3) 'eff_ql_au(m), eff_qi_au(m), eff_tr_au(m,mt)' ! + ! are added on this day in association with fully analytical treatment ! + ! of precipitation fall-out within convective updraft. ! + ! ------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------- ! + ! Compute 'exql,exqi' by solving analytical vertical integration of 'ql,qi' ! + ! by including differential precipitation fall-out in the integration. ! + ! ------------------------------------------------------------------------- ! + + if( iprd_prep .eq. 5 ) then ! Backward Analytical Method + + call conden( ptop(m), thl_aut(m), qt_aut(m), th, qv, ql, qi, qse, id_check ) + if( ( ql_cu + qi_cu ) .gt. criqc ) then + eps_dia_L = c0_ac * ( ( ql_cu + qi_cu ) - criqc ) / ( ql_cu + qi_cu ) + eps_dia_I = c0_ac * ( ( ql_cu + qi_cu ) - criqc ) / ( ql_cu + qi_cu ) + else + eps_dia_L = 0._r8 + eps_dia_I = 0._r8 + endif + call progup_thlqt( eps(m), eps_dia_L, 0._r8, p_b, ptop(m), ql_meu, ssqle(k), ql_au(m), ql_aut_adi_prp ) + call progup_thlqt( eps(m), eps_dia_I, 0._r8, p_b, ptop(m), qi_meu, ssqie(k), qi_au(m), qi_aut_adi_prp ) + exql = min( max( ql_aut_adi - ql_aut_adi_prp, 0._r8 ), 0.99_r8 * ql ) ! This should be guaranteed to be positive at this stage. + exqi = min( max( qi_aut_adi - qi_aut_adi_prp, 0._r8 ), 0.99_r8 * qi ) ! This should be guaranteed to be positive at this stage. + if( mclimit .eq. 1 ) then + tmp1 = exql + exqi + tmp2 = min( tmp1, max( ql + qi - criqc, 0._r8 ) ) ! To impose a continuous variation across ql + qi = criqc. + exql = exql * ( tmp2 / max( tmp1, nonzero ) ) + exqi = exqi * ( tmp2 / max( tmp1, nonzero ) ) + endif + do mt = 1, ncnst + if( mt .eq. 1 ) then + extr(mt) = 0._r8 + elseif( mt .eq. ixcldliq ) then + extr(mt) = exql + elseif( mt .eq. ixcldice ) then + extr(mt) = exqi + elseif( mt .eq. ixnumliq ) then + extr(mt) = exql * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + extr(mt) = exqi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + ! ----------------------------------------------------------------------------------------- ! + ! Wet deposition of aerosols (both interstitial and cloud-borne) within convective updarft. ! + ! Below is a very simple treatment which should be refined in future. ! + ! ----------------------------------------------------------------------------------------- ! + extr(mt) = tr_aut(m,mt) * ( ( exql + exqi ) / max( qt_aut(m), nonzero ) ) + ! Nov.29.2013. Following the reviewer's comments, use 'ql+qi' instead of 'qt_aut(m)' + ! in computing 'extr(mt)' above. + extr(mt) = caer * tr_aut(m,mt) * min( 1._r8, ( ( exql + exqi ) / max( ql + qi, nonzero ) ) ) + + endif + enddo + ! -------------------------------------------------- ! + ! Evaporation within Updraft. ! + ! Set it to be zero, but can be refined in future. ! + ! -------------------------------------------------- ! + evpR = 0._r8 + evpS = 0._r8 + do mt = 1, ncnst + evpRStr(mt) = 0._r8 + enddo + ! ---------------------------------------------------------------------------------------------------------- ! + ! Compute effective tendency of 'ql,qi' by 'CEF' process. ! + ! In the below 'thl_tmp, qt_tmp' are the final correct updraft state variable at the top interface ! + ! that includes both 'mixing' and 'precipitation fall-out'. ! + ! Note that I am using 'exn0(k)' instead of 'exnf(ptop(m))' in the below line to be consistent with ! + ! the other part of the code to satisfy energy-moisture conservation principle. ! + ! IMPORTANT : ! + ! In case of convective updraft when analytical integration is used as in the current code, ! + ! however, we should compute these 'effective CEF forcings' using the variables ! + ! including 'precipitation fallout' both adiabatically and diabatically, since analytical ! + ! computation of precipitation fall-out will break the imposed fractional relationship ! + ! of 'ql / (ql + qi ) = f(T)', so that the restoration of this relationship using 'conden' and ! + ! associated heating-cooling process is eventually included as a part of 'CEF' forcing. ! + ! ---------------------------------------------------------------------------------------------------------- ! + thl_tmp = thl_aut(m) + ( xlv / cp / exn0(k) ) * ( exql - evpR ) + ( xls / cp / exn0(k) ) * ( exqi - evpS ) + qt_tmp = qt_aut(m) - exql - exqi + evpR + evpS + call conden( ptop(m), thl_tmp, qt_tmp, th_tmp, qv_tmp, ql_tmp, qi_tmp, qs_tmp, id_check ) + eff_ql_au(m) = ql_tmp - ql_aut_adi_prp + eff_qi_au(m) = qi_tmp - qi_aut_adi_prp + do mt = 1, ncnst + if( mt .eq. ixnumliq ) then + ! Nov.28.2012. Below block is the new code. Note that in order to decide whether droplet activation + ! process should be performed or not, we should compare 'ql' with 'ql_u(m)' not + ! with 'ql_aut_adi'. + ! Below droplet activation form is not a general formula but a specific one designed + ! to satisfy the constraint of a constant in-cloud droplet size specified externally. + ! In future's generalized cloud microphysics, more generalized droplet activation + ! form should be used. The same is true for ice. + ! if( ql_au(m) .eq. 0._r8 .and. ql .gt. 0._r8 ) then ! Droplet Activation + ! eff_tr_au(m,mt) = eff_ql_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + ! else + ! ! The second line assumes that only evaporation changes droplet number. + ! ! The choice of second line should be made in consistent with the one in the downdraft process. + ! eff_tr_au(m,mt) = eff_ql_au(m) * ( tr_aut(m,mt) / max( ql_aut_adi, nonzero ) ) + ! ! eff_tr_au(m,mt) = min( eff_ql_au(m), 0._r8 ) * ( tr_aut(m,mt) / max( ql_aut_adi, nonzero ) ) + ! endif + ! Below line is the old code. + eff_tr_au(m,mt) = eff_ql_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + ! Nov.28.2012. Below block is the new code. + ! if( qi_au(m) .eq. 0._r8 .and. qi .gt. 0._r8 ) then ! Crystal Nucleation + ! eff_tr_au(m,mt) = eff_qi_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + ! else + ! ! The second line assumes that only evaporation changes droplet number. + ! ! The choice of second line should be made in consistent with the one in the downdraft process. + ! eff_tr_au(m,mt) = eff_qi_au(m) * ( tr_aut(m,mt) / max( qi_aut_adi, nonzero ) ) + ! ! eff_tr_au(m,mt) = min( eff_qi_au(m), 0._r8 ) * ( tr_aut(m,mt) / max( qi_aut_adi, nonzero ) ) + ! endif + ! Below line is the old code. + eff_tr_au(m,mt) = eff_qi_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + eff_tr_au(m,mt) = 0._r8 + endif + eff_tr_au(m,mt) = max( eff_tr_au(m,mt), qmin(mt) - tr_aut(m,mt) ) + enddo + + ! ------------------------------------------------------------------------- ! + ! Apr.08.2013. ! + ! Above block computing ! + ! (1) 'exql, exqi, extr(mt)', ! + ! (2) 'evpR, evpS, evpRStr(mt)', ! + ! (3) 'eff_ql_au(m), eff_qi_au(m), eff_tr_au(m,mt)' ! + ! are added on this day in association with fully analytical treatment ! + ! of precipitation fall-out within convective updraft. ! + ! Note that at this stage, none of (1),(2),(3) are used to update updraft ! + ! state variables at the top interface, which will be done further below. ! + ! ------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : ADIABATIC CONDENSATION-EVAPORATION-FREEZING DURING VERTICAL MOTION ! + ! Note that this CEF does not change 'thl_aut(m),qt_aut(m)'. So, here I only update 'tr_aut(m,mt)'. ! + ! ------------------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + tr_aut(m,mt) = tr_aut(m,mt) + eff_tr_au(m,mt) + enddo + + else ! The others of Backward Analytical Method + + ! ------------------------------------------------------------------------------- ! + ! 1. Compute diabatic 'condensation-evaporation-freezing' on the cloud condensate ! + ! In case of tracers, I temporarily set it to be zero. However, it should be ! + ! correctly computed later, depending on whether the tracers are cloud droplet ! + ! number concentration or other aerosol tracers ( mass and number ). If they ! + ! are droplet numbers, 'eff_tr_au' will be nonzero due to the evaporation and ! + ! freezing, but if they are other tracers, it is likely that 'eff_tr_au=0'. ! + ! Note that this 'CEF' process does not change 'thl,qt,u,v' which are ! + ! conserved scalars. Similarly, tracers other than 'nl,ni' are likely to be ! + ! invariant to this CEF process. ! + ! In the below, 'ql,qi' contains 'mixing' and 'CEF' already. ! + ! Nov.28.2012. In order to correctly handle the changes of droplet numbers ! + ! associated with this 'CEF', we should be able to separately handle freezing ! + ! process. Computation of this separate freezing process is possible if we ! + ! think this CEF process as a seris of 'CE' --> 'F' process. ! + ! In this case, eff_fz_au(m) = eff_qi_au(m). However, when there is only ice ! + ! not the liquid, this approach can be problematic, since we will ! + ! continuously generate ice crystal number by treating 'qi' increase as ! + ! freezing process. ! + ! This is a process reducing pressure without changing thl_aut(m) & qt_aut(m), ! + ! that is, 'eff_ql_au(m) + eff_qi_au(m) > 0', so that condensate is always ! + ! generated. This property provides a clue for handling this process. ! + ! Apr.08.2013. Below block is commented-out with '!prp' since it is now being ! + ! computed above in association with analytical treatment of precipitation ! + ! fall-out within convective updraft above. ! + ! ------------------------------------------------------------------------------- ! + call conden( ptop(m), thl_aut(m), qt_aut(m), th, qv, ql, qi, qse, id_check ) + eff_ql_au(m) = ql - ql_aut_adi + eff_qi_au(m) = qi - qi_aut_adi + ! ------------------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : ADIABATIC CONDENSATION-EVAPORATION-FREEZING DURING VERTICAL MOTION ! + ! ------------------------------------------------------------------------------------------------- ! + ! Nov.08.2011. Critical bug fix. I should correctly handle the droplet number concentration in order! + ! to prevent generating unreasonable source of droplet number which was the case in the! + ! previous wrong code. ! + ! Nov.28.2012. ! + ! Below treatment implies that ! + ! (1) Activation occurs with the specified 'droprad_liq, droprad_ice' ! + ! (2) Condensation occurs on the existing liquid and ice droplets, ! + ! (3) Evaporation reduces the numbers of liquid and ice droplets. ! + ! where treatment of (2) allows the growth of cloud liquid and ice crystals, so that ! + ! future parameterization of precipitation production as a function of droplet size ! + ! will be possible. ! + ! The only caveat of this approach is that when freezing occurs so that some of ! + ! the existing liquid droplets are converted into the ice crystals, corresponding ! + ! increase of tr_aut(m,ixnumice) cannot be treated, even though decrease of tr_aut(m,ixnumliq) ! + ! is treated. However, some of these processes are treated by ice nucleation process, so that ! + ! below treatment is not so bad. However, more complete treatment should be made in future. ! + ! For the time being, for consistency with previous code, let's also change droplet number when ! + ! condensation occurs. ! + ! Apr.08.2013. Below block is commented-out with '!prp' since it is now being ! + ! computed above in association with analytical treatment of precipitation ! + ! fall-out within convective updraft above. ! + ! ------------------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + if( mt .eq. ixnumliq ) then + ! Nov.28.2012. Below block is the new code. Note that in order to decide whether droplet activation + ! process should be performed or not, we should compare 'ql' with 'ql_u(m)' not + ! with 'ql_aut_adi'. + ! Below droplet activation form is not a general formula but a specific one designed + ! to satisfy the constraint of a constant in-cloud droplet size specified externally. + ! In future's generalized cloud microphysics, more generalized droplet activation + ! form should be used. The same is true for ice. + ! if( ql_au(m) .eq. 0._r8 .and. ql .gt. 0._r8 ) then ! Droplet Activation + ! eff_tr_au(m,mt) = eff_ql_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + ! else + ! ! The second line assumes that only evaporation changes droplet number. + ! ! The choice of second line should be made in consistent with the one in the downdraft process. + ! eff_tr_au(m,mt) = eff_ql_au(m) * ( tr_aut(m,mt) / max( ql_aut_adi, nonzero ) ) + ! ! eff_tr_au(m,mt) = min( eff_ql_au(m), 0._r8 ) * ( tr_aut(m,mt) / max( ql_aut_adi, nonzero ) ) + ! endif + ! Below line is the old code. + eff_tr_au(m,mt) = eff_ql_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + ! Nov.28.2012. Below block is the new code. + ! if( qi_au(m) .eq. 0._r8 .and. qi .gt. 0._r8 ) then ! Crystal Nucleation + ! eff_tr_au(m,mt) = eff_qi_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + ! else + ! ! The second line assumes that only evaporation changes droplet number. + ! ! The choice of second line should be made in consistent with the one in the downdraft process. + ! eff_tr_au(m,mt) = eff_qi_au(m) * ( tr_aut(m,mt) / max( qi_aut_adi, nonzero ) ) + ! ! eff_tr_au(m,mt) = min( eff_qi_au(m), 0._r8 ) * ( tr_aut(m,mt) / max( qi_aut_adi, nonzero ) ) + ! endif + ! Below line is the old code. + eff_tr_au(m,mt) = eff_qi_au(m) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + eff_tr_au(m,mt) = 0._r8 + endif + ! Nov.27.2012. Impose a constraint on the diabatic forcing to prevent the onset of negative tracer during vertical motion. + ! This constraint is imposed by using 'tr_aut(m,mt) + eff_tr_au(m,mt) > qmin(mt)' criteria, + ! where 'tr_aut(m,mt)' is a tracer at the base interface before adding diabatic forcing. + ! Similar constraint has also been imposed on the downdraft motion. + eff_tr_au(m,mt) = max( eff_tr_au(m,mt), qmin(mt) - tr_aut(m,mt) ) + enddo + + ! ------------------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : ADIABATIC CONDENSATION-EVAPORATION-FREEZING DURING VERTICAL MOTION ! + ! Note that this CEF does not change 'thl_aut(m),qt_aut(m)'. So, here I only update 'tr_aut(m,mt)'. ! + ! ------------------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + tr_aut(m,mt) = tr_aut(m,mt) + eff_tr_au(m,mt) + enddo + + ! ------------------------------------------------------------------------- ! + ! 2. Precipitation fallout at the cloud top ! + ! a. Future refinement of microphysics only requires recomputation of ! + ! production of precipitation, exql, exqi. ! + ! b. I used 'exn_t' for consistency with later computation of 'slten_u'. ! + ! Apr.21.2011. Use 'exn_top' instead of 'exn_t'. ! + ! c. In case of tracers other than droplet number concentration, ! + ! I temporary set 'prep_tr_au' to be zero but correct value should be ! + ! calculated by mimicking the in-cloud wet scavenging routine later. ! + ! ------------------------------------------------------------------------- ! + + ! -------------------------------------------------------------------------------------------------------------------- ! + ! Feb.07.2013. ! + ! Compute precipitation production rate at the cumulus top during upward motion from 'p_b(z_b)' to 'ptop(ztop)'. ! + ! It is possible that w_aut(m) = 0 if 'ptop' is the final cumulus top instead of the top interface. ! + ! Below subroutine 'prod_prep_up' computes the amount of precipitated condensate ( exql, exqi >= 0 in [kg/kg], ! + ! extr(1:ncnst) >= in [#(kg)/kg] ) during 'delta_t = ( ztop(m) - z_b ) / ( 0.5 * ( w_au(m) + w_aut(m) ) )' ! + ! at the top interface. ! + ! The final layer-mean precipitation production rate will be computed later using 'exql, exqi, extr(1:ncnst)'. ! + ! Note that extr(1) = 0., extr(ixcldliq) = exql, extr(ixcldice) = exqi, ! + ! extr(ixnumliq) = exql * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ), ! + ! extr(ixnumice) = exqi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ). ! + ! Most importantly, 'extr(other indices)' is the wet deposition of aerosols (both interstiail and cloud-borne) ! + ! within cumulus updraft. ! + ! Note since am_pu_msfc(k,msfc) is computed using am_us_msfc(k,msfc) not by using ! + ! am_u_msfc(k,msfc), I am using am_us_msfc(k,msfc) in the below subroutine as an input ! + ! argument. However, in association with the use of beta2 = 1 and evaporation within ! + ! PBL environment, I should come up with more satisfactory cloud overlapping structure ! + ! in future. This is always related with the treatment of wet deposition of aerosols ! + ! within unsaturated convective updraft. I should figure this out before AMWG. ! + ! Feb.09.2013. ! + ! Note that the input argument is 'am_u_msfc(k,msfc)' not 'am_us_msfc(k,msfc)' since evaporation within updraft is also! + ! treated when updraft is unsaturated. ! + ! Apr.08.2013. In association with fully analytical treatment precipitation fall-out within convective updraft above, ! + ! I commented-out below block with '!prp'. But it can be restored at any time in future. ! + ! -------------------------------------------------------------------------------------------------------------------- ! + + msfc = msfc_from_m(k,m) + call prod_prep_up( z_b, ztop(m), p_b, ptop(m), (ptop(m)/p00)**rovcp, exn0(k), & + w_au(m), w_aut(m), & + thl_aut(m), qt_aut(m), ql, qi, tr_aut(m,1:ncnst), & + S_b_ql_au(m), S_b_qi_au(m), iprd_prep, & + ql_cu, qi_cu, eps(m), & + thl_meu, ssthle(k), thl_au(m), qt_meu, ssqte(k), qt_au(m), & + ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, i, k, lchnk, & + flxrain_msfc(k,msfc), flxsnow_msfc(k,msfc), & + a_p_msfc(k,msfc), am_u_msfc(k,msfc), am_pu_msfc(k,msfc), & + caer, criqc, c0_ac, & + exql, exqi, extr(1:ncnst), S_t_ql_au(m), S_t_qi_au(m), & + evpR, evpS, evpRStr(1:ncnst) ) + + endif ! End of Backward Analytical Method + + + prep_qtl_au(m) = - exql + prep_qti_au(m) = - exqi + + prep_thll_au(m) = - ( xlv / cp / exn0(k) ) * prep_qtl_au(m) + prep_thli_au(m) = - ( xls / cp / exn0(k) ) * prep_qti_au(m) + + ! ------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : PRECIPITATION FALLOUT AT THE TOP INTERFACE ! + ! ------------------------------------------------------------------------- ! + + do mt = 1, ncnst + prep_tr_au(m,mt) = - extr(mt) + prep_tr_au(m,mt) = max( prep_tr_au(m,mt), qmin(mt) - tr_aut(m,mt) ) + enddo + ! ------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : PRECIPITATION FALLOUT AT THE TOP INTERFACE ! + ! ------------------------------------------------------------------------- ! + ! ------------------------------------------------------------------------------------------- ! + ! Evaporation of Precipitation at the cloud top ! + ! ------------------------------------------------------------------------------------------- ! + evp_qtl_au(m) = evpR + evp_qti_au(m) = evpS + evp_thll_au(m) = - ( xlv / cp / exn0(k) ) * evp_qtl_au(m) + evp_thli_au(m) = - ( xls / cp / exn0(k) ) * evp_qti_au(m) + ! -------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : EVAPORATION OF CONVECTIVE PRECIPITATION WITHIN UPDRAFTA ! + ! -------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + evp_tr_au(m,mt) = evpRStr(mt) + enddo + ! ------------------------------------------------------------------------------------------- ! + ! 0. Evaporation of Precipitation at the cloud top ! + ! a. Since updraft is unsaturated within the PBL, this evaporation should be treated here. ! + ! This may be especially important for treating deep convection. ! + ! b. I should treat only evaporation of 'convective precipitation' not the 'stratiform ! + ! precipitation'. This is important to satisfy energy and moisture conservations. ! + ! c. Any diabatic forcings within convective updraft and downdraft will induce the ! + ! tendencies of environmental variables. ! + ! d. Simply neglect evaporation of precipitation within convctive updraft. ! + ! ------------------------------------------------------------------------------------------- ! + thl_aut(m) = thl_aut(m) + prep_thll_au(m) + prep_thli_au(m) + evp_thll_au(m) + evp_thli_au(m) + qt_aut(m) = qt_aut(m) + prep_qtl_au(m) + prep_qti_au(m) + evp_qtl_au(m) + evp_qti_au(m) + do mt = 1, ncnst + tr_aut(m,mt) = tr_aut(m,mt) + prep_tr_au(m,mt) + evp_tr_au(m,mt) + enddo + ! ----------------------------------------------------- ! + ! 3. Horizontal PGF at the cloud top ! + ! a. Instead of using the gradient within the layer, ! + ! I should use the gradient between the layers. ! + ! ----------------------------------------------------- ! + PGF_u_au(m) = u_aut(m) - u_aut_adi + PGF_v_au(m) = v_aut(m) - v_aut_adi + + ! -------------------------------------------------------------------------- ! + ! Computation of 'ql_aut(m)' and 'qi_aut(m)' ! + ! Note that this is done using a fully updated final 'thl_aut, qt_aut' which ! + ! includes all the effect of 'mixing, precipitation fallout, evaporation. ! + ! -------------------------------------------------------------------------- ! + + call conden( ptop(m), thl_aut(m), qt_aut(m), th, qv, ql, qi, qse, id_check ) + ql_aut(m) = ql + qi_aut(m) = qi + thv_aut(m) = th * ( 1._r8 + zvir * qv - ql - qi ) + if( ql_aut(m) .eq. 0._r8 ) tr_aut(m,ixnumliq) = 0._r8 + if( qi_aut(m) .eq. 0._r8 ) tr_aut(m,ixnumice) = 0._r8 + + ! ------------------------------------------------------------------------ ! + ! Save cloud top height in each layer for each segment for future use. ! + ! Here, 'k' is defined as a layer mid-point index, not the base interface. ! + ! ------------------------------------------------------------------------ ! + + ptops(k,m) = ptop(m) + ztops(k,m) = ztop(m) + + ! -------------------------------------------------------------------------------- ! + ! Diagnostic Output : As of Jul.26.2011, these can be also used in the actual ! + ! as mentioned later below. ! + ! Individual updraft segment ( 'msfc' ) properties ! + ! Mean downdraft properties for individual updraft segment will be computed later. ! + ! Jul.26.2011. Below part of convective updraft properties at each interface are ! + ! moved into later part further below with additional inclusion of ! + ! non-zero cumulus updraft properties at the cumulus top. ! + ! -------------------------------------------------------------------------------- ! + + msfc = msfc_from_m(k,m) + + eps0_u_msfc(km,msfc) = eps0(m) + eps_u_msfc(km,msfc) = eps(m) + del_u_msfc(km,msfc) = del(m) + eeps_u_msfc(km,msfc) = eeps(m) + ddel_u_msfc(km,msfc) = ddel(m) + xc_u_msfc(km,msfc) = xc(m) + xs_u_msfc(km,msfc) = xs(m) + xemin_u_msfc(km,msfc) = xe_min(m) + xemax_u_msfc(km,msfc) = xe_max(m) + cridis_u_msfc(km,msfc) = cridis + thvcuenv_u_msfc(km,msfc) = thv_cu - thv_env + thvegenv_u_msfc(km,msfc) = thv_eg - thv_env + thvxsenv_u_msfc(km,msfc) = thv_xs - thv_env + fmix_u_msfc(km,msfc) = fmix(m) + cmfumix_u_msfc(km,msfc) = fmix(m) * dpa(m) * eps0(m) * cmf_au(m) + + ! ----------------- ! + ! Diagnostic Output ! + ! ----------------- ! + + enddo ! End of updraft segment 'm' loop + + ! ------------------------------------------------------------------------ ! + ! Number of detached and non-detached updraft segments ! + ! Also compute original ( at surface ) updraft segment index in each layer ! + ! Also compute the 'top layer index','top height in pressure and height' ! + ! of the original updraft segment at surface. ! + ! ------------------------------------------------------------------------ ! + + nseg_nondet = 0 ! # of non-detached updraft segments + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + nseg_nondet = nseg_nondet + 1 + msfc_from_m(k+1,nseg_nondet) = msfc_from_m(k,m) + else + ktop_msfc(msfc_from_m(k,m)) = k + ptop_msfc(msfc_from_m(k,m)) = ptops(k,m) + ztop_msfc(msfc_from_m(k,m)) = ztops(k,m) + endif + m_from_msfc(k,msfc_from_m(k,m)) = m + enddo + nseg_det = N_up(km) - nseg_nondet ! # of detached updraft segments + + ! -------------------------------------------------------------------------- ! + ! Apply the constraint of updraft vertical velocity for each updraft segment ! + ! and compute the mass of the 3rd type of detrained airs. ! + ! Note that 'ybot(m)=1' always. ! + ! -------------------------------------------------------------------------- ! + + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 .and. w_aut(m) .gt. wumax ) then + f_wu(m) = ( 1._r8 - wumax / w_aut(m) ) + f_srcds(k,m,3) = f_wu(m) * cmf_aut(m) / cmf_u(km) + f_srcrs(k,m,3) = 0._r8 + f_srcrs2(k,m,3) = 0._r8 + cmf_aut(m) = cmf_aut(m) * ( 1._r8 - f_wu(m) ) + w_aut(m) = w_aut(m) * ( 1._r8 - f_wu(m) ) + endif + enddo + + ! ------------------------------------------------------------------------ ! + ! Apply the constraint of updraft fractional area for each updraft segment ! + ! and compute the mass of the 3rd type of detrained airs. ! + ! Note that 'ybot(m)=1' always. ! + ! ------------------------------------------------------------------------ ! + + au_tent = 0._r8 + if( nseg_nondet .gt. 0.5_r8 ) then + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + au_tent = au_tent + a_aut(m) + endif + enddo + endif + + f_nu = max( 0._r8, 1._r8 - au_max / max( nonzero, au_tent ) ) + + if( au_tent .gt. au_max ) then + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + f_srcds(k,m,3) = f_srcds(k,m,3) + f_nu * cmf_aut(m) / cmf_u(km) + cmf_aut(m) = cmf_aut(m) * ( 1._r8 - f_nu ) + a_aut(m) = a_aut(m) * ( 1._r8 - f_nu ) + rad_aut(m) = sqrt( a_aut(m) / num_aut(m) / 3.141592_r8 ) ! Physical radius of updraft plume [ m ] + endif + enddo + endif + + ! ---------------------------------------------------------------------- ! + ! Mass-flux weighted mean or net updraft properties at the top interface ! + ! These are computed only using non-detached updrafts. ! + ! ---------------------------------------------------------------------- ! + + if( nseg_nondet .gt. 0.5_r8 ) then + + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + cmf_u(k) = cmf_u(k) + cmf_aut(m) + num_u(k) = num_u(k) + num_aut(m) + a_u(k) = a_u(k) + a_aut(m) + rad_u(k) = rad_u(k) + num_aut(m) * rad_aut(m)**2._r8 + thl_u(k) = thl_u(k) + thl_aut(m) * cmf_aut(m) + qt_u(k) = qt_u(k) + qt_aut(m) * cmf_aut(m) + u_u(k) = u_u(k) + u_aut(m) * cmf_aut(m) + v_u(k) = v_u(k) + v_aut(m) * cmf_aut(m) + w_u(k) = w_u(k) + w_aut(m) * cmf_aut(m) + wa_u(k) = wa_u(k) + w_aut(m) * a_aut(m) + ql_u(k) = ql_u(k) + ql_aut(m) * cmf_aut(m) + qi_u(k) = qi_u(k) + qi_aut(m) * cmf_aut(m) + do mt = 1, ncnst + tr_u(k,mt) = tr_u(k,mt) + tr_aut(m,mt) * cmf_aut(m) + enddo + qla_u(k) = qla_u(k) + ql_aut(m) * a_aut(m) + qia_u(k) = qia_u(k) + qi_aut(m) * a_aut(m) + thva_u(k) =thva_u(k) + thv_aut(m) * a_aut(m) + endif + enddo + rad_u(k) = sqrt( rad_u(k) / num_u(k) ) ! Effective plume radius [ m ] + thl_u(k) = thl_u(k) / cmf_u(k) + qt_u(k) = qt_u(k) / cmf_u(k) + u_u(k) = u_u(k) / cmf_u(k) + v_u(k) = v_u(k) / cmf_u(k) + w_u(k) = w_u(k) / cmf_u(k) + wa_u(k) = wa_u(k) / a_u(k) + ql_u(k) = ql_u(k) / cmf_u(k) ! Mass-flux weighted average of in-cloud liquid condensate + qi_u(k) = qi_u(k) / cmf_u(k) ! Mass-flux weighted average of in-cloud liquid condensate + do mt = 1, ncnst + tr_u(k,mt) = tr_u(k,mt) / cmf_u(k) + enddo + qla_u(k) = qla_u(k) / a_u(k) ! Area-weighting average of in-cloud liquid condensate + qia_u(k) = qia_u(k) / a_u(k) ! Area-weighting average of in-cloud liquid condensate + thva_u(k) =thva_u(k) / a_u(k) ! Area-weighting average of updraft buoyancy + endif + + ! ----------------------------------------------------------------------------- ! + ! Mass-flux weighted diabatic change of conservative scalars at each cloud top. ! + ! This will be used for computing environmental tendency later. ! + ! We separately define cmf_u_dia(k) as well as cmf_u(k) to take into account of ! + ! non-zero updraft mass flux at just below the cloud top of each detached ! + ! updraft for the purpose of treating diabatic forcing at the cloud top. ! + ! ----------------------------------------------------------------------------- ! + + do m = 1, N_up(km) + fac = 0.5_r8 * ( cmf_au(m) + cmf_aut(m) ) * ( dpa(m) / dp_m ) + if( ytop(m) .gt. 0.5_r8 ) fac = 0.5_r8 * ( cmf_au(m) + cmf_aut(m) / ( 1._r8 - f_nu ) / ( 1._r8 - f_wu(m) ) ) + cmf_u_dia(k) = cmf_u_dia(k) + fac + evp_thll_u(k) = evp_thll_u(k) + evp_thll_au(m) * fac + evp_qtl_u(k) = evp_qtl_u(k) + evp_qtl_au(m) * fac + evp_thli_u(k) = evp_thli_u(k) + evp_thli_au(m) * fac + evp_qti_u(k) = evp_qti_u(k) + evp_qti_au(m) * fac + prep_thll_u(k) = prep_thll_u(k) + prep_thll_au(m) * fac + prep_qtl_u(k) = prep_qtl_u(k) + prep_qtl_au(m) * fac + prep_thli_u(k) = prep_thli_u(k) + prep_thli_au(m) * fac + prep_qti_u(k) = prep_qti_u(k) + prep_qti_au(m) * fac + PGF_u_u(k) = PGF_u_u(k) + PGF_u_au(m) * fac + PGF_v_u(k) = PGF_v_u(k) + PGF_v_au(m) * fac + eff_ql_u(k) = eff_ql_u(k) + eff_ql_au(m) * fac + eff_qi_u(k) = eff_qi_u(k) + eff_qi_au(m) * fac + do mt = 1, ncnst + evp_tr_u(k,mt) = evp_tr_u(k,mt) + evp_tr_au(m,mt) * fac + prep_tr_u(k,mt) = prep_tr_u(k,mt) + prep_tr_au(m,mt) * fac + eff_tr_u(k,mt) = eff_tr_u(k,mt) + eff_tr_au(m,mt) * fac + enddo + cmf_u_mix(k) = cmf_u_mix(k) + fmix(m) * dpa(m) * eps0(m) * cmf_au(m) + ! ---------------------------------------------------------------------------- ! + ! Compute individual segment's rain and snow production tendency by convective ! + ! updrafts. Corresponding tendency by convective downdraft will be computed ! + ! later. ! + ! ---------------------------------------------------------------------------- ! + msfc = msfc_from_m(k,m) + qrten_u_msfc(k,msfc) = - ( g / dp0(k) ) * ( prep_qtl_au(m) + evp_qtl_au(m) ) * fac ! >= 0 + qsten_u_msfc(k,msfc) = - ( g / dp0(k) ) * ( prep_qti_au(m) + evp_qti_au(m) ) * fac ! >= 0 + ! --------------------------------------------------------------------------------------------------------- ! + ! Nov.29.2012. I can compute corresponding 'trrsten_u_msfc(k,msfc,mt)' of tracers associated with ! + ! precipitation by adding ( prep_tr_au(m,mt) + evp_tr_au(m,mt) ) * fac'. This information will be used ! + ! to trace aerosol concentration within precipitation flux, which will be used to compute the increase of ! + ! aerosol concentration within convective downdraft and environment when precipitation is evaporated within ! + ! convective downdraft and environment. Eventually, this will be used for computing aerosol wet scavenging ! + ! process associated with convective precipitation process instead of performing within wetdepa. ! + ! Note that I should use 'dptr0(k,mt)' instead of 'dp0(k)' for tracers. ! + ! Feb.06.2013. Note that wet deposition of aerosol within convetcive updraft (both cloud-borne and ! + ! interstitial) will be treated as a part of prep_tr_au(m,mt). ! + ! So, I don't need to use wdep_tr_au(m,mt) in the below trrsten_u_msfc(). ! + ! --------------------------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + trrsten_u_msfc(k,msfc,mt) = qrten_u_msfc(k,msfc) + elseif( mt .eq. ixcldice ) then + trrsten_u_msfc(k,msfc,mt) = qsten_u_msfc(k,msfc) + elseif( mt .eq. ixnumliq ) then + trrsten_u_msfc(k,msfc,mt) = qrten_u_msfc(k,msfc) * 3._r8 / & + ( 4._r8 * 3.141592_r8 * droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + trrsten_u_msfc(k,msfc,mt) = qsten_u_msfc(k,msfc) * 3._r8 / & + ( 4._r8 * 3.141592_r8 * droprad_snow**3 * density_snow ) + else + trrsten_u_msfc(k,msfc,mt) = - ( g / dptr0(k,mt) ) * ( prep_tr_au(m,mt) + evp_tr_au(m,mt) ) * fac ! >= 0 + endif + enddo + ! ---------------------------------------------------------------------------- ! + ! ! + ! ---------------------------------------------------------------------------- ! + enddo + if( cmf_u_dia(k) .gt. nonzero ) then + evp_thll_u(k) = evp_thll_u(k) / cmf_u_dia(k) + evp_qtl_u(k) = evp_qtl_u(k) / cmf_u_dia(k) + evp_thli_u(k) = evp_thli_u(k) / cmf_u_dia(k) + evp_qti_u(k) = evp_qti_u(k) / cmf_u_dia(k) + prep_thll_u(k) = prep_thll_u(k) / cmf_u_dia(k) + prep_qtl_u(k) = prep_qtl_u(k) / cmf_u_dia(k) + prep_thli_u(k) = prep_thli_u(k) / cmf_u_dia(k) + prep_qti_u(k) = prep_qti_u(k) / cmf_u_dia(k) + eff_ql_u(k) = eff_ql_u(k) / cmf_u_dia(k) + eff_qi_u(k) = eff_qi_u(k) / cmf_u_dia(k) + PGF_u_u(k) = PGF_u_u(k) / cmf_u_dia(k) + PGF_v_u(k) = PGF_v_u(k) / cmf_u_dia(k) + do mt = 1, ncnst + evp_tr_u(k,mt) = evp_tr_u(k,mt) / cmf_u_dia(k) + prep_tr_u(k,mt) = prep_tr_u(k,mt) / cmf_u_dia(k) + eff_tr_u(k,mt) = eff_tr_u(k,mt) / cmf_u_dia(k) + enddo + else + cmf_u_dia(k) = 0._r8 + evp_thll_u(k) = 0._r8 + evp_qtl_u(k) = 0._r8 + evp_thli_u(k) = 0._r8 + evp_qti_u(k) = 0._r8 + prep_thll_u(k) = 0._r8 + prep_qtl_u(k) = 0._r8 + prep_thli_u(k) = 0._r8 + prep_qti_u(k) = 0._r8 + eff_ql_u(k) = 0._r8 + eff_qi_u(k) = 0._r8 + PGF_u_u(k) = 0._r8 + PGF_v_u(k) = 0._r8 + do mt = 1, ncnst + evp_tr_u(k,mt) = 0._r8 + prep_tr_u(k,mt) = 0._r8 + eff_tr_u(k,mt) = 0._r8 + enddo + endif + + ! ----------------------------------------------------------------------------- ! + ! ! + ! 3 sources of downdrafts and 1 source of detrained air from each segment level ! + ! ! + ! ----------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------------------- ! + ! 1. Mixing Downdraft + Detrained Updraft ! + ! This is a lateral detrainment after updraft buoyancy sorting at the base interface ! + ! ------------------------------------------------------------------------------------- ! + + do m = 1, N_up(km) + ! ---------------------------------------------------------------------------- ! + ! 1. Since updraft buoyancy sorting was performed at the base interface, ! + ! we should use 'thl_au(m)' not 'thl_aut(m)'. ! + ! 2. For consistent treatment of buoyancy sorting with organized environmental ! + ! airs, we should use 'thl_eg' not 'thl_b'. ! + ! 3. Since 'compute_PDF' sets 'zmass = 0' when 'xe_min(m) = xe_max(m)', ! + ! below computation is correct in general case. ! + ! ---------------------------------------------------------------------------- ! + ! ---------------- ! + ! Mixing Downdraft ! + ! ---------------- ! + ! ------------------------------------------------------------------ ! + ! fmix(m) * dpa(m) * eps0(m) * cmf_au(m) : ! + ! The amount of updraft mass involved in the buoyancy sorting mixing ! + ! ------------------------------------------------------------------ ! + + call compute_PDF( 'PDFbsQ', xe_min(m), xe_max(m), zbar, zmass, zmass_up ) + f_srcds(k,m,1) = zmass * fmix(m) * dpa(m) * eps0(m) * 2._r8 * cmf_au(m) / cmf_u(km) + thl_srcds(k,m,1) = ( thl_au(m) + zbar * ( thl_eg - thl_au(m) ) ) + qt_srcds(k,m,1) = ( qt_au(m) + zbar * ( qt_eg - qt_au(m) ) ) + u_srcds(k,m,1) = ( u_au(m) + zbar * ( u_eg - u_au(m) ) ) + v_srcds(k,m,1) = ( v_au(m) + zbar * ( v_eg - v_au(m) ) ) + do mt = 1, ncnst + tr_srcds(k,m,1,mt) = ( tr_au(m,mt) + zbar * ( tr_eg(mt) - tr_au(m,mt) ) ) + enddo + ! -------------------------------------------------------------------------------------------------- ! + ! Nov.28.2012. Impose consistency between droplet mass and droplet number. ! + ! Note that this should be computed here since it involves the use of 'zbar'. ! + ! Mixing downdraft is generated at the base interface which will be the source level of ! + ! mixing downdraft layer. Thus, I am using 'ps0(km)' in the below 'conden' subroutine. ! + ! -------------------------------------------------------------------------------------------------- ! + call conden( ps0(km), thl_srcds(k,m,1), qt_srcds(k,m,1), tmp_th, tmp_qv, tmp_ql, tmp_qi, tmp_qse, id_check ) + ql_srcds(k,m,1) = tmp_ql + qi_srcds(k,m,1) = tmp_qi + tr_srcds(k,m,1,ixnumliq) = ql_srcds(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + tr_srcds(k,m,1,ixnumice) = qi_srcds(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + + ! ----------------- ! + ! Detrained Updraft ! + ! ----------------- ! + call compute_PDF( 'PDFbsQ', xc(m), xe_min(m), zbar1, zmass1, zmass_up1 ) + call compute_PDF( 'PDFbsQ', xe_max(m), 1._r8, zbar2, zmass2, zmass_up2 ) + zmass_up = zmass_up1 + zmass_up2 + zmass = zmass1 + zmass2 + zbar = 0._r8 + if( zmass .gt. nonzero ) zbar = ( zbar1 * zmass1 + zbar2 * zmass2 ) / zmass + f_srcrs(k,m,1) = zmass * fmix(m) * dpa(m) * eps0(m) * 2._r8 * cmf_au(m) / cmf_u(km) + thl_srcrs(k,m,1) = ( thl_au(m) + zbar * ( thl_eg - thl_au(m) ) ) + qt_srcrs(k,m,1) = ( qt_au(m) + zbar * ( qt_eg - qt_au(m) ) ) + u_srcrs(k,m,1) = ( u_au(m) + zbar * ( u_eg - u_au(m) ) ) + v_srcrs(k,m,1) = ( v_au(m) + zbar * ( v_eg - v_au(m) ) ) + do mt = 1, ncnst + tr_srcrs(k,m,1,mt) = ( tr_au(m,mt) + zbar * ( tr_eg(mt) - tr_au(m,mt) ) ) + enddo + ! -------------------------------------------------------------------------------------------------- ! + ! Nov.28.2012. Impose consistency between droplet mass and droplet number. ! + ! Note that this should be computed here since it involves the use of 'zbar'. ! + ! Detrained downdraft will be eventually detrained at the layer mid-point as has been ! + ! assumed in the previous code later. ! + ! Thus, I am using 'p0(k)' in the below 'conden' subroutine. ! + ! -------------------------------------------------------------------------------------------------- ! + call conden( p0(k), thl_srcrs(k,m,1), qt_srcrs(k,m,1), tmp_th, tmp_qv, tmp_ql, tmp_qi, tmp_qse, id_check ) + ql_srcrs(k,m,1) = tmp_ql + qi_srcrs(k,m,1) = tmp_qi + tr_srcrs(k,m,1,ixnumliq) = ql_srcrs(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + tr_srcrs(k,m,1,ixnumice) = qi_srcrs(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + + ! -------------------------------------------------------------- ! + ! Treatment of detrained airs purely from the convective updraft ! + ! -------------------------------------------------------------- ! + f_srcrs2(k,m,1) = zmass_up * fmix(m) * dpa(m) * eps0(m) * 2._r8 * cmf_au(m) / cmf_u(km) + thl_srcrs2(k,m,1) = thl_au(m) + qt_srcrs2(k,m,1) = qt_au(m) + u_srcrs2(k,m,1) = u_au(m) + v_srcrs2(k,m,1) = v_au(m) + do mt = 1, ncnst + tr_srcrs2(k,m,1,mt) = tr_au(m,mt) + enddo + ql_srcrs2(k,m,1) = ql_au(m) + qi_srcrs2(k,m,1) = qi_au(m) + tr_srcrs2(k,m,1,ixnumliq) = ql_srcrs2(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + tr_srcrs2(k,m,1,ixnumice) = qi_srcrs2(k,m,1) * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + + enddo + + ! ---------------- ! + ! 2. Top Downdraft ! + ! ---------------- ! + + if( nseg_det .gt. 0.5_r8 ) then + do m = 1, N_up(km) + if( ytop(m) .lt. 0.5_r8 ) then + f_srcds(k,m,2) = cmf_aut(m) / cmf_u(km) + thl_srcds(k,m,2) = thl_aut(m) + qt_srcds(k,m,2) = qt_aut(m) + u_srcds(k,m,2) = u_aut(m) + v_srcds(k,m,2) = v_aut(m) + do mt = 1, ncnst + tr_srcds(k,m,2,mt) = tr_aut(m,mt) + enddo + ql_srcds(k,m,2) = ql_aut(m) + qi_srcds(k,m,2) = qi_aut(m) + endif + enddo + endif + + ! ----------------- ! + ! 3. Area downdraft ! + ! ----------------- ! + + if( nseg_nondet .gt. 0.5_r8 ) then + + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + thl_srcds(k,m,3) = thl_aut(m) + qt_srcds(k,m,3) = qt_aut(m) + u_srcds(k,m,3) = u_aut(m) + v_srcds(k,m,3) = v_aut(m) + do mt = 1, ncnst + tr_srcds(k,m,3,mt) = tr_aut(m,mt) + enddo + ql_srcds(k,m,3) = ql_aut(m) + qi_srcds(k,m,3) = qi_aut(m) + endif + enddo + endif + + ! ----------------------------------------------------------------------- ! + ! Mass-flux weighted average of 3 sources of downdraft and 1 detrained ! + ! airs originated from the convective updrafts. ! + ! Jul.15.2010. Since I set ybot(m)=1, only ids=1 has non-zero mass flux ! + ! of detrained remaining airs. ! + ! ----------------------------------------------------------------------- ! + + do m = 1, N_up(km) + do ids = 1, 3 + if( f_srcds(k,m,ids) .gt. nonzero ) then + f_srcd(k) = f_srcd(k) + f_srcds(k,m,ids) + thl_srcd(k) = thl_srcd(k) + f_srcds(k,m,ids) * thl_srcds(k,m,ids) + qt_srcd(k) = qt_srcd(k) + f_srcds(k,m,ids) * qt_srcds(k,m,ids) + u_srcd(k) = u_srcd(k) + f_srcds(k,m,ids) * u_srcds(k,m,ids) + v_srcd(k) = v_srcd(k) + f_srcds(k,m,ids) * v_srcds(k,m,ids) + do mt = 1, ncnst + tr_srcd(k,mt) = tr_srcd(k,mt) + f_srcds(k,m,ids) * tr_srcds(k,m,ids,mt) + enddo + ql_srcd(k) = ql_srcd(k) + f_srcds(k,m,ids) * ql_srcds(k,m,ids) + qi_srcd(k) = qi_srcd(k) + f_srcds(k,m,ids) * qi_srcds(k,m,ids) + endif + if( f_srcrs(k,m,ids) .gt. nonzero ) then + f_srcr(k) = f_srcr(k) + f_srcrs(k,m,ids) + thl_srcr(k) = thl_srcr(k) + f_srcrs(k,m,ids) * thl_srcrs(k,m,ids) + qt_srcr(k) = qt_srcr(k) + f_srcrs(k,m,ids) * qt_srcrs(k,m,ids) + u_srcr(k) = u_srcr(k) + f_srcrs(k,m,ids) * u_srcrs(k,m,ids) + v_srcr(k) = v_srcr(k) + f_srcrs(k,m,ids) * v_srcrs(k,m,ids) + ql_srcr(k) = ql_srcr(k) + f_srcrs(k,m,ids) * ql_srcrs(k,m,ids) + qi_srcr(k) = qi_srcr(k) + f_srcrs(k,m,ids) * qi_srcrs(k,m,ids) + do mt = 1, ncnst + tr_srcr(k,mt) = tr_srcr(k,mt) + f_srcrs(k,m,ids) * tr_srcrs(k,m,ids,mt) + enddo + endif + ! --------------------------------------------------------------- ! + ! Treatment of detrained airs purely from the convective updrafts ! + ! --------------------------------------------------------------- ! + if( f_srcrs2(k,m,ids) .gt. nonzero ) then + f_srcr2(k) = f_srcr2(k) + f_srcrs2(k,m,ids) + thl_srcr2(k) = thl_srcr2(k) + f_srcrs2(k,m,ids) * thl_srcrs2(k,m,ids) + qt_srcr2(k) = qt_srcr2(k) + f_srcrs2(k,m,ids) * qt_srcrs2(k,m,ids) + u_srcr2(k) = u_srcr2(k) + f_srcrs2(k,m,ids) * u_srcrs2(k,m,ids) + v_srcr2(k) = v_srcr2(k) + f_srcrs2(k,m,ids) * v_srcrs2(k,m,ids) + ql_srcr2(k) = ql_srcr2(k) + f_srcrs2(k,m,ids) * ql_srcrs2(k,m,ids) + qi_srcr2(k) = qi_srcr2(k) + f_srcrs2(k,m,ids) * qi_srcrs2(k,m,ids) + do mt = 1, ncnst + tr_srcr2(k,mt) = tr_srcr2(k,mt) + f_srcrs2(k,m,ids) * tr_srcrs2(k,m,ids,mt) + enddo + endif + enddo + + enddo + + if( f_srcd(k) .gt. nonzero ) then + thl_srcd(k) = thl_srcd(k) / f_srcd(k) + qt_srcd(k) = qt_srcd(k) / f_srcd(k) + u_srcd(k) = u_srcd(k) / f_srcd(k) + v_srcd(k) = v_srcd(k) / f_srcd(k) + do mt = 1, ncnst + tr_srcd(k,mt) = tr_srcd(k,mt) / f_srcd(k) + enddo + ql_srcd(k) = ql_srcd(k) / f_srcd(k) + qi_srcd(k) = qi_srcd(k) / f_srcd(k) + else + f_srcd(k) = 0._r8 + thl_srcd(k) = 0._r8 + qt_srcd(k) = 0._r8 + u_srcd(k) = 0._r8 + v_srcd(k) = 0._r8 + do mt = 1, ncnst + tr_srcd(k,mt) = 0._r8 + enddo + ql_srcd(k) = 0._r8 + qi_srcd(k) = 0._r8 + endif + if( f_srcr(k) .gt. nonzero ) then + thl_srcr(k) = thl_srcr(k) / f_srcr(k) + qt_srcr(k) = qt_srcr(k) / f_srcr(k) + u_srcr(k) = u_srcr(k) / f_srcr(k) + v_srcr(k) = v_srcr(k) / f_srcr(k) + ql_srcr(k) = ql_srcr(k) / f_srcr(k) + qi_srcr(k) = qi_srcr(k) / f_srcr(k) + do mt = 1, ncnst + tr_srcr(k,mt) = tr_srcr(k,mt) / f_srcr(k) + enddo + else + f_srcr(k) = 0._r8 + thl_srcr(k) = 0._r8 + qt_srcr(k) = 0._r8 + u_srcr(k) = 0._r8 + v_srcr(k) = 0._r8 + ql_srcr(k) = 0._r8 + qi_srcr(k) = 0._r8 + do mt = 1, ncnst + tr_srcr(k,mt) = 0._r8 + enddo + endif + ! ------------------------------------------------------------- ! + ! Treatment of detrained air purely from the convective updraft ! + ! ------------------------------------------------------------- ! + if( f_srcr2(k) .gt. nonzero ) then + thl_srcr2(k) = thl_srcr2(k) / f_srcr2(k) + qt_srcr2(k) = qt_srcr2(k) / f_srcr2(k) + u_srcr2(k) = u_srcr2(k) / f_srcr2(k) + v_srcr2(k) = v_srcr2(k) / f_srcr2(k) + ql_srcr2(k) = ql_srcr2(k) / f_srcr2(k) + qi_srcr2(k) = qi_srcr2(k) / f_srcr2(k) + do mt = 1, ncnst + tr_srcr2(k,mt) = tr_srcr2(k,mt) / f_srcr2(k) + enddo + else + f_srcr2(k) = 0._r8 + thl_srcr2(k) = 0._r8 + qt_srcr2(k) = 0._r8 + u_srcr2(k) = 0._r8 + v_srcr2(k) = 0._r8 + ql_srcr2(k) = 0._r8 + qi_srcr2(k) = 0._r8 + do mt = 1, ncnst + tr_srcr2(k,mt) = 0._r8 + enddo + endif + + ! --------------------------------------------------------------------------- ! + ! Allocation of detrained source airs from convective updraft into new arrays ! + ! --------------------------------------------------------------------------- ! + + cmf_ru(k) = f_srcr(k) * cmf_u(km) + thl_ru(k) = thl_srcr(k) + qt_ru(k) = qt_srcr(k) + u_ru(k) = u_srcr(k) + v_ru(k) = v_srcr(k) + ql_ru(k) = ql_srcr(k) + qi_ru(k) = qi_srcr(k) + do mt = 1, ncnst + tr_ru(k,mt) = tr_srcr(k,mt) + enddo + + ! ------------------------------------------------------------- ! + ! Treatment of detrained air purely from the convective updraft ! + ! ------------------------------------------------------------- ! + + cmf_ru2(k) = f_srcr2(k) * cmf_u(km) + thl_ru2(k) = thl_srcr2(k) + qt_ru2(k) = qt_srcr2(k) + u_ru2(k) = u_srcr2(k) + v_ru2(k) = v_srcr2(k) + ql_ru2(k) = ql_srcr2(k) + qi_ru2(k) = qi_srcr2(k) + do mt = 1, ncnst + tr_ru2(k,mt) = tr_srcr2(k,mt) + enddo + + ! ---------------------------------------------------------------------- ! + ! Compute 'cloud fraction' and 'in-cloud LWC,IWC' at the layer mid-point ! + ! for individual updraft segment. ! + ! Note that 'ktop_msfc', 'ptop_msfc', 'ztop_msfc' should be printed out ! + ! at the output side of vertical 'k' loop - that is, it should be ! + ! printed-out where 'cushavg' is computed. ! + ! Sep.15.2011. All the other conservative scalars too for defining ! + ! mixing environmental airs associated organization later. ! + ! ---------------------------------------------------------------------- ! + + do m = 1, N_up(km) + msfc = msfc_from_m(k,m) + am_u_msfc(k,msfc) = 0.5_r8 * ( a_au(m) + a_aut(m) ) * ( dpa(m) / dp_m ) + qlm_u_msfc(k,msfc) = 0.5_r8 * ( ql_au(m) + ql_aut(m) ) * ( dpa(m) / dp_m ) + qim_u_msfc(k,msfc) = 0.5_r8 * ( qi_au(m) + qi_aut(m) ) * ( dpa(m) / dp_m ) + thlm_u_msfc(k,msfc) = 0.5_r8 * ( thl_au(m) + thl_aut(m) ) * ( dpa(m) / dp_m ) + qtm_u_msfc(k,msfc) = 0.5_r8 * ( qt_au(m) + qt_aut(m) ) * ( dpa(m) / dp_m ) + um_u_msfc(k,msfc) = 0.5_r8 * ( u_au(m) + u_aut(m) ) * ( dpa(m) / dp_m ) + vm_u_msfc(k,msfc) = 0.5_r8 * ( v_au(m) + v_aut(m) ) * ( dpa(m) / dp_m ) + do mt = 1, ncnst + trm_u_msfc(k,msfc,mt) = 0.5_r8 * ( tr_au(m,mt) + tr_aut(m,mt) ) * ( dpa(m) / dp_m ) + enddo + am_u(k) = am_u(k) + am_u_msfc(k,msfc) + qlm_u(k) = qlm_u(k) + am_u_msfc(k,msfc) * qlm_u_msfc(k,msfc) + qim_u(k) = qim_u(k) + am_u_msfc(k,msfc) * qim_u_msfc(k,msfc) + thlm_u(k) = thlm_u(k) + am_u_msfc(k,msfc) * thlm_u_msfc(k,msfc) + qtm_u(k) = qtm_u(k) + am_u_msfc(k,msfc) * qtm_u_msfc(k,msfc) + um_u(k) = um_u(k) + am_u_msfc(k,msfc) * um_u_msfc(k,msfc) + vm_u(k) = vm_u(k) + am_u_msfc(k,msfc) * vm_u_msfc(k,msfc) + do mt = 1, ncnst + trm_u(k,mt) = trm_u(k,mt) + am_u_msfc(k,msfc) * trm_u_msfc(k,msfc,mt) + enddo + enddo + if( am_u(k) .gt. nonzero ) then + qlm_u(k) = qlm_u(k) / am_u(k) + qim_u(k) = qim_u(k) / am_u(k) + thlm_u(k) = thlm_u(k) / am_u(k) + qtm_u(k) = qtm_u(k) / am_u(k) + um_u(k) = um_u(k) / am_u(k) + vm_u(k) = vm_u(k) / am_u(k) + do mt = 1, ncnst + trm_u(k,mt) = trm_u(k,mt) / am_u(k) + enddo + else + ! Sep.16.2011. Below is not anomaly but total field. Thus, in order to reduce any + ! potential bias grow later, I entered grid-mean value instead of zero. + qlm_u(k) = 0._r8 + qim_u(k) = 0._r8 + thlm_u(k) = thl0(k) + qtm_u(k) = qt0(k) + um_u(k) = u0(k) + vm_u(k) = v0(k) + do mt = 1, ncnst + trm_u(k,mt) = tr0(k,mt) + enddo + endif + + ! ----------------------------------------------------------------------------- ! + ! Jul.26.2011. ! + ! Save all the convective updraft properties at each model interface and at the ! + ! cumulus top ( i.e., in the cumulus top layer in each 'm' segment, the value ! + ! at the cumulus top not the value at the top interface of cumulus top layer is ! + ! saved ) for future use. For example, this can be used as alternative mixing ! + ! environmental value for convective downdraft. ! + ! Note that at the cumulus top, I set 'w_aut(m)=0, cmf_aut(m)>0' and ! + ! 'a_aut(m) = a_au(m), num_aut(m) = num_au(m), rad_aut(m) = rad_au(m)'. ! + ! ----------------------------------------------------------------------------- ! + + do m = 1, N_up(km) + msfc = msfc_from_m(k,m) + thl_u_msfc(k,msfc) = thl_aut(m) + qt_u_msfc(k,msfc) = qt_aut(m) + u_u_msfc(k,msfc) = u_aut(m) + v_u_msfc(k,msfc) = v_aut(m) + w_u_msfc(k,msfc) = w_aut(m) + ql_u_msfc(k,msfc) = ql_aut(m) + qi_u_msfc(k,msfc) = qi_aut(m) + do mt = 1, ncnst + tr_u_msfc(k,msfc,mt) = tr_aut(m,mt) + enddo + cmf_u_msfc(k,msfc) = cmf_aut(m) + a_u_msfc(k,msfc) = a_aut(m) + num_u_msfc(k,msfc) = num_aut(m) + rad_u_msfc(k,msfc) = rad_aut(m) + if( k .eq. 1 ) then + thl_u_msfc(km,msfc) = thl_au(m) + qt_u_msfc(km,msfc) = qt_au(m) + u_u_msfc(km,msfc) = u_au(m) + v_u_msfc(km,msfc) = v_au(m) + w_u_msfc(km,msfc) = w_au(m) + ql_u_msfc(km,msfc) = ql_au(m) + qi_u_msfc(km,msfc) = qi_au(m) + do mt = 1, ncnst + tr_u_msfc(km,msfc,mt) = tr_au(m,mt) + enddo + cmf_u_msfc(km,msfc) = cmf_au(m) + a_u_msfc(km,msfc) = a_au(m) + num_u_msfc(km,msfc) = num_au(m) + rad_u_msfc(km,msfc) = rad_au(m) + endif + enddo + + ! -------------------------------------------------------------------- ! + ! Re-allocate updraft segment values for computation in the next layer ! + ! Assign the array only to the non-detached updraft. ! + ! Mar.12.2013. Add 'S_b_ql_au(mm),S_b_qi_au(mm)' parts. ! + ! -------------------------------------------------------------------- ! + + mm = 0 + do m = 1, N_up(km) + if( ytop(m) .gt. 0.5_r8 ) then + mm = mm + 1 + cmf_au(mm) = cmf_aut(m) + a_au(mm) = a_aut(m) + num_au(mm) = num_aut(m) + rad_au(mm) = rad_aut(m) + thl_au(mm) = thl_aut(m) + qt_au(mm) = qt_aut(m) + u_au(mm) = u_aut(m) + v_au(mm) = v_aut(m) + w_au(mm) = w_aut(m) + ql_au(mm) = ql_aut(m) + qi_au(mm) = qi_aut(m) + thv_au(mm) = thv_aut(m) + do mt = 1, ncnst + tr_au(mm,mt) = tr_aut(m,mt) + enddo + S_b_ql_au(mm) = S_t_ql_au(m) + S_b_qi_au(mm) = S_t_qi_au(m) + endif + enddo + + ! -------------------------- ! + ! Identify Cumulus Top Layer ! + ! -------------------------- ! + + if( nseg_nondet .lt. 0.5_r8 ) then + ktop = k + cnt = real(k,r8) + ! --------------------------------------------------------------------------------- ! + ! Aug.02.2011. It seems to be more reasonable to set cnb = real(0,r8) instead of 1 ! + ! This should be done later. ! + ! --------------------------------------------------------------------------------- ! + cnb = real(1,r8) + cush_mxen(iter) = pblhz + do mm = 1, N_up(ktop-1) + cush_mxen(iter) = max( cush_mxen(iter), ztops(ktop,mm) ) + enddo + goto 50 + endif + + enddo ! k = 1, mkx - 1. Here, 'k' is a layer index. + +50 continue + + ! ------------------------------------------------------ ! + ! Assign updraft top layer index to 'ktop_mxen' variable ! + ! ------------------------------------------------------ ! + + ktop_mxen(iter) = ktop + + ! --------------------------------------------------------------------- ! + ! Compute mean-cumulus top height weighted by updraft mass flux ! + ! at surface. This quantity will be used for computing cridis_in ! + ! at the next time step instead of cush. ! + ! Sep.22.2011. Note that 'Pmu(m)' does not include the 'delta_w_PBL'. ! + ! However, since 'delta_w_PBL' is added uniformly all over ! + ! the 'm' segments, below computation of 'cushavg_mxen' is ! + ! completely correct. Note that below block is the only ! + ! part of the whole program to explicitly use the 'Pmu' ! + ! except the computation of 'cmf_au(m)' at surface. ! + ! Sep.21.2011. Now, by re-defining 'Pmu(m)' above, below computation of ! + ! cushavg_mxen is perfectly correct ! + ! without any modification. ! + ! --------------------------------------------------------------------- ! + + tmp1 = 0._r8 + cushavg_mxen(iter) = 0._r8 + do m = 1, nseg + tmp1 = tmp1 + Pmu(m) + cushavg_mxen(iter) = cushavg_mxen(iter) + ztop_msfc(m) * Pmu(m) + enddo + cushavg_mxen(iter) = max( cushavg_mxen(iter) / tmp1, pblhz ) + + ! ------------------------------------------- ! + ! ! + ! Vertical Evolution of Individual Downdrafts ! + ! ! + ! ------------------------------------------- ! + + rbuoy_dn = 0.5_r8 * ( rbuoy_min + rbuoy_max ) + + do msfc = 1, nseg ! This 'msfc' is updraft segment index at surface. + + ! -------------------------------------------------------------------------- ! + ! Initialization of Downdraft Sources in Each Layer for Each Updraft Segment ! + ! Mar.11.2013. Add initialization of evaporation rate at the top interface. ! + ! -------------------------------------------------------------------------- ! + + cmf_d_src(1:mkx,1:3) = 0._r8 + thl_d_src(1:mkx,1:3) = 0._r8 + qt_d_src(1:mkx,1:3) = 0._r8 + u_d_src(1:mkx,1:3) = 0._r8 + v_d_src(1:mkx,1:3) = 0._r8 + w_d_src(1:mkx,1:3) = 0._r8 + tr_d_src(1:mkx,1:3,1:ncnst) = 0._r8 + ql_d_src(1:mkx,1:3) = 0._r8 + qi_d_src(1:mkx,1:3) = 0._r8 + fevp1_t_rate_src(1:mkx,1:3) = 0._r8 + fevp2_t_rate_src(1:mkx,1:3) = 0._r8 + ix_d_src(1:mkx,1:3) = 0 + + ! ------------------------------------------------------------------------------------------------------- ! + ! Compute the location (x_um_msfc(k,msfc),y_um_msfc(k,msfc) in unit of [m]) of convective updraft center ! + ! at the layer mid-point relative to the convective updraft center at surface ! + ! using the profiles of (u,v,w) of convective updraft. ! + ! Note that 'u_u_msfc, v_u_msfc, w_u_msfc' in the k = ktop_msfc is defined at the cumulus ! + ! top not at the top interface. Thus, my below computation is perfectly correct. ! + ! Note that this computation goes from the bottom to the cumulus top layer, so that I should use separate ! + ! vertical loop here from the lowest to the cumulus top layer. ! + ! ------------------------------------------------------------------------------------------------------- ! + tmpx_bot = 0._r8 + tmpy_bot = 0._r8 + do k = 1, ktop_msfc(msfc) ! This is a layer index + km = k - 1 + if( k .eq. ktop_msfc(msfc) ) then + tmp3 = ztop_msfc(msfc) - zs0(km) + else + tmp3 = dz0(k) + endif + tmp1 = tmp3 / ( 0.5_r8 * ( w_u_msfc(k,msfc) + w_u_msfc(km,msfc) ) ) + tmpx_top = tmpx_bot + 0.5_r8 * ( u_u_msfc(k,msfc) - u_u_msfc(km,msfc) ) * tmp1 + tmpy_top = tmpy_bot + 0.5_r8 * ( v_u_msfc(k,msfc) - v_u_msfc(km,msfc) ) * tmp1 + x_um_msfc(k,msfc) = 0.5_r8 * ( tmpx_bot + tmpx_top ) + y_um_msfc(k,msfc) = 0.5_r8 * ( tmpy_bot + tmpy_top ) + tmpx_bot = tmpx_top + tmpy_bot = tmpy_top + end do + + ! --------------------------------------------------- ! + ! ! + ! Start of Downdraft Vertical Evolution in Each Layer ! + ! ! + ! --------------------------------------------------- ! + + do k = ktop_msfc(msfc), 1, -1 ! This 'k' is a layer index where vertical evolution of downdraft is computed. + + km = k - 1 + + ! ---------------------------------------------------------------------------------------------------- ! + ! Define non-array 'rain/snow/tracer fluxes at the top interface for use in various computations below ! + ! both for 'grid-mean' and 'in-precipitation-area' values. ! + ! ---------------------------------------------------------------------------------------------------- ! + + flxrain_top = flxrain_msfc(k,msfc) + flxsnow_top = flxsnow_msfc(k,msfc) + flxrasn_top = flxrain_top + flxsnow_top + + flxrain_top_in = flxrain_top / max( nonzero, a_p_msfc(k,msfc) ) + flxsnow_top_in = flxsnow_top / max( nonzero, a_p_msfc(k,msfc) ) + flxrasn_top_in = flxrain_top_in + flxsnow_top_in + + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + flxtrrs_top(mt) = flxrain_top + elseif( mt .eq. ixcldice ) then + flxtrrs_top(mt) = flxsnow_top + elseif( mt .eq. ixnumliq ) then + flxtrrs_top(mt) = flxrain_top * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + flxtrrs_top(mt) = flxsnow_top * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_snow**3 * density_snow ) + else + flxtrrs_top(mt) = flxtrrs_msfc(k,msfc,mt) + endif + enddo + + ! -------------------------------------------------------------------------------------------- ! + ! Compute various areas to compute ! + ! 1. Production of convective precipitation by accretion within convective updraft ! + ! 2. Evaporation of convective precipitation within environment ! + ! Below simply assumes that downdraft fractional area is zero for this purpose ( a_pd = 0. ). ! + ! In order to compute accretion rate, we should use ! + ! (a) a_pu : Overlapping area between precipitation area ( a_p_msfc(k,msfc) ) and ! + ! saturated updraft fractional area ( am_us_msfc(k,msfc) ), ! + ! (b) flxrain_top_in, flxsnow_top_in : Precipitation flux averaged over the ! + ! precipitation area (not the grid-mean) at the top interface, ! + ! (c) qlm_u_msfc(k,msfc), qim_u_msfc(k,msfc), trm_u_msfc(k,msfc,mt) : ! + ! In-cumulus properties. ! + ! Note 'a_p = a_pu + a_pd + a_pr + a_ps' and independent precipitation approximation is used, ! + ! so that in computing these overlapping areas, we really don't need to worry about the other ! + ! cumulus updraft segment' contribution. ! + ! ! + ! Feb.09.2013. In computing 'a_pu' below, change 'am_us_msfc' to 'am_u_msfc' since evaporation ! + ! of precipitation is computed within the subroutine 'prod_prep_up' above. ! + ! Thus, here, we should only consider what is happening within environment and ! + ! downdraft, not within updraft regardless whether updraft is saturated or not. ! + ! -------------------------------------------------------------------------------------------- ! + + am_s(k) = ast0(k) + if( ( am_u(k) + ast0(k) ) .gt. 1._r8 ) am_s(k) = 1._r8 - am_u(k) + am_r(k) = 1._r8 - am_u(k) - am_s(k) + + am_us_msfc(k,msfc) = am_u_msfc(k,msfc) + if( ( qlm_u_msfc(k,msfc) + qim_u_msfc(k,msfc) ) .le. 0._r8 ) am_us_msfc(k,msfc) = 0._r8 + + a_pu = area_overlap( x_p_msfc(k,msfc), y_p_msfc(k,msfc), a_p_msfc(k,msfc), & + !j x_um_msfc(k,msfc), y_um_msfc(k,msfc), am_u_msfc(k,msfc), & + x_um_msfc(k,msfc), y_um_msfc(k,msfc), am_us_msfc(k,msfc), & + num_u_msfc(0,msfc) ) + a_pd = 0._r8 + a_pr = ( a_p_msfc(k,msfc) - a_pu - a_pd ) * am_r(k) / ( am_r(k) + am_s(k) ) ! Advanced. + a_ps = ( a_p_msfc(k,msfc) - a_pu - a_pd ) * am_s(k) / ( am_r(k) + am_s(k) ) ! Advanced. + a_evp = a_pr + + am_evp_msfc(k,msfc) = a_evp + am_pu_msfc(k,msfc) = a_pu + am_pd_msfc(k,msfc) = a_pd + am_pr_msfc(k,msfc) = a_pr + am_ps_msfc(k,msfc) = a_ps + + ! ---------------------------------------------------------------------------------------------------------------------- ! + ! Compute evaporation of rain/snow within environment ( evprain_e_msfc(k,msfc), evpsnow_e_msfc(k,msfc) >= 0. [kg/kg/s] ) ! + ! ---------------------------------------------------------------------------------------------------------------------- ! + + ! Apr.15.2014. Recalculate 'qv_clr' using the normalized stratus fraction instead of using + ! the below original formula based on physical stratus fraction. + call qsat( t0(k), p0(k), es, qs ) + tmp1 = am_s(k) / ( 1._r8 - am_u(k) ) + qv_clr = max( nonzero, qv0(k) - tmp1 * qs ) / max( nonzero, 1._r8 - tmp1 ) + ! qv_clr = max( nonzero, qv0(k) - am_s(k) * qs ) / max( nonzero, 1._r8 - am_s(k) ) + qv_clr = min( min( qv_clr, qv0(k) ), qs ) + subsat_clr = min( 1._r8, max( 0._r8, 1._r8 - qv_clr / max( qs, nonzero ) ) ) + call findsp_single( qv_clr, t0(k), p0(k), tw, qw_clr, i, k, lchnk ) + evplimit_clr = max( 0._r8, ( qw_clr - qv_clr ) / dt ) + + evprain_clr = kevp_rain * subsat_clr * sqrt( max( 0._r8, flxrain_top_in ) ) + evpsnow_clr = kevp_snow * subsat_clr * sqrt( max( 0._r8, flxsnow_top_in ) ) + + evplimit_clr_rain = flxrain_top_in * g / dp0(k) ! New. Perfect. + evplimit_clr_snow = flxsnow_top_in * g / dp0(k) ! New. Perfect. + + evprain_clr = min( evprain_clr, evplimit_clr_rain ) + evpsnow_clr = min( evpsnow_clr, evplimit_clr_snow ) + if( ( evprain_clr + evpsnow_clr ) .lt. ( - qv0(k) / dt / max( nonzero, a_evp ) ) ) then + call endrun('UNICON : Impossible correction of precipitation generation') + endif + if( ( evprain_clr + evpsnow_clr ) .gt. evplimit_clr ) then + if( evprain_clr .ge. 0._r8 .and. evpsnow_clr .ge. 0._r8 ) then + tmp1 = evprain_clr * evplimit_clr / ( evprain_clr + evpsnow_clr ) + tmp2 = evpsnow_clr * evplimit_clr / ( evprain_clr + evpsnow_clr ) + evprain_clr = tmp1 + evpsnow_clr = tmp2 + elseif( evprain_clr .lt. 0._r8 ) then + evpsnow_clr = evplimit_clr - evprain_clr + elseif( evpsnow_clr .lt. 0._r8 ) then + evprain_clr = evplimit_clr - evpsnow_clr + else + call endrun('UNICON : Impossible case in Limit 1a') + endif + endif + + evprain_e_msfc(k,msfc) = evprain_clr * a_evp + evpsnow_e_msfc(k,msfc) = evpsnow_clr * a_evp + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + evptrrs_e_msfc(k,msfc,mt) = - evprain_e_msfc(k,msfc) + elseif( mt .eq. ixcldice ) then + evptrrs_e_msfc(k,msfc,mt) = - evpsnow_e_msfc(k,msfc) + elseif( mt .eq. ixnumliq ) then + evptrrs_e_msfc(k,msfc,mt) = - evprain_e_msfc(k,msfc) * 3._r8 / & + ( 4._r8 * 3.141592_r8 * droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + evptrrs_e_msfc(k,msfc,mt) = - evpsnow_e_msfc(k,msfc) * 3._r8 / & + ( 4._r8 * 3.141592_r8 * droprad_snow**3 * density_snow ) + else + evptrrs_e_msfc(k,msfc,mt) = - flxtrrs_top(mt) * ( ( evprain_e_msfc(k,msfc) + & + evpsnow_e_msfc(k,msfc) ) / max( flxrasn_top, nonzero ) ) + endif + enddo + + ! ------------------------------------------------------------------------------------ ! + ! Compute wet deposition of aerosols within denvironment. ! + ! Feb.05.2013. Below wet deposition tendency within updraft should be updated later ! + ! possibly, in combination with the treatment of accretion process. ! + ! Note that wet deposition only influences tracers not cloud condensate. ! + ! If I turn-on this in future, wet deposition by convective precipitation ! + ! in the separate wet deposition routine should be turned-off. ! + ! ------------------------------------------------------------------------------------ ! + + do mt = 1, ncnst + if( mt .eq. 1 .or. mt .eq. ixcldliq .or. mt .eq. ixcldice .or. mt .eq. ixnumliq .or. mt .eq. ixnumice ) then + wdeptrrs_e_msfc(k,msfc,mt) = 0._r8 + else + wdeptrrs_e_msfc(k,msfc,mt) = 0._r8 + endif + enddo + + ! --------------------------------------------------------------------------------- ! + ! Compute ! + ! Precipitation flux at the base interface by adding evaporation within environment ! + ! Note that until the full 2-moment microphysics are implemented, I will ! + ! assume a fixed droplet size of rain and snow. ! + ! Note that wet deposition does not affect condensate but only influences tracers. ! + ! Mar.05.2013. For computing the location of precipitation area (x_p, y_p) at the ! + ! base interface and for diagnostic purpose, compute ! + ! the 'flxrain(snow)_bot_up' and 'flxrain(snow)_bot_ee'. ! + ! Note that it is guaranteed that 'flxrain(snow)_bot_ee >= 0' ! + ! since 'evprain(snow)_e_msfc' were computed from 'flxrain_top_in' ! + ! which is perfectly good. ! + ! --------------------------------------------------------------------------------- ! + + flxrain_bot_ee = flxrain_top - evprain_e_msfc(k,msfc) * ( dp0(k) / g ) + flxsnow_bot_ee = flxsnow_top - evpsnow_e_msfc(k,msfc) * ( dp0(k) / g ) + + flxrain_bot_upee = flxrain_top + ( qrten_u_msfc(k,msfc) - evprain_e_msfc(k,msfc) ) * ( dp0(k) / g ) + flxsnow_bot_upee = flxsnow_top + ( qsten_u_msfc(k,msfc) - evpsnow_e_msfc(k,msfc) ) * ( dp0(k) / g ) + + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + flxtrrs_bot_upee(mt) = flxrain_bot_upee + elseif( mt .eq. ixcldice ) then + flxtrrs_bot_upee(mt) = flxsnow_bot_upee + elseif( mt .eq. ixnumliq ) then + flxtrrs_bot_upee(mt) = flxrain_bot_upee * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + flxtrrs_bot_upee(mt) = flxsnow_bot_upee * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_snow**3 * density_snow ) + else + flxtrrs_bot_upee(mt) = flxtrrs_top(mt) + ( trrsten_u_msfc(k,msfc,mt) + evptrrs_e_msfc(k,msfc,mt) + & + wdeptrrs_e_msfc(k,msfc,mt) ) * ( dptr0(k,mt) / g ) + endif + enddo + + ! ------------------------------------------------------------------------------------------------------- ! + ! Snow Melting at the Base Interface ( snowmlt_e_msfc(k,msfc) >= 0. [kg/kg/s] ) ! + ! Since snow melting changes droplet number within precipitation, I should perform updated computation of ! + ! droplet numbers and mass of precipitation. ! + ! Note that below assume that snow melting does not change the other tracers concentration as expected. ! + ! ------------------------------------------------------------------------------------------------------- ! + + if( t0(k) .ge. 273.15_r8 ) then + snowmlt_e_msfc(k,msfc) = max( 0._r8, unity * flxsnow_bot_upee * g / dp0(k) ) + else + snowmlt_e_msfc(k,msfc) = 0._r8 + endif + flxrain_bot_upeesm = max( 0._r8, flxrain_bot_upee + snowmlt_e_msfc(k,msfc) * dp0(k) / g ) + flxsnow_bot_upeesm = max( 0._r8, flxsnow_bot_upee - snowmlt_e_msfc(k,msfc) * dp0(k) / g ) + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + flxtrrs_bot_upeesm(mt) = flxrain_bot_upeesm + elseif( mt .eq. ixcldice ) then + flxtrrs_bot_upeesm(mt) = flxsnow_bot_upeesm + elseif( mt .eq. ixnumliq ) then + flxtrrs_bot_upeesm(mt) = flxrain_bot_upeesm * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + flxtrrs_bot_upeesm(mt) = flxsnow_bot_upeesm * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_snow**3 * density_snow ) + else + flxtrrs_bot_upeesm(mt) = flxtrrs_bot_upee(mt) + endif + enddo + + ! ---------------------------------------------------------------------------------------------------------------------- ! + ! Compute precipitation area at the base interface ( a_p_msfc(km,msfc) ) ! + ! While 'the location of the center of precipitation area ( x_p_msfc(km,msfc), y_p_msfc(km,msfc) )' are computed later ! + ! after doing evaporation of precipitation within downdraft, I should compute 'a_p_msfc(km,msfc)' here before ! + ! computing evaporation of precipitation within downdraft since that computation requires ! + ! the use of 'a_p_msfc(km,msfc)'. This is completely correct approach assuming that evaporation ! + ! within downdraft at the base interface does not completely evaporate 'flxrain_bot_upeesm', which is ! + ! grauanteed by setting 'eta2' smaller than 1. ! + ! ---------------------------------------------------------------------------------------------------------------------- ! + + am_up_msfc(k,msfc) = am_u_msfc(k,msfc) + if( ( qrten_u_msfc(k,msfc) + qsten_u_msfc(k,msfc) ) .le. 0._r8 ) am_up_msfc(k,msfc) = 0._r8 + a_ovp = area_overlap( x_p_msfc(k,msfc), y_p_msfc(k,msfc), a_p_msfc(k,msfc), & + x_um_msfc(k,msfc), y_um_msfc(k,msfc), am_up_msfc(k,msfc), & + num_u_msfc(0,msfc) ) + if( ( flxrasn_top_in - nonzero ) .le. ( evprain_clr + evpsnow_clr ) * dp0(k) / g ) then + a_p_msfc(km,msfc) = a_p_msfc(k,msfc) - a_evp + am_up_msfc(k,msfc) - a_ovp + else + a_p_msfc(km,msfc) = a_p_msfc(k,msfc) + am_up_msfc(k,msfc) - a_ovp + endif + if( ( flxrain_bot_upeesm + flxsnow_bot_upeesm ) .le. 0._r8 ) a_p_msfc(km,msfc) = 0._r8 + a_p_msfc(km,msfc) = max( 0._r8, min( 1._r8, a_p_msfc(km,msfc) ) ) + + ! ---------------------------------------------------------------------------------------------- ! + ! Initialize ! + ! ! + ! flxrain_bot = flxrain_bot_upeesm ! + ! flxsnow_bot = flxsnow_bot_upeesm ! + ! ! + ! where the final precipitation fluxes ( flxrain_bot, flxsnow_bot ) will be continuously updated ! + ! within the individual downdraft loop ( do ks = ktop, k, -1, do ids = 1, 3 ) below, eventually ! + ! getting the final precipitation flux at the bottom interface. ! + ! ---------------------------------------------------------------------------------------------- ! + + flxrain_bot = flxrain_bot_upeesm + flxsnow_bot = flxsnow_bot_upeesm + do mt = 1, ncnst + flxtrrs_bot(mt) = flxtrrs_bot_upeesm(mt) + enddo + + ! ------------------------------------------------------- ! + ! Define downdraft sources generated in the current layer ! + ! ------------------------------------------------------- ! + + do ids = 1, 3 ! This 'ids' is the type of downdraft source ( 1 : Mixing downdraft, 2 : Top downdraft, 3 : Constraint downdraft ) + ! ----------------------------------------------------------------------------------------------------------------- ! + ! m_from_msfc(k,msfc) : Convert updraft segment index at surface into shortened-updraft segment index in each layer ! + ! Since computation is done from k = 'ktop = ktop_msfc(msfc)' to 'k = 1' for each 'msfc', ! + ! it is always grauanteed that 'm' is a positive integer ( m > 0 ). Thus, below computation ! + ! is perfectly OK - if not, it will stop due to indexing error. ! + ! Be careful : I should use index 'k' not 'ks' in the below block since in this case index 'k' denotes source layer ! + ! ----------------------------------------------------------------------------------------------------------------- ! + m = m_from_msfc(k,msfc) + ix_d_src(k,ids) = 1 + cmf_d_src(k,ids) = f_srcds(k,m,ids) * cmf_u(km) + thl_d_src(k,ids) = thl_srcds(k,m,ids) + qt_d_src(k,ids) = qt_srcds(k,m,ids) + u_d_src(k,ids) = u_srcds(k,m,ids) + v_d_src(k,ids) = v_srcds(k,m,ids) + w_d_src(k,ids) = 0._r8 + do mt = 1, ncnst + tr_d_src(k,ids,mt) = tr_srcds(k,m,ids,mt) + enddo + ql_d_src(k,ids) = ql_srcds(k,m,ids) + qi_d_src(k,ids) = qi_srcds(k,m,ids) + ! ---------------------------------------------------------------------------------------------- ! + ! Mar.11.2013. Add initialization of evaporation rate at the top interface ! + ! Since below two variables are already initialized to zero above, ! + ! below initialization is redundant. However, for clearness of the model structure, ! + ! let's initialize again - it is no harm at all. ! + ! ---------------------------------------------------------------------------------------------- ! + fevp1_t_rate_src(k,ids) = 0._r8 + fevp2_t_rate_src(k,ids) = 0._r8 + ! Note that I am using 'nonzero=1.e-20' instead of 'cmfmin=1.e-5' below, since downdraft sources generated + ! in the current layer should go through vertical downward evolution and detrainment at the base interface + ! by the detrainment criteria. If I use 'cmfmin' here, those downdraft source with 'cmf_d_src < cmfmin' + ! cannot be detrained. + if( cmf_d_src(k,ids) .lt. nonzero ) then ! No downdraft source in this layer + ix_d_src(k,ids) = 0 + cmf_d_src(k,ids) = 0._r8 + endif + enddo + + ! ---------------------------------------------------------------------------------------------------------------- ! + ! Compute total number of downdrafts (ndb_evp) that will be used for computating ! + ! evaporation of convective precipitation at the base interface of current layer. ! + ! Although mixing downdraft generated in the current layer ( cmf_d_src(k,1) ) will not evaporate convective ! + ! precipitation due to zero displacement diatance (i.e., the source level of mixing downdraft in the current layer ! + ! is pt = ps0(km) ), I am including this contribution in computing 'ndb_evp >= 0'. ! + ! Note that ndb_evp = 0 is also possible, for example in the lowest model layer. However, in that case, ! + ! below constraint of 'goto 20 if ix_d_src(ks,ids) .eq. 0' will prevent division by zero within the main ! + ! computation part later. Thus, it is completely OK. ! + ! Mar.18.2013. Do not perform evaporation of precipitation within 'constraint' downdraft which is a numerical not ! + ! physical downdraft. This removal of 'constraint' downdraft in treating evaporation may also help to ! + ! reduce sensitivity to vertical resolution. Also neglect evaporation within 'top downdraft' since ! + ! geometrically, convective precipitation is below top downdraft. ! + ! removing these 'constraint' and 'top' downdrafts in doing evaporation of precipitation will also ! + ! help to reduce PREH20, which is extremely good. ! + ! Mar.18.2013. In order to remove the contribution of mixing downdraft generated in the current layer, I changed ! + ! I changed 'do ks = ktop_msfc(msfc), k, -1' to ' do ks = ktop_msfc(msfc), k + 1, -1', which ! + ! should not do anything when 'ktop_msfc(msfc) = k' by construction. ! + ! ---------------------------------------------------------------------------------------------------------------- ! + + ! Mar.17.2014. Since 'cmf_d_src(ks,1)' is the mass flux at the top interface of current 'k' layer, while + ! the limitation of of evaporation within downdraft with 'evap_prep_dn' is imposed at the + ! base interface, I multiplied 'tmp3' to the 'cmf_d_src(ks,1)' to compute downdraft mass + ! flux at the base interface of curent layer, 'k'. + ! Also note that I decided to exclude the mixing downdraft generated in the current layer 'k' + ! by using 'ks = ktop_msfc(msfc), k + 1, -1' instead of 'ks = ktop_msfc(msfc), k, -1' since + ! evaporation does not occur in the mixing downdraft generated in the 'k' layer. Note that + ! this 'cmfdb_evp, ndb_evp' are used as ONLY THE LIMITER not for computing the actual + ! evaporation rate within the downdraft. Thus below my computation is completely correct. + ! Note that we should only treat 'mixing downdraft', not 'top, constrained' downdrafts for + ! treating evaporation of precipitation within downdraft. If we want to include 'top, constrained + ! downdrafts, some portion of the codes (i.e., dz and dp in the below, and 'evap_prep_dn') should + ! be consistently modified. + + ndb_evp = 0 + cmfdb_evp = 0._r8 + rho = 0.5_r8 * ( rho0top(k) + rho0bot(k) ) + dz = zs0(k) - zs0(km) + dp = ps0(km) - ps0(k) + eps_dn = epsz_dn / ( rho * g ) + del_dn = delz_dn / ( rho * g ) + if( exp_cmf .eq. 1 ) then + tmp1 = eps_dn - del_dn + tmp2 = min( tmp1, log( 1._r8 + epsz0_max * dz ) / max( dp, nonzero ) ) + if( abs( tmp2 - tmp1 ) .ge. nonzero ) then ! Constraint is imposed. + eps_dn = eps_dn * ( tmp2 / tmp1 ) + del_dn = del_dn * ( tmp2 / tmp1 ) + endif + tmp3 = exp( dp * ( eps_dn - del_dn ) ) + elseif( exp_cmf .eq. 2 ) then + tmp3 = max( 0._r8, 1._r8 + dp * ( eps_dn - del_dn ) ) + endif + do ks = ktop_msfc(msfc), k + 1, -1 ! This 'ks' is a layer index where downdraft sources are generated. + if( ix_d_src(ks,1) .eq. 1 ) then + ndb_evp = ndb_evp + 1 + cmfdb_evp = cmfdb_evp + cmf_d_src(ks,1) * tmp3 + endif + enddo + + ! ---------------------------------------------------------------------------------------------------- ! + ! Compute vertical evolution of individual downdraft from the top interface (or top of each downdraft) ! + ! to the base interface within the given layer. ! + ! ---------------------------------------------------------------------------------------------------- ! + + do ks = ktop_msfc(msfc), k, -1 ! This 'ks' is a layer index where downdraft sources are generated. + + ! ------------------------------------------------------------------------------------------- ! + ! Convert updraft segment index at surface into shortened-updraft segment index in each layer ! + ! ------------------------------------------------------------------------------------------- ! + + m = m_from_msfc(ks,msfc) + + do ids = 1, 3 ! This 'ids' is the type of downdraft source ( 1 : Mixing downdraft, 2 : Top downdraft, 3 : Constraint downdraft ) + + ! ----------------------------------------------------------------------------------------- ! + ! Define downdraft properties at the downdraft 'top'. ! + ! Perform downward evolution only for the surviving (existing) downdraft ! + ! in the current layer. ! + ! Be careful : I should use index 'ks' not 'k' in the below block since all the source ! + ! variables of downdraft ( cmf_d_src(ks,ids), thl_d_src(ks,ids), ... ) are defined with the ! + ! layer index of 'origination layer' ( 'ks' ), whose values however are continuously ! + ! updated in each layer as downdraft moves down into the layers below. ! + ! ----------------------------------------------------------------------------------------- ! + if( ix_d_src(ks,ids) .eq. 1 ) then + cmf_dt = cmf_d_src(ks,ids) + thl_dt = thl_d_src(ks,ids) + qt_dt = qt_d_src(ks,ids) + u_dt = u_d_src(ks,ids) + v_dt = v_d_src(ks,ids) + w_dt = w_d_src(ks,ids) + do mt = 1, ncnst + tr_dt(mt) = tr_d_src(ks,ids,mt) + enddo + ql_dt = ql_d_src(ks,ids) + qi_dt = qi_d_src(ks,ids) + ! ------------------------------------------------------------------------ ! + ! Mar.11.2013. Add initialization of evaporation rate at the top interface ! + ! ------------------------------------------------------------------------ ! + fevp1_t_rate = fevp1_t_rate_src(ks,ids) + fevp2_t_rate = fevp2_t_rate_src(ks,ids) + else + cmf_d_src(ks,ids) = 0._r8 + ix_d_src(ks,ids) = 0 + goto 20 + endif + ! ------------------------------------------------------------------------------ ! + ! Define mean properties at the downdraft 'top' ! + ! Here, 'top' is defined as the level where downdraft starts its downward motion ! + ! in each layer. When 'k = ks', 'top' is defined in a different way depending on ! + ! whether the source of downdraft is 'mixing downdraft', 'top downdraft' ! + ! and 'area downdraft'. ! + ! Mar.07.2013. Define 'thv_mean_t' and 'thv_mean_b' by including updraft as well ! + ! as environment for use in computing vertical evolution of ! + ! downdraft vertical velocity, simular to convective updraft. ! + ! Note that we are simply assuming that downdraft fractional area ! + ! is zero, so that only updraft information is included in ! + ! computing 'thv_mean_t' and 'thv_mean_b' below. ! + ! This is for developing scale-adaptive parameterization even for ! + ! prognostic convection scheme in future. ! + ! Note we don't compute 'rho_mean_t, rho_mean_b' for simplicity. ! + ! ------------------------------------------------------------------------------ ! + p_t = ps0(k) + p_b = ps0(km) + z_t = zs0(k) + z_b = zs0(km) + thv_t = thv0top(k) + thv_b = thv0bot(k) + rho_t = rho0top(k) + rho_b = rho0bot(k) + thv_mean_t = a_u(k) * thva_u(k) + ( 1._r8 - a_u(k) ) * thv0top(k) + thv_mean_b = a_u(km) * thva_u(km) + ( 1._r8 - a_u(km) ) * thv0bot(k) + if( ks .eq. k ) then + if( ids .eq. 1 ) then ! Mixing Downdraft + p_t = ps0(km) + z_t = zs0(km) + elseif( ids .eq. 2 ) then ! Top Downdraft + p_t = ptops(k,m) + z_t = ztops(k,m) + else ! Constraint Downdraft + p_t = ps0(k) + z_t = zs0(k) + endif + p_t = min( p_t, ps0(km) ) + z_t = max( z_t, zs0(km) ) + thv_t = thv0bot(k) + ( p_t - ps0(km) ) * ( thv0top(k) - thv0bot(k) ) / ( ps0(k) - ps0(km) ) + rho_t = rho0bot(k) + ( p_t - ps0(km) ) * ( rho0top(k) - rho0bot(k) ) / ( ps0(k) - ps0(km) ) + thv_mean_t = thv_mean_b + ( p_t - ps0(km) ) * ( thv_mean_t - thv_mean_b ) / ( ps0(k) - ps0(km) ) + cmf_ad(k,ks,m,ids) = cmf_dt + thl_ad(k,ks,m,ids) = thl_dt + qt_ad(k,ks,m,ids) = qt_dt + u_ad(k,ks,m,ids) = u_dt + v_ad(k,ks,m,ids) = v_dt + w_ad(k,ks,m,ids) = w_dt + a_ad(k,ks,m,ids) = 0._r8 + do mt = 1, ncnst + tr_ad(k,ks,m,ids,mt) = tr_dt(mt) + enddo + ql_ad(k,ks,m,ids) = ql_dt + qi_ad(k,ks,m,ids) = qi_dt + endif + + call conden( p_t, thl_dt, qt_dt, th, qv, ql, qi, qse, id_check ) + th_dt = th + qv_dt = qv + ql_dt = ql + qi_dt = qi + thv_dt = th * ( 1._r8 + zvir * qv - ql - qi ) + bogtop = rbuoy_dn * ( 1._r8 - thv_dt / thv_mean_t ) + dp = p_b - p_t + dz = z_t - z_b + dpad(k,ks,m,ids) = dp + rho = 0.5_r8 * ( rho_t + rho_b ) + exn_b = exns0(km) + if( k .gt. 1 ) then + ! ----------------------------------- ! + ! Use different mu for each downdraft ! + ! ----------------------------------- ! + if( ids .eq. 1 ) then + mu = mu_mix + elseif( ids .eq. 2 ) then + mu = mu_top + elseif( ids .eq. 3 ) then + mu = mu_area + endif + tmp1 = ( 1._r8 - mu ) * thvl0top(km) + mu * thvl0bot(k) + tmp2 = ( 1._r8 - mu ) * thv0top(km) + mu * thv0bot(k) + thvl_minE = min( min( thvl0bot(k), thvl0top(k) ), tmp1 ) + thv_minE = min( min( thv0bot(k), thv0top(k) ), tmp2 ) + ! Apr.15.2014. Modified formula for thv_minE to obtain a reasonable solution when the mean inversion exists. + thv_minE = max( thv0top(km), tmp2 ) + ! Apr.15.2014. Modified formula for thv_minE + thvl_minE = thvl_minE + offset_minE + thv_minE = thv_minE + offset_minE + ! Mar.15.2014. For continuous buoyancy sorting in order to impose a stability in the code + ! and in order to minimize perturbation growth. + thv_max = max( thv0top(km), thv0bot(k) ) + thv_min = min( thv0top(km), thv0bot(k) ) + else + thvl_minE = -1.e8_r8 ! Always detrain downdraft in the lowest model layer after all diabatic forcings + thv_minE = -1.e8_r8 ! Always detrain downdraft in the lowest model layer after all diabatic forcings + ! Mar.15.2014. Below two lines are just a place holder. + thv_max = -1.e8_r8 + thv_min = -1.e8_r8 + endif + ! ------------------------------------------------------------------------------------ ! + ! Convert the unit of downdraft entrainment and detrainment rates from [1/z] to [1/Pa] ! + ! Jan.30.2013. Following the treatment of convective updraft, impose similar advanced ! + ! constraint on convective downdraft below. ! + ! Feb.06.2013. Always choose physically reasonable exp_cmf = 1 as of this day. ! + ! Nov.18.2013. Impose perfectly physical consistent limit. Only impose a upper limit ! + ! since we don't need to sorry about the decrease of downdraft mass flux ! + ! as downdraft moves down : we only need to worry about extremely huge ! + ! increase when downdraft moves down. ! + ! ------------------------------------------------------------------------------------ ! + eps_dn = epsz_dn / ( rho * g ) + del_dn = delz_dn / ( rho * g ) + tmp1 = eps_dn - del_dn + tmp2 = min( tmp1, log( 1._r8 + epsz0_max * dz ) / max( dp, nonzero ) ) + if( abs( tmp2 - tmp1 ) .ge. nonzero ) then ! Constraint is imposed. + eps_dn = eps_dn * ( tmp2 / tmp1 ) + del_dn = del_dn * ( tmp2 / tmp1 ) + endif + + cmf_db = cmf_dt * exp( dp * ( eps_dn - del_dn ) ) + ! ----------------------------------------------- ! + ! Update 'u_db,v_db' by diabatic horizontal PGF ! + ! Instead of using the gradient within the layer, ! + ! I should use the gradient between the layers. ! + ! ----------------------------------------------- ! + + ssu_tmp = ssu0(k) + ssv_tmp = ssv0(k) + u_med = u0bot(k) + ssu_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + v_med = v0bot(k) + ssv_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + + u_grdPGF = ssu0(k) + v_grdPGF = ssv0(k) + + call progup_uv( -eps_dn, PGFc_dn, p_t, p_b, u_med, ssu_tmp, u_grdPGF, u_dt, u_db ) + call progup_uv( -eps_dn, PGFc_dn, p_t, p_b, v_med, ssv_tmp, v_grdPGF, v_dt, v_db ) + + call progup_uv( -eps_dn, 0._r8, p_t, p_b, u_med, ssu_tmp, u_grdPGF, u_dt, u_db_adi ) + call progup_uv( -eps_dn, 0._r8, p_t, p_b, v_med, ssv_tmp, v_grdPGF, v_dt, v_db_adi ) + + PGF_u = u_db - u_db_adi + PGF_v = v_db - v_db_adi + + ! -------------------------------------------------------------------------- ! + ! ! + ! Update 'thl_db,qt_db' by diabatic evaporation of precipitation at the base ! + ! ! + ! -------------------------------------------------------------------------- ! + ! ----------------------------------------------------------------------- ! + ! 1. Evaporation of Precipitation ! + ! Also compute effective diabatic forcing before evaporation of precip ! + ! The effective forcing for tracers should be refined later by ! + ! considering 'evaporation-melting' especially for droplet numbers. ! + ! ----------------------------------------------------------------------- ! + + ssthl_tmp = ssthl0(k) + ssqt_tmp = ssqt0(k) + ssql_tmp = ssql0(k) + ssqi_tmp = ssqi0(k) + do mt = 1, ncnst + sstr_tmp(mt) = sstr0(k,mt) + enddo + thl_med = thl0bot(k) + ssthl_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + qt_med = qt0bot(k) + ssqt_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + ql_med = ql0bot(k) + ssql_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + qi_med = qi0bot(k) + ssqi_tmp * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + do mt = 1, ncnst + tr_med(mt) = tr0bot(k,mt) + sstr_tmp(mt) * ( 0.5_r8 * ( p_t + p_b ) - p_b ) + enddo + + call progup_thlqt( -eps_dn, 0._r8, 0._r8, p_t, p_b, thl_med, ssthl_tmp, thl_dt, thl_db ) + call progup_thlqt( -eps_dn, 0._r8, 0._r8, p_t, p_b, qt_med, ssqt_tmp, qt_dt, qt_db ) + call progup_thlqt( -eps_dn, 0._r8, 0._r8, p_t, p_b, ql_med, ssql_tmp, ql_dt, ql_db_adi ) + call progup_thlqt( -eps_dn, 0._r8, 0._r8, p_t, p_b, qi_med, ssqi_tmp, qi_dt, qi_db_adi ) + do mt = 1, ncnst + call progup_thlqt( -eps_dn, 0._r8, 0._r8, p_t, p_b, tr_med(mt), sstr_tmp(mt), tr_dt(mt), tr_db(mt) ) + enddo + + tr_db(ixnumliq) = ql_db_adi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + tr_db(ixnumice) = qi_db_adi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + + call conden( p_b, thl_db, qt_db, th, qv, ql, qi, qse, id_check ) + th_db = th + qs_db = qse + qv_db = qv + ql_db = ql + qi_db = qi + eff_ql = ql_db - ql_db_adi + eff_qi = qi_db - qi_db_adi + + ! ------------------------------------------------------------------------------------------------ ! + ! TRACERS REFINEMENT NECESSARY : ADIABATIC CONDENSATION-EVAPORATION-MELTING DURING VERTICAL MOTION ! + ! ------------------------------------------------------------------------------------------------ ! + do mt = 1, ncnst + if( mt .eq. ixnumliq ) then + eff_tr(mt) = eff_ql * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + eff_tr(mt) = eff_qi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + eff_tr(mt) = 0._r8 + endif + eff_tr(mt) = max( eff_tr(mt), qmin(mt) - tr_db(mt) ) + enddo + + ! ------------------------------------------------------------------------------------------------ ! + ! TRACERS REFINEMENT NECESSARY : ADIABATIC CONDENSATION-EVAPORATION-MELTING DURING VERTICAL MOTION ! + ! ------------------------------------------------------------------------------------------------ ! + + do mt = 1, ncnst + tr_db(mt) = tr_db(mt) + eff_tr(mt) + enddo + + ! -------------------------------------------------------------------------------------------------------------------- ! + ! Apr.17.2012. ! + ! Computation of (0) discrete numerical computation at the base interface or ! + ! (1) continuous analytical computation from the top to the base of convective downdraft in each layer, ! + ! of evaporation of convective precipitation within convective downdraft. ! + ! Note that the entire goal of below if block is to compute separate (numerical or analytical) 'evp_qtl' and 'evp_qti' ! + ! which are the resulting change of qt at the base interface [kg/kg] by the evaporation of convective rain and snow ! + ! within convective downdraft. ! + ! -------------------------------------------------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------------------------ ! + ! Mar.15.2013. All materials computing 'evp_qtl, evp_qtr' are incorporated into ! + ! the below subroutines of 'evap_prep_dn'. ! + ! Mar.18.2013. Perform evaporation only for 'mixing' downdraft. ! + ! Apr.09.2013. Add a switch to do an analytical integration of evaporation within downdraft ! + ! with 'iprpback = -1'. ! + ! ------------------------------------------------------------------------------------------ ! + + if( ids .eq. 1 ) then + + if( ievp_prep .ne. -5 ) then + + call evap_prep_dn( z_b, z_t, p_b, p_t, w_dt, bogtop, & + th_db, qv_db, ql_db, qi_db, tr_db(1:ncnst), qmin(1:ncnst), & + fevp1_t_rate, fevp2_t_rate, ievp_prep, & + flxrain_bot_upeesm, flxsnow_bot_upeesm, flxtrrs_bot_upeesm(1:ncnst), a_p_msfc(km,msfc), & + ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, ndb_evp, cmfdb_evp, i, k, ks, lchnk, & + rho, thv_mean_b, cmf_db, eps_dn, del_dn, & + kevp_rain_dn, kevp_snow_dn, eta2, rbuoy_dn, rdrag, rjet, nonzero, wdmin, & + evp_qtl, evp_qti, evp_tr(1:ncnst), fevp1_b_rate, fevp2_b_rate, w_db ) + + else + + ! --------------------------------------------------------------------------------------------------------- ! + ! Analytical treatment of evaporation within downdraft ! + ! Note that in order to prevent ambiguity due to snow melting, below uses 'flxrain(snow)_bot_upeesm' ! + ! instead of 'flxrain(snow)_top' in computing 'f_R,f_S', although the use of 'flxrain(snow)_bot_upeesm' ! + ! is still possible since the limiter is imposed based on 'flxrain(snow)_bot_upeesm'. ! + ! IMPORTANT : Due to the constraint of 'evp_max = max( qw_db - qv_db, 0._r8 )', evaporation does not occur ! + ! when 'ql_db,qi_qb > 0'. If downdraft is unsaturated at the base interface ( evp_max > 0 ), ! + ! evaporation occurs only until it is saturated without generating condensate. ! + ! Thus, the imposed fractional relationship of 'ql / (ql + qi ) = f(T)' from 'conden' is not ! + ! broken by the evaporation within downdraft. Thus, computating 'eff_ql = ql_db - ql_db_adi' ! + ! and 'eff_qi = qi_db - qi_db_adi' without considering evaporation within downdraft is correct. ! + ! In case of convective updraft when analytical integration is used as in the current code, ! + ! however, we should compute these 'effective CEF forcings' using the variables ! + ! including 'precipitation fallout' both adiabatically and diabatically, since analytical ! + ! computation of precipitation fall-out will break the imposed fractional relationship ! + ! of 'ql / (ql + qi ) = f(T)', so that the restoration of this relationship using 'conden' and ! + ! associated heating-cooling process is eventually included as a part of 'CEF' forcing. ! + ! ---------------------------------------------------------------------------------------------------------- ! + + call qsat(th_dt*exnf(p_t), p_t, es, qs) + f_R = kevp_rain_dn * sqrt( max( 0._r8, flxrain_bot_upeesm / max( a_p_msfc(km,msfc),nonzero))) + f_S = kevp_snow_dn * sqrt( max( 0._r8, flxsnow_bot_upeesm / max( a_p_msfc(km,msfc),nonzero))) + srcg_V = ( f_R + f_S ) / ( rho * g * max( w_dt, wdmin ) ) + eps_dia_V = ( f_R + f_S ) / ( rho * g * max( w_dt, wdmin ) * max( qs, nonzero ) ) + qv_med = qt_med - ql_med - qi_med + ssqv_tmp = ssqt_tmp - ssql_tmp - ssqi_tmp + call progup_thlqt( -eps_dn, -eps_dia_V, srcg_V, p_t, p_b, qv_med, ssqv_tmp, qv_dt, qv_db_adi_evp ) + qv_db_adi = qt_db - ql_db_adi - qi_db_adi + evp_qt = max( 0._r8, qv_db_adi_evp - qv_db_adi ) + evp_qtl = evp_qt * ( f_R / max( f_R + f_S, nonzero ) ) + evp_qti = evp_qt * ( f_S / max( f_R + f_S, nonzero ) ) + ! ---------------------------------------------------------------------------------- ! + ! Limiter should be imposed using the thermodynamic properties at the base interface ! + ! with entrainment dilution but without evaporation effect. ! + ! ---------------------------------------------------------------------------------- ! + ! evp_qtl = max( 0._r8, min( evp_qtl, eta2 * flxrain_bot_upeesm / max( nonzero, cmf_db ) / & + ! max( 1._r8, real(ndb_evp,r8) ) ) ) + ! evp_qti = max( 0._r8, min( evp_qti, eta2 * flxsnow_bot_upeesm / max( nonzero, cmf_db ) / & + ! max( 1._r8, real(ndb_evp,r8) ) ) ) + evp_qtl = max( 0._r8, min( evp_qtl, eta2 * flxrain_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + evp_qti = max( 0._r8, min( evp_qti, eta2 * flxsnow_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + call findsp_single( qv_db, th_db*exnf(p_b), p_b, tw_db, qw_db, i, k, lchnk ) + evp_max = max( qw_db - qv_db, 0._r8 ) + if( ( evp_qtl + evp_qti ) .gt. evp_max ) then + tmp1 = evp_qtl * evp_max / ( evp_qtl + evp_qti ) + tmp2 = evp_qti * evp_max / ( evp_qtl + evp_qti ) + evp_qtl = tmp1 + evp_qti = tmp2 + endif + ! ------------------------------ ! + ! Treatment of In-Cumulus Tracer ! + ! ------------------------------ ! + do mt = 1, ncnst + if( mt .eq. 1 ) then + evp_tr(mt) = evp_qtl + evp_qti + elseif( mt .eq. ixcldliq .or. mt .eq. ixcldice .or. mt .eq. ixnumliq .or. mt .eq. ixnumice ) then + evp_tr(mt) = 0._r8 + else + evp_tr(mt) = flxtrrs_bot_upeesm(mt) * ( evp_qtl + evp_qti ) / max( ( flxrain_bot_upeesm + & + flxsnow_bot_upeesm ) , nonzero ) + endif + evp_tr(mt) = max( evp_tr(mt), qmin(mt) - tr_db(mt) ) + enddo + ! ----------------------------------------------------------------------- ! + ! Compute 'w_db' at the base interface ! + ! In the below block, I simply neglect the reduction of 'qrain_b,qsnow_b' ! + ! due to the evaporation of precipitation within downdraft. ! + ! ----------------------------------------------------------------------- ! + t_tmp = th_db*exnf(p_b) - ( xlv / cp ) * evp_qtl - ( xls / cp ) * evp_qti + qv_tmp = qv_db + evp_qtl + evp_qti + th_tmp = t_tmp / exnf(p_b) + thv_tmp = th_tmp * ( 1._r8 + zvir * qv_tmp - ql_db - qi_db ) + bogbot = rbuoy_dn * ( 1._r8 - thv_tmp / thv_mean_b ) + call progup_wu2( -( rdrag*eps_dn - rjet*del_dn ), rho, p_t, p_b, -bogtop, -bogbot, w_dt**2._r8, & + 0._r8, wd2 ) + w_db = max( wdmin, sqrt( max( wd2, nonzero ) ) ) + ! ------------------------------------------ ! + ! Define the values of other null variables. ! + ! ------------------------------------------ ! + fevp1_b_rate = 0._r8 + fevp2_b_rate = 0._r8 + + endif + + else + + evp_qtl = 0._r8 + evp_qti = 0._r8 + evp_tr(1:ncnst) = 0._r8 + fevp1_b_rate = 0._r8 + fevp2_b_rate = 0._r8 + + endif + + + + evp_thll = - ( xlv / cp / exn0(k) ) * evp_qtl + evp_thli = - ( xls / cp / exn0(k) ) * evp_qti + thl_db = thl_db + evp_thll + evp_thli + qt_db = qt_db + evp_qtl + evp_qti + do mt = 1, ncnst + tr_db(mt) = tr_db(mt) + evp_tr(mt) + enddo + + ! ----------------------------------------------------- ! + ! 2. Precipitation Fallout : Neglected in the downdraft ! + ! ----------------------------------------------------- ! + prep_qtl = 0._r8 + prep_qti = 0._r8 + prep_thll = - ( xlv / cp / exn0(k) ) * prep_qtl + prep_thli = - ( xls / cp / exn0(k) ) * prep_qti + + ! -------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : PRECIPITATION FALLOUT AT THE BASE INTERFACE ! + ! -------------------------------------------------------------------------- ! + + do mt = 1, ncnst + if( mt .eq. 1 ) then + prep_tr(mt) = 0._r8 + elseif( mt .eq. ixcldliq ) then + prep_tr(mt) = prep_qtl + elseif( mt .eq. ixcldice ) then + prep_tr(mt) = prep_qti + elseif( mt .eq. ixnumliq ) then + prep_tr(mt) = prep_qtl * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + prep_tr(mt) = prep_qti * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + prep_tr(mt) = tr_db(mt) * ( ( prep_qtl + prep_qti ) / max( qt_db, nonzero ) ) + endif + prep_tr(mt) = max( prep_tr(mt), qmin(mt) - tr_db(mt) ) + enddo + + ! -------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : PRECIPITATION FALLOUT AT THE BASE INTERFACE ! + ! -------------------------------------------------------------------------- ! + + thl_db = thl_db + prep_thll + prep_thli + qt_db = qt_db + prep_qtl + prep_qti + do mt = 1, ncnst + tr_db(mt) = tr_db(mt) + prep_tr(mt) + enddo + + call conden( p_b, thl_db, qt_db, th_db, qv_db, ql_db, qi_db, qs_db, id_check ) + thv_db = th_db * ( 1._r8 + zvir * qv_db - ql_db - qi_db ) + if( ids .ne. 1 ) then + bogbot = rbuoy_dn * ( 1._r8 - thv_db / thv_mean_b ) + call progup_wu2( -( rdrag*eps_dn - rjet*del_dn ), rho, p_t, p_b, -bogtop, -bogbot, w_dt**2._r8, & + 0._r8, wd2 ) + w_db = max( wdmin, sqrt( max( wd2, nonzero ) ) ) + endif + + ! ---------------------------------------------------------------------- ! + ! Dec.18.2012. End of 'w_db' iteration loop for computing evaporation of ! + ! convective precipitation within convective downdraft. ! + ! ---------------------------------------------------------------------- ! + + ! ----------------------------------------------------------------------------- ! + ! Nov.28.2012. Impose final consistency between droplet mass and droplet number ! + ! before moving to the next layer below. ! + ! Mar.11.2013. Comment-out below two lines computing 'ql_db,qi_db' since they ! + ! have already been computed within the above iteration loop. ! + ! ----------------------------------------------------------------------------- ! + if( ql_db .eq. 0._r8 ) tr_db(ixnumliq) = 0._r8 + if( qi_db .eq. 0._r8 ) tr_db(ixnumice) = 0._r8 + + ! -------------------------------------------------------------------------- ! + ! Allocate diabatic forcings at the base interface into the array variable. ! + ! Diabatic forcing is always computed using the mean mass flux within ! + ! each layer, and with non-zero mass flux at the base interface of ! + ! detrainment layer. ! + ! (3) 0.5_r8 * ( cmf_dt + cmf_db ) where cmf_db > 0. ! + ! -------------------------------------------------------------------------- ! + cmf_ad_dia(k,ks,m,ids) = 0.5_r8 * ( cmf_db + cmf_dt ) * ( dp / dp0(k) ) + evp_thll_ad(k,ks,m,ids) = evp_thll + evp_qtl_ad(k,ks,m,ids) = evp_qtl + evp_thli_ad(k,ks,m,ids) = evp_thli + evp_qti_ad(k,ks,m,ids) = evp_qti + prep_thll_ad(k,ks,m,ids) = prep_thll + prep_qtl_ad(k,ks,m,ids) = prep_qtl + prep_thli_ad(k,ks,m,ids) = prep_thli + prep_qti_ad(k,ks,m,ids) = prep_qti + eff_ql_ad(k,ks,m,ids) = eff_ql + eff_qi_ad(k,ks,m,ids) = eff_qi + PGF_u_ad(k,ks,m,ids) = PGF_u + PGF_v_ad(k,ks,m,ids) = PGF_v + do mt = 1, ncnst + evp_tr_ad(k,ks,m,ids,mt) = evp_tr(mt) + prep_tr_ad(k,ks,m,ids,mt) = prep_tr(mt) + ! wdep_tr_ad(k,ks,m,ids,mt) = wdep_tr(mt) + eff_tr_ad(k,ks,m,ids,mt) = eff_tr(mt) + enddo + + ! ----------------------------------------------------------------------- ! + ! Compute 'net evaporation of precipitation' within each layer [kg/s/m^2] ! + ! and update precipitation fluxes at all interfaces below. ! + ! ----------------------------------------------------------------------- ! + + evplflux = ( evp_qtl + prep_qtl ) * cmf_ad_dia(k,ks,m,ids) + evpiflux = ( evp_qti + prep_qti ) * cmf_ad_dia(k,ks,m,ids) + + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + evptrflux(mt) = evplflux + elseif( mt .eq. ixcldice ) then + evptrflux(mt) = evpiflux + elseif( mt .eq. ixnumliq ) then + evptrflux(mt) = evplflux * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + evptrflux(mt) = evpiflux * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_snow**3 * density_snow ) + else + evptrflux(mt) = ( evp_tr(mt) + prep_tr(mt) ) * cmf_ad_dia(k,ks,m,ids) + ! evptrflux(mt) = ( evp_tr(mt) + prep_tr(mt) + wdep_tr(mt) ) * cmf_ad_dia(k,ks,m,ids) + endif + enddo + + flxrain_bot = flxrain_bot - evplflux + flxsnow_bot = flxsnow_bot - evpiflux + do mt = 1, ncnst + flxtrrs_bot(mt) = flxtrrs_bot(mt) - evptrflux(mt) + enddo + + ! ------------------------------------------------------------- ! + ! Check whether this air will move down into the below layer. ! + ! Also, compute the properties of detrained airs for treating ! + ! organization. ! + ! Detrainment of downdraft always occurs at the base interface. ! + ! ------------------------------------------------------------- ! + + ! ---------------------------------------------------------------------------------- ! + ! Compute laterally-detrained airs from downdraft while it moves from 'p_t' to 'p_b' ! + ! assuming that thermodynamic properties of detrained airs is the properties at the ! + ! p_t similar to the treatment of detrainment from convective updraft. ! + ! ---------------------------------------------------------------------------------- ! + + if( dp * abs( eps_dn - del_dn ) .ge. 1.e-3_r8 ) then + fmixd = ( exp( dp * ( eps_dn - del_dn ) ) - 1._r8 ) / ( dp * ( eps_dn - del_dn ) ) + else + fmixd = 1._r8 + endif + + cmf_ar(k,ks,m,ids) = fmixd * del_dn * dp * cmf_dt + thl_ar(k,ks,m,ids) = 0.5_r8 * ( thl_dt + thl_db ) + qt_ar(k,ks,m,ids) = 0.5_r8 * ( qt_dt + qt_db ) + u_ar(k,ks,m,ids) = 0.5_r8 * ( u_dt + u_db ) + v_ar(k,ks,m,ids) = 0.5_r8 * ( v_dt + v_db ) + do mt = 1, ncnst + tr_ar(k,ks,m,ids,mt) = 0.5_r8 * ( tr_dt(mt) + tr_db(mt) ) + enddo + ql_ar(k,ks,m,ids) = 0.5_r8 * ( ql_dt + ql_db ) + qi_ar(k,ks,m,ids) = 0.5_r8 * ( qi_dt + qi_db ) + + ! --------------------------------------------------------------- ! + ! Downdraft buoyancy sorting ! + ! Check whether downdraft will be detrained at the base interface ! + ! --------------------------------------------------------------- ! + + fddet = 0._r8 + if( dbsort_con ) then + fddet = ( thv_db - thv_min ) / max( thv_max - thv_min , nonzero ) + fddet = max( 0._r8, min( 1._r8, fddet ) ) + else + tmp1 = thv_db + tmp2 = thv_minE + if( tmp1 .gt. tmp2 ) fddet = 1._r8 + endif + if( k .eq. 1 .or. cmf_db * ( 1._r8 - fddet ) .lt. cmfmin ) fddet = 1._r8 + + ! if( fddet .gt. 0._r8 ) then + tmp3 = cmf_ar(k,ks,m,ids) + cmf_ar(k,ks,m,ids) = tmp3 + cmf_db * fddet + thl_ar(k,ks,m,ids) = ( thl_ar(k,ks,m,ids) * tmp3 + thl_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + qt_ar(k,ks,m,ids) = ( qt_ar(k,ks,m,ids) * tmp3 + qt_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + u_ar(k,ks,m,ids) = ( u_ar(k,ks,m,ids) * tmp3 + u_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + v_ar(k,ks,m,ids) = ( v_ar(k,ks,m,ids) * tmp3 + v_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + do mt = 1, ncnst + tr_ar(k,ks,m,ids,mt) = ( tr_ar(k,ks,m,ids,mt) * tmp3 + tr_db(mt) * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + enddo + ! Nov.28.2012. Below two lines are added. + ql_ar(k,ks,m,ids) = ( ql_ar(k,ks,m,ids) * tmp3 + ql_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + qi_ar(k,ks,m,ids) = ( qi_ar(k,ks,m,ids) * tmp3 + qi_db * cmf_db * fddet ) / & + max( nonzero, cmf_ar(k,ks,m,ids) ) + ! endif + + ! ------------------------------------------------------------------------------ ! + ! For diagnostic purpose and organization parameterization using cmf_d(0), ! + ! I am explicitly saving 'cmf_ad(0,ks,m,ids), thl_ad(0,ks,m,ids), and etc' here. ! + ! This does not influence tendency computation in the lowest model layer ! + ! by downdraft since downdraft fluxes at surface will be set to zero before ! + ! computing tendency as will be explained later. ! + ! Jun.29.2011. Note that this explicit computation at surface is also used for ! + ! computing downdraft TKE within PBL ( DKE ) and anomalies of ! + ! downdraft conservative scalars within PBL later for convective ! + ! organization. Thus, this explicit adding here is important. ! + ! Jul.13.2011. This explicit non-zero setting at surface is extremely useful in ! + ! computing 'tkePBLorg = wa_d(0,it=1)' for computing additional ! + ! background mean w associated with convective organization. ! + ! Mar.19.2014. Below explicit computation of downdraft properties at the surface ! + ! is now extremely important (not just diagnostic purpose), since ! + ! it is critically importantly used in partitioning convective ! + ! tendency in the lowest model layer intp the entire cumulus layers ! + ! or the PBL depth in association with the ipartition = 1. ! + ! ------------------------------------------------------------------------------ ! + if( k .eq. 1 ) then + cmf_ad(km,ks,m,ids) = cmf_db + thl_ad(km,ks,m,ids) = thl_db + qt_ad(km,ks,m,ids) = qt_db + u_ad(km,ks,m,ids) = u_db + v_ad(km,ks,m,ids) = v_db + w_ad(km,ks,m,ids) = w_db + a_ad(km,ks,m,ids) = cmf_db / rho_b / w_db + do mt = 1, ncnst + tr_ad(km,ks,m,ids,mt) = tr_db(mt) + enddo + ql_ad(km,ks,m,ids) = ql_db + qi_ad(km,ks,m,ids) = qi_db + endif + ! Mar.15.2014. For continuous buoyancy sorting in order to impose a stability in the code + ! and in order to minimize perturbation growth. + + if( fddet .eq. 1._r8 ) then ! Complete detrainment + cmf_db = 0._r8 + thl_db = 0._r8 + qt_db = 0._r8 + u_db = 0._r8 + v_db = 0._r8 + w_db = 0._r8 + do mt = 1, ncnst + tr_db(mt) = 0._r8 + enddo + ql_db = 0._r8 + qi_db = 0._r8 + ix_d_src(ks,ids) = 0 + cmf_d_src(ks,ids) = 0._r8 + goto 20 + endif + ! -------------------------------------------------------------- ! + ! Allocate downdraft values at the base interface into the array ! + ! -------------------------------------------------------------- ! + cmf_ad(km,ks,m,ids) = cmf_db * ( 1._r8 - fddet ) + thl_ad(km,ks,m,ids) = thl_db + qt_ad(km,ks,m,ids) = qt_db + u_ad(km,ks,m,ids) = u_db + v_ad(km,ks,m,ids) = v_db + w_ad(km,ks,m,ids) = w_db + a_ad(km,ks,m,ids) = cmf_db / rho_b / w_db + do mt = 1, ncnst + tr_ad(km,ks,m,ids,mt) = tr_db(mt) + enddo + ql_ad(km,ks,m,ids) = ql_db + qi_ad(km,ks,m,ids) = qi_db + ! --------------------------------------- ! + ! Initialization for the next computation ! + ! --------------------------------------- ! + ix_d_src(ks,ids) = 1 + cmf_d_src(ks,ids) = cmf_db * ( 1._r8 - fddet ) + thl_d_src(ks,ids) = thl_db + qt_d_src(ks,ids) = qt_db + u_d_src(ks,ids) = u_db + v_d_src(ks,ids) = v_db + w_d_src(ks,ids) = w_db + do mt = 1, ncnst + tr_d_src(ks,ids,mt) = tr_db(mt) + enddo + ql_d_src(ks,ids) = ql_db + qi_d_src(ks,ids) = qi_db + ! ------------------------------------------------------------------------ ! + ! Mar.11.2013. Add initialization of evaporation rate at the top interface ! + ! for the next layer below. ! + ! ------------------------------------------------------------------------ ! + fevp1_t_rate_src(ks,ids) = fevp1_b_rate + fevp2_t_rate_src(ks,ids) = fevp2_b_rate + ! ------------------------------------------------ ! + ! End of downdraft sorting of one downdraft source ! + ! ------------------------------------------------ ! + +20 continue + enddo ! ids = 1, 3. This 'ids' is a type of downdraft source. + enddo ! ks = ktop_msfc(msfc), k, -1. This 'ks' is a layer index of downdraft source. + + ! -------------------------------------------------------------------------------------- ! + ! Assign final precipitation flux at the bottom interface into the array ! + ! Also, compute 'evprain_d(k,msfc), evpsnow_d(k,msfc), evptrrs_d(k,msfc,mt)' >= 0 ! + ! by differencing two flux variables. ! + ! For safety and imposing full consistency, impose the constraint that droplet ! + ! size of precipitation rain/snow are externally specified. ! + ! Note that 'flxtrrs_bot(mt)' also contains the effect of wet deposition of aerosols ! + ! as well as evaporation ( & production ) of convective precipitation within ! + ! convective downdraft. Note also that wet deposition does not influences condensate but ! + ! only affect tracers. ! + ! -------------------------------------------------------------------------------------- ! + + flxrain_msfc(km,msfc) = flxrain_bot + flxsnow_msfc(km,msfc) = flxsnow_bot + evprain_d_msfc(k,msfc) = ( flxrain_bot_upeesm - flxrain_bot ) * ( g / dp0(k) ) ! >= 0. + evpsnow_d_msfc(k,msfc) = ( flxsnow_bot_upeesm - flxsnow_bot ) * ( g / dp0(k) ) ! >= 0. + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + flxtrrs_msfc(km,msfc,mt) = flxrain_msfc(km,msfc) + elseif( mt .eq. ixcldice ) then + flxtrrs_msfc(km,msfc,mt) = flxsnow_msfc(km,msfc) + elseif( mt .eq. ixnumliq ) then + flxtrrs_msfc(km,msfc,mt) = flxrain_msfc(km,msfc) * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + flxtrrs_msfc(km,msfc,mt) = flxsnow_msfc(km,msfc) * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_snow**3 * density_snow ) + else + flxtrrs_msfc(km,msfc,mt) = flxtrrs_bot(mt) + endif + evptrrs_d_msfc(k,msfc,mt) = ( flxtrrs_msfc(km,msfc,mt) - flxtrrs_bot_upeesm(mt) ) * ( g / dptr0(k,mt) ) + enddo + + ! Sanity Check : In the new code, this case must not happen. + if( flxrain_msfc(km,msfc) .lt. -1.e-18_r8 .or. flxsnow_msfc(km,msfc) .lt. -1.e-18_r8 ) then + write(iulog,*) 'UNICON : Stop - Negative precipitation flux after computing evaporation within environment' + write(iulog,*) k, flxrain_msfc(k,msfc), flxsnow_msfc(k,msfc), flxrain_msfc(km,msfc), flxsnow_msfc(km,msfc) + call endrun('STOP : UNICON - Negative Precipitation Flux') + write(iulog,*) + endif + + ! --------------------------------------------------------------------------------------------------- ! + ! Final Net Rain and Snow Production Tendency in Each Layer for Each Updraft Segment. ! + ! ! + ! A. For evaporation and snow melting, the sign of tracer tendencies have been already reversed, ! + ! so that simplying adding all the tracer tendencies produces correct results. ! + ! ! + ! B. Note that if we turn-off area and vertical velocity constraint of convective downdraft, then ! + ! ! + ! 1. qrten_d_msfc(k,msfc) = - evprain_d_msfc(k,msfc), ! + ! 2. qrten_d_msfc(k,msfc) = - evprain_d_msfc(k,msfc), ! + ! 3. trrsten_d_msfc(k,msfc) = evptrrs_d_msfc(k,msfc) ! + ! ! + ! where 3 variables on the LSH will be computed later after performing vertical velocity and ! + ! are constraints on the convective downdraft. In fact, this is the versy reason why these are ! + ! computed later instead of downdraft computation loop above. ! + ! ! + ! C. With the current treatment of new unified treatment of evaporation process with ! + ! the 'do msfc = 1, nseg' loop outside of 'do k = ktop, 1, -1', there is no way to perfectly treat ! + ! the area and vertical velocity constraint of convective downdraft. Thus, I should turn-off ! + ! the area and vertical velocity constraint of convective downdraft, which is OK given the huge ! + ! benefit of physically reasonable computation of evaporation process in a consistent way. ! + ! D. Note also that 'trrsten_u_msfc(k,msfc,mt),evptrrs_d_msfc(k,msfc,mt)' already contains the effect ! + ! of wet deposition of aerosols within convective updraft and downdrafts. ! + ! ! + ! MODIFICATION IS REQUIRED : ! + ! Below 'x_p_msfc(km,msfc), y_p_msfc(km,msfc)' should be re-computed. ! + ! ! + ! Mar.05.2013. Recompute 'x_p_msfc(km,msfc), y_p_msfc(km,msfc)' using grid-mean precipitation fluxes ! + ! both from the one coming from at the top interface with evaporation within environment ! + ! ( flxrain_bot_ee + flxsnow_bot_ee ) and the flux generated in the current layer from ! + ! convective updraft ( ( qrten_u_msfc(k,msfc) + qsten_u_msfc(k,msfc) ) * ( dp0(k) / g ) ! + ! as weighting factors. Note that since snow melting and evaporation within downdraft ! + ! occur both in the above two sources in the same way, we don't need to consider the ! + ! effect of snow melting and evaporation within downdraft in computing x_p_msfc(km,msfc) ! + ! and y_p_msfc(km,msfc). Note also that the weighting factor is the product of 'in-prep ! + ! precipitation flux' and the 'area', i.e., 'area' is also used as a weighting factor, ! + ! which is also a perfectly reasonable choice. ! + ! In addition, this new computation saves computation time. ! + ! The fundamental simplifying assumption of this approach is that both precipitation and ! + ! precipitating updraft areas can be described as a single disk with a single (x,y,R) at ! + ! each model interface. ! + ! --------------------------------------------------------------------------------------------------- ! + + tmpw = ( flxrain_bot_ee + flxsnow_bot_ee ) + ( qrten_u_msfc(k,msfc) + qsten_u_msfc(k,msfc) ) * ( dp0(k) / g ) + tmpw = max( tmpw, nonzero ) + x_p_msfc(km,msfc) = ( x_p_msfc(k,msfc) * ( flxrain_bot_ee + flxsnow_bot_ee ) + & + x_um_msfc(k,msfc) * ( qrten_u_msfc(k,msfc) + qsten_u_msfc(k,msfc) ) * ( dp0(k) / g ) ) / tmpw + y_p_msfc(km,msfc) = ( y_p_msfc(k,msfc) * ( flxrain_bot_ee + flxsnow_bot_ee ) + & + y_um_msfc(k,msfc) * ( qrten_u_msfc(k,msfc) + qsten_u_msfc(k,msfc) ) * ( dp0(k) / g ) ) / tmpw + + enddo ! k = ktop_msfc(msfc), 1, -1. This 'k' is a layer index where vertical evolution of downdraft is computed. + enddo ! msfc = 1, nseg This 'msfc' is a number of updraft segment at surface. + + ! ------------------------------------------------------------------------------------------------------- ! + ! ! + ! Iteration for treating accretion should end here. ! + ! ! + ! The variables used for the next accretion iteration computations within 'subroutine prod_prep_up' are ! + ! ! + ! 1. flxrain_msfc(k,msfc), flxsnow_msfc(k,msfc) ! + ! 2. a_p_msfc(k,msfc) ! + ! 3. am_us_msfc(k,msfc) ! + ! 4. am_pu_msfc(k,msfc) ! + ! ! + ! all of which are already computed above. Thus, this is the perfect location of the end of accretion ! + ! iteration loop. ! + ! ------------------------------------------------------------------------------------------------------- ! + + enddo ! Enf of iacc = 1, nacc This 'iacc' is a number of accretion iteration. + + ! ---------------------------------------------------------------------- ! + ! Compute mass-flux weighted mean ! + ! (1) downdraft properties at the interfaces ! + ! (2) detrained properties at the layer mid-point ! + ! Also compute mass-flux weighted diabatic contribution. ! + ! ---------------------------------------------------------------------- ! + + cmf_d_org_pblh = 0._r8 + thl_d_org_pblh = 0._r8 + qt_d_org_pblh = 0._r8 + u_d_org_pblh = 0._r8 + v_d_org_pblh = 0._r8 + tr_d_org_pblh(1:ncnst) = 0._r8 + qt_dia_d_org = 0._r8 + thl_dia_d_org = 0._r8 + tr_dia_d_org(1:ncnst) = 0._r8 + ! May.1.2014. For the budget consistent cold-pool treatment. + cmf_d_orgU_pblh = 0._r8 + thl_d_orgU_pblh = 0._r8 + qt_d_orgU_pblh = 0._r8 + u_d_orgU_pblh = 0._r8 + v_d_orgU_pblh = 0._r8 + tr_d_orgU_pblh(1:ncnst) = 0._r8 + qt_dia_d_orgU = 0._r8 + thl_dia_d_orgU = 0._r8 + tr_dia_d_orgU(1:ncnst) = 0._r8 + + do msfc = 1, nseg ! This 'msfc' is updraft segment index at surface. + do ids = 1, 3 ! This 'ids' is the type of downdraft source ( 1 : mixing downdraft, 2 : top downdraft, 3 : area downdraft ) + if( ids .eq. 1 ) then + ks_top = ktop_msfc(msfc) + ks_bot = 1 + elseif( ids .eq. 2 ) then + ks_top = ktop_msfc(msfc) + ks_bot = ks_top + elseif( ids .eq. 3 ) then + ks_top = ktop_msfc(msfc) - 1 + ks_bot = 1 + endif + do ks = ks_top, ks_bot, -1 ! This 'ks' is a layer index where downdraft sources are generated. + ! ------------------------------------------------------------------------------------------- ! + ! Convert updraft segment index at surface into shortened-updraft segment index in each layer ! + ! ------------------------------------------------------------------------------------------- ! + m = m_from_msfc(ks,msfc) + do k = ks, 1, -1 ! This 'k' is a layer index from the source layer to the 1st (not 2nd) layer. + km = k - 1 ! This 'km' is a base interface index + ! ------------------------------------------------- ! + ! Sum of downdraft properties at the base interface ! + ! ------------------------------------------------- ! + if( cmf_ad(km,ks,m,ids) .gt. nonzero ) then + cmf_d(km) = cmf_d(km) + cmf_ad(km,ks,m,ids) + a_d(km) = a_d(km) + a_ad(km,ks,m,ids) + thl_d(km) = thl_d(km) + thl_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qt_d(km) = qt_d(km) + qt_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + u_d(km) = u_d(km) + u_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + v_d(km) = v_d(km) + v_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + w_d(km) = w_d(km) + w_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + wa_d(km) = wa_d(km) + w_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + ql_d(km) = ql_d(km) + ql_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qi_d(km) = qi_d(km) + qi_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qla_d(km) = qla_d(km) + ql_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + qia_d(km) = qia_d(km) + qi_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + do mt = 1, ncnst + tr_d(km,mt) = tr_d(km,mt) + tr_ad(km,ks,m,ids,mt) * cmf_ad(km,ks,m,ids) + enddo + ! ---------------------------------------------------------------------------------------- ! + ! Refinement of Organization ! + ! In order to compute convective organization at surface, only sum the downdraft mass flux ! + ! that (1) was originated above PBLH, and (2) reaches down to surface by the rigorous ! + ! downdraft buoyancy sorting in the lowest model layer ( k = 1 ). ! + ! This is an attempt to sort out only the downdraft mass flux forced by evaporation of ! + ! convective precipitation. ! + ! Mar.11.2013. Comment-out below block since it is not used any more. ! + ! In addition, 'th,qv,ql,qi' are not computed correctly since above 'conden' ! + ! was commented out. ! + ! ---------------------------------------------------------------------------------------- ! + + if( ids .eq. 1 .and. & + ks .gt. kpblh .and. & + 8.64e7_r8*(flxrain_msfc(kpblhm,msfc)/1000._r8+flxsnow_msfc(kpblhm,msfc)/250._r8) .gt. prepminPBLH_org & + .and. cmf_ad(1,ks,m,ids) .gt. nonzero ) then + ! ---------------------------------------------------------- ! + ! Compute adiabatic downdraft fluxes of conservative scalars ! + ! ---------------------------------------------------------- ! + if( km .eq. kpblhm ) then + cmf_d_org_pblh = cmf_d_org_pblh + cmf_ad(km,ks,m,ids) + thl_d_org_pblh = thl_d_org_pblh + thl_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qt_d_org_pblh = qt_d_org_pblh + qt_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + u_d_org_pblh = u_d_org_pblh + u_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + v_d_org_pblh = v_d_org_pblh + v_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + do mt = 1, ncnst + tr_d_org_pblh(mt) = tr_d_org_pblh(mt) + tr_ad(km,ks,m,ids,mt) * cmf_ad(km,ks,m,ids) + enddo + endif + ! ----------------------------------------------------------------------------------------------------------- ! + ! Compute diabatic forcings integrated all over the layers within PBL. ! + ! Note that there is no diabatic forcing for 'u,v' since 'PGF' forcing is a simple conversion ! + ! between environment and convective downdraft. ! + ! For tracers, tendencies in each layer is computed by using 'pdelx = dpdry0(k)' not 'dp0(k)'. ! + ! I multiplied 'dp0(k)' for vertical integration. However, I should check this in future. ! + ! Note that below computation of diabatic forcing within downdraft does not contain either 'snow melting' ! + ! or 'corrective flux', both of which will be treated later as a part of environmental diabatic forcing. ! + ! Thus, there will be no missing process or double counting. ! + ! Sep.10.2011. Note tha below computation of diabatic forcing within downdraft within PBL should nbe done in ! + ! a fully cocnsitently way as the above computation of adiabatic forcing, i.e., using the ! + ! exactly same set of convective downdraft as in the current code. ! + ! Aug.02.2012. From above, I only allowed evaporation of precipitation within mixing downdraft not within ! + ! top downdraft and area downdraft anymore. ! + ! ----------------------------------------------------------------------------------------------------------- ! + if( k .le. kpblhm ) then + qt_dia_d_org = qt_dia_d_org + & + g * ( prep_qtl_ad(k,ks,m,ids) + prep_qti_ad(k,ks,m,ids) + evp_qtl_ad(k,ks,m,ids) & + + evp_qti_ad(k,ks,m,ids) ) * cmf_ad_dia(k,ks,m,ids) + thl_dia_d_org = thl_dia_d_org + & + g * ( prep_thll_ad(k,ks,m,ids) + prep_thli_ad(k,ks,m,ids) + evp_thll_ad(k,ks,m,ids) & + + evp_thli_ad(k,ks,m,ids) ) * cmf_ad_dia(k,ks,m,ids) + do mt = 1, ncnst + tmp1 = dp0(k) / dptr0(k,mt) + tr_dia_d_org(mt) = tr_dia_d_org(mt) + tmp1 * & + g * ( evp_tr_ad(k,ks,m,ids,mt) + prep_tr_ad(k,ks,m,ids,mt) + wdep_tr_ad(k,ks,m,ids,mt) & + + eff_tr_ad(k,ks,m,ids,mt) ) * cmf_ad_dia(k,ks,m,ids) + enddo + endif + endif + + ! -------------------------------------------------------------------------------------------------------------------- ! + ! May.1.2014. For budget consistent cold pool treatment. ! + ! In contrast to the above part computing 'cmf_d_org_pblh' that exculsively sinks down into 'awk_PBL', ! + ! this part computes 'cmf_d_orgU_pblh' that exclusively sinks down into '1-awk_PBL'. ! + ! Note that if 'i_budget_coldpool .eq. 1', there is no downdraft exclusively sinking into '1-awk_PBL', so that ! + ! it becomes 'cmf_d_orgU_pblh=0, thl_d_org_pblh=0, qt_dia_d_org=0' which is already done at the initialization at the ! + ! beginning of downdraft computation routine. Thus, I need to compute only for 'i_budget_cold_pool .eq. 2' when ! + ! all the downdrafts other than 'cmf_d_org_pblh' computed above exclusively fall into 'awk_PBL'. ! + ! Below 'if' constraints is exact opposite to the above 'if' constraint, currently, but it can be further ! + ! generalized by similarly defining 'clf_d_orgG_pblh' in future. ! + ! -------------------------------------------------------------------------------------------------------------------- ! + + if( i_budget_coldpool .eq. 2 .or. i_budget_coldpool .eq. 4 .or. i_budget_coldpool .eq. 5 ) then + + if( .not. ( ids .eq. 1 .and. & + ks .gt. kpblh .and. & +!? 8.64e7_r8*(flxrain_ava_msfc(kpblhm,msfc)/1000._r8+flxsnow_ava_msfc(kpblhm,msfc)/250._r8) .gt. prepminPBLH_org .and. & +!! 8.64e7_r8*(flxrain_msfc(kpblhm)/1000._r8+flxsnow_msfc(kpblhm)/250._r8) .gt. prepminPBLH_org .and. & + 8.64e7_r8*(flxrain_msfc(kpblhm,msfc)/1000._r8+flxsnow_msfc(kpblhm,msfc)/250._r8) & + .gt. prepminPBLH_org .and. & + cmf_ad(1,ks,m,ids) .gt. nonzero ) ) then + ! ---------------------------------------------------------- ! + ! Compute adiabatic downdraft fluxes of conservative scalars ! + ! ---------------------------------------------------------- ! + if( km .eq. kpblhm ) then + cmf_d_orgU_pblh = cmf_d_orgU_pblh + cmf_ad(km,ks,m,ids) + thl_d_orgU_pblh = thl_d_orgU_pblh + thl_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qt_d_orgU_pblh = qt_d_orgU_pblh + qt_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + u_d_orgU_pblh = u_d_orgU_pblh + u_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + v_d_orgU_pblh = v_d_orgU_pblh + v_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + do mt = 1, ncnst + tr_d_orgU_pblh(mt) = tr_d_orgU_pblh(mt) + tr_ad(km,ks,m,ids,mt) * cmf_ad(km,ks,m,ids) + enddo + endif + if( k .le. kpblhm ) then + qt_dia_d_orgU = qt_dia_d_orgU + & + g * ( prep_qtl_ad(k,ks,m,ids) + prep_qti_ad(k,ks,m,ids) + & + evp_qtl_ad(k,ks,m,ids) + evp_qti_ad(k,ks,m,ids) ) * & + cmf_ad_dia(k,ks,m,ids) + thl_dia_d_orgU = thl_dia_d_orgU + & + g * ( prep_thll_ad(k,ks,m,ids) + prep_thli_ad(k,ks,m,ids) + & + evp_thll_ad(k,ks,m,ids) + evp_thli_ad(k,ks,m,ids) ) * & + cmf_ad_dia(k,ks,m,ids) + do mt = 1, ncnst + tmp1 = dp0(k) / dptr0(k,mt) + tr_dia_d_orgU(mt) = tr_dia_d_orgU(mt) + tmp1 * & + g * ( evp_tr_ad(k,ks,m,ids,mt) + prep_tr_ad(k,ks,m,ids,mt) + & + wdep_tr_ad(k,ks,m,ids,mt) + eff_tr_ad(k,ks,m,ids,mt) ) * & + cmf_ad_dia(k,ks,m,ids) + enddo + endif + endif + + endif + + endif + ! --------------------------------------------- ! + ! Sum of diabatic forcing at the base interface ! + ! --------------------------------------------- ! + if( cmf_ad_dia(k,ks,m,ids) .gt. nonzero ) then + cmf_d_dia(k) = cmf_d_dia(k) + cmf_ad_dia(k,ks,m,ids) + evp_thll_d(k) = evp_thll_d(k) + evp_thll_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + evp_qtl_d(k) = evp_qtl_d(k) + evp_qtl_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + evp_thli_d(k) = evp_thli_d(k) + evp_thli_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + evp_qti_d(k) = evp_qti_d(k) + evp_qti_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + prep_thll_d(k) = prep_thll_d(k) + prep_thll_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + prep_qtl_d(k) = prep_qtl_d(k) + prep_qtl_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + prep_thli_d(k) = prep_thli_d(k) + prep_thli_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + prep_qti_d(k) = prep_qti_d(k) + prep_qti_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + eff_ql_d(k) = eff_ql_d(k) + eff_ql_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + eff_qi_d(k) = eff_qi_d(k) + eff_qi_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + PGF_u_d(k) = PGF_u_d(k) + PGF_u_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + PGF_v_d(k) = PGF_v_d(k) + PGF_v_ad(k,ks,m,ids) * cmf_ad_dia(k,ks,m,ids) + do mt = 1, ncnst + evp_tr_d(k,mt) = evp_tr_d(k,mt) + evp_tr_ad(k,ks,m,ids,mt) * cmf_ad_dia(k,ks,m,ids) + prep_tr_d(k,mt) = prep_tr_d(k,mt) + prep_tr_ad(k,ks,m,ids,mt) * cmf_ad_dia(k,ks,m,ids) + ! wdep_tr_d(k,mt) = wdep_tr_d(k,mt) + wdep_tr_ad(k,ks,m,ids,mt) * cmf_ad_dia(k,ks,m,ids) + eff_tr_d(k,mt) = eff_tr_d(k,mt) + eff_tr_ad(k,ks,m,ids,mt) * cmf_ad_dia(k,ks,m,ids) + enddo + endif + ! ----------------------------------------------------------------- ! + ! Sum of detrained properties from downdraft at the layer mid-point ! + ! ----------------------------------------------------------------- ! + if( cmf_ar(k,ks,m,ids) .gt. nonzero ) then + cmf_rd(k) = cmf_rd(k) + cmf_ar(k,ks,m,ids) + thl_rd(k) = thl_rd(k) + thl_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + qt_rd(k) = qt_rd(k) + qt_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + u_rd(k) = u_rd(k) + u_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + v_rd(k) = v_rd(k) + v_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + ql_rd(k) = ql_rd(k) + ql_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + qi_rd(k) = qi_rd(k) + qi_ar(k,ks,m,ids) * cmf_ar(k,ks,m,ids) + do mt = 1, ncnst + tr_rd(k,mt) = tr_rd(k,mt) + tr_ar(k,ks,m,ids,mt) * cmf_ar(k,ks,m,ids) + enddo + endif + ! ------------------------------------------------------------------------------------- ! + ! Compute mean downdraft properties at the layer mid-point or at the interface for each ! + ! original updraft segment 'msfc'. These are diagnostic quantities. ! + ! ------------------------------------------------------------------------------------- ! + tmp1 = 0.5_r8 * ( a_ad(km,ks,m,ids) + a_ad(k,ks,m,ids) ) * ( dpad(k,ks,m,ids) / dp0(k) ) + am_d_msfc(k,msfc) = am_d_msfc(k,msfc) + tmp1 + qlm_d_msfc(k,msfc) = qlm_d_msfc(k,msfc) + tmp1 * 0.5_r8 * ( ql_ad(km,ks,m,ids) + ql_ad(k,ks,m,ids) ) * & + ( dpad(k,ks,m,ids) / dp0(k) ) + qim_d_msfc(k,msfc) = qim_d_msfc(k,msfc) + tmp1 * 0.5_r8 * ( qi_ad(km,ks,m,ids) + qi_ad(k,ks,m,ids) ) * & + ( dpad(k,ks,m,ids) / dp0(k) ) + qrten_d_msfc(k,msfc) = qrten_d_msfc(k,msfc) - ( g / dp0(k) ) * ( prep_qtl_ad(k,ks,m,ids) + & + evp_qtl_ad(k,ks,m,ids) ) * cmf_ad_dia(k,ks,m,ids) ! <= 0 + qsten_d_msfc(k,msfc) = qsten_d_msfc(k,msfc) - ( g / dp0(k) ) * ( prep_qti_ad(k,ks,m,ids) + & + evp_qti_ad(k,ks,m,ids) ) * cmf_ad_dia(k,ks,m,ids) ! <= 0 + do mt = 1, ncnst + if( mt .eq. ixcldliq ) then + trrsten_d_msfc(k,msfc,mt) = qrten_d_msfc(k,msfc) + elseif( mt .eq. ixcldice ) then + trrsten_d_msfc(k,msfc,mt) = qsten_d_msfc(k,msfc) + elseif( mt .eq. ixnumliq ) then + trrsten_d_msfc(k,msfc,mt) = qrten_d_msfc(k,msfc) * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_rain**3 * density_rain ) + elseif( mt .eq. ixnumice ) then + trrsten_d_msfc(k,msfc,mt) = qsten_d_msfc(k,msfc) * 3._r8 / ( 4._r8 * 3.141592_r8 * & + droprad_snow**3 * density_snow ) + else + trrsten_d_msfc(k,msfc,mt) = trrsten_d_msfc(k,msfc,mt) - ( g / dptr0(k,mt) ) * & + ( prep_tr_ad(k,ks,m,ids,mt) + evp_tr_ad(k,ks,m,ids,mt) + & + wdep_tr_ad(k,ks,m,ids,mt) ) * cmf_ad_dia(k,ks,m,ids) ! <= 0 + endif + enddo + if( cmf_ad(km,ks,m,ids) .gt. nonzero ) then + cmf_d_msfc(km,msfc) = cmf_d_msfc(km,msfc) + cmf_ad(km,ks,m,ids) + a_d_msfc(km,msfc) = a_d_msfc(km,msfc) + a_ad(km,ks,m,ids) + thl_d_msfc(km,msfc) = thl_d_msfc(km,msfc) + thl_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qt_d_msfc(km,msfc) = qt_d_msfc(km,msfc) + qt_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + u_d_msfc(km,msfc) = u_d_msfc(km,msfc) + u_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + v_d_msfc(km,msfc) = v_d_msfc(km,msfc) + v_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + w_d_msfc(km,msfc) = w_d_msfc(km,msfc) + w_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + ql_d_msfc(km,msfc) = ql_d_msfc(km,msfc) + ql_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + qi_d_msfc(km,msfc) = qi_d_msfc(km,msfc) + qi_ad(km,ks,m,ids) * cmf_ad(km,ks,m,ids) + wa_d_msfc(km,msfc) = wa_d_msfc(km,msfc) + w_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + qla_d_msfc(km,msfc) = qla_d_msfc(km,msfc) + ql_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + qia_d_msfc(km,msfc) = qia_d_msfc(km,msfc) + qi_ad(km,ks,m,ids) * a_ad(km,ks,m,ids) + do mt = 1, ncnst + tr_d_msfc(km,msfc,mt) = tr_d_msfc(km,msfc,mt) + tr_ad(km,ks,m,ids,mt) * cmf_ad(km,ks,m,ids) + enddo + endif + ! ---------------------------------------------------------------------------- ! + ! ! + ! ---------------------------------------------------------------------------- ! + enddo ! k = ks, 1, -1. This 'k' is a layer index. + enddo ! ks = ks_top, ks_bot, -1. This 'ks' is a layer index of downdraft source. + enddo ! ids = 1, 3. This 'ids' is a type of downdraft source. + enddo ! msfc = 1, nseg This 'msfc' is a number of updraft segment at surface. + + ! ------------------------------------------------------------------------------------- ! + ! Jul.10.2011. In order to do in-downdraft perturbation, I should divide by 'tmp3' ! + ! However, TKE is accumulated quantities. ! + ! Note that final 'thlPBLorg,qtPBLorg' are mass-flux weighted quantities. ! + ! Aug.03.2011. Below may be modified in future such that 'if cmfPBLorg .le. nonzero', ! + ! I should set cmfPBLorg = 0. ! + ! ------------------------------------------------------------------------------------- ! + + ! ----------------------------------------------------------------------------------------------------------------- ! + ! Aug.30.2011. Mean downdraft properties at the PBL top interface ( kpblhm ) for organized convective downdraft. ! + ! Sep.06.2011. Also compute grid-mean vertically-averaged diabatic forcing within convective downdraft within PBL. ! + ! Sep.09.2011. Below block is commented-out since all the wake-related adiabatic and diabatic forcings are treated ! + ! later in a collective way. ! + ! Sep.11.2011. I restored below block for selective chooce of convective downdrafts. + ! ----------------------------------------------------------------------------------------------------------------- ! + + if( cmf_d_org_pblh .gt. nonzero ) then + thl_d_org_pblh = thl_d_org_pblh / cmf_d_org_pblh + qt_d_org_pblh = qt_d_org_pblh / cmf_d_org_pblh + u_d_org_pblh = u_d_org_pblh / cmf_d_org_pblh + v_d_org_pblh = v_d_org_pblh / cmf_d_org_pblh + do mt = 1, ncnst + tr_d_org_pblh(mt) = tr_d_org_pblh(mt) / cmf_d_org_pblh + enddo + else + cmf_d_org_pblh = 0._r8 + thl_d_org_pblh = 0._r8 + qt_d_org_pblh = 0._r8 + u_d_org_pblh = 0._r8 + v_d_org_pblh = 0._r8 + tr_d_org_pblh(1:ncnst) = 0._r8 + endif + + qt_dia_d_org = qt_dia_d_org / pblhp + thl_dia_d_org = thl_dia_d_org / pblhp + do mt = 1, ncnst + tr_dia_d_org(mt) = tr_dia_d_org(mt) / pblhp + enddo + + ! --------------------------------------------------------------------------------------------------------- ! + ! May.1.2014. ! + ! Add exactly same part as the above but for 'cmf_d_orgU_pblh' that exclusively sinks down into '1-awk_PBL' ! + ! instead of 'awk_PBL' for 'i_budget_coldpool = 1,2' treatment (i.e., budget consistent cold pool). ! + ! --------------------------------------------------------------------------------------------------------- ! + + if( cmf_d_orgU_pblh .gt. nonzero ) then + thl_d_orgU_pblh = thl_d_orgU_pblh / cmf_d_orgU_pblh + qt_d_orgU_pblh = qt_d_orgU_pblh / cmf_d_orgU_pblh + u_d_orgU_pblh = u_d_orgU_pblh / cmf_d_orgU_pblh + v_d_orgU_pblh = v_d_orgU_pblh / cmf_d_orgU_pblh + do mt = 1, ncnst + tr_d_orgU_pblh(mt) = tr_d_orgU_pblh(mt) / cmf_d_orgU_pblh + enddo + else + cmf_d_orgU_pblh = 0._r8 + thl_d_orgU_pblh = 0._r8 + qt_d_orgU_pblh = 0._r8 + u_d_orgU_pblh = 0._r8 + v_d_orgU_pblh = 0._r8 + tr_d_orgU_pblh(1:ncnst) = 0._r8 + endif + + qt_dia_d_orgU = qt_dia_d_orgU / pblhp + thl_dia_d_orgU = thl_dia_d_orgU / pblhp + do mt = 1, ncnst + tr_dia_d_orgU(mt) = tr_dia_d_orgU(mt) / pblhp + enddo + + ! --------------------------------------------------------------------------------------------------------- ! + ! Apr.21.2011. Below block is to compute diagnostic 'am_d,qlm_d,qim_d' extending element computation above. ! + ! This computation is same as corresnding computation of updraft ( am_u,qlm_u,qim_u ). ! + ! --------------------------------------------------------------------------------------------------------- ! + + do msfc = 1, nseg + do k = 1, ktop_msfc(msfc) + qlm_d_msfc(k,msfc) = qlm_d_msfc(k,msfc) / max( am_d_msfc(k,msfc), nonzero ) + qim_d_msfc(k,msfc) = qim_d_msfc(k,msfc) / max( am_d_msfc(k,msfc), nonzero ) + am_d(k) = am_d(k) + am_d_msfc(k,msfc) + qlm_d(k) = qlm_d(k) + am_d_msfc(k,msfc) * qlm_d_msfc(k,msfc) + qim_d(k) = qim_d(k) + am_d_msfc(k,msfc) * qim_d_msfc(k,msfc) + enddo + enddo + qlm_d(k) = qlm_d(k) / max( am_d(k), nonzero ) + qim_d(k) = qim_d(k) / max( am_d(k), nonzero ) + + ! ------------------------------------------ ! + ! Compute grid mean properties in each layer ! + ! ------------------------------------------ ! + + do k = 1, ktop ! This 'k' is a layer index + + km = k - 1 ! This 'km' is a base interface index of 'k' + + ! --------------------------------------------------------------------- ! + ! Mean downdraft properties at the base interface for each 'msfc' index ! + ! These are diagnostic quantities. ! + ! --------------------------------------------------------------------- ! + + do msfc = 1, nseg + if( cmf_d_msfc(km,msfc) .gt. nonzero ) then + thl_d_msfc(km,msfc) = thl_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + qt_d_msfc(km,msfc) = qt_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + u_d_msfc(km,msfc) = u_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + v_d_msfc(km,msfc) = v_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + w_d_msfc(km,msfc) = w_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + ql_d_msfc(km,msfc) = ql_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + qi_d_msfc(km,msfc) = qi_d_msfc(km,msfc) / cmf_d_msfc(km,msfc) + wa_d_msfc(km,msfc) = wa_d_msfc(km,msfc) / a_d_msfc(km,msfc) + qla_d_msfc(km,msfc) = qla_d_msfc(km,msfc) / a_d_msfc(km,msfc) + qia_d_msfc(km,msfc) = qia_d_msfc(km,msfc) / a_d_msfc(km,msfc) + do mt = 1, ncnst + tr_d_msfc(km,msfc,mt) = tr_d_msfc(km,msfc,mt) / cmf_d_msfc(km,msfc) + enddo + else + thl_d_msfc(km,msfc) = 0._r8 + qt_d_msfc(km,msfc) = 0._r8 + u_d_msfc(km,msfc) = 0._r8 + v_d_msfc(km,msfc) = 0._r8 + w_d_msfc(km,msfc) = 0._r8 + ql_d_msfc(km,msfc) = 0._r8 + qi_d_msfc(km,msfc) = 0._r8 + wa_d_msfc(km,msfc) = 0._r8 + qla_d_msfc(km,msfc) = 0._r8 + qia_d_msfc(km,msfc) = 0._r8 + do mt = 1, ncnst + tr_d_msfc(km,msfc,mt) = 0._r8 + enddo + endif + enddo + + ! ----------------------------------------------- ! + ! Mean downdraft properties at the base interface ! + ! ----------------------------------------------- ! + + if( cmf_d(km) .gt. nonzero ) then + thl_d(km) = thl_d(km) / cmf_d(km) + qt_d(km) = qt_d(km) / cmf_d(km) + u_d(km) = u_d(km) / cmf_d(km) + v_d(km) = v_d(km) / cmf_d(km) + w_d(km) = w_d(km) / cmf_d(km) + wa_d(km) = wa_d(km) / a_d(km) + ql_d(km) = ql_d(km) / cmf_d(km) + qi_d(km) = qi_d(km) / cmf_d(km) + qla_d(km) = qla_d(km) / a_d(km) + qia_d(km) = qia_d(km) / a_d(km) + do mt = 1, ncnst + tr_d(km,mt) = tr_d(km,mt) / cmf_d(km) + enddo + else + cmf_d(km) = 0._r8 + thl_d(km) = 0._r8 + qt_d(km) = 0._r8 + u_d(km) = 0._r8 + v_d(km) = 0._r8 + w_d(km) = 0._r8 + wa_d(km) = 0._r8 + ql_d(km) = 0._r8 + qi_d(km) = 0._r8 + qla_d(km) = 0._r8 + qia_d(km) = 0._r8 + do mt = 1, ncnst + tr_d(km,mt) = 0._r8 + enddo + endif + + ! ------------------------------------------------- ! + ! Mean diabatic forcings on downdraft in each layer ! + ! ------------------------------------------------- ! + + if( cmf_d_dia(k) .gt. nonzero ) then + evp_thll_d(k) = evp_thll_d(k) / cmf_d_dia(k) + evp_qtl_d(k) = evp_qtl_d(k) / cmf_d_dia(k) + evp_thli_d(k) = evp_thli_d(k) / cmf_d_dia(k) + evp_qti_d(k) = evp_qti_d(k) / cmf_d_dia(k) + prep_thll_d(k) = prep_thll_d(k) / cmf_d_dia(k) + prep_qtl_d(k) = prep_qtl_d(k) / cmf_d_dia(k) + prep_thli_d(k) = prep_thli_d(k) / cmf_d_dia(k) + prep_qti_d(k) = prep_qti_d(k) / cmf_d_dia(k) + eff_ql_d(k) = eff_ql_d(k) / cmf_d_dia(k) + eff_qi_d(k) = eff_qi_d(k) / cmf_d_dia(k) + PGF_u_d(k) = PGF_u_d(k) / cmf_d_dia(k) + PGF_v_d(k) = PGF_v_d(k) / cmf_d_dia(k) + do mt = 1, ncnst + evp_tr_d(k,mt) = evp_tr_d(k,mt) / cmf_d_dia(k) + prep_tr_d(k,mt) = prep_tr_d(k,mt) / cmf_d_dia(k) + eff_tr_d(k,mt) = eff_tr_d(k,mt) / cmf_d_dia(k) + enddo + else + cmf_d_dia(k) = 0._r8 + evp_thll_d(k) = 0._r8 + evp_qtl_d(k) = 0._r8 + evp_thli_d(k) = 0._r8 + evp_qti_d(k) = 0._r8 + prep_thll_d(k) = 0._r8 + prep_qtl_d(k) = 0._r8 + prep_thli_d(k) = 0._r8 + prep_qti_d(k) = 0._r8 + eff_ql_d(k) = 0._r8 + eff_qi_d(k) = 0._r8 + PGF_u_d(k) = 0._r8 + PGF_v_d(k) = 0._r8 + do mt = 1, ncnst + evp_tr_d(k,mt) = 0._r8 + prep_tr_d(k,mt) = 0._r8 + eff_tr_d(k,mt) = 0._r8 + enddo + endif + + ! ------------------------------------------------------- ! + ! Mean detrained properties from downdraft in each layer. ! + ! While all detrainment occurs at the base interface, ! + ! we define detrained properties in each layer. ! + ! ------------------------------------------------------- ! + + if( cmf_rd(k) .gt. nonzero ) then + thl_rd(k) = thl_rd(k) / cmf_rd(k) + qt_rd(k) = qt_rd(k) / cmf_rd(k) + u_rd(k) = u_rd(k) / cmf_rd(k) + v_rd(k) = v_rd(k) / cmf_rd(k) + ql_rd(k) = ql_rd(k) / cmf_rd(k) + qi_rd(k) = qi_rd(k) / cmf_rd(k) + do mt = 1, ncnst + tr_rd(k,mt) = tr_rd(k,mt) / cmf_rd(k) + enddo + else + cmf_rd(k) = 0._r8 + thl_rd(k) = 0._r8 + qt_rd(k) = 0._r8 + u_rd(k) = 0._r8 + v_rd(k) = 0._r8 + ql_rd(k) = 0._r8 + qi_rd(k) = 0._r8 + do mt = 1, ncnst + tr_rd(k,mt) = 0._r8 + enddo + endif + + ! ---------------------------------------------------------------------- ! + ! Computation of mean properties of all detrained source airs by summing ! + ! 1 detrained air from updrafts and 3 detrained airs from downdrafts. ! + ! ---------------------------------------------------------------------- ! + + cmf_r(k) = cmf_ru(k) + cmf_rd(k) + thl_r(k) = thl_ru(k) * cmf_ru(k) + thl_rd(k) * cmf_rd(k) + qt_r(k) = qt_ru(k) * cmf_ru(k) + qt_rd(k) * cmf_rd(k) + u_r(k) = u_ru(k) * cmf_ru(k) + u_rd(k) * cmf_rd(k) + v_r(k) = v_ru(k) * cmf_ru(k) + v_rd(k) * cmf_rd(k) + ql_r(k) = ql_ru(k) * cmf_ru(k) + ql_rd(k) * cmf_rd(k) + qi_r(k) = qi_ru(k) * cmf_ru(k) + qi_rd(k) * cmf_rd(k) + do mt = 1, ncnst + tr_r(k,mt) = tr_ru(k,mt) * cmf_ru(k) + tr_rd(k,mt) * cmf_rd(k) + enddo + if( cmf_r(k) .gt. nonzero ) then + thl_r(k) = thl_r(k) / cmf_r(k) + qt_r(k) = qt_r(k) / cmf_r(k) + u_r(k) = u_r(k) / cmf_r(k) + v_r(k) = v_r(k) / cmf_r(k) + ql_r(k) = ql_r(k) / cmf_r(k) + qi_r(k) = qi_r(k) / cmf_r(k) + do mt = 1, ncnst + tr_r(k,mt) = tr_r(k,mt) / cmf_r(k) + enddo + else + cmf_r(k) = 0._r8 + thl_r(k) = 0._r8 + qt_r(k) = 0._r8 + u_r(k) = 0._r8 + v_r(k) = 0._r8 + ql_r(k) = 0._r8 + qi_r(k) = 0._r8 + do mt = 1, ncnst + tr_r(k,mt) = 0._r8 + enddo + endif + + ! ------------------------------------------------------------- ! + ! Treatment of detrained air purely from the convective updraft ! + ! ------------------------------------------------------------- ! + + cmf_r2(k) = cmf_ru2(k) + cmf_rd(k) + thl_r2(k) = thl_ru2(k) * cmf_ru2(k) + thl_rd(k) * cmf_rd(k) + qt_r2(k) = qt_ru2(k) * cmf_ru2(k) + qt_rd(k) * cmf_rd(k) + u_r2(k) = u_ru2(k) * cmf_ru2(k) + u_rd(k) * cmf_rd(k) + v_r2(k) = v_ru2(k) * cmf_ru2(k) + v_rd(k) * cmf_rd(k) + ql_r2(k) = ql_ru2(k) * cmf_ru2(k) + ql_rd(k) * cmf_rd(k) + qi_r2(k) = qi_ru2(k) * cmf_ru2(k) + qi_rd(k) * cmf_rd(k) + do mt = 1, ncnst + tr_r2(k,mt) = tr_ru2(k,mt) * cmf_ru2(k) + tr_rd(k,mt) * cmf_rd(k) + enddo + if( cmf_r2(k) .gt. nonzero ) then + thl_r2(k) = thl_r2(k) / cmf_r2(k) + qt_r2(k) = qt_r2(k) / cmf_r2(k) + u_r2(k) = u_r2(k) / cmf_r2(k) + v_r2(k) = v_r2(k) / cmf_r2(k) + ql_r2(k) = ql_r2(k) / cmf_r2(k) + qi_r2(k) = qi_r2(k) / cmf_r2(k) + do mt = 1, ncnst + tr_r2(k,mt) = tr_r2(k,mt) / cmf_r2(k) + enddo + else + cmf_r2(k) = 0._r8 + thl_r2(k) = 0._r8 + qt_r2(k) = 0._r8 + u_r2(k) = 0._r8 + v_r2(k) = 0._r8 + ql_r2(k) = 0._r8 + qi_r2(k) = 0._r8 + do mt = 1, ncnst + tr_r2(k,mt) = 0._r8 + enddo + endif + + ! 'Flux-convergence' and 'Subsidence-detrainment' consistent diagnostic output for use in the macrophysics. + + cmf_det(k) = cmf_r2(k) + ql_det(k) = ql_r2(k) + qi_det(k) = qi_r2(k) + + + ! ---------------------------------------------------------------------------------------------------------------------- ! + ! For more clear treatment fully consistent with the governing tendency equations, I can use 'cmf_r2(k), thl_r2(k),....' ! + ! in the below 'if' block instead of 'cmf_r(k), thl_r(k),....'. This should be tested in a near future. ! + ! I should do this today, after verifying that the modified code exactly reproduces the previous results. ! + ! Nov.14.2014. I added 'i_detrain' option: '0' is previous formula-inconsistent default, ! + ! '1' is a new formula consistent one. ! + ! ---------------------------------------------------------------------------------------------------------------------- ! + + if( i_detrain .eq. 0 ) then + + if( cmf_r(k) .gt. nonzero ) then + cu_cmfr_mxen(k,iter) = cmf_r(k) + cu_thlr_mxen(k,iter) = thl_r(k) - thl0(k) + cu_qtr_mxen(k,iter) = qt_r(k) - qt0(k) + cu_ur_mxen(k,iter) = u_r(k) - u0(k) + cu_vr_mxen(k,iter) = v_r(k) - v0(k) + cu_qlr_mxen(k,iter) = ql_r(k) - ql0(k) + cu_qir_mxen(k,iter) = qi_r(k) - qi0(k) + do mt = 1, ncnst + cu_trr_mxen(k,mt,iter) = tr_r(k,mt) - tr0(k,mt) + enddo + endif + + else + + if( cmf_r2(k) .gt. nonzero ) then + cu_cmfr_mxen(k,iter) = cmf_r2(k) + cu_thlr_mxen(k,iter) = thl_r2(k) - thl0(k) + cu_qtr_mxen(k,iter) = qt_r2(k) - qt0(k) + cu_ur_mxen(k,iter) = u_r2(k) - u0(k) + cu_vr_mxen(k,iter) = v_r2(k) - v0(k) + cu_qlr_mxen(k,iter) = ql_r2(k) - ql0(k) + cu_qir_mxen(k,iter) = qi_r2(k) - qi0(k) + do mt = 1, ncnst + cu_trr_mxen(k,mt,iter) = tr_r2(k,mt) - tr0(k,mt) + enddo + endif + + endif + + cu_cmfum_mxen(k,iter) = cmf_u_mix(k) + + if( cmf_rd(k) .gt. nonzero ) then + cu_cmfrd_mxen(k,iter) = cmf_rd(k) + cu_thlrd_mxen(k,iter) = thl_rd(k) - thl0(k) + cu_qtrd_mxen(k,iter) = qt_rd(k) - qt0(k) + cu_urd_mxen(k,iter) = u_rd(k) - u0(k) + cu_vrd_mxen(k,iter) = v_rd(k) - v0(k) + cu_qlrd_mxen(k,iter) = ql_rd(k) - ql0(k) + cu_qird_mxen(k,iter) = qi_rd(k) - qi0(k) + do mt = 1, ncnst + cu_trrd_mxen(k,mt,iter) = tr_rd(k,mt) - tr0(k,mt) + enddo + endif + + enddo + + ! --------------------------------------------------------------------------------------- ! + ! Compute rain and snow production tendencies & effective tendencies of cloud condensate. ! + ! Important Sanity Check for Positive Precipitation Flux. ! + ! --------------------------------------------------------------------------------------- ! + + do k = ktop, 1, -1 ! This is a layer index + km = k - 1 + qlten_eff_u(k) = ( g / dp0(k) ) * eff_ql_u(k) * cmf_u_dia(k) + qiten_eff_u(k) = ( g / dp0(k) ) * eff_qi_u(k) * cmf_u_dia(k) + qlten_eff_d(k) = ( g / dp0(k) ) * eff_ql_d(k) * cmf_d_dia(k) + qiten_eff_d(k) = ( g / dp0(k) ) * eff_qi_d(k) * cmf_d_dia(k) + do mt = 1, ncnst + trten_eff_u(k,mt) = ( g / dptr0(k,mt) ) * eff_tr_u(k,mt) * cmf_u_dia(k) + trten_eff_d(k,mt) = ( g / dptr0(k,mt) ) * eff_tr_d(k,mt) * cmf_d_dia(k) + enddo + ! ------------------------------------------------------------------------------------- ! + ! Below considers 'production of precipitation within updraft ( prep_qtl_u < 0 ) and ! + ! 'evaporation of precipitation within downdraft ( evp_qtl_d > 0 ). ! + ! 1. By multiplying mass flux, the updraft/downdraft area information are included. ! + ! 2. In a certain layer, qrten, qsten can be negative due to the evaporation. However, ! + ! its downward integrated 'rainflx, snowflx' is always positive at all interfaces ! + ! due to the how 'evp_qtl_d' is computed. ! + ! 3. Snow melting effect is included into 'qrten(k), qsten(k)'. Note that it should ! + ! not be included into 'qrten_u(k), qsten_u(k)' - very important. ! + ! Nov.29.2012. Add tracer 'trrsten' associated with rain/snow components. ! + ! Feb.06.2013. Note that wet deposition of aerosols (both interstitial and cloud-borne) ! + ! within convective updraft and downdraft will be treated as a part of ! + ! prep_tr_u(k,mt) and prep_tr_d(k,mt). Thus, I don't need separate use of ! + ! wdep_tr_u(k,mt) and wdep_tr_d(k,mt) in the below computation of ! + ! trten_dia_u(k,mt) and trten_dia_d(k,mt). ! + ! ------------------------------------------------------------------------------------- ! + thlten_dia_u(k) = ( g / dp0(k) ) * ( prep_thll_u(k) + prep_thli_u(k) + evp_thll_u(k) + evp_thli_u(k) ) * cmf_u_dia(k) + qtten_dia_u(k) = ( g / dp0(k) ) * ( prep_qtl_u(k) + prep_qti_u(k) + evp_qtl_u(k) + evp_qti_u(k) ) * cmf_u_dia(k) + qlten_dia_u(k) = ( g / dp0(k) ) * ( prep_qtl_u(k) ) * cmf_u_dia(k) + qiten_dia_u(k) = ( g / dp0(k) ) * ( prep_qti_u(k) ) * cmf_u_dia(k) + thlten_dia_d(k) = ( g / dp0(k) ) * ( prep_thll_d(k) + prep_thli_d(k) + evp_thll_d(k) + evp_thli_d(k) ) * cmf_d_dia(k) + qtten_dia_d(k) = ( g / dp0(k) ) * ( prep_qtl_d(k) + prep_qti_d(k) + evp_qtl_d(k) + evp_qti_d(k) ) * cmf_d_dia(k) + qlten_dia_d(k) = ( g / dp0(k) ) * ( prep_qtl_d(k) ) * cmf_d_dia(k) + qiten_dia_d(k) = ( g / dp0(k) ) * ( prep_qti_d(k) ) * cmf_d_dia(k) + do mt = 1, ncnst + trten_dia_u(k,mt) = ( g / dptr0(k,mt) ) * ( prep_tr_u(k,mt) + evp_tr_u(k,mt) ) * cmf_u_dia(k) + trten_dia_d(k,mt) = ( g / dptr0(k,mt) ) * ( prep_tr_d(k,mt) + evp_tr_d(k,mt) ) * cmf_d_dia(k) + enddo + qrten_u(k) = - ( g / dp0(k) ) * ( prep_qtl_u(k) + evp_qtl_u(k) ) * cmf_u_dia(k) ! >= 0 + qrten_d(k) = - ( g / dp0(k) ) * ( prep_qtl_d(k) + evp_qtl_d(k) ) * cmf_d_dia(k) ! <= 0 + qsten_u(k) = - ( g / dp0(k) ) * ( prep_qti_u(k) + evp_qti_u(k) ) * cmf_u_dia(k) ! >= 0 + qsten_d(k) = - ( g / dp0(k) ) * ( prep_qti_d(k) + evp_qti_d(k) ) * cmf_d_dia(k) ! <= 0 + qrten(k) = qrten_u(k) + qrten_d(k) + qsten(k) = qsten_u(k) + qsten_d(k) + end do + + ! ------------------------------------------------------------------------ ! + ! Grid-mean tendencies of non-conservative scalars: 'ql,qi' ! + ! This is a sum of compensating subsidence and condensate detrainment. ! + ! Note that 'ql(i)flx_u(i)' at surface is set to zero even though cmf_d(0) ! + ! was explicitly computed above. As a result, the tendency computation is ! + ! absolutely correct, which is good. ! + ! Mar.19.2014. Note that tendency computation will be done further below ! + ! after computing flux first. As discussed further below, ! + ! should compute non-zero convective flux (both updraft and ! + ! downdraft) for use with 'ipartition = 1' option. ! + ! ------------------------------------------------------------------------ ! + + do k = 1, ktop - 1 ! This is a top interface index or layer index + km = k - 1 + kp = k + 1 + um = abs( g * cmf_u(k) * dt ) + dm = abs( g * cmf_d(k) * dt ) + call envcon_flux( k, mkx, um, dm, ql0(1:mkx), ssql0(1:mkx), ps0(0:mkx), ql_env_u, ql_env_d ) + call envcon_flux( k, mkx, um, dm, qi0(1:mkx), ssqi0(1:mkx), ps0(0:mkx), qi_env_u, qi_env_d ) + ql_env_ua(k) = ql_env_u + qi_env_ua(k) = qi_env_u + ql_env_da(kp) = ql_env_d + qi_env_da(kp) = qi_env_d + if( iflux_env .eq. 0 ) then + ql_env_ua(k) = ql0bot(kp) + qi_env_ua(k) = qi0bot(kp) + ql_env_da(kp) = ql0top(k) + qi_env_da(kp) = qi0top(k) + endif + qlflx_u(k) = cmf_u(k) * ( ql_u(k) - ql_env_ua(k) ) + qiflx_u(k) = cmf_u(k) * ( qi_u(k) - qi_env_ua(k) ) + qlflx_d(k) = - cmf_d(k) * ( ql_d(k) - ql_env_da(kp) ) + qiflx_d(k) = - cmf_d(k) * ( qi_d(k) - qi_env_da(kp) ) + do mt = 1, ncnst + call envcon_flux( k, mkx, um, dm, tr0(1:mkx,mt), sstr0(1:mkx,mt), ps0(0:mkx), tr_env_u, tr_env_d ) + if( iflux_env .eq. 0 ) then + tr_env_u = tr0bot(kp,mt) + tr_env_d = tr0top(k,mt) + endif + trflx_u(k,mt) = cmf_u(k) * ( tr_u(k,mt) - tr_env_u ) + trflx_d(k,mt) = - cmf_d(k) * ( tr_d(k,mt) - tr_env_d ) + enddo + enddo + ! ------------------------------------------------------------------------------------------- ! + ! Mar.19.2014. Compute downdraft flux at the base interface. ! + ! Similar to the treatment of the updraft flux with 'ipartition = 1' option, ! + ! I should compute the downdraft flux at the surface interface, and partition ! + ! the downdraft surface flux uniformly over the entire cumulus layer or the ! + ! PBL depth. I should do this for the 'ql,qi' and 'tracers' too. ! + ! This treatment of the 'ql,qi,tracer' fluxes are done here before computing ! + ! corresponding tendencies, using the exactly same method used here below for ! + ! conservative scalars. ! + ! Note that at this stage, we have already computed non-zero cmf_d(0), thl_d(0), ! + ! qt_d(0), u_d(0), v_d(0), so that below treatment is perfectly correct. ! + ! Similar computation of convective fluxes at the surface for 'slflx_d(0), ! + ! qtflx_d(0), uflx_d(0), vflx_d(0)' will be done later. The same computation for ! + ! convective updraft fluxes at the surface for all the scalars wre already done ! + ! at the beginning portion of this module. Thus below computation for 'ql,qi' ! + ! and 'tracers' of convective downdraft fluxes at the surface is enough. ! + ! ------------------------------------------------------------------------------------------- ! + qlflx_d(0) = -cmf_d(0) * ( ql_d(0) - ql0bot(1) ) + qiflx_d(0) = -cmf_d(0) * ( qi_d(0) - qi0bot(1) ) + do mt = 1, ncnst + trflx_d(0,mt) = -cmf_d(0) * ( tr_d(0,mt) - tr0bot(1,mt) ) + enddo + + ! ----------------------------------------------------------------------------------- ! + ! Mar.19.2014. Computation of tendencies of 'ql,qi,tracers' using the fluxes. ! + ! Note that we are using non-zero surface fluxes here for consistent use ! + ! with the other conservativee scalars with ipartition=1. ! + ! ----------------------------------------------------------------------------------- ! + + do k = 1, ktop + km = k - 1 + qlten_u(k) = ( g / dp0(k) ) * ( qlflx_u(km) - qlflx_u(k) ) + qlten_dia_u(k) + qlten_eff_u(k) + qiten_u(k) = ( g / dp0(k) ) * ( qiflx_u(km) - qiflx_u(k) ) + qiten_dia_u(k) + qiten_eff_u(k) + qlten_d(k) = ( g / dp0(k) ) * ( qlflx_d(km) - qlflx_d(k) ) + qlten_dia_d(k) + qlten_eff_d(k) + qiten_d(k) = ( g / dp0(k) ) * ( qiflx_d(km) - qiflx_d(k) ) + qiten_dia_d(k) + qiten_eff_d(k) + do mt = 1, ncnst + trten_u(k,mt) = ( g / dptr0(k,mt) ) * ( trflx_u(km,mt) - trflx_u(k,mt) ) + trten_dia_u(k,mt) + trten_eff_u(k,mt) + trten_d(k,mt) = ( g / dptr0(k,mt) ) * ( trflx_d(km,mt) - trflx_d(k,mt) ) + trten_dia_d(k,mt) + trten_eff_d(k,mt) + enddo + + end do + + ! ----------------------------------------------------- ! + ! Tendency due to Compensating Subsidence : [ kg/kg/s ] ! + ! ----------------------------------------------------- ! + + do k = 1, ktop + km = k - 1 + kp = k + 1 + if( k .eq. 1 ) then + qlten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( ql0(k+1) - ql0(1) ) / ( p0(1) - p0(k+1) ) + qiten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( qi0(k+1) - qi0(1) ) / ( p0(1) - p0(k+1) ) + elseif( k .eq. ktop ) then + qlten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( ql0(ktop) - ql0(k-1) ) / ( p0(k-1) - p0(ktop) ) + qiten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( qi0(ktop) - qi0(k-1) ) / ( p0(k-1) - p0(ktop) ) + else + qlten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( ql0(k+1) - ql0(k-1) ) / ( p0(k-1) - p0(k+1) ) + qiten_sub(k) = g * 0.5_r8 * ( cmf_u(k) + cmf_u(km) - cmf_d(k) - cmf_d(km) ) * & + ( qi0(k+1) - qi0(k-1) ) / ( p0(k-1) - p0(k+1) ) + endif + enddo + + ! ---------------------------------------------------- ! + ! Tendency due to Condensate Detrainment : [ kg/kg/s ] ! + ! ---------------------------------------------------- ! + + rliq = 0._r8 + do k = 1, ktop ! This is a layer index + km = k - 1 ! This is a base interface index + ! ------------------------------------------------------------------------------------------------------ ! + ! Nov.04.2014. For the fully consistent treatment directly relating 'flux-convergence' formula to ! + ! the 'subsidence-detrainment' formula, I should use 'cmf_r2(k), ql_r2(k), qi_r2(k)' in the below block. ! + ! Thus, I changed to the correct formula today. ! + ! ------------------------------------------------------------------------------------------------------ ! + ! qlten_det(k) = cmf_r(k) * ( ql_r(k) - ql0(k) ) * ( g / dp0(k) ) + ! qiten_det(k) = cmf_r(k) * ( qi_r(k) - qi0(k) ) * ( g / dp0(k) ) + qlten_det(k) = cmf_r2(k) * ( ql_r2(k) - ql0(k) ) * ( g / dp0(k) ) + qiten_det(k) = cmf_r2(k) * ( qi_r2(k) - qi0(k) ) * ( g / dp0(k) ) + rqc_l(k) = 0._r8 + rqc_i(k) = 0._r8 + rnc_l(k) = 0._r8 + rnc_i(k) = 0._r8 + rqc(k) = rqc_l(k) + rqc_i(k) + rliq = rliq + rqc(k) * dp0(k) / g / 1000._r8 ! [ liquid m/s ] + enddo ! k = 1, ktop. Here, 'k' is a layer index. + + ! -------------------------------------------- ! + ! ! + ! Grid-Mean Tendencies of Conservative Scalars ! + ! ! + ! -------------------------------------------- ! + + ! ----------------------------------------------------------------- ! + ! When convective updraft plumes launch from the surface ( k = 0 ), ! + ! also specify non-zero updraft flux value at surface. ! + ! By defult, the flux at surface is set to be zero. ! + ! As expected, this 'kiss=0' causes conservation error. ! + ! However, by setting I_cri = 0 when kiss = 0, we can avoid ! + ! conservation error in a most reasonable way. ! + ! ----------------------------------------------------------------- ! + + ! ---------------------------------- ! + ! Tendency due to Convective Updraft ! + ! ---------------------------------- ! + + do k = 1, ktop - 1 ! This is a layer index + um = abs( g * cmf_u(k) * dt ) + dm = 0._r8 + call envcon_flux( k, mkx, um, dm, thl0(1:mkx), ssthl0(1:mkx), ps0(0:mkx), thl_env_u, thl_env_d ) + call envcon_flux( k, mkx, um, dm, qt0(1:mkx), ssqt0(1:mkx), ps0(0:mkx), qt_env_u, qt_env_d ) + call envcon_flux( k, mkx, um, dm, u0(1:mkx), ssu0(1:mkx), ps0(0:mkx), u_env_u, u_env_d ) + call envcon_flux( k, mkx, um, dm, v0(1:mkx), ssv0(1:mkx), ps0(0:mkx), v_env_u, v_env_d ) + ! ---------------------------- ! + ! Use UW approach as an option ! + ! ---------------------------- ! + if( iflux_env .eq. 0 ) then + thl_env_u = thl0bot(k+1) + qt_env_u = qt0bot(k+1) + u_env_u = u0bot(k+1) + v_env_u = v0bot(k+1) + endif + + slflx_u(k) = cp * exns0(k) * cmf_u(k) * ( thl_u(k) - thl_env_u ) + qtflx_u(k) = cmf_u(k) * ( qt_u(k) - qt_env_u ) + uflx_u(k) = cmf_u(k) * ( u_u(k) - u_env_u ) + vflx_u(k) = cmf_u(k) * ( v_u(k) - v_env_u ) + + end do + + do k = 1, ktop + km = k - 1 + slten_u(k) = ( g / dp0(k) ) * ( slflx_u(km) - slflx_u(k) ) + cp * exn0(k) * thlten_dia_u(k) + qtten_u(k) = ( g / dp0(k) ) * ( qtflx_u(km) - qtflx_u(k) ) + qtten_dia_u(k) + uten_u(k) = ( g / dp0(k) ) * ( uflx_u(km) - uflx_u(k) ) + vten_u(k) = ( g / dp0(k) ) * ( vflx_u(km) - vflx_u(k) ) + sten_u(k) = slten_u(k) + xlv * qlten_u(k) + xls * qiten_u(k) + qvten_u(k) = qtten_u(k) - qlten_u(k) - qiten_u(k) + end do + + ! ------------------------------------------------------------------------ ! + ! Tendency due to Convective Downdraft ! + ! Note that the fluxes at surface are set to zero even though cmf_d(0) ! + ! was explicitly computed above. As a result, the tendency computation is ! + ! absolutely correct, which is good. ! + ! ------------------------------------------------------------------------ ! + + do k = 1, ktop - 1 ! This is a top interface index or layer index + um = abs( g * cmf_u(k) * dt ) + dm = abs( g * cmf_d(k) * dt ) + call envcon_flux( k, mkx, um, dm, thl0(1:mkx), ssthl0(1:mkx), ps0(0:mkx), thl_env_u, thl_env_d ) + call envcon_flux( k, mkx, um, dm, qt0(1:mkx), ssqt0(1:mkx), ps0(0:mkx), qt_env_u, qt_env_d ) + call envcon_flux( k, mkx, um, dm, u0(1:mkx), ssu0(1:mkx), ps0(0:mkx), u_env_u, u_env_d ) + call envcon_flux( k, mkx, um, dm, v0(1:mkx), ssv0(1:mkx), ps0(0:mkx), v_env_u, v_env_d ) + + ! ---------------------------- ! + ! Use UW approach as an option ! + ! ---------------------------- ! + if( iflux_env .eq. 0 ) then + thl_env_d = thl0top(k) + qt_env_d = qt0top(k) + u_env_d = u0top(k) + v_env_d = v0top(k) + endif + + slflx_d(k) = - cp * exns0(k) * cmf_d(k) * ( thl_d(k) - thl_env_d ) + qtflx_d(k) = - cmf_d(k) * ( qt_d(k) - qt_env_d ) + uflx_d(k) = - cmf_d(k) * ( u_d(k) - u_env_d ) + vflx_d(k) = - cmf_d(k) * ( v_d(k) - v_env_d ) + + end do + ! ------------------------------------------------------------------------------------------- ! + ! Mar.19.2014. Compute downdraft flux at the base interface. ! + ! Similar to the treatment of the updraft flux with 'ipartition = 1' option, ! + ! I should compute the downdraft flux at the surface interface, and partition ! + ! the downdraft surface flux uniformly over the entire cumulus layer or the ! + ! PBL depth. I should do this for the 'ql,qi' and 'tracers' too. ! + ! This treatment of the 'ql,qi,tracer' fluxes are done above before computing ! + ! corresponding tendencies, using the exactly same method used here below for ! + ! conservative scalars. ! + ! Note that at this stage, we have already computed non-zero cmf_d(0), thl_d(0), ! + ! qt_d(0), u_d(0), v_d(0), so that below treatment is perfectly correct. ! + ! ------------------------------------------------------------------------------------------- ! + slflx_d(0) = - cp * exns0(0) * cmf_d(0) * ( thl_d(0) - thl0bot(1) ) + qtflx_d(0) = - cmf_d(0) * ( qt_d(0) - qt0bot(1) ) + uflx_d(0) = - cmf_d(0) * ( u_d(0) - u0bot(1) ) + vflx_d(0) = - cmf_d(0) * ( v_d(0) - v0bot(1) ) + + ! ----------------------------------------------------------------------------------------------------- ! + ! Aug.30.2011. Compute downdraft flux associated with convective organization at the PBL top interface. ! + ! Also compute buoyancy flux to compute 'convective organization' and 'vertical velocity ! + ! perturbation at surface associated with convective organization. ! + ! Sep.07.2011. I should carefully choose whether I want to impose specific choice of only positive ! + ! buoyancy flux. ! + ! Sep.09.2011. New computation is made for imposing a full consistency and a full generality. ! + ! Now, the case of negative buoyancy flux at the PBL top as well as positive buoyancy flux ! + ! is completely and generally treated. ! + ! ----------------------------------------------------------------------------------------------------- ! + + if( cmf_d_org_pblh .gt. nonzero ) then + thlflx_d_org_pblh = - cmf_d_org_pblh * ( thl_d_org_pblh - thl0PBL ) + qtflx_d_org_pblh = - cmf_d_org_pblh * ( qt_d_org_pblh - qt0PBL ) + uflx_d_org_pblh = - cmf_d_org_pblh * ( u_d_org_pblh - u0PBL ) + vflx_d_org_pblh = - cmf_d_org_pblh * ( v_d_org_pblh - v0PBL ) + do mt = 1, ncnst + trflx_d_org_pblh(mt) = - cmf_d_org_pblh * ( tr_d_org_pblh(mt) - tr0PBL(mt) ) + enddo + else + cmf_d_org_pblh = 0._r8 + thlflx_d_org_pblh = 0._r8 + qtflx_d_org_pblh = 0._r8 + uflx_d_org_pblh = 0._r8 + vflx_d_org_pblh = 0._r8 + ! thvflx_d_org_pblh = 0._r8 + trflx_d_org_pblh(1:ncnst) = 0._r8 + endif + + ! -------------------------------------------------------------------------------------------------------------------------- ! + ! May.1.2014. ! + ! For the treatment of budget consistent coldpool (i_budget_coldpool = 1,2), add the computation of 'qtflx_d_orgU_pblh' from ! + ! the downdrafts that exclusively sinks down into '1-awk_PBL' instead of 'awk_PBL' as the above, and also 'qtflx_u_org_pblh' ! + ! that is the flux by convective updraft defalted from the PBL. Note that 'qtflx_u_org_pblh' is slightly different from the ! + ! already computed 'qtflx_u(kpblhm)' in that sense that 'qtflx_u_org_pblh' is using 'qt0PBL'. Since we are considering the ! + ! budget of 'bulk' budget for coldpool treatment, we should use 'qtflx_u_org_pblh' instead of 'qtflx_u(kpblhm)' for the ! + ! fully internally-self consistent treatment of cold pool. ! + ! -------------------------------------------------------------------------------------------------------------------------- ! + + if( cmf_d_orgU_pblh .gt. nonzero ) then + thlflx_d_orgU_pblh = - cmf_d_orgU_pblh * ( thl_d_orgU_pblh - thl0PBL ) + qtflx_d_orgU_pblh = - cmf_d_orgU_pblh * ( qt_d_orgU_pblh - qt0PBL ) + uflx_d_orgU_pblh = - cmf_d_orgU_pblh * ( u_d_orgU_pblh - u0PBL ) + vflx_d_orgU_pblh = - cmf_d_orgU_pblh * ( v_d_orgU_pblh - v0PBL ) + ! Aug.30.2011. Modification is required in the below block for cloud liquid and ice droplet number + ! following the previous treatment above since we are assuming a certain fixed droplet + ! radius for convective updraft and downdraft. However, since convective downdraft is + ! likely not to have any condensate, below is likely to be OK for the time being. + do mt = 1, ncnst + trflx_d_orgU_pblh(mt) = - cmf_d_orgU_pblh * ( tr_d_orgU_pblh(mt) - tr0PBL(mt) ) + enddo + else + cmf_d_orgU_pblh = 0._r8 + thlflx_d_orgU_pblh = 0._r8 + qtflx_d_orgU_pblh = 0._r8 + uflx_d_orgU_pblh = 0._r8 + vflx_d_orgU_pblh = 0._r8 + trflx_d_orgU_pblh(1:ncnst) = 0._r8 + endif + + cmf_u_org_pblh = cmf_u(kpblhm) + !lim if( cmf_u_org_pblh .gt. nonzero ) then + thlflx_u_org_pblh = cmf_u_org_pblh * ( thl_u(kpblhm) - thl0PBL ) + qtflx_u_org_pblh = cmf_u_org_pblh * ( qt_u(kpblhm) - qt0PBL ) + uflx_u_org_pblh = cmf_u_org_pblh * ( u_u(kpblhm) - u0PBL ) + vflx_u_org_pblh = cmf_u_org_pblh * ( v_u(kpblhm) - v0PBL ) + do mt = 1, ncnst + trflx_u_org_pblh(mt) = cmf_u_org_pblh * ( tr_u(kpblhm,mt) - tr0PBL(mt) ) + enddo + !lim else + !lim cmf_u_org_pblh = 0._r8 + !lim thlflx_u_org_pblh = 0._r8 + !lim qtflx_u_org_pblh = 0._r8 + !lim uflx_u_org_pblh = 0._r8 + !lim vflx_u_org_pblh = 0._r8 + !lim trflx_u_org_pblh(1:ncnst) = 0._r8 + !lim endif + + ! -------------------------------------------------- ! + ! Compute grid-mean tendency by convective downdraft ! + ! -------------------------------------------------- ! + + do k = 1, ktop + km = k - 1 + slten_d(k) = ( g / dp0(k) ) * ( slflx_d(km) - slflx_d(k) ) + cp * exn0(k) * thlten_dia_d(k) + qtten_d(k) = ( g / dp0(k) ) * ( qtflx_d(km) - qtflx_d(k) ) + qtten_dia_d(k) + uten_d(k) = ( g / dp0(k) ) * ( uflx_d(km) - uflx_d(k) ) + vten_d(k) = ( g / dp0(k) ) * ( vflx_d(km) - vflx_d(k) ) + sten_d(k) = slten_d(k) + xlv * qlten_d(k) + xls * qiten_d(k) + qvten_d(k) = qtten_d(k) - qlten_d(k) - qiten_d(k) + end do + + ! ------------------------------------------------------------------------------------- ! + ! Final Grid-Mean Evaporation Tendency ! + ! Nov.29.2012. Add corresponding tracer part. Here, we use proportional relationship ! + ! using the fluxes of 'precipitation' and 'tracers' at the top interface. ! + ! This seems to be correct and most reasonable approach. ! + ! If flx_all --> 0, then evprain_msfc(k,msfc) + evpsnow_msfc(k,msfc) --> 0,! + ! so that unreasonable large-value is automatically prohibited, which is ! + ! very good. ! + ! The same approach is used for the evaporation within downdraft. ! + ! Dec.01.2012. Do separate treatment for precipitating droplet numbers. ! + ! ------------------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------ ! + ! Compute grid-mean tendencies by averaging or summing all the ! + ! updraft segment tendencies. ! + ! ------------------------------------------------------------ ! + + do k = ktop, 1, -1 ! 'k' is a layer index : 'mkx'('1') is the top ('bottom') layer + ! ------------------------------------------------------------ ! + ! Save the results into the array of grid-mean state variables.! + ! For tracers, I temporarily set it to be zero but it should ! + ! be refined later. ! + ! Oct.12.2010. Note that I added 'snowmlt_e(k)' in 'slten_evp' ! + ! ------------------------------------------------------------ ! + do msfc = 1, nseg + snowmlt_e(k) = snowmlt_e(k) + snowmlt_e_msfc(k,msfc) + ntraprd(k) = ntraprd(k) + ntraprd_msfc(k,msfc) + ntsnprd(k) = ntsnprd(k) + ntsnprd_msfc(k,msfc) + evprain_e(k) = evprain_e(k) + evprain_e_msfc(k,msfc) + evpsnow_e(k) = evpsnow_e(k) + evpsnow_e_msfc(k,msfc) + evprain_d(k) = evprain_d(k) + evprain_d_msfc(k,msfc) + evpsnow_d(k) = evpsnow_d(k) + evpsnow_d_msfc(k,msfc) + flxrain(k) = flxrain(k) + flxrain_msfc(k,msfc) + flxsnow(k) = flxsnow(k) + flxsnow_msfc(k,msfc) + cvp_rainprd(k) = cvp_rainprd(k) + cvp_rainprd_msfc(k,msfc) + cvp_snowprd(k) = cvp_snowprd(k) + cvp_snowprd_msfc(k,msfc) + a_p(k) = a_p(k) + a_p_msfc(k,msfc) + am_up(k) = am_up(k) + am_up_msfc(k,msfc) + am_us(k) = am_us(k) + am_us_msfc(k,msfc) + am_evp(k) = am_evp(k) + am_evp_msfc(k,msfc) + am_pu(k) = am_pu(k) + am_pu_msfc(k,msfc) + am_pd(k) = am_pd(k) + am_pd_msfc(k,msfc) + am_pr(k) = am_pr(k) + am_pr_msfc(k,msfc) + am_ps(k) = am_ps(k) + am_ps_msfc(k,msfc) + ! Nov.29.2012. Add tracer block. + ! Dec.13.2012. Add the line of wet deposition within enironment. Note that wet deposition + ! within convective updraft and downdraft have already been computed. + do mt = 1, ncnst + nttrrsprd(k,mt) = nttrrsprd(k,mt) + nttrrsprd_msfc(k,msfc,mt) + evptrrs_e(k,mt) = evptrrs_e(k,mt) + evptrrs_e_msfc(k,msfc,mt) + evptrrs_d(k,mt) = evptrrs_d(k,mt) + evptrrs_d_msfc(k,msfc,mt) + wdeptrrs_e(k,mt) = wdeptrrs_e(k,mt) + wdeptrrs_e_msfc(k,msfc,mt) + flxtrrs(k,mt) = flxtrrs(k,mt) + flxtrrs_msfc(k,msfc,mt) + cvp_trrsprd(k,mt) = cvp_trrsprd(k,mt) + cvp_trrsprd_msfc(k,msfc,mt) + end do + end do + ! Since evaporation within downdraft has already been treated as a part of downdraft tendency ( qtten_d(k) ), + ! below treatment of '_evp(k)' should only contain the processes occuring within the environment. + qlten_evp(k) = 0._r8 + qiten_evp(k) = 0._r8 + qvten_evp(k) = evprain_e(k) - cvp_rainprd(k) + evpsnow_e(k) - cvp_snowprd(k) + qtten_evp(k) = qlten_evp(k) + qiten_evp(k) + qvten_evp(k) + slten_evp(k) = -xlv*(evprain_e(k) - cvp_rainprd(k)) - xls*(evpsnow_e(k) - cvp_snowprd(k)) - (xls - xlv)*snowmlt_e(k) + sten_evp(k) = slten_evp(k) + xlv * qlten_evp(k) + xls * qiten_evp(k) + uten_evp(k) = 0._r8 + vten_evp(k) = 0._r8 + ! ----------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : EVAPORATION OF CONVECTIVE PRECIPITATION WITHIN ENVIRONMENT ! + ! Nov.29.2012. Below is updated and correctly computed. ! + ! Dec.13.2012. I should carefully check whether below is double-counting with the separate ! + ! routine of wet deposition of aerosols. ! + ! Dec.13.2012. Add wet deposition part. ! + ! Note that 'evptrrs > 0' and 'wdeptrrs > 0'. Note also that wet deposition ! + ! component is only applied to tracers not to the other thermodynamic scalars. ! + ! For convenience and following previous code, 'cvp_trrsprd' is added into ! + ! the 'trten_evp'. ! + ! Note that (-) sign should be multiplied in front of 'wdeptrrs'. ! + ! Dec.13.2012. Note that 'cvp_trrsprd > 0' contains corrective tendencies associated with ! + ! evaporation both within downdraft and environment, so that it is a function ! + ! of 'evptrrs'. This re-geration of aerosols by evaporation of precipitation ! + ! i.e., 'evptrrs' is to some degree already treated in the separate wet ! + ! deposition routine. Thus, in order to precent double counting in the current ! + ! CAM5 structure, I should in principle remove 'evptrrs' in the below formula ! + ! of 'trten_evp'. If then, however, 'trten_evp << 0', so that resulting ! + ! concentration of aerosols after convection may become negative. Of course, ! + ! by using 'positive_tracer' subroutine, negative tracer will be eventually ! + ! converted into positive tracer. So, in order to reduce global AOD, ! + ! let's remove 'evptrrs' in the below computation of trten_evp. ! + ! Feb.05.2013. Note that below 'trten_evp(k,mt),trten_wdep(k,mt)' are tendencies only by ! + ! the processes within environment, since corresponding tendencies occuring ! + ! within convective updraft and downdraft have already been treated and saved ! + ! into 'trten_dia_u(k,mt)' and 'trten_dia_d(k,mt)'. ! + ! All final tendencies of tracers associated with diabatic forcings within ! + ! environment ( trten_evp, trten_wdep ) are totally handled in the below block.! + ! Thus, for correct computation of tracer tendency ( trten not trrsten ) by ! + ! evaporation and wet deposition within environment, I only need to modify ! + ! below block, which is sufficient and necessary. ! + ! ----------------------------------------------------------------------------------------- ! + do mt = 1, ncnst + if( mt .eq. 1 .or. mt .eq. ixcldliq .or. mt .eq. ixcldice .or. mt .eq. ixnumliq .or. mt .eq. ixnumice ) then + trten_evp(k,mt) = 0._r8 + trten_wdep(k,mt) = 0._r8 + else + !? ! In principle, I should use below two lines with appropriate computations of evptrrs_e(k,mt) + !? ! and wdeptrrs_e(k,mt) in the main program. However, in order to avoid double counting with + !? ! the similar treatment in the separate wet deposition routine in CAM5, I temporary set + !? ! these two tendencies to zero. In future, if I turn-off wet deposition treatment by + !? ! convective precipitation in the separate routine in CAM5 ( i.e., by setting input cumulus + !? ! area and convective precipitation to be zero ), I can use my robust below formula. + ! trten_evp(k,mt) = - evptrrs_e(k,mt) - cvp_trrsprd(k,mt) + ! trten_wdep(k,mt) = - wdeptrrs_e(k,mt) + trten_evp(k,mt) = - cvp_trrsprd(k,mt) + trten_wdep(k,mt) = 0._r8 + endif + enddo + ! ----------------------------------------------------------------------------------------- ! + ! TRACERS REFINEMENT NECESSARY : EVAPORATION OF CONVECTIVE PRECIPITATION WITHIN ENVIRONMENT ! + ! ----------------------------------------------------------------------------------------- ! + end do + + ! ----------------------------- ! + ! Precipitation flux at surface ! + ! Nov.29.2012. Add tracer block ! + ! ----------------------------- ! + do msfc = 1, nseg + flxrain(0) = flxrain(0) + flxrain_msfc(0,msfc) + flxsnow(0) = flxsnow(0) + flxsnow_msfc(0,msfc) + ! Nov.29.2012. Add tracer block. + do mt = 1, ncnst + flxtrrs(0,mt) = flxtrrs(0,mt) + flxtrrs_msfc(0,msfc,mt) + end do + a_p(0) = a_p(0) + a_p_msfc(0,msfc) + end do + precip = ( flxrain(0) + flxsnow(0) ) / 1000._r8 + snow = flxsnow(0) / 1000._r8 + + ! -------------------------------------------------------------------------------------------------------- ! + ! Vertically-integrated grid-mean differential evaporation rate of convective precipitation ( aw*(Qn-Qw) ) ! + ! averaged over the PBL depth. Note that this should only consider didbatic forcing within environment not ! + ! within convective downdraft since diabatic forcing within convective downdraft has already been computed ! + ! above. ! + ! I should also include 'corrective flux' ( 'cev' ) and 'snow melting'. ! + ! For simplicity, I will assume that 'corrective flux' is homogeneous across the grid and so does not ! + ! contribute to the computation of aw*(Qn-Qw). ! + ! Snow melting is assumed to occur even in the convective updraft in contrast to the ! + ! evaporation of convective precipitation. In order to treat snow melting more rigorously, I shoud use the ! + ! precipitation area before treating evaporation within downdraft ( a_p_prevp(k) defined at the interface )! + ! since snow melting was treated before evaporation within downdraft. ! + ! As a more rigorous choice, I will assume that 'evaporation area, a_evp' is either within ! + ! completely within 'non-wake' area or within 'wake' area whenever possible. This different geometrical ! + ! structure might be roughly described by using the similar tilting parameter, 'beta2'. ! + ! Conceptually, it seems to be most reasonable to assume that whenever possible, evaporation area exists ! + ! within wake area ( i.e., beta2 = 1 ). ! + ! Future works : Treatment of tracers should be refined in future. Note that snow melting does not affect ! + ! tracer concentrations. So, I can use tmp2 not tmp3. ! + ! Sep.09.2011. Below block is commented-out since it will be computed later below in a collectively way ! + ! for the whole wake forcing computation. ! + ! -------------------------------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------- ! + ! ! + ! Compute Grid-Mean Tendencies without repartitioning and dissipation heating ! + ! ! + ! --------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------- ! + ! Currently, no constraint is imposed on qvten(k), qlten(k), qiten(k).! + ! But negative condensate will be treated in positive_moisture in ! + ! the above subroutine. ! + ! ------------------------------------------------------------------- ! + + do k = 1, ktop + + slten_NUM(k) = slten_u(k) + slten_d(k) + slten_evp(k) + qtten_NUM(k) = qtten_u(k) + qtten_d(k) + qtten_evp(k) + uten_NUM(k) = uten_u(k) + uten_d(k) + uten_evp(k) + vten_NUM(k) = vten_u(k) + vten_d(k) + vten_evp(k) + + qlten_NUM(k) = qlten_u(k) + qlten_d(k) + qlten_evp(k) + qiten_NUM(k) = qiten_u(k) + qiten_d(k) + qiten_evp(k) + do mt = 1, ncnst + trten_NUM(k,mt) = trten_u(k,mt) + trten_d(k,mt) + trten_evp(k,mt) + trten_wdep(k,mt) + enddo + + qvten_NUM(k) = qtten_NUM(k) - qlten_NUM(k) - qiten_NUM(k) + sten_NUM(k) = slten_NUM(k) + xlv * qlten_NUM(k) + xls * qiten_NUM(k) + + enddo + + ! ---------------------------------------------------------------------------------------- ! + ! Repartition the tendency in the lowest model layer ! + ! into all the layers within the PBL or top of convection or whole atmospheric layer. ! + ! It seems to be most reasonable to distribute to the whole convection layer. ! + ! Note that the partition is done only for surface updraft flux not downdraft flux. ! + ! Sep.12.2011. I double checked that my below 'ipartition' formula is perfect because ! + ! (1) it conserves column-integrated energy, and (2) it completely remove ! + ! the generation of unreasonable convective tendency in the lowest model ! + ! layer by convection, so that it grauantees computation of reasonable ! + ! surface heat, moisture, momentum, and tracer fluxes at surface in the ! + ! following surface flux computation routine in the CAM. Also, I don't ! + ! need to modify any parts of CAM5 ( e.g., PBL scheme, surface flux ! + ! routine ), since all the required modifications are contained in the ! + ! UNICON in a fully reasonable way. ! + ! By using 'ipartition = 1' option, I don't need to combine 'symmetric ! + ! moist turbulence scheme' with the 'asymmetric moist turbulence scheme' ! + ! within the implicit iteration loop, so that I can save tremendous amount ! + ! of computation time. ! + ! Oct.24.2011. For correct consistent output, I should also correct flux at each model ! + ! interface, i.e., from each flux interface, I should subtract linear flux ! + ! profile that is 'slflx_u(0)' at surface but 'zero' at k = ktop interface. ! + ! Mar.19.2014. I should compute a similar non-zero partitioning tendency of 'ql,qi' below, ! + ! which is done on this day. In addition, I added the similar portion of ! + ! convective downdraft fluxes in computing below partitioning tendencies. ! + ! Note that 'kpblhm >= 1' and 'iopt_partition = 2' might be more conceptually ! + ! consistent with the cold-pool formulation. ! + ! ---------------------------------------------------------------------------------------- ! + + + if( iup_par .eq. 1 ) then ! Lowest Layer - No Partitioning + ktop_up_par = 1 + elseif( iup_par .eq. 2 ) then ! Minimum of PBL Top and Cumulus Top + ktop_up_par = min( kpblhm, ktop ) + elseif( iup_par .eq. 3 ) then ! PBL Layers + ktop_up_par = kpblhm + elseif( iup_par .eq. 4 ) then ! Cumulus Layers + ktop_up_par = ktop + elseif( iup_par .eq. 5 ) then ! Entire Layers + ktop_up_par = mkx + endif + + if( idn_par .eq. 1 ) then ! Lowest Layer - No Partitioning + ktop_dn_par = 1 + elseif( idn_par .eq. 2 ) then ! Minimum of PBL Top and Cumulus Top + ktop_dn_par = min( kpblhm, ktop ) + elseif( idn_par .eq. 3 ) then ! PBL Layers + ktop_dn_par = kpblhm + elseif( idn_par .eq. 4 ) then ! Cumulus Layers + ktop_dn_par = ktop + elseif( idn_par .eq. 5 ) then ! Entire Layers + ktop_dn_par = mkx + endif + + do k = ktop_up_par, 1, -1 + tmp2 = g / ( ps0(0) - ps0( ktop_up_par ) ) + slten_par(k) = - slflx_u(0) * tmp2 + qtten_par(k) = - qtflx_u(0) * tmp2 + uten_par(k) = - uflx_u(0) * tmp2 + vten_par(k) = - vflx_u(0) * tmp2 + qlten_par(k) = - qlflx_u(0) * tmp2 + qiten_par(k) = - qiflx_u(0) * tmp2 + do mt = 1, ncnst + trten_par(k,mt) = - trflx_u(0,mt) * tmp2 + enddo + ! -------------------------------------------------------------------------- ! + ! Oct.24.2011. Added below block for diagnostic 'ipartition' flux output. ! + ! Note that below correction does not change simulation output. ! + ! Mar.20.2014. Note that fluxes at the surface are printed-out as non-zero ! + ! purely for the diagnostic purpose. However, in the numerical ! + ! computation they are treated to be zero with partitioning. ! + ! -------------------------------------------------------------------------- ! + tmp1 = ( ps0(k) - ps0( ktop_up_par ) ) / ( ps0(0) - ps0( ktop_up_par ) ) + slflx_u(k) = slflx_u(k) - slflx_u(0) * tmp1 + qtflx_u(k) = qtflx_u(k) - qtflx_u(0) * tmp1 + uflx_u(k) = uflx_u(k) - uflx_u(0) * tmp1 + vflx_u(k) = vflx_u(k) - vflx_u(0) * tmp1 + qlflx_u(k) = qlflx_u(k) - qlflx_u(0) * tmp1 + qiflx_u(k) = qiflx_u(k) - qiflx_u(0) * tmp1 + do mt = 1, ncnst + trflx_u(k,mt) = trflx_u(k,mt) - trflx_u(0,mt) * tmp1 + enddo + enddo + + do k = ktop_dn_par, 1, -1 + tmp2 = g / ( ps0(0) - ps0( ktop_dn_par ) ) + slten_par(k) = slten_par(k) - slflx_d(0) * tmp2 + qtten_par(k) = qtten_par(k) - qtflx_d(0) * tmp2 + uten_par(k) = uten_par(k) - uflx_d(0) * tmp2 + vten_par(k) = vten_par(k) - vflx_d(0) * tmp2 + qlten_par(k) = qlten_par(k) - qlflx_d(0) * tmp2 + qiten_par(k) = qiten_par(k) - qiflx_d(0) * tmp2 + do mt = 1, ncnst + trten_par(k,mt) = trten_par(k,mt) - trflx_d(0,mt) * tmp2 + enddo + ! -------------------------------------------------------------------------- ! + ! Oct.24.2011. Added below block for diagnostic 'ipartition' flux output. ! + ! Note that below correction does not change simulation output. ! + ! Mar.20.2014. Note that fluxes at the surface are printed-out as non-zero ! + ! purely for the diagnostic purpose. However, in the numerical ! + ! computation they are treated to be zero with partitioning. ! + ! -------------------------------------------------------------------------- ! + tmp1 = ( ps0(k) - ps0( ktop_dn_par ) ) / ( ps0(0) - ps0( ktop_dn_par ) ) + slflx_d(k) = slflx_d(k) - slflx_d(0) * tmp1 + qtflx_d(k) = qtflx_d(k) - qtflx_d(0) * tmp1 + uflx_d(k) = uflx_d(k) - uflx_d(0) * tmp1 + vflx_d(k) = vflx_d(k) - vflx_d(0) * tmp1 + qlflx_d(k) = qlflx_d(k) - qlflx_d(0) * tmp1 + qiflx_d(k) = qiflx_d(k) - qiflx_d(0) * tmp1 + do mt = 1, ncnst + trflx_d(k,mt) = trflx_d(k,mt) - trflx_d(0,mt) * tmp1 + enddo + enddo + + do k = max( ktop_up_par, ktop_dn_par ), 1, -1 + slten_NUM(k) = slten_NUM(k) + slten_par(k) + qtten_NUM(k) = qtten_NUM(k) + qtten_par(k) + uten_NUM(k) = uten_NUM(k) + uten_par(k) + vten_NUM(k) = vten_NUM(k) + vten_par(k) + qlten_NUM(k) = qlten_NUM(k) + qlten_par(k) + qiten_NUM(k) = qiten_NUM(k) + qiten_par(k) + qvten_NUM(k) = qtten_NUM(k) - qlten_NUM(k) - qiten_NUM(k) + sten_NUM(k) = slten_NUM(k) + xlv * qlten_NUM(k) + xls * qiten_NUM(k) + do mt = 1, ncnst + trten_NUM(k,mt) = trten_NUM(k,mt) + trten_par(k,mt) + enddo + enddo + + ! -------------------------------------------------------------------------- ! + ! Reset surface flux to be zero for column energy conservation. ! + ! I commented-out below lines for looking at the detailed diagnostic output. ! + ! Note that this resetting does not influence numerical computation at all. ! + ! Oct.24.2011. I restored below block for correct diagnostic output. ! + ! Mar.19.2014. I added downdraft portition with the ipartition=1 condition ! + ! and also 'ql,qi' portions. ! + ! However, I commented-out below block on this day to see the ! + ! actual non-zero convective fluxes at the surface. ! + ! -------------------------------------------------------------------------- ! + !par if( ipartition .eq. 1 .and. kiss .eq. 0 ) then + !par slflx_u(0) = 0._r8 + !par qtflx_u(0) = 0._r8 + !par uflx_u(0) = 0._r8 + !par vflx_u(0) = 0._r8 + !par qlflx_u(0) = 0._r8 + !par qiflx_u(0) = 0._r8 + !par do mt = 1, ncnst + !par trflx_u(0,mt) = 0._r8 + !par enddo + !par slflx_d(0) = 0._r8 + !par qtflx_d(0) = 0._r8 + !par uflx_d(0) = 0._r8 + !par vflx_d(0) = 0._r8 + !par qlflx_d(0) = 0._r8 + !par qiflx_d(0) = 0._r8 + !par do mt = 1, ncnst + !par trflx_d(0,mt) = 0._r8 + !par enddo + !par endif + + ! ---------------------------------------------------------------------- ! + ! Choose either 'NUMerial' or 'ANAlytical' tendency as a final tendency. ! + ! ---------------------------------------------------------------------- ! + + uten(:mkx) = uten_NUM(:mkx) + vten(:mkx) = vten_NUM(:mkx) + qlten(:mkx) = qlten_NUM(:mkx) + qiten(:mkx) = qiten_NUM(:mkx) + qvten(:mkx) = qvten_NUM(:mkx) + sten(:mkx) = sten_NUM(:mkx) + do mt = 1, ncnst + trten(:mkx,mt) = trten_NUM(:mkx,mt) + enddo + + ! ----------------------------------------------------------------------------------- ! + ! Save '_mxen' variables associated with multiple mixing environmental airs. ! + ! Aug.01.2011. Brian Juwon Park's 10th Birthday. ! + ! The explicit ensemble mixing process 'iter' routine are included here. ! + ! I have a hunch that this is the remaining final process I should ! + ! implement into the UNICON. ! + ! ----------------------------------------------------------------------------------- ! + + cmf_u_mxen(0:mkx,iter) = cmf_u(0:mkx) + cmf_d_mxen(0:mkx,iter) = cmf_d(0:mkx) + slflx_u_mxen(0:mkx,iter) = slflx_u(0:mkx) + slflx_d_mxen(0:mkx,iter) = slflx_d(0:mkx) + qtflx_u_mxen(0:mkx,iter) = qtflx_u(0:mkx) + qtflx_d_mxen(0:mkx,iter) = qtflx_d(0:mkx) + uflx_u_mxen(0:mkx,iter) = uflx_u(0:mkx) + uflx_d_mxen(0:mkx,iter) = uflx_d(0:mkx) + vflx_u_mxen(0:mkx,iter) = vflx_u(0:mkx) + vflx_d_mxen(0:mkx,iter) = vflx_d(0:mkx) + + flxrain_u_mxen(0:mkx,iter) = flxrain(0:mkx) + flxsnow_u_mxen(0:mkx,iter) = flxsnow(0:mkx) + + ! ------------------------------------------------------------------------------------------------------------------------------------------- ! + ! Aug.31.2011. Add downdraft flux at the PBL top interface associated with convective organization ! + ! in order to parameterize density current and convective organization. ! + ! Sep.07.2011. Compute total organization densitiy current forcing of conservative scalars and thv ! + ! for the difference between non-wake area and grid-mean. ! + ! Include not only adiabatic forcing but also diabatic forcing both within convective ! + ! downdraft and environment. Also change the variable name from 'thlflx_d_org_pblh_mxen' ! + ! to 'thl_orgforce_mxen' to denote that it includes all adiabatic and diabatic forcings. ! + ! CAREFUL CONSIDERATION : Also impose a constraint based on the sign of total buoyancy forcing, if necessary. ! + ! Below is overall forcing averaged over the PBL. ! + ! The sum of below 3 should be positive in order to generate negative 'thv' anomaly within wake area or ! + ! equivalently, positive 'thv' anomaly within the non-wake area. ! + ! 1. Adiabatic forcing : thvflx_d_org_pblh * g / pblhp [ K / s ] ! + ! 2. Diabatic forcing within convective downdraft : thl_dia_d_org * ( 1._r8 + zvir * qt0PBL ) + zvir * thl0PBL * qt_dia_d_org [ K / s ] ! + ! 3. Diabatic forcing within environment : thl_dia_env_org * ( 1._r8 + zvir * qt0PBL ) + zvir * thl0PBL * qt_dia_env_org [ K / s ] ! + ! ! + ! Sep.07.2011. I also included 'inverse tau' into the mxen array in the below block. ! + ! Here, 'cd_' is non-dimensional darg coefficient for each conservative scalar and 'ws' is wind speed in the lowest model layer. ! + ! Temporarily, these drag coefficients are set to zero but we can include this component later. ! + ! Note that 'awk_' should not have this drag component since vertical mass exchange does not occur between the surface and ! + ! atmosphere. ! + ! ( Example ) Fs [J/s/m2] = rho * cp * cd_thl * ws1 * ( Ts - thl0(1) ). Thus, if we know Ts, we can back up 'cd_thl'. ! + ! Sep.07.2011. Instead of setting to zero, let's use a certain characteristic value of cd = 1.5e-3 for all scalars. ! + ! The ;thv' is not prognosed anymore for full consistency. ! + ! ------------------------------------------------------------------------------------------------------------------------------------------- ! + + ! -------------------------------------------- ! + ! ! + ! Computation of all the wake-related forcings ! + ! ! + ! -------------------------------------------- ! + + ! -------------------------------------------------------------------------------------------------------------------- ! + ! 2. Differential diabatic forcing between 'non-wake' and 'all over the grid'. ! + ! ONLY WITHIN convective updraft and downdraft ( ['a_nw*Q_nw'/a_nw - 'grid-mean Q']_only_within_updraft_downdraft ) ! + ! NOT WITHIN environmental portions of 'non-wake' and 'all over the grid'. ! + ! The 'und' denotes 'updraft and downdraft' in contrast to 'env' which denotes environment. ! + ! Note that we should not include 'momentum forcing' here since 'momentum C' is conversion not diabatic forcing. ! + ! The resulting units are [ kg / kg / s ], [ K / s ], [ # / kg / s ] or [ kg / kg / s ]. ! + ! Sep.10.2011. Below block is alternatively chosen for using selectively chosen convective downdraft instead of ! + ! all convective downdrafts. ! + ! Sep.13.2011. Through rigorous methematical derivation, I double-checked that ! + ! Below is always valid regardless whether I choose all convective downdraft or selective downdraft. ! + ! -------------------------------------------------------------------------------------------------------------------- ! + + qt_dia_und_org = 0._r8 + thl_dia_und_org = 0._r8 + tr_dia_und_org(1:ncnst) = 0._r8 + tmp2 = awk_PBL / ( 1._r8 - awk_PBL ) + + do k = 1, kpblhm + qt_dia_und_org = qt_dia_und_org + dp0(k) * ( tmp2 * qtten_dia_u(k) ) + thl_dia_und_org = thl_dia_und_org + dp0(k) * ( tmp2 * thlten_dia_u(k) ) + do mt = 1, ncnst + tr_dia_und_org(mt) = tr_dia_und_org(mt) + dp0(k) * ( tmp2 * ( trten_dia_u(k,mt) + trten_eff_u(k,mt) ) ) + enddo + enddo + qt_dia_und_org = qt_dia_und_org / pblhp - qt_dia_d_org + thl_dia_und_org = thl_dia_und_org / pblhp - thl_dia_d_org + do mt = 1, ncnst + tr_dia_und_org(mt) = tr_dia_und_org(mt) / pblhp - tr_dia_d_org(mt) + enddo + + ! ------------------------------------------------------------------------------------------------------------- ! + ! 2. Differential diabatic forcing between 'non-wake' and 'all over the grid' ! + ! ONLY WITHIN environmental portions of 'non-wake' and 'all over the grid'. ! + ! This is caused by two processes : (1) evaporation of precipitation within environment, ! + ! (2) snow melting within environment. ! + ! The corrective tendendies 'cev' is inevitable assumed to occur uniformly all over the grid ! + ! and so does not contribute here. ! + ! Note als that I am assuming dissipative heating is uniformly distributed all over the grid ! + ! and so does not contribute here. ! + ! The resulting units are [ kg / kg / s ], [ K / s ], [ # / kg / s ] or [ kg / kg / s ]. ! + ! Below 'tmp2' is from the the assumption of homogeneous distribution. ! + ! tmp2 = - ( awk_PBL / ( 1._r8 - awk_PBL ) ) * ( am_u(k) / ( 1._r8 - am_u(k) ) ! + ! Here, 'a_evp_wk' is overlapping area between 'evaporation area' and 'wake area'. Similar to the ! + ! overlapping treatment between precipitation area and updraft fractional area, I am using additional ! + ! tilting parameter to control the overlap between evaporation area ( am_evp(k) ) and wake area ( awk_PBL ). ! + ! Note that 'beta1' is likely to be related to 'beta2'. ! + ! Rigorously speaking, since below formula is explicitly using a_p_prevp(k), below treatment of snow melting ! + ! is only valid if 'i_snowmlt = 0' and so all snow melting occurs before evaporation within downdraft ( ! + ! thus 'snowmlt(k) = 0' but 'snowmlt_e(k) > 0 ' ) ! + ! However, since I will choose 'i_snowmlt = 0' as a default forever, below treatment is completely correct. ! + ! Sep.09.2011. I checked couple of times that below formula is completely correct. ! + ! Note that snow melting does not influence the tracers. ! + ! Oct.03.2011. Since 'am_p_wk' and 'tmp3' are used for partitioning snow melting and since snow melting was ! + ! computed before evaporation of precipitation within downdraft and environment, I should use ! + ! the 'a_p_prevp' not the 'a_p' in computing 'am_p_wk' and 'tmp3' below. Thus, my below code ! + ! is completely correct. ! + ! ------------------------------------------------------------------------------------------------------------- ! + + qt_dia_env_org = 0._r8 + thl_dia_env_org = 0._r8 + tr_dia_env_org(1:ncnst) = 0._r8 + do k = 1, kpblhm + am_evp_nw = ( 1._r8 - beta2 ) * am_evp(k) * ( 1._r8 - awk_PBL ) + beta2 * max( am_evp(k) - awk_PBL, 0._r8 ) + am_p_nw = am_pu(k) + (1._r8 - beta2)*(a_p(k) - am_pu(k))*(1._r8 - awk_PBL) + & + beta2*max( a_p(k) - am_pu(k) - awk_PBL, 0._r8 ) + tmp2 = ( 1._r8 / ( 1._r8 - awk_PBL ) ) * ( am_evp_nw - am_evp(k) * ( 1._r8 - awk_PBL ) ) + tmp3 = ( 1._r8 / ( 1._r8 - awk_PBL ) ) * ( am_p_nw - a_p(k) * ( 1._r8 - awk_PBL ) ) + qt_dia_env_org = qt_dia_env_org + tmp2*( evprain_e(k) + evpsnow_e(k) ) / max( am_evp(k), nonzero ) * dp0(k) + thl_dia_env_org = thl_dia_env_org + (tmp2*(-xlv*evprain_e(k) - xls*evpsnow_e(k))/max(am_evp(k),nonzero) + & + tmp3*(-(xls-xlv)*snowmlt_e(k))/max(a_p(k),nonzero))/(cp*exn0(k))*dp0(k) + + am_evp_nw_st = (1._r8 - beta2_st)*am_evp_st(k)*(1._r8 - awk_PBL) + beta2_st*max( am_evp_st(k) - awk_PBL, 0._r8 ) + tmp2_st = ( 1._r8 / ( 1._r8 - awk_PBL ) ) * ( am_evp_nw_st - am_evp_st(k) * ( 1._r8 - awk_PBL ) ) + qt_dia_env_org = qt_dia_env_org + tmp2_st*(evprain_st(k) + evpsnow_st(k)) / max( am_evp_st(k), nonzero ) * dp0(k) + thl_dia_env_org = thl_dia_env_org + ( tmp2_st * ( - xlv * evprain_st(k) - xls * evpsnow_st(k) ) / & + max( am_evp_st(k), nonzero ) ) / ( cp * exn0(k) ) * dp0(k) + do mt = 1, ncnst + tr_dia_env_org(mt) = tr_dia_env_org(mt) + tmp2 * ( trten_evp(k,mt) + trten_wdep(k,mt) ) * dp0(k) + enddo + enddo + qt_dia_env_org = qt_dia_env_org / pblhp + thl_dia_env_org = thl_dia_env_org / pblhp + do mt = 1, ncnst + tr_dia_env_org(mt) = tr_dia_env_org(mt) / pblhp + enddo + + ! ---------------------------------------------------------------------------------- ! + ! Computation of total wake forcing and relaxation time scale ! + ! Sep.09.2011. Note that I don't need to impose any limitation based on the the sign ! + ! of buoyancy flux or forcing since now UNICON can generally handle all ! + ! of the cases of positive and negative buoyancy forcings. ! + ! Note that I don't need to prognose 'thv' anymore since it will be ! + ! computed diagnostically from the prognosed 'thl,qt' at the beginning ! + ! of nex time step. This will impose a full consistency into the model. ! + ! Sep.16.2011. Note that 'cdrag' should be further reduced in principle since the ! + ! entrainment flux at the PBL top in the 'a_D' area will be reduced due ! + ! to enhanced stratification at the PBL top within 'a_D'. ! + ! This reduced entrainment effect should be simulated by the 'cdrag' ! + ! alone in the current UNICON. Thus, we should use smaller 'cdrag' ! + ! than the common value of 1.5e-3. The use of small value will also ! + ! improve the diurnal cycle. ! + ! In addition, in order to reduce model sensitivity to the vertical ! + ! resolution, we may dfine 'ws1' using the PBL-averaged wind instead of ! + ! the value in the lowest model layer. This should be considered in ! + ! future. ! + ! Dec.20.2012. Bug fix. In computing inverse relaxation time scale of conservative ! + ! scalars (taui below) other than 'taui_awk_mxen', I should include ! + ! the following below term which has a unit of [1/s] : ! + ! ( g / pblhp ) * max( 0._r8, cmf_d(kpblhm) - cmf_d_org_pblh ) : [1/s] ! + ! This correction will help to reduce simulated convective organization ! + ! due to the increase of damping effect. This is fully physically and ! + ! conceptually consistent. ! + ! Dec.20.2012. In addition, I also add entrainment rate at the PBL top interface, ! + ! went_eff [m/s] as well as 'cmf_d(kpblhm) - cmf_d_org_pblh' in ! + ! computing 'tmp3' below. Note that the unit of rho0(kpblhm) * went_eff ! + ! is [ kg / m2 / s ], same as the unit of the mass flux. ! + ! ---------------------------------------------------------------------------------- ! + + ! ------------------------ ! + ! 1. Relaxation Time Scale ! + ! ------------------------ ! + + tmp1 = ( g / pblhp ) + ! May.1.2014. Correct budget of cold pool. + if( i_budget_coldpool .eq. 0 ) then + tmp3 = tmp1 * ( max( 0._r8, cmf_d(kpblhm) - cmf_d_org_pblh ) - cmf_u(kpblhm) + rho0(kpblhm) * went_eff ) + elseif( i_budget_coldpool .eq. 3 ) then + tmp3 = tmp1 * ( max( 0._r8, cmf_d(kpblhm) - cmf_d_org_pblh ) + rho0(kpblhm) * went_eff - & + ( ( 1._r8 - awk_PBL * cdelta_s ) / ( 1._r8 - awk_PBL ) ) * cmf_u(kpblhm) ) + elseif( i_budget_coldpool .eq. 6 ) then + tmp3 = tmp1 * ( max( 0._r8, cmf_d(kpblhm) - cmf_d_org_pblh ) + rho0(kpblhm) * went_eff - & + ( ( 1._r8 - awk_PBL * cdelta_s ) / ( 1._r8 - awk_PBL ) ) * cmf_u_org_pblh ) + elseif( i_budget_coldpool .eq. 1 .or. i_budget_coldpool .eq. 2 ) then + tmp3 = tmp1 * ( max( 0._r8, cmf_d(kpblhm) - cmf_d_org_pblh - cmf_d_orgU_pblh ) + & + ( cmf_d_orgU_pblh - cmf_u_org_pblh ) / ( 1._r8 - awk_PBL ) + rho0(kpblhm) * went_eff ) + elseif( i_budget_coldpool .eq. 4 ) then + tmp3 = tmp1 * ( max( 0._r8, cmf_d_orgU_pblh / ( 1._r8 - awk_PBL ) ) - cmf_u(kpblhm) + rho0(kpblhm) * went_eff ) + elseif( i_budget_coldpool .eq. 5 ) then + tmp3 = tmp1 * ( cmf_d_orgU_pblh / ( 1._r8 - awk_PBL ) + rho0(kpblhm) * went_eff - & + ( ( 1._r8 - awk_PBL * cdelta_s ) / ( 1._r8 - awk_PBL ) ) * cmf_u(kpblhm) ) + endif + tmp4 = awk_PBL / ( 1._r8 - awk_PBL ) + ws1 = sqrt( u0(1)**2._r8 + v0(1)**2._r8 ) + cd_thl = cdrag + cd_qt = cdrag + cd_u = cdrag + cd_v = cdrag + cd_tr(:ncnst) = cdrag + + if( int_del_wk .eq. 1 ) then + del_wk_eff = c_del_wk * tmp1 * awk_PBL * cmf_u(kpblhm) + endif + + taui_thl_mxen(iter) = del_wk_eff / max( nonzero, awk_PBL * ( 1._r8 - awk_PBL ) ) + cd_thl * tmp1 * ws1 * rho0(1) + tmp3 + taui_qt_mxen(iter) = del_wk_eff / max( nonzero, awk_PBL * ( 1._r8 - awk_PBL ) ) + cd_qt * tmp1 * ws1 * rho0(1) + tmp3 + taui_u_mxen(iter) = del_wk_eff / max( nonzero, awk_PBL * ( 1._r8 - awk_PBL ) ) + cd_u * tmp1 * ws1 * rho0(1) + tmp3 + taui_v_mxen(iter) = del_wk_eff / max( nonzero, awk_PBL * ( 1._r8 - awk_PBL ) ) + cd_v * tmp1 * ws1 * rho0(1) + tmp3 + + do mt = 1, ncnst + taui_tr_mxen(mt,iter) = del_wk_eff/max(nonzero, awk_PBL*(1._r8 - awk_PBL)) + cd_tr(mt) * tmp1 * ws1 * rho0(1) + tmp3 + enddo + + ! May.1.2014. Correct budget of cold pool. + if( i_budget_coldpool .eq. 0 .or. i_budget_coldpool .eq. 3 ) then + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh - cmf_u(kpblhm) ) + elseif( i_budget_coldpool .eq. 6 ) then + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh - cmf_u_org_pblh ) + else + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh + cmf_d_orgU_pblh - cmf_u_org_pblh ) + endif + + if( i_energy_coldpool .eq. 1 .or. i_energy_coldpool .eq. 2 ) then + + taui_thl_mxen(iter) = del_wk0 / max( nonzero, ( 1._r8 - awk_PBL ) ) + cd_thl * tmp1 * ws1 * rho0(1) + tmp3 + taui_qt_mxen(iter) = del_wk0 / max( nonzero, ( 1._r8 - awk_PBL ) ) + cd_qt * tmp1 * ws1 * rho0(1) + tmp3 + taui_u_mxen(iter) = del_wk0 / max( nonzero, ( 1._r8 - awk_PBL ) ) + cd_u * tmp1 * ws1 * rho0(1) + tmp3 + taui_v_mxen(iter) = del_wk0 / max( nonzero, ( 1._r8 - awk_PBL ) ) + cd_v * tmp1 * ws1 * rho0(1) + tmp3 + do mt = 1, ncnst + taui_tr_mxen(mt,iter) = del_wk0 / max( nonzero, ( 1._r8 - awk_PBL ) ) + cd_tr(mt) * tmp1 * ws1 * rho0(1) + tmp3 + enddo + + ! May.1.2014. Correct budget of cold pool. + if( i_budget_coldpool .eq. 0 .or. i_budget_coldpool .eq. 3 ) then + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh - cmf_u(kpblhm) ) + ( del_wk0 - eps_wk0 ) + elseif( i_budget_coldpool .eq. 6 ) then + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh - cmf_u_org_pblh ) + ( del_wk0 - eps_wk0 ) + else + taui_awk_mxen(iter) = tmp1 * ( cmf_d_org_pblh + cmf_d_orgU_pblh - cmf_u_org_pblh ) + ( del_wk0 - eps_wk0 ) + endif + + endif + + del_org_mxen(iter) = awk_PBL * ( 1._r8 - awk_PBL ) * ( g / pblhp ) * cmf_u(kpblhm) + del0_org_mxen(iter) = ( 1._r8 - awk_PBL ) * ( g / pblhp ) * cmf_u(kpblhm) + + ! --------------------- ! + ! 2. Total Wake Forcing ! + ! --------------------- ! + + ! May.1.2014. Correct budget of cold pool. Note that 'awk_force_mxen' is identical to the previous case. + + if( i_budget_coldpool .eq. 0 .or. i_budget_coldpool .eq. 3 ) then + + thl_orgforce_mxen(iter) = thlflx_d_org_pblh * tmp1 + thl_dia_und_org + thl_dia_env_org + qt_orgforce_mxen(iter) = qtflx_d_org_pblh * tmp1 + qt_dia_und_org + qt_dia_env_org + u_orgforce_mxen(iter) = uflx_d_org_pblh * tmp1 + v_orgforce_mxen(iter) = vflx_d_org_pblh * tmp1 + do mt = 1, ncnst + tr_orgforce_mxen(mt,iter) = trflx_d_org_pblh(mt) * tmp1 + tr_dia_und_org(mt) + tr_dia_env_org(mt) + enddo + + elseif( i_budget_coldpool .eq. 1 .or. i_budget_coldpool .eq. 2 ) then + + thl_orgforce_mxen(iter) = ( thlflx_d_org_pblh - tmp4 * ( thlflx_u_org_pblh + thlflx_d_orgU_pblh ) ) * tmp1 + & + thl_dia_und_org + tmp4 * thl_dia_d_orgU + thl_dia_env_org + qt_orgforce_mxen(iter) = ( qtflx_d_org_pblh - tmp4 * ( qtflx_u_org_pblh + qtflx_d_orgU_pblh ) ) * tmp1 + & + qt_dia_und_org + tmp4 * qt_dia_d_orgU + qt_dia_env_org + u_orgforce_mxen(iter) = ( uflx_d_org_pblh - tmp4 * ( uflx_u_org_pblh + uflx_d_orgU_pblh ) ) * tmp1 + v_orgforce_mxen(iter) = ( vflx_d_org_pblh - tmp4 * ( vflx_u_org_pblh + vflx_d_orgU_pblh ) ) * tmp1 + do mt = 1, ncnst + tr_orgforce_mxen(mt,iter)=(trflx_d_org_pblh(mt) - tmp4*( trflx_u_org_pblh(mt) + trflx_d_orgU_pblh(mt) ) ) * tmp1 +& + tr_dia_und_org(mt) + tmp4 * tr_dia_d_orgU(mt) + tr_dia_env_org(mt) + enddo + + elseif( i_budget_coldpool .eq. 4 .or. i_budget_coldpool .eq. 5 ) then + + thl_orgforce_mxen(iter) = ( thlflx_d_org_pblh - tmp4 * ( 0._r8 + thlflx_d_orgU_pblh ) ) * tmp1 + & + thl_dia_und_org + tmp4 * thl_dia_d_orgU + thl_dia_env_org + qt_orgforce_mxen(iter) = ( qtflx_d_org_pblh - tmp4 * ( 0._r8 + qtflx_d_orgU_pblh ) ) * tmp1 + & + qt_dia_und_org + tmp4 * qt_dia_d_orgU + qt_dia_env_org + u_orgforce_mxen(iter) = ( uflx_d_org_pblh - tmp4 * ( 0._r8 + uflx_d_orgU_pblh ) ) * tmp1 + v_orgforce_mxen(iter) = ( vflx_d_org_pblh - tmp4 * ( 0._r8 + vflx_d_orgU_pblh ) ) * tmp1 + do mt = 1, ncnst + tr_orgforce_mxen(mt,iter)= ( trflx_d_org_pblh(mt) - tmp4 * ( 0._r8 + trflx_d_orgU_pblh(mt) ) ) * tmp1 + & + tr_dia_und_org(mt) + tmp4 * tr_dia_d_orgU(mt) + tr_dia_env_org(mt) + enddo + + elseif( i_budget_coldpool .eq. 6 ) then + + thl_orgforce_mxen(iter) = (thlflx_d_org_pblh - tmp4 * ( thlflx_u_org_pblh - cmf_u_org_pblh * cdelta_s * & + delta_thl_PBL ) ) * tmp1 + thl_dia_und_org + thl_dia_env_org + qt_orgforce_mxen(iter) = ( qtflx_d_org_pblh - tmp4 * ( qtflx_u_org_pblh - cmf_u_org_pblh * cdelta_s * & + delta_qt_PBL ) ) * tmp1 + & + qt_dia_und_org + qt_dia_env_org + u_orgforce_mxen(iter) = ( uflx_d_org_pblh - tmp4 * ( uflx_u_org_pblh - cmf_u_org_pblh * cdelta_s * & + delta_u_PBL ) ) * tmp1 + v_orgforce_mxen(iter) = ( vflx_d_org_pblh - tmp4 * ( vflx_u_org_pblh - cmf_u_org_pblh * cdelta_s * & + delta_v_PBL ) ) * tmp1 + do mt = 1, ncnst + tr_orgforce_mxen(mt,iter) = ( trflx_d_org_pblh(mt) - tmp4 * ( trflx_u_org_pblh(mt) - cmf_u_org_pblh * & + cdelta_s * delta_tr_PBL(mt) ) ) * tmp1 + & + tr_dia_und_org(mt) + tr_dia_env_org(mt) + enddo + + endif + + awk_orgforce_mxen(iter) = cmf_d_org_pblh * tmp1 + eps_wk_eff - del_wk_eff + + if( i_energy_coldpool .eq. 1 .or. i_energy_coldpool .eq. 2 ) then + + awk_orgforce_mxen(iter) = cmf_d_org_pblh * tmp1 + + endif + + ! -------------------------------------------------- ! + ! 2-1. Individual Wake Forcing for Diagnostic Output ! + ! -------------------------------------------------- ! + + thl_orgforce_flx_mxen(iter) = thlflx_d_org_pblh * tmp1 + thl_orgforce_und_mxen(iter) = thl_dia_und_org + thl_orgforce_env_mxen(iter) = thl_dia_env_org + + qt_orgforce_flx_mxen(iter) = qtflx_d_org_pblh * tmp1 + qt_orgforce_und_mxen(iter) = qt_dia_und_org + qt_orgforce_env_mxen(iter) = qt_dia_env_org + + u_orgforce_flx_mxen(iter) = uflx_d_org_pblh * tmp1 + u_orgforce_und_mxen(iter) = 0._r8 + u_orgforce_env_mxen(iter) = 0._r8 + + v_orgforce_flx_mxen(iter) = vflx_d_org_pblh * tmp1 + v_orgforce_und_mxen(iter) = 0._r8 + v_orgforce_env_mxen(iter) = 0._r8 + + awk_orgforce_flx_mxen(iter) = cmf_d_org_pblh * tmp1 + awk_orgforce_mix_mxen(iter) = eps_wk_eff - del_wk_eff + + cmf_d_org_pblh_mxen(iter) = cmf_d_org_pblh + + ! ---------------------------------------------------------------------------------------------------- ! + ! Sep.07.2011. I should carefully consider whether I want to include below buoyancy constraint or not. ! + ! It seems to be more transparent and safe to include below buoyancy constraint block. ! + ! Note that I still need to compute damping time scale for this case. ! + ! In case of 'taui_awk_mxen' and 'awk_orgforce_mxen', both of them are functions of ! + ! cmf_d_org_pblh. Thus, when below if conditions happens, both the 'taui_awk_mxen' and ! + ! 'awk_orgforce_mxen' should be consistently modified. However, we already imposed the ! + ! adiabatic forcing constraint on mass when buoyancy flux is negative, i.e,, I already ! + ! imposed the constraint of cmf_d_org_pblh = 0 before. So, in principle, I don't need to ! + ! do anything here. However, for safety, I also imposed the constraints on awk as below. ! + ! Sep.09.2011. I don't need below if constraint any more sine UNICON is quite generally formulated to ! + ! handle both positive/negative buoyancy forcing in wake. ! + ! ---------------------------------------------------------------------------------------------------- ! + + ! ------------------------- ! + ! End of Organization Block ! + ! ------------------------- ! + + qvten_mxen(:mkx,iter) = qvten(:mkx) + qlten_mxen(:mkx,iter) = qlten(:mkx) + qiten_mxen(:mkx,iter) = qiten(:mkx) + do mt = 1, ncnst + trten_mxen(:mkx,mt,iter) = trten(:mkx,mt) + enddo + sten_mxen(:mkx,iter) = sten(:mkx) + uten_mxen(:mkx,iter) = uten(:mkx) + vten_mxen(:mkx,iter) = vten(:mkx) + qrten_mxen(:mkx,iter) = qrten(:mkx) + qsten_mxen(:mkx,iter) = qsten(:mkx) + + rqc_l_mxen(:mkx,iter) = rqc_l(:mkx) + rqc_i_mxen(:mkx,iter) = rqc_i(:mkx) + rqc_mxen(:mkx,iter) = rqc(:mkx) + rnc_l_mxen(:mkx,iter) = rnc_l(:mkx) + rnc_i_mxen(:mkx,iter) = rnc_i(:mkx) + + cmf_det_mxen(:mkx,iter) = cmf_det(:mkx) + ql_det_mxen(:mkx,iter) = ql_det(:mkx) + qi_det_mxen(:mkx,iter) = qi_det(:mkx) + + evapc_mxen(:mkx,iter) = evapc(:mkx) + + am_u_mxen(:mkx,iter) = am_u(:mkx) + qlm_u_mxen(:mkx,iter) = qlm_u(:mkx) + qim_u_mxen(:mkx,iter) = qim_u(:mkx) + + am_d_mxen(:mkx,iter) = am_d(:mkx) + qlm_d_mxen(:mkx,iter) = qlm_d(:mkx) + qim_d_mxen(:mkx,iter) = qim_d(:mkx) + + rliq_mxen(iter) = rliq + precip_mxen(iter) = precip + snow_mxen(iter) = snow + + cnt_mxen(iter) = cnt + cnb_mxen(iter) = cnb + + slten_u_mxen(:mkx,iter) = slten_u(:mkx) + qtten_u_mxen(:mkx,iter) = qtten_u(:mkx) + uten_u_mxen(:mkx,iter) = uten_u(:mkx) + vten_u_mxen(:mkx,iter) = vten_u(:mkx) + sten_u_mxen(:mkx,iter) = sten_u(:mkx) + qvten_u_mxen(:mkx,iter) = qvten_u(:mkx) + qlten_u_mxen(:mkx,iter) = qlten_u(:mkx) + qiten_u_mxen(:mkx,iter) = qiten_u(:mkx) + do mt = 1, ncnst + trten_u_mxen(:mkx,mt,iter) = trten_u(:mkx,mt) + enddo + + slten_d_mxen(:mkx,iter) = slten_d(:mkx) + qtten_d_mxen(:mkx,iter) = qtten_d(:mkx) + uten_d_mxen(:mkx,iter) = uten_d(:mkx) + vten_d_mxen(:mkx,iter) = vten_d(:mkx) + sten_d_mxen(:mkx,iter) = sten_d(:mkx) + qvten_d_mxen(:mkx,iter) = qvten_d(:mkx) + qlten_d_mxen(:mkx,iter) = qlten_d(:mkx) + qiten_d_mxen(:mkx,iter) = qiten_d(:mkx) + do mt = 1, ncnst + trten_d_mxen(:mkx,mt,iter) = trten_d(:mkx,mt) + enddo + + slten_evp_mxen(:mkx,iter) = slten_evp(:mkx) + qtten_evp_mxen(:mkx,iter) = qtten_evp(:mkx) + uten_evp_mxen(:mkx,iter) = uten_evp(:mkx) + vten_evp_mxen(:mkx,iter) = vten_evp(:mkx) + sten_evp_mxen(:mkx,iter) = sten_evp(:mkx) + qvten_evp_mxen(:mkx,iter) = qvten_evp(:mkx) + qlten_evp_mxen(:mkx,iter) = qlten_evp(:mkx) + qiten_evp_mxen(:mkx,iter) = qiten_evp(:mkx) + do mt = 1, ncnst + trten_evp_mxen(:mkx,mt,iter) = trten_evp(:mkx,mt) + enddo + + qlten_sub_mxen(:mkx,iter) = qlten_sub(:mkx) + qiten_sub_mxen(:mkx,iter) = qiten_sub(:mkx) + + ! Apr.15.2014. Temporary Hack + + ! qlten_sub_mxen(:mkx,iter) = qrten_u(:mkx) + qsten_u(:mkx) + ! qiten_sub_mxen(:mkx,iter) = qrten_d(:mkx) + qsten_d(:mkx) + + qlten_det_mxen(:mkx,iter) = qlten_det(:mkx) + qiten_det_mxen(:mkx,iter) = qiten_det(:mkx) + + thl_u_mxen(0:mkx,iter) = thl_u(0:mkx) + qt_u_mxen(0:mkx,iter) = qt_u(0:mkx) + u_u_mxen(0:mkx,iter) = u_u(0:mkx) + v_u_mxen(0:mkx,iter) = v_u(0:mkx) + w_u_mxen(0:mkx,iter) = w_u(0:mkx) + ql_u_mxen(0:mkx,iter) = ql_u(0:mkx) + qi_u_mxen(0:mkx,iter) = qi_u(0:mkx) + do mt = 1, ncnst + tr_u_mxen(0:mkx,mt,iter) = tr_u(0:mkx,mt) + enddo + a_u_mxen(0:mkx,iter) = a_u(0:mkx) + num_u_mxen(0:mkx,iter) = num_u(0:mkx) + wa_u_mxen(0:mkx,iter) = wa_u(0:mkx) + qla_u_mxen(0:mkx,iter) = qla_u(0:mkx) + qia_u_mxen(0:mkx,iter) = qia_u(0:mkx) + rad_u_mxen(0:mkx,iter) = rad_u(0:mkx) + thva_u_mxen(0:mkx,iter) = thva_u(0:mkx) + + a_p_mxen(0:mkx,iter) = a_p(0:mkx) + am_evp_mxen(:mkx,iter) = am_evp(:mkx) + am_pu_mxen(:mkx,iter) = am_pu(:mkx) + x_p_mxen(0:mkx,iter) = x_p_msfc(0:mkx,1) + y_p_mxen(0:mkx,iter) = y_p_msfc(0:mkx,1) + x_um_mxen(:mkx,iter) = x_um_msfc(:mkx,1) + y_um_mxen(:mkx,iter) = y_um_msfc(:mkx,1) + + thl_d_mxen(0:mkx,iter) = thl_d(0:mkx) + qt_d_mxen(0:mkx,iter) = qt_d(0:mkx) + u_d_mxen(0:mkx,iter) = u_d(0:mkx) + v_d_mxen(0:mkx,iter) = v_d(0:mkx) + w_d_mxen(0:mkx,iter) = w_d(0:mkx) + ql_d_mxen(0:mkx,iter) = ql_d(0:mkx) + qi_d_mxen(0:mkx,iter) = qi_d(0:mkx) + do mt = 1, ncnst + tr_d_mxen(0:mkx,mt,iter) = tr_d(0:mkx,mt) + enddo + a_d_mxen(0:mkx,iter) = a_d(0:mkx) + wa_d_mxen(0:mkx,iter) = wa_d(0:mkx) + qla_d_mxen(0:mkx,iter) = qla_d(0:mkx) + qia_d_mxen(0:mkx,iter) = qia_d(0:mkx) + + thl_u_msfc_mxen(0:mkx,:nseg,iter) = thl_u_msfc(0:mkx,:nseg) + qt_u_msfc_mxen(0:mkx,:nseg,iter) = qt_u_msfc(0:mkx,:nseg) + u_u_msfc_mxen(0:mkx,:nseg,iter) = u_u_msfc(0:mkx,:nseg) + v_u_msfc_mxen(0:mkx,:nseg,iter) = v_u_msfc(0:mkx,:nseg) + w_u_msfc_mxen(0:mkx,:nseg,iter) = w_u_msfc(0:mkx,:nseg) + ql_u_msfc_mxen(0:mkx,:nseg,iter) = ql_u_msfc(0:mkx,:nseg) + qi_u_msfc_mxen(0:mkx,:nseg,iter) = qi_u_msfc(0:mkx,:nseg) + do mt = 1, ncnst + tr_u_msfc_mxen(0:mkx,:nseg,mt,iter) = tr_u_msfc(0:mkx,:nseg,mt) + enddo + cmf_u_msfc_mxen(0:mkx,:nseg,iter) = cmf_u_msfc(0:mkx,:nseg) + a_u_msfc_mxen(0:mkx,:nseg,iter) = a_u_msfc(0:mkx,:nseg) + num_u_msfc_mxen(0:mkx,:nseg,iter) = num_u_msfc(0:mkx,:nseg) + rad_u_msfc_mxen(0:mkx,:nseg,iter) = rad_u_msfc(0:mkx,:nseg) + + eps0_u_msfc_mxen(0:mkx,:nseg,iter) = eps0_u_msfc(0:mkx,:nseg) + eps_u_msfc_mxen(0:mkx,:nseg,iter) = eps_u_msfc(0:mkx,:nseg) + del_u_msfc_mxen(0:mkx,:nseg,iter) = del_u_msfc(0:mkx,:nseg) + eeps_u_msfc_mxen(0:mkx,:nseg,iter) = eeps_u_msfc(0:mkx,:nseg) + ddel_u_msfc_mxen(0:mkx,:nseg,iter) = ddel_u_msfc(0:mkx,:nseg) + xc_u_msfc_mxen(0:mkx,:nseg,iter) = xc_u_msfc(0:mkx,:nseg) + xs_u_msfc_mxen(0:mkx,:nseg,iter) = xs_u_msfc(0:mkx,:nseg) + xemin_u_msfc_mxen(0:mkx,:nseg,iter) = xemin_u_msfc(0:mkx,:nseg) + xemax_u_msfc_mxen(0:mkx,:nseg,iter) = xemax_u_msfc(0:mkx,:nseg) + cridis_u_msfc_mxen(0:mkx,:nseg,iter) = cridis_u_msfc(0:mkx,:nseg) + thvcuenv_u_msfc_mxen(0:mkx,:nseg,iter) = thvcuenv_u_msfc(0:mkx,:nseg) + thvegenv_u_msfc_mxen(0:mkx,:nseg,iter) = thvegenv_u_msfc(0:mkx,:nseg) + thvxsenv_u_msfc_mxen(0:mkx,:nseg,iter) = thvxsenv_u_msfc(0:mkx,:nseg) + fmix_u_msfc_mxen(0:mkx,:nseg,iter) = fmix_u_msfc(0:mkx,:nseg) + cmfumix_u_msfc_mxen(0:mkx,:nseg,iter) = cmfumix_u_msfc(0:mkx,:nseg) + + thl_d_msfc_mxen(0:mkx,:nseg,iter) = thl_d_msfc(0:mkx,:nseg) + qt_d_msfc_mxen(0:mkx,:nseg,iter) = qt_d_msfc(0:mkx,:nseg) + u_d_msfc_mxen(0:mkx,:nseg,iter) = u_d_msfc(0:mkx,:nseg) + v_d_msfc_mxen(0:mkx,:nseg,iter) = v_d_msfc(0:mkx,:nseg) + w_d_msfc_mxen(0:mkx,:nseg,iter) = w_d_msfc(0:mkx,:nseg) + ql_d_msfc_mxen(0:mkx,:nseg,iter) = ql_d_msfc(0:mkx,:nseg) + qi_d_msfc_mxen(0:mkx,:nseg,iter) = qi_d_msfc(0:mkx,:nseg) + do mt = 1, ncnst + tr_d_msfc_mxen(0:mkx,:nseg,mt,iter) = tr_d_msfc(0:mkx,:nseg,mt) + enddo + cmf_d_msfc_mxen(0:mkx,:nseg,iter) = cmf_d_msfc(0:mkx,:nseg) + a_d_msfc_mxen(0:mkx,:nseg,iter) = a_d_msfc(0:mkx,:nseg) + wa_d_msfc_mxen(0:mkx,:nseg,iter) = wa_d_msfc(0:mkx,:nseg) + qla_d_msfc_mxen(0:mkx,:nseg,iter) = qla_d_msfc(0:mkx,:nseg) + qia_d_msfc_mxen(0:mkx,:nseg,iter) = qia_d_msfc(0:mkx,:nseg) + + ptop_msfc_mxen(:nseg,iter) = ptop_msfc(:nseg) + ztop_msfc_mxen(:nseg,iter) = ztop_msfc(:nseg) + + ! ----------------------------------------------------------------------------------- ! + ! End of saving '_mxen' variables associated with multiple mixing environmental airs. ! + ! ----------------------------------------------------------------------------------- ! + + enddo ! End of iter = 1, niter. This is an iteration loop of whole vertical layer + + ! -------------------------------------------------------------------------------- ! + ! ! + ! Print-Out Formal Output Variables other than 'inout' Variables ! + ! ! + ! Aug.01.2011. Brian Juwon Park's 10th Birthday. ! + ! The average of explicit ensemble mixing process ! + ! are treated here. ! + ! Below formula only considers two-types of mixing ! + ! with iter = 1, 2 but multi-types of mixing can ! + ! be treated in future. ! + ! (1) iter = 1 : with mean environmental airs at the current time ! + ! (2) iter = 2 : with cumulus updraft + detrained airs at the ! + ! previous time step. ! + ! Note that I should use 'cuorg' not 'cuorg_mxen' in the below lines. ! + ! ! + ! -------------------------------------------------------------------------------- ! + + ! ------------------------- ! + ! 1. Flux at the Interfaces ! + ! ------------------------- ! + + do ki = 0, max( ktop_mxen(ixi) - 1, ktop_mxen(ixf) - 1 ) + kvi = mkx - ki + cmf_u_out(i,ki) = (1._r8 - cuorg)* cmf_u_mxen(ki,ixi) + cuorg*cmf_u_mxen(ki,ixf) + slflx_out(i,ki) = (1._r8 - cuorg)*(slflx_u_mxen(ki,ixi) + slflx_d_mxen(ki,ixi)) + cuorg*(slflx_u_mxen(ki,ixf) + & + slflx_d_mxen(ki,ixf) ) + qtflx_out(i,ki) = (1._r8 - cuorg)*(qtflx_u_mxen(ki,ixi) + qtflx_d_mxen(ki,ixi)) + cuorg*(qtflx_u_mxen(ki,ixf) + & + qtflx_d_mxen(ki,ixf) ) + enddo + + ! ------------------------ ! + ! 2. Layer-Mean Tendencies ! + ! ------------------------ ! + + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + kv = mkx + 1 - k + qvten_out(i,k) = ( 1._r8 - cuorg ) * qvten_mxen(k,ixi) + cuorg * qvten_mxen(k,ixf) + qlten_out(i,k) = ( 1._r8 - cuorg ) * qlten_mxen(k,ixi) + cuorg * qlten_mxen(k,ixf) + qiten_out(i,k) = ( 1._r8 - cuorg ) * qiten_mxen(k,ixi) + cuorg * qiten_mxen(k,ixf) + do mt = 1, ncnst + trten_out(i,k,mt) = ( 1._r8 - cuorg ) * trten_mxen(k,mt,ixi) + cuorg * trten_mxen(k,mt,ixf) + enddo + sten_out(i,k) = ( 1._r8 - cuorg ) * sten_mxen(k,ixi) + cuorg * sten_mxen(k,ixf) + uten_out(i,k) = ( 1._r8 - cuorg ) * uten_mxen(k,ixi) + cuorg * uten_mxen(k,ixf) + vten_out(i,k) = ( 1._r8 - cuorg ) * vten_mxen(k,ixi) + cuorg * vten_mxen(k,ixf) + qrten_out(i,k) = ( 1._r8 - cuorg ) * qrten_mxen(k,ixi) + cuorg * qrten_mxen(k,ixf) + qsten_out(i,k) = ( 1._r8 - cuorg ) * qsten_mxen(k,ixi) + cuorg * qsten_mxen(k,ixf) + enddo + + ! --------------------------------------------------------------------------------------------------- ! + ! SPECIAL : Compute Dissipation Heating - This must be done here to prevent energy conservation error ! + ! --------------------------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------- ! + ! Compute diabatic tendency associated with KE dissipative heating ! + ! In contrast to local symmetric turbulence scheme, KE dissipative heating by ! + ! nonlocal asymmetric turbulence (i.e., convection scheme) ! + ! can be either positive or negative. ! + ! In order to suppress energy conservation error, this should be done here at ! + ! the end after choosing 'NUM' or 'ANA'. ! + ! --------------------------------------------------------------------------- ! + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + uf(k) = u0(k) + uten_out(i,k) * dt + vf(k) = v0(k) + vten_out(i,k) * dt + enddo + ! ------------------------------------------------------------------------- ! + ! Reconstruct momemtum flux from the reconstructed uten_u(k) and uten_d(k) ! + ! and vten_u(k) and vten_d(k) associated with ipartition = 1. ! + ! Sep.12.2011. I should re-check whether below formula corretly incorporate ! + ! the 'ipartition = 1' effect. However, probably below is ! + ! correct since it seems that now I can trust myself with ! + ! reasonable amount of confidence. ! + ! ------------------------------------------------------------------------- ! + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + km = k - 1 + uflx(k) = uflx(km) - uten_out(i,k) * ( dp0(k) / g ) + vflx(k) = vflx(km) - vten_out(i,k) * ( dp0(k) / g ) + end do + ! ----------------------------------------------------- ! + ! Add dissipation heating to the final heating tendency ! + ! ----------------------------------------------------- ! + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + kp = k + 1 + km = k - 1 + if( k .eq. 1 ) then + sten_dis(k) = - g / 4._r8 * ( & + uflx(k) * ( uf(kp) - uf(k) + u0(kp) - u0(k) ) / dps0(k) + & + vflx(k) * ( vf(kp) - vf(k) + v0(kp) - v0(k) ) / dps0(k) ) + elseif( k .ge. 2 .and. k .le. max( ktop_mxen(ixi), ktop_mxen(ixf) ) - 1 ) then + sten_dis(k) = - g / 4._r8 * ( & + uflx(k) * ( uf(kp) - uf(k) + u0(kp) - u0(k) ) / dps0(k) + & + uflx(km) * ( uf(k) - uf(km) + u0(k) - u0(km) ) / dps0(km) + & + vflx(k) * ( vf(kp) - vf(k) + v0(kp) - v0(k) ) / dps0(k) + & + vflx(km) * ( vf(k) - vf(km) + v0(k) - v0(km) ) / dps0(km) ) + elseif( k .eq. max( ktop_mxen(ixi), ktop_mxen(ixf) ) ) then + sten_dis(k) = - g / 4._r8 * ( & + uflx(km) * ( uf(k) - uf(km) + u0(k) - u0(km) ) / dps0(km) + & + vflx(km) * ( vf(k) - vf(km) + v0(k) - v0(km) ) / dps0(km) ) + endif + slten_dis(k) = sten_dis(k) + qtten_dis(k) = 0._r8 + uten_dis(k) = 0._r8 + vten_dis(k) = 0._r8 + qvten_dis(k) = 0._r8 + qlten_dis(k) = 0._r8 + qiten_dis(k) = 0._r8 + do mt = 1, ncnst + trten_dis(k,mt) = 0._r8 + enddo + sten_out(i,k) = sten_out(i,k) + sten_dis(k) + enddo + + ! -------------------------- ! + ! 3. Other Layer-Mean Values ! + ! -------------------------- ! + + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + kv = mkx + 1 - k + ! ----------------------------------------------- ! + ! rqc_l, rqc_i, rqc are set to zero in the UNICON ! + ! ----------------------------------------------- ! + rqc_l_out(i,k) = ( 1._r8 - cuorg ) * rqc_l_mxen(k,ixi) + cuorg * rqc_l_mxen(k,ixf) + rqc_i_out(i,k) = ( 1._r8 - cuorg ) * rqc_i_mxen(k,ixi) + cuorg * rqc_i_mxen(k,ixf) + rqc_out(i,k) = ( 1._r8 - cuorg ) * rqc_mxen(k,ixi) + cuorg * rqc_mxen(k,ixf) + rnc_l_out(i,k) = ( 1._r8 - cuorg ) * rnc_l_mxen(k,ixi) + cuorg * rnc_l_mxen(k,ixf) + rnc_i_out(i,k) = ( 1._r8 - cuorg ) * rnc_i_mxen(k,ixi) + cuorg * rnc_i_mxen(k,ixf) + ! -------------------------------------------------------------------------------------------------------------- ! + ! Detrained mass flux and condensate: consistent between 'flux-convergence' and 'subsidence-detrainment' formula ! + ! -------------------------------------------------------------------------------------------------------------- ! + cmf_det_out(i,k) = ( 1._r8 - cuorg ) * cmf_det_mxen(k,ixi) + cuorg * cmf_det_mxen(k,ixf) + ql_det_out(i,k) = ( 1._r8 - cuorg ) * ql_det_mxen(k,ixi) + cuorg * ql_det_mxen(k,ixf) + qi_det_out(i,k) = ( 1._r8 - cuorg ) * qi_det_mxen(k,ixi) + cuorg * qi_det_mxen(k,ixf) + ! ----------------------------------------------------------------------- ! + ! evapc : Evaporation rate of convective precipitation within environment ! + ! ----------------------------------------------------------------------- ! + evapc_out(i,k) = ( 1._r8 - cuorg ) * evapc_mxen(k,ixi) + cuorg * evapc_mxen(k,ixf) + ! ------------------------------------------------------------------------ ! + ! am_u(d) : Updraft ( Downdraft ) fractional area at the layer mid-point. ! + ! qlm_u(d) : In-Updraft ( Downdraft ) LWC obtained by area weighting ! + ! ------------------------------------------------------------------------ ! + am_u_out(i,k) = ( 1._r8 - cuorg )* am_u_mxen(k,ixi) + cuorg* am_u_mxen(k,ixf) + qlm_u_out(i,k) = ( 1._r8 - cuorg )*qlm_u_mxen(k,ixi) * am_u_mxen(k,ixi) + cuorg*qlm_u_mxen(k,ixf) * am_u_mxen(k,ixf) + qim_u_out(i,k) = ( 1._r8 - cuorg )*qim_u_mxen(k,ixi) * am_u_mxen(k,ixi) + cuorg*qim_u_mxen(k,ixf) * am_u_mxen(k,ixf) + am_d_out(i,k) = ( 1._r8 - cuorg )* am_d_mxen(k,ixi) + cuorg* am_d_mxen(k,ixf) + qlm_d_out(i,k) = ( 1._r8 - cuorg )*qlm_d_mxen(k,ixi) * am_d_mxen(k,ixi) + cuorg*qlm_d_mxen(k,ixf) * am_d_mxen(k,ixf) + qim_d_out(i,k) = ( 1._r8 - cuorg )*qim_d_mxen(k,ixi) * am_d_mxen(k,ixi) + cuorg*qim_d_mxen(k,ixf) * am_d_mxen(k,ixf) + if( am_u_out(i,k) .gt. nonzero ) then + qlm_u_out(i,k) = qlm_u_out(i,k) / am_u_out(i,k) + qim_u_out(i,k) = qim_u_out(i,k) / am_u_out(i,k) + else + am_u_out(i,k) = 0._r8 + qlm_u_out(i,k) = 0._r8 + qim_u_out(i,k) = 0._r8 + endif + if( am_d_out(i,k) .gt. nonzero ) then + qlm_d_out(i,k) = qlm_d_out(i,k) / am_d_out(i,k) + qim_d_out(i,k) = qim_d_out(i,k) / am_d_out(i,k) + else + am_d_out(i,k) = 0._r8 + qlm_d_out(i,k) = 0._r8 + qim_d_out(i,k) = 0._r8 + endif + enddo + + ! ------------------------------- ! + ! 4. Single-Value for Each Column ! + ! ------------------------------- ! + + ! --------------------------------- ! + ! rliq is set to zero in the UNICON ! + ! --------------------------------- ! + rliq_out(i) = ( 1._r8 - cuorg ) * rliq_mxen(ixi) + cuorg * rliq_mxen(ixf) + precip_out(i) = ( 1._r8 - cuorg ) * precip_mxen(ixi) + cuorg * precip_mxen(ixf) + snow_out(i) = ( 1._r8 - cuorg ) * snow_mxen(ixi) + cuorg * snow_mxen(ixf) + ! --------------------------------------------------------------------------------------------- ! + ! cnt, cnb : Updraft 'top' and 'base' interface index. It is reasonable to take the maximum and ! + ! minimum respectively for final output instead of cuorg weighting average. ! + ! --------------------------------------------------------------------------------------------- ! + cnt_out(i) = max( cnt_mxen(ixi), cnt_mxen(ixf) ) + cnb_out(i) = min( cnb_mxen(ixi), cnb_mxen(ixf) ) + + ! --------------------------------------------------------------------- ! + ! ! + ! Print-Out Internal Output Variables ! + ! ! + ! Vertical index should be reversed for these internal output variables ! + ! ! + ! --------------------------------------------------------------------- ! + + ! ------------------------ ! + ! 1. Flux Interface Values ! + ! ------------------------ ! + + do ki = 0, max( ktop_mxen(ixi) - 1, ktop_mxen(ixf) - 1 ) + kvi = mkx - ki + cmf_out(i,kvi) = (1._r8 - cuorg)*( cmf_u_mxen(ki,ixi) - cmf_d_mxen(ki,ixi)) + cuorg*( cmf_u_mxen(ki,ixf) - & + cmf_d_mxen(ki,ixf) ) + uflx_out(i,kvi) = (1._r8 - cuorg)*( uflx_u_mxen(ki,ixi) + uflx_d_mxen(ki,ixi)) + cuorg*(uflx_u_mxen(ki,ixf) + & + uflx_d_mxen(ki,ixf) ) + vflx_out(i,kvi) = (1._r8 - cuorg)*( vflx_u_mxen(ki,ixi) + vflx_d_mxen(ki,ixi)) + cuorg*(vflx_u_mxen(ki,ixf) + & + vflx_d_mxen(ki,ixf) ) + slflx_u_out(i,kvi) = (1._r8 - cuorg)* slflx_u_mxen(ki,ixi) + cuorg * slflx_u_mxen(ki,ixf) + qtflx_u_out(i,kvi) = (1._r8 - cuorg)* qtflx_u_mxen(ki,ixi) + cuorg * qtflx_u_mxen(ki,ixf) + uflx_u_out(i,kvi) = (1._r8 - cuorg)* uflx_u_mxen(ki,ixi) + cuorg * uflx_u_mxen(ki,ixf) + vflx_u_out(i,kvi) = (1._r8 - cuorg)* vflx_u_mxen(ki,ixi) + cuorg * vflx_u_mxen(ki,ixf) + cmf_d_out(i,kvi) = (1._r8 - cuorg)* cmf_d_mxen(ki,ixi) + cuorg * cmf_d_mxen(ki,ixf) + slflx_d_out(i,kvi) = (1._r8 - cuorg)* slflx_d_mxen(ki,ixi) + cuorg * slflx_d_mxen(ki,ixf) + qtflx_d_out(i,kvi) = (1._r8 - cuorg)* qtflx_d_mxen(ki,ixi) + cuorg * qtflx_d_mxen(ki,ixf) + uflx_d_out(i,kvi) = (1._r8 - cuorg)* uflx_d_mxen(ki,ixi) + cuorg * uflx_d_mxen(ki,ixf) + vflx_d_out(i,kvi) = (1._r8 - cuorg)* vflx_d_mxen(ki,ixi) + cuorg * vflx_d_mxen(ki,ixf) + + flxrain_out(i,kvi) = ( 1._r8 - cuorg ) * flxrain_u_mxen(ki,ixi) + cuorg * flxrain_u_mxen(ki,ixf) + flxsnow_out(i,kvi) = ( 1._r8 - cuorg ) * flxsnow_u_mxen(ki,ixi) + cuorg * flxsnow_u_mxen(ki,ixf) + + enddo + + ! ----------------------------- ! + ! 2. Layer-Mean Tendency Values ! + ! ----------------------------- ! + + do k = 1, max( ktop_mxen(ixi), ktop_mxen(ixf) ) + kv = mkx + 1 - k + slten_u_out(i,kv) = ( 1._r8 - cuorg ) * slten_u_mxen(k,ixi) + cuorg * slten_u_mxen(k,ixf) + qtten_u_out(i,kv) = ( 1._r8 - cuorg ) * qtten_u_mxen(k,ixi) + cuorg * qtten_u_mxen(k,ixf) + uten_u_out(i,kv) = ( 1._r8 - cuorg ) * uten_u_mxen(k,ixi) + cuorg * uten_u_mxen(k,ixf) + vten_u_out(i,kv) = ( 1._r8 - cuorg ) * vten_u_mxen(k,ixi) + cuorg * vten_u_mxen(k,ixf) + sten_u_out(i,kv) = ( 1._r8 - cuorg ) * sten_u_mxen(k,ixi) + cuorg * sten_u_mxen(k,ixf) + qvten_u_out(i,kv) = ( 1._r8 - cuorg ) * qvten_u_mxen(k,ixi) + cuorg * qvten_u_mxen(k,ixf) + qlten_u_out(i,kv) = ( 1._r8 - cuorg ) * qlten_u_mxen(k,ixi) + cuorg * qlten_u_mxen(k,ixf) + qiten_u_out(i,kv) = ( 1._r8 - cuorg ) * qiten_u_mxen(k,ixi) + cuorg * qiten_u_mxen(k,ixf) + do mt = 1, ncnst + trten_u_out(i,kv,mt) = ( 1._r8 - cuorg ) * trten_u_mxen(k,mt,ixi) + cuorg * trten_u_mxen(k,mt,ixf) + enddo + slten_d_out(i,kv) = ( 1._r8 - cuorg ) * slten_d_mxen(k,ixi) + cuorg * slten_d_mxen(k,ixf) + qtten_d_out(i,kv) = ( 1._r8 - cuorg ) * qtten_d_mxen(k,ixi) + cuorg * qtten_d_mxen(k,ixf) + uten_d_out(i,kv) = ( 1._r8 - cuorg ) * uten_d_mxen(k,ixi) + cuorg * uten_d_mxen(k,ixf) + vten_d_out(i,kv) = ( 1._r8 - cuorg ) * vten_d_mxen(k,ixi) + cuorg * vten_d_mxen(k,ixf) + sten_d_out(i,kv) = ( 1._r8 - cuorg ) * sten_d_mxen(k,ixi) + cuorg * sten_d_mxen(k,ixf) + qvten_d_out(i,kv) = ( 1._r8 - cuorg ) * qvten_d_mxen(k,ixi) + cuorg * qvten_d_mxen(k,ixf) + qlten_d_out(i,kv) = ( 1._r8 - cuorg ) * qlten_d_mxen(k,ixi) + cuorg * qlten_d_mxen(k,ixf) + qiten_d_out(i,kv) = ( 1._r8 - cuorg ) * qiten_d_mxen(k,ixi) + cuorg * qiten_d_mxen(k,ixf) + do mt = 1, ncnst + trten_d_out(i,kv,mt) = ( 1._r8 - cuorg ) * trten_d_mxen(k,mt,ixi) + cuorg * trten_d_mxen(k,mt,ixf) + enddo + slten_evp_out(i,kv) = ( 1._r8 - cuorg ) * slten_evp_mxen(k,ixi) + cuorg * slten_evp_mxen(k,ixf) + qtten_evp_out(i,kv) = ( 1._r8 - cuorg ) * qtten_evp_mxen(k,ixi) + cuorg * qtten_evp_mxen(k,ixf) + uten_evp_out(i,kv) = ( 1._r8 - cuorg ) * uten_evp_mxen(k,ixi) + cuorg * uten_evp_mxen(k,ixf) + vten_evp_out(i,kv) = ( 1._r8 - cuorg ) * vten_evp_mxen(k,ixi) + cuorg * vten_evp_mxen(k,ixf) + sten_evp_out(i,kv) = ( 1._r8 - cuorg ) * sten_evp_mxen(k,ixi) + cuorg * sten_evp_mxen(k,ixf) + qvten_evp_out(i,kv) = ( 1._r8 - cuorg ) * qvten_evp_mxen(k,ixi) + cuorg * qvten_evp_mxen(k,ixf) + qlten_evp_out(i,kv) = ( 1._r8 - cuorg ) * qlten_evp_mxen(k,ixi) + cuorg * qlten_evp_mxen(k,ixf) + qiten_evp_out(i,kv) = ( 1._r8 - cuorg ) * qiten_evp_mxen(k,ixi) + cuorg * qiten_evp_mxen(k,ixf) + do mt = 1, ncnst + trten_evp_out(i,kv,mt) = ( 1._r8 - cuorg ) * trten_evp_mxen(k,mt,ixi) + cuorg * trten_evp_mxen(k,mt,ixf) + enddo + slten_dis_out(i,kv) = slten_dis(k) + qtten_dis_out(i,kv) = qtten_dis(k) + uten_dis_out(i,kv) = uten_dis(k) + vten_dis_out(i,kv) = vten_dis(k) + sten_dis_out(i,kv) = sten_dis(k) + qvten_dis_out(i,kv) = qvten_dis(k) + qlten_dis_out(i,kv) = qlten_dis(k) + qiten_dis_out(i,kv) = qiten_dis(k) + do mt = 1, ncnst + trten_dis_out(i,kv,mt) = trten_dis(k,mt) + enddo + qlten_sub_out(i,kv) = ( 1._r8 - cuorg ) * qlten_sub_mxen(k,ixi) + cuorg * qlten_sub_mxen(k,ixf) + qiten_sub_out(i,kv) = ( 1._r8 - cuorg ) * qiten_sub_mxen(k,ixi) + cuorg * qiten_sub_mxen(k,ixf) + qlten_det_out(i,kv) = ( 1._r8 - cuorg ) * qlten_det_mxen(k,ixi) + cuorg * qlten_det_mxen(k,ixf) + qiten_det_out(i,kv) = ( 1._r8 - cuorg ) * qiten_det_mxen(k,ixi) + cuorg * qiten_det_mxen(k,ixf) + + ! Diagnostic output for UNICON paper + am_evp_out(i,kv) = ( 1._r8 - cuorg ) * am_evp_mxen(k,ixi) + cuorg * am_evp_mxen(k,ixf) + am_pu_out(i,kv) = ( 1._r8 - cuorg ) * am_pu_mxen(k,ixi) + cuorg * am_pu_mxen(k,ixf) + x_um_out(i,kv) = ( 1._r8 - cuorg ) * x_um_mxen(k,ixi) + cuorg * x_um_mxen(k,ixf) + y_um_out(i,kv) = ( 1._r8 - cuorg ) * y_um_mxen(k,ixi) + cuorg * y_um_mxen(k,ixf) + ! Diagnostic output for UNICON paper + + enddo + + ! --------------------------------------------------------------- ! + ! 3. Convective Updraft and Downdraft Properties at Interfaces ! + ! Appropriate mass-flux, area, number weightings are required. ! + ! --------------------------------------------------------------- ! + + do ki = 0, max( ktop_mxen(ixi) - 1, ktop_mxen(ixf) - 1 ) + kvi = mkx - ki + ! ----------------------------- ! + ! Convective Updraft Properties ! + ! ----------------------------- ! + thl_u_out(i,kvi)= (1._r8 - cuorg)*thl_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg*thl_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + qt_u_out(i,kvi) = (1._r8 - cuorg)* qt_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* qt_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + u_u_out(i,kvi) = (1._r8 - cuorg)* u_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* u_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + v_u_out(i,kvi) = (1._r8 - cuorg)* v_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* v_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + w_u_out(i,kvi) = (1._r8 - cuorg)* w_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* w_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + ql_u_out(i,kvi) = (1._r8 - cuorg)* ql_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* ql_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + qi_u_out(i,kvi) = (1._r8 - cuorg)* qi_u_mxen(ki,ixi)*cmf_u_mxen(ki,ixi) + cuorg* qi_u_mxen(ki,ixf) * cmf_u_mxen(ki,ixf) + do mt = 1, ncnst + tr_u_out(i,kvi,mt) = (1._r8 - cuorg)*tr_u_mxen(ki,mt,ixi)*cmf_u_mxen(ki,ixi) + & + cuorg*tr_u_mxen(ki,mt,ixf)*cmf_u_mxen(ki,ixf) + enddo + ! ------------------------------------------------------------------------------------------------------- ! + ! Note that 'cmf_u_out(i,ki)' has already been computed above with OPPOSITE layer array index ki not kvi. ! + ! The way how 'rad_u_out' is computed is the same as the one in the main code with number weighting. ! + ! ------------------------------------------------------------------------------------------------------- ! + a_u_out(i,kvi) = (1._r8 - cuorg)* a_u_mxen(ki,ixi) + cuorg * a_u_mxen(ki,ixf) + num_u_out(i,kvi) = (1._r8 - cuorg)* num_u_mxen(ki,ixi) + cuorg * num_u_mxen(ki,ixf) + wa_u_out(i,kvi) = (1._r8 - cuorg)* wa_u_mxen(ki,ixi) * a_u_mxen(ki,ixi) + cuorg * wa_u_mxen(ki,ixf)*a_u_mxen(ki,ixf) + qla_u_out(i,kvi) = (1._r8 - cuorg)* qla_u_mxen(ki,ixi) * a_u_mxen(ki,ixi) + cuorg * qla_u_mxen(ki,ixf)*a_u_mxen(ki,ixf) + qia_u_out(i,kvi) = (1._r8 - cuorg)* qia_u_mxen(ki,ixi) * a_u_mxen(ki,ixi) + cuorg * qia_u_mxen(ki,ixf)*a_u_mxen(ki,ixf) + rad_u_out(i,kvi) = (1._r8 - cuorg)* rad_u_mxen(ki,ixi)**2._r8 * num_u_mxen(ki,ixi) + cuorg*rad_u_mxen(ki,ixf)**2._r8 * & + num_u_mxen(ki,ixf) + thva_u_out(i,kvi) = (1._r8 - cuorg)*thva_u_mxen(ki,ixi) * a_u_mxen(ki,ixi) + cuorg *thva_u_mxen(ki,ixf)*a_u_mxen(ki,ixf) + + ! Diagnostic output for UNICON paper + a_p_out(i,kvi) = ( 1._r8 - cuorg ) * a_p_mxen(ki,ixi) + cuorg * a_p_mxen(ki,ixf) + x_p_out(i,kvi) = ( 1._r8 - cuorg ) * x_p_mxen(ki,ixi) + cuorg * x_p_mxen(ki,ixf) + y_p_out(i,kvi) = ( 1._r8 - cuorg ) * y_p_mxen(ki,ixi) + cuorg * y_p_mxen(ki,ixf) + ! Diagnostic output for UNICON paper + + ! ------------------------------------------------------------------------------- ! + ! Final normalization and averaging ! + ! Be careful of the different index ki ( not kvi ) only in the mass flux. ! + ! Note also that nonzero net mass flux, area, number concentration are guaranteed ! + ! at all the interfaces we are considering in this do block. ! + ! However, if cuorg = 0 or 1, ero value may come out due to cuorg weighting. ! + ! Thus, we should carefully treat below using if block. ! + ! For full consistency, I use all the mass-flux, area, and number concentration ! + ! consistencies at the same time. ! + ! ------------------------------------------------------------------------------- ! + if( cmf_u_out(i,ki) .gt. nonzero .and. a_u_out(i,kvi) .gt. nonzero .and. num_u_out(i,kvi) .gt. nonzero ) then + thl_u_out(i,kvi) = thl_u_out(i,kvi) / cmf_u_out(i,ki) + qt_u_out(i,kvi) = qt_u_out(i,kvi) / cmf_u_out(i,ki) + u_u_out(i,kvi) = u_u_out(i,kvi) / cmf_u_out(i,ki) + v_u_out(i,kvi) = v_u_out(i,kvi) / cmf_u_out(i,ki) + w_u_out(i,kvi) = w_u_out(i,kvi) / cmf_u_out(i,ki) + ql_u_out(i,kvi) = ql_u_out(i,kvi) / cmf_u_out(i,ki) + qi_u_out(i,kvi) = qi_u_out(i,kvi) / cmf_u_out(i,ki) + do mt = 1, ncnst + tr_u_out(i,kvi,mt) = tr_u_out(i,kvi,mt) / cmf_u_out(i,ki) + enddo + wa_u_out(i,kvi) = wa_u_out(i,kvi) / a_u_out(i,kvi) + qla_u_out(i,kvi) = qla_u_out(i,kvi) / a_u_out(i,kvi) + qia_u_out(i,kvi) = qia_u_out(i,kvi) / a_u_out(i,kvi) + rad_u_out(i,kvi) = sqrt( rad_u_out(i,kvi) / num_u_out(i,kvi) ) + thva_u_out(i,kvi) = thva_u_out(i,kvi) / a_u_out(i,kvi) + else + cmf_u_out(i,ki) = 0._r8 + a_u_out(i,kvi) = 0._r8 + num_u_out(i,kvi) = 0._r8 + thl_u_out(i,kvi) = 0._r8 + qt_u_out(i,kvi) = 0._r8 + u_u_out(i,kvi) = 0._r8 + v_u_out(i,kvi) = 0._r8 + w_u_out(i,kvi) = 0._r8 + ql_u_out(i,kvi) = 0._r8 + qi_u_out(i,kvi) = 0._r8 + do mt = 1, ncnst + tr_u_out(i,kvi,mt) = 0._r8 + enddo + wa_u_out(i,kvi) = 0._r8 + qla_u_out(i,kvi) = 0._r8 + qia_u_out(i,kvi) = 0._r8 + rad_u_out(i,kvi) = 0._r8 + thva_u_out(i,kvi) = 0._r8 + endif + gamw_u_out(i,kvi) = w_u_out(i,kvi) / max( wa_u_out(i,kvi), nonzero ) + ! ------------------------------- ! + ! Convective Downdraft Properties ! + ! ------------------------------- ! + thl_d_out(i,kvi) = (1._r8 - cuorg)*thl_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg*thl_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + qt_d_out(i,kvi) = (1._r8 - cuorg)* qt_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* qt_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + u_d_out(i,kvi) = (1._r8 - cuorg)* u_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* u_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + v_d_out(i,kvi) = (1._r8 - cuorg)* v_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* v_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + w_d_out(i,kvi) = (1._r8 - cuorg)* w_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* w_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + ql_d_out(i,kvi) = (1._r8 - cuorg)* ql_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* ql_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + qi_d_out(i,kvi) = (1._r8 - cuorg)* qi_d_mxen(ki,ixi)*cmf_d_mxen(ki,ixi) + cuorg* qi_d_mxen(ki,ixf)*cmf_d_mxen(ki,ixf) + do mt = 1, ncnst + tr_d_out(i,kvi,mt) = (1._r8 - cuorg)*tr_d_mxen(ki,mt,ixi)*cmf_d_mxen(ki,ixi) + & + cuorg*tr_d_mxen(ki,mt,ixf)*cmf_d_mxen(ki,ixf) + enddo + ! ------------------------------------------------------------------------------------------------- ! + ! Note that 'cmf_d_out(i,kvi)' has already been computed above with the SAME layer array index kvi, ! + ! in contrast to 'cmf_u_out(i,ki)' ! + ! ------------------------------------------------------------------------------------------------- ! + a_d_out(i,kvi) = (1._r8 - cuorg)* a_d_mxen(ki,ixi) + cuorg* a_d_mxen(ki,ixf) + wa_d_out(i,kvi) = (1._r8 - cuorg)* wa_d_mxen(ki,ixi)*a_d_mxen(ki,ixi) + cuorg* wa_d_mxen(ki,ixf)*a_d_mxen(ki,ixf) + qla_d_out(i,kvi) = (1._r8 - cuorg)*qla_d_mxen(ki,ixi)*a_d_mxen(ki,ixi) + cuorg*qla_d_mxen(ki,ixf)*a_d_mxen(ki,ixf) + qia_d_out(i,kvi) = (1._r8 - cuorg)*qia_d_mxen(ki,ixi)*a_d_mxen(ki,ixi) + cuorg*qia_d_mxen(ki,ixf)*a_d_mxen(ki,ixf) + ! ------------------------------------------------------------------------------- ! + ! Final normalization and averaging ! + ! Be careful of the same index ki ( not kvi ) for the mass flux too in contrast ! + ! to convective updraft. ! + ! ------------------------------------------------------------------------------- ! + if( cmf_d_out(i,kvi) .gt. nonzero .and. a_d_out(i,kvi) .gt. nonzero ) then + thl_d_out(i,kvi) = thl_d_out(i,kvi) / cmf_d_out(i,kvi) + qt_d_out(i,kvi) = qt_d_out(i,kvi) / cmf_d_out(i,kvi) + u_d_out(i,kvi) = u_d_out(i,kvi) / cmf_d_out(i,kvi) + v_d_out(i,kvi) = v_d_out(i,kvi) / cmf_d_out(i,kvi) + w_d_out(i,kvi) = w_d_out(i,kvi) / cmf_d_out(i,kvi) + ql_d_out(i,kvi) = ql_d_out(i,kvi) / cmf_d_out(i,kvi) + qi_d_out(i,kvi) = qi_d_out(i,kvi) / cmf_d_out(i,kvi) + do mt = 1, ncnst + tr_d_out(i,kvi,mt) = tr_d_out(i,kvi,mt) / cmf_d_out(i,kvi) + enddo + wa_d_out(i,kvi) = wa_d_out(i,kvi) / a_d_out(i,kvi) + qla_d_out(i,kvi) = qla_d_out(i,kvi) / a_d_out(i,kvi) + qia_d_out(i,kvi) = qia_d_out(i,kvi) / a_d_out(i,kvi) + else + cmf_d_out(i,kvi) = 0._r8 + a_d_out(i,kvi) = 0._r8 + thl_d_out(i,kvi) = 0._r8 + qt_d_out(i,kvi) = 0._r8 + u_d_out(i,kvi) = 0._r8 + v_d_out(i,kvi) = 0._r8 + w_d_out(i,kvi) = 0._r8 + ql_d_out(i,kvi) = 0._r8 + qi_d_out(i,kvi) = 0._r8 + do mt = 1, ncnst + tr_d_out(i,kvi,mt) = 0._r8 + enddo + wa_d_out(i,kvi) = 0._r8 + qla_d_out(i,kvi) = 0._r8 + qia_d_out(i,kvi) = 0._r8 + endif + enddo + + ! ---------------------------------------------------------------------------------- ! + ! 4. Individual Segment Properties of Convective Updraft and Downdraft at Interfaces ! + ! In this case, instead of doing 'cuorg' average, just print out individual ! + ! mixing air properties. ! + ! ---------------------------------------------------------------------------------- ! + + do iter = 1, niter + do msfc = 1, nseg + do ki = 0, max( ktop_mxen(ixi) - 1, ktop_mxen(ixf) - 1 ) + + kvi = mkx - ki + thl_u_msfc_out(i,kvi,msfc,iter) = thl_u_msfc_mxen(ki,msfc,iter) + qt_u_msfc_out(i,kvi,msfc,iter) = qt_u_msfc_mxen(ki,msfc,iter) + u_u_msfc_out(i,kvi,msfc,iter) = u_u_msfc_mxen(ki,msfc,iter) + v_u_msfc_out(i,kvi,msfc,iter) = v_u_msfc_mxen(ki,msfc,iter) + w_u_msfc_out(i,kvi,msfc,iter) = w_u_msfc_mxen(ki,msfc,iter) + ql_u_msfc_out(i,kvi,msfc,iter) = ql_u_msfc_mxen(ki,msfc,iter) + qi_u_msfc_out(i,kvi,msfc,iter) = qi_u_msfc_mxen(ki,msfc,iter) + do mt = 1, ncnst + tr_u_msfc_out(i,kvi,msfc,mt,iter) = tr_u_msfc_mxen(ki,msfc,mt,iter) + enddo + cmf_u_msfc_out(i,kvi,msfc,iter) = cmf_u_msfc_mxen(ki,msfc,iter) + a_u_msfc_out(i,kvi,msfc,iter) = a_u_msfc_mxen(ki,msfc,iter) + num_u_msfc_out(i,kvi,msfc,iter) = num_u_msfc_mxen(ki,msfc,iter) + rad_u_msfc_out(i,kvi,msfc,iter) = rad_u_msfc_mxen(ki,msfc,iter) + + eps0_u_msfc_out(i,kvi,msfc,iter) = eps0_u_msfc_mxen(ki,msfc,iter) + eps_u_msfc_out(i,kvi,msfc,iter) = eps_u_msfc_mxen(ki,msfc,iter) + del_u_msfc_out(i,kvi,msfc,iter) = del_u_msfc_mxen(ki,msfc,iter) + eeps_u_msfc_out(i,kvi,msfc,iter) = eeps_u_msfc_mxen(ki,msfc,iter) + ddel_u_msfc_out(i,kvi,msfc,iter) = ddel_u_msfc_mxen(ki,msfc,iter) + xc_u_msfc_out(i,kvi,msfc,iter) = xc_u_msfc_mxen(ki,msfc,iter) + xs_u_msfc_out(i,kvi,msfc,iter) = xs_u_msfc_mxen(ki,msfc,iter) + xemin_u_msfc_out(i,kvi,msfc,iter) = xemin_u_msfc_mxen(ki,msfc,iter) + xemax_u_msfc_out(i,kvi,msfc,iter) = xemax_u_msfc_mxen(ki,msfc,iter) + cridis_u_msfc_out(i,kvi,msfc,iter) = cridis_u_msfc_mxen(ki,msfc,iter) + thvcuenv_u_msfc_out(i,kvi,msfc,iter) = thvcuenv_u_msfc_mxen(ki,msfc,iter) + thvegenv_u_msfc_out(i,kvi,msfc,iter) = thvegenv_u_msfc_mxen(ki,msfc,iter) + thvxsenv_u_msfc_out(i,kvi,msfc,iter) = thvxsenv_u_msfc_mxen(ki,msfc,iter) + fmix_u_msfc_out(i,kvi,msfc,iter) = fmix_u_msfc_mxen(ki,msfc,iter) + cmfumix_u_msfc_out(i,kvi,msfc,iter) = cmfumix_u_msfc_mxen(ki,msfc,iter) + + thl_d_msfc_out(i,kvi,msfc,iter) = thl_d_msfc_mxen(ki,msfc,iter) + qt_d_msfc_out(i,kvi,msfc,iter) = qt_d_msfc_mxen(ki,msfc,iter) + u_d_msfc_out(i,kvi,msfc,iter) = u_d_msfc_mxen(ki,msfc,iter) + v_d_msfc_out(i,kvi,msfc,iter) = v_d_msfc_mxen(ki,msfc,iter) + w_d_msfc_out(i,kvi,msfc,iter) = w_d_msfc_mxen(ki,msfc,iter) + ql_d_msfc_out(i,kvi,msfc,iter) = ql_d_msfc_mxen(ki,msfc,iter) + qi_d_msfc_out(i,kvi,msfc,iter) = qi_d_msfc_mxen(ki,msfc,iter) + do mt = 1, ncnst + tr_d_msfc_out(i,kvi,msfc,mt,iter) = tr_d_msfc_mxen(ki,msfc,mt,iter) + enddo + cmf_d_msfc_out(i,kvi,msfc,iter) = cmf_d_msfc_mxen(ki,msfc,iter) + a_d_msfc_out(i,kvi,msfc,iter) = a_d_msfc_mxen(ki,msfc,iter) + wa_d_msfc_out(i,kvi,msfc,iter) = wa_d_msfc_mxen(ki,msfc,iter) + qla_d_msfc_out(i,kvi,msfc,iter) = qla_d_msfc_mxen(ki,msfc,iter) + qia_d_msfc_out(i,kvi,msfc,iter) = qia_d_msfc_mxen(ki,msfc,iter) + + enddo + + ptop_msfc_out(i,msfc,iter) = ptop_msfc_mxen(msfc,iter) + ztop_msfc_out(i,msfc,iter) = ztop_msfc_mxen(msfc,iter) + + enddo + enddo + + ! ------------------------------------------------------------- ! + ! ! + ! Save the 'inout' variables related to convective organization ! + ! ! + ! ------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------------------------ ! + ! 1. Top height and average height of convective updraft at the single previous time step. ! + ! Similar to previous treatment, take the maximum value for 'cush' while perform ! + ! surface mass-flux weighted average for cush_avg. Note that both mxen = 1 and 2 have ! + ! identical surface mass flux. ! + ! Thus, it is more reasonable to use cushavg instead of cush for computation of ! + ! critical distance ( rlc ) for convective updraft mixing as is done in the current code. ! + ! ------------------------------------------------------------------------------------------ ! + + cush_inout(i) = max( cush_mxen(ixi), cush_mxen(ixf) ) + cushavg_inout(i) = ( 1._r8 - cuorg ) * cushavg_mxen(ixi) + cuorg * cushavg_mxen(ixf) + + ! TEST. Apr.15.2014. + ! if( get_nstep() .eq. 786 .or. get_nstep() .eq. 787 ) then + ! write(iulog,*) + ! write(iulog,*) 'SPARKCONV: cushavg, nstep = ', get_nstep() + ! write(iulog,*) 'Updated cushavg_inout, pblh, pblhz, pblhp =', cushavg_inout(i), pblh, pblhz, pblhp + ! write(iulog,*) 'kpblh, kpblhm, kpblh_in(i) = ', kpblh, kpblhm, kpblh_in(i) + ! write(iulog,*) 'zs0_in(i,0), zs0_in(i,1) = ', zs0_in(i,0), zs0_in(i,1) + ! write(iulog,*) 'zs0_in(i,kpblhm-1), zs0_in(i,kpblhm), zs0_in(i,kpblh) = ', zs0_in(i,kpblhm-1), zs0_in(i,kpblhm), zs0_in(i,kpblh) + ! write(iulog,*) 'ps0_in(i,0), ps0_in(i,kpblhm) = ', ps0_in(i,0), ps0_in(i,kpblhm) + ! write(iulog,*) 'eps_u_msfc_out(i,19,1,1), eps_u_msfc_out(i,20,1,1) = ', & + ! eps_u_msfc_out(i,19,1,1), eps_u_msfc_out(i,20,1,1) + ! write(iulog,*) 'ktop_mxen(ixi), ktop_mxen(ixf) = ', ktop_mxen(ixi), ktop_mxen(ixf) + ! write(iulog,*) 'zs0_in(i,ktop_mxen-1), zs0_in(i,ktop_mxen), zs0_in(i,ktop_mxen+1) = ', & + ! zs0_in(i,ktop_mxen-1), zs0_in(i,ktop_mxen), zs0_in(i,ktop_mxen+1) + ! write(iulog,*) + ! endif + ! TEST. Apr.15.2014. + + ! --------------------------------------------------------------------------------------------- ! + ! 4. The mass and scalar properties of detrained airs into each layer from ! + ! individual convective updraft and downdraft at the previous time step. ! + ! Due to the tracer array, I cannot save multi-time step informations. ! + ! Aug.01.2011. Brian Juwon Park's 9th Birthday. I modified below part to correctly compute ! + ! mass-flux weighted average for mixing with multiple mixing environmental air. ! + ! Below bloak is a new code on this day. ! + ! Note that for this 'inout' variables, we must use 'do k = 1, mkx' not ! + ! 'k = 1, max( ktop_mxen(1), ktop_mxen(2) )' to correctly put zero values in the ! + ! layers above 'max( ktop_mxen(1), ktop_mxen(2) )'. ! + ! --------------------------------------------------------------------------------------------- ! + + do k = 1, mkx + cu_cmfum_out(i,k) = ( 1._r8 - cuorg ) * cu_cmfum_mxen(k,ixi) + cuorg * cu_cmfum_mxen(k,ixf) + ! ---------------------------- ! + ! Total average detrained airs ! + ! ---------------------------- ! ------------------------------------------------------------------------------------------------- ! + ! Aug.12.2011. For more geographically organized mixing, it might be better to include only ! + ! cu_thlr_mxen(k,2). But may not. ! + ! Sep.15.2011. In order to reduce the numerical sensitivity due to on-and-off behavior of convection, define below 'cu_thlr_inout' ! + ! variables as the average of previous two time steps, not just at the previous time step. ! + ! In defining individual cu_thlr_mxen, I used 'am_u' instead of 'cu_cmfr_mxen' for nonzero constraint above. ! + ! However, below block indicates that the use of 'cu_cmfr_mxen' instead of 'am_u' is much more easy to use. ! + ! Thus, I modified previous computation using the 'cu_cmfr_mxen'. Since 'cu_thlr_inout' is anomaly values, ! + ! this use of 'cu_cmfr_mxen' seems to perfectly OK even though 'cu_thlr_mxen' were defined using 'am_u'. ! + ! In fact, exact two time step average is impossible unless we save multi-time step fields, which is very hard due to ! + ! large number of tracers. Thus, I simply do mass weighting average by using the newly generated 'cu_thlr' at ! + ! the current time step and the passed 'cu_thlr' from previous time steps. This seems to be most reasonable. ! + ! However, due to the uncertainty on how the treat the amount of mass itself ( clearly, we cannot add them all !!! ), ! + ! we cannot easily apply this method. Thus, I am leaving as a future work. ! + ! However, current one-time step saving seems to be perfectly OK, which is actually very well mimicking what is ! + ! happening in real nature. ! + ! also, when consideing cumulus updraft trailing previous cumulus updraft, current one time step methods seems to be ! + ! most perfectly conceptually reasonable. So, let's keep the current one-time-step method which is perfect. ! + ! -------------------------------------------------------------------------------------------------------------------------------- ! + cu_cmfr_inout(i,k) =(1._r8 - cuorg)*cu_cmfr_mxen(k,ixi) + cuorg* cu_cmfr_mxen(k,ixf) + cu_thlr_inout(i,k) =(1._r8 - cuorg)*cu_thlr_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg*cu_thlr_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + cu_qtr_inout(i,k) =(1._r8 - cuorg)* cu_qtr_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg* cu_qtr_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + cu_ur_inout(i,k) =(1._r8 - cuorg)* cu_ur_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg* cu_ur_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + cu_vr_inout(i,k) =(1._r8 - cuorg)* cu_vr_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg* cu_vr_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + cu_qlr_inout(i,k) =(1._r8 - cuorg)* cu_qlr_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg* cu_qlr_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + cu_qir_inout(i,k) =(1._r8 - cuorg)* cu_qir_mxen(k,ixi)*cu_cmfr_mxen(k,ixi) + cuorg* cu_qir_mxen(k,ixf)*cu_cmfr_mxen(k,ixf) + do mt = 1, ncnst + cu_trr_inout(i,k,mt) = (1._r8 - cuorg)*cu_trr_mxen(k,mt,ixi)*cu_cmfr_mxen(k,ixi) + & + cuorg*cu_trr_mxen(k,mt,ixf)*cu_cmfr_mxen(k,ixf) + enddo + if( cu_cmfr_inout(i,k) .gt. nonzero ) then + cu_thlr_inout(i,k) = cu_thlr_inout(i,k) / cu_cmfr_inout(i,k) + cu_qtr_inout(i,k) = cu_qtr_inout(i,k) / cu_cmfr_inout(i,k) + cu_ur_inout(i,k) = cu_ur_inout(i,k) / cu_cmfr_inout(i,k) + cu_vr_inout(i,k) = cu_vr_inout(i,k) / cu_cmfr_inout(i,k) + cu_qlr_inout(i,k) = cu_qlr_inout(i,k) / cu_cmfr_inout(i,k) + cu_qir_inout(i,k) = cu_qir_inout(i,k) / cu_cmfr_inout(i,k) + do mt = 1, ncnst + cu_trr_inout(i,k,mt) = cu_trr_inout(i,k,mt) / cu_cmfr_inout(i,k) + enddo + else + cu_cmfr_inout(i,k) = 0._r8 + cu_thlr_inout(i,k) = 0._r8 + cu_qtr_inout(i,k) = 0._r8 + cu_ur_inout(i,k) = 0._r8 + cu_vr_inout(i,k) = 0._r8 + cu_qlr_inout(i,k) = 0._r8 + cu_qir_inout(i,k) = 0._r8 + do mt = 1, ncnst + cu_trr_inout(i,k,mt) = 0._r8 + enddo + endif + ! ------------------------------------------------------------------------------------------------------------------ ! + ! Aug.2.2011. For diagnostic purpose, print-out 'cu_thvr_inout' and 'cu_rhr_inout'. Note that condensate is computed ! + ! from 'thlr' and 'qtr' by direct variable conversion. ! + ! ------------------------------------------------------------------------------------------------------------------ ! + call conden( p0(k), cu_thlr_inout(i,k) + thl0(k), cu_qtr_inout(i,k) + qt0(k), th, qv, ql, qi, qse, id_check ) + cu_thvr_inout(i,k) = th * ( 1._r8 + zvir * qv - ql - qi ) - thv0(k) + cu_rhr_inout(i,k) = max( 0._r8, min( 1._r8, qv / max( nonzero, qse ) ) ) - rh0(k) + ! --------------------------------------------- ! + ! Detrained airs only from convective downdraft ! + ! --------------------------------------------- ! + cu_cmfrd_out(i,k) = (1._r8 - cuorg)*cu_cmfrd_mxen(k,ixi) + & + cuorg*cu_cmfrd_mxen(k,ixf) + cu_thlrd_out(i,k) = (1._r8 - cuorg)*cu_thlrd_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg*cu_thlrd_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + cu_qtrd_out(i,k) = (1._r8 - cuorg)* cu_qtrd_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg* cu_qtrd_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + cu_urd_out(i,k) = (1._r8 - cuorg)* cu_urd_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg* cu_urd_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + cu_vrd_out(i,k) = (1._r8 - cuorg)* cu_vrd_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg* cu_vrd_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + cu_qlrd_out(i,k) = (1._r8 - cuorg)* cu_qlrd_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg* cu_qlrd_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + cu_qird_out(i,k) = (1._r8 - cuorg)* cu_qird_mxen(k,ixi)*cu_cmfrd_mxen(k,ixi) + & + cuorg* cu_qird_mxen(k,ixf)*cu_cmfrd_mxen(k,ixf) + do mt = 1, ncnst + cu_trrd_out(i,k,mt) = ( 1._r8 - cuorg ) * cu_trrd_mxen(k,mt,ixi) * cu_cmfrd_mxen(k,ixi) + & + cuorg * cu_trrd_mxen(k,mt,ixf) * cu_cmfrd_mxen(k,ixf) + enddo + if( cu_cmfrd_out(i,k) .gt. nonzero ) then + cu_thlrd_out(i,k) = cu_thlrd_out(i,k) / cu_cmfrd_out(i,k) + cu_qtrd_out(i,k) = cu_qtrd_out(i,k) / cu_cmfrd_out(i,k) + cu_urd_out(i,k) = cu_urd_out(i,k) / cu_cmfrd_out(i,k) + cu_vrd_out(i,k) = cu_vrd_out(i,k) / cu_cmfrd_out(i,k) + cu_qlrd_out(i,k) = cu_qlrd_out(i,k) / cu_cmfrd_out(i,k) + cu_qird_out(i,k) = cu_qird_out(i,k) / cu_cmfrd_out(i,k) + do mt = 1, ncnst + cu_trrd_out(i,k,mt) = cu_trrd_out(i,k,mt) / cu_cmfrd_out(i,k) + enddo + else + cu_cmfrd_out(i,k) = 0._r8 + cu_thlrd_out(i,k) = 0._r8 + cu_qtrd_out(i,k) = 0._r8 + cu_urd_out(i,k) = 0._r8 + cu_vrd_out(i,k) = 0._r8 + cu_qlrd_out(i,k) = 0._r8 + cu_qird_out(i,k) = 0._r8 + do mt = 1, ncnst + cu_trrd_out(i,k,mt) = 0._r8 + enddo + endif + enddo + + ! -------------------------------------------------------------------------------------------------------- ! + ! 5. Convective Organization Parameter ! + ! Compute updated convective organization for use at the next time step's ( t + dt ) convection scheme. ! + ! Impose lower and upper limits of [ 0, 1 ]. ! + ! Note that cuorg at the next time step ( cuorg_out ) is updated using grid-mean organization forcing. ! + ! Since 'tau_org' is and should be defined over the grid-mean, it is not a 'mxen-arrayed' variable but ! + ! a single value for the entire column. ! + ! -------------------------------------------------------------------------------------------------------- ! + + cuorg_inout(i) = cuorg + + ! -------------------------------------------------------------------------------------------------------- ! + ! 6. Convective Organization Parameter - Time evolution of the difference of PBL-mean conservative scalars ! + ! between off-wake region and grid-mean. At the beginning of next time time, convective organization ! + ! parameter ( cuorg ) will be diagnostically computed using the PBL-mean vertial potential difference ! + ! between the off-wake area and the grid-mean. ! + ! The reason to compute cuorg at the next time step diagnostically is to impose consistency in the ! + ! computed cuorg at the right time step for correct diagnostic output. ! + ! The lower and upper limits of [ 0, 1 ] on the cuorg is also imposed. ! + ! Note that cuorg at the next time step ( cuorg_out ) is updated using grid-mean organization forcing. ! + ! Since 'tau_org' is and should be defined over the grid-mean, it is not a 'mxen-arrayed' variable but ! + ! a single value for the entire column. ! + ! Note also that we are using the same damping time scale for all scalars since physically, damping of ! + ! the difference between off-wake and grid-mean value occurs due to lateral mixing along the wall of ! + ! of the wake from surface to the PBL top interface. ! + ! CAUTION : We may want to impose a certain on the prognosed 'delta_' variables in order to prevent ! + ! the disruption by unreasonable values. ! + ! ! + ! Sep.03.2011. As a forcing of 'delta_thl_PBL' variables in the below, I should also include diabatic ! + ! forcing within wake area ( aw * Qw ) as well as adiabatic flux at the PBL top interface ! + ! from the several selected downdraft components. Since diabatic forcing ( evaporation of ! + ! convective precipitation ) is larger over the land than over the ocean, this will ! + ! help to increase convective organization over the land, if I define 'cuorg' as the ! + ! normalized 'delta_thv_PBL' as in the current code. ! + ! Sep.07.2011. Redefine total forcings including both adiabatic forcing and two diabatic forcings both ! + ! within convective downdraft and environment. ! + ! Also rename the variables. ! + ! Sep.07.2011. Also includes prognostic equation for the wake area. ! + ! I should be very careful when I define 'tau' for 'niter' ensemble. ! + ! In addition, I should define 'tau' differently for individual conservative scalars and ! + ! wake area. This is because adjustment of wake by surface flux can generate diffferent ! + ! relaxation time scale for each conservative scalar. ! + ! Note that 'tau' for conservative scalar for iter = 1 is the same as the value for ! + ! iter = 2 even though we include surface flux adjustment. However, 'tau' for wake area ! + ! are different for iter = 1 and iter = 2. Regardless of whether it is conservative scalar ! + ! of wak area, we should perform 'cuorg' weighted average using '1/tau(iter)' and then ! + ! the resulting '1/tau(avg)' should be inversed to obtain the final 'tau(avg)'. This is ! + ! because the prognostic organization equations below are 1st order LINEAR equation. ! + ! By doing this, we can compuetely remove the ambiguity on the treatment of 'tau' in the ! + ! ensemble mean both for conservative scalar and wake area. ! + ! In the below block, 'taui' denotes '1/tau', i.e., inverse tau. ! + ! Note that 'tau' for 'awk' can be negative, which is completely OK. ! + ! Sep.09.2011. I don't prognose 'thv' any more - it will be computed diagnostically at the beginning of ! + ! the next time step for full model consistency. ! + ! -------------------------------------------------------------------------------------------------------- ! + + ! -------------------------------- ! + ! Inverse of Adjustment Time Scale ! + ! -------------------------------- ! + + taui_thl_out(i) = ( 1._r8 - cuorg ) * taui_thl_mxen(ixi) + cuorg * taui_thl_mxen(ixf) + taui_qt_out(i) = ( 1._r8 - cuorg ) * taui_qt_mxen(ixi) + cuorg * taui_qt_mxen(ixf) + taui_u_out(i) = ( 1._r8 - cuorg ) * taui_u_mxen(ixi) + cuorg * taui_u_mxen(ixf) + taui_v_out(i) = ( 1._r8 - cuorg ) * taui_v_mxen(ixi) + cuorg * taui_v_mxen(ixf) + do mt = 1, ncnst + taui_tr_out(i,mt) = ( 1._r8 - cuorg ) * taui_tr_mxen(mt,ixi) + cuorg * taui_tr_mxen(mt,ixf) + enddo + taui_awk_out(i) = ( 1._r8 - cuorg ) * taui_awk_mxen(ixi) + cuorg * taui_awk_mxen(ixf) + + del_org_out(i) = ( 1._r8 - cuorg ) * del_org_mxen(ixi) + cuorg * del_org_mxen(ixf) + del0_org_out(i) = ( 1._r8 - cuorg ) * del0_org_mxen(ixi) + cuorg * del0_org_mxen(ixf) + + ! -------------------------- ! + ! Total Organization Forcing ! + ! -------------------------- ! + + thl_orgforce_out(i) = ( 1._r8 - cuorg ) * thl_orgforce_mxen(ixi) + cuorg * thl_orgforce_mxen(ixf) + qt_orgforce_out(i) = ( 1._r8 - cuorg ) * qt_orgforce_mxen(ixi) + cuorg * qt_orgforce_mxen(ixf) + u_orgforce_out(i) = ( 1._r8 - cuorg ) * u_orgforce_mxen(ixi) + cuorg * u_orgforce_mxen(ixf) + v_orgforce_out(i) = ( 1._r8 - cuorg ) * v_orgforce_mxen(ixi) + cuorg * v_orgforce_mxen(ixf) + do mt = 1, ncnst + tr_orgforce_out(i,mt) = ( 1._r8 - cuorg ) * tr_orgforce_mxen(mt,ixi) + cuorg * tr_orgforce_mxen(mt,ixf) + enddo + awk_orgforce_out(i) = ( 1._r8 - cuorg ) * awk_orgforce_mxen(ixi) + cuorg * awk_orgforce_mxen(ixf) + + ! ----------------------------------------------------- ! + ! Individual Organization Forcing for Diagnostic Output ! + ! ----------------------------------------------------- ! + + thl_orgforce_flx_out(i) = ( 1._r8 - cuorg ) * thl_orgforce_flx_mxen(ixi) + cuorg * thl_orgforce_flx_mxen(ixf) + thl_orgforce_und_out(i) = ( 1._r8 - cuorg ) * thl_orgforce_und_mxen(ixi) + cuorg * thl_orgforce_und_mxen(ixf) + thl_orgforce_env_out(i) = ( 1._r8 - cuorg ) * thl_orgforce_env_mxen(ixi) + cuorg * thl_orgforce_env_mxen(ixf) + + qt_orgforce_flx_out(i) = ( 1._r8 - cuorg ) * qt_orgforce_flx_mxen(ixi) + cuorg * qt_orgforce_flx_mxen(ixf) + qt_orgforce_und_out(i) = ( 1._r8 - cuorg ) * qt_orgforce_und_mxen(ixi) + cuorg * qt_orgforce_und_mxen(ixf) + qt_orgforce_env_out(i) = ( 1._r8 - cuorg ) * qt_orgforce_env_mxen(ixi) + cuorg * qt_orgforce_env_mxen(ixf) + + u_orgforce_flx_out(i) = ( 1._r8 - cuorg ) * u_orgforce_flx_mxen(ixi) + cuorg * u_orgforce_flx_mxen(ixf) + u_orgforce_und_out(i) = ( 1._r8 - cuorg ) * u_orgforce_und_mxen(ixi) + cuorg * u_orgforce_und_mxen(ixf) + u_orgforce_env_out(i) = ( 1._r8 - cuorg ) * u_orgforce_env_mxen(ixi) + cuorg * u_orgforce_env_mxen(ixf) + + v_orgforce_flx_out(i) = ( 1._r8 - cuorg ) * v_orgforce_flx_mxen(ixi) + cuorg * v_orgforce_flx_mxen(ixf) + v_orgforce_und_out(i) = ( 1._r8 - cuorg ) * v_orgforce_und_mxen(ixi) + cuorg * v_orgforce_und_mxen(ixf) + v_orgforce_env_out(i) = ( 1._r8 - cuorg ) * v_orgforce_env_mxen(ixi) + cuorg * v_orgforce_env_mxen(ixf) + + awk_orgforce_flx_out(i) = ( 1._r8 - cuorg ) * awk_orgforce_flx_mxen(ixi) + cuorg * awk_orgforce_flx_mxen(ixf) + awk_orgforce_mix_out(i) = ( 1._r8 - cuorg ) * awk_orgforce_mix_mxen(ixi) + cuorg * awk_orgforce_mix_mxen(ixf) + + cmf_d_org_pblh_out(i) = ( 1._r8 - cuorg ) * cmf_d_org_pblh_mxen(ixi) + cuorg * cmf_d_org_pblh_mxen(ixf) + + ! -------------------------------------------------------------------------------------------------------------- ! + ! Sep.07.2011. If the prognosed wake area becomes larger than the available maximum value ( awk_PBL_max ), ! + ! increae the detrainment rate of the wake 'del_wk', such that the prognozed wake area becomes ! + ! identical to awk_PBL_max. Also correspondingly modify 'awk_orgforce_out(i)' and 'taui_thl_out(i)' ! + ! etc. which are explicit function of 'del_wk'. ! + ! Note that this 'awk_PBL_max' constraint is applied to the prognozed 'awk_PBL' but BEFORE applying ! + ! non-homogeneous distribution assumption of wake properties. When we apply non-homogeneous distr. ! + ! assumption of wake properties at the next time step, we an further decrease the wake area. So, ! + ! we have double safety which is good. Note also that due to the coding structure, it is very hard ! + ! to apply the awk_PBL_max constraint after applying non-homogeneous distribution assumption of ! + ! wake properties. Current UNICON code is reasonable good and perfect. ! + ! Sep.09.2011. I don't prognose 'thv' anymore. ! + ! I should re-check whether below formula is exactly correct or not - should re-derive for check. ! + ! Sep.11.2011. In the below block, 'tmp1' is an adjusted new 'del_wk'. ! + ! Note that the initial 'del_wk' specified from the parameter sentence can be zero. So, in order to ! + ! prevent division by zero, I used max( del_wk, nonzero ) in the below block. ! + ! REQUIREMENT: I must re-check whether below formula is not correct or not. ! + ! I have not done re-checking yet as of Sep.11.2011. ! + ! Sep.11.2011. In case of 'awk_PBL', I should adjust 'awk_orgforce' which is a function of del_wk, while ! + ! in case of 'thl,qt' , I should adjust 'taui' which is a function of del_wk. ! + ! In the below block, 'tmp1' is a newly adjusted 'del_wk'. ! + ! I performed correct re-checking and corrected the previously wrong code. ! + ! -------------------------------------------------------------------------------------------------------------- ! + + if( abs(taui_awk_out(i)) .gt. nonzero ) then + awk_PBL_inout(i) = awk_PBL * exp( - dt * taui_awk_out(i) ) + awk_orgforce_out(i) / taui_awk_out(i) * & + ( 1._r8 - exp( - dt * taui_awk_out(i) ) ) + else + awk_PBL_inout(i) = awk_PBL * ( 1._r8 - dt * taui_awk_out(i) ) + awk_orgforce_out(i) * dt + endif + + if( awk_PBL_inout(i) .gt. awk_PBL_max ) then + awk_PBL_inout(i) = awk_PBL_max + tmp2 = awk_orgforce_out(i) + if( abs(taui_awk_out(i)) .gt. nonzero ) then + awk_orgforce_out(i) = ( awk_PBL_max - awk_PBL * exp( - dt * taui_awk_out(i) ) ) * taui_awk_out(i) / ( 1._r8 - & + exp( - dt * taui_awk_out(i) ) ) + else + awk_orgforce_out(i) = ( awk_PBL_max - awk_PBL * ( 1._r8 - dt * taui_awk_out(i) ) ) / dt + endif + tmp1 = del_wk_eff + tmp2 - awk_orgforce_out(i) + tmp3 = 1._r8 / max( nonzero, awk_PBL * ( 1._r8 - awk_PBL ) ) + taui_thl_out(i) = taui_thl_out(i) + tmp3 * ( tmp1 - del_wk_eff ) + taui_qt_out(i) = taui_qt_out(i) + tmp3 * ( tmp1 - del_wk_eff ) + taui_u_out(i) = taui_u_out(i) + tmp3 * ( tmp1 - del_wk_eff ) + taui_v_out(i) = taui_v_out(i) + tmp3 * ( tmp1 - del_wk_eff ) + do mt = 1, ncnst + taui_tr_out(i,mt) = taui_tr_out(i,mt) + tmp3 * ( tmp1 - del_wk_eff ) + enddo + endif + + ! ------------------------------------------------------ ! + ! Compute final prognosed state ! + ! I may need to impose a bound on the prognosed results. ! + ! Sep.09.2011. I don't prognose 'thv' anymore. ! + ! ------------------------------------------------------ ! + + if( abs(taui_thl_out(i)) .gt. nonzero ) then + delta_thl_PBL_inout(i) = delta_thl_PBL * exp( - dt * taui_thl_out(i) ) + thl_orgforce_out(i) / & + taui_thl_out(i) * ( 1._r8 - exp( - dt * taui_thl_out(i) ) ) + else + delta_thl_PBL_inout(i) = delta_thl_PBL * ( 1._r8 - dt * taui_thl_out(i) ) + thl_orgforce_out(i) * dt + endif + if( abs(taui_qt_out(i)) .gt. nonzero ) then + delta_qt_PBL_inout(i) = delta_qt_PBL * exp( - dt * taui_qt_out(i) ) + qt_orgforce_out(i) / & + taui_qt_out(i) * ( 1._r8 - exp( - dt * taui_qt_out(i) ) ) + else + delta_qt_PBL_inout(i) = delta_qt_PBL * ( 1._r8 - dt * taui_qt_out(i) ) + qt_orgforce_out(i) * dt + endif + if( abs(taui_u_out(i)) .gt. nonzero ) then + delta_u_PBL_inout(i) = delta_u_PBL * exp( - dt * taui_u_out(i) ) + u_orgforce_out(i) / & + taui_u_out(i) * ( 1._r8 - exp( - dt * taui_u_out(i) ) ) + else + delta_u_PBL_inout(i) = delta_u_PBL * ( 1._r8 - dt * taui_u_out(i) ) + u_orgforce_out(i) * dt + endif + if( abs(taui_v_out(i)) .gt. nonzero ) then + delta_v_PBL_inout(i) = delta_v_PBL * exp( - dt * taui_v_out(i) ) + v_orgforce_out(i) / & + taui_v_out(i) * ( 1._r8 - exp( - dt * taui_v_out(i) ) ) + else + delta_v_PBL_inout(i) = delta_v_PBL * ( 1._r8 - dt * taui_v_out(i) ) + v_orgforce_out(i) * dt + endif + do mt = 1, ncnst + if ( abs(taui_tr_out(i,mt)) .gt. nonzero) then + delta_tr_PBL_inout(i,mt) = delta_tr_PBL(mt) * exp( - dt * taui_tr_out(i,mt) ) + tr_orgforce_out(i,mt) / & + taui_tr_out(i,mt) * ( 1._r8 - exp( - dt * taui_tr_out(i,mt) ) ) + else + delta_tr_PBL_inout(i,mt) = delta_tr_PBL(mt) * ( 1._r8 - dt * taui_tr_out(i,mt) ) + tr_orgforce_out(i,mt) * dt + endif + enddo + + ! ------------------------------------------------------------------------------------------------- ! + ! Substitute organization tendency to the tracer array in all layers when organization is advected. ! + ! In future, I can include the heterogeneity of individual 25 tracer components for completeness ! + ! which however will increase computation time. ! + ! Add an offset to make the output tracer to be positive, so that advection scheme can handle. ! + ! Note that the same amount of offset should be subtracted when 'delta_xxx' is extracted from the ! + ! input tr0_in at the beginning of this program. ! + ! Note that to ensure that 'delta_xxx' are not modified by wet or dry deposition and other physical ! + ! processes other than UNICON and horizontal advection, a guaranteed update of tracer arrays ! + ! just before advection scheme is done within tphysac.F90, which in fact makes below block ! + ! unnecessary. However, for clarify, let's keep below block. It is not a harm at all. ! + ! ------------------------------------------------------------------------------------------------- ! + + if( iorg_adv ) then + do k = 1, mkx + trten_out(i,k,i_awk) = ( awk_PBL_inout(i) - tr0_in(i,k,i_awk) ) / dt + trten_out(i,k,i_thl) = ( max( 0._r8, delta_thl_PBL_inout(i) + 100._r8 ) - tr0_in(i,k,i_thl) ) / dt + trten_out(i,k,i_qt) = ( max( 0._r8, delta_qt_PBL_inout(i) + 100._r8 ) - tr0_in(i,k,i_qt) ) / dt + trten_out(i,k,i_u) = ( max( 0._r8, delta_u_PBL_inout(i) + 100._r8 ) - tr0_in(i,k,i_u) ) / dt + trten_out(i,k,i_v) = ( max( 0._r8, delta_v_PBL_inout(i) + 100._r8 ) - tr0_in(i,k,i_v) ) / dt + enddo + endif + + enddo ! End of do i = 1, iend. This is a column loop. + + ! ----------------------- ! + ! End of Main Computation ! + ! ----------------------- ! + + ! ---------------------------------------- ! + ! Writing main diagnostic output variables ! + ! ---------------------------------------- ! + + call outfld('cmf_SP' , cmf_out, mix, lchnk) + tmpi_array(:,0:mkx) = slflx_out(:,mkx:0:-1) + call outfld('slflx_SP', tmpi_array, mix, lchnk) + tmpi_array(:,0:mkx) = qtflx_out(:,mkx:0:-1) + call outfld('qtflx_SP', tmpi_array, mix, lchnk) + call outfld('uflx_SP' , uflx_out, mix, lchnk) + call outfld('vflx_SP' , vflx_out, mix, lchnk) + + call outfld('flxrain_SP' , flxrain_out, mix, lchnk) + call outfld('flxsnow_SP' , flxsnow_out, mix, lchnk) + + tmpi_array(:,0:mkx) = cmf_u_out(:,mkx:0:-1) + call outfld('cmf_u_SP' , tmpi_array, mix, lchnk) + call outfld('slflx_u_SP', slflx_u_out, mix, lchnk) + call outfld('qtflx_u_SP', qtflx_u_out, mix, lchnk) + call outfld('uflx_u_SP' , uflx_u_out, mix, lchnk) + call outfld('vflx_u_SP' , vflx_u_out, mix, lchnk) + + call outfld('cmf_d_SP' , cmf_d_out, mix, lchnk) + call outfld('slflx_d_SP', slflx_d_out, mix, lchnk) + call outfld('qtflx_d_SP', qtflx_d_out, mix, lchnk) + call outfld('uflx_d_SP' , uflx_d_out, mix, lchnk) + call outfld('vflx_d_SP' , vflx_d_out, mix, lchnk) + + call outfld('cush_SP', cush_inout, mix, lchnk) + call outfld('cushavg_SP', cushavg_inout, mix, lchnk) + call outfld('cuorg_SP', cuorg_inout, mix, lchnk) + call outfld('Radius_SP', rad_u_out(:,mkx), mix, lchnk) + call outfld('sgh30_SP', sgh30_in, mix, lchnk) + + call outfld('kw_SP', kw_out, mix, lchnk) + + call outfld('sigma_w_SP', sigma_w_out, mix, lchnk) + call outfld('sigma_thl_SP', sigma_thl_out, mix, lchnk) + call outfld('sigma_qt_SP', sigma_qt_out, mix, lchnk) + call outfld('sigma_u_SP', sigma_u_out, mix, lchnk) + call outfld('sigma_v_SP', sigma_v_out, mix, lchnk) + + call outfld('w_org_SP', w_org_out, mix, lchnk) + call outfld('thl_org_SP', thl_org_out, mix, lchnk) + call outfld('qt_org_SP', qt_org_out, mix, lchnk) + call outfld('u_org_SP', u_org_out, mix, lchnk) + call outfld('v_org_SP', v_org_out, mix, lchnk) + + call outfld('tkes_SP', tkes_out, mix, lchnk) + call outfld('went_SP', went_out, mix, lchnk) + call outfld('went_eff_SP', went_eff_out, mix, lchnk) + + tmpm_array(:,1:mkx) = am_u_out(:,mkx:1:-1) + call outfld('am_u_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = qlm_u_out(:,mkx:1:-1) + call outfld('qlm_u_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = qim_u_out(:,mkx:1:-1) + call outfld('qim_u_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = am_d_out(:,mkx:1:-1) + call outfld('am_d_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = qlm_d_out(:,mkx:1:-1) + call outfld('qlm_d_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = qim_d_out(:,mkx:1:-1) + call outfld('qim_d_SP', tmpm_array, mix, lchnk) + + call outfld('slten_u_SP' , slten_u_out, mix, lchnk) + call outfld('qtten_u_SP' , qtten_u_out, mix, lchnk) + call outfld('uten_u_SP' , uten_u_out, mix, lchnk) + call outfld('vten_u_SP' , vten_u_out, mix, lchnk) + call outfld('sten_u_SP' , sten_u_out, mix, lchnk) + call outfld('qvten_u_SP' , qvten_u_out, mix, lchnk) + call outfld('qlten_u_SP' , qlten_u_out, mix, lchnk) + call outfld('qiten_u_SP' , qiten_u_out, mix, lchnk) + call outfld('nlten_u_SP' , trten_u_out(:,:,ixnumliq), mix, lchnk) + call outfld('niten_u_SP' , trten_u_out(:,:,ixnumice), mix, lchnk) +#ifdef MODAL_AERO + do m = 1, ntot_amode + l = numptr_amode(m) + varname = trim(cnst_name(l))//'_u_SP' + call outfld( trim(varname), trten_u_out(:,:,l), mix, lchnk ) + do lspec = 1, nspec_amode(m) + l = lmassptr_amode(lspec,m) + varname = trim(cnst_name(l))//'_u_SP' + call outfld( trim(varname), trten_u_out(:,:,l), mix, lchnk ) + enddo + enddo +#endif + + call outfld('slten_d_SP' , slten_d_out, mix, lchnk) + call outfld('qtten_d_SP' , qtten_d_out, mix, lchnk) + call outfld('uten_d_SP' , uten_d_out, mix, lchnk) + call outfld('vten_d_SP' , vten_d_out, mix, lchnk) + call outfld('sten_d_SP' , sten_d_out, mix, lchnk) + call outfld('qvten_d_SP' , qvten_d_out, mix, lchnk) + call outfld('qlten_d_SP' , qlten_d_out, mix, lchnk) + call outfld('qiten_d_SP' , qiten_d_out, mix, lchnk) + call outfld('nlten_d_SP' , trten_d_out(:,:,ixnumliq), mix, lchnk) + call outfld('niten_d_SP' , trten_d_out(:,:,ixnumice), mix, lchnk) +#ifdef MODAL_AERO + do m = 1, ntot_amode + l = numptr_amode(m) + varname = trim(cnst_name(l))//'_d_SP' + call outfld( trim(varname), trten_d_out(:,:,l), mix, lchnk ) + do lspec = 1, nspec_amode(m) + l = lmassptr_amode(lspec,m) + varname = trim(cnst_name(l))//'_d_SP' + call outfld( trim(varname), trten_d_out(:,:,l), mix, lchnk ) + enddo + enddo +#endif + + call outfld('slten_evp_SP' , slten_evp_out, mix, lchnk) + call outfld('qtten_evp_SP' , qtten_evp_out, mix, lchnk) + call outfld('uten_evp_SP' , uten_evp_out, mix, lchnk) + call outfld('vten_evp_SP' , vten_evp_out, mix, lchnk) + call outfld('sten_evp_SP' , sten_evp_out, mix, lchnk) + call outfld('qvten_evp_SP' , qvten_evp_out, mix, lchnk) + call outfld('qlten_evp_SP' , qlten_evp_out, mix, lchnk) + call outfld('qiten_evp_SP' , qiten_evp_out, mix, lchnk) + call outfld('nlten_evp_SP' , trten_evp_out(:,:,ixnumliq), mix, lchnk) + call outfld('niten_evp_SP' , trten_evp_out(:,:,ixnumice), mix, lchnk) +#ifdef MODAL_AERO + do m = 1, ntot_amode + l = numptr_amode(m) + varname = trim(cnst_name(l))//'_evp_SP' + call outfld( trim(varname), trten_evp_out(:,:,l), mix, lchnk ) + do lspec = 1, nspec_amode(m) + l = lmassptr_amode(lspec,m) + varname = trim(cnst_name(l))//'_evp_SP' + call outfld( trim(varname), trten_evp_out(:,:,l), mix, lchnk ) + enddo + enddo +#endif + + call outfld('slten_dis_SP' , slten_dis_out, mix, lchnk) + call outfld('qtten_dis_SP' , qtten_dis_out, mix, lchnk) + call outfld('uten_dis_SP' , uten_dis_out, mix, lchnk) + call outfld('vten_dis_SP' , vten_dis_out, mix, lchnk) + call outfld('sten_dis_SP' , sten_dis_out, mix, lchnk) + call outfld('qvten_dis_SP' , qvten_dis_out, mix, lchnk) + call outfld('qlten_dis_SP' , qlten_dis_out, mix, lchnk) + call outfld('qiten_dis_SP' , qiten_dis_out, mix, lchnk) + call outfld('nlten_dis_SP' , trten_dis_out(:,:,ixnumliq), mix, lchnk) + call outfld('niten_dis_SP' , trten_dis_out(:,:,ixnumice), mix, lchnk) +#ifdef MODAL_AERO + do m = 1, ntot_amode + l = numptr_amode(m) + varname = trim(cnst_name(l))//'_dis_SP' + call outfld( trim(varname), trten_dis_out(:,:,l), mix, lchnk ) + do lspec = 1, nspec_amode(m) + l = lmassptr_amode(lspec,m) + varname = trim(cnst_name(l))//'_dis_SP' + call outfld( trim(varname), trten_dis_out(:,:,l), mix, lchnk ) + enddo + enddo +#endif + + call outfld('qlten_sub_SP' , qlten_sub_out, mix, lchnk) + call outfld('qiten_sub_SP' , qiten_sub_out, mix, lchnk) + + call outfld('qlten_det_SP' , qlten_det_out, mix, lchnk) + call outfld('qiten_det_SP' , qiten_det_out, mix, lchnk) + + call outfld('thl_u_SP' , thl_u_out, mix, lchnk) + call outfld('qt_u_SP' , qt_u_out, mix, lchnk) + call outfld('u_u_SP' , u_u_out, mix, lchnk) + call outfld('v_u_SP' , v_u_out, mix, lchnk) + call outfld('w_u_SP' , w_u_out, mix, lchnk) + call outfld('ql_u_SP' , ql_u_out, mix, lchnk) + call outfld('qi_u_SP' , qi_u_out, mix, lchnk) + call outfld('wa_u_SP' , wa_u_out, mix, lchnk) + call outfld('qla_u_SP' , qla_u_out, mix, lchnk) + call outfld('qia_u_SP' , qia_u_out, mix, lchnk) + call outfld('a_u_SP' , a_u_out, mix, lchnk) + call outfld('rad_u_SP' , rad_u_out, mix, lchnk) + call outfld('num_u_SP' , num_u_out, mix, lchnk) + call outfld('gamw_u_SP' , gamw_u_out, mix, lchnk) + call outfld('nl_u_SP' , tr_u_out(:,:,ixnumliq), mix, lchnk) + call outfld('ni_u_SP' , tr_u_out(:,:,ixnumice), mix, lchnk) + call outfld('thva_u_SP' , thva_u_out, mix, lchnk) + + call outfld('a_p_SP' , a_p_out, mix, lchnk) + call outfld('am_evp_SP' , am_evp_out, mix, lchnk) + call outfld('am_pu_SP' , am_pu_out, mix, lchnk) + call outfld('x_p_SP' , x_p_out, mix, lchnk) + call outfld('y_p_SP' , y_p_out, mix, lchnk) + call outfld('x_um_SP' , x_um_out, mix, lchnk) + call outfld('y_um_SP' , y_um_out, mix, lchnk) + + call outfld('thl_d_SP' , thl_d_out, mix, lchnk) + call outfld('qt_d_SP' , qt_d_out, mix, lchnk) + call outfld('u_d_SP' , u_d_out, mix, lchnk) + call outfld('v_d_SP' , v_d_out, mix, lchnk) + call outfld('w_d_SP' , w_d_out, mix, lchnk) + call outfld('ql_d_SP' , ql_d_out, mix, lchnk) + call outfld('qi_d_SP' , qi_d_out, mix, lchnk) + call outfld('wa_d_SP' , wa_d_out, mix, lchnk) + call outfld('qla_d_SP' , qla_d_out, mix, lchnk) + call outfld('qia_d_SP' , qia_d_out, mix, lchnk) + call outfld('a_d_SP' , a_d_out, mix, lchnk) + call outfld('nl_d_SP' , tr_d_out(:,:,ixnumliq), mix, lchnk) + call outfld('ni_d_SP' , tr_d_out(:,:,ixnumice), mix, lchnk) + + tmpi_array(:,0:mkx) = thv_b_out(:,mkx:0:-1) + call outfld('thv_b_SP', tmpi_array, mix, lchnk) + tmpi_array(:,0:mkx) = thv_t_out(:,mkx:0:-1) + call outfld('thv_t_SP', tmpi_array, mix, lchnk) + tmpi_array(:,0:mkx) = thv_mt_out(:,mkx:0:-1) + call outfld('thv_mt_SP', tmpi_array, mix, lchnk) + tmpi_array(:,0:mkx) = thv_min_out(:,mkx:0:-1) + call outfld('thv_min_SP', tmpi_array, mix, lchnk) + + tmpm_array(:,1:mkx) = cu_cmfr_inout(:,mkx:1:-1) + call outfld('cu_cmfr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_thlr_inout(:,mkx:1:-1) + call outfld('cu_thlr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_qtr_inout(:,mkx:1:-1) + call outfld('cu_qtr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_qlr_inout(:,mkx:1:-1) + call outfld('cu_qlr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_qir_inout(:,mkx:1:-1) + call outfld('cu_qir_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_ur_inout(:,mkx:1:-1) + call outfld('cu_ur_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_vr_inout(:,mkx:1:-1) + call outfld('cu_vr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_thvr_inout(:,mkx:1:-1) + call outfld('cu_thvr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_rhr_inout(:,mkx:1:-1) + call outfld('cu_rhr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_trr_inout(:,mkx:1:-1,ixnumliq) + call outfld('cu_nlr_SP', tmpm_array, mix, lchnk) + tmpm_array(:,1:mkx) = cu_trr_inout(:,mkx:1:-1,ixnumice) + call outfld('cu_nir_SP', tmpm_array, mix, lchnk) + + do msfc = 1, nseg + write(numcha,'(i2.2)') msfc + + call outfld( 'thl_u'//numcha//'_SP', thl_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qt_u'//numcha//'_SP', qt_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'u_u'//numcha//'_SP', u_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'v_u'//numcha//'_SP', v_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'w_u'//numcha//'_SP', w_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'ql_u'//numcha//'_SP', ql_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qi_u'//numcha//'_SP', qi_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'cmf_u'//numcha//'_SP', cmf_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'a_u'//numcha//'_SP', a_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'num_u'//numcha//'_SP', num_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'rad_u'//numcha//'_SP', rad_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'nl_u'//numcha//'_SP', tr_u_msfc_out(:,:,msfc,ixnumliq,1), mix, lchnk) + call outfld( 'ni_u'//numcha//'_SP', tr_u_msfc_out(:,:,msfc,ixnumice,1), mix, lchnk) + + call outfld( 'eps0_u'//numcha//'_SP', eps0_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'eps_u'//numcha//'_SP', eps_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'del_u'//numcha//'_SP', del_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'eeps_u'//numcha//'_SP', eeps_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'ddel_u'//numcha//'_SP', ddel_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'xc_u'//numcha//'_SP', xc_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'xs_u'//numcha//'_SP', xs_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'xemin_u'//numcha//'_SP', xemin_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'xemax_u'//numcha//'_SP', xemax_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'cridis_u'//numcha//'_SP', cridis_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'thvcuenv_u'//numcha//'_SP', thvcuenv_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'thvegenv_u'//numcha//'_SP', thvegenv_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'thvxsenv_u'//numcha//'_SP', thvxsenv_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'fmix_u'//numcha//'_SP', fmix_u_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'cmfumix_u'//numcha//'_SP', cmfumix_u_msfc_out(:,:,msfc,1), mix, lchnk) + + call outfld( 'ptop'//numcha//'_SP', ptop_msfc_out(:,msfc,1), mix, lchnk) + call outfld( 'ztop'//numcha//'_SP', ztop_msfc_out(:,msfc,1), mix, lchnk) + + call outfld( 'thl_d'//numcha//'_SP', thl_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qt_d'//numcha//'_SP', qt_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'u_d'//numcha//'_SP', u_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'v_d'//numcha//'_SP', v_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'w_d'//numcha//'_SP', w_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'ql_d'//numcha//'_SP', ql_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qi_d'//numcha//'_SP', qi_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'wa_d'//numcha//'_SP', wa_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qla_d'//numcha//'_SP', qla_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'qia_d'//numcha//'_SP', qia_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'cmf_d'//numcha//'_SP', cmf_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'a_d'//numcha//'_SP', a_d_msfc_out(:,:,msfc,1), mix, lchnk) + call outfld( 'nl_d'//numcha//'_SP', tr_d_msfc_out(:,:,msfc,ixnumliq,1), mix, lchnk) + call outfld( 'ni_d'//numcha//'_SP', tr_d_msfc_out(:,:,msfc,ixnumice,1), mix, lchnk) + + enddo + + call outfld('thl_orgfce_SP', thl_orgforce_out, mix, lchnk) + call outfld('qt_orgfce_SP', qt_orgforce_out, mix, lchnk) + call outfld('u_orgfce_SP', u_orgforce_out, mix, lchnk) + call outfld('v_orgfce_SP', v_orgforce_out, mix, lchnk) + call outfld('awk_orgfce_SP', awk_orgforce_out, mix, lchnk) + + call outfld('thl_orgfce_f_SP', thl_orgforce_flx_out, mix, lchnk) + call outfld('qt_orgfce_f_SP', qt_orgforce_flx_out, mix, lchnk) + call outfld('u_orgfce_f_SP', u_orgforce_flx_out, mix, lchnk) + call outfld('v_orgfce_f_SP', v_orgforce_flx_out, mix, lchnk) + call outfld('awk_orgfce_f_SP', awk_orgforce_flx_out, mix, lchnk) + + call outfld('thl_orgfce_u_SP', thl_orgforce_und_out, mix, lchnk) + call outfld('qt_orgfce_u_SP', qt_orgforce_und_out, mix, lchnk) + call outfld('u_orgfce_u_SP', u_orgforce_und_out, mix, lchnk) + call outfld('v_orgfce_u_SP', v_orgforce_und_out, mix, lchnk) + call outfld('awk_orgfce_m_SP', awk_orgforce_mix_out, mix, lchnk) + + call outfld('thl_orgfce_e_SP', thl_orgforce_env_out, mix, lchnk) + call outfld('qt_orgfce_e_SP', qt_orgforce_env_out, mix, lchnk) + call outfld('u_orgfce_e_SP', u_orgforce_env_out, mix, lchnk) + call outfld('v_orgfce_e_SP', v_orgforce_env_out, mix, lchnk) + call outfld('cmf_d_orgh_SP', cmf_d_org_pblh_out, mix, lchnk) + + call outfld('taui_thl_SP', taui_thl_out, mix, lchnk) + call outfld('taui_qt_SP', taui_qt_out, mix, lchnk) + call outfld('taui_u_SP', taui_u_out, mix, lchnk) + call outfld('taui_v_SP', taui_v_out, mix, lchnk) + call outfld('taui_awk_SP', taui_awk_out, mix, lchnk) + + call outfld('del_org_SP', del_org_out, mix, lchnk) + call outfld('del0_org_SP', del0_org_out, mix, lchnk) + + return + +end subroutine compute_unicon + +end module unicon diff --git a/src/physics/cam/unicon_cam.F90 b/src/physics/cam/unicon_cam.F90 new file mode 100644 index 0000000000..41584dd316 --- /dev/null +++ b/src/physics/cam/unicon_cam.F90 @@ -0,0 +1,1412 @@ +!=========================================================================== +! CAM interface to the UNIFIED CONVECTION SCHEME (UNICON) +! +! The USE_UNICON macro converts this module to a stub interface which allows +! CAM to be built without the unicon and unicon_utils modules. +! +!=========================================================================== + +module unicon_cam + +use shr_kind_mod, only: r8 => shr_kind_r8, i4 => shr_kind_i4 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use physconst, only: rair, cpair, gravit, latvap, latice, zvir, mwdry + +use constituents, only: pcnst, cnst_add, qmin, cnst_get_type_byind, cnst_get_ind, cnst_name +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx +use physics_types, only: physics_state, physics_ptend, physics_ptend_init +use camsrfexch, only: cam_in_t +use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls, pbuf_old_tim_idx, & + physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_set_field + +use phys_control, only: phys_getopts +use cam_history, only: outfld, addfld, horiz_only + +use time_manager, only: is_first_step +use cam_abortutils, only: endrun + +#ifdef USE_UNICON +use unicon, only: unicon_init, compute_unicon +use unicon_utils, only: unicon_utils_init, positive_moisture, positive_tracer +#endif + +implicit none +private +save + +public :: & + unicon_cam_readnl, & + unicon_cam_register, & + unicon_cam_init, & + unicon_implements_cnst, & + unicon_init_cnst, & + unicon_out_t, & + unicon_cam_tend, & + unicon_cam_org_diags + +! namelist variables +logical :: unicon_offline_dat_out = .false. +integer :: unicon_offline_dat_hfile = 2 + +! properties +real(r8) :: xlv ! Latent heat of vaporization +real(r8) :: xlf ! Latent heat of fusion +real(r8) :: xls ! Latent heat of sublimation +real(r8) :: cp ! Specific heat of dry air + +integer, parameter :: & + nseg = 1, &! Number of updraft segments [ # ] + mix = pcols, &! Maximum number of columns + mkx = pver, &! Number of vertical layers + ncnst = pcnst ! Number of advected constituents + +! For advecting organization-related variables +integer, parameter :: n_org = 5 ! Number of constituents +character(len=8), dimension(n_org), parameter :: & ! Constituent names + cnst_names = (/'ORGawk ','ORGthl ','ORGqto ','ORGuoo ','ORGvoo '/) + +integer :: awk_cnst_ind, thl_cnst_ind, qt_cnst_ind, u_cnst_ind, v_cnst_ind + +! fields added to physics buffer by this module +integer :: & + cushavg_idx, & + cuorg_idx, & + awk_PBL_idx, & + delta_thl_PBL_idx, & + delta_qt_PBL_idx, & + delta_u_PBL_idx, & + delta_v_PBL_idx, & + delta_tr_PBL_idx, & + cu_cmfr_idx, & + cu_thlr_idx, & + cu_qtr_idx, & + cu_ur_idx, & + cu_vr_idx, & + cu_qlr_idx, & + cu_qir_idx, & + cu_trr_idx, & + cmfr_det_idx, & + qlr_det_idx, & + qir_det_idx + +! fields expected to be in the physics buffer +integer :: & + sgh30_idx = -1, & + ast_idx = -1, & + tke_idx = -1, & + bprod_idx = -1, & + kpblh_idx = -1, & + pblh_idx = -1, & + went_idx = -1, & + cush_idx = -1, & + shfrc_idx = -1, & + icwmrsh_idx = -1, & + rprdsh_idx = -1, & + prec_sh_idx = -1, & + snow_sh_idx = -1, & + nevapr_shcu_idx = -1, & + am_evp_st_idx = -1, & ! Evaporation area of stratiform precipitation [fraction] + evprain_st_idx = -1, & ! Grid-mean evaporation rate of stratiform rain [kg/kg/s] >= 0. + evpsnow_st_idx = -1 ! Grid-mean evaporation rate of stratiform snow [kg/kg/s] >= 0. + +! constituent indices +integer :: ixcldliq, ixcldice, ixnumliq, ixnumice + +! unicon output fields +type unicon_out_t + real(r8) :: cmfmc(mix,mkx+1) ! Upward convective mass flux at the interface [ kg / s / m2 ] + real(r8) :: slflx(mix,mkx+1) ! Net upward convective flux of liquid static energy [ J / s / m2 ] + real(r8) :: qtflx(mix,mkx+1) ! Net upward convective flux of total specific humidity [ kg / s / m2 ] + real(r8) :: rqc(mix,mkx) ! Prod of suspended LWC+IWC by expel of excessive in-cumulus condensate [ kg / kg / s ] > 0 + real(r8) :: rliq(mix) ! Vertical integral of 'rqc' in flux unit [ m / s ] + real(r8) :: cnt(mix) ! Cloud top interface index ( ki = kpen ) + real(r8) :: cnb(mix) ! Cloud base interface index ( ki = krel-1 ) +end type unicon_out_t + +! logical array to identify constituents that are mode number concentrations +logical :: cnst_is_mam_num(ncnst) +! logical array to identify constituents that are mode specie mass mixing ratios +logical :: cnst_is_mam_mmr(ncnst) + +!================================================================================================== +contains +!================================================================================================== + +!> \brief Read namelist group unicon_nl +!! +!! \param[in] nlfile ! filepath for file containing namelist input + +subroutine unicon_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'unicon_cam_readnl' + + namelist /unicon_nl/ unicon_offline_dat_out, unicon_offline_dat_hfile + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'unicon_nl', status=ierr) + if (ierr == 0) then + read(unitn, unicon_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast (unicon_offline_dat_out, 1, mpilog, 0, mpicom) + call mpibcast (unicon_offline_dat_hfile, 1, mpiint, 0, mpicom) +#endif + +end subroutine unicon_cam_readnl + +!================================================================================================ + +subroutine unicon_cam_register + +! Register fields in the constituent array and the physics buffer. + + + ! Jun.02.2012. Sungsu for advecting organization-related horizontal heterogeneity + ! within PBL. + ! For the time being, in order to save computation time, advection of aerosol perturbations + ! are simply neglected. + +#ifdef USE_UNICON + + call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, awk_cnst_ind, & + 'Wake area within PBL associated with organization', readiv=.false., mixtype = 'dry') + call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, thl_cnst_ind, & + 'Perturbation of thl associated with organization', readiv=.false., mixtype = 'dry') + call cnst_add(cnst_names(3), mwdry, cpair, 0._r8, qt_cnst_ind, & + 'Perturbation of qt associated with organization', readiv=.false., mixtype = 'dry') + call cnst_add(cnst_names(4), mwdry, cpair, 0._r8, u_cnst_ind, & + 'Perturbation of u associated with organization', readiv=.false., mixtype = 'dry') + call cnst_add(cnst_names(5), mwdry, cpair, 0._r8, v_cnst_ind, & + 'Perturbation of v associated with organization', readiv=.false., mixtype = 'dry') + + + call pbuf_add_field('cushavg', 'global', dtype_r8, (/pcols,dyn_time_lvls/), cushavg_idx) + call pbuf_add_field('cuorg', 'global', dtype_r8, (/pcols,dyn_time_lvls/), cuorg_idx) + call pbuf_add_field('awk_PBL', 'global', dtype_r8, (/pcols,dyn_time_lvls/), awk_PBL_idx) + call pbuf_add_field('delta_thl_PBL', 'global', dtype_r8, (/pcols,dyn_time_lvls/), delta_thl_PBL_idx) + call pbuf_add_field('delta_qt_PBL', 'global', dtype_r8, (/pcols,dyn_time_lvls/), delta_qt_PBL_idx) + call pbuf_add_field('delta_u_PBL', 'global', dtype_r8, (/pcols,dyn_time_lvls/), delta_u_PBL_idx) + call pbuf_add_field('delta_v_PBL', 'global', dtype_r8, (/pcols,dyn_time_lvls/), delta_v_PBL_idx) + call pbuf_add_field('delta_tr_PBL', 'global', dtype_r8, (/pcols,pcnst,dyn_time_lvls/), delta_tr_PBL_idx) + call pbuf_add_field('cu_cmfr', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_cmfr_idx) + call pbuf_add_field('cu_thlr', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_thlr_idx) + call pbuf_add_field('cu_qtr', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_qtr_idx) + call pbuf_add_field('cu_ur', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_ur_idx) + call pbuf_add_field('cu_vr', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_vr_idx) + call pbuf_add_field('cu_qlr', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_qlr_idx) + call pbuf_add_field('cu_qir', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cu_qir_idx) + call pbuf_add_field('cu_trr', 'global', dtype_r8, (/pcols,pver,pcnst,dyn_time_lvls/), cu_trr_idx) + call pbuf_add_field('cmfr_det', 'global', dtype_r8, (/pcols,pver/), cmfr_det_idx) + call pbuf_add_field('qlr_det', 'global', dtype_r8, (/pcols,pver/), qlr_det_idx) + call pbuf_add_field('qir_det', 'global', dtype_r8, (/pcols,pver/), qir_det_idx) + +#endif + +end subroutine unicon_cam_register + +!================================================================================================== + +subroutine unicon_cam_init(pbuf2d) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local variables + character(len=*), parameter :: sub='unicon_cam_init: ' + integer :: i, icnst, j, l, m, nmodes, nspec + + character(len=8) :: units + character(len=30) :: varname + character(len=60) :: surname + character(len=2) :: numcha + integer :: msfc + ! ------------------------------------------------------------------------------------------- ! + +#ifdef USE_UNICON + + ! constants + xlv = latvap + xlf = latice + xls = xlv + xlf + cp = cpair + + call unicon_init(latvap, cpair, latice, zvir, rair, gravit) + + ! save some constituent indices + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMLIQ', ixnumliq) + call cnst_get_ind('NUMICE', ixnumice) + + ! save some physics buffer indices + sgh30_idx = pbuf_get_index('SGH30') + ast_idx = pbuf_get_index('AST') + tke_idx = pbuf_get_index('tke') + bprod_idx = pbuf_get_index('bprod') + kpblh_idx = pbuf_get_index('kpblh') + pblh_idx = pbuf_get_index('pblh') + went_idx = pbuf_get_index('went') + cush_idx = pbuf_get_index('cush') + shfrc_idx = pbuf_get_index('shfrc') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + rprdsh_idx = pbuf_get_index('RPRDSH') + prec_sh_idx = pbuf_get_index('PREC_SH') + snow_sh_idx = pbuf_get_index('SNOW_SH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + am_evp_st_idx = pbuf_get_index('am_evp_st') + evprain_st_idx = pbuf_get_index('evprain_st') + evpsnow_st_idx = pbuf_get_index('evpsnow_st') + + ! physics buffer fields that need initializers -- these are only + ! fields that have been added to pbuf by this module, or by the + ! convection driver layer. + if (is_first_step()) then + + if (cush_idx > 0) then + call pbuf_set_field(pbuf2d, cush_idx, 1.e3_r8) + else + call endrun(sub//'cush not in pbuf') + end if + if (cushavg_idx > 0) then + call pbuf_set_field(pbuf2d, cushavg_idx, 1.e3_r8) + else + call endrun(sub//'cushavg not in pbuf') + end if + if (cuorg_idx > 0) then + call pbuf_set_field(pbuf2d, cuorg_idx, 0.0_r8) + else + call endrun(sub//'cuorg not in pbuf') + end if + if (awk_pbl_idx > 0) then + call pbuf_set_field(pbuf2d, awk_pbl_idx, 0.0_r8) + else + call endrun(sub//'awk_PBL not in pbuf') + end if + if (delta_thl_PBL_idx > 0) then + call pbuf_set_field(pbuf2d, delta_thl_PBL_idx, 0.0_r8) + else + call endrun(sub//'delta_thl_PBL not in pbuf') + end if + if (delta_qt_PBL_idx > 0) then + call pbuf_set_field(pbuf2d, delta_qt_PBL_idx, 0.0_r8) + else + call endrun(sub//'delta_qt_PBL not in pbuf') + end if + if (delta_u_PBL_idx > 0) then + call pbuf_set_field(pbuf2d, delta_u_PBL_idx, 0.0_r8) + else + call endrun(sub//'delta_u_PBL not in pbuf') + end if + if (delta_v_PBL_idx > 0) then + call pbuf_set_field(pbuf2d, delta_v_PBL_idx, 0.0_r8) + else + call endrun(sub//'delta_v_PBL not in pbuf') + end if + if (delta_tr_PBL_idx > 0) then + call pbuf_set_field(pbuf2d, delta_tr_PBL_idx, 0.0_r8) + else + call endrun(sub//'delta_tr_PBL not in pbuf') + end if + if (cu_cmfr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_cmfr_idx, 0.0_r8) + else + call endrun(sub//'cu_cmfr not in pbuf') + end if + if (cu_thlr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_thlr_idx, 0.0_r8) + else + call endrun(sub//'cu_thlr not in pbuf') + end if + if (cu_qtr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_qtr_idx, 0.0_r8) + else + call endrun(sub//'cu_qtr not in pbuf') + end if + if (cu_ur_idx > 0) then + call pbuf_set_field(pbuf2d, cu_ur_idx, 0.0_r8) + else + call endrun(sub//'cu_ur not in pbuf') + end if + if (cu_vr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_vr_idx, 0.0_r8) + else + call endrun(sub//'cu_vr not in pbuf') + end if + if (cu_qlr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_qlr_idx, 0.0_r8) + else + call endrun(sub//'cu_qlr not in pbuf') + end if + if (cu_qir_idx > 0) then + call pbuf_set_field(pbuf2d, cu_qir_idx, 0.0_r8) + else + call endrun(sub//'cu_qir not in pbuf') + end if + if (cu_trr_idx > 0) then + call pbuf_set_field(pbuf2d, cu_trr_idx, 0.0_r8) + else + call endrun(sub//'cu_trr not in pbuf') + end if + if (cmfr_det_idx > 0) then + call pbuf_set_field(pbuf2d, cmfr_det_idx, 0.0_r8) + else + call endrun(sub//'cmfr_det not in pbuf') + end if + if (qlr_det_idx > 0) then + call pbuf_set_field(pbuf2d, qlr_det_idx, 0.0_r8) + else + call endrun(sub//'qlr_det not in pbuf') + end if + if (qir_det_idx > 0) then + call pbuf_set_field(pbuf2d, qir_det_idx, 0.0_r8) + else + call endrun(sub//'qir_det not in pbuf') + end if + + end if + + ! Set arrays to identify the modal aerosol constituents + cnst_is_mam_num = .false. + cnst_is_mam_mmr = .false. + call rad_cnst_get_info(0, nmodes=nmodes) + do i = 1, nmodes + call rad_cnst_get_mode_num_idx(i, icnst) + cnst_is_mam_num(icnst) = .true. + call rad_cnst_get_info(0, i, nspec=nspec) + do j = 1, nspec + call rad_cnst_get_mam_mmr_idx(i, j, icnst) + cnst_is_mam_mmr(icnst) = .true. + end do + end do + + ! ------------------------- ! + ! Internal Output Variables ! + ! ------------------------- ! + + ! Sungsu for advection of convective organization + + call addfld('ORGawk', (/ 'lev' /), 'A', 'no', 'Convective Organization - Wake Area' ) + call addfld('ORGthl', (/ 'lev' /), 'A', 'K', 'Convective Organization - Perturbation of thl in the non-wake area' ) + call addfld('ORGqto', (/ 'lev' /), 'A', 'kg/kg', 'Convective Organization - Perturbation of qt in the non-wake area' ) + call addfld('ORGuoo', (/ 'lev' /), 'A', 'm/s', 'Convective Organization - Perturbation of u in the non-wake area' ) + call addfld('ORGvoo', (/ 'lev' /), 'A', 'm/s', 'Convective Organization - Perturbation of v in the non-wake area' ) + + ! From the main unified convection scheme + + call addfld('flxrain_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective net rain flux') + call addfld('flxsnow_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective net snow flux') + + call addfld('cmf_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective net mass flux') + call addfld('qtflx_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective net qt flux') + call addfld('slflx_SP', (/ 'ilev' /), 'A', 'J/m2/s' , 'Convective net sl flux') + call addfld('uflx_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective net u flux') + call addfld('vflx_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective net v flux') + + call addfld('cmf_u_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective updraft mass flux') + call addfld('qtflx_u_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective updraft qt flux') + call addfld('slflx_u_SP', (/ 'ilev' /), 'A', 'J/m2/s' , 'Convective updraft sl flux') + call addfld('uflx_u_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective updraft u flux') + call addfld('vflx_u_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective updraft v flux') + + call addfld('cmf_d_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective downdraft mass flux') + call addfld('qtflx_d_SP', (/ 'ilev' /), 'A', 'kg/m2/s', 'Convective downdraft qt flux') + call addfld('slflx_d_SP', (/ 'ilev' /), 'A', 'J/m2/s' , 'Convective downdraft sl flux') + call addfld('uflx_d_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective downdraft u flux') + call addfld('vflx_d_SP', (/ 'ilev' /), 'A', 'kg/m/s2', 'Convective downdraft v flux') + + call addfld('qtten_u_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qt by updraft') + call addfld('slten_u_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency sl by updraft') + call addfld('uten_u_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency u by updraft') + call addfld('vten_u_SP', (/ 'lev' /), 'A', 'm/s/s' , 'Convective tendency v by updraft') + call addfld('sten_u_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency s by updraft') + call addfld('qvten_u_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qv by updraft') + call addfld('qlten_u_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by updraft') + call addfld('qiten_u_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by updraft') + call addfld('nlten_u_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency nl by updraft') + call addfld('niten_u_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency ni by updraft') + + call addfld('qtten_d_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qt by downdraft') + call addfld('slten_d_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency sl by downdraft') + call addfld('uten_d_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency u by downdraft') + call addfld('vten_d_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency v by downdraft') + call addfld('sten_d_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency s by downdraft') + call addfld('qvten_d_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qv by downdraft') + call addfld('qlten_d_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by downdraft') + call addfld('qiten_d_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by downdraft') + call addfld('nlten_d_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency nl by downdraft') + call addfld('niten_d_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency ni by downdraft') + + call addfld('qtten_evp_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qt by evap of precip within environment') + call addfld('slten_evp_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency sl by evap of precip within environment') + call addfld('uten_evp_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency u by evap of precip within environment') + call addfld('vten_evp_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency v by evap of precip within environment') + call addfld('sten_evp_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency s by evap of precip within environment') + call addfld('qvten_evp_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qv by evap of precip within environment') + call addfld('qlten_evp_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by evap of precip within environment') + call addfld('qiten_evp_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by evap of precip within environment') + call addfld('nlten_evp_SP', (/ 'lev' /), 'A', '#/kg/s', 'Convective tendency nl by evap of precip within environment') + call addfld('niten_evp_SP', (/ 'lev' /), 'A', '#/kg/s', 'Convective tendency ni by evap of precip within environment') + + call addfld('qtten_dis_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qt by dissipative heating') + call addfld('slten_dis_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency sl by dissipative heating') + call addfld('uten_dis_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency u by dissipative heating') + call addfld('vten_dis_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency v by dissipative heating') + call addfld('sten_dis_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency s by dissipative heating') + call addfld('qvten_dis_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qv by dissipative heating') + call addfld('qlten_dis_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by dissipative heating') + call addfld('qiten_dis_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by dissipative heating') + call addfld('nlten_dis_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency nl by dissipative heating') + call addfld('niten_dis_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency ni by dissipative heating') + + call addfld('qtten_pos_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qt by positive tracer constraints') + call addfld('slten_pos_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency sl by positive tracer constraints') + call addfld('uten_pos_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency u by positive tracer constraints') + call addfld('vten_pos_SP', (/ 'lev' /), 'A', 'm/s/s', 'Convective tendency v by positive tracer constraints') + call addfld('sten_pos_SP', (/ 'lev' /), 'A', 'J/kg/s', 'Convective tendency s by positive tracer constraints') + call addfld('qvten_pos_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qv by positive tracer constraints') + call addfld('qlten_pos_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by positive tracer constraints') + call addfld('qiten_pos_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by positive tracer constraints') + call addfld('nlten_pos_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency nl by positive tracer constraints') + call addfld('niten_pos_SP', (/ 'lev' /), 'A', '1/kg/s', 'Convective tendency ni by positive tracer constraints') + + call addfld('qlten_sub_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by compensating subsidence') + call addfld('qiten_sub_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by compensating subsidence') + + call addfld('qlten_det_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency ql by detrainment') + call addfld('qiten_det_SP', (/ 'lev' /), 'A', 'kg/kg/s', 'Convective tendency qi by detrainment') + + call addfld('CMFR_DET', (/ 'lev' /), 'A', 'kg/m2/s', 'Detrained convective mass flux' ) + call addfld('QLR_DET', (/ 'lev' /), 'A', 'kg/kg', 'Detrained convective LWC' ) + call addfld('QIR_DET', (/ 'lev' /), 'A', 'kg/kg', 'Detrained convective IWC' ) + + !f call addfld('exit_Cu_SP', horiz_only, 'A', '1', 'Exit identifier of UNICON') + call addfld('cush_SP', horiz_only, 'A', 'm', 'Cumulus top height from UNICON') + call addfld('cushavg_SP', horiz_only, 'A', 'm', 'Mean cumulus top height from UNICON') + call addfld('cuorg_SP', horiz_only, 'A', '1', 'Cumulus organization parameter from UNICON') + call addfld('Radius_SP', horiz_only, 'A', 'm', 'Cumulus plume radius at surface from UNICON') + !d call addfld('orgforce_SP', horiz_only, 'A', 'kg/m/s^2', 'Various organization forcing of UNICON') + !d call addfld('tau_org_SP', horiz_only, 'A', 's', 'Damping time scale of convective organization of UNICON') + !d call addfld('tau_TKE_SP', horiz_only, 'A', 's', 'Damping time scale of meso-scale TKE of UNICON') + call addfld('sgh30_SP', horiz_only, 'A', 'm', 'Standard deviation of subgrid topography at 30 sec') + + + call addfld('kw_SP', horiz_only, 'A', 'no', 'Internally computed kw from SPARKCONV' ) + + call addfld('sigma_w_SP', horiz_only, 'A', 'm/s', 'Standard deviation of updraft w at surface from UNICON') + call addfld('sigma_thl_SP', horiz_only, 'A', 'K', 'Standard deviation of updraft thl at surface from UNICON') + call addfld('sigma_qt_SP', horiz_only, 'A', 'g/kg', 'Standard deviation of updraft qt at surface from UNICON') + call addfld('sigma_u_SP', horiz_only, 'A', 'm/s', 'Standard deviation of updraft u at surface from UNICON') + call addfld('sigma_v_SP', horiz_only, 'A', 'm/s', 'Standard deviation of updraft v at surface from UNICON') + + call addfld('w_org_SP', horiz_only, 'A', 'm2/s2', 'Organization-generated additional w at surface from UNICON') + call addfld('thl_org_SP', horiz_only, 'A', 'K', 'Organization-generated additional thl at surface from UNICON') + call addfld('qt_org_SP', horiz_only, 'A', 'g/kg', 'Organization-generated additional qt at surface from UNICON') + call addfld('u_org_SP', horiz_only, 'A', 'm/s', 'Organization-generated additional u at surface from UNICON') + call addfld('v_org_SP', horiz_only, 'A', 'm/s', 'Organization-generated additional v at surface from UNICON') + + call addfld('tkes_SP', horiz_only, 'A', 'm2/s2', 'TKE at surface within UNICON') + call addfld('went_SP', horiz_only, 'A', 'm/s', 'Entrainment rate at the PBL top interface from UW PBL') + call addfld('went_eff_SP', horiz_only, 'A', 'm/s', 'Effective entrainment rate at the PBL top interface in UNICON') + + call addfld('am_u_SP', (/ 'lev' /), 'A', '1', 'Convective updraft fractional area at mid-layer') + call addfld('am_d_SP', (/ 'lev' /), 'A', '1', 'Convective downdraft fractional area at mid-layer') + + call addfld('qlm_u_SP', (/ 'lev' /), 'A', 'kg/kg', 'Area-weighted in-cumulus LWC condensate of updraft at mid-layer') + call addfld('qlm_d_SP', (/ 'lev' /), 'A', 'kg/kg', 'Area-weighted in-cumulus IWC condensate of downdraft at mid-layer') + + call addfld('qim_u_SP', (/ 'lev' /), 'A', 'kg/kg', 'Area-weighted in-cumulus LWC condensate of updraft at mid-layer') + call addfld('qim_d_SP', (/ 'lev' /), 'A', 'kg/kg', 'Area-weighted in-cumulus IWC condensate of downdraft at mid-layer') + + call addfld('thl_u_SP', (/ 'ilev' /), 'A', 'K', 'Mass-flux weighted updraft mean thl') + call addfld('qt_u_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted updraft mean qt') + call addfld('u_u_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted updraft mean u') + call addfld('v_u_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted updraft mean v') + call addfld('w_u_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted updraft mean w') + call addfld('ql_u_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted updraft mean ql') + call addfld('qi_u_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted updraft mean qi') + call addfld('wa_u_SP', (/ 'ilev' /), 'A', 'm/s', 'Area weighted updraft mean w') + call addfld('qla_u_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Area weighted updraft mean ql') + call addfld('qia_u_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Area weighted updraft mean qi') + call addfld('a_u_SP', (/ 'ilev' /), 'A', '1', 'Convective updraft fractional area') + call addfld('rad_u_SP', (/ 'ilev' /), 'A', 'm', 'Number-weighted effective radius of updraft plumes') + call addfld('num_u_SP', (/ 'ilev' /), 'A', '1/m^2', 'Number concentration of updraft plumes') + call addfld('gamw_u_SP', (/ 'ilev' /), 'A', 'ratio', 'The ratio of w_u to wa_u') + call addfld('nl_u_SP', (/ 'ilev' /), 'A', '1/kg', 'Mass-flux weighted updraft mean nl') + call addfld('ni_u_SP', (/ 'ilev' /), 'A', '1/kg', 'Mass-flux weighted updraft mean ni') + call addfld('thva_u_SP', (/ 'ilev' /), 'A', 'K', 'Area weighted updraft mean thv') + + call addfld('thl_d_SP', (/ 'ilev' /), 'A', 'K', 'Mass-flux weighted downdraft mean thl') + call addfld('qt_d_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted downdraft mean qt') + call addfld('u_d_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted downdraft mean u') + call addfld('v_d_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted downdraft mean v') + call addfld('w_d_SP', (/ 'ilev' /), 'A', 'm/s', 'Mass-flux weighted downdraft mean w') + call addfld('ql_d_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted downdraft mean ql') + call addfld('qi_d_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Mass-flux weighted downdraft mean qi') + call addfld('wa_d_SP' , (/ 'ilev' /), 'A', 'm/s', 'Area weighted downdraft mean w') + call addfld('qla_d_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Area weighted downdraft mean ql') + call addfld('qia_d_SP', (/ 'ilev' /), 'A', 'kg/kg', 'Area weighted downdraft mean qi') + call addfld('a_d_SP', (/ 'ilev' /), 'A', '1', 'Convective downdraft fractional area') + call addfld('nl_d_SP', (/ 'ilev' /), 'A', '1/kg', 'Mass-flux weighted downdraft mean nl') + call addfld('ni_d_SP', (/ 'ilev' /), 'A', '1/kg', 'Mass-flux weighted downdraft mean ni') + + call addfld('thv_b_SP', (/ 'ilev' /), 'A', 'K', 'thv_b : Environmental buoyancy at the base interface') + call addfld('thv_t_SP', (/ 'ilev' /), 'A', 'K', 'thv_t : Environmental buoyancy at the top interface') + call addfld('thv_mt_SP', (/ 'ilev' /), 'A', 'K', 'thv_mt : Environmental buoyancy at the top interface of lower layer') + call addfld('thv_min_SP', (/ 'ilev' /), 'A', 'K', 'thv_min : Minimum environmental buoyancy for downdraft sorting') + + !a call addfld('CFL_SP', (/ 'lev' /), 'A', '1', 'Numerical stability parameter of UNICON') + + call addfld('cu_cmfr_SP', (/ 'lev' /), 'A', 'kg/m2/s', 'Mass flux of mixing environmental airs') + call addfld('cu_thlr_SP', (/ 'lev' /), 'A', 'K', 'thl of mixing environmental airs') + call addfld('cu_qtr_SP', (/ 'lev' /), 'A', 'kg/kg', 'qt of mixing environmental airs') + call addfld('cu_qlr_SP', (/ 'lev' /), 'A', 'kg/kg', 'ql of mixing environmental airs') + call addfld('cu_qir_SP', (/ 'lev' /), 'A', 'kg/kg', 'qi of mixing environmental airs') + call addfld('cu_ur_SP', (/ 'lev' /), 'A', 'm/s', 'u of mixing environmental airs') + call addfld('cu_vr_SP', (/ 'lev' /), 'A', 'm/s', 'v of mixing environmental airs') + call addfld('cu_thvr_SP', (/ 'lev' /), 'A', 'K', 'thv of mixing environmental airs') + call addfld('cu_rhr_SP', (/ 'lev' /), 'A', '1', 'rh of mixing environmental airs') + call addfld('cu_nlr_SP', (/ 'lev' /), 'A', '1/kg', 'nl of mixing environmental airs') + call addfld('cu_nir_SP', (/ 'lev' /), 'A', '1/kg', 'ni of mixing environmental airs') + + call addfld('a_p_SP', (/ 'ilev' /), 'A', '1', 'Convective precipitation area') + call addfld('am_evp_SP', (/ 'lev' /), 'A', '1', 'Convective evaporation area') + call addfld('am_pu_SP', (/ 'lev' /), 'A', '1', 'Overlapping area between conv precipitation and sat updraft area') + call addfld('x_um_SP', (/ 'lev' /), 'A', 'm', 'Zonal displacement of the updraft area from the surface') + call addfld('y_um_SP', (/ 'lev' /), 'A', 'm', 'Meridional displacement of the updraft area from the surface') + call addfld('x_p_SP', (/ 'ilev' /), 'A', 'm', 'Zonal displacement of the precipitation area from the surface') + call addfld('y_p_SP', (/ 'ilev' /), 'A', 'm', 'Meridional displacement of the precipitation area from the surface') + + do l = 1, pcnst + + if (cnst_is_mam_num(l) .or. cnst_is_mam_mmr(l)) then + + units = '1/kg/s' + if (cnst_is_mam_mmr(l)) units = 'kg/kg/s' + + varname = trim(cnst_name(l))//'_u_SP' + surname = trim(cnst_name(l))//' tendency by convective updraft from UNICON' + call addfld(trim(varname), (/ 'lev' /), 'A', units, trim(surname)) + + varname = trim(cnst_name(l))//'_d_SP' + surname = trim(cnst_name(l))//' tendency by convective downdraft from UNICON' + call addfld(trim(varname), (/ 'lev' /), 'A', units, trim(surname)) + + varname = trim(cnst_name(l))//'_evp_SP' + surname = trim(cnst_name(l))//' tendency by evap. of precip in env. from UNICON' + call addfld(trim(varname), (/ 'lev' /), 'A', units, trim(surname)) + + varname = trim(cnst_name(l))//'_dis_SP' + surname = trim(cnst_name(l))//' tendency by dissipative heating from UNICON' + call addfld(trim(varname), (/ 'lev' /), 'A', units, trim(surname)) + + varname = trim(cnst_name(l))//'_pos_SP' + surname = trim(cnst_name(l))//' tendency by positive moisture from UNICON' + call addfld(trim(varname), (/ 'lev' /), 'A', units, trim(surname)) + + end if + end do + + + ! Nov.15.2012. Below output corresponding to individual updraft segment is designed to write out individual + ! segment values for writing UNICON_II paper. + + do msfc = 1, nseg + write(numcha,'(i2.2)') msfc + + ! The properties of individual updraft segment + + call addfld('thl_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'K', numcha//' updraft segment : updraft thl' ) + call addfld('qt_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/kg', numcha//' updraft segment : updraft qt' ) + call addfld('u_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'm/s', numcha//' updraft segment : updraft u' ) + call addfld('v_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'm/s', numcha//' updraft segment : updraft v' ) + call addfld('w_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'm/s', numcha//' updraft segment : updraft w' ) + call addfld('ql_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/kg', numcha//' updraft segment : updraft ql' ) + call addfld('qi_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/kg', numcha//' updraft segment : updraft qi' ) + call addfld('cmf_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/s/m^2', numcha//' updraft segment : updraft cmf' ) + call addfld('a_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft fractional area') + call addfld('num_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1/m^2', numcha//' updraft segment : updraft number density' ) + call addfld('rad_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'm', numcha//' updraft segment : updraft plume radius' ) + call addfld('nl_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1/kg', numcha//' updraft segment : updraft nl' ) + call addfld('ni_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1/kg', numcha//' updraft segment : updraft ni' ) + + call addfld('eps0_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1/Pa', numcha//' updraft segment : updraft eps0' ) + call addfld('eps_u'//numcha//'_SP' , (/ 'ilev' /), 'A', '1/Pa', numcha//' updraft segment : updraft eps' ) + call addfld('del_u'//numcha//'_SP' , (/ 'ilev' /), 'A', '1/Pa', numcha//' updraft segment : updraft del' ) + call addfld('eeps_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft eeps' ) + call addfld('ddel_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft ddel' ) + call addfld('xc_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft xc' ) + call addfld('xs_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft xs' ) + call addfld('xemin_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft xemin' ) + call addfld('xemax_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft xemax' ) + call addfld('cridis_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'm', numcha//' updraft segment : updraft cridis' ) + call addfld('thvcuenv_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'K', numcha//' updraft segment : updraft thvcuenv') + call addfld('thvegenv_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'K', numcha//' updraft segment : updraft thvegenv') + call addfld('thvxsenv_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'K', numcha//' updraft segment : updraft thvxsenv') + call addfld('fmix_u'//numcha//'_SP', (/ 'ilev' /), 'A', '1', numcha//' updraft segment : updraft fmix' ) + call addfld('cmfumix_u'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/s/m^2', numcha//' updraft segment : updraft cmfumix' ) + + ! call addfld('ktop'//numcha//'_SP', horiz_only, 'A', '1', numcha//' updraft segment : top layer index') + call addfld('ptop'//numcha//'_SP', horiz_only, 'A', 'Pa', numcha//' updraft segment : updraft top pressure') + call addfld('ztop'//numcha//'_SP', horiz_only, 'A', 'm', numcha//' updraft segment : updraft top height') + + ! The properties of mass flux weighted ( or area-weighted or net=sum ) downdraft properties for individual updraft segment + + call addfld('thl_d'//numcha//'_SP', (/ 'ilev' /), 'A', 'K',& + 'Mass-flux weighted mean downdraft thl for '// numcha//' updraft segment') + call addfld('qt_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'kg/kg',& + 'Mass-flux weighted mean downdraft qt for '// numcha//' updraft segment') + call addfld('u_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'm/s',& + 'Mass-flux weighted mean downdraft u for '// numcha//' updraft segment') + call addfld('v_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'm/s',& + 'Mass-flux weighted mean downdraft v for '// numcha//' updraft segment') + call addfld('w_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'm/s',& + 'Mass-flux weighted mean downdraft w for '// numcha//' updraft segment') + call addfld('ql_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'kg/kg',& + 'Mass-flux weighted mean downdraft ql for '// numcha//' updraft segment') + call addfld('qi_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'kg/kg',& + 'Mass-flux weighted mean downdraft qi for '// numcha//' updraft segment') + call addfld('wa_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'm/s',& + 'Area weighted mean downdraft w for '// numcha//' updraft segment') + call addfld('qla_d'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/kg',& + 'Area weighted mean downdraft ql for '// numcha//' updraft segment') + call addfld('qia_d'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/kg',& + 'Area weighted mean downdraft qi for '// numcha//' updraft segment') + call addfld('cmf_d'//numcha//'_SP', (/ 'ilev' /), 'A', 'kg/s/m^2',& + 'Net downdraft cmf for '// numcha//' updraft segment') + call addfld('a_d'//numcha//'_SP' , (/ 'ilev' /), 'A', 'fraction',& + 'Net downdraft a for '// numcha//' updraft segment') + call addfld('nl_d'//numcha//'_SP' , (/ 'ilev' /), 'A', '#/kg',& + 'Mass-flux weighted mean downdraft nl for '// numcha//' updraft segment') + call addfld('ni_d'//numcha//'_SP' , (/ 'ilev' /), 'A', '#/kg',& + 'Mass-flux weighted mean downdraft ni for '// numcha//' updraft segment') + + enddo + + ! Nov.16.2012. Additional detailed diagnostic output + + call addfld('thl_orgfce_SP', horiz_only, 'A', 'K/s', & + 'Total organization forcing generating thl difference between non-wake and grid-mean areas') + call addfld('qt_orgfce_SP', horiz_only, 'A', 'kg/kg/s', & + 'Total organization forcing generating qt difference between non-wake and grid-mean areas') + call addfld('u_orgfce_SP', horiz_only, 'A', 'm/s/s', & + 'Total organization forcing generating u difference between non-wake and grid-mean areas') + call addfld('v_orgfce_SP', horiz_only, 'A', 'm/s/s', & + 'Total organization forcing generating v difference between non-wake and grid-mean areas') + call addfld('awk_orgfce_SP', horiz_only, 'A', '1/s', & + 'Total organization forcing generating wake area') + + call addfld('thl_orgfce_f_SP', horiz_only, 'A', 'K/s', & + 'PBL top flux-related forcing generating thl difference between non-wake and grid-mean areas') + call addfld('qt_orgfce_f_SP', horiz_only, 'A', 'kg/kg/s', & + 'PBL top flux-related forcing generating qt difference between non-wake and grid-mean areas') + call addfld('u_orgfce_f_SP', horiz_only, 'A', 'm/s/s', & + 'PBL top flux-related forcing generating u difference between non-wake and grid-mean areas') + call addfld('v_orgfce_f_SP', horiz_only, 'A', 'm/s/s', & + 'PBL top flux-related forcing generating v difference between non-wake and grid-mean areas') + call addfld('awk_orgfce_f_SP', horiz_only, 'A', '1/s', & + 'PBL top flux-related forcing generating wake area') + + call addfld('thl_orgfce_u_SP', horiz_only, 'A', 'K/s', & + 'Up-and-Down diabatic forcing generating thl difference between non-wake and grid-mean areas') + call addfld('qt_orgfce_u_SP', horiz_only, 'A', 'kg/kg/s', & + 'Up-and-Down diabatic forcing generating qt difference between non-wake and grid-mean areas') + call addfld('u_orgfce_u_SP', horiz_only, 'A', 'm/s/s', & + 'Up-and-Down diabatic forcing generating u difference between non-wake and grid-mean areas') + call addfld('v_orgfce_u_SP', horiz_only, 'A', 'm/s/s', & + 'Up-and-Down diabatic forcing generating v difference between non-wake and grid-mean areas') + call addfld('awk_orgfce_m_SP', horiz_only, 'A', '1/s', & + 'Lateral-Mixing forcing for wake area') + + call addfld('thl_orgfce_e_SP', horiz_only, 'A', 'K/s', & + 'Environment diabatic forcing generating thl difference between non-wake and grid-mean areas') + call addfld('qt_orgfce_e_SP', horiz_only, 'A', 'kg/kg/s', & + 'Environment diabatic forcing generating qt difference between non-wake and grid-mean areas') + call addfld('u_orgfce_e_SP', horiz_only, 'A', 'm/s/s', & + 'Environment diabatic forcing generating u difference between non-wake and grid-mean areas') + call addfld('v_orgfce_e_SP', horiz_only, 'A', 'm/s/s', & + 'Environment diabatic forcing generating v difference between non-wake and grid-mean areas') + call addfld('cmf_d_orgh_SP', horiz_only, 'A', 'kg/m^2/s', & + 'Organization-inducing downdraft mass flux at the PBL top interface') + + call addfld('taui_thl_SP', horiz_only, 'A', '1/s', & + 'Inverse of damping time scale of the difference between off-wake and grid-mean thl') + call addfld('taui_qt_SP', horiz_only, 'A', '1/s', & + 'Inverse of damping time scale of the difference between off-wake and grid-mean qt') + call addfld('taui_u_SP', horiz_only, 'A', '1/s', & + 'Inverse of damping time scale of the difference between off-wake and grid-mean u') + call addfld('taui_v_SP', horiz_only, 'A', '1/s', & + 'Inverse of damping time scale of the difference between off-wake and grid-mean v') + call addfld('taui_awk_SP', horiz_only, 'A', '1/s', & + 'Inverse of damping time scale of the wake area') + + call addfld('del_org_SP', horiz_only, 'A', '1/s', & + 'Detrainment rate of the cold pool from UNICON') + call addfld('del0_org_SP', horiz_only, 'A', '1/s', & + 'Effective detrainment rate of the cold pool from UNICON') + +#endif + +end subroutine unicon_cam_init + +!================================================================================================== + +function unicon_implements_cnst(name) + + ! Return true if specified constituent is implemented by this package + + character(len=*), intent(in) :: name ! constituent name + logical :: unicon_implements_cnst ! return value + + integer :: m + !----------------------------------------------------------------------- + + unicon_implements_cnst = .false. + +#ifdef USE_UNICON + + do m = 1, n_org + if (name == cnst_names(m)) then + unicon_implements_cnst = .true. + return + end if + end do + +#endif + +end function unicon_implements_cnst + +!================================================================================================== + +subroutine unicon_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize constituents if they are not read from the initial file + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + integer :: k + +#ifdef USE_UNICON + + do k = 1, size(q, 2) + if ( name == 'ORGawk' ) then + where(mask) + q(:,k) = 0.0_r8 + end where + else if ( name == 'ORGthl' ) then + where(mask) + q(:,k) = 100.0_r8 + end where + else if ( name == 'ORGqto' ) then + where(mask) + q(:,k) = 100.0_r8 + end where + else if ( name == 'ORGuoo' ) then + where(mask) + q(:,k) = 100.0_r8 + end where + else if ( name == 'ORGvoo' ) then + where(mask) + q(:,k) = 100.0_r8 + end where + end if + end do + +#endif + +end subroutine unicon_init_cnst + +!================================================================================================== + +subroutine unicon_cam_tend(dt, state, cam_in, & + pbuf, ptend, out) + + + ! ---------------------- ! + ! Input-output Arguments ! + ! ---------------------- ! + + real(r8), intent(in) :: dt ! Time step [s] + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in ! import state + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + type(physics_ptend), intent(out) :: ptend ! parameterization tendencies + type(unicon_out_t), intent(out) :: out ! parameterization outputs + + ! -------------------------------------------------------- ! + ! Internal output and local variables for positive tracers ! + ! -------------------------------------------------------- ! + + real(r8) :: sten_ori(mix,mkx) ! Tendency of dry static energy [ J / kg / s ] + real(r8) :: qvten_ori(mix,mkx) ! Tendency of water vapor specific humidity [ kg / kg / s ] + real(r8) :: qlten_ori(mix,mkx) ! Tendency of liquid water mixing ratio [ kg / kg / s ] + real(r8) :: qiten_ori(mix,mkx) ! Tendency of ice mixing ratio [ kg / kg / s ] + real(r8) :: trten_ori(mix,mkx,ncnst) ! Tendency of tracers [ # / kg / s, kg / kg / s ] + + real(r8) :: slten_pos_inv(mix,mkx) ! + real(r8) :: qtten_pos_inv(mix,mkx) ! + real(r8) :: uten_pos_inv(mix,mkx) ! + real(r8) :: vten_pos_inv(mix,mkx) ! + real(r8) :: sten_pos_inv(mix,mkx) ! + real(r8) :: qvten_pos_inv(mix,mkx) ! + real(r8) :: qlten_pos_inv(mix,mkx) ! + real(r8) :: qiten_pos_inv(mix,mkx) ! + real(r8) :: trten_pos_inv(mix,mkx,ncnst) + + ! --------------- ! + ! Local variables ! + ! --------------- ! + + integer :: iend + integer :: lchnk + integer :: itim + + ! fields in physics buffer + real(r8), pointer, dimension(:) :: & ! (mix) + sgh30 ! Standard deviation of topography at 30s [m] + + real(r8), pointer, dimension(:,:) :: & ! (mix,mkx) + ast0_inv ! Physical stratus fraction [ fraction ] + + real(r8), pointer, dimension(:,:) :: & ! (mix,mkx+1) + tke0_inv, &! TKE at the interface [ m2/s2 ] + bprod0_inv ! Buoyancy production at the interface [ m2/s3 ] + + integer(i4), pointer, dimension(:) :: & ! (mix) + kpblh_inv ! Layer index with PBL top in it or at the base interface + + real(r8), pointer, dimension(:) :: & ! (mix) + pblh, &! PBL top height [m] + went, &! Entrainment rate at the PBL top interface directly from UW PBL scheme [ m / s ]. went = 0 for STL. + cush, &! Cumulus top height [ m ] + cushavg, &! Mean cumulus top height weighted by updraft mass flux at surface [ m ] + cuorg, &! Convective organization parameter [ 0-1 ] + + awk_PBL, &! Wake area within PBL [ 0 - 1 ] + delta_thl_PBL, &! Diff of thl between off-wake region and grid-mean value averaged over the PBL [ K ] + delta_qt_PBL, &! Diff of qt between off-wake region and grid-mean value averaged over the PBL [ kg/kg ] + delta_u_PBL, &! Diff of u between off-wake region and grid-mean value averaged over the PBL [ m/s ] + delta_v_PBL ! Diff of v between off-wake region and grid-mean value averaged over the PBL [ m/s ] + + real(r8), pointer, dimension(:,:) :: & ! (mix,ncnst) + delta_tr_PBL ! Diff of tr between off-wake region and grid-mean value avg over the PBL [ kg/kg, #/kg ] + + real(r8), dimension(mix,mkx) :: & ! (mix,mkx) + cu_cmfum ! The mass involved in the updraft buoyancy sorting at the previous time step [ kg/s/m2 ] + + real(r8), pointer, dimension(:,:) :: & ! (mix,mkx) + cu_cmfr, &! The detrained mass from convective up and downdraft at the previous time step [ kg/s/m2 ] + cu_thlr, &! Mass-flux wghted mean 'thl' of detrained mass from conv up and downdraft at prev step [ K ] + cu_qtr, &! Mass-flux wghted mean 'qt' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + cu_ur, &! Mass-flux wghted mean 'u' of detrained mass from conv up and downdraft at prev step [ m/s ] + cu_vr, &! Mass-flux wghted mean 'v' of detrained mass from conv up and downdraft at prev step [ m/s ] + cu_qlr, &! Mass-flux wghted mean 'ql' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + cu_qir, &! Mass-flux wghted mean 'qi' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + cmfr_det,&! The detrained mass from convective up and downdraft at the previous time step [ kg/s/m2 ] + qlr_det, &! Mass-flux wghted mean 'ql' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + qir_det ! Mass-flux wghted mean 'qi' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + + real(r8), pointer, dimension(:,:,:) :: & ! (mix,mkx,ncnst) + cu_trr ! Mass-flux wghted mean 'tr' of detrained mass from conv up and downdraft at prev step [ kg/kg ] + + real(r8), dimension(mix,mkx) :: & ! (mix,mkx) + cu_cmfrd,&! The amount of detrained mass from convective downdraft at the previous time step [ kg/s/m2 ] + cu_thlrd,&! Mass-flux wghted mean 'thl' of detrained mass from conv downdraft at prev step [ K ] + cu_qtrd, &! Mass-flux wghted mean 'qt' of detrained mass from conv downdraft at prev step [ kg/kg ] + cu_urd, &! Mass-flux wghted mean 'u' of detrained mass from conv downdraft at prev step [ m/s ] + cu_vrd, &! Mass-flux wghted mean 'v' of detrained mass from conv downdraft at prev step [ m/s ] + cu_qlrd, &! Mass-flux wghted mean 'ql' of detrained mass from conv downdraft at prev step [ kg/kg ] + cu_qird ! Mass-flux wghted mean 'qi' of detrained mass from conv downdraft at prev step [ kg/kg ] + + real(r8), dimension(mix,mkx,ncnst) :: & ! (mix,mkx,ncnst) + cu_trrd ! Mass-flux wghted mean 'tr' of detrained mass from conv downdraft at prev step [ kg/kg ] + + real(r8), pointer, dimension(:,:) :: & ! (mix,mkx) + shfrc, &! Convective updraft fractional area + icwmrsh, &! In-cloud LWC+IWC within convective updraft + rprdsh, &! Prod of rain+snow by lateral expels of cumulus condensate [ kg / kg / s ] + evapc_inv, &! Evaporation rate of convective precipitation within environment [ kg/kg/s ] + am_evp_st_inv, &! Evaporation area of stratiform precipitation [fraction] + evprain_st_inv, &! Grid-mean evaporation rate of stratiform rain [kg/kg/s] >= 0. + evpsnow_st_inv ! Grid-mean evaporation rate of stratiform snow [kg/kg/s] >= 0. + + real(r8), pointer, dimension(:) :: & ! (mix) + precip, &! Precipitation flux at surface in flux unit [ m / s ] + snow ! Snow flux at surface in flux unit [ m / s ] + + real(r8) :: ps0(mix,0:mkx) ! Environmental pressure at full sigma levels + real(r8) :: zs0(mix,0:mkx) ! Environmental height at full sigma levels + real(r8) :: p0(mix,mkx) ! Environmental pressure at half sigma levels + real(r8) :: z0(mix,mkx) ! Environmental height at half sigma levels + real(r8) :: dp0(mix,mkx) ! Environmental layer pressure thickness + real(r8) :: dpdry0(mix,mkx) ! Environmental layer dry pressure thickness + real(r8) :: u0(mix,mkx) ! Environmental zonal wind + real(r8) :: v0(mix,mkx) ! Environmental meridional wind + real(r8) :: qv0(mix,mkx) ! Environmental specific humidity + real(r8) :: ql0(mix,mkx) ! Environmental liquid water mixing ratio + real(r8) :: qi0(mix,mkx) ! Environmental ice mixing ratio + real(r8) :: tr0(mix,mkx,ncnst) ! Environmental tracers [ #/kg, kg/kg ] + real(r8) :: t0(mix,mkx) ! Environmental temperature + real(r8) :: s0(mix,mkx) ! Environmental dry static energy + real(r8) :: ast0(mix,mkx) ! Physical stratiform cloud fraction [ fraction ] + real(r8) :: tke0(mix,0:mkx) ! TKE [ m2/s2 ] + real(r8) :: bprod0(mix,0:mkx) ! Buoyancy production [ m2/s3 ] + real(r8) :: am_evp_st(mix,mkx) ! Evaporation area of stratiform precipitation [fraction] + real(r8) :: evprain_st(mix,mkx) ! Grid-mean evaporation rate of stratiform rain [kg/kg/s] >= 0. + real(r8) :: evpsnow_st(mix,mkx) ! Grid-mean evaporation rate of stratiform snow [kg/kg/s] >= 0. + + integer(i4) :: kpblh(mix) ! Layer index with PBL top in it or at the base interface + + + real(r8) :: am_u(mix,mkx) ! Convective updraft fractional area + real(r8) :: qlm_u(mix,mkx) ! In-cloud LWC within convective updraft [ kg / kg ] + real(r8) :: qim_u(mix,mkx) ! In-cloud IWC within convective updraft [ kg / kg ] + + real(r8) :: am_d(mix,mkx) ! Convective downdraft fractional area + real(r8) :: qlm_d(mix,mkx) ! In-cloud LWC within downdraft updraft [ kg / kg ] + real(r8) :: qim_d(mix,mkx) ! In-cloud IWC within downdraft updraft [ kg / kg ] + + real(r8) :: cmf_u(mix,0:mkx) ! Upward convective mass flux at the interface [ kg / s / m2 ] + real(r8) :: slflx(mix,0:mkx) ! Net upward convective flux of liquid static energy [ J / s / m2 ] + real(r8) :: qtflx(mix,0:mkx) ! Net upward convective flux of total specific humidity [ kg / s / m2 ] + + real(r8) :: qvten(mix,mkx) ! Tendency of water vapor specific humidity [ kg / kg / s ] + real(r8) :: qlten(mix,mkx) ! Tendency of liquid water mixing ratio [ kg / kg / s ] + real(r8) :: qiten(mix,mkx) ! Tendency of ice mixing ratio [ kg / kg / s ] + real(r8) :: trten(mix,mkx,ncnst) ! Tendency of tracers [ # / kg / s, kg / kg / s ] + + real(r8) :: sten(mix,mkx) ! Tendency of dry static energy [ J / kg / s ] + real(r8) :: uten(mix,mkx) ! Tendency of zonal wind [ m / s / s ] + real(r8) :: vten(mix,mkx) ! Tendency of meridional wind [ m / s / s ] + + real(r8) :: qrten(mix,mkx) ! Production rate of rain by lateral expels of cumulus condensate [ kg / kg / s ] + real(r8) :: qsten(mix,mkx) ! Production rate of snow by lateral expels of cumulus condensate [ kg / kg / s ] + + real(r8) :: evapc(mix,mkx) ! Evaporation rate of convective precipitation within environment [ kg/kg/s ] + + real(r8) :: rqc(mix,mkx) ! Production rate of detrained LWC+IWC [ kg / kg / s ] > 0 + real(r8) :: rqc_l(mix,mkx) ! Production rate of detrained LWC [ kg / kg / s ] > 0 + real(r8) :: rqc_i(mix,mkx) ! Production rate of detrained IWC [ kg / kg / s ] > 0 + real(r8) :: rnc_l(mix,mkx) ! Production rate of detrained droplet number of cloud liquid droplets [ # / kg / s ] > 0 + real(r8) :: rnc_i(mix,mkx) ! Production rate of detrained droplet number of cloud ice droplets [ # / kg / s ] > 0 + + real(r8) :: cnt(mix) ! Cloud top interface index ( ki = kpen ) + real(r8) :: cnb(mix) ! Cloud base interface index ( ki = krel-1 ) + + real(r8) :: pdel0(mix,mkx) ! Environmental pressure thickness ( either dry or moist ) [ Pa ] + real(r8) :: trmin ! Minimum concentration of tracer [ # / kg ] + + real(r8) :: cmf_det(mix,mkx) ! Det mass flux from convective updraft (not from environment) and downdraft [kg/s/m^2] + real(r8) :: ql_det(mix,mkx) ! Det conv LWC from convective updraft (not from environment) and downdraft [kg/s/m^2] + real(r8) :: qi_det(mix,mkx) ! Det conv IWC from convective updraft (not from environment) and downdraft [kg/s/m^2] + + ! For prognostically updated state variables + + real(r8) :: qv0_c(mix,mkx) ! Environmental specific humidity + real(r8) :: ql0_c(mix,mkx) ! Environmental liquid water mixing ratio + real(r8) :: qi0_c(mix,mkx) ! Environmental ice mixing ratio + real(r8) :: t0_c(mix,mkx) ! Environmental temperature + real(r8) :: s0_c(mix,mkx) ! Environmental dry static energy + real(r8) :: tr0_c(mix,mkx,ncnst) ! Environmental tracers [ # / kg, kg / kg ] + + ! Layer index variables + integer :: k ! Vertical index for local fields + integer :: k_inv ! Vertical index for incoming fields + integer :: mt ! Tracer index [ no ] + integer :: m + + ! For aerosol tendency output + character(len=30) :: varname + + logical :: lq(ncnst) + + ! --------- ! + ! Main body ! + ! --------- ! + +#ifdef USE_UNICON + + iend = state%ncol + lchnk = state%lchnk + + ! Associate pointers with physics buffer fields + + itim = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, sgh30_idx, sgh30) + call pbuf_get_field(pbuf, ast_idx, ast0_inv, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, tke_idx, tke0_inv) + call pbuf_get_field(pbuf, bprod_idx, bprod0_inv) + call pbuf_get_field(pbuf, kpblh_idx, kpblh_inv) + call pbuf_get_field(pbuf, pblh_idx, pblh) + call pbuf_get_field(pbuf, went_idx, went) + call pbuf_get_field(pbuf, cush_idx, cush, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, cushavg_idx, cushavg, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, cuorg_idx, cuorg, start=(/1,itim/), kount=(/pcols,1/)) + + call pbuf_get_field(pbuf, awk_PBL_idx, awk_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_thl_PBL_idx, delta_thl_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_qt_PBL_idx, delta_qt_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_u_PBL_idx, delta_u_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_v_PBL_idx, delta_v_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_tr_PBL_idx, delta_tr_PBL, start=(/1,1,itim/), kount=(/pcols,pcnst,1/)) + + call pbuf_get_field(pbuf, cu_cmfr_idx, cu_cmfr, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_thlr_idx, cu_thlr, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_qtr_idx, cu_qtr, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_ur_idx, cu_ur, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_vr_idx, cu_vr, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_qlr_idx, cu_qlr, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_qir_idx, cu_qir, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cu_trr_idx, cu_trr, start=(/1,1,1,itim/), kount=(/pcols,pver,pcnst,1/)) + + call pbuf_get_field(pbuf, shfrc_idx, shfrc) + call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh) + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh) + call pbuf_get_field(pbuf, prec_sh_idx, precip) + call pbuf_get_field(pbuf, snow_sh_idx, snow) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapc_inv) + call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_inv) + call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_inv) + call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_inv) + + call pbuf_get_field(pbuf, cmfr_det_idx, cmfr_det) + call pbuf_get_field(pbuf, qlr_det_idx, qlr_det) + call pbuf_get_field(pbuf, qir_det_idx, qir_det) + + ! Reverse variables defined at the layer mid-point + + do k = 1, mkx + k_inv = mkx + 1 - k + p0(:iend,k) = state%pmid(:iend,k_inv) + u0(:iend,k) = state%u(:iend,k_inv) + v0(:iend,k) = state%v(:iend,k_inv) + z0(:iend,k) = state%zm(:iend,k_inv) + dp0(:iend,k) = state%pdel(:iend,k_inv) + dpdry0(:iend,k) = state%pdeldry(:iend,k_inv) + qv0(:iend,k) = state%q(:iend,k_inv,1) + ql0(:iend,k) = state%q(:iend,k_inv,ixcldliq) + qi0(:iend,k) = state%q(:iend,k_inv,ixcldice) + t0(:iend,k) = state%t(:iend,k_inv) + s0(:iend,k) = state%s(:iend,k_inv) + ast0(:iend,k) = ast0_inv(:iend,k_inv) + am_evp_st(:iend,k) = am_evp_st_inv(:iend,k_inv) + evprain_st(:iend,k) = evprain_st_inv(:iend,k_inv) + evpsnow_st(:iend,k) = evpsnow_st_inv(:iend,k_inv) + do mt = 1, ncnst + tr0(:iend,k,mt) = state%q(:iend,k_inv,mt) + end do + end do + + ! Reverse variables defined at the interfaces + + do k = 0, mkx + k_inv = mkx + 1 - k + ps0(:iend,k) = state%pint(:iend,k_inv) + zs0(:iend,k) = state%zi(:iend,k_inv) + tke0(:iend,k) = tke0_inv(:iend,k_inv) + bprod0(:iend,k) = bprod0_inv(:iend,k_inv) + end do + + ! Reverse the index of ambiguous layer + + kpblh(:iend) = mkx + 1 - kpblh_inv(:iend) + + + call compute_unicon( mix , mkx , iend , ncnst , dt , & + ps0 , zs0 , p0 , z0 , dp0 , dpdry0 , & + t0 , qv0 , ql0 , qi0 , tr0 , & + u0 , v0 , ast0 , tke0 , bprod0 , & + kpblh , pblh , went , & + cam_in%cflx(:,1), cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx , & + cam_in%landfrac, sgh30 , & + am_evp_st , evprain_st , evpsnow_st, & + cush , cushavg , cuorg , & + awk_PBL , delta_thl_PBL , delta_qt_PBL , & + delta_u_PBL , delta_v_PBL , delta_tr_PBL , & + cu_cmfum , cu_cmfr , cu_thlr , cu_qtr , cu_ur , cu_vr , & + cu_qlr , cu_qir , cu_trr , & + cu_cmfrd , cu_thlrd , cu_qtrd , cu_urd , cu_vrd , & + cu_qlrd , cu_qird , cu_trrd , & + am_u , qlm_u , qim_u , & + am_d , qlm_d , qim_d , & + cmf_u , slflx , qtflx , & + qvten , qlten , qiten , trten , & + sten , uten , vten , & + qrten , qsten , & + rqc_l , rqc_i , rqc , rnc_l , rnc_i , & + out%rliq , precip , snow , evapc , & + cnt , cnb , cmf_det , ql_det , qi_det , & + lchnk ) + + + ! Initialize output ptend + lq(:) = .true. + call physics_ptend_init(ptend, state%psetcols, 'unicon', ls=.true., lu=.true., lv=.true., lq=lq) + + ! ----------------------------------------------------- ! + ! Treatment of reserved liquid-ice water for CAM ! + ! All the reserved condensate is converted into liquid. ! + ! Jan.04.2012. Relocated from below to here to prevent ! + ! energy and water conservation error. ! + ! Also add corresponding tendency of cloud ! + ! droplet number concentration. ! + ! Note that since 'positive_moisture' will convert ! + ! negative 'ql,qi,nl,ni' into positive, below may cause ! + ! larger 'ql,qi' and smaller 'qv' than it should be if ! + ! 'ql0,qi0' further below becomes negative. ! + ! This feature is inevitable at the current stage. ! + ! Note that in future, I can impose consistency between ! + ! positive_moisture and positive_tracer for nl,ni. ! + ! ----------------------------------------------------- ! + + qlten(:iend,:mkx) = qlten(:iend,:mkx) - rqc_l(:iend,:mkx) + qiten(:iend,:mkx) = qiten(:iend,:mkx) - rqc_i(:iend,:mkx) + sten(:iend,:mkx) = sten(:iend,:mkx) - ( xls - xlv ) * rqc_i(:iend,:mkx) + trten(:iend,:mkx,ixnumliq) = trten(:iend,:mkx,ixnumliq) - rnc_l(:iend,:mkx) + trten(:iend,:mkx,ixnumice) = trten(:iend,:mkx,ixnumice) - rnc_i(:iend,:mkx) + + ! --------------------------------------------- ! + ! Prevent negative cloud condensate and tracers ! + ! --------------------------------------------- ! + + qv0_c(:iend,:mkx) = qv0(:iend,:mkx) + qvten(:iend,:mkx)*dt + ql0_c(:iend,:mkx) = ql0(:iend,:mkx) + qlten(:iend,:mkx)*dt + qi0_c(:iend,:mkx) = qi0(:iend,:mkx) + qiten(:iend,:mkx)*dt + t0_c(:iend,:mkx) = t0(:iend,:mkx) + (1._r8/cp)*sten(:iend,:mkx)*dt + s0_c(:iend,:mkx) = s0(:iend,:mkx) + sten(:iend,:mkx)*dt + do mt = 1, ncnst + tr0_c(:iend,:mkx,mt) = tr0(:iend,:mkx,mt) + trten(:iend,:mkx,mt)*dt + enddo + + ! Note : Since 'positive_moisture' will only perform condensation not the evaporation, + ! we don't need to modify corresponding 'nl,ni'. + ! Thus, current version is completely OK. + + sten_ori(:iend,:mkx) = sten(:iend,:mkx) + qvten_ori(:iend,:mkx) = qvten(:iend,:mkx) + qlten_ori(:iend,:mkx) = qlten(:iend,:mkx) + qiten_ori(:iend,:mkx) = qiten(:iend,:mkx) + do mt = 1, ncnst + trten_ori(:iend,:mkx,mt) = trten(:iend,:mkx,mt) + enddo + + call positive_moisture( & + cp, xlv, xls, mix, iend, & + mkx, dt, qmin(1), qmin(ixcldliq), qmin(ixcldice), & + dp0, qv0_c, ql0_c, qi0_c, t0_c, & + s0_c, qvten, qlten, qiten, sten ) + + do mt = 1, ncnst + + if( cnst_get_type_byind(mt) .eq. 'wet' ) then + pdel0(:iend,:mkx) = dp0(:iend,:mkx) + else + pdel0(:iend,:mkx) = dpdry0(:iend,:mkx) + endif + + if (cnst_is_mam_num(mt)) then + trmin = 1.e-5_r8 + else + trmin = qmin(mt) + end if + + call positive_tracer( mix, iend, mkx, dt, trmin, pdel0, tr0_c(:,:,mt), trten(:,:,mt) ) + + enddo + + ! ----------------------------------------------------- ! + ! Treatment of reserved liquid-ice water for CAM ! + ! All the reserved condensate is converted into liquid. ! + ! ----------------------------------------------------- ! + + ! Important : While below treatment looks different from what is being done in the uwshcu.F90, + ! below is actually the same as what is being done in the uwshcu.F90. The process + ! used below is (1) convert detrained ice into liquid, which involves melting cooling, + ! and then (2) subtract this total detrained liquid + ice from the grid-mean qlten. + ! Sep.08.2010. In the new scheme, it will be 'rqc_l = rqc_i = 0'. Thus, below block does nothing. + ! But it is no harm to keep below block. + ! Jan.04.2012. Below block will be used again for many reasons : (1) inctease TGCLDLWP, (2) reduce PREH20, + ! (2) reduce too strong SWCF over the far eastern equatorial Pacific. + ! Currently, below produces conservation error of both energy and water. + ! Jan.04.2012. Conservation errors of energy and moisture dissappears if I locate below block + ! before applying 'positive_moisture'. Thus, I relocated below block above. + + ! qlten(:iend,:mkx) = qlten(:iend,:mkx) + rqc_i(:iend,:mkx) + ! qiten(:iend,:mkx) = qiten(:iend,:mkx) - rqc_i(:iend,:mkx) + ! sten(:iend,:mkx) = sten(:iend,:mkx) - ( xls - xlv ) * rqc_i(:iend,:mkx) + ! qlten(:iend,:mkx) = qlten(:iend,:mkx) - rqc_l(:iend,:mkx) - rqc_i(:iend,:mkx) + ! trten(:iend,:mkx,ixnumliq) = trten(:iend,:mkx,ixnumliq) - rnc_l(:iend,:mkx) + ! trten(:iend,:mkx,ixnumice) = trten(:iend,:mkx,ixnumice) - rnc_i(:iend,:mkx) + + ! --------------------------- ! + ! Reverse vertical coordinate ! + ! --------------------------- ! + + ! Reverse cloud top/base interface indices + + out%cnt(:iend) = real(mkx,r8) + 1._r8 - cnt(:iend) + out%cnb(:iend) = real(mkx,r8) + 1._r8 - cnb(:iend) + + ! Reverse variables defined at the interfaces + + do k = 0, mkx + k_inv = mkx + 1 - k + out%cmfmc(:iend,k_inv) = cmf_u(:iend,k) ! Updraft mass flux at top of layer + out%slflx(:iend,k_inv) = slflx(:iend,k) ! Net liquid static energy flux + out%qtflx(:iend,k_inv) = qtflx(:iend,k) ! Net total water flux + end do + + ! Reverse variables defined at the layer mid-point + + do k = 1, mkx + k_inv = mkx + 1 - k + ptend%q(:iend,k_inv,1) = qvten(:iend,k) ! Convective tendency of specific humidity + ptend%q(:iend,k_inv,ixcldliq) = qlten(:iend,k) ! Convective tendency of liquid water mixing ratio + ptend%q(:iend,k_inv,ixcldice) = qiten(:iend,k) ! Convective tendency of ice mixing ratio + ptend%s(:iend,k_inv) = sten(:iend,k) ! Convective tendency of static energy + ptend%u(:iend,k_inv) = uten(:iend,k) ! Convective tendency of zonal wind + ptend%v(:iend,k_inv) = vten(:iend,k) ! Convective tendency of meridional wind + + out%rqc(:iend,k_inv) = rqc(:iend,k) ! Convective tendency of reserved (suspended) liquid + ice water + + ! These quantities are being put into physics buffer fields that were meant for shallow convection. + ! This should be fixed. + shfrc(:iend,k_inv) = am_u(:iend,k) + icwmrsh(:iend,k_inv) = qlm_u(:iend,k) + qim_u(:iend,k) + rprdsh(:iend,k_inv) = qrten(:iend,k) + qsten(:iend,k) + evapc_inv(:iend,k_inv) = evapc(:iend,k) ! Evaporation rate of convective precipitation within environment + + do mt = 2, ncnst + if (mt /= ixcldliq .and. mt /= ixcldice) then + ptend%q(:iend,k_inv,mt) = trten(:iend,k,mt) + end if + enddo + + ! Additional diagnostic output associated with positive tracer + + sten_pos_inv(:iend,k_inv) = sten(:iend,k) - sten_ori(:iend,k) + qvten_pos_inv(:iend,k_inv) = qvten(:iend,k) - qvten_ori(:iend,k) + qlten_pos_inv(:iend,k_inv) = qlten(:iend,k) - qlten_ori(:iend,k) + qiten_pos_inv(:iend,k_inv) = qiten(:iend,k) - qiten_ori(:iend,k) + qtten_pos_inv(:iend,k_inv) = qvten_pos_inv(:iend,k_inv) + qlten_pos_inv(:iend,k_inv) & + + qiten_pos_inv(:iend,k_inv) + slten_pos_inv(:iend,k_inv) = sten_pos_inv(:iend,k_inv) - xlv * qlten_pos_inv(:iend,k_inv) & + - xls * qiten_pos_inv(:iend,k_inv) + uten_pos_inv(:iend,k_inv) = 0._r8 + vten_pos_inv(:iend,k_inv) = 0._r8 + do mt = 1, ncnst + trten_pos_inv(:iend,k_inv,mt) = trten(:iend,k,mt) - trten_ori(:iend,k,mt) + enddo + + ! Save detrainment variables to pbuf for use in the cloud macrophysics + cmfr_det(:iend,k_inv) = cmf_det(:iend,k) + qlr_det(:iend,k_inv) = ql_det(:iend,k) + qir_det(:iend,k_inv) = qi_det(:iend,k) + + end do + + call outfld('slten_pos_SP' , slten_pos_inv, mix, lchnk) + call outfld('qtten_pos_SP' , qtten_pos_inv, mix, lchnk) + call outfld('uten_pos_SP' , uten_pos_inv, mix, lchnk) + call outfld('vten_pos_SP' , vten_pos_inv, mix, lchnk) + call outfld('sten_pos_SP' , sten_pos_inv, mix, lchnk) + call outfld('qvten_pos_SP' , qvten_pos_inv, mix, lchnk) + call outfld('qlten_pos_SP' , qlten_pos_inv, mix, lchnk) + call outfld('qiten_pos_SP' , qiten_pos_inv, mix, lchnk) + call outfld('nlten_pos_SP' , trten_pos_inv(:,:,ixnumliq), mix, lchnk) + call outfld('niten_pos_SP' , trten_pos_inv(:,:,ixnumice), mix, lchnk) + call outfld('CMFR_DET' , cmfr_det, pcols, lchnk) + call outfld('QLR_DET' , qlr_det, pcols, lchnk) + call outfld('QIR_DET' , qir_det, pcols, lchnk) + + do m = 1, ncnst + if (cnst_is_mam_num(m) .or. cnst_is_mam_mmr(m)) then + varname = trim(cnst_name(m))//'_pos_SP' + call outfld(trim(varname), trten_pos_inv(:,:,m), mix, lchnk) + end if + end do + +#endif + +end subroutine unicon_cam_tend + +subroutine unicon_cam_org_diags(state, pbuf) + + ! ------------------------------------------------------------------------ + ! Insert the organization-related heterogeneities computed inside the + ! UNICON into the tracer arrays here before performing advection. + ! This is necessary to prevent any modifications of organization-related + ! heterogeneities by non convection-advection process, such as + ! dry and wet deposition of aerosols, MAM, etc. + ! Again, note that only UNICON and advection schemes are allowed to + ! changes to organization at this stage, although we can include the + ! effects of other physical processes in future. + ! ------------------------------------------------------------------------ + + ! Arguments + type(physics_state), intent(inout) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables + real(r8), pointer, dimension(: ) :: awk_PBL + real(r8), pointer, dimension(: ) :: delta_thl_PBL + real(r8), pointer, dimension(: ) :: delta_qt_PBL + real(r8), pointer, dimension(: ) :: delta_u_PBL + real(r8), pointer, dimension(: ) :: delta_v_PBL + + integer :: i, itim, ncol + ! ------------------------------------------------------------------------ + +#ifdef USE_UNICON + + ncol = state%ncol + + itim = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, awk_PBL_idx, awk_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_thl_PBL_idx, delta_thl_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_qt_PBL_idx, delta_qt_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_u_PBL_idx, delta_u_PBL, start=(/1,itim/), kount=(/pcols,1/)) + call pbuf_get_field(pbuf, delta_v_PBL_idx, delta_v_PBL, start=(/1,itim/), kount=(/pcols,1/)) + + do i = 1, ncol + + state%q(i,:,awk_cnst_ind) = awk_PBL(i) + + ! Add a constant offset of '100._r8' to 'delta_xxx' variables to be + ! consistent with the reading sentence of unicon.F90 and so to prevent + ! negative tracers. + state%q(i,:,thl_cnst_ind) = max( 0._r8, delta_thl_PBL(i) + 100._r8 ) + state%q(i,:,qt_cnst_ind) = max( 0._r8, delta_qt_PBL(i) + 100._r8 ) + state%q(i,:,u_cnst_ind) = max( 0._r8, delta_u_PBL(i) + 100._r8 ) + state%q(i,:,v_cnst_ind) = max( 0._r8, delta_v_PBL(i) + 100._r8 ) + end do + +#endif + +end subroutine unicon_cam_org_diags + +!================================================================================================== +end module unicon_cam diff --git a/src/physics/cam/unicon_utils.F90 b/src/physics/cam/unicon_utils.F90 new file mode 100644 index 0000000000..0197c54fcc --- /dev/null +++ b/src/physics/cam/unicon_utils.F90 @@ -0,0 +1,1936 @@ +!============================================================ +! Utility routines for the UNIFIED CONVECTION SCHEME (UNICON) +!============================================================ + +module unicon_utils + +use shr_kind_mod, only : r8 => shr_kind_r8 +use wv_saturation, only : qsat, findsp +use cam_abortutils, only : endrun +use cam_logfile, only : iulog + +implicit none +private +save + +public :: & + unicon_utils_init, & + exnf, & + conden, & + slope, & + area_overlap, & + envcon_flux, & + prod_prep_up, & + evap_prep_dn, & + progup_thlqt, & + progup_uv, & + progup_wu2, & + compute_dp, & + buosort_downdraft, & + compute_PDF, & + compute_epsdelnod, & + buosorts_UW, & + positive_moisture, & + positive_tracer, & + findsp_single + +real(r8), parameter :: alpha_max = 2._r8 ! Upper limit of mixing parameter of updraft mass flux PDF [ no unit ] +real(r8), parameter :: nonzero = 1.e-20_r8 ! Non-zero minimal positive constant [ no unit ] +real(r8), parameter :: tmax_fice = 263.15_r8 ! Temperature where ice starts to be formed [ K ] +real(r8), parameter :: tmin_fice = 233.15_r8 ! Temperature where ice fraction becomes 1 [ K ] + +real(r8) :: xlv ! Latent heat of vaporization +real(r8) :: xlf ! Latent heat of fusion +real(r8) :: xls ! Latent heat of sublimation +real(r8) :: cp ! Specific heat of dry air +real(r8) :: zvir ! rh2o/rair - 1 +real(r8) :: r ! Gas constant for dry air +real(r8) :: g ! Gravitational constant +real(r8) :: p00 ! Reference pressure for exner function +real(r8) :: rovcp ! R/cp + +real(r8) :: droprad_liq ! Effectie droplet radius of detrained liquid [ m ] +real(r8) :: droprad_ice ! Effectie droplet radius of detrained ice [ m ] +real(r8) :: density_liq ! Density of cloud liquid droplets [ kg/m3 ] +real(r8) :: density_ice ! Density of cloud ice crystals [ kg/m3 ] + +integer :: mclimit ! If '1' ( '0' ), impose (not impose ) 'ql + qi > criqc' at the top interface + ! after precipitation fall-out. + + +!================================================================================================== +contains +!================================================================================================== + +subroutine unicon_utils_init(& + xlv_in, cp_in, xlf_in, zvir_in, r_in, & + g_in, droprad_liq_in, droprad_ice_in, density_liq_in, density_ice_in, & + mclimit_in) + + real(r8), intent(in) :: xlv_in ! Latent heat of vaporization + real(r8), intent(in) :: xlf_in ! Latent heat of fusion + real(r8), intent(in) :: cp_in ! Specific heat of dry air + real(r8), intent(in) :: zvir_in ! rh2o/rair - 1 + real(r8), intent(in) :: r_in ! Gas constant for dry air + real(r8), intent(in) :: g_in ! Gravitational constant + real(r8), intent(in) :: droprad_liq_in ! Effectie droplet radius of detrained liquid [ m ] + real(r8), intent(in) :: droprad_ice_in ! Effectie droplet radius of detrained ice [ m ] + real(r8), intent(in) :: density_liq_in ! Density of cloud liquid droplets [ kg/m3 ] + real(r8), intent(in) :: density_ice_in ! Density of cloud ice crystals [ kg/m3 ] + integer , intent(in) :: mclimit_in ! If '1' ( '0' ), impose (not impose ) 'ql + qi > criqc' at the top interface + + xlv = xlv_in + xlf = xlf_in + xls = xlv + xlf + cp = cp_in + zvir = zvir_in + r = r_in + g = g_in + p00 = 1.e5_r8 + rovcp = r/cp + + droprad_liq = droprad_liq_in + droprad_ice = droprad_ice_in + density_liq = density_liq_in + density_ice = density_ice_in + mclimit = mclimit_in + +end subroutine unicon_utils_init + +!-------------------------------------------------------------------------------------------------- + +real(r8) function exnf(pressure) + real(r8), intent(in) :: pressure + exnf = (pressure/p00)**rovcp +end function exnf + +!-------------------------------------------------------------------------------------------------- + +subroutine conden(p,thl,qt,th,qv,ql,qi,rvls,id_check) + + ! --------------------------------------------------------------------- ! + ! Calculate thermodynamic properties from a given set of ( p, thl, qt ) ! + ! Note that this subroutine assumes horizontal homogeneity in the grid. ! + ! --------------------------------------------------------------------- ! + + real(r8), intent(in) :: p, thl, qt + real(r8), intent(out) :: th, qv, ql, qi, rvls + integer, intent(out) :: id_check + real(r8) :: es, qs, gam + integer i + real(r8) qc, t, fice, ficeg, ficeg0, leff, leffg + real(r8) f, fg + + ! ---------------------------------------------------------- ! + ! Main Computation Loop : Find Final Equilibrium Temperature ! + ! ---------------------------------------------------------- ! + + id_check = 1 + ficeg0 = -1._r8/(tmax_fice-tmin_fice) + t = thl*exnf(p) + call qsat(t, p, es, qs) + + if( qs .ge. qt ) then + + qv = qt + qc = 0._r8 + ql = 0._r8 + qi = 0._r8 + th = t/exnf(p) + rvls = qs + id_check = 0 + return + + else + + do i = 1, 10 + + fice = max( 0._r8, min( 1._r8, (tmax_fice-t)/(tmax_fice-tmin_fice) ) ) + + if( t .lt. tmin_fice-1._r8 ) then + ficeg = 0._r8 + elseif( t .ge. tmin_fice-1._r8 .and. t .lt. tmin_fice+1._r8 ) then + ficeg = ficeg0 * ( t - tmin_fice + 1._r8 )/2._r8 + elseif( t .ge. tmin_fice+1._r8 .and. t .lt. tmax_fice-1._r8 ) then + ficeg = ficeg0 + elseif( t .ge. tmax_fice-1._r8 .and. t .lt. tmax_fice+1._r8 ) then + ficeg = -ficeg0 * ( t - tmax_fice - 1._r8 )/2._r8 + elseif( t .ge. tmax_fice+1._r8 ) then + ficeg = 0._r8 + endif + + leff = fice *xls + (1._r8 - fice)*xlv + leffg = ficeg*(xls-xlv) + call qsat(t, p, es, qs, gam=gam) + f = qt - (cp/leff)*(t-exnf(p)*thl)-qs + fg = (cp/leff)*((leffg/leff)*(t-exnf(p)*thl)-1._r8-gam) + + if( abs(fg) .lt. 1.e-12_r8 ) then + t = t + 0.1_r8 + else + t = t - f/fg + endif + if( abs(f/fg) .lt. 1.e-3_r8 ) then + qc = max(qt - qs,0._r8) + qv = qt - qc + ql = qc*(1._r8 - fice) + qi = fice*qc + th = t/exnf(p) + rvls = qs + id_check = 0 + return + endif + + enddo + + end if + + write(iulog,*) 'Warning : Convergence in conden is not achived and final value is used in unicon.F90' + qc = max(qt - qs,0._r8) + qv = qt - qc + ql = qc*(1._r8 - fice) + qi = fice*qc + th = t/exnf(p) + rvls = qs + id_check = 0 + +end subroutine conden + +!-------------------------------------------------------------------------------------------------- + +function slope(mkx,field,p0) + + ! ------------------------------------------------------------------ ! + ! Function performing profile reconstruction of conservative scalars ! + ! in each layer. This is identical to profile reconstruction used in ! + ! UW-PBL scheme but from bottom to top layer here. At the lowest ! + ! layer near to surface, slope is defined using the two lowest layer ! + ! mid-point values. I checked this subroutine and it is correct. ! + ! ------------------------------------------------------------------ ! + + integer, intent(in) :: mkx + real(r8), intent(in) :: field(mkx) + real(r8), intent(in) :: p0(mkx) + + real(r8) :: slope(mkx) + real(r8) :: below + real(r8) :: above + integer :: k + + below = (field(2) - field(1))/(p0(2) - p0(1)) + do k = 2, mkx + above = (field(k) - field(k-1))/(p0(k) - p0(k-1)) + if (above .gt. 0._r8) then + slope(k-1) = max(0._r8,min(above,below)) + else + slope(k-1) = min(0._r8,max(above,below)) + end if + below = above + end do + slope(mkx) = slope(mkx-1) + + ! Sep.22.2011. Set the slope in the lowest model layer to be zero to reduce the + ! sensitivity of the diurnal cycle to the surface heating. + ! slope(1) = 0._r8 + +end function slope + +!-------------------------------------------------------------------------------------------------- + +function area_overlap(x1,y1,a1,x2,y2,a2,cn) + + ! ----------------------------------------------------------------- ! + ! Function to compute overlapping area between two disks located at ! + ! (x1,y1) in unit of [m] with fractional area a1, and ! + ! (x2,y2) in unit of [m] with fractional area a2, both of which has ! + ! the same number concentration of 'cn' [ # / m^2 ]. ! + ! The resulting overlapping area has no unit : fractional area. ! + ! ----------------------------------------------------------------- ! + + real(r8) :: area_overlap + real(r8), intent(in) :: x1, y1, a1, x2, y2, a2, cn + real(r8) :: r1, r2 + real(r8) :: rmin, rmax, d + real(r8) :: arg1, arg2, arg3 + + r1 = sqrt(max(0._r8,a1/cn/3.141592_r8)) + r2 = sqrt(max(0._r8,a2/cn/3.141592_r8)) + d = sqrt( (x2-x1)**2._r8 + (y2-y1)**2._r8 ) + rmin = min( r1, r2 ) + rmax = max( r1, r2 ) + + if( rmin .eq. 0._r8 .or. rmax .eq. 0._r8 ) then + area_overlap = 0._r8 + return + else + if( d .le. ( rmax - rmin ) ) then + area_overlap = min( a1, a2 ) + return + elseif( d .ge. ( rmax + rmin ) ) then + area_overlap = 0._r8 + return + else + arg1 = (d**2._r8+rmin**2._r8-rmax**2._r8)/(2._r8*d*rmin) + arg2 = (d**2._r8+rmax**2._r8-rmin**2._r8)/(2._r8*d*rmax) + arg3 = (-d+rmin+rmax)*(d+rmin-rmax)*(d-rmin+rmax)*(d+rmin+rmax) + arg1 = max(-1._r8,min(1._r8,arg1)) + arg2 = max(-1._r8,min(1._r8,arg2)) + arg3 = max(0._r8,arg3) + + area_overlap = cn * & + (rmin**2._r8*acos(arg1) + rmax**2._r8*acos(arg2) - 0.5_r8*sqrt(arg3)) + + ! Apr.25.2012. I checked that below is always satisfied with round-off error. + ! So, I safely added below safety constraint. + area_overlap = min( a1, min( a2, area_overlap ) ) + return + end if + end if +end function area_overlap + +!-------------------------------------------------------------------------------------------------- + +subroutine envcon_flux(ki,mkx,umi,dmi,a0,ssa0,ps0,au,ad) + + ! --------------------------------------------------------------------------- ! + ! Compute mean-environmental values of conservative scalar for computation of ! + ! convective fluxes by considering the displacement of flux interface induced ! + ! by convective updraft and downdraft mass fluxes and associated compensating ! + ! downwelling and upwelling. ! + ! ki : interface index that is considered ! + ! umi : updraft mass flux in unit of [Pa] during dt ( umi >= 0 ) ! + ! dmi : downdraft mass flux in unit of [Pa] during dt ( dmi >= 0 ) ! + ! a : environmental conservative scalar that is considered ! + ! Done. ! + ! --------------------------------------------------------------------------- ! + + integer, intent(in) :: ki, mkx + real(r8), intent(in) :: umi, dmi + real(r8), intent(in) :: a0(mkx), ssa0(mkx) + real(r8), intent(in) :: ps0(0:mkx) + real(r8), intent(out) :: au, ad + integer k, ku, kd + real(r8) um, dm + real(r8) dp, dpu, dpd, pbot, ptop, dptop, a_dptop, dpbot, a_dpbot + + ! Impose a limiting on the updraft (um) and downdraft mass flux (dm) such that + ! it cannot be larger than the available mass above the interface (um) and + ! below the displaced interface (dm) by updraft mass flux. Note that ps0(0) is + ! surface interface while ps0(mkx) is top-most interface. Note umi, dmi > 0. + + um = max( 0._r8, min( umi, ps0(ki) - ps0(mkx) ) ) + dm = max( 0._r8, min( dmi, ps0(0) - ps0(ki) + um ) ) + + ! Treatment of updraft + + ! if( um .eq. 0._r8 ) then + if( um .lt. 1.e-5_r8 ) then ! To avoid dividing by zero ( dpu = 0 ) by round-off error. + if( ki .eq. mkx ) then + au = a0(ki) + else + au = a0(ki+1) + 0.5_r8 * ssa0(ki+1) * ( ps0(ki) - ps0(ki+1) ) + endif + goto 50 + endif + + ku = ki + 1 + do k = ki, mkx + if( ps0(k) .lt. ( ps0(ki) - um ) ) then + ku = k + goto 10 + endif + enddo +10 continue + + au = 0._r8 + dpu = 0._r8 + if( ( ku - 1 ) .ge. ( ki + 1 ) ) then + do k = ki + 1, ku - 1 + dp = ps0(k-1) - ps0(k) + au = au + a0(k) * dp + dpu = dpu + dp + enddo + endif + + ptop = ps0(ki) - um + dptop = ps0(ku-1) - ptop + a_dptop = a0(ku) + 0.5_r8 * ssa0(ku) * ( ptop - ps0(ku) ) + au = au + a_dptop * dptop + dpu = dpu + dptop + ! I checked that dpu = 0 happans when umi is very small, 1.e-15. + if( dpu .eq. 0._r8 ) then + write(iulog,*) 'ki, ku, um, umi, dmi = ', ki, ku, um, umi, dmi + write(iulog,*) 'ptop, dptop, a_dptop, au, dpu = ', ptop, dptop, a_dptop, au, dpu + do k = 1, mkx + write(iulog,*) 'ps0(k), a0(k) =', ps0(k), a0(k) + enddo + call endrun('UNICON : Zero dpu within envcon_flux') + endif + au = au / dpu + +50 continue + + ! Treatment of downdraft + + ! if( dm .eq. 0._r8 ) then + if( dm .lt. 1.e-5_r8 ) then ! To avoid dividing by zero ( dpd = 0 ) by round-off error. + ad = a0(ku) + ssa0(ku) * ( ptop - 0.5_r8 * ( ps0(ku-1) - ps0(ku ) ) ) + return + endif + + pbot = ps0(ki) - um + dm + kd = ku + do k = ku, 1, -1 + if( ps0(k) .ge. pbot ) then + kd = k + 1 + goto 20 + endif + enddo +20 continue + + ad = 0._r8 + dpd = 0._r8 + if( ( ku - 1 ) .ge. ( kd + 1 ) ) then + do k = kd + 1, ku - 1 + dp = ps0(k-1) - ps0(k) + ad = ad + a0(k) * dp + dpd = dpd + dp + enddo + endif + + if( pbot .le. ps0(ku-1) ) then + dpbot = dm + a_dpbot = a0(ku) + 0.5_r8 * ssa0(ku) * ( pbot + ptop - ps0(ku-1) - ps0(ku) ) + ad = ad + a_dpbot * dpbot + dpd = dpd + dpbot + ad = ad / dpd + return + else + dpbot = pbot - ps0(kd) + a_dpbot = a0(kd) + 0.5_r8 * ssa0(kd) * ( pbot + ps0(kd) - ps0(kd-1) - ps0(kd) ) + ad = ad + a_dpbot * dpbot + a_dptop * dptop + dpd = dpd + dpbot + dptop + ad = ad / dpd + return + endif + +end subroutine envcon_flux + +!-------------------------------------------------------------------------------------------------- + + subroutine prod_prep_up( z_b, z_t, p_b, p_t, exn_t, exn_m, w_b, w_t, & + thl_in, qt_in, ql_in, qi_in, tr_in, & + S_b_ql_in, S_b_qi_in, iprd_prep, & + ql_b, qi_b, epsb, & + thl_m, ssthl_m, thl_b, qt_m, ssqt_m, qt_b, & + ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, ii, kk, lchnk, & + flxrain, flxsnow, a_p, a_u, a_pu, & + caer, criqc, c0_ac, & + exql, exqi, extr, S_t_ql, S_t_qi, evpR, evpS, evpRStr ) + ! ------------------------------------------------------------------------------------------------------- ! + ! Compute 'exql, exqi >= 0' [kg/kg] and 'S_t_ql, S_t_qi >= 0' [kg/kg/Pa]. ! + ! ------------------------------------------------------------------------------------------------------- ! + + integer, intent(in) :: ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, ii, kk, lchnk, iprd_prep + real(r8), intent(in) :: z_b, z_t, p_b, p_t, exn_t, exn_m + real(r8), intent(in) :: w_b, w_t + real(r8), intent(in) :: thl_in, qt_in, ql_in, qi_in, tr_in(ncnst) + real(r8), intent(in) :: S_b_ql_in, S_b_qi_in + real(r8), intent(in) :: ql_b, qi_b, epsb + real(r8), intent(in) :: thl_m, ssthl_m, thl_b, qt_m, ssqt_m, qt_b + real(r8), intent(in) :: flxrain, flxsnow + real(r8), intent(in) :: a_p, a_u, a_pu + real(r8), intent(in) :: caer, criqc, c0_ac + real(r8), intent(out) :: exql, exqi, extr(ncnst) + real(r8), intent(out) :: evpR, evpS, evpRStr(ncnst) + real(r8), intent(out) :: S_t_ql, S_t_qi + integer mt, iter, id_exit, id_check, niter + real(r8) lambda + real(r8) tmp1, tmp2 + real(r8) tmp_thl, tmp_qt, tmp_th, tmp_qv, tmp_ql, tmp_qi, tmp_qs + real(r8) dp, dz, wm, delta_t + real(r8) flxrain_in, flxsnow_in + real(r8) ql, qi + real(r8) S_b_ql, S_b_qi + real(r8) S_ql, S_qi + real(r8) S_t_ql_pre, S_t_qi_pre + real(r8) exql_pre, exqi_pre + real(r8) dia_thl, dia_qt + ! ----------------------- ! + ! Compute basic variables ! + ! ----------------------- ! + + niter = 1 + if( iprd_prep .eq. -1 .or. iprd_prep .eq. -5 ) niter = 0 ! Forward Method + lambda = 0.5_r8 + dp = p_b - p_t ! [ Pa ] >= 0. + dz = z_t - z_b ! [ z ] >= 0. + wm = 0.5_r8 * ( w_b + w_t ) ! [ m/s ] > 0. + delta_t = dz / wm ! [ s ] >= 0. + flxrain_in = flxrain / max( nonzero, a_p ) + flxsnow_in = flxsnow / max( nonzero, a_p ) + + ! ------------------------------------------------------------------------------------------------------------------- ! + ! Current formulation only contains a simple auto-conversion process as a unique function of in-cloud LWC/IWC. ! + ! In future, I should add more advanced formula as a function of droplet radius, vertical velocity, and ! + ! precipitation flux falling into the current layer. ! + ! IMPORTANT : ! + ! (1) Current precipitation formula conserve 'the fraction (f(T)) of in-cumulus liquid / ice as a function ! + ! of T' as is assumed in the subroutine 'conden'. Thus, without using 'conden', I can construct this iteration ! + ! loop associated with precipitation production (i.e., temperature T does not change during precipitation ! + ! production process ), which saves computation time a lot. ! + ! (2) With future double-moment microphysics, this f(T) assumed within 'conden' does not hold after precipitation ! + ! production. Thus, I should not use 'conden' subroutine with future microphysics, which will also save ! + ! computation time in future. ! + ! ------------------------------------------------------------------------------------------------------------------- ! + + if( iprd_prep .eq. -5 ) then + + if( ( ql_b + qi_b ) .gt. criqc ) then + S_ql = c0_ac * ( ( ql_b + qi_b ) - criqc ) * ( ql_b / ( ql_b + qi_b ) ) + S_qi = c0_ac * ( ( ql_b + qi_b ) - criqc ) * ( qi_b / ( ql_b + qi_b ) ) + else + S_ql = 0._r8 + S_qi = 0._r8 + endif + dia_qt = S_ql + S_qi + dia_thl = - ( ( xlv / cp / exn_m ) * S_ql + ( xls / cp / exn_m ) * S_qi ) + call progup_thlqt( epsb, 0._r8, dia_thl, p_b, p_t, thl_m, ssthl_m, thl_b, tmp_thl ) + call progup_thlqt( epsb, 0._r8, dia_qt, p_b, p_t, qt_m, ssqt_m, qt_b, tmp_qt ) + call conden( p_t, tmp_thl, tmp_qt, tmp_th, tmp_qv, tmp_ql, tmp_qi, tmp_qs, id_check ) + exql = min( max( ql_in - tmp_ql, 0._r8 ), 0.99_r8 * ql_in ) + exqi = min( max( qi_in - tmp_qi, 0._r8 ), 0.99_r8 * qi_in ) + if( mclimit .eq. 1 ) then + tmp1 = exql + exqi + tmp2 = min( tmp1, max( ql_in + qi_in - criqc, 0._r8 ) ) ! To impose a continuous variation across ql + qi = criqc. + exql = exql * ( tmp2 / max( tmp1, nonzero ) ) + exqi = exqi * ( tmp2 / max( tmp1, nonzero ) ) + endif + S_ql = exql / max( dp, nonzero ) + S_qi = exqi / max( dp, nonzero ) + S_t_ql = S_ql + S_t_qi = S_qi + + else + + ! ------------------------------------------------------------------------------------------------------ ! + ! Compute initially-precipitated updraft state variable 'ql,qi' at the top interface using precipitation ! + ! tendency at the base interface. ! + ! ------------------------------------------------------------------------------------------------------ ! + + S_ql = S_b_ql_in + S_qi = S_b_qi_in + exql = S_ql * dp + exqi = S_qi * dp + exql = min( max( 0._r8, exql ), 0.99_r8 * ql_in ) + exqi = min( max( 0._r8, exqi ), 0.99_r8 * qi_in ) + if( mclimit .eq. 1 ) then + tmp1 = exql + exqi + tmp2 = min( tmp1, max( ql_in + qi_in - criqc, 0._r8 ) ) ! To impose a continuous variation across ql_in + qi_in = criqc. + exql = exql * ( tmp2 / max( tmp1, nonzero ) ) + exqi = exqi * ( tmp2 / max( tmp1, nonzero ) ) + endif + S_b_ql = exql / max( dp, nonzero ) + S_b_qi = exqi / max( dp, nonzero ) + ql = ql_in - exql + qi = qi_in - exqi + if( iprd_prep .eq. 1 ) then + ql = ql_in + qi = qi_in + endif + if( ( ql + qi ) .gt. criqc ) then + S_t_ql = c0_ac * ( ( ql + qi ) - criqc ) * ( ql / ( ql + qi ) ) ! [ kg/kg/Pa ] + S_t_qi = c0_ac * ( ( ql + qi ) - criqc ) * ( qi / ( ql + qi ) ) ! [ kg/kg/Pa ] + else + S_t_ql = 0._r8 + S_t_qi = 0._r8 + endif + + ! ---------------------------------------------------------------------------------------------------------------- ! + ! Perform implicit iteration ! + ! The requires output from the iteration loop : ! + ! (1) 'exql, exqi' ! + ! (2) 'S_t_ql, S_t_qi' ! + ! where the above (1) and (2) are fully consistent ( exql = 0.5_r8 * ( S_b_ql + S_t_ql ) * dp, exqi = ... ) ! + ! regardless of the iteration number. However, the consistency between the 'ql = ql_in - exql' and 'S_t_ql' at the ! + ! top interface can be obtained as iteration is executed many times. ! + ! By setting 'do iter = 1, 1', I can use centered difference instead of forward difference which is a default. ! + ! ---------------------------------------------------------------------------------------------------------------- ! + + id_exit = 0 + do iter = 1, niter + + ! ------------------------------------------------------ ! + ! Compute 'raw' precipitation rate at the top interface. ! + ! ------------------------------------------------------ ! + + if( ( ql + qi ) .gt. criqc ) then + S_t_ql = c0_ac * ( ( ql + qi ) - criqc ) * ( ql / ( ql + qi ) ) ! [ kg/kg/Pa ] + S_t_qi = c0_ac * ( ( ql + qi ) - criqc ) * ( qi / ( ql + qi ) ) ! [ kg/kg/Pa ] + else + S_t_ql = 0._r8 + S_t_qi = 0._r8 + endif + + ! ------------------------------------------------------------------------------- ! + ! Impose a limiter on the computed 'raw' precipitation rate at the top interface. ! + ! Use 'ql_in, qi_in' which does not include precipitation fall-out at the top. ! + ! At the end of this block, 'exql,exqi' is fully consistent with 'S_t_ql,S_t_qi'. ! + ! ------------------------------------------------------------------------------- ! + + S_ql = 0.5_r8 * ( S_b_ql + S_t_ql ) + S_qi = 0.5_r8 * ( S_b_qi + S_t_qi ) + if( iprd_prep .eq. 1 ) then + S_ql = S_t_ql + S_qi = S_t_qi + endif + exql = S_ql * dp + exqi = S_qi * dp + exql = min( max( 0._r8, exql ), 0.99_r8 * ql_in ) + exqi = min( max( 0._r8, exqi ), 0.99_r8 * qi_in ) + if( mclimit .eq. 1 ) then + tmp1 = exql + exqi + tmp2 = min( tmp1, max( ql_in + qi_in - criqc, 0._r8 ) ) ! To impose a continuous variation across ql_in + qi_in = criqc. + exql = exql * ( tmp2 / max( tmp1, nonzero ) ) + exqi = exqi * ( tmp2 / max( tmp1, nonzero ) ) + endif + S_ql = exql / max( dp, nonzero ) + S_qi = exqi / max( dp, nonzero ) + S_t_ql = 2._r8 * S_ql - S_b_ql ! IMPORTANT : This must be allowed to be negative. + S_t_qi = 2._r8 * S_qi - S_b_qi ! IMPORTANT : This must be allowed to be negative. + if( iprd_prep .eq. 1 ) then + S_t_ql = 1._r8 * S_ql ! IMPORTANT : This must be allowed to be negative. + S_t_qi = 1._r8 * S_qi ! IMPORTANT : This must be allowed to be negative. + endif + + ! ------------------------------------------------------------------------------------------------------------- ! + ! Compute 'implicit' precipitation rate at the top interface by averaging the 'current' precipitation rate with ! + ! the 'previous' precipitation rate computed at the previous iteration loop. ! + ! Since both 'current' and 'previous' precipitation rates satisfies the limiters, ! + ! the average 'implicit' precipitation rate also satisfies the limiter automatically. ! + ! Within if block, the implicit 'exql,exqi' is fully consistent with 'S_t_ql,S_t_qi'. ! + ! ------------------------------------------------------------------------------------------------------------- ! + + if( iter .gt. 1 ) then + S_t_ql = lambda * S_t_ql + ( 1._r8 - lambda ) * S_t_ql_pre + S_t_qi = lambda * S_t_qi + ( 1._r8 - lambda ) * S_t_qi_pre + S_ql = 0.5_r8 * ( S_b_ql + S_t_ql ) + S_qi = 0.5_r8 * ( S_b_qi + S_t_qi ) + if( iprd_prep .eq. 1 ) then + S_ql = S_t_ql + S_qi = S_t_qi + endif + exql = S_ql * dp + exqi = S_qi * dp + ! if( kk .ge. 10 .and. kk .le. 12 ) then + ! write(6,*) + ! write(6,*) 'UNICON : Convergence test within the subroutine prod_prep_up' + ! write(6,*) 'kk, iter, abs( exql + exqi - exql_pre - exqi_pre ) = ', kk, iter, abs( exql + exqi - exql_pre - exqi_pre ) + ! write(6,*) 'kk, iter, exql, exqi, S_t_ql, S_t_qi, dp = ', kk, iter, exql, exqi, S_t_ql, S_t_qi, dp + ! write(6,*) + ! endif + if( abs( exql + exqi - exql_pre - exqi_pre ) .lt. 1.e-6_r8 ) then + id_exit = 1 + endif + endif + + S_t_ql_pre = S_t_ql + S_t_qi_pre = S_t_qi + exql_pre = exql + exqi_pre = exqi + + ! ----------------------------------------------------------------------------------------------------------------- ! + ! Update state variable at the top interface. ! + ! At this stage, 'exql = 0.5_r8 * ( S_b_ql + S_t_ql ) * dp' is exactly satisfied. ! + ! However, our 'S_t_ql' becomes inconsistent with the below updated 'ql = ql_in - exql' since 'S_t_ql' was computed ! + ! using 'ql = ql_in - exql(old)' where 'exql(old)' differs from 'exql'. ! + ! This inconsistency will be removed as iteration goes on. ! + ! ----------------------------------------------------------------------------------------------------------------- ! + + ql = ql_in - exql + qi = qi_in - exqi + if( id_exit .eq. 1 ) goto 10 + + enddo + 10 S_t_ql = max( 0._r8, S_t_ql ) ! Reset to non-negative value before sending to output. + S_t_qi = max( 0._r8, S_t_qi ) ! Reset to non-negative value before sending to output. + + endif ! End of 'iprd_prep = -5' choice + + ! ------------------------------- ! + ! Treatment of In-Cumulus Tracers ! + ! ------------------------------- ! + + do mt = 1, ncnst + if( mt .eq. 1 ) then + extr(mt) = 0._r8 + elseif( mt .eq. ixcldliq ) then + extr(mt) = exql + elseif( mt .eq. ixcldice ) then + extr(mt) = exqi + elseif( mt .eq. ixnumliq ) then + extr(mt) = exql * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_liq**3 * density_liq ) + elseif( mt .eq. ixnumice ) then + extr(mt) = exqi * 3._r8 / ( 4._r8 * 3.141592_r8 * droprad_ice**3 * density_ice ) + else + ! ----------------------------------------------------------------------------------------- ! + ! Wet deposition of aerosols (both interstitial and cloud-borne) within convective updarft. ! + ! Below is a very simple treatment which should be refined in future. ! + ! Note that I should use 'qt_in, tr_in' (i.e., input values) within below block. ! + ! ----------------------------------------------------------------------------------------- ! + extr(mt) = tr_in(mt) * ( ( exql + exqi ) / max( qt_in, nonzero ) ) + ! Nov.26.2013. Following the reviewer's comments, set 'extr(mt) = 0' since current formulation of + ! extr(mt) only treats auto-conversion not accretion. + ! extr(mt) = 0._r8 + ! Nov.29.2013. Following the reviewer's comments, use 'ql_in + qi_in' instead of 'qt_in' + ! in computing 'extr(mt)' above. + extr(mt) = caer * tr_in(mt) * min( 1._r8, ( ( exql + exqi ) / max( ql_in + qi_in, nonzero ) ) ) + endif + enddo + + ! ------------------------------------------------------------ ! + ! Evaporation. ! + ! Temporary set it to be zero, but should be refined in future ! + ! ------------------------------------------------------------ ! + + evpR = 0._r8 + evpS = 0._r8 + do mt = 1, ncnst + evpRStr(mt) = 0._r8 + enddo + + return + + end subroutine prod_prep_up + +!-------------------------------------------------------------------------------------------------- + + subroutine evap_prep_dn( z_b, z_t, p_b, p_t, w_dt, bogtop, & + th_in, qv_in, ql_in, qi_in, tr_in, qmin, & + S_t_qvR_in, S_t_qvS_in, ievp_prep, & + flxrain_bot_upeesm, flxsnow_bot_upeesm, flxtrrs_bot_upeesm, a_p_msfc, & + ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice, ndb_evp, cmfdb_evp, ii, kk, ks, lchnk, & + rho, thv_mean_b, cmf_db, eps_dn, del_dn, & + kevp_rain_dn, kevp_snow_dn, eta2, rbuoy_dn, rdrag, rjet, nonzero, wdmin, & + evp_qvR, evp_qvS, evp_tr, S_b_qvR, S_b_qvS, w_db ) + ! ------------------------------------------------------------------------------------------------------- ! + ! Compute 'evp_qvR, evp_qvS >= 0' [kg/kg] and 'S_b_qvR, S_b_qvS >= 0' [kg/kg/Pa], 'w_db >= wdmin [m/s]' ! + ! ------------------------------------------------------------------------------------------------------- ! + implicit none + integer, intent(in) :: ncnst, ixcldliq, ixcldice, ixnumliq, ixnumice + integer, intent(in) :: ndb_evp, ii, kk, ks, lchnk, ievp_prep + real(r8), intent(in) :: cmfdb_evp + real(r8), intent(in) :: z_b, z_t, p_b, p_t + real(r8), intent(in) :: w_dt, bogtop + real(r8), intent(in) :: th_in, qv_in, ql_in, qi_in, tr_in(ncnst), qmin(ncnst) + real(r8), intent(in) :: S_t_qvR_in, S_t_qvS_in + real(r8), intent(in) :: flxrain_bot_upeesm, flxsnow_bot_upeesm, flxtrrs_bot_upeesm(ncnst), a_p_msfc + real(r8), intent(in) :: rho, thv_mean_b, cmf_db, eps_dn, del_dn + real(r8), intent(in) :: kevp_rain_dn, kevp_snow_dn, eta2 + real(r8), intent(in) :: rbuoy_dn, rdrag, rjet + real(r8), intent(in) :: nonzero, wdmin + real(r8), intent(out) :: evp_qvR, evp_qvS, evp_tr(ncnst) + real(r8), intent(out) :: S_b_qvR, S_b_qvS + real(r8), intent(out) :: w_db + real(r8) :: es, qs + integer mt, iter, id_exit, niter + real(r8) tmp1, tmp2 + real(r8) evp_max + real(r8) S_t_qvR, S_t_qvS + real(r8) S_qvR, S_qvS + real(r8) evp_qvR_pre, evp_qvS_pre + real(r8) S_b_qvR_pre, S_b_qvS_pre + real(r8) t_in, thv_in, tw_in, qw_in + real(r8) t, qv, th, thv, bogbot, wd2 + real(r8) subsat_db + real(r8) dp, dz + real(r8) lambda + real(r8) rndb_evp + + ! ----------------------- ! + ! Compute basic variables ! + ! ----------------------- ! + + niter = 1 + if( ievp_prep .eq. -1 .or. ievp_prep .eq. -5 ) niter = 0 ! Forward Method + lambda = 0.5_r8 + rndb_evp = real(ndb_evp,r8) + dp = p_b - p_t ! [ Pa ] >= 0. + dz = z_t - z_b ! [ z ] >= 0. + t_in = th_in*exnf(p_b) + call findsp_single( qv_in, t_in, p_b, tw_in, qw_in, ii, kk, lchnk ) + + ! -------------------------------------------------------------------------------------------------------------- ! + ! Two sufficient-necessary downdraft state variables used for computing evaporation rate at the base interface : ! + ! (1) subsat_db ! + ! (2) w_db ! + ! which should continuously updated within the iteration loop. ! + ! -------------------------------------------------------------------------------------------------------------- ! + + S_qvR = S_t_qvR_in + S_qvS = S_t_qvS_in + evp_qvR = S_qvR * dp + evp_qvS = S_qvS * dp + ! evp_qvR = max( 0._r8, min( evp_qvR, eta2 * flxrain_bot_upeesm / max( nonzero, cmf_db ) / max( 1._r8, rndb_evp ) ) ) + ! evp_qvS = max( 0._r8, min( evp_qvS, eta2 * flxsnow_bot_upeesm / max( nonzero, cmf_db ) / max( 1._r8, rndb_evp ) ) ) + evp_qvR = max( 0._r8, min( evp_qvR, eta2 * flxrain_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + evp_qvS = max( 0._r8, min( evp_qvS, eta2 * flxsnow_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + evp_max = max( qw_in - qv_in, 0._r8 ) + if( ( evp_qvR + evp_qvS ) .gt. evp_max ) then + tmp1 = evp_qvR * evp_max / ( evp_qvR + evp_qvS ) + tmp2 = evp_qvS * evp_max / ( evp_qvR + evp_qvS ) + evp_qvR = tmp1 + evp_qvS = tmp2 + endif + S_t_qvR = evp_qvR / max( dp, nonzero ) + S_t_qvS = evp_qvS / max( dp, nonzero ) + t = t_in - ( xlv / cp ) * evp_qvR - ( xls / cp ) * evp_qvS + qv = qv_in + evp_qvR + evp_qvS + if( ievp_prep .eq. 1 ) then + t = t_in + qv = qv_in + endif + + call qsat(t,p_b,es,qs) + subsat_db = min( 1._r8, max( 0._r8, 1._r8 - qv / max( qs, nonzero ) ) ) + th = t / exnf(p_b) + thv = th * ( 1._r8 + zvir * qv - ql_in - qi_in ) + bogbot = rbuoy_dn * ( 1._r8 - thv / thv_mean_b ) + call progup_wu2( -( rdrag*eps_dn - rjet*del_dn ), rho, p_t, p_b, -bogtop, -bogbot, w_dt**2._r8, 0._r8, wd2 ) + w_db = max( wdmin, sqrt( max( wd2, nonzero ) ) ) + + S_b_qvR = ( 1._r8 / ( rho * g ) / max( w_db, wdmin ) ) * kevp_rain_dn * subsat_db * & + sqrt( max( 0._r8, flxrain_bot_upeesm / max( a_p_msfc, nonzero ) ) ) + S_b_qvS = ( 1._r8 / ( rho * g ) / max( w_db, wdmin ) ) * kevp_snow_dn * subsat_db * & + sqrt( max( 0._r8, flxsnow_bot_upeesm / max( a_p_msfc, nonzero ) ) ) + + ! ---------------------------------------------------------------------------------------------------------------- ! + ! Perform implicit iteration ! + ! The requires output from the iteration loop : ! + ! (1) 'evp_qvR, evp_qvS [kg/kg] >= 0' ! + ! (2) 'S_b_qvR, S_b_qvS [kg/kg/Pa] >= 0' ! + ! where the above (1) and (2) are fully consistent ( evp_qvR = 0.5_r8 * ( S_t_qvR + S_b_qvR ) * dp, evp_qvS = .. ) ! + ! regardless of the iteration number. However, consistency between 't = t_in-(xlv/cp)*evp_qvR-(xls/cp)*evp_qvS, ! + ! qv = qv_in + evp_qvR + evp_qvS' and 'S_b_qvR, S_b_qvS' at the base interface can be obtained as iteration is ! + ! executed many times. ! + ! By setting 'do iter = 1, 1', I can use centered difference instead of forward difference which is a default. ! + ! ---------------------------------------------------------------------------------------------------------------- ! + + id_exit = 0 + do iter = 1, niter + + ! ----------------------------------------------------- ! + ! Compute 'raw' evaporation rate at the base interface. ! + ! ----------------------------------------------------- ! + + S_b_qvR = ( 1._r8 / ( rho * g ) / max( w_db, wdmin ) ) * kevp_rain_dn * subsat_db * & + sqrt( max( 0._r8, flxrain_bot_upeesm / max( a_p_msfc, nonzero ) ) ) + S_b_qvS = ( 1._r8 / ( rho * g ) / max( w_db, wdmin ) ) * kevp_snow_dn * subsat_db * & + sqrt( max( 0._r8, flxsnow_bot_upeesm / max( a_p_msfc, nonzero ) ) ) + + ! --------------------------------------------------------------------------------------- ! + ! Impose a limiter on the computed 'raw' evaporation rate at the base interface. ! + ! Use 'evp_max = qw_in - qv_in' and 'eta2 * flxrain_bot_upeesm...' which do not include ! + ! evaporation of precipitation yet. ! + ! --------------------------------------------------------------------------------------- ! + + S_qvR = 0.5_r8 * ( S_t_qvR + S_b_qvR ) + S_qvS = 0.5_r8 * ( S_t_qvS + S_b_qvS ) + if( ievp_prep .eq. 1 ) then + S_qvR = S_b_qvR + S_qvS = S_b_qvS + endif + evp_qvR = S_qvR * dp + evp_qvS = S_qvS * dp + ! evp_qvR = max( 0._r8, min( evp_qvR, eta2 * flxrain_bot_upeesm / max( nonzero, cmf_db ) / max( 1._r8, rndb_evp ) ) ) + ! evp_qvS = max( 0._r8, min( evp_qvS, eta2 * flxsnow_bot_upeesm / max( nonzero, cmf_db ) / max( 1._r8, rndb_evp ) ) ) + evp_qvR = max( 0._r8, min( evp_qvR, eta2 * flxrain_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + evp_qvS = max( 0._r8, min( evp_qvS, eta2 * flxsnow_bot_upeesm / max( nonzero, cmfdb_evp ) ) ) + evp_max = max( qw_in - qv_in, 0._r8 ) + if( ( evp_qvR + evp_qvS ) .gt. evp_max ) then + tmp1 = evp_qvR * evp_max / ( evp_qvR + evp_qvS ) + tmp2 = evp_qvS * evp_max / ( evp_qvR + evp_qvS ) + evp_qvR = tmp1 + evp_qvS = tmp2 + endif + ! Mar.15.2014. By commenting in (activating) below 'if' block, compute 'non-zero' 'S_b_qvR,S_b_qvS' + ! for mixing downdraft generated in the current layer. This is important to obtain reasonably + ! strong downdraft vertical velocity. +!? if( ks .ne. kk .and. dp .gt. 0._r8 ) then + if( ks .ne. kk ) then + S_qvR = evp_qvR / max( dp, nonzero ) + S_qvS = evp_qvS / max( dp, nonzero ) + S_b_qvR = 2._r8 * S_qvR - S_t_qvR ! IMPORTANT : This must be allowed to be negative to prevent negative precipitation flux. + S_b_qvS = 2._r8 * S_qvS - S_t_qvS ! IMPORTANT : This must be allowed to be negative to prevent negative precipitation flux. + if( ievp_prep .eq. 1 ) then + S_b_qvR = 1._r8 * S_qvR ! IMPORTANT : This must be allowed to be negative to prevent negative precipitation flux. + S_b_qvS = 1._r8 * S_qvS ! IMPORTANT : This must be allowed to be negative to prevent negative precipitation flux. + endif + endif + + ! ------------------------------------------------------------------------------------------------------------- ! + ! Compute 'implicit' precipitation rate at the top interface by averaging the 'current' precipitation rate with ! + ! the 'previous' precipitation rate computed at the previous iteration loop. ! + ! Since both 'current' and 'previous' precipitation rates satisfies the limiters, ! + ! the average 'implicit' precipitation rate also satisfies the limiter automatically. ! + ! ------------------------------------------------------------------------------------------------------------- ! + + if( iter .gt. 1 ) then + S_b_qvR = lambda * S_b_qvR + ( 1._r8 - lambda ) * S_b_qvR_pre + S_b_qvS = lambda * S_b_qvS + ( 1._r8 - lambda ) * S_b_qvS_pre + S_qvR = 0.5_r8 * ( S_t_qvR + S_b_qvR ) + S_qvS = 0.5_r8 * ( S_t_qvS + S_b_qvS ) + if( ievp_prep .eq. 1 ) then + S_qvR = S_b_qvR + S_qvS = S_b_qvS + endif + evp_qvR = S_qvR * dp + evp_qvS = S_qvS * dp + ! if( kk .ge. 10 .and. kk .le. 12 ) then + ! write(6,*) + ! write(6,*) 'UNICON : Convergence test within the subroutine evap_prep_up' + ! write(6,*) 'kk, iter, abs( evp_qvR + evp_qvS - evp_qvR_pre - evp_qvS_pre ) = ', kk, iter, abs( evp_qvR + evp_qvS - evp_qvR_pre - evp_qvS_pre ) + ! write(6,*) 'kk, iter, evp_qvR, evp_qvS, S_b_qvR, S_b_qvS, w_db, subsat_db, dp = ', kk, iter, evp_qvR, evp_qvS, S_b_qvR, S_b_qvS, w_db, subsat_db, dp + ! write(6,*) + ! endif + if( abs( evp_qvR + evp_qvS - evp_qvR_pre - evp_qvS_pre ) .lt. 1.e-6_r8 ) then + id_exit = 1 + endif + endif + + S_b_qvR_pre = S_b_qvR + S_b_qvS_pre = S_b_qvS + evp_qvR_pre = evp_qvR + evp_qvS_pre = evp_qvS + + ! ----------------------------------------------------------------------------------------------------------------- ! + ! Update state variable at the top interface. ! + ! At this stage, 'exql = 0.5_r8 * ( S_b_ql + S_t_ql ) * dp' is exactly satisfied. ! + ! However, our 'S_t_ql' becomes inconsistent with the below updated 'ql = ql_in - exql' since 'S_t_ql' was computed ! + ! using 'ql = ql_in - exql(old)' where 'exql(old)' differs from 'exql'. ! + ! This inconsistency will be removed as iteration goes on. ! + ! ----------------------------------------------------------------------------------------------------------------- ! + + t = t_in - ( xlv / cp ) * evp_qvR - ( xls / cp ) * evp_qvS + qv = qv_in + evp_qvR + evp_qvS + call qsat(t,p_b,es,qs) + subsat_db = min( 1._r8, max( 0._r8, 1._r8 - qv / max( qs, nonzero ) ) ) + th = t / exnf(p_b) + thv = th * ( 1._r8 + zvir * qv - ql_in - qi_in ) + bogbot = rbuoy_dn * ( 1._r8 - thv / thv_mean_b ) + call progup_wu2( -( rdrag*eps_dn - rjet*del_dn ), rho, p_t, p_b, -bogtop, -bogbot, w_dt**2._r8, 0._r8, wd2 ) + w_db = max( wdmin, sqrt( max( wd2, nonzero ) ) ) + if( id_exit .eq. 1 ) goto 10 + + enddo + 10 S_b_qvR = max( 0._r8, S_b_qvR ) ! Reset to non-negative value before sending to output. + S_b_qvS = max( 0._r8, S_b_qvS ) ! Reset to non-negative value before sending to output. + + ! ------------------------------- ! + ! Treatment of In-Cumulus Tracers ! + ! ------------------------------- ! + + do mt = 1, ncnst + if( mt .eq. 1 ) then + evp_tr(mt) = evp_qvR + evp_qvS + elseif( mt .eq. ixcldliq .or. mt .eq. ixcldice .or. mt .eq. ixnumliq .or. mt .eq. ixnumice ) then + evp_tr(mt) = 0._r8 + else + evp_tr(mt) = flxtrrs_bot_upeesm(mt) * ( evp_qvR + evp_qvS ) / & + max( ( flxrain_bot_upeesm + flxsnow_bot_upeesm ) , nonzero ) + endif + evp_tr(mt) = max( evp_tr(mt), qmin(mt) - tr_in(mt) ) + enddo + + return + + end subroutine evap_prep_dn + +!-------------------------------------------------------------------------------------------------- + +subroutine progup_thlqt(eps_mix,eps_dia,qsrcg,pb,pt,qmid,gamq,qub,qut) + + ! -------------------------------------------------------------------------------------------------------------------------- ! + ! Compute cumulus updraft properties at the top interface for 'thl,qt' ! + ! for individual updraft plume. This subroutine is directly from the ! + ! progupeff_thlqt but edge computation is removed for multiple plume ! + ! approach. ! + ! ! + ! (1) qsrcg = ['q'/Pa] ! + ! ! + ! Both in case that 'q' decreases as updraft rises (i.e., precipitation production process with q = ql, qi) ! + ! and 'q' increases as downdraft sinks (i.e., precipitation evaporation process with q = qv), ! + ! the specified 'qsrcg' should be positive. ! + ! That is, we should specify 'qsrcg' in pressure-coordinate system by considering dp = -dz. ! + ! ! + ! (2) eps_mix, eps_dia = [1/Pa] ! + ! ! + ! Here, 'eps_mix' is an inverse of damping length scale by 'entrainment mixing' while ! + ! the 'eps_dia' is an inverse of damping length scale by 'diabatic forcing' ! + ! ('eps_dia = + cat * max( (qc_cu - qcrit) / qc_cu, 0._r8 ) [1/Pa]' which is auto-conversion efficiency for updraft or ! + ! ('eps_dia = - (kevp / (rho*g*wd)) * sqrt( Fp / ap ) / qsd' [1/Pa]' which is evaporation efficiency for downdraft ). ! + ! Be careful that for convective updraft, both the specified 'eps_mix, eps_dia > 0' while ! + ! for downdraft process, both 'eps_mix, eps_dia < 0' as is shown in the calling routine in the main body. ! + ! ! + ! Done. ! + ! -------------------------------------------------------------------------------------------------------------------------- ! + + real(r8), intent(in) :: eps_mix, eps_dia, qsrcg + real(r8), intent(in) :: pb, pt + real(r8), intent(in) :: qub + real(r8), intent(in) :: qmid, gamq + real(r8), intent(out) :: qut + real(r8) eps, qb, a, b, c, fp, dp + + ! Environmental conservative scalar at the base interface + + dp = pb - pt + qb = qmid + 0.5_r8 * dp * gamq + + ! Ensemble-mean updraft value at the top interface + ! Aug.18.2010. I chekced that below 'qut' exactly reproduce the UW + ! in a raw form, but not the Taylor-extended form. I verified that + ! my Taylor extended form is wrong but the UW has the correct + ! Taylor-expanded form. Thus, I am using the UW-Taylor extended form. + ! As a result, my nelow formula produced the exactly same results as UW in + ! all cases. + + eps = eps_mix + eps_dia + a = - eps + b = - eps * gamq + c = - eps * ( qb - gamq * pb ) + + if(abs(a*dp).gt.1.e-3_r8) then + ! I checked that below exactly reproduced the UW. + !prp qut = ( qub - ( b * pb + c ) / a + ( b / a / a ) ) * exp( a * dp ) + ( b * pt + c ) / a - ( b / a / a ) + fp = 1._r8 - eps_dia / eps + qut = ( qub - ( ( b * pb + c ) / a - ( b / a / a ) ) * fp - qsrcg / a ) * exp( a * dp ) + & + ( ( b * pt + c ) / a - ( b / a / a ) ) * fp + qsrcg / a + else + ! Aug.18.2010. Below original form is wrong. Thus, I am using the + ! UW Taylor extended form. + ! Jul.12.2011. I may need to correct below Taylor-expansion formula using both 'q_b' and 'q_t' + ! similar to the modification in progup_wu2. + ! Apr.18.2012. I realized that 'dp * a * ( qub - qb )' produces results non-trivially different from + ! the 'dp * ( a * ( qub - qb ) )'. This was the reason why '057a' produces different + ! results from '057' in bluefire. + ! To be consistent with the treatment in progup_uv, I should use the UW.Correct.1. + ! But in order to reproduce the '056' simulation, let's use UW.Correct.2. for the + ! time being. This should be carefully chosen in future to be consistent with the + ! progup_uv. + ! I checked that below UW.Correct.2. exactly reproduces '056'. + ! qut = qub - dp * ( 0.5_r8 * b * ( pt + pb ) + c ) ! Original, Wrong. + !prp qut = qub + dp * ( a * ( qub - qb ) - qsrcg ) ! New = UW. Correct.1. + qut = qub + dp * ( a * ( qub - qb ) - qsrcg - eps_dia * qb ) ! New = UW. Correct.1. + ! qut = qub + dp * a * ( qub - qb ) - dp * qsrcg ! New = UW. Correct.2. + endif + + ! Below is from UW shallow convection + ! Produced similar result as above. + ! On Jul.21.2010., change to the UW formula for consistency with + ! the description paper. Also change 1.e-4 to 1.e-3 for Taylor expansion. + + ! if( eps*dp .gt. 1.e-3_r8 ) then + ! qut = ( qmid + gamq / eps - gamq * dp / 2._r8 ) - & + ! ( qmid + gamq * dp / 2._r8 - qub + gamq / eps ) * exp( -eps * dp ) + ! else + ! qut = qub + ( qmid + gamq * dp / 2._r8 - qub ) * eps * dp + ! endif + +end subroutine progup_thlqt + +!-------------------------------------------------------------------------------------------------- + +subroutine progup_uv(eps,PGFuv,pb,pt,qmid,gamq,gamqPGF,qub,qut) + + ! ---------------------------------------------------------------------- ! + ! Compute cumulus updraft properties at the top interface for 'u,v' ! + ! for individual updraft plume. This subroutine is directly from the ! + ! progupeff_thlqt but edge computation is removed for multiple plume ! + ! approach. ! + ! This is same as 'progupeff_thlqt_single' except that coef. c is ! + ! re-defined by including PGFc effect. ! + ! Done. ! + ! ---------------------------------------------------------------------- ! + + real(r8), intent(in) :: eps, PGFuv + real(r8), intent(in) :: pb, pt + real(r8), intent(in) :: qub + real(r8), intent(in) :: qmid, gamq, gamqPGF + real(r8), intent(out) :: qut + real(r8) qb, a, b, c, dp + + ! Environmental conservative scalar at the base interface + ! Aug.18.2010. I checked that below 'qut' exactly reproduce the UW + ! in a raw form, but not the Taylor-extended form. I verified that + ! my Taylor extended form is wrong but the UW has the correct + ! Taylor-expanded form. Thus, I am using the UW-Taylor extended form. + ! As a result, my nelow formula produced the exactly same results as UW in + ! all cases. + + ! Apr.5.2011. The 'gamq' multiplied to 'PGFuv' may need to be the one + ! using the inter-layer slope, not the within the layer slope. Thus, + ! I am using gamqPGF for PGFc effect. + + dp = pb - pt + qb = qmid + 0.5_r8 * dp * gamq + + ! Ensemble-mean updraft value at the top interface + + a = - eps + b = - eps * gamq + c = - eps * ( qb - gamq * pb ) + PGFuv * gamqPGF + + if( abs( a * dp ) .gt. 1.e-3_r8 ) then + qut = ( qub - ( b * pb + c ) / a + ( b / a / a ) ) * exp( a * dp ) + ( b * pt + c ) / a - ( b / a / a ) + else + ! Aug.18.2010. Below original form is wrong. Thus, I am using the + ! UW Taylor extended form. + ! Apr.18.2012. For consistency with progup_thlqt, I use UW.Correct.2. below. + ! The diffrence between UW.Correct.1. and UW.Correct.2. is from numerical truncation error. + ! qut = qub - dp * ( 0.5_r8 * b * ( pt + pb ) + c ) ! Original, Wrong. + qut = qub + dp * ( a * ( qub - qb ) - PGFuv * gamqPGF ) ! New = UW. Correct.1. + ! qut = qub + dp * a * ( qub - qb ) - dp * gamqPGF * PGFuv ! New = UW. Correct.2. + endif + + ! Below is from UW shallow convection + ! Produced similar result as above. + ! On Jul.21.2010., change to the UW formula for consistency with + ! the description paper. Also change 1.e-4 to 1.e-3 for Taylor expansion. + + ! if( eps * dp .gt. 1.e-3_r8 ) then + ! qut = ( qmid + ( 1._r8 - PGFuv ) * gamq / eps - gamq * dp / 2._r8 ) - & + ! ( qmid + gamq * dp / 2._r8 - qub + ( 1._r8 - PGFuv ) * gamq / eps ) * exp( -eps * dp ) + ! else + ! qut = qub + ( qmid + gamq * dp / 2._r8 - qub ) * eps * dp - PGFuv * gamq * dp + ! endif + +end subroutine progup_uv + +!-------------------------------------------------------------------------------------------------- + +subroutine progup_wu2(eps,rho,pb,pt,bogbot,bogtop,wwub,wwe,wwut) + + ! ----------------------------------------------------------------- ! + ! Compute squared ensemble-mean cumulus updraft vertical at the top ! + ! interface. Note that 'bogbot,bogtop' ( which are non-dimensional ! + ! variables ) already contains buoyancy coefficient, rbuoy in it. ! + ! Eqn: dw2/dp + a*w2 = c ! + ! Note that even the case of 'wwub=0.' is reasonably treated within ! + ! this subroutine. ! + ! Note that following 'compute_dp' should be chosen in a consistent ! + ! way as the one in this subroutine. ! + ! Mar.11.2013. Add 'wwe [m2/s2]' which is the square of vertical ! + ! velocity of mixing environmental airs that is ! + ! assumed to be a height-independent constant in the ! + ! layer considered. ! + ! worg, bogbot, bogtop : Have no unit. ! + ! Done. ! + ! ----------------------------------------------------------------- ! + + real(r8), intent(in) :: eps, rho + real(r8), intent(in) :: pb, pt + real(r8), intent(in) :: bogbot, bogtop + real(r8), intent(in) :: wwub + real(r8), intent(in) :: wwe + real(r8), intent(out) :: wwut + !real(r8) a, c + real(r8) dp, expfac, gammaB, worg + !real(r8) delbog + + ! Coefficients + + dp = pb - pt + !a = - 2._r8 * eps + !c = - ( bogbot + bogtop ) / rho + worg = rho * eps * wwe + + ! Option 1. Ensemble-mean updraft value at the top interface without + ! considering buoyancy slope in each layer. + ! For consistency with compute_dp, good to use this. + ! Aug.18.2010. I chekced that below 'qut' exactly reproduce the UW + ! if 'bogbot = bogtop' in the UW form. + + ! if( abs( a * dp ) .gt. 1.e-3_r8 ) then + ! wwut = ( wwub - c / a ) * exp( a * dp ) + c / a + ! else + ! ! Aug.18.2010. Below original form is wrong. Thus, I am using the + ! ! correct UW Taylor extended form. + ! ! wwut = wwub - c * dp ! Original Wrong + ! wwut = wwub * ( 1._r8 - 2._r8 * eps * dp ) - c * dp ! New Correct. + ! endif + + ! Option 2. Ensemble-mean updraft value at the top interface + ! with consideration of buoyancy slope in each layer. + ! Below is the most perfect formula I should use. + ! My below formula produced the exactly same results as UW in + ! all cases. + ! Jul.9.2011. Below is not correct for downdraft momentum equation. + ! I should correct this. Probably, I should correct ( add (-) sign ) + ! to the input argument of bogbot and bogtop. + ! Jul.10.2011. I modified below Taylor expansion formula by using 'eps .gt. 1.e-5' and + ! by changing 'bogbot' to '0.5_r8 * ( bogbot + bogtop )' for full consistency. + ! Below is old before Jul.10.2011. + ! if( eps * dp .gt. 1.e-3_r8 ) then + ! expfac = exp( -2._r8 * eps * dp ) + ! gammaB = ( bogtop - bogbot ) / dp + ! wwut = wwub * expfac + ( gammaB * dp + (1._r8-expfac)*(bogbot + gammaB/(-2._r8*eps)) )/(rho*eps) + ! else + ! wwut = wwub * ( 1._r8 - 2._r8 * eps * dp ) + 2._r8 * bogbot * dp / rho + ! endif + ! Below is new after Jul.10.2011. + ! Mar.11.2013. Add 'worg' only in the below block of formula. + ! Thus, I should only use below block. + + if( abs(dp) .lt. 1.e-10_r8 ) then + wwut = wwub + else + if( abs(eps) .gt. 1.e-6_r8 ) then + expfac = exp( -2._r8 * eps * dp ) + gammaB = ( bogtop - bogbot ) / dp + wwut = wwub * expfac + ( gammaB * dp + (1._r8-expfac)*(bogbot + gammaB/(-2._r8*eps) + worg) )/(rho*eps) + else + wwut = wwub * ( 1._r8 - 2._r8 * eps * dp ) + ( bogbot + bogtop + 2._r8 * worg ) * dp / rho + endif + endif + + ! Below is from UW shallow convection + ! Produced similar result as above. + ! On Jul.21.2010., change to the UW formula for consistency with the description paper. + ! However, Taylor-expanded formula is correctly revised. + + ! delbog = bogtop - bogbot + ! expfac = exp( -2._r8 * eps * dp ) + ! if( eps * dp .gt. 1.e-3_r8 ) then + ! wwut = wwub * expfac + ( delbog + (1._r8-expfac)*(bogbot + delbog/(-2._r8*eps*dp)))/(rho*eps) + ! else + ! ! Below is original Taylor formula. + ! ! wwut = wwub + dp * ( bogbot + bogtop ) / rho + ! ! Below is corrected Taylor formula on Jul.21.2010. + ! wwut = wwub * ( 1._r8 - 2._r8 * eps * dp ) + 2._r8 * bogbot * dp / rho + ! endif + +end subroutine progup_wu2 + +!-------------------------------------------------------------------------------------------------- + +real(r8) function compute_dp(eps,rho,pb,pt,bogbot,bogtop,wwub,wwe) + + ! ---------------------------------------------------------------------- ! + ! Compute vertical distance that convective updraft with non-zero ! + ! entrainment can move. ! + ! For simplicity, use the height-independent average buoyancy. ! + ! Note 'compute_dp = [Pa] > 0'. eps = [1/Pa]. bogbot,bgtop = [ no unit ] ! + ! Note that above 'progup_wu2' should be chosen in a consistent way ! + ! as the one in this subroutine. ! + ! Mar.11.2013. Add 'wwe [m2/s2]' which is the square of vertical ! + ! velocity of mixing environmental airs that is ! + ! assumed to be a height-independent constant in the ! + ! layer considered. ! + ! worg, bogbot, bogtop : Have no unit. ! + ! Done. ! + ! ---------------------------------------------------------------------- ! + + real(r8), intent(in) :: eps, rho + real(r8), intent(in) :: pb, pt + real(r8), intent(in) :: bogbot, bogtop + real(r8), intent(in) :: wwub + real(r8), intent(in) :: wwe + !real(r8) a, c + real(r8) dp, dpen, gammaB, worg + real(r8) x0, x1, f, fs, s00 + integer iteration + + !a = 2._r8 * eps + !c = ( bogbot + bogtop ) / rho + dpen = pb - pt + gammaB = ( bogtop - bogbot ) / dpen + worg = rho * eps * wwe + + ! Option 1. Without considering buoyancy slope in each layer. + + ! if( c .ge. 0._r8 ) then + ! dp = dpen + ! else + ! if( a .lt. 1.e-12_r8 ) then + ! dp = - wwub / c + ! else + ! dp = - ( 1._r8 / a ) * log( c / ( c - a * wwub ) ) + ! endif + ! endif + + ! Option 2. With considering buoyancy slope in each layer. + ! Below is from the UW code. + ! Below is the most perfect choice. + + ! Jul.10.2011. Rigorously speaking, below Taylor expansion should also be modified following + ! the same day's modification in progup_wu2 above, using 'eps' not the + ! product of 'eps * dpen', although this modification is likely to have + ! a very minor effect. + ! Mar.11.2013. Add 'worg' in the below block. However, I have not added 'worg' in the + ! Taylor-expended block, which should be done in future. + ! Probably, I should redefine s00 = ( bogbot + worg ) / rho - eps * wwub. + ! Since this seems to be quite straightforwatd, I also modified this Taylor block. + + ! s00 = bogbot / rho - eps * wwub + s00 = ( bogbot + worg ) / rho - eps * wwub + if( eps * dpen .le. 1.e-8_r8 ) then + if( s00 .ge. 0._r8 ) then + x0 = dpen + else + x0 = max( 0._r8, min( dpen , -0.5_r8 * wwub / s00 ) ) + endif + else + if( s00 .ge. 0._r8 ) then + x0 = dpen + else + x0 = 0._r8 + endif + do iteration = 1, 5 + f = exp(-2._r8*eps*x0)*(wwub-(bogbot-gammaB/(2._r8*eps)+worg)/(eps*rho)) + & + (gammaB*x0+bogbot-gammaB/(2._r8*eps)+worg)/(eps*rho) + fs = -2._r8*eps*exp(-2._r8*eps*x0)*(wwub-(bogbot-gammaB/(2._r8*eps)+worg)/(eps*rho)) + & + (gammaB)/(eps*rho) + ! Sep.28.2010. Very rarely, fs = 0 happens. So, I added below fixer. + if( fs .ge. 0._r8 ) fs = max(fs, nonzero) + if( fs .lt. 0._r8 ) fs = min(fs,-nonzero) + x1 = x0 - f/fs + x0 = x1 + x0 = min( dpen, max( 0._r8, x0 ) ) + end do + endif + dp = x0 + + compute_dp = min( dpen, max( 0._r8, dp ) ) + +end function compute_dp + +!-------------------------------------------------------------------------------------------------- + +subroutine buosort_downdraft( cuL, cuU, enL, xdown_min, xdown_max ) + + ! -------------------------------------------------------------- ! + ! Perform buoyancy sorting of downdrafts and find the ranges of ! + ! mixing fraction, (xdown_min, xdown_max), where mixtures within ! + ! this range will move down into the base interface. ! + ! It must be and is that x = 0 is corresponding to cuL, while ! + ! x = 1 is corresponding to cuU. ! + ! Done. ! + ! -------------------------------------------------------------- ! + + real(r8), intent(in) :: cuL, cuU, enL + real(r8), intent(out) :: xdown_min, xdown_max + + if( cuU.gt.cuL ) then + xdown_min = 0._r8 + xdown_max = min(1._r8,max(0._r8,(enL-cuL)/(cuU-cuL))) + return + elseif( cuU.lt.cuL ) then + xdown_min = min(1._r8,max(0._r8,(enL-cuL)/(cuU-cuL))) + xdown_max = 1._r8 + return + elseif( cuU.eq.cuL ) then + if( cuU.lt.enL ) then + xdown_min = 0._r8 + xdown_max = 1._r8 + return + elseif( cuU.gt.enL ) then + xdown_min = 0._r8 + xdown_max = 0._r8 + return + else + ! Below can be any values between 0 <= x <= 1 + ! Apr.21.2011. xdown_min is changed to 0 instead of 0.5 as described in the text. + ! xdown_min = 0.5_r8 + xdown_min = 0.0_r8 + xdown_max = 0.5_r8 + return + endif + return + endif + +end subroutine buosort_downdraft + +!-------------------------------------------------------------------------------------------------- + +subroutine compute_PDF( PDFtype, zLL, zUU, zbar, zmass, zmass_L ) + + ! ---------------------------------------------------------------------------------------- ! + ! Compute mass-flux weighted (or equally, probability weighted) mean z ! + ! (zbar) and corrresponding mass fraction (zmass) within a given single ! + ! interval between (zL,zU). ! + ! The PDFtype is as follows: ! + ! 'PDFupG' : Updraft PDF with Gamma distribution ( 0 < z = alpha < alpha_max = 3 ) ! + ! 'PDFupW' : Updraft PDF with Weibull distri. ( 0 < z = alpha < alpha_max = 3 ) ! + ! 'PDFdnU' : Downdraft PDF with Uniform distri. ( 0 < z = alpha < 2 ) ! + ! 'PDFdnT' : Downdraft PDF with Triangular distri. ( 0 < z = alpha < 2 ) ! + ! 'PDFbsU' : Microscopic buoyancy sorting PDF with Uniform distri. ( 0 < z = x < 1 ) ! + ! 'PDFbsT' : Microscopic buoyancy sorting PDF with Triangular distri. ( 0 < z = x < 1 ) ! + ! 'PDFbsQ' : Microscopic buoyancy sorting PDF with Quadratic distri. ( 0 < z = x < 1 ) ! + ! 'PDFbsN' : Microscopic buoyancy sorting PDF with p=0.5 in symmetric beta distri. ! + ! ( 0 < z = x < 1 ) ! + ! Note that ! + ! x = 0 : cumulus core, ! + ! x = 1 : environmental mean ! + ! alpha = 0 : cumulus edge toward environment ! + ! alpha = 2 or 3 : cumulus core-edge away from the environment ! + ! As the most general application, I should use the following ! + ! symmetric beta distribution for microscopic buoyancy sorting ! + ! P(x) = (x*(1-x))**(p-1) / B(p,p) , p > 0, 0 <= x <= 1 ! + ! B(p,p) = Gamma(p)*Gamma(p)/Gamma(2*p) ! + ! B(0.1,0.1) = 19.7146, B(0.5,0.5) = 3.1416 ! + ! B(1,1) = 1, B(2,2) = 1/6 ! + ! This shows how much time the system has for mixing for a given ! + ! model time step dt. If 'p' increases, it means that the system has ! + ! more time for buoyancy sorting mixing. This 'p' can parameterized ! + ! as a function of timeres/dt. ! + ! Nov.04.2014. ! + ! Currently, only 'PDFbsU' and 'PDFbsQ' computes 'zmass_L'. So, only choose these two ! + ! options. Computation of 'zmass_L' for the other cases should be done later. ! + ! Done. ! + ! ---------------------------------------------------------------------------------------- ! + + character(len=6), intent(in) :: PDFtype + real(r8), intent(in) :: zLL, zUU + real(r8), intent(out) :: zbar, zmass, zmass_L + real(r8) zmax, Pn, zL, zU + + ! Take such that zU is always equal or larger than zL. + + zL = min(zLL,zUU) + zU = max(zLL,zUU) + + ! Main computation. + ! 'zmass' is fractional area (mass) surrounded by [zL,zU] + ! 'zbar' is PDF-weighted mean z in [zL,zU] + ! 'zmass_L' is fractional mass of the convective updraft (on the zL side) + + select case (PDFtype) + case ('PDFupG') + zmax = alpha_max + Pn = 1._r8 - exp(-2._r8*zmax)*(1._r8+2._r8*zmax) + ! Currently, below analytical formula is obtained only when gma = 2._r8 + zmass = (exp(-2._r8*zL)*(1._r8+2._r8*zL)-exp(-2._r8*zU)*(1._r8+2._r8*zU))/Pn + if( abs(zL-zU) .le. 1.e-10_r8 ) then + zbar = zL + zmass = 0._r8 + return + else + zbar = exp(-2._r8*zL)*(zL**2+zL+0.5_r8)-exp(-2._r8*zU)*(zU**2+zU+0.5_r8) + zbar = 2._r8*zbar/Pn/zmass + return + endif + case ('PDFdnU') + zmax = 2._r8 + zmass = 0.5_r8*(zU-zL) + zbar = 0.5_r8*(zU+zL) + return + case ('PDFbsU') + zmax = 1._r8 + zmass = 1.0_r8*(zU-zL) + zbar = 0.5_r8*(zU+zL) + zmass_L = zU-0.5_r8*zU**2-(zL-0.5_r8*zL**2) + return + case ('PDFbsQ') + zmax = 1._r8 + zmass = (3._r8*zU**2-2._r8*zU**3)-(3._r8*zL**2-2._r8*zL**3) + if( zmass .gt. 0._r8 ) then + zbar = 0.5_r8*((4._r8*zU**3-3._r8*zU**4)-(4._r8*zL**3-3._r8*zL**4))/zmass + else + zbar = 0.5_r8*(zL+zU) + endif + zmass_L = 3._r8*zU**2-4._r8*zU**3+1.5_r8*zU**4-(3._r8*zL**2-4._r8*zL**3+1.5_r8*zL**4) + return + case ('PDFbsN') + zmax = 1._r8 + zmass = 0.3183_r8*( asin(2._r8*zU-1._r8) - asin(2._r8*zL-1._r8) ) + if( zL .eq. 0._r8 .and. zU .eq. 1._r8 ) zmass = 1._r8 + zmass = max(0._r8,min(1._r8,zmass)) + if( zmass .gt. 0._r8 ) then + zbar = ( 0.5_r8*asin(2._r8*zU-1._r8) - sqrt(zU*(1._r8-zU)) - 0.5_r8*asin(2._r8*zL-1._r8) + sqrt(zL*(1._r8-zL)) ) / & + ( asin(2._r8*zU-1._r8) - asin(2._r8*zL-1._r8) ) + else + zbar = 0.5_r8*(zL+zU) + endif + return + + end select + +end subroutine compute_PDF + +!-------------------------------------------------------------------------------------------------- + +subroutine compute_epsdelnod( PDFtype, xc, epsnod, delnod ) + + ! ------------------------------------------------------------------ ! + ! Compute non-dimensional fraction entrainment and detrainment rate ! + ! for a given 'xc' and normalized symmetric PDF(x) within 0 < x < 1. ! + ! This is for microscopic buoyancy sorting. ! + ! The PDFtype is as follows: ! + ! 'PDFbsU' : PDF with Uniform distri. ( 0 < x < 1 ) ! + ! 'PDFbsT' : PDF with Triangular distri. ( 0 < x < 1 ) ! + ! 'PDFbsQ' : PDF with Quadratic distri. ( 0 < x < 1 ) ! + ! 'PDFbsN' : PDF with p=0.5 in symmetric beta distri. ( 0 < x < 1 ) ! + ! Note that ! + ! x = 0 : cumulus core, ! + ! x = 1 : environmental mean ! + ! In order to avoid infinite area at x = 1, either triangular or ! + ! quadratic distribution is better than the uniform distribution. ! + ! As the most general application, I should use the following ! + ! symmetric beta distribution: ! + ! P(x) = (x*(1-x))**(p-1) / B(p,p) , p > 0, 0 <= x <= 1 ! + ! B(p,p) = Gamma(p)*Gamma(p)/Gamma(2*p) ! + ! B(0.1,0.1) = 19.7146, B(0.5,0.5) = 3.1416 ! + ! B(1,1) = 1, B(2,2) = 1/6 ! + ! This shows how much time the system has for mixing for a given ! + ! model time step dt. If 'p' increases, it means that the system has ! + ! more time for buoyancy sorting mixing. This 'p' can parameterized ! + ! as a function of timeres/dt. ! + ! Done. ! + ! ------------------------------------------------------------------ ! + + character(len=6), intent(in) :: PDFtype + real(r8), intent(in) :: xc + real(r8), intent(out) :: epsnod, delnod + + ! Main computation. + ! 'epsnod' is non-dimensional fractional entrainment rate + ! 'delnod' is non-dimensional fractional detrainment rate + + select case (PDFtype) + case ('PDFbsU') + epsnod = xc**2 + delnod = (1._r8-xc)**2 + return + case ('PDFbsT') + if( xc .le. 0.5_r8 ) then + epsnod = (8._r8/3._r8)*xc**3 + delnod = 1._r8-4._r8*xc**2+(8._r8/3._r8)*xc**3 + return + else + epsnod = -1._r8/3._r8 + 4._r8*xc**2-(8._r8/3._r8)*xc**3 + delnod = (8._r8/3._r8)*(1._r8-xc)**3 + return + endif + return + case ('PDFbsQ') + epsnod = xc**3*(4._r8-3._r8*xc) + delnod = (1._r8-6._r8*xc**2+8._r8*xc**3-3._r8*xc**4) + return + case ('PDFbsN') + epsnod = 2._r8*0.3183_r8*(0.5_r8*asin(2._r8*xc-1._r8)-sqrt(xc*(1._r8-xc))-0.5_r8*asin(-1._r8)) + delnod = 1._r8 - 2._r8*0.3183_r8*(0.5_r8*asin(2._r8*xc-1._r8)+sqrt(xc*(1._r8-xc))-0.5_r8*asin(-1._r8)) + if( xc .eq. 0._r8 ) then + epsnod = 0._r8 + delnod = 1._r8 + elseif( xc .eq. 1._r8 ) then + epsnod = 1._r8 + delnod = 0._r8 + endif + epsnod = max(0._r8,min(1._r8,epsnod)) + delnod = max(0._r8,min(1._r8,delnod)) + return + end select + +end subroutine compute_epsdelnod + +!-------------------------------------------------------------------------------------------------- + +subroutine buosorts_UW(rbuoy,p,w_cu,thl_cu,qt_cu,w_eg,thl_eg,qt_eg,thv_en,cridis,xc,xs,thv_cu,thv_eg,thvxs) + + ! ---------------------------------------------------------------------- ! + ! Buoyancy Sorting Algorithm from UWShCu but can treat the case of ! + ! different 'thv_eg' and 'thv_en' for handling organized non-uniform ! + ! environmental airs being entrained. ! + ! This codes assumes that gamv_en = gamv_cu = 0 ! + ! Except this, this code is quite general and correct for any 'cridis', ! + ! and computationally efficient. So, I should use this code in my GCM. ! + ! For microscopic buoyancy sorting, ! + ! x = 0 : cumulsu ensemble-mean ! + ! x = 1 : non-uniform environmental value ! + ! Done. ! + ! May.03.2011. In order to save computation time, I changed the variable ! + ! names: thvxsat -> thvxs, thlxsat -> thlxs, qtxsat -> qtxs ! + ! xsat -> xs which does not change the answer. ! + ! Mar.11.2013. I added 'w_eg' to treat the effect of organized flow ! + ! within PBL. ! + ! ---------------------------------------------------------------------- ! + + real(r8), intent(in) :: rbuoy + real(r8), intent(in) :: w_cu, w_eg + real(r8), intent(in) :: thl_cu, thl_eg + real(r8), intent(in) :: qt_cu, qt_eg + real(r8), intent(in) :: cridis + real(r8), intent(in) :: p, thv_en + real(r8), intent(out) :: xc, xs, thv_cu, thv_eg, thvxs + integer id_check, status, kk + real(r8) thlxs, qtxs, x_cu, x_en, thv_x0, thv_x1 + real(r8) th, qv, ql, qi, qse + real(r8) aquad, bquad, cquad, xc1, xc2, excess_cu, excess_eg, xs1, xs2 + real(r8) es + real(r8) qs + real(r8) qsat_arg + real(r8) exn + + ! ---------------------------------------------------------------- ! + ! Calculate environmental and cumulus saturation. ! + ! Note that in order to calculate saturation excess, we should use ! + ! liquid water temperature instead of temperature as the argument ! + ! of "qsat". But note normal argument of "qsat" is temperature. ! + ! ---------------------------------------------------------------- ! + + exn = (p/p00)**rovcp + call conden(p,thl_eg,qt_eg,th,qv,ql,qi,qse,id_check) + thv_eg = th * ( 1._r8 + zvir*qv - ql - qi ) + qsat_arg = thl_eg*exn + call qsat(qsat_arg, p, es, qs) + excess_eg = qt_eg - qs + + call conden(p,thl_cu,qt_cu,th,qv,ql,qi,qse,id_check) + thv_cu = th * ( 1._r8 + zvir * qv - ql - qi ) + qsat_arg = thl_cu*exn + call qsat(qsat_arg, p, es, qs) + excess_cu = qt_cu - qs + + if( (excess_cu*excess_eg).lt.0._r8 ) then + ! May.03.2011. Regardless of the relative magnitude of 'excess_cu,excess_eg', it should be + ! xs = excess_cu / ( excess_cu - excess_eg ). In the mother code, this 'xs' + ! is also directly used to compute 'xe_min, xe_max'. So, below mistake can + ! influence actual model computation. I fixed this bug by commenting out + ! 4 lines in the below if block. + ! if( excess_cu .gt. excess_eg ) then + xs = excess_cu / ( excess_cu - excess_eg ); + ! else + ! xs = excess_eg / ( excess_eg - excess_cu ); + ! endif + ! May.03.2011. In order to be fully compatible with the mother routine that computes + ! 'xe_min, xe_max', I should set 'xs = 0' for all these cases. This also + ! removes the distinuity when excess_cu=excess_eg=0. Thus, I removed + ! below 5 lines and reset xs = 0. + ! else + ! xs = 0._r8 + ! endif + ! Below block is old code before May.03.2011. + ! May.16.2011. I restored to the 'old code, since 'xs = 1._r8' is also fully compatible with the + ! mother subroutine and correct even within this subroutine. + elseif( excess_cu.le.0._r8 .and. excess_eg.le.0._r8 ) then + xs = 0._r8 + elseif( excess_cu.ge.0._r8 .and. excess_eg.ge.0._r8 ) then + xs = 1._r8 + endif + + ! ----------------------------------------------------------------- ! + ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! + ! ----------------------------------------------------------------- ! + + thvxs = thv_cu + ! May.03.2011. In order to save computation time, I re-write below if line using the above newly computed 'xs', + ! which should produce identical results. + if( xs .eq. 0._r8 .or. xs .eq. 1._r8 ) then + ! if( ( excess_cu .le. 0._r8 .and. excess_eg .le. 0._r8 ) .or. ( excess_cu .ge. 0._r8 .and. excess_eg .ge. 0._r8 ) ) then + ! Below is the original UW code assuming 'thv_eg=thv_en' + ! xc = min(1._r8,max(0._r8,1._r8-2._r8*rbuoy*g*cridis/w_cu**2._r8*(1._r8-thv_cu/thv_en))) + ! Below is the revised code considering the difference between 'thv_eg' and 'thv_en' + thv_x0 = thv_cu; + thv_x1 = thv_eg; + ! aquad = w_cu**2; + ! bquad = 2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv_en - 2._r8*w_cu**2; + aquad = (w_cu-w_eg)**2; + bquad = 2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv_en - 2._r8*w_cu*(w_cu-w_eg); + cquad = 2._r8*rbuoy*g*cridis*(thv_x0 - thv_en)/thv_en + w_cu**2; + if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + xc = min(1._r8,max(0._r8,min(1._r8,min(xs1,xs2)))) + else + xc = 1._r8; + endif + else + ! -------------------------------------------------- ! + ! Case 2 : When either cumulus or env. is saturated. ! + ! -------------------------------------------------- ! + ! May.03.2011. I commented out below 'xs' since it is already computed above. + ! This will save computation time. + ! xs = excess_cu / ( excess_cu - excess_eg ); + thlxs = thl_cu + xs * ( thl_eg - thl_cu ); + qtxs = qt_cu + xs * ( qt_eg - qt_cu ); + call conden(p,thlxs,qtxs,th,qv,ql,qi,qse,id_check) + thvxs = th * ( 1._r8 + zvir * qv - ql - qi ) + ! -------------------------------------------------- ! + ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! + ! -------------------------------------------------- ! + do kk = 1, 2 + if( kk .eq. 1 ) then + thv_x0 = thv_cu; + thv_x1 = ( 1._r8 - 1._r8 / xs ) * thv_cu + ( 1._r8 / xs ) * thvxs; + else + thv_x1 = thv_eg; + thv_x0 = ( xs / ( xs - 1._r8 ) ) * thv_eg + ( 1._r8/( 1._r8 - xs ) ) * thvxs; + endif + ! aquad = w_cu**2._r8; + ! bquad = 2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv_en - 2._r8*w_cu**2._r8; + aquad = (w_cu-w_eg)**2._r8; + bquad = 2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv_en - 2._r8*w_cu*(w_cu-w_eg); + ! Below is the original UW code assuming 'thv_eg=thv_en' + ! cquad = 2._r8*rbuoy*g*cridis*(thv_x0 - thv_eg)/thv_en + w_cu**2._r8; + ! Below is the revised code considering the difference between 'thv_eg' and 'thv_en' + cquad = 2._r8*rbuoy*g*cridis*(thv_x0 - thv_en)/thv_en + w_cu**2._r8; + if( kk .eq. 1 ) then + if( ( bquad**2._r8-4._r8*aquad*cquad ) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_cu = min(1._r8,max(0._r8,min(xs,min(xs1,xs2)))) + else + x_cu = xs; + endif + else + if( ( bquad**2._r8-4._r8*aquad*cquad) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_en = min(1._r8,max(0._r8,max(xs,min(xs1,xs2)))) + else + x_en = 1._r8; + endif + endif + enddo + if( x_cu .eq. xs ) then + xc = max(x_cu, x_en); + else + xc = x_cu; + endif + endif + +end subroutine buosorts_UW + +!-------------------------------------------------------------------------------------------------- + +subroutine positive_moisture( & + cp, xlv, xls, pcols, ncol, mkx, dt, qvmin, qlmin, qimin, dp, qv, ql, qi, t, s, qvten, & + qlten, qiten, sten ) + + ! ------------------------------------------------------------------------------- ! + ! Author : Sungsu Park. AMP/CGD/NCAR. ! + ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, ! + ! force them to be larger than minimum value by (1) condensating water vapor ! + ! into liquid or ice, and (2) by transporting water vapor from the very lower ! + ! layer. '2._r8' is multiplied to the minimum values for safety. ! + ! Update final state variables and tendencies associated with this correction. ! + ! If any condensation happens, update (s,t) too. ! + ! Note that (qv,ql,qi,t,s) are final state variables after applying corresponding ! + ! input tendencies. ! + ! Be careful the order of k : '1': near-surface layer, 'mkx' : top layer ! + ! May.03.2011. Additional refinement is added in the lowest model layer for ! + ! complete treatment. ! + ! ------------------------------------------------------------------------------- ! + + integer, intent(in) :: pcols, ncol, mkx + real(r8), intent(in) :: cp, xlv, xls + real(r8), intent(in) :: dt, qvmin, qlmin, qimin + real(r8), intent(in) :: dp(pcols,mkx) + real(r8), intent(inout) :: qv(pcols,mkx), ql(pcols,mkx), qi(pcols,mkx), t(pcols,mkx), s(pcols,mkx) + real(r8), intent(inout) :: qvten(pcols,mkx), qlten(pcols,mkx), qiten(pcols,mkx), sten(pcols,mkx) + integer i, k + real(r8) dql, dqi, dqv, sum, aa, dum + + do i = 1, ncol + do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface + dql = max(0._r8,1._r8*qlmin-ql(i,k)) + dqi = max(0._r8,1._r8*qimin-qi(i,k)) + qlten(i,k) = qlten(i,k) + dql/dt + qiten(i,k) = qiten(i,k) + dqi/dt + qvten(i,k) = qvten(i,k) - (dql+dqi)/dt + sten(i,k) = sten(i,k) + xlv * (dql/dt) + xls * (dqi/dt) + ql(i,k) = ql(i,k) + dql + qi(i,k) = qi(i,k) + dqi + qv(i,k) = qv(i,k) - dql - dqi + s(i,k) = s(i,k) + xlv * dql + xls * dqi + t(i,k) = t(i,k) + (xlv * dql + xls * dqi)/cp + dqv = max(0._r8,1._r8*qvmin-qv(i,k)) + qvten(i,k) = qvten(i,k) + dqv/dt + qv(i,k) = qv(i,k) + dqv + if( k .ne. 1 ) then + qv(i,k-1) = qv(i,k-1) - dqv*dp(i,k)/dp(i,k-1) + qvten(i,k-1) = qvten(i,k-1) - dqv*dp(i,k)/dp(i,k-1)/dt + endif + qv(i,k) = max(qv(i,k),qvmin) + ql(i,k) = max(ql(i,k),qlmin) + qi(i,k) = max(qi(i,k),qimin) + end do + ! May.03.2011. Below block is additionally added for completeness. + ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally + ! extracted from all the layers that has 'qv > 2*qvmin'. This fully + ! preserves column moisture. + if( dqv .gt. 0._r8 ) then + sum = 0._r8 + do k = 1, mkx + if( qv(i,k) .gt. 2._r8*qvmin ) sum = sum + qv(i,k)*dp(i,k) + enddo + aa = dqv*dp(i,1)/max(1.e-20_r8,sum) + if( aa .lt. 0.5_r8 ) then + do k = 1, mkx + if( qv(i,k) .gt. 2._r8*qvmin ) then + dum = aa*qv(i,k) + qv(i,k) = qv(i,k) - dum + qvten(i,k) = qvten(i,k) - dum/dt + endif + enddo + else + write(iulog,*) 'Full positive_moisture is impossible in UNICON' + endif + endif + end do + +end subroutine positive_moisture + +!-------------------------------------------------------------------------------------------------- + +subroutine positive_tracer( pcols, ncol, mkx, dt, trmin, dp, tr, trten ) + + ! ------------------------------------------------------------------------------- ! + ! If any 'tr < trmin' are developed in any layer, force them to be larger than ! + ! minimum value by transporting water vapor from the very lower layer. ! + ! Update final state variables and tendencies associated with this correction. ! + ! Note that 'tr' is the final state variables after applying corresponding ! + ! input tendencies. ! + ! Be careful the order of k : '1': near-surface layer, 'mkx' : top layer ! + ! May.03.2011. Additional refinement is added in the lowest model layer for ! + ! complete treatment. ! + ! ------------------------------------------------------------------------------- ! + + integer, intent(in) :: pcols, ncol, mkx + real(r8), intent(in) :: dt, trmin + real(r8), intent(in) :: dp(pcols,mkx) + real(r8), intent(inout) :: tr(pcols,mkx) + real(r8), intent(inout) :: trten(pcols,mkx) + integer i, k + real(r8) dtr, sum, aa, dum + + do i = 1, ncol + do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface + dtr = max(0._r8,1._r8*trmin-tr(i,k)) + trten(i,k) = trten(i,k) + dtr/dt + tr(i,k) = tr(i,k) + dtr + if( k .ne. 1 ) then + tr(i,k-1) = tr(i,k-1) - dtr*dp(i,k)/dp(i,k-1) + trten(i,k-1) = trten(i,k-1) - dtr*dp(i,k)/dp(i,k-1)/dt + endif + tr(i,k) = max(tr(i,k),trmin) + end do + ! May.03.2011. Below block is additionally added for completeness. + ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally + ! extracted from all the layers that has 'qv > 2*qvmin'. This fully + ! preserves column moisture. + if( dtr .gt. 0._r8 ) then + sum = 0._r8 + do k = 1, mkx + if( tr(i,k) .gt. 2._r8*trmin ) sum = sum + tr(i,k)*dp(i,k) + enddo + aa = dtr*dp(i,1)/max(1.e-20_r8,sum) + if( aa .lt. 0.5_r8 ) then + do k = 1, mkx + if( tr(i,k) .gt. 2._r8*trmin ) then + dum = aa*tr(i,k) + tr(i,k) = tr(i,k) - dum + trten(i,k) = trten(i,k) - dum/dt + endif + enddo + else + ! write(iulog,*) 'Full positive_tracer is impossible in UNICON' + endif + endif + end do + +end subroutine positive_tracer + +!-------------------------------------------------------------------------------------------------- + +subroutine findsp_single( q, t, p, tsp, qsp, i_in, k_in, lchnk ) + + ! Wrapper for the findsp subroutine in wv_saturation. + + integer , intent(in) :: lchnk + integer , intent(in) :: i_in, k_in + real(r8), intent(in) :: q ! Water vapor [kg/kg] + real(r8), intent(in) :: t ! Temperature [K] + real(r8), intent(in) :: p ! Pressure [Pa] + + real(r8), intent(out) :: tsp ! Saturation temp [K] + real(r8), intent(out) :: qsp ! Saturation mixing ratio [kg/kg] + + logical :: use_ice = .true. + integer :: status + !------------------------------------------------------------------------------ + + call findsp(q, t, p, use_ice, tsp, qsp, status) + + ! Currently, only 2 and 8 seem to be treated as fatal errors. + if (status == 2) then + write(iulog,*) ' findsp not converging at i,k,lchnk = ', i_in, k_in, lchnk + write(iulog,*) ' t, q, p ', t, q, p + write(iulog,*) ' tsp, qsp ', tsp, qsp + call endrun('findsp_single:: not converging') + else if (status == 8) then + write(iulog,*) ' the enthalpy is not conserved at i,k,lchnk = ', i_in, k_in, lchnk + write(iulog,*) ' t, q, p ', t, q, p + write(iulog,*) ' tsp, qsp ', tsp, qsp + call endrun('findsp_single:: enthalpy is not conserved') + endif + +end subroutine findsp_single + +!================================================================================================== +! Internal utilities +!================================================================================================== + +subroutine roots(a,b,c,r1,r2,status) + + ! --------------------------------------------------------- ! + ! Subroutine to solve the second order polynomial equation. ! + ! I should check this subroutine later. ! + ! Done. ! + ! --------------------------------------------------------- ! + + real(r8), intent(in) :: a + real(r8), intent(in) :: b + real(r8), intent(in) :: c + real(r8), intent(out) :: r1 + real(r8), intent(out) :: r2 + integer , intent(out) :: status + real(r8) :: q, rmin, rmax + + r1 = 0._r8 + r2 = 0._r8 + status = 0 + if(a .eq. 0) then ! Form b*x + c = 0 + if(b .eq. 0) then ! Failure: c = 0 + status = 1 + else ! b*x + c = 0 + r1 = -c/b + r2 = r1 + endif + else + if(b .eq. 0._r8) then ! Form a*x**2 + c = 0 + if(a*c .gt. 0._r8) then ! Failure: x**2 = -c/a < 0 + status = 2 + else ! x**2 = -c/a + r1 = sqrt(-c/a) + r2 = -r1 + endif + else ! Form a*x**2 + b*x + c = 0 + if((b**2 - 4._r8*a*c) .lt. 0._r8) then ! Failure, no real roots + status = 3 + else + q = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c)) + r1 = q/a + r2 = c/q + endif + endif + endif + + rmin = min(r1,r2) + rmax = max(r1,r2) + r1 = rmin + r2 = rmax + +end subroutine roots + +!-------------------------------------------------------------------------------------------------- + +end module unicon_utils diff --git a/src/physics/cam/uwshcu.F90 b/src/physics/cam/uwshcu.F90 new file mode 100644 index 0000000000..914d131a94 --- /dev/null +++ b/src/physics/cam/uwshcu.F90 @@ -0,0 +1,5111 @@ + module uwshcu + + use shr_spfn_mod, only: erfc => shr_spfn_erfc + use cam_logfile, only: iulog + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use wv_saturation, only: qsat + + + implicit none + private + save + + public & + uwshcu_readnl, & + init_uwshcu, & + compute_uwshcu, & + compute_uwshcu_inv + + integer , parameter :: r8 = selected_real_kind(12) ! 8 byte real + real(r8), parameter :: unset_r8 = huge(1.0_r8) + real(r8) :: xlv ! Latent heat of vaporization + real(r8) :: xlf ! Latent heat of fusion + real(r8) :: xls ! Latent heat of sublimation = xlv + xlf + real(r8) :: cp ! Specific heat of dry air + real(r8) :: zvir ! rh2o/rair - 1 + real(r8) :: r ! Gas constant for dry air + real(r8) :: g ! Gravitational constant + real(r8) :: ep2 ! mol wgt water vapor / mol wgt dry air + real(r8) :: p00 ! Reference pressure for exner function + real(r8) :: rovcp ! R/cp + + ! Tuning parameters set via namelist + real(r8) :: rpen ! For penetrative entrainment efficiency + +!=============================================================================== +contains +!=============================================================================== + + real(r8) function exnf(pressure) + real(r8), intent(in) :: pressure + exnf = (pressure/p00)**rovcp + return + end function exnf + +!=============================================================================== + +subroutine uwshcu_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'uwshcu_readnl' + + ! Namelist variables + real(r8) :: uwshcu_rpen = unset_r8 ! For penetrative entrainment efficiency + + namelist /uwshcu_nl/ uwshcu_rpen + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'uwshcu_nl', status=ierr) + if (ierr == 0) then + read(unitn, uwshcu_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(uwshcu_rpen, 1, mpir8, 0, mpicom) +#endif + + rpen=uwshcu_rpen + + +end subroutine uwshcu_readnl + +!=============================================================================== + + subroutine init_uwshcu( kind, xlv_in, cp_in, xlf_in, zvir_in, r_in, g_in, ep2_in ) + + !------------------------------------------------------------- ! + ! Purpose: ! + ! Initialize key constants for the shallow convection package. ! + !------------------------------------------------------------- ! + + use cam_history, only: addfld, horiz_only + implicit none + integer , intent(in) :: kind ! kind of reals being passed in + real(r8), intent(in) :: xlv_in ! Latent heat of vaporization + real(r8), intent(in) :: xlf_in ! Latent heat of fusion + real(r8), intent(in) :: cp_in ! Specific heat of dry air + real(r8), intent(in) :: zvir_in ! rh2o/rair - 1 + real(r8), intent(in) :: r_in ! Gas constant for dry air + real(r8), intent(in) :: g_in ! Gravitational constant + real(r8), intent(in) :: ep2_in ! mol wgt water vapor / mol wgt dry air + + character(len=*), parameter :: subname = 'init_uwshcu' + + ! ------------------------- ! + ! Internal Output Variables ! + ! ------------------------- ! + + call addfld( 'qtflx_Cu' , (/ 'ilev' /), 'A', 'kg/m2/s' , 'Convective qt flux' ) + call addfld( 'slflx_Cu' , (/ 'ilev' /), 'A', 'J/m2/s' , 'Convective sl flux' ) + call addfld( 'uflx_Cu' , (/ 'ilev' /), 'A', 'kg/m/s2' , 'Convective u flux' ) + call addfld( 'vflx_Cu' , (/ 'ilev' /), 'A', 'kg/m/s2' , 'Convective v flux' ) + + call addfld( 'qtten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qt tendency by convection' ) + call addfld( 'slten_Cu' , (/ 'lev' /), 'A', 'J/kg/s' , 'sl tendency by convection' ) + call addfld( 'uten_Cu' , (/ 'lev' /), 'A', 'm/s2' , ' u tendency by convection' ) + call addfld( 'vten_Cu' , (/ 'lev' /), 'A', 'm/s2' , ' v tendency by convection' ) + call addfld( 'qvten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qv tendency by convection' ) + call addfld( 'qlten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'ql tendency by convection' ) + call addfld( 'qiten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'qi tendency by convection' ) + + call addfld( 'cbmf_Cu' , horiz_only, 'A', 'kg/m2/s' , 'Cumulus base mass flux' ) + call addfld( 'ufrcinvbase_Cu' , horiz_only, 'A', 'fraction', 'Cumulus fraction at PBL top' ) + call addfld( 'ufrclcl_Cu' , horiz_only, 'A', 'fraction', 'Cumulus fraction at LCL' ) + call addfld( 'winvbase_Cu' , horiz_only, 'A', 'm/s' , 'Cumulus vertical velocity at PBL top' ) + call addfld( 'wlcl_Cu' , horiz_only, 'A', 'm/s' , 'Cumulus vertical velocity at LCL' ) + call addfld( 'plcl_Cu' , horiz_only, 'A', 'Pa' , 'LCL of source air' ) + call addfld( 'pinv_Cu' , horiz_only, 'A', 'Pa' , 'PBL top pressure' ) + call addfld( 'plfc_Cu' , horiz_only, 'A', 'Pa' , 'LFC of source air' ) + call addfld( 'pbup_Cu' , horiz_only, 'A', 'Pa' , 'Highest interface level of positive cumulus buoyancy' ) + call addfld( 'ppen_Cu' , horiz_only, 'A', 'Pa' , 'Highest level where cumulus w is 0' ) + call addfld( 'qtsrc_Cu' , horiz_only, 'A', 'kg/kg' , 'Cumulus source air qt' ) + call addfld( 'thlsrc_Cu' , horiz_only, 'A', 'K' , 'Cumulus source air thl' ) + call addfld( 'thvlsrc_Cu' , horiz_only, 'A', 'K' , 'Cumulus source air thvl' ) + call addfld( 'emfkbup_Cu' , horiz_only, 'A', 'kg/m2/s' , 'Penetrative mass flux at kbup' ) + call addfld( 'cin_Cu' , horiz_only, 'A', 'J/kg' , 'CIN upto LFC' ) + call addfld( 'cinlcl_Cu' , horiz_only, 'A', 'J/kg' , 'CIN upto LCL' ) + call addfld( 'cbmflimit_Cu' , horiz_only, 'A', 'kg/m2/s' , 'cbmflimiter' ) + call addfld( 'tkeavg_Cu' , horiz_only, 'A', 'm2/s2' , 'Average tke within PBL for convection scheme' ) + call addfld( 'zinv_Cu' , horiz_only, 'A', 'm' , 'PBL top height' ) + call addfld( 'rcwp_Cu' , horiz_only, 'A', 'kg/m2' , 'Cumulus LWP+IWP' ) + call addfld( 'rlwp_Cu' , horiz_only, 'A', 'kg/m2' , 'Cumulus LWP' ) + call addfld( 'riwp_Cu' , horiz_only, 'A', 'kg/m2' , 'Cumulus IWP' ) + call addfld( 'tophgt_Cu' , horiz_only, 'A', 'm' , 'Cumulus top height' ) + + call addfld( 'wu_Cu' , (/ 'ilev' /), 'A', 'm/s' , 'Convective updraft vertical velocity' ) + call addfld( 'ufrc_Cu' , (/ 'ilev' /), 'A', 'fraction', 'Convective updraft fractional area' ) + call addfld( 'qtu_Cu' , (/ 'ilev' /), 'A', 'kg/kg' , 'Cumulus updraft qt' ) + call addfld( 'thlu_Cu' , (/ 'ilev' /), 'A', 'K' , 'Cumulus updraft thl' ) + call addfld( 'thvu_Cu' , (/ 'ilev' /), 'A', 'K' , 'Cumulus updraft thv' ) + call addfld( 'uu_Cu' , (/ 'ilev' /), 'A', 'm/s' , 'Cumulus updraft uwnd' ) + call addfld( 'vu_Cu' , (/ 'ilev' /), 'A', 'm/s' , 'Cumulus updraft vwnd' ) + call addfld( 'qtu_emf_Cu' , (/ 'ilev' /), 'A', 'kg/kg' , 'qt of penatratively entrained air' ) + call addfld( 'thlu_emf_Cu' , (/ 'ilev' /), 'A', 'K' , 'thl of penatratively entrained air' ) + call addfld( 'uu_emf_Cu' , (/ 'ilev' /), 'A', 'm/s' , 'uwnd of penatratively entrained air' ) + call addfld( 'vu_emf_Cu' , (/ 'ilev' /), 'A', 'm/s' , 'vwnd of penatratively entrained air' ) + call addfld( 'umf_Cu' , (/ 'ilev' /), 'A', 'kg/m2/s' , 'Cumulus updraft mass flux' ) + call addfld( 'uemf_Cu' , (/ 'ilev' /), 'A', 'kg/m2/s' , 'Cumulus net ( updraft + entrainment ) mass flux' ) + call addfld( 'qcu_Cu' , (/ 'lev' /), 'A', 'kg/kg' , 'Cumulus updraft LWC+IWC' ) + call addfld( 'qlu_Cu' , (/ 'lev' /), 'A', 'kg/kg' , 'Cumulus updraft LWC' ) + call addfld( 'qiu_Cu' , (/ 'lev' /), 'A', 'kg/kg' , 'Cumulus updraft IWC' ) + call addfld( 'cufrc_Cu' , (/ 'lev' /), 'A', 'fraction', 'Cumulus cloud fraction' ) + call addfld( 'fer_Cu' , (/ 'lev' /), 'A', '1/m' , 'Cumulus lateral fractional entrainment rate' ) + call addfld( 'fdr_Cu' , (/ 'lev' /), 'A', '1/m' , 'Cumulus lateral fractional detrainment Rate' ) + + call addfld( 'dwten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Expellsion rate of cumulus cloud water to env.' ) + call addfld( 'diten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Expellsion rate of cumulus ice water to env.' ) + call addfld( 'qrten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Production rate of rain by cumulus' ) + call addfld( 'qsten_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Production rate of snow by cumulus' ) + call addfld( 'flxrain_Cu' , (/ 'ilev' /), 'A', 'kg/m2/s' , 'Rain flux induced by Cumulus' ) + call addfld( 'flxsnow_Cu' , (/ 'ilev' /), 'A', 'kg/m2/s' , 'Snow flux induced by Cumulus' ) + call addfld( 'ntraprd_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Net production rate of rain by Cumulus' ) + call addfld( 'ntsnprd_Cu' , (/ 'lev' /), 'A', 'kg/kg/s' , 'Net production rate of snow by Cumulus' ) + + call addfld( 'excessu_Cu' , (/ 'lev' /), 'A', 'no' , 'Updraft saturation excess' ) + call addfld( 'excess0_Cu' , (/ 'lev' /), 'A', 'no' , 'Environmental saturation excess' ) + call addfld( 'xc_Cu' , (/ 'lev' /), 'A', 'no' , 'Critical mixing ratio' ) + call addfld( 'aquad_Cu' , (/ 'lev' /), 'A', 'no' , 'aquad' ) + call addfld( 'bquad_Cu' , (/ 'lev' /), 'A', 'no' , 'bquad' ) + call addfld( 'cquad_Cu' , (/ 'lev' /), 'A', 'no' , 'cquad' ) + call addfld( 'bogbot_Cu' , (/ 'lev' /), 'A', 'no' , 'Cloud buoyancy at the bottom interface' ) + call addfld( 'bogtop_Cu' , (/ 'lev' /), 'A', 'no' , 'Cloud buoyancy at the top interface' ) + + call addfld('exit_UWCu_Cu' , horiz_only, 'A', 'no' , 'exit_UWCu' ) + call addfld('exit_conden_Cu' , horiz_only, 'A', 'no' , 'exit_conden' ) + call addfld('exit_klclmkx_Cu' , horiz_only, 'A', 'no' , 'exit_klclmkx' ) + call addfld('exit_klfcmkx_Cu' , horiz_only, 'A', 'no' , 'exit_klfcmkx' ) + call addfld('exit_ufrc_Cu' , horiz_only, 'A', 'no' , 'exit_ufrc' ) + call addfld('exit_wtw_Cu' , horiz_only, 'A', 'no' , 'exit_wtw' ) + call addfld('exit_drycore_Cu' , horiz_only, 'A', 'no' , 'exit_drycore' ) + call addfld('exit_wu_Cu' , horiz_only, 'A', 'no' , 'exit_wu' ) + call addfld('exit_cufilter_Cu', horiz_only, 'A', 'no' , 'exit_cufilter' ) + call addfld('exit_kinv1_Cu' , horiz_only, 'A', 'no' , 'exit_kinv1' ) + call addfld('exit_rei_Cu' , horiz_only, 'A', 'no' , 'exit_rei' ) + + call addfld('limit_shcu_Cu' , horiz_only, 'A', 'no' , 'limit_shcu' ) + call addfld('limit_negcon_Cu' , horiz_only, 'A', 'no' , 'limit_negcon' ) + call addfld('limit_ufrc_Cu' , horiz_only, 'A', 'no' , 'limit_ufrc' ) + call addfld('limit_ppen_Cu' , horiz_only, 'A', 'no' , 'limit_ppen' ) + call addfld('limit_emf_Cu' , horiz_only, 'A', 'no' , 'limit_emf' ) + call addfld('limit_cinlcl_Cu' , horiz_only, 'A', 'no' , 'limit_cinlcl' ) + call addfld('limit_cin_Cu' , horiz_only, 'A', 'no' , 'limit_cin' ) + call addfld('limit_cbmf_Cu' , horiz_only, 'A', 'no' , 'limit_cbmf' ) + call addfld('limit_rei_Cu' , horiz_only, 'A', 'no' , 'limit_rei' ) + call addfld('ind_delcin_Cu' , horiz_only, 'A', 'no' , 'ind_delcin' ) + + if( kind .ne. r8 ) then + write(iulog,*) subname//': ERROR -- real KIND does not match internal specification.' + call endrun(subname//': ERROR -- real KIND does not match internal specification.') + endif + + xlv = xlv_in + xlf = xlf_in + xls = xlv + xlf + cp = cp_in + zvir = zvir_in + r = r_in + g = g_in + ep2 = ep2_in + p00 = 1.e5_r8 + rovcp = r/cp + + if (rpen == unset_r8) then + call endrun(subname//': uwshcu_rpen must be set in the namelist') + end if + + if ( masterproc ) then + write(iulog,*) subname//': tuning parameters: rpen=',rpen + endif + + end subroutine init_uwshcu + + subroutine compute_uwshcu_inv( mix , mkx , iend , ncnst , dt , & + ps0_inv , zs0_inv , p0_inv , z0_inv , dp0_inv , & + u0_inv , v0_inv , qv0_inv , ql0_inv , qi0_inv , & + t0_inv , s0_inv , tr0_inv , & + tke_inv , cldfrct_inv, concldfrct_inv, pblh , cush , & + umf_inv , slflx_inv , qtflx_inv , & + flxprc1_inv, flxsnow1_inv, & + qvten_inv, qlten_inv , qiten_inv , & + sten_inv , uten_inv , vten_inv , trten_inv , & + qrten_inv, qsten_inv , precip , snow , evapc_inv, & + cufrc_inv, qcu_inv , qlu_inv , qiu_inv , & + cbmf , qc_inv , rliq , & + cnt_inv , cnb_inv , lchnk , dpdry0_inv, & + sh_e_ed_ratio ) + + implicit none + integer , intent(in) :: lchnk + integer , intent(in) :: mix + integer , intent(in) :: mkx + integer , intent(in) :: iend + integer , intent(in) :: ncnst + real(r8), intent(in) :: dt ! Time step : 2*delta_t [ s ] + real(r8), intent(in) :: ps0_inv(mix,mkx+1) ! Environmental pressure at the interfaces [ Pa ] + real(r8), intent(in) :: zs0_inv(mix,mkx+1) ! Environmental height at the interfaces [ m ] + real(r8), intent(in) :: p0_inv(mix,mkx) ! Environmental pressure at the layer mid-point [ Pa ] + real(r8), intent(in) :: z0_inv(mix,mkx) ! Environmental height at the layer mid-point [ m ] + real(r8), intent(in) :: dp0_inv(mix,mkx) ! Environmental layer pressure thickness [ Pa ] > 0. + real(r8), intent(in) :: dpdry0_inv(mix,mkx) ! Environmental dry layer pressure thickness [ Pa ] + real(r8), intent(in) :: u0_inv(mix,mkx) ! Environmental zonal wind [ m/s ] + real(r8), intent(in) :: v0_inv(mix,mkx) ! Environmental meridional wind [ m/s ] + real(r8), intent(in) :: qv0_inv(mix,mkx) ! Environmental water vapor specific humidity [ kg/kg ] + real(r8), intent(in) :: ql0_inv(mix,mkx) ! Environmental liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: qi0_inv(mix,mkx) ! Environmental ice specific humidity [ kg/kg ] + real(r8), intent(in) :: t0_inv(mix,mkx) ! Environmental temperature [ K ] + real(r8), intent(in) :: s0_inv(mix,mkx) ! Environmental dry static energy [ J/kg ] + real(r8), intent(in) :: tr0_inv(mix,mkx,ncnst) ! Environmental tracers [ #, kg/kg ] + real(r8), intent(in) :: tke_inv(mix,mkx+1) ! Turbulent kinetic energy at the interfaces [ m2/s2 ] + real(r8), intent(in) :: cldfrct_inv(mix,mkx) ! Total cloud fraction at the previous time step [ fraction ] + real(r8), intent(in) :: concldfrct_inv(mix,mkx) ! Total convective ( shallow + deep ) cloud fraction + ! at the previous time step [ fraction ] + real(r8), intent(in) :: pblh(mix) ! Height of PBL [ m ] + real(r8), intent(inout) :: cush(mix) ! Convective scale height [ m ] + real(r8), intent(out) :: umf_inv(mix,mkx+1) ! Updraft mass flux at the interfaces [ kg/m2/s ] + real(r8), intent(out) :: qvten_inv(mix,mkx) ! Tendency of water vapor specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qlten_inv(mix,mkx) ! Tendency of liquid water specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qiten_inv(mix,mkx) ! Tendency of ice specific humidity [ kg/kg/s ] + real(r8), intent(out) :: sten_inv(mix,mkx) ! Tendency of dry static energy [ J/kg/s ] + real(r8), intent(out) :: uten_inv(mix,mkx) ! Tendency of zonal wind [ m/s2 ] + real(r8), intent(out) :: vten_inv(mix,mkx) ! Tendency of meridional wind [ m/s2 ] + real(r8), intent(out) :: trten_inv(mix,mkx,ncnst) ! Tendency of tracers [ #/s, kg/kg/s ] + real(r8), intent(out) :: qrten_inv(mix,mkx) ! Tendency of rain water specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qsten_inv(mix,mkx) ! Tendency of snow specific humidity [ kg/kg/s ] + real(r8), intent(out) :: precip(mix) ! Precipitation ( rain + snow ) flux at the surface [ m/s ] + real(r8), intent(out) :: snow(mix) ! Snow flux at the surface [ m/s ] + real(r8), intent(out) :: evapc_inv(mix,mkx) ! Evaporation of precipitation [ kg/kg/s ] + real(r8), intent(out) :: rliq(mix) ! Vertical integral of tendency of detrained cloud condensate qc [ m/s ] + real(r8), intent(out) :: slflx_inv(mix,mkx+1) ! Updraft liquid static energy flux [ J/kg * kg/m2/s ] + real(r8), intent(out) :: qtflx_inv(mix,mkx+1) ! Updraft total water flux [ kg/kg * kg/m2/s ] + real(r8), intent(out) :: flxprc1_inv(mix,mkx+1) ! uw grid-box mean rain+snow flux (kg m^-2 s^-1) + ! for physics buffer calls in convect_shallow.F90 + real(r8), intent(out) :: flxsnow1_inv(mix,mkx+1) ! uw grid-box mean snow flux (kg m^-2 s^-1) + ! for physics buffer calls in convect_shallow.F90 + + real(r8), intent(out) :: cufrc_inv(mix,mkx) ! Shallow cumulus cloud fraction at the layer mid-point [ fraction ] + real(r8), intent(out) :: qcu_inv(mix,mkx) ! Liquid+ice specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: qlu_inv(mix,mkx) ! Liquid water specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: qiu_inv(mix,mkx) ! Ice specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: qc_inv(mix,mkx) ! Tendency of cumulus condensate detrained into the environment [ kg/kg/s ] + real(r8), intent(out) :: cbmf(mix) ! Cumulus base mass flux [ kg/m2/s ] + real(r8), intent(out) :: cnt_inv(mix) ! Cumulus top interface index, cnt = kpen [ no ] + real(r8), intent(out) :: cnb_inv(mix) ! Cumulus base interface index, cnb = krel - 1 [ no ] + + real(r8), intent(out) :: sh_e_ed_ratio(mix,mkx) ! shallow conv [ent/(ent+det)] ratio + + + real(r8) :: ps0(mix,0:mkx) ! Environmental pressure at the interfaces [ Pa ] + real(r8) :: zs0(mix,0:mkx) ! Environmental height at the interfaces [ m ] + real(r8) :: p0(mix,mkx) ! Environmental pressure at the layer mid-point [ Pa ] + real(r8) :: z0(mix,mkx) ! Environmental height at the layer mid-point [ m ] + real(r8) :: dp0(mix,mkx) ! Environmental layer pressure thickness [ Pa ] > 0. + real(r8) :: dpdry0(mix,mkx) ! Environmental dry layer pressure thickness [ Pa ] + real(r8) :: u0(mix,mkx) ! Environmental zonal wind [ m/s ] + real(r8) :: v0(mix,mkx) ! Environmental meridional wind [ m/s ] + real(r8) :: tke(mix,0:mkx) ! Turbulent kinetic energy at the interfaces [ m2/s2 ] + real(r8) :: cldfrct(mix,mkx) ! Total cloud fraction at the previous time step [ fraction ] + real(r8) :: concldfrct(mix,mkx) ! Total convective ( shallow + deep ) cloud fraction + ! at the previous time step [ fraction ] + real(r8) :: qv0(mix,mkx) ! Environmental water vapor specific humidity [ kg/kg ] + real(r8) :: ql0(mix,mkx) ! Environmental liquid water specific humidity [ kg/kg ] + real(r8) :: qi0(mix,mkx) ! Environmental ice specific humidity [ kg/kg ] + real(r8) :: t0(mix,mkx) ! Environmental temperature [ K ] + real(r8) :: s0(mix,mkx) ! Environmental dry static energy [ J/kg ] + real(r8) :: tr0(mix,mkx,ncnst) ! Environmental tracers [ #, kg/kg ] + real(r8) :: umf(mix,0:mkx) ! Updraft mass flux at the interfaces [ kg/m2/s ] + real(r8) :: qvten(mix,mkx) ! Tendency of water vapor specific humidity [ kg/kg/s ] + real(r8) :: qlten(mix,mkx) ! Tendency of liquid water specific humidity [ kg/kg/s ] + real(r8) :: qiten(mix,mkx) ! tendency of ice specific humidity [ kg/kg/s ] + real(r8) :: sten(mix,mkx) ! Tendency of static energy [ J/kg/s ] + real(r8) :: uten(mix,mkx) ! Tendency of zonal wind [ m/s2 ] + real(r8) :: vten(mix,mkx) ! Tendency of meridional wind [ m/s2 ] + real(r8) :: trten(mix,mkx,ncnst) ! Tendency of tracers [ #/s, kg/kg/s ] + real(r8) :: qrten(mix,mkx) ! Tendency of rain water specific humidity [ kg/kg/s ] + real(r8) :: qsten(mix,mkx) ! Tendency of snow speficif humidity [ kg/kg/s ] + real(r8) :: evapc(mix,mkx) ! Tendency of evaporation of precipitation [ kg/kg/s ] + real(r8) :: slflx(mix,0:mkx) ! Updraft liquid static energy flux [ J/kg * kg/m2/s ] + real(r8) :: qtflx(mix,0:mkx) ! Updraft total water flux [ kg/kg * kg/m2/s ] + real(r8) :: flxprc1(mix,0:mkx) ! uw grid-box mean rain+snow flux (kg m^-2 s^-1) + ! for physics buffer calls in convect_shallow.F90 + real(r8) :: flxsnow1(mix,0:mkx) ! uw grid-box mean snow flux (kg m^-2 s^-1) + ! for physics buffer calls in convect_shallow.F90 + real(r8) :: cufrc(mix,mkx) ! Shallow cumulus cloud fraction at the layer mid-point [ fraction ] + real(r8) :: qcu(mix,mkx) ! Condensate water specific humidity within cumulus updraft + ! at the layer mid-point [ kg/kg ] + real(r8) :: qlu(mix,mkx) ! Liquid water specific humidity within cumulus updraft + ! at the layer mid-point [ kg/kg ] + real(r8) :: qiu(mix,mkx) ! Ice specific humidity within cumulus updraft + ! at the layer mid-point [ kg/kg ] + real(r8) :: qc(mix,mkx) ! Tendency of cumulus condensate detrained into the environment [ kg/kg/s ] + real(r8) :: cnt(mix) ! Cumulus top interface index, cnt = kpen [ no ] + real(r8) :: cnb(mix) ! Cumulus base interface index, cnb = krel - 1 [ no ] + + real(r8) :: fer_out(mix,mkx) ! Fractional lateral entrainment rate [ 1/Pa ] + real(r8) :: fdr_out(mix,mkx) ! Fractional lateral detrainment rate [ 1/Pa ] + + integer :: i + integer :: k ! Vertical index for local fields [ no ] + integer :: k_inv ! Vertical index for incoming fields [ no ] + integer :: m ! Tracer index [ no ] + + do k = 1, mkx + k_inv = mkx + 1 - k + p0(:iend,k) = p0_inv(:iend,k_inv) + u0(:iend,k) = u0_inv(:iend,k_inv) + v0(:iend,k) = v0_inv(:iend,k_inv) + z0(:iend,k) = z0_inv(:iend,k_inv) + dp0(:iend,k) = dp0_inv(:iend,k_inv) + dpdry0(:iend,k) = dpdry0_inv(:iend,k_inv) + qv0(:iend,k) = qv0_inv(:iend,k_inv) + ql0(:iend,k) = ql0_inv(:iend,k_inv) + qi0(:iend,k) = qi0_inv(:iend,k_inv) + t0(:iend,k) = t0_inv(:iend,k_inv) + s0(:iend,k) = s0_inv(:iend,k_inv) + cldfrct(:iend,k) = cldfrct_inv(:iend,k_inv) + concldfrct(:iend,k) = concldfrct_inv(:iend,k_inv) + do m = 1, ncnst + tr0(:iend,k,m) = tr0_inv(:iend,k_inv,m) + enddo + enddo + + do k = 0, mkx + k_inv = mkx + 1 - k + ps0(:iend,k) = ps0_inv(:iend,k_inv) + zs0(:iend,k) = zs0_inv(:iend,k_inv) + tke(:iend,k) = tke_inv(:iend,k_inv) + end do + + call compute_uwshcu( mix , mkx , iend , ncnst , dt , & + ps0 , zs0 , p0 , z0 , dp0 , & + u0 , v0 , qv0 , ql0 , qi0 , & + t0 , s0 , tr0 , & + tke , cldfrct, concldfrct, pblh , cush , & + umf , slflx , qtflx , & + flxprc1 , flxsnow1 , & + qvten, qlten , qiten , & + sten , uten , vten , trten , & + qrten, qsten , precip , snow , evapc, & + cufrc, qcu , qlu , qiu , & + cbmf , qc , rliq , & + cnt , cnb , lchnk , dpdry0, & + fer_out, fdr_out ) + + ! Reverse cloud top/base interface indices + + cnt_inv(:iend) = mkx + 1 - cnt(:iend) + cnb_inv(:iend) = mkx + 1 - cnb(:iend) + + do k = 0, mkx + k_inv = mkx + 1 - k + umf_inv(:iend,k_inv) = umf(:iend,k) + slflx_inv(:iend,k_inv) = slflx(:iend,k) + qtflx_inv(:iend,k_inv) = qtflx(:iend,k) + flxprc1_inv(:iend,k_inv) = flxprc1(:iend,k) ! reversed for output to cam + flxsnow1_inv(:iend,k_inv) = flxsnow1(:iend,k) ! "" + end do + + do k = 1, mkx + k_inv = mkx + 1 - k + qvten_inv(:iend,k_inv) = qvten(:iend,k) + qlten_inv(:iend,k_inv) = qlten(:iend,k) + qiten_inv(:iend,k_inv) = qiten(:iend,k) + sten_inv(:iend,k_inv) = sten(:iend,k) + uten_inv(:iend,k_inv) = uten(:iend,k) + vten_inv(:iend,k_inv) = vten(:iend,k) + qrten_inv(:iend,k_inv) = qrten(:iend,k) + qsten_inv(:iend,k_inv) = qsten(:iend,k) + evapc_inv(:iend,k_inv) = evapc(:iend,k) + cufrc_inv(:iend,k_inv) = cufrc(:iend,k) + qcu_inv(:iend,k_inv) = qcu(:iend,k) + qlu_inv(:iend,k_inv) = qlu(:iend,k) + qiu_inv(:iend,k_inv) = qiu(:iend,k) + qc_inv(:iend,k_inv) = qc(:iend,k) + do m = 1, ncnst + trten_inv(:iend,k_inv,m) = trten(:iend,k,m) + enddo + + enddo + + sh_e_ed_ratio(:iend,:) = -1.0_r8 + do k = 1, mkx + do i = 1, iend + if ( max(fer_out(i,k),fdr_out(i,k)) > 1.0e-10_r8) then + sh_e_ed_ratio(i,k) = max(fer_out(i,k),0.0_r8) & + / (max(fer_out(i,k),0.0_r8) + max(fdr_out(i,k),0.0_r8)) + end if + end do + end do + + end subroutine compute_uwshcu_inv + + subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt , & + ps0_in , zs0_in , p0_in , z0_in , dp0_in , & + u0_in , v0_in , qv0_in , ql0_in , qi0_in , & + t0_in , s0_in , tr0_in , & + tke_in , cldfrct_in, concldfrct_in, pblh_in , cush_inout, & + umf_out , slflx_out , qtflx_out , & + flxprc1_out , flxsnow1_out , & + qvten_out, qlten_out , qiten_out , & + sten_out , uten_out , vten_out , trten_out, & + qrten_out, qsten_out , precip_out , snow_out , evapc_out , & + cufrc_out, qcu_out , qlu_out , qiu_out , & + cbmf_out , qc_out , rliq_out , & + cnt_out , cnb_out , lchnk , dpdry0_in , & + fer_out , fdr_out ) + + ! ------------------------------------------------------------ ! + ! ! + ! University of Washington Shallow Convection Scheme ! + ! ! + ! Described in Park and Bretherton. 2008. J. Climate : ! + ! ! + ! 'The University of Washington shallow convection and ! + ! moist turbulent schemes and their impact on climate ! + ! simulations with the Community Atmosphere Model' ! + ! ! + ! Coded by Sungsu Park. Oct.2005. ! + ! May.2008. ! + ! For questions, send an email to sungsup@ucar.edu or ! + ! sungsu@atmos.washington.edu ! + ! ! + ! ------------------------------------------------------------ ! + + use cam_history, only : outfld + use constituents, only : qmin, cnst_get_type_byind, cnst_get_ind + use wv_saturation, only : findsp_vc + + implicit none + + ! ---------------------- ! + ! Input-Output Variables ! + ! ---------------------- ! + + integer , intent(in) :: lchnk + integer , intent(in) :: mix + integer , intent(in) :: mkx + integer , intent(in) :: iend + integer , intent(in) :: ncnst + real(r8), intent(in) :: dt ! Time step : 2*delta_t [ s ] + real(r8), intent(in) :: ps0_in(mix,0:mkx) ! Environmental pressure at the interfaces [ Pa ] + real(r8), intent(in) :: zs0_in(mix,0:mkx) ! Environmental height at the interfaces [ m ] + real(r8), intent(in) :: p0_in(mix,mkx) ! Environmental pressure at the layer mid-point [ Pa ] + real(r8), intent(in) :: z0_in(mix,mkx) ! Environmental height at the layer mid-point [ m ] + real(r8), intent(in) :: dp0_in(mix,mkx) ! Environmental layer pressure thickness [ Pa ] > 0. + real(r8), intent(in) :: dpdry0_in(mix,mkx) ! Environmental dry layer pressure thickness [ Pa ] + real(r8), intent(in) :: u0_in(mix,mkx) ! Environmental zonal wind [ m/s ] + real(r8), intent(in) :: v0_in(mix,mkx) ! Environmental meridional wind [ m/s ] + real(r8), intent(in) :: qv0_in(mix,mkx) ! Environmental water vapor specific humidity [ kg/kg ] + real(r8), intent(in) :: ql0_in(mix,mkx) ! Environmental liquid water specific humidity [ kg/kg ] + real(r8), intent(in) :: qi0_in(mix,mkx) ! Environmental ice specific humidity [ kg/kg ] + real(r8), intent(in) :: t0_in(mix,mkx) ! Environmental temperature [ K ] + real(r8), intent(in) :: s0_in(mix,mkx) ! Environmental dry static energy [ J/kg ] + real(r8), intent(in) :: tr0_in(mix,mkx,ncnst) ! Environmental tracers [ #, kg/kg ] + real(r8), intent(in) :: tke_in(mix,0:mkx) ! Turbulent kinetic energy at the interfaces [ m2/s2 ] + real(r8), intent(in) :: cldfrct_in(mix,mkx) ! Total cloud fraction at the previous time step [ fraction ] + real(r8), intent(in) :: concldfrct_in(mix,mkx) ! Total convective cloud fraction + ! at the previous time step [ fraction ] + real(r8), intent(in) :: pblh_in(mix) ! Height of PBL [ m ] + real(r8), intent(inout) :: cush_inout(mix) ! Convective scale height [ m ] + + real(r8) tw0_in(mix,mkx) ! Wet bulb temperature [ K ] + real(r8) qw0_in(mix,mkx) ! Wet-bulb specific humidity [ kg/kg ] + + real(r8), intent(out) :: umf_out(mix,0:mkx) ! Updraft mass flux at the interfaces [ kg/m2/s ] + real(r8), intent(out) :: qvten_out(mix,mkx) ! Tendency of water vapor specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qlten_out(mix,mkx) ! Tendency of liquid water specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qiten_out(mix,mkx) ! Tendency of ice specific humidity [ kg/kg/s ] + real(r8), intent(out) :: sten_out(mix,mkx) ! Tendency of dry static energy [ J/kg/s ] + real(r8), intent(out) :: uten_out(mix,mkx) ! Tendency of zonal wind [ m/s2 ] + real(r8), intent(out) :: vten_out(mix,mkx) ! Tendency of meridional wind [ m/s2 ] + real(r8), intent(out) :: trten_out(mix,mkx,ncnst) ! Tendency of tracers [ #/s, kg/kg/s ] + real(r8), intent(out) :: qrten_out(mix,mkx) ! Tendency of rain water specific humidity [ kg/kg/s ] + real(r8), intent(out) :: qsten_out(mix,mkx) ! Tendency of snow specific humidity [ kg/kg/s ] + real(r8), intent(out) :: precip_out(mix) ! Precipitation ( rain + snow ) rate at surface [ m/s ] + real(r8), intent(out) :: snow_out(mix) ! Snow rate at surface [ m/s ] + real(r8), intent(out) :: evapc_out(mix,mkx) ! Tendency of evaporation of precipitation [ kg/kg/s ] + real(r8), intent(out) :: slflx_out(mix,0:mkx) ! Updraft/pen.entrainment liquid static energy flux + ! [ J/kg * kg/m2/s ] + real(r8), intent(out) :: qtflx_out(mix,0:mkx) ! updraft/pen.entrainment total water flux [ kg/kg * kg/m2/s ] + real(r8), intent(out) :: flxprc1_out(mix,0:mkx) ! precip (rain+snow) flux + real(r8), intent(out) :: flxsnow1_out(mix,0:mkx) ! snow flux + real(r8), intent(out) :: cufrc_out(mix,mkx) ! Shallow cumulus cloud fraction at the layer mid-point [ fraction ] + real(r8), intent(out) :: qcu_out(mix,mkx) ! Condensate water specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: qlu_out(mix,mkx) ! Liquid water specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: qiu_out(mix,mkx) ! Ice specific humidity within cumulus updraft [ kg/kg ] + real(r8), intent(out) :: cbmf_out(mix) ! Cloud base mass flux [ kg/m2/s ] + real(r8), intent(out) :: qc_out(mix,mkx) ! Tendency of detrained cumulus condensate + ! into the environment [ kg/kg/s ] + real(r8), intent(out) :: rliq_out(mix) ! Vertical integral of qc_out [ m/s ] + real(r8), intent(out) :: cnt_out(mix) ! Cumulus top interface index, cnt = kpen [ no ] + real(r8), intent(out) :: cnb_out(mix) ! Cumulus base interface index, cnb = krel - 1 [ no ] + real(r8), intent(out) :: fer_out(mix,mkx) ! Fractional lateral entrainment rate [ 1/Pa ] + real(r8), intent(out) :: fdr_out(mix,mkx) ! Fractional lateral detrainment rate [ 1/Pa ] + + ! + ! Internal Output Variables + ! + + real(r8) qtten_out(mix,mkx) ! Tendency of qt [ kg/kg/s ] + real(r8) slten_out(mix,mkx) ! Tendency of sl [ J/kg/s ] + real(r8) ufrc_out(mix,0:mkx) ! Updraft fractional area at the interfaces [ fraction ] + real(r8) uflx_out(mix,0:mkx) ! Updraft/pen.entrainment zonal momentum flux [ m/s/m2/s ] + real(r8) vflx_out(mix,0:mkx) ! Updraft/pen.entrainment meridional momentum flux [ m/s/m2/s ] + real(r8) cinh_out(mix) ! Convective INhibition upto LFC (CIN) [ J/kg ] + real(r8) trflx_out(mix,0:mkx,ncnst) ! Updraft/pen.entrainment tracer flux [ #/m2/s, kg/kg/m2/s ] + + ! -------------------------------------------- ! + ! One-dimensional variables at each grid point ! + ! -------------------------------------------- ! + + ! 1. Input variables + + real(r8) ps0(0:mkx) ! Environmental pressure at the interfaces [ Pa ] + real(r8) zs0(0:mkx) ! Environmental height at the interfaces [ m ] + real(r8) p0(mkx) ! Environmental pressure at the layer mid-point [ Pa ] + real(r8) z0(mkx) ! Environmental height at the layer mid-point [ m ] + real(r8) dp0(mkx) ! Environmental layer pressure thickness [ Pa ] > 0. + real(r8) dpdry0(mkx) ! Environmental dry layer pressure thickness [ Pa ] + real(r8) u0(mkx) ! Environmental zonal wind [ m/s ] + real(r8) v0(mkx) ! Environmental meridional wind [ m/s ] + real(r8) tke(0:mkx) ! Turbulent kinetic energy at the interfaces [ m2/s2 ] + real(r8) cldfrct(mkx) ! Total cloud fraction at the previous time step [ fraction ] + real(r8) concldfrct(mkx) ! Total convective cloud fraction + ! at the previous time step [ fraction ] + real(r8) qv0(mkx) ! Environmental water vapor specific humidity [ kg/kg ] + real(r8) ql0(mkx) ! Environmental liquid water specific humidity [ kg/kg ] + real(r8) qi0(mkx) ! Environmental ice specific humidity [ kg/kg ] + real(r8) t0(mkx) ! Environmental temperature [ K ] + real(r8) s0(mkx) ! Environmental dry static energy [ J/kg ] + real(r8) pblh ! Height of PBL [ m ] + real(r8) cush ! Convective scale height [ m ] + real(r8) tr0(mkx,ncnst) ! Environmental tracers [ #, kg/kg ] + + ! 2. Environmental variables directly derived from the input variables + + real(r8) qt0(mkx) ! Environmental total specific humidity [ kg/kg ] + real(r8) thl0(mkx) ! Environmental liquid potential temperature [ K ] + real(r8) thvl0(mkx) ! Environmental liquid virtual potential temperature [ K ] + real(r8) ssqt0(mkx) ! Linear internal slope + ! of environmental total specific humidity [ kg/kg/Pa ] + real(r8) ssthl0(mkx) ! Linear internal slope + ! of environmental liquid potential temperature [ K/Pa ] + real(r8) ssu0(mkx) ! Linear internal slope of environmental zonal wind [ m/s/Pa ] + real(r8) ssv0(mkx) ! Linear internal slope of environmental meridional wind [ m/s/Pa ] + real(r8) thv0bot(mkx) ! Environmental virtual potential temperature + ! at the bottom of each layer [ K ] + real(r8) thv0top(mkx) ! Environmental virtual potential temperature + ! at the top of each layer [ K ] + real(r8) thvl0bot(mkx) ! Environmental liquid virtual potential temperature + ! at the bottom of each layer [ K ] + real(r8) thvl0top(mkx) ! Environmental liquid virtual potential temperature + ! at the top of each layer [ K ] + real(r8) exn0(mkx) ! Exner function at the layer mid points [ no ] + real(r8) exns0(0:mkx) ! Exner function at the interfaces [ no ] + real(r8) sstr0(mkx,ncnst) ! Linear slope of environmental tracers [ #/Pa, kg/kg/Pa ] + + ! 2-1. For preventing negative condensate at the provisional time step + + real(r8) qv0_star(mkx) ! Environmental water vapor specific humidity [ kg/kg ] + real(r8) ql0_star(mkx) ! Environmental liquid water specific humidity [ kg/kg ] + real(r8) qi0_star(mkx) ! Environmental ice specific humidity [ kg/kg ] + real(r8) t0_star(mkx) ! Environmental temperature [ K ] + real(r8) s0_star(mkx) ! Environmental dry static energy [ J/kg ] + + ! 3. Variables associated with cumulus convection + + real(r8) umf(0:mkx) ! Updraft mass flux at the interfaces [ kg/m2/s ] + real(r8) emf(0:mkx) ! Penetrative entrainment mass flux at the interfaces [ kg/m2/s ] + real(r8) qvten(mkx) ! Tendency of water vapor specific humidity [ kg/kg/s ] + real(r8) qlten(mkx) ! Tendency of liquid water specific humidity [ kg/kg/s ] + real(r8) qiten(mkx) ! Tendency of ice specific humidity [ kg/kg/s ] + real(r8) sten(mkx) ! Tendency of dry static energy [ J/kg ] + real(r8) uten(mkx) ! Tendency of zonal wind [ m/s2 ] + real(r8) vten(mkx) ! Tendency of meridional wind [ m/s2 ] + real(r8) qrten(mkx) ! Tendency of rain water specific humidity [ kg/kg/s ] + real(r8) qsten(mkx) ! Tendency of snow specific humidity [ kg/kg/s ] + real(r8) precip ! Precipitation rate ( rain + snow) at the surface [ m/s ] + real(r8) snow ! Snow rate at the surface [ m/s ] + real(r8) evapc(mkx) ! Tendency of evaporation of precipitation [ kg/kg/s ] + real(r8) slflx(0:mkx) ! Updraft/pen.entrainment liquid static energy flux + ! [ J/kg * kg/m2/s ] + real(r8) qtflx(0:mkx) ! Updraft/pen.entrainment total water flux [ kg/kg * kg/m2/s ] + real(r8) uflx(0:mkx) ! Updraft/pen.entrainment flux of zonal momentum [ m/s/m2/s ] + real(r8) vflx(0:mkx) ! Updraft/pen.entrainment flux of meridional momentum [ m/s/m2/s ] + real(r8) cufrc(mkx) ! Shallow cumulus cloud fraction at the layer mid-point [ fraction ] + real(r8) qcu(mkx) ! Condensate water specific humidity + ! within convective updraft [ kg/kg ] + real(r8) qlu(mkx) ! Liquid water specific humidity within convective updraft [ kg/kg ] + real(r8) qiu(mkx) ! Ice specific humidity within convective updraft [ kg/kg ] + real(r8) dwten(mkx) ! Detrained water tendency from cumulus updraft [ kg/kg/s ] + real(r8) diten(mkx) ! Detrained ice tendency from cumulus updraft [ kg/kg/s ] + real(r8) fer(mkx) ! Fractional lateral entrainment rate [ 1/Pa ] + real(r8) fdr(mkx) ! Fractional lateral detrainment rate [ 1/Pa ] + real(r8) uf(mkx) ! Zonal wind at the provisional time step [ m/s ] + real(r8) vf(mkx) ! Meridional wind at the provisional time step [ m/s ] + real(r8) qc(mkx) ! Tendency due to detrained 'cloud water + cloud ice' + ! (without rain-snow contribution) [ kg/kg/s ] + real(r8) qc_l(mkx) ! Tendency due to detrained 'cloud water' + ! (without rain-snow contribution) [ kg/kg/s ] + real(r8) qc_i(mkx) ! Tendency due to detrained 'cloud ice' + ! (without rain-snow contribution) [ kg/kg/s ] + real(r8) qc_lm + real(r8) qc_im + real(r8) nc_lm + real(r8) nc_im + real(r8) ql_emf_kbup + real(r8) qi_emf_kbup + real(r8) nl_emf_kbup + real(r8) ni_emf_kbup + real(r8) qlten_det + real(r8) qiten_det + real(r8) rliq ! Vertical integral of qc [ m/s ] + real(r8) cnt ! Cumulus top interface index, cnt = kpen [ no ] + real(r8) cnb ! Cumulus base interface index, cnb = krel - 1 [ no ] + real(r8) qtten(mkx) ! Tendency of qt [ kg/kg/s ] + real(r8) slten(mkx) ! Tendency of sl [ J/kg/s ] + real(r8) ufrc(0:mkx) ! Updraft fractional area [ fraction ] + real(r8) trten(mkx,ncnst) ! Tendency of tracers [ #/s, kg/kg/s ] + real(r8) trflx(0:mkx,ncnst) ! Flux of tracers due to convection [ # * kg/m2/s, kg/kg * kg/m2/s ] + real(r8) trflx_d(0:mkx) ! Adjustive downward flux of tracers to prevent negative tracers + real(r8) trflx_u(0:mkx) ! Adjustive upward flux of tracers to prevent negative tracers + real(r8) trmin ! Minimum concentration of tracers allowed + real(r8) pdelx, dum + + !----- Variables used for the calculation of condensation sink associated with compensating subsidence + ! In the current code, this 'sink' tendency is simply set to be zero. + + real(r8) uemf(0:mkx) ! Net updraft mass flux at the interface ( emf + umf ) [ kg/m2/s ] + real(r8) comsub(mkx) ! Compensating subsidence + ! at the layer mid-point ( unit of mass flux, umf ) [ kg/m2/s ] + real(r8) qlten_sink(mkx) ! Liquid condensate tendency + ! by compensating subsidence/upwelling [ kg/kg/s ] + real(r8) qiten_sink(mkx) ! Ice condensate tendency + ! by compensating subsidence/upwelling [ kg/kg/s ] + real(r8) nlten_sink(mkx) ! Liquid droplets # tendency + ! by compensating subsidence/upwelling [ kg/kg/s ] + real(r8) niten_sink(mkx) ! Ice droplets # tendency + ! by compensating subsidence/upwelling [ kg/kg/s ] + real(r8) thlten_sub, qtten_sub ! Tendency of conservative scalars + ! by compensating subsidence/upwelling + real(r8) qlten_sub, qiten_sub ! Tendency of ql0, qi0 + ! by compensating subsidence/upwelling + real(r8) nlten_sub, niten_sub ! Tendency of nl0, ni0 + ! by compensating subsidence/upwelling + real(r8) thl_prog, qt_prog ! Prognosed 'thl, qt' + ! by compensating subsidence/upwelling + + !----- Variables describing cumulus updraft + + real(r8) wu(0:mkx) ! Updraft vertical velocity at the interface [ m/s ] + real(r8) thlu(0:mkx) ! Updraft liquid potential temperature at the interface [ K ] + real(r8) qtu(0:mkx) ! Updraft total specific humidity at the interface [ kg/kg ] + real(r8) uu(0:mkx) ! Updraft zonal wind at the interface [ m/s ] + real(r8) vu(0:mkx) ! Updraft meridional wind at the interface [ m/s ] + real(r8) thvu(0:mkx) ! Updraft virtual potential temperature at the interface [ m/s ] + real(r8) rei(mkx) ! Updraft fractional mixing rate with the environment [ 1/Pa ] + real(r8) tru(0:mkx,ncnst) ! Updraft tracers [ #, kg/kg ] + + !----- Variables describing conservative scalars of entraining downdrafts at the + ! entraining interfaces, i.e., 'kbup <= k < kpen-1'. At the other interfaces, + ! belows are simply set to equal to those of updraft for simplicity - but it + ! does not influence numerical calculation. + + real(r8) thlu_emf(0:mkx) ! Penetrative downdraft liquid potential temperature + ! at entraining interfaces [ K ] + real(r8) qtu_emf(0:mkx) ! Penetrative downdraft total water + ! at entraining interfaces [ kg/kg ] + real(r8) uu_emf(0:mkx) ! Penetrative downdraft zonal wind + ! at entraining interfaces [ m/s ] + real(r8) vu_emf(0:mkx) ! Penetrative downdraft meridional wind + ! at entraining interfaces [ m/s ] + real(r8) tru_emf(0:mkx,ncnst) ! Penetrative Downdraft tracers + ! at entraining interfaces [ #, kg/kg ] + + !----- Variables associated with evaporations of convective 'rain' and 'snow' + + real(r8) flxrain(0:mkx) ! Downward rain flux at each interface [ kg/m2/s ] + real(r8) flxsnow(0:mkx) ! Downward snow flux at each interface [ kg/m2/s ] + real(r8) ntraprd(mkx) ! Net production ( production - evaporation + melting ) + ! rate of rain in each layer [ kg/kg/s ] + real(r8) ntsnprd(mkx) ! Net production ( production - evaporation + freezing ) + ! rate of snow in each layer [ kg/kg/s ] + real(r8) flxsntm ! Downward snow flux + ! at the top of each layer after melting [ kg/m2/s ] + real(r8) snowmlt ! Snow melting tendency [ kg/kg/s ] + real(r8) subsat ! Sub-saturation ratio (1-qv/qs) [ no unit ] + real(r8) evprain ! Evaporation rate of rain [ kg/kg/s ] + real(r8) evpsnow ! Evaporation rate of snow [ kg/kg/s ] + real(r8) evplimit ! Limiter of 'evprain + evpsnow' [ kg/kg/s ] + real(r8) evplimit_rain ! Limiter of 'evprain' [ kg/kg/s ] + real(r8) evplimit_snow ! Limiter of 'evpsnow' [ kg/kg/s ] + real(r8) evpint_rain ! Vertically-integrated evaporative flux of rain [ kg/m2/s ] + real(r8) evpint_snow ! Vertically-integrated evaporative flux of snow [ kg/m2/s ] + real(r8) kevp ! Evaporative efficiency [ complex unit ] + + !----- Other internal variables + + integer kk, mm, k, i, m, kp1, km1 + integer iter_scaleh, iter_xc + integer id_check, status + integer klcl ! Layer containing LCL of source air + integer kinv ! Inversion layer with PBL top interface as a lower interface + integer krel ! Release layer where buoyancy sorting mixing + ! occurs for the first time + integer klfc ! LFC layer of cumulus source air + integer kbup ! Top layer in which cloud buoyancy is positive at the top interface + integer kpen ! Highest layer with positive updraft vertical velocity + ! - top layer cumulus can reach + logical id_exit + logical forcedCu ! If 'true', cumulus updraft cannot overcome the buoyancy barrier + ! just above the PBL top. + real(r8) thlsrc, qtsrc, usrc, vsrc, thvlsrc ! Updraft source air properties + real(r8) PGFc, uplus, vplus + real(r8) trsrc(ncnst), tre(ncnst) + real(r8) plcl, plfc, prel, wrel + real(r8) frc_rasn + real(r8) ee2, ud2, wtw, wtwb, wtwh + real(r8) xc, xc_2 + real(r8) cldhgt, scaleh, tscaleh, cridis, rle, rkm + real(r8) rkfre, sigmaw, epsvarw, tkeavg, dpsum, dpi, thvlmin + real(r8) thlxsat, qtxsat, thvxsat, x_cu, x_en, thv_x0, thv_x1 + real(r8) thj, qvj, qlj, qij, thvj, tj, thv0j, rho0j, rhos0j, qse + real(r8) cin, cinlcl + real(r8) pe, dpe, exne, thvebot, thle, qte, ue, ve, thlue, qtue, wue + real(r8) mu, mumin0, mumin1, mumin2, mulcl, mulclstar + real(r8) cbmf, wcrit, winv, wlcl, ufrcinv, ufrclcl, rmaxfrac + real(r8) criqc, exql, exqi, ppen + real(r8) thl0top, thl0bot, qt0bot, qt0top, thvubot, thvutop + real(r8) thlu_top, qtu_top, qlu_top, qiu_top, qlu_mid, qiu_mid, exntop + real(r8) thl0lcl, qt0lcl, thv0lcl, thv0rel, rho0inv, autodet + real(r8) aquad, bquad, cquad, xc1, xc2, excessu, excess0, xsat, xs1, xs2 + real(r8) bogbot, bogtop, delbog, drage, expfac, rbuoy, rdrag + real(r8) rcwp, rlwp, riwp, qcubelow, qlubelow, qiubelow + real(r8) rainflx, snowflx + real(r8) es + real(r8) qs + real(r8) qsat_arg + real(r8) xsrc, xmean, xtop, xbot, xflx(0:mkx) + real(r8) tmp1, tmp2 + + !----- Some diagnostic internal output variables + + real(r8) ufrcinvbase_out(mix) ! Cumulus updraft fraction at the PBL top [ fraction ] + real(r8) ufrclcl_out(mix) ! Cumulus updraft fraction at the LCL + ! ( or PBL top when LCL is below PBL top ) [ fraction ] + real(r8) winvbase_out(mix) ! Cumulus updraft velocity at the PBL top [ m/s ] + real(r8) wlcl_out(mix) ! Cumulus updraft velocity at the LCL + ! ( or PBL top when LCL is below PBL top ) [ m/s ] + real(r8) plcl_out(mix) ! LCL of source air [ Pa ] + real(r8) pinv_out(mix) ! PBL top pressure [ Pa ] + real(r8) plfc_out(mix) ! LFC of source air [ Pa ] + real(r8) pbup_out(mix) ! Highest interface level of positive buoyancy [ Pa ] + real(r8) ppen_out(mix) ! Highest interface evel where Cu w = 0 [ Pa ] + real(r8) qtsrc_out(mix) ! Sourse air qt [ kg/kg ] + real(r8) thlsrc_out(mix) ! Sourse air thl [ K ] + real(r8) thvlsrc_out(mix) ! Sourse air thvl [ K ] + real(r8) emfkbup_out(mix) ! Penetrative downward mass flux at 'kbup' interface [ kg/m2/s ] + real(r8) cinlclh_out(mix) ! Convective INhibition upto LCL (CIN) [ J/kg = m2/s2 ] + real(r8) tkeavg_out(mix) ! Average tke over the PBL [ m2/s2 ] + real(r8) cbmflimit_out(mix) ! Cloud base mass flux limiter [ kg/m2/s ] + real(r8) zinv_out(mix) ! PBL top height [ m ] + real(r8) rcwp_out(mix) ! Layer mean Cumulus LWP+IWP [ kg/m2 ] + real(r8) rlwp_out(mix) ! Layer mean Cumulus LWP [ kg/m2 ] + real(r8) riwp_out(mix) ! Layer mean Cumulus IWP [ kg/m2 ] + real(r8) wu_out(mix,0:mkx) ! Updraft vertical velocity + ! ( defined from the release level to 'kpen-1' interface ) + real(r8) qtu_out(mix,0:mkx) ! Updraft qt [ kg/kg ] + real(r8) thlu_out(mix,0:mkx) ! Updraft thl [ K ] + real(r8) thvu_out(mix,0:mkx) ! Updraft thv [ K ] + real(r8) uu_out(mix,0:mkx) ! Updraft zonal wind [ m/s ] + real(r8) vu_out(mix,0:mkx) ! Updraft meridional wind [ m/s ] + real(r8) qtu_emf_out(mix,0:mkx) ! Penetratively entrained qt [ kg/kg ] + real(r8) thlu_emf_out(mix,0:mkx) ! Penetratively entrained thl [ K ] + real(r8) uu_emf_out(mix,0:mkx) ! Penetratively entrained u [ m/s ] + real(r8) vu_emf_out(mix,0:mkx) ! Penetratively entrained v [ m/s ] + real(r8) uemf_out(mix,0:mkx) ! Net upward mass flux + ! including penetrative entrainment (umf+emf) [ kg/m2/s ] + real(r8) tru_out(mix,0:mkx,ncnst) ! Updraft tracers [ #, kg/kg ] + real(r8) tru_emf_out(mix,0:mkx,ncnst) ! Penetratively entrained tracers [ #, kg/kg ] + + real(r8) wu_s(0:mkx) ! Same as above but for implicit CIN + real(r8) qtu_s(0:mkx) + real(r8) thlu_s(0:mkx) + real(r8) thvu_s(0:mkx) + real(r8) uu_s(0:mkx) + real(r8) vu_s(0:mkx) + real(r8) qtu_emf_s(0:mkx) + real(r8) thlu_emf_s(0:mkx) + real(r8) uu_emf_s(0:mkx) + real(r8) vu_emf_s(0:mkx) + real(r8) uemf_s(0:mkx) + real(r8) tru_s(0:mkx,ncnst) + real(r8) tru_emf_s(0:mkx,ncnst) + + real(r8) dwten_out(mix,mkx) + real(r8) diten_out(mix,mkx) + real(r8) flxrain_out(mix,0:mkx) + real(r8) flxsnow_out(mix,0:mkx) + real(r8) ntraprd_out(mix,mkx) + real(r8) ntsnprd_out(mix,mkx) + + real(r8) dwten_s(mkx) + real(r8) diten_s(mkx) + real(r8) flxrain_s(0:mkx) + real(r8) flxsnow_s(0:mkx) + real(r8) ntraprd_s(mkx) + real(r8) ntsnprd_s(mkx) + + real(r8) excessu_arr_out(mix,mkx) + real(r8) excessu_arr(mkx) + real(r8) excessu_arr_s(mkx) + real(r8) excess0_arr_out(mix,mkx) + real(r8) excess0_arr(mkx) + real(r8) excess0_arr_s(mkx) + real(r8) xc_arr_out(mix,mkx) + real(r8) xc_arr(mkx) + real(r8) xc_arr_s(mkx) + real(r8) aquad_arr_out(mix,mkx) + real(r8) aquad_arr(mkx) + real(r8) aquad_arr_s(mkx) + real(r8) bquad_arr_out(mix,mkx) + real(r8) bquad_arr(mkx) + real(r8) bquad_arr_s(mkx) + real(r8) cquad_arr_out(mix,mkx) + real(r8) cquad_arr(mkx) + real(r8) cquad_arr_s(mkx) + real(r8) bogbot_arr_out(mix,mkx) + real(r8) bogbot_arr(mkx) + real(r8) bogbot_arr_s(mkx) + real(r8) bogtop_arr_out(mix,mkx) + real(r8) bogtop_arr(mkx) + real(r8) bogtop_arr_s(mkx) + + real(r8) exit_UWCu(mix) + real(r8) exit_conden(mix) + real(r8) exit_klclmkx(mix) + real(r8) exit_klfcmkx(mix) + real(r8) exit_ufrc(mix) + real(r8) exit_wtw(mix) + real(r8) exit_drycore(mix) + real(r8) exit_wu(mix) + real(r8) exit_cufilter(mix) + real(r8) exit_kinv1(mix) + real(r8) exit_rei(mix) + + real(r8) limit_shcu(mix) + real(r8) limit_negcon(mix) + real(r8) limit_ufrc(mix) + real(r8) limit_ppen(mix) + real(r8) limit_emf(mix) + real(r8) limit_cinlcl(mix) + real(r8) limit_cin(mix) + real(r8) limit_cbmf(mix) + real(r8) limit_rei(mix) + real(r8) ind_delcin(mix) + + real(r8) :: ufrcinvbase_s, ufrclcl_s, winvbase_s, wlcl_s, plcl_s, pinv_s, plfc_s, & + qtsrc_s, thlsrc_s, thvlsrc_s, emfkbup_s, cinlcl_s, pbup_s, ppen_s, cbmflimit_s, & + tkeavg_s, zinv_s, rcwp_s, rlwp_s, riwp_s + real(r8) :: ufrcinvbase, winvbase, pinv, zinv, emfkbup, cbmflimit, rho0rel + + !----- Variables for implicit CIN computation + + real(r8), dimension(mkx) :: qv0_s , ql0_s , qi0_s , s0_s , u0_s , & + v0_s , t0_s , qt0_s , thl0_s , thvl0_s , qvten_s , & + qlten_s, qiten_s , qrten_s , qsten_s , sten_s , evapc_s , & + uten_s , vten_s , cufrc_s , qcu_s , qlu_s , qiu_s , & + fer_s , fdr_s , qc_s , qtten_s , slten_s + real(r8), dimension(0:mkx) :: umf_s , slflx_s , qtflx_s , ufrc_s , uflx_s , vflx_s + real(r8) :: cush_s , precip_s, snow_s , cin_s , rliq_s, cbmf_s, cnt_s, cnb_s + real(r8) :: cin_i,cin_f,del_CIN,ke,alpha,thlj + real(r8) :: cinlcl_i,cinlcl_f,del_cinlcl + integer :: iter + + real(r8), dimension(mkx,ncnst) :: tr0_s, trten_s + real(r8), dimension(0:mkx,ncnst) :: trflx_s + + !----- Variables for temporary storages + + real(r8), dimension(mkx) :: qv0_o, ql0_o, qi0_o, t0_o, s0_o, u0_o, v0_o + real(r8), dimension(mkx) :: qt0_o , thl0_o , thvl0_o , & + qvten_o , qlten_o , qiten_o , qrten_o , qsten_o , & + sten_o , uten_o , vten_o , qcu_o , qlu_o , & + qiu_o , cufrc_o , evapc_o , & + thv0bot_o, thv0top_o, thvl0bot_o, thvl0top_o, & + ssthl0_o , ssqt0_o , ssu0_o , ssv0_o , qc_o , & + qtten_o , slten_o + real(r8), dimension(0:mkx) :: umf_o , slflx_o , qtflx_o , ufrc_o + real(r8), dimension(mix) :: cush_o , precip_o , snow_o , rliq_o, cbmf_o, cnt_o, cnb_o + real(r8), dimension(0:mkx) :: uflx_o , vflx_o + real(r8) :: tkeavg_o , thvlmin_o, qtsrc_o , thvlsrc_o, thlsrc_o , & + usrc_o , vsrc_o , plcl_o , plfc_o , & + thv0lcl_o, cinlcl_o + integer :: kinv_o , klcl_o , klfc_o + + real(r8), dimension(mkx,ncnst) :: tr0_o + real(r8), dimension(mkx,ncnst) :: trten_o, sstr0_o + real(r8), dimension(0:mkx,ncnst) :: trflx_o + real(r8), dimension(ncnst) :: trsrc_o + integer :: ixnumliq, ixnumice, ixcldliq, ixcldice + + ! ------------------ ! + ! ! + ! Define Parameters ! + ! ! + ! ------------------ ! + + ! ------------------------ ! + ! Iterative xc calculation ! + ! ------------------------ ! + + integer , parameter :: niter_xc = 2 + + ! ----------------------------------------------------------- ! + ! Choice of 'CIN = cin' (.true.) or 'CIN = cinlcl' (.false.). ! + ! ! + ! Feb 2007, Bundy: Note that use_CINcin = .false. will try to ! + ! use a variable (del_cinlcl) that is not currently set ! + ! ! + ! Sept 2012, Santos: The fact that this is still true over 5 ! + ! years later suggests that this option needs to be ! + ! fixed or abandoned. ! + ! ----------------------------------------------------------- ! + + logical , parameter :: use_CINcin = .true. + + ! --------------------------------------------------------------- ! + ! Choice of 'explicit' ( 1 ) or 'implicit' ( 2 ) CIN. ! + ! ! + ! When choose 'CIN = cinlcl' above, it is recommended not to use ! + ! implicit CIN, i.e., do 'NOT' choose simultaneously : ! + ! [ 'use_CINcin=.false. & 'iter_cin=2' ] ! + ! since 'cinlcl' will be always set to zero whenever LCL is below ! + ! the PBL top interface in the current code. So, averaging cinlcl ! + ! of two iter_cin steps is likely not so good. Except that, all ! + ! the other combinations of 'use_CINcin' & 'iter_cin' are OK. ! + ! --------------------------------------------------------------- ! + + integer , parameter :: iter_cin = 2 + + ! ---------------------------------------------------------------- ! + ! Choice of 'self-detrainment' by negative buoyancy in calculating ! + ! cumulus updraft mass flux at the top interface in each layer. ! + ! ---------------------------------------------------------------- ! + + logical , parameter :: use_self_detrain = .false. + + ! --------------------------------------------------------- ! + ! Cumulus momentum flux : turn-on (.true.) or off (.false.) ! + ! --------------------------------------------------------- ! + + logical , parameter :: use_momenflx = .true. + + ! ----------------------------------------------------------------------------------------- ! + ! Penetrative Entrainment : Cumulative ( .true. , original ) or Non-Cumulative ( .false. ) ! + ! This option ( .false. ) is designed to reduce the sensitivity to the vertical resolution. ! + ! ----------------------------------------------------------------------------------------- ! + + logical , parameter :: use_cumpenent = .true. + + ! --------------------------------------------------------------------------------------------------------------- ! + ! Computation of the grid-mean condensate tendency. ! + ! use_expconten = .true. : explcitly compute tendency by condensate detrainment and compensating subsidence ! + ! use_expconten = .false. : use the original proportional condensate tendency equation. ( original ) ! + ! --------------------------------------------------------------------------------------------------------------- ! + + logical , parameter :: use_expconten = .true. + + ! --------------------------------------------------------------------------------------------------------------- ! + ! Treatment of reserved condensate ! + ! use_unicondet = .true. : detrain condensate uniformly over the environment ( original ) ! + ! use_unicondet = .false. : detrain condensate into the pre-existing stratus ! + ! --------------------------------------------------------------------------------------------------------------- ! + + logical , parameter :: use_unicondet = .false. + + ! ----------------------- ! + ! For lateral entrainment ! + ! ----------------------- ! + + parameter (rle = 0.1_r8) ! For critical stopping distance for lateral entrainment [no unit] +! parameter (rkm = 16.0_r8) ! Determine the amount of air that is involved in buoyancy-sorting [no unit] + parameter (rkm = 14.0_r8) ! Determine the amount of air that is involved in buoyancy-sorting [no unit] + + parameter (rkfre = 1.0_r8) ! Vertical velocity variance as fraction of tke. + parameter (rmaxfrac = 0.10_r8) ! Maximum allowable 'core' updraft fraction + parameter (mumin1 = 0.906_r8) ! Normalized CIN ('mu') corresponding to 'rmaxfrac' at the PBL top + ! obtaind by inverting 'rmaxfrac = 0.5*erfc(mumin1)'. + ! [rmaxfrac:mumin1]=[ 0.05:1.163, 0.075:1.018, 0.1:0.906, 0.15:0.733, 0.2:0.595, 0.25:0.477] + parameter (rbuoy = 1.0_r8) ! For nonhydrostatic pressure effects on updraft [no unit] + parameter (rdrag = 1.0_r8) ! Drag coefficient [no unit] + + parameter (epsvarw = 5.e-4_r8) ! Variance of w at PBL top by meso-scale component [m2/s2] + parameter (PGFc = 0.7_r8) ! This is used for calculating vertical variations cumulus + ! 'u' & 'v' by horizontal PGF during upward motion [no unit] + + ! ---------------------------------------- ! + ! Bulk microphysics controlling parameters ! + ! --------------------------------------------------------------------------- ! + ! criqc : Maximum condensate that can be hold by cumulus updraft [kg/kg] ! + ! frc_rasn : Fraction of precipitable condensate in the expelled cloud water ! + ! from cumulus updraft. The remaining fraction ('1-frc_rasn') is ! + ! 'suspended condensate'. ! + ! 0 : all expelled condensate is 'suspended condensate' ! + ! 1 : all expelled condensate is 'precipitable condensate' ! + ! kevp : Evaporative efficiency ! + ! noevap_krelkpen : No evaporation from 'krel' to 'kpen' layers ! + ! --------------------------------------------------------------------------- ! + + parameter ( criqc = 0.7e-3_r8 ) + parameter ( frc_rasn = 1.0_r8 ) + parameter ( kevp = 2.e-6_r8 ) + logical, parameter :: noevap_krelkpen = .false. + + !------------------------! + ! ! + ! Start Main Calculation ! + ! ! + !------------------------! + + call cnst_get_ind( 'NUMLIQ', ixnumliq ) + call cnst_get_ind( 'NUMICE', ixnumice ) + + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + + + + + ! ------------------------------------------------------- ! + ! Initialize output variables defined for all grid points ! + ! ------------------------------------------------------- ! + + umf_out(:iend,0:mkx) = 0.0_r8 + slflx_out(:iend,0:mkx) = 0.0_r8 + qtflx_out(:iend,0:mkx) = 0.0_r8 + flxprc1_out(:iend,0:mkx) = 0.0_r8 + flxsnow1_out(:iend,0:mkx) = 0.0_r8 + qvten_out(:iend,:mkx) = 0.0_r8 + qlten_out(:iend,:mkx) = 0.0_r8 + qiten_out(:iend,:mkx) = 0.0_r8 + sten_out(:iend,:mkx) = 0.0_r8 + uten_out(:iend,:mkx) = 0.0_r8 + vten_out(:iend,:mkx) = 0.0_r8 + qrten_out(:iend,:mkx) = 0.0_r8 + qsten_out(:iend,:mkx) = 0.0_r8 + precip_out(:iend) = 0.0_r8 + snow_out(:iend) = 0.0_r8 + evapc_out(:iend,:mkx) = 0.0_r8 + cufrc_out(:iend,:mkx) = 0.0_r8 + qcu_out(:iend,:mkx) = 0.0_r8 + qlu_out(:iend,:mkx) = 0.0_r8 + qiu_out(:iend,:mkx) = 0.0_r8 + fer_out(:iend,:mkx) = 0.0_r8 + fdr_out(:iend,:mkx) = 0.0_r8 + cinh_out(:iend) = -1.0_r8 + cinlclh_out(:iend) = -1.0_r8 + cbmf_out(:iend) = 0.0_r8 + qc_out(:iend,:mkx) = 0.0_r8 + rliq_out(:iend) = 0.0_r8 + cnt_out(:iend) = real(mkx, r8) + cnb_out(:iend) = 0.0_r8 + qtten_out(:iend,:mkx) = 0.0_r8 + slten_out(:iend,:mkx) = 0.0_r8 + ufrc_out(:iend,0:mkx) = 0.0_r8 + + uflx_out(:iend,0:mkx) = 0.0_r8 + vflx_out(:iend,0:mkx) = 0.0_r8 + + trten_out(:iend,:mkx,:ncnst) = 0.0_r8 + trflx_out(:iend,0:mkx,:ncnst)= 0.0_r8 + + ufrcinvbase_out(:iend) = 0.0_r8 + ufrclcl_out(:iend) = 0.0_r8 + winvbase_out(:iend) = 0.0_r8 + wlcl_out(:iend) = 0.0_r8 + plcl_out(:iend) = 0.0_r8 + pinv_out(:iend) = 0.0_r8 + plfc_out(:iend) = 0.0_r8 + pbup_out(:iend) = 0.0_r8 + ppen_out(:iend) = 0.0_r8 + qtsrc_out(:iend) = 0.0_r8 + thlsrc_out(:iend) = 0.0_r8 + thvlsrc_out(:iend) = 0.0_r8 + emfkbup_out(:iend) = 0.0_r8 + cbmflimit_out(:iend) = 0.0_r8 + tkeavg_out(:iend) = 0.0_r8 + zinv_out(:iend) = 0.0_r8 + rcwp_out(:iend) = 0.0_r8 + rlwp_out(:iend) = 0.0_r8 + riwp_out(:iend) = 0.0_r8 + + wu_out(:iend,0:mkx) = 0.0_r8 + qtu_out(:iend,0:mkx) = 0.0_r8 + thlu_out(:iend,0:mkx) = 0.0_r8 + thvu_out(:iend,0:mkx) = 0.0_r8 + uu_out(:iend,0:mkx) = 0.0_r8 + vu_out(:iend,0:mkx) = 0.0_r8 + qtu_emf_out(:iend,0:mkx) = 0.0_r8 + thlu_emf_out(:iend,0:mkx) = 0.0_r8 + uu_emf_out(:iend,0:mkx) = 0.0_r8 + vu_emf_out(:iend,0:mkx) = 0.0_r8 + uemf_out(:iend,0:mkx) = 0.0_r8 + + tru_out(:iend,0:mkx,:ncnst) = 0.0_r8 + tru_emf_out(:iend,0:mkx,:ncnst) = 0.0_r8 + + dwten_out(:iend,:mkx) = 0.0_r8 + diten_out(:iend,:mkx) = 0.0_r8 + flxrain_out(:iend,0:mkx) = 0.0_r8 + flxsnow_out(:iend,0:mkx) = 0.0_r8 + ntraprd_out(:iend,mkx) = 0.0_r8 + ntsnprd_out(:iend,mkx) = 0.0_r8 + + excessu_arr_out(:iend,:mkx) = 0.0_r8 + excess0_arr_out(:iend,:mkx) = 0.0_r8 + xc_arr_out(:iend,:mkx) = 0.0_r8 + aquad_arr_out(:iend,:mkx) = 0.0_r8 + bquad_arr_out(:iend,:mkx) = 0.0_r8 + cquad_arr_out(:iend,:mkx) = 0.0_r8 + bogbot_arr_out(:iend,:mkx) = 0.0_r8 + bogtop_arr_out(:iend,:mkx) = 0.0_r8 + + exit_UWCu(:iend) = 0.0_r8 + exit_conden(:iend) = 0.0_r8 + exit_klclmkx(:iend) = 0.0_r8 + exit_klfcmkx(:iend) = 0.0_r8 + exit_ufrc(:iend) = 0.0_r8 + exit_wtw(:iend) = 0.0_r8 + exit_drycore(:iend) = 0.0_r8 + exit_wu(:iend) = 0.0_r8 + exit_cufilter(:iend) = 0.0_r8 + exit_kinv1(:iend) = 0.0_r8 + exit_rei(:iend) = 0.0_r8 + + limit_shcu(:iend) = 0.0_r8 + limit_negcon(:iend) = 0.0_r8 + limit_ufrc(:iend) = 0.0_r8 + limit_ppen(:iend) = 0.0_r8 + limit_emf(:iend) = 0.0_r8 + limit_cinlcl(:iend) = 0.0_r8 + limit_cin(:iend) = 0.0_r8 + limit_cbmf(:iend) = 0.0_r8 + limit_rei(:iend) = 0.0_r8 + + ind_delcin(:iend) = 0.0_r8 + + !--------------------------------------------------------------! + ! ! + ! Start the column i loop where i is a horizontal column index ! + ! ! + !--------------------------------------------------------------! + + ! Compute wet-bulb temperature and specific humidity + ! for treating evaporation of precipitation. + + ! "True" means ice will be taken into account + do k = 1, mkx + call findsp_vc(qv0_in(:iend,k), t0_in(:iend,k), p0_in(:iend,k), .true., & + tw0_in(:iend,k), qw0_in(:iend,k)) + end do + + do i = 1, iend + + id_exit = .false. + + ! -------------------------------------------- ! + ! Define 1D input variables at each grid point ! + ! -------------------------------------------- ! + + ps0(0:mkx) = ps0_in(i,0:mkx) + zs0(0:mkx) = zs0_in(i,0:mkx) + p0(:mkx) = p0_in(i,:mkx) + z0(:mkx) = z0_in(i,:mkx) + dp0(:mkx) = dp0_in(i,:mkx) + dpdry0(:mkx) = dpdry0_in(i,:mkx) + u0(:mkx) = u0_in(i,:mkx) + v0(:mkx) = v0_in(i,:mkx) + qv0(:mkx) = qv0_in(i,:mkx) + ql0(:mkx) = ql0_in(i,:mkx) + qi0(:mkx) = qi0_in(i,:mkx) + t0(:mkx) = t0_in(i,:mkx) + s0(:mkx) = s0_in(i,:mkx) + tke(0:mkx) = tke_in(i,0:mkx) + cldfrct(:mkx) = cldfrct_in(i,:mkx) + concldfrct(:mkx) = concldfrct_in(i,:mkx) + pblh = pblh_in(i) + cush = cush_inout(i) + do m = 1, ncnst + tr0(:mkx,m) = tr0_in(i,:mkx,m) + enddo + + ! --------------------------------------------------------- ! + ! Compute other basic thermodynamic variables directly from ! + ! the input variables at each grid point ! + ! --------------------------------------------------------- ! + + !----- 1. Compute internal environmental variables + + exn0(:mkx) = (p0(:mkx)/p00)**rovcp + exns0(0:mkx) = (ps0(0:mkx)/p00)**rovcp + qt0(:mkx) = (qv0(:mkx) + ql0(:mkx) + qi0(:mkx)) + thl0(:mkx) = (t0(:mkx) - xlv*ql0(:mkx)/cp - xls*qi0(:mkx)/cp)/exn0(:mkx) + thvl0(:mkx) = (1._r8 + zvir*qt0(:mkx))*thl0(:mkx) + + !----- 2. Compute slopes of environmental variables in each layer + ! Dimension of ssthl0(:mkx) is implicit. + + ssthl0 = slope(mkx,thl0,p0) + ssqt0 = slope(mkx,qt0 ,p0) + ssu0 = slope(mkx,u0 ,p0) + ssv0 = slope(mkx,v0 ,p0) + do m = 1, ncnst + sstr0(:mkx,m) = slope(mkx,tr0(:mkx,m),p0) + enddo + + !----- 3. Compute "thv0" and "thvl0" at the top/bottom interfaces in each layer + ! There are computed from the reconstructed thl, qt at the top/bottom. + + do k = 1, mkx + + thl0bot = thl0(k) + ssthl0(k)*(ps0(k-1) - p0(k)) + qt0bot = qt0(k) + ssqt0(k) *(ps0(k-1) - p0(k)) + call conden(ps0(k-1),thl0bot,qt0bot,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0bot(k) = thj*(1._r8 + zvir*qvj - qlj - qij) + thvl0bot(k) = thl0bot*(1._r8 + zvir*qt0bot) + + thl0top = thl0(k) + ssthl0(k)*(ps0(k) - p0(k)) + qt0top = qt0(k) + ssqt0(k) *(ps0(k) - p0(k)) + call conden(ps0(k),thl0top,qt0top,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0top(k) = thj*(1._r8 + zvir*qvj - qlj - qij) + thvl0top(k) = thl0top*(1._r8 + zvir*qt0top) + + end do + + ! ------------------------------------------------------------ ! + ! Save input and related environmental thermodynamic variables ! + ! for use at "iter_cin=2" when "del_CIN >= 0" ! + ! ------------------------------------------------------------ ! + + qv0_o(:mkx) = qv0(:mkx) + ql0_o(:mkx) = ql0(:mkx) + qi0_o(:mkx) = qi0(:mkx) + t0_o(:mkx) = t0(:mkx) + s0_o(:mkx) = s0(:mkx) + u0_o(:mkx) = u0(:mkx) + v0_o(:mkx) = v0(:mkx) + qt0_o(:mkx) = qt0(:mkx) + thl0_o(:mkx) = thl0(:mkx) + thvl0_o(:mkx) = thvl0(:mkx) + ssthl0_o(:mkx) = ssthl0(:mkx) + ssqt0_o(:mkx) = ssqt0(:mkx) + thv0bot_o(:mkx) = thv0bot(:mkx) + thv0top_o(:mkx) = thv0top(:mkx) + thvl0bot_o(:mkx) = thvl0bot(:mkx) + thvl0top_o(:mkx) = thvl0top(:mkx) + ssu0_o(:mkx) = ssu0(:mkx) + ssv0_o(:mkx) = ssv0(:mkx) + do m = 1, ncnst + tr0_o(:mkx,m) = tr0(:mkx,m) + sstr0_o(:mkx,m) = sstr0(:mkx,m) + enddo + + ! ---------------------------------------------- ! + ! Initialize output variables at each grid point ! + ! ---------------------------------------------- ! + + umf(0:mkx) = 0.0_r8 + emf(0:mkx) = 0.0_r8 + slflx(0:mkx) = 0.0_r8 + qtflx(0:mkx) = 0.0_r8 + uflx(0:mkx) = 0.0_r8 + vflx(0:mkx) = 0.0_r8 + qvten(:mkx) = 0.0_r8 + qlten(:mkx) = 0.0_r8 + qiten(:mkx) = 0.0_r8 + sten(:mkx) = 0.0_r8 + uten(:mkx) = 0.0_r8 + vten(:mkx) = 0.0_r8 + qrten(:mkx) = 0.0_r8 + qsten(:mkx) = 0.0_r8 + dwten(:mkx) = 0.0_r8 + diten(:mkx) = 0.0_r8 + precip = 0.0_r8 + snow = 0.0_r8 + evapc(:mkx) = 0.0_r8 + cufrc(:mkx) = 0.0_r8 + qcu(:mkx) = 0.0_r8 + qlu(:mkx) = 0.0_r8 + qiu(:mkx) = 0.0_r8 + fer(:mkx) = 0.0_r8 + fdr(:mkx) = 0.0_r8 + cin = 0.0_r8 + cbmf = 0.0_r8 + qc(:mkx) = 0.0_r8 + qc_l(:mkx) = 0.0_r8 + qc_i(:mkx) = 0.0_r8 + rliq = 0.0_r8 + cnt = real(mkx, r8) + cnb = 0.0_r8 + qtten(:mkx) = 0.0_r8 + slten(:mkx) = 0.0_r8 + ufrc(0:mkx) = 0.0_r8 + + thlu(0:mkx) = 0.0_r8 + qtu(0:mkx) = 0.0_r8 + uu(0:mkx) = 0.0_r8 + vu(0:mkx) = 0.0_r8 + wu(0:mkx) = 0.0_r8 + thvu(0:mkx) = 0.0_r8 + thlu_emf(0:mkx) = 0.0_r8 + qtu_emf(0:mkx) = 0.0_r8 + uu_emf(0:mkx) = 0.0_r8 + vu_emf(0:mkx) = 0.0_r8 + + ufrcinvbase = 0.0_r8 + ufrclcl = 0.0_r8 + winvbase = 0.0_r8 + wlcl = 0.0_r8 + emfkbup = 0.0_r8 + cbmflimit = 0.0_r8 + excessu_arr(:mkx) = 0.0_r8 + excess0_arr(:mkx) = 0.0_r8 + xc_arr(:mkx) = 0.0_r8 + aquad_arr(:mkx) = 0.0_r8 + bquad_arr(:mkx) = 0.0_r8 + cquad_arr(:mkx) = 0.0_r8 + bogbot_arr(:mkx) = 0.0_r8 + bogtop_arr(:mkx) = 0.0_r8 + + uemf(0:mkx) = 0.0_r8 + comsub(:mkx) = 0.0_r8 + qlten_sink(:mkx) = 0.0_r8 + qiten_sink(:mkx) = 0.0_r8 + nlten_sink(:mkx) = 0.0_r8 + niten_sink(:mkx) = 0.0_r8 + + do m = 1, ncnst + trflx(0:mkx,m) = 0.0_r8 + trten(:mkx,m) = 0.0_r8 + tru(0:mkx,m) = 0.0_r8 + tru_emf(0:mkx,m) = 0.0_r8 + enddo + + !-----------------------------------------------! + ! Below 'iter' loop is for implicit CIN closure ! + !-----------------------------------------------! + + ! ----------------------------------------------------------------------------- ! + ! It is important to note that this iterative cin loop is located at the outest ! + ! shell of the code. Thus, source air properties can also be changed during the ! + ! iterative cin calculation, because cumulus convection induces non-zero fluxes ! + ! even at interfaces below PBL top height through 'fluxbelowinv' subroutine. ! + ! ----------------------------------------------------------------------------- ! + + do iter = 1, iter_cin + + ! ---------------------------------------------------------------------- ! + ! Cumulus scale height ! + ! In contrast to the premitive code, cumulus scale height is iteratively ! + ! calculated at each time step, and at each iterative cin step. ! + ! It is not clear whether I should locate below two lines within or out ! + ! of the iterative cin loop. ! + ! ---------------------------------------------------------------------- ! + + tscaleh = cush + cush = -1._r8 + + ! ----------------------------------------------------------------------- ! + ! Find PBL top height interface index, 'kinv-1' where 'kinv' is the layer ! + ! index with PBLH in it. When PBLH is exactly at interface, 'kinv' is the ! + ! layer index having PBLH as a lower interface. ! + ! In the previous code, I set the lower limit of 'kinv' by 2 in order to ! + ! be consistent with the other parts of the code. However in the modified ! + ! code, I allowed 'kinv' to be 1 & if 'kinv = 1', I just exit the program ! + ! without performing cumulus convection. This new approach seems to be ! + ! more reasonable: if PBL height is within 'kinv=1' layer, surface is STL ! + ! interface (bflxs <= 0) and interface just above the surface should be ! + ! either non-turbulent (Ri>0.19) or stably turbulent (0<=Ri<0.19 but this ! + ! interface is identified as a base external interface of upperlying CL. ! + ! Thus, when 'kinv=1', PBL scheme guarantees 'bflxs <= 0'. For this case ! + ! it is reasonable to assume that cumulus convection does not happen. ! + ! When these is SBCL, PBL height from the PBL scheme is likely to be very ! + ! close at 'kinv-1' interface, but not exactly, since 'zi' information is ! + ! changed between two model time steps. In order to ensure correct identi ! + ! fication of 'kinv' for general case including SBCL, I imposed an offset ! + ! of 5 [m] in the below 'kinv' finding block. ! + ! ----------------------------------------------------------------------- ! + + do k = mkx - 1, 1, -1 + if( (pblh + 5._r8 - zs0(k))*(pblh + 5._r8 - zs0(k+1)) .lt. 0._r8 ) then + kinv = k + 1 + go to 15 + endif + end do + kinv = 1 +15 continue + + if( kinv .le. 1 ) then + exit_kinv1(i) = 1._r8 + id_exit = .true. + go to 333 + endif + ! From here, it must be 'kinv >= 2'. + + ! -------------------------------------------------------------------------- ! + ! Find PBL averaged tke ('tkeavg') and minimum 'thvl' ('thvlmin') in the PBL ! + ! In the current code, 'tkeavg' is obtained by averaging all interfacial TKE ! + ! within the PBL. However, in order to be conceptually consistent with PBL ! + ! scheme, 'tkeavg' should be calculated by considering surface buoyancy flux.! + ! If surface buoyancy flux is positive ( bflxs >0 ), surface interfacial TKE ! + ! should be included in calculating 'tkeavg', while if bflxs <= 0, surface ! + ! interfacial TKE should not be included in calculating 'tkeavg'. I should ! + ! modify the code when 'bflxs' is available as an input of cumulus scheme. ! + ! 'thvlmin' is a minimum 'thvl' within PBL obtained by comparing top & base ! + ! interface values of 'thvl' in each layers within the PBL. ! + ! -------------------------------------------------------------------------- ! + + dpsum = 0._r8 + tkeavg = 0._r8 + thvlmin = 1000._r8 + do k = 0, kinv - 1 ! Here, 'k' is an interfacial layer index. + if( k .eq. 0 ) then + dpi = ps0(0) - p0(1) + elseif( k .eq. (kinv-1) ) then + dpi = p0(kinv-1) - ps0(kinv-1) + else + dpi = p0(k) - p0(k+1) + endif + dpsum = dpsum + dpi + tkeavg = tkeavg + dpi*tke(k) + if( k .ne. 0 ) thvlmin = min(thvlmin,min(thvl0bot(k),thvl0top(k))) + end do + tkeavg = tkeavg/dpsum + + ! ------------------------------------------------------------------ ! + ! Find characteristics of cumulus source air: qtsrc,thlsrc,usrc,vsrc ! + ! Note that 'thlsrc' was con-cocked using 'thvlsrc' and 'qtsrc'. ! + ! 'qtsrc' is defined as the lowest layer mid-point value; 'thlsrc' ! + ! is from 'qtsrc' and 'thvlmin=thvlsrc'; 'usrc' & 'vsrc' are defined ! + ! as the values just below the PBL top interface. ! + ! ------------------------------------------------------------------ ! + + qtsrc = qt0(1) + thvlsrc = thvlmin + thlsrc = thvlsrc / ( 1._r8 + zvir * qtsrc ) + usrc = u0(kinv-1) + ssu0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + vsrc = v0(kinv-1) + ssv0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + do m = 1, ncnst + trsrc(m) = tr0(1,m) + enddo + + ! ------------------------------------------------------------------ ! + ! Find LCL of the source air and a layer index containing LCL (klcl) ! + ! When the LCL is exactly at the interface, 'klcl' is a layer index ! + ! having 'plcl' as the lower interface similar to the 'kinv' case. ! + ! In the previous code, I assumed that if LCL is located within the ! + ! lowest model layer ( 1 ) or the top model layer ( mkx ), then no ! + ! convective adjustment is performed and just exited. However, in ! + ! the revised code, I relaxed the first constraint and even though ! + ! LCL is at the lowest model layer, I allowed cumulus convection to ! + ! be initiated. For this case, cumulus convection should be started ! + ! from the PBL top height, as shown in the following code. ! + ! When source air is already saturated even at the surface, klcl is ! + ! set to 1. ! + ! ------------------------------------------------------------------ ! + + plcl = qsinvert(qtsrc,thlsrc,ps0(0)) + do k = 0, mkx + if( ps0(k) .lt. plcl ) then + klcl = k + go to 25 + endif + end do + klcl = mkx +25 continue + klcl = max(1,klcl) + + if( plcl .lt. 30000._r8 ) then + ! if( klcl .eq. mkx ) then + exit_klclmkx(i) = 1._r8 + id_exit = .true. + go to 333 + endif + + ! ------------------------------------------------------------- ! + ! Calculate environmental virtual potential temperature at LCL, ! + !'thv0lcl' which is solely used in the 'cin' calculation. Note ! + ! that 'thv0lcl' is calculated first by calculating 'thl0lcl' ! + ! and 'qt0lcl' at the LCL, and performing 'conden' afterward, ! + ! in fully consistent with the other parts of the code. ! + ! ------------------------------------------------------------- ! + + thl0lcl = thl0(klcl) + ssthl0(klcl) * ( plcl - p0(klcl) ) + qt0lcl = qt0(klcl) + ssqt0(klcl) * ( plcl - p0(klcl) ) + call conden(plcl,thl0lcl,qt0lcl,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0lcl = thj * ( 1._r8 + zvir * qvj - qlj - qij ) + + ! ------------------------------------------------------------------------ ! + ! Compute Convective Inhibition, 'cin' & 'cinlcl' [J/kg]=[m2/s2] TKE unit. ! + ! ! + ! 'cin' (cinlcl) is computed from the PBL top interface to LFC (LCL) using ! + ! piecewisely reconstructed environmental profiles, assuming environmental ! + ! buoyancy profile within each layer ( or from LCL to upper interface in ! + ! each layer ) is simply a linear profile. For the purpose of cin (cinlcl) ! + ! calculation, we simply assume that lateral entrainment does not occur in ! + ! updrafting cumulus plume, i.e., cumulus source air property is conserved.! + ! Below explains some rules used in the calculations of cin (cinlcl). In ! + ! general, both 'cin' and 'cinlcl' are calculated from a PBL top interface ! + ! to LCL and LFC, respectively : ! + ! 1. If LCL is lower than the PBL height, cinlcl = 0 and cin is calculated ! + ! from PBL height to LFC. ! + ! 2. If LCL is higher than PBL height, 'cinlcl' is calculated by summing ! + ! both positive and negative cloud buoyancy up to LCL using 'single_cin'! + ! From the LCL to LFC, however, only negative cloud buoyancy is counted ! + ! to calculate final 'cin' upto LFC. ! + ! 3. If either 'cin' or 'cinlcl' is negative, they are set to be zero. ! + ! In the below code, 'klfc' is the layer index containing 'LFC' similar to ! + ! 'kinv' and 'klcl'. ! + ! ------------------------------------------------------------------------ ! + + cin = 0._r8 + cinlcl = 0._r8 + plfc = 0._r8 + klfc = mkx + + ! ------------------------------------------------------------------------- ! + ! Case 1. LCL height is higher than PBL interface ( 'pLCL <= ps0(kinv-1)' ) ! + ! ------------------------------------------------------------------------- ! + + if( klcl .ge. kinv ) then + + do k = kinv, mkx - 1 + if( k .lt. klcl ) then + thvubot = thvlsrc + thvutop = thvlsrc + cin = cin + single_cin(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop) + elseif( k .eq. klcl ) then + !----- Bottom to LCL + thvubot = thvlsrc + thvutop = thvlsrc + cin = cin + single_cin(ps0(k-1),thv0bot(k),plcl,thv0lcl,thvubot,thvutop) + if( cin .lt. 0._r8 ) limit_cinlcl(i) = 1._r8 + cinlcl = max(cin,0._r8) + cin = cinlcl + !----- LCL to Top + thvubot = thvlsrc + call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + call getbuoy(plcl,thv0lcl,ps0(k),thv0top(k),thvubot,thvutop,plfc,cin) + if( plfc .gt. 0._r8 ) then + klfc = k + go to 35 + end if + else + thvubot = thvutop + call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + call getbuoy(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop,plfc,cin) + if( plfc .gt. 0._r8 ) then + klfc = k + go to 35 + end if + endif + end do + + ! ----------------------------------------------------------------------- ! + ! Case 2. LCL height is lower than PBL interface ( 'pLCL > ps0(kinv-1)' ) ! + ! ----------------------------------------------------------------------- ! + + else + cinlcl = 0._r8 + do k = kinv, mkx - 1 + call conden(ps0(k-1),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvubot = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + call getbuoy(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop,plfc,cin) + if( plfc .gt. 0._r8 ) then + klfc = k + go to 35 + end if + end do + endif ! End of CIN case selection + + 35 continue + if( cin .lt. 0._r8 ) limit_cin(i) = 1._r8 + cin = max(0._r8,cin) + if( klfc .ge. mkx ) then + klfc = mkx + ! write(iulog,*) 'klfc >= mkx' + exit_klfcmkx(i) = 1._r8 + id_exit = .true. + go to 333 + endif + + ! ---------------------------------------------------------------------- ! + ! In order to calculate implicit 'cin' (or 'cinlcl'), save the initially ! + ! calculated 'cin' and 'cinlcl', and other related variables. These will ! + ! be restored after calculating implicit CIN. ! + ! ---------------------------------------------------------------------- ! + + if( iter .eq. 1 ) then + cin_i = cin + cinlcl_i = cinlcl + ke = rbuoy / ( rkfre * tkeavg + epsvarw ) + kinv_o = kinv + klcl_o = klcl + klfc_o = klfc + plcl_o = plcl + plfc_o = plfc + tkeavg_o = tkeavg + thvlmin_o = thvlmin + qtsrc_o = qtsrc + thvlsrc_o = thvlsrc + thlsrc_o = thlsrc + usrc_o = usrc + vsrc_o = vsrc + thv0lcl_o = thv0lcl + do m = 1, ncnst + trsrc_o(m) = trsrc(m) + enddo + endif + + ! Modification : If I impose w = max(0.1_r8, w) up to the top interface of + ! klfc, I should only use cinlfc. That is, if I want to + ! use cinlcl, I should not impose w = max(0.1_r8, w). + ! Using cinlcl is equivalent to treating only 'saturated' + ! moist convection. Note that in this sense, I should keep + ! the functionality of both cinlfc and cinlcl. + ! However, the treatment of penetrative entrainment level becomes + ! ambiguous if I choose 'cinlcl'. Thus, the best option is to use + ! 'cinlfc'. + + ! -------------------------------------------------------------------------- ! + ! Calculate implicit 'cin' by averaging initial and final cins. Note that ! + ! implicit CIN is adopted only when cumulus convection stabilized the system,! + ! i.e., only when 'del_CIN >0'. If 'del_CIN<=0', just use explicit CIN. Note ! + ! also that since 'cinlcl' is set to zero whenever LCL is below the PBL top, ! + ! (see above CIN calculation part), the use of 'implicit CIN=cinlcl' is not ! + ! good. Thus, when using implicit CIN, always try to only use 'implicit CIN= ! + ! cin', not 'implicit CIN=cinlcl'. However, both 'CIN=cin' and 'CIN=cinlcl' ! + ! are good when using explicit CIN. ! + ! -------------------------------------------------------------------------- ! + + if( iter .ne. 1 ) then + + cin_f = cin + cinlcl_f = cinlcl + if( use_CINcin ) then + del_CIN = cin_f - cin_i + else + del_CIN = cinlcl_f - cinlcl_i + endif + + if( del_CIN .gt. 0._r8 ) then + + ! -------------------------------------------------------------- ! + ! Calculate implicit 'cin' and 'cinlcl'. Note that when we chose ! + ! to use 'implicit CIN = cin', choose 'cinlcl = cinlcl_i' below: ! + ! because iterative CIN only aims to obtain implicit CIN, once ! + ! we obtained 'implicit CIN=cin', it is good to use the original ! + ! profiles information for all the other variables after that. ! + ! Note 'cinlcl' will be explicitly used in calculating 'wlcl' & ! + ! 'ufrclcl' after calculating 'winv' & 'ufrcinv' at the PBL top ! + ! interface later, after calculating 'cbmf'. ! + ! -------------------------------------------------------------- ! + + alpha = compute_alpha( del_CIN, ke ) + cin = cin_i + alpha * del_CIN + if( use_CINcin ) then + cinlcl = cinlcl_i + else + cinlcl = cinlcl_i + alpha * del_cinlcl + endif + + ! ----------------------------------------------------------------- ! + ! Restore the original values from the previous 'iter_cin' step (1) ! + ! to compute correct tendencies for (n+1) time step by implicit CIN ! + ! ----------------------------------------------------------------- ! + + kinv = kinv_o + klcl = klcl_o + klfc = klfc_o + plcl = plcl_o + plfc = plfc_o + tkeavg = tkeavg_o + thvlmin = thvlmin_o + qtsrc = qtsrc_o + thvlsrc = thvlsrc_o + thlsrc = thlsrc_o + usrc = usrc_o + vsrc = vsrc_o + thv0lcl = thv0lcl_o + do m = 1, ncnst + trsrc(m) = trsrc_o(m) + enddo + + qv0(:mkx) = qv0_o(:mkx) + ql0(:mkx) = ql0_o(:mkx) + qi0(:mkx) = qi0_o(:mkx) + t0(:mkx) = t0_o(:mkx) + s0(:mkx) = s0_o(:mkx) + u0(:mkx) = u0_o(:mkx) + v0(:mkx) = v0_o(:mkx) + qt0(:mkx) = qt0_o(:mkx) + thl0(:mkx) = thl0_o(:mkx) + thvl0(:mkx) = thvl0_o(:mkx) + ssthl0(:mkx) = ssthl0_o(:mkx) + ssqt0(:mkx) = ssqt0_o(:mkx) + thv0bot(:mkx) = thv0bot_o(:mkx) + thv0top(:mkx) = thv0top_o(:mkx) + thvl0bot(:mkx) = thvl0bot_o(:mkx) + thvl0top(:mkx) = thvl0top_o(:mkx) + ssu0(:mkx) = ssu0_o(:mkx) + ssv0(:mkx) = ssv0_o(:mkx) + do m = 1, ncnst + tr0(:mkx,m) = tr0_o(:mkx,m) + sstr0(:mkx,m) = sstr0_o(:mkx,m) + enddo + + ! ------------------------------------------------------ ! + ! Initialize all fluxes, tendencies, and other variables ! + ! in association with cumulus convection. ! + ! ------------------------------------------------------ ! + + umf(0:mkx) = 0.0_r8 + emf(0:mkx) = 0.0_r8 + slflx(0:mkx) = 0.0_r8 + qtflx(0:mkx) = 0.0_r8 + uflx(0:mkx) = 0.0_r8 + vflx(0:mkx) = 0.0_r8 + qvten(:mkx) = 0.0_r8 + qlten(:mkx) = 0.0_r8 + qiten(:mkx) = 0.0_r8 + sten(:mkx) = 0.0_r8 + uten(:mkx) = 0.0_r8 + vten(:mkx) = 0.0_r8 + qrten(:mkx) = 0.0_r8 + qsten(:mkx) = 0.0_r8 + dwten(:mkx) = 0.0_r8 + diten(:mkx) = 0.0_r8 + precip = 0.0_r8 + snow = 0.0_r8 + evapc(:mkx) = 0.0_r8 + cufrc(:mkx) = 0.0_r8 + qcu(:mkx) = 0.0_r8 + qlu(:mkx) = 0.0_r8 + qiu(:mkx) = 0.0_r8 + fer(:mkx) = 0.0_r8 + fdr(:mkx) = 0.0_r8 + qc(:mkx) = 0.0_r8 + qc_l(:mkx) = 0.0_r8 + qc_i(:mkx) = 0.0_r8 + rliq = 0.0_r8 + cbmf = 0.0_r8 + cnt = real(mkx, r8) + cnb = 0.0_r8 + qtten(:mkx) = 0.0_r8 + slten(:mkx) = 0.0_r8 + ufrc(0:mkx) = 0.0_r8 + + thlu(0:mkx) = 0.0_r8 + qtu(0:mkx) = 0.0_r8 + uu(0:mkx) = 0.0_r8 + vu(0:mkx) = 0.0_r8 + wu(0:mkx) = 0.0_r8 + thvu(0:mkx) = 0.0_r8 + thlu_emf(0:mkx) = 0.0_r8 + qtu_emf(0:mkx) = 0.0_r8 + uu_emf(0:mkx) = 0.0_r8 + vu_emf(0:mkx) = 0.0_r8 + + do m = 1, ncnst + trflx(0:mkx,m) = 0.0_r8 + trten(:mkx,m) = 0.0_r8 + tru(0:mkx,m) = 0.0_r8 + tru_emf(0:mkx,m) = 0.0_r8 + enddo + + ! -------------------------------------------------- ! + ! Below are diagnostic output variables for detailed ! + ! analysis of cumulus scheme. ! + ! -------------------------------------------------- ! + + ufrcinvbase = 0.0_r8 + ufrclcl = 0.0_r8 + winvbase = 0.0_r8 + wlcl = 0.0_r8 + emfkbup = 0.0_r8 + cbmflimit = 0.0_r8 + excessu_arr(:mkx) = 0.0_r8 + excess0_arr(:mkx) = 0.0_r8 + xc_arr(:mkx) = 0.0_r8 + aquad_arr(:mkx) = 0.0_r8 + bquad_arr(:mkx) = 0.0_r8 + cquad_arr(:mkx) = 0.0_r8 + bogbot_arr(:mkx) = 0.0_r8 + bogtop_arr(:mkx) = 0.0_r8 + + else ! When 'del_CIN < 0', use explicit CIN instead of implicit CIN. + + ! ----------------------------------------------------------- ! + ! Identifier showing whether explicit or implicit CIN is used ! + ! ----------------------------------------------------------- ! + + ind_delcin(i) = 1._r8 + + ! --------------------------------------------------------- ! + ! Restore original output values of "iter_cin = 1" and exit ! + ! --------------------------------------------------------- ! + + umf_out(i,0:mkx) = umf_s(0:mkx) + qvten_out(i,:mkx) = qvten_s(:mkx) + qlten_out(i,:mkx) = qlten_s(:mkx) + qiten_out(i,:mkx) = qiten_s(:mkx) + sten_out(i,:mkx) = sten_s(:mkx) + uten_out(i,:mkx) = uten_s(:mkx) + vten_out(i,:mkx) = vten_s(:mkx) + qrten_out(i,:mkx) = qrten_s(:mkx) + qsten_out(i,:mkx) = qsten_s(:mkx) + precip_out(i) = precip_s + snow_out(i) = snow_s + evapc_out(i,:mkx) = evapc_s(:mkx) + cush_inout(i) = cush_s + cufrc_out(i,:mkx) = cufrc_s(:mkx) + slflx_out(i,0:mkx) = slflx_s(0:mkx) + qtflx_out(i,0:mkx) = qtflx_s(0:mkx) + qcu_out(i,:mkx) = qcu_s(:mkx) + qlu_out(i,:mkx) = qlu_s(:mkx) + qiu_out(i,:mkx) = qiu_s(:mkx) + cbmf_out(i) = cbmf_s + qc_out(i,:mkx) = qc_s(:mkx) + rliq_out(i) = rliq_s + cnt_out(i) = cnt_s + cnb_out(i) = cnb_s + do m = 1, ncnst + trten_out(i,:mkx,m) = trten_s(:mkx,m) + enddo + + ! ------------------------------------------------------------------------------ ! + ! Below are diagnostic output variables for detailed analysis of cumulus scheme. ! + ! The order of vertical index is reversed for this internal diagnostic output. ! + ! ------------------------------------------------------------------------------ ! + + fer_out(i,mkx:1:-1) = fer_s(:mkx) + fdr_out(i,mkx:1:-1) = fdr_s(:mkx) + cinh_out(i) = cin_s + cinlclh_out(i) = cinlcl_s + qtten_out(i,mkx:1:-1) = qtten_s(:mkx) + slten_out(i,mkx:1:-1) = slten_s(:mkx) + ufrc_out(i,mkx:0:-1) = ufrc_s(0:mkx) + uflx_out(i,mkx:0:-1) = uflx_s(0:mkx) + vflx_out(i,mkx:0:-1) = vflx_s(0:mkx) + + ufrcinvbase_out(i) = ufrcinvbase_s + ufrclcl_out(i) = ufrclcl_s + winvbase_out(i) = winvbase_s + wlcl_out(i) = wlcl_s + plcl_out(i) = plcl_s + pinv_out(i) = pinv_s + plfc_out(i) = plfc_s + pbup_out(i) = pbup_s + ppen_out(i) = ppen_s + qtsrc_out(i) = qtsrc_s + thlsrc_out(i) = thlsrc_s + thvlsrc_out(i) = thvlsrc_s + emfkbup_out(i) = emfkbup_s + cbmflimit_out(i) = cbmflimit_s + tkeavg_out(i) = tkeavg_s + zinv_out(i) = zinv_s + rcwp_out(i) = rcwp_s + rlwp_out(i) = rlwp_s + riwp_out(i) = riwp_s + + wu_out(i,mkx:0:-1) = wu_s(0:mkx) + qtu_out(i,mkx:0:-1) = qtu_s(0:mkx) + thlu_out(i,mkx:0:-1) = thlu_s(0:mkx) + thvu_out(i,mkx:0:-1) = thvu_s(0:mkx) + uu_out(i,mkx:0:-1) = uu_s(0:mkx) + vu_out(i,mkx:0:-1) = vu_s(0:mkx) + qtu_emf_out(i,mkx:0:-1) = qtu_emf_s(0:mkx) + thlu_emf_out(i,mkx:0:-1) = thlu_emf_s(0:mkx) + uu_emf_out(i,mkx:0:-1) = uu_emf_s(0:mkx) + vu_emf_out(i,mkx:0:-1) = vu_emf_s(0:mkx) + uemf_out(i,mkx:0:-1) = uemf_s(0:mkx) + + dwten_out(i,mkx:1:-1) = dwten_s(:mkx) + diten_out(i,mkx:1:-1) = diten_s(:mkx) + flxrain_out(i,mkx:0:-1) = flxrain_s(0:mkx) + flxsnow_out(i,mkx:0:-1) = flxsnow_s(0:mkx) + ntraprd_out(i,mkx:1:-1) = ntraprd_s(:mkx) + ntsnprd_out(i,mkx:1:-1) = ntsnprd_s(:mkx) + + excessu_arr_out(i,mkx:1:-1) = excessu_arr_s(:mkx) + excess0_arr_out(i,mkx:1:-1) = excess0_arr_s(:mkx) + xc_arr_out(i,mkx:1:-1) = xc_arr_s(:mkx) + aquad_arr_out(i,mkx:1:-1) = aquad_arr_s(:mkx) + bquad_arr_out(i,mkx:1:-1) = bquad_arr_s(:mkx) + cquad_arr_out(i,mkx:1:-1) = cquad_arr_s(:mkx) + bogbot_arr_out(i,mkx:1:-1) = bogbot_arr_s(:mkx) + bogtop_arr_out(i,mkx:1:-1) = bogtop_arr_s(:mkx) + + do m = 1, ncnst + trflx_out(i,mkx:0:-1,m) = trflx_s(0:mkx,m) + tru_out(i,mkx:0:-1,m) = tru_s(0:mkx,m) + tru_emf_out(i,mkx:0:-1,m) = tru_emf_s(0:mkx,m) + enddo + + id_exit = .false. + go to 333 + + endif + + endif + + ! ------------------------------------------------------------------ ! + ! Define a release level, 'prel' and release layer, 'krel'. ! + ! 'prel' is the lowest level from which buoyancy sorting occurs, and ! + ! 'krel' is the layer index containing 'prel' in it, similar to the ! + ! previous definitions of 'kinv', 'klcl', and 'klfc'. In order to ! + ! ensure that only PBL scheme works within the PBL, if LCL is below ! + ! PBL top height, then 'krel = kinv', while if LCL is above PBL top ! + ! height, then 'krel = klcl'. Note however that regardless of the ! + ! definition of 'krel', cumulus convection induces fluxes within PBL ! + ! through 'fluxbelowinv'. We can make cumulus convection start from ! + ! any level, even within the PBL by appropriately defining 'krel' & ! + ! 'prel' here. Then it must be accompanied by appropriate definition ! + ! of source air properties, CIN, and re-setting of 'fluxbelowinv', & ! + ! many other stuffs. ! + ! Note that even when 'prel' is located above the PBL top height, we ! + ! still have cumulus convection between PBL top height and 'prel': ! + ! we simply assume that no lateral mixing occurs in this range. ! + ! ------------------------------------------------------------------ ! + + if( klcl .lt. kinv ) then + krel = kinv + prel = ps0(krel-1) + thv0rel = thv0bot(krel) + else + krel = klcl + prel = plcl + thv0rel = thv0lcl + endif + + ! --------------------------------------------------------------------------- ! + ! Calculate cumulus base mass flux ('cbmf'), fractional area ('ufrcinv'), and ! + ! and mean vertical velocity (winv) of cumulus updraft at PBL top interface. ! + ! Also, calculate updraft fractional area (ufrclcl) and vertical velocity at ! + ! the LCL (wlcl). When LCL is below PBLH, cinlcl = 0 and 'ufrclcl = ufrcinv', ! + ! and 'wlcl = winv. ! + ! Only updrafts strong enough to overcome CIN can rise over PBL top interface.! + ! Thus, in order to calculate cumulus mass flux at PBL top interface, 'cbmf',! + ! we need to know 'CIN' ( the strength of potential energy barrier ) and ! + ! 'sigmaw' ( a standard deviation of updraft vertical velocity at the PBL top ! + ! interface, a measure of turbulentce strength in the PBL ). Naturally, the ! + ! ratio of these two variables, 'mu' - normalized CIN by TKE- is key variable ! + ! controlling 'cbmf'. If 'mu' becomes large, only small fraction of updrafts ! + ! with very strong TKE can rise over the PBL - both 'cbmf' and 'ufrc' becomes ! + ! small, but 'winv' becomes large ( this can be easily understood by PDF of w ! + ! at PBL top ). If 'mu' becomes small, lots of updraft can rise over the PBL ! + ! top - both 'cbmf' and 'ufrc' becomes large, but 'winv' becomes small. Thus, ! + ! all of the key variables associated with cumulus convection at the PBL top ! + ! - 'cbmf', 'ufrc', 'winv' where 'cbmf = rho*ufrc*winv' - are a unique functi ! + ! ons of 'mu', normalized CIN. Although these are uniquely determined by 'mu',! + ! we usually impose two comstraints on 'cbmf' and 'ufrc': (1) because we will ! + ! simply assume that subsidence warming and drying of 'kinv-1' layer in assoc ! + ! iation with 'cbmf' at PBL top interface is confined only in 'kinv-1' layer, ! + ! cbmf must not be larger than the mass within the 'kinv-1' layer. Otherwise, ! + ! instability will occur due to the breaking of stability con. If we consider ! + ! semi-Lagrangian vertical advection scheme and explicitly consider the exten ! + ! t of vertical movement of each layer in association with cumulus mass flux, ! + ! we don't need to impose this constraint. However, using a semi-Lagrangian ! + ! scheme is a future research subject. Note that this constraint should be ap ! + ! plied for all interfaces above PBL top as well as PBL top interface. As a ! + ! result, this 'cbmf' constraint impose a 'lower' limit on mu - 'mumin0'. (2) ! + ! in order for mass flux parameterization - rho*(w'a')= M*(a_c-a_e) - to be ! + ! valid, cumulus updraft fractional area should be much smaller than 1. In ! + ! current code, we impose 'rmaxfrac = 0.1 ~ 0.2' through the whole vertical ! + ! layers where cumulus convection occurs. At the PBL top interface, the same ! + ! constraint is made by imposing another lower 'lower' limit on mu, 'mumin1'. ! + ! After that, also limit 'ufrclcl' to be smaller than 'rmaxfrac' by 'mumin2'. ! + ! --------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------- ! + ! Calculate normalized CIN, 'mu' satisfying all the three constraints imposed ! + ! on 'cbmf'('mumin0'), 'ufrc' at the PBL top - 'ufrcinv' - ( by 'mumin1' from ! + ! a parameter sentence), and 'ufrc' at the LCL - 'ufrclcl' ( by 'mumin2'). ! + ! Note that 'cbmf' does not change between PBL top and LCL because we assume ! + ! that buoyancy sorting does not occur when cumulus updraft is unsaturated. ! + ! --------------------------------------------------------------------------- ! + + if( use_CINcin ) then + wcrit = sqrt( 2._r8 * cin * rbuoy ) + else + wcrit = sqrt( 2._r8 * cinlcl * rbuoy ) + endif + sigmaw = sqrt( rkfre * tkeavg + epsvarw ) + mu = wcrit/sigmaw/1.4142_r8 + if( mu .ge. 3._r8 ) then + ! write(iulog,*) 'mu >= 3' + id_exit = .true. + go to 333 + endif + rho0inv = ps0(kinv-1)/(r*thv0top(kinv-1)*exns0(kinv-1)) + cbmf = (rho0inv*sigmaw/2.5066_r8)*exp(-mu**2) + ! 1. 'cbmf' constraint + cbmflimit = 0.9_r8*dp0(kinv-1)/g/dt + mumin0 = 0._r8 + if( cbmf .gt. cbmflimit ) mumin0 = sqrt(-log(2.5066_r8*cbmflimit/rho0inv/sigmaw)) + ! 2. 'ufrcinv' constraint + mu = max(max(mu,mumin0),mumin1) + ! 3. 'ufrclcl' constraint + mulcl = sqrt(2._r8*cinlcl*rbuoy)/1.4142_r8/sigmaw + mulclstar = sqrt(max(0._r8,2._r8*(exp(-mu**2)/2.5066_r8)**2*(1._r8/erfc(mu)**2-0.25_r8/rmaxfrac**2))) + if( mulcl .gt. 1.e-8_r8 .and. mulcl .gt. mulclstar ) then + mumin2 = compute_mumin2(mulcl,rmaxfrac,mu) + if( mu .gt. mumin2 ) then + write(iulog,*) 'Critical error in mu calculation in UW_ShCu' + call endrun + endif + mu = max(mu,mumin2) + if( mu .eq. mumin2 ) limit_ufrc(i) = 1._r8 + endif + if( mu .eq. mumin0 ) limit_cbmf(i) = 1._r8 + if( mu .eq. mumin1 ) limit_ufrc(i) = 1._r8 + + ! ------------------------------------------------------------------- ! + ! Calculate final ['cbmf','ufrcinv','winv'] at the PBL top interface. ! + ! Note that final 'cbmf' here is obtained in such that 'ufrcinv' and ! + ! 'ufrclcl' are smaller than ufrcmax with no instability. ! + ! ------------------------------------------------------------------- ! + + cbmf = (rho0inv*sigmaw/2.5066_r8)*exp(-mu**2) + winv = sigmaw*(2._r8/2.5066_r8)*exp(-mu**2)/erfc(mu) + ufrcinv = cbmf/winv/rho0inv + + ! ------------------------------------------------------------------- ! + ! Calculate ['ufrclcl','wlcl'] at the LCL. When LCL is below PBL top, ! + ! it automatically becomes 'ufrclcl = ufrcinv' & 'wlcl = winv', since ! + ! it was already set to 'cinlcl=0' if LCL is below PBL top interface. ! + ! Note 'cbmf' at the PBL top is the same as 'cbmf' at the LCL. Note ! + ! also that final 'cbmf' here is obtained in such that 'ufrcinv' and ! + ! 'ufrclcl' are smaller than ufrcmax and there is no instability. ! + ! By construction, it must be 'wlcl > 0' but for assurance, I checked ! + ! this again in the below block. If 'ufrclcl < 0.1%', just exit. ! + ! ------------------------------------------------------------------- ! + + wtw = winv * winv - 2._r8 * cinlcl * rbuoy + if( wtw .le. 0._r8 ) then + ! write(iulog,*) 'wlcl < 0 at the LCL' + exit_wtw(i) = 1._r8 + id_exit = .true. + go to 333 + endif + wlcl = sqrt(wtw) + ufrclcl = cbmf/wlcl/rho0inv + wrel = wlcl + if( ufrclcl .le. 0.0001_r8 ) then + ! write(iulog,*) 'ufrclcl <= 0.0001' + exit_ufrc(i) = 1._r8 + id_exit = .true. + go to 333 + endif + ufrc(krel-1) = ufrclcl + + ! ----------------------------------------------------------------------- ! + ! Below is just diagnostic output for detailed analysis of cumulus scheme ! + ! ----------------------------------------------------------------------- ! + + ufrcinvbase = ufrcinv + winvbase = winv + umf(kinv-1:krel-1) = cbmf + wu(kinv-1:krel-1) = winv + + ! -------------------------------------------------------------------------- ! + ! Define updraft properties at the level where buoyancy sorting starts to be ! + ! happening, i.e., by definition, at 'prel' level within the release layer. ! + ! Because no lateral entrainment occurs upto 'prel', conservative scalars of ! + ! cumulus updraft at release level is same as those of source air. However, ! + ! horizontal momentums of source air are modified by horizontal PGF forcings ! + ! from PBL top interface to 'prel'. For this case, we should add additional ! + ! horizontal momentum from PBL top interface to 'prel' as will be done below ! + ! to 'usrc' and 'vsrc'. Note that below cumulus updraft properties - umf, wu,! + ! thlu, qtu, thvu, uu, vu - are defined all interfaces not at the layer mid- ! + ! point. From the index notation of cumulus scheme, wu(k) is the cumulus up- ! + ! draft vertical velocity at the top interface of k layer. ! + ! Diabatic horizontal momentum forcing should be treated as a kind of 'body' ! + ! forcing without actual mass exchange between convective updraft and ! + ! environment, but still taking horizontal momentum from the environment to ! + ! the convective updrafts. Thus, diabatic convective momentum transport ! + ! vertically redistributes environmental horizontal momentum. ! + ! -------------------------------------------------------------------------- ! + + emf(krel-1) = 0._r8 + umf(krel-1) = cbmf + wu(krel-1) = wrel + thlu(krel-1) = thlsrc + qtu(krel-1) = qtsrc + call conden(prel,thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + endif + thvu(krel-1) = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + + uplus = 0._r8 + vplus = 0._r8 + if( krel .eq. kinv ) then + uplus = PGFc * ssu0(kinv) * ( prel - ps0(kinv-1) ) + vplus = PGFc * ssv0(kinv) * ( prel - ps0(kinv-1) ) + else + do k = kinv, max(krel-1,kinv) + uplus = uplus + PGFc * ssu0(k) * ( ps0(k) - ps0(k-1) ) + vplus = vplus + PGFc * ssv0(k) * ( ps0(k) - ps0(k-1) ) + end do + uplus = uplus + PGFc * ssu0(krel) * ( prel - ps0(krel-1) ) + vplus = vplus + PGFc * ssv0(krel) * ( prel - ps0(krel-1) ) + end if + uu(krel-1) = usrc + uplus + vu(krel-1) = vsrc + vplus + + do m = 1, ncnst + tru(krel-1,m) = trsrc(m) + enddo + + ! -------------------------------------------------------------------------- ! + ! Define environmental properties at the level where buoyancy sorting occurs ! + ! ('pe', normally, layer midpoint except in the 'krel' layer). In the 'krel' ! + ! layer where buoyancy sorting starts to occur, however, 'pe' is defined ! + ! differently because LCL is regarded as lower interface for mixing purpose. ! + ! -------------------------------------------------------------------------- ! + + pe = 0.5_r8 * ( prel + ps0(krel) ) + dpe = prel - ps0(krel) + exne = exnf(pe) + thvebot = thv0rel + thle = thl0(krel) + ssthl0(krel) * ( pe - p0(krel) ) + qte = qt0(krel) + ssqt0(krel) * ( pe - p0(krel) ) + ue = u0(krel) + ssu0(krel) * ( pe - p0(krel) ) + ve = v0(krel) + ssv0(krel) * ( pe - p0(krel) ) + do m = 1, ncnst + tre(m) = tr0(krel,m) + sstr0(krel,m) * ( pe - p0(krel) ) + enddo + + !-------------------------! + ! Buoyancy-Sorting Mixing ! + !-------------------------!------------------------------------------------ ! + ! ! + ! In order to complete buoyancy-sorting mixing at layer mid-point, and so ! + ! calculate 'updraft mass flux, updraft w velocity, conservative scalars' ! + ! at the upper interface of each layer, we need following 3 information. ! + ! ! + ! 1. Pressure where mixing occurs ('pe'), and temperature at 'pe' which is ! + ! necessary to calculate various thermodynamic coefficients at pe. This ! + ! temperature is obtained by undiluted cumulus properties lifted to pe. ! + ! 2. Undiluted updraft properties at pe - conservative scalar and vertical ! + ! velocity -which are assumed to be the same as the properties at lower ! + ! interface only for calculation of fractional lateral entrainment and ! + ! detrainment rate ( fer(k) and fdr(k) [Pa-1] ), respectively. Final ! + ! values of cumulus conservative scalars and w at the top interface are ! + ! calculated afterward after obtaining fer(k) & fdr(k). ! + ! 3. Environmental properties at pe. ! + ! ------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------ ! + ! Define cumulus scale height. ! + ! Cumulus scale height is defined as the maximum height cumulus can reach. ! + ! In case of premitive code, cumulus scale height ('cush') at the current ! + ! time step was assumed to be the same as 'cush' of previous time step. ! + ! However, I directly calculated cush at each time step using an iterative ! + ! method. Note that within the cumulus scheme, 'cush' information is used ! + ! only at two places during buoyancy-sorting process: ! + ! (1) Even negatively buoyancy mixtures with strong vertical velocity ! + ! enough to rise up to 'rle*scaleh' (rle = 0.1) from pe are entrained ! + ! into cumulus updraft, ! + ! (2) The amount of mass that is involved in buoyancy-sorting mixing ! + ! process at pe is rei(k) = rkm/scaleh/rho*g [Pa-1] ! + ! In terms of (1), I think critical stopping distance might be replaced by ! + ! layer thickness. In future, we will use rei(k) = (0.5*rkm/z0(k)/rho/g). ! + ! In the premitive code, 'scaleh' was largely responsible for the jumping ! + ! variation of precipitation amount. ! + ! ------------------------------------------------------------------------ ! + + scaleh = tscaleh + if( tscaleh .lt. 0.0_r8 ) scaleh = 1000._r8 + + ! Save time : Set iter_scaleh = 1. This will automatically use 'cush' from the previous time step + ! at the first implicit iteration. At the second implicit iteration, it will use + ! the updated 'cush' by the first implicit cin. So, this updating has an effect of + ! doing one iteration for cush calculation, which is good. + ! So, only this setting of 'iter_scaleh = 1' is sufficient-enough to save computation time. + ! OK + + do iter_scaleh = 1, 3 + + ! ---------------------------------------------------------------- ! + ! Initialization of 'kbup' and 'kpen' ! + ! ---------------------------------------------------------------- ! + ! 'kbup' is the top-most layer in which cloud buoyancy is positive ! + ! both at the top and bottom interface of the layer. 'kpen' is the ! + ! layer upto which cumulus panetrates ,i.e., cumulus w at the base ! + ! interface is positive, but becomes negative at the top interface.! + ! Here, we initialize 'kbup' and 'kpen'. These initializations are ! + ! not trivial but important, expecially in calculating turbulent ! + ! fluxes without confliction among several physics as explained in ! + ! detail in the part of turbulent fluxes calculation later. Note ! + ! that regardless of whether 'kbup' and 'kpen' are updated or not ! + ! during updraft motion, penetrative entrainments are dumped down ! + ! across the top interface of 'kbup' later. More specifically,! + ! penetrative entrainment heat and moisture fluxes are calculated ! + ! from the top interface of 'kbup' layer to the base interface of ! + ! 'kpen' layer. Because of this, initialization of 'kbup' & 'kpen' ! + ! influence the convection system when there are not updated. The ! + ! below initialization of 'kbup = krel' assures that penetrative ! + ! entrainment fluxes always occur at interfaces above the PBL top ! + ! interfaces (i.e., only at interfaces k >=kinv ), which seems to ! + ! be attractable considering that the most correct fluxes at the ! + ! PBL top interface can be ontained from the 'fluxbelowinv' using ! + ! reconstructed PBL height. ! + ! The 'kbup = krel'(after going through the whole buoyancy sorting ! + ! proces during updraft motion) implies that cumulus updraft from ! + ! the PBL top interface can not reach to the LFC,so that 'kbup' is ! + ! not updated during upward. This means that cumulus updraft did ! + ! not fully overcome the buoyancy barrier above just the PBL top. ! + ! If 'kpen' is not updated either ( i.e., cumulus cannot rise over ! + ! the top interface of release layer),penetrative entrainment will ! + ! not happen at any interfaces. If cumulus updraft can rise above ! + ! the release layer but cannot fully overcome the buoyancy barrier ! + ! just above PBL top interface, penetratve entrainment occurs at ! + ! several above interfaces, including the top interface of release ! + ! layer. In the latter case, warming and drying tendencies will be ! + ! be initiated in 'krel' layer. Note current choice of 'kbup=krel' ! + ! is completely compatible with other flux physics without double ! + ! or miss counting turbulent fluxes at any interface. However, the ! + ! alternative choice of 'kbup=krel-1' also has itw own advantage - ! + ! when cumulus updraft cannot overcome buoyancy barrier just above ! + ! PBL top, entrainment warming and drying are concentrated in the ! + ! 'kinv-1' layer instead of 'kinv' layer for this case. This might ! + ! seems to be more dynamically reasonable, but I will choose the ! + ! 'kbup = krel' choice since it is more compatible with the other ! + ! parts of the code, expecially, when we chose ' use_emf=.false. ' ! + ! as explained in detail in turbulent flux calculation part. ! + ! ---------------------------------------------------------------- ! + + kbup = krel + kpen = krel + + ! ------------------------------------------------------------ ! + ! Since 'wtw' is continuously updated during vertical motion, ! + ! I need below initialization command within this 'iter_scaleh'! + ! do loop. Similarily, I need initializations of environmental ! + ! properties at 'krel' layer as below. ! + ! ------------------------------------------------------------ ! + + wtw = wlcl * wlcl + pe = 0.5_r8 * ( prel + ps0(krel) ) + dpe = prel - ps0(krel) + exne = exnf(pe) + thvebot = thv0rel + thle = thl0(krel) + ssthl0(krel) * ( pe - p0(krel) ) + qte = qt0(krel) + ssqt0(krel) * ( pe - p0(krel) ) + ue = u0(krel) + ssu0(krel) * ( pe - p0(krel) ) + ve = v0(krel) + ssv0(krel) * ( pe - p0(krel) ) + do m = 1, ncnst + tre(m) = tr0(krel,m) + sstr0(krel,m) * ( pe - p0(krel) ) + enddo + + ! ----------------------------------------------------------------------- ! + ! Cumulus rises upward from 'prel' ( or base interface of 'krel' layer ) ! + ! until updraft vertical velocity becomes zero. ! + ! Buoyancy sorting is performed via two stages. (1) Using cumulus updraft ! + ! properties at the base interface of each layer,perform buoyancy sorting ! + ! at the layer mid-point, 'pe', and update cumulus properties at the top ! + ! interface, and then (2) by averaging updated cumulus properties at the ! + ! top interface and cumulus properties at the base interface, calculate ! + ! cumulus updraft properties at pe that will be used in buoyancy sorting ! + ! mixing - thlue, qtue and, wue. Using this averaged properties, perform ! + ! buoyancy sorting again at pe, and re-calculate fer(k) and fdr(k). Using ! + ! this recalculated fer(k) and fdr(k), finally calculate cumulus updraft ! + ! properties at the top interface - thlu, qtu, thvu, uu, vu. In the below,! + ! 'iter_xc = 1' performs the first stage, while 'iter_xc= 2' performs the ! + ! second stage. We can increase the number of iterations, 'nter_xc'.as we ! + ! want, but a sample test indicated that about 3 - 5 iterations produced ! + ! satisfactory converent solution. Finally, identify 'kbup' and 'kpen'. ! + ! ----------------------------------------------------------------------- ! + + do k = krel, mkx - 1 ! Here, 'k' is a layer index. + + km1 = k - 1 + + thlue = thlu(km1) + qtue = qtu(km1) + wue = wu(km1) + wtwb = wtw + + do iter_xc = 1, niter_xc + + wtw = wu(km1) * wu(km1) + + ! ---------------------------------------------------------------- ! + ! Calculate environmental and cumulus saturation 'excess' at 'pe'. ! + ! Note that in order to calculate saturation excess, we should use ! + ! liquid water temperature instead of temperature as the argument ! + ! of "qsat". But note normal argument of "qsat" is temperature. ! + ! ---------------------------------------------------------------- ! + + call conden(pe,thle,qte,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0j = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + rho0j = pe / ( r * thv0j * exne ) + qsat_arg = thle*exne + call qsat(qsat_arg, pe, es, qs) + excess0 = qte - qs + + call conden(pe,thlue,qtue,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + ! ----------------------------------------------------------------- ! + ! Detrain excessive condensate larger than 'criqc' from the cumulus ! + ! updraft before performing buoyancy sorting. All I should to do is ! + ! to update 'thlue' & 'que' here. Below modification is completely ! + ! compatible with the other part of the code since 'thule' & 'qtue' ! + ! are used only for buoyancy sorting. I found that as long as I use ! + ! 'niter_xc >= 2', detraining excessive condensate before buoyancy ! + ! sorting has negligible influence on the buoyancy sorting results. ! + ! ----------------------------------------------------------------- ! + if( (qlj + qij) .gt. criqc ) then + exql = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij ) + exqi = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij ) + qtue = qtue - exql - exqi + thlue = thlue + (xlv/cp/exne)*exql + (xls/cp/exne)*exqi + endif + call conden(pe,thlue,qtue,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvj = thj * ( 1._r8 + zvir * qvj - qlj - qij ) + tj = thj * exne ! This 'tj' is used for computing thermo. coeffs. below + qsat_arg = thlue*exne + call qsat(qsat_arg, pe, es, qs) + excessu = qtue - qs + + ! ------------------------------------------------------------------- ! + ! Calculate critical mixing fraction, 'xc'. Mixture with mixing ratio ! + ! smaller than 'xc' will be entrained into cumulus updraft. Both the ! + ! saturated updrafts with 'positive buoyancy' or 'negative buoyancy + ! + ! strong vertical velocity enough to rise certain threshold distance' ! + ! are kept into the updraft in the below program. If the core updraft ! + ! is unsaturated, we can set 'xc = 0' and let the cumulus convection ! + ! still works or we may exit. ! + ! Current below code does not entrain unsaturated mixture. However it ! + ! should be modified such that it also entrain unsaturated mixture. ! + ! ------------------------------------------------------------------- ! + + ! ----------------------------------------------------------------- ! + ! cridis : Critical stopping distance for buoyancy sorting purpose. ! + ! scaleh is only used here. ! + ! ----------------------------------------------------------------- ! + + cridis = rle*scaleh ! Original code + ! cridis = 1._r8*(zs0(k) - zs0(k-1)) ! New code + + ! ---------------- ! + ! Buoyancy Sorting ! + ! ---------------- ! + + ! ----------------------------------------------------------------- ! + ! Case 1 : When both cumulus and env. are unsaturated or saturated. ! + ! ----------------------------------------------------------------- ! + + if( ( excessu .le. 0._r8 .and. excess0 .le. 0._r8 ) .or. ( excessu .ge. 0._r8 .and. excess0 .ge. 0._r8 ) ) then + xc = min(1._r8,max(0._r8,1._r8-2._r8*rbuoy*g*cridis/wue**2._r8*(1._r8-thvj/thv0j))) + ! Below 3 lines are diagnostic output not influencing + ! numerical calculations. + aquad = 0._r8 + bquad = 0._r8 + cquad = 0._r8 + else + ! -------------------------------------------------- ! + ! Case 2 : When either cumulus or env. is saturated. ! + ! -------------------------------------------------- ! + xsat = excessu / ( excessu - excess0 ); + thlxsat = thlue + xsat * ( thle - thlue ); + qtxsat = qtue + xsat * ( qte - qtue ); + call conden(pe,thlxsat,qtxsat,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvxsat = thj * ( 1._r8 + zvir * qvj - qlj - qij ) + ! -------------------------------------------------- ! + ! kk=1 : Cumulus Segment, kk=2 : Environment Segment ! + ! -------------------------------------------------- ! + do kk = 1, 2 + if( kk .eq. 1 ) then + thv_x0 = thvj; + thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvj + ( 1._r8/xsat ) * thvxsat; + else + thv_x1 = thv0j; + thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv0j + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat; + endif + aquad = wue**2; + bquad = 2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv0j - 2._r8*wue**2; + cquad = 2._r8*rbuoy*g*cridis*(thv_x0 - thv0j)/thv0j + wue**2; + if( kk .eq. 1 ) then + if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2)))) + else + x_cu = xsat; + endif + else + if( ( bquad**2-4._r8*aquad*cquad) .ge. 0._r8 ) then + call roots(aquad,bquad,cquad,xs1,xs2,status) + x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2)))) + else + x_en = 1._r8; + endif + endif + enddo + if( x_cu .eq. xsat ) then + xc = max(x_cu, x_en); + else + xc = x_cu; + endif + endif + + ! ------------------------------------------------------------------------ ! + ! Compute fractional lateral entrainment & detrainment rate in each layers.! + ! The unit of rei(k), fer(k), and fdr(k) is [Pa-1]. Alternative choice of ! + ! 'rei(k)' is also shown below, where coefficient 0.5 was from approximate ! + ! tuning against the BOMEX case. ! + ! In order to prevent the onset of instability in association with cumulus ! + ! induced subsidence advection, cumulus mass flux at the top interface in ! + ! any layer should be smaller than ( 90% of ) total mass within that layer.! + ! I imposed limits on 'rei(k)' as below, in such that stability condition ! + ! is always satisfied. ! + ! Below limiter of 'rei(k)' becomes negative for some cases, causing error.! + ! So, for the time being, I came back to the original limiter. ! + ! ------------------------------------------------------------------------ ! + ee2 = xc**2 + ud2 = 1._r8 - 2._r8*xc + xc**2 + ! rei(k) = ( rkm / scaleh / g / rho0j ) ! Default. + rei(k) = ( 0.5_r8 * rkm / z0(k) / g /rho0j ) ! Alternative. + if( xc .gt. 0.5_r8 ) rei(k) = min(rei(k),0.9_r8*log(dp0(k)/g/dt/umf(km1) + 1._r8)/dpe/(2._r8*xc-1._r8)) + fer(k) = rei(k) * ee2 + fdr(k) = rei(k) * ud2 + + ! ------------------------------------------------------------------------------ ! + ! Iteration Start due to 'maxufrc' constraint [ ****************************** ] ! + ! ------------------------------------------------------------------------------ ! + + ! -------------------------------------------------------------------------- ! + ! Calculate cumulus updraft mass flux and penetrative entrainment mass flux. ! + ! Note that non-zero penetrative entrainment mass flux will be asigned only ! + ! to interfaces from the top interface of 'kbup' layer to the base interface ! + ! of 'kpen' layer as will be shown later. ! + ! -------------------------------------------------------------------------- ! + + umf(k) = umf(km1) * exp( dpe * ( fer(k) - fdr(k) ) ) + emf(k) = 0._r8 + + ! --------------------------------------------------------- ! + ! Compute cumulus updraft properties at the top interface. ! + ! Also use Tayler expansion in order to treat limiting case ! + ! --------------------------------------------------------- ! + + if( fer(k)*dpe .lt. 1.e-4_r8 ) then + thlu(k) = thlu(km1) + ( thle + ssthl0(k) * dpe / 2._r8 - thlu(km1) ) * fer(k) * dpe + qtu(k) = qtu(km1) + ( qte + ssqt0(k) * dpe / 2._r8 - qtu(km1) ) * fer(k) * dpe + uu(k) = uu(km1) + ( ue + ssu0(k) * dpe / 2._r8 - uu(km1) ) * fer(k) * dpe - PGFc * ssu0(k) * dpe + vu(k) = vu(km1) + ( ve + ssv0(k) * dpe / 2._r8 - vu(km1) ) * fer(k) * dpe - PGFc * ssv0(k) * dpe + do m = 1, ncnst + tru(k,m) = tru(km1,m) + ( tre(m) + sstr0(k,m) * dpe / 2._r8 - tru(km1,m) ) * fer(k) * dpe + enddo + else + thlu(k) = ( thle + ssthl0(k) / fer(k) - ssthl0(k) * dpe / 2._r8 ) - & + ( thle + ssthl0(k) * dpe / 2._r8 - thlu(km1) + ssthl0(k) / fer(k) ) * exp(-fer(k) * dpe) + qtu(k) = ( qte + ssqt0(k) / fer(k) - ssqt0(k) * dpe / 2._r8 ) - & + ( qte + ssqt0(k) * dpe / 2._r8 - qtu(km1) + ssqt0(k) / fer(k) ) * exp(-fer(k) * dpe) + uu(k) = ( ue + ( 1._r8 - PGFc ) * ssu0(k) / fer(k) - ssu0(k) * dpe / 2._r8 ) - & + ( ue + ssu0(k) * dpe / 2._r8 - uu(km1) + ( 1._r8 - PGFc ) * ssu0(k) / fer(k) ) * exp(-fer(k) * dpe) + vu(k) = ( ve + ( 1._r8 - PGFc ) * ssv0(k) / fer(k) - ssv0(k) * dpe / 2._r8 ) - & + ( ve + ssv0(k) * dpe / 2._r8 - vu(km1) + ( 1._r8 - PGFc ) * ssv0(k) / fer(k) ) * exp(-fer(k) * dpe) + do m = 1, ncnst + tru(k,m) = ( tre(m) + sstr0(k,m) / fer(k) - sstr0(k,m) * dpe / 2._r8 ) - & + ( tre(m) + sstr0(k,m) * dpe / 2._r8 - tru(km1,m) + sstr0(k,m) / fer(k) ) * exp(-fer(k) * dpe) + enddo + end if + + !------------------------------------------------------------------- ! + ! Expel some of cloud water and ice from cumulus updraft at the top ! + ! interface. Note that this is not 'detrainment' term but a 'sink' ! + ! term of cumulus updraft qt ( or one part of 'source' term of mean ! + ! environmental qt ). At this stage, as the most simplest choice, if ! + ! condensate amount within cumulus updraft is larger than a critical ! + ! value, 'criqc', expels the surplus condensate from cumulus updraft ! + ! to the environment. A certain fraction ( e.g., 'frc_sus' ) of this ! + ! expelled condesnate will be in a form that can be suspended in the ! + ! layer k where it was formed, while the other fraction, '1-frc_sus' ! + ! will be in a form of precipitatble (e.g.,can potentially fall down ! + ! across the base interface of layer k ). In turn we should describe ! + ! subsequent falling of precipitable condensate ('1-frc_sus') across ! + ! the base interface of the layer k, & evaporation of precipitating ! + ! water in the below layer k-1 and associated evaporative cooling of ! + ! the later, k-1, and falling of 'non-evaporated precipitating water ! + ! ( which was initially formed in layer k ) and a newly-formed preci ! + ! pitable water in the layer, k-1', across the base interface of the ! + ! lower layer k-1. Cloud microphysics should correctly describe all ! + ! of these process. In a near future, I should significantly modify ! + ! this cloud microphysics, including precipitation-induced downdraft ! + ! also. ! + ! ------------------------------------------------------------------ ! + + call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + if( (qlj + qij) .gt. criqc ) then + exql = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij ) + exqi = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij ) + ! ---------------------------------------------------------------- ! + ! It is very important to re-update 'qtu' and 'thlu' at the upper ! + ! interface after expelling condensate from cumulus updraft at the ! + ! top interface of the layer. As mentioned above, this is a 'sink' ! + ! of cumulus qt (or equivalently, a 'source' of environmentasl qt),! + ! not a regular convective'detrainment'. ! + ! ---------------------------------------------------------------- ! + qtu(k) = qtu(k) - exql - exqi + thlu(k) = thlu(k) + (xlv/cp/exns0(k))*exql + (xls/cp/exns0(k))*exqi + ! ---------------------------------------------------------------- ! + ! Expelled cloud condensate into the environment from the updraft. ! + ! After all the calculation later, 'dwten' and 'diten' will have a ! + ! unit of [ kg/kg/s ], because it is a tendency of qt. Restoration ! + ! of 'dwten' and 'diten' to this correct unit through multiplying ! + ! 'umf(k)*g/dp0(k)' will be performed later after finally updating ! + ! 'umf' using a 'rmaxfrac' constraint near the end of this updraft ! + ! buoyancy sorting loop. ! + ! ---------------------------------------------------------------- ! + dwten(k) = exql + diten(k) = exqi + else + dwten(k) = 0._r8 + diten(k) = 0._r8 + endif + ! ----------------------------------------------------------------- ! + ! Update 'thvu(k)' after detraining condensate from cumulus updraft.! + ! ----------------------------------------------------------------- ! + call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thvu(k) = thj * ( 1._r8 + zvir * qvj - qlj - qij ) + + ! ----------------------------------------------------------- ! + ! Calculate updraft vertical velocity at the upper interface. ! + ! In order to calculate 'wtw' at the upper interface, we use ! + ! 'wtw' at the lower interface. Note 'wtw' is continuously ! + ! updated as cumulus updraft rises. ! + ! ----------------------------------------------------------- ! + + bogbot = rbuoy * ( thvu(km1) / thvebot - 1._r8 ) ! Cloud buoyancy at base interface + bogtop = rbuoy * ( thvu(k) / thv0top(k) - 1._r8 ) ! Cloud buoyancy at top interface + + delbog = bogtop - bogbot + drage = fer(k) * ( 1._r8 + rdrag ) + expfac = exp(-2._r8*drage*dpe) + + wtwb = wtw + if( drage*dpe .gt. 1.e-3_r8 ) then + wtw = wtw*expfac + (delbog + (1._r8-expfac)*(bogbot + delbog/(-2._r8*drage*dpe)))/(rho0j*drage) + else + wtw = wtw + dpe * ( bogbot + bogtop ) / rho0j + endif + + ! Force the plume rise at least to klfc of the undiluted plume. + ! Because even the below is not complete, I decided not to include this. + + ! if( k .le. klfc ) then + ! wtw = max( 1.e-2_r8, wtw ) + ! endif + + ! -------------------------------------------------------------- ! + ! Repeat 'iter_xc' iteration loop until 'iter_xc = niter_xc'. ! + ! Also treat the case even when wtw < 0 at the 'kpen' interface. ! + ! -------------------------------------------------------------- ! + + if( wtw .gt. 0._r8 ) then + thlue = 0.5_r8 * ( thlu(km1) + thlu(k) ) + qtue = 0.5_r8 * ( qtu(km1) + qtu(k) ) + wue = 0.5_r8 * sqrt( max( wtwb + wtw, 0._r8 ) ) + else + go to 111 + endif + + enddo ! End of 'iter_xc' loop + + 111 continue + + ! --------------------------------------------------------------------------- ! + ! Add the contribution of self-detrainment to vertical variations of cumulus ! + ! updraft mass flux. The reason why we are trying to include self-detrainment ! + ! is as follows. In current scheme, vertical variation of updraft mass flux ! + ! is not fully consistent with the vertical variation of updraft vertical w. ! + ! For example, within a given layer, let's assume that cumulus w is positive ! + ! at the base interface, while negative at the top interface. This means that ! + ! cumulus updraft cannot reach to the top interface of the layer. However, ! + ! cumulus updraft mass flux at the top interface is not zero according to the ! + ! vertical tendency equation of cumulus mass flux. Ideally, cumulus updraft ! + ! mass flux at the top interface should be zero for this case. In order to ! + ! assures that cumulus updraft mass flux goes to zero when cumulus updraft ! + ! vertical velocity goes to zero, we are imposing self-detrainment term as ! + ! below by considering layer-mean cloud buoyancy and cumulus updraft vertical ! + ! velocity square at the top interface. Use of auto-detrainment term will be ! + ! determined by setting 'use_self_detrain=.true.' in the parameter sentence. ! + ! --------------------------------------------------------------------------- ! + + if( use_self_detrain ) then + autodet = min( 0.5_r8*g*(bogbot+bogtop)/(max(wtw,0._r8)+1.e-4_r8), 0._r8 ) + umf(k) = umf(k) * exp( 0.637_r8*(dpe/rho0j/g) * autodet ) + end if + if( umf(k) .eq. 0._r8 ) wtw = -1._r8 + + ! -------------------------------------- ! + ! Below block is just a dignostic output ! + ! -------------------------------------- ! + + excessu_arr(k) = excessu + excess0_arr(k) = excess0 + xc_arr(k) = xc + aquad_arr(k) = aquad + bquad_arr(k) = bquad + cquad_arr(K) = cquad + bogbot_arr(k) = bogbot + bogtop_arr(k) = bogtop + + ! ------------------------------------------------------------------- ! + ! 'kbup' is the upper most layer in which cloud buoyancy is positive ! + ! both at the base and top interface. 'kpen' is the upper most layer ! + ! up to cumulus can reach. Usually, 'kpen' is located higher than the ! + ! 'kbup'. Note we initialized these by 'kbup = krel' & 'kpen = krel'. ! + ! As explained before, it is possible that only 'kpen' is updated, ! + ! while 'kbup' keeps its initialization value. For this case, current ! + ! scheme will simply turns-off penetrative entrainment fluxes and use ! + ! normal buoyancy-sorting fluxes for 'kbup <= k <= kpen-1' interfaces,! + ! in order to describe shallow continental cumulus convection. ! + ! ------------------------------------------------------------------- ! + + ! if( bogbot .gt. 0._r8 .and. bogtop .gt. 0._r8 ) then + ! if( bogtop .gt. 0._r8 ) then + if( bogtop .gt. 0._r8 .and. wtw .gt. 0._r8 ) then + kbup = k + end if + + if( wtw .le. 0._r8 ) then + kpen = k + go to 45 + end if + + wu(k) = sqrt(wtw) + if( wu(k) .gt. 100._r8 ) then + exit_wu(i) = 1._r8 + id_exit = .true. + go to 333 + endif + + ! ---------------------------------------------------------------------------- ! + ! Iteration end due to 'rmaxfrac' constraint [ ***************************** ] ! + ! ---------------------------------------------------------------------------- ! + + ! ---------------------------------------------------------------------- ! + ! Calculate updraft fractional area at the upper interface and set upper ! + ! limit to 'ufrc' by 'rmaxfrac'. In order to keep the consistency among ! + ! ['ufrc','umf','wu (or wtw)'], if ufrc is limited by 'rmaxfrac', either ! + ! 'umf' or 'wu' should be changed. Although both 'umf' and 'wu (wtw)' at ! + ! the current upper interface are used for updating 'umf' & 'wu' at the ! + ! next upper interface, 'umf' is a passive variable not influencing the ! + ! buoyancy sorting process in contrast to 'wtw'. This is a reason why we ! + ! adjusted 'umf' instead of 'wtw'. In turn we updated 'fdr' here instead ! + ! of 'fer', which guarantees that all previously updated thermodynamic ! + ! variables at the upper interface before applying 'rmaxfrac' constraint ! + ! are already internally consistent, even though 'ufrc' is limited by ! + ! 'rmaxfrac'. Thus, we don't need to go through interation loop again.If ! + ! If we update 'fer' however, we should go through above iteration loop. ! + ! ---------------------------------------------------------------------- ! + + rhos0j = ps0(k) / ( r * 0.5_r8 * ( thv0bot(k+1) + thv0top(k) ) * exns0(k) ) + ufrc(k) = umf(k) / ( rhos0j * wu(k) ) + if( ufrc(k) .gt. rmaxfrac ) then + limit_ufrc(i) = 1._r8 + ufrc(k) = rmaxfrac + umf(k) = rmaxfrac * rhos0j * wu(k) + fdr(k) = fer(k) - log( umf(k) / umf(km1) ) / dpe + endif + + ! ------------------------------------------------------------ ! + ! Update environmental properties for at the mid-point of next ! + ! upper layer for use in buoyancy sorting. ! + ! ------------------------------------------------------------ ! + + pe = p0(k+1) + dpe = dp0(k+1) + exne = exn0(k+1) + thvebot = thv0bot(k+1) + thle = thl0(k+1) + qte = qt0(k+1) + ue = u0(k+1) + ve = v0(k+1) + do m = 1, ncnst + tre(m) = tr0(k+1,m) + enddo + + end do ! End of cumulus updraft loop from the 'krel' layer to 'kpen' layer. + + ! ------------------------------------------------------------------------------- ! + ! Up to this point, we finished all of buoyancy sorting processes from the 'krel' ! + ! layer to 'kpen' layer: at the top interface of individual layers, we calculated ! + ! updraft and penetrative mass fluxes [ umf(k) & emf(k) = 0 ], updraft fractional ! + ! area [ ufrc(k) ], updraft vertical velocity [ wu(k) ], updraft thermodynamic ! + ! variables [thlu(k),qtu(k),uu(k),vu(k),thvu(k)]. In the layer,we also calculated ! + ! fractional entrainment-detrainment rate [ fer(k), fdr(k) ], and detrainment ten ! + ! dency of water and ice from cumulus updraft [ dwten(k), diten(k) ]. In addition,! + ! we updated and identified 'krel' and 'kpen' layer index, if any. In the 'kpen' ! + ! layer, we calculated everything mentioned above except the 'wu(k)' and 'ufrc(k)'! + ! since a real value of updraft vertical velocity is not defined at the kpen top ! + ! interface (note 'ufrc' at the top interface of layer is calculated from 'umf(k)'! + ! and 'wu(k)'). As mentioned before, special treatment is required when 'kbup' is ! + ! not updated and so 'kbup = krel'. ! + ! ------------------------------------------------------------------------------- ! + + ! ------------------------------------------------------------------------------ ! + ! During the 'iter_scaleh' iteration loop, non-physical ( with non-zero values ) ! + ! values can remain in the variable arrays above (also 'including' in case of wu ! + ! and ufrc at the top interface) the 'kpen' layer. This can happen when the kpen ! + ! layer index identified from the 'iter_scaleh = 1' iteration loop is located at ! + ! above the kpen layer index identified from 'iter_scaleh = 3' iteration loop. ! + ! Thus, in the following calculations, we should only use the values in each ! + ! variables only up to finally identified 'kpen' layer & 'kpen' interface except ! + ! 'wu' and 'ufrc' at the top interface of 'kpen' layer. Note that in order to ! + ! prevent any problems due to these non-physical values, I re-initialized the ! + ! values of [ umf(kpen:mkx), emf(kpen:mkx), dwten(kpen+1:mkx), diten(kpen+1:mkx),! + ! fer(kpen:mkx), fdr(kpen+1:mkx), ufrc(kpen:mkx) ] to be zero after 'iter_scaleh'! + ! do loop. ! + ! ------------------------------------------------------------------------------ ! + + 45 continue + + ! ------------------------------------------------------------------------------ ! + ! Calculate 'ppen( < 0 )', updarft penetrative distance from the lower interface ! + ! of 'kpen' layer. Note that bogbot & bogtop at the 'kpen' layer either when fer ! + ! is zero or non-zero was already calculated above. ! + ! It seems that below qudarature solving formula is valid only when bogbot < 0. ! + ! Below solving equation is clearly wrong ! I should revise this ! ! + ! ------------------------------------------------------------------------------ ! + + if( drage .eq. 0._r8 ) then + aquad = ( bogtop - bogbot ) / ( ps0(kpen) - ps0(kpen-1) ) + bquad = 2._r8 * bogbot + cquad = -wu(kpen-1)**2 * rho0j + call roots(aquad,bquad,cquad,xc1,xc2,status) + if( status .eq. 0 ) then + if( xc1 .le. 0._r8 .and. xc2 .le. 0._r8 ) then + ppen = max( xc1, xc2 ) + ppen = min( 0._r8,max( -dp0(kpen), ppen ) ) + elseif( xc1 .gt. 0._r8 .and. xc2 .gt. 0._r8 ) then + ppen = -dp0(kpen) + write(iulog,*) 'Warning : UW-Cumulus penetrates upto kpen interface' + else + ppen = min( xc1, xc2 ) + ppen = min( 0._r8,max( -dp0(kpen), ppen ) ) + endif + else + ppen = -dp0(kpen) + write(iulog,*) 'Warning : UW-Cumulus penetrates upto kpen interface' + endif + else + ppen = compute_ppen(wtwb,drage,bogbot,bogtop,rho0j,dp0(kpen)) + endif + if( ppen .eq. -dp0(kpen) .or. ppen .eq. 0._r8 ) limit_ppen(i) = 1._r8 + + ! -------------------------------------------------------------------- ! + ! Re-calculate the amount of expelled condensate from cloud updraft ! + ! at the cumulus top. This is necessary for refined calculations of ! + ! bulk cloud microphysics at the cumulus top. Note that ppen < 0._r8 ! + ! In the below, I explicitly calculate 'thlu_top' & 'qtu_top' by ! + ! using non-zero 'fer(kpen)'. ! + ! -------------------------------------------------------------------- ! + + if( fer(kpen)*(-ppen) .lt. 1.e-4_r8 ) then + thlu_top = thlu(kpen-1) + ( thl0(kpen) + ssthl0(kpen) * (-ppen) / 2._r8 - thlu(kpen-1) ) * fer(kpen) * (-ppen) + qtu_top = qtu(kpen-1) + ( qt0(kpen) + ssqt0(kpen) * (-ppen) / 2._r8 - qtu(kpen-1) ) * fer(kpen) * (-ppen) + else + thlu_top = ( thl0(kpen) + ssthl0(kpen) / fer(kpen) - ssthl0(kpen) * (-ppen) / 2._r8 ) - & + ( thl0(kpen) + ssthl0(kpen) * (-ppen) / 2._r8 - thlu(kpen-1) + ssthl0(kpen) / fer(kpen) ) & + * exp(-fer(kpen) * (-ppen)) + qtu_top = ( qt0(kpen) + ssqt0(kpen) / fer(kpen) - ssqt0(kpen) * (-ppen) / 2._r8 ) - & + ( qt0(kpen) + ssqt0(kpen) * (-ppen) / 2._r8 - qtu(kpen-1) + ssqt0(kpen) / fer(kpen) ) & + * exp(-fer(kpen) * (-ppen)) + end if + + call conden(ps0(kpen-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + exntop = ((ps0(kpen-1)+ppen)/p00)**rovcp + if( (qlj + qij) .gt. criqc ) then + dwten(kpen) = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij ) + diten(kpen) = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij ) + qtu_top = qtu_top - dwten(kpen) - diten(kpen) + thlu_top = thlu_top + (xlv/cp/exntop)*dwten(kpen) + (xls/cp/exntop)*diten(kpen) + else + dwten(kpen) = 0._r8 + diten(kpen) = 0._r8 + endif + + ! ----------------------------------------------------------------------- ! + ! Calculate cumulus scale height as the top height that cumulus can reach.! + ! ----------------------------------------------------------------------- ! + + rhos0j = ps0(kpen-1)/(r*0.5_r8*(thv0bot(kpen)+thv0top(kpen-1))*exns0(kpen-1)) + cush = zs0(kpen-1) - ppen/rhos0j/g + scaleh = cush + + end do ! End of 'iter_scaleh' loop. + + ! -------------------------------------------------------------------- ! + ! The 'forcedCu' is logical identifier saying whether cumulus updraft ! + ! overcome the buoyancy barrier just above the PBL top. If it is true, ! + ! cumulus did not overcome the barrier - this is a shallow convection ! + ! with negative cloud buoyancy, mimicking shallow continental cumulus ! + ! convection. Depending on 'forcedCu' parameter, treatment of heat & ! + ! moisture fluxes at the entraining interfaces, 'kbup <= k < kpen - 1' ! + ! will be set up in a different ways, as will be shown later. ! + ! -------------------------------------------------------------------- ! + + if( kbup .eq. krel ) then + forcedCu = .true. + limit_shcu(i) = 1._r8 + else + forcedCu = .false. + limit_shcu(i) = 0._r8 + endif + + ! ------------------------------------------------------------------ ! + ! Filtering of unerasonable cumulus adjustment here. This is a very ! + ! important process which should be done cautiously. Various ways of ! + ! filtering are possible depending on cases mainly using the indices ! + ! of key layers - 'klcl','kinv','krel','klfc','kbup','kpen'. At this ! + ! stage, the followings are all possible : 'kinv >= 2', 'klcl >= 1', ! + ! 'krel >= kinv', 'kbup >= krel', 'kpen >= krel'. I must design this ! + ! filtering very cautiously, in such that none of realistic cumulus ! + ! convection is arbitrarily turned-off. Potentially, I might turn-off! + ! cumulus convection if layer-mean 'ql > 0' in the 'kinv-1' layer,in ! + ! order to suppress cumulus convection growing, based at the Sc top. ! + ! This is one of potential future modifications. Note that ppen < 0. ! + ! ------------------------------------------------------------------ ! + + cldhgt = ps0(kpen-1) + ppen + if( forcedCu ) then + ! write(iulog,*) 'forcedCu - did not overcome initial buoyancy barrier' + exit_cufilter(i) = 1._r8 + id_exit = .true. + go to 333 + end if + ! Limit 'additional shallow cumulus' for DYCOMS simulation. + ! if( cldhgt.ge.88000._r8 ) then + ! id_exit = .true. + ! go to 333 + ! end if + + ! ------------------------------------------------------------------------------ ! + ! Re-initializing some key variables above the 'kpen' layer in order to suppress ! + ! the influence of non-physical values above 'kpen', in association with the use ! + ! of 'iter_scaleh' loop. Note that umf, emf, ufrc are defined at the interfaces ! + ! (0:mkx), while 'dwten','diten', 'fer', 'fdr' are defined at layer mid-points. ! + ! Initialization of 'fer' and 'fdr' is for correct writing purpose of diagnostic ! + ! output. Note that we set umf(kpen)=emf(kpen)=ufrc(kpen)=0, in consistent with ! + ! wtw < 0 at the top interface of 'kpen' layer. However, we still have non-zero ! + ! expelled cloud condensate in the 'kpen' layer. ! + ! ------------------------------------------------------------------------------ ! + + umf(kpen:mkx) = 0._r8 + emf(kpen:mkx) = 0._r8 + ufrc(kpen:mkx) = 0._r8 + dwten(kpen+1:mkx) = 0._r8 + diten(kpen+1:mkx) = 0._r8 + fer(kpen+1:mkx) = 0._r8 + fdr(kpen+1:mkx) = 0._r8 + + ! ------------------------------------------------------------------------ ! + ! Calculate downward penetrative entrainment mass flux, 'emf(k) < 0', and ! + ! thermodynamic properties of penetratively entrained airs at entraining ! + ! interfaces. emf(k) is defined from the top interface of the layer kbup ! + ! to the bottom interface of the layer 'kpen'. Note even when kbup = krel,! + ! i.e.,even when 'kbup' was not updated in the above buoyancy sorting do ! + ! loop (i.e., 'kbup' remains as the initialization value), below do loop ! + ! of penetrative entrainment flux can be performed without any conceptual ! + ! or logical problems, because we have already computed all the variables ! + ! necessary for performing below penetrative entrainment block. ! + ! In the below 'do' loop, 'k' is an interface index at which non-zero 'emf'! + ! (penetrative entrainment mass flux) is calculated. Since cumulus updraft ! + ! is negatively buoyant in the layers between the top interface of 'kbup' ! + ! layer (interface index, kbup) and the top interface of 'kpen' layer, the ! + ! fractional lateral entrainment, fer(k) within these layers will be close ! + ! to zero - so it is likely that only strong lateral detrainment occurs in ! + ! thses layers. Under this situation,we can easily calculate the amount of ! + ! detrainment cumulus air into these negatively buoyanct layers by simply ! + ! comparing cumulus updraft mass fluxes between the base and top interface ! + ! of each layer: emf(k) = emf(k-1)*exp(-fdr(k)*dp0(k)) ! + ! ~ emf(k-1)*(1-rei(k)*dp0(k)) ! + ! emf(k-1)-emf(k) ~ emf(k-1)*rei(k)*dp0(k) ! + ! Current code assumes that about 'rpen~10' times of these detrained mass ! + ! are penetratively re-entrained down into the 'k-1' interface. And all of ! + ! these detrained masses are finally dumped down into the top interface of ! + ! 'kbup' layer. Thus, the amount of penetratively entrained air across the ! + ! top interface of 'kbup' layer with 'rpen~10' becomes too large. ! + ! Note that this penetrative entrainment part can be completely turned-off ! + ! and we can simply use normal buoyancy-sorting involved turbulent fluxes ! + ! by modifying 'penetrative entrainment fluxes' part below. ! + ! ------------------------------------------------------------------------ ! + + ! -----------------------------------------------------------------------! + ! Calculate entrainment mass flux and conservative scalars of entraining ! + ! free air at interfaces of 'kbup <= k < kpen - 1' ! + ! ---------------------------------------------------------------------- ! + + do k = 0, mkx + thlu_emf(k) = thlu(k) + qtu_emf(k) = qtu(k) + uu_emf(k) = uu(k) + vu_emf(k) = vu(k) + do m = 1, ncnst + tru_emf(k,m) = tru(k,m) + enddo + end do + + do k = kpen - 1, kbup, -1 ! Here, 'k' is an interface index at which + ! penetrative entrainment fluxes are calculated. + + rhos0j = ps0(k) / ( r * 0.5_r8 * ( thv0bot(k+1) + thv0top(k) ) * exns0(k) ) + + if( k .eq. kpen - 1 ) then + + ! ------------------------------------------------------------------------ ! + ! Note that 'ppen' has already been calculated in the above 'iter_scaleh' ! + ! loop assuming zero lateral entrainmentin the layer 'kpen'. ! + ! ------------------------------------------------------------------------ ! + + ! -------------------------------------------------------------------- ! + ! Calculate returning mass flux, emf ( < 0 ) ! + ! Current penetrative entrainment rate with 'rpen~10' is too large and ! + ! future refinement is necessary including the definition of 'thl','qt'! + ! of penetratively entrained air. Penetratively entrained airs across ! + ! the 'kpen-1' interface is assumed to have the properties of the base ! + ! interface of 'kpen' layer. Note that 'emf ~ - umf/ufrc = - w * rho'. ! + ! Thus, below limit sets an upper limit of |emf| to be ~ 10cm/s, which ! + ! is very loose constraint. Here, I used more restricted constraint on ! + ! the limit of emf, assuming 'emf' cannot exceed a net mass within the ! + ! layer above the interface. Similar to the case of warming and drying ! + ! due to cumulus updraft induced compensating subsidence, penetrative ! + ! entrainment induces compensating upwelling - in order to prevent ! + ! numerical instability in association with compensating upwelling, we ! + ! should similarily limit the amount of penetrative entrainment at the ! + ! interface by the amount of masses within the layer just above the ! + ! penetratively entraining interface. ! + ! -------------------------------------------------------------------- ! + + if( ( umf(k)*ppen*rei(kpen)*rpen ) .lt. -0.1_r8*rhos0j ) limit_emf(i) = 1._r8 + if( ( umf(k)*ppen*rei(kpen)*rpen ) .lt. -0.9_r8*dp0(kpen)/g/dt ) limit_emf(i) = 1._r8 + + emf(k) = max( max( umf(k)*ppen*rei(kpen)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(kpen)/g/dt) + thlu_emf(k) = thl0(kpen) + ssthl0(kpen) * ( ps0(k) - p0(kpen) ) + qtu_emf(k) = qt0(kpen) + ssqt0(kpen) * ( ps0(k) - p0(kpen) ) + uu_emf(k) = u0(kpen) + ssu0(kpen) * ( ps0(k) - p0(kpen) ) + vu_emf(k) = v0(kpen) + ssv0(kpen) * ( ps0(k) - p0(kpen) ) + do m = 1, ncnst + tru_emf(k,m) = tr0(kpen,m) + sstr0(kpen,m) * ( ps0(k) - p0(kpen) ) + enddo + + else ! if(k.lt.kpen-1). + + ! --------------------------------------------------------------------------- ! + ! Note we are coming down from the higher interfaces to the lower interfaces. ! + ! Also note that 'emf < 0'. So, below operation is a summing not subtracting. ! + ! In order to ensure numerical stability, I imposed a modified correct limit ! + ! of '-0.9*dp0(k+1)/g/dt' on emf(k). ! + ! --------------------------------------------------------------------------- ! + + if( use_cumpenent ) then ! Original Cumulative Penetrative Entrainment + + if( ( emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.1_r8*rhos0j ) limit_emf(i) = 1 + if( ( emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.9_r8*dp0(k+1)/g/dt ) limit_emf(i) = 1 + emf(k) = max(max(emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(k+1)/g/dt ) + if( abs(emf(k)) .gt. abs(emf(k+1)) ) then + thlu_emf(k) = ( thlu_emf(k+1) * emf(k+1) + thl0(k+1) * ( emf(k) - emf(k+1) ) ) / emf(k) + qtu_emf(k) = ( qtu_emf(k+1) * emf(k+1) + qt0(k+1) * ( emf(k) - emf(k+1) ) ) / emf(k) + uu_emf(k) = ( uu_emf(k+1) * emf(k+1) + u0(k+1) * ( emf(k) - emf(k+1) ) ) / emf(k) + vu_emf(k) = ( vu_emf(k+1) * emf(k+1) + v0(k+1) * ( emf(k) - emf(k+1) ) ) / emf(k) + do m = 1, ncnst + tru_emf(k,m) = ( tru_emf(k+1,m) * emf(k+1) + tr0(k+1,m) * ( emf(k) - emf(k+1) ) ) / emf(k) + enddo + else + thlu_emf(k) = thl0(k+1) + qtu_emf(k) = qt0(k+1) + uu_emf(k) = u0(k+1) + vu_emf(k) = v0(k+1) + do m = 1, ncnst + tru_emf(k,m) = tr0(k+1,m) + enddo + endif + + else ! Alternative Non-Cumulative Penetrative Entrainment + + if( ( -umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.1_r8*rhos0j ) limit_emf(i) = 1 + if( ( -umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.9_r8*dp0(k+1)/g/dt ) limit_emf(i) = 1 + emf(k) = max(max(-umf(k)*dp0(k+1)*rei(k+1)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(k+1)/g/dt ) + thlu_emf(k) = thl0(k+1) + qtu_emf(k) = qt0(k+1) + uu_emf(k) = u0(k+1) + vu_emf(k) = v0(k+1) + do m = 1, ncnst + tru_emf(k,m) = tr0(k+1,m) + enddo + + endif + + endif + + ! ---------------------------------------------------------------------------- ! + ! In this GCM modeling framework, all what we should do is to calculate heat ! + ! and moisture fluxes at the given geometrically-fixed height interfaces - we ! + ! don't need to worry about movement of material height surface in association ! + ! with compensating subsidence or unwelling, in contrast to the bulk modeling. ! + ! In this geometrically fixed height coordinate system, heat and moisture flux ! + ! at the geometrically fixed height handle everything - a movement of material ! + ! surface is implicitly treated automatically. Note that in terms of turbulent ! + ! heat and moisture fluxes at model interfaces, both the cumulus updraft mass ! + ! flux and penetratively entraining mass flux play the same role -both of them ! + ! warms and dries the 'kbup' layer, cools and moistens the 'kpen' layer, and ! + ! cools and moistens any intervening layers between 'kbup' and 'kpen' layers. ! + ! It is important to note these identical roles on turbulent heat and moisture ! + ! fluxes of 'umf' and 'emf'. ! + ! When 'kbup' is a stratocumulus-topped PBL top interface, increase of 'rpen' ! + ! is likely to strongly diffuse stratocumulus top interface, resulting in the ! + ! reduction of cloud fraction. In this sense, the 'kbup' interface has a very ! + ! important meaning and role : across the 'kbup' interface, strong penetrative ! + ! entrainment occurs, thus any sharp gradient properties across that interface ! + ! are easily diffused through strong mass exchange. Thus, an initialization of ! + ! 'kbup' (and also 'kpen') should be done very cautiously as mentioned before. ! + ! In order to prevent this stron diffusion for the shallow cumulus convection ! + ! based at the Sc top, it seems to be good to initialize 'kbup = krel', rather ! + ! that 'kbup = krel-1'. ! + ! ---------------------------------------------------------------------------- ! + + end do + + !------------------------------------------------------------------ ! + ! ! + ! Compute turbulent heat, moisture, momentum flux at all interfaces ! + ! ! + !------------------------------------------------------------------ ! + ! It is very important to note that in calculating turbulent fluxes ! + ! below, we must not double count turbulent flux at any interefaces.! + ! In the below, turbulent fluxes at the interfaces (interface index ! + ! k) are calculated by the following 4 blocks in consecutive order: ! + ! ! + ! (1) " 0 <= k <= kinv - 1 " : PBL fluxes. ! + ! From 'fluxbelowinv' using reconstructed PBL height. Currently,! + ! the reconstructed PBLs are independently calculated for each ! + ! individual conservative scalar variables ( qt, thl, u, v ) in ! + ! each 'fluxbelowinv', instead of being uniquely calculated by ! + ! using thvl. Turbulent flux at the surface is assumed to be 0. ! + ! (2) " kinv <= k <= krel - 1 " : Non-buoyancy sorting fluxes ! + ! Assuming cumulus mass flux and cumulus updraft thermodynamic ! + ! properties (except u, v which are modified by the PGFc during ! + ! upward motion) are conserved during a updraft motion from the ! + ! PBL top interface to the release level. If these layers don't ! + ! exist (e,g, when 'krel = kinv'), then current routine do not ! + ! perform this routine automatically. So I don't need to modify ! + ! anything. ! + ! (3) " krel <= k <= kbup - 1 " : Buoyancy sorting fluxes ! + ! From laterally entraining-detraining buoyancy sorting plumes. ! + ! (4) " kbup <= k < kpen-1 " : Penetrative entrainment fluxes ! + ! From penetratively entraining plumes, ! + ! ! + ! In case of normal situation, turbulent interfaces in each groups ! + ! are mutually independent of each other. Thus double flux counting ! + ! or ambiguous flux counting requiring the choice among the above 4 ! + ! groups do not occur normally. However, in case that cumulus plume ! + ! could not completely overcome the buoyancy barrier just above the ! + ! PBL top interface and so 'kbup = krel' (.forcedCu=.true.) ( here, ! + ! it can be either 'kpen = krel' as the initialization, or ' kpen > ! + ! krel' if cumulus updraft just penetrated over the top of release ! + ! layer ). If this happens, we should be very careful in organizing ! + ! the sequence of the 4 calculation routines above - note that the ! + ! routine located at the later has the higher priority. Additional ! + ! feature I must consider is that when 'kbup = kinv - 1' (this is a ! + ! combined situation of 'kbup=krel-1' & 'krel = kinv' when I chose ! + ! 'kbup=krel-1' instead of current choice of 'kbup=krel'), a strong ! + ! penetrative entrainment fluxes exists at the PBL top interface, & ! + ! all of these fluxes are concentrated (deposited) within the layer ! + ! just below PBL top interface (i.e., 'kinv-1' layer). On the other ! + ! hand, in case of 'fluxbelowinv', only the compensating subsidence ! + ! effect is concentrated in the 'kinv-1' layer and 'pure' turbulent ! + ! heat and moisture fluxes ( 'pure' means the fluxes not associated ! + ! with compensating subsidence) are linearly distributed throughout ! + ! the whole PBL. Thus different choice of the above flux groups can ! + ! produce very different results. Output variable should be written ! + ! consistently to the choice of computation sequences. ! + ! When the case of 'kbup = krel(-1)' happens,another way to dealing ! + ! with this case is to simply ' exit ' the whole cumulus convection ! + ! calculation without performing any cumulus convection. We can ! + ! choose this approach by specifying a condition in the 'Filtering ! + ! of unreasonable cumulus adjustment' just after 'iter_scaleh'. But ! + ! this seems not to be a good choice (although this choice was used ! + ! previous code ), since it might arbitrary damped-out the shallow ! + ! cumulus convection over the continent land, where shallow cumulus ! + ! convection tends to be negatively buoyant. ! + ! ----------------------------------------------------------------- ! + + ! --------------------------------------------------- ! + ! 1. PBL fluxes : 0 <= k <= kinv - 1 ! + ! All the information necessary to reconstruct PBL ! + ! height are passed to 'fluxbelowinv'. ! + ! --------------------------------------------------- ! + + xsrc = qtsrc + xmean = qt0(kinv) + xtop = qt0(kinv+1) + ssqt0(kinv+1) * ( ps0(kinv) - p0(kinv+1) ) + xbot = qt0(kinv-1) + ssqt0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx ) + qtflx(0:kinv-1) = xflx(0:kinv-1) + + xsrc = thlsrc + xmean = thl0(kinv) + xtop = thl0(kinv+1) + ssthl0(kinv+1) * ( ps0(kinv) - p0(kinv+1) ) + xbot = thl0(kinv-1) + ssthl0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx ) + slflx(0:kinv-1) = cp * exns0(0:kinv-1) * xflx(0:kinv-1) + + xsrc = usrc + xmean = u0(kinv) + xtop = u0(kinv+1) + ssu0(kinv+1) * ( ps0(kinv) - p0(kinv+1) ) + xbot = u0(kinv-1) + ssu0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx ) + uflx(0:kinv-1) = xflx(0:kinv-1) + + xsrc = vsrc + xmean = v0(kinv) + xtop = v0(kinv+1) + ssv0(kinv+1) * ( ps0(kinv) - p0(kinv+1) ) + xbot = v0(kinv-1) + ssv0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) ) + call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx ) + vflx(0:kinv-1) = xflx(0:kinv-1) + + do m = 1, ncnst + xsrc = trsrc(m) + xmean = tr0(kinv,m) + xtop = tr0(kinv+1,m) + sstr0(kinv+1,m) * ( ps0(kinv) - p0(kinv+1) ) + xbot = tr0(kinv-1,m) + sstr0(kinv-1,m) * ( ps0(kinv-1) - p0(kinv-1) ) + call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx ) + trflx(0:kinv-1,m) = xflx(0:kinv-1) + enddo + + ! -------------------------------------------------------------- ! + ! 2. Non-buoyancy sorting fluxes : kinv <= k <= krel - 1 ! + ! Note that when 'krel = kinv', below block is never executed ! + ! as in a desirable, expected way ( but I must check if this ! + ! is the case ). The non-buoyancy sorting fluxes are computed ! + ! only when 'krel > kinv'. ! + ! -------------------------------------------------------------- ! + + uplus = 0._r8 + vplus = 0._r8 + do k = kinv, krel - 1 + kp1 = k + 1 + qtflx(k) = cbmf * ( qtsrc - ( qt0(kp1) + ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + slflx(k) = cbmf * ( thlsrc - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) * cp * exns0(k) + uplus = uplus + PGFc * ssu0(k) * ( ps0(k) - ps0(k-1) ) + vplus = vplus + PGFc * ssv0(k) * ( ps0(k) - ps0(k-1) ) + uflx(k) = cbmf * ( usrc + uplus - ( u0(kp1) + ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + vflx(k) = cbmf * ( vsrc + vplus - ( v0(kp1) + ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + do m = 1, ncnst + trflx(k,m) = cbmf * ( trsrc(m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) ) + enddo + end do + + ! ------------------------------------------------------------------------ ! + ! 3. Buoyancy sorting fluxes : krel <= k <= kbup - 1 ! + ! In case that 'kbup = krel - 1 ' ( or even in case 'kbup = krel' ), ! + ! buoyancy sorting fluxes are not calculated, which is consistent, ! + ! desirable feature. ! + ! ------------------------------------------------------------------------ ! + + do k = krel, kbup - 1 + kp1 = k + 1 + slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k) - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + qtflx(k) = umf(k) * ( qtu(k) - ( qt0(kp1) + ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + uflx(k) = umf(k) * ( uu(k) - ( u0(kp1) + ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + vflx(k) = umf(k) * ( vu(k) - ( v0(kp1) + ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + do m = 1, ncnst + trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) ) + enddo + end do + + ! ------------------------------------------------------------------------- ! + ! 4. Penetrative entrainment fluxes : kbup <= k <= kpen - 1 ! + ! The only confliction that can happen is when 'kbup = kinv-1'. For this ! + ! case, turbulent flux at kinv-1 is calculated both from 'fluxbelowinv' ! + ! and here as penetrative entrainment fluxes. Since penetrative flux is ! + ! calculated later, flux at 'kinv - 1 ' will be that of penetrative flux.! + ! However, turbulent flux calculated at 'kinv - 1' from penetrative entr.! + ! is less attractable, since more reasonable turbulent flux at 'kinv-1' ! + ! should be obtained from 'fluxbelowinv', by considering re-constructed ! + ! inversion base height. This conflicting problem can be solved if we can! + ! initialize 'kbup = krel', instead of kbup = krel - 1. This choice seems! + ! to be more reasonable since it is not conflicted with 'fluxbelowinv' in! + ! calculating fluxes at 'kinv - 1' ( for this case, flux at 'kinv-1' is ! + ! always from 'fluxbelowinv' ), and flux at 'krel-1' is calculated from ! + ! the non-buoyancy sorting flux without being competed with penetrative ! + ! entrainment fluxes. Even when we use normal cumulus flux instead of ! + ! penetrative entrainment fluxes at 'kbup <= k <= kpen-1' interfaces, ! + ! the initialization of kbup=krel perfectly works without any conceptual ! + ! confliction. Thus it seems to be much better to choose 'kbup = krel' ! + ! initialization of 'kbup', which is current choice. ! + ! Note that below formula uses conventional updraft cumulus fluxes for ! + ! shallow cumulus which did not overcome the first buoyancy barrier above! + ! PBL top while uses penetrative entrainment fluxes for the other cases ! + ! 'kbup <= k <= kpen-1' interfaces. Depending on cases, however, I can ! + ! selelct different choice. ! + ! ------------------------------------------------------------------------------------------------------------------ ! + ! if( forcedCu ) then ! + ! slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k) - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) ! + ! qtflx(k) = umf(k) * ( qtu(k) - ( qt0(kp1) + ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) ) ! + ! uflx(k) = umf(k) * ( uu(k) - ( u0(kp1) + ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) ) ! + ! vflx(k) = umf(k) * ( vu(k) - ( v0(kp1) + ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) ) ! + ! do m = 1, ncnst ! + ! trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) ) ! + ! enddo ! + ! else ! + ! slflx(k) = cp * exns0(k) * emf(k) * ( thlu_emf(k) - ( thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! qtflx(k) = emf(k) * ( qtu_emf(k) - ( qt0(k) + ssqt0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! uflx(k) = emf(k) * ( uu_emf(k) - ( u0(k) + ssu0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! vflx(k) = emf(k) * ( vu_emf(k) - ( v0(k) + ssv0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! do m = 1, ncnst ! + ! trflx(k,m) = emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) ) ! + ! enddo ! + ! endif ! + ! ! + ! if( use_uppenent ) then ! Combined Updraft + Penetrative Entrainment Flux ! + ! slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k) - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & ! + ! cp * exns0(k) * emf(k) * ( thlu_emf(k) - ( thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! qtflx(k) = umf(k) * ( qtu(k) - ( qt0(kp1) + ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & ! + ! emf(k) * ( qtu_emf(k) - ( qt0(k) + ssqt0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! uflx(k) = umf(k) * ( uu(k) - ( u0(kp1) + ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & ! + ! emf(k) * ( uu_emf(k) - ( u0(k) + ssu0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! vflx(k) = umf(k) * ( vu(k) - ( v0(kp1) + ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & ! + ! emf(k) * ( vu_emf(k) - ( v0(k) + ssv0(k) * ( ps0(k) - p0(k) ) ) ) ! + ! do m = 1, ncnst ! + ! trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) ) + & ! + ! emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) ) ! + ! enddo ! + ! ------------------------------------------------------------------------------------------------------------------ ! + + do k = kbup, kpen - 1 + kp1 = k + 1 + slflx(k) = cp * exns0(k) * emf(k) * ( thlu_emf(k) - ( thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) ) ) + qtflx(k) = emf(k) * ( qtu_emf(k) - ( qt0(k) + ssqt0(k) * ( ps0(k) - p0(k) ) ) ) + uflx(k) = emf(k) * ( uu_emf(k) - ( u0(k) + ssu0(k) * ( ps0(k) - p0(k) ) ) ) + vflx(k) = emf(k) * ( vu_emf(k) - ( v0(k) + ssv0(k) * ( ps0(k) - p0(k) ) ) ) + do m = 1, ncnst + trflx(k,m) = emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) ) + enddo + end do + + ! ------------------------------------------- ! + ! Turn-off cumulus momentum flux as an option ! + ! ------------------------------------------- ! + + if( .not. use_momenflx ) then + uflx(0:mkx) = 0._r8 + vflx(0:mkx) = 0._r8 + endif + + ! -------------------------------------------------------- ! + ! Condensate tendency by compensating subsidence/upwelling ! + ! -------------------------------------------------------- ! + + uemf(0:mkx) = 0._r8 + do k = 0, kinv - 2 ! Assume linear updraft mass flux within the PBL. + uemf(k) = cbmf * ( ps0(0) - ps0(k) ) / ( ps0(0) - ps0(kinv-1) ) + end do + uemf(kinv-1:krel-1) = cbmf + uemf(krel:kbup-1) = umf(krel:kbup-1) + uemf(kbup:kpen-1) = emf(kbup:kpen-1) ! Only use penetrative entrainment flux consistently. + + comsub(1:mkx) = 0._r8 + do k = 1, kpen + comsub(k) = 0.5_r8 * ( uemf(k) + uemf(k-1) ) + end do + + do k = 1, kpen + if( comsub(k) .ge. 0._r8 ) then + if( k .eq. mkx ) then + thlten_sub = 0._r8 + qtten_sub = 0._r8 + qlten_sub = 0._r8 + qiten_sub = 0._r8 + nlten_sub = 0._r8 + niten_sub = 0._r8 + else + thlten_sub = g * comsub(k) * ( thl0(k+1) - thl0(k) ) / ( p0(k) - p0(k+1) ) + qtten_sub = g * comsub(k) * ( qt0(k+1) - qt0(k) ) / ( p0(k) - p0(k+1) ) + qlten_sub = g * comsub(k) * ( ql0(k+1) - ql0(k) ) / ( p0(k) - p0(k+1) ) + qiten_sub = g * comsub(k) * ( qi0(k+1) - qi0(k) ) / ( p0(k) - p0(k+1) ) + nlten_sub = g * comsub(k) * ( tr0(k+1,ixnumliq) - tr0(k,ixnumliq) ) / ( p0(k) - p0(k+1) ) + niten_sub = g * comsub(k) * ( tr0(k+1,ixnumice) - tr0(k,ixnumice) ) / ( p0(k) - p0(k+1) ) + endif + else + if( k .eq. 1 ) then + thlten_sub = 0._r8 + qtten_sub = 0._r8 + qlten_sub = 0._r8 + qiten_sub = 0._r8 + nlten_sub = 0._r8 + niten_sub = 0._r8 + else + thlten_sub = g * comsub(k) * ( thl0(k) - thl0(k-1) ) / ( p0(k-1) - p0(k) ) + qtten_sub = g * comsub(k) * ( qt0(k) - qt0(k-1) ) / ( p0(k-1) - p0(k) ) + qlten_sub = g * comsub(k) * ( ql0(k) - ql0(k-1) ) / ( p0(k-1) - p0(k) ) + qiten_sub = g * comsub(k) * ( qi0(k) - qi0(k-1) ) / ( p0(k-1) - p0(k) ) + nlten_sub = g * comsub(k) * ( tr0(k,ixnumliq) - tr0(k-1,ixnumliq) ) / ( p0(k-1) - p0(k) ) + niten_sub = g * comsub(k) * ( tr0(k,ixnumice) - tr0(k-1,ixnumice) ) / ( p0(k-1) - p0(k) ) + endif + endif + thl_prog = thl0(k) + thlten_sub * dt + qt_prog = max( qt0(k) + qtten_sub * dt, 1.e-12_r8 ) + call conden(p0(k),thl_prog,qt_prog,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + id_exit = .true. + go to 333 + endif + ! qlten_sink(k) = ( qlj - ql0(k) ) / dt + ! qiten_sink(k) = ( qij - qi0(k) ) / dt + qlten_sink(k) = max( qlten_sub, - ql0(k) / dt ) ! For consistency with prognostic macrophysics scheme + qiten_sink(k) = max( qiten_sub, - qi0(k) / dt ) ! For consistency with prognostic macrophysics scheme + nlten_sink(k) = max( nlten_sub, - tr0(k,ixnumliq) / dt ) + niten_sink(k) = max( niten_sub, - tr0(k,ixnumice) / dt ) + end do + + ! --------------------------------------------- ! + ! ! + ! Calculate convective tendencies at each layer ! + ! ! + ! --------------------------------------------- ! + + ! ----------------- ! + ! Momentum tendency ! + ! ----------------- ! + + do k = 1, kpen + km1 = k - 1 + uten(k) = ( uflx(km1) - uflx(k) ) * g / dp0(k) + vten(k) = ( vflx(km1) - vflx(k) ) * g / dp0(k) + uf(k) = u0(k) + uten(k) * dt + vf(k) = v0(k) + vten(k) * dt + ! do m = 1, ncnst + ! trten(k,m) = ( trflx(km1,m) - trflx(k,m) ) * g / dp0(k) + ! ! Limit trten(k,m) such that negative value is not developed. + ! ! This limitation does not conserve grid-mean tracers and future + ! ! refinement is required for tracer-conserving treatment. + ! trten(k,m) = max(trten(k,m),-tr0(k,m)/dt) + ! enddo + end do + + ! ----------------------------------------------------------------- ! + ! Tendencies of thermodynamic variables. ! + ! This part requires a careful treatment of bulk cloud microphysics.! + ! Relocations of 'precipitable condensates' either into the surface ! + ! or into the tendency of 'krel' layer will be performed just after ! + ! finishing the below 'do-loop'. ! + ! ----------------------------------------------------------------- ! + + rliq = 0._r8 + rainflx = 0._r8 + snowflx = 0._r8 + + do k = 1, kpen + + km1 = k - 1 + + ! ------------------------------------------------------------------------------ ! + ! Compute 'slten', 'qtten', 'qvten', 'qlten', 'qiten', and 'sten' ! + ! ! + ! Key assumptions made in this 'cumulus scheme' are : ! + ! 1. Cumulus updraft expels condensate into the environment at the top interface ! + ! of each layer. Note that in addition to this expel process ('source' term), ! + ! cumulus updraft can modify layer mean condensate through normal detrainment ! + ! forcing or compensating subsidence. ! + ! 2. Expelled water can be either 'sustaining' or 'precipitating' condensate. By ! + ! definition, 'suataining condensate' will remain in the layer where it was ! + ! formed, while 'precipitating condensate' will fall across the base of the ! + ! layer where it was formed. ! + ! 3. All precipitating condensates are assumed to fall into the release layer or ! + ! ground as soon as it was formed without being evaporated during the falling ! + ! process down to the desinated layer ( either release layer of surface ). ! + ! ------------------------------------------------------------------------------ ! + + ! ------------------------------------------------------------------------- ! + ! 'dwten(k)','diten(k)' : Production rate of condensate within the layer k ! + ! [ kg/kg/s ] by the expels of condensate from cumulus updraft. ! + ! It is important to note that in terms of moisture tendency equation, this ! + ! is a 'source' term of enviromental 'qt'. More importantly, these source ! + ! are already counted in the turbulent heat and moisture fluxes we computed ! + ! until now, assuming all the expelled condensate remain in the layer where ! + ! it was formed. Thus, in calculation of 'qtten' and 'slten' below, we MUST ! + ! NOT add or subtract these terms explicitly in order not to double or miss ! + ! count, unless some expelled condensates fall down out of the layer. Note ! + ! this falling-down process ( i.e., precipitation process ) and associated ! + ! 'qtten' and 'slten' and production of surface precipitation flux will be ! + ! treated later in 'zm_conv_evap' in 'convect_shallow_tend' subroutine. ! + ! In below, we are converting expelled cloud condensate into correct unit. ! + ! I found that below use of '0.5 * (umf(k-1) + umf(k))' causes conservation ! + ! errors at some columns in global simulation. So, I returned to originals. ! + ! This will cause no precipitation flux at 'kpen' layer since umf(kpen)=0. ! + ! ------------------------------------------------------------------------- ! + + dwten(k) = dwten(k) * 0.5_r8 * ( umf(k-1) + umf(k) ) * g / dp0(k) ! [ kg/kg/s ] + diten(k) = diten(k) * 0.5_r8 * ( umf(k-1) + umf(k) ) * g / dp0(k) ! [ kg/kg/s ] + + ! dwten(k) = dwten(k) * umf(k) * g / dp0(k) ! [ kg/kg/s ] + ! diten(k) = diten(k) * umf(k) * g / dp0(k) ! [ kg/kg/s ] + + ! --------------------------------------------------------------------------- ! + ! 'qrten(k)','qsten(k)' : Production rate of rain and snow within the layer k ! + ! [ kg/kg/s ] by cumulus expels of condensates to the environment.! + ! This will be falled-out of the layer where it was formed and will be dumped ! + ! dumped into the release layer assuming that there is no evaporative cooling ! + ! while precipitable condensate moves to the relaes level. This is reasonable ! + ! assumtion if cumulus is purely vertical and so the path along which precita ! + ! ble condensate falls is fully saturared. This 're-allocation' process of ! + ! precipitable condensate into the release layer is fully described in this ! + ! convection scheme. After that, the dumped water into the release layer will ! + ! falling down across the base of release layer ( or LCL, if exact treatment ! + ! is required ) and will be allowed to be evaporated in layers below release ! + ! layer, and finally non-zero surface precipitation flux will be calculated. ! + ! This latter process will be separately treated 'zm_conv_evap' routine. ! + ! --------------------------------------------------------------------------- ! + + qrten(k) = frc_rasn * dwten(k) + qsten(k) = frc_rasn * diten(k) + + ! ----------------------------------------------------------------------- ! + ! 'rainflx','snowflx' : Cumulative rain and snow flux integrated from the ! + ! [ kg/m2/s ] release leyer to the 'kpen' layer. Note that even ! + ! though wtw(kpen) < 0 (and umf(kpen) = 0) at the top interface of 'kpen' ! + ! layer, 'dwten(kpen)' and diten(kpen) were calculated after calculating ! + ! explicit cloud top height. Thus below calculation of precipitation flux ! + ! is correct. Note that precipitating condensates are formed only in the ! + ! layers from 'krel' to 'kpen', including the two layers. ! + ! ----------------------------------------------------------------------- ! + + rainflx = rainflx + qrten(k) * dp0(k) / g + snowflx = snowflx + qsten(k) * dp0(k) / g + + ! ------------------------------------------------------------------------ ! + ! 'slten(k)','qtten(k)' ! + ! Note that 'slflx(k)' and 'qtflx(k)' we have calculated already included ! + ! all the contributions of (1) expels of condensate (dwten(k), diten(k)), ! + ! (2) mass detrainment ( delta * umf * ( qtu - qt ) ), & (3) compensating ! + ! subsidence ( M * dqt / dz ). Thus 'slflx(k)' and 'qtflx(k)' we computed ! + ! is a hybrid turbulent flux containing one part of 'source' term - expel ! + ! of condensate. In order to calculate 'slten' and 'qtten', we should add ! + ! additional 'source' term, if any. If the expelled condensate falls down ! + ! across the base of the layer, it will be another sink (negative source) ! + ! term. Note also that we included frictional heating terms in the below ! + ! calculation of 'slten'. ! + ! ------------------------------------------------------------------------ ! + + slten(k) = ( slflx(km1) - slflx(k) ) * g / dp0(k) + if( k .eq. 1 ) then + slten(k) = slten(k) - g / 4._r8 / dp0(k) * ( & + uflx(k)*(uf(k+1) - uf(k) + u0(k+1) - u0(k)) + & + vflx(k)*(vf(k+1) - vf(k) + v0(k+1) - v0(k))) + elseif( k .ge. 2 .and. k .le. kpen-1 ) then + slten(k) = slten(k) - g / 4._r8 / dp0(k) * ( & + uflx(k)*(uf(k+1) - uf(k) + u0(k+1) - u0(k)) + & + uflx(k-1)*(uf(k) - uf(k-1) + u0(k) - u0(k-1)) + & + vflx(k)*(vf(k+1) - vf(k) + v0(k+1) - v0(k)) + & + vflx(k-1)*(vf(k) - vf(k-1) + v0(k) - v0(k-1))) + elseif( k .eq. kpen ) then + slten(k) = slten(k) - g / 4._r8 / dp0(k) * ( & + uflx(k-1)*(uf(k) - uf(k-1) + u0(k) - u0(k-1)) + & + vflx(k-1)*(vf(k) - vf(k-1) + v0(k) - v0(k-1))) + endif + qtten(k) = ( qtflx(km1) - qtflx(k) ) * g / dp0(k) + + ! ---------------------------------------------------------------------------- ! + ! Compute condensate tendency, including reserved condensate ! + ! We assume that eventual detachment and detrainment occurs in kbup layer due ! + ! to downdraft buoyancy sorting. In the layer above the kbup, only penetrative ! + ! entrainment exists. Penetrative entrained air is assumed not to contain any ! + ! condensate. ! + ! ---------------------------------------------------------------------------- ! + + ! Compute in-cumulus condensate at the layer mid-point. + + if( k .lt. krel .or. k .gt. kpen ) then + qlu_mid = 0._r8 + qiu_mid = 0._r8 + qlj = 0._r8 + qij = 0._r8 + elseif( k .eq. krel ) then + call conden(prel,thlu(krel-1),qtu(krel-1),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + endif + qlubelow = qlj + qiubelow = qij + call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + qlu_mid = 0.5_r8 * ( qlubelow + qlj ) * ( prel - ps0(k) )/( ps0(k-1) - ps0(k) ) + qiu_mid = 0.5_r8 * ( qiubelow + qij ) * ( prel - ps0(k) )/( ps0(k-1) - ps0(k) ) + elseif( k .eq. kpen ) then + call conden(ps0(k-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + qlu_mid = 0.5_r8 * ( qlubelow + qlj ) * ( -ppen ) /( ps0(k-1) - ps0(k) ) + qiu_mid = 0.5_r8 * ( qiubelow + qij ) * ( -ppen ) /( ps0(k-1) - ps0(k) ) + qlu_top = qlj + qiu_top = qij + else + call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + qlu_mid = 0.5_r8 * ( qlubelow + qlj ) + qiu_mid = 0.5_r8 * ( qiubelow + qij ) + endif + qlubelow = qlj + qiubelow = qij + + ! 1. Sustained Precipitation + + qc_l(k) = ( 1._r8 - frc_rasn ) * dwten(k) ! [ kg/kg/s ] + qc_i(k) = ( 1._r8 - frc_rasn ) * diten(k) ! [ kg/kg/s ] + + ! 2. Detrained Condensate + + if( k .le. kbup ) then + qc_l(k) = qc_l(k) + g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qlu_mid ! [ kg/kg/s ] + qc_i(k) = qc_i(k) + g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qiu_mid ! [ kg/kg/s ] + qc_lm = - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * ql0(k) + qc_im = - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qi0(k) + ! Below 'nc_lm', 'nc_im' should be used only when frc_rasn = 1. + nc_lm = - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * tr0(k,ixnumliq) + nc_im = - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * tr0(k,ixnumice) + else + qc_lm = 0._r8 + qc_im = 0._r8 + nc_lm = 0._r8 + nc_im = 0._r8 + endif + + ! 3. Detached Updraft + + if( k .eq. kbup ) then + qc_l(k) = qc_l(k) + g * umf(k) * qlj / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + qc_i(k) = qc_i(k) + g * umf(k) * qij / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + qc_lm = qc_lm - g * umf(k) * ql0(k) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + qc_im = qc_im - g * umf(k) * qi0(k) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + nc_lm = nc_lm - g * umf(k) * tr0(k,ixnumliq) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + nc_im = nc_im - g * umf(k) * tr0(k,ixnumice) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + endif + + ! 4. Cumulative Penetrative entrainment detrained in the 'kbup' layer + ! Explicitly compute the properties detrained penetrative entrained airs in k = kbup layer. + + if( k .eq. kbup ) then + call conden(p0(k),thlu_emf(k),qtu_emf(k),thj,qvj,ql_emf_kbup,qi_emf_kbup,qse,id_check) + if( id_check .eq. 1 ) then + id_exit = .true. + go to 333 + endif + if( ql_emf_kbup .gt. 0._r8 ) then + nl_emf_kbup = tru_emf(k,ixnumliq) + else + nl_emf_kbup = 0._r8 + endif + if( qi_emf_kbup .gt. 0._r8 ) then + ni_emf_kbup = tru_emf(k,ixnumice) + else + ni_emf_kbup = 0._r8 + endif + qc_lm = qc_lm - g * emf(k) * ( ql_emf_kbup - ql0(k) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + qc_im = qc_im - g * emf(k) * ( qi_emf_kbup - qi0(k) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + nc_lm = nc_lm - g * emf(k) * ( nl_emf_kbup - tr0(k,ixnumliq) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + nc_im = nc_im - g * emf(k) * ( ni_emf_kbup - tr0(k,ixnumice) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ] + endif + + qlten_det = qc_l(k) + qc_lm + qiten_det = qc_i(k) + qc_im + + ! --------------------------------------------------------------------------------- ! + ! 'qlten(k)','qiten(k)','qvten(k)','sten(k)' ! + ! Note that falling of precipitation will be treated later. ! + ! The prevension of negative 'qv,ql,qi' will be treated later in positive_moisture. ! + ! --------------------------------------------------------------------------------- ! + + if( use_expconten ) then + if( use_unicondet ) then + qc_l(k) = 0._r8 + qc_i(k) = 0._r8 + qlten(k) = frc_rasn * dwten(k) + qlten_sink(k) + qlten_det + qiten(k) = frc_rasn * diten(k) + qiten_sink(k) + qiten_det + else + qlten(k) = qc_l(k) + frc_rasn * dwten(k) + ( max( 0._r8, ql0(k) + ( qc_lm + qlten_sink(k) ) * dt ) - ql0(k) ) / dt + qiten(k) = qc_i(k) + frc_rasn * diten(k) + ( max( 0._r8, qi0(k) + ( qc_im + qiten_sink(k) ) * dt ) - qi0(k) ) / dt + trten(k,ixnumliq) = max( nc_lm + nlten_sink(k), - tr0(k,ixnumliq) / dt ) + trten(k,ixnumice) = max( nc_im + niten_sink(k), - tr0(k,ixnumice) / dt ) + endif + else + if( use_unicondet ) then + qc_l(k) = 0._r8 + qc_i(k) = 0._r8 + endif + qlten(k) = dwten(k) + ( qtten(k) - dwten(k) - diten(k) ) * ( ql0(k) / qt0(k) ) + qiten(k) = diten(k) + ( qtten(k) - dwten(k) - diten(k) ) * ( qi0(k) / qt0(k) ) + endif + + qvten(k) = qtten(k) - qlten(k) - qiten(k) + sten(k) = slten(k) + xlv * qlten(k) + xls * qiten(k) + + ! -------------------------------------------------------------------------- ! + ! 'rliq' : Verticall-integrated 'suspended cloud condensate' ! + ! [m/s] This is so called 'reserved liquid water' in other subroutines ! + ! of CAM3, since the contribution of this term should not be included into ! + ! the tendency of each layer or surface flux (precip) within this cumulus ! + ! scheme. The adding of this term to the layer tendency will be done inthe ! + ! 'stratiform_tend', just after performing sediment process there. ! + ! The main problem of these rather going-back-and-forth and stupid-seeming ! + ! approach is that the sediment process of suspendened condensate will not ! + ! be treated at all in the 'stratiform_tend'. ! + ! Note that 'precip' [m/s] is vertically-integrated total 'rain+snow' formed ! + ! from the cumulus updraft. Important : in the below, 1000 is rhoh2o ( water ! + ! density ) [ kg/m^3 ] used for unit conversion from [ kg/m^2/s ] to [ m/s ] ! + ! for use in stratiform.F90. ! + ! -------------------------------------------------------------------------- ! + + qc(k) = qc_l(k) + qc_i(k) + rliq = rliq + qc(k) * dp0(k) / g / 1000._r8 ! [ m/s ] + + end do + + precip = rainflx + snowflx ! [ kg/m2/s ] + snow = snowflx ! [ kg/m2/s ] + + ! ---------------------------------------------------------------- ! + ! Now treats the 'evaporation' and 'melting' of rain ( qrten ) and ! + ! snow ( qsten ) during falling process. Below algorithms are from ! + ! 'zm_conv_evap' but with some modification, which allows separate ! + ! treatment of 'rain' and 'snow' condensates. Note that I included ! + ! the evaporation dynamics into the convection scheme for complete ! + ! development of cumulus scheme especially in association with the ! + ! implicit CIN closure. In compatible with this internal treatment ! + ! of evaporation, I should modify 'convect_shallow', in such that ! + ! 'zm_conv_evap' is not performed when I choose UW PBL-Cu schemes. ! + ! ---------------------------------------------------------------- ! + + evpint_rain = 0._r8 + evpint_snow = 0._r8 + flxrain(0:mkx) = 0._r8 + flxsnow(0:mkx) = 0._r8 + ntraprd(:mkx) = 0._r8 + ntsnprd(:mkx) = 0._r8 + + do k = mkx, 1, -1 ! 'k' is a layer index : 'mkx'('1') is the top ('bottom') layer + + ! ----------------------------------------------------------------------------- ! + ! flxsntm [kg/m2/s] : Downward snow flux at the top of each layer after melting.! + ! snowmlt [kg/kg/s] : Snow melting tendency. ! + ! Below allows melting of snow when it goes down into the warm layer below. ! + ! ----------------------------------------------------------------------------- ! + + if( t0(k) .gt. 273.16_r8 ) then + snowmlt = max( 0._r8, flxsnow(k) * g / dp0(k) ) + else + snowmlt = 0._r8 + endif + + ! ----------------------------------------------------------------- ! + ! Evaporation rate of 'rain' and 'snow' in the layer k, [ kg/kg/s ] ! + ! where 'rain' and 'snow' are coming down from the upper layers. ! + ! I used the same evaporative efficiency both for 'rain' and 'snow'.! + ! Note that evaporation is not allowed in the layers 'k >= krel' by ! + ! assuming that inside of cumulus cloud, across which precipitation ! + ! is falling down, is fully saturated. ! + ! The asumptions in association with the 'evplimit_rain(snow)' are ! + ! 1. Do not allow evaporation to supersate the layer ! + ! 2. Do not evaporate more than the flux falling into the layer ! + ! 3. Total evaporation cannot exceed the input total surface flux ! + ! ----------------------------------------------------------------- ! + + call qsat(t0(k), p0(k), es, qs) + subsat = max( ( 1._r8 - qv0(k)/qs ), 0._r8 ) + if( noevap_krelkpen ) then + if( k .ge. krel ) subsat = 0._r8 + endif + + evprain = kevp * subsat * sqrt(flxrain(k)+snowmlt*dp0(k)/g) + evpsnow = kevp * subsat * sqrt(max(flxsnow(k)-snowmlt*dp0(k)/g,0._r8)) + + evplimit = max( 0._r8, ( qw0_in(i,k) - qv0(k) ) / dt ) + + evplimit_rain = min( evplimit, ( flxrain(k) + snowmlt * dp0(k) / g ) * g / dp0(k) ) + evplimit_rain = min( evplimit_rain, ( rainflx - evpint_rain ) * g / dp0(k) ) + evprain = max(0._r8,min( evplimit_rain, evprain )) + + evplimit_snow = min( evplimit, max( flxsnow(k) - snowmlt * dp0(k) / g , 0._r8 ) * g / dp0(k) ) + evplimit_snow = min( evplimit_snow, ( snowflx - evpint_snow ) * g / dp0(k) ) + evpsnow = max(0._r8,min( evplimit_snow, evpsnow )) + + if( ( evprain + evpsnow ) .gt. evplimit ) then + tmp1 = evprain * evplimit / ( evprain + evpsnow ) + tmp2 = evpsnow * evplimit / ( evprain + evpsnow ) + evprain = tmp1 + evpsnow = tmp2 + endif + + evapc(k) = evprain + evpsnow + + ! ------------------------------------------------------------- ! + ! Vertically-integrated evaporative fluxes of 'rain' and 'snow' ! + ! ------------------------------------------------------------- ! + + evpint_rain = evpint_rain + evprain * dp0(k) / g + evpint_snow = evpint_snow + evpsnow * dp0(k) / g + + ! -------------------------------------------------------------- ! + ! Net 'rain' and 'snow' production rate in the layer [ kg/kg/s ] ! + ! -------------------------------------------------------------- ! + + ntraprd(k) = qrten(k) - evprain + snowmlt + ntsnprd(k) = qsten(k) - evpsnow - snowmlt + + ! -------------------------------------------------------------------------------- ! + ! Downward fluxes of 'rain' and 'snow' fluxes at the base of the layer [ kg/m2/s ] ! + ! Note that layer index increases with height. ! + ! -------------------------------------------------------------------------------- ! + + flxrain(k-1) = flxrain(k) + ntraprd(k) * dp0(k) / g + flxsnow(k-1) = flxsnow(k) + ntsnprd(k) * dp0(k) / g + flxrain(k-1) = max( flxrain(k-1), 0._r8 ) + if( flxrain(k-1) .eq. 0._r8 ) ntraprd(k) = -flxrain(k) * g / dp0(k) + flxsnow(k-1) = max( flxsnow(k-1), 0._r8 ) + if( flxsnow(k-1) .eq. 0._r8 ) ntsnprd(k) = -flxsnow(k) * g / dp0(k) + + ! ---------------------------------- ! + ! Calculate thermodynamic tendencies ! + ! --------------------------------------------------------------------------- ! + ! Note that equivalently, we can write tendency formula of 'sten' and 'slten' ! + ! by 'sten(k) = sten(k) - xlv*evprain - xls*evpsnow - (xls-xlv)*snowmlt' & ! + ! 'slten(k) = sten(k) - xlv*qlten(k) - xls*qiten(k)'. ! + ! The above formula is equivalent to the below formula. However below formula ! + ! is preferred since we have already imposed explicit constraint on 'ntraprd' ! + ! and 'ntsnprd' in case that flxrain(k-1) < 0 & flxsnow(k-1) < 0._r8 ! + ! Note : In future, I can elborate the limiting of 'qlten','qvten','qiten' ! + ! such that that energy and moisture conservation error is completely ! + ! suppressed. ! + ! Re-storation to the positive condensate will be performed later below ! + ! --------------------------------------------------------------------------- ! + + qlten(k) = qlten(k) - qrten(k) + qiten(k) = qiten(k) - qsten(k) + qvten(k) = qvten(k) + evprain + evpsnow + qtten(k) = qlten(k) + qiten(k) + qvten(k) + if( ( qv0(k) + qvten(k)*dt ) .lt. qmin(1) .or. & + ( ql0(k) + qlten(k)*dt ) .lt. qmin(ixcldliq) .or. & + ( qi0(k) + qiten(k)*dt ) .lt. qmin(ixcldice) ) then + limit_negcon(i) = 1._r8 + end if + sten(k) = sten(k) - xlv*evprain - xls*evpsnow - (xls-xlv)*snowmlt + slten(k) = sten(k) - xlv*qlten(k) - xls*qiten(k) + + ! slten(k) = slten(k) + xlv * ntraprd(k) + xls * ntsnprd(k) + ! sten(k) = slten(k) + xlv * qlten(k) + xls * qiten(k) + + end do + + ! ------------------------------------------------------------- ! + ! Calculate final surface flux of precipitation, rain, and snow ! + ! Convert unit to [m/s] for use in 'check_energy_chng'. ! + ! ------------------------------------------------------------- ! + + precip = ( flxrain(0) + flxsnow(0) ) / 1000._r8 + snow = flxsnow(0) / 1000._r8 + + ! --------------------------------------------------------------------------- ! + ! Until now, all the calculations are done completely in this shallow cumulus ! + ! scheme. If you want to use this cumulus scheme other than CAM3, then do not ! + ! perform below block. However, for compatible use with the other subroutines ! + ! in CAM3, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! + ! equation in each layer, since this effect will be separately added later in ! + ! in 'stratiform_tend' just after performing sediment process there. In order ! + ! to be consistent with 'stratiform_tend', just subtract qc(k) from tendency ! + ! equation of each layer, but do not add it to the 'precip'. Apprently, this ! + ! will violate energy and moisture conservations. However, when performing ! + ! conservation check in 'tphysbc.F90' just after 'convect_shallow_tend', we ! + ! will add 'qc(k)' ( rliq ) to the surface flux term just for the purpose of ! + ! passing the energy-moisture conservation check. Explicit adding-back of 'qc'! + ! to the individual layer tendency equation will be done in 'stratiform_tend' ! + ! after performing sediment process there. Simply speaking, in 'tphysbc' just ! + ! after 'convect_shallow_tend', we will dump 'rliq' into surface as a 'rain' ! + ! in order to satisfy energy and moisture conservation, and in the following ! + ! 'stratiform_tend', we will restore it back to 'qlten(k)' ( 'ice' will go to ! + ! 'water' there) from surface precipitation. This is a funny but conceptually ! + ! entertaining procedure. One concern I have for this complex process is that ! + ! output-writed stratiform precipitation amount will be underestimated due to ! + ! arbitrary subtracting of 'rliq' in stratiform_tend, where ! + ! ' prec_str = prec_sed + prec_pcw - rliq' and 'rliq' is not real but fake. ! + ! However, as shown in 'srfxfer.F90', large scale precipitation amount (PRECL)! + ! that is writed-output is corrected written since in 'srfxfer.F90', PRECL = ! + ! 'prec_sed + prec_pcw', without including 'rliq'. So current code is correct.! + ! Note also in 'srfxfer.F90', convective precipitation amount is 'PRECC = ! + ! prec_zmc(i) + prec_cmf(i)' which is also correct. ! + ! --------------------------------------------------------------------------- ! + + do k = 1, kpen + qtten(k) = qtten(k) - qc(k) + qlten(k) = qlten(k) - qc_l(k) + qiten(k) = qiten(k) - qc_i(k) + slten(k) = slten(k) + ( xlv * qc_l(k) + xls * qc_i(k) ) + ! ---------------------------------------------------------------------- ! + ! Since all reserved condensates will be treated as liquid water in the ! + ! 'check_energy_chng' & 'stratiform_tend' without an explicit conversion ! + ! algorithm, I should consider explicitly the energy conversions between ! + ! 'ice' and 'liquid' - i.e., I should convert 'ice' to 'liquid' and the ! + ! necessary energy for this conversion should be subtracted from 'sten'. ! + ! Without this conversion here, energy conservation error come out. Note ! + ! that there should be no change of 'qvten(k)'. ! + ! ---------------------------------------------------------------------- ! + sten(k) = sten(k) - ( xls - xlv ) * qc_i(k) + end do + + ! --------------------------------------------------------------- ! + ! Prevent the onset-of negative condensate at the next time step ! + ! Potentially, this block can be moved just in front of the above ! + ! block. ! + ! --------------------------------------------------------------- ! + + ! Modification : I should check whether this 'positive_moisture_single' routine is + ! consistent with the one used in UW PBL and cloud macrophysics schemes. + ! Modification : Below may overestimate resulting 'ql, qi' if we use the new 'qc_l', 'qc_i' + ! in combination with the original computation of qlten, qiten. However, + ! if we use new 'qlten,qiten', there is no problem. + + qv0_star(:mkx) = qv0(:mkx) + qvten(:mkx) * dt + ql0_star(:mkx) = ql0(:mkx) + qlten(:mkx) * dt + qi0_star(:mkx) = qi0(:mkx) + qiten(:mkx) * dt + s0_star(:mkx) = s0(:mkx) + sten(:mkx) * dt + call positive_moisture_single( xlv, xls, mkx, dt, qmin(1), qmin(ixcldliq), qmin(ixcldice), & + dp0, qv0_star, ql0_star, qi0_star, s0_star, qvten, qlten, qiten, sten ) + qtten(:mkx) = qvten(:mkx) + qlten(:mkx) + qiten(:mkx) + slten(:mkx) = sten(:mkx) - xlv * qlten(:mkx) - xls * qiten(:mkx) + + ! --------------------- ! + ! Tendencies of tracers ! + ! --------------------- ! + + do m = 4, ncnst + + if( m .ne. ixnumliq .and. m .ne. ixnumice ) then + + trmin = qmin(m) + trflx_d(0:mkx) = 0._r8 + trflx_u(0:mkx) = 0._r8 + do k = 1, mkx-1 + if( cnst_get_type_byind(m) .eq. 'wet' ) then + pdelx = dp0(k) + else + pdelx = dpdry0(k) + endif + km1 = k - 1 + dum = ( tr0(k,m) - trmin ) * pdelx / g / dt + trflx(km1,m) - trflx(k,m) + trflx_d(km1) + trflx_d(k) = min( 0._r8, dum ) + enddo + do k = mkx, 2, -1 + if( cnst_get_type_byind(m) .eq. 'wet' ) then + pdelx = dp0(k) + else + pdelx = dpdry0(k) + endif + km1 = k - 1 + dum = ( tr0(k,m) - trmin ) * pdelx / g / dt + trflx(km1,m) - trflx(k,m) + & + trflx_d(km1) - trflx_d(k) - trflx_u(k) + trflx_u(km1) = max( 0._r8, -dum ) + enddo + do k = 1, mkx + if( cnst_get_type_byind(m) .eq. 'wet' ) then + pdelx = dp0(k) + else + pdelx = dpdry0(k) + endif + km1 = k - 1 + ! Check : I should re-check whether '_u', '_d' are correctly ordered in + ! the below tendency computation. + trten(k,m) = ( trflx(km1,m) - trflx(k,m) + & + trflx_d(km1) - trflx_d(k) + & + trflx_u(km1) - trflx_u(k) ) * g / pdelx + enddo + + endif + + enddo + + ! ---------------------------------------------------------------- ! + ! Cumpute default diagnostic outputs ! + ! Note that since 'qtu(krel-1:kpen-1)' & 'thlu(krel-1:kpen-1)' has ! + ! been adjusted after detraining cloud condensate into environment ! + ! during cumulus updraft motion, below calculations will exactly ! + ! reproduce in-cloud properties as shown in the output analysis. ! + ! ---------------------------------------------------------------- ! + + call conden(prel,thlu(krel-1),qtu(krel-1),thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + qcubelow = qlj + qij + qlubelow = qlj + qiubelow = qij + rcwp = 0._r8 + rlwp = 0._r8 + riwp = 0._r8 + + ! --------------------------------------------------------------------- ! + ! In the below calculations, I explicitly considered cloud base ( LCL ) ! + ! and cloud top height ( ps0(kpen-1) + ppen ) ! + ! ----------------------------------------------------------------------! + do k = krel, kpen ! This is a layer index + ! ------------------------------------------------------------------ ! + ! Calculate cumulus condensate at the upper interface of each layer. ! + ! Note 'ppen < 0' and at 'k=kpen' layer, I used 'thlu_top'&'qtu_top' ! + ! which explicitly considered zero or non-zero 'fer(kpen)'. ! + ! ------------------------------------------------------------------ ! + if( k .eq. kpen ) then + call conden(ps0(k-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check) + else + call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check) + endif + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + ! ---------------------------------------------------------------- ! + ! Calculate in-cloud mean LWC ( qlu(k) ), IWC ( qiu(k) ), & layer ! + ! mean cumulus fraction ( cufrc(k) ), vertically-integrated layer ! + ! mean LWP and IWP. Expel some of in-cloud condensate at the upper ! + ! interface if it is largr than criqc. Note cumulus cloud fraction ! + ! is assumed to be twice of core updraft fractional area. Thus LWP ! + ! and IWP will be twice of actual value coming from our scheme. ! + ! ---------------------------------------------------------------- ! + qcu(k) = 0.5_r8 * ( qcubelow + qlj + qij ) + qlu(k) = 0.5_r8 * ( qlubelow + qlj ) + qiu(k) = 0.5_r8 * ( qiubelow + qij ) + cufrc(k) = ( ufrc(k-1) + ufrc(k) ) + if( k .eq. krel ) then + cufrc(k) = ( ufrclcl + ufrc(k) )*( prel - ps0(k) )/( ps0(k-1) - ps0(k) ) + else if( k .eq. kpen ) then + cufrc(k) = ( ufrc(k-1) + 0._r8 )*( -ppen ) /( ps0(k-1) - ps0(k) ) + if( (qlj + qij) .gt. criqc ) then + qcu(k) = 0.5_r8 * ( qcubelow + criqc ) + qlu(k) = 0.5_r8 * ( qlubelow + criqc * qlj / ( qlj + qij ) ) + qiu(k) = 0.5_r8 * ( qiubelow + criqc * qij / ( qlj + qij ) ) + endif + endif + rcwp = rcwp + ( qlu(k) + qiu(k) ) * ( ps0(k-1) - ps0(k) ) / g * cufrc(k) + rlwp = rlwp + qlu(k) * ( ps0(k-1) - ps0(k) ) / g * cufrc(k) + riwp = riwp + qiu(k) * ( ps0(k-1) - ps0(k) ) / g * cufrc(k) + qcubelow = qlj + qij + qlubelow = qlj + qiubelow = qij + end do + ! ------------------------------------ ! + ! Cloud top and base interface indices ! + ! ------------------------------------ ! + cnt = real( kpen, r8 ) + cnb = real( krel - 1, r8 ) + + ! ------------------------------------------------------------------------- ! + ! End of formal calculation. Below blocks are for implicit CIN calculations ! + ! with re-initialization and save variables at iter_cin = 1._r8 ! + ! ------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------- ! + ! Adjust the original input profiles for implicit CIN calculation ! + ! --------------------------------------------------------------- ! + + if( iter .ne. iter_cin ) then + + ! ------------------------------------------------------------------- ! + ! Save the output from "iter_cin = 1" ! + ! These output will be writed-out if "iter_cin = 1" was not performed ! + ! for some reasons. ! + ! ------------------------------------------------------------------- ! + + qv0_s(:mkx) = qv0(:mkx) + qvten(:mkx) * dt + ql0_s(:mkx) = ql0(:mkx) + qlten(:mkx) * dt + qi0_s(:mkx) = qi0(:mkx) + qiten(:mkx) * dt + s0_s(:mkx) = s0(:mkx) + sten(:mkx) * dt + u0_s(:mkx) = u0(:mkx) + uten(:mkx) * dt + v0_s(:mkx) = v0(:mkx) + vten(:mkx) * dt + qt0_s(:mkx) = qv0_s(:mkx) + ql0_s(:mkx) + qi0_s(:mkx) + t0_s(:mkx) = t0(:mkx) + sten(:mkx) * dt / cp + do m = 1, ncnst + tr0_s(:mkx,m) = tr0(:mkx,m) + trten(:mkx,m) * dt + enddo + + umf_s(0:mkx) = umf(0:mkx) + qvten_s(:mkx) = qvten(:mkx) + qlten_s(:mkx) = qlten(:mkx) + qiten_s(:mkx) = qiten(:mkx) + sten_s(:mkx) = sten(:mkx) + uten_s(:mkx) = uten(:mkx) + vten_s(:mkx) = vten(:mkx) + qrten_s(:mkx) = qrten(:mkx) + qsten_s(:mkx) = qsten(:mkx) + precip_s = precip + snow_s = snow + evapc_s(:mkx) = evapc(:mkx) + cush_s = cush + cufrc_s(:mkx) = cufrc(:mkx) + slflx_s(0:mkx) = slflx(0:mkx) + qtflx_s(0:mkx) = qtflx(0:mkx) + qcu_s(:mkx) = qcu(:mkx) + qlu_s(:mkx) = qlu(:mkx) + qiu_s(:mkx) = qiu(:mkx) + fer_s(:mkx) = fer(:mkx) + fdr_s(:mkx) = fdr(:mkx) + cin_s = cin + cinlcl_s = cinlcl + cbmf_s = cbmf + rliq_s = rliq + qc_s(:mkx) = qc(:mkx) + cnt_s = cnt + cnb_s = cnb + qtten_s(:mkx) = qtten(:mkx) + slten_s(:mkx) = slten(:mkx) + ufrc_s(0:mkx) = ufrc(0:mkx) + + uflx_s(0:mkx) = uflx(0:mkx) + vflx_s(0:mkx) = vflx(0:mkx) + + ufrcinvbase_s = ufrcinvbase + ufrclcl_s = ufrclcl + winvbase_s = winvbase + wlcl_s = wlcl + plcl_s = plcl + pinv_s = ps0(kinv-1) + plfc_s = plfc + pbup_s = ps0(kbup) + ppen_s = ps0(kpen-1) + ppen + qtsrc_s = qtsrc + thlsrc_s = thlsrc + thvlsrc_s = thvlsrc + emfkbup_s = emf(kbup) + cbmflimit_s = cbmflimit + tkeavg_s = tkeavg + zinv_s = zs0(kinv-1) + rcwp_s = rcwp + rlwp_s = rlwp + riwp_s = riwp + + wu_s(0:mkx) = wu(0:mkx) + qtu_s(0:mkx) = qtu(0:mkx) + thlu_s(0:mkx) = thlu(0:mkx) + thvu_s(0:mkx) = thvu(0:mkx) + uu_s(0:mkx) = uu(0:mkx) + vu_s(0:mkx) = vu(0:mkx) + qtu_emf_s(0:mkx) = qtu_emf(0:mkx) + thlu_emf_s(0:mkx) = thlu_emf(0:mkx) + uu_emf_s(0:mkx) = uu_emf(0:mkx) + vu_emf_s(0:mkx) = vu_emf(0:mkx) + uemf_s(0:mkx) = uemf(0:mkx) + + dwten_s(:mkx) = dwten(:mkx) + diten_s(:mkx) = diten(:mkx) + flxrain_s(0:mkx) = flxrain(0:mkx) + flxsnow_s(0:mkx) = flxsnow(0:mkx) + ntraprd_s(:mkx) = ntraprd(:mkx) + ntsnprd_s(:mkx) = ntsnprd(:mkx) + + excessu_arr_s(:mkx) = excessu_arr(:mkx) + excess0_arr_s(:mkx) = excess0_arr(:mkx) + xc_arr_s(:mkx) = xc_arr(:mkx) + aquad_arr_s(:mkx) = aquad_arr(:mkx) + bquad_arr_s(:mkx) = bquad_arr(:mkx) + cquad_arr_s(:mkx) = cquad_arr(:mkx) + bogbot_arr_s(:mkx) = bogbot_arr(:mkx) + bogtop_arr_s(:mkx) = bogtop_arr(:mkx) + + do m = 1, ncnst + trten_s(:mkx,m) = trten(:mkx,m) + trflx_s(0:mkx,m) = trflx(0:mkx,m) + tru_s(0:mkx,m) = tru(0:mkx,m) + tru_emf_s(0:mkx,m) = tru_emf(0:mkx,m) + enddo + + ! ----------------------------------------------------------------------------- ! + ! Recalculate environmental variables for new cin calculation at "iter_cin = 2" ! + ! using the updated state variables. Perform only for variables necessary for ! + ! the new cin calculation. ! + ! ----------------------------------------------------------------------------- ! + + qv0(:mkx) = qv0_s(:mkx) + ql0(:mkx) = ql0_s(:mkx) + qi0(:mkx) = qi0_s(:mkx) + s0(:mkx) = s0_s(:mkx) + t0(:mkx) = t0_s(:mkx) + + qt0(:mkx) = (qv0(:mkx) + ql0(:mkx) + qi0(:mkx)) + thl0(:mkx) = (t0(:mkx) - xlv*ql0(:mkx)/cp - xls*qi0(:mkx)/cp)/exn0(:mkx) + thvl0(:mkx) = (1._r8 + zvir*qt0(:mkx))*thl0(:mkx) + + ssthl0 = slope(mkx,thl0,p0) ! Dimension of ssthl0(:mkx) is implicit + ssqt0 = slope(mkx,qt0 ,p0) + ssu0 = slope(mkx,u0 ,p0) + ssv0 = slope(mkx,v0 ,p0) + do m = 1, ncnst + sstr0(:mkx,m) = slope(mkx,tr0(:mkx,m),p0) + enddo + + do k = 1, mkx + + thl0bot = thl0(k) + ssthl0(k) * ( ps0(k-1) - p0(k) ) + qt0bot = qt0(k) + ssqt0(k) * ( ps0(k-1) - p0(k) ) + call conden(ps0(k-1),thl0bot,qt0bot,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0bot(k) = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + thvl0bot(k) = thl0bot * ( 1._r8 + zvir*qt0bot ) + + thl0top = thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) + qt0top = qt0(k) + ssqt0(k) * ( ps0(k) - p0(k) ) + call conden(ps0(k),thl0top,qt0top,thj,qvj,qlj,qij,qse,id_check) + if( id_check .eq. 1 ) then + exit_conden(i) = 1._r8 + id_exit = .true. + go to 333 + end if + thv0top(k) = thj * ( 1._r8 + zvir*qvj - qlj - qij ) + thvl0top(k) = thl0top * ( 1._r8 + zvir*qt0top ) + + end do + + endif ! End of 'if(iter .ne. iter_cin)' if sentence. + + end do ! End of implicit CIN loop (cin_iter) + + ! ----------------------- ! + ! Update Output Variables ! + ! ----------------------- ! + + umf_out(i,0:mkx) = umf(0:mkx) + slflx_out(i,0:mkx) = slflx(0:mkx) + qtflx_out(i,0:mkx) = qtflx(0:mkx) +!the indices are not reversed, these variables go into compute_mcshallow_inv, this is why they are called "flxprc1" and "flxsnow1". + flxprc1_out(i,0:mkx) = flxrain(0:mkx) + flxsnow(0:mkx) + flxsnow1_out(i,0:mkx) = flxsnow(0:mkx) + qvten_out(i,:mkx) = qvten(:mkx) + qlten_out(i,:mkx) = qlten(:mkx) + qiten_out(i,:mkx) = qiten(:mkx) + sten_out(i,:mkx) = sten(:mkx) + uten_out(i,:mkx) = uten(:mkx) + vten_out(i,:mkx) = vten(:mkx) + qrten_out(i,:mkx) = qrten(:mkx) + qsten_out(i,:mkx) = qsten(:mkx) + precip_out(i) = precip + snow_out(i) = snow + evapc_out(i,:mkx) = evapc(:mkx) + cufrc_out(i,:mkx) = cufrc(:mkx) + qcu_out(i,:mkx) = qcu(:mkx) + qlu_out(i,:mkx) = qlu(:mkx) + qiu_out(i,:mkx) = qiu(:mkx) + cush_inout(i) = cush + cbmf_out(i) = cbmf + rliq_out(i) = rliq + qc_out(i,:mkx) = qc(:mkx) + cnt_out(i) = cnt + cnb_out(i) = cnb + + do m = 1, ncnst + trten_out(i,:mkx,m) = trten(:mkx,m) + enddo + + ! ------------------------------------------------- ! + ! Below are specific diagnostic output for detailed ! + ! analysis of cumulus scheme ! + ! ------------------------------------------------- ! + + fer_out(i,mkx:1:-1) = fer(:mkx) + fdr_out(i,mkx:1:-1) = fdr(:mkx) + cinh_out(i) = cin + cinlclh_out(i) = cinlcl + qtten_out(i,mkx:1:-1) = qtten(:mkx) + slten_out(i,mkx:1:-1) = slten(:mkx) + ufrc_out(i,mkx:0:-1) = ufrc(0:mkx) + uflx_out(i,mkx:0:-1) = uflx(0:mkx) + vflx_out(i,mkx:0:-1) = vflx(0:mkx) + + ufrcinvbase_out(i) = ufrcinvbase + ufrclcl_out(i) = ufrclcl + winvbase_out(i) = winvbase + wlcl_out(i) = wlcl + plcl_out(i) = plcl + pinv_out(i) = ps0(kinv-1) + plfc_out(i) = plfc + pbup_out(i) = ps0(kbup) + ppen_out(i) = ps0(kpen-1) + ppen + qtsrc_out(i) = qtsrc + thlsrc_out(i) = thlsrc + thvlsrc_out(i) = thvlsrc + emfkbup_out(i) = emf(kbup) + cbmflimit_out(i) = cbmflimit + tkeavg_out(i) = tkeavg + zinv_out(i) = zs0(kinv-1) + rcwp_out(i) = rcwp + rlwp_out(i) = rlwp + riwp_out(i) = riwp + + wu_out(i,mkx:0:-1) = wu(0:mkx) + qtu_out(i,mkx:0:-1) = qtu(0:mkx) + thlu_out(i,mkx:0:-1) = thlu(0:mkx) + thvu_out(i,mkx:0:-1) = thvu(0:mkx) + uu_out(i,mkx:0:-1) = uu(0:mkx) + vu_out(i,mkx:0:-1) = vu(0:mkx) + qtu_emf_out(i,mkx:0:-1) = qtu_emf(0:mkx) + thlu_emf_out(i,mkx:0:-1) = thlu_emf(0:mkx) + uu_emf_out(i,mkx:0:-1) = uu_emf(0:mkx) + vu_emf_out(i,mkx:0:-1) = vu_emf(0:mkx) + uemf_out(i,mkx:0:-1) = uemf(0:mkx) + + dwten_out(i,mkx:1:-1) = dwten(:mkx) + diten_out(i,mkx:1:-1) = diten(:mkx) + flxrain_out(i,mkx:0:-1) = flxrain(0:mkx) + flxsnow_out(i,mkx:0:-1) = flxsnow(0:mkx) + ntraprd_out(i,mkx:1:-1) = ntraprd(:mkx) + ntsnprd_out(i,mkx:1:-1) = ntsnprd(:mkx) + + excessu_arr_out(i,mkx:1:-1) = excessu_arr(:mkx) + excess0_arr_out(i,mkx:1:-1) = excess0_arr(:mkx) + xc_arr_out(i,mkx:1:-1) = xc_arr(:mkx) + aquad_arr_out(i,mkx:1:-1) = aquad_arr(:mkx) + bquad_arr_out(i,mkx:1:-1) = bquad_arr(:mkx) + cquad_arr_out(i,mkx:1:-1) = cquad_arr(:mkx) + bogbot_arr_out(i,mkx:1:-1) = bogbot_arr(:mkx) + bogtop_arr_out(i,mkx:1:-1) = bogtop_arr(:mkx) + + do m = 1, ncnst + trflx_out(i,mkx:0:-1,m) = trflx(0:mkx,m) + tru_out(i,mkx:0:-1,m) = tru(0:mkx,m) + tru_emf_out(i,mkx:0:-1,m) = tru_emf(0:mkx,m) + enddo + + 333 if(id_exit) then ! Exit without cumulus convection + + exit_UWCu(i) = 1._r8 + + ! --------------------------------------------------------------------- ! + ! Initialize output variables when cumulus convection was not performed.! + ! --------------------------------------------------------------------- ! + + umf_out(i,0:mkx) = 0._r8 + slflx_out(i,0:mkx) = 0._r8 + qtflx_out(i,0:mkx) = 0._r8 + qvten_out(i,:mkx) = 0._r8 + qlten_out(i,:mkx) = 0._r8 + qiten_out(i,:mkx) = 0._r8 + sten_out(i,:mkx) = 0._r8 + uten_out(i,:mkx) = 0._r8 + vten_out(i,:mkx) = 0._r8 + qrten_out(i,:mkx) = 0._r8 + qsten_out(i,:mkx) = 0._r8 + precip_out(i) = 0._r8 + snow_out(i) = 0._r8 + evapc_out(i,:mkx) = 0._r8 + cufrc_out(i,:mkx) = 0._r8 + qcu_out(i,:mkx) = 0._r8 + qlu_out(i,:mkx) = 0._r8 + qiu_out(i,:mkx) = 0._r8 + cush_inout(i) = -1._r8 + cbmf_out(i) = 0._r8 + rliq_out(i) = 0._r8 + qc_out(i,:mkx) = 0._r8 + cnt_out(i) = 1._r8 + cnb_out(i) = real(mkx, r8) + + fer_out(i,mkx:1:-1) = 0._r8 + fdr_out(i,mkx:1:-1) = 0._r8 + cinh_out(i) = -1._r8 + cinlclh_out(i) = -1._r8 + qtten_out(i,mkx:1:-1) = 0._r8 + slten_out(i,mkx:1:-1) = 0._r8 + ufrc_out(i,mkx:0:-1) = 0._r8 + uflx_out(i,mkx:0:-1) = 0._r8 + vflx_out(i,mkx:0:-1) = 0._r8 + + ufrcinvbase_out(i) = 0._r8 + ufrclcl_out(i) = 0._r8 + winvbase_out(i) = 0._r8 + wlcl_out(i) = 0._r8 + plcl_out(i) = 0._r8 + pinv_out(i) = 0._r8 + plfc_out(i) = 0._r8 + pbup_out(i) = 0._r8 + ppen_out(i) = 0._r8 + qtsrc_out(i) = 0._r8 + thlsrc_out(i) = 0._r8 + thvlsrc_out(i) = 0._r8 + emfkbup_out(i) = 0._r8 + cbmflimit_out(i) = 0._r8 + tkeavg_out(i) = 0._r8 + zinv_out(i) = 0._r8 + rcwp_out(i) = 0._r8 + rlwp_out(i) = 0._r8 + riwp_out(i) = 0._r8 + + wu_out(i,mkx:0:-1) = 0._r8 + qtu_out(i,mkx:0:-1) = 0._r8 + thlu_out(i,mkx:0:-1) = 0._r8 + thvu_out(i,mkx:0:-1) = 0._r8 + uu_out(i,mkx:0:-1) = 0._r8 + vu_out(i,mkx:0:-1) = 0._r8 + qtu_emf_out(i,mkx:0:-1) = 0._r8 + thlu_emf_out(i,mkx:0:-1) = 0._r8 + uu_emf_out(i,mkx:0:-1) = 0._r8 + vu_emf_out(i,mkx:0:-1) = 0._r8 + uemf_out(i,mkx:0:-1) = 0._r8 + + dwten_out(i,mkx:1:-1) = 0._r8 + diten_out(i,mkx:1:-1) = 0._r8 + flxrain_out(i,mkx:0:-1) = 0._r8 + flxsnow_out(i,mkx:0:-1) = 0._r8 + ntraprd_out(i,mkx:1:-1) = 0._r8 + ntsnprd_out(i,mkx:1:-1) = 0._r8 + + excessu_arr_out(i,mkx:1:-1) = 0._r8 + excess0_arr_out(i,mkx:1:-1) = 0._r8 + xc_arr_out(i,mkx:1:-1) = 0._r8 + aquad_arr_out(i,mkx:1:-1) = 0._r8 + bquad_arr_out(i,mkx:1:-1) = 0._r8 + cquad_arr_out(i,mkx:1:-1) = 0._r8 + bogbot_arr_out(i,mkx:1:-1) = 0._r8 + bogtop_arr_out(i,mkx:1:-1) = 0._r8 + + do m = 1, ncnst + trten_out(i,:mkx,m) = 0._r8 + trflx_out(i,mkx:0:-1,m) = 0._r8 + tru_out(i,mkx:0:-1,m) = 0._r8 + tru_emf_out(i,mkx:0:-1,m) = 0._r8 + enddo + + end if + + end do ! end of big i loop for each column. + + ! ---------------------------------------- ! + ! Writing main diagnostic output variables ! + ! ---------------------------------------- ! + + call outfld( 'qtflx_Cu' , qtflx_out(:,mkx:0:-1), mix, lchnk ) + call outfld( 'slflx_Cu' , slflx_out(:,mkx:0:-1), mix, lchnk ) + call outfld( 'uflx_Cu' , uflx_out, mix, lchnk ) + call outfld( 'vflx_Cu' , vflx_out, mix, lchnk ) + + call outfld( 'qtten_Cu' , qtten_out, mix, lchnk ) + call outfld( 'slten_Cu' , slten_out, mix, lchnk ) + call outfld( 'uten_Cu' , uten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'vten_Cu' , vten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qvten_Cu' , qvten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qlten_Cu' , qlten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qiten_Cu' , qiten_out(:,mkx:1:-1), mix, lchnk ) + + call outfld( 'cbmf_Cu' , cbmf_out, mix, lchnk ) + call outfld( 'ufrcinvbase_Cu' , ufrcinvbase_out, mix, lchnk ) + call outfld( 'ufrclcl_Cu' , ufrclcl_out, mix, lchnk ) + call outfld( 'winvbase_Cu' , winvbase_out, mix, lchnk ) + call outfld( 'wlcl_Cu' , wlcl_out, mix, lchnk ) + call outfld( 'plcl_Cu' , plcl_out, mix, lchnk ) + call outfld( 'pinv_Cu' , pinv_out, mix, lchnk ) + call outfld( 'plfc_Cu' , plfc_out, mix, lchnk ) + call outfld( 'pbup_Cu' , pbup_out, mix, lchnk ) + call outfld( 'ppen_Cu' , ppen_out, mix, lchnk ) + call outfld( 'qtsrc_Cu' , qtsrc_out, mix, lchnk ) + call outfld( 'thlsrc_Cu' , thlsrc_out, mix, lchnk ) + call outfld( 'thvlsrc_Cu' , thvlsrc_out, mix, lchnk ) + call outfld( 'emfkbup_Cu' , emfkbup_out, mix, lchnk ) + call outfld( 'cin_Cu' , cinh_out, mix, lchnk ) + call outfld( 'cinlcl_Cu' , cinlclh_out, mix, lchnk ) + call outfld( 'cbmflimit_Cu' , cbmflimit_out, mix, lchnk ) + call outfld( 'tkeavg_Cu' , tkeavg_out, mix, lchnk ) + call outfld( 'zinv_Cu' , zinv_out, mix, lchnk ) + call outfld( 'rcwp_Cu' , rcwp_out, mix, lchnk ) + call outfld( 'rlwp_Cu' , rlwp_out, mix, lchnk ) + call outfld( 'riwp_Cu' , riwp_out, mix, lchnk ) + call outfld( 'tophgt_Cu' , cush_inout, mix, lchnk ) + + call outfld( 'wu_Cu' , wu_out, mix, lchnk ) + call outfld( 'ufrc_Cu' , ufrc_out, mix, lchnk ) + call outfld( 'qtu_Cu' , qtu_out, mix, lchnk ) + call outfld( 'thlu_Cu' , thlu_out, mix, lchnk ) + call outfld( 'thvu_Cu' , thvu_out, mix, lchnk ) + call outfld( 'uu_Cu' , uu_out, mix, lchnk ) + call outfld( 'vu_Cu' , vu_out, mix, lchnk ) + call outfld( 'qtu_emf_Cu' , qtu_emf_out, mix, lchnk ) + call outfld( 'thlu_emf_Cu' , thlu_emf_out, mix, lchnk ) + call outfld( 'uu_emf_Cu' , uu_emf_out, mix, lchnk ) + call outfld( 'vu_emf_Cu' , vu_emf_out, mix, lchnk ) + call outfld( 'umf_Cu' , umf_out(:,mkx:0:-1), mix, lchnk ) + call outfld( 'uemf_Cu' , uemf_out, mix, lchnk ) + call outfld( 'qcu_Cu' , qcu_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qlu_Cu' , qlu_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qiu_Cu' , qiu_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'cufrc_Cu' , cufrc_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'fer_Cu' , fer_out, mix, lchnk ) + call outfld( 'fdr_Cu' , fdr_out, mix, lchnk ) + + call outfld( 'dwten_Cu' , dwten_out, mix, lchnk ) + call outfld( 'diten_Cu' , diten_out, mix, lchnk ) + call outfld( 'qrten_Cu' , qrten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'qsten_Cu' , qsten_out(:,mkx:1:-1), mix, lchnk ) + call outfld( 'flxrain_Cu' , flxrain_out, mix, lchnk ) + call outfld( 'flxsnow_Cu' , flxsnow_out, mix, lchnk ) + call outfld( 'ntraprd_Cu' , ntraprd_out, mix, lchnk ) + call outfld( 'ntsnprd_Cu' , ntsnprd_out, mix, lchnk ) + + call outfld( 'excessu_Cu' , excessu_arr_out, mix, lchnk ) + call outfld( 'excess0_Cu' , excess0_arr_out, mix, lchnk ) + call outfld( 'xc_Cu' , xc_arr_out, mix, lchnk ) + call outfld( 'aquad_Cu' , aquad_arr_out, mix, lchnk ) + call outfld( 'bquad_Cu' , bquad_arr_out, mix, lchnk ) + call outfld( 'cquad_Cu' , cquad_arr_out, mix, lchnk ) + call outfld( 'bogbot_Cu' , bogbot_arr_out, mix, lchnk ) + call outfld( 'bogtop_Cu' , bogtop_arr_out, mix, lchnk ) + + call outfld( 'exit_UWCu_Cu' , exit_UWCu, mix, lchnk ) + call outfld( 'exit_conden_Cu' , exit_conden, mix, lchnk ) + call outfld( 'exit_klclmkx_Cu' , exit_klclmkx, mix, lchnk ) + call outfld( 'exit_klfcmkx_Cu' , exit_klfcmkx, mix, lchnk ) + call outfld( 'exit_ufrc_Cu' , exit_ufrc, mix, lchnk ) + call outfld( 'exit_wtw_Cu' , exit_wtw, mix, lchnk ) + call outfld( 'exit_drycore_Cu' , exit_drycore, mix, lchnk ) + call outfld( 'exit_wu_Cu' , exit_wu, mix, lchnk ) + call outfld( 'exit_cufilter_Cu', exit_cufilter, mix, lchnk ) + call outfld( 'exit_kinv1_Cu' , exit_kinv1, mix, lchnk ) + call outfld( 'exit_rei_Cu' , exit_rei, mix, lchnk ) + + call outfld( 'limit_shcu_Cu' , limit_shcu, mix, lchnk ) + call outfld( 'limit_negcon_Cu' , limit_negcon, mix, lchnk ) + call outfld( 'limit_ufrc_Cu' , limit_ufrc, mix, lchnk ) + call outfld( 'limit_ppen_Cu' , limit_ppen, mix, lchnk ) + call outfld( 'limit_emf_Cu' , limit_emf, mix, lchnk ) + call outfld( 'limit_cinlcl_Cu' , limit_cinlcl, mix, lchnk ) + call outfld( 'limit_cin_Cu' , limit_cin, mix, lchnk ) + call outfld( 'limit_cbmf_Cu' , limit_cbmf, mix, lchnk ) + call outfld( 'limit_rei_Cu' , limit_rei, mix, lchnk ) + call outfld( 'ind_delcin_Cu' , ind_delcin, mix, lchnk ) + + return + + end subroutine compute_uwshcu + + ! ------------------------------ ! + ! ! + ! Beginning of subroutine blocks ! + ! ! + ! ------------------------------ ! + + subroutine getbuoy(pbot,thv0bot,ptop,thv0top,thvubot,thvutop,plfc,cin) + ! ----------------------------------------------------------- ! + ! Subroutine to calculate integrated CIN [ J/kg = m2/s2 ] and ! + ! 'cinlcl, plfc' if any. Assume 'thv' is linear in each layer ! + ! both for cumulus and environment. Note that this subroutine ! + ! only include positive CIN in calculation - if there are any ! + ! negative CIN, it is assumed to be zero. This is slightly ! + ! different from 'single_cin' below, where both positive and ! + ! negative CIN are included. ! + ! ----------------------------------------------------------- ! + real(r8) pbot,thv0bot,ptop,thv0top,thvubot,thvutop,plfc,cin,frc + + if( thvubot .gt. thv0bot .and. thvutop .gt. thv0top ) then + plfc = pbot + return + elseif( thvubot .le. thv0bot .and. thvutop .le. thv0top ) then + cin = cin - ( (thvubot/thv0bot - 1._r8) + (thvutop/thv0top - 1._r8)) * (pbot - ptop) / & + ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) ) + elseif( thvubot .gt. thv0bot .and. thvutop .le. thv0top ) then + frc = ( thvutop/thv0top - 1._r8 ) / ( (thvutop/thv0top - 1._r8) - (thvubot/thv0bot - 1._r8) ) + cin = cin - ( thvutop/thv0top - 1._r8 ) * ( (ptop + frc*(pbot - ptop)) - ptop ) / & + ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) ) + else + frc = ( thvubot/thv0bot - 1._r8 ) / ( (thvubot/thv0bot - 1._r8) - (thvutop/thv0top - 1._r8) ) + plfc = pbot - frc * ( pbot - ptop ) + cin = cin - ( thvubot/thv0bot - 1._r8)*(pbot - plfc)/ & + ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top * exnf(ptop))) + endif + + return + end subroutine getbuoy + + function single_cin(pbot,thv0bot,ptop,thv0top,thvubot,thvutop) + ! ------------------------------------------------------- ! + ! Function to calculate a single layer CIN by summing all ! + ! positive and negative CIN. ! + ! ------------------------------------------------------- ! + real(r8) :: single_cin + real(r8) pbot,thv0bot,ptop,thv0top,thvubot,thvutop + + single_cin = ( (1._r8 - thvubot/thv0bot) + (1._r8 - thvutop/thv0top)) * ( pbot - ptop ) / & + ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) ) + return + end function single_cin + + + subroutine conden(p,thl,qt,th,qv,ql,qi,rvls,id_check) + ! --------------------------------------------------------------------- ! + ! Calculate thermodynamic properties from a given set of ( p, thl, qt ) ! + ! --------------------------------------------------------------------- ! + implicit none + real(r8), intent(in) :: p + real(r8), intent(in) :: thl + real(r8), intent(in) :: qt + real(r8), intent(out) :: th + real(r8), intent(out) :: qv + real(r8), intent(out) :: ql + real(r8), intent(out) :: qi + real(r8), intent(out) :: rvls + integer , intent(out) :: id_check + real(r8) :: tc,temps,t + real(r8) :: leff, nu, qc + integer :: iteration + real(r8) :: es ! Saturation vapor pressure + real(r8) :: qs ! Saturation spec. humidity + + + tc = thl*exnf(p) + ! Modification : In order to be compatible with the dlf treatment in stratiform.F90, + ! we may use ( 268.15, 238.15 ) with 30K ramping instead of 20 K, + ! in computing ice fraction below. + ! Note that 'cldfrc_fice' uses ( 243.15, 263.15 ) with 20K ramping for stratus. + nu = max(min((268._r8 - tc)/20._r8,1.0_r8),0.0_r8) ! Fraction of ice in the condensate. + leff = (1._r8 - nu)*xlv + nu*xls ! This is an estimate that hopefully speeds convergence + + ! --------------------------------------------------------------------------- ! + ! Below "temps" and "rvls" are just initial guesses for iteration loop below. ! + ! Note that the output "temps" from the below iteration loop is "temperature" ! + ! NOT "liquid temperature". ! + ! --------------------------------------------------------------------------- ! + + temps = tc + call qsat(temps, p, es, qs) + rvls = qs + + if( qs .ge. qt ) then + id_check = 0 + qv = qt + qc = 0._r8 + ql = 0._r8 + qi = 0._r8 + th = tc/exnf(p) + else + do iteration = 1, 10 + temps = temps + ( (tc-temps)*cp/leff + qt - rvls )/( cp/leff + ep2*leff*rvls/r/temps/temps ) + call qsat(temps, p, es, qs) + rvls = qs + end do + qc = max(qt - qs,0._r8) + qv = qt - qc + ql = qc*(1._r8 - nu) + qi = nu*qc + th = temps/exnf(p) + if( abs((temps-(leff/cp)*qc)-tc) .ge. 1._r8 ) then + id_check = 1 + else + id_check = 0 + end if + end if + + return + end subroutine conden + + subroutine roots(a,b,c,r1,r2,status) + ! --------------------------------------------------------- ! + ! Subroutine to solve the second order polynomial equation. ! + ! I should check this subroutine later. ! + ! --------------------------------------------------------- ! + real(r8), intent(in) :: a + real(r8), intent(in) :: b + real(r8), intent(in) :: c + real(r8), intent(out) :: r1 + real(r8), intent(out) :: r2 + integer , intent(out) :: status + real(r8) :: q + + status = 0 + + if( a .eq. 0._r8 ) then ! Form b*x + c = 0 + if( b .eq. 0._r8 ) then ! Failure: c = 0 + status = 1 + else ! b*x + c = 0 + r1 = -c/b + endif + r2 = r1 + else + if( b .eq. 0._r8 ) then ! Form a*x**2 + c = 0 + if( a*c .gt. 0._r8 ) then ! Failure: x**2 = -c/a < 0 + status = 2 + else ! x**2 = -c/a + r1 = sqrt(-c/a) + endif + r2 = -r1 + else ! Form a*x**2 + b*x + c = 0 + if( (b**2 - 4._r8*a*c) .lt. 0._r8 ) then ! Failure, no real roots + status = 3 + else + q = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c)) + r1 = q/a + r2 = c/q + endif + endif + endif + + return + end subroutine roots + + function slope(mkx,field,p0) + ! ------------------------------------------------------------------ ! + ! Function performing profile reconstruction of conservative scalars ! + ! in each layer. This is identical to profile reconstruction used in ! + ! UW-PBL scheme but from bottom to top layer here. At the lowest ! + ! layer near to surface, slope is defined using the two lowest layer ! + ! mid-point values. I checked this subroutine and it is correct. ! + ! ------------------------------------------------------------------ ! + integer, intent(in) :: mkx + real(r8) :: slope(mkx) + real(r8), intent(in) :: field(mkx) + real(r8), intent(in) :: p0(mkx) + + real(r8) :: below + real(r8) :: above + integer :: k + + below = ( field(2) - field(1) ) / ( p0(2) - p0(1) ) + do k = 2, mkx + above = ( field(k) - field(k-1) ) / ( p0(k) - p0(k-1) ) + if( above .gt. 0._r8 ) then + slope(k-1) = max(0._r8,min(above,below)) + else + slope(k-1) = min(0._r8,max(above,below)) + end if + below = above + end do + slope(mkx) = slope(mkx-1) + + return + end function slope + + function qsinvert(qt,thl,psfc) + ! ----------------------------------------------------------------- ! + ! Function calculating saturation pressure ps (or pLCL) from qt and ! + ! thl ( liquid potential temperature, NOT liquid virtual potential ! + ! temperature) by inverting Bolton formula. I should check later if ! + ! current use of 'leff' instead of 'xlv' here is reasonable or not. ! + ! ----------------------------------------------------------------- ! + real(r8) :: qsinvert + real(r8) qt, thl, psfc + real(r8) ps, Pis, Ts, err, dlnqsdT, dTdPis + real(r8) dPisdps, dlnqsdps, derrdps, dps + real(r8) Ti, rhi, TLCL, PiLCL, psmin, dpsmax + integer i + real(r8) :: es ! saturation vapor pressure + real(r8) :: qs ! saturation spec. humidity + real(r8) :: gam ! (L/cp)*dqs/dT + real(r8) :: leff, nu + + psmin = 100._r8*100._r8 ! Default saturation pressure [Pa] if iteration does not converge + dpsmax = 1._r8 ! Tolerance [Pa] for convergence of iteration + + ! ------------------------------------ ! + ! Calculate best initial guess of pLCL ! + ! ------------------------------------ ! + + Ti = thl*(psfc/p00)**rovcp + call qsat(Ti, psfc, es, qs) + rhi = qt/qs + if( rhi .le. 0.01_r8 ) then + write(iulog,*) 'Source air is too dry and pLCL is set to psmin in uwshcu.F90' + qsinvert = psmin + return + end if + TLCL = 55._r8 + 1._r8/(1._r8/(Ti-55._r8)-log(rhi)/2840._r8); ! Bolton's formula. MWR.1980.Eq.(22) + PiLCL = TLCL/thl + ps = p00*(PiLCL)**(1._r8/rovcp) + + do i = 1, 10 + Pis = (ps/p00)**rovcp + Ts = thl*Pis + call qsat(Ts, ps, es, qs, gam=gam) + err = qt - qs + nu = max(min((268._r8 - Ts)/20._r8,1.0_r8),0.0_r8) + leff = (1._r8 - nu)*xlv + nu*xls + dlnqsdT = gam*(cp/leff)/qs + dTdPis = thl + dPisdps = rovcp*Pis/ps + dlnqsdps = -1._r8/(ps - (1._r8 - ep2)*es) + derrdps = -qs*(dlnqsdT * dTdPis * dPisdps + dlnqsdps) + dps = -err/derrdps + ps = ps + dps + if( ps .lt. 0._r8 ) then + write(iulog,*) 'pLCL iteration is negative and set to psmin in uwshcu.F90', qt, thl, psfc + qsinvert = psmin + return + end if + if( abs(dps) .le. dpsmax ) then + qsinvert = ps + return + end if + end do + write(iulog,*) 'pLCL does not converge and is set to psmin in uwshcu.F90', qt, thl, psfc + qsinvert = psmin + return + end function qsinvert + + real(r8) function compute_alpha(del_CIN,ke) + ! ------------------------------------------------ ! + ! Subroutine to compute proportionality factor for ! + ! implicit CIN calculation. ! + ! ------------------------------------------------ ! + real(r8) :: del_CIN, ke + real(r8) :: x0, x1 + + integer :: iteration + + x0 = 0._r8 + do iteration = 1, 10 + x1 = x0 - (exp(-x0*ke*del_CIN) - x0)/(-ke*del_CIN*exp(-x0*ke*del_CIN) - 1._r8) + x0 = x1 + end do + compute_alpha = x0 + + return + + end function compute_alpha + + real(r8) function compute_mumin2(mulcl,rmaxfrac,mulow) + ! --------------------------------------------------------- ! + ! Subroutine to compute critical 'mu' (normalized CIN) such ! + ! that updraft fraction at the LCL is equal to 'rmaxfrac'. ! + ! --------------------------------------------------------- ! + real(r8) :: mulcl, rmaxfrac, mulow + real(r8) :: x0, x1, ex, ef, exf, f, fs + integer :: iteration + + x0 = mulow + do iteration = 1, 10 + ex = exp(-x0**2) + ef = erfc(x0) + ! if(x0.ge.3._r8) then + ! compute_mumin2 = 3._r8 + ! goto 20 + ! endif + exf = ex/ef + f = 0.5_r8*exf**2 - 0.5_r8*(ex/2._r8/rmaxfrac)**2 - (mulcl*2.5066_r8/2._r8)**2 + fs = (2._r8*exf**2)*(exf/sqrt(3.141592_r8)-x0) + (0.5_r8*x0*ex**2)/(rmaxfrac**2) + x1 = x0 - f/fs + x0 = x1 + end do + compute_mumin2 = x0 + + 20 return + + end function compute_mumin2 + + real(r8) function compute_ppen(wtwb,D,bogbot,bogtop,rho0j,dpen) + ! ----------------------------------------------------------- ! + ! Subroutine to compute critical 'ppen[Pa]<0' ( pressure dis. ! + ! from 'ps0(kpen-1)' to the cumulus top where cumulus updraft ! + ! vertical velocity is exactly zero ) by considering exact ! + ! non-zero fer(kpen). ! + ! ----------------------------------------------------------- ! + real(r8) :: wtwb, D, bogbot, bogtop, rho0j, dpen + real(r8) :: x0, x1, f, fs, SB, s00 + integer :: iteration + + ! Buoyancy slope + SB = ( bogtop - bogbot ) / dpen + ! Sign of slope, 'f' at x = 0 + ! If 's00>0', 'w' increases with height. + s00 = bogbot / rho0j - D * wtwb + + if( D*dpen .lt. 1.e-8_r8 ) then + if( s00 .ge. 0._r8 ) then + x0 = dpen + else + x0 = max(0._r8,min(dpen,-0.5_r8*wtwb/s00)) + endif + else + if( s00 .ge. 0._r8 ) then + x0 = dpen + else + x0 = 0._r8 + endif + do iteration = 1, 5 + f = exp(-2._r8*D*x0)*(wtwb-(bogbot-SB/(2._r8*D))/(D*rho0j)) + & + (SB*x0+bogbot-SB/(2._r8*D))/(D*rho0j) + fs = -2._r8*D*exp(-2._r8*D*x0)*(wtwb-(bogbot-SB/(2._r8*D))/(D*rho0j)) + & + (SB)/(D*rho0j) + if( fs .ge. 0._r8 ) then + fs = max(fs, 1.e-10_r8) + else + fs = min(fs,-1.e-10_r8) + endif + x1 = x0 - f/fs + x0 = x1 + end do + + endif + + compute_ppen = -max(0._r8,min(dpen,x0)) + + end function compute_ppen + + subroutine fluxbelowinv(cbmf,ps0,mkx,kinv,dt,xsrc,xmean,xtopin,xbotin,xflx) + ! ------------------------------------------------------------------------- ! + ! Subroutine to calculate turbulent fluxes at and below 'kinv-1' interfaces.! + ! Check in the main program such that input 'cbmf' should not be zero. ! + ! If the reconstructed inversion height does not go down below the 'kinv-1' ! + ! interface, then turbulent flux at 'kinv-1' interface is simply a product ! + ! of 'cmbf' and 'qtsrc-xbot' where 'xbot' is the value at the top interface ! + ! of 'kinv-1' layer. This flux is linearly interpolated down to the surface ! + ! assuming turbulent fluxes at surface are zero. If reconstructed inversion ! + ! height goes down below the 'kinv-1' interface, subsidence warming &drying ! + ! measured by 'xtop-xbot', where 'xtop' is the value at the base interface ! + ! of 'kinv+1' layer, is added ONLY to the 'kinv-1' layer, using appropriate ! + ! mass weighting ( rpinv and rcbmf, or rr = rpinv / rcbmf ) between current ! + ! and next provisional time step. Also impose a limiter to enforce outliers ! + ! of thermodynamic variables in 'kinv' layer to come back to normal values ! + ! at the next step. ! + ! ------------------------------------------------------------------------- ! + integer, intent(in) :: mkx, kinv + real(r8), intent(in) :: cbmf, dt, xsrc, xmean, xtopin, xbotin + real(r8), intent(in), dimension(0:mkx) :: ps0 + real(r8), intent(out), dimension(0:mkx) :: xflx + integer k + real(r8) rcbmf, rpeff, dp, rr, pinv_eff, xtop, xbot, pinv, xtop_ori, xbot_ori + + xflx(0:mkx) = 0._r8 + dp = ps0(kinv-1) - ps0(kinv) + xbot = xbotin + xtop = xtopin + + ! -------------------------------------- ! + ! Compute reconstructed inversion height ! + ! -------------------------------------- ! + xtop_ori = xtop + xbot_ori = xbot + rcbmf = ( cbmf * g * dt ) / dp ! Can be larger than 1 : 'OK' + + if( xbot .ge. xtop ) then + rpeff = ( xmean - xtop ) / max( 1.e-20_r8, xbot - xtop ) + else + rpeff = ( xmean - xtop ) / min( -1.e-20_r8, xbot - xtop ) + endif + + rpeff = min( max(0._r8,rpeff), 1._r8 ) ! As of this, 0<= rpeff <= 1 + if( rpeff .eq. 0._r8 .or. rpeff .eq. 1._r8 ) then + xbot = xmean + xtop = xmean + endif + ! Below two commented-out lines are the old code replacing the above 'if' block. + ! if(rpeff.eq.1) xbot = xmean + ! if(rpeff.eq.0) xtop = xmean + rr = rpeff / rcbmf + pinv = ps0(kinv-1) - rpeff * dp ! "pinv" before detraining mass + pinv_eff = ps0(kinv-1) + ( rcbmf - rpeff ) * dp ! Effective "pinv" after detraining mass + ! ----------------------------------------------------------------------- ! + ! Compute turbulent fluxes. ! + ! Below two cases exactly converges at 'kinv-1' interface when rr = 1._r8 ! + ! ----------------------------------------------------------------------- ! + do k = 0, kinv - 1 + xflx(k) = cbmf * ( xsrc - xbot ) * ( ps0(0) - ps0(k) ) / ( ps0(0) - pinv ) + end do + if( rr .le. 1._r8 ) then + xflx(kinv-1) = xflx(kinv-1) - ( 1._r8 - rr ) * cbmf * ( xtop_ori - xbot_ori ) + endif + + return + end subroutine fluxbelowinv + + subroutine positive_moisture_single( xlv, xls, mkx, dt, qvmin, qlmin, qimin, dp, qv, ql, qi, s, qvten, qlten, qiten, sten ) + ! ------------------------------------------------------------------------------- ! + ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, ! + ! force them to be larger than minimum value by (1) condensating water vapor ! + ! into liquid or ice, and (2) by transporting water vapor from the very lower ! + ! layer. '2._r8' is multiplied to the minimum values for safety. ! + ! Update final state variables and tendencies associated with this correction. ! + ! If any condensation happens, update (s,t) too. ! + ! Note that (qv,ql,qi,s) are final state variables after applying corresponding ! + ! input tendencies and corrective tendencies ! + ! ------------------------------------------------------------------------------- ! + implicit none + integer, intent(in) :: mkx + real(r8), intent(in) :: xlv, xls + real(r8), intent(in) :: dt, qvmin, qlmin, qimin + real(r8), intent(in) :: dp(mkx) + real(r8), intent(inout) :: qv(mkx), ql(mkx), qi(mkx), s(mkx) + real(r8), intent(inout) :: qvten(mkx), qlten(mkx), qiten(mkx), sten(mkx) + integer k + real(r8) dql, dqi, dqv, sum, aa, dum + + do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface + dql = max(0._r8,1._r8*qlmin-ql(k)) + dqi = max(0._r8,1._r8*qimin-qi(k)) + qlten(k) = qlten(k) + dql/dt + qiten(k) = qiten(k) + dqi/dt + qvten(k) = qvten(k) - (dql+dqi)/dt + sten(k) = sten(k) + xlv * (dql/dt) + xls * (dqi/dt) + ql(k) = ql(k) + dql + qi(k) = qi(k) + dqi + qv(k) = qv(k) - dql - dqi + s(k) = s(k) + xlv * dql + xls * dqi + dqv = max(0._r8,1._r8*qvmin-qv(k)) + qvten(k) = qvten(k) + dqv/dt + qv(k) = qv(k) + dqv + if( k .ne. 1 ) then + qv(k-1) = qv(k-1) - dqv*dp(k)/dp(k-1) + qvten(k-1) = qvten(k-1) - dqv*dp(k)/dp(k-1)/dt + endif + qv(k) = max(qv(k),qvmin) + ql(k) = max(ql(k),qlmin) + qi(k) = max(qi(k),qimin) + end do + ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally + ! extracted from all the layers that has 'qv > 2*qvmin'. This fully + ! preserves column moisture. + if( dqv .gt. 1.e-20_r8 ) then + sum = 0._r8 + do k = 1, mkx + if( qv(k) .gt. 2._r8*qvmin ) sum = sum + qv(k)*dp(k) + enddo + aa = dqv*dp(1)/max(1.e-20_r8,sum) + if( aa .lt. 0.5_r8 ) then + do k = 1, mkx + if( qv(k) .gt. 2._r8*qvmin ) then + dum = aa*qv(k) + qv(k) = qv(k) - dum + qvten(k) = qvten(k) - dum/dt + endif + enddo + else + write(iulog,*) 'Full positive_moisture is impossible in uwshcu' + endif + endif + + return + end subroutine positive_moisture_single + + ! ------------------------ ! + ! ! + ! End of subroutine blocks ! + ! ! + ! ------------------------ ! + + end module uwshcu + diff --git a/src/physics/cam/vdiff_lu_solver.F90 b/src/physics/cam/vdiff_lu_solver.F90 new file mode 100644 index 0000000000..b482606007 --- /dev/null +++ b/src/physics/cam/vdiff_lu_solver.F90 @@ -0,0 +1,207 @@ +module vdiff_lu_solver + +! This module provides a function returning the matrix decomposition for +! an implicit finite volume solver for vertical diffusion. It accepts +! diffusion coefficients, time/grid spacing, and boundary condition +! objects, and returns a TriDiagDecomp object that can be used to diffuse +! an array for one time step with the "left_div" method. + +use coords_1d, only: Coords1D +use linear_1d_operators, only: TriDiagOp, operator(+), TriDiagDecomp + +implicit none +private +save + +! Public interfaces +public :: vd_lu_decomp +public :: fin_vol_lu_decomp + +! 8-byte real. +integer, parameter :: r8 = selected_real_kind(12) + +contains + +! ========================================================================! + +! Designed to solve the equation: +! dq/dt = c1 q'' + c2 q' + c q + +function vd_lu_decomp(dt, dp, coef_q, coef_q_d, coef_q_d2, upper_bndry, & + lower_bndry) result(decomp) + + use linear_1d_operators, only: & + identity_operator, & + diagonal_operator, & + first_derivative, & + second_derivative, & + BoundaryType + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + ! Time step. + real(r8), intent(in) :: dt + ! Grid spacing (deltas). + real(r8), USE_CONTIGUOUS intent(in) :: dp(:,:) + + ! Coefficients for q, q', and q''. + real(r8), USE_CONTIGUOUS intent(in), optional :: coef_q(:,:), & + coef_q_d(:,:), coef_q_d2(:,:) + + ! Boundary conditions (optional, default to 0 flux through boundary). + class(BoundaryType), target, intent(in), optional :: & + upper_bndry, lower_bndry + + ! Output decomposition. + type(TriDiagDecomp) :: decomp + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + ! Operator objects. + type(TriDiagOp) :: add_term + type(TriDiagOp) :: net_operator + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + if (present(coef_q)) then + net_operator = diagonal_operator(1._r8 - dt*coef_q) + else + net_operator = identity_operator(size(dp, 1), size(dp, 2) + 1) + end if + + if (present(coef_q_d)) then + add_term = first_derivative(dp, upper_bndry, lower_bndry) + call add_term%lmult_as_diag(-dt*coef_q_d) + call net_operator%add(add_term) + end if + + if (present(coef_q_d2)) then + add_term = second_derivative(dp, upper_bndry, lower_bndry) + call add_term%lmult_as_diag(-dt*coef_q_d2) + call net_operator%add(add_term) + end if + + decomp = TriDiagDecomp(net_operator) + + call net_operator%finalize() + call add_term%finalize() + +end function vd_lu_decomp + +! ========================================================================! + +! Designed to solve the equation: +! +! w * dq/dt = d/dp (D q' - v q) + c q +! +! where q is a grid-cell average, and p is the vertical coordinate +! (presumably pressure). +! +! In this function, coef_q_weight == w, coef_q_diff == D, +! coef_q_adv == v, and coef_q == c. All these are optional; omitting a +! coefficient is equivalent to setting the entire array to 0. +! +! coef_q_diff and coef_q_adv are defined at the level interfaces, while +! coef_q and coef_q_weight are grid-cell averages. + +function fin_vol_lu_decomp(dt, p, coef_q, coef_q_diff, coef_q_adv, & + coef_q_weight, upper_bndry, lower_bndry, graft_decomp) result(decomp) + + use linear_1d_operators, only: & + zero_operator, & + diagonal_operator, & + diffusion_operator, & + advection_operator, & + BoundaryType + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + ! Time step. + real(r8), intent(in) :: dt + ! Grid spacings. + type(Coords1D), intent(in) :: p + + ! Coefficients for diffusion and advection. + ! + ! The sizes must be consistent among all the coefficients that are + ! actually present, i.e. coef_q_diff and coef_q_adv should be one level + ! bigger than coef_q and coef_q_weight, and have the same column number. + real(r8), USE_CONTIGUOUS intent(in), optional :: coef_q(:,:), & + coef_q_diff(:,:), coef_q_adv(:,:), coef_q_weight(:,:) + + ! Boundary conditions (optional, default to 0 flux through boundary). + class(BoundaryType), target, intent(in), optional :: & + upper_bndry, lower_bndry + + ! Decomposition to graft onto. If this is provided, you can pass in + ! smaller coefficients. + type(TriDiagDecomp), intent(in), optional :: graft_decomp + + ! Output decomposition. + type(TriDiagDecomp) :: decomp + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + ! Operator objects. + type(TriDiagOp) :: add_term + type(TriDiagOp) :: net_operator + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + ! A diffusion term is probably present, so start with that. Otherwise + ! start with an operator of all 0s. + + if (present(coef_q_diff)) then + net_operator = diffusion_operator(p, coef_q_diff, & + upper_bndry, lower_bndry) + else + net_operator = zero_operator(p%n, p%d) + end if + + ! Constant term (damping). + if (present(coef_q)) then + add_term = diagonal_operator(coef_q) + call net_operator%add(add_term) + end if + + ! Effective advection. + if (present(coef_q_adv)) then + add_term = advection_operator(p, coef_q_adv, & + upper_bndry, lower_bndry) + call net_operator%add(add_term) + end if + + ! We want I-dt*(w^-1)*A for a single time step, implicit method, where + ! A is the right-hand-side operator (i.e. what net_operator is now). + if (present(coef_q_weight)) then + call net_operator%lmult_as_diag(-dt/coef_q_weight) + else + call net_operator%lmult_as_diag(-dt) + end if + call net_operator%add_to_diag(1._r8) + + ! Decompose, grafting on an optional input decomp. The graft is a way to + ! avoid re-calculating the ending (bottom) levels when the coefficients + ! have only changed at the beginning (top), e.g. for different + ! constituents in the molecular diffusion. + decomp = TriDiagDecomp(net_operator, graft_decomp=graft_decomp) + + ! Ensure local objects are deallocated. + call net_operator%finalize() + call add_term%finalize() + +end function fin_vol_lu_decomp + +end module vdiff_lu_solver diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 new file mode 100644 index 0000000000..d74a16a512 --- /dev/null +++ b/src/physics/cam/vertical_diffusion.F90 @@ -0,0 +1,1540 @@ +module vertical_diffusion + +!----------------------------------------------------------------------------------------------------- ! +! Module to compute vertical diffusion of momentum, moisture, trace constituents ! +! and static energy. Separate modules compute ! +! 1. stresses associated with turbulent flow over orography ! +! ( turbulent mountain stress ) ! +! 2. eddy diffusivities, including nonlocal tranport terms ! +! 3. molecular diffusivities ! +! Lastly, a implicit diffusion solver is called, and tendencies retrieved by ! +! differencing the diffused and initial states. ! +! ! +! Calling sequence: ! +! ! +! vertical_diffusion_init Initializes vertical diffustion constants and modules ! +! init_molec_diff Initializes molecular diffusivity module ! +! init_eddy_diff Initializes eddy diffusivity module (includes PBL) ! +! init_tms Initializes turbulent mountain stress module ! +! init_vdiff Initializes diffusion solver module ! +! vertical_diffusion_ts_init Time step initialization (only used for upper boundary condition) ! +! vertical_diffusion_tend Computes vertical diffusion tendencies ! +! compute_tms Computes turbulent mountain stresses ! +! compute_eddy_diff Computes eddy diffusivities and countergradient terms ! +! compute_vdiff Solves vertical diffusion equations, including molecular diffusivities ! +! ! +!----------------------------------------------------------------------------------------------------- ! +! Some notes on refactoring changes made in 2015, which were not quite finished. ! +! ! +! - eddy_diff_tend should really only have state, pbuf, and cam_in as inputs. The process of ! +! removing these arguments, and referring to pbuf fields instead, is not complete. ! +! ! +! - compute_vdiff was intended to be split up into three components: ! +! ! +! 1. Diffusion of winds and heat ("U", "V", and "S" in the fieldlist object). ! +! ! +! 2. Turbulent diffusion of a single constituent ! +! ! +! 3. Molecular diffusion of a single constituent ! +! ! +! This reorganization would allow the three resulting functions to each use a simpler interface ! +! than the current combined version, and possibly also remove the need to use the fieldlist ! +! object at all. ! +! ! +! - The conditionals controlled by "do_pbl_diags" are somewhat scattered. It might be better to ! +! pull out these diagnostic calculations and outfld calls into separate functions. ! +! ! +!---------------------------Code history-------------------------------------------------------------- ! +! J. Rosinski : Jun. 1992 ! +! J. McCaa : Sep. 2004 ! +! S. Park : Aug. 2006, Dec. 2008. Jan. 2010 ! +!----------------------------------------------------------------------------------------------------- ! + +use shr_kind_mod, only : r8 => shr_kind_r8, i4=> shr_kind_i4 +use ppgrid, only : pcols, pver, pverp +use constituents, only : pcnst +use diffusion_solver, only : vdiff_selector +use cam_abortutils, only : endrun +use error_messages, only : handle_errmsg +use physconst, only : & + cpair , & ! Specific heat of dry air + gravit , & ! Acceleration due to gravity + rair , & ! Gas constant for dry air + zvir , & ! rh2o/rair - 1 + latvap , & ! Latent heat of vaporization + latice , & ! Latent heat of fusion + karman , & ! von Karman constant + mwdry , & ! Molecular weight of dry air + avogad ! Avogadro's number +use cam_history, only : fieldname_len +use perf_mod +use cam_logfile, only : iulog +use ref_pres, only : do_molec_diff, nbot_molec +use phys_control, only : phys_getopts +use time_manager, only : is_first_step + +implicit none +private +save + +! ----------------- ! +! Public interfaces ! +! ----------------- ! + +public vd_readnl +public vd_register ! Register multi-time-level variables with physics buffer +public vertical_diffusion_init ! Initialization +public vertical_diffusion_ts_init ! Time step initialization (only used for upper boundary condition) +public vertical_diffusion_tend ! Full vertical diffusion routine + +! ------------ ! +! Private data ! +! ------------ ! + +character(len=16) :: eddy_scheme ! Default set in phys_control.F90, use namelist to change +! 'HB' = Holtslag and Boville (default) +! 'HBR' = Holtslag and Boville and Rash +! 'diag_TKE' = Bretherton and Park ( UW Moist Turbulence Scheme ) +logical, parameter :: wstarent = .true. ! Use wstar (.true.) or TKE (.false.) entrainment closure +! ( when 'diag_TKE' scheme is selected ) +logical :: do_pseudocon_diff = .false. ! If .true., do pseudo-conservative variables diffusion + +character(len=16) :: shallow_scheme ! Shallow convection scheme + +type(vdiff_selector) :: fieldlist_wet ! Logical switches for moist mixing ratio diffusion +type(vdiff_selector) :: fieldlist_dry ! Logical switches for dry mixing ratio diffusion +type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion +integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer +integer :: kvt_idx ! Index for kinematic molecular conductivity +integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions +integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress + +character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies +integer :: ixcldice, ixcldliq ! Constituent indices for cloud liquid and ice water +integer :: ixnumice, ixnumliq + +integer :: pblh_idx, tpert_idx, qpert_idx + +! pbuf fields for unicon +integer :: qtl_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on +integer :: qti_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on + +! pbuf fields for tms +integer :: ksrftms_idx = -1 +integer :: tautmsx_idx = -1 +integer :: tautmsy_idx = -1 + +! pbuf fields for blj (Beljaars) +integer :: dragblj_idx = -1 +integer :: taubljx_idx = -1 +integer :: taubljy_idx = -1 + +logical :: diff_cnsrv_mass_check ! do mass conservation check +logical :: do_iss ! switch for implicit turbulent surface stress +logical :: prog_modal_aero = .false. ! set true if prognostic modal aerosols are present +integer :: pmam_ncnst = 0 ! number of prognostic modal aerosol constituents +integer, allocatable :: pmam_cnst_idx(:) ! constituent indices of prognostic modal aerosols + +logical :: do_pbl_diags = .false. +logical :: waccmx_mode = .false. + +contains + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! +subroutine vd_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, masterprocid, mpi_logical, mpicom + use shr_log_mod, only: errMsg => shr_log_errMsg + use trb_mtn_stress_cam, only: trb_mtn_stress_readnl + use beljaars_drag_cam, only: beljaars_drag_readnl + use eddy_diff_cam, only: eddy_diff_readnl + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'vd_readnl' + + namelist /vert_diff_nl/ diff_cnsrv_mass_check, do_iss + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'vert_diff_nl', status=ierr) + if (ierr == 0) then + read(unitn, vert_diff_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(diff_cnsrv_mass_check, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + call mpi_bcast(do_iss, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error") + + ! Get eddy_scheme setting from phys_control. + call phys_getopts( eddy_scheme_out = eddy_scheme, & + shallow_scheme_out = shallow_scheme ) + + ! TMS reads its own namelist. + call trb_mtn_stress_readnl(nlfile) + + ! Beljaars reads its own namelist. + call beljaars_drag_readnl(nlfile) + + if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005' ) call eddy_diff_readnl(nlfile) + +end subroutine vd_readnl + +! =============================================================================== ! +! ! +! =============================================================================== ! + +subroutine vd_register() + + !------------------------------------------------ ! + ! Register physics buffer fields and constituents ! + !------------------------------------------------ ! + + use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4 + use trb_mtn_stress_cam, only : trb_mtn_stress_register + use beljaars_drag_cam, only : beljaars_drag_register + use eddy_diff_cam, only : eddy_diff_register + + ! Add fields to physics buffer + + ! kvt is used by gw_drag. only needs physpkg scope. + call pbuf_add_field('kvt', 'physpkg', dtype_r8, (/pcols,pverp/), kvt_idx) + + + if (eddy_scheme /= 'CLUBB_SGS') then + call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) + end if + + call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx ) + call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) + call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) + call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx) + call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx) + + call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx) + call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx) + + call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) + call pbuf_add_field('qpert', 'global', dtype_r8, (/pcols,pcnst/), qpert_idx) + + if (trim(shallow_scheme) == 'UNICON') then + call pbuf_add_field('qtl_flx', 'global', dtype_r8, (/pcols, pverp/), qtl_flx_idx) + call pbuf_add_field('qti_flx', 'global', dtype_r8, (/pcols, pverp/), qti_flx_idx) + end if + + ! diag_TKE fields + if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005') then + call eddy_diff_register() + end if + + ! TMS fields + call trb_mtn_stress_register() + + ! Beljaars fields + call beljaars_drag_register() + +end subroutine vd_register + +! =============================================================================== ! +! ! +! =============================================================================== ! + +subroutine vertical_diffusion_init(pbuf2d) + + !------------------------------------------------------------------! + ! Initialization of time independent fields for vertical diffusion ! + ! Calls initialization routines for subsidiary modules ! + !----------------------------------------------------------------- ! + + use cam_history, only : addfld, add_default, horiz_only + use cam_history, only : register_vector_field + use eddy_diff_cam, only : eddy_diff_init + use hb_diff, only : init_hb_diff + use molec_diff, only : init_molec_diff + use diffusion_solver, only : init_vdiff, new_fieldlist_vdiff, vdiff_select + use constituents, only : cnst_get_ind, cnst_get_type_byind, cnst_name, cnst_get_molec_byind + use spmd_utils, only : masterproc + use ref_pres, only : press_lim_idx, pref_mid + use physics_buffer, only : pbuf_set_field, pbuf_get_index, physics_buffer_desc + use rad_constituents, only : rad_cnst_get_info, rad_cnst_get_mode_num_idx, & + rad_cnst_get_mam_mmr_idx + use trb_mtn_stress_cam,only : trb_mtn_stress_init + use beljaars_drag_cam, only : beljaars_drag_init + use upper_bc, only : ubc_init + use phys_control, only : waccmx_is, fv_am_correction + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + character(128) :: errstring ! Error status for init_vdiff + integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 ) + integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) + integer :: k ! Vertical loop index + + real(r8), parameter :: ntop_eddy_pres = 1.e-5_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa) + + integer :: im, l, m, nmodes, nspec + + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_eddy ! output the eddy variables + logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi + integer :: history_budget_histfile_num ! output history file number for budget fields + logical :: history_waccm ! output variables of interest for WACCM runs + + ! ----------------------------------------------------------------- ! + + if (masterproc) then + write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' + end if + + ! Check to see if WACCM-X is on (currently we don't care whether the + ! ionosphere is on or not, since this neutral diffusion code is the + ! same either way). + waccmx_mode = waccmx_is('ionosphere') .or. waccmx_is('neutral') + + ! ----------------------------------------------------------------- ! + ! Get indices of cloud liquid and ice within the constituents array ! + ! ----------------------------------------------------------------- ! + + call cnst_get_ind( 'CLDLIQ', ixcldliq ) + call cnst_get_ind( 'CLDICE', ixcldice ) + ! These are optional; with the CAM4 microphysics, there are no number + ! constituents. + call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. ) + call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. ) + + ! prog_modal_aero determines whether prognostic modal aerosols are present in the run. + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + if (prog_modal_aero) then + + ! Get the constituent indices of the number and mass mixing ratios of the modal + ! aerosols. + ! + ! N.B. - This implementation assumes that the prognostic modal aerosols are + ! impacting the climate calculation (i.e., can get info from list 0). + ! + + ! First need total number of mam constituents + call rad_cnst_get_info(0, nmodes=nmodes) + do m = 1, nmodes + call rad_cnst_get_info(0, m, nspec=nspec) + pmam_ncnst = pmam_ncnst + 1 + nspec + end do + + allocate(pmam_cnst_idx(pmam_ncnst)) + + ! Get the constituent indicies + im = 1 + do m = 1, nmodes + call rad_cnst_get_mode_num_idx(m, pmam_cnst_idx(im)) + im = im + 1 + call rad_cnst_get_info(0, m, nspec=nspec) + do l = 1, nspec + call rad_cnst_get_mam_mmr_idx(m, l, pmam_cnst_idx(im)) + im = im + 1 + end do + end do + end if + + ! Initialize upper boundary condition module + + call ubc_init() + + ! ---------------------------------------------------------------------------------------- ! + ! Initialize molecular diffusivity module ! + ! Note that computing molecular diffusivities is a trivial expense, but constituent ! + ! diffusivities depend on their molecular weights. Decomposing the diffusion matrix ! + ! for each constituent is a needless expense unless the diffusivity is significant. ! + ! ---------------------------------------------------------------------------------------- ! + + !---------------------------------------------------------------------------------------- + ! Initialize molecular diffusion and get top and bottom molecular diffusion limits + !---------------------------------------------------------------------------------------- + + if( do_molec_diff ) then + call init_molec_diff( r8, pcnst, mwdry, avogad, & + errstring) + + call handle_errmsg(errstring, subname="init_molec_diff") + + call addfld( 'TTPXMLC', horiz_only, 'A', 'K/S', 'Top interf. temp. flux: molec. viscosity' ) + if( masterproc ) write(iulog,fmt='(a,i3,5x,a,i3)') 'NBOT_MOLEC =', nbot_molec + end if + + ! ---------------------------------- ! + ! Initialize eddy diffusivity module ! + ! ---------------------------------- ! + + ! ntop_eddy must be 1 or <= nbot_molec + ! Currently, it is always 1 except for WACCM-X. + if ( waccmx_mode ) then + ntop_eddy = press_lim_idx(ntop_eddy_pres, top=.true.) + else + ntop_eddy = 1 + end if + nbot_eddy = pver + + if (masterproc) write(iulog, fmt='(a,i3,5x,a,i3)') 'NTOP_EDDY =', ntop_eddy, 'NBOT_EDDY =', nbot_eddy + + select case ( eddy_scheme ) + case ( 'diag_TKE', 'SPCAM_m2005' ) + if( masterproc ) write(iulog,*) & + 'vertical_diffusion_init: eddy_diffusivity scheme: UW Moist Turbulence Scheme by Bretherton and Park' + call eddy_diff_init(pbuf2d, ntop_eddy, nbot_eddy) + case ( 'HB', 'HBR', 'SPCAM_sam1mom') + if( masterproc ) write(iulog,*) 'vertical_diffusion_init: eddy_diffusivity scheme: Holtslag and Boville' + call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, & + karman, eddy_scheme) + call addfld('HB_ri', (/ 'lev' /), 'A', 'no', 'Richardson Number (HB Scheme), I' ) + case ( 'CLUBB_SGS' ) + do_pbl_diags = .true. + end select + + ! ------------------------------------------- ! + ! Initialize turbulent mountain stress module ! + ! ------------------------------------------- ! + + call trb_mtn_stress_init() + + ! ----------------------------------- ! + ! Initialize Beljaars SGO drag module ! + ! ----------------------------------- ! + + call beljaars_drag_init() + + ! ---------------------------------- ! + ! Initialize diffusion solver module ! + ! ---------------------------------- ! + + call init_vdiff(r8, iulog, rair, cpair, gravit, do_iss, fv_am_correction, errstring) + call handle_errmsg(errstring, subname="init_vdiff") + + ! Use fieldlist_wet to select the fields which will be diffused using moist mixing ratios ( all by default ) + ! Use fieldlist_dry to select the fields which will be diffused using dry mixing ratios. + + fieldlist_wet = new_fieldlist_vdiff( pcnst) + fieldlist_dry = new_fieldlist_vdiff( pcnst) + fieldlist_molec = new_fieldlist_vdiff( pcnst) + + if( vdiff_select( fieldlist_wet, 'u' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'u' ) ) + if( vdiff_select( fieldlist_wet, 'v' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'v' ) ) + if( vdiff_select( fieldlist_wet, 's' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 's' ) ) + + constit_loop: do k = 1, pcnst + + if (prog_modal_aero) then + ! Do not diffuse droplet number - treated in dropmixnuc + if (k == ixnumliq) cycle constit_loop + ! Don't diffuse modal aerosol - treated in dropmixnuc + do m = 1, pmam_ncnst + if (k == pmam_cnst_idx(m)) cycle constit_loop + enddo + end if + + if( cnst_get_type_byind(k) .eq. 'wet' ) then + if( vdiff_select( fieldlist_wet, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'q', k ) ) + else + if( vdiff_select( fieldlist_dry, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_dry, 'q', k ) ) + endif + + ! ----------------------------------------------- ! + ! Select constituents for molecular diffusion ! + ! ----------------------------------------------- ! + if ( cnst_get_molec_byind(k) .eq. 'minor' ) then + if( vdiff_select(fieldlist_molec,'q',k) .ne. '' ) call endrun( vdiff_select( fieldlist_molec,'q',k ) ) + endif + + end do constit_loop + + ! ------------------------ ! + ! Diagnostic output fields ! + ! ------------------------ ! + + do k = 1, pcnst + vdiffnam(k) = 'VD'//cnst_name(k) + if( k == 1 ) vdiffnam(k) = 'VD01' !**** compatibility with old code **** + call addfld( vdiffnam(k), (/ 'lev' /), 'A', 'kg/kg/s', 'Vertical diffusion of '//cnst_name(k) ) + end do + + if (.not. do_pbl_diags) then + call addfld( 'PBLH' , horiz_only , 'A', 'm' , 'PBL height' ) + call addfld( 'QT' , (/ 'lev' /) , 'A', 'kg/kg' , 'Total water mixing ratio' ) + call addfld( 'SL' , (/ 'lev' /) , 'A', 'J/kg' , 'Liquid water static energy' ) + call addfld( 'SLV' , (/ 'lev' /) , 'A', 'J/kg' , 'Liq wat virtual static energy' ) + call addfld( 'SLFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Liquid static energy flux' ) + call addfld( 'QTFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Total water flux' ) + call addfld( 'TKE' , (/ 'ilev' /) , 'A', 'm2/s2' , 'Turbulent Kinetic Energy' ) + call addfld( 'TPERT' , horiz_only , 'A', 'K' , 'Perturbation temperature (eddies in PBL)' ) + call addfld( 'QPERT' , horiz_only , 'A', 'kg/kg' , 'Perturbation specific humidity (eddies in PBL)' ) + + call addfld( 'UFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Zonal momentum flux' ) + call addfld( 'VFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Meridional momentm flux' ) + call register_vector_field('UFLX', 'VFLX') + end if + + call addfld( 'USTAR' , horiz_only , 'A', 'm/s' , 'Surface friction velocity' ) + call addfld( 'KVH' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (heat/moisture)' ) + call addfld( 'KVM' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (momentum)' ) + call addfld( 'KVT' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion kinematic molecular conductivity') + call addfld( 'CGS' , (/ 'ilev' /) , 'A', 's/m2' , 'Counter-gradient coeff on surface kinematic fluxes' ) + call addfld( 'DTVKE' , (/ 'lev' /) , 'A', 'K/s' , 'dT/dt vertical diffusion KE dissipation' ) + call addfld( 'DTV' , (/ 'lev' /) , 'A', 'K/s' , 'T vertical diffusion' ) + call addfld( 'DUV' , (/ 'lev' /) , 'A', 'm/s2' , 'U vertical diffusion' ) + call addfld( 'DVV' , (/ 'lev' /) , 'A', 'm/s2' , 'V vertical diffusion' ) + + ! ---------------------------------------------------------------------------- ! + ! Below ( with '_PBL') are for detailed analysis of UW Moist Turbulence Scheme ! + ! ---------------------------------------------------------------------------- ! + + if (.not. do_pbl_diags) then + + call addfld( 'qt_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_prePBL' ) + call addfld( 'sl_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_prePBL' ) + call addfld( 'slv_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_prePBL' ) + call addfld( 'u_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_prePBL' ) + call addfld( 'v_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_prePBL' ) + call addfld( 'qv_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_prePBL' ) + call addfld( 'ql_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_prePBL' ) + call addfld( 'qi_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_prePBL' ) + call addfld( 't_pre_PBL', (/ 'lev' /) , 'A', 'K' , 't_prePBL' ) + call addfld( 'rh_pre_PBL', (/ 'lev' /) , 'A', '%' , 'rh_prePBL' ) + + call addfld( 'qt_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_afterPBL' ) + call addfld( 'sl_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_afterPBL' ) + call addfld( 'slv_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_afterPBL' ) + call addfld( 'u_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_afterPBL' ) + call addfld( 'v_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_afterPBL' ) + call addfld( 'qv_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_afterPBL' ) + call addfld( 'ql_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_afterPBL' ) + call addfld( 'qi_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_afterPBL' ) + call addfld( 't_aft_PBL', (/ 'lev' /) , 'A', 'K' , 't_afterPBL' ) + call addfld( 'rh_aft_PBL', (/ 'lev' /) , 'A', '%' , 'rh_afterPBL' ) + + call addfld( 'slflx_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl flux by PBL' ) + call addfld( 'qtflx_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt flux by PBL' ) + call addfld( 'uflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u flux by PBL' ) + call addfld( 'vflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v flux by PBL' ) + + call addfld( 'slflx_cg_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl_cg flux by PBL' ) + call addfld( 'qtflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt_cg flux by PBL' ) + call addfld( 'uflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u_cg flux by PBL' ) + call addfld( 'vflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v_cg flux by PBL' ) + + call addfld( 'qtten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qt tendency by PBL' ) + call addfld( 'slten_PBL', (/ 'lev' /) , 'A', 'J/kg/s' , 'sl tendency by PBL' ) + call addfld( 'uten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'u tendency by PBL' ) + call addfld( 'vten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'v tendency by PBL' ) + call addfld( 'qvten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qv tendency by PBL' ) + call addfld( 'qlten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'ql tendency by PBL' ) + call addfld( 'qiten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qi tendency by PBL' ) + call addfld( 'tten_PBL', (/ 'lev' /) , 'A', 'K/s' , 'T tendency by PBL' ) + call addfld( 'rhten_PBL', (/ 'lev' /) , 'A', '%/s' , 'RH tendency by PBL' ) + + end if + + call addfld ('ustar',horiz_only, 'A', ' ',' ') + call addfld ('obklen',horiz_only, 'A', ' ',' ') + + ! ---------------------------- + ! determine default variables + ! ---------------------------- + + call phys_getopts( history_amwg_out = history_amwg, & + history_eddy_out = history_eddy, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_waccm_out = history_waccm) + + if (history_amwg) then + call add_default( vdiffnam(1), 1, ' ' ) + call add_default( 'DTV' , 1, ' ' ) + if (.not. do_pbl_diags) then + call add_default( 'PBLH' , 1, ' ' ) + end if + endif + + if (history_eddy) then + call add_default( 'UFLX ', 1, ' ' ) + call add_default( 'VFLX ', 1, ' ' ) + endif + + if( history_budget ) then + call add_default( vdiffnam(ixcldliq), history_budget_histfile_num, ' ' ) + call add_default( vdiffnam(ixcldice), history_budget_histfile_num, ' ' ) + if( history_budget_histfile_num > 1 ) then + call add_default( vdiffnam(1), history_budget_histfile_num, ' ' ) + call add_default( 'DTV' , history_budget_histfile_num, ' ' ) + end if + end if + + if ( history_waccm ) then + if (do_molec_diff) then + call add_default ( 'TTPXMLC', 1, ' ' ) + end if + call add_default( 'DUV' , 1, ' ' ) + call add_default( 'DVV' , 1, ' ' ) + end if + ! ---------------------------- + + + ksrftms_idx = pbuf_get_index('ksrftms') + tautmsx_idx = pbuf_get_index('tautmsx') + tautmsy_idx = pbuf_get_index('tautmsy') + + dragblj_idx = pbuf_get_index('dragblj') + taubljx_idx = pbuf_get_index('taubljx') + taubljy_idx = pbuf_get_index('taubljy') + + if (eddy_scheme == 'CLUBB_SGS') then + kvh_idx = pbuf_get_index('kvh') + end if + + ! Initialization of some pbuf fields + if (is_first_step()) then + ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat + call pbuf_set_field(pbuf2d, turbtype_idx, 0 ) + call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8) + if (trim(shallow_scheme) == 'UNICON') then + call pbuf_set_field(pbuf2d, qtl_flx_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8) + end if + end if + +end subroutine vertical_diffusion_init + +! =============================================================================== ! +! ! +! =============================================================================== ! + +subroutine vertical_diffusion_ts_init( pbuf2d, state ) + + !-------------------------------------------------------------- ! + ! Timestep dependent setting, ! + ! At present only invokes upper bc code ! + !-------------------------------------------------------------- ! + use upper_bc, only : ubc_timestep_init + use physics_types , only : physics_state + use ppgrid , only : begchunk, endchunk + + use physics_buffer, only : physics_buffer_desc + + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + call ubc_timestep_init( pbuf2d, state) + +end subroutine vertical_diffusion_ts_init + +! =============================================================================== ! +! ! +! =============================================================================== ! + +subroutine vertical_diffusion_tend( & + ztodt , state , cam_in, & + ustar , obklen , ptend , & + cldn , pbuf) + !---------------------------------------------------- ! + ! This is an interface routine for vertical diffusion ! + !---------------------------------------------------- ! + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field + use physics_types, only : physics_state, physics_ptend, physics_ptend_init + use camsrfexch, only : cam_in_t + use cam_history, only : outfld + + use trb_mtn_stress_cam, only : trb_mtn_stress_tend + use beljaars_drag_cam, only : beljaars_drag_tend + use eddy_diff_cam, only : eddy_diff_tend + use hb_diff, only : compute_hb_diff + use wv_saturation, only : qsat + use molec_diff, only : compute_molec_diff, vd_lu_qdecomp + use constituents, only : qmincg, qmin + use diffusion_solver, only : compute_vdiff, any, operator(.not.) + use physconst, only : cpairv, rairv !Needed for calculation of upward H flux + use time_manager, only : get_nstep + use constituents, only : cnst_get_type_byind, cnst_name, & + cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx + use physconst, only : pi + use pbl_utils, only : virtem, calc_obklen, calc_ustar + use upper_bc, only : ubc_get_vals + use coords_1d, only : Coords1D + + ! --------------- ! + ! Input Arguments ! + ! --------------- ! + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in ! Surface inputs + + real(r8), intent(in) :: ztodt ! 2 delta-t [ s ] + real(r8), intent(in) :: cldn(pcols,pver) ! New stratus fraction [ fraction ] + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + + type(physics_ptend), intent(out) :: ptend ! Individual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + ! ---------------- ! + ! Output Arguments ! + ! ---------------- ! + + real(r8), intent(out) :: ustar(pcols) ! Surface friction velocity [ m/s ] + real(r8), intent(out) :: obklen(pcols) ! Obukhov length [ m ] + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + character(128) :: errstring ! Error status for compute_vdiff + + integer :: lchnk ! Chunk identifier + integer :: ncol ! Number of atmospheric columns + integer :: i, k, l, m ! column, level, constituent indices + + real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation + real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ] + integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ] + real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function + ! ( 0<= <=4.964 and 1 at neutral ) + + real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql + real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi + + real(r8) :: cgs(pcols,pverp) ! Counter-gradient star [ cg/flux ] + real(r8) :: cgh(pcols,pverp) ! Counter-gradient term for heat + real(r8) :: rztodt ! 1./ztodt [ 1/s ] + real(r8), pointer :: ksrftms(:) ! Turbulent mountain stress surface drag coefficient [ kg/s/m2 ] + real(r8), pointer :: tautmsx(:) ! U component of turbulent mountain stress [ N/m2 ] + real(r8), pointer :: tautmsy(:) ! V component of turbulent mountain stress [ N/m2 ] + real(r8) :: tautotx(pcols) ! U component of total surface stress [ N/m2 ] + real(r8) :: tautoty(pcols) ! V component of total surface stress [ N/m2 ] + + real(r8), pointer :: dragblj(:,:) ! Beljaars SGO form drag profile [ 1/s ] + real(r8), pointer :: taubljx(:) ! U component of turbulent mountain stress [ N/m2 ] + real(r8), pointer :: taubljy(:) ! V component of turbulent mountain stress [ N/m2 ] + + real(r8), pointer :: kvh_in(:,:) ! kvh from previous timestep [ m2/s ] + real(r8), pointer :: kvm_in(:,:) ! kvm from previous timestep [ m2/s ] + real(r8), pointer :: kvt(:,:) ! Molecular kinematic conductivity for temperature [ ] + real(r8) :: kvq(pcols,pverp) ! Eddy diffusivity for constituents [ m2/s ] + real(r8) :: kvh(pcols,pverp) ! Eddy diffusivity for heat [ m2/s ] + real(r8) :: kvm(pcols,pverp) ! Eddy diffusivity for momentum [ m2/s ] + real(r8) :: kvm_temp(pcols,pverp) ! Dummy eddy diffusivity for momentum (unused) [ m2/s ] + real(r8) :: dtk_temp(pcols,pverp) ! Unused output from second compute_vdiff call + real(r8) :: tautmsx_temp(pcols) ! Unused output from second compute_vdiff call + real(r8) :: tautmsy_temp(pcols) ! Unused output from second compute_vdiff call + real(r8) :: topflx_temp(pcols) ! Unused output from second compute_vdiff call + real(r8) :: sprod(pcols,pverp) ! Shear production of tke [ m2/s3 ] + real(r8) :: sfi(pcols,pverp) ! Saturation fraction at interfaces [ fraction ] + real(r8) :: sl(pcols,pver) + real(r8) :: qt(pcols,pver) + real(r8) :: slv(pcols,pver) + real(r8) :: sl_prePBL(pcols,pver) + real(r8) :: qt_prePBL(pcols,pver) + real(r8) :: slv_prePBL(pcols,pver) + real(r8) :: slten(pcols,pver) + real(r8) :: qtten(pcols,pver) + real(r8) :: slflx(pcols,pverp) + real(r8) :: qtflx(pcols,pverp) + real(r8) :: uflx(pcols,pverp) + real(r8) :: vflx(pcols,pverp) + real(r8) :: slflx_cg(pcols,pverp) + real(r8) :: qtflx_cg(pcols,pverp) + real(r8) :: uflx_cg(pcols,pverp) + real(r8) :: vflx_cg(pcols,pverp) + real(r8) :: th(pcols,pver) ! Potential temperature + real(r8) :: topflx(pcols) ! Molecular heat flux at top interface + real(r8) :: rhoair + + real(r8) :: ri(pcols,pver) ! richardson number (HB output) + + ! for obklen calculation outside HB + real(r8) :: thvs(pcols) ! Virtual potential temperature at surface + real(r8) :: rrho(pcols) ! Reciprocal of density at surface + real(r8) :: khfs(pcols) ! sfc kinematic heat flux [mK/s] + real(r8) :: kqfs(pcols) ! sfc kinematic water vapor flux [m/s] + real(r8) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3] + + real(r8) :: ftem(pcols,pver) ! Saturation vapor pressure before PBL + real(r8) :: ftem_prePBL(pcols,pver) ! Saturation vapor pressure before PBL + real(r8) :: ftem_aftPBL(pcols,pver) ! Saturation vapor pressure after PBL + real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH + real(r8) :: t_aftPBL(pcols,pver) ! Temperature after PBL diffusion + real(r8) :: tten(pcols,pver) ! Temperature tendency by PBL diffusion + real(r8) :: rhten(pcols,pver) ! RH tendency by PBL diffusion + real(r8) :: qv_aft_PBL(pcols,pver) ! qv after PBL diffusion + real(r8) :: ql_aft_PBL(pcols,pver) ! ql after PBL diffusion + real(r8) :: qi_aft_PBL(pcols,pver) ! qi after PBL diffusion + real(r8) :: s_aft_PBL(pcols,pver) ! s after PBL diffusion + real(r8) :: u_aft_PBL(pcols,pver) ! u after PBL diffusion + real(r8) :: v_aft_PBL(pcols,pver) ! v after PBL diffusion + real(r8) :: qv_pro(pcols,pver) + real(r8) :: ql_pro(pcols,pver) + real(r8) :: qi_pro(pcols,pver) + real(r8) :: s_pro(pcols,pver) + real(r8) :: t_pro(pcols,pver) + real(r8), pointer :: tauresx(:) ! Residual stress to be added in vdiff to correct + real(r8), pointer :: tauresy(:) ! for turb stress mismatch between sfc and atm accumulated. + + ! Interpolated interface values. + real(r8) :: tint(pcols,pver+1) ! Temperature [ K ] + real(r8) :: rairi(pcols,pver+1) ! Gas constant [ J/K/kg ] + real(r8) :: rhoi(pcols,pver+1) ! Density of air [ kg/m^3 ] + real(r8) :: rhoi_dry(pcols,pver+1) ! Density of air based on dry air pressure [ kg/m^3 ] + + ! Upper boundary conditions + real(r8) :: ubc_t(pcols) ! Temperature [ K ] + real(r8) :: ubc_mmr(pcols,pcnst) ! Mixing ratios [ kg/kg ] + real(r8) :: ubc_flux(pcols,pcnst) ! Constituent upper boundary flux (kg/s/m^2) + + ! Pressure coordinates used by the solver. + type(Coords1D) :: p + type(Coords1D) :: p_dry + + real(r8), pointer :: tpert(:) + real(r8), pointer :: qpert(:) + real(r8), pointer :: pblh(:) + + real(r8) :: tmp1(pcols) ! Temporary storage + + integer :: nstep + real(r8) :: sum1, sum2, sum3, pdelx + real(r8) :: sflx + + ! Copy state so we can pass to intent(inout) routines that return + ! new state instead of a tendency. + real(r8) :: s_tmp(pcols,pver) + real(r8) :: u_tmp(pcols,pver) + real(r8) :: v_tmp(pcols,pver) + real(r8) :: q_tmp(pcols,pver,pcnst) + + ! kq_fac*sqrt(T)*m_d/rho for molecular diffusivity + real(r8) :: kq_scal(pcols,pver+1) + ! composition dependent mw_fac on interface level + real(r8) :: mw_fac(pcols,pver+1,pcnst) + + ! Dry static energy top boundary condition. + real(r8) :: dse_top(pcols) + + ! Copies of flux arrays used to zero out any parts that are applied + ! elsewhere (e.g. by CLUBB). + real(r8) :: taux(pcols) + real(r8) :: tauy(pcols) + real(r8) :: shflux(pcols) + real(r8) :: cflux(pcols,pcnst) + + logical :: lq(pcnst) + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + rztodt = 1._r8 / ztodt + lchnk = state%lchnk + ncol = state%ncol + + call pbuf_get_field(pbuf, tauresx_idx, tauresx) + call pbuf_get_field(pbuf, tauresy_idx, tauresy) + call pbuf_get_field(pbuf, tpert_idx, tpert) + call pbuf_get_field(pbuf, qpert_idx, qpert) + call pbuf_get_field(pbuf, pblh_idx, pblh) + call pbuf_get_field(pbuf, turbtype_idx, turbtype) + + ! Interpolate temperature to interfaces. + do k = 2, pver + do i = 1, ncol + tint(i,k) = 0.5_r8 * ( state%t(i,k) + state%t(i,k-1) ) + end do + end do + tint(:ncol,pver+1) = state%t(:ncol,pver) + + ! Get upper boundary values + call ubc_get_vals( state%lchnk, ncol, state%pint, state%zi, state%t, state%q, state%omega, state%phis, & + ubc_t, ubc_mmr, ubc_flux ) + + ! Always have a fixed upper boundary T if molecular diffusion is active. Why ? + ! For WACCM-X, set ubc temperature to extrapolate from next two lower interface level temperatures + if (do_molec_diff) then + if (waccmx_mode) then + tint(:ncol,1) = 1.5_r8*tint(:ncol,2)-.5_r8*tint(:ncol,3) + else + tint (:ncol,1) = ubc_t(:ncol) + endif + else + tint(:ncol,1) = state%t(:ncol,1) + end if + + ! Set up pressure coordinates for solver calls. + p = Coords1D(state%pint(:ncol,:)) + p_dry = Coords1D(state%pintdry(:ncol,:)) + + !------------------------------------------------------------------------ + ! Check to see if constituent dependent gas constant needed (WACCM-X) + !------------------------------------------------------------------------ + if (waccmx_mode) then + rairi(:ncol,1) = rairv(:ncol,1,lchnk) + do k = 2, pver + do i = 1, ncol + rairi(i,k) = 0.5_r8 * (rairv(i,k,lchnk)+rairv(i,k-1,lchnk)) + end do + end do + rairi(:ncol,pver+1) = rairv(:ncol,pver,lchnk) + else + rairi(:ncol,:pver+1) = rair + endif + + ! Compute rho at interfaces. + do k = 1, pver+1 + do i = 1, ncol + rhoi(i,k) = p%ifc(i,k) / (rairi(i,k)*tint(i,k)) + end do + end do + + ! Compute rho_dry at interfaces. + do k = 1, pver+1 + do i = 1, ncol + rhoi_dry(i,k) = p_dry%ifc(i,k) / (rairi(i,k)*tint(i,k)) + end do + end do + + ! ---------------------------------------- ! + ! Computation of turbulent mountain stress ! + ! ---------------------------------------- ! + + ! Consistent with the computation of 'normal' drag coefficient, we are using + ! the raw input (u,v) to compute 'ksrftms', not the provisionally-marched 'u,v' + ! within the iteration loop of the PBL scheme. + + call trb_mtn_stress_tend(state, pbuf, cam_in) + + call pbuf_get_field(pbuf, ksrftms_idx, ksrftms) + call pbuf_get_field(pbuf, tautmsx_idx, tautmsx) + call pbuf_get_field(pbuf, tautmsy_idx, tautmsy) + + tautotx(:ncol) = cam_in%wsx(:ncol) + tautmsx(:ncol) + tautoty(:ncol) = cam_in%wsy(:ncol) + tautmsy(:ncol) + + ! ------------------------------------- ! + ! Computation of Beljaars SGO form drag ! + ! ------------------------------------- ! + + call beljaars_drag_tend(state, pbuf, cam_in) + + call pbuf_get_field(pbuf, dragblj_idx, dragblj) + call pbuf_get_field(pbuf, taubljx_idx, taubljx) + call pbuf_get_field(pbuf, taubljy_idx, taubljy) + + ! Add Beljaars integrated drag + + tautotx(:ncol) = tautotx(:ncol) + taubljx(:ncol) + tautoty(:ncol) = tautoty(:ncol) + taubljy(:ncol) + + !----------------------------------------------------------------------- ! + ! Computation of eddy diffusivities - Select appropriate PBL scheme ! + !----------------------------------------------------------------------- ! + call pbuf_get_field(pbuf, kvm_idx, kvm_in) + call pbuf_get_field(pbuf, kvh_idx, kvh_in) + call pbuf_get_field(pbuf, smaw_idx, smaw) + call pbuf_get_field(pbuf, tke_idx, tke) + + ! Get potential temperature. + th(:ncol,:pver) = state%t(:ncol,:pver) * state%exner(:ncol,:pver) + + select case (eddy_scheme) + case ( 'diag_TKE', 'SPCAM_m2005' ) + + call eddy_diff_tend(state, pbuf, cam_in, & + ztodt, p, tint, rhoi, cldn, wstarent, & + kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, & + rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & + tke, sprod, sfi, turbtype, smaw) + + ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations. + ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set. + call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol)) + call calc_obklen(ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), & + cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), & + khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol)) + + + case ( 'HB', 'HBR', 'SPCAM_sam1mom' ) + + ! Modification : We may need to use 'taux' instead of 'tautotx' here, for + ! consistency with the previous HB scheme. + + call compute_hb_diff( lchnk , ncol , & + th , state%t , state%q , state%zm , state%zi, & + state%pmid, state%u , state%v , tautotx , tautoty , & + cam_in%shf, cam_in%cflx(:,1), obklen , ustar , pblh , & + kvm , kvh , kvq , cgh , cgs , & + tpert , qpert , cldn , cam_in%ocnfrac , tke , & + ri , & + eddy_scheme ) + + call outfld( 'HB_ri', ri, pcols, lchnk ) + + case ( 'CLUBB_SGS' ) + + ! CLUBB has only a bare-bones placeholder here. If using CLUBB, the + ! PBL diffusion will happen before coupling, so vertical_diffusion + ! is only handling other things, e.g. some boundary conditions, tms, + ! and molecular diffusion. + + call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol)) + + call calc_ustar( ncol, state%t(:ncol,pver), state%pmid(:ncol,pver), & + cam_in%wsx(:ncol), cam_in%wsy(:ncol), rrho(:ncol), ustar(:ncol)) + ! Use actual qflux, not lhf/latvap as was done previously + call calc_obklen( ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), & + cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), & + khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol)) + + ! These tendencies all applied elsewhere. + kvm = 0._r8 + kvh = 0._r8 + kvq = 0._r8 + + ! Not defined since PBL is not actually running here. + cgh = 0._r8 + cgs = 0._r8 + + end select + + call outfld( 'ustar', ustar(:), pcols, lchnk ) + call outfld( 'obklen', obklen(:), pcols, lchnk ) + + ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff + ! on the next timestep. It is not updated by the compute_vdiff call below. + call pbuf_set_field(pbuf, kvh_idx, kvh) + + ! kvm (in pbuf) is only used as an initial guess in compute_eddy_diff on the next timestep. + ! The contributions for molecular diffusion made to kvm by the call to compute_vdiff below + ! are not included in the pbuf as these are not needed in the initial guess by compute_eddy_diff. + call pbuf_set_field(pbuf, kvm_idx, kvm) + + !------------------------------------ ! + ! Application of diffusivities ! + !------------------------------------ ! + + ! Set arrays from input state. + q_tmp(:ncol,:,:) = state%q(:ncol,:,:) + s_tmp(:ncol,:) = state%s(:ncol,:) + u_tmp(:ncol,:) = state%u(:ncol,:) + v_tmp(:ncol,:) = state%v(:ncol,:) + + !------------------------------------------------------ ! + ! Write profile output before applying diffusion scheme ! + !------------------------------------------------------ ! + + if (.not. do_pbl_diags) then + sl_prePBL(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) & + - ( latvap + latice) * q_tmp(:ncol,:,ixcldice) + qt_prePBL(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) & + + q_tmp(:ncol,:,ixcldice) + slv_prePBL(:ncol,:pver) = sl_prePBL(:ncol,:pver) * ( 1._r8 + zvir*qt_prePBL(:ncol,:pver) ) + + call qsat(state%t(:ncol,:), state%pmid(:ncol,:), & + tem2(:ncol,:), ftem(:ncol,:)) + ftem_prePBL(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 + + call outfld( 'qt_pre_PBL ', qt_prePBL, pcols, lchnk ) + call outfld( 'sl_pre_PBL ', sl_prePBL, pcols, lchnk ) + call outfld( 'slv_pre_PBL ', slv_prePBL, pcols, lchnk ) + call outfld( 'u_pre_PBL ', state%u, pcols, lchnk ) + call outfld( 'v_pre_PBL ', state%v, pcols, lchnk ) + call outfld( 'qv_pre_PBL ', state%q(:ncol,:,1), pcols, lchnk ) + call outfld( 'ql_pre_PBL ', state%q(:ncol,:,ixcldliq), pcols, lchnk ) + call outfld( 'qi_pre_PBL ', state%q(:ncol,:,ixcldice), pcols, lchnk ) + call outfld( 't_pre_PBL ', state%t, pcols, lchnk ) + call outfld( 'rh_pre_PBL ', ftem_prePBL, pcols, lchnk ) + + end if + + ! --------------------------------------------------------------------------------- ! + ! Call the diffusivity solver and solve diffusion equation ! + ! The final two arguments are optional function references to ! + ! constituent-independent and constituent-dependent moleculuar diffusivity routines ! + ! --------------------------------------------------------------------------------- ! + + ! Modification : We may need to output 'tautotx_im,tautoty_im' from below 'compute_vdiff' and + ! separately print out as diagnostic output, because these are different from + ! the explicit 'tautotx, tautoty' computed above. + ! Note that the output 'tauresx,tauresy' from below subroutines are fully implicit ones. + + call pbuf_get_field(pbuf, kvt_idx, kvt) + + if (do_molec_diff .and. .not. waccmx_mode) then + ! Top boundary condition for dry static energy + dse_top(:ncol) = cpairv(:ncol,1,lchnk) * tint(:ncol,1) + & + gravit * state%zi(:ncol,1) + else + dse_top(:ncol) = 0._r8 + end if + + select case (eddy_scheme) + case ('CLUBB_SGS') + ! CLUBB applies some fluxes itself, but we still want constituent + ! fluxes applied here (except water vapor). + taux = 0._r8 + tauy = 0._r8 + shflux = 0._r8 + cflux(:,1) = 0._r8 + cflux(:,2:) = cam_in%cflx(:,2:) + case default + taux = cam_in%wsx + tauy = cam_in%wsy + shflux = cam_in%shf + cflux = cam_in%cflx + end select + + if( any(fieldlist_wet) ) then + + if (do_molec_diff) then + call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, & + kvm, kvt, tint, rhoi, kq_scal, cnst_mw, & + mw_fac, nbot_molec) + end if + + call compute_vdiff( state%lchnk , & + pcols , pver , pcnst , ncol , tint , & + p , state%t , rhoi, ztodt , taux , & + tauy , shflux , cflux , & + kvh , kvm , kvq , cgs , cgh , & + state%zi , ksrftms , dragblj , & + qmincg , fieldlist_wet , fieldlist_molec,& + u_tmp , v_tmp , q_tmp , s_tmp , & + tautmsx , tautmsy , dtk , topflx , errstring , & + tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, & + do_molec_diff, waccmx_mode, & + vd_lu_qdecomp, & + ubc_mmr, ubc_flux, kvt, state%pmid, & + cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, & + kq_scal, mw_fac) + + call handle_errmsg(errstring, subname="compute_vdiff", & + extra_msg="Error in fieldlist_wet call from vertical_diffusion.") + + end if + + if( any( fieldlist_dry ) ) then + + if( do_molec_diff ) then + ! kvm is unused in the output here (since it was assigned + ! above), so we use a temp kvm for the inout argument, and + ! ignore the value output by compute_molec_diff. + kvm_temp = kvm + call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, & + kvm_temp, kvt, tint, rhoi_dry, kq_scal, cnst_mw, & + mw_fac, nbot_molec) + end if + + call compute_vdiff( state%lchnk , & + pcols , pver , pcnst , ncol , tint , & + p_dry , state%t , rhoi_dry, ztodt , taux , & + tauy , shflux , cflux , & + kvh , kvm , kvq , cgs , cgh , & + state%zi , ksrftms , dragblj , & + qmincg , fieldlist_dry , fieldlist_molec,& + u_tmp , v_tmp , q_tmp , s_tmp , & + tautmsx_temp , tautmsy_temp , dtk_temp , topflx_temp , errstring , & + tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, & + do_molec_diff , waccmx_mode, & + vd_lu_qdecomp, & + ubc_mmr, ubc_flux, kvt, state%pmiddry, & + cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, & + kq_scal, mw_fac) + + call handle_errmsg(errstring, subname="compute_vdiff", & + extra_msg="Error in fieldlist_dry call from vertical_diffusion.") + + end if + + if (prog_modal_aero) then + + ! Modal aerosol species not diffused, so just add the explicit surface fluxes to the + ! lowest layer + + tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver) + do m = 1, pmam_ncnst + l = pmam_cnst_idx(m) + q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cam_in%cflx(:ncol,l) + enddo + end if + + ! -------------------------------------------------------- ! + ! Diagnostics and output writing after applying PBL scheme ! + ! -------------------------------------------------------- ! + + if (.not. do_pbl_diags) then + + sl(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) & + - ( latvap + latice) * q_tmp(:ncol,:,ixcldice) + qt(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) & + + q_tmp(:ncol,:,ixcldice) + slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir*qt(:ncol,:pver) ) + + slflx(:ncol,1) = 0._r8 + qtflx(:ncol,1) = 0._r8 + uflx(:ncol,1) = 0._r8 + vflx(:ncol,1) = 0._r8 + + slflx_cg(:ncol,1) = 0._r8 + qtflx_cg(:ncol,1) = 0._r8 + uflx_cg(:ncol,1) = 0._r8 + vflx_cg(:ncol,1) = 0._r8 + + do k = 2, pver + do i = 1, ncol + rhoair = state%pint(i,k) / ( rair * ( ( 0.5_r8*(slv(i,k)+slv(i,k-1)) - gravit*state%zi(i,k))/cpair ) ) + slflx(i,k) = kvh(i,k) * & + ( - rhoair*(sl(i,k-1)-sl(i,k))/(state%zm(i,k-1)-state%zm(i,k)) & + + cgh(i,k) ) + qtflx(i,k) = kvh(i,k) * & + ( - rhoair*(qt(i,k-1)-qt(i,k))/(state%zm(i,k-1)-state%zm(i,k)) & + + rhoair*(cam_in%cflx(i,1)+cam_in%cflx(i,ixcldliq)+cam_in%cflx(i,ixcldice))*cgs(i,k) ) + uflx(i,k) = kvm(i,k) * & + ( - rhoair*(u_tmp(i,k-1)-u_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k))) + vflx(i,k) = kvm(i,k) * & + ( - rhoair*(v_tmp(i,k-1)-v_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k))) + slflx_cg(i,k) = kvh(i,k) * cgh(i,k) + qtflx_cg(i,k) = kvh(i,k) * rhoair * ( cam_in%cflx(i,1) + & + cam_in%cflx(i,ixcldliq) + cam_in%cflx(i,ixcldice) ) * cgs(i,k) + uflx_cg(i,k) = 0._r8 + vflx_cg(i,k) = 0._r8 + end do + end do + + ! Modification : I should check whether slflx(:ncol,pverp) is correctly computed. + ! Note also that 'tautotx' is explicit total stress, different from + ! the ones that have been actually added into the atmosphere. + + slflx(:ncol,pverp) = cam_in%shf(:ncol) + qtflx(:ncol,pverp) = cam_in%cflx(:ncol,1) + uflx(:ncol,pverp) = tautotx(:ncol) + vflx(:ncol,pverp) = tautoty(:ncol) + + slflx_cg(:ncol,pverp) = 0._r8 + qtflx_cg(:ncol,pverp) = 0._r8 + uflx_cg(:ncol,pverp) = 0._r8 + vflx_cg(:ncol,pverp) = 0._r8 + + if (trim(shallow_scheme) == 'UNICON') then + call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx) + call pbuf_get_field(pbuf, qti_flx_idx, qti_flx) + qtl_flx(:ncol,1) = 0._r8 + qti_flx(:ncol,1) = 0._r8 + do k = 2, pver + do i = 1, ncol + ! For use in the cloud macrophysics + ! Note that density is not added here. Also, only consider local transport term. + qtl_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldliq)-q_tmp(i,k,ixcldliq))/& + (state%zm(i,k-1)-state%zm(i,k)) + qti_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldice)-q_tmp(i,k,ixcldice))/& + (state%zm(i,k-1)-state%zm(i,k)) + end do + end do + do i = 1, ncol + rhoair = state%pint(i,pverp)/(rair*((slv(i,pver)-gravit*state%zi(i,pverp))/cpair)) + qtl_flx(i,pverp) = cam_in%cflx(i,1)/rhoair + qti_flx(i,pverp) = cam_in%cflx(i,1)/rhoair + end do + end if + + end if + + ! --------------------------------------------------------------- ! + ! Convert the new profiles into vertical diffusion tendencies. ! + ! Convert KE dissipative heat change into "temperature" tendency. ! + ! --------------------------------------------------------------- ! + + ! All variables are modified by vertical diffusion + + lq(:) = .TRUE. + call physics_ptend_init(ptend,state%psetcols, "vertical diffusion", & + ls=.true., lu=.true., lv=.true., lq=lq) + + ptend%s(:ncol,:) = ( s_tmp(:ncol,:) - state%s(:ncol,:) ) * rztodt + ptend%u(:ncol,:) = ( u_tmp(:ncol,:) - state%u(:ncol,:) ) * rztodt + ptend%v(:ncol,:) = ( v_tmp(:ncol,:) - state%v(:ncol,:) ) * rztodt + ptend%q(:ncol,:pver,:) = ( q_tmp(:ncol,:pver,:) - state%q(:ncol,:pver,:) ) * rztodt + if (.not. do_pbl_diags) then + slten(:ncol,:) = ( sl(:ncol,:) - sl_prePBL(:ncol,:) ) * rztodt + qtten(:ncol,:) = ( qt(:ncol,:) - qt_prePBL(:ncol,:) ) * rztodt + end if + + ! ------------------------------------------------------------ ! + ! In order to perform 'pseudo-conservative variable diffusion' ! + ! perform the following two stages: ! + ! ! + ! I. Re-set (1) 'qvten' by 'qtten', and 'qlten = qiten = 0' ! + ! (2) 'sten' by 'slten', and ! + ! (3) 'qlten = qiten = 0' ! + ! ! + ! II. Apply 'positive_moisture' ! + ! ! + ! ------------------------------------------------------------ ! + + if( (eddy_scheme .eq. 'diag_TKE' .or. eddy_scheme .eq. 'SPCAM_m2005') .and. do_pseudocon_diff ) then + + ptend%q(:ncol,:pver,1) = qtten(:ncol,:pver) + ptend%s(:ncol,:pver) = slten(:ncol,:pver) + ptend%q(:ncol,:pver,ixcldliq) = 0._r8 + ptend%q(:ncol,:pver,ixcldice) = 0._r8 + if (ixnumliq > 0) ptend%q(:ncol,:pver,ixnumliq) = 0._r8 + if (ixnumice > 0) ptend%q(:ncol,:pver,ixnumice) = 0._r8 + + do i = 1, ncol + do k = 1, pver + qv_pro(i,k) = state%q(i,k,1) + ptend%q(i,k,1) * ztodt + ql_pro(i,k) = state%q(i,k,ixcldliq) + ptend%q(i,k,ixcldliq) * ztodt + qi_pro(i,k) = state%q(i,k,ixcldice) + ptend%q(i,k,ixcldice) * ztodt + s_pro(i,k) = state%s(i,k) + ptend%s(i,k) * ztodt + t_pro(i,k) = state%t(i,k) + (1._r8/cpair)*ptend%s(i,k) * ztodt + end do + end do + + call positive_moisture( cpair, latvap, latvap+latice, ncol, pver, ztodt, qmin(1), qmin(ixcldliq), qmin(ixcldice), & + state%pdel(:ncol,pver:1:-1), qv_pro(:ncol,pver:1:-1), ql_pro(:ncol,pver:1:-1), & + qi_pro(:ncol,pver:1:-1), t_pro(:ncol,pver:1:-1), s_pro(:ncol,pver:1:-1), & + ptend%q(:ncol,pver:1:-1,1), ptend%q(:ncol,pver:1:-1,ixcldliq), & + ptend%q(:ncol,pver:1:-1,ixcldice), ptend%s(:ncol,pver:1:-1) ) + + end if + + ! ----------------------------------------------------------------- ! + ! Re-calculate diagnostic output variables after vertical diffusion ! + ! ----------------------------------------------------------------- ! + + if (.not. do_pbl_diags) then + + qv_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,1) + ptend%q(:ncol,:pver,1) * ztodt + ql_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + ptend%q(:ncol,:pver,ixcldliq) * ztodt + qi_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + ptend%q(:ncol,:pver,ixcldice) * ztodt + s_aft_PBL(:ncol,:pver) = state%s(:ncol,:pver) + ptend%s(:ncol,:pver) * ztodt + t_aftPBL(:ncol,:pver) = ( s_aft_PBL(:ncol,:pver) - gravit*state%zm(:ncol,:pver) ) / cpair + + u_aft_PBL(:ncol,:pver) = state%u(:ncol,:pver) + ptend%u(:ncol,:pver) * ztodt + v_aft_PBL(:ncol,:pver) = state%v(:ncol,:pver) + ptend%v(:ncol,:pver) * ztodt + + call qsat(t_aftPBL(:ncol,:pver), state%pmid(:ncol,:pver), & + tem2(:ncol,:pver), ftem(:ncol,:pver)) + ftem_aftPBL(:ncol,:pver) = qv_aft_PBL(:ncol,:pver) / ftem(:ncol,:pver) * 100._r8 + + tten(:ncol,:pver) = ( t_aftPBL(:ncol,:pver) - state%t(:ncol,:pver) ) * rztodt + rhten(:ncol,:pver) = ( ftem_aftPBL(:ncol,:pver) - ftem_prePBL(:ncol,:pver) ) * rztodt + + end if + + ! -------------------------------------------------------------- ! + ! mass conservation check......... + ! -------------------------------------------------------------- ! + if (diff_cnsrv_mass_check) then + + ! Conservation check + do m = 1, pcnst + fixed_ubc: if ((.not.cnst_fixed_ubc(m)).and.(.not.cnst_fixed_ubflx(m))) then + col_loop: do i = 1, ncol + sum1 = 0._r8 + sum2 = 0._r8 + sum3 = 0._r8 + do k = 1, pver + if(cnst_get_type_byind(m).eq.'wet') then + pdelx = state%pdel(i,k) + else + pdelx = state%pdeldry(i,k) + endif + sum1 = sum1 + state%q(i,k,m)*pdelx/gravit ! total column + sum2 = sum2 +(state%q(i,k,m)+ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! total column after tendancy is applied + sum3 = sum3 +( ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! rate of change in column + enddo + sum1 = sum1 + (cam_in%cflx(i,m) * ztodt) ! add in surface flux (kg/m2) + sflx = (cam_in%cflx(i,m) * ztodt) + if (sum1>1.e-36_r8) then + if( abs((sum2-sum1)/sum1) .gt. 1.e-12_r8 ) then + nstep = get_nstep() + write(iulog,'(a,a8,a,I4,2f8.3,5e25.16)') & + 'MASSCHECK vert diff : nstep,lon,lat,mass1,mass2,sum3,sflx,rel-diff : ', & + trim(cnst_name(m)), ' : ', nstep, state%lon(i)*180._r8/pi, state%lat(i)*180._r8/pi, & + sum1, sum2, sum3, sflx, abs(sum2-sum1)/sum1 + call endrun('vertical_diffusion_tend : mass not conserved' ) + endif + endif + enddo col_loop + endif fixed_ubc + enddo + endif + + ! -------------------------------------------------------------- ! + ! Writing state variables after PBL scheme for detailed analysis ! + ! -------------------------------------------------------------- ! + + if (.not. do_pbl_diags) then + + call outfld( 'sl_aft_PBL' , sl, pcols, lchnk ) + call outfld( 'qt_aft_PBL' , qt, pcols, lchnk ) + call outfld( 'slv_aft_PBL' , slv, pcols, lchnk ) + call outfld( 'u_aft_PBL' , u_aft_PBL, pcols, lchnk ) + call outfld( 'v_aft_PBL' , v_aft_PBL, pcols, lchnk ) + call outfld( 'qv_aft_PBL' , qv_aft_PBL, pcols, lchnk ) + call outfld( 'ql_aft_PBL' , ql_aft_PBL, pcols, lchnk ) + call outfld( 'qi_aft_PBL' , qi_aft_PBL, pcols, lchnk ) + call outfld( 't_aft_PBL ' , t_aftPBL, pcols, lchnk ) + call outfld( 'rh_aft_PBL' , ftem_aftPBL, pcols, lchnk ) + call outfld( 'slflx_PBL' , slflx, pcols, lchnk ) + call outfld( 'qtflx_PBL' , qtflx, pcols, lchnk ) + call outfld( 'uflx_PBL' , uflx, pcols, lchnk ) + call outfld( 'vflx_PBL' , vflx, pcols, lchnk ) + call outfld( 'slflx_cg_PBL' , slflx_cg, pcols, lchnk ) + call outfld( 'qtflx_cg_PBL' , qtflx_cg, pcols, lchnk ) + call outfld( 'uflx_cg_PBL' , uflx_cg, pcols, lchnk ) + call outfld( 'vflx_cg_PBL' , vflx_cg, pcols, lchnk ) + call outfld( 'slten_PBL' , slten, pcols, lchnk ) + call outfld( 'qtten_PBL' , qtten, pcols, lchnk ) + call outfld( 'uten_PBL' , ptend%u(:ncol,:), pcols, lchnk ) + call outfld( 'vten_PBL' , ptend%v(:ncol,:), pcols, lchnk ) + call outfld( 'qvten_PBL' , ptend%q(:ncol,:,1), pcols, lchnk ) + call outfld( 'qlten_PBL' , ptend%q(:ncol,:,ixcldliq), pcols, lchnk ) + call outfld( 'qiten_PBL' , ptend%q(:ncol,:,ixcldice), pcols, lchnk ) + call outfld( 'tten_PBL' , tten, pcols, lchnk ) + call outfld( 'rhten_PBL' , rhten, pcols, lchnk ) + + end if + + ! ------------------------------------------- ! + ! Writing the other standard output variables ! + ! ------------------------------------------- ! + + if (.not. do_pbl_diags) then + call outfld( 'QT' , qt, pcols, lchnk ) + call outfld( 'SL' , sl, pcols, lchnk ) + call outfld( 'SLV' , slv, pcols, lchnk ) + call outfld( 'SLFLX' , slflx, pcols, lchnk ) + call outfld( 'QTFLX' , qtflx, pcols, lchnk ) + call outfld( 'UFLX' , uflx, pcols, lchnk ) + call outfld( 'VFLX' , vflx, pcols, lchnk ) + call outfld( 'TKE' , tke, pcols, lchnk ) + + call outfld( 'PBLH' , pblh, pcols, lchnk ) + call outfld( 'TPERT' , tpert, pcols, lchnk ) + call outfld( 'QPERT' , qpert, pcols, lchnk ) + end if + call outfld( 'USTAR' , ustar, pcols, lchnk ) + call outfld( 'KVH' , kvh, pcols, lchnk ) + call outfld( 'KVT' , kvt, pcols, lchnk ) + call outfld( 'KVM' , kvm, pcols, lchnk ) + call outfld( 'CGS' , cgs, pcols, lchnk ) + dtk(:ncol,:) = dtk(:ncol,:) / cpair ! Normalize heating for history + call outfld( 'DTVKE' , dtk, pcols, lchnk ) + dtk(:ncol,:) = ptend%s(:ncol,:) / cpair ! Normalize heating for history using dtk + call outfld( 'DTV' , dtk, pcols, lchnk ) + call outfld( 'DUV' , ptend%u, pcols, lchnk ) + call outfld( 'DVV' , ptend%v, pcols, lchnk ) + do m = 1, pcnst + call outfld( vdiffnam(m) , ptend%q(1,1,m), pcols, lchnk ) + end do + if( do_molec_diff ) then + call outfld( 'TTPXMLC' , topflx, pcols, lchnk ) + end if + + call p%finalize() + call p_dry%finalize() + +end subroutine vertical_diffusion_tend + +! =============================================================================== ! +! ! +! =============================================================================== ! + +subroutine positive_moisture( cp, xlv, xls, ncol, mkx, dt, qvmin, qlmin, qimin, & + dp, qv, ql, qi, t, s, qvten, qlten, qiten, sten ) + ! ------------------------------------------------------------------------------- ! + ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, ! + ! force them to be larger than minimum value by (1) condensating water vapor ! + ! into liquid or ice, and (2) by transporting water vapor from the very lower ! + ! layer. '2._r8' is multiplied to the minimum values for safety. ! + ! Update final state variables and tendencies associated with this correction. ! + ! If any condensation happens, update (s,t) too. ! + ! Note that (qv,ql,qi,t,s) are final state variables after applying corresponding ! + ! input tendencies. ! + ! Be careful the order of k : '1': near-surface layer, 'mkx' : top layer ! + ! ------------------------------------------------------------------------------- ! + implicit none + integer, intent(in) :: ncol, mkx + real(r8), intent(in) :: cp, xlv, xls + real(r8), intent(in) :: dt, qvmin, qlmin, qimin + real(r8), intent(in) :: dp(ncol,mkx) + real(r8), intent(inout) :: qv(ncol,mkx), ql(ncol,mkx), qi(ncol,mkx), t(ncol,mkx), s(ncol,mkx) + real(r8), intent(inout) :: qvten(ncol,mkx), qlten(ncol,mkx), qiten(ncol,mkx), sten(ncol,mkx) + integer i, k + real(r8) dql, dqi, dqv, sum, aa, dum + + ! Modification : I should check whether this is exactly same as the one used in + ! shallow convection and cloud macrophysics. + + do i = 1, ncol + do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface + dql = max(0._r8,1._r8*qlmin-ql(i,k)) + dqi = max(0._r8,1._r8*qimin-qi(i,k)) + qlten(i,k) = qlten(i,k) + dql/dt + qiten(i,k) = qiten(i,k) + dqi/dt + qvten(i,k) = qvten(i,k) - (dql+dqi)/dt + sten(i,k) = sten(i,k) + xlv * (dql/dt) + xls * (dqi/dt) + ql(i,k) = ql(i,k) + dql + qi(i,k) = qi(i,k) + dqi + qv(i,k) = qv(i,k) - dql - dqi + s(i,k) = s(i,k) + xlv * dql + xls * dqi + t(i,k) = t(i,k) + (xlv * dql + xls * dqi)/cp + dqv = max(0._r8,1._r8*qvmin-qv(i,k)) + qvten(i,k) = qvten(i,k) + dqv/dt + qv(i,k) = qv(i,k) + dqv + if( k .ne. 1 ) then + qv(i,k-1) = qv(i,k-1) - dqv*dp(i,k)/dp(i,k-1) + qvten(i,k-1) = qvten(i,k-1) - dqv*dp(i,k)/dp(i,k-1)/dt + endif + qv(i,k) = max(qv(i,k),qvmin) + ql(i,k) = max(ql(i,k),qlmin) + qi(i,k) = max(qi(i,k),qimin) + end do + ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally + ! extracted from all the layers that has 'qv > 2*qvmin'. This fully + ! preserves column moisture. + if( dqv .gt. 1.e-20_r8 ) then + sum = 0._r8 + do k = 1, mkx + if( qv(i,k) .gt. 2._r8*qvmin ) sum = sum + qv(i,k)*dp(i,k) + enddo + aa = dqv*dp(i,1)/max(1.e-20_r8,sum) + if( aa .lt. 0.5_r8 ) then + do k = 1, mkx + if( qv(i,k) .gt. 2._r8*qvmin ) then + dum = aa*qv(i,k) + qv(i,k) = qv(i,k) - dum + qvten(i,k) = qvten(i,k) - dum/dt + endif + enddo + else + write(iulog,*) 'Full positive_moisture is impossible in vertical_diffusion' + endif + endif + end do + return + +end subroutine positive_moisture + +end module vertical_diffusion diff --git a/src/physics/cam/waccmx_phys_intr.F90 b/src/physics/cam/waccmx_phys_intr.F90 new file mode 100644 index 0000000000..0081031f59 --- /dev/null +++ b/src/physics/cam/waccmx_phys_intr.F90 @@ -0,0 +1,101 @@ +module waccmx_phys_intr + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend + use physics_buffer, only: physics_buffer_desc + +#ifdef WACCMX_PHYS + use majorsp_diffusion, only: mspd_init + use majorsp_diffusion, only: mspd_intr + use ion_electron_temp, only: ion_electron_temp_init + use ion_electron_temp, only: ion_electron_temp_register + use ion_electron_temp, only: ion_electron_temp_inidat + use ion_electron_temp, only: ion_electron_temp_tend + use iondrag, only: iondrag_inidat +#endif + + implicit none + private + + public :: waccmx_phys_mspd_init + public :: waccmx_phys_mspd_tend + public :: waccmx_phys_ion_elec_temp_reg + public :: waccmx_phys_ion_elec_temp_inidat + public :: waccmx_phys_ion_elec_temp_init + public :: waccmx_phys_ion_elec_temp_tend + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_mspd_init + +#ifdef WACCMX_PHYS + call mspd_init() +#endif + end subroutine waccmx_phys_mspd_init + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_mspd_tend(ztodt, state, ptend) + + real(r8), intent(in) :: ztodt ! 2 delta-t + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! indivdual parameterization tendencies + +#ifdef WACCMX_PHYS + call mspd_intr(ztodt, state, ptend) +#endif + end subroutine waccmx_phys_mspd_tend + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_ion_elec_temp_reg + +#ifdef WACCMX_PHYS + call ion_electron_temp_register +#endif + + end subroutine waccmx_phys_ion_elec_temp_reg + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_ion_elec_temp_inidat(ncid_ini,pbuf2d) + + use pio, only : file_desc_t + + type(file_desc_t), intent(inout) :: ncid_ini ! Initial condition file id + type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Physics buffer + +#ifdef WACCMX_PHYS + call ion_electron_temp_inidat(ncid_ini,pbuf2d) + call iondrag_inidat(ncid_ini,pbuf2d) +#endif + end subroutine waccmx_phys_ion_elec_temp_inidat + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_ion_elec_temp_init(pbuf2d) + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +#ifdef WACCMX_PHYS + call ion_electron_temp_init(pbuf2d) +#endif + end subroutine waccmx_phys_ion_elec_temp_init + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) + + type(physics_state), intent(in) :: state ! physics state structure + type(physics_ptend), intent(inout) :: ptend ! parameterization tendency structure + type(physics_buffer_desc),pointer :: pbuf(:) ! physics buffer + + real(r8), intent(in) :: ztodt ! Physics time step + +#ifdef WACCMX_PHYS + call ion_electron_temp_tend(state, ptend, pbuf, ztodt) +#endif + end subroutine waccmx_phys_ion_elec_temp_tend + +end module waccmx_phys_intr diff --git a/src/physics/cam/wv_sat_methods.F90 b/src/physics/cam/wv_sat_methods.F90 new file mode 100644 index 0000000000..c413376631 --- /dev/null +++ b/src/physics/cam/wv_sat_methods.F90 @@ -0,0 +1,484 @@ +module wv_sat_methods + +! This portable module contains all CAM methods for estimating +! the saturation vapor pressure of water. +! +! wv_saturation provides CAM-specific interfaces and utilities +! based on these formulae. +! +! Typical usage of this module: +! +! Init: +! call wv_sat_methods_init(r8, , errstring) +! +! Get scheme index from a name string: +! scheme_idx = wv_sat_get_scheme_idx(scheme_name) +! if (.not. wv_sat_valid_idx(scheme_idx)) +! +! Get pressures: +! es = wv_sat_svp_water(t, scheme_idx) +! es = wv_sat_svp_ice(t, scheme_idx) +! +! Use ice/water transition range: +! es = wv_sat_svp_trice(t, ttrice, scheme_idx) +! +! Note that elemental functions cannot be pointed to, nor passed +! as arguments. If you need to do either, it is recommended to +! wrap the function so that it can be given an explicit (non- +! elemental) interface. + +implicit none +private +save + +integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real + +real(r8) :: tmelt ! Melting point of water at 1 atm (K) +real(r8) :: h2otrip ! Triple point temperature of water (K) +real(r8) :: tboil ! Boiling point of water at 1 atm (K) + +real(r8) :: ttrice ! Ice-water transition range + +real(r8) :: epsilo ! Ice-water transition range +real(r8) :: omeps ! 1._r8 - epsilo + +! Indices representing individual schemes +integer, parameter :: Invalid_idx = -1 +integer, parameter :: OldGoffGratch_idx = 0 +integer, parameter :: GoffGratch_idx = 1 +integer, parameter :: MurphyKoop_idx = 2 +integer, parameter :: Bolton_idx = 3 + +! Index representing the current default scheme. +integer, parameter :: initial_default_idx = GoffGratch_idx +integer :: default_idx = initial_default_idx + +public wv_sat_methods_init +public wv_sat_get_scheme_idx +public wv_sat_valid_idx + +public wv_sat_set_default +public wv_sat_reset_default + +public wv_sat_svp_water +public wv_sat_svp_ice +public wv_sat_svp_trans + +! pressure -> humidity conversion +public wv_sat_svp_to_qsat + +! Combined qsat operations +public wv_sat_qsat_water +public wv_sat_qsat_ice +public wv_sat_qsat_trans + +contains + +!--------------------------------------------------------------------- +! ADMINISTRATIVE FUNCTIONS +!--------------------------------------------------------------------- + +! Get physical constants +subroutine wv_sat_methods_init(kind, tmelt_in, h2otrip_in, tboil_in, & + ttrice_in, epsilo_in, errstring) + integer, intent(in) :: kind + real(r8), intent(in) :: tmelt_in + real(r8), intent(in) :: h2otrip_in + real(r8), intent(in) :: tboil_in + real(r8), intent(in) :: ttrice_in + real(r8), intent(in) :: epsilo_in + character(len=*), intent(out) :: errstring + + errstring = ' ' + + if (kind /= r8) then + write(errstring,*) 'wv_sat_methods_init: ERROR: ', & + kind,' was input kind but ',r8,' is internal kind.' + return + end if + + if (ttrice_in < 0._r8) then + write(errstring,*) 'wv_sat_methods_init: ERROR: ', & + ttrice_in,' was input for ttrice, but negative range is invalid.' + return + end if + + tmelt = tmelt_in + h2otrip = h2otrip_in + tboil = tboil_in + ttrice = ttrice_in + epsilo = epsilo_in + + omeps = 1._r8 - epsilo + +end subroutine wv_sat_methods_init + +! Look up index by name. +pure function wv_sat_get_scheme_idx(name) result(idx) + character(len=*), intent(in) :: name + integer :: idx + + select case (name) + case("GoffGratch") + idx = GoffGratch_idx + case("MurphyKoop") + idx = MurphyKoop_idx + case("OldGoffGratch") + idx = OldGoffGratch_idx + case("Bolton") + idx = Bolton_idx + case default + idx = Invalid_idx + end select + +end function wv_sat_get_scheme_idx + +! Check validity of an index from the above routine. +pure function wv_sat_valid_idx(idx) result(status) + integer, intent(in) :: idx + logical :: status + + status = (idx /= Invalid_idx) + +end function wv_sat_valid_idx + +! Set default scheme (otherwise, Goff & Gratch is default) +! Returns a logical representing success (.true.) or +! failure (.false.). +function wv_sat_set_default(name) result(status) + character(len=*), intent(in) :: name + logical :: status + + ! Don't want to overwrite valid default with invalid, + ! so assign to temporary and check it first. + integer :: tmp_idx + + tmp_idx = wv_sat_get_scheme_idx(name) + + status = wv_sat_valid_idx(tmp_idx) + + if (status) default_idx = tmp_idx + +end function wv_sat_set_default + +! Reset default scheme to initial value. +! The same thing can be accomplished with wv_sat_set_default; +! the real reason to provide this routine is to reset the +! module for testing purposes. +subroutine wv_sat_reset_default() + + default_idx = initial_default_idx + +end subroutine wv_sat_reset_default + +!--------------------------------------------------------------------- +! UTILITIES +!--------------------------------------------------------------------- + +! Get saturation specific humidity given pressure and SVP. +! Specific humidity is limited to range 0-1. +elemental function wv_sat_svp_to_qsat(es, p) result(qs) + + real(r8), intent(in) :: es ! SVP + real(r8), intent(in) :: p ! Current pressure. + real(r8) :: qs + + ! If pressure is less than SVP, set qs to maximum of 1. + if ( (p - es) <= 0._r8 ) then + qs = 1.0_r8 + else + qs = epsilo*es / (p - omeps*es) + end if + +end function wv_sat_svp_to_qsat + +elemental subroutine wv_sat_qsat_water(t, p, es, qs, idx) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate SVP over water at a given temperature, and then ! + ! calculate and return saturation specific humidity. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + integer, intent(in), optional :: idx ! Scheme index + + es = wv_sat_svp_water(t, idx) + + qs = wv_sat_svp_to_qsat(es, p) + + ! Ensures returned es is consistent with limiters on qs. + es = min(es, p) + +end subroutine wv_sat_qsat_water + +elemental subroutine wv_sat_qsat_ice(t, p, es, qs, idx) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate SVP over ice at a given temperature, and then ! + ! calculate and return saturation specific humidity. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + integer, intent(in), optional :: idx ! Scheme index + + es = wv_sat_svp_ice(t, idx) + + qs = wv_sat_svp_to_qsat(es, p) + + ! Ensures returned es is consistent with limiters on qs. + es = min(es, p) + +end subroutine wv_sat_qsat_ice + +elemental subroutine wv_sat_qsat_trans(t, p, es, qs, idx) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate SVP over ice at a given temperature, and then ! + ! calculate and return saturation specific humidity. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + integer, intent(in), optional :: idx ! Scheme index + + es = wv_sat_svp_trans(t, idx) + + qs = wv_sat_svp_to_qsat(es, p) + + ! Ensures returned es is consistent with limiters on qs. + es = min(es, p) + +end subroutine wv_sat_qsat_trans + +!--------------------------------------------------------------------- +! SVP INTERFACE FUNCTIONS +!--------------------------------------------------------------------- + +elemental function wv_sat_svp_water(t, idx) result(es) + real(r8), intent(in) :: t + integer, intent(in), optional :: idx + real(r8) :: es + + integer :: use_idx + + if (present(idx)) then + use_idx = idx + else + use_idx = default_idx + end if + + select case (use_idx) + case(GoffGratch_idx) + es = GoffGratch_svp_water(t) + case(MurphyKoop_idx) + es = MurphyKoop_svp_water(t) + case(OldGoffGratch_idx) + es = OldGoffGratch_svp_water(t) + case(Bolton_idx) + es = Bolton_svp_water(t) + end select + +end function wv_sat_svp_water + +elemental function wv_sat_svp_ice(t, idx) result(es) + real(r8), intent(in) :: t + integer, intent(in), optional :: idx + real(r8) :: es + + integer :: use_idx + + if (present(idx)) then + use_idx = idx + else + use_idx = default_idx + end if + + select case (use_idx) + case(GoffGratch_idx) + es = GoffGratch_svp_ice(t) + case(MurphyKoop_idx) + es = MurphyKoop_svp_ice(t) + case(OldGoffGratch_idx) + es = OldGoffGratch_svp_ice(t) + case(Bolton_idx) + es = Bolton_svp_water(t) + end select + +end function wv_sat_svp_ice + +elemental function wv_sat_svp_trans(t, idx) result (es) + + real(r8), intent(in) :: t + integer, intent(in), optional :: idx + + real(r8) :: es + + real(r8) :: esice ! Saturation vapor pressure over ice + real(r8) :: weight ! Intermediate scratch variable for es transition + +! +! Water +! + if (t >= (tmelt - ttrice)) then + es = wv_sat_svp_water(t,idx) + else + es = 0.0_r8 + end if + +! +! Ice +! + if (t < tmelt) then + + esice = wv_sat_svp_ice(t,idx) + + if ( (tmelt - t) > ttrice ) then + weight = 1.0_r8 + else + weight = (tmelt - t)/ttrice + end if + + es = weight*esice + (1.0_r8 - weight)*es + end if + +end function wv_sat_svp_trans + +!--------------------------------------------------------------------- +! SVP METHODS +!--------------------------------------------------------------------- + +! Goff & Gratch (1946) + +elemental function GoffGratch_svp_water(t) result(es) + real(r8), intent(in) :: t ! Temperature in Kelvin + real(r8) :: es ! SVP in Pa + + ! uncertain below -70 C + es = 10._r8**(-7.90298_r8*(tboil/t-1._r8)+ & + 5.02808_r8*log10(tboil/t)- & + 1.3816e-7_r8*(10._r8**(11.344_r8*(1._r8-t/tboil))-1._r8)+ & + 8.1328e-3_r8*(10._r8**(-3.49149_r8*(tboil/t-1._r8))-1._r8)+ & + log10(1013.246_r8))*100._r8 + +end function GoffGratch_svp_water + +elemental function GoffGratch_svp_ice(t) result(es) + real(r8), intent(in) :: t ! Temperature in Kelvin + real(r8) :: es ! SVP in Pa + + ! good down to -100 C + es = 10._r8**(-9.09718_r8*(h2otrip/t-1._r8)-3.56654_r8* & + log10(h2otrip/t)+0.876793_r8*(1._r8-t/h2otrip)+ & + log10(6.1071_r8))*100._r8 + +end function GoffGratch_svp_ice + +! Murphy & Koop (2005) + +elemental function MurphyKoop_svp_water(t) result(es) + real(r8), intent(in) :: t ! Temperature in Kelvin + real(r8) :: es ! SVP in Pa + + ! (good for 123 < T < 332 K) + es = exp(54.842763_r8 - (6763.22_r8 / t) - (4.210_r8 * log(t)) + & + (0.000367_r8 * t) + (tanh(0.0415_r8 * (t - 218.8_r8)) * & + (53.878_r8 - (1331.22_r8 / t) - (9.44523_r8 * log(t)) + & + 0.014025_r8 * t))) + +end function MurphyKoop_svp_water + +elemental function MurphyKoop_svp_ice(t) result(es) + real(r8), intent(in) :: t ! Temperature in Kelvin + real(r8) :: es ! SVP in Pa + + ! (good down to 110 K) + es = exp(9.550426_r8 - (5723.265_r8 / t) + (3.53068_r8 * log(t)) & + - (0.00728332_r8 * t)) + +end function MurphyKoop_svp_ice + +! Old CAM implementation, also labelled Goff & Gratch (1946) + +! The water formula differs only due to compiler-dependent order of +! operations, so differences are roundoff level, usually 0. + +! The ice formula gives fairly close answers to the current +! implementation, but has been rearranged, and uses the +! 1 atm melting point of water as the triple point. +! Differences are thus small but above roundoff. + +! A curious fact: although using the melting point of water was +! probably a mistake, it mildly improves accuracy for ice svp, +! since it compensates for a systematic error in Goff & Gratch. + +elemental function OldGoffGratch_svp_water(t) result(es) + real(r8), intent(in) :: t + real(r8) :: es + real(r8) :: ps, e1, e2, f1, f2, f3, f4, f5, f + + ps = 1013.246_r8 + e1 = 11.344_r8*(1.0_r8 - t/tboil) + e2 = -3.49149_r8*(tboil/t - 1.0_r8) + f1 = -7.90298_r8*(tboil/t - 1.0_r8) + f2 = 5.02808_r8*log10(tboil/t) + f3 = -1.3816_r8*(10.0_r8**e1 - 1.0_r8)/10000000.0_r8 + f4 = 8.1328_r8*(10.0_r8**e2 - 1.0_r8)/1000.0_r8 + f5 = log10(ps) + f = f1 + f2 + f3 + f4 + f5 + + es = (10.0_r8**f)*100.0_r8 + +end function OldGoffGratch_svp_water + +elemental function OldGoffGratch_svp_ice(t) result(es) + real(r8), intent(in) :: t + real(r8) :: es + real(r8) :: term1, term2, term3 + + term1 = 2.01889049_r8/(tmelt/t) + term2 = 3.56654_r8*log(tmelt/t) + term3 = 20.947031_r8*(tmelt/t) + + es = 575.185606e10_r8*exp(-(term1 + term2 + term3)) + +end function OldGoffGratch_svp_ice + +! Bolton (1980) +! zm_conv deep convection scheme contained this SVP calculation. +! It appears to be from D. Bolton, 1980, Monthly Weather Review. +! Unlike the other schemes, no distinct ice formula is associated +! with it. (However, a Bolton ice formula exists in CLUBB.) + +! The original formula used degrees C, but this function +! takes Kelvin and internally converts. + +elemental function Bolton_svp_water(t) result(es) + real(r8),parameter :: c1 = 611.2_r8 + real(r8),parameter :: c2 = 17.67_r8 + real(r8),parameter :: c3 = 243.5_r8 + + real(r8), intent(in) :: t ! Temperature in Kelvin + real(r8) :: es ! SVP in Pa + + es = c1*exp( (c2*(t - tmelt))/((t - tmelt)+c3) ) + +end function Bolton_svp_water + +end module wv_sat_methods diff --git a/src/physics/cam/wv_saturation.F90 b/src/physics/cam/wv_saturation.F90 new file mode 100644 index 0000000000..94b32acd73 --- /dev/null +++ b/src/physics/cam/wv_saturation.F90 @@ -0,0 +1,802 @@ +module wv_saturation + +!--------------------------------------------------------------------! +! Module Overview: ! +! ! +! This module provides an interface to wv_sat_methods, providing ! +! saturation vapor pressure and related calculations to CAM. ! +! ! +! The original wv_saturation codes were introduced by J. J. Hack, ! +! February 1990. The code has been extensively rewritten since then, ! +! including a total refactoring in Summer 2012. ! +! ! +!--------------------------------------------------------------------! +! Methods: ! +! ! +! Pure water/ice saturation vapor pressures are calculated on the ! +! fly, with the specific method determined by a runtime option. ! +! Mixed phase SVP is interpolated from the internal table, estbl, ! +! which is created during initialization. ! +! ! +! The default method for calculating SVP is determined by a namelist ! +! option, and used whenever svp_water/ice or qsat are called. ! +! ! +!--------------------------------------------------------------------! + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: epsilo, & + latvap, & + latice, & + rh2o, & + cpair, & + tmelt, & + h2otrip + +use wv_sat_methods, only: & + svp_to_qsat => wv_sat_svp_to_qsat + +implicit none +private +save + +! Public interfaces +! Namelist, initialization, finalization +public wv_sat_readnl +public wv_sat_init +public wv_sat_final + +! Saturation vapor pressure calculations +public svp_water +public svp_ice + +! Mixed phase (water + ice) saturation vapor pressure table lookup +public estblf + +public svp_to_qsat + +! Subroutines that return both SVP and humidity +! Optional arguments do temperature derivatives +public qsat ! Mixed phase +public qsat_water ! SVP over water only +public qsat_ice ! SVP over ice only + +! Wet bulb temperature solver +public :: findsp_vc, findsp + +! Data + +! This value is slightly high, but it seems to be the value for the +! steam point of water originally (and most frequently) used in the +! Goff & Gratch scheme. +real(r8), parameter :: tboil = 373.16_r8 + +! Table of saturation vapor pressure values (estbl) from tmin to +! tmax+1 Kelvin, in one degree increments. ttrice defines the +! transition region, estbl contains a combination of ice & water +! values. +! Make these public parameters in case another module wants to see the +! extent of the table. + real(r8), public, parameter :: tmin = 127.16_r8 + real(r8), public, parameter :: tmax = 375.16_r8 + + real(r8), parameter :: ttrice = 20.00_r8 ! transition range from es over H2O to es over ice + + integer :: plenest ! length of estbl + real(r8), allocatable :: estbl(:) ! table values of saturation vapor pressure + + real(r8) :: omeps ! 1.0_r8 - epsilo + + real(r8) :: c3 ! parameter used by findsp + + ! Set coefficients for polynomial approximation of difference + ! between saturation vapor press over water and saturation pressure + ! over ice for -ttrice < t < 0 (degrees C). NOTE: polynomial is + ! valid in the range -40 < t < 0 (degrees C). + real(r8) :: pcf(5) = (/ & + 5.04469588506e-01_r8, & + -5.47288442819e+00_r8, & + -3.67471858735e-01_r8, & + -8.95963532403e-03_r8, & + -7.78053686625e-05_r8 /) + +! --- Degree 6 approximation --- +! real(r8) :: pcf(6) = (/ & +! 7.63285250063e-02, & +! 5.86048427932e+00, & +! 4.38660831780e-01, & +! 1.37898276415e-02, & +! 2.14444472424e-04, & +! 1.36639103771e-06 /) + +contains + +!--------------------------------------------------------------------- +! ADMINISTRATIVE FUNCTIONS +!--------------------------------------------------------------------- + +subroutine wv_sat_readnl(nlfile) + !------------------------------------------------------------------! + ! Purpose: ! + ! Get runtime options for wv_saturation. ! + !------------------------------------------------------------------! + + use wv_sat_methods, only: wv_sat_get_scheme_idx, & + wv_sat_valid_idx, & + wv_sat_set_default + + use spmd_utils, only: masterproc + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + use cam_abortutils, only: endrun + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + character(len=32) :: wv_sat_scheme = "GoffGratch" + + character(len=*), parameter :: subname = 'wv_sat_readnl' + + namelist /wv_sat_nl/ wv_sat_scheme + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'wv_sat_nl', status=ierr) + if (ierr == 0) then + read(unitn, wv_sat_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + return + end if + end if + close(unitn) + call freeunit(unitn) + + end if + +#ifdef SPMD + call mpibcast(wv_sat_scheme, len(wv_sat_scheme) , mpichar, 0, mpicom) +#endif + + if (.not. wv_sat_set_default(wv_sat_scheme)) then + call endrun('wv_sat_readnl :: Invalid wv_sat_scheme.') + return + end if + +end subroutine wv_sat_readnl + +subroutine wv_sat_init + !------------------------------------------------------------------! + ! Purpose: ! + ! Initialize module (e.g. setting parameters, initializing the ! + ! SVP lookup table). ! + !------------------------------------------------------------------! + + use wv_sat_methods, only: wv_sat_methods_init, & + wv_sat_get_scheme_idx, & + wv_sat_valid_idx + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use shr_assert_mod, only: shr_assert_in_domain + use error_messages, only: handle_errmsg + + integer :: status + + ! For wv_sat_methods error reporting. + character(len=256) :: errstring + + ! For generating internal SVP table. + real(r8) :: t ! Temperature + integer :: i ! Increment counter + + ! Precalculated because so frequently used. + omeps = 1.0_r8 - epsilo + + ! Transition range method is only valid for transition temperatures at: + ! -40 deg C < T < 0 deg C + call shr_assert_in_domain(ttrice, ge=0._r8, le=40._r8, varname="ttrice",& + msg="wv_sat_init: Invalid transition temperature range.") + +! This parameter uses a hardcoded 287.04_r8? + c3 = 287.04_r8*(7.5_r8*log(10._r8))/cpair + +! Init "methods" module containing actual SVP formulae. + + call wv_sat_methods_init(r8, tmelt, h2otrip, tboil, ttrice, & + epsilo, errstring) + + call handle_errmsg(errstring, subname="wv_sat_methods_init") + + ! Add two to make the table slightly too big, just in case. + plenest = ceiling(tmax-tmin) + 2 + + ! Allocate SVP table. + allocate(estbl(plenest), stat=status) + if (status /= 0) then + call endrun('wv_sat_init :: ERROR allocating saturation vapor pressure table') + return + end if + + do i = 1, plenest + estbl(i) = svp_trans(tmin + real(i-1,r8)) + end do + + if (masterproc) then + write(iulog,*)' *** SATURATION VAPOR PRESSURE TABLE COMPLETED ***' + end if + +end subroutine wv_sat_init + +subroutine wv_sat_final + !------------------------------------------------------------------! + ! Purpose: ! + ! Deallocate global variables in module. ! + !------------------------------------------------------------------! + use cam_abortutils, only: endrun + + integer :: status + + if (allocated(estbl)) then + + deallocate(estbl, stat=status) + + if (status /= 0) then + call endrun('wv_sat_final :: ERROR deallocating table') + return + end if + + end if + +end subroutine wv_sat_final + +!--------------------------------------------------------------------- +! DEFAULT SVP FUNCTIONS +!--------------------------------------------------------------------- + +! Compute saturation vapor pressure over water +elemental function svp_water(t) result(es) + + use wv_sat_methods, only: & + wv_sat_svp_water + + real(r8), intent(in) :: t ! Temperature (K) + real(r8) :: es ! SVP (Pa) + + es = wv_sat_svp_water(T) + +end function svp_water + +! Compute saturation vapor pressure over ice +elemental function svp_ice(t) result(es) + + use wv_sat_methods, only: & + wv_sat_svp_ice + + real(r8), intent(in) :: t ! Temperature (K) + real(r8) :: es ! SVP (Pa) + + es = wv_sat_svp_ice(T) + +end function svp_ice + +! Compute saturation vapor pressure with an ice-water transition +elemental function svp_trans(t) result(es) + + use wv_sat_methods, only: & + wv_sat_svp_trans + + real(r8), intent(in) :: t ! Temperature (K) + real(r8) :: es ! SVP (Pa) + + es = wv_sat_svp_trans(T) + +end function svp_trans + +!--------------------------------------------------------------------- +! UTILITIES +!--------------------------------------------------------------------- + +! Does linear interpolation from nearest values found +! in the table (estbl). +elemental function estblf(t) result(es) + + real(r8), intent(in) :: t ! Temperature + real(r8) :: es ! SVP (Pa) + + integer :: i ! Index for t in the table + real(r8) :: t_tmp ! intermediate temperature for es look-up + + real(r8) :: weight ! Weight for interpolation + + t_tmp = max(min(t,tmax)-tmin, 0._r8) ! Number of table entries above tmin + i = int(t_tmp) + 1 ! Corresponding index. + weight = t_tmp - aint(t_tmp, r8) ! Fractional part of t_tmp (for interpolation). + es = (1._r8 - weight)*estbl(i) + weight*estbl(i+1) + +end function estblf + +! Get enthalpy based only on temperature +! and specific humidity. +elemental function tq_enthalpy(t, q, hltalt) result(enthalpy) + + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: q ! Specific humidity + real(r8), intent(in) :: hltalt ! Modified hlat for T derivatives + + real(r8) :: enthalpy + + enthalpy = cpair * t + hltalt * q + +end function tq_enthalpy + +!--------------------------------------------------------------------- +! LATENT HEAT OF VAPORIZATION CORRECTIONS +!--------------------------------------------------------------------- + +elemental subroutine no_ip_hltalt(t, hltalt) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate latent heat of vaporization of pure liquid water at ! + ! a given temperature. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + ! Outputs + real(r8), intent(out) :: hltalt ! Appropriately modified hlat + + hltalt = latvap + + ! Account for change of latvap with t above freezing where + ! constant slope is given by -2369 j/(kg c) = cpv - cw + if (t >= tmelt) then + hltalt = hltalt - 2369.0_r8*(t-tmelt) + end if + +end subroutine no_ip_hltalt + +elemental subroutine calc_hltalt(t, hltalt, tterm) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate latent heat of vaporization of water at a given ! + ! temperature, taking into account the ice phase if temperature ! + ! is below freezing. ! + ! Optional argument also calculates a term used to calculate ! + ! d(es)/dT within the water-ice transition range. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + ! Outputs + real(r8), intent(out) :: hltalt ! Appropriately modified hlat + ! Term to account for d(es)/dT in transition region. + real(r8), intent(out), optional :: tterm + + ! Local variables + real(r8) :: tc ! Temperature in degrees C + real(r8) :: weight ! Weight for es transition from water to ice + ! Loop iterator + integer :: i + + if (present(tterm)) tterm = 0.0_r8 + + call no_ip_hltalt(t,hltalt) + if (t < tmelt) then + ! Weighting of hlat accounts for transition from water to ice. + tc = t - tmelt + + if (tc >= -ttrice) then + weight = -tc/ttrice + + ! polynomial expression approximates difference between es + ! over water and es over ice from 0 to -ttrice (C) (max of + ! ttrice is 40): required for accurate estimate of es + ! derivative in transition range from ice to water + if (present(tterm)) then + do i = size(pcf), 1, -1 + tterm = pcf(i) + tc*tterm + end do + tterm = tterm/ttrice + end if + + else + weight = 1.0_r8 + end if + + hltalt = hltalt + weight*latice + + end if + +end subroutine calc_hltalt + +!--------------------------------------------------------------------- +! OPTIONAL OUTPUTS +!--------------------------------------------------------------------- + +! Temperature derivative outputs, for qsat_* +elemental subroutine deriv_outputs(t, p, es, qs, hltalt, tterm, & + gam, dqsdt) + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + real(r8), intent(in) :: es ! Saturation vapor pressure + real(r8), intent(in) :: qs ! Saturation specific humidity + real(r8), intent(in) :: hltalt ! Modified latent heat + real(r8), intent(in) :: tterm ! Extra term for d(es)/dT in + ! transition region. + + ! Outputs + real(r8), intent(out), optional :: gam ! (hltalt/cpair)*(d(qs)/dt) + real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) + + ! Local variables + real(r8) :: desdt ! d(es)/dt + real(r8) :: dqsdt_loc ! local copy of dqsdt + + if (qs == 1.0_r8) then + dqsdt_loc = 0._r8 + else + desdt = hltalt*es/(rh2o*t*t) + tterm + dqsdt_loc = qs*p*desdt/(es*(p-omeps*es)) + end if + + if (present(dqsdt)) dqsdt = dqsdt_loc + if (present(gam)) gam = dqsdt_loc * (hltalt/cpair) + +end subroutine deriv_outputs + +!--------------------------------------------------------------------- +! QSAT (SPECIFIC HUMIDITY) PROCEDURES +!--------------------------------------------------------------------- + +elemental subroutine qsat(t, p, es, qs, gam, dqsdt, enthalpy) + !------------------------------------------------------------------! + ! Purpose: ! + ! Look up and return saturation vapor pressure from precomputed ! + ! table, then calculate and return saturation specific humidity. ! + ! Optionally return various temperature derivatives or enthalpy ! + ! at saturation. ! + !------------------------------------------------------------------! + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) + real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) + real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q + + ! Local variables + real(r8) :: hltalt ! Modified latent heat for T derivatives + real(r8) :: tterm ! Account for d(es)/dT in transition region + + es = estblf(t) + + qs = svp_to_qsat(es, p) + + ! Ensures returned es is consistent with limiters on qs. + es = min(es, p) + + ! Calculate optional arguments. + if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then + + ! "generalized" analytic expression for t derivative of es + ! accurate to within 1 percent for 173.16 < t < 373.16 + call calc_hltalt(t, hltalt, tterm) + + if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) + + call deriv_outputs(t, p, es, qs, hltalt, tterm, & + gam=gam, dqsdt=dqsdt) + + end if + +end subroutine qsat + +elemental subroutine qsat_water(t, p, es, qs, gam, dqsdt, enthalpy) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate SVP over water at a given temperature, and then ! + ! calculate and return saturation specific humidity. ! + ! Optionally return various temperature derivatives or enthalpy ! + ! at saturation. ! + !------------------------------------------------------------------! + + use wv_sat_methods, only: wv_sat_qsat_water + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) + real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) + real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q + + ! Local variables + real(r8) :: hltalt ! Modified latent heat for T derivatives + + call wv_sat_qsat_water(t, p, es, qs) + + if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then + + ! "generalized" analytic expression for t derivative of es + ! accurate to within 1 percent for 173.16 < t < 373.16 + call no_ip_hltalt(t, hltalt) + + if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) + + ! For pure water/ice transition term is 0. + call deriv_outputs(t, p, es, qs, hltalt, 0._r8, & + gam=gam, dqsdt=dqsdt) + + end if + +end subroutine qsat_water + +elemental subroutine qsat_ice(t, p, es, qs, gam, dqsdt, enthalpy) + !------------------------------------------------------------------! + ! Purpose: ! + ! Calculate SVP over ice at a given temperature, and then ! + ! calculate and return saturation specific humidity. ! + ! Optionally return various temperature derivatives or enthalpy ! + ! at saturation. ! + !------------------------------------------------------------------! + + use wv_sat_methods, only: wv_sat_qsat_ice + + ! Inputs + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: p ! Pressure + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure + real(r8), intent(out) :: qs ! Saturation specific humidity + + real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) + real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) + real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q + + ! Local variables + real(r8) :: hltalt ! Modified latent heat for T derivatives + + call wv_sat_qsat_ice(t, p, es, qs) + + if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then + + ! For pure ice, just add latent heats. + hltalt = latvap + latice + + if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) + + ! For pure water/ice transition term is 0. + call deriv_outputs(t, p, es, qs, hltalt, 0._r8, & + gam=gam, dqsdt=dqsdt) + + end if + +end subroutine qsat_ice + +!--------------------------------------------------------------------- +! FINDSP (WET BULB TEMPERATURE) PROCEDURES +!--------------------------------------------------------------------- + +subroutine findsp_vc(q, t, p, use_ice, tsp, qsp) + + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + ! Wrapper for findsp which is 1D and handles the output status. + ! Changing findsp to elemental restricted debugging output. + ! If that output is needed again, it's preferable *not* to copy findsp, + ! but to change the existing version. + + ! input arguments + real(r8), intent(in) :: q(:) ! water vapor (kg/kg) + real(r8), intent(in) :: t(:) ! temperature (K) + real(r8), intent(in) :: p(:) ! pressure (Pa) + logical, intent(in) :: use_ice ! flag to include ice phase in calculations + + ! output arguments + real(r8), intent(out) :: tsp(:) ! saturation temp (K) + real(r8), intent(out) :: qsp(:) ! saturation mixing ratio (kg/kg) + + integer :: status(size(q)) ! flag representing state of output + ! 0 => Successful convergence + ! 1 => No calculation done: pressure or specific + ! humidity not within usable range + ! 2 => Run failed to converge + ! 4 => Temperature fell below minimum + ! 8 => Enthalpy not conserved + + integer :: n, i + + n = size(q) + + call findsp(q, t, p, use_ice, tsp, qsp, status) + + ! Currently, only 2 and 8 seem to be treated as fatal errors. + do i = 1,n + if (status(i) == 2) then + write(iulog,*) ' findsp not converging at i = ', i + write(iulog,*) ' t, q, p ', t(i), q(i), p(i) + write(iulog,*) ' tsp, qsp ', tsp(i), qsp(i) + call endrun ('wv_saturation::FINDSP -- not converging') + else if (status(i) == 8) then + write(iulog,*) ' the enthalpy is not conserved at i = ', i + write(iulog,*) ' t, q, p ', t(i), q(i), p(i) + write(iulog,*) ' tsp, qsp ', tsp(i), qsp(i) + call endrun ('wv_saturation::FINDSP -- enthalpy is not conserved') + endif + end do + +end subroutine findsp_vc + +elemental subroutine findsp (q, t, p, use_ice, tsp, qsp, status) +!----------------------------------------------------------------------- +! +! Purpose: +! find the wet bulb temperature for a given t and q +! in a longitude height section +! wet bulb temp is the temperature and spec humidity that is +! just saturated and has the same enthalpy +! if q > qs(t) then tsp > t and qsp = qs(tsp) < q +! if q < qs(t) then tsp < t and qsp = qs(tsp) > q +! +! Method: +! a Newton method is used +! first guess uses an algorithm provided by John Petch from the UKMO +! we exclude points where the physical situation is unrealistic +! e.g. where the temperature is outside the range of validity for the +! saturation vapor pressure, or where the water vapor pressure +! exceeds the ambient pressure, or the saturation specific humidity is +! unrealistic +! +! Author: P. Rasch +! +!----------------------------------------------------------------------- +! +! input arguments +! + + real(r8), intent(in) :: q ! water vapor (kg/kg) + real(r8), intent(in) :: t ! temperature (K) + real(r8), intent(in) :: p ! pressure (Pa) + logical, intent(in) :: use_ice ! flag to include ice phase in calculations +! +! output arguments +! + real(r8), intent(out) :: tsp ! saturation temp (K) + real(r8), intent(out) :: qsp ! saturation mixing ratio (kg/kg) + integer, intent(out) :: status ! flag representing state of output + ! 0 => Successful convergence + ! 1 => No calculation done: pressure or specific + ! humidity not within usable range + ! 2 => Run failed to converge + ! 4 => Temperature fell below minimum + ! 8 => Enthalpy not conserved +! +! local variables +! + integer, parameter :: iter = 8 ! max number of times to iterate the calculation + integer :: l ! iterator + + real(r8) es ! sat. vapor pressure + real(r8) gam ! change in sat spec. hum. wrt temperature (times hltalt/cpair) + real(r8) dgdt ! work variable + real(r8) g ! work variable + real(r8) hltalt ! lat. heat. of vap. + real(r8) qs ! spec. hum. of water vapor + +! work variables + real(r8) t1, q1, dt, dq + real(r8) qvd + real(r8) r1b, c1, c2 + real(r8), parameter :: dttol = 1.e-4_r8 ! the relative temp error tolerance required to quit the iteration + real(r8), parameter :: dqtol = 1.e-4_r8 ! the relative moisture error tolerance required to quit the iteration + real(r8) enin, enout + + ! Saturation specific humidity at this temperature + if (use_ice) then + call qsat(t, p, es, qs) + else + call qsat_water(t, p, es, qs) + end if + + ! make sure a meaningful calculation is possible + if (p <= 5._r8*es .or. qs <= 0._r8 .or. qs >= 0.5_r8 & + .or. t < tmin .or. t > tmax) then + status = 1 + ! Keep initial parameters when conditions aren't suitable + tsp = t + qsp = q + enin = 1._r8 + enout = 1._r8 + + return + end if + + ! Prepare to iterate + status = 2 + + ! Get initial enthalpy + if (use_ice) then + call calc_hltalt(t,hltalt) + else + call no_ip_hltalt(t,hltalt) + end if + enin = tq_enthalpy(t, q, hltalt) + + ! make a guess at the wet bulb temp using a UKMO algorithm (from J. Petch) + c1 = hltalt*c3 + c2 = (t + 36._r8)**2 + r1b = c2/(c2 + c1*qs) + qvd = r1b * (q - qs) + tsp = t + ((hltalt/cpair)*qvd) + + ! Generate qsp, gam, and enout from tsp. + if (use_ice) then + call qsat(tsp, p, es, qsp, gam=gam, enthalpy=enout) + else + call qsat_water(tsp, p, es, qsp, gam=gam, enthalpy=enout) + end if + + ! iterate on first guess + do l = 1, iter + + g = enin - enout + dgdt = -cpair * (1 + gam) + + ! New tsp + t1 = tsp - g/dgdt + dt = abs(t1 - tsp)/t1 + tsp = t1 + + ! bail out if past end of temperature range + if ( tsp < tmin ) then + tsp = tmin + ! Get latent heat and set qsp to a value + ! that preserves enthalpy. + if (use_ice) then + call calc_hltalt(tsp,hltalt) + else + call no_ip_hltalt(tsp,hltalt) + end if + qsp = (enin - cpair*tsp)/hltalt + enout = tq_enthalpy(tsp, qsp, hltalt) + status = 4 + exit + end if + + ! Re-generate qsp, gam, and enout from new tsp. + if (use_ice) then + call qsat(tsp, p, es, q1, gam=gam, enthalpy=enout) + else + call qsat_water(tsp, p, es, q1, gam=gam, enthalpy=enout) + end if + dq = abs(q1 - qsp)/max(q1,1.e-12_r8) + qsp = q1 + + ! if converged at this point, exclude it from more iterations + if (dt < dttol .and. dq < dqtol) then + status = 0 + exit + endif + end do + + ! Test for enthalpy conservation + if (abs((enin-enout)/(enin+enout)) > 1.e-4_r8) status = 8 + +end subroutine findsp + +end module wv_saturation diff --git a/src/physics/cam/zm_conv.F90 b/src/physics/cam/zm_conv.F90 new file mode 100644 index 0000000000..99c2d36232 --- /dev/null +++ b/src/physics/cam/zm_conv.F90 @@ -0,0 +1,4722 @@ +module zm_conv + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Interface from Zhang-McFarlane convection scheme, includes evaporation of convective +! precip from the ZM scheme +! +! Apr 2006: RBN: Code added to perform a dilute ascent for closure of the CM mass flux +! based on an entraining plume a la Raymond and Blythe (1992) +! +! Author: Byron Boville, from code in tphysbc +! +!--------------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use cloud_fraction, only: cldfrc_fice + use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, & + cpwv, cpliq, rh2o + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use zm_microphysics, only: zm_mphy, zm_aero_t, zm_conv_t + + implicit none + + save + private ! Make default type private to the module +! +! PUBLIC: interfaces +! + public zm_convi ! ZM schemea + public zm_convr ! ZM schemea + public zm_conv_evap ! evaporation of precip from ZM schemea + public convtran ! convective transport + public momtran ! convective momentum transport + +! +! Private data +! + real(r8) rl ! wg latent heat of vaporization. + real(r8) cpres ! specific heat at constant pressure in j/kg-degk. + real(r8), parameter :: capelmt = 70._r8 ! threshold value for cape for deep convection. + real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke + real(r8) :: ke_lnd + real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd + real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn + integer :: num_cin ! set from namelist input zmconv_num_cin + ! The number of negative buoyancy regions that are allowed + ! before the convection top and CAPE calculations are completed. + logical :: zm_org + real(r8) tau ! convective time scale + real(r8),parameter :: c1 = 6.112_r8 + real(r8),parameter :: c2 = 17.67_r8 + real(r8),parameter :: c3 = 243.5_r8 + real(r8) :: tfreez + real(r8) :: eps1 + real(r8) :: momcu + real(r8) :: momcd + + logical :: zmconv_microp + + logical :: no_deep_pbl ! default = .false. + ! no_deep_pbl = .true. eliminates deep convection entirely within PBL + + +!moved from moistconvection.F90 + real(r8) :: rgrav ! reciprocal of grav + real(r8) :: rgas ! gas constant for dry air + real(r8) :: grav ! = gravit + real(r8) :: cp ! = cpres = cpair + + integer limcnv ! top interface level limit for convection + + real(r8),parameter :: tiedke_add = 0.5_r8 + +contains + + +subroutine zm_convi(limcnv_in, zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & + zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & + zmconv_microp_in, no_deep_pbl_in) + + integer, intent(in) :: limcnv_in ! top interface level limit for convection + integer, intent(in) :: zmconv_num_cin ! Number negative buoyancy regions that are allowed + ! before the convection top and CAPE calculations are completed. + real(r8),intent(in) :: zmconv_c0_lnd + real(r8),intent(in) :: zmconv_c0_ocn + real(r8),intent(in) :: zmconv_ke + real(r8),intent(in) :: zmconv_ke_lnd + real(r8),intent(in) :: zmconv_momcu + real(r8),intent(in) :: zmconv_momcd + logical :: zmconv_org + logical, intent(in) :: zmconv_microp_in + logical, intent(in), optional :: no_deep_pbl_in ! no_deep_pbl = .true. eliminates ZM convection entirely within PBL + + + ! Initialization of ZM constants + limcnv = limcnv_in + tfreez = tmelt + eps1 = epsilo + rl = latvap + cpres = cpair + rgrav = 1.0_r8/gravit + rgas = rair + grav = gravit + cp = cpres + + c0_lnd = zmconv_c0_lnd + c0_ocn = zmconv_c0_ocn + num_cin = zmconv_num_cin + ke = zmconv_ke + ke_lnd = zmconv_ke_lnd + zm_org = zmconv_org + momcu = zmconv_momcu + momcd = zmconv_momcd + + zmconv_microp = zmconv_microp_in + + if ( present(no_deep_pbl_in) ) then + no_deep_pbl = no_deep_pbl_in + else + no_deep_pbl = .false. + endif + + tau = 3600._r8 + + if ( masterproc ) then + write(iulog,*) 'tuning parameters zm_convi: tau',tau + write(iulog,*) 'tuning parameters zm_convi: c0_lnd',c0_lnd, ', c0_ocn', c0_ocn + write(iulog,*) 'tuning parameters zm_convi: num_cin', num_cin + write(iulog,*) 'tuning parameters zm_convi: ke',ke + write(iulog,*) 'tuning parameters zm_convi: no_deep_pbl',no_deep_pbl + endif + + if (masterproc) write(iulog,*)'**** ZM: DILUTE Buoyancy Calculation ****' + +end subroutine zm_convi + + + +subroutine zm_convr(lchnk ,ncol , & + t ,qh ,prec ,jctop ,jcbot , & + pblh ,zm ,geos ,zi ,qtnd , & + heat ,pap ,paph ,dpp , & + delt ,mcon ,cme ,cape , & + tpert ,dlf ,pflx ,zdu ,rprd , & + mu ,md ,du ,eu ,ed , & + dp ,dsubcld ,jt ,maxg ,ideep , & + ql ,rliq ,landfrac, & + org ,orgt ,org2d , & + dif ,dnlf ,dnif ,conv , & + aero , rice) +!----------------------------------------------------------------------- +! +! Purpose: +! Main driver for zhang-mcfarlane convection scheme +! +! Method: +! performs deep convective adjustment based on mass-flux closure +! algorithm. +! +! Author:guang jun zhang, m.lazare, n.mcfarlane. CAM Contact: P. Rasch +! +! This is contributed code not fully standardized by the CAM core group. +! All variables have been typed, where most are identified in comments +! The current procedure will be reimplemented in a subsequent version +! of the CAM where it will include a more straightforward formulation +! and will make use of the standard CAM nomenclature +! +!----------------------------------------------------------------------- + use phys_control, only: cam_physpkg_is + +! +! ************************ index of variables ********************** +! +! wg * alpha array of vertical differencing used (=1. for upstream). +! w * cape convective available potential energy. +! wg * capeg gathered convective available potential energy. +! c * capelmt threshold value for cape for deep convection. +! ic * cpres specific heat at constant pressure in j/kg-degk. +! i * dpp +! ic * delt length of model time-step in seconds. +! wg * dp layer thickness in mbs (between upper/lower interface). +! wg * dqdt mixing ratio tendency at gathered points. +! wg * dsdt dry static energy ("temp") tendency at gathered points. +! wg * dudt u-wind tendency at gathered points. +! wg * dvdt v-wind tendency at gathered points. +! wg * dsubcld layer thickness in mbs between lcl and maxi. +! ic * grav acceleration due to gravity in m/sec2. +! wg * du detrainment in updraft. specified in mid-layer +! wg * ed entrainment in downdraft. +! wg * eu entrainment in updraft. +! wg * hmn moist static energy. +! wg * hsat saturated moist static energy. +! w * ideep holds position of gathered points vs longitude index. +! ic * pver number of model levels. +! wg * j0 detrainment initiation level index. +! wg * jd downdraft initiation level index. +! ic * jlatpr gaussian latitude index for printing grids (if needed). +! wg * jt top level index of deep cumulus convection. +! w * lcl base level index of deep cumulus convection. +! wg * lclg gathered values of lcl. +! w * lel index of highest theoretical convective plume. +! wg * lelg gathered values of lel. +! w * lon index of onset level for deep convection. +! w * maxi index of level with largest moist static energy. +! wg * maxg gathered values of maxi. +! wg * mb cloud base mass flux. +! wg * mc net upward (scaled by mb) cloud mass flux. +! wg * md downward cloud mass flux (positive up). +! wg * mu upward cloud mass flux (positive up). specified +! at interface +! ic * msg number of missing moisture levels at the top of model. +! w * p grid slice of ambient mid-layer pressure in mbs. +! i * pblt row of pbl top indices. +! w * pcpdh scaled surface pressure. +! w * pf grid slice of ambient interface pressure in mbs. +! wg * pg grid slice of gathered values of p. +! w * q grid slice of mixing ratio. +! wg * qd grid slice of mixing ratio in downdraft. +! wg * qg grid slice of gathered values of q. +! i/o * qh grid slice of specific humidity. +! w * qh0 grid slice of initial specific humidity. +! wg * qhat grid slice of upper interface mixing ratio. +! wg * ql grid slice of cloud liquid water. +! wg * qs grid slice of saturation mixing ratio. +! w * qstp grid slice of parcel temp. saturation mixing ratio. +! wg * qstpg grid slice of gathered values of qstp. +! wg * qu grid slice of mixing ratio in updraft. +! ic * rgas dry air gas constant. +! wg * rl latent heat of vaporization. +! w * s grid slice of scaled dry static energy (t+gz/cp). +! wg * sd grid slice of dry static energy in downdraft. +! wg * sg grid slice of gathered values of s. +! wg * shat grid slice of upper interface dry static energy. +! wg * su grid slice of dry static energy in updraft. +! i/o * t +! o * jctop row of top-of-deep-convection indices passed out. +! O * jcbot row of base of cloud indices passed out. +! wg * tg grid slice of gathered values of t. +! w * tl row of parcel temperature at lcl. +! wg * tlg grid slice of gathered values of tl. +! w * tp grid slice of parcel temperatures. +! wg * tpg grid slice of gathered values of tp. +! i/o * u grid slice of u-wind (real). +! wg * ug grid slice of gathered values of u. +! i/o * utg grid slice of u-wind tendency (real). +! i/o * v grid slice of v-wind (real). +! w * va work array re-used by called subroutines. +! wg * vg grid slice of gathered values of v. +! i/o * vtg grid slice of v-wind tendency (real). +! i * w grid slice of diagnosed large-scale vertical velocity. +! w * z grid slice of ambient mid-layer height in metres. +! w * zf grid slice of ambient interface height in metres. +! wg * zfg grid slice of gathered values of zf. +! wg * zg grid slice of gathered values of z. +! +!----------------------------------------------------------------------- +! +! multi-level i/o fields: +! i => input arrays. +! i/o => input/output arrays. +! w => work arrays. +! wg => work arrays operating only on gathered points. +! ic => input data constants. +! c => data constants pertaining to subroutine itself. +! +! input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: t(pcols,pver) ! grid slice of temperature at mid-layer. + real(r8), intent(in) :: qh(pcols,pver) ! grid slice of specific humidity. + real(r8), intent(in) :: pap(pcols,pver) + real(r8), intent(in) :: paph(pcols,pver+1) + real(r8), intent(in) :: dpp(pcols,pver) ! local sigma half-level thickness (i.e. dshj). + real(r8), intent(in) :: zm(pcols,pver) + real(r8), intent(in) :: geos(pcols) + real(r8), intent(in) :: zi(pcols,pver+1) + real(r8), intent(in) :: pblh(pcols) + real(r8), intent(in) :: tpert(pcols) + real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac + + type(zm_conv_t), intent(inout) :: conv + type(zm_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the + ! gathered arrays are set here + ! before passing object + ! to microphysics +! output arguments +! + real(r8), intent(out) :: qtnd(pcols,pver) ! specific humidity tendency (kg/kg/s) + real(r8), intent(out) :: heat(pcols,pver) ! heating rate (dry static energy tendency, W/kg) + real(r8), intent(out) :: mcon(pcols,pverp) + real(r8), intent(out) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend + real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level + real(r8), intent(out) :: cme(pcols,pver) + real(r8), intent(out) :: cape(pcols) ! w convective available potential energy. + real(r8), intent(out) :: zdu(pcols,pver) + real(r8), intent(out) :: rprd(pcols,pver) ! rain production rate + real(r8), intent(out) :: dif(pcols,pver) ! detrained convective cloud ice mixing ratio. + real(r8), intent(out) :: dnlf(pcols,pver) ! detrained convective cloud water num concen. + real(r8), intent(out) :: dnif(pcols,pver) ! detrained convective cloud ice num concen. + +! move these vars from local storage to output so that convective +! transports can be done in outside of conv_cam. + real(r8), intent(out) :: mu(pcols,pver) + real(r8), intent(out) :: eu(pcols,pver) + real(r8), intent(out) :: du(pcols,pver) + real(r8), intent(out) :: md(pcols,pver) + real(r8), intent(out) :: ed(pcols,pver) + real(r8), intent(out) :: dp(pcols,pver) ! wg layer thickness in mbs (between upper/lower interface). + real(r8), intent(out) :: dsubcld(pcols) ! wg layer thickness in mbs between lcl and maxi. + real(r8), intent(out) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. + real(r8), intent(out) :: jcbot(pcols) ! o row of base of cloud indices passed out. + real(r8), intent(out) :: prec(pcols) + real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals + real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals + + integer, intent(out) :: ideep(pcols) ! column indices of gathered points + + type(zm_conv_t) :: loc_conv + + real(r8), pointer :: org(:,:) ! Only used if zm_org is true + real(r8), pointer :: orgt(:,:) ! Only used if zm_org is true + real(r8), pointer :: org2d(:,:) ! Only used if zm_org is true + + real(r8) zs(pcols) + real(r8) dlg(pcols,pver) ! gathrd version of the detraining cld h2o tend + real(r8) pflxg(pcols,pverp) ! gather precip flux at each level + real(r8) cug(pcols,pver) ! gathered condensation rate + + real(r8) evpg(pcols,pver) ! gathered evap rate of rain in downdraft + real(r8) orgavg(pcols) + real(r8) dptot(pcols) + real(r8) mumax(pcols) + integer jt(pcols) ! wg top level index of deep cumulus convection. + integer maxg(pcols) ! wg gathered values of maxi. + integer lengath +! diagnostic field used by chem/wetdep codes + real(r8) ql(pcols,pver) ! wg grid slice of cloud liquid water. +! + real(r8) pblt(pcols) ! i row of pbl top indices. + + + + +! +!----------------------------------------------------------------------- +! +! general work fields (local variables): +! + real(r8) q(pcols,pver) ! w grid slice of mixing ratio. + real(r8) p(pcols,pver) ! w grid slice of ambient mid-layer pressure in mbs. + real(r8) z(pcols,pver) ! w grid slice of ambient mid-layer height in metres. + real(r8) s(pcols,pver) ! w grid slice of scaled dry static energy (t+gz/cp). + real(r8) tp(pcols,pver) ! w grid slice of parcel temperatures. + real(r8) zf(pcols,pver+1) ! w grid slice of ambient interface height in metres. + real(r8) pf(pcols,pver+1) ! w grid slice of ambient interface pressure in mbs. + real(r8) qstp(pcols,pver) ! w grid slice of parcel temp. saturation mixing ratio. + + real(r8) tl(pcols) ! w row of parcel temperature at lcl. + + integer lcl(pcols) ! w base level index of deep cumulus convection. + integer lel(pcols) ! w index of highest theoretical convective plume. + integer lon(pcols) ! w index of onset level for deep convection. + integer maxi(pcols) ! w index of level with largest moist static energy. + + real(r8) precip +! +! gathered work fields: +! + real(r8) qg(pcols,pver) ! wg grid slice of gathered values of q. + real(r8) tg(pcols,pver) ! w grid slice of temperature at interface. + real(r8) pg(pcols,pver) ! wg grid slice of gathered values of p. + real(r8) zg(pcols,pver) ! wg grid slice of gathered values of z. + real(r8) sg(pcols,pver) ! wg grid slice of gathered values of s. + real(r8) tpg(pcols,pver) ! wg grid slice of gathered values of tp. + real(r8) zfg(pcols,pver+1) ! wg grid slice of gathered values of zf. + real(r8) qstpg(pcols,pver) ! wg grid slice of gathered values of qstp. + real(r8) ug(pcols,pver) ! wg grid slice of gathered values of u. + real(r8) vg(pcols,pver) ! wg grid slice of gathered values of v. + real(r8) cmeg(pcols,pver) + + real(r8) rprdg(pcols,pver) ! wg gathered rain production rate + real(r8) capeg(pcols) ! wg gathered convective available potential energy. + real(r8) tlg(pcols) ! wg grid slice of gathered values of tl. + real(r8) landfracg(pcols) ! wg grid slice of landfrac + + integer lclg(pcols) ! wg gathered values of lcl. + integer lelg(pcols) +! +! work fields arising from gathered calculations. +! + real(r8) dqdt(pcols,pver) ! wg mixing ratio tendency at gathered points. + real(r8) dsdt(pcols,pver) ! wg dry static energy ("temp") tendency at gathered points. +! real(r8) alpha(pcols,pver) ! array of vertical differencing used (=1. for upstream). + real(r8) sd(pcols,pver) ! wg grid slice of dry static energy in downdraft. + real(r8) qd(pcols,pver) ! wg grid slice of mixing ratio in downdraft. + real(r8) mc(pcols,pver) ! wg net upward (scaled by mb) cloud mass flux. + real(r8) qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. + real(r8) qu(pcols,pver) ! wg grid slice of mixing ratio in updraft. + real(r8) su(pcols,pver) ! wg grid slice of dry static energy in updraft. + real(r8) qs(pcols,pver) ! wg grid slice of saturation mixing ratio. + real(r8) shat(pcols,pver) ! wg grid slice of upper interface dry static energy. + real(r8) hmn(pcols,pver) ! wg moist static energy. + real(r8) hsat(pcols,pver) ! wg saturated moist static energy. + real(r8) qlg(pcols,pver) + real(r8) dudt(pcols,pver) ! wg u-wind tendency at gathered points. + real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points. +! real(r8) ud(pcols,pver) +! real(r8) vd(pcols,pver) + + + + + + + + real(r8) qldeg(pcols,pver) ! cloud liquid water mixing ratio for detrainment (kg/kg) + real(r8) mb(pcols) ! wg cloud base mass flux. + + integer jlcl(pcols) + integer j0(pcols) ! wg detrainment initiation level index. + integer jd(pcols) ! wg downdraft initiation level index. + + real(r8) delt ! length of model time-step in seconds. + + integer i + integer ii + integer k, kk, l, m + + integer msg ! ic number of missing moisture levels at the top of model. + real(r8) qdifr + real(r8) sdifr + + real(r8), parameter :: dcon = 25.e-6_r8 + real(r8), parameter :: mucon = 5.3_r8 + real(r8) negadq + logical doliq + + +! +!--------------------------Data statements------------------------------ + +! +! Set internal variable "msg" (convection limit) to "limcnv-1" +! + msg = limcnv - 1 +! +! initialize necessary arrays. +! zero out variables not used in cam +! + + if (zm_org) then + orgt(:,:) = 0._r8 + end if + + qtnd(:,:) = 0._r8 + heat(:,:) = 0._r8 + mcon(:,:) = 0._r8 + rliq(:ncol) = 0._r8 + rice(:ncol) = 0._r8 + + if (zmconv_microp) then + allocate( & + loc_conv%frz(pcols,pver), & + loc_conv%sprd(pcols,pver), & + loc_conv%wu(pcols,pver), & + loc_conv%qi(pcols,pver), & + loc_conv%qliq(pcols,pver), & + loc_conv%qice(pcols,pver), & + loc_conv%qrain(pcols,pver), & + loc_conv%qsnow(pcols,pver), & + loc_conv%di(pcols,pver), & + loc_conv%dnl(pcols,pver), & + loc_conv%dni(pcols,pver), & + loc_conv%qnl(pcols,pver), & + loc_conv%qni(pcols,pver), & + loc_conv%qnr(pcols,pver), & + loc_conv%qns(pcols,pver), & + loc_conv%qide(pcols,pver), & + loc_conv%qncde(pcols,pver), & + loc_conv%qnide(pcols,pver), & + loc_conv%autolm(pcols,pver), & + loc_conv%accrlm(pcols,pver), & + loc_conv%bergnm(pcols,pver), & + loc_conv%fhtimm(pcols,pver), & + loc_conv%fhtctm(pcols,pver), & + loc_conv%fhmlm(pcols,pver), & + loc_conv%hmpim(pcols,pver), & + loc_conv%accslm(pcols,pver), & + loc_conv%dlfm(pcols,pver), & + loc_conv%cmel(pcols,pver), & + loc_conv%autoln(pcols,pver), & + loc_conv%accrln(pcols,pver), & + loc_conv%bergnn(pcols,pver), & + loc_conv%fhtimn(pcols,pver), & + loc_conv%fhtctn(pcols,pver), & + loc_conv%fhmln(pcols,pver), & + loc_conv%accsln(pcols,pver), & + loc_conv%activn(pcols,pver), & + loc_conv%dlfn(pcols,pver), & + loc_conv%autoim(pcols,pver), & + loc_conv%accsim(pcols,pver), & + loc_conv%difm(pcols,pver), & + loc_conv%cmei(pcols,pver), & + loc_conv%nuclin(pcols,pver), & + loc_conv%autoin(pcols,pver), & + loc_conv%accsin(pcols,pver), & + loc_conv%hmpin(pcols,pver), & + loc_conv%difn(pcols,pver), & + loc_conv%trspcm(pcols,pver), & + loc_conv%trspcn(pcols,pver), & + loc_conv%trspim(pcols,pver), & + loc_conv%trspin(pcols,pver), & + loc_conv%lambdadpcu(pcols,pver), & + loc_conv%mudpcu(pcols,pver), & + loc_conv%dcape(pcols) ) + end if + +! +! initialize convective tendencies +! + prec(:ncol) = 0._r8 + do k = 1,pver + do i = 1,ncol + dqdt(i,k) = 0._r8 + dsdt(i,k) = 0._r8 + dudt(i,k) = 0._r8 + dvdt(i,k) = 0._r8 + pflx(i,k) = 0._r8 + pflxg(i,k) = 0._r8 + cme(i,k) = 0._r8 + rprd(i,k) = 0._r8 + zdu(i,k) = 0._r8 + ql(i,k) = 0._r8 + qlg(i,k) = 0._r8 + dlf(i,k) = 0._r8 + dlg(i,k) = 0._r8 + qldeg(i,k) = 0._r8 + + dif(i,k) = 0._r8 + dnlf(i,k) = 0._r8 + dnif(i,k) = 0._r8 + + end do + end do + + if (zmconv_microp) then + do k = 1,pver + do i = 1,ncol + loc_conv%qliq(i,k) = 0._r8 + loc_conv%qice(i,k) = 0._r8 + loc_conv%di(i,k) = 0._r8 + loc_conv%qrain(i,k)= 0._r8 + loc_conv%qsnow(i,k)= 0._r8 + loc_conv%dnl(i,k) = 0._r8 + loc_conv%dni(i,k) = 0._r8 + loc_conv%wu(i,k) = 0._r8 + loc_conv%qnl(i,k) = 0._r8 + loc_conv%qni(i,k) = 0._r8 + loc_conv%qnr(i,k) = 0._r8 + loc_conv%qns(i,k) = 0._r8 + loc_conv%frz(i,k) = 0._r8 + loc_conv%sprd(i,k) = 0._r8 + loc_conv%qide(i,k) = 0._r8 + loc_conv%qncde(i,k) = 0._r8 + loc_conv%qnide(i,k) = 0._r8 + + loc_conv%autolm(i,k) = 0._r8 + loc_conv%accrlm(i,k) = 0._r8 + loc_conv%bergnm(i,k) = 0._r8 + loc_conv%fhtimm(i,k) = 0._r8 + loc_conv%fhtctm(i,k) = 0._r8 + loc_conv%fhmlm (i,k) = 0._r8 + loc_conv%hmpim (i,k) = 0._r8 + loc_conv%accslm(i,k) = 0._r8 + loc_conv%dlfm (i,k) = 0._r8 + + loc_conv%autoln(i,k) = 0._r8 + loc_conv%accrln(i,k) = 0._r8 + loc_conv%bergnn(i,k) = 0._r8 + loc_conv%fhtimn(i,k) = 0._r8 + loc_conv%fhtctn(i,k) = 0._r8 + loc_conv%fhmln (i,k) = 0._r8 + loc_conv%accsln(i,k) = 0._r8 + loc_conv%activn(i,k) = 0._r8 + loc_conv%dlfn (i,k) = 0._r8 + loc_conv%cmel (i,k) = 0._r8 + + loc_conv%autoim(i,k) = 0._r8 + loc_conv%accsim(i,k) = 0._r8 + loc_conv%difm (i,k) = 0._r8 + loc_conv%cmei (i,k) = 0._r8 + + loc_conv%nuclin(i,k) = 0._r8 + loc_conv%autoin(i,k) = 0._r8 + loc_conv%accsin(i,k) = 0._r8 + loc_conv%hmpin (i,k) = 0._r8 + loc_conv%difn (i,k) = 0._r8 + + loc_conv%trspcm(i,k) = 0._r8 + loc_conv%trspcn(i,k) = 0._r8 + loc_conv%trspim(i,k) = 0._r8 + loc_conv%trspin(i,k) = 0._r8 + + conv%qi(i,k) = 0._r8 + conv%frz(i,k) = 0._r8 + conv%sprd(i,k) = 0._r8 + conv%qi(i,k) = 0._r8 + conv%qliq(i,k) = 0._r8 + conv%qice(i,k) = 0._r8 + conv%qnl(i,k) = 0._r8 + conv%qni(i,k) = 0._r8 + conv%qnr(i,k) = 0._r8 + conv%qns(i,k) = 0._r8 + conv%qrain(i,k) = 0._r8 + conv%qsnow(i,k) = 0._r8 + conv%wu(i,k) = 0._r8 + + conv%autolm(i,k) = 0._r8 + conv%accrlm(i,k) = 0._r8 + conv%bergnm(i,k) = 0._r8 + conv%fhtimm(i,k) = 0._r8 + conv%fhtctm(i,k) = 0._r8 + conv%fhmlm (i,k) = 0._r8 + conv%hmpim (i,k) = 0._r8 + conv%accslm(i,k) = 0._r8 + conv%dlfm (i,k) = 0._r8 + + conv%autoln(i,k) = 0._r8 + conv%accrln(i,k) = 0._r8 + conv%bergnn(i,k) = 0._r8 + conv%fhtimn(i,k) = 0._r8 + conv%fhtctn(i,k) = 0._r8 + conv%fhmln (i,k) = 0._r8 + conv%accsln(i,k) = 0._r8 + conv%activn(i,k) = 0._r8 + conv%dlfn (i,k) = 0._r8 + conv%cmel (i,k) = 0._r8 + + conv%autoim(i,k) = 0._r8 + conv%accsim(i,k) = 0._r8 + conv%difm (i,k) = 0._r8 + conv%cmei (i,k) = 0._r8 + + conv%nuclin(i,k) = 0._r8 + conv%autoin(i,k) = 0._r8 + conv%accsin(i,k) = 0._r8 + conv%hmpin (i,k) = 0._r8 + conv%difn (i,k) = 0._r8 + + conv%trspcm(i,k) = 0._r8 + conv%trspcn(i,k) = 0._r8 + conv%trspim(i,k) = 0._r8 + conv%trspin(i,k) = 0._r8 + + end do + end do + + conv%lambdadpcu = (mucon + 1._r8)/dcon + conv%mudpcu = mucon + loc_conv%lambdadpcu = conv%lambdadpcu + loc_conv%mudpcu = conv%mudpcu + + end if + + do i = 1,ncol + pflx(i,pverp) = 0 + pflxg(i,pverp) = 0 + end do +! + do i = 1,ncol + pblt(i) = pver + dsubcld(i) = 0._r8 + + + jctop(i) = pver + jcbot(i) = 1 + + end do + + if (zmconv_microp) then + do i = 1,ncol + conv%dcape(i) = 0._r8 + loc_conv%dcape(i) = 0._r8 + end do + end if + + if (zm_org) then +! compute vertical average here + orgavg(:) = 0._r8 + dptot(:) = 0._r8 + + do k = 1, pver + do i = 1,ncol + if (org(i,k) .gt. 0) then + orgavg(i) = orgavg(i)+dpp(i,k)*org(i,k) + dptot(i) = dptot(i)+dpp(i,k) + endif + enddo + enddo + + do i = 1,ncol + if (dptot(i) .gt. 0) then + orgavg(i) = orgavg(i)/dptot(i) + endif + enddo + + do k = 1, pver + do i = 1, ncol + org2d(i,k) = orgavg(i) + enddo + enddo + + endif + +! +! calculate local pressure (mbs) and height (m) for both interface +! and mid-layer locations. +! + do i = 1,ncol + zs(i) = geos(i)*rgrav + pf(i,pver+1) = paph(i,pver+1)*0.01_r8 + zf(i,pver+1) = zi(i,pver+1) + zs(i) + end do + do k = 1,pver + do i = 1,ncol + p(i,k) = pap(i,k)*0.01_r8 + pf(i,k) = paph(i,k)*0.01_r8 + z(i,k) = zm(i,k) + zs(i) + zf(i,k) = zi(i,k) + zs(i) + end do + end do +! + do k = pver - 1,msg + 1,-1 + do i = 1,ncol + if (abs(z(i,k)-zs(i)-pblh(i)) < (zf(i,k)-zf(i,k+1))*0.5_r8) pblt(i) = k + end do + end do +! +! store incoming specific humidity field for subsequent calculation +! of precipitation (through change in storage). +! define dry static energy (normalized by cp). +! + do k = 1,pver + do i = 1,ncol + q(i,k) = qh(i,k) + s(i,k) = t(i,k) + (grav/cpres)*z(i,k) + tp(i,k)=0.0_r8 + shat(i,k) = s(i,k) + qhat(i,k) = q(i,k) + end do + end do + + do i = 1,ncol + capeg(i) = 0._r8 + lclg(i) = 1 + lelg(i) = pver + maxg(i) = 1 + tlg(i) = 400._r8 + dsubcld(i) = 0._r8 + end do + + if( cam_physpkg_is('cam3')) then + + ! For cam3 physics package, call non-dilute + + call buoyan(lchnk ,ncol , & + q ,t ,p ,z ,pf , & + tp ,qstp ,tl ,rl ,cape , & + pblt ,lcl ,lel ,lon ,maxi , & + rgas ,grav ,cpres ,msg , & + tpert ) + else + + ! Evaluate Tparcel, qs(Tparcel), buoyancy and CAPE, + ! lcl, lel, parcel launch level at index maxi()=hmax + + call buoyan_dilute(lchnk ,ncol , & + q ,t ,p ,z ,pf , & + tp ,qstp ,tl ,rl ,cape , & + pblt ,lcl ,lel ,lon ,maxi , & + rgas ,grav ,cpres ,msg , & + tpert , org2d , landfrac) + end if + +! +! determine whether grid points will undergo some deep convection +! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel +! (require cape.gt. 0 and lel capelmt) then + lengath = lengath + 1 + ideep(lengath) = i + end if + end do + + if (lengath.eq.0) return +! +! obtain gathered arrays necessary for ensuing calculations. +! + do k = 1,pver + do i = 1,lengath + dp(i,k) = 0.01_r8*dpp(ideep(i),k) + qg(i,k) = q(ideep(i),k) + tg(i,k) = t(ideep(i),k) + pg(i,k) = p(ideep(i),k) + zg(i,k) = z(ideep(i),k) + sg(i,k) = s(ideep(i),k) + tpg(i,k) = tp(ideep(i),k) + zfg(i,k) = zf(ideep(i),k) + qstpg(i,k) = qstp(ideep(i),k) + ug(i,k) = 0._r8 + vg(i,k) = 0._r8 + end do + end do + + if (zmconv_microp) then + + if (aero%scheme == 'modal') then + + do m = 1, aero%nmodes + + do k = 1,pver + do i = 1,lengath + aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k) + aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k) + end do + end do + + do l = 1, aero%nspec(m) + do k = 1,pver + do i = 1,lengath + aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k) + end do + end do + end do + + end do + + else if (aero%scheme == 'bulk') then + + do m = 1, aero%nbulk + do k = 1,pver + do i = 1,lengath + aero%mmrg_bulk(i,k,m) = aero%mmr_bulk(m)%val(ideep(i),k) + end do + end do + end do + + end if + + end if + +! + do i = 1,lengath + zfg(i,pver+1) = zf(ideep(i),pver+1) + end do + do i = 1,lengath + capeg(i) = cape(ideep(i)) + lclg(i) = lcl(ideep(i)) + lelg(i) = lel(ideep(i)) + maxg(i) = maxi(ideep(i)) + tlg(i) = tl(ideep(i)) + landfracg(i) = landfrac(ideep(i)) + end do +! +! calculate sub-cloud layer pressure "thickness" for use in +! closure and tendency routines. +! + do k = msg + 1,pver + do i = 1,lengath + if (k >= maxg(i)) then + dsubcld(i) = dsubcld(i) + dp(i,k) + end if + end do + end do +! +! define array of factors (alpha) which defines interfacial +! values, as well as interfacial values for (q,s) used in +! subsequent routines. +! + do k = msg + 2,pver + do i = 1,lengath +! alpha(i,k) = 0.5 + sdifr = 0._r8 + qdifr = 0._r8 + if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) & + sdifr = abs((sg(i,k)-sg(i,k-1))/max(sg(i,k-1),sg(i,k))) + if (qg(i,k) > 0._r8 .or. qg(i,k-1) > 0._r8) & + qdifr = abs((qg(i,k)-qg(i,k-1))/max(qg(i,k-1),qg(i,k))) + if (sdifr > 1.E-6_r8) then + shat(i,k) = log(sg(i,k-1)/sg(i,k))*sg(i,k-1)*sg(i,k)/(sg(i,k-1)-sg(i,k)) + else + shat(i,k) = 0.5_r8* (sg(i,k)+sg(i,k-1)) + end if + if (qdifr > 1.E-6_r8) then + qhat(i,k) = log(qg(i,k-1)/qg(i,k))*qg(i,k-1)*qg(i,k)/(qg(i,k-1)-qg(i,k)) + else + qhat(i,k) = 0.5_r8* (qg(i,k)+qg(i,k-1)) + end if + end do + end do +! +! obtain cloud properties. +! + + call cldprp(lchnk , & + qg ,tg ,ug ,vg ,pg , & + zg ,sg ,mu ,eu ,du , & + md ,ed ,sd ,qd ,mc , & + qu ,su ,zfg ,qs ,hmn , & + hsat ,shat ,qlg , & + cmeg ,maxg ,lelg ,jt ,jlcl , & + maxg ,j0 ,jd ,rl ,lengath , & + rgas ,grav ,cpres ,msg , & + pflxg ,evpg ,cug ,rprdg ,limcnv ,landfracg , & + qldeg ,aero ,loc_conv,qhat ) + + if (zmconv_microp) then + do i = 1,lengath + capeg(i) = capeg(i)+ loc_conv%dcape(i) + end do + end if + +! +! convert detrainment from units of "1/m" to "1/mb". +! + + do k = msg + 1,pver + do i = 1,lengath + du (i,k) = du (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + eu (i,k) = eu (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + cmeg (i,k) = cmeg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + end do + end do + + if (zmconv_microp) then + do k = msg + 1,pver + do i = 1,lengath + loc_conv%sprd(i,k) = loc_conv%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + loc_conv%frz (i,k) = loc_conv%frz (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + end do + end do + end if + + call closure(lchnk , & + qg ,tg ,pg ,zg ,sg , & + tpg ,qs ,qu ,su ,mc , & + du ,mu ,md ,qd ,sd , & + qhat ,shat ,dp ,qstpg ,zfg , & + qlg ,dsubcld ,mb ,capeg ,tlg , & + lclg ,lelg ,jt ,maxg ,1 , & + lengath ,rgas ,grav ,cpres ,rl , & + msg ,capelmt ) +! +! limit cloud base mass flux to theoretical upper bound. +! + do i=1,lengath + mumax(i) = 0 + end do + do k=msg + 2,pver + do i=1,lengath + mumax(i) = max(mumax(i), mu(i,k)/dp(i,k)) + end do + end do + + do i=1,lengath + if (mumax(i) > 0._r8) then + mb(i) = min(mb(i),0.5_r8/(delt*mumax(i))) + else + mb(i) = 0._r8 + endif + end do + ! If no_deep_pbl = .true., don't allow convection entirely + ! within PBL (suggestion of Bjorn Stevens, 8-2000) + + if (no_deep_pbl) then + do i=1,lengath + if (zm(ideep(i),jt(i)) < pblh(ideep(i))) mb(i) = 0 + end do + end if + + if (zmconv_microp) then + do k=msg+1,pver + do i=1,lengath + loc_conv%sprd(i,k) = loc_conv%sprd(i,k)*mb(i) + loc_conv%frz (i,k) = loc_conv%frz (i,k)*mb(i) + end do + end do + end if + + do k=msg+1,pver + do i=1,lengath + mu (i,k) = mu (i,k)*mb(i) + md (i,k) = md (i,k)*mb(i) + mc (i,k) = mc (i,k)*mb(i) + du (i,k) = du (i,k)*mb(i) + eu (i,k) = eu (i,k)*mb(i) + ed (i,k) = ed (i,k)*mb(i) + cmeg (i,k) = cmeg (i,k)*mb(i) + rprdg(i,k) = rprdg(i,k)*mb(i) + cug (i,k) = cug (i,k)*mb(i) + evpg (i,k) = evpg (i,k)*mb(i) + pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/grav + + + if ( zmconv_microp .and. mb(i).eq.0._r8) then + qlg (i,k) = 0._r8 + loc_conv%qliq (i,k) = 0._r8 + loc_conv%qice (i,k) = 0._r8 + loc_conv%qrain(i,k) = 0._r8 + loc_conv%qsnow(i,k) = 0._r8 + loc_conv%wu(i,k) = 0._r8 + loc_conv%qnl (i,k) = 0._r8 + loc_conv%qni (i,k) = 0._r8 + loc_conv%qnr (i,k) = 0._r8 + loc_conv%qns (i,k) = 0._r8 + + loc_conv%autolm(i,k) = 0._r8 + loc_conv%accrlm(i,k) = 0._r8 + loc_conv%bergnm(i,k) = 0._r8 + loc_conv%fhtimm(i,k) = 0._r8 + loc_conv%fhtctm(i,k) = 0._r8 + loc_conv%fhmlm (i,k) = 0._r8 + loc_conv%hmpim (i,k) = 0._r8 + loc_conv%accslm(i,k) = 0._r8 + loc_conv%dlfm (i,k) = 0._r8 + + loc_conv%autoln(i,k) = 0._r8 + loc_conv%accrln(i,k) = 0._r8 + loc_conv%bergnn(i,k) = 0._r8 + loc_conv%fhtimn(i,k) = 0._r8 + loc_conv%fhtctn(i,k) = 0._r8 + loc_conv%fhmln (i,k) = 0._r8 + loc_conv%accsln(i,k) = 0._r8 + loc_conv%activn(i,k) = 0._r8 + loc_conv%dlfn (i,k) = 0._r8 + loc_conv%cmel (i,k) = 0._r8 + + loc_conv%autoim(i,k) = 0._r8 + loc_conv%accsim(i,k) = 0._r8 + loc_conv%difm (i,k) = 0._r8 + loc_conv%cmei (i,k) = 0._r8 + + loc_conv%nuclin(i,k) = 0._r8 + loc_conv%autoin(i,k) = 0._r8 + loc_conv%accsin(i,k) = 0._r8 + loc_conv%hmpin (i,k) = 0._r8 + loc_conv%difn (i,k) = 0._r8 + + loc_conv%trspcm(i,k) = 0._r8 + loc_conv%trspcn(i,k) = 0._r8 + loc_conv%trspim(i,k) = 0._r8 + loc_conv%trspin(i,k) = 0._r8 + end if + end do + end do +! +! compute temperature and moisture changes due to convection. +! + call q1q2_pjr(lchnk , & + dqdt ,dsdt ,qg ,qs ,qu , & + su ,du ,qhat ,shat ,dp , & + mu ,md ,sd ,qd ,qldeg , & + dsubcld ,jt ,maxg ,1 ,lengath , & + cpres ,rl ,msg , & + dlg ,evpg ,cug , & + loc_conv ) +! +! gather back temperature and mixing ratio. +! + + if (zmconv_microp) then + do k = msg + 1,pver + do i = 1,lengath + if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then + negadq = (dqdt(i,k)+0.5_r8*qg(i,k)/delt)/0.9999_r8 + dqdt(i,k) = dqdt(i,k)-negadq + + do kk=k,jt(i),-1 + if (negadq<0._r8) then + if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres + if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then + if(rprdg(i,kk)-loc_conv%sprd(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-loc_conv%sprd(i,kk))*dp(i,kk)/dp(i,k))*latice/cpres + loc_conv%sprd(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) + end if + else + loc_conv%sprd(i,kk) = loc_conv%sprd(i,kk)+negadq*dp(i,k)/dp(i,kk) + dsdt(i,k) = dsdt(i,k) + negadq*latice/cpres + end if + rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq + dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*rl/cpres*dp(i,kk)/dp(i,k) + if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then + dsdt(i,k) = dsdt(i,k) - loc_conv%sprd(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) + loc_conv%sprd(i,kk) = 0._r8 + else + dsdt(i,k) = dsdt(i,k) -rprdg(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) + loc_conv%sprd(i,kk)= loc_conv%sprd(i,kk)- rprdg(i,kk) + end if + rprdg(i,kk) = 0._r8 + end if + + if (dlg(i,kk)>loc_conv%di(i,kk)) then + doliq= .true. + else + doliq= .false. + end if + + if (negadq<0._r8) then + if (doliq) then + if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres + loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) + dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres + dlg(i,kk) = 0._r8 + loc_conv%dnl(i,kk) = 0._r8 + end if + else + if (loc_conv%di(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres + loc_conv%dni(i,kk) = loc_conv%dni(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_conv%di(i,kk)) + loc_conv%di(i,kk) = loc_conv%di(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + negadq = negadq + loc_conv%di(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - loc_conv%di(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres + loc_conv%di(i,kk) = 0._r8 + loc_conv%dni(i,kk) = 0._r8 + end if + doliq= .false. + end if + end if + if (negadq<0._r8 .and. doliq ) then + if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres + loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) + dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres + dlg(i,kk) = 0._r8 + loc_conv%dnl(i,kk) = 0._r8 + end if + end if + + end if + end do + + if (negadq<0._r8) then + dqdt(i,k) = dqdt(i,k) + negadq + end if + + end if + end do + end do + end if + + do k = msg + 1,pver + do i = 1,lengath +! +! q is updated to compute net precip. +! + q(ideep(i),k) = qh(ideep(i),k) + 2._r8*delt*dqdt(i,k) + qtnd(ideep(i),k) = dqdt (i,k) + cme (ideep(i),k) = cmeg (i,k) + rprd(ideep(i),k) = rprdg(i,k) + zdu (ideep(i),k) = du (i,k) + mcon(ideep(i),k) = mc (i,k) + heat(ideep(i),k) = dsdt (i,k)*cpres + dlf (ideep(i),k) = dlg (i,k) + pflx(ideep(i),k) = pflxg(i,k) + ql (ideep(i),k) = qlg (i,k) + end do + end do + + if (zmconv_microp) then + do k = msg + 1,pver + do i = 1,lengath + dif (ideep(i),k) = loc_conv%di (i,k) + dnlf(ideep(i),k) = loc_conv%dnl (i,k) + dnif(ideep(i),k) = loc_conv%dni (i,k) + + conv%qi (ideep(i),k) = loc_conv%qice(i,k) + conv%frz(ideep(i),k) = loc_conv%frz(i,k)*latice/cpres + conv%sprd(ideep(i),k) = loc_conv%sprd(i,k) + conv%wu (ideep(i),k) = loc_conv%wu (i,k) + conv%qliq(ideep(i),k) = loc_conv%qliq (i,k) + conv%qice(ideep(i),k) = loc_conv%qice (i,k) + conv%qrain(ideep(i),k) = loc_conv%qrain (i,k) + conv%qsnow(ideep(i),k) = loc_conv%qsnow (i,k) + conv%qnl(ideep(i),k) = loc_conv%qnl(i,k) + conv%qni(ideep(i),k) = loc_conv%qni(i,k) + conv%qnr(ideep(i),k) = loc_conv%qnr(i,k) + conv%qns(ideep(i),k) = loc_conv%qns(i,k) + + conv%autolm(ideep(i),k) = loc_conv%autolm(i,k) + conv%accrlm(ideep(i),k) = loc_conv%accrlm(i,k) + conv%bergnm(ideep(i),k) = loc_conv%bergnm(i,k) + conv%fhtimm(ideep(i),k) = loc_conv%fhtimm(i,k) + conv%fhtctm(ideep(i),k) = loc_conv%fhtctm(i,k) + conv%fhmlm (ideep(i),k) = loc_conv%fhmlm (i,k) + conv%hmpim (ideep(i),k) = loc_conv%hmpim (i,k) + conv%accslm(ideep(i),k) = loc_conv%accslm(i,k) + conv%dlfm (ideep(i),k) = loc_conv%dlfm (i,k) + + conv%autoln(ideep(i),k) = loc_conv%autoln(i,k) + conv%accrln(ideep(i),k) = loc_conv%accrln(i,k) + conv%bergnn(ideep(i),k) = loc_conv%bergnn(i,k) + conv%fhtimn(ideep(i),k) = loc_conv%fhtimn(i,k) + conv%fhtctn(ideep(i),k) = loc_conv%fhtctn(i,k) + conv%fhmln (ideep(i),k) = loc_conv%fhmln (i,k) + conv%accsln(ideep(i),k) = loc_conv%accsln(i,k) + conv%activn(ideep(i),k) = loc_conv%activn(i,k) + conv%dlfn (ideep(i),k) = loc_conv%dlfn (i,k) + conv%cmel (ideep(i),k) = loc_conv%cmel (i,k) + + conv%autoim(ideep(i),k) = loc_conv%autoim(i,k) + conv%accsim(ideep(i),k) = loc_conv%accsim(i,k) + conv%difm (ideep(i),k) = loc_conv%difm (i,k) + conv%cmei (ideep(i),k) = loc_conv%cmei (i,k) + + conv%nuclin(ideep(i),k) = loc_conv%nuclin(i,k) + conv%autoin(ideep(i),k) = loc_conv%autoin(i,k) + conv%accsin(ideep(i),k) = loc_conv%accsin(i,k) + conv%hmpin (ideep(i),k) = loc_conv%hmpin (i,k) + conv%difn (ideep(i),k) = loc_conv%difn (i,k) + + conv%trspcm(ideep(i),k) = loc_conv%trspcm(i,k) + conv%trspcn(ideep(i),k) = loc_conv%trspcn(i,k) + conv%trspim(ideep(i),k) = loc_conv%trspim(i,k) + conv%trspin(ideep(i),k) = loc_conv%trspin(i,k) + conv%lambdadpcu(ideep(i),k) = loc_conv%lambdadpcu(i,k) + conv%mudpcu(ideep(i),k) = loc_conv%mudpcu(i,k) + + end do + end do + + do k = msg + 1,pver + do i = 1,ncol + + !convert it from units of "kg/kg" to "g/m3" + + if(k.lt.pver) then + conv%qice (i,k) = 0.5_r8*(conv%qice(i,k)+conv%qice(i,k+1)) + conv%qliq (i,k) = 0.5_r8*(conv%qliq(i,k)+conv%qliq(i,k+1)) + conv%qrain (i,k) = 0.5_r8*(conv%qrain(i,k)+conv%qrain(i,k+1)) + conv%qsnow (i,k) = 0.5_r8*(conv%qsnow(i,k)+conv%qsnow(i,k+1)) + conv%qni (i,k) = 0.5_r8*(conv%qni(i,k)+conv%qni(i,k+1)) + conv%qnl (i,k) = 0.5_r8*(conv%qnl(i,k)+conv%qnl(i,k+1)) + conv%qnr (i,k) = 0.5_r8*(conv%qnr(i,k)+conv%qnr(i,k+1)) + conv%qns (i,k) = 0.5_r8*(conv%qns(i,k)+conv%qns(i,k+1)) + conv%wu(i,k) = 0.5_r8*(conv%wu(i,k)+conv%wu(i,k+1)) + end if + + if (t(i,k).gt. 273.15_r8 .and. t(i,k-1).le.273.15_r8) then + conv%qice (i,k-1) = conv%qice (i,k-1) + conv%qice (i,k) + conv%qice (i,k) = 0._r8 + conv%qni (i,k-1) = conv%qni (i,k-1) + conv%qni (i,k) + conv%qni (i,k) = 0._r8 + conv%qsnow (i,k-1) = conv%qsnow (i,k-1) + conv%qsnow (i,k) + conv%qsnow (i,k) = 0._r8 + conv%qns (i,k-1) = conv%qns (i,k-1) + conv%qns (i,k) + conv%qns (i,k) = 0._r8 + end if + + conv%qice (i,k) = conv%qice(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 + conv%qliq (i,k) = conv%qliq(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 + conv%qrain (i,k) = conv%qrain(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 + conv%qsnow (i,k) = conv%qsnow(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 + conv%qni (i,k) = conv%qni(i,k) * pap(i,k)/t(i,k)/rgas + conv%qnl (i,k) = conv%qnl(i,k) * pap(i,k)/t(i,k)/rgas + conv%qnr (i,k) = conv%qnr(i,k) * pap(i,k)/t(i,k)/rgas + conv%qns (i,k) = conv%qns(i,k) * pap(i,k)/t(i,k)/rgas + end do + end do + end if + +! + do i = 1,lengath + jctop(ideep(i)) = jt(i) + jcbot(ideep(i)) = maxg(i) + pflx(ideep(i),pverp) = pflxg(i,pverp) + end do + + if (zmconv_microp) then + do i = 1,lengath + conv%dcape(ideep(i)) = loc_conv%dcape(i) + end do + end if + +! Compute precip by integrating change in water vapor minus detrained cloud water + do k = pver,msg + 1,-1 + do i = 1,ncol + prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k))*2._r8*delt + end do + end do + +! obtain final precipitation rate in m/s. + do i = 1,ncol + prec(i) = rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8 + end do + +! Compute reserved liquid (not yet in cldliq) for energy integrals. +! Treat rliq as flux out bottom, to be added back later. + do k = 1, pver + do i = 1, ncol + rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k))*dpp(i,k)/gravit + rice(i) = rice(i) + dif(i,k)*dpp(i,k)/gravit + end do + end do + rliq(:ncol) = rliq(:ncol) /1000._r8 + rice(:ncol) = rice(:ncol) /1000._r8 + + if (zmconv_microp) then + deallocate( & + loc_conv%frz, & + loc_conv%sprd, & + loc_conv%wu, & + loc_conv%qi, & + loc_conv%qliq, & + loc_conv%qice, & + loc_conv%qrain, & + loc_conv%qsnow, & + loc_conv%di, & + loc_conv%dnl, & + loc_conv%dni, & + loc_conv%qnl, & + loc_conv%qni, & + loc_conv%qnr, & + loc_conv%qns, & + loc_conv%qide, & + loc_conv%qncde, & + loc_conv%qnide, & + loc_conv%autolm, & + loc_conv%accrlm, & + loc_conv%bergnm, & + loc_conv%fhtimm, & + loc_conv%fhtctm, & + loc_conv%fhmlm, & + loc_conv%hmpim, & + loc_conv%accslm, & + loc_conv%dlfm, & + loc_conv%cmel, & + loc_conv%autoln, & + loc_conv%accrln, & + loc_conv%bergnn, & + loc_conv%fhtimn, & + loc_conv%fhtctn, & + loc_conv%fhmln, & + loc_conv%accsln, & + loc_conv%activn, & + loc_conv%dlfn, & + loc_conv%autoim, & + loc_conv%accsim, & + loc_conv%difm, & + loc_conv%cmei, & + loc_conv%nuclin, & + loc_conv%autoin, & + loc_conv%accsin, & + loc_conv%hmpin, & + loc_conv%difn, & + loc_conv%trspcm, & + loc_conv%trspcn, & + loc_conv%trspim, & + loc_conv%trspin, & + loc_conv%lambdadpcu, & + loc_conv%mudpcu, & + loc_conv%dcape ) + end if + + return +end subroutine zm_convr + +!=============================================================================== +subroutine zm_conv_evap(ncol,lchnk, & + t,pmid,pdel,q, & + landfrac, & + tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & + prdprec, cldfrc, deltat, & + prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow) + + +!----------------------------------------------------------------------- +! Compute tendencies due to evaporation of rain from ZM scheme +!-- +! Compute the total precipitation and snow fluxes at the surface. +! Add in the latent heat of fusion for snow formation and melt, since it not dealt with +! in the Zhang-MacFarlane parameterization. +! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm +!----------------------------------------------------------------------- + + use wv_saturation, only: qsat + use phys_grid, only: get_rlat_all_p + +!------------------------------Arguments-------------------------------- + integer,intent(in) :: ncol, lchnk ! number of columns and chunk index + real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) + real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) + real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) + real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg) + real(r8),intent(in), dimension(pcols) :: landfrac + real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s) + real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s) + real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production + real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow + + + + real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s) + real(r8), intent(in ) :: cldfrc(pcols,pver) ! cloud fraction + real(r8), intent(in ) :: deltat ! time step + + real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate + real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate + + real(r8), optional, intent(in), allocatable :: prdsnow(:,:) ! snow production (kg/ks/s) + +! +!---------------------------Local storage------------------------------- + + real(r8) :: es (pcols,pver) ! Saturation vapor pressure + real(r8) :: fice (pcols,pver) ! ice fraction in precip production + real(r8) :: fsnow_conv(pcols,pver) ! snow fraction in precip production + real(r8) :: qs (pcols,pver) ! saturation specific humidity + real(r8),intent(out) :: flxprec(pcols,pverp) ! Convective-scale flux of precip at interfaces (kg/m2/s) + real(r8),intent(out) :: flxsnow(pcols,pverp) ! Convective-scale flux of snow at interfaces (kg/m2/s) + real(r8),intent(out) :: ntprprd(pcols,pver) ! net precip production in layer + real(r8),intent(out) :: ntsnprd(pcols,pver) ! net snow production in layer + real(r8) :: work1 ! temp variable (pjr) + real(r8) :: work2 ! temp variable (pjr) + + real(r8) :: evpvint(pcols) ! vertical integral of evaporation + real(r8) :: evpprec(pcols) ! evaporation of precipitation (kg/kg/s) + real(r8) :: evpsnow(pcols) ! evaporation of snowfall (kg/kg/s) + real(r8) :: snowmlt(pcols) ! snow melt tendency in layer + real(r8) :: flxsntm(pcols) ! flux of snow into layer, after melting + + real(r8) :: kemask + real(r8) :: evplimit ! temp variable for evaporation limits + real(r8) :: rlat(pcols) + real(r8) :: dum + real(r8) :: omsm + + integer :: i,k ! longitude,level indices + logical :: old_snow + + +!----------------------------------------------------------------------- + + ! If prdsnow is passed in and allocated, then use it in the calculation, otherwise + ! use the old snow calculation + old_snow=.true. + if (present(prdsnow)) then + if (allocated(prdsnow)) then + old_snow=.false. + end if + end if + +! convert input precip to kg/m2/s + prec(:ncol) = prec(:ncol)*1000._r8 + +! determine saturation vapor pressure + call qsat(t(1:ncol, 1:pver), pmid(1:ncol, 1:pver), & + es(1:ncol, 1:pver), qs(1:ncol, 1:pver)) + +! determine ice fraction in rain production (use cloud water parameterization fraction at present) + call cldfrc_fice(ncol, t, fice, fsnow_conv) + +! zero the flux integrals on the top boundary + flxprec(:ncol,1) = 0._r8 + flxsnow(:ncol,1) = 0._r8 + evpvint(:ncol) = 0._r8 + omsm=0.9999_r8 + + do k = 1, pver + do i = 1, ncol + +! Melt snow falling into layer, if necessary. + if( old_snow ) then + if (t(i,k) > tmelt) then + flxsntm(i) = 0._r8 + snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k) + else + flxsntm(i) = flxsnow(i,k) + snowmlt(i) = 0._r8 + end if + else + ! make sure melting snow doesn't reduce temperature below threshold + if (t(i,k) > tmelt) then + dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat + if (t(i,k) + dum .le. tmelt) then + dum = (t(i,k)-tmelt)*cpres/latice/deltat + dum = dum/(flxsnow(i,k)*gravit/pdel(i,k)) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + dum = dum*omsm + flxsntm(i) = flxsnow(i,k)*(1.0_r8-dum) + snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k) + else + flxsntm(i) = flxsnow(i,k) + snowmlt(i) = 0._r8 + end if + end if + +! relative humidity depression must be > 0 for evaporation + evplimit = max(1._r8 - q(i,k)/qs(i,k), 0._r8) + + if (zm_org) then + kemask = ke * (1._r8 - landfrac(i)) + ke_lnd * landfrac(i) + else + kemask = ke + endif + +! total evaporation depends on flux in the top of the layer +! flux prec is the net production above layer minus evaporation into environmet + evpprec(i) = kemask * (1._r8 - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k)) +!********************************************************** +!! evpprec(i) = 0. ! turn off evaporation for now +!********************************************************** + +! Don't let evaporation supersaturate layer (approx). Layer may already be saturated. +! Currently does not include heating/cooling change to qs + evplimit = max(0._r8, (qs(i,k)-q(i,k)) / deltat) + +! Don't evaporate more than is falling into the layer - do not evaporate rain formed +! in this layer but if precip production is negative, remove from the available precip +! Negative precip production occurs because of evaporation in downdrafts. +!!$ evplimit = flxprec(i,k) * gravit / pdel(i,k) + min(prdprec(i,k), 0.) + evplimit = min(evplimit, flxprec(i,k) * gravit / pdel(i,k)) + +! Total evaporation cannot exceed input precipitation + evplimit = min(evplimit, (prec(i) - evpvint(i)) * gravit / pdel(i,k)) + + evpprec(i) = min(evplimit, evpprec(i)) + if( .not.old_snow ) then + evpprec(i) = max(0._r8, evpprec(i)) + evpprec(i) = evpprec(i)*omsm + end if + + +! evaporation of snow depends on snow fraction of total precipitation in the top after melting + if (flxprec(i,k) > 0._r8) then +! evpsnow(i) = evpprec(i) * flxsntm(i) / flxprec(i,k) +! prevent roundoff problems + work1 = min(max(0._r8,flxsntm(i)/flxprec(i,k)),1._r8) + evpsnow(i) = evpprec(i) * work1 + else + evpsnow(i) = 0._r8 + end if + +! vertically integrated evaporation + evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit + +! net precip production is production - evaporation + ntprprd(i,k) = prdprec(i,k) - evpprec(i) +! net snow production is precip production * ice fraction - evaporation - melting +!pjrworks ntsnprd(i,k) = prdprec(i,k)*fice(i,k) - evpsnow(i) - snowmlt(i) +!pjrwrks2 ntsnprd(i,k) = prdprec(i,k)*fsnow_conv(i,k) - evpsnow(i) - snowmlt(i) +! the small amount added to flxprec in the work1 expression has been increased from +! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning +! scheme to be used for small flxprec amounts. This is to address error growth problems. + + if( old_snow ) then +#ifdef PERGRO + work1 = min(max(0._r8,flxsnow(i,k)/(flxprec(i,k)+8.64e-11_r8)),1._r8) +#else + if (flxprec(i,k).gt.0._r8) then + work1 = min(max(0._r8,flxsnow(i,k)/flxprec(i,k)),1._r8) + else + work1 = 0._r8 + endif +#endif + work2 = max(fsnow_conv(i,k), work1) + if (snowmlt(i).gt.0._r8) work2 = 0._r8 +! work2 = fsnow_conv(i,k) + ntsnprd(i,k) = prdprec(i,k)*work2 - evpsnow(i) - snowmlt(i) + tend_s_snwprd (i,k) = prdprec(i,k)*work2*latice + tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice + else + ntsnprd(i,k) = prdsnow(i,k) - min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i)) + tend_s_snwprd (i,k) = prdsnow(i,k)*latice + tend_s_snwevmlt(i,k) = -min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i) )*latice + end if + +! precipitation fluxes + flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit + flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit + +! protect against rounding error + flxprec(i,k+1) = max(flxprec(i,k+1), 0._r8) + flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._r8) +! more protection (pjr) +! flxsnow(i,k+1) = min(flxsnow(i,k+1), flxprec(i,k+1)) + +! heating (cooling) and moistening due to evaporation +! - latent heat of vaporization for precip production has already been accounted for +! - snow is contained in prec + if( old_snow ) then + tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice + else + tend_s(i,k) =-evpprec(i)*latvap + tend_s_snwevmlt(i,k) + end if + tend_q(i,k) = evpprec(i) + end do + end do + +! set output precipitation rates (m/s) + prec(:ncol) = flxprec(:ncol,pver+1) / 1000._r8 + snow(:ncol) = flxsnow(:ncol,pver+1) / 1000._r8 + +!********************************************************** +!!$ tend_s(:ncol,:) = 0. ! turn heating off +!********************************************************** + + end subroutine zm_conv_evap + + + +subroutine convtran(lchnk , & + doconvtran,q ,ncnst ,mu ,md , & + du ,eu ,ed ,dp ,dsubcld , & + jt ,mx ,ideep ,il1g ,il2g , & + nstep ,fracis ,dqdt ,dpdry ,dt) +!----------------------------------------------------------------------- +! +! Purpose: +! Convective transport of trace species +! +! Mixing ratios may be with respect to either dry or moist air +! +! Method: +! +! +! +! Author: P. Rasch +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: cnst_get_type_byind + use ppgrid + + implicit none +!----------------------------------------------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncnst ! number of tracers to transport + logical, intent(in) :: doconvtran(ncnst) ! flag for doing convective transport + real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture + real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up + real(r8), intent(in) :: md(pcols,pver) ! Mass flux down + real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft + real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft + real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft + real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces + real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc + real(r8), intent(in) :: fracis(pcols,pver,ncnst) ! fraction of tracer that is insoluble + + integer, intent(in) :: jt(pcols) ! Index of cloud top for each column + integer, intent(in) :: mx(pcols) ! Index of cloud top for each column + integer, intent(in) :: ideep(pcols) ! Gathering array + integer, intent(in) :: il1g ! Gathered min lon indices over which to operate + integer, intent(in) :: il2g ! Gathered max lon indices over which to operate + integer, intent(in) :: nstep ! Time step index + + real(r8), intent(in) :: dpdry(pcols,pver) ! Delta pressure between interfaces + + real(r8), intent(in) :: dt ! 2 delta t (model time increment) + +! input/output + + real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array + +!--------------------------Local Variables------------------------------ + + integer i ! Work index + integer k ! Work index + integer kbm ! Highest altitude index of cloud base + integer kk ! Work index + integer kkp1 ! Work index + integer km1 ! Work index + integer kp1 ! Work index + integer ktm ! Highest altitude index of cloud top + integer m ! Work index + + real(r8) cabv ! Mix ratio of constituent above + real(r8) cbel ! Mix ratio of constituent below + real(r8) cdifr ! Normalized diff between cabv and cbel + real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces + real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces + real(r8) const(pcols,pver) ! Gathered tracer array + real(r8) fisg(pcols,pver) ! gathered insoluble fraction of tracer + real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces + real(r8) dcondt(pcols,pver) ! Gathered tend array + real(r8) small ! A small number + real(r8) mbsth ! Threshold for mass fluxes + real(r8) mupdudp ! A work variable + real(r8) minc ! A work variable + real(r8) maxc ! A work variable + real(r8) fluxin ! A work variable + real(r8) fluxout ! A work variable + real(r8) netflux ! A work variable + + real(r8) dutmp(pcols,pver) ! Mass detraining from updraft + real(r8) eutmp(pcols,pver) ! Mass entraining from updraft + real(r8) edtmp(pcols,pver) ! Mass entraining from downdraft + real(r8) dptmp(pcols,pver) ! Delta pressure between interfaces + real(r8) total(pcols) + real(r8) negadt,qtmp + +!----------------------------------------------------------------------- +! + small = 1.e-36_r8 +! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) + mbsth = 1.e-15_r8 + +! Find the highest level top and bottom levels of convection + ktm = pver + kbm = pver + do i = il1g, il2g + ktm = min(ktm,jt(i)) + kbm = min(kbm,mx(i)) + end do + +! Loop ever each constituent + do m = 2, ncnst + if (doconvtran(m)) then + + if (cnst_get_type_byind(m).eq.'dry') then + do k = 1,pver + do i =il1g,il2g + dptmp(i,k) = dpdry(i,k) + dutmp(i,k) = du(i,k)*dp(i,k)/dpdry(i,k) + eutmp(i,k) = eu(i,k)*dp(i,k)/dpdry(i,k) + edtmp(i,k) = ed(i,k)*dp(i,k)/dpdry(i,k) + end do + end do + else + do k = 1,pver + do i =il1g,il2g + dptmp(i,k) = dp(i,k) + dutmp(i,k) = du(i,k) + eutmp(i,k) = eu(i,k) + edtmp(i,k) = ed(i,k) + end do + end do + endif +! dptmp = dp + +! Gather up the constituent and set tend to zero + do k = 1,pver + do i =il1g,il2g + const(i,k) = q(ideep(i),k,m) + fisg(i,k) = fracis(ideep(i),k,m) + end do + end do + +! From now on work only with gathered data + +! Interpolate environment tracer values to interfaces + do k = 1,pver + km1 = max(1,k-1) + do i = il1g, il2g + minc = min(const(i,km1),const(i,k)) + maxc = max(const(i,km1),const(i,k)) + if (minc < 0) then + cdifr = 0._r8 + else + cdifr = abs(const(i,k)-const(i,km1))/max(maxc,small) + endif + +! If the two layers differ significantly use a geometric averaging +! procedure + if (cdifr > 1.E-6_r8) then + cabv = max(const(i,km1),maxc*1.e-12_r8) + cbel = max(const(i,k),maxc*1.e-12_r8) + chat(i,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel + + else ! Small diff, so just arithmetic mean + chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) + end if + +! Provisional up and down draft values + conu(i,k) = chat(i,k) + cond(i,k) = chat(i,k) + +! provisional tends + dcondt(i,k) = 0._r8 + + end do + end do + +! Do levels adjacent to top and bottom + k = 2 + km1 = 1 + kk = pver + do i = il1g,il2g + mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) + if (mupdudp > mbsth) then + conu(i,kk) = (+eutmp(i,kk)*fisg(i,kk)*const(i,kk)*dptmp(i,kk))/mupdudp + endif + if (md(i,k) < -mbsth) then + cond(i,k) = (-edtmp(i,km1)*fisg(i,km1)*const(i,km1)*dptmp(i,km1))/md(i,k) + endif + end do + +! Updraft from bottom to top + do kk = pver-1,1,-1 + kkp1 = min(pver,kk+1) + do i = il1g,il2g + mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) + if (mupdudp > mbsth) then + conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eutmp(i,kk)*fisg(i,kk)* & + const(i,kk)*dptmp(i,kk) )/mupdudp + endif + end do + end do + +! Downdraft from top to bottom + do k = 3,pver + km1 = max(1,k-1) + do i = il1g,il2g + if (md(i,k) < -mbsth) then + cond(i,k) = ( md(i,km1)*cond(i,km1)-edtmp(i,km1)*fisg(i,km1)*const(i,km1) & + *dptmp(i,km1) )/md(i,k) + endif + end do + end do + + + do k = ktm,pver + km1 = max(1,k-1) + kp1 = min(pver,k+1) + do i = il1g,il2g + +! version 1 hard to check for roundoff errors +! dcondt(i,k) = +! $ +(+mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) +! $ -mu(i,k)* (conu(i,k)-chat(i,k)) +! $ +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) +! $ -md(i,k)* (cond(i,k)-chat(i,k)) +! $ )/dp(i,k) + +! version 2 hard to limit fluxes +! fluxin = mu(i,kp1)*conu(i,kp1) + mu(i,k)*chat(i,k) +! $ -(md(i,k) *cond(i,k) + md(i,kp1)*chat(i,kp1)) +! fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*chat(i,kp1) +! $ -(md(i,kp1)*cond(i,kp1) + md(i,k)*chat(i,k)) + +! version 3 limit fluxes outside convection to mass in appropriate layer +! these limiters are probably only safe for positive definite quantitities +! it assumes that mu and md already satify a courant number limit of 1 + fluxin = mu(i,kp1)*conu(i,kp1)+ mu(i,k)*min(chat(i,k),const(i,km1)) & + -(md(i,k) *cond(i,k) + md(i,kp1)*min(chat(i,kp1),const(i,kp1))) + fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*min(chat(i,kp1),const(i,k)) & + -(md(i,kp1)*cond(i,kp1) + md(i,k)*min(chat(i,k),const(i,k))) + + netflux = fluxin - fluxout + if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then + netflux = 0._r8 + endif + dcondt(i,k) = netflux/dptmp(i,k) + end do + end do +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! + do k = kbm,pver + km1 = max(1,k-1) + do i = il1g,il2g + if (k == mx(i)) then + +! version 1 +! dcondt(i,k) = (1./dsubcld(i))* +! $ (-mu(i,k)*(conu(i,k)-chat(i,k)) +! $ -md(i,k)*(cond(i,k)-chat(i,k)) +! $ ) + +! version 2 +! fluxin = mu(i,k)*chat(i,k) - md(i,k)*cond(i,k) +! fluxout = mu(i,k)*conu(i,k) - md(i,k)*chat(i,k) +! version 3 + fluxin = mu(i,k)*min(chat(i,k),const(i,km1)) - md(i,k)*cond(i,k) + fluxout = mu(i,k)*conu(i,k) - md(i,k)*min(chat(i,k),const(i,k)) + + netflux = fluxin - fluxout + if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then + netflux = 0._r8 + endif +! dcondt(i,k) = netflux/dsubcld(i) + dcondt(i,k) = netflux/dptmp(i,k) + else if (k > mx(i)) then +! dcondt(i,k) = dcondt(i,k-1) + dcondt(i,k) = 0._r8 + end if + end do + end do + + if (zmconv_microp) then + do i = il1g,il2g + do k = jt(i),mx(i) + if (dcondt(i,k)*dt+const(i,k)<0._r8) then + negadt = dcondt(i,k)+const(i,k)/dt + dcondt(i,k) = -const(i,k)/dt + do kk= k+1, mx(i) + if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then + qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) + if (qtmp*dt+const(i,kk)>0._r8) then + dcondt(i,kk)= qtmp + negadt=0._r8 + else + negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) + dcondt(i,kk)= -const(i,kk)/dt + end if + + end if + end do + do kk= k-1, jt(i), -1 + if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then + qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) + if (qtmp*dt+const(i,kk)>0._r8) then + dcondt(i,kk)= qtmp + negadt=0._r8 + else + negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) + dcondt(i,kk)= -const(i,kk)/dt + end if + end if + end do + + if (negadt<0._r8) then + dcondt(i,k) = dcondt(i,k) + negadt + end if + end if + end do + end do + end if + + +! Initialize to zero everywhere, then scatter tendency back to full array + dqdt(:,:,m) = 0._r8 + do k = 1,pver + kp1 = min(pver,k+1) + do i = il1g,il2g + dqdt(ideep(i),k,m) = dcondt(i,k) + end do + end do + + end if ! for doconvtran + + end do + + return +end subroutine convtran + +!========================================================================================= + +subroutine momtran(lchnk, ncol, & + domomtran,q ,ncnst ,mu ,md , & + du ,eu ,ed ,dp ,dsubcld , & + jt ,mx ,ideep ,il1g ,il2g , & + nstep ,dqdt ,pguall ,pgdall, icwu, icwd, dt, seten ) +!----------------------------------------------------------------------- +! +! Purpose: +! Convective transport of momentum +! +! Mixing ratios may be with respect to either dry or moist air +! +! Method: +! Based on the convtran subroutine by P. Rasch +! +! +! Author: J. Richter and P. Rasch +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: cnst_get_type_byind + use ppgrid + + implicit none +!----------------------------------------------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: ncnst ! number of tracers to transport + logical, intent(in) :: domomtran(ncnst) ! flag for doing convective transport + real(r8), intent(in) :: q(pcols,pver,ncnst) ! Wind array + real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up + real(r8), intent(in) :: md(pcols,pver) ! Mass flux down + real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft + real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft + real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft + real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces + real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc + real(r8), intent(in) :: dt ! time step in seconds : 2*delta_t + + integer, intent(in) :: jt(pcols) ! Index of cloud top for each column + integer, intent(in) :: mx(pcols) ! Index of cloud top for each column + integer, intent(in) :: ideep(pcols) ! Gathering array + integer, intent(in) :: il1g ! Gathered min lon indices over which to operate + integer, intent(in) :: il2g ! Gathered max lon indices over which to operate + integer, intent(in) :: nstep ! Time step index + + + +! input/output + + real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array + +!--------------------------Local Variables------------------------------ + + integer i ! Work index + integer k ! Work index + integer kbm ! Highest altitude index of cloud base + integer kk ! Work index + integer kkp1 ! Work index + integer kkm1 ! Work index + integer km1 ! Work index + integer kp1 ! Work index + integer ktm ! Highest altitude index of cloud top + integer m ! Work index + integer ii ! Work index + + real(r8) cabv ! Mix ratio of constituent above + real(r8) cbel ! Mix ratio of constituent below + real(r8) cdifr ! Normalized diff between cabv and cbel + real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces + real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces + real(r8) const(pcols,pver) ! Gathered wind array + real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces + real(r8) dcondt(pcols,pver) ! Gathered tend array + real(r8) mbsth ! Threshold for mass fluxes + real(r8) mupdudp ! A work variable + real(r8) minc ! A work variable + real(r8) maxc ! A work variable + real(r8) fluxin ! A work variable + real(r8) fluxout ! A work variable + real(r8) netflux ! A work variable + + real(r8) sum ! sum + real(r8) sum2 ! sum2 + + real(r8) mududp(pcols,pver) ! working variable + real(r8) mddudp(pcols,pver) ! working variable + + real(r8) pgu(pcols,pver) ! Pressure gradient term for updraft + real(r8) pgd(pcols,pver) ! Pressure gradient term for downdraft + + real(r8),intent(out) :: pguall(pcols,pver,ncnst) ! Apparent force from updraft PG + real(r8),intent(out) :: pgdall(pcols,pver,ncnst) ! Apparent force from downdraft PG + + real(r8),intent(out) :: icwu(pcols,pver,ncnst) ! In-cloud winds in updraft + real(r8),intent(out) :: icwd(pcols,pver,ncnst) ! In-cloud winds in downdraft + + real(r8),intent(out) :: seten(pcols,pver) ! Dry static energy tendency + real(r8) gseten(pcols,pver) ! Gathered dry static energy tendency + + real(r8) mflux(pcols,pverp,ncnst) ! Gathered momentum flux + + real(r8) wind0(pcols,pver,ncnst) ! gathered wind before time step + real(r8) windf(pcols,pver,ncnst) ! gathered wind after time step + real(r8) fkeb, fket, ketend_cons, ketend, utop, ubot, vtop, vbot, gset2 + + +!----------------------------------------------------------------------- +! + +! Initialize outgoing fields + pguall(:,:,:) = 0.0_r8 + pgdall(:,:,:) = 0.0_r8 +! Initialize in-cloud winds to environmental wind + icwu(:ncol,:,:) = q(:ncol,:,:) + icwd(:ncol,:,:) = q(:ncol,:,:) + +! Initialize momentum flux and final winds + mflux(:,:,:) = 0.0_r8 + wind0(:,:,:) = 0.0_r8 + windf(:,:,:) = 0.0_r8 + +! Initialize dry static energy + + seten(:,:) = 0.0_r8 + gseten(:,:) = 0.0_r8 + +! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) + mbsth = 1.e-15_r8 + +! Find the highest level top and bottom levels of convection + ktm = pver + kbm = pver + do i = il1g, il2g + ktm = min(ktm,jt(i)) + kbm = min(kbm,mx(i)) + end do + +! Loop ever each wind component + do m = 1, ncnst !start at m = 1 to transport momentum + if (domomtran(m)) then + +! Gather up the winds and set tend to zero + do k = 1,pver + do i =il1g,il2g + const(i,k) = q(ideep(i),k,m) + wind0(i,k,m) = const(i,k) + end do + end do + + +! From now on work only with gathered data + +! Interpolate winds to interfaces + + do k = 1,pver + km1 = max(1,k-1) + do i = il1g, il2g + + ! use arithmetic mean + chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) + +! Provisional up and down draft values + conu(i,k) = chat(i,k) + cond(i,k) = chat(i,k) + +! provisional tends + dcondt(i,k) = 0._r8 + + end do + end do + + +! +! Pressure Perturbation Term +! + + !Top boundary: assume mu is zero + + k=1 + pgu(:il2g,k) = 0.0_r8 + pgd(:il2g,k) = 0.0_r8 + + do k=2,pver-1 + km1 = max(1,k-1) + kp1 = min(pver,k+1) + do i = il1g,il2g + + !interior points + + mududp(i,k) = ( mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & + + mu(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) + + pgu(i,k) = - momcu * 0.5_r8 * mududp(i,k) + + + mddudp(i,k) = ( md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & + + md(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) + + pgd(i,k) = - momcd * 0.5_r8 * mddudp(i,k) + + + end do + end do + + ! bottom boundary + k = pver + km1 = max(1,k-1) + do i=il1g,il2g + + mududp(i,k) = mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) + pgu(i,k) = - momcu * mududp(i,k) + + mddudp(i,k) = md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) + + pgd(i,k) = - momcd * mddudp(i,k) + + end do + + +! +! In-cloud velocity calculations +! + +! Do levels adjacent to top and bottom + k = 2 + km1 = 1 + kk = pver + kkm1 = max(1,kk-1) + do i = il1g,il2g + mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) + if (mupdudp > mbsth) then + + conu(i,kk) = (+eu(i,kk)*const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp + endif + if (md(i,k) < -mbsth) then + cond(i,k) = (-ed(i,km1)*const(i,km1)*dp(i,km1))-pgd(i,km1)*dp(i,km1)/md(i,k) + endif + + + end do + + + +! Updraft from bottom to top + do kk = pver-1,1,-1 + kkm1 = max(1,kk-1) + kkp1 = min(pver,kk+1) + do i = il1g,il2g + mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) + if (mupdudp > mbsth) then + + conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eu(i,kk)* & + const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp + endif + end do + + end do + + +! Downdraft from top to bottom + do k = 3,pver + km1 = max(1,k-1) + do i = il1g,il2g + if (md(i,k) < -mbsth) then + + cond(i,k) = ( md(i,km1)*cond(i,km1)-ed(i,km1)*const(i,km1) & + *dp(i,km1)-pgd(i,km1)*dp(i,km1) )/md(i,k) + + endif + end do + end do + + + sum = 0._r8 + sum2 = 0._r8 + + + do k = ktm,pver + km1 = max(1,k-1) + kp1 = min(pver,k+1) + do i = il1g,il2g + ii = ideep(i) + +! version 1 hard to check for roundoff errors + dcondt(i,k) = & + +(mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) & + -mu(i,k)* (conu(i,k)-chat(i,k)) & + +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) & + -md(i,k)* (cond(i,k)-chat(i,k)) & + )/dp(i,k) + + end do + end do + + ! dcont for bottom layer + ! + do k = kbm,pver + km1 = max(1,k-1) + do i = il1g,il2g + if (k == mx(i)) then + + ! version 1 + dcondt(i,k) = (1._r8/dp(i,k))* & + (-mu(i,k)*(conu(i,k)-chat(i,k)) & + -md(i,k)*(cond(i,k)-chat(i,k)) & + ) + end if + end do + end do + +! Initialize to zero everywhere, then scatter tendency back to full array + dqdt(:,:,m) = 0._r8 + + do k = 1,pver + do i = il1g,il2g + ii = ideep(i) + dqdt(ii,k,m) = dcondt(i,k) + ! Output apparent force on the mean flow from pressure gradient + pguall(ii,k,m) = -pgu(i,k) + pgdall(ii,k,m) = -pgd(i,k) + icwu(ii,k,m) = conu(i,k) + icwd(ii,k,m) = cond(i,k) + end do + end do + + ! Calculate momentum flux in units of mb*m/s2 + + do k = ktm,pver + do i = il1g,il2g + ii = ideep(i) + mflux(i,k,m) = & + -mu(i,k)* (conu(i,k)-chat(i,k)) & + -md(i,k)* (cond(i,k)-chat(i,k)) + end do + end do + + + ! Calculate winds at the end of the time step + + do k = ktm,pver + do i = il1g,il2g + ii = ideep(i) + km1 = max(1,k-1) + kp1 = k+1 + windf(i,k,m) = const(i,k) - (mflux(i,kp1,m) - mflux(i,k,m)) * dt /dp(i,k) + + end do + end do + + end if ! for domomtran + end do + + ! Need to add an energy fix to account for the dissipation of kinetic energy + ! Formulation follows from Boville and Bretherton (2003) + ! formulation by PJR + + do k = ktm,pver + km1 = max(1,k-1) + kp1 = min(pver,k+1) + do i = il1g,il2g + + ii = ideep(i) + + ! calculate the KE fluxes at top and bot of layer + ! based on a discrete approximation to b&b eq(35) F_KE = u*F_u + v*F_v at interface + utop = (wind0(i,k,1)+wind0(i,km1,1))/2._r8 + vtop = (wind0(i,k,2)+wind0(i,km1,2))/2._r8 + ubot = (wind0(i,kp1,1)+wind0(i,k,1))/2._r8 + vbot = (wind0(i,kp1,2)+wind0(i,k,2))/2._r8 + fket = utop*mflux(i,k,1) + vtop*mflux(i,k,2) ! top of layer + fkeb = ubot*mflux(i,k+1,1) + vbot*mflux(i,k+1,2) ! bot of layer + + ! divergence of these fluxes should give a conservative redistribution of KE + ketend_cons = (fket-fkeb)/dp(i,k) + + ! tendency in kinetic energy resulting from the momentum transport + ketend = ((windf(i,k,1)**2 + windf(i,k,2)**2) - (wind0(i,k,1)**2 + wind0(i,k,2)**2))*0.5_r8/dt + + ! the difference should be the dissipation + gset2 = ketend_cons - ketend + gseten(i,k) = gset2 + + end do + + end do + + ! Scatter dry static energy to full array + do k = 1,pver + do i = il1g,il2g + ii = ideep(i) + seten(ii,k) = gseten(i,k) + + end do + end do + + return +end subroutine momtran + +!========================================================================================= + +subroutine buoyan(lchnk ,ncol , & + q ,t ,p ,z ,pf , & + tp ,qstp ,tl ,rl ,cape , & + pblt ,lcl ,lel ,lon ,mx , & + rd ,grav ,cp ,msg , & + tpert ) +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: +! +! +! +! Author: +! This is contributed code not fully standardized by the CCM core group. +! The documentation has been enhanced to the degree that we are able. +! Reviewed: P. Rasch, April 1996 +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: q(pcols,pver) ! spec. humidity + real(r8), intent(in) :: t(pcols,pver) ! temperature + real(r8), intent(in) :: p(pcols,pver) ! pressure + real(r8), intent(in) :: z(pcols,pver) ! height + real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces + real(r8), intent(in) :: pblt(pcols) ! index of pbl depth + real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes + +! +! output arguments +! + real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature + real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel + real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl + real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. + integer lcl(pcols) ! + integer lel(pcols) ! + integer lon(pcols) ! level of onset of deep convection + integer mx(pcols) ! level of max moist static energy +! +!--------------------------Local Variables------------------------------ +! + real(r8) capeten(pcols,num_cin) ! provisional value of cape + real(r8) tv(pcols,pver) ! + real(r8) tpv(pcols,pver) ! + real(r8) buoy(pcols,pver) + + real(r8) a1(pcols) + real(r8) a2(pcols) + real(r8) estp(pcols) + real(r8) pl(pcols) + real(r8) plexp(pcols) + real(r8) hmax(pcols) + real(r8) hmn(pcols) + real(r8) y(pcols) + + logical plge600(pcols) + integer knt(pcols) + integer lelten(pcols,num_cin) + + real(r8) cp + real(r8) e + real(r8) grav + + integer i + integer k + integer msg + integer n + + real(r8) rd + real(r8) rl +#ifdef PERGRO + real(r8) rhd +#endif +! +!----------------------------------------------------------------------- +! + do n = 1,num_cin + do i = 1,ncol + lelten(i,n) = pver + capeten(i,n) = 0._r8 + end do + end do +! + do i = 1,ncol + lon(i) = pver + knt(i) = 0 + lel(i) = pver + mx(i) = lon(i) + cape(i) = 0._r8 + hmax(i) = 0._r8 + end do + + tp(:ncol,:) = t(:ncol,:) + qstp(:ncol,:) = q(:ncol,:) + +!!! RBN - Initialize tv and buoy for output. +!!! tv=tv : tpv=tpv : qstp=q : buoy=0. + tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) + tpv(:ncol,:) = tv(:ncol,:) + buoy(:ncol,:) = 0._r8 + +! +! set "launching" level(mx) to be at maximum moist static energy. +! search for this level stops at planetary boundary layer top. +! +#ifdef PERGRO + do k = pver,msg + 1,-1 + do i = 1,ncol + hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) +! +! Reset max moist static energy level when relative difference exceeds 1.e-4 +! + rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i)) + if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then + hmax(i) = hmn(i) + mx(i) = k + end if + end do + end do +#else + do k = pver,msg + 1,-1 + do i = 1,ncol + hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) + if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then + hmax(i) = hmn(i) + mx(i) = k + end if + end do + end do +#endif +! + do i = 1,ncol + lcl(i) = mx(i) + e = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) + tl(i) = 2840._r8/ (3.5_r8*log(t(i,mx(i)))-log(e)-4.805_r8) + 55._r8 + if (tl(i) < t(i,mx(i))) then + plexp(i) = (1._r8/ (0.2854_r8* (1._r8-0.28_r8*q(i,mx(i))))) + pl(i) = p(i,mx(i))* (tl(i)/t(i,mx(i)))**plexp(i) + else + tl(i) = t(i,mx(i)) + pl(i) = p(i,mx(i)) + end if + end do + +! +! calculate lifting condensation level (lcl). +! + do k = pver,msg + 2,-1 + do i = 1,ncol + if (k <= mx(i) .and. (p(i,k) > pl(i) .and. p(i,k-1) <= pl(i))) then + lcl(i) = k - 1 + end if + end do + end do +! +! if lcl is above the nominal level of non-divergence (600 mbs), +! no deep convection is permitted (ensuing calculations +! skipped and cape retains initialized value of zero). +! + do i = 1,ncol + plge600(i) = pl(i).ge.600._r8 + end do +! +! initialize parcel properties in sub-cloud layer below lcl. +! + do k = pver,msg + 1,-1 + do i=1,ncol + if (k > lcl(i) .and. k <= mx(i) .and. plge600(i)) then + tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) + qstp(i,k) = q(i,mx(i)) + tp(i,k) = t(i,mx(i))* (p(i,k)/p(i,mx(i)))**(0.2854_r8* (1._r8-0.28_r8*q(i,mx(i)))) +! +! buoyancy is increased by 0.5 k as in tiedtke +! +!-jjh tpv (i,k)=tp(i,k)*(1.+1.608*q(i,mx(i)))/ +!-jjh 1 (1.+q(i,mx(i))) + tpv(i,k) = (tp(i,k)+tpert(i))*(1._r8+1.608_r8*q(i,mx(i)))/ (1._r8+q(i,mx(i))) + buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add + end if + end do + end do + +! +! define parcel properties at lcl (i.e. level immediately above pl). +! + do k = pver,msg + 1,-1 + do i=1,ncol + if (k == lcl(i) .and. plge600(i)) then + tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) + qstp(i,k) = q(i,mx(i)) + tp(i,k) = tl(i)* (p(i,k)/pl(i))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) +! estp(i) =exp(21.656_r8 - 5418._r8/tp(i,k)) +! use of different formulas for es has about 1 g/kg difference +! in qs at t= 300k, and 0.02 g/kg at t=263k, with the formula +! above giving larger qs. + call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) + a1(i) = cp / rl + qstp(i,k) * (1._r8+ qstp(i,k) / eps1) * rl * eps1 / & + (rd * tp(i,k) ** 2) + a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & + (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & + (rd**2*tp(i,k)**4)-qstp(i,k)* & + (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & + (rd*tp(i,k)**3)) + a1(i) = 1._r8/a1(i) + a2(i) = -a2(i)*a1(i)**3 + y(i) = q(i,mx(i)) - qstp(i,k) + tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 + call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) +! +! buoyancy is increased by 0.5 k in cape calculation. +! dec. 9, 1994 +!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/(1.+q(i,mx(i))) +! + tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+q(i,mx(i))) + buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add + end if + end do + end do +! +! main buoyancy calculation. +! + do k = pver - 1,msg + 1,-1 + do i=1,ncol + if (k < lcl(i) .and. plge600(i)) then + tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) + qstp(i,k) = qstp(i,k+1) + tp(i,k) = tp(i,k+1)* (p(i,k)/p(i,k+1))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) + call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) + a1(i) = cp/rl + qstp(i,k)* (1._r8+qstp(i,k)/eps1)*rl*eps1/ (rd*tp(i,k)**2) + a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & + (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & + (rd**2*tp(i,k)**4)-qstp(i,k)* & + (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & + (rd*tp(i,k)**3)) + a1(i) = 1._r8/a1(i) + a2(i) = -a2(i)*a1(i)**3 + y(i) = qstp(i,k+1) - qstp(i,k) + tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 + call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) +!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/ +!jt (1.+q(i,mx(i))) + tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k))/(1._r8+q(i,mx(i))) + buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add + end if + end do + end do + +! + do k = msg + 2,pver + do i = 1,ncol + if (k < lcl(i) .and. plge600(i)) then + if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then + knt(i) = min(5,knt(i) + 1) + lelten(i,knt(i)) = k + end if + end if + end do + end do +! +! calculate convective available potential energy (cape). +! + do n = 1,5 + do k = msg + 1,pver + do i = 1,ncol + if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then + capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) + end if + end do + end do + end do +! +! find maximum cape from all possible tentative capes from +! one sounding, +! and use it as the final cape, april 26, 1995 +! + do n = 1,5 + do i = 1,ncol + if (capeten(i,n) > cape(i)) then + cape(i) = capeten(i,n) + lel(i) = lelten(i,n) + end if + end do + end do +! +! put lower bound on cape for diagnostic purposes. +! + do i = 1,ncol + cape(i) = max(cape(i), 0._r8) + end do +! + return +end subroutine buoyan + +subroutine cldprp(lchnk , & + q ,t ,u ,v ,p , & + z ,s ,mu ,eu ,du , & + md ,ed ,sd ,qd ,mc , & + qu ,su ,zf ,qst ,hmn , & + hsat ,shat ,ql , & + cmeg ,jb ,lel ,jt ,jlcl , & + mx ,j0 ,jd ,rl ,il2g , & + rd ,grav ,cp ,msg , & + pflx ,evp ,cu ,rprd ,limcnv ,landfrac, & + qcde ,aero ,loc_conv,qhat ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: +! may 09/91 - guang jun zhang, m.lazare, n.mcfarlane. +! original version cldprop. +! +! Author: See above, modified by P. Rasch +! This is contributed code not fully standardized by the CCM core group. +! +! this code is very much rougher than virtually anything else in the CCM +! there are debug statements left strewn about and code segments disabled +! these are to facilitate future development. We expect to release a +! cleaner code in a future release +! +! the documentation has been enhanced to the degree that we are able +! +!----------------------------------------------------------------------- + + implicit none + +!------------------------------------------------------------------------------ +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + + real(r8), intent(in) :: q(pcols,pver) ! spec. humidity of env + real(r8), intent(in) :: t(pcols,pver) ! temp of env + real(r8), intent(in) :: p(pcols,pver) ! pressure of env + real(r8), intent(in) :: z(pcols,pver) ! height of env + real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy of env + real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces + real(r8), intent(in) :: u(pcols,pver) ! zonal velocity of env + real(r8), intent(in) :: v(pcols,pver) ! merid. velocity of env + + real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac + + integer, intent(in) :: jb(pcols) ! updraft base level + integer, intent(in) :: lel(pcols) ! updraft launch level + integer, intent(out) :: jt(pcols) ! updraft plume top + integer, intent(out) :: jlcl(pcols) ! updraft lifting cond level + integer, intent(in) :: mx(pcols) ! updraft base level (same is jb) + integer, intent(out) :: j0(pcols) ! level where updraft begins detraining + integer, intent(out) :: jd(pcols) ! level of downdraft + integer, intent(in) :: limcnv ! convection limiting level + integer, intent(in) :: il2g !CORE GROUP REMOVE + integer, intent(in) :: msg ! missing moisture vals (always 0) + real(r8), intent(in) :: rl ! latent heat of vap + real(r8), intent(in) :: shat(pcols,pver) ! interface values of dry stat energy + real(r8), intent(in) :: qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. + type(zm_aero_t), intent(in) :: aero ! aerosol object + +! +! output +! + real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer + real(r8), intent(out) :: du(pcols,pver) ! detrainement rate of updraft + real(r8), intent(out) :: ed(pcols,pver) ! entrainment rate of downdraft + real(r8), intent(out) :: eu(pcols,pver) ! entrainment rate of updraft + real(r8), intent(out) :: hmn(pcols,pver) ! moist stat energy of env + real(r8), intent(out) :: hsat(pcols,pver) ! sat moist stat energy of env + real(r8), intent(out) :: mc(pcols,pver) ! net mass flux + real(r8), intent(out) :: md(pcols,pver) ! downdraft mass flux + real(r8), intent(out) :: mu(pcols,pver) ! updraft mass flux + real(r8), intent(out) :: pflx(pcols,pverp) ! precipitation flux thru layer + real(r8), intent(out) :: qd(pcols,pver) ! spec humidity of downdraft + real(r8), intent(out) :: ql(pcols,pver) ! liq water of updraft + real(r8), intent(out) :: qst(pcols,pver) ! saturation mixing ratio of env. + real(r8), intent(out) :: qu(pcols,pver) ! spec hum of updraft + real(r8), intent(out) :: sd(pcols,pver) ! normalized dry stat energy of downdraft + real(r8), intent(out) :: su(pcols,pver) ! normalized dry stat energy of updraft + real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg) + + type(zm_conv_t) :: loc_conv + + real(r8) rd ! gas constant for dry air + real(r8) grav ! gravity + real(r8) cp ! heat capacity of dry air + +! +! Local workspace +! + real(r8) gamma(pcols,pver) + real(r8) dz(pcols,pver) + real(r8) iprm(pcols,pver) + real(r8) hu(pcols,pver) + real(r8) hd(pcols,pver) + real(r8) eps(pcols,pver) + real(r8) f(pcols,pver) + real(r8) k1(pcols,pver) + real(r8) i2(pcols,pver) + real(r8) ihat(pcols,pver) + real(r8) i3(pcols,pver) + real(r8) idag(pcols,pver) + real(r8) i4(pcols,pver) + real(r8) qsthat(pcols,pver) + real(r8) hsthat(pcols,pver) + real(r8) gamhat(pcols,pver) + real(r8) cu(pcols,pver) + real(r8) evp(pcols,pver) + real(r8) cmeg(pcols,pver) + real(r8) qds(pcols,pver) +! RBN For c0mask + real(r8) c0mask(pcols) + + real(r8) hmin(pcols) + real(r8) expdif(pcols) + real(r8) expnum(pcols) + real(r8) ftemp(pcols) + real(r8) eps0(pcols) + real(r8) rmue(pcols) + real(r8) zuef(pcols) + real(r8) zdef(pcols) + real(r8) epsm(pcols) + real(r8) ratmjb(pcols) + real(r8) est(pcols) + real(r8) totpcp(pcols) + real(r8) totevp(pcols) + real(r8) alfa(pcols) + real(r8) ql1 + real(r8) tu + real(r8) estu + real(r8) qstu + + real(r8) small + real(r8) mdt + + real(r8) fice(pcols,pver) ! ice fraction in precip production + real(r8) tug(pcols,pver) + + real(r8) tvuo(pcols,pver) ! updraft virtual T w/o freezing heating + real(r8) tvu(pcols,pver) ! updraft virtual T with freezing heating + real(r8) totfrz(pcols) + real(r8) frz (pcols,pver) ! rate of freezing + integer jto(pcols) ! updraft plume old top + integer tmplel(pcols) + + integer iter, itnum + integer m + + integer khighest + integer klowest + integer kount + integer i,k + + logical doit(pcols) + logical done(pcols) +! +!------------------------------------------------------------------------------ +! + if (zmconv_microp) then + loc_conv%autolm(:il2g,:) = 0._r8 + loc_conv%accrlm(:il2g,:) = 0._r8 + loc_conv%bergnm(:il2g,:) = 0._r8 + loc_conv%fhtimm(:il2g,:) = 0._r8 + loc_conv%fhtctm(:il2g,:) = 0._r8 + loc_conv%fhmlm (:il2g,:) = 0._r8 + loc_conv%hmpim (:il2g,:) = 0._r8 + loc_conv%accslm(:il2g,:) = 0._r8 + loc_conv%dlfm (:il2g,:) = 0._r8 + + loc_conv%autoln(:il2g,:) = 0._r8 + loc_conv%accrln(:il2g,:) = 0._r8 + loc_conv%bergnn(:il2g,:) = 0._r8 + loc_conv%fhtimn(:il2g,:) = 0._r8 + loc_conv%fhtctn(:il2g,:) = 0._r8 + loc_conv%fhmln (:il2g,:) = 0._r8 + loc_conv%accsln(:il2g,:) = 0._r8 + loc_conv%activn(:il2g,:) = 0._r8 + loc_conv%dlfn (:il2g,:) = 0._r8 + + loc_conv%autoim(:il2g,:) = 0._r8 + loc_conv%accsim(:il2g,:) = 0._r8 + loc_conv%difm (:il2g,:) = 0._r8 + + loc_conv%nuclin(:il2g,:) = 0._r8 + loc_conv%autoin(:il2g,:) = 0._r8 + loc_conv%accsin(:il2g,:) = 0._r8 + loc_conv%hmpin (:il2g,:) = 0._r8 + loc_conv%difn (:il2g,:) = 0._r8 + + loc_conv%trspcm(:il2g,:) = 0._r8 + loc_conv%trspcn(:il2g,:) = 0._r8 + loc_conv%trspim(:il2g,:) = 0._r8 + loc_conv%trspin(:il2g,:) = 0._r8 + + loc_conv%dcape (:il2g) = 0._r8 + + end if + + do i = 1,il2g + ftemp(i) = 0._r8 + expnum(i) = 0._r8 + expdif(i) = 0._r8 + c0mask(i) = c0_ocn * (1._r8-landfrac(i)) + c0_lnd * landfrac(i) + end do +! +!jr Change from msg+1 to 1 to prevent blowup +! + do k = 1,pver + do i = 1,il2g + dz(i,k) = zf(i,k) - zf(i,k+1) + end do + end do + +! +! initialize many output and work variables to zero +! + pflx(:il2g,1) = 0 + + do k = 1,pver + do i = 1,il2g + k1(i,k) = 0._r8 + i2(i,k) = 0._r8 + i3(i,k) = 0._r8 + i4(i,k) = 0._r8 + mu(i,k) = 0._r8 + f(i,k) = 0._r8 + eps(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = 0._r8 + ql(i,k) = 0._r8 + cu(i,k) = 0._r8 + evp(i,k) = 0._r8 + cmeg(i,k) = 0._r8 + qds(i,k) = q(i,k) + md(i,k) = 0._r8 + ed(i,k) = 0._r8 + sd(i,k) = s(i,k) + qd(i,k) = q(i,k) + mc(i,k) = 0._r8 + qu(i,k) = q(i,k) + su(i,k) = s(i,k) + call qsat_hPa(t(i,k), p(i,k), est(i), qst(i,k)) + + if ( p(i,k)-est(i) <= 0._r8 ) then + qst(i,k) = 1.0_r8 + end if + + gamma(i,k) = qst(i,k)*(1._r8 + qst(i,k)/eps1)*eps1*rl/(rd*t(i,k)**2)*rl/cp + hmn(i,k) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) + hsat(i,k) = cp*t(i,k) + grav*z(i,k) + rl*qst(i,k) + hu(i,k) = hmn(i,k) + hd(i,k) = hmn(i,k) + rprd(i,k) = 0._r8 + + fice(i,k) = 0._r8 + tug(i,k) = 0._r8 + qcde(i,k) = 0._r8 + tvuo(i,k) = (shat(i,k) - grav/cp*zf(i,k))*(1._r8 + 0.608_r8*qhat(i,k)) + tvu(i,k) = tvuo(i,k) + frz(i,k) = 0._r8 + + end do + end do + if (zmconv_microp) then + do k = 1,pver + do i = 1,il2g + loc_conv%sprd(i,k) = 0._r8 + loc_conv%wu(i,k) = 0._r8 + loc_conv%cmel(i,k) = 0._r8 + loc_conv%cmei(i,k) = 0._r8 + loc_conv%qliq(i,k) = 0._r8 + loc_conv%qice(i,k) = 0._r8 + loc_conv%qnl(i,k) = 0._r8 + loc_conv%qni(i,k) = 0._r8 + loc_conv%qide(i,k) = 0._r8 + loc_conv%qncde(i,k) = 0._r8 + loc_conv%qnide(i,k) = 0._r8 + loc_conv%qnr(i,k) = 0._r8 + loc_conv%qns(i,k) = 0._r8 + loc_conv%qrain(i,k)= 0._r8 + loc_conv%qsnow(i,k)= 0._r8 + loc_conv%frz(i,k) = 0._r8 + end do + end do + end if +! +!jr Set to zero things which make this routine blow up +! + do k=1,msg + do i=1,il2g + rprd(i,k) = 0._r8 + end do + end do +! +! interpolate the layer values of qst, hsat and gamma to +! layer interfaces +! + do k = 1, msg+1 + do i = 1,il2g + hsthat(i,k) = hsat(i,k) + qsthat(i,k) = qst(i,k) + gamhat(i,k) = gamma(i,k) + end do + end do + do i = 1,il2g + totpcp(i) = 0._r8 + totevp(i) = 0._r8 + end do + do k = msg + 2,pver + do i = 1,il2g + if (abs(qst(i,k-1)-qst(i,k)) > 1.E-6_r8) then + qsthat(i,k) = log(qst(i,k-1)/qst(i,k))*qst(i,k-1)*qst(i,k)/ (qst(i,k-1)-qst(i,k)) + else + qsthat(i,k) = qst(i,k) + end if + hsthat(i,k) = cp*shat(i,k) + rl*qsthat(i,k) + if (abs(gamma(i,k-1)-gamma(i,k)) > 1.E-6_r8) then + gamhat(i,k) = log(gamma(i,k-1)/gamma(i,k))*gamma(i,k-1)*gamma(i,k)/ & + (gamma(i,k-1)-gamma(i,k)) + else + gamhat(i,k) = gamma(i,k) + end if + end do + end do +! +! initialize cloud top to highest plume top. +!jr changed hard-wired 4 to limcnv+1 (not to exceed pver) +! + jt(:) = pver + do i = 1,il2g + jt(i) = max(lel(i),limcnv+1) + jt(i) = min(jt(i),pver) + jd(i) = pver + jlcl(i) = lel(i) + hmin(i) = 1.E6_r8 + end do +! +! find the level of minimum hsat, where detrainment starts +! + + do k = msg + 1,pver + do i = 1,il2g + if (hsat(i,k) <= hmin(i) .and. k >= jt(i) .and. k <= jb(i)) then + hmin(i) = hsat(i,k) + j0(i) = k + end if + end do + end do + do i = 1,il2g + j0(i) = min(j0(i),jb(i)-2) + j0(i) = max(j0(i),jt(i)+2) +! +! Fix from Guang Zhang to address out of bounds array reference +! + j0(i) = min(j0(i),pver) + end do +! +! Initialize certain arrays inside cloud +! + do k = msg + 1,pver + do i = 1,il2g + if (k >= jt(i) .and. k <= jb(i)) then + hu(i,k) = hmn(i,mx(i)) + cp*tiedke_add + su(i,k) = s(i,mx(i)) + tiedke_add + end if + end do + end do +! +! ********************************************************* +! compute taylor series for approximate eps(z) below +! ********************************************************* +! + do k = pver - 1,msg + 1,-1 + do i = 1,il2g + if (k < jb(i) .and. k >= jt(i)) then + k1(i,k) = k1(i,k+1) + (hmn(i,mx(i))-hmn(i,k))*dz(i,k) + ihat(i,k) = 0.5_r8* (k1(i,k+1)+k1(i,k)) + i2(i,k) = i2(i,k+1) + ihat(i,k)*dz(i,k) + idag(i,k) = 0.5_r8* (i2(i,k+1)+i2(i,k)) + i3(i,k) = i3(i,k+1) + idag(i,k)*dz(i,k) + iprm(i,k) = 0.5_r8* (i3(i,k+1)+i3(i,k)) + i4(i,k) = i4(i,k+1) + iprm(i,k)*dz(i,k) + end if + end do + end do +! +! re-initialize hmin array for ensuing calculation. +! + do i = 1,il2g + hmin(i) = 1.E6_r8 + end do + do k = msg + 1,pver + do i = 1,il2g + if (k >= j0(i) .and. k <= jb(i) .and. hmn(i,k) <= hmin(i)) then + hmin(i) = hmn(i,k) + expdif(i) = hmn(i,mx(i)) - hmin(i) + end if + end do + end do +! +! ********************************************************* +! compute approximate eps(z) using above taylor series +! ********************************************************* +! + do k = msg + 2,pver + do i = 1,il2g + expnum(i) = 0._r8 + ftemp(i) = 0._r8 + if (k < jt(i) .or. k >= jb(i)) then + k1(i,k) = 0._r8 + expnum(i) = 0._r8 + else + expnum(i) = hmn(i,mx(i)) - (hsat(i,k-1)*(zf(i,k)-z(i,k)) + & + hsat(i,k)* (z(i,k-1)-zf(i,k)))/(z(i,k-1)-z(i,k)) + end if + if ((expdif(i) > 100._r8 .and. expnum(i) > 0._r8) .and. & + k1(i,k) > expnum(i)*dz(i,k)) then + ftemp(i) = expnum(i)/k1(i,k) + f(i,k) = ftemp(i) + i2(i,k)/k1(i,k)*ftemp(i)**2 + & + (2._r8*i2(i,k)**2-k1(i,k)*i3(i,k))/k1(i,k)**2* & + ftemp(i)**3 + (-5._r8*k1(i,k)*i2(i,k)*i3(i,k)+ & + 5._r8*i2(i,k)**3+k1(i,k)**2*i4(i,k))/ & + k1(i,k)**3*ftemp(i)**4 + f(i,k) = max(f(i,k),0._r8) + f(i,k) = min(f(i,k),0.0002_r8) + end if + end do + end do + do i = 1,il2g + if (j0(i) < jb(i)) then + if (f(i,j0(i)) < 1.E-6_r8 .and. f(i,j0(i)+1) > f(i,j0(i))) j0(i) = j0(i) + 1 + end if + end do + do k = msg + 2,pver + do i = 1,il2g + if (k >= jt(i) .and. k <= j0(i)) then + f(i,k) = max(f(i,k),f(i,k-1)) + end if + end do + end do + do i = 1,il2g + eps0(i) = f(i,j0(i)) + eps(i,jb(i)) = eps0(i) + end do +! +! This is set to match the Rasch and Kristjansson paper +! + do k = pver,msg + 1,-1 + do i = 1,il2g + if (k >= j0(i) .and. k <= jb(i)) then + eps(i,k) = f(i,j0(i)) + end if + end do + end do + do k = pver,msg + 1,-1 + do i = 1,il2g + if (k < j0(i) .and. k >= jt(i)) eps(i,k) = f(i,k) + end do + end do + + if (zmconv_microp) then + itnum = 2 + else + itnum = 1 + end if + + do iter=1, itnum + + if (zmconv_microp) then + do k = pver,msg + 1,-1 + do i = 1,il2g + cu(i,k) = 0._r8 + loc_conv%qliq(i,k) = 0._r8 + loc_conv%qice(i,k) = 0._r8 + ql(i,k) = 0._r8 + loc_conv%frz(i,k) = 0._r8 + end do + end do + do i = 1,il2g + totpcp(i) = 0._r8 + hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_add + end do + + end if + +! +! specify the updraft mass flux mu, entrainment eu, detrainment du +! and moist static energy hu. +! here and below mu, eu,du, md and ed are all normalized by mb +! + do i = 1,il2g + if (eps0(i) > 0._r8) then + mu(i,jb(i)) = 1._r8 + eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i)) + end if + if (zmconv_microp) then + tmplel(i) = lel(i) + else + tmplel(i) = jt(i) + end if + end do + do k = pver,msg + 1,-1 + do i = 1,il2g + if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then + zuef(i) = zf(i,k) - zf(i,jb(i)) + rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i) + mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i) + eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k) + du(i,k) = (rmue(i)-mu(i,k))/dz(i,k) + end if + end do + end do + + khighest = pverp + klowest = 1 + do i=1,il2g + khighest = min(khighest,lel(i)) + klowest = max(klowest,jb(i)) + end do + do k = klowest-1,khighest,-1 + do i = 1,il2g + if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then + if (mu(i,k) < 0.02_r8) then + hu(i,k) = hmn(i,k) + mu(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = mu(i,k+1)/dz(i,k) + else + if (zmconv_microp) then + hu(i,k) = (mu(i,k+1)*hu(i,k+1) + dz(i,k)*(eu(i,k)*hmn(i,k) + & + latice*frz(i,k)))/(mu(i,k)+ dz(i,k)*du(i,k)) + else + hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + & + dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k)) + end if + end if + end if + end do + end do +! +! reset cloud top index beginning from two layers above the +! cloud base (i.e. if cloud is only one layer thick, top is not reset +! + do i=1,il2g + doit(i) = .true. + totfrz(i)= 0._r8 + do k = pver,msg + 1,-1 + totfrz(i)= totfrz(i)+ frz(i,k)*dz(i,k) + end do + end do + do k=klowest-2,khighest-1,-1 + do i=1,il2g + if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then + if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) & + .and. mu(i,k) >= 0.02_r8) then + if (hu(i,k)-hsthat(i,k) < -2000._r8) then + jt(i) = k + 1 + doit(i) = .false. + else + jt(i) = k + doit(i) = .false. + end if + else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < 0.02_r8) then + jt(i) = k + 1 + doit(i) = .false. + end if + end if + end do + end do + + if (iter == 1) jto(:) = jt(:) + + do k = pver,msg + 1,-1 + do i = 1,il2g + if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then + mu(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = 0._r8 + hu(i,k) = hmn(i,k) + end if + if (k == jt(i) .and. eps0(i) > 0._r8) then + du(i,k) = mu(i,k+1)/dz(i,k) + eu(i,k) = 0._r8 + mu(i,k) = 0._r8 + end if + end do + end do + + do i = 1,il2g + done(i) = .false. + end do + kount = 0 + do k = pver,msg + 2,-1 + do i = 1,il2g + if (k == jb(i) .and. eps0(i) > 0._r8) then + qu(i,k) = q(i,mx(i)) + su(i,k) = (hu(i,k)-rl*qu(i,k))/cp + end if + if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then + su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + & + dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k) + qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- & + du(i,k)*qst(i,k)) + tu = su(i,k) - grav/cp*zf(i,k) + call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu) + if (qu(i,k) >= qstu) then + jlcl(i) = k + kount = kount + 1 + done(i) = .true. + end if + end if + end do + if (kount >= il2g) goto 690 + end do +690 continue + do k = msg + 2,pver + do i = 1,il2g + if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then + su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(cp* (1._r8+gamhat(i,k))) + qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ & + (rl* (1._r8+gamhat(i,k))) + end if + end do + end do + +! compute condensation in updraft + if (zmconv_microp) then + tmplel(:il2g) = jlcl(:il2g)+1 + else + tmplel(:il2g) = jb(:il2g) + end if + + do k = pver,msg + 2,-1 + do i = 1,il2g + if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then + if (zmconv_microp) then + cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & + dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(rl/cp) & + - latice*frz(i,k)/rl + else + + cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & + dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp) + end if + if (k == jt(i)) cu(i,k) = 0._r8 + cu(i,k) = max(0._r8,cu(i,k)) + end if + end do + end do + + + if (zmconv_microp) then + + tug(:il2g,:) = t(:il2g,:) + fice(:,:) = 0._r8 + + do k = pver, msg+2, -1 + do i = 1, il2g + tug(i,k) = su(i,k) - grav/cp*zf(i,k) + end do + end do + + do k = 1, pver-1 + do i = 1, il2g + + if (tug(i,k+1) > 273.15_r8) then + ! If warmer than tmax then water phase + fice(i,k) = 0._r8 + + else if (tug(i,k+1) < 233.15_r8) then + ! If colder than tmin then ice phase + fice(i,k) = 1._r8 + + else + ! Otherwise mixed phase, with ice fraction decreasing linearly + ! from tmin to tmax + fice(i,k) =(273.15_r8 - tug(i,k+1)) / 40._r8 + end if + end do + end do + + do k = 1, pver + do i = 1,il2g + loc_conv%cmei(i,k) = cu(i,k)* fice(i,k) + loc_conv%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k)) + end do + end do + + call zm_mphy(su, qu, mu, du, eu, loc_conv%cmel, loc_conv%cmei, zf, p, t, q, & + eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & + loc_conv%qliq, loc_conv%qice, loc_conv%qnl, loc_conv%qni, qcde, loc_conv%qide, & + loc_conv%qncde, loc_conv%qnide, rprd, loc_conv%sprd, frz, & + loc_conv%wu, loc_conv%qrain, loc_conv%qsnow, loc_conv%qnr, loc_conv%qns, & + loc_conv%autolm, loc_conv%accrlm, loc_conv%bergnm, loc_conv%fhtimm, loc_conv%fhtctm, & + loc_conv%fhmlm, loc_conv%hmpim, loc_conv%accslm, loc_conv%dlfm, loc_conv%autoln, & + loc_conv%accrln, loc_conv%bergnn, loc_conv%fhtimn, loc_conv%fhtctn, & + loc_conv%fhmln, loc_conv%accsln, loc_conv%activn, loc_conv%dlfn, loc_conv%autoim, & + loc_conv%accsim, loc_conv%difm, loc_conv%nuclin, loc_conv%autoin, & + loc_conv%accsin, loc_conv%hmpin, loc_conv%difn, loc_conv%trspcm, loc_conv%trspcn, & + loc_conv%trspim, loc_conv%trspin, loc_conv%lambdadpcu, loc_conv%mudpcu ) + + + do k = pver,msg + 2,-1 + do i = 1,il2g + ql(i,k) = loc_conv%qliq(i,k)+ loc_conv%qice(i,k) + loc_conv%frz(i,k) = frz(i,k) + end do + end do + + do i = 1,il2g + if (iter == 2 .and. jt(i)> jto(i)) then + do k = jt(i), jto(i), -1 + loc_conv%frz(i,k) = 0.0_r8 + cu(i,k)=0.0_r8 + end do + end if + end do + + + do k = pver,msg + 2,-1 + do i = 1,il2g + if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then + totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*(qcde(i,k+1)+loc_conv%qide(i,k+1) )) + end if + end do + end do + + do k = msg + 2,pver + do i = 1,il2g + if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then + if (iter == 1) tvuo(i,k)= (su(i,k) - grav/cp*zf(i,k))*(1._r8+0.608_r8*qu(i,k)) + if (iter == 2 .and. k > max(jt(i),jto(i)) ) then + tvu(i,k) = (su(i,k) - grav/cp*zf(i,k))*(1._r8 +0.608_r8*qu(i,k)) + loc_conv%dcape(i) = loc_conv%dcape(i)+ rd*(tvu(i,k)-tvuo(i,k))*log(p(i,k)/p(i,k-1)) + end if + end if + end do + end do + + else ! no convective microphysics + +! compute condensed liquid, rain production rate +! accumulate total precipitation (condensation - detrainment of liquid) +! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k) +! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is +! consistently applied. +! mu, ql are interface quantities +! cu, du, eu, rprd are midpoint quantites + + do k = pver,msg + 2,-1 + do i = 1,il2g + rprd(i,k) = 0._r8 + if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then + if (mu(i,k) > 0._r8) then + ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- & + dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k)) + ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i)) + else + ql(i,k) = 0._r8 + end if + totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) + rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) + qcde(i,k) = ql(i,k) + + if (zmconv_microp) then + loc_conv%qide(i,k) = 0._r8 + loc_conv%qncde(i,k) = 0._r8 + loc_conv%qnide(i,k) = 0._r8 + loc_conv%sprd(i,k) = 0._r8 + end if + + end if + end do + end do +! + end if ! zmconv_microp + + end do !iter +! +! specify downdraft properties (no downdrafts if jd.ge.jb). +! scale down downward mass flux profile so that net flux +! (up-down) at cloud base in not negative. +! + do i = 1,il2g +! +! in normal downdraft strength run alfa=0.2. In test4 alfa=0.1 +! + alfa(i) = 0.1_r8 + jt(i) = min(jt(i),jb(i)-1) + jd(i) = max(j0(i),jt(i)+1) + jd(i) = min(jd(i),jb(i)) + hd(i,jd(i)) = hmn(i,jd(i)-1) + if (jd(i) < jb(i) .and. eps0(i) > 0._r8) then + epsm(i) = eps0(i) + md(i,jd(i)) = -alfa(i)*epsm(i)/eps0(i) + end if + end do + do k = msg + 1,pver + do i = 1,il2g + if ((k > jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8) then + zdef(i) = zf(i,jd(i)) - zf(i,k) + md(i,k) = -alfa(i)/ (2._r8*eps0(i))*(exp(2._r8*epsm(i)*zdef(i))-1._r8)/zdef(i) + end if + end do + end do + + do k = msg + 1,pver + do i = 1,il2g + if ((k >= jt(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then + ratmjb(i) = min(abs(mu(i,jb(i))/md(i,jb(i))),1._r8) + md(i,k) = md(i,k)*ratmjb(i) + end if + end do + end do + + small = 1.e-20_r8 + do k = msg + 1,pver + do i = 1,il2g + if ((k >= jt(i) .and. k <= pver) .and. eps0(i) > 0._r8) then + ed(i,k-1) = (md(i,k-1)-md(i,k))/dz(i,k-1) + mdt = min(md(i,k),-small) + hd(i,k) = (md(i,k-1)*hd(i,k-1) - dz(i,k-1)*ed(i,k-1)*hmn(i,k-1))/mdt + end if + end do + end do +! +! calculate updraft and downdraft properties. +! + do k = msg + 2,pver + do i = 1,il2g + if ((k >= jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then + qds(i,k) = qsthat(i,k) + gamhat(i,k)*(hd(i,k)-hsthat(i,k))/ & + (rl*(1._r8 + gamhat(i,k))) + end if + end do + end do + + do i = 1,il2g + qd(i,jd(i)) = qds(i,jd(i)) + sd(i,jd(i)) = (hd(i,jd(i)) - rl*qd(i,jd(i)))/cp + end do +! + do k = msg + 2,pver + do i = 1,il2g + if (k >= jd(i) .and. k < jb(i) .and. eps0(i) > 0._r8) then + qd(i,k+1) = qds(i,k+1) + evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k)-md(i,k+1)*qd(i,k+1))/dz(i,k) + evp(i,k) = max(evp(i,k),0._r8) + mdt = min(md(i,k+1),-small) + if (zmconv_microp) then + evp(i,k) = min(evp(i,k),rprd(i,k)) + end if + sd(i,k+1) = ((rl/cp*evp(i,k)-ed(i,k)*s(i,k))*dz(i,k) + md(i,k)*sd(i,k))/mdt + totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) + end if + end do + end do + do i = 1,il2g +!*guang totevp(i) = totevp(i) + md(i,jd(i))*q(i,jd(i)-1) - + totevp(i) = totevp(i) + md(i,jd(i))*qd(i,jd(i)) - md(i,jb(i))*qd(i,jb(i)) + end do +!!$ if (.true.) then + if (.false.) then + do i = 1,il2g + k = jb(i) + if (eps0(i) > 0._r8) then + evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k))/dz(i,k) + evp(i,k) = max(evp(i,k),0._r8) + totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) + end if + end do + endif + + do i = 1,il2g + totpcp(i) = max(totpcp(i),0._r8) + totevp(i) = max(totevp(i),0._r8) + end do +! + do k = msg + 2,pver + do i = 1,il2g + if (totevp(i) > 0._r8 .and. totpcp(i) > 0._r8) then + md(i,k) = md (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) + ed(i,k) = ed (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) + evp(i,k) = evp(i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) + else + md(i,k) = 0._r8 + ed(i,k) = 0._r8 + evp(i,k) = 0._r8 + end if +! cmeg is the cloud water condensed - rain water evaporated +! rprd is the cloud water converted to rain - (rain evaporated) + cmeg(i,k) = cu(i,k) - evp(i,k) + rprd(i,k) = rprd(i,k)-evp(i,k) + end do + end do + +! compute the net precipitation flux across interfaces + pflx(:il2g,1) = 0._r8 + do k = 2,pverp + do i = 1,il2g + pflx(i,k) = pflx(i,k-1) + rprd(i,k-1)*dz(i,k-1) + end do + end do +! + do k = msg + 1,pver + do i = 1,il2g + mc(i,k) = mu(i,k) + md(i,k) + end do + end do +! + return +end subroutine cldprp + +subroutine closure(lchnk , & + q ,t ,p ,z ,s , & + tp ,qs ,qu ,su ,mc , & + du ,mu ,md ,qd ,sd , & + qhat ,shat ,dp ,qstp ,zf , & + ql ,dsubcld ,mb ,cape ,tl , & + lcl ,lel ,jt ,mx ,il1g , & + il2g ,rd ,grav ,cp ,rl , & + msg ,capelmt ) +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: +! +! +! +! Author: G. Zhang and collaborators. CCM contact:P. Rasch +! This is contributed code not fully standardized by the CCM core group. +! +! this code is very much rougher than virtually anything else in the CCM +! We expect to release cleaner code in a future release +! +! the documentation has been enhanced to the degree that we are able +! +!----------------------------------------------------------------------- + +! +!-----------------------------Arguments--------------------------------- +! + integer, intent(in) :: lchnk ! chunk identifier + + real(r8), intent(inout) :: q(pcols,pver) ! spec humidity + real(r8), intent(inout) :: t(pcols,pver) ! temperature + real(r8), intent(inout) :: p(pcols,pver) ! pressure (mb) + real(r8), intent(inout) :: mb(pcols) ! cloud base mass flux + real(r8), intent(in) :: z(pcols,pver) ! height (m) + real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy + real(r8), intent(in) :: tp(pcols,pver) ! parcel temp + real(r8), intent(in) :: qs(pcols,pver) ! sat spec humidity + real(r8), intent(in) :: qu(pcols,pver) ! updraft spec. humidity + real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft + real(r8), intent(in) :: mc(pcols,pver) ! net convective mass flux + real(r8), intent(in) :: du(pcols,pver) ! detrainment from updraft + real(r8), intent(in) :: mu(pcols,pver) ! mass flux of updraft + real(r8), intent(in) :: md(pcols,pver) ! mass flux of downdraft + real(r8), intent(in) :: qd(pcols,pver) ! spec. humidity of downdraft + real(r8), intent(in) :: sd(pcols,pver) ! dry static energy of downdraft + real(r8), intent(in) :: qhat(pcols,pver) ! environment spec humidity at interfaces + real(r8), intent(in) :: shat(pcols,pver) ! env. normalized dry static energy at intrfcs + real(r8), intent(in) :: dp(pcols,pver) ! pressure thickness of layers + real(r8), intent(in) :: qstp(pcols,pver) ! spec humidity of parcel + real(r8), intent(in) :: zf(pcols,pver+1) ! height of interface levels + real(r8), intent(in) :: ql(pcols,pver) ! liquid water mixing ratio + + real(r8), intent(in) :: cape(pcols) ! available pot. energy of column + real(r8), intent(in) :: tl(pcols) + real(r8), intent(in) :: dsubcld(pcols) ! thickness of subcloud layer + + integer, intent(in) :: lcl(pcols) ! index of lcl + integer, intent(in) :: lel(pcols) ! index of launch leve + integer, intent(in) :: jt(pcols) ! top of updraft + integer, intent(in) :: mx(pcols) ! base of updraft +! +!--------------------------Local variables------------------------------ +! + real(r8) dtpdt(pcols,pver) + real(r8) dqsdtp(pcols,pver) + real(r8) dtmdt(pcols,pver) + real(r8) dqmdt(pcols,pver) + real(r8) dboydt(pcols,pver) + real(r8) thetavp(pcols,pver) + real(r8) thetavm(pcols,pver) + + real(r8) dtbdt(pcols),dqbdt(pcols),dtldt(pcols) + real(r8) beta + real(r8) capelmt + real(r8) cp + real(r8) dadt(pcols) + real(r8) debdt + real(r8) dltaa + real(r8) eb + real(r8) grav + + integer i + integer il1g + integer il2g + integer k, kmin, kmax + integer msg + + real(r8) rd + real(r8) rl +! change of subcloud layer properties due to convection is +! related to cumulus updrafts and downdrafts. +! mc(z)=f(z)*mb, mub=betau*mb, mdb=betad*mb are used +! to define betau, betad and f(z). +! note that this implies all time derivatives are in effect +! time derivatives per unit cloud-base mass flux, i.e. they +! have units of 1/mb instead of 1/sec. +! + do i = il1g,il2g + mb(i) = 0._r8 + eb = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) + dtbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(shat(i,mx(i))-su(i,mx(i)))+ & + md(i,mx(i))* (shat(i,mx(i))-sd(i,mx(i)))) + dqbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(qhat(i,mx(i))-qu(i,mx(i)))+ & + md(i,mx(i))* (qhat(i,mx(i))-qd(i,mx(i)))) + debdt = eps1*p(i,mx(i))/ (eps1+q(i,mx(i)))**2*dqbdt(i) + dtldt(i) = -2840._r8* (3.5_r8/t(i,mx(i))*dtbdt(i)-debdt/eb)/ & + (3.5_r8*log(t(i,mx(i)))-log(eb)-4.805_r8)**2 + end do +! +! dtmdt and dqmdt are cumulus heating and drying. +! + do k = msg + 1,pver + do i = il1g,il2g + dtmdt(i,k) = 0._r8 + dqmdt(i,k) = 0._r8 + end do + end do +! + do k = msg + 1,pver - 1 + do i = il1g,il2g + if (k == jt(i)) then + dtmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (su(i,k+1)-shat(i,k+1)- & + rl/cp*ql(i,k+1))+md(i,k+1)* (sd(i,k+1)-shat(i,k+1))) + dqmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (qu(i,k+1)- & + qhat(i,k+1)+ql(i,k+1))+md(i,k+1)*(qd(i,k+1)-qhat(i,k+1))) + end if + end do + end do +! + beta = 0._r8 + do k = msg + 1,pver - 1 + do i = il1g,il2g + if (k > jt(i) .and. k < mx(i)) then + dtmdt(i,k) = (mc(i,k)* (shat(i,k)-s(i,k))+mc(i,k+1)* (s(i,k)-shat(i,k+1)))/ & + dp(i,k) - rl/cp*du(i,k)*(beta*ql(i,k)+ (1-beta)*ql(i,k+1)) +! dqmdt(i,k)=(mc(i,k)*(qhat(i,k)-q(i,k)) +! 1 +mc(i,k+1)*(q(i,k)-qhat(i,k+1)))/dp(i,k) +! 2 +du(i,k)*(qs(i,k)-q(i,k)) +! 3 +du(i,k)*(beta*ql(i,k)+(1-beta)*ql(i,k+1)) + + dqmdt(i,k) = (mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)+cp/rl* (su(i,k+1)-s(i,k)))- & + mu(i,k)* (qu(i,k)-qhat(i,k)+cp/rl*(su(i,k)-s(i,k)))+md(i,k+1)* & + (qd(i,k+1)-qhat(i,k+1)+cp/rl*(sd(i,k+1)-s(i,k)))-md(i,k)* & + (qd(i,k)-qhat(i,k)+cp/rl*(sd(i,k)-s(i,k))))/dp(i,k) + & + du(i,k)* (beta*ql(i,k)+(1-beta)*ql(i,k+1)) + end if + end do + end do +! + do k = msg + 1,pver + do i = il1g,il2g + if (k >= lel(i) .and. k <= lcl(i)) then + thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i))) + thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) + dqsdtp(i,k) = qstp(i,k)* (1._r8+qstp(i,k)/eps1)*eps1*rl/(rd*tp(i,k)**2) +! +! dtpdt is the parcel temperature change due to change of +! subcloud layer properties during convection. +! + dtpdt(i,k) = tp(i,k)/ (1._r8+rl/cp* (dqsdtp(i,k)-qstp(i,k)/tp(i,k)))* & + (dtbdt(i)/t(i,mx(i))+rl/cp* (dqbdt(i)/tl(i)-q(i,mx(i))/ & + tl(i)**2*dtldt(i))) +! +! dboydt is the integrand of cape change. +! + dboydt(i,k) = ((dtpdt(i,k)/tp(i,k)+1._r8/(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i)))* & + (1.608_r8 * dqsdtp(i,k) * dtpdt(i,k) -dqbdt(i))) - (dtmdt(i,k)/t(i,k)+0.608_r8/ & + (1._r8+0.608_r8*q(i,k))*dqmdt(i,k)))*grav*thetavp(i,k)/thetavm(i,k) + end if + end do + end do +! + do k = msg + 1,pver + do i = il1g,il2g + if (k > lcl(i) .and. k < mx(i)) then + thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,mx(i))) + thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) +! +! dboydt is the integrand of cape change. +! + dboydt(i,k) = (dtbdt(i)/t(i,mx(i))+0.608_r8/ (1._r8+0.608_r8*q(i,mx(i)))*dqbdt(i)- & + dtmdt(i,k)/t(i,k)-0.608_r8/ (1._r8+0.608_r8*q(i,k))*dqmdt(i,k))* & + grav*thetavp(i,k)/thetavm(i,k) + end if + end do + end do + +! +! buoyant energy change is set to 2/3*excess cape per 3 hours +! + dadt(il1g:il2g) = 0._r8 + kmin = minval(lel(il1g:il2g)) + kmax = maxval(mx(il1g:il2g)) - 1 + do k = kmin, kmax + do i = il1g,il2g + if ( k >= lel(i) .and. k <= mx(i) - 1) then + dadt(i) = dadt(i) + dboydt(i,k)* (zf(i,k)-zf(i,k+1)) + endif + end do + end do + do i = il1g,il2g + dltaa = -1._r8* (cape(i)-capelmt) + if (dadt(i) /= 0._r8) mb(i) = max(dltaa/tau/dadt(i),0._r8) + end do +! + return +end subroutine closure + +subroutine q1q2_pjr(lchnk , & + dqdt ,dsdt ,q ,qs ,qu , & + su ,du ,qhat ,shat ,dp , & + mu ,md ,sd ,qd ,ql , & + dsubcld ,jt ,mx ,il1g ,il2g , & + cp ,rl ,msg , & + dl ,evp ,cu , & + loc_conv) + + + implicit none + +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: +! +! +! +! Author: phil rasch dec 19 1995 +! +!----------------------------------------------------------------------- + + + real(r8), intent(in) :: cp + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: il1g + integer, intent(in) :: il2g + integer, intent(in) :: msg + + real(r8), intent(in) :: q(pcols,pver) + real(r8), intent(in) :: qs(pcols,pver) + real(r8), intent(in) :: qu(pcols,pver) + real(r8), intent(in) :: su(pcols,pver) + real(r8), intent(in) :: du(pcols,pver) + real(r8), intent(in) :: qhat(pcols,pver) + real(r8), intent(in) :: shat(pcols,pver) + real(r8), intent(in) :: dp(pcols,pver) + real(r8), intent(in) :: mu(pcols,pver) + real(r8), intent(in) :: md(pcols,pver) + real(r8), intent(in) :: sd(pcols,pver) + real(r8), intent(in) :: qd(pcols,pver) + real(r8), intent(in) :: ql(pcols,pver) + real(r8), intent(in) :: evp(pcols,pver) + real(r8), intent(in) :: cu(pcols,pver) + real(r8), intent(in) :: dsubcld(pcols) + + real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) + real(r8),intent(out) :: dl(pcols,pver) + + type(zm_conv_t) :: loc_conv + + integer kbm + integer ktm + integer jt(pcols) + integer mx(pcols) +! +! work fields: +! + integer i + integer k + + real(r8) emc + real(r8) rl +!------------------------------------------------------------------- + do k = msg + 1,pver + do i = il1g,il2g + dsdt(i,k) = 0._r8 + dqdt(i,k) = 0._r8 + dl(i,k) = 0._r8 + end do + end do + + if (zmconv_microp) then + do k = msg + 1,pver + do i = il1g,il2g + loc_conv%di(i,k) = 0._r8 + loc_conv%dnl(i,k) = 0._r8 + loc_conv%dni(i,k) = 0._r8 + end do + end do + end if +! +! find the highest level top and bottom levels of convection +! + ktm = pver + kbm = pver + do i = il1g, il2g + ktm = min(ktm,jt(i)) + kbm = min(kbm,mx(i)) + end do + + do k = ktm,pver-1 + do i = il1g,il2g + emc = -cu (i,k) & ! condensation in updraft + +evp(i,k) ! evaporating rain in downdraft + + dsdt(i,k) = -rl/cp*emc & + + (+mu(i,k+1)* (su(i,k+1)-shat(i,k+1)) & + -mu(i,k)* (su(i,k)-shat(i,k)) & + +md(i,k+1)* (sd(i,k+1)-shat(i,k+1)) & + -md(i,k)* (sd(i,k)-shat(i,k)) & + )/dp(i,k) + + if (zmconv_microp) dsdt(i,k) = dsdt(i,k) + latice/cp*loc_conv%frz(i,k) + + dqdt(i,k) = emc + & + (+mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)) & + -mu(i,k)* (qu(i,k)-qhat(i,k)) & + +md(i,k+1)* (qd(i,k+1)-qhat(i,k+1)) & + -md(i,k)* (qd(i,k)-qhat(i,k)) & + )/dp(i,k) + + dl(i,k) = du(i,k)*ql(i,k+1) + + if (zmconv_microp) then + loc_conv%di(i,k) = du(i,k)*loc_conv%qide(i,k+1) + loc_conv%dnl(i,k) = du(i,k)*loc_conv%qncde(i,k+1) + loc_conv%dni(i,k) = du(i,k)*loc_conv%qnide(i,k+1) + end if + + end do + end do + +! + do k = kbm,pver + do i = il1g,il2g + if (k == mx(i)) then + dsdt(i,k) = (1._r8/dsubcld(i))* & + (-mu(i,k)* (su(i,k)-shat(i,k)) & + -md(i,k)* (sd(i,k)-shat(i,k)) & + ) + dqdt(i,k) = (1._r8/dsubcld(i))* & + (-mu(i,k)*(qu(i,k)-qhat(i,k)) & + -md(i,k)*(qd(i,k)-qhat(i,k)) & + ) + else if (k > mx(i)) then + dsdt(i,k) = dsdt(i,k-1) + dqdt(i,k) = dqdt(i,k-1) + end if + end do + end do +! + return +end subroutine q1q2_pjr + +subroutine buoyan_dilute(lchnk ,ncol , & + q ,t ,p ,z ,pf , & + tp ,qstp ,tl ,rl ,cape , & + pblt ,lcl ,lel ,lon ,mx , & + rd ,grav ,cp ,msg , & + tpert , org , landfrac) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculates CAPE the lifting condensation level and the convective top +! where buoyancy is first -ve. +! +! Method: Calculates the parcel temperature based on a simple constant +! entraining plume model. CAPE is integrated from buoyancy. +! 09/09/04 - Simplest approach using an assumed entrainment rate for +! testing (dmpdp). +! 08/04/05 - Swap to convert dmpdz to dmpdp +! +! SCAM Logical Switches - DILUTE:RBN - Now Disabled +! --------------------- +! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. +! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. +! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. +! +! References: +! Raymond and Blythe (1992) JAS +! +! Author: +! Richard Neale - September 2004 +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: q(pcols,pver) ! spec. humidity + real(r8), intent(in) :: t(pcols,pver) ! temperature + real(r8), intent(in) :: p(pcols,pver) ! pressure + real(r8), intent(in) :: z(pcols,pver) ! height + real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces + real(r8), intent(in) :: pblt(pcols) ! index of pbl depth + real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes + +! +! output arguments +! + real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature + real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel (only above lcl, just q below). + real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl + real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. + integer lcl(pcols) ! + integer lel(pcols) ! + integer lon(pcols) ! level of onset of deep convection + integer mx(pcols) ! level of max moist static energy + + real(r8), pointer :: org(:,:) ! organization parameter + real(r8), intent(in) :: landfrac(pcols) +! +!--------------------------Local Variables------------------------------ +! + real(r8) capeten(pcols,5) ! provisional value of cape + real(r8) tv(pcols,pver) ! + real(r8) tpv(pcols,pver) ! + real(r8) buoy(pcols,pver) + + real(r8) a1(pcols) + real(r8) a2(pcols) + real(r8) estp(pcols) + real(r8) pl(pcols) + real(r8) plexp(pcols) + real(r8) hmax(pcols) + real(r8) hmn(pcols) + real(r8) y(pcols) + + logical plge600(pcols) + integer knt(pcols) + integer lelten(pcols,5) + + real(r8) cp + real(r8) e + real(r8) grav + + integer i + integer k + integer msg + integer n + + real(r8) rd + real(r8) rl +#ifdef PERGRO + real(r8) rhd +#endif +! +!----------------------------------------------------------------------- +! + do n = 1,5 + do i = 1,ncol + lelten(i,n) = pver + capeten(i,n) = 0._r8 + end do + end do +! + do i = 1,ncol + lon(i) = pver + knt(i) = 0 + lel(i) = pver + mx(i) = lon(i) + cape(i) = 0._r8 + hmax(i) = 0._r8 + end do + + tp(:ncol,:) = t(:ncol,:) + qstp(:ncol,:) = q(:ncol,:) + +!!! RBN - Initialize tv and buoy for output. +!!! tv=tv : tpv=tpv : qstp=q : buoy=0. + tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) + tpv(:ncol,:) = tv(:ncol,:) + buoy(:ncol,:) = 0._r8 + +! +! set "launching" level(mx) to be at maximum moist static energy. +! search for this level stops at planetary boundary layer top. +! +#ifdef PERGRO + do k = pver,msg + 1,-1 + do i = 1,ncol + hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) +! +! Reset max moist static energy level when relative difference exceeds 1.e-4 +! + rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i)) + if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then + hmax(i) = hmn(i) + mx(i) = k + end if + end do + end do +#else + do k = pver,msg + 1,-1 + do i = 1,ncol + hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) + if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then + hmax(i) = hmn(i) + mx(i) = k + end if + end do + end do +#endif + +! LCL dilute calculation - initialize to mx(i) +! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute +! Original code actually sets LCL as level above wher condensate forms. +! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. + + do i = 1,ncol ! Initialise LCL variables. + lcl(i) = mx(i) + tl(i) = t(i,mx(i)) + pl(i) = p(i,mx(i)) + end do + +! +! main buoyancy calculation. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! +!!! RBN 9/9/04 !!! + + call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + org, landfrac) + + +! If lcl is above the nominal level of non-divergence (600 mbs), +! no deep convection is permitted (ensuing calculations +! skipped and cape retains initialized value of zero). +! + do i = 1,ncol + plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. + end do + +! +! Main buoyancy calculation. +! + do k = pver,msg + 1,-1 + do i=1,ncol + if (k <= mx(i) .and. plge600(i)) then ! Define buoy from launch level to cloud top. + tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) + buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add ! +0.5K or not? + else + qstp(i,k) = q(i,k) + tp(i,k) = t(i,k) + tpv(i,k) = tv(i,k) + endif + end do + end do + + + +!------------------------------------------------------------------------------- + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + +! + do k = msg + 2,pver + do i = 1,ncol + if (k < lcl(i) .and. plge600(i)) then + if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then + knt(i) = min(num_cin,knt(i) + 1) + lelten(i,knt(i)) = k + end if + end if + end do + end do +! +! calculate convective available potential energy (cape). +! + do n = 1,num_cin + do k = msg + 1,pver + do i = 1,ncol + if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then + capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) + end if + end do + end do + end do +! +! find maximum cape from all possible tentative capes from +! one sounding, +! and use it as the final cape, april 26, 1995 +! + do n = 1,num_cin + do i = 1,ncol + if (capeten(i,n) > cape(i)) then + cape(i) = capeten(i,n) + lel(i) = lelten(i,n) + end if + end do + end do +! +! put lower bound on cape for diagnostic purposes. +! + do i = 1,ncol + cape(i) = max(cape(i), 0._r8) + end do +! + return +end subroutine buoyan_dilute + +subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, & + tpert, tp, tpv, qstp, pl, tl, lcl, & + org, landfrac) + +! Routine to determine +! 1. Tp - Parcel temperature +! 2. qstp - Saturated mixing ratio at the parcel temperature. + +!-------------------- +implicit none +!-------------------- + +integer, intent(in) :: lchnk +integer, intent(in) :: ncol +integer, intent(in) :: msg + +integer, intent(in), dimension(pcols) :: klaunch(pcols) + +real(r8), intent(in), dimension(pcols,pver) :: p +real(r8), intent(in), dimension(pcols,pver) :: t +real(r8), intent(in), dimension(pcols,pver) :: q +real(r8), intent(in), dimension(pcols) :: tpert ! PBL temperature perturbation. + +real(r8), intent(inout), dimension(pcols,pver) :: tp ! Parcel temp. +real(r8), intent(inout), dimension(pcols,pver) :: qstp ! Parcel water vapour (sat value above lcl). +real(r8), intent(inout), dimension(pcols) :: tl ! Actual temp of LCL. +real(r8), intent(inout), dimension(pcols) :: pl ! Actual pressure of LCL. + +integer, intent(inout), dimension(pcols) :: lcl ! Lifting condesation level (first model level with saturation). + +real(r8), intent(out), dimension(pcols,pver) :: tpv ! Define tpv within this routine. + +real(r8), pointer, dimension(:,:) :: org +real(r8), intent(in), dimension(pcols) :: landfrac +!-------------------- + +! Have to be careful as s is also dry static energy. + + +! If we are to retain the fact that CAM loops over grid-points in the internal +! loop then we need to dimension sp,atp,mp,xsh2o with ncol. + + +real(r8) tmix(pcols,pver) ! Tempertaure of the entraining parcel. +real(r8) qtmix(pcols,pver) ! Total water of the entraining parcel. +real(r8) qsmix(pcols,pver) ! Saturated mixing ratio at the tmix. +real(r8) smix(pcols,pver) ! Entropy of the entraining parcel. +real(r8) xsh2o(pcols,pver) ! Precipitate lost from parcel. +real(r8) ds_xsh2o(pcols,pver) ! Entropy change due to loss of condensate. +real(r8) ds_freeze(pcols,pver) ! Entropy change sue to freezing of precip. +real(r8) dmpdz2d(pcols,pver) ! variable detrainment rate + +real(r8) mp(pcols) ! Parcel mass flux. +real(r8) qtp(pcols) ! Parcel total water. +real(r8) sp(pcols) ! Parcel entropy. + +real(r8) sp0(pcols) ! Parcel launch entropy. +real(r8) qtp0(pcols) ! Parcel launch total water. +real(r8) mp0(pcols) ! Parcel launch relative mass flux. + +real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. +real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). +!real(r8) dmpdpc ! In cloud parcel mass entrainment rate (/mb). +real(r8) dmpdz ! Parcel fractional mass entrainment rate (/m) +real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. +real(r8) senv ! Environmental entropy at each grid point. +real(r8) qtenv ! Environmental total water " " ". +real(r8) penv ! Environmental total pressure " " ". +real(r8) tenv ! Environmental total temperature " " ". +real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. +real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. +real(r8) dp ! Layer thickness (center to center) +real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! +real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). + +real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) +real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) +real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. +real(r8) org2rkm, org2Tpert +real(r8) dmpdz_lnd, dmpdz_mask + +integer rcall ! Number of ientropy call for errors recording +integer nit_lheat ! Number of iterations for condensation/freezing loop. +integer i,k,ii ! Loop counters. + +!====================================================================== +! SUMMARY +! +! 9/9/04 - Assumes parcel is initiated from level of maxh (klaunch) +! and entrains at each level with a specified entrainment rate. +! +! 15/9/04 - Calculates lcl(i) based on k where qsmix is first < qtmix. +! +!====================================================================== +! +! Set some values that may be changed frequently. +! + +if (zm_org) then + org2rkm = 10._r8 + org2Tpert = 0._r8 +endif +nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. +dmpdz=-1.e-3_r8 ! Entrainment rate. (-ve for /m) +dmpdz_lnd=-1.e-3_r8 +!dmpdpc = 3.e-2_r8 ! In cloud entrainment rate (/mb). +lwmax = 1.e-3_r8 ! Need to put formula in for this. +tscool = 0.0_r8 ! Temp at which water loading freezes in the cloud. + +qtmix=0._r8 +smix=0._r8 + +qtenv = 0._r8 +senv = 0._r8 +tenv = 0._r8 +penv = 0._r8 + +qtp0 = 0._r8 +sp0 = 0._r8 +mp0 = 0._r8 + +qtp = 0._r8 +sp = 0._r8 +mp = 0._r8 + +new_q = 0._r8 +new_s = 0._r8 + +! **** Begin loops **** + +do k = pver, msg+1, -1 + do i=1,ncol + +! Initialize parcel values at launch level. + + if (k == klaunch(i)) then + qtp0(i) = q(i,k) ! Parcel launch total water (assuming subsaturated) - OK????. + sp0(i) = entropy(t(i,k),p(i,k),qtp0(i)) ! Parcel launch entropy. + mp0(i) = 1._r8 ! Parcel launch relative mass (i.e. 1 parcel stays 1 parcel for dmpdp=0, undilute). + smix(i,k) = sp0(i) + qtmix(i,k) = qtp0(i) + tfguess = t(i,k) + rcall = 1 + call ientropy (rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) + end if + +! Entraining levels + + if (k < klaunch(i)) then + +! Set environmental values for this level. + + dp = (p(i,k)-p(i,k+1)) ! In -ve mb as p decreasing with height - difference between center of layers. + qtenv = 0.5_r8*(q(i,k)+q(i,k+1)) ! Total water of environment. + tenv = 0.5_r8*(t(i,k)+t(i,k+1)) + penv = 0.5_r8*(p(i,k)+p(i,k+1)) + + senv = entropy(tenv,penv,qtenv) ! Entropy of environment. + +! Determine fractional entrainment rate /pa given value /m. + + dpdz = -(penv*grav)/(rgas*tenv) ! in mb/m since p in mb. + dzdp = 1._r8/dpdz ! in m/mb + if (zm_org) then + dmpdz_mask = landfrac(i) * dmpdz_lnd + (1._r8 - landfrac(i)) * dmpdz + dmpdp = (dmpdz_mask/(1._r8+org(i,k)*org2rkm))*dzdp ! /mb Fractional entrainment + else + dmpdp = dmpdz*dzdp + endif + +! Sum entrainment to current level +! entrains q,s out of intervening dp layers, in which linear variation is assumed +! so really it entrains the mean of the 2 stored values. + + sp(i) = sp(i) - dmpdp*dp*senv + qtp(i) = qtp(i) - dmpdp*dp*qtenv + mp(i) = mp(i) - dmpdp*dp + +! Entrain s and qt to next level. + + smix(i,k) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) + qtmix(i,k) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) + +! Invert entropy from s and q to determine T and saturation-capped q of mixture. +! t(i,k) used as a first guess so that it converges faster. + + tfguess = tmix(i,k+1) + rcall = 2 + call ientropy(rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) + +! +! Determine if this is lcl of this column if qsmix <= qtmix. +! FIRST LEVEL where this happens on ascending. + + if (qsmix(i,k) <= qtmix(i,k) .and. qsmix(i,k+1) > qtmix(i,k+1)) then + lcl(i) = k + qxsk = qtmix(i,k) - qsmix(i,k) + qxskp1 = qtmix(i,k+1) - qsmix(i,k+1) + dqxsdp = (qxsk - qxskp1)/dp + pl(i) = p(i,k+1) - qxskp1/dqxsdp ! pressure level of actual lcl. + dsdp = (smix(i,k) - smix(i,k+1))/dp + dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp + slcl = smix(i,k+1) + dsdp* (pl(i)-p(i,k+1)) + qtlcl = qtmix(i,k+1) + dqtdp*(pl(i)-p(i,k+1)) + + tfguess = tmix(i,k) + rcall = 3 + call ientropy (rcall,i,lchnk,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) + +! write(iulog,*)' ' +! write(iulog,*)' p',p(i,k+1),pl(i),p(i,lcl(i)) +! write(iulog,*)' t',tmix(i,k+1),tl(i),tmix(i,lcl(i)) +! write(iulog,*)' s',smix(i,k+1),slcl,smix(i,lcl(i)) +! write(iulog,*)'qt',qtmix(i,k+1),qtlcl,qtmix(i,lcl(i)) +! write(iulog,*)'qs',qsmix(i,k+1),qslcl,qsmix(i,lcl(i)) + + endif +! + end if ! k < klaunch + + + end do ! Levels loop +end do ! Columns loop + +!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! Could stop now and test with this as it will provide some estimate of buoyancy +!! without the effects of freezing/condensation taken into account for tmix. + +!! So we now have a profile of entropy and total water of the entraining parcel +!! Varying with height from the launch level klaunch parcel=environment. To the +!! top allowed level for the existence of convection. + +!! Now we have to adjust these values such that the water held in vaopor is < or +!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of +!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously +!! provides latent heating to the mixed parcel and so this has to be added back +!! to it. But does this also increase qsmix as well? Also freezing processes + + +xsh2o = 0._r8 +ds_xsh2o = 0._r8 +ds_freeze = 0._r8 + +!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Iterate solution twice for accuracy + + + +do k = pver, msg+1, -1 + do i=1,ncol + +! Initialize variables at k=klaunch + + if (k == klaunch(i)) then + +! Set parcel values at launch level assume no liquid water. + + tp(i,k) = tmix(i,k) + qstp(i,k) = q(i,k) + if (zm_org) then + tpv(i,k) = (tp(i,k) + (org2Tpert*org(i,k)+tpert(i))) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) + else + tpv(i,k) = (tp(i,k) + tpert(i)) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) + endif + + end if + + if (k < klaunch(i)) then + +! Initiaite loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. + +! Iterate nit_lheat times for s,qt changes. + + do ii=0,nit_lheat-1 + +! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). + + xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax) + +! Contribution to ds from precip loss of condensate (Accumulated change from smix).(-ve) + + ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - cpliq * log (tmix(i,k)/tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1))) +! +! Entropy of freezing: latice times amount of water involved divided by T. +! + + if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) == 0._r8) then ! One off freezing of condensate. + ds_freeze(i,k) = (latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) ! Gain of LH + end if + + if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then ! Continual freezing of additional condensate. + ds_freeze(i,k) = ds_freeze(i,k+1)+(latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k))) + end if + +! Adjust entropy and accordingly to sum of ds (be careful of signs). + + new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k) + +! Adjust liquid water and accordingly to xsh2o. + + new_q = qtmix(i,k) - xsh2o(i,k) + +! Invert entropy to get updated Tmix and qsmix of parcel. + + tfguess = tmix(i,k) + rcall =4 + call ientropy (rcall,i,lchnk,new_s, p(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess) + + end do ! Iteration loop for freezing processes. + +! tp - Parcel temp is temp of mixture. +! tpv - Parcel v. temp should be density temp with new_q total water. + + tp(i,k) = tmix(i,k) + +! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) + + if (new_q > qsmix(i,k)) then ! Super-saturated so condensate present - reduces buoyancy. + qstp(i,k) = qsmix(i,k) + else ! Just saturated/sub-saturated - no condensate virtual effects. + qstp(i,k) = new_q + end if + + if (zm_org) then + tpv(i,k) = (tp(i,k)+(org2Tpert*org(i,k)+tpert(i)))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) + else + tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) + endif + + end if ! k < klaunch + + end do ! Loop for columns + +end do ! Loop for vertical levels. + + +return +end subroutine parcel_dilute + +!----------------------------------------------------------------------------------------- +real(r8) function entropy(TK,p,qtot) +!----------------------------------------------------------------------------------------- +! +! TK(K),p(mb),qtot(kg/kg) +! from Raymond and Blyth 1992 +! + real(r8), intent(in) :: p,qtot,TK + real(r8) :: qv,qst,e,est,L + real(r8), parameter :: pref = 1000._r8 + +L = rl - (cpliq - cpwv)*(TK-tfreez) ! T IN CENTIGRADE + +call qsat_hPa(TK, p, est, qst) + +qv = min(qtot,qst) ! Partition qtot into vapor part only. +e = qv*p / (eps1 +qv) + +entropy = (cpres + qtot*cpliq)*log( TK/tfreez) - rgas*log( (p-e)/pref ) + & + L*qv/TK - qv*rh2o*log(qv/qst) + +end FUNCTION entropy + +! +!----------------------------------------------------------------------------------------- +SUBROUTINE ientropy (rcall,icol,lchnk,s,p,qt,T,qst,Tfg) +!----------------------------------------------------------------------------------------- +! +! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). +! Inverts entropy, pressure and total water qt +! for T and saturated vapor mixing ratio +! + + use phys_grid, only: get_rlon_p, get_rlat_p + + integer, intent(in) :: icol, lchnk, rcall + real(r8), intent(in) :: s, p, Tfg, qt + real(r8), intent(out) :: qst, T + real(r8) :: est, this_lat,this_lon + real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol + integer :: i + + logical :: converged + + ! Max number of iteration loops. + integer, parameter :: LOOPMAX = 100 + real(r8), parameter :: EPS = 3.e-8_r8 + + converged = .false. + + ! Invert the entropy equation -- use Brent's method + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. + + T = Tfg ! Better first guess based on Tprofile from conv. + + a = Tfg-10 !low bracket + b = Tfg+10 !high bracket + + fa = entropy(a, p, qt) - s + fb = entropy(b, p, qt) - s + + c=b + fc=fb + tol=0.001_r8 + + converge: do i=0, LOOPMAX + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c=a + fc=fa + d=b-a + ebr=d + end if + if (abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + end if + + tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol + xm=0.5_r8*(c-b) + converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr=2.0_r8*xm*sbr + qbr=1.0_r8-sbr + else + qbr=fa/fc + rbr=fb/fc + pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then + ebr=d + d=pbr/qbr + else + d=xm + ebr=d + end if + else + d=xm + ebr=d + end if + a=b + fa=fb + b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) + + fb = entropy(b, p, qt) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + this_lat = get_rlat_p(lchnk, icol)*57.296_r8 + this_lon = get_rlon_p(lchnk, icol)*57.296_r8 + write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****' + write(iulog,100) 'ZM_CONV: IENTROPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, & + ' lat: ',this_lat,' lon: ',this_lon, & + ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, & + ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s + call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + +end SUBROUTINE ientropy + +! Wrapper for qsat_water that does translation between Pa and hPa +! qsat_water uses Pa internally, so get it right, need to pass in Pa. +! Afterward, set es back to hPa. +elemental subroutine qsat_hPa(t, p, es, qm) + use wv_saturation, only: qsat_water + + ! Inputs + real(r8), intent(in) :: t ! Temperature (K) + real(r8), intent(in) :: p ! Pressure (hPa) + ! Outputs + real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) + real(r8), intent(out) :: qm ! Saturation mass mixing ratio + ! (vapor mass over dry mass, kg/kg) + + call qsat_water(t, p*100._r8, es, qm) + + es = es*0.01_r8 + +end subroutine qsat_hPa + +end module zm_conv diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 new file mode 100644 index 0000000000..d5e87a4d6a --- /dev/null +++ b/src/physics/cam/zm_conv_intr.F90 @@ -0,0 +1,1379 @@ +module zm_conv_intr +!--------------------------------------------------------------------------------- +! Purpose: +! +! CAM interface to the Zhang-McFarlane deep convection scheme +! +! Author: D.B. Coleman +! January 2010 modified by J. Kay to add COSP simulator fields to physics buffer +!--------------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use physconst, only: cpair + use ppgrid, only: pver, pcols, pverp, begchunk, endchunk + use zm_conv, only: zm_conv_evap, zm_convr, convtran, momtran + use zm_microphysics, only: zm_aero_t, zm_conv_t + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & + rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & + use ndrop_bam, only: ndrop_bam_init + use cam_abortutils, only: endrun + use physconst, only: pi + use spmd_utils, only: masterproc + use perf_mod + use cam_logfile, only: iulog + use constituents, only: cnst_add + + implicit none + private + save + + ! Public methods + + public ::& + zm_conv_register, &! register fields in physics buffer + zm_conv_readnl, &! read namelist + zm_conv_init, &! initialize donner_deep module + zm_conv_tend, &! return tendencies + zm_conv_tend_2 ! return tendencies + + public :: zmconv_microp + + integer ::& ! indices for fields in the physics buffer + zm_mu_idx, & + zm_eu_idx, & + zm_du_idx, & + zm_md_idx, & + zm_ed_idx, & + zm_dp_idx, & + zm_dsubcld_idx, & + zm_jt_idx, & + zm_maxg_idx, & + zm_ideep_idx, & + dp_flxprc_idx, & + dp_flxsnw_idx, & + dp_cldliq_idx, & + ixorg, & + dp_cldice_idx, & + dlfzm_idx, & ! detrained convective cloud water mixing ratio. + difzm_idx, & ! detrained convective cloud ice mixing ratio. + dnlfzm_idx, & ! detrained convective cloud water num concen. + dnifzm_idx, & ! detrained convective cloud ice num concen. + prec_dp_idx, & + snow_dp_idx + + real(r8), parameter :: unset_r8 = huge(1.0_r8) + real(r8) :: zmconv_c0_lnd = unset_r8 + real(r8) :: zmconv_c0_ocn = unset_r8 + real(r8) :: zmconv_ke = unset_r8 + real(r8) :: zmconv_ke_lnd = unset_r8 + real(r8) :: zmconv_momcu = unset_r8 + real(r8) :: zmconv_momcd = unset_r8 + integer :: zmconv_num_cin ! Number of negative buoyancy regions that are allowed + ! before the convection top and CAPE calculations are completed. + logical :: zmconv_org ! Parameterization for sub-grid scale convective organization for the ZM deep + ! convective scheme based on Mapes and Neale (2011) + logical :: zmconv_microp = .false. ! switch for microphysics + + +! indices for fields in the physics buffer + integer :: cld_idx = 0 + integer :: icwmrdp_idx = 0 + integer :: rprddp_idx = 0 + integer :: fracis_idx = 0 + integer :: nevapr_dpcu_idx = 0 + integer :: dgnum_idx = 0 + + integer :: nmodes + integer :: nbulk + + type(zm_aero_t), allocatable :: aero(:) ! object contains information about the aerosols + +!========================================================================================= +contains +!========================================================================================= + +subroutine zm_conv_register + +!---------------------------------------- +! Purpose: register fields with the physics buffer +!---------------------------------------- + + use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4 + + implicit none + + integer idx + + call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx) + call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx) + call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx) + call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx) + call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx) + + ! wg layer thickness in mbs (between upper/lower interface). + call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx) + + ! wg layer thickness in mbs between lcl and maxi. + call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx) + + ! wg top level index of deep cumulus convection. + call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx) + + ! wg gathered values of maxi. + call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx) + + ! map gathered points to chunk index + call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx) + +! Flux of precipitation from deep convection (kg/m2/s) + call pbuf_add_field('DP_FLXPRC','global',dtype_r8,(/pcols,pverp/),dp_flxprc_idx) + +! Flux of snow from deep convection (kg/m2/s) + call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx) + +! deep gbm cloud liquid water (kg/kg) + call pbuf_add_field('DP_CLDLIQ','global',dtype_r8,(/pcols,pver/), dp_cldliq_idx) + +! deep gbm cloud liquid water (kg/kg) + call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx) + + call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) + call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) + call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx) + call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx) + call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx) + + ! detrained convective cloud water mixing ratio. + call pbuf_add_field('DLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dlfzm_idx) + ! detrained convective cloud ice mixing ratio. + call pbuf_add_field('DIFZM', 'physpkg', dtype_r8, (/pcols,pver/), difzm_idx) + + if (zmconv_microp) then + ! Only add the number conc fields if the microphysics is active. + + ! detrained convective cloud water num concen. + call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx) + ! detrained convective cloud ice num concen. + call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx) + end if + + if (zmconv_org) then + call cnst_add('ZM_ORG',0._r8,0._r8,0._r8,ixorg,longname='organization parameter') + endif + +end subroutine zm_conv_register + +!========================================================================================= + +subroutine zm_conv_readnl(nlfile) + + use spmd_utils, only: mpicom, masterproc, masterprocid, mpi_real8, mpi_integer, mpi_logical + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'zm_conv_readnl' + + namelist /zmconv_nl/ zmconv_c0_lnd, zmconv_c0_ocn, zmconv_num_cin, & + zmconv_ke, zmconv_ke_lnd, zmconv_org, & + zmconv_momcu, zmconv_momcd, zmconv_microp + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'zmconv_nl', status=ierr) + if (ierr == 0) then + read(unitn, zmconv_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + + ! Broadcast namelist variables + call mpi_bcast(zmconv_num_cin, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_num_cin") + call mpi_bcast(zmconv_c0_lnd, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_c0_lnd") + call mpi_bcast(zmconv_c0_ocn, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_c0_ocn") + call mpi_bcast(zmconv_ke, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_ke") + call mpi_bcast(zmconv_ke_lnd, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_ke_lnd") + call mpi_bcast(zmconv_momcu, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcu") + call mpi_bcast(zmconv_momcd, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcd") + call mpi_bcast(zmconv_org, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_org") + call mpi_bcast(zmconv_microp, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_microp") + +end subroutine zm_conv_readnl + +!========================================================================================= + +subroutine zm_conv_init(pref_edge) + +!---------------------------------------- +! Purpose: declare output fields, initialize variables needed by convection +!---------------------------------------- + + use cam_history, only: addfld, add_default, horiz_only + use ppgrid, only: pcols, pver + use zm_conv, only: zm_convi + use pmgrid, only: plev,plevp + use spmd_utils, only: masterproc + use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is + use physics_buffer, only: pbuf_get_index + + implicit none + + real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces + + + logical :: no_deep_pbl ! if true, no deep convection in PBL + integer limcnv ! top interface level limit for convection + integer k, istat + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + +! Allocate the basic aero structure outside the zmconv_microp logical +! This allows the aero structure to be passed +! Note that all of the arrays inside this structure are conditionally allocated + + allocate(aero(begchunk:endchunk)) + +! +! Register fields with the output buffer +! + + if (zmconv_org) then + call addfld ('ZM_ORG ', (/ 'lev' /), 'A', '- ','Organization parameter') + call addfld ('ZM_ORG2D ', (/ 'lev' /), 'A', '- ','Organization parameter 2D') + endif + call addfld ('PRECZ', horiz_only, 'A', 'm/s','total precipitation from ZM convection') + call addfld ('ZMDT', (/ 'lev' /), 'A', 'K/s','T tendency - Zhang-McFarlane moist convection') + call addfld ('ZMDQ', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Zhang-McFarlane moist convection') + call addfld ('ZMDICE', (/ 'lev' /), 'A', 'kg/kg/s','Cloud ice tendency - Zhang-McFarlane convection') + call addfld ('ZMDLIQ', (/ 'lev' /), 'A', 'kg/kg/s','Cloud liq tendency - Zhang-McFarlane convection') + call addfld ('EVAPTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Evaporation/snow prod from Zhang convection') + call addfld ('FZSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Rain to snow conversion from Zhang convection') + call addfld ('EVSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Snow to rain prod from Zhang convection') + call addfld ('EVAPQZM', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Evaporation from Zhang-McFarlane moist convection') + + call addfld ('ZMFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of precipitation from ZM convection' ) + call addfld ('ZMFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of snow from ZM convection' ) + call addfld ('ZMNTPRPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net precipitation production from ZM convection') + call addfld ('ZMNTSNPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net snow production from ZM convection' ) + call addfld ('ZMEIHEAT', (/ 'lev' /) , 'A', 'W/kg' ,'Heating by ice and evaporation in ZM convection') + + call addfld ('CMFMCDZM', (/ 'ilev' /), 'A', 'kg/m2/s','Convection mass flux from ZM deep ') + call addfld ('PRECCDZM', horiz_only, 'A', 'm/s','Convective precipitation rate from ZM deep') + + call addfld ('PCONVB', horiz_only , 'A', 'Pa' ,'convection base pressure') + call addfld ('PCONVT', horiz_only , 'A', 'Pa' ,'convection top pressure') + + call addfld ('CAPE', horiz_only, 'A', 'J/kg', 'Convectively available potential energy') + call addfld ('FREQZM', horiz_only , 'A', 'fraction', 'Fractional occurance of ZM convection') + + call addfld ('ZMMTT', (/ 'lev' /), 'A', 'K/s', 'T tendency - ZM convective momentum transport') + call addfld ('ZMMTU', (/ 'lev' /), 'A', 'm/s2', 'U tendency - ZM convective momentum transport') + call addfld ('ZMMTV', (/ 'lev' /), 'A', 'm/s2', 'V tendency - ZM convective momentum transport') + + call addfld ('ZMMU', (/ 'lev' /), 'A', 'kg/m2/s', 'ZM convection updraft mass flux') + call addfld ('ZMMD', (/ 'lev' /), 'A', 'kg/m2/s', 'ZM convection downdraft mass flux') + + call addfld ('ZMUPGU', (/ 'lev' /), 'A', 'm/s2', 'zonal force from ZM updraft pressure gradient term') + call addfld ('ZMUPGD', (/ 'lev' /), 'A', 'm/s2', 'zonal force from ZM downdraft pressure gradient term') + call addfld ('ZMVPGU', (/ 'lev' /), 'A', 'm/s2', 'meridional force from ZM updraft pressure gradient term') + call addfld ('ZMVPGD', (/ 'lev' /), 'A', 'm/s2', 'merdional force from ZM downdraft pressure gradient term') + + call addfld ('ZMICUU', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud U updrafts') + call addfld ('ZMICUD', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud U downdrafts') + call addfld ('ZMICVU', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V updrafts') + call addfld ('ZMICVD', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V downdrafts') + + call addfld ('DIFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained ice water from ZM convection') + call addfld ('DLFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained liquid water from ZM convection') + + call phys_getopts( history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + if (zmconv_org) then + call add_default('ZM_ORG', 1, ' ') + call add_default('ZM_ORG2D', 1, ' ') + endif + if ( history_budget ) then + call add_default('EVAPTZM ', history_budget_histfile_num, ' ') + call add_default('EVAPQZM ', history_budget_histfile_num, ' ') + call add_default('ZMDT ', history_budget_histfile_num, ' ') + call add_default('ZMDQ ', history_budget_histfile_num, ' ') + call add_default('ZMDLIQ ', history_budget_histfile_num, ' ') + call add_default('ZMDICE ', history_budget_histfile_num, ' ') + call add_default('ZMMTT ', history_budget_histfile_num, ' ') + end if + + if (zmconv_microp) then + call add_default ('DIFZM', 1, ' ') + call add_default ('DLFZM', 1, ' ') + end if +! +! Limit deep convection to regions below 40 mb +! Note this calculation is repeated in the shallow convection interface +! + limcnv = 0 ! null value to check against below + if (pref_edge(1) >= 4.e3_r8) then + limcnv = 1 + else + do k=1,plev + if (pref_edge(k) < 4.e3_r8 .and. pref_edge(k+1) >= 4.e3_r8) then + limcnv = k + exit + end if + end do + if ( limcnv == 0 ) limcnv = plevp + end if + + if (masterproc) then + write(iulog,*)'ZM_CONV_INIT: Deep convection will be capped at intfc ',limcnv, & + ' which is ',pref_edge(limcnv),' pascals' + end if + + no_deep_pbl = phys_deepconv_pbl() + call zm_convi(limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & + zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & + zmconv_microp, no_deep_pbl_in = no_deep_pbl) + + cld_idx = pbuf_get_index('CLD') + fracis_idx = pbuf_get_index('FRACIS') + + if (zmconv_microp) call zm_conv_micro_init() + +end subroutine zm_conv_init +!========================================================================================= +!subroutine zm_conv_tend(state, ptend, tdt) + +subroutine zm_conv_tend(pblh ,mcon ,cme , & + tpert ,pflx ,zdu , & + rliq ,rice ,ztodt , & + jctop ,jcbot , & + state ,ptend_all ,landfrac, pbuf) + + + use cam_history, only: outfld + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init, physics_update + use physics_types, only: physics_state_copy, physics_state_dealloc + use physics_types, only: physics_ptend_sum, physics_ptend_dealloc + + use phys_grid, only: get_lat_p, get_lon_p + use time_manager, only: get_nstep, is_first_step + use physics_buffer, only : pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx + use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1 + use check_energy, only: check_energy_chng + use physconst, only: gravit + use phys_control, only: cam_physpkg_is + + ! Arguments + + type(physics_state), intent(in),target :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend_all ! individual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + real(r8), intent(in) :: pblh(pcols) ! Planetary boundary layer height + real(r8), intent(in) :: tpert(pcols) ! Thermal temperature excess + real(r8), intent(in) :: landfrac(pcols) ! RBN - Landfrac + + real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c + real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level + real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation + real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux + + real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals + real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals + + + ! Local variables + + type(zm_conv_t) :: conv + + integer :: i,k,l,m + integer :: ilon ! global longitude index of a column + integer :: ilat ! global latitude index of a column + integer :: nstep + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: itim_old ! for physics buffer fields + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + real(r8) :: ntprprd(pcols,pver) ! evap outfld: net precip production in layer + real(r8) :: ntsnprd(pcols,pver) ! evap outfld: net snow production in layer + real(r8) :: tend_s_snwprd (pcols,pver) ! Heating rate of snow production + real(r8) :: tend_s_snwevmlt(pcols,pver) ! Heating rate of evap/melting of snow + real(r8) :: fake_dpdry(pcols,pver) ! used in convtran call + + ! physics types + type(physics_state) :: state1 ! locally modify for evaporation to use, not returned + type(physics_ptend),target :: ptend_loc ! package tendencies + + ! physics buffer fields + real(r8), pointer, dimension(:) :: prec ! total precipitation + real(r8), pointer, dimension(:) :: snow ! snow from ZM convection + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water. + real(r8), pointer, dimension(:,:) :: rprd ! rain production rate + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation + real(r8), pointer, dimension(:,:) :: flxprec ! Convective-scale flux of precip at interfaces (kg/m2/s) + real(r8), pointer, dimension(:,:) :: flxsnow ! Convective-scale flux of snow at interfaces (kg/m2/s) + real(r8), pointer, dimension(:,:) :: dp_cldliq + real(r8), pointer, dimension(:,:) :: dp_cldice + real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio. + real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio. + real(r8), pointer :: dnlf(:,:) ! detrained convective cloud water num concen. + real(r8), pointer :: dnif(:,:) ! detrained convective cloud ice num concen. + real(r8), pointer :: lambdadpcu(:,:) ! slope of cloud liquid size distr + real(r8), pointer :: mudpcu(:,:) ! width parameter of droplet size distr + + real(r8), pointer :: mu(:,:) ! (pcols,pver) + real(r8), pointer :: eu(:,:) ! (pcols,pver) + real(r8), pointer :: du(:,:) ! (pcols,pver) + real(r8), pointer :: md(:,:) ! (pcols,pver) + real(r8), pointer :: ed(:,:) ! (pcols,pver) + real(r8), pointer :: dp(:,:) ! (pcols,pver) + real(r8), pointer :: dsubcld(:) ! (pcols) + integer, pointer :: jt(:) ! (pcols) + integer, pointer :: maxg(:) ! (pcols) + integer, pointer :: ideep(:) ! (pcols) + integer :: lengath + + real(r8) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. + real(r8) :: jcbot(pcols) ! o row of base of cloud indices passed out. + + real(r8) :: pcont(pcols), pconb(pcols), freqzm(pcols) + + ! history output fields + real(r8) :: cape(pcols) ! w convective available potential energy. + real(r8) :: mu_out(pcols,pver) + real(r8) :: md_out(pcols,pver) + + ! used in momentum transport calculation + real(r8) :: winds(pcols, pver, 2) + real(r8) :: wind_tends(pcols, pver, 2) + real(r8) :: pguall(pcols, pver, 2) + real(r8) :: pgdall(pcols, pver, 2) + real(r8) :: icwu(pcols,pver, 2) + real(r8) :: icwd(pcols,pver, 2) + real(r8) :: seten(pcols, pver) + logical :: l_windt(2) + real(r8) :: tfinal1, tfinal2 + integer :: ii + + real(r8),pointer :: zm_org2d(:,:) + real(r8),pointer :: orgt(:,:), org(:,:) + + logical :: lq(pcnst) + + !---------------------------------------------------------------------- + + ! initialize + lchnk = state%lchnk + ncol = state%ncol + nstep = get_nstep() + + if (zmconv_microp) then + allocate( & + conv%qi(pcols,pver), & + conv%qliq(pcols,pver), & + conv%qice(pcols,pver), & + conv%wu(pcols,pver), & + conv%sprd(pcols,pver), & + conv%qrain(pcols,pver), & + conv%qsnow(pcols,pver), & + conv%qnl(pcols,pver), & + conv%qni(pcols,pver), & + conv%qnr(pcols,pver), & + conv%qns(pcols,pver), & + conv%frz(pcols,pver), & + conv%autolm(pcols,pver), & + conv%accrlm(pcols,pver), & + conv%bergnm(pcols,pver), & + conv%fhtimm(pcols,pver), & + conv%fhtctm(pcols,pver), & + conv%fhmlm (pcols,pver), & + conv%hmpim (pcols,pver), & + conv%accslm(pcols,pver), & + conv%dlfm (pcols,pver), & + conv%autoln(pcols,pver), & + conv%accrln(pcols,pver), & + conv%bergnn(pcols,pver), & + conv%fhtimn(pcols,pver), & + conv%fhtctn(pcols,pver), & + conv%fhmln (pcols,pver), & + conv%accsln(pcols,pver), & + conv%activn(pcols,pver), & + conv%dlfn (pcols,pver), & + conv%autoim(pcols,pver), & + conv%accsim(pcols,pver), & + conv%difm (pcols,pver), & + conv%nuclin(pcols,pver), & + conv%autoin(pcols,pver), & + conv%accsin(pcols,pver), & + conv%hmpin (pcols,pver), & + conv%difn (pcols,pver), & + conv%cmel (pcols,pver), & + conv%cmei (pcols,pver), & + conv%trspcm(pcols,pver), & + conv%trspcn(pcols,pver), & + conv%trspim(pcols,pver), & + conv%trspin(pcols,pver), & + conv%lambdadpcu(pcols,pver), & + conv%mudpcu(pcols,pver), & + conv%dcape(pcols) ) + end if + + ftem = 0._r8 + mu_out(:,:) = 0._r8 + md_out(:,:) = 0._r8 + wind_tends(:ncol,:pver,:) = 0.0_r8 + + call physics_state_copy(state,state1) ! copy state to local state1. + + lq(:) = .FALSE. + lq(1) = .TRUE. + if (zmconv_org) then + lq(ixorg) = .TRUE. + endif + call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type + +! +! Associate pointers with physics buffer fields +! + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, icwmrdp_idx, ql ) + call pbuf_get_field(pbuf, rprddp_idx, rprd ) + call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + call pbuf_get_field(pbuf, prec_dp_idx, prec ) + call pbuf_get_field(pbuf, snow_dp_idx, snow ) + + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + call pbuf_get_field(pbuf, dlfzm_idx, dlf) + call pbuf_get_field(pbuf, difzm_idx, dif) + + if (zmconv_microp) then + call pbuf_get_field(pbuf, dnlfzm_idx, dnlf) + call pbuf_get_field(pbuf, dnifzm_idx, dnif) + else + allocate(dnlf(pcols,pver), dnif(pcols,pver)) + end if + + if (zmconv_microp) then + + if (nmodes > 0) then + + ! Associate pointers with the modes and species that affect the climate + ! (list 0) + + do m = 1, nmodes + call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, aero(lchnk)%num_a(m)%val) + call pbuf_get_field(pbuf, dgnum_idx, aero(lchnk)%dgnum(m)%val, start=(/1,1,m/), kount=(/pcols,pver,1/)) + + do l = 1, aero(lchnk)%nspec(m) + call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, aero(lchnk)%mmr_a(l,m)%val) + end do + end do + + else if (nbulk > 0) then + + ! Associate pointers with the bulk aerosols that affect the climate + ! (list 0) + + do m = 1, nbulk + call rad_cnst_get_aer_mmr(0, m, state, pbuf, aero(lchnk)%mmr_bulk(m)%val) + end do + + end if + end if + +! +! Begin with Zhang-McFarlane (1996) convection parameterization +! + call t_startf ('zm_convr') + + if (zmconv_org) then + allocate(zm_org2d(pcols,pver)) + org => state%q(:,:,ixorg) + orgt => ptend_loc%q(:,:,ixorg) + endif + + call zm_convr( lchnk ,ncol , & + state%t ,state%q(:,:,1), prec ,jctop ,jcbot , & + pblh ,state%zm ,state%phis ,state%zi ,ptend_loc%q(:,:,1) , & + ptend_loc%s , state%pmid ,state%pint ,state%pdel , & + .5_r8*ztodt ,mcon ,cme , cape, & + tpert ,dlf ,pflx ,zdu ,rprd , & + mu, md, du, eu, ed, & + dp, dsubcld, jt, maxg, ideep, & + ql, rliq, landfrac, & + org, orgt, zm_org2d, & + dif, dnlf, dnif, conv, & + aero(lchnk), rice) + + lengath = count(ideep > 0) + + call outfld('CAPE', cape, pcols, lchnk) ! RBN - CAPE output +! +! Output fractional occurance of ZM convection +! + freqzm(:) = 0._r8 + do i = 1,lengath + freqzm(ideep(i)) = 1.0_r8 + end do + call outfld('FREQZM ',freqzm ,pcols ,lchnk ) +! +! Convert mass flux from reported mb/s to kg/m^2/s +! + mcon(:ncol,:pver) = mcon(:ncol,:pver) * 100._r8/gravit + + call outfld('CMFMCDZM', mcon, pcols, lchnk) + + ! Store upward and downward mass fluxes in un-gathered arrays + ! + convert from mb/s to kg/m^2/s + do i=1,lengath + do k=1,pver + ii = ideep(i) + mu_out(ii,k) = mu(i,k) * 100._r8/gravit + md_out(ii,k) = md(i,k) * 100._r8/gravit + end do + end do + + call outfld('ZMMU', mu_out, pcols, lchnk) + call outfld('ZMMD', md_out, pcols, lchnk) + + ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair + call outfld('ZMDT ',ftem ,pcols ,lchnk ) + call outfld('ZMDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk ) + call t_stopf ('zm_convr') + + call outfld('DIFZM' ,dif ,pcols, lchnk) + call outfld('DLFZM' ,dlf ,pcols, lchnk) + + if (zmconv_microp) call zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) + + pcont(:ncol) = state%ps(:ncol) + pconb(:ncol) = state%ps(:ncol) + do i = 1,lengath + if (maxg(i).gt.jt(i)) then + pcont(ideep(i)) = state%pmid(ideep(i),jt(i)) ! gathered array (or jctop ungathered) + pconb(ideep(i)) = state%pmid(ideep(i),maxg(i))! gathered array + endif + ! write(iulog,*) ' pcont, pconb ', pcont(i), pconb(i), cnt(i), cnb(i) + end do + call outfld('PCONVT ',pcont ,pcols ,lchnk ) + call outfld('PCONVB ',pconb ,pcols ,lchnk ) + + call physics_ptend_init(ptend_all, state%psetcols, 'zm_conv_tend') + + ! add tendency from this process to tendencies from other processes + call physics_ptend_sum(ptend_loc,ptend_all, ncol) + + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) + + ! initialize ptend for next process + lq(:) = .FALSE. + lq(1) = .TRUE. + if (zmconv_org) then + lq(ixorg) = .TRUE. + endif + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + + call t_startf ('zm_conv_evap') +! +! Determine the phase of the precipitation produced and add latent heat of fusion +! Evaporate some of the precip directly into the environment (Sundqvist) +! Allow this to use the updated state1 and the fresh ptend_loc type +! heating and specific humidity tendencies produced +! + + call pbuf_get_field(pbuf, dp_flxprc_idx, flxprec ) + call pbuf_get_field(pbuf, dp_flxsnw_idx, flxsnow ) + call pbuf_get_field(pbuf, dp_cldliq_idx, dp_cldliq ) + call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice ) + dp_cldliq(:ncol,:) = 0._r8 + dp_cldice(:ncol,:) = 0._r8 + + call zm_conv_evap(state1%ncol,state1%lchnk, & + state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & + landfrac, & + ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & + rprd, cld, ztodt, & + prec, snow, ntprprd, ntsnprd , flxprec, flxsnow, conv%sprd) + + evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) + + if (zmconv_org) then + ptend_loc%q(:ncol,:pver,ixorg) = min(1._r8,max(0._r8,(50._r8*1000._r8*1000._r8*abs(evapcdp(:ncol,:pver))) & + -(state%q(:ncol,:pver,ixorg)/10800._r8))) + ptend_loc%q(:ncol,:pver,ixorg) = (ptend_loc%q(:ncol,:pver,ixorg) - state%q(:ncol,:pver,ixorg))/ztodt + endif + +! +! Write out variables from zm_conv_evap +! + ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair + call outfld('EVAPTZM ',ftem ,pcols ,lchnk ) + ftem(:ncol,:pver) = tend_s_snwprd (:ncol,:pver)/cpair + call outfld('FZSNTZM ',ftem ,pcols ,lchnk ) + ftem(:ncol,:pver) = tend_s_snwevmlt(:ncol,:pver)/cpair + call outfld('EVSNTZM ',ftem ,pcols ,lchnk ) + call outfld('EVAPQZM ',ptend_loc%q(1,1,1) ,pcols ,lchnk ) + call outfld('ZMFLXPRC', flxprec, pcols, lchnk) + call outfld('ZMFLXSNW', flxsnow, pcols, lchnk) + call outfld('ZMNTPRPD', ntprprd, pcols, lchnk) + call outfld('ZMNTSNPD', ntsnprd, pcols, lchnk) + call outfld('ZMEIHEAT', ptend_loc%s, pcols, lchnk) + call outfld('CMFMCDZM ',mcon , pcols ,lchnk ) + call outfld('PRECCDZM ',prec, pcols ,lchnk ) + + + call t_stopf ('zm_conv_evap') + + call outfld('PRECZ ', prec , pcols, lchnk) + + ! add tendency from this process to tend from other processes here + call physics_ptend_sum(ptend_loc,ptend_all, ncol) + + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) + + + ! Momentum Transport (non-cam3 physics) + + if ( .not. cam_physpkg_is('cam3')) then + + call physics_ptend_init(ptend_loc, state1%psetcols, 'momtran', ls=.true., lu=.true., lv=.true.) + + winds(:ncol,:pver,1) = state1%u(:ncol,:pver) + winds(:ncol,:pver,2) = state1%v(:ncol,:pver) + + l_windt(1) = .true. + l_windt(2) = .true. + + call t_startf ('momtran') + call momtran (lchnk, ncol, & + l_windt,winds, 2, mu, md, & + du, eu, ed, dp, dsubcld, & + jt, maxg, ideep, 1, lengath, & + nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) + call t_stopf ('momtran') + + ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1) + ptend_loc%v(:ncol,:pver) = wind_tends(:ncol,:pver,2) + ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) + + call physics_ptend_sum(ptend_loc,ptend_all, ncol) + + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) + + ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair + if (zmconv_org) then + call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) + call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) + endif + call outfld('ZMMTT', ftem , pcols, lchnk) + call outfld('ZMMTU', wind_tends(1,1,1), pcols, lchnk) + call outfld('ZMMTV', wind_tends(1,1,2), pcols, lchnk) + + ! Output apparent force from pressure gradient + call outfld('ZMUPGU', pguall(1,1,1), pcols, lchnk) + call outfld('ZMUPGD', pgdall(1,1,1), pcols, lchnk) + call outfld('ZMVPGU', pguall(1,1,2), pcols, lchnk) + call outfld('ZMVPGD', pgdall(1,1,2), pcols, lchnk) + + ! Output in-cloud winds + call outfld('ZMICUU', icwu(1,1,1), pcols, lchnk) + call outfld('ZMICUD', icwd(1,1,1), pcols, lchnk) + call outfld('ZMICVU', icwu(1,1,2), pcols, lchnk) + call outfld('ZMICVD', icwd(1,1,2), pcols, lchnk) + + end if + + ! Transport cloud water and ice only + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + lq(:) = .FALSE. + lq(2:) = cnst_is_convtran1(2:) + call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) + + + ! dpdry is not used in this call to convtran since the cloud liquid and ice mixing + ! ratios are moist + fake_dpdry(:,:) = 0._r8 + + call t_startf ('convtran1') + call convtran (lchnk, & + ptend_loc%lq,state1%q, pcnst, mu, md, & + du, eu, ed, dp, dsubcld, & + jt,maxg, ideep, 1, lengath, & + nstep, fracis, ptend_loc%q, fake_dpdry, ztodt) + call t_stopf ('convtran1') + + call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk ) + call outfld('ZMDLIQ ',ptend_loc%q(1,1,ixcldliq) ,pcols ,lchnk ) + + ! add tendency from this process to tend from other processes here + call physics_ptend_sum(ptend_loc,ptend_all, ncol) + + call physics_state_dealloc(state1) + call physics_ptend_dealloc(ptend_loc) + + if (zmconv_org) then + deallocate(zm_org2d) + end if + + if (zmconv_microp) then + deallocate( & + conv%qi, & + conv%qliq, & + conv%qice, & + conv%wu, & + conv%sprd, & + conv%qrain, & + conv%qsnow, & + conv%qnl, & + conv%qni, & + conv%qnr, & + conv%qns, & + conv%frz, & + conv%autolm, & + conv%accrlm, & + conv%bergnm, & + conv%fhtimm, & + conv%fhtctm, & + conv%fhmlm , & + conv%hmpim , & + conv%accslm, & + conv%dlfm , & + conv%autoln, & + conv%accrln, & + conv%bergnn, & + conv%fhtimn, & + conv%fhtctn, & + conv%fhmln , & + conv%accsln, & + conv%activn, & + conv%dlfn , & + conv%autoim, & + conv%accsim, & + conv%difm , & + conv%nuclin, & + conv%autoin, & + conv%accsin, & + conv%hmpin , & + conv%difn , & + conv%cmel , & + conv%cmei , & + conv%trspcm, & + conv%trspcn, & + conv%trspim, & + conv%trspin, & + conv%lambdadpcu, & + conv%mudpcu, & + conv%dcape ) + + else + + deallocate(dnlf, dnif) + + end if + +end subroutine zm_conv_tend +!========================================================================================= + + +subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use time_manager, only: get_nstep + use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc + use constituents, only: pcnst, cnst_is_convtran2 + +! Arguments + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + +! Local variables + integer :: i, lchnk, istat + integer :: lengath ! number of columns with deep convection + integer :: nstep + + real(r8), dimension(pcols,pver) :: dpdry + + ! physics buffer fields + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + real(r8), pointer :: mu(:,:) ! (pcols,pver) + real(r8), pointer :: eu(:,:) ! (pcols,pver) + real(r8), pointer :: du(:,:) ! (pcols,pver) + real(r8), pointer :: md(:,:) ! (pcols,pver) + real(r8), pointer :: ed(:,:) ! (pcols,pver) + real(r8), pointer :: dp(:,:) ! (pcols,pver) + real(r8), pointer :: dsubcld(:) ! (pcols) + integer, pointer :: jt(:) ! (pcols) + integer, pointer :: maxg(:) ! (pcols) + integer, pointer :: ideep(:) ! (pcols) + !----------------------------------------------------------------------------------- + + + call physics_ptend_init(ptend, state%psetcols, 'convtran2', lq=cnst_is_convtran2 ) + + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, zm_mu_idx, mu) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_md_idx, md) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + lengath = count(ideep > 0) + + lchnk = state%lchnk + nstep = get_nstep() + + if (any(ptend%lq(:))) then + ! initialize dpdry for call to convtran + ! it is used for tracers of dry mixing ratio type + dpdry = 0._r8 + do i = 1, lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + end do + + call t_startf ('convtran2') + call convtran (lchnk, & + ptend%lq,state%q, pcnst, mu, md, & + du, eu, ed, dp, dsubcld, & + jt, maxg, ideep, 1, lengath, & + nstep, fracis, ptend%q, dpdry, ztodt) + call t_stopf ('convtran2') + end if + +end subroutine zm_conv_tend_2 + +!========================================================================================= + +subroutine zm_conv_micro_init() + + use cam_history, only: addfld, add_default, horiz_only + use ppgrid, only: pcols, pver + use pmgrid, only: plev,plevp + use phys_control, only: cam_physpkg_is + use physics_buffer, only: pbuf_get_index + use zm_microphysics, only: zm_mphyi + + implicit none + + integer :: i + + ! + ! Register fields with the output buffer + ! + call addfld ('ICIMRDP', (/ 'lev' /), 'A','kg/kg', 'Deep Convection in-cloud ice mixing ratio ') + call addfld ('CLDLIQZM',(/ 'lev' /), 'A','g/m3' ,'Cloud liquid water - ZM convection') + call addfld ('CLDICEZM',(/ 'lev' /), 'A','g/m3' ,'Cloud ice water - ZM convection') + call addfld ('CLIQSNUM',(/ 'lev' /), 'A','1' ,'Cloud liquid water sample number - ZM convection') + call addfld ('CICESNUM',(/ 'lev' /), 'A','1' ,'Cloud ice water sample number - ZM convection') + call addfld ('QRAINZM' ,(/ 'lev' /), 'A','g/m3' ,'rain water - ZM convection') + call addfld ('QSNOWZM' ,(/ 'lev' /), 'A','g/m3' ,'snow - ZM convection') + call addfld ('CRAINNUM',(/ 'lev' /), 'A','1' ,'Cloud rain water sample number - ZM convection') + call addfld ('CSNOWNUM',(/ 'lev' /), 'A','1' ,'Cloud snow sample number - ZM convection') + + call addfld ('DNIFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained ice water num concen from ZM convection') + call addfld ('DNLFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained liquid water num concen from ZM convection') + call addfld ('WUZM' ,(/ 'lev' /), 'A','m/s' ,'vertical velocity - ZM convection') + call addfld ('WUZMSNUM',(/ 'lev' /), 'A','1' ,'vertical velocity sample number - ZM convection') + + call addfld ('QNLZM',(/ 'lev' /), 'A','1/m3' ,'Cloud liquid water number concen - ZM convection') + call addfld ('QNIZM',(/ 'lev' /), 'A','1/m3' ,'Cloud ice number concen - ZM convection') + call addfld ('QNRZM',(/ 'lev' /), 'A','1/m3' ,'Cloud rain water number concen - ZM convection') + call addfld ('QNSZM',(/ 'lev' /), 'A','1/m3' ,'Cloud snow number concen - ZM convection') + + call addfld ('FRZZM',(/ 'lev' /), 'A','1/s' ,'mass tendency due to freezing - ZM convection') + + call addfld ('AUTOL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of droplets to rain') + call addfld ('ACCRL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplets by rain') + call addfld ('BERGN_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to Bergeron process') + call addfld ('FHTIM_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to immersion freezing') + call addfld ('FHTCT_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to contact freezing') + call addfld ('FHML_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to homogeneous freezing of droplet') + call addfld ('HMPI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to HM process') + call addfld ('ACCSL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplet by snow') + call addfld ('DLF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of droplet') + call addfld ('COND_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to condensation') + + call addfld ('AUTOL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of droplets to rain') + call addfld ('ACCRL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplets by rain') + call addfld ('BERGN_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to Bergeron process') + call addfld ('FHTIM_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to immersion freezing') + call addfld ('FHTCT_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to contact freezing') + call addfld ('FHML_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to homogeneous freezing of droplet') + call addfld ('ACCSL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplet by snow') + call addfld ('ACTIV_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to droplets activation') + call addfld ('DLF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of droplet') + + call addfld ('AUTOI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of ice to snow') + call addfld ('ACCSI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of ice by snow') + call addfld ('DIF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of cloud ice') + call addfld ('DEPOS_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to deposition') + + call addfld ('NUCLI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to ice nucleation') + call addfld ('AUTOI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of ice to snow') + call addfld ('ACCSI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of ice by snow') + call addfld ('HMPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to HM process') + call addfld ('DIF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of cloud ice') + + call addfld ('TRSPC_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of droplets due to convective transport') + call addfld ('TRSPC_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of droplets due to convective transport') + call addfld ('TRSPI_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of ice crystal due to convective transport') + call addfld ('TRSPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of ice crystal due to convective transport') + + + call add_default ('CLDLIQZM', 1, ' ') + call add_default ('CLDICEZM', 1, ' ') + call add_default ('CLIQSNUM', 1, ' ') + call add_default ('CICESNUM', 1, ' ') + call add_default ('DNIFZM', 1, ' ') + call add_default ('DNLFZM', 1, ' ') + call add_default ('WUZM', 1, ' ') + call add_default ('QRAINZM', 1, ' ') + call add_default ('QSNOWZM', 1, ' ') + call add_default ('CRAINNUM', 1, ' ') + call add_default ('CSNOWNUM', 1, ' ') + call add_default ('QNLZM', 1, ' ') + call add_default ('QNIZM', 1, ' ') + call add_default ('QNRZM', 1, ' ') + call add_default ('QNSZM', 1, ' ') + call add_default ('FRZZM', 1, ' ') + + ! Initialization for the microphysics + + call zm_mphyi() + + ! Initialize the aerosol object with data from the modes/species + ! affecting climate, + ! i.e., the list index is hardcoded to 0. + + call rad_cnst_get_info(0, nmodes=nmodes, naero=nbulk) + + + do i = begchunk, endchunk + call zm_aero_init(nmodes, nbulk, aero(i)) + end do + + if (nmodes > 0) then + + dgnum_idx = pbuf_get_index('DGNUM') + + else if (nbulk > 0 .and. cam_physpkg_is('cam4')) then + + ! This call is needed to allow running the ZM microphysics with the + ! cam4 physics package. + call ndrop_bam_init() + + end if + + end subroutine zm_conv_micro_init + + + subroutine zm_aero_init(nmodes, nbulk, aero) + + use pmgrid, only: plev,plevp + + ! Initialize the zm_aero_t object for modal aerosols + + integer, intent(in) :: nmodes + integer, intent(in) :: nbulk + type(zm_aero_t), intent(out) :: aero + + integer :: iaer, l, m + integer :: nspecmx ! max number of species in a mode + + character(len=20), allocatable :: aername(:) + character(len=32) :: str32 + character(len=*), parameter :: routine = 'zm_conv_init' + + real(r8) :: sigmag, dgnumlo, dgnumhi + real(r8) :: alnsg + !---------------------------------------------------------------------------------- + + aero%nmodes = nmodes + aero%nbulk = nbulk + + if (nmodes > 0) then + + ! Initialize the modal aerosol information + + aero%scheme = 'modal' + + ! Get number of species in each mode, and find max. + allocate(aero%nspec(aero%nmodes)) + nspecmx = 0 + do m = 1, aero%nmodes + + call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32) + + nspecmx = max(nspecmx, aero%nspec(m)) + + ! save mode index for specified mode types + select case (trim(str32)) + case ('accum') + aero%mode_accum_idx = m + case ('aitken') + aero%mode_aitken_idx = m + case ('coarse') + aero%mode_coarse_idx = m + end select + + end do + + ! Check that required mode types were found + if (aero%mode_accum_idx == -1 .or. aero%mode_aitken_idx == -1 .or. aero%mode_coarse_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx + call endrun(routine//': ERROR required mode type not found') + end if + + ! find indices for the dust and seasalt species in the coarse mode + do l = 1, aero%nspec(aero%mode_coarse_idx) + call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32) + select case (trim(str32)) + case ('dust') + aero%coarse_dust_idx = l + case ('seasalt') + aero%coarse_nacl_idx = l + end select + end do + ! Check that required modal specie types were found + if (aero%coarse_dust_idx == -1 .or. aero%coarse_nacl_idx == -1) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + aero%coarse_dust_idx, aero%coarse_nacl_idx + call endrun(routine//': ERROR required mode-species type not found') + end if + + allocate( & + aero%num_a(nmodes), & + aero%mmr_a(nspecmx,nmodes), & + aero%numg_a(pcols,pver,nmodes), & + aero%mmrg_a(pcols,pver,nspecmx,nmodes), & + aero%voltonumblo(nmodes), & + aero%voltonumbhi(nmodes), & + aero%specdens(nspecmx,nmodes), & + aero%spechygro(nspecmx,nmodes), & + aero%dgnum(nmodes), & + aero%dgnumg(pcols,pver,nmodes) ) + + + do m = 1, nmodes + + ! Properties of modes + call rad_cnst_get_mode_props(0, m, & + sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi) + + alnsg = log(sigmag) + aero%voltonumblo(m) = 1._r8 / ( (pi/6._r8)*(dgnumlo**3._r8)*exp(4.5_r8*alnsg**2._r8) ) + aero%voltonumbhi(m) = 1._r8 / ( (pi/6._r8)*(dgnumhi**3._r8)*exp(4.5_r8*alnsg**2._r8) ) + + ! save sigmag of aitken mode + if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag + + ! Properties of modal species + do l = 1, aero%nspec(m) + call rad_cnst_get_aer_props(0, m, l, density_aer=aero%specdens(l,m), & + hygro_aer=aero%spechygro(l,m)) + end do + end do + + else if (nbulk > 0) then + + aero%scheme = 'bulk' + + ! Props needed for BAM number concentration calcs. + allocate( & + aername(nbulk), & + aero%num_to_mass_aer(nbulk), & + aero%mmr_bulk(nbulk), & + aero%mmrg_bulk(pcols,plev,nbulk) ) + + do iaer = 1, aero%nbulk + call rad_cnst_get_aer_props(0, iaer, & + aername = aername(iaer), & + num_to_mass_aer = aero%num_to_mass_aer(iaer) ) + + ! Look for sulfate aerosol in this list (Bulk aerosol only) + if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer + if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer + if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer + if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer + if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer + if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer + end do + + end if + + end subroutine zm_aero_init + + subroutine zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) + + use cam_history, only: outfld + + type(zm_conv_t),intent(in) :: conv + real(r8), intent(in) :: dnlf(:,:) ! detrained convective cloud water num concen. + real(r8), intent(in) :: dnif(:,:) ! detrained convective cloud ice num concen. + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + + integer :: i,k + + real(r8) :: cice_snum(pcols,pver) ! convective cloud ice sample number. + real(r8) :: cliq_snum(pcols,pver) ! convective cloud liquid sample number. + real(r8) :: crain_snum(pcols,pver) ! convective rain water sample number. + real(r8) :: csnow_snum(pcols,pver) ! convective snow sample number. + real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number + + real(r8) :: qni_snum(pcols,pver) ! convective cloud ice number sample number. + real(r8) :: qnl_snum(pcols,pver) ! convective cloud liquid number sample number. + + do k = 1,pver + do i = 1,ncol + if (conv%qice(i,k) .gt. 0.0_r8) then + cice_snum(i,k) = 1.0_r8 + else + cice_snum(i,k) = 0.0_r8 + end if + if (conv%qliq(i,k) .gt. 0.0_r8) then + cliq_snum(i,k) = 1.0_r8 + else + cliq_snum(i,k) = 0.0_r8 + end if + if (conv%qsnow(i,k) .gt. 0.0_r8) then + csnow_snum(i,k) = 1.0_r8 + else + csnow_snum(i,k) = 0.0_r8 + end if + if (conv%qrain(i,k) .gt. 0.0_r8) then + crain_snum(i,k) = 1.0_r8 + else + crain_snum(i,k) = 0.0_r8 + end if + + if (conv%qnl(i,k) .gt. 0.0_r8) then + qnl_snum(i,k) = 1.0_r8 + else + qnl_snum(i,k) = 0.0_r8 + end if + if (conv%qni(i,k) .gt. 0.0_r8) then + qni_snum(i,k) = 1.0_r8 + else + qni_snum(i,k) = 0.0_r8 + end if + if (conv%wu(i,k) .gt. 0.0_r8) then + wu_snum(i,k) = 1.0_r8 + else + wu_snum(i,k) = 0.0_r8 + end if + + end do + end do + + call outfld('ICIMRDP ',conv%qi ,pcols, lchnk ) + call outfld('CLDLIQZM',conv%qliq ,pcols, lchnk) + call outfld('CLDICEZM',conv%qice ,pcols, lchnk) + call outfld('CLIQSNUM',cliq_snum ,pcols, lchnk) + call outfld('CICESNUM',cice_snum ,pcols, lchnk) + call outfld('QRAINZM' ,conv%qrain ,pcols, lchnk) + call outfld('QSNOWZM' ,conv%qsnow ,pcols, lchnk) + call outfld('CRAINNUM',crain_snum ,pcols, lchnk) + call outfld('CSNOWNUM',csnow_snum ,pcols, lchnk) + + call outfld('WUZM' ,conv%wu ,pcols, lchnk) + call outfld('WUZMSNUM',wu_snum ,pcols, lchnk) + call outfld('QNLZM' ,conv%qnl ,pcols, lchnk) + call outfld('QNIZM' ,conv%qni ,pcols, lchnk) + call outfld('QNRZM' ,conv%qnr ,pcols, lchnk) + call outfld('QNSZM' ,conv%qns ,pcols, lchnk) + call outfld('FRZZM' ,conv%frz ,pcols, lchnk) + + call outfld('AUTOL_M' ,conv%autolm ,pcols, lchnk) + call outfld('ACCRL_M' ,conv%accrlm ,pcols, lchnk) + call outfld('BERGN_M' ,conv%bergnm ,pcols, lchnk) + call outfld('FHTIM_M' ,conv%fhtimm ,pcols, lchnk) + call outfld('FHTCT_M' ,conv%fhtctm ,pcols, lchnk) + call outfld('FHML_M' ,conv%fhmlm ,pcols, lchnk) + call outfld('HMPI_M' ,conv%hmpim ,pcols, lchnk) + call outfld('ACCSL_M' ,conv%accslm ,pcols, lchnk) + call outfld('DLF_M' ,conv%dlfm ,pcols, lchnk) + + call outfld('AUTOL_N' ,conv%autoln ,pcols, lchnk) + call outfld('ACCRL_N' ,conv%accrln ,pcols, lchnk) + call outfld('BERGN_N' ,conv%bergnn ,pcols, lchnk) + call outfld('FHTIM_N' ,conv%fhtimn ,pcols, lchnk) + call outfld('FHTCT_N' ,conv%fhtctn ,pcols, lchnk) + call outfld('FHML_N' ,conv%fhmln ,pcols, lchnk) + call outfld('ACCSL_N' ,conv%accsln ,pcols, lchnk) + call outfld('ACTIV_N' ,conv%activn ,pcols, lchnk) + call outfld('DLF_N' ,conv%dlfn ,pcols, lchnk) + call outfld('AUTOI_M' ,conv%autoim ,pcols, lchnk) + call outfld('ACCSI_M' ,conv%accsim ,pcols, lchnk) + call outfld('DIF_M' ,conv%difm ,pcols, lchnk) + call outfld('NUCLI_N' ,conv%nuclin ,pcols, lchnk) + call outfld('AUTOI_N' ,conv%autoin ,pcols, lchnk) + call outfld('ACCSI_N' ,conv%accsin ,pcols, lchnk) + call outfld('HMPI_N' ,conv%hmpin ,pcols, lchnk) + call outfld('DIF_N' ,conv%difn ,pcols, lchnk) + call outfld('COND_M' ,conv%cmel ,pcols, lchnk) + call outfld('DEPOS_M' ,conv%cmei ,pcols, lchnk) + + call outfld('TRSPC_M' ,conv%trspcm ,pcols, lchnk) + call outfld('TRSPC_N' ,conv%trspcn ,pcols, lchnk) + call outfld('TRSPI_M' ,conv%trspim ,pcols, lchnk) + call outfld('TRSPI_N' ,conv%trspin ,pcols, lchnk) + call outfld('DNIFZM' ,dnif ,pcols, lchnk) + call outfld('DNLFZM' ,dnlf ,pcols, lchnk) + + end subroutine zm_conv_micro_outfld + +end module zm_conv_intr diff --git a/src/physics/cam/zm_microphysics.F90 b/src/physics/cam/zm_microphysics.F90 new file mode 100644 index 0000000000..29607725bc --- /dev/null +++ b/src/physics/cam/zm_microphysics.F90 @@ -0,0 +1,2445 @@ +module zm_microphysics + +!--------------------------------------------------------------------------------- +! Purpose: +! CAM Interface for cumulus microphysics +! +! Author: Xialiang Song and Guang Jun Zhang, June 2010 +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp +use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o +use physconst, only: latvap, latice +!use activate_drop_mam, only: actdrop_mam_calc +use ndrop, only: activate_modal +use ndrop_bam, only: ndrop_bam_run +use nucleate_ice, only: nucleati +use shr_spfn_mod, only: erf => shr_spfn_erf +use shr_spfn_mod, only: gamma => shr_spfn_gamma +use wv_saturation, only: svp_water, svp_ice +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use micro_mg_utils, only:ice_autoconversion, snow_self_aggregation, accrete_cloud_water_snow, & + secondary_ice_production, accrete_rain_snow, heterogeneous_rain_freezing, & + accrete_cloud_water_rain, self_collection_rain, accrete_cloud_ice_snow + +implicit none +private +save + +public :: & + zm_mphyi, & + zm_mphy, & + zm_conv_t,& + zm_aero_t + +! Private module data + +! constants remaped +real(r8) :: g ! gravity +real(r8) :: mw ! molecular weight of water +real(r8) :: r ! Dry air Gas constant +real(r8) :: rv ! water vapor gas contstant +real(r8) :: rr ! universal gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: rhow ! density of liquid water +real(r8) :: xlf ! latent heat of freezing + +!from 'microconstants' +real(r8) :: rhosn ! bulk density snow +real(r8) :: rhoi ! bulk density ice + +real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters +real(r8) :: ci,di !ice mass-diameter relation parameters +real(r8) :: cs,ds !snow mass-diameter relation parameters +real(r8) :: cr,dr !drop mass-diameter relation parameters +real(r8) :: Eii !collection efficiency aggregation of ice +real(r8) :: Ecc !collection efficiency +real(r8) :: Ecr !collection efficiency cloud droplets/rain +real(r8) :: DCS !autoconversion size threshold +real(r8) :: bimm,aimm !immersion freezing +real(r8) :: rhosu !typical 850mn air density +real(r8) :: mi0 ! new crystal mass +real(r8) :: rin ! radius of contact nuclei +real(r8) :: pi ! pi + +! contact freezing due to dust +! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 +real(r8), parameter :: rn_dst1 = 0.258e-6_r8 +real(r8), parameter :: rn_dst2 = 0.717e-6_r8 +real(r8), parameter :: rn_dst3 = 1.576e-6_r8 +real(r8), parameter :: rn_dst4 = 3.026e-6_r8 + +! smallest mixing ratio considered in microphysics +real(r8), parameter :: qsmall = 1.e-18_r8 + + +type, public :: ptr2d + real(r8), pointer :: val(:,:) +end type ptr2d + +! Aerosols +type :: zm_aero_t + + ! Aerosol treatment + character(len=5) :: scheme ! either 'bulk' or 'modal' + + ! Bulk aerosols + integer :: nbulk = 0 ! number of bulk aerosols affecting climate + integer :: idxsul = -1 ! index in aerosol list for sulfate + integer :: idxdst1 = -1 ! index in aerosol list for dust1 + integer :: idxdst2 = -1 ! index in aerosol list for dust2 + integer :: idxdst3 = -1 ! index in aerosol list for dust3 + integer :: idxdst4 = -1 ! index in aerosol list for dust4 + integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI) + + real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols + type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr + real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr + + ! Modal aerosols + integer :: nmodes = 0 ! number of modes + integer, allocatable :: nspec(:) ! number of species in each mode + type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase) + type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase) + real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase) + real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase) + real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode + real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode + real(r8), allocatable :: specdens(:,:) ! density of modal species + real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species + + integer :: mode_accum_idx = -1 ! index of accumulation mode + integer :: mode_aitken_idx = -1 ! index of aitken mode + integer :: mode_coarse_idx = -1 ! index of coarse mode + integer :: coarse_dust_idx = -1 ! index of dust in coarse mode + integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode + + type(ptr2d), allocatable :: dgnum(:) ! mode dry radius + real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius + + real(r8) :: sigmag_aitken + +end type zm_aero_t + +type :: zm_conv_t + + real(r8), allocatable :: qi(:,:) ! wg grid slice of cloud ice. + real(r8), allocatable :: qliq(:,:) ! convective cloud liquid water. + real(r8), allocatable :: qice(:,:) ! convective cloud ice. + real(r8), allocatable :: wu(:,:) ! vertical velocity + real(r8), allocatable :: sprd(:,:) ! rate of production of snow at that layer + real(r8), allocatable :: qrain(:,:) ! convective rain water. + real(r8), allocatable :: qsnow(:,:) ! convective snow. + real(r8), allocatable :: qnl(:,:) ! convective cloud liquid water num concen. + real(r8), allocatable :: qni(:,:) ! convective cloud ice num concen. + real(r8), allocatable :: qnr(:,:) ! convective rain water num concen. + real(r8), allocatable :: qns(:,:) ! convective snow num concen. + real(r8), allocatable :: frz(:,:) ! heating rate due to freezing + real(r8), allocatable :: autolm(:,:) !mass tendency due to autoconversion of droplets to rain + real(r8), allocatable :: accrlm(:,:) !mass tendency due to accretion of droplets by rain + real(r8), allocatable :: bergnm(:,:) !mass tendency due to Bergeron process + real(r8), allocatable :: fhtimm(:,:) !mass tendency due to immersion freezing + real(r8), allocatable :: fhtctm(:,:) !mass tendency due to contact freezing + real(r8), allocatable :: fhmlm (:,:) !mass tendency due to homogeneous freezing + real(r8), allocatable :: hmpim (:,:) !mass tendency due to HM process + real(r8), allocatable :: accslm(:,:) !mass tendency due to accretion of droplets by snow + real(r8), allocatable :: dlfm (:,:) !mass tendency due to detrainment of droplet + real(r8), allocatable :: autoln(:,:) !num tendency due to autoconversion of droplets to rain + real(r8), allocatable :: accrln(:,:) !num tendency due to accretion of droplets by rain + real(r8), allocatable :: bergnn(:,:) !num tendency due to Bergeron process + real(r8), allocatable :: fhtimn(:,:) !num tendency due to immersion freezing + real(r8), allocatable :: fhtctn(:,:) !num tendency due to contact freezing + real(r8), allocatable :: fhmln (:,:) !num tendency due to homogeneous freezing + real(r8), allocatable :: accsln(:,:) !num tendency due to accretion of droplets by snow + real(r8), allocatable :: activn(:,:) !num tendency due to droplets activation + real(r8), allocatable :: dlfn (:,:) !num tendency due to detrainment of droplet + real(r8), allocatable :: autoim(:,:) !mass tendency due to autoconversion of cloud ice to snow + real(r8), allocatable :: accsim(:,:) !mass tendency due to accretion of cloud ice by snow + real(r8), allocatable :: difm (:,:) !mass tendency due to detrainment of cloud ice + real(r8), allocatable :: nuclin(:,:) !num tendency due to ice nucleation + real(r8), allocatable :: autoin(:,:) !num tendency due to autoconversion of cloud ice to snow + real(r8), allocatable :: accsin(:,:) !num tendency due to accretion of cloud ice by snow + real(r8), allocatable :: hmpin (:,:) !num tendency due to HM process + real(r8), allocatable :: difn (:,:) !num tendency due to detrainment of cloud ice + real(r8), allocatable :: cmel (:,:) !mass tendency due to condensation + real(r8), allocatable :: cmei (:,:) !mass tendency due to deposition + real(r8), allocatable :: trspcm(:,:) !LWC tendency due to convective transport + real(r8), allocatable :: trspcn(:,:) !droplet num tendency due to convective transport + real(r8), allocatable :: trspim(:,:) !IWC tendency due to convective transport + real(r8), allocatable :: trspin(:,:) !ice crystal num tendency due to convective transport + real(r8), allocatable :: dcape(:) ! CAPE change due to freezing heating + real(r8), allocatable :: lambdadpcu(:,:)! slope of cloud liquid size distr + real(r8), allocatable :: mudpcu(:,:) ! width parameter of droplet size distr + real(r8), allocatable :: di(:,:) + real(r8), allocatable :: dnl(:,:) + real(r8), allocatable :: dni(:,:) + real(r8), allocatable :: qide(:,:) ! cloud ice mixing ratio for detrainment (kg/kg) + real(r8), allocatable :: qncde(:,:) ! cloud water number concentration for detrainment (1/kg) + real(r8), allocatable :: qnide(:,:) ! cloud ice number concentration for detrainment (1/kg) + + +end type zm_conv_t + +real(r8), parameter :: dcon = 25.e-6_r8 +real(r8), parameter :: mucon = 5.3_r8 +real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon + +!=============================================================================== +contains +!=============================================================================== + +subroutine zm_mphyi + +!----------------------------------------------------------------------- +! +! Purpose: +! initialize constants for the cumulus microphysics +! called from zm_conv_init() in zm_conv_intr.F90 +! +! Author: Xialiang Song, June 2010 +! +!----------------------------------------------------------------------- + +!NOTE: +! latent heats should probably be fixed with temperature +! for energy conservation with the rest of the model +! (this looks like a +/- 3 or 4% effect, but will mess up energy balance) + + xlf = latice ! latent heat freezing + +! from microconstants + +! parameters below from Reisner et al. (1998) +! density parameters (kg/m3) + + rhosn = 100._r8 ! bulk density snow + rhoi = 500._r8 ! bulk density ice + rhow = 1000._r8 ! bulk density liquid + +! fall speed parameters, V = aD^b +! V is in m/s + +! droplets + ac = 3.e7_r8 + bc = 2._r8 + +! snow + as = 11.72_r8 + bs = 0.41_r8 + +! cloud ice + ai = 700._r8 + bi = 1._r8 + +! rain + ar = 841.99667_r8 + br = 0.8_r8 + +! particle mass-diameter relationship +! currently we assume spherical particles for cloud ice/snow +! m = cD^d + + pi= 3.14159265358979323846_r8 + +! cloud ice mass-diameter relationship + + ci = rhoi*pi/6._r8 + di = 3._r8 + +! snow mass-diameter relationship + + cs = rhosn*pi/6._r8 + ds = 3._r8 + +! drop mass-diameter relationship + + cr = rhow*pi/6._r8 + dr = 3._r8 + +! collection efficiency, aggregation of cloud ice and snow + + Eii = 0.1_r8 + +! collection efficiency, accretion of cloud water by rain + + Ecr = 1.0_r8 + +! autoconversion size threshold for cloud ice to snow (m) + + Dcs = 150.e-6_r8 +! immersion freezing parameters, bigg 1953 + + bimm = 100._r8 + aimm = 0.66_r8 + +! typical air density at 850 mb + + rhosu = 85000._r8/(rair * tmelt) + +! mass of new crystal due to aerosol freezing and growth (kg) + + mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) + +! radius of contact nuclei aerosol (m) + + rin = 0.1e-6_r8 + +end subroutine zm_mphyi + +!=============================================================================== + +subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, & + eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & + qc, qi, nc, ni, qcde, qide, ncde, nide, rprd, sprd, frz, & + wu, qr, qni, nr, ns, autolm, accrlm, bergnm, fhtimm, fhtctm, & + fhmlm, hmpim, accslm, dlfm, autoln, accrln, bergnn, fhtimn, fhtctn, & + fhmln, accsln, activn, dlfn, autoim, accsim, difm, nuclin, autoin, & + accsin, hmpin, difn, trspcm, trspcn, trspim, trspin, lamc, pgam ) + + +! Purpose: +! microphysic parameterization for Zhang-McFarlane convection scheme +! called from cldprp() in zm_conv.F90 +! +! Author: Xialiang Song, June 2010 + + use time_manager, only: get_step_size + +! variable declarations + + implicit none + +! input variables + real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft + real(r8), intent(in) :: qu(pcols,pver) ! spec hum of updraft + real(r8), intent(in) :: mu(pcols,pver) ! updraft mass flux + real(r8), intent(in) :: du(pcols,pver) ! detrainement rate of updraft + real(r8), intent(in) :: eu(pcols,pver) ! entrainment rate of updraft + real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft + real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft + real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces + real(r8), intent(in) :: pm(pcols,pver) ! pressure of env + real(r8), intent(in) :: te(pcols,pver) ! temp of env + real(r8), intent(in) :: qe(pcols,pver) ! spec. humidity of env + real(r8), intent(in) :: eps0(pcols) + real(r8), intent(in) :: gamhat(pcols,pver) ! gamma=L/cp(dq*/dT) at interface + + integer, intent(in) :: jb(pcols) ! updraft base level + integer, intent(in) :: jt(pcols) ! updraft plume top + integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level + integer, intent(in) :: msg ! missing moisture vals + integer, intent(in) :: il2g ! number of columns in gathered arrays + + type(zm_aero_t), intent(in) :: aero ! aerosol object + + real(r8) grav ! gravity + real(r8) cp ! heat capacity of dry air + real(r8) rd ! gas constant for dry air + +! output variables + real(r8), intent(out) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg) + real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(out) :: nc(pcols,pver) ! cloud water number conc (1/kg) + real(r8), intent(out) :: ni(pcols,pver) ! cloud ice number conc (1/kg) + real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment(kg/kg) + real(r8), intent(out) :: qide(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg) + real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number conc for detrainment (1/kg) + real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number conc for detrainment (1/kg) + real(r8), intent(out) :: wu(pcols,pver) + real(r8), intent(out) :: qni(pcols,pver) ! snow mixing ratio + real(r8), intent(out) :: qr(pcols,pver) ! rain mixing ratio + real(r8), intent(out) :: ns(pcols,pver) ! snow number conc + real(r8), intent(out) :: nr(pcols,pver) ! rain number conc + real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer + real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer + real(r8), intent(out) :: frz(pcols,pver) ! rate of freezing + + + real(r8), intent(inout) :: lamc(pcols,pver) ! slope of cloud liquid size distr + real(r8), intent(inout) :: pgam(pcols,pver) ! spectral width parameter of droplet size distr + +! tendency for output + real(r8),intent(out) :: autolm(pcols,pver) !mass tendency due to autoconversion of droplets to rain + real(r8),intent(out) :: accrlm(pcols,pver) !mass tendency due to accretion of droplets by rain + real(r8),intent(out) :: bergnm(pcols,pver) !mass tendency due to Bergeron process + real(r8),intent(out) :: fhtimm(pcols,pver) !mass tendency due to immersion freezing + real(r8),intent(out) :: fhtctm(pcols,pver) !mass tendency due to contact freezing + real(r8),intent(out) :: fhmlm (pcols,pver) !mass tendency due to homogeneous freezing + real(r8),intent(out) :: hmpim (pcols,pver) !mass tendency due to HM process + real(r8),intent(out) :: accslm(pcols,pver) !mass tendency due to accretion of droplets by snow + real(r8),intent(out) :: dlfm (pcols,pver) !mass tendency due to detrainment of droplet + real(r8),intent(out) :: trspcm(pcols,pver) !mass tendency of droplets due to convective transport + + real(r8),intent(out) :: autoln(pcols,pver) !num tendency due to autoconversion of droplets to rain + real(r8),intent(out) :: accrln(pcols,pver) !num tendency due to accretion of droplets by rain + real(r8),intent(out) :: bergnn(pcols,pver) !num tendency due to Bergeron process + real(r8),intent(out) :: fhtimn(pcols,pver) !num tendency due to immersion freezing + real(r8),intent(out) :: fhtctn(pcols,pver) !num tendency due to contact freezing + real(r8),intent(out) :: fhmln (pcols,pver) !num tendency due to homogeneous freezing + real(r8),intent(out) :: accsln(pcols,pver) !num tendency due to accretion of droplets by snow + real(r8),intent(out) :: activn(pcols,pver) !num tendency due to droplets activation + real(r8),intent(out) :: dlfn (pcols,pver) !num tendency due to detrainment of droplet + real(r8),intent(out) :: trspcn(pcols,pver) !num tendency of droplets due to convective transport + + real(r8),intent(out) :: autoim(pcols,pver) !mass tendency due to autoconversion of cloud ice to snow + real(r8),intent(out) :: accsim(pcols,pver) !mass tendency due to accretion of cloud ice by snow + real(r8),intent(out) :: difm (pcols,pver) !mass tendency due to detrainment of cloud ice + real(r8),intent(out) :: trspim(pcols,pver) !mass tendency of ice crystal due to convective transport + + real(r8),intent(out) :: nuclin(pcols,pver) !num tendency due to ice nucleation + real(r8),intent(out) :: autoin(pcols,pver) !num tendency due to autoconversion of cloud ice to snow + real(r8),intent(out) :: accsin(pcols,pver) !num tendency due to accretion of cloud ice by snow + real(r8),intent(out) :: hmpin (pcols,pver) !num tendency due to HM process + real(r8),intent(out) :: difn (pcols,pver) !num tendency due to detrainment of cloud ice + real(r8),intent(out) :: trspin(pcols,pver) !num tendency of ice crystal due to convective transport + +!................................................................................ +! local workspace +! all units mks unless otherwise stated + real(r8) :: deltat ! time step (s) + real(r8) :: omsm ! number near unity for round-off issues + real(r8) :: dum ! temporary dummy variable + real(r8) :: dum1 ! temporary dummy variable + real(r8) :: dum2 ! temporary dummy variable + + real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg) + real(r8) :: t(pcols,pver) ! temperature (K) + real(r8) :: rho(pcols,pver) ! air density (kg m-3) + real(r8) :: dz(pcols,pver) ! height difference across model vertical level + + real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio + real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio + real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio + real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio + real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc + real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc + real(r8) :: nsic(pcols,pver) ! in-precip snow number conc + real(r8) :: nric(pcols,pver) ! in-precip rain number conc + + real(r8) :: lami(pver) ! slope of cloud ice size distr + real(r8) :: n0i(pver) ! intercept of cloud ice size distr + real(r8) :: n0c(pver) ! intercept of cloud liquid size distr + real(r8) :: lams(pver) ! slope of snow size distr + real(r8) :: n0s(pver) ! intercept of snow size distr + real(r8) :: lamr(pver) ! slope of rain size distr + real(r8) :: n0r(pver) ! intercept of rain size distr + real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing + real(r8) :: lammax ! maximum allowed slope of size distr + real(r8) :: lammin ! minimum allowed slope of size distr + + real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water + real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water + real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water + real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water + real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication + real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication + real(r8) :: prf(pver) ! mixing ratio tendency due to fallout of rain + real(r8) :: psf(pver) ! mixing ratio tendency due to fallout of snow + real(r8) :: pnrf(pver) ! number conc tendency due to fallout of rain + real(r8) :: pnsf(pver) ! number conc tendency due to fallout of snow + real(r8) :: prc(pver) ! mixing ratio tendency due to autoconversion of cloud droplets + real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets + real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets + real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow + real(r8) :: dc0 ! mean size droplet size distr + real(r8) :: ds0 ! mean size snow size distr (area weighted) + real(r8) :: eci ! collection efficiency for riming of snow by droplets + real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air + real(r8) :: mua(pcols,pver) ! viscocity of air + real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow + real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow + real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow + real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow + real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain + real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain + real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain + real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain + real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain + real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow + real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow + real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow + real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow + real(r8) :: prb(pver) ! rain mixing rat tendency due to Bergeron process + real(r8) :: nprb(pver) ! number conc tendency due to Bergeron process + real(r8) :: fhmrm (pcols,pver) !mass tendency due to homogeneous freezing of rain + +! fall speed + real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter + real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter + real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter + real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter + real(r8) :: uns(pver) ! number-weighted snow fallspeed + real(r8) :: ums(pver) ! mass-weighted snow fallspeed + real(r8) :: unr(pver) ! number-weighted rain fallspeed + real(r8) :: umr(pver) ! mass-weighted rain fallspeed + +! conservation check + real(r8) :: qce ! dummy qc for conservation check + real(r8) :: qie ! dummy qi for conservation check + real(r8) :: nce ! dummy nc for conservation check + real(r8) :: nie ! dummy ni for conservation check + real(r8) :: qre ! dummy qr for conservation check + real(r8) :: nre ! dummy nr for conservation check + real(r8) :: qnie ! dummy qni for conservation check + real(r8) :: nse ! dummy ns for conservation check + real(r8) :: ratio ! parameter for conservation check + +! sum of source/sink terms for cloud hydrometeor + real(r8) :: qctend(pcols,pver) ! microphysical tendency qc (1/s) + real(r8) :: qitend(pcols,pver) ! microphysical tendency qi (1/s) + real(r8) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s)) + real(r8) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s)) + real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term + real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term + real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term + real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term + +! terms for Bergeron process + real(r8) :: bergtsf !bergeron timescale to remove all liquid + real(r8) :: plevap ! cloud liquid water evaporation rate + +! variables for droplet activation by modal aerosols + real(r8) :: wmix, wmin, wmax, wdiab + real(r8) :: vol, nlsrc + real(r8), allocatable :: vaerosol(:), hygro(:), naermod(:) + real(r8), allocatable :: fn(:) ! number fraction of aerosols activated + real(r8), allocatable :: fm(:) ! mass fraction of aerosols activated + real(r8), allocatable :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s) + real(r8), allocatable :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s) + real(r8) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) + real(r8) :: dmc + real(r8) :: ssmc + real(r8) :: dgnum_aitken + +! bulk aerosol variables + real(r8), allocatable :: naer2(:,:,:) ! new aerosol number concentration (/m3) + real(r8), allocatable :: naer2h(:,:,:) ! new aerosol number concentration (/m3) + real(r8), allocatable :: maerosol(:) ! aerosol mass conc (kg/m3) + real(r8) :: so4_num + real(r8) :: soot_num + real(r8) :: dst1_num + real(r8) :: dst2_num + real(r8) :: dst3_num + real(r8) :: dst4_num + real(r8) :: dst_num + +! droplet activation + logical :: in_cloud ! true when above cloud base layer (k > jb) + real(r8) :: smax_f ! droplet and rain size distr factor used in the + ! in-cloud smax calculation + real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg) + real(r8) :: npccn(pver) ! droplet activation rate + real(r8) :: ncmax + real(r8) :: mtimec ! factor to account for droplet activation timescale + +! ice nucleation + real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg) + real(r8) :: qs(pcols,pver) ! liquid-ice weighted sat mixing rat (kg/kg) + real(r8) :: es(pcols,pver) ! sat vapor press (pa) over water + real(r8) :: relhum(pcols,pver) ! relative humidity + real(r8) :: esi(pcols,pver) ! sat vapor press (pa) over ice + real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing + real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation + real(r8) :: mtime ! factor to account for ice nucleation timescale + +! output for ice nucleation + real(r8) :: nimey(pcols,pver) !number conc of ice nuclei due to meyers deposition (1/m3) + real(r8) :: nihf(pcols,pver) !number conc of ice nuclei due to heterogenous freezing (1/m3) + real(r8) :: nidep(pcols,pver) !number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3) + real(r8) :: niimm(pcols,pver) !number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3) + + real(r8) :: wpice, weff, fhom ! unused dummies + +! loop array variables + integer i,k, n, l + integer ii,kk, m + +! loop variables for iteration solution + integer iter,it,ltrue(pcols) + +! used in contact freezing via dust particles + real(r8) tcnt, viscosity, mfp + real(r8) slip1, slip2, slip3, slip4 + real(r8) dfaer1, dfaer2, dfaer3, dfaer4 + real(r8) nacon1,nacon2,nacon3,nacon4 + +! used in immersion freezing via soot + real(r8) ttend(pver) + real(r8) naimm + real(r8) :: ntaer(pcols,pver) + real(r8) :: ntaerh(pcols,pver) + +! used in homogeneous freezing + real(r8) :: fholm (pcols,pver) !mass tendency due to homogeneous freezing + real(r8) :: fholn (pcols,pver) !number conc tendency due to homogeneous freezing + +! used in secondary ice production + real(r8) ni_secp + +! used in vertical velocity calculation + real(r8) th(pcols,pver) + real(r8) qh(pcols,pver) + real(r8) zkine(pcols,pver) + real(r8) zbuo(pcols,pver) + real(r8) zfacbuo, cwdrag, cwifrac, retv, zbuoc + real(r8) zbc, zbe, zdkbuo, zdken + real(r8) arcf(pcols,pver) + real(r8) p(pcols,pver) + real(r8) ph(pcols,pver) + +! used in vertical integreation + logical qcimp(pver) ! true to solve qc with implicit formula + logical ncimp(pver) ! true to solve nc with implicit formula + logical qiimp(pver) ! true to solve qi with implicit formula + logical niimp(pver) ! true to solve ni with implicit formula + +! tendency due to adjustment + real(r8) :: ncadj(pcols,pver) !droplet num tendency due to adjustment + real(r8) :: niadj(pcols,pver) !ice crystal num tendency due to adjustment + real(r8) :: ncorg, niorg, total + + real(r8) :: rhoh(pcols,pver) ! air density (kg m-3) at interface + real(r8) :: rhom(pcols,pver) ! air density (kg m-3) at mid-level + real(r8) :: tu(pcols,pver) ! temperature in updraft (K) + + integer kqi(pcols),kqc(pcols) + logical lcbase(pcols), libase(pcols) + + real(r8) :: nai_bcphi, nai_dst1, nai_dst2, nai_dst3, nai_dst4 + + real(r8) flxrm, mvtrm, flxrn, mvtrn, flxsm, mvtsm, flxsn, mvtsn + integer nlr, nls + + real(r8) rmean, beta6, beta66, r6, r6c + real(r8) temp1, temp2, temp3, temp4 ! variable to store output which is not required by this routine + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! initialization +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + if (aero%scheme == 'modal') then + + allocate(vaerosol(aero%nmodes), hygro(aero%nmodes), naermod(aero%nmodes), & + fn(aero%nmodes), fm(aero%nmodes), fluxn(aero%nmodes), fluxm(aero%nmodes)) + + else if (aero%scheme == 'bulk') then + + allocate( & + naer2(pcols,pver,aero%nbulk), & + naer2h(pcols,pver,aero%nbulk), & + maerosol(aero%nbulk)) + + end if + + deltat= get_step_size() !for FV dynamical core + + ! parameters for scheme + omsm=0.99999_r8 + zfacbuo = 0.5_r8/(1._r8+0.5_r8) + cwdrag = 1.875_r8*0.506_r8 + cwifrac = 0.5_r8 + retv = 0.608_r8 + bergtsf = 1800._r8 + + ! initialize multi-level fields + do i=1,il2g + do k=1,pver + q(i,k) = qu(i,k) + tu(i,k)= su(i,k) - grav/cp*zf(i,k) + t(i,k) = su(i,k) - grav/cp*zf(i,k) + p(i,k) = 100._r8*pm(i,k) + wu(i,k) = 0._r8 + zkine(i,k)= 0._r8 + arcf(i,k) = 0._r8 + zbuo(i,k) = 0._r8 + nc(i,k) = 0._r8 + ni(i,k) = 0._r8 + qc(i,k) = 0._r8 + qi(i,k) = 0._r8 + ncde(i,k) = 0._r8 + nide(i,k) = 0._r8 + qcde(i,k) = 0._r8 + qide(i,k) = 0._r8 + rprd(i,k) = 0._r8 + sprd(i,k) = 0._r8 + frz(i,k) = 0._r8 + qcic(i,k) = 0._r8 + qiic(i,k) = 0._r8 + ncic(i,k) = 0._r8 + niic(i,k) = 0._r8 + qr(i,k) = 0._r8 + qni(i,k) = 0._r8 + nr(i,k) = 0._r8 + ns(i,k) = 0._r8 + qric(i,k) = 0._r8 + qniic(i,k) = 0._r8 + nric(i,k) = 0._r8 + nsic(i,k) = 0._r8 + nimey(i,k) = 0._r8 + nihf(i,k) = 0._r8 + nidep(i,k) = 0._r8 + niimm(i,k) = 0._r8 + fhmrm(i,k) = 0._r8 + + autolm(i,k) = 0._r8 + accrlm(i,k) = 0._r8 + bergnm(i,k) = 0._r8 + fhtimm(i,k) = 0._r8 + fhtctm(i,k) = 0._r8 + fhmlm (i,k) = 0._r8 + fholm (i,k) = 0._r8 + hmpim (i,k) = 0._r8 + accslm(i,k) = 0._r8 + dlfm (i,k) = 0._r8 + + autoln(i,k) = 0._r8 + accrln(i,k) = 0._r8 + bergnn(i,k) = 0._r8 + fhtimn(i,k) = 0._r8 + fhtctn(i,k) = 0._r8 + fhmln (i,k) = 0._r8 + fholn (i,k) = 0._r8 + accsln(i,k) = 0._r8 + activn(i,k) = 0._r8 + dlfn (i,k) = 0._r8 + + autoim(i,k) = 0._r8 + accsim(i,k) = 0._r8 + difm (i,k) = 0._r8 + + nuclin(i,k) = 0._r8 + autoin(i,k) = 0._r8 + accsin(i,k) = 0._r8 + hmpin (i,k) = 0._r8 + difn (i,k) = 0._r8 + + trspcm(i,k) = 0._r8 + trspcn(i,k) = 0._r8 + trspim(i,k) = 0._r8 + trspin(i,k) = 0._r8 + + ncadj (i,k) = 0._r8 + niadj (i,k) = 0._r8 + end do + end do + + ! initialize time-varying parameters + do k=1,pver + do i=1,il2g + if (k .eq.1) then + rhoh(i,k) = p(i,k)/(t(i,k)*rd) + rhom(i,k) = p(i,k)/(t(i,k)*rd) + th (i,k) = te(i,k) + qh (i,k) = qe(i,k) + dz (i,k) = zf(i,k) - zf(i,k+1) + ph(i,k) = p(i,k) + else + rhoh(i,k) = 0.5_r8*(p(i,k)+p(i,k-1))/(t(i,k)*rd) + if (k .eq. pver) then + rhom(i,k) = p(i,k)/(rd*t(i,k)) + else + rhom(i,k) = 2.0_r8*p(i,k)/(rd*(t(i,k)+t(i,k+1))) + end if + th (i,k) = 0.5_r8*(te(i,k)+te(i,k-1)) + qh (i,k) = 0.5_r8*(qe(i,k)+qe(i,k-1)) + dz(i,k) = zf(i,k-1) - zf(i,k) + ph(i,k) = 0.5_r8*(p(i,k) + p(i,k-1)) + end if + dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/ph(i,k) + mua(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/ & + (t(i,k)+120._r8) + + rho(i,k) = rhoh(i,k) + + ! air density adjustment for fallspeed parameters + ! add air density correction factor to the power of + ! 0.54 following Heymsfield and Bansemer 2006 + + arn(i,k)=ar*(rhosu/rho(i,k))**0.54_r8 + asn(i,k)=as*(rhosu/rho(i,k))**0.54_r8 + acn(i,k)=ac*(rhosu/rho(i,k))**0.54_r8 + ain(i,k)=ai*(rhosu/rho(i,k))**0.54_r8 + + end do + end do + + if (aero%scheme == 'modal') then + + wmix = 0._r8 + wmin = 0._r8 + wmax = 10._r8 + wdiab = 0._r8 + + do k=1,pver + do i=1,il2g + dum2l(i,k)=0._r8 + dum2i(i,k)=0._r8 + ntaer(i,k) = 0.0_r8 + ntaerh(i,k) = 0.0_r8 + do m = 1, aero%nmodes + ntaer(i,k) = ntaer(i,k) + aero%numg_a(i,k,m)*rhom(i,k) + enddo + end do + end do + + else if (aero%scheme == 'bulk') then + + ! initialize aerosol number + do k=1,pver + do i=1,il2g + naer2(i,k,:)=0._r8 + naer2h(i,k,:)=0._r8 + dum2l(i,k)=0._r8 + dum2i(i,k)=0._r8 + end do + end do + + do k=1,pver + do i=1,il2g + ntaer(i,k) = 0.0_r8 + ntaerh(i,k) = 0.0_r8 + do m = 1, aero%nbulk + maerosol(m) = aero%mmrg_bulk(i,k,m)*rhom(i,k) + + ! set number nucleated for sulfate based on Lohmann et al. 2000 (JGR) Eq.2 + ! Na=340.*(massSO4)^0.58 where Na=cm-3 and massSO4=ug/m3 + ! convert units to Na [m-3] and SO4 [kgm-3] + ! Na(m-3)= 1.e6 cm3 m-3 Na(cm-3)=340. *(massSO4[kg/m3]*1.e9ug/kg)^0.58 + ! or Na(m-3)= 1.e6* 340.*(1.e9ug/kg)^0.58 * (massSO4[kg/m3])^0.58 + + if (m .eq. aero%idxsul) then + naer2(i,k,m)= 5.64259e13_r8 * maerosol(m)**0.58_r8 + else + naer2(i,k,m)=maerosol(m)*aero%num_to_mass_aer(m) + end if + ntaer(i,k) = ntaer(i,k) + naer2(i,k,m) + end do + end do + end do + + end if + + do i=1,il2g + ltrue(i)=0 + do k=1,pver + if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmel(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1 + end do + end do + + ! skip microphysical calculations if no cloud water + do i=1,il2g + if (ltrue(i).eq.0) then + do k=1,pver + qctend(i,k)=0._r8 + qitend(i,k)=0._r8 + qnitend(i,k)=0._r8 + qrtend(i,k)=0._r8 + nctend(i,k)=0._r8 + nitend(i,k)=0._r8 + nrtend(i,k)=0._r8 + nstend(i,k)=0._r8 + qniic(i,k)=0._r8 + qric(i,k)=0._r8 + nsic(i,k)=0._r8 + nric(i,k)=0._r8 + qni(i,k)=0._r8 + qr(i,k)=0._r8 + ns(i,k)=0._r8 + nr(i,k)=0._r8 + qc(i,k) = 0._r8 + qi(i,k) = 0._r8 + nc(i,k) = 0._r8 + ni(i,k) = 0._r8 + qcde(i,k) = 0._r8 + qide(i,k) = 0._r8 + ncde(i,k) = 0._r8 + nide(i,k) = 0._r8 + rprd(i,k) = 0._r8 + sprd(i,k) = 0._r8 + frz(i,k) = 0._r8 + end do + goto 300 + end if + + kqc(i) = 1 + kqi(i) = 1 + lcbase(i) = .true. + libase(i) = .true. + + ! assign number of steps for iteration + ! use 2 steps following Song and Zhang, 2011, J. Clim. + iter = 2 + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! iteration + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + do it=1,iter + + ! initialize sub-step microphysical tendencies + do k=1,pver + qctend(i,k)=0._r8 + qitend(i,k)=0._r8 + qnitend(i,k)=0._r8 + qrtend(i,k)=0._r8 + nctend(i,k)=0._r8 + nitend(i,k)=0._r8 + nrtend(i,k)=0._r8 + nstend(i,k)=0._r8 + rprd(i,k) = 0._r8 + sprd(i,k) = 0._r8 + frz(i,k) = 0._r8 + qniic(i,k)=0._r8 + qric(i,k)=0._r8 + nsic(i,k)=0._r8 + nric(i,k)=0._r8 + qiic(i,k)=0._r8 + qcic(i,k)=0._r8 + niic(i,k)=0._r8 + ncic(i,k)=0._r8 + qcimp(k) = .false. + ncimp(k) = .false. + qiimp(k) = .false. + niimp(k) = .false. + dum2l(i,k)=0._r8 + dum2i(i,k)=0._r8 + autolm(i,k) = 0._r8 + accrlm(i,k) = 0._r8 + bergnm(i,k) = 0._r8 + fhtimm(i,k) = 0._r8 + fhtctm(i,k) = 0._r8 + fhmlm (i,k) = 0._r8 + fholm (i,k) = 0._r8 + hmpim (i,k) = 0._r8 + accslm(i,k) = 0._r8 + dlfm (i,k) = 0._r8 + + autoln(i,k) = 0._r8 + accrln(i,k) = 0._r8 + bergnn(i,k) = 0._r8 + fhtimn(i,k) = 0._r8 + fhtctn(i,k) = 0._r8 + fhmln (i,k) = 0._r8 + fholn (i,k) = 0._r8 + accsln(i,k) = 0._r8 + activn(i,k) = 0._r8 + dlfn (i,k) = 0._r8 + ncadj (i,k) = 0._r8 + + autoim(i,k) = 0._r8 + accsim(i,k) = 0._r8 + difm (i,k) = 0._r8 + + nuclin(i,k) = 0._r8 + autoin(i,k) = 0._r8 + accsin(i,k) = 0._r8 + hmpin (i,k) = 0._r8 + difn (i,k) = 0._r8 + niadj (i,k) = 0._r8 + + trspcm(i,k) = 0._r8 + trspcn(i,k) = 0._r8 + trspim(i,k) = 0._r8 + trspin(i,k) = 0._r8 + + fhmrm (i,k) = 0._r8 + end do + + do k = pver,msg+2,-1 + + if (k > jt(i) .and. k <= jb(i) .and. eps0(i) > 0._r8 & + .and.mu(i,k).gt.0._r8 .and. mu(i,k-1).gt.0._r8) then + + ! initialize precip fallspeeds to zero + if (it.eq.1) then + ums(k)=0._r8 + uns(k)=0._r8 + umr(k)=0._r8 + unr(k)=0._r8 + prf(k)=0._r8 + pnrf(k)=0._r8 + psf(k) =0._r8 + pnsf(k) = 0._r8 + end if + ttend(k)=0._r8 + nnuccd(k)=0._r8 + npccn(k)=0._r8 + + !************************************************************************************ + ! obtain values of cloud water/ice mixing ratios and number concentrations in updraft + ! for microphysical process calculations + ! units are kg/kg for mixing ratio, 1/kg for number conc + !************************************************************************************ + + + if (it.eq.1) then + qcic(i,k) = qc(i,k) + qiic(i,k) = qi(i,k) + ncic(i,k) = nc(i,k) + niic(i,k) = ni(i,k) + qniic(i,k)= qni(i,k) + qric(i,k) = qr(i,k) + nsic(i,k) = ns(i,k) + nric(i,k) = nr(i,k) + else + if (k.le.kqc(i)) then + qcic(i,k) = qc(i,k) + ncic(i,k) = nc(i,k) + + ! consider rain falling from above + flxrm = 0._r8 + mvtrm = 0._r8 + flxrn = 0._r8 + mvtrn = 0._r8 + nlr = 0 + + do kk= k,jt(i)+3,-1 + if (qr(i,kk-1) .gt. 0._r8) then + nlr = nlr + 1 + flxrm = flxrm + umr(kk-1)*qr(i,kk-1)*arcf(i,kk-1) + flxrn = flxrn + unr(kk-1)*nr(i,kk-1)*arcf(i,kk-1) + mvtrm = mvtrm + umr(kk-1)*arcf(i,kk-1) + mvtrn = mvtrn + unr(kk-1)*arcf(i,kk-1) + end if + end do + if (mvtrm.gt.0) then + qric(i,k) = (qr(i,k)*mu(i,k)+flxrm)/(mu(i,k)+mvtrm) + else + qric(i,k) = qr(i,k) + end if + if (mvtrn.gt.0) then + nric(i,k) = (nr(i,k)*mu(i,k)+flxrn)/(mu(i,k)+mvtrn) + else + nric(i,k) = nr(i,k) + end if + + end if + if (k.eq.kqc(i)) then + qcic(i,k) = qc(i,k-1) + ncic(i,k) = nc(i,k-1) + end if + if(k.le.kqi(i)) then + qiic(i,k) = qi(i,k) + niic(i,k) = ni(i,k) +! consider snow falling from above + flxsm = 0._r8 + mvtsm = 0._r8 + flxsn = 0._r8 + mvtsn = 0._r8 + nls = 0 + + do kk= k,jt(i)+3,-1 + if (qni(i,kk-1) .gt. 0._r8) then + nls = nls + 1 + flxsm = flxsm + ums(kk-1)*qni(i,kk-1)*arcf(i,kk-1) + mvtsm = mvtsm + ums(kk-1)*arcf(i,kk-1) + flxsn = flxsn + uns(kk-1)*ns(i,kk-1)*arcf(i,kk-1) + mvtsn = mvtsn + uns(kk-1)*arcf(i,kk-1) + end if + end do + + if (mvtsm.gt.0) then + qniic(i,k) = (qni(i,k)*mu(i,k)+flxsm)/(mu(i,k)+mvtsm) + else + qniic(i,k) = qni(i,k) + end if + if (mvtsn.gt.0) then + nsic(i,k) = (ns(i,k)*mu(i,k)+flxsn)/(mu(i,k)+mvtsn) + else + nsic(i,k) = ns(i,k) + end if + end if + if(k.eq.kqi(i)) then + qiic(i,k) = qi(i,k-1) + niic(i,k) = ni(i,k-1) + end if + end if + + !********************************************************************** + ! boundary condition for cloud liquid water and cloud ice + !*********************************************************************** + + ! boundary condition for provisional cloud water + if (cmel(i,k-1).gt.qsmall .and. lcbase(i) .and. it.eq.1 ) then + kqc(i) = k + lcbase(i) = .false. + qcic(i,k) = dz(i,k)*cmel(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) + ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*10.e-6_r8**3*rhow) + end if + + ! boundary condition for provisional cloud ice + if (qiic(i,k).gt.qsmall .and. libase(i) .and. it.eq.1 ) then + kqi(i) = k + libase(i) = .false. + else if ( cmei(i,k-1).gt.qsmall .and. & + cmei(i,k).lt.qsmall .and. k.le.jb(i) .and. libase(i) .and. it.eq.1 ) then + kqi(i)=k + libase(i) = .false. + qiic(i,k) = dz(i,k)*cmei(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) + niic(i,k) = qiic(i,k)/(4._r8/3._r8*pi*25.e-6_r8**3*rhoi) + end if + + !*************************************************************************** + ! get size distribution parameters based on in-cloud cloud water/ice + ! these calculations also ensure consistency between number and mixing ratio + !*************************************************************************** + ! cloud ice + if (qiic(i,k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8) + lami(k) = (gamma(1._r8+di)*ci* & + niic(i,k)/qiic(i,k))**(1._r8/di) + n0i(k) = niic(i,k)*lami(k) + + ! check for slope + lammax = 1._r8/10.e-6_r8 + lammin = 1._r8/(2._r8*dcs) + + ! adjust vars + if (lami(k).lt.lammin) then + lami(k) = lammin + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) + niic(i,k) = n0i(k)/lami(k) + else if (lami(k).gt.lammax) then + lami(k) = lammax + n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) + niic(i,k) = n0i(k)/lami(k) + end if + else + lami(k) = 0._r8 + n0i(k) = 0._r8 + end if + + ! cloud water + if (qcic(i,k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8) + + ! get pgam from fit to observations of martin et al. 1994 + + pgam(i,k)=0.0005714_r8*(ncic(i,k)/1.e6_r8/rho(i,k))+0.2714_r8 + pgam(i,k)=1._r8/(pgam(i,k)**2)-1._r8 + pgam(i,k)=max(pgam(i,k),2._r8) + pgam(i,k)=min(pgam(i,k),15._r8) + + ! calculate lamc + lamc(i,k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(i,k)+4._r8)/ & + (qcic(i,k)*gamma(pgam(i,k)+1._r8)))**(1._r8/3._r8) + + ! lammin, 50 micron diameter max mean size + lammin = (pgam(i,k)+1._r8)/40.e-6_r8 + lammax = (pgam(i,k)+1._r8)/1.e-6_r8 + + if (lamc(i,k).lt.lammin) then + lamc(i,k) = lammin + ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & + gamma(pgam(i,k)+1._r8)/ & + (pi*rhow*gamma(pgam(i,k)+4._r8)) + else if (lamc(i,k).gt.lammax) then + lamc(i,k) = lammax + ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & + gamma(pgam(i,k)+1._r8)/ & + (pi*rhow*gamma(pgam(i,k)+4._r8)) + end if + + ! parameter to calculate droplet freezing + + cdist1(k) = ncic(i,k)/gamma(pgam(i,k)+1._r8) + else + lamc(i,k) = 0._r8 + cdist1(k) = 0._r8 + end if + + ! boundary condition for cloud liquid water + if ( kqc(i) .eq. k ) then + qc(i,k) = 0._r8 + nc(i,k) = 0._r8 + end if + + ! boundary condition for cloud ice + if (kqi(i).eq.k ) then + qi(i,k) = 0._r8 + ni(i,k) = 0._r8 + end if + + !************************************************************************** + ! begin micropysical process calculations + !************************************************************************** + + !................................................................. + ! autoconversion of cloud liquid water to rain + ! formula from Khrouditnov and Kogan (2000) + ! minimum qc of 1 x 10^-8 prevents floating point error + + if (qcic(i,k).ge.1.e-8_r8) then + + ! nprc is increase in rain number conc due to autoconversion + ! nprc1 is decrease in cloud droplet conc due to autoconversion + ! Khrouditnov and Kogan (2000) +! prc(k) = 1350._r8*qcic(i,k)**2.47_r8* & +! (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8) + + ! Liu and Daum(2004)(modified), Wood(2005) + rmean = 1.e6_r8*((qcic(i,k)/ncic(i,k))/(4._r8/3._r8*pi*rhow))**(1._r8/3._r8) + + if (rmean .ge. 15._r8) then + + beta6 = (1._r8+3._r8/rmean)**(1._r8/3._r8) + beta66 = (1._r8+3._r8/rmean)**2._r8 + r6 = beta6*rmean + r6c = 7.5_r8/(r6**0.5_r8*(qcic(i,k)*rho(i,k))**(1._r8/6._r8)) + prc(k) = 1.3e9_r8*beta66*(qcic(i,k)*rho(i,k))**3._r8/ & + (ncic(i,k)*rho(i,k))*max(0._r8,r6-r6c)/rho(i,k) + + nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k)) + nprc(k) = nprc1(k)*0.5_r8 + else + prc(k)=0._r8 + nprc(k)=0._r8 + nprc1(k)=0._r8 + end if + else + prc(k)=0._r8 + nprc(k)=0._r8 + nprc1(k)=0._r8 + end if + + ! provisional rain mixing ratio and number concentration (qric and nric) + ! at boundary are estimated via autoconversion + + if (k.eq.kqc(i) .and. it.eq.1) then + qric(i,k) = prc(k)*dz(i,k)/0.55_r8 + nric(i,k) = nprc(k)*dz(i,k)/0.55_r8 + qr(i,k) = 0.0_r8 + nr(i,k) = 0.0_r8 + end if + + !....................................................................... + ! Autoconversion of cloud ice to snow + ! similar to Ferrier (1994) + + call ice_autoconversion(t(i,k), qiic(i,k), lami(k), n0i(k), dcs, prci(k), nprci(k), 1) + + ! provisional snow mixing ratio and number concentration (qniic and nsic) + ! at boundary are estimated via autoconversion + + if (k.eq.kqi(i) .and. it.eq.1) then + qniic(i,k)= prci(k)*dz(i,k)*0.25_r8 + nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8 + qni(i,k)= 0.0_r8 + ns(i,k)= 0.0_r8 + end if + + ! if precip mix ratio is zero so should number concentration + if (qniic(i,k).lt.qsmall) then + qniic(i,k)=0._r8 + nsic(i,k)=0._r8 + end if + if (qric(i,k).lt.qsmall) then + qric(i,k)=0._r8 + nric(i,k)=0._r8 + end if + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + nric(i,k)=max(nric(i,k),0._r8) + nsic(i,k)=max(nsic(i,k),0._r8) + + !********************************************************************** + ! get size distribution parameters for precip + !********************************************************************** + ! rain + + if (qric(i,k).ge.qsmall) then + lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8) + n0r(k) = nric(i,k)*lamr(k) + + ! check for slope + lammax = 1._r8/150.e-6_r8 + lammin = 1._r8/3000.e-6_r8 + + ! adjust vars + if (lamr(k).lt.lammin) then + lamr(k) = lammin + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + else if (lamr(k).gt.lammax) then + lamr(k) = lammax + n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) + nric(i,k) = n0r(k)/lamr(k) + end if + + ! provisional rain number and mass weighted mean fallspeed (m/s) + ! Eq.18 of Morrison and Gettelman, 2008, J. Climate + unr(k) = min(arn(i,k)*gamma(1._r8+br)/lamr(k)**br,10._r8) + umr(k) = min(arn(i,k)*gamma(4._r8+br)/(6._r8*lamr(k)**br),10._r8) + else + lamr(k) = 0._r8 + n0r(k) = 0._r8 + umr(k) = 0._r8 + unr(k) = 0._r8 + end if + + !...................................................................... + ! snow + if (qniic(i,k).ge.qsmall) then + lams(k) = (gamma(1._r8+ds)*cs*nsic(i,k)/ & + qniic(i,k))**(1._r8/ds) + n0s(k) = nsic(i,k)*lams(k) + + ! check for slope + lammax = 1._r8/10.e-6_r8 + lammin = 1._r8/2000.e-6_r8 + + ! adjust vars + if (lams(k).lt.lammin) then + lams(k) = lammin + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) + nsic(i,k) = n0s(k)/lams(k) + else if (lams(k).gt.lammax) then + lams(k) = lammax + n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) + nsic(i,k) = n0s(k)/lams(k) + end if + + ! provisional snow number and mass weighted mean fallspeed (m/s) + ums(k) = min(asn(i,k)*gamma(4._r8+bs)/(6._r8*lams(k)**bs),3.6_r8) + uns(k) = min(asn(i,k)*gamma(1._r8+bs)/lams(k)**bs,3.6_r8) + else + lams(k) = 0._r8 + n0s(k) = 0._r8 + ums(k) = 0._r8 + uns(k) = 0._r8 + end if + + !....................................................................... + ! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35) + ! this is hard-wired for bs = 0.4 for now + ! ignore self-collection of cloud ice + + call snow_self_aggregation(t(i,k), rho(i,k), asn(i,k), rhosn, qniic(i,k), nsic(i,k), nsagg(k), 1) + + !....................................................................... + ! accretion of cloud droplets onto snow/graupel + ! here use continuous collection equation with + ! simple gravitational collection kernel + ! ignore collisions between droplets/cloud ice + + ! ignore collision of snow with droplets above freezing + + call accrete_cloud_water_snow(t(i,k), rho(i,k), asn(i,k), uns(k), mua(i,k), & + qcic(i,k), ncic(i,k), qniic(i,k), pgam(i,k), lamc(i,k), lams(k), n0s(k), & + psacws(k), npsacws(k), 1) + + ! secondary ice production due to accretion of droplets by snow + ! (Hallet-Mossop process) (from Cotton et al., 1986) + + call secondary_ice_production(t(i,k), psacws(k), msacwi(k), nsacwi(k), 1) + + !....................................................................... + ! accretion of rain water by snow + ! formula from ikawa and saito, 1991, used by reisner et al., 1998 + + call accrete_rain_snow(t(i,k), rho(i,k), umr(k), ums(k), unr(k), uns(k), qric(i,k), & + qniic(i,k), lamr(k), n0r(k), lams(k), n0s(k), pracs(k), npracs(k), 1 ) + + !....................................................................... + ! heterogeneous freezing of rain drops + ! follows from Bigg (1953) + + call heterogeneous_rain_freezing(t(i,k), qric(i,k), nric(i,k), lamr(k), mnuccr(k), nnuccr(k), 1) + + !....................................................................... + ! accretion of cloud liquid water by rain + ! formula from Khrouditnov and Kogan (2000) + ! gravitational collection kernel, droplet fall speed neglected + + call accrete_cloud_water_rain(.true., qric(i,k), qcic(i,k), ncic(i,k), [1._r8], [0._r8], pra(k), npra(k), 1) + + !....................................................................... + ! Self-collection of rain drops + ! from Beheng(1994) + + call self_collection_rain(rho(i,k), qric(i,k), nric(i,k), nragg(k), 1) + + !....................................................................... + ! Accretion of cloud ice by snow + ! For this calculation, it is assumed that the Vs >> Vi + ! and Ds >> Di for continuous collection + + call accrete_cloud_ice_snow(t(i,k), rho(i,k), asn(i,k), qiic(i,k), niic(i,k), & + qniic(i,k), lams(k), n0s(k), prai(k), nprai(k), 1) + + !....................................................................... + ! fallout term + prf(k) = -umr(k)*qric(i,k)/dz(i,k) + pnrf(k) = -unr(k)*nric(i,k)/dz(i,k) + psf(k) = -ums(k)*qniic(i,k)/dz(i,k) + pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k) + + !........................................................................ + ! calculate vertical velocity in cumulus updraft + + if (k.eq.jb(i)) then + zkine(i,jb(i)) = 0.5_r8 + wu (i,jb(i)) = 1._r8 + zbuo (i,jb(i)) = (tu(i,jb(i))*(1._r8+retv*qu(i,jb(i)))- & + th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))/ & + (th(i,jb(i))*(1._r8+retv*qh(i,jb(i)))) + else + if (.true.) then + ! ECMWF formula + zbc = tu(i,k)*(1._r8+retv*qu(i,k)-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k)) + zbe = th(i,k)*(1._r8+retv*qh(i,k)) + zbuo(i,k) = (zbc-zbe)/zbe + zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 + zdkbuo = dz(i,k+1)*grav*zfacbuo*zbuoc + zdken = min(.99_r8,(1._r8+cwdrag)*max(du(i,k),eu(i,k))*dz(i,k+1)/ & + max(1.e-10_r8,mu(i,k+1))) + zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & + (1._r8+zdken) + else + ! Gregory formula + zbc = tu(i,k)*(1._r8+retv*qu(i,k)) + zbe = th(i,k)*(1._r8+retv*qh(i,k)) + zbuo(i,k) = (zbc-zbe)/zbe-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k) + zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 + zdkbuo = dz(i,k+1)*grav*zbuoc*(1.0_r8-0.25_r8)/6._r8 + zdken = du(i,k)*dz(i,k+1)/max(1.e-10_r8,mu(i,k+1)) + zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & + (1._r8+zdken) + end if + wu(i,k) = min(15._r8,sqrt(2._r8*max(0.1_r8,zkine(i,k) ))) + end if + + arcf(i,k)= mu(i,k)/wu(i,k) + + !............................................................................ + ! droplet activation + ! calculate potential for droplet activation if cloud water is present + ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98 + + if (aero%scheme == 'bulk') then + naer2h(i,k,:) = 0.5_r8*(naer2(i,k,:) + naer2(i,k-1,:)) + end if + + ntaerh(i,k) = 0.5_r8*(ntaer(i,k) + ntaer(i,k-1)) + + if (qcic(i,k).ge.qsmall ) then + + if (aero%scheme == 'modal') then + + nlsrc = 0._r8 + + do m = 1, aero%nmodes + vaerosol(m) = 0._r8 + hygro(m) = 0._r8 + do l = 1, aero%nspec(m) + vol = max(0.5_r8*(aero%mmrg_a(i,k,l,m)+aero%mmrg_a(i,k-1,l,m)) , 0._r8)/aero%specdens(l,m) + vaerosol(m) = vaerosol(m) + vol + hygro(m) = hygro(m) + vol*aero%spechygro(l,m) + end do + if (vaerosol(m) > 1.0e-30_r8) then + hygro(m) = hygro(m)/(vaerosol(m)) + vaerosol(m) = vaerosol(m)*rho(i,k) + else + hygro(m) = 0.0_r8 + vaerosol(m) = 0.0_r8 + endif + naermod(m) = 0.5_r8*(aero%numg_a(i,k,m)+aero%numg_a(i,k-1,m))*rho(i,k) + naermod(m) = max(naermod(m), vaerosol(m)*aero%voltonumbhi(m)) + naermod(m) = min(naermod(m), vaerosol(m)*aero%voltonumblo(m)) + end do + + in_cloud = (k < jb(i)) + smax_f = 0.0_r8 + if (in_cloud) then + if ( qcic(i,k).ge.qsmall ) & + smax_f = ncic(i,k)/lamc(i,k) * gamma(2.0_r8 + pgam(i,k))/gamma(1.0_r8 + pgam(i,k)) + if ( qric(i,k).ge.qsmall) smax_f = smax_f + nric(i,k)/lamr(k) + + end if + + call activate_modal( & + wu(i,k), wmix, wdiab, wmin, wmax, & + t(i,k), rho(i,k), naermod, aero%nmodes, vaerosol, & + hygro, fn, fm, & + fluxn, fluxm, flux_fullact, in_cloud_in=in_cloud, smax_f=smax_f) + + do m = 1, aero%nmodes + nlsrc = nlsrc + fn(m)*naermod(m) ! number nucleated + end do + + if (nlsrc .ne. nlsrc) then + write(iulog,*) "nlsrc=",nlsrc,"wu(i,k)=",wu(i,k) + write(iulog,*) "fn(m)=",fn,"naermod(m)=",naermod,"aero%specdens(l,m)=",aero%specdens + write(iulog,*) "vaerosol(m)=",vaerosol,"aero%voltonumbhi(m)=",aero%voltonumbhi + write(iulog,*) "aero%voltonumblo(m)=",aero%voltonumblo,"k=",k,"i=",i + write(iulog,*) "aero%numg_a(i,k,m)=",aero%numg_a(i,k,:),"rho(i,k)=",rho(i,k) + write(iulog,*) "aero%mmrg_a(i,k,l,m)=",aero%mmrg_a(i,k,:,:) + end if + + dum2l(i,k) = nlsrc + + else if (aero%scheme == 'bulk') then + + call ndrop_bam_run( & + wu(i,k), t(i,k), rho(i,k), naer2h(i,k,:), aero%nbulk, & + aero%nbulk, maerosol, dum2) + + dum2l(i,k) = dum2 + + end if + + else + dum2l(i,k) = 0._r8 + end if + + ! get droplet activation rate + if (qcic(i,k).ge.qsmall .and. t(i,k).gt.238.15_r8 .and. k.gt.jt(i)+2 ) then + + ! assume aerosols already activated are equal number of existing droplets for simplicity + if (k.eq.kqc(i)) then + npccn(k) = dum2l(i,k)/deltat + else + npccn(k) = (dum2l(i,k)-ncic(i,k))/deltat + end if + + ! make sure number activated > 0 + npccn(k) = max(0._r8,npccn(k)) + ncmax = dum2l(i,k) + else + npccn(k)=0._r8 + ncmax = 0._r8 + end if + + !.............................................................................. + !ice nucleation + es(i,k) = svp_water(t(i,k)) ! over water in mixed clouds + esi(i,k) = svp_ice(t(i,k)) ! over ice + qs(i,k) = 0.622_r8*es(i,k)/(ph(i,k) - (1.0_r8-0.622_r8)*es(i,k)) + qs(i,k) = min(1.0_r8,qs(i,k)) + if (qs(i,k) < 0.0_r8) qs(i,k) = 1.0_r8 + + relhum(i,k)= 1.0_r8 + + if (t(i,k).lt.tmelt ) then + + ! compute aerosol number for so4, soot, and dust with units #/cm^3 + so4_num = 0._r8 + soot_num = 0._r8 + dst1_num = 0._r8 + dst2_num = 0._r8 + dst3_num = 0._r8 + dst4_num = 0._r8 + + if (aero%scheme == 'modal') then + + !For modal aerosols, assume for the upper troposphere: + ! soot = accumulation mode + ! sulfate = aiken mode + ! dust = coarse mode + ! since modal has internal mixtures. + soot_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_accum_idx) & + +aero%numg_a(i,k,aero%mode_accum_idx))*rho(i,k)*1.0e-6_r8 + dmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx)) + ssmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx)) + if (dmc > 0._r8) then + dst_num = dmc/(ssmc + dmc) *(aero%numg_a(i,k-1,aero%mode_coarse_idx) & + + aero%numg_a(i,k,aero%mode_coarse_idx))*0.5_r8*rho(i,k)*1.0e-6_r8 + else + dst_num = 0.0_r8 + end if + dgnum_aitken = 0.5_r8*(aero%dgnumg(i,k,aero%mode_aitken_idx)+ & + aero%dgnumg(i,k-1,aero%mode_aitken_idx)) + if (dgnum_aitken > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + so4_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_aitken_idx)+ & + aero%numg_a(i,k,aero%mode_aitken_idx))*rho(i,k)*1.0e-6_r8 & + * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum_aitken)/ & + (2._r8**0.5_r8*log(aero%sigmag_aitken)))) + else + so4_num = 0.0_r8 + end if + so4_num = max(0.0_r8, so4_num) + + else if (aero%scheme == 'bulk') then + + if (aero%idxsul > 0) then + so4_num = naer2h(i,k,aero%idxsul)/25._r8 *1.0e-6_r8 + end if + if (aero%idxbcphi > 0) then + soot_num = naer2h(i,k,aero%idxbcphi)/25._r8 *1.0e-6_r8 + end if + if (aero%idxdst1 > 0) then + dst1_num = naer2h(i,k,aero%idxdst1)/25._r8 *1.0e-6_r8 + end if + if (aero%idxdst2 > 0) then + dst2_num = naer2h(i,k,aero%idxdst2)/25._r8 *1.0e-6_r8 + end if + if (aero%idxdst3 > 0) then + dst3_num = naer2h(i,k,aero%idxdst3)/25._r8 *1.0e-6_r8 + end if + if (aero%idxdst4 > 0) then + dst4_num = naer2h(i,k,aero%idxdst4)/25._r8 *1.0e-6_r8 + end if + dst_num = dst1_num + dst2_num + dst3_num + dst4_num + + end if + + ! *** Turn off soot nucleation *** + soot_num = 0.0_r8 + + ! Liu et al.,J. climate, 2007 + if ( wu(i,k) .lt. 4.0_r8) then + call nucleati( & + wu(i,k), t(i,k), ph(i,k), relhum(i,k), 1.0_r8, qcic(i,k), & + 1.0e-20_r8, 0.0_r8, rho(i,k), so4_num, dst_num, soot_num, 1.0_r8, & + dum2i(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & + wpice, weff, fhom, temp1, temp2, temp3, temp4, .true. ) + end if + nihf(i,k)=nihf(i,k)*rho(i,k) ! convert from #/kg -> #/m3) + niimm(i,k)=niimm(i,k)*rho(i,k) + nidep(i,k)=nidep(i,k)*rho(i,k) + nimey(i,k)=nimey(i,k)*rho(i,k) + + if (.false.) then + ! cooper curve (factor of 1000 is to convert from L-1 to m-3) + !dum2i(i,k)=0.005_r8*exp(0.304_r8*(273.15_r8-t(i,k)))*1000._r8 + + ! put limit on number of nucleated crystals, set to number at T=-30 C + ! cooper (limit to value at -35 C) + !dum2i(i,k)=min(dum2i(i,k),208.9e3_r8)/rho(i,k) ! convert from m-3 to kg-1 + end if + + else + dum2i(i,k)=0._r8 + end if + + ! ice nucleation if activated nuclei exist at t<0C + + if (dum2i(i,k).gt.0._r8.and.t(i,k).lt.tmelt.and. & + relhum(i,k)*es(i,k)/esi(i,k).gt. 1.05_r8 .and. k.gt.jt(i)+1) then + + if (k.eq.kqi(i)) then + nnuccd(k)=dum2i(i,k)/deltat + else + nnuccd(k)=(dum2i(i,k)-niic(i,k))/deltat + end if + nnuccd(k)=max(nnuccd(k),0._r8) + + !Calc mass of new particles using new crystal mass... + !also this will be multiplied by mtime as nnuccd is... + + mnuccd(k) = nnuccd(k) * mi0 + else + nnuccd(k)=0._r8 + mnuccd(k) = 0._r8 + end if + + !................................................................................ + ! Bergeron process + ! If 0C< T <-40C and both ice and liquid exist + + if (t(i,k).le.273.15_r8 .and. t(i,k).gt.233.15_r8 .and. & + qiic(i,k).gt.0.5e-6_r8 .and. qcic(i,k).gt. qsmall) then + plevap = qcic(i,k)/bergtsf + prb(k) = max(0._r8,plevap) + nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k)) + else + prb(k)=0._r8 + nprb(k)=0._r8 + end if + + !................................................................................ + ! heterogeneous freezing of cloud water (-5C < T < -35C) + + if (qcic(i,k).ge.qsmall .and.ncic(i,k).gt.0._r8 .and. ntaerh(i,k).gt.0._r8 .and. & + t(i,k).le.268.15_r8 .and. t(i,k).gt.238.15_r8 ) then + + if (aero%scheme == 'bulk') then + ! immersion freezing (Diehl and Wurzler, 2004) + ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) + + nai_bcphi = 0.0_r8 + nai_dst1 = 0.0_r8 + nai_dst2 = 0.0_r8 + nai_dst3 = 0.0_r8 + nai_dst4 = 0.0_r8 + + if (aero%idxbcphi > 0) nai_bcphi = naer2h(i,k,aero%idxbcphi) + if (aero%idxdst1 > 0) nai_dst1 = naer2h(i,k,aero%idxdst1) + if (aero%idxdst2 > 0) nai_dst2 = naer2h(i,k,aero%idxdst2) + if (aero%idxdst3 > 0) nai_dst3 = naer2h(i,k,aero%idxdst3) + if (aero%idxdst4 > 0) nai_dst4 = naer2h(i,k,aero%idxdst4) + + naimm = (0.00291_r8*nai_bcphi + 32.3_r8*(nai_dst1 + nai_dst2 + & + nai_dst3 + nai_dst4))/ntaerh(i,k) !m-3 + if (ttend(k) .lt. 0._r8) then + nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 + mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) + end if + else + if (.false.) then + ! immersion freezing (Diehl and Wurzler, 2004) + ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) + naimm = (0.00291_r8*soot_num + 32.3_r8*dst_num )*1.0e6_r8/ntaerh(i,k) !m-3 + if (ttend(k) .lt. 0._r8) then + nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 + mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) + end if + else + ! immersion freezing (Bigg, 1953) + mnuccc(k) = pi*pi/36._r8*rhow* & + cdist1(k)*gamma(7._r8+pgam(i,k))* & + bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ & + lamc(i,k)**3/lamc(i,k)**3 + + nnuccc(k) = pi/6._r8*cdist1(k)*gamma(pgam(i,k)+4._r8) & + *bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(i,k)**3 + end if + end if + + ! contact freezing (Young, 1974) with hooks into simulated dust + + tcnt=(270.16_r8-t(i,k))**1.3_r8 + viscosity=1.8e-5_r8*(t(i,k)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) + mfp=2.0_r8*viscosity/(ph(i,k) & ! Mean free path (m) + *sqrt(8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i,k)))) + + slip1=1.0_r8+(mfp/rn_dst1)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst1/mfp))))! Slip correction factor + slip2=1.0_r8+(mfp/rn_dst2)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst2/mfp)))) + slip3=1.0_r8+(mfp/rn_dst3)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst3/mfp)))) + slip4=1.0_r8+(mfp/rn_dst4)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst4/mfp)))) + + dfaer1=1.381e-23_r8*t(i,k)*slip1/(6._r8*pi*viscosity*rn_dst1) ! aerosol diffusivity (m2/s) + dfaer2=1.381e-23_r8*t(i,k)*slip2/(6._r8*pi*viscosity*rn_dst2) + dfaer3=1.381e-23_r8*t(i,k)*slip3/(6._r8*pi*viscosity*rn_dst3) + dfaer4=1.381e-23_r8*t(i,k)*slip4/(6._r8*pi*viscosity*rn_dst4) + + nacon1=0.0_r8 + nacon2=0.0_r8 + nacon3=0.0_r8 + nacon4=0.0_r8 + + if (aero%scheme == 'modal') then + + ! For modal aerosols: + ! use size '3' for dust coarse mode... + ! scale by dust fraction in coarse mode + + dmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx)) + ssmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx)) + if (dmc > 0.0_r8) then + nacon3 = dmc/(ssmc + dmc) * (aero%numg_a(i,k,aero%mode_coarse_idx) & + + aero%numg_a(i,k-1,aero%mode_coarse_idx))*0.5_r8*rho(i,k) + end if + + else if (aero%scheme == 'bulk') then + + if (aero%idxdst1.gt.0) then + nacon1=naer2h(i,k,aero%idxdst1)*tcnt *0.0_r8 + endif + if (aero%idxdst2.gt.0) then + nacon2=naer2h(i,k,aero%idxdst2)*tcnt ! 1/m3 + endif + if (aero%idxdst3.gt.0) then + nacon3=naer2h(i,k,aero%idxdst3)*tcnt + endif + if (aero%idxdst4.gt.0) then + nacon4=naer2h(i,k,aero%idxdst4)*tcnt + endif + end if + + mnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*pi*pi/3._r8*rhow* & + cdist1(k)*gamma(pgam(i,k)+5._r8)/lamc(i,k)**4 + + nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi* & + cdist1(k)*gamma(pgam(i,k)+2._r8)/lamc(i,k) + + ! if (nnuccc(k).gt.nnuccd(k)) then + ! dum=nnuccd(k)/nnuccc(k) + ! scale mixing ratio of droplet freezing with limit + ! mnuccc(k)=mnuccc(k)*dum + ! nnuccc(k)=nnuccd(k) + ! end if + + else + mnuccc(k) = 0._r8 + nnuccc(k) = 0._r8 + mnucct(k) = 0._r8 + nnucct(k) = 0._r8 + end if + + ! freeze cloud liquid water homogeneously at -40 C + if (t(i,k) < 233.15_r8 .and. qc(i,k) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above + ! threshold + dum = xlf/cp*qc(i,k) + if (t(i,k)+dum.gt.233.15_r8) then + dum = -(t(i,k)-233.15_r8)*cp/xlf + dum = dum/qc(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + fholm(i,k) = mu(i,k)*dum*qc(i,k) + fholn(i,k) = mu(i,k)*dum*nc(i,k) + end if + + + !**************************************************************************************** + ! conservation to ensure no negative values of cloud water/precipitation + ! in case microphysical process rates are large + ! note: for check on conservation, processes are multiplied by omsm + ! to prevent problems due to round off error + + ! since activation/nucleation processes are fast, need to take into account + ! factor mtime = mixing timescale in cloud / model time step + ! for now mixing timescale is assumed to be 15 min + !***************************************************************************************** + + mtime=deltat/900._r8 + mtimec=deltat/900._r8 + + ! conservation of qc + ! ice mass production from ice nucleation(deposition/cond.-freezing), mnuccd, + ! is considered as a part of cmei. + + qce = mu(i,k)*qc(i,k)-fholm(i,k) +dz(i,k)*cmel(i,k-1) + dum = arcf(i,k)*(pra(k)+prc(k)+prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & + psacws(k))*dz(i,k) + if( qce.lt.0._r8) then + qcimp(k) = .true. + prc(k) = 0._r8 + pra(k) = 0._r8 + prb(k) = 0._r8 + mnuccc(k) = 0._r8 + mnucct(k) = 0._r8 + msacwi(k) = 0._r8 + psacws(k) = 0._r8 + else if (dum.gt.qce) then + ratio = qce/dum*omsm + prc(k) = prc(k)*ratio + pra(k) = pra(k)*ratio + prb(k) = prb(k)*ratio + mnuccc(k) = mnuccc(k)*ratio + mnucct(k) = mnucct(k)*ratio + msacwi(k) = msacwi(k)*ratio + psacws(k) = psacws(k)*ratio + end if + + ! conservation of nc + nce = mu(i,k)*nc(i,k)-fholn(i,k) + (arcf(i,k)*npccn(k)*mtimec)*dz(i,k) + dum = arcf(i,k)*dz(i,k)*(nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ & + npsacws(k)+ nprb(k) ) + if (nce.lt.0._r8) then + ncimp(k) = .true. + nprc1(k) = 0._r8 + npra(k) = 0._r8 + nnuccc(k) = 0._r8 + nnucct(k) = 0._r8 + npsacws(k) = 0._r8 + nprb(k) = 0._r8 + else if (dum.gt.nce) then + ratio = nce/dum*omsm + nprc1(k) = nprc1(k)*ratio + npra(k) = npra(k)*ratio + nnuccc(k) = nnuccc(k)*ratio + nnucct(k) = nnucct(k)*ratio + npsacws(k) = npsacws(k)*ratio + nprb(k) = nprb(k)*ratio + end if + + ! conservation of qi + qie = mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*(cmei(i,k-1) + & + ( mnuccc(k)+mnucct(k)+msacwi(k)+prb(k))*arcf(i,k) ) + dum = arcf(i,k)*(prci(k)+ prai(k))*dz(i,k) + if (qie.lt.0._r8) then + qiimp(k) = .true. + prci(k) = 0._r8 + prai(k) = 0._r8 + else if (dum.gt.qie) then + ratio = qie/dum*omsm + prci(k) = prci(k)*ratio + prai(k) = prai(k)*ratio + end if + + ! conservation of ni + nie = mu(i,k)*ni(i,k)+fholn(i,k) +dz(i,k)*(nnuccd(k)*mtime*arcf(i,k) & + +(nnuccc(k)+ nnucct(k))*arcf(i,k) ) + dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ nprai(k)) + if( nie.lt.0._r8) then + niimp(k) = .true. + nsacwi(k)= 0._r8 + nprci(k) = 0._r8 + nprai(k) = 0._r8 + else if (dum.gt.nie) then + ratio = nie/dum*omsm + nsacwi(k)= nsacwi(k)*ratio + nprci(k) = nprci(k)*ratio + nprai(k) = nprai(k)*ratio + end if + + ! conservation of qr + + qre = mu(i,k)*qr(i,k)+dz(i,k)*(pra(k)+prc(k))*arcf(i,k) + dum = arcf(i,k)*dz(i,k)*(pracs(k)+ mnuccr(k)-prf(k)) + if (qre.lt.0._r8) then + prf(k) = 0._r8 + pracs(k) = 0._r8 + mnuccr(k) = 0._r8 + else if (dum.gt.qre) then + ratio = qre/dum*omsm + prf(k) = prf(k)*ratio + pracs(k) = pracs(k)*ratio + mnuccr(k) = mnuccr(k)*ratio + end if + + ! conservation of nr + nre = mu(i,k)*nr(i,k) + nprc(k)*arcf(i,k)*dz(i,k) + dum = arcf(i,k)*dz(i,k)*(npracs(k)+nnuccr(k) & + -nragg(k)-pnrf(k)) + if(nre.lt.0._r8) then + npracs(k)= 0._r8 + nnuccr(k)= 0._r8 + nragg(k) = 0._r8 + pnrf(k) = 0._r8 + else if (dum.gt.nre) then + ratio = nre/dum*omsm + npracs(k)= npracs(k)*ratio + nnuccr(k)= nnuccr(k)*ratio + nragg(k) = nragg(k)*ratio + pnrf(k) = pnrf(k)*ratio + end if + + ! conservation of qni + + qnie = mu(i,k)*qni(i,k)+dz(i,k)*( (prai(k)+psacws(k)+prci(k)+ & + pracs(k)+mnuccr(k))*arcf(i,k) ) + dum = arcf(i,k)*dz(i,k)*(-psf(k)) + + if(qnie.lt.0._r8) then + psf(k) = 0._r8 + else if (dum.gt.qnie) then + ratio = qnie/dum*omsm + psf(k) = psf(k)*ratio + end if + + ! conservation of ns + nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+nnuccr(k))*arcf(i,k) + dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k)) + if (nse.lt.0._r8) then + nsagg(k) = 0._r8 + pnsf(k) = 0._r8 + else if (dum.gt.nse) then + ratio = nse/dum*omsm + nsagg(k) = nsagg(k)*ratio + pnsf(k) = pnsf(k)*ratio + end if + + !***************************************************************************** + ! get tendencies due to microphysical conversion processes + !***************************************************************************** + + if (k.le.kqc(i)) then + qctend(i,k) = (-pra(k)-prc(k)-prb(k)-mnuccc(k)-mnucct(k)-msacwi(k)- & + psacws(k)) + + qitend(i,k) = (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- prai(k)) + + qrtend(i,k) = (pra(k)+prc(k))+(-pracs(k)- mnuccr(k)) + + qnitend(i,k) = (prai(k)+psacws(k)+prci(k))+(pracs(k)+mnuccr(k)) + + ! multiply activation/nucleation by mtime to account for fast timescale + + nctend(i,k) = npccn(k)*mtimec+(-nnuccc(k)-nnucct(k)-npsacws(k) & + -npra(k)-nprc1(k)-nprb(k)) + + nitend(i,k) = nnuccd(k)*mtime+(nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- & + nprai(k)) + + nstend(i,k) = nsagg(k)+nnuccr(k) + nprci(k) + + nrtend(i,k) = nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k)) + + ! for output + ! cloud liquid water------------- + + autolm(i,k-1) = -prc(k)*arcf(i,k) + accrlm(i,k-1) = -pra(k)*arcf(i,k) + bergnm(i,k-1) = -prb(k)*arcf(i,k) + fhtimm(i,k-1) = -mnuccc(k)*arcf(i,k) + fhtctm(i,k-1) = -mnucct(k)*arcf(i,k) + hmpim (i,k-1) = -msacwi(k)*arcf(i,k) + accslm(i,k-1) = -psacws(k)*arcf(i,k) + fhmlm(i,k-1) = -fholm(i,k)/dz(i,k) + + autoln(i,k-1) = -nprc1(k)*arcf(i,k) + accrln(i,k-1) = -npra(k)*arcf(i,k) + bergnn(i,k-1) = -nprb(k)*arcf(i,k) + fhtimn(i,k-1) = -nnuccc(k)*arcf(i,k) + fhtctn(i,k-1) = -nnucct(k)*arcf(i,k) + accsln(i,k-1) = -npsacws(k)*arcf(i,k) + activn(i,k-1) = npccn(k)*mtimec*arcf(i,k) + fhmln(i,k-1) = -fholn(i,k)/dz(i,k) + + !cloud ice------------------------ + + autoim(i,k-1) = -prci(k)*arcf(i,k) + accsim(i,k-1) = -prai(k)*arcf(i,k) + + nuclin(i,k-1) = nnuccd(k)*mtime*arcf(i,k) + autoin(i,k-1) = -nprci(k)*arcf(i,k) + accsin(i,k-1) = -nprai(k)*arcf(i,k) + hmpin (i,k-1) = nsacwi(k)*arcf(i,k) + + else + qctend(i,k) = 0._r8 + qitend(i,k) = 0._r8 + qrtend(i,k) = 0._r8 + qnitend(i,k) = 0._r8 + nctend(i,k) = 0._r8 + nitend(i,k) = 0._r8 + nstend(i,k) = 0._r8 + nrtend(i,k) = 0._r8 + end if + + !******************************************************************************** + ! vertical integration + !******************************************************************************** + ! snow + if ( k.le.kqi(i) ) then + qni(i,k-1) = 1._r8/mu(i,k-1)* & + (mu(i,k)*qni(i,k)+dz(i,k)*(qnitend(i,k)+psf(k))*arcf(i,k) ) + + ns(i,k-1) = 1._r8/mu(i,k-1)* & + (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) ) + + else + qni(i,k-1)=0._r8 + ns(i,k-1)=0._r8 + end if + + if (qni(i,k-1).le.0._r8) then + qni(i,k-1)=0._r8 + ns(i,k-1)=0._r8 + end if + + ! rain + if (k.le.kqc(i) ) then + qr(i,k-1) = 1._r8/mu(i,k-1)* & + (mu(i,k)*qr(i,k)+dz(i,k)*(qrtend(i,k)+prf(k))*arcf(i,k) ) + + nr(i,k-1) = 1._r8/mu(i,k-1)* & + (mu(i,k)*nr(i,k)+dz(i,k)*(nrtend(i,k)+pnrf(k))*arcf(i,k) ) + + else + qr(i,k-1)=0._r8 + nr(i,k-1)=0._r8 + end if + + if( qr(i,k-1) .le. 0._r8) then + qr(i,k-1)=0._r8 + nr(i,k-1)=0._r8 + end if + + ! freeze rain homogeneously at -40 C + + if (t(i,k-1) < 233.15_r8 .and. qr(i,k-1) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cp*qr(i,k-1) + if (t(i,k-1)+dum.gt.233.15_r8) then + dum = -(t(i,k-1)-233.15_r8)*cp/xlf + dum = dum/qr(i,k-1) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + qni(i,k-1)=qni(i,k-1)+dum*qr(i,k-1) + ns(i,k-1)=ns(i,k-1)+dum*nr(i,k-1) + qr(i,k-1)=(1._r8-dum)*qr(i,k-1) + nr(i,k-1)=(1._r8-dum)*nr(i,k-1) + fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k) + end if + + + ! cloud water + if ( k.le.kqc(i) ) then + qc(i,k-1) = (mu(i,k)*qc(i,k)-fholm(i,k)+dz(i,k)*qctend(i,k)*arcf(i,k) & + +dz(i,k)*cmel(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) + + qcde(i,k) = qc(i,k-1) + + nc(i,k-1) = (mu(i,k)*nc(i,k) -fholn(i,k) +dz(i,k)*nctend(i,k)*arcf(i,k) ) & + /(mu(i,k-1)+dz(i,k)*du(i,k-1)) + + ncde(i,k) = nc(i,k-1) + else + qc(i,k-1)=0._r8 + nc(i,k-1)=0._r8 + end if + + if (qc(i,k-1).lt.0._r8) write(iulog,*) "negative qc(i,k-1)=",qc(i,k-1) + dlfm(i,k-1) = -du(i,k-1)*qcde(i,k) + dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) + + if (qc(i,k-1).le. 0._r8) then + qc(i,k-1)=0._r8 + nc(i,k-1)=0._r8 + end if + + if (nc(i,k-1).lt. 0._r8) then + write(iulog,*) "nc(i,k-1)=",nc(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) + write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"nc(i,k)=",ni(i,k) + write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nctend(i,k)=",nctend(i,k) + write(iulog,*) "eu(i,k-1)=",eu(i,k-1) + end if + + ! cloud ice + if( k.le.kqi(i)) then + qi(i,k-1) = (mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*qitend(i,k)*arcf(i,k) & + +dz(i,k)*cmei(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) + + qide(i,k) = qi(i,k-1) + + ni(i,k-1) = (mu(i,k)*ni(i,k)+fholn(i,k)+dz(i,k)*nitend(i,k)*arcf(i,k) ) & + /(mu(i,k-1)+dz(i,k)*du(i,k-1)) + + nide(i,k) = ni(i,k-1) + else + qi(i,k-1)=0._r8 + ni(i,k-1)=0._r8 + end if + + if (qi(i,k-1).lt.0._r8) write(iulog,*) "negative qi(i,k-1)=",qi(i,k-1) + difm(i,k-1) = -du(i,k-1)*qide(i,k) + difn(i,k-1) = -du(i,k-1)*nide(i,k) + + if (qi(i,k-1).le. 0._r8) then + qi(i,k-1)=0._r8 + ni(i,k-1)=0._r8 + end if + + + if (ni(i,k-1).lt. 0._r8) then + write(iulog,*) "ni(i,k-1)=",ni(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) + write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"ni(i,k)=",ni(i,k) + write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nitend(i,k)=",nitend(i,k) + write(iulog,*) "eu(i,k-1)=",eu(i,k-1) + end if + + + frz(i,k-1) = cmei(i,k-1) + arcf(i,k)*(prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & + pracs(k)+mnuccr(k)+psacws(k) )-fhmlm(i,k-1)-fhmrm(i,k-1) + + + !****************************************************************************** + ! get size distribution parameters based on in-cloud cloud water/ice + ! these calculations also ensure consistency between number and mixing ratio + + ! following equation(2,3,4) of Morrison and Gettelman, 2008, J. Climate. + ! Gamma(n)= (n-1)! + ! lamc <-> lambda for cloud liquid water + ! pgam <-> meu for cloud liquid water + ! meu=0 for ice,rain and snow + !******************************************************************************* + + ! cloud ice + niorg = ni(i,k-1) + if (qi(i,k-1).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + ni(i,k-1)=min(ni(i,k-1),qi(i,k-1)*1.e20_r8) + ! ni should be non-negative + ! ni(i,k-1) = max(ni(i,k-1), 0._r8) + if (ni(i,k-1).lt. 0._r8) write(iulog,*) "ni(i,k-1)=",ni(i,k-1) + + lami(k-1) = (gamma(1._r8+di)*ci* & + ni(i,k-1)/qi(i,k-1))**(1._r8/di) + n0i(k-1) = ni(i,k-1)*lami(k-1) + + ! check for slope + lammax = 1._r8/10.e-6_r8 + lammin = 1._r8/(2._r8*dcs) + + ! adjust vars + if (lami(k-1).lt.lammin) then + lami(k-1) = lammin + n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) + ni(i,k-1) = n0i(k-1)/lami(k-1) + else if (lami(k-1).gt.lammax) then + lami(k-1) = lammax + n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) + ni(i,k-1) = n0i(k-1)/lami(k-1) + end if + else + lami(k-1) = 0._r8 + n0i(k-1) = 0._r8 + end if + + nide(i,k) = ni(i,k-1) + difn(i,k-1) = -du(i,k-1)*nide(i,k) + + niadj(i,k-1)= (ni(i,k-1)- niorg)*mu(i,k-1)/dz(i,k) + + if (niadj(i,k-1) .lt. 0._r8) then + total = nuclin(i,k-1)-fhtimn(i,k-1)-fhtctn(i,k-1)-fhmln(i,k-1)+ hmpin (i,k-1) + if (total .ne. 0._r8) then + nuclin(i,k-1) = nuclin(i,k-1) + nuclin(i,k-1)*niadj(i,k-1)/total + fhtimn(i,k-1) = fhtimn(i,k-1) + fhtimn(i,k-1)*niadj(i,k-1)/total + fhtctn(i,k-1) = fhtctn(i,k-1) + fhtctn(i,k-1)*niadj(i,k-1)/total + fhmln (i,k-1) = fhmln (i,k-1) + fhmln (i,k-1)*niadj(i,k-1)/total + hmpin (i,k-1) = hmpin (i,k-1) + hmpin (i,k-1)*niadj(i,k-1)/total + else + total = 5._r8 + nuclin(i,k-1) = nuclin(i,k-1) + niadj(i,k-1)/total + fhtimn(i,k-1) = fhtimn(i,k-1) + niadj(i,k-1)/total + fhtctn(i,k-1) = fhtctn(i,k-1) + niadj(i,k-1)/total + fhmln (i,k-1) = fhmln (i,k-1) + niadj(i,k-1)/total + hmpin (i,k-1) = hmpin (i,k-1) + niadj(i,k-1)/total + end if + else if (niadj(i,k-1) .gt. 0._r8) then + total = autoin(i,k-1)+accsin(i,k-1) + if (total .ne. 0._r8) then + autoin(i,k-1) = autoin(i,k-1) + autoin(i,k-1)*niadj(i,k-1)/total + accsin(i,k-1) = accsin(i,k-1) + accsin(i,k-1)*niadj(i,k-1)/total + else + total = 2._r8 + autoin(i,k-1) = autoin(i,k-1) + niadj(i,k-1)/total + accsin(i,k-1) = accsin(i,k-1) + niadj(i,k-1)/total + end if + end if + + !................................................................................ + !cloud water + ncorg = nc(i,k-1) + if (qc(i,k-1).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + nc(i,k-1)=min(nc(i,k-1),qc(i,k-1)*1.e20_r8) + ! and make sure it's non-negative + ! nc(i,k-1) = max(nc(i,k-1), 0._r8) + if (nc(i,k-1).lt. 0._r8) write(iulog,*) "nc(i,k-1)=",nc(i,k-1) + + ! get pgam from fit to observations of martin et al. 1994 + + pgam(i,k-1)=0.0005714_r8*(nc(i,k-1)/1.e6_r8/rho(i,k-1))+0.2714_r8 + pgam(i,k-1)=1._r8/(pgam(i,k-1)**2)-1._r8 + pgam(i,k-1)=max(pgam(i,k-1),2._r8) + pgam(i,k-1)=min(pgam(i,k-1),15._r8) + ! calculate lamc + + lamc(i,k-1) = (pi/6._r8*rhow*nc(i,k-1)*gamma(pgam(i,k-1)+4._r8)/ & + (qc(i,k-1)*gamma(pgam(i,k-1)+1._r8)))**(1._r8/3._r8) + + ! lammin, 50 micron diameter max mean size + lammin = (pgam(i,k-1)+1._r8)/40.e-6_r8 + lammax = (pgam(i,k-1)+1._r8)/1.e-6_r8 + + if (lamc(i,k-1).lt.lammin) then + lamc(i,k-1) = lammin + nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & + gamma(pgam(i,k-1)+1._r8)/ & + (pi*rhow*gamma(pgam(i,k-1)+4._r8)) + else if (lamc(i,k-1).gt.lammax) then + lamc(i,k-1) = lammax + nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & + gamma(pgam(i,k-1)+1._r8)/ & + (pi*rhow*gamma(pgam(i,k-1)+4._r8)) + end if + + ! parameter to calculate droplet freezing + + cdist1(k-1) = nc(i,k-1)/gamma(pgam(i,k-1)+1._r8) + else + lamc(i,k-1) = 0._r8 + cdist1(k-1) = 0._r8 + end if + + ncde(i,k) = nc(i,k-1) + dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) + + ncadj(i,k-1) = (nc(i,k-1)- ncorg)*mu(i,k-1)/dz(i,k) + if (ncadj(i,k-1) .lt. 0._r8) then + activn(i,k-1) = activn(i,k-1) + ncadj(i,k-1) + else if (ncadj(i,k-1) .gt. 0._r8) then + total = autoln(i,k-1)+accrln(i,k-1)+bergnn(i,k-1)+accsln(i,k-1) + if (total .ne. 0._r8) then + autoln(i,k-1) = autoln(i,k-1) + autoln(i,k-1)*ncadj(i,k-1)/total + accrln(i,k-1) = accrln(i,k-1) + accrln(i,k-1)*ncadj(i,k-1)/total + bergnn(i,k-1) = bergnn(i,k-1) + bergnn(i,k-1)*ncadj(i,k-1)/total + accsln(i,k-1) = accsln(i,k-1) + accsln(i,k-1)*ncadj(i,k-1)/total + else + total = 4._r8 + autoln(i,k-1) = autoln(i,k-1) + ncadj(i,k-1)/total + accrln(i,k-1) = accrln(i,k-1) + ncadj(i,k-1)/total + bergnn(i,k-1) = bergnn(i,k-1) + ncadj(i,k-1)/total + accsln(i,k-1) = accsln(i,k-1) + ncadj(i,k-1)/total + end if + end if + + trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k) + trspcn(i,k-1) = (mu(i,k)*nc(i,k) - mu(i,k-1)*nc(i,k-1))/dz(i,k) + trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k) + trspin(i,k-1) = (mu(i,k)*ni(i,k) - mu(i,k-1)*ni(i,k-1))/dz(i,k) + + if (k-1 .eq. jt(i)+1) then + trspcm(i,k-2) = mu(i,k-1)*qc(i,k-1)/dz(i,k-1) + trspcn(i,k-2) = mu(i,k-1)*nc(i,k-1)/dz(i,k-1) + trspim(i,k-2) = mu(i,k-1)*qi(i,k-1)/dz(i,k-1) + trspin(i,k-2) = mu(i,k-1)*ni(i,k-1)/dz(i,k-1) + qcde(i,k-1) = qc(i,k-1) + ncde(i,k-1) = nc(i,k-1) + qide(i,k-1) = qi(i,k-1) + nide(i,k-1) = ni(i,k-1) + dlfm (i,k-2) = -du(i,k-2)*qcde(i,k-1) + dlfn (i,k-2) = -du(i,k-2)*ncde(i,k-1) + difm (i,k-2) = -du(i,k-2)*qide(i,k-1) + difn (i,k-2) = -du(i,k-2)*nide(i,k-1) + end if + + + !....................................................................... + ! get size distribution parameters for precip + !...................................................................... + ! rain + if (qr(i,k-1).ge.qsmall) then + + lamr(k-1) = (pi*rhow*nr(i,k-1)/qr(i,k-1))**(1._r8/3._r8) + n0r(k-1) = nr(i,k-1)*lamr(k-1) + + ! check for slope + lammax = 1._r8/150.e-6_r8 + lammin = 1._r8/3000.e-6_r8 + ! adjust vars + if (lamr(k-1).lt.lammin) then + lamr(k-1) = lammin + n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) + nr(i,k-1) = n0r(k-1)/lamr(k-1) + else if (lamr(k-1).gt.lammax) then + lamr(k-1) = lammax + n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) + nr(i,k-1) = n0r(k-1)/lamr(k-1) + end if + + unr(k-1) = min(arn(i,k-1)*gamma(1._r8+br)/lamr(k-1)**br,10._r8) + umr(k-1) = min(arn(i,k-1)*gamma(4._r8+br)/(6._r8*lamr(k-1)**br),10._r8) + else + lamr(k-1) = 0._r8 + n0r(k-1) = 0._r8 + umr(k-1) = 0._r8 + unr(k-1) = 0._r8 + end if + + !...................................................................... + ! snow + if (qni(i,k-1).ge.qsmall) then + lams(k-1) = (gamma(1._r8+ds)*cs*ns(i,k-1)/ & + qni(i,k-1))**(1._r8/ds) + n0s(k-1) = ns(i,k-1)*lams(k-1) + + ! check for slope + lammax = 1._r8/10.e-6_r8 + lammin = 1._r8/2000.e-6_r8 + + ! adjust vars + if (lams(k-1).lt.lammin) then + lams(k-1) = lammin + n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) + ns(i,k-1) = n0s(k-1)/lams(k-1) + else if (lams(k-1).gt.lammax) then + lams(k-1) = lammax + n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) + ns(i,k-1) = n0s(k-1)/lams(k-1) + end if + ums(k-1) = min(asn(i,k-1)*gamma(4._r8+bs)/(6._r8*lams(k-1)**bs),3.6_r8) + uns(k-1) = min(asn(i,k-1)*gamma(1._r8+bs)/lams(k-1)**bs,3.6_r8) + else + lams(k-1) = 0._r8 + n0s(k-1) = 0._r8 + ums(k-1) = 0._r8 + uns(k-1) = 0._r8 + end if + + rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k))*arcf(i,k) + sprd(i,k-1)= qnitend(i,k) *arcf(i,k) -fhmrm(i,k-1) + + end if ! k shr_kind_r8 + use solar_irrad_data, only : sol_irrad, we, nbins, do_spctrl_scaling, ssi_ref + use solar_irrad_data, only : has_spectrum, has_ref_spectrum + use cam_abortutils, only : endrun + + implicit none + save + + private + public :: rad_solar_var_init + public :: get_variability + + real(r8), allocatable :: ref_band_irrad(:) ! scaling will be relative to ref_band_irrad in each band + real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + + real(r8), allocatable :: radbinmax(:) + real(r8), allocatable :: radbinmin(:) + integer :: nradbins +contains + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine rad_solar_var_init( ) + use radconstants, only : get_number_sw_bands + use radconstants, only : get_sw_spectral_boundaries + use radconstants, only : get_ref_solar_band_irrad + use radconstants, only : get_ref_total_solar_irrad + + integer :: i + integer :: ierr + integer :: yr, mon, tod + + + call get_number_sw_bands(nradbins) + + if ( do_spctrl_scaling ) then + + if ( .not.has_spectrum ) then + call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') + endif + + if ( .not.has_ref_spectrum ) then + call endrun('rad_solar_var_init: solar input file must have reference irradiance spectrum') + endif + + allocate (radbinmax(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmax') + end if + + allocate (radbinmin(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmin') + end if + + allocate (ref_band_irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for ref_band_irrad') + end if + + allocate (irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for irrad') + end if + + call get_sw_spectral_boundaries(radbinmin, radbinmax, 'nm') + + call integrate_spectrum( nbins, nradbins, we, radbinmin, radbinmax, ssi_ref, ref_band_irrad) + + endif + + endsubroutine rad_solar_var_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine get_variability( sfac ) + + real(r8), intent(out) :: sfac(nradbins) ! scaling factors for CAM heating + + integer :: yr, mon, day, tod + + if ( do_spctrl_scaling ) then + + call integrate_spectrum( nbins, nradbins, we, radbinmin, radbinmax, sol_irrad, irrad) + + sfac(:nradbins) = irrad(:nradbins)/ref_band_irrad(:nradbins) + + else + + sfac(:nradbins) = 1._r8 + + endif + + endsubroutine get_variability + +!------------------------------------------------------------------------------- +! private method......... +!------------------------------------------------------------------------------- + + subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) + + use mo_util, only : rebin + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: max_trg(ntrg) ! target coordinates + real(r8), intent(in) :: min_trg(ntrg) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + real(r8) :: trg_x(2), targ(1) ! target coordinates + integer :: i + + do i = 1, ntrg + + trg_x(1) = min_trg(i) + trg_x(2) = max_trg(i) + + call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) + ! W/m2/nm --> W/m2 + trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) + + enddo + + + end subroutine integrate_spectrum + +end module rad_solar_var diff --git a/src/physics/camrt/radae.F90 b/src/physics/camrt/radae.F90 new file mode 100644 index 0000000000..90e2998e16 --- /dev/null +++ b/src/physics/camrt/radae.F90 @@ -0,0 +1,4237 @@ +module radae +!------------------------------------------------------------------------------ +! +! Description: +! +! Data and subroutines to calculate absorptivities and emissivity needed +! for the LW radiation calculation. +! +! Public interfaces are: +! +! radae_init ------------ Initialization +! initialize_radbuffer -- Initialize the 3D abs/emis arrays. +! radabs ---------------- Compute absorptivities. +! radems ---------------- Compute emissivity. +! radtpl ---------------- Compute Temperatures and path lengths. +! radoz2 ---------------- Compute ozone path lengths. +! trcpth ---------------- Compute ghg path lengths. +! +! Author: B. Collins +! +!------------------------------------------------------------------------------ + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pverp, begchunk, endchunk, pver + use infnan, only: posinf, assignment(=) + use pmgrid, only: plev, plevp + use radconstants, only: nlwbands, idx_LW_0650_0800, idx_LW_0500_0650, & + idx_LW_1000_1200, idx_LW_0800_1000, idx_LW_1200_2000 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use wv_saturation, only: qsat_water + + implicit none + private + save + + public :: radabs, radems, radtpl, radae_init, radoz2, trcpth, initialize_radbuffer + + integer, public, parameter :: nbands = 2 ! Number of spectral bands + + ! Following data needed for restarts and in radclwmx + real(r8), public, allocatable, target :: abstot_3d(:,:,:,:) ! Non-adjacent layer absorptivites + real(r8), public, allocatable, target :: absnxt_3d(:,:,:,:) ! Nearest layer absorptivities + real(r8), public, allocatable, target :: emstot_3d(:,:,:) ! Total emissivity + integer, public :: ntoplw ! top level to solve for longwave cooling + + real(r8) :: p0 ! Standard pressure (dynes/cm**2) + real(r8) :: amd ! Molecular weight of dry air (g/mol) + real(r8) :: amco2 ! Molecular weight of co2 (g/mol) + real(r8) :: mwo3 ! Molecular weight of O3 (g/mol) + + real(r8) :: gravit ! acceleration due to gravity (m/s**2) + real(r8) :: gravit_cgs ! acceleration due to gravity (cm/s**2) + real(r8) :: rga ! 1./gravit_cgs + real(r8) :: epsilo ! Ratio of mol. wght of H2O to dry air + real(r8) :: omeps ! 1._r8 - epsilo + real(r8) :: sslp ! Standard sea-level pressure (dynes/cm**2) + real(r8) :: stebol_cgs ! Stefan-Boltzmann's constant (CGS) + real(r8) :: rgsslp ! 0.5/(gravit_cgs*sslp) + real(r8) :: dpfo3 ! Voigt correction factor for O3 + real(r8) :: dpfco2 ! Voigt correction factor for CO2 + + integer, parameter :: n_u = 25 ! Number of U in abs/emis tables + integer, parameter :: n_p = 10 ! Number of P in abs/emis tables + integer, parameter :: n_tp = 10 ! Number of T_p in abs/emis tables + integer, parameter :: n_te = 21 ! Number of T_e in abs/emis tables + integer, parameter :: n_rh = 7 ! Number of RH in abs/emis tables + + real(r8):: ah2onw(n_p, n_tp, n_u, n_te, n_rh) ! absorptivity (non-window) + real(r8):: eh2onw(n_p, n_tp, n_u, n_te, n_rh) ! emissivity (non-window) + real(r8):: ah2ow(n_p, n_tp, n_u, n_te, n_rh) ! absorptivity (window, for adjacent layers) + real(r8):: cn_ah2ow(n_p, n_tp, n_u, n_te, n_rh) ! continuum transmission for absorptivity (window) + real(r8):: cn_eh2ow(n_p, n_tp, n_u, n_te, n_rh) ! continuum transmission for emissivity (window) + real(r8):: ln_ah2ow(n_p, n_tp, n_u, n_te, n_rh) ! line-only transmission for absorptivity (window) + real(r8):: ln_eh2ow(n_p, n_tp, n_u, n_te, n_rh) ! line-only transmission for emissivity (window) +! +! Constant coefficients for water vapor overlap with trace gases. +! Reference: Ramanathan, V. and P.Downey, 1986: A Nonisothermal +! Emissivity and Absorptivity Formulation for Water Vapor +! Journal of Geophysical Research, vol. 91., D8, pp 8649-8666 +! + real(r8):: coefh(2,4) = reshape( & + (/ (/5.46557e+01_r8,-7.30387e-02_r8/), & + (/1.09311e+02_r8,-1.46077e-01_r8/), & + (/5.11479e+01_r8,-6.82615e-02_r8/), & + (/1.02296e+02_r8,-1.36523e-01_r8/) /), (/2,4/) ) +! + real(r8):: coefj(3,2) = reshape( & + (/ (/2.82096e-02_r8,2.47836e-04_r8,1.16904e-06_r8/), & + (/9.27379e-02_r8,8.04454e-04_r8,6.88844e-06_r8/) /), (/3,2/) ) +! + real(r8):: coefk(3,2) = reshape( & + (/ (/2.48852e-01_r8,2.09667e-03_r8,2.60377e-06_r8/) , & + (/1.03594e+00_r8,6.58620e-03_r8,4.04456e-06_r8/) /), (/3,2/) ) + real(r8):: c16,c17,c26,c27,c28,c29,c30,c31 +! +! Farwing correction constants for narrow-band emissivity model, +! introduced to account for the deficiencies in narrow-band model +! used to derive the emissivity; tuned with Arkings line-by-line +! calculations. Just used for water vapor overlap with trace gases. +! + real(r8):: fwcoef ! Farwing correction constant + real(r8):: fwc1,fwc2 ! Farwing correction constants + real(r8):: fc1 ! Farwing correction constant +! +! Collins/Hackney/Edwards (C/H/E) & Collins/Lee-Taylor/Edwards (C/LT/E) +! H2O parameterization +! +! Notation: +! U = integral (P/P_0 dW) eq. 15 in Ramanathan/Downey 1986 +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! +! absorptivity/emissivity in window are fit using an expression: +! +! a/e = f_a/e * {1.0 - ln_a/e * cn_a/e} +! +! absorptivity/emissivity in non-window are fit using: +! +! a/e = f_a/e * a/e_norm +! +! where +! a/e = absorptivity/emissivity +! a/e_norm = absorptivity/emissivity normalized to 1 +! f_a/e = value of a/e as U->infinity = f(T_e) only +! cn_a/e = continuum transmission +! ln_a/e = line transmission +! +! spectral interval: +! 1 = 0-800 cm^-1 and 1200-2200 cm^-1 (rotation and rotation-vibration) +! 2 = 800-1200 cm^-1 (window) +! + real(r8), parameter:: min_tp_h2o = 160.0_r8 ! min T_p for pre-calculated abs/emis + real(r8), parameter:: max_tp_h2o = 349.999999_r8 ! max T_p for pre-calculated abs/emis + integer, parameter :: ntemp = 192 ! Number of temperatures in H2O sat. table for Tp + integer, parameter :: o_fa = 6 ! Degree+1 of poly of T_e for absorptivity as U->inf. + integer, parameter :: o_fe = 6 ! Degree+1 of poly of T_e for emissivity as U->inf. +!----------------------------------------------------------------------------- +! Data for f in C/H/E fit -- value of A and E as U->infinity +! New C/LT/E fit (Hitran 2K, CKD 2.4) -- no change +! These values are determined by integrals of Planck functions or +! derivatives of Planck functions only. +!----------------------------------------------------------------------------- +! +! fa/fe coefficients for 2 bands (0-800 & 1200-2200, 800-1200 cm^-1) +! +! Coefficients of polynomial for f_a in T_e +! + real(r8), parameter:: fat(o_fa,nbands) = reshape( (/ & + (/-1.06665373E-01_r8, 2.90617375E-02_r8, -2.70642049E-04_r8, & ! 0-800&1200-2200 cm^-1 + 1.07595511E-06_r8, -1.97419681E-09_r8, 1.37763374E-12_r8/), & ! 0-800&1200-2200 cm^-1 + (/ 1.10666537E+00_r8, -2.90617375E-02_r8, 2.70642049E-04_r8, & ! 800-1200 cm^-1 + -1.07595511E-06_r8, 1.97419681E-09_r8, -1.37763374E-12_r8/) /) & ! 800-1200 cm^-1 + , (/o_fa,nbands/) ) +! +! Coefficients of polynomial for f_e in T_e +! + real(r8), parameter:: fet(o_fe,nbands) = reshape( (/ & + (/3.46148163E-01_r8, 1.51240299E-02_r8, -1.21846479E-04_r8, & ! 0-800&1200-2200 cm^-1 + 4.04970123E-07_r8, -6.15368936E-10_r8, 3.52415071E-13_r8/), & ! 0-800&1200-2200 cm^-1 + (/6.53851837E-01_r8, -1.51240299E-02_r8, 1.21846479E-04_r8, & ! 800-1200 cm^-1 + -4.04970123E-07_r8, 6.15368936E-10_r8, -3.52415071E-13_r8/) /) & ! 800-1200 cm^-1 + , (/o_fa,nbands/) ) +! +! Note: max values should be slightly underestimated to avoid index bound violations +! + real(r8), parameter:: min_lp_h2o = -3.0_r8 ! min log_10(P) for pre-calculated abs/emis + real(r8), parameter:: min_p_h2o = 1.0e-3_r8 ! min log_10(P) for pre-calculated abs/emis + real(r8), parameter:: max_lp_h2o = -0.0000001_r8 ! max log_10(P) for pre-calculated abs/emis + real(r8), parameter:: dlp_h2o = 0.3333333333333_r8 ! difference in adjacent elements of lp_h2o + + real(r8), parameter:: dtp_h2o = 21.111111111111_r8 ! difference in adjacent elements of tp_h2o + + real(r8), parameter:: min_rh_h2o = 0.0_r8 ! min RH for pre-calculated abs/emis + real(r8), parameter:: max_rh_h2o = 1.19999999_r8 ! max RH for pre-calculated abs/emis + real(r8), parameter:: drh_h2o = 0.2_r8 ! difference in adjacent elements of RH + + real(r8), parameter:: min_te_h2o = -120.0_r8 ! min T_e-T_p for pre-calculated abs/emis + real(r8), parameter:: max_te_h2o = 79.999999_r8 ! max T_e-T_p for pre-calculated abs/emis + real(r8), parameter:: dte_h2o = 10.0_r8 ! difference in adjacent elements of te_h2o + + real(r8), parameter:: min_lu_h2o = -8.0_r8 ! min log_10(U) for pre-calculated abs/emis + real(r8), parameter:: min_u_h2o = 1.0e-8_r8 ! min pressure-weighted path-length + real(r8), parameter:: max_lu_h2o = 3.9999999_r8 ! max log_10(U) for pre-calculated abs/emis + real(r8), parameter:: dlu_h2o = 0.5_r8 ! difference in adjacent elements of lu_h2o + + real(r8), parameter:: g1(6)=(/0.0468556_r8,0.0397454_r8,0.0407664_r8,0.0304380_r8,0.0540398_r8,0.0321962_r8/) + real(r8), parameter :: g2(6)=(/14.4832_r8,4.30242_r8,5.23523_r8,3.25342_r8,0.698935_r8,16.5599_r8/) + real(r8), parameter :: g3(6)=(/26.1898_r8,18.4476_r8,15.3633_r8,12.1927_r8,9.14992_r8,8.07092_r8/) + real(r8), parameter :: g4(6)=(/0.0261782_r8,0.0369516_r8,0.0307266_r8,0.0243854_r8,0.0182932_r8,0.0161418_r8/) + real(r8), parameter :: ab(6)=(/3.0857e-2_r8,2.3524e-2_r8,1.7310e-2_r8,2.6661e-2_r8,2.8074e-2_r8,2.2915e-2_r8/) + real(r8), parameter :: bb(6)=(/-1.3512e-4_r8,-6.8320e-5_r8,-3.2609e-5_r8,-1.0228e-5_r8,-9.5743e-5_r8,-1.0304e-4_r8/) + real(r8), parameter :: abp(6)=(/2.9129e-2_r8,2.4101e-2_r8,1.9821e-2_r8,2.6904e-2_r8,2.9458e-2_r8,1.9892e-2_r8/) + real(r8), parameter :: bbp(6)=(/-1.3139e-4_r8,-5.5688e-5_r8,-4.6380e-5_r8,-8.0362e-5_r8,-1.0115e-4_r8,-8.8061e-5_r8/) + + +! Public Interfaces +!==================================================================================== +CONTAINS +!==================================================================================== + +subroutine radabs(lchnk ,ncol , & + pbr ,pnm ,co2em ,co2eml ,tplnka , & + s2c ,tcg ,w ,h2otr ,plco2 , & + plh2o ,co2t ,tint ,tlayr ,plol , & + plos ,pmln ,piln ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,uch4 ,uco211 ,uco212 , & + uco213 ,uco221 ,uco222 ,uco223 ,uptype , & + bn2o0 ,bn2o1 ,bch4 ,abplnk1 ,abplnk2 , & + abstot ,absnxt ,plh2ob ,wb , & + odap_aer ,aer_trn_ttl, co2mmr) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute absorptivities for h2o, co2, o3, ch4, n2o, cfc11 and cfc12 +! +! Method: +! h2o .... Uses nonisothermal emissivity method for water vapor from +! Ramanathan, V. and P.Downey, 1986: A Nonisothermal +! Emissivity and Absorptivity Formulation for Water Vapor +! Journal of Geophysical Research, vol. 91., D8, pp 8649-8666 +! +! Implementation updated by Collins, Hackney, and Edwards (2001) +! using line-by-line calculations based upon Hitran 1996 and +! CKD 2.1 for absorptivity and emissivity +! +! Implementation updated by Collins, Lee-Taylor, and Edwards (2003) +! using line-by-line calculations based upon Hitran 2000 and +! CKD 2.4 for absorptivity and emissivity +! +! co2 .... Uses absorptance parameterization of the 15 micro-meter +! (500 - 800 cm-1) band system of Carbon Dioxide, from +! Kiehl, J.T. and B.P.Briegleb, 1991: A New Parameterization +! of the Absorptance Due to the 15 micro-meter Band System +! of Carbon Dioxide Jouranl of Geophysical Research, +! vol. 96., D5, pp 9013-9019. +! Parameterizations for the 9.4 and 10.4 mircon bands of CO2 +! are also included. +! +! o3 .... Uses absorptance parameterization of the 9.6 micro-meter +! band system of ozone, from Ramanathan, V. and R.Dickinson, +! 1979: The Role of stratospheric ozone in the zonal and +! seasonal radiative energy balance of the earth-troposphere +! system. Journal of the Atmospheric Sciences, Vol. 36, +! pp 1084-1104 +! +! ch4 .... Uses a broad band model for the 7.7 micron band of methane. +! +! n20 .... Uses a broad band model for the 7.8, 8.6 and 17.0 micron +! bands of nitrous oxide +! +! cfc11 ... Uses a quasi-linear model for the 9.2, 10.7, 11.8 and 12.5 +! micron bands of CFC11 +! +! cfc12 ... Uses a quasi-linear model for the 8.6, 9.1, 10.8 and 11.2 +! micron bands of CFC12 +! +! +! Computes individual absorptivities for non-adjacent layers, accounting +! for band overlap, and sums to obtain the total; then, computes the +! nearest layer contribution. +! +! Author: W. Collins (H2O absorptivity) and J. Kiehl +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: pbr(pcols,pver) ! Prssr at mid-levels (dynes/cm2) + real(r8), intent(in) :: pnm(pcols,pverp) ! Prssr at interfaces (dynes/cm2) + real(r8), intent(in) :: co2em(pcols,pverp) ! Co2 emissivity function + real(r8), intent(in) :: co2eml(pcols,pver) ! Co2 emissivity function + real(r8), intent(in) :: tplnka(pcols,pverp) ! Planck fnctn level temperature + real(r8), intent(in) :: s2c(pcols,pverp) ! H2o continuum path length + real(r8), intent(in) :: tcg(pcols,pverp) ! H2o-mass-wgted temp. (Curtis-Godson approx.) + real(r8), intent(in) :: w(pcols,pverp) ! H2o prs wghted path + real(r8), intent(in) :: h2otr(pcols,pverp) ! H2o trnsmssn fnct for o3 overlap + real(r8), intent(in) :: plco2(pcols,pverp) ! Co2 prs wghted path length + real(r8), intent(in) :: plh2o(pcols,pverp) ! H2o prs wfhted path length + real(r8), intent(in) :: co2t(pcols,pverp) ! Tmp and prs wghted path length + real(r8), intent(in) :: tint(pcols,pverp) ! Interface temperatures + real(r8), intent(in) :: tlayr(pcols,pverp) ! K-1 level temperatures + real(r8), intent(in) :: plol(pcols,pverp) ! Ozone prs wghted path length + real(r8), intent(in) :: plos(pcols,pverp) ! Ozone path length + real(r8), intent(in) :: pmln(pcols,pver) ! Ln(pmidm1) + real(r8), intent(in) :: piln(pcols,pverp) ! Ln(pintm1) + real(r8), intent(in) :: plh2ob(nbands,pcols,pverp) ! Pressure weighted h2o path with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + real(r8), intent(in) :: wb(nbands,pcols,pverp) ! H2o path length with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + +! [fraction] absorbtion optical depth, cumulative from top + real(r8), intent(in) :: odap_aer(pcols,pver,nlwbands) + +! [fraction] Total transmission between interfaces k1 and k2 + real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) + +! +! Trace gas variables +! + real(r8), intent(in) :: co2mmr(pcols) ! co2 column mean mass mixing ratio + real(r8), intent(in) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(in) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(in) :: un2o0(pcols,pverp) ! N2O path length + real(r8), intent(in) :: un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8), intent(in) :: uch4(pcols,pverp) ! CH4 path length + real(r8), intent(in) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uptype(pcols,pverp) ! continuum path length + real(r8), intent(in) :: bn2o0(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bn2o1(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bch4(pcols,pverp) ! pressure factor for ch4 + real(r8), intent(in) :: abplnk1(14,pcols,pverp) ! non-nearest layer Planck factor + real(r8), intent(in) :: abplnk2(14,pcols,pverp) ! nearest layer factor +! +! Output arguments +! + real(r8), intent(out) :: abstot(pcols,ntoplw:pverp,ntoplw:pverp) ! Total absorptivity + real(r8), intent(out) :: absnxt(pcols,pver,4) ! Total nearest layer absorptivity +! +!---------------------------Local variables----------------------------- +! + integer i ! Longitude index + integer k ! Level index + integer k1 ! Level index + integer k2 ! Level index + integer kn ! Nearest level index + integer wvl ! Wavelength index + + real(r8) abstrc(pcols) ! total trace gas absorptivity + real(r8) bplnk(14,pcols,4) ! Planck functions for sub-divided layers + real(r8) pnew(pcols) ! Effective pressure for H2O vapor linewidth + real(r8) pnewb(nbands) ! Effective pressure for h2o linewidth w/ + ! Hulst-Curtis-Godson correction for + ! each band + real(r8) u(pcols) ! Pressure weighted H2O path length + real(r8) ub(nbands) ! Pressure weighted H2O path length with + ! Hulst-Curtis-Godson correction for + ! each band + real(r8) tbar(pcols,4) ! Mean layer temperature + real(r8) emm(pcols,4) ! Mean co2 emissivity + real(r8) o3emm(pcols,4) ! Mean o3 emissivity + real(r8) o3bndi ! Ozone band parameter + real(r8) temh2o(pcols,4) ! Mean layer temperature equivalent to tbar + real(r8) k21 ! Exponential coefficient used to calculate +! ! rotation band transmissvty in the 650-800 +! ! cm-1 region (tr1) + real(r8) k22 ! Exponential coefficient used to calculate +! ! rotation band transmissvty in the 500-650 +! ! cm-1 region (tr2) + real(r8) uc1(pcols) ! H2o continuum pathlength in 500-800 cm-1 + real(r8) to3h2o(pcols) ! H2o trnsmsn for overlap with o3 + real(r8) pi ! For co2 absorptivity computation + real(r8) sqti(pcols) ! Used to store sqrt of mean temperature + real(r8) et ! Co2 hot band factor + real(r8) et2 ! Co2 hot band factor squared + real(r8) et4 ! Co2 hot band factor to fourth power + real(r8) omet ! Co2 stimulated emission term + real(r8) f1co2 ! Co2 central band factor + real(r8) f2co2(pcols) ! Co2 weak band factor + real(r8) f3co2(pcols) ! Co2 weak band factor + real(r8) t1co2(pcols) ! Overlap factr weak bands on strong band + real(r8) sqwp ! Sqrt of co2 pathlength + real(r8) f1sqwp(pcols) ! Main co2 band factor + real(r8) oneme ! Co2 stimulated emission term + real(r8) alphat ! Part of the co2 stimulated emission term + real(r8) co2vmr(pcols) ! CO2 column mean vmr + real(r8) rmw ! ratio of molecular weights (air/co2) + real(r8) wco2 ! Constants used to define co2 pathlength + real(r8) posqt ! Effective pressure for co2 line width + real(r8) u7(pcols) ! Co2 hot band path length + real(r8) u8 ! Co2 hot band path length + real(r8) u9 ! Co2 hot band path length + real(r8) u13 ! Co2 hot band path length + real(r8) rbeta7(pcols) ! Inverse of co2 hot band line width par + real(r8) rbeta8 ! Inverse of co2 hot band line width par + real(r8) rbeta9 ! Inverse of co2 hot band line width par + real(r8) rbeta13 ! Inverse of co2 hot band line width par + real(r8) tpatha ! For absorptivity computation + real(r8) abso(pcols,4) ! Absorptivity for various gases/bands + real(r8) dtx(pcols) ! Planck temperature minus 250 K + real(r8) dty(pcols) ! Path temperature minus 250 K + real(r8) term7(pcols,2) ! Kl_inf(i) in eq(r8) of table A3a of R&D + real(r8) term8(pcols,2) ! Delta kl_inf(i) in eq(r8) + real(r8) tr1 ! Eqn(6) in table A2 of R&D for 650-800 + real(r8) tr10(pcols) ! Eqn (6) times eq(4) in table A2 +! ! of R&D for 500-650 cm-1 region + real(r8) tr2 ! Eqn(6) in table A2 of R&D for 500-650 + real(r8) tr5 ! Eqn(4) in table A2 of R&D for 650-800 + real(r8) tr6 ! Eqn(4) in table A2 of R&D for 500-650 + real(r8) tr9(pcols) ! Equation (6) times eq(4) in table A2 +! ! of R&D for 650-800 cm-1 region + real(r8) sqrtu(pcols) ! Sqrt of pressure weighted h20 pathlength + real(r8) fwk(pcols) ! Equation(33) in R&D far wing correction + real(r8) fwku(pcols) ! GU term in eqs(1) and (6) in table A2 + real(r8) to3co2(pcols) ! P weighted temp in ozone band model + real(r8) dpnm(pcols) ! Pressure difference between two levels + real(r8) pnmsq(pcols,pverp) ! Pressure squared + real(r8) dw(pcols) ! Amount of h2o between two levels + real(r8) uinpl(pcols,4) ! Nearest layer subdivision factor + real(r8) winpl(pcols,4) ! Nearest layer subdivision factor + real(r8) zinpl(pcols,4) ! Nearest layer subdivision factor + real(r8) pinpl(pcols,4) ! Nearest layer subdivision factor + real(r8) dplh2o(pcols) ! Difference in press weighted h2o amount + real(r8) r293 ! 1/293 + real(r8) r250 ! 1/250 + real(r8) r3205 ! Line width factor for o3 (see R&Di) + real(r8) r300 ! 1/300 + real(r8) rsslp ! Reciprocal of sea level pressure + real(r8) r2sslp ! 1/2 of rsslp + real(r8) ds2c ! Y in eq(7) in table A2 of R&D + real(r8) dplos ! Ozone pathlength eq(A2) in R&Di + real(r8) dplol ! Presure weighted ozone pathlength + real(r8) tlocal ! Local interface temperature + real(r8) beta ! Ozone mean line parameter eq(A3) in R&Di +! (includes Voigt line correction factor) + real(r8) rphat ! Effective pressure for ozone beta + real(r8) tcrfac ! Ozone temperature factor table 1 R&Di + real(r8) tmp1 ! Ozone band factor see eq(A1) in R&Di + real(r8) u1 ! Effective ozone pathlength eq(A2) in R&Di + real(r8) realnu ! 1/beta factor in ozone band model eq(A1) + real(r8) tmp2 ! Ozone band factor see eq(A1) in R&Di + real(r8) u2 ! Effective ozone pathlength eq(A2) in R&Di + real(r8) rsqti ! Reciprocal of sqrt of path temperature + real(r8) tpath ! Path temperature used in co2 band model + real(r8) tmp3 ! Weak band factor see K&B + real(r8) rdpnmsq ! Reciprocal of difference in press^2 + real(r8) rdpnm ! Reciprocal of difference in press + real(r8) p1 ! Mean pressure factor + real(r8) p2 ! Mean pressure factor + real(r8) dtym10 ! T - 260 used in eq(9) and (10) table A3a + real(r8) dplco2 ! Co2 path length + real(r8) te ! A_0 T factor in ozone model table 1 of R&Di + real(r8) denom ! Denominator in eq(r8) of table A3a of R&D + real(r8) th2o(pcols) ! transmission due to H2O + real(r8) tco2(pcols) ! transmission due to CO2 + real(r8) to3(pcols) ! transmission due to O3 +! +! Transmission terms for various spectral intervals: +! + real(r8) trab2(pcols) ! H2o 500 - 800 cm-1 + real(r8) absbnd ! Proportional to co2 band absorptance + real(r8) dbvtit(pcols,pverp)! Intrfc drvtv plnck fnctn for o3 + real(r8) dbvtly(pcols,pver) ! Level drvtv plnck fnctn for o3 +! +! Variables for Collins/Hackney/Edwards (C/H/E) & +! Collins/Lee-Taylor/Edwards (C/LT/E) H2O parameterization + +! +! Notation: +! U = integral (P/P_0 dW) eq. 15 in Ramanathan/Downey 1986 +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! + real(r8) fa ! asymptotic value of abs. as U->infinity + real(r8) a_star ! normalized absorptivity for non-window + real(r8) l_star ! interpolated line transmission + real(r8) c_star ! interpolated continuum transmission + + real(r8) te1 ! emission temperature + real(r8) te2 ! te^2 + real(r8) te3 ! te^3 + real(r8) te4 ! te^4 + real(r8) te5 ! te^5 + + real(r8) log_u ! log base 10 of U + real(r8) log_uc ! log base 10 of H2O continuum path + real(r8) log_p ! log base 10 of P + real(r8) t_p ! T_p + real(r8) t_e ! T_e (offset by T_p) + + integer iu ! index for log10(U) + integer iu1 ! iu + 1 + integer iuc ! index for log10(H2O continuum path) + integer iuc1 ! iuc + 1 + integer ip ! index for log10(P) + integer ip1 ! ip + 1 + integer itp ! index for T_p + integer itp1 ! itp + 1 + integer ite ! index for T_e + integer ite1 ! ite + 1 + integer irh ! index for RH + integer irh1 ! irh + 1 + + real(r8) dvar ! normalized variation in T_p/T_e/P/U + real(r8) uvar ! U * diffusivity factor + real(r8) uscl ! factor for lineary scaling as U->0 + + real(r8) wu ! weight for U + real(r8) wu1 ! 1 - wu + real(r8) wuc ! weight for H2O continuum path + real(r8) wuc1 ! 1 - wuc + real(r8) wp ! weight for P + real(r8) wp1 ! 1 - wp + real(r8) wtp ! weight for T_p + real(r8) wtp1 ! 1 - wtp + real(r8) wte ! weight for T_e + real(r8) wte1 ! 1 - wte + real(r8) wrh ! weight for RH + real(r8) wrh1 ! 1 - wrh + + real(r8) w_0_0_ ! weight for Tp/Te combination + real(r8) w_0_1_ ! weight for Tp/Te combination + real(r8) w_1_0_ ! weight for Tp/Te combination + real(r8) w_1_1_ ! weight for Tp/Te combination + + real(r8) w_0_00 ! weight for Tp/Te/RH combination + real(r8) w_0_01 ! weight for Tp/Te/RH combination + real(r8) w_0_10 ! weight for Tp/Te/RH combination + real(r8) w_0_11 ! weight for Tp/Te/RH combination + real(r8) w_1_00 ! weight for Tp/Te/RH combination + real(r8) w_1_01 ! weight for Tp/Te/RH combination + real(r8) w_1_10 ! weight for Tp/Te/RH combination + real(r8) w_1_11 ! weight for Tp/Te/RH combination + + real(r8) w00_00 ! weight for P/Tp/Te/RH combination + real(r8) w00_01 ! weight for P/Tp/Te/RH combination + real(r8) w00_10 ! weight for P/Tp/Te/RH combination + real(r8) w00_11 ! weight for P/Tp/Te/RH combination + real(r8) w01_00 ! weight for P/Tp/Te/RH combination + real(r8) w01_01 ! weight for P/Tp/Te/RH combination + real(r8) w01_10 ! weight for P/Tp/Te/RH combination + real(r8) w01_11 ! weight for P/Tp/Te/RH combination + real(r8) w10_00 ! weight for P/Tp/Te/RH combination + real(r8) w10_01 ! weight for P/Tp/Te/RH combination + real(r8) w10_10 ! weight for P/Tp/Te/RH combination + real(r8) w10_11 ! weight for P/Tp/Te/RH combination + real(r8) w11_00 ! weight for P/Tp/Te/RH combination + real(r8) w11_01 ! weight for P/Tp/Te/RH combination + real(r8) w11_10 ! weight for P/Tp/Te/RH combination + real(r8) w11_11 ! weight for P/Tp/Te/RH combination + + integer ib ! spectral interval: + ! 1 = 0-800 cm^-1 and 1200-2200 cm^-1 + ! 2 = 800-1200 cm^-1 + + + real(r8) pch2o ! H2O continuum path + real(r8) fch2o ! temp. factor for continuum + real(r8) uch2o ! U corresponding to H2O cont. path (window) + + real(r8) fdif ! secant(zenith angle) for diffusivity approx. + + real(r8) sslp_mks ! Sea-level pressure in MKS units + real(r8) esx ! saturation vapor pressure returned by qsat + real(r8) qsx ! saturation mixing ratio returned by qsat + real(r8) pnew_mks ! pnew in MKS units + real(r8) q_path ! effective specific humidity along path + real(r8) rh_path ! effective relative humidity along path + + integer bnd_idx ! LW band index + real(r8) aer_pth_dlt ! [kg m-2] STRAER path between interface levels k1 and k2 + real(r8) aer_pth_ngh(pcols) + ! [kg m-2] STRAER path between neighboring layers + real(r8) odap_aer_ttl ! [fraction] Total path absorption optical depth + real(r8) aer_trn_ngh(pcols,nlwbands) + ! [fraction] Total transmission between + ! nearest neighbor sub-levels +! +!--------------------------Statement function--------------------------- +! + real(r8) dbvt,t ! Planck fnctn tmp derivative for o3 +! + dbvt(t)=(-2.8911366682e-4_r8+(2.3771251896e-6_r8+1.1305188929e-10_r8*t)*t)/ & + (1.0_r8+(-6.1364820707e-3_r8+1.5550319767e-5_r8*t)*t) +! +! +!----------------------------------------------------------------------- +! +! Initialize +! + do k2=1,4 + do k1=1,ntoplw-1 + absnxt(:,k1,k2) = posinf ! set unused portions for lf95 restart write + end do + end do + + do k=ntoplw,pverp + abstot(:,k,k) = posinf ! set unused portions for lf95 restart write + end do + + do k=ntoplw,pver + do i=1,ncol + dbvtly(i,k) = dbvt(tlayr(i,k+1)) + dbvtit(i,k) = dbvt(tint(i,k)) + end do + end do + rmw = amd/amco2 + do i=1,ncol + dbvtit(i,pverp) = dbvt(tint(i,pverp)) + co2vmr(i) = co2mmr(i) * rmw + end do +! + r293 = 1._r8/293._r8 + r250 = 1._r8/250._r8 + r3205 = 1._r8/.3205_r8 + r300 = 1._r8/300._r8 + rsslp = 1._r8/sslp + r2sslp = 1._r8/(2._r8*sslp) +! +!Constants for computing U corresponding to H2O cont. path +! + fdif = 1.66_r8 + sslp_mks = sslp / 10.0_r8 +! +! Non-adjacent layer absorptivity: +! +! abso(i,1) 0 - 800 cm-1 h2o rotation band +! abso(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! abso(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O absorptivity +! +! 500-800 cm^-1 H2o continuum/line overlap already included +! in abso(i,1). This used to be in abso(i,4) +! +! abso(i,3) o3 9.6 micrometer band (nu3 and nu1 bands) +! abso(i,4) co2 15 micrometer band system +! + do k=ntoplw,pverp + do i=1,ncol + pnmsq(i,k) = pnm(i,k)**2 + dtx(i) = tplnka(i,k) - 250._r8 + end do + end do +! +! Non-nearest layer level loops +! + do k1=pverp,ntoplw,-1 + do k2=pverp,ntoplw,-1 + if (k1 == k2) cycle + do i=1,ncol + dplh2o(i) = plh2o(i,k1) - plh2o(i,k2) + u(i) = abs(dplh2o(i)) + sqrtu(i) = sqrt(u(i)) + ds2c = abs(s2c(i,k1) - s2c(i,k2)) + dw(i) = abs(w(i,k1) - w(i,k2)) + uc1(i) = (ds2c + 1.7e-3_r8*u(i))*(1._r8 + 2._r8*ds2c)/(1._r8 + 15._r8*ds2c) + pch2o = ds2c + pnew(i) = u(i)/dw(i) + pnew_mks = pnew(i) * sslp_mks +! +! Changed effective path temperature to std. Curtis-Godson form +! + tpatha = abs(tcg(i,k1) - tcg(i,k2))/dw(i) + t_p = min(max(tpatha, min_tp_h2o), max_tp_h2o) + + call qsat_water(t_p, pnew_mks, esx, qsx) +! +! Compute effective RH along path +! + q_path = dw(i) / abs(pnm(i,k1) - pnm(i,k2)) / rga +! +! Calculate effective u, pnew for each band using +! Hulst-Curtis-Godson approximation: +! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, +! 2nd edition, Oxford University Press, 1989. +! Effective H2O path (w) +! eq. 6.24, p. 228 +! Effective H2O path pressure (pnew = u/w): +! eq. 6.29, p. 228 +! + ub(1) = abs(plh2ob(1,i,k1) - plh2ob(1,i,k2)) / psi(t_p,1) + ub(2) = abs(plh2ob(2,i,k1) - plh2ob(2,i,k2)) / psi(t_p,2) + + pnewb(1) = ub(1) / abs(wb(1,i,k1) - wb(1,i,k2)) * phi(t_p,1) + pnewb(2) = ub(2) / abs(wb(2,i,k1) - wb(2,i,k2)) * phi(t_p,2) + + dtx(i) = tplnka(i,k2) - 250._r8 + dty(i) = tpatha - 250._r8 + + fwk(i) = fwcoef + fwc1/(1._r8 + fwc2*u(i)) + fwku(i) = fwk(i)*u(i) +! +! Define variables for C/H/E (now C/LT/E) fit +! +! abso(i,1) 0 - 800 cm-1 h2o rotation band +! abso(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! abso(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O absorptivity +! +! Notation: +! U = integral (P/P_0 dW) +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! +! +! Terms for asymptotic value of emissivity +! + te1 = tplnka(i,k2) + te2 = te1 * te1 + te3 = te2 * te1 + te4 = te3 * te1 + te5 = te4 * te1 + +! +! Band-independent indices for lines and continuum tables +! + dvar = (t_p - min_tp_h2o) / dtp_h2o + itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1) + itp1 = itp + 1 + wtp = dvar - floor(dvar) + wtp1 = 1.0_r8 - wtp + + t_e = min(max(tplnka(i,k2)-t_p, min_te_h2o), max_te_h2o) + dvar = (t_e - min_te_h2o) / dte_h2o + ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1) + ite1 = ite + 1 + wte = dvar - floor(dvar) + wte1 = 1.0_r8 - wte + + rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o) + dvar = (rh_path - min_rh_h2o) / drh_h2o + irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1) + irh1 = irh + 1 + wrh = dvar - floor(dvar) + wrh1 = 1.0_r8 - wrh + + w_0_0_ = wtp * wte + w_0_1_ = wtp * wte1 + w_1_0_ = wtp1 * wte + w_1_1_ = wtp1 * wte1 + + w_0_00 = w_0_0_ * wrh + w_0_01 = w_0_0_ * wrh1 + w_0_10 = w_0_1_ * wrh + w_0_11 = w_0_1_ * wrh1 + w_1_00 = w_1_0_ * wrh + w_1_01 = w_1_0_ * wrh1 + w_1_10 = w_1_1_ * wrh + w_1_11 = w_1_1_ * wrh1 + +! +! H2O Continuum path for 0-800 and 1200-2200 cm^-1 +! +! Assume foreign continuum dominates total H2O continuum in these bands +! per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776 +! Then the effective H2O path is just +! U_c = integral[ f(P) dW ] +! where +! W = water-vapor mass and +! f(P) = dependence of foreign continuum on pressure +! = P / sslp +! Then +! U_c = U (the same effective H2O path as for lines) +! +! +! Continuum terms for 800-1200 cm^-1 +! +! Assume self continuum dominates total H2O continuum for this band +! per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776 +! Then the effective H2O self-continuum path is +! U_c = integral[ h(e,T) dW ] (*eq. 1*) +! where +! W = water-vapor mass and +! e = partial pressure of H2O along path +! T = temperature along path +! h(e,T) = dependence of foreign continuum on e,T +! = e / sslp * f(T) +! +! Replacing +! e =~ q * P / epsilo +! q = mixing ratio of H2O +! epsilo = 0.622 +! +! and using the definition +! U = integral [ (P / sslp) dW ] +! = (P / sslp) W (homogeneous path) +! +! the effective path length for the self continuum is +! U_c = (q / epsilo) f(T) U (*eq. 2*) +! +! Once values of T, U, and q have been calculated for the inhomogeneous +! path, this sets U_c for the corresponding +! homogeneous atmosphere. However, this need not equal the +! value of U_c' defined by eq. 1 for the actual inhomogeneous atmosphere +! under consideration. +! +! Solution: hold T and q constant, solve for U' that gives U_c' by +! inverting eq. (2): +! +! U' = (U_c * epsilo) / (q * f(T)) +! + fch2o = fh2oself(t_p) + uch2o = (pch2o * epsilo) / (q_path * fch2o) + +! +! Band-dependent indices for non-window +! + ib = 1 + + uvar = ub(ib) * fdif + log_u = min(log10(max(uvar, min_u_h2o)), max_lu_h2o) + dvar = (log_u - min_lu_h2o) / dlu_h2o + iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iu1 = iu + 1 + wu = dvar - floor(dvar) + wu1 = 1.0_r8 - wu + + log_p = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o) + dvar = (log_p - min_lp_h2o) / dlp_h2o + ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1) + ip1 = ip + 1 + wp = dvar - floor(dvar) + wp1 = 1.0_r8 - wp + + w00_00 = wp * w_0_00 + w00_01 = wp * w_0_01 + w00_10 = wp * w_0_10 + w00_11 = wp * w_0_11 + w01_00 = wp * w_1_00 + w01_01 = wp * w_1_01 + w01_10 = wp * w_1_10 + w01_11 = wp * w_1_11 + w10_00 = wp1 * w_0_00 + w10_01 = wp1 * w_0_01 + w10_10 = wp1 * w_0_10 + w10_11 = wp1 * w_0_11 + w11_00 = wp1 * w_1_00 + w11_01 = wp1 * w_1_01 + w11_10 = wp1 * w_1_10 + w11_11 = wp1 * w_1_11 +! +! Asymptotic value of absorptivity as U->infinity +! + fa = fat(1,ib) + & + fat(2,ib) * te1 + & + fat(3,ib) * te2 + & + fat(4,ib) * te3 + & + fat(5,ib) * te4 + & + fat(6,ib) * te5 + + a_star = & + ah2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + ah2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + ah2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + ah2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + ah2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + ah2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + ah2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + ah2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + ah2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + ah2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + ah2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + ah2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + ah2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + ah2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + ah2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + ah2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + ah2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + ah2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + ah2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + ah2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + ah2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + ah2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + ah2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + ah2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + ah2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + ah2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + ah2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + ah2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + ah2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + ah2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + ah2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + ah2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + abso(i,ib) = min(max(fa * (1.0_r8 - (1.0_r8 - a_star) * & + aer_trn_ttl(i,k1,k2,ib)), & + 0.0_r8), 1.0_r8) +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + abso(i,ib) = abso(i,ib) * uscl + endif + +! +! Band-dependent indices for window +! + ib = 2 + + uvar = ub(ib) * fdif + log_u = min(log10(max(uvar, min_u_h2o)), max_lu_h2o) + dvar = (log_u - min_lu_h2o) / dlu_h2o + iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iu1 = iu + 1 + wu = dvar - floor(dvar) + wu1 = 1.0_r8 - wu + + log_p = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o) + dvar = (log_p - min_lp_h2o) / dlp_h2o + ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1) + ip1 = ip + 1 + wp = dvar - floor(dvar) + wp1 = 1.0_r8 - wp + + w00_00 = wp * w_0_00 + w00_01 = wp * w_0_01 + w00_10 = wp * w_0_10 + w00_11 = wp * w_0_11 + w01_00 = wp * w_1_00 + w01_01 = wp * w_1_01 + w01_10 = wp * w_1_10 + w01_11 = wp * w_1_11 + w10_00 = wp1 * w_0_00 + w10_01 = wp1 * w_0_01 + w10_10 = wp1 * w_0_10 + w10_11 = wp1 * w_0_11 + w11_00 = wp1 * w_1_00 + w11_01 = wp1 * w_1_01 + w11_10 = wp1 * w_1_10 + w11_11 = wp1 * w_1_11 + + log_uc = min(log10(max(uch2o * fdif, min_u_h2o)), max_lu_h2o) + dvar = (log_uc - min_lu_h2o) / dlu_h2o + iuc = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iuc1 = iuc + 1 + wuc = dvar - floor(dvar) + wuc1 = 1.0_r8 - wuc +! +! Asymptotic value of absorptivity as U->infinity +! + fa = fat(1,ib) + & + fat(2,ib) * te1 + & + fat(3,ib) * te2 + & + fat(4,ib) * te3 + & + fat(5,ib) * te4 + & + fat(6,ib) * te5 + + l_star = & + ln_ah2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + ln_ah2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + ln_ah2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + ln_ah2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + ln_ah2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + ln_ah2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + ln_ah2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + ln_ah2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + ln_ah2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + ln_ah2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + ln_ah2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + ln_ah2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + ln_ah2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + ln_ah2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + ln_ah2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + ln_ah2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + ln_ah2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + ln_ah2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + ln_ah2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + ln_ah2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + ln_ah2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + ln_ah2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + ln_ah2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + ln_ah2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + ln_ah2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + ln_ah2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + ln_ah2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + ln_ah2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + ln_ah2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + ln_ah2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + ln_ah2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + ln_ah2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + + c_star = & + cn_ah2ow(ip , itp , iuc , ite , irh ) * w11_11 * wuc1 + & + cn_ah2ow(ip , itp , iuc , ite , irh1) * w11_10 * wuc1 + & + cn_ah2ow(ip , itp , iuc , ite1, irh ) * w11_01 * wuc1 + & + cn_ah2ow(ip , itp , iuc , ite1, irh1) * w11_00 * wuc1 + & + cn_ah2ow(ip , itp , iuc1, ite , irh ) * w11_11 * wuc + & + cn_ah2ow(ip , itp , iuc1, ite , irh1) * w11_10 * wuc + & + cn_ah2ow(ip , itp , iuc1, ite1, irh ) * w11_01 * wuc + & + cn_ah2ow(ip , itp , iuc1, ite1, irh1) * w11_00 * wuc + & + cn_ah2ow(ip , itp1, iuc , ite , irh ) * w10_11 * wuc1 + & + cn_ah2ow(ip , itp1, iuc , ite , irh1) * w10_10 * wuc1 + & + cn_ah2ow(ip , itp1, iuc , ite1, irh ) * w10_01 * wuc1 + & + cn_ah2ow(ip , itp1, iuc , ite1, irh1) * w10_00 * wuc1 + & + cn_ah2ow(ip , itp1, iuc1, ite , irh ) * w10_11 * wuc + & + cn_ah2ow(ip , itp1, iuc1, ite , irh1) * w10_10 * wuc + & + cn_ah2ow(ip , itp1, iuc1, ite1, irh ) * w10_01 * wuc + & + cn_ah2ow(ip , itp1, iuc1, ite1, irh1) * w10_00 * wuc + & + cn_ah2ow(ip1, itp , iuc , ite , irh ) * w01_11 * wuc1 + & + cn_ah2ow(ip1, itp , iuc , ite , irh1) * w01_10 * wuc1 + & + cn_ah2ow(ip1, itp , iuc , ite1, irh ) * w01_01 * wuc1 + & + cn_ah2ow(ip1, itp , iuc , ite1, irh1) * w01_00 * wuc1 + & + cn_ah2ow(ip1, itp , iuc1, ite , irh ) * w01_11 * wuc + & + cn_ah2ow(ip1, itp , iuc1, ite , irh1) * w01_10 * wuc + & + cn_ah2ow(ip1, itp , iuc1, ite1, irh ) * w01_01 * wuc + & + cn_ah2ow(ip1, itp , iuc1, ite1, irh1) * w01_00 * wuc + & + cn_ah2ow(ip1, itp1, iuc , ite , irh ) * w00_11 * wuc1 + & + cn_ah2ow(ip1, itp1, iuc , ite , irh1) * w00_10 * wuc1 + & + cn_ah2ow(ip1, itp1, iuc , ite1, irh ) * w00_01 * wuc1 + & + cn_ah2ow(ip1, itp1, iuc , ite1, irh1) * w00_00 * wuc1 + & + cn_ah2ow(ip1, itp1, iuc1, ite , irh ) * w00_11 * wuc + & + cn_ah2ow(ip1, itp1, iuc1, ite , irh1) * w00_10 * wuc + & + cn_ah2ow(ip1, itp1, iuc1, ite1, irh ) * w00_01 * wuc + & + cn_ah2ow(ip1, itp1, iuc1, ite1, irh1) * w00_00 * wuc + abso(i,ib) = min(max(fa * (1.0_r8 - l_star * c_star * & + aer_trn_ttl(i,k1,k2,ib)), & + 0.0_r8), 1.0_r8) +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + abso(i,ib) = abso(i,ib) * uscl + endif + + end do +! +! Line transmission in 800-1000 and 1000-1200 cm-1 intervals +! + do i=1,ncol + term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1._r8 + c16*dty(i)) + term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1._r8 + c17*dty(i)) + term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1._r8 + c26*dty(i)) + term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1._r8 + c27*dty(i)) + end do +! +! 500 - 800 cm-1 h2o rotation band overlap with co2 +! + do i=1,ncol + k21 = term7(i,1) + term8(i,1)/ & + (1._r8 + (c30 + c31*(dty(i)-10._r8)*(dty(i)-10._r8))*sqrtu(i)) + k22 = term7(i,2) + term8(i,2)/ & + (1._r8 + (c28 + c29*(dty(i)-10._r8))*sqrtu(i)) + tr1 = exp(-(k21*(sqrtu(i) + fc1*fwku(i)))) + tr2 = exp(-(k22*(sqrtu(i) + fc1*fwku(i)))) + tr1=tr1*aer_trn_ttl(i,k1,k2,idx_LW_0650_0800) +! ! H2O line+STRAER trn 650--800 cm-1 + tr2=tr2*aer_trn_ttl(i,k1,k2,idx_LW_0500_0650) +! ! H2O line+STRAER trn 500--650 cm-1 + tr5 = exp(-((coefh(1,3) + coefh(2,3)*dtx(i))*uc1(i))) + tr6 = exp(-((coefh(1,4) + coefh(2,4)*dtx(i))*uc1(i))) + tr9(i) = tr1*tr5 + tr10(i) = tr2*tr6 + th2o(i) = tr10(i) + trab2(i) = 0.65_r8*tr9(i) + 0.35_r8*tr10(i) + end do + if (k2 < k1) then + do i=1,ncol + to3h2o(i) = h2otr(i,k1)/h2otr(i,k2) + end do + else + do i=1,ncol + to3h2o(i) = h2otr(i,k2)/h2otr(i,k1) + end do + end if +! +! abso(i,3) o3 9.6 micrometer band (nu3 and nu1 bands) +! + do i=1,ncol + dpnm(i) = pnm(i,k1) - pnm(i,k2) + to3co2(i) = (pnm(i,k1)*co2t(i,k1) - pnm(i,k2)*co2t(i,k2))/dpnm(i) + te = (to3co2(i)*r293)**.7_r8 + dplos = plos(i,k1) - plos(i,k2) + if (dplos == 0._r8) then + abso(i,3) = 0._r8 + to3(i) = 1._r8 + write(iulog,*) 'radiation ozone error ',k1,k2,plos(i,k1) + else + dplol = plol(i,k1) - plol(i,k2) + u1 = 18.29_r8*abs(dplos)/te + u2 = .5649_r8*abs(dplos)/te + rphat = dplol/dplos + tlocal = tint(i,k2) + tcrfac = sqrt(tlocal*r250)*te + beta = r3205*(rphat + dpfo3*tcrfac) + realnu = te/beta + tmp1 = u1/sqrt(4._r8 + u1*(1._r8 + realnu)) + tmp2 = u2/sqrt(4._r8 + u2*(1._r8 + realnu)) + o3bndi = 74._r8*te*log(1._r8 + tmp1 + tmp2) + abso(i,3) = o3bndi*to3h2o(i)*dbvtit(i,k2) + to3(i) = 1.0_r8/(1._r8 + 0.1_r8*tmp1 + 0.1_r8*tmp2) + endif + end do +! +! abso(i,4) co2 15 micrometer band system +! + do i=1,ncol + sqwp = sqrt(abs(plco2(i,k1) - plco2(i,k2))) + et = exp(-480._r8/to3co2(i)) + sqti(i) = sqrt(to3co2(i)) + rsqti = 1._r8/sqti(i) + et2 = et*et + et4 = et2*et2 + omet = 1._r8 - 1.5_r8*et2 + f1co2 = 899.70_r8*omet*(1._r8 + 1.94774_r8*et + 4.73486_r8*et2)*rsqti + f1sqwp(i) = f1co2*sqwp + t1co2(i) = 1._r8/(1._r8 + (245.18_r8*omet*sqwp*rsqti)) + oneme = 1._r8 - et2 + alphat = oneme**3*rsqti + pi = abs(dpnm(i)) + wco2 = 2.5221_r8*co2vmr(i)*pi*rga + u7(i) = 4.9411e4_r8*alphat*et2*wco2 + u8 = 3.9744e4_r8*alphat*et4*wco2 + u9 = 1.0447e5_r8*alphat*et4*et2*wco2 + u13 = 2.8388e3_r8*alphat*et4*wco2 + tpath = to3co2(i) + tlocal = tint(i,k2) + tcrfac = sqrt(tlocal*r250*tpath*r300) + posqt = ((pnm(i,k2) + pnm(i,k1))*r2sslp + dpfco2*tcrfac)*rsqti + rbeta7(i) = 1._r8/(5.3228_r8*posqt) + rbeta8 = 1._r8/(10.6576_r8*posqt) + rbeta9 = rbeta7(i) + rbeta13 = rbeta9 + f2co2(i) = (u7(i)/sqrt(4._r8 + u7(i)*(1._r8 + rbeta7(i)))) + & + (u8 /sqrt(4._r8 + u8*(1._r8 + rbeta8))) + & + (u9 /sqrt(4._r8 + u9*(1._r8 + rbeta9))) + f3co2(i) = u13/sqrt(4._r8 + u13*(1._r8 + rbeta13)) + end do + if (k2 >= k1) then + do i=1,ncol + sqti(i) = sqrt(tlayr(i,k2)) + end do + end if +! + do i=1,ncol + tmp1 = log(1._r8 + f1sqwp(i)) + tmp2 = log(1._r8 + f2co2(i)) + tmp3 = log(1._r8 + f3co2(i)) + absbnd = (tmp1 + 2._r8*t1co2(i)*tmp2 + 2._r8*tmp3)*sqti(i) + abso(i,4) = trab2(i)*co2em(i,k2)*absbnd + tco2(i) = 1._r8/(1.0_r8+10.0_r8*(u7(i)/sqrt(4._r8 + u7(i)*(1._r8 + rbeta7(i))))) + end do +! +! Calculate absorptivity due to trace gases, abstrc +! + call trcab(ncol , & + k1 ,k2 ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,bn2o0 ,bn2o1 , & + bch4 ,to3co2 ,pnm ,dw ,pnew , & + s2c ,uptype ,u ,abplnk1 ,tco2 , & + th2o ,to3 ,abstrc , & + aer_trn_ttl) +! +! Sum total absorptivity +! + do i=1,ncol + abstot(i,k1,k2) = abso(i,1) + abso(i,2) + & + abso(i,3) + abso(i,4) + abstrc(i) + end do + end do ! do k2 = + end do ! do k1 = +! +! Adjacent layer absorptivity: +! +! abso(i,1) 0 - 800 cm-1 h2o rotation band +! abso(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! abso(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O absorptivity +! +! 500-800 cm^-1 H2o continuum/line overlap already included +! in abso(i,1). This used to be in abso(i,4) +! +! abso(i,3) o3 9.6 micrometer band (nu3 and nu1 bands) +! abso(i,4) co2 15 micrometer band system +! +! Nearest layer level loop +! + do k2=pver,ntoplw,-1 + do i=1,ncol + tbar(i,1) = 0.5_r8*(tint(i,k2+1) + tlayr(i,k2+1)) + emm(i,1) = 0.5_r8*(co2em(i,k2+1) + co2eml(i,k2)) + tbar(i,2) = 0.5_r8*(tlayr(i,k2+1) + tint(i,k2)) + emm(i,2) = 0.5_r8*(co2em(i,k2) + co2eml(i,k2)) + tbar(i,3) = 0.5_r8*(tbar(i,2) + tbar(i,1)) + emm(i,3) = emm(i,1) + tbar(i,4) = tbar(i,3) + emm(i,4) = emm(i,2) + o3emm(i,1) = 0.5_r8*(dbvtit(i,k2+1) + dbvtly(i,k2)) + o3emm(i,2) = 0.5_r8*(dbvtit(i,k2) + dbvtly(i,k2)) + o3emm(i,3) = o3emm(i,1) + o3emm(i,4) = o3emm(i,2) + temh2o(i,1) = tbar(i,1) + temh2o(i,2) = tbar(i,2) + temh2o(i,3) = tbar(i,1) + temh2o(i,4) = tbar(i,2) + dpnm(i) = pnm(i,k2+1) - pnm(i,k2) + end do +! +! Weighted Planck functions for trace gases +! + do wvl = 1,14 + do i = 1,ncol + bplnk(wvl,i,1) = 0.5_r8*(abplnk1(wvl,i,k2+1) + abplnk2(wvl,i,k2)) + bplnk(wvl,i,2) = 0.5_r8*(abplnk1(wvl,i,k2) + abplnk2(wvl,i,k2)) + bplnk(wvl,i,3) = bplnk(wvl,i,1) + bplnk(wvl,i,4) = bplnk(wvl,i,2) + end do + end do + + do i=1,ncol + rdpnmsq = 1._r8/(pnmsq(i,k2+1) - pnmsq(i,k2)) + rdpnm = 1._r8/dpnm(i) + p1 = .5_r8*(pbr(i,k2) + pnm(i,k2+1)) + p2 = .5_r8*(pbr(i,k2) + pnm(i,k2 )) + uinpl(i,1) = (pnmsq(i,k2+1) - p1**2)*rdpnmsq + uinpl(i,2) = -(pnmsq(i,k2 ) - p2**2)*rdpnmsq + uinpl(i,3) = -(pnmsq(i,k2 ) - p1**2)*rdpnmsq + uinpl(i,4) = (pnmsq(i,k2+1) - p2**2)*rdpnmsq + winpl(i,1) = (.5_r8*( pnm(i,k2+1) - pbr(i,k2)))*rdpnm + winpl(i,2) = (.5_r8*(-pnm(i,k2 ) + pbr(i,k2)))*rdpnm + winpl(i,3) = (.5_r8*( pnm(i,k2+1) + pbr(i,k2)) - pnm(i,k2 ))*rdpnm + winpl(i,4) = (.5_r8*(-pnm(i,k2 ) - pbr(i,k2)) + pnm(i,k2+1))*rdpnm + tmp1 = 1._r8/(piln(i,k2+1) - piln(i,k2)) + tmp2 = piln(i,k2+1) - pmln(i,k2) + tmp3 = piln(i,k2 ) - pmln(i,k2) + zinpl(i,1) = (.5_r8*tmp2 )*tmp1 + zinpl(i,2) = ( - .5_r8*tmp3)*tmp1 + zinpl(i,3) = (.5_r8*tmp2 - tmp3)*tmp1 + zinpl(i,4) = ( tmp2 - .5_r8*tmp3)*tmp1 + pinpl(i,1) = 0.5_r8*(p1 + pnm(i,k2+1)) + pinpl(i,2) = 0.5_r8*(p2 + pnm(i,k2 )) + pinpl(i,3) = 0.5_r8*(p1 + pnm(i,k2 )) + pinpl(i,4) = 0.5_r8*(p2 + pnm(i,k2+1)) + end do + do kn=1,4 + do i=1,ncol + u(i) = uinpl(i,kn)*abs(plh2o(i,k2) - plh2o(i,k2+1)) + sqrtu(i) = sqrt(u(i)) + dw(i) = abs(w(i,k2) - w(i,k2+1)) + pnew(i) = u(i)/(winpl(i,kn)*dw(i)) + pnew_mks = pnew(i) * sslp_mks + t_p = min(max(tbar(i,kn), min_tp_h2o), max_tp_h2o) + + call qsat_water(t_p, pnew_mks, esx, qsx) + + q_path = dw(i) / ABS(dpnm(i)) / rga + + ds2c = abs(s2c(i,k2) - s2c(i,k2+1)) + uc1(i) = uinpl(i,kn)*ds2c + pch2o = uc1(i) + uc1(i) = (uc1(i) + 1.7e-3_r8*u(i))*(1._r8 + 2._r8*uc1(i))/(1._r8 + 15._r8*uc1(i)) + dtx(i) = temh2o(i,kn) - 250._r8 + dty(i) = tbar(i,kn) - 250._r8 + + fwk(i) = fwcoef + fwc1/(1._r8 + fwc2*u(i)) + fwku(i) = fwk(i)*u(i) + + aer_trn_ngh(i, 1:nlwbands)= & + exp(-fdif * uinpl(i,kn) * odap_aer(i, k2, 1:nlwbands ) ) + +! +! Define variables for C/H/E (now C/LT/E) fit +! +! abso(i,1) 0 - 800 cm-1 h2o rotation band +! abso(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! abso(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O absorptivity +! +! Notation: +! U = integral (P/P_0 dW) +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! +! +! Terms for asymptotic value of emissivity +! + te1 = temh2o(i,kn) + te2 = te1 * te1 + te3 = te2 * te1 + te4 = te3 * te1 + te5 = te4 * te1 + +! +! Indices for lines and continuum tables +! Note: because we are dealing with the nearest layer, +! the Hulst-Curtis-Godson corrections +! for inhomogeneous paths are not applied. +! + uvar = u(i)*fdif + log_u = min(log10(max(uvar, min_u_h2o)), max_lu_h2o) + dvar = (log_u - min_lu_h2o) / dlu_h2o + iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iu1 = iu + 1 + wu = dvar - floor(dvar) + wu1 = 1.0_r8 - wu + + log_p = min(log10(max(pnew(i), min_p_h2o)), max_lp_h2o) + dvar = (log_p - min_lp_h2o) / dlp_h2o + ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1) + ip1 = ip + 1 + wp = dvar - floor(dvar) + wp1 = 1.0_r8 - wp + + dvar = (t_p - min_tp_h2o) / dtp_h2o + itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1) + itp1 = itp + 1 + wtp = dvar - floor(dvar) + wtp1 = 1.0_r8 - wtp + + t_e = min(max(temh2o(i,kn)-t_p,min_te_h2o),max_te_h2o) + dvar = (t_e - min_te_h2o) / dte_h2o + ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1) + ite1 = ite + 1 + wte = dvar - floor(dvar) + wte1 = 1.0_r8 - wte + + rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o) + dvar = (rh_path - min_rh_h2o) / drh_h2o + irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1) + irh1 = irh + 1 + wrh = dvar - floor(dvar) + wrh1 = 1.0_r8 - wrh + + w_0_0_ = wtp * wte + w_0_1_ = wtp * wte1 + w_1_0_ = wtp1 * wte + w_1_1_ = wtp1 * wte1 + + w_0_00 = w_0_0_ * wrh + w_0_01 = w_0_0_ * wrh1 + w_0_10 = w_0_1_ * wrh + w_0_11 = w_0_1_ * wrh1 + w_1_00 = w_1_0_ * wrh + w_1_01 = w_1_0_ * wrh1 + w_1_10 = w_1_1_ * wrh + w_1_11 = w_1_1_ * wrh1 + + w00_00 = wp * w_0_00 + w00_01 = wp * w_0_01 + w00_10 = wp * w_0_10 + w00_11 = wp * w_0_11 + w01_00 = wp * w_1_00 + w01_01 = wp * w_1_01 + w01_10 = wp * w_1_10 + w01_11 = wp * w_1_11 + w10_00 = wp1 * w_0_00 + w10_01 = wp1 * w_0_01 + w10_10 = wp1 * w_0_10 + w10_11 = wp1 * w_0_11 + w11_00 = wp1 * w_1_00 + w11_01 = wp1 * w_1_01 + w11_10 = wp1 * w_1_10 + w11_11 = wp1 * w_1_11 + +! +! Non-window absorptivity +! + ib = 1 + + fa = fat(1,ib) + & + fat(2,ib) * te1 + & + fat(3,ib) * te2 + & + fat(4,ib) * te3 + & + fat(5,ib) * te4 + & + fat(6,ib) * te5 + + a_star = & + ah2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + ah2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + ah2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + ah2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + ah2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + ah2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + ah2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + ah2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + ah2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + ah2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + ah2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + ah2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + ah2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + ah2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + ah2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + ah2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + ah2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + ah2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + ah2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + ah2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + ah2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + ah2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + ah2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + ah2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + ah2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + ah2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + ah2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + ah2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + ah2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + ah2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + ah2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + ah2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + + abso(i,ib) = min(max(fa * (1.0_r8 - (1.0_r8 - a_star) * & + aer_trn_ngh(i,ib)), & + 0.0_r8), 1.0_r8) + +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + abso(i,ib) = abso(i,ib) * uscl + endif + +! +! Window absorptivity +! + ib = 2 + + fa = fat(1,ib) + & + fat(2,ib) * te1 + & + fat(3,ib) * te2 + & + fat(4,ib) * te3 + & + fat(5,ib) * te4 + & + fat(6,ib) * te5 + + a_star = & + ah2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + ah2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + ah2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + ah2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + ah2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + ah2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + ah2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + ah2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + ah2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + ah2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + ah2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + ah2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + ah2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + ah2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + ah2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + ah2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + ah2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + ah2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + ah2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + ah2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + ah2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + ah2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + ah2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + ah2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + ah2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + ah2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + ah2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + ah2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + ah2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + ah2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + ah2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + ah2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + + abso(i,ib) = min(max(fa * (1.0_r8 - (1.0_r8 - a_star) * & + aer_trn_ngh(i,ib)), & + 0.0_r8), 1.0_r8) + +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + abso(i,ib) = abso(i,ib) * uscl + endif + + end do +! +! Line transmission in 800-1000 and 1000-1200 cm-1 intervals +! + do i=1,ncol + term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1._r8 + c16*dty(i)) + term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1._r8 + c17*dty(i)) + term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1._r8 + c26*dty(i)) + term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1._r8 + c27*dty(i)) + end do +! +! 500 - 800 cm-1 h2o rotation band overlap with co2 +! + do i=1,ncol + dtym10 = dty(i) - 10._r8 + denom = 1._r8 + (c30 + c31*dtym10*dtym10)*sqrtu(i) + k21 = term7(i,1) + term8(i,1)/denom + denom = 1._r8 + (c28 + c29*dtym10 )*sqrtu(i) + k22 = term7(i,2) + term8(i,2)/denom + tr1 = exp(-(k21*(sqrtu(i) + fc1*fwku(i)))) + tr2 = exp(-(k22*(sqrtu(i) + fc1*fwku(i)))) + tr1=tr1*aer_trn_ngh(i,idx_LW_0650_0800) +! ! H2O line+STRAER trn 650--800 cm-1 + tr2=tr2*aer_trn_ngh(i,idx_LW_0500_0650) +! ! H2O line+STRAER trn 500--650 cm-1 + tr5 = exp(-((coefh(1,3) + coefh(2,3)*dtx(i))*uc1(i))) + tr6 = exp(-((coefh(1,4) + coefh(2,4)*dtx(i))*uc1(i))) + tr9(i) = tr1*tr5 + tr10(i) = tr2*tr6 + trab2(i)= 0.65_r8*tr9(i) + 0.35_r8*tr10(i) + th2o(i) = tr10(i) + end do +! +! abso(i,3) o3 9.6 micrometer (nu3 and nu1 bands) +! + do i=1,ncol + te = (tbar(i,kn)*r293)**.7_r8 + dplos = abs(plos(i,k2+1) - plos(i,k2)) + u1 = zinpl(i,kn)*18.29_r8*dplos/te + u2 = zinpl(i,kn)*.5649_r8*dplos/te + tlocal = tbar(i,kn) + tcrfac = sqrt(tlocal*r250)*te + beta = r3205*(pinpl(i,kn)*rsslp + dpfo3*tcrfac) + realnu = te/beta + tmp1 = u1/sqrt(4._r8 + u1*(1._r8 + realnu)) + tmp2 = u2/sqrt(4._r8 + u2*(1._r8 + realnu)) + o3bndi = 74._r8*te*log(1._r8 + tmp1 + tmp2) + abso(i,3) = o3bndi*o3emm(i,kn)*(h2otr(i,k2+1)/h2otr(i,k2)) + to3(i) = 1.0_r8/(1._r8 + 0.1_r8*tmp1 + 0.1_r8*tmp2) + end do +! +! abso(i,4) co2 15 micrometer band system +! + do i=1,ncol + dplco2 = plco2(i,k2+1) - plco2(i,k2) + sqwp = sqrt(uinpl(i,kn)*dplco2) + et = exp(-480._r8/tbar(i,kn)) + sqti(i) = sqrt(tbar(i,kn)) + rsqti = 1._r8/sqti(i) + et2 = et*et + et4 = et2*et2 + omet = (1._r8 - 1.5_r8*et2) + f1co2 = 899.70_r8*omet*(1._r8 + 1.94774_r8*et + 4.73486_r8*et2)*rsqti + f1sqwp(i)= f1co2*sqwp + t1co2(i) = 1._r8/(1._r8 + (245.18_r8*omet*sqwp*rsqti)) + oneme = 1._r8 - et2 + alphat = oneme**3*rsqti + pi = abs(dpnm(i))*winpl(i,kn) + wco2 = 2.5221_r8*co2vmr(i)*pi*rga + u7(i) = 4.9411e4_r8*alphat*et2*wco2 + u8 = 3.9744e4_r8*alphat*et4*wco2 + u9 = 1.0447e5_r8*alphat*et4*et2*wco2 + u13 = 2.8388e3_r8*alphat*et4*wco2 + tpath = tbar(i,kn) + tlocal = tbar(i,kn) + tcrfac = sqrt((tlocal*r250)*(tpath*r300)) + posqt = (pinpl(i,kn)*rsslp + dpfco2*tcrfac)*rsqti + rbeta7(i)= 1._r8/(5.3228_r8*posqt) + rbeta8 = 1._r8/(10.6576_r8*posqt) + rbeta9 = rbeta7(i) + rbeta13 = rbeta9 + f2co2(i) = u7(i)/sqrt(4._r8 + u7(i)*(1._r8 + rbeta7(i))) + & + u8 /sqrt(4._r8 + u8*(1._r8 + rbeta8)) + & + u9 /sqrt(4._r8 + u9*(1._r8 + rbeta9)) + f3co2(i) = u13/sqrt(4._r8 + u13*(1._r8 + rbeta13)) + tmp1 = log(1._r8 + f1sqwp(i)) + tmp2 = log(1._r8 + f2co2(i)) + tmp3 = log(1._r8 + f3co2(i)) + absbnd = (tmp1 + 2._r8*t1co2(i)*tmp2 + 2._r8*tmp3)*sqti(i) + abso(i,4)= trab2(i)*emm(i,kn)*absbnd + tco2(i) = 1.0_r8/(1.0_r8+ 10.0_r8*u7(i)/sqrt(4._r8 + u7(i)*(1._r8 + rbeta7(i)))) + end do ! do i = +! +! Calculate trace gas absorptivity for nearest layer, abstrc +! + call trcabn(ncol , & + k2 ,kn ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,tbar ,bplnk , & + winpl ,pinpl ,tco2 ,th2o ,to3 , & + uptype ,dw ,s2c ,u ,pnew , & + abstrc ,uinpl , & + aer_trn_ngh) +! +! Total next layer absorptivity: +! + do i=1,ncol + absnxt(i,k2,kn) = abso(i,1) + abso(i,2) + & + abso(i,3) + abso(i,4) + abstrc(i) + end do + end do ! do kn = + end do ! do k2 = + + return +end subroutine radabs + +!==================================================================================== + +subroutine radems(lchnk ,ncol , & + s2c ,tcg ,w ,tplnke ,plh2o , & + pnm ,plco2 ,tint ,tint4 ,tlayr , & + tlayr4 ,plol ,plos ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,uch4 ,uco211 ,uco212 , & + uco213 ,uco221 ,uco222 ,uco223 ,uptype , & + bn2o0 ,bn2o1 ,bch4 ,co2em ,co2eml , & + co2t ,h2otr ,abplnk1 ,abplnk2 ,emstot , & + plh2ob ,wb , & + aer_trn_ttl, co2mmr) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute emissivity for H2O, CO2, O3, CH4, N2O, CFC11 and CFC12 +! +! Method: +! H2O .... Uses nonisothermal emissivity method for water vapor from +! Ramanathan, V. and P.Downey, 1986: A Nonisothermal +! Emissivity and Absorptivity Formulation for Water Vapor +! Jouranl of Geophysical Research, vol. 91., D8, pp 8649-8666 +! +! Implementation updated by Collins,Hackney, and Edwards 2001 +! using line-by-line calculations based upon Hitran 1996 and +! CKD 2.1 for absorptivity and emissivity +! +! Implementation updated by Collins, Lee-Taylor, and Edwards (2003) +! using line-by-line calculations based upon Hitran 2000 and +! CKD 2.4 for absorptivity and emissivity +! +! CO2 .... Uses absorptance parameterization of the 15 micro-meter +! (500 - 800 cm-1) band system of Carbon Dioxide, from +! Kiehl, J.T. and B.P.Briegleb, 1991: A New Parameterization +! of the Absorptance Due to the 15 micro-meter Band System +! of Carbon Dioxide Jouranl of Geophysical Research, +! vol. 96., D5, pp 9013-9019. Also includes the effects +! of the 9.4 and 10.4 micron bands of CO2. +! +! O3 .... Uses absorptance parameterization of the 9.6 micro-meter +! band system of ozone, from Ramanathan, V. and R. Dickinson, +! 1979: The Role of stratospheric ozone in the zonal and +! seasonal radiative energy balance of the earth-troposphere +! system. Journal of the Atmospheric Sciences, Vol. 36, +! pp 1084-1104 +! +! ch4 .... Uses a broad band model for the 7.7 micron band of methane. +! +! n20 .... Uses a broad band model for the 7.8, 8.6 and 17.0 micron +! bands of nitrous oxide +! +! cfc11 ... Uses a quasi-linear model for the 9.2, 10.7, 11.8 and 12.5 +! micron bands of CFC11 +! +! cfc12 ... Uses a quasi-linear model for the 8.6, 9.1, 10.8 and 11.2 +! micron bands of CFC12 +! +! +! Computes individual emissivities, accounting for band overlap, and +! sums to obtain the total. +! +! Author: W. Collins (H2O emissivity) and J. Kiehl +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: s2c(pcols,pverp) ! H2o continuum path length + real(r8), intent(in) :: tcg(pcols,pverp) ! H2o-mass-wgted temp. (Curtis-Godson approx.) + real(r8), intent(in) :: w(pcols,pverp) ! H2o path length + real(r8), intent(in) :: tplnke(pcols) ! Layer planck temperature + real(r8), intent(in) :: plh2o(pcols,pverp) ! H2o prs wghted path length + real(r8), intent(in) :: pnm(pcols,pverp) ! Model interface pressure + real(r8), intent(in) :: plco2(pcols,pverp) ! Prs wghted path of co2 + real(r8), intent(in) :: tint(pcols,pverp) ! Model interface temperatures + real(r8), intent(in) :: tint4(pcols,pverp) ! Tint to the 4th power + real(r8), intent(in) :: tlayr(pcols,pverp) ! K-1 model layer temperature + real(r8), intent(in) :: tlayr4(pcols,pverp) ! Tlayr to the 4th power + real(r8), intent(in) :: plol(pcols,pverp) ! Pressure wghtd ozone path + real(r8), intent(in) :: plos(pcols,pverp) ! Ozone path + real(r8), intent(in) :: plh2ob(nbands,pcols,pverp) ! Pressure weighted h2o path with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + real(r8), intent(in) :: wb(nbands,pcols,pverp) ! H2o path length with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + + real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) +! ! [fraction] Total strat. aerosol +! ! transmission between interfaces k1 and k2 + +! +! Trace gas variables +! + real(r8), intent(in) :: co2mmr(pcols) ! co2 column mean mass mixing ratio + real(r8), intent(in) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(in) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(in) :: un2o0(pcols,pverp) ! N2O path length + real(r8), intent(in) :: un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8), intent(in) :: uch4(pcols,pverp) ! CH4 path length + real(r8), intent(in) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: bn2o0(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bn2o1(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bch4(pcols,pverp) ! pressure factor for ch4 + real(r8), intent(in) :: uptype(pcols,pverp) ! p-type continuum path length +! +! Output arguments +! + real(r8), intent(out) :: emstot(pcols,pverp) ! Total emissivity + real(r8), intent(out) :: co2em(pcols,pverp) ! Layer co2 normalzd plnck funct drvtv + real(r8), intent(out) :: co2eml(pcols,pver) ! Intrfc co2 normalzd plnck func drvtv + real(r8), intent(out) :: co2t(pcols,pverp) ! Tmp and prs weighted path length + real(r8), intent(out) :: h2otr(pcols,pverp) ! H2o transmission over o3 band + real(r8), intent(out) :: abplnk1(14,pcols,pverp) ! non-nearest layer Plack factor + real(r8), intent(out) :: abplnk2(14,pcols,pverp) ! nearest layer factor + +! +!---------------------------Local variables----------------------------- +! + integer i ! Longitude index + integer k ! Level index] + integer k1 ! Level index +! +! Local variables for H2O: +! + real(r8) h2oems(pcols,pverp) ! H2o emissivity + real(r8) tpathe ! Used to compute h2o emissivity + real(r8) dtx(pcols) ! Planck temperature minus 250 K + real(r8) dty(pcols) ! Path temperature minus 250 K +! +! The 500-800 cm^-1 emission in emis(i,4) has been combined +! into the 0-800 cm^-1 emission in emis(i,1) +! + real(r8) emis(pcols,2) ! H2O emissivity +! +! +! + real(r8) term7(pcols,2) ! Kl_inf(i) in eq(r8) of table A3a of R&D + real(r8) term8(pcols,2) ! Delta kl_inf(i) in eq(r8) + real(r8) tr1(pcols) ! Equation(6) in table A2 for 650-800 + real(r8) tr2(pcols) ! Equation(6) in table A2 for 500-650 + real(r8) tr3(pcols) ! Equation(4) in table A2 for 650-800 + real(r8) tr4(pcols) ! Equation(4),table A2 of R&D for 500-650 + real(r8) tr7(pcols) ! Equation (6) times eq(4) in table A2 +! of R&D for 650-800 cm-1 region + real(r8) tr8(pcols) ! Equation (6) times eq(4) in table A2 +! of R&D for 500-650 cm-1 region + real(r8) k21(pcols) ! Exponential coefficient used to calc +! rot band transmissivity in the 650-800 +! cm-1 region (tr1) + real(r8) k22(pcols) ! Exponential coefficient used to calc +! rot band transmissivity in the 500-650 +! cm-1 region (tr2) + real(r8) u(pcols) ! Pressure weighted H2O path length + real(r8) ub(nbands) ! Pressure weighted H2O path length with + ! Hulst-Curtis-Godson correction for + ! each band + real(r8) pnew ! Effective pressure for h2o linewidth + real(r8) pnewb(nbands) ! Effective pressure for h2o linewidth w/ + ! Hulst-Curtis-Godson correction for + ! each band + real(r8) uc1(pcols) ! H2o continuum pathlength 500-800 cm-1 + real(r8) fwk ! Equation(33) in R&D far wing correction + real(r8) troco2(pcols,pverp) ! H2o overlap factor for co2 absorption + real(r8) emplnk(14,pcols) ! emissivity Planck factor + real(r8) emstrc(pcols,pverp) ! total trace gas emissivity +! +! Local variables for CO2: +! + real(r8) co2vmr(pcols) ! CO2 column mean vmr + real(r8) rmw ! ratio of molecular weights (air/co2) + real(r8) co2ems(pcols,pverp) ! Co2 emissivity + real(r8) co2plk(pcols) ! Used to compute co2 emissivity + real(r8) sum(pcols) ! Used to calculate path temperature + real(r8) t1i ! Co2 hot band temperature factor + real(r8) sqti ! Sqrt of temperature + real(r8) pi ! Pressure used in co2 mean line width + real(r8) et ! Co2 hot band factor + real(r8) et2 ! Co2 hot band factor + real(r8) et4 ! Co2 hot band factor + real(r8) omet ! Co2 stimulated emission term + real(r8) ex ! Part of co2 planck function + real(r8) f1co2 ! Co2 weak band factor + real(r8) f2co2 ! Co2 weak band factor + real(r8) f3co2 ! Co2 weak band factor + real(r8) t1co2 ! Overlap factor weak bands strong band + real(r8) sqwp ! Sqrt of co2 pathlength + real(r8) f1sqwp ! Main co2 band factor + real(r8) oneme ! Co2 stimulated emission term + real(r8) alphat ! Part of the co2 stimulated emiss term + real(r8) wco2 ! Consts used to define co2 pathlength + real(r8) posqt ! Effective pressure for co2 line width + real(r8) rbeta7 ! Inverse of co2 hot band line width par + real(r8) rbeta8 ! Inverse of co2 hot band line width par + real(r8) rbeta9 ! Inverse of co2 hot band line width par + real(r8) rbeta13 ! Inverse of co2 hot band line width par + real(r8) tpath ! Path temp used in co2 band model + real(r8) tmp1 ! Co2 band factor + real(r8) tmp2 ! Co2 band factor + real(r8) tmp3 ! Co2 band factor + real(r8) tlayr5 ! Temperature factor in co2 Planck func + real(r8) rsqti ! Reciprocal of sqrt of temperature + real(r8) exm1sq ! Part of co2 Planck function + real(r8) u7 ! Absorber amt for various co2 band systems + real(r8) u8 ! Absorber amt for various co2 band systems + real(r8) u9 ! Absorber amt for various co2 band systems + real(r8) u13 ! Absorber amt for various co2 band systems + real(r8) r250 ! Inverse 250K + real(r8) r300 ! Inverse 300K + real(r8) rsslp ! Inverse standard sea-level pressure +! +! Local variables for O3: +! + real(r8) o3ems(pcols,pverp) ! Ozone emissivity + real(r8) dbvtt(pcols) ! Tmp drvtv of planck fctn for tplnke + real(r8) dbvt,fo3,t,ux,vx + real(r8) te ! Temperature factor + real(r8) u1 ! Path length factor + real(r8) u2 ! Path length factor + real(r8) phat ! Effecitive path length pressure + real(r8) tlocal ! Local planck function temperature + real(r8) tcrfac ! Scaled temperature factor + real(r8) beta ! Absorption funct factor voigt effect + real(r8) realnu ! Absorption function factor + real(r8) o3bndi ! Band absorption factor +! +! Transmission terms for various spectral intervals: +! + real(r8) absbnd ! Proportional to co2 band absorptance + real(r8) tco2(pcols) ! co2 overlap factor + real(r8) th2o(pcols) ! h2o overlap factor + real(r8) to3(pcols) ! o3 overlap factor +! +! Variables for new H2O parameterization +! +! Notation: +! U = integral (P/P_0 dW) eq. 15 in Ramanathan/Downey 1986 +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! + real(r8) fe ! asymptotic value of emis. as U->infinity + real(r8) e_star ! normalized non-window emissivity + real(r8) l_star ! interpolated line transmission + real(r8) c_star ! interpolated continuum transmission + + real(r8) te1 ! emission temperature + real(r8) te2 ! te^2 + real(r8) te3 ! te^3 + real(r8) te4 ! te^4 + real(r8) te5 ! te^5 + + real(r8) log_u ! log base 10 of U + real(r8) log_uc ! log base 10 of H2O continuum path + real(r8) log_p ! log base 10 of P + real(r8) t_p ! T_p + real(r8) t_e ! T_e (offset by T_p) + + integer iu ! index for log10(U) + integer iu1 ! iu + 1 + integer iuc ! index for log10(H2O continuum path) + integer iuc1 ! iuc + 1 + integer ip ! index for log10(P) + integer ip1 ! ip + 1 + integer itp ! index for T_p + integer itp1 ! itp + 1 + integer ite ! index for T_e + integer ite1 ! ite + 1 + integer irh ! index for RH + integer irh1 ! irh + 1 + + real(r8) dvar ! normalized variation in T_p/T_e/P/U + real(r8) uvar ! U * diffusivity factor + real(r8) uscl ! factor for lineary scaling as U->0 + + real(r8) wu ! weight for U + real(r8) wu1 ! 1 - wu + real(r8) wuc ! weight for H2O continuum path + real(r8) wuc1 ! 1 - wuc + real(r8) wp ! weight for P + real(r8) wp1 ! 1 - wp + real(r8) wtp ! weight for T_p + real(r8) wtp1 ! 1 - wtp + real(r8) wte ! weight for T_e + real(r8) wte1 ! 1 - wte + real(r8) wrh ! weight for RH + real(r8) wrh1 ! 1 - wrh + + real(r8) w_0_0_ ! weight for Tp/Te combination + real(r8) w_0_1_ ! weight for Tp/Te combination + real(r8) w_1_0_ ! weight for Tp/Te combination + real(r8) w_1_1_ ! weight for Tp/Te combination + + real(r8) w_0_00 ! weight for Tp/Te/RH combination + real(r8) w_0_01 ! weight for Tp/Te/RH combination + real(r8) w_0_10 ! weight for Tp/Te/RH combination + real(r8) w_0_11 ! weight for Tp/Te/RH combination + real(r8) w_1_00 ! weight for Tp/Te/RH combination + real(r8) w_1_01 ! weight for Tp/Te/RH combination + real(r8) w_1_10 ! weight for Tp/Te/RH combination + real(r8) w_1_11 ! weight for Tp/Te/RH combination + + real(r8) w00_00 ! weight for P/Tp/Te/RH combination + real(r8) w00_01 ! weight for P/Tp/Te/RH combination + real(r8) w00_10 ! weight for P/Tp/Te/RH combination + real(r8) w00_11 ! weight for P/Tp/Te/RH combination + real(r8) w01_00 ! weight for P/Tp/Te/RH combination + real(r8) w01_01 ! weight for P/Tp/Te/RH combination + real(r8) w01_10 ! weight for P/Tp/Te/RH combination + real(r8) w01_11 ! weight for P/Tp/Te/RH combination + real(r8) w10_00 ! weight for P/Tp/Te/RH combination + real(r8) w10_01 ! weight for P/Tp/Te/RH combination + real(r8) w10_10 ! weight for P/Tp/Te/RH combination + real(r8) w10_11 ! weight for P/Tp/Te/RH combination + real(r8) w11_00 ! weight for P/Tp/Te/RH combination + real(r8) w11_01 ! weight for P/Tp/Te/RH combination + real(r8) w11_10 ! weight for P/Tp/Te/RH combination + real(r8) w11_11 ! weight for P/Tp/Te/RH combination + + integer ib ! spectral interval: + ! 1 = 0-800 cm^-1 and 1200-2200 cm^-1 + ! 2 = 800-1200 cm^-1 + + real(r8) pch2o ! H2O continuum path + real(r8) fch2o ! temp. factor for continuum + real(r8) uch2o ! U corresponding to H2O cont. path (window) + + real(r8) fdif ! secant(zenith angle) for diffusivity approx. + + real(r8) sslp_mks ! Sea-level pressure in MKS units + real(r8) esx ! saturation vapor pressure returned by qsat + real(r8) qsx ! saturation mixing ratio returned by qsat + real(r8) pnew_mks ! pnew in MKS units + real(r8) q_path ! effective specific humidity along path + real(r8) rh_path ! effective relative humidity along path + +! +!---------------------------Statement functions------------------------- +! +! Derivative of planck function at 9.6 micro-meter wavelength, and +! an absorption function factor: +! +! + dbvt(t)=(-2.8911366682e-4_r8+(2.3771251896e-6_r8+1.1305188929e-10_r8*t)*t)/ & + (1.0_r8+(-6.1364820707e-3_r8+1.5550319767e-5_r8*t)*t) +! + fo3(ux,vx)=ux/sqrt(4._r8+ux*(1._r8+vx)) +! +! +! +!----------------------------------------------------------------------- +! +! Initialize +! + r250 = 1._r8/250._r8 + r300 = 1._r8/300._r8 + rsslp = 1._r8/sslp + rmw = amd/amco2 + do i=1,ncol + co2vmr(i) = co2mmr(i) * rmw + end do +! +! Constants for computing U corresponding to H2O cont. path +! + fdif = 1.66_r8 + sslp_mks = sslp / 10.0_r8 +! +! Planck function for co2 +! + do i=1,ncol + ex = exp(960._r8/tplnke(i)) + co2plk(i) = 5.e8_r8/((tplnke(i)**4)*(ex - 1._r8)) + co2t(i,ntoplw) = tplnke(i) + sum(i) = co2t(i,ntoplw)*pnm(i,ntoplw) + end do + k = ntoplw + do k1=pverp,ntoplw+1,-1 + k = k + 1 + do i=1,ncol + sum(i) = sum(i) + tlayr(i,k)*(pnm(i,k)-pnm(i,k-1)) + ex = exp(960._r8/tlayr(i,k1)) + tlayr5 = tlayr(i,k1)*tlayr4(i,k1) + co2eml(i,k1-1) = 1.2e11_r8*ex/(tlayr5*(ex - 1._r8)**2) + co2t(i,k) = sum(i)/pnm(i,k) + end do + end do +! +! Initialize planck function derivative for O3 +! + do i=1,ncol + dbvtt(i) = dbvt(tplnke(i)) + end do +! +! Calculate trace gas Planck functions +! + call trcplk(ncol , & + tint ,tlayr ,tplnke ,emplnk ,abplnk1 , & + abplnk2 ) + + if ( ntoplw > 1 )then + emstot(:ncol,:ntoplw-1) = 0._r8 + end if + +! +! Interface loop +! + do k1=ntoplw,pverp +! +! H2O emissivity +! +! emis(i,1) 0 - 800 cm-1 h2o rotation band +! emis(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! emis(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O emissivity +! +! emis(i,3) = 0.0 +! +! For the p type continuum +! + do i=1,ncol + u(i) = plh2o(i,k1) + pnew = u(i)/w(i,k1) + pnew_mks = pnew * sslp_mks +! +! Apply scaling factor for 500-800 continuum +! + uc1(i) = (s2c(i,k1) + 1.7e-3_r8*plh2o(i,k1))*(1._r8 + 2._r8*s2c(i,k1))/ & + (1._r8 + 15._r8*s2c(i,k1)) + pch2o = s2c(i,k1) +! +! Changed effective path temperature to std. Curtis-Godson form +! + tpathe = tcg(i,k1)/w(i,k1) + t_p = min(max(tpathe, min_tp_h2o), max_tp_h2o) + + call qsat_water(t_p, pnew_mks, esx, qsx) + +! +! Compute effective RH along path +! + q_path = w(i,k1) / pnm(i,k1) / rga +! +! Calculate effective u, pnew for each band using +! Hulst-Curtis-Godson approximation: +! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, +! 2nd edition, Oxford University Press, 1989. +! Effective H2O path (w) +! eq. 6.24, p. 228 +! Effective H2O path pressure (pnew = u/w): +! eq. 6.29, p. 228 +! + ub(1) = plh2ob(1,i,k1) / psi(t_p,1) + ub(2) = plh2ob(2,i,k1) / psi(t_p,2) + + pnewb(1) = ub(1) / wb(1,i,k1) * phi(t_p,1) + pnewb(2) = ub(2) / wb(2,i,k1) * phi(t_p,2) +! +! +! + dtx(i) = tplnke(i) - 250._r8 + dty(i) = tpathe - 250._r8 +! +! Define variables for C/H/E (now C/LT/E) fit +! +! emis(i,1) 0 - 800 cm-1 h2o rotation band +! emis(i,1) 1200 - 2200 cm-1 h2o vibration-rotation band +! emis(i,2) 800 - 1200 cm-1 h2o window +! +! Separation between rotation and vibration-rotation dropped, so +! only 2 slots needed for H2O emissivity +! +! emis(i,3) = 0.0 +! +! Notation: +! U = integral (P/P_0 dW) +! P = atmospheric pressure +! P_0 = reference atmospheric pressure +! W = precipitable water path +! T_e = emission temperature +! T_p = path temperature +! RH = path relative humidity +! +! Terms for asymptotic value of emissivity +! + te1 = tplnke(i) + te2 = te1 * te1 + te3 = te2 * te1 + te4 = te3 * te1 + te5 = te4 * te1 +! +! Band-independent indices for lines and continuum tables +! + dvar = (t_p - min_tp_h2o) / dtp_h2o + itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1) + itp1 = itp + 1 + wtp = dvar - floor(dvar) + wtp1 = 1.0_r8 - wtp + + t_e = min(max(tplnke(i) - t_p, min_te_h2o), max_te_h2o) + dvar = (t_e - min_te_h2o) / dte_h2o + ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1) + ite1 = ite + 1 + wte = dvar - floor(dvar) + wte1 = 1.0_r8 - wte + + rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o) + dvar = (rh_path - min_rh_h2o) / drh_h2o + irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1) + irh1 = irh + 1 + wrh = dvar - floor(dvar) + wrh1 = 1.0_r8 - wrh + + w_0_0_ = wtp * wte + w_0_1_ = wtp * wte1 + w_1_0_ = wtp1 * wte + w_1_1_ = wtp1 * wte1 + + w_0_00 = w_0_0_ * wrh + w_0_01 = w_0_0_ * wrh1 + w_0_10 = w_0_1_ * wrh + w_0_11 = w_0_1_ * wrh1 + w_1_00 = w_1_0_ * wrh + w_1_01 = w_1_0_ * wrh1 + w_1_10 = w_1_1_ * wrh + w_1_11 = w_1_1_ * wrh1 +! +! H2O Continuum path for 0-800 and 1200-2200 cm^-1 +! +! Assume foreign continuum dominates total H2O continuum in these bands +! per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776 +! Then the effective H2O path is just +! U_c = integral[ f(P) dW ] +! where +! W = water-vapor mass and +! f(P) = dependence of foreign continuum on pressure +! = P / sslp +! Then +! U_c = U (the same effective H2O path as for lines) +! +! +! Continuum terms for 800-1200 cm^-1 +! +! Assume self continuum dominates total H2O continuum for this band +! per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776 +! Then the effective H2O self-continuum path is +! U_c = integral[ h(e,T) dW ] (*eq. 1*) +! where +! W = water-vapor mass and +! e = partial pressure of H2O along path +! T = temperature along path +! h(e,T) = dependence of foreign continuum on e,T +! = e / sslp * f(T) +! +! Replacing +! e =~ q * P / epsilo +! q = mixing ratio of H2O +! epsilo = 0.622 +! +! and using the definition +! U = integral [ (P / sslp) dW ] +! = (P / sslp) W (homogeneous path) +! +! the effective path length for the self continuum is +! U_c = (q / epsilo) f(T) U (*eq. 2*) +! +! Once values of T, U, and q have been calculated for the inhomogeneous +! path, this sets U_c for the corresponding +! homogeneous atmosphere. However, this need not equal the +! value of U_c' defined by eq. 1 for the actual inhomogeneous atmosphere +! under consideration. +! +! Solution: hold T and q constant, solve for U' that gives U_c' by +! inverting eq. (2): +! +! U' = (U_c * epsilo) / (q * f(T)) +! + fch2o = fh2oself(t_p) + uch2o = (pch2o * epsilo) / (q_path * fch2o) + +! +! Band-dependent indices for non-window +! + ib = 1 + + uvar = ub(ib) * fdif + log_u = min(log10(max(uvar, min_u_h2o)), max_lu_h2o) + dvar = (log_u - min_lu_h2o) / dlu_h2o + iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iu1 = iu + 1 + wu = dvar - floor(dvar) + wu1 = 1.0_r8 - wu + + log_p = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o) + dvar = (log_p - min_lp_h2o) / dlp_h2o + ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1) + ip1 = ip + 1 + wp = dvar - floor(dvar) + wp1 = 1.0_r8 - wp + + w00_00 = wp * w_0_00 + w00_01 = wp * w_0_01 + w00_10 = wp * w_0_10 + w00_11 = wp * w_0_11 + w01_00 = wp * w_1_00 + w01_01 = wp * w_1_01 + w01_10 = wp * w_1_10 + w01_11 = wp * w_1_11 + w10_00 = wp1 * w_0_00 + w10_01 = wp1 * w_0_01 + w10_10 = wp1 * w_0_10 + w10_11 = wp1 * w_0_11 + w11_00 = wp1 * w_1_00 + w11_01 = wp1 * w_1_01 + w11_10 = wp1 * w_1_10 + w11_11 = wp1 * w_1_11 + +! +! Asymptotic value of emissivity as U->infinity +! + fe = fet(1,ib) + & + fet(2,ib) * te1 + & + fet(3,ib) * te2 + & + fet(4,ib) * te3 + & + fet(5,ib) * te4 + & + fet(6,ib) * te5 + + e_star = & + eh2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + eh2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + eh2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + eh2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + eh2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + eh2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + eh2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + eh2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + eh2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + eh2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + eh2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + eh2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + eh2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + eh2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + eh2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + eh2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + eh2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + eh2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + eh2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + eh2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + eh2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + eh2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + eh2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + eh2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + eh2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + eh2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + eh2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + eh2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + eh2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + eh2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + eh2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + eh2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + emis(i,ib) = min(max(fe * (1.0_r8 - (1.0_r8 - e_star) * & + aer_trn_ttl(i,k1,1,ib)), & + 0.0_r8), 1.0_r8) +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + emis(i,ib) = emis(i,ib) * uscl + endif + + + +! +! Band-dependent indices for window +! + ib = 2 + + uvar = ub(ib) * fdif + log_u = min(log10(max(uvar, min_u_h2o)), max_lu_h2o) + dvar = (log_u - min_lu_h2o) / dlu_h2o + iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iu1 = iu + 1 + wu = dvar - floor(dvar) + wu1 = 1.0_r8 - wu + + log_p = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o) + dvar = (log_p - min_lp_h2o) / dlp_h2o + ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1) + ip1 = ip + 1 + wp = dvar - floor(dvar) + wp1 = 1.0_r8 - wp + + w00_00 = wp * w_0_00 + w00_01 = wp * w_0_01 + w00_10 = wp * w_0_10 + w00_11 = wp * w_0_11 + w01_00 = wp * w_1_00 + w01_01 = wp * w_1_01 + w01_10 = wp * w_1_10 + w01_11 = wp * w_1_11 + w10_00 = wp1 * w_0_00 + w10_01 = wp1 * w_0_01 + w10_10 = wp1 * w_0_10 + w10_11 = wp1 * w_0_11 + w11_00 = wp1 * w_1_00 + w11_01 = wp1 * w_1_01 + w11_10 = wp1 * w_1_10 + w11_11 = wp1 * w_1_11 + + log_uc = min(log10(max(uch2o * fdif, min_u_h2o)), max_lu_h2o) + dvar = (log_uc - min_lu_h2o) / dlu_h2o + iuc = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1) + iuc1 = iuc + 1 + wuc = dvar - floor(dvar) + wuc1 = 1.0_r8 - wuc +! +! Asymptotic value of emissivity as U->infinity +! + fe = fet(1,ib) + & + fet(2,ib) * te1 + & + fet(3,ib) * te2 + & + fet(4,ib) * te3 + & + fet(5,ib) * te4 + & + fet(6,ib) * te5 + + l_star = & + ln_eh2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + & + ln_eh2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + & + ln_eh2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + & + ln_eh2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + & + ln_eh2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu + & + ln_eh2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu + & + ln_eh2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu + & + ln_eh2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu + & + ln_eh2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + & + ln_eh2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + & + ln_eh2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + & + ln_eh2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + & + ln_eh2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu + & + ln_eh2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu + & + ln_eh2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu + & + ln_eh2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu + & + ln_eh2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + & + ln_eh2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + & + ln_eh2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + & + ln_eh2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + & + ln_eh2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu + & + ln_eh2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu + & + ln_eh2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu + & + ln_eh2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu + & + ln_eh2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + & + ln_eh2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + & + ln_eh2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + & + ln_eh2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + & + ln_eh2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu + & + ln_eh2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu + & + ln_eh2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu + & + ln_eh2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu + + c_star = & + cn_eh2ow(ip , itp , iuc , ite , irh ) * w11_11 * wuc1 + & + cn_eh2ow(ip , itp , iuc , ite , irh1) * w11_10 * wuc1 + & + cn_eh2ow(ip , itp , iuc , ite1, irh ) * w11_01 * wuc1 + & + cn_eh2ow(ip , itp , iuc , ite1, irh1) * w11_00 * wuc1 + & + cn_eh2ow(ip , itp , iuc1, ite , irh ) * w11_11 * wuc + & + cn_eh2ow(ip , itp , iuc1, ite , irh1) * w11_10 * wuc + & + cn_eh2ow(ip , itp , iuc1, ite1, irh ) * w11_01 * wuc + & + cn_eh2ow(ip , itp , iuc1, ite1, irh1) * w11_00 * wuc + & + cn_eh2ow(ip , itp1, iuc , ite , irh ) * w10_11 * wuc1 + & + cn_eh2ow(ip , itp1, iuc , ite , irh1) * w10_10 * wuc1 + & + cn_eh2ow(ip , itp1, iuc , ite1, irh ) * w10_01 * wuc1 + & + cn_eh2ow(ip , itp1, iuc , ite1, irh1) * w10_00 * wuc1 + & + cn_eh2ow(ip , itp1, iuc1, ite , irh ) * w10_11 * wuc + & + cn_eh2ow(ip , itp1, iuc1, ite , irh1) * w10_10 * wuc + & + cn_eh2ow(ip , itp1, iuc1, ite1, irh ) * w10_01 * wuc + & + cn_eh2ow(ip , itp1, iuc1, ite1, irh1) * w10_00 * wuc + & + cn_eh2ow(ip1, itp , iuc , ite , irh ) * w01_11 * wuc1 + & + cn_eh2ow(ip1, itp , iuc , ite , irh1) * w01_10 * wuc1 + & + cn_eh2ow(ip1, itp , iuc , ite1, irh ) * w01_01 * wuc1 + & + cn_eh2ow(ip1, itp , iuc , ite1, irh1) * w01_00 * wuc1 + & + cn_eh2ow(ip1, itp , iuc1, ite , irh ) * w01_11 * wuc + & + cn_eh2ow(ip1, itp , iuc1, ite , irh1) * w01_10 * wuc + & + cn_eh2ow(ip1, itp , iuc1, ite1, irh ) * w01_01 * wuc + & + cn_eh2ow(ip1, itp , iuc1, ite1, irh1) * w01_00 * wuc + & + cn_eh2ow(ip1, itp1, iuc , ite , irh ) * w00_11 * wuc1 + & + cn_eh2ow(ip1, itp1, iuc , ite , irh1) * w00_10 * wuc1 + & + cn_eh2ow(ip1, itp1, iuc , ite1, irh ) * w00_01 * wuc1 + & + cn_eh2ow(ip1, itp1, iuc , ite1, irh1) * w00_00 * wuc1 + & + cn_eh2ow(ip1, itp1, iuc1, ite , irh ) * w00_11 * wuc + & + cn_eh2ow(ip1, itp1, iuc1, ite , irh1) * w00_10 * wuc + & + cn_eh2ow(ip1, itp1, iuc1, ite1, irh ) * w00_01 * wuc + & + cn_eh2ow(ip1, itp1, iuc1, ite1, irh1) * w00_00 * wuc + emis(i,ib) = min(max(fe * (1.0_r8 - l_star * c_star * & + aer_trn_ttl(i,k1,1,ib)), & + 0.0_r8), 1.0_r8) +! +! Invoke linear limit for scaling wrt u below min_u_h2o +! + if (uvar < min_u_h2o) then + uscl = uvar / min_u_h2o + emis(i,ib) = emis(i,ib) * uscl + endif + + +! +! Compute total emissivity for H2O +! + h2oems(i,k1) = emis(i,1)+emis(i,2) + + end do +! +! +! + + do i=1,ncol + term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1._r8+c16*dty(i)) + term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1._r8+c17*dty(i)) + term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1._r8+c26*dty(i)) + term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1._r8+c27*dty(i)) + end do + do i=1,ncol +! +! 500 - 800 cm-1 rotation band overlap with co2 +! + k21(i) = term7(i,1) + term8(i,1)/ & + (1._r8 + (c30 + c31*(dty(i)-10._r8)*(dty(i)-10._r8))*sqrt(u(i))) + k22(i) = term7(i,2) + term8(i,2)/ & + (1._r8 + (c28 + c29*(dty(i)-10._r8))*sqrt(u(i))) + fwk = fwcoef + fwc1/(1._r8+fwc2*u(i)) + tr1(i) = exp(-(k21(i)*(sqrt(u(i)) + fc1*fwk*u(i)))) + tr2(i) = exp(-(k22(i)*(sqrt(u(i)) + fc1*fwk*u(i)))) + tr1(i)=tr1(i)*aer_trn_ttl(i,k1,1,idx_LW_0650_0800) +! ! H2O line+aer trn 650--800 cm-1 + tr2(i)=tr2(i)*aer_trn_ttl(i,k1,1,idx_LW_0500_0650) +! ! H2O line+aer trn 500--650 cm-1 + tr3(i) = exp(-((coefh(1,1) + coefh(2,1)*dtx(i))*uc1(i))) + tr4(i) = exp(-((coefh(1,2) + coefh(2,2)*dtx(i))*uc1(i))) + tr7(i) = tr1(i)*tr3(i) + tr8(i) = tr2(i)*tr4(i) + troco2(i,k1) = 0.65_r8*tr7(i) + 0.35_r8*tr8(i) + th2o(i) = tr8(i) + end do +! +! CO2 emissivity for 15 micron band system +! + do i=1,ncol + t1i = exp(-480._r8/co2t(i,k1)) + sqti = sqrt(co2t(i,k1)) + rsqti = 1._r8/sqti + et = t1i + et2 = et*et + et4 = et2*et2 + omet = 1._r8 - 1.5_r8*et2 + f1co2 = 899.70_r8*omet*(1._r8 + 1.94774_r8*et + 4.73486_r8*et2)*rsqti + sqwp = sqrt(plco2(i,k1)) + f1sqwp = f1co2*sqwp + t1co2 = 1._r8/(1._r8 + 245.18_r8*omet*sqwp*rsqti) + oneme = 1._r8 - et2 + alphat = oneme**3*rsqti + wco2 = 2.5221_r8*co2vmr(i)*pnm(i,k1)*rga + u7 = 4.9411e4_r8*alphat*et2*wco2 + u8 = 3.9744e4_r8*alphat*et4*wco2 + u9 = 1.0447e5_r8*alphat*et4*et2*wco2 + u13 = 2.8388e3_r8*alphat*et4*wco2 +! + tpath = co2t(i,k1) + tlocal = tplnke(i) + tcrfac = sqrt((tlocal*r250)*(tpath*r300)) + pi = pnm(i,k1)*rsslp + 2._r8*dpfco2*tcrfac + posqt = pi/(2._r8*sqti) + rbeta7 = 1._r8/( 5.3288_r8*posqt) + rbeta8 = 1._r8/ (10.6576_r8*posqt) + rbeta9 = rbeta7 + rbeta13= rbeta9 + f2co2 = (u7/sqrt(4._r8 + u7*(1._r8 + rbeta7))) + & + (u8/sqrt(4._r8 + u8*(1._r8 + rbeta8))) + & + (u9/sqrt(4._r8 + u9*(1._r8 + rbeta9))) + f3co2 = u13/sqrt(4._r8 + u13*(1._r8 + rbeta13)) + tmp1 = log(1._r8 + f1sqwp) + tmp2 = log(1._r8 + f2co2) + tmp3 = log(1._r8 + f3co2) + absbnd = (tmp1 + 2._r8*t1co2*tmp2 + 2._r8*tmp3)*sqti + tco2(i)=1.0_r8/(1.0_r8+10.0_r8*(u7/sqrt(4._r8 + u7*(1._r8 + rbeta7)))) + co2ems(i,k1) = troco2(i,k1)*absbnd*co2plk(i) + ex = exp(960._r8/tint(i,k1)) + exm1sq = (ex - 1._r8)**2 + co2em(i,k1) = 1.2e11_r8*ex/(tint(i,k1)*tint4(i,k1)*exm1sq) + end do +! +! O3 emissivity +! + do i=1,ncol + h2otr(i,k1) = exp(-12._r8*s2c(i,k1)) + h2otr(i,k1)=h2otr(i,k1)*aer_trn_ttl(i,k1,1,idx_LW_1000_1200) + te = (co2t(i,k1)/293._r8)**.7_r8 + u1 = 18.29_r8*plos(i,k1)/te + u2 = .5649_r8*plos(i,k1)/te + phat = plos(i,k1)/plol(i,k1) + tlocal = tplnke(i) + tcrfac = sqrt(tlocal*r250)*te + beta = (1._r8/.3205_r8)*((1._r8/phat) + (dpfo3*tcrfac)) + realnu = (1._r8/beta)*te + o3bndi = 74._r8*te*(tplnke(i)/375._r8)*log(1._r8 + fo3(u1,realnu) + fo3(u2,realnu)) + o3ems(i,k1) = dbvtt(i)*h2otr(i,k1)*o3bndi + to3(i)=1.0_r8/(1._r8 + 0.1_r8*fo3(u1,realnu) + 0.1_r8*fo3(u2,realnu)) + end do +! +! Calculate trace gas emissivities +! + call trcems(ncol , & + k1 ,co2t ,pnm ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,bn2o0 ,bn2o1 ,uch4 , & + bch4 ,uco211 ,uco212 ,uco213 ,uco221 , & + uco222 ,uco223 ,uptype ,w ,s2c , & + u ,emplnk ,th2o ,tco2 ,to3 , & + emstrc , & + aer_trn_ttl) +! +! Total emissivity: +! + do i=1,ncol + emstot(i,k1) = h2oems(i,k1) + co2ems(i,k1) + o3ems(i,k1) & + + emstrc(i,k1) + end do + end do ! End of interface loop + +end subroutine radems + +!==================================================================================== + +subroutine radtpl(ncol , & + tnm ,lwupcgs ,qnm ,pnm ,plco2 ,plh2o , & + tplnka ,s2c ,tcg ,w ,tplnke , & + tint ,tint4 ,tlayr ,tlayr4 ,pmln , & + piln ,plh2ob ,wb ,co2mmr) +!-------------------------------------------------------------------- +! +! Purpose: +! Compute temperatures and path lengths for longwave radiation +! +! Method: +! +! +! +! Author: CCM1 +!------------------------------Arguments----------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: tnm(pcols,pver) ! Model level temperatures + real(r8), intent(in) :: lwupcgs(pcols) ! Surface longwave up flux + real(r8), intent(in) :: qnm(pcols,pver) ! Model level specific humidity + real(r8), intent(in) :: pnm(pcols,pverp) ! Pressure at model interfaces (dynes/cm2) + real(r8), intent(in) :: pmln(pcols,pver) ! Ln(pmidm1) + real(r8), intent(in) :: piln(pcols,pverp) ! Ln(pintm1) + real(r8), intent(in) :: co2mmr(pcols) ! co2 column mean mass mixing ratio +! +! Output arguments +! + real(r8), intent(out) :: plco2(pcols,pverp) ! Pressure weighted co2 path + real(r8), intent(out) :: plh2o(pcols,pverp) ! Pressure weighted h2o path + real(r8), intent(out) :: tplnka(pcols,pverp) ! Level temperature from interface temperatures + real(r8), intent(out) :: s2c(pcols,pverp) ! H2o continuum path length + real(r8), intent(out) :: tcg(pcols,pverp) ! H2o-mass-wgted temp. (Curtis-Godson approx.) + real(r8), intent(out) :: w(pcols,pverp) ! H2o path length + real(r8), intent(out) :: tplnke(pcols) ! Equal to tplnka + real(r8), intent(out) :: tint(pcols,pverp) ! Layer interface temperature + real(r8), intent(out) :: tint4(pcols,pverp) ! Tint to the 4th power + real(r8), intent(out) :: tlayr(pcols,pverp) ! K-1 level temperature + real(r8), intent(out) :: tlayr4(pcols,pverp) ! Tlayr to the 4th power + real(r8), intent(out) :: plh2ob(nbands,pcols,pverp)! Pressure weighted h2o path with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + real(r8), intent(out) :: wb(nbands,pcols,pverp) ! H2o path length with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + +! +!---------------------------Local variables-------------------------- +! + integer i ! Longitude index + integer k ! Level index + integer kp1 ! Level index + 1 + + real(r8) repsil ! Inver ratio mol weight h2o to dry air + real(r8) dy ! Thickness of layer for tmp interp + real(r8) dpnm ! Pressure thickness of layer + real(r8) dpnmsq ! Prs squared difference across layer + real(r8) dw ! Increment in H2O path length + real(r8) dplh2o ! Increment in plh2o + real(r8) cpwpl ! Const in co2 mix ratio to path length conversn + +!-------------------------------------------------------------------- +! + repsil = 1._r8/epsilo +! +! Compute co2 and h2o paths +! + cpwpl = 0.5_r8/(gravit_cgs*p0) + do i=1,ncol + plh2o(i,ntoplw) = rgsslp*qnm(i,ntoplw)*pnm(i,ntoplw)*pnm(i,ntoplw) + plco2(i,ntoplw) = co2mmr(i)*cpwpl*pnm(i,ntoplw)*pnm(i,ntoplw) + end do + do k=ntoplw,pver + do i=1,ncol + plh2o(i,k+1) = plh2o(i,k) + rgsslp* & + (pnm(i,k+1)**2 - pnm(i,k)**2)*qnm(i,k) + plco2(i,k+1) = co2mmr(i)*cpwpl*pnm(i,k+1)**2 + end do + end do +! +! Set the top and bottom intermediate level temperatures, +! top level planck temperature and top layer temp**4. +! +! Tint is lower interface temperature +! (not available for bottom layer, so use ground temperature) +! + do i=1,ncol + tint4(i,pverp) = lwupcgs(i)/stebol_cgs + tint(i,pverp) = sqrt(sqrt(tint4(i,pverp))) + tplnka(i,ntoplw) = tnm(i,ntoplw) + tint(i,ntoplw) = tplnka(i,ntoplw) + tlayr4(i,ntoplw) = tplnka(i,ntoplw)**4 + tint4(i,ntoplw) = tlayr4(i,ntoplw) + end do +! +! Intermediate level temperatures are computed using temperature +! at the full level below less dy*delta t,between the full level +! + do k=ntoplw+1,pver + do i=1,ncol + dy = (piln(i,k) - pmln(i,k))/(pmln(i,k-1) - pmln(i,k)) + tint(i,k) = tnm(i,k) - dy*(tnm(i,k)-tnm(i,k-1)) + tint4(i,k) = tint(i,k)**4 + end do + end do +! +! Now set the layer temp=full level temperatures and establish a +! planck temperature for absorption (tplnka) which is the average +! the intermediate level temperatures. Note that tplnka is not +! equal to the full level temperatures. +! + do k=ntoplw+1,pverp + do i=1,ncol + tlayr(i,k) = tnm(i,k-1) + tlayr4(i,k) = tlayr(i,k)**4 + tplnka(i,k) = .5_r8*(tint(i,k) + tint(i,k-1)) + end do + end do +! +! Calculate tplank for emissivity calculation. +! Assume isothermal tplnke i.e. all levels=ttop. +! + do i=1,ncol + tplnke(i) = tplnka(i,ntoplw) + tlayr(i,ntoplw) = tint(i,ntoplw) + end do +! +! Now compute h2o path fields: +! + do i=1,ncol +! +! Changed effective path temperature to std. Curtis-Godson form +! + tcg(i,ntoplw) = rga*qnm(i,ntoplw)*pnm(i,ntoplw)*tnm(i,ntoplw) + w(i,ntoplw) = sslp * (plh2o(i,ntoplw)*2._r8) / pnm(i,ntoplw) +! +! Hulst-Curtis-Godson scaling for H2O path +! + wb(1,i,ntoplw) = w(i,ntoplw) * phi(tnm(i,ntoplw),1) + wb(2,i,ntoplw) = w(i,ntoplw) * phi(tnm(i,ntoplw),2) +! +! Hulst-Curtis-Godson scaling for effective pressure along H2O path +! + plh2ob(1,i,ntoplw) = plh2o(i,ntoplw) * psi(tnm(i,ntoplw),1) + plh2ob(2,i,ntoplw) = plh2o(i,ntoplw) * psi(tnm(i,ntoplw),2) + + s2c(i,ntoplw) = plh2o(i,ntoplw)*fh2oself(tnm(i,ntoplw))*qnm(i,ntoplw)*repsil + end do + + do k=ntoplw,pver + do i=1,ncol + dpnm = pnm(i,k+1) - pnm(i,k) + dpnmsq = pnm(i,k+1)**2 - pnm(i,k)**2 + dw = rga*qnm(i,k)*dpnm + kp1 = k+1 + w(i,kp1) = w(i,k) + dw +! +! Hulst-Curtis-Godson scaling for H2O path +! + wb(1,i,kp1) = wb(1,i,k) + dw * phi(tnm(i,k),1) + wb(2,i,kp1) = wb(2,i,k) + dw * phi(tnm(i,k),2) +! +! Hulst-Curtis-Godson scaling for effective pressure along H2O path +! + dplh2o = plh2o(i,kp1) - plh2o(i,k) + + plh2ob(1,i,kp1) = plh2ob(1,i,k) + dplh2o * psi(tnm(i,k),1) + plh2ob(2,i,kp1) = plh2ob(2,i,k) + dplh2o * psi(tnm(i,k),2) +! +! Changed effective path temperature to std. Curtis-Godson form +! + tcg(i,kp1) = tcg(i,k) + dw*tnm(i,k) + s2c(i,kp1) = s2c(i,k) + rgsslp*dpnmsq*qnm(i,k)* & + fh2oself(tnm(i,k))*qnm(i,k)*repsil + end do + end do + +end subroutine radtpl + +!==================================================================================== + +subroutine radae_init( & + gravx, epsilox, stebol, pstdx, mwdryx, & + mwco2x, mwo3x, absems_data) +! +! Initialize radae module data +! + use pio, only: file_desc_t, var_desc_t, pio_inq_dimid, pio_inquire_dimension, & + pio_inquire_variable, pio_inq_varid, pio_get_var, pio_nowrite, & + pio_max_var_dims, pio_max_name, pio_closefile + use cam_pio_utils,only: cam_pio_openfile + use ioFileMod, only: getfil +! +! Input variables +! + real(r8), intent(in) :: gravx ! Acceleration due to gravity (m/s**2) + real(r8), intent(in) :: epsilox ! Ratio of mol. wght of H2O to dry air + real(r8), intent(in) :: stebol ! Stefan-Boltzmann's constant (MKS) + real(r8), intent(in) :: pstdx ! Standard pressure (pascals) + real(r8), intent(in) :: mwdryx ! Molecular weight of dry air + real(r8), intent(in) :: mwco2x ! Molecular weight of carbon dioxide + real(r8), intent(in) :: mwo3x ! Molecular weight of ozone + + character(len=*) :: absems_data ! full pathname for time-invariant absorption dataset + +! +! Variables for loading absorptivity/emissivity +! + type(file_desc_T) :: ncid_ae ! NetCDF file id for abs/ems file + + integer pdimid ! pressure dimension id + integer psize ! pressure dimension size + + integer tpdimid ! path temperature dimension id + integer tpsize ! path temperature size + + integer tedimid ! emission temperature dimension id + integer tesize ! emission temperature size + + integer udimid ! u (H2O path) dimension id + integer usize ! u (H2O path) dimension size + + integer rhdimid ! relative humidity dimension id + integer rhsize ! relative humidity dimension size + + type(var_desc_t) :: ah2onwid ! var. id for non-wndw abs. + type(var_desc_t) :: eh2onwid ! var. id for non-wndw ems. + type(var_desc_t) :: ah2owid ! var. id for wndw abs. (adjacent layers) + type(var_desc_t) :: cn_ah2owid ! var. id for continuum trans. for wndw abs. + type(var_desc_t) :: cn_eh2owid ! var. id for continuum trans. for wndw ems. + type(var_desc_t) :: ln_ah2owid ! var. id for line trans. for wndw abs. + type(var_desc_t) :: ln_eh2owid ! var. id for line trans. for wndw ems. + + character*(PIO_MAX_NAME) tmpname! dummy variable for var/dim names + character(len=256) locfn ! local filename + integer tmptype ! dummy variable for variable type + integer ndims ! number of dimensions + integer dims(PIO_MAX_VAR_DIMS) ! vector of dimension ids + integer natt ! number of attributes + + integer ierr ! ierr flag returned from pio (pio handles errors internally so it is not checked) +! +! Constants to set +! + gravit = gravx + gravit_cgs = 100._r8*gravx + rga = 1._r8/gravit_cgs + epsilo = epsilox + omeps = 1._r8 - epsilo + sslp = 1.013250e6_r8 + stebol_cgs = 1.e3_r8*stebol + rgsslp = 0.5_r8/(gravit_cgs*sslp) + dpfo3 = 2.5e-3_r8 + dpfco2 = 5.0e-3_r8 + + p0 = pstdx*10.0_r8 + amd = mwdryx + amco2 = mwco2x + mwo3 = mwo3x +! +! Coefficients for h2o emissivity and absorptivity for overlap of H2O +! and trace gases. +! + c16 = coefj(3,1)/coefj(2,1) + c17 = coefk(3,1)/coefk(2,1) + c26 = coefj(3,2)/coefj(2,2) + c27 = coefk(3,2)/coefk(2,2) + c28 = .5_r8 + c29 = .002053_r8 + c30 = .1_r8 + c31 = 3.0e-5_r8 +! +! Initialize further longwave constants referring to far wing +! correction for overlap of H2O and trace gases; R&D refers to: +! +! Ramanathan, V. and P.Downey, 1986: A Nonisothermal +! Emissivity and Absorptivity Formulation for Water Vapor +! Journal of Geophysical Research, vol. 91., D8, pp 8649-8666 +! + fwcoef = .1_r8 ! See eq(33) R&D + fwc1 = .30_r8 ! See eq(33) R&D + fwc2 = 4.5_r8 ! See eq(33) and eq(34) in R&D + fc1 = 2.6_r8 ! See eq(34) R&D + + call getfil(absems_data, locfn) + call cam_pio_openfile(ncid_ae, locfn, PIO_NOWRITE) + + ierr = pio_inq_dimid(ncid_ae, 'p', pdimid) + ierr = pio_inquire_dimension(ncid_ae, pdimid, len=psize) + + ierr = pio_inq_dimid(ncid_ae, 'tp', tpdimid) + ierr = pio_inquire_dimension(ncid_ae, tpdimid, len=tpsize) + + ierr = pio_inq_dimid(ncid_ae, 'te', tedimid) + ierr = pio_inquire_dimension(ncid_ae, tedimid, len=tesize) + + ierr = pio_inq_dimid(ncid_ae, 'u', udimid) + ierr = pio_inquire_dimension(ncid_ae, udimid, len=usize) + + ierr = pio_inq_dimid(ncid_ae, 'rh', rhdimid) + ierr = pio_inquire_dimension(ncid_ae, rhdimid, len=rhsize) + + if (psize /= n_p .or. & + tpsize /= n_tp .or. & + usize /= n_u .or. & + tesize /= n_te .or. & + rhsize /= n_rh) then + call endrun ('RADAEINI: dimensions for abs/ems do not match internal def.') + endif + + ierr = pio_inq_varid(ncid_ae, 'ah2onw', ah2onwid) + ierr = pio_inq_varid(ncid_ae, 'eh2onw', eh2onwid) + ierr = pio_inq_varid(ncid_ae, 'ah2ow', ah2owid) + ierr = pio_inq_varid(ncid_ae, 'cn_ah2ow', cn_ah2owid) + ierr = pio_inq_varid(ncid_ae, 'cn_eh2ow', cn_eh2owid) + ierr = pio_inq_varid(ncid_ae, 'ln_ah2ow', ln_ah2owid) + ierr = pio_inq_varid(ncid_ae, 'ln_eh2ow', ln_eh2owid) + + ierr = pio_inquire_variable(ncid_ae, ah2onwid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: non-wndw abs. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, eh2onwid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: non-wndw ems. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, ah2owid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: window abs. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, cn_ah2owid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: cont. trans for abs. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, cn_eh2owid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: cont. trans. for ems. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, ln_ah2owid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: line trans for abs. in file /= internal def.') + endif + ierr = pio_inquire_variable(ncid_ae, ln_eh2owid, tmpname, tmptype, ndims, dims, natt) + if (ndims /= 5 .or. & + dims(1) /= pdimid .or. & + dims(2) /= tpdimid .or. & + dims(3) /= udimid .or. & + dims(4) /= tedimid .or. & + dims(5) /= rhdimid) then + call endrun ('RADAEINI: line trans. for ems. in file /= internal def.') + endif + + ierr = pio_get_var (ncid_ae, ah2onwid, ah2onw) + ierr = pio_get_var (ncid_ae, eh2onwid, eh2onw) + ierr = pio_get_var (ncid_ae, ah2owid, ah2ow) + ierr = pio_get_var (ncid_ae, cn_ah2owid, cn_ah2ow) + ierr = pio_get_var (ncid_ae, cn_eh2owid, cn_eh2ow) + ierr = pio_get_var (ncid_ae, ln_ah2owid, ln_ah2ow) + ierr = pio_get_var (ncid_ae, ln_eh2owid, ln_eh2ow) + + call pio_closefile(ncid_ae) + + ! check whether arrays have already been allocated before calling + ! initialize_radbuffer. This will be the case for restart and branch + ! runs since those arrays are restored from the restart file before + ! this routine is called. + if (.not. allocated(abstot_3d)) call initialize_radbuffer() + +end subroutine radae_init + +!==================================================================================== + +subroutine initialize_radbuffer +! +! Initialize radiation buffer data +! + + use ref_pres, only : pref_mid + use phys_control, only : phys_getopts + + character(len=16) :: radiation_scheme + integer :: k + +! If the top model level is above ~90 km (0.1 Pa), set the top level to compute +! longwave cooling to about 80 km (1 Pa) + if (pref_mid(1) .lt. 0.1_r8) then + do k = 1, plev + if (pref_mid(k) .lt. 1._r8) ntoplw = k + end do + else + ntoplw = 1 + end if + if (masterproc) then + write(iulog,*) 'INITIALIZE_RADBUFFER: ntoplw =',ntoplw, ' pressure:',pref_mid(ntoplw) + endif + + call phys_getopts(radiation_scheme_out=radiation_scheme) + + if(radiation_scheme.eq.'camrt') then + allocate (abstot_3d(pcols,ntoplw:pverp,ntoplw:pverp,begchunk:endchunk)) + allocate (absnxt_3d(pcols,pver,4,begchunk:endchunk)) + allocate (emstot_3d(pcols,pverp,begchunk:endchunk)) + abstot_3d(:,:,:,:) = posinf + absnxt_3d(:,:,:,:) = posinf + emstot_3d(:,:,:) = posinf + end if + return +end subroutine initialize_radbuffer + +!==================================================================================== + +subroutine radoz2(ncol, o3, pint, plol, plos) +!----------------------------------------------------------------------- +! +! Purpose: +! Computes the path length integrals to the model interfaces given the +! ozone volume mixing ratio +! +! Method: +! +! +! +! Author: CCM1, CMS Contact J. Kiehl +! +!------------------------------Input arguments-------------------------- +! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: o3(pcols,pver) ! ozone mass mixing ratio + real(r8), intent(in) :: pint(pcols,pverp) ! Model interface pressures +! +!----------------------------Output arguments--------------------------- +! + real(r8), intent(out) :: plol(pcols,pverp) ! Ozone prs weighted path length (cm) + real(r8), intent(out) :: plos(pcols,pverp) ! Ozone path length (cm) +! +!---------------------------Local workspace----------------------------- +! + integer i ! longitude index + integer k ! level index + + real(r8) :: v0 ! Volume of a gas at stp (m**3/kmol) + real(r8) :: p0 ! Standard pressure (pascals) + real(r8) :: cplos ! constant for ozone path length integral + real(r8) :: cplol ! constant for ozone path length integral + +! +!----------------------------------------------------------------------- +!******************************************************************* +! These hardwired constants need to be replaced with common values. +! They are here for testing infrastructure changes that should not +! change answers. +! Constants for ozone path integrals (multiplication by 100 for unit +! conversion to cgs from mks): +! + v0 = 22.4136_r8 ! Volume of a gas at stp (m**3/kmol) + p0 = 0.1_r8*sslp ! Standard pressure (pascals) + cplos = v0/(mwo3*gravit) *100.0_r8 + cplol = v0/(mwo3*gravit*p0)*0.5_r8*100.0_r8 +!******************************************************************* +! +! Evaluate the ozone path length integrals to interfaces; +! factors of .1 and .01 to convert pressures from cgs to mks: +! + do i=1,ncol + plos(i,ntoplw) = 0.1_r8 *cplos*o3(i,ntoplw)*pint(i,ntoplw) + plol(i,ntoplw) = 0.01_r8*cplol*o3(i,ntoplw)*pint(i,ntoplw)*pint(i,ntoplw) + end do + do k=ntoplw+1,pverp + do i=1,ncol + plos(i,k) = plos(i,k-1) + 0.1_r8*cplos*o3(i,k-1)*(pint(i,k) - pint(i,k-1)) + plol(i,k) = plol(i,k-1) + 0.01_r8*cplol*o3(i,k-1)* & + (pint(i,k)*pint(i,k) - pint(i,k-1)*pint(i,k-1)) + end do + end do + +end subroutine radoz2 + +!==================================================================================== + +subroutine trcpth(ncol , & + tnm ,pnm ,cfc11 ,cfc12 ,n2o , & + ch4 ,qnm ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,bn2o0 ,bn2o1 , & + bch4 ,uptype ,co2mmr) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate path lengths and pressure factors for CH4, N2O, CFC11 +! and CFC12. +! +! Method: +! See CCM3 description for details +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: tnm(pcols,pver) ! Model level temperatures + real(r8), intent(in) :: pnm(pcols,pverp) ! Pres. at model interfaces (dynes/cm2) + real(r8), intent(in) :: qnm(pcols,pver) ! h2o specific humidity + real(r8), intent(in) :: cfc11(pcols,pver) ! CFC11 mass mixing ratio +! + real(r8), intent(in) :: cfc12(pcols,pver) ! CFC12 mass mixing ratio + real(r8), intent(in) :: n2o(pcols,pver) ! N2O mass mixing ratio + real(r8), intent(in) :: ch4(pcols,pver) ! CH4 mass mixing ratio + real(r8), intent(in) :: co2mmr(pcols) ! co2 column mean mass mixing ratio + +! +! Output arguments +! + real(r8), intent(out) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(out) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(out) :: un2o0(pcols,pverp) ! N2O path length + real(r8), intent(out) :: un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8), intent(out) :: uch4(pcols,pverp) ! CH4 path length +! + real(r8), intent(out) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(out) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(out) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(out) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(out) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length +! + real(r8), intent(out) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(out) :: bn2o0(pcols,pverp) ! pressure factor for n2o + real(r8), intent(out) :: bn2o1(pcols,pverp) ! pressure factor for n2o + real(r8), intent(out) :: bch4(pcols,pverp) ! pressure factor for ch4 + real(r8), intent(out) :: uptype(pcols,pverp) ! p-type continuum path length + +! +!---------------------------Local variables----------------------------- +! + integer i ! Longitude index + integer k ! Level index +! + real(r8) co2fac(pcols,1) ! co2 factor + real(r8) alpha1(pcols) ! stimulated emission term + real(r8) alpha2(pcols) ! stimulated emission term + real(r8) rt(pcols) ! reciprocal of local temperature + real(r8) rsqrt(pcols) ! reciprocal of sqrt of temp +! + real(r8) pbar(pcols) ! mean pressure + real(r8) dpnm(pcols) ! difference in pressure + real(r8) diff ! diffusivity factor +! +!--------------------------Data Statements------------------------------ +! + data diff /1.66_r8/ +! +!----------------------------------------------------------------------- +! +! Calculate path lengths for the trace gases at model top +! + + do i = 1,ncol + ucfc11(i,ntoplw) = 1.8_r8 * cfc11(i,ntoplw) * pnm(i,ntoplw) * rga + ucfc12(i,ntoplw) = 1.8_r8 * cfc12(i,ntoplw) * pnm(i,ntoplw) * rga + un2o0(i,ntoplw) = diff * 1.02346e5_r8 * n2o(i,ntoplw) * pnm(i,ntoplw) * rga / sqrt(tnm(i,ntoplw)) + un2o1(i,ntoplw) = diff * 2.01909_r8 * un2o0(i,ntoplw) * exp(-847.36_r8/tnm(i,ntoplw)) + uch4(i,ntoplw) = diff * 8.60957e4_r8 * ch4(i,ntoplw) * pnm(i,ntoplw) * rga / sqrt(tnm(i,ntoplw)) + co2fac(i,1) = diff * co2mmr(i) * pnm(i,ntoplw) * rga + alpha1(i) = (1.0_r8 - exp(-1540.0_r8/tnm(i,ntoplw)))**3.0_r8/sqrt(tnm(i,ntoplw)) + alpha2(i) = (1.0_r8 - exp(-1360.0_r8/tnm(i,ntoplw)))**3.0_r8/sqrt(tnm(i,ntoplw)) + uco211(i,ntoplw) = 3.42217e3_r8 * co2fac(i,1) * alpha1(i) * exp(-1849.7_r8/tnm(i,ntoplw)) + uco212(i,ntoplw) = 6.02454e3_r8 * co2fac(i,1) * alpha1(i) * exp(-2782.1_r8/tnm(i,ntoplw)) + uco213(i,ntoplw) = 5.53143e3_r8 * co2fac(i,1) * alpha1(i) * exp(-3723.2_r8/tnm(i,ntoplw)) + uco221(i,ntoplw) = 3.88984e3_r8 * co2fac(i,1) * alpha2(i) * exp(-1997.6_r8/tnm(i,ntoplw)) + uco222(i,ntoplw) = 3.67108e3_r8 * co2fac(i,1) * alpha2(i) * exp(-3843.8_r8/tnm(i,ntoplw)) + uco223(i,ntoplw) = 6.50642e3_r8 * co2fac(i,1) * alpha2(i) * exp(-2989.7_r8/tnm(i,ntoplw)) + bn2o0(i,ntoplw) = diff * 19.399_r8 * pnm(i,ntoplw)**2.0_r8 * n2o(i,ntoplw) * & + 1.02346e5_r8 * rga / (sslp*tnm(i,ntoplw)) + bn2o1(i,ntoplw) = bn2o0(i,ntoplw) * exp(-847.36_r8/tnm(i,ntoplw)) * 2.06646e5_r8 + bch4(i,ntoplw) = diff * 2.94449_r8 * ch4(i,ntoplw) * pnm(i,ntoplw)**2.0_r8 * rga * & + 8.60957e4_r8 / (sslp*tnm(i,ntoplw)) + uptype(i,ntoplw) = diff * qnm(i,ntoplw) * pnm(i,ntoplw)**2.0_r8 * & + exp(1800.0_r8*(1.0_r8/tnm(i,ntoplw) - 1.0_r8/296.0_r8)) * rga / sslp + end do +! +! Calculate trace gas path lengths through model atmosphere +! + do k = ntoplw,pver + do i = 1,ncol + rt(i) = 1._r8/tnm(i,k) + rsqrt(i) = sqrt(rt(i)) + pbar(i) = 0.5_r8 * (pnm(i,k+1) + pnm(i,k)) / sslp + dpnm(i) = (pnm(i,k+1) - pnm(i,k)) * rga + alpha1(i) = diff * rsqrt(i) * (1.0_r8 - exp(-1540.0_r8/tnm(i,k)))**3.0_r8 + alpha2(i) = diff * rsqrt(i) * (1.0_r8 - exp(-1360.0_r8/tnm(i,k)))**3.0_r8 + ucfc11(i,k+1) = ucfc11(i,k) + 1.8_r8 * cfc11(i,k) * dpnm(i) + ucfc12(i,k+1) = ucfc12(i,k) + 1.8_r8 * cfc12(i,k) * dpnm(i) + un2o0(i,k+1) = un2o0(i,k) + diff * 1.02346e5_r8 * n2o(i,k) * rsqrt(i) * dpnm(i) + un2o1(i,k+1) = un2o1(i,k) + diff * 2.06646e5_r8 * n2o(i,k) * & + rsqrt(i) * exp(-847.36_r8/tnm(i,k)) * dpnm(i) + uch4(i,k+1) = uch4(i,k) + diff * 8.60957e4_r8 * ch4(i,k) * rsqrt(i) * dpnm(i) + uco211(i,k+1) = uco211(i,k) + 1.15_r8*3.42217e3_r8 * alpha1(i) * & + co2mmr(i) * exp(-1849.7_r8/tnm(i,k)) * dpnm(i) + uco212(i,k+1) = uco212(i,k) + 1.15_r8*6.02454e3_r8 * alpha1(i) * & + co2mmr(i) * exp(-2782.1_r8/tnm(i,k)) * dpnm(i) + uco213(i,k+1) = uco213(i,k) + 1.15_r8*5.53143e3_r8 * alpha1(i) * & + co2mmr(i) * exp(-3723.2_r8/tnm(i,k)) * dpnm(i) + uco221(i,k+1) = uco221(i,k) + 1.15_r8*3.88984e3_r8 * alpha2(i) * & + co2mmr(i) * exp(-1997.6_r8/tnm(i,k)) * dpnm(i) + uco222(i,k+1) = uco222(i,k) + 1.15_r8*3.67108e3_r8 * alpha2(i) * & + co2mmr(i) * exp(-3843.8_r8/tnm(i,k)) * dpnm(i) + uco223(i,k+1) = uco223(i,k) + 1.15_r8*6.50642e3_r8 * alpha2(i) * & + co2mmr(i) * exp(-2989.7_r8/tnm(i,k)) * dpnm(i) + bn2o0(i,k+1) = bn2o0(i,k) + diff * 19.399_r8 * pbar(i) * rt(i) & + * 1.02346e5_r8 * n2o(i,k) * dpnm(i) + bn2o1(i,k+1) = bn2o1(i,k) + diff * 19.399_r8 * pbar(i) * rt(i) & + * 2.06646e5_r8 * exp(-847.36_r8/tnm(i,k)) * n2o(i,k)*dpnm(i) + bch4(i,k+1) = bch4(i,k) + diff * 2.94449_r8 * rt(i) * pbar(i) & + * 8.60957e4_r8 * ch4(i,k) * dpnm(i) + uptype(i,k+1) = uptype(i,k) + diff *qnm(i,k) * & + exp(1800.0_r8*(1.0_r8/tnm(i,k) - 1.0_r8/296.0_r8)) * pbar(i) * dpnm(i) + end do + end do +! + return +end subroutine trcpth + + + +!==================================================================================== +! Private Interfaces +!==================================================================================== + +function fh2oself( temp ) +! +! Short function for H2O self-continuum temperature factor in +! calculation of effective H2O self-continuum path length +! +! H2O Continuum: CKD 2.4 +! Code for continuum: GENLN3 +! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric +! Transmittance and Radiance Model, Version 3.0 Description +! and Users Guide, NCAR/TN-367+STR, 147 pp. +! +! In GENLN, the temperature scaling of the self-continuum is handled +! by exponential interpolation/extrapolation from observations at +! 260K and 296K by: +! +! TFAC = (T(IPATH) - 296.0)/(260.0 - 296.0) +! CSFFT = CSFF296*(CSFF260/CSFF296)**TFAC +! +! For 800-1200 cm^-1, (CSFF260/CSFF296) ranges from ~2.1 to ~1.9 +! with increasing wavenumber. The ratio /, +! where <> indicates average over wavenumber, is ~2.07 +! +! fh2oself is (/)**TFAC +! + real(r8),intent(in) :: temp ! path temperature + real(r8) fh2oself ! mean ratio of self-continuum at temp and 296K + + fh2oself = 2.0727484_r8**((296.0_r8 - temp) / 36.0_r8) +end function fh2oself + +!==================================================================================== + +function phi(tpx,iband) +! +! History: First version for Hitran 1996 (C/H/E) +! Current version for Hitran 2000 (C/LT/E) +! Short function for Hulst-Curtis-Godson temperature factors for +! computing effective H2O path +! Line data for H2O: Hitran 2000, plus H2O patches v11.0 for 1341 missing +! lines between 500 and 2820 cm^-1. +! See cfa-www.harvard.edu/HITRAN +! Isotopes of H2O: all +! Line widths: air-broadened only (self set to 0) +! Code for line strengths and widths: GENLN3 +! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric +! Transmittance and Radiance Model, Version 3.0 Description +! and Users Guide, NCAR/TN-367+STR, 147 pp. +! +! Note: functions have been normalized by dividing by their values at +! a path temperature of 160K +! +! spectral intervals: +! 1 = 0-800 cm^-1 and 1200-2200 cm^-1 +! 2 = 800-1200 cm^-1 +! +! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, +! 2nd edition, Oxford University Press, 1989. +! Phi: function for H2O path +! eq. 6.25, p. 228 +! + real(r8),intent(in):: tpx ! path temperature + integer, intent(in):: iband ! band to process + real(r8) phi ! phi for given band + real(r8),parameter :: phi_r0(nbands) = (/ 9.60917711E-01_r8, -2.21031342E+01_r8/) + real(r8),parameter :: phi_r1(nbands) = (/ 4.86076751E-04_r8, 4.24062610E-01_r8/) + real(r8),parameter :: phi_r2(nbands) = (/-1.84806265E-06_r8, -2.95543415E-03_r8/) + real(r8),parameter :: phi_r3(nbands) = (/ 2.11239959E-09_r8, 7.52470896E-06_r8/) + + phi = (((phi_r3(iband) * tpx) + phi_r2(iband)) * tpx + phi_r1(iband)) & + * tpx + phi_r0(iband) +end function phi + +!==================================================================================== + +function psi(tpx,iband) +! +! History: First version for Hitran 1996 (C/H/E) +! Current version for Hitran 2000 (C/LT/E) +! Short function for Hulst-Curtis-Godson temperature factors for +! computing effective H2O path +! Line data for H2O: Hitran 2000, plus H2O patches v11.0 for 1341 missing +! lines between 500 and 2820 cm^-1. +! See cfa-www.harvard.edu/HITRAN +! Isotopes of H2O: all +! Line widths: air-broadened only (self set to 0) +! Code for line strengths and widths: GENLN3 +! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric +! Transmittance and Radiance Model, Version 3.0 Description +! and Users Guide, NCAR/TN-367+STR, 147 pp. +! +! Note: functions have been normalized by dividing by their values at +! a path temperature of 160K +! +! spectral intervals: +! 1 = 0-800 cm^-1 and 1200-2200 cm^-1 +! 2 = 800-1200 cm^-1 +! +! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, +! 2nd edition, Oxford University Press, 1989. +! Psi: function for pressure along path +! eq. 6.30, p. 228 +! + real(r8),intent(in):: tpx ! path temperature + integer, intent(in):: iband ! band to process + real(r8) psi ! psi for given band + real(r8),parameter :: psi_r0(nbands) = (/ 5.65308452E-01_r8, -7.30087891E+01_r8/) + real(r8),parameter :: psi_r1(nbands) = (/ 4.07519005E-03_r8, 1.22199547E+00_r8/) + real(r8),parameter :: psi_r2(nbands) = (/-1.04347237E-05_r8, -7.12256227E-03_r8/) + real(r8),parameter :: psi_r3(nbands) = (/ 1.23765354E-08_r8, 1.47852825E-05_r8/) + + psi = (((psi_r3(iband) * tpx) + psi_r2(iband)) * tpx + psi_r1(iband)) * tpx + psi_r0(iband) + +end function psi + +!==================================================================================== + +subroutine trcab(ncol , & + k1 ,k2 ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,bn2o0 ,bn2o1 , & + bch4 ,to3co2 ,pnm ,dw ,pnew , & + s2c ,uptype ,dplh2o ,abplnk1 ,tco2 , & + th2o ,to3 ,abstrc , & + aer_trn_ttl) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate absorptivity for non nearest layers for CH4, N2O, CFC11 and +! CFC12. +! +! Method: +! See CCM3 description for equations. +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: k1,k2 ! level indices +! + real(r8), intent(in) :: to3co2(pcols) ! pressure weighted temperature + real(r8), intent(in) :: pnm(pcols,pverp) ! interface pressures + real(r8), intent(in) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(in) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(in) :: un2o0(pcols,pverp) ! N2O path length +! + real(r8), intent(in) :: un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8), intent(in) :: uch4(pcols,pverp) ! CH4 path length + real(r8), intent(in) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length +! + real(r8), intent(in) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: bn2o0(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bn2o1(pcols,pverp) ! pressure factor for n2o +! + real(r8), intent(in) :: bch4(pcols,pverp) ! pressure factor for ch4 + real(r8), intent(in) :: dw(pcols) ! h2o path length + real(r8), intent(in) :: pnew(pcols) ! pressure + real(r8), intent(in) :: s2c(pcols,pverp) ! continuum path length + real(r8), intent(in) :: uptype(pcols,pverp) ! p-type h2o path length +! + real(r8), intent(in) :: dplh2o(pcols) ! p squared h2o path length + real(r8), intent(in) :: abplnk1(14,pcols,pverp) ! Planck factor + real(r8), intent(in) :: tco2(pcols) ! co2 transmission factor + real(r8), intent(in) :: th2o(pcols) ! h2o transmission factor + real(r8), intent(in) :: to3(pcols) ! o3 transmission factor + + real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) ! aer trn. + +! +! Output Arguments +! + real(r8), intent(out) :: abstrc(pcols) ! total trace gas absorptivity +! +!--------------------------Local Variables------------------------------ +! + integer i,l ! loop counters + + real(r8) sqti(pcols) ! square root of mean temp + real(r8) du1 ! cfc11 path length + real(r8) du2 ! cfc12 path length + real(r8) acfc1 ! cfc11 absorptivity 798 cm-1 + real(r8) acfc2 ! cfc11 absorptivity 846 cm-1 +! + real(r8) acfc3 ! cfc11 absorptivity 933 cm-1 + real(r8) acfc4 ! cfc11 absorptivity 1085 cm-1 + real(r8) acfc5 ! cfc12 absorptivity 889 cm-1 + real(r8) acfc6 ! cfc12 absorptivity 923 cm-1 + real(r8) acfc7 ! cfc12 absorptivity 1102 cm-1 +! + real(r8) acfc8 ! cfc12 absorptivity 1161 cm-1 + real(r8) du01 ! n2o path length + real(r8) dbeta01 ! n2o pressure factor + real(r8) dbeta11 ! " + real(r8) an2o1 ! absorptivity of 1285 cm-1 n2o band +! + real(r8) du02 ! n2o path length + real(r8) dbeta02 ! n2o pressure factor + real(r8) an2o2 ! absorptivity of 589 cm-1 n2o band + real(r8) du03 ! n2o path length + real(r8) dbeta03 ! n2o pressure factor +! + real(r8) an2o3 ! absorptivity of 1168 cm-1 n2o band + real(r8) duch4 ! ch4 path length + real(r8) dbetac ! ch4 pressure factor + real(r8) ach4 ! absorptivity of 1306 cm-1 ch4 band + real(r8) du11 ! co2 path length +! + real(r8) du12 ! " + real(r8) du13 ! " + real(r8) dbetc1 ! co2 pressure factor + real(r8) dbetc2 ! co2 pressure factor + real(r8) aco21 ! absorptivity of 1064 cm-1 band +! + real(r8) du21 ! co2 path length + real(r8) du22 ! " + real(r8) du23 ! " + real(r8) aco22 ! absorptivity of 961 cm-1 band + real(r8) tt(pcols) ! temp. factor for h2o overlap factor +! + real(r8) psi1 ! " + real(r8) phi1 ! " + real(r8) p1 ! h2o overlap factor + real(r8) w1 ! " + real(r8) ds2c(pcols) ! continuum path length +! + real(r8) duptyp(pcols) ! p-type path length + real(r8) tw(pcols,6) ! h2o transmission factor +! real(r8) g1(6) ! " +! real(r8) g2(6) ! " +! real(r8) g3(6) ! " +! +! real(r8) g4(6) ! " +! real(r8) ab(6) ! h2o temp. factor +! real(r8) bb(6) ! " +! real(r8) abp(6) ! " +! real(r8) bbp(6) ! " +! + real(r8) tcfc3 ! transmission for cfc11 band + real(r8) tcfc4 ! transmission for cfc11 band + real(r8) tcfc6 ! transmission for cfc12 band + real(r8) tcfc7 ! transmission for cfc12 band + real(r8) tcfc8 ! transmission for cfc12 band +! + real(r8) tlw ! h2o transmission + real(r8) tch4 ! ch4 transmission +! +!--------------------------Data Statements------------------------------ +! +! data g1 /0.0468556_r8,0.0397454_r8,0.0407664_r8,0.0304380_r8,0.0540398_r8,0.0321962_r8/ +! data g2 /14.4832_r8,4.30242_r8,5.23523_r8,3.25342_r8,0.698935_r8,16.5599_r8/ +! data g3 /26.1898_r8,18.4476_r8,15.3633_r8,12.1927_r8,9.14992_r8,8.07092_r8/ +! data g4 /0.0261782_r8,0.0369516_r8,0.0307266_r8,0.0243854_r8,0.0182932_r8,0.0161418_r8/ +! data ab /3.0857e-2_r8,2.3524e-2_r8,1.7310e-2_r8,2.6661e-2_r8,2.8074e-2_r8,2.2915e-2_r8/ +! data bb /-1.3512e-4_r8,-6.8320e-5_r8,-3.2609e-5_r8,-1.0228e-5_r8,-9.5743e-5_r8,-1.0304e-4_r8/ +! data abp/2.9129e-2_r8,2.4101e-2_r8,1.9821e-2_r8,2.6904e-2_r8,2.9458e-2_r8,1.9892e-2_r8/ +! data bbp/-1.3139e-4_r8,-5.5688e-5_r8,-4.6380e-5_r8,-8.0362e-5_r8,-1.0115e-4_r8,-8.8061e-5_r8/ +! +!--------------------------Statement Functions-------------------------- +! + real(r8) func, u, b + func(u,b) = u/sqrt(4.0_r8 + u*(1.0_r8 + 1.0_r8 / b)) +! +!------------------------------------------------------------------------ +! + do i = 1,ncol + sqti(i) = sqrt(to3co2(i)) +! +! h2o transmission +! + tt(i) = abs(to3co2(i) - 250.0_r8) + ds2c(i) = abs(s2c(i,k1) - s2c(i,k2)) + duptyp(i) = abs(uptype(i,k1) - uptype(i,k2)) + end do +! + do l = 1,6 + do i = 1,ncol + psi1 = exp(abp(l)*tt(i) + bbp(l)*tt(i)*tt(i)) + phi1 = exp(ab(l)*tt(i) + bb(l)*tt(i)*tt(i)) + p1 = pnew(i)*(psi1/phi1)/sslp + w1 = dw(i)*phi1 + tw(i,l) = exp(-g1(l)*p1*(sqrt(1.0_r8 + g2(l)*(w1/p1)) - 1.0_r8) - & + g3(l)*ds2c(i)-g4(l)*duptyp(i)) + end do + end do +! + do i=1,ncol + tw(i,1)=tw(i,1)*(0.7_r8*aer_trn_ttl(i,k1,k2,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1 + 0.3_r8*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000)) + tw(i,2)=tw(i,2)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1 + tw(i,3)=tw(i,3)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1 + tw(i,4)=tw(i,4)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1 + tw(i,5)=tw(i,5)*aer_trn_ttl(i,k1,k2,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1 + tw(i,6)=tw(i,6)*aer_trn_ttl(i,k1,k2,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1 + end do ! end loop over lon + do i = 1,ncol + du1 = abs(ucfc11(i,k1) - ucfc11(i,k2)) + du2 = abs(ucfc12(i,k1) - ucfc12(i,k2)) +! +! cfc transmissions +! + tcfc3 = exp(-175.005_r8*du1) + tcfc4 = exp(-1202.18_r8*du1) + tcfc6 = exp(-5786.73_r8*du2) + tcfc7 = exp(-2873.51_r8*du2) + tcfc8 = exp(-2085.59_r8*du2) +! +! Absorptivity for CFC11 bands +! + acfc1 = 50.0_r8*(1.0_r8 - exp(-54.09_r8*du1))*tw(i,1)*abplnk1(7,i,k2) + acfc2 = 60.0_r8*(1.0_r8 - exp(-5130.03_r8*du1))*tw(i,2)*abplnk1(8,i,k2) + acfc3 = 60.0_r8*(1.0_r8 - tcfc3)*tw(i,4)*tcfc6*abplnk1(9,i,k2) + acfc4 = 100.0_r8*(1.0_r8 - tcfc4)*tw(i,5)*abplnk1(10,i,k2) +! +! Absorptivity for CFC12 bands +! + acfc5 = 45.0_r8*(1.0_r8 - exp(-1272.35_r8*du2))*tw(i,3)*abplnk1(11,i,k2) + acfc6 = 50.0_r8*(1.0_r8 - tcfc6)* tw(i,4) * abplnk1(12,i,k2) + acfc7 = 80.0_r8*(1.0_r8 - tcfc7)* tw(i,5) * tcfc4*abplnk1(13,i,k2) + acfc8 = 70.0_r8*(1.0_r8 - tcfc8)* tw(i,6) * abplnk1(14,i,k2) +! +! Emissivity for CH4 band 1306 cm-1 +! + tlw = exp(-1.0_r8*sqrt(dplh2o(i))) + tlw=tlw*aer_trn_ttl(i,k1,k2,idx_LW_1200_2000) + duch4 = abs(uch4(i,k1) - uch4(i,k2)) + dbetac = abs(bch4(i,k1) - bch4(i,k2))/duch4 + ach4 = 6.00444_r8*sqti(i)*log(1.0_r8 + func(duch4,dbetac))*tlw*abplnk1(3,i,k2) + tch4 = 1.0_r8/(1.0_r8 + 0.02_r8*func(duch4,dbetac)) +! +! Absorptivity for N2O bands +! + du01 = abs(un2o0(i,k1) - un2o0(i,k2)) + du11 = abs(un2o1(i,k1) - un2o1(i,k2)) + dbeta01 = abs(bn2o0(i,k1) - bn2o0(i,k2))/du01 + dbeta11 = abs(bn2o1(i,k1) - bn2o1(i,k2))/du11 +! +! 1285 cm-1 band +! + an2o1 = 2.35558_r8*sqti(i)*log(1.0_r8 + func(du01,dbeta01) & + + func(du11,dbeta11))*tlw*tch4*abplnk1(4,i,k2) + du02 = 0.100090_r8*du01 + du12 = 0.0992746_r8*du11 + dbeta02 = 0.964282_r8*dbeta01 +! +! 589 cm-1 band +! + an2o2 = 2.65581_r8*sqti(i)*log(1.0_r8 + func(du02,dbeta02) + & + func(du12,dbeta02))*th2o(i)*tco2(i)*abplnk1(5,i,k2) + du03 = 0.0333767_r8*du01 + dbeta03 = 0.982143_r8*dbeta01 +! +! 1168 cm-1 band +! + an2o3 = 2.54034_r8*sqti(i)*log(1.0_r8 + func(du03,dbeta03))* & + tw(i,6)*tcfc8*abplnk1(6,i,k2) +! +! Emissivity for 1064 cm-1 band of CO2 +! + du11 = abs(uco211(i,k1) - uco211(i,k2)) + du12 = abs(uco212(i,k1) - uco212(i,k2)) + du13 = abs(uco213(i,k1) - uco213(i,k2)) + dbetc1 = 2.97558_r8*abs(pnm(i,k1) + pnm(i,k2))/(2.0_r8*sslp*sqti(i)) + dbetc2 = 2.0_r8*dbetc1 + aco21 = 3.7571_r8*sqti(i)*log(1.0_r8 + func(du11,dbetc1) & + + func(du12,dbetc2) + func(du13,dbetc2)) & + *to3(i)*tw(i,5)*tcfc4*tcfc7*abplnk1(2,i,k2) +! +! Emissivity for 961 cm-1 band +! + du21 = abs(uco221(i,k1) - uco221(i,k2)) + du22 = abs(uco222(i,k1) - uco222(i,k2)) + du23 = abs(uco223(i,k1) - uco223(i,k2)) + aco22 = 3.8443_r8*sqti(i)*log(1.0_r8 + func(du21,dbetc1) & + + func(du22,dbetc1) + func(du23,dbetc2)) & + *tw(i,4)*tcfc3*tcfc6*abplnk1(1,i,k2) +! +! total trace gas absorptivity +! + abstrc(i) = acfc1 + acfc2 + acfc3 + acfc4 + acfc5 + acfc6 + & + acfc7 + acfc8 + an2o1 + an2o2 + an2o3 + ach4 + & + aco21 + aco22 + end do + +end subroutine trcab + +!==================================================================================== + +subroutine trcabn(ncol , & + k2 ,kn ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,tbar ,bplnk , & + winpl ,pinpl ,tco2 ,th2o ,to3 , & + uptype ,dw ,s2c ,up2 ,pnew , & + abstrc ,uinpl , & + aer_trn_ngh) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate nearest layer absorptivity due to CH4, N2O, CFC11 and CFC12 +! +! Method: +! Equations in CCM3 description +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: k2 ! level index + integer, intent(in) :: kn ! level index +! + real(r8), intent(in) :: tbar(pcols,4) ! pressure weighted temperature + real(r8), intent(in) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(in) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(in) :: un2o0(pcols,pverp) ! N2O path length + real(r8), intent(in) :: un2o1(pcols,pverp) ! N2O path length (hot band) +! + real(r8), intent(in) :: uch4(pcols,pverp) ! CH4 path length + real(r8), intent(in) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length +! + real(r8), intent(in) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: bplnk(14,pcols,4) ! weighted Planck fnc. for absorptivity + real(r8), intent(in) :: winpl(pcols,4) ! fractional path length + real(r8), intent(in) :: pinpl(pcols,4) ! pressure factor for subdivided layer +! + real(r8), intent(in) :: tco2(pcols) ! co2 transmission + real(r8), intent(in) :: th2o(pcols) ! h2o transmission + real(r8), intent(in) :: to3(pcols) ! o3 transmission + real(r8), intent(in) :: dw(pcols) ! h2o path length + real(r8), intent(in) :: pnew(pcols) ! pressure factor +! + real(r8), intent(in) :: s2c(pcols,pverp) ! h2o continuum factor + real(r8), intent(in) :: uptype(pcols,pverp) ! p-type path length + real(r8), intent(in) :: up2(pcols) ! p squared path length + real(r8), intent(in) :: uinpl(pcols,4) ! Nearest layer subdivision factor + real(r8), intent(in) :: aer_trn_ngh(pcols,nlwbands) + ! [fraction] Total transmission between + ! nearest neighbor sub-levels +! +! Output Arguments +! + real(r8), intent(out) :: abstrc(pcols) ! total trace gas absorptivity + +! +!--------------------------Local Variables------------------------------ +! + integer i,l ! loop counters +! + real(r8) sqti(pcols) ! square root of mean temp + real(r8) rsqti(pcols) ! reciprocal of sqti + real(r8) du1 ! cfc11 path length + real(r8) du2 ! cfc12 path length + real(r8) acfc1 ! absorptivity of cfc11 798 cm-1 band +! + real(r8) acfc2 ! absorptivity of cfc11 846 cm-1 band + real(r8) acfc3 ! absorptivity of cfc11 933 cm-1 band + real(r8) acfc4 ! absorptivity of cfc11 1085 cm-1 band + real(r8) acfc5 ! absorptivity of cfc11 889 cm-1 band + real(r8) acfc6 ! absorptivity of cfc11 923 cm-1 band +! + real(r8) acfc7 ! absorptivity of cfc11 1102 cm-1 band + real(r8) acfc8 ! absorptivity of cfc11 1161 cm-1 band + real(r8) du01 ! n2o path length + real(r8) dbeta01 ! n2o pressure factors + real(r8) dbeta11 ! " +! + real(r8) an2o1 ! absorptivity of the 1285 cm-1 n2o band + real(r8) du02 ! n2o path length + real(r8) dbeta02 ! n2o pressure factor + real(r8) an2o2 ! absorptivity of the 589 cm-1 n2o band + real(r8) du03 ! n2o path length +! + real(r8) dbeta03 ! n2o pressure factor + real(r8) an2o3 ! absorptivity of the 1168 cm-1 n2o band + real(r8) duch4 ! ch4 path length + real(r8) dbetac ! ch4 pressure factor + real(r8) ach4 ! absorptivity of the 1306 cm-1 ch4 band +! + real(r8) du11 ! co2 path length + real(r8) du12 ! " + real(r8) du13 ! " + real(r8) dbetc1 ! co2 pressure factor + real(r8) dbetc2 ! co2 pressure factor +! + real(r8) aco21 ! absorptivity of the 1064 cm-1 co2 band + real(r8) du21 ! co2 path length + real(r8) du22 ! " + real(r8) du23 ! " + real(r8) aco22 ! absorptivity of the 961 cm-1 co2 band +! + real(r8) tt(pcols) ! temp. factor for h2o overlap + real(r8) psi1 ! " + real(r8) phi1 ! " + real(r8) p1 ! factor for h2o overlap + real(r8) w1 ! " +! + real(r8) ds2c(pcols) ! continuum path length + real(r8) duptyp(pcols) ! p-type path length + real(r8) tw(pcols,6) ! h2o transmission overlap +! real(r8) g1(6) ! h2o overlap factor +! real(r8) g2(6) ! " +! +! real(r8) g3(6) ! " +! real(r8) g4(6) ! " +! real(r8) ab(6) ! h2o temp. factor +! real(r8) bb(6) ! " +! real(r8) abp(6) ! " +! +! real(r8) bbp(6) ! " + real(r8) tcfc3 ! transmission of cfc11 band + real(r8) tcfc4 ! transmission of cfc11 band + real(r8) tcfc6 ! transmission of cfc12 band + real(r8) tcfc7 ! " +! + real(r8) tcfc8 ! " + real(r8) tlw ! h2o transmission + real(r8) tch4 ! ch4 transmission +! +!--------------------------Data Statements------------------------------ +! +! data g1 /0.0468556_r8,0.0397454_r8,0.0407664_r8,0.0304380_r8,0.0540398_r8,0.0321962_r8/ +! data g2 /14.4832_r8,4.30242_r8,5.23523_r8,3.25342_r8,0.698935_r8,16.5599_r8/ +! data g3 /26.1898_r8,18.4476_r8,15.3633_r8,12.1927_r8,9.14992_r8,8.07092_r8/ +! data g4 /0.0261782_r8,0.0369516_r8,0.0307266_r8,0.0243854_r8,0.0182932_r8,0.0161418_r8/ +! data ab /3.0857e-2_r8,2.3524e-2_r8,1.7310e-2_r8,2.6661e-2_r8,2.8074e-2_r8,2.2915e-2_r8/ +! data bb /-1.3512e-4_r8,-6.8320e-5_r8,-3.2609e-5_r8,-1.0228e-5_r8,-9.5743e-5_r8,-1.0304e-4_r8/ +! data abp/2.9129e-2_r8,2.4101e-2_r8,1.9821e-2_r8,2.6904e-2_r8,2.9458e-2_r8,1.9892e-2_r8/ +! data bbp/-1.3139e-4_r8,-5.5688e-5_r8,-4.6380e-5_r8,-8.0362e-5_r8,-1.0115e-4_r8,-8.8061e-5_r8/ +! +!--------------------------Statement Functions-------------------------- +! + real(r8) func, u, b + func(u,b) = u/sqrt(4.0_r8 + u*(1.0_r8 + 1.0_r8 / b)) +! +!------------------------------------------------------------------ +! + do i = 1,ncol + sqti(i) = sqrt(tbar(i,kn)) + rsqti(i) = 1._r8 / sqti(i) +! +! h2o transmission +! + tt(i) = abs(tbar(i,kn) - 250.0_r8) + ds2c(i) = abs(s2c(i,k2+1) - s2c(i,k2))*uinpl(i,kn) + duptyp(i) = abs(uptype(i,k2+1) - uptype(i,k2))*uinpl(i,kn) + end do +! + do l = 1,6 + do i = 1,ncol + psi1 = exp(abp(l)*tt(i)+bbp(l)*tt(i)*tt(i)) + phi1 = exp(ab(l)*tt(i)+bb(l)*tt(i)*tt(i)) + p1 = pnew(i) * (psi1/phi1) / sslp + w1 = dw(i) * winpl(i,kn) * phi1 + tw(i,l) = exp(- g1(l)*p1*(sqrt(1.0_r8+g2(l)*(w1/p1))-1.0_r8) & + - g3(l)*ds2c(i)-g4(l)*duptyp(i)) + end do + end do +! + do i=1,ncol + tw(i,1)=tw(i,1)*(0.7_r8*aer_trn_ngh(i,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1 + 0.3_r8*aer_trn_ngh(i,idx_LW_0800_1000)) + tw(i,2)=tw(i,2)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1 + tw(i,3)=tw(i,3)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1 + tw(i,4)=tw(i,4)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1 + tw(i,5)=tw(i,5)*aer_trn_ngh(i,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1 + tw(i,6)=tw(i,6)*aer_trn_ngh(i,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1 + end do ! end loop over lon + + do i = 1,ncol +! + du1 = abs(ucfc11(i,k2+1) - ucfc11(i,k2)) * winpl(i,kn) + du2 = abs(ucfc12(i,k2+1) - ucfc12(i,k2)) * winpl(i,kn) +! +! cfc transmissions +! + tcfc3 = exp(-175.005_r8*du1) + tcfc4 = exp(-1202.18_r8*du1) + tcfc6 = exp(-5786.73_r8*du2) + tcfc7 = exp(-2873.51_r8*du2) + tcfc8 = exp(-2085.59_r8*du2) +! +! Absorptivity for CFC11 bands +! + acfc1 = 50.0_r8*(1.0_r8 - exp(-54.09_r8*du1)) * tw(i,1)*bplnk(7,i,kn) + acfc2 = 60.0_r8*(1.0_r8 - exp(-5130.03_r8*du1))*tw(i,2)*bplnk(8,i,kn) + acfc3 = 60.0_r8*(1.0_r8 - tcfc3)*tw(i,4)*tcfc6 * bplnk(9,i,kn) + acfc4 = 100.0_r8*(1.0_r8 - tcfc4)* tw(i,5) * bplnk(10,i,kn) +! +! Absorptivity for CFC12 bands +! + acfc5 = 45.0_r8*(1.0_r8 - exp(-1272.35_r8*du2))*tw(i,3)*bplnk(11,i,kn) + acfc6 = 50.0_r8*(1.0_r8 - tcfc6)*tw(i,4)*bplnk(12,i,kn) + acfc7 = 80.0_r8*(1.0_r8 - tcfc7)* tw(i,5)*tcfc4 *bplnk(13,i,kn) + acfc8 = 70.0_r8*(1.0_r8 - tcfc8)*tw(i,6)*bplnk(14,i,kn) +! +! Absorptivity for CH4 band 1306 cm-1 +! + tlw = exp(-1.0_r8*sqrt(up2(i))) + tlw=tlw*aer_trn_ngh(i,idx_LW_1200_2000) + duch4 = abs(uch4(i,k2+1) - uch4(i,k2)) * winpl(i,kn) + dbetac = 2.94449_r8 * pinpl(i,kn) * rsqti(i) / sslp + ach4 = 6.00444_r8*sqti(i)*log(1.0_r8 + func(duch4,dbetac)) * tlw * bplnk(3,i,kn) + tch4 = 1.0_r8/(1.0_r8 + 0.02_r8*func(duch4,dbetac)) +! +! Absorptivity for N2O bands +! + du01 = abs(un2o0(i,k2+1) - un2o0(i,k2)) * winpl(i,kn) + du11 = abs(un2o1(i,k2+1) - un2o1(i,k2)) * winpl(i,kn) + dbeta01 = 19.399_r8 * pinpl(i,kn) * rsqti(i) / sslp + dbeta11 = dbeta01 +! +! 1285 cm-1 band +! + an2o1 = 2.35558_r8*sqti(i)*log(1.0_r8 + func(du01,dbeta01) & + + func(du11,dbeta11)) * tlw * tch4 * bplnk(4,i,kn) + du02 = 0.100090_r8*du01 + du12 = 0.0992746_r8*du11 + dbeta02 = 0.964282_r8*dbeta01 +! +! 589 cm-1 band +! + an2o2 = 2.65581_r8*sqti(i)*log(1.0_r8 + func(du02,dbeta02) & + + func(du12,dbeta02)) * tco2(i) * th2o(i) * bplnk(5,i,kn) + du03 = 0.0333767_r8*du01 + dbeta03 = 0.982143_r8*dbeta01 +! +! 1168 cm-1 band +! + an2o3 = 2.54034_r8*sqti(i)*log(1.0_r8 + func(du03,dbeta03)) * & + tw(i,6) * tcfc8 * bplnk(6,i,kn) +! +! Absorptivity for 1064 cm-1 band of CO2 +! + du11 = abs(uco211(i,k2+1) - uco211(i,k2)) * winpl(i,kn) + du12 = abs(uco212(i,k2+1) - uco212(i,k2)) * winpl(i,kn) + du13 = abs(uco213(i,k2+1) - uco213(i,k2)) * winpl(i,kn) + dbetc1 = 2.97558_r8 * pinpl(i,kn) * rsqti(i) / sslp + dbetc2 = 2.0_r8 * dbetc1 + aco21 = 3.7571_r8*sqti(i)*log(1.0_r8 + func(du11,dbetc1) & + + func(du12,dbetc2) + func(du13,dbetc2)) & + * to3(i) * tw(i,5) * tcfc4 * tcfc7 * bplnk(2,i,kn) +! +! Absorptivity for 961 cm-1 band of co2 +! + du21 = abs(uco221(i,k2+1) - uco221(i,k2)) * winpl(i,kn) + du22 = abs(uco222(i,k2+1) - uco222(i,k2)) * winpl(i,kn) + du23 = abs(uco223(i,k2+1) - uco223(i,k2)) * winpl(i,kn) + aco22 = 3.8443_r8*sqti(i)*log(1.0_r8 + func(du21,dbetc1) & + + func(du22,dbetc1) + func(du23,dbetc2)) & + * tw(i,4) * tcfc3 * tcfc6 * bplnk(1,i,kn) +! +! total trace gas absorptivity +! + abstrc(i) = acfc1 + acfc2 + acfc3 + acfc4 + acfc5 + acfc6 + & + acfc7 + acfc8 + an2o1 + an2o2 + an2o3 + ach4 + & + aco21 + aco22 + end do + +end subroutine trcabn + +!==================================================================================== + +subroutine trcems(ncol , & + k ,co2t ,pnm ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,bn2o0 ,bn2o1 ,uch4 , & + bch4 ,uco211 ,uco212 ,uco213 ,uco221 , & + uco222 ,uco223 ,uptype ,w ,s2c , & + up2 ,emplnk ,th2o ,tco2 ,to3 , & + emstrc , & + aer_trn_ttl) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate emissivity for CH4, N2O, CFC11 and CFC12 bands. +! +! Method: +! See CCM3 Description for equations. +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: co2t(pcols,pverp) ! pressure weighted temperature + real(r8), intent(in) :: pnm(pcols,pverp) ! interface pressure + real(r8), intent(in) :: ucfc11(pcols,pverp) ! CFC11 path length + real(r8), intent(in) :: ucfc12(pcols,pverp) ! CFC12 path length + real(r8), intent(in) :: un2o0(pcols,pverp) ! N2O path length +! + real(r8), intent(in) :: un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8), intent(in) :: uch4(pcols,pverp) ! CH4 path length + real(r8), intent(in) :: uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8), intent(in) :: uco213(pcols,pverp) ! CO2 9.4 micron band path length +! + real(r8), intent(in) :: uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8), intent(in) :: uptype(pcols,pverp) ! continuum path length + real(r8), intent(in) :: bn2o0(pcols,pverp) ! pressure factor for n2o +! + real(r8), intent(in) :: bn2o1(pcols,pverp) ! pressure factor for n2o + real(r8), intent(in) :: bch4(pcols,pverp) ! pressure factor for ch4 + real(r8), intent(in) :: emplnk(14,pcols) ! emissivity Planck factor + real(r8), intent(in) :: th2o(pcols) ! water vapor overlap factor + real(r8), intent(in) :: tco2(pcols) ! co2 overlap factor +! + real(r8), intent(in) :: to3(pcols) ! o3 overlap factor + real(r8), intent(in) :: s2c(pcols,pverp) ! h2o continuum path length + real(r8), intent(in) :: w(pcols,pverp) ! h2o path length + real(r8), intent(in) :: up2(pcols) ! pressure squared h2o path length +! + integer, intent(in) :: k ! level index + + real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) ! aer trn. + +! +! Output Arguments +! + real(r8), intent(out) :: emstrc(pcols,pverp) ! total trace gas emissivity + +! +!--------------------------Local Variables------------------------------ +! + integer i,l ! loop counters +! + real(r8) sqti(pcols) ! square root of mean temp + real(r8) ecfc1 ! emissivity of cfc11 798 cm-1 band + real(r8) ecfc2 ! " " " 846 cm-1 band + real(r8) ecfc3 ! " " " 933 cm-1 band + real(r8) ecfc4 ! " " " 1085 cm-1 band +! + real(r8) ecfc5 ! " " cfc12 889 cm-1 band + real(r8) ecfc6 ! " " " 923 cm-1 band + real(r8) ecfc7 ! " " " 1102 cm-1 band + real(r8) ecfc8 ! " " " 1161 cm-1 band + real(r8) u01 ! n2o path length +! + real(r8) u11 ! n2o path length + real(r8) beta01 ! n2o pressure factor + real(r8) beta11 ! n2o pressure factor + real(r8) en2o1 ! emissivity of the 1285 cm-1 N2O band + real(r8) u02 ! n2o path length +! + real(r8) u12 ! n2o path length + real(r8) beta02 ! n2o pressure factor + real(r8) en2o2 ! emissivity of the 589 cm-1 N2O band + real(r8) u03 ! n2o path length + real(r8) beta03 ! n2o pressure factor +! + real(r8) en2o3 ! emissivity of the 1168 cm-1 N2O band + real(r8) betac ! ch4 pressure factor + real(r8) ech4 ! emissivity of 1306 cm-1 CH4 band + real(r8) betac1 ! co2 pressure factor + real(r8) betac2 ! co2 pressure factor +! + real(r8) eco21 ! emissivity of 1064 cm-1 CO2 band + real(r8) eco22 ! emissivity of 961 cm-1 CO2 band + real(r8) tt(pcols) ! temp. factor for h2o overlap factor + real(r8) psi1 ! narrow band h2o temp. factor + real(r8) phi1 ! " +! + real(r8) p1 ! h2o line overlap factor + real(r8) w1 ! " + real(r8) tw(pcols,6) ! h2o transmission overlap +! real(r8) g1(6) ! h2o overlap factor +! real(r8) g2(6) ! " +! +! real(r8) g3(6) ! " +! real(r8) g4(6) ! " +! real(r8) ab(6) ! " +! real(r8) bb(6) ! " +! real(r8) abp(6) ! " +! +! real(r8) bbp(6) ! " + real(r8) tcfc3 ! transmission for cfc11 band + real(r8) tcfc4 ! " + real(r8) tcfc6 ! transmission for cfc12 band + real(r8) tcfc7 ! " +! + real(r8) tcfc8 ! " + real(r8) tlw ! h2o overlap factor + real(r8) tch4 ! ch4 overlap factor +! +!--------------------------Data Statements------------------------------ +! +! data g1 /0.0468556_r8,0.0397454_r8,0.0407664_r8,0.0304380_r8,0.0540398_r8,0.0321962_r8/ +! data g2 /14.4832_r8,4.30242_r8,5.23523_r8,3.25342_r8,0.698935_r8,16.5599_r8/ +! data g3 /26.1898_r8,18.4476_r8,15.3633_r8,12.1927_r8,9.14992_r8,8.07092_r8/ +! data g4 /0.0261782_r8,0.0369516_r8,0.0307266_r8,0.0243854_r8,0.0182932_r8,0.0161418_r8/ +! data ab /3.0857e-2_r8,2.3524e-2_r8,1.7310e-2_r8,2.6661e-2_r8,2.8074e-2_r8,2.2915e-2_r8/ +! data bb /-1.3512e-4_r8,-6.8320e-5_r8,-3.2609e-5_r8,-1.0228e-5_r8,-9.5743e-5_r8,-1.0304e-4_r8/ +! data abp/2.9129e-2_r8,2.4101e-2_r8,1.9821e-2_r8,2.6904e-2_r8,2.9458e-2_r8,1.9892e-2_r8/ +! data bbp/-1.3139e-4_r8,-5.5688e-5_r8,-4.6380e-5_r8,-8.0362e-5_r8,-1.0115e-4_r8,-8.8061e-5_r8/ +! +!--------------------------Statement Functions-------------------------- +! + real(r8) func, u, b + func(u,b) = u/sqrt(4.0_r8 + u*(1.0_r8 + 1.0_r8 / b)) +! +!----------------------------------------------------------------------- +! + do i = 1,ncol + sqti(i) = sqrt(co2t(i,k)) +! +! Transmission for h2o +! + tt(i) = abs(co2t(i,k) - 250.0_r8) + end do +! + do l = 1,6 + do i = 1,ncol + psi1 = exp(abp(l)*tt(i)+bbp(l)*tt(i)*tt(i)) + phi1 = exp(ab(l)*tt(i)+bb(l)*tt(i)*tt(i)) + p1 = pnm(i,k) * (psi1/phi1) / sslp + w1 = w(i,k) * phi1 + tw(i,l) = exp(- g1(l)*p1*(sqrt(1.0_r8+g2(l)*(w1/p1))-1.0_r8) & + - g3(l)*s2c(i,k)-g4(l)*uptype(i,k)) + end do + end do + +! Overlap H2O tranmission with STRAER continuum in 6 trace gas +! subbands + + do i=1,ncol + tw(i,1)=tw(i,1)*(0.7_r8*aer_trn_ttl(i,k,1,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1 + 0.3_r8*aer_trn_ttl(i,k,1,idx_LW_0800_1000)) + tw(i,2)=tw(i,2)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1 + tw(i,3)=tw(i,3)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1 + tw(i,4)=tw(i,4)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1 + tw(i,5)=tw(i,5)*aer_trn_ttl(i,k,1,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1 + tw(i,6)=tw(i,6)*aer_trn_ttl(i,k,1,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1 + end do ! end loop over lon +! + do i = 1,ncol +! +! transmission due to cfc bands +! + tcfc3 = exp(-175.005_r8*ucfc11(i,k)) + tcfc4 = exp(-1202.18_r8*ucfc11(i,k)) + tcfc6 = exp(-5786.73_r8*ucfc12(i,k)) + tcfc7 = exp(-2873.51_r8*ucfc12(i,k)) + tcfc8 = exp(-2085.59_r8*ucfc12(i,k)) +! +! Emissivity for CFC11 bands +! + ecfc1 = 50.0_r8*(1.0_r8 - exp(-54.09_r8*ucfc11(i,k))) * tw(i,1) * emplnk(7,i) + ecfc2 = 60.0_r8*(1.0_r8 - exp(-5130.03_r8*ucfc11(i,k)))* tw(i,2) * emplnk(8,i) + ecfc3 = 60.0_r8*(1.0_r8 - tcfc3)*tw(i,4)*tcfc6*emplnk(9,i) + ecfc4 = 100.0_r8*(1.0_r8 - tcfc4)*tw(i,5)*emplnk(10,i) +! +! Emissivity for CFC12 bands +! + ecfc5 = 45.0_r8*(1.0_r8 - exp(-1272.35_r8*ucfc12(i,k)))*tw(i,3)*emplnk(11,i) + ecfc6 = 50.0_r8*(1.0_r8 - tcfc6)*tw(i,4)*emplnk(12,i) + ecfc7 = 80.0_r8*(1.0_r8 - tcfc7)*tw(i,5)* tcfc4 * emplnk(13,i) + ecfc8 = 70.0_r8*(1.0_r8 - tcfc8)*tw(i,6) * emplnk(14,i) +! +! Emissivity for CH4 band 1306 cm-1 +! + tlw = exp(-1.0_r8*sqrt(up2(i))) + +! Overlap H2O vibration rotation band with STRAER continuum +! for CH4 1306 cm-1 and N2O 1285 cm-1 bands + + tlw=tlw*aer_trn_ttl(i,k,1,idx_LW_1200_2000) + betac = bch4(i,k)/uch4(i,k) + ech4 = 6.00444_r8*sqti(i)*log(1.0_r8 + func(uch4(i,k),betac)) *tlw * emplnk(3,i) + tch4 = 1.0_r8/(1.0_r8 + 0.02_r8*func(uch4(i,k),betac)) +! +! Emissivity for N2O bands +! + u01 = un2o0(i,k) + u11 = un2o1(i,k) + beta01 = bn2o0(i,k)/un2o0(i,k) + beta11 = bn2o1(i,k)/un2o1(i,k) +! +! 1285 cm-1 band +! + en2o1 = 2.35558_r8*sqti(i)*log(1.0_r8 + func(u01,beta01) + & + func(u11,beta11))*tlw*tch4*emplnk(4,i) + u02 = 0.100090_r8*u01 + u12 = 0.0992746_r8*u11 + beta02 = 0.964282_r8*beta01 +! +! 589 cm-1 band +! + en2o2 = 2.65581_r8*sqti(i)*log(1.0_r8 + func(u02,beta02) + & + func(u12,beta02)) * tco2(i) * th2o(i) * emplnk(5,i) + u03 = 0.0333767_r8*u01 + beta03 = 0.982143_r8*beta01 +! +! 1168 cm-1 band +! + en2o3 = 2.54034_r8*sqti(i)*log(1.0_r8 + func(u03,beta03)) * & + tw(i,6) * tcfc8 * emplnk(6,i) +! +! Emissivity for 1064 cm-1 band of CO2 +! + betac1 = 2.97558_r8*pnm(i,k) / (sslp*sqti(i)) + betac2 = 2.0_r8 * betac1 + eco21 = 3.7571_r8*sqti(i)*log(1.0_r8 + func(uco211(i,k),betac1) & + + func(uco212(i,k),betac2) + func(uco213(i,k),betac2)) & + * to3(i) * tw(i,5) * tcfc4 * tcfc7 * emplnk(2,i) +! +! Emissivity for 961 cm-1 band +! + eco22 = 3.8443_r8*sqti(i)*log(1.0_r8 + func(uco221(i,k),betac1) & + + func(uco222(i,k),betac1) + func(uco223(i,k),betac2)) & + * tw(i,4) * tcfc3 * tcfc6 * emplnk(1,i) +! +! total trace gas emissivity +! + emstrc(i,k) = ecfc1 + ecfc2 + ecfc3 + ecfc4 + ecfc5 +ecfc6 + & + ecfc7 + ecfc8 + en2o1 + en2o2 + en2o3 + ech4 + & + eco21 + eco22 + end do + +end subroutine trcems + +!==================================================================================== + +subroutine trcplk(ncol , & + tint ,tlayr ,tplnke ,emplnk ,abplnk1 , & + abplnk2 ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate Planck factors for absorptivity and emissivity of +! CH4, N2O, CFC11 and CFC12 +! +! Method: +! Planck function and derivative evaluated at the band center. +! +! Author: J. Kiehl +! +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: tint(pcols,pverp) ! interface temperatures + real(r8), intent(in) :: tlayr(pcols,pverp) ! k-1 level temperatures + real(r8), intent(in) :: tplnke(pcols) ! Top Layer temperature +! +! output arguments +! + real(r8), intent(out) :: emplnk(14,pcols) ! emissivity Planck factor + real(r8), intent(out) :: abplnk1(14,pcols,pverp) ! non-nearest layer Plack factor + real(r8), intent(out) :: abplnk2(14,pcols,pverp) ! nearest layer factor + +! +!--------------------------Local Variables------------------------------ +! + integer wvl ! wavelength index + integer i,k ! loop counters +! + real(r8) f1(14) ! Planck function factor + real(r8) f2(14) ! " + real(r8) f3(14) ! " +! +!--------------------------Data Statements------------------------------ +! + data f1 /5.85713e8_r8,7.94950e8_r8,1.47009e9_r8,1.40031e9_r8,1.34853e8_r8, & + 1.05158e9_r8,3.35370e8_r8,3.99601e8_r8,5.35994e8_r8,8.42955e8_r8, & + 4.63682e8_r8,5.18944e8_r8,8.83202e8_r8,1.03279e9_r8/ + data f2 /2.02493e11_r8,3.04286e11_r8,6.90698e11_r8,6.47333e11_r8, & + 2.85744e10_r8,4.41862e11_r8,9.62780e10_r8,1.21618e11_r8, & + 1.79905e11_r8,3.29029e11_r8,1.48294e11_r8,1.72315e11_r8, & + 3.50140e11_r8,4.31364e11_r8/ + data f3 /1383.0_r8,1531.0_r8,1879.0_r8,1849.0_r8,848.0_r8,1681.0_r8, & + 1148.0_r8,1217.0_r8,1343.0_r8,1561.0_r8,1279.0_r8,1328.0_r8, & + 1586.0_r8,1671.0_r8/ +! +!----------------------------------------------------------------------- +! +! Calculate emissivity Planck factor +! + do wvl = 1,14 + do i = 1,ncol + emplnk(wvl,i) = f1(wvl)/(tplnke(i)**4.0_r8*(exp(f3(wvl)/tplnke(i))-1.0_r8)) + end do + end do +! +! Calculate absorptivity Planck factor for tint and tlayr temperatures +! + do wvl = 1,14 + do k = ntoplw, pverp + do i = 1, ncol +! +! non-nearlest layer function +! + abplnk1(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tint(i,k))) & + /(tint(i,k)**5.0_r8*(exp(f3(wvl)/tint(i,k))-1.0_r8)**2.0_r8) +! +! nearest layer function +! + abplnk2(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tlayr(i,k))) & + /(tlayr(i,k)**5.0_r8*(exp(f3(wvl)/tlayr(i,k))-1.0_r8)**2.0_r8) + end do + end do + end do + +end subroutine trcplk + + +!==================================================================================== + +end module radae diff --git a/src/physics/camrt/radconstants.F90 b/src/physics/camrt/radconstants.F90 new file mode 100644 index 0000000000..89503fd0f5 --- /dev/null +++ b/src/physics/camrt/radconstants.F90 @@ -0,0 +1,308 @@ +module radconstants + +! This module contains constants that are specific to the radiative transfer +! code used in the CAM3 model. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +implicit none +private + +! public routines + + public :: get_number_sw_bands + public :: get_sw_spectral_boundaries + public :: get_lw_spectral_boundaries + public :: get_ref_solar_band_irrad + public :: get_true_ref_solar_band_irrad + public :: get_ref_total_solar_irrad + public :: get_solar_band_fraction_irrad + public :: radconstants_init + public :: rad_gas_index + +! optics files specify a type. What length is it? +integer, parameter, public :: ot_length = 32 + +! SHORTWAVE DATA + +! number of shorwave spectral intervals +integer, parameter, public :: nswbands = 19 + +integer, parameter, public :: idx_sw_diag = 8 ! index to sw visible band + +! *** For interface consistency -- used only by modal_aero_optics and assumes use of RRTMG +! Need to provide a function interface to avoid this hack. +integer, parameter, public :: idx_nir_diag = 999 ! index to sw near infrared (778-1240 nm) band +integer, parameter, public :: idx_uv_diag = 999 ! index to sw uv (345-441 nm) band +! *** For interface consistency + + +integer, parameter, public :: idx_lw_diag = 2 ! index to (H20 window) LW band + + +! Number of evenly spaced intervals in rh +! The globality of this mesh may not be necessary +! Perhaps it could be specific to the aerosol +! But it is difficult to see how refined it must be +! for lookup. This value was found to be sufficient +! for Sulfate and probably necessary to resolve the +! high variation near rh = 1. Alternative methods +! were found to be too slow. +! Optimal approach would be for cam to specify size of aerosol +! based on each aerosol's characteristics. Radiation +! should know nothing about hygroscopic growth! +integer, parameter, public :: nrh = 1000 + +! LONGWAVE DATA + +! number of lw bands +integer, public, parameter :: nlwbands = 7 +! Index of volc. abs., H2O non-window +integer, public, parameter :: idx_LW_H2O_NONWND=1 +! Index of volc. abs., H2O window +integer, public, parameter :: idx_LW_H2O_WINDOW=2 +! Index of volc. cnt. abs. 0500--0650 cm-1 +integer, public, parameter :: idx_LW_0500_0650=3 +! Index of volc. cnt. abs. 0650--0800 cm-1 +integer, public, parameter :: idx_LW_0650_0800=4 +! Index of volc. cnt. abs. 0800--1000 cm-1 +integer, public, parameter :: idx_LW_0800_1000=5 +! Index of volc. cnt. abs. 1000--1200 cm-1 +integer, public, parameter :: idx_LW_1000_1200=6 +! Index of volc. cnt. abs. 1200--2000 cm-1 +integer, public, parameter :: idx_LW_1200_2000=7 + +! GASES TREATED BY RADIATION (line spectrae) + +! gasses required by radiation +integer, public, parameter :: gasnamelength = 5 +integer, public, parameter :: nradgas = 8 +character(len=gasnamelength), public, parameter :: gaslist(nradgas) & + = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + +! what is the minimum mass mixing ratio that can be supported by radiation implementation? +real(r8), public, parameter :: minmmr(nradgas) & + = epsilon(1._r8) + +! Solar and SW data for CAMRT + + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + integer, public, parameter :: indxsl(nswbands) = & + (/ 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 2, 3, & + 3, 3, 3, 4, 4, & + 4, 4, 4/) + + ! minimum wavelength of band in micrometers + real(r8), parameter :: wavmin(nswbands) = & + (/ 0.200_r8, 0.245_r8, 0.265_r8, 0.275_r8, 0.285_r8, & + 0.295_r8, 0.305_r8, 0.350_r8, 0.640_r8, 0.700_r8, 0.700_r8, & + 0.700_r8, 0.700_r8, 0.700_r8, 0.700_r8, 0.700_r8, & + 2.630_r8, 4.160_r8, 4.160_r8/) + + ! maximum wavelength of band in micrometers + real(r8), parameter :: wavmax(nswbands) = & + (/ 0.245_r8, 0.265_r8, 0.275_r8, 0.285_r8, 0.295_r8, & + 0.305_r8, 0.350_r8, 0.640_r8, 0.700_r8, 5.000_r8, 5.000_r8, & + 5.000_r8, 5.000_r8, 5.000_r8, 5.000_r8, 5.000_r8, & + 2.860_r8, 4.550_r8, 4.550_r8/) + + ! Fraction of solar flux in each stated spectral interval + real(r8), public, parameter :: frcsol(nswbands) = & + (/ .001488_r8, .001389_r8, .001290_r8, .001686_r8, .002877_r8, & + .003869_r8, .026336_r8, .360739_r8, .065392_r8, .526861_r8, & + .526861_r8, .526861_r8, .526861_r8, .526861_r8, .526861_r8, & + .526861_r8, .006239_r8, .001834_r8, .001834_r8/) + + ! Weight of h2o in spectral interval + real(r8), public, parameter :: ph2o(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .505_r8, & + .210_r8, .120_r8, .070_r8, .048_r8, .029_r8, & + .018_r8, .000_r8, .000_r8, .000_r8/) + + ! Weight of co2 in spectral interval + real(r8), public, parameter :: pco2(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, 1.000_r8, .640_r8, .360_r8/) + + ! Weight of o2 in spectral interval + real(r8), public, parameter :: po2(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, 1.000_r8, 1.000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8/) + + real(r8) :: solfrac_true(nswbands) + + ! Longwave spectral band limits (cm-1) + real(r8), private, parameter :: wavenumber1_longwave(nlwbands) = & + (/10._r8,350._r8,500._r8,650._r8,800._r8,1000._r8,1200._r8/) + + ! Longwave spectral band limits (cm-1) + real(r8), private, parameter :: wavenumber2_longwave(nlwbands) = & + (/350._r8,500._r8,650._r8,800._r8,1000._r8,1200._r8,2000._r8/) + +contains + + +!------------------------------------------------------------------------------ +subroutine get_number_sw_bands(number_of_bands) + ! number of solar (shortwave) bands in the radiation code + integer, intent(out) :: number_of_bands + + number_of_bands = nswbands + +end subroutine get_number_sw_bands + +!------------------------------------------------------------------------------ +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each longwave band + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber1_longwave + high_boundaries = wavenumber2_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber2_longwave + high_boundaries = 1.e-2_r8/wavenumber1_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber2_longwave + high_boundaries = 1.e7_r8/wavenumber1_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber2_longwave + high_boundaries = 1.e4_r8/wavenumber1_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber2_longwave + high_boundaries = 1._r8/wavenumber1_longwave + case default + call endrun('get_lw_spectral_boundaries: spectral units not acceptable'//units) + end select + +end subroutine get_lw_spectral_boundaries + +!------------------------------------------------------------------------------ +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each shortwave band + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = 1.e4_r8/wavmax + high_boundaries = 1.e4_r8/wavmin + case('m','meter','meters') + low_boundaries = 1.e-6_r8*wavmin + high_boundaries = 1.e-6_r8*wavmax + case('nm','nanometer','nanometers') + low_boundaries = 1.e3_r8*wavmin + high_boundaries = 1.e3_r8*wavmax + case('um','micrometer','micrometers','micron','microns') + low_boundaries = wavmin + high_boundaries = wavmax + case('cm','centimeter','centimeters') + low_boundaries = 1.e-4_r8*wavmin + high_boundaries = 1.e-4_r8*wavmax + case default + call endrun('get_sw_spectral_boundaries: spectral units not acceptable'//units) + end select + +end subroutine get_sw_spectral_boundaries + +!------------------------------------------------------------------------------ +subroutine get_ref_solar_band_irrad( band_irrad ) + + ! solar irradiance in each band (W/m^2) + real(r8), intent(out) :: band_irrad(nswbands) + + band_irrad = frcsol + +end subroutine get_ref_solar_band_irrad + +!------------------------------------------------------------------------------ +subroutine radconstants_init() +! The last bands are implemented as scalings to the solar flux +! so the corresponding actual flux applied to the heating +! is different from the solar in that band. These are the +! actual solar flux applied to each band + + integer :: ns + real(r8):: psf(nswbands) ! scaled fractional solar spectrum in each band applied to unitary heating + + do ns = 1, nswbands + psf(ns) = 1.0_r8 + if(ph2o(ns)/=0._r8) psf(ns) = psf(ns)*ph2o(ns) + if(pco2(ns)/=0._r8) psf(ns) = psf(ns)*pco2(ns) + if(po2 (ns)/=0._r8) psf(ns) = psf(ns)*po2 (ns) + solfrac_true(ns) = frcsol(ns)*psf(ns) + enddo + +end subroutine radconstants_init + + +!------------------------------------------------------------------------------ +subroutine get_true_ref_solar_band_irrad( solfrac_true_out ) + + ! solar irradiance in each band (W/m^2) + + real(r8), intent(out) :: solfrac_true_out(nswbands) + + solfrac_true_out(:) = solfrac_true(:) + +end subroutine get_true_ref_solar_band_irrad + +!------------------------------------------------------------------------------ +subroutine get_ref_total_solar_irrad(tsi) + ! provide Total Solar Irradiance assumed by radiation + + real(r8), intent(out) :: tsi + real(r8) :: solfrac_true(nswbands) + + call get_true_ref_solar_band_irrad( solfrac_true ) + tsi = sum(solfrac_true) + +end subroutine get_ref_total_solar_irrad + +!------------------------------------------------------------------------------ +subroutine get_solar_band_fraction_irrad(fractional_irradiance) + ! provide fractional solar irradiance in each band + + ! fraction of solar irradiance in each band + real(r8), intent(out) :: fractional_irradiance(1:nswbands) + real(r8) :: tsi ! total solar irradiance + + fractional_irradiance = frcsol + +end subroutine get_solar_band_fraction_irrad + +!------------------------------------------------------------------------------ +integer function rad_gas_index(gasname) + + ! return the index in the gaslist array of the specified gasname + + character(len=*),intent(in) :: gasname + integer :: igas + + rad_gas_index = -1 + do igas = 1, nradgas + if (trim(gaslist(igas)).eq.trim(gasname)) then + rad_gas_index = igas + return + endif + enddo + call endrun ("rad_gas_index: can not find gas with name "//gasname) +end function rad_gas_index + +end module radconstants diff --git a/src/physics/camrt/radiation.F90 b/src/physics/camrt/radiation.F90 new file mode 100644 index 0000000000..1ca1e074de --- /dev/null +++ b/src/physics/camrt/radiation.F90 @@ -0,0 +1,1339 @@ +module radiation + +!--------------------------------------------------------------------------------- +! +! CAM interface to the legacy 'camrt' radiation code +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use physics_types, only: physics_state, physics_ptend +use phys_grid, only: get_ncols_p +use camsrfexch, only: cam_out_t, cam_in_t +use physconst, only: cpair, cappa +use time_manager, only: get_nstep, is_first_restart_step, & + get_curr_calday, get_step_size +use cam_control_mod, only: lambm0, obliqr, mvelpp, eccen + +use radae, only: abstot_3d, absnxt_3d, emstot_3d, initialize_radbuffer, ntoplw + +use scamMod, only: scm_crm_mode, single_column,have_cld,cldobs,& + have_clwp,clwpobs,have_tg,tground + +use cam_grid_support, only: cam_grid_write_attr, cam_grid_id, & + cam_grid_header_info_t, cam_grid_dimensions, & + cam_grid_write_dist_array, cam_grid_read_dist_array + +use cam_history, only: outfld, hist_fld_active +use cam_history_support, only: fillvalue + +use cam_pio_utils, only: cam_pio_def_dim + +use pio, only: file_desc_t, var_desc_t, & + pio_double, pio_int, pio_noerr, & + pio_seterrorhandling, pio_bcast_error, & + pio_inq_varid, & + pio_def_var, pio_def_dim, & + pio_put_var, pio_get_var + +use cam_abortutils, only: endrun +use error_messages, only: handle_err +use perf_mod, only: t_startf, t_stopf +use cam_logfile, only: iulog + +implicit none +private +save + +public :: & + radiation_readnl, &! read namelist variables + radiation_register, &! registers radiation physics buffer fields + radiation_nextsw_cday, &! calendar day of next radiation calculation + radiation_do, &! query which radiation calcs are done this timestep + radiation_init, &! initialization + radiation_define_restart, &! + radiation_write_restart, &! + radiation_read_restart, &! + radiation_tend, &! compute heating rates and fluxes + rad_out_t ! type for diagnostic outputs + +type rad_out_t + real(r8) :: solin(pcols) ! Solar incident flux + real(r8) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA + real(r8) :: fsntoac(pcols) ! Clear sky net solar flux at TOA + real(r8) :: fsnirt(pcols) ! Near-IR flux absorbed at toa + real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns + real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux + real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux + real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + real(r8) :: flut(pcols) ! Upward flux at top of model + real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model + real(r8) :: flntc(pcols) ! Clear sky lw flux at model top + real(r8) :: flnsc(pcols) ! Clear sky lw flux at srf (up-down) + real(r8) :: fldsc(pcols) ! Clear sky lw flux at srf (down) + real(r8) :: flwds(pcols) ! Down longwave flux at surface + real(r8) :: fsnr(pcols) + real(r8) :: flnr(pcols) + real(r8) :: fsds(pcols) ! Surface solar down flux + real(r8) :: fln200(pcols) ! net longwave flux interpolated to 200 mb + real(r8) :: fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb + real(r8) :: fsn200(pcols) ! fns interpolated to 200 mb + real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb + real(r8) :: sols(pcols) ! Solar downward visible direct to surface + real(r8) :: soll(pcols) ! Solar downward near infrared direct to surface + real(r8) :: solsd(pcols) ! Solar downward visible diffuse to surface + real(r8) :: solld(pcols) ! Solar downward near infrared diffuse to surface + real(r8) :: qrsc(pcols,pver) ! clearsky shortwave radiative heating rate + real(r8) :: qrlc(pcols,pver) ! clearsky longwave radiative heating rate + real(r8) :: fsdtoa(pcols) ! Solar input = Flux Solar Downward Top of Atmosphere + real(r8) :: swcf(pcols) ! shortwave cloud forcing + real(r8) :: lwcf(pcols) ! longwave cloud forcing + + real(r8) :: tot_cld_vistau(pcols,pver) + real(r8) :: tot_icld_vistau(pcols,pver) + real(r8) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth (only during day, night = fillvalue) +end type rad_out_t + +! Namelist variables + +character(len=cl) :: absems_data +integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive) + ! or hours (negative). +integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive) + ! or hours (negative). +integer :: iradae = -12 ! frequency of absorp/emis calc in time steps (positive) + ! or hours (negative). +integer :: irad_always = 0 ! Specifies length of time in timesteps (positive) + ! or hours (negative) SW/LW radiation will be + ! run continuously from the start of an + ! initial or restart run +logical :: use_rad_dt_cosz = .false. ! if true use zenith angle averaged over + ! interval between radiation calculations + +! Physics buffer indices +integer :: qrs_idx = 0 +integer :: qrl_idx = 0 +integer :: fsds_idx = 0 +integer :: fsns_idx = 0 +integer :: fsnt_idx = 0 +integer :: flns_idx = 0 +integer :: flnt_idx = 0 +integer :: cld_idx = 0 +integer :: rel_idx = 0 +integer :: rei_idx = 0 +integer :: cicewp_idx = -1 +integer :: cliqwp_idx = -1 +integer :: cldemis_idx = -1 +integer :: cldtau_idx = -1 +integer :: nmxrgn_idx = -1 +integer :: pmxrgn_idx = -1 + +! averaging time interval for zenith angle +real(r8) :: dt_avg = 0._r8 + +real(r8), parameter :: cgs2mks = 1.e-3_r8 + +! PIO descriptors (for restarts) + +type(var_desc_t), allocatable :: abstot_desc(:) +type(var_desc_t) :: emstot_desc, absnxt_desc(4) + +!=============================================================================== +contains +!=============================================================================== + +subroutine radiation_readnl(nlfile) + + ! Read radiation_nl namelist group. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & + mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + integer :: dtime ! timestep size + character(len=*), parameter :: sub = 'radiation_readnl' + + namelist /radiation_nl/ absems_data, iradsw, iradlw, iradae, irad_always, & + use_rad_dt_cosz + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'radiation_nl', status=ierr) + if (ierr == 0) then + read(unitn, radiation_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(absems_data, len(absems_data), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: absems_data") + call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradsw") + call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradlw") + call mpi_bcast(iradae, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradae") + call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: irad_always") + call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") + + ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary + dtime = get_step_size() + if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) + if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) + if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) + + ! Convert iradae from hours to timesteps if necessary and check that + ! iradae must be an even multiple of iradlw + if (iradae < 0) iradae = nint((-iradae*3600._r8)/dtime) + if (mod(iradae,iradlw)/=0) then + write(iulog,*) sub//': iradae must be an even multiple of iradlw.' + write(iulog,*)' iradae = ',iradae,', iradlw = ',iradlw + call endrun(sub//': iradae must be an even multiple of iradlw.') + end if + + !----------------------------------------------------------------------- + ! Print runtime options to log. + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'CAMRT radiation scheme parameters:' + write(iulog,10) iradsw, iradlw, iradae, irad_always, use_rad_dt_cosz + write(iulog,*) ' Abs/Emis dataset: ', trim(absems_data) + end if + +10 format(' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & + ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & + ' Frequency (timesteps) of Absorptivity/Emissivity calc:',i5/, & + ' SW/LW calc done every timestep for first N steps. N= ',i5/, & + ' Use average zenith angle: ',l5) + + +end subroutine radiation_readnl + +!================================================================================================ + +subroutine radiation_register + + ! Register radiation fields in the physics buffer + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use radiation_data, only: rad_data_register + + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate + call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate + + call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux + + call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux + call pbuf_add_field('FSNT' , 'global',dtype_r8,(/pcols/), fsnt_idx) ! Top-of-model net shortwave flux + call pbuf_add_field('FLNS' , 'global',dtype_r8,(/pcols/), flns_idx) ! Surface net longwave flux + call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux + + call rad_data_register() + +end subroutine radiation_register + +!================================================================================================ + +function radiation_do(op, timestep) + + ! Returns true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in), optional:: timestep + logical :: radiation_do ! return value + + ! Local variables + integer :: nstep ! current timestep number + !----------------------------------------------------------------------- + + if (present(timestep)) then + nstep = timestep + else + nstep = get_nstep() + end if + + select case (op) + + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradsw == 1 & + .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradlw == 1 & + .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + + case ('absems') ! do an absorptivity/emissivity calculation this timestep? + radiation_do = nstep == 0 .or. iradae == 1 & + .or. (mod(nstep-1,iradae) == 0 .and. nstep /= 1) + + case ('aeres') ! write absorptivity/emissivity to restart file this timestep? + radiation_do = mod(nstep,iradae) /= 0 + + case default + call endrun('radiation_do: unknown operation:'//op) + + end select +end function radiation_do + +!================================================================================================ + +real(r8) function radiation_nextsw_cday() + + ! Returns calendar day of next sw radiation calculation + + ! Local variables + integer :: nstep ! timestep counter + logical :: dosw ! true => do shosrtwave calc + integer :: offset ! offset for calendar day calculation + integer :: dTime ! integer timestep size + real(r8):: calday ! calendar day of + !----------------------------------------------------------------------- + + radiation_nextsw_cday = -1._r8 + dosw = .false. + nstep = get_nstep() + dtime = get_step_size() + offset = 0 + do while (.not. dosw) + nstep = nstep + 1 + offset = offset + dtime + if (radiation_do('sw', nstep)) then + radiation_nextsw_cday = get_curr_calday(offset=offset) + dosw = .true. + end if + end do + if(radiation_nextsw_cday == -1._r8) then + call endrun('error in radiation_nextsw_cday') + end if + +end function radiation_nextsw_cday + +!================================================================================================ + +subroutine radiation_init(pbuf2d) + + ! Initialize the radiation parameterization, add fields to the history buffer + + use cam_history, only: addfld, add_default, horiz_only + use physconst, only: gravit, cpair, epsilo, stebol, & + pstd, mwdry, mwco2, mwo3 + + use physics_buffer, only: physics_buffer_desc, pbuf_get_index + use radsw, only: radsw_init + use radlw, only: radlw_init + use radae, only: radae_init + use radconstants, only: radconstants_init + use rad_solar_var, only: rad_solar_var_init + use radiation_data, only: rad_data_init + use phys_control, only: phys_getopts + use time_manager, only: get_step_size + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + ! Local variables + integer :: nstep ! current timestep number + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_vdiag ! output the variables used by the AMWG variability diag package + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + + integer :: dtime + !----------------------------------------------------------------------- + + call radconstants_init() + call rad_solar_var_init() + + call radsw_init(gravit) + call radlw_init(gravit, stebol) + call radae_init( & + gravit, epsilo, stebol, pstd, mwdry, & + mwco2, mwo3, absems_data) + + call rad_data_init(pbuf2d) + + ! Set the radiation timestep for cosz calculations if requested using the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dtime = get_step_size() + dt_avg = real(iradsw*dtime, r8) + end if + + ! Get physics buffer indices + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! "irad_always" is number of time steps to execute radiation continuously from start of + ! initial OR restart run + nstep = get_nstep() + if ( irad_always > 0) then + nstep = get_nstep() + irad_always = irad_always + nstep + end if + + ! Shortwave radiation + call addfld ('SOLIN', horiz_only, 'A','W/m2','Solar insolation', sampling_seq='rad_lwsw') + call addfld ('SOLL', horiz_only, 'A','W/m2','Solar downward near infrared direct to surface', & + sampling_seq='rad_lwsw') + call addfld ('SOLS', horiz_only, 'A','W/m2','Solar downward visible direct to surface', sampling_seq='rad_lwsw') + call addfld ('SOLLD', horiz_only, 'A','W/m2','Solar downward near infrared diffuse to surface', & + sampling_seq='rad_lwsw') + call addfld ('SOLSD', horiz_only, 'A','W/m2','Solar downward visible diffuse to surface', sampling_seq='rad_lwsw') + call addfld ('QRS', (/ 'lev' /), 'A','K/s', 'Solar heating rate', sampling_seq='rad_lwsw') + call addfld ('QRSC', (/ 'lev' /), 'A','K/s', 'Clearsky solar heating rate', sampling_seq='rad_lwsw') + call addfld ('FSNS', horiz_only, 'A','W/m2','Net solar flux at surface', sampling_seq='rad_lwsw') + call addfld ('FSNT', horiz_only, 'A','W/m2','Net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld ('FSNTOA', horiz_only, 'A','W/m2','Net solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld ('FSUTOA', horiz_only, 'A','W/m2','Upwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld ('FSNTOAC', horiz_only, 'A','W/m2','Clearsky net solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld ('FSDTOA', horiz_only, 'A','W/m2','Downwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld ('FSN200', horiz_only, 'A','W/m2','Net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld ('FSN200C', horiz_only, 'A','W/m2','Clearsky net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld ('FSNTC', horiz_only, 'A','W/m2','Clearsky net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld ('FSNSC', horiz_only, 'A','W/m2','Clearsky net solar flux at surface', sampling_seq='rad_lwsw') + call addfld ('FSDSC', horiz_only, 'A','W/m2','Clearsky downwelling solar flux at surface', & + sampling_seq='rad_lwsw') + call addfld ('FSDS', horiz_only, 'A','W/m2','Downwelling solar flux at surface', sampling_seq='rad_lwsw') + call addfld ('FUS', (/ 'ilev' /), 'I','W/m2','Shortwave upward flux') + call addfld ('FDS', (/ 'ilev' /), 'I','W/m2','Shortwave downward flux') + call addfld ('FUSC', (/ 'ilev' /), 'I','W/m2','Shortwave clear-sky upward flux') + call addfld ('FDSC', (/ 'ilev' /), 'I','W/m2','Shortwave clear-sky downward flux') + call addfld ('FSNIRTOA', horiz_only, 'A','W/m2','Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld ('FSNRTOAC', horiz_only, 'A','W/m2', & + 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld ('FSNRTOAS', horiz_only, 'A','W/m2','Net near-infrared flux (>= 0.7 microns) at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld ('FSNR', horiz_only, 'A','W/m2','Net solar flux at tropopause', sampling_seq='rad_lwsw') + call addfld ('SWCF', horiz_only, 'A','W/m2','Shortwave cloud forcing', sampling_seq='rad_lwsw') + + call addfld ('TOT_CLD_VISTAU', (/ 'lev' /), 'A','1', 'Total gbx cloud visible sw optical depth', & + sampling_seq='rad_lwsw',flag_xyfill=.true.) + call addfld ('TOT_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Total in-cloud visible sw optical depth', & + sampling_seq='rad_lwsw',flag_xyfill=.true.) + call addfld ('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Liquid in-cloud visible sw optical depth', & + sampling_seq='rad_lwsw',flag_xyfill=.true.) + call addfld ('ICE_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Ice in-cloud visible sw optical depth', & + sampling_seq='rad_lwsw',flag_xyfill=.true.) + + ! Longwave radiation + call addfld ('QRL', (/ 'lev' /), 'A','K/s', 'Longwave heating rate', sampling_seq='rad_lwsw') + call addfld ('QRLC', (/ 'lev' /), 'A','K/s', 'Clearsky longwave heating rate', sampling_seq='rad_lwsw') + call addfld ('FLNS', horiz_only, 'A','W/m2','Net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld ('FLDS', horiz_only, 'A','W/m2','Downwelling longwave flux at surface', sampling_seq='rad_lwsw') + call addfld ('FLNT', horiz_only, 'A','W/m2','Net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld ('FLUT', horiz_only, 'A','W/m2','Upwelling longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld ('FLUTC', horiz_only, 'A','W/m2','Clearsky upwelling longwave flux at top of model', & + sampling_seq='rad_lwsw') + call addfld ('FLNTC', horiz_only, 'A','W/m2','Clearsky net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld ('FLN200', horiz_only, 'A','W/m2','Net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld ('FLN200C', horiz_only, 'A','W/m2','Clearsky net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld ('FLNR', horiz_only, 'A','W/m2','Net longwave flux at tropopause', sampling_seq='rad_lwsw') + call addfld ('FLNSC', horiz_only, 'A','W/m2','Clearsky net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld ('FLDSC', horiz_only, 'A','W/m2','Clearsky downwelling longwave flux at surface', & + sampling_seq='rad_lwsw') + call addfld ('LWCF', horiz_only, 'A','W/m2','Longwave cloud forcing', sampling_seq='rad_lwsw') + call addfld ('FUL', (/ 'ilev' /), 'I','W/m2','Longwave upward flux') + call addfld ('FDL', (/ 'ilev' /), 'I','W/m2','Longwave downward flux') + call addfld ('FULC', (/ 'ilev' /), 'I','W/m2','Longwave clear-sky upward flux') + call addfld ('FDLC', (/ 'ilev' /), 'I','W/m2','Longwave clear-sky downward flux') + + ! Heating rate needed for d(theta)/dt computation + call addfld ('HR', (/ 'lev' /), 'A','K/s', 'Heating rate needed for d(theta)/dt computation') + + ! determine default variables + call phys_getopts(history_amwg_out = history_amwg, & + history_vdiag_out = history_vdiag, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + if (history_amwg) then + ! Shortwave variables + call add_default ('SOLIN ', 1, ' ') + call add_default ('QRS ', 1, ' ') + call add_default ('FSNS ', 1, ' ') + call add_default ('FSNT ', 1, ' ') + call add_default ('FSDTOA ', 1, ' ') + call add_default ('FSNTOA ', 1, ' ') + call add_default ('FSUTOA ', 1, ' ') + call add_default ('FSNTOAC ', 1, ' ') + call add_default ('FSNTC ', 1, ' ') + call add_default ('FSNSC ', 1, ' ') + call add_default ('FSDSC ', 1, ' ') + call add_default ('FSDS ', 1, ' ') + call add_default ('SWCF ', 1, ' ') + ! Longwave variables + call add_default ('QRL ', 1, ' ') + call add_default ('FLNS ', 1, ' ') + call add_default ('FLDS ', 1, ' ') + call add_default ('FLNT ', 1, ' ') + call add_default ('FLUT ', 1, ' ') + call add_default ('FLUTC ', 1, ' ') + call add_default ('FLNTC ', 1, ' ') + call add_default ('FLNSC ', 1, ' ') + call add_default ('FLDSC ', 1, ' ') + call add_default ('LWCF ', 1, ' ') + endif + if (single_column.and.scm_crm_mode) then + ! Shortwave variables + call add_default ('FUS ', 1, ' ') + call add_default ('FUSC ', 1, ' ') + call add_default ('FDS ', 1, ' ') + call add_default ('FDSC ', 1, ' ') + ! Longwave variables + call add_default ('FUL ', 1, ' ') + call add_default ('FULC ', 1, ' ') + call add_default ('FDL ', 1, ' ') + call add_default ('FDLC ', 1, ' ') + endif + + if ( history_budget .and. history_budget_histfile_num > 1 ) then + call add_default ('QRL ', history_budget_histfile_num, ' ') + call add_default ('QRS ', history_budget_histfile_num, ' ') + end if + + if (history_vdiag) then + call add_default('FLUT',2,' ') + call add_default('FLUT',3,' ') + end if + + cicewp_idx = pbuf_get_index('CICEWP') + cliqwp_idx = pbuf_get_index('CLIQWP') + cldemis_idx= pbuf_get_index('CLDEMIS') + cldtau_idx = pbuf_get_index('CLDTAU') + nmxrgn_idx = pbuf_get_index('NMXRGN') + pmxrgn_idx = pbuf_get_index('PMXRGN') + +end subroutine radiation_init + +!=============================================================================== + +subroutine radiation_define_restart(file) + + ! define variables to be written to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: i, ierr + integer :: grid_id + integer :: hdimcnt + integer :: pver_id, pverp_id + integer :: vsize + integer :: dimids(4) + + type(cam_grid_header_info_t) :: info + + character(len=16) :: pname + !---------------------------------------------------------------------------- + + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + + if (radiation_do('aeres')) then + + grid_id = cam_grid_id('physgrid') + call cam_grid_write_attr(File, grid_id, info) + hdimcnt = info%num_hdims() + do i = 1, hdimcnt + dimids(i) = info%get_hdimid(i) + end do + + call cam_pio_def_dim(File, 'lev', pver, pver_id, existOK=.true.) + call cam_pio_def_dim(File, 'ilev', pverp, pverp_id, existOK=.true.) + + vsize = pverp - ntoplw + 1 + if (vsize /= pverp) then + ierr = pio_def_dim(File, 'lwcols', vsize, dimids(hdimcnt+1)) + else + dimids(hdimcnt+1) = pverp_id + end if + + ! split into vsize variables to avoid excessive memory usage in IO + + allocate(abstot_desc(ntoplw:pverp)) + + do i = ntoplw, pverp + write(pname,'(a,i3.3)') 'NAL_absorp', i + ierr = pio_def_var(File, trim(pname), pio_double, dimids(1:hdimcnt+1), abstot_desc(i)) + end do + + dimids(hdimcnt+1) = pverp_id + ierr = pio_def_var(File, 'Emissivity', pio_double, dimids(1:hdimcnt+1), emstot_desc) + + dimids(hdimcnt+1) = pver_id + do i=1,4 + write(pname,'(a,i3.3)') 'NN_absorp',i + ierr = pio_def_var(File, pname, pio_double, dimids(1:hdimcnt+1), absnxt_desc(i)) + end do + + end if + +end subroutine radiation_define_restart + +!=============================================================================== + +subroutine radiation_write_restart(file) + + ! write variables to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: i, ierr + integer :: physgrid + integer :: dims(3), gdims(3) + integer :: nhdims + integer :: ncol + !---------------------------------------------------------------------------- + + if ( radiation_do('aeres') ) then + + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + + do i = begchunk, endchunk + ncol = get_ncols_p(i) + if (ncol < pcols) then + abstot_3d(ncol+1:pcols,:,:,i) = fillvalue + absnxt_3d(ncol+1:pcols,:,:,i) = fillvalue + emstot_3d(ncol+1:pcols,:,i) = fillvalue + end if + end do + + ! abstot_3d is written as a series of 3D variables + + dims(1) = size(abstot_3d, 1) ! Should be pcols + dims(2) = size(abstot_3d, 2) ! Should be (pverp-ntoplw+1) + dims(3) = size(abstot_3d, 4) ! Should be endchunk - begchunk + 1 + gdims(nhdims+1) = dims(2) + do i = ntoplw, pverp + call cam_grid_write_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), abstot_3d(:,:,i,:), abstot_desc(i)) + end do + + dims(1) = size(emstot_3d, 1) ! Should be pcols + dims(2) = size(emstot_3d, 2) ! Should be pverp + dims(3) = size(emstot_3d, 3) ! Should be endchunk - begchunk + 1 + gdims(nhdims+1) = dims(2) + call cam_grid_write_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), emstot_3d, emstot_desc) + + dims(1) = size(absnxt_3d, 1) ! Should be pcols + dims(2) = size(absnxt_3d, 2) ! Should be pver + dims(3) = size(absnxt_3d, 4) ! Should be endchunk - begchunk + 1 + gdims(nhdims+1) = dims(2) + do i = 1, 4 + call cam_grid_write_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), absnxt_3d(:,:,i,:), absnxt_desc(i)) + end do + + ! module data was allocated in radiation_define_restart + deallocate(abstot_desc) + end if + +end subroutine radiation_write_restart + +!=============================================================================== + +subroutine radiation_read_restart(file) + + ! read variables from restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + + integer :: err_handling + integer :: ierr + integer :: physgrid + integer :: dims(3), gdims(3), nhdims + integer :: vsize + integer :: i + + type(var_desc_t) :: vardesc + character(len=16) :: pname + !---------------------------------------------------------------------------- + + ! Put this call here for now. It should move to an init method when the + ! initialization and restart sequencing is unified. + call initialize_radbuffer() + + if ( radiation_do('aeres') ) then + + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'Emissivity', vardesc) + call pio_seterrorhandling(File, err_handling) + if (ierr /= PIO_NOERR) then + if (masterproc) write(iulog,*) 'Warning: Emissivity variable not found on restart file.' + return + end if + + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + + dims(1) = pcols + dims(2) = pverp + dims(3) = endchunk - begchunk + 1 + gdims(nhdims+1) = dims(2) + + call cam_grid_read_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), emstot_3d, vardesc) + + vsize = pverp - ntoplw + 1 + dims(2) = vsize + gdims(nhdims+1) = dims(2) + + do i = ntoplw, pverp + write(pname,'(a,i3.3)') 'NAL_absorp', i + ierr = pio_inq_varid(File, trim(pname), vardesc) + call cam_grid_read_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), abstot_3d(:,:,i,:), vardesc) + end do + + dims(2) = pver + gdims(nhdims+1) = dims(2) + do i = 1, 4 + write(pname,'(a,i3.3)') 'NN_absorp', i + ierr = pio_inq_varid(File, trim(pname), vardesc) + call cam_grid_read_dist_array(File, physgrid, dims(1:3), & + gdims(1:nhdims+1), absnxt_3d(:,:,i,:), vardesc) + end do + end if + +end subroutine radiation_read_restart + +!=============================================================================== + +subroutine radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) + + !----------------------------------------------------------------------- + ! Driver for radiation computation. + ! + ! NOTE: Radiation uses cgs units, so conversions must be done from + ! model fields to radiation fields. + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use physics_types, only: physics_state, physics_ptend + use time_manager, only: get_curr_calday + use radheat, only: radheat_tend + use physconst, only: cpair, stebol + use radconstants, only: nlwbands, nswbands + use radsw, only: radcswmx + use radlw, only: radclwmx + use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out + use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + use interpolate_data, only: vertinterp + use radiation_data, only: rad_data_write + use cloud_cover_diags, only: cloud_cover_diags_out + use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use orbit, only: zenith + + ! Arguments + type(physics_state), target, intent(in) :: state + type(physics_ptend), intent(out) :: ptend + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(out) :: net_flx(pcols) + type(rad_out_t), target, optional, intent(out) :: rd_out + + ! Local variables + type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object + ! if the argument is not present + + integer :: i, k + integer :: lchnk, ncol + + logical :: dosw, dolw, doabsems + integer, pointer :: nmxrgn(:) ! pbuf pointer to Number of maximally overlapped regions + real(r8),pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + ! maximally overlapped region. + ! 0->pmxrgn(i,1) is range of pressure for + ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for + ! 2nd region, etc + + real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity + real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth + real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path + real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path + + real(r8) :: cltot(pcols) ! Diagnostic total cloud cover + real(r8) :: cllow(pcols) ! " low cloud cover + real(r8) :: clmed(pcols) ! " mid cloud cover + real(r8) :: clhgh(pcols) ! " hgh cloud cover + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + + integer :: itim_old + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + real(r8), pointer, dimension(:,:) :: qrs ! shortwave radiative heating rate + real(r8), pointer, dimension(:,:) :: qrl ! longwave radiative heating rate + + real(r8) :: calday ! current calendar day + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + + real(r8) :: fns(pcols,pverp) ! net shortwave flux + real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux + real(r8) :: fnl(pcols,pverp) ! net longwave flux + real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux + + ! This is used by the chemistry. + real(r8), pointer :: fsds(:) ! Surface solar down flux + + ! This is used for the energy checker and the Eulerian dycore. + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + + real(r8) :: pbr(pcols,pver) ! Model mid-level pressures (dynes/cm2) + real(r8) :: pnm(pcols,pverp) ! Model interface pressures (dynes/cm2) + real(r8) :: eccf ! Earth/sun distance factor + real(r8) :: lwupcgs(pcols) ! Upward longwave flux in cgs units + + real(r8), pointer, dimension(:,:) :: n2o ! nitrous oxide mass mixing ratio + real(r8), pointer, dimension(:,:) :: ch4 ! methane mass mixing ratio + real(r8), pointer, dimension(:,:) :: cfc11 ! cfc11 mass mixing ratio + real(r8), pointer, dimension(:,:) :: cfc12 ! cfc12 mass mixing ratio + real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio + real(r8), pointer, dimension(:,:) :: o2 ! Oxygen mass mixing ratio + real(r8), dimension(pcols) :: o2_col ! column oxygen mmr + real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio + real(r8), dimension(pcols) :: co2_col_mean ! co2 column mean mmr + real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity + + ! Aerosol shortwave radiative properties + real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau + + ! Aerosol longwave absorption optical depth + real(r8) :: odap_aer(pcols,pver,nlwbands) + + ! Gathered indicies of day and night columns + ! chunk_column_index = IdxDay(daylight_column_index) + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns + integer, dimension(pcols) :: IdxNite ! Indicies of night coumns + + character(*), parameter :: name = 'radiation_tend' + + ! tropopause diagnostic + integer :: troplev(pcols) + real(r8):: p_trop(pcols) + + logical :: write_output ! switch for outfld calls + !---------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + calday = get_curr_calday() + + if (present(rd_out)) then + rd => rd_out + write_output = .false. + else + allocate(rd) + write_output=.true. + end if + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qrs_idx,qrs) + call pbuf_get_field(pbuf, qrl_idx,qrl) + + call pbuf_get_field(pbuf, fsds_idx, fsds) + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + + ! For CRM, make cloud equal to input observations: + if (single_column.and.scm_crm_mode.and.have_cld) then + do k = 1,pver + cld(:ncol,k)= cldobs(k) + enddo + endif + + ! Cosine solar zenith angle for current time step + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + call zenith (calday, clat, clon, coszrs, ncol, dt_avg) + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + dosw = radiation_do('sw') ! do shortwave heating calc this timestep? + dolw = radiation_do('lw') ! do longwave heating calc this timestep? + + doabsems = radiation_do('absems') ! do absorptivity/emissivity calc this timestep? + + if (dosw .or. dolw) then + + ! pbuf cloud properties set in cloud_diagnostics + call pbuf_get_field(pbuf, cicewp_idx, cicewp) + call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) + call pbuf_get_field(pbuf, cldemis_idx, emis) + + call pbuf_get_field(pbuf, cldtau_idx, cldtau) + + call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn) + call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn) + + ! For CRM, make cloud liquid water path equal to input observations + if(single_column.and.scm_crm_mode.and.have_clwp)then + do k=1,pver + cliqwp(:ncol,k) = clwpobs(k) + end do + endif + + ! Get specific humidity + call rad_cnst_get_gas(0,'H2O', state, pbuf, sp_hum) + + ! Get ozone mass mixing ratio. + call rad_cnst_get_gas(0,'O3', state, pbuf, o3) + + ! Get CO2 mass mixing ratio and compute column mean values + call rad_cnst_get_gas(0,'CO2', state, pbuf, co2) + call calc_col_mean(state, co2, co2_col_mean) + + ! construct cgs unit reps of pmid and pint and get "eccf" - earthsundistancefactor + call radinp(ncol, state%pmid, state%pint, pbr, pnm, eccf) + + ! Solar radiation computation + + if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then + call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + endif + + if (dosw) then + + call t_startf('rad_sw') + + ! Get Oxygen mass mixing ratio. + call rad_cnst_get_gas(0,'O2', state, pbuf, o2) + call calc_col_mean(state, o2, o2_col) + + ! Get aerosol radiative properties. + call t_startf('aero_optics_sw') + call aer_rad_props_sw(0, state, pbuf, nnite, idxnite, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) + call t_stopf('aero_optics_sw') + + call radcswmx(lchnk, & + ncol, pnm, pbr, sp_hum, o3, & + o2_col, cld, cicewp, cliqwp, rel, & + rei, eccf, coszrs, rd%solin, & + cam_in%asdir, cam_in%asdif, cam_in%aldir, cam_in%aldif, nmxrgn, & + pmxrgn, qrs, rd%qrsc, fsnt, rd%fsntc, rd%fsdtoa, & + rd%fsntoa, rd%fsutoa, rd%fsntoac, rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, & + fsns, rd%fsnsc, rd%fsdsc, fsds, cam_out%sols, & + cam_out%soll, cam_out%solsd, cam_out%solld, fns, fcns, & + Nday, Nnite, IdxDay, IdxNite, co2_col_mean, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f , rd%liq_icld_vistau, rd%ice_icld_vistau ) + + call t_stopf('rad_sw') + + ! Output net fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) + if (hist_fld_active('FSNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fns(i,:), rd%fsnr(i)) + rd%fsnr(i) = rd%fsnr(i)*cgs2mks + enddo + else + rd%fsnr(:) = 0._r8 + endif + + ! Convert units of shortwave fields needed by rest of model from CGS to MKS + + do i=1,ncol + rd%solin(i) = rd%solin(i) *cgs2mks + fsds(i) = fsds(i) *cgs2mks + rd%fsnirt(i) = rd%fsnirt(i) *cgs2mks + rd%fsnrtc(i) = rd%fsnrtc(i) *cgs2mks + rd%fsnirtsq(i)= rd%fsnirtsq(i)*cgs2mks + fsnt(i) = fsnt(i) *cgs2mks + rd%fsdtoa(i) = rd%fsdtoa(i) *cgs2mks + fsns(i) = fsns(i) *cgs2mks + rd%fsntc(i) = rd%fsntc(i) *cgs2mks + rd%fsnsc(i) = rd%fsnsc(i) *cgs2mks + rd%fsdsc(i) = rd%fsdsc(i) *cgs2mks + rd%fsntoa(i) = rd%fsntoa(i) *cgs2mks + rd%fsutoa(i) = rd%fsutoa(i) *cgs2mks + rd%fsntoac(i) = rd%fsntoac(i) *cgs2mks + rd%fsn200(i) = rd%fsn200(i) *cgs2mks + rd%fsn200c(i) = rd%fsn200c(i) *cgs2mks + rd%swcf(i) = rd%fsntoa(i) - rd%fsntoac(i) + end do + + ! initialize tau_cld_vistau and tau_icld_vistau as fillvalue, they will stay fillvalue for night columns + rd%tot_icld_vistau(1:pcols,1:pver) = fillvalue + rd%tot_cld_vistau(1:pcols,1:pver) = fillvalue + + ! only do calcs for tot_cld_vistau and tot_icld_vistau on daytime columns + do i=1,Nday + ! sum the water and ice optical depths to get total in-cloud cloud optical depth + rd%tot_icld_vistau(IdxDay(i),1:pver) = rd%liq_icld_vistau(IdxDay(i),1:pver) + & + rd%ice_icld_vistau(IdxDay(i),1:pver) + + ! sum wat and ice, multiply by cloud fraction to get grid-box value + rd%tot_cld_vistau(IdxDay(i),1:pver) = (rd%liq_icld_vistau(IdxDay(i),1:pver) + & + rd%ice_icld_vistau(IdxDay(i),1:pver))*cld(IdxDay(i),1:pver) + end do + + ! add fillvalue for night columns + do i = 1, Nnite + rd%liq_icld_vistau(IdxNite(i),:) = fillvalue + rd%ice_icld_vistau(IdxNite(i),:) = fillvalue + end do + + if (write_output) call radiation_output_sw(state, rd, cam_out, fsns, fsnt, fsds, qrs) + + end if ! dosw + + ! Longwave radiation computation + + if (dolw) then + + call t_startf("rad_lw") + + ! Convert upward longwave flux units to CGS + + do i=1,ncol + lwupcgs(i) = cam_in%lwup(i)*1000._r8 + if (single_column .and. scm_crm_mode .and. have_tg) & + lwupcgs(i) = 1000*stebol*tground(1)**4 + end do + + ! Get gas phase constituents. + call rad_cnst_get_gas(0,'N2O', state, pbuf, n2o) + call rad_cnst_get_gas(0,'CH4', state, pbuf, ch4) + call rad_cnst_get_gas(0,'CFC11', state, pbuf, cfc11) + call rad_cnst_get_gas(0,'CFC12', state, pbuf, cfc12) + + ! absems requires lw absorption optical depth and transmission through aerosols + call t_startf('aero_optics_lw') + if (doabsems) call aer_rad_props_lw(0, state, pbuf, odap_aer) + call t_stopf('aero_optics_lw') + + call radclwmx(lchnk, ncol, doabsems, & + lwupcgs, state%t, sp_hum, o3, pbr, & + pnm, state%lnpmid, state%lnpint, n2o, ch4, & + cfc11, cfc12, cld, emis, pmxrgn, & + nmxrgn, qrl, rd%qrlc, flns, flnt, rd%flnsc, & + rd%flntc, cam_out%flwds, rd%fldsc, rd%flut, rd%flutc, & + fnl, fcnl, co2_col_mean, odap_aer) + + call t_stopf("rad_lw") + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) + if (hist_fld_active('FLNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fnl(i,:), rd%flnr(i)) + enddo + else + rd%flnr(:) = 0._r8 + endif + + ! Convert units of longwave fields needed by rest of model from CGS to MKS + + do i = 1, ncol + flnt(i) = flnt(i) *cgs2mks + rd%flut(i) = rd%flut(i) *cgs2mks + rd%flutc(i) = rd%flutc(i) *cgs2mks + rd%lwcf(i) = rd%flutc(i) - rd%flut(i) + flns(i) = flns(i) *cgs2mks + rd%fldsc(i) = rd%fldsc(i) *cgs2mks + rd%flntc(i) = rd%flntc(i) *cgs2mks + rd%fln200(i) = rd%fln200(i) *cgs2mks + rd%fln200c(i) = rd%fln200c(i) *cgs2mks + rd%flnsc(i) = rd%flnsc(i) *cgs2mks + cam_out%flwds(i) = cam_out%flwds(i) *cgs2mks + rd%flnr(i) = rd%flnr(i) *cgs2mks + end do + + if (write_output) call radiation_output_lw(state, rd, cam_out, flns, flnt, qrl) + + end if ! dolw + + ! Output aerosol mmr + if (write_output) call rad_cnst_out(0, state, pbuf) + + ! Cloud cover diagnostics + ! radsw can change pmxrgn and nmxrgn so cldsav needs to follow radsw + if (write_output) call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) + + else ! if (dosw .or. dolw) then + + ! convert radiative heating rates from Q*dp to Q for energy conservation + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)/state%pdel(i,k) + qrl(i,k) = qrl(i,k)/state%pdel(i,k) + end do + end do + + end if ! if (dosw .or. dolw) then + + ! output rad inputs and resulting heating rates + call rad_data_write( pbuf, state, cam_in, coszrs ) + + ! Compute net radiative heating tendency + call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, cam_in%asdir, net_flx) + + if (write_output) then + ! Compute heating rate for dtheta/dt + do k=1,pver + do i=1,ncol + ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR ',ftem ,pcols ,lchnk ) + end if + + ! convert radiative heating rates to Q*dp for energy conservation + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)*state%pdel(i,k) + qrl(i,k) = qrl(i,k)*state%pdel(i,k) + end do + end do + + cam_out%netsw(:ncol) = fsns(:ncol) + + if (.not. present(rd_out)) then + deallocate(rd) + end if +end subroutine radiation_tend + +!=============================================================================== + +subroutine radiation_output_sw(state, rd, cam_out, fsns, fsnt, fsds, qrs) + + ! Dump shortwave radiation information to history buffer (diagnostics) + + type(physics_state), intent(in) :: state + type(rad_out_t), intent(in) :: rd + type(cam_out_t), intent(in) :: cam_out + real(r8), intent(in) :: fsns(pcols) ! Surface solar absorbed flux + real(r8), intent(in) :: fsnt(pcols) ! Net column abs solar flux at model top + real(r8), intent(in) :: fsds(pcols) ! Surface solar down flux + real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate + + ! Local variables + integer :: lchnk, ncol + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + !---------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair + call outfld('QRS ',ftem ,pcols,lchnk) + + ftem(:ncol,:pver) = rd%qrsc(:ncol,:pver)/cpair + call outfld('QRSC ',ftem ,pcols,lchnk) + + call outfld('SOLIN ',rd%solin ,pcols,lchnk) + call outfld('FSDS ',fsds ,pcols,lchnk) + call outfld('FSNIRTOA',rd%fsnirt ,pcols,lchnk) + call outfld('FSNRTOAC',rd%fsnrtc ,pcols,lchnk) + call outfld('FSNRTOAS',rd%fsnirtsq ,pcols,lchnk) + call outfld('FSNT ',fsnt ,pcols,lchnk) + call outfld('FSDTOA ',rd%fsdtoa ,pcols,lchnk) + call outfld('FSNS ',fsns ,pcols,lchnk) + call outfld('FSNTC ',rd%fsntc ,pcols,lchnk) + call outfld('FSNSC ',rd%fsnsc ,pcols,lchnk) + call outfld('FSDSC ',rd%fsdsc ,pcols,lchnk) + call outfld('FSNTOA ',rd%fsntoa ,pcols,lchnk) + call outfld('FSUTOA ',rd%fsutoa ,pcols,lchnk) + call outfld('FSNTOAC ',rd%fsntoac ,pcols,lchnk) + call outfld('SOLS ',cam_out%sols ,pcols,lchnk) + call outfld('SOLL ',cam_out%soll ,pcols,lchnk) + call outfld('SOLSD ',cam_out%solsd ,pcols,lchnk) + call outfld('SOLLD ',cam_out%solld ,pcols,lchnk) + call outfld('FSN200 ',rd%fsn200 ,pcols,lchnk) + call outfld('FSN200C ',rd%fsn200c ,pcols,lchnk) + call outfld('FSNR' ,rd%fsnr ,pcols,lchnk) + call outfld('SWCF ',rd%swcf ,pcols,lchnk) + + call outfld('TOT_CLD_VISTAU ',rd%tot_cld_vistau ,pcols,lchnk) + call outfld('TOT_ICLD_VISTAU ',rd%tot_icld_vistau ,pcols,lchnk) + call outfld('LIQ_ICLD_VISTAU ',rd%liq_icld_vistau ,pcols,lchnk) + call outfld('ICE_ICLD_VISTAU ',rd%ice_icld_vistau ,pcols,lchnk) + +end subroutine radiation_output_sw + +!=============================================================================== + +subroutine radiation_output_lw(state, rd, cam_out, flns, flnt, qrl) + + ! Dump longwave radiation information to history tape buffer (diagnostics) + + type(physics_state), intent(in) :: state + type(rad_out_t), intent(in) :: rd + type(cam_out_t), intent(in) :: cam_out + real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux + real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top + real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate + + ! Local variables + integer :: lchnk, ncol + real(r8) :: ftem(pcols,pver) + !---------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + call outfld('QRL ',qrl(:ncol,:)/cpair,ncol,lchnk) + call outfld('QRLC ',rd%qrlc(:ncol,:)/cpair,ncol,lchnk) + call outfld('FLNT ',flnt ,pcols,lchnk) + call outfld('FLUT ',rd%flut ,pcols,lchnk) + call outfld('FLUTC ',rd%flutc ,pcols,lchnk) + call outfld('FLNTC ',rd%flntc ,pcols,lchnk) + call outfld('FLNS ',flns ,pcols,lchnk) + call outfld('FLDS ',cam_out%flwds ,pcols,lchnk) + call outfld('FLNSC ',rd%flnsc ,pcols,lchnk) + call outfld('FLDSC ',rd%fldsc ,pcols,lchnk) + call outfld('LWCF ',rd%lwcf ,pcols,lchnk) + call outfld('FLN200 ',rd%fln200,pcols,lchnk) + call outfld('FLN200C ',rd%fln200c,pcols,lchnk) + call outfld('FLNR ' ,rd%flnr,pcols,lchnk) + +end subroutine radiation_output_lw + +!=============================================================================== + +subroutine radinp(ncol, pmid, pint, pmidrd, pintrd, eccf) + + use shr_orb_mod + use time_manager, only: get_curr_calday + + !------------------------------Arguments-------------------------------- + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model mid-levels (pascals) + real(r8), intent(in) :: pint(pcols,pverp) ! Pressure at model interfaces (pascals) + + real(r8), intent(out) :: pmidrd(pcols,pver) ! Pressure at mid-levels (dynes/cm*2) + real(r8), intent(out) :: pintrd(pcols,pverp) ! Pressure at interfaces (dynes/cm*2) + real(r8), intent(out) :: eccf ! Earth-sun distance factor + + !---------------------------Local variables----------------------------- + integer :: i, k + real(r8) :: calday ! current calendar day + real(r8) :: delta ! Solar declination angle + !----------------------------------------------------------------------- + + calday = get_curr_calday() + call shr_orb_decl (calday ,eccen ,mvelpp ,lambm0 ,obliqr , & + delta ,eccf) + + ! Convert pressure from pascals to dynes/cm2 + do k=1,pver + do i=1,ncol + pmidrd(i,k) = pmid(i,k)*10.0_r8 + pintrd(i,k) = pint(i,k)*10.0_r8 + end do + end do + do i=1,ncol + pintrd(i,pverp) = pint(i,pverp)*10.0_r8 + end do + +end subroutine radinp + +!=============================================================================== + +subroutine calc_col_mean(state, mmr_pointer, mean_value) + + ! Compute the column mean. + + use cam_logfile, only: iulog + + type(physics_state), intent(in) :: state + real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) + real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr + + integer :: i, k, ncol + real(r8) :: ptot(pcols) + !----------------------------------------------------------------------- + + ncol = state%ncol + mean_value = 0.0_r8 + ptot = 0.0_r8 + + do k=1,pver + do i=1,ncol + mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k) + ptot(i) = ptot(i) + state%pdeldry(i,k) + end do + end do + do i=1,ncol + mean_value(i) = mean_value(i) / ptot(i) + end do + +end subroutine calc_col_mean + +!=============================================================================== + +end module radiation + diff --git a/src/physics/camrt/radlw.F90 b/src/physics/camrt/radlw.F90 new file mode 100644 index 0000000000..62ec514ffc --- /dev/null +++ b/src/physics/camrt/radlw.F90 @@ -0,0 +1,1114 @@ + +module radlw +!----------------------------------------------------------------------- +! +! Purpose: Longwave radiation calculations. +! +!----------------------------------------------------------------------- +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use cam_abortutils, only: endrun +use scamMod, only: single_column, scm_crm_mode +use radconstants, only: nlwbands +implicit none + +private +save + +! Public methods + +public ::& + radlw_init, &! initialize constants + radclwmx ! driver for longwave radiation code + +! Private module data + +real(r8) :: gravit_cgs ! Acceleration of gravity (cm/s**2) +real(r8) :: stebol_cgs ! Stefan-Boltzmann constant (CGS) + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine radclwmx(lchnk ,ncol ,doabsems , & + lwupcgs ,tnm ,qnm ,o3 , & + pmid ,pint ,pmln ,piln , & + n2o ,ch4 ,cfc11 ,cfc12 , & + cld ,emis ,pmxrgn ,nmxrgn ,qrl,qrlc, & + flns ,flnt ,flnsc ,flntc ,flwds , & + fldsc ,flut ,flutc , & + fnl ,fcnl ,co2mmr, odap_aer) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute longwave radiation heating rates and boundary fluxes +! +! Method: +! Uses broad band absorptivity/emissivity method to compute clear sky; +! assumes randomly overlapped clouds with variable cloud emissivity to +! include effects of clouds. +! +! Computes clear sky absorptivity/emissivity at lower frequency (in +! general) than the model radiation frequency; uses previously computed +! and stored values for efficiency +! +! Note: This subroutine contains vertical indexing which proceeds +! from bottom to top rather than the top to bottom indexing +! used in the rest of the model. +! +! Author: B. Collins +! +!----------------------------------------------------------------------- + use radae, only: nbands, radems, radabs, radtpl, abstot_3d, & + absnxt_3d, emstot_3d, ntoplw, radoz2, trcpth + use cam_history, only: outfld + use quicksort, only: quick_sort + use radconstants, only: nlwbands + use phys_control, only: cam_physpkg_is + use ref_pres, only: trop_cloud_top_lev + + integer, parameter :: pverp2=pver+2, pverp3=pver+3, pverp4=pver+4 + real(r8), parameter :: cldmin = 1.0e-80_r8 + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + logical, intent(in) :: doabsems ! True => abs/emiss calculation this timestep + +! maximally overlapped region. +! 0->pmxrgn(i,1) is range of pmid for +! 1st region, pmxrgn(i,1)->pmxrgn(i,2) for +! 2nd region, etc + integer, intent(in) :: nmxrgn(pcols) ! Number of maximally overlapped regions + + real(r8), intent(in) :: pmxrgn(pcols,pverp) ! Maximum values of pmid for each + real(r8), intent(in) :: lwupcgs(pcols) ! Longwave up flux in CGS units +! +! Input arguments which are only passed to other routines +! + real(r8), intent(in) :: tnm(pcols,pver) ! Level temperature + real(r8), intent(in) :: qnm(pcols,pver) ! Level moisture field + real(r8), intent(in) :: o3(pcols,pver) ! ozone mass mixing ratio + real(r8), intent(in) :: pmid(pcols,pver) ! Level pressure + real(r8), intent(in) :: pint(pcols,pverp) ! Model interface pressure + real(r8), intent(in) :: pmln(pcols,pver) ! Ln(pmid) + real(r8), intent(in) :: piln(pcols,pverp) ! Ln(pint) + real(r8), intent(in) :: co2mmr(pcols) ! co2 column mean mass mixing ratio + real(r8), intent(in) :: n2o(pcols,pver) ! nitrous oxide mass mixing ratio + real(r8), intent(in) :: ch4(pcols,pver) ! methane mass mixing ratio + real(r8), intent(in) :: cfc11(pcols,pver) ! cfc11 mass mixing ratio + real(r8), intent(in) :: cfc12(pcols,pver) ! cfc12 mass mixing ratio + real(r8), intent(in) :: cld(pcols,pver) ! Cloud cover + real(r8), intent(in) :: emis(pcols,pver) ! Cloud emissivity + +! [fraction] absorbtion optical depth, cumulative from top + real(r8), intent(in) :: odap_aer(pcols,pver,nlwbands) + + +! +! Output arguments +! + real(r8), intent(out) :: qrl (pcols,pver) ! Longwave heating rate + real(r8), intent(out) :: qrlc(pcols,pver) ! Clearsky longwave heating rate + real(r8), intent(out) :: flns(pcols) ! Surface cooling flux + real(r8), intent(out) :: flnt(pcols) ! Net outgoing flux + real(r8), intent(out) :: flut(pcols) ! Upward flux at top of model + real(r8), intent(out) :: flnsc(pcols) ! Clear sky surface cooing + real(r8), intent(out) :: flntc(pcols) ! Net clear sky outgoing flux + real(r8), intent(out) :: flutc(pcols) ! Upward clear-sky flux at top of model + real(r8), intent(out) :: flwds(pcols) ! Down longwave flux at surface + real(r8), intent(out) :: fldsc(pcols) ! Down clear-sky longwave flux at surface + real(r8),intent(out) :: fcnl(pcols,pverp) ! clear sky net flux at interfaces + real(r8),intent(out) :: fnl(pcols,pverp) ! net flux at interfaces +! +!---------------------------Local variables----------------------------- +! + ! Implicit save here is fine since this should have the same value for + ! the entire run. + integer :: ntopcld = 2 ! Lowest layer without clouds. + ! Shouldn't this be turned off by default? + + integer i ! Longitude index + integer ilon ! Longitude index + integer ii ! Longitude index + integer iimx ! Longitude index (max overlap) + integer k ! Level index + integer k1 ! Level index + integer k2 ! Level index + integer k3 ! Level index + integer km ! Level index + integer km1 ! Level index + integer km3 ! Level index + integer km4 ! Level index + integer irgn ! Index for max-overlap regions + integer l ! Index for clouds to overlap + integer l1 ! Index for clouds to overlap + integer n ! Counter + +! + real(r8) :: plco2(pcols,pverp) ! Path length co2 + real(r8) :: plh2o(pcols,pverp) ! Path length h2o + real(r8) tmp(pcols) ! Temporary workspace + real(r8) tmp2(pcols) ! Temporary workspace + real(r8) tmp3(0:pverp) ! Temporary workspace + real(r8) tmp4 ! Temporary workspace + real(r8) tfdl ! Temporary workspace + real(r8) tful ! Temporary workspace + real(r8) absbt(pcols) ! Downward emission at model top + real(r8) plol(pcols,pverp) ! O3 pressure wghted path length + real(r8) plos(pcols,pverp) ! O3 path length + real(r8) co2em(pcols,pverp) ! Layer co2 normalized planck funct. derivative + real(r8) co2eml(pcols,pver) ! Interface co2 normalized planck funct. deriv. + real(r8) delt(pcols) ! Diff t**4 mid layer to top interface + real(r8) delt1(pcols) ! Diff t**4 lower intrfc to mid layer + real(r8) bk1(pcols) ! Absrptvty for vertical quadrature + real(r8) bk2(pcols) ! Absrptvty for vertical quadrature + real(r8) cldp(pcols,pverp) ! Cloud cover with extra layer + real(r8) ful(pcols,pverp) ! Total upwards longwave flux + real(r8) fsul(pcols,pverp) ! Clear sky upwards longwave flux + real(r8) fdl(pcols,pverp) ! Total downwards longwave flux + real(r8) fsdl(pcols,pverp) ! Clear sky downwards longwv flux + real(r8) fclb4(pcols,-1:pver) ! Sig t**4 for cld bottom interfc + real(r8) fclt4(pcols,0:pver) ! Sig t**4 for cloud top interfc + real(r8) s(pcols,pverp,pverp) ! Flx integral sum + real(r8) tplnka(pcols,pverp) ! Planck fnctn temperature + real(r8) s2c(pcols,pverp) ! H2o cont amount + real(r8) tcg(pcols,pverp) ! H2o-mass-wgted temp. (Curtis-Godson approx.) + real(r8) w(pcols,pverp) ! H2o path + real(r8) tplnke(pcols) ! Planck fnctn temperature + real(r8) h2otr(pcols,pverp) ! H2o trnmsn for o3 overlap + real(r8) co2t(pcols,pverp) ! Prs wghted temperature path + real(r8) tint(pcols,pverp) ! Interface temperature + real(r8) tint4(pcols,pverp) ! Interface temperature**4 + real(r8) tlayr(pcols,pverp) ! Level temperature + real(r8) tlayr4(pcols,pverp) ! Level temperature**4 + real(r8) plh2ob(nbands,pcols,pverp)! Pressure weighted h2o path with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + real(r8) wb(nbands,pcols,pverp) ! H2o path length with + ! Hulst-Curtis-Godson temp. factor + ! for H2O bands + + real(r8) cld0 ! previous cloud amt (for max overlap) + real(r8) cld1 ! next cloud amt (for max overlap) + real(r8) emx(0:pverp) ! Emissivity factors (max overlap) + real(r8) emx0 ! Emissivity factors for BCs (max overlap) + real(r8) trans ! 1 - emis + real(r8) asort(pver) ! 1 - cloud amounts to be sorted for max ovrlp. + real(r8) atmp ! Temporary storage for sort when nxs = 2 + real(r8) maxcld(pcols) ! Maximum cloud at any layer + + integer indx(pcols) ! index vector of gathered array values + integer indxmx(pcols+1,pverp)! index vector of gathered array values +! integer indxmx(pcols,pverp)! index vector of gathered array values +! (max overlap) + integer nrgn(pcols) ! Number of max overlap regions at longitude + integer npts ! number of values satisfying some criterion + integer ncolmx(pverp) ! number of columns with clds in region + integer kx1(pcols,pverp) ! Level index for top of max-overlap region + integer kx2(pcols,0:pverp)! Level index for bottom of max-overlap region + integer kxs(0:pverp,pcols,pverp)! Level indices for cld layers sorted by cld() +! in descending order + integer nxs(pcols,pverp) ! Number of cloudy layers between kx1 and kx2 + integer nxsk ! Number of cloudy layers between (kx1/kx2)&k + integer ksort(0:pverp) ! Level indices of cloud amounts to be sorted +! for max ovrlp. calculation + integer ktmp ! Temporary storage for sort when nxs = 2 + +! +! Pointer variables to 3d structures +! + real(r8), pointer :: abstot(:,:,:) + real(r8), pointer :: absnxt(:,:,:) + real(r8), pointer :: emstot(:,:) + +! [fraction] Total transmission between interfaces k1 and k2 + real(r8) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) +! +! Trace gas variables +! + real(r8) ucfc11(pcols,pverp) ! CFC11 path length + real(r8) ucfc12(pcols,pverp) ! CFC12 path length + real(r8) un2o0(pcols,pverp) ! N2O path length + real(r8) un2o1(pcols,pverp) ! N2O path length (hot band) + real(r8) uch4(pcols,pverp) ! CH4 path length + real(r8) uco211(pcols,pverp) ! CO2 9.4 micron band path length + real(r8) uco212(pcols,pverp) ! CO2 9.4 micron band path length + real(r8) uco213(pcols,pverp) ! CO2 9.4 micron band path length + real(r8) uco221(pcols,pverp) ! CO2 10.4 micron band path length + real(r8) uco222(pcols,pverp) ! CO2 10.4 micron band path length + real(r8) uco223(pcols,pverp) ! CO2 10.4 micron band path length + real(r8) bn2o0(pcols,pverp) ! pressure factor for n2o + real(r8) bn2o1(pcols,pverp) ! pressure factor for n2o + real(r8) bch4(pcols,pverp) ! pressure factor for ch4 + real(r8) uptype(pcols,pverp) ! p-type continuum path length + real(r8) abplnk1(14,pcols,pverp) ! non-nearest layer Plack factor + real(r8) abplnk2(14,pcols,pverp) ! nearest layer factor +! +! +!----------------------------------------------------------------------- +! +! +! Set pointer variables +! + abstot => abstot_3d(:,:,:,lchnk) + absnxt => absnxt_3d(:,:,:,lchnk) + emstot => emstot_3d(:,:,lchnk) + +! +! Calculate some temperatures needed to derive absorptivity and +! emissivity, as well as some h2o path lengths +! + call radtpl(ncol , & + tnm ,lwupcgs ,qnm ,pint ,plco2 ,plh2o , & + tplnka ,s2c ,tcg ,w ,tplnke , & + tint ,tint4 ,tlayr ,tlayr4 ,pmln , & + piln ,plh2ob ,wb ,co2mmr) + + + if (doabsems) then +! +! Compute ozone path lengths at frequency of a/e calculation. +! + call radoz2(ncol, o3, pint, plol, plos) +! +! Compute trace gas path lengths +! + call trcpth(ncol , & + tnm ,pint ,cfc11 ,cfc12 ,n2o , & + ch4 ,qnm ,ucfc11 ,ucfc12 ,un2o0 , & + un2o1 ,uch4 ,uco211 ,uco212 ,uco213 , & + uco221 ,uco222 ,uco223 ,bn2o0 ,bn2o1 , & + bch4 ,uptype ,co2mmr) +! +! Compute transmission through aerosols from (absorption) optical depths +! + call aer_trans_from_od(ncol, odap_aer, aer_trn_ttl) +! +! Compute total emissivity: +! + call radems(lchnk ,ncol , & + s2c ,tcg ,w ,tplnke ,plh2o , & + pint ,plco2 ,tint ,tint4 ,tlayr , & + tlayr4 ,plol ,plos ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,uch4 ,uco211 ,uco212 , & + uco213 ,uco221 ,uco222 ,uco223 ,uptype , & + bn2o0 ,bn2o1 ,bch4 ,co2em ,co2eml , & + co2t ,h2otr ,abplnk1 ,abplnk2 ,emstot , & + plh2ob ,wb , & + aer_trn_ttl, co2mmr) +! +! Compute total absorptivity: +! + + call radabs(lchnk ,ncol , & + pmid ,pint ,co2em ,co2eml ,tplnka , & + s2c ,tcg ,w ,h2otr ,plco2 , & + plh2o ,co2t ,tint ,tlayr ,plol , & + plos ,pmln ,piln ,ucfc11 ,ucfc12 , & + un2o0 ,un2o1 ,uch4 ,uco211 ,uco212 , & + uco213 ,uco221 ,uco222 ,uco223 ,uptype , & + bn2o0 ,bn2o1 ,bch4 ,abplnk1 ,abplnk2 , & + abstot ,absnxt ,plh2ob ,wb , & + odap_aer,aer_trn_ttl, co2mmr) + end if +! +! Compute sums used in integrals (all longitude points) +! +! Definition of bk1 & bk2 depends on finite differencing. for +! trapezoidal rule bk1=bk2. trapezoidal rule applied for nonadjacent +! layers only. +! +! delt=t**4 in layer above current sigma level km. +! delt1=t**4 in layer below current sigma level km. +! + do i=1,ncol + delt(i) = tint4(i,pver) - tlayr4(i,pverp) + delt1(i) = tlayr4(i,pverp) - tint4(i,pverp) + s(i,pverp,pverp) = stebol_cgs*(delt1(i)*absnxt(i,pver,1) + delt (i)*absnxt(i,pver,4)) + s(i,pver,pverp) = stebol_cgs*(delt (i)*absnxt(i,pver,2) + delt1(i)*absnxt(i,pver,3)) + end do + do k=ntoplw,pver-1 + do i=1,ncol + bk2(i) = (abstot_3d(i,k,pver,lchnk) + abstot_3d(i,k,pverp,lchnk))*0.5_r8 + bk1(i) = bk2(i) + s(i,k,pverp) = stebol_cgs*(bk2(i)*delt(i) + bk1(i)*delt1(i)) + end do + end do +! +! All k, km>1 +! + do km=pver,ntoplw+1,-1 + do i=1,ncol + delt(i) = tint4(i,km-1) - tlayr4(i,km) + delt1(i) = tlayr4(i,km) - tint4(i,km) + end do +!CSD$ PARALLEL DO PRIVATE( i, k, bk1, bk2 ) + do k=pverp,ntoplw,-1 + if (k == km) then + do i=1,ncol + bk2(i) = absnxt(i,km-1,4) + bk1(i) = absnxt(i,km-1,1) + end do + else if (k == km-1) then + do i=1,ncol + bk2(i) = absnxt(i,km-1,2) + bk1(i) = absnxt(i,km-1,3) + end do + else + do i=1,ncol + bk2(i) = (abstot_3d(i,k,km-1,lchnk) + abstot_3d(i,k,km,lchnk))*0.5_r8 + bk1(i) = bk2(i) + end do + end if + do i=1,ncol + s(i,k,km) = s(i,k,km+1) + stebol_cgs*(bk2(i)*delt(i) + bk1(i)*delt1(i)) + end do + end do +!CSD$ END PARALLEL DO + end do +! +! Computation of clear sky fluxes always set first level of fsul +! + do i=1,ncol + fsul(i,pverp) = lwupcgs(i) + end do +! +! Downward clear sky fluxes store intermediate quantities in down flux +! Initialize fluxes to clear sky values. +! + do i=1,ncol + tmp(i) = fsul(i,pverp) - stebol_cgs*tint4(i,pverp) + fsul(i,ntoplw) = fsul(i,pverp) - abstot_3d(i,ntoplw,pverp,lchnk)*tmp(i) + s(i,ntoplw,ntoplw+1) + fsdl(i,ntoplw) = stebol_cgs*(tplnke(i)**4)*emstot(i,ntoplw) + end do +! +! fsdl(i,pverp) assumes isothermal layer +! + do k=ntoplw+1,pver + do i=1,ncol + fsul(i,k) = fsul(i,pverp) - abstot_3d(i,k,pverp,lchnk)*tmp(i) + s(i,k,k+1) + fsdl(i,k) = stebol_cgs*(tplnke(i)**4)*emstot(i,k) - (s(i,k,ntoplw+1) - s(i,k,k+1)) + end do + end do +! +! Store the downward emission from level 1 = total gas emission * sigma +! t**4. fsdl does not yet include all terms +! + do i=1,ncol + absbt(i) = stebol_cgs*(tplnke(i)**4)*emstot(i,pverp) + fsdl(i,pverp) = absbt(i) - s(i,pverp,ntoplw+1) + end do + + do k = ntoplw,pverp + do i = 1,ncol + fcnl(i,k) = fsul(i,k) - fsdl(i,k) + end do + end do +! +!---------------------------------------------------------------------- +! Modifications for clouds -- max/random overlap assumption +! +! The column is divided into sets of adjacent layers, called regions, +! in which the clouds are maximally overlapped. The clouds are +! randomly overlapped between different regions. The number of +! regions in a column is set by nmxrgn, and the range of pressures +! included in each region is set by pmxrgn. The max/random overlap +! can be written in terms of the solutions of random overlap with +! cloud amounts = 1. The random overlap assumption is equivalent to +! setting the flux boundary conditions (BCs) at the edges of each region +! equal to the mean all-sky flux at those boundaries. Since the +! emissivity array for propogating BCs is only computed for the +! TOA BC, the flux BCs elsewhere in the atmosphere have to be formulated +! in terms of solutions to the random overlap equations. This is done +! by writing the flux BCs as the sum of a clear-sky flux and emission +! from a cloud outside the region weighted by an emissivity. This +! emissivity is determined from the location of the cloud and the +! flux BC. +! +! Copy cloud amounts to buffer with extra layer (needed for overlap logic) +! + + ntopcld = max(ntopcld, trop_cloud_top_lev) + + cldp(:ncol,1:ntopcld) = 0.0_r8 + if ( cam_physpkg_is('cam3')) then + cldp(:ncol,ntoplw:pver) = cld(:ncol,ntoplw:pver) + else + cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) + end if + cldp(:ncol,pverp) = 0.0_r8 +! +! +! Select only those locations where there are no clouds +! (maximum cloud fraction <= 1.e-3 treated as clear) +! Set all-sky fluxes to clear-sky values. +! + maxcld(1:ncol) = maxval(cldp(1:ncol,ntoplw:pver),dim=2) + + npts = 0 + do i=1,ncol + if (maxcld(i) < cldmin) then + npts = npts + 1 + indx(npts) = i + end if + end do + + do ii = 1, npts + i = indx(ii) + do k = ntoplw, pverp + fdl(i,k) = fsdl(i,k) + ful(i,k) = fsul(i,k) + end do + end do +! +! Select only those locations where there are clouds +! + npts = 0 + do i=1,ncol + if (maxcld(i) >= cldmin) then + npts = npts + 1 + indx(npts) = i + end if + end do + +! +! Initialize all-sky fluxes. fdl(i,1) & ful(i,pverp) are boundary conditions +! + do ii = 1, npts + i = indx(ii) + fdl(i,ntoplw) = fsdl(i,ntoplw) + fdl(i,pverp) = 0.0_r8 + ful(i,ntoplw) = 0.0_r8 + ful(i,pverp) = fsul(i,pverp) + do k = ntoplw+1, pver + fdl(i,k) = 0.0_r8 + ful(i,k) = 0.0_r8 + end do +! +! Initialize Planck emission from layer boundaries +! + do k = ntoplw, pver + fclt4(i,k-1) = stebol_cgs*tint4(i,k) + fclb4(i,k-1) = stebol_cgs*tint4(i,k+1) + enddo + fclb4(i,ntoplw-2) = stebol_cgs*tint4(i,ntoplw) + fclt4(i,pver) = stebol_cgs*tint4(i,pverp) +! +! Initialize indices for layers to be max-overlapped +! + do irgn = 0, nmxrgn(i) + kx2(i,irgn) = ntoplw-1 + end do + nrgn(i) = 0 + end do + +!---------------------------------------------------------------------- +! INDEX CALCULATIONS FOR MAX OVERLAP + +!CSD$ PARALLEL DO PRIVATE( ii, ilon, irgn, n, k1, k2, k, indxmx, ncolmx, iimx, i, ksort ) & +!CSD$ PRIVATE( asort, ktmp, atmp, km1, km4, k3, emx0, nxsk, emx, cld0 ) & +!CSD$ PRIVATE( tmp4, l1, tmp3, tfdl, l, cld1, trans, km3, tful ) + do ii = 1, npts + ilon = indx(ii) + +! +! Outermost loop over regions (sets of adjacent layers) to be max overlapped +! + do irgn = 1, nmxrgn(ilon) +! +! Calculate min/max layer indices inside region. +! + n = 0 + if (kx2(ilon,irgn-1) < pver) then + nrgn(ilon) = irgn + k1 = kx2(ilon,irgn-1)+1 + kx1(ilon,irgn) = k1 + kx2(ilon,irgn) = k1 - 1 + do k2 = pver, k1, -1 + if (pmid(ilon,k2) <= pmxrgn(ilon,irgn)) then + kx2(ilon,irgn) = k2 + exit + end if + end do +! +! Identify columns with clouds in the given region. +! + do k = k1, k2 + if (cldp(ilon,k) >= cldmin) then + n = n+1 + indxmx(n,irgn) = ilon + exit + endif + end do + endif + ncolmx(irgn) = n +! +! Dummy value for handling clear-sky regions +! + indxmx(ncolmx(irgn)+1,irgn) = ncol+1 +! +! Outer loop over columns with clouds in the max-overlap region +! + do iimx = 1, ncolmx(irgn) + i = indxmx(iimx,irgn) +! +! Sort cloud areas and corresponding level indices. +! + n = 0 + do k = kx1(i,irgn),kx2(i,irgn) + if (cldp(i,k) >= cldmin) then + n = n+1 + ksort(n) = k +! +! We need indices for clouds in order of largest to smallest, so +! sort 1-cld in ascending order +! + asort(n) = 1.0_r8-cldp(i,k) + end if + end do + nxs(i,irgn) = n +! +! If nxs(i,irgn) eq 1, no need to sort. +! If nxs(i,irgn) eq 2, sort by swapping if necessary +! If nxs(i,irgn) ge 3, sort using local sort routine +! + if (nxs(i,irgn) == 2) then + if (asort(2) < asort(1)) then + ktmp = ksort(1) + ksort(1) = ksort(2) + ksort(2) = ktmp + + atmp = asort(1) + asort(1) = asort(2) + asort(2) = atmp + endif + else if (nxs(i,irgn) >= 3) then + call quick_sort(asort(1:nxs(i,irgn)),ksort(1:nxs(i,irgn))) + endif + + do l = 1, nxs(i,irgn) + kxs(l,i,irgn) = ksort(l) + end do +! +! End loop over longitude i for fluxes +! + end do +! +! End loop over regions irgn for max-overlap +! + end do +! +!---------------------------------------------------------------------- +! DOWNWARD FLUXES: +! Outermost loop over regions (sets of adjacent layers) to be max overlapped +! + do irgn = 1, nmxrgn(ilon) +! +! Compute clear-sky fluxes for regions without clouds +! + iimx = 1 + if (ilon < indxmx(iimx,irgn) .and. irgn <= nrgn(ilon)) then +! +! Calculate emissivity so that downward flux at upper boundary of region +! can be cast in form of solution for downward flux from cloud above +! that boundary. Then solutions for fluxes at other levels take form of +! random overlap expressions. Try to locate "cloud" as close as possible +! to TOA such that the "cloud" pseudo-emissivity is between 0 and 1. +! + k1 = kx1(ilon,irgn) + do km1 = ntoplw-2, k1-2 + km4 = km1+3 + k2 = k1 + k3 = k2+1 + tmp(ilon) = s(ilon,k2,min(k3,pverp))*min(1,pverp2-k3) + emx0 = (fdl(ilon,k1)-fsdl(ilon,k1))/ & + ((fclb4(ilon,km1)-s(ilon,k2,km4)+tmp(ilon))- fsdl(ilon,k1)) + if (emx0 >= 0.0_r8 .and. emx0 <= 1.0_r8) exit + end do + km1 = min(km1,k1-2) + do k2 = kx1(ilon,irgn)+1, kx2(ilon,irgn)+1 + k3 = k2+1 + tmp(ilon) = s(ilon,k2,min(k3,pverp))*min(1,pverp2-k3) + fdl(ilon,k2) = (1.0_r8-emx0)*fsdl(ilon,k2) + & + emx0*(fclb4(ilon,km1)-s(ilon,k2,km4)+tmp(ilon)) + end do + else if (ilon==indxmx(iimx,irgn) .and. iimx<=ncolmx(irgn)) then + iimx = iimx+1 + end if +! +! Outer loop over columns with clouds in the max-overlap region +! + do iimx = 1, ncolmx(irgn) + i = indxmx(iimx,irgn) + +! +! Calculate emissivity so that downward flux at upper boundary of region +! can be cast in form of solution for downward flux from cloud above that +! boundary. Then solutions for fluxes at other levels take form of +! random overlap expressions. Try to locate "cloud" as close as possible +! to TOA such that the "cloud" pseudo-emissivity is between 0 and 1. +! + k1 = kx1(i,irgn) + do km1 = ntoplw-2,k1-2 + km4 = km1+3 + k2 = k1 + k3 = k2 + 1 + tmp(i) = s(i,k2,min(k3,pverp))*min(1,pverp2-k3) + tmp2(i) = s(i,k2,min(km4,pverp))*min(1,pverp2-km4) + emx0 = (fdl(i,k1)-fsdl(i,k1))/((fclb4(i,km1)-tmp2(i)+tmp(i))-fsdl(i,k1)) + if (emx0 >= 0.0_r8 .and. emx0 <= 1.0_r8) exit + end do + km1 = min(km1,k1-2) + ksort(0) = km1 + 1 +! +! Loop to calculate fluxes at level k +! + nxsk = 0 + do k = kx1(i,irgn), kx2(i,irgn) +! +! Identify clouds (largest to smallest area) between kx1 and k +! Since nxsk will increase with increasing k up to nxs(i,irgn), once +! nxsk == nxs(i,irgn) then use the list constructed for previous k +! + if (nxsk < nxs(i,irgn)) then + nxsk = 0 + do l = 1, nxs(i,irgn) + k1 = kxs(l,i,irgn) + if (k >= k1) then + nxsk = nxsk + 1 + ksort(nxsk) = k1 + endif + end do + endif +! +! Dummy value of index to insure computation of cloud amt is valid for l=nxsk+1 +! + ksort(nxsk+1) = pverp +! +! Initialize iterated emissivity factors +! + do l = 1, nxsk + emx(l) = emis(i,ksort(l)) + end do +! +! Initialize iterated emissivity factor for bnd. condition at upper interface +! + emx(0) = emx0 +! +! Initialize previous cloud amounts +! + cld0 = 1.0_r8 +! +! Indices for flux calculations +! + k2 = k+1 + k3 = k2+1 + tmp4 = s(i,k2,min(k3,pverp))*min(1,pverp2-k3) +! +! Special case nxsk == 0 +! + if ( nxsk == 0 ) then + fdl(i,k2) = fdl(i,k2)+fsdl(i,k2) + if ( emx0 /= 0.0_r8 ) then + km1 = ksort(0)-1 + km4 = km1+3 + fdl(i,k2) = fdl(i,k2)+emx0* & + (fclb4(i,km1)-(s(i,k2,min(km4,pverp))*min(1,pverp2-km4))+tmp4-fsdl(i,k2)) + end if + cycle + end if ! nxsk == 0 + +! +! Loop over number of cloud levels inside region (biggest to smallest cld area) +! + do l1 = 0, nxsk + km1 = ksort(l1)-1 + km4 = km1+3 + tmp3(l1) = fclb4(i,km1)-(s(i,k2,min(km4,pverp))*min(1,pverp2-km4))+tmp4-fsdl(i,k2) + end do + + tfdl = 0.0_r8 + + do l = 1, nxsk+1 +! +! Calculate downward fluxes +! + cld1 = cldp(i,ksort(l))*min(1,nxsk+1-l) + if (cld0 /= cld1) then + tfdl = tfdl+(cld0-cld1)*fsdl(i,k2) + do l1 = 0, l - 1 + tfdl = tfdl+(cld0-cld1)*emx(l1)*tmp3(l1) + end do + endif + cld0 = cld1 +! +! Multiply emissivity factors by current cloud transmissivity +! + if (l <= nxsk) then + k1 = ksort(l) + trans = 1.0_r8-emis(i,k1) +! +! Ideally the upper bound on l1 would be l-1, but the sort routine +! scrambles the order of layers with identical cloud amounts +! + do l1 = 0, nxsk + if (ksort(l1) < k1) then + emx(l1) = emx(l1)*trans + endif + end do + end if +! +! End loop over number l of cloud levels +! + end do + fdl(i,k2) = tfdl +! +! End loop over level k for fluxes +! + end do +! +! End loop over longitude i for fluxes +! + end do +! +! End loop over regions irgn for max-overlap +! + end do + +! +!---------------------------------------------------------------------- +! UPWARD FLUXES: +! Outermost loop over regions (sets of adjacent layers) to be max overlapped +! + do irgn = nmxrgn(ilon), 1, -1 +! +! Compute clear-sky fluxes for regions without clouds +! + iimx = 1 + if (ilon < indxmx(iimx,irgn) .and. irgn <= nrgn(ilon)) then +! +! Calculate emissivity so that upward flux at lower boundary of region +! can be cast in form of solution for upward flux from cloud below that +! boundary. Then solutions for fluxes at other levels take form of +! random overlap expressions. Try to locate "cloud" as close as possible +! to surface such that the "cloud" pseudo-emissivity is between 0 and 1. +! Include allowance for surface emissivity (both numerator and denominator +! equal 1) +! + k1 = kx2(ilon,irgn)+1 + if (k1 < pverp) then + do km1 = pver-1,kx2(ilon,irgn),-1 + km3 = km1+2 + k2 = k1 + k3 = k2+1 + tmp(ilon) = s(ilon,k2,min(km3,pverp))* min(1,pverp2-km3) + emx0 = (ful(ilon,k1)-fsul(ilon,k1))/ & + ((fclt4(ilon,km1)+s(ilon,k2,k3)-tmp(ilon))- fsul(ilon,k1)) + if (emx0 >= 0.0_r8 .and. emx0 <= 1.0_r8) exit + end do + km1 = max(km1,kx2(ilon,irgn)) + else + km1 = k1-1 + km3 = km1+2 + emx0 = 1.0_r8 + endif + + do k2 = kx1(ilon,irgn), kx2(ilon,irgn) + k3 = k2+1 +! +! If km3 == pver+2, one of the s integrals = 0 (integration limits both = p_s) +! + tmp(ilon) = s(ilon,k2,min(km3,pverp))* min(1,pverp2-km3) + ful(ilon,k2) =(1.0_r8-emx0)*fsul(ilon,k2) + emx0* & + (fclt4(ilon,km1)+s(ilon,k2,k3)-tmp(ilon)) + end do + else if (ilon==indxmx(iimx,irgn) .and. iimx<=ncolmx(irgn)) then + iimx = iimx+1 + end if +! +! Outer loop over columns with clouds in the max-overlap region +! + do iimx = 1, ncolmx(irgn) + i = indxmx(iimx,irgn) + +! +! Calculate emissivity so that upward flux at lower boundary of region +! can be cast in form of solution for upward flux from cloud at that +! boundary. Then solutions for fluxes at other levels take form of +! random overlap expressions. Try to locate "cloud" as close as possible +! to surface such that the "cloud" pseudo-emissivity is between 0 and 1. +! Include allowance for surface emissivity (both numerator and denominator +! equal 1) +! + k1 = kx2(i,irgn)+1 + if (k1 < pverp) then + do km1 = pver-1,kx2(i,irgn),-1 + km3 = km1+2 + k2 = k1 + k3 = k2+1 + tmp(i) = s(i,k2,min(km3,pverp))*min(1,pverp2-km3) + emx0 = (ful(i,k1)-fsul(i,k1))/((fclt4(i,km1)+s(i,k2,k3)-tmp(i))-fsul(i,k1)) + if (emx0 >= 0.0_r8 .and. emx0 <= 1.0_r8) exit + end do + km1 = max(km1,kx2(i,irgn)) + else + emx0 = 1.0_r8 + km1 = k1-1 + endif + ksort(0) = km1 + 1 + +! +! Loop to calculate fluxes at level k +! + nxsk = 0 + do k = kx2(i,irgn), kx1(i,irgn), -1 +! +! Identify clouds (largest to smallest area) between k and kx2 +! Since nxsk will increase with decreasing k up to nxs(i,irgn), once +! nxsk == nxs(i,irgn) then use the list constructed for previous k +! + if (nxsk < nxs(i,irgn)) then + nxsk = 0 + do l = 1, nxs(i,irgn) + k1 = kxs(l,i,irgn) + if (k <= k1) then + nxsk = nxsk + 1 + ksort(nxsk) = k1 + endif + end do + endif +! +! Dummy value of index to insure computation of cloud amt is valid for l=nxsk+1 +! + ksort(nxsk+1) = pverp +! +! Initialize iterated emissivity factors +! + do l = 1, nxsk + emx(l) = emis(i,ksort(l)) + end do +! +! Initialize iterated emissivity factor for bnd. condition at lower interface +! + emx(0) = emx0 +! +! Initialize previous cloud amounts +! + cld0 = 1.0_r8 +! +! Indices for flux calculations +! + k2 = k + k3 = k2+1 +! +! Special case nxsk == 0 +! + if ( nxsk == 0 ) then + ful(i,k2) = ful(i,k2)+fsul(i,k2) + if ( emx0 /= 0.0_r8 ) then + km1 = ksort(0)-1 + km3 = km1+2 +! +! If km3 == pver+2, one of the s integrals = 0 (integration limits both = p_s) +! + ful(i,k2) = ful(i,k2)+emx0* & + (fclt4(i,km1)+s(i,k2,k3)-(s(i,k2,min(km3,pverp))*min(1,pverp2-km3))-fsul(i,k2)) + + end if + cycle + end if +! +! Loop over number of cloud levels inside region (biggest to smallest cld area) +! + do l1 = 0, nxsk + km1 = ksort(l1)-1 + km3 = km1+2 +! +! If km3 == pver+2, one of the s integrals = 0 (integration limits both = p_s) +! + tmp3(l1) = fclt4(i,km1)+s(i,k2,k3)-(s(i,k2,min(km3,pverp))*min(1,pverp2-km3))- fsul(i,k2) + end do + + tful = 0.0_r8 + + do l = 1, nxsk+1 +! +! Calculate upward fluxes +! + cld1 = cldp(i,ksort(l))*min(1,nxsk+1-l) + if (cld0 /= cld1) then + tful = tful+(cld0-cld1)*fsul(i,k2) + do l1 = 0, l - 1 + tful = tful+(cld0-cld1)*emx(l1)*tmp3(l1) + end do + endif + cld0 = cld1 +! +! Multiply emissivity factors by current cloud transmissivity +! + if (l <= nxsk) then + k1 = ksort(l) + trans = 1.0_r8-emis(i,k1) +! +! Ideally the upper bound on l1 would be l-1, but the sort routine +! scrambles the order of layers with identical cloud amounts +! + do l1 = 0, nxsk + if (ksort(l1) > k1) then + emx(l1) = emx(l1)*trans + endif + end do + end if +! +! End loop over number l of cloud levels +! + end do + ful(i,k2) = tful +! +! End loop over level k for fluxes +! + end do +! +! End loop over longitude i for fluxes +! + end do +! +! End loop over regions irgn for max-overlap +! + end do +! +! End outermost longitude loop +! + end do +!CSD$ END PARALLEL DO +! +! End cloud modification loops +! +!---------------------------------------------------------------------- +! All longitudes: store history tape quantities +! + do i=1,ncol + flwds(i) = fdl (i,pverp ) + fldsc(i) = fsdl(i,pverp ) + flns(i) = ful (i,pverp ) - fdl (i,pverp ) + flnsc(i) = fsul(i,pverp ) - fsdl(i,pverp ) + flnt(i) = ful (i,ntoplw) - fdl (i,ntoplw) + flntc(i) = fsul(i,ntoplw) - fsdl(i,ntoplw) + flut(i) = ful (i,ntoplw) + flutc(i) = fsul(i,ntoplw) + end do + + if (single_column.and.scm_crm_mode) then + call outfld('FUL ',ful*1.e-3_r8,pcols,lchnk) + call outfld('FDL ',fdl*1.e-3_r8,pcols,lchnk) + call outfld('FULC ',fsul*1.e-3_r8,pcols,lchnk) + call outfld('FDLC ',fsdl*1.e-3_r8,pcols,lchnk) + endif + + do k = ntoplw,pverp + do i = 1,ncol + fnl(i,k) = ful(i,k) - fdl(i,k) + end do + end do +! +! Computation of longwave heating (J/kg/s) +! + do k=ntoplw,pver + do i=1,ncol + qrl(i,k) = (ful(i,k) - fdl(i,k) - ful(i,k+1) + fdl(i,k+1))* & + 1.E-4_r8*gravit_cgs/((pint(i,k) - pint(i,k+1))) + qrlc(i,k) = (fsul(i,k) - fsdl(i,k) - fsul(i,k+1) + fsdl(i,k+1))* & + 1.E-4_r8*gravit_cgs/((pint(i,k) - pint(i,k+1))) + end do + end do +! Return 0 above solution domain + if ( ntoplw > 1 )then + qrl(:ncol,:ntoplw-1) = 0._r8 + qrlc(:ncol,:ntoplw-1) = 0._r8 + end if +! + return +end subroutine radclwmx + + + +!------------------------------------------------------------------------------- + +subroutine radlw_init(gravit, stebol) +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize various constants for radiation scheme; note that +! the radiation scheme uses cgs units. +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: gravit ! Acceleration of gravity (MKS) + real(r8), intent(in) :: stebol ! Stefan-Boltzmann's constant (MKS) +! +!----------------------------------------------------------------------- +! +! Set general radiation consts; convert to cgs units where appropriate: +! + gravit_cgs = 100._r8*gravit + stebol_cgs = 1.e3_r8*stebol + +end subroutine radlw_init + +!------------------------------------------------------------------------------- +subroutine aer_trans_from_od(ncol, odap_aer, aer_trn_ttl) + use radconstants, only: nlwbands + use ppgrid, only: pcols, pver, pverp + integer, intent(in) :: ncol +! [fraction] absorption optical depth, per layer + real(r8), intent(in) :: odap_aer(pcols,pver,nlwbands) +! [fraction] Total transmission between interfaces k1 and k2 + real(r8), intent(out) :: aer_trn_ttl(pcols,pverp,pverp,nlwbands) +! [fraction] absorption optical depth, cumulative from top + real(r8) :: odap_aer_ttl(pcols,pverp,nlwbands) + + integer i, k1, k2, bnd_idx ! column iterator, level iterators, band iterator + ! odap_aer_ttl is cumulative total optical depth from top of atmosphere + odap_aer_ttl = 0._r8 + do bnd_idx=1,nlwbands + do k1=1,pver + do i=1,ncol + odap_aer_ttl(i,k1+1,bnd_idx) = odap_aer_ttl(i,k1,bnd_idx) + odap_aer(i,k1,bnd_idx) + end do + end do + end do + + ! compute transmission from top of atmosphere to level + ! where angular dependence of optical depth has been + ! integrated (giving factor 1.666666) + do k1=1,pverp + aer_trn_ttl(1:pcols,k1,k1,:)=1._r8 + enddo + aer_trn_ttl(1:ncol,1,2:pverp,1:nlwbands) = & + exp(-1.66_r8 * odap_aer_ttl(1:ncol,2:pverp,1:nlwbands) ) + + ! compute transmission between a given layer (k1) and lower layers. + do k1=2,pver + do k2=k1+1,pverp + aer_trn_ttl(1:ncol,k1,k2,1:nlwbands) = & + aer_trn_ttl(1:ncol,1,k2,1:nlwbands) / & + aer_trn_ttl(1:ncol,1,k1,1:nlwbands) + end do + end do + + ! transmission from k1 to k2 is same as transmission from k2 to k1. + do k1=2,pverp + do k2=1,k1-1 + aer_trn_ttl(1:ncol,k1,k2,1:nlwbands)=aer_trn_ttl(1:ncol,k2,k1,1:nlwbands) + end do + end do + + return +end subroutine aer_trans_from_od + +end module radlw diff --git a/src/physics/camrt/radsw.F90 b/src/physics/camrt/radsw.F90 new file mode 100644 index 0000000000..e0d609a4cc --- /dev/null +++ b/src/physics/camrt/radsw.F90 @@ -0,0 +1,2285 @@ + +module radsw +!----------------------------------------------------------------------- +! +! Purpose: Solar radiation calculations. +! +!----------------------------------------------------------------------- +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use cam_abortutils, only: endrun +use cam_history, only: outfld +use scamMod, only: single_column,scm_crm_mode,have_asdir, & + asdirobs, have_asdif, asdifobs, have_aldir, & + aldirobs, have_aldif, aldifobs +use cam_logfile, only: iulog +use radconstants, only: nswbands, get_sw_spectral_boundaries, & + idx_sw_diag, indxsl + +implicit none + +private +save + +! Public methods + +public ::& + radsw_init, &! initialize constants + radcswmx ! driver for solar radiation code + +! Private module data + +real(r8) :: gravit ! Acceleration of gravity +real(r8) :: rga ! 1./gravit +real(r8) :: sslp ! Standard sea-level pressure + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine radcswmx(lchnk ,ncol , & + E_pint ,E_pmid ,E_h2ommr ,E_o3mmr , & + E_o2mmr ,E_cld ,E_cicewp ,E_cliqwp ,E_rel , & + E_rei ,eccf ,E_coszrs ,solin , & + E_asdir ,E_asdif ,E_aldir ,E_aldif ,nmxrgn , & + pmxrgn ,qrs,qrsc,fsnt ,fsntc ,fsdtoa, fsntoa, & + fsutoa ,fsntoac, fsnirtoa,fsnrtoac,fsnrtoaq,fsns , & + fsnsc ,fsdsc ,fsds ,sols ,soll , & + solsd ,solld , fns ,fcns , & + Nday ,Nnite ,IdxDay ,IdxNite, E_co2mmr, & + E_aer_tau, E_aer_tau_w, E_aer_tau_w_g, E_aer_tau_w_f, tauxcl_out, tauxci_out) +!----------------------------------------------------------------------- +! + +! Purpose: +! Solar radiation code +! +! Method: +! Basic method is Delta-Eddington as described in: +! +! Briegleb, Bruce P., 1992: Delta-Eddington +! Approximation for Solar Radiation in the NCAR Community Climate Model, +! Journal of Geophysical Research, Vol 97, D7, pp7603-7612). +! +! Five changes to the basic method described above are: +! (1) addition of sulfate aerosols (Kiehl and Briegleb, 1993) +! (2) the distinction between liquid and ice particle clouds +! (Kiehl et al, 1996); +! (3) provision for calculating TOA fluxes with spectral response to +! match Nimbus-7 visible/near-IR radiometers (Collins, 1998); +! (4) max-random overlap (Collins, 2001) +! (5) The near-IR absorption by H2O was updated in 2003 by Collins, +! Lee-Taylor, and Edwards for consistency with the new line data in +! Hitran 2000 and the H2O continuum version CKD 2.4. Modifications +! were optimized by reducing RMS errors in heating rates relative +! to a series of benchmark calculations for the 5 standard AFGL +! atmospheres. The benchmarks were performed using DISORT2 combined +! with GENLN3. The near-IR scattering optical depths for Rayleigh +! scattering were also adjusted, as well as the correction for +! stratospheric heating by H2O. +! +! The treatment of maximum-random overlap is described in the +! comment block "INDEX CALCULATIONS FOR MAX OVERLAP". +! +! Divides solar spectrum into 19 intervals from 0.2-5.0 micro-meters. +! solar flux fractions specified for each interval. allows for +! seasonally and diurnally varying solar input. Includes molecular, +! cloud, aerosol, and surface scattering, along with h2o,o3,co2,o2,cloud, +! and surface absorption. Computes delta-eddington reflections and +! transmissions assuming homogeneously mixed layers. Adds the layers +! assuming scattering between layers to be isotropic, and distinguishes +! direct solar beam from scattered radiation. +! +! Longitude loops are broken into 1 or 2 sections, so that only daylight +! (i.e. coszrs > 0) computations are done. +! +! Note that an extra layer above the model top layer is added. +! +! cgs units are used. +! +! Special diagnostic calculation of the clear sky surface and total column +! absorbed flux is also done for cloud forcing diagnostics. +! +!----------------------------------------------------------------------- +! +! D. Parks (NEC) 09/11/03 +! Restructuring of routine to support SX vector architecture. +! +! Possible improvements: +! +! 1. Look at vectorizing index calculations for maximum overlap. +! +! 2. Consider making innermost loop in flux computations the number +! of spectral intervals. Given that NS is fixed at 19, the trade-off +! will be stride one memory accesses of length 19 versus indirect +! addressing (list vector - gather/scatter) with potential vector +! lenghts of the number of day light points. Vectorizing on the number +! of spectral intervals seems worthwhile for low resolution models (T42), +! but might be inefficient with higher resolutions. +! +! 3. Move the linearization of daylight points (compression/expansion) out +! of radcswmx and into d_p_coupling. This would eliminate the cost of +! routines CmpDayNite and ExpDayNite. +! +! 4. Look at expliciting computing all streams in upward propagation of +! radiation. There would be additional floating point operations in +! exchange for the elimination of indirect addressing. +! +!----------------------------------------------------------------------- + + use rad_solar_var, only: get_variability + use cmparray_mod, only: CmpDayNite, ExpDayNite + use quicksort, only: quick_sort + use phys_control, only: phys_getopts + use solar_irrad_data, only: sol_tsi, do_spctrl_scaling, ref_tsi + use radconstants, only: frcsol, ph2o, pco2, po2 + +!-----------------------Constants for new band (640-700 nm)------------- + real(r8) v_raytau_35 + real(r8) v_raytau_64 + real(r8) v_abo3_35 + real(r8) v_abo3_64 + parameter( & + v_raytau_35 = 0.155208_r8, & + v_raytau_64 = 0.0392_r8, & + v_abo3_35 = 2.4058030e+01_r8, & + v_abo3_64 = 2.210e+01_r8 & + ) + + +!-------------Parameters for accelerating max-random solution------------- +! +! The solution time scales like prod(j:1->N) (1 + n_j) where +! N = number of max-overlap regions (nmxrgn) +! n_j = number of unique cloud amounts in region j +! +! Therefore the solution cost can be reduced by decreasing n_j. +! cldmin reduces n_j by treating cloud amounts < cldmin as clear sky. +! cldeps reduces n_j by treating cloud amounts identical to log(1/cldeps) +! decimal places as identical +! +! areamin reduces the cost by dropping configurations that occupy +! a surface area < areamin of the model grid box. The surface area +! for a configuration C(j,k_j), where j is the region number and k_j is the +! index for a unique cloud amount (in descending order from biggest to +! smallest clouds) in region j, is +! +! A = prod(j:1->N) [C(j,k_j) - C(j,k_j+1)] +! +! where C(j,0) = 1.0 and C(j,n_j+1) = 0.0. +! +! nconfgmax reduces the cost and improves load balancing by setting an upper +! bound on the number of cloud configurations in the solution. If the number +! of configurations exceeds nconfgmax, the nconfgmax configurations with the +! largest area are retained, and the fluxes are normalized by the total area +! of these nconfgmax configurations. For the current max/random overlap +! assumption (see subroutine cldovrlap), 30 levels, and cloud-amount +! parameterization, the mean and RMS number of configurations are +! both roughly 5. nconfgmax has been set to the mean+2*RMS number, or 15. +! +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Minimimum horizontal area (as a fraction of the grid-box area) to retain +! for a unique cloud configuration in the max-random solution +! + real(r8) areamin + parameter (areamin = 0.01_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) +! +! Maximum number of configurations to include in solution +! + integer nconfgmax + parameter (nconfgmax = 15) +!------------------------------Commons---------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + integer,intent(in) :: Nday ! Number of daylight columns + integer,intent(in) :: Nnite ! Number of night columns + integer,intent(in), dimension(pcols) :: IdxDay ! Indicies of daylight coumns + integer,intent(in), dimension(pcols) :: IdxNite ! Indicies of night coumns + + + real(r8), intent(in) :: E_pmid(pcols,pver) ! Level pressure + real(r8), intent(in) :: E_pint(pcols,pverp) ! Interface pressure + real(r8), intent(in) :: E_h2ommr(pcols,pver) ! Specific humidity (h2o mass mix ratio) + real(r8), intent(in) :: E_o3mmr(pcols,pver) ! Ozone mass mixing ratio + real(r8), intent(in) :: E_o2mmr(pcols) ! oxygen mass mixing ratio +! + real(r8), intent(in) :: E_cld(pcols,pver) ! Fractional cloud cover + real(r8), intent(in) :: E_cicewp(pcols,pver) ! in-cloud cloud ice water path + real(r8), intent(in) :: E_cliqwp(pcols,pver) ! in-cloud cloud liquid water path + real(r8), intent(in) :: E_rel(pcols,pver) ! Liquid effective drop size (microns) + real(r8), intent(in) :: E_rei(pcols,pver) ! Ice effective drop size (microns) +! + real(r8), intent(in) :: eccf ! Eccentricity factor (1./earth-sun dist^2) + real(r8), intent(in) :: E_coszrs(pcols) ! Cosine solar zenith angle + real(r8), intent(in) :: E_asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad + real(r8), intent(in) :: E_aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad + real(r8), intent(in) :: E_asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad + real(r8), intent(in) :: E_aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad + real(r8), intent(in) :: E_co2mmr(pcols) ! co2 column mean mmr + +! +! Aerosol radiative property arrays +! + real(r8),intent(in) :: E_aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8),intent(in) :: E_aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8),intent(in) :: E_aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau + +! +! IN/OUT arguments +! + real(r8), intent(inout) :: pmxrgn(pcols,pverp) ! Maximum values of pressure for each +! ! maximally overlapped region. +! ! 0->pmxrgn(i,1) is range of pressure for +! ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for +! ! 2nd region, etc + integer, intent(inout) :: nmxrgn(pcols) ! Number of maximally overlapped regions +! +! Output arguments +! + + real(r8), intent(out) :: solin(pcols) ! Incident solar flux + real(r8), intent(out) :: qrs (pcols,pver) ! Solar heating rate + real(r8), intent(out) :: qrsc(pcols,pver) ! Clearsky solar heating rate + real(r8), intent(out) :: fsns(pcols) ! Surface absorbed solar flux + real(r8), intent(out) :: fsnt(pcols) ! Total column absorbed solar flux + real(r8), intent(out) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8), intent(out) :: fsutoa(pcols) ! Upward solar flux at TOA + real(r8), intent(out) :: fsds(pcols) ! Flux shortwave downwelling surface +! + real(r8), intent(out) :: fsnsc(pcols) ! Clear sky surface absorbed solar flux + real(r8), intent(out) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + real(r8), intent(out) :: fsntc(pcols) ! Clear sky total column absorbed solar flx + real(r8), intent(out) :: fsdtoa(pcols) ! Downwelling solar flux at TOA + real(r8), intent(out) :: fsntoac(pcols) ! Clear sky net solar flx at TOA + real(r8), intent(out) :: sols(pcols) ! Direct solar rad on surface (< 0.7) + real(r8), intent(out) :: soll(pcols) ! Direct solar rad on surface (>= 0.7) + real(r8), intent(out) :: solsd(pcols) ! Diffuse solar rad on surface (< 0.7) + real(r8), intent(out) :: solld(pcols) ! Diffuse solar rad on surface (>= 0.7) + real(r8), intent(out) :: fsnirtoa(pcols) ! Near-IR flux absorbed at toa + real(r8), intent(out) :: fsnrtoac(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8), intent(out) :: fsnrtoaq(pcols) ! Net near-IR flux at toa >= 0.7 microns + + real(r8), intent(out) :: fns(pcols,pverp) ! net flux at interfaces + real(r8), intent(out) :: fcns(pcols,pverp) ! net clear-sky flux at interfaces + + real(r8), intent(out) :: tauxcl_out(pcols,pver) ! liquid cloud visible sw optical depth + real(r8), intent(out) :: tauxci_out(pcols,pver) ! ice cloud visible sw optical depth + +! +!---------------------------Local variables----------------------------- +! +! Local and reordered copies of the intent(in) variables +! + real(r8):: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8):: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8):: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau + real(r8) :: pmid(pcols,pver) ! Level pressure + real(r8) :: pint(pcols,pverp) ! Interface pressure + real(r8) :: h2ommr(pcols,pver) ! Specific humidity (h2o mass mix ratio) + real(r8) :: o3mmr(pcols,pver) ! Ozone mass mixing ratio +! + real(r8) :: cld(pcols,pver) ! Fractional cloud cover + real(r8) :: cicewp(pcols,pver) ! in-cloud cloud ice water path + real(r8) :: cliqwp(pcols,pver) ! in-cloud cloud liquid water path + real(r8) :: rel(pcols,pver) ! Liquid effective drop size (microns) + real(r8) :: rei(pcols,pver) ! Ice effective drop size (microns) +! + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + real(r8) :: asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad + real(r8) :: aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad + real(r8) :: asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad + real(r8) :: aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad + real(r8) :: co2mmr(pcols) ! co2 column mean mmr + real(r8) :: o2mmr(pcols) ! o2 column mean mmr + + real(r8) :: tot_irrad +! +! Max/random overlap variables +! + real(r8) asort(pverp) ! 1 - cloud amounts to be sorted for max ovrlp. + real(r8) atmp ! Temporary storage for sort when nxs = 2 + real(r8) cld0 ! 1 - (cld amt) used to make wstr, cstr, nstr + real(r8) totwgt(pcols) ! Total of xwgts = total fractional area of +! grid-box covered by cloud configurations +! included in solution to fluxes + + real(r8) wgtv(nconfgmax) ! Weights for fluxes +! 1st index is configuration number + real(r8) wstr(pverp,pverp) ! area weighting factors for streams +! 1st index is for stream #, +! 2nd index is for region # + + real(r8) xexpt ! solar direct beam trans. for layer above + real(r8) xrdnd ! diffuse reflectivity for layer above + real(r8) xrupd ! diffuse reflectivity for layer below + real(r8) xrups ! direct-beam reflectivity for layer below + real(r8) xtdnt ! total trans for layers above + + real(r8) xwgt ! product of cloud amounts + + real(r8) yexpt ! solar direct beam trans. for layer above + real(r8) yrdnd ! diffuse reflectivity for layer above + real(r8) yrupd ! diffuse reflectivity for layer below + real(r8) ytdnd ! dif-beam transmission for layers above + real(r8) ytupd ! dif-beam transmission for layers below + + real(r8) zexpt ! solar direct beam trans. for layer above + real(r8) zrdnd ! diffuse reflectivity for layer above + real(r8) zrupd ! diffuse reflectivity for layer below + real(r8) zrups ! direct-beam reflectivity for layer below + real(r8) ztdnt ! total trans for layers above + + logical new_term ! Flag for configurations to include in fluxes + logical region_found ! flag for identifying regions + + integer ccon(nconfgmax,0:pverp,pcols) +! flags for presence of clouds +! 1st index is for level # (including +! layer above top of model and at surface) +! 2nd index is for configuration # + integer cstr(0:pverp,pverp) +! flags for presence of clouds +! 1st index is for level # (including +! layer above top of model and at surface) +! 2nd index is for stream # + integer icond(nconfgmax,0:pverp,pcols) +! Indices for copying rad. properties from +! one identical downward cld config. +! to another in adding method (step 2) +! 1st index is for interface # (including +! layer above top of model and at surface) +! 2nd index is for configuration # range + integer iconu(nconfgmax,0:pverp,pcols) +! Indices for copying rad. properties from +! one identical upward configuration +! to another in adding method (step 2) +! 1st index is for interface # (including +! layer above top of model and at surface) +! 2nd index is for configuration # range + integer iconfig ! Counter for random-ovrlap configurations + integer irgn ! Index for max-overlap regions + integer is0 ! Lower end of stream index range + integer is1 ! Upper end of stream index range + integer isn ! Stream index + integer istr(pverp+1) ! index for stream #s during flux calculation + integer istrtd(0:nconfgmax+1,0:pverp,pcols) +! indices into icond +! 1st index is for interface # (including +! layer above top of model and at surface) +! 2nd index is for configuration # range + integer istrtu(0:nconfgmax+1,0:pverp,pcols) +! indices into iconu +! 1st index is for interface # (including +! layer above top of model and at surface) +! 2nd index is for configuration # range + integer j ! Configuration index + integer jj ! Configuration index + integer k1 ! Level index + integer k2 ! Level index + integer ksort(pverp) ! Level indices of cloud amounts to be sorted + integer ktmp ! Temporary storage for sort when nxs = 2 + integer kx1(0:pverp) ! Level index for top of max-overlap region + integer kx2(0:pverp) ! Level index for bottom of max-overlap region + integer l ! Index + integer l0 ! Index + integer mrgn ! Counter for nrgn + integer mstr ! Counter for nstr + integer n0 ! Number of configurations with ccon(:,k,:)==0 + integer n1 ! Number of configurations with ccon(:,k,:)==1 + integer nconfig(pcols) ! Number of random-ovrlap configurations + integer nconfigm ! Value of config before testing for areamin, +! nconfgmax + integer npasses ! number of passes over the indexing loop + integer nrgn ! Number of max overlap regions at current +! longitude + integer nstr(pverp) ! Number of unique cloud configurations +! ("streams") in a max-overlapped region +! 1st index is for region # + integer nuniq ! # of unique cloud configurations + integer nuniqd(0:pverp,pcols) ! # of unique cloud configurations: TOA +! to level k + integer nuniqu(0:pverp,pcols) ! # of unique cloud configurations: surface +! to level k + integer nxs ! Number of cloudy layers between k1 and k2 + integer ptr0(nconfgmax) ! Indices of configurations with ccon(:,k,:)==0 + integer ptr1(nconfgmax) ! Indices of configurations with ccon(:,k,:)==1 + integer ptrc(nconfgmax) ! Pointer for configurations sorted by wgtv + integer, dimension(1) :: min_idx ! required for return val of func minloc + +! +! Other +! + integer ns ! Spectral loop index + integer i ! Longitude loop index + integer k ! Level loop index + integer km1 ! k - 1 + integer kp1 ! k + 1 + integer n ! Loop index for daylight + integer ksz ! dust size bin index + integer kaer ! aerosol group index +! +! A. Slingo's data for cloud particle radiative properties (from 'A GCM +! Parameterization for the Shortwave Properties of Water Clouds' JAS +! vol. 46 may 1989 pp 1419-1427) +! + + real(r8), parameter :: abarl(4) = (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8), parameter :: bbarl(4) = (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8), parameter :: cbarl(4) = (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8), parameter :: dbarl(4) = (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8), parameter :: ebarl(4) = (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8), parameter :: fbarl(4) = (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band +! +! Caution... A. Slingo recommends no less than 4.0 micro-meters nor +! greater than 20 micro-meters +! +! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) +! + real(r8), parameter :: abari(4) = (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8), parameter :: bbari(4) = (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8), parameter :: cbari(4) = (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8), parameter :: dbari(4) = (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8), parameter :: ebari(4) = (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8), parameter :: fbari(4) = (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + +! +! UPDATE TO H2O NEAR-IR: Delta optimized for Hitran 2K and CKD 2.4 +! + real(r8), parameter :: delta = 0.0014257179260883_r8 +! +! END UPDATE +! + real(r8) :: albdir(pcols,nswbands) ! Current spc intrvl srf alb to direct rad + real(r8) :: albdif(pcols,nswbands) ! Current spc intrvl srf alb to diffuse rad +! +! Next series depends on spectral interval +! + real(r8) :: wgtint ! Weight for specific spectral interval + +! +! weight for 0.64 - 0.7 microns appropriate to clear skies over oceans +! + real(r8), parameter :: nirwgt(nswbands) = & + (/ 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, & + 0.0_r8, 0.0_r8, 0.0_r8, 0.320518_r8, 1.0_r8, 1.0_r8, & + 1.0_r8, 1.0_r8, 1.0_r8, 1.0_r8, 1.0_r8, & + 1.0_r8, 1.0_r8, 1.0_r8 /) + +! +! UPDATE TO H2O NEAR-IR: Rayleigh scattering optimized for Hitran 2K & CKD 2.4 +! + real(r8), parameter :: raytau(nswbands) = & + (/ 4.020_r8, 2.180_r8, 1.700_r8, 1.450_r8, 1.250_r8, & + 1.085_r8, 0.730_r8, v_raytau_35, v_raytau_64, & + 0.02899756_r8, 0.01356763_r8, 0.00537341_r8, & + 0.00228515_r8, 0.00105028_r8, 0.00046631_r8, & + 0.00025734_r8, & + .0001_r8, .0001_r8, .0001_r8/) +! +! END UPDATE +! + +! +! Absorption coefficients +! +! +! UPDATE TO H2O NEAR-IR: abh2o optimized for Hitran 2K and CKD 2.4 +! + real(r8), parameter :: abh2o(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, & + 0.00256608_r8, 0.06310504_r8, 0.42287445_r8, 2.45397941_r8, & + 11.20070807_r8, 47.66091389_r8, 240.19010243_r8, & + .000_r8, .000_r8, .000_r8/) +! +! END UPDATE +! + + real(r8), parameter :: abo3(nswbands) = & + (/5.370e+04_r8, 13.080e+04_r8, 9.292e+04_r8, 4.530e+04_r8, 1.616e+04_r8, & + 4.441e+03_r8, 1.775e+02_r8, v_abo3_35, v_abo3_64, .000_r8, & + .000_r8, .000_r8 , .000_r8 , .000_r8 , .000_r8, & + .000_r8, .000_r8 , .000_r8 , .000_r8 /) + + real(r8), parameter :: abco2(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .094_r8, .196_r8, 1.963_r8/) + + real(r8), parameter :: abo2(nswbands) = & + (/ .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8,1.11e-05_r8,6.69e-05_r8, & + .000_r8, .000_r8, .000_r8, .000_r8, .000_r8, & + .000_r8, .000_r8, .000_r8, .000_r8/) +! +! Diagnostic and accumulation arrays; note that fswup, and +! fswdn are not used in the computation,but are retained for future use. +! + real(r8) solflx(pcols) ! Solar flux in current interval + real(r8) totfld (pcols,0:pver) ! Spectrally summed flux divergence + real(r8) totfldc(pcols,0:pver) ! Spectrally summed flux divergence (clearsky) + real(r8) fswup(pcols,0:pverp) ! Spectrally summed up flux + real(r8) fswdn(pcols,0:pverp) ! Spectrally summed down flux +! +! Cloud radiative property arrays +! + real(r8) tauxcl(pcols,0:pver) ! water cloud extinction optical depth + real(r8) tauxci(pcols,0:pver) ! ice cloud extinction optical depth + real(r8) wcl(pcols,0:pver) ! liquid cloud single scattering albedo + real(r8) gcl(pcols,0:pver) ! liquid cloud asymmetry parameter + real(r8) fcl(pcols,0:pver) ! liquid cloud forward scattered fraction + real(r8) wci(pcols,0:pver) ! ice cloud single scattering albedo + real(r8) gci(pcols,0:pver) ! ice cloud asymmetry parameter + real(r8) fci(pcols,0:pver) ! ice cloud forward scattered fraction + +! +! Various arrays and other constants: +! + real(r8) pflx(pcols,0:pverp) ! Interface press, including extra layer + real(r8) zenfac(pcols) ! Square root of cos solar zenith angle + real(r8) sqrco2(pcols) ! Square root of the co2 mass mixg ratio + real(r8) tmp1 ! Temporary constant array + real(r8) tmp2 ! Temporary constant array + real(r8) pdel ! Pressure difference across layer + real(r8) path ! Mass path of layer + real(r8) ptop ! Lower interface pressure of extra layer + real(r8) ptho2 ! Used to compute mass path of o2 + real(r8) ptho3 ! Used to compute mass path of o3 + real(r8) pthco2 ! Used to compute mass path of co2 + real(r8) pthh2o ! Used to compute mass path of h2o + real(r8) h2ostr ! Inverse sq. root h2o mass mixing ratio + + real(r8) wavmin(nswbands) ! Spectral interval minimum wavelength + real(r8) wavmax(nswbands) ! Spectral interval maximum wavelength + real(r8) wavmid(nswbands) ! Spectral interval middle wavelength + real(r8) trayoslp ! Rayleigh optical depth/standard pressure + real(r8) tmp1l ! Temporary constant array + real(r8) tmp2l ! Temporary constant array + real(r8) tmp3l ! Temporary constant array + real(r8) tmp1i ! Temporary constant array + real(r8) tmp2i ! Temporary constant array + real(r8) tmp3i ! Temporary constant array + real(r8) rdenom ! Multiple scattering term + real(r8) rdirexp ! layer direct ref times exp transmission + real(r8) tdnmexp ! total transmission - exp transmission + real(r8) psf(nswbands) ! Frac of solar flux in spect interval +! +! Layer absorber amounts; note that 0 refers to the extra layer added +! above the top model layer +! + real(r8) uh2o(pcols,0:pver) ! Layer absorber amount of h2o + real(r8) uo3(pcols,0:pver) ! Layer absorber amount of o3 + real(r8) uco2(pcols,0:pver) ! Layer absorber amount of co2 + real(r8) uo2(pcols,0:pver) ! Layer absorber amount of o2 +! +! Total column absorber amounts: +! + real(r8) uth2o(pcols) ! Total column absorber amount of h2o + real(r8) uto3(pcols) ! Total column absorber amount of o3 + real(r8) utco2(pcols) ! Total column absorber amount of co2 + real(r8) uto2(pcols) ! Total column absorber amount of o2 +! +! These arrays are defined for pver model layers; 0 refers to the extra +! layer on top: +! + real(r8) rdir(nswbands,pcols,0:pver) ! Layer reflectivity to direct rad + real(r8) rdif(nswbands,pcols,0:pver) ! Layer reflectivity to diffuse rad + real(r8) tdir(nswbands,pcols,0:pver) ! Layer transmission to direct rad + real(r8) tdif(nswbands,pcols,0:pver) ! Layer transmission to diffuse rad + real(r8) explay(nswbands,pcols,0:pver) ! Solar beam exp trans. for layer + + real(r8) rdirc(nswbands,pcols,0:pver) ! Clear Layer reflec. to direct rad + real(r8) rdifc(nswbands,pcols,0:pver) ! Clear Layer reflec. to diffuse rad + real(r8) tdirc(nswbands,pcols,0:pver) ! Clear Layer trans. to direct rad + real(r8) tdifc(nswbands,pcols,0:pver) ! Clear Layer trans. to diffuse rad + real(r8) explayc(nswbands,pcols,0:pver) ! Solar beam exp trans. clear layer + + real(r8) fus(pcols,pverp) ! Upward flux (added for CRM) + real(r8) fds(pcols,pverp) ! Downward flux (added for CRM) + real(r8) fusc(pcols,pverp) ! Upward clear-sky flux (added for CRM) + real(r8) fdsc(pcols,pverp) ! Downward clear-sky flux (added for CRM) + + real(r8) flxdiv ! Flux divergence for layer + +! +! Temporary arrays for either clear or cloudy values. +! + real(r8), dimension(nswbands) :: Trdir + real(r8), dimension(nswbands) :: Trdif + real(r8), dimension(nswbands) :: Ttdir + real(r8), dimension(nswbands) :: Ttdif + real(r8), dimension(nswbands) :: Texplay +! +! +! Radiative Properties: +! +! There are 1 classes of properties: +! (1. All-sky bulk properties +! (2. Clear-sky properties +! +! The first set of properties are generated during step 2 of the solution. +! +! These arrays are defined at model interfaces; in 1st index (for level #), +! 0 is the top of the extra layer above the model top, and +! pverp is the earth surface. 2nd index is for cloud configuration +! defined over a whole column. +! + real(r8) exptdn(nswbands,0:pverp,nconfgmax,pcols) ! Sol. beam trans from layers above + real(r8) rdndif(nswbands,0:pverp,nconfgmax,pcols) ! Ref to dif rad for layers above + real(r8) rupdif(nswbands,0:pverp,nconfgmax,pcols) ! Ref to dif rad for layers below + real(r8) rupdir(nswbands,0:pverp,nconfgmax,pcols) ! Ref to dir rad for layers below + real(r8) tdntot(nswbands,0:pverp,nconfgmax,pcols) ! Total trans for layers above +! +! Bulk properties used during the clear-sky calculation. +! + real(r8) exptdnc(pcols,0:pverp) ! clr: Sol. beam trans from layers above + real(r8) rdndifc(pcols,0:pverp) ! clr: Ref to dif rad for layers above + real(r8) rupdifc(pcols,0:pverp) ! clr: Ref to dif rad for layers below + real(r8) rupdirc(pcols,0:pverp) ! clr: Ref to dir rad for layers below + real(r8) tdntotc(pcols,0:pverp) ! clr: Total trans for layers above + + real(r8) fluxup(nswbands,0:pverp,pcols) ! Up flux at model interface + real(r8) fluxdn(nswbands,0:pverp,pcols) ! Down flux at model interface + real(r8) wexptdn(nswbands,pcols) ! Direct solar beam trans. to surface +! +! Scalars used in vectorization +! + integer :: kk +! +! Arrays used in vectorization +! + real(r8) v_wgtv(nconfgmax,pcols) ! Weights for fluxes + + real(r8) :: rdiff, ro, rn + rdiff(ro,rn) = abs((ro-rn)/merge(ro,1.0_r8,ro /= 0.0_r8)) + +! solar variability factor + real(r8) :: sfac(nswbands) + + character(len=16) :: microp_scheme ! microphysics scheme + + !----------------------------------------------------------------------- + ! START OF CALCULATION + !----------------------------------------------------------------------- + + call phys_getopts(microp_scheme_out=microp_scheme) + +! +! Initialize output fields: +! + fsds(1:ncol) = 0.0_r8 + + fsnirtoa(1:ncol) = 0.0_r8 + fsnrtoac(1:ncol) = 0.0_r8 + fsnrtoaq(1:ncol) = 0.0_r8 + + fsns(1:ncol) = 0.0_r8 + fsnsc(1:ncol) = 0.0_r8 + fsdsc(1:ncol) = 0.0_r8 + + fsnt(1:ncol) = 0.0_r8 + fsntc(1:ncol) = 0.0_r8 + fsntoa(1:ncol) = 0.0_r8 + fsdtoa(1:ncol) = 0.0_r8 + fsutoa(1:ncol) = 0.0_r8 + fsntoac(1:ncol) = 0.0_r8 + + solin(1:ncol) = 0.0_r8 + + sols(1:ncol) = 0.0_r8 + soll(1:ncol) = 0.0_r8 + solsd(1:ncol) = 0.0_r8 + solld(1:ncol) = 0.0_r8 + + qrs (1:ncol,1:pver) = 0.0_r8 + qrsc(1:ncol,1:pver) = 0.0_r8 + fns(1:ncol,1:pverp) = 0.0_r8 + fcns(1:ncol,1:pverp) = 0.0_r8 + if (single_column.and.scm_crm_mode) then + fus(1:ncol,1:pverp) = 0.0_r8 + fds(1:ncol,1:pverp) = 0.0_r8 + fusc(:ncol,:pverp) = 0.0_r8 + fdsc(:ncol,:pverp) = 0.0_r8 + endif + + tauxcl_out(1:pcols,1:pver) = 0.0_r8 + tauxci_out(1:pcols,1:pver) = 0.0_r8 + +! +! If night everywhere, return: +! + if ( Nday == 0 ) then + return + endif + +! +! Rearrange input arrays +! + + call CmpDayNite(E_pmid, pmid, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_pint, pint, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call CmpDayNite(E_h2ommr, h2ommr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_o3mmr, o3mmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_cld, cld, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_cicewp, cicewp, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_cliqwp, cliqwp, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_rel, rel, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_rei, rei, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call CmpDayNite(E_coszrs, coszrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_asdir, asdir, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_aldir, aldir, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_asdif, asdif, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_aldif, aldif, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_co2mmr, co2mmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_o2mmr, o2mmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + + call CmpDayNite(pmxrgn, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call CmpDayNite(nmxrgn, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_aer_tau, aer_tau, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 0, pver, 1,nswbands) + call CmpDayNite(E_aer_tau_w, aer_tau_w, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 0, pver, 1,nswbands) + call CmpDayNite(E_aer_tau_w_g, aer_tau_w_g, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 0, pver, 1,nswbands) + call CmpDayNite(E_aer_tau_w_f, aer_tau_w_f, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 0, pver, 1,nswbands) + + if (scm_crm_mode) then + ! overwrite albedos for CRM + if(have_asdir) asdir = asdirobs(1) + if(have_asdif) asdif = asdifobs(1) + if(have_aldir) aldir = aldirobs(1) + if(have_aldif) aldif = aldifobs(1) + endif +! +! Perform other initializations +! + tmp1 = 0.5_r8/(gravit*sslp) + tmp2 = delta/gravit + + do i = 1, Nday + sqrco2(i) = sqrt(co2mmr(i)) + end do + + if ( do_spctrl_scaling ) then + call get_variability(sfac) + tot_irrad = ref_tsi + else + tot_irrad = sol_tsi + endif + + do k=1,pverp + do i=1,Nday + pflx(i,k) = pint(i,k) + end do + end do + + do i=1,Nday +! +! Define solar incident radiation and interface pressures: +! + + solin(i) = tot_irrad*1.e3_r8*eccf*coszrs(i) + + pflx(i,0) = 0._r8 +! +! Compute optical paths: +! + ptop = pflx(i,1) + ptho2 = o2mmr(i) * ptop / gravit + ptho3 = o3mmr(i,1) * ptop / gravit + pthco2 = sqrco2(i) * (ptop / gravit) + h2ostr = sqrt( 1._r8 / h2ommr(i,1) ) + zenfac(i) = sqrt(coszrs(i)) + pthh2o = ptop**2*tmp1 + (ptop*rga)* & + (h2ostr*zenfac(i)*delta) + uh2o(i,0) = h2ommr(i,1)*pthh2o + uco2(i,0) = zenfac(i)*pthco2 + uo2 (i,0) = zenfac(i)*ptho2 + uo3 (i,0) = ptho3 +! +! End do i=1,Nday +! + end do + + do k=1,pver + + do i=1,Nday + + pdel = pflx(i,k+1) - pflx(i,k) + path = pdel / gravit + ptho2 = o2mmr(i) * path + ptho3 = o3mmr(i,k) * path + pthco2 = sqrco2(i) * path + h2ostr = sqrt(1.0_r8/h2ommr(i,k)) + pthh2o = (pflx(i,k+1)**2 - pflx(i,k)**2)*tmp1 + pdel*h2ostr*zenfac(i)*tmp2 + uh2o(i,k) = h2ommr(i,k)*pthh2o + uco2(i,k) = zenfac(i)*pthco2 + uo2 (i,k) = zenfac(i)*ptho2 + uo3 (i,k) = ptho3 + +! +! End do i=1,Nday +! + end do +! +! End k=1,pver +! + end do +! +! Compute column absorber amounts for the clear sky computation: +! + do i=1,Nday + + uth2o(i) = 0.0_r8 + uto3(i) = 0.0_r8 + utco2(i) = 0.0_r8 + uto2(i) = 0.0_r8 + + do k=1,pver + uth2o(i) = uth2o(i) + uh2o(i,k) + uto3(i) = uto3(i) + uo3(i,k) + utco2(i) = utco2(i) + uco2(i,k) + uto2(i) = uto2(i) + uo2(i,k) +! +! End k=1,pver +! + end do +! +! End do i=1,Nday +! + end do +! +! Set cloud properties for top (0) layer; so long as tauxcl is zero, +! there is no cloud above top of model; the other cloud properties +! are arbitrary: +! + do i=1,Nday + + tauxcl(i,0) = 0._r8 + wcl(i,0) = 0.999999_r8 + gcl(i,0) = 0.85_r8 + fcl(i,0) = 0.725_r8 + tauxci(i,0) = 0._r8 + wci(i,0) = 0.999999_r8 + gci(i,0) = 0.85_r8 + fci(i,0) = 0.725_r8 +! +! End do i=1,Nday +! + end do +! +! Begin spectral loop +! + do ns=1,nswbands +! +! Set cloud extinction optical depth, single scatter albedo, +! asymmetry parameter, and forward scattered fraction: +! + abarli = abarl(indxsl(ns)) + bbarli = bbarl(indxsl(ns)) + cbarli = cbarl(indxsl(ns)) + dbarli = dbarl(indxsl(ns)) + ebarli = ebarl(indxsl(ns)) + fbarli = fbarl(indxsl(ns)) +! + abarii = abari(indxsl(ns)) + bbarii = bbari(indxsl(ns)) + cbarii = cbari(indxsl(ns)) + dbarii = dbari(indxsl(ns)) + ebarii = ebari(indxsl(ns)) + fbarii = fbari(indxsl(ns)) +! +! adjustfraction within spectral interval to allow for the possibility of +! sub-divisions within a particular interval: +! + psf(ns) = 1.0_r8 + if(ph2o(ns)/=0._r8) psf(ns) = psf(ns)*ph2o(ns) + if(pco2(ns)/=0._r8) psf(ns) = psf(ns)*pco2(ns) + if(po2 (ns)/=0._r8) psf(ns) = psf(ns)*po2 (ns) + + do k=1,pver + + do i=1,Nday + + ! liquid + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if ( microp_scheme == 'MG' ) then + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + else + tmp2l = 1._r8 - cbarli - dbarli*rel(i,k) + tmp3l = fbarli*rel(i,k) + endif + + ! ice + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if ( microp_scheme == 'MG' ) then + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,rei(i,k)),130._r8) + else + tmp2i = 1._r8 - cbarii - dbarii*rei(i,k) + tmp3i = fbarii*rei(i,k) + endif + + if (cld(i,k) >= cldmin .and. cld(i,k) >= cldeps) then + + ! liquid + if ( microp_scheme == 'MG' ) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + else + tmp1l = abarli + bbarli/rel(i,k) + endif + + ! ice + if ( microp_scheme == 'MG' ) then + tmp1i = abarii + bbarii/max(13._r8,min(rei(i,k),130._r8)) + else + tmp1i = abarii + bbarii/rei(i,k) + endif + + tauxcl(i,k) = cliqwp(i,k)*tmp1l + tauxci(i,k) = cicewp(i,k)*tmp1i + + if (ns .eq. idx_sw_diag) then + tauxcl_out(i,k) = cliqwp(i,k)*tmp1l + tauxci_out(i,k) = cicewp(i,k)*tmp1i + endif + else + tauxcl(i,k) = 0.0_r8 + tauxci(i,k) = 0.0_r8 + endif + + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + wcl(i,k) = min(tmp2l,.999999_r8) + gcl(i,k) = ebarli + tmp3l + fcl(i,k) = gcl(i,k)*gcl(i,k) + + wci(i,k) = min(tmp2i,.999999_r8) + gci(i,k) = ebarii + tmp3i + fci(i,k) = gci(i,k)*gci(i,k) + + end do ! End do i=1,Nday + end do ! End do k=1,pver + + +! +! Set reflectivities for surface based on mid-point wavelength +! + call get_sw_spectral_boundaries(wavmin, wavmax, 'micrometer') + wavmid(ns) = 0.5_r8*(wavmin(ns) + wavmax(ns)) +! +! Wavelength less than 0.7 micro-meter +! + if (wavmid(ns) < 0.7_r8 ) then + do i=1,Nday + albdir(i,ns) = asdir(i) + albdif(i,ns) = asdif(i) + end do +! +! Wavelength greater than 0.7 micro-meter +! + else + do i=1,Nday + albdir(i,ns) = aldir(i) + albdif(i,ns) = aldif(i) + end do + end if + trayoslp = raytau(ns)/sslp +! +! Layer input properties now completely specified; compute the +! delta-Eddington solution reflectivities and transmissivities +! for each layer +! + call raddedmx(coszrs ,Nday , & + abh2o(ns),abo3(ns) ,abco2(ns),abo2(ns) , & + uh2o ,uo3 ,uco2 ,uo2 , & + trayoslp ,pflx ,ns , & + tauxcl ,wcl ,gcl ,fcl , & + tauxci ,wci ,gci ,fci , & + aer_tau(:,:,ns) ,aer_tau_w(:,:,ns) ,aer_tau_w_g(:,:,ns) ,aer_tau_w_f(:,:,ns) , & + rdir ,rdif ,tdir ,tdif ,explay , & + rdirc ,rdifc ,tdirc ,tdifc ,explayc ) +! +! End spectral loop +! + end do +! +!---------------------------------------------------------------------- +! +! Solution for max/random cloud overlap. +! +! Steps: +! (1. delta-Eddington solution for each layer (called above) +! +! (2. The adding method is used to +! compute the reflectivity and transmissivity to direct and diffuse +! radiation from the top and bottom of the atmosphere for each +! cloud configuration. This calculation is based upon the +! max-random overlap assumption. +! +! (3. to solve for the fluxes, combine the +! bulk properties of the atmosphere above/below the region. +! +! Index calculations for steps 2-3 are performed outside spectral +! loop to avoid redundant calculations. Index calculations (with +! application of areamin & nconfgmax conditions) are performed +! first to identify the minimum subset of terms for the configurations +! satisfying the areamin & nconfgmax conditions. This minimum set is +! used to identify the corresponding minimum subset of terms in +! steps 2 and 3. +! + do iconfig = 1, nconfgmax + ccon(iconfig,0,1:Nday) = 0 + ccon(iconfig,pverp,1:Nday) = 0 + + icond(iconfig,0,1:Nday) = iconfig + iconu(iconfig,pverp,1:Nday) = iconfig + end do +! +! Construction of nuniqu/d, istrtu/d, iconu/d using binary tree +! + nuniqd(0,1:Nday) = 1 + nuniqu(pverp,1:Nday) = 1 + + istrtd(1,0,1:Nday) = 1 + istrtu(1,pverp,1:Nday) = 1 + + +!CSD$ PARALLEL DO PRIVATE( npasses, kx2, mrgn, region_found, k1, k2, kx1, nxs, ksort, asort ) & +!CSD$ PRIVATE ( ktmp, atmp, cstr, mstr, nstr, cld0, wstr, nrgn, nconfigm, istr, new_term, xwgt ) & +!CSD$ PRIVATE ( j, ptrc, wgtv, km1, nuniq, is0, is1, n0, n1, ptr0, ptr1, kp1, i, irgn ) & +!CSD$ PRIVATE ( k, l, iconfig, l0, isn ) + do i=1,Nday + +!---------------------------------------------------------------------- +! INDEX CALCULATIONS FOR MAX OVERLAP +! +! The column is divided into sets of adjacent layers, called regions, +! in which the clouds are maximally overlapped. The clouds are +! randomly overlapped between different regions. The number of +! regions in a column is set by nmxrgn, and the range of pressures +! included in each region is set by pmxrgn. +! +! The following calculations determine the number of unique cloud +! configurations (assuming maximum overlap), called "streams", +! within each region. Each stream consists of a vector of binary +! clouds (either 0 or 100% cloud cover). Over the depth of the region, +! each stream requires a separate calculation of radiative properties. These +! properties are generated using the adding method from +! the radiative properties for each layer calculated by raddedmx. +! +! The upward and downward-propagating streams are treated +! separately. +! +! We will refer to a particular configuration of binary clouds +! within a single max-overlapped region as a "stream". We will +! refer to a particular arrangement of binary clouds over the entire column +! as a "configuration". +! +! This section of the code generates the following information: +! (1. nrgn : the true number of max-overlap regions (need not = nmxrgn) +! (2. nstr : the number of streams in a region (>=1) +! (3. cstr : flags for presence of clouds at each layer in each stream +! (4. wstr : the fractional horizontal area of a grid box covered +! by each stream +! (5. kx1,2 : level indices for top/bottom of each region +! +! The max-overlap calculation proceeds in 3 stages: +! (1. compute layer radiative properties in raddedmx. +! (2. combine these properties between layers +! (3. combine properties to compute fluxes at each interface. +! +! Most of the indexing information calculated here is used in steps 2-3 +! after the call to raddedmx. +! +! Initialize indices for layers to be max-overlapped +! +! Loop to handle fix in totwgt=0. For original overlap config +! from npasses = 0. +! + npasses = 0 + do + do irgn = 0, nmxrgn(i) + kx2(irgn) = 0 + end do + mrgn = 0 +! +! Outermost loop over regions (sets of adjacent layers) to be max overlapped +! + do irgn = 1, nmxrgn(i) +! +! Calculate min/max layer indices inside region. +! + region_found = .false. + if (kx2(irgn-1) < pver) then + k1 = kx2(irgn-1)+1 + kx1(irgn) = k1 + kx2(irgn) = k1-1 + do k2 = pver, k1, -1 + if (pmid(i,k2) <= pmxrgn(i,irgn)) then + kx2(irgn) = k2 + mrgn = mrgn+1 + region_found = .true. + exit + end if + end do + else + exit + endif + + if (region_found) then +! +! Sort cloud areas and corresponding level indices. +! + nxs = 0 + if (cldeps > 0) then + do k = k1,k2 + if (cld(i,k) >= cldmin .and. cld(i,k) >= cldeps) then + nxs = nxs+1 + ksort(nxs) = k +! +! We need indices for clouds in order of largest to smallest, so +! sort 1-cld in ascending order +! + asort(nxs) = 1.0_r8-(floor(cld(i,k)/cldeps)*cldeps) + end if + end do + else + do k = k1,k2 + if (cld(i,k) >= cldmin) then + nxs = nxs+1 + ksort(nxs) = k +! +! We need indices for clouds in order of largest to smallest, so +! sort 1-cld in ascending order +! + asort(nxs) = 1.0_r8-cld(i,k) + end if + end do + endif +! +! If nxs eq 1, no need to sort. +! If nxs eq 2, sort by swapping if necessary +! If nxs ge 3, sort using local sort routine +! + if (nxs == 2) then + if (asort(2) < asort(1)) then + ktmp = ksort(1) + ksort(1) = ksort(2) + ksort(2) = ktmp + + atmp = asort(1) + asort(1) = asort(2) + asort(2) = atmp + endif + else if (nxs >= 3) then + call quick_sort(asort(1:nxs),ksort(1:nxs)) + endif +! +! Construct wstr, cstr, nstr for this region +! + cstr(k1:k2,1:nxs+1) = 0 + mstr = 1 + cld0 = 0.0_r8 + do l = 1, nxs + if (asort(l) /= cld0) then + wstr(mstr,mrgn) = asort(l) - cld0 + cld0 = asort(l) + mstr = mstr + 1 + endif + cstr(ksort(l),mstr:nxs+1) = 1 + end do + nstr(mrgn) = mstr + wstr(mstr,mrgn) = 1.0_r8 - cld0 +! +! End test of region_found = true +! + endif +! +! End loop over regions irgn for max-overlap +! + end do + nrgn = mrgn +! +! Finish construction of cstr for additional top layer +! + cstr(0,1:nstr(1)) = 0 +! +! INDEX COMPUTATIONS FOR STEP 2-3 +! This section of the code generates the following information: +! (1. totwgt step 3 total frac. area of configurations satisfying +! areamin & nconfgmax criteria +! (2. wgtv step 3 frac. area of configurations +! (3. ccon step 2 binary flag for clouds in each configuration +! (4. nconfig steps 2-3 number of configurations +! (5. nuniqu/d step 2 Number of unique cloud configurations for +! up/downwelling rad. between surface/TOA +! and level k +! (6. istrtu/d step 2 Indices into iconu/d +! (7. iconu/d step 2 Cloud configurations which are identical +! for up/downwelling rad. between surface/TOA +! and level k +! +! Number of configurations (all permutations of streams in each region) +! + nconfigm = product(nstr(1: nrgn)) +! +! Construction of totwgt, wgtv, ccon, nconfig +! + istr(1: nrgn) = 1 + nconfig(i) = 0 + totwgt(i) = 0.0_r8 + new_term = .true. + do iconfig = 1, nconfigm + xwgt = 1.0_r8 + do mrgn = 1, nrgn + xwgt = xwgt * wstr(istr(mrgn),mrgn) + end do + if (xwgt >= areamin) then + nconfig(i) = nconfig(i) + 1 + if (nconfig(i) <= nconfgmax) then + j = nconfig(i) + ptrc(nconfig(i)) = nconfig(i) + else + nconfig(i) = nconfgmax + if (new_term) then + min_idx = minloc(wgtv) + j = min_idx(1) + endif + if (wgtv(j) < xwgt) then + totwgt(i) = totwgt(i) - wgtv(j) + new_term = .true. + else + new_term = .false. + endif + endif + if (new_term) then + wgtv(j) = xwgt + totwgt(i) = totwgt(i) + xwgt + do mrgn = 1, nrgn + ccon(j,kx1(mrgn):kx2(mrgn),i) = cstr(kx1(mrgn):kx2(mrgn),istr(mrgn)) + end do + endif + endif + + mrgn = nrgn + istr(mrgn) = istr(mrgn) + 1 + do while (istr(mrgn) > nstr(mrgn) .and. mrgn > 1) + istr(mrgn) = 1 + mrgn = mrgn - 1 + istr(mrgn) = istr(mrgn) + 1 + end do +! +! End do iconfig = 1, nconfigm +! + end do +! +! If totwgt(i) = 0 implement maximum overlap and make another pass +! if totwgt(i) = 0 on this second pass then terminate. +! + if (totwgt(i) > 0._r8) then + exit + else + npasses = npasses + 1 + if (npasses >= 2 ) then + write(iulog,*)'RADCSWMX: Maximum overlap of column ','failed' + call endrun('RADCSWMX') + endif + nmxrgn(i)=1 + pmxrgn(i,1)=1.0e30_r8 + end if +! +! End npasses = 0, do +! + end do +! +! Finish construction of ccon +! + + istrtd(2,0,i) = nconfig(i)+1 + istrtu(2,pverp,i) = nconfig(i)+1 + + do k = 1, pverp + km1 = k-1 + nuniq = 0 + istrtd(1,k,i) = 1 + do l0 = 1, nuniqd(km1,i) + is0 = istrtd(l0,km1,i) + is1 = istrtd(l0+1,km1,i)-1 + n0 = 0 + n1 = 0 + do isn = is0, is1 + j = icond(isn,km1,i) + if (ccon(j,k,i) == 0) then + n0 = n0 + 1 + ptr0(n0) = j + else ! if (ccon(j,k,i) == 1) then + n1 = n1 + 1 + ptr1(n1) = j + endif + end do + if (n0 > 0) then + nuniq = nuniq + 1 + istrtd(nuniq+1,k,i) = istrtd(nuniq,k,i)+n0 + icond(istrtd(nuniq,k,i):istrtd(nuniq+1,k,i)-1,k,i) = ptr0(1:n0) + endif + if (n1 > 0) then + nuniq = nuniq + 1 + istrtd(nuniq+1,k,i) = istrtd(nuniq,k,i)+n1 + icond(istrtd(nuniq,k,i):istrtd(nuniq+1,k,i)-1,k,i) = ptr1(1:n1) + endif + end do + nuniqd(k,i) = nuniq + end do +! +! Find 'transition point' in downward configurations where the number +! of 'configurations' changes from 1. This is used to optimize the +! construction of the upward configurations. +! Note: k1 == transition point +! + + do k = pverp,0,-1 + if ( nuniqd(k,i) == 1) then + k1 = k + exit + end if + end do + + do k = pver, k1+1,-1 + kp1 = k+1 + nuniq = 0 + istrtu(1,k,i) = 1 + do l0 = 1, nuniqu(kp1,i) + is0 = istrtu(l0,kp1,i) + is1 = istrtu(l0+1,kp1,i)-1 + n0 = 0 + n1 = 0 + do isn = is0, is1 + j = iconu(isn,kp1,i) + if (ccon(j,k,i) == 0) then + n0 = n0 + 1 + ptr0(n0) = j + else ! if (ccon(j,k,i) == 1) then + n1 = n1 + 1 + ptr1(n1) = j + endif + end do + if (n0 > 0) then + nuniq = nuniq + 1 + istrtu(nuniq+1,k,i) = istrtu(nuniq,k,i)+n0 + iconu(istrtu(nuniq,k,i):istrtu(nuniq+1,k,i)-1,k,i) = ptr0(1:n0) + endif + if (n1 > 0) then + nuniq = nuniq + 1 + istrtu(nuniq+1,k,i) = istrtu(nuniq,k,i)+n1 + iconu(istrtu(nuniq,k,i):istrtu(nuniq+1,k,i)-1,k,i) = ptr1(1:n1) + endif + end do + nuniqu(k,i) = nuniq + end do +! +! Copy identical configurations from 'transition point' to surface. +! + k1 = min(pverp-1,k1) + nuniq = nuniqu(k1+1,i) + do k = k1,0,-1 + nuniqu(k,i) = nuniq + iconu(1:nuniq,k,i) = iconu(1:nuniq,k1+1,i) + istrtu(1:nuniq+1,k,i) = istrtu(1:nuniq+1,k1+1,i) + end do + + v_wgtv(1:nconfig(i),i) = wgtv(1:nconfig(i)) + +! +!---------------------------------------------------------------------- +! End of index calculations +!---------------------------------------------------------------------- +! +! End do i=1,Nday +! + end do +!CSD$ END PARALLEL + +!---------------------------------------------------------------------- +! Start of flux calculations +!---------------------------------------------------------------------- +! +! Initialize spectrally integrated totals: +! + totfld (1:Nday,0:pver) = 0.0_r8 + totfldc(1:Nday,0:pver) = 0.0_r8 + fswup (1:Nday,0:pver) = 0.0_r8 + fswdn (1:Nday,0:pver) = 0.0_r8 + + fswup (1:Nday,pverp) = 0.0_r8 + fswdn (1:Nday,pverp) = 0.0_r8 +! +! Start spectral interval +! +!old do ns = 1,nswbands +!old wgtint = nirwgt(ns) + + do i=1,Nday + +!---------------------------------------------------------------------- +! STEP 2 +! +! +! Apply adding method to solve for radiative properties +! +! first initialize the bulk properties at toa +! + +! nswbands, 0:pverp, nconfgmax, pcols + + rdndif(:,0,1:nconfig(i),i) = 0.0_r8 + exptdn(:,0,1:nconfig(i),i) = 1.0_r8 + tdntot(:,0,1:nconfig(i),i) = 1.0_r8 +! +! End do i=1,Nday +! + end do +! +! solve for properties involving downward propagation of radiation. +! the bulk properties are: +! +! (1. exptdn sol. beam dwn. trans from layers above +! (2. rdndif ref to dif rad for layers above +! (3. tdntot total trans for layers above +! + +!CSD$ PARALLEL DO PRIVATE( km1, is0, is1, j, jj, Ttdif, Trdif, Trdir, Ttdir, Texplay ) & +!CSD$ PRIVATE( xexpt, xrdnd, tdnmexp, ytdnd, yrdnd, rdenom, rdirexp, zexpt, zrdnd, ztdnt ) & +!CSD$ PRIVATE( i, k, l0, ns, isn ) + do i = 1, Nday + do k = 1, pverp + km1 = k - 1 + do l0 = 1, nuniqd(km1,i) + is0 = istrtd(l0,km1,i) + is1 = istrtd(l0+1,km1,i)-1 + + j = icond(is0,km1,i) + +! +! If cloud in layer, use cloudy layer radiative properties (ccon == 1) +! If clear layer, use clear-sky layer radiative properties (ccon /= 1) +! + if ( ccon(j,km1,i) == 1 ) then + Ttdif(:) = tdif(:,i,km1) + Trdif(:) = rdif(:,i,km1) + Trdir(:) = rdir(:,i,km1) + Ttdir(:) = tdir(:,i,km1) + Texplay(:) = explay(:,i,km1) + else + Ttdif(:) = tdifc(:,i,km1) + Trdif(:) = rdifc(:,i,km1) + Trdir(:) = rdirc(:,i,km1) + Ttdir(:) = tdirc(:,i,km1) + Texplay(:) = explayc(:,i,km1) + end if + + do ns = 1, nswbands + xexpt = exptdn(ns,km1,j,i) + xrdnd = rdndif(ns,km1,j,i) + tdnmexp = tdntot(ns,km1,j,i) - xexpt + + ytdnd = Ttdif(ns) + yrdnd = Trdif(ns) + + rdenom = 1._r8/(1._r8-yrdnd*xrdnd) + rdirexp = Trdir(ns)*xexpt + + zexpt = xexpt * Texplay(ns) + zrdnd = yrdnd + xrdnd*(ytdnd**2)*rdenom + ztdnt = xexpt*Ttdir(ns) + ytdnd* & + (tdnmexp + xrdnd*rdirexp)*rdenom + + exptdn(ns,k,j,i) = zexpt + rdndif(ns,k,j,i) = zrdnd + tdntot(ns,k,j,i) = ztdnt + end do ! ns = 1, nswbands +! +! If 2 or more configurations share identical properties at a given level k, +! the properties (at level k) are computed once and copied to +! all the configurations for efficiency. +! + do isn = is0+1, is1 + jj = icond(isn,km1,i) + exptdn(:,k,jj,i) = exptdn(:,k,j,i) + rdndif(:,k,jj,i) = rdndif(:,k,j,i) + tdntot(:,k,jj,i) = tdntot(:,k,j,i) + end do + +! +! end do l0 = 1, nuniqd(k,i) +! + end do +! +! end do k = 1, pverp +! + end do +! +! end do i = 1, Nday +! + end do +!CSD$ END PARALLEL +! +! Solve for properties involving upward propagation of radiation. +! The bulk properties are: +! +! (1. rupdif Ref to dif rad for layers below +! (2. rupdir Ref to dir rad for layers below +! +! Specify surface boundary conditions (surface albedos) +! + +! nswbands, 0:pverp, nconfgmax, pcols + rupdir = 0._r8 + rupdif = 0._r8 + do i = 1, Nday + do ns = 1, nswbands + rupdir(ns,pverp,1:nconfig(i),i) = albdir(i,ns) + rupdif(ns,pverp,1:nconfig(i),i) = albdif(i,ns) + end do + end do + + do i = 1, Nday + do k = pver, 0, -1 + do l0 = 1, nuniqu(k,i) + is0 = istrtu(l0,k,i) + is1 = istrtu(l0+1,k,i)-1 + + j = iconu(is0,k,i) + +! +! If cloud in layer, use cloudy layer radiative properties (ccon == 1) +! If clear layer, use clear-sky layer radiative properties (ccon /= 1) +! + if ( ccon(j,k,i) == 1 ) then + Ttdif(:) = tdif(:,i,k) + Trdif(:) = rdif(:,i,k) + Trdir(:) = rdir(:,i,k) + Ttdir(:) = tdir(:,i,k) + Texplay(:) = explay(:,i,k) + else + Ttdif(:) = tdifc(:,i,k) + Trdif(:) = rdifc(:,i,k) + Trdir(:) = rdirc(:,i,k) + Ttdir(:) = tdirc(:,i,k) + Texplay(:) = explayc(:,i,k) + end if + + do ns = 1, nswbands + xrupd = rupdif(ns,k+1,j,i) + xrups = rupdir(ns,k+1,j,i) + +! +! If cloud in layer, use cloudy layer radiative properties (ccon == 1) +! If clear layer, use clear-sky layer radiative properties (ccon /= 1) +! + yexpt = Texplay(ns) + yrupd = Trdif(ns) + ytupd = Ttdif(ns) + + rdenom = 1._r8/( 1._r8 - yrupd*xrupd) + tdnmexp = (Ttdir(ns)-yexpt) + rdirexp = xrups*yexpt + + zrupd = yrupd + xrupd*(ytupd**2)*rdenom + zrups = Trdir(ns) + ytupd*(rdirexp + xrupd*tdnmexp)*rdenom + + rupdif(ns,k,j,i) = zrupd + rupdir(ns,k,j,i) = zrups + end do ! ns = 1, nswbands +! +! If 2 or more configurations share identical properties at a given level k, +! the properties (at level k) are computed once and copied to +! all the configurations for efficiency. +! + do isn = is0+1, is1 + jj = iconu(isn,k,i) + rupdif(:,k,jj,i) = rupdif(:,k,j,i) + rupdir(:,k,jj,i) = rupdir(:,k,j,i) + end do + +! +! end do l0 = 1, nuniqu(k,i) +! + end do +! +! end do k = pver,0,-1 +! + end do +! +! end do i = 1, Nday +! + end do +! +!---------------------------------------------------------------------- +! +! STEP 3 +! +! Compute up and down fluxes for each interface k. This requires +! adding up the contributions from all possible permutations +! of streams in all max-overlap regions, weighted by the +! product of the fractional areas of the streams in each region +! (the random overlap assumption). The adding principle has been +! used in step 2 to combine the bulk radiative properties +! above and below the interface. +! + +! +! Initialize the fluxes +! + fluxup = 0.0_r8 + fluxdn = 0.0_r8 + + do i = 1, Nday + do iconfig = 1, nconfig(i) + xwgt = v_wgtv(iconfig,i) + + do k = 0, pverp + do ns = 1, nswbands + xexpt = exptdn(ns,k,iconfig,i) + xtdnt = tdntot(ns,k,iconfig,i) + xrdnd = rdndif(ns,k,iconfig,i) + xrupd = rupdif(ns,k,iconfig,i) + xrups = rupdir(ns,k,iconfig,i) +! +! Flux computation +! + rdenom = 1._r8/(1._r8 - xrdnd * xrupd) + + fluxup(ns,k,i) = fluxup(ns,k,i) + xwgt * & + ((xexpt * xrups + (xtdnt - xexpt) * xrupd) * rdenom) + fluxdn(ns,k,i) = fluxdn(ns,k,i) + xwgt * & + (xexpt + (xtdnt - xexpt + xexpt * xrups * xrdnd) * rdenom) + end do ! do ns = 1, nswbands + end do +! +! End do iconfig = 1, nconfig(i) +! + end do +! +! End do iconfig = 1, Nday +! + end do +! +! Normalize by total area covered by cloud configurations included +! in solution +! + do i = 1, Nday + do k = 0, pverp + do ns = 1, nswbands + fluxup(ns,k,i)=fluxup(ns,k,i) / totwgt(i) + fluxdn(ns,k,i)=fluxdn(ns,k,i) / totwgt(i) + end do ! do i = 1, nday + end do ! do k = 0, pverp + end do ! do i = 1, nday + + +! +! Initialize the direct-beam flux at surface +! + wexptdn(:,1:Nday) = 0.0_r8 + + do ns = 1,nswbands + wgtint = nirwgt(ns) + + + do i=1,Nday + do iconfig = 1, nconfig(i) +! +! Note: exptdn can be directly indexed by iconfig at k=pverp. +! + wexptdn(ns,i) = wexptdn(ns,i) + v_wgtv(iconfig,i) * exptdn(ns,pverp,iconfig,i) + end do + end do + + do i=1,Nday + wexptdn(ns,i) = wexptdn(ns,i) / totwgt(i) +! +! Monochromatic computation completed; accumulate in totals +! + if ( do_spctrl_scaling ) then + solflx(i) = solin(i)*frcsol(ns)*psf(ns)*sfac(ns) + else + solflx(i) = solin(i)*frcsol(ns)*psf(ns) + endif + fsnt(i) = fsnt(i) + solflx(i)*(fluxdn(ns,1,i) - fluxup(ns,1,i)) + fsntoa(i)= fsntoa(i) + solflx(i)*(fluxdn(ns,0,i) - fluxup(ns,0,i)) + fsutoa(i)= fsutoa(i) + solflx(i)*(fluxup(ns,0,i)) + fsns(i) = fsns(i) + solflx(i)*(fluxdn(ns,pverp,i)-fluxup(ns,pverp,i)) + fsdtoa(i) = fsdtoa(i) + solflx(i) + fswup(i,0) = fswup(i,0) + solflx(i)*fluxup(ns,0,i) + fswdn(i,0) = fswdn(i,0) + solflx(i)*fluxdn(ns,0,i) +! +! Down spectral fluxes need to be in mks; thus the .001 conversion factors +! + if (wavmid(ns) < 0.7_r8) then + sols(i) = sols(i) + wexptdn(ns,i)*solflx(i)*0.001_r8 + solsd(i) = solsd(i)+(fluxdn(ns,pverp,i)-wexptdn(ns,i))*solflx(i)*0.001_r8 + else + soll(i) = soll(i) + wexptdn(ns,i)*solflx(i)*0.001_r8 + solld(i) = solld(i)+(fluxdn(ns,pverp,i)-wexptdn(ns,i))*solflx(i)*0.001_r8 + fsnrtoaq(i) = fsnrtoaq(i) + solflx(i)*(fluxdn(ns,0,i) - fluxup(ns,0,i)) + end if + fsnirtoa(i) = fsnirtoa(i) + wgtint*solflx(i)*(fluxdn(ns,0,i) - fluxup(ns,0,i)) + +! +! End do i=1,Nday +! + end do + + + do k=0,pver + do i=1,Nday +! +! Compute flux divergence in each layer using the interface up and down +! fluxes: +! + kp1 = k+1 + flxdiv = (fluxdn(ns,k,i) - fluxdn(ns,kp1,i)) + (fluxup(ns,kp1,i) - fluxup(ns,k,i)) + totfld(i,k) = totfld(i,k) + solflx(i)*flxdiv + fswdn(i,kp1) = fswdn(i,kp1) + solflx(i)*fluxdn(ns,kp1,i) + fswup(i,kp1) = fswup(i,kp1) + solflx(i)*fluxup(ns,kp1,i) + fns(i,kp1) = fswdn(i,kp1) - fswup(i,kp1) + if (single_column.and.scm_crm_mode) then + fus(i,kp1)=fswup(i,kp1) + fds(i,kp1)=fswdn(i,kp1) + endif + end do + end do +! +! Perform clear-sky calculation +! + + exptdnc(1:Nday,0) = 1.0_r8 + rdndifc(1:Nday,0) = 0.0_r8 + tdntotc(1:Nday,0) = 1.0_r8 + rupdirc(1:Nday,pverp) = albdir(1:Nday,ns) + rupdifc(1:Nday,pverp) = albdif(1:Nday,ns) + + + do k = 1, pverp + do i=1,Nday + km1 = k - 1 + xexpt = exptdnc(i,km1) + xrdnd = rdndifc(i,km1) + yrdnd = rdifc(ns,i,km1) + ytdnd = tdifc(ns,i,km1) + + exptdnc(i,k) = xexpt*explayc(ns,i,km1) + + rdenom = 1._r8/(1._r8 - yrdnd*xrdnd) + rdirexp = rdirc(ns,i,km1)*xexpt + tdnmexp = tdntotc(i,km1) - xexpt + + tdntotc(i,k) = xexpt*tdirc(ns,i,km1) + ytdnd*(tdnmexp + xrdnd*rdirexp)* & + rdenom + rdndifc(i,k) = yrdnd + xrdnd*(ytdnd**2)*rdenom +! +! End do i=1,Nday +! + end do + end do + + do k=pver,0,-1 + do i=1,Nday + xrupd = rupdifc(i,k+1) + yexpt = explayc(ns,i,k) + yrupd = rdifc(ns,i,k) + ytupd = tdifc(ns,i,k) + + rdenom = 1._r8/( 1._r8 - yrupd*xrupd) + + rupdirc(i,k) = rdirc(ns,i,k) + ytupd*(rupdirc(i,k+1)*yexpt + & + xrupd*(tdirc(ns,i,k)-yexpt))*rdenom + rupdifc(i,k) = yrupd + xrupd*ytupd**2*rdenom +! +! End do i=1,Nday +! + end do + end do + + do k=0,pverp + do i=1,Nday + rdenom = 1._r8/(1._r8 - rdndifc(i,k)*rupdifc(i,k)) + fluxup(ns,k,i) = (exptdnc(i,k)*rupdirc(i,k) + (tdntotc(i,k)-exptdnc(i,k))*rupdifc(i,k))* & + rdenom + fluxdn(ns,k,i) = exptdnc(i,k) + & + (tdntotc(i,k) - exptdnc(i,k) + exptdnc(i,k)*rupdirc(i,k)*rdndifc(i,k))* & + rdenom +! +! End do i=1,Nday +! + end do + end do + + do k=0,pver + do i=1,Nday +! +! Compute flux divergence in each layer using the interface up and down +! fluxes: +! + kp1 = k+1 + flxdiv = (fluxdn(ns,k,i) - fluxdn(ns,kp1,i)) + (fluxup(ns,kp1,i) - fluxup(ns,k,i)) + totfldc(i,k) = totfldc(i,k) + solflx(i)*flxdiv + end do + end do + + do i=1,Nday + fsntc(i) = fsntc(i)+solflx(i)*(fluxdn(ns,1,i)-fluxup(ns,1,i)) + fsntoac(i) = fsntoac(i)+solflx(i)*(fluxdn(ns,0,i)-fluxup(ns,0,i)) + fsnsc(i) = fsnsc(i)+solflx(i)*(fluxdn(ns,pverp,i)-fluxup(ns,pverp,i)) + fsdsc(i) = fsdsc(i)+solflx(i)*(fluxdn(ns,pverp,i)) + fsnrtoac(i) = fsnrtoac(i)+wgtint*solflx(i)*(fluxdn(ns,0,i)-fluxup(ns,0,i)) + if (single_column.and.scm_crm_mode) then + do k = 1,pverp + fusc(i,k)=fusc(i,k) + solflx(i) * fluxup(ns,k,i) + fdsc(i,k)=fdsc(i,k) + solflx(i) * fluxdn(ns,k,i) + enddo + endif +! +! End do i=1,Nday +! + end do + + do k = 1,pverp + do i=1,Nday + fcns(i,k)=fcns(i,k) + solflx(i)*(fluxdn(ns,k,i)-fluxup(ns,k,i)) + enddo + enddo +! +! End of clear sky calculation +! + +! +! End of spectral interval loop +! + end do + + do i=1,Nday + +! +! Compute solar heating rate (J/kg/s) +! + do k=1,pver + qrs(i,k) = -1.E-4_r8*gravit*totfld(i,k)/(pint(i,k) - pint(i,k+1)) + qrsc(i,k) = -1.E-4_r8*gravit*totfldc(i,k)/(pint(i,k) - pint(i,k+1)) + end do +! +! Set the downwelling flux at the surface +! + fsds(i) = fswdn(i,pverp) +! +! End do i=1,Nday +! + end do +! +! Rearrange output arrays. +! +! intent(inout) +! + call ExpDayNite(pmxrgn, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(nmxrgn, Nday, IdxDay, Nnite, IdxNite, 1, pcols) +! +! intent(out) +! + call ExpDayNite(solin, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(qrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call ExpDayNite(qrsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call ExpDayNite(fns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fcns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fsns, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnt, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsutoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsds, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsdsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsdtoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(sols, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(soll, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(solsd, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(solld, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnirtoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnrtoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnrtoaq, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(tauxcl_out, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call ExpDayNite(tauxci_out, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + +! these outfld calls don't work for spmd only outfield in scm mode (nonspmd) + if (single_column.and.scm_crm_mode) then + ! Following outputs added for CRM + call ExpDayNite(fus, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fds, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fusc, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fdsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call outfld('FUS ', fus*1.e-3_r8, pcols, lchnk) + call outfld('FDS ', fds*1.e-3_r8, pcols, lchnk) + call outfld('FUSC ', fusc*1.e-3_r8, pcols, lchnk) + call outfld('FDSC ', fdsc*1.e-3_r8, pcols, lchnk) + endif +! write(iulog, '(a, x, i3)') 'radcswmx : exiting, chunk identifier', lchnk + + return +end subroutine radcswmx + +!------------------------------------------------------------------------------- + +subroutine raddedmx(coszrs ,ndayc ,abh2o , & + abo3 ,abco2 ,abo2 ,uh2o ,uo3 , & + uco2 ,uo2 ,trayoslp,pflx ,ns , & + tauxcl ,wcl ,gcl ,fcl ,tauxci , & + wci ,gci ,fci ,aer_tau ,aer_tau_w, & + aer_tau_w_g, aer_tau_w_f ,rdir ,rdif ,tdir , & + tdif ,explay ,rdirc ,rdifc ,tdirc , & + tdifc ,explayc ) +!----------------------------------------------------------------------- +! +! Purpose: +! Computes layer reflectivities and transmissivities, from the top down +! to the surface using the delta-Eddington solutions for each layer +! +! Method: +! For more details , see Briegleb, Bruce P., 1992: Delta-Eddington +! Approximation for Solar Radiation in the NCAR Community Climate Model, +! Journal of Geophysical Research, Vol 97, D7, pp7603-7612). +! +! Modified for maximum/random cloud overlap by Bill Collins and John +! Truesdale +! +! Author: Bill Collins +! +!----------------------------------------------------------------------- + +! +! Minimum total transmission below which no layer computation are done: +! + real(r8) trmin ! Minimum total transmission allowed + real(r8) wray ! Rayleigh single scatter albedo + real(r8) gray ! Rayleigh asymetry parameter + real(r8) fray ! Rayleigh forward scattered fraction + + parameter (trmin = 1.e-3_r8) + parameter (wray = 0.999999_r8) + parameter (gray = 0.0_r8) + parameter (fray = 0.1_r8) +! +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: coszrs(pcols) ! Cosine zenith angle + real(r8), intent(in) :: trayoslp ! Tray/sslp + real(r8), intent(in) :: pflx(pcols,0:pverp) ! Interface pressure + real(r8), intent(in) :: abh2o ! Absorption coefficiant for h2o + real(r8), intent(in) :: abo3 ! Absorption coefficiant for o3 + real(r8), intent(in) :: abco2 ! Absorption coefficiant for co2 + real(r8), intent(in) :: abo2 ! Absorption coefficiant for o2 + real(r8), intent(in) :: uh2o(pcols,0:pver) ! Layer absorber amount of h2o + real(r8), intent(in) :: uo3(pcols,0:pver) ! Layer absorber amount of o3 + real(r8), intent(in) :: uco2(pcols,0:pver) ! Layer absorber amount of co2 + real(r8), intent(in) :: uo2(pcols,0:pver) ! Layer absorber amount of o2 + real(r8), intent(in) :: tauxcl(pcols,0:pver) ! Cloud extinction optical depth (liquid) + real(r8), intent(in) :: wcl(pcols,0:pver) ! Cloud single scattering albedo (liquid) + real(r8), intent(in) :: gcl(pcols,0:pver) ! Cloud asymmetry parameter (liquid) + real(r8), intent(in) :: fcl(pcols,0:pver) ! Cloud forward scattered fraction (liquid) + real(r8), intent(in) :: tauxci(pcols,0:pver) ! Cloud extinction optical depth (ice) + real(r8), intent(in) :: wci(pcols,0:pver) ! Cloud single scattering albedo (ice) + real(r8), intent(in) :: gci(pcols,0:pver) ! Cloud asymmetry parameter (ice) + real(r8), intent(in) :: fci(pcols,0:pver) ! Cloud forward scattered fraction (ice) + real(r8), intent(inout) :: aer_tau(pcols,0:pver) ! Aerosol extinction optical depth + real(r8), intent(inout) :: aer_tau_w(pcols,0:pver) ! Aerosol single scattering albedo * tau + real(r8), intent(inout) :: aer_tau_w_g(pcols,0:pver) ! Aerosol asymmetry parameter * w * t + real(r8), intent(inout) :: aer_tau_w_f(pcols,0:pver) ! Aerosol forward scattered fraction * w * tau + + integer, intent(in) :: ndayc ! Number of daylight columns + integer, intent(in) :: ns ! Index of spectral interval +! +! Input/Output arguments +! +! Following variables are defined for each layer; 0 refers to extra +! layer above top of model: +! + real(r8), intent(inout) :: rdir(nswbands,pcols,0:pver) ! Layer reflectivity to direct rad + real(r8), intent(inout) :: rdif(nswbands,pcols,0:pver) ! Layer reflectivity to diffuse rad + real(r8), intent(inout) :: tdir(nswbands,pcols,0:pver) ! Layer transmission to direct rad + real(r8), intent(inout) :: tdif(nswbands,pcols,0:pver) ! Layer transmission to diffuse rad + real(r8), intent(inout) :: explay(nswbands,pcols,0:pver) ! Solar beam exp transm for layer +! +! Corresponding quantities for clear-skies +! + real(r8), intent(inout) :: rdirc(nswbands,pcols,0:pver) ! Clear layer reflec. to direct rad + real(r8), intent(inout) :: rdifc(nswbands,pcols,0:pver) ! Clear layer reflec. to diffuse rad + real(r8), intent(inout) :: tdirc(nswbands,pcols,0:pver) ! Clear layer trans. to direct rad + real(r8), intent(inout) :: tdifc(nswbands,pcols,0:pver) ! Clear layer trans. to diffuse rad + real(r8), intent(inout) :: explayc(nswbands,pcols,0:pver)! Solar beam exp transm clear layer +! +!---------------------------Local variables----------------------------- +! + integer i ! Column indices + integer k ! Level index + integer nn ! Index of column loops (max=ndayc) + + real(r8) taugab(pcols) ! Layer total gas absorption optical depth + real(r8) tauray(pcols) ! Layer rayleigh optical depth + real(r8) taucsc ! Layer cloud scattering optical depth + real(r8) tautot ! Total layer optical depth + real(r8) wtot ! Total layer single scatter albedo + real(r8) gtot ! Total layer asymmetry parameter + real(r8) ftot ! Total layer forward scatter fraction + real(r8) wtau ! rayleigh layer scattering optical depth + real(r8) wt ! layer total single scattering albedo + real(r8) ts ! layer scaled extinction optical depth + real(r8) ws ! layer scaled single scattering albedo + real(r8) gs ! layer scaled asymmetry parameter +! +!---------------------------Statement functions------------------------- +! +! Statement functions and other local variables +! + real(r8) alpha ! Term in direct reflect and transmissivity + real(r8) gamma ! Term in direct reflect and transmissivity + real(r8) el ! Term in alpha,gamma,n,u + real(r8) taus ! Scaled extinction optical depth + real(r8) omgs ! Scaled single particle scattering albedo + real(r8) asys ! Scaled asymmetry parameter + real(r8) u ! Term in diffuse reflect and +! transmissivity + real(r8) n ! Term in diffuse reflect and +! transmissivity + real(r8) lm ! Temporary for el + real(r8) ne ! Temporary for n + real(r8) w ! Dummy argument for statement function + real(r8) uu ! Dummy argument for statement function + real(r8) g ! Dummy argument for statement function + real(r8) e ! Dummy argument for statement function + real(r8) f ! Dummy argument for statement function + real(r8) t ! Dummy argument for statement function + real(r8) et ! Dummy argument for statement function +! +! Intermediate terms for delta-eddington solution +! + real(r8) alp ! Temporary for alpha + real(r8) gam ! Temporary for gamma + real(r8) ue ! Temporary for u + real(r8) arg ! Exponential argument + real(r8) extins ! Extinction + real(r8) amg ! Alp - gam + real(r8) apg ! Alp + gam +! +! ssa <=1 limit for aerosol +! + real(r8) :: w_limited(pcols,0:pver) ! Aerosol ssa (limited to < 0.999999) + real(r8) :: aer_g_limit(pcols,0:pver) ! Aerosol tau_w_g (limited ssa) + real(r8) :: aer_f_limit(pcols,0:pver) ! Aerosol tau_w_f (limited ssa) +! + alpha(w,uu,g,e) = .75_r8*w*uu*((1._r8 + g*(1._r8-w))/(1._r8 - e*e*uu*uu)) + gamma(w,uu,g,e) = .50_r8*w*((3._r8*g*(1._r8-w)*uu*uu + 1._r8)/(1._r8-e*e*uu*uu)) + el(w,g) = sqrt(3._r8*(1._r8-w)*(1._r8 - w*g)) + taus(w,f,t) = (1._r8 - w*f)*t + omgs(w,f) = (1._r8 - f)*w/(1._r8 - w*f) + asys(g,f) = (g - f)/(1._r8 - f) + u(w,g,e) = 1.5_r8*(1._r8 - w*g)/e + n(uu,et) = ((uu+1._r8)*(uu+1._r8)/et ) - ((uu-1._r8)*(uu-1._r8)*et) +! +!----------------------------------------------------------------------- +! +! Compute layer radiative properties +! +! Compute radiative properties (reflectivity and transmissivity for +! direct and diffuse radiation incident from above, under clear +! and cloudy conditions) and transmission of direct radiation +! (under clear and cloudy conditions) for each layer. +! + do k=0,pver + do i=1,ndayc + if(aer_tau(i,k) > 0._r8) then !where(aer_tau > 0._r8) + aer_g_limit(i,k) = aer_tau_w_g(i,k) / aer_tau_w(i,k) + aer_f_limit(i,k) = aer_tau_w_f(i,k) / aer_tau_w(i,k) + aer_tau_w(i,k) = aer_tau(i,k) * min(aer_tau_w(i,k)/aer_tau(i,k) , 0.999999_r8) + else + aer_tau(i,k) = 0._r8 + aer_tau_w(i,k) = 0._r8 + aer_g_limit(i,k) = 0._r8 + aer_f_limit(i,k) = 0._r8 + endif + aer_tau_w_g(i,k) = aer_tau_w(i,k) * aer_g_limit(i,k) + aer_tau_w_f(i,k) = aer_tau_w(i,k) * aer_f_limit(i,k) + enddo + enddo + + do k=0,pver + do i=1,ndayc + tauray(i) = trayoslp*(pflx(i,k+1)-pflx(i,k)) + taugab(i) = abh2o*uh2o(i,k) + abo3*uo3(i,k) + abco2*uco2(i,k) + abo2*uo2(i,k) + tautot = tauxcl(i,k) + tauxci(i,k) + tauray(i) + taugab(i) + aer_tau(i,k) + taucsc = tauxcl(i,k)*wcl(i,k) + tauxci(i,k)*wci(i,k) + aer_tau_w(i,k) + wtau = wray*tauray(i) + wt = wtau + taucsc + wtot = wt/tautot + gtot = (wtau*gray + gcl(i,k)*wcl(i,k)*tauxcl(i,k) & + + gci(i,k)*wci(i,k)*tauxci(i,k) + aer_tau_w_g(i,k))/wt + ftot = (wtau*fray + fcl(i,k)*wcl(i,k)*tauxcl(i,k) & + + fci(i,k)*wci(i,k)*tauxci(i,k) + aer_tau_w_f(i,k))/wt + ts = taus(wtot,ftot,tautot) + ws = omgs(wtot,ftot) + gs = asys(gtot,ftot) + lm = el(ws,gs) + alp = alpha(ws,coszrs(i),gs,lm) + gam = gamma(ws,coszrs(i),gs,lm) + ue = u(ws,gs,lm) +! +! Limit argument of exponential to 25, in case lm very large: +! + arg = min(lm*ts,25._r8) + extins = exp(-arg) + ne = n(ue,extins) + rdif(ns,i,k) = (ue+1._r8)*(ue-1._r8)*(1._r8/extins - extins)/ne + tdif(ns,i,k) = 4._r8*ue/ne +! +! Limit argument of exponential to 25, in case coszrs is very small: +! + arg = min(ts/coszrs(i),25._r8) + explay(ns,i,k) = exp(-arg) + apg = alp + gam + amg = alp - gam + rdir(ns,i,k) = amg*(tdif(ns,i,k)*explay(ns,i,k)-1._r8) + apg*rdif(ns,i,k) + tdir(ns,i,k) = apg*tdif(ns,i,k) + (amg*rdif(ns,i,k)-(apg-1._r8))*explay(ns,i,k) +! +! Under rare conditions, reflectivies and transmissivities can be +! negative; zero out any negative values +! + rdir(ns,i,k) = max(rdir(ns,i,k),0.0_r8) + tdir(ns,i,k) = max(tdir(ns,i,k),0.0_r8) + rdif(ns,i,k) = max(rdif(ns,i,k),0.0_r8) + tdif(ns,i,k) = max(tdif(ns,i,k),0.0_r8) +! +! Clear-sky calculation +! + if (tauxcl(i,k) == 0.0_r8 .and. tauxci(i,k) == 0.0_r8) then + + rdirc(ns,i,k) = rdir(ns,i,k) + tdirc(ns,i,k) = tdir(ns,i,k) + rdifc(ns,i,k) = rdif(ns,i,k) + tdifc(ns,i,k) = tdif(ns,i,k) + explayc(ns,i,k) = explay(ns,i,k) + else + tautot = tauray(i) + taugab(i) + aer_tau(i,k) + taucsc = aer_tau_w(i,k) +! +! wtau already computed for all-sky +! + wt = wtau + taucsc + wtot = wt/tautot + gtot = (wtau*gray + aer_tau_w_g(i,k))/wt + ftot = (wtau*fray + aer_tau_w_f(i,k))/wt + ts = taus(wtot,ftot,tautot) + ws = omgs(wtot,ftot) + gs = asys(gtot,ftot) + lm = el(ws,gs) + alp = alpha(ws,coszrs(i),gs,lm) + gam = gamma(ws,coszrs(i),gs,lm) + ue = u(ws,gs,lm) +! +! Limit argument of exponential to 25, in case lm very large: +! + arg = min(lm*ts,25._r8) + extins = exp(-arg) + ne = n(ue,extins) + rdifc(ns,i,k) = (ue+1._r8)*(ue-1._r8)*(1._r8/extins - extins)/ne + tdifc(ns,i,k) = 4._r8*ue/ne +! +! Limit argument of exponential to 25, in case coszrs is very small: +! + arg = min(ts/coszrs(i),25._r8) + explayc(ns,i,k) = exp(-arg) + apg = alp + gam + amg = alp - gam + rdirc(ns,i,k) = amg*(tdifc(ns,i,k)*explayc(ns,i,k)-1._r8)+ & + apg*rdifc(ns,i,k) + tdirc(ns,i,k) = apg*tdifc(ns,i,k) + (amg*rdifc(ns,i,k) - (apg-1._r8))* & + explayc(ns,i,k) +! +! Under rare conditions, reflectivies and transmissivities can be +! negative; zero out any negative values +! + rdirc(ns,i,k) = max(rdirc(ns,i,k),0.0_r8) + tdirc(ns,i,k) = max(tdirc(ns,i,k),0.0_r8) + rdifc(ns,i,k) = max(rdifc(ns,i,k),0.0_r8) + tdifc(ns,i,k) = max(tdifc(ns,i,k),0.0_r8) + end if + end do + end do + +end subroutine raddedmx + +!------------------------------------------------------------------------------- + +subroutine radsw_init(gravx) +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize various constants for radiation scheme; note that +! the radiation scheme uses cgs units. +! +! Author: W. Collins (H2O parameterization) and J. Kiehl +! +!----------------------------------------------------------------------- +! +! Input arguments +! + real(r8), intent(in) :: gravx ! Acceleration of gravity (MKS) + + real(r8), parameter :: ref_tsi = 1367._r8 ! value supplied by Dan Marsh -- see solvar_woods.F90 +! +!----------------------------------------------------------------------- +! +! Set general radiation consts; convert to cgs units where appropriate: +! + gravit = 100._r8*gravx + rga = 1._r8/gravit + sslp = 1.013250e6_r8 + +end subroutine radsw_init + +!------------------------------------------------------------------------------- + +end module radsw diff --git a/src/physics/carma/cam/carma_cloudfraction.F90 b/src/physics/carma/cam/carma_cloudfraction.F90 new file mode 100644 index 0000000000..16035cd996 --- /dev/null +++ b/src/physics/carma/cam/carma_cloudfraction.F90 @@ -0,0 +1,47 @@ + !! Determine the stratifrom cloud fractions using the CAM routines. This will return the + !! ice and liquid cloud fractions as well as the minimum relative humidity for the onset + !! of liquid clouds. + !! + !! NOTE: This is just a stub for models that don't use cloud fraction. It should be replaced + !! be a new routine in a file of the same name in the model directory if the model needs + !! cloud fraction. This routine needs to be in its own file to avoid circular references when + !! using the CAM cloud fraction routines (see cirrus model). + !! + !! @version Aug-2010 + !! @author Chuck Bardeen + subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcrit, rc) + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carma_model_mod + use carma_flags_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + + use physics_types, only : physics_state + use camsrfexch, only : cam_in_t + use ppgrid, only : pver + + type(carma_type) :: carma !! the carma object + type(carmastate_type) :: cstate !! the carma state object + type(cam_in_t) :: cam_in + type(physics_state) :: state !! physics state variables + integer :: icol !! column index + real(kind=f) :: cldfrc(pver) !! total cloud fraction [fraction] + real(kind=f) :: rhcrit(pver) !! realtive humidity for onset of liquid clouds [fraction] + integer :: rc !! return code, negative indicates failure + + rc = RC_OK + + cldfrc(:) = 1._f + rhcrit(:) = 1._f + + return + end subroutine CARMA_CloudFraction + + diff --git a/src/physics/carma/cam/carma_constants_mod.F90 b/src/physics/carma/cam/carma_constants_mod.F90 new file mode 100644 index 0000000000..27c8055095 --- /dev/null +++ b/src/physics/carma/cam/carma_constants_mod.F90 @@ -0,0 +1,152 @@ +!! This module defines constants used by the CARMA code. Where possible, it uses constants +!! already defined in CAM. +!! +!! NOTE: CARMA constants are typically in cgs units, while CAM constants are typically in +!! mks units, so some unit conversion needs to be performed. +!! +!! NOTE: This file is adapted for use within CAM and is different than the file of the +!! same name that is part of the standard CARMA distribution. +module carma_constants_mod + + use carma_precision_mod + use shr_const_mod, only: SHR_CONST_TKTRIP, SHR_CONST_RHOICE, SHR_CONST_CDAY + use physconst, only: p_pi=>pi, avogad, boltz, r_universal, rhoh2o, latvap, latice + use radconstants, only: nswbands, nlwbands + use cam_history_support, only: fillvalue + + implicit none + + !-- + ! Physical constants + + ! Meter-Kilogram-Second (MKS) convention for units + ! This convention is different from CARMA's original + ! Centimeter-Gram-Second (CGS) convention. Be wary of + ! this conversion to the new convention. + + ! Use the _f for all literal constants, e.g. 1.2e_f. + ! If you omit the _f in the initialization, a compiler may cast this + ! number into single precision and then store it as _f precision. + + !! Define triple-point temperature (K) + real(kind=f), parameter :: T0 = SHR_CONST_TKTRIP + + ! Define constants for circles and trig + real(kind=f), parameter :: PI = p_pi + real(kind=f), parameter :: DEG2RAD = PI / 180._f + real(kind=f), parameter :: RAD2DEG = 180._f / PI + + !! Define avogadro's number [ # particles / mole ] + real(kind=f), parameter :: AVG = avogad / 1000._f + + !! Define Boltzmann's constant [ erg / deg_K ] + real(kind=f), parameter :: BK = boltz * 1e7_f + + !! Define Loschmidt's number [ mole / cm^3, @ STP ] + real(kind=f), parameter :: ALOS = 2.68719e+19_f + + !! Define reference pressure, e.g. for potential temp calcs [ dyne / cm^2 ] + real(kind=f), parameter :: PREF = 1000.e+3_f + + !! Define conversion factor for mb to cgs [ dyne / cm^2 ] units + real(kind=f), parameter :: RMB2CGS = 1000.e+0_f + + !! Define conversion factor for Pa to cgs [ dyne / cm^2 ] units + real(kind=f), parameter :: RPA2CGS = 10.e+0_f + + !! Define conversion factor for m to cgs [ cm ] units + real(kind=f), parameter :: RM2CGS = 100.0_f + + !! Define universal gas constant [ erg / deg_K / mole ] + real(kind=f), parameter :: RGAS = r_universal * 1e7_f / 1000._f + + !! Define number of seconds per the planet's day [ s / d ] + real(kind=f), parameter :: SCDAY = SHR_CONST_CDAY + + !! Define mass density of liquid water [ g / cm^3 ] + real(kind=f), parameter :: RHO_W = rhoh2o / 1000._f + + !! Define mass density of water ice [ g / cm^3 ] + real(kind=f), parameter :: RHO_I = SHR_CONST_RHOICE / 1000._f + + !! Latent heat of evaporation for gas [cm^2/s^2] + real(kind=f), parameter :: RLHE_CNST = latvap * 1e4_f + + !! Latent heat of ice melting for gas [cm^2/s^2] + real(kind=f), parameter :: RLHM_CNST = latice * 1e4_f + + + !! The dimension of THETD, ELTRMX, CSTHT, PI, TAU, SI2THT. + !! IT must correspond exactly to the second dimension of ELTRMX. + integer, parameter :: IT = 1 + + !! String length of names + integer, parameter :: CARMA_NAME_LEN = 255 + + !! String length of short names + integer, parameter :: CARMA_SHORT_NAME_LEN = 6 + + !! Fill value indicating no value is being returned + real(kind=f), parameter :: CAM_FILL = fillvalue + + + !! Define particle number concentration [ # / cm3 ] + !! used to decide whether to bypass microphysical processes. + real(kind=f), parameter :: FEW_PC = 1e-6_f + + !! Define small particle number concentration + !! [ # / x_units / y_units / z_units ] + !! + !! NOTE: Currently has mass conservation errors on the order + !! of one part in 10^8. Keep this small enough, so that you can + !! filter out all of the small stuff around SMALL_PC without + !! getting neat FEW_PC. + !! + !! For degree/degree/hybrid coordinates, the metric is on the + !! order of 1e20. +! real(kind=f), parameter :: SMALL_PC = 1e-50_f + real(kind=f), parameter :: SMALL_PC = FEW_PC * 1e20 * 1e-30 + + !! Define core fraction (for core mass and second moment) used + !! when particle number concentrations are limited to SMALL_PC + real(kind=f), parameter :: FIX_COREF = 0.1_f + + !! Minimum Cloud Fraction + real(kind=f), parameter :: CLDFRC_MIN = 0.009_f + + !! Incloud Cloud Fraction Threshold for statistics + real(kind=f), parameter :: CLDFRC_INCLOUD = 0.01_f + + !! NWAVE should be the total number of bands CAM supports. + integer, public, parameter :: NWAVE = nlwbands+nswbands ! Number of wavelength bands + + + + + + !! These are constants per CARMA's definition, but are set dynamically in CAM and thus + !! can not be set as constants. They must be initialized as variables in carma_init. + + !! Acceleration of gravity near Earth surface [ cm/s^2 ] + real(kind=f) :: GRAV + + !! Define planet equatorial radius [ cm ] + real(kind=f) :: REARTH + + !! Define molecular weight of dry air [ g / mole ] + real(kind=f) :: WTMOL_AIR + + !! Define molecular weight of water [ g / mole ] + real(kind=f) :: WTMOL_H2O + + !! Define gas constant for dry air [ erg / deg_K / mole ] + real(kind=f) :: R_AIR + + !! Define specific heat at constant pres of dry air [ cm^2 / s^2 / deg_K ] + real(kind=f) :: CP + + !! Define ratio of gas constant for dry air and specific heat + real(kind=f) :: RKAPPA + + +end module diff --git a/src/physics/carma/cam/carma_getH2O.F90 b/src/physics/carma/cam/carma_getH2O.F90 new file mode 100644 index 0000000000..436042d6f6 --- /dev/null +++ b/src/physics/carma/cam/carma_getH2O.F90 @@ -0,0 +1,40 @@ + ! Read the average water vapor profile from the initial condition file. + ! + ! NOTE: This needs to be in its own file to avoid circular references. + subroutine carma_getH2O(h2o) + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_initfiles, only: initial_file_get_id + use pio, only: file_desc_t + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + + real(r8), intent(out) :: h2o(pver) ! midpoint h2o mmr (kg/kg) + + integer :: iz ! vertical index + type(file_desc_t), pointer :: ncid_ini + logical :: found + real(r8), pointer :: init_h2o(:,:,:) + + ! For an initial run, if the file is missing, then create one using the + ! average concentration from the initial condition file. + ncid_ini => initial_file_get_id() + nullify(init_h2o) + + allocate(init_h2o(plon,pver,plat)) + call cam_pio_get_var('Q', ncid_ini, init_h2o, found=found) + + if (.not. found) then + call endrun('carma_init::cam_pio_get_var failed to find field Q.') + end if + + ! Just do a simple average. Could get gw and do a weighted average. + do iz = 1, pver + h2o(iz) = sum(init_h2o(:, iz, :)) / plat / plon + end do + + deallocate(init_h2o) + + return + end diff --git a/src/physics/carma/cam/carma_getH2SO4.F90 b/src/physics/carma/cam/carma_getH2SO4.F90 new file mode 100644 index 0000000000..0472656529 --- /dev/null +++ b/src/physics/carma/cam/carma_getH2SO4.F90 @@ -0,0 +1,40 @@ + ! Read the average H2SO4 profile from the initial condition file. + ! + ! NOTE: This needs to be in its own file to avoid circular references. + subroutine carma_getH2SO4(h2so4) + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_initfiles, only: initial_file_get_id + use pio, only: file_desc_t + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + + real(r8), intent(out) :: h2so4(pver) ! midpoint h2so4 mmr (kg/kg) + + integer :: iz ! vertical index + type(file_desc_t), pointer :: ncid_ini + logical :: found + real(r8), pointer :: init_h2so4(:,:,:) + + ! For an initial run, if the file is missing, then create one using the + ! average concentration from the initial condition file. + ncid_ini => initial_file_get_id() + nullify(init_h2so4) + + allocate(init_h2so4(plon,pver,plat)) + call cam_pio_get_var('H2SO4', ncid_ini, init_h2so4, found=found) + + if (.not. found) then + call endrun('carma_init::cam_pio_get_var failed to find field H2SO4.') + end if + + ! Just do a simple average. Could get gw and do a weighted average. + do iz = 1, pver + h2so4(iz) = sum(init_h2so4(:, iz, :)) / plat / plon + end do + + deallocate(init_h2so4) + + return + end diff --git a/src/physics/carma/cam/carma_getT.F90 b/src/physics/carma/cam/carma_getT.F90 new file mode 100644 index 0000000000..27bf928b98 --- /dev/null +++ b/src/physics/carma/cam/carma_getT.F90 @@ -0,0 +1,40 @@ + ! Read the average temperature profile from the initial condition file. + ! + ! NOTE: This needs to be in its own file to avoid circular references. + subroutine carma_getT(T) + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_initfiles, only: initial_file_get_id + use pio, only: file_desc_t + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + + real(r8), intent(out) :: T(pver) ! midpoint temperature (Pa) + + integer :: iz ! vertical index + type(file_desc_t), pointer :: ncid_ini + logical :: found + real(r8), pointer :: init_t(:,:,:) + + ! For an initial run, if the file is missing, then create one using the average + ! temperature from the initial condition file. + ncid_ini => initial_file_get_id() + nullify(init_t) + + allocate(init_t(plon,pver,plat)) + call cam_pio_get_var('T', ncid_ini, init_t, found=found) + + if (.not. found) then + call endrun('carma_init::cam_pio_get_var failed to find field T.') + end if + + ! Just do a simple average. Could get gw and do a weighted average. + do iz = 1, pver + T(iz) = sum(init_t(:, iz, :)) / plat / plon + end do + + deallocate(init_t) + + return + end diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 new file mode 100644 index 0000000000..50bad3dffa --- /dev/null +++ b/src/physics/carma/cam/carma_intr.F90 @@ -0,0 +1,2723 @@ +!! This module is a coupler between the CAM model and the Community Aerosol +!! and Radiation Model for Atmospheres (CARMA) microphysics model. It adds the +!! capabilities of CARMA to CAM, allowing for binned microphysics studies +!! within the CAM framework. This module supports the CAM physics interface, and +!! uses the CARMA and CARMASTATE objects to perform the microphysical +!! calculations. +!! +!! @author Chuck Bardeen +!! @version July 2009 +module carma_intr + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carma_flags_mod + use carma_model_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use ref_pres, only: pref_mid, pref_edge, pref_mid_norm, psurf_ref + use physics_types, only: physics_state, physics_ptend, physics_ptend_init, & + set_dry_to_wet, physics_state_copy + use phys_grid, only: get_lat_all_p + use physconst, only: avogad, cpair + use constituents, only: pcnst, cnst_add, cnst_get_ind, & + cnst_name, cnst_longname, cnst_type + use chem_surfvals, only: chem_surfvals_get + use cam_abortutils, only: endrun + use physics_buffer, only: physics_buffer_desc, pbuf_add_field, pbuf_old_tim_idx, & + pbuf_get_index, pbuf_get_field, dtype_r8 + + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + save + + ! Public interfaces + + ! CAM Physics Interface + public carma_register ! register consituents + public carma_is_active ! retrns true if this package is active (microphysics = .true.) + public carma_implements_cnst ! returns true if consituent is implemented by this package + public carma_init_cnst ! initialize constituent mixing ratios, if not read from initial file + public carma_init ! initialize timestep independent variables + public carma_final ! finalize the CARMA module + public carma_timestep_init ! initialize timestep dependent variables + public carma_timestep_tend ! interface to tendency computation + public carma_accumulate_stats ! collect stats from all MPI tasks + + ! Other Microphysics + public carma_emission_tend ! calculate tendency from emission source function + public carma_wetdep_tend ! calculate tendency from wet deposition + + + ! Private data + + ! Particle Group Statistics + + ! Gridbox average + integer, parameter :: NGPDIAGS = 12 ! Number of particle diagnostics ... + integer, parameter :: GPDIAGS_ND = 1 ! Number density + integer, parameter :: GPDIAGS_AD = 2 ! Surface area density + integer, parameter :: GPDIAGS_MD = 3 ! Mass density + integer, parameter :: GPDIAGS_RE = 4 ! Effective Radius + integer, parameter :: GPDIAGS_RM = 5 ! Mitchell [2002] Effective Radius + integer, parameter :: GPDIAGS_JN = 6 ! Nucleation Rate + integer, parameter :: GPDIAGS_MR = 7 ! Mass Mixing Ratio + integer, parameter :: GPDIAGS_EX = 8 ! Extinction + integer, parameter :: GPDIAGS_OD = 9 ! Optical Depth + integer, parameter :: GPDIAGS_VM = 10 ! Mass Weighted Fall Velocity + integer, parameter :: GPDIAGS_PA = 11 ! Projected Area + integer, parameter :: GPDIAGS_AR = 12 ! Area Ratio + + ! Particle Bin (Element) Statistics + integer, parameter :: NBNDIAGS = 1 ! Number of bin surface diagnostics ... + integer, parameter :: BNDIAGS_TP = 1 ! Delta Particle Temperature [K] + + ! Surface + integer, parameter :: NSBDIAGS = 2 ! Number of bin surface diagnostics ... + integer, parameter :: SBDIAGS_DD = 1 ! Dry deposition flux [kg/m2/s] + integer, parameter :: SBDIAGS_VD = 2 ! Dry deposition velocity [cm/s] + + + ! Gas Statistics + integer, parameter :: NGSDIAGS = 5 ! Number of gas diagnostics ... + integer, parameter :: GSDIAGS_SI = 1 ! saturation wrt ice + integer, parameter :: GSDIAGS_SL = 2 ! saturation wrt water + integer, parameter :: GSDIAGS_EI = 3 ! equilibrium vp wrt ice + integer, parameter :: GSDIAGS_EL = 4 ! equilibrium vp wrt water + integer, parameter :: GSDIAGS_WT = 5 ! weight percent composition for aerosols + + ! Step Statistics + integer, parameter :: NSPDIAGS = 2 ! Number of step diagnostics ... + integer, parameter :: SPDIAGS_NSTEP = 1 ! number of substeps + integer, parameter :: SPDIAGS_LNSTEP = 2 ! ln(number of substeps) + + ! Defaults not in the namelist + character(len=10), parameter :: carma_mixtype = 'wet' ! mixing ratio type for CARMA constituents + integer :: LUNOPRT = -1 ! lun for output + + ! Constituent Mappings + integer :: icnst4elem(NELEM, NBIN) ! constituent index for a carma element + integer :: icnst4gas(NGAS) ! constituent index for a carma gas + + character(len=16) :: btndname(NGROUP, NBIN) ! names of group per bin tendencies + character(len=16) :: etndname(NELEM, NBIN) ! names of element tendencies + character(len=16) :: gtndname(NGAS) ! names of gas tendencies + + ! Flags to indicate whether each constituent could have a CARMA tendency. + logical :: lq_carma(pcnst) + + ! The CARMA object stores the configuration inforamtion about CARMA, only one is + ! is needed per MPI task. In the future, this could potentially be turned into one + ! per model to allow multiple models with different numbers of bins, ... to be + ! run simultaneously. However, it is more complicated than that, since some of the + ! globals here would need to be put into the carma or another object and some sort + ! of callback mechanism is needed to call the correct model implementations for + ! the model specific methods. + type(carma_type), target :: carma ! the carma object + + + ! Physics Buffer Indicies + integer :: ipbuf4gas(NGAS) ! physics buffer index for a carma gas + integer :: ipbuf4t ! physics buffer index for a carma temperature + integer :: ipbuf4sati(NGAS) ! physics buffer index for a carma saturation over ice + integer :: ipbuf4satl(NGAS) ! physics buffer index for a carma saturation over liquid + + ! Globals used for a reference atmosphere. + real(kind=f) :: carma_t_ref(pver) ! midpoint temperature (Pa) + real(kind=f) :: carma_h2o_ref(pver) ! h2o mmmr (kg/kg) + real(kind=f) :: carma_h2so4_ref(pver) ! h2so4 mmr (kg/kg) + + + ! Globals used for total statistics + real(kind=f) :: glob_max_nsubstep = 0._f + real(kind=f) :: glob_max_nretry = 0._f + real(kind=f) :: glob_nstep = 0._f + real(kind=f) :: glob_nsubstep = 0._f + real(kind=f) :: glob_nretry = 0._f + + real(kind=f) :: step_max_nsubstep = 0._f + real(kind=f) :: step_max_nretry = 0._f + real(kind=f) :: step_nstep = 0._f + real(kind=f) :: step_nsubstep = 0._f + real(kind=f) :: step_nretry = 0._f + + +contains + + + !! Read the names of the constituents from CARMA and automatically create + !! a list of names based on the constituents and the number of size + !! bins. A naming convention is used to map from CARMA constiuent & bin to + !! CAM constituent, with the smallest bin being 01, then next + !! shortname<02>, ... + !! + !! A check is done to see if the CARMA gases are already present. If so, + !! they gases are linked; otherwise, the gas is added to CAM. The shortname + !! of the gas is used as the constituent name. + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_register + use radconstants, only : nswbands, nlwbands, & + get_sw_spectral_boundaries, get_lw_spectral_boundaries + use cam_logfile, only : iulog + use cam_control_mod, only : initial_run + use physconst, only: gravit, p_rearth=>rearth, mwdry, mwh2o + use phys_control, only: phys_getopts + + implicit none + + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: igas ! gas index + integer :: igroup ! group index + integer :: rc ! CARMA return code + character(len=8) :: c_name ! constituent name + character(len=50) :: c_longname ! constituent long name + real(r8) :: wave(NWAVE) ! wavelength band centers (cm) + real(r8) :: dwave(NWAVE) ! wavelength band width (cm) + logical :: do_wave_emit(NWAVE) ! do emission in band? + real(r8) :: r(NBIN) ! particle radius (cm) + real(r8) :: rmass(NBIN) ! particle mass (g) + character(len=8) :: shortname ! short (CAM) name + character(len=8) :: grp_short ! group short (CAM) name + character(len=50) :: name ! long (CARMA) name + real(r8) :: wtmol ! gas molecular weight + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + + character(len=16) :: radiation_scheme ! CAM's radiation package. + + ! Initialize the return code. + rc = 0 + + ! Some constants are set on the fly in CAM, so initialize them and any derived "constants" here. + ! Some of them are needed in CARMA_DefineModel and CARMA_Initialize. + GRAV = gravit * RM2CGS + REARTH = p_rearth * RM2CGS + WTMOL_AIR = mwdry + WTMOL_H2O = mwh2o + R_AIR = RGAS / WTMOL_AIR + CP = cpair * 1.e7_r8 / 1000._r8 + RKAPPA = R_AIR / CP + + ! Setup the lun for output. + LUNOPRT = iulog + + ! Find out which radiation scheme is active. + call phys_getopts(radiation_scheme_out = radiation_scheme) + + ! Get the wavelength centers for the CAM longwave and shortwave bands + ! from the radiation code. + + ! Can do this 'in place'; set wave to lower boundaries of all bands, + ! dwave to upper boundaries. + call get_lw_spectral_boundaries( wave(:nlwbands ), dwave(:nlwbands ), 'cm') + call get_sw_spectral_boundaries( wave( nlwbands+1:), dwave( nlwbands+1:), 'cm') + + ! Now make dwave the difference and wave the average + dwave = dwave - wave + wave = wave + (dwave / 2._r8) + + ! NOTE: RRTMG does not calculate emission in the shortwave bands and the first and + ! last shortwave bands overlap the longwave bands. At least the first and last bands + ! needs to be excluded and perhaps all of the shortwave bands need to be excluded or + ! double counting will happen for particle emission. The details of this should + ! probably be moved into the radiation code. + do_wave_emit(:nlwbands) = .TRUE. +! do_wave_emit(nlwbands+1:) = .FALSE. + do_wave_emit(nlwbands+1:) = .TRUE. + do_wave_emit(nlwbands+1) = .FALSE. + do_wave_emit(NWAVE) = .FALSE. + + ! Create the CARMA object that will contain all the information about the + ! how CARMA is configured. + + call CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, & + LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit) + if (rc < 0) call endrun('carma_register::CARMA_Create failed.') + + ! Define the microphysical model. + call CARMA_DefineModel(carma, rc) + if (rc < 0) call endrun('carma_register::CARMA_DefineModel failed.') + + if (masterproc) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA general settings for ', trim(carma_model), ' model : ' + write(LUNOPRT,*) ' carma_do_aerosol = ', carma_do_aerosol + write(LUNOPRT,*) ' carma_do_cldice = ', carma_do_cldice + write(LUNOPRT,*) ' carma_do_cldliq = ', carma_do_cldliq + write(LUNOPRT,*) ' carma_do_clearsky = ', carma_do_clearsky + write(LUNOPRT,*) ' carma_do_coag = ', carma_do_coag + write(LUNOPRT,*) ' carma_do_detrain = ', carma_do_detrain + write(LUNOPRT,*) ' carma_do_drydep = ', carma_do_drydep + write(LUNOPRT,*) ' carma_do_emission = ', carma_do_emission + write(LUNOPRT,*) ' carma_do_fixedinit = ', carma_do_fixedinit + write(LUNOPRT,*) ' carma_do_grow = ', carma_do_grow + write(LUNOPRT,*) ' carma_do_explised = ', carma_do_explised + write(LUNOPRT,*) ' carma_do_incloud = ', carma_do_incloud + write(LUNOPRT,*) ' carma_do_partialinit= ', carma_do_partialinit + write(LUNOPRT,*) ' carma_do_pheat = ', carma_do_pheat + write(LUNOPRT,*) ' carma_do_pheatatm = ', carma_do_pheatatm + write(LUNOPRT,*) ' carma_do_substep = ', carma_do_substep + write(LUNOPRT,*) ' carma_do_thermo = ', carma_do_thermo + write(LUNOPRT,*) ' carma_do_vdiff = ', carma_do_vdiff + write(LUNOPRT,*) ' carma_do_vtran = ', carma_do_vtran + write(LUNOPRT,*) ' carma_do_wetdep = ', carma_do_wetdep + write(LUNOPRT,*) ' carma_dgc_threshold = ', carma_dgc_threshold + write(LUNOPRT,*) ' carma_ds_threshold = ', carma_ds_threshold + write(LUNOPRT,*) ' carma_dt_threshold = ', carma_dt_threshold + write(LUNOPRT,*) ' carma_cstick = ', carma_cstick + write(LUNOPRT,*) ' carma_gsticki = ', carma_gsticki + write(LUNOPRT,*) ' carma_gstickl = ', carma_gstickl + write(LUNOPRT,*) ' carma_tstick = ', carma_tstick + write(LUNOPRT,*) ' carma_rhcrit = ', carma_rhcrit + write(LUNOPRT,*) ' carma_conmax = ', carma_conmax + write(LUNOPRT,*) ' carma_minsubsteps = ', carma_minsubsteps + write(LUNOPRT,*) ' carma_maxsubsteps = ', carma_maxsubsteps + write(LUNOPRT,*) ' carma_maxretries = ', carma_maxretries + write(LUNOPRT,*) ' carma_vf_const = ', carma_vf_const + write(LUNOPRT,*) ' cldfrc_incloud = ', CLDFRC_INCLOUD + write(LUNOPRT,*) ' carma_reftfile = ', trim(carma_reftfile) + write(LUNOPRT,*) ' carma_rad_feedback = ', carma_rad_feedback + write(LUNOPRT,*) '' + endif + + ! Intialize the model based upon the namelist configuration. + ! + ! NOTE: When used with CAM, the latents heats (of melting and evaporation) + ! need to be constant for energy balance to work. This allows them to match the + ! assumptions made in the CAM energy checking and microphysics code. + call CARMA_Initialize(carma, & + rc, & + do_clearsky = carma_do_clearsky, & + do_cnst_rlh = .true., & + do_coag = carma_do_coag, & + do_detrain = carma_do_detrain, & + do_drydep = carma_do_drydep, & + do_fixedinit = carma_do_fixedinit, & + do_grow = carma_do_grow, & + do_explised = carma_do_explised, & + do_incloud = carma_do_incloud, & + do_partialinit= carma_do_partialinit, & + do_pheat = carma_do_pheat, & + do_pheatatm = carma_do_pheatatm, & + do_print_init = masterproc, & + do_substep = carma_do_substep, & + do_thermo = carma_do_thermo, & + do_vdiff = carma_do_vdiff, & + do_vtran = carma_do_vtran, & + minsubsteps = carma_minsubsteps, & + maxsubsteps = carma_maxsubsteps, & + maxretries = carma_maxretries, & + vf_const = carma_vf_const, & + conmax = carma_conmax, & + cstick = carma_cstick, & + dt_threshold = carma_dt_threshold, & + gsticki = carma_gsticki, & + gstickl = carma_gstickl, & + tstick = carma_tstick) + if (rc < 0) call endrun('carma_register::CARMA_Initialize failed.') + + + ! The elements and gases from CARMA need to be added as constituents in + ! CAM (if they don't already exist). For the elements, each radius bin + ! needs to be its own constiuent in CAM. + ! + ! Some rules about the constituents: + ! 1) The shortname must be 8 characters or less, so the CARMA short name + ! is limited to 6 characters and 2 characters for the bin number. + ! 2) The molecular weight is in kg/kmol. + ! 3) The specific heat at constant pressure is in J/kg/K. + ! 4) The consituents are added sequentially. + + ! Add a CAM constituents for each bin of each element. + do ielem = 1, NELEM + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup, shortname=shortname, name=name) + if (rc < 0) call endrun('carma_register::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, shortname=grp_short) + if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.') + + ! For prognostic groups, all of the bins need to be represented as actual CAM + ! constituents. Diagnostic groups are determined from state information that + ! is already present in CAM, and thus their bins only exist in CARMA. + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin + + write(c_name, '(A, I2.2)') trim(shortname), ibin + write(c_longname, '(A, e11.4, A)') trim(name) // ', ', r(ibin)*1.e4_r8, ' um' + + ! The molecular weight seems to be used for molecular diffusion, which + ! doesn't make sense for particles. The CAM solvers are unstable if the + ! mass provided is large. + call cnst_add(c_name, WTMOL_AIR, cpair, 0._r8, icnst4elem(ielem, ibin), & + longname=c_longname, mixtype=carma_mixtype, is_convtran1=is_convtran1(igroup)) + end if + end do + end if + end do + + ! Find the constituent for the gas or add it if not found. + do igas = 1, NGAS + + call CARMAGAS_Get(carma, igas, rc, shortname=shortname, name=name, wtmol=wtmol) + if (rc < 0) call endrun('carma_register::CARMAGAS_Get failed.') + + ! Is the gas already defined? + call cnst_get_ind(shortname, icnst4gas(igas)) + + ! For substepping, we need to store the last mmr values for the gas. + call pbuf_add_field('CG' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4gas(igas)) + + ! For substepping, we need to store the last supersaturations. + call pbuf_add_field('CI' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4sati(igas)) + call pbuf_add_field('CL' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4satl(igas)) + end do + + + ! For substepping, we need to store the temperature. + call pbuf_add_field('CT', 'global',dtype_r8, (/pcols, pver/), ipbuf4t) + + + ! Create the optical properties files needed for RRTMG radiative transfer + ! calculations. + ! + ! NOTE: This only needs to be done once at the start of the run and does not need + ! to be done for restarts. + ! + ! NOTE: We only want to do this with RRTMG. If CAM_RT is being used, then skip this. + if ((masterproc) .and. (initial_run) .and. (radiation_scheme == "rrtmg") .and. (carma_do_optics)) then + call CARMA_CreateOpticsFile(carma, rc) + if (rc < 0) call endrun('carma_register::carma_CreateOpticsFiles failed.') + end if + + return + end subroutine carma_register + + + !! Returns true if the CARMA package is active + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May 2009 + function carma_is_active() + implicit none + + logical :: carma_is_active + + carma_is_active = carma_flag + + return + end function carma_is_active + + + !! Returns true if specified constituent is implemented by CARMA + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May 2009 + function carma_implements_cnst(name) + implicit none + + character(len=*), intent(in) :: name !! constituent name + logical :: carma_implements_cnst ! return value + + integer :: igroup + integer :: ielem + integer :: ibin + integer :: igas + integer :: rc + + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + + rc = 0 + + carma_implements_cnst = .false. + + ! Check each bin to see if it this constituent. + do ielem = 1, NELEM + do ibin = 1, NBIN + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the parent model. + if (ibin <= maxbin) then + + if (name == cnst_name(icnst4elem(ielem, ibin))) then + carma_implements_cnst = .true. + return + end if + end if + end if + end do + end do + + ! Check each gas to see if it this constituent. + do igas = 1, NGAS + if (name == cnst_name(icnst4gas(igas))) then + carma_implements_cnst = .true. + return + end if + end do + + return + end function carma_implements_cnst + + + !! Initialize items in CARMA that only need to be initialized once. This + !! routine is called after carma_register has been called. + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May 2009 + subroutine carma_init + use cam_history, only: addfld, add_default, horiz_only + use ioFileMod, only : getfil + use wrap_nf + use time_manager, only: is_first_step + use phys_control, only: phys_getopts + + implicit none + + integer :: iz ! vertical index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: igas ! gas index + integer :: igroup ! group index + integer :: icnst ! constituent index + integer :: rc ! CARMA return code + character(len=8) :: sname ! short (CAM) name + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + logical :: is_cloud ! is the group a cloud? + logical :: do_drydep ! is dry deposition enabled? + + integer :: i + integer :: ier + integer :: ncid, dimid_lev, lev, vid_T + logical :: lexist + character(len=256) :: locfn + integer :: nlev + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + logical :: history_carma + + +1 format(a6,4x,a11,4x,a11,4x,a11) +2 format(i6,4x,3(1pe11.3,4x)) + + ! Initialize the return code. + rc = 0 + + call phys_getopts(history_carma_out=history_carma) + + ! Set names of constituent sources and declare them as history variables; howver, + ! only prognostic variables have. + lq_carma(:) = .false. + + do ielem = 1, NELEM + do ibin = 1, NBIN + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) + if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the parent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + ! Indicate that this is a constituent whose tendency could be changed by + ! CARMA. + lq_carma(icnst) = .true. + + etndname(ielem, ibin) = trim(cnst_name(icnst)) + + call addfld(cnst_name(icnst), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(icnst)) + if (history_carma) then + call add_default(cnst_name(icnst), 1, ' ') + end if + + call addfld(trim(etndname(ielem, ibin))//'TC', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(icnst)) // ' tendency') + call addfld(trim(etndname(ielem, ibin))//'SF', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(icnst)) // ' surface emission') + call addfld(trim(etndname(ielem, ibin))//'EM', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(icnst)) // ' emission') + call addfld(trim(etndname(ielem, ibin))//'WD', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(icnst)) // ' wet deposition') + call addfld(trim(etndname(ielem, ibin))//'SW', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(icnst)) // ' wet deposition flux at surface') + + if (do_drydep) then + call addfld(trim(etndname(ielem, ibin))//'DD', horiz_only, 'A', 'kg/m2/s ', & + trim(cnst_name(icnst)) // ' dry deposition') + end if + + if (carma_do_pheat) then + call addfld(trim(etndname(ielem, ibin))//'TP', (/ 'lev' /), 'A', 'K ', & + trim(cnst_name(icnst)) // ' delta particle temperature') + end if + end if + end if + end do + end do + + do igroup = 1, NGROUP + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep) + if (rc < 0) call endrun('carma_init::CARMAGROUP_GetGroup failed.') + + ! Gridbox average + ! + ! NOTE: Would like use flag_xf_fill for the reffective radius fields, but cam_history + ! currently only supports fill values in the entire column. + call addfld(trim(sname)//'ND', (/ 'lev' /), 'A', '#/cm3', trim(sname) // ' number density') + call addfld(trim(sname)//'AD', (/ 'lev' /), 'A', 'um2/cm3', trim(sname) // ' surface area density') + call addfld(trim(sname)//'MD', (/ 'lev' /), 'A', 'g/cm3', trim(sname) // ' mass density') + call addfld(trim(sname)//'RE', (/ 'lev' /), 'A', 'um', trim(sname) // ' effective radius') + call addfld(trim(sname)//'RM', (/ 'lev' /), 'A', 'um', trim(sname) // ' Mitchell effective radius') + call addfld(trim(sname)//'JN', (/ 'lev' /), 'A', '#/cm3/s', trim(sname) // ' nucleation rate') + call addfld(trim(sname)//'MR', (/ 'lev' /), 'A', 'kg/kg', trim(sname) // ' mass mixing ratio') + call addfld(trim(sname)//'EX', (/ 'lev' /), 'A', 'km-1', trim(sname) // ' extinction') + call addfld(trim(sname)//'OD', (/ 'lev' /), 'A', ' ', trim(sname) // ' optical depth') + call addfld(trim(sname)//'PA', (/ 'lev' /), 'A', 'cm2', trim(sname) // ' projected area') + call addfld(trim(sname)//'AR', (/ 'lev' /), 'A', ' ', trim(sname) // ' area ratio') + call addfld(trim(sname)//'VM', (/ 'lev' /), 'A', 'm/s', trim(sname) // ' fall velocity') + + if (history_carma) then + call add_default(trim(sname)//'ND', 1, ' ') + call add_default(trim(sname)//'AD', 1, ' ') + call add_default(trim(sname)//'MD', 1, ' ') + call add_default(trim(sname)//'RE', 1, ' ') + call add_default(trim(sname)//'RM', 1, ' ') + call add_default(trim(sname)//'MR', 1, ' ') + call add_default(trim(sname)//'EX', 1, ' ') + call add_default(trim(sname)//'OD', 1, ' ') + call add_default(trim(sname)//'PA', 1, ' ') + call add_default(trim(sname)//'AR', 1, ' ') + call add_default(trim(sname)//'VM', 1, ' ') + + if (carma_do_grow) then + call add_default(trim(sname)//'JN', 1, ' ') + end if + end if + + ! Per bin stats .. + if (do_drydep) then + do ibin = 1, NBIN + call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & + trim(cnst_name(icnst)) // ' dry deposition velocity') + end do + end if + + end do + + do igas = 1, NGAS + icnst = icnst4gas(igas) + + ! Indicate that this is a constituent whose tendency could be changed by + ! CARMA. + lq_carma(icnst) = .true. + gtndname(igas) = trim(cnst_name(icnst)) // 'TC' + + call addfld(gtndname(igas), (/ 'lev' /), 'A', 'kg/kg/s', trim(cnst_name(icnst)) // ' CARMA tendency') + + call addfld(trim(cnst_name(icnst))//'SI', (/ 'lev' /), 'A', 'ratio', & + trim(cnst_name(icnst)) // ' saturation wrt ice') + call addfld(trim(cnst_name(icnst))//'SL', (/ 'lev' /), 'A', 'ratio', & + trim(cnst_name(icnst)) // ' saturation wrt liquid') + call addfld(trim(cnst_name(icnst))//'EI', (/ 'lev' /), 'A', 'mol/mol', & + trim(cnst_name(icnst)) // ' equilibrium vmr wrt ice') + call addfld(trim(cnst_name(icnst))//'EL', (/ 'lev' /), 'A', 'mol/mol', & + trim(cnst_name(icnst)) // ' equilibrium vmr wrt liquid') + call addfld(trim(cnst_name(icnst))//'WT', (/ 'lev' /), 'A', '%', & + trim(cnst_name(icnst)) // ' weight percent aerosol composition') + + if (history_carma) then + call add_default(trim(cnst_name(icnst))//'SI', 1, ' ') + call add_default(trim(cnst_name(icnst))//'SL', 1, ' ') + end if + end do + + if (carma_do_thermo) then + call addfld('CRTT', (/ 'lev' /), 'A', 'K/s', ' CARMA temperature tendency') + end if + + ! Add fields for diagnostic fields, and make them defaults on the first tape. + if (carma_do_substep) then + call addfld('CRNSTEP', (/ 'lev' /), 'A', ' ', 'number of carma substeps') + call addfld('CRLNSTEP', (/ 'lev' /), 'A', ' ', 'ln(number of carma substeps)') + + if (history_carma) then + call add_default('CRNSTEP', 1, ' ') + call add_default('CRLNSTEP', 1, ' ') + end if + end if + + + ! Set up the reference atmosphere that can be used for fixed initialization. This is + ! an approximate atmospheric used to define average fall velocities, coagulation + ! kernels, and growth parameters. + if (carma_do_fixedinit) then + + ! NOTE: Reading the initial condtion file using the supplied routines must + ! be done outside of masterproc, so does this in all threads before deciding + ! if it will be used. The initial condition file is only opened on an initial run. + if (is_first_step()) then + call carma_getT(carma_t_ref) + if (carma%f_igash2o /= 0) call carma_getH2O(carma_h2o_ref) + if (carma%f_igash2So4 /= 0) call carma_getH2SO4(carma_h2so4_ref) + end if + + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_init::CARMA_Get failed.') + + if (do_print) write(LUNOPRT,*) "" + if (do_print) write(LUNOPRT,*) "CARMA initializing to fixed reference state." + if (do_print) write(LUNOPRT,*) "" + + ! For temperature, get the average temperature from reference temperature file + ! if it exists or from the initial condition file if the reference temperature file + ! doesn't exist. + ! + ! NOTE: The reference temperature file will only be created for an inital run. It + ! must already exist for a restart run. + + ! Does reference temperature file already exist? + call getfil(carma_reftfile, locfn, iflag=1) + + inquire(file=locfn, exist=lexist) + + ! Read the reference temperature from the file. + if (lexist) then + + ! Open the netcdf file. + call wrap_open(trim(locfn), NF90_NOWRITE, ncid) + + ! Inquire about dimensions + call wrap_inq_dimid(ncid, 'lev', dimid_lev) + call wrap_inq_dimlen(ncid, dimid_lev, nlev) + + ! Does the number of levels match? + if (nlev /= pver) then + call endrun("carma_init::ERROR - Incompatible number of levels & + &in the CARMA reference temperature file ... " // trim(locfn)) + end if + + ! Get variable ID for reference temperature + call wrap_inq_varid(ncid, 'T', vid_T) + + ! Read in the temperature data. + call wrap_get_var_realx(ncid, vid_T, carma_T_ref) + + if (carma%f_igash2o /= 0) then + ! Get variable ID for reference temperature + call wrap_inq_varid(ncid, 'Q', vid_T) + + ! Read in the temperature data. + call wrap_get_var_realx(ncid, vid_T, carma_h2o_ref) + end if + + if (carma%f_igash2so4 /= 0) then + ! Get variable ID for reference temperature + call wrap_inq_varid(ncid, 'H2SO4', vid_T) + + ! Read in the temperature data. + call wrap_get_var_realx(ncid, vid_T, carma_h2so4_ref) + end if + + ! Close the file + call wrap_close(ncid) + + ! Is this an initial or restart run? + else if (is_first_step()) then + + if (do_print) write(LUNOPRT,*) "" + if (do_print) write(LUNOPRT,*) 'Creating CARMA reference temperature file ... ', trim(locfn) + + ! Save the average into a file to be used for restarts. + call CARMA_CreateRefTFile(carma, locfn, pref_mid(:) / 100._r8, & + carma_t_ref(:), rc, refh2o=carma_h2o_ref(:), refh2so4=carma_h2so4_ref(:)) + else + + ! The file must already exist for a restart run. + call endrun("carma_init::ERROR - Can't find the CARMA reference temperature file ... " // trim(carma_reftfile)) + + end if + + ! Write out the values that are being used. + if (do_print) write(LUNOPRT,*) "" + if (do_print) write(LUNOPRT,1) "Level","Int P (Pa)","Mid P (Pa)","Mid T (K)" + + do iz = 1, pver + if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), pref_mid(iz), carma_t_ref(iz) + end do + if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), 0.0_r8, 0.0_r8 + if (do_print) write(LUNOPRT,*) "" + end if + +#ifdef SPMD + + ! Communicate the settings to the other MPI tasks. + call mpi_bcast(carma_t_ref, pver, MPI_REAL8, 0, mpicom, ier) +#endif + end if + + + ! Do a model specific initialization. + call CARMA_InitializeModel(carma, lq_carma, rc) + if (rc < 0) call endrun('carma_init::CARMA_InitializeModel failed.') + + return + end subroutine carma_init + + + !! Finalize (cleanup allocations) in the CARMA model. + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version October 2009 + subroutine carma_final + implicit none + + integer :: rc ! CARMA return code + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + 2 format(' carma_final: overall substepping statistics',/,& + ' max nsubstep=',1F9.0,/,' avg nsubstep=',1F9.2,/,& + ' max nretry=',1F9.0,/,' avg nretry=',1F10.4) + + ! Initialize the return code. + rc = 0 + + ! Output the end of run statistics for CARMA + if (carma_do_substep) then + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_final::CARMA_Get failed.') + + if (glob_nstep > 0) then + if (do_print) write(LUNOPRT,2) glob_max_nsubstep, & + glob_nsubstep / glob_nstep, & + glob_max_nretry, & + glob_nretry / glob_nstep + else + if (do_print) write(LUNOPRT,2) glob_max_nsubstep, & + 0., & + glob_max_nretry, & + 0. + end if + end if + end if + + + ! Do a model specific initialization. + call CARMA_Destroy(carma, rc) + if (rc < 0) call endrun('carma_final::CARMA_Destroy failed.') + + return + end subroutine carma_final + + + !! Initialization that needs to be done prior to each timestep. + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_timestep_init + implicit none + + if (.not. carma_flag) return + + ! Reset the stats, so that they are per timestep values. + step_max_nsubstep = 0._f + step_max_nretry = 0._f + step_nstep = 0._f + step_nsubstep = 0._f + step_nretry = 0._f + + return + end subroutine carma_timestep_init + + + !! Calculates the tendencies for all of the constituents handled by CARMA. + !! To do this: + !! + !! - a CARMASTATE object is created + !! - it is set to the current CAM state + !! - a new state is determined by CARMA + !! - the difference between these states is used to determine the tendencies + !! - statistics arecollected and reported + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! NOTE: Need to add code for getting/putting last fields into the physics + !! buffer from substeping. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rliq, prec_str, snow_str, & + prec_sed, snow_sed, ustar, obklen) + use time_manager, only: get_nstep, get_step_size, is_first_step + use camsrfexch, only: cam_in_t, cam_out_t + use scamMod, only: single_column + use planck, only: planckIntensity + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + type(cam_in_t), intent(in) :: cam_in !! surface inputs + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_ptend), intent(out) :: ptend !! constituent tendencies + real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(in), optional :: ustar(pcols) !! friction velocity (m/s) + real(r8), intent(in), optional :: obklen(pcols) !! Obukhov length [ m ] + + ! Local variables + type(physics_state) :: state_loc ! local physics state using wet mmr + type(carma_type), pointer :: carma_ptr ! the carma state object + type(carmastate_type) :: cstate ! the carma state object + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ielem_nd ! index of numder density element in group + integer :: ibin ! bin index + integer :: igas ! gas index + integer :: icol ! column index + integer :: icnst ! constituent index + integer :: icnst_q ! H2O constituent index + integer :: ncol ! number of columns + integer :: rc ! CARMA return code + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + real(r8) :: spdiags(pcols, pver, NSPDIAGS) ! CARMA step diagnostic output + real(r8) :: gsdiags(pcols, pver, NGAS, NGSDIAGS) ! CARMA gas diagnostic output + real(r8) :: gpdiags(pcols, pver, NGROUP, NGPDIAGS) ! CARMA group diagnostic output + real(r8) :: sbdiags(pcols, NBIN, NELEM, NSBDIAGS) ! CARMA surface bin diagnostic output + real(r8) :: bndiags(pcols, pver, NBIN, NELEM, NBNDIAGS) ! CARMA bin diagnostic output + real(r8) :: newstate(pver) ! next state for a physics state field + real(r8) :: xc(pver) ! x center + real(r8) :: dx(pver) ! x width + real(r8) :: yc(pver) ! y center + real(r8) :: dy(pver) ! y width + real(r8) :: dz(pver) ! z width + real(r8) :: satice(pver) ! saturation wrt ice + real(r8) :: satliq(pver) ! saturation wrt liquid + real(r8) :: eqice(pver) ! equil vp wrt ice + real(r8) :: eqliq(pver) ! equil vp wrt liquid + real(r8) :: wtpct(pver) ! weight percent aerosol composition + real(r8) :: time ! the total elapsed time (s) + real(r8) :: dlat ! latitude spacing + real(r8) :: r(NBIN) ! particle radius (cm) + real(r8) :: rmass(NBIN) ! particle mass (g) + real(r8) :: rrat(NBIN) ! particle maximum radius ratio () + real(r8) :: arat(NBIN) ! particle area ration () + real(r8) :: rhoelem ! element density (g) + real(r8) :: nd(pver) ! number density (cm-3) + real(r8) :: ad(pver) ! area density (um2/cm3) + real(r8) :: md(pver) ! mass density (g cm-3) + real(r8) :: mr(pver) ! mass mixing ratio (kg/kg) + real(r8) :: re(pver) ! effective radius (um) + real(r8) :: rm(pver) ! Mitchell effective radius (um) + real(r8) :: ex(pver) ! extinction (km-1) + real(r8) :: od(pver) ! optical depth + real(r8) :: re2(pver) ! N(r)*r^2 (cm2) + real(r8) :: re3(pver) ! N(r)*r^3 (cm3) + real(r8) :: pa(pver) ! Projected Area (cm2) + real(r8) :: ar(pver) ! Area Ratio + real(r8) :: vm(pver) ! Massweighted fall velocity (cm2) + real(r8) :: jn(pver) ! nucleation (cm-3) + real(r8) :: numberDensity(pver) ! number density (cm-3) + real(r8) :: nucleationRate(pver) ! nucleation rate (cm-3 s-1) + real(r8) :: extinctionCoefficient(pver) ! extinction coefficient (cm2) + real(r8) :: dd ! dry deposition (kg/m2) + real(r8) :: vd ! dry deposition velocity (cm/s) + real(r8) :: vf(pverp) ! fall velocity (cm/s) + real(r8) :: dtpart(pver) ! delta particle temperature (K) + real(r8), pointer, dimension(:, :) :: t_ptr ! last temperature + real(r8), pointer, dimension(:, :) :: gc_ptr ! last gas mmr + real(r8), pointer, dimension(:, :) :: sati_ptr ! last saturation wrt ice + real(r8), pointer, dimension(:, :) :: satl_ptr ! last saturation wrt liquid + real(r8), pointer, dimension(:, :, :) :: su_ptr ! shortwave flux up (W/m2) + real(r8), pointer, dimension(:, :, :) :: sd_ptr ! shortwave flux down (W/m2) + real(r8), pointer, dimension(:, :, :) :: lu_ptr ! longwave flux up (W/m2) + real(r8), pointer, dimension(:, :, :) :: ld_ptr ! longwave flux down (W/m2) + real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) + real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) + real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) + integer :: lchnk ! chunk identifier + real(r8) :: coremmr(pver) + real(r8) :: ttlmmr(pver) + integer :: iz + real(r8) :: cldfrc(pver) ! cloud fraction [fraction] + real(r8) :: rhcrit(pver) ! relative humidity for onset of liquid clouds [fraction] + real(r8) :: lndram ! land aerodynamical resistance [s/m] + real(r8) :: lndfv ! surface friction velocity from land [m/s] + real(r8) :: ocnram ! ocean aerodynamical resistance [s/m] + real(r8) :: ocnfv ! surface friction velocity from ocean [m/s] + real(r8) :: iceram ! sea ice aerodynamical resistance [s/m] + real(r8) :: icefv ! surface friction velocity from sea ice [m/s] + real(r8) :: radint(pver,NWAVE) ! radiative intensity (W/m2/sr/cm) + real(kind=f) :: dwave(NWAVE) ! the wavelengths widths (cm) + real(kind=f) :: wave(NWAVE) ! the center wavelengths (cm) + + integer :: max_nsubstep + real(kind=f) :: max_nretry + real(kind=f) :: nstep + integer :: nsubstep + real(kind=f) :: nretry + real(kind=f) :: zsubsteps(pver) + logical :: is_cloud ! is the group a cloud? + logical :: is_ice ! is the group ice? + integer :: ienconc + logical :: grp_do_drydep ! is dry depostion enabled for group? + logical :: do_drydep ! is dry depostion enabled? + logical :: do_fixedinit ! do initialization from reference atm? + logical :: do_detrain ! do convective detrainment? + integer :: iwvl + real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length [m] + real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length [m] + + + ! Initialize the return code. + rc = 0 + + ! Initialize the output tendency structure. + call physics_ptend_init(ptend,state%psetcols,'CARMA', ls=carma_do_thermo, lq=lq_carma) + + if (present(prec_sed)) prec_sed(:) = 0._f + if (present(snow_sed)) snow_sed(:) = 0._f + if (present(prec_str)) prec_str(:) = 0._f + if (present(snow_str)) snow_str(:) = 0._f + + if (.not. carma_flag) return + + ! Determine the current time in seconds. + time = dt * get_nstep() - 1 + + ! The CARMA interface assumes that mass mixing ratios are relative to a + ! wet atmosphere, so convert any dry mass mixing ratios to wet. + call physics_state_copy(state, state_loc) + call set_dry_to_wet(state_loc) + + spdiags(:, :, :) = 0.0_r8 + gpdiags(:, :, :, :) = 0.0_r8 + gsdiags(:, :, :, :) = 0.0_r8 + sbdiags(:, :, :, :) = 0.0_r8 + bndiags(:, :, :, :, :) = 0.0_r8 + + ! Find the constituent index for water vapor. + call cnst_get_ind('Q', icnst_q) + + ! Get pointers into pbuf ... + lchnk = state_loc%lchnk + + call pbuf_get_field(pbuf, ipbuf4t, t_ptr) + + ! If doing particle heating, then get pointers to the spectral flux data provided + ! by the radiation code in the physics buffer. + ! + ! NOTE: RRTMG can now be done in a subset of all levels, rather than the full + ! model height. Any implications for this code have not been worked out. + if (carma_do_pheat) then + call pbuf_get_field(pbuf, pbuf_get_index("SU"), su_ptr) + call pbuf_get_field(pbuf, pbuf_get_index("SD"), sd_ptr) + call pbuf_get_field(pbuf, pbuf_get_index("LU"), lu_ptr) + call pbuf_get_field(pbuf, pbuf_get_index("LD"), ld_ptr) + end if + + ! Cloud ice pbuf fields + if (carma_do_cldice) then + call pbuf_get_field(pbuf, pbuf_get_index("TND_QSNOW"), tnd_qsnow) + call pbuf_get_field(pbuf, pbuf_get_index("TND_NSNOW"), tnd_nsnow) + call pbuf_get_field(pbuf, pbuf_get_index("RE_ICE"), re_ice) + end if + + + ! Create a CARMASTATE object which contains state information about one + ! column of the atmosphere. + carma_ptr => carma + + + ! If initializing CARMASTATE from a reference state, do it before entering the main + ! loop. + ! + call CARMA_Get(carma, rc, do_fixedinit=do_fixedinit, do_drydep=do_drydep) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') + + if (do_fixedinit) then + + ! The latitude and longitude are arbitrary, but the dimensions need to be correct. + xc = 255._r8 + yc = 40._r8 + + ! Assume resolution is 64x128. + if (single_column) then + dx = 360._r8 / 128._r8 + dy = 180._r8 / 64._r8 + else + + ! Calculate the x and y coordinates, in degrees latitude and longitude. + dx = 360._r8 / plon + dy = 180._r8 / (plat-1) + end if + + call CARMASTATE_CreateFromReference(cstate, & + carma_ptr, & + time, & + dt, & + pver, & + I_HYBRID, & + I_LL, & + 40._r8, & + 255._r8, & + xc, & + dx, & + yc, & + dy, & + pref_mid_norm, & + pref_edge/psurf_ref, & + pref_mid(:), & + pref_edge(:), & + carma_t_ref(:), & + rc, & + qh2o=carma_h2o_ref, & + qh2so4=carma_h2so4_ref) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_CreateFromReference failed.') + end if + + + ! Process each column. + do icol = 1, state_loc%ncol + + ! Haven't figured out how to get dimensions for single column. Perhaps should change + ! CARMA to work with area rather than dx and dy. For now, just hack something. + xc(:) = state_loc%lon(icol) / DEG2RAD + yc(:) = state_loc%lat(icol) / DEG2RAD + + ! Assume resolution is 64x128. + if (single_column) then + dx = 360._r8 / 128._r8 + dy = 180._r8 / 64._r8 + else + + ! Caclulate the x and y coordinates, in degrees latitude and longitude. + dx(:) = 360._r8 / plon + + dlat = 180._r8 / (plat-1) + + ! The pole points need special treatment, since the point is not the + ! center of the grid box. + ! + ! In single column mode there is just one latitude, so make it global. + if (abs(state_loc%lat(icol) / DEG2RAD) >= (90._r8 - (90._r8 / (plat-1)))) then + + ! Nudge yc toward the equator. + yc(:) = yc(:) - sign(0.25_r8,state_loc%lat(icol)) * dlat + + dy(:) = dlat / 2._r8 + else + dy(:) = dlat + endif + end if + + if (is_first_step()) then + t_ptr(icol,:) = state_loc%t(icol,:) + end if + + ! For particle heating, need to get the incoming radiative intensity from + ! the radiation code. + ! + ! The radiation code can optionally provide the flux up and down per band in W/m2, + ! when the compute_spectral_flux namelist variable is provided to the radiation. This + ! data needs to be scaled to a radiative intensity by assuming it is isotrotropic. + radint(:,:) = 0._f + + if (carma_do_pheat) then + call CARMA_Get(carma, rc, dwave=dwave, wave=wave) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') + + ! CARMA may run before the radiation code for the very first time step. + ! In that case, the lu, ld, su and sd values are NaN. NaN will crash + ! the model, so instead substitute an approximation that is roughly a + ! nighttime (su=sd=0) with a black body temperature of the grid point + ! temperature (lu=ld=B(T)). + ! + ! NOTE: planckIntensity is in erg/cm2/s/sr/cm and lu is in W/m2, + ! so some conversion factors are needed. + if (is_first_step()) then + su_ptr(icol, :, :) = 0._r8 + sd_ptr(icol, :, :) = 0._r8 + + do iwvl = 1, nlwbands + do iz = 1, pver + lu_ptr(icol, iz, iwvl) = planckIntensity(wave(iwvl), state_loc%t(icol, iz)) / 1e7_f * 1e4_f * dwave(iwvl) * PI + end do + lu_ptr(icol, pverp, iwvl) = lu_ptr(icol, pver, iwvl) + + ld_ptr(icol, 2:pverp, iwvl) = lu_ptr(icol, 1:pver, iwvl) + ld_ptr(icol, 1, iwvl) = lu_ptr(icol, 2, iwvl) + end do + end if + + + do iwvl = 1, nlwbands + radint(:, iwvl) = (lu_ptr(icol, 2:, iwvl) + ld_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(iwvl) + end do + + do iwvl = 1, nswbands + radint(:, nlwbands+iwvl) = (su_ptr(icol, 2:, iwvl) + sd_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(nlwbands+iwvl) + end do + end if + + call CARMASTATE_Create(cstate, & + carma_ptr, & + time, & + dt, & + pver, & + I_HYBRID, & + I_LL, & + state_loc%lat(icol) / DEG2RAD, & + state_loc%lon(icol) / DEG2RAD, & + xc, & + dx, & + yc, & + dy, & + pref_mid_norm, & + pref_edge/psurf_ref, & + state_loc%pmid(icol, :), & + state_loc%pint(icol, :), & + state_loc%t(icol, :), & + rc, & + qh2o=state_loc%q(icol, :, icnst_q), & + told=t_ptr(icol, :), & + radint=radint) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Create failed.') + + + ! Store information about the CARMA particles. + + ! For prognostic groups, the mass of the particles for each bin is stored as + ! a unique constituent within CAM. + do ielem = 1, NELEM + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! For prognostic groups, set the bin from the corresponding constituent. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the parent model. + if (ibin <= maxbin) then + call CARMASTATE_SetBin(cstate, ielem, ibin, state_loc%q(icol, :, icnst4elem(ielem, ibin)), rc) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') + else + newstate(:) = 0._f + + call CARMASTATE_SetBin(cstate, ielem, ibin, newstate, rc) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') + end if + end do + end if + end do + + ! Store information about CARMA gases. + do igas = 1, NGAS + call pbuf_get_field(pbuf, ipbuf4gas(igas), gc_ptr) + call pbuf_get_field(pbuf, ipbuf4sati(igas), sati_ptr) + call pbuf_get_field(pbuf, ipbuf4satl(igas), satl_ptr) + + ! Handle the initial case where we don't have last values. + if (is_first_step()) then + gc_ptr(icol,:) = state_loc%q(icol, :, icnst4gas(igas)) + sati_ptr(icol,:) = -1._f + satl_ptr(icol,:) = -1._f + end if + + call CARMASTATE_SetGas(cstate, igas, state_loc%q(icol, :, icnst4gas(igas)), rc, & + mmr_old=gc_ptr(icol,:), satice_old=sati_ptr(icol,:), satliq_old=satl_ptr(icol,:)) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetGas failed.') + end do + + + call CARMA_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') + + + ! If the model supports detraining of condensed water from convection, then pass + ! along the condensed H2O. + call CARMA_Get(carma, rc, do_detrain=do_detrain) + if (rc < 0) call endrun('CARMA_Detrain::CARMA_Get failed.') + + if (do_detrain) then + call CARMA_Detrain(carma, cstate, cam_in, dlf, state_loc, icol, dt, rc, rliq=rliq, prec_str=prec_str, & + snow_str=snow_str, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Detrain failed.') + end if + + + ! Now that detrainment has happened, determine the cloud fractions. + ! These will be used to scale the cloud amount to go from gridbox average to in-cloud + ! values and back. + ! + ! For the cirrus model, assume the cloud fraction is just the ice cloud fraction. + call CARMA_CloudFraction(carma, cstate, cam_in, state_loc, icol, cldfrc, rhcrit, rc) + if (rc < 0) call endrun('carma_timestep_tend::carma_CloudFraction failed.') + + ! A fixed value for rhcrit can be specified in the namelist rather than using the + ! one from the cloud fraction. + if (carma_rhcrit /= 0._f) then + rhcrit(:) = carma_rhcrit + end if + + + ! For dry deposition, provide a surface friction velocity and an aerodynamic + ! resistance for each of the land surface types. The values for the land come + ! from the land model, but those for ocean and sea ice need to be calculated. + if (do_drydep) then + + ! Land + lndfv = cam_in%fv(icol) + lndram = cam_in%ram1(icol) + + ! Ocean + ocnfv = ustar(icol) + ocnram = 0._r8 + if (cam_in%ocnfrac(icol) > 0._r8) then + call CARMA_calcram(ocnfv, & + zzocen, & + state_loc%pdel(icol, pver), & + state_loc%pmid(icol, pver), & + state_loc%t(icol, pver), & + obklen(icol), & + ocnram) + end if + + ! Sea Ice + icefv = ustar(icol) + iceram = 0._r8 + if (cam_in%icefrac(icol) > 0._r8) then + call CARMA_calcram(ocnfv, & + zzocen, & + state_loc%pdel(icol, pver), & + state_loc%pmid(icol, pver), & + state_loc%t(icol, pver), & + obklen(icol), & + iceram) + end if + end if + + + ! Advance the microphysics one timestep. + call CARMASTATE_Step(cstate, rc, cldfrc=cldfrc, rhcrit=rhcrit, & + lndfv=lndfv, ocnfv=ocnfv, icefv=icefv, lndram=lndram, & + ocnram=ocnram, iceram=iceram, lndfrac=cam_in%landfrac(icol), & + ocnfrac=cam_in%ocnfrac(icol), icefrac=cam_in%icefrac(icol)) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Step failed.') + + + ! Get the results for the CARMA particles. + + ! For diagnostic groups, a special routine needs to be called to determine how + ! bins affect the bulk state, since there is not an individual constituent for + ! each bin. + ! + ! NOTE: To work around an XL Fortran compiler bug, the optional arguments can only + ! be passed when defined. + if (present(rliq)) then + call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc, & + rliq=rliq, prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed, & + snow_sed=snow_sed, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow, re_ice=re_ice) + else + call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc) + end if + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_DiagnoseBulk failed.') + + + ! Calculate the group statistics for all elements. + dz(:) = state_loc%zi(icol, 1:pver) - state_loc%zi(icol, 2:pverp) + + do ielem = 1, NELEM + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, & + is_cloud=is_cloud, is_ice=is_ice, do_drydep=grp_do_drydep, rrat=rrat, arat=arat) + if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') + + ! Intialize the group totals + nd(:) = 0.0_r8 + ad(:) = 0.0_r8 + md(:) = 0.0_r8 + mr(:) = 0.0_r8 + re(:) = 0.0_r8 + rm(:) = 0.0_r8 + ex(:) = 0.0_r8 + od(:) = 0.0_r8 + re2(:) = 0.0_r8 + re3(:) = 0.0_r8 + jn(:) = 0.0_r8 + pa(:) = 0.0_r8 + vm(:) = 0.0_r8 + ar(:) = 0.0_r8 + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, newstate(:), rc, & + numberDensity=numberDensity, nucleationRate=nucleationRate, surface=dd, vd=vd, vf=vf, dtpart=dtpart) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetBin failed.') + + ! For prognostic groups, set the tendency from the corresponding constituents. + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + ! Update the consituent tendency. + ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt + + if (grp_do_drydep) then + sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd / dt + sbdiags(icol, ibin, ielem, SBDIAGS_VD) = - vd / 100._r8 + end if + end if + end if + + ! Calculate the total densities. + ! + ! NOTE: Convert AD to um2/cm3. + if (numberDensity(1) /= CAM_FILL) then + nd(:) = nd(:) + numberDensity(:) + re2(:) = re2(:) + numberDensity(:) * ((r(ibin)*rrat(ibin))**2) + re3(:) = re3(:) + numberDensity(:) * ((r(ibin)*rrat(ibin))**3) + ad(:) = ad(:) + numberDensity(:) * 4.0_r8 * PI * (r(ibin)**2) * 1.0e8_r8 + md(:) = md(:) + numberDensity(:) * rmass(ibin) + mr(:) = mr(:) + newstate(:) + pa(:) = pa(:) + numberDensity(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + vm(:) = vm(:) + numberDensity(:) * rmass(ibin) * vf(2:) / 100._f + + ! Calculate the optical depth and extinction. + ! + ! NOTE: Assume Qext = 2 for optical depth. This can be pulled out of CARMA + ! mie claculations later. + ! + ! Convert extinction coefficient to km-1. + extinctionCoefficient(:) = 2.0_r8 * PI * (r(ibin)**2) + ex(:) = ex(:) + numberDensity(:) * extinctionCoefficient(:) * 1e5_r8 + od(:) = od(:) + numberDensity(:) * extinctionCoefficient(:) * dz(:) * 100._r8 + end if + + ! Particle temperatures from particle heating. + if (carma_do_pheat) then + bndiags(icol, :, ibin, ielem, BNDIAGS_TP) = dtpart(:) + end if + + if (nucleationRate(1) /= CAM_FILL) then + jn(:) = jn(:) + nucleationRate(:) + end if + end do + + ! If this is the number element for the group, then write out the + ! statistics. + if (numberDensity(1) /= CAM_FILL) then + + ! Calculate the effective radius (total volume / total area). Places + ! with no surface area will cause NaN values. + ! + ! NOTE: Convert RE to um. + where (re2(:) > 0.0_r8) + re(:) = (re3(:) / re2(:)) * 1e4_r8 + rm(:) = (3._r8 / 4._r8) * (md(:) / (0.917_r8 * pa(:))) * 1e4_r8 + ar(:) = pa(:) / PI / re2(:) + end where + + where (md(:) > 0.0_r8) + vm(:) = vm(:) / md(:) + end where + + ! Store the statistics. + + ! Gridbox average + gpdiags(icol, :, igroup, GPDIAGS_ND) = nd + gpdiags(icol, :, igroup, GPDIAGS_AD) = ad + gpdiags(icol, :, igroup, GPDIAGS_MD) = md + gpdiags(icol, :, igroup, GPDIAGS_RE) = re + gpdiags(icol, :, igroup, GPDIAGS_RM) = rm + gpdiags(icol, :, igroup, GPDIAGS_MR) = mr + gpdiags(icol, :, igroup, GPDIAGS_EX) = ex + gpdiags(icol, :, igroup, GPDIAGS_OD) = od + gpdiags(icol, :, igroup, GPDIAGS_VM) = vm + gpdiags(icol, :, igroup, GPDIAGS_PA) = pa + gpdiags(icol, :, igroup, GPDIAGS_AR) = ar + + if (nucleationRate(1) /= CAM_FILL) then + gpdiags(icol, :, igroup, GPDIAGS_JN) = jn + end if + end if + end do + + + ! Get the results for the CARMA gases. + do igas = 1, NGAS + call pbuf_get_field(pbuf, ipbuf4gas(igas), gc_ptr) + call pbuf_get_field(pbuf, ipbuf4sati(igas), sati_ptr) + call pbuf_get_field(pbuf, ipbuf4satl(igas), satl_ptr) + + call CARMASTATE_GetGas(cstate, igas, newstate(:), rc, satice=satice, satliq=satliq, & + eqice=eqice, eqliq=eqliq, wtpct=wtpct) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetGas failed.') + + icnst = icnst4gas(igas) + + ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt + + gsdiags(icol, :, igas, GSDIAGS_SI) = satice(:) + gsdiags(icol, :, igas, GSDIAGS_SL) = satliq(:) + gsdiags(icol, :, igas, GSDIAGS_EI) = eqice(:) + gsdiags(icol, :, igas, GSDIAGS_EL) = eqliq(:) + gsdiags(icol, :, igas, GSDIAGS_WT) = wtpct(:) + + ! Store the values needed for substepping in the physics buffer. + gc_ptr(icol,:) = newstate(:) + sati_ptr(icol, :) = satice(:) + satl_ptr(icol, :) = satliq(:) + end do + + + ! Get the results for temperature. + call CARMASTATE_GetState(cstate, rc, t=newstate(:)) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetState failed.') + + ! Store the values needed for substepping in the physics buffer. + t_ptr(icol,:) = newstate(:) + + if (carma_do_thermo) then + ptend%s(icol, :) = (newstate(:) - state_loc%t(icol, :)) * cpair / dt + endif + + + ! Get the substepping statistics + if (carma_do_substep) then + call CARMASTATE_Get(cstate, rc, zsubsteps=zsubsteps) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') + + spdiags(icol, :, SPDIAGS_NSTEP) = zsubsteps(:) + spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + end if + end do + + + ! Report substep diagnostics + if (carma_do_substep) then + call CARMASTATE_Get(cstate, rc, max_nsubstep=max_nsubstep, max_nretry=max_nretry, & + nstep=nstep, nsubstep=nsubstep, nretry=nretry) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') + +!$OMP CRITICAL + step_max_nsubstep = max(step_max_nsubstep, real(max_nsubstep, f)) + step_max_nretry = max(step_max_nretry, max_nretry) + + step_nstep = step_nstep + nstep + step_nsubstep = step_nsubstep + real(nsubstep, f) + step_nretry = step_nretry + nretry +!$OMP END CRITICAL + end if + + ! The CARMASTATE object is no longer needed. + call CARMASTATE_Destroy(cstate, rc) + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Destroy failed.') + + + ! Output diagnostic fields. + call carma_output_diagnostics(state_loc, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + + end subroutine carma_timestep_tend + + + subroutine carma_accumulate_stats() + implicit none + + integer :: istat + integer :: rc + real(kind=f) :: wrk + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Define formats + 1 format(' carma: max nsubstep=',1F9.0,3x,'avg nsubstep=',1F9.2,3x,'max nretry=',1F9.0,3x,'avg nretry=',1F10.4) + + if (carma_do_substep) then + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_init::CARMA_Get failed.') + +#ifdef SPMD + call mpi_allreduce(step_max_nsubstep, wrk, 1, mpir8, mpi_max, mpicom, istat) + if( istat /= MPI_SUCCESS ) then + if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for max_nsubstep failed; error = ',istat + call endrun + end if + step_max_nsubstep = wrk + glob_max_nsubstep = max(glob_max_nsubstep, wrk) + + call mpi_allreduce(step_max_nretry, wrk, 1, mpir8, mpi_max, mpicom, istat) + if( istat /= MPI_SUCCESS ) then + if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for max_nsubstep failed; error = ',istat + call endrun + end if + step_max_nretry = wrk + glob_max_nretry = max(glob_max_nretry, wrk) + + call mpi_allreduce(step_nstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) + if( istat /= MPI_SUCCESS ) then + if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nstep failed; error = ',istat + call endrun + end if + step_nstep = wrk + glob_nstep = glob_nstep + wrk + + call mpi_allreduce(step_nsubstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) + if( istat /= MPI_SUCCESS ) then + if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nsubstep failed; error = ',istat + call endrun + end if + step_nsubstep = wrk + glob_nsubstep = glob_nsubstep + wrk + + call mpi_allreduce(step_nretry, wrk, 1, mpir8, mpi_sum, mpicom, istat) + if( istat /= MPI_SUCCESS ) then + if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nretry failed; error = ',istat + call endrun + end if + step_nretry = wrk + glob_nretry = glob_nretry + wrk +#else + + ! For single CPU or OMP, just set the globals directly. + glob_max_nsubstep = max(glob_max_nsubstep, step_max_nsubstep) + glob_max_nretry = max(glob_max_nretry, step_max_nretry) + glob_nstep = glob_nstep + step_nstep + glob_nsubstep = glob_nsubstep + step_nsubstep + glob_nretry = glob_nretry + step_nretry + +#endif + + if (masterproc) then + if (step_nstep > 0) then + if (do_print) write(LUNOPRT,1) step_max_nsubstep, & + step_nsubstep / step_nstep, & + step_max_nretry, & + step_nretry / step_nstep + else + if (do_print) write(LUNOPRT,1) step_max_nsubstep, & + 0., & + step_max_nretry, & + 0. + end if + end if + end if + + end subroutine carma_accumulate_stats + + + !! Set initial mass mixing ratios of constituents, if nothing is specifed + !! in the initial conditions file. + !! + !! NOTE: This call is part of the CAM Physics Interface + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_init_cnst(name, latvals, lonvals, mask, q) + implicit none + + character(len=*), intent(in) :: name !! constituent name + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ilev ! level index + integer :: ibin ! bin index + integer :: icnst ! constituent index + integer :: rc ! CARMA return code + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + + ! Initialize the return code. + rc = 0 + + ! Determine the element an bin for the particle + do ielem = 1, NELEM + do ibin = 1, NBIN + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + if (cnst_name(icnst) == name) then + + ! By default, initialize all constituents to 0. + do ilev = 1, size(q, 2) + where(mask) + q(:, ilev) = 0.0_r8 + end where + end do + + call CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + if (rc < 0) call endrun('carma_init_cnst::CARMA_InitializeParticle failed.') + end if + end if + end if + end do + end do + + ! NOTE: There is currently no initialization for gases, but it could be + ! added here. + + return + end subroutine carma_init_cnst + + + !! Outputs tracer tendencies and diagnositc fields to the history files. + !! All the columns in the chunk should be output at the same time. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + use cam_history, only: outfld + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output + real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output + real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output + real(r8), intent(in), dimension(pcols, pver, NSPDIAGS) :: spdiags !! CARMA step diagnostic output + real(r8), intent(in), dimension(pcols, pver, NBIN, NELEM, NBNDIAGS) :: bndiags !! CARMA bin diagnostic output + + ! Local variables + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: igas ! gas index + integer :: ienconc ! element index for group's concentration element + integer :: icnst ! constituent index + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns + integer :: rc ! CARMA return code + character(len=8) :: sname ! short (CAM) name + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + logical :: is_cloud ! is the group a cloud? + logical :: do_drydep ! is dry deposition enabled? + + ! Initialize the return code. + rc = 0 + + ! Check each column int the chunk. + lchnk = state%lchnk + ncol = state%ncol + + ! Output step diagnostics. + if (carma_do_substep) then + call outfld('CRNSTEP', spdiags(:, :, SPDIAGS_NSTEP), pcols, lchnk) + call outfld('CRLNSTEP', spdiags(:, :, SPDIAGS_LNSTEP), pcols, lchnk) + end if + + ! Output the particle tendencies. + do ielem = 1, NELEM + do ibin = 1, NBIN + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) + if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + call outfld(trim(etndname(ielem, ibin))//'TC', ptend%q(:, :, icnst), pcols, lchnk) + + if (do_drydep) then + call outfld(trim(etndname(ielem, ibin))//'DD', sbdiags(:, ibin, ielem, SBDIAGS_DD), pcols, lchnk) + end if + + if (carma_do_pheat) then + + ! Only specified for the number density element of the group. + if (bndiags(1, 1, ibin, ielem, BNDIAGS_TP) /= CAM_FILL) then + call outfld(trim(etndname(ielem, ibin))//'TP', bndiags(:, :, ibin, ielem, BNDIAGS_TP), pcols, lchnk) + end if + end if + end if + end if + end do + end do + + ! Output the particle diagnostics. + do igroup = 1, NGROUP + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ienconc=ienconc) + if (rc < 0) call endrun('carma_output_diagnostics::CARMAGROUP_Get failed.') + + ! Gridbox average + call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) + call outfld(trim(sname)//'AD', gpdiags(:, :, igroup, GPDIAGS_AD), pcols, lchnk) + call outfld(trim(sname)//'MD', gpdiags(:, :, igroup, GPDIAGS_MD), pcols, lchnk) + call outfld(trim(sname)//'RE', gpdiags(:, :, igroup, GPDIAGS_RE), pcols, lchnk) + call outfld(trim(sname)//'RM', gpdiags(:, :, igroup, GPDIAGS_RM), pcols, lchnk) + call outfld(trim(sname)//'JN', gpdiags(:, :, igroup, GPDIAGS_JN), pcols, lchnk) + call outfld(trim(sname)//'MR', gpdiags(:, :, igroup, GPDIAGS_MR), pcols, lchnk) + call outfld(trim(sname)//'EX', gpdiags(:, :, igroup, GPDIAGS_EX), pcols, lchnk) + call outfld(trim(sname)//'OD', gpdiags(:, :, igroup, GPDIAGS_OD), pcols, lchnk) + call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) + call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) + call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) + + if (do_drydep) then + do ibin = 1, NBIN + call outfld(trim(btndname(igroup, ibin))//'VD', sbdiags(:, ibin, ienconc, SBDIAGS_VD), pcols, lchnk) + end do + end if + end do + + ! Output the gas tendencies. + do igas = 1, NGAS + icnst = icnst4gas(igas) + + call outfld(gtndname(igas), ptend%q(:, :, icnst), pcols, lchnk) + + ! Output the supersaturations. + call outfld(trim(cnst_name(icnst))//'SI', gsdiags(:, :, igas, GSDIAGS_SI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'SL', gsdiags(:, :, igas, GSDIAGS_SL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EI', gsdiags(:, :, igas, GSDIAGS_EI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EL', gsdiags(:, :, igas, GSDIAGS_EL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'WT', gsdiags(:, :, igas, GSDIAGS_WT), pcols, lchnk) + end do + + ! Output the temperature tendency. + if (carma_do_thermo) then + call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) + end if + + return + end subroutine carma_output_diagnostics + + + !! Calculate the emissions for CARMA aerosols. This is taken from + !! the routine aerosol_emis_intr in aerosol_intr.F90 and dust_emis_intr in + !! dust_intr.F90 by Phil Rasch. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_emission_tend (state, ptend, cam_in, dt) + use cam_history, only: outfld + use camsrfexch, only: cam_in_t + + implicit none + + type(physics_state), intent(in ) :: state !! physics state + type(physics_ptend), intent(inout) :: ptend !! physics state tendencies + type(cam_in_t), intent(inout) :: cam_in !! surface inputs + real(r8), intent(in) :: dt !! time step (s) + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: icnst ! consituent index + real(r8) :: tendency(pcols, pver) ! constituent tendency (kg/kg/s) + real(r8) :: surfaceFlux(pcols) ! constituent surface flux (kg/m^2/s) + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: rc ! CARMA return code + + ! Initialize the return code. + rc = 0 + + ! Initialize the output tendency structure. + call physics_ptend_init(ptend,state%psetcols, 'CARMA (emission)', lq=lq_carma) + + if (.not. carma_flag) return + if (.not. carma_do_emission) return + + ncol = state%ncol + lchnk = state%lchnk + + ! Provide emissions rates for particles. + ! + ! NOTE: This can only be done for prognostic groups. + do ielem = 1, NELEM + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_drydep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_drydep_tend::CARMAGROUP_Get failed.') + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then + + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + call CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + if (rc < 0) call endrun('carma_emission_tend::CARMA_EmitParticle failed.') + + ! Add any surface flux here. + cam_in%cflx(:ncol, icnst) = surfaceFlux(:ncol) + call outfld(trim(cnst_name(icnst))//'SF', cam_in%cflx(:ncol, icnst), ncol, lchnk) + + ! For emissions into the atmosphere, put the emission here. + ptend%q(:ncol, :pver, icnst) = tendency(:ncol, :pver) + call outfld(trim(cnst_name(icnst))//'EM', ptend%q(:ncol, :, icnst), ncol, lchnk) + end if + enddo + end if + enddo + + ! No emissions rate is set up for gases, but it could be added here. + + return + end subroutine carma_emission_tend + + + !! Calculate the wet deposition for the CARMA aerosols. This is taken from + !! the routine aerosol_wet_int in aerosol_intr.F90 and dust_wet_intr in + !! dust_intr.F90 by Phil Rasch. + !! + !! Method: + !! Use a modified version of the scavenging parameterization described in + !! Barth et al, 2000, JGR (sulfur cycle paper) + !! Rasch et al, 2001, JGR (INDOEX paper) + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) + use cam_history, only: outfld + use phys_control, only: cam_physpkg_is + use phys_grid, only: get_lat_all_p, get_lon_all_p, get_rlat_all_p + use wetdep, only: clddiag, wetdepa_v1, wetdepa_v2 + use camsrfexch, only: cam_out_t + use physconst, only: gravit + + implicit none + + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in ) :: state !! physics state + type(physics_ptend), intent(inout) :: ptend !! physics state tendencies + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dlf(pcols,pver) !! Detrainment of convective condensate + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + + ! local vars + real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume + real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing wet chem and scavenging + real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area, top interface of current layer + real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area, top interface of current layer + integer :: ielem ! element index + integer :: igroup ! group index + integer :: ibin ! bin index + integer :: icnst ! constituent index + integer :: lat(pcols) ! latitude indices + real(r8) :: clat(pcols) ! latitudes + integer :: lon(pcols) ! longtitude indices + real(r8) :: conicw(pcols,pver) ! convective in-cloud water + real(r8) :: cmfdqr(pcols,pver) ! convective production of rain + real(r8) :: cldc(pcols,pver) ! convective cloud fraction, currently empty + real(r8) :: clds(pcols,pver) ! Stratiform cloud fraction + real(r8) :: evapc(pcols,pver) ! Evaporation rate of convective precipitation + real(r8) :: iscavt(pcols, pver) + real(r8) :: scavt(pcols, pver) + integer :: ixcldliq + integer :: ixcldice + real(r8) :: totcond(pcols, pver) ! total condensate + real(r8) :: solfac ! solubility factor + real(r8) :: scavcoef ! scavenging Coefficient + logical :: do_wetdep + integer :: ncol ! number of columns + integer :: lchnk ! chunk identifier + integer :: rc ! CARMA return code + real(r8) :: z_scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) + integer :: cnsttype ! constituent type + integer :: k + real(r8) :: sflx(pcols) ! Surface Flux (kg/m2/s) + integer :: maxbin + + ! physics buffer + integer itim_old, ifld + real(r8), pointer, dimension(:,:) :: cldn ! cloud fraction + real(r8), pointer, dimension(:,:) :: cme + real(r8), pointer, dimension(:,:) :: prain + real(r8), pointer, dimension(:,:) :: evapr + real(r8), pointer, dimension(:,:) :: icwmrdp ! in cloud water mixing ratio, deep convection + real(r8), pointer, dimension(:,:) :: rprddp ! rain production, deep convection + real(r8), pointer, dimension(:,:) :: icwmrsh ! in cloud water mixing ratio, deep convection + real(r8), pointer, dimension(:,:) :: rprdsh ! rain production, deep convection + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + real(r8), pointer, dimension(:,:) :: sh_frac ! Shallow convective cloud fraction + real(r8), pointer, dimension(:,:) :: dp_frac ! Deep convective cloud fraction + real(r8), pointer, dimension(:,:) :: evapcsh ! Evaporation rate of shallow convective precipitation >=0. + real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation rate of deep convective precipitation >=0. + + ! Initialize the return code. + rc = 0 + + ! Initialize the output tendency structure. + call physics_ptend_init(ptend,state%psetcols, 'CARMA (wetdep)', lq=lq_carma) + + if (.not. carma_flag) return + if (.not. carma_do_wetdep) return + + ncol = state%ncol + lchnk = state%lchnk + + call get_lat_all_p(lchnk, ncol, lat) + call get_lon_all_p(lchnk, ncol, lon) + call get_rlat_all_p(lchnk, ncol, clat) + + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, pbuf_get_index('CLD'), cldn, (/1,1,itim_old/),(/pcols,pver,1/)) + call pbuf_get_field(pbuf, pbuf_get_index('QME'), cme ) + call pbuf_get_field(pbuf, pbuf_get_index('PRAIN'), prain ) + call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR'), evapr ) + call pbuf_get_field(pbuf, pbuf_get_index('FRACIS'), fracis ) + call pbuf_get_field(pbuf, pbuf_get_index('ICWMRDP'), icwmrdp ) + call pbuf_get_field(pbuf, pbuf_get_index('RPRDDP'), rprddp ) + call pbuf_get_field(pbuf, pbuf_get_index('ICWMRSH'), icwmrsh ) + call pbuf_get_field(pbuf, pbuf_get_index('RPRDSH'), rprdsh ) + + ! sum deep and shallow convection contributions + conicw(:ncol,:) = icwmrdp(:ncol,:) + icwmrsh(:ncol,:) + cmfdqr(:ncol,:) = rprddp(:ncol,:) + rprdsh(:ncol,:) + + call pbuf_get_field(pbuf, pbuf_get_index('SH_FRAC'), sh_frac ) + call pbuf_get_field(pbuf, pbuf_get_index('DP_FRAC'), dp_frac ) + call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_SHCU'), evapcsh ) + call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_DPCU'), evapcdp ) + + cldc(:ncol,:) = dp_frac(:ncol,:) + sh_frac(:ncol,:) ! Sungsu included this. + evapc(:ncol,:) = evapcsh(:ncol,:) + evapcdp(:ncol,:) ! Sungsu included this. + clds(:ncol,:) = cldn(:ncol,:) - cldc(:ncol,:) ! Stratiform cloud fraction + + + cmfdqr(:ncol,:) = rprddp(:ncol,:) + rprdsh(:ncol,:) + + ! fields needed for wet scavenging + call clddiag( state%t, state%pmid, state%pdel, cmfdqr, evapc, cldn, cldc, clds, cme, evapr, prain, & + cldv, cldvcu, cldvst, rainmr, ncol ) + + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + totcond(:ncol,:) = state%q(:ncol,:,ixcldliq) + & + state%q(:ncol,:,ixcldice) + + ! Iterate over each particle and calculate a tendency from wet + ! scavenging for it. + do ielem = 1, NELEM + + ! NOTE: This can only be done for prognistic groups. + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, & + solfac=solfac, scavcoef=scavcoef, maxbin=maxbin) + if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.') + + if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then + + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the parent model. + if (ibin <= maxbin) then + + icnst = icnst4elem(ielem, ibin) + + scavt = 0._r8 + + ! The scavenging coefficient might be calculated as a function of + ! the aerosol bin at each grid point. However, for now, we will just + ! use a constant value for each group. + z_scavcoef(:, :) = scavcoef + + if (cam_physpkg_is('cam5') .or. cam_physpkg_is('cam6')) then + + call wetdepa_v2( & + state%pmid, & + state%q, & + state%pdel, & + cldn, & + cldc, & + cmfdqr, & + evapc, & + conicw, & + prain, & + cme, & + evapr, & + totcond, & + state%q(:, :, icnst), & + dt, & + scavt, & + iscavt, & + cldvcu, & + cldvst, & + dlf, & + fracis(:, :, icnst), & + solfac, & + ncol, & + z_scavcoef) + + else if (cam_physpkg_is('cam4')) then + + call wetdepa_v1(state%t, & + state%pmid, & + state%q, & + state%pdel, & + cldn, & + cldc, & + cmfdqr, & + conicw, & + prain, & + cme, & + evapr, & + totcond, & + state%q(:, :, icnst), & + dt, & + scavt, & + iscavt, & + cldv, & + fracis(:, :, icnst), & + solfac, & + ncol, & + z_scavcoef) + else + + call endrun('carma_wetdep_tend:: No wet deposition routine is available for this configuration.') + end if + + ptend%q(:, :, icnst) = scavt + call outfld(trim(cnst_name(icnst))//'WD', ptend%q(:, :, icnst), pcols, lchnk) + + ! + ! ptend%q(kg/kg air/s) * pdel(Pa) / gravit (m/s2) => (kg/m2/s) + ! note: 1Pa = 1 kg air * (m/s2) / m2 + sflx(:) = 0._r8 + + do k = 1,pver + sflx(:ncol) = sflx(:ncol) - ptend%q(:ncol, k, icnst) * state%pdel(:ncol,k) / gravit + enddo + + call outfld(trim(cnst_name(icnst))//'SW', sflx, pcols, lchnk) + + ! Add this to the surface amount of the constituent + call CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + + end if + end do + end if + end do + + return + end subroutine carma_wetdep_tend + + + !! This routine creates files containing optical properties for each radiatively + !! active particle type. These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + !! + !! NOTE: The format of this file is determined by the needs of the radiative tranfer + !! code, so ideally a routine would exist in that module that could create a file + !! with the proper format. Since that doesn't exist, we do it all here. + subroutine CARMA_CreateOpticsFile(carma, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: igroup, ibin, iwave, irh + integer :: irhswell + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE) + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + logical :: do_mie + integer :: fid + integer :: rhdim, lwdim, swdim + integer :: rhvar, lwvar, swvar + integer :: abs_lw_var + integer :: ext_sw_var, ssa_sw_var, asm_sw_var + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(2) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw(NMIE_RH, nlwbands) + real(kind=f) :: ext_sw(NMIE_RH, nswbands) + real(kind=f) :: ssa_sw(NMIE_RH, nswbands) + real(kind=f) :: asm_sw(NMIE_RH, nswbands) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: nrh + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Process each group that is defined in the model. + do igroup = 1, NGROUP + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, refidx=refidx, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Are we supposed to do the mie calculation for this group? + if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then + + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! For non-hygroscopic, only use 1 RH value. + if (irhswell /= 0) then + nrh = NMIE_RH + else + nrh = min(NMIE_RH, 1) + end if + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band dims." + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) + + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + dimids(1) = rhdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw', NF90_DOUBLE, 2, dimids, abs_lw_var) + + write(LUNOPRT,*) "Defined abs_lw." + + call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') + + dimids(1) = rhdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) + call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) + call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) + + write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." + + call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) + + write(LUNOPRT,*) "Defined lw refindex." + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) + + write(LUNOPRT,*) "Defined sw refindex." + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) + + write(LUNOPRT,*) "Defined omdim." + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) + + write(LUNOPRT,*) "Defined aername." + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) + + write(LUNOPRT,*) "Defined name." + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1:0), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1:0), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1:0), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + + write(LUNOPRT,*) "Defined all variables." + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands))) + + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + ! These fields control whether the particle is treated as a CCN. For now, + ! set these so that CARMA particles are not considered as CCN by the + ! CAM microphysics. + if (irhswell /= 0) then + count_text(1) = len('hygroscopic ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic ' /)) + else + count_text(1) = len('insoluble ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) + end if + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, nrh + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! Calculate at each wavelength. + do iwave = 1, NWAVE +write(carma%f_LUNOPRT,*) "CARMA mie calc: start ", igroup, ibin, iwave, carma%f_wave(iwave), carma%f_group(igroup)%f_nmon(ibin) + + + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: nmon, df, rmon and falpha are only used for fractal particles. + call mie(carma, & + carma%f_group(igroup)%f_imiertn, & + rwet, & + carma%f_wave(iwave), & + carma%f_group(igroup)%f_nmon(ibin), & + carma%f_group(igroup)%f_df(ibin), & + carma%f_group(igroup)%f_rmon, & + carma%f_group(igroup)%f_falpha, & + carma%f_group(igroup)%f_refidx(iwave), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') +write(carma%f_LUNOPRT,*) "CARMA mie calc: done ", Qext, Qsca, asym + + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw(irh, iwave - nlwbands) = Qsca / Qext + asm_sw(irh, iwave - nlwbands) = asym + end if + end do + end do + + ! Write out the longwave fields. + ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var + call handle_error (ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ext_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, ssa_sw_var, ssa_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ssa_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, asm_sw_var, asm_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var + call handle_error (ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + end if + end do + + return + end subroutine CARMA_CreateOpticsFile + + + !! This routine creates a file containing a reference temperature profile + !! for use with fixed initialization. + subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4) + use wrap_nf + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + character(len=*), intent(in) :: filepath !! the file path + real(kind=f), intent(in) :: lev(pver) !! pressure levels + real(kind=f), intent(in) :: reft(pver) !! reference temperature + integer, intent(out) :: rc !! return code, negative indicates failure + real(kind=f), optional, intent(in) :: refh2o(pver) !! reference water vapor + real(kind=f), optional, intent(in) :: refh2so4(pver) !! reference sulfuric acid + + ! Local variables + integer :: fid + integer :: levdim + integer :: levvar, tvar, h2ovar, h2so4var + integer :: dimids(2) + + + ! Assume success. + rc = 0 + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + + ! Define the dimensions: lev + call wrap_def_dim(fid, 'lev', pver, levdim) + + dimids(1) = levdim + call wrap_def_var(fid, 'lev', NF90_DOUBLE, 1, dimids(1:1), levvar) + + call wrap_put_att_text(fid, levvar, 'units', 'level') + call wrap_put_att_text(fid, levvar, 'long_name', 'hybrid level at midpoints (1000*(A+B))') + call wrap_put_att_text(fid, levvar, 'positive', 'down') + call wrap_put_att_text(fid, levvar, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate') + call wrap_put_att_text(fid, levvar, 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS') + + ! Define the variables: T + call wrap_def_var(fid, 'T', NF90_DOUBLE, 1, dimids(1:1), tvar) + + call wrap_put_att_text(fid, tvar, 'units', 'K') + call wrap_put_att_text(fid, tvar, 'long_name', 'Temperature') + + if ((carma%f_igash2o /= 0) .and. present(refh2o)) then + call wrap_def_var(fid, 'Q', NF90_DOUBLE, 1, dimids(1:1), h2ovar) + + call wrap_put_att_text(fid, h2ovar, 'units', 'kg/kg') + call wrap_put_att_text(fid, h2ovar, 'long_name', 'Specific Humidity') + end if + + if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then + call wrap_def_var(fid, 'H2SO4', NF90_DOUBLE, 1, dimids(1:1), h2so4var) + + call wrap_put_att_text(fid, h2so4var, 'units', 'kg/kg') + call wrap_put_att_text(fid, h2so4var, 'long_name', 'H2SO4') + end if + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + + ! Write out the dimensions. + call wrap_put_var_realx(fid, levvar, lev) + + ! Write out the variables. + call wrap_put_var_realx(fid, tvar, reft) + + if ((carma%f_igash2o /= 0) .and. present(refh2o)) then + call wrap_put_var_realx(fid, h2ovar, refh2o(:)) + end if + + if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then + call wrap_put_var_realx(fid, h2so4var, refh2so4(:)) + end if + + ! Close the file. + call wrap_close(fid) + + return + end subroutine CARMA_CreateRefTFile + + + !! Calculate the aerodynamic resistance for dry deposition. + !! + !! This is based upon Seinfeld and Pandis (1998) page 963, and + !! is similar to the calcram routine in drydep_mod.F90; + !! however, it enables independent determination of the aerodynamic + !! resistance each surface type (land, ocean and ice). + !! + !! @author Tianyi Fan + !! @version Aug 2011 + subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) + use shr_const_mod, only: shr_const_karman + use physconst, only: rair, gravit + + implicit none + + ! input and output argument + real(r8), intent(in) :: ustar ! friction velocity + real(r8), intent(in) :: z0 ! roughness length + real(r8), intent(in) :: pdel ! layer depth in pressure [Pa] + real(r8), intent(in) :: pmid ! layer mid-point pressure [Pa] + real(r8), intent(in) :: tmid ! layer mid-point temperature [K] + real(r8), intent(in) :: obklen ! Monin-Obukhov length + real(r8), intent(out) :: ram ! aerodynamic resistance + + ! local varibles + real(r8) :: z ! half the layer height + real(r8) :: psi ! stability parameter for z + real(r8) :: psi0 ! stability parameter for z0 + real(r8) :: nu ! temparory variable + real(r8) :: nu0 ! temparory variable + real(r8), parameter :: xkar = shr_const_karman + + + ! Use half the layer height like Ganzefeld and Lelieveld, 1995 + z = pdel * rair * tmid / pmid / gravit / 2._r8 + + if (obklen .eq. 0._r8) then + psi = 0._r8 + psi0 = 0._r8 + else + psi = min(max(z / obklen, -1._r8), 1._r8) + psi0 = min(max(z0 / obklen, -1._r8), 1._r8) + endif + + ! Stable + if (psi > 0._r8) then + ram = 1._r8 / xkar / ustar * (log(z / z0) + 4.7_r8 * (psi - psi0)) + + ! Unstable + else if (psi < 0._r8) then + nu = (1._r8 - 15._r8 *psi)**(.25_r8) + nu0 = (1._r8 - 15._r8 *psi0)**(.25_r8) + + if (ustar /= 0._r8) then + ram = 1._r8 / xkar / ustar * (log(z / z0) + & + log(((nu0**2 + 1._r8) * (nu0 + 1._r8)**2) / & + ((nu**2 + 1._r8) * (nu + 1._r8)**2)) + & + 2._r8 * (atan(nu) - atan(nu0))) + else + ram = 0._r8 + end if + + ! Neutral + else + ram = 1._r8 / xkar / ustar * log(z / z0) + end if + + return + end subroutine CARMA_calcram +end module carma_intr diff --git a/src/physics/carma/cam/carma_precision_mod.F90 b/src/physics/carma/cam/carma_precision_mod.F90 new file mode 100644 index 0000000000..db76f798c6 --- /dev/null +++ b/src/physics/carma/cam/carma_precision_mod.F90 @@ -0,0 +1,38 @@ +!! This module defines the prescision used for real variables within the CARMA code. +!! It uses defintion for a real that is used within CAM. +!! +!! NOTE: This file is adapted for use within CAM and is different than the file of the +!! same name that is part of the standard CARMA distribution. +module carma_precision_mod + + use shr_kind_mod, only: shr_kind_r8 + + implicit none + + integer, parameter :: f = shr_kind_r8 + real(kind=f), parameter :: powmax = 308._f + + ! Precision control strategy + ! JAS CU-Boulder June 8, 2006 + ! + ! I imagine using these statements bracketed with some CPP statements + ! to control the overall precision of a model. All variables would be + ! declared as real(f). All physical constants would have a + ! a suffix of _f, e.g. 2._f, to force them into the proper precision. + ! + ! I do wonder if it would be more accurate to declare variables as + ! real( kind=f ), but real(f) is how Chivers and Sleightholme + ! declare in their F90 text. + ! + ! Both real(f) and real( kind=f ) seem to work, but I'm more comfortable + ! with real( kind=f ), so I'm using that in all declarations. + + !-- + ! Numerical constants + !! Define 1 in the specified precision. + real(kind=f), parameter :: ONE = 1._f + + !! Define smallest possible number such that ONE + ALMOST_ZERO > ONE + real(kind=f), parameter :: ALMOST_ZERO = epsilon( ONE ) + real(kind=f), parameter :: ALMOST_ONE = ONE - ALMOST_ZERO +end module diff --git a/src/physics/carma/models/bc_strat/carma_model_mod.F90 b/src/physics/carma/models/bc_strat/carma_model_mod.F90 new file mode 100644 index 0000000000..42dc276a01 --- /dev/null +++ b/src/physics/carma/models/bc_strat/carma_model_mod.F90 @@ -0,0 +1,420 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of black carbon (soot) particles +!! in 1 size bin. Soot mass mixing ratio is passed to the atmosphere model for radiative +!! interactions. The particles are not subject to particle swelling, and do not coagulate. +!! +!! @version Jan-2011 +!! @author Mike Mills +!! +!!--------------------------------------------------------------------------------- + +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 1 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_SOOT = 1 !! soot composition + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_SOOT = 1 !! soot aerosol + + integer, public, parameter :: I_ELEM_SOOT = 1 !! soot aerosol + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_SOOT = 1.0_f ! density of soot particles (g/cm) + real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & + scavcoef=0.1_f, shortname="SOOT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="SOOT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes +! call CARMA_AddCoagulation(carma, I_GRP_SOOT, I_GRP_SOOT, I_GRP_SOOT, I_COLLEC_DATA, rc) +! if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + real(r8) :: sflx ! surface flux (kg/m2/s) + real(r8) :: mmr(pver) ! surface flux (kg/m2/s) + integer :: ielem + integer :: ibin + + ! Default return code. + rc = RC_OK + + ! Add the sedimentation and dry deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + do ielem = 1, NELEM + do ibin = 1, NBIN + + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + + cam_out%bcphidry(icol) = cam_out%bcphidry(icol) + max(sflx, 0._r8) + end do + end do + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + ! Put a horizontally uniform layer of the smallest bin size + ! in the model. +! if (ibin == 1) then +! q(:, 1) = 100e-9_r8 ! top +! q(:, plev/4) = 100e-9_r8 ! 1/4 +! q(:, plev/2) = 100e-9_r8 ! middle +! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 +! q(:, plev-1) = 100e-9_r8 ! bottom +! end if + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + ! Add the wet deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + do icol = 1, state%ncol + cam_out%bcphiwet(icol) = cam_out%bcphiwet(icol) + max(sflx(icol), 0._r8) + end do + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/cirrus/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 new file mode 100644 index 0000000000..88be7373bb --- /dev/null +++ b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 @@ -0,0 +1,142 @@ + !! Determine the stratifrom cloud fractions using the CAM routines. This will return the + !! ice and liquid cloud fractions as well as the minimum relative humidity for the onset + !! of liquid clouds. + !! + !! NOTE: This is just a stub for models that don't use cloud fraction. It should be replaced + !! be a new routine in a file of the same name in the model directory if the model needs + !! cloud fraction. This routine needs to be in its own file to avoid circular references when + !! using the CAM cloud fraction routines (see cirrus model). + !! + !! @version Aug-2010 + !! @author Chuck Bardeen + subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcrit, rc) + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carma_model_mod + use carma_flags_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & + set_dry_to_wet + use constituents, only: cnst_get_ind + use cam_abortutils, only: endrun + + use camsrfexch, only : cam_in_t + use ppgrid, only : pcols, pver, pverp + use cldfrc2m, only : astG_RHU_single, astG_PDF_single, aist_single, CAMstfrac + + type(carma_type) :: carma !! the carma object + type(carmastate_type) :: cstate !! the carma state object + type(cam_in_t) :: cam_in + type(physics_state) :: state !! physics state variables + integer :: icol !! column index + real(r8) :: cldfrc(pver) !! total cloud fraction [fraction] + real(r8) :: rhcrit(pver) !! realtive humidity for onset of liquid clouds [fraction] + integer :: rc !! return code, negative indicates failure + + real(r8) :: liqcldf(pver) ! liquid cloud fraction [fraction] + real(r8) :: icecldf(pver) ! ice cloud fraction [fraction] + real(r8) :: Ga ! dU/da + real(r8) :: ssl + real(r8) :: ssi + real(r8) :: qi(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: mmr(pver) ! ice mass mixing ratio (kg/kg) + integer :: ixcldice + integer :: ielem + integer :: igroup + integer :: ibin + integer :: iz + integer :: ienconc + logical :: is_ice + logical :: is_cloud + logical :: do_detrain + + rc = RC_OK + + call CARMA_Get(carma, rc, do_detrain=do_detrain) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMA_Get failed.') + + ! Get the cloud ice mmr. For the cloud fraction, we only want to include the + ! ice that is considered in-cloud. + qi = 0._f + + do ielem = 1, NELEM + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, is_ice=is_ice, is_cloud=is_cloud) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMAGROUP_Get failed.') + + ! Is this an ice cloud? + if ((ielem == ienconc) .and. (is_ice) .and. (is_cloud)) then + + do ibin = 1, NBIN + + ! Get the mass mixing ration for this bin. + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMASTATE_GetBin failed.') + + ! Add it to the existing ice. + qi = qi + mmr + + ! Add in the detrained ice for this bin. + if (do_detrain) then + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMASTATE_GetDetrain failed.') + + ! Add it to the existing ice. + qi = qi + mmr + end if + end do + end if + end do + + + ! Calculate the cloud fractions. + do iz = 1, pver + + ! Get a supersaturation that has not been scaled based upon the cloud + ! fraction. + call supersat_nocldf(carma, cstate, iz, I_GAS_H2O, ssi, ssl, rc) + + ! Get the liquid cloud fraction and the onset humidity for liquid clouds. + ! + ! NOTE: There is also a PDF based routine, but for now it isn't being used. If + ! it starts to be used, then a general routine astG_single should be written. + if (CAMstfrac) then + call astG_RHU_single(ssl + 1._f, state%pmid(icol, iz), state%q(icol, iz, 1), & + cam_in%landfrac(icol), cam_in%snowhland(icol), liqcldf(iz), Ga, rhcrit(iz)) + else + call astG_PDF_single(ssl + 1._f, state%pmid(icol, iz), state%q(icol, iz, 1), & + cam_in%landfrac(icol), cam_in%snowhland(icol), liqcldf(iz), Ga, rhcrit(iz)) + end if + + ! Now get the ice cloud fraction. + call aist_single(state%q(icol, iz, 1), state%t(icol, iz), state%pmid(icol, iz), & + qi(iz), cam_in%landfrac(icol), cam_in%snowhland(icol), icecldf(iz)) + end do + + ! Calculate an overall cloud fraction. This may vary depending upon the model, + ! but defaults to minimum overlap (Wilson and Ballard, 1999). This may not be + ! the same as the assumptions made by the CAM cloud scheme. + cldfrc(:) = min(1.0_f, icecldf(:) + liqcldf(:)) + + ! For the cirrus model, we just want to use the ice cloud fraction. +! cldfrc(:) = icecldf(:) + + ! Don't let the cloud fraction get too small. + cldfrc(:) = max(CLDFRC_MIN, cldfrc(:)) + + return + end subroutine CARMA_CloudFraction + + diff --git a/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 b/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..a01b22d8e1 --- /dev/null +++ b/src/physics/carma/models/cirrus/carma_model_flags_mod.F90 @@ -0,0 +1,79 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + character(len=256), public :: carma_mice_file = 'mice_warren2008.nc' ! name of the ice refractive index file + character(len=32), public :: carma_sulfate_method = "fixed" ! prescribed sulfate method + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_mice_file, carma_sulfate_method + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_mice_file, len(carma_mice_file), mpichar, 0, mpicom) + call mpibcast(carma_sulfate_method, len(carma_sulfate_method), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/cirrus/carma_model_mod.F90 b/src/physics/carma/models/cirrus/carma_model_mod.F90 new file mode 100644 index 0000000000..446a17cdd8 --- /dev/null +++ b/src/physics/carma/models/cirrus/carma_model_mod.F90 @@ -0,0 +1,2067 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has the following methods: +!! +!! - CARMA_DiagnoseBins() +!! - CARMA_DiagnoseBulk() +!! - CARMA_DefineModel() +!! - CARMA_Detrain() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. For diagnostic groups, there are +!! also routines that diagnose the mass in the bins of that group from the +!! parent model's state inforamtion and that calculate the tendency on the +!! parent model's state based upon changes in the bins. +!! +!! This cirrus cloud model allows CARMA bin microphysics to do the ice microphysics +!! while MG does the liquid microphysics. The MG microphysics here should not update +!! CLDICE or NUMICE, since those values will not be reflected in the CARMA ice +!! bins, which are the true state variables for ice. In this situation, CLDICE and +!! NUMICE are merely diagnostic variables available as input to the rest of CAM. +!! +!! The CARMA microphysics will run before MG and will handle: +!! - Detrainment (liquid and ice) +!! - Homogeneous ice nucleation (currently with prescribed sulfates) +!! - Heterogeneous ice nucleation (future) +!! - Bergeron process +!! - Melting of detrained ice +!! - Freezing of cloud drops +!! - Autoconversion (ice -> snow) +!! - Variable ice density (function of particle size) +!! - In-cloud values (dividing by cloud fraction) +!! +!! Some potential issues that are not currently handled by CARMA: +!! - collection of ice by snow +!! - aggregation of ice +!! - sub-grid vertical velocity for CARMA +!! - Goff & Gratch vs. Murphy & Koop vapor pressures +!! - Radiation using CARMA size distribution (each bin as tracer) +!! - Hallet-Mossop Process +!! +!! The following variables will have been set by CARMA: +!! - (S) CLDICE, (S) NUMICE +!! - (S) CLDLIQ, (S) NUMLIQ +!! - (S) T +!! - (P) TNDQSNOW, (P) TNDNSNOW +!! - (P) REICE +!! +!! Varaibles with an S will be in the physics_state and variables with a P are +!! parameters passed into the MG microphysics. +!! +!! The module carma_intr defines a few flags that indicate what portion of the +!! cloud microphysics is handled by CARMA: +!! +!! - carma_do_cldice - CARMA does ice clouds +!! - carma_do_cldliq - CARMA does liquid clouds +!! +!!--------------------------------------------------------------------------------- + + +!! Each realization of CARMA microphysics has its own version of this file. +!! +!! This model replaces the ice microphysics from the MG two-moment scheme with +!! a CARMA bin microphysics representation of the ice. The purpose of this +!! model is to provide a more detail description of the thin cirrus clouds that +!! form in the TTL and to investigate the impact of these clouds on radiative +!! forcing, troposphere-to-stratosphere transport, and control of water vapor +!! in the UT/LS. +!! +!! @version July-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_field, pbuf_get_index + use physconst, only: gravit + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 4 !! Number of particle groups + integer, public, parameter :: NELEM = 5 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 1 !! Number of particle solutes + integer, public, parameter :: NGAS = 1 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition + integer, public, parameter :: I_ICE = 2 !! ice + integer, public, parameter :: I_WATER = 3 !! water + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_CRCN = 1 !! sulfate aerosol + integer, public, parameter :: I_GRP_CRDICE = 2 !! detrained ice + integer, public, parameter :: I_GRP_CRSICE = 3 !! in-situ ice + integer, public, parameter :: I_GRP_CRLIQ = 4 !! liquid drop + + integer, public, parameter :: I_ELEM_CRCN = 1 !! sulfate + integer, public, parameter :: I_ELEM_CRDICE = 2 !! detrained ice + integer, public, parameter :: I_ELEM_CRSICE = 3 !! in-situ ice + integer, public, parameter :: I_ELEM_CRCORE = 4 !! sulfate core + integer, public, parameter :: I_ELEM_CRLIQ = 5 !! water vapor + + integer, public, parameter :: I_SOL_CRH2SO4 = 1 !! sulfuric acid + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + + + ! From Morrison & Gettelman [2008] and micro_mg.F90 (formerly cldwat2m_micro.F90) + ! + ! NOTE: In the bin model, the bin boundaries are also important for determining the threshold, + ! since the whole bin is autoconverted if the threshold is less than the bin midpoint radius. + real(kind=f), public, parameter :: CAM_RHOCI = 0.5_f !! (g/cm3) MG bulk density for cloud ice + real(kind=f), public, parameter :: CAM_RHOSN = 0.1_f !! (g/cm3) MG bulk density for snow + + + ! Parameters and variabls that control the detrainment process. + integer, parameter :: NINTS_BINS = 10 !! number of steps to integrate bin fractions + integer, parameter :: NINTS_SNOW = 100 !! number of steps to integrate snow fractions + + + real(kind=f), parameter :: r_dliq_lnd = 8e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_lnd = 18e-4_f !! detrained liquid radius (cm) + real(kind=f), parameter :: r_dliq_ocn = 8e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_ocn = 14e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_ocn = 18e-4_f !! detrained liquid radius (cm) + + real(kind=f), parameter :: snow_max_d = 10000._f !! maximum diameter for snow integration (um) + +! integer, parameter :: MIN_DTEMP = -60 !! Miniumum detrainment temperature (C) + integer, parameter :: MIN_DTEMP = -90 !! Miniumum detrainment temperature (C) + integer, parameter :: NDTEMP = -MIN_DTEMP + 1 !! Number of detrainment temperature bins + +! character(len=12), parameter :: carma_dice_method = "mono" + real(kind=f), parameter :: dice_snow_reff_mono = 348e-4_f !! Effective Radius of snow for monodisperse detrainment (cm) + real(kind=f), parameter :: r_dice_mono = 25e-4_f !! detrained ice radius, monodisperse (cm) + real(kind=f), parameter :: dice_loss = 0.0_f !! detrained fraction lost to precipitation, mondisperse +! real(kind=f), parameter :: dice_loss = 0.004_f !! detrained fraction lost to precipitation, mondisperse + + + ! This distribution varies the size disribution as a function of temperature, with the + ! distribution biased toards larer particles at warm temperature and small particles at + ! cold temperatures. This fit is from eq. 7 of Heymsfield and Schmitt [2010]. The Jensen + ! fit used above is similar to the cold end of this range. + character(len=12), parameter :: carma_dice_method = "dist_hym2010" + + ! From eq 7 in Heymsefield & Schmitt [2010] (cm -1) +! real(kind=f), parameter :: dist_hym2010_alpha = 14.26_f !! alpha (stratiform) +! real(kind=f), parameter :: dist_hym2010_beta = -0.0538_f !! beta (stratiform) + real(kind=f), parameter :: dist_hym2010_alpha = 2.425_f !! alpha (convective) + real(kind=f), parameter :: dist_hym2010_beta = -0.088_f !! beta (convective) + + real(kind=f) :: dice_snow_rmass(NDTEMP) !! snow particle mass (kg) + real(kind=f) :: dice_snow_fraction(NDTEMP) !! detrained mass fraction, snow + real(kind=f) :: dice_bin_fraction(NBIN, NDTEMP) !! detrained mass fraction, ice bin + + logical, public, parameter :: carma_do_mass_check = .false. ! If .true. then CARMA will check for mass loss by CARMA + logical, public, parameter :: carma_do_mass_check2 = .false. ! If .true. then CARMA will check for mass loss + ! (internal steps, e.g. detrain, diagnoseBIns, ...) + logical, public, parameter :: carma_do_mass_check3 = .false. ! If .true. then CARMA will check for incoming mass loss + ! (CAM -> CARMA) + logical, public, parameter :: carma_do_mass_fix = .true. ! If .true. then CARMA will fix for mass loss + ! between cldice and ice bins + logical, public, parameter :: carma_do_print_fix = .false. ! If .true. then CARMA will print the value of the mass fix + + logical, public, parameter :: carma_do_initice = .true. ! If .true. then CARMA carma prognositic bins are set from + ! the bulk ice on the first timestep + logical, public, parameter :: carma_do_bulk_tend = .true. ! If .true. then update CAM bulk tendencies + logical, public, parameter :: carma_do_autosnow = .false. ! If .true. then the largest ice bin is autoconverted to snow + ! at the end of the timestep. + + integer :: ixcldice + integer :: ixnumice + integer :: ixcldliq + integer :: ixnumliq + + integer :: warren_nwave ! number of wavelengths in file + real(r8), allocatable, dimension(:) :: warren_wave ! Warren & Brandt 2008, wavelengths + real(r8), allocatable, dimension(:) :: warren_real ! Warren & Brandt 2008, real part of m + real(r8), allocatable, dimension(:) :: warren_imag ! Warren & Brandt 2008, imag part of m + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use physconst, only: latice, latvap + use ioFileMod, only: getfil + use wrap_nf + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: rmin_ice = 5.e-5_f ! min radius for ice bins (cm) + real(kind=f), parameter :: rmin_cn = 1.e-7_f ! min radius for sulfate bins (cm) + real(kind=f), parameter :: RHO_CN = 1.78_f ! density of sulfate particles (g/cm) + real(kind=f) :: rmassmin ! mass of the first radius bin (g) + real(kind=f) :: vmrat ! volume ratio between adjacent bin + real(kind=f) :: rhoelem(NBIN) ! element density per bin (g/cm3) + real(kind=f) :: arat(NBIN) ! projected area ratio + integer :: maxbin ! the bin number of the largest prognostic ice bin + integer :: i + integer :: j + real(kind=f) :: wave(NWAVE) ! CAM band wavelength centers (cm) + integer :: fid + integer :: wave_did + integer :: wave_vid + integer :: real_vid + integer :: imag_vid + character(len=256) :: efile ! refractive index file name + real(kind=f) :: interp + complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) + write(LUNOPRT,*) ' carma_sulfate_method = ', trim(carma_sulfate_method) + end if + end if + + ! Get the refractive index for ice as a function of wavelength for particle heating + ! calculations. + ! + ! NOTE: These values probably should be a band average, but for now just do band centers. + + ! Read the values in from Warren et al. 2008. + if (carma_do_pheat) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_mice_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "wavelength", wave_did) + call wrap_inq_dimlen(fid, wave_did, warren_nwave) + endif + +#if ( defined SPMD ) + call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) +#endif + + allocate(warren_wave(warren_nwave)) + allocate(warren_real(warren_nwave)) + allocate(warren_imag(warren_nwave)) + + if (masterproc) then + + ! Read in the tables. + call wrap_inq_varid(fid, 'wavelength', wave_vid) + call wrap_get_var_realx(fid, wave_vid, warren_wave) + warren_wave = warren_wave * 1e-4 ! um -> cm + + call wrap_inq_varid(fid, 'm_real', real_vid) + call wrap_get_var_realx(fid, real_vid, warren_real) + + call wrap_inq_varid(fid, 'm_imag', imag_vid) + call wrap_get_var_realx(fid, imag_vid, warren_imag) + + ! Close the file. + call wrap_close(fid) + end if + +#if ( defined SPMD ) + call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) +#endif + + ! Interpolate the values. + do i = 1, NWAVE + do j = 1, warren_nwave + if (wave(i) <= warren_wave(j)) then + if ((j > 1) .and. (wave(i) /= warren_wave(j))) then + interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) + refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1))) + else + refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) + endif + + exit + end if + end do + end do + end if + + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + rmassmin = (4._f / 3._f) * PI * (rmin_cn ** 3) * RHO_CN +! vmrat = 4.0_f ! For 16 bins +! vmrat = 2.8_f ! For 21 bins + vmrat = 2.16_f ! For 28 bins +! vmrat = 2.0_f ! For 32 bins + + ! Since these sulfates are prescribed, don't sediment them. This will save some + ! processing time. + call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, vmrat, I_SPHERE, 1._f, .false., & + rc, shortname="CRCN", rmassmin=rmassmin, do_mie=.false., & + cnsttype=I_CNSTTYPE_DIAGNOSTIC, do_vtran=.false.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + ! NOTE: For freezing and melting, the ice and water bins need to have the same mass. + rmassmin = (4._f / 3._f) * PI * (rmin_ice ** 3) * RHO_I + vmrat = 2.055_f ! For 28 bins, Heysmfield Ice Density, cold + + ! If doing autoconversion of ice to snow, then the last bin will always be zero and + ! there is no point making it an advected constituent. + if (carma_do_autosnow) then + maxbin = NBIN-1 + else + maxbin = NBIN + end if + + ! Make the aged detrained ice have a variable density to represent the complex set of + ! possible shapes that we can't represent. This is based upon Heymsfield and + ! Westfield [2010] and Heysfield and Schmitt [2010]. + call CARMAGROUP_Create(carma, I_GRP_CRDICE, "Detrained Ice, Aged", rmin_ice, vmrat, I_SPHERE, 1._f, .true., & + rc, shortname="CRDICE", rmassmin=rmassmin, do_mie=carma_do_pheat, refidx=refidx_ice, & + ifallrtn=I_FALLRTN_HEYMSFIELD2010, imiertn=I_MIERTN_BOHREN1983, is_cloud=.true., maxbin=maxbin) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(2) = .true. + + ! Make the in-situ ice a plate, AR=6. This is based upon observations from Lawson + ! et al. [2008]. AR=6 is for larger particles, so AR=3 is a compromise that is + ! part way between that and more spheroidal particles that are likely at smaller sizes. + ! + ! NOTE: All cloud particles should be convectively transported in the first phase of + ! convection. + ! + ! NOTE: All ice particles have the last bin as the one that gets autoconverted to + ! snow at the end of the timestep and thus it does not need to be a prognostic bin. +! call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_SPHERE, 1._f, .true., & +! call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_HEXAGON, 1._f / 6._f, .true., & + call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_HEXAGON, 1._f / 3._f, .true., & + rc, shortname="CRSICE", rmassmin=rmassmin, do_mie=carma_do_pheat, refidx=refidx_ice, & + ifallrtn=I_FALLRTN_HEYMSFIELD2010, imiertn=I_MIERTN_BOHREN1983, & + is_cloud=(.not. carma_do_clearsky), maxbin=maxbin) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(3) = .true. + + ! Water drops are spherical. + call CARMAGROUP_Create(carma, I_GRP_CRLIQ, "Water Drop", rmin_ice, vmrat, I_SPHERE, 1._f, .false., & + rc, shortname="CRLIQ", rmassmin=rmassmin, do_mie=.false., & + cnsttype=I_CNSTTYPE_DIAGNOSTIC, is_cloud=.true., do_vtran=.false.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(4) = .true. + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_CRCN, I_GRP_CRCN, "Sulfate CN", RHO_CN, & + I_INVOLATILE, I_H2SO4, rc, shortname="CRCN", isolute=I_SOL_CRH2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + ! The density of ice is changed based on the maximum dimensions of ice particles + ! as a function of mass from Heymsfield and Schmitt [2010]. +! call rhoice_heymsfield2010(carma, RHO_I, I_GRP_CRDICE, "conv", rhoelem, arat, rc) + call rhoice_heymsfield2010(carma, RHO_I, I_GRP_CRDICE, "warm", rhoelem, arat, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::rhoice_heymsfield2010 failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRDICE, I_GRP_CRDICE, "Detrained Ice", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRDICE", rhobin=rhoelem, arat=arat) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRSICE, I_GRP_CRSICE, "In-situ Ice", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRSICE") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRSICE, "Core Mass", RHO_CN, & + I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=I_SOL_CRH2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRLIQ, I_GRP_CRLIQ, "Water Drop", RHO_W, & + I_VOLATILE, I_WATER, rc, shortname="CRLIQ") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + ! Define the Solutes + call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, & + 98._f, 1.38_f, rc, shortname="CRH2SO4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & + I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + + ! Detrained Ice, Aged + call CARMA_AddGrowth(carma, I_ELEM_CRDICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRDICE, I_ELEM_CRLIQ, I_ICEMELT, & + -latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_CRDICE, I_GRP_CRDICE, I_GRP_CRDICE, & + I_COLLEC_DATA, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + ! In-Situ Ice + call CARMA_AddGrowth(carma, I_ELEM_CRSICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + ! NOTE: For now, assume the latent heat for nucleation is the latent of of fusion of + ! water, using the CAM constant (scaled from J/kg to erg/g). + ! + ! NOTE: Since the sulfates are not seen as part of the water/energy budget in CAM, don't + ! include any latent heat from the freezing of the sulfate liquid. The latent heat of + ! the gas associated with nucleation is accounted for. + call CARMA_AddNucleation(carma, 1, 4, I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=1, ievp2elem=1) +! call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & +! I_AERFREEZE + I_AF_KOOP_2000 + I_AF_MURRAY_2010, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRSICE, I_ELEM_CRLIQ, I_ICEMELT, -latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_CRSICE, I_GRP_CRSICE, I_GRP_CRSICE, I_COLLEC_DATA, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + ! Water Drop + call CARMA_AddGrowth(carma, I_ELEM_CRLIQ, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRLIQ, I_ELEM_CRDICE, I_DROPFREEZE, latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + real(kind=f) :: t(pver) ! temperature (K) + real(kind=f) :: mmr_ice(NBIN, pver) ! ice mass mixing ratio (kg/kg) + real(kind=f) :: mmr_liq(NBIN, pver) ! liquid mass mixing ratio (kg/kg) + real(kind=f) :: r_ice(NBIN) ! ice radius bins (cm) + real(kind=f) :: r_liq(NBIN) ! liquid radius bins (cm) + + real(kind=f) :: ice_fraction ! fraction of detrained condensate that is ice + real(kind=f) :: mass_liq ! detrainment rate of liquid (kg/kg/s) + real(kind=f) :: mass_ice ! detrainment rate of ice (kg/kg/s) + real(kind=f) :: mass_snow ! detrainment rate of snow (kg/kg/s) + real(kind=f) :: mass_dlf ! detrained mass (m/s) + integer :: k ! vertical index + integer :: ibin ! bin index + integer :: itemp ! termperature index + + real(r8) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(r8) :: snowNumber(pver) ! snow number (#/kg) + real(r8) :: snowSurface ! snow on surface (kg/m2) + real(r8) :: waterMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: waterNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: rainSurface ! rain on surface (kg/m2) + real(r8) :: newSnow ! snow mass (kg) + real(r8) :: newRain ! rain mass mass (kg) + + logical :: do_thermo ! do thermodynamics? + + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_thermo=do_thermo) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMA_Get failed.') + + ! Put all of the detraining cloud water from convection into the large scale cloud. + ! put detraining cloud water into liq and ice based on temperature partition + call CARMAGROUP_Get(carma, I_GRP_CRDICE, rc, r=r_ice(:)) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_Get failed.') + + call CARMAGROUP_Get(carma, I_GRP_CRLIQ, rc, r=r_liq(:)) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_Get failed.') + + ! Account for the reserved ice that is being detrained in the precipitation. +! prec_str(icol) = prec_str(icol) - rliq(icol) +! rliq(icol) = 0._f + + call CARMASTATE_GetState(cstate, rc, t=t) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_GetState failed.') + + ! Determine the amount of detrainment that could be used to saturate the + ! atmosphere with respect to liquid. For GCM scales, assume that three things + ! happen to detrained condensate: + ! + ! 1) large particles will fallout as snow or rain + ! 2) will be converted to vapor + ! 3) will remain as ice + ! + ! Because of the large scales of the GCM and because this is a stratiform + ! parameterization, a lot of the condensate that hasn't fallen out will + ! increase the humidity (i.e. detrained anvil evaporates or falls out entirely + ! with 100 km of the convection). + mmr_ice(:, :) = 0._f + mmr_liq(:, :) = 0._f + + do k = 1,pver + + ! Remove amount being detrained from rliq and prec_str. + mass_dlf = dlf(icol, k) * (state%pdel(icol, k) / gravit) / 1000._f + prec_str(icol) = prec_str(icol) - mass_dlf + rliq(icol) = rliq(icol) - mass_dlf + + + if (t(k) > 268.15_f) then + ice_fraction = 0.0_f + else if (t(k) < 238.15_f) then + ice_fraction = 1.0_f + else + ice_fraction = (268.15_f - t(k)) / 30._f + end if + + itemp = max(-max(MIN_DTEMP, nint(t(k) - T0)), 0) + 1 + + mass_liq = dlf(icol, k) * (1._f - ice_fraction) + mass_ice = dlf(icol, k) * ice_fraction * (1._f - dice_snow_fraction(itemp)) + mass_snow = dlf(icol, k) * ice_fraction * dice_snow_fraction(itemp) + + ! Calculate the detrainment of ice and liquid into the appropriate CARMA + ! bins. + ! + ! Scale the size based on whether the surface is land or ocean. This + ! assumes that there are more aerosols over land, reducing the detrainment + ! size. This is similar to the c0_lnd and c0_ocn parameter split done in + ! the convective parameterization. + ! + ! NOTE: This should really be tied to aerosol amount, not land fraction. + do ibin = 1, NBIN + + ! Assume detrained cloud water is monodisperse. + if (r_liq(ibin) >= r_dliq_ocn) then + mmr_liq(ibin, k) = mmr_liq(ibin, k) + (mass_liq * dt) * (1._f - cam_in%landfrac(icol)) + exit + end if + end do + + do ibin = 1, NBIN + + ! Assume detrained cloud water is monodisperse. + if (r_liq(ibin) >= r_dliq_lnd) then + + mmr_liq(ibin, k) = mmr_liq(ibin, k) + (mass_liq * dt) * cam_in%landfrac(icol) + exit + end if + end do + + ! Detrain cloud ice into the bins according to the predefined distribution. + do ibin = 1, NBIN + + ! Detrain using a size distribution (log-normal in mass). The table has + ! already bin setup during initialization indicating the fraction of the mass + ! that goes into each bin. + ! + ! NOTE: Since snow has already been removed, but was part of the fractions + ! in the bins, scale the bin fractions so that it sums to 1. + mmr_ice(ibin, k) = mmr_ice(ibin, k) + dice_bin_fraction(ibin, itemp) * (mass_ice * dt) + end do + + ! The large portion of the distribution can go directly to snow, + ! since it is too big to be represented in the bin strucutre. + tnd_qsnow(icol, k) = mass_snow + tnd_nsnow(icol, k) = mass_snow / dice_snow_rmass(itemp) + + rliq(icol) = rliq(icol) + mass_snow * (state%pdel(icol, k) / gravit) / 1000._f + + ! Account for latent heat release during freezing. By default the detrained + ! condensate is assumed to be liquid for energy balance. + t(k) = t(k) + ((mass_ice + mass_snow) * latice * dt / cpair) + end do + + + do ibin = 1, NBIN + call CARMASTATE_SetDetrain(cstate, I_ELEM_CRLIQ, ibin, mmr_liq(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAState_SetBin failed.') + + + call CARMASTATE_SetDetrain(cstate, I_ELEM_CRDICE, ibin, mmr_ice(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAState_SetBin failed.') + end do + + + if (do_thermo) then + call CARMASTATE_SetState(cstate, rc, t(:)) + end if + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check2) then + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + + call CARMA_CheckMassAndEnergy(carma, cstate, .false., "CARMA_Detrain", state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + end if + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + use micro_mg_utils, only: size_dist_param_basic, size_dist_param_liq, & + mg_ice_props, mg_liq_props + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mu(pver) ! spectral width parameter of droplet size distr + real(r8) :: lambda(pver) ! slope of cloud liquid size distr + real(r8) :: mmr(NBIN,pver) ! elements mass mixing ratio + + real(kind=f) :: r(NBIN) ! bin mean radius + real(kind=f) :: dr(NBIN) ! bin radius width + real(kind=f) :: rmass(NBIN) ! bin mass + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: k ! vertical index + + ! This buffer exists purely to work around the fact that "state" is + ! intent(in), but the size_dist_param function will try to change the + ! input number concentrations. + real(r8) :: limNumber(pver) + + real(r8) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(r8) :: snowNumber(pver) ! snow number (#/kg) + real(r8) :: snowSurface ! snow on surface (kg/m2) + real(r8) :: carma_ice ! total cldice from CARMA bins (kg/kg) + real(r8) :: waterMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: waterNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: rainSurface ! rain on surface (kg/m2) + real(r8) :: carma_water ! total cldliq from CARMA bins (kg/kg) + real(r8) :: diff + + ! Aerosol size distribution + real(r8), parameter :: n = 100._r8 ! concentration (cm-3) + real(r8), parameter :: r0 = 2.5e-6_r8 ! mean radius (cm) + real(r8), parameter :: rsig = 1.5_r8 ! distribution width + + real(r8) :: arg1(NBIN) + real(r8) :: arg2(NBIN) + real(r8) :: rhop(NBIN) ! particle mass density (kg/m3) + real(r8) :: totalrhop ! total particle mass density (kg/m3) + real(kind=f) :: rhoa_wet(pver) ! air density (g/cm3) + + real(r8) :: rliq_new(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + + integer :: LUNOPRT + logical :: do_print + real(r8) :: lat + real(r8) :: lon + + real(r8), pointer, dimension(:, :) :: sulf ! last saturation wrt ice + integer :: itim_old + + character(len=8) :: c_name ! constituent name + + + 1 format(/,'CARMA_DiagnoseBins::ERROR - CAM ice mass conservation error, icol=',i4,', iz=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e16.10,',carma=',e16.10,',rer=',e9.3) + 2 format(/,'CARMA_DiagnoseBins::ERROR - CAM liquid mass conservation error, icol=',i4,', iz=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e16.10,',carma=',e16.10,',rer=',e9.3) + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + + ! Get the air density. + call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') + + + ! Aerosols + ! + igroup = 1 + ielem = 1 + + ! Use a fixed aerosols distribution. + if ((carma_sulfate_method == "fixed") .or. (carma_sulfate_method == "bulk")) then + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) + arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) + + ! kg/m3 + rhop(:) = arg1(:) * exp(arg2(:)) * rmass(:) * 1e6_f / 1e3_f + + + if (carma_sulfate_method == "bulk") then + totalrhop = sum(rhop(:)) + + ! Get the index for the prescribed sulfates. This gives the mmr that should be + ! present at this location. Use this to scale the size distribution that CARMA + ! will generate. + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, pbuf_get_index('sulf'), sulf, (/1,1,itim_old/),(/pcols,pver,1/)) + end if + end if + + do ibin = 1, NBIN + + ! Use a fixed mixing ration. + if (carma_sulfate_method == "fixed") then + mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) + end if + + + ! Since bulk aerosols don't have a size distribution, use the fixed + ! distribution for the shape of the distribution, but scale the total + ! mass to the prescribed value. + if (carma_sulfate_method == "bulk") then + mmr(ibin, :) = rhop(ibin) / totalrhop * sulf(icol, :) + end if + + ! Use the CRCNxx fields from a special prescribed aerosol file that has + ! results from a CARMA simulation of sulfates. This will set the magnitude + ! and the size distribution. + if (carma_sulfate_method == "carma") then + ! Get the index for the prescribed sulfates. + itim_old = pbuf_old_tim_idx() + write(c_name, '(A, I2.2)') "CRCN", ibin + + call pbuf_get_field(pbuf, pbuf_get_index(c_name), sulf, (/1,1,itim_old/),(/pcols,pver,1/)) + mmr(ibin, :) = sulf(icol, :) + end if + + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + end do + + + ! Cloud Ice & Snow + ! + ! Cloud ice is maintained in advected species in CARMA, and we are only + ! concerned with snow production by CARMA. + ! + ! NOTE: To allow this code to be tested when not doing the cloud ice, but + ! either doing nothing or doing detrainment, use the ice properties to convert + ! from the 2 moment values to a size distribution. + ! + ! NOTE: To keep mass and energy conservation happy, on the first step when + ! camra_do_cldice is true, we take the bulk values and convert them + ! into bins; however, this might cause issues with the CARMA growth code. + if ((.not. carma_do_cldice) .or. (is_first_step() .and. carma_do_initice)) then + igroup = I_GRP_CRDICE + ielem = I_ELEM_CRDICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + ! Have to copy this, because size_dist_param_basic has an intent(inout) + ! argument, but state is intent(in). + limNumber = state%q(icol, :, ixnumice) + + ! Subroutine from MG utilities. + call size_dist_param_basic(mg_ice_props, state%q(icol, :, ixcldice), & + limNumber, lambda(:)) + ! For ice, assume mu is 0. + mu = 0._r8 + + call CARMA_GetMmrFromGamma(carma, r(:), dr(:), rmass(:), & + state%q(icol, :, ixcldice), limNumber, mu(:), & + lambda(:), mmr(:, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetMmrFromGamma failed.') + + do ibin = 1, NBIN + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBulk::CARMASTATE_SetBin failed.') + end do + else + + ! If CARMA is keeping track of ice, then total up the detrained and in-situ ice to + ! make sure that no one else has meesed with the ice fields. If changes were made, + ! then adjustments need to be made to the totals to prevent mass and energy conservation + ! errors within CAM. The difference could be accounted for in snow_str and prec_str. + ! + ! NOTE: Advection, diffusion, ... may have affected the tracer values since the + ! previous time step, however, the tracer correlations need to remain intact for + ! CARMA to work properly. Also, no special processing can occur on the cldice fields + ! outside of CARMA, since they are merely diagnostic fields of the CARMA state. + if (carma_do_mass_check3 .or. carma_do_mass_fix) then + + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalIceAndSnow failed.') + + do k = 1, pver + + ! NOTE: CAM resets cloud ice less than 1e-36 to 0 in physics_update, so ignore values smaller + ! than that. + carma_ice = iceMass(k) + snowMass(k) + if (carma_ice < 1e-36_r8) then + carma_ice = 0._r8 + end if + + if (carma_ice /= state%q(icol, k, ixcldice)) then + + if (carma_do_mass_check3) then + if (abs(carma_ice - state%q(icol, k, ixcldice)) / max(abs(carma_ice), & + abs(state%q(icol, k, ixcldice))) >= 1e-10_r8) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,1) icol, k, lat, lon, state%q(icol, k, ixcldice), & + carma_ice, (carma_ice - state%q(icol, k, ixcldice)) / max(abs(carma_ice), & + abs(state%q(icol, k, ixcldice))) + + write(LUNOPRT,*) " CAM cldice : ", state%q(icol, k, ixcldice) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " CARMA cldice : ", iceMass(k) + snowMass(k) + write(LUNOPRT,*) " CARMA ice : ", iceMass(k) + write(LUNOPRT,*) " CARMA snow : ", snowMass(k) + end if + end if + end if + + if (carma_do_mass_fix) then + + diff = (state%q(icol, k, ixcldice) - (iceMass(k) + snowMass(k))) * (state%pdel(icol, k) / gravit) / dt / 1000._r8 + + snow_str(icol) = snow_str(icol) + diff + prec_str(icol) = prec_str(icol) + diff + + if (carma_do_print_fix) then + if (do_print) then + write(LUNOPRT,*) " CARMA_DiagnoseBins::& + &WARNING - Adjusting prec_str for ice mass difference", & + icol, k, (state%q(icol, k, ixcldice) - (iceMass(k) + snowMass(k))) + end if + end if + end if + end if + end do + end if + end if + + + ! Water Drops + ! + ! Use the CAM mass and number (CLDLIQ and NUMLIQ) to determine an initial + ! size distribution. + igroup = I_GRP_CRLIQ + ielem = I_ELEM_CRLIQ + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + ! Prevent size_dist_param from trying to change state by passing it a + ! copy of the number concentration. + limNumber = state%q(icol, :, ixnumliq) + + ! Subroutine from MG utilities. + call size_dist_param_liq(mg_liq_props, state%q(icol, :, ixcldliq), & + limNumber, rhoa_wet(:), mu(:), lambda(:)) + + call CARMA_GetMmrFromGamma(carma, r(:), dr(:), rmass(:), state%q(icol, :, ixcldliq), & + limNumber, mu(:), lambda(:), mmr(:, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetMmrFromGamma failed.') + + do ibin = 1, NBIN + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_SetBin failed.') + end do + + + if (carma_do_mass_check2 .or. carma_do_mass_check3) then + + ! Check to see of the mass that we get back adds up. + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalWaterAndRain failed.') + + + if (carma_do_mass_check3) then + do k = 1, pver + + carma_water = waterMass(k) + if (carma_water < 1e-38_r8) then + carma_water = 0._r8 + end if + + ! The routine that provides the modal properties for water has a miniumum of 1e-18. + ! This causes problems in comparisons, since smaller qc values are seen in the data, + ! but CARMA's bins won't have values that small. + if (carma_water /= state%q(icol, k, ixcldliq)) then + if (abs(carma_water - state%q(icol, k, ixcldliq)) / max(abs(carma_water), & + abs(state%q(icol, k, ixcldliq))) >= 1e-10_r8) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,2) icol, k, lat, lon, state%q(icol, k, ixcldliq), & + carma_water, (carma_water - state%q(icol, k, ixcldliq)) / max(abs(carma_water), & + abs(state%q(icol, k, ixcldliq))) + + write(LUNOPRT,*) " CAM cldliq : ", state%q(icol, k, ixcldliq) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " CARMA cldliq : ", waterMass(k) + end if + end if + end if + end do + end if + + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check2) then + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalIceAndSnow failed.') + + ! The detrained ice is not include yet, so ignore rliq. + rliq_new(:) = 0._f + call CARMA_CheckMassAndEnergy(carma, cstate, .false., "CARMA_DiagnoseBins", state, & + icol, dt, rliq_new, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_CheckMassAndEnergy failed.') + end if + end if + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! These values are chosen to match up with how small cloud ice values are handled in + ! micro_mg. + real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: omsm = 0.99999_r8 ! Prevents roundoff errors + + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: icore ! core index + integer :: icorelem(NELEM) ! core indexes for group + integer :: ncore ! number of core elements + + real(kind=f) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(kind=f) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(kind=f) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(kind=f) :: snowNumber(pver) ! snow number (#/kg) + real(kind=f) :: snowSurface ! snow on surface (kg/m2) + real(kind=f) :: waterMass(pver) ! water mass mixing ratio (kg/kg) + real(kind=f) :: waterNumber(pver) ! water number mixing ratio (#/kg) + real(kind=f) :: rainSurface ! rain on surface (kg/m2) + real(kind=f) :: iceRe(pver) ! ice effective radius (m) + + real(r8) :: newRain ! [Total] sfc flux of rain from stratiform (m/s) + real(r8) :: newSnow ! [Total] sfc flux of snow from stratiform (m/s) + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: mmrcore(pver) ! core mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: r(NBIN) ! radius (cm) + real(kind=f) :: sfc ! surface mass (kg/m2) + real(kind=f) :: sfccore ! core surface mass (kg/m2) + + + ! Default return code. + rc = RC_OK + + + ! Aerosols + ! + ! Currently, we are just using a fixed aerosol size distribution, but in the + ! future this could be linked to the model aerosols. + + + ! Cloud Ice & Snow + ! + ! Determine the changes to cloud ice (mass and number) and snow (mass and number) + ! by looking at the totals if the detrained and in-situ ice. + ! + ! Ice particles in the largest bin are treated as snow rather than ice. + + ! Get the total ice. + call CARMA_GetTotalIceAndSnow(carma, cstate, .true., iceMass, iceNumber, & + snowMass, snowNumber, snowSurface, rc, iceRe=iceRe) + + ! Calculate the tendencies on CLDICE, NUMICE, QSNOW and NSNOW + if (carma_do_bulk_tend) then + + ptend%q(icol, :, ixcldice) = (iceMass(:) - state%q(icol, :, ixcldice)) / dt + ptend%q(icol, :, ixnumice) = ((iceNumber(:) - state%q(icol, :, ixnumice)) / dt) + + where(iceMass(:) < qsmall) + ptend%q(icol, :, ixcldice) = (-state%q(icol, :, ixcldice)) / dt + ptend%q(icol, :, ixnumice) = (-state%q(icol, :, ixnumice)) / dt + end where + + ! Snow is not a constituent, so write this information into the physics buffer. + tnd_qsnow(icol, :) = tnd_qsnow(icol, :) + snowMass(:) / dt + tnd_nsnow(icol, :) = tnd_nsnow(icol, :) + snowNumber(:) / dt + + ! Now we need to change the reserve liquid. This was indicating the amount of + ! water than was not in the atmosphere because it was in convection (dlf). Now + ! we have included that water, but we have removed water representing snow in + ! the atmosphere. This needs to be communicated to the CAM microphysics which + ! will take care of actually precipitating or evaporating the snow. + rliq(icol) = rliq(icol) + sum(snowMass(:) * (state%pdel(icol, :) / gravit)) / dt / 1000._r8 + + ! The ice effective radius is used by the radiation code; however, it uses a mass + ! weighted effective diameter in um. + re_ice(icol, :) = iceRe + end if + + + ! Water Drops + ! + ! Calcualte the total mass and total number of the water drops, and then + ! determine the appropriate tendencies. + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + + ! Calculate the tendencies on CLDLIQ and NUMLIQ + if (carma_do_bulk_tend) then + + ! In CAM in cldwat2m, a couple of things are done: + ! + ! 1) If cldliq < qsmall, then the number desnity is set to 0. + ! 2) to keep from overshooting into negative values, they don't try to drive + ! the value all the way to 0. + ptend%q(icol, :, ixcldliq) = (waterMass(:) - state%q(icol, :, ixcldliq)) / dt + + ptend%q(icol, :, ixnumliq) = (waterNumber(:) - state%q(icol, :, ixnumliq)) / dt + + where(waterMass(:) < qsmall) + ptend%q(icol, :, ixnumliq) = (-state%q(icol, :, ixnumliq)) / dt + end where + end if + + + ! For mass balance, we also need to supply the total precipation and snow. Not + ! all of the snow may make the ground, but that will be determined later in the + ! MG microphysics. For now, we need to account for all condensate that is not + ! in CLDICE or CLDLIQ. + ! + ! Need the 1000. to convert from kg/m2/s to m/s + newSnow = snowSurface + newRain = rainSurface + + snow_sed(icol) = snow_sed(icol) + newSnow / dt / 1000._r8 + prec_sed(icol) = prec_sed(icol) + (newRain + newSnow) / dt / 1000._r8 + + snow_str(icol) = snow_str(icol) + newSnow / dt / 1000._r8 + prec_str(icol) = prec_str(icol) + (newRain + newSnow) / dt / 1000._r8 + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check) then + + ! The CAM state has not been updated yet, so compare the original CAM state + ! with the new CARMA state. + call CARMA_CheckMassAndEnergy(carma, cstate, .true., "CARMA_DiagnoseBulk", state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + end if + + return + end subroutine CARMA_DiagnoseBulk + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: cnst_get_ind, pcnst + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ibin ! bin index + integer :: i + integer :: itemp ! temperature index + integer :: LUNOPRT + + logical :: do_print_init + logical :: do_grow + logical :: do_detrain + logical :: do_thermo + + real(kind=f) :: r(NBIN) ! bin center radius (cm) + real(kind=f) :: dr(NBIN) ! bin width (cm) + real(kind=f) :: rmass(NBIN) ! bin mass (g) + real(kind=f) :: sub_d ! integration substep diameter (um) + real(kind=f) :: sub_dd ! integration substep width (um) + real(kind=f) :: snow_d ! starting snow diameter (um) + real(kind=f) :: nsnow ! number of snow particles (um) + real(kind=f) :: snow_r3 ! snow N*r^3 (um^3) + real(kind=f) :: snow_r2 ! snow N*r^3 (um^2) + real(kind=f) :: snow_reff(NDTEMP) ! snow effective radius (cm) + real(kind=f) :: eshape ! particle aspect ratio (> 0 is prolate) + real(kind=f) :: shapeFactor ! shape factor for maximum radius + real(kind=f) :: remainder + real(kind=f) :: lambda ! fit factor for H&S 2010 size distribution + real(kind=f) :: temp ! temperature (C) + + ! Default return code. + rc = 0 + + call CARMA_Get(carma, rc, do_print_init=do_print_init, LUNOPRT=LUNOPRT, & + do_grow=do_grow, do_detrain=do_detrain, do_thermo=do_thermo) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + ! Lookup indices to other constituents that are needed. + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMICE', ixnumice) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('NUMLIQ', ixnumliq) + + ! Add the CAM ice and liquid fields as some that could be modified by CARMA. + lq_carma(ixcldice) = .true. + lq_carma(ixnumice) = .true. + lq_carma(ixcldliq) = .true. + lq_carma(ixnumliq) = .true. + + if (do_print_init) then + write(LUNOPRT,*) "" + write(LUNOPRT,*) "Initializing CARMA Detrainment" + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Using ice method = ", carma_dice_method + end if + + ! For detrainment of ice, setup the fractions of ice that go into each bin and + ! into snow. This can be done different ways: + ! + ! - monodisperse + ! - temperature dependent size distribution + ! + ! In any of these, a fraction of the ice can go directly to snow, rather than + ! going into bins first. + ! + ! Puts all of the detraining cloud water from convection into the large scale cloud, + ! and puts detraining cloud water into liquid and ice based on temperature partition + call CARMAGROUP_Get(carma, I_GRP_CRDICE, rc, r=r(:), dr=dr(:), eshape=eshape, rmass=rmass(:)) + if (rc < RC_OK) call endrun('CARMA_InitializeModel::CARMAGROUP_Get failed.') + + ! This size distribution in based upon the maximum diameter, so the ice particles have + ! a shape then pass the largest dimension to the size distribution. + ! + ! NOTE: This is assuming the shape is a spheroid. Should consider passing shape + ! parameters out of setupvfall, so that f1 is available for this. + if (eshape >= 1._f) then + shapeFactor = eshape**(1._f / 3._f) + else + shapeFactor = eshape**(- 1._f / 3._f) + end if + + dice_bin_fraction(:, :) = 0._f + dice_snow_fraction(:) = 0._f + dice_snow_rmass(:) = 0._f + + + ! Heymsfield & Schmitt [2010] tmeperature dependent distribution + if (carma_dice_method == "dist_hym2010") then + + ! Integrate over the defined temperaure range. + do itemp = 1, NDTEMP + + temp = 1._f - itemp + + ! Determine the exponentianal factor of the number distribution from H&S eq. 7. + lambda = dist_hym2010_alpha * exp(temp * dist_hym2010_beta) + + ! Determine a mass distribution using from a size distribution using this + ! lambda. The number distribution is N = N0 * exp(-lambda * D), with D in + ! cm from H&S eq. 1. Since this is just to generate a PDF, just use an N0 + ! of 1. + ! + ! NOTE: This mass distribution (dMdD) is based on the diameter in cm. + do ibin = 1, NBIN + + ! Determine the fraction in each bin. + ! + ! NOTE: The bins are wide realtive to this function, so sum over an interval + sub_dd = 2._f * dr(ibin) * shapeFactor + sub_d = 2._f * r(ibin) * shapeFactor + + dice_bin_fraction(ibin, itemp) = dice_bin_fraction(ibin, itemp) + & + rmass(ibin) / lambda * & + (exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f)))) + end do + + ! Integrate to determine how much mass exits outside of the bins. + ! Now integrate the snow distribution. We know the snow amount, but need an effective radius + ! to determine the snow number. + sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor + sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_d = sub_d + sub_dd / 2._f + + remainder = 0._f + + do i = 1, NINTS_SNOW + + ! Determine the number. + ! + ! NOTE: Use the unscaled diameter and assume a sphere to get the volume of the particle. + nsnow = exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f))) * sub_dd + + ! Assume density from Heymsfield & Schmitt [2010]. This assumes that: + ! + ! m = aD^2.1 + ! + ! NOTE: This needs to match the density assumption made in the detrained ice bins. + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + + sub_d = sub_d + sub_dd + end do + + ! The sum of the integral may not be exactly 1, so scale the total so as not to skew + ! the amount going straight to snow. + dice_bin_fraction(:, itemp) = dice_bin_fraction(:, itemp) / (sum(dice_bin_fraction(:, itemp)) + remainder) + + + ! Now integrate the snow distribution. We know the snow amount, but need an effective radius + ! to determine the snow number. + snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) + sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_d = snow_d + (sub_dd / 2._f) + + snow_r3 = 0._f + snow_r2 = 0._f + + do i = 1, NINTS_SNOW + + ! Determine the number. + ! + ! NOTE: Use the unscaled diameter and assume a sphere to get the volume of the particle. + nsnow = exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f))) * sub_dd + + snow_r3 = snow_r3 + nsnow / lambda * (sub_d / 2._f)**3 + snow_r2 = snow_r2 + nsnow / lambda * (sub_d / 2._f)**2 + + sub_d = sub_d + sub_dd + end do + + if (snow_r2 <= 0._f) then + snow_reff(itemp) = 0.1_f + else + snow_reff(itemp) = snow_r3 / snow_r2 + end if + + ! If autoconversion is on then, detrain directly to snow. Otherwise, add the extra + ! mass to the largest bin. + if (carma_do_autosnow) then + dice_snow_fraction(itemp) = 1._f - sum(dice_bin_fraction(:, itemp)) + else + dice_snow_fraction(itemp) = 0._f + dice_bin_fraction(NBIN, itemp) = dice_bin_fraction(NBIN, itemp) + 1._f - sum(dice_bin_fraction(:, itemp)) + end if + + ! The sum of the integral may not be exactly 1, so scale the total so as not to skew + ! the amount going straight to snow. + dice_bin_fraction(:, itemp) = dice_bin_fraction(:, itemp) / sum(dice_bin_fraction(:, itemp)) + end do + + ! Default to monodisperse + else + + do ibin = 1, NBIN + if (r(ibin) >= r_dice_mono) then + dice_bin_fraction(ibin, :) = 1._f - dice_loss + + exit + end if + end do + + dice_snow_fraction(:) = 1._f - sum(dice_bin_fraction(:, 1)) + snow_reff(:) = dice_snow_reff_mono + end if + + + ! Determine the amount that goes into snow. + dice_snow_rmass(:) = 4._f / 3._f * PI * (snow_reff(:)**3) * CAM_RHOSN / 1e3_f + + if (do_print_init) then + do itemp = 1, NDTEMP, 10 + + if ((itemp == 1) .or. (carma_dice_method == "dist_hym2010")) then + + if (carma_dice_method == "dist_hym2010") then + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Temperature = ", 1 - itemp, " C" + write(LUNOPRT,*) "" + end if + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " ibin r (um) fraction" + + do ibin = 1, NBIN + write(LUNOPRT,*) ibin, r(ibin)*1e4_f, dice_bin_fraction(ibin, itemp) + end do + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Total fractions" + write(LUNOPRT,*) " ice = ", 1._f - dice_snow_fraction(itemp) + write(LUNOPRT,*) " snow = ", dice_snow_fraction(itemp) + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Snow" + write(LUNOPRT,*) " min_r (um) = ", snow_d / 2._f + write(LUNOPRT,*) " rmass (kg) = ", dice_snow_rmass(itemp) + write(LUNOPRT,*) " reff (um) = ", snow_reff(itemp)*1e4_f + write(LUNOPRT,*) "" + end if + end do + end if + + ! Log a warning message if doing growth or detrainment and not doing + ! thermodynamics. This will cause an energy error to be reported by CAM. + if ((do_grow .or. do_detrain) .and. .not. do_thermo) then + if (do_print_init) then + write(LUNOPRT,*) "CARMA_InitializeModel:& + &WARNING - do_grow and/or do_detrain are selected without & + &do_thermo which may result in energy conservation errors." + end if + end if + + return + end subroutine CARMA_InitializeModel + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + + ! Default return code. + rc = RC_OK + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + + + ! Using the specified parameters for the gamma distribution, determine the mass mixing ratio of particles + subroutine CARMA_GetMmrFromGamma(carma, r, dr, rmass, qic, nic, mu, lambda, mmr, rc) + use shr_spfn_mod, only : gamma => shr_spfn_gamma + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + real(kind=f), intent(in) :: r(NBIN) !! bin mean radius + real(kind=f), intent(in) :: dr(NBIN) !! bin radius width + real(kind=f), intent(in) :: rmass(NBIN) !! bin mass + real(r8), intent(in) :: qic(pver) !! in-cloud cloud liquid mixing ratio + real(r8), intent(in) :: nic(pver) !! in-cloud droplet number conc + real(r8), intent(in) :: mu(pver) !! spectral width parameter of droplet size distr + real(r8), intent(in) :: lambda(pver) !! slope of cloud liquid size distr + real(r8), intent(out) :: mmr(NBIN,pver) !! elements mass mixing ratio + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: k ! z index + integer :: ibin ! bin index + real(kind=f) :: totalMass ! mmr of all particles (kg/kg) + real(kind=f) :: n ! number of particles (#/kg) + real(kind=f) :: n0 ! number parameter for gamma distribution + real(kind=f) :: d(NBIN) ! bin diameter (m) + real(kind=f) :: dd(NBIN) ! diameter width of bin (m) + +! real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: qsmall = 1.e-36_r8 ! min mixing ratio + + + ! Default return code. + rc = RC_OK + + ! Their equations are in terms of diameter (in m) + d(:) = 2._r8 * r(:) * 1e-2_r8 + dd(:) = 2._r8 * dr(:) * 1e-2_r8 + + do k = 1, pver + + ! From Morisson & Gettelman [2008] and cldwat2m + ! + ! If there is a small mass, then ther are no particles. + if (qic(k) < qsmall) then + mmr(:, k) = 0._r8 + else + n0 = (nic(k) * (lambda(k) ** (mu(k) + 1._r8)) / (gamma(mu(k) + 1._r8))) + + + ! Iterate over the bins. + ! + ! NOTE: Just the functional fit can go negative for some bins with larger diameter, but this is not physical. + do ibin = 1, NBIN + n = n0 * (d(ibin)**mu(k)) * exp(-lambda(k) * d(ibin)) * dd(ibin) + mmr(ibin, k) = n * rmass(ibin) * 1e-3_r8 + end do + + ! Adjust the number density so that we don't create mass. This will adjust for + ! problems fitting the size distribution and for differences in the assumptions + ! of the bulk density of the particles. + totalMass = sum(mmr(:, k)) + if (totalMass /= 0._r8) then + mmr(:, k) = mmr(:, k) * (qic(k) / totalMass) + else + mmr(:, k) = 0._r8 + end if + end if + end do + + return + end subroutine CARMA_GetMmrFromGamma + + + !! Detemrine the total cloud ice concentration and number stored in the bins that represent + !! water within the CARMA model. + !! + !! For snow, it is assumed that the largest ice bin in the in situ and detrained ice are + !! snow. The mass of these bins is the same, but the dimensions are different since there + !! are different shape assumptions for the different types. + !! + !! @version Nov-2009 + !! @author Chuck Bardeen + subroutine CARMA_GetTotalIceAndSnow(carma, cstate, makeSnow, iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc, iceRe) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + logical, intent(in) :: makeSnow !! should bins be changed because of snow? + real(kind=f), intent(out) :: iceMass(pver) !! ice mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: iceNumber(pver) !! ice number mixing ratio (#/kg) + real(kind=f), intent(out) :: snowMass(pver) !! snow mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: snowNumber(pver) !! snow number (#/kg) + real(kind=f), intent(out) :: snowSurface !! snow on surface (kg/m2) + integer, intent(out) :: rc !! return code, negative indicates failure + real(kind=f), intent(out), optional :: iceRe(pver) !! ice effective radius (m) + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: iz ! vertical index + integer :: icore ! core index + integer :: icorelem(NELEM) ! core indexes for group + integer :: ncore ! number of core elements + integer :: maxbin ! maximum prognostic bin + + real(kind=f) :: coreMass(pver) ! core mass mixing ratio (kg/kg) + real(kind=f) :: coreSurface ! core on surface (kg/kg) + + real(kind=f) :: newSnow ! [Total] sfc flux of snow from stratiform (m/s) + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: mmrcore(pver) ! core mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: r(NBIN) ! radius (cm) + real(kind=f) :: rmass(NBIN) ! mass (g) + real(kind=f) :: rrat(NBIN) ! particle maximum radius ratio () + real(kind=f) :: arat(NBIN) ! particle area ration () + real(kind=f) :: sfc ! surface mass (kg/m2) + real(kind=f) :: sfccore ! core surface mass (kg/m2) + real(kind=f) :: nd(pver) ! number density (#/cm3) + real(kind=f) :: pa(pver) ! projected area (cm2) + real(kind=f) :: md(pver) ! mass density (g/cm3) + + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + iceMass(:) = 0._f + iceNumber(:) = 0._f + snowMass(:) = 0._f + snowNumber(:) = 0._f + snowSurface = 0._f + pa(:) = 0._f + md(:) = 0._f + + if (present(iceRe)) iceRe(:) = 0._f + + + ! Detrained Ice, Aged + igroup = I_GRP_CRDICE + ielem = I_ELEM_CRDICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, rmass=rmass, arat=arat, rrat=rrat, maxbin=maxbin) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc, numberDensity=nd) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + else + iceMass(:) = iceMass(:) + mmr(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + + ! NOTE: This is following the definition of Dave Mitchell for effective diameter, + ! Mitchell [2002], which indicates it needs to be scaled based on the effective + ! ice density. + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of snow. + snowSurface = snowSurface + sfc + end do + + + ! Detrained Ice, Fresh + + do ibin = 1, NBIN + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc, nmr=nmr, numberDensity=nd) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetDetrain(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + else + iceMass(:) = iceMass(:) + mmr(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + end do + + + ! In-situ ice. + igroup = I_GRP_CRSICE + ielem = I_ELEM_CRSICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, ncore=ncore, icorelem=icorelem, arat=arat, rrat=rrat, maxbin=maxbin) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc, numberDensity=nd) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBulk::CARMASTATE_GetBin failed.') + + ! Determine how much of the mmr is related to core mass. This needs to + ! be subtracted to get the amount of water in the ice. + coreMass(:) = 0.0_f + coreSurface = 0.0_f + + do icore = 1, ncore + call CARMASTATE_GetBin(cstate, icorelem(icore), ibin, mmrcore, rc, surface=sfccore) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + coreMass(:) = coreMass(:) + mmrcore(:) + coreSurface = coreSurface + sfccore + end do + + ! The core mass can't be more than the particle mass. If so, this indicates + ! that are problem happened, perhaps during advection and the particle masses + ! should be ignored. This should never happen from CARMA itself. + if (carma_do_mass_fix) then + do iz = 1, pver + + if (coreMass(iz) > mmr(iz)) then + if (carma_do_mass_fix) then + + if (carma_do_print_fix .and. do_print) write(LUNOPRT,*) & + " GetTotalIceAndSnow::WARNING - Adjusting particle for core mass error", & + iz, ielem, ibin, mmr(iz), coreMass(iz) + + ! It is hard to know what the right fix should be. You could reset + ! the particle mass to the coremass, but this will create lots of + ! small particles. It may be safer just to zero out both the particle + ! count and all of the core masses, assuming that this is a particle + ! that was created by diffusion in the transport and shouldn't really exist. + mmr(iz) = coreMass(iz) + end if + end if + end do + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) - coreMass(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + + ! Also zero out the core mass. + ! + ! In the future, you could try to keep track of the mass of the cores + ! in the snow and communicate that to CAM. + do icore = 1, ncore + call CARMASTATE_SetBin(cstate, icorelem(icore), ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end do + end if + else + iceMass(:) = iceMass(:) + mmr(:) - coreMass(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of snow. + snowSurface = snowSurface + sfc - sfccore + + + ! Calculate the effective radius (total volume / total area). + ! NOTE: cm -> m. + if (present(iceRe)) then + where (pa(:) > 0.0_r8) + iceRe(:) = (3._f / 4._f) * (md(:) / (0.917_f * pa(:))) * 1e-2_f + end where + + end if + end do + + return + end subroutine CARMA_GetTotalIceAndSnow + + + !! Detemrine the total cloud water concentration and number stored in the bins that represent + !! water within the CARMA model. + !! + !! @version Nov-2009 + !! @author Chuck Bardeen + subroutine CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + real(kind=f), intent(out) :: waterMass(pver) !! water mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: waterNumber(pver) !! water number mixing ratio (#/kg) + real(kind=f), intent(out) :: rainSurface !! rain on surface (kg/m2) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: sfc ! surface mass (kg/m2) + + rc = RC_OK + + waterMass(:) = 0._f + waterNumber(:) = 0._f + rainSurface = 0._f + + igroup = I_GRP_CRLIQ + ielem = I_ELEM_CRLIQ + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc) + if (rc < RC_OK) call endrun('CARMA_GetTotalWaterAndRain::CARMASTATE_GetBin failed.') + + waterMass(:) = waterMass(:) + mmr(:) + waterNumber(:) = waterNumber(:) + nmr(:) + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of rain. + rainSurface = rainSurface + sfc + + ! Include the detrained liquid that hasn't been added to the particle bins yet. + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc, nmr=nmr) + if (rc < RC_OK) call endrun('CARMA_GetTotalWaterAndRain::CARMASTATE_GetDetrain failed.') + + waterMass(:) = waterMass(:) + mmr(:) + waterNumber(:) = waterNumber(:) + nmr(:) + end do + + return + end subroutine CARMA_GetTotalWaterAndRain + + + + subroutine CARMA_CheckMassAndEnergy(carma, cstate, madeSnow, name, state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + logical, intent(in) :: madeSnow !! should bins be changed because of snow? + character*(*),intent(in) :: name !! test name + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(kind=f), intent(in) :: dt !! time step + real(kind=f), intent(in) :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(kind=f), intent(in) :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(kind=f), intent(in) :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(kind=f), intent(in) :: waterMass(pver) !! water mass mixing ratio (kg/kg) + real(kind=f), intent(in) :: iceMass(pver) !! ice mass mixing ratio (kg/kg) + real(kind=f), intent(in) :: snowMass(pver) !! snow mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code, negative indicates failure + + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + logical :: do_detrain ! do convective detrainment? + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: totalMass + real(kind=f) :: totalMass2 + + real(r8) :: lat + real(r8) :: lon + + + 1 format(/,'CARMA_CheckMassAndEnergy::ERROR - CARMA mass conservation error, ',a,',icol=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e16.10,',carma=',e16.10,',diff=',e16.10,',rer=',e9.3) + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, do_detrain=do_detrain) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + totalMass = sum(state%q(icol, :, ixcldliq) * (state%pdel(icol, :) / gravit)) + totalMass = totalMass + sum(state%q(icol, :, ixcldice) * (state%pdel(icol, :) / gravit)) + totalMass = totalMass + sum(state%q(icol, :, 1) * (state%pdel(icol, :) / gravit)) + + if (abs((totalMass - state%tw_cur(icol))) / state%tw_cur(icol) > 1e14_f) then + if (do_print) then + write(LUNOPRT,*) "CARMA_CheckMassAndEnergy::& + &WARNING Total water not conserved, ", & + totalMass, state%tw_cur, (totalMass - state%tw_cur(icol)), & + (totalMass - state%tw_cur(icol)) / state%tw_cur(icol) + end if + end if + + + ! Get the total water coming out of CARMA + call CARMASTATE_GetGas(cstate, I_GAS_H2O, mmr(:), rc) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMASTATE_GetGas failed.') + + totalMass2 = sum(waterMass(:) * (state%pdel(icol, :) / gravit)) + totalMass2 = totalMass2 + sum((iceMass(:)) * (state%pdel(icol, :) / gravit)) + + ! If snow has been made, that means it has been removed from the cloud ice that is + ! in the atmosphere and is now accounted for by the prec_str and snow_str fields. + ! Prior to that, it is still considered as part of the atmospheric ice total. + if (.not. madeSnow) then + totalMass2 = totalMass2 + sum(snowMass(:) * (state%pdel(icol, :) / gravit)) + end if + + totalMass2 = totalMass2 + sum(mmr(:) * (state%pdel(icol, :) / gravit)) + totalMass2 = totalMass2 + prec_str(icol) * dt * 1000._f + + if (do_detrain) totalMass2 = totalMass2 + rliq(icol) * dt * 1000._f + + if (totalMass /= totalMass2) then + + if (totalMass /= 0._f) then + + if (abs((totalMass - totalMass2) / totalMass) > 1e-10_f) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,1) name, icol, lat, lon, totalMass, totalMass2, & + totalMass2-TotalMass, (totalMass - totalMass2) / totalMass + + write(LUNOPRT,*) " state tw : ", state%tw_cur(icol) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " old vap : ", sum(state%q(icol, :, 1) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " old liq : ", sum(state%q(icol, :, ixcldliq) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " old ice : ", sum(state%q(icol, :, ixcldice) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " new vap : ", sum(mmr(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new liq : ", sum(waterMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new ice : ", sum(iceMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new snow : ", sum(snowMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " rliq : ", rliq(icol) * dt * 1000._f + write(LUNOPRT,*) " prec_str : ", prec_str(icol) * dt * 1000._f + end if + end if + end if + end if + + return + end subroutine CARMA_CheckMassAndEnergy + +end module diff --git a/src/physics/carma/models/cirrus/growevapl.F90 b/src/physics/carma/models/cirrus/growevapl.F90 new file mode 100644 index 0000000000..e1020eb802 --- /dev/null +++ b/src/physics/carma/models/cirrus/growevapl.F90 @@ -0,0 +1,264 @@ +! Include shortname defintions, so that the F77 code does not have to be modified to +! reference the CARMA structure. +#include "carma_globaer.h" + +!! This routine evaluate particle loss rates due to condensational +!! growth and evaporation for all condensing gases. +!! +!! The loss rates for each group are and . +!! +!! Units are [s^-1]. +!! +!! @author Andy Ackerman +!! @version Dec-1995 +subroutine growevapl(carma, cstate, iz, rc) + + ! types + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmastate_mod + use carma_mod + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + integer, intent(in) :: iz !! z index + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Local declarations + integer :: igroup + integer :: iepart + integer :: igas + integer :: ibin + integer :: isol + integer :: nother + integer :: ieoth_rel + integer :: ieoth_abs + integer :: jother + real(kind=f) :: argsol + real(kind=f) :: othermtot + real(kind=f) :: condm + real(kind=f) :: akas + real(kind=f) :: expon + real(kind=f) :: g0 + real(kind=f) :: g1 + real(kind=f) :: g2 + real(kind=f) :: ss + real(kind=f) :: pvap + real(kind=f) :: dpc + real(kind=f) :: dpc1 + real(kind=f) :: dpcm1 + real(kind=f) :: rat1 + real(kind=f) :: rat2 + real(kind=f) :: rat3 + real(kind=f) :: rat4 + real(kind=f) :: ratt1 + real(kind=f) :: ratt2 + real(kind=f) :: ratt3 + real(kind=f) :: den1 + real(kind=f) :: test1 + real(kind=f) :: test2 + real(kind=f) :: x + integer :: ieother(NELEM) + real(kind=f) :: otherm(NELEM) + real(kind=f) :: dela(NBIN) + real(kind=f) :: delma(NBIN) + real(kind=f) :: aju(NBIN) + real(kind=f) :: ar(NBIN) + real(kind=f) :: al(NBIN) + real(kind=f) :: a6(NBIN) + real(kind=f) :: dmdt(NBIN) + real(kind=f) :: growlg_max + + + do igroup = 1,NGROUP + + ! element of particle number concentration + iepart = ienconc(igroup) + + ! condensing gas + igas = igrowgas(iepart) + + if (igas .ne. 0) then + ! Only valid for condensing liquid water and sulfric acid currently. + if ((igas /= igash2o) .and. (igas .ne. igash2so4)) then + if (do_print) write(LUNOPRT,*) 'growevapl::ERROR - Invalid gas (', igas, ').' + rc = -1 + return + endif + + ! Treat condensation of gas to/from particle group . + ! + ! Bypass calculation if few particles are present + if( pconmax(iz,igroup) .gt. FEW_PC )then + do ibin = 1,NBIN-1 + + ! Determine the growth rate (dmdt). This calculation may take into account + ! radiative effects on the particle which can affect the growth rates. + call pheat(carma, cstate, iz, igroup, iepart, ibin, igas, dmdt(ibin), rc) + + enddo ! ibin = 1,NBIN-1 + + ! Now calculate condensation/evaporation production and loss rates. + ! Use Piecewise Polynomial Method [Colela and Woodard, J. Comp. Phys., + ! 54, 174-201, 1984] + ! + ! First, use cubic fits to estimate concentration values at bin + ! boundaries + do ibin = 2,NBIN-1 + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup) + dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup) + ratt1 = pratt(1,ibin,igroup) + ratt2 = pratt(2,ibin,igroup) + ratt3 = pratt(3,ibin,igroup) + dela(ibin) = ratt1 * ( ratt2*(dpc1-dpc) + ratt3*(dpc-dpcm1) ) + delma(ibin) = 0._f + + if( (dpc1-dpc)*(dpc-dpcm1) .gt. 0._f ) & + delma(ibin) = min( abs(dela(ibin)), 2._f*abs(dpc-dpc1), & + 2._f*abs(dpc-dpcm1) ) * sign(1._f, dela(ibin)) + + enddo ! ibin = 2,NBIN-2 + + do ibin = 2,NBIN-2 + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup) + dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup) + rat1 = prat(1,ibin,igroup) + rat2 = prat(2,ibin,igroup) + rat3 = prat(3,ibin,igroup) + rat4 = prat(4,ibin,igroup) + den1 = pden1(ibin,igroup) + + ! is the estimate for concentration (dn/dm) at bin + ! boundary +1/2. + aju(ibin) = dpc + rat1*(dpc1-dpc) + 1._f/den1 * & + ( rat2*(rat3-rat4)*(dpc1-dpc) - & + dm(ibin,igroup)*rat3*delma(ibin+1) + & + dm(ibin+1,igroup)*rat4*delma(ibin) ) + enddo ! ibin = 2,NBIN-2 + + ! Now construct polynomial functions in each bin + do ibin = 3,NBIN-2 + al(ibin) = aju(ibin-1) + ar(ibin) = aju(ibin) + enddo + + ! Use linear functions in first two and last two bins + if( NBIN .gt. 1 )then + ibin = NBIN + + ar(2) = aju(2) + al(2) = pc(iz,1,iepart)/dm(1,igroup) + & + palr(1,igroup) * & + (pc(iz,2,iepart)/dm(2,igroup)- & + pc(iz,1,iepart)/dm(1,igroup)) + ar(1) = al(2) + al(1) = pc(iz,1,iepart)/dm(1,igroup) + & + palr(2,igroup) * & + (pc(iz,2,iepart)/dm(2,igroup)- & + pc(iz,1,iepart)/dm(1,igroup)) + + al(ibin-1) = aju(ibin-2) + ar(ibin-1) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + & + palr(3,igroup) * & + (pc(iz,ibin,iepart)/dm(ibin,igroup)- & + pc(iz,ibin-1,iepart)/dm(ibin-1,igroup)) + al(ibin) = ar(ibin-1) + ar(ibin) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + & + palr(4,igroup) * & + (pc(iz,ibin,iepart)/dm(ibin,igroup)- & + pc(iz,ibin-1,iepart)/dm(ibin-1,igroup)) + endif + + ! Next, ensure that polynomial functions do not deviate beyond the + ! range [,] + do ibin = 1,NBIN + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + + if( (ar(ibin)-dpc)*(dpc-al(ibin)) .le. 0._f )then + al(ibin) = dpc + ar(ibin) = dpc + endif + + test1 = (ar(ibin)-al(ibin))*(dpc - 0.5_f*(al(ibin)+ar(ibin))) + test2 = 1._f/6._f*(ar(ibin)-al(ibin))**2 + + if( test1 .gt. test2 )then + al(ibin) = 3._f*dpc - 2._f*ar(ibin) + elseif( test1 .lt. -test2 )then + ar(ibin) = 3._f*dpc - 2._f*al(ibin) + endif + enddo + + ! Lastly, calculate fluxes across each bin boundary. + ! + ! Use upwind advection when courant number > 1. + do ibin = 1,NBIN + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dela(ibin) = ar(ibin) - al(ibin) + a6(ibin) = 6._f * ( dpc - 0.5_f*(ar(ibin)+al(ibin)) ) + enddo + + do ibin = 1,NBIN-1 + + if( dmdt(ibin) .gt. 0._f .and. & + pc(iz,ibin,iepart) .gt. SMALL_PC )then + + x = dmdt(ibin)*dtime/dm(ibin,igroup) + + if( x .lt. 1._f )then + growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & + * ( ar(ibin) - 0.5*dela(ibin)*x + & + (x/2._f - x**2/3._f)*a6(ibin) ) + else + growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) + endif + + elseif( dmdt(ibin) .lt. 0._f .and. & + pc(iz,ibin+1,iepart) .gt. SMALL_PC )then + + x = -dmdt(ibin)*dtime/dm(ibin+1,igroup) + + if( x .lt. 1._f )then + evaplg(ibin+1,igroup) = -dmdt(ibin)/ & + pc(iz,ibin+1,iepart) & + * ( al(ibin+1) + 0.5_f*dela(ibin+1)*x + & + (x/2._f - (x**2)/3._f)*a6(ibin+1) ) + else + evaplg(ibin+1,igroup) = -dmdt(ibin) / dm(ibin+1,igroup) + endif + + ! Boundary conditions: for evaporation out of first bin (with cores), + ! use evaporation rate from second bin. +! if( ibin .eq. 1 .and. ncore(igroup) .gt. 0 )then + if( ibin .eq. 1)then + evaplg(1,igroup) = -dmdt(1) / dm(1,igroup) + endif + endif + + ! As a hack, limit the growth of water drops to areas where it + ! is below freezing. This is where the Bergeron process exists. Let + ! the parent model do the rest of the droplet growth. + if ((igroup == 4) .and. (t(iz) > T0)) then + growlg(ibin,igroup) = 0._f + evaplg(ibin+1,igroup) = 0._f + end if + + enddo ! ibin = 1,NBIN-1 + endif ! (pconmax .gt. FEW_PC) + endif ! (igas = igrowgas(ielem)) .ne. 0 + enddo ! igroup = 1,NGROUP + + + ! Return to caller with particle loss rates for growth and evaporation + ! evaluated. + return +end diff --git a/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 new file mode 100644 index 0000000000..88be7373bb --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 @@ -0,0 +1,142 @@ + !! Determine the stratifrom cloud fractions using the CAM routines. This will return the + !! ice and liquid cloud fractions as well as the minimum relative humidity for the onset + !! of liquid clouds. + !! + !! NOTE: This is just a stub for models that don't use cloud fraction. It should be replaced + !! be a new routine in a file of the same name in the model directory if the model needs + !! cloud fraction. This routine needs to be in its own file to avoid circular references when + !! using the CAM cloud fraction routines (see cirrus model). + !! + !! @version Aug-2010 + !! @author Chuck Bardeen + subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcrit, rc) + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carma_model_mod + use carma_flags_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & + set_dry_to_wet + use constituents, only: cnst_get_ind + use cam_abortutils, only: endrun + + use camsrfexch, only : cam_in_t + use ppgrid, only : pcols, pver, pverp + use cldfrc2m, only : astG_RHU_single, astG_PDF_single, aist_single, CAMstfrac + + type(carma_type) :: carma !! the carma object + type(carmastate_type) :: cstate !! the carma state object + type(cam_in_t) :: cam_in + type(physics_state) :: state !! physics state variables + integer :: icol !! column index + real(r8) :: cldfrc(pver) !! total cloud fraction [fraction] + real(r8) :: rhcrit(pver) !! realtive humidity for onset of liquid clouds [fraction] + integer :: rc !! return code, negative indicates failure + + real(r8) :: liqcldf(pver) ! liquid cloud fraction [fraction] + real(r8) :: icecldf(pver) ! ice cloud fraction [fraction] + real(r8) :: Ga ! dU/da + real(r8) :: ssl + real(r8) :: ssi + real(r8) :: qi(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: mmr(pver) ! ice mass mixing ratio (kg/kg) + integer :: ixcldice + integer :: ielem + integer :: igroup + integer :: ibin + integer :: iz + integer :: ienconc + logical :: is_ice + logical :: is_cloud + logical :: do_detrain + + rc = RC_OK + + call CARMA_Get(carma, rc, do_detrain=do_detrain) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMA_Get failed.') + + ! Get the cloud ice mmr. For the cloud fraction, we only want to include the + ! ice that is considered in-cloud. + qi = 0._f + + do ielem = 1, NELEM + + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMAELEMENT_Get failed.') + + call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, is_ice=is_ice, is_cloud=is_cloud) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMAGROUP_Get failed.') + + ! Is this an ice cloud? + if ((ielem == ienconc) .and. (is_ice) .and. (is_cloud)) then + + do ibin = 1, NBIN + + ! Get the mass mixing ration for this bin. + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMASTATE_GetBin failed.') + + ! Add it to the existing ice. + qi = qi + mmr + + ! Add in the detrained ice for this bin. + if (do_detrain) then + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_CloudFraction::CARMASTATE_GetDetrain failed.') + + ! Add it to the existing ice. + qi = qi + mmr + end if + end do + end if + end do + + + ! Calculate the cloud fractions. + do iz = 1, pver + + ! Get a supersaturation that has not been scaled based upon the cloud + ! fraction. + call supersat_nocldf(carma, cstate, iz, I_GAS_H2O, ssi, ssl, rc) + + ! Get the liquid cloud fraction and the onset humidity for liquid clouds. + ! + ! NOTE: There is also a PDF based routine, but for now it isn't being used. If + ! it starts to be used, then a general routine astG_single should be written. + if (CAMstfrac) then + call astG_RHU_single(ssl + 1._f, state%pmid(icol, iz), state%q(icol, iz, 1), & + cam_in%landfrac(icol), cam_in%snowhland(icol), liqcldf(iz), Ga, rhcrit(iz)) + else + call astG_PDF_single(ssl + 1._f, state%pmid(icol, iz), state%q(icol, iz, 1), & + cam_in%landfrac(icol), cam_in%snowhland(icol), liqcldf(iz), Ga, rhcrit(iz)) + end if + + ! Now get the ice cloud fraction. + call aist_single(state%q(icol, iz, 1), state%t(icol, iz), state%pmid(icol, iz), & + qi(iz), cam_in%landfrac(icol), cam_in%snowhland(icol), icecldf(iz)) + end do + + ! Calculate an overall cloud fraction. This may vary depending upon the model, + ! but defaults to minimum overlap (Wilson and Ballard, 1999). This may not be + ! the same as the assumptions made by the CAM cloud scheme. + cldfrc(:) = min(1.0_f, icecldf(:) + liqcldf(:)) + + ! For the cirrus model, we just want to use the ice cloud fraction. +! cldfrc(:) = icecldf(:) + + ! Don't let the cloud fraction get too small. + cldfrc(:) = max(CLDFRC_MIN, cldfrc(:)) + + return + end subroutine CARMA_CloudFraction + + diff --git a/src/physics/carma/models/cirrus_dust/carma_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_mod.F90 new file mode 100644 index 0000000000..ab89065690 --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/carma_mod.F90 @@ -0,0 +1,1478 @@ +!! The CARMA module contains an interface to the Community Aerosol and Radiation +!! Model for Atmospheres (CARMA) bin microphysical model [Turco et al. 1979; +!! Toon et al. 1988]. This implementation has been customized to work within +!! other model frameworks, so although it can be provided with an array of +!! columns, it does not do horizontal transport and just does independent 1-D +!! calculations upon each column. +!! +!! The typical usage for the CARMA and CARMASTATE objects within a model would be: +!!> +!! ! This first section of code is done during the parent model's initialzation, +!! ! and there should be a unique CARMA object created for each thread of +!! ! execution. +!! +!! ! Create the CARMA object. +!! call CARMA_Create(carma, ...) +!! +!! ! Define the microphysical components. +!! call CARMAGROUP_Create(carma, ...) ! One or more calls +!! +!! call CARMAELEMENT_Create(carma, ...) ! One or more calls +!! +!! call CARMASOLUTE_Create(carma, ...) ! Zero or more calls +!! +!! call CARMAGAS_Create(carma, ...) ! Zero or more calls +!! +!! ! Define the relationships for the microphysical processes. +!! call CARMA_AddCoagulation(carma, ...) ! Zero or more calls +!! call CARMA_AddGrowth(carma, ...) ! Zero or more calls +!! call CARMA_AddNucleation(carma, ...) ! Zero or more calls +!! +!! ! Initialize things that are state and timestep independent. +!! call CARMA_Initialize(carma, ...) +!! +!! ... +!! +!! ! This section of code is within the parent model's timing loop. +!! ! +!! ! NOTE: If using OPEN/MP, then each thread will execute one of +!! ! of these loops per column of data. To avoid having to destroy +!! ! the CARMASTATE object, a pool of CARMASTATE objects could be +!! ! created so that there is one per thread and then the +!! ! CARMA_Destroy() could be called after all columns have been +!! ! processed. +!! +!! ! Initialize CARMA for this model state and timestep. +!! call CARMASTATE_Create(cstate, carma, ...) +!! +!! ! Set the model state for each bin and gas. +!! call CARMASTATE_SetBin(cstate, ...) ! One call for each bin +!! call CARMASTATE_SetGas(cstate, ...) ! One call for each gas +!! +!! ! Calculate the new state +!! call CARMASTATE_Step(cstate, ...) +!! +!! ! Get the results to return back to the parent model. +!! call CARMASTATE_GetBin(cstate, ...) ! One call for each Bin +!! call CARMASTATE_GetGas(cstate, ...) ! One call for each gas +!! call CARMASTATE_GetState(cstate, ...) ! Zero or one calls +!! +!! ! (optional) Deallocate arrays that are not needed beyond this timestep. +!! call CARMASTATE_Destroy(cstate) +!! +!! ... +!! +!! ! This section of code is done during the parent model's cleanup. +!! +!! ! Deallocate all arrays. +!! call CARMA_Destroy(carma) +!!< +!! +!! @version Feb-2009 +!! @author Chuck Bardeen, Pete Colarco, Jamie Smith +! +! NOTE: Documentation for this code can be generated automatically using f90doc, +! which is freely available from: +! http://erikdemaine.org/software/f90doc/ +! Comment lines with double comment characters are processed by f90doc, and there are +! some special characters added to the comments to control the documentation process. +! In addition to the special characters mentioned in the f990doc documentation, html +! formatting tags (e.g. , , ...) can also be added to the f90doc +! comments. +module carma_mod + + ! This module maps the parents models constants into the constants need by CARMA. NOTE: CARMA + ! constants are in CGS units, while the parent models are typically in MKS units. + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + + ! CARMA explicitly declares all variables. + implicit none + + ! All CARMA variables and procedures are private except those explicitly declared to be public. + private + + ! Declare the public methods. + public CARMA_AddCoagulation + public CARMA_AddGrowth + public CARMA_AddNucleation + public CARMA_Create + public CARMA_Destroy + public CARMA_Get + public CARMA_Initialize + +contains + + ! These are the methods that provide the interface between the parent model and the CARMA + ! microphysical model. There are many other methods that are not in this file that are + ! used to implement the microphysical calculations needed by the CARMA model. These other + ! methods are in effect private methods of the CARMA module, but are in individual files + ! since that is the way that CARMA has traditionally been structured and where users may + ! want to extend or replace code to affect the microphysics. + + !! Creates the CARMA object and allocates arrays to store configuration information + !! that will follow from the CARMA_AddXXX() methods. When the CARMA object is no longer + !! needed, the CARMA_Destroy() method should be used to clean up any allocations + !! that have happened. If LUNOPRT is specified, then the logical unit should be open and + !! ready for output. The caller is responsible for closing the LUNOPRT logical unit + !! after the CARMA object has been destroyed. + !! + !! @version Feb-2009 + !! @author Chuck Bardeen + subroutine CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, & + LUNOPRT, wave, dwave, do_wave_emit) + + type(carma_type), intent(out) :: carma !! the carma object + integer, intent(in) :: NBIN !! number of radius bins per group + integer, intent(in) :: NELEM !! total number of elements + integer, intent(in) :: NGROUP !! total number of groups + integer, intent(in) :: NSOLUTE !! total number of solutes + integer, intent(in) :: NGAS !! total number of gases + integer, intent(in) :: NWAVE !! number of wavelengths + integer, intent(out) :: rc !! return code, negative indicates failure + integer, intent(in), optional :: LUNOPRT !! logical unit number for output + real(kind=f), intent(in), optional :: wave(NWAVE) !! wavelength centers (cm) + real(kind=f), intent(in), optional :: dwave(NWAVE) !! wavelength width (cm) + logical, intent(in), optional :: do_wave_emit(NWAVE) !! do emission in band? + + ! Local Varaibles + integer :: ier + + ! Assume success. + rc = RC_OK + + ! Save off the logic unit used for output if one was provided. If one was provided, + ! then assume that CARMA can print output. + if (present(LUNOPRT)) then + carma%f_LUNOPRT = LUNOPRT + carma%f_do_print = .TRUE. + end if + + ! Save the defintion of the number of comonents involved in the microphysics. + carma%f_NGROUP = NGROUP + carma%f_NELEM = NELEM + carma%f_NBIN = NBIN + carma%f_NGAS = NGAS + carma%f_NSOLUTE = NSOLUTE + carma%f_NWAVE = NWAVE + + + ! Allocate tables for the groups. + allocate( & + carma%f_group(NGROUP), & + carma%f_icoag(NGROUP, NGROUP), & + carma%f_inucgas(NGROUP), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating groups, NGROUP=", & + carma%f_NGROUP, ", status=", ier + rc = RC_ERROR + return + endif + + ! Initialize + carma%f_icoag(:, :) = 0 + carma%f_inucgas(:) = 0 + + ! Allocate tables for the elements. + allocate( & + carma%f_element(NELEM), & + carma%f_igrowgas(NELEM), & + carma%f_inuc2elem(NELEM, NELEM), & + carma%f_inucproc(NELEM, NELEM), & + carma%f_ievp2elem(NELEM), & + carma%f_nnuc2elem(NELEM), & + carma%f_nnucelem(NELEM), & + carma%f_inucelem(NELEM,NELEM*NGROUP), & + carma%f_if_nuc(NELEM,NELEM), & + carma%f_rlh_nuc(NELEM, NELEM), & + carma%f_icoagelem(NELEM, NGROUP), & + carma%f_icoagelem_cm(NELEM, NGROUP), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating elements, NELEM=", & + carma%f_NELEM, ", status=", ier + rc = RC_ERROR + return + endif + + ! Initialize + carma%f_igrowgas(:) = 0 + carma%f_inuc2elem(:,:) = 0 + carma%f_inucproc(:,:) = 0 + carma%f_ievp2elem(:) = 0 + carma%f_nnuc2elem(:) = 0 + carma%f_nnucelem(:) = 0 + carma%f_inucelem(:,:) = 0 + carma%f_if_nuc(:,:) = .FALSE. + carma%f_rlh_nuc(:,:) = 0._f + carma%f_icoagelem(:,:) = 0 + carma%f_icoagelem_cm(:,:) = 0 + + + ! Allocate tables for the bins. + allocate( & + carma%f_inuc2bin(NBIN,NGROUP,NGROUP), & + carma%f_ievp2bin(NBIN,NGROUP,NGROUP), & + carma%f_nnucbin(NGROUP,NBIN,NGROUP), & + carma%f_inucbin(NBIN*NGROUP,NGROUP,NBIN,NGROUP), & + carma%f_diffmass(NBIN, NGROUP, NBIN, NGROUP), & + carma%f_volx(NGROUP,NGROUP,NGROUP,NBIN,NBIN), & + carma%f_ilow(NGROUP,NBIN,NBIN*NBIN), & + carma%f_jlow(NGROUP,NBIN,NBIN*NBIN), & + carma%f_iup(NGROUP,NBIN,NBIN*NBIN), & + carma%f_jup(NGROUP,NBIN,NBIN*NBIN), & + carma%f_npairl(NGROUP,NBIN), & + carma%f_npairu(NGROUP,NBIN), & + carma%f_iglow(NGROUP,NBIN,NBIN*NBIN), & + carma%f_jglow(NGROUP,NBIN,NBIN*NBIN), & + carma%f_igup(NGROUP,NBIN,NBIN*NBIN), & + carma%f_jgup(NGROUP,NBIN,NBIN*NBIN), & + carma%f_kbin(NGROUP,NGROUP,NGROUP,NBIN,NBIN), & + carma%f_pkernel(NBIN,NBIN,NGROUP,NGROUP,NGROUP,6), & + carma%f_pratt(3,NBIN,NGROUP), & + carma%f_prat(4,NBIN,NGROUP), & + carma%f_pden1(NBIN,NGROUP), & + carma%f_palr(4,NGROUP), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating bins, NBIN=", & + carma%f_NBIN, ", status=", ier + rc = RC_ERROR + return + endif + + ! Initialize + carma%f_inuc2bin(:,:,:) = 0 + carma%f_ievp2bin(:,:,:) = 0 + carma%f_nnucbin(:,:,:) = 0 + carma%f_inucbin(:,:,:,:) = 0 + carma%f_diffmass(:, :, :, :) = 0._f + carma%f_volx(:,:,:,:,:) = 0._f + carma%f_ilow(:,:,:) = 0 + carma%f_jlow(:,:,:) = 0 + carma%f_iup(:,:,:) = 0 + carma%f_jup(:,:,:) = 0 + carma%f_npairl(:,:) = 0 + carma%f_npairu(:,:) = 0 + carma%f_iglow(:,:,:) = 0 + carma%f_jglow(:,:,:) = 0 + carma%f_igup(:,:,:) = 0 + carma%f_jgup(:,:,:) = 0 + carma%f_kbin(:,:,:,:,:) = 0._f + carma%f_pkernel(:,:,:,:,:,:) = 0._f + carma%f_pratt(:,:,:) = 0._f + carma%f_prat(:,:,:) = 0._f + carma%f_pden1(:,:) = 0._f + carma%f_palr(:,:) = 0._f + + + ! Allocate tables for solutes, if any are needed. + if (NSOLUTE > 0) then + allocate( & + carma%f_solute(NSOLUTE), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating solutes, NSOLUTE=", & + carma%f_NSOLUTE, ", status=", ier + rc = RC_ERROR + return + endif + end if + + + ! Allocate tables for gases, if any are needed. + if (NGAS > 0) then + allocate( & + carma%f_gas(NGAS), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating gases, NGAS=", & + carma%f_NGAS, ", status=", ier + rc = RC_ERROR + return + endif + end if + + + ! Allocate tables for optical properties, if any are needed. + if (NWAVE > 0) then + allocate( & + carma%f_wave(NWAVE), & + carma%f_dwave(NWAVE), & + carma%f_do_wave_emit(NWAVE), & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating wavelengths, NWAVE=", & + carma%f_NWAVE, ", status=", ier + rc = RC_ERROR + return + endif + + ! Initialize + carma%f_do_wave_emit(:) = .TRUE. + + if (present(wave)) carma%f_wave(:) = wave(:) + if (present(dwave)) carma%f_dwave(:) = dwave(:) + if (present(do_wave_emit)) carma%f_do_wave_emit(:) = do_wave_emit(:) + end if + + return + end subroutine CARMA_Create + + !! Called after the CARMA object has been created and the microphysics description has been + !! configured. The optional flags control which microphysical processes are enabled and all of + !! them default to FALSE. For a microphysical process to be active it must have been both + !! configured (using a CARMA_AddXXX() method) and enabled here. + !! + !! NOTE: After initialization, the structure of the particle size bins is determined, and + !! the resulting r, dr, rmass and dm can be retrieved with the CARMA_GetGroup() method. + !! + !! @version Feb-2009 + !! @author Chuck Bardeen + subroutine CARMA_Initialize(carma, rc, do_cnst_rlh, do_coag, do_detrain, do_fixedinit, & + do_grow, do_incloud, do_explised, do_print_init, do_substep, do_thermo, do_vdiff, & + do_vtran, do_drydep, vf_const, minsubsteps, maxsubsteps, maxretries, conmax, & + do_pheat, do_pheatatm, dt_threshold, cstick, gsticki, gstickl, tstick, do_clearsky) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + logical, intent(in), optional :: do_cnst_rlh !! use constant values for latent heats + !! (instead of varying with temperature)? + logical, intent(in), optional :: do_coag !! do coagulation? + logical, intent(in), optional :: do_detrain !! do detrainement? + logical, intent(in), optional :: do_fixedinit !! do initialization from reference atm? + logical, intent(in), optional :: do_grow !! do nucleation, growth and evaporation? + logical, intent(in), optional :: do_incloud !! do incloud growth and coagulation? + logical, intent(in), optional :: do_explised !! do sedimentation with substepping + logical, intent(in), optional :: do_substep !! do substepping + logical, intent(in), optional :: do_print_init !! do prinit initializtion information + logical, intent(in), optional :: do_thermo !! do thermodynamics + logical, intent(in), optional :: do_vdiff !! do Brownian diffusion + logical, intent(in), optional :: do_vtran !! do sedimentation + logical, intent(in), optional :: do_drydep !! do dry deposition + real(kind=f), intent(in), optional :: vf_const !! if specified and non-zero + !! constant fall velocity for all particles [cm/s] + integer, intent(in), optional :: minsubsteps !! minimum number of substeps, default = 1 + integer, intent(in), optional :: maxsubsteps !! maximum number of substeps, default = 1 + integer, intent(in), optional :: maxretries !! maximum number of substep retries, default = 5 + real(kind=f), intent(in), optional :: conmax !! minimum relative concentration to consider, default = 1e-1 + logical, intent(in), optional :: do_pheat !! do particle heating + logical, intent(in), optional :: do_pheatatm !! do particle heating of atmosphere + real(kind=f), intent(in), optional :: dt_threshold !! convergence criteria for temperature [fraction] + real(kind=f), intent(in), optional :: cstick !! accommodation coefficient - coagulation, default = 1.0 + real(kind=f), intent(in), optional :: gsticki !! accommodation coefficient - growth (ice), default = 0.93 + real(kind=f), intent(in), optional :: gstickl !! accommodation coefficient - growth (liquid), default = 1.0 + real(kind=f), intent(in), optional :: tstick !! accommodation coefficient - temperature, default = 1.0 + logical, intent(in), optional :: do_clearsky !! do clear sky growth and coagulation? + + ! Assume success. + rc = RC_OK + + ! Set default values for control flags. + carma%f_do_cnst_rlh = .FALSE. + carma%f_do_coag = .FALSE. + carma%f_do_detrain = .FALSE. + carma%f_do_fixedinit = .FALSE. + carma%f_do_grow = .FALSE. + carma%f_do_incloud = .FALSE. + carma%f_do_explised = .FALSE. + carma%f_do_pheat = .FALSE. + carma%f_do_pheatatm = .FALSE. + carma%f_do_print_init = .FALSE. + carma%f_do_substep = .FALSE. + carma%f_do_thermo = .FALSE. + carma%f_do_vdiff = .FALSE. + carma%f_do_vtran = .FALSE. + carma%f_do_drydep = .FALSE. + carma%f_dt_threshold = 0._f + carma%f_cstick = 1._f + carma%f_gsticki = 0.93_f + carma%f_gstickl = 1._f + carma%f_tstick = 1._f + carma%f_do_clearsky = .FALSE. + + ! Store off any control flag values that have been supplied. + if (present(do_cnst_rlh)) carma%f_do_cnst_rlh = do_cnst_rlh + if (present(do_coag)) carma%f_do_coag = do_coag + if (present(do_detrain)) carma%f_do_detrain = do_detrain + if (present(do_fixedinit)) carma%f_do_fixedinit = do_fixedinit + if (present(do_grow)) carma%f_do_grow = do_grow + if (present(do_incloud)) carma%f_do_incloud = do_incloud + if (present(do_explised)) carma%f_do_explised = do_explised + if (present(do_pheat)) carma%f_do_pheat = do_pheat + if (present(do_pheatatm)) carma%f_do_pheatatm = do_pheatatm + if (present(do_print_init)) carma%f_do_print_init = (do_print_init .and. carma%f_do_print) + if (present(do_substep)) carma%f_do_substep = do_substep + if (present(do_thermo)) carma%f_do_thermo = do_thermo + if (present(do_vdiff)) carma%f_do_vdiff = do_vdiff + if (present(do_vtran)) carma%f_do_vtran = do_vtran + if (present(do_drydep)) carma%f_do_drydep = do_drydep + if (present(dt_threshold)) carma%f_dt_threshold = dt_threshold + if (present(cstick)) carma%f_cstick = cstick + if (present(gsticki)) carma%f_gsticki = gsticki + if (present(gstickl)) carma%f_gstickl = gstickl + if (present(tstick)) carma%f_tstick = tstick + if (present(do_clearsky)) carma%f_do_clearsky = do_clearsky + + + ! Setup the bin structure. + call setupbins(carma, rc) + if (rc < 0) return + + ! Substepping + carma%f_minsubsteps = 1 ! minimum number of substeps + carma%f_maxsubsteps = 1 ! maximum number of substeps + carma%f_maxretries = 1 ! maximum number of retries + carma%f_conmax = 1.e-1_f + + if (present(minsubsteps)) carma%f_minsubsteps = minsubsteps + if (present(maxsubsteps)) carma%f_maxsubsteps = maxsubsteps + if (present(maxretries)) carma%f_maxretries = maxretries + if (present(conmax)) carma%f_conmax = conmax + + carma%f_do_step = .TRUE. + + ! Calculate the Optical Properties + call CARMA_InitializeOptics(carma, rc) + if (rc < 0) return + + ! If any of the processes have initialization that can be done without the state + ! information, then perform that now. This will mostly be checking the configuration + ! and setting up any tables based upon the configuration. + if (carma%f_do_vtran .or. carma%f_do_coag) then + call CARMA_InitializeVertical(carma, rc, vf_const) + if (rc < 0) return + end if + + if (carma%f_do_coag) then + call setupcoag(carma, rc) + if (rc < 0) return + end if + + if (carma%f_do_grow) then + call CARMA_InitializeGrowth(carma, rc) + if (rc < 0) return + end if + + if (carma%f_do_thermo) then + call CARMA_InitializeThermo(carma, rc) + if (rc < 0) return + end if + + return + end subroutine CARMA_Initialize + + + subroutine CARMA_InitializeGrowth(carma, rc) + type(carma_type), intent(inout) :: carma + integer, intent(out) :: rc + + ! Local Variables + integer :: i + logical :: bad_grid + integer :: igroup ! group index + integer :: igas ! gas index + integer :: isol ! solute index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: igfrom + integer :: igto + integer :: ibto + integer :: ieto + integer :: ifrom + integer :: iefrom + integer :: jefrom + integer :: ip + integer :: jcore + integer :: iecore + integer :: im + integer :: jnucelem + integer :: inuc2 + integer :: neto + integer :: jfrom + integer :: j + integer :: nnucb + + ! Define formats + 1 format(a,': ',12i6) + 2 format(/,a,': ',i6) + 3 format(a,a) + 4 format(a,': ',1pe12.3) + 5 format(/,'Particle nucleation mapping arrays (setupnuc):') + 7 format(/,'Warning: nucleation cannot occur from group',i3, & + ' bin',i3,' into group',i3,' ( is zero)') + + + ! Assume success. + rc = RC_OK + + ! Compute radius-dependent terms used in PPM advection scheme + do igroup = 1, carma%f_NGROUP + do i = 2,carma%f_NBIN-1 + carma%f_pratt(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / & + ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) ) + carma%f_pratt(2,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / & + ( carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) ) + carma%f_pratt(3,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) ) / & + ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) + enddo + + do i = 2,carma%f_NBIN-2 + carma%f_prat(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / & + ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) ) + carma%f_prat(2,i,igroup) = 2._f * carma%f_group(igroup)%f_dm(i+1) * carma%f_group(igroup)%f_dm(i) / & + ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) ) + carma%f_prat(3,i,igroup) = ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / & + ( 2._f*carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) ) + carma%f_prat(4,i,igroup) = ( carma%f_group(igroup)%f_dm(i+2) + carma%f_group(igroup)%f_dm(i+1) ) / & + ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) ) + carma%f_pden1(i,igroup) = carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + & + carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i+2) + enddo + + if( carma%f_NBIN .gt. 1 )then + carma%f_palr(1,igroup) = & + (carma%f_group(igroup)%f_rmassup(1)-carma%f_group(igroup)%f_rmass(1)) / & + (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1)) + carma%f_palr(2,igroup) = & + (carma%f_group(igroup)%f_rmassup(1)/carma%f_group(igroup)%f_rmrat-carma%f_group(igroup)%f_rmass(1)) / & + (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1)) + carma%f_palr(3,igroup) = & + (carma%f_group(igroup)%f_rmassup(carma%f_NBIN-1)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) & + / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) + carma%f_palr(4,igroup) = & + (carma%f_group(igroup)%f_rmassup(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) & + / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) + endif + end do + + + ! Check the nucleation mapping. + ! + ! NOTE: This code was moved from setupnuc, because it is not dependent on the model's + ! state. A small part of setupnuc which deals with scrit is state specific, and that was + ! left in setupnuc. + + ! Bin mapping for nucleation : nucleation would transfer mass from particles + ! in into target bin in group + ! . The target bin is the smallest bin in the target size grid with + ! mass exceeding that of nucleated particle. + do igfrom = 1,carma%f_NGROUP ! nucleation source group + do igto = 1,carma%f_NGROUP ! nucleation target group + do ifrom = 1,carma%f_NBIN ! nucleation source bin + + carma%f_inuc2bin(ifrom,igfrom,igto) = 0 + + do ibto = carma%f_NBIN,1,-1 ! nucleation target bin + + if( carma%f_group(igto)%f_rmass(ibto) .ge. carma%f_group(igfrom)%f_rmass(ifrom) )then + carma%f_inuc2bin(ifrom,igfrom,igto) = ibto + endif + enddo + enddo + enddo + enddo + + ! Mappings for nucleation sources: + ! + ! is the number of particle elements that nucleate to + ! particle element . + ! + ! are the particle elements that + ! nucleate to particle element , where + ! jefrom = 1,nnucelem(ielem). + ! + ! is true if nucleation transfers mass from element + ! to element . + ! + ! is the number of particle bins that nucleate + ! to particles in bin from group . + ! + ! are the particle bins + ! that nucleate to particles in bin , where + ! jfrom = 1,nnucbin(igfrom,ibin,igto). + ! + ! + ! First, calculate and + ! based on + do iefrom = 1,carma%f_NELEM + do ieto = 1,carma%f_NELEM + carma%f_if_nuc(iefrom,ieto) = .false. + enddo + enddo + + do ielem = 1,carma%f_NELEM + carma%f_nnuc2elem(ielem) = 0 + + do jefrom = 1,carma%f_NGROUP + if( carma%f_inuc2elem(jefrom,ielem) .ne. 0 ) then + carma%f_nnuc2elem(ielem) = carma%f_nnuc2elem(ielem) + 1 + carma%f_if_nuc(ielem,carma%f_inuc2elem(jefrom,ielem)) = .true. + + + ! Also check for cases where neither the source or destinaton don't have cores (e.g. + ! melting ice to water drops). + if ((carma%f_group(carma%f_element(ielem)%f_igroup)%f_ncore .eq. 0) .and. & + (carma%f_group(carma%f_element(carma%f_inuc2elem(jefrom,ielem))%f_igroup)%f_ncore .eq. 0)) then + + ! For particle concentration target elements, only count source elements + ! that are also particle concentrations. + carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) = carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) + 1 + carma%f_inucelem(carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)),carma%f_inuc2elem(jefrom,ielem)) = ielem + end if + endif + enddo + enddo + + ! Next, enumerate and count elements that nucleate to cores. + do igroup = 1,carma%f_NGROUP + + ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element + + do jcore = 1,carma%f_group(igroup)%f_ncore + + iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core element +! carma%f_nnucelem(iecore) = 0 + + do iefrom = 1,carma%f_NELEM + + if( carma%f_if_nuc(iefrom,iecore) ) then + carma%f_nnucelem(iecore) = carma%f_nnucelem(iecore) + 1 + carma%f_inucelem(carma%f_nnucelem(iecore),iecore) = iefrom + endif + enddo ! iefrom=1,NELEM + enddo ! jcore=1,ncore + enddo ! igroup=1,NGROUP + + + ! Now enumerate and count elements nucleating to particle concentration + ! (itype=I_INVOLATILE and itype=I_VOLATILE) and core second moment + ! (itype=I_COREMASS). Elements with itype = I_VOLATILE are special because all + ! nucleation sources for core elements in same group are also sources + ! for the itype = I_VOLATILE element. + do igroup = 1,carma%f_NGROUP + + ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element + im = carma%f_group(igroup)%f_imomelem ! target core second moment element + +! carma%f_nnucelem(ip) = 0 +! if( im .ne. 0 )then +! carma%f_nnucelem(im) = 0 +! endif + + do jcore = 1,carma%f_group(igroup)%f_ncore + + iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core mass element + + do jnucelem = 1,carma%f_nnucelem(iecore) ! elements nucleating to cores + + iefrom = carma%f_inucelem(jnucelem,iecore) ! source + + ! For particle concentration target elements, only count source elements + ! that are also particle concentrations. + carma%f_nnucelem(ip) = carma%f_nnucelem(ip) + 1 + carma%f_inucelem(carma%f_nnucelem(ip),ip) = carma%f_group(carma%f_element(iefrom)%f_igroup)%f_ienconc + + if( im .ne. 0 )then + carma%f_nnucelem(im) = carma%f_nnucelem(im) + 1 + carma%f_inucelem(carma%f_nnucelem(im),im) = iefrom + endif + enddo + enddo ! jcore=1,ncore + enddo ! igroup=1,NGROUP + + + ! Now enumerate and count nucleating bins. + do igroup = 1,carma%f_NGROUP ! target group + do ibin = 1,carma%f_NBIN ! target bin + do igfrom = 1,carma%f_NGROUP ! source group + + carma%f_nnucbin(igfrom,ibin,igroup) = 0 + + do ifrom = 1,carma%f_NBIN ! source bin + + if( carma%f_inuc2bin(ifrom,igfrom,igroup) .eq. ibin ) then + carma%f_nnucbin(igfrom,ibin,igroup) = carma%f_nnucbin(igfrom,ibin,igroup) + 1 + carma%f_inucbin(carma%f_nnucbin(igfrom,ibin,igroup),igfrom,ibin,igroup) = ifrom + endif + enddo + enddo ! igfrom=1,NGROUP + enddo ! ibin=1,NBIN=1,NGROUP + enddo ! igroup=1,NGROUP + + if (carma%f_do_print_init) then + + ! Report nucleation mapping arrays (should be 'write' stmts, of course) + + write(carma%f_LUNOPRT,*) ' ' + write(carma%f_LUNOPRT,*) 'Nucleation mapping arrays (setupnuc):' + write(carma%f_LUNOPRT,*) ' ' + write(carma%f_LUNOPRT,*) 'Elements mapping:' + + do ielem = 1,carma%f_NELEM + write(carma%f_LUNOPRT,*) 'ielem,nnucelem=',ielem,carma%f_nnucelem(ielem) + + if(carma%f_nnucelem(ielem) .gt. 0) then + do jfrom = 1,carma%f_nnucelem(ielem) + write(carma%f_LUNOPRT,*) 'jfrom,inucelem= ',jfrom,carma%f_inucelem(jfrom,ielem) + enddo + endif + enddo + + write(carma%f_LUNOPRT,*) ' ' + write(carma%f_LUNOPRT,*) 'Bin mapping:' + + do igfrom = 1,carma%f_NGROUP + do igroup = 1,carma%f_NGROUP + write(carma%f_LUNOPRT,*) ' ' + write(carma%f_LUNOPRT,*) 'Groups (from, to) = ', igfrom, igroup + + do ibin = 1,carma%f_NBIN + nnucb = carma%f_nnucbin(igfrom,ibin,igroup) + if(nnucb .eq. 0) write(carma%f_LUNOPRT,*) ' None for bin ',ibin + if(nnucb .gt. 0) then + write(carma%f_LUNOPRT,*) ' ibin,nnucbin=',ibin,nnucb + write(carma%f_LUNOPRT,*) ' inucbin=',(carma%f_inucbin(j,igfrom,ibin,igroup),j=1,nnucb) + endif + enddo + enddo + enddo + endif + + + ! Check that values are valid. + do ielem = 1, carma%f_NELEM + + if( carma%f_element(ielem)%f_isolute .gt. carma%f_NSOLUTE )then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of isolute > NSOLUTE' + rc = RC_ERROR + return + endif + + if( carma%f_ievp2elem(ielem) .gt. carma%f_NELEM )then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of ievp2elem > NELEM' + rc = RC_ERROR + return + endif + + ! Check that is consistent with . + if( carma%f_ievp2elem(ielem) .ne. 0 .and. carma%f_element(ielem)%f_itype .eq. I_COREMASS )then + if( carma%f_element(ielem)%f_isolute .ne. carma%f_element(carma%f_ievp2elem(ielem))%f_isolute)then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - isolute and ievp2elem are inconsistent' + rc = RC_ERROR + return + endif + endif + + ! Check that is consistent with . +! igas = carma%f_inucgas( carma%f_element(ielem)%f_igroup ) +! if( igas .ne. 0 )then +! if( carma%f_element(ielem)%f_itype .eq. I_COREMASS .and. carma%f_element(ielem)%f_isolute .eq. 0 )then +! if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - inucgas ne 0 but isolute eq 0' +! rc = RC_ERROR +! return +! endif +! endif + enddo + + do ielem = 1, carma%f_NELEM + if( carma%f_nnuc2elem(ielem) .gt. 0 ) then + do inuc2 = 1, carma%f_nnuc2elem(ielem) + if( carma%f_inuc2elem(inuc2,ielem) .gt. carma%f_NELEM )then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of inuc2elem > NELEM' + rc = RC_ERROR + return + endif + enddo + endif + enddo + + ! Particle grids are incompatible if there is no target bin with enough + ! mass to accomodate nucleated particle. + bad_grid = .false. + + do iefrom = 1,carma%f_NELEM ! source element + + igfrom = carma%f_element(iefrom)%f_igroup + neto = carma%f_nnuc2elem(iefrom) + + if( neto .gt. 0 )then + + do inuc2 = 1,neto + ieto = carma%f_inuc2elem(inuc2,iefrom) + igto = carma%f_element(ieto)%f_igroup + + do ifrom = 1,carma%f_NBIN ! source bin + if( carma%f_inuc2bin(ifrom,igfrom,igto) .eq. 0 )then + if (carma%f_do_print) write(carma%f_LUNOPRT,7) igfrom,ifrom,igto + bad_grid = .true. + endif + enddo + enddo + endif + enddo + + if( bad_grid )then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - incompatible grids for nucleation' + rc = RC_ERROR + return + endif + + if (carma%f_do_print_init) then + + ! Report some initialization values! + write(carma%f_LUNOPRT,5) + write(carma%f_LUNOPRT,1) 'inucgas ',(carma%f_inucgas(i),i=1,carma%f_NGROUP) + write(carma%f_LUNOPRT,1) 'inuc2elem',(carma%f_inuc2elem(1,i),i=1,carma%f_NELEM) + write(carma%f_LUNOPRT,1) 'ievp2elem',(carma%f_ievp2elem(i),i=1,carma%f_NELEM) + write(carma%f_LUNOPRT,1) 'isolute ',(carma%f_element(i)%f_isolute,i=1,carma%f_NELEM) + + do isol = 1,carma%f_NSOLUTE + write(carma%f_LUNOPRT,2) 'solute number ',isol + write(carma%f_LUNOPRT,3) 'solute name: ',carma%f_solute(isol)%f_name + write(carma%f_LUNOPRT,4) 'molecular weight',carma%f_solute(isol)%f_wtmol + write(carma%f_LUNOPRT,4) 'mass density ',carma%f_solute(isol)%f_rho + enddo + endif + + + ! Initialize indexes for the gases and check to make sure if H2SO4 is used + ! that it occurs after H2O. This is necessary for supersaturation calculations. + carma%f_igash2o = 0 + carma%f_igash2so4 = 0 + carma%f_igasso2 = 0 + + do igas = 1, carma%f_NGAS + if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2O) then + carma%f_igash2o = igas + else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2SO4) then + carma%f_igash2so4 = igas + else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_SO2) then + carma%f_igasso2 = igas + end if + end do + + if ((carma%f_igash2so4 /= 0) .and. (carma%f_igash2o > carma%f_igash2so4)) then + if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - H2O gas must come before H2SO4.' + rc = RC_ERROR + return + end if + + return + end subroutine CARMA_InitializeGrowth + + !! Calculate the optical properties for each particle bin at each of + !! the specified wavelengths. The optical properties include the + !! extinction efficiency, the single scattering albedo and the + !! asymmetry factor. + !! + !! NOTE: For these calculations, the particles are assumed to be spheres and + !! Mie code is used to calculate the optical properties. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeOptics(carma, rc) + type(carma_type), intent(inout) :: carma + integer, intent(out) :: rc + + integer :: igroup ! group index + integer :: iwave ! wavelength index + integer :: ibin ! bin index + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + + + ! Assume success. + rc = RC_OK + + ! Were any wavelengths specified? + do iwave = 1, carma%f_NWAVE + do igroup = 1, carma%f_NGROUP + + ! Should we calculate mie properties for this group? + if (carma%f_group(igroup)%f_do_mie) then + + do ibin = 1, carma%f_NBIN + + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: The miess does not converge over as broad a + ! range of input parameters as bhmie, but it can handle + ! coated spheres. + + call mie(carma, & + carma%f_group(igroup)%f_imiertn, & + carma%f_group(igroup)%f_r(ibin), & + carma%f_wave(iwave), & + carma%f_group(igroup)%f_refidx(iwave), & + Qext, & + Qsca, & + asym, & + rc) + + if (rc < RC_OK) then + if (carma%f_do_print) then + write(carma%f_LUNOPRT, *) "CARMA_InitializeOptics:: & + &Mie failed for (band, wavelength, group, bin)", & + iwave, carma%f_wave(iwave), igroup, ibin + end if + return + end if + + carma%f_group(igroup)%f_qext(iwave, ibin) = Qext + carma%f_group(igroup)%f_ssa(iwave, ibin) = Qsca / Qext + carma%f_group(igroup)%f_asym(iwave, ibin) = asym + + end do + end if + end do + end do + + return + end subroutine CARMA_InitializeOptics + + !! Perform initialization of variables related to thermodynamical calculations that + !! are not dependent on the model state. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeThermo(carma, rc) + type(carma_type), intent(inout) :: carma + integer, intent(out) :: rc + + ! Assume success. + rc = RC_OK + + return + end subroutine CARMA_InitializeThermo + + !! Perform initialization of variables related to vertical transport that are not dependent + !! on the model state. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeVertical(carma, rc, vf_const) + type(carma_type), intent(inout) :: carma + integer, intent(out) :: rc + real(kind=f), intent(in), optional :: vf_const + + ! Assume success. + rc = RC_OK + + ! Was a constant vertical velocity specified? + carma%f_ifall = 1 + carma%f_vf_const = 0._f + + if (present(vf_const)) then + if (vf_const /= 0._f) then + carma%f_ifall = 0 + carma%f_vf_const = vf_const + end if + end if + + ! Specify the boundary conditions for vertical transport. + carma%f_itbnd_pc = I_FIXED_CONC + carma%f_ibbnd_pc = I_FIXED_CONC + + return + end subroutine CARMA_InitializeVertical + + !! The routine should be called when the carma object is no longer needed. It deallocates + !! any memory allocations made by CARMA (during CARMA_Create()), and failure to call this + !!routine could result in memory leaks. + !! + !! @author Chuck Bardeen + !! @version May-2009 + !! + !! @see CARMA_Create + subroutine CARMA_Destroy(carma, rc) + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + + type(carma_type), intent(inout) :: carma + integer, intent(out) :: rc + + ! Local variables + integer :: ier + integer :: igroup + integer :: ielem + integer :: isolute + integer :: igas + + ! Assume success. + rc = RC_OK + + ! If allocated, deallocate all the variables that were allocated in the Create() method. + if (allocated(carma%f_group)) then + do igroup = 1, carma%f_NGROUP + call CARMAGROUP_Destroy(carma, igroup, rc) + if (rc < 0) return + end do + + deallocate( & + carma%f_group, & + carma%f_icoag, & + carma%f_inucgas, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating groups, status=", ier + rc = RC_ERROR + endif + endif + + if (allocated(carma%f_element)) then + do ielem = 1, carma%f_NELEM + call CARMAELEMENT_Destroy(carma, ielem, rc) + if (rc < RC_OK) return + end do + + deallocate( & + carma%f_element, & + carma%f_igrowgas, & + carma%f_inuc2elem, & + carma%f_inucproc, & + carma%f_ievp2elem, & + carma%f_nnuc2elem, & + carma%f_nnucelem, & + carma%f_inucelem, & + carma%f_if_nuc, & + carma%f_rlh_nuc, & + carma%f_icoagelem, & + carma%f_icoagelem_cm, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating elements, status=", ier + rc = RC_ERROR + endif + endif + + if (allocated(carma%f_inuc2bin)) then + deallocate( & + carma%f_inuc2bin, & + carma%f_ievp2bin, & + carma%f_nnucbin, & + carma%f_inucbin, & + carma%f_diffmass, & + carma%f_volx, & + carma%f_ilow, & + carma%f_jlow, & + carma%f_iup, & + carma%f_jup, & + carma%f_npairl, & + carma%f_npairu, & + carma%f_iglow, & + carma%f_jglow, & + carma%f_igup, & + carma%f_jgup, & + carma%f_kbin, & + carma%f_pkernel, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating bins, status=", ier + rc = RC_ERROR + endif + endif + + if (carma%f_NSOLUTE > 0) then + do isolute = 1, carma%f_NSOLUTE + call CARMASOLUTE_Destroy(carma, isolute, rc) + if (rc < RC_OK) return + end do + + if (allocated(carma%f_solute)) then + deallocate( & + carma%f_solute, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating solutes, status=", ier + rc = RC_ERROR + endif + endif + end if + + if (carma%f_NGAS > 0) then + do igas = 1, carma%f_NGAS + call CARMAGAS_Destroy(carma, igas, rc) + if (rc < RC_OK) return + end do + + if (allocated(carma%f_gas)) then + deallocate( & + carma%f_gas, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating gases, status=", ier + rc = RC_ERROR + endif + endif + end if + + if (carma%f_NWAVE > 0) then + if (allocated(carma%f_wave)) then + deallocate( & + carma%f_wave, & + carma%f_dwave, & + carma%f_do_wave_emit, & + stat=ier) + if(ier /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating wavelengths, status=", ier + rc = RC_ERROR + return + endif + endif + endif + + return + end subroutine CARMA_Destroy + + ! Configuration + + !! Add a coagulation process between two groups (igroup1 and igroup2), with the resulting + !! particle being in the destination group (igroup3). If ck0 is specifed, then a constant + !! coagulation kernel will be used. + subroutine CARMA_AddCoagulation(carma, igroup1, igroup2, igroup3, icollec, rc, ck0, grav_e_coll0) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup1 !! first source group + integer, intent(in) :: igroup2 !! second source group + integer, intent(in) :: igroup3 !! destination group + integer, intent(in) :: icollec !! collection technique [I_COLLEC_CONST | I_COLLEC_FUCHS | I_COLLEC_DATA] + integer, intent(out) :: rc !! return code, negative indicates failure + real(kind=f), intent(in), optional :: ck0 !! if specified, forces a constant coagulation kernel + real(kind=f), intent(in), optional :: grav_e_coll0 !! if icollec is I_COLLEC_CONST + !! the constant gravitational collection efficiency + + ! Assume success. + rc = RC_OK + + ! Make sure the groups exists. + if (igroup1 > carma%f_NGROUP) then + if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", & + igroup1, ") is larger than the number of groups (", carma%f_NGROUP, ")." + rc = RC_ERROR + return + end if + + if (igroup2 > carma%f_NGROUP) then + if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", & + igroup2, ") is larger than the number of groups (", carma%f_NGROUP, ")." + rc = RC_ERROR + return + end if + + if (igroup3 > carma%f_NGROUP) then + if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", & + igroup3, ") is larger than the number of groups (", carma%f_NGROUP, ")." + rc = RC_ERROR + return + end if + + ! Indicate that the groups coagulate together. + carma%f_icoag(igroup1, igroup2) = igroup3 + + ! If ck0 was specified, then we use a fixed coagulation rate of ck0. + if (present(ck0)) then + carma%f_ck0 = ck0 + carma%f_icoagop = I_COAGOP_CONST + else + carma%f_icoagop = I_COAGOP_CALC + end if + + ! What collection technique is specified. + if (icollec > I_COLLEC_DATA) then + if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed collection method (", & + icollec, ") is unknown." + rc = RC_ERROR + return + end if + + if (icollec == I_COLLEC_CONST) then + if (present(grav_e_coll0)) then + carma%f_grav_e_coll0 = grav_e_coll0 + else + if (carma%f_do_print) then + write(carma%f_LUNOPRT, *) "CARMA_AddCoagulation::& + &ERROR - A constant gravitational collection was requested, & + &but grav_e_coll0 was not provided." + end if + rc = RC_ERROR + return + end if + end if + + carma%f_icollec = icollec + + return + end subroutine CARMA_AddCoagulation + + !! Add a growth process between the element (ielem) and gas (igas) specifed. The element + !! and gas should have already been defined using CARMA_AddElement() and CARMA_AddGas(). + !! + !! NOTE: Each element can only have one volatile component. + !! + !! @author Chuck Bardeen + !! @version May-2009 + !! + !! @see CARMA_AddElement + !! @see CARMA_AddGas + subroutine CARMA_AddGrowth(carma, ielem, igas, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: ielem !! the element index + integer, intent(in) :: igas !! the gas index + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Assume success. + rc = RC_OK + + ! Make sure the element exists. + if (ielem > carma%f_NELEM) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", & + ielem, ") is larger than the number of elements (", carma%f_NELEM, ")." + rc = RC_ERROR + return + end if + + ! Make sure there are enough gases allocated. + if (igas > carma%f_NGAS) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed gas (", & + igas, ") is larger than the number of gases (", carma%f_NGAS, ")." + rc = RC_ERROR + return + end if + + ! If not already defined, indicate that the element can grow with the specified gas. + if (carma%f_igrowgas(ielem) /= 0) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", & + ielem, ") already has gas (", carma%f_igrowgas(ielem), ") condensing on it." + rc = RC_ERROR + return + else + carma%f_igrowgas(ielem) = igas + end if + + return + end subroutine CARMA_AddGrowth + + !! Add a nucleation process that nucleates one element (elemfrom) to another element (elemto) + !! using the specified gas (igas). The elements and gas should have already been defined + !! using CARMA_AddElement() and CARMA_AddGas(). The nucleation scheme is indicated by + !! inucproc, and can be one of: + !! + !! - I_DROPACT + !! - I_AERFREEZE + !! - I_DROPFREEZE + !! - I_ICEMELT + !! - I_HETNUC + !! - I_HOMNUC + !! + !! There are multiple parameterizations for I_AERFREEZE, so when that is selected the + !! particular parameterization needs to be indicated by adding it to I_AERFREEZE. The + !! specific routines are: + !! + !! - I_AF_TABAZADEH_2000 + !! - I_AF_KOOP_2000 + !! - I_AF_MOHLER_2010 + !! - I_AF_MURRAY_2010 + !! + !! One or more of these routines may be selected, but in general one of the first + !! three should be selected and then it can optionally be combined with the glassy + !! aerosols (I_AF_MURRAY_2010). + !! + !! Total evaporation transfers particle mass from the destination element back to the + !! element indicated by ievp2elem. This relationship is not automatically generated, + !! because multiple elements can nucleate to a particular element and therefore the + !! reverse mapping is not unique. + !! + !! NOTE: The gas used for nucleation must be the same for all nucleation defined from + !! elements of the same group. + !! + !! @author Chuck Bardeen + !! @version Feb-2009 + !! @see I_DROPACT + !! @see I_AERFREEZE + !! @see I_DROPFREEZE + !! @see I_ICEMELT + !! @see I_HETNUC + !! @see I_HOMNUC + !! @see I_AF_TABAZADEH_2000 + !! @see I_AF_KOOP_2000 + !! @see I_AF_MOHLER_2010 + !! @see I_AF_MURRAY_2010 + !! @see CARMA_AddElement + !! @see CARMA_AddGas + subroutine CARMA_AddNucleation(carma, ielemfrom, ielemto, inucproc, & + rlh_nuc, rc, igas, ievp2elem) + + use carmaelement_mod, only : CARMAELEMENT_Get + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: ielemfrom !! the source element + integer, intent(in) :: ielemto !! the destination element + integer, intent(in) :: inucproc !! the nucleation process + !! [I_DROPACT | I_AERFREEZE | I_ICEMELT | I_HETNUC | I_HOMNUC] + real(kind=f), intent(in) :: rlh_nuc !! the latent heat of nucleation [cm2/s2] + integer, intent(out) :: rc !! return code, negative indicated failure + integer, optional, intent(in) :: igas !! the gas + integer, optional, intent(in) :: ievp2elem !! the element created upon evaporation + + integer :: igroup !! group for source element + + ! Assume success. + rc = RC_OK + + ! Make sure the elements exist. + if (ielemfrom > carma%f_NELEM) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", & + ielemfrom, ") is larger than the number of elements (", carma%f_NELEM, ")." + rc = RC_ERROR + return + end if + + if (ielemto > carma%f_NELEM) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", & + ielemto, ") is larger than the number of elements (", carma%f_NELEM, ")." + rc = RC_ERROR + return + end if + + if (present(ievp2elem)) then + if (ievp2elem > carma%f_NELEM) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", & + ievp2elem, ") is larger than the number of elements (", carma%f_NELEM, ")." + rc = RC_ERROR + return + end if + end if + + + ! Make sure there are enough gases allocated. + if (present(igas)) then + if (igas > carma%f_NGAS) then + if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed gas (", & + igas, ") is larger than the number of gases (", carma%f_NGAS, ")." + rc = RC_ERROR + return + end if + end if + + + ! If aerosol freezing is selected, but no I_AF_xxx sub-method is selected, then indicate an error. + if (inucproc == I_AERFREEZE) then + if (carma%f_do_print) then + write(carma%f_LUNOPRT, *) "CARMA_AddNucleation::& + &ERROR - I_AERFREEZE was specified without an I_AF_xxx value." + end if + return + end if + + + ! Array maps a particle group to its associated gas for nucleation: + ! Nucleation from group is associated with gas + ! Set to zero if particles are not subject to nucleation. + if (present(igas)) then + call CARMAELEMENT_Get(carma, ielemfrom, rc, igroup=igroup) + + if (rc >= RC_OK) then + carma%f_inucgas(igroup) = igas + end if + end if + + + ! Nucleation transfers particle mass from element to element + ! , where ranges from 0 to the number of elements + ! nucleating from . +! carma%f_nnucelem(ielemto) = carma%f_nnucelem(ielemto) + 1 +! carma%f_inucelem(carma%f_nnucelem(ielemto), ielemto) = ielemfrom + carma%f_nnuc2elem(ielemfrom) = carma%f_nnuc2elem(ielemfrom) + 1 + carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom) = ielemto +! carma%f_if_nuc(ielemfrom,carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom)) = .true. + + ! specifies what nucleation process nucleates + ! particles from element to element : + ! I_DROPACT: Aerosol activation to droplets + ! I_AERFREEZE: Aerosol homogeneous freezing + ! I_DROPFREEZE: Droplet homogeneous freezing + ! I_GLFREEZE: Glassy Aerosol heteroogeneous freezing + ! I_GLAERFREEZE: Glassy & Aerosol freezing + carma%f_inucproc(ielemfrom, ielemto) = inucproc + + + ! Total evaporation mapping: total evaporation transfers particle mass from + ! element to element . + ! + ! NOTE: This array is not automatically derived from because multiple + ! elements can nucleate to a particular element (reverse mapping is not + ! unique). + if (present(ievp2elem)) carma%f_ievp2elem(ielemto) = ievp2elem + + + ! is the latent heat released by nucleation + ! from element to element [cm^2/s^2]. + carma%f_rlh_nuc(ielemfrom,ielemto) = rlh_nuc + + return + end subroutine + + + ! Query, Control and State I/O + + !! Gets the information about the carma object. + !! + !! @author Chuck Bardeen + !! @version May-2009 + !! + !! @see CARMA_Create + subroutine CARMA_Get(carma, rc, LUNOPRT, NBIN, NELEM, NGAS, NGROUP, NSOLUTE, NWAVE, do_detrain, & + do_drydep, do_fixedinit, do_grow, do_print, do_print_init, do_thermo, wave, dwave, do_wave_emit) + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + integer, optional, intent(out) :: NBIN !! number of radius bins per group + integer, optional, intent(out) :: NELEM !! total number of elements + integer, optional, intent(out) :: NGROUP !! total number of groups + integer, optional, intent(out) :: NSOLUTE !! total number of solutes + integer, optional, intent(out) :: NGAS !! total number of gases + integer, optional, intent(out) :: NWAVE !! number of wavelengths + integer, optional, intent(out) :: LUNOPRT !! logical unit number for output + logical, optional, intent(out) :: do_detrain !! do detrainement? + logical, optional, intent(out) :: do_drydep !! do dry deposition? + logical, optional, intent(out) :: do_fixedinit !! do initialization from reference atm? + logical, optional, intent(out) :: do_grow !! do condensational growth? + logical, optional, intent(out) :: do_print !! do print output? + logical, optional, intent(out) :: do_print_init !! do print initialization output? + logical, optional, intent(out) :: do_thermo !! do thermodynamics? + real(kind=f), optional, intent(out) :: wave(carma%f_NWAVE) !! the wavelengths centers (cm) + real(kind=f), optional, intent(out) :: dwave(carma%f_NWAVE) !! the wavelengths widths (cm) + logical, optional, intent(out) :: do_wave_emit(carma%f_NWAVE) !! do emission in this band? + + ! Assume success. + rc = RC_OK + + if (present(LUNOPRT)) LUNOPRT = carma%f_LUNOPRT + if (present(NBIN)) NBIN = carma%f_NBIN + if (present(NELEM)) NELEM = carma%f_NELEM + if (present(NGAS)) NGAS = carma%f_NGAS + if (present(NGROUP)) NGROUP = carma%f_NGROUP + if (present(NSOLUTE)) NSOLUTE = carma%f_NSOLUTE + if (present(NWAVE)) NWAVE = carma%f_NWAVE + + if (present(do_detrain)) do_detrain = carma%f_do_detrain + if (present(do_drydep)) do_drydep = carma%f_do_drydep + if (present(do_grow)) do_grow = carma%f_do_grow + if (present(do_fixedinit)) do_fixedinit = carma%f_do_fixedinit + if (present(do_print)) do_print = carma%f_do_print + if (present(do_print_init)) do_print_init = carma%f_do_print_init + if (present(do_thermo)) do_thermo = carma%f_do_thermo + + if (present(wave)) wave(:) = carma%f_wave(:) + if (present(dwave)) dwave(:) = carma%f_dwave(:) + if (present(do_wave_emit)) do_wave_emit(:) = carma%f_do_wave_emit(:) + + return + end subroutine CARMA_Get + +end module diff --git a/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..0c63fda25c --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/carma_model_flags_mod.F90 @@ -0,0 +1,82 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + character(len=256), public :: carma_mice_file = 'mice_warren2008.nc' ! name of the ice refractive index file + character(len=32), public :: carma_sulfate_method = "fixed" ! prescribed sulfate method + ! name of the dust erosion factor file + character(len=256), public :: carma_soilerosion_file = 'soil_erosion_factor_1x1_c120907.nc' + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_mice_file, carma_sulfate_method, carma_soilerosion_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_mice_file, len(carma_mice_file), mpichar, 0, mpicom) + call mpibcast(carma_sulfate_method, len(carma_sulfate_method), mpichar, 0, mpicom) + call mpibcast(carma_soilerosion_file, len(carma_soilerosion_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 new file mode 100644 index 0000000000..036e1ea977 --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 @@ -0,0 +1,2721 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has the following methods: +!! +!! - CARMA_DiagnoseBins() +!! - CARMA_DiagnoseBulk() +!! - CARMA_DefineModel() +!! - CARMA_Detrain() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. For diagnostic groups, there are +!! also routines that diagnose the mass in the bins of that group from the +!! parent model's state inforamtion and that calculate the tendency on the +!! parent model's state based upon changes in the bins. +!! +!! This cirrus cloud model allows CARMA bin microphysics to do the ice microphysics +!! while MG does the liquid microphysics. The MG microphysics here should not update +!! CLDICE or NUMICE, since those values will not be reflected in the CARMA ice +!! bins, which are the true state variables for ice. In this situation, CLDICE and +!! NUMICE are merely diagnostic variables available as input to the rest of CAM. +!! +!! The CARMA microphysics will run before MG and will handle: +!! - Detrainment (liquid and ice) +!! - Homogeneous ice nucleation (currently with prescribed sulfates) +!! - Heterogeneous ice nucleation (future) +!! - Bergeron process +!! - Melting of detrained ice +!! - Freezing of cloud drops +!! - Autoconversion (ice -> snow) +!! - Variable ice density (function of particle size) +!! - In-cloud values (dividing by cloud fraction) +!! +!! Some potential issues that are not currently handled by CARMA: +!! - collection of ice by snow +!! - aggregation of ice +!! - sub-grid vertical velocity for CARMA +!! - Goff & Gratch vs. Murphy & Koop vapor pressures +!! - Radiation using CARMA size distribution (each bin as tracer) +!! - Hallet-Mossop Process +!! +!! The following variables will have been set by CARMA: +!! - (S) CLDICE, (S) NUMICE +!! - (S) CLDLIQ, (S) NUMLIQ +!! - (S) T +!! - (P) TNDQSNOW, (P) TNDNSNOW +!! - (P) REICE +!! +!! Varaibles with an S will be in the physics_state and variables with a P are +!! parameters passed into the MG microphysics. +!! +!! The module carma_intr defines a few flags that indicate what portion of the +!! cloud microphysics is handled by CARMA: +!! +!! - carma_do_cldice - CARMA does ice clouds +!! - carma_do_cldliq - CARMA does liquid clouds +!! +!! NOTE: This model is still under development and is not intended to be released as +!! part of the standard CAM distribution. Please contact Chuck Bardeen at +!! bardeenc@ucar.edu if you are interested in using or deriving off of this +!! model. +!!--------------------------------------------------------------------------------- + + +!! Each realization of CARMA microphysics has its own version of this file. +!! +!! This model replaces the ice microphysics from the MG two-moment scheme with +!! a CARMA bin microphysics representation of the ice. The purpose of this +!! model is to provide a more detail description of the thin cirrus clouds that +!! form in the TTL and to investigate the impact of these clouds on radiative +!! forcing, troposphere-to-stratosphere transport, and control of water vapor +!! in the UT/LS. +!! +!! @version July-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_field, pbuf_get_index + use physconst, only: gravit + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 5 !! Number of particle groups + integer, public, parameter :: NELEM = 7 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 1 !! Number of particle solutes + integer, public, parameter :: NGAS = 1 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition + integer, public, parameter :: I_ICE = 2 !! ice + integer, public, parameter :: I_WATER = 3 !! water + integer, public, parameter :: I_DUST = 4 !! dust + + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_CRCN = 1 !! sulfate aerosol + integer, public, parameter :: I_GRP_CRDICE = 2 !! detrained ice + integer, public, parameter :: I_GRP_CRSICE = 3 !! in-situ ice + integer, public, parameter :: I_GRP_CRLIQ = 4 !! liquid drop + integer, public, parameter :: I_GRP_CRDUST = 5 !! dust + + integer, public, parameter :: I_ELEM_CRCN = 1 !! sulfate + integer, public, parameter :: I_ELEM_CRDICE = 2 !! detrained ice + integer, public, parameter :: I_ELEM_CRSICE = 3 !! in-situ ice + integer, public, parameter :: I_ELEM_CRCORE = 4 !! sulfate core + integer, public, parameter :: I_ELEM_CRDCOR = 5 !! dust core + integer, public, parameter :: I_ELEM_CRLIQ = 6 !! water vapor + integer, public, parameter :: I_ELEM_CRDUST = 7 !! water vapor + + integer, public, parameter :: I_SOL_CRH2SO4 = 1 !! sulfuric acid + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + + + ! From Morrison & Gettelman [2008] and micro_mg.F90 (formerly cldwat2m_micro.F90) + ! + ! NOTE: In the bin model, the bin boundaries are also important for determining the threshold, + ! since the whole bin is autoconverted if the threshold is less than the bin midpoint radius. + real(kind=f), public, parameter :: CAM_RHOCI = 0.5_f !! (g/cm3) MG bulk density for cloud ice + real(kind=f), public, parameter :: CAM_RHOSN = 0.1_f !! (g/cm3) MG bulk density for snow + + + ! Parameters and variabls that control the detrainment process. + integer, parameter :: NINTS_BINS = 10 !! number of steps to integrate bin fractions + integer, parameter :: NINTS_SNOW = 100 !! number of steps to integrate snow fractions + + + real(kind=f), parameter :: r_dliq_lnd = 8e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_lnd = 18e-4_f !! detrained liquid radius (cm) + real(kind=f), parameter :: r_dliq_ocn = 8e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_ocn = 14e-4_f !! detrained liquid radius (cm) +! real(kind=f), parameter :: r_dliq_ocn = 18e-4_f !! detrained liquid radius (cm) + + real(kind=f), parameter :: snow_max_d = 10000._f !! maximum diameter for snow integration (um) + +! integer, parameter :: MIN_DTEMP = -60 !! Miniumum detrainment temperature (C) + integer, parameter :: MIN_DTEMP = -90 !! Miniumum detrainment temperature (C) + integer, parameter :: NDTEMP = -MIN_DTEMP + 1 !! Number of detrainment temperature bins + +! character(len=12), parameter :: carma_dice_method = "mono" + real(kind=f), parameter :: dice_snow_reff_mono = 348e-4_f !! Effective Radius of snow for monodisperse detrainment (cm) + real(kind=f), parameter :: r_dice_mono = 25e-4_f !! detrained ice radius, monodisperse (cm) + real(kind=f), parameter :: dice_loss = 0.0_f !! detrained fraction lost to precipitation, mondisperse +! real(kind=f), parameter :: dice_loss = 0.004_f !! detrained fraction lost to precipitation, mondisperse + + + ! This distribution varies the size disribution as a function of temperature, with the + ! distribution biased toards larer particles at warm temperature and small particles at + ! cold temperatures. This fit is from eq. 7 of Heymsfield and Schmitt [2010]. The Jensen + ! fit used above is similar to the cold end of this range. + character(len=12), parameter :: carma_dice_method = "dist_hym2010" + + ! from eq 7 in Heymsefield & Schmitt [2010] (cm -1) +! real(kind=f), parameter :: dist_hym2010_alpha = 14.26_f !! alpha (stratiform) +! real(kind=f), parameter :: dist_hym2010_beta = -0.0538_f !! beta (stratiform) + real(kind=f), parameter :: dist_hym2010_alpha = 2.425_f !! alpha (convective) + real(kind=f), parameter :: dist_hym2010_beta = -0.088_f !! beta (convective) + + real(kind=f) :: dice_snow_rmass(NDTEMP) !! snow particle mass (kg) + real(kind=f) :: dice_snow_fraction(NDTEMP) !! detrained mass fraction, snow + real(kind=f) :: dice_bin_fraction(NBIN, NDTEMP) !! detrained mass fraction, ice bin + + logical, public, parameter :: carma_do_mass_check = .false. ! If .true. then CARMA will check for mass loss by CARMA + logical, public, parameter :: carma_do_mass_check2 = .false. ! If .true. then CARMA will check for mass loss + ! (internal steps, e.g. detrain, diagnoseBIns, ...) + logical, public, parameter :: carma_do_mass_check3 = .false. ! If .true. then CARMA will check for incoming mass loss + ! (CAM -> CARMA) + logical, public, parameter :: carma_do_mass_fix = .true. ! If .true. then CARMA will fix for mass loss + ! between cldice and ice bins + logical, public, parameter :: carma_do_print_fix = .false. ! If .true. then CARMA will print the value of the mass fix + + logical, public, parameter :: carma_do_initice = .true. ! If .true. then CARMA carma prognositic bins are set + ! from the bulk ice on the first timestep + logical, public, parameter :: carma_do_bulk_tend = .true. ! If .true. then update CAM bulk tendencies + logical, public, parameter :: carma_do_autosnow = .false. ! If .true. then the largest ice bin is autoconverted + ! to snow at the end of the timestep. + + integer :: ixcldice + integer :: ixnumice + integer :: ixcldliq + integer :: ixnumliq + + integer :: warren_nwave ! number of wavelengths in file + real(r8), allocatable, dimension(:) :: warren_wave ! Warren & Brandt 2008, wavelengths + real(r8), allocatable, dimension(:) :: warren_real ! Warren & Brandt 2008, real part of m + real(r8), allocatable, dimension(:) :: warren_imag ! Warren & Brandt 2008, imag part of m + + real(kind=f), parameter :: rClay = 1e-4_f !! silt/clay particle radius boundary (cm) + + integer :: nClay !! Number of clay bins (r < 1 um) + integer :: nSilt !! Number of silt bins + real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use physconst, only: latice, latvap + use ioFileMod, only: getfil + use wrap_nf + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: rmin_ice = 5.e-5_f ! min radius for ice bins (cm) + real(kind=f), parameter :: rmin_cn = 1.e-7_f ! min radius for sulfate bins (cm) + real(kind=f), parameter :: RHO_CN = 1.78_f ! density of sulfate particles (g/cm) + real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), parameter :: rmin_dust = 1.19e-5_f ! minimum radius (cm) +! real(kind=f), parameter :: vmrat_dust = 2.371_f ! volume ratio + real(kind=f), parameter :: vmrat_dust = 1.588_f ! volume ratio + real(kind=f) :: rmassmin ! mass of the first radius bin (g) + real(kind=f) :: vmrat ! volume ratio between adjacent bin + real(kind=f) :: rhoelem(NBIN) ! element density per bin (g/cm3) + real(kind=f) :: arat(NBIN) ! projected area ratio + integer :: maxbin ! the bin number of the largest prognostic ice bin + integer :: i + integer :: j + real(kind=f) :: wave(NWAVE) ! CAM band wavelength centers (cm) + integer :: fid + integer :: wave_did + integer :: wave_vid + integer :: real_vid + integer :: imag_vid + character(len=256) :: efile ! refractive index file name + real(kind=f) :: interp + complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) + write(LUNOPRT,*) ' carma_sulfate_method = ', trim(carma_sulfate_method) + end if + end if + + ! Get the refractive index for ice as a function of wavelength for particle heating + ! calculations. + ! + ! NOTE: These values probably should be a band average, but for now just do band centers. + + ! Read the values in from Warren et al. 2008. + if (carma_do_pheat) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_mice_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "wavelength", wave_did) + call wrap_inq_dimlen(fid, wave_did, warren_nwave) + endif + +#if ( defined SPMD ) + call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) +#endif + + allocate(warren_wave(warren_nwave)) + allocate(warren_real(warren_nwave)) + allocate(warren_imag(warren_nwave)) + + if (masterproc) then + + ! Read in the tables. + call wrap_inq_varid(fid, 'wavelength', wave_vid) + call wrap_get_var_realx(fid, wave_vid, warren_wave) + warren_wave = warren_wave * 1e-4 ! um -> cm + + call wrap_inq_varid(fid, 'm_real', real_vid) + call wrap_get_var_realx(fid, real_vid, warren_real) + + call wrap_inq_varid(fid, 'm_imag', imag_vid) + call wrap_get_var_realx(fid, imag_vid, warren_imag) + + ! Close the file. + call wrap_close(fid) + end if + +#if ( defined SPMD ) + call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) +#endif + + ! Interpolate the values. + do i = 1, NWAVE + do j = 1, warren_nwave + if (wave(i) <= warren_wave(j)) then + if ((j > 1) .and. (wave(i) /= warren_wave(j))) then + interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) + refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1)),kind=f) + else + refidx_ice(i) = cmplx(warren_real(j), warren_imag(j),kind=f) + endif + + exit + end if + end do + end do + end if + + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + rmassmin = (4._f / 3._f) * PI * (rmin_cn ** 3) * RHO_CN +! vmrat = 4.0_f ! For 16 bins +! vmrat = 2.8_f ! For 21 bins + vmrat = 2.16_f ! For 28 bins +! vmrat = 2.0_f ! For 32 bins + + ! Since these sulfates are prescribed, don't sediment them. This will save some + ! processing time. + call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, vmrat, I_SPHERE, 1._f, .false., & + rc, shortname="CRCN", rmassmin=rmassmin, do_mie=.false., & + cnsttype=I_CNSTTYPE_DIAGNOSTIC, do_vtran=.false.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + ! NOTE: For freezing and melting, the ice and water bins need to have the same mass. + rmassmin = (4._f / 3._f) * PI * (rmin_ice ** 3) * RHO_I + vmrat = 2.055_f ! For 28 bins, Heysmfield Ice Density, cold + + ! If doing autoconversion of ice to snow, then the last bin will always be zero and + ! there is no point making it an advected constituent. + if (carma_do_autosnow) then + maxbin = NBIN-1 + else + maxbin = NBIN + end if + + ! Make the aged detrained ice have a variable density to represent the complex set of + ! possible shapes that we can't represent. This is based upon Heymsfield and + ! Westfield [2010] and Heysfield and Schmitt [2010]. + call CARMAGROUP_Create(carma, I_GRP_CRDICE, "Detrained Ice, Aged", rmin_ice, vmrat, I_SPHERE, 1._f, .true., & + rc, shortname="CRDICE", rmassmin=rmassmin, do_mie=carma_do_pheat, refidx=refidx_ice, & + ifallrtn=I_FALLRTN_HEYMSFIELD2010, imiertn=I_MIERTN_BOHREN1983, is_cloud=.true., maxbin=maxbin) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(2) = .true. + + ! Make the in-situ ice a plate, AR=6. This is based upon observations from Lawson + ! et al. [2008]. AR=6 is for larger particles, so AR=3 is a compromise that is + ! part way between that and more spheroidal particles that are likely at smaller sizes. + ! + ! NOTE: All cloud particles should be convectively transported in the first phase of + ! convection. + ! + ! NOTE: All ice particles have the last bin as the one that gets autoconverted to + ! snow at the end of the timestep and thus it does not need to be a prognostic bin. +! call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_SPHERE, 1._f, .true., & +! call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_HEXAGON, 1._f / 6._f, .true., & + call CARMAGROUP_Create(carma, I_GRP_CRSICE, "In-situ Ice", rmin_ice, vmrat, I_HEXAGON, 1._f / 3._f, .true., & + rc, shortname="CRSICE", rmassmin=rmassmin, do_mie=carma_do_pheat, refidx=refidx_ice, & + ifallrtn=I_FALLRTN_HEYMSFIELD2010, imiertn=I_MIERTN_BOHREN1983, & + is_cloud=(.not. carma_do_clearsky), maxbin=maxbin) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(3) = .true. + + ! Water drops are spherical. + call CARMAGROUP_Create(carma, I_GRP_CRLIQ, "Water Drop", rmin_ice, vmrat, I_SPHERE, 1._f, .false., & + rc, shortname="CRLIQ", rmassmin=rmassmin, do_mie=.false., & + cnsttype=I_CNSTTYPE_DIAGNOSTIC, is_cloud=.true., do_vtran=.false.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(4) = .true. + + ! Dust. + rmassmin = (4._f / 3._f) * PI * (rmin_dust ** 3) * RHO_DUST + call CARMAGROUP_Create(carma, I_GRP_CRDUST, "Dust", rmin_dust, vmrat_dust, I_SPHERE, 1._f, .false., & + rc, shortname="CRDUST", rmassmin=rmassmin, do_mie=.false., & + do_vtran=.true.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + is_convtran1(5) = .false. + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_CRCN, I_GRP_CRCN, "Sulfate CN", RHO_CN, & + I_INVOLATILE, I_H2SO4, rc, shortname="CRCN", isolute=I_SOL_CRH2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + ! The density of ice is changed based on the maximum dimensions of ice particles + ! as a function of mass from Heymsfield and Schmitt [2010]. +! call rhoice_heymsfield2010(carma, RHO_I, I_GRP_CRDICE, "conv", rhoelem, arat, rc) + call rhoice_heymsfield2010(carma, RHO_I, I_GRP_CRDICE, "warm", rhoelem, arat, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::rhoice_heymsfield2010 failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRDICE, I_GRP_CRDICE, "Detrained Ice", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRDICE", rhobin=rhoelem, arat=arat) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRSICE, I_GRP_CRSICE, "In-situ Ice", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRSICE") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRSICE, "Core Mass", RHO_CN, & + I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=I_SOL_CRH2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRDCOR, I_GRP_CRSICE, "Dust Core", RHO_DUST, & + I_COREMASS, I_DUST, rc, shortname="CRDCOR") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRLIQ, I_GRP_CRLIQ, "Water Drop", RHO_W, & + I_VOLATILE, I_WATER, rc, shortname="CRLIQ") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + call CARMAELEMENT_Create(carma, I_ELEM_CRDUST, I_GRP_CRDUST, "Dust", RHO_DUST, & + I_INVOLATILE, I_DUST, rc, shortname="CRDUST") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + + ! Define the Solutes + call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, & + 98._f, 1.38_f, rc, shortname="CRH2SO4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & + I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + + ! Detrained Ice, Aged + call CARMA_AddGrowth(carma, I_ELEM_CRDICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRDICE, I_ELEM_CRLIQ, I_ICEMELT, & + -latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_CRDICE, I_GRP_CRDICE, I_GRP_CRDICE, & + I_COLLEC_DATA, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + ! In-Situ Ice + call CARMA_AddGrowth(carma, I_ELEM_CRSICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + ! NOTE: For now, assume the latent heat for nucleation is the latent of of fusion of + ! water, using the CAM constant (scaled from J/kg to erg/g). + ! + ! NOTE: Since the sulfates are not seen as part of the water/energy budget in CAM, don't + ! include any latent heat from the freezing of the sulfate liquid. The latent heat of + ! the gas associated with nucleation is accounted for. + call CARMA_AddNucleation(carma, 1, 4, I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=1, ievp2elem=1) +! call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & +! I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) +! call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & +! I_AERFREEZE + I_AF_KOOP_2000 + I_AF_MURRAY_2010, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRDUST, I_ELEM_CRDCOR, I_HETNUC, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRDUST) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRSICE, I_ELEM_CRLIQ, I_ICEMELT, -latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_CRSICE, I_GRP_CRSICE, I_GRP_CRSICE, I_COLLEC_DATA, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + ! Water Drop + call CARMA_AddGrowth(carma, I_ELEM_CRLIQ, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_CRLIQ, I_ELEM_CRDICE, I_DROPFREEZE, latice*1e4_f, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + real(kind=f) :: t(pver) ! temperature (K) + real(kind=f) :: mmr_ice(NBIN, pver) ! ice mass mixing ratio (kg/kg) + real(kind=f) :: mmr_liq(NBIN, pver) ! liquid mass mixing ratio (kg/kg) + real(kind=f) :: r_ice(NBIN) ! ice radius bins (cm) + real(kind=f) :: r_liq(NBIN) ! liquid radius bins (cm) + + real(kind=f) :: ice_fraction ! fraction of detrained condensate that is ice + real(kind=f) :: mass_liq ! detrainment rate of liquid (kg/kg/s) + real(kind=f) :: mass_ice ! detrainment rate of ice (kg/kg/s) + real(kind=f) :: mass_snow ! detrainment rate of snow (kg/kg/s) + real(kind=f) :: mass_dlf ! detrained mass (m/s) + integer :: k ! vertical index + integer :: ibin ! bin index + integer :: itemp ! termperature index + + real(r8) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(r8) :: snowNumber(pver) ! snow number (#/kg) + real(r8) :: snowSurface ! snow on surface (kg/m2) + real(r8) :: waterMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: waterNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: rainSurface ! rain on surface (kg/m2) + real(r8) :: newSnow ! snow mass (kg) + real(r8) :: newRain ! rain mass mass (kg) + + logical :: do_thermo ! do thermodynamics? + + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_thermo=do_thermo) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMA_Get failed.') + + ! Put all of the detraining cloud water from convection into the large scale cloud. + ! put detraining cloud water into liq and ice based on temperature partition + call CARMAGROUP_Get(carma, I_GRP_CRDICE, rc, r=r_ice(:)) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_Get failed.') + + call CARMAGROUP_Get(carma, I_GRP_CRLIQ, rc, r=r_liq(:)) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_Get failed.') + + ! Account for the reserved ice that is being detrained in the precipitation. +! prec_str(icol) = prec_str(icol) - rliq(icol) +! rliq(icol) = 0._f + + call CARMASTATE_GetState(cstate, rc, t=t) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAGROUP_GetState failed.') + + ! Determine the amount of detrainment that could be used to saturate the + ! atmosphere with respect to liquid. For GCM scales, assume that three things + ! happen to detrained condensate: + ! + ! 1) large particles will fallout as snow or rain + ! 2) will be converted to vapor + ! 3) will remain as ice + ! + ! Because of the large scales of the GCM and because this is a stratiform + ! parameterization, a lot of the condensate that hasn't fallen out will + ! increase the humidity (i.e. detrained anvil evaporates or falls out entirely + ! with 100 km of the convection). + mmr_ice(:, :) = 0._f + mmr_liq(:, :) = 0._f + + do k = 1,pver + + ! Remove amount being detrained from rliq and prec_str. + mass_dlf = dlf(icol, k) * (state%pdel(icol, k) / gravit) / 1000._f + prec_str(icol) = prec_str(icol) - mass_dlf + rliq(icol) = rliq(icol) - mass_dlf + + + if (t(k) > 268.15_f) then + ice_fraction = 0.0_f + else if (t(k) < 238.15_f) then + ice_fraction = 1.0_f + else + ice_fraction = (268.15_f - t(k)) / 30._f + end if + + itemp = max(-max(MIN_DTEMP, nint(t(k) - T0)), 0) + 1 + + mass_liq = dlf(icol, k) * (1._f - ice_fraction) + mass_ice = dlf(icol, k) * ice_fraction * (1._f - dice_snow_fraction(itemp)) + mass_snow = dlf(icol, k) * ice_fraction * dice_snow_fraction(itemp) + + ! Calculate the detrainment of ice and liquid into the appropriate CARMA + ! bins. + ! + ! Scale the size based on whether the surface is land or ocean. This + ! assumes that there are more aerosols over land, reducing the detrainment + ! size. This is similar to the c0_lnd and c0_ocn parameter split done in + ! the convective parameterization. + ! + ! NOTE: This should really be tied to aerosol amount, not land fraction. + do ibin = 1, NBIN + + ! Assume detrained cloud water is monodisperse. + if (r_liq(ibin) >= r_dliq_ocn) then + mmr_liq(ibin, k) = mmr_liq(ibin, k) + (mass_liq * dt) * (1._f - cam_in%landfrac(icol)) + exit + end if + end do + + do ibin = 1, NBIN + + ! Assume detrained cloud water is monodisperse. + if (r_liq(ibin) >= r_dliq_lnd) then + + mmr_liq(ibin, k) = mmr_liq(ibin, k) + (mass_liq * dt) * cam_in%landfrac(icol) + exit + end if + end do + + ! Detrain cloud ice into the bins according to the predefined distribution. + do ibin = 1, NBIN + + ! Detrain using a size distribution (log-normal in mass). The table has + ! already bin setup during initialization indicating the fraction of the mass + ! that goes into each bin. + ! + ! NOTE: Since snow has already been removed, but was part of the fractions + ! in the bins, scale the bin fractions so that it sums to 1. + mmr_ice(ibin, k) = mmr_ice(ibin, k) + dice_bin_fraction(ibin, itemp) * (mass_ice * dt) + end do + + ! The large portion of the distribution can go directly to snow, + ! since it is too big to be represented in the bin strucutre. + tnd_qsnow(icol, k) = mass_snow + tnd_nsnow(icol, k) = mass_snow / dice_snow_rmass(itemp) + + rliq(icol) = rliq(icol) + mass_snow * (state%pdel(icol, k) / gravit) / 1000._f + + ! Account for latent heat release during freezing. By default the detrained + ! condensate is assumed to be liquid for energy balance. + t(k) = t(k) + ((mass_ice + mass_snow) * latice * dt / cpair) + end do + + + do ibin = 1, NBIN + call CARMASTATE_SetDetrain(cstate, I_ELEM_CRLIQ, ibin, mmr_liq(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAState_SetBin failed.') + + + call CARMASTATE_SetDetrain(cstate, I_ELEM_CRDICE, ibin, mmr_ice(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMAState_SetBin failed.') + end do + + + if (do_thermo) then + call CARMASTATE_SetState(cstate, rc, t(:)) + end if + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check2) then + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + + call CARMA_CheckMassAndEnergy(carma, cstate, .false., "CARMA_Detrain", state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + end if + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mu(pver) ! spectral width parameter of droplet size distr + real(r8) :: lambda(pver) ! slope of cloud liquid size distr + real(r8) :: mmr(NBIN,pver) ! elements mass mixing ratio + + real(kind=f) :: r(NBIN) ! bin mean radius + real(kind=f) :: dr(NBIN) ! bin radius width + real(kind=f) :: rmass(NBIN) ! bin mass + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: k ! vertical index + + real(r8) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(r8) :: snowNumber(pver) ! snow number (#/kg) + real(r8) :: snowSurface ! snow on surface (kg/m2) + real(r8) :: carma_ice ! total cldice from CARMA bins (kg/kg) + real(r8) :: waterMass(pver) ! ice mass mixing ratio (kg/kg) + real(r8) :: waterNumber(pver) ! ice number mixing ratio (#/kg) + real(r8) :: rainSurface ! rain on surface (kg/m2) + real(r8) :: carma_water ! total cldliq from CARMA bins (kg/kg) + real(r8) :: diff + + ! Aerosol size distribution + real(r8), parameter :: n = 100._r8 ! concentration (cm-3) + real(r8), parameter :: r0 = 2.5e-6_r8 ! mean radius (cm) + real(r8), parameter :: rsig = 1.5_r8 ! distribution width + + real(r8) :: arg1(NBIN) + real(r8) :: arg2(NBIN) + real(r8) :: rhop(NBIN) ! particle mass density (kg/m3) + real(r8) :: totalrhop ! total particle mass density (kg/m3) + real(kind=f) :: rhoa_wet(pver) ! air density (g/cm3) + + real(r8) :: rliq_new(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + + integer :: LUNOPRT + logical :: do_print + real(r8) :: lat + real(r8) :: lon + + real(r8), pointer, dimension(:, :) :: sulf ! last saturation wrt ice + integer :: lchnk ! chunk identifier + integer :: itim + + character(len=8) :: c_name ! constituent name + + + 1 format(/,'CARMA_DiagnoseBins::ERROR - CAM ice mass conservation error, icol=',i4,', iz=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e17.10,',carma=',e17.10,',rer=',e10.3) + 2 format(/,'CARMA_DiagnoseBins::ERROR - CAM liquid mass conservation error, icol=',i4,', iz=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e17.10,',carma=',e17.10,',rer=',e10.3) + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + + ! Get the air density. + call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') + + + ! Aerosols + ! + igroup = 1 + ielem = 1 + + ! Use a fixed aerosols distribution. + if ((carma_sulfate_method == "fixed") .or. (carma_sulfate_method == "bulk")) then + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) + arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) + + ! kg/m3 + rhop(:) = arg1(:) * exp(arg2(:)) * rmass(:) * 1e6_f / 1e3_f + + + if (carma_sulfate_method == "bulk") then + totalrhop = sum(rhop(:)) + + ! Get the index for the prescribed sulfates. This gives the mmr that should be + ! present at this location. Use this to scale the size distribution that CARMA + ! will generate. + lchnk = state%lchnk + itim = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, pbuf_get_index('sulf'), sulf, (/1,1,itim/),(/pcols,pver,1/)) + end if + end if + + do ibin = 1, NBIN + + ! Use a fixed mixing ration. + if (carma_sulfate_method == "fixed") then + mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) + end if + + + ! Since bulk aerosols don't have a size distribution, use the fixed + ! distribution for the shape of the distribution, but scale the total + ! mass to the prescribed value. + if (carma_sulfate_method == "bulk") then + mmr(ibin, :) = rhop(ibin) / totalrhop * sulf(icol, :) + end if + + ! Use the CRCNxx fields from a special prescribed aerosol file that has + ! results from a CARMA simulation of sulfates. This will set the magnitude + ! and the size distribution. + if (carma_sulfate_method == "carma") then + ! Get the index for the prescribed sulfates. + lchnk = state%lchnk + itim = pbuf_old_tim_idx() + write(c_name, '(A, I2.2)') "CRCN", ibin + + call pbuf_get_field(pbuf, pbuf_get_index(c_name), sulf, (/1,1,itim/),(/pcols,pver,1/)) + mmr(ibin, :) = sulf(icol, :) + end if + + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + end do + + + ! Cloud Ice & Snow + ! + ! Cloud ice is maintained in advected species in CARMA, and we are only + ! concerned with snow production by CARMA. + ! + ! NOTE: To allow this code to be tested when not doing the cloud ice, but + ! either doing nothing or doing detrainment, use the ice properties to convert + ! from the 2 moment values to a size distribution. + ! + ! NOTE: To keep mass and energy conservation happy, on the first step when + ! camra_do_cldice is true, we take the bulk values and convert them + ! into bins; however, this might cause issues with the CARMA growth code. + if ((.not. carma_do_cldice) .or. (is_first_step() .and. carma_do_initice)) then + igroup = I_GRP_CRDICE + ielem = I_ELEM_CRDICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + ! Need to determine the shape parameters for the size distribution. It + ! would be nice if these routines came from the MG microphysics module, + ! but until then their code with be duplicated here. + call CARMA_GetGammaParmsForIce(carma, state%q(icol, :, ixcldice), & + state%q(icol, :, ixnumice), rhoa_wet(:), mu(:), lambda(:), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetGammaParmsForIce failed.') + + call CARMA_GetMmrFromGamma(carma, r(:), dr(:), rmass(:), & + state%q(icol, :, ixcldice), state%q(icol, :, ixnumice), mu(:), & + lambda(:), mmr(:, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetMmrFromGamma failed.') + + do ibin = 1, NBIN + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBulk::CARMASTATE_SetBin failed.') + end do + else + + ! If CARMA is keeping track of ice, then total up the detrained and in-situ ice to + ! make sure that no one else has meesed with the ice fields. If changes were made, + ! then adjustments need to be made to the totals to prevent mass and energy conservation + ! errors within CAM. The difference could be accounted for in snow_str and prec_str. + ! + ! NOTE: Advection, diffusion, ... may have affected the tracer values since the + ! previous time step, however, the tracer correlations need to remain intact for + ! CARMA to work properly. Also, no special processing can occur on the cldice fields + ! outside of CARMA, since they are merely diagnostic fields of the CARMA state. + if (carma_do_mass_check3 .or. carma_do_mass_fix) then + + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalIceAndSnow failed.') + + do k = 1, pver + + ! NOTE: CAM resets cloud ice less than 1e-36 to 0 in physics_update, so ignore values smaller + ! than that. + carma_ice = iceMass(k) + snowMass(k) + if (carma_ice < 1e-36_r8) then + carma_ice = 0._r8 + end if + + if (carma_ice /= state%q(icol, k, ixcldice)) then + + if (carma_do_mass_check3) then + if (abs(carma_ice - state%q(icol, k, ixcldice)) / max(abs(carma_ice), & + abs(state%q(icol, k, ixcldice))) >= 1e-10_r8) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,1) icol, k, lat, lon, state%q(icol, k, ixcldice), & + carma_ice, (carma_ice - state%q(icol, k, ixcldice)) / max(abs(carma_ice), & + abs(state%q(icol, k, ixcldice))) + + write(LUNOPRT,*) " CAM cldice : ", state%q(icol, k, ixcldice) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " CARMA cldice : ", iceMass(k) + snowMass(k) + write(LUNOPRT,*) " CARMA ice : ", iceMass(k) + write(LUNOPRT,*) " CARMA snow : ", snowMass(k) + end if + end if + end if + + if (carma_do_mass_fix) then + + diff = (state%q(icol, k, ixcldice) - (iceMass(k) + snowMass(k))) * (state%pdel(icol, k) / gravit) / dt / 1000._r8 + + snow_str(icol) = snow_str(icol) + diff + prec_str(icol) = prec_str(icol) + diff + + if (carma_do_print_fix) then + if (do_print) then + write(LUNOPRT,*) " CARMA_DiagnoseBins::& + &WARNING - Adjusting prec_str for ice mass difference", & + icol, k, (state%q(icol, k, ixcldice) - (iceMass(k) + snowMass(k))) + end if + end if + end if + end if + end do + end if + end if + + + ! Water Drops + ! + ! Use the CAM mass and number (CLDLIQ and NUMLIQ) to determine an initial + ! size distribution. + igroup = I_GRP_CRLIQ + ielem = I_ELEM_CRLIQ + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + ! Need to determine the shape parameters for the size distribution. It + ! would be nice if these routines came from the MG microphysics module, + ! but until then their code with be duplicated here. + call CARMA_GetGammaParmsForLiq(carma, state%q(icol, :, ixcldliq), state%q(icol, :, ixnumliq), & + rhoa_wet(:), mu(:), lambda(:), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetGammaParmsForLiq failed.') + + call CARMA_GetMmrFromGamma(carma, r(:), dr(:), rmass(:), state%q(icol, :, ixcldliq), & + state%q(icol, :, ixnumliq), mu(:), lambda(:), mmr(:, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetMmrFromGamma failed.') + + do ibin = 1, NBIN + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_SetBin failed.') + end do + + + if (carma_do_mass_check2 .or. carma_do_mass_check3) then + + ! Check to see of the mass that we get back adds up. + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalWaterAndRain failed.') + + + if (carma_do_mass_check3) then + do k = 1, pver + + carma_water = waterMass(k) + if (carma_water < 1e-38_r8) then + carma_water = 0._r8 + end if + + ! The routine that provides the modal properties for water has a miniumum of 1e-18. + ! This causes problems in comparisons, since smaller qc values are seen in the data, + ! but CARMA's bins won't have values that small. + if (carma_water /= state%q(icol, k, ixcldliq)) then + if (abs(carma_water - state%q(icol, k, ixcldliq)) / max(abs(carma_water), & + abs(state%q(icol, k, ixcldliq))) >= 1e-10_r8) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,2) icol, k, lat, lon, state%q(icol, k, ixcldliq), & + carma_water, (carma_water - state%q(icol, k, ixcldliq)) / max(abs(carma_water), & + abs(state%q(icol, k, ixcldliq))) + + write(LUNOPRT,*) " CAM cldliq : ", state%q(icol, k, ixcldliq) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " CARMA cldliq : ", waterMass(k) + end if + end if + end if + end do + end if + + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check2) then + call CARMA_GetTotalIceAndSnow(carma, cstate, .false., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_GetTotalIceAndSnow failed.') + + ! The detrained ice is not include yet, so ignore rliq. + rliq_new(:) = 0._f + call CARMA_CheckMassAndEnergy(carma, cstate, .false., "CARMA_DiagnoseBins", state, & + icol, dt, rliq_new, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMA_CheckMassAndEnergy failed.') + end if + end if + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! These values are chosen to match up with how small cloud ice values are handled in + ! micro_mg. + real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: omsm = 0.99999_r8 ! Prevents roundoff errors + + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: icore ! core index + integer :: icorelem(NELEM) ! core indexes for group + integer :: ncore ! number of core elements + integer :: itim + + real(kind=f) :: iceMass(pver) ! ice mass mixing ratio (kg/kg) + real(kind=f) :: iceNumber(pver) ! ice number mixing ratio (#/kg) + real(kind=f) :: snowMass(pver) ! snow mass mixing ratio (kg/kg) + real(kind=f) :: snowNumber(pver) ! snow number (#/kg) + real(kind=f) :: snowSurface ! snow on surface (kg/m2) + real(kind=f) :: waterMass(pver) ! water mass mixing ratio (kg/kg) + real(kind=f) :: waterNumber(pver) ! water number mixing ratio (#/kg) + real(kind=f) :: rainSurface ! rain on surface (kg/m2) + real(kind=f) :: iceRe(pver) ! ice effective radius (m) + + real(r8) :: newRain ! [Total] sfc flux of rain from stratiform (m/s) + real(r8) :: newSnow ! [Total] sfc flux of snow from stratiform (m/s) + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: mmrcore(pver) ! core mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: r(NBIN) ! radius (cm) + real(kind=f) :: sfc ! surface mass (kg/m2) + real(kind=f) :: sfccore ! core surface mass (kg/m2) + + + ! Default return code. + rc = RC_OK + + + ! Aerosols + ! + ! Currently, we are just using a fixed aerosol size distribution, but in the + ! future this could be linked to the model aerosols. + + + ! Cloud Ice & Snow + ! + ! Determine the changes to cloud ice (mass and number) and snow (mass and number) + ! by looking at the totals if the detrained and in-situ ice. + ! + ! Ice particles in the largest bin are treated as snow rather than ice. + + ! Get the total ice. + call CARMA_GetTotalIceAndSnow(carma, cstate, .true., iceMass, iceNumber, snowMass, snowNumber, snowSurface, rc, iceRe=iceRe) + + ! Calculate the tendencies on CLDICE, NUMICE, QSNOW and NSNOW + if (carma_do_bulk_tend) then + + ptend%q(icol, :, ixcldice) = (iceMass(:) - state%q(icol, :, ixcldice)) / dt + ptend%q(icol, :, ixnumice) = ((iceNumber(:) - state%q(icol, :, ixnumice)) / dt) + + where(iceMass(:) < qsmall) + ptend%q(icol, :, ixcldice) = (-state%q(icol, :, ixcldice)) / dt + ptend%q(icol, :, ixnumice) = (-state%q(icol, :, ixnumice)) / dt + end where + + ! Snow is not a constituent, so write this information into the physics buffer. + tnd_qsnow(icol, :) = tnd_qsnow(icol, :) + snowMass(:) / dt + tnd_nsnow(icol, :) = tnd_nsnow(icol, :) + snowNumber(:) / dt + + ! Now we need to change the reserve liquid. This was indicating the amount of + ! water than was not in the atmosphere because it was in convection (dlf). Now + ! we have included that water, but we have removed water representing snow in + ! the atmosphere. This needs to be communicated to the CAM microphysics which + ! will take care of actually precipitating or evaporating the snow. + rliq(icol) = rliq(icol) + sum(snowMass(:) * (state%pdel(icol, :) / gravit)) / dt / 1000._r8 + + ! The ice effective radius is used by the radiation code; however, it uses a mass + ! weighted effective diameter in um. + re_ice(icol, :) = iceRe + end if + + + ! Water Drops + ! + ! Calcualte the total mass and total number of the water drops, and then + ! determine the appropriate tendencies. + call CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + + ! Calculate the tendencies on CLDLIQ and NUMLIQ + if (carma_do_bulk_tend) then + + ! In CAM in cldwat2m, a couple of things are done: + ! + ! 1) If cldliq < qsmall, then the number desnity is set to 0. + ! 2) to keep from overshooting into negative values, they don't try to drive + ! the value all the way to 0. + ptend%q(icol, :, ixcldliq) = (waterMass(:) - state%q(icol, :, ixcldliq)) / dt + + ptend%q(icol, :, ixnumliq) = (waterNumber(:) - state%q(icol, :, ixnumliq)) / dt + + where(waterMass(:) < qsmall) + ptend%q(icol, :, ixnumliq) = (-state%q(icol, :, ixnumliq)) / dt + end where + end if + + + ! For mass balance, we also need to supply the total precipation and snow. Not + ! all of the snow may make the ground, but that will be determined later in the + ! MG microphysics. For now, we need to account for all condensate that is not + ! in CLDICE or CLDLIQ. + ! + ! Need the 1000. to convert from kg/m2/s to m/s + newSnow = snowSurface + newRain = rainSurface + + snow_sed(icol) = snow_sed(icol) + newSnow / dt / 1000._r8 + prec_sed(icol) = prec_sed(icol) + (newRain + newSnow) / dt / 1000._r8 + + snow_str(icol) = snow_str(icol) + newSnow / dt / 1000._r8 + prec_str(icol) = prec_str(icol) + (newRain + newSnow) / dt / 1000._r8 + + ! Check for total water conservation by CARMA. + if (carma_do_mass_check) then + + ! The CAM state has not been updated yet, so compare the original CAM state + ! with the new CARMA state. + call CARMA_CheckMassAndEnergy(carma, cstate, .true., "CARMA_DiagnoseBulk", state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + end if + + return + end subroutine CARMA_DiagnoseBulk + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: cnst_get_ind, pcnst + use cam_history, only: addfld, horiz_only + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ibin ! bin index + integer :: i + integer :: itemp ! temperature index + integer :: LUNOPRT + + logical :: do_print_init + logical :: do_grow + logical :: do_detrain + logical :: do_thermo + logical :: do_print + + real(kind=f) :: r(NBIN) ! bin center radius (cm) + real(kind=f) :: dr(NBIN) ! bin width (cm) + real(kind=f) :: rmass(NBIN) ! bin mass (g) + real(kind=f) :: sub_d ! integration substep diameter (um) + real(kind=f) :: sub_dd ! integration substep width (um) + real(kind=f) :: snow_d ! starting snow diameter (um) + real(kind=f) :: nsnow ! number of snow particles (um) + real(kind=f) :: snow_r3 ! snow N*r^3 (um^3) + real(kind=f) :: snow_r2 ! snow N*r^3 (um^2) + real(kind=f) :: snow_reff(NDTEMP) ! snow effective radius (cm) + real(kind=f) :: eshape ! particle aspect ratio (> 0 is prolate) + real(kind=f) :: shapeFactor ! shape factor for maximum radius + real(kind=f) :: remainder + real(kind=f) :: lambda ! fit factor for H&S 2010 size distribution + real(kind=f) :: temp ! temperature (C) + + integer :: count_Silt ! count number for Silt + integer :: igroup ! the index of the carma aerosol group + integer :: ielem ! the index of the carma aerosol element + character(len=32) :: shortname ! the shortname of the element + + + ! Default return code. + rc = 0 + + call CARMA_Get(carma, rc, do_print_init=do_print_init, LUNOPRT=LUNOPRT, & + do_grow=do_grow, do_detrain=do_detrain, do_thermo=do_thermo) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + ! Lookup indices to other constituents that are needed. + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMICE', ixnumice) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('NUMLIQ', ixnumliq) + + ! Add the CAM ice and liquid fields as some that could be modified by CARMA. + lq_carma(ixcldice) = .true. + lq_carma(ixnumice) = .true. + lq_carma(ixcldliq) = .true. + lq_carma(ixnumliq) = .true. + + if (do_print_init) then + write(LUNOPRT,*) "" + write(LUNOPRT,*) "Initializing CARMA Detrainment" + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Using ice method = ", carma_dice_method + end if + + ! For detrainment of ice, setup the fractions of ice that go into each bin and + ! into snow. This can be done different ways: + ! + ! - monodisperse + ! - temperature dependent size distribution + ! + ! In any of these, a fraction of the ice can go directly to snow, rather than + ! going into bins first. + ! + ! Puts all of the detraining cloud water from convection into the large scale cloud, + ! and puts detraining cloud water into liquid and ice based on temperature partition + call CARMAGROUP_Get(carma, I_GRP_CRDICE, rc, r=r(:), dr=dr(:), eshape=eshape, rmass=rmass(:)) + if (rc < RC_OK) call endrun('CARMA_InitializeModel::CARMAGROUP_Get failed.') + + ! This size distribution in based upon the maximum diameter, so the ice particles have + ! a shape then pass the largest dimension to the size distribution. + ! + ! NOTE: This is assuming the shape is a spheroid. Should consider passing shape + ! parameters out of setupvfall, so that f1 is available for this. + if (eshape >= 1._f) then + shapeFactor = eshape**(1._f / 3._f) + else + shapeFactor = eshape**(- 1._f / 3._f) + end if + + dice_bin_fraction(:, :) = 0._f + dice_snow_fraction(:) = 0._f + dice_snow_rmass(:) = 0._f + + + ! Heymsfield & Schmitt [2010] tmeperature dependent distribution + if (carma_dice_method == "dist_hym2010") then + + ! Integrate over the defined temperaure range. + do itemp = 1, NDTEMP + + temp = 1._f - itemp + + ! Determine the exponentianal factor of the number distribution from H&S eq. 7. + lambda = dist_hym2010_alpha * exp(temp * dist_hym2010_beta) + + ! Determine a mass distribution using from a size distribution using this + ! lambda. The number distribution is N = N0 * exp(-lambda * D), with D in + ! cm from H&S eq. 1. Since this is just to generate a PDF, just use an N0 + ! of 1. + ! + ! NOTE: This mass distribution (dMdD) is based on the diameter in cm. + do ibin = 1, NBIN + + ! Determine the fraction in each bin. + ! + ! NOTE: The bins are wide realtive to this function, so sum over an interval + sub_dd = 2._f * dr(ibin) * shapeFactor + sub_d = 2._f * r(ibin) * shapeFactor + + dice_bin_fraction(ibin, itemp) = dice_bin_fraction(ibin, itemp) + & + rmass(ibin) / lambda * & + (exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f)))) + end do + + ! Integrate to determine how much mass exits outside of the bins. + ! Now integrate the snow distribution. We know the snow amount, but need an effective radius + ! to determine the snow number. + sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor + sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_d = sub_d + sub_dd / 2._f + + remainder = 0._f + + do i = 1, NINTS_SNOW + + ! Determine the number. + ! + ! NOTE: Use the unscaled diameter and assume a sphere to get the volume of the particle. + nsnow = exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f))) * sub_dd + + ! Assume density from Heymsfield & Schmitt [2010]. This assumes that: + ! + ! m = aD^2.1 + ! + ! NOTE: This needs to match the density assumption made in the detrained ice bins. + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + + sub_d = sub_d + sub_dd + end do + + ! The sum of the integral may not be exactly 1, so scale the total so as not to skew + ! the amount going straight to snow. + dice_bin_fraction(:, itemp) = dice_bin_fraction(:, itemp) / (sum(dice_bin_fraction(:, itemp)) + remainder) + + + ! Now integrate the snow distribution. We know the snow amount, but need an effective radius + ! to determine the snow number. + snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) + sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_d = snow_d + (sub_dd / 2._f) + + snow_r3 = 0._f + snow_r2 = 0._f + + do i = 1, NINTS_SNOW + + ! Determine the number. + ! + ! NOTE: Use the unscaled diameter and assume a sphere to get the volume of the particle. + nsnow = exp(-lambda * (sub_d - (sub_dd / 2._f))) - exp(-lambda * (sub_d + (sub_dd / 2._f))) * sub_dd + + snow_r3 = snow_r3 + nsnow / lambda * (sub_d / 2._f)**3 + snow_r2 = snow_r2 + nsnow / lambda * (sub_d / 2._f)**2 + + sub_d = sub_d + sub_dd + end do + + if (snow_r2 <= 0._f) then + snow_reff(itemp) = 0.1_f + else + snow_reff(itemp) = snow_r3 / snow_r2 + end if + + ! If autoconversion is on then, detrain directly to snow. Otherwise, add the extra + ! mass to the largest bin. + if (carma_do_autosnow) then + dice_snow_fraction(itemp) = 1._f - sum(dice_bin_fraction(:, itemp)) + else + dice_snow_fraction(itemp) = 0._f + dice_bin_fraction(NBIN, itemp) = dice_bin_fraction(NBIN, itemp) + 1._f - sum(dice_bin_fraction(:, itemp)) + end if + + ! The sum of the integral may not be exactly 1, so scale the total so as not to skew + ! the amount going straight to snow. + dice_bin_fraction(:, itemp) = dice_bin_fraction(:, itemp) / sum(dice_bin_fraction(:, itemp)) + end do + + ! Default to monodisperse + else + + do ibin = 1, NBIN + if (r(ibin) >= r_dice_mono) then + dice_bin_fraction(ibin, :) = 1._f - dice_loss + + exit + end if + end do + + dice_snow_fraction(:) = 1._f - sum(dice_bin_fraction(:, 1)) + snow_reff(:) = dice_snow_reff_mono + end if + + + ! Determine the amount that goes into snow. + dice_snow_rmass(:) = 4._f / 3._f * PI * (snow_reff(:)**3) * CAM_RHOSN / 1e3_f + + if (do_print_init) then + do itemp = 1, NDTEMP, 10 + + if ((itemp == 1) .or. (carma_dice_method == "dist_hym2010")) then + + if (carma_dice_method == "dist_hym2010") then + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Temperature = ", 1 - itemp, " C" + write(LUNOPRT,*) "" + end if + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " ibin r (um) fraction" + + do ibin = 1, NBIN + write(LUNOPRT,*) ibin, r(ibin)*1e4_f, dice_bin_fraction(ibin, itemp) + end do + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Total fractions" + write(LUNOPRT,*) " ice = ", 1._f - dice_snow_fraction(itemp) + write(LUNOPRT,*) " snow = ", dice_snow_fraction(itemp) + + write(LUNOPRT,*) "" + write(LUNOPRT,*) " Snow" + write(LUNOPRT,*) " min_r (um) = ", snow_d / 2._f + write(LUNOPRT,*) " rmass (kg) = ", dice_snow_rmass(itemp) + write(LUNOPRT,*) " reff (um) = ", snow_reff(itemp)*1e4_f + write(LUNOPRT,*) "" + end if + end do + end if + + ! Log a warning message if doing growth or detrainment and not doing + ! thermodynamics. This will cause an energy error to be reported by CAM. + if ((do_grow .or. do_detrain) .and. .not. do_thermo) then + if (do_print_init) then + write(LUNOPRT,*) "CARMA_InitializeModel:& + &WARNING - do_grow and/or do_detrain are selected without & + &do_thermo which may result in energy conservation errors." + end if + end if + + ! Determine how many clay and how many silt bins there are, based + ! upon the bin definitions and rClay. + ! + ! TBD: This should us the radii rather than being hard coded. + ! nClay = 8 + ! nSilt = NBIN - nClay + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + count_Silt = 0 + do ibin = 1, NBIN + if (r(ibin) >= rclay) then + count_Silt = count_Silt + 1 + else + end if + end do + nSilt = count_Silt + nClay = NBIN - nSilt + end if + end do + + ! Read in the soil factors. + call CARMA_ReadSoilErosionFactor(carma, rc) + if (RC < RC_ERROR) return + + ! To determine Clay Mass Fraction + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + call CARMA_ClayMassFraction(carma, igroup, rc) + end if + end do + + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) then + write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' + write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor + + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' + end if + end if + + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') + + return + end subroutine CARMA_InitializeModel + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use phys_grid, only: get_lon_all_p, get_lat_all_p + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat(pcols) ! latitude index + integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + character(len=32) :: shortname ! the shortname of the group + + ! -------- local variables added for dust model ------------ + real(r8), parameter :: ch = 0.5e-9_r8 ! dimensional factor & tuning number, + ! as it's model resolution dependent (kgs^2/m^5)!!! + real(r8) :: r(NBIN) ! bin center (cm) + real(r8) :: uth ! threshold wind velocity (m/s) + + real(r8) :: uv10 ! 10 m wind speed (m/s) + real(r8) :: cd10 ! 10-m drag coefficient () + real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: sp ! mass fraction for soil factor + integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay + real(r8) :: soilfact(pcols) ! soil erosion factor (for debug) + + ! Default return code. + rc = RC_OK + + ! Determine the latitude and longitude of each column. + lchnk = state%lchnk + ncol = state%ncol + + call get_lat_all_p(lchnk, ncol, ilat) + call get_lon_all_p(lchnk, ncol, ilon) + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + + ! Is this clay or silt? + ! + ! NOTE: It is assumed that 90% of the mass will be silt and 10% will + ! be clay. + ! + ! NOTE: For clay bins, use the smallest silt bin to calculate the + ! mass and then scale that into each clay bin based upon interpolation of + ! Tegen and Lacis [1996]. + if (r(ibin) >= rClay) then + sp = 0.9_r8 / nSilt + idustbin = ibin + else + sp = 0.1_r8 / nClay + idustbin = nClay + 1 + end if + + ! Process each column. + do icol = 1,ncol + + call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + ! Is the wind above the threshold for dust production? + if (uv10 > uth) then + surfaceFlux(icol) = ch * soil_factor(ilat(icol), ilon(icol)) * sp * & + wwd * (uv10 - uth) + endif + + ! Scale the clay bins based upon the smallest silt bin. + surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) + + ! Save off the soil erosion factor so it can be output. + soilfact(icol) = soil_factor(ilat(icol), ilon(icol)) + end do + + ! For debug purposes, output the soil erosion factor. + call outfld('CRSLERFC', soilfact, pcols, lchnk) + end if + + return + end subroutine CARMA_EmitParticle + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + return + end subroutine CARMA_InitializeParticle + + + !! This routine is used to determine the shape parameters (pgam and lamc) for + !! cloud ice. + !! + !! This code is taken from cldwat2m.F90, and ideally, there would be a routine + !! in the cldwat2m module available for this purpose rather than duplicating the + !! code and the parameters here. + subroutine CARMA_GetGammaParmsForIce(carma, qiic, niic, rho, pgam, lami, rc) + use shr_spfn_mod, only : gamma => shr_spfn_gamma + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + real(r8), intent(in) :: qiic(pver) !! in-cloud cloud liquid mixing ratio + real(r8), intent(in) :: niic(pver) !! in-cloud droplet number conc + real(r8), intent(in) :: rho(pver) !! air density (kg m-3) + real(r8), intent(out) :: pgam(pver) !! spectral width parameter of droplet size distr + real(r8), intent(out) :: lami(pver) !! slope of cloud liquid size distr + integer, intent(out) :: rc !! return code, negative indicates failure + + + real(r8), parameter :: qsmall = 1.e-36_r8 ! min mixing ratio +! real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: pi = 3.1415927_r8 + real(r8), parameter :: dcs = 250.e-6_r8 ! autoconversion size threshold for cloud ice to snow (m) + real(r8), parameter :: rhoi = 500._r8 ! bulk density ice + + ! cloud ice mass-diameter relationship + real(r8), parameter :: ci = rhoi*pi/6._r8 + real(r8), parameter :: di = 3._r8 + + integer :: k + real(r8) :: n0i(pver) ! intercept of cloud ice size distr + real(r8) :: lammax ! maximum allowed slope of size distr + real(r8) :: lammin ! minimum allowed slope of size distr + real(r8) :: nc(pver) ! in-cloud droplet number conc + + + ! Default return code. + rc = RC_OK + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get size distribution parameters based on in-cloud cloud water/ice + ! these calculations also ensure consistency between number and mixing ratio + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! NOTE: For ice, pgam is assumed to be 0. + pgam(:) = 0._r8 + + ! check for slope + lammax = 1._r8/10.e-6_r8 + lammin = 1._r8/(2._r8*dcs) + + do k = 1, pver + + if (qiic(k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + nc(k)=min(niic(k),qiic(k)*1.e20_r8) + + lami(k) = (gamma(1._r8+di)*ci*nc(k)/qiic(k))**(1._r8/di) + n0i(k) = nc(k)*lami(k) + + ! adjust vars + if (lami(k).lt.lammin) then + + lami(k) = lammin + n0i(k) = lami(k)**(di+1._r8)*qiic(k)/(ci*gamma(1._r8+di)) + nc(k) = n0i(k)/lami(k) + else if (lami(k).gt.lammax) then + lami(k) = lammax + n0i(k) = lami(k)**(di+1._r8)*qiic(k)/(ci*gamma(1._r8+di)) + nc(k) = n0i(k)/lami(k) + end if + else + lami(k) = 0._r8 + n0i(k) = 0._r8 + end if + end do + + return + end subroutine CARMA_GetGammaParmsForIce + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + + + !! This routine is used to determine the shape parameters (pgam and lamc) for + !! cloud water. + !! + !! This code is taken from cldwat2m.F90, and ideally, there would be a routine + !! in the cldwat2m module available for this purpose rather than duplicating the + !! code and the parameters here. + subroutine CARMA_GetGammaParmsForLiq(carma, qcic, ncic, rho, pgam, lamc, rc) + use shr_spfn_mod, only : gamma => shr_spfn_gamma + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + real(r8), intent(in) :: qcic(pver) !! in-cloud cloud liquid mixing ratio + real(r8), intent(in) :: ncic(pver) !! in-cloud droplet number conc + real(r8), intent(in) :: rho(pver) !! air density (kg m-3) + real(r8), intent(out) :: pgam(pver) !! spectral width parameter of droplet size distr + real(r8), intent(out) :: lamc(pver) !! slope of cloud liquid size distr + integer, intent(out) :: rc !! return code, negative indicates failure + + + real(r8), parameter :: rhow = 1000._r8 ! bulk density liquid (kg/m3) +! real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: qsmall = 1.e-36_r8 ! min mixing ratio + real(r8), parameter :: pi = 3.1415927_r8 + real(r8), parameter :: cdnl = 0.e6_r8 ! cloud droplet number limiter + + integer :: k + real(r8) :: n0c(pver) ! intercept of cloud liquid size distr + real(r8) :: lams(pver) ! slope of snow size distr + real(r8) :: n0s(pver) ! intercept of snow size distr + real(r8) :: lamr(pver) ! slope of rain size distr + real(r8) :: n0r(pver) ! intercept of rain size distr + real(r8) :: lammax ! maximum allowed slope of size distr + real(r8) :: lammin ! minimum allowed slope of size distr + real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing + real(r8) :: nc(pver) ! in-cloud droplet number conc + + + ! Default return code. + rc = RC_OK + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get size distribution parameters based on in-cloud cloud water/ice + ! these calculations also ensure consistency between number and mixing ratio + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + do k = 1, pver + + if (qcic(k).ge.qsmall) then + + ! add upper limit to in-cloud number concentration to prevent numerical error + nc(k) = min(ncic(k),qcic(k)*1.e20_r8) + nc(k)=max(nc(k),cdnl/rho(k)) ! sghan minimum in #/cm + + ! get pgam from fit to observations of martin et al. 1994 + pgam(k) = 0.0005714_r8*(nc(k)/1.e6_r8*rho(k))+0.2714_r8 + pgam(k) = 1._r8/(pgam(k)**2)-1._r8 + pgam(k) = max(pgam(k),2._r8) + pgam(k) = min(pgam(k),15._r8) + + ! calculate lamc + lamc(k) = (pi/6._r8*rhow*nc(k)*gamma(pgam(k)+4._r8) / & + (qcic(k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8) + + ! lammin, 50 micron diameter max mean size + lammin = (pgam(k)+1._r8)/50.e-6_r8 + lammax = (pgam(k)+1._r8)/2.e-6_r8 + + if (lamc(k).lt.lammin) then + lamc(k) = lammin + nc(k) = 6._r8*lamc(k)**3*qcic(k)* & + gamma(pgam(k)+1._r8)/ & + (pi*rhow*gamma(pgam(k)+4._r8)) + else if (lamc(k).gt.lammax) then + lamc(k) = lammax + nc(k) = 6._r8*lamc(k)**3*qcic(k)* & + gamma(pgam(k)+1._r8)/ & + (pi*rhow*gamma(pgam(k)+4._r8)) + end if + + ! parameter to calculate droplet freezing + cdist1(k) = nc(k)/gamma(pgam(k)+1._r8) + + else + pgam(k) = 0._r8 + lamc(k) = 0._r8 + cdist1(k) = 0._r8 + end if + end do + + return + end subroutine CARMA_GetGammaParmsForLiq + + + ! Using the specified parameters for the gamma distribution, determine the mass mixing ratio of particles + subroutine CARMA_GetMmrFromGamma(carma, r, dr, rmass, qic, nic, mu, lambda, mmr, rc) + use shr_spfn_mod, only : gamma => shr_spfn_gamma + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + real(kind=f), intent(in) :: r(NBIN) !! bin mean radius + real(kind=f), intent(in) :: dr(NBIN) !! bin radius width + real(kind=f), intent(in) :: rmass(NBIN) !! bin mass + real(r8), intent(in) :: qic(pver) !! in-cloud cloud liquid mixing ratio + real(r8), intent(in) :: nic(pver) !! in-cloud droplet number conc + real(r8), intent(in) :: mu(pver) !! spectral width parameter of droplet size distr + real(r8), intent(in) :: lambda(pver) !! slope of cloud liquid size distr + real(r8), intent(out) :: mmr(NBIN,pver) !! elements mass mixing ratio + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: k ! z index + integer :: ibin ! bin index + real(kind=f) :: totalMass ! mmr of all particles (kg/kg) + real(kind=f) :: n ! number of particles (#/kg) + real(kind=f) :: n0 ! number parameter for gamma distribution + real(kind=f) :: d(NBIN) ! bin diameter (m) + real(kind=f) :: dd(NBIN) ! diameter width of bin (m) + +! real(r8), parameter :: qsmall = 1.e-18_r8 ! min mixing ratio + real(r8), parameter :: qsmall = 1.e-36_r8 ! min mixing ratio + + + ! Default return code. + rc = RC_OK + + ! Their equations are in terms of diameter (in m) + d(:) = 2._r8 * r(:) * 1e-2_r8 + dd(:) = 2._r8 * dr(:) * 1e-2_r8 + + do k = 1, pver + + ! From Morisson & Gettelman [2008] and cldwat2m + ! + ! If there is a small mass, then ther are no particles. + if (qic(k) < qsmall) then + mmr(:, k) = 0._r8 + else + n0 = (nic(k) * (lambda(k) ** (mu(k) + 1._r8)) / (gamma(mu(k) + 1._r8))) + + + ! Iterate over the bins. + ! + ! NOTE: Just the functional fit can go negative for some bins with larger diameter, but this is not physical. + do ibin = 1, NBIN + n = n0 * (d(ibin)**mu(k)) * exp(-lambda(k) * d(ibin)) * dd(ibin) + mmr(ibin, k) = n * rmass(ibin) * 1e-3_r8 + end do + + ! Adjust the number density so that we don't create mass. This will adjust for + ! problems fitting the size distribution and for differences in the assumptions + ! of the bulk density of the particles. + totalMass = sum(mmr(:, k)) + if (totalMass /= 0._r8) then + mmr(:, k) = mmr(:, k) * (qic(k) / totalMass) + else + mmr(:, k) = 0._r8 + end if + end if + end do + + return + end subroutine CARMA_GetMmrFromGamma + + + !! Detemrine the total cloud ice concentration and number stored in the bins that represent + !! water within the CARMA model. + !! + !! For snow, it is assumed that the largest ice bin in the in situ and detrained ice are + !! snow. The mass of these bins is the same, but the dimensions are different since there + !! are different shape assumptions for the different types. + !! + !! @version Nov-2009 + !! @author Chuck Bardeen + subroutine CARMA_GetTotalIceAndSnow(carma, cstate, makeSnow, iceMass, iceNumber, & + snowMass, snowNumber, snowSurface, rc, iceRe) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + logical, intent(in) :: makeSnow !! should bins be changed because of snow? + real(kind=f), intent(out) :: iceMass(pver) !! ice mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: iceNumber(pver) !! ice number mixing ratio (#/kg) + real(kind=f), intent(out) :: snowMass(pver) !! snow mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: snowNumber(pver) !! snow number (#/kg) + real(kind=f), intent(out) :: snowSurface !! snow on surface (kg/m2) + integer, intent(out) :: rc !! return code, negative indicates failure + real(kind=f), intent(out), optional :: iceRe(pver) !! ice effective radius (m) + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + integer :: iz ! vertical index + integer :: icore ! core index + integer :: icorelem(NELEM) ! core indexes for group + integer :: ncore ! number of core elements + integer :: maxbin ! maximum prognostic bin + + real(kind=f) :: coreMass(pver) ! core mass mixing ratio (kg/kg) + real(kind=f) :: coreSurface ! core on surface (kg/kg) + + real(kind=f) :: newSnow ! [Total] sfc flux of snow from stratiform (m/s) + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: mmrcore(pver) ! core mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: r(NBIN) ! radius (cm) + real(kind=f) :: rmass(NBIN) ! mass (g) + real(kind=f) :: rrat(NBIN) ! particle maximum radius ratio () + real(kind=f) :: arat(NBIN) ! particle area ration () + real(kind=f) :: sfc ! surface mass (kg/m2) + real(kind=f) :: sfccore ! core surface mass (kg/m2) + real(kind=f) :: nd(pver) ! number density (#/cm3) + real(kind=f) :: pa(pver) ! projected area (cm2) + real(kind=f) :: md(pver) ! mass density (g/cm3) + + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + iceMass(:) = 0._f + iceNumber(:) = 0._f + snowMass(:) = 0._f + snowNumber(:) = 0._f + snowSurface = 0._f + pa(:) = 0._f + md(:) = 0._f + + if (present(iceRe)) iceRe(:) = 0._f + + + ! Detrained Ice, Aged + igroup = I_GRP_CRDICE + ielem = I_ELEM_CRDICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, rmass=rmass, arat=arat, rrat=rrat, maxbin=maxbin) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc, numberDensity=nd) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + else + iceMass(:) = iceMass(:) + mmr(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + + ! NOTE: This is following the definition of Dave Mitchell for effective diameter, + ! Mitchell [2002], which indicates it needs to be scaled based on the effective + ! ice density. + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of snow. + snowSurface = snowSurface + sfc + end do + + + ! Detrained Ice, Fresh + + do ibin = 1, NBIN + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc, nmr=nmr, numberDensity=nd) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetDetrain(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + else + iceMass(:) = iceMass(:) + mmr(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + end do + + + ! In-situ ice. + igroup = I_GRP_CRSICE + ielem = I_ELEM_CRSICE + + call CARMAGROUP_Get(carma, igroup, rc, r=r, ncore=ncore, icorelem=icorelem, arat=arat, rrat=rrat, maxbin=maxbin) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc, numberDensity=nd) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBulk::CARMASTATE_GetBin failed.') + + ! Determine how much of the mmr is related to core mass. This needs to + ! be subtracted to get the amount of water in the ice. + coreMass(:) = 0.0_f + coreSurface = 0.0_f + + do icore = 1, ncore + call CARMASTATE_GetBin(cstate, icorelem(icore), ibin, mmrcore, rc, surface=sfccore) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_GetBin failed.') + + coreMass(:) = coreMass(:) + mmrcore(:) + coreSurface = coreSurface + sfccore + end do + + ! The core mass can't be more than the particle mass. If so, this indicates + ! that are problem happened, perhaps during advection and the particle masses + ! should be ignored. This should never happen from CARMA itself. + if (carma_do_mass_fix) then + do iz = 1, pver + + if (coreMass(iz) > mmr(iz)) then + if (carma_do_mass_fix) then + + if (carma_do_print_fix .and. do_print) write(LUNOPRT,*) & + " GetTotalIceAndSnow::WARNING - Adjusting particle for core mass error", & + iz, ielem, ibin, mmr(iz), coreMass(iz) + + ! It is hard to know what the right fix should be. You could reset + ! the particle mass to the coremass, but this will create lots of + ! small particles. It may be safer just to zero out both the particle + ! count and all of the core masses, assuming that this is a particle + ! that was created by diffusion in the transport and shouldn't really exist. + mmr(iz) = coreMass(iz) + end if + end if + end do + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end if + + ! Only calculate snow if CARMA is responsible for the cloud ice. + if (carma_do_cldice .and. carma_do_autosnow .and. (ibin > maxbin)) then + snowMass(:) = snowMass(:) + mmr(:) - coreMass(:) + snowNumber(:) = snowNumber(:) + nmr(:) + + if (makeSnow) then + + ! This ice is now snow, so zero it out in the ice bins. + mmr(:) = 0._f + + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + + ! Also zero out the core mass. + ! + ! In the future, you could try to keep track of the mass of the cores + ! in the snow and communicate that to CAM. + do icore = 1, ncore + call CARMASTATE_SetBin(cstate, icorelem(icore), ibin, mmr, rc) + if (rc < RC_OK) call endrun('GetTotalIceAndSnow::CARMASTATE_SetBin failed.') + end do + end if + else + iceMass(:) = iceMass(:) + mmr(:) - coreMass(:) + iceNumber(:) = iceNumber(:) + nmr(:) + + where (nd(:) > SMALL_PC) + pa(:) = pa(:) + nd(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) + md(:) = md(:) + nd(:) * rmass(ibin) + end where + end if + + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of snow. + snowSurface = snowSurface + sfc - sfccore + + + ! Calculate the effective radius (total volume / total area). + ! NOTE: cm -> m. + if (present(iceRe)) then + where (pa(:) > 0.0_r8) + iceRe(:) = (3._f / 4._f) * (md(:) / (0.917_f * pa(:))) * 1e-2_f + end where + + end if + end do + + return + end subroutine CARMA_GetTotalIceAndSnow + + + !! Detemrine the total cloud water concentration and number stored in the bins that represent + !! water within the CARMA model. + !! + !! @version Nov-2009 + !! @author Chuck Bardeen + subroutine CARMA_GetTotalWaterAndRain(carma, cstate, waterMass, waterNumber, rainSurface, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + real(kind=f), intent(out) :: waterMass(pver) !! water mass mixing ratio (kg/kg) + real(kind=f), intent(out) :: waterNumber(pver) !! water number mixing ratio (#/kg) + real(kind=f), intent(out) :: rainSurface !! rain on surface (kg/m2) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: nmr(pver) ! number mixing ratio (#/kg) + real(kind=f) :: sfc ! surface mass (kg/m2) + + rc = RC_OK + + waterMass(:) = 0._f + waterNumber(:) = 0._f + rainSurface = 0._f + + igroup = I_GRP_CRLIQ + ielem = I_ELEM_CRLIQ + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, nmr=nmr, surface=sfc) + if (rc < RC_OK) call endrun('CARMA_GetTotalWaterAndRain::CARMASTATE_GetBin failed.') + + waterMass(:) = waterMass(:) + mmr(:) + waterNumber(:) = waterNumber(:) + nmr(:) + + ! The particles that sedimented out of the bottom layer need to be included + ! in the mass of rain. + rainSurface = rainSurface + sfc + + ! Include the detrained liquid that hasn't been added to the particle bins yet. + call CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc, nmr=nmr) + if (rc < RC_OK) call endrun('CARMA_GetTotalWaterAndRain::CARMASTATE_GetDetrain failed.') + + waterMass(:) = waterMass(:) + mmr(:) + waterNumber(:) = waterNumber(:) + nmr(:) + end do + + return + end subroutine CARMA_GetTotalWaterAndRain + + + + subroutine CARMA_CheckMassAndEnergy(carma, cstate, madeSnow, name, state, & + icol, dt, rliq, prec_str, snow_str, waterMass, iceMass, snowMass, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + logical, intent(in) :: madeSnow !! should bins be changed because of snow? + character*(*),intent(in) :: name !! test name + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(kind=f), intent(in) :: dt !! time step + real(kind=f), intent(in) :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(kind=f), intent(in) :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(kind=f), intent(in) :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(kind=f), intent(in) :: waterMass(pver) !! water mass mixing ratio (kg/kg) + real(kind=f), intent(in) :: iceMass(pver) !! ice mass mixing ratio (kg/kg) + real(kind=f), intent(in) :: snowMass(pver) !! snow mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code, negative indicates failure + + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + logical :: do_detrain ! do convective detrainment? + + real(kind=f) :: mmr(pver) ! mass mixing ratio (#/kg) + real(kind=f) :: totalMass + real(kind=f) :: totalMass2 + + real(r8) :: lat + real(r8) :: lon + + + 1 format(/,'CARMA_CheckMassAndEnergy::ERROR - CARMA mass conservation error, ',a,',icol=',i4,',lat=',& + f7.2,',lon=',f7.2,',cam=',e17.10,',carma=',e17.10,',diff=',e17.10,',rer=',e10.3) + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, do_detrain=do_detrain) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMA_Get failed.') + + totalMass = sum(state%q(icol, :, ixcldliq) * (state%pdel(icol, :) / gravit)) + totalMass = totalMass + sum(state%q(icol, :, ixcldice) * (state%pdel(icol, :) / gravit)) + totalMass = totalMass + sum(state%q(icol, :, 1) * (state%pdel(icol, :) / gravit)) + + if (abs((totalMass - state%tw_cur(icol))) / state%tw_cur(icol) > 1e14_f) then + if (do_print) then + write(LUNOPRT,*) "CARMA_CheckMassAndEnergy::& + &WARNING Total water not conserved, ", totalMass, state%tw_cur, & + (totalMass - state%tw_cur(icol)), & + (totalMass - state%tw_cur(icol)) / state%tw_cur(icol) + end if + end if + + + ! Get the total water coming out of CARMA + call CARMASTATE_GetGas(cstate, I_GAS_H2O, mmr(:), rc) + if (rc < RC_OK) call endrun('CARMA_CheckMassAndEnergy::CARMASTATE_GetGas failed.') + + totalMass2 = sum(waterMass(:) * (state%pdel(icol, :) / gravit)) + totalMass2 = totalMass2 + sum((iceMass(:)) * (state%pdel(icol, :) / gravit)) + + ! If snow has been made, that means it has been removed from the cloud ice that is + ! in the atmosphere and is now accounted for by the prec_str and snow_str fields. + ! Prior to that, it is still considered as part of the atmospheric ice total. + if (.not. madeSnow) then + totalMass2 = totalMass2 + sum(snowMass(:) * (state%pdel(icol, :) / gravit)) + end if + + totalMass2 = totalMass2 + sum(mmr(:) * (state%pdel(icol, :) / gravit)) + totalMass2 = totalMass2 + prec_str(icol) * dt * 1000._f + + if (do_detrain) totalMass2 = totalMass2 + rliq(icol) * dt * 1000._f + + if (totalMass /= totalMass2) then + + if (totalMass /= 0._f) then + + if (abs((totalMass - totalMass2) / totalMass) > 1e-10_f) then + if (do_print) then + call CARMASTATE_Get(cstate, rc, lat=lat, lon=lon) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_Get failed.') + + write(LUNOPRT,1) name, icol, lat, lon, totalMass, totalMass2, & + totalMass2-TotalMass, (totalMass - totalMass2) / totalMass + + write(LUNOPRT,*) " state tw : ", state%tw_cur(icol) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " old vap : ", sum(state%q(icol, :, 1) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " old liq : ", sum(state%q(icol, :, ixcldliq) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " old ice : ", sum(state%q(icol, :, ixcldice) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) "" + write(LUNOPRT,*) " new vap : ", sum(mmr(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new liq : ", sum(waterMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new ice : ", sum(iceMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " new snow : ", sum(snowMass(:) * (state%pdel(icol, :) / gravit)) + write(LUNOPRT,*) " rliq : ", rliq(icol) * dt * 1000._f + write(LUNOPRT,*) " prec_str : ", prec_str(icol) * dt * 1000._f + end if + end if + end if + end if + + return + end subroutine CARMA_CheckMassAndEnergy + + !! Determines the mass fraction for the clay (submicron) bins based upon + !! Tegen and Lacis [1996]. The total fraction for all clay bins should + !! add up to 1. + !! + !! NOTE: WOuld it be better to interpolate this into the bins rather than + !! assigning all CARMA bins within a Tegen & Lacis bin the same value? + !! + !! NOTE: Should any mass go to bins smaller than the smallest one used by + !! Tegen and Lacis? + !! + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + subroutine CARMA_ClayMassFraction(carma, igroup, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: igroup !! the carma group index + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Bins and mass fraction from Tegen and Lacis. + integer, parameter :: NBIN_TEGEN = 4 + real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) + real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) + real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) + + ! Local Variables + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 + integer :: count(NBIN_TEGEN+2) ! count number + integer :: ind_up(NBIN_TEGEN+2) + integer :: ind_low(NBIN_TEGEN+2) + integer :: j ! local index number + integer :: ibin ! carma bin index + real(r8) :: r(carma%f_NBIN) ! CARMA bin center (cm) + + ! Default return code. + rc = RC_OK + + ! Interpolate from Tegen and Lacis. + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis + ! ranges. + count(:) = 0 + + do ibin = 1, NBIN + + ! Smaller than the range. + if (r(ibin) < tl_rmin(1)) then + count(IBELOW) = count(IBELOW) + 1 + end if + + ! In the range + do j = 1, NBIN_TEGEN + if (r(ibin) < tl_rmax(j) .and. r(ibin) >= tl_rmin(j)) then + count(j+1) = count(j+1) + 1 + end if + end do + + ! Bigger than the range. + if (r(ibin) >= tl_rmax(NBIN_TEGEN)) then + count(IABOVE) = count(IABOVE) + 1 + end if + end do + + ! Determine where the boundaries are between the TEGEN bins and + ! the CARMA bin structure. + ind_up(:) = 0 + ind_low(:) = 0 + ind_up (IBELOW) = count(IBELOW) + ind_low(IBELOW) = min(1, count(IBELOW)) + + do j = 1, 5 + ind_up (j+1) = ind_up(j) + count(j+1) + ind_low(j+1) = ind_up(j) + min(count(j+1), 1) + end do + + ! No mass to bins smaller than the smallest size. + clay_mf(:) = 0._r8 + + ! NOTE: This won't work right if the dust bins are coarser than + ! the Tegen and Lacis bins. In this case mass fraction would need + ! to be combined from the Tegen & Lacis bins into a CARMA bin. + do j = 1, NBIN_TEGEN + if (count(j+1) > 0) then + clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / count(j+1) + end if + end do + + clay_mf(ind_low(IABOVE):) = 1._r8 + + return + end subroutine CARMA_ClayMassFraction + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! NOTE: This should be combined with a similar routine in the sea salt + !! model, and any differences should be control by parameters into this + !! routine (and perhaps namelist variables). + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version July-2012 + subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + + implicit none + + ! in and out field + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! physics state + integer, intent(in) :: icol !! column index + integer, intent(in) :: ilat !! latitude index + integer, intent(in) :: ilon !! longitude index + integer, intent(in) :: ielem !! element index + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: uv10 !! the 10m wind speed (m/s) + real(r8), intent(out) :: wwd !! the 10m wind speed with Weibull applied (m/s) + real(r8), intent(out) :: uth !! the 10m wind threshold (m/s) + integer, intent(inout) :: rc !! return code, negative indicates failure + + real(r8), parameter :: vk = 0.4_r8 ! von Karman constant + real(r8) :: r(NBIN) ! CARMA bin center (cm) + real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) + real(r8) :: uthfact ! + integer :: iepart ! element in group containing the particle concentration + real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface + + rc = RC_OK + + ! Get the 10 meter wind speed + uv10 = cam_in%u10(icol) + + ! Calculate the threshold wind speed of each bin [Marticorena and Bergametti,1995] + ! note that in cgs units --> m/s + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + ! Define particle # concentration element index for current group + call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) + if (RC < RC_ERROR) return + + if (cam_in%soilw(icol) > 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then + uthfact = 1.2_r8 + 0.2_r8*log10(cam_in%soilw(icol)) + if (r(ibin) > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm + uth = uthfact * 1.e-2_r8 * 0.13_r8 * sqrt(rhop(ibin)*GRAV*r(ibin)*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + else + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + endif + else + uth = uv10 + endif + + ! Use Weibull with Lansing's estimate for shape. + call WeibullWind(uv10, uth, 2._r8, wwd) + + return + end subroutine CARMA_SurfaceWind + + + !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this + !! processes, the data is regridded from the source size to the size needed by the + !! model. + !! + !! NOTE: This is currently doing 2-D interpolation, but it really wshould be doing + !! regridding. + !! + !! @author Pengfei Yu + !! @version July-2012 + subroutine CARMA_ReadSoilErosionFactor(carma, rc) + use pmgrid, only: plat, plon + use ioFileMod, only: getfil + use wrap_nf + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: idvar, f_nlon, f_nlat, idlat, idlon + integer :: fid, fid_lon, fid_lat + real(r8), allocatable, dimension(:,:) :: ero_factor, ero_factor1 + character(len=256) :: ero_file + real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension + type (interp_type) :: wgt1, wgt2 + real(r8) :: lat(plat), lon(plon) + integer :: i + + rc = RC_OK + + ! Open the netcdf file (read only) + call getfil(carma_soilerosion_file, ero_file, 0) + call wrap_open(ero_file, 0, fid) + + ! Get file dimensions + call wrap_inq_dimid(fid, 'plon', fid_lon) + call wrap_inq_dimid(fid, 'plat', fid_lat) + call wrap_inq_dimlen(fid, fid_lon, f_nlon) + call wrap_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(ero_lat(f_nlat)) + allocate(ero_lon(f_nlon)) + allocate(ero_factor (f_nlon, f_nlat)) + allocate(ero_factor1(plon, plat)) + allocate(soil_factor(plat, plon)) + + ! Read in the tables. + call wrap_inq_varid(fid, 'new_source', idvar) + i = nf90_get_var (fid, idvar, ero_factor) + if (i/=NF90_NOERR) then + write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + call handle_error (i) + end if + call wrap_inq_varid(fid, 'plat', idlat) + call wrap_get_var_realx(fid, idlat, ero_lat) + call wrap_inq_varid(fid, 'plon', idlon) + call wrap_get_var_realx(fid, idlon, ero_lon) + + ! Close the file. + call wrap_close(fid) + + ! NOTE: Is there a better way to get all of the dimensions + ! needed for the model grid? Seems like it shouldn't be hard + ! coded here. + do i = 1, plat + lat(i) = 180._r8 / (plat-1) * (i-1) - 90._r8 + end do + + do i = 1, plon + lon(i) = 360._r8 / plon * (i-1) + end do + + call lininterp_init(ero_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(ero_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(ero_factor, f_nlon, f_nlat, ero_factor1, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + soil_factor(:plat, :plon) = transpose(ero_factor1(:plon, :plat)) + + deallocate(ero_lat) + deallocate(ero_lon) + deallocate(ero_factor) + deallocate(ero_factor1) + + return + end subroutine CARMA_ReadSoilErosionFactor + + + !! Calculate the nth mean of u using Weibull wind distribution + !! considering the threshold wind velocity. This algorithm + !! integrates from uth to infinite (u^n P(u)du ) + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine WeibullWind(u, uth, n, uwb, wbk) + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_spfn_mod, only: gamma => shr_spfn_gamma, & + igamma => shr_spfn_igamma + + implicit none + + real(r8), intent(in) :: u ! mean wind speed + real(r8), intent(in) :: uth ! threshold velocity + real(r8), intent(in) :: n ! the rank of u in the integration + real(r8), intent(out) :: uwb ! the Weibull distribution + real(r8), intent(in), optional :: wbk ! the shape parameter + + ! local variable + real(r8) :: k ! the shape parameter in Weibull distribution + real(r8) :: c ! the scale parameter in Weibull distribution + + if (present(wbk)) then + k = wbk + else + k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + ! k = 2.5_r8 ! Lansing's estimate + end if + + ! If u is 0, then k can be 0, which makes a lot of this undefined. + ! Just return 0. in this case. + if (u == 0._r8) then + uwb = 0._r8 + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) + end if + + end subroutine WeibullWind + +end module diff --git a/src/physics/carma/models/cirrus_dust/growevapl.F90 b/src/physics/carma/models/cirrus_dust/growevapl.F90 new file mode 100644 index 0000000000..e1020eb802 --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/growevapl.F90 @@ -0,0 +1,264 @@ +! Include shortname defintions, so that the F77 code does not have to be modified to +! reference the CARMA structure. +#include "carma_globaer.h" + +!! This routine evaluate particle loss rates due to condensational +!! growth and evaporation for all condensing gases. +!! +!! The loss rates for each group are and . +!! +!! Units are [s^-1]. +!! +!! @author Andy Ackerman +!! @version Dec-1995 +subroutine growevapl(carma, cstate, iz, rc) + + ! types + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmastate_mod + use carma_mod + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + integer, intent(in) :: iz !! z index + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Local declarations + integer :: igroup + integer :: iepart + integer :: igas + integer :: ibin + integer :: isol + integer :: nother + integer :: ieoth_rel + integer :: ieoth_abs + integer :: jother + real(kind=f) :: argsol + real(kind=f) :: othermtot + real(kind=f) :: condm + real(kind=f) :: akas + real(kind=f) :: expon + real(kind=f) :: g0 + real(kind=f) :: g1 + real(kind=f) :: g2 + real(kind=f) :: ss + real(kind=f) :: pvap + real(kind=f) :: dpc + real(kind=f) :: dpc1 + real(kind=f) :: dpcm1 + real(kind=f) :: rat1 + real(kind=f) :: rat2 + real(kind=f) :: rat3 + real(kind=f) :: rat4 + real(kind=f) :: ratt1 + real(kind=f) :: ratt2 + real(kind=f) :: ratt3 + real(kind=f) :: den1 + real(kind=f) :: test1 + real(kind=f) :: test2 + real(kind=f) :: x + integer :: ieother(NELEM) + real(kind=f) :: otherm(NELEM) + real(kind=f) :: dela(NBIN) + real(kind=f) :: delma(NBIN) + real(kind=f) :: aju(NBIN) + real(kind=f) :: ar(NBIN) + real(kind=f) :: al(NBIN) + real(kind=f) :: a6(NBIN) + real(kind=f) :: dmdt(NBIN) + real(kind=f) :: growlg_max + + + do igroup = 1,NGROUP + + ! element of particle number concentration + iepart = ienconc(igroup) + + ! condensing gas + igas = igrowgas(iepart) + + if (igas .ne. 0) then + ! Only valid for condensing liquid water and sulfric acid currently. + if ((igas /= igash2o) .and. (igas .ne. igash2so4)) then + if (do_print) write(LUNOPRT,*) 'growevapl::ERROR - Invalid gas (', igas, ').' + rc = -1 + return + endif + + ! Treat condensation of gas to/from particle group . + ! + ! Bypass calculation if few particles are present + if( pconmax(iz,igroup) .gt. FEW_PC )then + do ibin = 1,NBIN-1 + + ! Determine the growth rate (dmdt). This calculation may take into account + ! radiative effects on the particle which can affect the growth rates. + call pheat(carma, cstate, iz, igroup, iepart, ibin, igas, dmdt(ibin), rc) + + enddo ! ibin = 1,NBIN-1 + + ! Now calculate condensation/evaporation production and loss rates. + ! Use Piecewise Polynomial Method [Colela and Woodard, J. Comp. Phys., + ! 54, 174-201, 1984] + ! + ! First, use cubic fits to estimate concentration values at bin + ! boundaries + do ibin = 2,NBIN-1 + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup) + dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup) + ratt1 = pratt(1,ibin,igroup) + ratt2 = pratt(2,ibin,igroup) + ratt3 = pratt(3,ibin,igroup) + dela(ibin) = ratt1 * ( ratt2*(dpc1-dpc) + ratt3*(dpc-dpcm1) ) + delma(ibin) = 0._f + + if( (dpc1-dpc)*(dpc-dpcm1) .gt. 0._f ) & + delma(ibin) = min( abs(dela(ibin)), 2._f*abs(dpc-dpc1), & + 2._f*abs(dpc-dpcm1) ) * sign(1._f, dela(ibin)) + + enddo ! ibin = 2,NBIN-2 + + do ibin = 2,NBIN-2 + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup) + dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup) + rat1 = prat(1,ibin,igroup) + rat2 = prat(2,ibin,igroup) + rat3 = prat(3,ibin,igroup) + rat4 = prat(4,ibin,igroup) + den1 = pden1(ibin,igroup) + + ! is the estimate for concentration (dn/dm) at bin + ! boundary +1/2. + aju(ibin) = dpc + rat1*(dpc1-dpc) + 1._f/den1 * & + ( rat2*(rat3-rat4)*(dpc1-dpc) - & + dm(ibin,igroup)*rat3*delma(ibin+1) + & + dm(ibin+1,igroup)*rat4*delma(ibin) ) + enddo ! ibin = 2,NBIN-2 + + ! Now construct polynomial functions in each bin + do ibin = 3,NBIN-2 + al(ibin) = aju(ibin-1) + ar(ibin) = aju(ibin) + enddo + + ! Use linear functions in first two and last two bins + if( NBIN .gt. 1 )then + ibin = NBIN + + ar(2) = aju(2) + al(2) = pc(iz,1,iepart)/dm(1,igroup) + & + palr(1,igroup) * & + (pc(iz,2,iepart)/dm(2,igroup)- & + pc(iz,1,iepart)/dm(1,igroup)) + ar(1) = al(2) + al(1) = pc(iz,1,iepart)/dm(1,igroup) + & + palr(2,igroup) * & + (pc(iz,2,iepart)/dm(2,igroup)- & + pc(iz,1,iepart)/dm(1,igroup)) + + al(ibin-1) = aju(ibin-2) + ar(ibin-1) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + & + palr(3,igroup) * & + (pc(iz,ibin,iepart)/dm(ibin,igroup)- & + pc(iz,ibin-1,iepart)/dm(ibin-1,igroup)) + al(ibin) = ar(ibin-1) + ar(ibin) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + & + palr(4,igroup) * & + (pc(iz,ibin,iepart)/dm(ibin,igroup)- & + pc(iz,ibin-1,iepart)/dm(ibin-1,igroup)) + endif + + ! Next, ensure that polynomial functions do not deviate beyond the + ! range [,] + do ibin = 1,NBIN + + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + + if( (ar(ibin)-dpc)*(dpc-al(ibin)) .le. 0._f )then + al(ibin) = dpc + ar(ibin) = dpc + endif + + test1 = (ar(ibin)-al(ibin))*(dpc - 0.5_f*(al(ibin)+ar(ibin))) + test2 = 1._f/6._f*(ar(ibin)-al(ibin))**2 + + if( test1 .gt. test2 )then + al(ibin) = 3._f*dpc - 2._f*ar(ibin) + elseif( test1 .lt. -test2 )then + ar(ibin) = 3._f*dpc - 2._f*al(ibin) + endif + enddo + + ! Lastly, calculate fluxes across each bin boundary. + ! + ! Use upwind advection when courant number > 1. + do ibin = 1,NBIN + dpc = pc(iz,ibin,iepart) / dm(ibin,igroup) + dela(ibin) = ar(ibin) - al(ibin) + a6(ibin) = 6._f * ( dpc - 0.5_f*(ar(ibin)+al(ibin)) ) + enddo + + do ibin = 1,NBIN-1 + + if( dmdt(ibin) .gt. 0._f .and. & + pc(iz,ibin,iepart) .gt. SMALL_PC )then + + x = dmdt(ibin)*dtime/dm(ibin,igroup) + + if( x .lt. 1._f )then + growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & + * ( ar(ibin) - 0.5*dela(ibin)*x + & + (x/2._f - x**2/3._f)*a6(ibin) ) + else + growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) + endif + + elseif( dmdt(ibin) .lt. 0._f .and. & + pc(iz,ibin+1,iepart) .gt. SMALL_PC )then + + x = -dmdt(ibin)*dtime/dm(ibin+1,igroup) + + if( x .lt. 1._f )then + evaplg(ibin+1,igroup) = -dmdt(ibin)/ & + pc(iz,ibin+1,iepart) & + * ( al(ibin+1) + 0.5_f*dela(ibin+1)*x + & + (x/2._f - (x**2)/3._f)*a6(ibin+1) ) + else + evaplg(ibin+1,igroup) = -dmdt(ibin) / dm(ibin+1,igroup) + endif + + ! Boundary conditions: for evaporation out of first bin (with cores), + ! use evaporation rate from second bin. +! if( ibin .eq. 1 .and. ncore(igroup) .gt. 0 )then + if( ibin .eq. 1)then + evaplg(1,igroup) = -dmdt(1) / dm(1,igroup) + endif + endif + + ! As a hack, limit the growth of water drops to areas where it + ! is below freezing. This is where the Bergeron process exists. Let + ! the parent model do the rest of the droplet growth. + if ((igroup == 4) .and. (t(iz) > T0)) then + growlg(ibin,igroup) = 0._f + evaplg(ibin+1,igroup) = 0._f + end if + + enddo ! ibin = 1,NBIN-1 + endif ! (pconmax .gt. FEW_PC) + endif ! (igas = igrowgas(ielem)) .ne. 0 + enddo ! igroup = 1,NGROUP + + + ! Return to caller with particle loss rates for growth and evaporation + ! evaluated. + return +end diff --git a/src/physics/carma/models/cirrus_dust/hetnucl.F90 b/src/physics/carma/models/cirrus_dust/hetnucl.F90 new file mode 100644 index 0000000000..318bc91db6 --- /dev/null +++ b/src/physics/carma/models/cirrus_dust/hetnucl.F90 @@ -0,0 +1,178 @@ +! Include shortname defintions, so that the F77 code does not have to be modified to +! reference the CARMA structure. +#include "carma_globaer.h" + +!! This routine evaluates particle loss rates due to nucleation : +!! heterogeneous deposition nucleation only. The parameters are adjusted +!! for mesospheric conditions, based upon the recommendations of Keesee. +!! +!! Based on expressions from ... +!! Keesee [JGR,1989] +!! Pruppacher and Klett [2000] +!! Rapp and Thomas [JASTP, 2006] +!! Trainer et al. [2008] +!! +!! The loss rates for all particle elements in a particle group are equal. +!! +!! To avoid nucleation into an evaporating bin, this subroutine must +!! be called after growp, which evaluates evaporation loss rates . +!! +!! @author Eric Jensen, Chuck Bardeen +!! @version Oct-2000, Jan-2010 +subroutine hetnucl(carma, cstate, iz, rc) + + ! types + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmastate_mod + use carma_mod + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + integer, intent(in) :: iz !! z index + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Local declarations + logical :: evapfrom_nucto + integer :: igas ! gas index + integer :: igroup ! group index + integer :: ibin ! bin index + integer :: iepart ! element for condensing group index + integer :: inuc ! nucleating element index + integer :: ienucto ! index of target nucleation element + integer :: ignucto ! index of target nucleation group + integer :: inucto ! index of target nucleation bin + real(kind=f) :: rmw + real(kind=f) :: R_H2O + real(kind=f) :: rnh2o + real(kind=f) :: rlogs + real(kind=f) :: ag + real(kind=f) :: contang + real(kind=f) :: xh + real(kind=f) :: phih + real(kind=f) :: rath + real(kind=f) :: fv3h + real(kind=f) :: fv4h + real(kind=f) :: fh + real(kind=f) :: delfg + real(kind=f) :: expon + + ! Heterogeneous nucleation factors +! real(kind=f), parameter :: gdes = 2.9e-13_f + real(kind=f), parameter :: gdes = 4.125e-13_f ! From Chen et al., ACP, 2008 average of Saharan and Asian dust + real(kind=f), parameter :: gsd = 0.1_f * gdes + real(kind=f), parameter :: zeld = 0.1_f + real(kind=f), parameter :: vibfreq = 1.e13_f + real(kind=f), parameter :: diflen = 0.1e-7_f + real(kind=f) :: rmiv + +! rmiv = 0.95_f + rmiv = 0.9945_f ! From Chen et al., ACP, 2008 for average of Saharan and Asian dust + + ! rmiv - Eq. 2, Trainer et al. [2008] +! rmiv = 0.94_f - (6005._f * exp(-0.065_f * max(150._f, t(iz)))) +! rmiv = max(0._f, 0.94_f - (6005._f * exp(-0.065_f * t(iz)))) + + ! Loop over particle groups. + do igroup = 1, NGROUP + + igas = inucgas(igroup) ! condensing gas + + if (igas .ne. 0) then + + iepart = ienconc(igroup) ! particle number density element + + rmw = gwtmol(igas) / AVG + R_H2O = RGAS / gwtmol(igas) + rnh2o = gc(iz,igas) * R_H2O / BK + + ! Calculate nucleation loss rates. Do not allow nucleation into + ! an evaporating bin. + ! + ! is index of target nucleation element; + ! is index of target nucleation group. + do inuc = 1, nnuc2elem(iepart) + + ienucto = inuc2elem(inuc,iepart) + + if (ienucto .ne. 0) then + ignucto = igelem(ienucto) + else + ignucto = 0 + endif + + ! Only compute nucleation rate for heterogenous nucleation + if (inucproc(iepart,ienucto) .eq. I_HETNUC) then + + ! Loop over particle bins. Loop from largest to smallest for + ! evaluation of index of smallest bin nucleated during time step . + do ibin = NBIN, 1, -1 + + ! is index of target nucleation bin. + if (ignucto .ne. 0) then + inucto = inuc2bin(ibin,igroup,ignucto) + else + inucto = 0 + endif + + ! Bypass calculation if few particles are present + if (pconmax(iz,igroup) .gt. FEW_PC) then + + ! Set to .true. when target droplets are evaporating + if (inucto .ne. 0) then + evapfrom_nucto = evaplg(inucto,ignucto) .gt. 0._f + else + evapfrom_nucto = .false. + endif + + ! Only proceed if ice supersaturated + if ((supsati(iz,igas) .gt. 0._f)) then + rlogs = log(supsati(iz,igas) + 1._f) + + ! Critical ice germ radius formed in the sulfate solution + ! + ! Eq. 2, Rapp & Thomas [2006] + ag = 2._f * gwtmol(igas) * surfctia(iz) / rgas / t(iz) / RHO_I / rlogs + + ! Heterogeneous nucleation geometric factor + ! + ! Eq. 9-22, Pruppacher & Klett [2000] + contang = acos(rmiv) + xh = r(ibin,igroup) / ag + phih = sqrt(1._f - 2._f * rmiv * xh + xh**2 ) + rath = (xh-rmiv) / phih + fv3h = xh**3 * (2._f - 3._f * rath + rath**3 ) + fv4h = 3._f * rmiv * xh**2 * (rath - 1._f) + + if (abs(rath) .gt. 1._f - 1.e-8_f) fv3h = 0._f + if (abs(rath) .gt. 1._f - 1.e-10_f) fv4h = 0._f + + fh = 0.5_f * (1._f + ((1._f - rmiv * xh) / phih)**3 + fv3h + fv4h) + + ! Gibbs free energy of ice germ formation in the ice/sulfate solution + ! + ! Eq. 3, Rapp & Thomas [2006] + delfg = 4._f * PI * ag**2 * surfctia(iz) - 4._f * PI * RHO_I * ag**3 *BK * t(iz) * rlogs / 3._f / rmw + + ! Ice nucleation rate in a 0.2 micron aerosol (/sec) + expon = (2._f * gdes - gsd - fh*delfg) / BK / t(iz) + + ! NOTE: Excessive nucleation makes it difficult for the substepping to find a + ! stable solution, so put a cap on really large nucleation values that can be produced. + rnuclg(ibin,igroup,ignucto) = min(1e10_f, zeld * BK * t(iz) * diflen * ag * sin(contang) * & + 4._f * PI * r(ibin,igroup)**2 * rnh2o**2 / (fh * rmw * vibfreq) * exp(expon)) + endif + endif ! pconmax(ixyz,igroup) .gt. FEW_PC + enddo ! ibin = 1,NBIN + endif ! inucproc(iepart,ienucto) .eq. I_DROPACT + enddo ! inuc = 1,nnuc2elem(iepart) + endif ! (igas = inucgas(igroup) .ne. 0) + enddo ! igroup = 1,NGROUP + + ! Return to caller with particle loss rates due to nucleation evaluated. + return +end diff --git a/src/physics/carma/models/dust/carma_model_flags_mod.F90 b/src/physics/carma/models/dust/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..b5233cf5aa --- /dev/null +++ b/src/physics/carma/models/dust/carma_model_flags_mod.F90 @@ -0,0 +1,79 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + + ! name of the dust erosion factor file + character(len=256), public :: carma_soilerosion_file = 'soil_erosion_factor_1x1_c120907.nc' + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_soilerosion_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_soilerosion_file, len(carma_soilerosion_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 new file mode 100644 index 0000000000..cfd1d3f284 --- /dev/null +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -0,0 +1,828 @@ +!! This CARMA model is for dust aerosols and is based upon Su & Toon, JGR, 2009; +!! Su & Toon, ACP 2011. +!! +!! These dust are not currently radiatively active and do not replace the dust +!! in CAM; however, this is something that could be done in the future. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! - CARMA_SurfaceWind() +!! - CARMA_SurfaceWind() +!! - WeibullWind() +!! +!! @version July-2012 +!! @author Lin Su, Pengfei Yu, Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_DUST = 1 !! sea salt composition + + real(kind=f), parameter :: rClay = 1e-4_f !! silt/clay particle radius boundary (cm) + + integer :: nClay !! Number of clay bins (r < 1 um) + integer :: nSilt !! Number of silt bins + real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), parameter :: rmin = 1.19e-5_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.371_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_soilerosion_file = ', carma_soilerosion_file + end if + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "dust", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="CRDUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version Dec-2010 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use phys_grid, only: get_lon_all_p, get_lat_all_p + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat(pcols) ! latitude index + integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + character(len=32) :: shortname ! the shortname of the group + + ! -------- local variables added for dust model ------------ + real(r8), parameter :: ch = 0.5e-9_r8 ! dimensional factor & tuning number, + ! as it's model resolution dependent (kgs^2/m^5)!!! + real(r8) :: r(NBIN) ! bin center (cm) + real(r8) :: uth ! threshold wind velocity (m/s) + + real(r8) :: uv10 ! 10 m wind speed (m/s) + real(r8) :: cd10 ! 10-m drag coefficient () + real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: sp ! mass fraction for soil factor + integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay + real(r8) :: soilfact(pcols) ! soil erosion factor (for debug) + + ! Default return code. + rc = RC_OK + + ! Determine the latitude and longitude of each column. + lchnk = state%lchnk + ncol = state%ncol + + call get_lat_all_p(lchnk, ncol, ilat) + call get_lon_all_p(lchnk, ncol, ilon) + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + + ! Is this clay or silt? + ! + ! NOTE: It is assumed that 90% of the mass will be silt and 10% will + ! be clay. + ! + ! NOTE: For clay bins, use the smallest silt bin to calculate the + ! mass and then scale that into each clay bin based upon interpolation of + ! Tegen and Lacis [1996]. + if (r(ibin) >= rClay) then + sp = 0.9_r8 / nSilt + idustbin = ibin + else + sp = 0.1_r8 / nClay + idustbin = nClay + 1 + end if + + ! Process each column. + do icol = 1,ncol + + call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + ! Is the wind above the threshold for dust production? + if (uv10 > uth) then + surfaceFlux(icol) = ch * soil_factor(ilat(icol), ilon(icol)) * sp * & + wwd * (uv10 - uth) + endif + + ! Scale the clay bins based upon the smallest silt bin. + surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) + + ! Save off the soil erosion factor so it can be output. + soilfact(icol) = soil_factor(ilat(icol), ilon(icol)) + end do + + ! For debug purposes, output the soil erosion factor. + call outfld('CRSLERFC', soilfact, pcols, lchnk) + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use cam_history, only: addfld, add_default, horiz_only + use constituents, only: pcnst + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! -------- local variables ---------- + integer :: ibin ! CARMA bin index + real(r8) :: r(carma%f_NBIN) ! bin center (cm) + integer :: count_Silt ! count number for Silt + integer :: igroup ! the index of the carma aerosol group + integer :: ielem ! the index of the carma aerosol element + character(len=32) :: shortname ! the shortname of the element + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + + ! Default return code. + rc = RC_OK + + ! Determine how many clay and how many silt bins there are, based + ! upon the bin definitions and rClay. + ! + ! TBD: This should use the radii rather than being hard coded. + ! nClay = 8 + ! nSilt = NBIN - nClay + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + count_Silt = 0 + do ibin = 1, NBIN + if (r(ibin) >= rclay) then + count_Silt = count_Silt + 1 + else + end if + end do + nSilt = count_Silt + nClay = NBIN - nSilt + end if + end do + + ! Read in the soil factors. + call CARMA_ReadSoilErosionFactor(carma, rc) + if (RC < RC_ERROR) return + + ! To determine Clay Mass Fraction + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + if (shortname .eq. "CRDUST") then + call CARMA_ClayMassFraction(carma, igroup, rc) + end if + end do + + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) then + write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' + write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor + + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' + end if + end if + + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + + + !! Determines the mass fraction for the clay (submicron) bins based upon + !! Tegen and Lacis [1996]. The total fraction for all clay bins should + !! add up to 1. + !! + !! NOTE: WOuld it be better to interpolate this into the bins rather than + !! assigning all CARMA bins within a Tegen & Lacis bin the same value? + !! + !! NOTE: Should any mass go to bins smaller than the smallest one used by + !! Tegen and Lacis? + !! + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + subroutine CARMA_ClayMassFraction(carma, igroup, rc) + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: igroup !! the carma group index + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Bins and mass fraction from Tegen and Lacis. + integer, parameter :: NBIN_TEGEN = 4 + real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) + real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) + real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) + + ! Local Variables + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 + integer :: tl_count(NBIN_TEGEN+2) ! count number in Tegen and Lacis ranges + integer :: ind_up(NBIN_TEGEN+2) + integer :: ind_low(NBIN_TEGEN+2) + integer :: j ! local index number + integer :: ibin ! carma bin index + real(r8) :: r(carma%f_NBIN) ! CARMA bin center (cm) + + ! Default return code. + rc = RC_OK + + ! Interpolate from Tegen and Lacis. + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis + ! ranges. + tl_count(:) = 0 + + do ibin = 1, NBIN + + ! Smaller than the range. + if (r(ibin) < tl_rmin(1)) then + tl_count(IBELOW) = tl_count(IBELOW) + 1 + end if + + ! In the range + do j = 1, NBIN_TEGEN + if (r(ibin) < tl_rmax(j) .and. r(ibin) >= tl_rmin(j)) then + tl_count(j+1) = tl_count(j+1) + 1 + end if + end do + + ! Bigger than the range. + if (r(ibin) >= tl_rmax(NBIN_TEGEN)) then + tl_count(IABOVE) = tl_count(IABOVE) + 1 + end if + end do + + ! Determine where the boundaries are between the TEGEN bins and + ! the CARMA bin structure. + ind_up(:) = 0 + ind_low(:) = 0 + ind_up (IBELOW) = tl_count(IBELOW) + ind_low(IBELOW) = min(1, tl_count(IBELOW)) + + do j = 1, 5 + ind_up (j+1) = ind_up(j) + tl_count(j+1) + ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1) + end do + + ! No mass to bins smaller than the smallest size. + clay_mf(:) = 0._r8 + + ! NOTE: This won't work right if the dust bins are coarser than + ! the Tegen and Lacis bins. In this case mass fraction would need + ! to be combined from the Tegen & Lacis bins into a CARMA bin. + do j = 1, NBIN_TEGEN + if (tl_count(j+1) > 0) then + clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1) + end if + end do + + clay_mf(ind_low(IABOVE):) = 1._r8 + + return + end subroutine CARMA_ClayMassFraction + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! NOTE: This should be combined with a similar routine in the sea salt + !! model, and any differences should be control by parameters into this + !! routine (and perhaps namelist variables). + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version July-2012 + subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + + implicit none + + ! in and out field + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! physics state + integer, intent(in) :: icol !! column index + integer, intent(in) :: ilat !! latitude index + integer, intent(in) :: ilon !! longitude index + integer, intent(in) :: ielem !! element index + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: uv10 !! the 10m wind speed (m/s) + real(r8), intent(out) :: wwd !! the 10m wind speed with Weibull applied (m/s) + real(r8), intent(out) :: uth !! the 10m wind threshold (m/s) + integer, intent(inout) :: rc !! return code, negative indicates failure + + real(r8), parameter :: vk = 0.4_r8 ! von Karman constant + real(r8) :: r(NBIN) ! CARMA bin center (cm) + real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) + real(r8) :: uthfact ! + integer :: iepart ! element in group containing the particle concentration + real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface + + rc = RC_OK + + ! Get the 10 meter wind speed + uv10 = cam_in%u10(icol) + + ! Calculate the threshold wind speed of each bin [Marticorena and Bergametti,1995] + ! note that in cgs units --> m/s + call CARMAGROUP_GET(carma, igroup, rc, r=r) + if (RC < RC_ERROR) return + + ! Define particle # concentration element index for current group + call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) + if (RC < RC_ERROR) return + + if (cam_in%soilw(icol) > 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then + uthfact = 1.2_r8 + 0.2_r8*log10(cam_in%soilw(icol)) + if (r(ibin) > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm + uth = uthfact * 1.e-2_r8 * 0.13_r8 * sqrt(rhop(ibin)*GRAV*r(ibin)*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + else + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + endif + else + uth = uv10 + endif + + ! Use Weibull with Lansing's estimate for shape. + call WeibullWind(uv10, uth, 2._r8, wwd) + + return + end subroutine CARMA_SurfaceWind + + + !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this + !! processes, the data is regridded from the source size to the size needed by the + !! model. + !! + !! NOTE: This is currently doing 2-D interpolation, but it really should be doing + !! regridding. + !! + !! @author Pengfei Yu + !! @version July-2012 + subroutine CARMA_ReadSoilErosionFactor(carma, rc) + use pmgrid, only: plat, plon + use ioFileMod, only: getfil + use wrap_nf + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: idvar, f_nlon, f_nlat, idlat, idlon + integer :: fid, fid_lon, fid_lat + real(r8), allocatable, dimension(:,:) :: ero_factor, ero_factor1 + character(len=256) :: ero_file + real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension + type (interp_type) :: wgt1, wgt2 + real(r8) :: lat(plat), lon(plon) + integer :: i + + rc = RC_OK + + ! Open the netcdf file (read only) + call getfil(carma_soilerosion_file, ero_file, 0) + call wrap_open(ero_file, 0, fid) + + ! Get file dimensions + call wrap_inq_dimid(fid, 'plon', fid_lon) + call wrap_inq_dimid(fid, 'plat', fid_lat) + call wrap_inq_dimlen(fid, fid_lon, f_nlon) + call wrap_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(ero_lat(f_nlat)) + allocate(ero_lon(f_nlon)) + allocate(ero_factor (f_nlon, f_nlat)) + allocate(ero_factor1(plon, plat)) + allocate(soil_factor(plat, plon)) + + ! Read in the tables. + call wrap_inq_varid(fid, 'new_source', idvar) + i = nf90_get_var (fid, idvar, ero_factor) + if (i/=NF90_NOERR) then + write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + call handle_error (i) + end if + call wrap_inq_varid(fid, 'plat', idlat) + call wrap_get_var_realx(fid, idlat, ero_lat) + call wrap_inq_varid(fid, 'plon', idlon) + call wrap_get_var_realx(fid, idlon, ero_lon) + + ! Close the file. + call wrap_close(fid) + + ! NOTE: Is there a better way to get all of the dimensions + ! needed for the model grid? Seems like it shouldn't be hard + ! coded here. + do i = 1, plat + lat(i) = 180._r8 / (plat-1) * (i-1) - 90._r8 + end do + + do i = 1, plon + lon(i) = 360._r8 / plon * (i-1) + end do + + call lininterp_init(ero_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(ero_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(ero_factor, f_nlon, f_nlat, ero_factor1, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + soil_factor(:plat, :plon) = transpose(ero_factor1(:plon, :plat)) + + deallocate(ero_lat) + deallocate(ero_lon) + deallocate(ero_factor) + deallocate(ero_factor1) + + return + end subroutine CARMA_ReadSoilErosionFactor + + + !! Calculate the nth mean of u using Weibull wind distribution + !! considering the threshold wind velocity. This algorithm + !! integrates from uth to infinite (u^n P(u)du ) + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine WeibullWind(u, uth, n, uwb, wbk) + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_spfn_mod, only: gamma => shr_spfn_gamma, & + igamma => shr_spfn_igamma + + implicit none + + real(r8), intent(in) :: u ! mean wind speed + real(r8), intent(in) :: uth ! threshold velocity + real(r8), intent(in) :: n ! the rank of u in the integration + real(r8), intent(out) :: uwb ! the Weibull distribution + real(r8), intent(in), optional :: wbk ! the shape parameter + + ! local variable + real(r8) :: k ! the shape parameter in Weibull distribution + real(r8) :: c ! the scale parameter in Weibull distribution + + if (present(wbk)) then + k = wbk + else + k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + ! k = 2.5_r8 ! Lansing's estimate + end if + + ! If u is 0, then k can be 0, which makes a lot of this undefined. + ! Just return 0. in this case. + if (u == 0._r8) then + uwb = 0._r8 + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) + end if + + end subroutine WeibullWind + +end module diff --git a/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..360ddb9499 --- /dev/null +++ b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 @@ -0,0 +1,99 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + real(r8), public :: carma_emis_dust = 0._r8 !! Total dust emission for the event (kg) + real(r8), public :: carma_emis_soot = 0._r8 !! Total soot emission for the event (kg) + integer, public :: carma_emis_startdate = 1 !! start year and day of year (yyyyddd) + integer, public :: carma_emis_stopdate = 1 !! stop year and day of year (yyyyddd) + integer, public :: carma_emis_starttime = 0 !! start time of day (s) + integer, public :: carma_emis_stoptime = 0 !! stop time of day (s) + real(r8), public :: carma_emis_minlat = -90. !! minimum latitude + real(r8), public :: carma_emis_maxlat = 90. !! maximum latitude + real(r8), public :: carma_emis_minlon = 0. !! minimum longitude + real(r8), public :: carma_emis_maxlon = 360. !! maximum longitude + logical, public :: carma_fractal_soot = .false. !! fractal Soot + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_emis_dust, carma_emis_soot, carma_emis_startdate, carma_emis_stopdate, & + carma_emis_starttime, carma_emis_stoptime, carma_emis_minlat, carma_emis_maxlat, & + carma_emis_minlon, carma_emis_maxlon, carma_fractal_soot + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_emis_dust, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_soot, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_startdate, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_stopdate, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_starttime, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_stoptime, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_minlat, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_maxlat, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_minlon, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_maxlon, 1, mpir8, 0, mpicom) + call mpibcast(carma_fractal_soot, 1, mpilog, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 new file mode 100755 index 0000000000..d60aa02bee --- /dev/null +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -0,0 +1,808 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is used to model a meteor impact upon the land. This model is +!! preliminary. Please talk to Chuck Bardeen (bardeenc@ucar.edu) if you are +!! interested in this model. +!! +!! @version Oct-2012 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 2 !! Number of particle elements + integer, public, parameter :: NBIN = 21 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + + !! Relative humidities for mie and radiation calculations. The RRTMG radiation code will interpolate + !! based upon the current relative humidity from a table built using the specified relative + !! humidities. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_DUST = 1 !! dust composition + integer, public, parameter :: I_SOOT = 2 !! soot composition + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_DUST = 1 !! dust aerosol group + integer, public, parameter :: I_GRP_SOOT = 2 !! soot aerosol group + + integer, public, parameter :: I_ELEM_DUST = 1 !! dust aerosol element + integer, public, parameter :: I_ELEM_SOOT = 2 !! soot aerosol element + + + integer :: carma_dustmap(NBIN) !! mapping of the CARMA dust bins to the surface dust bins. + real(kind=f) :: carma_dustbinfactor(NBIN) !! bin weighting factor for dust emissions + real(kind=f) :: carma_sootbinfactor(NBIN) !! bin weighting factor for soot emissions + real(kind=f) :: carma_emis_area !! surface area where emissions are happening (m2) + real(kind=f) :: carma_emis_dtime !! duration of the event (s) +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) + real(kind=f) :: RHO_SOOT ! density of soot particles (g/cm) + real(kind=f), parameter :: dust_rmin = 20.e-7_f ! dust minimum radius (cm) + real(kind=f), parameter :: dust_vmrat = 2.49_f ! dust volume ratio + real(kind=f), parameter :: soot_rmin = 20.e-7_f ! dust minimum radius (cm) + real(kind=f), parameter :: soot_vmrat = 2.49_f ! dust volume ratio + complex(kind=f) :: refidx(NWAVE) ! refractice indices + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + real(kind=f) :: soot_rmon = 30.e-7_f ! soot monomer radius (cm) + real(kind=f) :: soot_df(NBIN) = 2.2_f ! soot fractal dimension + real(kind=f) :: soot_falpha = 1._f ! soot fractal packing coefficient + + ! Default return code. + rc = RC_OK + + ! Adjust longitudes to be 0 to 360 rather than +- 180. + if (carma_emis_minlon < 0._f) carma_emis_minlon = 360._f + carma_emis_minlon + if (carma_emis_maxlon < 0._f) carma_emis_maxlon = 360._f + carma_emis_maxlon + + if (carma_emis_minlat > carma_emis_maxlat) then + if (do_print) write(LUNOPRT,*) 'CARMA_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' + end if + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_emis_dust = ', carma_emis_dust, ' (kg)' + if (do_print) write(LUNOPRT,*) ' carma_emis_soot = ', carma_emis_soot, ' (kg)' + if (do_print) write(LUNOPRT,*) ' carma_emis_startdate = ', carma_emis_startdate + if (do_print) write(LUNOPRT,*) ' carma_emis_starttime = ', carma_emis_starttime + if (do_print) write(LUNOPRT,*) ' carma_emis_stopdate = ', carma_emis_stopdate + if (do_print) write(LUNOPRT,*) ' carma_emis_stoptime = ', carma_emis_stoptime + if (do_print) write(LUNOPRT,*) ' carma_emis_minlat = ', carma_emis_minlat + if (do_print) write(LUNOPRT,*) ' carma_emis_maxlat = ', carma_emis_maxlat + if (do_print) write(LUNOPRT,*) ' carma_emis_minlon = ', carma_emis_minlon + if (do_print) write(LUNOPRT,*) ' carma_emis_maxlon = ', carma_emis_maxlon + if (do_print) write(LUNOPRT,*) ' carma_fractal_soot = ', carma_fractal_soot + end if + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + + ! Use the same refractive index at all wavelengths. This value is typical of soot and + ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the + ! real part (0.003 (IR) to 0.05 (UV)). + refidx(:) = (1.53_f, 0.008_f) + + call CARMAGROUP_Create(carma, I_GRP_DUST, "Dust", dust_rmin, dust_vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="CRDUST", refidx=refidx, do_mie=.true.) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + ! Use the same refractive index at all wavelengths. This value is typical of soot and + ! is recommended by Toon et al. 2012. + refidx(:) = (1.8_f, 0.67_f) + + if (carma_fractal_soot) then + RHO_SOOT = 1.8_f + + ! This matches the df profile used by Wolf and Toon [2010]. + soot_df(:) = (/ 3.0000_f, 3.0000_f, 1.5033_f, 1.5082_f, 1.5494_f, 1.6168_f, 1.7589_f, & + 1.9957_f, 2.2519_f, 2.3840_f, 2.4000_f, 2.4000_f, 2.4000_f, 2.4000_f, & + 2.4000_f, 2.4000_f, 2.4000_f, 2.4000_f, 2.4000_f, 2.4000_f, 2.4000_f /) + + call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & + scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true., & + is_fractal=.true., rmon=soot_rmon, df=soot_df, falpha=soot_falpha, & + imiertn=I_MIERTN_BOTET1997) + else + RHO_SOOT = 1.0_f + call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & + scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true.) + end if + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_SOOT, I_GRP_SOOT, I_GRP_SOOT, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + integer :: ielem ! element index + integer :: ibin ! bin index + real(r8) :: mmr(pver) ! mass mixing ration (kg/kg) + real(r8) :: sflx ! surface flux (kg/m2/s) + + ! Default return code. + rc = RC_OK + + ! Add the sedimentation and dry deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + ielem = I_ELEM_SOOT + do ibin = 1, NBIN + + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + + cam_out%bcphidry(icol) = cam_out%bcphidry(icol) + max(sflx, 0._r8) + end do + + ielem = I_ELEM_DUST + do ibin = 1, NBIN + + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + + if (carma_dustmap(ibin) == 1) then + cam_out%dstdry1(icol) = cam_out%dstdry1(icol) + max(sflx, 0._r8) + else if (carma_dustmap(ibin) == 2) then + cam_out%dstdry2(icol) = cam_out%dstdry2(icol) + max(sflx, 0._r8) + else if (carma_dustmap(ibin) == 3) then + cam_out%dstdry3(icol) = cam_out%dstdry3(icol) + max(sflx, 0._r8) + else if (carma_dustmap(ibin) == 4) then + cam_out%dstdry4(icol) = cam_out%dstdry4(icol) + max(sflx, 0._r8) + end if + end do + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual, is_first_step + use camsrfexch, only: cam_in_t + use tropopause, only: tropopause_find + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8), parameter :: mu_dust_gnd = 1._r8 ! width parameter, dust, ground (km) + real(r8), parameter :: mu_dust_trop = 3._r8 ! width parameter, dust, tropopause (km) + real(r8), parameter :: mu_soot_gnd = 1._r8 ! width parameter, soot, ground (km) + real(r8), parameter :: mu_soot_trop = 3._r8 ! width parameter, soot, tropopause (km) + + integer :: tropLev(pcols) ! tropopause level index + real(r8) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8) :: tropT(pcols) ! tropopause temperature (K) + real(r8) :: tropZ(pcols) ! tropopause height (m) + + real(r8) :: lon(state%ncol) ! longitude + real(r8) :: lat(state%ncol) ! latitude + integer :: igroup ! group index + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: k ! vertical index + real(r8) :: calday ! current calendar day + integer :: currentDate ! current date (yyyydoy) + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + real(r8) :: startyear ! start year + real(r8) :: stopyear ! stop year + real(r8) :: startdoy ! start year + real(r8) :: stopdoy ! stop year + integer :: emis_time ! length of time for emission + real(r8) :: vfunc(pver) ! scaling factor to preserve total emission + character(len=32) :: shortname ! the shortname of the group + real(r8) :: zmid ! layer midpoint altitude (km) + real(r8) :: ztrop ! tropopause altitude (km) + real(r8) :: rate ! emission rate (kg/s/m) + real(r8) :: massflux ! mass flux (kg/m3/s) + real(r8) :: thickness ! layer thickness (m) + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! Determine the latitude and longitude of each column. + ncol = state%ncol + + lat = state%lat(:ncol) * RAD2DEG + lon = state%lon(:ncol) * RAD2DEG + + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! Use Toon et al. [2012] as the source function for soot and dust + ! from a 1 km meteor impact. + ! + ! For soot, it is assumed that the soot is emitted in one column + ! containing the impact and that there are two gaussian + ! distributions: one centered at the surface and one centered at + ! the tropopause. The emission rate of soot is given as g/s/km and + ! we assume that the total mass is delivered in one time step. + ! + ! NOTE: Perhaps some of these fields should end up in the CARMA + ! model namelist, so different experiments can be run more easily. + tendency(:ncol, :pver) = 0.0_r8 + + ! Determine the start and stop year and day of year from the namelist + ! variables. + currentDate = yr * 1000 + doy + startyear = carma_emis_startdate / 1000 + stopyear = carma_emis_stopdate / 1000 + + startdoy = mod(carma_emis_startdate, 1000) + stopdoy = mod(carma_emis_stopdate, 1000) + + ! Only emit particles during the specified time interval. + if (((currentDate > carma_emis_startdate) .or. & + ((currentDate == carma_emis_startdate) .and. (ncsec >= carma_emis_starttime))) .and. & + ((currentDate < carma_emis_stopdate) .or. & + ((currentDate == carma_emis_stopdate) .and. (ncsec < carma_emis_stoptime)))) then + + ! Make sure to emit for at least one timestep and in multiples of the time + ! step length. + ! TBD - This has a leap year problem, but works otherwise ... + carma_emis_dtime = INT((((stopyear - startyear) * 365._f + (stopdoy - startdoy)) * 24._f * 3600._f + & + (carma_emis_stoptime - carma_emis_starttime)) / dt) * dt + + ! For simplicity, calculate the emission function at the cell midpoint and + ! assume that rate is used throughout the cell. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname) + if (RC < RC_ERROR) return + + if ((shortname == "CRDUST") .or. (shortname == "CRSOOT")) then + + ! Find the tropopause using the default algorithm backed by the climatology. + call tropopause_find(state, tropLev, tropZ=tropZ) + + ! Loop over all of the columns. + do icol = 1, ncol + + ! Is the column one of the ones over which there should be emissions> + if ((lat(icol) > carma_emis_minlat) .and. (lat(icol) < carma_emis_maxlat) .and. & + (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(icol) >= carma_emis_minlon) .and. & + (lon(icol) <= carma_emis_maxlon)) .or. & + ((carma_emis_minlon > carma_emis_maxlon) .and. & + ((lon(icol) >= carma_emis_minlon) .or. (lon(icol) <= carma_emis_maxlon))))) then + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + + ! Get the cell midpoint and height + zmid = state%zm(icol, k) / 1000._f + + ! Get the tropopause height. + ztrop = tropZ(icol) / 1000._f + + ! Use the dust emission from Toon et al. 2012. + if (shortname == "CRDUST") then + + ! Determine the total emission rate for this grid box using equation 2 + ! from Toon et al. [2012] and also adjust for the fraction of the + ! mass that goes into the specified bin based on the assumed size + ! distribution also from Toon et al. [2012]. + vfunc(k) = 1._f / (2._f * sqrt(2._f * PI)) * & + (1._f / mu_dust_gnd * exp(-0.5_f * ((zmid / mu_dust_gnd)**2)) + & + 1._f / (2._f * mu_dust_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_dust_trop)**2))) * & + (state%zi(icol, k) - state%zi(icol, k+1)) + + rate = carma_emis_dust * carma_dustbinfactor(ibin) + end if + + ! Use the soot emissions from Toon et al. 2012. + if (shortname == "CRSOOT") then + + ! Determine the total emission rate for this grid box using equation 2 + ! from Toon et al. [2012] and also adjust for the fraction of the + ! mass that goes into the specified bin based on the assumed size + ! distribution also from Toon et al. [2012]. + vfunc(k) = 1._f / (2._f * sqrt(2._f * PI)) * & + (1._f / mu_soot_gnd * exp(-0.5_f * ((zmid / mu_soot_gnd)**2)) + & + 1._f / (2._f * mu_soot_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_soot_trop)**2))) * & + (state%zi(icol, k) - state%zi(icol, k+1)) + + + rate = carma_emis_soot * carma_sootbinfactor(ibin) + end if + + ! Calculate a rate by dividing by total emission time. + rate = rate * vfunc(k) / carma_emis_dtime + + ! Scale for the fraction of the total surface area that is emitting and + ! convert to kg/m2/s + massflux = rate / carma_emis_area + + ! Convert the mass flux to a tendency on the mass mixing ratio. + tendency(icol, k) = massflux / (state%pdel(icol, k) / gravit) + end do + + ! Now normalize in the vertical to preserve the total mass. + tendency(icol, :) = tendency(icol, :) / sum(vfunc(:)) + end if + end do + end if + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: pcnst + use dyn_grid, only: get_horiz_grid_dim_d, get_horiz_grid_d + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! NOTE: The dust distribution has not been specified yet, but it should be different + ! from the soot. + real(kind=f), parameter :: rm_dust = 0.11 ! dust mean radius (um) + real(kind=f), parameter :: sigma_dust = 1.6 ! dust variance + real(kind=f), parameter :: rm_soot = 0.11 ! soot mean radius (um) + real(kind=f), parameter :: sigma_soot = 1.6 ! soot variance + + integer :: i + integer :: hdim1_d + integer :: hdim2_d + integer :: ngcols + real(kind=f) :: r(NBIN) + real(kind=f) :: dr(NBIN) + real(kind=f) :: rmass(NBIN) + real(kind=f) :: dM(NBIN) + real(kind=f), allocatable :: lat(:) + real(kind=f), allocatable :: lon(:) + real(kind=f), allocatable :: colarea(:) + character(len=32) :: shortname ! the shortname of the group + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + 1 format(i3,5x,i3,4x,e10.3,4x,e10.3) + + ! Default return code. + rc = RC_OK + + ! Create a mapping of the CARMA dust bins to the dust sizes assumed at the + ! surface. The sizes of the dust bins at the surface are from Mahowald et al. + ! [2006]. + ! + ! 1 : 0.1 - 1.0 um + ! 2 : 1.0 - 2.5 um + ! 3 : 2.5 - 5.0 um + ! 4 : 5.0 - 10.0 um + call CARMAGROUP_GET(carma, I_GRP_DUST, rc, r=r) + if (RC < RC_ERROR) return + + do i = 1, NBIN + if (r(i) .le. 1e-4_f) then + carma_dustmap(i) = 1 + else if (r(i) .le. 2.5e-4_f) then + carma_dustmap(i) = 2 + else if (r(i) .le. 5e-4_f) then + carma_dustmap(i) = 3 + else + carma_dustmap(i) = 4 + end if + end do + + ! Determine the weight of mass in each bin based upon the size distribution specified + ! in Toon et al. [2012], for soot and dust. They are lognormal for the smaller sizes + ! and dust is lognormal for larger sizes. + + call CARMAGROUP_GET(carma, I_GRP_DUST, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + dM(:) = rmass(:) * & + exp(-(log(r(:) * 1e4_f / rm_dust) ** 2) / (2._f * (log(sigma_dust) ** 2))) / & + log(sigma_dust) * (dr(:) / r(:)) + carma_dustbinfactor(:) = dM / sum(dM) + + call CARMAGROUP_GET(carma, I_GRP_SOOT, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + dM(:) = rmass(:) * & + exp(-(log(r(:) * 1e4_f / rm_soot) ** 2) / (2._f * (log(sigma_soot) ** 2))) / & + log(sigma_soot) * (dr(:) / r(:)) + carma_sootbinfactor(:) = dM / sum(dM) + + + ! Determine the total area in which debris will be emitted. This is used to scale + ! the emission per column, based upon the fraction of surface area. This assumes a + ! regular physics grid. + call get_horiz_grid_dim_d(hdim1_d, hdim2_d) + + ngcols = hdim1_d*hdim2_d + + allocate(lat(ngcols)) + allocate(lon(ngcols)) + allocate(colarea(ngcols)) + + call get_horiz_grid_d(ngcols, clat_d_out=lat, clon_d_out=lon, area_d_out=colarea) + + lat = lat * RAD2DEG + lon = lon * RAD2DEG + + ! rad2 -> m2 + colarea = colarea * REARTH * REARTH / 1e4 + + ! Integrate surface area with same checks as in the emission routine to determine + ! the area where the emissions come from (m2). Assume that the grid box is either + ! all in or all out based upon the center lat/lon. Don't include fractions of a + ! grid box. + carma_emis_area = 0._f + + do i = 1, ngcols + if ((lat(i) >= carma_emis_minlat) .and. (lat(i) <= carma_emis_maxlat) .and. & + (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(i) >= carma_emis_minlon) .and. & + (lon(i) <= carma_emis_maxlon)) .or. & + ((carma_emis_minlon > carma_emis_maxlon) .and. & + ((lon(i) >= carma_emis_minlon) .or. (lon(i) <= carma_emis_maxlon))))) then + carma_emis_area = carma_emis_area + colarea(i) + end if + end do + + carma_emis_area = carma_emis_area + + deallocate(lat) + deallocate(lon) + deallocate(colarea) + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA Initialization ...' + + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'ibin dustmap dustfactor sootfactor' + + do i = 1, NBIN + write(LUNOPRT,1) i, carma_dustmap(i), carma_dustbinfactor(i), carma_sootbinfactor(i) + end do + + write(LUNOPRT,*) '' + write(LUNOPRT,*) ' Emission area : ', carma_emis_area / 1e6_f, ' (km^2)' + write(LUNOPRT,*) '' + + end if + end if + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + ! Add the wet deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + if (ielem == I_ELEM_SOOT) then + do icol = 1, state%ncol + cam_out%bcphiwet(icol) = cam_out%bcphiwet(icol) + max(sflx(icol), 0._r8) + end do + end if + + if (ielem == I_ELEM_DUST) then + do icol = 1, state%ncol + if (carma_dustmap(ibin) == 1) then + cam_out%dstwet1(icol) = cam_out%dstwet1(icol) + max(sflx(icol), 0._r8) + else if (carma_dustmap(ibin) == 2) then + cam_out%dstwet2(icol) = cam_out%dstwet2(icol) + max(sflx(icol), 0._r8) + else if (carma_dustmap(ibin) == 3) then + cam_out%dstwet3(icol) = cam_out%dstwet3(icol) + max(sflx(icol), 0._r8) + else if (carma_dustmap(ibin) == 4) then + cam_out%dstwet4(icol) = cam_out%dstwet4(icol) + max(sflx(icol), 0._r8) + end if + end do + end if + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..c56542d707 --- /dev/null +++ b/src/physics/carma/models/meteor_smoke/carma_model_flags_mod.F90 @@ -0,0 +1,86 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_do_escale = .false. ! Scale the emissions with the relative flux + real(r8), public :: carma_emis_total = 16.0_r8 ! Total mass emitted (kt/year) + character(len=256), public :: carma_emis_file = 'meteor_smoke_kalashnikova.nc' ! name of the emission file + character(len=256), public :: carma_escale_file = 'smoke_grf_frentzke.nc' ! name of the emission scale file + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_escale, & + carma_emis_total, & + carma_emis_file, & + carma_escale_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_do_escale, 1, mpilog, 0, mpicom) + call mpibcast(carma_emis_total, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_file, len(carma_emis_file), mpichar, 0, mpicom) + call mpibcast(carma_escale_file, len(carma_escale_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 new file mode 100644 index 0000000000..5bc4787ad5 --- /dev/null +++ b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 @@ -0,0 +1,768 @@ +!! This CARMA model is for meteor smoke aerosols and is based upon Bardeen et al., +!! JGR, 2008. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! +!! @version Jan-2011 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_METEOR_SMOKE = 1 !! meteor smoke + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_DUST = 1 !! meteor smoke + + integer, public, parameter :: I_ELEM_DUST = 1 !! meteor smoke + + ! These variables are all set during initialization and are used to calculate + ! emission tendencies. + integer :: carma_emis_nLevs ! number of emission levels + real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) + real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level + real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) + + integer :: carma_escale_nLats ! number of emission scale latitudes + integer :: carma_escale_nTimes ! number of emission scale times + integer :: carma_escale_nLTimes ! number of emission scale local times + real(r8), allocatable, dimension(:,:) :: carma_escale_grf ! global relative flux + real(r8), allocatable, dimension(:) :: carma_escale_lat ! global relative flux latitudes + real(r8), allocatable, dimension(:) :: carma_escale_lrf ! locat time realtive flux + real(r8), allocatable, dimension(:) :: carma_escale_ltime ! local time relative flux times + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) + real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale + if (do_print) write(LUNOPRT,*) ' carma_emis_total = ', carma_emis_total + if (do_print) write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) + if (do_print) write(LUNOPRT,*) ' carma_escale_file= ', trim(carma_escale_file) + end if + + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & + I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version Jan-2011 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat ! latitude index + integer :: iltime ! local time index + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + integer :: k ! vertical index + integer :: ilev ! level index in emissions data + character(len=32) :: shortname ! the shortname of the group + real(r8) :: r(NBIN) ! bin center + real(r8) :: dr(NBIN) ! bin width + real(r8) :: rmass(NBIN) ! bin mass + real(r8) :: pressure ! pressure (Pa) + real(r8) :: thickness ! layer thickness (m) + real(r8) :: rate ! emission rate (#/cm-3/s) + real(r8) :: massflux ! emission mass flux (kg/m2/s) + real(r8) :: columnMass ! mass of the total column (kg/m2/s) + real(r8) :: scale ! scaling factor to conserve the expected mass + real(r8) :: rfScale(pcols) ! scaling factor from global and local relative flux + + real(r8) :: calday ! current calendar day + integer :: yr, mon, day, ncsec, doy + integer :: ncdate + real(r8) :: ltime ! local time + + + ! Default return code. + rc = RC_OK + + ! Get the current date and time. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! NOTE: The global relative flux file is based upon a noleap calendar, + ! so don't let the doy get too big. + doy = min(365, doy) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + ! Only do emission for the first bin of the meteor smoke group. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + ! For meteoritic dust, the source from the smoke only goes into the + ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates + ! is proportional to the pressure, so the emission is a function of + ! pressure. + if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + do icol = 1, ncol + + pressure = state%pmid(icol, k) + + ! This is roughly a log-normal approximation to the production + ! rate, but only applies from about 70 to 110 km. + ! + ! NOTE: Based upon US Standard Atmosphere 1976. + if ((pressure >= carma_emis_lev(carma_emis_ilev_min)) .and. & + (pressure <= carma_emis_lev(carma_emis_ilev_max))) then + + ! The rates are in terms of # cm-3 s-1, but were really derived + ! from the mass flux of meteoritic dust. Since we are using a + ! size different that 1.3 nm for the smallest bin, scale the + ! number appropriately. + ! + ! The values are in a lookup table, so find the two numbers + ! surrounding the pressure and do a linear interpolation on the + ! rate. This linear search is kind of expensive, particularly if + ! there are a lot of points. + ! + ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) + do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr + if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then + rate = carma_emis_rate(ilev) + + if (pressure > carma_emis_lev(ilev)) then + rate = rate + & + ((carma_emis_rate(ilev+carma_emis_ilev_incr) - & + carma_emis_rate(ilev)) / (carma_emis_lev(ilev+carma_emis_ilev_incr) - & + carma_emis_lev(ilev))) * (pressure - carma_emis_lev(ilev)) + end if + + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) + exit + end if + end do + + ! Calculate the mass flux in terms of kg/m3/s + massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) + + ! Calculate a scaling if appropriate. + rfScale(icol) = 1.0_r8 + + if (carma_do_escale) then + + ! Global Scaling + ! + ! Interpolate the global scale by latitude. + ! + ! NOTE: It would be better to interpolate the table once in init to the + ! latitude structure and just look up by index. + ! + ! NOTE: The latitudes have some small significant digits at the end, which makes + ! exact comparisons to latitude values fail. + do ilat = 1, carma_escale_nLats + if ((state%lat(icol) / DEG2RAD) <= carma_escale_lat(ilat)) then + if (abs((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat)) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(ilat, doy) + else + rfScale(icol) = carma_escale_grf(ilat-1, doy) + & + (((state%lat(icol) / DEG2RAD) - & + carma_escale_lat(ilat-1)) / (carma_escale_lat(ilat) - carma_escale_lat(ilat-1))) * & + (carma_escale_grf(ilat, doy) - carma_escale_grf(ilat-1, doy)) + endif + exit + end if + end do + + if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) + end if + + ! Local Time Scaling + ! + ! Interpolate the local scale by local time. + ltime = abs((ncsec / 3600._r8) + (24._r8 * (state%lon(icol) / DEG2RAD) / 360._r8)) + if (ltime > 24._r8) then + ltime = ltime - 24._r8 + end if + + do iltime = 1, carma_escale_nLTimes + if (ltime <= carma_escale_ltime(iltime)) then + if (abs(ltime - carma_escale_ltime(iltime)) <= 0.00001_r8) then + rfScale(icol) = rfScale(icol) * carma_escale_lrf(iltime) + else + rfScale(icol) = rfScale(icol) * (carma_escale_lrf(iltime-1) + & + ((iltime - carma_escale_ltime(iltime-1)) / (carma_escale_ltime(iltime) - carma_escale_ltime(iltime-1))) * & + (carma_escale_lrf(iltime) - carma_escale_lrf(iltime-1))) + endif + exit + end if + end do + endif + + ! Convert the mass flux to a tendency on the mass mixing ratio. + thickness = state%zi(icol, k) - state%zi(icol, k+1) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + end if + enddo + enddo + + ! Scale the columns to keep the total mass influx in the column a + ! constant. + do icol = 1, ncol + columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) + scale = carma_emis_expected / columnMass + + ! Also apply the relative flux scaling. This needs to be done after + ! the normalization + tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use ioFileMod, only: getfil + use constituents, only: pcnst + use wrap_nf + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilev ! level index + integer :: fid ! file id + integer :: lev_did ! level dimension id + integer :: lev_vid ! level variable id + integer :: rate_vid ! rate variable + integer :: tmp + integer :: lat_did ! latitude dimension id + integer :: ltime_did ! local time dimension id + integer :: time_did ! time + integer :: lat_vid ! latitude variable id + integer :: lrf_vid ! local relative flux variable id + integer :: grf_vid ! global relative flux variable id + integer :: ltime_vid ! local time variable id + character(len=256) :: efile ! emission file name + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + ! Initialize the emissions rate table. + if (carma_do_emission) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_emis_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission rates from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lev", lev_did) + call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_emis_lev(carma_emis_nLevs)) + allocate(carma_emis_rate(carma_emis_nLevs)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'MSMOKE', rate_vid) + call wrap_get_var_realx(fid, rate_vid, carma_emis_rate) + + call wrap_inq_varid(fid, 'lev', lev_vid) + call wrap_get_var_realx(fid, lev_vid, carma_emis_lev) + + ! Close the file. + call wrap_close(fid) + + ! Find out where the bounds of the table are and in what order + ! the pressures levels are in. + carma_emis_ilev_min = 1 + carma_emis_ilev_max = carma_emis_nLevs + + do ilev = 1, carma_emis_nLevs + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_min = ilev + 1 + else + exit + endif + end do + + do ilev = carma_emis_nLevs, 1, -1 + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_max = ilev - 1 + else + exit + endif + end do + + if (carma_emis_lev(carma_emis_ilev_min) < carma_emis_lev(carma_emis_ilev_max)) then + carma_emis_ilev_incr = 1 + else + carma_emis_ilev_incr = -1 + tmp = carma_emis_ilev_min + carma_emis_ilev_min = carma_emis_ilev_max + carma_emis_iLev_max = tmp + endif + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' + do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) + enddo + + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' + carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & + (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission table.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_lev, carma_emis_nLevs, mpir8, 0, mpicom) + call mpibcast(carma_emis_rate, carma_emis_nLevs, mpir8, 0, mpicom) + + call mpibcast(carma_emis_expected, 1, mpir8, 0, mpicom) + + call mpibcast(carma_emis_ilev_min, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_max, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_incr, 1, mpiint, 0, mpicom) +#endif + + endif + + + ! Initialize the emissions scaling table. + if (carma_do_escale) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_escale_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission scaling from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lat", lat_did) + call wrap_inq_dimlen(fid, lat_did, carma_escale_nLats) + + call wrap_inq_dimid(fid, "time", time_did) + call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) + + ! There should be one time for each day of the year, so + ! quit if it isn't correct. + if (carma_escale_nTimes .ne. 365) then + call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + endif + + call wrap_inq_dimid(fid, "ltime", ltime_did) + call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nLTimes, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_escale_lat(carma_escale_nLats)) + allocate(carma_escale_grf(carma_escale_nLats, carma_escale_nTimes)) + allocate(carma_escale_ltime(carma_escale_nLTimes)) + allocate(carma_escale_lrf(carma_escale_nLTimes)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'SGRF', grf_vid) + tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) + if (tmp/=NF90_NOERR) then + write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + call handle_error (tmp) + end if + + call wrap_inq_varid(fid, 'lat', lat_vid) + call wrap_get_var_realx(fid, lat_vid, carma_escale_lat) + + call wrap_inq_varid(fid, 'SLRF', lrf_vid) + call wrap_get_var_realx(fid, lrf_vid, carma_escale_lrf) + + call wrap_inq_varid(fid, 'ltime', ltime_vid) + call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) + + ! Close the file. + call wrap_close(fid) + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLats = ', carma_escale_nLats + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_lat, carma_escale_nLats, mpir8, 0, mpicom) + call mpibcast(carma_escale_grf, carma_escale_nLats*carma_escale_nTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_ltime, carma_escale_nLTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_lrf, carma_escale_nLTimes, mpir8, 0, mpicom) +#endif + + endif + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..2fde981d4f --- /dev/null +++ b/src/physics/carma/models/mixed_sulfate/carma_model_flags_mod.F90 @@ -0,0 +1,89 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_do_escale = .false. ! Scale the emissions with the relative flux + logical, public :: carma_neutral_h2so4 = .false. ! Treat h2so4 vapor pressure as over neutralize sulfates + real(r8), public :: carma_emis_total = 16.0_r8 ! Total mass emitted (kt/year) + character(len=256), public :: carma_emis_file = 'meteor_smoke_kalashnikova.nc' ! name of the emission file + character(len=256), public :: carma_escale_file = 'smoke_grf_frentzke.nc' ! name of the emission scale file + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_escale, & + carma_neutral_h2so4, & + carma_emis_total, & + carma_emis_file, & + carma_escale_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_do_escale, 1, mpilog, 0, mpicom) + call mpibcast(carma_neutral_h2so4, 1, mpilog, 0, mpicom) + call mpibcast(carma_emis_total, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_file, len(carma_emis_file), mpichar, 0, mpicom) + call mpibcast(carma_escale_file, len(carma_escale_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 new file mode 100644 index 0000000000..803a37edd6 --- /dev/null +++ b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 @@ -0,0 +1,847 @@ +!! This CARMA model is for meteor smoke aerosols and sulfates +!! is based upon Mills.. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! +!! NOTE: This model is still under development and is not intended to be released as +!! part of the standard CAM distribution. Please contact Charles Bardeen at +!! bardeenc@ucar.edu if you are interested in using or deriving off of this +!! work. +!! +!! @version Jul-2013 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 3 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 2 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_METEOR_SMOKE = 1 !! meteor smoke + integer, public, parameter :: I_H2SO4 = 2 !! sulfuric acid + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_DUST = 1 !! meteor smoke + integer, public, parameter :: I_GRP_SULFATE = 2 !! sulfate aerosol + + integer, public, parameter :: I_ELEM_DUST = 1 !! meteor smoke + integer, public, parameter :: I_ELEM_SULFATE = 2 !! sulfate aerosol + integer, public, parameter :: I_ELEM_SULCORE = 3 !! meteor smoke core in sulfate + + integer, public, parameter :: I_SOL_CRH2SO4 = 1 !! sulfuric acid + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + integer, public, parameter :: I_GAS_H2SO4 = 2 !! sulphuric acid + + real(kind=f), public, parameter :: WTMOL_H2SO4 = 98.078479_f !! molecular weight of sulphuric acid + + ! These variables are all set during initialization and are used to calculate + ! emission tendencies. + integer :: carma_emis_nLevs ! number of emission levels + real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) + real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level + real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) + + integer :: carma_escale_nLats ! number of emission scale latitudes + integer :: carma_escale_nTimes ! number of emission scale times + integer :: carma_escale_nLTimes ! number of emission scale local times + real(r8), allocatable, dimension(:,:) :: carma_escale_grf ! global relative flux + real(r8), allocatable, dimension(:) :: carma_escale_lat ! global relative flux latitudes + real(r8), allocatable, dimension(:) :: carma_escale_lrf ! locat time realtive flux + real(r8), allocatable, dimension(:) :: carma_escale_ltime ! local time relative flux times + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use ioFileMod, only: getfil + use wrap_nf + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) + real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) + real(kind=f), parameter :: RHO_SULFATE = 1.923_f ! dry density of sulfate particles (g/cm3) +! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: + real(kind=f), parameter :: rmin_sulfate = 3.43230298e-8_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat_sulfate = 2.56_f ! volume ratio (adjusted for 28 bins from 2.4 for 30 bins) + + + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale + write(LUNOPRT,*) ' carma_neutral_h2s04 = ', carma_neutral_h2so4 + write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) + write(LUNOPRT,*) ' carma_escale_file = ', trim(carma_escale_file) + end if + end if + + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + ! solfac was formerly set to 0.3, changed to 1.0 because it seems physical. + ! This change needs to be validated -MJM 12/1/2011 + ! + ! NOTE: Add flag to enable neutralization for sulfates? + call CARMAGROUP_Create(carma, I_GRP_SULFATE, "sulfate", rmin_sulfate, vmrat_sulfate, I_SPHERE, 1._f, .false., & + rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=1.0_f, & + scavcoef=0.1_f, is_sulfate=.true., shortname="SULF") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & + I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "sulfate", RHO_SULFATE, & + I_VOLATILE, I_H2SO4, rc, shortname="SULF") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_SULCORE, I_GRP_SULFATE, "sulfate core", RHO_METEOR_SMOKE, & + I_COREMASS, I_METEOR_SMOKE, rc, shortname="SFCORE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes + ! + ! Should this be a RHO_SULFATE_WET of 1.38? + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & + I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", & + ds_threshold=0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, & + I_VAPRTN_H2SO4_AYERS1980, I_GCOMP_H2SO4, rc, shortname = "H2SO4", & + ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium + ! and will be used to define the wet particle radius. + call CARMA_AddGrowth(carma, I_ELEM_SULFATE, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_SULFATE, I_ELEM_SULFATE, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + ! Also need nucleation with meteor smoke. + call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_SULCORE, I_HETNUCSULF, 0._f, rc, igas=I_GAS_H2SO4, ievp2elem=I_ELEM_DUST) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_SULFATE, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + ! Dust-Sulfate Coagulation? + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat ! latitude index + integer :: iltime ! local time index + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + integer :: k ! vertical index + integer :: ilev ! level index in emissions data + character(len=32) :: shortname ! the shortname of the group + real(r8) :: r(NBIN) ! bin center + real(r8) :: dr(NBIN) ! bin width + real(r8) :: rmass(NBIN) ! bin mass + real(r8) :: pressure ! pressure (Pa) + real(r8) :: thickness ! layer thickness (m) + real(r8) :: rate ! emission rate (#/cm-3/s) + real(r8) :: massflux ! emission mass flux (kg/m2/s) + real(r8) :: columnMass ! mass of the total column (kg/m2/s) + real(r8) :: scale ! scaling factor to conserve the expected mass + real(r8) :: rfScale(pcols) ! scaling factor from global and local relative flux + + real(r8) :: calday ! current calendar day + integer :: yr, mon, day, ncsec, doy + integer :: ncdate + real(r8) :: ltime ! local time + + + ! Default return code. + rc = RC_OK + + ! Get the current date and time. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! NOTE: The global realtive flux file is based upon a noleap calendar, so don't + ! let the doy get too big. + doy = min(365, doy) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + ! Only do emission for the first bin of the meteor smoke group. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + ! For meteoritic dust, the source from the smoke only goes into the + ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates + ! is proportional to the pressure, so the emission is a function of + ! pressure. + if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + do icol = 1, ncol + + pressure = state%pmid(icol, k) + + ! This is roughly a log-normal approximation to the production + ! rate, but only applies from about 70 to 110 km. + ! + ! NOTE: Based upon US Standard Atmosphere 1976. + if ((pressure >= carma_emis_lev(carma_emis_ilev_min)) .and. & + (pressure <= carma_emis_lev(carma_emis_ilev_max))) then + + ! The rates are in terms of # cm-3 s-1, but were really derived + ! from the mass flux of meteoritic dust. Since we are using a + ! size different that 1.3 nm for the smallest bin, scale the + ! number appropriately. + ! + ! The values are in a lookup table, so find the two numbers + ! surrounding the pressure and do a linear interpolation on the + ! rate. This linear search is kind of expensive, particularly if + ! there are a lot of points. + ! + ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) + do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr + if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then + rate = carma_emis_rate(ilev) + + if (pressure > carma_emis_lev(ilev)) then + rate = rate + & + ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & + (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & + (pressure - carma_emis_lev(ilev)) + end if + + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) + exit + end if + end do + + ! Calculate the mass flux in terms of kg/m3/s + massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) + + ! Calculate a scaling if appropriate. + rfScale(icol) = 1.0_r8 + + if (carma_do_escale) then + + ! Global Scaling + ! + ! Interpolate the global scale by latitude. + ! + ! NOTE: It would be better to interpolate the table once in init to the + ! latitude structure and just look up by index. + ! + ! NOTE: The latitudes have some small significant digits at the end, which makes + ! exact comparisons to latitude values fail. + do ilat = 1, carma_escale_nLats + if ((state%lat(icol) / DEG2RAD) <= carma_escale_lat(ilat)) then + if (abs((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat)) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(ilat, doy) + else + rfScale(icol) = carma_escale_grf(ilat-1, doy) + & + (((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat-1)) / & + (carma_escale_lat(ilat) - carma_escale_lat(ilat-1))) * & + (carma_escale_grf(ilat, doy) - carma_escale_grf(ilat-1, doy)) + endif + exit + end if + end do + + if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) + end if + + ! Local Time Scaling + ! + ! Interpolate the local scale by local time. + ltime = abs((ncsec / 3600._r8) + (24._r8 * (state%lon(icol) / DEG2RAD) / 360._r8)) + if (ltime > 24._r8) then + ltime = ltime - 24._r8 + end if + + do iltime = 1, carma_escale_nLTimes + if (ltime <= carma_escale_ltime(iltime)) then + if (abs(ltime - carma_escale_ltime(iltime)) <= 0.00001_r8) then + rfScale(icol) = rfScale(icol) * carma_escale_lrf(iltime) + else + rfScale(icol) = rfScale(icol) * (carma_escale_lrf(iltime-1) + & + ((iltime - carma_escale_ltime(iltime-1)) / (carma_escale_ltime(iltime) - carma_escale_ltime(iltime-1))) * & + (carma_escale_lrf(iltime) - carma_escale_lrf(iltime-1))) + endif + exit + end if + end do + endif + + ! Convert the mass flux to a tendency on the mass mixing ratio. + thickness = state%zi(icol, k) - state%zi(icol, k+1) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + end if + enddo + enddo + + ! Scale the columns to keep the total mass influx in the column a + ! constant. + do icol = 1, ncol + columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) + + ! Protect against divide-by-zero (but not overflow). + if (columnMass /= 0._r8) then + scale = carma_emis_expected / columnMass + else + scale = 0._r8 + end if + + ! Also apply the relative flux scaling. This needs to be done after + ! the normalization + tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: pcnst + use ioFileMod, only: getfil + use wrap_nf + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilev ! level index + integer :: fid ! file id + integer :: lev_did ! level dimension id + integer :: lev_vid ! level variable id + integer :: rate_vid ! rate variable + integer :: tmp + integer :: lat_did ! latitude dimension id + integer :: ltime_did ! local time dimension id + integer :: time_did ! time + integer :: lat_vid ! latitude variable id + integer :: lrf_vid ! local relative flux variable id + integer :: grf_vid ! global relative flux variable id + integer :: ltime_vid ! local time variable id + character(len=256) :: efile ! emission file name + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + ! Initialize the emissions rate table. + if (carma_do_emission) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_emis_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission rates from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lev", lev_did) + call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_emis_lev(carma_emis_nLevs)) + allocate(carma_emis_rate(carma_emis_nLevs)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'MSMOKE', rate_vid) + call wrap_get_var_realx(fid, rate_vid, carma_emis_rate) + + call wrap_inq_varid(fid, 'lev', lev_vid) + call wrap_get_var_realx(fid, lev_vid, carma_emis_lev) + + ! Close the file. + call wrap_close(fid) + + ! Find out where the bounds of the table are and in what order + ! the pressures levels are in. + carma_emis_ilev_min = 1 + carma_emis_ilev_max = carma_emis_nLevs + + do ilev = 1, carma_emis_nLevs + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_min = ilev + 1 + else + exit + endif + end do + + do ilev = carma_emis_nLevs, 1, -1 + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_max = ilev - 1 + else + exit + endif + end do + + if (carma_emis_lev(carma_emis_ilev_min) < carma_emis_lev(carma_emis_ilev_max)) then + carma_emis_ilev_incr = 1 + else + carma_emis_ilev_incr = -1 + tmp = carma_emis_ilev_min + carma_emis_ilev_min = carma_emis_ilev_max + carma_emis_iLev_max = tmp + endif + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' + do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) + enddo + + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' + carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & + (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission table.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_lev, carma_emis_nLevs, mpir8, 0, mpicom) + call mpibcast(carma_emis_rate, carma_emis_nLevs, mpir8, 0, mpicom) + + call mpibcast(carma_emis_expected, 1, mpir8, 0, mpicom) + + call mpibcast(carma_emis_ilev_min, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_max, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_incr, 1, mpiint, 0, mpicom) +#endif + + endif + + + ! Initialize the emissions scaling table. + if (carma_do_escale) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_escale_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission scaling from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lat", lat_did) + call wrap_inq_dimlen(fid, lat_did, carma_escale_nLats) + + call wrap_inq_dimid(fid, "time", time_did) + call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) + + ! There should be one time for each day of the year, so + ! quit if it isn't correct. + if (carma_escale_nTimes .ne. 365) then + call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + endif + + call wrap_inq_dimid(fid, "ltime", ltime_did) + call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nLTimes, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_escale_lat(carma_escale_nLats)) + allocate(carma_escale_grf(carma_escale_nLats, carma_escale_nTimes)) + allocate(carma_escale_ltime(carma_escale_nLTimes)) + allocate(carma_escale_lrf(carma_escale_nLTimes)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'SGRF', grf_vid) + tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) + if (tmp/=NF90_NOERR) then + write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + call handle_error (tmp) + end if + + call wrap_inq_varid(fid, 'lat', lat_vid) + call wrap_get_var_realx(fid, lat_vid, carma_escale_lat) + + call wrap_inq_varid(fid, 'SLRF', lrf_vid) + call wrap_get_var_realx(fid, lrf_vid, carma_escale_lrf) + + call wrap_inq_varid(fid, 'ltime', ltime_vid) + call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) + + ! Close the file. + call wrap_close(fid) + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLats = ', carma_escale_nLats + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_lat, carma_escale_nLats, mpir8, 0, mpicom) + call mpibcast(carma_escale_grf, carma_escale_nLats*carma_escale_nTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_ltime, carma_escale_nLTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_lrf, carma_escale_nLTimes, mpir8, 0, mpicom) +#endif + + endif + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/pmc/carma_model_flags_mod.F90 b/src/physics/carma/models/pmc/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..4f87403f75 --- /dev/null +++ b/src/physics/carma/models/pmc/carma_model_flags_mod.F90 @@ -0,0 +1,89 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_do_escale = .false. ! Scale the emissions with the relative flux + real(r8), public :: carma_emis_total = 16.0_r8 ! Total mass emitted (kt/year) + character(len=256), public :: carma_emis_file = 'meteor_smoke_kalashnikova.nc' ! name of the emission file + character(len=256), public :: carma_escale_file = 'smoke_grf_frentzke.nc' ! name of the emission scale file + character(len=256), public :: carma_mice_file = 'mice_warren2008.nc' ! name of the ice refractive index file + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_escale, & + carma_emis_total, & + carma_emis_file, & + carma_escale_file, & + carma_mice_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_do_escale, 1, mpilog, 0, mpicom) + call mpibcast(carma_emis_total, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_file, len(carma_emis_file), mpichar, 0, mpicom) + call mpibcast(carma_escale_file, len(carma_escale_file), mpichar, 0, mpicom) + call mpibcast(carma_mice_file, len(carma_mice_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/pmc/carma_model_mod.F90 b/src/physics/carma/models/pmc/carma_model_mod.F90 new file mode 100644 index 0000000000..1ddd1b1347 --- /dev/null +++ b/src/physics/carma/models/pmc/carma_model_mod.F90 @@ -0,0 +1,885 @@ +!! This CARMA model is for polar mesospheric clouds and meteor smoke aerosols and +!! is based upon Bardeen et al., JGR, 2010. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! +!! @version Jan-2011 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 3 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 1 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_METEOR_SMOKE = 1 !! meteor smoke + integer, public, parameter :: I_ICE = 2 !! ice + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_DUST = 1 !! meteor smoke + integer, public, parameter :: I_GRP_CRICE = 2 !! ice + + integer, public, parameter :: I_ELEM_DUST = 1 !! meteor smoke + integer, public, parameter :: I_ELEM_CRICE = 2 !! ice + integer, public, parameter :: I_ELEM_CRCORE = 3 !! meteor smoke core + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + + + ! These variables are all set during initialization and are used to calculate + ! emission tendencies. + integer :: carma_emis_nLevs ! number of emission levels + real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) + real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level + real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) + + integer :: carma_escale_nLats ! number of emission scale latitudes + integer :: carma_escale_nTimes ! number of emission scale times + integer :: carma_escale_nLTimes ! number of emission scale local times + real(r8), allocatable, dimension(:,:) :: carma_escale_grf ! global relative flux + real(r8), allocatable, dimension(:) :: carma_escale_lat ! global relative flux latitudes + real(r8), allocatable, dimension(:) :: carma_escale_lrf ! locat time realtive flux + real(r8), allocatable, dimension(:) :: carma_escale_ltime ! local time relative flux times + + integer :: warren_nwave ! number of wavelengths in file + real(r8), allocatable, dimension(:) :: warren_wave ! Warren & Brandt 2008, wavelengths + real(r8), allocatable, dimension(:) :: warren_real ! Warren & Brandt 2008, real part of m + real(r8), allocatable, dimension(:) :: warren_imag ! Warren & Brandt 2008, imag part of m + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use ioFileMod, only: getfil + use wrap_nf + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) + real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) + integer :: i + integer :: j + real(kind=f) :: wave(NWAVE) ! CAM band wavelength centers (cm) + integer :: fid + integer :: wave_did + integer :: wave_vid + integer :: real_vid + integer :: imag_vid + character(len=256) :: efile ! refractive index file name + real(kind=f) :: interp + complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale + write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) + write(LUNOPRT,*) ' carma_escale_file= ', trim(carma_escale_file) + write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) + end if + end if + + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="DUST") + + + ! Get the refractive index for ice as a function of wavelength for particle heating + ! calculations. + ! + ! NOTE: These values probably should be a band average, but for now just do band centers. + + ! Read the values in from Warren et al. 2008. + if (carma_do_pheat) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_mice_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "wavelength", wave_did) + call wrap_inq_dimlen(fid, wave_did, warren_nwave) + endif + +#if ( defined SPMD ) + call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) +#endif + + allocate(warren_wave(warren_nwave)) + allocate(warren_real(warren_nwave)) + allocate(warren_imag(warren_nwave)) + + if (masterproc) then + + ! Read in the tables. + call wrap_inq_varid(fid, 'wavelength', wave_vid) + call wrap_get_var_realx(fid, wave_vid, warren_wave) + warren_wave = warren_wave * 1e-4 ! um -> cm + + call wrap_inq_varid(fid, 'm_real', real_vid) + call wrap_get_var_realx(fid, real_vid, warren_real) + + call wrap_inq_varid(fid, 'm_imag', imag_vid) + call wrap_get_var_realx(fid, imag_vid, warren_imag) + + ! Close the file. + call wrap_close(fid) + end if + +#if ( defined SPMD ) + call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) +#endif + + ! Interpolate the values. + do i = 1, NWAVE + do j = 1, warren_nwave + if (wave(i) > warren_wave(j)) then + if (j > 1) then + interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) + refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1))) + else + refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) + endif + + exit + end if + end do + end do + end if + + call CARMAGROUP_Create(carma, I_GRP_CRICE, "ice crystal", rmin, 2.2_f, I_SPHERE, 1._f, .true., & + rc, do_mie=carma_do_pheat, refidx=refidx_ice, shortname="CRICE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & + I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "ice crystal", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRICE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "ice core", RHO_METEOR_SMOKE, & + I_COREMASS, I_METEOR_SMOKE, rc, shortname="CRCORE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & + I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_CRCORE, I_HETNUC, 0._f, rc, & + igas=I_GAS_H2O, ievp2elem=I_ELEM_DUST) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_CRICE, I_GRP_CRICE, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat ! latitude index + integer :: iltime ! local time index + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + integer :: k ! vertical index + integer :: ilev ! level index in emissions data + character(len=32) :: shortname ! the shortname of the group + real(r8) :: r(NBIN) ! bin center + real(r8) :: dr(NBIN) ! bin width + real(r8) :: rmass(NBIN) ! bin mass + real(r8) :: pressure ! pressure (Pa) + real(r8) :: thickness ! layer thickness (m) + real(r8) :: rate ! emission rate (#/cm-3/s) + real(r8) :: massflux ! emission mass flux (kg/m2/s) + real(r8) :: columnMass ! mass of the total column (kg/m2/s) + real(r8) :: scale ! scaling factor to conserve the expected mass + real(r8) :: rfScale(pcols) ! scaling factor from global and local relative flux + + real(r8) :: calday ! current calendar day + integer :: yr, mon, day, ncsec, doy + integer :: ncdate + real(r8) :: ltime ! local time + + + ! Default return code. + rc = RC_OK + + ! Get the current date and time. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! NOTE: The global relative flux file is based upon a noleap calendar, + ! so don't let the doy get too big. + doy = min(365, doy) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + ! Only do emission for the first bin of the meteor smoke group. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + ! For meteoritic dust, the source from the smoke only goes into the + ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates + ! is proportional to the pressure, so the emission is a function of + ! pressure. + if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + do icol = 1, ncol + + pressure = state%pmid(icol, k) + + ! This is roughly a log-normal approximation to the production + ! rate, but only applies from about 70 to 110 km. + ! + ! NOTE: Based upon US Standard Atmosphere 1976. + if ((pressure >= carma_emis_lev(carma_emis_ilev_min)) .and. & + (pressure <= carma_emis_lev(carma_emis_ilev_max))) then + + ! The rates are in terms of # cm-3 s-1, but were really derived + ! from the mass flux of meteoritic dust. Since we are using a + ! size different that 1.3 nm for the smallest bin, scale the + ! number appropriately. + ! + ! The values are in a lookup table, so find the two numbers + ! surrounding the pressure and do a linear interpolation on the + ! rate. This linear search is kind of expensive, particularly if + ! there are a lot of points. + ! + ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) + do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr + if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then + rate = carma_emis_rate(ilev) + + if (pressure > carma_emis_lev(ilev)) then + rate = rate + & + ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & + (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & + (pressure - carma_emis_lev(ilev)) + end if + + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) + exit + end if + end do + + ! Calculate the mass flux in terms of kg/m3/s + massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) + + ! Calculate a scaling if appropriate. + rfScale(icol) = 1.0_r8 + + if (carma_do_escale) then + + ! Global Scaling + ! + ! Interpolate the global scale by latitude. + ! + ! NOTE: It would be better to interpolate the table once in init to the + ! latitude structure and just look up by index. + ! + ! NOTE: The latitudes have some small significant digits at the end, which makes + ! exact comparisons to latitude values fail. + do ilat = 1, carma_escale_nLats + if ((state%lat(icol) / DEG2RAD) <= carma_escale_lat(ilat)) then + if (abs((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat)) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(ilat, doy) + else + rfScale(icol) = carma_escale_grf(ilat-1, doy) + & + (((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat-1)) / & + (carma_escale_lat(ilat) - carma_escale_lat(ilat-1))) * & + (carma_escale_grf(ilat, doy) - carma_escale_grf(ilat-1, doy)) + endif + exit + end if + end do + + if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) + end if + + ! Local Time Scaling + ! + ! Interpolate the local scale by local time. + ltime = abs((ncsec / 3600._r8) + (24._r8 * (state%lon(icol) / DEG2RAD) / 360._r8)) + if (ltime > 24._r8) then + ltime = ltime - 24._r8 + end if + + do iltime = 1, carma_escale_nLTimes + if (ltime <= carma_escale_ltime(iltime)) then + if (abs(ltime - carma_escale_ltime(iltime)) <= 0.00001_r8) then + rfScale(icol) = rfScale(icol) * carma_escale_lrf(iltime) + else + rfScale(icol) = rfScale(icol) * (carma_escale_lrf(iltime-1) + & + ((iltime - carma_escale_ltime(iltime-1)) / (carma_escale_ltime(iltime) - carma_escale_ltime(iltime-1))) * & + (carma_escale_lrf(iltime) - carma_escale_lrf(iltime-1))) + endif + exit + end if + end do + endif + + ! Convert the mass flux to a tendency on the mass mixing ratio. + thickness = state%zi(icol, k) - state%zi(icol, k+1) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + end if + enddo + enddo + + ! Scale the columns to keep the total mass influx in the column a + ! constant. + do icol = 1, ncol + columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) + scale = carma_emis_expected / columnMass + + ! Also apply the relative flux scaling. This needs to be done after + ! the normalization + tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use ioFileMod, only: getfil + use constituents, only: pcnst + use wrap_nf + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilev ! level index + integer :: fid ! file id + integer :: lev_did ! level dimension id + integer :: lev_vid ! level variable id + integer :: rate_vid ! rate variable + integer :: tmp + integer :: lat_did ! latitude dimension id + integer :: ltime_did ! local time dimension id + integer :: time_did ! time + integer :: lat_vid ! latitude variable id + integer :: lrf_vid ! local relative flux variable id + integer :: grf_vid ! global relative flux variable id + integer :: ltime_vid ! local time variable id + character(len=256) :: efile ! emission file name + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + ! Initialize the emissions rate table. + if (carma_do_emission) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_emis_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission rates from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lev", lev_did) + call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_emis_lev(carma_emis_nLevs)) + allocate(carma_emis_rate(carma_emis_nLevs)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'MSMOKE', rate_vid) + call wrap_get_var_realx(fid, rate_vid, carma_emis_rate) + + call wrap_inq_varid(fid, 'lev', lev_vid) + call wrap_get_var_realx(fid, lev_vid, carma_emis_lev) + + ! Close the file. + call wrap_close(fid) + + ! Find out where the bounds of the table are and in what order + ! the pressures levels are in. + carma_emis_ilev_min = 1 + carma_emis_ilev_max = carma_emis_nLevs + + do ilev = 1, carma_emis_nLevs + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_min = ilev + 1 + else + exit + endif + end do + + do ilev = carma_emis_nLevs, 1, -1 + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_max = ilev - 1 + else + exit + endif + end do + + if (carma_emis_lev(carma_emis_ilev_min) < carma_emis_lev(carma_emis_ilev_max)) then + carma_emis_ilev_incr = 1 + else + carma_emis_ilev_incr = -1 + tmp = carma_emis_ilev_min + carma_emis_ilev_min = carma_emis_ilev_max + carma_emis_iLev_max = tmp + endif + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' + do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) + enddo + + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' + carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & + (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission table.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_lev, carma_emis_nLevs, mpir8, 0, mpicom) + call mpibcast(carma_emis_rate, carma_emis_nLevs, mpir8, 0, mpicom) + + call mpibcast(carma_emis_expected, 1, mpir8, 0, mpicom) + + call mpibcast(carma_emis_ilev_min, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_max, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_incr, 1, mpiint, 0, mpicom) +#endif + + endif + + + ! Initialize the emissions scaling table. + if (carma_do_escale) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_escale_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission scaling from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lat", lat_did) + call wrap_inq_dimlen(fid, lat_did, carma_escale_nLats) + + call wrap_inq_dimid(fid, "time", time_did) + call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) + + ! There should be one time for each day of the year, so + ! quit if it isn't correct. + if (carma_escale_nTimes .ne. 365) then + call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + endif + + call wrap_inq_dimid(fid, "ltime", ltime_did) + call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nLTimes, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_escale_lat(carma_escale_nLats)) + allocate(carma_escale_grf(carma_escale_nLats, carma_escale_nTimes)) + allocate(carma_escale_ltime(carma_escale_nLTimes)) + allocate(carma_escale_lrf(carma_escale_nLTimes)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'SGRF', grf_vid) + tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) + if (tmp/=NF90_NOERR) then + write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + call handle_error (tmp) + end if + + call wrap_inq_varid(fid, 'lat', lat_vid) + call wrap_get_var_realx(fid, lat_vid, carma_escale_lat) + + call wrap_inq_varid(fid, 'SLRF', lrf_vid) + call wrap_get_var_realx(fid, lrf_vid, carma_escale_lrf) + + call wrap_inq_varid(fid, 'ltime', ltime_vid) + call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) + + ! Close the file. + call wrap_close(fid) + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLats = ', carma_escale_nLats + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_lat, carma_escale_nLats, mpir8, 0, mpicom) + call mpibcast(carma_escale_grf, carma_escale_nLats*carma_escale_nTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_ltime, carma_escale_nLTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_lrf, carma_escale_nLTimes, mpir8, 0, mpicom) +#endif + + endif + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 b/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..46f83fec4b --- /dev/null +++ b/src/physics/carma/models/pmc_sulfate/carma_model_flags_mod.F90 @@ -0,0 +1,92 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_do_escale = .false. ! Scale the emissions with the relative flux + logical, public :: carma_neutral_h2so4 = .false. ! Treat h2so4 vapor pressure as over neutralize sulfates + real(r8), public :: carma_emis_total = 16.0_r8 ! Total mass emitted (kt/year) + character(len=256), public :: carma_emis_file = 'meteor_smoke_kalashnikova.nc' ! name of the emission file + character(len=256), public :: carma_escale_file = 'smoke_grf_frentzke.nc' ! name of the emission scale file + character(len=256), public :: carma_mice_file = 'mice_warren2008.nc' ! name of the ice refractive index file + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_escale, & + carma_neutral_h2so4, & + carma_emis_total, & + carma_emis_file, & + carma_escale_file, & + carma_mice_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_do_escale, 1, mpilog, 0, mpicom) + call mpibcast(carma_neutral_h2so4, 1, mpilog, 0, mpicom) + call mpibcast(carma_emis_total, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_file, len(carma_emis_file), mpichar, 0, mpicom) + call mpibcast(carma_escale_file, len(carma_escale_file), mpichar, 0, mpicom) + call mpibcast(carma_mice_file, len(carma_mice_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 new file mode 100644 index 0000000000..4a9e08d5be --- /dev/null +++ b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 @@ -0,0 +1,956 @@ +!! This CARMA model is for polar mesospheric clouds and meteor smoke aerosols and +!! is based upon Bardeen et al., JGR, 2010. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeModel() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! +!! NOTE: This model is still under development and is not intended to be released as +!! part of the standard CAM distribution. Please contact Charles Bardeen at +!! bardeenc@ucar.edu if you are interested in using or deriving off of this +!! work. +!! +!! @version Jan-2011 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + +#if ( defined SPMD ) + use mpishorthand +#endif + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 3 !! Number of particle groups + integer, public, parameter :: NELEM = 5 !! Number of particle elements + integer, public, parameter :: NBIN = 28 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 2 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_METEOR_SMOKE = 1 !! meteor smoke + integer, public, parameter :: I_ICE = 2 !! ice + integer, public, parameter :: I_H2SO4 = 3 !! sulfuric acid + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_DUST = 1 !! meteor smoke + integer, public, parameter :: I_GRP_CRICE = 2 !! ice + integer, public, parameter :: I_GRP_SULFATE = 3 !! sulfate aerosol + + integer, public, parameter :: I_ELEM_DUST = 1 !! meteor smoke + integer, public, parameter :: I_ELEM_CRICE = 2 !! ice + integer, public, parameter :: I_ELEM_CRCORE = 3 !! meteor smoke core in ice + integer, public, parameter :: I_ELEM_SULFATE = 4 !! sulfate aerosol + integer, public, parameter :: I_ELEM_SULCORE = 5 !! meteor smoke core in sulfate + + integer, public, parameter :: I_SOL_CRH2SO4 = 1 !! sulfuric acid + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + integer, public, parameter :: I_GAS_H2SO4 = 2 !! sulphuric acid + + real(kind=f), public, parameter :: WTMOL_H2SO4 = 98.078479_f !! molecular weight of sulphuric acid + + ! These variables are all set during initialization and are used to calculate + ! emission tendencies. + integer :: carma_emis_nLevs ! number of emission levels + real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) + real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level + real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) + + integer :: carma_escale_nLats ! number of emission scale latitudes + integer :: carma_escale_nTimes ! number of emission scale times + integer :: carma_escale_nLTimes ! number of emission scale local times + real(r8), allocatable, dimension(:,:) :: carma_escale_grf ! global relative flux + real(r8), allocatable, dimension(:) :: carma_escale_lat ! global relative flux latitudes + real(r8), allocatable, dimension(:) :: carma_escale_lrf ! locat time realtive flux + real(r8), allocatable, dimension(:) :: carma_escale_ltime ! local time relative flux times + + integer :: warren_nwave ! number of wavelengths in file + real(r8), allocatable, dimension(:) :: warren_wave ! Warren & Brandt 2008, wavelengths + real(r8), allocatable, dimension(:) :: warren_real ! Warren & Brandt 2008, real part of m + real(r8), allocatable, dimension(:) :: warren_imag ! Warren & Brandt 2008, imag part of m + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use ioFileMod, only: getfil + use wrap_nf + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) + real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) + real(kind=f), parameter :: RHO_SULFATE = 1.923_f ! dry density of sulfate particles (g/cm3) +! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: + real(kind=f), parameter :: rmin_sulfate = 3.43230298e-8_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat_sulfate = 2.56_f ! volume ratio (adjusted for 28 bins from 2.4 for 30 bins) + + + integer :: i + integer :: j + real(kind=f) :: wave(NWAVE) ! CAM band wavelength centers (cm) + integer :: fid + integer :: wave_did + integer :: wave_vid + integer :: real_vid + integer :: imag_vid + character(len=256) :: efile ! refractive index file name + real(kind=f) :: interp + complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale + write(LUNOPRT,*) ' carma_neutral_h2s04 = ', carma_neutral_h2so4 + write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) + write(LUNOPRT,*) ' carma_escale_file = ', trim(carma_escale_file) + write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) + end if + end if + + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + ! Get the refractive index for ice as a function of wavelength for particle heating + ! calculations. + ! + ! NOTE: These values probably should be a band average, but for now just do band centers. + + ! Read the values in from Warren et al. 2008. + if (carma_do_pheat) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_mice_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "wavelength", wave_did) + call wrap_inq_dimlen(fid, wave_did, warren_nwave) + endif + +#if ( defined SPMD ) + call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) +#endif + + allocate(warren_wave(warren_nwave)) + allocate(warren_real(warren_nwave)) + allocate(warren_imag(warren_nwave)) + + if (masterproc) then + + ! Read in the tables. + call wrap_inq_varid(fid, 'wavelength', wave_vid) + call wrap_get_var_realx(fid, wave_vid, warren_wave) + warren_wave = warren_wave * 1e-4 ! um -> cm + + call wrap_inq_varid(fid, 'm_real', real_vid) + call wrap_get_var_realx(fid, real_vid, warren_real) + + call wrap_inq_varid(fid, 'm_imag', imag_vid) + call wrap_get_var_realx(fid, imag_vid, warren_imag) + + ! Close the file. + call wrap_close(fid) + end if + +#if ( defined SPMD ) + call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) + call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) +#endif + + ! Interpolate the values. + do i = 1, NWAVE + do j = 1, warren_nwave + if (wave(i) > warren_wave(j)) then + if (j > 1) then + interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) + refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1))) + else + refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) + endif + + exit + end if + end do + end do + end if + + + call CARMAGROUP_Create(carma, I_GRP_CRICE, "ice crystal", rmin, 2.2_f, I_SPHERE, 1._f, .true., & + rc, do_mie=carma_do_pheat, refidx=refidx_ice, shortname="CRICE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + ! solfac was formerly set to 0.3, changed to 1.0 because it seems physical. + ! This change needs to be validated -MJM 12/1/2011 + ! + ! NOTE: Add flag to enable neutralization for sulfates? + call CARMAGROUP_Create(carma, I_GRP_SULFATE, "sulfate", rmin_sulfate, vmrat_sulfate, I_SPHERE, 1._f, .false., & + rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=1.0_f, & + scavcoef=0.1_f, is_sulfate=.true., shortname="SULF") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & + I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "ice crystal", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRICE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "ice core", RHO_METEOR_SMOKE, & + I_COREMASS, I_METEOR_SMOKE, rc, shortname="CRCORE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "sulfate", RHO_SULFATE, & + I_VOLATILE, I_H2SO4, rc, shortname="SULF") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_SULCORE, I_GRP_SULFATE, "sulfate core", RHO_METEOR_SMOKE, & + I_COREMASS, I_METEOR_SMOKE, rc, shortname="SFCORE") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes + ! + ! Should this be a RHO_SULFATE_WET of 1.38? + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & + I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & + I_GCOMP_H2SO4, rc, shortname = "H2SO4", ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_CRCORE, I_HETNUC, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_DUST) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_CRICE, I_GRP_CRICE, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium + ! and will be used to define the wet particle radius. + call CARMA_AddGrowth(carma, I_ELEM_SULFATE, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_SULFATE, I_ELEM_SULFATE, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + ! Also need nucleation with meteor smoke. + call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_SULCORE, I_HETNUCSULF, 0._f, rc, igas=I_GAS_H2SO4, ievp2elem=I_ELEM_DUST) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_SULFATE, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + ! Dust-Sulfate Coagulation? + call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat ! latitude index + integer :: iltime ! local time index + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + integer :: k ! vertical index + integer :: ilev ! level index in emissions data + character(len=32) :: shortname ! the shortname of the group + real(r8) :: r(NBIN) ! bin center + real(r8) :: dr(NBIN) ! bin width + real(r8) :: rmass(NBIN) ! bin mass + real(r8) :: pressure ! pressure (Pa) + real(r8) :: thickness ! layer thickness (m) + real(r8) :: rate ! emission rate (#/cm-3/s) + real(r8) :: massflux ! emission mass flux (kg/m2/s) + real(r8) :: columnMass ! mass of the total column (kg/m2/s) + real(r8) :: scale ! scaling factor to conserve the expected mass + real(r8) :: rfScale(pcols) ! scaling factor from global and local relative flux + + real(r8) :: calday ! current calendar day + integer :: yr, mon, day, ncsec, doy + integer :: ncdate + real(r8) :: ltime ! local time + + + ! Default return code. + rc = RC_OK + + ! Get the current date and time. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! NOTE: The global relative flux file is based upon a noleap calendar, so don't + ! let the doy get too big. + doy = min(365, doy) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + ! Only do emission for the first bin of the meteor smoke group. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + ! For meteoritic dust, the source from the smoke only goes into the + ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates + ! is proportional to the pressure, so the emission is a function of + ! pressure. + if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then + + ! Change this to a scaling if appropriate. + rfScale = 1.0_r8 + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + do icol = 1, ncol + + pressure = state%pmid(icol, k) + + ! This is roughly a log-normal approximation to the production + ! rate, but only applies from about 70 to 110 km. + ! + ! NOTE: Based upon US Standard Atmosphere 1976. + if ((pressure >= carma_emis_lev(carma_emis_ilev_min)) .and. & + (pressure <= carma_emis_lev(carma_emis_ilev_max))) then + + ! The rates are in terms of # cm-3 s-1, but were really derived + ! from the mass flux of meteoritic dust. Since we are using a + ! size different that 1.3 nm for the smallest bin, scale the + ! number appropriately. + ! + ! The values are in a lookup table, so find the two numbers + ! surrounding the pressure and do a linear interpolation on the + ! rate. This linear search is kind of expensive, particularly if + ! there are a lot of points. + ! + ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) + do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr + if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then + rate = carma_emis_rate(ilev) + + if (pressure > carma_emis_lev(ilev)) then + rate = rate + & + ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & + (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & + (pressure - carma_emis_lev(ilev)) + end if + + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) + exit + end if + end do + + ! Calculate the mass flux in terms of kg/m3/s + massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) + + if (carma_do_escale) then + + ! Global Scaling + ! + ! Interpolate the global scale by latitude. + ! + ! NOTE: It would be better to interpolate the table once in init to the + ! latitude structure and just look up by index. + ! + ! NOTE: The latitudes have some small significant digits at the end, which makes + ! exact comparisons to latitude values fail. + do ilat = 1, carma_escale_nLats + if ((state%lat(icol) / DEG2RAD) <= carma_escale_lat(ilat)) then + if (abs((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat)) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(ilat, doy) + else + rfScale(icol) = carma_escale_grf(ilat-1, doy) + & + (((state%lat(icol) / DEG2RAD) - carma_escale_lat(ilat-1)) / & + (carma_escale_lat(ilat) - carma_escale_lat(ilat-1))) * & + (carma_escale_grf(ilat, doy) - carma_escale_grf(ilat-1, doy)) + endif + exit + end if + end do + + if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) + end if + + ! Local Time Scaling + ! + ! Interpolate the local scale by local time. + ltime = abs((ncsec / 3600._r8) + (24._r8 * (state%lon(icol) / DEG2RAD) / 360._r8)) + if (ltime > 24._r8) then + ltime = ltime - 24._r8 + end if + + do iltime = 1, carma_escale_nLTimes + if (ltime <= carma_escale_ltime(iltime)) then + if (abs(ltime - carma_escale_ltime(iltime)) <= 0.00001_r8) then + rfScale(icol) = rfScale(icol) * carma_escale_lrf(iltime) + else + rfScale(icol) = rfScale(icol) * (carma_escale_lrf(iltime-1) + & + ((iltime - carma_escale_ltime(iltime-1)) / (carma_escale_ltime(iltime) - carma_escale_ltime(iltime-1))) * & + (carma_escale_lrf(iltime) - carma_escale_lrf(iltime-1))) + endif + exit + end if + end do + endif + + ! Convert the mass flux to a tendency on the mass mixing ratio. + thickness = state%zi(icol, k) - state%zi(icol, k+1) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + end if + enddo + enddo + + ! Scale the columns to keep the total mass influx in the column a + ! constant. + do icol = 1, ncol + columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) + + ! Protect against divide-by-zero (but not overflow). + if (columnMass /= 0._r8) then + scale = carma_emis_expected / columnMass + else + scale = 0._r8 + end if + + ! Also apply the relative flux scaling. This needs to be done after + ! the normalization + tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: pcnst + use ioFileMod, only: getfil + use wrap_nf + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilev ! level index + integer :: fid ! file id + integer :: lev_did ! level dimension id + integer :: lev_vid ! level variable id + integer :: rate_vid ! rate variable + integer :: tmp + integer :: lat_did ! latitude dimension id + integer :: ltime_did ! local time dimension id + integer :: time_did ! time + integer :: lat_vid ! latitude variable id + integer :: lrf_vid ! local relative flux variable id + integer :: grf_vid ! global relative flux variable id + integer :: ltime_vid ! local time variable id + character(len=256) :: efile ! emission file name + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + ! Initialize the emissions rate table. + if (carma_do_emission) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_emis_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission rates from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lev", lev_did) + call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_emis_lev(carma_emis_nLevs)) + allocate(carma_emis_rate(carma_emis_nLevs)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'MSMOKE', rate_vid) + call wrap_get_var_realx(fid, rate_vid, carma_emis_rate) + + call wrap_inq_varid(fid, 'lev', lev_vid) + call wrap_get_var_realx(fid, lev_vid, carma_emis_lev) + + ! Close the file. + call wrap_close(fid) + + ! Find out where the bounds of the table are and in what order + ! the pressures levels are in. + carma_emis_ilev_min = 1 + carma_emis_ilev_max = carma_emis_nLevs + + do ilev = 1, carma_emis_nLevs + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_min = ilev + 1 + else + exit + endif + end do + + do ilev = carma_emis_nLevs, 1, -1 + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_max = ilev - 1 + else + exit + endif + end do + + if (carma_emis_lev(carma_emis_ilev_min) < carma_emis_lev(carma_emis_ilev_max)) then + carma_emis_ilev_incr = 1 + else + carma_emis_ilev_incr = -1 + tmp = carma_emis_ilev_min + carma_emis_ilev_min = carma_emis_ilev_max + carma_emis_iLev_max = tmp + endif + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' + do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) + enddo + + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' + carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & + (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission table.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_lev, carma_emis_nLevs, mpir8, 0, mpicom) + call mpibcast(carma_emis_rate, carma_emis_nLevs, mpir8, 0, mpicom) + + call mpibcast(carma_emis_expected, 1, mpir8, 0, mpicom) + + call mpibcast(carma_emis_ilev_min, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_max, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_incr, 1, mpiint, 0, mpicom) +#endif + + endif + + + ! Initialize the emissions scaling table. + if (carma_do_escale) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_escale_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission scaling from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lat", lat_did) + call wrap_inq_dimlen(fid, lat_did, carma_escale_nLats) + + call wrap_inq_dimid(fid, "time", time_did) + call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) + + ! There should be one time for each day of the year, so + ! quit if it isn't correct. + if (carma_escale_nTimes .ne. 365) then + call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + endif + + call wrap_inq_dimid(fid, "ltime", ltime_did) + call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) + call mpibcast(carma_escale_nLTimes, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_escale_lat(carma_escale_nLats)) + allocate(carma_escale_grf(carma_escale_nLats, carma_escale_nTimes)) + allocate(carma_escale_ltime(carma_escale_nLTimes)) + allocate(carma_escale_lrf(carma_escale_nLTimes)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'SGRF', grf_vid) + tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) + if (tmp/=NF90_NOERR) then + write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + call handle_error (tmp) + end if + + call wrap_inq_varid(fid, 'lat', lat_vid) + call wrap_get_var_realx(fid, lat_vid, carma_escale_lat) + + call wrap_inq_varid(fid, 'SLRF', lrf_vid) + call wrap_get_var_realx(fid, lrf_vid, carma_escale_lrf) + + call wrap_inq_varid(fid, 'ltime', ltime_vid) + call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) + + ! Close the file. + call wrap_close(fid) + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLats = ', carma_escale_nLats + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_escale_lat, carma_escale_nLats, mpir8, 0, mpicom) + call mpibcast(carma_escale_grf, carma_escale_nLats*carma_escale_nTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_ltime, carma_escale_nLTimes, mpir8, 0, mpicom) + call mpibcast(carma_escale_lrf, carma_escale_nLTimes, mpir8, 0, mpicom) +#endif + + endif + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..0548fee8e3 --- /dev/null +++ b/src/physics/carma/models/sea_salt/carma_model_flags_mod.F90 @@ -0,0 +1,81 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + logical, public :: carma_do_WeibullK = .false. ! if .true. then use calculated Weibull K, [Monahan, 2006] + character(len=32), public :: carma_seasalt_emis = 'Gong' ! the source function scheme, either "Gong", "Martensson", + ! "Clarke", "Caffrey", "CMS", "CONST", or "NONE" + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_WeibullK, & + carma_seasalt_emis + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_do_WeibullK, 1, mpilog, 0, mpicom) + call mpibcast(carma_seasalt_emis, len(carma_seasalt_emis), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 new file mode 100644 index 0000000000..d26452d58a --- /dev/null +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -0,0 +1,820 @@ +!! This CARMA model is for sea salt aerosols and is based upon Fan & Toon, ACP, 2011. +!! +!! These aerosols are not currently radiatively active and do not replace the sea +!! salt aerosols in CAM; however, this is something that could be done in the future. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! - CARMA_SurfaceWind() +!! - WeibullWind() +!! +!! @version Dec-2010 +!! @author Tianyi Fan, Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_SEA_SALT = 1 !! sea salt composition + + real(r8), parameter :: uth = 4._r8 !! threshold wind velocity + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) + real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 4.32_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Report model specific configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_seasalt_emis = ', trim(carma_seasalt_emis) + end if + + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "sea salt", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="SALT", irhswell=I_GERBER, & + irhswcomp=I_SWG_SEA_SALT) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "sea salt", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Tianyi Fan, Chuck Bardeen + !! @version Dec-2010 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use phys_grid, only: get_lon_all_p, get_lat_all_p + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat(pcols) ! latitude index + integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + character(len=32) :: shortname ! the shortname of the group + + ! -------- local variables added for sea salt model ------------ + real(r8) :: rdrycm, rdry ! dry radius [cm], [um] + real(r8) :: r80cm, r80 ! wet radius at relatige humidity of 80% [cm] + real(r8) :: ncflx ! dF/dr [#/m2/s/um] + real(r8) :: Monahan, Clarke, Smith ! dF/dr [#/m2/s/um] + real(r8) :: A_para, B_para, sita_para ! A, B, and sita parameters in Gong + real(r8) :: B_mona ! the parameter used in Monahan + real(r8) :: W_Caff ! Correction factor in Caffrey + real(r8) :: u14, ustar_smith, cd_smith ! 14m wind velocity, friction velocity and drag + ! coefficient as desired by Andreas source function + real(r8) :: wcap ! whitecap coverage + real(r8) :: fref ! correction factor suggested by Hoppe2005 + real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant + real(r8) :: u10in ! 10 meter wind speed use in the emission rate + real(r8) :: r(NBIN) ! bin center (cm) + real(r8) :: dr(NBIN) ! bin width (cm) + real(r8) :: rmass(NBIN) ! bin mass (g) + + ! ------------------------------------------------------------------------------------------------ + ! -- Martensson source function. Coefficients for the parameterization of Ak(c4-c0) and Bk(d4-d0) + ! ------------------------------------------------------------------------------------------------- + real(r8), parameter :: c41 = -2.576e35_r8 + real(r8), parameter :: c42 = -2.452e33_r8 + real(r8), parameter :: c43 = 1.085e29_r8 + real(r8), parameter :: c31 = 5.932e28_r8 + real(r8), parameter :: c32 = 2.404e27_r8 + real(r8), parameter :: c33 = -9.841e23_r8 + real(r8), parameter :: c21 = -2.867e21_r8 + real(r8), parameter :: c22 = -8.148e20_r8 + real(r8), parameter :: c23 = 3.132e18_r8 + real(r8), parameter :: c11 = -3.003e13_r8 + real(r8), parameter :: c12 = 1.183e14_r8 + real(r8), parameter :: c13 = -4.165e12_r8 + real(r8), parameter :: c01 = -2.881e6_r8 + real(r8), parameter :: c02 = -6.743e6_r8 + real(r8), parameter :: c03 = 2.181e6_r8 + real(r8), parameter :: d41 = 7.188e37_r8 + real(r8), parameter :: d42 = 7.368e35_r8 + real(r8), parameter :: d43 = -2.859e31_r8 + real(r8), parameter :: d31 =-1.616e31_r8 + real(r8), parameter :: d32 =-7.310e29_r8 + real(r8), parameter :: d33 = 2.601e26_r8 + real(r8), parameter :: d21 = 6.791e23_r8 + real(r8), parameter :: d22 = 2.528e23_r8 + real(r8), parameter :: d23 =-8.297e20_r8 + real(r8), parameter :: d11 = 1.829e16_r8 + real(r8), parameter :: d12 =-3.787e16_r8 + real(r8), parameter :: d13 = 1.105e15_r8 + real(r8), parameter :: d01 = 7.609e8_r8 + real(r8), parameter :: d02 = 2.279e9_r8 + real(r8), parameter :: d03 =-5.800e8_r8 + + real(r8) :: rpdry ! dry radius + real(r8) :: Ak1 ! Coefficient Ak in Martensson's source function + real(r8) :: Ak2 + real(r8) :: Ak3 + real(r8) :: Bk1 ! Coefficient Bk in Martensson's source function + real(r8) :: Bk2 + real(r8) :: Bk3 + Ak1(rpdry)= c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01 + Ak2(rpdry)= c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02 + Ak3(rpdry)= c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 + Bk1(rpdry)= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01 + Bk2(rpdry)= d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02 + Bk3(rpdry)= d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03 + + ! ------------------------------------------------------------ + ! ---- Clarke Source Function. Coefficients for Ai ------- + ! ------------------------------------------------------------ + real(r8), parameter :: beta01 =-5.001e3_r8 + real(r8), parameter :: beta11 = 0.808e6_r8 + real(r8), parameter :: beta21 =-1.980e7_r8 + real(r8), parameter :: beta31 = 2.188e8_r8 + real(r8), parameter :: beta41 =-1.144e9_r8 + real(r8), parameter :: beta51 = 2.290e9_r8 + real(r8), parameter :: beta02 = 3.854e3_r8 + real(r8), parameter :: beta12 = 1.168e4_r8 + real(r8), parameter :: beta22 =-6.572e4_r8 + real(r8), parameter :: beta32 = 1.003e5_r8 + real(r8), parameter :: beta42 =-6.407e4_r8 + real(r8), parameter :: beta52 = 1.493e4_r8 + real(r8), parameter :: beta03 = 4.498e2_r8 + real(r8), parameter :: beta13 = 0.839e3_r8 + real(r8), parameter :: beta23 =-5.394e2_r8 + real(r8), parameter :: beta33 = 1.218e2_r8 + real(r8), parameter :: beta43 =-1.213e1_r8 + real(r8), parameter :: beta53 = 4.514e-1_r8 + real(r8) :: A1 ! Coefficient Ak in Clarkes's source function + real(r8) :: A2 + real(r8) :: A3 + A1(rpdry) = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + & + beta31*(2._r8*rpdry)**3 + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5 + A2(rpdry) = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + & + beta32*(2._r8*rpdry)**3 + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5 + A3(rpdry) = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + & + beta33*(2._r8*rpdry)**3 + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5 + + ! --------------------------------------------- + ! coefficient A1, A2 in Andreas's Source funcion + ! --------------------------------------------- + real(r8) ::A1A92 + real(r8) ::A2A92 + + ! --------------------------------------------- + ! coefficient in Smith's Source funcion + ! --------------------------------------------- + real(r8), parameter :: f1 = 3.1_r8 + real(r8), parameter :: f2 = 3.3_r8 + real(r8), parameter :: r1 = 2.1_r8 + real(r8), parameter :: r2 = 9.2_r8 + real(r8), parameter :: delta = 10._r8 + + ! -------------------------------------------------------------------- + ! ---- constants in calculating the particle wet radius [Gerber, 1985] + ! -------------------------------------------------------------------- + real(r8), parameter :: c1 = 0.7674_r8 ! . + real(r8), parameter :: c2 = 3.079_r8 ! . + real(r8), parameter :: c3 = 2.573e-11_r8 ! . + real(r8), parameter :: c4 = -1.424_r8 ! constants in calculating the particel wet radius + + ! Default return code. + rc = RC_OK + + ! Determine the latitude and longitude of each column. + lchnk = state%lchnk + ncol = state%ncol + + call get_lat_all_p(lchnk, ncol, ilat) + call get_lon_all_p(lchnk, ncol, ilon) + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + if (shortname .eq. "SALT") then + + ! Are we configured for one of the known emission schemes? + if(carma_seasalt_emis .ne. "Gong" .and. & + carma_seasalt_emis .ne. "Martensson" .and. & + carma_seasalt_emis .ne. "Clarke" .and. & + carma_seasalt_emis .ne. "Andreas" .and. & + carma_seasalt_emis .ne. "Caffrey" .and. & + carma_seasalt_emis .ne. "CMS" .and. & + carma_seasalt_emis .ne. "NONE" .and. & + carma_seasalt_emis .ne. "CONST" ) then + + call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.') + end if + + !********************************** + ! wet sea salt radius at RH = 80% + !********************************** + r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8)) + (r(ibin))**3) ** (1./3.) ! [cm] + rdrycm = r(ibin) ! [cm] + r80 = r80cm *1.e4_r8 ! [um] + rdry = rdrycm*1.e4_r8 ! [um] + + do icol = 1,ncol + + ! Only generate sea salt over the ocean. + if (cam_in%ocnfrac(icol) > 0._r8) then + + !********************************** + ! WIND for seasalt production + !********************************** + call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), cam_in, u10in, rc) + + ! Add any surface flux here. + ncflx = 0.0_r8 + Monahan = 0.0_r8 + Clarke = 0.0_r8 + Smith = 0.0_r8 + + !********************************** + ! Whitecap Coverage + !********************************** + wcap = 3.84e-6_r8 * u10in ** 3.41_r8 ! in percent, ie., 75%, wcap = 0.75 + + !**************************************** + ! Hoppel correction factor + ! Smith drag coefficients and etc + !**************************************** + if (u10in .le. 10._r8) then + cd_smith = 1.14e-3_r8 + else + cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8 + end if + + ustar_smith = cd_smith **0.5_r8 * u10in + + ! We don't have vg yet, since that is calculated by CARMA. That will require + ! a different interface for the emissions, storing vg in the physics buffer, + ! and/or doing some duplicate calculations for vg assuming 80% RH. +! fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith)) + fref = 1.0_r8 + + !********************************** + ! Source Functions + !********************************** + if (carma_seasalt_emis .eq. 'NONE') then + ncflx = 0._r8 + end if + + if (carma_seasalt_emis .eq. 'CONST') then + ncflx = 1.e-5_r8 + end if + + !-------Gong source function------ + if (carma_seasalt_emis == "Gong") then + sita_para = 30 + A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8)) + B_para = (0.433_r8 - log10(r80)) / 0.433_r8 + ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * & + (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2)) +! if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in + end if + + !------Martensson source function----- + if (carma_seasalt_emis == "Martensson") then + if (rdry .le. 0.0725_r8) then + ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then + ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then + ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-------Clarke source function------- + if (carma_seasalt_emis == "Clarke")then + if (rdry .lt. 0.066_r8) then + ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then + ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then + ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx= ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-----------Caffrey source function------------ + if (carma_seasalt_emis == "Caffrey") then + + !Monahan + B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * & + (1._r8 + 0.057 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1. * B_mona**2)) ! dF/dr + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2) ! dF/dr [#/m2/s/um] + + !Caffrey based on Monahan and Smith + W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) + if (rdry .lt. 0.15_r8) then + ncflx = Monahan + else + if (u10in .le. 9._r8) then + ncflx = Monahan + else + if(Monahan .ge. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + ncflx = ncflx * W_Caff + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + !--------CMS (Clarke, Monahan, and Smith source function)------- + if (carma_seasalt_emis == "CMS") then + + !Clarke + if (rdry .lt. 0.066_r8) then + Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then + Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then + Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke= Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + end if + + !Monahan + B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * & + (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2)) + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2) ! dF/dr [#/m2/s/um] + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! CMS1 or CMS2 + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! if (rdry .lt. 0.1_r8) then ! originally cut at 0.1 um + ! ***CMS1***** + if (rdry .lt. 1._r8) then ! cut at 1.0 um + ! ***CMS2***** + ! if (rdry .lt. 2._r8) then ! cut at 2.0 um + ncflx = Clarke + else + if (u10in .lt. 9._r8) then + ncflx = Monahan + else + if (Monahan .gt. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] + surfaceFlux(icol) = ncflx * dr(ibin) * rmass(ibin) * 10._r8 ! *1e4[um/cm] * 1.e-3[kg/g] + +! if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup +! if (do_print) write(LUNOPRT, *) "dr = ", dr(ibin), ", rmass = ", rmass(ibin) +! if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", surfaceFlux = ", surfaceFlux(icol) + + ! weighted by the ocean fraction + surfaceFlux(icol) = surfaceFlux(icol) * cam_in%ocnfrac(icol) + end if + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + + implicit none + + ! in and out field + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! physics state + integer, intent(in) :: icol !! column index + integer, intent(in) :: ilat !! latitude index + integer, intent(in) :: ilon !! longitude index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: u10in !! the 10m wind speed put into the source function + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + ! the nth mean wind with integration using Weibull Distribution (integrate from threshold wind velocity) + real(r8) :: uWB341 + + rc = RC_OK + + uWB341 = 0._r8 + + ! calc. the Weibull wind distribution + u10in = cam_in%u10(icol) + + call WeibullWind(u10in, uth, 3.41_r8, uWB341) + + ! Asked for 3.41 moment of the wind, but return the first moment of the + ! Weibull wind. + u10in = uWB341 ** (1._r8 / 3.41_r8) + + return + end subroutine CARMA_SurfaceWind + + + !! Calculate the nth mean of u using Weibull wind distribution + !! considering the threshold wind velocity. This algorithm + !! integrates from uth to infinite (u^n P(u)du ) + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine WeibullWind(u, uth, n, uwb, wbk) + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_spfn_mod, only: gamma => shr_spfn_gamma, & + igamma => shr_spfn_igamma + + implicit none + + real(r8), intent(in) :: u ! mean wind speed + real(r8), intent(in) :: uth ! threshold velocity + real(r8), intent(in) :: n ! the rank of u in the integration + real(r8), intent(out) :: uwb ! the Weibull distribution + real(r8), intent(in), optional :: wbk ! the shape parameter + + ! local variable + real(r8) :: k ! the shape parameter in Weibull distribution + real(r8) :: c ! the scale parameter in Weibull distribution + + if (present(wbk)) then + k = wbk + else + k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR +! k = 2.5_r8 ! Lansing's estimate + end if + + ! At some locations the k parameter is 0, not ocean which then + ! makes the gamma functions unstable. + if (k .eq. 0._r8) then + c = u**n + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) + end if + + end subroutine WeibullWind + +end module diff --git a/src/physics/carma/models/sulfate/carma_model_mod.F90 b/src/physics/carma/models/sulfate/carma_model_mod.F90 new file mode 100644 index 0000000000..fb410e83c9 --- /dev/null +++ b/src/physics/carma/models/sulfate/carma_model_mod.F90 @@ -0,0 +1,453 @@ +!! This CARMA model is for sulfate aerosols and is based upon work done by Mike Mills +!! and Jason English, which is described in English et al. 2011. +!! +!! These aerosols are not currently radiatively active and do not replace the sulfate +!! aerosols in CAM; however, this is something that could be done in the future. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! +!! @version Dec-2010 +!! @author Tianyi Fan, Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use spmd_utils, only: masterproc + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 30 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 2 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition + integer, public, parameter :: I_WATER = 2 !! water + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_SULFATE = 1 !! sulfate aerosol + + integer, public, parameter :: I_ELEM_SULFATE = 1 !! sulfate aerosol + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + integer, public, parameter :: I_GAS_H2SO4 = 2 !! sulphuric acid + + real(kind=f), public, parameter :: WTMOL_H2SO4 = 98.078479_f !! molecular weight of sulphuric acid + + ! Physics buffer index for sulfate surface area density + integer :: ipbuf4sad, ipbuf4reff, ipbuf4so4mmr + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + use physics_buffer, only: pbuf_add_field, dtype_r8 + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_SULFATE = 1.923_f ! dry density of sulfate particles (g/cm3) +! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: + real(kind=f), parameter :: rmin = 3.43230298e-8_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.4_f ! volume ratio + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_hetchem_feedback = ', carma_hetchem_feedback + end if + end if + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + ! solfac was formerly set to 0.3, changed to 1.0 because it seems physical. + ! This change needs to be validated -MJM 12/1/2011 + call CARMAGROUP_Create(carma, I_GRP_SULFATE, "sulfate", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=1.0_f, & + scavcoef=0.1_f, is_sulfate=.true., shortname="PURSUL") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "Sulfate", RHO_SULFATE, & + I_VOLATILE, I_H2SO4, rc, shortname="PURSUL") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, & + rc, shortname = "Q", ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & + I_GCOMP_H2SO4, rc, shortname = "H2SO4", ds_threshold=-0.2_f) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + ! Define the Processes + + ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium + ! and will be used to define the wet particle radius. + call CARMA_AddGrowth(carma, I_ELEM_SULFATE, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_SULFATE, I_ELEM_SULFATE, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_SULFATE, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call pbuf_add_field('SADSULF', 'global', dtype_r8, (/pcols, pver/), ipbuf4sad) + + if (carma_rad_feedback) then + call pbuf_add_field('VOLC_RAD_GEOM', 'global', dtype_r8, (/pcols, pver/), ipbuf4reff) + call pbuf_add_field('VOLC_MMR', 'global', dtype_r8, (/pcols, pver/), ipbuf4so4mmr) + endif + + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + use physics_buffer, only: pbuf_get_field + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Local variables + real(r8) :: numberDensity(cstate%f_NZ) + real(r8) :: ad(cstate%f_NZ) ! stratospheric aerosol wet surface area density (cm2/cm3) + real(r8) :: reff(cstate%f_NZ) ! stratospheric wet effective radius (m) + real(r8) :: md(cstate%f_NZ) ! bin integrated stratospheric mass mixing ratio (kg/kg) + real(r8) :: mmr(cstate%f_NZ) ! stratospheric mass mixing ratio per bin (kg/kg) + real(r8) :: r_wet(cstate%f_NZ) ! Sulfate aerosol bin wet radius (cm) + real(r8), pointer, dimension(:,:) :: sadsulf_ptr ! Sulfate surface area density pointer + real(r8), pointer, dimension(:,:) :: reffsulf_ptr ! Sulfate effective radius pointer + real(r8), pointer, dimension(:,:) :: mmrsulf_ptr ! Sulfate mass mixing ratio pointer + integer :: ibin, igroup + + ! Default return code. + rc = RC_OK + + call CARMAELEMENT_Get(carma, I_ELEM_SULFATE, rc, igroup=igroup) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMAELEMENT_Get failed.') + + ad(:) = 0.0_r8 ! stratospheric wet aerosol surface area density (cm2/cm3) + md(:) = 0.0_r8 ! bin integrated stratospheric mass mixing ratio (kg/kg) + reff(:) = 0.0_r8 ! stratospheric effective radius (m) + + do ibin = 1, NBIN + call CARMASTATE_GetBin(cstate, I_ELEM_SULFATE, ibin, mmr(:), rc, & + numberDensity=numberDensity, r_wet=r_wet) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMASTATE_GetBin failed.') + + ! Calculate the total densities. + ! + ! NOTE: Calculate AD in cm2/cm3. + if (numberDensity(1) /= CAM_FILL) then + ad(:) = ad(:) + numberDensity(:) * (r_wet(:)**2) + reff(:) = reff(:) + numberDensity(:) * (r_wet(:)**3) + md(:) = md(:) + mmr(:) ! bin integrated stratospheric mass mixing ratio (kg/kg) + end if + end do + + reff(:) = reff(:) / ad(:) ! wet effective radius in cm + reff(:) = reff(:) / 100.0_r8 ! cm -> m + ad(:) = ad(:) * 4.0_r8 * PI ! surface area density in cm2/cm3 + + call pbuf_get_field(pbuf, ipbuf4sad, sadsulf_ptr) + sadsulf_ptr(icol, :cstate%f_NZ) = ad(:cstate%f_NZ) ! stratospheric aerosol wet surface area density (cm2/cm3) + + if (carma_rad_feedback) then + call pbuf_get_field(pbuf, ipbuf4reff, reffsulf_ptr) + reffsulf_ptr(icol, :cstate%f_NZ) = reff(:cstate%f_NZ) ! stratospheric wet effective radius (m) + + call pbuf_get_field(pbuf, ipbuf4so4mmr, mmrsulf_ptr) + mmrsulf_ptr(icol, :cstate%f_NZ) = md(:cstate%f_NZ) ! bin integrated stratospheric mass mixing ratio (kg/kg) + end if + + + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Tianyi Fan, Chuck Bardeen + !! @version Dec-2010 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add any surface flux here. + surfaceFlux = 0._r8 + + ! For emissions into the atmosphere, put the emission here. + tendency = 0._r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_detrain/carma_model_mod.F90 b/src/physics/carma/models/test_detrain/carma_model_mod.F90 new file mode 100644 index 0000000000..16e6cb431f --- /dev/null +++ b/src/physics/carma/models/test_detrain/carma_model_mod.F90 @@ -0,0 +1,475 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of dust particles and +!! 8 size bins. Optical properties are calculated, assuming a constant refractive +!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but +!! do coagulate. +!! +!! @version May-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 3 !! Number of particle groups + integer, public, parameter :: NELEM = 3 !! Number of particle elements + integer, public, parameter :: NBIN = 22 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_ICE = 1 !! dust composition + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + call CARMAGROUP_Create(carma, 1, "Mass", rmin, 1.00001_f, I_SPHERE, 1._f, .true., & + rc, shortname="CRMASS") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 2, "Number", rmin, 1.00001_f, I_SPHERE, 1._f, .true., & + rc, shortname="CRNUMB") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 3, "Always", rmin, 1.000001_f, I_SPHERE, 1._f, .true., & + rc, shortname="CRALL") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "Mass", RHO_I, I_VOLATILE, I_ICE, rc, shortname="CRMASS") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 2, 2, "Number", RHO_I, I_VOLATILE, I_ICE, rc, shortname="CRNUMB") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 3, 3, "Always", RHO_I, I_VOLATILE, I_ICE, rc, shortname="CRALL") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair, cappa + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + integer, parameter :: ielemMass = 1 + integer, parameter :: ielemNumber = 2 + integer, parameter :: ielemAlways = 3 + real(r8), parameter :: theta_min = 320._r8 + real(r8), parameter :: theta_max = 400._r8 + real(r8), parameter :: dtheta = (theta_max - theta_min) / (NBIN - 2) + real(r8), parameter :: startDay = 20._r8 + real(r8), parameter :: stopDay = 30._r8 +! real(r8), parameter :: startDay = 335._r8 +! real(r8), parameter :: stopDay = 345._r8 + real(r8), parameter :: mmrThreshold = 1e-8_r8 + integer :: k + integer :: ibin + real(r8) :: p(pver) + real(r8) :: t(pver) + real(r8) :: theta(pver) + real(r8) :: mmr(pver) + real(r8) :: cday + + ! Default return code. + rc = RC_OK + + ! Only detrain condensate during certain days, so we get a pulse that we can then follow around. + cday = get_curr_calday() + + if ((cday >= startDay) .and. (cday <= stopDay)) then + + call CARMASTATE_GetState(cstate, rc, t=t, p=p) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_GetState failed.') + + ! Calculate the potential temperature. + theta(:) = t(:) * (1e5_f / p(:)) ** (cappa) + + ! Put all of the detraining cloud water from convection into the large scale cloud. + ! put detraining cloud water into liq and ice based on temperature partition + do k = 1, pver + + ! Put the detrained mass into a bin sorted by potential temperature. + ibin = ((theta(k) - theta_min) / dtheta) + 2 + + if (theta(k) < theta_min) then + ibin = 1 + else if (theta(k) > theta_max) then + ibin = NBIN + endif + + + ! Mass based tracer reflects detrained mass. + call CARMASTATE_GetBin(cstate, ielemMass, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_GetBin failed.') + + mmr(k) = mmr(k) + dlf(icol, k) * dt + + call CARMASTATE_SetBin(cstate, ielemMass, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_SetBin failed.') + + + ! Event based tracer reflects the number of detrainment events, but apply a + ! threshold so that not everything counts. + if ((dlf(icol, k) * dt) >= mmrThreshold) then + + call CARMASTATE_GetBin(cstate, ielemNumber, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_GetBin failed.') + + mmr(k) = mmr(k) + 1e-6_r8 + + call CARMASTATE_SetBin(cstate, ielemNumber, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_SetBin failed.') + end if + + + ! This group puts in tracer at all potential temperatures, just to see what happens + ! independent of whether detrainment actually puts mass there. + call CARMASTATE_GetBin(cstate, ielemAlways, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_GetBin failed.') + + mmr(k) = mmr(k) + 1e-6_r8 + + call CARMASTATE_SetBin(cstate, ielemAlways, ibin, mmr, rc) + if (rc < RC_OK) call endrun('CARMA_Detrain::CARMASTATE_SetBin failed.') + + end do + end if + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + if (present(re_ice)) re_ice(:,:) = 0.0_f + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here (default is 0.) + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_growth/carma_model_mod.F90 b/src/physics/carma/models/test_growth/carma_model_mod.F90 new file mode 100644 index 0000000000..24a8d958cc --- /dev/null +++ b/src/physics/carma/models/test_growth/carma_model_mod.F90 @@ -0,0 +1,473 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of dust particles and +!! 8 size bins. Optical properties are calculated, assuming a constant refractive +!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but +!! do coagulate. +!! +!! @version May-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 3 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 1 !! Number of particle solutes + integer, public, parameter :: NGAS = 1 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition + integer, public, parameter :: I_ICE = 2 !! ice + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_CRCN = 1 !! sulfate aerosol + integer, public, parameter :: I_GRP_CRICE = 2 !! ice + + integer, public, parameter :: I_ELEM_CRCN = 1 !! sulfate aerosol + integer, public, parameter :: I_ELEM_CRICE = 2 !! ice + integer, public, parameter :: I_ELEM_CRCORE = 3 !! sulfate core + + integer, public, parameter :: I_SOL_CRH2SO4 = 1 !! H2SO4 + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_CN = 2.65_f ! dry density of sea salt particles (g/cm) + real(kind=f), parameter :: rmin_ice = 5.e-5_f ! min radius for ice bins (cm) + real(kind=f), parameter :: rmin_cn = 1.e-7_f ! min radius for sulfate bins (cm) + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + + ! Since these sulfates are prescribed, don't sediment them. This will save some + ! processing time. + call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, 4.0_f, I_SPHERE, 1._f, .false., & + rc, shortname="CRCN", cnsttype=I_CNSTTYPE_DIAGNOSTIC, & + do_vtran=.false.) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, I_GRP_CRICE, "Ice", rmin_ice, 2.8_f, I_HEXAGON, 1._f / 6._f, .true., & + rc, shortname="CRICE", ifallrtn=I_FALLRTN_STD_SHAPE) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_CRCN, I_GRP_CRCN, "Sulfate CN", RHO_CN, & + I_INVOLATILE, I_H2SO4, rc, shortname="CRCN", isolute=I_SOL_CRH2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "Ice", RHO_I, & + I_VOLATILE, I_ICE, rc, shortname="CRICE") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "Core Mass", RHO_CN, & + I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=1) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + ! Define the Solutes + call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, 98._f, 1.38_f, rc, shortname="CRH2SO4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') + + + ! Define the Gases + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + ! NOTE: For now, assume the latent heat for nucleation is the latent of of fusion of + ! water, using the CAM constant (scaled from J/kg to erg/g). + ! + ! NOTE: SInce the sulfates are not seen as part of the water/energy budget in CAM, don't + ! include any latent heat from the freezing of the sulfate liquid. The latent heat of + ! the gas associated with nucleation is accounted for. + call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & + I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + integer :: igroup ! group index + integer :: ielem ! element index + integer :: ibin ! bin index + + ! Sulfate size distribution parameters + real(r8), parameter :: n = 100._r8 ! concentration (cm-3) + real(r8), parameter :: r0 = 2.5e-6_r8 ! mean radius (cm) + real(r8), parameter :: rsig = 1.5_r8 ! distribution width + + real(r8) :: arg1(NBIN) + real(r8) :: arg2(NBIN) + real(r8) :: rhop(NBIN) ! particle mass density (kg/m3) + real(kind=f) :: rhoa_wet(pver) ! air density (g/cm3) + real(kind=f) :: r(NBIN) ! bin mean radius + real(kind=f) :: dr(NBIN) ! bin radius width + real(kind=f) :: rmass(NBIN) ! bin mass + real(r8) :: mmr(NBIN,pver) ! elements mass mixing ratio + + ! Default return code. + rc = RC_OK + + ! Get the air density. + call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') + + ! Use a fixed sulfate size distribution. By doing this as a diagnostic group, + ! the constituents for the sulfate bins do not need to be advected, which + ! improves the speed of the model. + igroup = 1 + ielem = 1 + + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) + arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) + + rhop(:) = arg1(:) * exp(arg2(:)) * rmass(:) * 1e6_f / 1e3_f + + do ibin = 1, NBIN + mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) + call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) + if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + end do + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + ! Put a horizontally uniform layer of the smallest bin size + ! in the model. + if (ibin == 1) then + where(mask) +! q(:, 1) = 100e-9_r8 ! top + q(:, plev/4) = 100e-9_r8 ! 1/4 +! q(:, plev/2) = 100e-9_r8 ! middle +! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 +! q(:, plev-1) = 100e-9_r8 ! bottom + end where + end if + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_passive/carma_model_mod.F90 b/src/physics/carma/models/test_passive/carma_model_mod.F90 new file mode 100644 index 0000000000..d616a2066a --- /dev/null +++ b/src/physics/carma/models/test_passive/carma_model_mod.F90 @@ -0,0 +1,392 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of dust particles and +!! 8 size bins. Optical properties are calculated, assuming a constant refractive +!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but +!! do coagulate. +!! +!! @version May-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_DUST = 1 !! dust composition + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) + real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & + scavcoef=0.1_f, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + ! Put a horizontally uniform layer of the smallest bin size + ! in the model. + if (ibin == 1) then + where(mask) +! q(:, 1) = 100e-9_r8 ! top + q(:, plev/4) = 100e-9_r8 ! 1/4 +! q(:, plev/2) = 100e-9_r8 ! middle +! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 +! q(:, plev-1) = 100e-9_r8 ! bottom + end where + end if + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_radiative/carma_model_mod.F90 b/src/physics/carma/models/test_radiative/carma_model_mod.F90 new file mode 100644 index 0000000000..c394c8e220 --- /dev/null +++ b/src/physics/carma/models/test_radiative/carma_model_mod.F90 @@ -0,0 +1,400 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of dust particles and +!! 8 size bins. Optical properties are calculated, assuming a constant refractive +!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but +!! do coagulate. +!! +!! @version May-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + + !! Relative humidities for mie and radiation calculations. The RRTMG radiation code will interpolate + !! based upon the current relative humidity from a table built using the specified relative + !! humidities. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_DUST = 1 !! dust composition + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) + real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio + complex(kind=f) :: refidx(NWAVE) ! refractice indices + + ! Default return code. + rc = RC_OK + + ! Use the same refractive index at all wavelengths. This value is typical of dust in + ! the visible. + refidx(:) = (1.55_f, 4e-3_f) + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & + scavcoef=0.1_f, shortname="DUST", refidx=refidx, do_mie=.true.) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + ! Put a horizontally uniform layer of the smallest bin size + ! in the model. + if (ibin == 1) then + where(mask) +! q(:, 1) = 100e-9_r8 ! top + q(:, plev/4) = 100e-9_r8 ! 1/4 +! q(:, plev/2) = 100e-9_r8 ! middle +! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 +! q(:, plev-1) = 100e-9_r8 ! bottom + end where + end if + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_swelling/carma_model_mod.F90 b/src/physics/carma/models/test_swelling/carma_model_mod.F90 new file mode 100644 index 0000000000..901f601c8a --- /dev/null +++ b/src/physics/carma/models/test_swelling/carma_model_mod.F90 @@ -0,0 +1,401 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a simple test case involving one group of dust particles and +!! 8 size bins. Optical properties are calculated, assuming a constant refractive +!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but +!! do coagulate. +!! +!! @version May-2009 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 3 !! Number of particle groups + integer, public, parameter :: NELEM = 3 !! Number of particle elements + integer, public, parameter :: NBIN = 16 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_SEA_SALT = 1 !! sea salt composition + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) + real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 4.0_f ! volume ratio + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "None", rmin, vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="SALT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, 2, "Fitzgerald", rmin, vmrat, I_SPHERE, 1._f, & + .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="SALTFZ", irhswell=I_FITZGERALD, & + irhswcomp=I_SWF_NACL) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, 3, "Gerber", rmin, vmrat, I_SPHERE, 1._f, & + .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="SALTGB", irhswell=I_GERBER, & + irhswcomp=I_SWG_SEA_SALT) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "None", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, 2, 2, "Fitz", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTFZ") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, 3, 3, "Gerb", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTGB") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + tendency(:ncol, :pver) = 0.0_r8 + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + ! Put a horizontally uniform layer at all bin sizes + where(mask) +! q(:, 1) = 100e-9_r8 ! top +! q(:, plev/4) = 100e-9_r8 ! 1/4 + q(:, plev/2) = 100e-9_r8 ! middle +! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 +! q(:, plev-1) = 100e-9_r8 ! bottom + end where + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..012bb16ca0 --- /dev/null +++ b/src/physics/carma/models/test_tracers/carma_model_flags_mod.F90 @@ -0,0 +1,80 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + integer, public :: carma_launch_doy = 1 !! The day of year upon which to begin the test + real(r8), public :: carma_emission_rate = 1e-9_r8 !! Tracer emitted at the surface, + !! positive is mass (kg/m2/s), negative is mmr (kg/kg/s) + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_launch_doy, carma_emission_rate + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_launch_doy, 1, mpiint, 0, mpicom) + call mpibcast(carma_emission_rate, 1, mpir8, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/test_tracers/carma_model_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_mod.F90 new file mode 100644 index 0000000000..f357a6defd --- /dev/null +++ b/src/physics/carma/models/test_tracers/carma_model_mod.F90 @@ -0,0 +1,585 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a test case that uses CARMA groups and bins to implement a +!! tracer trajectory test for the Asian Monsoon region. This is the reverse of +!! back trajectory calculations being done by John Bergman. In this model each +!! group is a region of the model and each bin represents a day. Emissions +!! start on the carma_launch_doy and then continue for NBINS days. +!! +!! NOTE: This test can use a lot of advected constituents. If you want to reduce +!! the number of regions or days tracked, you also need to reduce the number of +!! advected constituents added in configure. +!! +!! @version April-2011 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 6 !! Number of particle groups + integer, public, parameter :: NELEM = 6 !! Number of particle elements + integer, public, parameter :: NBIN = 62 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .False. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_INERT = 1 !! tracer composition + + real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, 0._f, 0._f, 0._f, 0._f /) + real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 40._f, 40._f, 40._f, 40._f, 40._f /) + + real(kind=f), public :: rgn_minlon(NELEM-1) = (/ 60._f, 60._f, 105._f, 60._f, 105._f /) + real(kind=f), public :: rgn_maxlon(NELEM-1) = (/ 105._f, 105._f, 140._f, 105._f, 140._f /) + + real(kind=f), public :: rgn_ps(NELEM) = (/ -75000._f, 75000._f, 0._f, 0._f, 0._f, 0._f /) + + logical, public :: rgn_doLand(NELEM) = (/ .True., .True., .True., .False., .False., .True. /) + logical, public :: rgn_doOcean(NELEM) = (/ .False., .False., .False., .True., .True., .True. /) + logical, public :: rgn_doSeaIce(NELEM) = (/ .False., .False., .False., .True., .True., .True. /) + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_launch_doy = ', carma_launch_doy + write(LUNOPRT,*) ' carma_emission_rate = ', carma_emission_rate + end if + end if + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 6, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 6, 6, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair, cappa + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! When the tracer hits at the surface at a time other than on its launch day, + !! it will be removed from the model. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + integer :: elapsed ! days since launch + + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + if (present(re_ice)) re_ice(:,:) = 0.0_f + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! Any material that has made it to the surface from a previous day should be removed. + elapsed = doy - carma_launch_doy + + if (elapsed > 1) then + cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f + end if + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. + !! + !! Emit particles after the specified launch day, with each bin being used + !! for only one day. Each element is a different regions. Regions can be defined by: + !! + !! latitude and longitude range + !! surface pressure + !! surface type (land, ocean, sea ice) + !! + !! The tracer is emitted as a constant column mass (kg/m2/s), so regions are weighted + !! by their surface area. Mixed surface types have are scaled by the fraction of the + !! surface type included in the region. + !! + !! A negative surface pressure means that the surface pressure must be less than or + !! equal to the number specified, While a positive number means it must be greater + !! than the specified value. + !! + !! One extra region is defined that is all of the areas excluded (via lat/lon) from + !! all of the other regions (i.e. the rest of the world). + !! + !! NOTE: Launch days that wrap around are not currently supported + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: lat(state%ncol) ! latitude (degrees) + real(r8) :: lon(state%ncol) ! longitude (degrees) + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + integer :: elapsed ! days since launch + logical :: doPS ! is pressure in correct range? + logical :: doRegion ! are lat/lon in correct range? + integer :: i + real(r8) :: frac ! scaling fraction from land type + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + elapsed = doy - carma_launch_doy + + ! Determine the latitude and longitude of each column. + ncol = state%ncol + + surfaceFlux(:ncol) = 0.0_f + tendency(:ncol, :pver) = 0.0_f + + ! Is this a day to launch more material? + if ((elapsed + 1) == ibin) then + + lat = state%lat(:ncol) / DEG2RAD + lon = state%lon(:ncol) / DEG2RAD + + do icol = 1, ncol + + ! Determine the region based upon latitude and longitude. The last region is + ! defined to be rest of the world (i.e. all regions not in another region). + doRegion = .False. + + if (ielem == NELEM) then + doRegion = .True. + + do i = 1, NELEM-1 + if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & + (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then + doRegion = .False. + end if + end do + else + if ((rgn_minlat(ielem) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(ielem)) .and. & + (rgn_minlon(ielem) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(ielem))) then + doRegion = .True. + end if + end if + + ! Check the surface pressure. + doPS = .False. + if (rgn_ps(ielem) == 0._f) then + doPS = .True. + else + if (rgn_ps(ielem) > 0._f) then + if (state%ps(icol) > rgn_ps(ielem)) then + doPS = .True. + end if + else + if (state%ps(icol) <= abs(rgn_ps(ielem))) then + doPS = .True. + end if + end if + end if + + ! Calculate the emission rate as a constant mass. + if (doRegion .and. doPS) then + + ! A negative emission rate means to treat it as an mmr (kg/kg/s) and a + ! postive value means to treat it as a column mass (kg/m2/s). + if (carma_emission_rate > 0._f) then + tendency(icol, pver) = carma_emission_rate / state%pdel(icol, pver) / gravit + else + ! For mmr, calculate a tendecy to keep the surface at that emitted value, + ! rather than having a constant emission rate. +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt + end if + end if + + ! Scale with the land/ocean fraction. + frac = 0._f + + if (rgn_doLand(ielem)) then + frac = frac + cam_in%landfrac(icol) + end if + + if (rgn_doOcean(ielem)) then + frac = frac + cam_in%ocnfrac(icol) + end if + + if (rgn_doSeaIce(ielem)) then + frac = frac + cam_in%icefrac(icol) + end if + + tendency(icol, pver) = tendency(icol, pver) * frac + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: i + + ! Default return code. + rc = RC_OK + + ! Add initial condition here (default is 0.) + do i = 1, size(q, 2) + where(mask) + q(:,i) = 0._r8 + end where + end do + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..012bb16ca0 --- /dev/null +++ b/src/physics/carma/models/test_tracers2/carma_model_flags_mod.F90 @@ -0,0 +1,80 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + integer, public :: carma_launch_doy = 1 !! The day of year upon which to begin the test + real(r8), public :: carma_emission_rate = 1e-9_r8 !! Tracer emitted at the surface, + !! positive is mass (kg/m2/s), negative is mmr (kg/kg/s) + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_launch_doy, carma_emission_rate + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_launch_doy, 1, mpiint, 0, mpicom) + call mpibcast(carma_emission_rate, 1, mpir8, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 new file mode 100644 index 0000000000..e5595a367e --- /dev/null +++ b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 @@ -0,0 +1,593 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is a test case that uses CARMA groups and bins to implement a +!! tracer trajectory test for the Guam region. This is the reverse of +!! back trajectory calculations being done by John Bergman. In this model each +!! group is a region of the model and each bin represents a day. Emissions +!! start on the carma_launch_doy and then continue for NBINS days. +!! +!! NOTE: This test can use a lot of advected constituents. If you want to reduce +!! the number of regions or days tracked, you also need to reduce the number of +!! advected constituents added in configure. +!! +!! @version April-2011 +!! @author Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use radconstants, only: nswbands, nlwbands + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 7 !! Number of particle groups + integer, public, parameter :: NELEM = 7 !! Number of particle elements + integer, public, parameter :: NBIN = 62 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .False. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_INERT = 1 !! tracer composition + + ! Regions for ATTREX + real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, -20._f, -30._f, -20._f, -10._f, -30._f /) + real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 20._f, 0._f, 20._f, 20._f, 20._f, -10._f /) + + real(kind=f), public :: rgn_minlon(NELEM-1) = (/ 150._f, 150._f, 100._f, 30._f, 100._f, 100._f /) + real(kind=f), public :: rgn_maxlon(NELEM-1) = (/ 240._f, 240._f, 150._f, 100._f, 150._f, 150._f /) + + real(kind=f), public :: rgn_ps(NELEM) = (/ 0._f, 0._f, 0._f, 0._f, 0._f, 0._f, 0._f /) + + logical, public :: rgn_doLand(NELEM) = (/ .True., .True., .False., .True., .True., .True., .True. /) + logical, public :: rgn_doOcean(NELEM) = (/ .True., .True., .True., .True., .False., .False., .True. /) + logical, public :: rgn_doSeaIce(NELEM) = (/ .True., .True., .True., .True., .False., .False., .True. /) + +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) + real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio + integer :: LUNOPRT + logical :: do_print + + ! Default return code. + rc = RC_OK + + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + + ! Report model specific configuration parameters. + if (masterproc) then + if (do_print) then + write(LUNOPRT,*) '' + write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + write(LUNOPRT,*) ' carma_launch_doy = ', carma_launch_doy + write(LUNOPRT,*) ' carma_emission_rate = ', carma_emission_rate + end if + end if + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 6, "Region 6", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + call CARMAGROUP_Create(carma, 7, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG7") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 6, 6, "Region 6", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + call CARMAELEMENT_Create(carma, 7, 7, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG7") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair, cappa + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! When the tracer hits at the surface at a time other than on its launch day, + !! it will be removed from the model. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + integer :: elapsed ! days since launch + + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the bulk mass from the CARMA state. + + if (present(re_ice)) re_ice(:,:) = 0.0_f + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + ! Any material that has made it to the surface from a previous day should be removed. + elapsed = doy - carma_launch_doy + + if (elapsed > 1) then + cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f + end if + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. + !! + !! Emit particles after the specified launch day, with each bin being used + !! for only one day. Each element is a different regions. Regions can be defined by: + !! + !! latitude and longitude range + !! surface pressure + !! surface type (land, ocean, sea ice) + !! + !! The tracer is emitted as a constant column mass (kg/m2/s), so regions are weighted + !! by their surface area. Mixed surface types have are scaled by the fraction of the + !! surface type included in the region. + !! + !! A negative surface pressure means that the surface pressure must be less than or + !! equal to the number specified, While a positive number means it must be greater + !! than the specified value. + !! + !! One extra region is defined that is all of the areas excluded (via lat/lon) from + !! all of the other regions (i.e. the rest of the world). + !! + !! NOTE: Launch days that wrap around are not currently supported + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual + use camsrfexch, only: cam_in_t + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: lat(state%ncol) ! latitude (degrees) + real(r8) :: lon(state%ncol) ! longitude (degrees) + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + real(r8) :: calday ! current calendar day + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + integer :: doy ! day of year + integer :: elapsed ! days since launch + logical :: doPS ! is pressure in correct range? + logical :: doRegion ! are lat/lon in correct range? + integer :: i + real(r8) :: frac ! scaling fraction from land type + + ! Default return code. + rc = RC_OK + + ! Determine the day of year. + calday = get_curr_calday() + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + doy = floor(calday) + + elapsed = doy - carma_launch_doy + + ncol = state%ncol + + surfaceFlux(:ncol) = 0.0_f + tendency(:ncol, :pver) = 0.0_f + + ! Is this a day to launch more material? + if ((elapsed + 1) == ibin) then + + ! Determine the latitude and longitude of each column. + + lat = state%lat(:ncol) / DEG2RAD + lon = state%lon(:ncol) / DEG2RAD + + do icol = 1, ncol + + ! Determine the region based upon latitude and longitude. The last region is + ! defined to be rest of the world (i.e. all regions not in another region). + doRegion = .False. + + if (ielem == NELEM) then + doRegion = .True. + + do i = 1, NELEM-1 + if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & + (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then + doRegion = .False. + end if + end do + else + if ((rgn_minlat(ielem) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(ielem)) .and. & + (rgn_minlon(ielem) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(ielem))) then + doRegion = .True. + end if + end if + + ! Check the surface pressure. + doPS = .False. + if (rgn_ps(ielem) == 0._f) then + doPS = .True. + else + if (rgn_ps(ielem) > 0._f) then + if (state%ps(icol) > rgn_ps(ielem)) then + doPS = .True. + end if + else + if (state%ps(icol) <= abs(rgn_ps(ielem))) then + doPS = .True. + end if + end if + end if + + ! Calculate the emission rate as a constant mass. + if (doRegion .and. doPS) then + + ! A negative emission rate means to treat it as an mmr (kg/kg/s) and a + ! postive value means to treat it as a column mass (kg/m2/s). + if (carma_emission_rate > 0._f) then + tendency(icol, pver) = carma_emission_rate / state%pdel(icol, pver) / gravit + else + ! For mmr, calculate a tendecy to keep the surface at that emitted value, + ! rather than having a constant emission rate. +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt + end if + end if + + ! Scale with the land/ocean fraction. + frac = 0._f + + if (rgn_doLand(ielem)) then + frac = frac + cam_in%landfrac(icol) + end if + + if (rgn_doOcean(ielem)) then + frac = frac + cam_in%ocnfrac(icol) + end if + + if (rgn_doSeaIce(ielem)) then + frac = frac + cam_in%icefrac(icol) + end if + + tendency(icol, pver) = tendency(icol, pver) * frac + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only : pcnst + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: i + + ! Default return code. + rc = RC_OK + + ! Add initial condition here (default is 0.) + do i = 1, size(q, 2) + where(mask) + q(:,i) = 0._r8 + end where + end do + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/carma/models/tholin/carma_model_flags_mod.F90 b/src/physics/carma/models/tholin/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..e94eb426ac --- /dev/null +++ b/src/physics/carma/models/tholin/carma_model_flags_mod.F90 @@ -0,0 +1,80 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/ and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + real(r8), public :: carma_emis_total = 1e5_r8 ! Total mass emitted (kt/year) + character(len=256), public :: carma_emis_file = 'early_earth_haze.nc' ! name of the emission file + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_emis_total, & + carma_emis_file + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_emis_total, 1, mpir8, 0, mpicom) + call mpibcast(carma_emis_file, len(carma_emis_file), mpichar, 0, mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/tholin/carma_model_mod.F90 b/src/physics/carma/models/tholin/carma_model_mod.F90 new file mode 100755 index 0000000000..b2eb8309c3 --- /dev/null +++ b/src/physics/carma/models/tholin/carma_model_mod.F90 @@ -0,0 +1,643 @@ +!! This module is used to define a particular CARMA microphysical model. For +!! simple cases, this may be the only code that needs to be modified. This module +!! defines several constants and has three methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! - CARMA_InitializeParticle() +!! +!! These methods define the microphysical model, the particle emissions and +!! the initial conditions of the particles. Each realization of CARMA +!! microphysics has its own version of this file. +!! +!! This file is used to model early earth haze particles. This model is +!! preliminary and used to test the CARMA fractal code. Please talk to +!! Eric Wolf (eric.wolf@colorado.edu) if you are interested in this model. +!! +!! @version May-2013 +!! @author Eric Wolf, Chuck Bardeen +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + ! Declare the public methods. + public CARMA_DefineModel + public CARMA_Detrain + public CARMA_DiagnoseBins + public CARMA_DiagnoseBulk + public CARMA_EmitParticle + public CARMA_InitializeModel + public CARMA_InitializeParticle + public CARMA_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 1 !! Number of particle groups + integer, public, parameter :: NELEM = 1 !! Number of particle elements + integer, public, parameter :: NBIN = 40 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 0 !! Number of gases + + + !! Relative humidities for mie and radiation calculations. The RRTMG radiation code will interpolate + !! based upon the current relative humidity from a table built using the specified relative + !! humidities. + integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations + real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_THOLIN = 1 !! tholin composition + + ! Define group, element, solute and gas indexes. + integer, public, parameter :: I_GRP_THOLIN = 1 !! tholin aerosol group + + integer, public, parameter :: I_ELEM_THOLIN = 1 !! tholin aerosol element + + + ! These variables are all set during initialization and are used to calculate + ! emission tendencies. + integer :: carma_emis_nLevs ! number of emission levels + real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) + real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level + real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) +contains + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMA_DefineModel(carma, rc) + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + real(kind=f) :: RHO_THOLIN = 0.64 ! density of tholin particles (g/cm) + real(kind=f), parameter :: tholin_rmin = 1.e-7_f ! dust minimum radius (cm) + real(kind=f), parameter :: tholin_vmrat = 2.5_f ! dust volume ratio + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + real(kind=f) :: tholin_rmon = 50e-7_f ! tholin monomer radius (cm) + + ! soot fractal dimension + real(kind=f) :: tholin_df(NBIN) = & + (/ 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, & + 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 3.00000_f, 1.50214_f, 1.50535_f, 1.51331_f, & + 1.53291_f, 1.58003_f, 1.68694_f, 1.89714_f, 2.18998_f, 2.37633_f, 2.39990_f, 2.40000_f, & + 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, & + 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f, 2.40000_f /) + + real(kind=f) :: tholin_falpha = 1._f ! soot fractal packing coefficient + + ! Default return code. + rc = RC_OK + + ! Define the Groups + ! + ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + + call CARMAGROUP_Create(carma, I_GRP_THOLIN, "Tholin", tholin_rmin, tholin_vmrat, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, shortname="THOLIN", is_fractal=.true., & + rmon=tholin_rmon, df=tholin_df, falpha=tholin_falpha) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + call CARMAELEMENT_Create(carma, I_ELEM_THOLIN, I_GRP_THOLIN, "Tholin", RHO_THOLIN, & + I_INVOLATILE, I_THOLIN, rc, shortname="THOLIN") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes + + + ! Define the Gases + + + ! Define the Processes + call CARMA_AddCoagulation(carma, I_GRP_THOLIN, I_GRP_THOLIN, I_GRP_THOLIN, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + return + end subroutine CARMA_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + use physconst, only: latice, latvap, cpair + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMA_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + use time_manager, only: is_first_step + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + real(r8) :: mmr(pver) !! elements mass mixing ratio + integer :: ibin !! bin index + + ! Default return code. + rc = RC_OK + + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by + ! code to determine the mass in each bin from the CAM state. + + return + end subroutine CARMA_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + integer :: ielem ! element index + integer :: ibin ! bin index + real(r8) :: mmr(pver) ! mass mixing ration (kg/kg) + real(r8) :: sflx ! surface flux (kg/m2/s) + + ! Default return code. + rc = RC_OK + + ! Add the sedimentation and dry deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + ielem = I_ELEM_THOLIN + do ibin = 1, NBIN + + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) + if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + + cam_out%ocphidry(icol) = cam_out%ocphidry(icol) + max(sflx, 0._r8) + end do + + return + end subroutine CARMA_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & + is_perpetual, is_first_step + use camsrfexch, only: cam_in_t + use tropopause, only: tropopause_find + use physconst, only: gravit + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: igroup ! the index of the carma aerosol group + integer :: k ! vertical index + integer :: ilev ! level index in emissions data + character(len=32) :: shortname ! the shortname of the group + real(r8) :: r(NBIN) ! bin center + real(r8) :: dr(NBIN) ! bin width + real(r8) :: rmass(NBIN) ! bin mass + real(r8) :: pressure ! pressure (Pa) + real(r8) :: thickness ! layer thickness (m) + real(r8) :: rate ! emission rate (#/cm-3/s) + real(r8) :: massflux ! emission mass flux (kg/m2/s) + real(r8) :: columnMass ! mass of the total column (kg/m2/s) + real(r8) :: scale ! scaling factor to conserve the expected mass + + ! Default return code. + rc = RC_OK + + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + + ! Only do emission for the first bin of the meteor smoke group. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) + if (RC < RC_ERROR) return + + ! For meteoritic dust, the source from the smoke only goes into the + ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates + ! is proportional to the pressure, so the emission is a function of + ! pressure. + if ((shortname .eq. "THOLIN") .and. (ibin .eq. 1)) then + + ! Set tendencies for any sources or sinks in the atmosphere. + do k = 1, pver + do icol = 1, ncol + + pressure = state%pmid(icol, k) + + ! This is roughly a log-normal approximation to the production + ! rate, but only applies from about 70 to 110 km. + ! + ! NOTE: Based upon US Standard Atmosphere 1976. + if ((pressure >= carma_emis_lev(carma_emis_ilev_min)) .and. & + (pressure <= carma_emis_lev(carma_emis_ilev_max))) then + + ! The rates are in terms of # cm-3 s-1, but were really derived + ! from the mass flux of meteoritic dust. Since we are using a + ! size different that 1.0 nm for the smallest bin, scale the + ! number appropriately. + ! + ! The values are in a lookup table, so find the two numbers + ! surrounding the pressure and do a linear interpolation on the + ! rate. This linear search is kind of expensive, particularly if + ! there are a lot of points. + ! + ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) + do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr + if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then + rate = carma_emis_rate(ilev) + + if (pressure > carma_emis_lev(ilev)) then + rate = rate + & + ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & + (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & + (pressure - carma_emis_lev(ilev)) + end if + + rate = rate * (((1.0e-7_r8)**3) / (r(ibin)**3)) + exit + end if + end do + + ! Calculate the mass flux in terms of kg/m3/s + massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) + + ! Convert the mass flux to a tendency on the mass mixing ratio. + thickness = state%zi(icol, k) - state%zi(icol, k+1) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + end if + enddo + enddo + + ! Scale the columns to keep the total mass influx in the column a + ! constant. + do icol = 1, ncol + columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) + + ! Protect against divide-by-zero (but not overflow). + if (columnMass /= 0._r8) then + scale = carma_emis_expected / columnMass + else + scale = 0._r8 + end if + + ! Also apply the relative flux scaling. This needs to be done after + ! the normalization + tendency(icol, :) = tendency(icol, :) * scale + end do + end if + + return + end subroutine CARMA_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeModel(carma, lq_carma, rc) + use constituents, only: pcnst + use ioFileMod, only: getfil + use wrap_nf + use mpishorthand + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilev ! level index + integer :: fid ! file id + integer :: lev_did ! level dimension id + integer :: lev_vid ! level variable id + integer :: rate_vid ! rate variable + integer :: tmp + integer :: lat_did ! latitude dimension id + integer :: ltime_did ! local time dimension id + integer :: time_did ! time + integer :: lat_vid ! latitude variable id + integer :: lrf_vid ! local relative flux variable id + integer :: grf_vid ! global relative flux variable id + integer :: ltime_vid ! local time variable id + character(len=256) :: efile ! emission file name + + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + ! Default return code. + rc = RC_OK + + ! Add initialization here. + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + ! Initialize the emissions rate table. + if (carma_do_emission) then + if (masterproc) then + + ! Open the netcdf file (read only) + call getfil(carma_emis_file, efile, fid) + if (do_print) write(LUNOPRT,*) 'carma_init(): Reading particle emission rates from ', efile + + call wrap_open(efile, 0, fid) + + ! Alocate the table arrays + call wrap_inq_dimid(fid, "lev", lev_did) + call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) +#endif + + allocate(carma_emis_lev(carma_emis_nLevs)) + allocate(carma_emis_rate(carma_emis_nLevs)) + + if (masterproc) then + ! Read in the tables. + call wrap_inq_varid(fid, 'MHAZE', rate_vid) + call wrap_get_var_realx(fid, rate_vid, carma_emis_rate) + + call wrap_inq_varid(fid, 'lev', lev_vid) + call wrap_get_var_realx(fid, lev_vid, carma_emis_lev) + + ! Close the file. + call wrap_close(fid) + + ! Find out where the bounds of the table are and in what order + ! the pressures levels are in. + carma_emis_ilev_min = 1 + carma_emis_ilev_max = carma_emis_nLevs + + do ilev = 1, carma_emis_nLevs + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_min = ilev + 1 + else + exit + endif + end do + + do ilev = carma_emis_nLevs, 1, -1 + if (carma_emis_rate(ilev) <= 0.0) then + carma_emis_ilev_max = ilev - 1 + else + exit + endif + end do + + if (carma_emis_lev(carma_emis_ilev_min) < carma_emis_lev(carma_emis_ilev_max)) then + carma_emis_ilev_incr = 1 + else + carma_emis_ilev_incr = -1 + tmp = carma_emis_ilev_min + carma_emis_ilev_min = carma_emis_ilev_max + carma_emis_iLev_max = tmp + endif + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) '' + + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' + do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) + enddo + + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' + carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & + (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission table.' + + endif + +#if ( defined SPMD ) + call mpibcast(carma_emis_lev, carma_emis_nLevs, mpir8, 0, mpicom) + call mpibcast(carma_emis_rate, carma_emis_nLevs, mpir8, 0, mpicom) + + call mpibcast(carma_emis_expected, 1, mpir8, 0, mpicom) + + call mpibcast(carma_emis_ilev_min, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_max, 1, mpiint, 0, mpicom) + call mpibcast(carma_emis_ilev_incr, 1, mpiint, 0, mpicom) +#endif + + endif + + return + + return + end subroutine CARMA_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + + return + end subroutine CARMA_InitializeParticle + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + implicit none + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + ! Add the wet deposition fluxes to the hydrophilic black carbon. + ! + ! NOTE: Don't give the surface model negative values for the surface fluxes. + if (ielem == I_ELEM_THOLIN) then + do icol = 1, state%ncol + cam_out%ocphiwet(icol) = cam_out%ocphiwet(icol) + max(sflx(icol), 0._r8) + end do + end if + + return + end subroutine CARMA_WetDeposition + +end module diff --git a/src/physics/cosp2/Makefile.in b/src/physics/cosp2/Makefile.in new file mode 100644 index 0000000000..f13c1658e0 --- /dev/null +++ b/src/physics/cosp2/Makefile.in @@ -0,0 +1,187 @@ +.SUFFIXES : .F .f .c .o .a .f90 .f95 +######################################################################## +# +# The Makefile for building the COSP library is created by CAM's configure +# using this template and prepending the following macros: +# COSP_PATH, ISCCP_PATH, RS_PATH, CS_PATH, MISR_PATH, MODIS_PATH, RT_PATH, +# and PARASOL_PATH. +# +# The macro CAM_BLD is also prepended. It is the build directory of the CAM +# code and it contains the abortutils.mod file. The abortutils module is +# referenced by COSP code in order to perform an abort which is appropriate +# for the CESM system. +# +# The main customization required for the library to link with CAM is to +# use autopromotion of the default real type to real*8. This is required +# in most, though not all, of the COSP files. Also, some compilers require +# special flags to specify fixed or free format source (rather than depend +# on filename extensions). Thus, the explicit rules at the end of this +# template for compiling COSP files have been modified to allow different +# sets of flags for 1) files that cannot be compiled with autopromotion, +# and 2) files that use fixed format source. +# +# The generated Makefile will be used by a sub-Make issued from CAM's Make. +# The sub-Make will inherit the macros: +# +# FC name of Fortran90 compiler +# FC_FLAGS Fortran compiler flags +# +######################################################################## + +F90 := $(FC) +F90FLAGS := $(FREEFLAGS) $(FC_FLAGS) +VPATH := $(COSP_PATH) + +OBJS = cosp_kinds.o cosp_constants.o cosp_cloudsat_interface.o cosp_config.o \ + cosp.o cosp_stats.o quickbeam.o parasol.o lidar_simulator.o icarus.o \ + cosp_calipso_interface.o cosp_isccp_interface.o cosp_misr_interface.o \ + MISR_simulator.o cosp_modis_interface.o modis_simulator.o \ + cosp_rttov_interfaceSTUB.o cosp_rttovSTUB.o cosp_parasol_interface.o \ + scops.o prec_scops.o cosp_utils.o cosp_optics.o quickbeam_optics.o \ + mo_rng.o cosp_errorHandling.o array_lib.o math_lib.o optics_lib.o \ + mrgrnk.o + + +libcosp.a: $(OBJS) + ar cr libcosp.a $(OBJS) + +%.o: %.f90 + $(F90) -I$(CAM_BLD) $(F90FLAGS) -c $< +%.o: %.F90 + $(F90) -I$(CAM_BLD) $(F90FLAGS) -c $< + +# Dependencies (COSP2 library) +cosp.o : cosp_kinds.o cosp_modis_interface.o cosp_constants.o \ + cosp_rttov_interfaceSTUB.o cosp_misr_interface.o \ + cosp_isccp_interface.o cosp_calipso_interface.o \ + cosp_cloudsat_interface.o cosp_stats.o cosp_parasol_interface.o \ + cosp_rttovSTUB.o cosp_rttov_interfaceSTUB.o quickbeam.o \ + MISR_simulator.o lidar_simulator.o parasol.o icarus.o +cosp_config.o : cosp_kinds.o +cosp_stats.o : cosp_kinds.o cosp_config.o +cosp_calipso_interface.o : cosp_kinds.o lidar_simulator.o +cosp_cloudsat_interface.o : cosp_kinds.o cosp_config.o quickbeam.o +cosp_isccp_interface.o : cosp_kinds.o icarus.o +cosp_misr_interface.o : cosp_kinds.o +cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o +cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o +cosp_parasol_interface.o : cosp_kinds.o +cosp_rttovSTUB.o : cosp_kinds.o cosp_config.o cosp_constants.o +MISR_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o +modis_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o +lidar_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o +icarus.o : cosp_kinds.o cosp_constants.o cosp_stats.o +parasol.o : cosp_kinds.o cosp_config.o cosp_constants.o +quickbeam.o : cosp_kinds.o cosp_config.o cosp_stats.o +# Dependencies (for COSP interface) +mo_rng.o : cosp_kinds.o +scops.o : cosp_kinds.o mo_rng.o cosp_errorHandling.o +prec_scops.o : cosp_kinds.o cosp_config.o +cosp_optics.o : cosp_kinds.o cosp_constants.o modis_simulator.o +quickbeam_optics.o : cosp_kinds.o cosp_config.o cosp_constants.o quickbeam.o \ + cosp_errorHandling.o array_lib.o math_lib.o optics_lib.o +optics_lib.o : cosp_kinds.o cosp_errorHandling.o +array_lib.o : cosp_kinds.o cosp_errorHandling.o +math_lib.o : cosp_kinds.o array_lib.o mrgrnk.o +mrgrnk.o : cosp_kinds.o +cosp_errorHandling.o : cosp_kinds.o +cosp_utils.o : cosp_kinds.o cosp_config.o +cosp_constants.o : cosp_kinds.o + +# +clean_objs: + rm -f $(OBJS) *.mod *.o + +clean: + rm -f $(PROG) $(OBJS) *.mod *.o fort.* + +icarus.o : $(ISCCP_PATH)/icarus.F90 + $(F90) $(F90FLAGS) -c $< + +quickbeam.o: $(RS_PATH)/quickbeam.F90 + $(F90) $(F90FLAGS) -c $< + +MISR_simulator.o : $(MISR_PATH)/MISR_simulator.F90 + $(F90) $(F90FLAGS) -c $< + +modis_simulator.o : $(MODIS_PATH)/modis_simulator.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_rttov_interfaceSTUB.o : $(COSP_PATH)/src/simulator/cosp_rttov_interfaceSTUB.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_misr_interface.o : $(COSP_PATH)/src/simulator/cosp_misr_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_modis_interface.o : $(COSP_PATH)/src/simulator/cosp_modis_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_isccp_interface.o : $(COSP_PATH)/src/simulator/cosp_isccp_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_calipso_interface.o : $(COSP_PATH)/src/simulator/cosp_calipso_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_cloudsat_interface.o : $(COSP_PATH)/src/simulator/cosp_cloudsat_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_parasol_interface.o : $(COSP_PATH)/src/simulator/cosp_parasol_interface.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_rttovSTUB.o : $(RT_PATH)/cosp_rttovSTUB.F90 + $(F90) $(F90FLAGS) -c $< + +lidar_simulator.o : $(CS_PATH)/lidar_simulator.F90 + $(F90) $(F90FLAGS) -c $< + +parasol.o : $(PARASOL_PATH)/parasol.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_constants.o : $(COSP_PATH)/src/cosp_constants.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_kinds.o : $(COSP_PATH)/cosp_kinds.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_config.o : $(COSP_PATH)/src/cosp_config.F90 + $(F90) $(F90FLAGS) -c $< + +cosp.o : $(COSP_PATH)/src/cosp.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_stats.o : $(COSP_PATH)/src/cosp_stats.F90 + $(F90) $(F90FLAGS) -c $< + +# COSPv1.4 interface +mo_rng.o : $(COSP_PATH)/subcol/mo_rng.F90 + $(F90) $(F90FLAGS) -c $< + +scops.o : $(COSP_PATH)/subcol/scops.F90 + $(F90) $(F90FLAGS) -c $< + +prec_scops.o : $(COSP_PATH)/subcol/prec_scops.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_utils.o : $(COSP_PATH)/optics/cosp_utils.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_optics.o : $(COSP_PATH)/optics/cosp_optics.F90 + $(F90) $(F90FLAGS) -c $< + +quickbeam_optics.o : $(COSP_PATH)/optics/quickbeam_optics.F90 + $(F90) $(F90FLAGS) -c $< + +array_lib.o : $(COSP_PATH)/optics/array_lib.F90 + $(F90) $(F90FLAGS) -c $< + +math_lib.o : $(COSP_PATH)/optics/math_lib.F90 + $(F90) $(F90FLAGS) -c $< + +mrgrnk.o : $(COSP_PATH)/optics/mrgrnk.F90 + $(F90) $(F90FLAGS) -c $< + +optics_lib.o : $(COSP_PATH)/optics/optics_lib.F90 + $(F90) $(F90FLAGS) -c $< + +cosp_errorHandling.o : $(COSP_PATH)/cosp_errorHandling.F90 + $(F90) $(F90FLAGS) -c $< diff --git a/src/physics/cosp2/cosp_errorHandling.F90 b/src/physics/cosp2/cosp_errorHandling.F90 new file mode 100644 index 0000000000..fee68c326f --- /dev/null +++ b/src/physics/cosp2/cosp_errorHandling.F90 @@ -0,0 +1,50 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015- D. Swales - Original version +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +module mod_cosp_error + use cosp_kinds, ONLY: wp +contains + ! ###################################################################################### + ! Subroutine errorMessage_print + ! ###################################################################################### + subroutine errorMessage(message) + ! Inputs + character(len=*),intent(in) :: message + + print*,message + end subroutine errorMessage + + ! ###################################################################################### + ! END MODULE + ! ###################################################################################### +end module mod_cosp_error diff --git a/src/physics/cosp2/cosp_kinds.F90 b/src/physics/cosp2/cosp_kinds.F90 new file mode 100644 index 0000000000..c8c14575f2 --- /dev/null +++ b/src/physics/cosp2/cosp_kinds.F90 @@ -0,0 +1,40 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015- D. Swales - Original version +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +MODULE cosp_kinds + implicit none + INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND( 6, 37) + INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(12) !Same as SHR_KIND_R8 + INTEGER, PARAMETER :: wp = dp + +END MODULE cosp_kinds + diff --git a/src/physics/cosp2/optics/array_lib.F90 b/src/physics/cosp2/optics/array_lib.F90 new file mode 100644 index 0000000000..05fafca74a --- /dev/null +++ b/src/physics/cosp2/optics/array_lib.F90 @@ -0,0 +1,103 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! 10/16/03 John Haynes - Original version (haynes@atmos.colostate.edu) +! 01/31/06 John Haynes - IDL to Fortran 90 +! 01/01/15 Dustin Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module array_lib + USE COSP_KINDS, ONLY: wp + implicit none +contains + + ! ############################################################################ + ! function INFIND + ! ############################################################################ + function infind(list,val) + implicit none + ! ########################################################################## + ! Purpose: + ! Finds the index of an array that is closest to a value, plus the + ! difference between the value found and the value specified + ! + ! Inputs: + ! [list] an array of sequential values + ! [val] a value to locate + ! Optional input: + ! [sort] set to 1 if [list] is in unknown/non-sequential order + ! + ! Returns: + ! index of [list] that is closest to [val] + ! + ! Optional output: + ! [dist] set to variable containing [list([result])] - [val] + ! + ! Requires: + ! mrgrnk library + ! + ! ########################################################################## + + ! INPUTS + real(wp), dimension(:), intent(in) :: & + list ! An array of sequential values + real(wp), intent(in) :: & + val ! A value to locate + ! OUTPUTS + integer :: & + infind ! Index of [list] that is closest to [val] + + ! Internal Variables + real(wp), dimension(size(list)) :: lists + integer :: nlist, result, tmp(1), sort_list + integer, dimension(size(list)) :: mask + + sort_list = 0 + + nlist = size(list) + lists = list + + if (val >= lists(nlist)) then + result = nlist + else if (val <= lists(1)) then + result = 1 + else + mask(:) = 0 + where (lists < val) mask = 1 + tmp = minloc(mask,1) + if (abs(lists(tmp(1)-1)-val) < abs(lists(tmp(1))-val)) then + result = tmp(1) - 1 + else + result = tmp(1) + endif + endif + infind = result + end function infind + +end module array_lib diff --git a/src/physics/cosp2/optics/cosp_optics.F90 b/src/physics/cosp2/optics/cosp_optics.F90 new file mode 100644 index 0000000000..b1ed5ef117 --- /dev/null +++ b/src/physics/cosp2/optics/cosp_optics.F90 @@ -0,0 +1,488 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! 05/01/15 Dustin Swales - Original version +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module cosp_optics + USE COSP_KINDS, ONLY: wp,dp + USE COSP_MATH_CONSTANTS, ONLY: pi + USE COSP_PHYS_CONSTANTS, ONLY: rholiq,km,rd,grav + USE MOD_MODIS_SIM, ONLY: phaseIsLiquid,phaseIsIce,get_g_nir=>get_g_nir_old,get_ssa_nir=>get_ssa_nir_old + implicit none + + real(wp),parameter :: & ! + ice_density = 0.93_wp ! Ice density used in MODIS phase partitioning + + interface cosp_simulator_optics + module procedure cosp_simulator_optics2D, cosp_simulator_optics3D + end interface cosp_simulator_optics + +contains + ! ########################################################################## + ! COSP_SIMULATOR_OPTICS + ! + ! Used by: ISCCP, MISR and MODIS simulators + ! ########################################################################## + subroutine cosp_simulator_optics2D(dim1,dim2,dim3,flag,varIN1,varIN2,varOUT) + ! INPUTS + integer,intent(in) :: & + dim1, & ! Dimension 1 extent (Horizontal) + dim2, & ! Dimension 2 extent (Subcolumn) + dim3 ! Dimension 3 extent (Vertical) + real(wp),intent(in),dimension(dim1,dim2,dim3) :: & + flag ! Logical to determine the of merge var1IN and var2IN + real(wp),intent(in),dimension(dim1, dim3) :: & + varIN1, & ! Input field 1 + varIN2 ! Input field 2 + ! OUTPUTS + real(wp),intent(out),dimension(dim1,dim2,dim3) :: & + varOUT ! Merged output field + ! LOCAL VARIABLES + integer :: j + + varOUT(1:dim1,1:dim2,1:dim3) = 0._wp + do j=1,dim2 + where(flag(:,j,:) .eq. 1) + varOUT(:,j,:) = varIN2 + endwhere + where(flag(:,j,:) .eq. 2) + varOUT(:,j,:) = varIN1 + endwhere + enddo + end subroutine cosp_simulator_optics2D + subroutine cosp_simulator_optics3D(dim1,dim2,dim3,flag,varIN1,varIN2,varOUT) + ! INPUTS + integer,intent(in) :: & + dim1, & ! Dimension 1 extent (Horizontal) + dim2, & ! Dimension 2 extent (Subcolumn) + dim3 ! Dimension 3 extent (Vertical) + real(wp),intent(in),dimension(dim1,dim2,dim3) :: & + flag ! Logical to determine the of merge var1IN and var2IN + real(wp),intent(in),dimension(dim1,dim2,dim3) :: & + varIN1, & ! Input field 1 + varIN2 ! Input field 2 + ! OUTPUTS + real(wp),intent(out),dimension(dim1,dim2,dim3) :: & + varOUT ! Merged output field + + varOUT(1:dim1,1:dim2,1:dim3) = 0._wp + where(flag(:,:,:) .eq. 1) + varOUT(:,:,:) = varIN2 + endwhere + where(flag(:,:,:) .eq. 2) + varOUT(:,:,:) = varIN1 + endwhere + + end subroutine cosp_simulator_optics3D + + ! ############################################################################## + ! MODIS_OPTICS_PARTITION + ! + ! For the MODIS simulator, there are times when only a sinlge optical depth + ! profile, cloud-ice and cloud-water are provided. In this case, the optical + ! depth is partitioned by phase. + ! ############################################################################## + subroutine MODIS_OPTICS_PARTITION(npoints,nlev,ncolumns,cloudWater,cloudIce,cloudSnow, & + waterSize,iceSize,snowSize,tau,tauL,tauI,tauS) + ! INPUTS + INTEGER,intent(in) :: & + npoints, & ! Number of horizontal gridpoints + nlev, & ! Number of levels + ncolumns ! Number of subcolumns + REAL(wp),intent(in),dimension(npoints,nlev,ncolumns) :: & + cloudWater, & ! Subcolumn cloud water content + cloudIce, & ! Subcolumn cloud ice content + cloudSnow, & ! Subcolumn cloud snow content + waterSize, & ! Subcolumn cloud water effective radius + iceSize, & ! Subcolumn cloud ice effective radius + snowSize, & ! Subcolumn cloud snow effective radius + tau ! Optical thickness + + ! OUTPUTS + real(wp),intent(out),dimension(npoints,nlev,ncolumns) :: & + tauL, & ! Partitioned liquid optical thickness. + tauI, & ! Partitioned ice optical thickness. + tauS ! Partitioned snow optical thickness. + + ! LOCAL VARIABLES + real(wp),dimension(nlev,ncolumns) :: totalExtinction + integer :: i,j,k + + do i=1,npoints + totalExtinction(:,:) = 0._wp + where(waterSize(i,:,:) > 0.) + totalExtinction(:,:) = cloudWater(i,:,:)/waterSize(i,:,:) + elsewhere + totalExtinction(:,:) = 0. + end where + + where(iceSize(i,:,:) > 0.) totalExtinction(:,:) = totalExtinction(:,:) + & + cloudIce(i,:,:)/(ice_density * iceSize(i,:,:)) + where(snowSize(i,:,:) > 0.) totalExtinction(:,:) = totalExtinction(:,:) + & + cloudSnow(i,:,:)/(ice_density * snowSize(i,:,:)) + + where((waterSize(i,:, :) > 0.) .and. (totalExtinction(:,:) > 0.)) + tauL(i,:,:) = tau(i,:,:) * cloudWater(i,:,:) / & + ( waterSize(i,:,:) * totalExtinction(:,:)) + elsewhere + tauL(i,:,:) = 0. + end where + + where( (iceSize(i,:,:) > 0.) .and. (totalExtinction(:,:) > 0.)) + tauI(i,:,:) = tau(i,:,:) * cloudIce(i,:,:) / & + (ice_density * iceSize(i,:,:) * totalExtinction(:,:)) + elsewhere + tauI(i,:,:) = 0. + end where + + where( (snowSize(i,:,:) > 0.) .and. (totalExtinction(:,:) > 0.)) + tauS(i,:,:) = tau(i,:,:) * cloudSnow(i,:,:) / & + (ice_density * snowSize(i,:,:) * totalExtinction(:,:)) + elsewhere + tauS(i,:,:) = 0. + end where + enddo + + end subroutine MODIS_OPTICS_PARTITION + ! ######################################################################################## + ! SUBROUTINE MODIS_OPTICS + ! ######################################################################################## + subroutine modis_optics(nPoints, nLevels, nSubCols, tauLIQ, sizeLIQ, tauICE, sizeICE, & + tauSNOW, sizeSNOW, fracLIQ, g, w0) + ! INPUTS + integer, intent(in) :: nPoints,nLevels,nSubCols + real(wp),intent(in),dimension(nPoints,nSubCols,nLevels) :: tauLIQ, sizeLIQ, tauICE, sizeICE,tauSNOW,sizeSNOW + + ! OUTPUTS + real(wp),intent(out),dimension(nPoints,nSubCols,nLevels) :: g,w0,fracLIQ + ! LOCAL VARIABLES + real(wp), dimension(nLevels) :: water_g, water_w0, ice_g, ice_w0, tau, snow_g, snow_w0 + integer :: i,j + + ! Initialize + g(1:nPoints,1:nSubCols,1:nLevels) = 0._wp + w0(1:nPoints,1:nSubCols,1:nLevels) = 0._wp + + do j =1,nPoints + do i=1,nSubCols + water_g(1:nLevels) = get_g_nir( phaseIsLiquid, sizeLIQ(j,i,1:nLevels)) + water_w0(1:nLevels) = get_ssa_nir(phaseIsLiquid, sizeLIQ(j,i,1:nLevels)) + ice_g(1:nLevels) = get_g_nir( phaseIsIce, sizeICE(j,i,1:nLevels)) + ice_w0(1:nLevels) = get_ssa_nir(phaseIsIce, sizeICE(j,i,1:nLevels)) + snow_g(1:nLevels) = get_g_nir( phaseIsIce, sizeSNOW(j,i,1:nLevels)) + snow_w0(1:nLevels) = get_ssa_nir(phaseIsIce, sizeSNOW(j,i,1:nLevels)) + + ! Combine ice, snow and water optical properties + tau(1:nLevels) = tauICE(j,i,1:nLevels) + tauLIQ(j,i,1:nLevels) + tauSNOW(j,i,1:nLevels) + where (tau(1:nLevels) > 0) + g(j,i,1:nLevels) = (tauLIQ(j,i,1:nLevels)*water_g(1:nLevels) + & + tauICE(j,i,1:nLevels)*ice_g(1:nLevels) + & + tauSNOW(j,i,1:nLevels)*snow_g(1:nLevels)) / & + tau(1:nLevels) + w0(j,i,1:nLevels) = (tauLIQ(j,i,1:nLevels)*water_g(1:nLevels)*water_w0(1:nLevels) + & + tauICE(j,i,1:nLevels)*ice_g(1:nLevels)*ice_w0(1:nLevels) + & + tauSNOW(j,i,1:nLevels)*snow_g(1:nLevels)*snow_w0(1:nLevels)) / & + (g(j,i,1:nLevels) * tau(1:nLevels)) + end where + enddo + enddo + + ! Compute the total optical thickness and the proportion due to liquid in each cell + do i=1,npoints + where(tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) + tauSNOW(i,1:nSubCols,1:nLevels) > 0.) + fracLIQ(i,1:nSubCols,1:nLevels) = tauLIQ(i,1:nSubCols,1:nLevels)/ & + (tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) + tauSNOW(i,1:nSubCols,1:nLevels) ) + elsewhere + fracLIQ(i,1:nSubCols,1:nLevels) = 0._wp + end where + enddo + + end subroutine modis_optics + + ! ###################################################################################### + ! SUBROUTINE lidar_optics + ! ###################################################################################### + subroutine lidar_optics(npoints,ncolumns,nlev,npart,ice_type,q_lsliq,q_lsice,q_cvliq, & + q_cvice,q_lssnow,ls_radliq,ls_radice,cv_radliq,cv_radice,ls_radsnow, & + pres,presf,temp,beta_mol,betatot,tau_mol,tautot, & + tautot_S_liq,tautot_S_ice,betatot_ice,betatot_liq, & + tautot_ice,tautot_liq) + + ! #################################################################################### + ! NOTE: Using "grav" from cosp_constants.f90, instead of grav=9.81, introduces + ! changes of up to 2% in atb532 adn 0.003% in parasolRefl and lidarBetaMol532. + ! This also results in small changes in the joint-histogram, cfadLidarsr532. + ! #################################################################################### + + ! INPUTS + INTEGER,intent(in) :: & + npoints, & ! Number of gridpoints + ncolumns, & ! Number of subcolumns + nlev, & ! Number of levels + npart, & ! Number of cloud meteors (stratiform_liq, stratiform_ice, conv_liq, conv_ice). + ice_type ! Ice particle shape hypothesis (0 for spheres, 1 for non-spherical) + REAL(WP),intent(in),dimension(npoints,nlev) :: & + temp, & ! Temperature of layer k + pres, & ! Pressure at full levels + ls_radliq, & ! Effective radius of LS liquid particles (meters) + ls_radice, & ! Effective radius of LS ice particles (meters) + cv_radliq, & ! Effective radius of CONV liquid particles (meters) + cv_radice ! Effective radius of CONV ice particles (meters) + REAL(WP),intent(inout),dimension(npoints,nlev) :: & + ls_radsnow ! Effective radius of LS snow particles (meters) + REAL(WP),intent(in),dimension(npoints,ncolumns,nlev) :: & + q_lsliq, & ! LS sub-column liquid water mixing ratio (kg/kg) + q_lsice, & ! LS sub-column ice water mixing ratio (kg/kg) + q_cvliq, & ! CONV sub-column liquid water mixing ratio (kg/kg) + q_cvice, & ! CONV sub-column ice water mixing ratio (kg/kg) + q_lssnow ! LS sub-column snow mixing ratio (kg/kg) + REAL(WP),intent(in),dimension(npoints,nlev+1) :: & + presf ! Pressure at half levels + + ! OUTPUTS + REAL(WP),intent(out),dimension(npoints,ncolumns,nlev) :: & + betatot, & ! + tautot ! Optical thickess integrated from top + REAL(WP),optional,intent(out),dimension(npoints,ncolumns,nlev) :: & + betatot_ice, & ! Backscatter coefficient for ice particles + betatot_liq, & ! Backscatter coefficient for liquid particles + tautot_ice, & ! Total optical thickness of ice + tautot_liq ! Total optical thickness of liq + REAL(WP),intent(out),dimension(npoints,nlev) :: & + beta_mol, & ! Molecular backscatter coefficient + tau_mol ! Molecular optical depth + REAL(WP),intent(out),dimension(npoints,ncolumns) :: & + tautot_S_liq, & ! TOA optical depth for liquid + tautot_S_ice ! TOA optical depth for ice + + ! LOCAL VARIABLES + REAL(WP),dimension(npart) :: rhopart + REAL(WP),dimension(npart,5) :: polpart + REAL(WP),dimension(npoints,nlev) :: rhoair,alpha_mol + REAL(WP),dimension(npoints,nlev+1) :: zheight + REAL(WP),dimension(npoints,nlev,npart) :: rad_part,kp_part,qpart,alpha_part,tau_part + + INTEGER :: i,k,icol + + ! Local data + REAL(WP),PARAMETER :: rhoice = 0.5e+03 ! Density of ice (kg/m3) + REAL(WP),PARAMETER :: Cmol = 6.2446e-32 ! Wavelength dependent + REAL(WP),PARAMETER :: rdiffm = 0.7_wp ! Multiple scattering correction parameter + REAL(WP),PARAMETER :: Qscat = 2.0_wp ! Particle scattering efficiency at 532 nm + ! Local indicies for large-scale and convective ice and liquid + INTEGER,PARAMETER :: INDX_LSLIQ = 1 + INTEGER,PARAMETER :: INDX_LSICE = 2 + INTEGER,PARAMETER :: INDX_CVLIQ = 3 + INTEGER,PARAMETER :: INDX_CVICE = 4 + INTEGER,PARAMETER :: INDX_LSSNOW = 5 + + ! Polarized optics parameterization + ! Polynomial coefficients for spherical liq/ice particles derived from Mie theory. + ! Polynomial coefficients for non spherical particles derived from a composite of + ! Ray-tracing theory for large particles (e.g. Noel et al., Appl. Opt., 2001) + ! and FDTD theory for very small particles (Yang et al., JQSRT, 2003). + ! We repeat the same coefficients for LS and CONV cloud to make code more readable + REAL(WP),PARAMETER,dimension(5) :: & + polpartCVLIQ = (/ 2.6980e-8_wp, -3.7701e-6_wp, 1.6594e-4_wp, -0.0024_wp, 0.0626_wp/), & + polpartLSLIQ = (/ 2.6980e-8_wp, -3.7701e-6_wp, 1.6594e-4_wp, -0.0024_wp, 0.0626_wp/), & + polpartCVICE0 = (/-1.0176e-8_wp, 1.7615e-6_wp, -1.0480e-4_wp, 0.0019_wp, 0.0460_wp/), & + polpartLSICE0 = (/-1.0176e-8_wp, 1.7615e-6_wp, -1.0480e-4_wp, 0.0019_wp, 0.0460_wp/), & + polpartCVICE1 = (/ 1.3615e-8_wp, -2.04206e-6_wp, 7.51799e-5_wp, 0.00078213_wp, 0.0182131_wp/), & + polpartLSICE1 = (/ 1.3615e-8_wp, -2.04206e-6_wp, 7.51799e-5_wp, 0.00078213_wp, 0.0182131_wp/), & + polpartLSSNOW = (/ 1.3615e-8_wp, -2.04206e-6_wp, 7.51799e-5_wp, 0.00078213_wp, 0.0182131_wp/) + ! ############################################################################## + + ! Liquid/ice particles + rhopart(INDX_LSLIQ) = rholiq + rhopart(INDX_LSICE) = rhoice + rhopart(INDX_CVLIQ) = rholiq + rhopart(INDX_CVICE) = rhoice + rhopart(INDX_LSSNOW) = rhoice/2._wp + + ! LS and CONV Liquid water coefficients + polpart(INDX_LSLIQ,1:5) = polpartLSLIQ + polpart(INDX_CVLIQ,1:5) = polpartCVLIQ + polpart(INDX_LSSNOW,1:5) = polpartLSSNOW + ! LS and CONV Ice water coefficients + if (ice_type .eq. 0) then + polpart(INDX_LSICE,1:5) = polpartLSICE0 + polpart(INDX_CVICE,1:5) = polpartCVICE0 + endif + if (ice_type .eq. 1) then + polpart(INDX_LSICE,1:5) = polpartLSICE1 + polpart(INDX_CVICE,1:5) = polpartCVICE1 + endif + + ! Effective radius particles: + rad_part(1:npoints,1:nlev,INDX_LSLIQ) = ls_radliq(1:npoints,1:nlev) + rad_part(1:npoints,1:nlev,INDX_LSICE) = ls_radice(1:npoints,1:nlev) + rad_part(1:npoints,1:nlev,INDX_CVLIQ) = cv_radliq(1:npoints,1:nlev) + rad_part(1:npoints,1:nlev,INDX_CVICE) = cv_radice(1:npoints,1:nlev) + rad_part(1:npoints,1:nlev,INDX_LSSNOW) = ls_radsnow(1:npoints,1:nlev) + rad_part(:,:,:) = MAX(rad_part(:,:,:),0._wp) + rad_part(:,:,:) = MIN(rad_part(:,:,:),70.0e-6_wp) + ls_radsnow(:,:) = MAX(ls_radsnow(:,:),0._wp) + ls_radsnow(:,:) = MIN(ls_radsnow(:,:),1000.e-6_wp) + + ! Density (clear-sky air) + rhoair(1:npoints,1:nlev) = pres(1:npoints,1:nlev)/(rd*temp(1:npoints,1:nlev)) + + ! Altitude at half pressure levels: + zheight(1:npoints,nlev+1) = 0._wp + do k=nlev,1,-1 + zheight(1:npoints,k) = zheight(1:npoints,k+1) & + -(presf(1:npoints,k)-presf(1:npoints,k+1))/(rhoair(1:npoints,k)*grav) + enddo + + ! ############################################################################## + ! *) Molecular alpha, beta and optical thickness + ! ############################################################################## + + beta_mol(1:npoints,1:nlev) = pres(1:npoints,1:nlev)/km/temp(1:npoints,1:nlev)*Cmol + alpha_mol(1:npoints,1:nlev) = 8._wp*pi/3._wp * beta_mol(1:npoints,1:nlev) + + ! Optical thickness of each layer (molecular) + tau_mol(1:npoints,1:nlev) = alpha_mol(1:npoints,1:nlev)*(zheight(1:npoints,1:nlev)-& + zheight(1:npoints,2:nlev+1)) + + ! Optical thickness from TOA to layer k (molecular) + DO k = 2,nlev + tau_mol(1:npoints,k) = tau_mol(1:npoints,k) + tau_mol(1:npoints,k-1) + ENDDO + + betatot (1:npoints,1:ncolumns,1:nlev) = spread(beta_mol(1:npoints,1:nlev), dim=2, NCOPIES=ncolumns) + tautot (1:npoints,1:ncolumns,1:nlev) = spread(tau_mol (1:npoints,1:nlev), dim=2, NCOPIES=ncolumns) + betatot_liq(1:npoints,1:ncolumns,1:nlev) = betatot(1:npoints,1:ncolumns,1:nlev) + betatot_ice(1:npoints,1:ncolumns,1:nlev) = betatot(1:npoints,1:ncolumns,1:nlev) + tautot_liq (1:npoints,1:ncolumns,1:nlev) = tautot(1:npoints,1:ncolumns,1:nlev) + tautot_ice (1:npoints,1:ncolumns,1:nlev) = tautot(1:npoints,1:ncolumns,1:nlev) + + ! ############################################################################## + ! *) Particles alpha, beta and optical thickness + ! ############################################################################## + ! Polynomials kp_lidar derived from Mie theory + do i = 1, npart + where (rad_part(1:npoints,1:nlev,i) .gt. 0.0) + kp_part(1:npoints,1:nlev,i) = & + polpart(i,1)*(rad_part(1:npoints,1:nlev,i)*1e6)**4 & + + polpart(i,2)*(rad_part(1:npoints,1:nlev,i)*1e6)**3 & + + polpart(i,3)*(rad_part(1:npoints,1:nlev,i)*1e6)**2 & + + polpart(i,4)*(rad_part(1:npoints,1:nlev,i)*1e6) & + + polpart(i,5) + elsewhere + kp_part(1:npoints,1:nlev,i) = 0._wp + endwhere + enddo + + ! Loop over all subcolumns + tautot_S_liq(1:npoints,1:ncolumns) = 0._wp + tautot_S_ice(1:npoints,1:ncolumns) = 0._wp + do icol=1,ncolumns + ! ############################################################################## + ! Mixing ratio particles in each subcolum + ! ############################################################################## + qpart(1:npoints,1:nlev,INDX_LSLIQ) = q_lsliq(1:npoints,icol,1:nlev) + qpart(1:npoints,1:nlev,INDX_LSICE) = q_lsice(1:npoints,icol,1:nlev) + qpart(1:npoints,1:nlev,INDX_CVLIQ) = q_cvliq(1:npoints,icol,1:nlev) + qpart(1:npoints,1:nlev,INDX_CVICE) = q_cvice(1:npoints,icol,1:nlev) + qpart(1:npoints,1:nlev,INDX_LSSNOW) = q_lssnow(1:npoints,icol,1:nlev) + + ! ############################################################################## + ! Alpha and optical thickness (particles) + ! ############################################################################## + ! Alpha of particles in each subcolumn: + do i = 1, npart-1 + where (rad_part(1:npoints,1:nlev,i) .gt. 0.0) + alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat & + * rhoair(1:npoints,1:nlev) * qpart(1:npoints,1:nlev,i) & + / (rhopart(i) * rad_part(1:npoints,1:nlev,i) ) + elsewhere + alpha_part(1:npoints,1:nlev,i) = 0._wp + endwhere + enddo + where ( ls_radsnow(:,:).gt.0.0) + alpha_part(:,:,5) = 3.0/4.0 * Qscat * rhoair(:,:) * qpart(:,:,5)/(rhopart(5) * ls_radsnow(:,:) ) + elsewhere + alpha_part(:,:,5) = 0. + endwhere + + ! Optical thicknes + tau_part(1:npoints,1:nlev,1:npart) = rdiffm * alpha_part(1:npoints,1:nlev,1:npart) + do i = 1, npart + ! Optical thickness of each layer (particles) + tau_part(1:npoints,1:nlev,i) = tau_part(1:npoints,1:nlev,i) & + & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) ) + ! Optical thickness from TOA to layer k (particles) + do k=2,nlev + tau_part(1:npoints,k,i) = tau_part(1:npoints,k,i) + tau_part(1:npoints,k-1,i) + enddo + enddo + + ! ############################################################################## + ! Beta and optical thickness (total=molecular + particules) + ! ############################################################################## + + DO i = 1, npart + betatot(1:npoints,icol,1:nlev) = betatot(1:npoints,icol,1:nlev) + & + kp_part(1:npoints,1:nlev,i)*alpha_part(1:npoints,1:nlev,i) + tautot(1:npoints,icol,1:nlev) = tautot(1:npoints,icol,1:nlev) + & + tau_part(1:npoints,1:nlev,i) + ENDDO + + ! ############################################################################## + ! Beta and optical thickness (liquid/ice) + ! ############################################################################## + ! Ice + betatot_ice(1:npoints,icol,1:nlev) = betatot_ice(1:npoints,icol,1:nlev)+ & + kp_part(1:npoints,1:nlev,INDX_LSICE)*alpha_part(1:npoints,1:nlev,INDX_LSICE)+ & + kp_part(1:npoints,1:nlev,INDX_CVICE)*alpha_part(1:npoints,1:nlev,INDX_CVICE) + tautot_ice(1:npoints,icol,1:nlev) = tautot_ice(1:npoints,icol,1:nlev) + & + tau_part(1:npoints,1:nlev,INDX_LSICE) + & + tau_part(1:npoints,1:nlev,INDX_CVICE) + + ! Liquid + betatot_liq(1:npoints,icol,1:nlev) = betatot_liq(1:npoints,icol,1:nlev)+ & + kp_part(1:npoints,1:nlev,INDX_LSLIQ)*alpha_part(1:npoints,1:nlev,INDX_LSLIQ)+ & + kp_part(1:npoints,1:nlev,INDX_CVLIQ)*alpha_part(1:npoints,1:nlev,INDX_CVLIQ) + tautot_liq(1:npoints,icol,1:nlev) = tautot_liq(1:npoints,icol,1:nlev) + & + tau_part(1:npoints,1:nlev,INDX_LSLIQ) + & + tau_part(1:npoints,1:nlev,INDX_CVLIQ) + + ! ############################################################################## + ! Optical depths used by the PARASOL simulator + ! ############################################################################## + tautot_S_liq(:,icol) = tau_part(:,nlev,1)+tau_part(:,nlev,3) + tautot_S_ice(:,icol) = tau_part(:,nlev,2)+tau_part(:,nlev,4)+tau_part(:,nlev,5) + enddo + + end subroutine lidar_optics + + +end module cosp_optics diff --git a/src/physics/cosp2/optics/cosp_utils.F90 b/src/physics/cosp2/optics/cosp_utils.F90 new file mode 100644 index 0000000000..98c26cd5be --- /dev/null +++ b/src/physics/cosp2/optics/cosp_utils.F90 @@ -0,0 +1,89 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! Jul 2007 - A. Bodas-Salcedo - Initial version +! May 2015 - Dustin Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +MODULE MOD_COSP_UTILS + USE COSP_KINDS, ONLY: wp + USE MOD_COSP_CONFIG + IMPLICIT NONE + +CONTAINS +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +!------------------- SUBROUTINE COSP_PRECIP_MXRATIO -------------- +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, & + n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4, & + flux,mxratio,reff) + + ! Input arguments, (IN) + integer,intent(in) :: Npoints,Nlevels,Ncolumns + real(wp),intent(in),dimension(Npoints,Nlevels) :: p,T,flux + real(wp),intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac + real(wp),intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4,prec_type + ! Input arguments, (OUT) + real(wp),intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio + real(wp),intent(inout),dimension(Npoints,Ncolumns,Nlevels) :: reff + ! Local variables + integer :: i,j,k + real(wp) :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta + + mxratio = 0.0 + + if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed + xi = d_x/(alpha_x + b_x - n_bx + 1._wp) + rho0 = 1.29_wp + sigma = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi + one_over_xip1 = 1._wp/(xi + 1._wp) + gamma_4_3_2 = 0.5_wp*gamma4/gamma3 + delta = (alpha_x + b_x + d_x - n_bx + 1._wp) + + do k=1,Nlevels + do j=1,Ncolumns + do i=1,Npoints + if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then + rho = p(i,k)/(287.05_wp*T(i,k)) + mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1 + mxratio(i,j,k)=mxratio(i,j,k)/rho + ! Compute effective radius + if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) /= 0._wp)) then + lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1._wp/delta) + reff(i,j,k) = gamma_4_3_2/lambda_x + endif + endif + enddo + enddo + enddo + endif +END SUBROUTINE COSP_PRECIP_MXRATIO + + +END MODULE MOD_COSP_UTILS diff --git a/src/physics/cosp2/optics/math_lib.F90 b/src/physics/cosp2/optics/math_lib.F90 new file mode 100644 index 0000000000..d282614be3 --- /dev/null +++ b/src/physics/cosp2/optics/math_lib.F90 @@ -0,0 +1,404 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! July 2006: John Haynes - Initial version +! May 2015: Dustin Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module math_lib + USE COSP_KINDS, ONLY: wp + use mod_cosp_error, ONLY: errorMessage + implicit none + +contains + ! ########################################################################## + ! function PATH_INTEGRAL + ! ########################################################################## + function path_integral(f,s,i1,i2) + use m_mrgrnk + use array_lib + implicit none + ! ######################################################################## + ! Purpose: + ! evalues the integral (f ds) between f(index=i1) and f(index=i2) + ! using the AVINT procedure + ! + ! Inputs: + ! [f] functional values + ! [s] abscissa values + ! [i1] index of lower limit + ! [i2] index of upper limit + ! + ! Returns: + ! result of path integral + ! + ! Notes: + ! [s] may be in forward or reverse numerical order + ! + ! Requires: + ! mrgrnk package + ! + ! Created: + ! 02/02/06 John Haynes (haynes@atmos.colostate.edu) + ! ######################################################################## + + ! INPUTS + real(wp),intent(in), dimension(:) :: & + f, & ! Functional values + s ! Abscissa values + integer, intent(in) :: & + i1, & ! Index of lower limit + i2 ! Index of upper limit + + ! OUTPUTS + real(wp) :: path_integral + + ! Internal variables + real(wp) :: sumo, deltah, val + integer :: nelm, j + integer, dimension(i2-i1+1) :: idx + real(wp), dimension(i2-i1+1) :: f_rev, s_rev + + nelm = i2-i1+1 + if (nelm > 3) then + call mrgrnk(s(i1:i2),idx) + s_rev = s(idx) + f_rev = f(idx) + call avint(f_rev(i1:i2),s_rev(i1:i2),(i2-i1+1), & + s_rev(i1),s_rev(i2), val) + path_integral = val + else + sumo = 0._wp + do j=i1,i2 + deltah = abs(s(i1+1)-s(i1)) + sumo = sumo + f(j)*deltah + enddo + path_integral = sumo + endif + + return + end function path_integral + + ! ########################################################################## + ! subroutine AVINT + ! ########################################################################## + subroutine avint ( ftab, xtab, ntab, a_in, b_in, result ) + implicit none + ! ######################################################################## + ! Purpose: + ! estimate the integral of unevenly spaced data + ! + ! Inputs: + ! [ftab] functional values + ! [xtab] abscissa values + ! [ntab] number of elements of [ftab] and [xtab] + ! [a] lower limit of integration + ! [b] upper limit of integration + ! + ! Outputs: + ! [result] approximate value of integral + ! + ! Reference: + ! From SLATEC libraries, in public domain + ! + !*********************************************************************** + ! + ! AVINT estimates the integral of unevenly spaced data. + ! + ! Discussion: + ! + ! The method uses overlapping parabolas and smoothing. + ! + ! Modified: + ! + ! 30 October 2000 + ! 4 January 2008, A. Bodas-Salcedo. Error control for XTAB taken out of + ! loop to allow vectorization. + ! + ! Reference: + ! + ! Philip Davis and Philip Rabinowitz, + ! Methods of Numerical Integration, + ! Blaisdell Publishing, 1967. + ! + ! P E Hennion, + ! Algorithm 77, + ! Interpolation, Differentiation and Integration, + ! Communications of the Association for Computing Machinery, + ! Volume 5, page 96, 1962. + ! + ! Parameters: + ! + ! Input, real ( kind = 8 ) FTAB(NTAB), the function values, + ! FTAB(I) = F(XTAB(I)). + ! + ! Input, real ( kind = 8 ) XTAB(NTAB), the abscissas at which the + ! function values are given. The XTAB's must be distinct + ! and in ascending order. + ! + ! Input, integer NTAB, the number of entries in FTAB and + ! XTAB. NTAB must be at least 3. + ! + ! Input, real ( kind = 8 ) A, the lower limit of integration. A should + ! be, but need not be, near one endpoint of the interval + ! (X(1), X(NTAB)). + ! + ! Input, real ( kind = 8 ) B, the upper limit of integration. B should + ! be, but need not be, near one endpoint of the interval + ! (X(1), X(NTAB)). + ! + ! Output, real ( kind = 8 ) RESULT, the approximate value of the integral. + ! ########################################################################## + + ! INPUTS + integer,intent(in) :: & + ntab ! Number of elements of [ftab] and [xtab] + real(wp),intent(in) :: & + a_in, & ! Lower limit of integration + b_in ! Upper limit of integration + real(wp),intent(in),dimension(ntab) :: & + ftab, & ! Functional values + xtab ! Abscissa value + + ! OUTPUTS + real(wp),intent(out) :: result ! Approximate value of integral + + ! Internal varaibles + real(wp) :: a, atemp, b, btemp,ca,cb,cc,ctemp,sum1,syl,term1,term2,term3,x1,x2,x3 + integer :: i,ihi,ilo,ind + logical :: lerror + + lerror = .false. + a = a_in + b = b_in + + if ( ntab < 3 ) then + call errorMessage('FATAL ERROR(optics/math_lib.f90:AVINT): Ntab is less than 3.') + return + end if + + do i = 2, ntab + if ( xtab(i) <= xtab(i-1) ) then + lerror = .true. + exit + end if + end do + + if (lerror) then + call errorMessage('FATAL ERROR(optics/math_lib.f90:AVINT): Xtab(i) is not greater than Xtab(i-1).') + return + end if + +!ds result = 0.0D+00 + result = 0._wp + + if ( a == b ) then + call errorMessage('WARNING(optics/math_lib.f90:AVINT): A=B => integral=0') + return + end if + + ! If B < A, temporarily switch A and B, and store sign. + if ( b < a ) then + syl = b + b = a + a = syl + ind = -1 + else + syl = a + ind = 1 + end if + + ! Bracket A and B between XTAB(ILO) and XTAB(IHI). + ilo = 1 + ihi = ntab + + do i = 1, ntab + if ( a <= xtab(i) ) then + exit + end if + ilo = ilo + 1 + end do + + ilo = max ( 2, ilo ) + ilo = min ( ilo, ntab - 1 ) + + do i = 1, ntab + if ( xtab(i) <= b ) then + exit + end if + ihi = ihi - 1 + end do + + ihi = min ( ihi, ntab - 1 ) + ihi = max ( ilo, ihi - 1 ) + + ! Carry out approximate integration from XTAB(ILO) to XTAB(IHI). + sum1 = 0._wp +!ds sum1 = 0.0D+00 + + do i = ilo, ihi + + x1 = xtab(i-1) + x2 = xtab(i) + x3 = xtab(i+1) + + term1 = ftab(i-1) / ( ( x1 - x2 ) * ( x1 - x3 ) ) + term2 = ftab(i) / ( ( x2 - x1 ) * ( x2 - x3 ) ) + term3 = ftab(i+1) / ( ( x3 - x1 ) * ( x3 - x2 ) ) + + atemp = term1 + term2 + term3 + + btemp = - ( x2 + x3 ) * term1 & + - ( x1 + x3 ) * term2 & + - ( x1 + x2 ) * term3 + + ctemp = x2 * x3 * term1 + x1 * x3 * term2 + x1 * x2 * term3 + + if ( i <= ilo ) then + ca = atemp + cb = btemp + cc = ctemp + else + ca = 0.5_wp * ( atemp + ca ) + cb = 0.5_wp * ( btemp + cb ) + cc = 0.5_wp * ( ctemp + cc ) +!ds ca = 0.5D+00 * ( atemp + ca ) +!ds cb = 0.5D+00 * ( btemp + cb ) +!ds cc = 0.5D+00 * ( ctemp + cc ) + end if + + sum1 = sum1 + ca * ( x2**3 - syl**3 ) / 3._wp & + + cb * 0.5_wp * ( x2**2 - syl**2 ) + cc * ( x2 - syl ) +!ds sum1 = sum1 + ca * ( x2**3 - syl**3 ) / 3.0D+00 & +!ds + cb * 0.5D+00 * ( x2**2 - syl**2 ) + cc * ( x2 - syl ) + + ca = atemp + cb = btemp + cc = ctemp + + syl = x2 + + end do + + result = sum1 + ca * ( b**3 - syl**3 ) / 3._wp & + + cb * 0.5_wp * ( b**2 - syl**2 ) + cc * ( b - syl ) +!ds result = sum1 + ca * ( b**3 - syl**3 ) / 3.0D+00 & +!ds + cb * 0.5D+00 * ( b**2 - syl**2 ) + cc * ( b - syl ) + + ! Restore original values of A and B, reverse sign of integral + ! because of earlier switch. + if ( ind /= 1 ) then + ind = 1 + syl = b + b = a + a = syl + result = -result + end if + + return + end subroutine avint + ! ###################################################################################### + ! SUBROUTINE gamma + ! Purpose: + ! Returns the gamma function + ! + ! Input: + ! [x] value to compute gamma function of + ! + ! Returns: + ! gamma(x) + ! + ! Coded: + ! 02/02/06 John Haynes (haynes@atmos.colostate.edu) + ! (original code of unknown origin) + ! ###################################################################################### + function gamma(x) + ! Inputs + real(wp), intent(in) :: x + + ! Outputs + real(wp) :: gamma + + ! Local variables + real(wp) :: pi,ga,z,r,gr + integer :: k,m1,m + + ! Parameters + real(wp),dimension(26),parameter :: & + g = (/1.0,0.5772156649015329, -0.6558780715202538, -0.420026350340952e-1, & + 0.1665386113822915,-0.421977345555443e-1,-0.96219715278770e-2, & + 0.72189432466630e-2,-0.11651675918591e-2, -0.2152416741149e-3, & + 0.1280502823882e-3, -0.201348547807e-4, -0.12504934821e-5, 0.11330272320e-5, & + -0.2056338417e-6, 0.61160950e-8,0.50020075e-8, -0.11812746e-8, 0.1043427e-9, & + 0.77823e-11, -0.36968e-11, 0.51e-12, -0.206e-13, -0.54e-14, 0.14e-14, 0.1e-15/) +!ds real(wp),dimension(26),parameter :: & +!ds g = (/1.0d0,0.5772156649015329d0, -0.6558780715202538d0, -0.420026350340952d-1, & +!ds 0.1665386113822915d0,-0.421977345555443d-1,-0.96219715278770d-2, & +!ds 0.72189432466630d-2,-0.11651675918591d-2, -0.2152416741149d-3, & +!ds 0.1280502823882d-3, -0.201348547807d-4, -0.12504934821d-5, 0.11330272320d-5, & +!ds -0.2056338417d-6, 0.61160950d-8,0.50020075d-8, -0.11812746d-8, 0.1043427d-9, & +!ds 0.77823d-11, -0.36968d-11, 0.51d-12, -0.206d-13, -0.54d-14, 0.14d-14, 0.1d-15/) + + pi = acos(-1._wp) + if (x ==int(x)) then + if (x > 0.0) then + ga=1._wp + m1=x-1 + do k=2,m1 + ga=ga*k + enddo + else + ga=1._wp+300 + endif + else + if (abs(x) > 1.0) then + z=abs(x) + m=int(z) + r=1._wp + do k=1,m + r=r*(z-k) + enddo + z=z-m + else + z=x + endif + gr=g(26) + do k=25,1,-1 + gr=gr*z+g(k) + enddo + ga=1._wp/(gr*z) + if (abs(x) > 1.0) then + ga=ga*r + if (x < 0.0) ga=-pi/(x*ga*sin(pi*x)) + endif + endif + gamma = ga + return + end function gamma +end module math_lib diff --git a/src/physics/cosp2/optics/mrgrnk.F90 b/src/physics/cosp2/optics/mrgrnk.F90 new file mode 100644 index 0000000000..4913951819 --- /dev/null +++ b/src/physics/cosp2/optics/mrgrnk.F90 @@ -0,0 +1,645 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015: Dustin Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +Module m_mrgrnk + USE COSP_KINDS, ONLY: wp + Integer, Parameter :: kdp = selected_real_kind(15) + public :: mrgrnk + private :: kdp + private :: R_mrgrnk, I_mrgrnk, D_mrgrnk + + interface mrgrnk +! module procedure D_mrgrnk, R_mrgrnk, I_mrgrnk + module procedure R_mrgrnk, I_mrgrnk + + end interface +contains + + Subroutine D_mrgrnk (XDONT, IRNGT) + ! __________________________________________________________ + ! MRGRNK = Merge-sort ranking of an array + ! For performance reasons, the first 2 passes are taken + ! out of the standard loop, and use dedicated coding. + ! __________________________________________________________ + ! __________________________________________________________ + Real (wp), Dimension (:), Intent (In) :: XDONT + Integer, Dimension (:), Intent (Out) :: IRNGT + ! __________________________________________________________ + Real (wp) :: XVALA, XVALB + ! + Integer, Dimension (SIZE(IRNGT)) :: JWRKT + Integer :: LMTNA, LMTNC, IRNG1, IRNG2 + Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB + ! + NVAL = Min (SIZE(XDONT), SIZE(IRNGT)) + Select Case (NVAL) + Case (:0) + Return + Case (1) + IRNGT (1) = 1 + Return + Case Default + Continue + End Select + ! + ! Fill-in the index array, creating ordered couples + ! + Do IIND = 2, NVAL, 2 + If (XDONT(IIND-1) <= XDONT(IIND)) Then + IRNGT (IIND-1) = IIND - 1 + IRNGT (IIND) = IIND + Else + IRNGT (IIND-1) = IIND + IRNGT (IIND) = IIND - 1 + End If + End Do + If (Modulo(NVAL, 2) /= 0) Then + IRNGT (NVAL) = NVAL + End If + ! + ! We will now have ordered subsets A - B - A - B - ... + ! and merge A and B couples into C - C - ... + ! + LMTNA = 2 + LMTNC = 4 + ! + ! First iteration. The length of the ordered subsets goes from 2 to 4 + ! + Do + If (NVAL <= 2) Exit + ! + ! Loop on merges of A and B into C + ! + Do IWRKD = 0, NVAL - 1, 4 + If ((IWRKD+4) > NVAL) Then + If ((IWRKD+2) >= NVAL) Exit + ! + ! 1 2 3 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit + ! + ! 1 3 2 + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNG2 + ! + ! 3 1 2 + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNG1 + End If + Exit + End If + ! + ! 1 2 3 4 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle + ! + ! 1 3 x x + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 1 3 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 1 3 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + ! + ! 3 x x x + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then + IRNGT (IWRKD+2) = IRNG1 + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 3 1 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 3 1 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + Else + ! 3 4 1 2 + IRNGT (IWRKD+2) = IRNGT (IWRKD+4) + IRNGT (IWRKD+3) = IRNG1 + IRNGT (IWRKD+4) = IRNG2 + End If + End If + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 4 + Exit + End Do + ! + ! Iteration loop. Each time, the length of the ordered subsets + ! is doubled. + ! + Do + If (LMTNA >= NVAL) Exit + IWRKF = 0 + LMTNC = 2 * LMTNC + ! + ! Loop on merges of A and B into C + ! + Do + IWRK = IWRKF + IWRKD = IWRKF + 1 + JINDA = IWRKF + LMTNA + IWRKF = IWRKF + LMTNC + If (IWRKF >= NVAL) Then + If (JINDA >= NVAL) Exit + IWRKF = NVAL + End If + IINDA = 1 + IINDB = JINDA + 1 + ! + ! Shortcut for the case when the max of A is smaller + ! than the min of B. This line may be activated when the + ! initial set is already close to sorted. + ! + ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE + ! + ! One steps in the C subset, that we build in the final rank array + ! + ! Make a copy of the rank array for the merge iteration + ! + JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) + ! + XVALA = XDONT (JWRKT(IINDA)) + XVALB = XDONT (IRNGT(IINDB)) + ! + Do + IWRK = IWRK + 1 + ! + ! We still have unprocessed values in both A and B + ! + If (XVALA > XVALB) Then + IRNGT (IWRK) = IRNGT (IINDB) + IINDB = IINDB + 1 + If (IINDB > IWRKF) Then + ! Only A still with unprocessed values + IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) + Exit + End If + XVALB = XDONT (IRNGT(IINDB)) + Else + IRNGT (IWRK) = JWRKT (IINDA) + IINDA = IINDA + 1 + If (IINDA > LMTNA) Exit! Only B still with unprocessed values + XVALA = XDONT (JWRKT(IINDA)) + End If + ! + End Do + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 2 * LMTNA + End Do + ! + Return + ! + End Subroutine D_mrgrnk + + Subroutine R_mrgrnk (XDONT, IRNGT) + ! __________________________________________________________ + ! MRGRNK = Merge-sort ranking of an array + ! For performance reasons, the first 2 passes are taken + ! out of the standard loop, and use dedicated coding. + ! __________________________________________________________ + ! _________________________________________________________ + Real(wp), Dimension (:), Intent (In) :: XDONT + Integer, Dimension (:), Intent (Out) :: IRNGT + ! __________________________________________________________ + Real(wp) :: XVALA, XVALB + ! + Integer, Dimension (SIZE(IRNGT)) :: JWRKT + Integer :: LMTNA, LMTNC, IRNG1, IRNG2 + Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB + ! + NVAL = Min (SIZE(XDONT), SIZE(IRNGT)) + Select Case (NVAL) + Case (:0) + Return + Case (1) + IRNGT (1) = 1 + Return + Case Default + Continue + End Select + ! + ! Fill-in the index array, creating ordered couples + ! + Do IIND = 2, NVAL, 2 + If (XDONT(IIND-1) <= XDONT(IIND)) Then + IRNGT (IIND-1) = IIND - 1 + IRNGT (IIND) = IIND + Else + IRNGT (IIND-1) = IIND + IRNGT (IIND) = IIND - 1 + End If + End Do + If (Modulo(NVAL, 2) /= 0) Then + IRNGT (NVAL) = NVAL + End If + ! + ! We will now have ordered subsets A - B - A - B - ... + ! and merge A and B couples into C - C - ... + ! + LMTNA = 2 + LMTNC = 4 + ! + ! First iteration. The length of the ordered subsets goes from 2 to 4 + ! + Do + If (NVAL <= 2) Exit + ! + ! Loop on merges of A and B into C + ! + Do IWRKD = 0, NVAL - 1, 4 + If ((IWRKD+4) > NVAL) Then + If ((IWRKD+2) >= NVAL) Exit + ! + ! 1 2 3 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit + ! + ! 1 3 2 + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNG2 + ! + ! 3 1 2 + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNG1 + End If + Exit + End If + ! + ! 1 2 3 4 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle + ! + ! 1 3 x x + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 1 3 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 1 3 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + ! + ! 3 x x x + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then + IRNGT (IWRKD+2) = IRNG1 + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 3 1 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 3 1 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + Else + ! 3 4 1 2 + IRNGT (IWRKD+2) = IRNGT (IWRKD+4) + IRNGT (IWRKD+3) = IRNG1 + IRNGT (IWRKD+4) = IRNG2 + End If + End If + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 4 + Exit + End Do + ! + ! Iteration loop. Each time, the length of the ordered subsets + ! is doubled. + ! + Do + If (LMTNA >= NVAL) Exit + IWRKF = 0 + LMTNC = 2 * LMTNC + ! + ! Loop on merges of A and B into C + ! + Do + IWRK = IWRKF + IWRKD = IWRKF + 1 + JINDA = IWRKF + LMTNA + IWRKF = IWRKF + LMTNC + If (IWRKF >= NVAL) Then + If (JINDA >= NVAL) Exit + IWRKF = NVAL + End If + IINDA = 1 + IINDB = JINDA + 1 + ! + ! Shortcut for the case when the max of A is smaller + ! than the min of B. This line may be activated when the + ! initial set is already close to sorted. + ! + ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE + ! + ! One steps in the C subset, that we build in the final rank array + ! + ! Make a copy of the rank array for the merge iteration + ! + JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) + ! + XVALA = XDONT (JWRKT(IINDA)) + XVALB = XDONT (IRNGT(IINDB)) + ! + Do + IWRK = IWRK + 1 + ! + ! We still have unprocessed values in both A and B + ! + If (XVALA > XVALB) Then + IRNGT (IWRK) = IRNGT (IINDB) + IINDB = IINDB + 1 + If (IINDB > IWRKF) Then + ! Only A still with unprocessed values + IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) + Exit + End If + XVALB = XDONT (IRNGT(IINDB)) + Else + IRNGT (IWRK) = JWRKT (IINDA) + IINDA = IINDA + 1 + If (IINDA > LMTNA) Exit! Only B still with unprocessed values + XVALA = XDONT (JWRKT(IINDA)) + End If + ! + End Do + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 2 * LMTNA + End Do + ! + Return + ! + End Subroutine R_mrgrnk + Subroutine I_mrgrnk (XDONT, IRNGT) + ! __________________________________________________________ + ! MRGRNK = Merge-sort ranking of an array + ! For performance reasons, the first 2 passes are taken + ! out of the standard loop, and use dedicated coding. + ! __________________________________________________________ + ! __________________________________________________________ + Integer, Dimension (:), Intent (In) :: XDONT + Integer, Dimension (:), Intent (Out) :: IRNGT + ! __________________________________________________________ + Integer :: XVALA, XVALB + ! + Integer, Dimension (SIZE(IRNGT)) :: JWRKT + Integer :: LMTNA, LMTNC, IRNG1, IRNG2 + Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB + ! + NVAL = Min (SIZE(XDONT), SIZE(IRNGT)) + Select Case (NVAL) + Case (:0) + Return + Case (1) + IRNGT (1) = 1 + Return + Case Default + Continue + End Select + ! + ! Fill-in the index array, creating ordered couples + ! + Do IIND = 2, NVAL, 2 + If (XDONT(IIND-1) <= XDONT(IIND)) Then + IRNGT (IIND-1) = IIND - 1 + IRNGT (IIND) = IIND + Else + IRNGT (IIND-1) = IIND + IRNGT (IIND) = IIND - 1 + End If + End Do + If (Modulo(NVAL, 2) /= 0) Then + IRNGT (NVAL) = NVAL + End If + ! + ! We will now have ordered subsets A - B - A - B - ... + ! and merge A and B couples into C - C - ... + ! + LMTNA = 2 + LMTNC = 4 + ! + ! First iteration. The length of the ordered subsets goes from 2 to 4 + ! + Do + If (NVAL <= 2) Exit + ! + ! Loop on merges of A and B into C + ! + Do IWRKD = 0, NVAL - 1, 4 + If ((IWRKD+4) > NVAL) Then + If ((IWRKD+2) >= NVAL) Exit + ! + ! 1 2 3 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit + ! + ! 1 3 2 + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNG2 + ! + ! 3 1 2 + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + IRNGT (IWRKD+3) = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNG1 + End If + Exit + End If + ! + ! 1 2 3 4 + ! + If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle + ! + ! 1 3 x x + ! + If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+2) = IRNGT (IWRKD+3) + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 1 3 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 1 3 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + ! + ! 3 x x x + ! + Else + IRNG1 = IRNGT (IWRKD+1) + IRNG2 = IRNGT (IWRKD+2) + IRNGT (IWRKD+1) = IRNGT (IWRKD+3) + If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then + IRNGT (IWRKD+2) = IRNG1 + If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then + ! 3 1 2 4 + IRNGT (IWRKD+3) = IRNG2 + Else + ! 3 1 4 2 + IRNGT (IWRKD+3) = IRNGT (IWRKD+4) + IRNGT (IWRKD+4) = IRNG2 + End If + Else + ! 3 4 1 2 + IRNGT (IWRKD+2) = IRNGT (IWRKD+4) + IRNGT (IWRKD+3) = IRNG1 + IRNGT (IWRKD+4) = IRNG2 + End If + End If + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 4 + Exit + End Do + ! + ! Iteration loop. Each time, the length of the ordered subsets + ! is doubled. + ! + Do + If (LMTNA >= NVAL) Exit + IWRKF = 0 + LMTNC = 2 * LMTNC + ! + ! Loop on merges of A and B into C + ! + Do + IWRK = IWRKF + IWRKD = IWRKF + 1 + JINDA = IWRKF + LMTNA + IWRKF = IWRKF + LMTNC + If (IWRKF >= NVAL) Then + If (JINDA >= NVAL) Exit + IWRKF = NVAL + End If + IINDA = 1 + IINDB = JINDA + 1 + ! + ! Shortcut for the case when the max of A is smaller + ! than the min of B. This line may be activated when the + ! initial set is already close to sorted. + ! + ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE + ! + ! One steps in the C subset, that we build in the final rank array + ! + ! Make a copy of the rank array for the merge iteration + ! + JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) + ! + XVALA = XDONT (JWRKT(IINDA)) + XVALB = XDONT (IRNGT(IINDB)) + ! + Do + IWRK = IWRK + 1 + ! + ! We still have unprocessed values in both A and B + ! + If (XVALA > XVALB) Then + IRNGT (IWRK) = IRNGT (IINDB) + IINDB = IINDB + 1 + If (IINDB > IWRKF) Then + ! Only A still with unprocessed values + IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) + Exit + End If + XVALB = XDONT (IRNGT(IINDB)) + Else + IRNGT (IWRK) = JWRKT (IINDA) + IINDA = IINDA + 1 + If (IINDA > LMTNA) Exit! Only B still with unprocessed values + XVALA = XDONT (JWRKT(IINDA)) + End If + ! + End Do + End Do + ! + ! The Cs become As and Bs + ! + LMTNA = 2 * LMTNA + End Do + ! + Return + ! + End Subroutine I_mrgrnk +end module m_mrgrnk diff --git a/src/physics/cosp2/optics/optics_lib.F90 b/src/physics/cosp2/optics/optics_lib.F90 new file mode 100644 index 0000000000..0b1dfe17b3 --- /dev/null +++ b/src/physics/cosp2/optics/optics_lib.F90 @@ -0,0 +1,771 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! July 2006: John Haynes - Initial version +! May 2015: Dustin Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module optics_lib + USE COSP_KINDS, ONLY: wp + use mod_cosp_error, ONLY: errorMessage + implicit none + +contains + + ! ############################################################################## + ! subroutine M_WAT + ! ############################################################################## + subroutine m_wat(freq, tk, n_r, n_i) + ! ############################################################################ + ! + ! Purpose: + ! compute complex index of refraction of liquid water + ! + ! Inputs: + ! [freq] frequency (GHz) + ! [tk] temperature (K) + ! + ! Outputs: + ! [n_r] real part index of refraction + ! [n_i] imaginary part index of refraction + ! + ! Reference: + ! Based on the work of Ray (1972) + ! + ! Coded: + ! 03/22/05 John Haynes (haynes@atmos.colostate.edu) + ! ############################################################################ + + ! INPUTS + real(wp), intent(in) :: & + freq, & ! Frequency (GHz) + tk ! Temperature (K) + + ! OUTPUTS + real(wp), intent(out) :: & + n_r, & ! Real part of index of refraction + n_i ! Imaginary part of index of refraction + + ! Internal variables + real(wp) :: ld,es,ei,a,ls,sg,tm1,cos1,sin1,e_r,e_i,pi,tc + complex(wp) :: e_comp, sq + + tc = tk - 273.15_wp + + ld = 100._wp*2.99792458E8_wp/(freq*1E9_wp) + es = 78.54_wp*(1-(4.579E-3_wp*(tc-25._wp)+1.19E-5_wp*(tc-25._wp)**2 & + -2.8E-8_wp*(tc-25._wp)**3)) + ei = 5.27137_wp+0.021647_wp*tc-0.00131198_wp*tc**2 + a = -(16.8129_wp/(tc+273._wp))+0.0609265_wp + ls = 0.00033836_wp*exp(2513.98_wp/(tc+273._wp)) + sg = 12.5664E8_wp + + tm1 = (ls/ld)**(1-a) + pi = acos(-1._wp) + cos1 = cos(0.5_wp*a*pi) + sin1 = sin(0.5_wp*a*pi) + + e_r = ei + (((es-ei)*(1.+tm1*sin1))/(1._wp+2*tm1*sin1+tm1**2)) + e_i = (((es-ei)*tm1*cos1)/(1._wp+2*tm1*sin1+tm1**2)) & + +((sg*ld)/1.885E11_wp) + +!ds e_comp = cmplx(e_r,e_i,Kind=Kind(0d0)) + e_comp = cmplx(e_r,e_i,Kind=wp) + sq = sqrt(e_comp) + + n_r = real(sq) + n_i = aimag(sq) + + return + end subroutine m_wat + + ! ############################################################################ + ! subroutine M_ICE + ! ############################################################################ + subroutine m_ice(freq,t,n_r,n_i) + ! ########################################################################## + ! + ! Purpose: + ! compute complex index of refraction of ice + ! + ! Inputs: + ! [freq] frequency (GHz) + ! [t] temperature (K) + ! + ! Outputs: + ! [n_r] real part index of refraction + ! [n_i] imaginary part index of refraction + ! + ! Reference: + ! Fortran 90 port from IDL of REFICE by Stephen G. Warren + ! + ! Modified: + ! 05/31/05 John Haynes (haynes@atmos.colostate.edu) + ! ########################################################################## + + ! INPUTS + real(wp), intent(in) :: & + freq, & ! Frequency (GHz) + t ! Temperature (K) + + ! OUTPUTS + real(wp), intent(out) :: & + n_r, & ! Real part of index of refraction + n_i ! Imaginary part of index of refraction + + ! Internal variables + integer :: i,lt1,lt2 + real(wp) :: alam,pi,t1,t2, & + x,x1,x2,y,y1,y2,ylo,yhi,tk + + + ! Parameters: + integer,parameter :: & + nwl = 468, & ! + nwlt = 62 ! + real(wp),parameter,dimension(4) :: & + temref = [272.16,268.16,253.16,213.16] + real(wp),parameter :: & ! + wlmin = 0.045, & ! + wlmax = 8.6e6, & ! + cutice = 167.0 + real(wp),parameter,dimension(nwlt) :: & + wlt = & + [0.1670e+03, 0.1778e+03, 0.1884e+03, 0.1995e+03, 0.2113e+03, 0.2239e+03, & + 0.2371e+03, 0.2512e+03, 0.2661e+03, 0.2818e+03, 0.2985e+03, 0.3162e+03, & + 0.3548e+03, 0.3981e+03, 0.4467e+03, 0.5012e+03, 0.5623e+03, 0.6310e+03, & + 0.7943e+03, 0.1000e+04, 0.1259e+04, 0.2500e+04, 0.5000e+04, 0.1000e+05, & + 0.2000e+05, 0.3200e+05, 0.3500e+05, 0.4000e+05, 0.4500e+05, 0.5000e+05, & + 0.6000e+05, 0.7000e+05, 0.9000e+05, 0.1110e+06, 0.1200e+06, 0.1300e+06, & + 0.1400e+06, 0.1500e+06, 0.1600e+06, 0.1700e+06, 0.1800e+06, 0.2000e+06, & + 0.2500e+06, 0.2900e+06, 0.3200e+06, 0.3500e+06, 0.3800e+06, 0.4000e+06, & + 0.4500e+06, 0.5000e+06, 0.6000e+06, 0.6400e+06, 0.6800e+06, 0.7200e+06, & + 0.7600e+06, 0.8000e+06, 0.8400e+06, 0.9000e+06, 0.1000e+07, 0.2000e+07, & + 0.5000e+07,0.8600e+07] + real(wp),parameter,dimension(nwl) :: & + tabim = & + [0.1640e+00, 0.1730e+00, 0.1830e+00, 0.1950e+00, 0.2080e+00, 0.2230e+00, & + 0.2400e+00, 0.2500e+00, 0.2590e+00, 0.2680e+00, 0.2790e+00, 0.2970e+00, & + 0.3190e+00, 0.3400e+00, 0.3660e+00, 0.3920e+00, 0.4160e+00, 0.4400e+00, & + 0.4640e+00, 0.4920e+00, 0.5170e+00, 0.5280e+00, 0.5330e+00, 0.5340e+00, & + 0.5310e+00, 0.5240e+00, 0.5100e+00, 0.5000e+00, 0.4990e+00, 0.4680e+00, & + 0.3800e+00, 0.3600e+00, 0.3390e+00, 0.3180e+00, 0.2910e+00, 0.2510e+00, & + 0.2440e+00, 0.2390e+00, 0.2390e+00, 0.2440e+00, 0.2470e+00, 0.2240e+00, & + 0.1950e+00, 0.1740e+00, 0.1720e+00, 0.1800e+00, 0.1940e+00, 0.2130e+00, & + 0.2430e+00, 0.2710e+00, 0.2890e+00, 0.3340e+00, 0.3440e+00, 0.3820e+00, & + 0.4010e+00, 0.4065e+00, 0.4050e+00, 0.3890e+00, 0.3770e+00, 0.3450e+00, & + 0.3320e+00, 0.3150e+00, 0.2980e+00, 0.2740e+00, 0.2280e+00, 0.1980e+00, & + 0.1720e+00, 0.1560e+00, 0.1100e+00, 0.8300e-01, 0.5800e-01, 0.2200e-01, & + 0.1000e-01, 0.3000e-02, 0.1000e-02, 0.3000e-03, 0.1000e-03, 0.3000e-04, & + 0.1000e-04, 0.3000e-05, 0.1000e-05, 0.7000e-06, 0.4000e-06, 0.2000e-06, & + 0.1000e-06, 0.6377e-07, 0.3750e-07, 0.2800e-07, 0.2400e-07, 0.2200e-07, & + 0.1900e-07, 0.1750e-07, 0.1640e-07, 0.1590e-07, 0.1325e-07, 0.8623e-08, & + 0.5504e-08, 0.3765e-08, 0.2710e-08, 0.2510e-08, 0.2260e-08, 0.2080e-08, & + 0.1910e-08, 0.1540e-08, 0.1530e-08, 0.1550e-08, 0.1640e-08, 0.1780e-08, & + 0.1910e-08, 0.2140e-08, 0.2260e-08, 0.2540e-08, 0.2930e-08, 0.3110e-08, & + 0.3290e-08, 0.3520e-08, 0.4040e-08, 0.4880e-08, 0.5730e-08, 0.6890e-08, & + 0.8580e-08, 0.1040e-07, 0.1220e-07, 0.1430e-07, 0.1660e-07, 0.1890e-07, & + 0.2090e-07, 0.2400e-07, 0.2900e-07, 0.3440e-07, 0.4030e-07, 0.4300e-07, & + 0.4920e-07, 0.5870e-07, 0.7080e-07, 0.8580e-07, 0.1020e-06, 0.1180e-06, & + 0.1340e-06, 0.1400e-06, 0.1430e-06, 0.1450e-06, 0.1510e-06, 0.1830e-06, & + 0.2150e-06, 0.2650e-06, 0.3350e-06, 0.3920e-06, 0.4200e-06, 0.4440e-06, & + 0.4740e-06, 0.5110e-06, 0.5530e-06, 0.6020e-06, 0.7550e-06, 0.9260e-06, & + 0.1120e-05, 0.1330e-05, 0.1620e-05, 0.2000e-05, 0.2250e-05, 0.2330e-05, & + 0.2330e-05, 0.2170e-05, 0.1960e-05, 0.1810e-05, 0.1740e-05, 0.1730e-05, & + 0.1700e-05, 0.1760e-05, 0.1820e-05, 0.2040e-05, 0.2250e-05, 0.2290e-05, & + 0.3040e-05, 0.3840e-05, 0.4770e-05, 0.5760e-05, 0.6710e-05, 0.8660e-05, & + 0.1020e-04, 0.1130e-04, 0.1220e-04, 0.1290e-04, 0.1320e-04, 0.1350e-04, & + 0.1330e-04, 0.1320e-04, 0.1320e-04, 0.1310e-04, 0.1320e-04, 0.1320e-04, & + 0.1340e-04, 0.1390e-04, 0.1420e-04, 0.1480e-04, 0.1580e-04, 0.1740e-04, & + 0.1980e-04, 0.2500e-04, 0.5400e-04, 0.1040e-03, 0.2030e-03, 0.2708e-03, & + 0.3511e-03, 0.4299e-03, 0.5181e-03, 0.5855e-03, 0.5899e-03, 0.5635e-03, & + 0.5480e-03, 0.5266e-03, 0.4394e-03, 0.3701e-03, 0.3372e-03, 0.2410e-03, & + 0.1890e-03, 0.1660e-03, 0.1450e-03, 0.1280e-03, 0.1030e-03, 0.8600e-04, & + 0.8220e-04, 0.8030e-04, 0.8500e-04, 0.9900e-04, 0.1500e-03, 0.2950e-03, & + 0.4687e-03, 0.7615e-03, 0.1010e-02, 0.1313e-02, 0.1539e-02, 0.1588e-02, & + 0.1540e-02, 0.1412e-02, 0.1244e-02, 0.1068e-02, 0.8414e-03, 0.5650e-03, & + 0.4320e-03, 0.3500e-03, 0.2870e-03, 0.2210e-03, 0.2030e-03, 0.2010e-03, & + 0.2030e-03, 0.2140e-03, 0.2320e-03, 0.2890e-03, 0.3810e-03, 0.4620e-03, & + 0.5480e-03, 0.6180e-03, 0.6800e-03, 0.7300e-03, 0.7820e-03, 0.8480e-03, & + 0.9250e-03, 0.9200e-03, 0.8920e-03, 0.8700e-03, 0.8900e-03, 0.9300e-03, & + 0.1010e-02, 0.1350e-02, 0.3420e-02, 0.7920e-02, 0.2000e-01, 0.3800e-01, & + 0.5200e-01, 0.6800e-01, 0.9230e-01, 0.1270e+00, 0.1690e+00, 0.2210e+00, & + 0.2760e+00, 0.3120e+00, 0.3470e+00, 0.3880e+00, 0.4380e+00, 0.4930e+00, & + 0.5540e+00, 0.6120e+00, 0.6250e+00, 0.5930e+00, 0.5390e+00, 0.4910e+00, & + 0.4380e+00, 0.3720e+00, 0.3000e+00, 0.2380e+00, 0.1930e+00, 0.1580e+00, & + 0.1210e+00, 0.1030e+00, 0.8360e-01, 0.6680e-01, 0.5400e-01, 0.4220e-01, & + 0.3420e-01, 0.2740e-01, 0.2200e-01, 0.1860e-01, 0.1520e-01, 0.1260e-01, & + 0.1060e-01, 0.8020e-02, 0.6850e-02, 0.6600e-02, 0.6960e-02, 0.9160e-02, & + 0.1110e-01, 0.1450e-01, 0.2000e-01, 0.2300e-01, 0.2600e-01, 0.2900e-01, & + 0.2930e-01, 0.3000e-01, 0.2850e-01, 0.1730e-01, 0.1290e-01, 0.1200e-01, & + 0.1250e-01, 0.1340e-01, 0.1400e-01, 0.1750e-01, 0.2400e-01, 0.3500e-01, & + 0.3800e-01, 0.4200e-01, 0.4600e-01, 0.5200e-01, 0.5700e-01, 0.6900e-01, & + 0.7000e-01, 0.6700e-01, 0.6500e-01, 0.6400e-01, 0.6200e-01, 0.5900e-01, & + 0.5700e-01, 0.5600e-01, 0.5500e-01, 0.5700e-01, 0.5800e-01, 0.5700e-01, & + 0.5500e-01, 0.5500e-01, 0.5400e-01, 0.5200e-01, 0.5200e-01, 0.5200e-01, & + 0.5200e-01, 0.5000e-01, 0.4700e-01, 0.4300e-01, 0.3900e-01, 0.3700e-01, & + 0.3900e-01, 0.4000e-01, 0.4200e-01, 0.4400e-01, 0.4500e-01, 0.4600e-01, & + 0.4700e-01, 0.5100e-01, 0.6500e-01, 0.7500e-01, 0.8800e-01, 0.1080e+00, & + 0.1340e+00, 0.1680e+00, 0.2040e+00, 0.2480e+00, 0.2800e+00, 0.3410e+00, & + 0.3790e+00, 0.4090e+00, 0.4220e+00, 0.4220e+00, 0.4030e+00, 0.3890e+00, & + 0.3740e+00, 0.3540e+00, 0.3350e+00, 0.3150e+00, 0.2940e+00, 0.2710e+00, & + 0.2460e+00, 0.1980e+00, 0.1640e+00, 0.1520e+00, 0.1420e+00, 0.1280e+00, & + 0.1250e+00, 0.1230e+00, 0.1160e+00, 0.1070e+00, 0.7900e-01, 0.7200e-01, & + 0.7600e-01, 0.7500e-01, 0.6700e-01, 0.5500e-01, 0.4500e-01, 0.2900e-01, & + 0.2750e-01, 0.2700e-01, 0.2730e-01, 0.2890e-01, 0.3000e-01, 0.3400e-01, & + 0.5300e-01, 0.7550e-01, 0.1060e+00, 0.1350e+00, 0.1761e+00, 0.2229e+00, & + 0.2746e+00, 0.3280e+00, 0.3906e+00, 0.4642e+00, 0.5247e+00, 0.5731e+00, & + 0.6362e+00, 0.6839e+00, 0.7091e+00, 0.6790e+00, 0.6250e+00, 0.5654e+00, & + 0.5433e+00, 0.5292e+00, 0.5070e+00, 0.4883e+00, 0.4707e+00, 0.4203e+00, & + 0.3771e+00, 0.3376e+00, 0.3056e+00, 0.2835e+00, 0.3170e+00, 0.3517e+00, & + 0.3902e+00, 0.4509e+00, 0.4671e+00, 0.4779e+00, 0.4890e+00, 0.4899e+00, & + 0.4873e+00, 0.4766e+00, 0.4508e+00, 0.4193e+00, 0.3880e+00, 0.3433e+00, & + 0.3118e+00, 0.2935e+00, 0.2350e+00, 0.1981e+00, 0.1865e+00, 0.1771e+00, & + 0.1620e+00, 0.1490e+00, 0.1390e+00, 0.1200e+00, 0.9620e-01, 0.8300e-01] + real(wp),parameter,dimension(nwl) :: & + wl = & + [0.4430e-01, 0.4510e-01, 0.4590e-01, 0.4680e-01, 0.4770e-01, 0.4860e-01, & + 0.4960e-01, 0.5060e-01, 0.5170e-01, 0.5280e-01, 0.5390e-01, 0.5510e-01, & + 0.5640e-01, 0.5770e-01, 0.5900e-01, 0.6050e-01, 0.6200e-01, 0.6360e-01, & + 0.6530e-01, 0.6700e-01, 0.6890e-01, 0.7080e-01, 0.7290e-01, 0.7380e-01, & + 0.7510e-01, 0.7750e-01, 0.8000e-01, 0.8270e-01, 0.8550e-01, 0.8860e-01, & + 0.9180e-01, 0.9300e-01, 0.9540e-01, 0.9920e-01, 0.1033e+00, 0.1078e+00, & + 0.1100e+00, 0.1127e+00, 0.1140e+00, 0.1181e+00, 0.1210e+00, 0.1240e+00, & + 0.1272e+00, 0.1295e+00, 0.1305e+00, 0.1319e+00, 0.1333e+00, 0.1348e+00, & + 0.1362e+00, 0.1370e+00, 0.1378e+00, 0.1387e+00, 0.1393e+00, 0.1409e+00, & + 0.1425e+00, 0.1435e+00, 0.1442e+00, 0.1450e+00, 0.1459e+00, 0.1468e+00, & + 0.1476e+00, 0.1480e+00, 0.1485e+00, 0.1494e+00, 0.1512e+00, 0.1531e+00, & + 0.1540e+00, 0.1550e+00, 0.1569e+00, 0.1580e+00, 0.1589e+00, 0.1610e+00, & + 0.1625e+00, 0.1648e+00, 0.1669e+00, 0.1692e+00, 0.1713e+00, 0.1737e+00, & + 0.1757e+00, 0.1779e+00, 0.1802e+00, 0.1809e+00, 0.1821e+00, 0.1833e+00, & + 0.1843e+00, 0.1850e+00, 0.1860e+00, 0.1870e+00, 0.1880e+00, 0.1890e+00, & + 0.1900e+00, 0.1910e+00, 0.1930e+00, 0.1950e+00, 0.2100e+00, 0.2500e+00, & + 0.3000e+00, 0.3500e+00, 0.4000e+00, 0.4100e+00, 0.4200e+00, 0.4300e+00, & + 0.4400e+00, 0.4500e+00, 0.4600e+00, 0.4700e+00, 0.4800e+00, 0.4900e+00, & + 0.5000e+00, 0.5100e+00, 0.5200e+00, 0.5300e+00, 0.5400e+00, 0.5500e+00, & + 0.5600e+00, 0.5700e+00, 0.5800e+00, 0.5900e+00, 0.6000e+00, 0.6100e+00, & + 0.6200e+00, 0.6300e+00, 0.6400e+00, 0.6500e+00, 0.6600e+00, 0.6700e+00, & + 0.6800e+00, 0.6900e+00, 0.7000e+00, 0.7100e+00, 0.7200e+00, 0.7300e+00, & + 0.7400e+00, 0.7500e+00, 0.7600e+00, 0.7700e+00, 0.7800e+00, 0.7900e+00, & + 0.8000e+00, 0.8100e+00, 0.8200e+00, 0.8300e+00, 0.8400e+00, 0.8500e+00, & + 0.8600e+00, 0.8700e+00, 0.8800e+00, 0.8900e+00, 0.9000e+00, 0.9100e+00, & + 0.9200e+00, 0.9300e+00, 0.9400e+00, 0.9500e+00, 0.9600e+00, 0.9700e+00, & + 0.9800e+00, 0.9900e+00, 0.1000e+01, 0.1010e+01, 0.1020e+01, 0.1030e+01, & + 0.1040e+01, 0.1050e+01, 0.1060e+01, 0.1070e+01, 0.1080e+01, 0.1090e+01, & + 0.1100e+01, 0.1110e+01, 0.1120e+01, 0.1130e+01, 0.1140e+01, 0.1150e+01, & + 0.1160e+01, 0.1170e+01, 0.1180e+01, 0.1190e+01, 0.1200e+01, 0.1210e+01, & + 0.1220e+01, 0.1230e+01, 0.1240e+01, 0.1250e+01, 0.1260e+01, 0.1270e+01, & + 0.1280e+01, 0.1290e+01, 0.1300e+01, 0.1310e+01, 0.1320e+01, 0.1330e+01, & + 0.1340e+01, 0.1350e+01, 0.1360e+01, 0.1370e+01, 0.1380e+01, 0.1390e+01, & + 0.1400e+01, 0.1410e+01, 0.1420e+01, 0.1430e+01, 0.1440e+01, 0.1449e+01, & + 0.1460e+01, 0.1471e+01, 0.1481e+01, 0.1493e+01, 0.1504e+01, 0.1515e+01, & + 0.1527e+01, 0.1538e+01, 0.1563e+01, 0.1587e+01, 0.1613e+01, 0.1650e+01, & + 0.1680e+01, 0.1700e+01, 0.1730e+01, 0.1760e+01, 0.1800e+01, 0.1830e+01, & + 0.1840e+01, 0.1850e+01, 0.1855e+01, 0.1860e+01, 0.1870e+01, 0.1890e+01, & + 0.1905e+01, 0.1923e+01, 0.1942e+01, 0.1961e+01, 0.1980e+01, 0.2000e+01, & + 0.2020e+01, 0.2041e+01, 0.2062e+01, 0.2083e+01, 0.2105e+01, 0.2130e+01, & + 0.2150e+01, 0.2170e+01, 0.2190e+01, 0.2220e+01, 0.2240e+01, 0.2245e+01, & + 0.2250e+01, 0.2260e+01, 0.2270e+01, 0.2290e+01, 0.2310e+01, 0.2330e+01, & + 0.2350e+01, 0.2370e+01, 0.2390e+01, 0.2410e+01, 0.2430e+01, 0.2460e+01, & + 0.2500e+01, 0.2520e+01, 0.2550e+01, 0.2565e+01, 0.2580e+01, 0.2590e+01, & + 0.2600e+01, 0.2620e+01, 0.2675e+01, 0.2725e+01, 0.2778e+01, 0.2817e+01, & + 0.2833e+01, 0.2849e+01, 0.2865e+01, 0.2882e+01, 0.2899e+01, 0.2915e+01, & + 0.2933e+01, 0.2950e+01, 0.2967e+01, 0.2985e+01, 0.3003e+01, 0.3021e+01, & + 0.3040e+01, 0.3058e+01, 0.3077e+01, 0.3096e+01, 0.3115e+01, 0.3135e+01, & + 0.3155e+01, 0.3175e+01, 0.3195e+01, 0.3215e+01, 0.3236e+01, 0.3257e+01, & + 0.3279e+01, 0.3300e+01, 0.3322e+01, 0.3345e+01, 0.3367e+01, 0.3390e+01, & + 0.3413e+01, 0.3436e+01, 0.3460e+01, 0.3484e+01, 0.3509e+01, 0.3534e+01, & + 0.3559e+01, 0.3624e+01, 0.3732e+01, 0.3775e+01, 0.3847e+01, 0.3969e+01, & + 0.4099e+01, 0.4239e+01, 0.4348e+01, 0.4387e+01, 0.4444e+01, 0.4505e+01, & + 0.4547e+01, 0.4560e+01, 0.4580e+01, 0.4719e+01, 0.4904e+01, 0.5000e+01, & + 0.5100e+01, 0.5200e+01, 0.5263e+01, 0.5400e+01, 0.5556e+01, 0.5714e+01, & + 0.5747e+01, 0.5780e+01, 0.5814e+01, 0.5848e+01, 0.5882e+01, 0.6061e+01, & + 0.6135e+01, 0.6250e+01, 0.6289e+01, 0.6329e+01, 0.6369e+01, 0.6410e+01, & + 0.6452e+01, 0.6494e+01, 0.6579e+01, 0.6667e+01, 0.6757e+01, 0.6897e+01, & + 0.7042e+01, 0.7143e+01, 0.7246e+01, 0.7353e+01, 0.7463e+01, 0.7576e+01, & + 0.7692e+01, 0.7812e+01, 0.7937e+01, 0.8065e+01, 0.8197e+01, 0.8333e+01, & + 0.8475e+01, 0.8696e+01, 0.8929e+01, 0.9091e+01, 0.9259e+01, 0.9524e+01, & + 0.9804e+01, 0.1000e+02, 0.1020e+02, 0.1031e+02, 0.1042e+02, 0.1053e+02, & + 0.1064e+02, 0.1075e+02, 0.1087e+02, 0.1100e+02, 0.1111e+02, 0.1136e+02, & + 0.1163e+02, 0.1190e+02, 0.1220e+02, 0.1250e+02, 0.1282e+02, 0.1299e+02, & + 0.1316e+02, 0.1333e+02, 0.1351e+02, 0.1370e+02, 0.1389e+02, 0.1408e+02, & + 0.1429e+02, 0.1471e+02, 0.1515e+02, 0.1538e+02, 0.1563e+02, 0.1613e+02, & + 0.1639e+02, 0.1667e+02, 0.1695e+02, 0.1724e+02, 0.1818e+02, 0.1887e+02, & + 0.1923e+02, 0.1961e+02, 0.2000e+02, 0.2041e+02, 0.2083e+02, 0.2222e+02, & + 0.2260e+02, 0.2305e+02, 0.2360e+02, 0.2460e+02, 0.2500e+02, 0.2600e+02, & + 0.2857e+02, 0.3100e+02, 0.3333e+02, 0.3448e+02, 0.3564e+02, 0.3700e+02, & + 0.3824e+02, 0.3960e+02, 0.4114e+02, 0.4276e+02, 0.4358e+02, 0.4458e+02, & + 0.4550e+02, 0.4615e+02, 0.4671e+02, 0.4736e+02, 0.4800e+02, 0.4878e+02, & + 0.5003e+02, 0.5128e+02, 0.5275e+02, 0.5350e+02, 0.5424e+02, 0.5500e+02, & + 0.5574e+02, 0.5640e+02, 0.5700e+02, 0.5746e+02, 0.5840e+02, 0.5929e+02, & + 0.6000e+02, 0.6100e+02, 0.6125e+02, 0.6250e+02, 0.6378e+02, 0.6467e+02, & + 0.6558e+02, 0.6655e+02, 0.6760e+02, 0.6900e+02, 0.7053e+02, 0.7300e+02, & + 0.7500e+02, 0.7629e+02, 0.8000e+02, 0.8297e+02, 0.8500e+02, 0.8680e+02, & + 0.9080e+02, 0.9517e+02, 0.1000e+03, 0.1200e+03, 0.1500e+03, 0.1670e+03] + real(wp),parameter,dimension(nwlt,4) :: & + tabimt = reshape(source= & + (/0.8300e-01, 0.6900e-01, 0.5700e-01, 0.4560e-01, 0.3790e-01, 0.3140e-01, & + 0.2620e-01, 0.2240e-01, 0.1960e-01, 0.1760e-01, 0.1665e-01, 0.1620e-01, & + 0.1550e-01, 0.1470e-01, 0.1390e-01, 0.1320e-01, 0.1250e-01, 0.1180e-01, & + 0.1060e-01, 0.9540e-02, 0.8560e-02, 0.6210e-02, 0.4490e-02, 0.3240e-02, & + 0.2340e-02, 0.1880e-02, 0.1740e-02, 0.1500e-02, 0.1320e-02, 0.1160e-02, & + 0.8800e-03, 0.6950e-03, 0.4640e-03, 0.3400e-03, 0.3110e-03, 0.2940e-03, & + 0.2790e-03, 0.2700e-03, 0.2640e-03, 0.2580e-03, 0.2520e-03, 0.2490e-03, & + 0.2540e-03, 0.2640e-03, 0.2740e-03, 0.2890e-03, 0.3050e-03, 0.3150e-03, & + 0.3460e-03, 0.3820e-03, 0.4620e-03, 0.5000e-03, 0.5500e-03, 0.5950e-03, & + 0.6470e-03, 0.6920e-03, 0.7420e-03, 0.8200e-03, 0.9700e-03, 0.1950e-02, & + 0.5780e-02, 0.9700e-02, 0.8300e-01, 0.6900e-01, 0.5700e-01, 0.4560e-01, & + 0.3790e-01, 0.3140e-01, 0.2620e-01, 0.2240e-01, 0.1960e-01, 0.1760e-01, & + 0.1665e-01, 0.1600e-01, 0.1500e-01, 0.1400e-01, 0.1310e-01, 0.1230e-01, & + 0.1150e-01, 0.1080e-01, 0.9460e-02, 0.8290e-02, 0.7270e-02, 0.4910e-02, & + 0.3300e-02, 0.2220e-02, 0.1490e-02, 0.1140e-02, 0.1060e-02, 0.9480e-03, & + 0.8500e-03, 0.7660e-03, 0.6300e-03, 0.5200e-03, 0.3840e-03, 0.2960e-03, & + 0.2700e-03, 0.2520e-03, 0.2440e-03, 0.2360e-03, 0.2300e-03, 0.2280e-03, & + 0.2250e-03, 0.2200e-03, 0.2160e-03, 0.2170e-03, 0.2200e-03, 0.2250e-03, & + 0.2320e-03, 0.2390e-03, 0.2600e-03, 0.2860e-03, 0.3560e-03, 0.3830e-03, & + 0.4150e-03, 0.4450e-03, 0.4760e-03, 0.5080e-03, 0.5400e-03, 0.5860e-03, & + 0.6780e-03, 0.1280e-02, 0.3550e-02, 0.5600e-02, 0.8300e-01, 0.6900e-01, & + 0.5700e-01, 0.4560e-01, 0.3790e-01, 0.3140e-01, 0.2620e-01, 0.2190e-01, & + 0.1880e-01, 0.1660e-01, 0.1540e-01, 0.1470e-01, 0.1350e-01, 0.1250e-01, & + 0.1150e-01, 0.1060e-01, 0.9770e-02, 0.9010e-02, 0.7660e-02, 0.6520e-02, & + 0.5540e-02, 0.3420e-02, 0.2100e-02, 0.1290e-02, 0.7930e-03, 0.5700e-03, & + 0.5350e-03, 0.4820e-03, 0.4380e-03, 0.4080e-03, 0.3500e-03, 0.3200e-03, & + 0.2550e-03, 0.2120e-03, 0.2000e-03, 0.1860e-03, 0.1750e-03, 0.1660e-03, & + 0.1560e-03, 0.1490e-03, 0.1440e-03, 0.1350e-03, 0.1210e-03, 0.1160e-03, & + 0.1160e-03, 0.1170e-03, 0.1200e-03, 0.1230e-03, 0.1320e-03, 0.1440e-03, & + 0.1680e-03, 0.1800e-03, 0.1900e-03, 0.2090e-03, 0.2160e-03, 0.2290e-03, & + 0.2400e-03, 0.2600e-03, 0.2920e-03, 0.6100e-03, 0.1020e-02, 0.1810e-02, & + 0.8300e-01, 0.6900e-01, 0.5700e-01, 0.4450e-01, 0.3550e-01, 0.2910e-01, & + 0.2440e-01, 0.1970e-01, 0.1670e-01, 0.1400e-01, 0.1235e-01, 0.1080e-01, & + 0.8900e-02, 0.7340e-02, 0.6400e-02, 0.5600e-02, 0.5000e-02, 0.4520e-02, & + 0.3680e-02, 0.2990e-02, 0.2490e-02, 0.1550e-02, 0.9610e-03, 0.5950e-03, & + 0.3690e-03, 0.2670e-03, 0.2510e-03, 0.2290e-03, 0.2110e-03, 0.1960e-03, & + 0.1730e-03, 0.1550e-03, 0.1310e-03, 0.1130e-03, 0.1060e-03, 0.9900e-04, & + 0.9300e-04, 0.8730e-04, 0.8300e-04, 0.7870e-04, 0.7500e-04, 0.6830e-04, & + 0.5600e-04, 0.4960e-04, 0.4550e-04, 0.4210e-04, 0.3910e-04, 0.3760e-04, & + 0.3400e-04, 0.3100e-04, 0.2640e-04, 0.2510e-04, 0.2430e-04, 0.2390e-04, & + 0.2370e-04, 0.2380e-04, 0.2400e-04, 0.2460e-04, 0.2660e-04, 0.4450e-04, & + 0.8700e-04, 0.1320e-03/),shape=(/nwlt,4/)) + + real(wp),parameter,dimension(nwl) :: & + tabre = & + [0.83441, 0.83676, 0.83729, 0.83771, 0.83827, 0.84038, & + 0.84719, 0.85522, 0.86047, 0.86248, 0.86157, 0.86093, & + 0.86419, 0.86916, 0.87764, 0.89296, 0.91041, 0.93089, & + 0.95373, 0.98188, 1.02334, 1.06735, 1.11197, 1.13134, & + 1.15747, 1.20045, 1.23840, 1.27325, 1.32157, 1.38958, & + 1.41644, 1.40906, 1.40063, 1.40169, 1.40934, 1.40221, & + 1.39240, 1.38424, 1.38075, 1.38186, 1.39634, 1.40918, & + 1.40256, 1.38013, 1.36303, 1.34144, 1.32377, 1.30605, & + 1.29054, 1.28890, 1.28931, 1.30190, 1.32025, 1.36302, & + 1.41872, 1.45834, 1.49028, 1.52128, 1.55376, 1.57782, & + 1.59636, 1.60652, 1.61172, 1.61919, 1.62522, 1.63404, & + 1.63689, 1.63833, 1.63720, 1.63233, 1.62222, 1.58269, & + 1.55635, 1.52453, 1.50320, 1.48498, 1.47226, 1.45991, & + 1.45115, 1.44272, 1.43498, 1.43280, 1.42924, 1.42602, & + 1.42323, 1.42143, 1.41897, 1.41660, 1.41434, 1.41216, & + 1.41006, 1.40805, 1.40423, 1.40067, 1.38004, 1.35085, & + 1.33394, 1.32492, 1.31940, 1.31854, 1.31775, 1.31702, & + 1.31633, 1.31569, 1.31509, 1.31452, 1.31399, 1.31349, & + 1.31302, 1.31257, 1.31215, 1.31175, 1.31136, 1.31099, & + 1.31064, 1.31031, 1.30999, 1.30968, 1.30938, 1.30909, & + 1.30882, 1.30855, 1.30829, 1.30804, 1.30780, 1.30756, & + 1.30733, 1.30710, 1.30688, 1.30667, 1.30646, 1.30625, & + 1.30605, 1.30585, 1.30566, 1.30547, 1.30528, 1.30509, & + 1.30491, 1.30473, 1.30455, 1.30437, 1.30419, 1.30402, & + 1.30385, 1.30367, 1.30350, 1.30333, 1.30316, 1.30299, & + 1.30283, 1.30266, 1.30249, 1.30232, 1.30216, 1.30199, & + 1.30182, 1.30166, 1.30149, 1.30132, 1.30116, 1.30099, & + 1.30082, 1.30065, 1.30048, 1.30031, 1.30014, 1.29997, & + 1.29979, 1.29962, 1.29945, 1.29927, 1.29909, 1.29891, & + 1.29873, 1.29855, 1.29837, 1.29818, 1.29800, 1.29781, & + 1.29762, 1.29743, 1.29724, 1.29705, 1.29686, 1.29666, & + 1.29646, 1.29626, 1.29605, 1.29584, 1.29563, 1.29542, & + 1.29521, 1.29499, 1.29476, 1.29453, 1.29430, 1.29406, & + 1.29381, 1.29355, 1.29327, 1.29299, 1.29272, 1.29252, & + 1.29228, 1.29205, 1.29186, 1.29167, 1.29150, 1.29130, & + 1.29106, 1.29083, 1.29025, 1.28962, 1.28891, 1.28784, & + 1.28689, 1.28623, 1.28521, 1.28413, 1.28261, 1.28137, & + 1.28093, 1.28047, 1.28022, 1.27998, 1.27948, 1.27849, & + 1.27774, 1.27691, 1.27610, 1.27535, 1.27471, 1.27404, & + 1.27329, 1.27240, 1.27139, 1.27029, 1.26901, 1.26736, & + 1.26591, 1.26441, 1.26284, 1.26036, 1.25860, 1.25815, & + 1.25768, 1.25675, 1.25579, 1.25383, 1.25179, 1.24967, & + 1.24745, 1.24512, 1.24266, 1.24004, 1.23725, 1.23270, & + 1.22583, 1.22198, 1.21548, 1.21184, 1.20790, 1.20507, & + 1.20209, 1.19566, 1.17411, 1.14734, 1.10766, 1.06739, & + 1.04762, 1.02650, 1.00357, 0.98197, 0.96503, 0.95962, & + 0.97269, 0.99172, 1.00668, 1.02186, 1.04270, 1.07597, & + 1.12954, 1.21267, 1.32509, 1.42599, 1.49656, 1.55095, & + 1.59988, 1.63631, 1.65024, 1.64278, 1.62691, 1.61284, & + 1.59245, 1.57329, 1.55770, 1.54129, 1.52654, 1.51139, & + 1.49725, 1.48453, 1.47209, 1.46125, 1.45132, 1.44215, & + 1.43366, 1.41553, 1.39417, 1.38732, 1.37735, 1.36448, & + 1.35414, 1.34456, 1.33882, 1.33807, 1.33847, 1.34053, & + 1.34287, 1.34418, 1.34634, 1.34422, 1.33453, 1.32897, & + 1.32333, 1.31800, 1.31432, 1.30623, 1.29722, 1.28898, & + 1.28730, 1.28603, 1.28509, 1.28535, 1.28813, 1.30156, & + 1.30901, 1.31720, 1.31893, 1.32039, 1.32201, 1.32239, & + 1.32149, 1.32036, 1.31814, 1.31705, 1.31807, 1.31953, & + 1.31933, 1.31896, 1.31909, 1.31796, 1.31631, 1.31542, & + 1.31540, 1.31552, 1.31455, 1.31193, 1.30677, 1.29934, & + 1.29253, 1.28389, 1.27401, 1.26724, 1.25990, 1.24510, & + 1.22241, 1.19913, 1.17150, 1.15528, 1.13700, 1.11808, & + 1.10134, 1.09083, 1.08734, 1.09254, 1.10654, 1.14779, & + 1.20202, 1.25825, 1.32305, 1.38574, 1.44478, 1.47170, & + 1.49619, 1.51652, 1.53328, 1.54900, 1.56276, 1.57317, & + 1.58028, 1.57918, 1.56672, 1.55869, 1.55081, 1.53807, & + 1.53296, 1.53220, 1.53340, 1.53289, 1.51705, 1.50097, & + 1.49681, 1.49928, 1.50153, 1.49856, 1.49053, 1.46070, & + 1.45182, 1.44223, 1.43158, 1.41385, 1.40676, 1.38955, & + 1.34894, 1.31039, 1.26420, 1.23656, 1.21663, 1.20233, & + 1.19640, 1.19969, 1.20860, 1.22173, 1.24166, 1.28175, & + 1.32784, 1.38657, 1.46486, 1.55323, 1.60379, 1.61877, & + 1.62963, 1.65712, 1.69810, 1.72065, 1.74865, 1.76736, & + 1.76476, 1.75011, 1.72327, 1.68490, 1.62398, 1.59596, & + 1.58514, 1.59917, 1.61405, 1.66625, 1.70663, 1.73713, & + 1.76860, 1.80343, 1.83296, 1.85682, 1.87411, 1.89110, & + 1.89918, 1.90432, 1.90329, 1.88744, 1.87499, 1.86702, & + 1.85361, 1.84250, 1.83225, 1.81914, 1.82268, 1.82961] + real(wp),parameter,dimension(nwlt,4) :: & + tabret = reshape( & + source =(/1.82961, 1.83258, 1.83149, & + 1.82748, 1.82224, 1.81718, 1.81204, 1.80704, 1.80250, & + 1.79834, 1.79482, 1.79214, 1.78843, 1.78601, 1.78434, & + 1.78322, 1.78248, 1.78201, 1.78170, 1.78160, 1.78190, & + 1.78300, 1.78430, 1.78520, 1.78620, 1.78660, 1.78680, & + 1.78690, 1.78700, 1.78700, 1.78710, 1.78710, 1.78720, & + 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, & + 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, & + 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, & + 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, 1.78720, & + 1.78720, 1.78720, 1.78720, 1.78720, 1.78800, & + 1.82961, 1.83258, 1.83149, 1.82748, & + 1.82224, 1.81718, 1.81204, 1.80704, 1.80250, 1.79834, & + 1.79482, 1.79214, 1.78843, 1.78601, 1.78434, 1.78322, & + 1.78248, 1.78201, 1.78170, 1.78160, 1.78190, 1.78300, & + 1.78430, 1.78520, 1.78610, 1.78630, 1.78640, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, 1.78650, & + 1.78650, 1.78650, 1.78650, 1.78720, & + 1.82961, 1.83258, 1.83149, 1.82748, 1.82224, & + 1.81718, 1.81204, 1.80704, 1.80250, 1.79834, 1.79482, & + 1.79214, 1.78843, 1.78601, 1.78434, 1.78322, 1.78248, & + 1.78201, 1.78160, 1.78140, 1.78160, 1.78220, 1.78310, & + 1.78380, 1.78390, 1.78400, 1.78400, 1.78400, 1.78400, & + 1.78400, 1.78390, 1.78380, 1.78370, 1.78370, 1.78370, & + 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, & + 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, & + 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, & + 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, 1.78370, & + 1.78370, 1.78400, 1.78450, & + 1.82961, 1.83258, 1.83149, 1.82748, 1.82224, 1.81718, & + 1.81204, 1.80704, 1.80250, 1.79834, 1.79482, 1.79214, & + 1.78843, 1.78601, 1.78434, 1.78322, 1.78248, 1.78201, & + 1.78150, 1.78070, 1.78010, 1.77890, 1.77790, 1.77730, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, 1.77720, & + 1.77720, 1.77800/),shape=(/nwlt,4/)) + + ! ##################################################################### + ! Defines wavelength dependent complex index of refraction for ice. + ! Allowable wavelength range extends from 0.045 microns to 8.6 meter + ! temperature dependence only considered beyond 167 microns. + ! + ! interpolation is done n_r vs. log(xlam) + ! n_r vs. t + ! log(n_i) vs. log(xlam) + ! log(n_i) vs. t + ! + ! Stephen G. Warren - 1983 + ! Dept. of Atmospheric Sciences + ! University of Washington + ! Seattle, Wa 98195 + ! + ! Based on + ! + ! Warren,S.G.,1984. + ! Optical constants of ice from the ultraviolet to the microwave. + ! Applied Optics,23,1206-1225 + ! + ! Reference temperatures are -1.0,-5.0,-20.0, and -60.0 deg C + ! ##################################################################### + + pi = acos(-1._wp) + n_r = 0._wp + n_i = 0._wp + tk = t + + ! Convert frequency to wavelength (um) + alam=3E5_wp/freq + if((alam < wlmin) .or. (alam > wlmax)) then + call errorMessage('FATAL ERROR(optics/optics_lib.f90:m_ice): wavelength out of bounds') + return + endif + + if (alam < cutice) then + ! Region from 0.045 microns to 167.0 microns - no temperature depend + do i=2,nwl + if(alam < wl(i)) continue + enddo + x1 = log(wl(i-1)) + x2 = log(wl(i)) + y1 = tabre(i-1) + y2 = tabre(i) + x = log(alam) + y = ((x-x1)*(y2-y1)/(x2-x1))+y1 + n_r = y + y1 = log(abs(tabim(i-1))) + y2 = log(abs(tabim(i))) + y = ((x-x1)*(y2-y1)/(x2-x1))+y1 + n_i = exp(y) + else + ! Region from 167.0 microns to 8.6 meters - temperature dependence + if(tk > temref(1)) tk=temref(1) + if(tk < temref(4)) tk=temref(4) + do i=2,4 + if(tk.ge.temref(i)) go to 12 + enddo +12 lt1 = i + lt2 = i-1 + do i=2,nwlt + if(alam.le.wlt(i)) go to 14 + enddo +14 x1 = log(wlt(i-1)) + x2 = log(wlt(i)) + y1 = tabret(i-1,lt1) + y2 = tabret(i,lt1) + x = log(alam) + ylo = ((x-x1)*(y2-y1)/(x2-x1))+y1 + y1 = tabret(i-1,lt2) + y2 = tabret(i,lt2) + yhi = ((x-x1)*(y2-y1)/(x2-x1))+y1 + t1 = temref(lt1) + t2 = temref(lt2) + y = ((tk-t1)*(yhi-ylo)/(t2-t1))+ylo + n_r = y + y1 = log(abs(tabimt(i-1,lt1))) + y2 = log(abs(tabimt(i,lt1))) + ylo = ((x-x1)*(y2-y1)/(x2-x1))+y1 + y1 = log(abs(tabimt(i-1,lt2))) + y2 = log(abs(tabimt(i,lt2))) + yhi = ((x-x1)*(y2-y1)/(x2-x1))+y1 + y = ((tk-t1)*(yhi-ylo)/(t2-t1))+ylo + n_i = exp(y) + endif + end subroutine m_ice + + ! ############################################################################ + ! subroutine MIEINT + ! ############################################################################ + Subroutine MieInt(Dx, SCm, Inp, Dqv, Dqxt, Dqsc, Dbsc, Dg, Xs1, Xs2, DPh, Error) + ! ########################################################################## + ! + ! General purpose Mie scattering routine for single particles + ! Author: R Grainger 1990 + ! History: + ! G Thomas, March 2005: Added calculation of Phase function and + ! code to ensure correct calculation of backscatter coeficient + ! Options/Extend_Source + ! + ! ########################################################################## + ! INPUTS + integer, intent(in) :: & + Inp + real(wp),intent(in) :: & + Dx ! + real(wp),intent(in),dimension(Inp) :: & + Dqv + Complex(wp),intent(in) :: & + SCm! + + ! OUTPUTS + Complex(wp),intent(out),dimension(InP) :: & + Xs1, & ! + Xs2 ! + real(wp),intent(out) :: & + Dqxt, & ! + Dqsc, & ! + Dg, & ! + Dbsc ! + real(wp),intent(out),dimension(InP) :: & + DPh + integer :: & + Error !! + + ! PARAMETERS + Integer,parameter :: & + Imaxx = 12000, & ! + Itermax = 30000, & ! Must be large enough to cope with the + ! largest possible nmx = x * abs(scm) + 15 + ! or nmx = Dx + 4.05*Dx**(1./3.) + 2.0 + Imaxnp = 10000 ! Change this as required + Real(wp),parameter :: & + RIMax=2.5, & ! Largest real part of refractive index + IRIMax = -2 ! Largest imaginary part of refractive index + + ! Internal variables + Integer :: I, NStop, NmX, N, Inp2 + Real(wp) :: Chi,Chi0,Chi1,APsi,APsi0,APsi1,Psi,Psi0,Psi1 + Real(wp),dimension(Imaxnp) :: Pi0,Pi1,Taun + Complex(wp) :: Ir,Cm,A,ANM1,APB,B,BNM1,AMB,Xi,Xi0,Xi1,Y + Complex(wp),dimension(Itermax) :: D + Complex(wp),dimension(Imaxnp) :: Sp,Sm! + + ! ACCELERATOR VARIABLES + Integer :: Tnp1,Tnm1 + Real(wp) :: Dn, Rnx,Turbo,A2 + real(wp),dimension(Imaxnp) :: S,T + Complex(wp) :: A1 + + If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then + Error = 1 + Return + EndIf + Cm = SCm + Ir = 1 / Cm + Y = Dx * Cm + If (Dx.Lt.0.02) Then + NStop = 2 + Else + If (Dx.Le.8.0) Then + NStop = Dx + 4.00*Dx**(1./3.) + 2.0 + Else + If (Dx.Lt. 4200.0) Then + NStop = Dx + 4.05*Dx**(1./3.) + 2.0 + Else + NStop = Dx + 4.00*Dx**(1./3.) + 2.0 + End If + End If + End If + NmX = Max(Real(NStop),Real(Abs(Y))) + 15. + If (Nmx .gt. Itermax) then + Error = 1 + Return + End If + Inp2 = Inp+1 +!ds D(NmX) = cmplx(0,0,Kind=Kind(0d0)) + D(NmX) = cmplx(0,0,Kind=wp) + Do N = Nmx-1,1,-1 + A1 = (N+1) / Y + D(N) = A1 - 1/(A1+D(N+1)) + End Do + Do I =1,Inp2 + Sm(I) = cmplx(0,0,Kind=wp) +!ds Sm(I) = cmplx(0,0,Kind=Kind(0d0)) + Sp(I) = cmplx(0,0,Kind=wp) +!ds Sp(I) = cmplx(0,0,Kind=Kind(0d0)) + Pi0(I) = 0 + Pi1(I) = 1 + End Do + Psi0 = Cos(Dx) + Psi1 = Sin(Dx) + Chi0 =-Sin(Dx) + Chi1 = Cos(Dx) + APsi0 = Psi0 + APsi1 = Psi1 + Xi0 = cmplx(APsi0,Chi0,Kind=wp) +!ds Xi0 = cmplx(APsi0,Chi0,Kind=Kind(0d0)) + Xi1 = cmplx(APsi1,Chi1,Kind=wp) +!ds Xi1 = cmplx(APsi1,Chi1,Kind=Kind(0d0)) + Dg = 0 + Dqsc = 0 + Dqxt = 0 + Tnp1 = 1 + Do N = 1,Nstop + DN = N + Tnp1 = Tnp1 + 2 + Tnm1 = Tnp1 - 2 + A2 = Tnp1 / (DN*(DN+1._wp)) +!ds A2 = Tnp1 / (DN*(DN+1D0)) + Turbo = (DN+1._wp) / DN +!ds Turbo = (DN+1D0) / DN + Rnx = DN/Dx + Psi = Tnm1*Psi1/Dx - Psi0 +!ds Psi = Dble(Tnm1)*Psi1/Dx - Psi0 + APsi = Psi + Chi = Tnm1*Chi1/Dx - Chi0 + Xi = cmplx(APsi,Chi,Kind=wp) +!ds Xi = cmplx(APsi,Chi,Kind=Kind(0d0)) + A = ((D(N)*Ir+Rnx)*APsi-APsi1) / ((D(N)*Ir+Rnx)* Xi- Xi1) + B = ((D(N)*Cm+Rnx)*APsi-APsi1) / ((D(N)*Cm+Rnx)* Xi- Xi1) + Dqxt = Tnp1*(A + B)+ Dqxt +!ds Dqxt = Tnp1 * Dble(A + B) + Dqxt + Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc + If (N.Gt.1) then + Dg = Dg + (dN*dN - 1) * (ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 *(ANM1*Conjg(BNM1)) / (dN*dN - dN) +!ds Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN) + End If + Anm1 = A + Bnm1 = B + APB = A2 * (A + B) + AMB = A2 * (A - B) + Do I = 1,Inp2 + If (I.GT.Inp) Then + S(I) = -Pi1(I) + Else + S(I) = Dqv(I) * Pi1(I) + End If + T(I) = S(I) - Pi0(I) + Taun(I) = N*T(I) - Pi0(I) + Sp(I) = APB * (Pi1(I) + Taun(I)) + Sp(I) + Sm(I) = AMB * (Pi1(I) - Taun(I)) + Sm(I) + Pi0(I) = Pi1(I) + Pi1(I) = S(I) + T(I)*Turbo + End Do + Psi0 = Psi1 + Psi1 = Psi + Apsi1 = Psi1 + Chi0 = Chi1 + Chi1 = Chi + Xi1 = cmplx(APsi1,Chi1,Kind=wp) +!ds Xi1 = cmplx(APsi1,Chi1,Kind=Kind(0d0)) + End Do + + If (Dg .GT.0) Dg = 2 * Dg / Dqsc + Dqsc = 2 * Dqsc / Dx**2 + Dqxt = 2 * Dqxt / Dx**2 + Do I = 1,Inp + Xs1(I) = (Sp(I)+Sm(I)) / 2 + Xs2(I) = (Sp(I)-Sm(I)) / 2 + Dph(I) = 2 * (Xs1(I)*Conjg(Xs1(I)) + Xs2(I)*Conjg(Xs2(I))) / (Dx**2 * Dqsc) +!ds Dph(I) = 2 * Dble(Xs1(I)*Conjg(Xs1(I)) + Xs2(I)*Conjg(Xs2(I))) / (Dx**2 * Dqsc) + End Do + Dbsc = 4 * Abs(( (Sp(Inp2)+Sm(Inp2))/2 )**2) / Dx**2 + Error = 0 + Return + End subroutine MieInt +end module optics_lib diff --git a/src/physics/cosp2/optics/quickbeam_optics.F90 b/src/physics/cosp2/optics/quickbeam_optics.F90 new file mode 100644 index 0000000000..71bfd97d52 --- /dev/null +++ b/src/physics/cosp2/optics/quickbeam_optics.F90 @@ -0,0 +1,1397 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015: Dustin Swales - Initial version +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module mod_quickbeam_optics + USE COSP_KINDS, ONLY: wp,dp + USE array_lib, ONLY: infind + USE math_lib, ONLY: path_integral,avint,gamma + USE optics_lib, ONLY: m_wat,m_ice,MieInt + USE cosp_math_constants, ONLY: pi + USE cosp_phys_constants, ONLY: rhoice + use quickbeam, ONLY: radar_cfg,dmin,dmax,Re_BIN_LENGTH, & + Re_MAX_BIN,nRe_types,nd,maxhclass,save_scale_LUTs + use mod_cosp_config, ONLY: N_HYDRO + use mod_cosp_error, ONLY: errorMessage + implicit none + + ! Derived type for particle size distribution + TYPE size_distribution + real(wp),dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho + integer, dimension(maxhclass) :: dtype,phase + END TYPE size_distribution + + ! Parameters + integer,parameter :: & ! + cnt_liq = 19, & ! Liquid temperature count + cnt_ice = 20 ! Lce temperature count + + ! Initialization variables + real(wp),dimension(cnt_ice) :: mt_tti + real(wp),dimension(cnt_liq) :: mt_ttl + real(wp),dimension(nd) :: D + +contains + ! ###################################################################################### + ! SUBROUTINE quickbeam_optics_init + ! ###################################################################################### + subroutine quickbeam_optics_init() + integer :: j + + mt_tti = (/ ((j-1)*5-90 + 273.15, j = 1, cnt_ice) /) + mt_ttl = (/ ((j-1)*5-60 + 273.15, j = 1, cnt_liq) /) + D(1) = dmin + do j=2,nd + D(j) = D(j-1)*exp((log(dmax)-log(dmin))/(nd-1)) + enddo + end subroutine quickbeam_optics_init + + ! ###################################################################################### + ! SUBROUTINE QUICKBEAM_OPTICS + ! ###################################################################################### + subroutine quickbeam_optics(sd, rcfg, nprof, ngate, undef, hm_matrix, re_matrix, & + Np_matrix, p_matrix, t_matrix, sh_matrix,z_vol,kr_vol) + + ! INPUTS + type(size_distribution),intent(inout) :: & + sd ! + type(radar_cfg),intent(inout) :: & + rcfg ! + integer,intent(in) :: & + nprof, & ! Number of hydrometeor profiles + ngate ! Number of vertical layers + real(wp),intent(in) :: & + undef ! Missing data value + real(wp),intent(in),dimension(nprof,ngate) :: & + p_matrix, & ! Pressure profile (hPa) + t_matrix, & ! Temperature profile (K) + sh_matrix ! Specific humidity profile (%) -- only needed if gaseous aborption calculated. + real(wp),intent(in),dimension(nprof,ngate,rcfg%nhclass) :: & + re_matrix, & ! Table of hydrometeor effective radii. 0 ==> use defaults. (units=microns) + hm_matrix ! Table of hydrometeor mixing ratios (g/kg) + real(wp),intent(inout),dimension(nprof,ngate,rcfg%nhclass) :: & + Np_matrix ! Table of hydrometeor number concentration. 0 ==> use defaults. (units = 1/kg) + + ! OUTPUTS + real(wp),intent(out), dimension(nprof, ngate) :: & + z_vol, & ! Effective reflectivity factor (mm^6/m^3) + kr_vol ! Attenuation coefficient hydro (dB/km) + + ! INTERNAL VARIABLES + integer :: & + phase, ns,tp,j,k,pr,itt,iRe_type,n + logical :: & + hydro + real(wp) :: & + t_kelvin,Re_internal + real(wp) :: & + rho_a,kr,ze,zr,scale_factor,Re,Np,base,step + + real(wp),dimension(:),allocatable :: & + Deq, & ! Discrete drop sizes (um) + Ni, & ! Discrete concentrations (cm^-3 um^-1) + rhoi, & ! Discrete densities (kg m^-3) + xxa, & ! + Di ! Discrete drop sizes (um) + + real(wp), dimension(nprof, ngate) :: & + z_ray ! Reflectivity factor, Rayleigh only (mm^6/m^3) + + ! PARAMETERS + logical, parameter :: & ! + DO_LUT_TEST = .false., & ! + DO_NP_TEST = .false. ! + real(wp), parameter :: & + one_third = 1._wp/3._wp ! + + ! Initialization + z_vol = 0._wp + z_ray = 0._wp + kr_vol = 0._wp + + do k=1,ngate ! Loop over each profile (nprof) + do pr=1,nprof + + ! Determine if hydrometeor(s) present in volume + hydro = .false. + do j=1,rcfg%nhclass + if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then + hydro = .true. + exit + endif + enddo + + t_kelvin = t_matrix(pr,k) + ! If there is hydrometeor in the volume + if (hydro) then + rho_a = (p_matrix(pr,k))/(287._wp*(t_kelvin)) + + ! Loop over hydrometeor type + do tp=1,rcfg%nhclass + Re_internal = re_matrix(pr,k,tp) + + if (hm_matrix(pr,k,tp) <= 1E-12) cycle + + ! Index into temperature dimension of scaling tables + ! These tables have regular steps -- exploit this and abandon infind + phase = sd%phase(tp) + if (phase==0) then + itt = infind(mt_ttl,t_kelvin) + else + itt = infind(mt_tti,t_kelvin) + endif + + ! Compute effective radius from number concentration and distribution parameters + if (Re_internal .eq. 0) then + call calc_Re(hm_matrix(pr,k,tp),Np_matrix(pr,k,tp),rho_a, & + sd%dtype(tp),sd%apm(tp),sd%bpm(tp),sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp),Re) + Re_internal=Re + !re_matrix(pr,k,tp)=Re + else + if (Np_matrix(pr,k,tp) > 0) then + call errorMessage('WARNING(optics/quickbeam_optics.f90): '//& + 'Re and Np set for the same volume & hydrometeor type. Np is being ignored.') + endif + Re = Re_internal + !Re = re_matrix(pr,k,tp) + endif + + ! Index into particle size dimension of scaling tables + iRe_type=1 + if(Re.gt.0) then + ! Determine index in to scale LUT + ! Distance between Re points (defined by "base" and "step") for + ! each interval of size Re_BIN_LENGTH + ! Integer asignment, avoids calling floor intrinsic + n=Re/Re_BIN_LENGTH + if (n>=Re_MAX_BIN) n=Re_MAX_BIN-1 + step = rcfg%step_list(n+1) + base = rcfg%base_list(n+1) + iRe_type=Re/step + if (iRe_type.lt.1) iRe_type=1 + Re=step*(iRe_type+0.5_wp) ! set value of Re to closest value allowed in LUT. + iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step) + + ! Make sure iRe_type is within bounds + if (iRe_type.ge.nRe_types) then + !write(*,*) 'Warning: size of Re exceed value permitted ', & + ! 'in Look-Up Table (LUT). Will calculate. ' + ! No scaling allowed + iRe_type=nRe_types + rcfg%Z_scale_flag(tp,itt,iRe_type)=.false. + else + ! Set value in re_matrix to closest values in LUT + if (.not. DO_LUT_TEST) re_internal=Re + !if (.not. DO_LUT_TEST) re_matrix(pr,k,tp)=Re + endif + endif + + ! Use Ze_scaled, Zr_scaled, and kr_scaled ... if know them + ! if not we will calculate Ze, Zr, and Kr from the distribution parameters +! if( rcfg%Z_scale_flag(tp,itt,iRe_type) .and. .not. DO_LUT_TEST) then +! ! can use z scaling +! scale_factor=rho_a*hm_matrix(pr,k,tp) +! zr = rcfg%Zr_scaled(tp,itt,iRe_type) * scale_factor +! ze = rcfg%Ze_scaled(tp,itt,iRe_type) * scale_factor +! kr = rcfg%kr_scaled(tp,itt,iRe_type) * scale_factor +! else + if( (.not. rcfg%Z_scale_flag(tp,itt,iRe_type)) .or. DO_LUT_TEST) then + ! Create a discrete distribution of hydrometeors within volume + select case(sd%dtype(tp)) + case(4) + ns = 1 + allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) + Di = sd%p1(tp) + Ni = 0._wp + case default + ns = nd ! constant defined in simulator/quickbeam.f90 + allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) + Di = D + Ni = 0._wp + end select + call dsd(hm_matrix(pr,k,tp),re_internal,Np_matrix(pr,k,tp), & + Di,Ni,ns,sd%dtype(tp),rho_a,t_kelvin, & + sd%dmin(tp),sd%dmax(tp),sd%apm(tp),sd%bpm(tp), & + sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp)) + + ! Calculate particle density + if (phase == 1) then + if (sd%rho(tp) < 0) then + ! Use equivalent volume spheres. + rcfg%rho_eff(tp,1:ns,iRe_type) = rhoice ! solid ice == equivalent volume approach + Deq = ( ( 6/pi*sd%apm(tp)/rhoice) ** one_third ) * ( (Di*1E-6) ** (sd%bpm(tp)/3._wp) ) * 1E6 + ! alternative is to comment out above two lines and use the following block + ! MG Mie approach - adjust density of sphere with D = D_characteristic to match particle density + ! + ! rcfg%rho_eff(tp,1:ns,iRe_type) = (6/pi)*sd%apm(tp)*(Di*1E-6)**(sd%bpm(tp)-3) !MG Mie approach + + ! as the particle size gets small it is possible that the mass to size relationship of + ! (given by power law in hclass.data) can produce impossible results + ! where the mass is larger than a solid sphere of ice. + ! This loop ensures that no ice particle can have more mass/density larger than an ice sphere. + ! do i=1,ns + ! if(rcfg%rho_eff(tp,i,iRe_type) > 917 ) then + ! rcfg%rho_eff(tp,i,iRe_type) = 917 + ! endif + ! enddo + else + ! Equivalent volume sphere (solid ice rhoice=917 kg/m^3). + rcfg%rho_eff(tp,1:ns,iRe_type) = rhoice + Deq=Di * ((sd%rho(tp)/rhoice)**one_third) + ! alternative ... coment out above two lines and use the following for MG-Mie + ! rcfg%rho_eff(tp,1:ns,iRe_type) = sd%rho(tp) !MG Mie approach + endif + else + ! I assume here that water phase droplets are spheres. + ! sd%rho should be ~ 1000 or sd%apm=524 .and. sd%bpm=3 + Deq = Di + endif + + ! Calculate effective reflectivity factor of volume + ! xxa are unused (Mie scattering and extinction efficiencies) + xxa(1:ns) = -9.9_wp + rhoi = rcfg%rho_eff(tp,1:ns,iRe_type) + call zeff(rcfg%freq,Deq,Ni,ns,rcfg%k2,t_kelvin,phase,rcfg%do_ray, & + ze,zr,kr,xxa,xxa,rhoi) + + ! Test compares total number concentration with sum of discrete samples + ! The second test, below, compares ab initio and "scaled" computations + ! of reflectivity + ! These should get broken out as a unit test that gets called on + ! data. That routine could write to std out. + + ! Test code ... compare Np value input to routine with sum of DSD + ! NOTE: if .not. DO_LUT_TEST, then you are checking the LUT approximation + ! not just the DSD representation given by Ni + if(Np_matrix(pr,k,tp)>0 .and. DO_NP_TEST ) then + Np = path_integral(Ni,Di,1,ns-1)/rho_a*1.E6_wp + ! Note: Representation is not great or small Re < 2 + if( (Np_matrix(pr,k,tp)-Np)/Np_matrix(pr,k,tp)>0.1 ) then + call errorMessage('ERROR(optics/quickbeam_optics.f90): Error: Np input does not match sum(N)') + endif + endif + + ! Clean up space + deallocate(Di,Ni,rhoi,xxa,Deq) + + ! LUT test code + ! This segment of code compares full calculation to scaling result + if ( rcfg%Z_scale_flag(tp,itt,iRe_type) .and. DO_LUT_TEST ) then + scale_factor=rho_a*hm_matrix(pr,k,tp) + ! if more than 2 dBZe difference print error message/parameters. + if ( abs(10*log10(ze) - 10*log10(rcfg%Ze_scaled(tp,itt,iRe_type) * & + scale_factor)) > 2 ) then + call errorMessage('ERROR(optics/quickbeam_optics.f90): ERROR: Roj Error?') + endif + endif + else + ! Use z scaling + scale_factor=rho_a*hm_matrix(pr,k,tp) + zr = rcfg%Zr_scaled(tp,itt,iRe_type) * scale_factor + ze = rcfg%Ze_scaled(tp,itt,iRe_type) * scale_factor + kr = rcfg%kr_scaled(tp,itt,iRe_type) * scale_factor + endif ! end z_scaling + + kr_vol(pr,k) = kr_vol(pr,k) + kr + z_vol(pr,k) = z_vol(pr,k) + ze + z_ray(pr,k) = z_ray(pr,k) + zr + + ! Construct Ze_scaled, Zr_scaled, and kr_scaled ... if we can + if ( .not. rcfg%Z_scale_flag(tp,itt,iRe_type) ) then + if (iRe_type>1) then + scale_factor=rho_a*hm_matrix(pr,k,tp) + rcfg%Ze_scaled(tp,itt,iRe_type) = ze/ scale_factor + rcfg%Zr_scaled(tp,itt,iRe_type) = zr/ scale_factor + rcfg%kr_scaled(tp,itt,iRe_type) = kr/ scale_factor + rcfg%Z_scale_flag(tp,itt,iRe_type) = .true. + rcfg%Z_scale_added_flag(tp,itt,iRe_type)=.true. + endif + endif + enddo ! end loop of tp (hydrometeor type) + endif + enddo + enddo + + where(kr_vol(:,:) <= EPSILON(kr_vol)) + ! Volume is hydrometeor-free + !z_vol(:,:) = undef + z_ray(:,:) = undef + end where + + ! Save any updates made + if (rcfg%update_scale_LUTs) call save_scale_LUTs(rcfg) + + end subroutine quickbeam_optics + ! ############################################################################################## + ! ############################################################################################## + subroutine calc_Re(Q,Np,rho_a,dtype,apm,bpm,rho_c,p1,p2,p3,Re) + ! ############################################################################################## + ! Purpose: + ! Calculates Effective Radius (1/2 distribution 3rd moment / 2nd moment). + ! + ! For some distribution types, the total number concentration (per kg), Np + ! may be optionally specified. Should be set to zero, otherwise. + ! + ! Roj Marchand July 2010 + ! + ! Inputs: + ! + ! [Q] hydrometeor mixing ratio (g/kg) ! not needed for some distribution types + ! [Np] Optional Total number concentration (per kg). 0 = use defaults (p1, p2, p3) + ! [rho_a] ambient air density (kg m^-3) + ! + ! Distribution parameters as per quickbeam documentation. + ! [dtype] distribution type + ! [apm] a parameter for mass (kg m^[-bpm]) + ! [bmp] b params for mass + ! [p1],[p2],[p3] distribution parameters + ! + ! Outputs: + ! [Re] Effective radius, 1/2 the 3rd moment/2nd moment (um) + ! + ! Created: + ! July 2010 Roj Marchand + ! Modified: + ! 12/18/14 Dustin Swales: Define type REALs as double precision (dustin.swales@noaa.gov) + ! + ! ############################################################################################## + ! ############################################################################################## + + ! Inputs + real(wp), intent(in) :: Q,Np,rho_a,rho_c,p1,p2,p3 + integer, intent(in) :: dtype + real(wp), intent(inout) :: apm,bpm + + ! Outputs + real(wp), intent(out) :: Re + + ! Internal + integer :: local_dtype + real(wp) :: local_p3,local_Np,tmp1,tmp2 + real(wp) :: N0,D0,vu,dm,ld,rg,log_sigma_g ! gamma, exponential variables + + + ! If density is constant, set equivalent values for apm and bpm + if ((rho_c > 0) .and. (apm < 0)) then + apm = (pi/6)*rho_c + bpm = 3._wp + endif + + ! Exponential is same as modified gamma with vu =1 + ! if Np is specified then we will just treat as modified gamma + if(dtype .eq. 2 .and. Np .gt. 0) then + local_dtype = 1 + local_p3 = 1 + else + local_dtype = dtype + local_p3 = p3 + endif + select case(local_dtype) + + ! ---------------------------------------------------------! + ! Modified gamma ! + ! Np = total number concentration (1/kg) = Nt / rho_a ! + ! D0 = characteristic diameter (um) ! + ! dm = mean diameter (um) - first moment over zeroth moment! + ! vu = distribution width parameter ! + ! ---------------------------------------------------------! + case(1) + + if( abs(local_p3+2) < 1E-8) then + if(Np>1E-30) then + ! Morrison scheme with Martin 1994 shape parameter (NOTE: vu = pc +1) + ! fixed Roj. Dec. 2010 -- after comment by S. Mcfarlane + vu = (1/(0.2714_wp + 0.00057145_wp*Np*rho_a*1E-6))**2 ! units of Nt = Np*rhoa = #/cm^3 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify a value for Np in each volume with Morrison/Martin Scheme.') + return + endif + elseif (abs(local_p3+1) > 1E-8) then + ! vu is fixed in hp structure + vu = local_p3 + else + ! vu isn't specified + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify a value for vu for Modified Gamma distribution') + return + endif + + if( Np.eq.0 .and. p2+1 > 1E-8) then ! use default value for MEAN diameter as first default + dm = p2 ! by definition, should have units of microns + D0 = gamma(vu)/gamma(vu+1)*dm + else ! use value of Np + if(Np.eq.0) then + if( abs(p1+1) > 1E-8 ) then ! use default number concentration + local_Np = p1 ! total number concentration / pa --- units kg^-1 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify Np or default value (p1=Dm [um] or p2=Np [1/kg]) for Modified Gamma distribution') + return + endif + else + local_Np=Np; + endif + D0 = 1E6 * ( Q*1E-3*gamma(vu)/(apm*local_Np*gamma(vu+bpm)) )**(1/bpm) ! units = microns + endif + Re = 0.5_wp*D0*gamma(vu+3)/gamma(vu+2) + + ! ---------------------------------------------------------! + ! Exponential ! + ! N0 = intercept parameter (m^-4) ! + ! ld = slope parameter (um) ! + ! ---------------------------------------------------------! + case(2) + + ! Np not specified (see if statement above) + if((abs(p1+1) > 1E-8) ) then ! N0 has been specified, determine ld + N0 = p1 + tmp1 = 1._wp/(1._wp+bpm) + ld = ((apm*gamma(1.+bpm)*N0)/(rho_a*Q*1E-3))**tmp1 + ld = ld/1E6 ! set units to microns^-1 + elseif (abs(p2+1) > 1E-8) then ! lambda=ld has been specified as default + ld = p2 ! should have units of microns^-1 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify Np or default value (p1=No or p2=lambda) for Exponential distribution') + return + endif + Re = 1.5_wp/ld + + ! ---------------------------------------------------------! + ! Power law ! + ! ahp = Ar parameter (m^-4 mm^-bhp) ! + ! bhp = br parameter ! + ! dmin_mm = lower bound (mm) ! + ! dmax_mm = upper bound (mm) ! + ! ---------------------------------------------------------! + case(3) + + Re=0._wp ! Not supporting LUT approach for power-law ... + if(Np>0) then + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Variable Np not supported for Power Law distribution') + return + endif + + ! ---------------------------------------------------------! + ! Monodisperse ! + ! D0 = particle diameter (um) == Re ! + ! ---------------------------------------------------------! + case(4) + + Re = p1 + if(Np>0) then + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Variable Np not supported for Monodispersed distribution') + return + endif + + ! ---------------------------------------------------------! + ! Lognormal ! + ! N0 = total number concentration (m^-3) ! + ! np = fixed number concentration (kg^-1) ! + ! rg = mean radius (um) ! + ! log_sigma_g = ln(geometric standard deviation) ! + ! ---------------------------------------------------------! + case(5) + + if( abs(local_p3+1) > 1E-8 ) then + !set natural log width + log_sigma_g = local_p3 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify a value for sigma_g when using a Log-Normal distribution') + return + endif + + ! get rg ... + if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg + rg = p2 + else + if(Np>0) then + local_Np=Np; + elseif(abs(p2+1) < 1E-8) then + local_Np=p1 + else + call errorMessage('ERROR(optics/quickbeam_optics.f90:Calc_Re): '//& + 'Must specify Np or default value (p2=Rg or p1=Np) for Log-Normal distribution') + endif + log_sigma_g = p3 + tmp1 = (Q*1E-3)/(2._wp**bpm*apm*local_Np) + tmp2 = exp(0.5_wp*bpm*bpm*(log_sigma_g))*exp(0.5_wp*bpm*bpm*(log_sigma_g)) + rg = ((tmp1/tmp2)**(1._wp/bpm))*1E6 + endif + Re = rg*exp(2.5_wp*(log_sigma_g*log_sigma_g)) + end select + end subroutine calc_Re + ! ############################################################################################## + ! ############################################################################################## + subroutine dsd(Q,Re,Np,D,N,nsizes,dtype,rho_a,tk,dmin,dmax,apm,bpm,rho_c,p1,p2,p3) + ! ############################################################################################## + ! Purpose: + ! Create a discrete drop size distribution + ! + ! Starting with Quickbeam V3, this routine now allows input of + ! both effective radius (Re) and total number concentration (Nt) + ! Roj Marchand July 2010 + ! + ! The version in Quickbeam v.104 was modified to allow Re but not Nt + ! This is a significantly modified form for the version + ! + ! Originally Part of QuickBeam v1.03 by John Haynes + ! http://reef.atmos.colostate.edu/haynes/radarsim + ! + ! Inputs: + ! + ! [Q] hydrometeor mixing ratio (g/kg) + ! [Re] Optional Effective Radius (microns). 0 = use defaults (p1, p2, p3) + ! + ! [D] array of discrete drop sizes (um) where we desire to know the number concentraiton n(D). + ! [nsizes] number of elements of [D] + ! + ! [dtype] distribution type + ! [rho_a] ambient air density (kg m^-3) + ! [tk] temperature (K) + ! [dmin] minimum size cutoff (um) + ! [dmax] maximum size cutoff (um) + ! [rho_c] alternate constant density (kg m^-3) + ! [p1],[p2],[p3] distribution parameters + ! + ! Input/Output: + ! [apm] a parameter for mass (kg m^[-bpm]) + ! [bmp] b params for mass + ! + ! Outputs: + ! [N] discrete concentrations (cm^-3 um^-1) + ! or, for monodisperse, a constant (1/cm^3) + ! + ! Requires: + ! function infind + ! + ! Created: + ! 11/28/05 John Haynes (haynes@atmos.colostate.edu) + ! Modified: + ! 01/31/06 Port from IDL to Fortran 90 + ! 07/07/06 Rewritten for variable DSD's + ! 10/02/06 Rewritten using scaling factors (Roger Marchand and JMH), Re added V1.04 + ! July 2020 "N Scale factors" (variable fc) removed (Roj Marchand). + ! 12/18/14 Define type REALs as double precision (dustin.swales@noaa.gov) + ! ############################################################################################## + + ! Inputs + integer, intent(in) :: & + nsizes,& ! Number of elements of [D] + dtype ! distribution type + real(wp),intent(in),dimension(nsizes) :: & + D ! Array of discrete drop sizes (um) where we desire to know the number concentraiton n(D). + real(wp),intent(in) :: & + Q, & ! Hydrometeor mixing ratio (g/kg) + Np, & ! + rho_a, & ! Ambient air density (kg m^-3) + tk, & ! Temperature (K) + dmin, & ! Minimum size cutoff (um) + dmax, & ! Maximum size cutoff (um) + rho_c, & ! Alternate constant density (kg m^-3) + p1, & ! Distribution parameter 1 + p2, & ! Distribution parameter 2 + p3 ! Distribution parameter 3 + real(wp),intent(inout) :: & + apm, & ! a parameter for mass (kg m^[-bpm]) + bpm, & ! b params for mass + Re ! Optional Effective Radius (microns) + + ! Outputs + real(wp),intent(out),dimension(nsizes) :: & + N ! Discrete concentrations (cm^-3 um^-1) + ! or, for monodisperse, a constant (1/cm^3) + + ! Internal Variables + real(wp),dimension(nsizes) :: & + fc + real(wp) :: & + N0,D0,vu,local_np,dm,ld, & ! gamma, exponential variables + dmin_mm,dmax_mm,ahp,bhp, & ! power law variables + rg,log_sigma_g, & ! lognormal variables + rho_e, & ! particle density (kg m^-3) + tmp1,tmp2,tc + integer :: & + k,lidx,uidx + + ! Convert temperature from Kelvin to Celsius + tc = tk - 273.15_wp + + ! If density is constant, store equivalent values for apm and bpm + if ((rho_c > 0) .and. (apm < 0)) then + apm = (pi/6)*rho_c + bpm = 3._wp + endif + + ! Will preferentially use Re input over Np. + ! if only Np given then calculate Re + ! if neigher than use other defaults (p1,p2,p3) following quickbeam documentation + if(Re==0 .and. Np>0) then + call calc_Re(Q,Np,rho_a,dtype,apm,bpm,rho_c,p1,p2,p3,Re) + endif + select case(dtype) + + ! ---------------------------------------------------------! + ! Modified gamma ! + ! np = total number concentration ! + ! D0 = characteristic diameter (um) ! + ! dm = mean diameter (um) - first moment over zeroth moment! + ! vu = distribution width parameter ! + ! ---------------------------------------------------------! + case(1) + + if( abs(p3+2) < 1E-8) then + if( Np>1E-30) then + ! Morrison scheme with Martin 1994 shape parameter (NOTE: vu = pc +1) + ! fixed Roj. Dec. 2010 -- after comment by S. Mcfarlane + vu = (1/(0.2714_wp + 0.00057145_wp*Np*rho_a*1E-6))**2._wp ! units of Nt = Np*rhoa = #/cm^3 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'Must specify a value for Np in each volume with Morrison/Martin Scheme.') + return + endif + elseif (abs(p3+1) > 1E-8) then + ! vu is fixed in hp structure + vu = p3 + else + ! vu isn't specified + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'Must specify a value for vu for Modified Gamma distribution') + return + endif + + if(Re>0) then + D0 = 2._wp*Re*gamma(vu+2)/gamma(vu+3) + fc = (((D*1E-6)**(vu-1)*exp(-1*D/D0)) / & + (apm*((D0*1E-6)**(vu+bpm))*gamma(vu+bpm))) * 1E-12 + N = fc*rho_a*(Q*1E-3) + elseif( p2+1 > 1E-8) then ! use default value for MEAN diameter + dm = p2 + D0 = gamma(vu)/gamma(vu+1)*dm + fc = (((D*1E-6)**(vu-1)*exp(-1*D/D0)) / & + (apm*((D0*1E-6)**(vu+bpm))*gamma(vu+bpm))) * 1E-12 + N = fc*rho_a*(Q*1E-3) + elseif(abs(p3+1) > 1E-8) then! use default number concentration + local_np = p1 ! total number concentration / pa check + tmp1 = (Q*1E-3)**(1./bpm) + fc = (D*1E-6 / (gamma(vu)/(apm*local_np*gamma(vu+bpm)))**(1._wp/bpm))**vu + N = ((rho_a*local_np*fc*(D*1E-6)**(-1._wp))/(gamma(vu)*tmp1**vu) * & + exp(-1._wp*fc**(1._wp/vu)/tmp1)) * 1E-12 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'No default value for Dm or Np provided!') + return + endif + + ! ---------------------------------------------------------! + ! Exponential ! + ! N0 = intercept parameter (m^-4) ! + ! ld = slope parameter (um) ! + ! ---------------------------------------------------------! + case(2) + + if(Re>0) then + ld = 1.5_wp/Re ! units 1/um + fc = (ld*1E6)**(1.+bpm)/(apm*gamma(1+bpm))*exp(-1._wp*(ld*1E6)*(D*1E-6))*1E-12 + N = fc*rho_a*(Q*1E-3) + elseif (abs(p1+1) > 1E-8) then + ! Use N0 default value + N0 = p1 + tmp1 = 1._wp/(1._wp+bpm) + fc = ((apm*gamma(1.+bpm)*N0)**tmp1)*(D*1E-6) + N = (N0*exp(-1._wp*fc*(1._wp/(rho_a*Q*1E-3))**tmp1)) * 1E-12 + elseif (abs(p2+1) > 1E-8) then + ! Use default value for lambda + ld = p2 + fc = (ld*1E6)**(1._wp+bpm)/(apm*gamma(1+bpm))*exp(-1._wp*(ld*1E6)*(D*1E-6))*1E-12 + N = fc*rho_a*(Q*1E-3) + else + ! ld "parameterized" from temperature (carry over from original Quickbeam). + ld = 1220._wp*10._wp**(-0.0245_wp*tc)*1E-6 + N0 = ((ld*1E6)**(1._wp+bpm)*Q*1E-3*rho_a)/(apm*gamma(1+bpm)) + N = (N0*exp(-ld*D)) * 1E-12 + endif + + ! ---------------------------------------------------------! + ! Power law ! + ! ahp = Ar parameter (m^-4 mm^-bhp) ! + ! bhp = br parameter ! + ! dmin_mm = lower bound (mm) ! + ! dmax_mm = upper bound (mm) ! + ! ---------------------------------------------------------! + case(3) + + if(Re>0) then + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'Variable Re not supported for Power-Law distribution') + return + elseif(Np>0) then + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'Variable Np not supported for Power-Law distribution') + return + endif + + ! br parameter + if (abs(p1+2) < 1E-8) then + ! if p1=-2, bhp is parameterized according to Ryan (2000), + ! applicatable to cirrus clouds + if (tc < -30) then + bhp = -1.75_wp+0.09_wp*((tc+273._wp)-243.16_wp) + elseif ((tc >= -30) .and. (tc < -9)) then + bhp = -3.25_wp-0.06_wp*((tc+273._wp)-265.66_wp) + else + bhp = -2.15_wp + endif + elseif (abs(p1+3) < 1E-8) then + ! if p1=-3, bhp is parameterized according to Ryan (2000), + ! applicable to frontal clouds + if (tc < -35) then + bhp = -1.75_wp+0.09_wp*((tc+273._wp)-243.16_wp) + elseif ((tc >= -35) .and. (tc < -17.5)) then + bhp = -2.65_wp+0.09_wp*((tc+273._wp)-255.66_wp) + elseif ((tc >= -17.5) .and. (tc < -9)) then + bhp = -3.25_wp-0.06_wp*((tc+273._wp)-265.66_wp) + else + bhp = -2.15_wp + endif + else + ! Otherwise the specified value is used + bhp = p1 + endif + + ! Ar parameter + dmin_mm = dmin*1E-3 + dmax_mm = dmax*1E-3 + + ! Commented lines are original method with constant density + ! rc = 500. ! (kg/m^3) + ! tmp1 = 6*rho_a*(bhp+4) + ! tmp2 = pi*rc*(dmax_mm**(bhp+4))*(1-(dmin_mm/dmax_mm)**(bhp+4)) + ! ahp = (Q*1E-3)*1E12*tmp1/tmp2 + + ! New method is more consistent with the rest of the distributions + ! and allows density to vary with particle size + tmp1 = rho_a*(Q*1E-3)*(bhp+bpm+1) + tmp2 = apm*(dmax_mm**bhp*dmax**(bpm+1)-dmin_mm**bhp*dmin**(bpm+1)) + ahp = tmp1/tmp2 * 1E24 + ! ahp = tmp1/tmp2 + lidx = infind(D,dmin) + uidx = infind(D,dmax) + do k=lidx,uidx + N(k) = (ahp*(D(k)*1E-3)**bhp) * 1E-12 + enddo + + ! ---------------------------------------------------------! + ! Monodisperse ! + ! D0 = particle diameter (um) ! + ! ---------------------------------------------------------! + case(4) + + if (Re>0) then + D0 = Re + else + D0 = p1 + endif + + rho_e = (6._wp/pi)*apm*(D0*1E-6)**(bpm-3) + fc(1) = (6._wp/(pi*D0*D0*D0*rho_e))*1E12 + N(1) = fc(1)*rho_a*(Q*1E-3) + + ! ---------------------------------------------------------! + ! Lognormal ! + ! N0 = total number concentration (m^-3) ! + ! np = fixed number concentration (kg^-1) ! + ! rg = mean radius (um) ! + ! og_sigma_g = ln(geometric standard deviation) ! + ! ---------------------------------------------------------! + case(5) + if (abs(p1+1) < 1E-8 .or. Re>0 ) then + ! rg, log_sigma_g are given + log_sigma_g = p3 + tmp2 = (bpm*log_sigma_g)*(bpm*log_sigma_g) + if(Re.le.0) then + rg = p2 + else + !rg = Re*exp(-2.5*(log_sigma_g*log_sigma_g)) + rg =Re*exp(-2.5_wp*(log_sigma_g**2)) + + endif + + fc = 0.5_wp*((1._wp/((2._wp*rg*1E-6)**(bpm)*apm*(2._wp*pi)**(0.5_wp) * & + log_sigma_g*D*0.5_wp*1E-6))*exp(-0.5_wp*((log(0.5_wp*D/rg)/log_sigma_g)**2._wp+tmp2)))*1E-12 + N = fc*rho_a*(Q*1E-3) + + elseif (abs(p2+1) < 1E-8 .or. Np>0) then + ! Np, log_sigma_g are given + if(Np>0) then + local_Np = Np + else + local_Np = p1 + endif + + log_sigma_g = p3 + N0 = local_np*rho_a + tmp1 = (rho_a*(Q*1E-3))/(2._wp**bpm*apm*N0) + tmp2 = exp(0.5_wp*bpm*bpm*(log_sigma_g))*exp(0.5_wp*bpm*bpm*(log_sigma_g)) + rg = ((tmp1/tmp2)**(1/bpm))*1E6 + + N = 0.5_wp*(N0 / ((2._wp*pi)**(0.5_wp)*log_sigma_g*D*0.5_wp*1E-6) * & + exp((-0.5_wp*(log(0.5_wp*D/rg)/log_sigma_g)**2._wp)))*1E-12 + else + call errorMessage('FATAL ERROR(optics/quickbeam_optics.f90:dsd): '//& + 'Must specify a value for sigma_g') + return + endif + end select + end subroutine dsd + ! ############################################################################################## + ! ############################################################################################## + subroutine zeff(freq,D,N,nsizes,k2,tt,ice,xr,z_eff,z_ray,kr,qe,qs,rho_e) + ! ############################################################################################## + ! Purpose: + ! Simulates radar return of a volume given DSD of spheres + ! Part of QuickBeam v1.03 by John Haynes + ! http://reef.atmos.colostate.edu/haynes/radarsim + ! + ! Inputs: + ! [freq] radar frequency (GHz) + ! [D] discrete drop sizes (um) + ! [N] discrete concentrations (cm^-3 um^-1) + ! [nsizes] number of discrete drop sizes + ! [k2] |K|^2, -1=use frequency dependent default + ! [tt] hydrometeor temperature (K) + ! [ice] indicates volume consists of ice + ! [xr] perform Rayleigh calculations? + ! [qe] if using a mie table, these contain ext/sca ... + ! [qs] ... efficiencies; otherwise set to -1 + ! [rho_e] medium effective density (kg m^-3) (-1 = pure) + ! + ! Outputs: + ! [z_eff] unattenuated effective reflectivity factor (mm^6/m^3) + ! [z_ray] reflectivity factor, Rayleigh only (mm^6/m^3) + ! [kr] attenuation coefficient (db km^-1) + ! + ! Created: + ! 11/28/05 John Haynes (haynes@atmos.colostate.edu) + ! Modified: + ! 12/18/14 Dustin Swales: Define type REALs as double precision (dustin.swales@noaa.gov) + ! ############################################################################################## + ! Inputs + integer, intent(in) :: & + ice, & ! Indicates volume consists of ice + xr, & ! Perform Rayleigh calculations? + nsizes ! Number of discrete drop sizes + real(wp), intent(in),dimension(nsizes) :: & + D, & ! Discrete drop sizes (um) + N, & ! Discrete concentrations (cm^-3 um^-1) + rho_e, & ! Medium effective density (kg m^-3) (-1 = pure) + qe, & ! Extinction efficiency, when using Mie tables + qs ! Scatering efficiency, when using Mie tables + real(wp),intent(in) :: & + freq, & ! Radar frequency (GHz) + tt ! Hydrometeor temperature (K) + real(wp), intent(inout) :: & + k2 ! |K|^2, -1=use frequency dependent default + + ! Outputs + real(wp), intent(out) :: & + z_eff, & ! Unattenuated effective reflectivity factor (mm^6/m^3) + z_ray, & ! Reflectivity factor, Rayleigh only (mm^6/m^3) + kr ! Attenuation coefficient (db km^-1) + + ! Internal Variables + integer :: correct_for_rho ! Correct for density flag + real(wp), dimension(nsizes) :: & + D0, & ! D in (m) + N0, & ! N in m^-3 m^-1 + sizep, & ! Size parameter + qext, & ! Extinction efficiency + qbsca, & ! Backscatter efficiency + f, & ! Ice fraction + xtemp ! + real(wp) :: & + wl, cr,eta_sum,eta_mie,const,z0_eff,z0_ray,k_sum,n_r,n_i,dqv(1),dqsc,dg,dph(1) + complex(wp) :: & + m, & ! Complex index of refraction of bulk form + Xs1(1), Xs2(1) ! + integer :: & + i, err ! + integer, parameter :: & + one=1 ! + real(wp),parameter :: & + conv_d = 1e-6, & ! Conversion factor for drop sizes (to m) + conv_n = 1e12, & ! Conversion factor for drop concentrations (to m^-3) + conv_f = 0.299792458 ! Conversion for radar frequency (to m) + complex(wp),dimension(nsizes) ::& + m0 ! Complex index of refraction + + ! Initialize + z0_ray = 0._wp + + ! Conversions + D0 = d*conv_d + N0 = n*conv_n + wl = conv_f/freq + + ! // dielectric constant |k^2| defaults + if (k2 < 0) then + k2 = 0.933_wp + if (abs(94.-freq) < 3.) k2=0.75_wp + if (abs(35.-freq) < 3.) k2=0.88_wp + if (abs(13.8-freq) < 3.) k2=0.925_wp + endif + + if (qe(1) < -9) then + + ! Get the refractive index of the bulk hydrometeors + if (ice == 0) then + call m_wat(freq,tt,n_r,n_i) + else + call m_ice(freq,tt,n_r,n_i) + endif + m = cmplx(n_r,-n_i) + m0(1:nsizes) = m + + correct_for_rho = 0 + if ((ice == 1) .and. (minval(rho_e) >= 0)) correct_for_rho = 1 + + ! Correct refractive index for ice density if needed + if (correct_for_rho == 1) then + f = rho_e/rhoice + m0 = sqrt((2+(m0*m0)+2*f*((m0*m0)-1))/(2+(m0*m0)+f*(1-(m0*m0)))) + endif + + ! Mie calculations + sizep = (pi*D0)/wl + dqv(1) = 0._wp + do i=1,nsizes + call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), & + dg, xs1, xs2, dph, err) + end do + + else + ! Mie table used + qext = qe + qbsca = qs + endif + + ! eta_mie = 0.25*sum[qbsca*pi*D^2*N(D)*deltaD] + ! <--------- eta_sum ---------> + ! z0_eff = (wl^4/!pi^5)*(1./k2)*eta_mie + eta_sum = 0._wp + if (size(D0) == 1) then + eta_sum = qbsca(1)*(n(1)*1E6)*D0(1)*D0(1) + else + xtemp = qbsca*N0*D0*D0 + call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),eta_sum) + endif + + eta_mie = eta_sum*0.25_wp*pi + const = ((wl*wl*wl*wl)/(pi*pi*pi*pi*pi))*(1._wp/k2) + + z0_eff = const*eta_mie + + ! kr = 0.25*cr*sum[qext*pi*D^2*N(D)*deltaD] + ! <---------- k_sum ---------> + k_sum = 0._wp + if (size(D0) == 1) then + k_sum = qext(1)*(n(1)*1E6)*D0(1)*D0(1) + else + xtemp = qext*N0*D0*D0 + call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),k_sum) + endif + ! DS2014 START: Making this calculation in double precision results in a small + ! amount of very small errors in the COSP output field,dBZE94, + ! so it will be left as is. + !cr = 10._wp/log(10._wp) + cr = 10./log(10.) + ! DS2014 STOP + kr = k_sum*0.25_wp*pi*(1000._wp*cr) + + ! z_ray = sum[D^6*N(D)*deltaD] + if (xr == 1) then + z0_ray = 0._wp + if (size(D0) == 1) then + z0_ray = (n(1)*1E6)*D0(1)*D0(1)*D0(1)*D0(1)*D0(1)*D0(1) + else + xtemp = N0*D0*D0*D0*D0*D0*D0 + call avint(xtemp,D0,nsizes,D0(1),D0(size(D0)),z0_ray) + endif + endif + + ! Convert to mm^6/m^3 + z_eff = z0_eff*1E18 ! 10.*alog10(z0_eff*1E18) + z_ray = z0_ray*1E18 ! 10.*alog10(z0_ray*1E18) + + end subroutine zeff + ! ############################################################################################## + ! ############################################################################################## + function gases(PRES_mb,T,SH,f) + ! ############################################################################################## + ! Purpose: + ! Compute 2-way gaseous attenuation through a volume in microwave + ! + ! Inputs: + ! [PRES_mb] pressure (mb) (hPa) + ! [T] temperature (K) + ! [RH] relative humidity (%) + ! [f] frequency (GHz), < 300 GHz + ! + ! Returns: + ! 2-way gaseous attenuation (dB/km) + ! + ! Reference: + ! Uses method of Liebe (1985) + ! + ! Created: + ! 12/09/05 John Haynes (haynes@atmos.colostate.edu) + ! Modified: + ! 01/31/06 Port from IDL to Fortran 90 + ! 12/19/14 Dustin Swales: Define type REALs as double precision (dustin.swales@noaa.gov) + ! ############################################################################################## + + ! INPUTS + real(wp), intent(in) :: & ! + PRES_mb, & ! Pressure (mb) (hPa) + T, & ! Temperature (K) + SH, & ! Specific humidity + f ! Frequency (GHz), < 300 GHz + + ! PARAMETERS + integer, parameter :: & ! + nbands_o2 = 48, & ! Number of O2 bands + nbands_h2o = 30 ! Number of h2o bands + ! LOCAL VARIABLES + real(wp) :: & + gases, th, e, p, sumo, gm0, a0, ap, term1, & + term2, term3, bf, be, term4, npp,e_th,one_th, & + pth3,eth35,aux1,aux2,aux3, aux4,gm,delt,x,y, & + gm2,fpp_o2,fpp_h2o,s_o2,s_h2o + integer :: i + + ! Table1 parameters v0, a1, a2, a3, a4, a5, a6 + real(wp),dimension(nbands_o2),parameter :: & + v0 = (/49.4523790,49.9622570,50.4742380,50.9877480,51.5033500, & + 52.0214090,52.5423930,53.0669060,53.5957480,54.1299999,54.6711570, & + 55.2213650,55.7838000,56.2647770,56.3378700,56.9681000,57.6124810, & + 58.3238740,58.4465890,59.1642040,59.5909820,60.3060570,60.4347750, & + 61.1505580,61.8001520,62.4112120,62.4862530,62.9979740,63.5685150, & + 64.1277640,64.6789000,65.2240670,65.7647690,66.3020880,66.8368270, & + 67.3695950,67.9008620,68.4310010,68.9603060,69.4890210,70.0173420, & + 118.7503410,368.4983500,424.7631200,487.2493700,715.3931500, & + 773.8387300, 834.1453300/), & + a1 = (/0.0000001,0.0000003,0.0000009,0.0000025,0.0000061,0.0000141, & + 0.0000310,0.0000641,0.0001247,0.0002280,0.0003918,0.0006316,0.0009535, & + 0.0005489,0.0013440,0.0017630,0.0000213,0.0000239,0.0000146,0.0000240, & + 0.0000211,0.0000212,0.0000246,0.0000250,0.0000230,0.0000193,0.0000152, & + 0.0000150,0.0000109,0.0007335,0.0004635,0.0002748,0.0001530,0.0000801, & + 0.0000395,0.0000183,0.0000080,0.0000033,0.0000013,0.0000005,0.0000002, & + 0.0000094,0.0000679,0.0006380,0.0002350,0.0000996,0.0006710,0.0001800/),& + a2 = (/11.8300000,10.7200000,9.6900000,8.8900000,7.7400000,6.8400000, & + 6.0000000,5.2200000,4.4800000,3.8100000,3.1900000,2.6200000,2.1150000, & + 0.0100000,1.6550000,1.2550000,0.9100000,0.6210000,0.0790000,0.3860000, & + 0.2070000,0.2070000,0.3860000,0.6210000,0.9100000,1.2550000,0.0780000, & + 1.6600000,2.1100000,2.6200000,3.1900000,3.8100000,4.4800000,5.2200000, & + 6.0000000,6.8400000,7.7400000,8.6900000,9.6900000,10.7200000,11.8300000,& + 0.0000000,0.0200000,0.0110000,0.0110000,0.0890000,0.0790000,0.0790000/),& + a3 = (/0.0083000,0.0085000,0.0086000,0.0087000,0.0089000,0.0092000, & + 0.0094000,0.0097000,0.0100000,0.0102000,0.0105000,0.0107900,0.0111000, & + 0.0164600,0.0114400,0.0118100,0.0122100,0.0126600,0.0144900,0.0131900, & + 0.0136000,0.0138200,0.0129700,0.0124800,0.0120700,0.0117100,0.0146800, & + 0.0113900,0.0110800,0.0107800,0.0105000,0.0102000,0.0100000,0.0097000, & + 0.0094000,0.0092000,0.0089000,0.0087000,0.0086000,0.0085000,0.0084000, & + 0.0159200,0.0192000,0.0191600,0.0192000,0.0181000,0.0181000,0.0181000/),& + a4 = (/0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, & + 0.0000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000/),& + a5 = (/0.0056000,0.0056000,0.0056000,0.0055000,0.0056000,0.0055000, & + 0.0057000,0.0053000,0.0054000,0.0048000,0.0048000,0.0041700,0.0037500, & + 0.0077400,0.0029700,0.0021200,0.0009400,-0.0005500,0.0059700,-0.0024400,& + 0.0034400,-0.0041300,0.0013200,-0.0003600,-0.0015900,-0.0026600, & + -0.0047700,-0.0033400,-0.0041700,-0.0044800,-0.0051000,-0.0051000, & + -0.0057000,-0.0055000,-0.0059000,-0.0056000,-0.0058000,-0.0057000, & + -0.0056000,-0.0056000,-0.0056000,-0.0004400,0.0000000,0.0000000, & + 0.0000000,0.0000000,0.0000000,0.0000000/), & + a6 = (/1.7000000,1.7000000,1.7000000,1.7000000,1.8000000,1.8000000, & + 1.8000000,1.9000000,1.8000000,2.0000000,1.9000000,2.1000000,2.1000000, & + 0.9000000,2.3000000,2.5000000,3.7000000,-3.1000000,0.8000000,0.1000000, & + 0.5000000,0.7000000,-1.0000000,5.8000000,2.9000000,2.3000000,0.9000000, & + 2.2000000,2.0000000,2.0000000,1.8000000,1.9000000,1.8000000,1.8000000, & + 1.7000000,1.8000000,1.7000000,1.7000000,1.7000000,1.7000000,1.7000000, & + 0.9000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000/) + + ! Table2 parameters v1, b1, b2, b3 + real(wp),dimension(nbands_h2o),parameter :: & + v1 = (/22.2350800,67.8139600,119.9959400,183.3101170,321.2256440, & + 325.1529190,336.1870000,380.1973720,390.1345080,437.3466670,439.1508120, & + 443.0182950,448.0010750,470.8889740,474.6891270,488.4911330,503.5685320, & + 504.4826920,556.9360020,620.7008070,658.0065000,752.0332270,841.0735950, & + 859.8650000,899.4070000,902.5550000,906.2055240,916.1715820,970.3150220, & + 987.9267640/), & + b1 = (/0.1090000,0.0011000,0.0007000,2.3000000,0.0464000,1.5400000, & + 0.0010000,11.9000000,0.0044000,0.0637000,0.9210000,0.1940000,10.6000000, & + 0.3300000,1.2800000,0.2530000,0.0374000,0.0125000,510.0000000,5.0900000, & + 0.2740000,250.0000000,0.0130000,0.1330000,0.0550000,0.0380000,0.1830000, & + 8.5600000,9.1600000,138.0000000/), & + b2 = (/2.1430000,8.7300000,8.3470000,0.6530000,6.1560000,1.5150000, & + 9.8020000,1.0180000,7.3180000,5.0150000,3.5610000,5.0150000,1.3700000, & + 3.5610000,2.3420000,2.8140000,6.6930000,6.6930000,0.1140000,2.1500000, & + 7.7670000,0.3360000,8.1130000,7.9890000,7.8450000,8.3600000,5.0390000, & + 1.3690000,1.8420000,0.1780000/), & + b3 = (/0.0278400,0.0276000,0.0270000,0.0283500,0.0214000,0.0270000, & + 0.0265000,0.0276000,0.0190000,0.0137000,0.0164000,0.0144000,0.0238000, & + 0.0182000,0.0198000,0.0249000,0.0115000,0.0119000,0.0300000,0.0223000, & + 0.0300000,0.0286000,0.0141000,0.0286000,0.0286000,0.0264000,0.0234000, & + 0.0253000,0.0240000,0.0286000/) + + ! Conversions + th = 300._wp/T ! unitless + + ! DS2014 START: Using _wp for the exponential in the denominator results in slight errors + ! for dBze94. 0.01 % of values differ, relative range: 1.03e-05 to 1.78e-04 + !e = (RH*th*th*th*th*th)/(41.45_wp*10**(9.834_wp*th-10)) ! kPa + !e = (RH*th*th*th*th*th)/(41.45_wp*10**(9.834_wp*th-10)) ! kPa + e = SH*PRES_mb/(SH+0.622_wp)/1000._wp !kPa + ! DS2014 END + + p = PRES_mb/1000._wp-e ! kPa + e_th = e*th + one_th = 1 - th + pth3 = p*th*th*th + eth35 = e*th**(3.5) + + ! Term1 + sumo = 0._wp + aux1 = 1.1_wp*e_th + do i=1,nbands_o2 + aux2 = f/v0(i) + aux3 = v0(i)-f + aux4 = v0(i)+f + gm = a3(i)*(p*th**(0.8_wp-a4(i))+aux1) + gm2 = gm*gm + delt = a5(i)*p*th**a6(i) + x = aux3*aux3+gm2 + y = aux4*aux4+gm2 + fpp_o2 = (((1._wp/x)+(1._wp/y))*(gm*aux2) - (delt*aux2)*((aux3/(x))-(aux4/(x)))) + s_o2 = a1(i)*pth3*exp(a2(i)*one_th) + sumo = sumo + fpp_o2 * s_o2 + enddo + term1 = sumo + + ! Term2 + gm0 = 5.6E-3_wp*(p+1.1_wp*e)*th**(0.8_wp) + a0 = 3.07E-4_wp + ap = 1.4_wp*(1-1.2_wp*f**(1.5_wp)*1E-5)*1E-10 + term2 = (2*a0*(gm0*(1+(f/gm0)*(f/gm0))*(1+(f/60._wp)**2))**(-1) + ap*p*th**(2.5_wp))*f*p*th*th + + ! Term3 + sumo = 0._wp + aux1 = 4.8_wp*e_th + do i=1,nbands_h2o + aux2 = f/v1(i) + aux3 = v1(i)-f + aux4 = v1(i)+f + gm = b3(i)*(p*th**(0.8)+aux1) + gm2 = gm*gm + x = aux3*aux3+gm2 + y = aux4*aux4+gm2 + fpp_h2o = ((1._wp/x)+(1._wp/y))*(gm*aux2) ! - (delt*aux2)*((aux3/(x))-(aux4/(x))) + s_h2o = b1(i)*eth35*exp(b2(i)*one_th) + sumo = sumo + fpp_h2o * s_h2o + enddo + term3 = sumo + + ! Term4 + bf = 1.4E-6_wp + be = 5.41E-5_wp + term4 = (bf*p+be*e*th*th*th)*f*e*th**(2.5_wp) + + ! Summation and result + npp = term1 + term2 + term3 + term4 + gases = 0.182_wp*f*npp + + end function gases + subroutine hydro_class_init(lsingle,ldouble,sd) + ! ############################################################################################## + ! Purpose: + ! + ! Initialize variables used by the radar simulator. + ! Part of QuickBeam v3.0 by John Haynes and Roj Marchand + ! + ! Inputs: + ! NAME SIZE DESCRIPTION + ! [lsingle] (1) Logical flag to use single moment + ! [ldouble] (1) Logical flag to use two moment + ! Outputs: + ! [sd] Structure that define hydrometeor types + ! + ! Local variables: + ! [n_hydro] (1) Number of hydrometeor types + ! [hclass_type] (nhclass) Type of distribution (see quickbeam documentation) + ! [hclass_phase] (nhclass) 1==ice, 0=liquid + ! [hclass_dmin] (nhclass) Minimum diameter allowed is drop size distribution N(DDmax)=0 + ! [hclass_apm] (nhclass) Density of partical apm*D^bpm or constant = rho + ! [hclass_bpm] (nhclass) Density of partical apm*D^bpm or constant = rho + ! [hclass_rho] (nhclass) Density of partical apm*D^bpm or constant = rho + ! [hclass_p1] (nhclass) Default values of DSD parameters (see quickbeam documentation) + ! [hclass_p2] (nhclass) Default values of DSD parameters (see quickbeam documentation) + ! [hclass_p3] (nhclass) Default values of DSD parameters (see quickbeam documentation) + ! Modified: + ! 08/23/2006 placed into subroutine form (Roger Marchand) + ! June 2010 New interface to support "radar_simulator_params" structure + ! 12/22/2014 Moved radar simulator (CLOUDSAT) configuration initialization to cloudsat_init + ! ############################################################################################## + + ! #################################################################################### + ! NOTES on HCLASS variables + ! + ! TYPE - Set to + ! 1 for modified gamma distribution, + ! 2 for exponential distribution, + ! 3 for power law distribution, + ! 4 for monodisperse distribution, + ! 5 for lognormal distribution. + ! + ! PHASE - Set to 0 for liquid, 1 for ice. + ! DMIN - The minimum drop size for this class (micron), ignored for monodisperse. + ! DMAX - The maximum drop size for this class (micron), ignored for monodisperse. + ! Important note: The settings for DMIN and DMAX are + ! ignored in the current version for all distributions except for power + ! law. Except when the power law distribution is used, particle size + ! is fixed to vary from zero to infinity, a restriction that is expected + ! to be lifted in future versions. A placeholder must still be specified + ! for each. + ! Density of particles is given by apm*D^bpm or a fixed value rho. ONLY specify ONE of these two!! + ! APM - The alpha_m coefficient in equation (1) (kg m**-beta_m ) + ! BPM - The beta_m coefficient in equation (1), see section 4.1. + ! RHO - Hydrometeor density (kg m-3 ). + ! + ! P1, P2, P3 - are default distribution parameters that depend on the type + ! of distribution (see quickmbeam documentation for more information) + ! + ! Modified Gamma (must set P3 and one of P1 or P2) + ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ), where + ! rho_a is the density of air in the radar volume. + ! P2 - Set to the particle mean diameter D (micron). + ! P3 - Set to the distribution width nu. + ! + ! Exponetial (set one of) + ! P1 - Set to a constant intercept parameter N0 (m-4). + ! P2 - Set to a constant lambda (micron-1). + ! + ! Power Law + ! P1 - Set this to the value of a constant power law parameter br + ! + ! Monodisperse + ! P1 - Set to a constant diameter D0 (micron) = Re. + ! + ! Log-normal (must set P3 and one of P1 or P2) + ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ) + ! P2 - Set to the geometric mean particle radius rg (micron). + ! P3 - Set to the natural logarithm of the geometric standard deviation. + ! #################################################################################### + ! INPUTS + logical,intent(in) :: & + lsingle, & ! True -> use single moment + ldouble ! True -> use two moment + + ! OUTPUTS + type(size_distribution),intent(out) ::& + sd ! + + ! SINGLE MOMENT PARAMETERS + integer,parameter,dimension(N_HYDRO) :: & + ! LSL LSI LSR LSS CVL CVI CVR CVS LSG + HCLASS1_TYPE = (/5, 1, 2, 2, 5, 1, 2, 2, 2/), & ! + HCLASS1_PHASE = (/0, 1, 0, 1, 0, 1, 0, 1, 1/) ! + real(wp),parameter,dimension(N_HYDRO) ::& + ! LSL LSI LSR LSS CVL CVI CVR CVS LSG + HCLASS1_DMIN = (/ -1., -1., -1., -1., -1., -1., -1., -1., -1. /), & + HCLASS1_DMAX = (/ -1., -1., -1., -1., -1., -1., -1., -1., -1. /), & + HCLASS1_APM = (/524., 110.8, 524., -1., 524., 110.8, 524., -1., -1. /), & + HCLASS1_BPM = (/ 3., 2.91, 3., -1., 3., 2.91, 3., -1., -1. /), & + HCLASS1_RHO = (/ -1., -1., -1., 100., -1., -1., -1., 100., 400. /), & + HCLASS1_P1 = (/ -1., -1., 8.e6, 3.e6, -1., -1., 8.e6, 3.e6, 4.e6/), & + HCLASS1_P2 = (/ 6., 40., -1., -1., 6., 40., -1., -1., -1. /), & + HCLASS1_P3 = (/ 0.3, 2., -1., -1., 0.3, 2., -1., -1., -1. /) + + ! TWO MOMENT PARAMETERS + integer,parameter,dimension(N_HYDRO) :: & + ! LSL LSI LSR LSS CVL CVI CVR CVS LSG + HCLASS2_TYPE = (/ 1, 1, 1, 1, 1, 1, 1, 1, 1/), & + HCLASS2_PHASE = (/ 0, 1, 0, 1, 0, 1, 0, 1, 1/) + + real(wp),parameter,dimension(N_HYDRO) :: & + ! LSL LSI LSR LSS CVL CVI CVR CVS LSG + HCLASS2_DMIN = (/ -1, -1, -1, -1, -1, -1, -1, -1, -1/), & + HCLASS2_DMAX = (/ -1, -1, -1, -1, -1, -1, -1, -1, -1/), & + HCLASS2_APM = (/524, -1, 524, -1, 524, -1, 524, -1, -1/), & + HCLASS2_BPM = (/ 3, -1, 3, -1, 3, -1, 3, -1, -1/), & + HCLASS2_RHO = (/ -1, 500, -1, 100, -1, 500, -1, 100, 900/), & + HCLASS2_P1 = (/ -1, -1, -1, -1, -1, -1, -1, -1, -1/), & + HCLASS2_P2 = (/ -1, -1, -1, -1, -1, -1, -1, -1, -1/), & + HCLASS2_P3 = (/ -2, 1, 1, 1, -2, 1, 1, 1, 1/) + + if (lsingle) then + sd%dtype(1:N_HYDRO) = HCLASS1_TYPE(1:N_HYDRO) + sd%phase(1:N_HYDRO) = HCLASS1_PHASE(1:N_HYDRO) + sd%dmin(1:N_HYDRO) = HCLASS1_DMIN(1:N_HYDRO) + sd%dmax(1:N_HYDRO) = HCLASS1_DMAX(1:N_HYDRO) + sd%apm(1:N_HYDRO) = HCLASS1_APM(1:N_HYDRO) + sd%bpm(1:N_HYDRO) = HCLASS1_BPM(1:N_HYDRO) + sd%rho(1:N_HYDRO) = HCLASS1_RHO(1:N_HYDRO) + sd%p1(1:N_HYDRO) = HCLASS1_P1(1:N_HYDRO) + sd%p2(1:N_HYDRO) = HCLASS1_P2(1:N_HYDRO) + sd%p3(1:N_HYDRO) = HCLASS1_P3(1:N_HYDRO) + endif + if (ldouble) then + sd%dtype(1:N_HYDRO) = HCLASS2_TYPE(1:N_HYDRO) + sd%phase(1:N_HYDRO) = HCLASS2_PHASE(1:N_HYDRO) + sd%dmin(1:N_HYDRO) = HCLASS2_DMIN(1:N_HYDRO) + sd%dmax(1:N_HYDRO) = HCLASS2_DMAX(1:N_HYDRO) + sd%apm(1:N_HYDRO) = HCLASS2_APM(1:N_HYDRO) + sd%bpm(1:N_HYDRO) = HCLASS2_BPM(1:N_HYDRO) + sd%rho(1:N_HYDRO) = HCLASS2_RHO(1:N_HYDRO) + sd%p1(1:N_HYDRO) = HCLASS2_P1(1:N_HYDRO) + sd%p2(1:N_HYDRO) = HCLASS2_P2(1:N_HYDRO) + sd%p3(1:N_HYDRO) = HCLASS2_P3(1:N_HYDRO) + endif + end subroutine hydro_class_init +end module mod_quickbeam_optics diff --git a/src/physics/cosp2/subcol/mo_rng.F90 b/src/physics/cosp2/subcol/mo_rng.F90 new file mode 100644 index 0000000000..e783889389 --- /dev/null +++ b/src/physics/cosp2/subcol/mo_rng.F90 @@ -0,0 +1,151 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2015, Regents of the University of Colorado +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015- D. Swales - Original version +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +MODULE mod_rng + USE cosp_kinds, ONLY: dp, sp, wp + IMPLICIT NONE + + INTEGER, parameter :: ki9 = selected_int_kind(R=9) + integer :: testInt + + TYPE rng_state + INTEGER(ki9) :: seed ! 32 bit integer + END TYPE rng_state + + INTERFACE init_rng + MODULE PROCEDURE init_rng_1, init_rng_n + END INTERFACE init_rng + + INTERFACE get_rng + MODULE PROCEDURE get_rng_1, get_rng_n, get_rng_v + END INTERFACE get_rng + +CONTAINS + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Set single seed + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE init_rng_1(s, seed_in) + TYPE(rng_state), INTENT(INOUT) :: s + INTEGER, INTENT(IN ) :: seed_in + s%seed = seed_in + END SUBROUTINE init_rng_1 + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Set vector of seeds + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + SUBROUTINE init_rng_n(s, seed_in) + TYPE(rng_state), DIMENSION(:), INTENT(INOUT) :: s + INTEGER, DIMENSION(:), INTENT(IN ) :: seed_in + + INTEGER :: i + DO i = 1, SIZE(seed_in) + s(i)%seed = seed_in(i) + END DO + END SUBROUTINE init_rng_n + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Create single random number from seed + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + FUNCTION get_rng_1(s) + TYPE(rng_state), INTENT(INOUT) :: s + REAL(WP) :: get_rng_1 + REAL(SP) :: r + + integer, parameter :: i8 = selected_int_kind(13) + logical :: bigendian + + bigendian = (transfer(1_i8, 1) == 0) + + ! Return the next random numbers + + ! Marsaglia CONG algorithm + if (bigendian) then + ! Get low bytes from big-endian machine without overflow. + s%seed = transfer(ishft(69069_i8*s%seed+1234567, bit_size(1)), 1) + else + ! Get low bytes from little-endian machine without overflow. + s%seed = transfer(69069_i8*s%seed+1234567, 1) + end if + + ! mod 32 bit overflow + s%seed=mod(s%seed,2_ki9**30_ki9) + r = s%seed*0.931322574615479E-09 + + ! convert to range 0-1 (32 bit only) + ! DJS2016: What is being done here is an intentional integer overflow and a test to + ! see if this occured. Some compilers check for integer overflows during + ! compilation (ie. gfortan), while others do not (ie. pgi and ifort). When + ! using gfortran, you cannot use the overflow and test for overflow method, + ! so we use sizeof(someInt) to determine wheter it is on 32 bit. + !if ( i2_16*i2_16 .le. huge32 ) then + if (digits(testInt) .le. 31) then + !if (sizeof(testInt) .eq. 4) then + r=r+1 + r=r-int(r) + endif + get_rng_1 = REAL(r, KIND = WP) + + END FUNCTION get_rng_1 + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Create single random number N times + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + FUNCTION get_rng_n(s, n) RESULT (r) + integer,intent(inout) :: n + TYPE(rng_state),INTENT(INOUT) :: s + ! Return the next N random numbers + REAL(WP), DIMENSION (n) :: r + + INTEGER :: i + + DO i = 1, N + r(i) = get_rng_1(s) + END DO + END FUNCTION get_rng_n + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Create a vector of random numbers from a vector of input seeds + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + FUNCTION get_rng_v(s) RESULT (r) + ! Return the next N random numbers + TYPE(rng_state), DIMENSION(:), INTENT(INOUT) :: s + REAL(WP), DIMENSION (SIZE(S)) :: r + + INTEGER :: i + + DO i = 1, size(s) + r(i) = get_rng_1(s(i)) + END DO + END FUNCTION get_rng_v + +END MODULE mod_rng diff --git a/src/physics/cosp2/subcol/prec_scops.F90 b/src/physics/cosp2/subcol/prec_scops.F90 new file mode 100644 index 0000000000..3cd19e3ca0 --- /dev/null +++ b/src/physics/cosp2/subcol/prec_scops.F90 @@ -0,0 +1,277 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2008, Lawrence Livermore National Security Limited Liability Corporation +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History: +! May 2015- D. Swales - Modified for COSPv2.0 +! +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module mod_prec_scops + implicit none +contains + + subroutine prec_scops(npoints,nlev,ncol,ls_p_rate,cv_p_rate,frac_out,prec_frac) + + USE COSP_KINDS, ONLY: wp + use mod_cosp_config, ONLY: scops_ccfrac + + INTEGER npoints ! number of model points in the horizontal + INTEGER nlev ! number of model levels in column + INTEGER ncol ! number of subcolumns + + INTEGER j,ilev,ibox,cv_col + + REAL(WP) ls_p_rate(npoints,nlev),cv_p_rate(npoints,nlev) + + REAL(WP) frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into + ! Equivalent of BOX in original version, but + ! indexed by column then row, rather than + ! by row then column + !TOA to SURFACE!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + REAL(WP) prec_frac(npoints,ncol,nlev) ! 0 -> clear sky + ! 1 -> LS precipitation + ! 2 -> CONV precipitation + ! 3 -> both + !TOA to SURFACE!!!!!!!!!!!!!!!!!! + + INTEGER flag_ls, flag_cv + INTEGER frac_out_ls(npoints,ncol),frac_out_cv(npoints,ncol) !flag variables for + ! stratiform cloud and convective cloud in the vertical column + + cv_col = scops_ccfrac*ncol + if (cv_col .eq. 0) cv_col=1 + + do ilev=1,nlev + do ibox=1,ncol + do j=1,npoints + prec_frac(j,ibox,ilev) = 0 + enddo + enddo + enddo + + do j=1,npoints + do ibox=1,ncol + frac_out_ls(j,ibox)=0 + frac_out_cv(j,ibox)=0 + flag_ls=0 + flag_cv=0 + do ilev=1,nlev + if (frac_out(j,ibox,ilev) .eq. 1) then + flag_ls=1 + endif + if (frac_out(j,ibox,ilev) .eq. 2) then + flag_cv=1 + endif + enddo !loop over nlev + if (flag_ls .eq. 1) then + frac_out_ls(j,ibox)=1 + endif + if (flag_cv .eq. 1) then + frac_out_cv(j,ibox)=1 + endif + enddo ! loop over ncol + enddo ! loop over npoints + +! initialize the top layer + do j=1,npoints + flag_ls=0 + flag_cv=0 + + if (ls_p_rate(j,1) .gt. 0.) then + do ibox=1,ncol ! possibility ONE + if (frac_out(j,ibox,1) .eq. 1) then + prec_frac(j,ibox,1) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + if (flag_ls .eq. 0) then ! possibility THREE + do ibox=1,ncol + if (frac_out(j,ibox,2) .eq. 1) then + prec_frac(j,ibox,1) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + endif + if (flag_ls .eq. 0) then ! possibility Four + do ibox=1,ncol + if (frac_out_ls(j,ibox) .eq. 1) then + prec_frac(j,ibox,1) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + endif + if (flag_ls .eq. 0) then ! possibility Five + do ibox=1,ncol + ! prec_frac(j,1:ncol,1) = 1 + prec_frac(j,ibox,1) = 1 + enddo ! loop over ncol + endif + endif + ! There is large scale precipitation + + if (cv_p_rate(j,1) .gt. 0.) then + do ibox=1,ncol ! possibility ONE + if (frac_out(j,ibox,1) .eq. 2) then + if (prec_frac(j,ibox,1) .eq. 0) then + prec_frac(j,ibox,1) = 2 + else + prec_frac(j,ibox,1) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + if (flag_cv .eq. 0) then ! possibility THREE + do ibox=1,ncol + if (frac_out(j,ibox,2) .eq. 2) then + if (prec_frac(j,ibox,1) .eq. 0) then + prec_frac(j,ibox,1) = 2 + else + prec_frac(j,ibox,1) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + endif + if (flag_cv .eq. 0) then ! possibility Four + do ibox=1,ncol + if (frac_out_cv(j,ibox) .eq. 1) then + if (prec_frac(j,ibox,1) .eq. 0) then + prec_frac(j,ibox,1) = 2 + else + prec_frac(j,ibox,1) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + endif + if (flag_cv .eq. 0) then ! possibility Five + do ibox=1,cv_col + if (prec_frac(j,ibox,1) .eq. 0) then + prec_frac(j,ibox,1) = 2 + else + prec_frac(j,ibox,1) = 3 + endif + enddo !loop over cv_col + endif + endif + ! There is convective precipitation + + enddo ! loop over npoints +! end of initializing the top layer + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! working on the levels from top to surface + do ilev=2,nlev + do j=1,npoints + flag_ls=0 + flag_cv=0 + + if (ls_p_rate(j,ilev) .gt. 0.) then + do ibox=1,ncol ! possibility ONE&TWO + if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1) & + .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then + prec_frac(j,ibox,ilev) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE + do ibox=1,ncol + if (frac_out(j,ibox,ilev+1) .eq. 1) then + prec_frac(j,ibox,ilev) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + endif + if (flag_ls .eq. 0) then ! possibility Four + do ibox=1,ncol + if (frac_out_ls(j,ibox) .eq. 1) then + prec_frac(j,ibox,ilev) = 1 + flag_ls=1 + endif + enddo ! loop over ncol + endif + if (flag_ls .eq. 0) then ! possibility Five + do ibox=1,ncol +! prec_frac(j,1:ncol,ilev) = 1 + prec_frac(j,ibox,ilev) = 1 + enddo ! loop over ncol + endif + endif ! There is large scale precipitation + + if (cv_p_rate(j,ilev) .gt. 0.) then + do ibox=1,ncol ! possibility ONE&TWO + if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2) & + .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then + if (prec_frac(j,ibox,ilev) .eq. 0) then + prec_frac(j,ibox,ilev) = 2 + else + prec_frac(j,ibox,ilev) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE + do ibox=1,ncol + if (frac_out(j,ibox,ilev+1) .eq. 2) then + if (prec_frac(j,ibox,ilev) .eq. 0) then + prec_frac(j,ibox,ilev) = 2 + else + prec_frac(j,ibox,ilev) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + endif + if (flag_cv .eq. 0) then ! possibility Four + do ibox=1,ncol + if (frac_out_cv(j,ibox) .eq. 1) then + if (prec_frac(j,ibox,ilev) .eq. 0) then + prec_frac(j,ibox,ilev) = 2 + else + prec_frac(j,ibox,ilev) = 3 + endif + flag_cv=1 + endif + enddo ! loop over ncol + endif + if (flag_cv .eq. 0) then ! possibility Five + do ibox=1,cv_col + if (prec_frac(j,ibox,ilev) .eq. 0) then + prec_frac(j,ibox,ilev) = 2 + else + prec_frac(j,ibox,ilev) = 3 + endif + enddo !loop over cv_col + endif + endif ! There is convective precipitation + + enddo ! loop over npoints + enddo ! loop over nlev + + end subroutine prec_scops +end module mod_prec_scops diff --git a/src/physics/cosp2/subcol/scops.F90 b/src/physics/cosp2/subcol/scops.F90 new file mode 100644 index 0000000000..c7682a25fc --- /dev/null +++ b/src/physics/cosp2/subcol/scops.F90 @@ -0,0 +1,240 @@ +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +! Copyright (c) 2009, British Crown Copyright, the Met Office +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of +! conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list +! of conditions and the following disclaimer in the documentation and/or other +! materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be +! used to endorse or promote products derived from this software without specific prior +! written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! History +! May 2015 - D. Swales - Modified for COSPv2.0 +! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +module mod_scops + USE COSP_KINDS, ONLY: wp + USE MOD_RNG!, ONLY: rng_state,get_rng + use mod_cosp_error, ONLY: errorMessage + + implicit none + + integer,parameter :: default_overlap = 3 ! Used when invalid overlap assumption is provided. + +contains + subroutine scops(npoints,nlev,ncol,rngs,cc,conv,overlap,frac_out,ncolprint) + INTEGER :: npoints, & ! Number of model points in the horizontal + nlev, & ! Number of model levels in column + ncol, & ! Number of subcolumns + overlap ! Overlap type (1=max, 2=rand, 3=max/rand) + type(rng_state),dimension(npoints) :: rngs + INTEGER, parameter :: huge32 = 2147483647 + INTEGER, parameter :: i2_16 = 65536 + INTEGER :: i,j,ilev,ibox,ncolprint,ilev2 + + REAL(WP), dimension(npoints,nlev) :: & + cc, & ! Input cloud cover in each model level (fraction) + ! NOTE: This is the HORIZONTAL area of each + ! grid box covered by clouds + conv, & ! Input convective cloud cover in each model level (fraction) + ! NOTE: This is the HORIZONTAL area of each + ! grid box covered by convective clouds + tca ! Total cloud cover in each model level (fraction) + ! with extra layer of zeroes on top + ! in this version this just contains the values input + ! from cc but with an extra level + REAL(WP),intent(inout), dimension(npoints,ncol,nlev) :: & + frac_out ! Boxes gridbox divided up into equivalent of BOX in + ! original version, but indexed by column then row, rather than + ! by row then column + REAL(WP), dimension(npoints,ncol) :: & + threshold, & ! pointer to position in gridbox + maxocc, & ! Flag for max overlapped conv cld + maxosc, & ! Flag for max overlapped strat cld + boxpos, & ! ordered pointer to position in gridbox + threshold_min ! minimum value to define range in with new threshold is chosen. + REAL(WP), dimension(npoints) :: & + ran ! vector of random numbers + + ! Test for valid input overlap assumption + if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne. 3) then + overlap=default_overlap + call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)') + endif + + boxpos = spread(([(i, i=1,ncol)]-0.5)/ncol,1,npoints) + + ! ####################################################################### + ! Initialize working variables + ! ####################################################################### + + ! Initialize frac_out to zero + frac_out(1:npoints,1:ncol,1:nlev)=0.0 + + ! Assign 2d tca array using 1d input array cc + tca(1:npoints,1:nlev) = cc(1:npoints,1:nlev) + + if (ncolprint.ne.0) then + write (6,'(a)') 'frac_out_pp_rev:' + do j=1,npoints,1000 + write(6,'(a10)') 'j=' + write(6,'(8I10)') j + write (6,'(8f5.2)') ((frac_out(j,ibox,ilev),ibox=1,ncolprint),ilev=1,nlev) + enddo + write (6,'(a)') 'ncol:' + write (6,'(I3)') ncol + endif + if (ncolprint.ne.0) then + write (6,'(a)') 'last_frac_pp:' + do j=1,npoints,1000 + write(6,'(a10)') 'j=' + write(6,'(8I10)') j + write (6,'(8f5.2)') (tca(j,1)) + enddo + endif + + ! ####################################################################### + ! ALLOCATE CLOUD INTO BOXES, FOR NCOLUMNS, NLEVELS + ! frac_out is the array that contains the information + ! where 0 is no cloud, 1 is a stratiform cloud and 2 is a + ! convective cloud + ! ####################################################################### + + ! Loop over vertical levels + DO ilev = 1,nlev + + ! Initialise threshold + IF (ilev.eq.1) then + ! If max overlap + IF (overlap.eq.1) then + ! Select pixels spread evenly across the gridbox + threshold(1:npoints,1:ncol)=boxpos(1:npoints,1:ncol) + ELSE + DO ibox=1,ncol + !include 'congvec.f90' + ran(1:npoints) = get_rng(RNGS) + ! select random pixels from the non-convective + ! part the gridbox ( some will be converted into + ! convective pixels below ) + threshold(1:npoints,ibox) = conv(1:npoints,ilev)+(1-conv(1:npoints,ilev))*ran(npoints) + enddo + ENDIF + IF (ncolprint.ne.0) then + write (6,'(a)') 'threshold_nsf2:' + do j=1,npoints,1000 + write(6,'(a10)') 'j=' + write(6,'(8I10)') j + write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint) + enddo + ENDIF + ENDIF + + IF (ncolprint.ne.0) then + write (6,'(a)') 'ilev:' + write (6,'(I2)') ilev + ENDIF + + DO ibox=1,ncol + ! All versions + !maxocc(1:npoints,ibox) = merge(1,0,boxpos(1:npoints,ibox) .le. conv(1:npoints,ilev)) + !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox)) + do j=1,npoints + if (boxpos(j,ibox).le.conv(j,ilev)) then + maxocc(j,ibox) = 1 + else + maxocc(j,ibox) = 0 + end if + enddo + + ! Max overlap + if (overlap.eq.1) then + threshold_min(1:npoints,ibox) = conv(1:npoints,ilev) + maxosc(1:npoints,ibox) = 1 + endif + + ! Random overlap + if (overlap.eq.2) then + threshold_min(1:npoints,ibox) = conv(1:npoints,ilev) + maxosc(1:npoints,ibox) = 0 + endif + ! Max/Random overlap + if (overlap.eq.3) then + ! DS2014 START: The bounds on tca are not valid when ilev=1. + !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev))) + !maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. & + ! min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. & + ! (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev))) + if (ilev .ne. 1) then + threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev))) + maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. & + min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. & + (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev))) + else + threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(0._wp,tca(1:npoints,ilev))) + maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. & + min(0._wp,tca(1:npoints,ilev)) .and. & + (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev))) + endif + endif + + ! Reset threshold + !include 'congvec.f90' + ran(1:npoints) = get_rng(RNGS) + + threshold(1:npoints,ibox)= maxocc(1:npoints,ibox)*(boxpos(1:npoints,ibox)) + & + (1-maxocc(1:npoints,ibox))*((maxosc(1:npoints,ibox))*(threshold(1:npoints,ibox)) + & + (1-maxosc(1:npoints,ibox))*(threshold_min(1:npoints,ibox)+ & + (1-threshold_min(1:npoints,ibox))*ran(1:npoints))) + + ! Fill frac_out with 1's where tca is greater than the threshold + frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev).gt.threshold(1:npoints,ibox)) + + ! Code to partition boxes into startiform and convective parts goes here + where(threshold(1:npoints,ibox).le.conv(1:npoints,ilev) .and. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2 + ENDDO ! ibox + + + ! Set last_frac to tca at this level, so as to be tca from last level next time round + if (ncolprint.ne.0) then + do j=1,npoints ,1000 + write(6,'(a10)') 'j=' + write(6,'(8I10)') j + write (6,'(a)') 'last_frac:' + write (6,'(8f5.2)') (tca(j,ilev)) + write (6,'(a)') 'conv:' + write (6,'(8f5.2)') (conv(j,ilev),ibox=1,ncolprint) + write (6,'(a)') 'max_overlap_cc:' + write (6,'(8f5.2)') (maxocc(j,ibox),ibox=1,ncolprint) + write (6,'(a)') 'max_overlap_sc:' + write (6,'(8f5.2)') (maxosc(j,ibox),ibox=1,ncolprint) + write (6,'(a)') 'threshold_min_nsf2:' + write (6,'(8f5.2)') (threshold_min(j,ibox),ibox=1,ncolprint) + write (6,'(a)') 'threshold_nsf2:' + write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint) + write (6,'(a)') 'frac_out_pp_rev:' + write (6,'(8f5.2)') ((frac_out(j,ibox,ilev2),ibox=1,ncolprint),ilev2=1,nlev) + enddo + endif + + enddo ! Loop over nlev + + ! END + end subroutine scops +end module mod_scops diff --git a/src/physics/rrtmg/aer_src/mcica_subcol_gen_lw.f90 b/src/physics/rrtmg/aer_src/mcica_subcol_gen_lw.f90 new file mode 100644 index 0000000000..617ce8bd92 --- /dev/null +++ b/src/physics/rrtmg/aer_src/mcica_subcol_gen_lw.f90 @@ -0,0 +1,425 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/mcica_subcol_gen_lw.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.3 $ +! created: $Date: 2007/08/28 22:38:11 $ +! + +module mcica_subcol_gen_lw + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! Purpose: Create McICA stochastic arrays for cloud physical or optical properties. +! Two options are possible: +! 1) Input cloud physical properties: cloud fraction, ice and liquid water +! paths, ice fraction, and particle sizes. Output will be stochastic +! arrays of these variables. (inflag = 1) +! 2) Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (inflag = 0; longwave scattering is not +! yet available, ssac and asmc are for future expansion) + +! --------- Modules ---------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +use parrrtm, only : nbndlw, ngptlw +use rrlw_wvn, only: ngb + +implicit none +private + +public :: mcica_subcol_lw + +!========================================================================================= +contains +!========================================================================================= + +subroutine mcica_subcol_lw(lchnk, ncol, nlay, icld, permuteseed, play, & + cldfrac, ciwp, clwp, rei, rel, tauc, cldfmcl, & + ciwpmcl, clwpmcl, reicmcl, relqmcl, taucmcl) + + ! ----- Input ----- + ! Control + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlay ! number of model layers + integer, intent(in) :: icld ! clear/cloud, cloud overlap flag + integer, intent(in) :: permuteseed ! if the cloud generator is called multiple times, + ! permute the seed between each call. + ! between calls for LW and SW, recommended + ! permuteseed differes by 'ngpt' + + ! Atmosphere + real(kind=r8), intent(in) :: play(:,:) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + + ! Atmosphere/clouds - cldprop + real(kind=r8), intent(in) :: cldfrac(:,:) ! layer cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tauc(:,:,:) ! cloud optical depth + ! Dimensions: (nbndlw,ncol,nlay) + real(kind=r8), intent(in) :: ciwp(:,:) ! cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: clwp(:,:) ! cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: rei(:,:) ! cloud ice particle size + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: rel(:,:) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + + ! ----- Output ----- + ! Atmosphere/clouds - cldprmc [mcica] + real(kind=r8), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: ciwpmcl(:,:,:) ! cloud ice water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: clwpmcl(:,:,:) ! cloud liquid water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: relqmcl(:,:) ! liquid particle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: reicmcl(:,:) ! ice partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: taucmcl(:,:,:) ! cloud optical depth [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + ! ----- Local ----- + + ! Stochastic cloud generator variables [mcica] + integer, parameter :: nsubclw = ngptlw ! number of sub-columns (g-point intervals) + integer :: km, im, nm ! loop indices + + real(kind=r8) :: pmid(ncol, nlay) ! layer pressures (Pa) + !---------------------------------------------------------------------------- + + ! Return if clear sky; or stop if icld out of range + if (icld.eq.0) return + if (icld.lt.0.or.icld.gt.3) then + call endrun('MCICA_SUBCOL: INVALID ICLD') + end if + + ! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at + ! least the number of subcolumns + + ! Pass particle sizes to new arrays, no subcolumns for these properties yet + ! Convert pressures from mb to Pa + + reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) + relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) + pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_r8 + + ! Generate the stochastic subcolumns of cloud optical properties for the longwave; + call generate_stochastic_clouds( & + ncol, nlay, nsubclw, icld, pmid, & + cldfrac, clwp, ciwp, tauc, cldfmcl, & + clwpmcl, ciwpmcl, taucmcl, permuteseed) + +end subroutine mcica_subcol_lw + +!========================================================================================= + +subroutine generate_stochastic_clouds( & + ncol, nlay, nsubcol, icld, pmid, & + cld, clwp, ciwp, tauc, cld_stoch, & + clwp_stoch, ciwp_stoch, tauc_stoch, changeSeed) + + !---------------------------------------------------------------------------------------------------------------- + ! --------------------- + ! Contact: Cecile Hannay (hannay@ucar.edu) + ! + ! Original code: Based on Raisanen et al., QJRMS, 2004. + ! + ! Modifications: Generalized for use with RRTMG and added Mersenne Twister as the default + ! random number generator, which can be changed to the optional kissvec random number generator + ! with flag 'irnd' below. Some extra functionality has been commented or removed. + ! Michael J. Iacono, AER, Inc., February 2007 + ! + ! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. + ! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one + ! and uniform cloud liquid and cloud ice concentration. + ! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer + ! and obeys an overlap assumption in the vertical. + ! + ! Overlap assumption: + ! The cloud are consistent with 4 overlap assumptions: random, maximum, maximum-random and exponential. + ! The default option is maximum-random (option 3) + ! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap + ! This is set with the variable "overlap" + !mji - Exponential overlap option (overlap=4) has been deactivated in this version + ! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) + ! + ! Seed: + ! If the stochastic cloud generator is called several times during the same timestep, + ! one should change the seed between the call to insure that the subcolumns are different. + ! This is done by changing the argument 'changeSeed' + ! For example, if one wants to create a set of columns for the shortwave and another set for the longwave , + ! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call + ! + ! PDF assumption: + ! We can use arbitrary complicated PDFS. + ! In the present version, we produce homogeneuous clouds (the simplest case). + ! Future developments include using the PDF scheme of Ben Johnson. + ! + ! History file: + ! Option to add diagnostics variables in the history file. (using FINCL in the namelist) + ! nsubcol = number of subcolumns + ! overlap = overlap type (1-3) + ! Zo = length scale + ! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) + ! CLDLIQ_S = mean of the subcolumn cloud water + ! CLDICE_S = mean of the subcolumn cloud ice + ! + ! Note: + ! Here: we force that the cloud condensate to be consistent with the cloud fraction + ! i.e we only have cloud condensate when the cell is cloudy. + ! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations + ! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction + ! without cloud condensate or the opposite). + !--------------------------------------------------------------------------------------------------------------- + + use shr_RandNum_mod, only: ShrIntrinsicRandGen, ShrKissRandGen, & + ShrF95MtRandGen, ShrDsfmtRandGen + + type(ShrDsfmtRandGen) :: dsfmt_gen + type(ShrKissRandGen) :: kiss_gen + + ! -- Arguments + + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlay ! number of layers + integer, intent(in) :: icld ! clear/cloud, cloud overlap flag + integer, intent(in) :: nsubcol ! number of sub-columns (g-point intervals) + integer, optional, intent(in) :: changeSeed ! allows permuting seed + + real(kind=r8), intent(in) :: pmid(:,:) ! layer pressure (Pa) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cld(:,:) ! cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: clwp(:,:) ! cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ciwp(:,:) ! cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tauc(:,:,:) ! cloud optical depth + ! Dimensions: (nbndlw,ncol,nlay) + + real(kind=r8), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: clwp_stoch(:,:,:) ! subcolumn cloud liquid water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn cloud ice water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(out) :: tauc_stoch(:,:,:) ! subcolumn cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) + ! -- Local variables + real(kind=r8) :: cldf(ncol,nlay) ! cloud fraction + + ! Constants (min value for cloud fraction and cloud water and ice) + real(kind=r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + + ! Variables related to random number and seed + integer :: irnd ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + + real(kind=r8), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 ! random numbers + integer, dimension(ncol,4) :: kiss_seed + real(kind=r8), dimension(ncol,1) :: rand_num_1d ! random number (kissvec) + real(kind=r8), dimension(ncol,nlay) :: rand_num ! random number (kissvec) + integer, dimension(ncol) :: iseed ! seed to create random number (Mersenne Teister) + + ! Flag to identify cloud fraction in subcolumns + logical, dimension(nsubcol, ncol, nlay) :: iscloudy ! flag that says whether a gridbox is cloudy + + ! Indices + integer :: ilev, isubcol, i, n ! indices + !---------------------------------------------------------------------------- + + ! Set randum number generator to use (0 = kissvec; 1 = mersennetwister) + irnd = 0 + + ! ensure that cloud fractions are in bounds + cldf(:,:) = cld(:ncol,:nlay) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! ----- Create seed -------- + + ! Advance randum number generator by changeseed values + if (irnd == 0) then + + ! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. + ! Must use pmid from bottom four layers. + do i=1,ncol + if (pmid(i,nlay).lt.pmid(i,nlay-1)) then + call endrun('MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID FROM BOTTOM FOUR LAYERS.') + end if + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + kiss_gen = ShrKissRandGen(kiss_seed) + + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + elseif (irnd.eq.1) then + + do i = 1, ncol + if (pmid(i,nlay) < pmid(i,nlay-1)) then + call endrun('MCICA_SUBCOL: MT SEED GENERATOR REQUIRES PMID FROM BOTTOM FOUR LAYERS.') + end if + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + iseed = kiss_seed(:,1) + kiss_seed(:,2) + kiss_seed(:,3) + kiss_seed(:,4) + dsfmt_gen =ShrDsfmtRandGen(iseed,1) + + end if + + ! ------ Apply overlap assumption -------- + + ! generate the random numbers + + select case (icld) + + case(1) + ! Random overlap + ! i) pick a random value at every level + + if (irnd == 0) then + do isubcol = 1,nsubcol + call kiss_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + else if (irnd == 1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + end if + + case(2) + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, we use the same random number than in the layer above + ! - if the layer above is clear, we use a new random number + + if (irnd == 0) then + do isubcol = 1, nsubcol + call kiss_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + elseif (irnd == 1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + end if + + do ilev = 2,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (CDF(isubcol, i, ilev-1) > 1._r8 - cldf(i,ilev-1) ) then + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) + else + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._r8 - cldf(i,ilev-1)) + end if + end do + end do + end do + + case(3) + ! Maximum overlap + ! i) pick the same random numebr at every level + + if (irnd.eq.0) then + do isubcol = 1,nsubcol + call kiss_gen%random(rand_num_1d) + do ilev = 1,nlay + CDF(isubcol,:,ilev) = rand_num_1d(:,1) + enddo + enddo + elseif (irnd.eq.1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num_1d) + do ilev = 1, nlay + CDF(isubcol,:,ilev) = rand_num_1d(:,1) + enddo + enddo + endif + + end select + + ! -- generate subcolumns for homogeneous clouds ----- + do ilev = 1,nlay + iscloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._r8 - spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) + end do + + ! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; + ! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0 + + do ilev = 1,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (iscloudy(isubcol,i,ilev) ) then + cld_stoch(isubcol,i,ilev) = 1._r8 + else + cld_stoch(isubcol,i,ilev) = 0._r8 + endif + end do + end do + end do + + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming clwp, ciwp and tauc should be in-cloud quantites and not grid-averaged quantities + + do ilev = 1, nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if ( iscloudy(isubcol,i,ilev) .and. (cldf(i,ilev) > 0._r8) ) then + clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) + ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) + else + clwp_stoch(isubcol,i,ilev) = 0._r8 + ciwp_stoch(isubcol,i,ilev) = 0._r8 + end if + end do + end do + end do + + do ilev = 1, nlay + do i = 1, ncol + do isubcol = 1,nsubcol + if ( iscloudy(isubcol,i,ilev) .and. (cldf(i,ilev) > 0._r8) ) then + n = ngb(isubcol) + tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) + else + tauc_stoch(isubcol,i,ilev) = 0._r8 + end if + end do + end do + end do + + if (irnd == 0) then + call kiss_gen%finalize() + else if (irnd == 1) then + call dsfmt_gen%finalize() + end if + +end subroutine generate_stochastic_clouds + +end module mcica_subcol_gen_lw diff --git a/src/physics/rrtmg/aer_src/mcica_subcol_gen_sw.f90 b/src/physics/rrtmg/aer_src/mcica_subcol_gen_sw.f90 new file mode 100644 index 0000000000..8d0acc3190 --- /dev/null +++ b/src/physics/rrtmg/aer_src/mcica_subcol_gen_sw.f90 @@ -0,0 +1,461 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/mcica_subcol_gen_sw.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.4 $ +! created: $Date: 2008/01/03 21:35:35 $ +! + +module mcica_subcol_gen_sw + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! Purpose: Create McICA stochastic arrays for cloud physical or optical properties. +! Two options are possible: +! 1) Input cloud physical properties: cloud fraction, ice and liquid water +! paths, ice fraction, and particle sizes. Output will be stochastic +! arrays of these variables. (inflag = 1) +! 2) Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (inflag = 0) + +! --------- Modules ---------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +use parrrsw, only: ngptsw +use rrsw_wvn, only: ngb + +implicit none +private + +public :: mcica_subcol_sw + +!========================================================================================= +contains +!========================================================================================= + +subroutine mcica_subcol_sw(lchnk, ncol, nlay, icld, permuteseed, play, & + cldfrac, ciwp, clwp, rei, rel, tauc, ssac, asmc, fsfc, & + cldfmcl, ciwpmcl, clwpmcl, reicmcl, relqmcl, & + taucmcl, ssacmcl, asmcmcl, fsfcmcl) + + ! ----- Input ----- + ! Control + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlay ! number of model layers + integer, intent(in) :: icld ! clear/cloud, cloud overlap flag + integer, intent(in) :: permuteseed ! if the cloud generator is called multiple times, + ! permute the seed between each call; + ! between calls for LW and SW, recommended + ! permuteseed differs by 'ngpt' + + ! Atmosphere + real(kind=r8), intent(in) :: play(:,:) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + + ! Atmosphere/clouds - cldprop + real(kind=r8), intent(in) :: cldfrac(:,:) ! layer cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tauc(:,:,:) ! cloud optical depth + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: ssac(:,:,:) ! cloud single scattering albedo (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: asmc(:,:,:) ! cloud asymmetry parameter (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: fsfc(:,:,:) ! cloud forward scattering fraction (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: ciwp(:,:) ! cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: clwp(:,:) ! cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: rei(:,:) ! cloud ice particle size + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: rel(:,:) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + + ! ----- Output ----- + ! Atmosphere/clouds - cldprmc [mcica] + real(kind=r8), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: ciwpmcl(:,:,:) ! cloud ice water path [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: clwpmcl(:,:,:) ! cloud liquid water path [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: relqmcl(:,:) ! liquid particle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: reicmcl(:,:) ! ice partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: taucmcl(:,:,:) ! cloud optical depth [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: ssacmcl(:,:,:) ! cloud single scattering albedo [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: asmcmcl(:,:,:) ! cloud asymmetry parameter [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: fsfcmcl(:,:,:) ! cloud forward scattering fraction [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + + ! ----- Local ----- + + ! Stochastic cloud generator variables [mcica] + integer, parameter :: nsubcsw = ngptsw ! number of sub-columns (g-point intervals) + integer :: km, im, nm ! loop indices + + real(kind=r8) :: pmid(ncol,nlay) ! layer pressures (Pa) + !---------------------------------------------------------------------------- + + ! Return if clear sky; or stop if icld out of range + if (icld.eq.0) return + if (icld.lt.0.or.icld.gt.3) then + call endrun('MCICA_SUBCOL: INVALID ICLD') + endif + + ! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at + ! least number of subcolumns + + ! Pass particle sizes to new arrays, no subcolumns for these properties yet + ! Convert pressures from mb to Pa + + reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) + relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) + pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_r8 + + ! Generate the stochastic subcolumns of cloud optical properties for the shortwave; + call generate_stochastic_clouds_sw( & + ncol, nlay, nsubcsw, icld, pmid, & + cldfrac, clwp, ciwp, tauc, ssac, & + asmc, fsfc, cldfmcl, clwpmcl, ciwpmcl, & + taucmcl, ssacmcl, asmcmcl, fsfcmcl, permuteseed) + +end subroutine mcica_subcol_sw + +!========================================================================================= + +subroutine generate_stochastic_clouds_sw( & + ncol, nlay, nsubcol, icld, pmid, & + cld, clwp, ciwp, tauc, ssac, & + asmc, fsfc, cld_stoch, clwp_stoch, ciwp_stoch, & + tauc_stoch, ssac_stoch, asmc_stoch, fsfc_stoch, changeSeed) + + !---------------------------------------------------------------------------------------------------------------- + ! --------------------- + ! Contact: Cecile Hannay (hannay@ucar.edu) + ! + ! Original code: Based on Raisanen et al., QJRMS, 2004. + ! + ! Modifications: Generalized for use with RRTMG and added Mersenne Twister as the default + ! random number generator, which can be changed to the optional kissvec random number generator + ! with flag 'irnd' below . Some extra functionality has been commented or removed. + ! Michael J. Iacono, AER, Inc., February 2007 + ! + ! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. + ! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one + ! and uniform cloud liquid and cloud ice concentration. + ! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer + ! and obeys an overlap assumption in the vertical. + ! + ! Overlap assumption: + ! The cloud are consistent with 4 overlap assumptions: random, maximum, maximum-random and exponential. + ! The default option is maximum-random (option 3) + ! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap + ! This is set with the variable "overlap" + !mji - Exponential overlap option (overlap=4) has been deactivated in this version + ! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) + ! + ! Seed: + ! If the stochastic cloud generator is called several times during the same timestep, + ! one should change the seed between the call to insure that the subcolumns are different. + ! This is done by changing the argument 'changeSeed' + ! For example, if one wants to create a set of columns for the shortwave and another set for the longwave , + ! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call + ! + ! PDF assumption: + ! We can use arbitrary complicated PDFS. + ! In the present version, we produce homogeneuous clouds (the simplest case). + ! Future developments include using the PDF scheme of Ben Johnson. + ! + ! History file: + ! Option to add diagnostics variables in the history file. (using FINCL in the namelist) + ! nsubcol = number of subcolumns + ! overlap = overlap type (1-3) + ! Zo = length scale + ! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) + ! CLDLIQ_S = mean of the subcolumn cloud water + ! CLDICE_S = mean of the subcolumn cloud ice + ! + ! Note: + ! Here: we force that the cloud condensate to be consistent with the cloud fraction + ! i.e we only have cloud condensate when the cell is cloudy. + ! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations + ! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction + ! without cloud condensate or the opposite). + !--------------------------------------------------------------------------------------------------------------- + + use shr_RandNum_mod, only: ShrIntrinsicRandGen, ShrKissRandGen, & + ShrF95MtRandGen, ShrDsfmtRandGen + + type(ShrDsfmtRandGen) :: dsfmt_gen + type(ShrKissRandGen) :: kiss_gen + + ! -- Arguments + + integer, intent(in) :: ncol ! number of layers + integer, intent(in) :: nlay ! number of layers + integer, intent(in) :: icld ! clear/cloud, cloud overlap flag + integer, intent(in) :: nsubcol ! number of sub-columns (g-point intervals) + integer, optional, intent(in) :: changeSeed ! allows permuting seed + + real(kind=r8), intent(in) :: pmid(:,:) ! layer pressure (Pa) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cld(:,:) ! cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: clwp(:,:) ! cloud liquid water path (g/m2) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ciwp(:,:) ! cloud ice water path (g/m2) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tauc(:,:,:) ! cloud optical depth (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: ssac(:,:,:) ! cloud single scattering albedo (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: asmc(:,:,:) ! cloud asymmetry parameter (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=r8), intent(in) :: fsfc(:,:,:) ! cloud forward scattering fraction (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + + real(kind=r8), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: clwp_stoch(:,:,:) ! subcolumn cloud liquid water path + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn cloud ice water path + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: tauc_stoch(:,:,:) ! subcolumn cloud optical depth + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: ssac_stoch(:,:,:) ! subcolumn cloud single scattering albedo + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: asmc_stoch(:,:,:) ! subcolumn cloud asymmetry parameter + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(out) :: fsfc_stoch(:,:,:) ! subcolumn cloud forward scattering fraction + ! Dimensions: (ngptsw,ncol,nlay) + + ! -- Local variables + real(kind=r8) :: cldf(ncol,nlay) ! cloud fraction + ! Dimensions: (ncol,nlay) + + ! Constants (min value for cloud fraction and cloud water and ice) + real(kind=r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + + ! Variables related to random number and seed + integer :: irnd ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + + real(kind=r8), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 ! random numbers + integer, dimension(ncol,4) :: kiss_seed + real(kind=r8), dimension(ncol,1) :: rand_num_1d ! random number + real(kind=r8), dimension(ncol,nlay) :: rand_num ! random number + integer, dimension(ncol) :: iseed ! seed to create random number (Mersenne Teister) + + ! Flag to identify cloud fraction in subcolumns + logical, dimension(nsubcol, ncol, nlay) :: isCloudy ! flag that says whether a gridbox is cloudy + + ! Indices + integer :: ilev, isubcol, i, n, ngbm ! indices + !---------------------------------------------------------------------------- + + ! Set randum number generator to use (0 = kissvec; 1 = mersennetwister) + irnd = 0 + + ! ensure that cloud fractions are in bounds + cldf(:,:) = cld(:ncol,:nlay) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! ----- Create seed -------- + + ! Advance randum number generator by changeseed values + if (irnd == 0) then + + ! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. + ! Must use pmid from bottom four layers. + do i = 1, ncol + if (pmid(i,nlay) < pmid(i,nlay-1)) then + call endrun('MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID FROM BOTTOM FOUR LAYERS.') + end if + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + kiss_gen = ShrKissRandGen(kiss_seed) + + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + elseif (irnd == 1) then + + do i = 1, ncol + if (pmid(i,nlay) < pmid(i,nlay-1)) then + call endrun('MCICA_SUBCOL: MT SEED GENERATOR REQUIRES PMID FROM BOTTOM FOUR LAYERS.') + end if + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + iseed = kiss_seed(:,1) + kiss_seed(:,2) + kiss_seed(:,3) + kiss_seed(:,4) + dsfmt_gen =ShrDsfmtRandGen(iseed,1) + + end if + + ! ------ Apply overlap assumption -------- + + ! generate the random numbers + + select case (icld) + + case(1) + ! Random overlap + ! i) pick a random value at every level + if (irnd == 0) then + do isubcol = 1,nsubcol + call kiss_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + else if (irnd == 1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + end if + + case(2) + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, we use the same random number than in the layer above + ! - if the layer above is clear, we use a new random number + + if (irnd == 0) then + do isubcol = 1, nsubcol + call kiss_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + else if (irnd == 1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num) + CDF(isubcol,:,:) = rand_num(:,:) + end do + end if + + do ilev = 2, nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (CDF(isubcol, i, ilev-1) > 1._r8 - cldf(i,ilev-1) ) then + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) + else + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._r8 - cldf(i,ilev-1)) + end if + end do + end do + end do + + case(3) + ! Maximum overlap + ! i) pick same random numebr at every level + + if (irnd == 0) then + do isubcol = 1, nsubcol + call kiss_gen%random(rand_num_1d) + do ilev = 1,nlay + CDF(isubcol,:,ilev) = rand_num_1d(:,1) + end do + end do + else if (irnd == 1) then + do isubcol = 1, nsubcol + call dsfmt_gen%random(rand_num_1d) + do ilev = 1, nlay + CDF(isubcol,:,ilev) = rand_num_1d(:,1) + end do + end do + end if + + end select + + ! -- generate subcolumns for homogeneous clouds ----- + do ilev = 1, nlay + isCloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._r8 - spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) + end do + + ! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; + ! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0 + + do ilev = 1, nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (iscloudy(isubcol,i,ilev) ) then + cld_stoch(isubcol,i,ilev) = 1._r8 + else + cld_stoch(isubcol,i,ilev) = 0._r8 + end if + end do + end do + end do + + ! where there is a cloud, set the subcolumn cloud properties; + ! Incoming clwp, ciwp and tauc should be in-cloud quantites and not grid-averaged quantities + + do ilev = 1, nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if ( iscloudy(isubcol,i,ilev) .and. (cldf(i,ilev) > 0._r8) ) then + clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) + ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) + else + clwp_stoch(isubcol,i,ilev) = 0._r8 + ciwp_stoch(isubcol,i,ilev) = 0._r8 + end if + end do + end do + end do + + ngbm = ngb(1) - 1 + do ilev = 1,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if ( iscloudy(isubcol,i,ilev) .and. (cldf(i,ilev) > 0._r8) ) then + n = ngb(isubcol) - ngbm + tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) + ssac_stoch(isubcol,i,ilev) = ssac(n,i,ilev) + asmc_stoch(isubcol,i,ilev) = asmc(n,i,ilev) + fsfc_stoch(isubcol,i,ilev) = fsfc(n,i,ilev) + else + tauc_stoch(isubcol,i,ilev) = 0._r8 + ssac_stoch(isubcol,i,ilev) = 1._r8 + asmc_stoch(isubcol,i,ilev) = 0._r8 + fsfc_stoch(isubcol,i,ilev) = 0._r8 + end if + end do + end do + end do + + if (irnd == 0) then + call kiss_gen%finalize() + else if (irnd == 1) then + call dsfmt_gen%finalize() + end if + +end subroutine generate_stochastic_clouds_sw + +end module mcica_subcol_gen_sw diff --git a/src/physics/rrtmg/aer_src/parrrsw.f90 b/src/physics/rrtmg/aer_src/parrrsw.f90 new file mode 100644 index 0000000000..8f9dcea6ee --- /dev/null +++ b/src/physics/rrtmg/aer_src/parrrsw.f90 @@ -0,0 +1,123 @@ + + module parrrsw + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_sw main parameters +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! mxlay : integer: maximum number of layers +! mg : integer: number of original g-intervals per spectral band +! nbndsw : integer: number of spectral bands +! naerec : integer: number of aerosols (iaer=6, ecmwf aerosol option) +! ngptsw : integer: total number of reduced g-intervals for rrtmg_lw +! ngNN : integer: number of reduced g-intervals per spectral band +! ngsNN : integer: cumulative number of g-intervals per band +!------------------------------------------------------------------ + +! Settings for single column mode. +! For GCM use, set nlon to number of longitudes, and +! mxlay to number of model layers + integer, parameter :: mxlay = 203 !jplay, klev + integer, parameter :: mg = 16 !jpg + integer, parameter :: nbndsw = 14 !jpsw, ksw + integer, parameter :: naerec = 6 !jpaer + integer, parameter :: mxmol = 38 + integer, parameter :: nstr = 2 + integer, parameter :: nmol = 7 +! Use for 112 g-point model + integer, parameter :: ngptsw = 112 !jpgpt +! Use for 224 g-point model +! integer, parameter :: ngptsw = 224 !jpgpt + +! may need to rename these - from v2.6 + integer, parameter :: jpband = 29 + integer, parameter :: jpb1 = 16 !istart + integer, parameter :: jpb2 = 29 !iend + + integer, parameter :: jmcmu = 32 + integer, parameter :: jmumu = 32 + integer, parameter :: jmphi = 3 + integer, parameter :: jmxang = 4 + integer, parameter :: jmxstr = 16 +! ^ + +! Use for 112 g-point model + integer, parameter :: ng16 = 6 + integer, parameter :: ng17 = 12 + integer, parameter :: ng18 = 8 + integer, parameter :: ng19 = 8 + integer, parameter :: ng20 = 10 + integer, parameter :: ng21 = 10 + integer, parameter :: ng22 = 2 + integer, parameter :: ng23 = 10 + integer, parameter :: ng24 = 8 + integer, parameter :: ng25 = 6 + integer, parameter :: ng26 = 6 + integer, parameter :: ng27 = 8 + integer, parameter :: ng28 = 6 + integer, parameter :: ng29 = 12 + + integer, parameter :: ngs16 = 6 + integer, parameter :: ngs17 = 18 + integer, parameter :: ngs18 = 26 + integer, parameter :: ngs19 = 34 + integer, parameter :: ngs20 = 44 + integer, parameter :: ngs21 = 54 + integer, parameter :: ngs22 = 56 + integer, parameter :: ngs23 = 66 + integer, parameter :: ngs24 = 74 + integer, parameter :: ngs25 = 80 + integer, parameter :: ngs26 = 86 + integer, parameter :: ngs27 = 94 + integer, parameter :: ngs28 = 100 + integer, parameter :: ngs29 = 112 + +! Use for 224 g-point model +! integer, parameter :: ng16 = 16 +! integer, parameter :: ng17 = 16 +! integer, parameter :: ng18 = 16 +! integer, parameter :: ng19 = 16 +! integer, parameter :: ng20 = 16 +! integer, parameter :: ng21 = 16 +! integer, parameter :: ng22 = 16 +! integer, parameter :: ng23 = 16 +! integer, parameter :: ng24 = 16 +! integer, parameter :: ng25 = 16 +! integer, parameter :: ng26 = 16 +! integer, parameter :: ng27 = 16 +! integer, parameter :: ng28 = 16 +! integer, parameter :: ng29 = 16 + +! integer, parameter :: ngs16 = 16 +! integer, parameter :: ngs17 = 32 +! integer, parameter :: ngs18 = 48 +! integer, parameter :: ngs19 = 64 +! integer, parameter :: ngs20 = 80 +! integer, parameter :: ngs21 = 96 +! integer, parameter :: ngs22 = 112 +! integer, parameter :: ngs23 = 128 +! integer, parameter :: ngs24 = 144 +! integer, parameter :: ngs25 = 160 +! integer, parameter :: ngs26 = 176 +! integer, parameter :: ngs27 = 192 +! integer, parameter :: ngs28 = 208 +! integer, parameter :: ngs29 = 224 + +! Source function solar constant + real(kind=r8), parameter :: rrsw_scon = 1.36822e+03 ! W/m2 + + end module parrrsw + + diff --git a/src/physics/rrtmg/aer_src/parrrtm.f90 b/src/physics/rrtmg/aer_src/parrrtm.f90 new file mode 100644 index 0000000000..678d1958ea --- /dev/null +++ b/src/physics/rrtmg/aer_src/parrrtm.f90 @@ -0,0 +1,111 @@ + + module parrrtm + +! use parkind ,only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_lw main parameters +! +! Initial version: JJMorcrette, ECMWF, Jul 1998 +! Revised: MJIacono, AER, Jun 2006 +! Revised: MJIacono, AER, Aug 2007 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! mxlay : integer: maximum number of layers +! mg : integer: number of original g-intervals per spectral band +! nbndlw : integer: number of spectral bands +! maxxsec: integer: maximum number of cross-section molecules +! (e.g. cfcs) +! maxinpx: integer: +! ngptlw : integer: total number of reduced g-intervals for rrtmg_lw +! ngNN : integer: number of reduced g-intervals per spectral band +! ngsNN : integer: cumulative number of g-intervals per band +!------------------------------------------------------------------ + + integer, parameter :: mxlay = 203 + integer, parameter :: mg = 16 + integer, parameter :: nbndlw = 16 + integer, parameter :: maxxsec= 4 + integer, parameter :: mxmol = 38 + integer, parameter :: maxinpx= 38 + integer, parameter :: nmol = 7 +! Use for 140 g-point model + integer, parameter :: ngptlw = 140 +! Use for 256 g-point model +! integer, parameter :: ngptlw = 256 + +! Use for 140 g-point model + integer, parameter :: ng1 = 10 + integer, parameter :: ng2 = 12 + integer, parameter :: ng3 = 16 + integer, parameter :: ng4 = 14 + integer, parameter :: ng5 = 16 + integer, parameter :: ng6 = 8 + integer, parameter :: ng7 = 12 + integer, parameter :: ng8 = 8 + integer, parameter :: ng9 = 12 + integer, parameter :: ng10 = 6 + integer, parameter :: ng11 = 8 + integer, parameter :: ng12 = 8 + integer, parameter :: ng13 = 4 + integer, parameter :: ng14 = 2 + integer, parameter :: ng15 = 2 + integer, parameter :: ng16 = 2 + + integer, parameter :: ngs1 = 10 + integer, parameter :: ngs2 = 22 + integer, parameter :: ngs3 = 38 + integer, parameter :: ngs4 = 52 + integer, parameter :: ngs5 = 68 + integer, parameter :: ngs6 = 76 + integer, parameter :: ngs7 = 88 + integer, parameter :: ngs8 = 96 + integer, parameter :: ngs9 = 108 + integer, parameter :: ngs10 = 114 + integer, parameter :: ngs11 = 122 + integer, parameter :: ngs12 = 130 + integer, parameter :: ngs13 = 134 + integer, parameter :: ngs14 = 136 + integer, parameter :: ngs15 = 138 + +! Use for 256 g-point model +! integer, parameter :: ng1 = 16 +! integer, parameter :: ng2 = 16 +! integer, parameter :: ng3 = 16 +! integer, parameter :: ng4 = 16 +! integer, parameter :: ng5 = 16 +! integer, parameter :: ng6 = 16 +! integer, parameter :: ng7 = 16 +! integer, parameter :: ng8 = 16 +! integer, parameter :: ng9 = 16 +! integer, parameter :: ng10 = 16 +! integer, parameter :: ng11 = 16 +! integer, parameter :: ng12 = 16 +! integer, parameter :: ng13 = 16 +! integer, parameter :: ng14 = 16 +! integer, parameter :: ng15 = 16 +! integer, parameter :: ng16 = 16 + +! integer, parameter :: ngs1 = 16 +! integer, parameter :: ngs2 = 32 +! integer, parameter :: ngs3 = 48 +! integer, parameter :: ngs4 = 64 +! integer, parameter :: ngs5 = 80 +! integer, parameter :: ngs6 = 96 +! integer, parameter :: ngs7 = 112 +! integer, parameter :: ngs8 = 128 +! integer, parameter :: ngs9 = 144 +! integer, parameter :: ngs10 = 160 +! integer, parameter :: ngs11 = 176 +! integer, parameter :: ngs12 = 192 +! integer, parameter :: ngs13 = 208 +! integer, parameter :: ngs14 = 224 +! integer, parameter :: ngs15 = 240 +! integer, parameter :: ngs16 = 256 + + end module parrrtm diff --git a/src/physics/rrtmg/aer_src/rrlw_con.f90 b/src/physics/rrtmg/aer_src/rrlw_con.f90 new file mode 100644 index 0000000000..3e80ef5d46 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_con.f90 @@ -0,0 +1,40 @@ + module rrlw_con + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_lw constants + +! Initial version: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! fluxfac: real : radiance to flux conversion factor +! heatfac: real : flux to heating rate conversion factor +!oneminus: real : 1.-1.e-6 +! pi : real : pi +! grav : real : acceleration of gravity (m/s2) +! planck : real : planck constant +! boltz : real : boltzman constant +! clight : real : speed of light +! avogad : real : avogadro's constant +! alosmt : real : +! gascon : real : gas constant +! radcn1 : real : +! radcn2 : real : +!------------------------------------------------------------------ + + real(kind=r8) :: fluxfac, heatfac + real(kind=r8) :: oneminus, pi, grav + real(kind=r8) :: planck, boltz, clight + real(kind=r8) :: avogad, alosmt, gascon + real(kind=r8) :: radcn1, radcn2 + + end module rrlw_con + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg01.f90 b/src/physics/rrtmg/aer_src/rrlw_kg01.f90 new file mode 100644 index 0000000000..4552de79b9 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg01.f90 @@ -0,0 +1,74 @@ + module rrlw_kg01 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 1 +! band 1: 10-250 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mn2 : real +! kbo_mn2 : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no1 = 16 + + real(kind=r8) :: fracrefao(no1) , fracrefbo(no1) + real(kind=r8) :: kao(5,13,no1) + real(kind=r8) :: kbo(5,13:59,no1) + real(kind=r8) :: kao_mn2(19,no1) , kbo_mn2(19,no1) + real(kind=r8) :: selfrefo(10,no1), forrefo(4,no1) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 1 +! band 1: 10-250 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! absa : real +! absb : real +! ka_mn2 : real +! kb_mn2 : real +! selfref : real +! forref : real +!----------------------------------------------------------------- + + integer, parameter :: ng1 = 10 + + real(kind=r8) :: fracrefa(ng1) , fracrefb(ng1) + real(kind=r8) :: ka(5,13,ng1) , absa(65,ng1) + real(kind=r8) :: kb(5,13:59,ng1), absb(235,ng1) + real(kind=r8) :: ka_mn2(19,ng1) , kb_mn2(19,ng1) + real(kind=r8) :: selfref(10,ng1), forref(4,ng1) + + equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrlw_kg01 + + + + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg02.f90 b/src/physics/rrtmg/aer_src/rrlw_kg02.f90 new file mode 100644 index 0000000000..e58132cb1e --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg02.f90 @@ -0,0 +1,70 @@ + module rrlw_kg02 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 2 +! band 2: 250-500 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no2 = 16 + + real(kind=r8) :: fracrefao(no2) , fracrefbo(no2) + real(kind=r8) :: kao(5,13,no2) + real(kind=r8) :: kbo(5,13:59,no2) + real(kind=r8) :: selfrefo(10,no2) , forrefo(4,no2) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 2 +! band 2: 250-500 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! +! refparam: real +!----------------------------------------------------------------- + + integer, parameter :: ng2 = 12 + + real(kind=r8) :: fracrefa(ng2) , fracrefb(ng2) + real(kind=r8) :: ka(5,13,ng2) , absa(65,ng2) + real(kind=r8) :: kb(5,13:59,ng2), absb(235,ng2) + real(kind=r8) :: selfref(10,ng2), forref(4,ng2) + + real(kind=r8) :: refparam(13) + + equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg02 + + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg03.f90 b/src/physics/rrtmg/aer_src/rrlw_kg03.f90 new file mode 100644 index 0000000000..2e01d923b6 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg03.f90 @@ -0,0 +1,75 @@ + module rrlw_kg03 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 3 +! band 3: 500-630 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mn2o: real +! kbo_mn2o: real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no3 = 16 + + real(kind=r8) :: fracrefao(no3,10) ,fracrefbo(no3,5) + real(kind=r8) :: kao(9,5,13,no3) + real(kind=r8) :: kbo(5,5,13:59,no3) + real(kind=r8) :: kao_mn2o(9,19,no3), kbo_mn2o(5,19,no3) + real(kind=r8) :: selfrefo(10,no3) + real(kind=r8) :: forrefo(4,no3) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 3 +! band 3: 500-630 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mn2o : real +! kb_mn2o : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng3 = 16 + + real(kind=r8) :: fracrefa(ng3,10) ,fracrefb(ng3,5) + real(kind=r8) :: ka(9,5,13,ng3) ,absa(585,ng3) + real(kind=r8) :: kb(5,5,13:59,ng3),absb(1175,ng3) + real(kind=r8) :: ka_mn2o(9,19,ng3), kb_mn2o(5,19,ng3) + real(kind=r8) :: selfref(10,ng3) + real(kind=r8) :: forref(4,ng3) + + equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1)) + + end module rrlw_kg03 + + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg04.f90 b/src/physics/rrtmg/aer_src/rrlw_kg04.f90 new file mode 100644 index 0000000000..ab7ef6d491 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg04.f90 @@ -0,0 +1,64 @@ + module rrlw_kg04 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 4 +! band 4: 630-700 cm-1 (low - h2o,co2; high - o3,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no4 = 16 + + real(kind=r8) :: fracrefao(no4,9) ,fracrefbo(no4,6) + real(kind=r8) :: kao(9,5,13,no4) + real(kind=r8) :: kbo(5,5,13:59,no4) + real(kind=r8) :: selfrefo(10,no4) ,forrefo(4,no4) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 4 +! band 4: 630-700 cm-1 (low - h2o,co2; high - o3,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! absa : real +! absb : real +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! selfref : real +! forref : real +!----------------------------------------------------------------- + + integer, parameter :: ng4 = 14 + + real(kind=r8) :: fracrefa(ng4,9) ,fracrefb(ng4,6) + real(kind=r8) :: ka(9,5,13,ng4) ,absa(585,ng4) + real(kind=r8) :: kb(5,5,13:59,ng4),absb(1175,ng4) + real(kind=r8) :: selfref(10,ng4) ,forref(4,ng4) + + equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1)) + + end module rrlw_kg04 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg05.f90 b/src/physics/rrtmg/aer_src/rrlw_kg05.f90 new file mode 100644 index 0000000000..f22b6c632e --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg05.f90 @@ -0,0 +1,76 @@ + module rrlw_kg05 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 5 +! band 5: 700-820 cm-1 (low - h2o,co2; high - o3,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mo3 : real +! selfrefo: real +! forrefo : real +! ccl4o : real +!----------------------------------------------------------------- + + integer, parameter :: no5 = 16 + + real(kind=r8) :: fracrefao(no5,9) ,fracrefbo(no5,5) + real(kind=r8) :: kao(9,5,13,no5) + real(kind=r8) :: kbo(5,5,13:59,no5) + real(kind=r8) :: kao_mo3(9,19,no5) + real(kind=r8) :: selfrefo(10,no5) + real(kind=r8) :: forrefo(4,no5) + real(kind=r8) :: ccl4o(no5) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 5 +! band 5: 700-820 cm-1 (low - h2o,co2; high - o3,co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mo3 : real +! selfref : real +! forref : real +! ccl4 : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng5 = 16 + + real(kind=r8) :: fracrefa(ng5,9) ,fracrefb(ng5,5) + real(kind=r8) :: ka(9,5,13,ng5) ,absa(585,ng5) + real(kind=r8) :: kb(5,5,13:59,ng5),absb(1175,ng5) + real(kind=r8) :: ka_mo3(9,19,ng5) + real(kind=r8) :: selfref(10,ng5) + real(kind=r8) :: forref(4,ng5) + real(kind=r8) :: ccl4(ng5) + + equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1)) + + end module rrlw_kg05 + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg06.f90 b/src/physics/rrtmg/aer_src/rrlw_kg06.f90 new file mode 100644 index 0000000000..a226a2493c --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg06.f90 @@ -0,0 +1,74 @@ + module rrlw_kg06 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 6 +! band 6: 820-980 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +! kao : real +! kao_mco2: real +! selfrefo: real +! forrefo : real +!cfc11adjo: real +! cfc12o : real +!----------------------------------------------------------------- + + integer, parameter :: no6 = 16 + + real(kind=r8) , dimension(no6) :: fracrefao + real(kind=r8) :: kao(5,13,no6) + real(kind=r8) :: kao_mco2(19,no6) + real(kind=r8) :: selfrefo(10,no6) + real(kind=r8) :: forrefo(4,no6) + + real(kind=r8) , dimension(no6) :: cfc11adjo + real(kind=r8) , dimension(no6) :: cfc12o + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 6 +! band 6: 820-980 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +! ka : real +! ka_mco2 : real +! selfref : real +! forref : real +!cfc11adj : real +! cfc12 : real +! +! absa : real +!----------------------------------------------------------------- + + integer, parameter :: ng6 = 8 + + real(kind=r8) , dimension(ng6) :: fracrefa + real(kind=r8) :: ka(5,13,ng6),absa(65,ng6) + real(kind=r8) :: ka_mco2(19,ng6) + real(kind=r8) :: selfref(10,ng6) + real(kind=r8) :: forref(4,ng6) + + real(kind=r8) , dimension(ng6) :: cfc11adj + real(kind=r8) , dimension(ng6) :: cfc12 + + equivalence (ka(1,1,1),absa(1,1)) + + end module rrlw_kg06 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg07.f90 b/src/physics/rrtmg/aer_src/rrlw_kg07.f90 new file mode 100644 index 0000000000..8505a54ad3 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg07.f90 @@ -0,0 +1,76 @@ + module rrlw_kg07 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 7 +! band 7: 980-1080 cm-1 (low - h2o,o3; high - o3) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mco2: real +! kbo_mco2: real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no7 = 16 + + real(kind=r8) , dimension(no7) :: fracrefbo + real(kind=r8) :: fracrefao(no7,9) + real(kind=r8) :: kao(9,5,13,no7) + real(kind=r8) :: kbo(5,13:59,no7) + real(kind=r8) :: kao_mco2(9,19,no7) + real(kind=r8) :: kbo_mco2(19,no7) + real(kind=r8) :: selfrefo(10,no7) + real(kind=r8) :: forrefo(4,no7) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 7 +! band 7: 980-1080 cm-1 (low - h2o,o3; high - o3) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mco2 : real +! kb_mco2 : real +! selfref : real +! forref : real +! +! absa : real +!----------------------------------------------------------------- + + integer, parameter :: ng7 = 12 + + real(kind=r8) , dimension(ng7) :: fracrefb + real(kind=r8) :: fracrefa(ng7,9) + real(kind=r8) :: ka(9,5,13,ng7) ,absa(585,ng7) + real(kind=r8) :: kb(5,13:59,ng7),absb(235,ng7) + real(kind=r8) :: ka_mco2(9,19,ng7) + real(kind=r8) :: kb_mco2(19,ng7) + real(kind=r8) :: selfref(10,ng7) + real(kind=r8) :: forref(4,ng7) + + equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg07 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg08.f90 b/src/physics/rrtmg/aer_src/rrlw_kg08.f90 new file mode 100644 index 0000000000..b6cbef60e6 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg08.f90 @@ -0,0 +1,100 @@ + module rrlw_kg08 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 8 +! band 8: 1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mco2: real +! kbo_mco2: real +! kao_mn2o: real +! kbo_mn2o: real +! kao_mo3 : real +! selfrefo: real +! forrefo : real +! cfc12o : real +!cfc22adjo: real +!----------------------------------------------------------------- + + integer, parameter :: no8 = 16 + + real(kind=r8) , dimension(no8) :: fracrefao + real(kind=r8) , dimension(no8) :: fracrefbo + real(kind=r8) , dimension(no8) :: cfc12o + real(kind=r8) , dimension(no8) :: cfc22adjo + + real(kind=r8) :: kao(5,13,no8) + real(kind=r8) :: kao_mco2(19,no8) + real(kind=r8) :: kao_mn2o(19,no8) + real(kind=r8) :: kao_mo3(19,no8) + real(kind=r8) :: kbo(5,13:59,no8) + real(kind=r8) :: kbo_mco2(19,no8) + real(kind=r8) :: kbo_mn2o(19,no8) + real(kind=r8) :: selfrefo(10,no8) + real(kind=r8) :: forrefo(4,no8) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 8 +! band 8: 1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mco2 : real +! kb_mco2 : real +! ka_mn2o : real +! kb_mn2o : real +! ka_mo3 : real +! selfref : real +! forref : real +! cfc12 : real +! cfc22adj: real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng8 = 8 + + real(kind=r8) , dimension(ng8) :: fracrefa + real(kind=r8) , dimension(ng8) :: fracrefb + real(kind=r8) , dimension(ng8) :: cfc12 + real(kind=r8) , dimension(ng8) :: cfc22adj + + real(kind=r8) :: ka(5,13,ng8) ,absa(65,ng8) + real(kind=r8) :: kb(5,13:59,ng8) ,absb(235,ng8) + real(kind=r8) :: ka_mco2(19,ng8) + real(kind=r8) :: ka_mn2o(19,ng8) + real(kind=r8) :: ka_mo3(19,ng8) + real(kind=r8) :: kb_mco2(19,ng8) + real(kind=r8) :: kb_mn2o(19,ng8) + real(kind=r8) :: selfref(10,ng8) + real(kind=r8) :: forref(4,ng8) + + equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg08 + diff --git a/src/physics/rrtmg/aer_src/rrlw_kg09.f90 b/src/physics/rrtmg/aer_src/rrlw_kg09.f90 new file mode 100644 index 0000000000..c95bdacdec --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg09.f90 @@ -0,0 +1,78 @@ + module rrlw_kg09 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 9 +! band 9: 1180-1390 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mn2o: real +! kbo_mn2o: real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no9 = 16 + + real(kind=r8) , dimension(no9) :: fracrefbo + + real(kind=r8) :: fracrefao(no9,9) + real(kind=r8) :: kao(9,5,13,no9) + real(kind=r8) :: kbo(5,13:59,no9) + real(kind=r8) :: kao_mn2o(9,19,no9) + real(kind=r8) :: kbo_mn2o(19,no9) + real(kind=r8) :: selfrefo(10,no9) + real(kind=r8) :: forrefo(4,no9) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 9 +! band 9: 1180-1390 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mn2o : real +! kb_mn2o : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng9 = 12 + + real(kind=r8) , dimension(ng9) :: fracrefb + real(kind=r8) :: fracrefa(ng9,9) + real(kind=r8) :: ka(9,5,13,ng9) ,absa(585,ng9) + real(kind=r8) :: kb(5,13:59,ng9) ,absb(235,ng9) + real(kind=r8) :: ka_mn2o(9,19,ng9) + real(kind=r8) :: kb_mn2o(19,ng9) + real(kind=r8) :: selfref(10,ng9) + real(kind=r8) :: forref(4,ng9) + + equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg09 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg10.f90 b/src/physics/rrtmg/aer_src/rrlw_kg10.f90 new file mode 100644 index 0000000000..cf38dcb254 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg10.f90 @@ -0,0 +1,71 @@ + module rrlw_kg10 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 10 +! band 10: 1390-1480 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no10 = 16 + + real(kind=r8) , dimension(no10) :: fracrefao + real(kind=r8) , dimension(no10) :: fracrefbo + + real(kind=r8) :: kao(5,13,no10) + real(kind=r8) :: kbo(5,13:59,no10) + real(kind=r8) :: selfrefo(10,no10) + real(kind=r8) :: forrefo(4,no10) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 10 +! band 10: 1390-1480 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng10 = 6 + + real(kind=r8) , dimension(ng10) :: fracrefa + real(kind=r8) , dimension(ng10) :: fracrefb + + real(kind=r8) :: ka(5,13,ng10) , absa(65,ng10) + real(kind=r8) :: kb(5,13:59,ng10), absb(235,ng10) + real(kind=r8) :: selfref(10,ng10) + real(kind=r8) :: forref(4,ng10) + + equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg10 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg11.f90 b/src/physics/rrtmg/aer_src/rrlw_kg11.f90 new file mode 100644 index 0000000000..33d3d6c74e --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg11.f90 @@ -0,0 +1,79 @@ + module rrlw_kg11 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 11 +! band 11: 1480-1800 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! kao_mo2 : real +! kbo_mo2 : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no11 = 16 + + real(kind=r8) , dimension(no11) :: fracrefao + real(kind=r8) , dimension(no11) :: fracrefbo + + real(kind=r8) :: kao(5,13,no11) + real(kind=r8) :: kbo(5,13:59,no11) + real(kind=r8) :: kao_mo2(19,no11) + real(kind=r8) :: kbo_mo2(19,no11) + real(kind=r8) :: selfrefo(10,no11) + real(kind=r8) :: forrefo(4,no11) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 11 +! band 11: 1480-1800 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! ka_mo2 : real +! kb_mo2 : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng11 = 8 + + real(kind=r8) , dimension(ng11) :: fracrefa + real(kind=r8) , dimension(ng11) :: fracrefb + + real(kind=r8) :: ka(5,13,ng11) , absa(65,ng11) + real(kind=r8) :: kb(5,13:59,ng11), absb(235,ng11) + real(kind=r8) :: ka_mo2(19,ng11) + real(kind=r8) :: kb_mo2(19,ng11) + real(kind=r8) :: selfref(10,ng11) + real(kind=r8) :: forref(4,ng11) + + equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1)) + + end module rrlw_kg11 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg12.f90 b/src/physics/rrtmg/aer_src/rrlw_kg12.f90 new file mode 100644 index 0000000000..e4d40c1fe2 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg12.f90 @@ -0,0 +1,60 @@ + module rrlw_kg12 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 12 +! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +! kao : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no12 = 16 + + real(kind=r8) :: fracrefao(no12,9) + real(kind=r8) :: kao(9,5,13,no12) + real(kind=r8) :: selfrefo(10,no12) + real(kind=r8) :: forrefo(4,no12) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 12 +! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +! ka : real +! selfref : real +! forref : real +! +! absa : real +!----------------------------------------------------------------- + + integer, parameter :: ng12 = 8 + + real(kind=r8) :: fracrefa(ng12,9) + real(kind=r8) :: ka(9,5,13,ng12) ,absa(585,ng12) + real(kind=r8) :: selfref(10,ng12) + real(kind=r8) :: forref(4,ng12) + + equivalence (ka(1,1,1,1),absa(1,1)) + + end module rrlw_kg12 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg13.f90 b/src/physics/rrtmg/aer_src/rrlw_kg13.f90 new file mode 100644 index 0000000000..c8949b1ca1 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg13.f90 @@ -0,0 +1,76 @@ + module rrlw_kg13 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 13 +! band 13: 2080-2250 cm-1 (low - h2o,n2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +! kao : real +! kao_mco2: real +! kao_mco : real +! kbo_mo3 : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no13 = 16 + + real(kind=r8) , dimension(no13) :: fracrefbo + + real(kind=r8) :: fracrefao(no13,9) + real(kind=r8) :: kao(9,5,13,no13) + real(kind=r8) :: kao_mco2(9,19,no13) + real(kind=r8) :: kao_mco(9,19,no13) + real(kind=r8) :: kbo_mo3(19,no13) + real(kind=r8) :: selfrefo(10,no13) + real(kind=r8) :: forrefo(4,no13) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 13 +! band 13: 2080-2250 cm-1 (low - h2o,n2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +! ka : real +! ka_mco2 : real +! ka_mco : real +! kb_mo3 : real +! selfref : real +! forref : real +! +! absa : real +!----------------------------------------------------------------- + + integer, parameter :: ng13 = 4 + + real(kind=r8) , dimension(ng13) :: fracrefb + + real(kind=r8) :: fracrefa(ng13,9) + real(kind=r8) :: ka(9,5,13,ng13) ,absa(585,ng13) + real(kind=r8) :: ka_mco2(9,19,ng13) + real(kind=r8) :: ka_mco(9,19,ng13) + real(kind=r8) :: kb_mo3(19,ng13) + real(kind=r8) :: selfref(10,ng13) + real(kind=r8) :: forref(4,ng13) + + equivalence (ka(1,1,1,1),absa(1,1)) + + end module rrlw_kg13 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg14.f90 b/src/physics/rrtmg/aer_src/rrlw_kg14.f90 new file mode 100644 index 0000000000..38d7eace55 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg14.f90 @@ -0,0 +1,71 @@ + module rrlw_kg14 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 14 +! band 14: 2250-2380 cm-1 (low - co2; high - co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +!fracrefbo: real +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no14 = 16 + + real(kind=r8) , dimension(no14) :: fracrefao + real(kind=r8) , dimension(no14) :: fracrefbo + + real(kind=r8) :: kao(5,13,no14) + real(kind=r8) :: kbo(5,13:59,no14) + real(kind=r8) :: selfrefo(10,no14) + real(kind=r8) :: forrefo(4,no14) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 14 +! band 14: 2250-2380 cm-1 (low - co2; high - co2) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +!fracrefb : real +! ka : real +! kb : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng14 = 2 + + real(kind=r8) , dimension(ng14) :: fracrefa + real(kind=r8) , dimension(ng14) :: fracrefb + + real(kind=r8) :: ka(5,13,ng14) ,absa(65,ng14) + real(kind=r8) :: kb(5,13:59,ng14),absb(235,ng14) + real(kind=r8) :: selfref(10,ng14) + real(kind=r8) :: forref(4,ng14) + + equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrlw_kg14 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg15.f90 b/src/physics/rrtmg/aer_src/rrlw_kg15.f90 new file mode 100644 index 0000000000..2cabdc91e0 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg15.f90 @@ -0,0 +1,65 @@ + module rrlw_kg15 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, r8 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 15 +! band 15: 2380-2600 cm-1 (low - n2o,co2; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +! kao : real +! kao_mn2 : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no15 = 16 + + real(kind=r8) :: fracrefao(no15,9) + real(kind=r8) :: kao(9,5,13,no15) + real(kind=r8) :: kao_mn2(9,19,no15) + real(kind=r8) :: selfrefo(10,no15) + real(kind=r8) :: forrefo(4,no15) + + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 15 +! band 15: 2380-2600 cm-1 (low - n2o,co2; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +! ka : real +! ka_mn2 : real +! selfref : real +! forref : real +! +! absa : real +!----------------------------------------------------------------- + + integer, parameter :: ng15 = 2 + + real(kind=r8) :: fracrefa(ng15,9) + real(kind=r8) :: ka(9,5,13,ng15) ,absa(585,ng15) + real(kind=r8) :: ka_mn2(9,19,ng15) + real(kind=r8) :: selfref(10,ng15) + real(kind=r8) :: forref(4,ng15) + + equivalence (ka(1,1,1,1),absa(1,1)) + + end module rrlw_kg15 diff --git a/src/physics/rrtmg/aer_src/rrlw_kg16.f90 b/src/physics/rrtmg/aer_src/rrlw_kg16.f90 new file mode 100644 index 0000000000..55c949fc8b --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_kg16.f90 @@ -0,0 +1,70 @@ + module rrlw_kg16 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_lw ORIGINAL abs. coefficients for interval 16 +! band 16: 2600-3000 cm-1 (low - h2o,ch4; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefao: real +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!----------------------------------------------------------------- + + integer, parameter :: no16 = 16 + + real(kind=r8) , dimension(no16) :: fracrefbo + + real(kind=r8) :: fracrefao(no16,9) + real(kind=r8) :: kao(9,5,13,no16) + real(kind=r8) :: kbo(5,13:59,no16) + real(kind=r8) :: selfrefo(10,no16) + real(kind=r8) :: forrefo(4,no16) + +!----------------------------------------------------------------- +! rrtmg_lw COMBINED abs. coefficients for interval 16 +! band 16: 2600-3000 cm-1 (low - h2o,ch4; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!fracrefa : real +! ka : real +! kb : real +! selfref : real +! forref : real +! +! absa : real +! absb : real +!----------------------------------------------------------------- + + integer, parameter :: ng16 = 2 + + real(kind=r8) , dimension(ng16) :: fracrefb + + real(kind=r8) :: fracrefa(ng16,9) + real(kind=r8) :: ka(9,5,13,ng16) ,absa(585,ng16) + real(kind=r8) :: kb(5,13:59,ng16), absb(235,ng16) + real(kind=r8) :: selfref(10,ng16) + real(kind=r8) :: forref(4,ng16) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrlw_kg16 + diff --git a/src/physics/rrtmg/aer_src/rrlw_ref.f90 b/src/physics/rrtmg/aer_src/rrlw_ref.f90 new file mode 100644 index 0000000000..b0139c4b23 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_ref.f90 @@ -0,0 +1,31 @@ + module rrlw_ref + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_lw reference atmosphere +! Based on standard mid-latitude summer profile +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! pref : real : Reference pressure levels +! preflog: real : Reference pressure levels, ln(pref) +! tref : real : Reference temperature levels for MLS profile +! chi_mls: real : +!------------------------------------------------------------------ + + real(kind=r8) , dimension(59) :: pref + real(kind=r8) , dimension(59) :: preflog + real(kind=r8) , dimension(59) :: tref + real(kind=r8) :: chi_mls(7,59) + + end module rrlw_ref diff --git a/src/physics/rrtmg/aer_src/rrlw_tbl.f90 b/src/physics/rrtmg/aer_src/rrlw_tbl.f90 new file mode 100644 index 0000000000..795145a4b5 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_tbl.f90 @@ -0,0 +1,47 @@ + module rrlw_tbl + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_lw exponential lookup table arrays + +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, Jun 2006 +! Revised: MJIacono, AER, Aug 2007 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! ntbl : integer: Lookup table dimension +! tblint : real : Lookup table conversion factor +! tau_tbl: real : Clear-sky optical depth (used in cloudy radiative +! transfer) +! exp_tbl: real : Transmittance lookup table +! tfn_tbl: real : Tau transition function; i.e. the transition of +! the Planck function from that for the mean layer +! temperature to that for the layer boundary +! temperature as a function of optical depth. +! The "linear in tau" method is used to make +! the table. +! pade : real : Pade constant +! bpade : real : Inverse of Pade constant +!------------------------------------------------------------------ + + integer, parameter :: ntbl = 10000 + + real(kind=r8), parameter :: tblint = 10000.0_r8 + + real(kind=r8) , dimension(0:ntbl) :: tau_tbl + real(kind=r8) , dimension(0:ntbl) :: exp_tbl + real(kind=r8) , dimension(0:ntbl) :: tfn_tbl + + real(kind=r8), parameter :: pade = 0.278_r8 + real(kind=r8) :: bpade + + end module rrlw_tbl + diff --git a/src/physics/rrtmg/aer_src/rrlw_wvn.f90 b/src/physics/rrtmg/aer_src/rrlw_wvn.f90 new file mode 100644 index 0000000000..6582158064 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrlw_wvn.f90 @@ -0,0 +1,76 @@ + module rrlw_wvn + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use parrrtm, only : nbndlw, mg, ngptlw, maxinpx + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_lw spectral information + +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! ng : integer: Number of original g-intervals in each spectral band +! nspa : integer: For the lower atmosphere, the number of reference +! atmospheres that are stored for each spectral band +! per pressure level and temperature. Each of these +! atmospheres has different relative amounts of the +! key species for the band (i.e. different binary +! species parameters). +! nspb : integer: Same as nspa for the upper atmosphere +!wavenum1: real : Spectral band lower boundary in wavenumbers +!wavenum2: real : Spectral band upper boundary in wavenumbers +! delwave: real : Spectral band width in wavenumbers +! totplnk: real : Integrated Planck value for each band; (band 16 +! includes total from 2600 cm-1 to infinity) +! Used for calculation across total spectrum +!totplk16: real : Integrated Planck value for band 16 (2600-3250 cm-1) +! Used for calculation in band 16 only if +! individual band output requested +! +! ngc : integer: The number of new g-intervals in each band +! ngs : integer: The cumulative sum of new g-intervals for each band +! ngm : integer: The index of each new g-interval relative to the +! original 16 g-intervals in each band +! ngn : integer: The number of original g-intervals that are +! combined to make each new g-intervals in each band +! ngb : integer: The band index for each new g-interval +! wt : real : RRTM weights for the original 16 g-intervals +! rwgt : real : Weights for combining original 16 g-intervals +! (256 total) into reduced set of g-intervals +! (140 total) +! nxmol : integer: Number of cross-section molecules +! ixindx : integer: Flag for active cross-sections in calculation +!------------------------------------------------------------------ + + integer :: ng(nbndlw) + integer :: nspa(nbndlw) + integer :: nspb(nbndlw) + + real(kind=r8) :: wavenum1(nbndlw) + real(kind=r8) :: wavenum2(nbndlw) + real(kind=r8) :: delwave(nbndlw) + + real(kind=r8) :: totplnk(181,nbndlw) + real(kind=r8) :: totplk16(181) + + integer :: ngc(nbndlw) + integer :: ngs(nbndlw) + integer :: ngn(ngptlw) + integer :: ngb(ngptlw) + integer :: ngm(nbndlw*mg) + + real(kind=r8) :: wt(mg) + real(kind=r8) :: rwgt(nbndlw*mg) + + integer :: nxmol + integer :: ixindx(maxinpx) + + end module rrlw_wvn diff --git a/src/physics/rrtmg/aer_src/rrsw_con.f90 b/src/physics/rrtmg/aer_src/rrsw_con.f90 new file mode 100644 index 0000000000..08fd46ff7e --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_con.f90 @@ -0,0 +1,40 @@ + module rrsw_con + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_sw constants + +! Initial version: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! fluxfac: real : radiance to flux conversion factor +! heatfac: real : flux to heating rate conversion factor +!oneminus: real : 1.-1.e-6 +! pi : real : pi +! grav : real : acceleration of gravity (m/s2) +! planck : real : planck constant +! boltz : real : boltzman constant +! clight : real : speed of light +! avogad : real : avogadro's constant +! alosmt : real : +! gascon : real : gas constant +! radcn1 : real : +! radcn2 : real : +!------------------------------------------------------------------ + + real(kind=r8) :: fluxfac, heatfac + real(kind=r8) :: oneminus, pi, grav + real(kind=r8) :: planck, boltz, clight + real(kind=r8) :: avogad, alosmt, gascon + real(kind=r8) :: radcn1, radcn2 + + end module rrsw_con + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg16.f90 b/src/physics/rrtmg/aer_src/rrsw_kg16.f90 new file mode 100644 index 0000000000..0f859879a4 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg16.f90 @@ -0,0 +1,65 @@ + module rrsw_kg16 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng16 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 16 +! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no16 = 16 + + real(kind=r8) :: kao(9,5,13,no16) + real(kind=r8) :: kbo(5,13:59,no16) + real(kind=r8) :: selfrefo(10,no16), forrefo(3,no16) + real(kind=r8) :: sfluxrefo(no16) + + integer :: layreffr + real(kind=r8) :: rayl, strrat1 + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 16 +! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng16) , absa(585,ng16) + real(kind=r8) :: kb(5,13:59,ng16), absb(235,ng16) + real(kind=r8) :: selfref(10,ng16), forref(3,ng16) + real(kind=r8) :: sfluxref(ng16) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg16 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg17.f90 b/src/physics/rrtmg/aer_src/rrsw_kg17.f90 new file mode 100644 index 0000000000..d251f3a232 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg17.f90 @@ -0,0 +1,65 @@ + module rrsw_kg17 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng17 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 17 +! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no17 = 16 + + real(kind=r8) :: kao(9,5,13,no17) + real(kind=r8) :: kbo(5,5,13:59,no17) + real(kind=r8) :: selfrefo(10,no17), forrefo(4,no17) + real(kind=r8) :: sfluxrefo(no17,5) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 17 +! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng17) , absa(585,ng17) + real(kind=r8) :: kb(5,5,13:59,ng17), absb(1175,ng17) + real(kind=r8) :: selfref(10,ng17), forref(4,ng17) + real(kind=r8) :: sfluxref(ng17,5) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1)) + + end module rrsw_kg17 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg18.f90 b/src/physics/rrtmg/aer_src/rrsw_kg18.f90 new file mode 100644 index 0000000000..6a96dc756c --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg18.f90 @@ -0,0 +1,65 @@ + module rrsw_kg18 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng18 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 18 +! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no18 = 16 + + real(kind=r8) :: kao(9,5,13,no18) + real(kind=r8) :: kbo(5,13:59,no18) + real(kind=r8) :: selfrefo(10,no18), forrefo(3,no18) + real(kind=r8) :: sfluxrefo(no18,9) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 18 +! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng18), absa(585,ng18) + real(kind=r8) :: kb(5,13:59,ng18), absb(235,ng18) + real(kind=r8) :: selfref(10,ng18), forref(3,ng18) + real(kind=r8) :: sfluxref(ng18,9) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg18 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg19.f90 b/src/physics/rrtmg/aer_src/rrsw_kg19.f90 new file mode 100644 index 0000000000..37f5421c45 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg19.f90 @@ -0,0 +1,65 @@ + module rrsw_kg19 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng19 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 19 +! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no19 = 16 + + real(kind=r8) :: kao(9,5,13,no19) + real(kind=r8) :: kbo(5,13:59,no19) + real(kind=r8) :: selfrefo(10,no19), forrefo(3,no19) + real(kind=r8) :: sfluxrefo(no19,9) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 19 +! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng19), absa(585,ng19) + real(kind=r8) :: kb(5,13:59,ng19), absb(235,ng19) + real(kind=r8) :: selfref(10,ng19), forref(3,ng19) + real(kind=r8) :: sfluxref(ng19,9) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg19 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg20.f90 b/src/physics/rrtmg/aer_src/rrsw_kg20.f90 new file mode 100644 index 0000000000..777a684d77 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg20.f90 @@ -0,0 +1,69 @@ + module rrsw_kg20 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng20 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 20 +! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +! absch4o : real +!----------------------------------------------------------------- + + integer, parameter :: no20 = 16 + + real(kind=r8) :: kao(5,13,no20) + real(kind=r8) :: kbo(5,13:59,no20) + real(kind=r8) :: selfrefo(10,no20), forrefo(4,no20) + real(kind=r8) :: sfluxrefo(no20) + real(kind=r8) :: absch4o(no20) + + integer :: layreffr + real(kind=r8) :: rayl + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 20 +! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +! absch4 : real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(5,13,ng20), absa(65,ng20) + real(kind=r8) :: kb(5,13:59,ng20), absb(235,ng20) + real(kind=r8) :: selfref(10,ng20), forref(4,ng20) + real(kind=r8) :: sfluxref(ng20) + real(kind=r8) :: absch4(ng20) + + equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg20 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg21.f90 b/src/physics/rrtmg/aer_src/rrsw_kg21.f90 new file mode 100644 index 0000000000..b669bd0e3d --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg21.f90 @@ -0,0 +1,65 @@ + module rrsw_kg21 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng21 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 21 +! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no21 = 16 + + real(kind=r8) :: kao(9,5,13,no21) + real(kind=r8) :: kbo(5,5,13:59,no21) + real(kind=r8) :: selfrefo(10,no21), forrefo(4,no21) + real(kind=r8) :: sfluxrefo(no21,9) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 21 +! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng21), absa(585,ng21) + real(kind=r8) :: kb(5,5,13:59,ng21), absb(1175,ng21) + real(kind=r8) :: selfref(10,ng21), forref(4,ng21) + real(kind=r8) :: sfluxref(ng21,9) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1)) + + end module rrsw_kg21 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg22.f90 b/src/physics/rrtmg/aer_src/rrsw_kg22.f90 new file mode 100644 index 0000000000..708b54a020 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg22.f90 @@ -0,0 +1,65 @@ + module rrsw_kg22 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng22 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 22 +! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no22 = 16 + + real(kind=r8) :: kao(9,5,13,no22) + real(kind=r8) :: kbo(5,13:59,no22) + real(kind=r8) :: selfrefo(10,no22), forrefo(3,no22) + real(kind=r8) :: sfluxrefo(no22,9) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 22 +! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng22), absa(585,ng22) + real(kind=r8) :: kb(5,13:59,ng22), absb(235,ng22) + real(kind=r8) :: selfref(10,ng22), forref(3,ng22) + real(kind=r8) :: sfluxref(ng22,9) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg22 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg23.f90 b/src/physics/rrtmg/aer_src/rrsw_kg23.f90 new file mode 100644 index 0000000000..f56bbecf5d --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg23.f90 @@ -0,0 +1,64 @@ + module rrsw_kg23 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng23 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 23 +! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no23 = 16 + + real(kind=r8) :: kao(5,13,no23) + real(kind=r8) :: selfrefo(10,no23), forrefo(3,no23) + real(kind=r8) :: sfluxrefo(no23) + real(kind=r8) :: raylo(no23) + + integer :: layreffr + real(kind=r8) :: givfac + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 23 +! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(5,13,ng23), absa(65,ng23) + real(kind=r8) :: selfref(10,ng23), forref(3,ng23) + real(kind=r8) :: sfluxref(ng23), rayl(ng23) + + equivalence (ka(1,1,1),absa(1,1)) + + end module rrsw_kg23 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg24.f90 b/src/physics/rrtmg/aer_src/rrsw_kg24.f90 new file mode 100644 index 0000000000..df947d9d8b --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg24.f90 @@ -0,0 +1,77 @@ + module rrsw_kg24 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng24 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 24 +! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +! abso3ao : real +! abso3bo : real +! raylao : real +! raylbo : real +!----------------------------------------------------------------- + + integer, parameter :: no24 = 16 + + real(kind=r8) :: kao(9,5,13,no24) + real(kind=r8) :: kbo(5,13:59,no24) + real(kind=r8) :: selfrefo(10,no24), forrefo(3,no24) + real(kind=r8) :: sfluxrefo(no24,9) + real(kind=r8) :: abso3ao(no24), abso3bo(no24) + real(kind=r8) :: raylao(no24,9), raylbo(no24) + + integer :: layreffr + real(kind=r8) :: strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 24 +! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! selfref : real +! forref : real +! sfluxref: real +! abso3a : real +! abso3b : real +! rayla : real +! raylb : real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng24), absa(585,ng24) + real(kind=r8) :: kb(5,13:59,ng24), absb(235,ng24) + real(kind=r8) :: selfref(10,ng24), forref(3,ng24) + real(kind=r8) :: sfluxref(ng24,9) + real(kind=r8) :: abso3a(ng24), abso3b(ng24) + real(kind=r8) :: rayla(ng24,9), raylb(ng24) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg24 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg25.f90 b/src/physics/rrtmg/aer_src/rrsw_kg25.f90 new file mode 100644 index 0000000000..20dc3a501d --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg25.f90 @@ -0,0 +1,63 @@ + module rrsw_kg25 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng25 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 25 +! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +!sfluxrefo: real +! abso3ao : real +! abso3bo : real +! raylo : real +!----------------------------------------------------------------- + + integer, parameter :: no25 = 16 + + real(kind=r8) :: kao(5,13,no25) + real(kind=r8) :: sfluxrefo(no25) + real(kind=r8) :: abso3ao(no25), abso3bo(no25) + real(kind=r8) :: raylo(no25) + + integer :: layreffr + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 25 +! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! absa : real +! sfluxref: real +! abso3a : real +! abso3b : real +! rayl : real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(5,13,ng25), absa(65,ng25) + real(kind=r8) :: sfluxref(ng25) + real(kind=r8) :: abso3a(ng25), abso3b(ng25) + real(kind=r8) :: rayl(ng25) + + equivalence (ka(1,1,1),absa(1,1)) + + end module rrsw_kg25 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg26.f90 b/src/physics/rrtmg/aer_src/rrsw_kg26.f90 new file mode 100644 index 0000000000..958bb1de08 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg26.f90 @@ -0,0 +1,48 @@ + module rrsw_kg26 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng26 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 26 +! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +!sfluxrefo: real +! raylo : real +!----------------------------------------------------------------- + + integer, parameter :: no26 = 16 + + real(kind=r8) :: sfluxrefo(no26) + real(kind=r8) :: raylo(no26) + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 26 +! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! sfluxref: real +! rayl : real +!----------------------------------------------------------------- + + real(kind=r8) :: sfluxref(ng26) + real(kind=r8) :: rayl(ng26) + + end module rrsw_kg26 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg27.f90 b/src/physics/rrtmg/aer_src/rrsw_kg27.f90 new file mode 100644 index 0000000000..c8f56838ce --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg27.f90 @@ -0,0 +1,63 @@ + module rrsw_kg27 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng27 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 27 +! band 27: 29000-38000 cm-1 (low - o3; high - o3) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +!sfluxrefo: real +! raylo : real +!----------------------------------------------------------------- + + integer, parameter :: no27 = 16 + + real(kind=r8) :: kao(5,13,no27) + real(kind=r8) :: kbo(5,13:59,no27) + real(kind=r8) :: sfluxrefo(no27) + real(kind=r8) :: raylo(no27) + + integer :: layreffr + real(kind=r8) :: scalekur + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 27 +! band 27: 29000-38000 cm-1 (low - o3; high - o3) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! absa : real +! absb : real +! sfluxref: real +! rayl : real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(5,13,ng27), absa(65,ng27) + real(kind=r8) :: kb(5,13:59,ng27), absb(235,ng27) + real(kind=r8) :: sfluxref(ng27) + real(kind=r8) :: rayl(ng27) + + equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg27 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg28.f90 b/src/physics/rrtmg/aer_src/rrsw_kg28.f90 new file mode 100644 index 0000000000..2726f7cbaf --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg28.f90 @@ -0,0 +1,57 @@ + module rrsw_kg28 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng28 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 28 +! band 28: 38000-50000 cm-1 (low - o3, o2; high - o3, o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +!sfluxrefo: real +!----------------------------------------------------------------- + + integer, parameter :: no28 = 16 + + real(kind=r8) :: kao(9,5,13,no28) + real(kind=r8) :: kbo(5,5,13:59,no28) + real(kind=r8) :: sfluxrefo(no28,5) + + integer :: layreffr + real(kind=r8) :: rayl, strrat + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 28 +! band 28: 38000-50000 cm-1 (low - o3, o2; high - o3, o2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! sfluxref: real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(9,5,13,ng28), absa(585,ng28) + real(kind=r8) :: kb(5,5,13:59,ng28), absb(1175,ng28) + real(kind=r8) :: sfluxref(ng28,5) + + equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1)) + + end module rrsw_kg28 + diff --git a/src/physics/rrtmg/aer_src/rrsw_kg29.f90 b/src/physics/rrtmg/aer_src/rrsw_kg29.f90 new file mode 100644 index 0000000000..69c8b3057f --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_kg29.f90 @@ -0,0 +1,69 @@ + module rrsw_kg29 + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind ,only : jpim, jprb + use parrrsw, only : ng29 + + implicit none + save + +!----------------------------------------------------------------- +! rrtmg_sw ORIGINAL abs. coefficients for interval 29 +! band 29: 820-2600 cm-1 (low - h2o; high - co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! kao : real +! kbo : real +! selfrefo: real +! forrefo : real +!sfluxrefo: real +! absh2oo : real +! absco2o : real +!----------------------------------------------------------------- + + integer, parameter :: no29 = 16 + + real(kind=r8) :: kao(5,13,no29) + real(kind=r8) :: kbo(5,13:59,no29) + real(kind=r8) :: selfrefo(10,no29), forrefo(4,no29) + real(kind=r8) :: sfluxrefo(no29) + real(kind=r8) :: absh2oo(no29), absco2o(no29) + + integer :: layreffr + real(kind=r8) :: rayl + +!----------------------------------------------------------------- +! rrtmg_sw COMBINED abs. coefficients for interval 29 +! band 29: 820-2600 cm-1 (low - h2o; high - co2) +! +! Initial version: JJMorcrette, ECMWF, oct1999 +! Revised: MJIacono, AER, jul2006 +!----------------------------------------------------------------- +! +! name type purpose +! ---- : ---- : --------------------------------------------- +! ka : real +! kb : real +! selfref : real +! forref : real +! sfluxref: real +! absh2o : real +! absco2 : real +!----------------------------------------------------------------- + + real(kind=r8) :: ka(5,13,ng29), absa(65,ng29) + real(kind=r8) :: kb(5,13:59,ng29), absb(235,ng29) + real(kind=r8) :: selfref(10,ng29), forref(4,ng29) + real(kind=r8) :: sfluxref(ng29) + real(kind=r8) :: absh2o(ng29), absco2(ng29) + + equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1)) + + end module rrsw_kg29 + diff --git a/src/physics/rrtmg/aer_src/rrsw_ref.f90 b/src/physics/rrtmg/aer_src/rrsw_ref.f90 new file mode 100644 index 0000000000..00b7f0018f --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_ref.f90 @@ -0,0 +1,29 @@ + module rrsw_ref + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_sw reference atmosphere +! Based on standard mid-latitude summer profile +! +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jun2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! pref : real : Reference pressure levels +! preflog: real : Reference pressure levels, ln(pref) +! tref : real : Reference temperature levels for MLS profile +!------------------------------------------------------------------ + + real(kind=r8) , dimension(59) :: pref + real(kind=r8) , dimension(59) :: preflog + real(kind=r8) , dimension(59) :: tref + + end module rrsw_ref diff --git a/src/physics/rrtmg/aer_src/rrsw_tbl.f90 b/src/physics/rrtmg/aer_src/rrsw_tbl.f90 new file mode 100644 index 0000000000..f7b75b7d1a --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_tbl.f90 @@ -0,0 +1,42 @@ + module rrsw_tbl + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_sw lookup table arrays + +! Initial version: MJIacono, AER, may2007 +! Revised: MJIacono, AER, aug2007 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! ntbl : integer: Lookup table dimension +! tblint : real : Lookup table conversion factor +! tau_tbl: real : Clear-sky optical depth +! exp_tbl: real : Exponential lookup table for transmittance +! od_lo : real : Value of tau below which expansion is used +! : in place of lookup table +! pade : real : Pade approximation constant +! bpade : real : Inverse of Pade constant +!------------------------------------------------------------------ + + integer, parameter :: ntbl = 10000 + + real(kind=r8), parameter :: tblint = 10000.0 + + real(kind=r8), parameter :: od_lo = 0.06 + + real(kind=r8) :: tau_tbl + real(kind=r8) , dimension(0:ntbl) :: exp_tbl + + real(kind=r8), parameter :: pade = 0.278_r8 + real(kind=r8) :: bpade + + end module rrsw_tbl + diff --git a/src/physics/rrtmg/aer_src/rrsw_wvn.f90 b/src/physics/rrtmg/aer_src/rrsw_wvn.f90 new file mode 100644 index 0000000000..650470a5bc --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrsw_wvn.f90 @@ -0,0 +1,57 @@ + module rrsw_wvn + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use parrrsw, only : nbndsw, mg, ngptsw, jpb1, jpb2 + + implicit none + save + +!------------------------------------------------------------------ +! rrtmg_sw spectral information + +! Initial version: JJMorcrette, ECMWF, jul1998 +! Revised: MJIacono, AER, jul2006 +!------------------------------------------------------------------ + +! name type purpose +! ----- : ---- : ---------------------------------------------- +! ng : integer: Number of original g-intervals in each spectral band +! nspa : integer: +! nspb : integer: +!wavenum1: real : Spectral band lower boundary in wavenumbers +!wavenum2: real : Spectral band upper boundary in wavenumbers +! delwave: real : Spectral band width in wavenumbers +! +! ngc : integer: The number of new g-intervals in each band +! ngs : integer: The cumulative sum of new g-intervals for each band +! ngm : integer: The index of each new g-interval relative to the +! original 16 g-intervals in each band +! ngn : integer: The number of original g-intervals that are +! combined to make each new g-intervals in each band +! ngb : integer: The band index for each new g-interval +! wt : real : RRTM weights for the original 16 g-intervals +! rwgt : real : Weights for combining original 16 g-intervals +! (224 total) into reduced set of g-intervals +! (112 total) +!------------------------------------------------------------------ + + integer :: ng(jpb1:jpb2) + integer :: nspa(jpb1:jpb2) + integer :: nspb(jpb1:jpb2) + + real(kind=r8) :: wavenum1(jpb1:jpb2) + real(kind=r8) :: wavenum2(jpb1:jpb2) + real(kind=r8) :: delwave(jpb1:jpb2) + + integer :: ngc(nbndsw) + integer :: ngs(nbndsw) + integer :: ngn(ngptsw) + integer :: ngb(ngptsw) + integer :: ngm(nbndsw*mg) + + real(kind=r8) :: wt(mg) + real(kind=r8) :: rwgt(nbndsw*mg) + + end module rrsw_wvn diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 new file mode 100644 index 0000000000..d334e67786 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_init.f90 @@ -0,0 +1,1988 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_init.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/22 19:20:03 $ +! + module rrtmg_lw_init + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_wvn + use rrtmg_lw_setcoef, only: lwatmref, lwavplank + + implicit none + + contains + +! ************************************************************************** + subroutine rrtmg_lw_ini +! ************************************************************************** +! +! Original version: Michael J. Iacono; July, 1998 +! First revision for NCAR CCM: September, 1998 +! Second revision for RRTM_V3.0: September, 2002 +! +! This subroutine performs calculations necessary for the initialization +! of the longwave model. Lookup tables are computed for use in the LW +! radiative transfer, and input absorption coefficient data for each +! spectral band are reduced from 256 g-point intervals to 140. +! ************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw + use rrlw_tbl, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl, tfn_tbl + +! ------- Local ------- + + integer :: itr, ibnd, igc, ig, ind, ipr + integer :: igcsm, iprsm + + real(kind=r8) :: wtsum, wtsm(mg) ! + real(kind=r8) :: tfn ! + +! ------- Definitions ------- +! Arrays for 10000-point look-up tables: +! TAU_TBL Clear-sky optical depth (used in cloudy radiative transfer) +! EXP_TBL Exponential lookup table for ransmittance +! TFN_TBL Tau transition function; i.e. the transition of the Planck +! function from that for the mean layer temperature to that for +! the layer boundary temperature as a function of optical depth. +! The "linear in tau" method is used to make the table. +! PADE Pade approximation constant (= 0.278) +! BPADE Inverse of the Pade approximation constant +! + +! Initialize model data + call lwdatinit + call lwcmbdat ! g-point interval reduction data + call lwatmref ! reference MLS profile + call lwavplank ! Planck function + call lw_kgb01 ! molecular absorption coefficients + call lw_kgb02 + call lw_kgb03 + call lw_kgb04 + call lw_kgb05 + call lw_kgb06 + call lw_kgb07 + call lw_kgb08 + call lw_kgb09 + call lw_kgb10 + call lw_kgb11 + call lw_kgb12 + call lw_kgb13 + call lw_kgb14 + call lw_kgb15 + call lw_kgb16 + +! Compute lookup tables for transmittance, tau transition function, +! and clear sky tau (for the cloudy sky radiative transfer). Tau is +! computed as a function of the tau transition function, transmittance +! is calculated as a function of tau, and the tau transition function +! is calculated using the linear in tau formulation at values of tau +! above 0.01. TF is approximated as tau/6 for tau < 0.01. All tables +! are computed at intervals of 0.001. The inverse of the constant used +! in the Pade approximation to the tau transition function is set to b. + + tau_tbl(0) = 0.0_r8 + tau_tbl(ntbl) = 1.e10_r8 + exp_tbl(0) = 1.0_r8 + exp_tbl(ntbl) = 0.0_r8 + tfn_tbl(0) = 0.0_r8 + tfn_tbl(ntbl) = 1.0_r8 + bpade = 1.0_r8 / pade + do itr = 1, ntbl-1 + tfn = float(itr) / float(ntbl) + tau_tbl(itr) = bpade * tfn / (1._r8 - tfn) + exp_tbl(itr) = exp(-tau_tbl(itr)) + if (tau_tbl(itr) .lt. 0.06_r8) then + tfn_tbl(itr) = tau_tbl(itr)/6._r8 + else + tfn_tbl(itr) = 1._r8-2._r8*((1._r8/tau_tbl(itr))-(exp_tbl(itr)/(1.-exp_tbl(itr)))) + endif + enddo + +! Perform g-point reduction from 16 per band (256 total points) to +! a band dependant number (140 total points) for all absorption +! coefficient input data and Planck fraction input data. +! Compute relative weighting for new g-point combinations. + + igcsm = 0 + do ibnd = 1,nbndlw + iprsm = 0 + if (ngc(ibnd).lt.mg) then + do igc = 1,ngc(ibnd) + igcsm = igcsm + 1 + wtsum = 0._r8 + do ipr = 1, ngn(igcsm) + iprsm = iprsm + 1 + wtsum = wtsum + wt(iprsm) + enddo + wtsm(igc) = wtsum + enddo + do ig = 1, ng(ibnd) + ind = (ibnd-1)*mg + ig + rwgt(ind) = wt(ig)/wtsm(ngm(ind)) + enddo + else + do ig = 1, ng(ibnd) + igcsm = igcsm + 1 + ind = (ibnd-1)*mg + ig + rwgt(ind) = 1.0_r8 + enddo + endif + enddo + +! Reduce g-points for absorption coefficient data in each LW spectral band. + + call cmbgb1 + call cmbgb2 + call cmbgb3 + call cmbgb4 + call cmbgb5 + call cmbgb6 + call cmbgb7 + call cmbgb8 + call cmbgb9 + call cmbgb10 + call cmbgb11 + call cmbgb12 + call cmbgb13 + call cmbgb14 + call cmbgb15 + call cmbgb16 + + end subroutine rrtmg_lw_ini + +!*************************************************************************** + subroutine lwdatinit +!*************************************************************************** + +! --------- Modules ---------- + + use parrrtm, only : maxxsec, maxinpx + use rrlw_con, only: heatfac, grav, planck, boltz, & + clight, avogad, alosmt, gascon, radcn1, radcn2 + use shr_const_mod, only: shr_const_avogad + use physconst, only: cday, gravit, cpair + + save + +! Longwave spectral band limits (wavenumbers) + wavenum1(:) = (/ 10._r8, 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, & + 980._r8,1080._r8,1180._r8,1390._r8,1480._r8,1800._r8, & + 2080._r8,2250._r8,2390._r8,2600._r8/) + wavenum2(:) = (/350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, & + 1080._r8,1180._r8,1390._r8,1480._r8,1800._r8,2080._r8, & + 2250._r8,2390._r8,2600._r8,3250._r8/) + delwave(:) = (/340._r8, 150._r8, 130._r8, 70._r8, 120._r8, 160._r8, & + 100._r8, 100._r8, 210._r8, 90._r8, 320._r8, 280._r8, & + 170._r8, 130._r8, 220._r8, 650._r8/) + +! Spectral band information + ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/) + nspa(:) = (/1,1,9,9,9,1,9,1,9,1,1,9,9,1,9,9/) + nspb(:) = (/1,1,5,5,5,0,1,1,1,1,1,0,0,1,0,0/) + +! Use constants set in CAM for consistency + grav = gravit + avogad = shr_const_avogad * 1.e-3_r8 + +! Heatfac is the factor by which one must multiply delta-flux/ +! delta-pressure, with flux in w/m-2 and pressure in mbar, to get +! the heating rate in units of degrees/day. It is equal to +! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p) +! = (9.8066)(86400)(1e-5)/(1.004) +! heatfac = 8.4391_r8 + +! Modified values for consistency with CAM: +! = (9.80616)(86400)(1e-5)/(1.00464) +! heatfac = 8.43339130434_r8 + +! Calculate heatfac directly from CAM constants: + heatfac = grav * cday * 1.e-5_r8 / (cpair * 1.e-3_r8) + +! nxmol - number of cross-sections input by user +! ixindx(i) - index of cross-section molecule corresponding to Ith +! cross-section specified by user +! = 0 -- not allowed in rrtm +! = 1 -- ccl4 +! = 2 -- cfc11 +! = 3 -- cfc12 +! = 4 -- cfc22 + nxmol = 4 + ixindx(1) = 1 + ixindx(2) = 2 + ixindx(3) = 3 + ixindx(4) = 4 + ixindx(5:maxinpx) = 0 + +! Constants from NIST 01/11/2002 + +! grav = 9.8066_r8 + planck = 6.62606876e-27_r8 + boltz = 1.3806503e-16_r8 + clight = 2.99792458e+10_r8 +! avogad = 6.02214199e+23_r8 + alosmt = 2.6867775e+19_r8 + gascon = 8.31447200e+07_r8 + radcn1 = 1.191042722e-12_r8 + radcn2 = 1.4387752_r8 + +! +! units are generally cgs +! +! The first and second radiation constants are taken from NIST. +! They were previously obtained from the relations: +! radcn1 = 2.*planck*clight*clight*1.e-07 +! radcn2 = planck*clight/boltz + + end subroutine lwdatinit + +!*************************************************************************** + subroutine lwcmbdat +!*************************************************************************** + + save + +! ------- Definitions ------- +! Arrays for the g-point reduction from 256 to 140 for the 16 LW bands: +! This mapping from 256 to 140 points has been carefully selected to +! minimize the effect on the resulting fluxes and cooling rates, and +! caution should be used if the mapping is modified. The full 256 +! g-point set can be restored with ngptlw=256, ngc=16*16, ngn=256*1., etc. +! ngptlw The total number of new g-points +! ngc The number of new g-points in each band +! ngs The cumulative sum of new g-points for each band +! ngm The index of each new g-point relative to the original +! 16 g-points for each band. +! ngn The number of original g-points that are combined to make +! each new g-point in each band. +! ngb The band index for each new g-point. +! wt RRTM weights for 16 g-points. + +! ------- Data statements ------- + ngc(:) = (/10,12,16,14,16,8,12,8,12,6,8,8,4,2,2,2/) + ngs(:) = (/10,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/) + ngm(:) = (/1,2,3,3,4,4,5,5,6,6,7,7,8,8,9,10, & ! band 1 + 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, & ! band 2 + 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 3 + 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, & ! band 4 + 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 5 + 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! band 6 + 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, & ! band 7 + 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! band 8 + 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, & ! band 9 + 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, & ! band 10 + 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, & ! band 11 + 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, & ! band 12 + 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, & ! band 13 + 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! band 14 + 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! band 15 + 1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2/) ! band 16 + ngn(:) = (/1,1,2,2,2,2,2,2,1,1, & ! band 1 + 1,1,1,1,1,1,1,1,2,2,2,2, & ! band 2 + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 3 + 1,1,1,1,1,1,1,1,1,1,1,1,1,3, & ! band 4 + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 5 + 2,2,2,2,2,2,2,2, & ! band 6 + 2,2,1,1,1,1,1,1,1,1,2,2, & ! band 7 + 2,2,2,2,2,2,2,2, & ! band 8 + 1,1,1,1,1,1,1,1,2,2,2,2, & ! band 9 + 2,2,2,2,4,4, & ! band 10 + 1,1,2,2,2,2,3,3, & ! band 11 + 1,1,1,1,2,2,4,4, & ! band 12 + 3,3,4,6, & ! band 13 + 8,8, & ! band 14 + 8,8, & ! band 15 + 4,12/) ! band 16 + ngb(:) = (/1,1,1,1,1,1,1,1,1,1, & ! band 1 + 2,2,2,2,2,2,2,2,2,2,2,2, & ! band 2 + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, & ! band 3 + 4,4,4,4,4,4,4,4,4,4,4,4,4,4, & ! band 4 + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, & ! band 5 + 6,6,6,6,6,6,6,6, & ! band 6 + 7,7,7,7,7,7,7,7,7,7,7,7, & ! band 7 + 8,8,8,8,8,8,8,8, & ! band 8 + 9,9,9,9,9,9,9,9,9,9,9,9, & ! band 9 + 10,10,10,10,10,10, & ! band 10 + 11,11,11,11,11,11,11,11, & ! band 11 + 12,12,12,12,12,12,12,12, & ! band 12 + 13,13,13,13, & ! band 13 + 14,14, & ! band 14 + 15,15, & ! band 15 + 16,16/) ! band 16 + wt(:) = (/ 0.1527534276_r8, 0.1491729617_r8, 0.1420961469_r8, & + 0.1316886544_r8, 0.1181945205_r8, 0.1019300893_r8, & + 0.0832767040_r8, 0.0626720116_r8, 0.0424925000_r8, & + 0.0046269894_r8, 0.0038279891_r8, 0.0030260086_r8, & + 0.0022199750_r8, 0.0014140010_r8, 0.0005330000_r8, & + 0.0000750000_r8/) + + end subroutine lwcmbdat + +!*************************************************************************** + subroutine cmbgb1 +!*************************************************************************** +! +! Original version: MJIacono; July 1998 +! Revision for GCMs: MJIacono; September 1998 +! Revision for RRTMG: MJIacono, September 2002 +! Revision for F90 reformatting: MJIacono, June 2006 +! +! The subroutines CMBGB1->CMBGB16 input the absorption coefficient +! data for each band, which are defined for 16 g-points and 16 spectral +! bands. The data are combined with appropriate weighting following the +! g-point mapping arrays specified in RRTMINIT. Plank fraction data +! in arrays FRACREFA and FRACREFB are combined without weighting. All +! g-point reduced data are put into new arrays for use in RRTM. +! +! band 1: 10-350 cm-1 (low key - h2o; low minor - n2) +! (high key - h2o; high minor - n2) +! note: previous versions of rrtm band 1: +! 10-250 cm-1 (low - h2o; high - h2o) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng1 + use rrlw_kg01, only: fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, ka_mn2, kb_mn2, & + selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumk1, sumk2, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(1) + sumk1 = 0. + sumk2 = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk1 = sumk1 + kao_mn2(jt,iprsm)*rwgt(iprsm) + sumk2 = sumk2 + kbo_mn2(jt,iprsm)*rwgt(iprsm) + enddo + ka_mn2(jt,igc) = sumk1 + kb_mn2(jt,igc) = sumk2 + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(1) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + enddo + + end subroutine cmbgb1 + +!*************************************************************************** + subroutine cmbgb2 +!*************************************************************************** +! +! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) +! +! note: previous version of rrtm band 2: +! 250 - 500 cm-1 (low - h2o; high - h2o) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng2 + use rrlw_kg02, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+16) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+16) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+16) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+16) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(2) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + enddo + + end subroutine cmbgb2 + +!*************************************************************************** + subroutine cmbgb3 +!*************************************************************************** +! +! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) +! (high key - h2o,co2; high minor - n2o) +! +! old band 3: 500-630 cm-1 (low - h2o,co2; high - h2o,co2) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng3 + use rrlw_kg03, only: fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, ka_mn2o, kb_mn2o, & + selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+32) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+32) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+32) + enddo + ka_mn2o(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jn = 1,5 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo_mn2o(jn,jt,iprsm)*rwgt(iprsm+32) + enddo + kb_mn2o(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+32) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+32) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(3) + sumf = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + do jp = 1,5 + iprsm = 0 + do igc = 1,ngc(3) + sumf = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm,jp) + enddo + fracrefb(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb3 + +!*************************************************************************** + subroutine cmbgb4 +!*************************************************************************** +! +! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) +! +! old band 4: 630-700 cm-1 (low - h2o,co2; high - o3,co2) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng4 + use rrlw_kg04, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+48) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+48) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+48) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+48) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(4) + sumf = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + do jp = 1,5 + iprsm = 0 + do igc = 1,ngc(4) + sumf = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm,jp) + enddo + fracrefb(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb4 + +!*************************************************************************** + subroutine cmbgb5 +!*************************************************************************** +! +! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) +! (high key - o3,co2) +! +! old band 5: 700-820 cm-1 (low - h2o,co2; high - o3,co2) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng5 + use rrlw_kg05, only: fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, ka_mo3, ccl4, & + selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+64) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+64) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mo3(jn,jt,iprsm)*rwgt(iprsm+64) + enddo + ka_mo3(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+64) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+64) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(5) + sumf = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + do jp = 1,5 + iprsm = 0 + do igc = 1,ngc(5) + sumf = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm,jp) + enddo + fracrefb(igc,jp) = sumf + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + ccl4o(iprsm)*rwgt(iprsm+64) + enddo + ccl4(igc) = sumk + enddo + + end subroutine cmbgb5 + +!*************************************************************************** + subroutine cmbgb6 +!*************************************************************************** +! +! band 6: 820-980 cm-1 (low key - h2o; low minor - co2) +! (high key - nothing; high minor - cfc11, cfc12) +! +! old band 6: 820-980 cm-1 (low - h2o; high - nothing) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng6 + use rrlw_kg06, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, & + selfrefo, forrefo, & + fracrefa, ka, ka_mco2, cfc11adj, cfc12, & + selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf, sumk1, sumk2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+80) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mco2(jt,iprsm)*rwgt(iprsm+80) + enddo + ka_mco2(jt,igc) = sumk + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+80) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+80) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(6) + sumf = 0. + sumk1= 0. + sumk2= 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm) + sumk1= sumk1+ cfc11adjo(iprsm)*rwgt(iprsm+80) + sumk2= sumk2+ cfc12o(iprsm)*rwgt(iprsm+80) + enddo + fracrefa(igc) = sumf + cfc11adj(igc) = sumk1 + cfc12(igc) = sumk2 + enddo + + end subroutine cmbgb6 + +!*************************************************************************** + subroutine cmbgb7 +!*************************************************************************** +! +! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) +! (high key - o3; high minor - co2) +! +! old band 7: 980-1080 cm-1 (low - h2o,o3; high - o3) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng7 + use rrlw_kg07, only: fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, ka_mco2, kb_mco2, & + selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+96) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+96) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+96) + enddo + ka_mco2(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo_mco2(jt,iprsm)*rwgt(iprsm+96) + enddo + kb_mco2(jt,igc) = sumk + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+96) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+96) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(7) + sumf = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(7) + sumf = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm) + enddo + fracrefb(igc) = sumf + enddo + + end subroutine cmbgb7 + +!*************************************************************************** + subroutine cmbgb8 +!*************************************************************************** +! +! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) +! (high key - o3; high minor - co2, n2o) +! +! old band 8: 1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng8 + use rrlw_kg08, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, & + kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, & + cfc12o, cfc22adjo, & + fracrefa, fracrefb, ka, ka_mco2, ka_mn2o, & + ka_mo3, kb, kb_mco2, kb_mn2o, selfref, forref, & + cfc12, cfc22adj + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumk1, sumk2, sumk3, sumk4, sumk5, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+112) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+112) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(8) + sumk1 = 0. + sumk2 = 0. + sumk3 = 0. + sumk4 = 0. + sumk5 = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk1 = sumk1 + kao_mco2(jt,iprsm)*rwgt(iprsm+112) + sumk2 = sumk2 + kbo_mco2(jt,iprsm)*rwgt(iprsm+112) + sumk3 = sumk3 + kao_mo3(jt,iprsm)*rwgt(iprsm+112) + sumk4 = sumk4 + kao_mn2o(jt,iprsm)*rwgt(iprsm+112) + sumk5 = sumk5 + kbo_mn2o(jt,iprsm)*rwgt(iprsm+112) + enddo + ka_mco2(jt,igc) = sumk1 + kb_mco2(jt,igc) = sumk2 + ka_mo3(jt,igc) = sumk3 + ka_mn2o(jt,igc) = sumk4 + kb_mn2o(jt,igc) = sumk5 + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(8) + sumf1= 0. + sumf2= 0. + sumk1= 0. + sumk2= 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + sumk1= sumk1+ cfc12o(iprsm)*rwgt(iprsm+112) + sumk2= sumk2+ cfc22adjo(iprsm)*rwgt(iprsm+112) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + cfc12(igc) = sumk1 + cfc22adj(igc) = sumk2 + enddo + + end subroutine cmbgb8 + +!*************************************************************************** + subroutine cmbgb9 +!*************************************************************************** +! +! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) +! (high key - ch4; high minor - n2o)! + +! old band 9: 1180-1390 cm-1 (low - h2o,ch4; high - ch4) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng9 + use rrlw_kg09, only: fracrefao, fracrefbo, kao, kao_mn2o, & + kbo, kbo_mn2o, selfrefo, forrefo, & + fracrefa, fracrefb, ka, ka_mn2o, & + kb, kb_mn2o, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+128) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+128) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+128) + enddo + ka_mn2o(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo_mn2o(jt,iprsm)*rwgt(iprsm+128) + enddo + kb_mn2o(jt,igc) = sumk + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+128) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+128) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(9) + sumf = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(9) + sumf = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm) + enddo + fracrefb(igc) = sumf + enddo + + end subroutine cmbgb9 + +!*************************************************************************** + subroutine cmbgb10 +!*************************************************************************** +! +! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) +! +! old band 10: 1390-1480 cm-1 (low - h2o; high - h2o) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng10 + use rrlw_kg10, only: fracrefao, fracrefbo, kao, kbo, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, & + selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(10) + sumk = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+144) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(10) + sumk = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+144) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(10) + sumk = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+144) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(10) + sumk = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+144) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(10) + sumf1= 0. + sumf2= 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + enddo + + end subroutine cmbgb10 + +!*************************************************************************** + subroutine cmbgb11 +!*************************************************************************** +! +! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) +! (high key - h2o; high minor - o2) +! +! old band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) +! (high key - h2o; high minor - o2) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng11 + use rrlw_kg11, only: fracrefao, fracrefbo, kao, kao_mo2, & + kbo, kbo_mo2, selfrefo, forrefo, & + fracrefa, fracrefb, ka, ka_mo2, & + kb, kb_mo2, selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumk1, sumk2, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(11) + sumk = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+160) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(11) + sumk = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+160) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(11) + sumk1 = 0. + sumk2 = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumk1 = sumk1 + kao_mo2(jt,iprsm)*rwgt(iprsm+160) + sumk2 = sumk2 + kbo_mo2(jt,iprsm)*rwgt(iprsm+160) + enddo + ka_mo2(jt,igc) = sumk1 + kb_mo2(jt,igc) = sumk2 + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(11) + sumk = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+160) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(11) + sumk = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+160) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(11) + sumf1= 0. + sumf2= 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + enddo + + end subroutine cmbgb11 + +!*************************************************************************** + subroutine cmbgb12 +!*************************************************************************** +! +! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +! +! old band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng12 + use rrlw_kg12, only: fracrefao, kao, selfrefo, forrefo, & + fracrefa, ka, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(12) + sumk = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+176) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(12) + sumk = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+176) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(12) + sumk = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+176) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(12) + sumf = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb12 + +!*************************************************************************** + subroutine cmbgb13 +!*************************************************************************** +! +! band 13: 2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor) +! +! old band 13: 2080-2250 cm-1 (low - h2o,n2o; high - nothing) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng13 + use rrlw_kg13, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mco, & + kbo_mo3, selfrefo, forrefo, & + fracrefa, fracrefb, ka, ka_mco2, ka_mco, & + kb_mo3, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumk1, sumk2, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+192) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(13) + sumk1 = 0. + sumk2 = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk1 = sumk1 + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+192) + sumk2 = sumk2 + kao_mco(jn,jt,iprsm)*rwgt(iprsm+192) + enddo + ka_mco2(jn,jt,igc) = sumk1 + ka_mco(jn,jt,igc) = sumk2 + enddo + enddo + enddo + + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo_mo3(jt,iprsm)*rwgt(iprsm+192) + enddo + kb_mo3(jt,igc) = sumk + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+192) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+192) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(13) + sumf = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm) + enddo + fracrefb(igc) = sumf + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(13) + sumf = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb13 + +!*************************************************************************** + subroutine cmbgb14 +!*************************************************************************** +! +! band 14: 2250-2380 cm-1 (low - co2; high - co2) +! +! old band 14: 2250-2380 cm-1 (low - co2; high - co2) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng14 + use rrlw_kg14, only: fracrefao, fracrefbo, kao, kbo, & + selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, & + selfref, forref + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+208) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+208) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+208) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+208) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(14) + sumf1= 0. + sumf2= 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumf1= sumf1+ fracrefao(iprsm) + sumf2= sumf2+ fracrefbo(iprsm) + enddo + fracrefa(igc) = sumf1 + fracrefb(igc) = sumf2 + enddo + + end subroutine cmbgb14 + +!*************************************************************************** + subroutine cmbgb15 +!*************************************************************************** +! +! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) +! (high - nothing) +! +! old band 15: 2380-2600 cm-1 (low - n2o,co2; high - nothing) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng15 + use rrlw_kg15, only: fracrefao, kao, kao_mn2, selfrefo, forrefo, & + fracrefa, ka, ka_mn2, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(15) + sumk = 0. + do ipr = 1, ngn(ngs(14)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+224) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,9 + do jt = 1,19 + iprsm = 0 + do igc = 1,ngc(15) + sumk = 0. + do ipr = 1, ngn(ngs(14)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao_mn2(jn,jt,iprsm)*rwgt(iprsm+224) + enddo + ka_mn2(jn,jt,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(15) + sumk = 0. + do ipr = 1, ngn(ngs(14)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+224) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(15) + sumk = 0. + do ipr = 1, ngn(ngs(14)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+224) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(15) + sumf = 0. + do ipr = 1, ngn(ngs(14)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb15 + +!*************************************************************************** + subroutine cmbgb16 +!*************************************************************************** +! +! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) +! +! old band 16: 2600-3000 cm-1 (low - h2o,ch4; high - nothing) +!*************************************************************************** + + use parrrtm, only : mg, nbndlw, ngptlw, ng16 + use rrlw_kg16, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, & + fracrefa, fracrefb, ka, kb, selfref, forref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(16) + sumk = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+240) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(16) + sumk = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+240) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(16) + sumk = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+240) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(16) + sumk = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+240) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(16) + sumf = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefbo(iprsm) + enddo + fracrefb(igc) = sumf + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(16) + sumf = 0. + do ipr = 1, ngn(ngs(15)+igc) + iprsm = iprsm + 1 + sumf = sumf + fracrefao(iprsm,jp) + enddo + fracrefa(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb16 + +!*************************************************************************** + + end module rrtmg_lw_init + diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 new file mode 100644 index 0000000000..ee4cc5f5e7 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_k_g.f90 @@ -0,0 +1,76246 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_k_g.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/22 19:20:03 $ +! +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ************************************************************************** +! subroutine lw_kgbnn +! ************************************************************************** +! RRTM Longwave Radiative Transfer Model +! Atmospheric and Environmental Research, Inc., Cambridge, MA +! +! Original version: E. J. Mlawer, et al. +! Revision for GCMs: Michael J. Iacono; October, 2002 +! +! This file contains 16 subroutines that include the +! absorption coefficients and other data for each of the 16 longwave +! spectral bands used in RRTM. Here, the data are defined for 16 +! g-points, or sub-intervals, per band. These data are combined and +! weighted using a mapping procedure in routine RRTMG_LW_INIT to reduce +! the total number of g-points from 256 to 140 for use in the GCM. +! ************************************************************************** + subroutine lw_kgb01 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg01, only : fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, & + selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K + fracrefao(:) = (/ & + 2.1227E-01_r8,1.8897E-01_r8,1.3934E-01_r8,1.1557E-01_r8,9.5282E-02_r8,8.3359E-02_r8, & + 6.5333E-02_r8,5.2016E-02_r8,3.4272E-02_r8,4.0257E-03_r8,3.1857E-03_r8,2.6014E-03_r8, & + 1.9141E-03_r8,1.2612E-03_r8,5.3169E-04_r8,7.6476E-05_r8/) + +! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K +! These Planck fractions were calculated using lower atmosphere +! parameters. + fracrefbo(:) = (/ & + 2.1227E-01_r8,1.8897E-01_r8,1.3934E-01_r8,1.1557E-01_r8,9.5282E-02_r8,8.3359E-02_r8, & + 6.5333E-02_r8,5.2016E-02_r8,3.4272E-02_r8,4.0257E-03_r8,3.1857E-03_r8,2.6014E-03_r8, & + 1.9141E-03_r8,1.2612E-03_r8,5.3169E-04_r8,7.6476E-05_r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &1.1936e-01_r8,1.2127e-01_r8,1.2290e-01_r8,1.2324e-01_r8,1.2302e-01_r8/) + kao(:, 2, 1) = (/ & + &9.3666e-02_r8,9.6336e-02_r8,9.8457e-02_r8,9.9155e-02_r8,9.9330e-02_r8/) + kao(:, 3, 1) = (/ & + &7.3480e-02_r8,7.5571e-02_r8,7.7998e-02_r8,7.9619e-02_r8,8.0000e-02_r8/) + kao(:, 4, 1) = (/ & + &5.8417e-02_r8,6.0062e-02_r8,6.2150e-02_r8,6.4024e-02_r8,6.4943e-02_r8/) + kao(:, 5, 1) = (/ & + &4.6742e-02_r8,4.8171e-02_r8,4.9840e-02_r8,5.1580e-02_r8,5.2974e-02_r8/) + kao(:, 6, 1) = (/ & + &3.7093e-02_r8,3.8712e-02_r8,4.0031e-02_r8,4.1473e-02_r8,4.2868e-02_r8/) + kao(:, 7, 1) = (/ & + &2.9515e-02_r8,3.1114e-02_r8,3.2344e-02_r8,3.3496e-02_r8,3.4715e-02_r8/) + kao(:, 8, 1) = (/ & + &2.3548e-02_r8,2.5012e-02_r8,2.6176e-02_r8,2.7253e-02_r8,2.8263e-02_r8/) + kao(:, 9, 1) = (/ & + &1.9136e-02_r8,2.0420e-02_r8,2.1607e-02_r8,2.2607e-02_r8,2.3502e-02_r8/) + kao(:,10, 1) = (/ & + &1.6947e-02_r8,1.8986e-02_r8,2.0617e-02_r8,2.1896e-02_r8,2.2928e-02_r8/) + kao(:,11, 1) = (/ & + &1.4724e-02_r8,1.6490e-02_r8,1.8468e-02_r8,1.9875e-02_r8,2.1095e-02_r8/) + kao(:,12, 1) = (/ & + &1.2332e-02_r8,1.3992e-02_r8,1.5549e-02_r8,1.7137e-02_r8,1.8190e-02_r8/) + kao(:,13, 1) = (/ & + &1.0144e-02_r8,1.1539e-02_r8,1.2861e-02_r8,1.4225e-02_r8,1.5224e-02_r8/) + kao(:, 1, 2) = (/ & + &3.5138e-01_r8,3.5502e-01_r8,3.5774e-01_r8,3.5894e-01_r8,3.5740e-01_r8/) + kao(:, 2, 2) = (/ & + &2.8740e-01_r8,2.8961e-01_r8,2.9119e-01_r8,2.9268e-01_r8,2.9128e-01_r8/) + kao(:, 3, 2) = (/ & + &2.3142e-01_r8,2.3495e-01_r8,2.3595e-01_r8,2.3731e-01_r8,2.3828e-01_r8/) + kao(:, 4, 2) = (/ & + &1.8684e-01_r8,1.9090e-01_r8,1.9387e-01_r8,1.9355e-01_r8,1.9518e-01_r8/) + kao(:, 5, 2) = (/ & + &1.5108e-01_r8,1.5525e-01_r8,1.5832e-01_r8,1.5904e-01_r8,1.5962e-01_r8/) + kao(:, 6, 2) = (/ & + &1.2219e-01_r8,1.2585e-01_r8,1.2901e-01_r8,1.3090e-01_r8,1.3158e-01_r8/) + kao(:, 7, 2) = (/ & + &9.8743e-02_r8,1.0185e-01_r8,1.0506e-01_r8,1.0763e-01_r8,1.0820e-01_r8/) + kao(:, 8, 2) = (/ & + &7.9966e-02_r8,8.2922e-02_r8,8.5859e-02_r8,8.8462e-02_r8,8.9282e-02_r8/) + kao(:, 9, 2) = (/ & + &6.5726e-02_r8,6.8954e-02_r8,7.1786e-02_r8,7.3678e-02_r8,7.5233e-02_r8/) + kao(:,10, 2) = (/ & + &6.0011e-02_r8,6.2230e-02_r8,6.5254e-02_r8,6.7031e-02_r8,6.9052e-02_r8/) + kao(:,11, 2) = (/ & + &5.5743e-02_r8,5.7099e-02_r8,5.8802e-02_r8,6.0875e-02_r8,6.2690e-02_r8/) + kao(:,12, 2) = (/ & + &4.9598e-02_r8,5.1234e-02_r8,5.2659e-02_r8,5.3951e-02_r8,5.5431e-02_r8/) + kao(:,13, 2) = (/ & + &4.1938e-02_r8,4.3540e-02_r8,4.4990e-02_r8,4.6074e-02_r8,4.6999e-02_r8/) + kao(:, 1, 3) = (/ & + &8.4590e-01_r8,8.4151e-01_r8,8.3682e-01_r8,8.3729e-01_r8,8.3944e-01_r8/) + kao(:, 2, 3) = (/ & + &6.8809e-01_r8,6.8696e-01_r8,6.8512e-01_r8,6.8470e-01_r8,6.8864e-01_r8/) + kao(:, 3, 3) = (/ & + &5.6065e-01_r8,5.5891e-01_r8,5.5871e-01_r8,5.5784e-01_r8,5.6029e-01_r8/) + kao(:, 4, 3) = (/ & + &4.6097e-01_r8,4.6021e-01_r8,4.5874e-01_r8,4.6110e-01_r8,4.6088e-01_r8/) + kao(:, 5, 3) = (/ & + &3.8076e-01_r8,3.8128e-01_r8,3.8007e-01_r8,3.8126e-01_r8,3.8214e-01_r8/) + kao(:, 6, 3) = (/ & + &3.1396e-01_r8,3.1576e-01_r8,3.1554e-01_r8,3.1478e-01_r8,3.1602e-01_r8/) + kao(:, 7, 3) = (/ & + &2.5841e-01_r8,2.6039e-01_r8,2.6160e-01_r8,2.6034e-01_r8,2.6147e-01_r8/) + kao(:, 8, 3) = (/ & + &2.1354e-01_r8,2.1540e-01_r8,2.1664e-01_r8,2.1675e-01_r8,2.1689e-01_r8/) + kao(:, 9, 3) = (/ & + &1.8409e-01_r8,1.8340e-01_r8,1.8423e-01_r8,1.8535e-01_r8,1.8550e-01_r8/) + kao(:,10, 3) = (/ & + &1.7687e-01_r8,1.8149e-01_r8,1.8138e-01_r8,1.8043e-01_r8,1.8050e-01_r8/) + kao(:,11, 3) = (/ & + &1.6660e-01_r8,1.6980e-01_r8,1.7005e-01_r8,1.7156e-01_r8,1.6983e-01_r8/) + kao(:,12, 3) = (/ & + &1.4699e-01_r8,1.5037e-01_r8,1.5032e-01_r8,1.5012e-01_r8,1.5041e-01_r8/) + kao(:,13, 3) = (/ & + &1.2497e-01_r8,1.2733e-01_r8,1.2732e-01_r8,1.2710e-01_r8,1.2722e-01_r8/) + kao(:, 1, 4) = (/ & + &1.8528e+00_r8,1.8358e+00_r8,1.8100e+00_r8,1.7728e+00_r8,1.7348e+00_r8/) + kao(:, 2, 4) = (/ & + &1.5191e+00_r8,1.5067e+00_r8,1.4864e+00_r8,1.4586e+00_r8,1.4273e+00_r8/) + kao(:, 3, 4) = (/ & + &1.2421e+00_r8,1.2332e+00_r8,1.2184e+00_r8,1.1999e+00_r8,1.1763e+00_r8/) + kao(:, 4, 4) = (/ & + &1.0235e+00_r8,1.0199e+00_r8,1.0105e+00_r8,9.9649e-01_r8,9.8141e-01_r8/) + kao(:, 5, 4) = (/ & + &8.4444e-01_r8,8.4579e-01_r8,8.4104e-01_r8,8.3201e-01_r8,8.2148e-01_r8/) + kao(:, 6, 4) = (/ & + &6.9623e-01_r8,7.0066e-01_r8,6.9879e-01_r8,6.9507e-01_r8,6.8745e-01_r8/) + kao(:, 7, 4) = (/ & + &5.7271e-01_r8,5.7848e-01_r8,5.7971e-01_r8,5.7773e-01_r8,5.7376e-01_r8/) + kao(:, 8, 4) = (/ & + &4.7082e-01_r8,4.7730e-01_r8,4.8061e-01_r8,4.7996e-01_r8,4.7783e-01_r8/) + kao(:, 9, 4) = (/ & + &3.8997e-01_r8,3.9821e-01_r8,4.0249e-01_r8,4.0315e-01_r8,4.0145e-01_r8/) + kao(:,10, 4) = (/ & + &3.5012e-01_r8,3.4335e-01_r8,3.3833e-01_r8,3.3654e-01_r8,3.3448e-01_r8/) + kao(:,11, 4) = (/ & + &3.1060e-01_r8,3.1084e-01_r8,3.0440e-01_r8,2.9201e-01_r8,2.8482e-01_r8/) + kao(:,12, 4) = (/ & + &2.7883e-01_r8,2.7190e-01_r8,2.6805e-01_r8,2.5917e-01_r8,2.4860e-01_r8/) + kao(:,13, 4) = (/ & + &2.3244e-01_r8,2.2666e-01_r8,2.2365e-01_r8,2.1647e-01_r8,2.0828e-01_r8/) + kao(:, 1, 5) = (/ & + &3.3225e+00_r8,3.2784e+00_r8,3.2423e+00_r8,3.2074e+00_r8,3.1704e+00_r8/) + kao(:, 2, 5) = (/ & + &2.7581e+00_r8,2.7256e+00_r8,2.6962e+00_r8,2.6686e+00_r8,2.6375e+00_r8/) + kao(:, 3, 5) = (/ & + &2.2798e+00_r8,2.2570e+00_r8,2.2330e+00_r8,2.2089e+00_r8,2.1829e+00_r8/) + kao(:, 4, 5) = (/ & + &1.8979e+00_r8,1.8796e+00_r8,1.8601e+00_r8,1.8393e+00_r8,1.8181e+00_r8/) + kao(:, 5, 5) = (/ & + &1.5861e+00_r8,1.5695e+00_r8,1.5550e+00_r8,1.5372e+00_r8,1.5203e+00_r8/) + kao(:, 6, 5) = (/ & + &1.3252e+00_r8,1.3124e+00_r8,1.3013e+00_r8,1.2872e+00_r8,1.2740e+00_r8/) + kao(:, 7, 5) = (/ & + &1.1027e+00_r8,1.0966e+00_r8,1.0870e+00_r8,1.0776e+00_r8,1.0667e+00_r8/) + kao(:, 8, 5) = (/ & + &9.1563e-01_r8,9.1410e-01_r8,9.0764e-01_r8,8.9982e-01_r8,8.9251e-01_r8/) + kao(:, 9, 5) = (/ & + &7.6595e-01_r8,7.6784e-01_r8,7.6494e-01_r8,7.5888e-01_r8,7.5288e-01_r8/) + kao(:,10, 5) = (/ & + &6.3388e-01_r8,6.4169e-01_r8,6.4724e-01_r8,6.4562e-01_r8,6.3971e-01_r8/) + kao(:,11, 5) = (/ & + &5.2794e-01_r8,5.2411e-01_r8,5.2455e-01_r8,5.2936e-01_r8,5.2927e-01_r8/) + kao(:,12, 5) = (/ & + &4.3721e-01_r8,4.3826e-01_r8,4.3490e-01_r8,4.3598e-01_r8,4.3794e-01_r8/) + kao(:,13, 5) = (/ & + &3.6693e-01_r8,3.6670e-01_r8,3.6374e-01_r8,3.6513e-01_r8,3.6694e-01_r8/) + kao(:, 1, 6) = (/ & + &6.6283e+00_r8,6.5357e+00_r8,6.4205e+00_r8,6.3046e+00_r8,6.1937e+00_r8/) + kao(:, 2, 6) = (/ & + &5.5921e+00_r8,5.5122e+00_r8,5.4227e+00_r8,5.3355e+00_r8,5.2548e+00_r8/) + kao(:, 3, 6) = (/ & + &4.6918e+00_r8,4.6295e+00_r8,4.5667e+00_r8,4.5016e+00_r8,4.4390e+00_r8/) + kao(:, 4, 6) = (/ & + &3.9477e+00_r8,3.9046e+00_r8,3.8607e+00_r8,3.8148e+00_r8,3.7628e+00_r8/) + kao(:, 5, 6) = (/ & + &3.3255e+00_r8,3.2963e+00_r8,3.2647e+00_r8,3.2299e+00_r8,3.1875e+00_r8/) + kao(:, 6, 6) = (/ & + &2.7972e+00_r8,2.7784e+00_r8,2.7561e+00_r8,2.7282e+00_r8,2.6941e+00_r8/) + kao(:, 7, 6) = (/ & + &2.3458e+00_r8,2.3342e+00_r8,2.3185e+00_r8,2.2969e+00_r8,2.2704e+00_r8/) + kao(:, 8, 6) = (/ & + &1.9572e+00_r8,1.9527e+00_r8,1.9423e+00_r8,1.9266e+00_r8,1.9056e+00_r8/) + kao(:, 9, 6) = (/ & + &1.6385e+00_r8,1.6357e+00_r8,1.6281e+00_r8,1.6171e+00_r8,1.6000e+00_r8/) + kao(:,10, 6) = (/ & + &1.4144e+00_r8,1.4143e+00_r8,1.4078e+00_r8,1.4009e+00_r8,1.3895e+00_r8/) + kao(:,11, 6) = (/ & + &1.1820e+00_r8,1.1847e+00_r8,1.1842e+00_r8,1.1773e+00_r8,1.1681e+00_r8/) + kao(:,12, 6) = (/ & + &9.7725e-01_r8,9.8091e-01_r8,9.8204e-01_r8,9.7703e-01_r8,9.7159e-01_r8/) + kao(:,13, 6) = (/ & + &8.1815e-01_r8,8.2185e-01_r8,8.2056e-01_r8,8.1693e-01_r8,8.1119e-01_r8/) + kao(:, 1, 7) = (/ & + &1.4313e+01_r8,1.4082e+01_r8,1.3850e+01_r8,1.3623e+01_r8,1.3382e+01_r8/) + kao(:, 2, 7) = (/ & + &1.2515e+01_r8,1.2314e+01_r8,1.2108e+01_r8,1.1882e+01_r8,1.1633e+01_r8/) + kao(:, 3, 7) = (/ & + &1.0802e+01_r8,1.0631e+01_r8,1.0439e+01_r8,1.0228e+01_r8,1.0005e+01_r8/) + kao(:, 4, 7) = (/ & + &9.2958e+00_r8,9.1469e+00_r8,8.9753e+00_r8,8.7884e+00_r8,8.6020e+00_r8/) + kao(:, 5, 7) = (/ & + &7.9646e+00_r8,7.8400e+00_r8,7.6929e+00_r8,7.5385e+00_r8,7.3901e+00_r8/) + kao(:, 6, 7) = (/ & + &6.7986e+00_r8,6.6983e+00_r8,6.5761e+00_r8,6.4518e+00_r8,6.3346e+00_r8/) + kao(:, 7, 7) = (/ & + &5.7703e+00_r8,5.6909e+00_r8,5.5962e+00_r8,5.4989e+00_r8,5.4062e+00_r8/) + kao(:, 8, 7) = (/ & + &4.8763e+00_r8,4.8159e+00_r8,4.7441e+00_r8,4.6692e+00_r8,4.5978e+00_r8/) + kao(:, 9, 7) = (/ & + &4.0868e+00_r8,4.0475e+00_r8,3.9918e+00_r8,3.9346e+00_r8,3.8784e+00_r8/) + kao(:,10, 7) = (/ & + &3.5589e+00_r8,3.5215e+00_r8,3.4698e+00_r8,3.4096e+00_r8,3.3531e+00_r8/) + kao(:,11, 7) = (/ & + &3.0702e+00_r8,3.0357e+00_r8,2.9927e+00_r8,2.9456e+00_r8,2.8950e+00_r8/) + kao(:,12, 7) = (/ & + &2.6022e+00_r8,2.5722e+00_r8,2.5392e+00_r8,2.5002e+00_r8,2.4548e+00_r8/) + kao(:,13, 7) = (/ & + &2.1727e+00_r8,2.1507e+00_r8,2.1220e+00_r8,2.0892e+00_r8,2.0541e+00_r8/) + kao(:, 1, 8) = (/ & + &3.4174e+01_r8,3.3741e+01_r8,3.3273e+01_r8,3.2762e+01_r8,3.2231e+01_r8/) + kao(:, 2, 8) = (/ & + &3.1501e+01_r8,3.1077e+01_r8,3.0621e+01_r8,3.0167e+01_r8,2.9717e+01_r8/) + kao(:, 3, 8) = (/ & + &2.8624e+01_r8,2.8247e+01_r8,2.7846e+01_r8,2.7455e+01_r8,2.7037e+01_r8/) + kao(:, 4, 8) = (/ & + &2.5860e+01_r8,2.5530e+01_r8,2.5179e+01_r8,2.4813e+01_r8,2.4424e+01_r8/) + kao(:, 5, 8) = (/ & + &2.3133e+01_r8,2.2868e+01_r8,2.2552e+01_r8,2.2222e+01_r8,2.1874e+01_r8/) + kao(:, 6, 8) = (/ & + &2.0417e+01_r8,2.0203e+01_r8,1.9954e+01_r8,1.9685e+01_r8,1.9370e+01_r8/) + kao(:, 7, 8) = (/ & + &1.7808e+01_r8,1.7656e+01_r8,1.7468e+01_r8,1.7234e+01_r8,1.6957e+01_r8/) + kao(:, 8, 8) = (/ & + &1.5349e+01_r8,1.5257e+01_r8,1.5109e+01_r8,1.4918e+01_r8,1.4683e+01_r8/) + kao(:, 9, 8) = (/ & + &1.3085e+01_r8,1.3031e+01_r8,1.2930e+01_r8,1.2779e+01_r8,1.2590e+01_r8/) + kao(:,10, 8) = (/ & + &1.0971e+01_r8,1.0917e+01_r8,1.0852e+01_r8,1.0748e+01_r8,1.0603e+01_r8/) + kao(:,11, 8) = (/ & + &9.5673e+00_r8,9.4985e+00_r8,9.4337e+00_r8,9.3153e+00_r8,9.1800e+00_r8/) + kao(:,12, 8) = (/ & + &8.2885e+00_r8,8.2471e+00_r8,8.1591e+00_r8,8.0541e+00_r8,7.9348e+00_r8/) + kao(:,13, 8) = (/ & + &7.1017e+00_r8,7.0462e+00_r8,6.9629e+00_r8,6.8569e+00_r8,6.7518e+00_r8/) + kao(:, 1, 9) = (/ & + &9.9761e+01_r8,9.8762e+01_r8,9.7605e+01_r8,9.6340e+01_r8,9.4995e+01_r8/) + kao(:, 2, 9) = (/ & + &9.9948e+01_r8,9.8866e+01_r8,9.7644e+01_r8,9.6363e+01_r8,9.4985e+01_r8/) + kao(:, 3, 9) = (/ & + &9.9007e+01_r8,9.8007e+01_r8,9.6838e+01_r8,9.5570e+01_r8,9.4251e+01_r8/) + kao(:, 4, 9) = (/ & + &9.6662e+01_r8,9.5791e+01_r8,9.4804e+01_r8,9.3746e+01_r8,9.2558e+01_r8/) + kao(:, 5, 9) = (/ & + &9.3093e+01_r8,9.2470e+01_r8,9.1704e+01_r8,9.0779e+01_r8,8.9739e+01_r8/) + kao(:, 6, 9) = (/ & + &8.8508e+01_r8,8.8114e+01_r8,8.7530e+01_r8,8.6816e+01_r8,8.5948e+01_r8/) + kao(:, 7, 9) = (/ & + &8.2974e+01_r8,8.2771e+01_r8,8.2394e+01_r8,8.1879e+01_r8,8.1118e+01_r8/) + kao(:, 8, 9) = (/ & + &7.6684e+01_r8,7.6645e+01_r8,7.6457e+01_r8,7.6020e+01_r8,7.5326e+01_r8/) + kao(:, 9, 9) = (/ & + &6.9973e+01_r8,7.0055e+01_r8,6.9978e+01_r8,6.9596e+01_r8,6.8941e+01_r8/) + kao(:,10, 9) = (/ & + &6.2676e+01_r8,6.2928e+01_r8,6.2907e+01_r8,6.2549e+01_r8,6.1993e+01_r8/) + kao(:,11, 9) = (/ & + &5.5263e+01_r8,5.5480e+01_r8,5.5306e+01_r8,5.4944e+01_r8,5.4442e+01_r8/) + kao(:,12, 9) = (/ & + &4.8636e+01_r8,4.8624e+01_r8,4.8458e+01_r8,4.8148e+01_r8,4.7712e+01_r8/) + kao(:,13, 9) = (/ & + &4.2167e+01_r8,4.2169e+01_r8,4.2037e+01_r8,4.1794e+01_r8,4.1453e+01_r8/) + kao(:, 1,10) = (/ & + &2.2059e+02_r8,2.1997e+02_r8,2.1921e+02_r8,2.1843e+02_r8,2.1743e+02_r8/) + kao(:, 2,10) = (/ & + &2.3102e+02_r8,2.3132e+02_r8,2.3151e+02_r8,2.3081e+02_r8,2.3008e+02_r8/) + kao(:, 3,10) = (/ & + &2.4111e+02_r8,2.4197e+02_r8,2.4166e+02_r8,2.4016e+02_r8,2.3836e+02_r8/) + kao(:, 4,10) = (/ & + &2.5158e+02_r8,2.5229e+02_r8,2.5082e+02_r8,2.4795e+02_r8,2.4522e+02_r8/) + kao(:, 5,10) = (/ & + &2.5765e+02_r8,2.5772e+02_r8,2.5582e+02_r8,2.5268e+02_r8,2.4923e+02_r8/) + kao(:, 6,10) = (/ & + &2.5856e+02_r8,2.5749e+02_r8,2.5502e+02_r8,2.5166e+02_r8,2.4826e+02_r8/) + kao(:, 7,10) = (/ & + &2.5368e+02_r8,2.5237e+02_r8,2.4999e+02_r8,2.4711e+02_r8,2.4470e+02_r8/) + kao(:, 8,10) = (/ & + &2.4476e+02_r8,2.4415e+02_r8,2.4213e+02_r8,2.4060e+02_r8,2.3968e+02_r8/) + kao(:, 9,10) = (/ & + &2.3178e+02_r8,2.3169e+02_r8,2.3048e+02_r8,2.3066e+02_r8,2.3132e+02_r8/) + kao(:,10,10) = (/ & + &2.1736e+02_r8,2.1726e+02_r8,2.1730e+02_r8,2.1880e+02_r8,2.1934e+02_r8/) + kao(:,11,10) = (/ & + &2.0114e+02_r8,2.0172e+02_r8,2.0351e+02_r8,2.0457e+02_r8,2.0387e+02_r8/) + kao(:,12,10) = (/ & + &1.8488e+02_r8,1.8650e+02_r8,1.8715e+02_r8,1.8619e+02_r8,1.8458e+02_r8/) + kao(:,13,10) = (/ & + &1.7142e+02_r8,1.7281e+02_r8,1.7236e+02_r8,1.7114e+02_r8,1.6934e+02_r8/) + kao(:, 1,11) = (/ & + &2.9459e+02_r8,2.9267e+02_r8,2.9151e+02_r8,2.8931e+02_r8,2.8695e+02_r8/) + kao(:, 2,11) = (/ & + &3.1654e+02_r8,3.1722e+02_r8,3.1773e+02_r8,3.1519e+02_r8,3.1185e+02_r8/) + kao(:, 3,11) = (/ & + &3.3345e+02_r8,3.3361e+02_r8,3.3487e+02_r8,3.3474e+02_r8,3.3330e+02_r8/) + kao(:, 4,11) = (/ & + &3.4222e+02_r8,3.4143e+02_r8,3.4230e+02_r8,3.4254e+02_r8,3.4132e+02_r8/) + kao(:, 5,11) = (/ & + &3.5206e+02_r8,3.5057e+02_r8,3.4997e+02_r8,3.4857e+02_r8,3.4588e+02_r8/) + kao(:, 6,11) = (/ & + &3.6028e+02_r8,3.6070e+02_r8,3.6119e+02_r8,3.5790e+02_r8,3.5262e+02_r8/) + kao(:, 7,11) = (/ & + &3.6620e+02_r8,3.6652e+02_r8,3.6631e+02_r8,3.6276e+02_r8,3.5799e+02_r8/) + kao(:, 8,11) = (/ & + &3.6855e+02_r8,3.6845e+02_r8,3.6741e+02_r8,3.6316e+02_r8,3.5815e+02_r8/) + kao(:, 9,11) = (/ & + &3.6490e+02_r8,3.6506e+02_r8,3.6353e+02_r8,3.5922e+02_r8,3.5455e+02_r8/) + kao(:,10,11) = (/ & + &3.5317e+02_r8,3.5433e+02_r8,3.5339e+02_r8,3.5013e+02_r8,3.4719e+02_r8/) + kao(:,11,11) = (/ & + &3.3639e+02_r8,3.3748e+02_r8,3.3591e+02_r8,3.3444e+02_r8,3.3466e+02_r8/) + kao(:,12,11) = (/ & + &3.1388e+02_r8,3.1454e+02_r8,3.1501e+02_r8,3.1656e+02_r8,3.1666e+02_r8/) + kao(:,13,11) = (/ & + &2.9044e+02_r8,2.9107e+02_r8,2.9274e+02_r8,2.9324e+02_r8,2.9124e+02_r8/) + kao(:, 1,12) = (/ & + &3.8243e+02_r8,3.8335e+02_r8,3.8560e+02_r8,3.8967e+02_r8,3.9390e+02_r8/) + kao(:, 2,12) = (/ & + &4.2476e+02_r8,4.2018e+02_r8,4.1643e+02_r8,4.1764e+02_r8,4.1841e+02_r8/) + kao(:, 3,12) = (/ & + &4.5902e+02_r8,4.5366e+02_r8,4.4789e+02_r8,4.4616e+02_r8,4.4366e+02_r8/) + kao(:, 4,12) = (/ & + &4.8576e+02_r8,4.8192e+02_r8,4.7838e+02_r8,4.7712e+02_r8,4.7436e+02_r8/) + kao(:, 5,12) = (/ & + &5.0548e+02_r8,5.0130e+02_r8,4.9886e+02_r8,4.9965e+02_r8,4.9992e+02_r8/) + kao(:, 6,12) = (/ & + &5.2714e+02_r8,5.1902e+02_r8,5.1379e+02_r8,5.1543e+02_r8,5.1780e+02_r8/) + kao(:, 7,12) = (/ & + &5.5149e+02_r8,5.4136e+02_r8,5.3395e+02_r8,5.3343e+02_r8,5.3337e+02_r8/) + kao(:, 8,12) = (/ & + &5.7260e+02_r8,5.6332e+02_r8,5.5702e+02_r8,5.5596e+02_r8,5.5242e+02_r8/) + kao(:, 9,12) = (/ & + &5.8640e+02_r8,5.7843e+02_r8,5.7443e+02_r8,5.7374e+02_r8,5.6970e+02_r8/) + kao(:,10,12) = (/ & + &5.9437e+02_r8,5.8760e+02_r8,5.8375e+02_r8,5.8166e+02_r8,5.7639e+02_r8/) + kao(:,11,12) = (/ & + &5.8998e+02_r8,5.8468e+02_r8,5.8336e+02_r8,5.7943e+02_r8,5.7161e+02_r8/) + kao(:,12,12) = (/ & + &5.7429e+02_r8,5.7360e+02_r8,5.7128e+02_r8,5.6564e+02_r8,5.6011e+02_r8/) + kao(:,13,12) = (/ & + &5.5035e+02_r8,5.5083e+02_r8,5.4893e+02_r8,5.4549e+02_r8,5.4357e+02_r8/) + kao(:, 1,13) = (/ & + &4.9343e+02_r8,4.9586e+02_r8,4.9750e+02_r8,4.9873e+02_r8,4.9898e+02_r8/) + kao(:, 2,13) = (/ & + &5.4485e+02_r8,5.4781e+02_r8,5.5082e+02_r8,5.5168e+02_r8,5.5417e+02_r8/) + kao(:, 3,13) = (/ & + &6.1399e+02_r8,6.1257e+02_r8,6.1216e+02_r8,6.1051e+02_r8,6.1193e+02_r8/) + kao(:, 4,13) = (/ & + &6.9330e+02_r8,6.8682e+02_r8,6.8040e+02_r8,6.7417e+02_r8,6.7247e+02_r8/) + kao(:, 5,13) = (/ & + &7.6881e+02_r8,7.6265e+02_r8,7.5375e+02_r8,7.4386e+02_r8,7.3721e+02_r8/) + kao(:, 6,13) = (/ & + &8.3052e+02_r8,8.2987e+02_r8,8.2363e+02_r8,8.1336e+02_r8,8.0445e+02_r8/) + kao(:, 7,13) = (/ & + &8.8082e+02_r8,8.8344e+02_r8,8.8117e+02_r8,8.7395e+02_r8,8.6653e+02_r8/) + kao(:, 8,13) = (/ & + &9.2485e+02_r8,9.2603e+02_r8,9.2355e+02_r8,9.1727e+02_r8,9.1414e+02_r8/) + kao(:, 9,13) = (/ & + &9.7276e+02_r8,9.7146e+02_r8,9.6566e+02_r8,9.5635e+02_r8,9.5212e+02_r8/) + kao(:,10,13) = (/ & + &1.0175e+03_r8,1.0163e+03_r8,1.0069e+03_r8,9.9610e+02_r8,9.9075e+02_r8/) + kao(:,11,13) = (/ & + &1.0564e+03_r8,1.0547e+03_r8,1.0423e+03_r8,1.0316e+03_r8,1.0272e+03_r8/) + kao(:,12,13) = (/ & + &1.0856e+03_r8,1.0807e+03_r8,1.0716e+03_r8,1.0657e+03_r8,1.0617e+03_r8/) + kao(:,13,13) = (/ & + &1.1006e+03_r8,1.0930e+03_r8,1.0868e+03_r8,1.0845e+03_r8,1.0783e+03_r8/) + kao(:, 1,14) = (/ & + &7.0211e+02_r8,7.0175e+02_r8,7.0131e+02_r8,6.9909e+02_r8,6.9776e+02_r8/) + kao(:, 2,14) = (/ & + &7.9113e+02_r8,7.9461e+02_r8,7.9834e+02_r8,7.9969e+02_r8,7.9813e+02_r8/) + kao(:, 3,14) = (/ & + &8.8896e+02_r8,8.9686e+02_r8,9.0679e+02_r8,9.1320e+02_r8,9.1562e+02_r8/) + kao(:, 4,14) = (/ & + &9.9457e+02_r8,1.0048e+03_r8,1.0163e+03_r8,1.0256e+03_r8,1.0309e+03_r8/) + kao(:, 5,14) = (/ & + &1.1171e+03_r8,1.1226e+03_r8,1.1342e+03_r8,1.1464e+03_r8,1.1541e+03_r8/) + kao(:, 6,14) = (/ & + &1.2650e+03_r8,1.2607e+03_r8,1.2659e+03_r8,1.2764e+03_r8,1.2854e+03_r8/) + kao(:, 7,14) = (/ & + &1.4362e+03_r8,1.4239e+03_r8,1.4228e+03_r8,1.4266e+03_r8,1.4315e+03_r8/) + kao(:, 8,14) = (/ & + &1.6263e+03_r8,1.6088e+03_r8,1.5994e+03_r8,1.5975e+03_r8,1.5958e+03_r8/) + kao(:, 9,14) = (/ & + &1.8039e+03_r8,1.7901e+03_r8,1.7817e+03_r8,1.7757e+03_r8,1.7698e+03_r8/) + kao(:,10,14) = (/ & + &1.9623e+03_r8,1.9495e+03_r8,1.9467e+03_r8,1.9462e+03_r8,1.9411e+03_r8/) + kao(:,11,14) = (/ & + &2.1010e+03_r8,2.0894e+03_r8,2.0912e+03_r8,2.0963e+03_r8,2.0914e+03_r8/) + kao(:,12,14) = (/ & + &2.2319e+03_r8,2.2209e+03_r8,2.2201e+03_r8,2.2217e+03_r8,2.2137e+03_r8/) + kao(:,13,14) = (/ & + &2.3516e+03_r8,2.3425e+03_r8,2.3393e+03_r8,2.3344e+03_r8,2.3274e+03_r8/) + kao(:, 1,15) = (/ & + &1.0409e+03_r8,1.0602e+03_r8,1.0710e+03_r8,1.0853e+03_r8,1.1018e+03_r8/) + kao(:, 2,15) = (/ & + &1.2151e+03_r8,1.2303e+03_r8,1.2347e+03_r8,1.2478e+03_r8,1.2680e+03_r8/) + kao(:, 3,15) = (/ & + &1.4193e+03_r8,1.4320e+03_r8,1.4382e+03_r8,1.4463e+03_r8,1.4605e+03_r8/) + kao(:, 4,15) = (/ & + &1.6341e+03_r8,1.6472e+03_r8,1.6601e+03_r8,1.6700e+03_r8,1.6846e+03_r8/) + kao(:, 5,15) = (/ & + &1.8786e+03_r8,1.8904e+03_r8,1.9028e+03_r8,1.9104e+03_r8,1.9250e+03_r8/) + kao(:, 6,15) = (/ & + &2.1492e+03_r8,2.1663e+03_r8,2.1776e+03_r8,2.1833e+03_r8,2.1940e+03_r8/) + kao(:, 7,15) = (/ & + &2.4310e+03_r8,2.4567e+03_r8,2.4727e+03_r8,2.4804e+03_r8,2.4891e+03_r8/) + kao(:, 8,15) = (/ & + &2.7261e+03_r8,2.7552e+03_r8,2.7803e+03_r8,2.7970e+03_r8,2.8141e+03_r8/) + kao(:, 9,15) = (/ & + &3.0867e+03_r8,3.0994e+03_r8,3.1170e+03_r8,3.1402e+03_r8,3.1679e+03_r8/) + kao(:,10,15) = (/ & + &3.5269e+03_r8,3.5204e+03_r8,3.5225e+03_r8,3.5345e+03_r8,3.5601e+03_r8/) + kao(:,11,15) = (/ & + &4.0271e+03_r8,4.0096e+03_r8,4.0024e+03_r8,4.0052e+03_r8,4.0246e+03_r8/) + kao(:,12,15) = (/ & + &4.5798e+03_r8,4.5585e+03_r8,4.5503e+03_r8,4.5442e+03_r8,4.5532e+03_r8/) + kao(:,13,15) = (/ & + &5.1911e+03_r8,5.1717e+03_r8,5.1553e+03_r8,5.1395e+03_r8,5.1397e+03_r8/) + kao(:, 1,16) = (/ & + &1.2071e+03_r8,1.2414e+03_r8,1.3062e+03_r8,1.3645e+03_r8,1.4123e+03_r8/) + kao(:, 2,16) = (/ & + &1.4670e+03_r8,1.4886e+03_r8,1.5547e+03_r8,1.6269e+03_r8,1.6875e+03_r8/) + kao(:, 3,16) = (/ & + &1.7847e+03_r8,1.7994e+03_r8,1.8394e+03_r8,1.9097e+03_r8,1.9863e+03_r8/) + kao(:, 4,16) = (/ & + &2.1409e+03_r8,2.1717e+03_r8,2.1953e+03_r8,2.2438e+03_r8,2.3059e+03_r8/) + kao(:, 5,16) = (/ & + &2.5417e+03_r8,2.5918e+03_r8,2.6196e+03_r8,2.6591e+03_r8,2.7124e+03_r8/) + kao(:, 6,16) = (/ & + &3.0242e+03_r8,3.0688e+03_r8,3.1113e+03_r8,3.1534e+03_r8,3.2074e+03_r8/) + kao(:, 7,16) = (/ & + &3.6491e+03_r8,3.6695e+03_r8,3.6939e+03_r8,3.7229e+03_r8,3.7906e+03_r8/) + kao(:, 8,16) = (/ & + &4.4223e+03_r8,4.4232e+03_r8,4.4297e+03_r8,4.4268e+03_r8,4.4608e+03_r8/) + kao(:, 9,16) = (/ & + &5.3502e+03_r8,5.3400e+03_r8,5.3338e+03_r8,5.3140e+03_r8,5.2816e+03_r8/) + kao(:,10,16) = (/ & + &6.4333e+03_r8,6.4257e+03_r8,6.4093e+03_r8,6.3744e+03_r8,6.3162e+03_r8/) + kao(:,11,16) = (/ & + &7.6805e+03_r8,7.6778e+03_r8,7.6466e+03_r8,7.5865e+03_r8,7.5106e+03_r8/) + kao(:,12,16) = (/ & + &9.1073e+03_r8,9.0972e+03_r8,9.0428e+03_r8,8.9445e+03_r8,8.8997e+03_r8/) + kao(:,13,16) = (/ & + &1.0699e+04_r8,1.0668e+04_r8,1.0580e+04_r8,1.0493e+04_r8,1.0473e+04_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &1.0144e-02_r8,1.1539e-02_r8,1.2861e-02_r8,1.4225e-02_r8,1.5224e-02_r8/) + kbo(:,14, 1) = (/ & + &8.4327e-03_r8,9.5989e-03_r8,1.0734e-02_r8,1.1890e-02_r8,1.2872e-02_r8/) + kbo(:,15, 1) = (/ & + &6.9967e-03_r8,7.9676e-03_r8,8.9559e-03_r8,9.9119e-03_r8,1.0533e-02_r8/) + kbo(:,16, 1) = (/ & + &5.7988e-03_r8,6.6068e-03_r8,7.4553e-03_r8,8.2402e-03_r8,8.5310e-03_r8/) + kbo(:,17, 1) = (/ & + &4.8055e-03_r8,5.4781e-03_r8,6.1884e-03_r8,6.8148e-03_r8,6.9563e-03_r8/) + kbo(:,18, 1) = (/ & + &3.9877e-03_r8,4.5423e-03_r8,5.1325e-03_r8,5.5098e-03_r8,5.6946e-03_r8/) + kbo(:,19, 1) = (/ & + &3.3110e-03_r8,3.7880e-03_r8,4.2806e-03_r8,4.4996e-03_r8,4.6784e-03_r8/) + kbo(:,20, 1) = (/ & + &2.7631e-03_r8,3.1756e-03_r8,3.5803e-03_r8,3.7100e-03_r8,3.8598e-03_r8/) + kbo(:,21, 1) = (/ & + &2.3113e-03_r8,2.6584e-03_r8,2.9347e-03_r8,3.0481e-03_r8,3.1824e-03_r8/) + kbo(:,22, 1) = (/ & + &1.9510e-03_r8,2.2389e-03_r8,2.4076e-03_r8,2.5106e-03_r8,2.6293e-03_r8/) + kbo(:,23, 1) = (/ & + &1.6490e-03_r8,1.8833e-03_r8,1.9839e-03_r8,2.0707e-03_r8,2.1757e-03_r8/) + kbo(:,24, 1) = (/ & + &1.3921e-03_r8,1.5822e-03_r8,1.6416e-03_r8,1.7136e-03_r8,1.8019e-03_r8/) + kbo(:,25, 1) = (/ & + &1.1754e-03_r8,1.2986e-03_r8,1.3546e-03_r8,1.4184e-03_r8,1.4951e-03_r8/) + kbo(:,26, 1) = (/ & + &9.9384e-04_r8,1.0692e-03_r8,1.1181e-03_r8,1.1767e-03_r8,1.2423e-03_r8/) + kbo(:,27, 1) = (/ & + &8.3932e-04_r8,8.8446e-04_r8,9.2496e-04_r8,9.7555e-04_r8,1.0286e-03_r8/) + kbo(:,28, 1) = (/ & + &7.0655e-04_r8,7.3418e-04_r8,7.6647e-04_r8,8.0853e-04_r8,8.5091e-04_r8/) + kbo(:,29, 1) = (/ & + &5.8016e-04_r8,6.0558e-04_r8,6.3439e-04_r8,6.6940e-04_r8,7.0187e-04_r8/) + kbo(:,30, 1) = (/ & + &4.7757e-04_r8,4.9924e-04_r8,5.2442e-04_r8,5.5397e-04_r8,5.7829e-04_r8/) + kbo(:,31, 1) = (/ & + &3.9420e-04_r8,4.1123e-04_r8,4.3298e-04_r8,4.5563e-04_r8,4.7437e-04_r8/) + kbo(:,32, 1) = (/ & + &3.2571e-04_r8,3.3960e-04_r8,3.5704e-04_r8,3.7387e-04_r8,3.8849e-04_r8/) + kbo(:,33, 1) = (/ & + &2.6741e-04_r8,2.8027e-04_r8,2.9349e-04_r8,3.0636e-04_r8,3.1790e-04_r8/) + kbo(:,34, 1) = (/ & + &2.2029e-04_r8,2.3073e-04_r8,2.4120e-04_r8,2.5116e-04_r8,2.5977e-04_r8/) + kbo(:,35, 1) = (/ & + &1.8092e-04_r8,1.8913e-04_r8,1.9723e-04_r8,2.0490e-04_r8,2.1120e-04_r8/) + kbo(:,36, 1) = (/ & + &1.4775e-04_r8,1.5426e-04_r8,1.6038e-04_r8,1.6643e-04_r8,1.7137e-04_r8/) + kbo(:,37, 1) = (/ & + &1.2005e-04_r8,1.2534e-04_r8,1.3001e-04_r8,1.3495e-04_r8,1.3888e-04_r8/) + kbo(:,38, 1) = (/ & + &9.7560e-05_r8,1.0177e-04_r8,1.0540e-04_r8,1.0924e-04_r8,1.1256e-04_r8/) + kbo(:,39, 1) = (/ & + &7.9344e-05_r8,8.2615e-05_r8,8.5368e-05_r8,8.8405e-05_r8,9.1186e-05_r8/) + kbo(:,40, 1) = (/ & + &6.4575e-05_r8,6.7008e-05_r8,6.9369e-05_r8,7.1740e-05_r8,7.4003e-05_r8/) + kbo(:,41, 1) = (/ & + &5.2697e-05_r8,5.4334e-05_r8,5.6409e-05_r8,5.8228e-05_r8,6.0014e-05_r8/) + kbo(:,42, 1) = (/ & + &4.3089e-05_r8,4.4120e-05_r8,4.5815e-05_r8,4.7218e-05_r8,4.8658e-05_r8/) + kbo(:,43, 1) = (/ & + &3.4429e-05_r8,3.5847e-05_r8,3.7149e-05_r8,3.8380e-05_r8,3.9479e-05_r8/) + kbo(:,44, 1) = (/ & + &2.7169e-05_r8,2.9300e-05_r8,3.0128e-05_r8,3.1175e-05_r8,3.2021e-05_r8/) + kbo(:,45, 1) = (/ & + &2.1411e-05_r8,2.3782e-05_r8,2.4360e-05_r8,2.5287e-05_r8,2.6025e-05_r8/) + kbo(:,46, 1) = (/ & + &1.6754e-05_r8,1.8795e-05_r8,1.9931e-05_r8,2.0532e-05_r8,2.1145e-05_r8/) + kbo(:,47, 1) = (/ & + &1.3067e-05_r8,1.4757e-05_r8,1.6247e-05_r8,1.6575e-05_r8,1.7184e-05_r8/) + kbo(:,48, 1) = (/ & + &1.0193e-05_r8,1.1527e-05_r8,1.2841e-05_r8,1.3599e-05_r8,1.3946e-05_r8/) + kbo(:,49, 1) = (/ & + &7.9417e-06_r8,8.9971e-06_r8,1.0112e-05_r8,1.1045e-05_r8,1.1285e-05_r8/) + kbo(:,50, 1) = (/ & + &6.1950e-06_r8,7.0678e-06_r8,7.9571e-06_r8,8.7859e-06_r8,9.3116e-06_r8/) + kbo(:,51, 1) = (/ & + &4.8121e-06_r8,5.5540e-06_r8,6.2634e-06_r8,6.9968e-06_r8,7.5750e-06_r8/) + kbo(:,52, 1) = (/ & + &3.7732e-06_r8,4.3400e-06_r8,4.9368e-06_r8,5.5255e-06_r8,6.0507e-06_r8/) + kbo(:,53, 1) = (/ & + &2.9588e-06_r8,3.3855e-06_r8,3.8934e-06_r8,4.3558e-06_r8,4.8377e-06_r8/) + kbo(:,54, 1) = (/ & + &2.2637e-06_r8,2.6550e-06_r8,3.0640e-06_r8,3.4670e-06_r8,3.8645e-06_r8/) + kbo(:,55, 1) = (/ & + &1.7394e-06_r8,2.1318e-06_r8,2.4092e-06_r8,2.7718e-06_r8,3.0969e-06_r8/) + kbo(:,56, 1) = (/ & + &1.3379e-06_r8,1.6962e-06_r8,1.9182e-06_r8,2.2019e-06_r8,2.5057e-06_r8/) + kbo(:,57, 1) = (/ & + &1.0894e-06_r8,1.3086e-06_r8,1.5250e-06_r8,1.7825e-06_r8,2.0078e-06_r8/) + kbo(:,58, 1) = (/ & + &8.2505e-07_r8,1.0180e-06_r8,1.2548e-06_r8,1.4584e-06_r8,1.7398e-06_r8/) + kbo(:,59, 1) = (/ & + &7.1802e-07_r8,8.6784e-07_r8,1.0974e-06_r8,1.3504e-06_r8,1.4314e-06_r8/) + kbo(:,13, 2) = (/ & + &4.1938e-02_r8,4.3540e-02_r8,4.4990e-02_r8,4.6074e-02_r8,4.6999e-02_r8/) + kbo(:,14, 2) = (/ & + &3.5928e-02_r8,3.7447e-02_r8,3.8935e-02_r8,3.9816e-02_r8,4.0666e-02_r8/) + kbo(:,15, 2) = (/ & + &3.0539e-02_r8,3.1836e-02_r8,3.3086e-02_r8,3.4096e-02_r8,3.5203e-02_r8/) + kbo(:,16, 2) = (/ & + &2.5542e-02_r8,2.6607e-02_r8,2.7654e-02_r8,2.8622e-02_r8,2.9849e-02_r8/) + kbo(:,17, 2) = (/ & + &2.1059e-02_r8,2.2159e-02_r8,2.3097e-02_r8,2.3970e-02_r8,2.5021e-02_r8/) + kbo(:,18, 2) = (/ & + &1.7420e-02_r8,1.8344e-02_r8,1.9223e-02_r8,2.0092e-02_r8,2.0887e-02_r8/) + kbo(:,19, 2) = (/ & + &1.4527e-02_r8,1.5294e-02_r8,1.6071e-02_r8,1.6950e-02_r8,1.7660e-02_r8/) + kbo(:,20, 2) = (/ & + &1.2057e-02_r8,1.2740e-02_r8,1.3375e-02_r8,1.4212e-02_r8,1.4836e-02_r8/) + kbo(:,21, 2) = (/ & + &1.0024e-02_r8,1.0630e-02_r8,1.1202e-02_r8,1.1918e-02_r8,1.2460e-02_r8/) + kbo(:,22, 2) = (/ & + &8.3586e-03_r8,8.8721e-03_r8,9.4319e-03_r8,1.0016e-02_r8,1.0451e-02_r8/) + kbo(:,23, 2) = (/ & + &7.0023e-03_r8,7.4292e-03_r8,7.9425e-03_r8,8.4001e-03_r8,8.6668e-03_r8/) + kbo(:,24, 2) = (/ & + &5.8805e-03_r8,6.2414e-03_r8,6.6855e-03_r8,7.0380e-03_r8,7.1881e-03_r8/) + kbo(:,25, 2) = (/ & + &4.9300e-03_r8,5.2659e-03_r8,5.6130e-03_r8,5.8139e-03_r8,5.9744e-03_r8/) + kbo(:,26, 2) = (/ & + &4.1346e-03_r8,4.4268e-03_r8,4.6994e-03_r8,4.8189e-03_r8,4.9700e-03_r8/) + kbo(:,27, 2) = (/ & + &3.4478e-03_r8,3.6949e-03_r8,3.8760e-03_r8,3.9800e-03_r8,4.1083e-03_r8/) + kbo(:,28, 2) = (/ & + &2.8662e-03_r8,3.0720e-03_r8,3.1855e-03_r8,3.2844e-03_r8,3.3841e-03_r8/) + kbo(:,29, 2) = (/ & + &2.3700e-03_r8,2.5289e-03_r8,2.6049e-03_r8,2.6846e-03_r8,2.7555e-03_r8/) + kbo(:,30, 2) = (/ & + &1.9529e-03_r8,2.0734e-03_r8,2.1236e-03_r8,2.1766e-03_r8,2.2279e-03_r8/) + kbo(:,31, 2) = (/ & + &1.5951e-03_r8,1.6761e-03_r8,1.7103e-03_r8,1.7458e-03_r8,1.7856e-03_r8/) + kbo(:,32, 2) = (/ & + &1.2965e-03_r8,1.3546e-03_r8,1.3767e-03_r8,1.4016e-03_r8,1.4345e-03_r8/) + kbo(:,33, 2) = (/ & + &1.0497e-03_r8,1.0916e-03_r8,1.1061e-03_r8,1.1259e-03_r8,1.1490e-03_r8/) + kbo(:,34, 2) = (/ & + &8.5263e-04_r8,8.8439e-04_r8,8.9299e-04_r8,9.0901e-04_r8,9.2683e-04_r8/) + kbo(:,35, 2) = (/ & + &6.8961e-04_r8,7.1452e-04_r8,7.2125e-04_r8,7.3408e-04_r8,7.4718e-04_r8/) + kbo(:,36, 2) = (/ & + &5.5538e-04_r8,5.7454e-04_r8,5.8468e-04_r8,5.9295e-04_r8,6.0312e-04_r8/) + kbo(:,37, 2) = (/ & + &4.4687e-04_r8,4.6228e-04_r8,4.7485e-04_r8,4.8052e-04_r8,4.8826e-04_r8/) + kbo(:,38, 2) = (/ & + &3.5911e-04_r8,3.7176e-04_r8,3.8278e-04_r8,3.8998e-04_r8,3.9487e-04_r8/) + kbo(:,39, 2) = (/ & + &2.8825e-04_r8,2.9868e-04_r8,3.0761e-04_r8,3.1500e-04_r8,3.2065e-04_r8/) + kbo(:,40, 2) = (/ & + &2.3221e-04_r8,2.4117e-04_r8,2.4916e-04_r8,2.5539e-04_r8,2.6149e-04_r8/) + kbo(:,41, 2) = (/ & + &1.8711e-04_r8,1.9520e-04_r8,2.0184e-04_r8,2.0732e-04_r8,2.1208e-04_r8/) + kbo(:,42, 2) = (/ & + &1.5044e-04_r8,1.5806e-04_r8,1.6349e-04_r8,1.6813e-04_r8,1.7186e-04_r8/) + kbo(:,43, 2) = (/ & + &1.2147e-04_r8,1.2754e-04_r8,1.3202e-04_r8,1.3603e-04_r8,1.3922e-04_r8/) + kbo(:,44, 2) = (/ & + &9.7631e-05_r8,1.0254e-04_r8,1.0664e-04_r8,1.1000e-04_r8,1.1278e-04_r8/) + kbo(:,45, 2) = (/ & + &7.8551e-05_r8,8.2386e-05_r8,8.6252e-05_r8,8.8821e-05_r8,9.1113e-05_r8/) + kbo(:,46, 2) = (/ & + &6.3082e-05_r8,6.6217e-05_r8,6.9264e-05_r8,7.1597e-05_r8,7.3596e-05_r8/) + kbo(:,47, 2) = (/ & + &5.0668e-05_r8,5.3148e-05_r8,5.5648e-05_r8,5.8023e-05_r8,5.9460e-05_r8/) + kbo(:,48, 2) = (/ & + &4.0723e-05_r8,4.2652e-05_r8,4.4714e-05_r8,4.6562e-05_r8,4.8110e-05_r8/) + kbo(:,49, 2) = (/ & + &3.2577e-05_r8,3.4241e-05_r8,3.5845e-05_r8,3.7418e-05_r8,3.8704e-05_r8/) + kbo(:,50, 2) = (/ & + &2.6548e-05_r8,2.7645e-05_r8,2.8887e-05_r8,3.0243e-05_r8,3.1285e-05_r8/) + kbo(:,51, 2) = (/ & + &2.1632e-05_r8,2.2305e-05_r8,2.3402e-05_r8,2.4420e-05_r8,2.5424e-05_r8/) + kbo(:,52, 2) = (/ & + &1.7494e-05_r8,1.8158e-05_r8,1.8946e-05_r8,1.9746e-05_r8,2.0626e-05_r8/) + kbo(:,53, 2) = (/ & + &1.4060e-05_r8,1.4924e-05_r8,1.5296e-05_r8,1.6047e-05_r8,1.6661e-05_r8/) + kbo(:,54, 2) = (/ & + &1.1502e-05_r8,1.2189e-05_r8,1.2591e-05_r8,1.3072e-05_r8,1.3585e-05_r8/) + kbo(:,55, 2) = (/ & + &9.4731e-06_r8,9.9000e-06_r8,1.0499e-05_r8,1.0730e-05_r8,1.1201e-05_r8/) + kbo(:,56, 2) = (/ & + &7.7842e-06_r8,8.0609e-06_r8,8.6328e-06_r8,8.9073e-06_r8,9.2258e-06_r8/) + kbo(:,57, 2) = (/ & + &6.1271e-06_r8,6.6999e-06_r8,7.0368e-06_r8,7.4466e-06_r8,7.6395e-06_r8/) + kbo(:,58, 2) = (/ & + &4.7873e-06_r8,5.5615e-06_r8,5.7470e-06_r8,6.1637e-06_r8,6.3705e-06_r8/) + kbo(:,59, 2) = (/ & + &3.8649e-06_r8,4.5966e-06_r8,4.7965e-06_r8,5.1490e-06_r8,5.3880e-06_r8/) + kbo(:,13, 3) = (/ & + &1.2497e-01_r8,1.2733e-01_r8,1.2732e-01_r8,1.2710e-01_r8,1.2722e-01_r8/) + kbo(:,14, 3) = (/ & + &1.0770e-01_r8,1.1044e-01_r8,1.0994e-01_r8,1.0972e-01_r8,1.0842e-01_r8/) + kbo(:,15, 3) = (/ & + &9.2313e-02_r8,9.4782e-02_r8,9.3928e-02_r8,9.2439e-02_r8,9.0946e-02_r8/) + kbo(:,16, 3) = (/ & + &7.7737e-02_r8,7.9134e-02_r8,7.7340e-02_r8,7.6811e-02_r8,7.6114e-02_r8/) + kbo(:,17, 3) = (/ & + &6.5446e-02_r8,6.4598e-02_r8,6.3955e-02_r8,6.3795e-02_r8,6.3695e-02_r8/) + kbo(:,18, 3) = (/ & + &5.3197e-02_r8,5.2989e-02_r8,5.2755e-02_r8,5.2824e-02_r8,5.2780e-02_r8/) + kbo(:,19, 3) = (/ & + &4.3741e-02_r8,4.3850e-02_r8,4.3971e-02_r8,4.3934e-02_r8,4.3215e-02_r8/) + kbo(:,20, 3) = (/ & + &3.6203e-02_r8,3.6356e-02_r8,3.6481e-02_r8,3.6039e-02_r8,3.5482e-02_r8/) + kbo(:,21, 3) = (/ & + &2.9983e-02_r8,3.0109e-02_r8,3.0136e-02_r8,2.9600e-02_r8,2.9205e-02_r8/) + kbo(:,22, 3) = (/ & + &2.4798e-02_r8,2.4802e-02_r8,2.4628e-02_r8,2.4239e-02_r8,2.4061e-02_r8/) + kbo(:,23, 3) = (/ & + &2.0477e-02_r8,2.0405e-02_r8,2.0149e-02_r8,1.9990e-02_r8,1.9997e-02_r8/) + kbo(:,24, 3) = (/ & + &1.6953e-02_r8,1.6782e-02_r8,1.6632e-02_r8,1.6618e-02_r8,1.6673e-02_r8/) + kbo(:,25, 3) = (/ & + &1.3995e-02_r8,1.3802e-02_r8,1.3748e-02_r8,1.3853e-02_r8,1.3849e-02_r8/) + kbo(:,26, 3) = (/ & + &1.1507e-02_r8,1.1388e-02_r8,1.1372e-02_r8,1.1472e-02_r8,1.1479e-02_r8/) + kbo(:,27, 3) = (/ & + &9.4100e-03_r8,9.3552e-03_r8,9.3927e-03_r8,9.4480e-03_r8,9.4683e-03_r8/) + kbo(:,28, 3) = (/ & + &7.6709e-03_r8,7.6555e-03_r8,7.7364e-03_r8,7.7513e-03_r8,7.7691e-03_r8/) + kbo(:,29, 3) = (/ & + &6.2318e-03_r8,6.2179e-03_r8,6.2783e-03_r8,6.2823e-03_r8,6.2984e-03_r8/) + kbo(:,30, 3) = (/ & + &5.0369e-03_r8,5.0223e-03_r8,5.0690e-03_r8,5.0675e-03_r8,5.0877e-03_r8/) + kbo(:,31, 3) = (/ & + &4.0270e-03_r8,4.0248e-03_r8,4.0530e-03_r8,4.0550e-03_r8,4.0668e-03_r8/) + kbo(:,32, 3) = (/ & + &3.2266e-03_r8,3.2233e-03_r8,3.2444e-03_r8,3.2484e-03_r8,3.2485e-03_r8/) + kbo(:,33, 3) = (/ & + &2.5826e-03_r8,2.5793e-03_r8,2.5980e-03_r8,2.5954e-03_r8,2.5860e-03_r8/) + kbo(:,34, 3) = (/ & + &2.0751e-03_r8,2.0785e-03_r8,2.0913e-03_r8,2.0819e-03_r8,2.0719e-03_r8/) + kbo(:,35, 3) = (/ & + &1.6732e-03_r8,1.6746e-03_r8,1.6840e-03_r8,1.6712e-03_r8,1.6630e-03_r8/) + kbo(:,36, 3) = (/ & + &1.3540e-03_r8,1.3534e-03_r8,1.3539e-03_r8,1.3458e-03_r8,1.3380e-03_r8/) + kbo(:,37, 3) = (/ & + &1.1025e-03_r8,1.0986e-03_r8,1.0965e-03_r8,1.0906e-03_r8,1.0838e-03_r8/) + kbo(:,38, 3) = (/ & + &8.9827e-04_r8,8.9144e-04_r8,8.8894e-04_r8,8.8260e-04_r8,8.7601e-04_r8/) + kbo(:,39, 3) = (/ & + &7.3039e-04_r8,7.2351e-04_r8,7.1956e-04_r8,7.1446e-04_r8,7.0735e-04_r8/) + kbo(:,40, 3) = (/ & + &6.0257e-04_r8,5.9335e-04_r8,5.8899e-04_r8,5.8497e-04_r8,5.7809e-04_r8/) + kbo(:,41, 3) = (/ & + &4.9748e-04_r8,4.8829e-04_r8,4.8330e-04_r8,4.7897e-04_r8,4.7418e-04_r8/) + kbo(:,42, 3) = (/ & + &4.0962e-04_r8,4.0192e-04_r8,3.9631e-04_r8,3.9272e-04_r8,3.8922e-04_r8/) + kbo(:,43, 3) = (/ & + &3.3511e-04_r8,3.3335e-04_r8,3.2739e-04_r8,3.2309e-04_r8,3.2009e-04_r8/) + kbo(:,44, 3) = (/ & + &2.7494e-04_r8,2.7440e-04_r8,2.7166e-04_r8,2.6681e-04_r8,2.6291e-04_r8/) + kbo(:,45, 3) = (/ & + &2.2409e-04_r8,2.2465e-04_r8,2.2546e-04_r8,2.2120e-04_r8,2.1688e-04_r8/) + kbo(:,46, 3) = (/ & + &1.8344e-04_r8,1.8445e-04_r8,1.8370e-04_r8,1.8435e-04_r8,1.8060e-04_r8/) + kbo(:,47, 3) = (/ & + &1.5220e-04_r8,1.5094e-04_r8,1.5093e-04_r8,1.5107e-04_r8,1.5073e-04_r8/) + kbo(:,48, 3) = (/ & + &1.2685e-04_r8,1.2406e-04_r8,1.2418e-04_r8,1.2347e-04_r8,1.2407e-04_r8/) + kbo(:,49, 3) = (/ & + &1.0283e-04_r8,1.0360e-04_r8,1.0186e-04_r8,1.0181e-04_r8,1.0123e-04_r8/) + kbo(:,50, 3) = (/ & + &8.3231e-05_r8,8.5593e-05_r8,8.4616e-05_r8,8.3839e-05_r8,8.3224e-05_r8/) + kbo(:,51, 3) = (/ & + &6.6892e-05_r8,7.0153e-05_r8,7.0699e-05_r8,6.9691e-05_r8,6.9167e-05_r8/) + kbo(:,52, 3) = (/ & + &5.4090e-05_r8,5.6975e-05_r8,5.8223e-05_r8,5.8345e-05_r8,5.7364e-05_r8/) + kbo(:,53, 3) = (/ & + &4.3363e-05_r8,4.5702e-05_r8,4.7865e-05_r8,4.7887e-05_r8,4.7945e-05_r8/) + kbo(:,54, 3) = (/ & + &3.4722e-05_r8,3.7579e-05_r8,3.9122e-05_r8,3.9883e-05_r8,3.9754e-05_r8/) + kbo(:,55, 3) = (/ & + &2.7984e-05_r8,3.0530e-05_r8,3.1930e-05_r8,3.3227e-05_r8,3.3134e-05_r8/) + kbo(:,56, 3) = (/ & + &2.2565e-05_r8,2.4737e-05_r8,2.6495e-05_r8,2.7386e-05_r8,2.7845e-05_r8/) + kbo(:,57, 3) = (/ & + &1.8624e-05_r8,1.9996e-05_r8,2.1604e-05_r8,2.2454e-05_r8,2.3200e-05_r8/) + kbo(:,58, 3) = (/ & + &1.5567e-05_r8,1.6215e-05_r8,1.7630e-05_r8,1.8795e-05_r8,1.9192e-05_r8/) + kbo(:,59, 3) = (/ & + &1.3180e-05_r8,1.3591e-05_r8,1.4748e-05_r8,1.5698e-05_r8,1.6153e-05_r8/) + kbo(:,13, 4) = (/ & + &2.3244e-01_r8,2.2666e-01_r8,2.2365e-01_r8,2.1647e-01_r8,2.0828e-01_r8/) + kbo(:,14, 4) = (/ & + &1.9358e-01_r8,1.8830e-01_r8,1.8743e-01_r8,1.8019e-01_r8,1.7506e-01_r8/) + kbo(:,15, 4) = (/ & + &1.6047e-01_r8,1.5782e-01_r8,1.5488e-01_r8,1.5178e-01_r8,1.4896e-01_r8/) + kbo(:,16, 4) = (/ & + &1.3221e-01_r8,1.3030e-01_r8,1.2930e-01_r8,1.2731e-01_r8,1.2502e-01_r8/) + kbo(:,17, 4) = (/ & + &1.0863e-01_r8,1.0862e-01_r8,1.0815e-01_r8,1.0706e-01_r8,1.0464e-01_r8/) + kbo(:,18, 4) = (/ & + &9.0031e-02_r8,9.0210e-02_r8,9.0179e-02_r8,8.8891e-02_r8,8.7072e-02_r8/) + kbo(:,19, 4) = (/ & + &7.4933e-02_r8,7.5517e-02_r8,7.5432e-02_r8,7.4716e-02_r8,7.4259e-02_r8/) + kbo(:,20, 4) = (/ & + &6.2292e-02_r8,6.2900e-02_r8,6.2796e-02_r8,6.2799e-02_r8,6.2655e-02_r8/) + kbo(:,21, 4) = (/ & + &5.1753e-02_r8,5.2259e-02_r8,5.2338e-02_r8,5.2648e-02_r8,5.2692e-02_r8/) + kbo(:,22, 4) = (/ & + &4.2879e-02_r8,4.3337e-02_r8,4.3671e-02_r8,4.3911e-02_r8,4.3964e-02_r8/) + kbo(:,23, 4) = (/ & + &3.5511e-02_r8,3.5957e-02_r8,3.6400e-02_r8,3.6560e-02_r8,3.6588e-02_r8/) + kbo(:,24, 4) = (/ & + &2.9490e-02_r8,3.0002e-02_r8,3.0363e-02_r8,3.0503e-02_r8,3.0607e-02_r8/) + kbo(:,25, 4) = (/ & + &2.4491e-02_r8,2.5028e-02_r8,2.5370e-02_r8,2.5485e-02_r8,2.5616e-02_r8/) + kbo(:,26, 4) = (/ & + &2.0405e-02_r8,2.0858e-02_r8,2.1166e-02_r8,2.1267e-02_r8,2.1358e-02_r8/) + kbo(:,27, 4) = (/ & + &1.6966e-02_r8,1.7305e-02_r8,1.7522e-02_r8,1.7603e-02_r8,1.7664e-02_r8/) + kbo(:,28, 4) = (/ & + &1.4041e-02_r8,1.4283e-02_r8,1.4398e-02_r8,1.4482e-02_r8,1.4540e-02_r8/) + kbo(:,29, 4) = (/ & + &1.1473e-02_r8,1.1643e-02_r8,1.1712e-02_r8,1.1784e-02_r8,1.1808e-02_r8/) + kbo(:,30, 4) = (/ & + &9.3128e-03_r8,9.4393e-03_r8,9.4816e-03_r8,9.5274e-03_r8,9.5277e-03_r8/) + kbo(:,31, 4) = (/ & + &7.5018e-03_r8,7.5697e-03_r8,7.5938e-03_r8,7.6234e-03_r8,7.6068e-03_r8/) + kbo(:,32, 4) = (/ & + &6.0276e-03_r8,6.0587e-03_r8,6.0760e-03_r8,6.0793e-03_r8,6.0890e-03_r8/) + kbo(:,33, 4) = (/ & + &4.8317e-03_r8,4.8465e-03_r8,4.8480e-03_r8,4.8590e-03_r8,4.8679e-03_r8/) + kbo(:,34, 4) = (/ & + &3.8930e-03_r8,3.8936e-03_r8,3.8908e-03_r8,3.9081e-03_r8,3.9148e-03_r8/) + kbo(:,35, 4) = (/ & + &3.1327e-03_r8,3.1329e-03_r8,3.1313e-03_r8,3.1437e-03_r8,3.1485e-03_r8/) + kbo(:,36, 4) = (/ & + &2.5288e-03_r8,2.5255e-03_r8,2.5228e-03_r8,2.5303e-03_r8,2.5349e-03_r8/) + kbo(:,37, 4) = (/ & + &2.0481e-03_r8,2.0483e-03_r8,2.0398e-03_r8,2.0467e-03_r8,2.0499e-03_r8/) + kbo(:,38, 4) = (/ & + &1.6558e-03_r8,1.6596e-03_r8,1.6492e-03_r8,1.6534e-03_r8,1.6569e-03_r8/) + kbo(:,39, 4) = (/ & + &1.3374e-03_r8,1.3400e-03_r8,1.3351e-03_r8,1.3347e-03_r8,1.3383e-03_r8/) + kbo(:,40, 4) = (/ & + &1.0845e-03_r8,1.0921e-03_r8,1.0887e-03_r8,1.0875e-03_r8,1.0897e-03_r8/) + kbo(:,41, 4) = (/ & + &8.8154e-04_r8,8.8864e-04_r8,8.8779e-04_r8,8.8674e-04_r8,8.8749e-04_r8/) + kbo(:,42, 4) = (/ & + &7.1843e-04_r8,7.2263e-04_r8,7.2341e-04_r8,7.2250e-04_r8,7.2207e-04_r8/) + kbo(:,43, 4) = (/ & + &5.8799e-04_r8,5.8635e-04_r8,5.8966e-04_r8,5.8857e-04_r8,5.8778e-04_r8/) + kbo(:,44, 4) = (/ & + &4.7968e-04_r8,4.7905e-04_r8,4.7843e-04_r8,4.7895e-04_r8,4.7900e-04_r8/) + kbo(:,45, 4) = (/ & + &3.9220e-04_r8,3.9274e-04_r8,3.8844e-04_r8,3.8841e-04_r8,3.8937e-04_r8/) + kbo(:,46, 4) = (/ & + &3.2002e-04_r8,3.2007e-04_r8,3.1928e-04_r8,3.1499e-04_r8,3.1489e-04_r8/) + kbo(:,47, 4) = (/ & + &2.6159e-04_r8,2.6272e-04_r8,2.6214e-04_r8,2.5941e-04_r8,2.5552e-04_r8/) + kbo(:,48, 4) = (/ & + &2.1397e-04_r8,2.1500e-04_r8,2.1426e-04_r8,2.1370e-04_r8,2.0956e-04_r8/) + kbo(:,49, 4) = (/ & + &1.7795e-04_r8,1.7554e-04_r8,1.7551e-04_r8,1.7452e-04_r8,1.7328e-04_r8/) + kbo(:,50, 4) = (/ & + &1.4762e-04_r8,1.4610e-04_r8,1.4428e-04_r8,1.4351e-04_r8,1.4273e-04_r8/) + kbo(:,51, 4) = (/ & + &1.2354e-04_r8,1.2144e-04_r8,1.1938e-04_r8,1.1805e-04_r8,1.1688e-04_r8/) + kbo(:,52, 4) = (/ & + &1.0353e-04_r8,1.0111e-04_r8,9.9958e-05_r8,9.7469e-05_r8,9.6574e-05_r8/) + kbo(:,53, 4) = (/ & + &8.8311e-05_r8,8.4522e-05_r8,8.3164e-05_r8,8.1847e-05_r8,7.9623e-05_r8/) + kbo(:,54, 4) = (/ & + &7.5002e-05_r8,7.1277e-05_r8,6.9429e-05_r8,6.8546e-05_r8,6.7044e-05_r8/) + kbo(:,55, 4) = (/ & + &6.4688e-05_r8,6.1558e-05_r8,5.8597e-05_r8,5.7310e-05_r8,5.6741e-05_r8/) + kbo(:,56, 4) = (/ & + &5.4545e-05_r8,5.2835e-05_r8,4.9722e-05_r8,4.8222e-05_r8,4.7437e-05_r8/) + kbo(:,57, 4) = (/ & + &4.5567e-05_r8,4.5770e-05_r8,4.3541e-05_r8,4.1141e-05_r8,3.9867e-05_r8/) + kbo(:,58, 4) = (/ & + &3.8423e-05_r8,3.8314e-05_r8,3.7767e-05_r8,3.5438e-05_r8,3.3984e-05_r8/) + kbo(:,59, 4) = (/ & + &3.2695e-05_r8,3.2545e-05_r8,3.2199e-05_r8,3.0741e-05_r8,2.9151e-05_r8/) + kbo(:,13, 5) = (/ & + &3.6693e-01_r8,3.6670e-01_r8,3.6374e-01_r8,3.6513e-01_r8,3.6694e-01_r8/) + kbo(:,14, 5) = (/ & + &3.1193e-01_r8,3.1009e-01_r8,3.0785e-01_r8,3.1108e-01_r8,3.1338e-01_r8/) + kbo(:,15, 5) = (/ & + &2.6635e-01_r8,2.6398e-01_r8,2.6603e-01_r8,2.6792e-01_r8,2.6974e-01_r8/) + kbo(:,16, 5) = (/ & + &2.2560e-01_r8,2.2536e-01_r8,2.2722e-01_r8,2.2790e-01_r8,2.2934e-01_r8/) + kbo(:,17, 5) = (/ & + &1.9102e-01_r8,1.9205e-01_r8,1.9235e-01_r8,1.9256e-01_r8,1.9454e-01_r8/) + kbo(:,18, 5) = (/ & + &1.6220e-01_r8,1.6268e-01_r8,1.6247e-01_r8,1.6354e-01_r8,1.6555e-01_r8/) + kbo(:,19, 5) = (/ & + &1.3796e-01_r8,1.3803e-01_r8,1.3823e-01_r8,1.3977e-01_r8,1.4117e-01_r8/) + kbo(:,20, 5) = (/ & + &1.1636e-01_r8,1.1631e-01_r8,1.1719e-01_r8,1.1821e-01_r8,1.1915e-01_r8/) + kbo(:,21, 5) = (/ & + &9.7502e-02_r8,9.7703e-02_r8,9.8615e-02_r8,9.9561e-02_r8,1.0025e-01_r8/) + kbo(:,22, 5) = (/ & + &8.1562e-02_r8,8.1981e-02_r8,8.2659e-02_r8,8.3450e-02_r8,8.3918e-02_r8/) + kbo(:,23, 5) = (/ & + &6.8080e-02_r8,6.8683e-02_r8,6.9366e-02_r8,6.9894e-02_r8,7.0282e-02_r8/) + kbo(:,24, 5) = (/ & + &5.7119e-02_r8,5.7682e-02_r8,5.8192e-02_r8,5.8547e-02_r8,5.9029e-02_r8/) + kbo(:,25, 5) = (/ & + &4.7811e-02_r8,4.8293e-02_r8,4.8606e-02_r8,4.8996e-02_r8,4.9473e-02_r8/) + kbo(:,26, 5) = (/ & + &3.9890e-02_r8,4.0316e-02_r8,4.0576e-02_r8,4.1016e-02_r8,4.1455e-02_r8/) + kbo(:,27, 5) = (/ & + &3.3117e-02_r8,3.3470e-02_r8,3.3770e-02_r8,3.4189e-02_r8,3.4527e-02_r8/) + kbo(:,28, 5) = (/ & + &2.7406e-02_r8,2.7694e-02_r8,2.7971e-02_r8,2.8332e-02_r8,2.8599e-02_r8/) + kbo(:,29, 5) = (/ & + &2.2401e-02_r8,2.2630e-02_r8,2.2890e-02_r8,2.3150e-02_r8,2.3396e-02_r8/) + kbo(:,30, 5) = (/ & + &1.8227e-02_r8,1.8399e-02_r8,1.8623e-02_r8,1.8850e-02_r8,1.9028e-02_r8/) + kbo(:,31, 5) = (/ & + &1.4683e-02_r8,1.4830e-02_r8,1.5011e-02_r8,1.5187e-02_r8,1.5326e-02_r8/) + kbo(:,32, 5) = (/ & + &1.1826e-02_r8,1.1971e-02_r8,1.2101e-02_r8,1.2245e-02_r8,1.2313e-02_r8/) + kbo(:,33, 5) = (/ & + &9.5307e-03_r8,9.6419e-03_r8,9.7421e-03_r8,9.8284e-03_r8,9.8826e-03_r8/) + kbo(:,34, 5) = (/ & + &7.7176e-03_r8,7.8031e-03_r8,7.8838e-03_r8,7.9405e-03_r8,7.9679e-03_r8/) + kbo(:,35, 5) = (/ & + &6.2512e-03_r8,6.3124e-03_r8,6.3712e-03_r8,6.4126e-03_r8,6.4324e-03_r8/) + kbo(:,36, 5) = (/ & + &5.0560e-03_r8,5.1076e-03_r8,5.1576e-03_r8,5.1918e-03_r8,5.2018e-03_r8/) + kbo(:,37, 5) = (/ & + &4.0965e-03_r8,4.1427e-03_r8,4.1869e-03_r8,4.2164e-03_r8,4.2222e-03_r8/) + kbo(:,38, 5) = (/ & + &3.3169e-03_r8,3.3541e-03_r8,3.3940e-03_r8,3.4174e-03_r8,3.4236e-03_r8/) + kbo(:,39, 5) = (/ & + &2.6806e-03_r8,2.7157e-03_r8,2.7440e-03_r8,2.7658e-03_r8,2.7739e-03_r8/) + kbo(:,40, 5) = (/ & + &2.1766e-03_r8,2.2105e-03_r8,2.2356e-03_r8,2.2533e-03_r8,2.2654e-03_r8/) + kbo(:,41, 5) = (/ & + &1.7690e-03_r8,1.7997e-03_r8,1.8217e-03_r8,1.8373e-03_r8,1.8492e-03_r8/) + kbo(:,42, 5) = (/ & + &1.4370e-03_r8,1.4625e-03_r8,1.4833e-03_r8,1.4970e-03_r8,1.5072e-03_r8/) + kbo(:,43, 5) = (/ & + &1.1671e-03_r8,1.1863e-03_r8,1.2051e-03_r8,1.2193e-03_r8,1.2276e-03_r8/) + kbo(:,44, 5) = (/ & + &9.4820e-04_r8,9.6187e-04_r8,9.7830e-04_r8,9.9143e-04_r8,9.9963e-04_r8/) + kbo(:,45, 5) = (/ & + &7.6916e-04_r8,7.7831e-04_r8,7.9153e-04_r8,8.0495e-04_r8,8.1281e-04_r8/) + kbo(:,46, 5) = (/ & + &6.2348e-04_r8,6.3114e-04_r8,6.4009e-04_r8,6.5199e-04_r8,6.6002e-04_r8/) + kbo(:,47, 5) = (/ & + &5.0390e-04_r8,5.1138e-04_r8,5.1807e-04_r8,5.2655e-04_r8,5.3606e-04_r8/) + kbo(:,48, 5) = (/ & + &4.0606e-04_r8,4.1379e-04_r8,4.1952e-04_r8,4.2537e-04_r8,4.3314e-04_r8/) + kbo(:,49, 5) = (/ & + &3.2659e-04_r8,3.3285e-04_r8,3.3902e-04_r8,3.4315e-04_r8,3.4880e-04_r8/) + kbo(:,50, 5) = (/ & + &2.6466e-04_r8,2.6781e-04_r8,2.7393e-04_r8,2.7826e-04_r8,2.8216e-04_r8/) + kbo(:,51, 5) = (/ & + &2.1507e-04_r8,2.1721e-04_r8,2.2109e-04_r8,2.2570e-04_r8,2.2911e-04_r8/) + kbo(:,52, 5) = (/ & + &1.7470e-04_r8,1.7639e-04_r8,1.7813e-04_r8,1.8197e-04_r8,1.8512e-04_r8/) + kbo(:,53, 5) = (/ & + &1.4115e-04_r8,1.4348e-04_r8,1.4425e-04_r8,1.4633e-04_r8,1.4939e-04_r8/) + kbo(:,54, 5) = (/ & + &1.1575e-04_r8,1.1704e-04_r8,1.1812e-04_r8,1.1890e-04_r8,1.2106e-04_r8/) + kbo(:,55, 5) = (/ & + &9.4726e-05_r8,9.5455e-05_r8,9.6825e-05_r8,9.7465e-05_r8,9.8412e-05_r8/) + kbo(:,56, 5) = (/ & + &7.9719e-05_r8,7.8475e-05_r8,7.9571e-05_r8,8.0057e-05_r8,8.0565e-05_r8/) + kbo(:,57, 5) = (/ & + &6.7373e-05_r8,6.4174e-05_r8,6.4600e-05_r8,6.5492e-05_r8,6.6130e-05_r8/) + kbo(:,58, 5) = (/ & + &5.8248e-05_r8,5.4990e-05_r8,5.3012e-05_r8,5.3610e-05_r8,5.4283e-05_r8/) + kbo(:,59, 5) = (/ & + &5.0210e-05_r8,4.6885e-05_r8,4.4678e-05_r8,4.4690e-05_r8,4.5330e-05_r8/) + kbo(:,13, 6) = (/ & + &8.1815e-01_r8,8.2185e-01_r8,8.2056e-01_r8,8.1693e-01_r8,8.1119e-01_r8/) + kbo(:,14, 6) = (/ & + &6.9938e-01_r8,7.0403e-01_r8,7.0310e-01_r8,6.9893e-01_r8,6.9382e-01_r8/) + kbo(:,15, 6) = (/ & + &6.0306e-01_r8,6.0562e-01_r8,6.0433e-01_r8,6.0124e-01_r8,5.9539e-01_r8/) + kbo(:,16, 6) = (/ & + &5.1717e-01_r8,5.1741e-01_r8,5.1602e-01_r8,5.1303e-01_r8,5.0799e-01_r8/) + kbo(:,17, 6) = (/ & + &4.3954e-01_r8,4.3996e-01_r8,4.3917e-01_r8,4.3585e-01_r8,4.3144e-01_r8/) + kbo(:,18, 6) = (/ & + &3.7098e-01_r8,3.7164e-01_r8,3.7046e-01_r8,3.6778e-01_r8,3.6412e-01_r8/) + kbo(:,19, 6) = (/ & + &3.1410e-01_r8,3.1452e-01_r8,3.1318e-01_r8,3.1054e-01_r8,3.0829e-01_r8/) + kbo(:,20, 6) = (/ & + &2.6425e-01_r8,2.6434e-01_r8,2.6287e-01_r8,2.6129e-01_r8,2.6054e-01_r8/) + kbo(:,21, 6) = (/ & + &2.2166e-01_r8,2.2161e-01_r8,2.2078e-01_r8,2.2017e-01_r8,2.1929e-01_r8/) + kbo(:,22, 6) = (/ & + &1.8499e-01_r8,1.8512e-01_r8,1.8480e-01_r8,1.8474e-01_r8,1.8395e-01_r8/) + kbo(:,23, 6) = (/ & + &1.5462e-01_r8,1.5460e-01_r8,1.5448e-01_r8,1.5440e-01_r8,1.5366e-01_r8/) + kbo(:,24, 6) = (/ & + &1.2929e-01_r8,1.2940e-01_r8,1.2953e-01_r8,1.2932e-01_r8,1.2872e-01_r8/) + kbo(:,25, 6) = (/ & + &1.0802e-01_r8,1.0819e-01_r8,1.0834e-01_r8,1.0817e-01_r8,1.0761e-01_r8/) + kbo(:,26, 6) = (/ & + &9.0060e-02_r8,9.0350e-02_r8,9.0334e-02_r8,9.0150e-02_r8,8.9781e-02_r8/) + kbo(:,27, 6) = (/ & + &7.4680e-02_r8,7.4863e-02_r8,7.4908e-02_r8,7.4831e-02_r8,7.4608e-02_r8/) + kbo(:,28, 6) = (/ & + &6.1687e-02_r8,6.1865e-02_r8,6.1970e-02_r8,6.1917e-02_r8,6.1874e-02_r8/) + kbo(:,29, 6) = (/ & + &5.0513e-02_r8,5.0701e-02_r8,5.0801e-02_r8,5.0773e-02_r8,5.0734e-02_r8/) + kbo(:,30, 6) = (/ & + &4.1201e-02_r8,4.1379e-02_r8,4.1449e-02_r8,4.1422e-02_r8,4.1408e-02_r8/) + kbo(:,31, 6) = (/ & + &3.3339e-02_r8,3.3480e-02_r8,3.3517e-02_r8,3.3503e-02_r8,3.3496e-02_r8/) + kbo(:,32, 6) = (/ & + &2.6941e-02_r8,2.7025e-02_r8,2.7045e-02_r8,2.7032e-02_r8,2.7041e-02_r8/) + kbo(:,33, 6) = (/ & + &2.1746e-02_r8,2.1784e-02_r8,2.1791e-02_r8,2.1788e-02_r8,2.1780e-02_r8/) + kbo(:,34, 6) = (/ & + &1.7618e-02_r8,1.7652e-02_r8,1.7653e-02_r8,1.7651e-02_r8,1.7645e-02_r8/) + kbo(:,35, 6) = (/ & + &1.4278e-02_r8,1.4314e-02_r8,1.4305e-02_r8,1.4306e-02_r8,1.4294e-02_r8/) + kbo(:,36, 6) = (/ & + &1.1580e-02_r8,1.1612e-02_r8,1.1606e-02_r8,1.1608e-02_r8,1.1605e-02_r8/) + kbo(:,37, 6) = (/ & + &9.4219e-03_r8,9.4537e-03_r8,9.4624e-03_r8,9.4565e-03_r8,9.4577e-03_r8/) + kbo(:,38, 6) = (/ & + &7.6536e-03_r8,7.6870e-03_r8,7.7033e-03_r8,7.6954e-03_r8,7.6994e-03_r8/) + kbo(:,39, 6) = (/ & + &6.2054e-03_r8,6.2357e-03_r8,6.2573e-03_r8,6.2573e-03_r8,6.2600e-03_r8/) + kbo(:,40, 6) = (/ & + &5.0787e-03_r8,5.1000e-03_r8,5.1231e-03_r8,5.1304e-03_r8,5.1270e-03_r8/) + kbo(:,41, 6) = (/ & + &4.1553e-03_r8,4.1734e-03_r8,4.1950e-03_r8,4.2100e-03_r8,4.2073e-03_r8/) + kbo(:,42, 6) = (/ & + &3.3951e-03_r8,3.4115e-03_r8,3.4321e-03_r8,3.4456e-03_r8,3.4459e-03_r8/) + kbo(:,43, 6) = (/ & + &2.7739e-03_r8,2.7892e-03_r8,2.8063e-03_r8,2.8198e-03_r8,2.8248e-03_r8/) + kbo(:,44, 6) = (/ & + &2.2638e-03_r8,2.2784e-03_r8,2.2918e-03_r8,2.3046e-03_r8,2.3113e-03_r8/) + kbo(:,45, 6) = (/ & + &1.8451e-03_r8,1.8580e-03_r8,1.8678e-03_r8,1.8806e-03_r8,1.8860e-03_r8/) + kbo(:,46, 6) = (/ & + &1.5013e-03_r8,1.5134e-03_r8,1.5237e-03_r8,1.5316e-03_r8,1.5391e-03_r8/) + kbo(:,47, 6) = (/ & + &1.2205e-03_r8,1.2340e-03_r8,1.2429e-03_r8,1.2503e-03_r8,1.2568e-03_r8/) + kbo(:,48, 6) = (/ & + &9.8959e-04_r8,1.0036e-03_r8,1.0115e-03_r8,1.0182e-03_r8,1.0235e-03_r8/) + kbo(:,49, 6) = (/ & + &8.0128e-04_r8,8.1327e-04_r8,8.2211e-04_r8,8.2807e-04_r8,8.3181e-04_r8/) + kbo(:,50, 6) = (/ & + &6.5077e-04_r8,6.6049e-04_r8,6.6942e-04_r8,6.7493e-04_r8,6.7909e-04_r8/) + kbo(:,51, 6) = (/ & + &5.2860e-04_r8,5.3765e-04_r8,5.4562e-04_r8,5.5099e-04_r8,5.5519e-04_r8/) + kbo(:,52, 6) = (/ & + &4.2741e-04_r8,4.3678e-04_r8,4.4379e-04_r8,4.4944e-04_r8,4.5321e-04_r8/) + kbo(:,53, 6) = (/ & + &3.4420e-04_r8,3.5368e-04_r8,3.5979e-04_r8,3.6513e-04_r8,3.6858e-04_r8/) + kbo(:,54, 6) = (/ & + &2.7911e-04_r8,2.8752e-04_r8,2.9393e-04_r8,2.9865e-04_r8,3.0238e-04_r8/) + kbo(:,55, 6) = (/ & + &2.2659e-04_r8,2.3415e-04_r8,2.4084e-04_r8,2.4534e-04_r8,2.4896e-04_r8/) + kbo(:,56, 6) = (/ & + &1.8317e-04_r8,1.9078e-04_r8,1.9656e-04_r8,2.0135e-04_r8,2.0466e-04_r8/) + kbo(:,57, 6) = (/ & + &1.4828e-04_r8,1.5527e-04_r8,1.6035e-04_r8,1.6503e-04_r8,1.6825e-04_r8/) + kbo(:,58, 6) = (/ & + &1.1818e-04_r8,1.2542e-04_r8,1.3082e-04_r8,1.3476e-04_r8,1.3831e-04_r8/) + kbo(:,59, 6) = (/ & + &9.6673e-05_r8,1.0368e-04_r8,1.0861e-04_r8,1.1211e-04_r8,1.1553e-04_r8/) + kbo(:,13, 7) = (/ & + &2.1727e+00_r8,2.1507e+00_r8,2.1220e+00_r8,2.0892e+00_r8,2.0541e+00_r8/) + kbo(:,14, 7) = (/ & + &1.7980e+00_r8,1.7753e+00_r8,1.7493e+00_r8,1.7241e+00_r8,1.6941e+00_r8/) + kbo(:,15, 7) = (/ & + &1.5327e+00_r8,1.5148e+00_r8,1.4951e+00_r8,1.4705e+00_r8,1.4480e+00_r8/) + kbo(:,16, 7) = (/ & + &1.3007e+00_r8,1.2909e+00_r8,1.2720e+00_r8,1.2527e+00_r8,1.2359e+00_r8/) + kbo(:,17, 7) = (/ & + &1.1117e+00_r8,1.1002e+00_r8,1.0859e+00_r8,1.0728e+00_r8,1.0608e+00_r8/) + kbo(:,18, 7) = (/ & + &9.4895e-01_r8,9.3669e-01_r8,9.2658e-01_r8,9.1630e-01_r8,9.0461e-01_r8/) + kbo(:,19, 7) = (/ & + &8.0771e-01_r8,7.9960e-01_r8,7.9052e-01_r8,7.8134e-01_r8,7.7103e-01_r8/) + kbo(:,20, 7) = (/ & + &6.8397e-01_r8,6.7733e-01_r8,6.6931e-01_r8,6.6104e-01_r8,6.5276e-01_r8/) + kbo(:,21, 7) = (/ & + &5.7680e-01_r8,5.7078e-01_r8,5.6416e-01_r8,5.5706e-01_r8,5.4996e-01_r8/) + kbo(:,22, 7) = (/ & + &4.8402e-01_r8,4.7901e-01_r8,4.7292e-01_r8,4.6701e-01_r8,4.6224e-01_r8/) + kbo(:,23, 7) = (/ & + &4.0435e-01_r8,4.0004e-01_r8,3.9588e-01_r8,3.9219e-01_r8,3.8835e-01_r8/) + kbo(:,24, 7) = (/ & + &3.3766e-01_r8,3.3478e-01_r8,3.3178e-01_r8,3.2887e-01_r8,3.2604e-01_r8/) + kbo(:,25, 7) = (/ & + &2.8141e-01_r8,2.7941e-01_r8,2.7716e-01_r8,2.7469e-01_r8,2.7266e-01_r8/) + kbo(:,26, 7) = (/ & + &2.3429e-01_r8,2.3260e-01_r8,2.3087e-01_r8,2.2897e-01_r8,2.2751e-01_r8/) + kbo(:,27, 7) = (/ & + &1.9420e-01_r8,1.9275e-01_r8,1.9122e-01_r8,1.8991e-01_r8,1.8923e-01_r8/) + kbo(:,28, 7) = (/ & + &1.6015e-01_r8,1.5905e-01_r8,1.5800e-01_r8,1.5718e-01_r8,1.5696e-01_r8/) + kbo(:,29, 7) = (/ & + &1.3094e-01_r8,1.3014e-01_r8,1.2944e-01_r8,1.2906e-01_r8,1.2899e-01_r8/) + kbo(:,30, 7) = (/ & + &1.0666e-01_r8,1.0604e-01_r8,1.0563e-01_r8,1.0549e-01_r8,1.0548e-01_r8/) + kbo(:,31, 7) = (/ & + &8.6275e-02_r8,8.5845e-02_r8,8.5617e-02_r8,8.5505e-02_r8,8.5535e-02_r8/) + kbo(:,32, 7) = (/ & + &6.9798e-02_r8,6.9528e-02_r8,6.9393e-02_r8,6.9336e-02_r8,6.9374e-02_r8/) + kbo(:,33, 7) = (/ & + &5.6418e-02_r8,5.6253e-02_r8,5.6185e-02_r8,5.6126e-02_r8,5.6165e-02_r8/) + kbo(:,34, 7) = (/ & + &4.5866e-02_r8,4.5727e-02_r8,4.5682e-02_r8,4.5616e-02_r8,4.5707e-02_r8/) + kbo(:,35, 7) = (/ & + &3.7274e-02_r8,3.7180e-02_r8,3.7143e-02_r8,3.7120e-02_r8,3.7200e-02_r8/) + kbo(:,36, 7) = (/ & + &3.0350e-02_r8,3.0274e-02_r8,3.0257e-02_r8,3.0235e-02_r8,3.0299e-02_r8/) + kbo(:,37, 7) = (/ & + &2.4821e-02_r8,2.4753e-02_r8,2.4742e-02_r8,2.4741e-02_r8,2.4790e-02_r8/) + kbo(:,38, 7) = (/ & + &2.0268e-02_r8,2.0223e-02_r8,2.0196e-02_r8,2.0200e-02_r8,2.0236e-02_r8/) + kbo(:,39, 7) = (/ & + &1.6521e-02_r8,1.6487e-02_r8,1.6459e-02_r8,1.6462e-02_r8,1.6499e-02_r8/) + kbo(:,40, 7) = (/ & + &1.3551e-02_r8,1.3542e-02_r8,1.3531e-02_r8,1.3538e-02_r8,1.3571e-02_r8/) + kbo(:,41, 7) = (/ & + &1.1139e-02_r8,1.1135e-02_r8,1.1130e-02_r8,1.1141e-02_r8,1.1171e-02_r8/) + kbo(:,42, 7) = (/ & + &9.1492e-03_r8,9.1515e-03_r8,9.1518e-03_r8,9.1649e-03_r8,9.1900e-03_r8/) + kbo(:,43, 7) = (/ & + &7.5083e-03_r8,7.5191e-03_r8,7.5258e-03_r8,7.5334e-03_r8,7.5552e-03_r8/) + kbo(:,44, 7) = (/ & + &6.1594e-03_r8,6.1707e-03_r8,6.1785e-03_r8,6.1865e-03_r8,6.2090e-03_r8/) + kbo(:,45, 7) = (/ & + &5.0436e-03_r8,5.0526e-03_r8,5.0656e-03_r8,5.0711e-03_r8,5.0867e-03_r8/) + kbo(:,46, 7) = (/ & + &4.1291e-03_r8,4.1408e-03_r8,4.1483e-03_r8,4.1539e-03_r8,4.1670e-03_r8/) + kbo(:,47, 7) = (/ & + &3.3808e-03_r8,3.3903e-03_r8,3.4014e-03_r8,3.4059e-03_r8,3.4179e-03_r8/) + kbo(:,48, 7) = (/ & + &2.7630e-03_r8,2.7730e-03_r8,2.7794e-03_r8,2.7876e-03_r8,2.7961e-03_r8/) + kbo(:,49, 7) = (/ & + &2.2529e-03_r8,2.2614e-03_r8,2.2681e-03_r8,2.2743e-03_r8,2.2825e-03_r8/) + kbo(:,50, 7) = (/ & + &1.8409e-03_r8,1.8507e-03_r8,1.8571e-03_r8,1.8629e-03_r8,1.8694e-03_r8/) + kbo(:,51, 7) = (/ & + &1.5059e-03_r8,1.5160e-03_r8,1.5224e-03_r8,1.5287e-03_r8,1.5343e-03_r8/) + kbo(:,52, 7) = (/ & + &1.2303e-03_r8,1.2392e-03_r8,1.2461e-03_r8,1.2522e-03_r8,1.2570e-03_r8/) + kbo(:,53, 7) = (/ & + &1.0020e-03_r8,1.0115e-03_r8,1.0178e-03_r8,1.0227e-03_r8,1.0281e-03_r8/) + kbo(:,54, 7) = (/ & + &8.2130e-04_r8,8.3060e-04_r8,8.3778e-04_r8,8.4304e-04_r8,8.4741e-04_r8/) + kbo(:,55, 7) = (/ & + &6.7498e-04_r8,6.8670e-04_r8,6.9292e-04_r8,6.9895e-04_r8,7.0313e-04_r8/) + kbo(:,56, 7) = (/ & + &5.5427e-04_r8,5.6524e-04_r8,5.7318e-04_r8,5.7892e-04_r8,5.8355e-04_r8/) + kbo(:,57, 7) = (/ & + &4.5437e-04_r8,4.6585e-04_r8,4.7333e-04_r8,4.7899e-04_r8,4.8346e-04_r8/) + kbo(:,58, 7) = (/ & + &3.7314e-04_r8,3.8385e-04_r8,3.9164e-04_r8,3.9732e-04_r8,4.0183e-04_r8/) + kbo(:,59, 7) = (/ & + &3.1164e-04_r8,3.2163e-04_r8,3.2929e-04_r8,3.3498e-04_r8,3.3967e-04_r8/) + kbo(:,13, 8) = (/ & + &7.1017e+00_r8,7.0462e+00_r8,6.9629e+00_r8,6.8569e+00_r8,6.7518e+00_r8/) + kbo(:,14, 8) = (/ & + &5.9884e+00_r8,5.9470e+00_r8,5.8924e+00_r8,5.8216e+00_r8,5.7342e+00_r8/) + kbo(:,15, 8) = (/ & + &4.9849e+00_r8,4.9563e+00_r8,4.9071e+00_r8,4.8502e+00_r8,4.7771e+00_r8/) + kbo(:,16, 8) = (/ & + &4.1453e+00_r8,4.1136e+00_r8,4.0790e+00_r8,4.0345e+00_r8,3.9753e+00_r8/) + kbo(:,17, 8) = (/ & + &3.5269e+00_r8,3.5022e+00_r8,3.4717e+00_r8,3.4323e+00_r8,3.3830e+00_r8/) + kbo(:,18, 8) = (/ & + &3.0258e+00_r8,3.0139e+00_r8,2.9887e+00_r8,2.9518e+00_r8,2.9096e+00_r8/) + kbo(:,19, 8) = (/ & + &2.6100e+00_r8,2.6057e+00_r8,2.5839e+00_r8,2.5531e+00_r8,2.5181e+00_r8/) + kbo(:,20, 8) = (/ & + &2.2532e+00_r8,2.2444e+00_r8,2.2242e+00_r8,2.2015e+00_r8,2.1737e+00_r8/) + kbo(:,21, 8) = (/ & + &1.9361e+00_r8,1.9257e+00_r8,1.9080e+00_r8,1.8885e+00_r8,1.8663e+00_r8/) + kbo(:,22, 8) = (/ & + &1.6493e+00_r8,1.6394e+00_r8,1.6256e+00_r8,1.6084e+00_r8,1.5911e+00_r8/) + kbo(:,23, 8) = (/ & + &1.3971e+00_r8,1.3901e+00_r8,1.3774e+00_r8,1.3628e+00_r8,1.3482e+00_r8/) + kbo(:,24, 8) = (/ & + &1.1828e+00_r8,1.1757e+00_r8,1.1653e+00_r8,1.1541e+00_r8,1.1420e+00_r8/) + kbo(:,25, 8) = (/ & + &9.9841e-01_r8,9.9173e-01_r8,9.8314e-01_r8,9.7419e-01_r8,9.6526e-01_r8/) + kbo(:,26, 8) = (/ & + &8.3815e-01_r8,8.3237e-01_r8,8.2631e-01_r8,8.2072e-01_r8,8.1439e-01_r8/) + kbo(:,27, 8) = (/ & + &6.9885e-01_r8,6.9534e-01_r8,6.9172e-01_r8,6.8787e-01_r8,6.8202e-01_r8/) + kbo(:,28, 8) = (/ & + &5.8056e-01_r8,5.7858e-01_r8,5.7609e-01_r8,5.7252e-01_r8,5.6730e-01_r8/) + kbo(:,29, 8) = (/ & + &4.7795e-01_r8,4.7646e-01_r8,4.7447e-01_r8,4.7127e-01_r8,4.6716e-01_r8/) + kbo(:,30, 8) = (/ & + &3.9180e-01_r8,3.9040e-01_r8,3.8874e-01_r8,3.8567e-01_r8,3.8256e-01_r8/) + kbo(:,31, 8) = (/ & + &3.1850e-01_r8,3.1735e-01_r8,3.1544e-01_r8,3.1324e-01_r8,3.1109e-01_r8/) + kbo(:,32, 8) = (/ & + &2.5851e-01_r8,2.5736e-01_r8,2.5590e-01_r8,2.5439e-01_r8,2.5264e-01_r8/) + kbo(:,33, 8) = (/ & + &2.0938e-01_r8,2.0841e-01_r8,2.0741e-01_r8,2.0615e-01_r8,2.0501e-01_r8/) + kbo(:,34, 8) = (/ & + &1.7037e-01_r8,1.6964e-01_r8,1.6891e-01_r8,1.6812e-01_r8,1.6728e-01_r8/) + kbo(:,35, 8) = (/ & + &1.3875e-01_r8,1.3827e-01_r8,1.3776e-01_r8,1.3724e-01_r8,1.3661e-01_r8/) + kbo(:,36, 8) = (/ & + &1.1324e-01_r8,1.1288e-01_r8,1.1260e-01_r8,1.1226e-01_r8,1.1182e-01_r8/) + kbo(:,37, 8) = (/ & + &9.2766e-02_r8,9.2595e-02_r8,9.2422e-02_r8,9.2186e-02_r8,9.1910e-02_r8/) + kbo(:,38, 8) = (/ & + &7.5939e-02_r8,7.5826e-02_r8,7.5761e-02_r8,7.5637e-02_r8,7.5518e-02_r8/) + kbo(:,39, 8) = (/ & + &6.2076e-02_r8,6.2014e-02_r8,6.2019e-02_r8,6.2000e-02_r8,6.1957e-02_r8/) + kbo(:,40, 8) = (/ & + &5.1067e-02_r8,5.1119e-02_r8,5.1147e-02_r8,5.1217e-02_r8,5.1232e-02_r8/) + kbo(:,41, 8) = (/ & + &4.2004e-02_r8,4.2110e-02_r8,4.2194e-02_r8,4.2288e-02_r8,4.2348e-02_r8/) + kbo(:,42, 8) = (/ & + &3.4565e-02_r8,3.4686e-02_r8,3.4772e-02_r8,3.4891e-02_r8,3.5001e-02_r8/) + kbo(:,43, 8) = (/ & + &2.8439e-02_r8,2.8558e-02_r8,2.8651e-02_r8,2.8781e-02_r8,2.8908e-02_r8/) + kbo(:,44, 8) = (/ & + &2.3381e-02_r8,2.3495e-02_r8,2.3607e-02_r8,2.3736e-02_r8,2.3863e-02_r8/) + kbo(:,45, 8) = (/ & + &1.9178e-02_r8,1.9302e-02_r8,1.9411e-02_r8,1.9527e-02_r8,1.9645e-02_r8/) + kbo(:,46, 8) = (/ & + &1.5718e-02_r8,1.5824e-02_r8,1.5935e-02_r8,1.6052e-02_r8,1.6161e-02_r8/) + kbo(:,47, 8) = (/ & + &1.2888e-02_r8,1.2994e-02_r8,1.3091e-02_r8,1.3201e-02_r8,1.3310e-02_r8/) + kbo(:,48, 8) = (/ & + &1.0534e-02_r8,1.0644e-02_r8,1.0741e-02_r8,1.0828e-02_r8,1.0922e-02_r8/) + kbo(:,49, 8) = (/ & + &8.5773e-03_r8,8.6840e-03_r8,8.7716e-03_r8,8.8561e-03_r8,8.9344e-03_r8/) + kbo(:,50, 8) = (/ & + &7.0118e-03_r8,7.1121e-03_r8,7.1954e-03_r8,7.2655e-03_r8,7.3372e-03_r8/) + kbo(:,51, 8) = (/ & + &5.7344e-03_r8,5.8326e-03_r8,5.9098e-03_r8,5.9770e-03_r8,6.0423e-03_r8/) + kbo(:,52, 8) = (/ & + &4.6784e-03_r8,4.7703e-03_r8,4.8415e-03_r8,4.9016e-03_r8,4.9646e-03_r8/) + kbo(:,53, 8) = (/ & + &3.8084e-03_r8,3.8892e-03_r8,3.9565e-03_r8,4.0107e-03_r8,4.0624e-03_r8/) + kbo(:,54, 8) = (/ & + &3.1302e-03_r8,3.1988e-03_r8,3.2604e-03_r8,3.3140e-03_r8,3.3627e-03_r8/) + kbo(:,55, 8) = (/ & + &2.5815e-03_r8,2.6417e-03_r8,2.7045e-03_r8,2.7548e-03_r8,2.8045e-03_r8/) + kbo(:,56, 8) = (/ & + &2.1299e-03_r8,2.1858e-03_r8,2.2412e-03_r8,2.2906e-03_r8,2.3394e-03_r8/) + kbo(:,57, 8) = (/ & + &1.7549e-03_r8,1.8058e-03_r8,1.8577e-03_r8,1.9050e-03_r8,1.9496e-03_r8/) + kbo(:,58, 8) = (/ & + &1.4508e-03_r8,1.4946e-03_r8,1.5437e-03_r8,1.5867e-03_r8,1.6288e-03_r8/) + kbo(:,59, 8) = (/ & + &1.2226e-03_r8,1.2669e-03_r8,1.3143e-03_r8,1.3547e-03_r8,1.3969e-03_r8/) + kbo(:,13, 9) = (/ & + &4.2167e+01_r8,4.2169e+01_r8,4.2037e+01_r8,4.1794e+01_r8,4.1453e+01_r8/) + kbo(:,14, 9) = (/ & + &3.6302e+01_r8,3.6287e+01_r8,3.6134e+01_r8,3.5895e+01_r8,3.5553e+01_r8/) + kbo(:,15, 9) = (/ & + &3.1018e+01_r8,3.0974e+01_r8,3.0831e+01_r8,3.0595e+01_r8,3.0284e+01_r8/) + kbo(:,16, 9) = (/ & + &2.6381e+01_r8,2.6327e+01_r8,2.6171e+01_r8,2.5940e+01_r8,2.5630e+01_r8/) + kbo(:,17, 9) = (/ & + &2.2159e+01_r8,2.2069e+01_r8,2.1921e+01_r8,2.1709e+01_r8,2.1443e+01_r8/) + kbo(:,18, 9) = (/ & + &1.8546e+01_r8,1.8422e+01_r8,1.8249e+01_r8,1.8049e+01_r8,1.7832e+01_r8/) + kbo(:,19, 9) = (/ & + &1.5581e+01_r8,1.5418e+01_r8,1.5257e+01_r8,1.5071e+01_r8,1.4880e+01_r8/) + kbo(:,20, 9) = (/ & + &1.3153e+01_r8,1.2997e+01_r8,1.2837e+01_r8,1.2663e+01_r8,1.2482e+01_r8/) + kbo(:,21, 9) = (/ & + &1.1154e+01_r8,1.1003e+01_r8,1.0876e+01_r8,1.0723e+01_r8,1.0559e+01_r8/) + kbo(:,22, 9) = (/ & + &9.6248e+00_r8,9.4985e+00_r8,9.3603e+00_r8,9.2175e+00_r8,9.0746e+00_r8/) + kbo(:,23, 9) = (/ & + &8.3452e+00_r8,8.2318e+00_r8,8.1134e+00_r8,7.9935e+00_r8,7.8653e+00_r8/) + kbo(:,24, 9) = (/ & + &7.2560e+00_r8,7.1534e+00_r8,7.0580e+00_r8,6.9498e+00_r8,6.8440e+00_r8/) + kbo(:,25, 9) = (/ & + &6.3013e+00_r8,6.2279e+00_r8,6.1411e+00_r8,6.0460e+00_r8,5.9566e+00_r8/) + kbo(:,26, 9) = (/ & + &5.4473e+00_r8,5.3837e+00_r8,5.3066e+00_r8,5.2353e+00_r8,5.1609e+00_r8/) + kbo(:,27, 9) = (/ & + &4.6665e+00_r8,4.6055e+00_r8,4.5477e+00_r8,4.4876e+00_r8,4.4277e+00_r8/) + kbo(:,28, 9) = (/ & + &3.9616e+00_r8,3.9145e+00_r8,3.8668e+00_r8,3.8180e+00_r8,3.7694e+00_r8/) + kbo(:,29, 9) = (/ & + &3.3226e+00_r8,3.2862e+00_r8,3.2469e+00_r8,3.2091e+00_r8,3.1718e+00_r8/) + kbo(:,30, 9) = (/ & + &2.7659e+00_r8,2.7390e+00_r8,2.7094e+00_r8,2.6815e+00_r8,2.6543e+00_r8/) + kbo(:,31, 9) = (/ & + &2.2826e+00_r8,2.2617e+00_r8,2.2409e+00_r8,2.2203e+00_r8,2.1979e+00_r8/) + kbo(:,32, 9) = (/ & + &1.8802e+00_r8,1.8648e+00_r8,1.8493e+00_r8,1.8340e+00_r8,1.8168e+00_r8/) + kbo(:,33, 9) = (/ & + &1.5466e+00_r8,1.5353e+00_r8,1.5232e+00_r8,1.5114e+00_r8,1.4999e+00_r8/) + kbo(:,34, 9) = (/ & + &1.2752e+00_r8,1.2674e+00_r8,1.2588e+00_r8,1.2512e+00_r8,1.2426e+00_r8/) + kbo(:,35, 9) = (/ & + &1.0520e+00_r8,1.0466e+00_r8,1.0412e+00_r8,1.0356e+00_r8,1.0296e+00_r8/) + kbo(:,36, 9) = (/ & + &8.6897e-01_r8,8.6546e-01_r8,8.6220e-01_r8,8.5818e-01_r8,8.5421e-01_r8/) + kbo(:,37, 9) = (/ & + &7.1978e-01_r8,7.1767e-01_r8,7.1572e-01_r8,7.1373e-01_r8,7.1176e-01_r8/) + kbo(:,38, 9) = (/ & + &5.9482e-01_r8,5.9396e-01_r8,5.9353e-01_r8,5.9295e-01_r8,5.9232e-01_r8/) + kbo(:,39, 9) = (/ & + &4.9071e-01_r8,4.9116e-01_r8,4.9162e-01_r8,4.9173e-01_r8,4.9201e-01_r8/) + kbo(:,40, 9) = (/ & + &4.0707e-01_r8,4.0846e-01_r8,4.0948e-01_r8,4.1018e-01_r8,4.1089e-01_r8/) + kbo(:,41, 9) = (/ & + &3.3813e-01_r8,3.3959e-01_r8,3.4089e-01_r8,3.4218e-01_r8,3.4329e-01_r8/) + kbo(:,42, 9) = (/ & + &2.8061e-01_r8,2.8231e-01_r8,2.8363e-01_r8,2.8501e-01_r8,2.8630e-01_r8/) + kbo(:,43, 9) = (/ & + &2.3284e-01_r8,2.3448e-01_r8,2.3606e-01_r8,2.3737e-01_r8,2.3893e-01_r8/) + kbo(:,44, 9) = (/ & + &1.9306e-01_r8,1.9456e-01_r8,1.9627e-01_r8,1.9759e-01_r8,1.9913e-01_r8/) + kbo(:,45, 9) = (/ & + &1.5984e-01_r8,1.6139e-01_r8,1.6282e-01_r8,1.6435e-01_r8,1.6569e-01_r8/) + kbo(:,46, 9) = (/ & + &1.3218e-01_r8,1.3367e-01_r8,1.3504e-01_r8,1.3656e-01_r8,1.3780e-01_r8/) + kbo(:,47, 9) = (/ & + &1.0925e-01_r8,1.1079e-01_r8,1.1209e-01_r8,1.1337e-01_r8,1.1463e-01_r8/) + kbo(:,48, 9) = (/ & + &9.0249e-02_r8,9.1522e-02_r8,9.2774e-02_r8,9.3960e-02_r8,9.5177e-02_r8/) + kbo(:,49, 9) = (/ & + &7.4377e-02_r8,7.5400e-02_r8,7.6569e-02_r8,7.7633e-02_r8,7.8742e-02_r8/) + kbo(:,50, 9) = (/ & + &6.1418e-02_r8,6.2415e-02_r8,6.3422e-02_r8,6.4413e-02_r8,6.5389e-02_r8/) + kbo(:,51, 9) = (/ & + &5.0729e-02_r8,5.1644e-02_r8,5.2564e-02_r8,5.3444e-02_r8,5.4353e-02_r8/) + kbo(:,52, 9) = (/ & + &4.1908e-02_r8,4.2660e-02_r8,4.3502e-02_r8,4.4323e-02_r8,4.5095e-02_r8/) + kbo(:,53, 9) = (/ & + &3.4462e-02_r8,3.5223e-02_r8,3.5939e-02_r8,3.6640e-02_r8,3.7360e-02_r8/) + kbo(:,54, 9) = (/ & + &2.8588e-02_r8,2.9269e-02_r8,2.9929e-02_r8,3.0560e-02_r8,3.1160e-02_r8/) + kbo(:,55, 9) = (/ & + &2.3807e-02_r8,2.4406e-02_r8,2.4997e-02_r8,2.5573e-02_r8,2.6196e-02_r8/) + kbo(:,56, 9) = (/ & + &1.9841e-02_r8,2.0395e-02_r8,2.0945e-02_r8,2.1491e-02_r8,2.2006e-02_r8/) + kbo(:,57, 9) = (/ & + &1.6519e-02_r8,1.7032e-02_r8,1.7546e-02_r8,1.8054e-02_r8,1.8550e-02_r8/) + kbo(:,58, 9) = (/ & + &1.3793e-02_r8,1.4292e-02_r8,1.4753e-02_r8,1.5213e-02_r8,1.5695e-02_r8/) + kbo(:,59, 9) = (/ & + &1.1809e-02_r8,1.2269e-02_r8,1.2713e-02_r8,1.3163e-02_r8,1.3635e-02_r8/) + kbo(:,13,10) = (/ & + &1.7142e+02_r8,1.7281e+02_r8,1.7236e+02_r8,1.7114e+02_r8,1.6934e+02_r8/) + kbo(:,14,10) = (/ & + &1.5574e+02_r8,1.5556e+02_r8,1.5469e+02_r8,1.5334e+02_r8,1.5193e+02_r8/) + kbo(:,15,10) = (/ & + &1.3728e+02_r8,1.3704e+02_r8,1.3637e+02_r8,1.3560e+02_r8,1.3459e+02_r8/) + kbo(:,16,10) = (/ & + &1.1953e+02_r8,1.1932e+02_r8,1.1895e+02_r8,1.1818e+02_r8,1.1715e+02_r8/) + kbo(:,17,10) = (/ & + &1.0359e+02_r8,1.0375e+02_r8,1.0320e+02_r8,1.0240e+02_r8,1.0131e+02_r8/) + kbo(:,18,10) = (/ & + &8.8878e+01_r8,8.9020e+01_r8,8.8706e+01_r8,8.7973e+01_r8,8.6746e+01_r8/) + kbo(:,19,10) = (/ & + &7.4020e+01_r8,7.4305e+01_r8,7.4019e+01_r8,7.3466e+01_r8,7.2562e+01_r8/) + kbo(:,20,10) = (/ & + &6.0721e+01_r8,6.1015e+01_r8,6.0921e+01_r8,6.0532e+01_r8,5.9983e+01_r8/) + kbo(:,21,10) = (/ & + &5.0465e+01_r8,5.0665e+01_r8,5.0241e+01_r8,4.9849e+01_r8,4.9385e+01_r8/) + kbo(:,22,10) = (/ & + &4.0819e+01_r8,4.0731e+01_r8,4.0529e+01_r8,4.0271e+01_r8,3.9749e+01_r8/) + kbo(:,23,10) = (/ & + &3.4205e+01_r8,3.4202e+01_r8,3.4020e+01_r8,3.3582e+01_r8,3.3186e+01_r8/) + kbo(:,24,10) = (/ & + &2.9307e+01_r8,2.9168e+01_r8,2.8849e+01_r8,2.8552e+01_r8,2.8160e+01_r8/) + kbo(:,25,10) = (/ & + &2.5427e+01_r8,2.5125e+01_r8,2.4814e+01_r8,2.4511e+01_r8,2.4195e+01_r8/) + kbo(:,26,10) = (/ & + &2.2227e+01_r8,2.1953e+01_r8,2.1723e+01_r8,2.1344e+01_r8,2.1061e+01_r8/) + kbo(:,27,10) = (/ & + &1.9562e+01_r8,1.9387e+01_r8,1.9087e+01_r8,1.8779e+01_r8,1.8567e+01_r8/) + kbo(:,28,10) = (/ & + &1.7147e+01_r8,1.6935e+01_r8,1.6668e+01_r8,1.6479e+01_r8,1.6263e+01_r8/) + kbo(:,29,10) = (/ & + &1.4781e+01_r8,1.4573e+01_r8,1.4404e+01_r8,1.4242e+01_r8,1.4093e+01_r8/) + kbo(:,30,10) = (/ & + &1.2615e+01_r8,1.2471e+01_r8,1.2325e+01_r8,1.2193e+01_r8,1.2047e+01_r8/) + kbo(:,31,10) = (/ & + &1.0637e+01_r8,1.0540e+01_r8,1.0405e+01_r8,1.0303e+01_r8,1.0219e+01_r8/) + kbo(:,32,10) = (/ & + &8.9113e+00_r8,8.8364e+00_r8,8.7502e+00_r8,8.6801e+00_r8,8.6141e+00_r8/) + kbo(:,33,10) = (/ & + &7.4220e+00_r8,7.3714e+00_r8,7.3296e+00_r8,7.2916e+00_r8,7.2335e+00_r8/) + kbo(:,34,10) = (/ & + &6.2166e+00_r8,6.1844e+00_r8,6.1565e+00_r8,6.1097e+00_r8,6.0839e+00_r8/) + kbo(:,35,10) = (/ & + &5.1978e+00_r8,5.1804e+00_r8,5.1597e+00_r8,5.1357e+00_r8,5.1182e+00_r8/) + kbo(:,36,10) = (/ & + &4.3470e+00_r8,4.3385e+00_r8,4.3233e+00_r8,4.3177e+00_r8,4.3104e+00_r8/) + kbo(:,37,10) = (/ & + &3.6398e+00_r8,3.6424e+00_r8,3.6345e+00_r8,3.6386e+00_r8,3.6334e+00_r8/) + kbo(:,38,10) = (/ & + &3.0434e+00_r8,3.0512e+00_r8,3.0559e+00_r8,3.0639e+00_r8,3.0639e+00_r8/) + kbo(:,39,10) = (/ & + &2.5458e+00_r8,2.5538e+00_r8,2.5569e+00_r8,2.5728e+00_r8,2.5769e+00_r8/) + kbo(:,40,10) = (/ & + &2.1317e+00_r8,2.1438e+00_r8,2.1539e+00_r8,2.1706e+00_r8,2.1835e+00_r8/) + kbo(:,41,10) = (/ & + &1.7848e+00_r8,1.8052e+00_r8,1.8158e+00_r8,1.8336e+00_r8,1.8470e+00_r8/) + kbo(:,42,10) = (/ & + &1.4932e+00_r8,1.5091e+00_r8,1.5289e+00_r8,1.5466e+00_r8,1.5621e+00_r8/) + kbo(:,43,10) = (/ & + &1.2466e+00_r8,1.2672e+00_r8,1.2843e+00_r8,1.3063e+00_r8,1.3216e+00_r8/) + kbo(:,44,10) = (/ & + &1.0395e+00_r8,1.0592e+00_r8,1.0758e+00_r8,1.0990e+00_r8,1.1149e+00_r8/) + kbo(:,45,10) = (/ & + &8.6570e-01_r8,8.8331e-01_r8,9.0051e-01_r8,9.1956e-01_r8,9.3855e-01_r8/) + kbo(:,46,10) = (/ & + &7.2006e-01_r8,7.3467e-01_r8,7.5104e-01_r8,7.6845e-01_r8,7.8787e-01_r8/) + kbo(:,47,10) = (/ & + &5.9818e-01_r8,6.0970e-01_r8,6.2444e-01_r8,6.4248e-01_r8,6.5898e-01_r8/) + kbo(:,48,10) = (/ & + &4.9441e-01_r8,5.0661e-01_r8,5.1925e-01_r8,5.3379e-01_r8,5.5029e-01_r8/) + kbo(:,49,10) = (/ & + &4.0883e-01_r8,4.1946e-01_r8,4.3019e-01_r8,4.4310e-01_r8,4.5870e-01_r8/) + kbo(:,50,10) = (/ & + &3.3724e-01_r8,3.4698e-01_r8,3.5791e-01_r8,3.6811e-01_r8,3.8262e-01_r8/) + kbo(:,51,10) = (/ & + &2.7937e-01_r8,2.8820e-01_r8,2.9748e-01_r8,3.0671e-01_r8,3.1956e-01_r8/) + kbo(:,52,10) = (/ & + &2.3100e-01_r8,2.3806e-01_r8,2.4610e-01_r8,2.5504e-01_r8,2.6621e-01_r8/) + kbo(:,53,10) = (/ & + &1.9108e-01_r8,1.9654e-01_r8,2.0325e-01_r8,2.1194e-01_r8,2.2154e-01_r8/) + kbo(:,54,10) = (/ & + &1.5899e-01_r8,1.6347e-01_r8,1.6947e-01_r8,1.7655e-01_r8,1.8610e-01_r8/) + kbo(:,55,10) = (/ & + &1.3326e-01_r8,1.3696e-01_r8,1.4221e-01_r8,1.4834e-01_r8,1.5647e-01_r8/) + kbo(:,56,10) = (/ & + &1.1049e-01_r8,1.1469e-01_r8,1.1935e-01_r8,1.2428e-01_r8,1.3176e-01_r8/) + kbo(:,57,10) = (/ & + &9.2761e-02_r8,9.6003e-02_r8,9.9705e-02_r8,1.0515e-01_r8,1.1098e-01_r8/) + kbo(:,58,10) = (/ & + &7.7951e-02_r8,8.0603e-02_r8,8.4255e-02_r8,8.8708e-02_r8,9.3824e-02_r8/) + kbo(:,59,10) = (/ & + &6.6831e-02_r8,6.9853e-02_r8,7.3196e-02_r8,7.7714e-02_r8,8.2447e-02_r8/) + kbo(:,13,11) = (/ & + &2.9044e+02_r8,2.9107e+02_r8,2.9274e+02_r8,2.9324e+02_r8,2.9124e+02_r8/) + kbo(:,14,11) = (/ & + &2.7118e+02_r8,2.7257e+02_r8,2.7251e+02_r8,2.7007e+02_r8,2.6710e+02_r8/) + kbo(:,15,11) = (/ & + &2.5062e+02_r8,2.5131e+02_r8,2.4974e+02_r8,2.4698e+02_r8,2.4378e+02_r8/) + kbo(:,16,11) = (/ & + &2.2673e+02_r8,2.2541e+02_r8,2.2341e+02_r8,2.2106e+02_r8,2.1873e+02_r8/) + kbo(:,17,11) = (/ & + &1.9976e+02_r8,1.9861e+02_r8,1.9716e+02_r8,1.9539e+02_r8,1.9362e+02_r8/) + kbo(:,18,11) = (/ & + &1.7313e+02_r8,1.7242e+02_r8,1.7179e+02_r8,1.7065e+02_r8,1.6917e+02_r8/) + kbo(:,19,11) = (/ & + &1.5014e+02_r8,1.4982e+02_r8,1.4894e+02_r8,1.4750e+02_r8,1.4584e+02_r8/) + kbo(:,20,11) = (/ & + &1.2916e+02_r8,1.2859e+02_r8,1.2771e+02_r8,1.2637e+02_r8,1.2459e+02_r8/) + kbo(:,21,11) = (/ & + &1.0806e+02_r8,1.0775e+02_r8,1.0718e+02_r8,1.0610e+02_r8,1.0475e+02_r8/) + kbo(:,22,11) = (/ & + &8.9165e+01_r8,8.9073e+01_r8,8.8652e+01_r8,8.7815e+01_r8,8.6979e+01_r8/) + kbo(:,23,11) = (/ & + &7.2556e+01_r8,7.2172e+01_r8,7.1575e+01_r8,7.1058e+01_r8,7.0305e+01_r8/) + kbo(:,24,11) = (/ & + &5.8830e+01_r8,5.8306e+01_r8,5.7758e+01_r8,5.7080e+01_r8,5.6291e+01_r8/) + kbo(:,25,11) = (/ & + &4.9821e+01_r8,4.9499e+01_r8,4.8965e+01_r8,4.8414e+01_r8,4.7810e+01_r8/) + kbo(:,26,11) = (/ & + &4.2622e+01_r8,4.2267e+01_r8,4.1876e+01_r8,4.1470e+01_r8,4.0806e+01_r8/) + kbo(:,27,11) = (/ & + &3.6706e+01_r8,3.6324e+01_r8,3.5968e+01_r8,3.5540e+01_r8,3.5058e+01_r8/) + kbo(:,28,11) = (/ & + &3.1978e+01_r8,3.1566e+01_r8,3.1237e+01_r8,3.0772e+01_r8,3.0454e+01_r8/) + kbo(:,29,11) = (/ & + &2.7828e+01_r8,2.7575e+01_r8,2.7171e+01_r8,2.6860e+01_r8,2.6508e+01_r8/) + kbo(:,30,11) = (/ & + &2.4147e+01_r8,2.3835e+01_r8,2.3571e+01_r8,2.3332e+01_r8,2.3114e+01_r8/) + kbo(:,31,11) = (/ & + &2.0703e+01_r8,2.0408e+01_r8,2.0254e+01_r8,2.0067e+01_r8,1.9883e+01_r8/) + kbo(:,32,11) = (/ & + &1.7639e+01_r8,1.7476e+01_r8,1.7324e+01_r8,1.7159e+01_r8,1.7076e+01_r8/) + kbo(:,33,11) = (/ & + &1.4975e+01_r8,1.4865e+01_r8,1.4744e+01_r8,1.4668e+01_r8,1.4624e+01_r8/) + kbo(:,34,11) = (/ & + &1.2711e+01_r8,1.2631e+01_r8,1.2589e+01_r8,1.2550e+01_r8,1.2508e+01_r8/) + kbo(:,35,11) = (/ & + &1.0751e+01_r8,1.0723e+01_r8,1.0704e+01_r8,1.0702e+01_r8,1.0681e+01_r8/) + kbo(:,36,11) = (/ & + &9.0814e+00_r8,9.0752e+00_r8,9.0908e+00_r8,9.1081e+00_r8,9.1217e+00_r8/) + kbo(:,37,11) = (/ & + &7.6820e+00_r8,7.7040e+00_r8,7.7379e+00_r8,7.7515e+00_r8,7.7864e+00_r8/) + kbo(:,38,11) = (/ & + &6.4923e+00_r8,6.5176e+00_r8,6.5490e+00_r8,6.5779e+00_r8,6.6281e+00_r8/) + kbo(:,39,11) = (/ & + &5.4567e+00_r8,5.4975e+00_r8,5.5468e+00_r8,5.5843e+00_r8,5.6396e+00_r8/) + kbo(:,40,11) = (/ & + &4.6201e+00_r8,4.6597e+00_r8,4.7074e+00_r8,4.7531e+00_r8,4.8054e+00_r8/) + kbo(:,41,11) = (/ & + &3.8974e+00_r8,3.9399e+00_r8,3.9967e+00_r8,4.0418e+00_r8,4.1011e+00_r8/) + kbo(:,42,11) = (/ & + &3.2907e+00_r8,3.3361e+00_r8,3.3839e+00_r8,3.4382e+00_r8,3.4997e+00_r8/) + kbo(:,43,11) = (/ & + &2.7732e+00_r8,2.8146e+00_r8,2.8677e+00_r8,2.9201e+00_r8,2.9866e+00_r8/) + kbo(:,44,11) = (/ & + &2.3284e+00_r8,2.3728e+00_r8,2.4251e+00_r8,2.4785e+00_r8,2.5440e+00_r8/) + kbo(:,45,11) = (/ & + &1.9528e+00_r8,1.9951e+00_r8,2.0498e+00_r8,2.1003e+00_r8,2.1644e+00_r8/) + kbo(:,46,11) = (/ & + &1.6318e+00_r8,1.6755e+00_r8,1.7227e+00_r8,1.7737e+00_r8,1.8354e+00_r8/) + kbo(:,47,11) = (/ & + &1.3599e+00_r8,1.4032e+00_r8,1.4486e+00_r8,1.4978e+00_r8,1.5556e+00_r8/) + kbo(:,48,11) = (/ & + &1.1311e+00_r8,1.1685e+00_r8,1.2136e+00_r8,1.2615e+00_r8,1.3144e+00_r8/) + kbo(:,49,11) = (/ & + &9.3555e-01_r8,9.7341e-01_r8,1.0126e+00_r8,1.0587e+00_r8,1.1063e+00_r8/) + kbo(:,50,11) = (/ & + &7.7693e-01_r8,8.0966e-01_r8,8.4684e-01_r8,8.9020e-01_r8,9.3317e-01_r8/) + kbo(:,51,11) = (/ & + &6.4536e-01_r8,6.7488e-01_r8,7.0604e-01_r8,7.4875e-01_r8,7.8723e-01_r8/) + kbo(:,52,11) = (/ & + &5.3457e-01_r8,5.5971e-01_r8,5.9092e-01_r8,6.2609e-01_r8,6.6312e-01_r8/) + kbo(:,53,11) = (/ & + &4.4222e-01_r8,4.6435e-01_r8,4.9056e-01_r8,5.2208e-01_r8,5.5614e-01_r8/) + kbo(:,54,11) = (/ & + &3.6743e-01_r8,3.8638e-01_r8,4.1127e-01_r8,4.3844e-01_r8,4.6892e-01_r8/) + kbo(:,55,11) = (/ & + &3.0658e-01_r8,3.2360e-01_r8,3.4391e-01_r8,3.6924e-01_r8,3.9670e-01_r8/) + kbo(:,56,11) = (/ & + &2.5551e-01_r8,2.6954e-01_r8,2.8819e-01_r8,3.1080e-01_r8,3.3508e-01_r8/) + kbo(:,57,11) = (/ & + &2.1322e-01_r8,2.2632e-01_r8,2.4139e-01_r8,2.5957e-01_r8,2.8310e-01_r8/) + kbo(:,58,11) = (/ & + &1.7898e-01_r8,1.8948e-01_r8,2.0228e-01_r8,2.1870e-01_r8,2.4000e-01_r8/) + kbo(:,59,11) = (/ & + &1.5351e-01_r8,1.6320e-01_r8,1.7439e-01_r8,1.8953e-01_r8,2.0982e-01_r8/) + kbo(:,13,12) = (/ & + &5.5035e+02_r8,5.5083e+02_r8,5.4893e+02_r8,5.4549e+02_r8,5.4357e+02_r8/) + kbo(:,14,12) = (/ & + &5.1666e+02_r8,5.1747e+02_r8,5.1731e+02_r8,5.1865e+02_r8,5.1926e+02_r8/) + kbo(:,15,12) = (/ & + &4.8259e+02_r8,4.8322e+02_r8,4.8500e+02_r8,4.8625e+02_r8,4.8440e+02_r8/) + kbo(:,16,12) = (/ & + &4.4814e+02_r8,4.5080e+02_r8,4.5253e+02_r8,4.5080e+02_r8,4.4664e+02_r8/) + kbo(:,17,12) = (/ & + &4.1611e+02_r8,4.1780e+02_r8,4.1594e+02_r8,4.1174e+02_r8,4.0672e+02_r8/) + kbo(:,18,12) = (/ & + &3.8097e+02_r8,3.8017e+02_r8,3.7694e+02_r8,3.7269e+02_r8,3.6847e+02_r8/) + kbo(:,19,12) = (/ & + &3.3900e+02_r8,3.3735e+02_r8,3.3499e+02_r8,3.3205e+02_r8,3.2864e+02_r8/) + kbo(:,20,12) = (/ & + &2.9644e+02_r8,2.9567e+02_r8,2.9387e+02_r8,2.9171e+02_r8,2.8914e+02_r8/) + kbo(:,21,12) = (/ & + &2.5711e+02_r8,2.5659e+02_r8,2.5545e+02_r8,2.5349e+02_r8,2.5090e+02_r8/) + kbo(:,22,12) = (/ & + &2.2227e+02_r8,2.2144e+02_r8,2.1973e+02_r8,2.1742e+02_r8,2.1472e+02_r8/) + kbo(:,23,12) = (/ & + &1.8874e+02_r8,1.8786e+02_r8,1.8655e+02_r8,1.8434e+02_r8,1.8190e+02_r8/) + kbo(:,24,12) = (/ & + &1.5708e+02_r8,1.5682e+02_r8,1.5564e+02_r8,1.5414e+02_r8,1.5250e+02_r8/) + kbo(:,25,12) = (/ & + &1.2691e+02_r8,1.2649e+02_r8,1.2582e+02_r8,1.2476e+02_r8,1.2335e+02_r8/) + kbo(:,26,12) = (/ & + &1.0261e+02_r8,1.0208e+02_r8,1.0124e+02_r8,1.0027e+02_r8,9.9263e+01_r8/) + kbo(:,27,12) = (/ & + &8.5769e+01_r8,8.4989e+01_r8,8.4207e+01_r8,8.3351e+01_r8,8.2249e+01_r8/) + kbo(:,28,12) = (/ & + &7.3314e+01_r8,7.2801e+01_r8,7.2005e+01_r8,7.1293e+01_r8,7.0277e+01_r8/) + kbo(:,29,12) = (/ & + &6.2526e+01_r8,6.2052e+01_r8,6.1497e+01_r8,6.0774e+01_r8,6.0060e+01_r8/) + kbo(:,30,12) = (/ & + &5.3636e+01_r8,5.3199e+01_r8,5.2692e+01_r8,5.1970e+01_r8,5.1392e+01_r8/) + kbo(:,31,12) = (/ & + &4.6032e+01_r8,4.5690e+01_r8,4.5122e+01_r8,4.4615e+01_r8,4.4345e+01_r8/) + kbo(:,32,12) = (/ & + &3.9736e+01_r8,3.9262e+01_r8,3.8850e+01_r8,3.8552e+01_r8,3.8247e+01_r8/) + kbo(:,33,12) = (/ & + &3.4154e+01_r8,3.3807e+01_r8,3.3534e+01_r8,3.3264e+01_r8,3.3008e+01_r8/) + kbo(:,34,12) = (/ & + &2.9451e+01_r8,2.9219e+01_r8,2.9024e+01_r8,2.8833e+01_r8,2.8685e+01_r8/) + kbo(:,35,12) = (/ & + &2.5346e+01_r8,2.5246e+01_r8,2.5119e+01_r8,2.4977e+01_r8,2.4976e+01_r8/) + kbo(:,36,12) = (/ & + &2.1817e+01_r8,2.1779e+01_r8,2.1703e+01_r8,2.1681e+01_r8,2.1750e+01_r8/) + kbo(:,37,12) = (/ & + &1.8813e+01_r8,1.8767e+01_r8,1.8799e+01_r8,1.8847e+01_r8,1.8941e+01_r8/) + kbo(:,38,12) = (/ & + &1.6125e+01_r8,1.6141e+01_r8,1.6208e+01_r8,1.6337e+01_r8,1.6455e+01_r8/) + kbo(:,39,12) = (/ & + &1.3770e+01_r8,1.3861e+01_r8,1.3953e+01_r8,1.4099e+01_r8,1.4238e+01_r8/) + kbo(:,40,12) = (/ & + &1.1787e+01_r8,1.1887e+01_r8,1.2028e+01_r8,1.2178e+01_r8,1.2352e+01_r8/) + kbo(:,41,12) = (/ & + &1.0073e+01_r8,1.0213e+01_r8,1.0351e+01_r8,1.0547e+01_r8,1.0724e+01_r8/) + kbo(:,42,12) = (/ & + &8.5925e+00_r8,8.7331e+00_r8,8.9300e+00_r8,9.0948e+00_r8,9.2833e+00_r8/) + kbo(:,43,12) = (/ & + &7.3118e+00_r8,7.4895e+00_r8,7.6577e+00_r8,7.8465e+00_r8,8.0457e+00_r8/) + kbo(:,44,12) = (/ & + &6.2222e+00_r8,6.3886e+00_r8,6.5774e+00_r8,6.7646e+00_r8,6.9710e+00_r8/) + kbo(:,45,12) = (/ & + &5.2923e+00_r8,5.4528e+00_r8,5.6365e+00_r8,5.8147e+00_r8,6.0122e+00_r8/) + kbo(:,46,12) = (/ & + &4.4844e+00_r8,4.6394e+00_r8,4.8198e+00_r8,4.9986e+00_r8,5.1861e+00_r8/) + kbo(:,47,12) = (/ & + &3.7915e+00_r8,3.9458e+00_r8,4.1119e+00_r8,4.2905e+00_r8,4.4702e+00_r8/) + kbo(:,48,12) = (/ & + &3.2031e+00_r8,3.3449e+00_r8,3.4984e+00_r8,3.6554e+00_r8,3.8276e+00_r8/) + kbo(:,49,12) = (/ & + &2.6829e+00_r8,2.8156e+00_r8,2.9666e+00_r8,3.1113e+00_r8,3.2647e+00_r8/) + kbo(:,50,12) = (/ & + &2.2570e+00_r8,2.3778e+00_r8,2.5052e+00_r8,2.6542e+00_r8,2.7988e+00_r8/) + kbo(:,51,12) = (/ & + &1.8957e+00_r8,2.0048e+00_r8,2.1275e+00_r8,2.2538e+00_r8,2.3944e+00_r8/) + kbo(:,52,12) = (/ & + &1.5859e+00_r8,1.6936e+00_r8,1.7982e+00_r8,1.9164e+00_r8,2.0433e+00_r8/) + kbo(:,53,12) = (/ & + &1.3268e+00_r8,1.4138e+00_r8,1.5132e+00_r8,1.6183e+00_r8,1.7346e+00_r8/) + kbo(:,54,12) = (/ & + &1.1132e+00_r8,1.1981e+00_r8,1.2847e+00_r8,1.3880e+00_r8,1.4926e+00_r8/) + kbo(:,55,12) = (/ & + &9.3399e-01_r8,1.0137e+00_r8,1.0949e+00_r8,1.1891e+00_r8,1.2944e+00_r8/) + kbo(:,56,12) = (/ & + &7.8822e-01_r8,8.5806e-01_r8,9.3275e-01_r8,1.0165e+00_r8,1.1194e+00_r8/) + kbo(:,57,12) = (/ & + &6.5846e-01_r8,7.2237e-01_r8,7.9487e-01_r8,8.7625e-01_r8,9.6708e-01_r8/) + kbo(:,58,12) = (/ & + &5.5082e-01_r8,6.0932e-01_r8,6.7677e-01_r8,7.5228e-01_r8,8.3907e-01_r8/) + kbo(:,59,12) = (/ & + &4.7097e-01_r8,5.2693e-01_r8,5.8955e-01_r8,6.6574e-01_r8,7.5245e-01_r8/) + kbo(:,13,13) = (/ & + &1.1006e+03_r8,1.0930e+03_r8,1.0868e+03_r8,1.0845e+03_r8,1.0783e+03_r8/) + kbo(:,14,13) = (/ & + &1.0959e+03_r8,1.0919e+03_r8,1.0910e+03_r8,1.0859e+03_r8,1.0743e+03_r8/) + kbo(:,15,13) = (/ & + &1.0739e+03_r8,1.0736e+03_r8,1.0715e+03_r8,1.0637e+03_r8,1.0554e+03_r8/) + kbo(:,16,13) = (/ & + &1.0348e+03_r8,1.0368e+03_r8,1.0336e+03_r8,1.0297e+03_r8,1.0251e+03_r8/) + kbo(:,17,13) = (/ & + &9.8104e+02_r8,9.8318e+02_r8,9.8416e+02_r8,9.8388e+02_r8,9.8177e+02_r8/) + kbo(:,18,13) = (/ & + &9.1939e+02_r8,9.2259e+02_r8,9.2492e+02_r8,9.2597e+02_r8,9.2235e+02_r8/) + kbo(:,19,13) = (/ & + &8.5744e+02_r8,8.6138e+02_r8,8.6320e+02_r8,8.6092e+02_r8,8.5380e+02_r8/) + kbo(:,20,13) = (/ & + &7.9222e+02_r8,7.9480e+02_r8,7.9309e+02_r8,7.8688e+02_r8,7.7879e+02_r8/) + kbo(:,21,13) = (/ & + &7.2352e+02_r8,7.2196e+02_r8,7.1706e+02_r8,7.1061e+02_r8,7.0329e+02_r8/) + kbo(:,22,13) = (/ & + &6.4947e+02_r8,6.4590e+02_r8,6.4130e+02_r8,6.3579e+02_r8,6.2875e+02_r8/) + kbo(:,23,13) = (/ & + &5.7230e+02_r8,5.6958e+02_r8,5.6554e+02_r8,5.6079e+02_r8,5.5572e+02_r8/) + kbo(:,24,13) = (/ & + &4.9907e+02_r8,4.9687e+02_r8,4.9379e+02_r8,4.8982e+02_r8,4.8472e+02_r8/) + kbo(:,25,13) = (/ & + &4.3090e+02_r8,4.2914e+02_r8,4.2610e+02_r8,4.2208e+02_r8,4.1721e+02_r8/) + kbo(:,26,13) = (/ & + &3.6834e+02_r8,3.6617e+02_r8,3.6313e+02_r8,3.5932e+02_r8,3.5509e+02_r8/) + kbo(:,27,13) = (/ & + &3.0815e+02_r8,3.0692e+02_r8,3.0435e+02_r8,3.0103e+02_r8,2.9773e+02_r8/) + kbo(:,28,13) = (/ & + &2.5402e+02_r8,2.5274e+02_r8,2.5083e+02_r8,2.4862e+02_r8,2.4624e+02_r8/) + kbo(:,29,13) = (/ & + &2.0985e+02_r8,2.0878e+02_r8,2.0729e+02_r8,2.0573e+02_r8,2.0375e+02_r8/) + kbo(:,30,13) = (/ & + &1.7400e+02_r8,1.7284e+02_r8,1.7160e+02_r8,1.7041e+02_r8,1.6891e+02_r8/) + kbo(:,31,13) = (/ & + &1.4590e+02_r8,1.4515e+02_r8,1.4409e+02_r8,1.4281e+02_r8,1.4174e+02_r8/) + kbo(:,32,13) = (/ & + &1.2352e+02_r8,1.2281e+02_r8,1.2185e+02_r8,1.2095e+02_r8,1.2000e+02_r8/) + kbo(:,33,13) = (/ & + &1.0504e+02_r8,1.0445e+02_r8,1.0374e+02_r8,1.0318e+02_r8,1.0254e+02_r8/) + kbo(:,34,13) = (/ & + &8.9914e+01_r8,8.9264e+01_r8,8.8774e+01_r8,8.8232e+01_r8,8.7968e+01_r8/) + kbo(:,35,13) = (/ & + &7.7137e+01_r8,7.6673e+01_r8,7.6351e+01_r8,7.5989e+01_r8,7.5812e+01_r8/) + kbo(:,36,13) = (/ & + &6.6630e+01_r8,6.6370e+01_r8,6.6000e+01_r8,6.5870e+01_r8,6.5834e+01_r8/) + kbo(:,37,13) = (/ & + &5.7835e+01_r8,5.7711e+01_r8,5.7500e+01_r8,5.7478e+01_r8,5.7625e+01_r8/) + kbo(:,38,13) = (/ & + &5.0326e+01_r8,5.0239e+01_r8,5.0196e+01_r8,5.0287e+01_r8,5.0433e+01_r8/) + kbo(:,39,13) = (/ & + &4.3783e+01_r8,4.3749e+01_r8,4.3859e+01_r8,4.3984e+01_r8,4.4262e+01_r8/) + kbo(:,40,13) = (/ & + &3.8311e+01_r8,3.8366e+01_r8,3.8494e+01_r8,3.8770e+01_r8,3.9082e+01_r8/) + kbo(:,41,13) = (/ & + &3.3505e+01_r8,3.3696e+01_r8,3.3809e+01_r8,3.4139e+01_r8,3.4534e+01_r8/) + kbo(:,42,13) = (/ & + &2.9251e+01_r8,2.9507e+01_r8,2.9744e+01_r8,3.0106e+01_r8,3.0543e+01_r8/) + kbo(:,43,13) = (/ & + &2.5517e+01_r8,2.5852e+01_r8,2.6152e+01_r8,2.6566e+01_r8,2.7067e+01_r8/) + kbo(:,44,13) = (/ & + &2.2216e+01_r8,2.2648e+01_r8,2.3006e+01_r8,2.3424e+01_r8,2.3903e+01_r8/) + kbo(:,45,13) = (/ & + &1.9313e+01_r8,1.9753e+01_r8,2.0163e+01_r8,2.0601e+01_r8,2.1122e+01_r8/) + kbo(:,46,13) = (/ & + &1.6765e+01_r8,1.7207e+01_r8,1.7660e+01_r8,1.8173e+01_r8,1.8710e+01_r8/) + kbo(:,47,13) = (/ & + &1.4512e+01_r8,1.4984e+01_r8,1.5402e+01_r8,1.5957e+01_r8,1.6479e+01_r8/) + kbo(:,48,13) = (/ & + &1.2486e+01_r8,1.2967e+01_r8,1.3459e+01_r8,1.3983e+01_r8,1.4524e+01_r8/) + kbo(:,49,13) = (/ & + &1.0733e+01_r8,1.1206e+01_r8,1.1665e+01_r8,1.2207e+01_r8,1.2773e+01_r8/) + kbo(:,50,13) = (/ & + &9.2157e+00_r8,9.6749e+00_r8,1.0151e+01_r8,1.0704e+01_r8,1.1247e+01_r8/) + kbo(:,51,13) = (/ & + &7.9591e+00_r8,8.3907e+00_r8,8.8535e+00_r8,9.3811e+00_r8,9.9247e+00_r8/) + kbo(:,52,13) = (/ & + &6.8068e+00_r8,7.2371e+00_r8,7.6934e+00_r8,8.2063e+00_r8,8.7553e+00_r8/) + kbo(:,53,13) = (/ & + &5.7967e+00_r8,6.2085e+00_r8,6.6421e+00_r8,7.1263e+00_r8,7.6815e+00_r8/) + kbo(:,54,13) = (/ & + &4.9653e+00_r8,5.3639e+00_r8,5.8069e+00_r8,6.2889e+00_r8,6.8002e+00_r8/) + kbo(:,55,13) = (/ & + &4.2889e+00_r8,4.6915e+00_r8,5.1242e+00_r8,5.6024e+00_r8,6.0981e+00_r8/) + kbo(:,56,13) = (/ & + &3.6900e+00_r8,4.0833e+00_r8,4.5086e+00_r8,4.9809e+00_r8,5.4831e+00_r8/) + kbo(:,57,13) = (/ & + &3.1898e+00_r8,3.5703e+00_r8,3.9801e+00_r8,4.4470e+00_r8,4.9431e+00_r8/) + kbo(:,58,13) = (/ & + &2.7316e+00_r8,3.0989e+00_r8,3.5187e+00_r8,3.9710e+00_r8,4.4675e+00_r8/) + kbo(:,59,13) = (/ & + &2.4661e+00_r8,2.8142e+00_r8,3.2518e+00_r8,3.7206e+00_r8,4.2604e+00_r8/) + kbo(:,13,14) = (/ & + &2.3516e+03_r8,2.3425e+03_r8,2.3393e+03_r8,2.3344e+03_r8,2.3274e+03_r8/) + kbo(:,14,14) = (/ & + &2.4560e+03_r8,2.4460e+03_r8,2.4416e+03_r8,2.4361e+03_r8,2.4328e+03_r8/) + kbo(:,15,14) = (/ & + &2.5504e+03_r8,2.5434e+03_r8,2.5388e+03_r8,2.5327e+03_r8,2.5248e+03_r8/) + kbo(:,16,14) = (/ & + &2.6346e+03_r8,2.6312e+03_r8,2.6203e+03_r8,2.6088e+03_r8,2.5971e+03_r8/) + kbo(:,17,14) = (/ & + &2.7008e+03_r8,2.6935e+03_r8,2.6794e+03_r8,2.6636e+03_r8,2.6477e+03_r8/) + kbo(:,18,14) = (/ & + &2.7305e+03_r8,2.7239e+03_r8,2.7111e+03_r8,2.6981e+03_r8,2.6813e+03_r8/) + kbo(:,19,14) = (/ & + &2.7180e+03_r8,2.7110e+03_r8,2.7049e+03_r8,2.6968e+03_r8,2.6814e+03_r8/) + kbo(:,20,14) = (/ & + &2.6672e+03_r8,2.6665e+03_r8,2.6675e+03_r8,2.6606e+03_r8,2.6429e+03_r8/) + kbo(:,21,14) = (/ & + &2.5815e+03_r8,2.5893e+03_r8,2.5905e+03_r8,2.5819e+03_r8,2.5661e+03_r8/) + kbo(:,22,14) = (/ & + &2.4673e+03_r8,2.4773e+03_r8,2.4773e+03_r8,2.4699e+03_r8,2.4562e+03_r8/) + kbo(:,23,14) = (/ & + &2.3326e+03_r8,2.3404e+03_r8,2.3409e+03_r8,2.3341e+03_r8,2.3220e+03_r8/) + kbo(:,24,14) = (/ & + &2.1770e+03_r8,2.1831e+03_r8,2.1839e+03_r8,2.1779e+03_r8,2.1650e+03_r8/) + kbo(:,25,14) = (/ & + &2.0113e+03_r8,2.0166e+03_r8,2.0154e+03_r8,2.0063e+03_r8,1.9910e+03_r8/) + kbo(:,26,14) = (/ & + &1.8365e+03_r8,1.8415e+03_r8,1.8363e+03_r8,1.8253e+03_r8,1.8117e+03_r8/) + kbo(:,27,14) = (/ & + &1.6595e+03_r8,1.6581e+03_r8,1.6515e+03_r8,1.6428e+03_r8,1.6322e+03_r8/) + kbo(:,28,14) = (/ & + &1.4809e+03_r8,1.4771e+03_r8,1.4724e+03_r8,1.4658e+03_r8,1.4569e+03_r8/) + kbo(:,29,14) = (/ & + &1.3089e+03_r8,1.3068e+03_r8,1.3044e+03_r8,1.2991e+03_r8,1.2930e+03_r8/) + kbo(:,30,14) = (/ & + &1.1460e+03_r8,1.1478e+03_r8,1.1472e+03_r8,1.1450e+03_r8,1.1415e+03_r8/) + kbo(:,31,14) = (/ & + &9.9693e+02_r8,1.0002e+03_r8,1.0008e+03_r8,1.0017e+03_r8,1.0008e+03_r8/) + kbo(:,32,14) = (/ & + &8.6070e+02_r8,8.6544e+02_r8,8.6833e+02_r8,8.7044e+02_r8,8.7331e+02_r8/) + kbo(:,33,14) = (/ & + &7.4260e+02_r8,7.4642e+02_r8,7.5058e+02_r8,7.5528e+02_r8,7.5991e+02_r8/) + kbo(:,34,14) = (/ & + &6.3829e+02_r8,6.4348e+02_r8,6.4940e+02_r8,6.5551e+02_r8,6.6078e+02_r8/) + kbo(:,35,14) = (/ & + &5.4846e+02_r8,5.5540e+02_r8,5.6285e+02_r8,5.6932e+02_r8,5.7603e+02_r8/) + kbo(:,36,14) = (/ & + &4.7198e+02_r8,4.7993e+02_r8,4.8784e+02_r8,4.9478e+02_r8,5.0307e+02_r8/) + kbo(:,37,14) = (/ & + &4.0498e+02_r8,4.1318e+02_r8,4.2147e+02_r8,4.2948e+02_r8,4.3820e+02_r8/) + kbo(:,38,14) = (/ & + &3.4831e+02_r8,3.5680e+02_r8,3.6471e+02_r8,3.7305e+02_r8,3.8282e+02_r8/) + kbo(:,39,14) = (/ & + &3.0154e+02_r8,3.0929e+02_r8,3.1734e+02_r8,3.2632e+02_r8,3.3596e+02_r8/) + kbo(:,40,14) = (/ & + &2.6084e+02_r8,2.6836e+02_r8,2.7578e+02_r8,2.8455e+02_r8,2.9457e+02_r8/) + kbo(:,41,14) = (/ & + &2.2737e+02_r8,2.3379e+02_r8,2.4131e+02_r8,2.4917e+02_r8,2.5928e+02_r8/) + kbo(:,42,14) = (/ & + &1.9807e+02_r8,2.0493e+02_r8,2.1238e+02_r8,2.2005e+02_r8,2.2904e+02_r8/) + kbo(:,43,14) = (/ & + &1.7261e+02_r8,1.7936e+02_r8,1.8667e+02_r8,1.9473e+02_r8,2.0355e+02_r8/) + kbo(:,44,14) = (/ & + &1.5104e+02_r8,1.5759e+02_r8,1.6444e+02_r8,1.7229e+02_r8,1.8143e+02_r8/) + kbo(:,45,14) = (/ & + &1.3320e+02_r8,1.3908e+02_r8,1.4536e+02_r8,1.5288e+02_r8,1.6210e+02_r8/) + kbo(:,46,14) = (/ & + &1.1788e+02_r8,1.2339e+02_r8,1.2957e+02_r8,1.3630e+02_r8,1.4477e+02_r8/) + kbo(:,47,14) = (/ & + &1.0441e+02_r8,1.0994e+02_r8,1.1542e+02_r8,1.2186e+02_r8,1.2998e+02_r8/) + kbo(:,48,14) = (/ & + &9.2989e+01_r8,9.8393e+01_r8,1.0367e+02_r8,1.0970e+02_r8,1.1684e+02_r8/) + kbo(:,49,14) = (/ & + &8.3245e+01_r8,8.8109e+01_r8,9.3736e+01_r8,9.8882e+01_r8,1.0570e+02_r8/) + kbo(:,50,14) = (/ & + &7.4420e+01_r8,7.9603e+01_r8,8.4592e+01_r8,9.0187e+01_r8,9.6226e+01_r8/) + kbo(:,51,14) = (/ & + &6.6553e+01_r8,7.2000e+01_r8,7.7144e+01_r8,8.2193e+01_r8,8.8503e+01_r8/) + kbo(:,52,14) = (/ & + &5.9519e+01_r8,6.4793e+01_r8,7.0321e+01_r8,7.5806e+01_r8,8.1580e+01_r8/) + kbo(:,53,14) = (/ & + &5.3233e+01_r8,5.8402e+01_r8,6.4217e+01_r8,6.9900e+01_r8,7.5580e+01_r8/) + kbo(:,54,14) = (/ & + &4.7589e+01_r8,5.2923e+01_r8,5.8451e+01_r8,6.4196e+01_r8,7.0322e+01_r8/) + kbo(:,55,14) = (/ & + &4.2742e+01_r8,4.7820e+01_r8,5.3445e+01_r8,5.9447e+01_r8,6.5405e+01_r8/) + kbo(:,56,14) = (/ & + &3.8175e+01_r8,4.3483e+01_r8,4.9069e+01_r8,5.5046e+01_r8,6.1266e+01_r8/) + kbo(:,57,14) = (/ & + &3.4510e+01_r8,3.9326e+01_r8,4.4806e+01_r8,5.1166e+01_r8,5.7169e+01_r8/) + kbo(:,58,14) = (/ & + &3.1419e+01_r8,3.6120e+01_r8,4.1281e+01_r8,4.7436e+01_r8,5.4030e+01_r8/) + kbo(:,59,14) = (/ & + &3.0087e+01_r8,3.4624e+01_r8,3.9514e+01_r8,4.5129e+01_r8,5.1873e+01_r8/) + kbo(:,13,15) = (/ & + &5.1911e+03_r8,5.1717e+03_r8,5.1553e+03_r8,5.1395e+03_r8,5.1397e+03_r8/) + kbo(:,14,15) = (/ & + &5.8547e+03_r8,5.8285e+03_r8,5.7963e+03_r8,5.7766e+03_r8,5.7715e+03_r8/) + kbo(:,15,15) = (/ & + &6.5298e+03_r8,6.4858e+03_r8,6.4506e+03_r8,6.4312e+03_r8,6.4243e+03_r8/) + kbo(:,16,15) = (/ & + &7.2117e+03_r8,7.1510e+03_r8,7.1189e+03_r8,7.1000e+03_r8,7.0870e+03_r8/) + kbo(:,17,15) = (/ & + &7.8953e+03_r8,7.8291e+03_r8,7.7890e+03_r8,7.7670e+03_r8,7.7489e+03_r8/) + kbo(:,18,15) = (/ & + &8.5855e+03_r8,8.5208e+03_r8,8.4668e+03_r8,8.4206e+03_r8,8.3980e+03_r8/) + kbo(:,19,15) = (/ & + &9.2674e+03_r8,9.2049e+03_r8,9.1326e+03_r8,9.0736e+03_r8,9.0525e+03_r8/) + kbo(:,20,15) = (/ & + &9.9108e+03_r8,9.8356e+03_r8,9.7636e+03_r8,9.7141e+03_r8,9.6905e+03_r8/) + kbo(:,21,15) = (/ & + &1.0486e+04_r8,1.0415e+04_r8,1.0355e+04_r8,1.0317e+04_r8,1.0287e+04_r8/) + kbo(:,22,15) = (/ & + &1.0985e+04_r8,1.0920e+04_r8,1.0875e+04_r8,1.0845e+04_r8,1.0804e+04_r8/) + kbo(:,23,15) = (/ & + &1.1398e+04_r8,1.1342e+04_r8,1.1308e+04_r8,1.1276e+04_r8,1.1234e+04_r8/) + kbo(:,24,15) = (/ & + &1.1709e+04_r8,1.1672e+04_r8,1.1645e+04_r8,1.1614e+04_r8,1.1576e+04_r8/) + kbo(:,25,15) = (/ & + &1.1914e+04_r8,1.1896e+04_r8,1.1878e+04_r8,1.1862e+04_r8,1.1837e+04_r8/) + kbo(:,26,15) = (/ & + &1.2040e+04_r8,1.2031e+04_r8,1.2029e+04_r8,1.2020e+04_r8,1.1998e+04_r8/) + kbo(:,27,15) = (/ & + &1.2071e+04_r8,1.2081e+04_r8,1.2089e+04_r8,1.2085e+04_r8,1.2069e+04_r8/) + kbo(:,28,15) = (/ & + &1.2021e+04_r8,1.2058e+04_r8,1.2068e+04_r8,1.2068e+04_r8,1.2073e+04_r8/) + kbo(:,29,15) = (/ & + &1.1886e+04_r8,1.1940e+04_r8,1.1970e+04_r8,1.1995e+04_r8,1.2017e+04_r8/) + kbo(:,30,15) = (/ & + &1.1676e+04_r8,1.1749e+04_r8,1.1808e+04_r8,1.1861e+04_r8,1.1908e+04_r8/) + kbo(:,31,15) = (/ & + &1.1416e+04_r8,1.1515e+04_r8,1.1609e+04_r8,1.1694e+04_r8,1.1764e+04_r8/) + kbo(:,32,15) = (/ & + &1.1108e+04_r8,1.1250e+04_r8,1.1385e+04_r8,1.1503e+04_r8,1.1598e+04_r8/) + kbo(:,33,15) = (/ & + &1.0773e+04_r8,1.0963e+04_r8,1.1141e+04_r8,1.1294e+04_r8,1.1425e+04_r8/) + kbo(:,34,15) = (/ & + &1.0438e+04_r8,1.0673e+04_r8,1.0885e+04_r8,1.1077e+04_r8,1.1249e+04_r8/) + kbo(:,35,15) = (/ & + &1.0089e+04_r8,1.0368e+04_r8,1.0621e+04_r8,1.0852e+04_r8,1.1064e+04_r8/) + kbo(:,36,15) = (/ & + &9.7201e+03_r8,1.0041e+04_r8,1.0341e+04_r8,1.0614e+04_r8,1.0861e+04_r8/) + kbo(:,37,15) = (/ & + &9.3163e+03_r8,9.6805e+03_r8,1.0024e+04_r8,1.0342e+04_r8,1.0632e+04_r8/) + kbo(:,38,15) = (/ & + &8.9272e+03_r8,9.3307e+03_r8,9.7169e+03_r8,1.0074e+04_r8,1.0402e+04_r8/) + kbo(:,39,15) = (/ & + &8.5526e+03_r8,8.9993e+03_r8,9.4206e+03_r8,9.8154e+03_r8,1.0180e+04_r8/) + kbo(:,40,15) = (/ & + &8.1494e+03_r8,8.6355e+03_r8,9.0962e+03_r8,9.5285e+03_r8,9.9305e+03_r8/) + kbo(:,41,15) = (/ & + &7.7529e+03_r8,8.2788e+03_r8,8.7766e+03_r8,9.2446e+03_r8,9.6773e+03_r8/) + kbo(:,42,15) = (/ & + &7.3760e+03_r8,7.9339e+03_r8,8.4681e+03_r8,8.9681e+03_r8,9.4340e+03_r8/) + kbo(:,43,15) = (/ & + &6.9819e+03_r8,7.5721e+03_r8,8.1409e+03_r8,8.6746e+03_r8,9.1691e+03_r8/) + kbo(:,44,15) = (/ & + &6.5827e+03_r8,7.2081e+03_r8,7.8084e+03_r8,8.3740e+03_r8,8.8982e+03_r8/) + kbo(:,45,15) = (/ & + &6.1901e+03_r8,6.8485e+03_r8,7.4795e+03_r8,8.0786e+03_r8,8.6303e+03_r8/) + kbo(:,46,15) = (/ & + &5.8024e+03_r8,6.4801e+03_r8,7.1413e+03_r8,7.7702e+03_r8,8.3548e+03_r8/) + kbo(:,47,15) = (/ & + &5.3938e+03_r8,6.0870e+03_r8,6.7778e+03_r8,7.4341e+03_r8,8.0495e+03_r8/) + kbo(:,48,15) = (/ & + &5.0092e+03_r8,5.7052e+03_r8,6.4111e+03_r8,7.0962e+03_r8,7.7409e+03_r8/) + kbo(:,49,15) = (/ & + &4.6045e+03_r8,5.3446e+03_r8,6.0469e+03_r8,6.7562e+03_r8,7.4302e+03_r8/) + kbo(:,50,15) = (/ & + &4.2414e+03_r8,4.9940e+03_r8,5.7177e+03_r8,6.4318e+03_r8,7.1308e+03_r8/) + kbo(:,51,15) = (/ & + &3.9058e+03_r8,4.6435e+03_r8,5.4144e+03_r8,6.1320e+03_r8,6.8340e+03_r8/) + kbo(:,52,15) = (/ & + &3.5828e+03_r8,4.3242e+03_r8,5.0835e+03_r8,5.8308e+03_r8,6.5455e+03_r8/) + kbo(:,53,15) = (/ & + &3.2733e+03_r8,3.9950e+03_r8,4.7590e+03_r8,5.5300e+03_r8,6.2613e+03_r8/) + kbo(:,54,15) = (/ & + &2.9973e+03_r8,3.7033e+03_r8,4.4798e+03_r8,5.2468e+03_r8,6.0054e+03_r8/) + kbo(:,55,15) = (/ & + &2.7347e+03_r8,3.4529e+03_r8,4.2020e+03_r8,4.9932e+03_r8,5.7360e+03_r8/) + kbo(:,56,15) = (/ & + &2.4953e+03_r8,3.1956e+03_r8,3.9366e+03_r8,4.7176e+03_r8,5.4818e+03_r8/) + kbo(:,57,15) = (/ & + &2.2617e+03_r8,2.9413e+03_r8,3.6881e+03_r8,4.4499e+03_r8,5.2349e+03_r8/) + kbo(:,58,15) = (/ & + &2.0370e+03_r8,2.7148e+03_r8,3.4460e+03_r8,4.2224e+03_r8,4.9906e+03_r8/) + kbo(:,59,15) = (/ & + &1.9478e+03_r8,2.6130e+03_r8,3.3529e+03_r8,4.1205e+03_r8,4.8990e+03_r8/) + kbo(:,13,16) = (/ & + &1.0699e+04_r8,1.0668e+04_r8,1.0580e+04_r8,1.0493e+04_r8,1.0473e+04_r8/) + kbo(:,14,16) = (/ & + &1.2469e+04_r8,1.2443e+04_r8,1.2338e+04_r8,1.2279e+04_r8,1.2260e+04_r8/) + kbo(:,15,16) = (/ & + &1.4513e+04_r8,1.4466e+04_r8,1.4361e+04_r8,1.4360e+04_r8,1.4376e+04_r8/) + kbo(:,16,16) = (/ & + &1.6769e+04_r8,1.6706e+04_r8,1.6727e+04_r8,1.6775e+04_r8,1.6795e+04_r8/) + kbo(:,17,16) = (/ & + &1.9233e+04_r8,1.9285e+04_r8,1.9387e+04_r8,1.9445e+04_r8,1.9443e+04_r8/) + kbo(:,18,16) = (/ & + &2.2082e+04_r8,2.2141e+04_r8,2.2296e+04_r8,2.2362e+04_r8,2.2373e+04_r8/) + kbo(:,19,16) = (/ & + &2.5392e+04_r8,2.5419e+04_r8,2.5533e+04_r8,2.5623e+04_r8,2.5622e+04_r8/) + kbo(:,20,16) = (/ & + &2.9227e+04_r8,2.9228e+04_r8,2.9232e+04_r8,2.9272e+04_r8,2.9286e+04_r8/) + kbo(:,21,16) = (/ & + &3.3689e+04_r8,3.3556e+04_r8,3.3511e+04_r8,3.3436e+04_r8,3.3399e+04_r8/) + kbo(:,22,16) = (/ & + &3.8640e+04_r8,3.8494e+04_r8,3.8304e+04_r8,3.8118e+04_r8,3.8006e+04_r8/) + kbo(:,23,16) = (/ & + &4.4135e+04_r8,4.3894e+04_r8,4.3600e+04_r8,4.3191e+04_r8,4.3063e+04_r8/) + kbo(:,24,16) = (/ & + &5.0120e+04_r8,4.9723e+04_r8,4.9276e+04_r8,4.8847e+04_r8,4.8550e+04_r8/) + kbo(:,25,16) = (/ & + &5.6400e+04_r8,5.5824e+04_r8,5.5260e+04_r8,5.4753e+04_r8,5.4318e+04_r8/) + kbo(:,26,16) = (/ & + &6.2742e+04_r8,6.2101e+04_r8,6.1449e+04_r8,6.0838e+04_r8,6.0246e+04_r8/) + kbo(:,27,16) = (/ & + &6.9256e+04_r8,6.8498e+04_r8,6.7755e+04_r8,6.7035e+04_r8,6.6255e+04_r8/) + kbo(:,28,16) = (/ & + &7.5845e+04_r8,7.4890e+04_r8,7.4038e+04_r8,7.3125e+04_r8,7.2119e+04_r8/) + kbo(:,29,16) = (/ & + &8.2416e+04_r8,8.1292e+04_r8,8.0172e+04_r8,7.8988e+04_r8,7.7733e+04_r8/) + kbo(:,30,16) = (/ & + &8.8923e+04_r8,8.7524e+04_r8,8.6114e+04_r8,8.4633e+04_r8,8.3083e+04_r8/) + kbo(:,31,16) = (/ & + &9.5128e+04_r8,9.3474e+04_r8,9.1409e+04_r8,8.9609e+04_r8,8.8121e+04_r8/) + kbo(:,32,16) = (/ & + &1.0109e+05_r8,9.9056e+04_r8,9.6959e+04_r8,9.4838e+04_r8,9.2728e+04_r8/) + kbo(:,33,16) = (/ & + &1.0668e+05_r8,1.0426e+05_r8,1.0177e+05_r8,9.9309e+04_r8,9.6864e+04_r8/) + kbo(:,34,16) = (/ & + &1.1181e+05_r8,1.0901e+05_r8,1.0619e+05_r8,1.0339e+05_r8,1.0062e+05_r8/) + kbo(:,35,16) = (/ & + &1.1669e+05_r8,1.1352e+05_r8,1.1036e+05_r8,1.0724e+05_r8,1.0414e+05_r8/) + kbo(:,36,16) = (/ & + &1.2143e+05_r8,1.1741e+05_r8,1.1444e+05_r8,1.1099e+05_r8,1.0759e+05_r8/) + kbo(:,37,16) = (/ & + &1.2629e+05_r8,1.2248e+05_r8,1.1868e+05_r8,1.1492e+05_r8,1.1120e+05_r8/) + kbo(:,38,16) = (/ & + &1.3077e+05_r8,1.2669e+05_r8,1.2260e+05_r8,1.1857e+05_r8,1.1458e+05_r8/) + kbo(:,39,16) = (/ & + &1.3413e+05_r8,1.3013e+05_r8,1.2620e+05_r8,1.2191e+05_r8,1.1768e+05_r8/) + kbo(:,40,16) = (/ & + &1.3905e+05_r8,1.3448e+05_r8,1.2993e+05_r8,1.2540e+05_r8,1.2095e+05_r8/) + kbo(:,41,16) = (/ & + &1.4302e+05_r8,1.3822e+05_r8,1.3346e+05_r8,1.2873e+05_r8,1.2407e+05_r8/) + kbo(:,42,16) = (/ & + &1.4675e+05_r8,1.4173e+05_r8,1.3673e+05_r8,1.3182e+05_r8,1.2698e+05_r8/) + kbo(:,43,16) = (/ & + &1.5047e+05_r8,1.4528e+05_r8,1.4010e+05_r8,1.3500e+05_r8,1.2941e+05_r8/) + kbo(:,44,16) = (/ & + &1.5413e+05_r8,1.4878e+05_r8,1.4344e+05_r8,1.3816e+05_r8,1.3300e+05_r8/) + kbo(:,45,16) = (/ & + &1.5764e+05_r8,1.5214e+05_r8,1.4665e+05_r8,1.4055e+05_r8,1.3586e+05_r8/) + kbo(:,46,16) = (/ & + &1.6104e+05_r8,1.5546e+05_r8,1.4981e+05_r8,1.4422e+05_r8,1.3874e+05_r8/) + kbo(:,47,16) = (/ & + &1.6453e+05_r8,1.5891e+05_r8,1.5314e+05_r8,1.4742e+05_r8,1.4180e+05_r8/) + kbo(:,48,16) = (/ & + &1.6775e+05_r8,1.6219e+05_r8,1.5640e+05_r8,1.5054e+05_r8,1.4481e+05_r8/) + kbo(:,49,16) = (/ & + &1.7104e+05_r8,1.6528e+05_r8,1.5957e+05_r8,1.5363e+05_r8,1.4773e+05_r8/) + kbo(:,50,16) = (/ & + &1.7401e+05_r8,1.6818e+05_r8,1.6240e+05_r8,1.5648e+05_r8,1.5051e+05_r8/) + kbo(:,51,16) = (/ & + &1.7667e+05_r8,1.7104e+05_r8,1.6499e+05_r8,1.5912e+05_r8,1.5318e+05_r8/) + kbo(:,52,16) = (/ & + &1.7922e+05_r8,1.7356e+05_r8,1.6772e+05_r8,1.6169e+05_r8,1.5572e+05_r8/) + kbo(:,53,16) = (/ & + &1.8153e+05_r8,1.7622e+05_r8,1.7035e+05_r8,1.6422e+05_r8,1.5819e+05_r8/) + kbo(:,54,16) = (/ & + &1.8363e+05_r8,1.7848e+05_r8,1.7259e+05_r8,1.6657e+05_r8,1.6042e+05_r8/) + kbo(:,55,16) = (/ & + &1.8551e+05_r8,1.8043e+05_r8,1.7479e+05_r8,1.6867e+05_r8,1.6267e+05_r8/) + kbo(:,56,16) = (/ & + &1.8723e+05_r8,1.8233e+05_r8,1.7687e+05_r8,1.7089e+05_r8,1.6480e+05_r8/) + kbo(:,57,16) = (/ & + &1.8886e+05_r8,1.8420e+05_r8,1.7883e+05_r8,1.7299e+05_r8,1.6681e+05_r8/) + kbo(:,58,16) = (/ & + &1.9037e+05_r8,1.8581e+05_r8,1.8067e+05_r8,1.7477e+05_r8,1.6881e+05_r8/) + kbo(:,59,16) = (/ & + &1.9100e+05_r8,1.8659e+05_r8,1.8132e+05_r8,1.7562e+05_r8,1.6956e+05_r8/) + + kao_mn2(:, 1) = (/ & + & 5.12042e-08_r8, 5.51239e-08_r8, 5.93436e-08_r8, 6.38863e-08_r8, 6.87767e-08_r8, & + & 7.40415e-08_r8, 7.97093e-08_r8, 8.58110e-08_r8, 9.23797e-08_r8, 9.94513e-08_r8, & + & 1.07064e-07_r8, 1.15260e-07_r8, 1.24083e-07_r8, 1.33581e-07_r8, 1.43807e-07_r8, & + & 1.54815e-07_r8, 1.66666e-07_r8, 1.79424e-07_r8, 1.93159e-07_r8/) + kao_mn2(:, 2) = (/ & + & 2.30938e-07_r8, 2.41696e-07_r8, 2.52955e-07_r8, 2.64738e-07_r8, 2.77071e-07_r8, & + & 2.89978e-07_r8, 3.03486e-07_r8, 3.17623e-07_r8, 3.32419e-07_r8, 3.47904e-07_r8, & + & 3.64111e-07_r8, 3.81072e-07_r8, 3.98824e-07_r8, 4.17402e-07_r8, 4.36846e-07_r8, & + & 4.57196e-07_r8, 4.78494e-07_r8, 5.00784e-07_r8, 5.24112e-07_r8/) + kao_mn2(:, 3) = (/ & + & 6.70458e-07_r8, 7.04274e-07_r8, 7.39795e-07_r8, 7.77109e-07_r8, 8.16304e-07_r8, & + & 8.57476e-07_r8, 9.00724e-07_r8, 9.46154e-07_r8, 9.93876e-07_r8, 1.04400e-06_r8, & + & 1.09666e-06_r8, 1.15197e-06_r8, 1.21008e-06_r8, 1.27111e-06_r8, 1.33522e-06_r8, & + & 1.40256e-06_r8, 1.47331e-06_r8, 1.54761e-06_r8, 1.62567e-06_r8/) + kao_mn2(:, 4) = (/ & + & 1.84182e-06_r8, 1.89203e-06_r8, 1.94360e-06_r8, 1.99658e-06_r8, 2.05101e-06_r8, & + & 2.10692e-06_r8, 2.16435e-06_r8, 2.22335e-06_r8, 2.28396e-06_r8, 2.34622e-06_r8, & + & 2.41017e-06_r8, 2.47587e-06_r8, 2.54337e-06_r8, 2.61270e-06_r8, 2.68392e-06_r8, & + & 2.75708e-06_r8, 2.83224e-06_r8, 2.90944e-06_r8, 2.98875e-06_r8/) + kao_mn2(:, 5) = (/ & + & 3.41996e-06_r8, 3.32758e-06_r8, 3.23770e-06_r8, 3.15024e-06_r8, 3.06515e-06_r8, & + & 2.98235e-06_r8, 2.90180e-06_r8, 2.82341e-06_r8, 2.74715e-06_r8, 2.67294e-06_r8, & + & 2.60074e-06_r8, 2.53049e-06_r8, 2.46214e-06_r8, 2.39563e-06_r8, 2.33092e-06_r8, & + & 2.26796e-06_r8, 2.20670e-06_r8, 2.14709e-06_r8, 2.08910e-06_r8/) + kao_mn2(:, 6) = (/ & + & 3.38746e-06_r8, 3.25966e-06_r8, 3.13669e-06_r8, 3.01836e-06_r8, 2.90449e-06_r8, & + & 2.79491e-06_r8, 2.68947e-06_r8, 2.58801e-06_r8, 2.49037e-06_r8, 2.39642e-06_r8, & + & 2.30601e-06_r8, 2.21902e-06_r8, 2.13530e-06_r8, 2.05475e-06_r8, 1.97723e-06_r8, & + & 1.90264e-06_r8, 1.83086e-06_r8, 1.76179e-06_r8, 1.69532e-06_r8/) + kao_mn2(:, 7) = (/ & + & 3.17530e-06_r8, 3.07196e-06_r8, 2.97199e-06_r8, 2.87527e-06_r8, 2.78170e-06_r8, & + & 2.69118e-06_r8, 2.60360e-06_r8, 2.51887e-06_r8, 2.43690e-06_r8, 2.35759e-06_r8, & + & 2.28087e-06_r8, 2.20664e-06_r8, 2.13483e-06_r8, 2.06536e-06_r8, 1.99814e-06_r8, & + & 1.93312e-06_r8, 1.87021e-06_r8, 1.80934e-06_r8, 1.75046e-06_r8/) + kao_mn2(:, 8) = (/ & + & 2.84701e-06_r8, 2.77007e-06_r8, 2.69521e-06_r8, 2.62237e-06_r8, 2.55150e-06_r8, & + & 2.48254e-06_r8, 2.41545e-06_r8, 2.35017e-06_r8, 2.28666e-06_r8, 2.22486e-06_r8, & + & 2.16473e-06_r8, 2.10623e-06_r8, 2.04930e-06_r8, 1.99392e-06_r8, 1.94003e-06_r8, & + & 1.88760e-06_r8, 1.83659e-06_r8, 1.78695e-06_r8, 1.73866e-06_r8/) + kao_mn2(:, 9) = (/ & + & 2.79917e-06_r8, 2.73207e-06_r8, 2.66658e-06_r8, 2.60266e-06_r8, 2.54027e-06_r8, & + & 2.47937e-06_r8, 2.41994e-06_r8, 2.36192e-06_r8, 2.30530e-06_r8, 2.25004e-06_r8, & + & 2.19610e-06_r8, 2.14346e-06_r8, 2.09208e-06_r8, 2.04193e-06_r8, 1.99298e-06_r8, & + & 1.94520e-06_r8, 1.89857e-06_r8, 1.85306e-06_r8, 1.80864e-06_r8/) + kao_mn2(:,10) = (/ & + & 2.74910e-06_r8, 2.64462e-06_r8, 2.54412e-06_r8, 2.44743e-06_r8, 2.35442e-06_r8, & + & 2.26495e-06_r8, 2.17887e-06_r8, 2.09606e-06_r8, 2.01641e-06_r8, 1.93978e-06_r8, & + & 1.86606e-06_r8, 1.79514e-06_r8, 1.72692e-06_r8, 1.66129e-06_r8, 1.59815e-06_r8, & + & 1.53742e-06_r8, 1.47899e-06_r8, 1.42278e-06_r8, 1.36871e-06_r8/) + kao_mn2(:,11) = (/ & + & 2.63952e-06_r8, 2.60263e-06_r8, 2.56626e-06_r8, 2.53039e-06_r8, 2.49503e-06_r8, & + & 2.46016e-06_r8, 2.42578e-06_r8, 2.39188e-06_r8, 2.35845e-06_r8, 2.32549e-06_r8, & + & 2.29299e-06_r8, 2.26094e-06_r8, 2.22934e-06_r8, 2.19819e-06_r8, 2.16747e-06_r8, & + & 2.13717e-06_r8, 2.10731e-06_r8, 2.07786e-06_r8, 2.04882e-06_r8/) + kao_mn2(:,12) = (/ & + & 2.94106e-06_r8, 2.82819e-06_r8, 2.71966e-06_r8, 2.61528e-06_r8, 2.51492e-06_r8, & + & 2.41841e-06_r8, 2.32560e-06_r8, 2.23635e-06_r8, 2.15053e-06_r8, 2.06800e-06_r8, & + & 1.98863e-06_r8, 1.91232e-06_r8, 1.83893e-06_r8, 1.76836e-06_r8, 1.70049e-06_r8, & + & 1.63524e-06_r8, 1.57248e-06_r8, 1.51214e-06_r8, 1.45411e-06_r8/) + kao_mn2(:,13) = (/ & + & 2.94607e-06_r8, 2.87369e-06_r8, 2.80309e-06_r8, 2.73422e-06_r8, 2.66705e-06_r8, & + & 2.60152e-06_r8, 2.53760e-06_r8, 2.47526e-06_r8, 2.41445e-06_r8, 2.35513e-06_r8, & + & 2.29726e-06_r8, 2.24082e-06_r8, 2.18577e-06_r8, 2.13207e-06_r8, 2.07969e-06_r8, & + & 2.02859e-06_r8, 1.97875e-06_r8, 1.93014e-06_r8, 1.88272e-06_r8/) + kao_mn2(:,14) = (/ & + & 2.58051e-06_r8, 2.48749e-06_r8, 2.39782e-06_r8, 2.31139e-06_r8, 2.22807e-06_r8, & + & 2.14775e-06_r8, 2.07033e-06_r8, 1.99570e-06_r8, 1.92376e-06_r8, 1.85441e-06_r8, & + & 1.78756e-06_r8, 1.72313e-06_r8, 1.66101e-06_r8, 1.60114e-06_r8, 1.54342e-06_r8, & + & 1.48778e-06_r8, 1.43415e-06_r8, 1.38245e-06_r8, 1.33262e-06_r8/) + kao_mn2(:,15) = (/ & + & 3.03447e-06_r8, 2.88559e-06_r8, 2.74401e-06_r8, 2.60938e-06_r8, 2.48135e-06_r8, & + & 2.35961e-06_r8, 2.24384e-06_r8, 2.13375e-06_r8, 2.02906e-06_r8, 1.92951e-06_r8, & + & 1.83484e-06_r8, 1.74481e-06_r8, 1.65921e-06_r8, 1.57780e-06_r8, 1.50039e-06_r8, & + & 1.42677e-06_r8, 1.35677e-06_r8, 1.29020e-06_r8, 1.22690e-06_r8/) + kao_mn2(:,16) = (/ & + & 1.48655e-06_r8, 1.48283e-06_r8, 1.47913e-06_r8, 1.47543e-06_r8, 1.47174e-06_r8, & + & 1.46806e-06_r8, 1.46439e-06_r8, 1.46072e-06_r8, 1.45707e-06_r8, 1.45343e-06_r8, & + & 1.44979e-06_r8, 1.44617e-06_r8, 1.44255e-06_r8, 1.43894e-06_r8, 1.43534e-06_r8, & + & 1.43176e-06_r8, 1.42817e-06_r8, 1.42460e-06_r8, 1.42104e-06_r8/) + kbo_mn2(:, 1) = (/ & + & 5.12042e-08_r8, 5.51239e-08_r8, 5.93436e-08_r8, 6.38863e-08_r8, 6.87767e-08_r8, & + & 7.40415e-08_r8, 7.97093e-08_r8, 8.58110e-08_r8, 9.23797e-08_r8, 9.94513e-08_r8, & + & 1.07064e-07_r8, 1.15260e-07_r8, 1.24083e-07_r8, 1.33581e-07_r8, 1.43807e-07_r8, & + & 1.54815e-07_r8, 1.66666e-07_r8, 1.79424e-07_r8, 1.93159e-07_r8/) + kbo_mn2(:, 2) = (/ & + & 2.30938e-07_r8, 2.41696e-07_r8, 2.52955e-07_r8, 2.64738e-07_r8, 2.77071e-07_r8, & + & 2.89978e-07_r8, 3.03486e-07_r8, 3.17623e-07_r8, 3.32419e-07_r8, 3.47904e-07_r8, & + & 3.64111e-07_r8, 3.81072e-07_r8, 3.98824e-07_r8, 4.17402e-07_r8, 4.36846e-07_r8, & + & 4.57196e-07_r8, 4.78494e-07_r8, 5.00784e-07_r8, 5.24112e-07_r8/) + kbo_mn2(:, 3) = (/ & + & 6.70458e-07_r8, 7.04274e-07_r8, 7.39795e-07_r8, 7.77109e-07_r8, 8.16304e-07_r8, & + & 8.57476e-07_r8, 9.00724e-07_r8, 9.46154e-07_r8, 9.93876e-07_r8, 1.04400e-06_r8, & + & 1.09666e-06_r8, 1.15197e-06_r8, 1.21008e-06_r8, 1.27111e-06_r8, 1.33522e-06_r8, & + & 1.40256e-06_r8, 1.47331e-06_r8, 1.54761e-06_r8, 1.62567e-06_r8/) + kbo_mn2(:, 4) = (/ & + & 1.84182e-06_r8, 1.89203e-06_r8, 1.94360e-06_r8, 1.99658e-06_r8, 2.05101e-06_r8, & + & 2.10692e-06_r8, 2.16435e-06_r8, 2.22335e-06_r8, 2.28396e-06_r8, 2.34622e-06_r8, & + & 2.41017e-06_r8, 2.47587e-06_r8, 2.54337e-06_r8, 2.61270e-06_r8, 2.68392e-06_r8, & + & 2.75708e-06_r8, 2.83224e-06_r8, 2.90944e-06_r8, 2.98875e-06_r8/) + kbo_mn2(:, 5) = (/ & + & 3.41996e-06_r8, 3.32758e-06_r8, 3.23770e-06_r8, 3.15024e-06_r8, 3.06515e-06_r8, & + & 2.98235e-06_r8, 2.90180e-06_r8, 2.82341e-06_r8, 2.74715e-06_r8, 2.67294e-06_r8, & + & 2.60074e-06_r8, 2.53049e-06_r8, 2.46214e-06_r8, 2.39563e-06_r8, 2.33092e-06_r8, & + & 2.26796e-06_r8, 2.20670e-06_r8, 2.14709e-06_r8, 2.08910e-06_r8/) + kbo_mn2(:, 6) = (/ & + & 3.38746e-06_r8, 3.25966e-06_r8, 3.13669e-06_r8, 3.01836e-06_r8, 2.90449e-06_r8, & + & 2.79491e-06_r8, 2.68947e-06_r8, 2.58801e-06_r8, 2.49037e-06_r8, 2.39642e-06_r8, & + & 2.30601e-06_r8, 2.21902e-06_r8, 2.13530e-06_r8, 2.05475e-06_r8, 1.97723e-06_r8, & + & 1.90264e-06_r8, 1.83086e-06_r8, 1.76179e-06_r8, 1.69532e-06_r8/) + kbo_mn2(:, 7) = (/ & + & 3.17530e-06_r8, 3.07196e-06_r8, 2.97199e-06_r8, 2.87527e-06_r8, 2.78170e-06_r8, & + & 2.69118e-06_r8, 2.60360e-06_r8, 2.51887e-06_r8, 2.43690e-06_r8, 2.35759e-06_r8, & + & 2.28087e-06_r8, 2.20664e-06_r8, 2.13483e-06_r8, 2.06536e-06_r8, 1.99814e-06_r8, & + & 1.93312e-06_r8, 1.87021e-06_r8, 1.80934e-06_r8, 1.75046e-06_r8/) + kbo_mn2(:, 8) = (/ & + & 2.84701e-06_r8, 2.77007e-06_r8, 2.69521e-06_r8, 2.62237e-06_r8, 2.55150e-06_r8, & + & 2.48254e-06_r8, 2.41545e-06_r8, 2.35017e-06_r8, 2.28666e-06_r8, 2.22486e-06_r8, & + & 2.16473e-06_r8, 2.10623e-06_r8, 2.04930e-06_r8, 1.99392e-06_r8, 1.94003e-06_r8, & + & 1.88760e-06_r8, 1.83659e-06_r8, 1.78695e-06_r8, 1.73866e-06_r8/) + kbo_mn2(:, 9) = (/ & + & 2.79917e-06_r8, 2.73207e-06_r8, 2.66658e-06_r8, 2.60266e-06_r8, 2.54027e-06_r8, & + & 2.47937e-06_r8, 2.41994e-06_r8, 2.36192e-06_r8, 2.30530e-06_r8, 2.25004e-06_r8, & + & 2.19610e-06_r8, 2.14346e-06_r8, 2.09208e-06_r8, 2.04193e-06_r8, 1.99298e-06_r8, & + & 1.94520e-06_r8, 1.89857e-06_r8, 1.85306e-06_r8, 1.80864e-06_r8/) + kbo_mn2(:,10) = (/ & + & 2.74910e-06_r8, 2.64462e-06_r8, 2.54412e-06_r8, 2.44743e-06_r8, 2.35442e-06_r8, & + & 2.26495e-06_r8, 2.17887e-06_r8, 2.09606e-06_r8, 2.01641e-06_r8, 1.93978e-06_r8, & + & 1.86606e-06_r8, 1.79514e-06_r8, 1.72692e-06_r8, 1.66129e-06_r8, 1.59815e-06_r8, & + & 1.53742e-06_r8, 1.47899e-06_r8, 1.42278e-06_r8, 1.36871e-06_r8/) + kbo_mn2(:,11) = (/ & + & 2.63952e-06_r8, 2.60263e-06_r8, 2.56626e-06_r8, 2.53039e-06_r8, 2.49503e-06_r8, & + & 2.46016e-06_r8, 2.42578e-06_r8, 2.39188e-06_r8, 2.35845e-06_r8, 2.32549e-06_r8, & + & 2.29299e-06_r8, 2.26094e-06_r8, 2.22934e-06_r8, 2.19819e-06_r8, 2.16747e-06_r8, & + & 2.13717e-06_r8, 2.10731e-06_r8, 2.07786e-06_r8, 2.04882e-06_r8/) + kbo_mn2(:,12) = (/ & + & 2.94106e-06_r8, 2.82819e-06_r8, 2.71966e-06_r8, 2.61528e-06_r8, 2.51492e-06_r8, & + & 2.41841e-06_r8, 2.32560e-06_r8, 2.23635e-06_r8, 2.15053e-06_r8, 2.06800e-06_r8, & + & 1.98863e-06_r8, 1.91232e-06_r8, 1.83893e-06_r8, 1.76836e-06_r8, 1.70049e-06_r8, & + & 1.63524e-06_r8, 1.57248e-06_r8, 1.51214e-06_r8, 1.45411e-06_r8/) + kbo_mn2(:,13) = (/ & + & 2.94607e-06_r8, 2.87369e-06_r8, 2.80309e-06_r8, 2.73422e-06_r8, 2.66705e-06_r8, & + & 2.60152e-06_r8, 2.53760e-06_r8, 2.47526e-06_r8, 2.41445e-06_r8, 2.35513e-06_r8, & + & 2.29726e-06_r8, 2.24082e-06_r8, 2.18577e-06_r8, 2.13207e-06_r8, 2.07969e-06_r8, & + & 2.02859e-06_r8, 1.97875e-06_r8, 1.93014e-06_r8, 1.88272e-06_r8/) + kbo_mn2(:,14) = (/ & + & 2.58051e-06_r8, 2.48749e-06_r8, 2.39782e-06_r8, 2.31139e-06_r8, 2.22807e-06_r8, & + & 2.14775e-06_r8, 2.07033e-06_r8, 1.99570e-06_r8, 1.92376e-06_r8, 1.85441e-06_r8, & + & 1.78756e-06_r8, 1.72313e-06_r8, 1.66101e-06_r8, 1.60114e-06_r8, 1.54342e-06_r8, & + & 1.48778e-06_r8, 1.43415e-06_r8, 1.38245e-06_r8, 1.33262e-06_r8/) + kbo_mn2(:,15) = (/ & + & 3.03447e-06_r8, 2.88559e-06_r8, 2.74401e-06_r8, 2.60938e-06_r8, 2.48135e-06_r8, & + & 2.35961e-06_r8, 2.24384e-06_r8, 2.13375e-06_r8, 2.02906e-06_r8, 1.92951e-06_r8, & + & 1.83484e-06_r8, 1.74481e-06_r8, 1.65921e-06_r8, 1.57780e-06_r8, 1.50039e-06_r8, & + & 1.42677e-06_r8, 1.35677e-06_r8, 1.29020e-06_r8, 1.22690e-06_r8/) + kbo_mn2(:,16) = (/ & + & 1.48655e-06_r8, 1.48283e-06_r8, 1.47913e-06_r8, 1.47543e-06_r8, 1.47174e-06_r8, & + & 1.46806e-06_r8, 1.46439e-06_r8, 1.46072e-06_r8, 1.45707e-06_r8, 1.45343e-06_r8, & + & 1.44979e-06_r8, 1.44617e-06_r8, 1.44255e-06_r8, 1.43894e-06_r8, 1.43534e-06_r8, & + & 1.43176e-06_r8, 1.42817e-06_r8, 1.42460e-06_r8, 1.42104e-06_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &3.6742e-02_r8,1.0664e-01_r8,2.6132e-01_r8,2.7906e-01_r8,2.8151e-01_r8,2.7465e-01_r8, & + &2.8530e-01_r8,2.9123e-01_r8,3.0697e-01_r8,3.1801e-01_r8,3.2444e-01_r8,2.7746e-01_r8, & + &3.1994e-01_r8,2.9750e-01_r8,2.1226e-01_r8,1.2847e-01_r8/) + forrefo(2,:) = (/ & + &4.0450e-02_r8,1.1085e-01_r8,2.9205e-01_r8,3.1934e-01_r8,3.1739e-01_r8,3.1450e-01_r8, & + &3.2797e-01_r8,3.2223e-01_r8,3.3099e-01_r8,3.4800e-01_r8,3.4046e-01_r8,3.5700e-01_r8, & + &3.8264e-01_r8,3.6679e-01_r8,3.3481e-01_r8,3.2113e-01_r8/) + forrefo(3,:) = (/ & + &4.6952e-02_r8,1.1999e-01_r8,3.1473e-01_r8,3.7015e-01_r8,3.6913e-01_r8,3.6352e-01_r8, & + &3.7754e-01_r8,3.7402e-01_r8,3.7113e-01_r8,3.7720e-01_r8,3.8365e-01_r8,4.0876e-01_r8, & + &4.2968e-01_r8,4.4186e-01_r8,4.3468e-01_r8,4.7083e-01_r8/) + forrefo(4,:) = (/ & + &7.0645e-02_r8,1.6618e-01_r8,2.8516e-01_r8,3.1819e-01_r8,3.0131e-01_r8,2.9552e-01_r8, & + &2.8972e-01_r8,2.9348e-01_r8,2.8668e-01_r8,2.8483e-01_r8,2.8130e-01_r8,2.7757e-01_r8, & + &2.9735e-01_r8,3.1684e-01_r8,3.0681e-01_r8,3.6778e-01_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 2.16803e+00_r8, 1.98236e+00_r8, 1.81260e+00_r8, 1.65737e+00_r8, 1.51544e+00_r8, & + & 1.38567e+00_r8, 1.26700e+00_r8, 1.15850e+00_r8, 1.05929e+00_r8, 9.68576e-01_r8/) + selfrefo(:, 2) = (/ & + & 3.70149e+00_r8, 3.43145e+00_r8, 3.18110e+00_r8, 2.94902e+00_r8, 2.73387e+00_r8, & + & 2.53441e+00_r8, 2.34951e+00_r8, 2.17810e+00_r8, 2.01919e+00_r8, 1.87188e+00_r8/) + selfrefo(:, 3) = (/ & + & 6.17433e+00_r8, 5.62207e+00_r8, 5.11920e+00_r8, 4.66131e+00_r8, 4.24438e+00_r8, & + & 3.86474e+00_r8, 3.51906e+00_r8, 3.20430e+00_r8, 2.91769e+00_r8, 2.65672e+00_r8/) + selfrefo(:, 4) = (/ & + & 6.56459e+00_r8, 5.94787e+00_r8, 5.38910e+00_r8, 4.88282e+00_r8, 4.42410e+00_r8, & + & 4.00848e+00_r8, 3.63190e+00_r8, 3.29070e+00_r8, 2.98155e+00_r8, 2.70145e+00_r8/) + selfrefo(:, 5) = (/ & + & 6.49581e+00_r8, 5.91114e+00_r8, 5.37910e+00_r8, 4.89494e+00_r8, 4.45436e+00_r8, & + & 4.05344e+00_r8, 3.68860e+00_r8, 3.35660e+00_r8, 3.05448e+00_r8, 2.77956e+00_r8/) + selfrefo(:, 6) = (/ & + & 6.50189e+00_r8, 5.89381e+00_r8, 5.34260e+00_r8, 4.84294e+00_r8, 4.39001e+00_r8, & + & 3.97944e+00_r8, 3.60727e+00_r8, 3.26990e+00_r8, 2.96409e+00_r8, 2.68687e+00_r8/) + selfrefo(:, 7) = (/ & + & 6.64768e+00_r8, 6.01719e+00_r8, 5.44650e+00_r8, 4.92993e+00_r8, 4.46236e+00_r8, & + & 4.03914e+00_r8, 3.65605e+00_r8, 3.30930e+00_r8, 2.99543e+00_r8, 2.71134e+00_r8/) + selfrefo(:, 8) = (/ & + & 6.43744e+00_r8, 5.87166e+00_r8, 5.35560e+00_r8, 4.88490e+00_r8, 4.45557e+00_r8, & + & 4.06397e+00_r8, 3.70679e+00_r8, 3.38100e+00_r8, 3.08384e+00_r8, 2.81281e+00_r8/) + selfrefo(:, 9) = (/ & + & 6.55466e+00_r8, 5.99777e+00_r8, 5.48820e+00_r8, 5.02192e+00_r8, 4.59525e+00_r8, & + & 4.20484e+00_r8, 3.84759e+00_r8, 3.52070e+00_r8, 3.22158e+00_r8, 2.94787e+00_r8/) + selfrefo(:,10) = (/ & + & 6.84510e+00_r8, 6.26933e+00_r8, 5.74200e+00_r8, 5.25902e+00_r8, 4.81667e+00_r8, & + & 4.41152e+00_r8, 4.04046e+00_r8, 3.70060e+00_r8, 3.38933e+00_r8, 3.10424e+00_r8/) + selfrefo(:,11) = (/ & + & 6.83128e+00_r8, 6.25536e+00_r8, 5.72800e+00_r8, 5.24510e+00_r8, 4.80291e+00_r8, & + & 4.39799e+00_r8, 4.02722e+00_r8, 3.68770e+00_r8, 3.37681e+00_r8, 3.09212e+00_r8/) + selfrefo(:,12) = (/ & + & 7.35969e+00_r8, 6.61719e+00_r8, 5.94960e+00_r8, 5.34936e+00_r8, 4.80968e+00_r8, & + & 4.32445e+00_r8, 3.88817e+00_r8, 3.49590e+00_r8, 3.14321e+00_r8, 2.82610e+00_r8/) + selfrefo(:,13) = (/ & + & 7.50064e+00_r8, 6.80749e+00_r8, 6.17840e+00_r8, 5.60744e+00_r8, 5.08925e+00_r8, & + & 4.61894e+00_r8, 4.19210e+00_r8, 3.80470e+00_r8, 3.45310e+00_r8, 3.13399e+00_r8/) + selfrefo(:,14) = (/ & + & 7.40801e+00_r8, 6.71328e+00_r8, 6.08370e+00_r8, 5.51316e+00_r8, 4.99613e+00_r8, & + & 4.52759e+00_r8, 4.10298e+00_r8, 3.71820e+00_r8, 3.36950e+00_r8, 3.05351e+00_r8/) + selfrefo(:,15) = (/ & + & 7.51895e+00_r8, 6.68846e+00_r8, 5.94970e+00_r8, 5.29254e+00_r8, 4.70796e+00_r8, & + & 4.18795e+00_r8, 3.72538e+00_r8, 3.31390e+00_r8, 2.94787e+00_r8, 2.62227e+00_r8/) + selfrefo(:,16) = (/ & + & 7.84774e+00_r8, 6.80673e+00_r8, 5.90380e+00_r8, 5.12065e+00_r8, 4.44138e+00_r8, & + & 3.85223e+00_r8, 3.34122e+00_r8, 2.89800e+00_r8, 2.51357e+00_r8, 2.18014e+00_r8/) + + end subroutine lw_kgb01 + +! ************************************************************************** + subroutine lw_kgb02 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg02, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level: P = 1053.630 mbar, T = 294.2 K + fracrefao(:) = (/ & + 1.6388e-01_r8, 1.5241e-01_r8, 1.4290e-01_r8, 1.2864e-01_r8, & + 1.1615e-01_r8, 1.0047e-01_r8, 8.0013e-02_r8, 6.0445e-02_r8, & + 4.0530e-02_r8, 4.3879e-03_r8, 3.5726e-03_r8, 2.7669e-03_r8, & + 2.0078e-03_r8, 1.2864e-03_r8, 4.7630e-04_r8, 6.9109e-05_r8/) + +! Planck fraction mapping level: P = 3.206e-2 mb, T = 197.92 K + fracrefbo(:) = (/ & + 1.4697e-01_r8, 1.4826e-01_r8, 1.4278e-01_r8, 1.3320e-01_r8, & + 1.1965e-01_r8, 1.0297e-01_r8, 8.4170e-02_r8, 6.3282e-02_r8, & + 4.2868e-02_r8, 4.6644e-03_r8, 3.8619e-03_r8, 3.0533e-03_r8, & + 2.2359e-03_r8, 1.4226e-03_r8, 5.3642e-04_r8, 7.6316e-05_r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &4.9444e-03_r8,5.9459e-03_r8,7.0909e-03_r8,8.2082e-03_r8,9.2071e-03_r8/) + kao(:, 2, 1) = (/ & + &3.6253e-03_r8,4.3860e-03_r8,5.2541e-03_r8,6.0419e-03_r8,6.8835e-03_r8/) + kao(:, 3, 1) = (/ & + &2.5338e-03_r8,3.0985e-03_r8,3.7400e-03_r8,4.2996e-03_r8,4.9675e-03_r8/) + kao(:, 4, 1) = (/ & + &1.7755e-03_r8,2.1973e-03_r8,2.6664e-03_r8,3.1111e-03_r8,3.6091e-03_r8/) + kao(:, 5, 1) = (/ & + &1.2565e-03_r8,1.5789e-03_r8,1.9196e-03_r8,2.3096e-03_r8,2.6519e-03_r8/) + kao(:, 6, 1) = (/ & + &8.8624e-04_r8,1.1175e-03_r8,1.3818e-03_r8,1.6934e-03_r8,1.9635e-03_r8/) + kao(:, 7, 1) = (/ & + &6.2843e-04_r8,7.9253e-04_r8,1.0012e-03_r8,1.2222e-03_r8,1.4734e-03_r8/) + kao(:, 8, 1) = (/ & + &4.5023e-04_r8,5.6483e-04_r8,7.1568e-04_r8,8.9026e-04_r8,1.0929e-03_r8/) + kao(:, 9, 1) = (/ & + &3.2520e-04_r8,4.0407e-04_r8,5.1209e-04_r8,6.4949e-04_r8,7.9581e-04_r8/) + kao(:,10, 1) = (/ & + &2.4126e-04_r8,2.9581e-04_r8,3.7404e-04_r8,4.7585e-04_r8,5.9085e-04_r8/) + kao(:,11, 1) = (/ & + &1.9501e-04_r8,2.4152e-04_r8,3.0649e-04_r8,3.9104e-04_r8,4.8881e-04_r8/) + kao(:,12, 1) = (/ & + &1.5881e-04_r8,1.9763e-04_r8,2.5177e-04_r8,3.2441e-04_r8,4.0632e-04_r8/) + kao(:,13, 1) = (/ & + &1.3003e-04_r8,1.6216e-04_r8,2.0768e-04_r8,2.6864e-04_r8,3.3497e-04_r8/) + kao(:, 1, 2) = (/ & + &1.0027e-02_r8,1.1791e-02_r8,1.3932e-02_r8,1.6666e-02_r8,2.0126e-02_r8/) + kao(:, 2, 2) = (/ & + &7.4056e-03_r8,8.8285e-03_r8,1.0460e-02_r8,1.2669e-02_r8,1.5282e-02_r8/) + kao(:, 3, 2) = (/ & + &5.2661e-03_r8,6.2928e-03_r8,7.5540e-03_r8,9.2387e-03_r8,1.1182e-02_r8/) + kao(:, 4, 2) = (/ & + &3.7830e-03_r8,4.5144e-03_r8,5.4622e-03_r8,6.6869e-03_r8,8.1435e-03_r8/) + kao(:, 5, 2) = (/ & + &2.7480e-03_r8,3.3042e-03_r8,3.9726e-03_r8,4.8258e-03_r8,5.9510e-03_r8/) + kao(:, 6, 2) = (/ & + &2.0063e-03_r8,2.3984e-03_r8,2.8713e-03_r8,3.4864e-03_r8,4.3135e-03_r8/) + kao(:, 7, 2) = (/ & + &1.4846e-03_r8,1.7453e-03_r8,2.0981e-03_r8,2.5444e-03_r8,3.1056e-03_r8/) + kao(:, 8, 2) = (/ & + &1.1210e-03_r8,1.2879e-03_r8,1.5449e-03_r8,1.8524e-03_r8,2.2562e-03_r8/) + kao(:, 9, 2) = (/ & + &8.5574e-04_r8,9.6423e-04_r8,1.1336e-03_r8,1.3659e-03_r8,1.6594e-03_r8/) + kao(:,10, 2) = (/ & + &6.6848e-04_r8,7.4016e-04_r8,8.5479e-04_r8,1.0274e-03_r8,1.2343e-03_r8/) + kao(:,11, 2) = (/ & + &5.5022e-04_r8,6.0473e-04_r8,6.9963e-04_r8,8.4106e-04_r8,1.0097e-03_r8/) + kao(:,12, 2) = (/ & + &4.4972e-04_r8,4.9436e-04_r8,5.7239e-04_r8,6.8738e-04_r8,8.3038e-04_r8/) + kao(:,13, 2) = (/ & + &3.6745e-04_r8,4.0460e-04_r8,4.6828e-04_r8,5.6427e-04_r8,6.8387e-04_r8/) + kao(:, 1, 3) = (/ & + &2.0475e-02_r8,2.4886e-02_r8,2.8056e-02_r8,3.1687e-02_r8,3.6011e-02_r8/) + kao(:, 2, 3) = (/ & + &1.5293e-02_r8,1.8649e-02_r8,2.1197e-02_r8,2.4106e-02_r8,2.7485e-02_r8/) + kao(:, 3, 3) = (/ & + &1.0918e-02_r8,1.3480e-02_r8,1.5496e-02_r8,1.7769e-02_r8,2.0398e-02_r8/) + kao(:, 4, 3) = (/ & + &7.7395e-03_r8,9.6625e-03_r8,1.1379e-02_r8,1.3130e-02_r8,1.5170e-02_r8/) + kao(:, 5, 3) = (/ & + &5.4995e-03_r8,6.9063e-03_r8,8.5233e-03_r8,9.8125e-03_r8,1.1368e-02_r8/) + kao(:, 6, 3) = (/ & + &3.9002e-03_r8,4.9307e-03_r8,6.2037e-03_r8,7.3100e-03_r8,8.4689e-03_r8/) + kao(:, 7, 3) = (/ & + &2.7369e-03_r8,3.5078e-03_r8,4.4352e-03_r8,5.5098e-03_r8,6.3463e-03_r8/) + kao(:, 8, 3) = (/ & + &1.9294e-03_r8,2.5028e-03_r8,3.1751e-03_r8,4.0255e-03_r8,4.7593e-03_r8/) + kao(:, 9, 3) = (/ & + &1.2806e-03_r8,1.7659e-03_r8,2.2786e-03_r8,2.8933e-03_r8,3.6112e-03_r8/) + kao(:,10, 3) = (/ & + &8.6429e-04_r8,1.2871e-03_r8,1.6661e-03_r8,2.1207e-03_r8,2.6956e-03_r8/) + kao(:,11, 3) = (/ & + &7.0989e-04_r8,1.0555e-03_r8,1.3691e-03_r8,1.7450e-03_r8,2.2184e-03_r8/) + kao(:,12, 3) = (/ & + &5.8630e-04_r8,8.6615e-04_r8,1.1265e-03_r8,1.4357e-03_r8,1.8221e-03_r8/) + kao(:,13, 3) = (/ & + &4.8372e-04_r8,7.1031e-04_r8,9.2618e-04_r8,1.1787e-03_r8,1.4998e-03_r8/) + kao(:, 1, 4) = (/ & + &3.4150e-02_r8,4.0367e-02_r8,4.9280e-02_r8,5.9100e-02_r8,6.9499e-02_r8/) + kao(:, 2, 4) = (/ & + &2.5504e-02_r8,3.0447e-02_r8,3.7321e-02_r8,4.4944e-02_r8,5.3298e-02_r8/) + kao(:, 3, 4) = (/ & + &1.8371e-02_r8,2.2085e-02_r8,2.7226e-02_r8,3.2994e-02_r8,3.9403e-02_r8/) + kao(:, 4, 4) = (/ & + &1.3235e-02_r8,1.6046e-02_r8,1.9813e-02_r8,2.4156e-02_r8,2.9082e-02_r8/) + kao(:, 5, 4) = (/ & + &9.5998e-03_r8,1.1709e-02_r8,1.4338e-02_r8,1.7707e-02_r8,2.1505e-02_r8/) + kao(:, 6, 4) = (/ & + &6.9022e-03_r8,8.5630e-03_r8,1.0395e-02_r8,1.2869e-02_r8,1.5787e-02_r8/) + kao(:, 7, 4) = (/ & + &5.0622e-03_r8,6.1861e-03_r8,7.5642e-03_r8,9.2835e-03_r8,1.1530e-02_r8/) + kao(:, 8, 4) = (/ & + &3.7734e-03_r8,4.4956e-03_r8,5.5749e-03_r8,6.7721e-03_r8,8.4253e-03_r8/) + kao(:, 9, 4) = (/ & + &2.9619e-03_r8,3.3315e-03_r8,4.0621e-03_r8,4.9694e-03_r8,6.1117e-03_r8/) + kao(:,10, 4) = (/ & + &2.2204e-03_r8,2.5123e-03_r8,3.0176e-03_r8,3.7321e-03_r8,4.5545e-03_r8/) + kao(:,11, 4) = (/ & + &1.8288e-03_r8,2.0602e-03_r8,2.4838e-03_r8,3.0685e-03_r8,3.7508e-03_r8/) + kao(:,12, 4) = (/ & + &1.5051e-03_r8,1.6916e-03_r8,2.0466e-03_r8,2.5239e-03_r8,3.0905e-03_r8/) + kao(:,13, 4) = (/ & + &1.2373e-03_r8,1.3907e-03_r8,1.6848e-03_r8,2.0764e-03_r8,2.5455e-03_r8/) + kao(:, 1, 5) = (/ & + &7.4128e-02_r8,9.0328e-02_r8,1.0845e-01_r8,1.2842e-01_r8,1.4993e-01_r8/) + kao(:, 2, 5) = (/ & + &5.6421e-02_r8,6.8932e-02_r8,8.3294e-02_r8,9.9111e-02_r8,1.1617e-01_r8/) + kao(:, 3, 5) = (/ & + &4.0916e-02_r8,5.0385e-02_r8,6.1257e-02_r8,7.3474e-02_r8,8.6732e-02_r8/) + kao(:, 4, 5) = (/ & + &2.9430e-02_r8,3.6556e-02_r8,4.4742e-02_r8,5.4199e-02_r8,6.4580e-02_r8/) + kao(:, 5, 5) = (/ & + &2.1212e-02_r8,2.6602e-02_r8,3.2780e-02_r8,4.0084e-02_r8,4.8236e-02_r8/) + kao(:, 6, 5) = (/ & + &1.5151e-02_r8,1.9129e-02_r8,2.3897e-02_r8,2.9436e-02_r8,3.5798e-02_r8/) + kao(:, 7, 5) = (/ & + &1.0718e-02_r8,1.3802e-02_r8,1.7389e-02_r8,2.1505e-02_r8,2.6440e-02_r8/) + kao(:, 8, 5) = (/ & + &7.4917e-03_r8,9.9125e-03_r8,1.2578e-02_r8,1.5770e-02_r8,1.9483e-02_r8/) + kao(:, 9, 5) = (/ & + &5.1168e-03_r8,7.0368e-03_r8,9.1089e-03_r8,1.1527e-02_r8,1.4293e-02_r8/) + kao(:,10, 5) = (/ & + &3.6983e-03_r8,5.0627e-03_r8,6.6991e-03_r8,8.5275e-03_r8,1.0696e-02_r8/) + kao(:,11, 5) = (/ & + &3.0484e-03_r8,4.1916e-03_r8,5.5346e-03_r8,7.0513e-03_r8,8.8498e-03_r8/) + kao(:,12, 5) = (/ & + &2.5174e-03_r8,3.4714e-03_r8,4.5718e-03_r8,5.8341e-03_r8,7.3195e-03_r8/) + kao(:,13, 5) = (/ & + &2.0770e-03_r8,2.8684e-03_r8,3.7718e-03_r8,4.8192e-03_r8,6.0412e-03_r8/) + kao(:, 1, 6) = (/ & + &2.0613e-01_r8,2.5157e-01_r8,3.0178e-01_r8,3.5683e-01_r8,4.1542e-01_r8/) + kao(:, 2, 6) = (/ & + &1.5819e-01_r8,1.9432e-01_r8,2.3452e-01_r8,2.7858e-01_r8,3.2587e-01_r8/) + kao(:, 3, 6) = (/ & + &1.1531e-01_r8,1.4306e-01_r8,1.7435e-01_r8,2.0876e-01_r8,2.4632e-01_r8/) + kao(:, 4, 6) = (/ & + &8.3284e-02_r8,1.0444e-01_r8,1.2864e-01_r8,1.5560e-01_r8,1.8535e-01_r8/) + kao(:, 5, 6) = (/ & + &6.0166e-02_r8,7.6315e-02_r8,9.4937e-02_r8,1.1604e-01_r8,1.3958e-01_r8/) + kao(:, 6, 6) = (/ & + &4.3003e-02_r8,5.5230e-02_r8,6.9447e-02_r8,8.5781e-02_r8,1.0424e-01_r8/) + kao(:, 7, 6) = (/ & + &3.0490e-02_r8,3.9769e-02_r8,5.0618e-02_r8,6.3200e-02_r8,7.7597e-02_r8/) + kao(:, 8, 6) = (/ & + &2.1570e-02_r8,2.8573e-02_r8,3.6803e-02_r8,4.6437e-02_r8,5.7626e-02_r8/) + kao(:, 9, 6) = (/ & + &1.5155e-02_r8,2.0450e-02_r8,2.6673e-02_r8,3.4004e-02_r8,4.2620e-02_r8/) + kao(:,10, 6) = (/ & + &1.0852e-02_r8,1.4893e-02_r8,1.9668e-02_r8,2.5324e-02_r8,3.1992e-02_r8/) + kao(:,11, 6) = (/ & + &9.0511e-03_r8,1.2422e-02_r8,1.6374e-02_r8,2.1084e-02_r8,2.6643e-02_r8/) + kao(:,12, 6) = (/ & + &7.5332e-03_r8,1.0338e-02_r8,1.3623e-02_r8,1.7531e-02_r8,2.2174e-02_r8/) + kao(:,13, 6) = (/ & + &6.2568e-03_r8,8.5754e-03_r8,1.1313e-02_r8,1.4562e-02_r8,1.8439e-02_r8/) + kao(:, 1, 7) = (/ & + &6.4924e-01_r8,7.7307e-01_r8,9.0386e-01_r8,1.0388e+00_r8,1.1773e+00_r8/) + kao(:, 2, 7) = (/ & + &5.0577e-01_r8,6.0786e-01_r8,7.1639e-01_r8,8.2855e-01_r8,9.4493e-01_r8/) + kao(:, 3, 7) = (/ & + &3.7384e-01_r8,4.5638e-01_r8,5.4361e-01_r8,6.3563e-01_r8,7.3108e-01_r8/) + kao(:, 4, 7) = (/ & + &2.7157e-01_r8,3.3769e-01_r8,4.0798e-01_r8,4.8298e-01_r8,5.6158e-01_r8/) + kao(:, 5, 7) = (/ & + &1.9648e-01_r8,2.4838e-01_r8,3.0521e-01_r8,3.6590e-01_r8,4.3005e-01_r8/) + kao(:, 6, 7) = (/ & + &1.3966e-01_r8,1.7987e-01_r8,2.2524e-01_r8,2.7405e-01_r8,3.2593e-01_r8/) + kao(:, 7, 7) = (/ & + &9.8353e-02_r8,1.2917e-01_r8,1.6445e-01_r8,2.0365e-01_r8,2.4531e-01_r8/) + kao(:, 8, 7) = (/ & + &6.8795e-02_r8,9.2244e-02_r8,1.1951e-01_r8,1.5053e-01_r8,1.8392e-01_r8/) + kao(:, 9, 7) = (/ & + &4.7720e-02_r8,6.5374e-02_r8,8.6294e-02_r8,1.1044e-01_r8,1.3721e-01_r8/) + kao(:,10, 7) = (/ & + &3.3881e-02_r8,4.7211e-02_r8,6.3377e-02_r8,8.2294e-02_r8,1.0374e-01_r8/) + kao(:,11, 7) = (/ & + &2.8304e-02_r8,3.9386e-02_r8,5.2911e-02_r8,6.8671e-02_r8,8.6477e-02_r8/) + kao(:,12, 7) = (/ & + &2.3643e-02_r8,3.2849e-02_r8,4.4121e-02_r8,5.7246e-02_r8,7.2052e-02_r8/) + kao(:,13, 7) = (/ & + &1.9678e-02_r8,2.7339e-02_r8,3.6693e-02_r8,4.7583e-02_r8,5.9838e-02_r8/) + kao(:, 1, 8) = (/ & + &1.5852e+00_r8,1.8937e+00_r8,2.2233e+00_r8,2.5759e+00_r8,2.9447e+00_r8/) + kao(:, 2, 8) = (/ & + &1.3020e+00_r8,1.5608e+00_r8,1.8408e+00_r8,2.1415e+00_r8,2.4614e+00_r8/) + kao(:, 3, 8) = (/ & + &1.0126e+00_r8,1.2239e+00_r8,1.4553e+00_r8,1.7040e+00_r8,1.9702e+00_r8/) + kao(:, 4, 8) = (/ & + &7.6856e-01_r8,9.4025e-01_r8,1.1316e+00_r8,1.3386e+00_r8,1.5605e+00_r8/) + kao(:, 5, 8) = (/ & + &5.7616e-01_r8,7.1359e-01_r8,8.6832e-01_r8,1.0388e+00_r8,1.2228e+00_r8/) + kao(:, 6, 8) = (/ & + &4.2350e-01_r8,5.3268e-01_r8,6.5605e-01_r8,7.9334e-01_r8,9.4223e-01_r8/) + kao(:, 7, 8) = (/ & + &3.0686e-01_r8,3.9225e-01_r8,4.9010e-01_r8,5.9944e-01_r8,7.1967e-01_r8/) + kao(:, 8, 8) = (/ & + &2.2070e-01_r8,2.8688e-01_r8,3.6348e-01_r8,4.5007e-01_r8,5.4597e-01_r8/) + kao(:, 9, 8) = (/ & + &1.5750e-01_r8,2.0832e-01_r8,2.6774e-01_r8,3.3584e-01_r8,4.1169e-01_r8/) + kao(:,10, 8) = (/ & + &1.1458e-01_r8,1.5398e-01_r8,2.0047e-01_r8,2.5420e-01_r8,3.1452e-01_r8/) + kao(:,11, 8) = (/ & + &9.6352e-02_r8,1.2945e-01_r8,1.6850e-01_r8,2.1343e-01_r8,2.6418e-01_r8/) + kao(:,12, 8) = (/ & + &8.0859e-02_r8,1.0869e-01_r8,1.4142e-01_r8,1.7905e-01_r8,2.2159e-01_r8/) + kao(:,13, 8) = (/ & + &6.7685e-02_r8,9.1028e-02_r8,1.1838e-01_r8,1.4990e-01_r8,1.8559e-01_r8/) + kao(:, 1, 9) = (/ & + &5.2550e+00_r8,6.3269e+00_r8,7.5188e+00_r8,8.8046e+00_r8,1.0194e+01_r8/) + kao(:, 2, 9) = (/ & + &4.6603e+00_r8,5.6500e+00_r8,6.7441e+00_r8,7.9369e+00_r8,9.2112e+00_r8/) + kao(:, 3, 9) = (/ & + &3.9124e+00_r8,4.7902e+00_r8,5.7591e+00_r8,6.8243e+00_r8,7.9677e+00_r8/) + kao(:, 4, 9) = (/ & + &3.2096e+00_r8,3.9597e+00_r8,4.8029e+00_r8,5.7377e+00_r8,6.7626e+00_r8/) + kao(:, 5, 9) = (/ & + &2.5970e+00_r8,3.2435e+00_r8,3.9726e+00_r8,4.7826e+00_r8,5.6814e+00_r8/) + kao(:, 6, 9) = (/ & + &2.0409e+00_r8,2.5854e+00_r8,3.2065e+00_r8,3.9078e+00_r8,4.6887e+00_r8/) + kao(:, 7, 9) = (/ & + &1.5708e+00_r8,2.0187e+00_r8,2.5381e+00_r8,3.1327e+00_r8,3.8016e+00_r8/) + kao(:, 8, 9) = (/ & + &1.1892e+00_r8,1.5546e+00_r8,1.9836e+00_r8,2.4782e+00_r8,3.0361e+00_r8/) + kao(:, 9, 9) = (/ & + &8.8412e-01_r8,1.1765e+00_r8,1.5263e+00_r8,1.9325e+00_r8,2.3921e+00_r8/) + kao(:,10, 9) = (/ & + &6.6160e-01_r8,8.9598e-01_r8,1.1789e+00_r8,1.5110e+00_r8,1.8897e+00_r8/) + kao(:,11, 9) = (/ & + &5.6952e-01_r8,7.7339e-01_r8,1.0185e+00_r8,1.3041e+00_r8,1.6292e+00_r8/) + kao(:,12, 9) = (/ & + &4.8820e-01_r8,6.6319e-01_r8,8.7290e-01_r8,1.1167e+00_r8,1.3956e+00_r8/) + kao(:,13, 9) = (/ & + &4.1555e-01_r8,5.6459e-01_r8,7.4208e-01_r8,9.4959e-01_r8,1.1894e+00_r8/) + kao(:, 1,10) = (/ & + &1.2977e+01_r8,1.5399e+01_r8,1.8084e+01_r8,2.1107e+01_r8,2.4279e+01_r8/) + kao(:, 2,10) = (/ & + &1.2242e+01_r8,1.4713e+01_r8,1.7530e+01_r8,2.0660e+01_r8,2.4161e+01_r8/) + kao(:, 3,10) = (/ & + &1.0793e+01_r8,1.3120e+01_r8,1.5954e+01_r8,1.9118e+01_r8,2.2561e+01_r8/) + kao(:, 4,10) = (/ & + &9.2115e+00_r8,1.1467e+01_r8,1.4090e+01_r8,1.6870e+01_r8,1.9865e+01_r8/) + kao(:, 5,10) = (/ & + &7.7076e+00_r8,9.6964e+00_r8,1.2018e+01_r8,1.4581e+01_r8,1.7283e+01_r8/) + kao(:, 6,10) = (/ & + &6.3938e+00_r8,8.1632e+00_r8,1.0170e+01_r8,1.2328e+01_r8,1.4702e+01_r8/) + kao(:, 7,10) = (/ & + &5.2643e+00_r8,6.8431e+00_r8,8.5879e+00_r8,1.0497e+01_r8,1.2599e+01_r8/) + kao(:, 8,10) = (/ & + &4.2306e+00_r8,5.5592e+00_r8,7.0542e+00_r8,8.7515e+00_r8,1.0687e+01_r8/) + kao(:, 9,10) = (/ & + &3.3029e+00_r8,4.4196e+00_r8,5.6740e+00_r8,7.1182e+00_r8,8.8343e+00_r8/) + kao(:,10,10) = (/ & + &2.6002e+00_r8,3.5171e+00_r8,4.6049e+00_r8,5.8654e+00_r8,7.3550e+00_r8/) + kao(:,11,10) = (/ & + &2.3411e+00_r8,3.1582e+00_r8,4.1576e+00_r8,5.3440e+00_r8,6.7154e+00_r8/) + kao(:,12,10) = (/ & + &2.0671e+00_r8,2.8097e+00_r8,3.7158e+00_r8,4.7938e+00_r8,5.9967e+00_r8/) + kao(:,13,10) = (/ & + &1.8130e+00_r8,2.4724e+00_r8,3.2908e+00_r8,4.2191e+00_r8,5.2351e+00_r8/) + kao(:, 1,11) = (/ & + &1.7369e+01_r8,2.0982e+01_r8,2.4652e+01_r8,2.8692e+01_r8,3.3179e+01_r8/) + kao(:, 2,11) = (/ & + &1.6823e+01_r8,2.0457e+01_r8,2.4236e+01_r8,2.8171e+01_r8,3.2333e+01_r8/) + kao(:, 3,11) = (/ & + &1.5375e+01_r8,1.8905e+01_r8,2.2457e+01_r8,2.6420e+01_r8,3.0766e+01_r8/) + kao(:, 4,11) = (/ & + &1.3375e+01_r8,1.6618e+01_r8,2.0128e+01_r8,2.4207e+01_r8,2.8664e+01_r8/) + kao(:, 5,11) = (/ & + &1.1552e+01_r8,1.4477e+01_r8,1.7747e+01_r8,2.1616e+01_r8,2.5966e+01_r8/) + kao(:, 6,11) = (/ & + &9.7662e+00_r8,1.2339e+01_r8,1.5425e+01_r8,1.9082e+01_r8,2.3024e+01_r8/) + kao(:, 7,11) = (/ & + &8.0435e+00_r8,1.0356e+01_r8,1.3162e+01_r8,1.6422e+01_r8,1.9976e+01_r8/) + kao(:, 8,11) = (/ & + &6.6475e+00_r8,8.6800e+00_r8,1.1208e+01_r8,1.4127e+01_r8,1.7194e+01_r8/) + kao(:, 9,11) = (/ & + &5.4286e+00_r8,7.1938e+00_r8,9.4274e+00_r8,1.1995e+01_r8,1.4788e+01_r8/) + kao(:,10,11) = (/ & + &4.4519e+00_r8,5.9777e+00_r8,7.8591e+00_r8,1.0067e+01_r8,1.2572e+01_r8/) + kao(:,11,11) = (/ & + &4.1097e+00_r8,5.5519e+00_r8,7.2615e+00_r8,9.2610e+00_r8,1.1615e+01_r8/) + kao(:,12,11) = (/ & + &3.7565e+00_r8,5.0648e+00_r8,6.6341e+00_r8,8.4916e+00_r8,1.0710e+01_r8/) + kao(:,13,11) = (/ & + &3.3842e+00_r8,4.5598e+00_r8,5.9909e+00_r8,7.7387e+00_r8,9.7720e+00_r8/) + kao(:, 1,12) = (/ & + &2.2275e+01_r8,2.7471e+01_r8,3.3492e+01_r8,4.0225e+01_r8,4.7465e+01_r8/) + kao(:, 2,12) = (/ & + &2.2476e+01_r8,2.7446e+01_r8,3.3072e+01_r8,3.9336e+01_r8,4.6205e+01_r8/) + kao(:, 3,12) = (/ & + &2.1150e+01_r8,2.6276e+01_r8,3.1885e+01_r8,3.7595e+01_r8,4.3863e+01_r8/) + kao(:, 4,12) = (/ & + &1.9455e+01_r8,2.4367e+01_r8,2.9875e+01_r8,3.5713e+01_r8,4.1802e+01_r8/) + kao(:, 5,12) = (/ & + &1.7406e+01_r8,2.2244e+01_r8,2.7648e+01_r8,3.3299e+01_r8,3.9489e+01_r8/) + kao(:, 6,12) = (/ & + &1.5271e+01_r8,1.9641e+01_r8,2.4614e+01_r8,3.0133e+01_r8,3.6348e+01_r8/) + kao(:, 7,12) = (/ & + &1.3343e+01_r8,1.7102e+01_r8,2.1495e+01_r8,2.6582e+01_r8,3.2562e+01_r8/) + kao(:, 8,12) = (/ & + &1.1399e+01_r8,1.4767e+01_r8,1.8657e+01_r8,2.3239e+01_r8,2.8870e+01_r8/) + kao(:, 9,12) = (/ & + &9.4462e+00_r8,1.2437e+01_r8,1.5942e+01_r8,2.0083e+01_r8,2.5175e+01_r8/) + kao(:,10,12) = (/ & + &7.9561e+00_r8,1.0576e+01_r8,1.3751e+01_r8,1.7625e+01_r8,2.2224e+01_r8/) + kao(:,11,12) = (/ & + &7.6703e+00_r8,1.0214e+01_r8,1.3362e+01_r8,1.7172e+01_r8,2.1565e+01_r8/) + kao(:,12,12) = (/ & + &7.3002e+00_r8,9.7613e+00_r8,1.2808e+01_r8,1.6448e+01_r8,2.0508e+01_r8/) + kao(:,13,12) = (/ & + &6.8227e+00_r8,9.1662e+00_r8,1.2005e+01_r8,1.5291e+01_r8,1.9104e+01_r8/) + kao(:, 1,13) = (/ & + &2.8154e+01_r8,3.5750e+01_r8,4.4791e+01_r8,5.4873e+01_r8,6.6140e+01_r8/) + kao(:, 2,13) = (/ & + &2.8745e+01_r8,3.6229e+01_r8,4.5340e+01_r8,5.5950e+01_r8,6.7860e+01_r8/) + kao(:, 3,13) = (/ & + &2.8731e+01_r8,3.5740e+01_r8,4.4190e+01_r8,5.4581e+01_r8,6.6390e+01_r8/) + kao(:, 4,13) = (/ & + &2.7586e+01_r8,3.5028e+01_r8,4.3053e+01_r8,5.2513e+01_r8,6.3590e+01_r8/) + kao(:, 5,13) = (/ & + &2.6083e+01_r8,3.3437e+01_r8,4.1632e+01_r8,5.0781e+01_r8,6.1113e+01_r8/) + kao(:, 6,13) = (/ & + &2.3829e+01_r8,3.1109e+01_r8,3.9228e+01_r8,4.8371e+01_r8,5.8278e+01_r8/) + kao(:, 7,13) = (/ & + &2.1209e+01_r8,2.8372e+01_r8,3.6376e+01_r8,4.5363e+01_r8,5.5372e+01_r8/) + kao(:, 8,13) = (/ & + &1.8790e+01_r8,2.5354e+01_r8,3.3043e+01_r8,4.1793e+01_r8,5.1443e+01_r8/) + kao(:, 9,13) = (/ & + &1.6798e+01_r8,2.2642e+01_r8,2.9578e+01_r8,3.7822e+01_r8,4.7058e+01_r8/) + kao(:,10,13) = (/ & + &1.4972e+01_r8,2.0558e+01_r8,2.6854e+01_r8,3.4253e+01_r8,4.2864e+01_r8/) + kao(:,11,13) = (/ & + &1.5310e+01_r8,2.0781e+01_r8,2.6920e+01_r8,3.4183e+01_r8,4.2625e+01_r8/) + kao(:,12,13) = (/ & + &1.5266e+01_r8,2.0520e+01_r8,2.6628e+01_r8,3.3712e+01_r8,4.2182e+01_r8/) + kao(:,13,13) = (/ & + &1.4957e+01_r8,1.9939e+01_r8,2.5957e+01_r8,3.3111e+01_r8,4.1486e+01_r8/) + kao(:, 1,14) = (/ & + &4.6330e+01_r8,6.0030e+01_r8,7.5480e+01_r8,9.2536e+01_r8,1.1059e+02_r8/) + kao(:, 2,14) = (/ & + &4.4855e+01_r8,5.8960e+01_r8,7.5059e+01_r8,9.2958e+01_r8,1.1209e+02_r8/) + kao(:, 3,14) = (/ & + &4.1447e+01_r8,5.4787e+01_r8,7.1113e+01_r8,8.9291e+01_r8,1.0911e+02_r8/) + kao(:, 4,14) = (/ & + &3.9104e+01_r8,5.0668e+01_r8,6.5934e+01_r8,8.3732e+01_r8,1.0396e+02_r8/) + kao(:, 5,14) = (/ & + &3.8023e+01_r8,4.8275e+01_r8,6.1835e+01_r8,7.8920e+01_r8,9.8684e+01_r8/) + kao(:, 6,14) = (/ & + &3.6671e+01_r8,4.6928e+01_r8,5.9373e+01_r8,7.4910e+01_r8,9.4120e+01_r8/) + kao(:, 7,14) = (/ & + &3.4713e+01_r8,4.5254e+01_r8,5.8164e+01_r8,7.3270e+01_r8,9.1067e+01_r8/) + kao(:, 8,14) = (/ & + &3.2317e+01_r8,4.2931e+01_r8,5.6350e+01_r8,7.1845e+01_r8,8.9533e+01_r8/) + kao(:, 9,14) = (/ & + &2.9466e+01_r8,3.9947e+01_r8,5.3450e+01_r8,6.9454e+01_r8,8.7436e+01_r8/) + kao(:,10,14) = (/ & + &2.7304e+01_r8,3.7491e+01_r8,5.1151e+01_r8,6.7458e+01_r8,8.6217e+01_r8/) + kao(:,11,14) = (/ & + &2.9371e+01_r8,4.0579e+01_r8,5.5614e+01_r8,7.3135e+01_r8,9.3406e+01_r8/) + kao(:,12,14) = (/ & + &3.1557e+01_r8,4.3832e+01_r8,5.9668e+01_r8,7.8288e+01_r8,9.9282e+01_r8/) + kao(:,13,14) = (/ & + &3.3702e+01_r8,4.7002e+01_r8,6.3302e+01_r8,8.2327e+01_r8,1.0363e+02_r8/) + kao(:, 1,15) = (/ & + &7.1097e+01_r8,9.1809e+01_r8,1.1513e+02_r8,1.4077e+02_r8,1.6931e+02_r8/) + kao(:, 2,15) = (/ & + &7.6481e+01_r8,9.9988e+01_r8,1.2655e+02_r8,1.5641e+02_r8,1.9001e+02_r8/) + kao(:, 3,15) = (/ & + &7.6089e+01_r8,1.0186e+02_r8,1.3121e+02_r8,1.6509e+02_r8,2.0316e+02_r8/) + kao(:, 4,15) = (/ & + &7.1689e+01_r8,9.8693e+01_r8,1.3061e+02_r8,1.6745e+02_r8,2.0924e+02_r8/) + kao(:, 5,15) = (/ & + &6.5396e+01_r8,9.2850e+01_r8,1.2644e+02_r8,1.6569e+02_r8,2.1030e+02_r8/) + kao(:, 6,15) = (/ & + &5.9839e+01_r8,8.4120e+01_r8,1.1791e+02_r8,1.5835e+02_r8,2.0497e+02_r8/) + kao(:, 7,15) = (/ & + &5.7504e+01_r8,7.7966e+01_r8,1.0776e+02_r8,1.4729e+02_r8,1.9476e+02_r8/) + kao(:, 8,15) = (/ & + &5.7004e+01_r8,7.5268e+01_r8,1.0086e+02_r8,1.3678e+02_r8,1.8339e+02_r8/) + kao(:, 9,15) = (/ & + &5.5577e+01_r8,7.3906e+01_r8,9.7044e+01_r8,1.2904e+02_r8,1.7226e+02_r8/) + kao(:,10,15) = (/ & + &5.5416e+01_r8,7.4211e+01_r8,9.6440e+01_r8,1.2687e+02_r8,1.6750e+02_r8/) + kao(:,11,15) = (/ & + &6.2860e+01_r8,8.4332e+01_r8,1.0913e+02_r8,1.4265e+02_r8,1.8694e+02_r8/) + kao(:,12,15) = (/ & + &7.1048e+01_r8,9.5286e+01_r8,1.2362e+02_r8,1.6046e+02_r8,2.0975e+02_r8/) + kao(:,13,15) = (/ & + &7.9451e+01_r8,1.0631e+02_r8,1.3951e+02_r8,1.8076e+02_r8,2.3534e+02_r8/) + kao(:, 1,16) = (/ & + &7.6064e+01_r8,1.0164e+02_r8,1.3126e+02_r8,1.6469e+02_r8,2.0152e+02_r8/) + kao(:, 2,16) = (/ & + &8.3803e+01_r8,1.1323e+02_r8,1.4816e+02_r8,1.8796e+02_r8,2.3219e+02_r8/) + kao(:, 3,16) = (/ & + &8.7402e+01_r8,1.1813e+02_r8,1.5778e+02_r8,2.0377e+02_r8,2.5553e+02_r8/) + kao(:, 4,16) = (/ & + &8.7865e+01_r8,1.1968e+02_r8,1.6142e+02_r8,2.1263e+02_r8,2.7144e+02_r8/) + kao(:, 5,16) = (/ & + &8.6499e+01_r8,1.2062e+02_r8,1.6367e+02_r8,2.1790e+02_r8,2.8301e+02_r8/) + kao(:, 6,16) = (/ & + &8.2494e+01_r8,1.1893e+02_r8,1.6400e+02_r8,2.2086e+02_r8,2.8964e+02_r8/) + kao(:, 7,16) = (/ & + &7.7078e+01_r8,1.1526e+02_r8,1.6302e+02_r8,2.2306e+02_r8,2.9645e+02_r8/) + kao(:, 8,16) = (/ & + &7.0841e+01_r8,1.1011e+02_r8,1.6059e+02_r8,2.2458e+02_r8,3.0342e+02_r8/) + kao(:, 9,16) = (/ & + &7.4013e+01_r8,1.0313e+02_r8,1.5566e+02_r8,2.2324e+02_r8,3.0785e+02_r8/) + kao(:,10,16) = (/ & + &8.3043e+01_r8,1.0119e+02_r8,1.5304e+02_r8,2.2535e+02_r8,3.1705e+02_r8/) + kao(:,11,16) = (/ & + &1.0007e+02_r8,1.2237e+02_r8,1.8107e+02_r8,2.6762e+02_r8,3.7672e+02_r8/) + kao(:,12,16) = (/ & + &1.1998e+02_r8,1.4801e+02_r8,2.1370e+02_r8,3.1623e+02_r8,4.4496e+02_r8/) + kao(:,13,16) = (/ & + &1.4282e+02_r8,1.7830e+02_r8,2.5018e+02_r8,3.7037e+02_r8,5.2070e+02_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &1.3000e-04_r8,1.6216e-04_r8,2.0768e-04_r8,2.6864e-04_r8,3.3497e-04_r8/) + kbo(:,14, 1) = (/ & + &1.0850e-04_r8,1.3602e-04_r8,1.7553e-04_r8,2.2686e-04_r8,2.8162e-04_r8/) + kbo(:,15, 1) = (/ & + &9.0864e-05_r8,1.1476e-04_r8,1.4832e-04_r8,1.9081e-04_r8,2.3698e-04_r8/) + kbo(:,16, 1) = (/ & + &7.6202e-05_r8,9.6897e-05_r8,1.2521e-04_r8,1.6032e-04_r8,1.9925e-04_r8/) + kbo(:,17, 1) = (/ & + &6.3984e-05_r8,8.1671e-05_r8,1.0565e-04_r8,1.3448e-04_r8,1.6696e-04_r8/) + kbo(:,18, 1) = (/ & + &5.3749e-05_r8,6.8759e-05_r8,8.9036e-05_r8,1.1274e-04_r8,1.3824e-04_r8/) + kbo(:,19, 1) = (/ & + &4.5160e-05_r8,5.7874e-05_r8,7.4954e-05_r8,9.4487e-05_r8,1.1485e-04_r8/) + kbo(:,20, 1) = (/ & + &3.8050e-05_r8,4.8934e-05_r8,6.3376e-05_r8,7.9393e-05_r8,9.5565e-05_r8/) + kbo(:,21, 1) = (/ & + &3.2121e-05_r8,4.1368e-05_r8,5.3585e-05_r8,6.6749e-05_r8,7.9704e-05_r8/) + kbo(:,22, 1) = (/ & + &2.7597e-05_r8,3.5606e-05_r8,4.6066e-05_r8,5.6919e-05_r8,6.7252e-05_r8/) + kbo(:,23, 1) = (/ & + &2.3703e-05_r8,3.0672e-05_r8,3.9251e-05_r8,4.8622e-05_r8,5.6783e-05_r8/) + kbo(:,24, 1) = (/ & + &2.0444e-05_r8,2.6471e-05_r8,3.3535e-05_r8,4.1441e-05_r8,4.8070e-05_r8/) + kbo(:,25, 1) = (/ & + &1.7691e-05_r8,2.2899e-05_r8,2.8737e-05_r8,3.4776e-05_r8,4.0820e-05_r8/) + kbo(:,26, 1) = (/ & + &1.5391e-05_r8,1.9900e-05_r8,2.4708e-05_r8,2.9438e-05_r8,3.4884e-05_r8/) + kbo(:,27, 1) = (/ & + &1.3401e-05_r8,1.7231e-05_r8,2.1300e-05_r8,2.5041e-05_r8,2.9843e-05_r8/) + kbo(:,28, 1) = (/ & + &1.1671e-05_r8,1.4827e-05_r8,1.8383e-05_r8,2.1307e-05_r8,2.5549e-05_r8/) + kbo(:,29, 1) = (/ & + &1.0183e-05_r8,1.2798e-05_r8,1.5535e-05_r8,1.8197e-05_r8,2.1838e-05_r8/) + kbo(:,30, 1) = (/ & + &8.8844e-06_r8,1.1043e-05_r8,1.3172e-05_r8,1.5593e-05_r8,1.8678e-05_r8/) + kbo(:,31, 1) = (/ & + &7.7313e-06_r8,9.5518e-06_r8,1.1237e-05_r8,1.3382e-05_r8,1.5999e-05_r8/) + kbo(:,32, 1) = (/ & + &6.6794e-06_r8,8.2781e-06_r8,9.5924e-06_r8,1.1496e-05_r8,1.3717e-05_r8/) + kbo(:,33, 1) = (/ & + &5.7815e-06_r8,7.0042e-06_r8,8.2098e-06_r8,9.8489e-06_r8,1.1766e-05_r8/) + kbo(:,34, 1) = (/ & + &4.9641e-06_r8,5.9235e-06_r8,7.0090e-06_r8,8.3895e-06_r8,1.0037e-05_r8/) + kbo(:,35, 1) = (/ & + &4.1780e-06_r8,4.9520e-06_r8,5.8797e-06_r8,7.0288e-06_r8,8.4123e-06_r8/) + kbo(:,36, 1) = (/ & + &3.4370e-06_r8,4.0690e-06_r8,4.8335e-06_r8,5.7766e-06_r8,6.9140e-06_r8/) + kbo(:,37, 1) = (/ & + &2.7366e-06_r8,3.2617e-06_r8,3.8617e-06_r8,4.6224e-06_r8,5.5308e-06_r8/) + kbo(:,38, 1) = (/ & + &2.1763e-06_r8,2.6155e-06_r8,3.0811e-06_r8,3.6939e-06_r8,4.4152e-06_r8/) + kbo(:,39, 1) = (/ & + &1.7313e-06_r8,2.1017e-06_r8,2.4606e-06_r8,2.9519e-06_r8,3.5266e-06_r8/) + kbo(:,40, 1) = (/ & + &1.3469e-06_r8,1.6693e-06_r8,1.9344e-06_r8,2.3182e-06_r8,2.7667e-06_r8/) + kbo(:,41, 1) = (/ & + &1.0461e-06_r8,1.2927e-06_r8,1.5201e-06_r8,1.8107e-06_r8,2.1653e-06_r8/) + kbo(:,42, 1) = (/ & + &8.0658e-07_r8,1.0022e-06_r8,1.1943e-06_r8,1.4143e-06_r8,1.6945e-06_r8/) + kbo(:,43, 1) = (/ & + &6.1022e-07_r8,7.6847e-07_r8,9.3637e-07_r8,1.0945e-06_r8,1.3137e-06_r8/) + kbo(:,44, 1) = (/ & + &4.5840e-07_r8,5.8613e-07_r8,7.2558e-07_r8,8.4731e-07_r8,1.0130e-06_r8/) + kbo(:,45, 1) = (/ & + &3.4424e-07_r8,4.4504e-07_r8,5.5242e-07_r8,6.5691e-07_r8,7.7925e-07_r8/) + kbo(:,46, 1) = (/ & + &2.5697e-07_r8,3.3261e-07_r8,4.1921e-07_r8,5.1218e-07_r8,5.9773e-07_r8/) + kbo(:,47, 1) = (/ & + &1.8987e-07_r8,2.4567e-07_r8,3.1544e-07_r8,3.9053e-07_r8,4.5787e-07_r8/) + kbo(:,48, 1) = (/ & + &1.4058e-07_r8,1.8138e-07_r8,2.3483e-07_r8,2.9330e-07_r8,3.5197e-07_r8/) + kbo(:,49, 1) = (/ & + &1.0462e-07_r8,1.3385e-07_r8,1.7347e-07_r8,2.2053e-07_r8,2.7396e-07_r8/) + kbo(:,50, 1) = (/ & + &7.9205e-08_r8,9.9611e-08_r8,1.2890e-07_r8,1.6695e-07_r8,2.0670e-07_r8/) + kbo(:,51, 1) = (/ & + &6.0628e-08_r8,7.4396e-08_r8,9.6049e-08_r8,1.2454e-07_r8,1.5638e-07_r8/) + kbo(:,52, 1) = (/ & + &4.5002e-08_r8,5.5943e-08_r8,7.1532e-08_r8,9.2844e-08_r8,1.1852e-07_r8/) + kbo(:,53, 1) = (/ & + &3.2555e-08_r8,4.2490e-08_r8,5.3383e-08_r8,6.9149e-08_r8,8.9727e-08_r8/) + kbo(:,54, 1) = (/ & + &2.3696e-08_r8,3.2653e-08_r8,4.0140e-08_r8,5.1914e-08_r8,6.7441e-08_r8/) + kbo(:,55, 1) = (/ & + &1.7247e-08_r8,2.4546e-08_r8,3.0469e-08_r8,3.9087e-08_r8,5.0840e-08_r8/) + kbo(:,56, 1) = (/ & + &1.2515e-08_r8,1.8025e-08_r8,2.3296e-08_r8,2.9456e-08_r8,3.8300e-08_r8/) + kbo(:,57, 1) = (/ & + &9.0211e-09_r8,1.3183e-08_r8,1.7891e-08_r8,2.2220e-08_r8,2.8857e-08_r8/) + kbo(:,58, 1) = (/ & + &6.4935e-09_r8,9.6472e-09_r8,1.3706e-08_r8,1.6858e-08_r8,2.1803e-08_r8/) + kbo(:,59, 1) = (/ & + &5.0413e-09_r8,7.5477e-09_r8,1.0800e-08_r8,1.3392e-08_r8,1.7290e-08_r8/) + kbo(:,13, 2) = (/ & + &3.6782e-04_r8,4.0460e-04_r8,4.6828e-04_r8,5.6427e-04_r8,6.8387e-04_r8/) + kbo(:,14, 2) = (/ & + &3.0206e-04_r8,3.3534e-04_r8,3.8904e-04_r8,4.6908e-04_r8,5.7354e-04_r8/) + kbo(:,15, 2) = (/ & + &2.4903e-04_r8,2.7718e-04_r8,3.2574e-04_r8,3.9271e-04_r8,4.8202e-04_r8/) + kbo(:,16, 2) = (/ & + &2.0570e-04_r8,2.3043e-04_r8,2.7323e-04_r8,3.2940e-04_r8,4.0539e-04_r8/) + kbo(:,17, 2) = (/ & + &1.6973e-04_r8,1.9226e-04_r8,2.2908e-04_r8,2.7627e-04_r8,3.4057e-04_r8/) + kbo(:,18, 2) = (/ & + &1.4059e-04_r8,1.6018e-04_r8,1.9182e-04_r8,2.3171e-04_r8,2.8730e-04_r8/) + kbo(:,19, 2) = (/ & + &1.1617e-04_r8,1.3358e-04_r8,1.6042e-04_r8,1.9424e-04_r8,2.4177e-04_r8/) + kbo(:,20, 2) = (/ & + &9.6546e-05_r8,1.1187e-04_r8,1.3461e-04_r8,1.6319e-04_r8,2.0430e-04_r8/) + kbo(:,21, 2) = (/ & + &8.0465e-05_r8,9.3512e-05_r8,1.1260e-04_r8,1.3712e-04_r8,1.7240e-04_r8/) + kbo(:,22, 2) = (/ & + &6.7521e-05_r8,7.9100e-05_r8,9.4853e-05_r8,1.1694e-04_r8,1.4756e-04_r8/) + kbo(:,23, 2) = (/ & + &5.6632e-05_r8,6.7211e-05_r8,8.0875e-05_r8,9.9624e-05_r8,1.2638e-04_r8/) + kbo(:,24, 2) = (/ & + &4.7866e-05_r8,5.7310e-05_r8,6.9154e-05_r8,8.5301e-05_r8,1.0831e-04_r8/) + kbo(:,25, 2) = (/ & + &4.0652e-05_r8,4.8933e-05_r8,5.9257e-05_r8,7.3835e-05_r8,9.2951e-05_r8/) + kbo(:,26, 2) = (/ & + &3.4655e-05_r8,4.1694e-05_r8,5.0935e-05_r8,6.3979e-05_r8,8.0042e-05_r8/) + kbo(:,27, 2) = (/ & + &2.9633e-05_r8,3.5562e-05_r8,4.3853e-05_r8,5.5348e-05_r8,6.8920e-05_r8/) + kbo(:,28, 2) = (/ & + &2.5432e-05_r8,3.0614e-05_r8,3.7665e-05_r8,4.7871e-05_r8,5.9328e-05_r8/) + kbo(:,29, 2) = (/ & + &2.1848e-05_r8,2.6432e-05_r8,3.2844e-05_r8,4.1383e-05_r8,5.1047e-05_r8/) + kbo(:,30, 2) = (/ & + &1.8680e-05_r8,2.2782e-05_r8,2.8578e-05_r8,3.5766e-05_r8,4.3772e-05_r8/) + kbo(:,31, 2) = (/ & + &1.5971e-05_r8,1.9690e-05_r8,2.4825e-05_r8,3.0907e-05_r8,3.7564e-05_r8/) + kbo(:,32, 2) = (/ & + &1.3804e-05_r8,1.6977e-05_r8,2.1562e-05_r8,2.6712e-05_r8,3.2275e-05_r8/) + kbo(:,33, 2) = (/ & + &1.1945e-05_r8,1.4856e-05_r8,1.8696e-05_r8,2.3037e-05_r8,2.7659e-05_r8/) + kbo(:,34, 2) = (/ & + &1.0252e-05_r8,1.2851e-05_r8,1.6075e-05_r8,1.9670e-05_r8,2.3561e-05_r8/) + kbo(:,35, 2) = (/ & + &8.6288e-06_r8,1.0847e-05_r8,1.3532e-05_r8,1.6502e-05_r8,1.9733e-05_r8/) + kbo(:,36, 2) = (/ & + &7.0970e-06_r8,8.9246e-06_r8,1.1130e-05_r8,1.3564e-05_r8,1.6217e-05_r8/) + kbo(:,37, 2) = (/ & + &5.6546e-06_r8,7.0912e-06_r8,8.8667e-06_r8,1.0842e-05_r8,1.2980e-05_r8/) + kbo(:,38, 2) = (/ & + &4.4964e-06_r8,5.6180e-06_r8,7.0484e-06_r8,8.6481e-06_r8,1.0377e-05_r8/) + kbo(:,39, 2) = (/ & + &3.5794e-06_r8,4.4460e-06_r8,5.6006e-06_r8,6.9055e-06_r8,8.2935e-06_r8/) + kbo(:,40, 2) = (/ & + &2.7849e-06_r8,3.4244e-06_r8,4.3497e-06_r8,5.3888e-06_r8,6.5103e-06_r8/) + kbo(:,41, 2) = (/ & + &2.1634e-06_r8,2.6661e-06_r8,3.3623e-06_r8,4.1856e-06_r8,5.0849e-06_r8/) + kbo(:,42, 2) = (/ & + &1.6951e-06_r8,2.0688e-06_r8,2.5958e-06_r8,3.2479e-06_r8,3.9733e-06_r8/) + kbo(:,43, 2) = (/ & + &1.3156e-06_r8,1.5889e-06_r8,1.9703e-06_r8,2.4872e-06_r8,3.0727e-06_r8/) + kbo(:,44, 2) = (/ & + &1.0083e-06_r8,1.2108e-06_r8,1.4918e-06_r8,1.8898e-06_r8,2.3484e-06_r8/) + kbo(:,45, 2) = (/ & + &7.7597e-07_r8,9.3178e-07_r8,1.1396e-06_r8,1.4323e-06_r8,1.7919e-06_r8/) + kbo(:,46, 2) = (/ & + &5.9640e-07_r8,7.1743e-07_r8,8.6664e-07_r8,1.0739e-06_r8,1.3585e-06_r8/) + kbo(:,47, 2) = (/ & + &4.5875e-07_r8,5.4303e-07_r8,6.5202e-07_r8,8.0415e-07_r8,1.0165e-06_r8/) + kbo(:,48, 2) = (/ & + &3.5634e-07_r8,4.1385e-07_r8,4.9968e-07_r8,6.0505e-07_r8,7.5779e-07_r8/) + kbo(:,49, 2) = (/ & + &2.7966e-07_r8,3.1607e-07_r8,3.7849e-07_r8,4.5539e-07_r8,5.6073e-07_r8/) + kbo(:,50, 2) = (/ & + &2.2335e-07_r8,2.4619e-07_r8,2.8832e-07_r8,3.4563e-07_r8,4.2520e-07_r8/) + kbo(:,51, 2) = (/ & + &1.6810e-07_r8,1.9184e-07_r8,2.2126e-07_r8,2.6681e-07_r8,3.2272e-07_r8/) + kbo(:,52, 2) = (/ & + &1.2477e-07_r8,1.5183e-07_r8,1.7051e-07_r8,2.0325e-07_r8,2.4465e-07_r8/) + kbo(:,53, 2) = (/ & + &9.1697e-08_r8,1.2163e-07_r8,1.3293e-07_r8,1.5546e-07_r8,1.8654e-07_r8/) + kbo(:,54, 2) = (/ & + &6.8066e-08_r8,9.0724e-08_r8,1.0426e-07_r8,1.1988e-07_r8,1.4459e-07_r8/) + kbo(:,55, 2) = (/ & + &5.0853e-08_r8,6.8116e-08_r8,8.2949e-08_r8,9.3086e-08_r8,1.1106e-07_r8/) + kbo(:,56, 2) = (/ & + &3.8097e-08_r8,5.0708e-08_r8,6.6601e-08_r8,7.3097e-08_r8,8.5626e-08_r8/) + kbo(:,57, 2) = (/ & + &2.8575e-08_r8,3.7778e-08_r8,5.0543e-08_r8,5.7226e-08_r8,6.6193e-08_r8/) + kbo(:,58, 2) = (/ & + &2.1274e-08_r8,2.8319e-08_r8,3.8061e-08_r8,4.5485e-08_r8,5.1336e-08_r8/) + kbo(:,59, 2) = (/ & + &1.6785e-08_r8,2.2389e-08_r8,3.0047e-08_r8,3.6850e-08_r8,4.1308e-08_r8/) + kbo(:,13, 3) = (/ & + &4.8329e-04_r8,7.1031e-04_r8,9.2618e-04_r8,1.1787e-03_r8,1.4998e-03_r8/) + kbo(:,14, 3) = (/ & + &4.1573e-04_r8,5.9621e-04_r8,7.7781e-04_r8,9.9253e-04_r8,1.2561e-03_r8/) + kbo(:,15, 3) = (/ & + &3.5745e-04_r8,5.0356e-04_r8,6.5391e-04_r8,8.3999e-04_r8,1.0559e-03_r8/) + kbo(:,16, 3) = (/ & + &3.0758e-04_r8,4.2512e-04_r8,5.5063e-04_r8,7.1032e-04_r8,8.8405e-04_r8/) + kbo(:,17, 3) = (/ & + &2.6428e-04_r8,3.5939e-04_r8,4.6476e-04_r8,5.9990e-04_r8,7.3444e-04_r8/) + kbo(:,18, 3) = (/ & + &2.2620e-04_r8,3.0371e-04_r8,3.9242e-04_r8,5.0569e-04_r8,6.1057e-04_r8/) + kbo(:,19, 3) = (/ & + &1.9349e-04_r8,2.5703e-04_r8,3.3045e-04_r8,4.2572e-04_r8,5.0885e-04_r8/) + kbo(:,20, 3) = (/ & + &1.6601e-04_r8,2.1679e-04_r8,2.7938e-04_r8,3.5877e-04_r8,4.2456e-04_r8/) + kbo(:,21, 3) = (/ & + &1.3973e-04_r8,1.8356e-04_r8,2.3660e-04_r8,3.0163e-04_r8,3.5438e-04_r8/) + kbo(:,22, 3) = (/ & + &1.2024e-04_r8,1.5775e-04_r8,2.0424e-04_r8,2.5718e-04_r8,2.9870e-04_r8/) + kbo(:,23, 3) = (/ & + &1.0421e-04_r8,1.3581e-04_r8,1.7576e-04_r8,2.1785e-04_r8,2.5256e-04_r8/) + kbo(:,24, 3) = (/ & + &9.0642e-05_r8,1.1736e-04_r8,1.5142e-04_r8,1.8334e-04_r8,2.1432e-04_r8/) + kbo(:,25, 3) = (/ & + &7.8653e-05_r8,1.0139e-04_r8,1.3046e-04_r8,1.5520e-04_r8,1.8200e-04_r8/) + kbo(:,26, 3) = (/ & + &6.8347e-05_r8,8.8330e-05_r8,1.1221e-04_r8,1.3139e-04_r8,1.5501e-04_r8/) + kbo(:,27, 3) = (/ & + &5.9438e-05_r8,7.7110e-05_r8,9.6484e-05_r8,1.1163e-04_r8,1.3198e-04_r8/) + kbo(:,28, 3) = (/ & + &5.1865e-05_r8,6.7062e-05_r8,8.1622e-05_r8,9.5189e-05_r8,1.1250e-04_r8/) + kbo(:,29, 3) = (/ & + &4.5229e-05_r8,5.8248e-05_r8,6.9371e-05_r8,8.1305e-05_r8,9.5987e-05_r8/) + kbo(:,30, 3) = (/ & + &3.9548e-05_r8,5.0236e-05_r8,5.8927e-05_r8,6.9361e-05_r8,8.1985e-05_r8/) + kbo(:,31, 3) = (/ & + &3.4672e-05_r8,4.3357e-05_r8,5.0119e-05_r8,5.9230e-05_r8,7.0087e-05_r8/) + kbo(:,32, 3) = (/ & + &3.0291e-05_r8,3.6761e-05_r8,4.2859e-05_r8,5.0621e-05_r8,5.9826e-05_r8/) + kbo(:,33, 3) = (/ & + &2.6343e-05_r8,3.1291e-05_r8,3.6685e-05_r8,4.3251e-05_r8,5.1136e-05_r8/) + kbo(:,34, 3) = (/ & + &2.2619e-05_r8,2.6479e-05_r8,3.1160e-05_r8,3.6817e-05_r8,4.3454e-05_r8/) + kbo(:,35, 3) = (/ & + &1.9044e-05_r8,2.2094e-05_r8,2.6069e-05_r8,3.0814e-05_r8,3.6332e-05_r8/) + kbo(:,36, 3) = (/ & + &1.5660e-05_r8,1.8150e-05_r8,2.1420e-05_r8,2.5318e-05_r8,2.9845e-05_r8/) + kbo(:,37, 3) = (/ & + &1.2481e-05_r8,1.4567e-05_r8,1.7160e-05_r8,2.0273e-05_r8,2.3924e-05_r8/) + kbo(:,38, 3) = (/ & + &9.9229e-06_r8,1.1707e-05_r8,1.3728e-05_r8,1.6208e-05_r8,1.9147e-05_r8/) + kbo(:,39, 3) = (/ & + &7.8980e-06_r8,9.3824e-06_r8,1.0994e-05_r8,1.2956e-05_r8,1.5319e-05_r8/) + kbo(:,40, 3) = (/ & + &6.1214e-06_r8,7.4148e-06_r8,8.6411e-06_r8,1.0203e-05_r8,1.2052e-05_r8/) + kbo(:,41, 3) = (/ & + &4.7079e-06_r8,5.8792e-06_r8,6.7814e-06_r8,8.0075e-06_r8,9.4649e-06_r8/) + kbo(:,42, 3) = (/ & + &3.6048e-06_r8,4.5698e-06_r8,5.3449e-06_r8,6.2854e-06_r8,7.4263e-06_r8/) + kbo(:,43, 3) = (/ & + &2.7216e-06_r8,3.5076e-06_r8,4.1783e-06_r8,4.8932e-06_r8,5.7661e-06_r8/) + kbo(:,44, 3) = (/ & + &2.0468e-06_r8,2.6504e-06_r8,3.2648e-06_r8,3.7820e-06_r8,4.4701e-06_r8/) + kbo(:,45, 3) = (/ & + &1.5361e-06_r8,1.9893e-06_r8,2.5184e-06_r8,2.9393e-06_r8,3.4602e-06_r8/) + kbo(:,46, 3) = (/ & + &1.1503e-06_r8,1.4832e-06_r8,1.9137e-06_r8,2.2823e-06_r8,2.6719e-06_r8/) + kbo(:,47, 3) = (/ & + &8.3777e-07_r8,1.0971e-06_r8,1.4217e-06_r8,1.7739e-06_r8,2.0443e-06_r8/) + kbo(:,48, 3) = (/ & + &6.1407e-07_r8,8.0972e-07_r8,1.0453e-06_r8,1.3363e-06_r8,1.5776e-06_r8/) + kbo(:,49, 3) = (/ & + &4.3890e-07_r8,5.9676e-07_r8,7.7449e-07_r8,1.0018e-06_r8,1.2151e-06_r8/) + kbo(:,50, 3) = (/ & + &3.0232e-07_r8,4.3632e-07_r8,5.7501e-07_r8,7.4600e-07_r8,9.3964e-07_r8/) + kbo(:,51, 3) = (/ & + &2.1820e-07_r8,3.2558e-07_r8,4.2933e-07_r8,5.5411e-07_r8,7.1236e-07_r8/) + kbo(:,52, 3) = (/ & + &1.6142e-07_r8,2.3096e-07_r8,3.1815e-07_r8,4.1428e-07_r8,5.3670e-07_r8/) + kbo(:,53, 3) = (/ & + &1.2239e-07_r8,1.5927e-07_r8,2.3415e-07_r8,3.0848e-07_r8,4.0010e-07_r8/) + kbo(:,54, 3) = (/ & + &9.4287e-08_r8,1.1772e-07_r8,1.7609e-07_r8,2.3226e-07_r8,2.9972e-07_r8/) + kbo(:,55, 3) = (/ & + &7.3559e-08_r8,8.8158e-08_r8,1.2627e-07_r8,1.7401e-07_r8,2.2659e-07_r8/) + kbo(:,56, 3) = (/ & + &5.7474e-08_r8,6.7419e-08_r8,8.9064e-08_r8,1.2949e-07_r8,1.7067e-07_r8/) + kbo(:,57, 3) = (/ & + &4.5317e-08_r8,5.2043e-08_r8,6.5424e-08_r8,9.7761e-08_r8,1.2882e-07_r8/) + kbo(:,58, 3) = (/ & + &3.4988e-08_r8,4.0617e-08_r8,4.8970e-08_r8,7.1601e-08_r8,9.7431e-08_r8/) + kbo(:,59, 3) = (/ & + &2.8131e-08_r8,3.2653e-08_r8,3.8986e-08_r8,5.5678e-08_r8,7.6933e-08_r8/) + kbo(:,13, 4) = (/ & + &1.2375e-03_r8,1.3907e-03_r8,1.6848e-03_r8,2.0764e-03_r8,2.5455e-03_r8/) + kbo(:,14, 4) = (/ & + &1.0352e-03_r8,1.1626e-03_r8,1.4153e-03_r8,1.7410e-03_r8,2.1410e-03_r8/) + kbo(:,15, 4) = (/ & + &8.6916e-04_r8,9.7450e-04_r8,1.1918e-03_r8,1.4617e-03_r8,1.8090e-03_r8/) + kbo(:,16, 4) = (/ & + &7.1556e-04_r8,8.1812e-04_r8,1.0040e-03_r8,1.2311e-03_r8,1.5286e-03_r8/) + kbo(:,17, 4) = (/ & + &5.8965e-04_r8,6.8521e-04_r8,8.4372e-04_r8,1.0375e-03_r8,1.2976e-03_r8/) + kbo(:,18, 4) = (/ & + &4.8726e-04_r8,5.7342e-04_r8,7.0979e-04_r8,8.7350e-04_r8,1.0996e-03_r8/) + kbo(:,19, 4) = (/ & + &4.0346e-04_r8,4.7923e-04_r8,5.9512e-04_r8,7.3474e-04_r8,9.2909e-04_r8/) + kbo(:,20, 4) = (/ & + &3.3252e-04_r8,4.0340e-04_r8,5.0129e-04_r8,6.2120e-04_r8,7.8738e-04_r8/) + kbo(:,21, 4) = (/ & + &2.7824e-04_r8,3.3959e-04_r8,4.2206e-04_r8,5.2456e-04_r8,6.6651e-04_r8/) + kbo(:,22, 4) = (/ & + &2.3686e-04_r8,2.9111e-04_r8,3.6067e-04_r8,4.4836e-04_r8,5.7225e-04_r8/) + kbo(:,23, 4) = (/ & + &2.0203e-04_r8,2.4985e-04_r8,3.0880e-04_r8,3.8545e-04_r8,4.9113e-04_r8/) + kbo(:,24, 4) = (/ & + &1.7215e-04_r8,2.1409e-04_r8,2.6491e-04_r8,3.3340e-04_r8,4.2129e-04_r8/) + kbo(:,25, 4) = (/ & + &1.4744e-04_r8,1.8341e-04_r8,2.2761e-04_r8,2.8826e-04_r8,3.6138e-04_r8/) + kbo(:,26, 4) = (/ & + &1.2712e-04_r8,1.5795e-04_r8,1.9671e-04_r8,2.5046e-04_r8,3.1109e-04_r8/) + kbo(:,27, 4) = (/ & + &1.1012e-04_r8,1.3626e-04_r8,1.6969e-04_r8,2.1697e-04_r8,2.6764e-04_r8/) + kbo(:,28, 4) = (/ & + &9.5268e-05_r8,1.1775e-04_r8,1.4811e-04_r8,1.8739e-04_r8,2.3002e-04_r8/) + kbo(:,29, 4) = (/ & + &8.1990e-05_r8,1.0183e-04_r8,1.2887e-04_r8,1.6155e-04_r8,1.9779e-04_r8/) + kbo(:,30, 4) = (/ & + &7.0812e-05_r8,8.8197e-05_r8,1.1209e-04_r8,1.3932e-04_r8,1.6990e-04_r8/) + kbo(:,31, 4) = (/ & + &6.1297e-05_r8,7.6242e-05_r8,9.7371e-05_r8,1.2004e-04_r8,1.4578e-04_r8/) + kbo(:,32, 4) = (/ & + &5.3068e-05_r8,6.6743e-05_r8,8.4358e-05_r8,1.0341e-04_r8,1.2514e-04_r8/) + kbo(:,33, 4) = (/ & + &4.6021e-05_r8,5.8210e-05_r8,7.2823e-05_r8,8.9095e-05_r8,1.0732e-04_r8/) + kbo(:,34, 4) = (/ & + &3.9611e-05_r8,5.0325e-05_r8,6.2484e-05_r8,7.6131e-05_r8,9.1418e-05_r8/) + kbo(:,35, 4) = (/ & + &3.3314e-05_r8,4.2493e-05_r8,5.2519e-05_r8,6.3851e-05_r8,7.6543e-05_r8/) + kbo(:,36, 4) = (/ & + &2.7397e-05_r8,3.4956e-05_r8,4.3170e-05_r8,5.2466e-05_r8,6.2879e-05_r8/) + kbo(:,37, 4) = (/ & + &2.1842e-05_r8,2.7769e-05_r8,3.4424e-05_r8,4.1912e-05_r8,5.0314e-05_r8/) + kbo(:,38, 4) = (/ & + &1.7352e-05_r8,2.1971e-05_r8,2.7389e-05_r8,3.3429e-05_r8,4.0195e-05_r8/) + kbo(:,39, 4) = (/ & + &1.3770e-05_r8,1.7414e-05_r8,2.1778e-05_r8,2.6648e-05_r8,3.2100e-05_r8/) + kbo(:,40, 4) = (/ & + &1.0696e-05_r8,1.3450e-05_r8,1.6968e-05_r8,2.0795e-05_r8,2.5164e-05_r8/) + kbo(:,41, 4) = (/ & + &8.2926e-06_r8,1.0301e-05_r8,1.3150e-05_r8,1.6196e-05_r8,1.9663e-05_r8/) + kbo(:,42, 4) = (/ & + &6.4321e-06_r8,7.9930e-06_r8,1.0153e-05_r8,1.2599e-05_r8,1.5345e-05_r8/) + kbo(:,43, 4) = (/ & + &4.9294e-06_r8,6.1147e-06_r8,7.7222e-06_r8,9.6711e-06_r8,1.1840e-05_r8/) + kbo(:,44, 4) = (/ & + &3.7796e-06_r8,4.6518e-06_r8,5.8136e-06_r8,7.3808e-06_r8,9.0677e-06_r8/) + kbo(:,45, 4) = (/ & + &2.8649e-06_r8,3.5446e-06_r8,4.4045e-06_r8,5.6003e-06_r8,6.9419e-06_r8/) + kbo(:,46, 4) = (/ & + &2.1636e-06_r8,2.6897e-06_r8,3.3348e-06_r8,4.2109e-06_r8,5.2785e-06_r8/) + kbo(:,47, 4) = (/ & + &1.6423e-06_r8,2.0325e-06_r8,2.5019e-06_r8,3.1092e-06_r8,3.9697e-06_r8/) + kbo(:,48, 4) = (/ & + &1.2438e-06_r8,1.5176e-06_r8,1.8805e-06_r8,2.3386e-06_r8,2.9598e-06_r8/) + kbo(:,49, 4) = (/ & + &9.6637e-07_r8,1.1421e-06_r8,1.4184e-06_r8,1.7520e-06_r8,2.2027e-06_r8/) + kbo(:,50, 4) = (/ & + &7.6681e-07_r8,8.7015e-07_r8,1.0718e-06_r8,1.3233e-06_r8,1.6436e-06_r8/) + kbo(:,51, 4) = (/ & + &5.7638e-07_r8,6.6674e-07_r8,8.0765e-07_r8,1.0019e-06_r8,1.2448e-06_r8/) + kbo(:,52, 4) = (/ & + &4.3579e-07_r8,5.2641e-07_r8,6.1480e-07_r8,7.6360e-07_r8,9.4101e-07_r8/) + kbo(:,53, 4) = (/ & + &3.2630e-07_r8,4.1175e-07_r8,4.6866e-07_r8,5.7670e-07_r8,7.1273e-07_r8/) + kbo(:,54, 4) = (/ & + &2.4508e-07_r8,3.1226e-07_r8,3.6234e-07_r8,4.3785e-07_r8,5.4334e-07_r8/) + kbo(:,55, 4) = (/ & + &1.8867e-07_r8,2.3849e-07_r8,2.8812e-07_r8,3.3656e-07_r8,4.1795e-07_r8/) + kbo(:,56, 4) = (/ & + &1.3888e-07_r8,1.8052e-07_r8,2.2770e-07_r8,2.5896e-07_r8,3.1922e-07_r8/) + kbo(:,57, 4) = (/ & + &9.9211e-08_r8,1.3628e-07_r8,1.7309e-07_r8,2.0040e-07_r8,2.4315e-07_r8/) + kbo(:,58, 4) = (/ & + &7.2311e-08_r8,1.0440e-07_r8,1.3249e-07_r8,1.5839e-07_r8,1.8707e-07_r8/) + kbo(:,59, 4) = (/ & + &5.6449e-08_r8,8.3969e-08_r8,1.0579e-07_r8,1.2870e-07_r8,1.4987e-07_r8/) + kbo(:,13, 5) = (/ & + &2.0768e-03_r8,2.8684e-03_r8,3.7718e-03_r8,4.8192e-03_r8,6.0412e-03_r8/) + kbo(:,14, 5) = (/ & + &1.7564e-03_r8,2.4332e-03_r8,3.1824e-03_r8,4.0625e-03_r8,5.0889e-03_r8/) + kbo(:,15, 5) = (/ & + &1.4908e-03_r8,2.0712e-03_r8,2.6934e-03_r8,3.4353e-03_r8,4.2909e-03_r8/) + kbo(:,16, 5) = (/ & + &1.2837e-03_r8,1.7624e-03_r8,2.2850e-03_r8,2.9120e-03_r8,3.6366e-03_r8/) + kbo(:,17, 5) = (/ & + &1.1007e-03_r8,1.4970e-03_r8,1.9372e-03_r8,2.4633e-03_r8,3.0868e-03_r8/) + kbo(:,18, 5) = (/ & + &9.3998e-04_r8,1.2697e-03_r8,1.6378e-03_r8,2.0802e-03_r8,2.6082e-03_r8/) + kbo(:,19, 5) = (/ & + &8.0100e-04_r8,1.0742e-03_r8,1.3849e-03_r8,1.7569e-03_r8,2.2030e-03_r8/) + kbo(:,20, 5) = (/ & + &6.8663e-04_r8,9.1195e-04_r8,1.1757e-03_r8,1.4883e-03_r8,1.8647e-03_r8/) + kbo(:,21, 5) = (/ & + &5.8705e-04_r8,7.7399e-04_r8,9.9752e-04_r8,1.2607e-03_r8,1.5771e-03_r8/) + kbo(:,22, 5) = (/ & + &5.1050e-04_r8,6.6826e-04_r8,8.5880e-04_r8,1.0835e-03_r8,1.3514e-03_r8/) + kbo(:,23, 5) = (/ & + &4.4216e-04_r8,5.7700e-04_r8,7.3906e-04_r8,9.3102e-04_r8,1.1572e-03_r8/) + kbo(:,24, 5) = (/ & + &3.8397e-04_r8,4.9926e-04_r8,6.3682e-04_r8,8.0099e-04_r8,9.9155e-04_r8/) + kbo(:,25, 5) = (/ & + &3.3452e-04_r8,4.3352e-04_r8,5.4972e-04_r8,6.8946e-04_r8,8.5204e-04_r8/) + kbo(:,26, 5) = (/ & + &2.9253e-04_r8,3.7705e-04_r8,4.7637e-04_r8,5.9546e-04_r8,7.3410e-04_r8/) + kbo(:,27, 5) = (/ & + &2.5516e-04_r8,3.2740e-04_r8,4.1271e-04_r8,5.1423e-04_r8,6.3183e-04_r8/) + kbo(:,28, 5) = (/ & + &2.2216e-04_r8,2.8389e-04_r8,3.5748e-04_r8,4.4367e-04_r8,5.4344e-04_r8/) + kbo(:,29, 5) = (/ & + &1.9425e-04_r8,2.4642e-04_r8,3.0966e-04_r8,3.8285e-04_r8,4.6743e-04_r8/) + kbo(:,30, 5) = (/ & + &1.6916e-04_r8,2.1405e-04_r8,2.6782e-04_r8,3.3008e-04_r8,4.0176e-04_r8/) + kbo(:,31, 5) = (/ & + &1.4722e-04_r8,1.8596e-04_r8,2.3162e-04_r8,2.8455e-04_r8,3.4535e-04_r8/) + kbo(:,32, 5) = (/ & + &1.2822e-04_r8,1.6146e-04_r8,2.0021e-04_r8,2.4528e-04_r8,2.9677e-04_r8/) + kbo(:,33, 5) = (/ & + &1.1158e-04_r8,1.4011e-04_r8,1.7313e-04_r8,2.1133e-04_r8,2.5496e-04_r8/) + kbo(:,34, 5) = (/ & + &9.6356e-05_r8,1.2055e-04_r8,1.4854e-04_r8,1.8079e-04_r8,2.1758e-04_r8/) + kbo(:,35, 5) = (/ & + &8.1343e-05_r8,1.0151e-04_r8,1.2490e-04_r8,1.5178e-04_r8,1.8239e-04_r8/) + kbo(:,36, 5) = (/ & + &6.6965e-05_r8,8.3520e-05_r8,1.0275e-04_r8,1.2482e-04_r8,1.4993e-04_r8/) + kbo(:,37, 5) = (/ & + &5.3206e-05_r8,6.6545e-05_r8,8.1990e-05_r8,9.9764e-05_r8,1.2001e-04_r8/) + kbo(:,38, 5) = (/ & + &4.2208e-05_r8,5.2902e-05_r8,6.5299e-05_r8,7.9577e-05_r8,9.5895e-05_r8/) + kbo(:,39, 5) = (/ & + &3.3472e-05_r8,4.2041e-05_r8,5.1984e-05_r8,6.3462e-05_r8,7.6593e-05_r8/) + kbo(:,40, 5) = (/ & + &2.5925e-05_r8,3.2660e-05_r8,4.0509e-05_r8,4.9627e-05_r8,6.0037e-05_r8/) + kbo(:,41, 5) = (/ & + &2.0003e-05_r8,2.5267e-05_r8,3.1469e-05_r8,3.8672e-05_r8,4.6923e-05_r8/) + kbo(:,42, 5) = (/ & + &1.5411e-05_r8,1.9519e-05_r8,2.4420e-05_r8,3.0101e-05_r8,3.6637e-05_r8/) + kbo(:,43, 5) = (/ & + &1.1687e-05_r8,1.4867e-05_r8,1.8698e-05_r8,2.3140e-05_r8,2.8269e-05_r8/) + kbo(:,44, 5) = (/ & + &8.7679e-06_r8,1.1261e-05_r8,1.4209e-05_r8,1.7673e-05_r8,2.1693e-05_r8/) + kbo(:,45, 5) = (/ & + &6.5931e-06_r8,8.5087e-06_r8,1.0776e-05_r8,1.3478e-05_r8,1.6614e-05_r8/) + kbo(:,46, 5) = (/ & + &4.9080e-06_r8,6.3755e-06_r8,8.1160e-06_r8,1.0213e-05_r8,1.2647e-05_r8/) + kbo(:,47, 5) = (/ & + &3.5919e-06_r8,4.7038e-06_r8,6.0534e-06_r8,7.6485e-06_r8,9.5281e-06_r8/) + kbo(:,48, 5) = (/ & + &2.6062e-06_r8,3.4739e-06_r8,4.4987e-06_r8,5.7085e-06_r8,7.1618e-06_r8/) + kbo(:,49, 5) = (/ & + &1.8621e-06_r8,2.5496e-06_r8,3.3246e-06_r8,4.2578e-06_r8,5.3684e-06_r8/) + kbo(:,50, 5) = (/ & + &1.3311e-06_r8,1.8748e-06_r8,2.4717e-06_r8,3.1893e-06_r8,4.0386e-06_r8/) + kbo(:,51, 5) = (/ & + &9.8374e-07_r8,1.3665e-06_r8,1.8393e-06_r8,2.3887e-06_r8,3.0388e-06_r8/) + kbo(:,52, 5) = (/ & + &7.2293e-07_r8,9.8525e-07_r8,1.3616e-06_r8,1.7795e-06_r8,2.2858e-06_r8/) + kbo(:,53, 5) = (/ & + &5.3539e-07_r8,7.1322e-07_r8,1.0025e-06_r8,1.3275e-06_r8,1.7157e-06_r8/) + kbo(:,54, 5) = (/ & + &3.9532e-07_r8,5.3074e-07_r8,7.3585e-07_r8,9.9485e-07_r8,1.2941e-06_r8/) + kbo(:,55, 5) = (/ & + &2.9574e-07_r8,3.9534e-07_r8,5.3898e-07_r8,7.4534e-07_r8,9.7510e-07_r8/) + kbo(:,56, 5) = (/ & + &2.2158e-07_r8,2.9575e-07_r8,3.9553e-07_r8,5.5662e-07_r8,7.3612e-07_r8/) + kbo(:,57, 5) = (/ & + &1.7387e-07_r8,2.1999e-07_r8,2.9597e-07_r8,4.1152e-07_r8,5.5434e-07_r8/) + kbo(:,58, 5) = (/ & + &1.3813e-07_r8,1.6569e-07_r8,2.2197e-07_r8,3.0386e-07_r8,4.1774e-07_r8/) + kbo(:,59, 5) = (/ & + &1.1153e-07_r8,1.3014e-07_r8,1.7513e-07_r8,2.3832e-07_r8,3.3096e-07_r8/) + kbo(:,13, 6) = (/ & + &6.2563e-03_r8,8.5754e-03_r8,1.1313e-02_r8,1.4562e-02_r8,1.8439e-02_r8/) + kbo(:,14, 6) = (/ & + &5.3407e-03_r8,7.2874e-03_r8,9.6031e-03_r8,1.2344e-02_r8,1.5616e-02_r8/) + kbo(:,15, 6) = (/ & + &4.5624e-03_r8,6.2026e-03_r8,8.1616e-03_r8,1.0480e-02_r8,1.3236e-02_r8/) + kbo(:,16, 6) = (/ & + &3.8957e-03_r8,5.2793e-03_r8,6.9259e-03_r8,8.8846e-03_r8,1.1202e-02_r8/) + kbo(:,17, 6) = (/ & + &3.3209e-03_r8,4.4815e-03_r8,5.8698e-03_r8,7.5204e-03_r8,9.4486e-03_r8/) + kbo(:,18, 6) = (/ & + &2.8290e-03_r8,3.8089e-03_r8,4.9773e-03_r8,6.3684e-03_r8,7.9890e-03_r8/) + kbo(:,19, 6) = (/ & + &2.4112e-03_r8,3.2462e-03_r8,4.2316e-03_r8,5.4060e-03_r8,6.7720e-03_r8/) + kbo(:,20, 6) = (/ & + &2.0691e-03_r8,2.7791e-03_r8,3.6122e-03_r8,4.6028e-03_r8,5.7715e-03_r8/) + kbo(:,21, 6) = (/ & + &1.7739e-03_r8,2.3724e-03_r8,3.0729e-03_r8,3.9123e-03_r8,4.9081e-03_r8/) + kbo(:,22, 6) = (/ & + &1.5468e-03_r8,2.0535e-03_r8,2.6512e-03_r8,3.3770e-03_r8,4.2260e-03_r8/) + kbo(:,23, 6) = (/ & + &1.3475e-03_r8,1.7768e-03_r8,2.2959e-03_r8,2.9141e-03_r8,3.6373e-03_r8/) + kbo(:,24, 6) = (/ & + &1.1752e-03_r8,1.5439e-03_r8,1.9895e-03_r8,2.5170e-03_r8,3.1328e-03_r8/) + kbo(:,25, 6) = (/ & + &1.0263e-03_r8,1.3444e-03_r8,1.7264e-03_r8,2.1761e-03_r8,2.6990e-03_r8/) + kbo(:,26, 6) = (/ & + &9.0166e-04_r8,1.1758e-03_r8,1.5031e-03_r8,1.8871e-03_r8,2.3306e-03_r8/) + kbo(:,27, 6) = (/ & + &7.9141e-04_r8,1.0269e-03_r8,1.3074e-03_r8,1.6348e-03_r8,2.0092e-03_r8/) + kbo(:,28, 6) = (/ & + &6.9371e-04_r8,8.9592e-04_r8,1.1355e-03_r8,1.4137e-03_r8,1.7327e-03_r8/) + kbo(:,29, 6) = (/ & + &6.0795e-04_r8,7.8166e-04_r8,9.8572e-04_r8,1.2233e-03_r8,1.4938e-03_r8/) + kbo(:,30, 6) = (/ & + &5.3230e-04_r8,6.8106e-04_r8,8.5522e-04_r8,1.0576e-03_r8,1.2859e-03_r8/) + kbo(:,31, 6) = (/ & + &4.6592e-04_r8,5.9303e-04_r8,7.4221e-04_r8,9.1346e-04_r8,1.1061e-03_r8/) + kbo(:,32, 6) = (/ & + &4.0751e-04_r8,5.1643e-04_r8,6.4366e-04_r8,7.8848e-04_r8,9.5095e-04_r8/) + kbo(:,33, 6) = (/ & + &3.5610e-04_r8,4.4934e-04_r8,5.5753e-04_r8,6.8015e-04_r8,8.1668e-04_r8/) + kbo(:,34, 6) = (/ & + &3.0849e-04_r8,3.8773e-04_r8,4.7909e-04_r8,5.8242e-04_r8,6.9697e-04_r8/) + kbo(:,35, 6) = (/ & + &2.6100e-04_r8,3.2729e-04_r8,4.0344e-04_r8,4.8961e-04_r8,5.8449e-04_r8/) + kbo(:,36, 6) = (/ & + &2.1525e-04_r8,2.6972e-04_r8,3.3236e-04_r8,4.0320e-04_r8,4.8106e-04_r8/) + kbo(:,37, 6) = (/ & + &1.7127e-04_r8,2.1505e-04_r8,2.6562e-04_r8,3.2288e-04_r8,3.8605e-04_r8/) + kbo(:,38, 6) = (/ & + &1.3592e-04_r8,1.7107e-04_r8,2.1184e-04_r8,2.5803e-04_r8,3.0917e-04_r8/) + kbo(:,39, 6) = (/ & + &1.0785e-04_r8,1.3607e-04_r8,1.6885e-04_r8,2.0614e-04_r8,2.4755e-04_r8/) + kbo(:,40, 6) = (/ & + &8.3445e-05_r8,1.0573e-04_r8,1.3174e-04_r8,1.6145e-04_r8,1.9465e-04_r8/) + kbo(:,41, 6) = (/ & + &6.4274e-05_r8,8.1836e-05_r8,1.0238e-04_r8,1.2600e-04_r8,1.5256e-04_r8/) + kbo(:,42, 6) = (/ & + &4.9425e-05_r8,6.3242e-05_r8,7.9461e-05_r8,9.8197e-05_r8,1.1940e-04_r8/) + kbo(:,43, 6) = (/ & + &3.7393e-05_r8,4.8142e-05_r8,6.0818e-05_r8,7.5575e-05_r8,9.2337e-05_r8/) + kbo(:,44, 6) = (/ & + &2.8031e-05_r8,3.6364e-05_r8,4.6223e-05_r8,5.7754e-05_r8,7.0960e-05_r8/) + kbo(:,45, 6) = (/ & + &2.0952e-05_r8,2.7396e-05_r8,3.5050e-05_r8,4.4048e-05_r8,5.4413e-05_r8/) + kbo(:,46, 6) = (/ & + &1.5504e-05_r8,2.0469e-05_r8,2.6380e-05_r8,3.3353e-05_r8,4.1465e-05_r8/) + kbo(:,47, 6) = (/ & + &1.1285e-05_r8,1.5071e-05_r8,1.9596e-05_r8,2.4961e-05_r8,3.1243e-05_r8/) + kbo(:,48, 6) = (/ & + &8.1713e-06_r8,1.1048e-05_r8,1.4507e-05_r8,1.8626e-05_r8,2.3478e-05_r8/) + kbo(:,49, 6) = (/ & + &5.8892e-06_r8,8.0594e-06_r8,1.0700e-05_r8,1.3854e-05_r8,1.7591e-05_r8/) + kbo(:,50, 6) = (/ & + &4.2527e-06_r8,5.8989e-06_r8,7.9160e-06_r8,1.0341e-05_r8,1.3223e-05_r8/) + kbo(:,51, 6) = (/ & + &3.0672e-06_r8,4.3146e-06_r8,5.8537e-06_r8,7.7179e-06_r8,9.9420e-06_r8/) + kbo(:,52, 6) = (/ & + &2.1919e-06_r8,3.1415e-06_r8,4.3130e-06_r8,5.7435e-06_r8,7.4576e-06_r8/) + kbo(:,53, 6) = (/ & + &1.5489e-06_r8,2.2740e-06_r8,3.1638e-06_r8,4.2575e-06_r8,5.5767e-06_r8/) + kbo(:,54, 6) = (/ & + &1.1055e-06_r8,1.6569e-06_r8,2.3353e-06_r8,3.1738e-06_r8,4.1929e-06_r8/) + kbo(:,55, 6) = (/ & + &7.7959e-07_r8,1.2025e-06_r8,1.7241e-06_r8,2.3677e-06_r8,3.1567e-06_r8/) + kbo(:,56, 6) = (/ & + &5.5393e-07_r8,8.6666e-07_r8,1.2673e-06_r8,1.7619e-06_r8,2.3695e-06_r8/) + kbo(:,57, 6) = (/ & + &3.8362e-07_r8,6.2174e-07_r8,9.3002e-07_r8,1.3068e-06_r8,1.7740e-06_r8/) + kbo(:,58, 6) = (/ & + &2.6381e-07_r8,4.4330e-07_r8,6.7991e-07_r8,9.7066e-07_r8,1.3310e-06_r8/) + kbo(:,59, 6) = (/ & + &2.0120e-07_r8,3.4415e-07_r8,5.3237e-07_r8,7.6501e-07_r8,1.0533e-06_r8/) + kbo(:,13, 7) = (/ & + &1.9678e-02_r8,2.7339e-02_r8,3.6693e-02_r8,4.7583e-02_r8,5.9838e-02_r8/) + kbo(:,14, 7) = (/ & + &1.6855e-02_r8,2.3332e-02_r8,3.1200e-02_r8,4.0354e-02_r8,5.0549e-02_r8/) + kbo(:,15, 7) = (/ & + &1.4447e-02_r8,1.9926e-02_r8,2.6539e-02_r8,3.4203e-02_r8,4.2741e-02_r8/) + kbo(:,16, 7) = (/ & + &1.2375e-02_r8,1.7007e-02_r8,2.2570e-02_r8,2.9011e-02_r8,3.6155e-02_r8/) + kbo(:,17, 7) = (/ & + &1.0572e-02_r8,1.4480e-02_r8,1.9148e-02_r8,2.4557e-02_r8,3.0543e-02_r8/) + kbo(:,18, 7) = (/ & + &9.0187e-03_r8,1.2308e-02_r8,1.6230e-02_r8,2.0762e-02_r8,2.5754e-02_r8/) + kbo(:,19, 7) = (/ & + &7.6960e-03_r8,1.0462e-02_r8,1.3757e-02_r8,1.7553e-02_r8,2.1712e-02_r8/) + kbo(:,20, 7) = (/ & + &6.5947e-03_r8,8.9295e-03_r8,1.1707e-02_r8,1.4880e-02_r8,1.8332e-02_r8/) + kbo(:,21, 7) = (/ & + &5.6518e-03_r8,7.6362e-03_r8,9.9897e-03_r8,1.2646e-02_r8,1.5515e-02_r8/) + kbo(:,22, 7) = (/ & + &4.9551e-03_r8,6.6562e-03_r8,8.6611e-03_r8,1.0883e-02_r8,1.3285e-02_r8/) + kbo(:,23, 7) = (/ & + &4.3463e-03_r8,5.8019e-03_r8,7.4874e-03_r8,9.3424e-03_r8,1.1393e-02_r8/) + kbo(:,24, 7) = (/ & + &3.8088e-03_r8,5.0439e-03_r8,6.4617e-03_r8,8.0406e-03_r8,9.7631e-03_r8/) + kbo(:,25, 7) = (/ & + &3.3364e-03_r8,4.3855e-03_r8,5.5891e-03_r8,6.9199e-03_r8,8.3730e-03_r8/) + kbo(:,26, 7) = (/ & + &2.9302e-03_r8,3.8269e-03_r8,4.8484e-03_r8,5.9724e-03_r8,7.1930e-03_r8/) + kbo(:,27, 7) = (/ & + &2.5694e-03_r8,3.3414e-03_r8,4.2035e-03_r8,5.1445e-03_r8,6.1710e-03_r8/) + kbo(:,28, 7) = (/ & + &2.2557e-03_r8,2.9117e-03_r8,3.6362e-03_r8,4.4284e-03_r8,5.2859e-03_r8/) + kbo(:,29, 7) = (/ & + &1.9791e-03_r8,2.5337e-03_r8,3.1431e-03_r8,3.8083e-03_r8,4.5227e-03_r8/) + kbo(:,30, 7) = (/ & + &1.7348e-03_r8,2.2004e-03_r8,2.7128e-03_r8,3.2695e-03_r8,3.8671e-03_r8/) + kbo(:,31, 7) = (/ & + &1.5168e-03_r8,1.9090e-03_r8,2.3389e-03_r8,2.8042e-03_r8,3.3063e-03_r8/) + kbo(:,32, 7) = (/ & + &1.3245e-03_r8,1.6546e-03_r8,2.0148e-03_r8,2.4067e-03_r8,2.8256e-03_r8/) + kbo(:,33, 7) = (/ & + &1.1547e-03_r8,1.4322e-03_r8,1.7355e-03_r8,2.0639e-03_r8,2.4127e-03_r8/) + kbo(:,34, 7) = (/ & + &9.9732e-04_r8,1.2299e-03_r8,1.4851e-03_r8,1.7585e-03_r8,2.0486e-03_r8/) + kbo(:,35, 7) = (/ & + &8.4240e-04_r8,1.0365e-03_r8,1.2482e-03_r8,1.4745e-03_r8,1.7149e-03_r8/) + kbo(:,36, 7) = (/ & + &6.9459e-04_r8,8.5479e-04_r8,1.0290e-03_r8,1.2151e-03_r8,1.4131e-03_r8/) + kbo(:,37, 7) = (/ & + &5.5418e-04_r8,6.8431e-04_r8,8.2605e-04_r8,9.7772e-04_r8,1.1393e-03_r8/) + kbo(:,38, 7) = (/ & + &4.4103e-04_r8,5.4666e-04_r8,6.6164e-04_r8,7.8531e-04_r8,9.1717e-04_r8/) + kbo(:,39, 7) = (/ & + &3.5078e-04_r8,4.3647e-04_r8,5.2986e-04_r8,6.3056e-04_r8,7.3809e-04_r8/) + kbo(:,40, 7) = (/ & + &2.7223e-04_r8,3.4099e-04_r8,4.1623e-04_r8,4.9763e-04_r8,5.8479e-04_r8/) + kbo(:,41, 7) = (/ & + &2.1016e-04_r8,2.6529e-04_r8,3.2578e-04_r8,3.9146e-04_r8,4.6190e-04_r8/) + kbo(:,42, 7) = (/ & + &1.6186e-04_r8,2.0599e-04_r8,2.5454e-04_r8,3.0749e-04_r8,3.6441e-04_r8/) + kbo(:,43, 7) = (/ & + &1.2244e-04_r8,1.5755e-04_r8,1.9631e-04_r8,2.3871e-04_r8,2.8458e-04_r8/) + kbo(:,44, 7) = (/ & + &9.1656e-05_r8,1.1940e-04_r8,1.5021e-04_r8,1.8408e-04_r8,2.2084e-04_r8/) + kbo(:,45, 7) = (/ & + &6.8343e-05_r8,9.0130e-05_r8,1.1460e-04_r8,1.4155e-04_r8,1.7102e-04_r8/) + kbo(:,46, 7) = (/ & + &5.0438e-05_r8,6.7336e-05_r8,8.6692e-05_r8,1.0813e-04_r8,1.3160e-04_r8/) + kbo(:,47, 7) = (/ & + &3.6553e-05_r8,4.9462e-05_r8,6.4648e-05_r8,8.1563e-05_r8,1.0018e-04_r8/) + kbo(:,48, 7) = (/ & + &2.6343e-05_r8,3.6142e-05_r8,4.7933e-05_r8,6.1264e-05_r8,7.5986e-05_r8/) + kbo(:,49, 7) = (/ & + &1.8866e-05_r8,2.6263e-05_r8,3.5311e-05_r8,4.5778e-05_r8,5.7425e-05_r8/) + kbo(:,50, 7) = (/ & + &1.3557e-05_r8,1.9139e-05_r8,2.6064e-05_r8,3.4268e-05_r8,4.3473e-05_r8/) + kbo(:,51, 7) = (/ & + &9.7297e-06_r8,1.3926e-05_r8,1.9216e-05_r8,2.5597e-05_r8,3.2867e-05_r8/) + kbo(:,52, 7) = (/ & + &6.9563e-06_r8,1.0085e-05_r8,1.4103e-05_r8,1.9022e-05_r8,2.4754e-05_r8/) + kbo(:,53, 7) = (/ & + &4.9502e-06_r8,7.2644e-06_r8,1.0302e-05_r8,1.4070e-05_r8,1.8558e-05_r8/) + kbo(:,54, 7) = (/ & + &3.5499e-06_r8,5.2696e-06_r8,7.5685e-06_r8,1.0462e-05_r8,1.3965e-05_r8/) + kbo(:,55, 7) = (/ & + &2.5517e-06_r8,3.8332e-06_r8,5.5671e-06_r8,7.7870e-06_r8,1.0502e-05_r8/) + kbo(:,56, 7) = (/ & + &1.8250e-06_r8,2.7802e-06_r8,4.0807e-06_r8,5.7760e-06_r8,7.8765e-06_r8/) + kbo(:,57, 7) = (/ & + &1.3020e-06_r8,2.0096e-06_r8,2.9783e-06_r8,4.2688e-06_r8,5.8872e-06_r8/) + kbo(:,58, 7) = (/ & + &9.3216e-07_r8,1.4580e-06_r8,2.1842e-06_r8,3.1634e-06_r8,4.4097e-06_r8/) + kbo(:,59, 7) = (/ & + &7.2634e-07_r8,1.1405e-06_r8,1.7167e-06_r8,2.4950e-06_r8,3.4919e-06_r8/) + kbo(:,13, 8) = (/ & + &6.7703e-02_r8,9.1028e-02_r8,1.1838e-01_r8,1.4990e-01_r8,1.8559e-01_r8/) + kbo(:,14, 8) = (/ & + &5.8222e-02_r8,7.8007e-02_r8,1.0118e-01_r8,1.2784e-01_r8,1.5811e-01_r8/) + kbo(:,15, 8) = (/ & + &5.0069e-02_r8,6.6838e-02_r8,8.6469e-02_r8,1.0901e-01_r8,1.3468e-01_r8/) + kbo(:,16, 8) = (/ & + &4.3038e-02_r8,5.7247e-02_r8,7.3838e-02_r8,9.2876e-02_r8,1.1462e-01_r8/) + kbo(:,17, 8) = (/ & + &3.6905e-02_r8,4.8922e-02_r8,6.2921e-02_r8,7.8980e-02_r8,9.7249e-02_r8/) + kbo(:,18, 8) = (/ & + &3.1539e-02_r8,4.1670e-02_r8,5.3450e-02_r8,6.6951e-02_r8,8.2335e-02_r8/) + kbo(:,19, 8) = (/ & + &2.6840e-02_r8,3.5366e-02_r8,4.5264e-02_r8,5.6569e-02_r8,6.9496e-02_r8/) + kbo(:,20, 8) = (/ & + &2.2918e-02_r8,3.0090e-02_r8,3.8404e-02_r8,4.7928e-02_r8,5.8831e-02_r8/) + kbo(:,21, 8) = (/ & + &1.9556e-02_r8,2.5586e-02_r8,3.2570e-02_r8,4.0587e-02_r8,4.9753e-02_r8/) + kbo(:,22, 8) = (/ & + &1.6988e-02_r8,2.2111e-02_r8,2.8028e-02_r8,3.4852e-02_r8,4.2609e-02_r8/) + kbo(:,23, 8) = (/ & + &1.4811e-02_r8,1.9201e-02_r8,2.4269e-02_r8,3.0112e-02_r8,3.6663e-02_r8/) + kbo(:,24, 8) = (/ & + &1.2965e-02_r8,1.6745e-02_r8,2.1118e-02_r8,2.6093e-02_r8,3.1689e-02_r8/) + kbo(:,25, 8) = (/ & + &1.1393e-02_r8,1.4643e-02_r8,1.8383e-02_r8,2.2644e-02_r8,2.7400e-02_r8/) + kbo(:,26, 8) = (/ & + &1.0038e-02_r8,1.2830e-02_r8,1.6015e-02_r8,1.9632e-02_r8,2.3704e-02_r8/) + kbo(:,27, 8) = (/ & + &8.8123e-03_r8,1.1178e-02_r8,1.3890e-02_r8,1.6992e-02_r8,2.0492e-02_r8/) + kbo(:,28, 8) = (/ & + &7.6974e-03_r8,9.7127e-03_r8,1.2040e-02_r8,1.4716e-02_r8,1.7696e-02_r8/) + kbo(:,29, 8) = (/ & + &6.7206e-03_r8,8.4382e-03_r8,1.0458e-02_r8,1.2740e-02_r8,1.5282e-02_r8/) + kbo(:,30, 8) = (/ & + &5.8552e-03_r8,7.3524e-03_r8,9.0759e-03_r8,1.1022e-02_r8,1.3175e-02_r8/) + kbo(:,31, 8) = (/ & + &5.1145e-03_r8,6.3996e-03_r8,7.8758e-03_r8,9.5283e-03_r8,1.1351e-02_r8/) + kbo(:,32, 8) = (/ & + &4.4686e-03_r8,5.5753e-03_r8,6.8326e-03_r8,8.2331e-03_r8,9.7798e-03_r8/) + kbo(:,33, 8) = (/ & + &3.9075e-03_r8,4.8544e-03_r8,5.9240e-03_r8,7.1154e-03_r8,8.4216e-03_r8/) + kbo(:,34, 8) = (/ & + &3.3885e-03_r8,4.1943e-03_r8,5.1017e-03_r8,6.1096e-03_r8,7.2102e-03_r8/) + kbo(:,35, 8) = (/ & + &2.8755e-03_r8,3.5515e-03_r8,4.3142e-03_r8,5.1540e-03_r8,6.0867e-03_r8/) + kbo(:,36, 8) = (/ & + &2.3819e-03_r8,2.9429e-03_r8,3.5744e-03_r8,4.2743e-03_r8,5.0503e-03_r8/) + kbo(:,37, 8) = (/ & + &1.9080e-03_r8,2.3651e-03_r8,2.8794e-03_r8,3.4539e-03_r8,4.0906e-03_r8/) + kbo(:,38, 8) = (/ & + &1.5252e-03_r8,1.8961e-03_r8,2.3154e-03_r8,2.7875e-03_r8,3.3076e-03_r8/) + kbo(:,39, 8) = (/ & + &1.2186e-03_r8,1.5204e-03_r8,1.8625e-03_r8,2.2483e-03_r8,2.6746e-03_r8/) + kbo(:,40, 8) = (/ & + &9.5047e-04_r8,1.1919e-03_r8,1.4679e-03_r8,1.7800e-03_r8,2.1255e-03_r8/) + kbo(:,41, 8) = (/ & + &7.3797e-04_r8,9.3055e-04_r8,1.1523e-03_r8,1.4042e-03_r8,1.6837e-03_r8/) + kbo(:,42, 8) = (/ & + &5.7195e-04_r8,7.2531e-04_r8,9.0341e-04_r8,1.1062e-03_r8,1.3320e-03_r8/) + kbo(:,43, 8) = (/ & + &4.3632e-04_r8,5.5716e-04_r8,6.9866e-04_r8,8.6074e-04_r8,1.0421e-03_r8/) + kbo(:,44, 8) = (/ & + &3.2967e-04_r8,4.2439e-04_r8,5.3607e-04_r8,6.6494e-04_r8,8.0995e-04_r8/) + kbo(:,45, 8) = (/ & + &2.4830e-04_r8,3.2230e-04_r8,4.1025e-04_r8,5.1229e-04_r8,6.2794e-04_r8/) + kbo(:,46, 8) = (/ & + &1.8517e-04_r8,2.4270e-04_r8,3.1143e-04_r8,3.9189e-04_r8,4.8363e-04_r8/) + kbo(:,47, 8) = (/ & + &1.3585e-04_r8,1.8008e-04_r8,2.3317e-04_r8,2.9603e-04_r8,3.6826e-04_r8/) + kbo(:,48, 8) = (/ & + &9.9135e-05_r8,1.3301e-04_r8,1.7388e-04_r8,2.2278e-04_r8,2.7947e-04_r8/) + kbo(:,49, 8) = (/ & + &7.1904e-05_r8,9.7733e-05_r8,1.2918e-04_r8,1.6699e-04_r8,2.1129e-04_r8/) + kbo(:,50, 8) = (/ & + &5.2307e-05_r8,7.2019e-05_r8,9.6216e-05_r8,1.2554e-04_r8,1.6020e-04_r8/) + kbo(:,51, 8) = (/ & + &3.7969e-05_r8,5.2997e-05_r8,7.1620e-05_r8,9.4315e-05_r8,1.2143e-04_r8/) + kbo(:,52, 8) = (/ & + &2.7413e-05_r8,3.8825e-05_r8,5.3093e-05_r8,7.0665e-05_r8,9.1720e-05_r8/) + kbo(:,53, 8) = (/ & + &1.9654e-05_r8,2.8289e-05_r8,3.9179e-05_r8,5.2708e-05_r8,6.9024e-05_r8/) + kbo(:,54, 8) = (/ & + &1.4176e-05_r8,2.0734e-05_r8,2.9077e-05_r8,3.9534e-05_r8,5.2234e-05_r8/) + kbo(:,55, 8) = (/ & + &1.0223e-05_r8,1.5194e-05_r8,2.1592e-05_r8,2.9664e-05_r8,3.9585e-05_r8/) + kbo(:,56, 8) = (/ & + &7.3305e-06_r8,1.1089e-05_r8,1.5976e-05_r8,2.2196e-05_r8,2.9906e-05_r8/) + kbo(:,57, 8) = (/ & + &5.2231e-06_r8,8.0475e-06_r8,1.1769e-05_r8,1.6548e-05_r8,2.2524e-05_r8/) + kbo(:,58, 8) = (/ & + &3.7230e-06_r8,5.8489e-06_r8,8.6848e-06_r8,1.2363e-05_r8,1.6999e-05_r8/) + kbo(:,59, 8) = (/ & + &2.8893e-06_r8,4.5778e-06_r8,6.8447e-06_r8,9.7955e-06_r8,1.3534e-05_r8/) + kbo(:,13, 9) = (/ & + &4.1576e-01_r8,5.6459e-01_r8,7.4208e-01_r8,9.4959e-01_r8,1.1894e+00_r8/) + kbo(:,14, 9) = (/ & + &3.6259e-01_r8,4.8996e-01_r8,6.4236e-01_r8,8.2178e-01_r8,1.0273e+00_r8/) + kbo(:,15, 9) = (/ & + &3.1572e-01_r8,4.2505e-01_r8,5.5650e-01_r8,7.1044e-01_r8,8.8534e-01_r8/) + kbo(:,16, 9) = (/ & + &2.7461e-01_r8,3.6869e-01_r8,4.8148e-01_r8,6.1276e-01_r8,7.6136e-01_r8/) + kbo(:,17, 9) = (/ & + &2.3842e-01_r8,3.1920e-01_r8,4.1566e-01_r8,5.2724e-01_r8,6.5339e-01_r8/) + kbo(:,18, 9) = (/ & + &2.0643e-01_r8,2.7580e-01_r8,3.5808e-01_r8,4.5284e-01_r8,5.5957e-01_r8/) + kbo(:,19, 9) = (/ & + &1.7844e-01_r8,2.3768e-01_r8,3.0746e-01_r8,3.8778e-01_r8,4.7826e-01_r8/) + kbo(:,20, 9) = (/ & + &1.5457e-01_r8,2.0515e-01_r8,2.6455e-01_r8,3.3275e-01_r8,4.0945e-01_r8/) + kbo(:,21, 9) = (/ & + &1.3372e-01_r8,1.7673e-01_r8,2.2718e-01_r8,2.8500e-01_r8,3.5014e-01_r8/) + kbo(:,22, 9) = (/ & + &1.1755e-01_r8,1.5455e-01_r8,1.9772e-01_r8,2.4719e-01_r8,3.0287e-01_r8/) + kbo(:,23, 9) = (/ & + &1.0319e-01_r8,1.3488e-01_r8,1.7188e-01_r8,2.1417e-01_r8,2.6161e-01_r8/) + kbo(:,24, 9) = (/ & + &9.0543e-02_r8,1.1778e-01_r8,1.4943e-01_r8,1.8553e-01_r8,2.2596e-01_r8/) + kbo(:,25, 9) = (/ & + &7.9491e-02_r8,1.0285e-01_r8,1.2998e-01_r8,1.6082e-01_r8,1.9540e-01_r8/) + kbo(:,26, 9) = (/ & + &7.0023e-02_r8,9.0152e-02_r8,1.1342e-01_r8,1.3988e-01_r8,1.6957e-01_r8/) + kbo(:,27, 9) = (/ & + &6.1675e-02_r8,7.9028e-02_r8,9.9049e-02_r8,1.2176e-01_r8,1.4715e-01_r8/) + kbo(:,28, 9) = (/ & + &5.4332e-02_r8,6.9290e-02_r8,8.6538e-02_r8,1.0602e-01_r8,1.2768e-01_r8/) + kbo(:,29, 9) = (/ & + &4.8016e-02_r8,6.0968e-02_r8,7.5734e-02_r8,9.2386e-02_r8,1.1090e-01_r8/) + kbo(:,30, 9) = (/ & + &4.2494e-02_r8,5.3680e-02_r8,6.6413e-02_r8,8.0729e-02_r8,9.6539e-02_r8/) + kbo(:,31, 9) = (/ & + &3.7548e-02_r8,4.7237e-02_r8,5.8255e-02_r8,7.0556e-02_r8,8.4102e-02_r8/) + kbo(:,32, 9) = (/ & + &3.3189e-02_r8,4.1551e-02_r8,5.1044e-02_r8,6.1646e-02_r8,7.3306e-02_r8/) + kbo(:,33, 9) = (/ & + &2.9274e-02_r8,3.6514e-02_r8,4.4704e-02_r8,5.3824e-02_r8,6.3833e-02_r8/) + kbo(:,34, 9) = (/ & + &2.5627e-02_r8,3.1864e-02_r8,3.8903e-02_r8,4.6747e-02_r8,5.5596e-02_r8/) + kbo(:,35, 9) = (/ & + &2.1952e-02_r8,2.7259e-02_r8,3.3247e-02_r8,4.0073e-02_r8,4.7679e-02_r8/) + kbo(:,36, 9) = (/ & + &1.8347e-02_r8,2.2808e-02_r8,2.7904e-02_r8,3.3738e-02_r8,4.0178e-02_r8/) + kbo(:,37, 9) = (/ & + &1.4833e-02_r8,1.8504e-02_r8,2.2807e-02_r8,2.7664e-02_r8,3.3111e-02_r8/) + kbo(:,38, 9) = (/ & + &1.1957e-02_r8,1.5000e-02_r8,1.8592e-02_r8,2.2638e-02_r8,2.7241e-02_r8/) + kbo(:,39, 9) = (/ & + &9.6263e-03_r8,1.2169e-02_r8,1.5133e-02_r8,1.8540e-02_r8,2.2409e-02_r8/) + kbo(:,40, 9) = (/ & + &7.5755e-03_r8,9.6595e-03_r8,1.2095e-02_r8,1.4919e-02_r8,1.8126e-02_r8/) + kbo(:,41, 9) = (/ & + &5.9308e-03_r8,7.6313e-03_r8,9.6291e-03_r8,1.1965e-02_r8,1.4606e-02_r8/) + kbo(:,42, 9) = (/ & + &4.6365e-03_r8,6.0158e-03_r8,7.6539e-03_r8,9.5769e-03_r8,1.1776e-02_r8/) + kbo(:,43, 9) = (/ & + &3.5646e-03_r8,4.6692e-03_r8,5.9951e-03_r8,7.5584e-03_r8,9.3611e-03_r8/) + kbo(:,44, 9) = (/ & + &2.7083e-03_r8,3.5831e-03_r8,4.6545e-03_r8,5.9178e-03_r8,7.3883e-03_r8/) + kbo(:,45, 9) = (/ & + &2.0498e-03_r8,2.7405e-03_r8,3.5962e-03_r8,4.6175e-03_r8,5.8123e-03_r8/) + kbo(:,46, 9) = (/ & + &1.5335e-03_r8,2.0746e-03_r8,2.7520e-03_r8,3.5687e-03_r8,4.5390e-03_r8/) + kbo(:,47, 9) = (/ & + &1.1263e-03_r8,1.5445e-03_r8,2.0740e-03_r8,2.7200e-03_r8,3.4958e-03_r8/) + kbo(:,48, 9) = (/ & + &8.2184e-04_r8,1.1429e-03_r8,1.5538e-03_r8,2.0625e-03_r8,2.6781e-03_r8/) + kbo(:,49, 9) = (/ & + &5.9594e-04_r8,8.3975e-04_r8,1.1570e-03_r8,1.5542e-03_r8,2.0406e-03_r8/) + kbo(:,50, 9) = (/ & + &4.3385e-04_r8,6.1951e-04_r8,8.6528e-04_r8,1.1761e-03_r8,1.5615e-03_r8/) + kbo(:,51, 9) = (/ & + &3.1545e-04_r8,4.5652e-04_r8,6.4640e-04_r8,8.8983e-04_r8,1.1948e-03_r8/) + kbo(:,52, 9) = (/ & + &2.2788e-04_r8,3.3444e-04_r8,4.7984e-04_r8,6.6976e-04_r8,9.1050e-04_r8/) + kbo(:,53, 9) = (/ & + &1.6338e-04_r8,2.4338e-04_r8,3.5401e-04_r8,5.0057e-04_r8,6.8907e-04_r8/) + kbo(:,54, 9) = (/ & + &1.1823e-04_r8,1.7879e-04_r8,2.6356e-04_r8,3.7767e-04_r8,5.2615e-04_r8/) + kbo(:,55, 9) = (/ & + &8.5773e-05_r8,1.3160e-04_r8,1.9666e-04_r8,2.8549e-04_r8,4.0286e-04_r8/) + kbo(:,56, 9) = (/ & + &6.1815e-05_r8,9.6294e-05_r8,1.4602e-04_r8,2.1495e-04_r8,3.0724e-04_r8/) + kbo(:,57, 9) = (/ & + &4.4282e-05_r8,7.0071e-05_r8,1.0785e-04_r8,1.6097e-04_r8,2.3304e-04_r8/) + kbo(:,58, 9) = (/ & + &3.1779e-05_r8,5.1099e-05_r8,7.9795e-05_r8,1.2084e-04_r8,1.7730e-04_r8/) + kbo(:,59, 9) = (/ & + &2.4962e-05_r8,4.0511e-05_r8,6.3843e-05_r8,9.7519e-05_r8,1.4426e-04_r8/) + kbo(:,13,10) = (/ & + &1.8139e+00_r8,2.4724e+00_r8,3.2908e+00_r8,4.2191e+00_r8,5.2351e+00_r8/) + kbo(:,14,10) = (/ & + &1.6219e+00_r8,2.2181e+00_r8,2.9298e+00_r8,3.7301e+00_r8,4.6329e+00_r8/) + kbo(:,15,10) = (/ & + &1.4445e+00_r8,1.9645e+00_r8,2.5717e+00_r8,3.2739e+00_r8,4.0834e+00_r8/) + kbo(:,16,10) = (/ & + &1.2756e+00_r8,1.7196e+00_r8,2.2454e+00_r8,2.8649e+00_r8,3.5710e+00_r8/) + kbo(:,17,10) = (/ & + &1.1121e+00_r8,1.4934e+00_r8,1.9517e+00_r8,2.4879e+00_r8,3.0883e+00_r8/) + kbo(:,18,10) = (/ & + &9.6871e-01_r8,1.2953e+00_r8,1.6900e+00_r8,2.1475e+00_r8,2.6630e+00_r8/) + kbo(:,19,10) = (/ & + &8.4238e-01_r8,1.1243e+00_r8,1.4633e+00_r8,1.8537e+00_r8,2.2906e+00_r8/) + kbo(:,20,10) = (/ & + &7.3459e-01_r8,9.7958e-01_r8,1.2711e+00_r8,1.6026e+00_r8,1.9721e+00_r8/) + kbo(:,21,10) = (/ & + &6.4101e-01_r8,8.5278e-01_r8,1.0998e+00_r8,1.3825e+00_r8,1.6970e+00_r8/) + kbo(:,22,10) = (/ & + &5.6942e-01_r8,7.5220e-01_r8,9.6596e-01_r8,1.2079e+00_r8,1.4762e+00_r8/) + kbo(:,23,10) = (/ & + &5.0503e-01_r8,6.6296e-01_r8,8.4599e-01_r8,1.0531e+00_r8,1.2851e+00_r8/) + kbo(:,24,10) = (/ & + &4.4682e-01_r8,5.8292e-01_r8,7.4005e-01_r8,9.1863e-01_r8,1.1187e+00_r8/) + kbo(:,25,10) = (/ & + &3.9593e-01_r8,5.1361e-01_r8,6.4951e-01_r8,8.0398e-01_r8,9.7427e-01_r8/) + kbo(:,26,10) = (/ & + &3.5212e-01_r8,4.5450e-01_r8,5.7266e-01_r8,7.0571e-01_r8,8.5181e-01_r8/) + kbo(:,27,10) = (/ & + &3.1284e-01_r8,4.0173e-01_r8,5.0408e-01_r8,6.1838e-01_r8,7.4572e-01_r8/) + kbo(:,28,10) = (/ & + &2.7721e-01_r8,3.5447e-01_r8,4.4231e-01_r8,5.4145e-01_r8,6.5404e-01_r8/) + kbo(:,29,10) = (/ & + &2.4517e-01_r8,3.1175e-01_r8,3.8832e-01_r8,4.7588e-01_r8,5.7437e-01_r8/) + kbo(:,30,10) = (/ & + &2.1578e-01_r8,2.7344e-01_r8,3.4039e-01_r8,4.1657e-01_r8,5.0271e-01_r8/) + kbo(:,31,10) = (/ & + &1.9067e-01_r8,2.4099e-01_r8,2.9914e-01_r8,3.6552e-01_r8,4.4046e-01_r8/) + kbo(:,32,10) = (/ & + &1.6874e-01_r8,2.1279e-01_r8,2.6352e-01_r8,3.2154e-01_r8,3.8678e-01_r8/) + kbo(:,33,10) = (/ & + &1.4979e-01_r8,1.8828e-01_r8,2.3277e-01_r8,2.8345e-01_r8,3.4103e-01_r8/) + kbo(:,34,10) = (/ & + &1.3170e-01_r8,1.6528e-01_r8,2.0425e-01_r8,2.4841e-01_r8,2.9642e-01_r8/) + kbo(:,35,10) = (/ & + &1.1324e-01_r8,1.4235e-01_r8,1.7590e-01_r8,2.1287e-01_r8,2.5375e-01_r8/) + kbo(:,36,10) = (/ & + &9.5231e-02_r8,1.1973e-01_r8,1.4778e-01_r8,1.7871e-01_r8,2.1338e-01_r8/) + kbo(:,37,10) = (/ & + &7.7445e-02_r8,9.7552e-02_r8,1.1991e-01_r8,1.4578e-01_r8,1.7559e-01_r8/) + kbo(:,38,10) = (/ & + &6.2913e-02_r8,7.9354e-02_r8,9.7396e-02_r8,1.1872e-01_r8,1.4502e-01_r8/) + kbo(:,39,10) = (/ & + &5.1069e-02_r8,6.4406e-02_r8,7.9431e-02_r8,9.7751e-02_r8,1.1994e-01_r8/) + kbo(:,40,10) = (/ & + &4.0487e-02_r8,5.1192e-02_r8,6.3494e-02_r8,7.8782e-02_r8,9.6672e-02_r8/) + kbo(:,41,10) = (/ & + &3.1933e-02_r8,4.0574e-02_r8,5.0815e-02_r8,6.3454e-02_r8,7.7908e-02_r8/) + kbo(:,42,10) = (/ & + &2.5104e-02_r8,3.2117e-02_r8,4.0690e-02_r8,5.1132e-02_r8,6.3360e-02_r8/) + kbo(:,43,10) = (/ & + &1.9359e-02_r8,2.4985e-02_r8,3.2134e-02_r8,4.0672e-02_r8,5.0944e-02_r8/) + kbo(:,44,10) = (/ & + &1.4822e-02_r8,1.9377e-02_r8,2.5087e-02_r8,3.2083e-02_r8,4.0842e-02_r8/) + kbo(:,45,10) = (/ & + &1.1292e-02_r8,1.4912e-02_r8,1.9592e-02_r8,2.5310e-02_r8,3.2495e-02_r8/) + kbo(:,46,10) = (/ & + &8.5215e-03_r8,1.1374e-02_r8,1.5134e-02_r8,1.9829e-02_r8,2.5701e-02_r8/) + kbo(:,47,10) = (/ & + &6.3304e-03_r8,8.5539e-03_r8,1.1519e-02_r8,1.5304e-02_r8,2.0043e-02_r8/) + kbo(:,48,10) = (/ & + &4.6596e-03_r8,6.3842e-03_r8,8.7184e-03_r8,1.1727e-02_r8,1.5575e-02_r8/) + kbo(:,49,10) = (/ & + &3.3978e-03_r8,4.7268e-03_r8,6.5354e-03_r8,8.9194e-03_r8,1.1986e-02_r8/) + kbo(:,50,10) = (/ & + &2.4889e-03_r8,3.5204e-03_r8,4.9247e-03_r8,6.8240e-03_r8,9.2921e-03_r8/) + kbo(:,51,10) = (/ & + &1.8182e-03_r8,2.6209e-03_r8,3.7132e-03_r8,5.2128e-03_r8,7.2010e-03_r8/) + kbo(:,52,10) = (/ & + &1.3186e-03_r8,1.9376e-03_r8,2.7823e-03_r8,3.9639e-03_r8,5.5462e-03_r8/) + kbo(:,53,10) = (/ & + &9.4728e-04_r8,1.4218e-03_r8,2.0704e-03_r8,2.9919e-03_r8,4.2442e-03_r8/) + kbo(:,54,10) = (/ & + &6.9069e-04_r8,1.0561e-03_r8,1.5627e-03_r8,2.2955e-03_r8,3.3049e-03_r8/) + kbo(:,55,10) = (/ & + &5.0377e-04_r8,7.8848e-04_r8,1.1876e-03_r8,1.7754e-03_r8,2.5917e-03_r8/) + kbo(:,56,10) = (/ & + &3.6627e-04_r8,5.8682e-04_r8,8.9763e-04_r8,1.3649e-03_r8,2.0311e-03_r8/) + kbo(:,57,10) = (/ & + &2.6429e-04_r8,4.3296e-04_r8,6.7428e-04_r8,1.0407e-03_r8,1.5759e-03_r8/) + kbo(:,58,10) = (/ & + &1.9120e-04_r8,3.1987e-04_r8,5.0621e-04_r8,7.9436e-04_r8,1.2215e-03_r8/) + kbo(:,59,10) = (/ & + &1.5379e-04_r8,2.5891e-04_r8,4.1558e-04_r8,6.6123e-04_r8,1.0327e-03_r8/) + kbo(:,13,11) = (/ & + &3.3861e+00_r8,4.5598e+00_r8,5.9909e+00_r8,7.7387e+00_r8,9.7720e+00_r8/) + kbo(:,14,11) = (/ & + &3.0835e+00_r8,4.1638e+00_r8,5.4907e+00_r8,7.0868e+00_r8,8.8764e+00_r8/) + kbo(:,15,11) = (/ & + &2.7946e+00_r8,3.7805e+00_r8,4.9918e+00_r8,6.3780e+00_r8,7.9256e+00_r8/) + kbo(:,16,11) = (/ & + &2.5106e+00_r8,3.4021e+00_r8,4.4602e+00_r8,5.6582e+00_r8,7.0321e+00_r8/) + kbo(:,17,11) = (/ & + &2.2366e+00_r8,3.0111e+00_r8,3.9217e+00_r8,4.9755e+00_r8,6.2040e+00_r8/) + kbo(:,18,11) = (/ & + &1.9672e+00_r8,2.6349e+00_r8,3.4220e+00_r8,4.3497e+00_r8,5.4155e+00_r8/) + kbo(:,19,11) = (/ & + &1.7131e+00_r8,2.2896e+00_r8,2.9754e+00_r8,3.7775e+00_r8,4.6830e+00_r8/) + kbo(:,20,11) = (/ & + &1.4996e+00_r8,1.9951e+00_r8,2.5864e+00_r8,3.2729e+00_r8,4.0503e+00_r8/) + kbo(:,21,11) = (/ & + &1.3113e+00_r8,1.7407e+00_r8,2.2502e+00_r8,2.8371e+00_r8,3.4967e+00_r8/) + kbo(:,22,11) = (/ & + &1.1682e+00_r8,1.5452e+00_r8,1.9872e+00_r8,2.4911e+00_r8,3.0547e+00_r8/) + kbo(:,23,11) = (/ & + &1.0421e+00_r8,1.3707e+00_r8,1.7516e+00_r8,2.1846e+00_r8,2.6659e+00_r8/) + kbo(:,24,11) = (/ & + &9.2979e-01_r8,1.2143e+00_r8,1.5435e+00_r8,1.9148e+00_r8,2.3275e+00_r8/) + kbo(:,25,11) = (/ & + &8.2875e-01_r8,1.0753e+00_r8,1.3588e+00_r8,1.6784e+00_r8,2.0353e+00_r8/) + kbo(:,26,11) = (/ & + &7.3934e-01_r8,9.5318e-01_r8,1.1984e+00_r8,1.4754e+00_r8,1.7853e+00_r8/) + kbo(:,27,11) = (/ & + &6.5883e-01_r8,8.4429e-01_r8,1.0568e+00_r8,1.2987e+00_r8,1.5650e+00_r8/) + kbo(:,28,11) = (/ & + &5.8647e-01_r8,7.4845e-01_r8,9.3430e-01_r8,1.1424e+00_r8,1.3714e+00_r8/) + kbo(:,29,11) = (/ & + &5.2333e-01_r8,6.6481e-01_r8,8.2647e-01_r8,1.0068e+00_r8,1.2071e+00_r8/) + kbo(:,30,11) = (/ & + &4.6646e-01_r8,5.9039e-01_r8,7.3092e-01_r8,8.8855e-01_r8,1.0662e+00_r8/) + kbo(:,31,11) = (/ & + &4.1617e-01_r8,5.2426e-01_r8,6.4699e-01_r8,7.8730e-01_r8,9.4645e-01_r8/) + kbo(:,32,11) = (/ & + &3.7143e-01_r8,4.6600e-01_r8,5.7506e-01_r8,6.9984e-01_r8,8.4024e-01_r8/) + kbo(:,33,11) = (/ & + &3.3164e-01_r8,4.1539e-01_r8,5.1227e-01_r8,6.2282e-01_r8,7.4734e-01_r8/) + kbo(:,34,11) = (/ & + &2.9391e-01_r8,3.6839e-01_r8,4.5381e-01_r8,5.5129e-01_r8,6.6077e-01_r8/) + kbo(:,35,11) = (/ & + &2.5539e-01_r8,3.2000e-01_r8,3.9467e-01_r8,4.7981e-01_r8,5.7557e-01_r8/) + kbo(:,36,11) = (/ & + &2.1634e-01_r8,2.7190e-01_r8,3.3604e-01_r8,4.0953e-01_r8,4.9314e-01_r8/) + kbo(:,37,11) = (/ & + &1.7643e-01_r8,2.2324e-01_r8,2.7784e-01_r8,3.4019e-01_r8,4.0996e-01_r8/) + kbo(:,38,11) = (/ & + &1.4359e-01_r8,1.8284e-01_r8,2.2947e-01_r8,2.8247e-01_r8,3.3992e-01_r8/) + kbo(:,39,11) = (/ & + &1.1703e-01_r8,1.4999e-01_r8,1.8946e-01_r8,2.3346e-01_r8,2.8235e-01_r8/) + kbo(:,40,11) = (/ & + &9.2508e-02_r8,1.1962e-01_r8,1.5225e-01_r8,1.8852e-01_r8,2.3037e-01_r8/) + kbo(:,41,11) = (/ & + &7.2812e-02_r8,9.4920e-02_r8,1.2149e-01_r8,1.5155e-01_r8,1.8718e-01_r8/) + kbo(:,42,11) = (/ & + &5.7212e-02_r8,7.5261e-02_r8,9.6717e-02_r8,1.2163e-01_r8,1.5109e-01_r8/) + kbo(:,43,11) = (/ & + &4.4118e-02_r8,5.8641e-02_r8,7.5812e-02_r8,9.6186e-02_r8,1.2035e-01_r8/) + kbo(:,44,11) = (/ & + &3.3705e-02_r8,4.5203e-02_r8,5.8991e-02_r8,7.5535e-02_r8,9.5312e-02_r8/) + kbo(:,45,11) = (/ & + &2.5795e-02_r8,3.4826e-02_r8,4.5764e-02_r8,5.9102e-02_r8,7.5973e-02_r8/) + kbo(:,46,11) = (/ & + &1.9500e-02_r8,2.6666e-02_r8,3.5264e-02_r8,4.5887e-02_r8,6.0050e-02_r8/) + kbo(:,47,11) = (/ & + &1.4478e-02_r8,2.0069e-02_r8,2.6758e-02_r8,3.5119e-02_r8,4.6750e-02_r8/) + kbo(:,48,11) = (/ & + &1.0673e-02_r8,1.5022e-02_r8,2.0274e-02_r8,2.6837e-02_r8,3.6213e-02_r8/) + kbo(:,49,11) = (/ & + &7.8044e-03_r8,1.1183e-02_r8,1.5301e-02_r8,2.0457e-02_r8,2.8037e-02_r8/) + kbo(:,50,11) = (/ & + &5.7286e-03_r8,8.3541e-03_r8,1.1590e-02_r8,1.5692e-02_r8,2.1700e-02_r8/) + kbo(:,51,11) = (/ & + &4.2038e-03_r8,6.2320e-03_r8,8.7867e-03_r8,1.2044e-02_r8,1.6737e-02_r8/) + kbo(:,52,11) = (/ & + &3.0623e-03_r8,4.6247e-03_r8,6.6271e-03_r8,9.2102e-03_r8,1.2933e-02_r8/) + kbo(:,53,11) = (/ & + &2.2163e-03_r8,3.3976e-03_r8,4.9642e-03_r8,7.0028e-03_r8,9.9664e-03_r8/) + kbo(:,54,11) = (/ & + &1.6196e-03_r8,2.5242e-03_r8,3.7641e-03_r8,5.3709e-03_r8,7.7537e-03_r8/) + kbo(:,55,11) = (/ & + &1.1913e-03_r8,1.8900e-03_r8,2.8670e-03_r8,4.1465e-03_r8,6.0719e-03_r8/) + kbo(:,56,11) = (/ & + &8.6854e-04_r8,1.4072e-03_r8,2.1797e-03_r8,3.2039e-03_r8,4.7482e-03_r8/) + kbo(:,57,11) = (/ & + &6.2940e-04_r8,1.0423e-03_r8,1.6521e-03_r8,2.4738e-03_r8,3.7243e-03_r8/) + kbo(:,58,11) = (/ & + &4.5766e-04_r8,7.7541e-04_r8,1.2578e-03_r8,1.9222e-03_r8,2.9509e-03_r8/) + kbo(:,59,11) = (/ & + &3.7158e-04_r8,6.4512e-04_r8,1.0666e-03_r8,1.6673e-03_r8,2.6085e-03_r8/) + kbo(:,13,12) = (/ & + &6.8265e+00_r8,9.1662e+00_r8,1.2005e+01_r8,1.5291e+01_r8,1.9104e+01_r8/) + kbo(:,14,12) = (/ & + &6.4505e+00_r8,8.6663e+00_r8,1.1302e+01_r8,1.4372e+01_r8,1.8022e+01_r8/) + kbo(:,15,12) = (/ & + &6.0333e+00_r8,8.0721e+00_r8,1.0531e+01_r8,1.3476e+01_r8,1.6920e+01_r8/) + kbo(:,16,12) = (/ & + &5.5683e+00_r8,7.4562e+00_r8,9.7508e+00_r8,1.2490e+01_r8,1.5606e+01_r8/) + kbo(:,17,12) = (/ & + &5.0713e+00_r8,6.8025e+00_r8,8.9065e+00_r8,1.1361e+01_r8,1.4093e+01_r8/) + kbo(:,18,12) = (/ & + &4.5774e+00_r8,6.1450e+00_r8,8.0133e+00_r8,1.0144e+01_r8,1.2548e+01_r8/) + kbo(:,19,12) = (/ & + &4.0864e+00_r8,5.4694e+00_r8,7.0931e+00_r8,8.9659e+00_r8,1.1117e+01_r8/) + kbo(:,20,12) = (/ & + &3.6294e+00_r8,4.8248e+00_r8,6.2421e+00_r8,7.9048e+00_r8,9.7882e+00_r8/) + kbo(:,21,12) = (/ & + &3.1876e+00_r8,4.2266e+00_r8,5.4689e+00_r8,6.9148e+00_r8,8.5415e+00_r8/) + kbo(:,22,12) = (/ & + &2.8446e+00_r8,3.7580e+00_r8,4.8472e+00_r8,6.1036e+00_r8,7.5044e+00_r8/) + kbo(:,23,12) = (/ & + &2.5375e+00_r8,3.3389e+00_r8,4.2884e+00_r8,5.3709e+00_r8,6.5794e+00_r8/) + kbo(:,24,12) = (/ & + &2.2687e+00_r8,2.9742e+00_r8,3.7979e+00_r8,4.7327e+00_r8,5.7691e+00_r8/) + kbo(:,25,12) = (/ & + &2.0354e+00_r8,2.6539e+00_r8,3.3704e+00_r8,4.1780e+00_r8,5.0680e+00_r8/) + kbo(:,26,12) = (/ & + &1.8347e+00_r8,2.3795e+00_r8,3.0035e+00_r8,3.7009e+00_r8,4.4678e+00_r8/) + kbo(:,27,12) = (/ & + &1.6539e+00_r8,2.1288e+00_r8,2.6709e+00_r8,3.2754e+00_r8,3.9447e+00_r8/) + kbo(:,28,12) = (/ & + &1.4848e+00_r8,1.8995e+00_r8,2.3700e+00_r8,2.8962e+00_r8,3.4805e+00_r8/) + kbo(:,29,12) = (/ & + &1.3323e+00_r8,1.6945e+00_r8,2.1064e+00_r8,2.5664e+00_r8,3.0755e+00_r8/) + kbo(:,30,12) = (/ & + &1.1951e+00_r8,1.5124e+00_r8,1.8729e+00_r8,2.2771e+00_r8,2.7207e+00_r8/) + kbo(:,31,12) = (/ & + &1.0723e+00_r8,1.3520e+00_r8,1.6707e+00_r8,2.0245e+00_r8,2.4134e+00_r8/) + kbo(:,32,12) = (/ & + &9.6436e-01_r8,1.2123e+00_r8,1.4924e+00_r8,1.8027e+00_r8,2.1488e+00_r8/) + kbo(:,33,12) = (/ & + &8.6875e-01_r8,1.0883e+00_r8,1.3350e+00_r8,1.6111e+00_r8,1.9241e+00_r8/) + kbo(:,34,12) = (/ & + &7.7744e-01_r8,9.7074e-01_r8,1.1897e+00_r8,1.4382e+00_r8,1.7216e+00_r8/) + kbo(:,35,12) = (/ & + &6.8108e-01_r8,8.5081e-01_r8,1.0447e+00_r8,1.2673e+00_r8,1.5231e+00_r8/) + kbo(:,36,12) = (/ & + &5.8251e-01_r8,7.3036e-01_r8,9.0117e-01_r8,1.0985e+00_r8,1.3262e+00_r8/) + kbo(:,37,12) = (/ & + &4.8147e-01_r8,6.0751e-01_r8,7.5487e-01_r8,9.2714e-01_r8,1.1257e+00_r8/) + kbo(:,38,12) = (/ & + &3.9749e-01_r8,5.0467e-01_r8,6.3154e-01_r8,7.8124e-01_r8,9.5438e-01_r8/) + kbo(:,39,12) = (/ & + &3.2829e-01_r8,4.1995e-01_r8,5.2901e-01_r8,6.5861e-01_r8,8.0986e-01_r8/) + kbo(:,40,12) = (/ & + &2.6399e-01_r8,3.4098e-01_r8,4.3333e-01_r8,5.4338e-01_r8,6.7333e-01_r8/) + kbo(:,41,12) = (/ & + &2.1121e-01_r8,2.7554e-01_r8,3.5340e-01_r8,4.4699e-01_r8,5.5819e-01_r8/) + kbo(:,42,12) = (/ & + &1.6875e-01_r8,2.2242e-01_r8,2.8790e-01_r8,3.6718e-01_r8,4.6248e-01_r8/) + kbo(:,43,12) = (/ & + &1.3242e-01_r8,1.7649e-01_r8,2.3091e-01_r8,2.9729e-01_r8,3.7802e-01_r8/) + kbo(:,44,12) = (/ & + &1.0268e-01_r8,1.3874e-01_r8,1.8350e-01_r8,2.3873e-01_r8,3.0615e-01_r8/) + kbo(:,45,12) = (/ & + &7.9157e-02_r8,1.0857e-01_r8,1.4543e-01_r8,1.9132e-01_r8,2.4703e-01_r8/) + kbo(:,46,12) = (/ & + &6.0349e-02_r8,8.3945e-02_r8,1.1412e-01_r8,1.5200e-01_r8,1.9783e-01_r8/) + kbo(:,47,12) = (/ & + &4.5026e-02_r8,6.3638e-02_r8,8.7982e-02_r8,1.1888e-01_r8,1.5630e-01_r8/) + kbo(:,48,12) = (/ & + &3.3400e-02_r8,4.7982e-02_r8,6.7403e-02_r8,9.2494e-02_r8,1.2316e-01_r8/) + kbo(:,49,12) = (/ & + &2.4633e-02_r8,3.5960e-02_r8,5.1349e-02_r8,7.1624e-02_r8,9.6517e-02_r8/) + kbo(:,50,12) = (/ & + &1.8199e-02_r8,2.7006e-02_r8,3.9181e-02_r8,5.5479e-02_r8,7.5913e-02_r8/) + kbo(:,51,12) = (/ & + &1.3397e-02_r8,2.0251e-02_r8,2.9827e-02_r8,4.2894e-02_r8,5.9697e-02_r8/) + kbo(:,52,12) = (/ & + &9.8047e-03_r8,1.5092e-02_r8,2.2613e-02_r8,3.3016e-02_r8,4.6660e-02_r8/) + kbo(:,53,12) = (/ & + &7.1233e-03_r8,1.1184e-02_r8,1.7048e-02_r8,2.5317e-02_r8,3.6316e-02_r8/) + kbo(:,54,12) = (/ & + &5.1904e-03_r8,8.3108e-03_r8,1.2872e-02_r8,1.9462e-02_r8,2.8342e-02_r8/) + kbo(:,55,12) = (/ & + &3.7706e-03_r8,6.1523e-03_r8,9.6915e-03_r8,1.4909e-02_r8,2.2083e-02_r8/) + kbo(:,56,12) = (/ & + &2.7214e-03_r8,4.5313e-03_r8,7.2581e-03_r8,1.1344e-02_r8,1.7112e-02_r8/) + kbo(:,57,12) = (/ & + &1.9679e-03_r8,3.3305e-03_r8,5.4024e-03_r8,8.5896e-03_r8,1.3181e-02_r8/) + kbo(:,58,12) = (/ & + &1.4312e-03_r8,2.4830e-03_r8,4.0992e-03_r8,6.5707e-03_r8,1.0148e-02_r8/) + kbo(:,59,12) = (/ & + &1.1735e-03_r8,2.0715e-03_r8,3.4672e-03_r8,5.6187e-03_r8,8.6747e-03_r8/) + kbo(:,13,13) = (/ & + &1.4965e+01_r8,1.9939e+01_r8,2.5957e+01_r8,3.3111e+01_r8,4.1486e+01_r8/) + kbo(:,14,13) = (/ & + &1.4891e+01_r8,1.9752e+01_r8,2.5714e+01_r8,3.2877e+01_r8,4.1201e+01_r8/) + kbo(:,15,13) = (/ & + &1.4632e+01_r8,1.9464e+01_r8,2.5349e+01_r8,3.2327e+01_r8,4.0239e+01_r8/) + kbo(:,16,13) = (/ & + &1.4224e+01_r8,1.8920e+01_r8,2.4612e+01_r8,3.1240e+01_r8,3.8764e+01_r8/) + kbo(:,17,13) = (/ & + &1.3596e+01_r8,1.8071e+01_r8,2.3399e+01_r8,2.9603e+01_r8,3.6827e+01_r8/) + kbo(:,18,13) = (/ & + &1.2765e+01_r8,1.6956e+01_r8,2.1940e+01_r8,2.7801e+01_r8,3.4621e+01_r8/) + kbo(:,19,13) = (/ & + &1.1845e+01_r8,1.5708e+01_r8,2.0355e+01_r8,2.5828e+01_r8,3.2043e+01_r8/) + kbo(:,20,13) = (/ & + &1.0881e+01_r8,1.4480e+01_r8,1.8761e+01_r8,2.3735e+01_r8,2.9355e+01_r8/) + kbo(:,21,13) = (/ & + &9.9388e+00_r8,1.3181e+01_r8,1.7060e+01_r8,2.1504e+01_r8,2.6520e+01_r8/) + kbo(:,22,13) = (/ & + &9.1395e+00_r8,1.2102e+01_r8,1.5540e+01_r8,1.9513e+01_r8,2.4061e+01_r8/) + kbo(:,23,13) = (/ & + &8.3446e+00_r8,1.0972e+01_r8,1.4055e+01_r8,1.7623e+01_r8,2.1727e+01_r8/) + kbo(:,24,13) = (/ & + &7.5591e+00_r8,9.8924e+00_r8,1.2651e+01_r8,1.5869e+01_r8,1.9520e+01_r8/) + kbo(:,25,13) = (/ & + &6.8143e+00_r8,8.8970e+00_r8,1.1359e+01_r8,1.4218e+01_r8,1.7424e+01_r8/) + kbo(:,26,13) = (/ & + &6.1698e+00_r8,8.0210e+00_r8,1.0220e+01_r8,1.2729e+01_r8,1.5532e+01_r8/) + kbo(:,27,13) = (/ & + &5.5728e+00_r8,7.2306e+00_r8,9.1639e+00_r8,1.1369e+01_r8,1.3833e+01_r8/) + kbo(:,28,13) = (/ & + &5.0450e+00_r8,6.5146e+00_r8,8.2221e+00_r8,1.0165e+01_r8,1.2320e+01_r8/) + kbo(:,29,13) = (/ & + &4.5820e+00_r8,5.8856e+00_r8,7.3962e+00_r8,9.1032e+00_r8,1.0999e+01_r8/) + kbo(:,30,13) = (/ & + &4.1619e+00_r8,5.3258e+00_r8,6.6581e+00_r8,8.1640e+00_r8,9.8348e+00_r8/) + kbo(:,31,13) = (/ & + &3.7986e+00_r8,4.8336e+00_r8,6.0169e+00_r8,7.3498e+00_r8,8.8372e+00_r8/) + kbo(:,32,13) = (/ & + &3.4747e+00_r8,4.3988e+00_r8,5.4556e+00_r8,6.6497e+00_r8,7.9860e+00_r8/) + kbo(:,33,13) = (/ & + &3.1806e+00_r8,4.0134e+00_r8,4.9644e+00_r8,6.0424e+00_r8,7.2445e+00_r8/) + kbo(:,34,13) = (/ & + &2.8901e+00_r8,3.6383e+00_r8,4.4979e+00_r8,5.4687e+00_r8,6.5591e+00_r8/) + kbo(:,35,13) = (/ & + &2.5701e+00_r8,3.2361e+00_r8,4.0067e+00_r8,4.8794e+00_r8,5.8576e+00_r8/) + kbo(:,36,13) = (/ & + &2.2323e+00_r8,2.8199e+00_r8,3.4998e+00_r8,4.2791e+00_r8,5.1575e+00_r8/) + kbo(:,37,13) = (/ & + &1.8736e+00_r8,2.3827e+00_r8,2.9738e+00_r8,3.6564e+00_r8,4.4360e+00_r8/) + kbo(:,38,13) = (/ & + &1.5728e+00_r8,2.0148e+00_r8,2.5311e+00_r8,3.1303e+00_r8,3.8226e+00_r8/) + kbo(:,39,13) = (/ & + &1.3237e+00_r8,1.7072e+00_r8,2.1603e+00_r8,2.6914e+00_r8,3.3072e+00_r8/) + kbo(:,40,13) = (/ & + &1.0847e+00_r8,1.4132e+00_r8,1.8059e+00_r8,2.2702e+00_r8,2.8143e+00_r8/) + kbo(:,41,13) = (/ & + &8.8581e-01_r8,1.1668e+00_r8,1.5064e+00_r8,1.9133e+00_r8,2.3935e+00_r8/) + kbo(:,42,13) = (/ & + &7.2374e-01_r8,9.6367e-01_r8,1.2577e+00_r8,1.6144e+00_r8,2.0403e+00_r8/) + kbo(:,43,13) = (/ & + &5.8123e-01_r8,7.8367e-01_r8,1.0353e+00_r8,1.3440e+00_r8,1.7177e+00_r8/) + kbo(:,44,13) = (/ & + &4.6198e-01_r8,6.3195e-01_r8,8.4539e-01_r8,1.1117e+00_r8,1.4376e+00_r8/) + kbo(:,45,13) = (/ & + &3.6584e-01_r8,5.0822e-01_r8,6.8932e-01_r8,9.1864e-01_r8,1.2028e+00_r8/) + kbo(:,46,13) = (/ & + &2.8644e-01_r8,4.0442e-01_r8,5.5738e-01_r8,7.5306e-01_r8,9.9957e-01_r8/) + kbo(:,47,13) = (/ & + &2.1956e-01_r8,3.1585e-01_r8,4.4303e-01_r8,6.0814e-01_r8,8.1897e-01_r8/) + kbo(:,48,13) = (/ & + &1.6674e-01_r8,2.4495e-01_r8,3.5019e-01_r8,4.8911e-01_r8,6.6858e-01_r8/) + kbo(:,49,13) = (/ & + &1.2553e-01_r8,1.8856e-01_r8,2.7515e-01_r8,3.9103e-01_r8,5.4421e-01_r8/) + kbo(:,50,13) = (/ & + &9.4665e-02_r8,1.4544e-01_r8,2.1677e-01_r8,3.1374e-01_r8,4.4454e-01_r8/) + kbo(:,51,13) = (/ & + &7.1191e-02_r8,1.1194e-01_r8,1.7036e-01_r8,2.5168e-01_r8,3.6277e-01_r8/) + kbo(:,52,13) = (/ & + &5.3052e-02_r8,8.5501e-02_r8,1.3304e-01_r8,2.0087e-01_r8,2.9517e-01_r8/) + kbo(:,53,13) = (/ & + &3.9132e-02_r8,6.4715e-02_r8,1.0314e-01_r8,1.5924e-01_r8,2.3881e-01_r8/) + kbo(:,54,13) = (/ & + &2.9043e-02_r8,4.9273e-02_r8,8.0552e-02_r8,1.2707e-01_r8,1.9473e-01_r8/) + kbo(:,55,13) = (/ & + &2.1525e-02_r8,3.7498e-02_r8,6.2875e-02_r8,1.0150e-01_r8,1.5889e-01_r8/) + kbo(:,56,13) = (/ & + &1.5833e-02_r8,2.8322e-02_r8,4.8765e-02_r8,8.0651e-02_r8,1.2905e-01_r8/) + kbo(:,57,13) = (/ & + &1.1526e-02_r8,2.1205e-02_r8,3.7510e-02_r8,6.3651e-02_r8,1.0431e-01_r8/) + kbo(:,58,13) = (/ & + &8.3779e-03_r8,1.5855e-02_r8,2.8776e-02_r8,5.0260e-02_r8,8.4604e-02_r8/) + kbo(:,59,13) = (/ & + &6.7851e-03_r8,1.3119e-02_r8,2.4293e-02_r8,4.3321e-02_r8,7.4531e-02_r8/) + kbo(:,13,14) = (/ & + &3.3721e+01_r8,4.7002e+01_r8,6.3302e+01_r8,8.2327e+01_r8,1.0363e+02_r8/) + kbo(:,14,14) = (/ & + &3.6911e+01_r8,5.0874e+01_r8,6.7511e+01_r8,8.6774e+01_r8,1.0872e+02_r8/) + kbo(:,15,14) = (/ & + &3.9962e+01_r8,5.4067e+01_r8,7.0780e+01_r8,9.0289e+01_r8,1.1312e+02_r8/) + kbo(:,16,14) = (/ & + &4.2338e+01_r8,5.6683e+01_r8,7.3332e+01_r8,9.3095e+01_r8,1.1626e+02_r8/) + kbo(:,17,14) = (/ & + &4.3916e+01_r8,5.8217e+01_r8,7.5023e+01_r8,9.4925e+01_r8,1.1793e+02_r8/) + kbo(:,18,14) = (/ & + &4.4576e+01_r8,5.8845e+01_r8,7.5702e+01_r8,9.5514e+01_r8,1.1830e+02_r8/) + kbo(:,19,14) = (/ & + &4.4328e+01_r8,5.8466e+01_r8,7.5196e+01_r8,9.4726e+01_r8,1.1748e+02_r8/) + kbo(:,20,14) = (/ & + &4.3798e+01_r8,5.7631e+01_r8,7.4169e+01_r8,9.3518e+01_r8,1.1584e+02_r8/) + kbo(:,21,14) = (/ & + &4.2847e+01_r8,5.6429e+01_r8,7.2627e+01_r8,9.1567e+01_r8,1.1316e+02_r8/) + kbo(:,22,14) = (/ & + &4.2232e+01_r8,5.5705e+01_r8,7.1694e+01_r8,9.0118e+01_r8,1.1101e+02_r8/) + kbo(:,23,14) = (/ & + &4.1301e+01_r8,5.4371e+01_r8,6.9797e+01_r8,8.7676e+01_r8,1.0772e+02_r8/) + kbo(:,24,14) = (/ & + &4.0036e+01_r8,5.2522e+01_r8,6.7301e+01_r8,8.4384e+01_r8,1.0387e+02_r8/) + kbo(:,25,14) = (/ & + &3.8535e+01_r8,5.0451e+01_r8,6.4572e+01_r8,8.0891e+01_r8,9.9814e+01_r8/) + kbo(:,26,14) = (/ & + &3.6990e+01_r8,4.8476e+01_r8,6.1896e+01_r8,7.7604e+01_r8,9.5632e+01_r8/) + kbo(:,27,14) = (/ & + &3.5439e+01_r8,4.6349e+01_r8,5.9201e+01_r8,7.4166e+01_r8,9.1237e+01_r8/) + kbo(:,28,14) = (/ & + &3.3799e+01_r8,4.4185e+01_r8,5.6512e+01_r8,7.0702e+01_r8,8.6988e+01_r8/) + kbo(:,29,14) = (/ & + &3.2225e+01_r8,4.2139e+01_r8,5.3908e+01_r8,6.7503e+01_r8,8.3109e+01_r8/) + kbo(:,30,14) = (/ & + &3.0748e+01_r8,4.0218e+01_r8,5.1459e+01_r8,6.4621e+01_r8,7.9612e+01_r8/) + kbo(:,31,14) = (/ & + &2.9425e+01_r8,3.8499e+01_r8,4.9352e+01_r8,6.2118e+01_r8,7.6745e+01_r8/) + kbo(:,32,14) = (/ & + &2.8242e+01_r8,3.7039e+01_r8,4.7648e+01_r8,6.0092e+01_r8,7.4536e+01_r8/) + kbo(:,33,14) = (/ & + &2.7263e+01_r8,3.5883e+01_r8,4.6290e+01_r8,5.8616e+01_r8,7.3025e+01_r8/) + kbo(:,34,14) = (/ & + &2.6245e+01_r8,3.4728e+01_r8,4.4963e+01_r8,5.7211e+01_r8,7.1614e+01_r8/) + kbo(:,35,14) = (/ & + &2.4792e+01_r8,3.3010e+01_r8,4.3016e+01_r8,5.5082e+01_r8,6.9332e+01_r8/) + kbo(:,36,14) = (/ & + &2.2854e+01_r8,3.0681e+01_r8,4.0335e+01_r8,5.2076e+01_r8,6.5971e+01_r8/) + kbo(:,37,14) = (/ & + &2.0215e+01_r8,2.7477e+01_r8,3.6561e+01_r8,4.7698e+01_r8,6.0990e+01_r8/) + kbo(:,38,14) = (/ & + &1.7901e+01_r8,2.4657e+01_r8,3.3200e+01_r8,4.3777e+01_r8,5.6518e+01_r8/) + kbo(:,39,14) = (/ & + &1.5916e+01_r8,2.2229e+01_r8,3.0285e+01_r8,4.0352e+01_r8,5.2594e+01_r8/) + kbo(:,40,14) = (/ & + &1.3687e+01_r8,1.9453e+01_r8,2.6865e+01_r8,3.6273e+01_r8,4.7801e+01_r8/) + kbo(:,41,14) = (/ & + &1.1706e+01_r8,1.6957e+01_r8,2.3775e+01_r8,3.2529e+01_r8,4.3345e+01_r8/) + kbo(:,42,14) = (/ & + &1.0015e+01_r8,1.4777e+01_r8,2.1056e+01_r8,2.9181e+01_r8,3.9336e+01_r8/) + kbo(:,43,14) = (/ & + &8.3602e+00_r8,1.2595e+01_r8,1.8289e+01_r8,2.5700e+01_r8,3.5139e+01_r8/) + kbo(:,44,14) = (/ & + &6.8842e+00_r8,1.0588e+01_r8,1.5702e+01_r8,2.2421e+01_r8,3.1090e+01_r8/) + kbo(:,45,14) = (/ & + &5.6505e+00_r8,8.8697e+00_r8,1.3428e+01_r8,1.9525e+01_r8,2.7445e+01_r8/) + kbo(:,46,14) = (/ & + &4.5669e+00_r8,7.3282e+00_r8,1.1331e+01_r8,1.6810e+01_r8,2.3987e+01_r8/) + kbo(:,47,14) = (/ & + &3.5910e+00_r8,5.9011e+00_r8,9.3338e+00_r8,1.4162e+01_r8,2.0590e+01_r8/) + kbo(:,48,14) = (/ & + &2.8046e+00_r8,4.7156e+00_r8,7.6334e+00_r8,1.1848e+01_r8,1.7577e+01_r8/) + kbo(:,49,14) = (/ & + &2.1748e+00_r8,3.7383e+00_r8,6.1955e+00_r8,9.8356e+00_r8,1.4909e+01_r8/) + kbo(:,50,14) = (/ & + &1.6968e+00_r8,2.9824e+00_r8,5.0552e+00_r8,8.1970e+00_r8,1.2692e+01_r8/) + kbo(:,51,14) = (/ & + &1.3228e+00_r8,2.3793e+00_r8,4.1196e+00_r8,6.8244e+00_r8,1.0784e+01_r8/) + kbo(:,52,14) = (/ & + &1.0245e+00_r8,1.8865e+00_r8,3.3355e+00_r8,5.6478e+00_r8,9.1028e+00_r8/) + kbo(:,53,14) = (/ & + &7.8728e-01_r8,1.4840e+00_r8,2.6816e+00_r8,4.6391e+00_r8,7.6341e+00_r8/) + kbo(:,54,14) = (/ & + &6.1018e-01_r8,1.1815e+00_r8,2.1812e+00_r8,3.8474e+00_r8,6.4584e+00_r8/) + kbo(:,55,14) = (/ & + &4.7246e-01_r8,9.4354e-01_r8,1.7799e+00_r8,3.1974e+00_r8,5.4714e+00_r8/) + kbo(:,56,14) = (/ & + &3.6268e-01_r8,7.4897e-01_r8,1.4435e+00_r8,2.6438e+00_r8,4.6110e+00_r8/) + kbo(:,57,14) = (/ & + &2.7617e-01_r8,5.8818e-01_r8,1.1638e+00_r8,2.1763e+00_r8,3.8632e+00_r8/) + kbo(:,58,14) = (/ & + &2.1026e-01_r8,4.6281e-01_r8,9.4334e-01_r8,1.8002e+00_r8,3.2506e+00_r8/) + kbo(:,59,14) = (/ & + &1.8510e-01_r8,4.1578e-01_r8,8.6198e-01_r8,1.6609e+00_r8,3.0231e+00_r8/) + kbo(:,13,15) = (/ & + &7.9497e+01_r8,1.0631e+02_r8,1.3951e+02_r8,1.8076e+02_r8,2.3534e+02_r8/) + kbo(:,14,15) = (/ & + &9.0008e+01_r8,1.2102e+02_r8,1.6070e+02_r8,2.0844e+02_r8,2.6891e+02_r8/) + kbo(:,15,15) = (/ & + &1.0142e+02_r8,1.3773e+02_r8,1.8424e+02_r8,2.3942e+02_r8,3.0596e+02_r8/) + kbo(:,16,15) = (/ & + &1.1444e+02_r8,1.5595e+02_r8,2.0951e+02_r8,2.7261e+02_r8,3.4599e+02_r8/) + kbo(:,17,15) = (/ & + &1.2871e+02_r8,1.7599e+02_r8,2.3611e+02_r8,3.0737e+02_r8,3.8849e+02_r8/) + kbo(:,18,15) = (/ & + &1.4444e+02_r8,1.9729e+02_r8,2.6334e+02_r8,3.4204e+02_r8,4.3103e+02_r8/) + kbo(:,19,15) = (/ & + &1.6121e+02_r8,2.1913e+02_r8,2.9095e+02_r8,3.7632e+02_r8,4.7170e+02_r8/) + kbo(:,20,15) = (/ & + &1.7880e+02_r8,2.4196e+02_r8,3.1956e+02_r8,4.1027e+02_r8,5.1312e+02_r8/) + kbo(:,21,15) = (/ & + &1.9582e+02_r8,2.6409e+02_r8,3.4675e+02_r8,4.4276e+02_r8,5.5264e+02_r8/) + kbo(:,22,15) = (/ & + &2.1631e+02_r8,2.9018e+02_r8,3.7825e+02_r8,4.8067e+02_r8,5.9651e+02_r8/) + kbo(:,23,15) = (/ & + &2.3693e+02_r8,3.1638e+02_r8,4.0986e+02_r8,5.1726e+02_r8,6.3877e+02_r8/) + kbo(:,24,15) = (/ & + &2.5815e+02_r8,3.4252e+02_r8,4.4099e+02_r8,5.5343e+02_r8,6.7985e+02_r8/) + kbo(:,25,15) = (/ & + &2.7940e+02_r8,3.6830e+02_r8,4.7141e+02_r8,5.8880e+02_r8,7.2036e+02_r8/) + kbo(:,26,15) = (/ & + &3.0147e+02_r8,3.9459e+02_r8,5.0246e+02_r8,6.2482e+02_r8,7.6276e+02_r8/) + kbo(:,27,15) = (/ & + &3.2318e+02_r8,4.2065e+02_r8,5.3313e+02_r8,6.6087e+02_r8,8.0529e+02_r8/) + kbo(:,28,15) = (/ & + &3.4508e+02_r8,4.4657e+02_r8,5.6379e+02_r8,6.9725e+02_r8,8.4792e+02_r8/) + kbo(:,29,15) = (/ & + &3.6777e+02_r8,4.7381e+02_r8,5.9626e+02_r8,7.3554e+02_r8,8.9251e+02_r8/) + kbo(:,30,15) = (/ & + &3.9103e+02_r8,5.0185e+02_r8,6.2997e+02_r8,7.7485e+02_r8,9.3819e+02_r8/) + kbo(:,31,15) = (/ & + &4.1560e+02_r8,5.3166e+02_r8,6.6523e+02_r8,8.1615e+02_r8,9.8559e+02_r8/) + kbo(:,32,15) = (/ & + &4.4194e+02_r8,5.6341e+02_r8,7.0244e+02_r8,8.5957e+02_r8,1.0345e+03_r8/) + kbo(:,33,15) = (/ & + &4.7004e+02_r8,5.9690e+02_r8,7.4161e+02_r8,9.0465e+02_r8,1.0849e+03_r8/) + kbo(:,34,15) = (/ & + &4.9560e+02_r8,6.2720e+02_r8,7.7702e+02_r8,9.4526e+02_r8,1.1301e+03_r8/) + kbo(:,35,15) = (/ & + &5.1020e+02_r8,6.4498e+02_r8,7.9798e+02_r8,9.6921e+02_r8,1.1571e+03_r8/) + kbo(:,36,15) = (/ & + &5.1153e+02_r8,6.4732e+02_r8,8.0146e+02_r8,9.7374e+02_r8,1.1629e+03_r8/) + kbo(:,37,15) = (/ & + &4.9411e+02_r8,6.2784e+02_r8,7.8019e+02_r8,9.5084e+02_r8,1.1384e+03_r8/) + kbo(:,38,15) = (/ & + &4.7607e+02_r8,6.0738e+02_r8,7.5785e+02_r8,9.2634e+02_r8,1.1122e+03_r8/) + kbo(:,39,15) = (/ & + &4.5860e+02_r8,5.8729e+02_r8,7.3571e+02_r8,9.0212e+02_r8,1.0835e+03_r8/) + kbo(:,40,15) = (/ & + &4.2990e+02_r8,5.5385e+02_r8,6.9803e+02_r8,8.6039e+02_r8,1.0406e+03_r8/) + kbo(:,41,15) = (/ & + &4.0087e+02_r8,5.1992e+02_r8,6.5921e+02_r8,8.1732e+02_r8,9.9347e+02_r8/) + kbo(:,42,15) = (/ & + &3.7298e+02_r8,4.8724e+02_r8,6.2146e+02_r8,7.7537e+02_r8,9.4699e+02_r8/) + kbo(:,43,15) = (/ & + &3.4053e+02_r8,4.4909e+02_r8,5.7712e+02_r8,7.2520e+02_r8,8.9154e+02_r8/) + kbo(:,44,15) = (/ & + &3.0753e+02_r8,4.1020e+02_r8,5.3144e+02_r8,6.7302e+02_r8,8.3358e+02_r8/) + kbo(:,45,15) = (/ & + &2.7654e+02_r8,3.7323e+02_r8,4.8808e+02_r8,6.2285e+02_r8,7.7741e+02_r8/) + kbo(:,46,15) = (/ & + &2.4531e+02_r8,3.3622e+02_r8,4.4437e+02_r8,5.7189e+02_r8,7.1969e+02_r8/) + kbo(:,47,15) = (/ & + &2.1302e+02_r8,2.9761e+02_r8,3.9853e+02_r8,5.1809e+02_r8,6.5783e+02_r8/) + kbo(:,48,15) = (/ & + &1.8355e+02_r8,2.6147e+02_r8,3.5562e+02_r8,4.6754e+02_r8,5.9909e+02_r8/) + kbo(:,49,15) = (/ & + &1.5701e+02_r8,2.2791e+02_r8,3.1569e+02_r8,4.2021e+02_r8,5.4365e+02_r8/) + kbo(:,50,15) = (/ & + &1.3468e+02_r8,1.9893e+02_r8,2.8071e+02_r8,3.7858e+02_r8,4.9472e+02_r8/) + kbo(:,51,15) = (/ & + &1.1526e+02_r8,1.7331e+02_r8,2.4880e+02_r8,3.4068e+02_r8,4.5000e+02_r8/) + kbo(:,52,15) = (/ & + &9.7991e+01_r8,1.5012e+02_r8,2.1915e+02_r8,3.0532e+02_r8,4.0798e+02_r8/) + kbo(:,53,15) = (/ & + &8.2622e+01_r8,1.2914e+02_r8,1.9179e+02_r8,2.7194e+02_r8,3.6825e+02_r8/) + kbo(:,54,15) = (/ & + &7.0111e+01_r8,1.1182e+02_r8,1.6882e+02_r8,2.4316e+02_r8,3.3408e+02_r8/) + kbo(:,55,15) = (/ & + &5.9451e+01_r8,9.6898e+01_r8,1.4869e+02_r8,2.1737e+02_r8,3.0323e+02_r8/) + kbo(:,56,15) = (/ & + &4.9982e+01_r8,8.3446e+01_r8,1.3033e+02_r8,1.9338e+02_r8,2.7397e+02_r8/) + kbo(:,57,15) = (/ & + &4.1621e+01_r8,7.1384e+01_r8,1.1363e+02_r8,1.7127e+02_r8,2.4633e+02_r8/) + kbo(:,58,15) = (/ & + &3.4650e+01_r8,6.1162e+01_r8,9.9313e+01_r8,1.5200e+02_r8,2.2168e+02_r8/) + kbo(:,59,15) = (/ & + &3.2067e+01_r8,5.7347e+01_r8,9.3961e+01_r8,1.4472e+02_r8,2.1224e+02_r8/) + kbo(:,13,16) = (/ & + &1.4292e+02_r8,1.7830e+02_r8,2.5018e+02_r8,3.7037e+02_r8,5.2070e+02_r8/) + kbo(:,14,16) = (/ & + &1.7229e+02_r8,2.1935e+02_r8,3.0306e+02_r8,4.4388e+02_r8,6.2020e+02_r8/) + kbo(:,15,16) = (/ & + &2.0873e+02_r8,2.6972e+02_r8,3.6756e+02_r8,5.2712e+02_r8,7.3393e+02_r8/) + kbo(:,16,16) = (/ & + &2.5439e+02_r8,3.3072e+02_r8,4.4570e+02_r8,6.2226e+02_r8,8.6517e+02_r8/) + kbo(:,17,16) = (/ & + &3.0902e+02_r8,4.0145e+02_r8,5.3763e+02_r8,7.3415e+02_r8,1.0082e+03_r8/) + kbo(:,18,16) = (/ & + &3.7239e+02_r8,4.8343e+02_r8,6.4354e+02_r8,8.6401e+02_r8,1.1697e+03_r8/) + kbo(:,19,16) = (/ & + &4.4344e+02_r8,5.7744e+02_r8,7.6245e+02_r8,1.0126e+03_r8,1.3544e+03_r8/) + kbo(:,20,16) = (/ & + &5.2591e+02_r8,6.8473e+02_r8,8.9843e+02_r8,1.1879e+03_r8,1.5662e+03_r8/) + kbo(:,21,16) = (/ & + &6.1975e+02_r8,8.0389e+02_r8,1.0527e+03_r8,1.3850e+03_r8,1.8066e+03_r8/) + kbo(:,22,16) = (/ & + &7.3890e+02_r8,9.5515e+02_r8,1.2474e+03_r8,1.6302e+03_r8,2.1130e+03_r8/) + kbo(:,23,16) = (/ & + &8.7503e+02_r8,1.1289e+03_r8,1.4705e+03_r8,1.9102e+03_r8,2.4554e+03_r8/) + kbo(:,24,16) = (/ & + &1.0277e+03_r8,1.3283e+03_r8,1.7241e+03_r8,2.2247e+03_r8,2.8319e+03_r8/) + kbo(:,25,16) = (/ & + &1.2034e+03_r8,1.5543e+03_r8,2.0073e+03_r8,2.5693e+03_r8,3.2356e+03_r8/) + kbo(:,26,16) = (/ & + &1.4042e+03_r8,1.8088e+03_r8,2.3218e+03_r8,2.9229e+03_r8,3.6714e+03_r8/) + kbo(:,27,16) = (/ & + &1.6234e+03_r8,2.0833e+03_r8,2.6544e+03_r8,3.3382e+03_r8,4.1196e+03_r8/) + kbo(:,28,16) = (/ & + &1.8563e+03_r8,2.3730e+03_r8,3.0002e+03_r8,3.7388e+03_r8,4.5730e+03_r8/) + kbo(:,29,16) = (/ & + &2.1060e+03_r8,2.6609e+03_r8,3.3576e+03_r8,4.1487e+03_r8,5.0295e+03_r8/) + kbo(:,30,16) = (/ & + &2.3669e+03_r8,2.9882e+03_r8,3.7190e+03_r8,4.5573e+03_r8,5.4823e+03_r8/) + kbo(:,31,16) = (/ & + &2.6382e+03_r8,3.3079e+03_r8,4.0851e+03_r8,4.9669e+03_r8,5.9326e+03_r8/) + kbo(:,32,16) = (/ & + &2.9162e+03_r8,3.6311e+03_r8,4.4535e+03_r8,5.3188e+03_r8,6.3774e+03_r8/) + kbo(:,33,16) = (/ & + &3.1977e+03_r8,3.9546e+03_r8,4.8182e+03_r8,5.7741e+03_r8,6.8136e+03_r8/) + kbo(:,34,16) = (/ & + &3.4540e+03_r8,4.2467e+03_r8,5.1445e+03_r8,6.1305e+03_r8,7.1986e+03_r8/) + kbo(:,35,16) = (/ & + &3.6329e+03_r8,4.4502e+03_r8,5.3698e+03_r8,6.3759e+03_r8,7.4635e+03_r8/) + kbo(:,36,16) = (/ & + &3.7190e+03_r8,4.5470e+03_r8,5.4751e+03_r8,6.4918e+03_r8,7.5883e+03_r8/) + kbo(:,37,16) = (/ & + &3.6766e+03_r8,4.4979e+03_r8,5.4194e+03_r8,6.4326e+03_r8,7.5253e+03_r8/) + kbo(:,38,16) = (/ & + &3.6175e+03_r8,4.4311e+03_r8,5.3444e+03_r8,6.3514e+03_r8,7.4384e+03_r8/) + kbo(:,39,16) = (/ & + &3.5511e+03_r8,4.3577e+03_r8,5.2603e+03_r8,6.2593e+03_r8,7.3011e+03_r8/) + kbo(:,40,16) = (/ & + &3.4038e+03_r8,4.1899e+03_r8,5.0730e+03_r8,6.0546e+03_r8,7.1202e+03_r8/) + kbo(:,41,16) = (/ & + &3.2449e+03_r8,4.0090e+03_r8,4.8718e+03_r8,5.8306e+03_r8,6.8794e+03_r8/) + kbo(:,42,16) = (/ & + &3.0878e+03_r8,3.8270e+03_r8,4.6679e+03_r8,5.6043e+03_r8,6.6342e+03_r8/) + kbo(:,43,16) = (/ & + &2.8974e+03_r8,3.6038e+03_r8,4.4171e+03_r8,5.3250e+03_r8,6.3295e+03_r8/) + kbo(:,44,16) = (/ & + &2.6963e+03_r8,3.3670e+03_r8,4.1477e+03_r8,5.0263e+03_r8,5.9993e+03_r8/) + kbo(:,45,16) = (/ & + &2.5060e+03_r8,3.1396e+03_r8,3.8862e+03_r8,4.7337e+03_r8,5.6766e+03_r8/) + kbo(:,46,16) = (/ & + &2.3164e+03_r8,2.9079e+03_r8,3.6158e+03_r8,4.4299e+03_r8,5.3398e+03_r8/) + kbo(:,47,16) = (/ & + &2.1174e+03_r8,2.6621e+03_r8,3.3261e+03_r8,4.0998e+03_r8,4.9727e+03_r8/) + kbo(:,48,16) = (/ & + &1.9329e+03_r8,2.4347e+03_r8,3.0518e+03_r8,3.7834e+03_r8,4.6186e+03_r8/) + kbo(:,49,16) = (/ & + &1.7595e+03_r8,2.2251e+03_r8,2.7943e+03_r8,3.4811e+03_r8,4.2776e+03_r8/) + kbo(:,50,16) = (/ & + &1.6082e+03_r8,2.0431e+03_r8,2.5690e+03_r8,3.2137e+03_r8,3.9707e+03_r8/) + kbo(:,51,16) = (/ & + &1.4710e+03_r8,1.8773e+03_r8,2.3673e+03_r8,2.9684e+03_r8,3.6854e+03_r8/) + kbo(:,52,16) = (/ & + &1.3426e+03_r8,1.7222e+03_r8,2.1800e+03_r8,2.7371e+03_r8,3.4141e+03_r8/) + kbo(:,53,16) = (/ & + &1.2224e+03_r8,1.5765e+03_r8,2.0045e+03_r8,2.5219e+03_r8,3.1562e+03_r8/) + kbo(:,54,16) = (/ & + &1.1196e+03_r8,1.4516e+03_r8,1.8541e+03_r8,2.3387e+03_r8,2.9325e+03_r8/) + kbo(:,55,16) = (/ & + &1.0267e+03_r8,1.3387e+03_r8,1.7175e+03_r8,2.1745e+03_r8,2.7302e+03_r8/) + kbo(:,56,16) = (/ & + &9.3987e+02_r8,1.2326e+03_r8,1.5894e+03_r8,2.0202e+03_r8,2.5405e+03_r8/) + kbo(:,57,16) = (/ & + &8.5792e+02_r8,1.1333e+03_r8,1.4474e+03_r8,1.8742e+03_r8,2.3631e+03_r8/) + kbo(:,58,16) = (/ & + &7.8443e+02_r8,1.0443e+03_r8,1.3605e+03_r8,1.7435e+03_r8,2.2055e+03_r8/) + kbo(:,59,16) = (/ & + &7.5656e+02_r8,1.0103e+03_r8,1.3189e+03_r8,1.6936e+03_r8,2.1455e+03_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &2.8549e-03_r8,4.8281e-03_r8,6.2570e-03_r8,8.2731e-03_r8,7.9056e-03_r8,7.7840e-03_r8, & + &1.0115e-02_r8,9.6599e-03_r8,1.0153e-02_r8,1.0921e-02_r8,1.2408e-02_r8,1.3496e-02_r8, & + &1.5059e-02_r8,1.4636e-02_r8,1.6483e-02_r8,1.2394e-02_r8/) + forrefo(2,:) = (/ & + &3.0036e-03_r8,5.1093e-03_r8,5.7317e-03_r8,9.2246e-03_r8,8.9829e-03_r8,8.6477e-03_r8, & + &1.1448e-02_r8,1.0391e-02_r8,1.0211e-02_r8,1.2921e-02_r8,1.2726e-02_r8,1.2426e-02_r8, & + &1.4609e-02_r8,1.5783e-02_r8,1.6617e-02_r8,1.6858e-02_r8/) + forrefo(3,:) = (/ & + &3.0771e-03_r8,5.1206e-03_r8,5.8426e-03_r8,9.5727e-03_r8,1.0338e-02_r8,9.3737e-03_r8, & + &1.2805e-02_r8,1.1272e-02_r8,1.1353e-02_r8,1.1837e-02_r8,1.1550e-02_r8,1.3020e-02_r8, & + &1.3536e-02_r8,1.6226e-02_r8,1.6039e-02_r8,2.2578e-02_r8/) + forrefo(4,:) = (/ & + &3.3072e-03_r8,5.0240e-03_r8,6.8474e-03_r8,8.2736e-03_r8,8.6151e-03_r8,8.6762e-03_r8, & + &1.1476e-02_r8,1.0246e-02_r8,1.0819e-02_r8,1.0640e-02_r8,1.0545e-02_r8,1.0533e-02_r8, & + &1.0496e-02_r8,1.0142e-02_r8,9.7979e-03_r8,1.5255e-02_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 7.25695e-01_r8, 6.53591e-01_r8, 5.88650e-01_r8, 5.30162e-01_r8, 4.77485e-01_r8, & + & 4.30042e-01_r8, 3.87313e-01_r8, 3.48830e-01_r8, 3.14170e-01_r8, 2.82954e-01_r8/) + selfrefo(:, 2) = (/ & + & 9.61996e-01_r8, 8.77853e-01_r8, 8.01070e-01_r8, 7.31003e-01_r8, 6.67064e-01_r8, & + & 6.08718e-01_r8, 5.55476e-01_r8, 5.06890e-01_r8, 4.62554e-01_r8, 4.22096e-01_r8/) + selfrefo(:, 3) = (/ & + & 9.72584e-01_r8, 9.02658e-01_r8, 8.37760e-01_r8, 7.77527e-01_r8, 7.21626e-01_r8, & + & 6.69743e-01_r8, 6.21591e-01_r8, 5.76900e-01_r8, 5.35423e-01_r8, 4.96927e-01_r8/) + selfrefo(:, 4) = (/ & + & 1.24790e+00_r8, 1.14353e+00_r8, 1.04790e+00_r8, 9.60263e-01_r8, 8.79956e-01_r8, & + & 8.06364e-01_r8, 7.38927e-01_r8, 6.77130e-01_r8, 6.20501e-01_r8, 5.68608e-01_r8/) + selfrefo(:, 5) = (/ & + & 1.23574e+00_r8, 1.12928e+00_r8, 1.03200e+00_r8, 9.43096e-01_r8, 8.61851e-01_r8, & + & 7.87605e-01_r8, 7.19755e-01_r8, 6.57750e-01_r8, 6.01087e-01_r8, 5.49305e-01_r8/) + selfrefo(:, 6) = (/ & + & 1.20921e+00_r8, 1.10660e+00_r8, 1.01270e+00_r8, 9.26766e-01_r8, 8.48124e-01_r8, & + & 7.76155e-01_r8, 7.10293e-01_r8, 6.50020e-01_r8, 5.94861e-01_r8, 5.44384e-01_r8/) + selfrefo(:, 7) = (/ & + & 1.38112e+00_r8, 1.26727e+00_r8, 1.16280e+00_r8, 1.06694e+00_r8, 9.78990e-01_r8, & + & 8.98287e-01_r8, 8.24236e-01_r8, 7.56290e-01_r8, 6.93945e-01_r8, 6.36739e-01_r8/) + selfrefo(:, 8) = (/ & + & 1.30321e+00_r8, 1.20127e+00_r8, 1.10730e+00_r8, 1.02068e+00_r8, 9.40840e-01_r8, & + & 8.67243e-01_r8, 7.99403e-01_r8, 7.36870e-01_r8, 6.79229e-01_r8, 6.26096e-01_r8/) + selfrefo(:, 9) = (/ & + & 1.26713e+00_r8, 1.17927e+00_r8, 1.09750e+00_r8, 1.02140e+00_r8, 9.50575e-01_r8, & + & 8.84662e-01_r8, 8.23319e-01_r8, 7.66230e-01_r8, 7.13099e-01_r8, 6.63653e-01_r8/) + selfrefo(:,10) = (/ & + & 1.49824e+00_r8, 1.37053e+00_r8, 1.25370e+00_r8, 1.14683e+00_r8, 1.04908e+00_r8, & + & 9.59651e-01_r8, 8.77849e-01_r8, 8.03020e-01_r8, 7.34569e-01_r8, 6.71954e-01_r8/) + selfrefo(:,11) = (/ & + & 1.44786e+00_r8, 1.34594e+00_r8, 1.25120e+00_r8, 1.16313e+00_r8, 1.08125e+00_r8, & + & 1.00514e+00_r8, 9.34392e-01_r8, 8.68620e-01_r8, 8.07477e-01_r8, 7.50639e-01_r8/) + selfrefo(:,12) = (/ & + & 1.38460e+00_r8, 1.30437e+00_r8, 1.22880e+00_r8, 1.15760e+00_r8, 1.09053e+00_r8, & + & 1.02735e+00_r8, 9.67825e-01_r8, 9.11750e-01_r8, 8.58924e-01_r8, 8.09159e-01_r8/) + selfrefo(:,13) = (/ & + & 1.51953e+00_r8, 1.42822e+00_r8, 1.34240e+00_r8, 1.26173e+00_r8, 1.18592e+00_r8, & + & 1.11465e+00_r8, 1.04768e+00_r8, 9.84720e-01_r8, 9.25548e-01_r8, 8.69932e-01_r8/) + selfrefo(:,14) = (/ & + & 1.62608e+00_r8, 1.51021e+00_r8, 1.40260e+00_r8, 1.30266e+00_r8, 1.20983e+00_r8, & + & 1.12363e+00_r8, 1.04356e+00_r8, 9.69200e-01_r8, 9.00138e-01_r8, 8.35998e-01_r8/) + selfrefo(:,15) = (/ & + & 1.65383e+00_r8, 1.54808e+00_r8, 1.44910e+00_r8, 1.35644e+00_r8, 1.26971e+00_r8, & + & 1.18853e+00_r8, 1.11254e+00_r8, 1.04140e+00_r8, 9.74813e-01_r8, 9.12484e-01_r8/) + selfrefo(:,16) = (/ & + & 1.78105e+00_r8, 1.61421e+00_r8, 1.46300e+00_r8, 1.32595e+00_r8, 1.20174e+00_r8, & + & 1.08917e+00_r8, 9.87141e-01_r8, 8.94670e-01_r8, 8.10861e-01_r8, 7.34904e-01_r8/) + + end subroutine lw_kgb02 + +! ************************************************************************** + subroutine lw_kgb03 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg03, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, & + kbo_mn2o, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level: P=212.7250 mbar, T = 223.06 K + fracrefao(:, 1) = (/ & + & 1.6251e-01_r8,1.5572e-01_r8,1.4557e-01_r8,1.3208e-01_r8,1.1582e-01_r8,9.6895e-02_r8, & + & 7.8720e-02_r8,5.8462e-02_r8,3.9631e-02_r8,4.3001e-03_r8,3.5555e-03_r8,2.8101e-03_r8, & + & 2.0547e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 2) = (/ & + & 1.6006e-01_r8,1.5576e-01_r8,1.4609e-01_r8,1.3276e-01_r8,1.1594e-01_r8,9.7336e-02_r8, & + & 7.9035e-02_r8,5.8696e-02_r8,3.9723e-02_r8,4.3001e-03_r8,3.5555e-03_r8,2.8101e-03_r8, & + & 2.0547e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 3) = (/ & + & 1.5952e-01_r8,1.5566e-01_r8,1.4590e-01_r8,1.3294e-01_r8,1.1599e-01_r8,9.7511e-02_r8, & + & 7.9127e-02_r8,5.8888e-02_r8,3.9874e-02_r8,4.3001e-03_r8,3.5555e-03_r8,2.8102e-03_r8, & + & 2.0547e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 4) = (/ & + & 1.5907e-01_r8,1.5541e-01_r8,1.4585e-01_r8,1.3316e-01_r8,1.1596e-01_r8,9.7647e-02_r8, & + & 7.9243e-02_r8,5.9024e-02_r8,4.0028e-02_r8,4.3112e-03_r8,3.5555e-03_r8,2.8102e-03_r8, & + & 2.0547e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 5) = (/ & + & 1.5862e-01_r8,1.5517e-01_r8,1.4588e-01_r8,1.3328e-01_r8,1.1585e-01_r8,9.7840e-02_r8, & + & 7.9364e-02_r8,5.9174e-02_r8,4.0160e-02_r8,4.3403e-03_r8,3.5900e-03_r8,2.8102e-03_r8, & + & 2.0547e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 6) = (/ & + & 1.5830e-01_r8,1.5490e-01_r8,1.4582e-01_r8,1.3331e-01_r8,1.1567e-01_r8,9.8079e-02_r8, & + & 7.9510e-02_r8,5.9369e-02_r8,4.0326e-02_r8,4.3343e-03_r8,3.5908e-03_r8,2.8527e-03_r8, & + & 2.0655e-03_r8,1.3109e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 7) = (/ & + & 1.5789e-01_r8,1.5435e-01_r8,1.4595e-01_r8,1.3304e-01_r8,1.1566e-01_r8,9.8426e-02_r8, & + & 7.9704e-02_r8,5.9618e-02_r8,4.0520e-02_r8,4.3812e-03_r8,3.6147e-03_r8,2.8395e-03_r8, & + & 2.1301e-03_r8,1.3145e-03_r8,4.9403e-04_r8,6.9515e-05_r8/) + fracrefao(:, 8) = (/ & + & 1.5704e-01_r8,1.5398e-01_r8,1.4564e-01_r8,1.3222e-01_r8,1.1586e-01_r8,9.9230e-02_r8, & + & 8.0011e-02_r8,6.0149e-02_r8,4.0790e-02_r8,4.4253e-03_r8,3.6534e-03_r8,2.9191e-03_r8, & + & 2.1373e-03_r8,1.3558e-03_r8,5.1631e-04_r8,7.8794e-05_r8/) + fracrefao(:, 9) = (/ & + & 1.5270e-01_r8,1.5126e-01_r8,1.4264e-01_r8,1.3106e-01_r8,1.1740e-01_r8,1.0137e-01_r8, & + & 8.3057e-02_r8,6.2282e-02_r8,4.2301e-02_r8,4.6486e-03_r8,3.8159e-03_r8,3.0472e-03_r8, & + & 2.2870e-03_r8,1.4818e-03_r8,5.6773e-04_r8,7.8794e-05_r8/) + +! Planck fraction mapping level: p = 95.8 mbar, t = 215.7 k + fracrefbo(:, 1) = (/ & + & 1.6413e-01_r8,1.5665e-01_r8,1.4606e-01_r8,1.3184e-01_r8,1.1517e-01_r8,9.6243e-02_r8, & + & 7.7982e-02_r8,5.8165e-02_r8,3.9311e-02_r8,4.2586e-03_r8,3.5189e-03_r8,2.7793e-03_r8, & + & 2.0376e-03_r8,1.2938e-03_r8,4.8853e-04_r8,6.8745e-05_r8/) + fracrefbo(:, 2) = (/ & + & 1.6254e-01_r8,1.5674e-01_r8,1.4652e-01_r8,1.3221e-01_r8,1.1535e-01_r8,9.6439e-02_r8, & + & 7.8155e-02_r8,5.8254e-02_r8,3.9343e-02_r8,4.2586e-03_r8,3.5189e-03_r8,2.7793e-03_r8, & + & 2.0376e-03_r8,1.2938e-03_r8,4.8853e-04_r8,6.8745e-05_r8/) + fracrefbo(:, 3) = (/ & + & 1.6177e-01_r8,1.5664e-01_r8,1.4669e-01_r8,1.3242e-01_r8,1.1541e-01_r8,9.6536e-02_r8, & + & 7.8257e-02_r8,5.8387e-02_r8,3.9431e-02_r8,4.2587e-03_r8,3.5189e-03_r8,2.7793e-03_r8, & + & 2.0376e-03_r8,1.2938e-03_r8,4.8853e-04_r8,6.8745e-05_r8/) + fracrefbo(:, 4) = (/ & + & 1.6077e-01_r8,1.5679e-01_r8,1.4648e-01_r8,1.3273e-01_r8,1.1546e-01_r8,9.6779e-02_r8, & + & 7.8371e-02_r8,5.8546e-02_r8,3.9611e-02_r8,4.2772e-03_r8,3.5190e-03_r8,2.7793e-03_r8, & + & 2.0376e-03_r8,1.2938e-03_r8,4.8853e-04_r8,6.8745e-05_r8/) + fracrefbo(:, 5) = (/ & + & 1.6067e-01_r8,1.5608e-01_r8,1.4247e-01_r8,1.2881e-01_r8,1.1449e-01_r8,9.8802e-02_r8, & + & 8.0828e-02_r8,6.0977e-02_r8,4.1494e-02_r8,4.5116e-03_r8,3.7290e-03_r8,2.9460e-03_r8, & + & 2.1948e-03_r8,1.3778e-03_r8,5.4552e-04_r8,7.9969e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &3.1886e-07_r8,1.8969e-04_r8,4.1239e-04_r8,6.4667e-04_r8,8.5292e-04_r8,1.1836e-03_r8, & + &1.4006e-03_r8,1.5411e-03_r8,8.3293e-04_r8/) + kao(:, 2, 1, 1) = (/ & + &4.3208e-07_r8,2.2286e-04_r8,4.4627e-04_r8,7.2330e-04_r8,9.3694e-04_r8,1.2337e-03_r8, & + &1.5482e-03_r8,1.7773e-03_r8,1.0038e-03_r8/) + kao(:, 3, 1, 1) = (/ & + &5.8834e-07_r8,2.6143e-04_r8,5.0441e-04_r8,7.7424e-04_r8,1.0403e-03_r8,1.3331e-03_r8, & + &1.7908e-03_r8,2.0845e-03_r8,1.1619e-03_r8/) + kao(:, 4, 1, 1) = (/ & + &7.9926e-07_r8,3.0532e-04_r8,5.7655e-04_r8,8.4667e-04_r8,1.1189e-03_r8,1.4849e-03_r8, & + &1.7793e-03_r8,2.3392e-03_r8,1.2758e-03_r8/) + kao(:, 5, 1, 1) = (/ & + &1.0726e-06_r8,3.5559e-04_r8,6.6472e-04_r8,9.5586e-04_r8,1.2287e-03_r8,1.5629e-03_r8, & + &1.9684e-03_r8,2.6521e-03_r8,1.4781e-03_r8/) + kao(:, 1, 2, 1) = (/ & + &3.7301e-07_r8,1.5101e-04_r8,3.0613e-04_r8,5.2444e-04_r8,6.6785e-04_r8,9.0347e-04_r8, & + &1.1047e-03_r8,1.2717e-03_r8,6.0920e-04_r8/) + kao(:, 2, 2, 1) = (/ & + &5.0464e-07_r8,1.7900e-04_r8,3.4606e-04_r8,5.4112e-04_r8,7.7706e-04_r8,9.3108e-04_r8, & + &1.2909e-03_r8,1.4671e-03_r8,7.3637e-04_r8/) + kao(:, 3, 2, 1) = (/ & + &6.9109e-07_r8,2.1210e-04_r8,4.0308e-04_r8,5.9670e-04_r8,8.3572e-04_r8,1.0539e-03_r8, & + &1.2895e-03_r8,1.6281e-03_r8,8.3917e-04_r8/) + kao(:, 4, 2, 1) = (/ & + &9.4449e-07_r8,2.4973e-04_r8,4.6862e-04_r8,6.7662e-04_r8,9.0294e-04_r8,1.1388e-03_r8, & + &1.4230e-03_r8,1.8780e-03_r8,9.5236e-04_r8/) + kao(:, 5, 2, 1) = (/ & + &1.2785e-06_r8,2.9283e-04_r8,5.4407e-04_r8,7.7522e-04_r8,1.0053e-03_r8,1.2254e-03_r8, & + &1.5592e-03_r8,1.9031e-03_r8,1.1164e-03_r8/) + kao(:, 1, 3, 1) = (/ & + &5.5921e-07_r8,1.1924e-04_r8,2.2509e-04_r8,3.4318e-04_r8,5.2308e-04_r8,6.5616e-04_r8, & + &8.5230e-04_r8,1.0069e-03_r8,4.1268e-04_r8/) + kao(:, 2, 3, 1) = (/ & + &7.5055e-07_r8,1.4483e-04_r8,2.6805e-04_r8,3.9345e-04_r8,5.4245e-04_r8,7.6863e-04_r8, & + &8.6931e-04_r8,1.1266e-03_r8,5.0829e-04_r8/) + kao(:, 3, 3, 1) = (/ & + &1.0282e-06_r8,1.7418e-04_r8,3.1823e-04_r8,4.6052e-04_r8,6.0646e-04_r8,8.0699e-04_r8, & + &9.9010e-04_r8,1.2822e-03_r8,5.8353e-04_r8/) + kao(:, 4, 3, 1) = (/ & + &1.4165e-06_r8,2.0776e-04_r8,3.7640e-04_r8,5.3896e-04_r8,6.9736e-04_r8,8.7108e-04_r8, & + &1.0948e-03_r8,1.3035e-03_r8,6.8429e-04_r8/) + kao(:, 5, 3, 1) = (/ & + &1.9344e-06_r8,2.4744e-04_r8,4.4263e-04_r8,6.2983e-04_r8,8.0258e-04_r8,9.7503e-04_r8, & + &1.1651e-03_r8,1.4497e-03_r8,8.1461e-04_r8/) + kao(:, 1, 4, 1) = (/ & + &8.5732e-07_r8,9.6467e-05_r8,1.7424e-04_r8,2.5100e-04_r8,3.3065e-04_r8,4.8724e-04_r8, & + &6.0299e-04_r8,7.8582e-04_r8,2.9808e-04_r8/) + kao(:, 2, 4, 1) = (/ & + &1.1308e-06_r8,1.1826e-04_r8,2.1303e-04_r8,3.0261e-04_r8,3.9186e-04_r8,5.0849e-04_r8, & + &7.0322e-04_r8,8.2275e-04_r8,3.5462e-04_r8/) + kao(:, 3, 4, 1) = (/ & + &1.5409e-06_r8,1.4413e-04_r8,2.5818e-04_r8,3.6263e-04_r8,4.6469e-04_r8,5.7592e-04_r8, & + &7.3867e-04_r8,8.7496e-04_r8,4.2760e-04_r8/) + kao(:, 4, 4, 1) = (/ & + &2.1300e-06_r8,1.7563e-04_r8,3.1026e-04_r8,4.3228e-04_r8,5.4859e-04_r8,6.6681e-04_r8, & + &7.9581e-04_r8,9.9932e-04_r8,5.0892e-04_r8/) + kao(:, 5, 4, 1) = (/ & + &2.9291e-06_r8,2.1272e-04_r8,3.6864e-04_r8,5.1165e-04_r8,6.4677e-04_r8,7.7619e-04_r8, & + &8.9814e-04_r8,1.0897e-03_r8,6.0064e-04_r8/) + kao(:, 1, 5, 1) = (/ & + &1.2415e-06_r8,7.8277e-05_r8,1.3778e-04_r8,1.9284e-04_r8,2.4740e-04_r8,3.0422e-04_r8, & + &4.5046e-04_r8,5.5097e-04_r8,2.1557e-04_r8/) + kao(:, 2, 5, 1) = (/ & + &1.5909e-06_r8,9.7521e-05_r8,1.7125e-04_r8,2.3852e-04_r8,3.0221e-04_r8,3.6563e-04_r8, & + &4.6525e-04_r8,6.1320e-04_r8,2.5987e-04_r8/) + kao(:, 3, 5, 1) = (/ & + &2.1423e-06_r8,1.2163e-04_r8,2.0881e-04_r8,2.9129e-04_r8,3.6625e-04_r8,4.3908e-04_r8, & + &5.2524e-04_r8,7.1422e-04_r8,3.1853e-04_r8/) + kao(:, 4, 5, 1) = (/ & + &2.9538e-06_r8,1.5072e-04_r8,2.5416e-04_r8,3.5255e-04_r8,4.4063e-04_r8,5.2156e-04_r8, & + &6.0639e-04_r8,7.4820e-04_r8,3.8686e-04_r8/) + kao(:, 5, 5, 1) = (/ & + &4.0808e-06_r8,1.8492e-04_r8,3.0793e-04_r8,4.2155e-04_r8,5.2630e-04_r8,6.1892e-04_r8, & + &7.0820e-04_r8,8.0049e-04_r8,4.6257e-04_r8/) + kao(:, 1, 6, 1) = (/ & + &1.7276e-06_r8,6.3066e-05_r8,1.0985e-04_r8,1.5043e-04_r8,1.8792e-04_r8,2.2547e-04_r8, & + &2.7278e-04_r8,4.0029e-04_r8,1.5625e-04_r8/) + kao(:, 2, 6, 1) = (/ & + &2.1189e-06_r8,8.0476e-05_r8,1.3664e-04_r8,1.8841e-04_r8,2.3492e-04_r8,2.7888e-04_r8, & + &3.2236e-04_r8,4.6057e-04_r8,1.9653e-04_r8/) + kao(:, 3, 6, 1) = (/ & + &2.7917e-06_r8,1.0200e-04_r8,1.6954e-04_r8,2.3141e-04_r8,2.8961e-04_r8,3.4143e-04_r8, & + &3.9023e-04_r8,4.8352e-04_r8,2.3947e-04_r8/) + kao(:, 4, 6, 1) = (/ & + &3.8168e-06_r8,1.2811e-04_r8,2.1054e-04_r8,2.8370e-04_r8,3.5217e-04_r8,4.1385e-04_r8, & + &4.6780e-04_r8,5.3253e-04_r8,2.9421e-04_r8/) + kao(:, 5, 6, 1) = (/ & + &5.2799e-06_r8,1.5893e-04_r8,2.5910e-04_r8,3.4517e-04_r8,4.2434e-04_r8,4.9842e-04_r8, & + &5.5728e-04_r8,6.1195e-04_r8,3.4978e-04_r8/) + kao(:, 1, 7, 1) = (/ & + &2.6141e-06_r8,5.1662e-05_r8,8.7249e-05_r8,1.2099e-04_r8,1.4820e-04_r8,1.7386e-04_r8, & + &1.9973e-04_r8,2.8823e-04_r8,1.2462e-04_r8/) + kao(:, 2, 7, 1) = (/ & + &3.0451e-06_r8,6.6903e-05_r8,1.1099e-04_r8,1.5079e-04_r8,1.8779e-04_r8,2.1746e-04_r8, & + &2.4532e-04_r8,2.8791e-04_r8,1.5686e-04_r8/) + kao(:, 3, 7, 1) = (/ & + &3.8821e-06_r8,8.6234e-05_r8,1.4155e-04_r8,1.8817e-04_r8,2.3079e-04_r8,2.7142e-04_r8, & + &3.0362e-04_r8,3.3424e-04_r8,1.9309e-04_r8/) + kao(:, 4, 7, 1) = (/ & + &5.2168e-06_r8,1.0990e-04_r8,1.7879e-04_r8,2.3488e-04_r8,2.8585e-04_r8,3.3138e-04_r8, & + &3.7038e-04_r8,4.0029e-04_r8,2.2841e-04_r8/) + kao(:, 5, 7, 1) = (/ & + &7.1879e-06_r8,1.3891e-04_r8,2.2275e-04_r8,2.9114e-04_r8,3.5068e-04_r8,4.0298e-04_r8, & + &4.4929e-04_r8,4.7758e-04_r8,2.7333e-04_r8/) + kao(:, 1, 8, 1) = (/ & + &4.8895e-06_r8,4.6642e-05_r8,7.3353e-05_r8,9.8230e-05_r8,1.2186e-04_r8,1.4040e-04_r8, & + &1.5472e-04_r8,1.7158e-04_r8,1.2116e-04_r8/) + kao(:, 2, 8, 1) = (/ & + &5.4032e-06_r8,6.0479e-05_r8,9.5191e-05_r8,1.2606e-04_r8,1.5260e-04_r8,1.7774e-04_r8, & + &1.9641e-04_r8,2.0965e-04_r8,1.4264e-04_r8/) + kao(:, 3, 8, 1) = (/ & + &6.5997e-06_r8,7.8772e-05_r8,1.2353e-04_r8,1.6212e-04_r8,1.9427e-04_r8,2.2313e-04_r8, & + &2.4636e-04_r8,2.5986e-04_r8,1.7188e-04_r8/) + kao(:, 4, 8, 1) = (/ & + &8.6548e-06_r8,1.0205e-04_r8,1.5903e-04_r8,2.0720e-04_r8,2.4581e-04_r8,2.7759e-04_r8, & + &3.0314e-04_r8,3.2037e-04_r8,2.0203e-04_r8/) + kao(:, 5, 8, 1) = (/ & + &1.1792e-05_r8,1.3168e-04_r8,2.0236e-04_r8,2.6066e-04_r8,3.0759e-04_r8,3.4497e-04_r8, & + &3.7389e-04_r8,3.8968e-04_r8,2.4008e-04_r8/) + kao(:, 1, 9, 1) = (/ & + &1.7686e-05_r8,6.2925e-05_r8,8.5198e-05_r8,1.0213e-04_r8,1.1543e-04_r8,1.2780e-04_r8, & + &1.3994e-04_r8,1.4164e-04_r8,1.0306e-04_r8/) + kao(:, 2, 9, 1) = (/ & + &1.8629e-05_r8,7.9145e-05_r8,1.0839e-04_r8,1.3177e-04_r8,1.5002e-04_r8,1.6481e-04_r8, & + &1.7578e-04_r8,1.8331e-04_r8,1.3692e-04_r8/) + kao(:, 3, 9, 1) = (/ & + &2.1655e-05_r8,1.0259e-04_r8,1.4047e-04_r8,1.7139e-04_r8,1.9624e-04_r8,2.1451e-04_r8, & + &2.2698e-04_r8,2.2863e-04_r8,1.7350e-04_r8/) + kao(:, 4, 9, 1) = (/ & + &2.7461e-05_r8,1.3575e-04_r8,1.8409e-04_r8,2.2366e-04_r8,2.5484e-04_r8,2.7815e-04_r8, & + &2.9152e-04_r8,2.8719e-04_r8,2.1425e-04_r8/) + kao(:, 5, 9, 1) = (/ & + &3.6727e-05_r8,1.8189e-04_r8,2.4258e-04_r8,2.9022e-04_r8,3.2921e-04_r8,3.5617e-04_r8, & + &3.6983e-04_r8,3.5850e-04_r8,2.5866e-04_r8/) + kao(:, 1,10, 1) = (/ & + &7.2663e-05_r8,1.2805e-04_r8,1.4610e-04_r8,1.5523e-04_r8,1.5931e-04_r8,1.5768e-04_r8, & + &1.4950e-04_r8,1.3593e-04_r8,1.1207e-04_r8/) + kao(:, 2,10, 1) = (/ & + &7.4019e-05_r8,1.5108e-04_r8,1.7625e-04_r8,1.9103e-04_r8,1.9729e-04_r8,1.9817e-04_r8, & + &1.9144e-04_r8,1.7408e-04_r8,1.5499e-04_r8/) + kao(:, 3,10, 1) = (/ & + &8.2403e-05_r8,1.8863e-04_r8,2.2414e-04_r8,2.4536e-04_r8,2.5373e-04_r8,2.5549e-04_r8, & + &2.4939e-04_r8,2.2811e-04_r8,2.0551e-04_r8/) + kao(:, 4,10, 1) = (/ & + &1.0093e-04_r8,2.4723e-04_r8,2.9626e-04_r8,3.2296e-04_r8,3.3348e-04_r8,3.3522e-04_r8, & + &3.2677e-04_r8,2.9826e-04_r8,2.6379e-04_r8/) + kao(:, 5,10, 1) = (/ & + &1.3200e-04_r8,3.3367e-04_r8,4.0011e-04_r8,4.3332e-04_r8,4.4493e-04_r8,4.4261e-04_r8, & + &4.2611e-04_r8,3.8581e-04_r8,3.2912e-04_r8/) + kao(:, 1,11, 1) = (/ & + &1.0393e-04_r8,1.5840e-04_r8,1.7203e-04_r8,1.7648e-04_r8,1.7454e-04_r8,1.6667e-04_r8, & + &1.5308e-04_r8,1.2939e-04_r8,1.0993e-04_r8/) + kao(:, 2,11, 1) = (/ & + &1.0623e-04_r8,1.8473e-04_r8,2.0510e-04_r8,2.1424e-04_r8,2.1529e-04_r8,2.0732e-04_r8, & + &1.9332e-04_r8,1.6735e-04_r8,1.5034e-04_r8/) + kao(:, 3,11, 1) = (/ & + &1.1880e-04_r8,2.2821e-04_r8,2.5935e-04_r8,2.7369e-04_r8,2.7717e-04_r8,2.6782e-04_r8, & + &2.5002e-04_r8,2.1993e-04_r8,1.9822e-04_r8/) + kao(:, 4,11, 1) = (/ & + &1.4561e-04_r8,2.9665e-04_r8,3.4318e-04_r8,3.6287e-04_r8,3.6642e-04_r8,3.5386e-04_r8, & + &3.2944e-04_r8,2.8811e-04_r8,2.5319e-04_r8/) + kao(:, 5,11, 1) = (/ & + &1.9054e-04_r8,3.9809e-04_r8,4.6486e-04_r8,4.9198e-04_r8,4.9373e-04_r8,4.7462e-04_r8, & + &4.3676e-04_r8,3.7664e-04_r8,3.1222e-04_r8/) + kao(:, 1,12, 1) = (/ & + &1.1070e-04_r8,1.5948e-04_r8,1.6935e-04_r8,1.7123e-04_r8,1.6742e-04_r8,1.5636e-04_r8, & + &1.4108e-04_r8,1.1641e-04_r8,9.3609e-05_r8/) + kao(:, 2,12, 1) = (/ & + &1.1350e-04_r8,1.8499e-04_r8,2.0156e-04_r8,2.0690e-04_r8,2.0458e-04_r8,1.9450e-04_r8, & + &1.7678e-04_r8,1.4985e-04_r8,1.2839e-04_r8/) + kao(:, 3,12, 1) = (/ & + &1.2733e-04_r8,2.2735e-04_r8,2.5402e-04_r8,2.6442e-04_r8,2.6348e-04_r8,2.5189e-04_r8, & + &2.2992e-04_r8,1.9655e-04_r8,1.6928e-04_r8/) + kao(:, 4,12, 1) = (/ & + &1.5627e-04_r8,2.9456e-04_r8,3.3549e-04_r8,3.5142e-04_r8,3.5055e-04_r8,3.3475e-04_r8, & + &3.0473e-04_r8,2.5892e-04_r8,2.1653e-04_r8/) + kao(:, 5,12, 1) = (/ & + &2.0441e-04_r8,3.9462e-04_r8,4.5461e-04_r8,4.7637e-04_r8,4.7456e-04_r8,4.5071e-04_r8, & + &4.0805e-04_r8,3.4047e-04_r8,2.6779e-04_r8/) + kao(:, 1,13, 1) = (/ & + &9.4796e-05_r8,1.3566e-04_r8,1.4361e-04_r8,1.4479e-04_r8,1.4118e-04_r8,1.3147e-04_r8, & + &1.1819e-04_r8,9.7170e-05_r8,7.6303e-05_r8/) + kao(:, 2,13, 1) = (/ & + &9.7387e-05_r8,1.5742e-04_r8,1.7115e-04_r8,1.7535e-04_r8,1.7300e-04_r8,1.6383e-04_r8, & + &1.4824e-04_r8,1.2513e-04_r8,1.0469e-04_r8/) + kao(:, 3,13, 1) = (/ & + &1.0948e-04_r8,1.9354e-04_r8,2.1601e-04_r8,2.2450e-04_r8,2.2321e-04_r8,2.1287e-04_r8, & + &1.9350e-04_r8,1.6433e-04_r8,1.3819e-04_r8/) + kao(:, 4,13, 1) = (/ & + &1.3445e-04_r8,2.5083e-04_r8,2.8549e-04_r8,2.9847e-04_r8,2.9725e-04_r8,2.8343e-04_r8, & + &2.5763e-04_r8,2.1720e-04_r8,1.7601e-04_r8/) + kao(:, 5,13, 1) = (/ & + &1.7573e-04_r8,3.3657e-04_r8,3.8710e-04_r8,4.0560e-04_r8,4.0357e-04_r8,3.8257e-04_r8, & + &3.4653e-04_r8,2.8685e-04_r8,2.1855e-04_r8/) + kao(:, 1, 1, 2) = (/ & + &1.3073e-06_r8,4.2059e-04_r8,6.7561e-04_r8,8.6609e-04_r8,1.3520e-03_r8,1.6085e-03_r8, & + &2.0908e-03_r8,3.5262e-03_r8,1.7846e-03_r8/) + kao(:, 2, 1, 2) = (/ & + &1.8197e-06_r8,5.0768e-04_r8,8.4110e-04_r8,1.0238e-03_r8,1.3765e-03_r8,1.9239e-03_r8, & + &2.2997e-03_r8,3.5756e-03_r8,2.0767e-03_r8/) + kao(:, 3, 1, 2) = (/ & + &2.5084e-06_r8,6.1290e-04_r8,1.0202e-03_r8,1.2693e-03_r8,1.5516e-03_r8,2.0078e-03_r8, & + &2.5461e-03_r8,3.4922e-03_r8,2.2668e-03_r8/) + kao(:, 4, 1, 2) = (/ & + &3.4224e-06_r8,7.3392e-04_r8,1.2104e-03_r8,1.5455e-03_r8,1.8866e-03_r8,2.1966e-03_r8, & + &2.9624e-03_r8,3.8708e-03_r8,2.5909e-03_r8/) + kao(:, 5, 1, 2) = (/ & + &4.5990e-06_r8,8.7030e-04_r8,1.4253e-03_r8,1.8395e-03_r8,2.2537e-03_r8,2.6314e-03_r8, & + &3.0779e-03_r8,4.2442e-03_r8,2.9663e-03_r8/) + kao(:, 1, 2, 2) = (/ & + &1.5178e-06_r8,3.4269e-04_r8,6.0748e-04_r8,7.1986e-04_r8,9.3674e-04_r8,1.3121e-03_r8, & + &1.6102e-03_r8,2.4069e-03_r8,1.3247e-03_r8/) + kao(:, 2, 2, 2) = (/ & + &2.1299e-06_r8,4.2524e-04_r8,7.3703e-04_r8,9.3776e-04_r8,1.0398e-03_r8,1.4367e-03_r8, & + &1.7353e-03_r8,2.4061e-03_r8,1.5243e-03_r8/) + kao(:, 3, 2, 2) = (/ & + &2.9612e-06_r8,5.1753e-04_r8,8.8626e-04_r8,1.1500e-03_r8,1.2896e-03_r8,1.5263e-03_r8, & + &2.0876e-03_r8,2.6389e-03_r8,1.6966e-03_r8/) + kao(:, 4, 2, 2) = (/ & + &4.0897e-06_r8,6.2596e-04_r8,1.0597e-03_r8,1.3843e-03_r8,1.5850e-03_r8,1.8098e-03_r8, & + &2.1268e-03_r8,2.8656e-03_r8,1.9584e-03_r8/) + kao(:, 5, 2, 2) = (/ & + &5.5687e-06_r8,7.4555e-04_r8,1.2600e-03_r8,1.6347e-03_r8,1.9070e-03_r8,2.1914e-03_r8, & + &2.4166e-03_r8,3.3007e-03_r8,2.2669e-03_r8/) + kao(:, 1, 3, 2) = (/ & + &2.2234e-06_r8,2.7444e-04_r8,5.0085e-04_r8,6.9534e-04_r8,7.7629e-04_r8,8.8854e-04_r8, & + &1.1917e-03_r8,1.5373e-03_r8,9.1595e-04_r8/) + kao(:, 2, 3, 2) = (/ & + &3.1317e-06_r8,3.4263e-04_r8,6.2257e-04_r8,8.4941e-04_r8,1.0127e-03_r8,1.0143e-03_r8, & + &1.3362e-03_r8,1.6583e-03_r8,1.0393e-03_r8/) + kao(:, 3, 3, 2) = (/ & + &4.4080e-06_r8,4.2422e-04_r8,7.6347e-04_r8,1.0279e-03_r8,1.2387e-03_r8,1.2967e-03_r8, & + &1.3932e-03_r8,1.8408e-03_r8,1.2152e-03_r8/) + kao(:, 4, 3, 2) = (/ & + &6.1670e-06_r8,5.2130e-04_r8,9.2425e-04_r8,1.2412e-03_r8,1.4849e-03_r8,1.6022e-03_r8, & + &1.6415e-03_r8,2.0935e-03_r8,1.4201e-03_r8/) + kao(:, 5, 3, 2) = (/ & + &8.5264e-06_r8,6.3507e-04_r8,1.1072e-03_r8,1.4843e-03_r8,1.7747e-03_r8,1.9362e-03_r8, & + &2.0233e-03_r8,2.1572e-03_r8,1.6619e-03_r8/) + kao(:, 1, 4, 2) = (/ & + &3.2835e-06_r8,2.2111e-04_r8,3.9199e-04_r8,5.4782e-04_r8,7.1479e-04_r8,7.6154e-04_r8, & + &8.2345e-04_r8,1.0888e-03_r8,6.1749e-04_r8/) + kao(:, 2, 4, 2) = (/ & + &4.6177e-06_r8,2.8239e-04_r8,4.9392e-04_r8,6.9299e-04_r8,8.7089e-04_r8,1.0035e-03_r8, & + &9.4113e-04_r8,1.2776e-03_r8,7.2212e-04_r8/) + kao(:, 3, 4, 2) = (/ & + &6.5470e-06_r8,3.5777e-04_r8,6.1550e-04_r8,8.6066e-04_r8,1.0686e-03_r8,1.2181e-03_r8, & + &1.2204e-03_r8,1.3196e-03_r8,8.5856e-04_r8/) + kao(:, 4, 4, 2) = (/ & + &9.2896e-06_r8,4.4826e-04_r8,7.6106e-04_r8,1.0547e-03_r8,1.2989e-03_r8,1.4671e-03_r8, & + &1.5260e-03_r8,1.4238e-03_r8,1.0237e-03_r8/) + kao(:, 5, 4, 2) = (/ & + &1.3071e-05_r8,5.5733e-04_r8,9.3625e-04_r8,1.2821e-03_r8,1.5559e-03_r8,1.7516e-03_r8, & + &1.8364e-03_r8,1.7115e-03_r8,1.2165e-03_r8/) + kao(:, 1, 5, 2) = (/ & + &4.5002e-06_r8,1.7869e-04_r8,3.1112e-04_r8,4.2906e-04_r8,5.3570e-04_r8,6.6321e-04_r8, & + &6.6606e-04_r8,8.0088e-04_r8,4.3845e-04_r8/) + kao(:, 2, 5, 2) = (/ & + &6.2709e-06_r8,2.3526e-04_r8,3.9946e-04_r8,5.4822e-04_r8,6.8446e-04_r8,8.1650e-04_r8, & + &8.9841e-04_r8,8.3661e-04_r8,5.3250e-04_r8/) + kao(:, 3, 5, 2) = (/ & + &8.9215e-06_r8,3.0515e-04_r8,5.1007e-04_r8,6.9053e-04_r8,8.5739e-04_r8,1.0092e-03_r8, & + &1.0997e-03_r8,9.5118e-04_r8,6.4123e-04_r8/) + kao(:, 4, 5, 2) = (/ & + &1.2814e-05_r8,3.9188e-04_r8,6.4418e-04_r8,8.6120e-04_r8,1.0618e-03_r8,1.2430e-03_r8, & + &1.3327e-03_r8,1.2360e-03_r8,7.6830e-04_r8/) + kao(:, 5, 5, 2) = (/ & + &1.8376e-05_r8,4.9865e-04_r8,8.0644e-04_r8,1.0670e-03_r8,1.3038e-03_r8,1.5043e-03_r8, & + &1.6049e-03_r8,1.5432e-03_r8,9.1314e-04_r8/) + kao(:, 1, 6, 2) = (/ & + &5.7892e-06_r8,1.4663e-04_r8,2.4065e-04_r8,3.3064e-04_r8,4.1135e-04_r8,4.8169e-04_r8, & + &5.8379e-04_r8,5.7710e-04_r8,3.1814e-04_r8/) + kao(:, 2, 6, 2) = (/ & + &7.9690e-06_r8,1.9590e-04_r8,3.2041e-04_r8,4.3222e-04_r8,5.3334e-04_r8,6.2056e-04_r8, & + &7.1751e-04_r8,6.6758e-04_r8,3.9067e-04_r8/) + kao(:, 3, 6, 2) = (/ & + &1.1323e-05_r8,2.6004e-04_r8,4.1914e-04_r8,5.5855e-04_r8,6.8140e-04_r8,7.8989e-04_r8, & + &8.8852e-04_r8,8.8775e-04_r8,4.8310e-04_r8/) + kao(:, 4, 6, 2) = (/ & + &1.6358e-05_r8,3.4053e-04_r8,5.4044e-04_r8,7.1305e-04_r8,8.6088e-04_r8,9.8765e-04_r8, & + &1.0974e-03_r8,1.1000e-03_r8,5.7948e-04_r8/) + kao(:, 5, 6, 2) = (/ & + &2.3775e-05_r8,4.4089e-04_r8,6.9082e-04_r8,9.0148e-04_r8,1.0783e-03_r8,1.2236e-03_r8, & + &1.3409e-03_r8,1.3317e-03_r8,6.9627e-04_r8/) + kao(:, 1, 7, 2) = (/ & + &8.0091e-06_r8,1.2605e-04_r8,1.9716e-04_r8,2.5635e-04_r8,3.1697e-04_r8,3.6727e-04_r8, & + &4.1064e-04_r8,4.3234e-04_r8,2.4150e-04_r8/) + kao(:, 2, 7, 2) = (/ & + &1.0776e-05_r8,1.7034e-04_r8,2.6589e-04_r8,3.4715e-04_r8,4.2062e-04_r8,4.8583e-04_r8, & + &5.3757e-04_r8,5.9551e-04_r8,2.9725e-04_r8/) + kao(:, 3, 7, 2) = (/ & + &1.5189e-05_r8,2.2959e-04_r8,3.5476e-04_r8,4.5964e-04_r8,5.5426e-04_r8,6.3049e-04_r8, & + &6.9328e-04_r8,7.3902e-04_r8,3.6802e-04_r8/) + kao(:, 4, 7, 2) = (/ & + &2.2007e-05_r8,3.0657e-04_r8,4.6692e-04_r8,5.9983e-04_r8,7.1322e-04_r8,8.0913e-04_r8, & + &8.7898e-04_r8,9.1398e-04_r8,4.5358e-04_r8/) + kao(:, 5, 7, 2) = (/ & + &3.2377e-05_r8,4.0363e-04_r8,6.0728e-04_r8,7.7481e-04_r8,9.1139e-04_r8,1.0238e-03_r8, & + &1.0988e-03_r8,1.1244e-03_r8,5.4283e-04_r8/) + kao(:, 1, 8, 2) = (/ & + &1.3646e-05_r8,1.1718e-04_r8,1.7739e-04_r8,2.2327e-04_r8,2.5768e-04_r8,2.9227e-04_r8, & + &3.2168e-04_r8,3.3945e-04_r8,2.0435e-04_r8/) + kao(:, 2, 8, 2) = (/ & + &1.7797e-05_r8,1.5982e-04_r8,2.4160e-04_r8,3.0351e-04_r8,3.5441e-04_r8,3.9644e-04_r8, & + &4.3035e-04_r8,4.4547e-04_r8,2.6027e-04_r8/) + kao(:, 3, 8, 2) = (/ & + &2.4726e-05_r8,2.1816e-04_r8,3.2650e-04_r8,4.0893e-04_r8,4.7479e-04_r8,5.2784e-04_r8, & + &5.6990e-04_r8,5.8414e-04_r8,3.2342e-04_r8/) + kao(:, 4, 8, 2) = (/ & + &3.5739e-05_r8,2.9719e-04_r8,4.3967e-04_r8,5.4459e-04_r8,6.2961e-04_r8,6.9435e-04_r8, & + &7.4016e-04_r8,7.4703e-04_r8,3.9508e-04_r8/) + kao(:, 5, 8, 2) = (/ & + &5.2993e-05_r8,4.0333e-04_r8,5.8500e-04_r8,7.1845e-04_r8,8.2505e-04_r8,9.0108e-04_r8, & + &9.4665e-04_r8,9.4587e-04_r8,4.7280e-04_r8/) + kao(:, 1, 9, 2) = (/ & + &4.5250e-05_r8,1.4686e-04_r8,2.0230e-04_r8,2.4828e-04_r8,2.8036e-04_r8,2.9801e-04_r8, & + &2.9921e-04_r8,2.8815e-04_r8,2.4577e-04_r8/) + kao(:, 2, 9, 2) = (/ & + &5.6592e-05_r8,2.0110e-04_r8,2.8181e-04_r8,3.4405e-04_r8,3.8167e-04_r8,4.0863e-04_r8, & + &4.1514e-04_r8,3.9115e-04_r8,3.2441e-04_r8/) + kao(:, 3, 9, 2) = (/ & + &7.7017e-05_r8,2.8027e-04_r8,3.9316e-04_r8,4.7187e-04_r8,5.1925e-04_r8,5.5669e-04_r8, & + &5.6308e-04_r8,5.3177e-04_r8,4.1003e-04_r8/) + kao(:, 4, 9, 2) = (/ & + &1.1025e-04_r8,3.9471e-04_r8,5.4612e-04_r8,6.4824e-04_r8,7.1055e-04_r8,7.5245e-04_r8, & + &7.5557e-04_r8,7.0714e-04_r8,5.0547e-04_r8/) + kao(:, 5, 9, 2) = (/ & + &1.6377e-04_r8,5.5266e-04_r8,7.5260e-04_r8,8.8463e-04_r8,9.6217e-04_r8,1.0084e-03_r8, & + &1.0010e-03_r8,9.2831e-04_r8,5.9992e-04_r8/) + kao(:, 1,10, 2) = (/ & + &1.7408e-04_r8,2.8709e-04_r8,3.2527e-04_r8,3.4835e-04_r8,3.5894e-04_r8,3.5919e-04_r8, & + &3.5263e-04_r8,3.1484e-04_r8,2.7571e-04_r8/) + kao(:, 2,10, 2) = (/ & + &2.0961e-04_r8,3.6816e-04_r8,4.3143e-04_r8,4.6881e-04_r8,4.9659e-04_r8,5.0147e-04_r8, & + &4.9272e-04_r8,4.3339e-04_r8,3.8859e-04_r8/) + kao(:, 3,10, 2) = (/ & + &2.7776e-04_r8,5.0192e-04_r8,5.9603e-04_r8,6.5181e-04_r8,6.9357e-04_r8,7.0312e-04_r8, & + &6.7864e-04_r8,5.9253e-04_r8,5.1467e-04_r8/) + kao(:, 4,10, 2) = (/ & + &3.9424e-04_r8,7.1243e-04_r8,8.4498e-04_r8,9.2473e-04_r8,9.7484e-04_r8,9.8216e-04_r8, & + &9.3644e-04_r8,8.0724e-04_r8,6.5632e-04_r8/) + kao(:, 5,10, 2) = (/ & + &5.8403e-04_r8,1.0226e-03_r8,1.2011e-03_r8,1.3089e-03_r8,1.3689e-03_r8,1.3686e-03_r8, & + &1.2847e-03_r8,1.0916e-03_r8,8.0745e-04_r8/) + kao(:, 1,11, 2) = (/ & + &2.5093e-04_r8,3.5665e-04_r8,3.8701e-04_r8,3.9631e-04_r8,3.9372e-04_r8,3.8144e-04_r8, & + &3.5373e-04_r8,3.1423e-04_r8,3.0104e-04_r8/) + kao(:, 2,11, 2) = (/ & + &3.0561e-04_r8,4.5397e-04_r8,5.0521e-04_r8,5.3017e-04_r8,5.3366e-04_r8,5.2816e-04_r8, & + &4.9620e-04_r8,4.3115e-04_r8,4.1409e-04_r8/) + kao(:, 3,11, 2) = (/ & + &4.0935e-04_r8,6.2197e-04_r8,6.9995e-04_r8,7.3845e-04_r8,7.4646e-04_r8,7.4054e-04_r8, & + &7.0035e-04_r8,5.8985e-04_r8,5.4448e-04_r8/) + kao(:, 4,11, 2) = (/ & + &5.8584e-04_r8,8.9030e-04_r8,1.0016e-03_r8,1.0495e-03_r8,1.0645e-03_r8,1.0487e-03_r8, & + &9.8184e-04_r8,8.1405e-04_r8,6.7706e-04_r8/) + kao(:, 5,11, 2) = (/ & + &8.7589e-04_r8,1.3050e-03_r8,1.4464e-03_r8,1.5053e-03_r8,1.5175e-03_r8,1.4779e-03_r8, & + &1.3691e-03_r8,1.1154e-03_r8,8.3668e-04_r8/) + kao(:, 1,12, 2) = (/ & + &2.6981e-04_r8,3.6165e-04_r8,3.8393e-04_r8,3.8621e-04_r8,3.7773e-04_r8,3.5863e-04_r8, & + &3.2723e-04_r8,2.8136e-04_r8,2.7937e-04_r8/) + kao(:, 2,12, 2) = (/ & + &3.3189e-04_r8,4.6172e-04_r8,5.0224e-04_r8,5.1546e-04_r8,5.1134e-04_r8,4.9419e-04_r8, & + &4.6078e-04_r8,3.9503e-04_r8,3.8165e-04_r8/) + kao(:, 3,12, 2) = (/ & + &4.4945e-04_r8,6.3614e-04_r8,7.0015e-04_r8,7.2309e-04_r8,7.1840e-04_r8,6.9882e-04_r8, & + &6.5062e-04_r8,5.4697e-04_r8,5.0283e-04_r8/) + kao(:, 4,12, 2) = (/ & + &6.4949e-04_r8,9.2459e-04_r8,1.0096e-03_r8,1.0404e-03_r8,1.0301e-03_r8,9.9704e-04_r8, & + &9.2064e-04_r8,7.5726e-04_r8,6.3715e-04_r8/) + kao(:, 5,12, 2) = (/ & + &9.7948e-04_r8,1.3695e-03_r8,1.4755e-03_r8,1.5098e-03_r8,1.4823e-03_r8,1.4173e-03_r8, & + &1.2918e-03_r8,1.0472e-03_r8,7.8120e-04_r8/) + kao(:, 1,13, 2) = (/ & + &2.3347e-04_r8,3.0984e-04_r8,3.2740e-04_r8,3.2836e-04_r8,3.1964e-04_r8,3.0307e-04_r8, & + &2.7562e-04_r8,2.3564e-04_r8,2.3674e-04_r8/) + kao(:, 2,13, 2) = (/ & + &2.9027e-04_r8,3.9857e-04_r8,4.3170e-04_r8,4.4144e-04_r8,4.3482e-04_r8,4.1943e-04_r8, & + &3.8943e-04_r8,3.3194e-04_r8,3.2365e-04_r8/) + kao(:, 3,13, 2) = (/ & + &3.9524e-04_r8,5.5472e-04_r8,6.0676e-04_r8,6.2319e-04_r8,6.1597e-04_r8,5.9710e-04_r8, & + &5.5278e-04_r8,4.6213e-04_r8,4.2552e-04_r8/) + kao(:, 4,13, 2) = (/ & + &5.7486e-04_r8,8.1393e-04_r8,8.8216e-04_r8,9.0454e-04_r8,8.9206e-04_r8,8.5566e-04_r8, & + &7.8499e-04_r8,6.4422e-04_r8,5.3476e-04_r8/) + kao(:, 5,13, 2) = (/ & + &8.7246e-04_r8,1.2122e-03_r8,1.2989e-03_r8,1.3221e-03_r8,1.2955e-03_r8,1.2260e-03_r8, & + &1.1071e-03_r8,8.9174e-04_r8,6.5849e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &5.2546e-06_r8,7.1189e-04_r8,1.0882e-03_r8,1.5407e-03_r8,1.6694e-03_r8,2.0484e-03_r8, & + &2.8523e-03_r8,4.1696e-03_r8,2.5067e-03_r8/) + kao(:, 2, 1, 3) = (/ & + &7.7092e-06_r8,8.7649e-04_r8,1.3426e-03_r8,1.8360e-03_r8,2.2345e-03_r8,2.3018e-03_r8, & + &2.9500e-03_r8,4.8247e-03_r8,2.8678e-03_r8/) + kao(:, 3, 1, 3) = (/ & + &1.1096e-05_r8,1.0569e-03_r8,1.6133e-03_r8,2.2145e-03_r8,2.7396e-03_r8,3.0159e-03_r8, & + &3.2179e-03_r8,5.1113e-03_r8,3.6024e-03_r8/) + kao(:, 4, 1, 3) = (/ & + &1.5736e-05_r8,1.2601e-03_r8,1.9380e-03_r8,2.6510e-03_r8,3.2424e-03_r8,3.7893e-03_r8, & + &3.9992e-03_r8,5.0794e-03_r8,4.4455e-03_r8/) + kao(:, 5, 1, 3) = (/ & + &2.1768e-05_r8,1.4881e-03_r8,2.3013e-03_r8,3.1272e-03_r8,3.8505e-03_r8,4.4934e-03_r8, & + &5.1336e-03_r8,5.8796e-03_r8,5.3642e-03_r8/) + kao(:, 1, 2, 3) = (/ & + &6.4189e-06_r8,6.4436e-04_r8,9.4389e-04_r8,1.2239e-03_r8,1.5862e-03_r8,1.5943e-03_r8, & + &2.1761e-03_r8,2.9768e-03_r8,1.8319e-03_r8/) + kao(:, 2, 2, 3) = (/ & + &9.5139e-06_r8,7.9863e-04_r8,1.1748e-03_r8,1.5104e-03_r8,1.9094e-03_r8,2.0876e-03_r8, & + &2.2172e-03_r8,3.3690e-03_r8,2.2079e-03_r8/) + kao(:, 3, 2, 3) = (/ & + &1.3920e-05_r8,9.7738e-04_r8,1.4337e-03_r8,1.8422e-03_r8,2.2904e-03_r8,2.6664e-03_r8, & + &2.6655e-03_r8,3.3322e-03_r8,2.7973e-03_r8/) + kao(:, 4, 2, 3) = (/ & + &1.9815e-05_r8,1.1745e-03_r8,1.7255e-03_r8,2.2150e-03_r8,2.7638e-03_r8,3.1950e-03_r8, & + &3.5144e-03_r8,3.6601e-03_r8,3.4291e-03_r8/) + kao(:, 5, 2, 3) = (/ & + &2.7567e-05_r8,1.3937e-03_r8,2.0553e-03_r8,2.6513e-03_r8,3.2736e-03_r8,3.7952e-03_r8, & + &4.2837e-03_r8,4.4922e-03_r8,4.1160e-03_r8/) + kao(:, 1, 3, 3) = (/ & + &9.6319e-06_r8,5.9789e-04_r8,9.0789e-04_r8,1.1077e-03_r8,1.2525e-03_r8,1.5120e-03_r8, & + &1.4959e-03_r8,2.1276e-03_r8,1.3456e-03_r8/) + kao(:, 2, 3, 3) = (/ & + &1.4531e-05_r8,7.5640e-04_r8,1.1412e-03_r8,1.3989e-03_r8,1.5703e-03_r8,1.7944e-03_r8, & + &1.9386e-03_r8,2.1696e-03_r8,1.7109e-03_r8/) + kao(:, 3, 3, 3) = (/ & + &2.1457e-05_r8,9.3610e-04_r8,1.4115e-03_r8,1.7272e-03_r8,1.9369e-03_r8,2.2003e-03_r8, & + &2.5012e-03_r8,2.3167e-03_r8,2.1265e-03_r8/) + kao(:, 4, 3, 3) = (/ & + &3.1112e-05_r8,1.1388e-03_r8,1.7200e-03_r8,2.0901e-03_r8,2.3590e-03_r8,2.6864e-03_r8, & + &2.9768e-03_r8,2.9114e-03_r8,2.5844e-03_r8/) + kao(:, 5, 3, 3) = (/ & + &4.3735e-05_r8,1.3632e-03_r8,2.0663e-03_r8,2.5031e-03_r8,2.8359e-03_r8,3.2124e-03_r8, & + &3.5643e-03_r8,3.8138e-03_r8,3.0766e-03_r8/) + kao(:, 1, 4, 3) = (/ & + &1.4332e-05_r8,5.0481e-04_r8,8.3885e-04_r8,1.0386e-03_r8,1.1528e-03_r8,1.2153e-03_r8, & + &1.3236e-03_r8,1.3236e-03_r8,9.9177e-04_r8/) + kao(:, 2, 4, 3) = (/ & + &2.1745e-05_r8,6.5797e-04_r8,1.0771e-03_r8,1.3282e-03_r8,1.4860e-03_r8,1.5492e-03_r8, & + &1.6188e-03_r8,1.5468e-03_r8,1.2757e-03_r8/) + kao(:, 3, 4, 3) = (/ & + &3.2667e-05_r8,8.3614e-04_r8,1.3479e-03_r8,1.6673e-03_r8,1.8582e-03_r8,1.9416e-03_r8, & + &2.0036e-03_r8,2.1024e-03_r8,1.5754e-03_r8/) + kao(:, 4, 4, 3) = (/ & + &4.8093e-05_r8,1.0472e-03_r8,1.6541e-03_r8,2.0462e-03_r8,2.2910e-03_r8,2.3927e-03_r8, & + &2.4569e-03_r8,2.6010e-03_r8,1.9210e-03_r8/) + kao(:, 5, 4, 3) = (/ & + &6.8610e-05_r8,1.2933e-03_r8,1.9995e-03_r8,2.4752e-03_r8,2.7858e-03_r8,2.9107e-03_r8, & + &2.9847e-03_r8,3.0912e-03_r8,2.3242e-03_r8/) + kao(:, 1, 5, 3) = (/ & + &1.9357e-05_r8,4.3188e-04_r8,6.9760e-04_r8,9.1881e-04_r8,1.0444e-03_r8,1.0861e-03_r8, & + &1.0808e-03_r8,1.0528e-03_r8,7.6202e-04_r8/) + kao(:, 2, 5, 3) = (/ & + &2.9833e-05_r8,5.6548e-04_r8,9.1440e-04_r8,1.2005e-03_r8,1.3604e-03_r8,1.4256e-03_r8, & + &1.3945e-03_r8,1.3872e-03_r8,9.4421e-04_r8/) + kao(:, 3, 5, 3) = (/ & + &4.5578e-05_r8,7.2730e-04_r8,1.1762e-03_r8,1.5269e-03_r8,1.7329e-03_r8,1.8168e-03_r8, & + &1.7751e-03_r8,1.6935e-03_r8,1.1652e-03_r8/) + kao(:, 4, 5, 3) = (/ & + &6.7915e-05_r8,9.2227e-04_r8,1.4839e-03_r8,1.8964e-03_r8,2.1540e-03_r8,2.2580e-03_r8, & + &2.2284e-03_r8,2.0768e-03_r8,1.4187e-03_r8/) + kao(:, 5, 5, 3) = (/ & + &9.8232e-05_r8,1.1614e-03_r8,1.8417e-03_r8,2.3162e-03_r8,2.6333e-03_r8,2.7678e-03_r8, & + &2.7278e-03_r8,2.5343e-03_r8,1.7135e-03_r8/) + kao(:, 1, 6, 3) = (/ & + &2.4087e-05_r8,3.6023e-04_r8,5.7620e-04_r8,7.4775e-04_r8,8.9007e-04_r8,9.5429e-04_r8, & + &9.1764e-04_r8,8.4636e-04_r8,5.7959e-04_r8/) + kao(:, 2, 6, 3) = (/ & + &3.7139e-05_r8,4.8232e-04_r8,7.6564e-04_r8,9.9341e-04_r8,1.1781e-03_r8,1.2665e-03_r8, & + &1.2330e-03_r8,1.0918e-03_r8,7.2688e-04_r8/) + kao(:, 3, 6, 3) = (/ & + &5.7836e-05_r8,6.3457e-04_r8,9.9482e-04_r8,1.2902e-03_r8,1.5235e-03_r8,1.6284e-03_r8, & + &1.5983e-03_r8,1.4005e-03_r8,8.9110e-04_r8/) + kao(:, 4, 6, 3) = (/ & + &8.7827e-05_r8,8.3029e-04_r8,1.2776e-03_r8,1.6365e-03_r8,1.9214e-03_r8,2.0538e-03_r8, & + &2.0181e-03_r8,1.7675e-03_r8,1.0912e-03_r8/) + kao(:, 5, 6, 3) = (/ & + &1.2951e-04_r8,1.0725e-03_r8,1.6206e-03_r8,2.0554e-03_r8,2.3768e-03_r8,2.5369e-03_r8, & + &2.5004e-03_r8,2.2047e-03_r8,1.3222e-03_r8/) + kao(:, 1, 7, 3) = (/ & + &3.1610e-05_r8,3.0736e-04_r8,4.8099e-04_r8,6.1875e-04_r8,7.2425e-04_r8,8.0714e-04_r8, & + &8.2765e-04_r8,7.1397e-04_r8,4.2627e-04_r8/) + kao(:, 2, 7, 3) = (/ & + &4.8734e-05_r8,4.2352e-04_r8,6.5473e-04_r8,8.3909e-04_r8,9.8036e-04_r8,1.0919e-03_r8, & + &1.1195e-03_r8,9.5621e-04_r8,5.5009e-04_r8/) + kao(:, 3, 7, 3) = (/ & + &7.5777e-05_r8,5.7189e-04_r8,8.6982e-04_r8,1.1085e-03_r8,1.2941e-03_r8,1.4332e-03_r8, & + &1.4595e-03_r8,1.2666e-03_r8,6.8930e-04_r8/) + kao(:, 4, 7, 3) = (/ & + &1.1758e-04_r8,7.6635e-04_r8,1.1428e-03_r8,1.4431e-03_r8,1.6723e-03_r8,1.8359e-03_r8, & + &1.8555e-03_r8,1.6214e-03_r8,8.4503e-04_r8/) + kao(:, 5, 7, 3) = (/ & + &1.7719e-04_r8,1.0176e-03_r8,1.4892e-03_r8,1.8529e-03_r8,2.1284e-03_r8,2.3074e-03_r8, & + &2.3192e-03_r8,2.0277e-03_r8,1.0269e-03_r8/) + kao(:, 1, 8, 3) = (/ & + &5.0016e-05_r8,3.0350e-04_r8,4.3130e-04_r8,5.4117e-04_r8,6.2740e-04_r8,6.8603e-04_r8, & + &7.1531e-04_r8,6.7206e-04_r8,3.4534e-04_r8/) + kao(:, 2, 8, 3) = (/ & + &7.6305e-05_r8,4.2110e-04_r8,6.0202e-04_r8,7.5262e-04_r8,8.6967e-04_r8,9.4998e-04_r8, & + &9.8539e-04_r8,9.2682e-04_r8,4.4615e-04_r8/) + kao(:, 3, 8, 3) = (/ & + &1.1911e-04_r8,5.8304e-04_r8,8.2209e-04_r8,1.0213e-03_r8,1.1738e-03_r8,1.2774e-03_r8, & + &1.3191e-03_r8,1.2307e-03_r8,5.5948e-04_r8/) + kao(:, 4, 8, 3) = (/ & + &1.8649e-04_r8,7.9923e-04_r8,1.1102e-03_r8,1.3602e-03_r8,1.5530e-03_r8,1.6805e-03_r8, & + &1.7288e-03_r8,1.5932e-03_r8,6.8951e-04_r8/) + kao(:, 5, 8, 3) = (/ & + &2.8664e-04_r8,1.0891e-03_r8,1.4894e-03_r8,1.7956e-03_r8,2.0238e-03_r8,2.1795e-03_r8, & + &2.2144e-03_r8,2.0105e-03_r8,8.3262e-04_r8/) + kao(:, 1, 9, 3) = (/ & + &1.5293e-04_r8,4.6711e-04_r8,5.9429e-04_r8,6.7143e-04_r8,7.0270e-04_r8,7.2578e-04_r8, & + &7.2031e-04_r8,6.7023e-04_r8,4.6857e-04_r8/) + kao(:, 2, 9, 3) = (/ & + &2.2743e-04_r8,6.5435e-04_r8,8.3260e-04_r8,9.2221e-04_r8,9.8476e-04_r8,1.0204e-03_r8, & + &1.0235e-03_r8,9.4955e-04_r8,5.6708e-04_r8/) + kao(:, 3, 9, 3) = (/ & + &3.5601e-04_r8,9.4855e-04_r8,1.1602e-03_r8,1.2875e-03_r8,1.3640e-03_r8,1.4067e-03_r8, & + &1.4070e-03_r8,1.3032e-03_r8,6.4714e-04_r8/) + kao(:, 4, 9, 3) = (/ & + &5.5911e-04_r8,1.3606e-03_r8,1.6272e-03_r8,1.7782e-03_r8,1.8671e-03_r8,1.9159e-03_r8, & + &1.8899e-03_r8,1.7374e-03_r8,7.3858e-04_r8/) + kao(:, 5, 9, 3) = (/ & + &8.7081e-04_r8,1.9356e-03_r8,2.2669e-03_r8,2.4429e-03_r8,2.5498e-03_r8,2.5834e-03_r8, & + &2.5150e-03_r8,2.2763e-03_r8,8.7139e-04_r8/) + kao(:, 1,10, 3) = (/ & + &5.5025e-04_r8,9.1638e-04_r8,1.0524e-03_r8,1.1151e-03_r8,1.1173e-03_r8,1.0672e-03_r8, & + &9.7649e-04_r8,7.7345e-04_r8,6.5002e-04_r8/) + kao(:, 2,10, 3) = (/ & + &7.9126e-04_r8,1.3002e-03_r8,1.4860e-03_r8,1.5598e-03_r8,1.5441e-03_r8,1.5015e-03_r8, & + &1.3399e-03_r8,1.0909e-03_r8,8.3499e-04_r8/) + kao(:, 3,10, 3) = (/ & + &1.2237e-03_r8,1.9321e-03_r8,2.1587e-03_r8,2.2526e-03_r8,2.2235e-03_r8,2.1040e-03_r8, & + &1.8744e-03_r8,1.5238e-03_r8,1.0298e-03_r8/) + kao(:, 4,10, 3) = (/ & + &1.9295e-03_r8,2.9068e-03_r8,3.1939e-03_r8,3.2884e-03_r8,3.1828e-03_r8,2.9739e-03_r8, & + &2.6100e-03_r8,2.0967e-03_r8,1.2389e-03_r8/) + kao(:, 5,10, 3) = (/ & + &3.0420e-03_r8,4.3560e-03_r8,4.6911e-03_r8,4.7252e-03_r8,4.5246e-03_r8,4.1666e-03_r8, & + &3.6292e-03_r8,2.8608e-03_r8,1.4677e-03_r8/) + kao(:, 1,11, 3) = (/ & + &8.0124e-04_r8,1.1600e-03_r8,1.2577e-03_r8,1.2913e-03_r8,1.2758e-03_r8,1.1948e-03_r8, & + &1.0607e-03_r8,8.2464e-04_r8,6.8579e-04_r8/) + kao(:, 2,11, 3) = (/ & + &1.1673e-03_r8,1.6642e-03_r8,1.8003e-03_r8,1.8395e-03_r8,1.7987e-03_r8,1.6759e-03_r8, & + &1.4977e-03_r8,1.1597e-03_r8,8.7714e-04_r8/) + kao(:, 3,11, 3) = (/ & + &1.8208e-03_r8,2.5072e-03_r8,2.6736e-03_r8,2.6935e-03_r8,2.6255e-03_r8,2.4196e-03_r8, & + &2.1072e-03_r8,1.6350e-03_r8,1.1070e-03_r8/) + kao(:, 4,11, 3) = (/ & + &2.8872e-03_r8,3.8298e-03_r8,4.0028e-03_r8,4.0090e-03_r8,3.8400e-03_r8,3.4828e-03_r8, & + &2.9827e-03_r8,2.2825e-03_r8,1.3306e-03_r8/) + kao(:, 5,11, 3) = (/ & + &4.5758e-03_r8,5.8214e-03_r8,5.9954e-03_r8,5.8806e-03_r8,5.5457e-03_r8,4.9671e-03_r8, & + &4.1979e-03_r8,3.1537e-03_r8,1.5896e-03_r8/) + kao(:, 1,12, 3) = (/ & + &8.6957e-04_r8,1.1918e-03_r8,1.2597e-03_r8,1.2688e-03_r8,1.2375e-03_r8,1.1513e-03_r8, & + &1.0110e-03_r8,7.8620e-04_r8,6.6607e-04_r8/) + kao(:, 2,12, 3) = (/ & + &1.2841e-03_r8,1.7262e-03_r8,1.8227e-03_r8,1.8310e-03_r8,1.7702e-03_r8,1.6364e-03_r8, & + &1.4379e-03_r8,1.0990e-03_r8,8.6314e-04_r8/) + kao(:, 3,12, 3) = (/ & + &2.0183e-03_r8,2.6229e-03_r8,2.7286e-03_r8,2.7135e-03_r8,2.6112e-03_r8,2.3987e-03_r8, & + &2.0472e-03_r8,1.5496e-03_r8,1.0681e-03_r8/) + kao(:, 4,12, 3) = (/ & + &3.2212e-03_r8,4.0504e-03_r8,4.1472e-03_r8,4.0702e-03_r8,3.8583e-03_r8,3.4748e-03_r8, & + &2.9262e-03_r8,2.1914e-03_r8,1.2601e-03_r8/) + kao(:, 5,12, 3) = (/ & + &5.1511e-03_r8,6.2196e-03_r8,6.2591e-03_r8,6.0402e-03_r8,5.6302e-03_r8,4.9946e-03_r8, & + &4.1641e-03_r8,3.0581e-03_r8,1.4932e-03_r8/) + kao(:, 1,13, 3) = (/ & + &7.5570e-04_r8,1.0245e-03_r8,1.0772e-03_r8,1.0860e-03_r8,1.0524e-03_r8,9.7557e-04_r8, & + &8.5610e-04_r8,6.6220e-04_r8,5.7960e-04_r8/) + kao(:, 2,13, 3) = (/ & + &1.1289e-03_r8,1.4995e-03_r8,1.5736e-03_r8,1.5761e-03_r8,1.5191e-03_r8,1.4055e-03_r8, & + &1.2213e-03_r8,9.3390e-04_r8,7.5295e-04_r8/) + kao(:, 3,13, 3) = (/ & + &1.7891e-03_r8,2.2942e-03_r8,2.3709e-03_r8,2.3513e-03_r8,2.2646e-03_r8,2.0616e-03_r8, & + &1.7545e-03_r8,1.3283e-03_r8,9.2119e-04_r8/) + kao(:, 4,13, 3) = (/ & + &2.8872e-03_r8,3.5675e-03_r8,3.6372e-03_r8,3.5628e-03_r8,3.3407e-03_r8,3.0031e-03_r8, & + &2.5207e-03_r8,1.8863e-03_r8,1.0888e-03_r8/) + kao(:, 5,13, 3) = (/ & + &4.6509e-03_r8,5.5327e-03_r8,5.4994e-03_r8,5.2862e-03_r8,4.8993e-03_r8,4.3534e-03_r8, & + &3.6092e-03_r8,2.6447e-03_r8,1.2715e-03_r8/) + kao(:, 1, 1, 4) = (/ & + &2.0197e-05_r8,1.1667e-03_r8,1.8703e-03_r8,2.3597e-03_r8,2.8442e-03_r8,3.3004e-03_r8, & + &3.9209e-03_r8,5.1050e-03_r8,4.4032e-03_r8/) + kao(:, 2, 1, 4) = (/ & + &2.9878e-05_r8,1.4283e-03_r8,2.2934e-03_r8,2.9621e-03_r8,3.4763e-03_r8,4.1665e-03_r8, & + &4.8948e-03_r8,5.8620e-03_r8,5.4661e-03_r8/) + kao(:, 3, 1, 4) = (/ & + &4.2867e-05_r8,1.7152e-03_r8,2.7742e-03_r8,3.5744e-03_r8,4.2361e-03_r8,5.0272e-03_r8, & + &5.9642e-03_r8,7.9378e-03_r8,6.6044e-03_r8/) + kao(:, 4, 1, 4) = (/ & + &5.9869e-05_r8,2.0335e-03_r8,3.2827e-03_r8,4.2442e-03_r8,5.1046e-03_r8,5.9179e-03_r8, & + &7.1401e-03_r8,9.6601e-03_r8,7.8490e-03_r8/) + kao(:, 5, 1, 4) = (/ & + &8.1517e-05_r8,2.3834e-03_r8,3.8440e-03_r8,4.9959e-03_r8,6.0214e-03_r8,7.0692e-03_r8, & + &8.4265e-03_r8,1.1443e-02_r8,9.2888e-03_r8/) + kao(:, 1, 2, 4) = (/ & + &2.5366e-05_r8,1.0671e-03_r8,1.6131e-03_r8,2.1123e-03_r8,2.3685e-03_r8,2.7185e-03_r8, & + &3.0418e-03_r8,3.4879e-03_r8,3.3143e-03_r8/) + kao(:, 2, 2, 4) = (/ & + &3.7671e-05_r8,1.3088e-03_r8,2.0014e-03_r8,2.6106e-03_r8,3.0312e-03_r8,3.3873e-03_r8, & + &3.9017e-03_r8,4.5215e-03_r8,4.1143e-03_r8/) + kao(:, 3, 2, 4) = (/ & + &5.4541e-05_r8,1.5795e-03_r8,2.4306e-03_r8,3.1726e-03_r8,3.7137e-03_r8,4.1208e-03_r8, & + &4.7737e-03_r8,5.7376e-03_r8,4.9901e-03_r8/) + kao(:, 4, 2, 4) = (/ & + &7.7056e-05_r8,1.8857e-03_r8,2.9009e-03_r8,3.7836e-03_r8,4.4364e-03_r8,5.0235e-03_r8, & + &5.6427e-03_r8,6.9365e-03_r8,5.9848e-03_r8/) + kao(:, 5, 2, 4) = (/ & + &1.0566e-04_r8,2.2344e-03_r8,3.4137e-03_r8,4.4552e-03_r8,5.2671e-03_r8,5.9853e-03_r8, & + &6.7249e-03_r8,8.2397e-03_r8,7.1296e-03_r8/) + kao(:, 1, 3, 4) = (/ & + &3.9558e-05_r8,1.0742e-03_r8,1.5248e-03_r8,1.8501e-03_r8,2.1830e-03_r8,2.3261e-03_r8, & + &2.4391e-03_r8,2.5890e-03_r8,2.3829e-03_r8/) + kao(:, 2, 3, 4) = (/ & + &5.9594e-05_r8,1.3476e-03_r8,1.8940e-03_r8,2.3182e-03_r8,2.7486e-03_r8,3.0410e-03_r8, & + &3.0839e-03_r8,3.3287e-03_r8,2.9662e-03_r8/) + kao(:, 3, 3, 4) = (/ & + &8.7495e-05_r8,1.6651e-03_r8,2.3108e-03_r8,2.8515e-03_r8,3.3798e-03_r8,3.7359e-03_r8, & + &3.8327e-03_r8,4.1905e-03_r8,3.5949e-03_r8/) + kao(:, 4, 3, 4) = (/ & + &1.2450e-04_r8,2.0293e-03_r8,2.7849e-03_r8,3.4502e-03_r8,4.0760e-03_r8,4.5002e-03_r8, & + &4.7432e-03_r8,5.0708e-03_r8,4.3551e-03_r8/) + kao(:, 5, 3, 4) = (/ & + &1.7405e-04_r8,2.4316e-03_r8,3.3182e-03_r8,4.1142e-03_r8,4.8387e-03_r8,5.3673e-03_r8, & + &5.6716e-03_r8,6.0036e-03_r8,5.2554e-03_r8/) + kao(:, 1, 4, 4) = (/ & + &6.0993e-05_r8,1.0865e-03_r8,1.5064e-03_r8,1.7956e-03_r8,1.9492e-03_r8,2.0758e-03_r8, & + &2.1376e-03_r8,1.9974e-03_r8,1.7194e-03_r8/) + kao(:, 2, 4, 4) = (/ & + &9.3739e-05_r8,1.3938e-03_r8,1.9090e-03_r8,2.2655e-03_r8,2.4714e-03_r8,2.6468e-03_r8, & + &2.7998e-03_r8,2.5993e-03_r8,2.1766e-03_r8/) + kao(:, 3, 4, 4) = (/ & + &1.3999e-04_r8,1.7512e-03_r8,2.3888e-03_r8,2.8018e-03_r8,3.0687e-03_r8,3.3097e-03_r8, & + &3.4825e-03_r8,3.2297e-03_r8,2.6912e-03_r8/) + kao(:, 4, 4, 4) = (/ & + &2.0284e-04_r8,2.1576e-03_r8,2.9507e-03_r8,3.4179e-03_r8,3.7408e-03_r8,4.0628e-03_r8, & + &4.2589e-03_r8,4.0554e-03_r8,3.2822e-03_r8/) + kao(:, 5, 4, 4) = (/ & + &2.8653e-04_r8,2.6101e-03_r8,3.5917e-03_r8,4.1189e-03_r8,4.5031e-03_r8,4.8876e-03_r8, & + &5.1085e-03_r8,4.9728e-03_r8,3.9394e-03_r8/) + kao(:, 1, 5, 4) = (/ & + &8.6213e-05_r8,1.0235e-03_r8,1.4463e-03_r8,1.6932e-03_r8,1.8586e-03_r8,1.8899e-03_r8, & + &1.8325e-03_r8,1.6931e-03_r8,1.2167e-03_r8/) + kao(:, 2, 5, 4) = (/ & + &1.3497e-04_r8,1.3639e-03_r8,1.8867e-03_r8,2.1813e-03_r8,2.3731e-03_r8,2.4352e-03_r8, & + &2.3757e-03_r8,2.2169e-03_r8,1.5707e-03_r8/) + kao(:, 3, 5, 4) = (/ & + &2.0469e-04_r8,1.7684e-03_r8,2.3970e-03_r8,2.7679e-03_r8,2.9816e-03_r8,3.0549e-03_r8, & + &3.0098e-03_r8,2.8798e-03_r8,1.9802e-03_r8/) + kao(:, 4, 5, 4) = (/ & + &3.0118e-04_r8,2.2412e-03_r8,2.9952e-03_r8,3.4514e-03_r8,3.7055e-03_r8,3.7675e-03_r8, & + &3.7358e-03_r8,3.5681e-03_r8,2.4524e-03_r8/) + kao(:, 5, 5, 4) = (/ & + &4.3178e-04_r8,2.7692e-03_r8,3.6699e-03_r8,4.2507e-03_r8,4.5341e-03_r8,4.5904e-03_r8, & + &4.5606e-03_r8,4.3497e-03_r8,2.9904e-03_r8/) + kao(:, 1, 6, 4) = (/ & + &1.1224e-04_r8,9.6248e-04_r8,1.3486e-03_r8,1.5651e-03_r8,1.6739e-03_r8,1.7217e-03_r8, & + &1.6200e-03_r8,1.3812e-03_r8,9.3024e-04_r8/) + kao(:, 2, 6, 4) = (/ & + &1.7788e-04_r8,1.2979e-03_r8,1.7963e-03_r8,2.0621e-03_r8,2.2013e-03_r8,2.2377e-03_r8, & + &2.1278e-03_r8,1.8809e-03_r8,1.2042e-03_r8/) + kao(:, 3, 6, 4) = (/ & + &2.7340e-04_r8,1.7148e-03_r8,2.3323e-03_r8,2.6619e-03_r8,2.8238e-03_r8,2.8631e-03_r8, & + &2.7284e-03_r8,2.4183e-03_r8,1.5217e-03_r8/) + kao(:, 4, 6, 4) = (/ & + &4.0959e-04_r8,2.2331e-03_r8,2.9678e-03_r8,3.3799e-03_r8,3.5736e-03_r8,3.5928e-03_r8, & + &3.4271e-03_r8,3.0552e-03_r8,1.8843e-03_r8/) + kao(:, 5, 6, 4) = (/ & + &5.9620e-04_r8,2.8328e-03_r8,3.7008e-03_r8,4.1972e-03_r8,4.4330e-03_r8,4.4525e-03_r8, & + &4.2185e-03_r8,3.7711e-03_r8,2.2988e-03_r8/) + kao(:, 1, 7, 4) = (/ & + &1.5344e-04_r8,9.2316e-04_r8,1.2773e-03_r8,1.5000e-03_r8,1.6102e-03_r8,1.6127e-03_r8, & + &1.5115e-03_r8,1.2377e-03_r8,7.0764e-04_r8/) + kao(:, 2, 7, 4) = (/ & + &2.4398e-04_r8,1.2809e-03_r8,1.7477e-03_r8,2.0347e-03_r8,2.1522e-03_r8,2.1311e-03_r8, & + &1.9950e-03_r8,1.6669e-03_r8,9.1774e-04_r8/) + kao(:, 3, 7, 4) = (/ & + &3.8058e-04_r8,1.7477e-03_r8,2.3440e-03_r8,2.6829e-03_r8,2.8039e-03_r8,2.7555e-03_r8, & + &2.5876e-03_r8,2.1763e-03_r8,1.1586e-03_r8/) + kao(:, 4, 7, 4) = (/ & + &5.7739e-04_r8,2.3349e-03_r8,3.0698e-03_r8,3.4470e-03_r8,3.5790e-03_r8,3.5331e-03_r8, & + &3.3054e-03_r8,2.7805e-03_r8,1.4458e-03_r8/) + kao(:, 5, 7, 4) = (/ & + &8.5208e-04_r8,3.0383e-03_r8,3.9002e-03_r8,4.3347e-03_r8,4.5004e-03_r8,4.4415e-03_r8, & + &4.1236e-03_r8,3.4788e-03_r8,1.7825e-03_r8/) + kao(:, 1, 8, 4) = (/ & + &2.5035e-04_r8,9.8089e-04_r8,1.3026e-03_r8,1.5173e-03_r8,1.6357e-03_r8,1.6535e-03_r8, & + &1.5386e-03_r8,1.2613e-03_r8,5.4812e-04_r8/) + kao(:, 2, 8, 4) = (/ & + &3.9983e-04_r8,1.4074e-03_r8,1.8431e-03_r8,2.1183e-03_r8,2.2695e-03_r8,2.2610e-03_r8, & + &2.0892e-03_r8,1.6966e-03_r8,7.0487e-04_r8/) + kao(:, 3, 8, 4) = (/ & + &6.2524e-04_r8,1.9883e-03_r8,2.5535e-03_r8,2.8971e-03_r8,3.0599e-03_r8,3.0259e-03_r8, & + &2.7534e-03_r8,2.2128e-03_r8,8.9347e-04_r8/) + kao(:, 4, 8, 4) = (/ & + &9.6475e-04_r8,2.7489e-03_r8,3.4725e-03_r8,3.8856e-03_r8,4.0355e-03_r8,3.9357e-03_r8, & + &3.5484e-03_r8,2.8450e-03_r8,1.1141e-03_r8/) + kao(:, 5, 8, 4) = (/ & + &1.4492e-03_r8,3.7234e-03_r8,4.6023e-03_r8,5.0761e-03_r8,5.1898e-03_r8,5.0041e-03_r8, & + &4.4962e-03_r8,3.6082e-03_r8,1.3876e-03_r8/) + kao(:, 1, 9, 4) = (/ & + &7.7717e-04_r8,1.6076e-03_r8,1.9327e-03_r8,2.0950e-03_r8,2.1727e-03_r8,2.1507e-03_r8, & + &2.0239e-03_r8,1.6619e-03_r8,6.5283e-04_r8/) + kao(:, 2, 9, 4) = (/ & + &1.2257e-03_r8,2.4216e-03_r8,2.8205e-03_r8,3.0706e-03_r8,3.1558e-03_r8,3.0893e-03_r8, & + &2.8639e-03_r8,2.3215e-03_r8,8.1326e-04_r8/) + kao(:, 3, 9, 4) = (/ & + &1.9258e-03_r8,3.5788e-03_r8,4.1331e-03_r8,4.4121e-03_r8,4.4825e-03_r8,4.3456e-03_r8, & + &3.9751e-03_r8,3.1546e-03_r8,1.0072e-03_r8/) + kao(:, 4, 9, 4) = (/ & + &3.0058e-03_r8,5.1816e-03_r8,5.8926e-03_r8,6.2133e-03_r8,6.2513e-03_r8,5.9943e-03_r8, & + &5.4160e-03_r8,4.1735e-03_r8,1.2133e-03_r8/) + kao(:, 5, 9, 4) = (/ & + &4.5860e-03_r8,7.3561e-03_r8,8.1694e-03_r8,8.5315e-03_r8,8.5009e-03_r8,8.0696e-03_r8, & + &7.1597e-03_r8,5.3914e-03_r8,1.4524e-03_r8/) + kao(:, 1,10, 4) = (/ & + &2.7632e-03_r8,3.7578e-03_r8,3.8929e-03_r8,3.8648e-03_r8,3.7150e-03_r8,3.4386e-03_r8, & + &2.9824e-03_r8,2.3042e-03_r8,1.1595e-03_r8/) + kao(:, 2,10, 4) = (/ & + &4.3618e-03_r8,5.8439e-03_r8,6.0237e-03_r8,5.9173e-03_r8,5.6198e-03_r8,5.0739e-03_r8, & + &4.3966e-03_r8,3.3846e-03_r8,1.3310e-03_r8/) + kao(:, 3,10, 4) = (/ & + &6.8076e-03_r8,8.8616e-03_r8,9.0867e-03_r8,8.8297e-03_r8,8.2980e-03_r8,7.5120e-03_r8, & + &6.4366e-03_r8,4.8357e-03_r8,1.4427e-03_r8/) + kao(:, 4,10, 4) = (/ & + &1.0727e-02_r8,1.3247e-02_r8,1.3386e-02_r8,1.2895e-02_r8,1.2079e-02_r8,1.0841e-02_r8, & + &9.1826e-03_r8,6.8074e-03_r8,1.5623e-03_r8/) + kao(:, 5,10, 4) = (/ & + &1.6578e-02_r8,1.9641e-02_r8,1.9517e-02_r8,1.8627e-02_r8,1.7184e-02_r8,1.5227e-02_r8, & + &1.2710e-02_r8,9.3140e-03_r8,1.8266e-03_r8/) + kao(:, 1,11, 4) = (/ & + &4.3397e-03_r8,5.2633e-03_r8,5.2314e-03_r8,5.0017e-03_r8,4.6314e-03_r8,4.1308e-03_r8, & + &3.4621e-03_r8,2.5597e-03_r8,1.2582e-03_r8/) + kao(:, 2,11, 4) = (/ & + &6.6934e-03_r8,8.1477e-03_r8,8.0949e-03_r8,7.7188e-03_r8,7.1188e-03_r8,6.2977e-03_r8, & + &5.1713e-03_r8,3.7779e-03_r8,1.4574e-03_r8/) + kao(:, 3,11, 4) = (/ & + &1.0432e-02_r8,1.2428e-02_r8,1.2196e-02_r8,1.1560e-02_r8,1.0566e-02_r8,9.2464e-03_r8, & + &7.6156e-03_r8,5.5141e-03_r8,1.6582e-03_r8/) + kao(:, 4,11, 4) = (/ & + &1.6491e-02_r8,1.8759e-02_r8,1.8258e-02_r8,1.7109e-02_r8,1.5472e-02_r8,1.3463e-02_r8, & + &1.0963e-02_r8,7.7973e-03_r8,1.8335e-03_r8/) + kao(:, 5,11, 4) = (/ & + &2.5430e-02_r8,2.8078e-02_r8,2.7002e-02_r8,2.5032e-02_r8,2.2392e-02_r8,1.9261e-02_r8, & + &1.5474e-02_r8,1.0784e-02_r8,2.0075e-03_r8/) + kao(:, 1,12, 4) = (/ & + &4.9273e-03_r8,5.7931e-03_r8,5.6746e-03_r8,5.3611e-03_r8,4.8847e-03_r8,4.2709e-03_r8, & + &3.4855e-03_r8,2.4889e-03_r8,1.1526e-03_r8/) + kao(:, 2,12, 4) = (/ & + &7.6884e-03_r8,8.9132e-03_r8,8.6777e-03_r8,8.1782e-03_r8,7.4327e-03_r8,6.4648e-03_r8, & + &5.2372e-03_r8,3.6981e-03_r8,1.3373e-03_r8/) + kao(:, 3,12, 4) = (/ & + &1.2107e-02_r8,1.3711e-02_r8,1.3177e-02_r8,1.2250e-02_r8,1.1036e-02_r8,9.5160e-03_r8, & + &7.6801e-03_r8,5.4155e-03_r8,1.5194e-03_r8/) + kao(:, 4,12, 4) = (/ & + &1.8869e-02_r8,2.0811e-02_r8,1.9833e-02_r8,1.8325e-02_r8,1.6361e-02_r8,1.3983e-02_r8, & + &1.1160e-02_r8,7.6837e-03_r8,1.7468e-03_r8/) + kao(:, 5,12, 4) = (/ & + &2.9063e-02_r8,3.1131e-02_r8,2.9461e-02_r8,2.6993e-02_r8,2.3838e-02_r8,2.0192e-02_r8, & + &1.5924e-02_r8,1.0737e-02_r8,1.9884e-03_r8/) + kao(:, 1,13, 4) = (/ & + &4.3869e-03_r8,5.1798e-03_r8,5.0989e-03_r8,4.8169e-03_r8,4.3794e-03_r8,3.7839e-03_r8, & + &3.0521e-03_r8,2.1587e-03_r8,9.4784e-04_r8/) + kao(:, 2,13, 4) = (/ & + &6.9481e-03_r8,8.0525e-03_r8,7.8458e-03_r8,7.3314e-03_r8,6.6078e-03_r8,5.7100e-03_r8, & + &4.5663e-03_r8,3.2136e-03_r8,1.0961e-03_r8/) + kao(:, 3,13, 4) = (/ & + &1.1021e-02_r8,1.2458e-02_r8,1.1977e-02_r8,1.1021e-02_r8,9.8258e-03_r8,8.4083e-03_r8, & + &6.7419e-03_r8,4.6947e-03_r8,1.2238e-03_r8/) + kao(:, 4,13, 4) = (/ & + &1.7310e-02_r8,1.8923e-02_r8,1.8001e-02_r8,1.6509e-02_r8,1.4657e-02_r8,1.2419e-02_r8, & + &9.8548e-03_r8,6.6916e-03_r8,1.4326e-03_r8/) + kao(:, 5,13, 4) = (/ & + &2.6619e-02_r8,2.8296e-02_r8,2.6623e-02_r8,2.4187e-02_r8,2.1294e-02_r8,1.7939e-02_r8, & + &1.4103e-02_r8,9.4141e-03_r8,1.6712e-03_r8/) + kao(:, 1, 1, 5) = (/ & + &1.5033e-04_r8,2.0446e-03_r8,3.1681e-03_r8,4.0928e-03_r8,4.9645e-03_r8,5.8752e-03_r8, & + &6.8891e-03_r8,9.7460e-03_r8,8.2375e-03_r8/) + kao(:, 2, 1, 5) = (/ & + &2.0389e-04_r8,2.4966e-03_r8,3.8465e-03_r8,4.9929e-03_r8,6.1245e-03_r8,7.2940e-03_r8, & + &8.7776e-03_r8,1.1499e-02_r8,1.0182e-02_r8/) + kao(:, 3, 1, 5) = (/ & + &2.6769e-04_r8,3.0079e-03_r8,4.6076e-03_r8,5.9938e-03_r8,7.3703e-03_r8,8.8250e-03_r8, & + &1.0916e-02_r8,1.3468e-02_r8,1.2268e-02_r8/) + kao(:, 4, 1, 5) = (/ & + &3.4024e-04_r8,3.5831e-03_r8,5.4751e-03_r8,7.1124e-03_r8,8.7423e-03_r8,1.0600e-02_r8, & + &1.2985e-02_r8,1.6757e-02_r8,1.4652e-02_r8/) + kao(:, 5, 1, 5) = (/ & + &4.2020e-04_r8,4.2180e-03_r8,6.4294e-03_r8,8.3453e-03_r8,1.0248e-02_r8,1.2449e-02_r8, & + &1.5350e-02_r8,1.9955e-02_r8,1.7214e-02_r8/) + kao(:, 1, 2, 5) = (/ & + &1.8399e-04_r8,1.8419e-03_r8,2.8498e-03_r8,3.5822e-03_r8,4.2442e-03_r8,4.8814e-03_r8, & + &5.3141e-03_r8,6.9582e-03_r8,6.1890e-03_r8/) + kao(:, 2, 2, 5) = (/ & + &2.5292e-04_r8,2.2771e-03_r8,3.4958e-03_r8,4.3938e-03_r8,5.2283e-03_r8,6.0330e-03_r8, & + &6.8353e-03_r8,8.0230e-03_r8,7.6976e-03_r8/) + kao(:, 3, 2, 5) = (/ & + &3.3540e-04_r8,2.7711e-03_r8,4.2257e-03_r8,5.3109e-03_r8,6.3352e-03_r8,7.3450e-03_r8, & + &8.3567e-03_r8,1.0142e-02_r8,9.3716e-03_r8/) + kao(:, 4, 2, 5) = (/ & + &4.2928e-04_r8,3.3267e-03_r8,5.0595e-03_r8,6.3597e-03_r8,7.5719e-03_r8,8.7753e-03_r8, & + &1.0137e-02_r8,1.2487e-02_r8,1.1226e-02_r8/) + kao(:, 5, 2, 5) = (/ & + &5.3326e-04_r8,3.9397e-03_r8,5.9807e-03_r8,7.5174e-03_r8,8.9383e-03_r8,1.0365e-02_r8, & + &1.1992e-02_r8,1.4789e-02_r8,1.3251e-02_r8/) + kao(:, 1, 3, 5) = (/ & + &2.8126e-04_r8,1.8765e-03_r8,2.6588e-03_r8,3.3485e-03_r8,3.8221e-03_r8,4.1636e-03_r8, & + &4.4682e-03_r8,4.4846e-03_r8,4.3919e-03_r8/) + kao(:, 2, 3, 5) = (/ & + &3.9449e-04_r8,2.3306e-03_r8,3.3231e-03_r8,4.1650e-03_r8,4.7241e-03_r8,5.1684e-03_r8, & + &5.5884e-03_r8,5.9167e-03_r8,5.5074e-03_r8/) + kao(:, 3, 3, 5) = (/ & + &5.3269e-04_r8,2.8500e-03_r8,4.0835e-03_r8,5.0834e-03_r8,5.7677e-03_r8,6.3235e-03_r8, & + &6.8829e-03_r8,7.4745e-03_r8,6.8347e-03_r8/) + kao(:, 4, 3, 5) = (/ & + &6.9304e-04_r8,3.4418e-03_r8,4.9465e-03_r8,6.1263e-03_r8,6.9668e-03_r8,7.6366e-03_r8, & + &8.3133e-03_r8,9.1010e-03_r8,8.2831e-03_r8/) + kao(:, 5, 3, 5) = (/ & + &8.7133e-04_r8,4.1178e-03_r8,5.9088e-03_r8,7.3026e-03_r8,8.3125e-03_r8,9.0996e-03_r8, & + &9.9113e-03_r8,1.0888e-02_r8,9.8539e-03_r8/) + kao(:, 1, 4, 5) = (/ & + &4.2942e-04_r8,2.1209e-03_r8,2.6611e-03_r8,3.0954e-03_r8,3.5092e-03_r8,3.7795e-03_r8, & + &3.7536e-03_r8,3.6803e-03_r8,3.1833e-03_r8/) + kao(:, 2, 4, 5) = (/ & + &6.1278e-04_r8,2.6801e-03_r8,3.3648e-03_r8,3.9108e-03_r8,4.4289e-03_r8,4.7305e-03_r8, & + &4.7677e-03_r8,4.7187e-03_r8,4.0112e-03_r8/) + kao(:, 3, 4, 5) = (/ & + &8.4431e-04_r8,3.3316e-03_r8,4.1648e-03_r8,4.8597e-03_r8,5.4829e-03_r8,5.8484e-03_r8, & + &5.9135e-03_r8,5.9451e-03_r8,4.9891e-03_r8/) + kao(:, 4, 4, 5) = (/ & + &1.1175e-03_r8,4.0506e-03_r8,5.0747e-03_r8,5.9647e-03_r8,6.6966e-03_r8,7.1102e-03_r8, & + &7.2127e-03_r8,7.2668e-03_r8,6.0794e-03_r8/) + kao(:, 5, 4, 5) = (/ & + &1.4334e-03_r8,4.8948e-03_r8,6.1056e-03_r8,7.2069e-03_r8,8.0737e-03_r8,8.5555e-03_r8, & + &8.6934e-03_r8,8.7560e-03_r8,7.1896e-03_r8/) + kao(:, 1, 5, 5) = (/ & + &6.0926e-04_r8,2.3529e-03_r8,2.8355e-03_r8,3.0797e-03_r8,3.2149e-03_r8,3.3400e-03_r8, & + &3.3910e-03_r8,2.9801e-03_r8,2.2681e-03_r8/) + kao(:, 2, 5, 5) = (/ & + &8.8131e-04_r8,3.0196e-03_r8,3.6353e-03_r8,3.9718e-03_r8,4.1316e-03_r8,4.2694e-03_r8, & + &4.3037e-03_r8,3.9012e-03_r8,2.9392e-03_r8/) + kao(:, 3, 5, 5) = (/ & + &1.2303e-03_r8,3.8066e-03_r8,4.5787e-03_r8,4.9631e-03_r8,5.1972e-03_r8,5.3645e-03_r8, & + &5.3804e-03_r8,4.9263e-03_r8,3.6983e-03_r8/) + kao(:, 4, 5, 5) = (/ & + &1.6619e-03_r8,4.7363e-03_r8,5.6662e-03_r8,6.1253e-03_r8,6.4225e-03_r8,6.6560e-03_r8, & + &6.6051e-03_r8,6.0844e-03_r8,4.5482e-03_r8/) + kao(:, 5, 5, 5) = (/ & + &2.1681e-03_r8,5.8273e-03_r8,6.8808e-03_r8,7.4389e-03_r8,7.8269e-03_r8,8.1204e-03_r8, & + &8.0166e-03_r8,7.4003e-03_r8,5.4950e-03_r8/) + kao(:, 1, 6, 5) = (/ & + &8.3319e-04_r8,2.4541e-03_r8,2.9309e-03_r8,3.1239e-03_r8,3.1232e-03_r8,3.0304e-03_r8, & + &2.8953e-03_r8,2.6232e-03_r8,1.6854e-03_r8/) + kao(:, 2, 6, 5) = (/ & + &1.2038e-03_r8,3.2544e-03_r8,3.8397e-03_r8,4.0740e-03_r8,4.0835e-03_r8,3.9879e-03_r8, & + &3.7753e-03_r8,3.4082e-03_r8,2.1468e-03_r8/) + kao(:, 3, 6, 5) = (/ & + &1.6852e-03_r8,4.1990e-03_r8,4.9217e-03_r8,5.1945e-03_r8,5.2325e-03_r8,5.0738e-03_r8, & + &4.7918e-03_r8,4.2939e-03_r8,2.6825e-03_r8/) + kao(:, 4, 6, 5) = (/ & + &2.3055e-03_r8,5.2874e-03_r8,6.1886e-03_r8,6.5148e-03_r8,6.5533e-03_r8,6.3614e-03_r8, & + &5.9949e-03_r8,5.3440e-03_r8,3.2990e-03_r8/) + kao(:, 5, 6, 5) = (/ & + &3.0550e-03_r8,6.5592e-03_r8,7.6795e-03_r8,8.0591e-03_r8,8.0426e-03_r8,7.8256e-03_r8, & + &7.4185e-03_r8,6.5412e-03_r8,4.0170e-03_r8/) + kao(:, 1, 7, 5) = (/ & + &1.2030e-03_r8,2.7895e-03_r8,3.1932e-03_r8,3.3085e-03_r8,3.2497e-03_r8,3.0373e-03_r8, & + &2.6860e-03_r8,2.2491e-03_r8,1.3507e-03_r8/) + kao(:, 2, 7, 5) = (/ & + &1.7561e-03_r8,3.7366e-03_r8,4.1989e-03_r8,4.3780e-03_r8,4.3275e-03_r8,4.0454e-03_r8, & + &3.5823e-03_r8,2.9962e-03_r8,1.7424e-03_r8/) + kao(:, 3, 7, 5) = (/ & + &2.4695e-03_r8,4.8641e-03_r8,5.4890e-03_r8,5.7046e-03_r8,5.6266e-03_r8,5.2456e-03_r8, & + &4.6755e-03_r8,3.8694e-03_r8,2.1970e-03_r8/) + kao(:, 4, 7, 5) = (/ & + &3.4036e-03_r8,6.2572e-03_r8,7.0247e-03_r8,7.3182e-03_r8,7.1220e-03_r8,6.6595e-03_r8, & + &5.9470e-03_r8,4.8905e-03_r8,2.7089e-03_r8/) + kao(:, 5, 7, 5) = (/ & + &4.5461e-03_r8,7.9331e-03_r8,8.8637e-03_r8,9.1326e-03_r8,8.9102e-03_r8,8.3275e-03_r8, & + &7.4120e-03_r8,6.0989e-03_r8,3.2778e-03_r8/) + kao(:, 1, 8, 5) = (/ & + &2.0449e-03_r8,3.7053e-03_r8,4.0860e-03_r8,4.1499e-03_r8,3.9922e-03_r8,3.6227e-03_r8, & + &3.0421e-03_r8,2.2282e-03_r8,1.0954e-03_r8/) + kao(:, 2, 8, 5) = (/ & + &3.0260e-03_r8,5.1232e-03_r8,5.5625e-03_r8,5.5873e-03_r8,5.3321e-03_r8,4.8458e-03_r8, & + &4.0703e-03_r8,3.0319e-03_r8,1.4218e-03_r8/) + kao(:, 3, 8, 5) = (/ & + &4.3499e-03_r8,6.8685e-03_r8,7.3484e-03_r8,7.3183e-03_r8,6.9565e-03_r8,6.3086e-03_r8, & + &5.3805e-03_r8,3.9991e-03_r8,1.7827e-03_r8/) + kao(:, 4, 8, 5) = (/ & + &6.0988e-03_r8,9.0048e-03_r8,9.4728e-03_r8,9.3798e-03_r8,8.9487e-03_r8,8.1669e-03_r8, & + &6.9162e-03_r8,5.1727e-03_r8,2.2090e-03_r8/) + kao(:, 5, 8, 5) = (/ & + &8.2301e-03_r8,1.1592e-02_r8,1.2058e-02_r8,1.1936e-02_r8,1.1386e-02_r8,1.0345e-02_r8, & + &8.7069e-03_r8,6.5415e-03_r8,2.6879e-03_r8/) + kao(:, 1, 9, 5) = (/ & + &6.4341e-03_r8,8.4932e-03_r8,8.6319e-03_r8,8.3108e-03_r8,7.7018e-03_r8,6.7763e-03_r8, & + &5.5115e-03_r8,3.7767e-03_r8,9.5475e-04_r8/) + kao(:, 2, 9, 5) = (/ & + &9.6759e-03_r8,1.2213e-02_r8,1.2266e-02_r8,1.1725e-02_r8,1.0741e-02_r8,9.3855e-03_r8, & + &7.5654e-03_r8,5.1517e-03_r8,1.1933e-03_r8/) + kao(:, 3, 9, 5) = (/ & + &1.4274e-02_r8,1.7116e-02_r8,1.6970e-02_r8,1.6030e-02_r8,1.4545e-02_r8,1.2624e-02_r8, & + &1.0092e-02_r8,6.8273e-03_r8,1.4956e-03_r8/) + kao(:, 4, 9, 5) = (/ & + &2.0348e-02_r8,2.3456e-02_r8,2.2925e-02_r8,2.1415e-02_r8,1.9260e-02_r8,1.6502e-02_r8, & + &1.3098e-02_r8,8.8597e-03_r8,1.8913e-03_r8/) + kao(:, 5, 9, 5) = (/ & + &2.7947e-02_r8,3.1392e-02_r8,3.0350e-02_r8,2.8042e-02_r8,2.4920e-02_r8,2.1171e-02_r8, & + &1.6720e-02_r8,1.1275e-02_r8,2.3159e-03_r8/) + kao(:, 1,10, 5) = (/ & + &2.3218e-02_r8,2.4547e-02_r8,2.3456e-02_r8,2.1452e-02_r8,1.8855e-02_r8,1.5703e-02_r8, & + &1.2047e-02_r8,7.7884e-03_r8,1.4115e-03_r8/) + kao(:, 2,10, 5) = (/ & + &3.5352e-02_r8,3.6479e-02_r8,3.4471e-02_r8,3.1299e-02_r8,2.7239e-02_r8,2.2668e-02_r8, & + &1.7318e-02_r8,1.0990e-02_r8,1.7428e-03_r8/) + kao(:, 3,10, 5) = (/ & + &5.3041e-02_r8,5.3290e-02_r8,4.9753e-02_r8,4.4634e-02_r8,3.8593e-02_r8,3.1830e-02_r8, & + &2.4004e-02_r8,1.5032e-02_r8,2.1711e-03_r8/) + kao(:, 4,10, 5) = (/ & + &7.6819e-02_r8,7.5905e-02_r8,7.0118e-02_r8,6.2386e-02_r8,5.3448e-02_r8,4.3595e-02_r8, & + &3.2572e-02_r8,2.0010e-02_r8,2.6405e-03_r8/) + kao(:, 5,10, 5) = (/ & + &1.0741e-01_r8,1.0446e-01_r8,9.5780e-02_r8,8.4676e-02_r8,7.2117e-02_r8,5.8406e-02_r8, & + &4.3338e-02_r8,2.6148e-02_r8,3.0152e-03_r8/) + kao(:, 1,11, 5) = (/ & + &3.5267e-02_r8,3.5419e-02_r8,3.3018e-02_r8,2.9652e-02_r8,2.5661e-02_r8,2.1081e-02_r8, & + &1.5812e-02_r8,9.8203e-03_r8,1.5039e-03_r8/) + kao(:, 2,11, 5) = (/ & + &5.4088e-02_r8,5.3137e-02_r8,4.9102e-02_r8,4.3719e-02_r8,3.7498e-02_r8,3.0622e-02_r8, & + &2.2914e-02_r8,1.4036e-02_r8,1.8588e-03_r8/) + kao(:, 3,11, 5) = (/ & + &8.1309e-02_r8,7.8515e-02_r8,7.1873e-02_r8,6.3455e-02_r8,5.4008e-02_r8,4.3709e-02_r8, & + &3.2277e-02_r8,1.9424e-02_r8,2.2498e-03_r8/) + kao(:, 4,11, 5) = (/ & + &1.1800e-01_r8,1.1244e-01_r8,1.0217e-01_r8,8.9567e-02_r8,7.5664e-02_r8,6.0559e-02_r8, & + &4.4387e-02_r8,2.6353e-02_r8,2.7248e-03_r8/) + kao(:, 5,11, 5) = (/ & + &1.6472e-01_r8,1.5538e-01_r8,1.4035e-01_r8,1.2265e-01_r8,1.0315e-01_r8,8.2131e-02_r8, & + &5.9771e-02_r8,3.4979e-02_r8,3.2176e-03_r8/) + kao(:, 1,12, 5) = (/ & + &3.9647e-02_r8,3.8955e-02_r8,3.5866e-02_r8,3.1882e-02_r8,2.7372e-02_r8,2.2283e-02_r8, & + &1.6581e-02_r8,1.0137e-02_r8,1.4428e-03_r8/) + kao(:, 2,12, 5) = (/ & + &6.1147e-02_r8,5.9154e-02_r8,5.3991e-02_r8,4.7633e-02_r8,4.0515e-02_r8,3.2821e-02_r8, & + &2.4231e-02_r8,1.4611e-02_r8,1.7795e-03_r8/) + kao(:, 3,12, 5) = (/ & + &9.1962e-02_r8,8.7537e-02_r8,7.9486e-02_r8,6.9739e-02_r8,5.8957e-02_r8,4.7222e-02_r8, & + &3.4488e-02_r8,2.0425e-02_r8,2.1548e-03_r8/) + kao(:, 4,12, 5) = (/ & + &1.3375e-01_r8,1.2593e-01_r8,1.1362e-01_r8,9.8983e-02_r8,8.2938e-02_r8,6.5961e-02_r8, & + &4.7849e-02_r8,2.7977e-02_r8,2.5823e-03_r8/) + kao(:, 5,12, 5) = (/ & + &1.8619e-01_r8,1.7389e-01_r8,1.5614e-01_r8,1.3563e-01_r8,1.1356e-01_r8,8.9900e-02_r8, & + &6.4743e-02_r8,3.7437e-02_r8,3.0416e-03_r8/) + kao(:, 1,13, 5) = (/ & + &3.5348e-02_r8,3.4594e-02_r8,3.1651e-02_r8,2.8032e-02_r8,2.3972e-02_r8,1.9476e-02_r8, & + &1.4520e-02_r8,8.8483e-03_r8,1.2073e-03_r8/) + kao(:, 2,13, 5) = (/ & + &5.4657e-02_r8,5.2717e-02_r8,4.7880e-02_r8,4.2169e-02_r8,3.5919e-02_r8,2.9028e-02_r8, & + &2.1424e-02_r8,1.2832e-02_r8,1.4997e-03_r8/) + kao(:, 3,13, 5) = (/ & + &8.2593e-02_r8,7.8668e-02_r8,7.1038e-02_r8,6.2226e-02_r8,5.2555e-02_r8,4.1980e-02_r8, & + &3.0595e-02_r8,1.8057e-02_r8,1.8484e-03_r8/) + kao(:, 4,13, 5) = (/ & + &1.1968e-01_r8,1.1269e-01_r8,1.0134e-01_r8,8.8277e-02_r8,7.4125e-02_r8,5.9019e-02_r8, & + &4.2726e-02_r8,2.4879e-02_r8,2.2113e-03_r8/) + kao(:, 5,13, 5) = (/ & + &1.6694e-01_r8,1.5606e-01_r8,1.3993e-01_r8,1.2146e-01_r8,1.0158e-01_r8,8.0368e-02_r8, & + &5.7742e-02_r8,3.3361e-02_r8,2.6209e-03_r8/) + kao(:, 1, 1, 6) = (/ & + &5.8710e-04_r8,3.7447e-03_r8,5.6598e-03_r8,7.4215e-03_r8,9.2308e-03_r8,1.1302e-02_r8, & + &1.3745e-02_r8,1.7130e-02_r8,1.6376e-02_r8/) + kao(:, 2, 1, 6) = (/ & + &7.1095e-04_r8,4.5295e-03_r8,6.8956e-03_r8,9.1329e-03_r8,1.1441e-02_r8,1.4069e-02_r8, & + &1.7260e-02_r8,2.1984e-02_r8,2.0159e-02_r8/) + kao(:, 3, 1, 6) = (/ & + &8.4824e-04_r8,5.3994e-03_r8,8.2567e-03_r8,1.1010e-02_r8,1.3909e-02_r8,1.7204e-02_r8, & + &2.1091e-02_r8,2.7132e-02_r8,2.4524e-02_r8/) + kao(:, 4, 1, 6) = (/ & + &9.9962e-04_r8,6.3675e-03_r8,9.7929e-03_r8,1.3116e-02_r8,1.6664e-02_r8,2.0670e-02_r8, & + &2.5520e-02_r8,3.3009e-02_r8,2.9504e-02_r8/) + kao(:, 5, 1, 6) = (/ & + &1.1677e-03_r8,7.4449e-03_r8,1.1517e-02_r8,1.5476e-02_r8,1.9740e-02_r8,2.4530e-02_r8, & + &3.0349e-02_r8,3.9385e-02_r8,3.5028e-02_r8/) + kao(:, 1, 2, 6) = (/ & + &7.3151e-04_r8,3.6448e-03_r8,5.2016e-03_r8,6.6421e-03_r8,7.9400e-03_r8,9.1018e-03_r8, & + &1.0516e-02_r8,1.2549e-02_r8,1.2514e-02_r8/) + kao(:, 2, 2, 6) = (/ & + &8.8990e-04_r8,4.4216e-03_r8,6.3659e-03_r8,8.1663e-03_r8,9.8302e-03_r8,1.1392e-02_r8, & + &1.3321e-02_r8,1.6283e-02_r8,1.5469e-02_r8/) + kao(:, 3, 2, 6) = (/ & + &1.0714e-03_r8,5.2883e-03_r8,7.6564e-03_r8,9.8457e-03_r8,1.1909e-02_r8,1.3940e-02_r8, & + &1.6405e-02_r8,2.0166e-02_r8,1.8847e-02_r8/) + kao(:, 4, 2, 6) = (/ & + &1.2782e-03_r8,6.2637e-03_r8,9.0995e-03_r8,1.1738e-02_r8,1.4242e-02_r8,1.6761e-02_r8, & + &1.9871e-02_r8,2.4604e-02_r8,2.2753e-02_r8/) + kao(:, 5, 2, 6) = (/ & + &1.5101e-03_r8,7.3491e-03_r8,1.0728e-02_r8,1.3865e-02_r8,1.6850e-02_r8,1.9892e-02_r8, & + &2.3687e-02_r8,2.9581e-02_r8,2.7171e-02_r8/) + kao(:, 1, 3, 6) = (/ & + &1.1614e-03_r8,3.9286e-03_r8,5.2992e-03_r8,6.2920e-03_r8,7.1803e-03_r8,7.9571e-03_r8, & + &8.5455e-03_r8,9.0349e-03_r8,9.0567e-03_r8/) + kao(:, 2, 3, 6) = (/ & + &1.4526e-03_r8,4.8338e-03_r8,6.5076e-03_r8,7.7704e-03_r8,8.9197e-03_r8,9.9629e-03_r8, & + &1.0799e-02_r8,1.1625e-02_r8,1.1298e-02_r8/) + kao(:, 3, 3, 6) = (/ & + &1.7725e-03_r8,5.8343e-03_r8,7.8680e-03_r8,9.4298e-03_r8,1.0866e-02_r8,1.2179e-02_r8, & + &1.3264e-02_r8,1.4525e-02_r8,1.3847e-02_r8/) + kao(:, 4, 3, 6) = (/ & + &2.1368e-03_r8,6.9576e-03_r8,9.3967e-03_r8,1.1298e-02_r8,1.3038e-02_r8,1.4633e-02_r8, & + &1.6013e-02_r8,1.7774e-02_r8,1.6807e-02_r8/) + kao(:, 5, 3, 6) = (/ & + &2.5530e-03_r8,8.2213e-03_r8,1.1119e-02_r8,1.3386e-02_r8,1.5467e-02_r8,1.7396e-02_r8, & + &1.9105e-02_r8,2.1405e-02_r8,2.0198e-02_r8/) + kao(:, 1, 4, 6) = (/ & + &1.8393e-03_r8,4.2719e-03_r8,5.6108e-03_r8,6.4238e-03_r8,6.8867e-03_r8,7.1924e-03_r8, & + &7.4060e-03_r8,7.2862e-03_r8,6.3156e-03_r8/) + kao(:, 2, 4, 6) = (/ & + &2.3510e-03_r8,5.3330e-03_r8,6.9923e-03_r8,7.9801e-03_r8,8.5829e-03_r8,9.0352e-03_r8, & + &9.3670e-03_r8,9.3790e-03_r8,7.9787e-03_r8/) + kao(:, 3, 4, 6) = (/ & + &2.9328e-03_r8,6.5477e-03_r8,8.5524e-03_r8,9.7522e-03_r8,1.0523e-02_r8,1.1105e-02_r8, & + &1.1571e-02_r8,1.1684e-02_r8,9.9124e-03_r8/) + kao(:, 4, 4, 6) = (/ & + &3.6136e-03_r8,7.9708e-03_r8,1.0306e-02_r8,1.1748e-02_r8,1.2708e-02_r8,1.3440e-02_r8, & + &1.4032e-02_r8,1.4271e-02_r8,1.2172e-02_r8/) + kao(:, 5, 4, 6) = (/ & + &4.3442e-03_r8,9.5761e-03_r8,1.2277e-02_r8,1.3997e-02_r8,1.5163e-02_r8,1.6053e-02_r8, & + &1.6795e-02_r8,1.7163e-02_r8,1.4922e-02_r8/) + kao(:, 1, 5, 6) = (/ & + &2.6688e-03_r8,4.8052e-03_r8,5.7832e-03_r8,6.4797e-03_r8,6.8502e-03_r8,6.8218e-03_r8, & + &6.5242e-03_r8,6.0722e-03_r8,4.6753e-03_r8/) + kao(:, 2, 5, 6) = (/ & + &3.4688e-03_r8,6.1297e-03_r8,7.3230e-03_r8,8.1782e-03_r8,8.6322e-03_r8,8.6195e-03_r8, & + &8.3126e-03_r8,7.8540e-03_r8,5.9385e-03_r8/) + kao(:, 3, 5, 6) = (/ & + &4.4058e-03_r8,7.6630e-03_r8,9.1013e-03_r8,1.0147e-02_r8,1.0667e-02_r8,1.0680e-02_r8, & + &1.0355e-02_r8,9.8543e-03_r8,7.3828e-03_r8/) + kao(:, 4, 5, 6) = (/ & + &5.5115e-03_r8,9.4361e-03_r8,1.1163e-02_r8,1.2385e-02_r8,1.2986e-02_r8,1.3010e-02_r8, & + &1.2662e-02_r8,1.2099e-02_r8,9.0803e-03_r8/) + kao(:, 5, 5, 6) = (/ & + &6.7862e-03_r8,1.1482e-02_r8,1.3563e-02_r8,1.4942e-02_r8,1.5588e-02_r8,1.5643e-02_r8, & + &1.5261e-02_r8,1.4627e-02_r8,1.1026e-02_r8/) + kao(:, 1, 6, 6) = (/ & + &3.5724e-03_r8,5.4370e-03_r8,6.0294e-03_r8,6.3914e-03_r8,6.6047e-03_r8,6.5232e-03_r8, & + &6.0277e-03_r8,5.0661e-03_r8,3.1530e-03_r8/) + kao(:, 2, 6, 6) = (/ & + &4.7182e-03_r8,7.1382e-03_r8,7.8365e-03_r8,8.2706e-03_r8,8.5053e-03_r8,8.3495e-03_r8, & + &7.7282e-03_r8,6.6198e-03_r8,4.1407e-03_r8/) + kao(:, 3, 6, 6) = (/ & + &6.1150e-03_r8,9.1981e-03_r8,9.9430e-03_r8,1.0464e-02_r8,1.0671e-02_r8,1.0482e-02_r8, & + &9.6931e-03_r8,8.3868e-03_r8,5.3331e-03_r8/) + kao(:, 4, 6, 6) = (/ & + &7.7447e-03_r8,1.1494e-02_r8,1.2445e-02_r8,1.3024e-02_r8,1.3207e-02_r8,1.2894e-02_r8, & + &1.1946e-02_r8,1.0395e-02_r8,6.6921e-03_r8/) + kao(:, 5, 6, 6) = (/ & + &9.6796e-03_r8,1.4190e-02_r8,1.5330e-02_r8,1.5967e-02_r8,1.6158e-02_r8,1.5661e-02_r8, & + &1.4492e-02_r8,1.2674e-02_r8,8.2498e-03_r8/) + kao(:, 1, 7, 6) = (/ & + &4.9616e-03_r8,6.6121e-03_r8,6.8416e-03_r8,6.8101e-03_r8,6.6768e-03_r8,6.3696e-03_r8, & + &5.8141e-03_r8,4.6733e-03_r8,2.5227e-03_r8/) + kao(:, 2, 7, 6) = (/ & + &6.6954e-03_r8,8.8189e-03_r8,9.1778e-03_r8,9.1281e-03_r8,8.8939e-03_r8,8.4196e-03_r8, & + &7.6478e-03_r8,6.1227e-03_r8,3.2129e-03_r8/) + kao(:, 3, 7, 6) = (/ & + &8.9023e-03_r8,1.1584e-02_r8,1.1984e-02_r8,1.1899e-02_r8,1.1446e-02_r8,1.0830e-02_r8, & + &9.7223e-03_r8,7.7935e-03_r8,4.0071e-03_r8/) + kao(:, 4, 7, 6) = (/ & + &1.1382e-02_r8,1.4883e-02_r8,1.5340e-02_r8,1.5077e-02_r8,1.4572e-02_r8,1.3613e-02_r8, & + &1.2124e-02_r8,9.7242e-03_r8,4.9238e-03_r8/) + kao(:, 5, 7, 6) = (/ & + &1.4371e-02_r8,1.8723e-02_r8,1.9154e-02_r8,1.8910e-02_r8,1.8193e-02_r8,1.6854e-02_r8, & + &1.4917e-02_r8,1.1939e-02_r8,6.0317e-03_r8/) + kao(:, 1, 8, 6) = (/ & + &8.7001e-03_r8,9.7747e-03_r8,9.5071e-03_r8,8.9379e-03_r8,8.2227e-03_r8,7.2962e-03_r8, & + &6.1868e-03_r8,4.7953e-03_r8,2.0794e-03_r8/) + kao(:, 2, 8, 6) = (/ & + &1.1618e-02_r8,1.3178e-02_r8,1.2958e-02_r8,1.2245e-02_r8,1.1180e-02_r8,9.8759e-03_r8, & + &8.4959e-03_r8,6.4689e-03_r8,2.6798e-03_r8/) + kao(:, 3, 8, 6) = (/ & + &1.5351e-02_r8,1.7665e-02_r8,1.7319e-02_r8,1.6267e-02_r8,1.4838e-02_r8,1.3188e-02_r8, & + &1.1167e-02_r8,8.4425e-03_r8,3.4113e-03_r8/) + kao(:, 4, 8, 6) = (/ & + &2.0092e-02_r8,2.2911e-02_r8,2.2431e-02_r8,2.1181e-02_r8,1.9393e-02_r8,1.7119e-02_r8, & + &1.4369e-02_r8,1.0695e-02_r8,4.2567e-03_r8/) + kao(:, 5, 8, 6) = (/ & + &2.5625e-02_r8,2.9136e-02_r8,2.8640e-02_r8,2.6980e-02_r8,2.4612e-02_r8,2.1703e-02_r8, & + &1.8202e-02_r8,1.3310e-02_r8,5.2101e-03_r8/) + kao(:, 1, 9, 6) = (/ & + &2.8411e-02_r8,2.7805e-02_r8,2.5436e-02_r8,2.2677e-02_r8,1.9516e-02_r8,1.5867e-02_r8, & + &1.1958e-02_r8,7.5969e-03_r8,2.0612e-03_r8/) + kao(:, 2, 9, 6) = (/ & + &3.8814e-02_r8,3.7908e-02_r8,3.4867e-02_r8,3.0948e-02_r8,2.6641e-02_r8,2.1668e-02_r8, & + &1.6345e-02_r8,1.0429e-02_r8,2.5903e-03_r8/) + kao(:, 3, 9, 6) = (/ & + &5.1537e-02_r8,5.0347e-02_r8,4.6262e-02_r8,4.1144e-02_r8,3.5324e-02_r8,2.8924e-02_r8, & + &2.1923e-02_r8,1.4064e-02_r8,3.2116e-03_r8/) + kao(:, 4, 9, 6) = (/ & + &6.6909e-02_r8,6.5234e-02_r8,6.0364e-02_r8,5.3943e-02_r8,4.6443e-02_r8,3.8124e-02_r8, & + &2.8947e-02_r8,1.8549e-02_r8,3.8623e-03_r8/) + kao(:, 5, 9, 6) = (/ & + &8.6078e-02_r8,8.4018e-02_r8,7.7843e-02_r8,6.9506e-02_r8,5.9853e-02_r8,4.9159e-02_r8, & + &3.7146e-02_r8,2.3977e-02_r8,4.6095e-03_r8/) + kao(:, 1,10, 6) = (/ & + &1.0479e-01_r8,9.4804e-02_r8,8.4158e-02_r8,7.2419e-02_r8,5.9897e-02_r8,4.7014e-02_r8, & + &3.3513e-02_r8,1.8915e-02_r8,2.3959e-03_r8/) + kao(:, 2,10, 6) = (/ & + &1.4593e-01_r8,1.3214e-01_r8,1.1705e-01_r8,1.0074e-01_r8,8.3547e-02_r8,6.5542e-02_r8, & + &4.6772e-02_r8,2.6375e-02_r8,2.8756e-03_r8/) + kao(:, 3,10, 6) = (/ & + &1.9678e-01_r8,1.7825e-01_r8,1.5773e-01_r8,1.3590e-01_r8,1.1277e-01_r8,8.8462e-02_r8, & + &6.3144e-02_r8,3.5733e-02_r8,3.4719e-03_r8/) + kao(:, 4,10, 6) = (/ & + &2.5901e-01_r8,2.3451e-01_r8,2.0787e-01_r8,1.7931e-01_r8,1.4891e-01_r8,1.1693e-01_r8, & + &8.3230e-02_r8,4.7067e-02_r8,4.3129e-03_r8/) + kao(:, 5,10, 6) = (/ & + &3.3485e-01_r8,3.0286e-01_r8,2.6808e-01_r8,2.3135e-01_r8,1.9236e-01_r8,1.5087e-01_r8, & + &1.0672e-01_r8,6.0498e-02_r8,5.2412e-03_r8/) + kao(:, 1,11, 6) = (/ & + &1.5729e-01_r8,1.4058e-01_r8,1.2399e-01_r8,1.0596e-01_r8,8.6953e-02_r8,6.7449e-02_r8, & + &4.7388e-02_r8,2.6098e-02_r8,2.4928e-03_r8/) + kao(:, 2,11, 6) = (/ & + &2.1957e-01_r8,1.9641e-01_r8,1.7272e-01_r8,1.4763e-01_r8,1.2135e-01_r8,9.4358e-02_r8, & + &6.6246e-02_r8,3.6579e-02_r8,3.1141e-03_r8/) + kao(:, 3,11, 6) = (/ & + &2.9796e-01_r8,2.6647e-01_r8,2.3432e-01_r8,2.0028e-01_r8,1.6476e-01_r8,1.2810e-01_r8, & + &8.9989e-02_r8,4.9741e-02_r8,3.7347e-03_r8/) + kao(:, 4,11, 6) = (/ & + &3.9483e-01_r8,3.5349e-01_r8,3.1058e-01_r8,2.6565e-01_r8,2.1911e-01_r8,1.7032e-01_r8, & + &1.1939e-01_r8,6.5674e-02_r8,4.4794e-03_r8/) + kao(:, 5,11, 6) = (/ & + &5.1293e-01_r8,4.5889e-01_r8,4.0288e-01_r8,3.4402e-01_r8,2.8339e-01_r8,2.1998e-01_r8, & + &1.5383e-01_r8,8.4493e-02_r8,5.3916e-03_r8/) + kao(:, 1,12, 6) = (/ & + &1.7496e-01_r8,1.5620e-01_r8,1.3720e-01_r8,1.1692e-01_r8,9.5664e-02_r8,7.3896e-02_r8, & + &5.1517e-02_r8,2.8131e-02_r8,2.4011e-03_r8/) + kao(:, 2,12, 6) = (/ & + &2.4535e-01_r8,2.1911e-01_r8,1.9222e-01_r8,1.6394e-01_r8,1.3439e-01_r8,1.0379e-01_r8, & + &7.2409e-02_r8,3.9528e-02_r8,2.9367e-03_r8/) + kao(:, 3,12, 6) = (/ & + &3.3489e-01_r8,2.9916e-01_r8,2.6204e-01_r8,2.2337e-01_r8,1.8311e-01_r8,1.4171e-01_r8, & + &9.8967e-02_r8,5.4062e-02_r8,3.5110e-03_r8/) + kao(:, 4,12, 6) = (/ & + &4.4645e-01_r8,3.9881e-01_r8,3.4940e-01_r8,2.9764e-01_r8,2.4438e-01_r8,1.8899e-01_r8, & + &1.3169e-01_r8,7.1745e-02_r8,4.2744e-03_r8/) + kao(:, 5,12, 6) = (/ & + &5.8440e-01_r8,5.2135e-01_r8,4.5608e-01_r8,3.8804e-01_r8,3.1784e-01_r8,2.4555e-01_r8, & + &1.7082e-01_r8,9.2836e-02_r8,5.0546e-03_r8/) + kao(:, 1,13, 6) = (/ & + &1.5548e-01_r8,1.3934e-01_r8,1.2226e-01_r8,1.0396e-01_r8,8.5068e-02_r8,6.5711e-02_r8, & + &4.5702e-02_r8,2.4873e-02_r8,2.0740e-03_r8/) + kao(:, 2,13, 6) = (/ & + &2.1897e-01_r8,1.9631e-01_r8,1.7240e-01_r8,1.4676e-01_r8,1.2003e-01_r8,9.2645e-02_r8, & + &6.4538e-02_r8,3.5191e-02_r8,2.5124e-03_r8/) + kao(:, 3,13, 6) = (/ & + &3.0093e-01_r8,2.6954e-01_r8,2.3618e-01_r8,2.0119e-01_r8,1.6478e-01_r8,1.2740e-01_r8, & + &8.8848e-02_r8,4.8366e-02_r8,3.0385e-03_r8/) + kao(:, 4,13, 6) = (/ & + &4.0480e-01_r8,3.6240e-01_r8,3.1715e-01_r8,2.6983e-01_r8,2.2076e-01_r8,1.7039e-01_r8, & + &1.1847e-01_r8,6.4388e-02_r8,3.6949e-03_r8/) + kao(:, 5,13, 6) = (/ & + &5.3109e-01_r8,4.7451e-01_r8,4.1461e-01_r8,3.5239e-01_r8,2.8790e-01_r8,2.2202e-01_r8, & + &1.5435e-01_r8,8.3628e-02_r8,4.3087e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &1.3848e-03_r8,7.4265e-03_r8,1.1328e-02_r8,1.5765e-02_r8,2.0617e-02_r8,2.5760e-02_r8, & + &3.1394e-02_r8,3.9174e-02_r8,3.7962e-02_r8/) + kao(:, 2, 1, 7) = (/ & + &1.6671e-03_r8,8.9945e-03_r8,1.3803e-02_r8,1.9211e-02_r8,2.5130e-02_r8,3.1434e-02_r8, & + &3.8541e-02_r8,4.9244e-02_r8,4.6325e-02_r8/) + kao(:, 3, 1, 7) = (/ & + &1.9714e-03_r8,1.0738e-02_r8,1.6621e-02_r8,2.3153e-02_r8,3.0242e-02_r8,3.7827e-02_r8, & + &4.6470e-02_r8,6.0286e-02_r8,5.5806e-02_r8/) + kao(:, 4, 1, 7) = (/ & + &2.3028e-03_r8,1.2683e-02_r8,1.9788e-02_r8,2.7634e-02_r8,3.6042e-02_r8,4.5063e-02_r8, & + &5.5400e-02_r8,7.2329e-02_r8,6.6551e-02_r8/) + kao(:, 5, 1, 7) = (/ & + &2.6597e-03_r8,1.4839e-02_r8,2.3341e-02_r8,3.2680e-02_r8,4.2600e-02_r8,5.3211e-02_r8, & + &6.5429e-02_r8,8.5816e-02_r8,7.8751e-02_r8/) + kao(:, 1, 2, 7) = (/ & + &1.7365e-03_r8,7.5104e-03_r8,1.0855e-02_r8,1.3649e-02_r8,1.6794e-02_r8,2.0487e-02_r8, & + &2.4622e-02_r8,2.9785e-02_r8,2.9296e-02_r8/) + kao(:, 2, 2, 7) = (/ & + &2.1191e-03_r8,9.1841e-03_r8,1.3246e-02_r8,1.6722e-02_r8,2.0613e-02_r8,2.5164e-02_r8, & + &3.0319e-02_r8,3.7310e-02_r8,3.6002e-02_r8/) + kao(:, 3, 2, 7) = (/ & + &2.5333e-03_r8,1.1030e-02_r8,1.5921e-02_r8,2.0206e-02_r8,2.4966e-02_r8,3.0432e-02_r8, & + &3.6701e-02_r8,4.5559e-02_r8,4.3603e-02_r8/) + kao(:, 4, 2, 7) = (/ & + &2.9828e-03_r8,1.3051e-02_r8,1.8932e-02_r8,2.4145e-02_r8,2.9915e-02_r8,3.6454e-02_r8, & + &4.3919e-02_r8,5.4674e-02_r8,5.2233e-02_r8/) + kao(:, 5, 2, 7) = (/ & + &3.4709e-03_r8,1.5291e-02_r8,2.2279e-02_r8,2.8573e-02_r8,3.5520e-02_r8,4.3284e-02_r8, & + &5.2127e-02_r8,6.5008e-02_r8,6.1979e-02_r8/) + kao(:, 1, 3, 7) = (/ & + &2.8092e-03_r8,8.4318e-03_r8,1.1352e-02_r8,1.3672e-02_r8,1.5434e-02_r8,1.6834e-02_r8, & + &1.8680e-02_r8,2.1551e-02_r8,2.1437e-02_r8/) + kao(:, 2, 3, 7) = (/ & + &3.4524e-03_r8,1.0436e-02_r8,1.4060e-02_r8,1.6891e-02_r8,1.9071e-02_r8,2.0847e-02_r8, & + &2.3206e-02_r8,2.6955e-02_r8,2.6565e-02_r8/) + kao(:, 3, 3, 7) = (/ & + &4.1827e-03_r8,1.2653e-02_r8,1.7072e-02_r8,2.0477e-02_r8,2.3160e-02_r8,2.5389e-02_r8, & + &2.8361e-02_r8,3.3016e-02_r8,3.2451e-02_r8/) + kao(:, 4, 3, 7) = (/ & + &4.9958e-03_r8,1.5103e-02_r8,2.0380e-02_r8,2.4512e-02_r8,2.7790e-02_r8,3.0621e-02_r8, & + &3.4270e-02_r8,3.9878e-02_r8,3.9158e-02_r8/) + kao(:, 5, 3, 7) = (/ & + &5.8802e-03_r8,1.7776e-02_r8,2.4055e-02_r8,2.9030e-02_r8,3.2999e-02_r8,3.6516e-02_r8, & + &4.0970e-02_r8,4.7651e-02_r8,4.6784e-02_r8/) + kao(:, 1, 4, 7) = (/ & + &4.5589e-03_r8,1.0079e-02_r8,1.2337e-02_r8,1.3994e-02_r8,1.5249e-02_r8,1.6070e-02_r8, & + &1.6321e-02_r8,1.6191e-02_r8,1.5492e-02_r8/) + kao(:, 2, 4, 7) = (/ & + &5.6834e-03_r8,1.2638e-02_r8,1.5464e-02_r8,1.7583e-02_r8,1.9154e-02_r8,2.0166e-02_r8, & + &2.0456e-02_r8,2.0438e-02_r8,1.9456e-02_r8/) + kao(:, 3, 4, 7) = (/ & + &6.9619e-03_r8,1.5492e-02_r8,1.8969e-02_r8,2.1612e-02_r8,2.3568e-02_r8,2.4770e-02_r8, & + &2.5120e-02_r8,2.5223e-02_r8,2.3997e-02_r8/) + kao(:, 4, 4, 7) = (/ & + &8.4006e-03_r8,1.8644e-02_r8,2.2892e-02_r8,2.6108e-02_r8,2.8487e-02_r8,2.9981e-02_r8, & + &3.0457e-02_r8,3.0724e-02_r8,2.9183e-02_r8/) + kao(:, 5, 4, 7) = (/ & + &1.0053e-02_r8,2.2099e-02_r8,2.7239e-02_r8,3.1080e-02_r8,3.3975e-02_r8,3.5831e-02_r8, & + &3.6496e-02_r8,3.6989e-02_r8,3.5086e-02_r8/) + kao(:, 1, 5, 7) = (/ & + &6.7689e-03_r8,1.1903e-02_r8,1.3648e-02_r8,1.4571e-02_r8,1.5091e-02_r8,1.5249e-02_r8, & + &1.4963e-02_r8,1.3941e-02_r8,1.1072e-02_r8/) + kao(:, 2, 5, 7) = (/ & + &8.5889e-03_r8,1.5080e-02_r8,1.7390e-02_r8,1.8530e-02_r8,1.9222e-02_r8,1.9473e-02_r8, & + &1.9084e-02_r8,1.7764e-02_r8,1.3833e-02_r8/) + kao(:, 3, 5, 7) = (/ & + &1.0679e-02_r8,1.8745e-02_r8,2.1599e-02_r8,2.3039e-02_r8,2.3924e-02_r8,2.4268e-02_r8, & + &2.3807e-02_r8,2.2090e-02_r8,1.7335e-02_r8/) + kao(:, 4, 5, 7) = (/ & + &1.3055e-02_r8,2.2828e-02_r8,2.6303e-02_r8,2.8136e-02_r8,2.9230e-02_r8,2.9685e-02_r8, & + &2.9170e-02_r8,2.7046e-02_r8,2.1372e-02_r8/) + kao(:, 5, 5, 7) = (/ & + &1.5751e-02_r8,2.7271e-02_r8,3.1547e-02_r8,3.3833e-02_r8,3.5204e-02_r8,3.5707e-02_r8, & + &3.5181e-02_r8,3.2654e-02_r8,2.6029e-02_r8/) + kao(:, 1, 6, 7) = (/ & + &9.2094e-03_r8,1.3724e-02_r8,1.5036e-02_r8,1.5371e-02_r8,1.5106e-02_r8,1.4473e-02_r8, & + &1.3532e-02_r8,1.2020e-02_r8,8.1670e-03_r8/) + kao(:, 2, 6, 7) = (/ & + &1.1986e-02_r8,1.7634e-02_r8,1.9365e-02_r8,1.9834e-02_r8,1.9516e-02_r8,1.8750e-02_r8, & + &1.7602e-02_r8,1.5593e-02_r8,1.0511e-02_r8/) + kao(:, 3, 6, 7) = (/ & + &1.5180e-02_r8,2.2067e-02_r8,2.4393e-02_r8,2.4963e-02_r8,2.4596e-02_r8,2.3680e-02_r8, & + &2.2274e-02_r8,1.9750e-02_r8,1.3124e-02_r8/) + kao(:, 4, 6, 7) = (/ & + &1.8879e-02_r8,2.7272e-02_r8,3.0068e-02_r8,3.0821e-02_r8,3.0411e-02_r8,2.9355e-02_r8, & + &2.7616e-02_r8,2.4539e-02_r8,1.6137e-02_r8/) + kao(:, 5, 6, 7) = (/ & + &2.3118e-02_r8,3.3049e-02_r8,3.6382e-02_r8,3.7419e-02_r8,3.7019e-02_r8,3.5790e-02_r8, & + &3.3628e-02_r8,2.9915e-02_r8,1.9032e-02_r8/) + kao(:, 1, 7, 7) = (/ & + &1.3180e-02_r8,1.6672e-02_r8,1.7592e-02_r8,1.7458e-02_r8,1.6513e-02_r8,1.5058e-02_r8, & + &1.3095e-02_r8,1.0650e-02_r8,5.4642e-03_r8/) + kao(:, 2, 7, 7) = (/ & + &1.7434e-02_r8,2.2125e-02_r8,2.3174e-02_r8,2.2835e-02_r8,2.1611e-02_r8,1.9729e-02_r8, & + &1.7181e-02_r8,1.4117e-02_r8,7.1375e-03_r8/) + kao(:, 3, 7, 7) = (/ & + &2.2566e-02_r8,2.8274e-02_r8,2.9519e-02_r8,2.9093e-02_r8,2.7592e-02_r8,2.5177e-02_r8, & + &2.2032e-02_r8,1.8185e-02_r8,9.3084e-03_r8/) + kao(:, 4, 7, 7) = (/ & + &2.8653e-02_r8,3.5321e-02_r8,3.6780e-02_r8,3.6287e-02_r8,3.4434e-02_r8,3.1535e-02_r8, & + &2.7705e-02_r8,2.2900e-02_r8,1.1848e-02_r8/) + kao(:, 5, 7, 7) = (/ & + &3.5765e-02_r8,4.3430e-02_r8,4.5100e-02_r8,4.4435e-02_r8,4.2245e-02_r8,3.8834e-02_r8, & + &3.4253e-02_r8,2.8260e-02_r8,1.4688e-02_r8/) + kao(:, 1, 8, 7) = (/ & + &2.1747e-02_r8,2.4454e-02_r8,2.4292e-02_r8,2.3080e-02_r8,2.1111e-02_r8,1.8543e-02_r8, & + &1.5300e-02_r8,1.1054e-02_r8,4.8558e-03_r8/) + kao(:, 2, 8, 7) = (/ & + &3.0389e-02_r8,3.3327e-02_r8,3.2926e-02_r8,3.1134e-02_r8,2.8533e-02_r8,2.5003e-02_r8, & + &2.0402e-02_r8,1.4724e-02_r8,6.1788e-03_r8/) + kao(:, 3, 8, 7) = (/ & + &4.0290e-02_r8,4.3505e-02_r8,4.2950e-02_r8,4.0676e-02_r8,3.7191e-02_r8,3.2422e-02_r8, & + &2.6427e-02_r8,1.9111e-02_r8,7.6799e-03_r8/) + kao(:, 4, 8, 7) = (/ & + &5.2072e-02_r8,5.5809e-02_r8,5.4895e-02_r8,5.1714e-02_r8,4.6978e-02_r8,4.0907e-02_r8, & + &3.3411e-02_r8,2.4362e-02_r8,9.3208e-03_r8/) + kao(:, 5, 8, 7) = (/ & + &6.6160e-02_r8,7.0258e-02_r8,6.8654e-02_r8,6.4320e-02_r8,5.8240e-02_r8,5.0667e-02_r8, & + &4.1561e-02_r8,3.0531e-02_r8,1.1097e-02_r8/) + kao(:, 1, 9, 7) = (/ & + &6.9879e-02_r8,6.6386e-02_r8,6.1416e-02_r8,5.4862e-02_r8,4.7283e-02_r8,3.9112e-02_r8, & + &2.9846e-02_r8,1.9026e-02_r8,5.0281e-03_r8/) + kao(:, 2, 9, 7) = (/ & + &9.7072e-02_r8,9.2199e-02_r8,8.5540e-02_r8,7.6855e-02_r8,6.6492e-02_r8,5.4707e-02_r8, & + &4.1549e-02_r8,2.6366e-02_r8,6.3749e-03_r8/) + kao(:, 3, 9, 7) = (/ & + &1.3274e-01_r8,1.2639e-01_r8,1.1670e-01_r8,1.0412e-01_r8,8.9576e-02_r8,7.3400e-02_r8, & + &5.5548e-02_r8,3.5017e-02_r8,7.9283e-03_r8/) + kao(:, 4, 9, 7) = (/ & + &1.7725e-01_r8,1.6726e-01_r8,1.5276e-01_r8,1.3606e-01_r8,1.1668e-01_r8,9.5385e-02_r8, & + &7.1895e-02_r8,4.5017e-02_r8,9.7700e-03_r8/) + kao(:, 5, 9, 7) = (/ & + &2.2900e-01_r8,2.1469e-01_r8,1.9562e-01_r8,1.7346e-01_r8,1.4892e-01_r8,1.2126e-01_r8, & + &9.1015e-02_r8,5.6621e-02_r8,1.1851e-02_r8/) + kao(:, 1,10, 7) = (/ & + &2.6110e-01_r8,2.3191e-01_r8,2.0431e-01_r8,1.7643e-01_r8,1.4693e-01_r8,1.1545e-01_r8, & + &8.1908e-02_r8,4.6480e-02_r8,5.5448e-03_r8/) + kao(:, 2,10, 7) = (/ & + &3.6304e-01_r8,3.2305e-01_r8,2.8523e-01_r8,2.4612e-01_r8,2.0468e-01_r8,1.6117e-01_r8, & + &1.1489e-01_r8,6.5350e-02_r8,7.0032e-03_r8/) + kao(:, 3,10, 7) = (/ & + &5.0185e-01_r8,4.4688e-01_r8,3.9417e-01_r8,3.3909e-01_r8,2.8117e-01_r8,2.2056e-01_r8, & + &1.5648e-01_r8,8.9037e-02_r8,8.6105e-03_r8/) + kao(:, 4,10, 7) = (/ & + &6.7448e-01_r8,6.0038e-01_r8,5.2817e-01_r8,4.5305e-01_r8,3.7479e-01_r8,2.9367e-01_r8, & + &2.0933e-01_r8,1.1852e-01_r8,1.0215e-02_r8/) + kao(:, 5,10, 7) = (/ & + &8.8770e-01_r8,7.8961e-01_r8,6.9429e-01_r8,5.9500e-01_r8,4.9158e-01_r8,3.8401e-01_r8, & + &2.7292e-01_r8,1.5364e-01_r8,1.2140e-02_r8/) + kao(:, 1,11, 7) = (/ & + &4.0532e-01_r8,3.5824e-01_r8,3.1239e-01_r8,2.6732e-01_r8,2.2024e-01_r8,1.7123e-01_r8, & + &1.1969e-01_r8,6.6094e-02_r8,5.4214e-03_r8/) + kao(:, 2,11, 7) = (/ & + &5.6606e-01_r8,5.0050e-01_r8,4.3693e-01_r8,3.7301e-01_r8,3.0650e-01_r8,2.3759e-01_r8, & + &1.6618e-01_r8,9.1406e-02_r8,6.5476e-03_r8/) + kao(:, 3,11, 7) = (/ & + &7.7109e-01_r8,6.8230e-01_r8,5.9547e-01_r8,5.0803e-01_r8,4.1719e-01_r8,3.2299e-01_r8, & + &2.2593e-01_r8,1.2450e-01_r8,7.8892e-03_r8/) + kao(:, 4,11, 7) = (/ & + &1.0345e+00_r8,9.1439e-01_r8,7.9746e-01_r8,6.7877e-01_r8,5.5627e-01_r8,4.3053e-01_r8, & + &3.0103e-01_r8,1.6533e-01_r8,9.6823e-03_r8/) + kao(:, 5,11, 7) = (/ & + &1.3462e+00_r8,1.1891e+00_r8,1.0362e+00_r8,8.8065e-01_r8,7.2071e-01_r8,5.5791e-01_r8, & + &3.9044e-01_r8,2.1464e-01_r8,1.1736e-02_r8/) + kao(:, 1,12, 7) = (/ & + &4.6420e-01_r8,4.0988e-01_r8,3.5698e-01_r8,3.0422e-01_r8,2.4918e-01_r8,1.9252e-01_r8, & + &1.3423e-01_r8,7.3160e-02_r8,4.7396e-03_r8/) + kao(:, 2,12, 7) = (/ & + &6.5450e-01_r8,5.7811e-01_r8,5.0333e-01_r8,4.2804e-01_r8,3.4996e-01_r8,2.7019e-01_r8, & + &1.8778e-01_r8,1.0212e-01_r8,5.9506e-03_r8/) + kao(:, 3,12, 7) = (/ & + &8.9348e-01_r8,7.8900e-01_r8,6.8666e-01_r8,5.8272e-01_r8,4.7603e-01_r8,3.6677e-01_r8, & + &2.5473e-01_r8,1.3789e-01_r8,7.3179e-03_r8/) + kao(:, 4,12, 7) = (/ & + &1.1756e+00_r8,1.0374e+00_r8,9.0174e-01_r8,7.6533e-01_r8,6.2509e-01_r8,4.8180e-01_r8, & + &3.3511e-01_r8,1.8185e-01_r8,8.9523e-03_r8/) + kao(:, 5,12, 7) = (/ & + &1.5297e+00_r8,1.3494e+00_r8,1.1729e+00_r8,9.9401e-01_r8,8.1052e-01_r8,6.2387e-01_r8, & + &4.3290e-01_r8,2.3433e-01_r8,1.0845e-02_r8/) + kao(:, 1,13, 7) = (/ & + &4.2167e-01_r8,3.7276e-01_r8,3.2553e-01_r8,2.7726e-01_r8,2.2695e-01_r8,1.7522e-01_r8, & + &1.2184e-01_r8,6.6143e-02_r8,4.0030e-03_r8/) + kao(:, 2,13, 7) = (/ & + &6.0140e-01_r8,5.3188e-01_r8,4.6380e-01_r8,3.9365e-01_r8,3.2184e-01_r8,2.4778e-01_r8, & + &1.7190e-01_r8,9.3023e-02_r8,5.1104e-03_r8/) + kao(:, 3,13, 7) = (/ & + &8.1807e-01_r8,7.2295e-01_r8,6.3004e-01_r8,5.3457e-01_r8,4.3643e-01_r8,3.3605e-01_r8, & + &2.3292e-01_r8,1.2549e-01_r8,6.4347e-03_r8/) + kao(:, 4,13, 7) = (/ & + &1.0778e+00_r8,9.5216e-01_r8,8.2890e-01_r8,7.0211e-01_r8,5.7259e-01_r8,4.4078e-01_r8, & + &3.0511e-01_r8,1.6456e-01_r8,7.8490e-03_r8/) + kao(:, 5,13, 7) = (/ & + &1.3868e+00_r8,1.2246e+00_r8,1.0647e+00_r8,9.0150e-01_r8,7.3547e-01_r8,5.6615e-01_r8, & + &3.9191e-01_r8,2.1135e-01_r8,9.6903e-03_r8/) + kao(:, 1, 1, 8) = (/ & + &3.5696e-03_r8,1.6007e-02_r8,2.9119e-02_r8,4.2110e-02_r8,5.4860e-02_r8,6.8076e-02_r8, & + &8.3917e-02_r8,1.0558e-01_r8,1.0534e-01_r8/) + kao(:, 2, 1, 8) = (/ & + &4.2863e-03_r8,1.9722e-02_r8,3.5791e-02_r8,5.1660e-02_r8,6.7170e-02_r8,8.3493e-02_r8, & + &1.0314e-01_r8,1.2980e-01_r8,1.2936e-01_r8/) + kao(:, 3, 1, 8) = (/ & + &5.0567e-03_r8,2.3939e-02_r8,4.3341e-02_r8,6.2437e-02_r8,8.1028e-02_r8,1.0094e-01_r8, & + &1.2485e-01_r8,1.5697e-01_r8,1.5657e-01_r8/) + kao(:, 4, 1, 8) = (/ & + &5.8865e-03_r8,2.8699e-02_r8,5.1840e-02_r8,7.4548e-02_r8,9.6669e-02_r8,1.2066e-01_r8, & + &1.4947e-01_r8,1.8794e-01_r8,1.8748e-01_r8/) + kao(:, 5, 1, 8) = (/ & + &6.7695e-03_r8,3.4031e-02_r8,6.1358e-02_r8,8.8096e-02_r8,1.1420e-01_r8,1.4289e-01_r8, & + &1.7720e-01_r8,2.2237e-01_r8,2.2240e-01_r8/) + kao(:, 1, 2, 8) = (/ & + &4.7118e-03_r8,1.5877e-02_r8,2.5399e-02_r8,3.5918e-02_r8,4.6457e-02_r8,5.6939e-02_r8, & + &6.8068e-02_r8,8.4536e-02_r8,8.5555e-02_r8/) + kao(:, 2, 2, 8) = (/ & + &5.7108e-03_r8,1.9571e-02_r8,3.1487e-02_r8,4.4433e-02_r8,5.7366e-02_r8,7.0154e-02_r8, & + &8.4052e-02_r8,1.0472e-01_r8,1.0570e-01_r8/) + kao(:, 3, 2, 8) = (/ & + &6.7866e-03_r8,2.3743e-02_r8,3.8403e-02_r8,5.4069e-02_r8,6.9657e-02_r8,8.4997e-02_r8, & + &1.0211e-01_r8,1.2762e-01_r8,1.2838e-01_r8/) + kao(:, 4, 2, 8) = (/ & + &7.9436e-03_r8,2.8460e-02_r8,4.6231e-02_r8,6.4990e-02_r8,8.3598e-02_r8,1.0182e-01_r8, & + &1.2260e-01_r8,1.5356e-01_r8,1.5440e-01_r8/) + kao(:, 5, 2, 8) = (/ & + &9.1873e-03_r8,3.3722e-02_r8,5.4999e-02_r8,7.7194e-02_r8,9.9137e-02_r8,1.2068e-01_r8, & + &1.4584e-01_r8,1.8285e-01_r8,1.8375e-01_r8/) + kao(:, 1, 3, 8) = (/ & + &7.9289e-03_r8,1.8898e-02_r8,2.5653e-02_r8,3.1610e-02_r8,3.8347e-02_r8,4.5822e-02_r8, & + &5.3494e-02_r8,6.2174e-02_r8,6.4789e-02_r8/) + kao(:, 2, 3, 8) = (/ & + &9.7250e-03_r8,2.3378e-02_r8,3.1960e-02_r8,3.9650e-02_r8,4.8157e-02_r8,5.7463e-02_r8, & + &6.6987e-02_r8,7.7905e-02_r8,8.1125e-02_r8/) + kao(:, 3, 3, 8) = (/ & + &1.1690e-02_r8,2.8477e-02_r8,3.9050e-02_r8,4.8735e-02_r8,5.9251e-02_r8,7.0590e-02_r8, & + &8.2118e-02_r8,9.5596e-02_r8,9.9562e-02_r8/) + kao(:, 4, 3, 8) = (/ & + &1.3819e-02_r8,3.4230e-02_r8,4.7053e-02_r8,5.8936e-02_r8,7.1761e-02_r8,8.5391e-02_r8, & + &9.9148e-02_r8,1.1547e-01_r8,1.2059e-01_r8/) + kao(:, 5, 3, 8) = (/ & + &1.6126e-02_r8,4.0610e-02_r8,5.5935e-02_r8,7.0350e-02_r8,8.5758e-02_r8,1.0193e-01_r8, & + &1.1815e-01_r8,1.3794e-01_r8,1.4428e-01_r8/) + kao(:, 1, 4, 8) = (/ & + &1.3217e-02_r8,2.3479e-02_r8,2.9539e-02_r8,3.3751e-02_r8,3.6721e-02_r8,3.9161e-02_r8, & + &4.2339e-02_r8,4.7025e-02_r8,4.7847e-02_r8/) + kao(:, 2, 4, 8) = (/ & + &1.6447e-02_r8,2.9417e-02_r8,3.7093e-02_r8,4.2546e-02_r8,4.6456e-02_r8,4.9765e-02_r8, & + &5.3922e-02_r8,5.9724e-02_r8,6.0703e-02_r8/) + kao(:, 3, 4, 8) = (/ & + &2.0055e-02_r8,3.6163e-02_r8,4.5727e-02_r8,5.2541e-02_r8,5.7472e-02_r8,6.1844e-02_r8, & + &6.7058e-02_r8,7.4090e-02_r8,7.5241e-02_r8/) + kao(:, 4, 4, 8) = (/ & + &2.4006e-02_r8,4.3785e-02_r8,5.5469e-02_r8,6.3755e-02_r8,6.9920e-02_r8,7.5527e-02_r8, & + &8.2000e-02_r8,9.0387e-02_r8,9.1968e-02_r8/) + kao(:, 5, 4, 8) = (/ & + &2.8301e-02_r8,5.2295e-02_r8,6.6272e-02_r8,7.6263e-02_r8,8.3883e-02_r8,9.0941e-02_r8, & + &9.8884e-02_r8,1.0876e-01_r8,1.1102e-01_r8/) + kao(:, 1, 5, 8) = (/ & + &1.9932e-02_r8,2.8909e-02_r8,3.3929e-02_r8,3.6963e-02_r8,3.8599e-02_r8,3.9090e-02_r8, & + &3.8100e-02_r8,3.6647e-02_r8,3.4570e-02_r8/) + kao(:, 2, 5, 8) = (/ & + &2.5221e-02_r8,3.6867e-02_r8,4.3184e-02_r8,4.7147e-02_r8,4.9394e-02_r8,5.0060e-02_r8, & + &4.9016e-02_r8,4.7379e-02_r8,4.4959e-02_r8/) + kao(:, 3, 5, 8) = (/ & + &3.1232e-02_r8,4.5824e-02_r8,5.3773e-02_r8,5.8918e-02_r8,6.1826e-02_r8,6.2626e-02_r8, & + &6.1399e-02_r8,5.9643e-02_r8,5.6358e-02_r8/) + kao(:, 4, 5, 8) = (/ & + &3.7911e-02_r8,5.5890e-02_r8,6.5835e-02_r8,7.2317e-02_r8,7.5820e-02_r8,7.6769e-02_r8, & + &7.5408e-02_r8,7.3611e-02_r8,6.9498e-02_r8/) + kao(:, 5, 5, 8) = (/ & + &4.5225e-02_r8,6.7203e-02_r8,7.9322e-02_r8,8.7058e-02_r8,9.1394e-02_r8,9.2728e-02_r8, & + &9.1290e-02_r8,8.9467e-02_r8,8.4545e-02_r8/) + kao(:, 1, 6, 8) = (/ & + &2.7668e-02_r8,3.4842e-02_r8,3.8147e-02_r8,3.9719e-02_r8,4.0056e-02_r8,3.9073e-02_r8, & + &3.6625e-02_r8,3.2055e-02_r8,2.4026e-02_r8/) + kao(:, 2, 6, 8) = (/ & + &3.5525e-02_r8,4.5073e-02_r8,4.9553e-02_r8,5.1630e-02_r8,5.2026e-02_r8,5.0818e-02_r8, & + &4.7728e-02_r8,4.1935e-02_r8,3.1627e-02_r8/) + kao(:, 3, 6, 8) = (/ & + &4.4689e-02_r8,5.6776e-02_r8,6.2560e-02_r8,6.5413e-02_r8,6.6041e-02_r8,6.4568e-02_r8, & + &6.0721e-02_r8,5.3252e-02_r8,4.0421e-02_r8/) + kao(:, 4, 6, 8) = (/ & + &5.5122e-02_r8,7.0187e-02_r8,7.7371e-02_r8,8.1166e-02_r8,8.2060e-02_r8,8.0200e-02_r8, & + &7.5289e-02_r8,6.6107e-02_r8,5.0711e-02_r8/) + kao(:, 5, 6, 8) = (/ & + &6.6674e-02_r8,8.5247e-02_r8,9.4184e-02_r8,9.8741e-02_r8,9.9891e-02_r8,9.7702e-02_r8, & + &9.1660e-02_r8,8.0784e-02_r8,6.3321e-02_r8/) + kao(:, 1, 7, 8) = (/ & + &4.0056e-02_r8,4.4898e-02_r8,4.5971e-02_r8,4.5352e-02_r8,4.3659e-02_r8,4.0747e-02_r8, & + &3.6554e-02_r8,3.0205e-02_r8,1.8196e-02_r8/) + kao(:, 2, 7, 8) = (/ & + &5.2185e-02_r8,5.8633e-02_r8,6.0480e-02_r8,6.0085e-02_r8,5.7874e-02_r8,5.4080e-02_r8, & + &4.8546e-02_r8,4.0072e-02_r8,2.4060e-02_r8/) + kao(:, 3, 7, 8) = (/ & + &6.6434e-02_r8,7.5122e-02_r8,7.7544e-02_r8,7.7216e-02_r8,7.4584e-02_r8,6.9858e-02_r8, & + &6.2703e-02_r8,5.1788e-02_r8,3.0507e-02_r8/) + kao(:, 4, 7, 8) = (/ & + &8.3239e-02_r8,9.4089e-02_r8,9.7312e-02_r8,9.7000e-02_r8,9.3885e-02_r8,8.8076e-02_r8, & + &7.9042e-02_r8,6.5047e-02_r8,3.6382e-02_r8/) + kao(:, 5, 7, 8) = (/ & + &1.0221e-01_r8,1.1561e-01_r8,1.1992e-01_r8,1.1954e-01_r8,1.1572e-01_r8,1.0845e-01_r8, & + &9.7278e-02_r8,8.0126e-02_r8,4.5426e-02_r8/) + kao(:, 1, 8, 8) = (/ & + &6.9306e-02_r8,6.9494e-02_r8,6.7600e-02_r8,6.3267e-02_r8,5.7322e-02_r8,5.0091e-02_r8, & + &4.1741e-02_r8,3.1433e-02_r8,1.2053e-02_r8/) + kao(:, 2, 8, 8) = (/ & + &9.1357e-02_r8,9.2237e-02_r8,8.9335e-02_r8,8.3857e-02_r8,7.6444e-02_r8,6.7451e-02_r8, & + &5.6474e-02_r8,4.2659e-02_r8,1.6127e-02_r8/) + kao(:, 3, 8, 8) = (/ & + &1.1801e-01_r8,1.1955e-01_r8,1.1588e-01_r8,1.0908e-01_r8,9.9881e-02_r8,8.8243e-02_r8, & + &7.4146e-02_r8,5.6165e-02_r8,2.1600e-02_r8/) + kao(:, 4, 8, 8) = (/ & + &1.4950e-01_r8,1.5197e-01_r8,1.4749e-01_r8,1.3894e-01_r8,1.2736e-01_r8,1.1271e-01_r8, & + &9.4953e-02_r8,7.1880e-02_r8,2.7972e-02_r8/) + kao(:, 5, 8, 8) = (/ & + &1.8646e-01_r8,1.8942e-01_r8,1.8392e-01_r8,1.7346e-01_r8,1.5924e-01_r8,1.4113e-01_r8, & + &1.1856e-01_r8,8.9580e-02_r8,3.5566e-02_r8/) + kao(:, 1, 9, 8) = (/ & + &2.2096e-01_r8,1.9931e-01_r8,1.8126e-01_r8,1.6106e-01_r8,1.3834e-01_r8,1.1283e-01_r8, & + &8.4790e-02_r8,5.3465e-02_r8,1.3124e-02_r8/) + kao(:, 2, 9, 8) = (/ & + &3.0111e-01_r8,2.7269e-01_r8,2.4731e-01_r8,2.1828e-01_r8,1.8616e-01_r8,1.5202e-01_r8, & + &1.1457e-01_r8,7.2434e-02_r8,1.6890e-02_r8/) + kao(:, 3, 9, 8) = (/ & + &3.9547e-01_r8,3.5811e-01_r8,3.2380e-01_r8,2.8636e-01_r8,2.4465e-01_r8,1.9968e-01_r8, & + &1.5075e-01_r8,9.6319e-02_r8,2.1030e-02_r8/) + kao(:, 4, 9, 8) = (/ & + &5.0622e-01_r8,4.6008e-01_r8,4.1701e-01_r8,3.6806e-01_r8,3.1477e-01_r8,2.5740e-01_r8, & + &1.9504e-01_r8,1.2517e-01_r8,2.5567e-02_r8/) + kao(:, 5, 9, 8) = (/ & + &6.3970e-01_r8,5.8282e-01_r8,5.2753e-01_r8,4.6589e-01_r8,3.9821e-01_r8,3.2594e-01_r8, & + &2.4744e-01_r8,1.5892e-01_r8,3.0707e-02_r8/) + kao(:, 1,10, 8) = (/ & + &7.9609e-01_r8,6.9877e-01_r8,6.0631e-01_r8,5.1323e-01_r8,4.2176e-01_r8,3.3040e-01_r8, & + &2.3557e-01_r8,1.3340e-01_r8,1.8364e-02_r8/) + kao(:, 2,10, 8) = (/ & + &1.1185e+00_r8,9.8179e-01_r8,8.5163e-01_r8,7.2111e-01_r8,5.9292e-01_r8,4.6368e-01_r8, & + &3.2777e-01_r8,1.8494e-01_r8,2.2731e-02_r8/) + kao(:, 3,10, 8) = (/ & + &1.4977e+00_r8,1.3152e+00_r8,1.1422e+00_r8,9.6927e-01_r8,7.9815e-01_r8,6.2269e-01_r8, & + &4.4054e-01_r8,2.4719e-01_r8,2.7714e-02_r8/) + kao(:, 4,10, 8) = (/ & + &1.9588e+00_r8,1.7209e+00_r8,1.4963e+00_r8,1.2699e+00_r8,1.0440e+00_r8,8.1231e-01_r8, & + &5.7215e-01_r8,3.2165e-01_r8,3.3541e-02_r8/) + kao(:, 5,10, 8) = (/ & + &2.4948e+00_r8,2.1931e+00_r8,1.9066e+00_r8,1.6194e+00_r8,1.3305e+00_r8,1.0363e+00_r8, & + &7.3187e-01_r8,4.1258e-01_r8,3.9461e-02_r8/) + kao(:, 1,11, 8) = (/ & + &1.1786e+00_r8,1.0326e+00_r8,8.9194e-01_r8,7.5040e-01_r8,6.1100e-01_r8,4.7311e-01_r8, & + &3.3100e-01_r8,1.8184e-01_r8,1.9912e-02_r8/) + kao(:, 2,11, 8) = (/ & + &1.6577e+00_r8,1.4527e+00_r8,1.2557e+00_r8,1.0583e+00_r8,8.6330e-01_r8,6.6758e-01_r8, & + &4.6659e-01_r8,2.5585e-01_r8,2.4574e-02_r8/) + kao(:, 3,11, 8) = (/ & + &2.2529e+00_r8,1.9745e+00_r8,1.7078e+00_r8,1.4395e+00_r8,1.1743e+00_r8,9.0668e-01_r8, & + &6.3142e-01_r8,3.4477e-01_r8,2.9771e-02_r8/) + kao(:, 4,11, 8) = (/ & + &2.9660e+00_r8,2.6012e+00_r8,2.2499e+00_r8,1.8975e+00_r8,1.5469e+00_r8,1.1941e+00_r8, & + &8.2956e-01_r8,4.5247e-01_r8,3.5340e-02_r8/) + kao(:, 5,11, 8) = (/ & + &3.8252e+00_r8,3.3560e+00_r8,2.9025e+00_r8,2.4493e+00_r8,1.9962e+00_r8,1.5364e+00_r8, & + &1.0662e+00_r8,5.8207e-01_r8,4.0740e-02_r8/) + kao(:, 1,12, 8) = (/ & + &1.3334e+00_r8,1.1683e+00_r8,1.0080e+00_r8,8.4695e-01_r8,6.8881e-01_r8,5.3043e-01_r8, & + &3.6715e-01_r8,1.9749e-01_r8,1.8810e-02_r8/) + kao(:, 2,12, 8) = (/ & + &1.8510e+00_r8,1.6221e+00_r8,1.4015e+00_r8,1.1795e+00_r8,9.6045e-01_r8,7.4002e-01_r8, & + &5.1281e-01_r8,2.7717e-01_r8,2.2865e-02_r8/) + kao(:, 3,12, 8) = (/ & + &2.5252e+00_r8,2.2140e+00_r8,1.9140e+00_r8,1.6128e+00_r8,1.3137e+00_r8,1.0115e+00_r8, & + &6.9957e-01_r8,3.7776e-01_r8,2.7421e-02_r8/) + kao(:, 4,12, 8) = (/ & + &3.3724e+00_r8,2.9581e+00_r8,2.5564e+00_r8,2.1530e+00_r8,1.7520e+00_r8,1.3471e+00_r8, & + &9.2947e-01_r8,5.0112e-01_r8,3.2393e-02_r8/) + kao(:, 5,12, 8) = (/ & + &4.3792e+00_r8,3.8422e+00_r8,3.3210e+00_r8,2.7983e+00_r8,2.2755e+00_r8,1.7461e+00_r8, & + &1.2059e+00_r8,6.4752e-01_r8,3.7070e-02_r8/) + kao(:, 1,13, 8) = (/ & + &1.2116e+00_r8,1.0627e+00_r8,9.1758e-01_r8,7.7277e-01_r8,6.2996e-01_r8,4.8487e-01_r8, & + &3.3536e-01_r8,1.7964e-01_r8,1.5468e-02_r8/) + kao(:, 2,13, 8) = (/ & + &1.6818e+00_r8,1.4755e+00_r8,1.2746e+00_r8,1.0748e+00_r8,8.7634e-01_r8,6.7377e-01_r8, & + &4.6518e-01_r8,2.4901e-01_r8,1.8709e-02_r8/) + kao(:, 3,13, 8) = (/ & + &2.2861e+00_r8,2.0071e+00_r8,1.7358e+00_r8,1.4644e+00_r8,1.1940e+00_r8,9.1837e-01_r8, & + &6.3513e-01_r8,3.4226e-01_r8,2.2464e-02_r8/) + kao(:, 4,13, 8) = (/ & + &3.0747e+00_r8,2.7003e+00_r8,2.3365e+00_r8,1.9712e+00_r8,1.6050e+00_r8,1.2324e+00_r8, & + &8.5082e-01_r8,4.5761e-01_r8,2.6279e-02_r8/) + kao(:, 5,13, 8) = (/ & + &4.0462e+00_r8,3.5547e+00_r8,3.0752e+00_r8,2.5948e+00_r8,2.1107e+00_r8,1.6188e+00_r8, & + &1.1159e+00_r8,5.9825e-01_r8,3.0261e-02_r8/) + kao(:, 1, 1, 9) = (/ & + &7.9433e-03_r8,4.9696e-02_r8,8.9399e-02_r8,1.2891e-01_r8,1.7031e-01_r8,2.1327e-01_r8, & + &2.5635e-01_r8,2.9834e-01_r8,3.4005e-01_r8/) + kao(:, 2, 1, 9) = (/ & + &9.5773e-03_r8,6.0610e-02_r8,1.0882e-01_r8,1.5730e-01_r8,2.0827e-01_r8,2.6089e-01_r8, & + &3.1374e-01_r8,3.6559e-01_r8,4.1584e-01_r8/) + kao(:, 3, 1, 9) = (/ & + &1.1355e-02_r8,7.2723e-02_r8,1.3048e-01_r8,1.8917e-01_r8,2.5096e-01_r8,3.1435e-01_r8, & + &3.7828e-01_r8,4.4211e-01_r8,5.0107e-01_r8/) + kao(:, 4, 1, 9) = (/ & + &1.3277e-02_r8,8.6204e-02_r8,1.5483e-01_r8,2.2520e-01_r8,2.9933e-01_r8,3.7480e-01_r8, & + &4.5117e-01_r8,5.2865e-01_r8,5.9762e-01_r8/) + kao(:, 5, 1, 9) = (/ & + &1.5326e-02_r8,1.0116e-01_r8,1.8188e-01_r8,2.6559e-01_r8,3.5380e-01_r8,4.4327e-01_r8, & + &5.3402e-01_r8,6.2664e-01_r8,7.0640e-01_r8/) + kao(:, 1, 2, 9) = (/ & + &1.1776e-02_r8,4.7878e-02_r8,8.4972e-02_r8,1.1878e-01_r8,1.5366e-01_r8,1.9061e-01_r8, & + &2.3033e-01_r8,2.7211e-01_r8,3.0314e-01_r8/) + kao(:, 2, 2, 9) = (/ & + &1.4294e-02_r8,5.8956e-02_r8,1.0416e-01_r8,1.4559e-01_r8,1.8871e-01_r8,2.3457e-01_r8, & + &2.8358e-01_r8,3.3549e-01_r8,3.7290e-01_r8/) + kao(:, 3, 2, 9) = (/ & + &1.7066e-02_r8,7.1345e-02_r8,1.2565e-01_r8,1.7589e-01_r8,2.2857e-01_r8,2.8471e-01_r8, & + &3.4402e-01_r8,4.0658e-01_r8,4.5272e-01_r8/) + kao(:, 4, 2, 9) = (/ & + &2.0089e-02_r8,8.5201e-02_r8,1.4972e-01_r8,2.1022e-01_r8,2.7384e-01_r8,3.4170e-01_r8, & + &4.1272e-01_r8,4.8704e-01_r8,5.4350e-01_r8/) + kao(:, 5, 2, 9) = (/ & + &2.3307e-02_r8,1.0059e-01_r8,1.7602e-01_r8,2.4834e-01_r8,3.2442e-01_r8,4.0570e-01_r8, & + &4.8998e-01_r8,5.7844e-01_r8,6.4523e-01_r8/) + kao(:, 1, 3, 9) = (/ & + &2.2348e-02_r8,5.0240e-02_r8,8.0496e-02_r8,1.1072e-01_r8,1.3814e-01_r8,1.6488e-01_r8, & + &1.9401e-01_r8,2.2881e-01_r8,2.5470e-01_r8/) + kao(:, 2, 3, 9) = (/ & + &2.7442e-02_r8,6.2748e-02_r8,1.0008e-01_r8,1.3702e-01_r8,1.7047e-01_r8,2.0379e-01_r8, & + &2.4015e-01_r8,2.8371e-01_r8,3.1563e-01_r8/) + kao(:, 3, 3, 9) = (/ & + &3.3066e-02_r8,7.6711e-02_r8,1.2229e-01_r8,1.6700e-01_r8,2.0740e-01_r8,2.4849e-01_r8, & + &2.9339e-01_r8,3.4685e-01_r8,3.8604e-01_r8/) + kao(:, 4, 3, 9) = (/ & + &3.9269e-02_r8,9.2366e-02_r8,1.4749e-01_r8,2.0103e-01_r8,2.4924e-01_r8,2.9944e-01_r8, & + &3.5443e-01_r8,4.1958e-01_r8,4.6663e-01_r8/) + kao(:, 5, 3, 9) = (/ & + &4.5933e-02_r8,1.0972e-01_r8,1.7562e-01_r8,2.3869e-01_r8,2.9592e-01_r8,3.5671e-01_r8, & + &4.2354e-01_r8,5.0205e-01_r8,5.5762e-01_r8/) + kao(:, 1, 4, 9) = (/ & + &4.2106e-02_r8,6.4369e-02_r8,8.4555e-02_r8,1.0542e-01_r8,1.2690e-01_r8,1.4750e-01_r8, & + &1.6487e-01_r8,1.8576e-01_r8,2.0651e-01_r8/) + kao(:, 2, 4, 9) = (/ & + &5.2576e-02_r8,8.1026e-02_r8,1.0683e-01_r8,1.3280e-01_r8,1.5950e-01_r8,1.8491e-01_r8, & + &2.0655e-01_r8,2.3307e-01_r8,2.5966e-01_r8/) + kao(:, 3, 4, 9) = (/ & + &6.4079e-02_r8,9.9622e-02_r8,1.3194e-01_r8,1.6392e-01_r8,1.9672e-01_r8,2.2769e-01_r8, & + &2.5451e-01_r8,2.8781e-01_r8,3.2142e-01_r8/) + kao(:, 4, 4, 9) = (/ & + &7.6781e-02_r8,1.2036e-01_r8,1.6040e-01_r8,1.9955e-01_r8,2.3909e-01_r8,2.7584e-01_r8, & + &3.0872e-01_r8,3.5017e-01_r8,3.9149e-01_r8/) + kao(:, 5, 4, 9) = (/ & + &9.0605e-02_r8,1.4314e-01_r8,1.9223e-01_r8,2.3943e-01_r8,2.8645e-01_r8,3.2911e-01_r8, & + &3.6945e-01_r8,4.2071e-01_r8,4.7061e-01_r8/) + kao(:, 1, 5, 9) = (/ & + &7.1850e-02_r8,8.9617e-02_r8,1.0358e-01_r8,1.1417e-01_r8,1.2410e-01_r8,1.3445e-01_r8, & + &1.4500e-01_r8,1.5289e-01_r8,1.6393e-01_r8/) + kao(:, 2, 5, 9) = (/ & + &9.1160e-02_r8,1.1411e-01_r8,1.3218e-01_r8,1.4610e-01_r8,1.5890e-01_r8,1.7194e-01_r8, & + &1.8487e-01_r8,1.9440e-01_r8,2.0899e-01_r8/) + kao(:, 3, 5, 9) = (/ & + &1.1266e-01_r8,1.4163e-01_r8,1.6452e-01_r8,1.8216e-01_r8,1.9856e-01_r8,2.1504e-01_r8, & + &2.3093e-01_r8,2.4255e-01_r8,2.6179e-01_r8/) + kao(:, 4, 5, 9) = (/ & + &1.3642e-01_r8,1.7249e-01_r8,2.0078e-01_r8,2.2297e-01_r8,2.4396e-01_r8,2.6433e-01_r8, & + &2.8347e-01_r8,2.9753e-01_r8,3.2213e-01_r8/) + kao(:, 5, 5, 9) = (/ & + &1.6239e-01_r8,2.0660e-01_r8,2.4114e-01_r8,2.6894e-01_r8,2.9484e-01_r8,3.1958e-01_r8, & + &3.4207e-01_r8,3.5958e-01_r8,3.9095e-01_r8/) + kao(:, 1, 6, 9) = (/ & + &1.1140e-01_r8,1.2144e-01_r8,1.3218e-01_r8,1.3718e-01_r8,1.3653e-01_r8,1.3402e-01_r8, & + &1.3174e-01_r8,1.2946e-01_r8,1.2677e-01_r8/) + kao(:, 2, 6, 9) = (/ & + &1.4420e-01_r8,1.5827e-01_r8,1.7119e-01_r8,1.7776e-01_r8,1.7742e-01_r8,1.7454e-01_r8, & + &1.7134e-01_r8,1.6760e-01_r8,1.6399e-01_r8/) + kao(:, 3, 6, 9) = (/ & + &1.8124e-01_r8,2.0002e-01_r8,2.1589e-01_r8,2.2389e-01_r8,2.2423e-01_r8,2.2127e-01_r8, & + &2.1711e-01_r8,2.1204e-01_r8,2.0793e-01_r8/) + kao(:, 4, 6, 9) = (/ & + &2.2248e-01_r8,2.4636e-01_r8,2.6609e-01_r8,2.7594e-01_r8,2.7715e-01_r8,2.7479e-01_r8, & + &2.7017e-01_r8,2.6283e-01_r8,2.5856e-01_r8/) + kao(:, 5, 6, 9) = (/ & + &2.6774e-01_r8,2.9748e-01_r8,3.2183e-01_r8,3.3450e-01_r8,3.3675e-01_r8,3.3499e-01_r8, & + &3.3006e-01_r8,3.2020e-01_r8,3.1680e-01_r8/) + kao(:, 1, 7, 9) = (/ & + &1.7732e-01_r8,1.7534e-01_r8,1.7803e-01_r8,1.7714e-01_r8,1.7022e-01_r8,1.5702e-01_r8, & + &1.3821e-01_r8,1.1726e-01_r8,9.2624e-02_r8/) + kao(:, 2, 7, 9) = (/ & + &2.3477e-01_r8,2.3316e-01_r8,2.3664e-01_r8,2.3403e-01_r8,2.2497e-01_r8,2.0771e-01_r8, & + &1.8285e-01_r8,1.5521e-01_r8,1.2312e-01_r8/) + kao(:, 3, 7, 9) = (/ & + &3.0054e-01_r8,2.9947e-01_r8,3.0371e-01_r8,2.9989e-01_r8,2.8797e-01_r8,2.6596e-01_r8, & + &2.3476e-01_r8,1.9945e-01_r8,1.5929e-01_r8/) + kao(:, 4, 7, 9) = (/ & + &3.7459e-01_r8,3.7495e-01_r8,3.7937e-01_r8,3.7465e-01_r8,3.5915e-01_r8,3.3235e-01_r8, & + &2.9471e-01_r8,2.5108e-01_r8,2.0370e-01_r8/) + kao(:, 5, 7, 9) = (/ & + &4.5653e-01_r8,4.5857e-01_r8,4.6346e-01_r8,4.5781e-01_r8,4.3887e-01_r8,4.0748e-01_r8, & + &3.6268e-01_r8,3.0976e-01_r8,2.5195e-01_r8/) + kao(:, 1, 8, 9) = (/ & + &3.3219e-01_r8,3.0467e-01_r8,2.8618e-01_r8,2.6721e-01_r8,2.4601e-01_r8,2.1811e-01_r8, & + &1.8145e-01_r8,1.3269e-01_r8,6.6401e-02_r8/) + kao(:, 2, 8, 9) = (/ & + &4.4950e-01_r8,4.1374e-01_r8,3.8999e-01_r8,3.6461e-01_r8,3.3388e-01_r8,2.9490e-01_r8, & + &2.4508e-01_r8,1.7935e-01_r8,9.0026e-02_r8/) + kao(:, 3, 8, 9) = (/ & + &5.8717e-01_r8,5.4166e-01_r8,5.1100e-01_r8,4.7736e-01_r8,4.3579e-01_r8,3.8461e-01_r8, & + &3.1925e-01_r8,2.3358e-01_r8,1.1833e-01_r8/) + kao(:, 4, 8, 9) = (/ & + &7.4406e-01_r8,6.8778e-01_r8,6.4996e-01_r8,6.0622e-01_r8,5.5241e-01_r8,4.8728e-01_r8, & + &4.0419e-01_r8,2.9657e-01_r8,1.5189e-01_r8/) + kao(:, 5, 8, 9) = (/ & + &9.1907e-01_r8,8.5125e-01_r8,8.0569e-01_r8,7.5012e-01_r8,6.8369e-01_r8,6.0185e-01_r8, & + &4.9995e-01_r8,3.6832e-01_r8,1.9101e-01_r8/) + kao(:, 1, 9, 9) = (/ & + &1.1485e+00_r8,1.0089e+00_r8,8.7880e-01_r8,7.5762e-01_r8,6.3622e-01_r8,5.1377e-01_r8, & + &3.9068e-01_r8,2.5323e-01_r8,5.4057e-02_r8/) + kao(:, 2, 9, 9) = (/ & + &1.5919e+00_r8,1.3983e+00_r8,1.2193e+00_r8,1.0539e+00_r8,8.8759e-01_r8,7.1827e-01_r8, & + &5.4603e-01_r8,3.5236e-01_r8,7.3567e-02_r8/) + kao(:, 3, 9, 9) = (/ & + &2.1202e+00_r8,1.8629e+00_r8,1.6282e+00_r8,1.4084e+00_r8,1.1875e+00_r8,9.6283e-01_r8, & + &7.2992e-01_r8,4.6911e-01_r8,9.7269e-02_r8/) + kao(:, 4, 9, 9) = (/ & + &2.7354e+00_r8,2.4050e+00_r8,2.1038e+00_r8,1.8214e+00_r8,1.5366e+00_r8,1.2471e+00_r8, & + &9.4177e-01_r8,6.0391e-01_r8,1.2338e-01_r8/) + kao(:, 5, 9, 9) = (/ & + &3.4317e+00_r8,3.0176e+00_r8,2.6421e+00_r8,2.2877e+00_r8,1.9310e+00_r8,1.5677e+00_r8, & + &1.1814e+00_r8,7.5635e-01_r8,1.5353e-01_r8/) + kao(:, 1,10, 9) = (/ & + &4.4436e+00_r8,3.8882e+00_r8,3.3348e+00_r8,2.7888e+00_r8,2.2477e+00_r8,1.7134e+00_r8, & + &1.1871e+00_r8,6.5782e-01_r8,7.0663e-02_r8/) + kao(:, 2,10, 9) = (/ & + &6.2997e+00_r8,5.5124e+00_r8,4.7288e+00_r8,3.9559e+00_r8,3.1897e+00_r8,2.4334e+00_r8, & + &1.6915e+00_r8,9.3954e-01_r8,8.7418e-02_r8/) + kao(:, 3,10, 9) = (/ & + &8.5619e+00_r8,7.4925e+00_r8,6.4279e+00_r8,5.3771e+00_r8,4.3365e+00_r8,3.3136e+00_r8, & + &2.3060e+00_r8,1.2843e+00_r8,1.0436e-01_r8/) + kao(:, 4,10, 9) = (/ & + &1.1219e+01_r8,9.8180e+00_r8,8.4228e+00_r8,7.0486e+00_r8,5.6898e+00_r8,4.3532e+00_r8, & + &3.0319e+00_r8,1.6916e+00_r8,1.2593e-01_r8/) + kao(:, 5,10, 9) = (/ & + &1.4295e+01_r8,1.2510e+01_r8,1.0734e+01_r8,8.9819e+00_r8,7.2530e+00_r8,5.5514e+00_r8, & + &3.8643e+00_r8,2.1564e+00_r8,1.5004e-01_r8/) + kao(:, 1,11, 9) = (/ & + &7.0050e+00_r8,6.1296e+00_r8,5.2549e+00_r8,4.3868e+00_r8,3.5242e+00_r8,2.6669e+00_r8, & + &1.8245e+00_r8,9.8168e-01_r8,8.5745e-02_r8/) + kao(:, 2,11, 9) = (/ & + &9.9554e+00_r8,8.7114e+00_r8,7.4687e+00_r8,6.2351e+00_r8,5.0098e+00_r8,3.7942e+00_r8, & + &2.5980e+00_r8,1.4001e+00_r8,1.0478e-01_r8/) + kao(:, 3,11, 9) = (/ & + &1.3533e+01_r8,1.1842e+01_r8,1.0152e+01_r8,8.4771e+00_r8,6.8123e+00_r8,5.1640e+00_r8, & + &3.5405e+00_r8,1.9111e+00_r8,1.2573e-01_r8/) + kao(:, 4,11, 9) = (/ & + &1.7771e+01_r8,1.5551e+01_r8,1.3333e+01_r8,1.1134e+01_r8,8.9512e+00_r8,6.7876e+00_r8, & + &4.6577e+00_r8,2.5172e+00_r8,1.4855e-01_r8/) + kao(:, 5,11, 9) = (/ & + &2.2680e+01_r8,1.9846e+01_r8,1.7019e+01_r8,1.4214e+01_r8,1.1430e+01_r8,8.6745e+00_r8, & + &5.9538e+00_r8,3.2175e+00_r8,1.7203e-01_r8/) + kao(:, 1,12, 9) = (/ & + &8.1047e+00_r8,7.0920e+00_r8,6.0802e+00_r8,5.0761e+00_r8,4.0767e+00_r8,3.0841e+00_r8, & + &2.1058e+00_r8,1.1266e+00_r8,9.0852e-02_r8/) + kao(:, 2,12, 9) = (/ & + &1.1567e+01_r8,1.0121e+01_r8,8.6775e+00_r8,7.2441e+00_r8,5.8181e+00_r8,4.4027e+00_r8, & + &3.0080e+00_r8,1.6091e+00_r8,1.1081e-01_r8/) + kao(:, 3,12, 9) = (/ & + &1.5756e+01_r8,1.3787e+01_r8,1.1820e+01_r8,9.8684e+00_r8,7.9263e+00_r8,6.0014e+00_r8, & + &4.1030e+00_r8,2.1969e+00_r8,1.3256e-01_r8/) + kao(:, 4,12, 9) = (/ & + &2.0731e+01_r8,1.8141e+01_r8,1.5554e+01_r8,1.2989e+01_r8,1.0436e+01_r8,7.9047e+00_r8, & + &5.4071e+00_r8,2.8962e+00_r8,1.5690e-01_r8/) + kao(:, 5,12, 9) = (/ & + &2.6483e+01_r8,2.3176e+01_r8,1.9872e+01_r8,1.6594e+01_r8,1.3339e+01_r8,1.0111e+01_r8, & + &6.9150e+00_r8,3.7095e+00_r8,1.8186e-01_r8/) + kao(:, 1,13, 9) = (/ & + &7.4699e+00_r8,6.5364e+00_r8,5.6062e+00_r8,4.6835e+00_r8,3.7650e+00_r8,2.8555e+00_r8, & + &1.9560e+00_r8,1.0515e+00_r8,8.5273e-02_r8/) + kao(:, 2,13, 9) = (/ & + &1.0680e+01_r8,9.3454e+00_r8,8.0165e+00_r8,6.6976e+00_r8,5.3854e+00_r8,4.0877e+00_r8, & + &2.8036e+00_r8,1.5078e+00_r8,1.0411e-01_r8/) + kao(:, 3,13, 9) = (/ & + &1.4620e+01_r8,1.2793e+01_r8,1.0973e+01_r8,9.1678e+00_r8,7.3735e+00_r8,5.5972e+00_r8, & + &3.8382e+00_r8,2.0618e+00_r8,1.2386e-01_r8/) + kao(:, 4,13, 9) = (/ & + &1.9258e+01_r8,1.6852e+01_r8,1.4455e+01_r8,1.2079e+01_r8,9.7197e+00_r8,7.3817e+00_r8, & + &5.0639e+00_r8,2.7225e+00_r8,1.4610e-01_r8/) + kao(:, 5,13, 9) = (/ & + &2.4621e+01_r8,2.1546e+01_r8,1.8485e+01_r8,1.5448e+01_r8,1.2432e+01_r8,9.4454e+00_r8, & + &6.4771e+00_r8,3.4853e+00_r8,1.7007e-01_r8/) + kao(:, 1, 1,10) = (/ & + &1.3879e-02_r8,1.0986e-01_r8,1.9192e-01_r8,2.8700e-01_r8,3.8129e-01_r8,4.7527e-01_r8, & + &5.7067e-01_r8,6.6779e-01_r8,7.6243e-01_r8/) + kao(:, 2, 1,10) = (/ & + &1.6954e-02_r8,1.3303e-01_r8,2.3564e-01_r8,3.5200e-01_r8,4.6702e-01_r8,5.8054e-01_r8, & + &6.9523e-01_r8,8.1372e-01_r8,9.3367e-01_r8/) + kao(:, 3, 1,10) = (/ & + &2.0369e-02_r8,1.5906e-01_r8,2.8523e-01_r8,4.2640e-01_r8,5.6627e-01_r8,7.0405e-01_r8, & + &8.3748e-01_r8,9.6604e-01_r8,1.1321e+00_r8/) + kao(:, 4, 1,10) = (/ & + &2.4061e-02_r8,1.8742e-01_r8,3.4065e-01_r8,5.0987e-01_r8,6.7810e-01_r8,8.4492e-01_r8, & + &1.0078e+00_r8,1.1403e+00_r8,1.3558e+00_r8/) + kao(:, 5, 1,10) = (/ & + &2.7911e-02_r8,2.1680e-01_r8,4.0347e-01_r8,6.0365e-01_r8,8.0163e-01_r8,9.9663e-01_r8, & + &1.1842e+00_r8,1.3430e+00_r8,1.6028e+00_r8/) + kao(:, 1, 2,10) = (/ & + &2.2158e-02_r8,1.1276e-01_r8,1.8891e-01_r8,2.7518e-01_r8,3.6524e-01_r8,4.5317e-01_r8, & + &5.3652e-01_r8,6.1296e-01_r8,7.3020e-01_r8/) + kao(:, 2, 2,10) = (/ & + &2.7256e-02_r8,1.3808e-01_r8,2.3100e-01_r8,3.4051e-01_r8,4.5180e-01_r8,5.6015e-01_r8, & + &6.6160e-01_r8,7.4973e-01_r8,9.0314e-01_r8/) + kao(:, 3, 2,10) = (/ & + &3.2742e-02_r8,1.6645e-01_r8,2.7575e-01_r8,4.1007e-01_r8,5.4427e-01_r8,6.7555e-01_r8, & + &8.0050e-01_r8,9.1019e-01_r8,1.0879e+00_r8/) + kao(:, 4, 2,10) = (/ & + &3.8593e-02_r8,1.9807e-01_r8,3.2475e-01_r8,4.8552e-01_r8,6.4531e-01_r8,8.0341e-01_r8, & + &9.5786e-01_r8,1.0994e+00_r8,1.2898e+00_r8/) + kao(:, 5, 2,10) = (/ & + &4.4713e-02_r8,2.3139e-01_r8,3.8401e-01_r8,5.7431e-01_r8,7.6329e-01_r8,9.5026e-01_r8, & + &1.1317e+00_r8,1.3007e+00_r8,1.5256e+00_r8/) + kao(:, 1, 3,10) = (/ & + &4.4889e-02_r8,1.1945e-01_r8,1.9910e-01_r8,2.6592e-01_r8,3.2716e-01_r8,4.0820e-01_r8, & + &4.8832e-01_r8,5.6450e-01_r8,6.5333e-01_r8/) + kao(:, 2, 3,10) = (/ & + &5.6096e-02_r8,1.4847e-01_r8,2.4845e-01_r8,3.3071e-01_r8,4.1171e-01_r8,5.1418e-01_r8, & + &6.1578e-01_r8,7.1081e-01_r8,8.2224e-01_r8/) + kao(:, 3, 3,10) = (/ & + &6.8702e-02_r8,1.8161e-01_r8,3.0124e-01_r8,3.9617e-01_r8,5.0089e-01_r8,6.2554e-01_r8, & + &7.4933e-01_r8,8.6662e-01_r8,1.0003e+00_r8/) + kao(:, 4, 3,10) = (/ & + &8.1949e-02_r8,2.1813e-01_r8,3.5788e-01_r8,4.6675e-01_r8,6.0112e-01_r8,7.4982e-01_r8, & + &8.9722e-01_r8,1.0369e+00_r8,1.1996e+00_r8/) + kao(:, 5, 3,10) = (/ & + &9.5752e-02_r8,2.5792e-01_r8,4.1860e-01_r8,5.4742e-01_r8,7.1669e-01_r8,8.9255e-01_r8, & + &1.0648e+00_r8,1.2234e+00_r8,1.4293e+00_r8/) + kao(:, 1, 4,10) = (/ & + &9.2779e-02_r8,1.3647e-01_r8,2.0374e-01_r8,2.6880e-01_r8,3.2474e-01_r8,3.6630e-01_r8, & + &4.2915e-01_r8,4.9644e-01_r8,5.7357e-01_r8/) + kao(:, 2, 4,10) = (/ & + &1.1604e-01_r8,1.7477e-01_r8,2.5924e-01_r8,3.4288e-01_r8,4.1143e-01_r8,4.5661e-01_r8, & + &5.3933e-01_r8,6.2792e-01_r8,7.1853e-01_r8/) + kao(:, 3, 4,10) = (/ & + &1.4325e-01_r8,2.1810e-01_r8,3.2204e-01_r8,4.2345e-01_r8,5.0270e-01_r8,5.5390e-01_r8, & + &6.5839e-01_r8,7.6862e-01_r8,8.7526e-01_r8/) + kao(:, 4, 4,10) = (/ & + &1.7320e-01_r8,2.6694e-01_r8,3.8938e-01_r8,5.0945e-01_r8,6.0406e-01_r8,6.6936e-01_r8, & + &8.0058e-01_r8,9.3405e-01_r8,1.0639e+00_r8/) + kao(:, 5, 4,10) = (/ & + &2.0528e-01_r8,3.2153e-01_r8,4.6268e-01_r8,6.0392e-01_r8,7.1636e-01_r8,8.0678e-01_r8, & + &9.6596e-01_r8,1.1248e+00_r8,1.2848e+00_r8/) + kao(:, 1, 5,10) = (/ & + &1.7241e-01_r8,1.8815e-01_r8,2.2088e-01_r8,2.6810e-01_r8,3.2220e-01_r8,3.6810e-01_r8, & + &3.9585e-01_r8,4.3476e-01_r8,4.9559e-01_r8/) + kao(:, 2, 5,10) = (/ & + &2.1928e-01_r8,2.4297e-01_r8,2.8762e-01_r8,3.4907e-01_r8,4.1506e-01_r8,4.6919e-01_r8, & + &4.9756e-01_r8,5.5222e-01_r8,6.2884e-01_r8/) + kao(:, 3, 5,10) = (/ & + &2.7265e-01_r8,3.0607e-01_r8,3.6483e-01_r8,4.4370e-01_r8,5.1761e-01_r8,5.7690e-01_r8, & + &6.0530e-01_r8,6.7866e-01_r8,7.7290e-01_r8/) + kao(:, 4, 5,10) = (/ & + &3.3288e-01_r8,3.7610e-01_r8,4.5166e-01_r8,5.4662e-01_r8,6.2951e-01_r8,6.9865e-01_r8, & + &7.2973e-01_r8,8.2842e-01_r8,9.4575e-01_r8/) + kao(:, 5, 5,10) = (/ & + &3.9915e-01_r8,4.5195e-01_r8,5.4707e-01_r8,6.6103e-01_r8,7.5773e-01_r8,8.3891e-01_r8, & + &8.7097e-01_r8,1.0005e+00_r8,1.1404e+00_r8/) + kao(:, 1, 6,10) = (/ & + &2.9778e-01_r8,2.8967e-01_r8,2.9242e-01_r8,2.9076e-01_r8,3.1606e-01_r8,3.5216e-01_r8, & + &3.7514e-01_r8,3.6360e-01_r8,4.0286e-01_r8/) + kao(:, 2, 6,10) = (/ & + &3.8364e-01_r8,3.7347e-01_r8,3.8384e-01_r8,3.8402e-01_r8,4.1811e-01_r8,4.6141e-01_r8, & + &4.8908e-01_r8,4.6937e-01_r8,5.2349e-01_r8/) + kao(:, 3, 6,10) = (/ & + &4.8196e-01_r8,4.7366e-01_r8,4.8805e-01_r8,4.9747e-01_r8,5.3761e-01_r8,5.8138e-01_r8, & + &6.1239e-01_r8,5.8662e-01_r8,6.5890e-01_r8/) + kao(:, 4, 6,10) = (/ & + &5.9004e-01_r8,5.9246e-01_r8,6.0698e-01_r8,6.2535e-01_r8,6.7125e-01_r8,7.1432e-01_r8, & + &7.4926e-01_r8,7.2627e-01_r8,8.2202e-01_r8/) + kao(:, 5, 6,10) = (/ & + &7.1225e-01_r8,7.2336e-01_r8,7.3969e-01_r8,7.6299e-01_r8,8.2248e-01_r8,8.6951e-01_r8, & + &9.0679e-01_r8,8.7991e-01_r8,1.0003e+00_r8/) + kao(:, 1, 7,10) = (/ & + &5.2983e-01_r8,4.8709e-01_r8,4.4813e-01_r8,4.1883e-01_r8,3.8710e-01_r8,3.5910e-01_r8, & + &3.5198e-01_r8,3.4364e-01_r8,3.2708e-01_r8/) + kao(:, 2, 7,10) = (/ & + &6.9820e-01_r8,6.4182e-01_r8,5.9773e-01_r8,5.6199e-01_r8,5.1585e-01_r8,4.8198e-01_r8, & + &4.7538e-01_r8,4.5593e-01_r8,4.2838e-01_r8/) + kao(:, 3, 7,10) = (/ & + &8.9166e-01_r8,8.2011e-01_r8,7.7520e-01_r8,7.2195e-01_r8,6.6977e-01_r8,6.2908e-01_r8, & + &6.1720e-01_r8,5.8358e-01_r8,5.4876e-01_r8/) + kao(:, 4, 7,10) = (/ & + &1.1048e+00_r8,1.0150e+00_r8,9.7493e-01_r8,9.0555e-01_r8,8.5261e-01_r8,7.9496e-01_r8, & + &7.7495e-01_r8,7.2954e-01_r8,6.9328e-01_r8/) + kao(:, 5, 7,10) = (/ & + &1.3386e+00_r8,1.2295e+00_r8,1.1950e+00_r8,1.1151e+00_r8,1.0543e+00_r8,9.8064e-01_r8, & + &9.5591e-01_r8,8.9484e-01_r8,8.5404e-01_r8/) + kao(:, 1, 8,10) = (/ & + &1.0881e+00_r8,9.5225e-01_r8,8.5699e-01_r8,7.4043e-01_r8,6.3719e-01_r8,5.4699e-01_r8, & + &4.4366e-01_r8,3.3722e-01_r8,2.5365e-01_r8/) + kao(:, 2, 8,10) = (/ & + &1.4729e+00_r8,1.2892e+00_r8,1.1603e+00_r8,1.0057e+00_r8,8.7735e-01_r8,7.4624e-01_r8, & + &6.0685e-01_r8,4.5839e-01_r8,3.4968e-01_r8/) + kao(:, 3, 8,10) = (/ & + &1.9193e+00_r8,1.6816e+00_r8,1.5156e+00_r8,1.3265e+00_r8,1.1534e+00_r8,9.7741e-01_r8, & + &7.9951e-01_r8,6.0809e-01_r8,4.5275e-01_r8/) + kao(:, 4, 8,10) = (/ & + &2.4196e+00_r8,2.1220e+00_r8,1.9097e+00_r8,1.6942e+00_r8,1.4693e+00_r8,1.2439e+00_r8, & + &1.0194e+00_r8,7.8139e-01_r8,5.7536e-01_r8/) + kao(:, 5, 8,10) = (/ & + &2.9662e+00_r8,2.6064e+00_r8,2.3390e+00_r8,2.0966e+00_r8,1.8122e+00_r8,1.5517e+00_r8, & + &1.2698e+00_r8,9.8175e-01_r8,7.1420e-01_r8/) + kao(:, 1, 9,10) = (/ & + &4.0693e+00_r8,3.5609e+00_r8,3.0521e+00_r8,2.5470e+00_r8,2.0946e+00_r8,1.6231e+00_r8, & + &1.1342e+00_r8,6.9341e-01_r8,2.3254e-01_r8/) + kao(:, 2, 9,10) = (/ & + &5.6525e+00_r8,4.9459e+00_r8,4.2396e+00_r8,3.5367e+00_r8,2.9143e+00_r8,2.2533e+00_r8, & + &1.5867e+00_r8,9.6567e-01_r8,2.9706e-01_r8/) + kao(:, 3, 9,10) = (/ & + &7.5336e+00_r8,6.5921e+00_r8,5.6502e+00_r8,4.7197e+00_r8,3.8915e+00_r8,3.0030e+00_r8, & + &2.1420e+00_r8,1.2862e+00_r8,3.6402e-01_r8/) + kao(:, 4, 9,10) = (/ & + &9.6696e+00_r8,8.4608e+00_r8,7.2526e+00_r8,6.0675e+00_r8,4.9886e+00_r8,3.8558e+00_r8, & + &2.7779e+00_r8,1.6618e+00_r8,4.0961e-01_r8/) + kao(:, 5, 9,10) = (/ & + &1.2059e+01_r8,1.0552e+01_r8,9.0447e+00_r8,7.5858e+00_r8,6.2136e+00_r8,4.8233e+00_r8, & + &3.4799e+00_r8,2.0915e+00_r8,3.7531e-01_r8/) + kao(:, 1,10,10) = (/ & + &1.7088e+01_r8,1.4952e+01_r8,1.2816e+01_r8,1.0681e+01_r8,8.5444e+00_r8,6.4081e+00_r8, & + &4.3169e+00_r8,2.2612e+00_r8,1.5325e-01_r8/) + kao(:, 2,10,10) = (/ & + &2.4265e+01_r8,2.1232e+01_r8,1.8199e+01_r8,1.5167e+01_r8,1.2132e+01_r8,9.0996e+00_r8, & + &6.1194e+00_r8,3.2115e+00_r8,2.0907e-01_r8/) + kao(:, 3,10,10) = (/ & + &3.2859e+01_r8,2.8752e+01_r8,2.4646e+01_r8,2.0537e+01_r8,1.6430e+01_r8,1.2323e+01_r8, & + &8.2885e+00_r8,4.3528e+00_r8,2.8093e-01_r8/) + kao(:, 4,10,10) = (/ & + &4.2869e+01_r8,3.7512e+01_r8,3.2153e+01_r8,2.6795e+01_r8,2.1435e+01_r8,1.6077e+01_r8, & + &1.0833e+01_r8,5.6764e+00_r8,3.4638e-01_r8/) + kao(:, 5,10,10) = (/ & + &5.4098e+01_r8,4.7336e+01_r8,4.0575e+01_r8,3.3816e+01_r8,2.7052e+01_r8,2.0291e+01_r8, & + &1.3707e+01_r8,7.1952e+00_r8,4.8935e-01_r8/) + kao(:, 1,11,10) = (/ & + &2.9317e+01_r8,2.5652e+01_r8,2.1987e+01_r8,1.8324e+01_r8,1.4658e+01_r8,1.0994e+01_r8, & + &7.3313e+00_r8,3.7877e+00_r8,2.2554e-01_r8/) + kao(:, 2,11,10) = (/ & + &4.1549e+01_r8,3.6355e+01_r8,3.1162e+01_r8,2.5968e+01_r8,2.0775e+01_r8,1.5581e+01_r8, & + &1.0388e+01_r8,5.3868e+00_r8,2.3983e-01_r8/) + kao(:, 3,11,10) = (/ & + &5.6191e+01_r8,4.9168e+01_r8,4.2143e+01_r8,3.5117e+01_r8,2.8096e+01_r8,2.1071e+01_r8, & + &1.4052e+01_r8,7.2903e+00_r8,2.8347e-01_r8/) + kao(:, 4,11,10) = (/ & + &7.3162e+01_r8,6.4016e+01_r8,5.4871e+01_r8,4.5729e+01_r8,3.6583e+01_r8,2.7439e+01_r8, & + &1.8309e+01_r8,9.4965e+00_r8,3.4363e-01_r8/) + kao(:, 5,11,10) = (/ & + &9.2126e+01_r8,8.0611e+01_r8,6.9095e+01_r8,5.7582e+01_r8,4.6068e+01_r8,3.4554e+01_r8, & + &2.3073e+01_r8,1.1954e+01_r8,4.6470e-01_r8/) + kao(:, 1,12,10) = (/ & + &3.6684e+01_r8,3.2099e+01_r8,2.7514e+01_r8,2.2927e+01_r8,1.8342e+01_r8,1.3757e+01_r8, & + &9.1743e+00_r8,4.7217e+00_r8,2.6068e-01_r8/) + kao(:, 2,12,10) = (/ & + &5.1868e+01_r8,4.5387e+01_r8,3.8901e+01_r8,3.2419e+01_r8,2.5934e+01_r8,1.9452e+01_r8, & + &1.2967e+01_r8,6.6916e+00_r8,2.7916e-01_r8/) + kao(:, 3,12,10) = (/ & + &7.0081e+01_r8,6.1322e+01_r8,5.2561e+01_r8,4.3801e+01_r8,3.5043e+01_r8,2.6282e+01_r8, & + &1.7526e+01_r8,9.0530e+00_r8,3.3145e-01_r8/) + kao(:, 4,12,10) = (/ & + &9.0957e+01_r8,7.9591e+01_r8,6.8227e+01_r8,5.6859e+01_r8,4.5488e+01_r8,3.4114e+01_r8, & + &2.2760e+01_r8,1.1751e+01_r8,3.6053e-01_r8/) + kao(:, 5,12,10) = (/ & + &1.1478e+02_r8,1.0044e+02_r8,8.6086e+01_r8,7.1743e+01_r8,5.7394e+01_r8,4.3046e+01_r8, & + &2.8737e+01_r8,1.4814e+01_r8,4.5144e-01_r8/) + kao(:, 1,13,10) = (/ & + &3.5965e+01_r8,3.1472e+01_r8,2.6975e+01_r8,2.2479e+01_r8,1.7984e+01_r8,1.3488e+01_r8, & + &9.0232e+00_r8,4.6648e+00_r8,2.4705e-01_r8/) + kao(:, 2,13,10) = (/ & + &5.0800e+01_r8,4.4451e+01_r8,3.8101e+01_r8,3.1752e+01_r8,2.5403e+01_r8,1.9053e+01_r8, & + &1.2739e+01_r8,6.5982e+00_r8,2.8941e-01_r8/) + kao(:, 3,13,10) = (/ & + &6.8393e+01_r8,5.9846e+01_r8,5.1296e+01_r8,4.2746e+01_r8,3.4199e+01_r8,2.5650e+01_r8, & + &1.7151e+01_r8,8.8890e+00_r8,3.3776e-01_r8/) + kao(:, 4,13,10) = (/ & + &8.8957e+01_r8,7.7837e+01_r8,6.6721e+01_r8,5.5604e+01_r8,4.4485e+01_r8,3.3364e+01_r8, & + &2.2331e+01_r8,1.1554e+01_r8,3.9400e-01_r8/) + kao(:, 5,13,10) = (/ & + &1.1248e+02_r8,9.8422e+01_r8,8.4359e+01_r8,7.0296e+01_r8,5.6240e+01_r8,4.2182e+01_r8, & + &2.8274e+01_r8,1.4614e+01_r8,4.6294e-01_r8/) + kao(:, 1, 1,11) = (/ & + &2.0991e-02_r8,1.4510e-01_r8,2.7530e-01_r8,4.1253e-01_r8,5.4888e-01_r8,6.8317e-01_r8, & + &8.1040e-01_r8,9.0204e-01_r8,1.0977e+00_r8/) + kao(:, 2, 1,11) = (/ & + &2.6377e-02_r8,1.7420e-01_r8,3.3534e-01_r8,5.0284e-01_r8,6.6978e-01_r8,8.3508e-01_r8, & + &9.9362e-01_r8,1.1152e+00_r8,1.3395e+00_r8/) + kao(:, 3, 1,11) = (/ & + &3.2301e-02_r8,2.0470e-01_r8,4.0014e-01_r8,5.9936e-01_r8,7.9730e-01_r8,9.9294e-01_r8, & + &1.1840e+00_r8,1.3371e+00_r8,1.5943e+00_r8/) + kao(:, 4, 1,11) = (/ & + &3.8610e-02_r8,2.3990e-01_r8,4.7445e-01_r8,7.0939e-01_r8,9.4186e-01_r8,1.1687e+00_r8, & + &1.3842e+00_r8,1.5657e+00_r8,1.8832e+00_r8/) + kao(:, 5, 1,11) = (/ & + &4.5285e-02_r8,2.8044e-01_r8,5.5866e-01_r8,8.3454e-01_r8,1.1074e+00_r8,1.3742e+00_r8, & + &1.6243e+00_r8,1.8087e+00_r8,2.2141e+00_r8/) + kao(:, 1, 2,11) = (/ & + &3.0334e-02_r8,1.5806e-01_r8,2.5391e-01_r8,3.8056e-01_r8,5.0695e-01_r8,6.3318e-01_r8, & + &7.5908e-01_r8,8.7813e-01_r8,1.0138e+00_r8/) + kao(:, 2, 2,11) = (/ & + &3.8224e-02_r8,1.9234e-01_r8,3.1173e-01_r8,4.6706e-01_r8,6.2209e-01_r8,7.7707e-01_r8, & + &9.3334e-01_r8,1.0857e+00_r8,1.2438e+00_r8/) + kao(:, 3, 2,11) = (/ & + &4.7042e-02_r8,2.2793e-01_r8,3.7775e-01_r8,5.6573e-01_r8,7.5275e-01_r8,9.3856e-01_r8, & + &1.1227e+00_r8,1.3034e+00_r8,1.5049e+00_r8/) + kao(:, 4, 2,11) = (/ & + &5.6790e-02_r8,2.6663e-01_r8,4.5515e-01_r8,6.8101e-01_r8,9.0489e-01_r8,1.1244e+00_r8, & + &1.3363e+00_r8,1.5352e+00_r8,1.8090e+00_r8/) + kao(:, 5, 2,11) = (/ & + &6.7198e-02_r8,3.0909e-01_r8,5.3855e-01_r8,8.0620e-01_r8,1.0720e+00_r8,1.3339e+00_r8, & + &1.5872e+00_r8,1.8075e+00_r8,2.1432e+00_r8/) + kao(:, 1, 3,11) = (/ & + &5.8386e-02_r8,1.7533e-01_r8,2.7134e-01_r8,3.4280e-01_r8,4.5327e-01_r8,5.6550e-01_r8, & + &6.7606e-01_r8,7.8244e-01_r8,9.0646e-01_r8/) + kao(:, 2, 3,11) = (/ & + &7.4136e-02_r8,2.1912e-01_r8,3.3311e-01_r8,4.2266e-01_r8,5.6203e-01_r8,7.0075e-01_r8, & + &8.3707e-01_r8,9.6959e-01_r8,1.1236e+00_r8/) + kao(:, 3, 3,11) = (/ & + &9.1573e-02_r8,2.6509e-01_r8,4.0096e-01_r8,5.1730e-01_r8,6.8812e-01_r8,8.5747e-01_r8, & + &1.0237e+00_r8,1.1823e+00_r8,1.3753e+00_r8/) + kao(:, 4, 3,11) = (/ & + &1.1115e-01_r8,3.1410e-01_r8,4.7626e-01_r8,6.2447e-01_r8,8.3118e-01_r8,1.0365e+00_r8, & + &1.2383e+00_r8,1.4280e+00_r8,1.6615e+00_r8/) + kao(:, 5, 3,11) = (/ & + &1.3245e-01_r8,3.6725e-01_r8,5.5683e-01_r8,7.4336e-01_r8,9.8988e-01_r8,1.2355e+00_r8, & + &1.4780e+00_r8,1.7132e+00_r8,1.9788e+00_r8/) + kao(:, 1, 4,11) = (/ & + &1.1641e-01_r8,1.9770e-01_r8,2.9439e-01_r8,3.7525e-01_r8,4.3722e-01_r8,5.0094e-01_r8, & + &6.0009e-01_r8,6.9731e-01_r8,8.0196e-01_r8/) + kao(:, 2, 4,11) = (/ & + &1.4966e-01_r8,2.5765e-01_r8,3.7252e-01_r8,4.6834e-01_r8,5.4216e-01_r8,6.3606e-01_r8, & + &7.6075e-01_r8,8.7975e-01_r8,1.0184e+00_r8/) + kao(:, 3, 4,11) = (/ & + &1.8710e-01_r8,3.2245e-01_r8,4.5679e-01_r8,5.7205e-01_r8,6.6194e-01_r8,7.9151e-01_r8, & + &9.4643e-01_r8,1.0919e+00_r8,1.2671e+00_r8/) + kao(:, 4, 4,11) = (/ & + &2.2853e-01_r8,3.9201e-01_r8,5.5041e-01_r8,6.8810e-01_r8,7.8876e-01_r8,9.5787e-01_r8, & + &1.1458e+00_r8,1.3241e+00_r8,1.5335e+00_r8/) + kao(:, 5, 4,11) = (/ & + &2.7304e-01_r8,4.6530e-01_r8,6.5411e-01_r8,8.1513e-01_r8,9.2682e-01_r8,1.1406e+00_r8, & + &1.3653e+00_r8,1.5825e+00_r8,1.8252e+00_r8/) + kao(:, 1, 5,11) = (/ & + &2.2361e-01_r8,2.4318e-01_r8,3.1539e-01_r8,3.9443e-01_r8,4.5716e-01_r8,5.0109e-01_r8, & + &5.2154e-01_r8,6.0679e-01_r8,6.9571e-01_r8/) + kao(:, 2, 5,11) = (/ & + &2.8781e-01_r8,3.2451e-01_r8,4.1536e-01_r8,5.0630e-01_r8,5.8344e-01_r8,6.3855e-01_r8, & + &6.7297e-01_r8,7.8266e-01_r8,8.9726e-01_r8/) + kao(:, 3, 5,11) = (/ & + &3.6159e-01_r8,4.1915e-01_r8,5.2707e-01_r8,6.2976e-01_r8,7.2674e-01_r8,7.9740e-01_r8, & + &8.4985e-01_r8,9.8938e-01_r8,1.1325e+00_r8/) + kao(:, 4, 5,11) = (/ & + &4.4416e-01_r8,5.2452e-01_r8,6.5017e-01_r8,7.6880e-01_r8,8.8658e-01_r8,9.6270e-01_r8, & + &1.0399e+00_r8,1.2125e+00_r8,1.3846e+00_r8/) + kao(:, 5, 5,11) = (/ & + &5.3394e-01_r8,6.3638e-01_r8,7.8407e-01_r8,9.2197e-01_r8,1.0572e+00_r8,1.1328e+00_r8, & + &1.2555e+00_r8,1.4611e+00_r8,1.6711e+00_r8/) + kao(:, 1, 6,11) = (/ & + &3.9154e-01_r8,3.6960e-01_r8,3.6660e-01_r8,4.0826e-01_r8,4.6123e-01_r8,5.0084e-01_r8, & + &5.2154e-01_r8,5.2728e-01_r8,6.0320e-01_r8/) + kao(:, 2, 6,11) = (/ & + &5.1275e-01_r8,4.8556e-01_r8,4.9732e-01_r8,5.4788e-01_r8,6.0699e-01_r8,6.5333e-01_r8, & + &6.7418e-01_r8,6.8648e-01_r8,7.8580e-01_r8/) + kao(:, 3, 6,11) = (/ & + &6.5141e-01_r8,6.2128e-01_r8,6.5130e-01_r8,7.0712e-01_r8,7.7202e-01_r8,8.3303e-01_r8, & + &8.5314e-01_r8,8.6953e-01_r8,9.9315e-01_r8/) + kao(:, 4, 6,11) = (/ & + &8.1112e-01_r8,7.6989e-01_r8,8.2193e-01_r8,8.8492e-01_r8,9.6073e-01_r8,1.0362e+00_r8, & + &1.0443e+00_r8,1.0666e+00_r8,1.2159e+00_r8/) + kao(:, 5, 6,11) = (/ & + &9.8628e-01_r8,9.3596e-01_r8,1.0065e+00_r8,1.0840e+00_r8,1.1687e+00_r8,1.2489e+00_r8, & + &1.2474e+00_r8,1.2983e+00_r8,1.4796e+00_r8/) + kao(:, 1, 7,11) = (/ & + &6.9811e-01_r8,6.2404e-01_r8,5.7431e-01_r8,5.2596e-01_r8,5.0219e-01_r8,5.1011e-01_r8, & + &5.2289e-01_r8,4.9946e-01_r8,5.0228e-01_r8/) + kao(:, 2, 7,11) = (/ & + &9.3257e-01_r8,8.3430e-01_r8,7.6751e-01_r8,7.1360e-01_r8,6.8353e-01_r8,6.8813e-01_r8, & + &6.9358e-01_r8,6.6018e-01_r8,6.7200e-01_r8/) + kao(:, 3, 7,11) = (/ & + &1.1984e+00_r8,1.0755e+00_r8,9.9660e-01_r8,9.4008e-01_r8,8.9760e-01_r8,8.9906e-01_r8, & + &8.9631e-01_r8,8.4016e-01_r8,8.6247e-01_r8/) + kao(:, 4, 7,11) = (/ & + &1.5061e+00_r8,1.3555e+00_r8,1.2704e+00_r8,1.2009e+00_r8,1.1418e+00_r8,1.1469e+00_r8, & + &1.1302e+00_r8,1.0283e+00_r8,1.0687e+00_r8/) + kao(:, 5, 7,11) = (/ & + &1.8551e+00_r8,1.6736e+00_r8,1.5791e+00_r8,1.4850e+00_r8,1.4175e+00_r8,1.4225e+00_r8, & + &1.3804e+00_r8,1.2333e+00_r8,1.3098e+00_r8/) + kao(:, 1, 8,11) = (/ & + &1.4751e+00_r8,1.2907e+00_r8,1.1413e+00_r8,9.9788e-01_r8,8.3765e-01_r8,7.0312e-01_r8, & + &5.8437e-01_r8,5.1212e-01_r8,4.0848e-01_r8/) + kao(:, 2, 8,11) = (/ & + &2.0110e+00_r8,1.7597e+00_r8,1.5595e+00_r8,1.3603e+00_r8,1.1539e+00_r8,9.7291e-01_r8, & + &7.9698e-01_r8,7.0110e-01_r8,5.5259e-01_r8/) + kao(:, 3, 8,11) = (/ & + &2.6286e+00_r8,2.3001e+00_r8,2.0385e+00_r8,1.7785e+00_r8,1.5362e+00_r8,1.2889e+00_r8, & + &1.0590e+00_r8,9.2250e-01_r8,7.2275e-01_r8/) + kao(:, 4, 8,11) = (/ & + &3.3350e+00_r8,2.9182e+00_r8,2.5850e+00_r8,2.2617e+00_r8,1.9780e+00_r8,1.6580e+00_r8, & + &1.3758e+00_r8,1.1729e+00_r8,9.1532e-01_r8/) + kao(:, 5, 8,11) = (/ & + &4.1346e+00_r8,3.6181e+00_r8,3.2106e+00_r8,2.8264e+00_r8,2.4835e+00_r8,2.0714e+00_r8, & + &1.7385e+00_r8,1.4468e+00_r8,1.1430e+00_r8/) + kao(:, 1, 9,11) = (/ & + &5.7681e+00_r8,5.0468e+00_r8,4.3260e+00_r8,3.6050e+00_r8,2.9109e+00_r8,2.2673e+00_r8, & + &1.5776e+00_r8,9.1302e-01_r8,3.3856e-01_r8/) + kao(:, 2, 9,11) = (/ & + &8.0519e+00_r8,7.0463e+00_r8,6.0395e+00_r8,5.0331e+00_r8,4.0586e+00_r8,3.1762e+00_r8, & + &2.2073e+00_r8,1.2968e+00_r8,3.9705e-01_r8/) + kao(:, 3, 9,11) = (/ & + &1.0740e+01_r8,9.3971e+00_r8,8.0549e+00_r8,6.7129e+00_r8,5.4190e+00_r8,4.2355e+00_r8, & + &2.9531e+00_r8,1.7521e+00_r8,4.0437e-01_r8/) + kao(:, 4, 9,11) = (/ & + &1.3840e+01_r8,1.2110e+01_r8,1.0380e+01_r8,8.6502e+00_r8,7.0077e+00_r8,5.4549e+00_r8, & + &3.8354e+00_r8,2.2704e+00_r8,5.4385e-01_r8/) + kao(:, 5, 9,11) = (/ & + &1.7291e+01_r8,1.5129e+01_r8,1.2969e+01_r8,1.0808e+01_r8,8.7913e+00_r8,6.8118e+00_r8, & + &4.8594e+00_r8,2.8643e+00_r8,9.3844e-01_r8/) + kao(:, 1,10,11) = (/ & + &2.5281e+01_r8,2.2121e+01_r8,1.8961e+01_r8,1.5801e+01_r8,1.2641e+01_r8,9.4806e+00_r8, & + &6.3207e+00_r8,3.2921e+00_r8,2.8225e-01_r8/) + kao(:, 2,10,11) = (/ & + &3.6089e+01_r8,3.1577e+01_r8,2.7066e+01_r8,2.2555e+01_r8,1.8044e+01_r8,1.3532e+01_r8, & + &9.0226e+00_r8,4.7197e+00_r8,3.9375e-01_r8/) + kao(:, 3,10,11) = (/ & + &4.8997e+01_r8,4.2873e+01_r8,3.6749e+01_r8,3.0623e+01_r8,2.4498e+01_r8,1.8373e+01_r8, & + &1.2249e+01_r8,6.4130e+00_r8,6.0950e-01_r8/) + kao(:, 4,10,11) = (/ & + &6.4090e+01_r8,5.6079e+01_r8,4.8068e+01_r8,4.0059e+01_r8,3.2048e+01_r8,2.4036e+01_r8, & + &1.6029e+01_r8,8.3902e+00_r8,8.3229e-01_r8/) + kao(:, 5,10,11) = (/ & + &8.0977e+01_r8,7.0856e+01_r8,6.0735e+01_r8,5.0611e+01_r8,4.0489e+01_r8,3.0368e+01_r8, & + &2.0260e+01_r8,1.0591e+01_r8,9.6456e-01_r8/) + kao(:, 1,11,11) = (/ & + &4.5405e+01_r8,3.9730e+01_r8,3.4055e+01_r8,2.8379e+01_r8,2.2704e+01_r8,1.7027e+01_r8, & + &1.1352e+01_r8,5.7629e+00_r8,2.2978e-01_r8/) + kao(:, 2,11,11) = (/ & + &6.4516e+01_r8,5.6450e+01_r8,4.8385e+01_r8,4.0321e+01_r8,3.2258e+01_r8,2.4193e+01_r8, & + &1.6129e+01_r8,8.1743e+00_r8,3.8450e-01_r8/) + kao(:, 3,11,11) = (/ & + &8.7570e+01_r8,7.6629e+01_r8,6.5678e+01_r8,5.4738e+01_r8,4.3785e+01_r8,3.2840e+01_r8, & + &2.1894e+01_r8,1.1105e+01_r8,5.0528e-01_r8/) + kao(:, 4,11,11) = (/ & + &1.1421e+02_r8,9.9924e+01_r8,8.5650e+01_r8,7.1372e+01_r8,5.7099e+01_r8,4.2826e+01_r8, & + &2.8549e+01_r8,1.4506e+01_r8,6.3580e-01_r8/) + kao(:, 5,11,11) = (/ & + &1.4404e+02_r8,1.2604e+02_r8,1.0803e+02_r8,9.0033e+01_r8,7.2026e+01_r8,5.4020e+01_r8, & + &3.6011e+01_r8,1.8334e+01_r8,7.9612e-01_r8/) + kao(:, 1,12,11) = (/ & + &5.9271e+01_r8,5.1859e+01_r8,4.4453e+01_r8,3.7044e+01_r8,2.9635e+01_r8,2.2226e+01_r8, & + &1.4818e+01_r8,7.4861e+00_r8,2.2024e-01_r8/) + kao(:, 2,12,11) = (/ & + &8.4185e+01_r8,7.3665e+01_r8,6.3138e+01_r8,5.2615e+01_r8,4.2094e+01_r8,3.1570e+01_r8, & + &2.1046e+01_r8,1.0615e+01_r8,3.8802e-01_r8/) + kao(:, 3,12,11) = (/ & + &1.1399e+02_r8,9.9749e+01_r8,8.5496e+01_r8,7.1245e+01_r8,5.6997e+01_r8,4.2749e+01_r8, & + &2.8499e+01_r8,1.4383e+01_r8,4.9342e-01_r8/) + kao(:, 4,12,11) = (/ & + &1.4842e+02_r8,1.2987e+02_r8,1.1132e+02_r8,9.2770e+01_r8,7.4216e+01_r8,5.5662e+01_r8, & + &3.7107e+01_r8,1.8761e+01_r8,6.8194e-01_r8/) + kao(:, 5,12,11) = (/ & + &1.8694e+02_r8,1.6356e+02_r8,1.4020e+02_r8,1.1683e+02_r8,9.3474e+01_r8,7.0107e+01_r8, & + &4.6738e+01_r8,2.3682e+01_r8,7.5051e-01_r8/) + kao(:, 1,13,11) = (/ & + &6.1162e+01_r8,5.3516e+01_r8,4.5871e+01_r8,3.8225e+01_r8,3.0581e+01_r8,2.2936e+01_r8, & + &1.5291e+01_r8,7.7722e+00_r8,3.0501e-01_r8/) + kao(:, 2,13,11) = (/ & + &8.6643e+01_r8,7.5815e+01_r8,6.4984e+01_r8,5.4153e+01_r8,4.3324e+01_r8,3.2493e+01_r8, & + &2.1662e+01_r8,1.1016e+01_r8,3.8069e-01_r8/) + kao(:, 3,13,11) = (/ & + &1.1697e+02_r8,1.0235e+02_r8,8.7727e+01_r8,7.3107e+01_r8,5.8486e+01_r8,4.3863e+01_r8, & + &2.9242e+01_r8,1.4879e+01_r8,4.9510e-01_r8/) + kao(:, 4,13,11) = (/ & + &1.5186e+02_r8,1.3288e+02_r8,1.1389e+02_r8,9.4916e+01_r8,7.5936e+01_r8,5.6949e+01_r8, & + &3.7967e+01_r8,1.9342e+01_r8,5.7912e-01_r8/) + kao(:, 5,13,11) = (/ & + &1.9078e+02_r8,1.6694e+02_r8,1.4309e+02_r8,1.1924e+02_r8,9.5394e+01_r8,7.1546e+01_r8, & + &4.7697e+01_r8,2.4327e+01_r8,6.7000e-01_r8/) + kao(:, 1, 1,12) = (/ & + &4.4327e-02_r8,1.9901e-01_r8,3.9567e-01_r8,5.8848e-01_r8,7.7476e-01_r8,9.4853e-01_r8, & + &1.0934e+00_r8,1.1527e+00_r8,1.5495e+00_r8/) + kao(:, 2, 1,12) = (/ & + &5.3905e-02_r8,2.4740e-01_r8,4.9242e-01_r8,7.3367e-01_r8,9.6823e-01_r8,1.1892e+00_r8, & + &1.3767e+00_r8,1.4534e+00_r8,1.9364e+00_r8/) + kao(:, 3, 1,12) = (/ & + &6.4069e-02_r8,2.9762e-01_r8,5.9267e-01_r8,8.8396e-01_r8,1.1680e+00_r8,1.4379e+00_r8, & + &1.6734e+00_r8,1.7853e+00_r8,2.3359e+00_r8/) + kao(:, 4, 1,12) = (/ & + &7.4599e-02_r8,3.4908e-01_r8,6.9548e-01_r8,1.0378e+00_r8,1.3725e+00_r8,1.6921e+00_r8, & + &1.9734e+00_r8,2.1192e+00_r8,2.7449e+00_r8/) + kao(:, 5, 1,12) = (/ & + &8.5274e-02_r8,4.0394e-01_r8,8.0404e-01_r8,1.1983e+00_r8,1.5830e+00_r8,1.9477e+00_r8, & + &2.2662e+00_r8,2.4521e+00_r8,3.1659e+00_r8/) + kao(:, 1, 2,12) = (/ & + &6.1665e-02_r8,2.1077e-01_r8,3.8355e-01_r8,5.7339e-01_r8,7.6055e-01_r8,9.4236e-01_r8, & + &1.1091e+00_r8,1.2168e+00_r8,1.5210e+00_r8/) + kao(:, 2, 2,12) = (/ & + &7.6234e-02_r8,2.5639e-01_r8,4.7826e-01_r8,7.1532e-01_r8,9.5007e-01_r8,1.1793e+00_r8, & + &1.3941e+00_r8,1.5452e+00_r8,1.9001e+00_r8/) + kao(:, 3, 2,12) = (/ & + &9.1892e-02_r8,3.0376e-01_r8,5.7761e-01_r8,8.6445e-01_r8,1.1488e+00_r8,1.4281e+00_r8, & + &1.6923e+00_r8,1.8917e+00_r8,2.2975e+00_r8/) + kao(:, 4, 2,12) = (/ & + &1.0837e-01_r8,3.5273e-01_r8,6.8106e-01_r8,1.0192e+00_r8,1.3548e+00_r8,1.6858e+00_r8, & + &2.0012e+00_r8,2.2488e+00_r8,2.7094e+00_r8/) + kao(:, 5, 2,12) = (/ & + &1.2523e-01_r8,4.0526e-01_r8,7.9735e-01_r8,1.1921e+00_r8,1.5816e+00_r8,1.9625e+00_r8, & + &2.3213e+00_r8,2.6087e+00_r8,3.1625e+00_r8/) + kao(:, 1, 3,12) = (/ & + &1.1120e-01_r8,2.4868e-01_r8,3.6808e-01_r8,5.1840e-01_r8,6.9017e-01_r8,8.6056e-01_r8, & + &1.0271e+00_r8,1.1758e+00_r8,1.3802e+00_r8/) + kao(:, 2, 3,12) = (/ & + &1.4053e-01_r8,3.1536e-01_r8,4.5583e-01_r8,6.5442e-01_r8,8.7173e-01_r8,1.0879e+00_r8, & + &1.3003e+00_r8,1.4947e+00_r8,1.7433e+00_r8/) + kao(:, 3, 3,12) = (/ & + &1.7249e-01_r8,3.8643e-01_r8,5.4830e-01_r8,7.9885e-01_r8,1.0645e+00_r8,1.3292e+00_r8, & + &1.5905e+00_r8,1.8338e+00_r8,2.1288e+00_r8/) + kao(:, 4, 3,12) = (/ & + &2.0676e-01_r8,4.5780e-01_r8,6.4549e-01_r8,9.5437e-01_r8,1.2710e+00_r8,1.5864e+00_r8, & + &1.8970e+00_r8,2.1896e+00_r8,2.5411e+00_r8/) + kao(:, 5, 3,12) = (/ & + &2.4212e-01_r8,5.2871e-01_r8,7.5484e-01_r8,1.1269e+00_r8,1.5000e+00_r8,1.8700e+00_r8, & + &2.2336e+00_r8,2.5647e+00_r8,2.9987e+00_r8/) + kao(:, 1, 4,12) = (/ & + &2.0092e-01_r8,3.0566e-01_r8,4.3321e-01_r8,5.2770e-01_r8,6.0160e-01_r8,7.5023e-01_r8, & + &8.9870e-01_r8,1.0432e+00_r8,1.2013e+00_r8/) + kao(:, 2, 4,12) = (/ & + &2.6071e-01_r8,3.8703e-01_r8,5.5757e-01_r8,6.5930e-01_r8,7.6619e-01_r8,9.5732e-01_r8, & + &1.1477e+00_r8,1.3364e+00_r8,1.5321e+00_r8/) + kao(:, 3, 4,12) = (/ & + &3.2640e-01_r8,4.7994e-01_r8,6.8737e-01_r8,7.9575e-01_r8,9.4617e-01_r8,1.1821e+00_r8, & + &1.4178e+00_r8,1.6541e+00_r8,1.8914e+00_r8/) + kao(:, 4, 4,12) = (/ & + &3.9855e-01_r8,5.8348e-01_r8,8.2078e-01_r8,9.3830e-01_r8,1.1490e+00_r8,1.4352e+00_r8, & + &1.7207e+00_r8,2.0041e+00_r8,2.2963e+00_r8/) + kao(:, 5, 4,12) = (/ & + &4.7570e-01_r8,6.9415e-01_r8,9.5472e-01_r8,1.0922e+00_r8,1.3776e+00_r8,1.7196e+00_r8, & + &2.0594e+00_r8,2.3902e+00_r8,2.7528e+00_r8/) + kao(:, 1, 5,12) = (/ & + &3.3247e-01_r8,3.9594e-01_r8,4.9056e-01_r8,5.8813e-01_r8,6.5607e-01_r8,6.8035e-01_r8, & + &7.9032e-01_r8,9.1840e-01_r8,1.0557e+00_r8/) + kao(:, 2, 5,12) = (/ & + &4.4282e-01_r8,5.1203e-01_r8,6.4486e-01_r8,7.7152e-01_r8,8.4090e-01_r8,8.6628e-01_r8, & + &1.0179e+00_r8,1.1841e+00_r8,1.3589e+00_r8/) + kao(:, 3, 5,12) = (/ & + &5.6912e-01_r8,6.3900e-01_r8,8.2247e-01_r8,9.6727e-01_r8,1.0369e+00_r8,1.0698e+00_r8, & + &1.2706e+00_r8,1.4785e+00_r8,1.6959e+00_r8/) + kao(:, 4, 5,12) = (/ & + &7.0931e-01_r8,7.8069e-01_r8,1.0153e+00_r8,1.1726e+00_r8,1.2423e+00_r8,1.3043e+00_r8, & + &1.5604e+00_r8,1.8146e+00_r8,2.0829e+00_r8/) + kao(:, 5, 5,12) = (/ & + &8.5949e-01_r8,9.3825e-01_r8,1.2105e+00_r8,1.3829e+00_r8,1.4592e+00_r8,1.5748e+00_r8, & + &1.8870e+00_r8,2.1938e+00_r8,2.5189e+00_r8/) + kao(:, 1, 6,12) = (/ & + &5.2509e-01_r8,5.1721e-01_r8,5.7378e-01_r8,6.3384e-01_r8,6.9692e-01_r8,7.3419e-01_r8, & + &7.1864e-01_r8,7.9317e-01_r8,9.0866e-01_r8/) + kao(:, 2, 6,12) = (/ & + &7.0957e-01_r8,6.9625e-01_r8,7.6638e-01_r8,8.5821e-01_r8,9.3314e-01_r8,9.6244e-01_r8, & + &9.2911e-01_r8,1.0410e+00_r8,1.1915e+00_r8/) + kao(:, 3, 6,12) = (/ & + &9.2892e-01_r8,9.0647e-01_r8,9.9421e-01_r8,1.1180e+00_r8,1.1912e+00_r8,1.2074e+00_r8, & + &1.1606e+00_r8,1.3214e+00_r8,1.5144e+00_r8/) + kao(:, 4, 6,12) = (/ & + &1.1749e+00_r8,1.1432e+00_r8,1.2560e+00_r8,1.3977e+00_r8,1.4686e+00_r8,1.4691e+00_r8, & + &1.4281e+00_r8,1.6462e+00_r8,1.8876e+00_r8/) + kao(:, 5, 6,12) = (/ & + &1.4442e+00_r8,1.4016e+00_r8,1.5480e+00_r8,1.6922e+00_r8,1.7621e+00_r8,1.7564e+00_r8, & + &1.7321e+00_r8,2.0105e+00_r8,2.3048e+00_r8/) + kao(:, 1, 7,12) = (/ & + &9.1849e-01_r8,8.0624e-01_r8,7.9050e-01_r8,7.5675e-01_r8,7.6178e-01_r8,7.8133e-01_r8, & + &7.7608e-01_r8,6.9116e-01_r8,7.7991e-01_r8/) + kao(:, 2, 7,12) = (/ & + &1.2413e+00_r8,1.0918e+00_r8,1.0769e+00_r8,1.0420e+00_r8,1.0608e+00_r8,1.0726e+00_r8, & + &1.0404e+00_r8,9.1318e-01_r8,1.0358e+00_r8/) + kao(:, 3, 7,12) = (/ & + &1.6444e+00_r8,1.4500e+00_r8,1.4209e+00_r8,1.3929e+00_r8,1.4200e+00_r8,1.3992e+00_r8, & + &1.3321e+00_r8,1.1740e+00_r8,1.3388e+00_r8/) + kao(:, 4, 7,12) = (/ & + &2.1122e+00_r8,1.8669e+00_r8,1.8040e+00_r8,1.8049e+00_r8,1.8188e+00_r8,1.7570e+00_r8, & + &1.6501e+00_r8,1.4861e+00_r8,1.6989e+00_r8/) + kao(:, 5, 7,12) = (/ & + &2.6250e+00_r8,2.3265e+00_r8,2.2289e+00_r8,2.2673e+00_r8,2.2456e+00_r8,2.1426e+00_r8, & + &2.0040e+00_r8,1.8373e+00_r8,2.0997e+00_r8/) + kao(:, 1, 8,12) = (/ & + &1.9827e+00_r8,1.7349e+00_r8,1.4981e+00_r8,1.3371e+00_r8,1.1453e+00_r8,9.6602e-01_r8, & + &8.7309e-01_r8,7.7254e-01_r8,6.6571e-01_r8/) + kao(:, 2, 8,12) = (/ & + &2.7151e+00_r8,2.3758e+00_r8,2.0507e+00_r8,1.8313e+00_r8,1.5691e+00_r8,1.3551e+00_r8, & + &1.2325e+00_r8,1.0537e+00_r8,8.9966e-01_r8/) + kao(:, 3, 8,12) = (/ & + &3.5997e+00_r8,3.1499e+00_r8,2.7291e+00_r8,2.4373e+00_r8,2.1034e+00_r8,1.8593e+00_r8, & + &1.6579e+00_r8,1.3773e+00_r8,1.1789e+00_r8/) + kao(:, 4, 8,12) = (/ & + &4.6665e+00_r8,4.0832e+00_r8,3.5519e+00_r8,3.1544e+00_r8,2.7468e+00_r8,2.4617e+00_r8, & + &2.1388e+00_r8,1.7464e+00_r8,1.5079e+00_r8/) + kao(:, 5, 8,12) = (/ & + &5.8669e+00_r8,5.1335e+00_r8,4.4792e+00_r8,3.9559e+00_r8,3.4817e+00_r8,3.1241e+00_r8, & + &2.6649e+00_r8,2.1629e+00_r8,1.8732e+00_r8/) + kao(:, 1, 9,12) = (/ & + &8.0387e+00_r8,7.0340e+00_r8,6.0293e+00_r8,5.0245e+00_r8,4.0196e+00_r8,3.0957e+00_r8, & + &2.1773e+00_r8,1.2357e+00_r8,4.2050e-01_r8/) + kao(:, 2, 9,12) = (/ & + &1.1280e+01_r8,9.8705e+00_r8,8.4601e+00_r8,7.0501e+00_r8,5.6402e+00_r8,4.3334e+00_r8, & + &3.0492e+00_r8,1.7467e+00_r8,4.6837e-01_r8/) + kao(:, 3, 9,12) = (/ & + &1.5202e+01_r8,1.3302e+01_r8,1.1401e+01_r8,9.5008e+00_r8,7.6009e+00_r8,5.8446e+00_r8, & + &4.1033e+00_r8,2.4072e+00_r8,9.0067e-01_r8/) + kao(:, 4, 9,12) = (/ & + &1.9804e+01_r8,1.7328e+01_r8,1.4853e+01_r8,1.2377e+01_r8,9.9040e+00_r8,7.6319e+00_r8, & + &5.3589e+00_r8,3.2206e+00_r8,1.3277e+00_r8/) + kao(:, 5, 9,12) = (/ & + &2.5091e+01_r8,2.1955e+01_r8,1.8819e+01_r8,1.5683e+01_r8,1.2554e+01_r8,9.6970e+00_r8, & + &6.8190e+00_r8,4.1412e+00_r8,1.6570e+00_r8/) + kao(:, 1,10,12) = (/ & + &3.6853e+01_r8,3.2247e+01_r8,2.7641e+01_r8,2.3035e+01_r8,1.8427e+01_r8,1.3820e+01_r8, & + &9.2142e+00_r8,4.7017e+00_r8,5.2096e-01_r8/) + kao(:, 2,10,12) = (/ & + &5.2866e+01_r8,4.6255e+01_r8,3.9648e+01_r8,3.3040e+01_r8,2.6431e+01_r8,1.9825e+01_r8, & + &1.3217e+01_r8,6.7223e+00_r8,8.5705e-01_r8/) + kao(:, 3,10,12) = (/ & + &7.2440e+01_r8,6.3382e+01_r8,5.4326e+01_r8,4.5272e+01_r8,3.6218e+01_r8,2.7164e+01_r8, & + &1.8108e+01_r8,9.2103e+00_r8,9.7984e-01_r8/) + kao(:, 4,10,12) = (/ & + &9.5327e+01_r8,8.3414e+01_r8,7.1501e+01_r8,5.9582e+01_r8,4.7667e+01_r8,3.5750e+01_r8, & + &2.3834e+01_r8,1.2146e+01_r8,1.1774e+00_r8/) + kao(:, 5,10,12) = (/ & + &1.2143e+02_r8,1.0625e+02_r8,9.1069e+01_r8,7.5889e+01_r8,6.0713e+01_r8,4.5537e+01_r8, & + &3.0358e+01_r8,1.5516e+01_r8,1.3416e+00_r8/) + kao(:, 1,11,12) = (/ & + &6.9348e+01_r8,6.0680e+01_r8,5.2012e+01_r8,4.3342e+01_r8,3.4673e+01_r8,2.6006e+01_r8, & + &1.7338e+01_r8,8.6702e+00_r8,3.0466e-01_r8/) + kao(:, 2,11,12) = (/ & + &9.9352e+01_r8,8.6930e+01_r8,7.4511e+01_r8,6.2093e+01_r8,4.9676e+01_r8,3.7257e+01_r8, & + &2.4839e+01_r8,1.2419e+01_r8,6.8510e-01_r8/) + kao(:, 3,11,12) = (/ & + &1.3563e+02_r8,1.1868e+02_r8,1.0173e+02_r8,8.4769e+01_r8,6.7818e+01_r8,5.0866e+01_r8, & + &3.3908e+01_r8,1.6957e+01_r8,1.0467e+00_r8/) + kao(:, 4,11,12) = (/ & + &1.7753e+02_r8,1.5535e+02_r8,1.3315e+02_r8,1.1096e+02_r8,8.8765e+01_r8,6.6576e+01_r8, & + &4.4384e+01_r8,2.2206e+01_r8,1.3289e+00_r8/) + kao(:, 5,11,12) = (/ & + &2.2508e+02_r8,1.9694e+02_r8,1.6881e+02_r8,1.4068e+02_r8,1.1255e+02_r8,8.4405e+01_r8, & + &5.6267e+01_r8,2.8168e+01_r8,1.6371e+00_r8/) + kao(:, 1,12,12) = (/ & + &9.5815e+01_r8,8.3836e+01_r8,7.1860e+01_r8,5.9885e+01_r8,4.7907e+01_r8,3.5931e+01_r8, & + &2.3953e+01_r8,1.1977e+01_r8,2.4035e-01_r8/) + kao(:, 2,12,12) = (/ & + &1.3694e+02_r8,1.1982e+02_r8,1.0270e+02_r8,8.5588e+01_r8,6.8468e+01_r8,5.1352e+01_r8, & + &3.4234e+01_r8,1.7118e+01_r8,5.7126e-01_r8/) + kao(:, 3,12,12) = (/ & + &1.8607e+02_r8,1.6282e+02_r8,1.3956e+02_r8,1.1630e+02_r8,9.3038e+01_r8,6.9781e+01_r8, & + &4.6518e+01_r8,2.3259e+01_r8,8.8813e-01_r8/) + kao(:, 4,12,12) = (/ & + &2.4268e+02_r8,2.1235e+02_r8,1.8201e+02_r8,1.5168e+02_r8,1.2134e+02_r8,9.1010e+01_r8, & + &6.0670e+01_r8,3.0335e+01_r8,1.1237e+00_r8/) + kao(:, 5,12,12) = (/ & + &3.0642e+02_r8,2.6813e+02_r8,2.2982e+02_r8,1.9152e+02_r8,1.5322e+02_r8,1.1491e+02_r8, & + &7.6606e+01_r8,3.8310e+01_r8,1.5308e+00_r8/) + kao(:, 1,13,12) = (/ & + &1.0396e+02_r8,9.0973e+01_r8,7.7973e+01_r8,6.4982e+01_r8,5.1984e+01_r8,3.8991e+01_r8, & + &2.5992e+01_r8,1.3003e+01_r8,2.8896e-01_r8/) + kao(:, 2,13,12) = (/ & + &1.4817e+02_r8,1.2965e+02_r8,1.1113e+02_r8,9.2604e+01_r8,7.4089e+01_r8,5.5562e+01_r8, & + &3.7043e+01_r8,1.8523e+01_r8,6.4071e-01_r8/) + kao(:, 3,13,12) = (/ & + &2.0056e+02_r8,1.7549e+02_r8,1.5042e+02_r8,1.2535e+02_r8,1.0028e+02_r8,7.5210e+01_r8, & + &5.0138e+01_r8,2.5080e+01_r8,7.6073e-01_r8/) + kao(:, 4,13,12) = (/ & + &2.6107e+02_r8,2.2842e+02_r8,1.9581e+02_r8,1.6317e+02_r8,1.3054e+02_r8,9.7901e+01_r8, & + &6.5267e+01_r8,3.2665e+01_r8,1.0550e+00_r8/) + kao(:, 5,13,12) = (/ & + &3.2818e+02_r8,2.8717e+02_r8,2.4613e+02_r8,2.0512e+02_r8,1.6409e+02_r8,1.2307e+02_r8, & + &8.2040e+01_r8,4.1093e+01_r8,1.4069e+00_r8/) + kao(:, 1, 1,13) = (/ & + &8.9189e-02_r8,2.7547e-01_r8,5.4755e-01_r8,8.1466e-01_r8,1.0734e+00_r8,1.3167e+00_r8, & + &1.5262e+00_r8,1.6545e+00_r8,2.1467e+00_r8/) + kao(:, 2, 1,13) = (/ & + &1.0564e-01_r8,3.3448e-01_r8,6.6333e-01_r8,9.8354e-01_r8,1.2897e+00_r8,1.5719e+00_r8, & + &1.8097e+00_r8,1.9474e+00_r8,2.5794e+00_r8/) + kao(:, 3, 1,13) = (/ & + &1.2232e-01_r8,4.0251e-01_r8,7.9745e-01_r8,1.1809e+00_r8,1.5463e+00_r8,1.8798e+00_r8, & + &2.1512e+00_r8,2.2853e+00_r8,3.0925e+00_r8/) + kao(:, 4, 1,13) = (/ & + &1.3906e-01_r8,4.8151e-01_r8,9.5370e-01_r8,1.4117e+00_r8,1.8477e+00_r8,2.2440e+00_r8, & + &2.5627e+00_r8,2.7054e+00_r8,3.6953e+00_r8/) + kao(:, 5, 1,13) = (/ & + &1.5537e-01_r8,5.6891e-01_r8,1.1282e+00_r8,1.6723e+00_r8,2.1918e+00_r8,2.6654e+00_r8, & + &3.0480e+00_r8,3.1989e+00_r8,4.3834e+00_r8/) + kao(:, 1, 2,13) = (/ & + &1.2651e-01_r8,2.7511e-01_r8,5.4811e-01_r8,8.1792e-01_r8,1.0822e+00_r8,1.3369e+00_r8, & + &1.5702e+00_r8,1.7388e+00_r8,2.1643e+00_r8/) + kao(:, 2, 2,13) = (/ & + &1.5153e-01_r8,3.4384e-01_r8,6.8417e-01_r8,1.0197e+00_r8,1.3466e+00_r8,1.6574e+00_r8, & + &1.9318e+00_r8,2.0933e+00_r8,2.6930e+00_r8/) + kao(:, 3, 2,13) = (/ & + &1.7716e-01_r8,4.2323e-01_r8,8.4160e-01_r8,1.2530e+00_r8,1.6525e+00_r8,2.0285e+00_r8, & + &2.3523e+00_r8,2.5052e+00_r8,3.3049e+00_r8/) + kao(:, 4, 2,13) = (/ & + &2.0304e-01_r8,5.0914e-01_r8,1.0128e+00_r8,1.5083e+00_r8,1.9894e+00_r8,2.4425e+00_r8, & + &2.8273e+00_r8,2.9947e+00_r8,3.9785e+00_r8/) + kao(:, 5, 2,13) = (/ & + &2.2856e-01_r8,5.9708e-01_r8,1.1882e+00_r8,1.7705e+00_r8,2.3375e+00_r8,2.8753e+00_r8, & + &3.3417e+00_r8,3.5598e+00_r8,4.6746e+00_r8/) + kao(:, 1, 3,13) = (/ & + &2.3155e-01_r8,3.6106e-01_r8,5.1524e-01_r8,7.7074e-01_r8,1.0237e+00_r8,1.2717e+00_r8, & + &1.5079e+00_r8,1.7067e+00_r8,2.0474e+00_r8/) + kao(:, 2, 3,13) = (/ & + &2.8222e-01_r8,4.3122e-01_r8,6.6114e-01_r8,9.8854e-01_r8,1.3120e+00_r8,1.6278e+00_r8, & + &1.9248e+00_r8,2.1616e+00_r8,2.6238e+00_r8/) + kao(:, 3, 3,13) = (/ & + &3.3490e-01_r8,5.0925e-01_r8,8.3049e-01_r8,1.2417e+00_r8,1.6476e+00_r8,2.0430e+00_r8, & + &2.4133e+00_r8,2.6954e+00_r8,3.2949e+00_r8/) + kao(:, 4, 3,13) = (/ & + &3.8898e-01_r8,5.9951e-01_r8,1.0132e+00_r8,1.5151e+00_r8,2.0114e+00_r8,2.4964e+00_r8, & + &2.9531e+00_r8,3.3043e+00_r8,4.0224e+00_r8/) + kao(:, 5, 3,13) = (/ & + &4.4295e-01_r8,6.9228e-01_r8,1.1941e+00_r8,1.7863e+00_r8,2.3719e+00_r8,2.9449e+00_r8, & + &3.4879e+00_r8,3.9170e+00_r8,4.7434e+00_r8/) + kao(:, 1, 4,13) = (/ & + &4.2438e-01_r8,5.0777e-01_r8,6.1519e-01_r8,7.0596e-01_r8,9.3438e-01_r8,1.1645e+00_r8, & + &1.3892e+00_r8,1.5946e+00_r8,1.8686e+00_r8/) + kao(:, 2, 4,13) = (/ & + &5.2911e-01_r8,6.2653e-01_r8,7.5903e-01_r8,9.2591e-01_r8,1.2320e+00_r8,1.5352e+00_r8, & + &1.8307e+00_r8,2.0955e+00_r8,2.4637e+00_r8/) + kao(:, 3, 4,13) = (/ & + &6.3945e-01_r8,7.5086e-01_r8,9.2902e-01_r8,1.1816e+00_r8,1.5728e+00_r8,1.9600e+00_r8, & + &2.3380e+00_r8,2.6793e+00_r8,3.1453e+00_r8/) + kao(:, 4, 4,13) = (/ & + &7.5432e-01_r8,8.7946e-01_r8,1.1073e+00_r8,1.4569e+00_r8,1.9394e+00_r8,2.4183e+00_r8, & + &2.8875e+00_r8,3.3173e+00_r8,3.8782e+00_r8/) + kao(:, 5, 4,13) = (/ & + &8.7134e-01_r8,1.0123e+00_r8,1.2829e+00_r8,1.7403e+00_r8,2.3172e+00_r8,2.8902e+00_r8, & + &3.4528e+00_r8,3.9744e+00_r8,4.6335e+00_r8/) + kao(:, 1, 5,13) = (/ & + &7.1207e-01_r8,6.8711e-01_r8,8.3241e-01_r8,8.6529e-01_r8,8.8550e-01_r8,1.0406e+00_r8, & + &1.2451e+00_r8,1.4407e+00_r8,1.6670e+00_r8/) + kao(:, 2, 5,13) = (/ & + &9.0944e-01_r8,8.8418e-01_r8,1.0384e+00_r8,1.0957e+00_r8,1.1610e+00_r8,1.4029e+00_r8, & + &1.6788e+00_r8,1.9429e+00_r8,2.2472e+00_r8/) + kao(:, 3, 5,13) = (/ & + &1.1217e+00_r8,1.1051e+00_r8,1.2550e+00_r8,1.3677e+00_r8,1.4770e+00_r8,1.8154e+00_r8, & + &2.1738e+00_r8,2.5182e+00_r8,2.9077e+00_r8/) + kao(:, 4, 5,13) = (/ & + &1.3460e+00_r8,1.3429e+00_r8,1.4887e+00_r8,1.6567e+00_r8,1.8206e+00_r8,2.2609e+00_r8, & + &2.7082e+00_r8,3.1425e+00_r8,3.6199e+00_r8/) + kao(:, 5, 5,13) = (/ & + &1.5795e+00_r8,1.5881e+00_r8,1.7517e+00_r8,1.9324e+00_r8,2.1859e+00_r8,2.7284e+00_r8, & + &3.2694e+00_r8,3.7971e+00_r8,4.3676e+00_r8/) + kao(:, 1, 6,13) = (/ & + &1.1023e+00_r8,9.7526e-01_r8,1.0617e+00_r8,1.1008e+00_r8,1.0651e+00_r8,1.0178e+00_r8, & + &1.0836e+00_r8,1.2590e+00_r8,1.4474e+00_r8/) + kao(:, 2, 6,13) = (/ & + &1.4464e+00_r8,1.2819e+00_r8,1.3748e+00_r8,1.4078e+00_r8,1.3857e+00_r8,1.3476e+00_r8, & + &1.4882e+00_r8,1.7304e+00_r8,1.9875e+00_r8/) + kao(:, 3, 6,13) = (/ & + &1.8308e+00_r8,1.6242e+00_r8,1.7155e+00_r8,1.7456e+00_r8,1.7675e+00_r8,1.7237e+00_r8, & + &1.9554e+00_r8,2.2760e+00_r8,2.6094e+00_r8/) + kao(:, 4, 6,13) = (/ & + &2.2453e+00_r8,1.9975e+00_r8,2.0781e+00_r8,2.1295e+00_r8,2.1828e+00_r8,2.1327e+00_r8, & + &2.4652e+00_r8,2.8713e+00_r8,3.2893e+00_r8/) + kao(:, 5, 6,13) = (/ & + &2.6836e+00_r8,2.3986e+00_r8,2.4577e+00_r8,2.5567e+00_r8,2.5877e+00_r8,2.5663e+00_r8, & + &3.0104e+00_r8,3.5064e+00_r8,4.0161e+00_r8/) + kao(:, 1, 7,13) = (/ & + &1.7788e+00_r8,1.5565e+00_r8,1.4296e+00_r8,1.4541e+00_r8,1.3809e+00_r8,1.2482e+00_r8, & + &1.1009e+00_r8,1.0852e+00_r8,1.2442e+00_r8/) + kao(:, 2, 7,13) = (/ & + &2.4100e+00_r8,2.1089e+00_r8,1.9246e+00_r8,1.9363e+00_r8,1.8185e+00_r8,1.6636e+00_r8, & + &1.4819e+00_r8,1.5124e+00_r8,1.7324e+00_r8/) + kao(:, 3, 7,13) = (/ & + &3.1319e+00_r8,2.7405e+00_r8,2.5003e+00_r8,2.4636e+00_r8,2.3111e+00_r8,2.1652e+00_r8, & + &1.9114e+00_r8,2.0080e+00_r8,2.2982e+00_r8/) + kao(:, 4, 7,13) = (/ & + &3.9360e+00_r8,3.4440e+00_r8,3.1598e+00_r8,3.0372e+00_r8,2.8747e+00_r8,2.7334e+00_r8, & + &2.3814e+00_r8,2.5579e+00_r8,2.9254e+00_r8/) + kao(:, 5, 7,13) = (/ & + &4.8010e+00_r8,4.2009e+00_r8,3.8764e+00_r8,3.6526e+00_r8,3.5065e+00_r8,3.3078e+00_r8, & + &2.8824e+00_r8,3.1625e+00_r8,3.6156e+00_r8/) + kao(:, 1, 8,13) = (/ & + &3.4656e+00_r8,3.0324e+00_r8,2.5993e+00_r8,2.2536e+00_r8,2.0768e+00_r8,1.8323e+00_r8, & + &1.4794e+00_r8,1.1100e+00_r8,1.0719e+00_r8/) + kao(:, 2, 8,13) = (/ & + &4.7953e+00_r8,4.1960e+00_r8,3.5964e+00_r8,3.1195e+00_r8,2.8558e+00_r8,2.4960e+00_r8, & + &2.0234e+00_r8,1.5264e+00_r8,1.5151e+00_r8/) + kao(:, 3, 8,13) = (/ & + &6.4119e+00_r8,5.6106e+00_r8,4.8091e+00_r8,4.1637e+00_r8,3.7658e+00_r8,3.2529e+00_r8, & + &2.6777e+00_r8,1.9921e+00_r8,2.0306e+00_r8/) + kao(:, 4, 8,13) = (/ & + &8.2532e+00_r8,7.2211e+00_r8,6.1898e+00_r8,5.3688e+00_r8,4.7948e+00_r8,4.1025e+00_r8, & + &3.4458e+00_r8,2.5062e+00_r8,2.6143e+00_r8/) + kao(:, 5, 8,13) = (/ & + &1.0283e+01_r8,8.9971e+00_r8,7.7118e+00_r8,6.7087e+00_r8,5.9163e+00_r8,5.0630e+00_r8, & + &4.2877e+00_r8,3.0597e+00_r8,3.2702e+00_r8/) + kao(:, 1, 9,13) = (/ & + &1.3039e+01_r8,1.1409e+01_r8,9.7786e+00_r8,8.1486e+00_r8,6.5192e+00_r8,4.9000e+00_r8, & + &3.5526e+00_r8,2.2083e+00_r8,6.1249e-01_r8/) + kao(:, 2, 9,13) = (/ & + &1.8190e+01_r8,1.5916e+01_r8,1.3643e+01_r8,1.1369e+01_r8,9.0953e+00_r8,6.8331e+00_r8, & + &4.9544e+00_r8,3.0917e+00_r8,1.3174e+00_r8/) + kao(:, 3, 9,13) = (/ & + &2.4717e+01_r8,2.1628e+01_r8,1.8538e+01_r8,1.5449e+01_r8,1.2359e+01_r8,9.2996e+00_r8, & + &6.7414e+00_r8,4.1578e+00_r8,1.7841e+00_r8/) + kao(:, 4, 9,13) = (/ & + &3.2573e+01_r8,2.8503e+01_r8,2.4432e+01_r8,2.0359e+01_r8,1.6288e+01_r8,1.2267e+01_r8, & + &8.8606e+00_r8,5.4011e+00_r8,2.3241e+00_r8/) + kao(:, 5, 9,13) = (/ & + &4.1562e+01_r8,3.6368e+01_r8,3.1173e+01_r8,2.5977e+01_r8,2.0781e+01_r8,1.5678e+01_r8, & + &1.1261e+01_r8,6.8301e+00_r8,2.9541e+00_r8/) + kao(:, 1,10,13) = (/ & + &5.7951e+01_r8,5.0708e+01_r8,4.3464e+01_r8,3.6220e+01_r8,2.8976e+01_r8,2.1732e+01_r8, & + &1.4488e+01_r8,7.2520e+00_r8,5.6538e-01_r8/) + kao(:, 2,10,13) = (/ & + &8.1306e+01_r8,7.1141e+01_r8,6.0979e+01_r8,5.0813e+01_r8,4.0652e+01_r8,3.0489e+01_r8, & + &2.0326e+01_r8,1.0163e+01_r8,6.5761e-01_r8/) + kao(:, 3,10,13) = (/ & + &1.1158e+02_r8,9.7625e+01_r8,8.3679e+01_r8,6.9730e+01_r8,5.5786e+01_r8,4.1839e+01_r8, & + &2.7893e+01_r8,1.3953e+01_r8,1.0530e+00_r8/) + kao(:, 4,10,13) = (/ & + &1.4877e+02_r8,1.3018e+02_r8,1.1158e+02_r8,9.2984e+01_r8,7.4388e+01_r8,5.5791e+01_r8, & + &3.7194e+01_r8,1.8619e+01_r8,1.0469e+00_r8/) + kao(:, 5,10,13) = (/ & + &1.9259e+02_r8,1.6851e+02_r8,1.4444e+02_r8,1.2037e+02_r8,9.6298e+01_r8,7.2222e+01_r8, & + &4.8145e+01_r8,2.4115e+01_r8,9.0336e-01_r8/) + kao(:, 1,11,13) = (/ & + &1.0724e+02_r8,9.3834e+01_r8,8.0425e+01_r8,6.7028e+01_r8,5.3621e+01_r8,4.0215e+01_r8, & + &2.6808e+01_r8,1.3405e+01_r8,7.5947e-01_r8/) + kao(:, 2,11,13) = (/ & + &1.5135e+02_r8,1.3244e+02_r8,1.1352e+02_r8,9.4596e+01_r8,7.5677e+01_r8,5.6758e+01_r8, & + &3.7839e+01_r8,1.8919e+01_r8,7.7568e-01_r8/) + kao(:, 3,11,13) = (/ & + &2.0634e+02_r8,1.8056e+02_r8,1.5476e+02_r8,1.2896e+02_r8,1.0317e+02_r8,7.7384e+01_r8, & + &5.1587e+01_r8,2.5792e+01_r8,1.1446e+00_r8/) + kao(:, 4,11,13) = (/ & + &2.7388e+02_r8,2.3963e+02_r8,2.0540e+02_r8,1.7116e+02_r8,1.3692e+02_r8,1.0270e+02_r8, & + &6.8464e+01_r8,3.4233e+01_r8,1.4967e+00_r8/) + kao(:, 5,11,13) = (/ & + &3.5254e+02_r8,3.0844e+02_r8,2.6442e+02_r8,2.2035e+02_r8,1.7628e+02_r8,1.3220e+02_r8, & + &8.8134e+01_r8,4.4067e+01_r8,1.3951e+00_r8/) + kao(:, 1,12,13) = (/ & + &1.4929e+02_r8,1.3063e+02_r8,1.1197e+02_r8,9.3306e+01_r8,7.4648e+01_r8,5.5984e+01_r8, & + &3.7322e+01_r8,1.8661e+01_r8,7.7179e-01_r8/) + kao(:, 2,12,13) = (/ & + &2.1213e+02_r8,1.8562e+02_r8,1.5909e+02_r8,1.3258e+02_r8,1.0606e+02_r8,7.9546e+01_r8, & + &5.3033e+01_r8,2.6517e+01_r8,8.3102e-01_r8/) + kao(:, 3,12,13) = (/ & + &2.8848e+02_r8,2.5242e+02_r8,2.1635e+02_r8,1.8030e+02_r8,1.4425e+02_r8,1.0818e+02_r8, & + &7.2116e+01_r8,3.6059e+01_r8,1.2769e+00_r8/) + kao(:, 4,12,13) = (/ & + &3.7976e+02_r8,3.3226e+02_r8,2.8481e+02_r8,2.3733e+02_r8,1.8986e+02_r8,1.4240e+02_r8, & + &9.4932e+01_r8,4.7464e+01_r8,1.6812e+00_r8/) + kao(:, 5,12,13) = (/ & + &4.8508e+02_r8,4.2444e+02_r8,3.6380e+02_r8,3.0318e+02_r8,2.4253e+02_r8,1.8190e+02_r8, & + &1.2127e+02_r8,6.0633e+01_r8,1.6837e+00_r8/) + kao(:, 1,13,13) = (/ & + &1.6844e+02_r8,1.4739e+02_r8,1.2633e+02_r8,1.0528e+02_r8,8.4219e+01_r8,6.3167e+01_r8, & + &4.2110e+01_r8,2.1055e+01_r8,6.4746e-01_r8/) + kao(:, 2,13,13) = (/ & + &2.3974e+02_r8,2.0978e+02_r8,1.7981e+02_r8,1.4983e+02_r8,1.1987e+02_r8,8.9901e+01_r8, & + &5.9937e+01_r8,2.9967e+01_r8,7.7977e-01_r8/) + kao(:, 3,13,13) = (/ & + &3.2617e+02_r8,2.8540e+02_r8,2.4462e+02_r8,2.0386e+02_r8,1.6309e+02_r8,1.2231e+02_r8, & + &8.1544e+01_r8,4.0770e+01_r8,1.5118e+00_r8/) + kao(:, 4,13,13) = (/ & + &4.2665e+02_r8,3.7332e+02_r8,3.1999e+02_r8,2.6667e+02_r8,2.1333e+02_r8,1.5999e+02_r8, & + &1.0667e+02_r8,5.3332e+01_r8,1.6652e+00_r8/) + kao(:, 5,13,13) = (/ & + &5.4098e+02_r8,4.7336e+02_r8,4.0573e+02_r8,3.3811e+02_r8,2.7048e+02_r8,2.0286e+02_r8, & + &1.3525e+02_r8,6.7619e+01_r8,1.7274e+00_r8/) + kao(:, 1, 1,14) = (/ & + &1.4473e-01_r8,4.5196e-01_r8,8.9698e-01_r8,1.3316e+00_r8,1.7483e+00_r8,2.1329e+00_r8, & + &2.4492e+00_r8,2.5366e+00_r8,3.4967e+00_r8/) + kao(:, 2, 1,14) = (/ & + &1.6846e-01_r8,5.5554e-01_r8,1.1039e+00_r8,1.6417e+00_r8,2.1611e+00_r8,2.6456e+00_r8, & + &3.0463e+00_r8,3.1695e+00_r8,4.3222e+00_r8/) + kao(:, 3, 1,14) = (/ & + &1.9174e-01_r8,6.6749e-01_r8,1.3276e+00_r8,1.9756e+00_r8,2.6027e+00_r8,3.1886e+00_r8, & + &3.6789e+00_r8,3.8433e+00_r8,5.2055e+00_r8/) + kao(:, 4, 1,14) = (/ & + &2.1490e-01_r8,7.8476e-01_r8,1.5609e+00_r8,2.3233e+00_r8,3.0639e+00_r8,3.7563e+00_r8, & + &4.3396e+00_r8,4.5493e+00_r8,6.1279e+00_r8/) + kao(:, 5, 1,14) = (/ & + &2.3691e-01_r8,9.0765e-01_r8,1.8042e+00_r8,2.6834e+00_r8,3.5348e+00_r8,4.3362e+00_r8, & + &5.0160e+00_r8,5.2774e+00_r8,7.0696e+00_r8/) + kao(:, 1, 2,14) = (/ & + &2.1296e-01_r8,4.6215e-01_r8,9.1984e-01_r8,1.3706e+00_r8,1.8091e+00_r8,2.2245e+00_r8, & + &2.5860e+00_r8,2.7730e+00_r8,3.6182e+00_r8/) + kao(:, 2, 2,14) = (/ & + &2.5016e-01_r8,5.6432e-01_r8,1.1237e+00_r8,1.6756e+00_r8,2.2151e+00_r8,2.7294e+00_r8, & + &3.1864e+00_r8,3.4606e+00_r8,4.4301e+00_r8/) + kao(:, 3, 2,14) = (/ & + &2.8692e-01_r8,6.7375e-01_r8,1.3425e+00_r8,2.0033e+00_r8,2.6512e+00_r8,3.2743e+00_r8, & + &3.8384e+00_r8,4.2145e+00_r8,5.3023e+00_r8/) + kao(:, 4, 2,14) = (/ & + &3.2327e-01_r8,7.9645e-01_r8,1.5866e+00_r8,2.3669e+00_r8,3.1323e+00_r8,3.8679e+00_r8, & + &4.5425e+00_r8,5.0100e+00_r8,6.2645e+00_r8/) + kao(:, 5, 2,14) = (/ & + &3.5851e-01_r8,9.3518e-01_r8,1.8621e+00_r8,2.7777e+00_r8,3.6730e+00_r8,4.5297e+00_r8, & + &5.3029e+00_r8,5.8281e+00_r8,7.3458e+00_r8/) + kao(:, 1, 3,14) = (/ & + &4.0569e-01_r8,4.7346e-01_r8,9.0139e-01_r8,1.3483e+00_r8,1.7892e+00_r8,2.2204e+00_r8, & + &2.6252e+00_r8,2.9358e+00_r8,3.5784e+00_r8/) + kao(:, 2, 3,14) = (/ & + &4.8357e-01_r8,5.7585e-01_r8,1.1016e+00_r8,1.6482e+00_r8,2.1888e+00_r8,2.7185e+00_r8, & + &3.2205e+00_r8,3.6184e+00_r8,4.3777e+00_r8/) + kao(:, 3, 3,14) = (/ & + &5.6184e-01_r8,6.8539e-01_r8,1.3182e+00_r8,1.9726e+00_r8,2.6206e+00_r8,3.2555e+00_r8, & + &3.8616e+00_r8,4.3597e+00_r8,5.2411e+00_r8/) + kao(:, 4, 3,14) = (/ & + &6.3937e-01_r8,8.0074e-01_r8,1.5659e+00_r8,2.3420e+00_r8,3.1101e+00_r8,3.8617e+00_r8, & + &4.5735e+00_r8,5.1595e+00_r8,6.2201e+00_r8/) + kao(:, 5, 3,14) = (/ & + &7.1542e-01_r8,9.3290e-01_r8,1.8594e+00_r8,2.7803e+00_r8,3.6907e+00_r8,4.5815e+00_r8, & + &5.4228e+00_r8,6.0997e+00_r8,7.3811e+00_r8/) + kao(:, 1, 4,14) = (/ & + &7.7613e-01_r8,7.2482e-01_r8,8.8213e-01_r8,1.2906e+00_r8,1.7174e+00_r8,2.1406e+00_r8, & + &2.5536e+00_r8,2.9272e+00_r8,3.4348e+00_r8/) + kao(:, 2, 4,14) = (/ & + &9.4054e-01_r8,9.0136e-01_r8,1.0781e+00_r8,1.5850e+00_r8,2.1098e+00_r8,2.6295e+00_r8, & + &3.1372e+00_r8,3.6020e+00_r8,4.2194e+00_r8/) + kao(:, 3, 4,14) = (/ & + &1.1095e+00_r8,1.0843e+00_r8,1.2887e+00_r8,1.9170e+00_r8,2.5512e+00_r8,3.1791e+00_r8, & + &3.7919e+00_r8,4.3511e+00_r8,5.1021e+00_r8/) + kao(:, 4, 4,14) = (/ & + &1.2791e+00_r8,1.2603e+00_r8,1.5382e+00_r8,2.3038e+00_r8,3.0649e+00_r8,3.8173e+00_r8, & + &4.5513e+00_r8,5.2083e+00_r8,6.1294e+00_r8/) + kao(:, 5, 4,14) = (/ & + &1.4465e+00_r8,1.4292e+00_r8,1.8362e+00_r8,2.7499e+00_r8,3.6579e+00_r8,4.5561e+00_r8, & + &5.4280e+00_r8,6.2050e+00_r8,7.3150e+00_r8/) + kao(:, 1, 5,14) = (/ & + &1.3553e+00_r8,1.1859e+00_r8,1.1889e+00_r8,1.2820e+00_r8,1.6126e+00_r8,2.0133e+00_r8, & + &2.4100e+00_r8,2.7917e+00_r8,3.2251e+00_r8/) + kao(:, 2, 5,14) = (/ & + &1.6746e+00_r8,1.4653e+00_r8,1.4722e+00_r8,1.5790e+00_r8,2.0132e+00_r8,2.5133e+00_r8, & + &3.0071e+00_r8,3.4795e+00_r8,4.0262e+00_r8/) + kao(:, 3, 5,14) = (/ & + &2.0071e+00_r8,1.7563e+00_r8,1.7644e+00_r8,1.8926e+00_r8,2.4705e+00_r8,3.0826e+00_r8, & + &3.6880e+00_r8,4.2630e+00_r8,4.9404e+00_r8/) + kao(:, 4, 5,14) = (/ & + &2.3461e+00_r8,2.0539e+00_r8,2.0623e+00_r8,2.2628e+00_r8,3.0107e+00_r8,3.7562e+00_r8, & + &4.4918e+00_r8,5.1850e+00_r8,6.0203e+00_r8/) + kao(:, 5, 5,14) = (/ & + &2.6832e+00_r8,2.3569e+00_r8,2.3578e+00_r8,2.7266e+00_r8,3.6306e+00_r8,4.5292e+00_r8, & + &5.4146e+00_r8,6.2480e+00_r8,7.2595e+00_r8/) + kao(:, 1, 6,14) = (/ & + &2.1798e+00_r8,1.9076e+00_r8,1.6634e+00_r8,1.6610e+00_r8,1.6126e+00_r8,1.8086e+00_r8, & + &2.1681e+00_r8,2.5212e+00_r8,2.8955e+00_r8/) + kao(:, 2, 6,14) = (/ & + &2.7568e+00_r8,2.4124e+00_r8,2.1319e+00_r8,2.0890e+00_r8,2.0379e+00_r8,2.3402e+00_r8, & + &2.8045e+00_r8,3.2592e+00_r8,3.7464e+00_r8/) + kao(:, 3, 6,14) = (/ & + &3.3653e+00_r8,2.9447e+00_r8,2.6494e+00_r8,2.5260e+00_r8,2.4774e+00_r8,2.9464e+00_r8, & + &3.5300e+00_r8,4.0980e+00_r8,4.7178e+00_r8/) + kao(:, 4, 6,14) = (/ & + &3.9980e+00_r8,3.4981e+00_r8,3.2081e+00_r8,2.9759e+00_r8,2.9694e+00_r8,3.6441e+00_r8, & + &4.3643e+00_r8,5.0633e+00_r8,5.8364e+00_r8/) + kao(:, 5, 6,14) = (/ & + &4.6371e+00_r8,4.0569e+00_r8,3.7676e+00_r8,3.4231e+00_r8,3.5724e+00_r8,4.4465e+00_r8, & + &5.3245e+00_r8,6.1747e+00_r8,7.1186e+00_r8/) + kao(:, 1, 7,14) = (/ & + &3.6500e+00_r8,3.1940e+00_r8,2.7377e+00_r8,2.3521e+00_r8,2.2005e+00_r8,1.9226e+00_r8, & + &1.8951e+00_r8,2.2032e+00_r8,2.5224e+00_r8/) + kao(:, 2, 7,14) = (/ & + &4.7380e+00_r8,4.1460e+00_r8,3.5535e+00_r8,3.0746e+00_r8,2.8560e+00_r8,2.4862e+00_r8, & + &2.5325e+00_r8,2.9498e+00_r8,3.3790e+00_r8/) + kao(:, 3, 7,14) = (/ & + &5.9099e+00_r8,5.1713e+00_r8,4.4326e+00_r8,3.9038e+00_r8,3.5341e+00_r8,3.0823e+00_r8, & + &3.2930e+00_r8,3.8333e+00_r8,4.3949e+00_r8/) + kao(:, 4, 7,14) = (/ & + &7.1406e+00_r8,6.2480e+00_r8,5.3561e+00_r8,4.7936e+00_r8,4.2290e+00_r8,3.7296e+00_r8, & + &4.1867e+00_r8,4.8720e+00_r8,5.5890e+00_r8/) + kao(:, 5, 7,14) = (/ & + &8.4067e+00_r8,7.3559e+00_r8,6.3050e+00_r8,5.6953e+00_r8,4.9319e+00_r8,4.4981e+00_r8, & + &5.2053e+00_r8,6.0551e+00_r8,6.9478e+00_r8/) + kao(:, 1, 8,14) = (/ & + &7.2793e+00_r8,6.3695e+00_r8,5.4593e+00_r8,4.5496e+00_r8,3.6668e+00_r8,3.0739e+00_r8, & + &2.3812e+00_r8,1.8850e+00_r8,2.1414e+00_r8/) + kao(:, 2, 8,14) = (/ & + &9.7148e+00_r8,8.5004e+00_r8,7.2858e+00_r8,6.0719e+00_r8,4.9067e+00_r8,4.1050e+00_r8, & + &3.1504e+00_r8,2.5960e+00_r8,2.9698e+00_r8/) + kao(:, 3, 8,14) = (/ & + &1.2408e+01_r8,1.0858e+01_r8,9.3058e+00_r8,7.7549e+00_r8,6.3008e+00_r8,5.2586e+00_r8, & + &3.9820e+00_r8,3.4865e+00_r8,3.9886e+00_r8/) + kao(:, 4, 8,14) = (/ & + &1.5301e+01_r8,1.3388e+01_r8,1.1476e+01_r8,9.5632e+00_r8,7.8364e+00_r8,6.4696e+00_r8, & + &4.8601e+00_r8,4.5513e+00_r8,5.2081e+00_r8/) + kao(:, 5, 8,14) = (/ & + &1.8319e+01_r8,1.6029e+01_r8,1.3740e+01_r8,1.1449e+01_r8,9.4798e+00_r8,7.7150e+00_r8, & + &5.8215e+00_r8,5.7877e+00_r8,6.6226e+00_r8/) + kao(:, 1, 9,14) = (/ & + &2.7093e+01_r8,2.3706e+01_r8,2.0321e+01_r8,1.6934e+01_r8,1.3547e+01_r8,1.0161e+01_r8, & + &6.7735e+00_r8,3.8947e+00_r8,1.7904e+00_r8/) + kao(:, 2, 9,14) = (/ & + &3.7356e+01_r8,3.2687e+01_r8,2.8017e+01_r8,2.3347e+01_r8,1.8679e+01_r8,1.4008e+01_r8, & + &9.3393e+00_r8,5.3672e+00_r8,2.5563e+00_r8/) + kao(:, 3, 9,14) = (/ & + &4.9010e+01_r8,4.2883e+01_r8,3.6757e+01_r8,3.0630e+01_r8,2.4505e+01_r8,1.8379e+01_r8, & + &1.2257e+01_r8,7.0400e+00_r8,3.5347e+00_r8/) + kao(:, 4, 9,14) = (/ & + &6.1735e+01_r8,5.4018e+01_r8,4.6300e+01_r8,3.8583e+01_r8,3.0868e+01_r8,2.3150e+01_r8, & + &1.5458e+01_r8,8.8071e+00_r8,4.7393e+00_r8/) + kao(:, 5, 9,14) = (/ & + &7.5284e+01_r8,6.5873e+01_r8,5.6463e+01_r8,4.7052e+01_r8,3.7640e+01_r8,2.8233e+01_r8, & + &1.8889e+01_r8,1.0654e+01_r8,6.1635e+00_r8/) + kao(:, 1,10,14) = (/ & + &1.1501e+02_r8,1.0064e+02_r8,8.6262e+01_r8,7.1883e+01_r8,5.7506e+01_r8,4.3130e+01_r8, & + &2.8755e+01_r8,1.4378e+01_r8,5.7116e-01_r8/) + kao(:, 2,10,14) = (/ & + &1.6323e+02_r8,1.4283e+02_r8,1.2242e+02_r8,1.0202e+02_r8,8.1614e+01_r8,6.1213e+01_r8, & + &4.0807e+01_r8,2.0405e+01_r8,4.6944e-01_r8/) + kao(:, 3,10,14) = (/ & + &2.1950e+02_r8,1.9206e+02_r8,1.6462e+02_r8,1.3718e+02_r8,1.0975e+02_r8,8.2311e+01_r8, & + &5.4875e+01_r8,2.7438e+01_r8,1.0245e+00_r8/) + kao(:, 4,10,14) = (/ & + &2.8264e+02_r8,2.4730e+02_r8,2.1197e+02_r8,1.7666e+02_r8,1.4132e+02_r8,1.0599e+02_r8, & + &7.0664e+01_r8,3.5330e+01_r8,2.8560e+00_r8/) + kao(:, 5,10,14) = (/ & + &3.5102e+02_r8,3.0716e+02_r8,2.6326e+02_r8,2.1939e+02_r8,1.7551e+02_r8,1.3164e+02_r8, & + &8.7759e+01_r8,4.3879e+01_r8,5.5928e+00_r8/) + kao(:, 1,11,14) = (/ & + &2.0513e+02_r8,1.7948e+02_r8,1.5384e+02_r8,1.2821e+02_r8,1.0256e+02_r8,7.6924e+01_r8, & + &5.1281e+01_r8,2.5640e+01_r8,9.4489e-01_r8/) + kao(:, 2,11,14) = (/ & + &2.8915e+02_r8,2.5300e+02_r8,2.1687e+02_r8,1.8072e+02_r8,1.4458e+02_r8,1.0844e+02_r8, & + &7.2287e+01_r8,3.6146e+01_r8,1.0101e+00_r8/) + kao(:, 3,11,14) = (/ & + &3.8981e+02_r8,3.4108e+02_r8,2.9236e+02_r8,2.4364e+02_r8,1.9490e+02_r8,1.4617e+02_r8, & + &9.7460e+01_r8,4.8730e+01_r8,5.8913e-01_r8/) + kao(:, 4,11,14) = (/ & + &5.0429e+02_r8,4.4124e+02_r8,3.7819e+02_r8,3.1515e+02_r8,2.5212e+02_r8,1.8910e+02_r8, & + &1.2606e+02_r8,6.3034e+01_r8,1.0227e+00_r8/) + kao(:, 5,11,14) = (/ & + &6.2985e+02_r8,5.5113e+02_r8,4.7241e+02_r8,3.9368e+02_r8,3.1495e+02_r8,2.3621e+02_r8, & + &1.5747e+02_r8,7.8734e+01_r8,3.1704e+00_r8/) + kao(:, 1,12,14) = (/ & + &2.7480e+02_r8,2.4043e+02_r8,2.0609e+02_r8,1.7173e+02_r8,1.3740e+02_r8,1.0305e+02_r8, & + &6.8696e+01_r8,3.4350e+01_r8,1.0331e+00_r8/) + kao(:, 2,12,14) = (/ & + &3.8434e+02_r8,3.3629e+02_r8,2.8824e+02_r8,2.4020e+02_r8,1.9217e+02_r8,1.4412e+02_r8, & + &9.6082e+01_r8,4.8041e+01_r8,1.0697e+00_r8/) + kao(:, 3,12,14) = (/ & + &5.1835e+02_r8,4.5357e+02_r8,3.8876e+02_r8,3.2398e+02_r8,2.5917e+02_r8,1.9438e+02_r8, & + &1.2959e+02_r8,6.4795e+01_r8,6.6152e-01_r8/) + kao(:, 4,12,14) = (/ & + &6.7292e+02_r8,5.8878e+02_r8,5.0467e+02_r8,4.2055e+02_r8,3.3645e+02_r8,2.5234e+02_r8, & + &1.6823e+02_r8,8.4112e+01_r8,1.1390e+00_r8/) + kao(:, 5,12,14) = (/ & + &8.4273e+02_r8,7.3739e+02_r8,6.3205e+02_r8,5.2668e+02_r8,4.2135e+02_r8,3.1602e+02_r8, & + &2.1069e+02_r8,1.0534e+02_r8,2.2409e+00_r8/) + kao(:, 1,13,14) = (/ & + &2.9725e+02_r8,2.6009e+02_r8,2.2295e+02_r8,1.8578e+02_r8,1.4862e+02_r8,1.1147e+02_r8, & + &7.4314e+01_r8,3.7158e+01_r8,8.5883e-01_r8/) + kao(:, 2,13,14) = (/ & + &4.1294e+02_r8,3.6134e+02_r8,3.0971e+02_r8,2.5809e+02_r8,2.0649e+02_r8,1.5487e+02_r8, & + &1.0324e+02_r8,5.1621e+01_r8,7.4403e-01_r8/) + kao(:, 3,13,14) = (/ & + &5.5484e+02_r8,4.8548e+02_r8,4.1611e+02_r8,3.4677e+02_r8,2.7741e+02_r8,2.0806e+02_r8, & + &1.3871e+02_r8,6.9351e+01_r8,6.5779e-01_r8/) + kao(:, 4,13,14) = (/ & + &7.2016e+02_r8,6.3017e+02_r8,5.4015e+02_r8,4.5013e+02_r8,3.6010e+02_r8,2.7007e+02_r8, & + &1.8004e+02_r8,9.0025e+01_r8,1.1133e+00_r8/) + kao(:, 5,13,14) = (/ & + &9.0551e+02_r8,7.9235e+02_r8,6.7916e+02_r8,5.6596e+02_r8,4.5276e+02_r8,3.3958e+02_r8, & + &2.2638e+02_r8,1.1319e+02_r8,2.5474e+00_r8/) + kao(:, 1, 1,15) = (/ & + &1.6993e-01_r8,6.2319e-01_r8,1.2302e+00_r8,1.8117e+00_r8,2.3534e+00_r8,2.8224e+00_r8, & + &3.1427e+00_r8,3.0683e+00_r8,4.7067e+00_r8/) + kao(:, 2, 1,15) = (/ & + &1.9652e-01_r8,7.8355e-01_r8,1.5463e+00_r8,2.2775e+00_r8,2.9572e+00_r8,3.5450e+00_r8, & + &3.9419e+00_r8,3.8320e+00_r8,5.9144e+00_r8/) + kao(:, 3, 1,15) = (/ & + &2.2200e-01_r8,9.5617e-01_r8,1.8872e+00_r8,2.7806e+00_r8,3.6114e+00_r8,4.3315e+00_r8, & + &4.8212e+00_r8,4.6828e+00_r8,7.2228e+00_r8/) + kao(:, 4, 1,15) = (/ & + &2.4720e-01_r8,1.1411e+00_r8,2.2528e+00_r8,3.3193e+00_r8,4.3116e+00_r8,5.1713e+00_r8, & + &5.7552e+00_r8,5.5959e+00_r8,8.6231e+00_r8/) + kao(:, 5, 1,15) = (/ & + &2.7067e-01_r8,1.3368e+00_r8,2.6392e+00_r8,3.8885e+00_r8,5.0531e+00_r8,6.0617e+00_r8, & + &6.7490e+00_r8,6.5681e+00_r8,1.0106e+01_r8/) + kao(:, 1, 2,15) = (/ & + &2.5495e-01_r8,6.7714e-01_r8,1.3429e+00_r8,1.9911e+00_r8,2.6102e+00_r8,3.1741e+00_r8, & + &3.6176e+00_r8,3.6989e+00_r8,5.2204e+00_r8/) + kao(:, 2, 2,15) = (/ & + &2.9713e-01_r8,8.6139e-01_r8,1.7085e+00_r8,2.5326e+00_r8,3.3191e+00_r8,4.0358e+00_r8, & + &4.5977e+00_r8,4.6904e+00_r8,6.6382e+00_r8/) + kao(:, 3, 2,15) = (/ & + &3.3791e-01_r8,1.0632e+00_r8,2.1089e+00_r8,3.1273e+00_r8,4.0996e+00_r8,4.9862e+00_r8, & + &5.6823e+00_r8,5.7948e+00_r8,8.1990e+00_r8/) + kao(:, 4, 2,15) = (/ & + &3.7751e-01_r8,1.2778e+00_r8,2.5347e+00_r8,3.7591e+00_r8,4.9277e+00_r8,5.9944e+00_r8, & + &6.8345e+00_r8,6.9830e+00_r8,9.8554e+00_r8/) + kao(:, 5, 2,15) = (/ & + &4.1544e-01_r8,1.5054e+00_r8,2.9855e+00_r8,4.4278e+00_r8,5.8067e+00_r8,7.0647e+00_r8, & + &8.0557e+00_r8,8.2364e+00_r8,1.1613e+01_r8/) + kao(:, 1, 3,15) = (/ & + &4.9608e-01_r8,6.8984e-01_r8,1.3746e+00_r8,2.0502e+00_r8,2.7121e+00_r8,3.3455e+00_r8, & + &3.9122e+00_r8,4.2490e+00_r8,5.4242e+00_r8/) + kao(:, 2, 3,15) = (/ & + &5.8591e-01_r8,8.9422e-01_r8,1.7812e+00_r8,2.6579e+00_r8,3.5151e+00_r8,4.3360e+00_r8, & + &5.0694e+00_r8,5.5020e+00_r8,7.0303e+00_r8/) + kao(:, 3, 3,15) = (/ & + &6.7409e-01_r8,1.1231e+00_r8,2.2377e+00_r8,3.3379e+00_r8,4.4153e+00_r8,5.4452e+00_r8, & + &6.3666e+00_r8,6.9097e+00_r8,8.8307e+00_r8/) + kao(:, 4, 3,15) = (/ & + &7.5926e-01_r8,1.3688e+00_r8,2.7271e+00_r8,4.0692e+00_r8,5.3814e+00_r8,6.6410e+00_r8, & + &7.7706e+00_r8,8.4452e+00_r8,1.0763e+01_r8/) + kao(:, 5, 3,15) = (/ & + &8.4200e-01_r8,1.6284e+00_r8,3.2443e+00_r8,4.8405e+00_r8,6.4040e+00_r8,7.9036e+00_r8, & + &9.2460e+00_r8,1.0057e+01_r8,1.2808e+01_r8/) + kao(:, 1, 4,15) = (/ & + &9.7215e-01_r8,8.5067e-01_r8,1.3532e+00_r8,2.0247e+00_r8,2.6895e+00_r8,3.3419e+00_r8, & + &3.9624e+00_r8,4.4662e+00_r8,5.3791e+00_r8/) + kao(:, 2, 4,15) = (/ & + &1.1632e+00_r8,1.0264e+00_r8,1.7937e+00_r8,2.6847e+00_r8,3.5667e+00_r8,4.4317e+00_r8, & + &5.2538e+00_r8,5.9212e+00_r8,7.1333e+00_r8/) + kao(:, 3, 4,15) = (/ & + &1.3574e+00_r8,1.2217e+00_r8,2.2951e+00_r8,3.4352e+00_r8,4.5625e+00_r8,5.6686e+00_r8, & + &6.7222e+00_r8,7.5788e+00_r8,9.1250e+00_r8/) + kao(:, 4, 4,15) = (/ & + &1.5473e+00_r8,1.4621e+00_r8,2.8487e+00_r8,4.2635e+00_r8,5.6651e+00_r8,7.0387e+00_r8, & + &8.3491e+00_r8,9.4177e+00_r8,1.1330e+01_r8/) + kao(:, 5, 4,15) = (/ & + &1.7305e+00_r8,1.7312e+00_r8,3.4330e+00_r8,5.1366e+00_r8,6.8257e+00_r8,8.4825e+00_r8, & + &1.0065e+01_r8,1.1356e+01_r8,1.3651e+01_r8/) + kao(:, 1, 5,15) = (/ & + &1.7388e+00_r8,1.5215e+00_r8,1.3772e+00_r8,1.9641e+00_r8,2.6140e+00_r8,3.2573e+00_r8, & + &3.8853e+00_r8,4.4515e+00_r8,5.2280e+00_r8/) + kao(:, 2, 5,15) = (/ & + &2.1169e+00_r8,1.8521e+00_r8,1.7962e+00_r8,2.6470e+00_r8,3.5230e+00_r8,4.3915e+00_r8, & + &5.2396e+00_r8,6.0117e+00_r8,7.0460e+00_r8/) + kao(:, 3, 5,15) = (/ & + &2.5041e+00_r8,2.1909e+00_r8,2.3110e+00_r8,3.4553e+00_r8,4.5986e+00_r8,5.7308e+00_r8, & + &6.8405e+00_r8,7.8473e+00_r8,9.1972e+00_r8/) + kao(:, 4, 5,15) = (/ & + &2.8915e+00_r8,2.5301e+00_r8,2.9136e+00_r8,4.3640e+00_r8,5.8101e+00_r8,7.2418e+00_r8, & + &8.6447e+00_r8,9.9184e+00_r8,1.1620e+01_r8/) + kao(:, 5, 5,15) = (/ & + &3.2655e+00_r8,2.8574e+00_r8,3.5660e+00_r8,5.3438e+00_r8,7.1123e+00_r8,8.8675e+00_r8, & + &1.0583e+01_r8,1.2152e+01_r8,1.4224e+01_r8/) + kao(:, 1, 6,15) = (/ & + &2.8657e+00_r8,2.5077e+00_r8,2.1495e+00_r8,1.9426e+00_r8,2.5509e+00_r8,3.1827e+00_r8, & + &3.8069e+00_r8,4.3973e+00_r8,5.1017e+00_r8/) + kao(:, 2, 6,15) = (/ & + &3.5656e+00_r8,3.1200e+00_r8,2.6742e+00_r8,2.5857e+00_r8,3.4175e+00_r8,4.2650e+00_r8, & + &5.1021e+00_r8,5.8962e+00_r8,6.8350e+00_r8/) + kao(:, 3, 6,15) = (/ & + &4.2807e+00_r8,3.7458e+00_r8,3.2105e+00_r8,3.3891e+00_r8,4.4929e+00_r8,5.6082e+00_r8, & + &6.7100e+00_r8,7.7616e+00_r8,8.9857e+00_r8/) + kao(:, 4, 6,15) = (/ & + &5.0170e+00_r8,4.3893e+00_r8,3.7667e+00_r8,4.3378e+00_r8,5.7738e+00_r8,7.2087e+00_r8, & + &8.6270e+00_r8,9.9837e+00_r8,1.1548e+01_r8/) + kao(:, 5, 6,15) = (/ & + &5.7403e+00_r8,5.0226e+00_r8,4.3725e+00_r8,5.3984e+00_r8,7.1936e+00_r8,8.9774e+00_r8, & + &1.0747e+01_r8,1.2440e+01_r8,1.4387e+01_r8/) + kao(:, 1, 7,15) = (/ & + &4.9113e+00_r8,4.2974e+00_r8,3.6835e+00_r8,3.0697e+00_r8,2.6153e+00_r8,3.1091e+00_r8, & + &3.7251e+00_r8,4.3239e+00_r8,4.9783e+00_r8/) + kao(:, 2, 7,15) = (/ & + &6.2562e+00_r8,5.4743e+00_r8,4.6920e+00_r8,3.9102e+00_r8,3.4334e+00_r8,4.1812e+00_r8, & + &5.0095e+00_r8,5.8168e+00_r8,6.6958e+00_r8/) + kao(:, 3, 7,15) = (/ & + &7.6604e+00_r8,6.7031e+00_r8,5.7453e+00_r8,4.7880e+00_r8,4.4844e+00_r8,5.5063e+00_r8, & + &6.5975e+00_r8,7.6628e+00_r8,8.8178e+00_r8/) + kao(:, 4, 7,15) = (/ & + &9.1018e+00_r8,7.9643e+00_r8,6.8268e+00_r8,5.7331e+00_r8,5.7498e+00_r8,7.0854e+00_r8, & + &8.4900e+00_r8,9.8659e+00_r8,1.1347e+01_r8/) + kao(:, 5, 7,15) = (/ & + &1.0558e+01_r8,9.2378e+00_r8,7.9183e+00_r8,6.7553e+00_r8,7.1878e+00_r8,8.8933e+00_r8, & + &1.0658e+01_r8,1.2385e+01_r8,1.4238e+01_r8/) + kao(:, 1, 8,15) = (/ & + &1.0009e+01_r8,8.7571e+00_r8,7.5061e+00_r8,6.2547e+00_r8,5.0042e+00_r8,3.7993e+00_r8, & + &3.6112e+00_r8,4.2052e+00_r8,4.8194e+00_r8/) + kao(:, 2, 8,15) = (/ & + &1.3089e+01_r8,1.1454e+01_r8,9.8171e+00_r8,8.1811e+00_r8,6.5451e+00_r8,5.0064e+00_r8, & + &4.9059e+00_r8,5.7129e+00_r8,6.5481e+00_r8/) + kao(:, 3, 8,15) = (/ & + &1.6387e+01_r8,1.4339e+01_r8,1.2290e+01_r8,1.0242e+01_r8,8.1941e+00_r8,6.3517e+00_r8, & + &6.5066e+00_r8,7.5778e+00_r8,8.6840e+00_r8/) + kao(:, 4, 8,15) = (/ & + &1.9809e+01_r8,1.7333e+01_r8,1.4856e+01_r8,1.2381e+01_r8,9.9047e+00_r8,7.9569e+00_r8, & + &8.4189e+00_r8,9.8052e+00_r8,1.1235e+01_r8/) + kao(:, 5, 8,15) = (/ & + &2.3310e+01_r8,2.0396e+01_r8,1.7482e+01_r8,1.4569e+01_r8,1.1654e+01_r8,9.7998e+00_r8, & + &1.0613e+01_r8,1.2362e+01_r8,1.4162e+01_r8/) + kao(:, 1, 9,15) = (/ & + &3.8130e+01_r8,3.3362e+01_r8,2.8596e+01_r8,2.3830e+01_r8,1.9065e+01_r8,1.4298e+01_r8, & + &9.5322e+00_r8,4.9254e+00_r8,4.5210e+00_r8/) + kao(:, 2, 9,15) = (/ & + &5.1350e+01_r8,4.4933e+01_r8,3.8514e+01_r8,3.2094e+01_r8,2.5677e+01_r8,1.9258e+01_r8, & + &1.2838e+01_r8,6.6242e+00_r8,6.3225e+00_r8/) + kao(:, 3, 9,15) = (/ & + &6.5865e+01_r8,5.7633e+01_r8,4.9398e+01_r8,4.1167e+01_r8,3.2931e+01_r8,2.4701e+01_r8, & + &1.6465e+01_r8,8.5406e+00_r8,8.4711e+00_r8/) + kao(:, 4, 9,15) = (/ & + &8.1194e+01_r8,7.1041e+01_r8,6.0891e+01_r8,5.0738e+01_r8,4.0591e+01_r8,3.0449e+01_r8, & + &2.0297e+01_r8,1.0902e+01_r8,1.1050e+01_r8/) + kao(:, 5, 9,15) = (/ & + &9.6976e+01_r8,8.4851e+01_r8,7.2734e+01_r8,6.0609e+01_r8,4.8485e+01_r8,3.6366e+01_r8, & + &2.4244e+01_r8,1.3609e+01_r8,1.4022e+01_r8/) + kao(:, 1,10,15) = (/ & + &1.6495e+02_r8,1.4434e+02_r8,1.2371e+02_r8,1.0308e+02_r8,8.2478e+01_r8,6.1862e+01_r8, & + &4.1240e+01_r8,2.0620e+01_r8,1.6305e+00_r8/) + kao(:, 2,10,15) = (/ & + &2.2828e+02_r8,1.9973e+02_r8,1.7121e+02_r8,1.4267e+02_r8,1.1414e+02_r8,8.5604e+01_r8, & + &5.7062e+01_r8,2.8536e+01_r8,5.3393e+00_r8/) + kao(:, 3,10,15) = (/ & + &2.9925e+02_r8,2.6184e+02_r8,2.2444e+02_r8,1.8703e+02_r8,1.4963e+02_r8,1.1222e+02_r8, & + &7.4815e+01_r8,3.7408e+01_r8,8.3308e+00_r8/) + kao(:, 4,10,15) = (/ & + &3.7719e+02_r8,3.3003e+02_r8,2.8287e+02_r8,2.3573e+02_r8,1.8859e+02_r8,1.4144e+02_r8, & + &9.4294e+01_r8,4.7146e+01_r8,1.0953e+01_r8/) + kao(:, 5,10,15) = (/ & + &4.5955e+02_r8,4.0214e+02_r8,3.4467e+02_r8,2.8724e+02_r8,2.2979e+02_r8,1.7235e+02_r8, & + &1.1490e+02_r8,5.7448e+01_r8,1.3975e+01_r8/) + kao(:, 1,11,15) = (/ & + &2.9347e+02_r8,2.5677e+02_r8,2.2010e+02_r8,1.8342e+02_r8,1.4673e+02_r8,1.1005e+02_r8, & + &7.3365e+01_r8,3.6685e+01_r8,2.5030e-01_r8/) + kao(:, 2,11,15) = (/ & + &4.0846e+02_r8,3.5738e+02_r8,3.0635e+02_r8,2.5530e+02_r8,2.0423e+02_r8,1.5319e+02_r8, & + &1.0212e+02_r8,5.1058e+01_r8,2.2261e+00_r8/) + kao(:, 3,11,15) = (/ & + &5.3934e+02_r8,4.7191e+02_r8,4.0450e+02_r8,3.3708e+02_r8,2.6969e+02_r8,2.0225e+02_r8, & + &1.3483e+02_r8,6.7419e+01_r8,7.0745e+00_r8/) + kao(:, 4,11,15) = (/ & + &6.8280e+02_r8,5.9745e+02_r8,5.1209e+02_r8,4.2676e+02_r8,3.4141e+02_r8,2.5605e+02_r8, & + &1.7070e+02_r8,8.5353e+01_r8,1.1909e+01_r8/) + kao(:, 5,11,15) = (/ & + &8.3619e+02_r8,7.3167e+02_r8,6.2713e+02_r8,5.2262e+02_r8,4.1810e+02_r8,3.1359e+02_r8, & + &2.0904e+02_r8,1.0453e+02_r8,1.5372e+01_r8/) + kao(:, 1,12,15) = (/ & + &3.9587e+02_r8,3.4637e+02_r8,2.9690e+02_r8,2.4742e+02_r8,1.9794e+02_r8,1.4844e+02_r8, & + &9.8964e+01_r8,4.9484e+01_r8,3.4642e-05_r8/) + kao(:, 2,12,15) = (/ & + &5.5272e+02_r8,4.8359e+02_r8,4.1455e+02_r8,3.4543e+02_r8,2.7636e+02_r8,2.0725e+02_r8, & + &1.3818e+02_r8,6.9086e+01_r8,1.7207e+00_r8/) + kao(:, 3,12,15) = (/ & + &7.3408e+02_r8,6.4226e+02_r8,5.5052e+02_r8,4.5884e+02_r8,3.6704e+02_r8,2.7529e+02_r8, & + &1.8352e+02_r8,9.1757e+01_r8,6.4555e+00_r8/) + kao(:, 4,12,15) = (/ & + &9.3778e+02_r8,8.2044e+02_r8,7.0331e+02_r8,5.8607e+02_r8,4.6883e+02_r8,3.5166e+02_r8, & + &2.3443e+02_r8,1.1722e+02_r8,1.0884e+01_r8/) + kao(:, 5,12,15) = (/ & + &1.1629e+03_r8,1.0175e+03_r8,8.7216e+02_r8,7.2684e+02_r8,5.8142e+02_r8,4.3609e+02_r8, & + &2.9073e+02_r8,1.4537e+02_r8,1.6871e+01_r8/) + kao(:, 1,13,15) = (/ & + &4.3408e+02_r8,3.7980e+02_r8,3.2553e+02_r8,2.7129e+02_r8,2.1704e+02_r8,1.6278e+02_r8, & + &1.0851e+02_r8,5.4254e+01_r8,3.3387e-01_r8/) + kao(:, 2,13,15) = (/ & + &6.1113e+02_r8,5.3482e+02_r8,4.5841e+02_r8,3.8201e+02_r8,3.0560e+02_r8,2.2920e+02_r8, & + &1.5279e+02_r8,7.6397e+01_r8,3.4060e+00_r8/) + kao(:, 3,13,15) = (/ & + &8.2033e+02_r8,7.1780e+02_r8,6.1525e+02_r8,5.1272e+02_r8,4.1017e+02_r8,3.0764e+02_r8, & + &2.0509e+02_r8,1.0254e+02_r8,7.3848e+00_r8/) + kao(:, 4,13,15) = (/ & + &1.0623e+03_r8,9.2952e+02_r8,7.9671e+02_r8,6.6390e+02_r8,5.3111e+02_r8,3.9834e+02_r8, & + &2.6556e+02_r8,1.3278e+02_r8,1.3310e+01_r8/) + kao(:, 5,13,15) = (/ & + &1.3308e+03_r8,1.1645e+03_r8,9.9813e+02_r8,8.3174e+02_r8,6.6542e+02_r8,4.9907e+02_r8, & + &3.3271e+02_r8,1.6635e+02_r8,1.8499e+01_r8/) + kao(:, 1, 1,16) = (/ & + &1.7254e-01_r8,6.6462e-01_r8,1.3115e+00_r8,1.9318e+00_r8,2.5084e+00_r8,3.0076e+00_r8, & + &3.3449e+00_r8,3.2523e+00_r8,5.0169e+00_r8/) + kao(:, 2, 1,16) = (/ & + &1.9945e-01_r8,8.1688e-01_r8,1.6118e+00_r8,2.3741e+00_r8,3.0836e+00_r8,3.6966e+00_r8, & + &4.1116e+00_r8,3.9980e+00_r8,6.1673e+00_r8/) + kao(:, 3, 1,16) = (/ & + &2.2510e-01_r8,1.0070e+00_r8,1.9841e+00_r8,2.9159e+00_r8,3.7748e+00_r8,4.5037e+00_r8, & + &4.9689e+00_r8,4.7883e+00_r8,7.5495e+00_r8/) + kao(:, 4, 1,16) = (/ & + &2.5048e-01_r8,1.2252e+00_r8,2.4140e+00_r8,3.5479e+00_r8,4.5928e+00_r8,5.4806e+00_r8, & + &6.0471e+00_r8,5.7831e+00_r8,9.1856e+00_r8/) + kao(:, 5, 1,16) = (/ & + &2.7413e-01_r8,1.4585e+00_r8,2.8735e+00_r8,4.2233e+00_r8,5.4678e+00_r8,6.4913e+00_r8, & + &7.1996e+00_r8,6.8835e+00_r8,1.0936e+01_r8/) + kao(:, 1, 2,16) = (/ & + &2.5949e-01_r8,7.4073e-01_r8,1.4685e+00_r8,2.1764e+00_r8,2.8509e+00_r8,3.4639e+00_r8, & + &3.9405e+00_r8,4.0097e+00_r8,5.7017e+00_r8/) + kao(:, 2, 2,16) = (/ & + &3.0220e-01_r8,9.2128e-01_r8,1.8172e+00_r8,2.6931e+00_r8,3.5460e+00_r8,4.3080e+00_r8, & + &4.9007e+00_r8,4.9876e+00_r8,7.0918e+00_r8/) + kao(:, 3, 2,16) = (/ & + &3.4341e-01_r8,1.1291e+00_r8,2.2360e+00_r8,3.3088e+00_r8,4.3252e+00_r8,5.2383e+00_r8, & + &5.9360e+00_r8,6.0318e+00_r8,8.6502e+00_r8/) + kao(:, 4, 2,16) = (/ & + &3.8325e-01_r8,1.3874e+00_r8,2.7481e+00_r8,4.0666e+00_r8,5.3159e+00_r8,6.4367e+00_r8, & + &7.2790e+00_r8,7.3059e+00_r8,1.0632e+01_r8/) + kao(:, 5, 2,16) = (/ & + &4.2153e-01_r8,1.6660e+00_r8,3.2992e+00_r8,4.8823e+00_r8,6.3819e+00_r8,7.7290e+00_r8, & + &8.7410e+00_r8,8.7737e+00_r8,1.2764e+01_r8/) + kao(:, 1, 3,16) = (/ & + &5.0644e-01_r8,7.8255e-01_r8,1.5587e+00_r8,2.3239e+00_r8,3.0716e+00_r8,3.7848e+00_r8, & + &4.4177e+00_r8,4.7740e+00_r8,6.1431e+00_r8/) + kao(:, 2, 3,16) = (/ & + &5.9759e-01_r8,9.9169e-01_r8,1.9751e+00_r8,2.9450e+00_r8,3.8926e+00_r8,4.7966e+00_r8, & + &5.5986e+00_r8,6.0493e+00_r8,7.7852e+00_r8/) + kao(:, 3, 3,16) = (/ & + &6.8696e-01_r8,1.2186e+00_r8,2.4265e+00_r8,3.6186e+00_r8,4.7825e+00_r8,5.8630e+00_r8, & + &6.8786e+00_r8,7.4328e+00_r8,9.5649e+00_r8/) + kao(:, 4, 3,16) = (/ & + &7.7291e-01_r8,1.5044e+00_r8,2.9942e+00_r8,4.4622e+00_r8,5.8918e+00_r8,7.2471e+00_r8, & + &8.4308e+00_r8,9.0321e+00_r8,1.1784e+01_r8/) + kao(:, 5, 3,16) = (/ & + &8.5655e-01_r8,1.8308e+00_r8,3.6443e+00_r8,5.4303e+00_r8,7.1696e+00_r8,8.8191e+00_r8, & + &1.0261e+01_r8,1.0994e+01_r8,1.4339e+01_r8/) + kao(:, 1, 4,16) = (/ & + &9.9660e-01_r8,8.7187e-01_r8,1.6058e+00_r8,2.4020e+00_r8,3.1900e+00_r8,3.9596e+00_r8, & + &4.6884e+00_r8,5.2602e+00_r8,6.3800e+00_r8/) + kao(:, 2, 4,16) = (/ & + &1.1909e+00_r8,1.0454e+00_r8,2.0813e+00_r8,3.1135e+00_r8,4.1338e+00_r8,5.1320e+00_r8, & + &6.0754e+00_r8,6.8176e+00_r8,8.2675e+00_r8/) + kao(:, 3, 4,16) = (/ & + &1.3883e+00_r8,1.3053e+00_r8,2.6054e+00_r8,3.8972e+00_r8,5.1746e+00_r8,6.4245e+00_r8, & + &7.6056e+00_r8,8.5415e+00_r8,1.0349e+01_r8/) + kao(:, 4, 4,16) = (/ & + &1.5813e+00_r8,1.6017e+00_r8,3.1965e+00_r8,4.7803e+00_r8,6.3446e+00_r8,7.8728e+00_r8, & + &9.3118e+00_r8,1.0423e+01_r8,1.2689e+01_r8/) + kao(:, 5, 4,16) = (/ & + &1.7666e+00_r8,1.9742e+00_r8,3.9398e+00_r8,5.8918e+00_r8,7.8191e+00_r8,9.6976e+00_r8, & + &1.1463e+01_r8,1.2804e+01_r8,1.5638e+01_r8/) + kao(:, 1, 5,16) = (/ & + &1.7905e+00_r8,1.5668e+00_r8,1.6306e+00_r8,2.4424e+00_r8,3.2499e+00_r8,4.0478e+00_r8, & + &4.8237e+00_r8,5.5141e+00_r8,6.4998e+00_r8/) + kao(:, 2, 5,16) = (/ & + &2.1763e+00_r8,1.9041e+00_r8,2.1658e+00_r8,3.2440e+00_r8,4.3166e+00_r8,5.3771e+00_r8, & + &6.4071e+00_r8,7.3247e+00_r8,8.6332e+00_r8/) + kao(:, 3, 5,16) = (/ & + &2.5702e+00_r8,2.2488e+00_r8,2.7671e+00_r8,4.1446e+00_r8,5.5145e+00_r8,6.8692e+00_r8, & + &8.1862e+00_r8,9.3584e+00_r8,1.1029e+01_r8/) + kao(:, 4, 5,16) = (/ & + &2.9652e+00_r8,2.5941e+00_r8,3.4291e+00_r8,5.1370e+00_r8,6.8346e+00_r8,8.5115e+00_r8, & + &1.0142e+01_r8,1.1590e+01_r8,1.3669e+01_r8/) + kao(:, 5, 5,16) = (/ & + &3.3442e+00_r8,2.9260e+00_r8,4.2225e+00_r8,6.3231e+00_r8,8.4117e+00_r8,1.0473e+01_r8, & + &1.2473e+01_r8,1.4226e+01_r8,1.6823e+01_r8/) + kao(:, 1, 6,16) = (/ & + &2.9659e+00_r8,2.5957e+00_r8,2.2251e+00_r8,2.4192e+00_r8,3.2212e+00_r8,4.0191e+00_r8, & + &4.8055e+00_r8,5.5432e+00_r8,6.4424e+00_r8/) + kao(:, 2, 6,16) = (/ & + &3.6832e+00_r8,3.2223e+00_r8,2.7616e+00_r8,3.3057e+00_r8,4.4026e+00_r8,5.4931e+00_r8, & + &6.5666e+00_r8,7.5768e+00_r8,8.8051e+00_r8/) + kao(:, 3, 6,16) = (/ & + &4.4116e+00_r8,3.8604e+00_r8,3.3096e+00_r8,4.3238e+00_r8,5.7589e+00_r8,7.1852e+00_r8, & + &8.5905e+00_r8,9.9138e+00_r8,1.1518e+01_r8/) + kao(:, 4, 6,16) = (/ & + &5.1628e+00_r8,4.5167e+00_r8,3.8530e+00_r8,5.4598e+00_r8,7.2711e+00_r8,9.0722e+00_r8, & + &1.0846e+01_r8,1.2515e+01_r8,1.4542e+01_r8/) + kao(:, 5, 6,16) = (/ & + &5.8968e+00_r8,5.1602e+00_r8,4.5054e+00_r8,6.7527e+00_r8,8.9935e+00_r8,1.1218e+01_r8, & + &1.3409e+01_r8,1.5457e+01_r8,1.7987e+01_r8/) + kao(:, 1, 7,16) = (/ & + &5.1220e+00_r8,4.4578e+00_r8,3.8412e+00_r8,3.1847e+00_r8,3.1367e+00_r8,3.9170e+00_r8, & + &4.6915e+00_r8,5.4417e+00_r8,6.2734e+00_r8/) + kao(:, 2, 7,16) = (/ & + &6.5146e+00_r8,5.7005e+00_r8,4.8852e+00_r8,4.0720e+00_r8,4.4224e+00_r8,5.5237e+00_r8, & + &6.6151e+00_r8,7.6744e+00_r8,8.8447e+00_r8/) + kao(:, 3, 7,16) = (/ & + &7.9642e+00_r8,6.9679e+00_r8,5.9715e+00_r8,4.9772e+00_r8,5.9352e+00_r8,7.4116e+00_r8, & + &8.8775e+00_r8,1.0298e+01_r8,1.1870e+01_r8/) + kao(:, 4, 7,16) = (/ & + &9.4454e+00_r8,8.2650e+00_r8,7.0847e+00_r8,5.9047e+00_r8,7.6537e+00_r8,9.5584e+00_r8, & + &1.1448e+01_r8,1.3281e+01_r8,1.5307e+01_r8/) + kao(:, 5, 7,16) = (/ & + &1.0942e+01_r8,9.5731e+00_r8,8.2052e+00_r8,7.1985e+00_r8,9.5915e+00_r8,1.1978e+01_r8, & + &1.4344e+01_r8,1.6634e+01_r8,1.9183e+01_r8/) + kao(:, 1, 8,16) = (/ & + &1.0533e+01_r8,9.2146e+00_r8,7.8983e+00_r8,6.5814e+00_r8,5.2661e+00_r8,3.9493e+00_r8, & + &4.5315e+00_r8,5.2737e+00_r8,6.0497e+00_r8/) + kao(:, 2, 8,16) = (/ & + &1.3750e+01_r8,1.2032e+01_r8,1.0313e+01_r8,8.5934e+00_r8,6.8745e+00_r8,5.4846e+00_r8, & + &6.5763e+00_r8,7.6139e+00_r8,8.7787e+00_r8/) + kao(:, 3, 8,16) = (/ & + &1.7175e+01_r8,1.5029e+01_r8,1.2881e+01_r8,1.0735e+01_r8,8.5883e+00_r8,7.5634e+00_r8, & + &9.0692e+00_r8,1.0555e+01_r8,1.2107e+01_r8/) + kao(:, 4, 8,16) = (/ & + &2.0707e+01_r8,1.8120e+01_r8,1.5532e+01_r8,1.2944e+01_r8,1.0356e+01_r8,9.9766e+00_r8, & + &1.1963e+01_r8,1.3921e+01_r8,1.5970e+01_r8/) + kao(:, 5, 8,16) = (/ & + &2.4320e+01_r8,2.1282e+01_r8,1.8238e+01_r8,1.5200e+01_r8,1.2161e+01_r8,1.2723e+01_r8, & + &1.5254e+01_r8,1.7752e+01_r8,2.0364e+01_r8/) + kao(:, 1, 9,16) = (/ & + &4.0363e+01_r8,3.5318e+01_r8,3.0273e+01_r8,2.5227e+01_r8,2.0181e+01_r8,1.5134e+01_r8, & + &1.0090e+01_r8,5.4212e+00_r8,6.1996e+00_r8/) + kao(:, 2, 9,16) = (/ & + &5.4231e+01_r8,4.7444e+01_r8,4.0667e+01_r8,3.3896e+01_r8,2.7114e+01_r8,2.0336e+01_r8, & + &1.3557e+01_r8,7.4876e+00_r8,8.5638e+00_r8/) + kao(:, 3, 9,16) = (/ & + &6.9375e+01_r8,6.0706e+01_r8,5.2030e+01_r8,4.3363e+01_r8,3.4693e+01_r8,2.6019e+01_r8, & + &1.7346e+01_r8,1.0642e+01_r8,1.2169e+01_r8/) + kao(:, 4, 9,16) = (/ & + &8.5364e+01_r8,7.4694e+01_r8,6.4003e+01_r8,5.3349e+01_r8,4.2675e+01_r8,3.2007e+01_r8, & + &2.1338e+01_r8,1.4379e+01_r8,1.6444e+01_r8/) + kao(:, 5, 9,16) = (/ & + &1.0173e+02_r8,8.9011e+01_r8,7.6294e+01_r8,6.3578e+01_r8,5.0858e+01_r8,3.8147e+01_r8, & + &2.5431e+01_r8,1.8715e+01_r8,2.1406e+01_r8/) + kao(:, 1,10,16) = (/ & + &1.7518e+02_r8,1.5326e+02_r8,1.3138e+02_r8,1.0946e+02_r8,8.7589e+01_r8,6.5684e+01_r8, & + &4.3795e+01_r8,2.1898e+01_r8,6.6096e+00_r8/) + kao(:, 2,10,16) = (/ & + &2.4209e+02_r8,2.1181e+02_r8,1.8152e+02_r8,1.5127e+02_r8,1.2102e+02_r8,9.0779e+01_r8, & + &6.0510e+01_r8,3.0258e+01_r8,8.7477e+00_r8/) + kao(:, 3,10,16) = (/ & + &3.1702e+02_r8,2.7739e+02_r8,2.3777e+02_r8,1.9810e+02_r8,1.5849e+02_r8,1.1888e+02_r8, & + &7.9249e+01_r8,3.9623e+01_r8,1.2377e+01_r8/) + kao(:, 4,10,16) = (/ & + &3.9791e+02_r8,3.4817e+02_r8,2.9841e+02_r8,2.4869e+02_r8,1.9896e+02_r8,1.4923e+02_r8, & + &9.9472e+01_r8,4.9736e+01_r8,1.7102e+01_r8/) + kao(:, 5,10,16) = (/ & + &4.8342e+02_r8,4.2295e+02_r8,3.6251e+02_r8,3.0211e+02_r8,2.4169e+02_r8,1.8128e+02_r8, & + &1.2083e+02_r8,6.0427e+01_r8,2.2752e+01_r8/) + kao(:, 1,11,16) = (/ & + &3.1380e+02_r8,2.7453e+02_r8,2.3526e+02_r8,1.9609e+02_r8,1.5686e+02_r8,1.1764e+02_r8, & + &7.8455e+01_r8,3.9219e+01_r8,4.1702e-05_r8/) + kao(:, 2,11,16) = (/ & + &4.3458e+02_r8,3.8032e+02_r8,3.2596e+02_r8,2.7165e+02_r8,2.1736e+02_r8,1.6300e+02_r8, & + &1.0866e+02_r8,5.4331e+01_r8,1.0603e+01_r8/) + kao(:, 3,11,16) = (/ & + &5.7279e+02_r8,5.0121e+02_r8,4.2963e+02_r8,3.5802e+02_r8,2.8639e+02_r8,2.1479e+02_r8, & + &1.4321e+02_r8,7.1606e+01_r8,1.4737e+01_r8/) + kao(:, 4,11,16) = (/ & + &7.2603e+02_r8,6.3199e+02_r8,5.4450e+02_r8,4.5379e+02_r8,3.6299e+02_r8,2.7226e+02_r8, & + &1.8150e+02_r8,9.0755e+01_r8,2.0418e+01_r8/) + kao(:, 5,11,16) = (/ & + &8.9810e+02_r8,7.8584e+02_r8,6.7355e+02_r8,5.6126e+02_r8,4.4901e+02_r8,3.3674e+02_r8, & + &2.2451e+02_r8,1.1225e+02_r8,2.7345e+01_r8/) + kao(:, 1,12,16) = (/ & + &4.2564e+02_r8,3.7252e+02_r8,3.1927e+02_r8,2.6605e+02_r8,2.1287e+02_r8,1.5962e+02_r8, & + &1.0643e+02_r8,5.3212e+01_r8,3.3974e-05_r8/) + kao(:, 2,12,16) = (/ & + &5.9696e+02_r8,5.2232e+02_r8,4.4774e+02_r8,3.7307e+02_r8,2.9847e+02_r8,2.2385e+02_r8, & + &1.4924e+02_r8,7.4619e+01_r8,1.2841e+01_r8/) + kao(:, 3,12,16) = (/ & + &8.0130e+02_r8,7.0109e+02_r8,6.0095e+02_r8,5.0082e+02_r8,4.0064e+02_r8,3.0049e+02_r8, & + &2.0030e+02_r8,1.0016e+02_r8,1.7604e+01_r8/) + kao(:, 4,12,16) = (/ & + &1.0424e+03_r8,9.1209e+02_r8,7.8186e+02_r8,6.5151e+02_r8,5.2121e+02_r8,3.9092e+02_r8, & + &2.6059e+02_r8,1.3030e+02_r8,2.4408e+01_r8/) + kao(:, 5,12,16) = (/ & + &1.3107e+03_r8,1.1467e+03_r8,9.8296e+02_r8,8.1915e+02_r8,6.5538e+02_r8,4.9148e+02_r8, & + &3.2766e+02_r8,1.6385e+02_r8,3.2853e+01_r8/) + kao(:, 1,13,16) = (/ & + &4.8122e+02_r8,4.2105e+02_r8,3.6087e+02_r8,3.0076e+02_r8,2.4060e+02_r8,1.8046e+02_r8, & + &1.2030e+02_r8,6.0148e+01_r8,7.3993e+00_r8/) + kao(:, 2,13,16) = (/ & + &6.9206e+02_r8,6.0557e+02_r8,5.1907e+02_r8,4.3255e+02_r8,3.4603e+02_r8,2.5955e+02_r8, & + &1.7302e+02_r8,8.6508e+01_r8,1.5501e+01_r8/) + kao(:, 3,13,16) = (/ & + &9.4703e+02_r8,8.2867e+02_r8,7.1030e+02_r8,5.9189e+02_r8,4.7354e+02_r8,3.5512e+02_r8, & + &2.3675e+02_r8,1.1838e+02_r8,2.1029e+01_r8/) + kao(:, 4,13,16) = (/ & + &1.2338e+03_r8,1.0854e+03_r8,9.3026e+02_r8,7.7526e+02_r8,6.2018e+02_r8,4.6513e+02_r8, & + &3.1009e+02_r8,1.5423e+02_r8,2.9122e+01_r8/) + kao(:, 5,13,16) = (/ & + &1.5695e+03_r8,1.3734e+03_r8,1.1772e+03_r8,9.8104e+02_r8,7.8484e+02_r8,5.8860e+02_r8, & + &3.9240e+02_r8,1.9620e+02_r8,3.9289e+01_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:, 1,13, 1) = (/ & + &9.4796e-05_r8,1.4361e-04_r8,1.4118e-04_r8,1.1819e-04_r8,7.6303e-05_r8/) + kbo(:, 2,13, 1) = (/ & + &9.7387e-05_r8,1.7115e-04_r8,1.7300e-04_r8,1.4824e-04_r8,1.0469e-04_r8/) + kbo(:, 3,13, 1) = (/ & + &1.0951e-04_r8,2.1604e-04_r8,2.2323e-04_r8,1.9350e-04_r8,1.3818e-04_r8/) + kbo(:, 4,13, 1) = (/ & + &1.3449e-04_r8,2.8552e-04_r8,2.9728e-04_r8,2.5764e-04_r8,1.7597e-04_r8/) + kbo(:, 5,13, 1) = (/ & + &1.7577e-04_r8,3.8714e-04_r8,4.0359e-04_r8,3.4654e-04_r8,2.1851e-04_r8/) + kbo(:, 1,14, 1) = (/ & + &7.9000e-05_r8,1.2113e-04_r8,1.1920e-04_r8,9.9664e-05_r8,6.3646e-05_r8/) + kbo(:, 2,14, 1) = (/ & + &8.1870e-05_r8,1.4526e-04_r8,1.4705e-04_r8,1.2557e-04_r8,8.6376e-05_r8/) + kbo(:, 3,14, 1) = (/ & + &9.2975e-05_r8,1.8451e-04_r8,1.9063e-04_r8,1.6489e-04_r8,1.1348e-04_r8/) + kbo(:, 4,14, 1) = (/ & + &1.1499e-04_r8,2.4478e-04_r8,2.5460e-04_r8,2.2031e-04_r8,1.4451e-04_r8/) + kbo(:, 5,14, 1) = (/ & + &1.5077e-04_r8,3.3228e-04_r8,3.4580e-04_r8,2.9716e-04_r8,1.7798e-04_r8/) + kbo(:, 1,15, 1) = (/ & + &6.3146e-05_r8,9.9373e-05_r8,9.8373e-05_r8,8.2691e-05_r8,5.2397e-05_r8/) + kbo(:, 2,15, 1) = (/ & + &6.6078e-05_r8,1.2006e-04_r8,1.2228e-04_r8,1.0469e-04_r8,7.0411e-05_r8/) + kbo(:, 3,15, 1) = (/ & + &7.5821e-05_r8,1.5360e-04_r8,1.5869e-04_r8,1.3814e-04_r8,9.1603e-05_r8/) + kbo(:, 4,15, 1) = (/ & + &9.4372e-05_r8,2.0448e-04_r8,2.1279e-04_r8,1.8521e-04_r8,1.1587e-04_r8/) + kbo(:, 5,15, 1) = (/ & + &1.2416e-04_r8,2.7753e-04_r8,2.8967e-04_r8,2.5010e-04_r8,1.4409e-04_r8/) + kbo(:, 1,16, 1) = (/ & + &4.9335e-05_r8,8.0237e-05_r8,8.0247e-05_r8,6.8036e-05_r8,4.2623e-05_r8/) + kbo(:, 2,16, 1) = (/ & + &5.2173e-05_r8,9.7834e-05_r8,1.0022e-04_r8,8.6725e-05_r8,5.7211e-05_r8/) + kbo(:, 3,16, 1) = (/ & + &6.0461e-05_r8,1.2605e-04_r8,1.3061e-04_r8,1.1470e-04_r8,7.4324e-05_r8/) + kbo(:, 4,16, 1) = (/ & + &7.5694e-05_r8,1.6827e-04_r8,1.7572e-04_r8,1.5404e-04_r8,9.3686e-05_r8/) + kbo(:, 5,16, 1) = (/ & + &9.9955e-05_r8,2.2866e-04_r8,2.3956e-04_r8,2.0826e-04_r8,1.1548e-04_r8/) + kbo(:, 1,17, 1) = (/ & + &3.8266e-05_r8,6.4449e-05_r8,6.5172e-05_r8,5.5789e-05_r8,3.5130e-05_r8/) + kbo(:, 2,17, 1) = (/ & + &4.0895e-05_r8,7.9297e-05_r8,8.1758e-05_r8,7.1548e-05_r8,4.6781e-05_r8/) + kbo(:, 3,17, 1) = (/ & + &4.7807e-05_r8,1.0278e-04_r8,1.0697e-04_r8,9.4840e-05_r8,6.0133e-05_r8/) + kbo(:, 4,17, 1) = (/ & + &6.0159e-05_r8,1.3765e-04_r8,1.4446e-04_r8,1.2759e-04_r8,7.5139e-05_r8/) + kbo(:, 5,17, 1) = (/ & + &7.9747e-05_r8,1.8704e-04_r8,1.9692e-04_r8,1.7259e-04_r8,9.1648e-05_r8/) + kbo(:, 1,18, 1) = (/ & + &2.9184e-05_r8,5.1211e-05_r8,5.2362e-05_r8,4.5451e-05_r8,2.8937e-05_r8/) + kbo(:, 2,18, 1) = (/ & + &3.1502e-05_r8,6.3605e-05_r8,6.6096e-05_r8,5.8591e-05_r8,3.8202e-05_r8/) + kbo(:, 3,18, 1) = (/ & + &3.7129e-05_r8,8.2865e-05_r8,8.6932e-05_r8,7.7931e-05_r8,4.8777e-05_r8/) + kbo(:, 4,18, 1) = (/ & + &4.6953e-05_r8,1.1128e-04_r8,1.1763e-04_r8,1.0496e-04_r8,6.0806e-05_r8/) + kbo(:, 5,18, 1) = (/ & + &6.2502e-05_r8,1.5129e-04_r8,1.6025e-04_r8,1.4184e-04_r8,7.4536e-05_r8/) + kbo(:, 1,19, 1) = (/ & + &2.2672e-05_r8,4.1242e-05_r8,4.2527e-05_r8,3.7342e-05_r8,2.3934e-05_r8/) + kbo(:, 2,19, 1) = (/ & + &2.4699e-05_r8,5.1600e-05_r8,5.3953e-05_r8,4.8350e-05_r8,3.1473e-05_r8/) + kbo(:, 3,19, 1) = (/ & + &2.9334e-05_r8,6.7547e-05_r8,7.1294e-05_r8,6.4461e-05_r8,4.0025e-05_r8/) + kbo(:, 4,19, 1) = (/ & + &3.7286e-05_r8,9.0838e-05_r8,9.6625e-05_r8,8.6862e-05_r8,4.9869e-05_r8/) + kbo(:, 5,19, 1) = (/ & + &4.9822e-05_r8,1.2352e-04_r8,1.3152e-04_r8,1.1713e-04_r8,6.1219e-05_r8/) + kbo(:, 1,20, 1) = (/ & + &1.8003e-05_r8,3.3802e-05_r8,3.5042e-05_r8,3.1068e-05_r8,2.0074e-05_r8/) + kbo(:, 2,20, 1) = (/ & + &1.9811e-05_r8,4.2600e-05_r8,4.4765e-05_r8,4.0426e-05_r8,2.6188e-05_r8/) + kbo(:, 3,20, 1) = (/ & + &2.3740e-05_r8,5.5990e-05_r8,5.9400e-05_r8,5.4019e-05_r8,3.3275e-05_r8/) + kbo(:, 4,20, 1) = (/ & + &3.0362e-05_r8,7.5435e-05_r8,8.0630e-05_r8,7.2808e-05_r8,4.1380e-05_r8/) + kbo(:, 5,20, 1) = (/ & + &4.0743e-05_r8,1.0263e-04_r8,1.0963e-04_r8,9.7998e-05_r8,5.0442e-05_r8/) + kbo(:, 1,21, 1) = (/ & + &1.4410e-05_r8,2.7872e-05_r8,2.9027e-05_r8,2.5943e-05_r8,1.6820e-05_r8/) + kbo(:, 2,21, 1) = (/ & + &1.6018e-05_r8,3.5348e-05_r8,3.7320e-05_r8,3.3900e-05_r8,2.1893e-05_r8/) + kbo(:, 3,21, 1) = (/ & + &1.9364e-05_r8,4.6630e-05_r8,4.9701e-05_r8,4.5376e-05_r8,2.7723e-05_r8/) + kbo(:, 4,21, 1) = (/ & + &2.4923e-05_r8,6.2936e-05_r8,6.7505e-05_r8,6.1129e-05_r8,3.4253e-05_r8/) + kbo(:, 5,21, 1) = (/ & + &3.3581e-05_r8,8.5657e-05_r8,9.1740e-05_r8,8.2183e-05_r8,4.1502e-05_r8/) + kbo(:, 1,22, 1) = (/ & + &1.1606e-05_r8,2.3345e-05_r8,2.4458e-05_r8,2.2044e-05_r8,1.4341e-05_r8/) + kbo(:, 2,22, 1) = (/ & + &1.3108e-05_r8,2.9860e-05_r8,3.1703e-05_r8,2.8973e-05_r8,1.8544e-05_r8/) + kbo(:, 3,22, 1) = (/ & + &1.6058e-05_r8,3.9598e-05_r8,4.2399e-05_r8,3.8843e-05_r8,2.3272e-05_r8/) + kbo(:, 4,22, 1) = (/ & + &2.0871e-05_r8,5.3592e-05_r8,5.7668e-05_r8,5.2303e-05_r8,2.8594e-05_r8/) + kbo(:, 5,22, 1) = (/ & + &2.8287e-05_r8,7.2910e-05_r8,7.8274e-05_r8,7.0191e-05_r8,3.4495e-05_r8/) + kbo(:, 1,23, 1) = (/ & + &9.3973e-06_r8,1.9636e-05_r8,2.0704e-05_r8,1.8793e-05_r8,1.2204e-05_r8/) + kbo(:, 2,23, 1) = (/ & + &1.0787e-05_r8,2.5322e-05_r8,2.7025e-05_r8,2.4831e-05_r8,1.5654e-05_r8/) + kbo(:, 3,23, 1) = (/ & + &1.3385e-05_r8,3.3729e-05_r8,3.6290e-05_r8,3.3307e-05_r8,1.9609e-05_r8/) + kbo(:, 4,23, 1) = (/ & + &1.7566e-05_r8,4.5745e-05_r8,4.9368e-05_r8,4.4833e-05_r8,2.3893e-05_r8/) + kbo(:, 5,23, 1) = (/ & + &2.3931e-05_r8,6.2215e-05_r8,6.6919e-05_r8,6.0045e-05_r8,2.8668e-05_r8/) + kbo(:, 1,24, 1) = (/ & + &7.7170e-06_r8,1.6679e-05_r8,1.7685e-05_r8,1.6128e-05_r8,1.0358e-05_r8/) + kbo(:, 2,24, 1) = (/ & + &9.0120e-06_r8,2.1659e-05_r8,2.3221e-05_r8,2.1395e-05_r8,1.3206e-05_r8/) + kbo(:, 3,24, 1) = (/ & + &1.1319e-05_r8,2.8989e-05_r8,3.1289e-05_r8,2.8717e-05_r8,1.6361e-05_r8/) + kbo(:, 4,24, 1) = (/ & + &1.4992e-05_r8,3.9385e-05_r8,4.2555e-05_r8,3.8633e-05_r8,1.9891e-05_r8/) + kbo(:, 5,24, 1) = (/ & + &2.0520e-05_r8,5.3479e-05_r8,5.7600e-05_r8,5.1654e-05_r8,2.3746e-05_r8/) + kbo(:, 1,25, 1) = (/ & + &6.3838e-06_r8,1.4248e-05_r8,1.5168e-05_r8,1.3906e-05_r8,8.8251e-06_r8/) + kbo(:, 2,25, 1) = (/ & + &7.5878e-06_r8,1.8635e-05_r8,2.0050e-05_r8,1.8513e-05_r8,1.1119e-05_r8/) + kbo(:, 3,25, 1) = (/ & + &9.6475e-06_r8,2.5052e-05_r8,2.7110e-05_r8,2.4846e-05_r8,1.3734e-05_r8/) + kbo(:, 4,25, 1) = (/ & + &1.2889e-05_r8,3.4075e-05_r8,3.6834e-05_r8,3.3385e-05_r8,1.6609e-05_r8/) + kbo(:, 5,25, 1) = (/ & + &1.7706e-05_r8,4.6181e-05_r8,4.9751e-05_r8,4.4544e-05_r8,1.9735e-05_r8/) + kbo(:, 1,26, 1) = (/ & + &5.3393e-06_r8,1.2288e-05_r8,1.3132e-05_r8,1.2096e-05_r8,7.5264e-06_r8/) + kbo(:, 2,26, 1) = (/ & + &6.4609e-06_r8,1.6189e-05_r8,1.7467e-05_r8,1.6131e-05_r8,9.4332e-06_r8/) + kbo(:, 3,26, 1) = (/ & + &8.3200e-06_r8,2.1853e-05_r8,2.3681e-05_r8,2.1653e-05_r8,1.1593e-05_r8/) + kbo(:, 4,26, 1) = (/ & + &1.1209e-05_r8,2.9737e-05_r8,3.2133e-05_r8,2.9046e-05_r8,1.3941e-05_r8/) + kbo(:, 5,26, 1) = (/ & + &1.5443e-05_r8,4.0196e-05_r8,4.3302e-05_r8,3.8639e-05_r8,1.6481e-05_r8/) + kbo(:, 1,27, 1) = (/ & + &4.5029e-06_r8,1.0646e-05_r8,1.1429e-05_r8,1.0549e-05_r8,6.4263e-06_r8/) + kbo(:, 2,27, 1) = (/ & + &5.5408e-06_r8,1.4124e-05_r8,1.5272e-05_r8,1.4080e-05_r8,8.0128e-06_r8/) + kbo(:, 3,27, 1) = (/ & + &7.2235e-06_r8,1.9128e-05_r8,2.0734e-05_r8,1.8902e-05_r8,9.7874e-06_r8/) + kbo(:, 4,27, 1) = (/ & + &9.8044e-06_r8,2.6022e-05_r8,2.8102e-05_r8,2.5321e-05_r8,1.1642e-05_r8/) + kbo(:, 5,27, 1) = (/ & + &1.3531e-05_r8,3.5058e-05_r8,3.7762e-05_r8,3.3580e-05_r8,1.3712e-05_r8/) + kbo(:, 1,28, 1) = (/ & + &3.8267e-06_r8,9.2605e-06_r8,9.9753e-06_r8,9.2087e-06_r8,5.4910e-06_r8/) + kbo(:, 2,28, 1) = (/ & + &4.7813e-06_r8,1.2361e-05_r8,1.3381e-05_r8,1.2301e-05_r8,6.7809e-06_r8/) + kbo(:, 3,28, 1) = (/ & + &6.3052e-06_r8,1.6784e-05_r8,1.8184e-05_r8,1.6520e-05_r8,8.1872e-06_r8/) + kbo(:, 4,28, 1) = (/ & + &8.6092e-06_r8,2.2800e-05_r8,2.4603e-05_r8,2.2078e-05_r8,9.6541e-06_r8/) + kbo(:, 5,28, 1) = (/ & + &1.1891e-05_r8,3.0613e-05_r8,3.2964e-05_r8,2.9199e-05_r8,1.1371e-05_r8/) + kbo(:, 1,29, 1) = (/ & + &3.2554e-06_r8,8.0646e-06_r8,8.7115e-06_r8,8.0443e-06_r8,4.6597e-06_r8/) + kbo(:, 2,29, 1) = (/ & + &4.1267e-06_r8,1.0826e-05_r8,1.1737e-05_r8,1.0754e-05_r8,5.7169e-06_r8/) + kbo(:, 3,29, 1) = (/ & + &5.4998e-06_r8,1.4722e-05_r8,1.5944e-05_r8,1.4441e-05_r8,6.8326e-06_r8/) + kbo(:, 4,29, 1) = (/ & + &7.5454e-06_r8,1.9957e-05_r8,2.1533e-05_r8,1.9256e-05_r8,8.0674e-06_r8/) + kbo(:, 5,29, 1) = (/ & + &1.0421e-05_r8,2.6692e-05_r8,2.8752e-05_r8,2.5378e-05_r8,9.4635e-06_r8/) + kbo(:, 1,30, 1) = (/ & + &2.7722e-06_r8,7.0257e-06_r8,7.6070e-06_r8,7.0209e-06_r8,3.9148e-06_r8/) + kbo(:, 2,30, 1) = (/ & + &3.5629e-06_r8,9.4753e-06_r8,1.0287e-05_r8,9.3951e-06_r8,4.7641e-06_r8/) + kbo(:, 3,30, 1) = (/ & + &4.7932e-06_r8,1.2893e-05_r8,1.3959e-05_r8,1.2600e-05_r8,5.6708e-06_r8/) + kbo(:, 4,30, 1) = (/ & + &6.5982e-06_r8,1.7431e-05_r8,1.8810e-05_r8,1.6759e-05_r8,6.6902e-06_r8/) + kbo(:, 5,30, 1) = (/ & + &9.1066e-06_r8,2.3231e-05_r8,2.5041e-05_r8,2.2031e-05_r8,7.8394e-06_r8/) + kbo(:, 1,31, 1) = (/ & + &2.3506e-06_r8,6.1052e-06_r8,6.6305e-06_r8,6.1196e-06_r8,3.2861e-06_r8/) + kbo(:, 2,31, 1) = (/ & + &3.0616e-06_r8,8.2670e-06_r8,8.9874e-06_r8,8.1933e-06_r8,3.9690e-06_r8/) + kbo(:, 3,31, 1) = (/ & + &4.1518e-06_r8,1.1245e-05_r8,1.2180e-05_r8,1.0973e-05_r8,4.7077e-06_r8/) + kbo(:, 4,31, 1) = (/ & + &5.7278e-06_r8,1.5154e-05_r8,1.6366e-05_r8,1.4549e-05_r8,5.5398e-06_r8/) + kbo(:, 5,31, 1) = (/ & + &7.8906e-06_r8,2.0109e-05_r8,2.1708e-05_r8,1.9053e-05_r8,6.4566e-06_r8/) + kbo(:, 1,32, 1) = (/ & + &2.0097e-06_r8,5.3323e-06_r8,5.8021e-06_r8,5.3502e-06_r8,2.7241e-06_r8/) + kbo(:, 2,32, 1) = (/ & + &2.6508e-06_r8,7.2383e-06_r8,7.8773e-06_r8,7.1648e-06_r8,3.2755e-06_r8/) + kbo(:, 3,32, 1) = (/ & + &3.6184e-06_r8,9.8348e-06_r8,1.0656e-05_r8,9.5737e-06_r8,3.8774e-06_r8/) + kbo(:, 4,32, 1) = (/ & + &4.9951e-06_r8,1.3205e-05_r8,1.4271e-05_r8,1.2656e-05_r8,4.5194e-06_r8/) + kbo(:, 5,32, 1) = (/ & + &6.8654e-06_r8,1.7445e-05_r8,1.8860e-05_r8,1.6511e-05_r8,5.2597e-06_r8/) + kbo(:, 1,33, 1) = (/ & + &1.7307e-06_r8,4.6719e-06_r8,5.0926e-06_r8,4.6864e-06_r8,2.2504e-06_r8/) + kbo(:, 2,33, 1) = (/ & + &2.3079e-06_r8,6.3540e-06_r8,6.9152e-06_r8,6.2764e-06_r8,2.6926e-06_r8/) + kbo(:, 3,33, 1) = (/ & + &3.1665e-06_r8,8.6147e-06_r8,9.3343e-06_r8,8.3614e-06_r8,3.1814e-06_r8/) + kbo(:, 4,33, 1) = (/ & + &4.3731e-06_r8,1.1528e-05_r8,1.2464e-05_r8,1.1023e-05_r8,3.7164e-06_r8/) + kbo(:, 5,33, 1) = (/ & + &5.9878e-06_r8,1.5151e-05_r8,1.6400e-05_r8,1.4316e-05_r8,4.2974e-06_r8/) + kbo(:, 1,34, 1) = (/ & + &1.4981e-06_r8,4.0834e-06_r8,4.4531e-06_r8,4.0843e-06_r8,1.8539e-06_r8/) + kbo(:, 2,34, 1) = (/ & + &2.0150e-06_r8,5.5569e-06_r8,6.0419e-06_r8,5.4716e-06_r8,2.2285e-06_r8/) + kbo(:, 3,34, 1) = (/ & + &2.7725e-06_r8,7.5151e-06_r8,8.1387e-06_r8,7.2690e-06_r8,2.6334e-06_r8/) + kbo(:, 4,34, 1) = (/ & + &3.8256e-06_r8,1.0019e-05_r8,1.0836e-05_r8,9.5549e-06_r8,3.0709e-06_r8/) + kbo(:, 5,34, 1) = (/ & + &5.2217e-06_r8,1.3116e-05_r8,1.4207e-05_r8,1.2368e-05_r8,3.5492e-06_r8/) + kbo(:, 1,35, 1) = (/ & + &1.2683e-06_r8,3.4717e-06_r8,3.7843e-06_r8,3.4639e-06_r8,1.5033e-06_r8/) + kbo(:, 2,35, 1) = (/ & + &1.7130e-06_r8,4.7242e-06_r8,5.1321e-06_r8,4.6386e-06_r8,1.8045e-06_r8/) + kbo(:, 3,35, 1) = (/ & + &2.3598e-06_r8,6.3794e-06_r8,6.9043e-06_r8,6.1552e-06_r8,2.1312e-06_r8/) + kbo(:, 4,35, 1) = (/ & + &3.2533e-06_r8,8.4861e-06_r8,9.1773e-06_r8,8.0771e-06_r8,2.4797e-06_r8/) + kbo(:, 5,35, 1) = (/ & + &4.4317e-06_r8,1.1084e-05_r8,1.2009e-05_r8,1.0436e-05_r8,2.8460e-06_r8/) + kbo(:, 1,36, 1) = (/ & + &1.0446e-06_r8,2.8596e-06_r8,3.1142e-06_r8,2.8488e-06_r8,1.1841e-06_r8/) + kbo(:, 2,36, 1) = (/ & + &1.4115e-06_r8,3.8911e-06_r8,4.2236e-06_r8,3.8148e-06_r8,1.4188e-06_r8/) + kbo(:, 3,36, 1) = (/ & + &1.9447e-06_r8,5.2529e-06_r8,5.6822e-06_r8,5.0612e-06_r8,1.6763e-06_r8/) + kbo(:, 4,36, 1) = (/ & + &2.6806e-06_r8,6.9854e-06_r8,7.5506e-06_r8,6.6402e-06_r8,1.9492e-06_r8/) + kbo(:, 5,36, 1) = (/ & + &3.6503e-06_r8,9.1210e-06_r8,9.8800e-06_r8,8.5784e-06_r8,2.2478e-06_r8/) + kbo(:, 1,37, 1) = (/ & + &8.3141e-07_r8,2.2606e-06_r8,2.4589e-06_r8,2.2521e-06_r8,9.1953e-07_r8/) + kbo(:, 2,37, 1) = (/ & + &1.1186e-06_r8,3.0759e-06_r8,3.3374e-06_r8,3.0170e-06_r8,1.1075e-06_r8/) + kbo(:, 3,37, 1) = (/ & + &1.5392e-06_r8,4.1590e-06_r8,4.4972e-06_r8,4.0085e-06_r8,1.3109e-06_r8/) + kbo(:, 4,37, 1) = (/ & + &2.1232e-06_r8,5.5433e-06_r8,5.9872e-06_r8,5.2697e-06_r8,1.5318e-06_r8/) + kbo(:, 5,37, 1) = (/ & + &2.8971e-06_r8,7.2549e-06_r8,7.8520e-06_r8,6.8216e-06_r8,1.7720e-06_r8/) + kbo(:, 1,38, 1) = (/ & + &6.6100e-07_r8,1.7834e-06_r8,1.9371e-06_r8,1.7763e-06_r8,7.1225e-07_r8/) + kbo(:, 2,38, 1) = (/ & + &8.8499e-07_r8,2.4255e-06_r8,2.6307e-06_r8,2.3793e-06_r8,8.6302e-07_r8/) + kbo(:, 3,38, 1) = (/ & + &1.2155e-06_r8,3.2848e-06_r8,3.5503e-06_r8,3.1675e-06_r8,1.0267e-06_r8/) + kbo(:, 4,38, 1) = (/ & + &1.6779e-06_r8,4.3885e-06_r8,4.7364e-06_r8,4.1721e-06_r8,1.2041e-06_r8/) + kbo(:, 5,38, 1) = (/ & + &2.2938e-06_r8,5.7578e-06_r8,6.2256e-06_r8,5.4129e-06_r8,1.3941e-06_r8/) + kbo(:, 1,39, 1) = (/ & + &5.2622e-07_r8,1.4074e-06_r8,1.5268e-06_r8,1.4013e-06_r8,5.4821e-07_r8/) + kbo(:, 2,39, 1) = (/ & + &7.0069e-07_r8,1.9130e-06_r8,2.0737e-06_r8,1.8765e-06_r8,6.6832e-07_r8/) + kbo(:, 3,39, 1) = (/ & + &9.6029e-07_r8,2.5942e-06_r8,2.8023e-06_r8,2.5024e-06_r8,8.0073e-07_r8/) + kbo(:, 4,39, 1) = (/ & + &1.3259e-06_r8,3.4737e-06_r8,3.7464e-06_r8,3.3022e-06_r8,9.3841e-07_r8/) + kbo(:, 5,39, 1) = (/ & + &1.8162e-06_r8,4.5691e-06_r8,4.9354e-06_r8,4.2944e-06_r8,1.0896e-06_r8/) + kbo(:, 1,40, 1) = (/ & + &4.1271e-07_r8,1.0842e-06_r8,1.1736e-06_r8,1.0777e-06_r8,4.1787e-07_r8/) + kbo(:, 2,40, 1) = (/ & + &5.4389e-07_r8,1.4709e-06_r8,1.5926e-06_r8,1.4421e-06_r8,5.1017e-07_r8/) + kbo(:, 3,40, 1) = (/ & + &7.4188e-07_r8,1.9982e-06_r8,2.1561e-06_r8,1.9284e-06_r8,6.1575e-07_r8/) + kbo(:, 4,40, 1) = (/ & + &1.0242e-06_r8,2.6854e-06_r8,2.8924e-06_r8,2.5529e-06_r8,7.2613e-07_r8/) + kbo(:, 5,40, 1) = (/ & + &1.4067e-06_r8,3.5476e-06_r8,3.8249e-06_r8,3.3331e-06_r8,8.4610e-07_r8/) + kbo(:, 1,41, 1) = (/ & + &3.2432e-07_r8,8.3392e-07_r8,9.0025e-07_r8,8.2659e-07_r8,3.1699e-07_r8/) + kbo(:, 2,41, 1) = (/ & + &4.2215e-07_r8,1.1277e-06_r8,1.2186e-06_r8,1.1049e-06_r8,3.8959e-07_r8/) + kbo(:, 3,41, 1) = (/ & + &5.7203e-07_r8,1.5335e-06_r8,1.6530e-06_r8,1.4808e-06_r8,4.7229e-07_r8/) + kbo(:, 4,41, 1) = (/ & + &7.8892e-07_r8,2.0682e-06_r8,2.2251e-06_r8,1.9663e-06_r8,5.6019e-07_r8/) + kbo(:, 5,41, 1) = (/ & + &1.0862e-06_r8,2.7447e-06_r8,2.9535e-06_r8,2.5776e-06_r8,6.5591e-07_r8/) + kbo(:, 1,42, 1) = (/ & + &2.5587e-07_r8,6.4253e-07_r8,6.9167e-07_r8,6.3420e-07_r8,2.3952e-07_r8/) + kbo(:, 2,42, 1) = (/ & + &3.2863e-07_r8,8.6497e-07_r8,9.3264e-07_r8,8.4649e-07_r8,2.9775e-07_r8/) + kbo(:, 3,42, 1) = (/ & + &4.4164e-07_r8,1.1761e-06_r8,1.2667e-06_r8,1.1361e-06_r8,3.6120e-07_r8/) + kbo(:, 4,42, 1) = (/ & + &6.0774e-07_r8,1.5914e-06_r8,1.7100e-06_r8,1.5131e-06_r8,4.3157e-07_r8/) + kbo(:, 5,42, 1) = (/ & + &8.3802e-07_r8,2.1211e-06_r8,2.2785e-06_r8,1.9912e-06_r8,5.0721e-07_r8/) + kbo(:, 1,43, 1) = (/ & + &2.0233e-07_r8,4.9120e-07_r8,5.2639e-07_r8,4.8089e-07_r8,1.7965e-07_r8/) + kbo(:, 2,43, 1) = (/ & + &2.5538e-07_r8,6.5692e-07_r8,7.0547e-07_r8,6.4075e-07_r8,2.2496e-07_r8/) + kbo(:, 3,43, 1) = (/ & + &3.3917e-07_r8,8.9179e-07_r8,9.5869e-07_r8,8.5986e-07_r8,2.7469e-07_r8/) + kbo(:, 4,43, 1) = (/ & + &4.6446e-07_r8,1.2101e-06_r8,1.2978e-06_r8,1.1498e-06_r8,3.3044e-07_r8/) + kbo(:, 5,43, 1) = (/ & + &6.4112e-07_r8,1.6212e-06_r8,1.7373e-06_r8,1.5201e-06_r8,3.9028e-07_r8/) + kbo(:, 1,44, 1) = (/ & + &1.6122e-07_r8,3.7551e-07_r8,3.9960e-07_r8,3.6377e-07_r8,1.3351e-07_r8/) + kbo(:, 2,44, 1) = (/ & + &1.9938e-07_r8,4.9773e-07_r8,5.3195e-07_r8,4.8258e-07_r8,1.6857e-07_r8/) + kbo(:, 3,44, 1) = (/ & + &2.6075e-07_r8,6.7334e-07_r8,7.2162e-07_r8,6.4719e-07_r8,2.0768e-07_r8/) + kbo(:, 4,44, 1) = (/ & + &3.5440e-07_r8,9.1528e-07_r8,9.7926e-07_r8,8.6831e-07_r8,2.5128e-07_r8/) + kbo(:, 5,44, 1) = (/ & + &4.8882e-07_r8,1.2321e-06_r8,1.3171e-06_r8,1.1536e-06_r8,2.9843e-07_r8/) + kbo(:, 1,45, 1) = (/ & + &1.2988e-07_r8,2.8870e-07_r8,3.0532e-07_r8,2.7582e-07_r8,9.8684e-08_r8/) + kbo(:, 2,45, 1) = (/ & + &1.5689e-07_r8,3.7846e-07_r8,4.0235e-07_r8,3.6402e-07_r8,1.2561e-07_r8/) + kbo(:, 3,45, 1) = (/ & + &2.0165e-07_r8,5.0920e-07_r8,5.4343e-07_r8,4.8733e-07_r8,1.5620e-07_r8/) + kbo(:, 4,45, 1) = (/ & + &2.7120e-07_r8,6.9216e-07_r8,7.3881e-07_r8,6.5533e-07_r8,1.9009e-07_r8/) + kbo(:, 5,45, 1) = (/ & + &3.7310e-07_r8,9.3568e-07_r8,9.9762e-07_r8,8.7425e-07_r8,2.2785e-07_r8/) + kbo(:, 1,46, 1) = (/ & + &1.0564e-07_r8,2.2197e-07_r8,2.3290e-07_r8,2.0875e-07_r8,7.2454e-08_r8/) + kbo(:, 2,46, 1) = (/ & + &1.2404e-07_r8,2.8745e-07_r8,3.0379e-07_r8,2.7335e-07_r8,9.2971e-08_r8/) + kbo(:, 3,46, 1) = (/ & + &1.5624e-07_r8,3.8369e-07_r8,4.0737e-07_r8,3.6500e-07_r8,1.1671e-07_r8/) + kbo(:, 4,46, 1) = (/ & + &2.0727e-07_r8,5.2051e-07_r8,5.5407e-07_r8,4.9156e-07_r8,1.4314e-07_r8/) + kbo(:, 5,46, 1) = (/ & + &2.8357e-07_r8,7.0586e-07_r8,7.5047e-07_r8,6.5798e-07_r8,1.7235e-07_r8/) + kbo(:, 1,47, 1) = (/ & + &8.6916e-08_r8,1.7066e-07_r8,1.7731e-07_r8,1.5740e-07_r8,5.2956e-08_r8/) + kbo(:, 2,47, 1) = (/ & + &9.8603e-08_r8,2.1737e-07_r8,2.2800e-07_r8,2.0365e-07_r8,6.8355e-08_r8/) + kbo(:, 3,47, 1) = (/ & + &1.2114e-07_r8,2.8693e-07_r8,3.0257e-07_r8,2.7060e-07_r8,8.6098e-08_r8/) + kbo(:, 4,47, 1) = (/ & + &1.5770e-07_r8,3.8735e-07_r8,4.1075e-07_r8,3.6401e-07_r8,1.0681e-07_r8/) + kbo(:, 5,47, 1) = (/ & + &2.1366e-07_r8,5.2607e-07_r8,5.5766e-07_r8,4.8899e-07_r8,1.2936e-07_r8/) + kbo(:, 1,48, 1) = (/ & + &7.2690e-08_r8,1.3243e-07_r8,1.3635e-07_r8,1.1959e-07_r8,3.9422e-08_r8/) + kbo(:, 2,48, 1) = (/ & + &7.9634e-08_r8,1.6556e-07_r8,1.7235e-07_r8,1.5270e-07_r8,4.9882e-08_r8/) + kbo(:, 3,48, 1) = (/ & + &9.5002e-08_r8,2.1570e-07_r8,2.2592e-07_r8,2.0102e-07_r8,6.3148e-08_r8/) + kbo(:, 4,48, 1) = (/ & + &1.2105e-07_r8,2.8907e-07_r8,3.0482e-07_r8,2.6976e-07_r8,7.9242e-08_r8/) + kbo(:, 5,48, 1) = (/ & + &1.6180e-07_r8,3.9224e-07_r8,4.1437e-07_r8,3.6322e-07_r8,9.6936e-08_r8/) + kbo(:, 1,49, 1) = (/ & + &6.1774e-08_r8,1.0401e-07_r8,1.0607e-07_r8,9.1394e-08_r8,2.9238e-08_r8/) + kbo(:, 2,49, 1) = (/ & + &6.5366e-08_r8,1.2732e-07_r8,1.3151e-07_r8,1.1526e-07_r8,3.6075e-08_r8/) + kbo(:, 3,49, 1) = (/ & + &7.5416e-08_r8,1.6321e-07_r8,1.6967e-07_r8,1.4985e-07_r8,4.6286e-08_r8/) + kbo(:, 4,49, 1) = (/ & + &9.3863e-08_r8,2.1656e-07_r8,2.2682e-07_r8,2.0018e-07_r8,5.8261e-08_r8/) + kbo(:, 5,49, 1) = (/ & + &1.2334e-07_r8,2.9285e-07_r8,3.0807e-07_r8,2.6986e-07_r8,7.1843e-08_r8/) + kbo(:, 1,50, 1) = (/ & + &5.3206e-08_r8,8.3103e-08_r8,8.3626e-08_r8,7.1042e-08_r8,2.0418e-08_r8/) + kbo(:, 2,50, 1) = (/ & + &5.4599e-08_r8,9.9314e-08_r8,1.0171e-07_r8,8.8074e-08_r8,2.6669e-08_r8/) + kbo(:, 3,50, 1) = (/ & + &6.0981e-08_r8,1.2515e-07_r8,1.2917e-07_r8,1.1305e-07_r8,3.4171e-08_r8/) + kbo(:, 4,50, 1) = (/ & + &7.3992e-08_r8,1.6416e-07_r8,1.7066e-07_r8,1.4995e-07_r8,4.3100e-08_r8/) + kbo(:, 5,50, 1) = (/ & + &9.5401e-08_r8,2.2074e-07_r8,2.3106e-07_r8,2.0200e-07_r8,5.3679e-08_r8/) + kbo(:, 1,51, 1) = (/ & + &4.6282e-08_r8,6.7151e-08_r8,6.6436e-08_r8,5.6117e-08_r8,1.4310e-08_r8/) + kbo(:, 2,51, 1) = (/ & + &4.6293e-08_r8,7.8464e-08_r8,7.9611e-08_r8,6.7952e-08_r8,2.0313e-08_r8/) + kbo(:, 3,51, 1) = (/ & + &5.0084e-08_r8,9.7036e-08_r8,9.9288e-08_r8,8.6023e-08_r8,2.5137e-08_r8/) + kbo(:, 4,51, 1) = (/ & + &5.9071e-08_r8,1.2553e-07_r8,1.2948e-07_r8,1.1300e-07_r8,3.2036e-08_r8/) + kbo(:, 5,51, 1) = (/ & + &7.4640e-08_r8,1.6747e-07_r8,1.7423e-07_r8,1.5170e-07_r8,4.0217e-08_r8/) + kbo(:, 1,52, 1) = (/ & + &4.0629e-08_r8,5.4875e-08_r8,5.3346e-08_r8,4.4940e-08_r8,9.9095e-09_r8/) + kbo(:, 2,52, 1) = (/ & + &3.9810e-08_r8,6.2753e-08_r8,6.2779e-08_r8,5.3045e-08_r8,1.4355e-08_r8/) + kbo(:, 3,52, 1) = (/ & + &4.1749e-08_r8,7.5935e-08_r8,7.6945e-08_r8,6.5932e-08_r8,1.8547e-08_r8/) + kbo(:, 4,52, 1) = (/ & + &4.7734e-08_r8,9.6672e-08_r8,9.8927e-08_r8,8.5559e-08_r8,2.3788e-08_r8/) + kbo(:, 5,52, 1) = (/ & + &5.9002e-08_r8,1.2763e-07_r8,1.3186e-07_r8,1.1423e-07_r8,2.9932e-08_r8/) + kbo(:, 1,53, 1) = (/ & + &3.5975e-08_r8,4.5399e-08_r8,4.2771e-08_r8,3.6200e-08_r8,6.7635e-09_r8/) + kbo(:, 2,53, 1) = (/ & + &3.4672e-08_r8,5.0776e-08_r8,4.9763e-08_r8,4.1778e-08_r8,1.0001e-08_r8/) + kbo(:, 3,53, 1) = (/ & + &3.5325e-08_r8,6.0020e-08_r8,6.0156e-08_r8,5.0998e-08_r8,1.3726e-08_r8/) + kbo(:, 4,53, 1) = (/ & + &3.9133e-08_r8,7.5038e-08_r8,7.6143e-08_r8,6.5063e-08_r8,1.7480e-08_r8/) + kbo(:, 5,53, 1) = (/ & + &4.7140e-08_r8,9.7792e-08_r8,1.0026e-07_r8,8.6276e-08_r8,2.2211e-08_r8/) + kbo(:, 1,54, 1) = (/ & + &3.2026e-08_r8,3.8173e-08_r8,3.4913e-08_r8,2.9554e-08_r8,4.7895e-09_r8/) + kbo(:, 2,54, 1) = (/ & + &3.0459e-08_r8,4.1712e-08_r8,4.0172e-08_r8,3.3417e-08_r8,7.2202e-09_r8/) + kbo(:, 3,54, 1) = (/ & + &3.0344e-08_r8,4.8248e-08_r8,4.7728e-08_r8,3.9999e-08_r8,1.0387e-08_r8/) + kbo(:, 4,54, 1) = (/ & + &3.2650e-08_r8,5.9169e-08_r8,5.9453e-08_r8,5.0241e-08_r8,1.3202e-08_r8/) + kbo(:, 5,54, 1) = (/ & + &3.8298e-08_r8,7.6040e-08_r8,7.7304e-08_r8,6.5975e-08_r8,1.6815e-08_r8/) + kbo(:, 1,55, 1) = (/ & + &2.8677e-08_r8,3.2441e-08_r8,2.8748e-08_r8,2.4151e-08_r8,3.5459e-09_r8/) + kbo(:, 2,55, 1) = (/ & + &2.6981e-08_r8,3.4720e-08_r8,3.2391e-08_r8,2.6974e-08_r8,5.3560e-09_r8/) + kbo(:, 3,55, 1) = (/ & + &2.6409e-08_r8,3.9355e-08_r8,3.8167e-08_r8,3.1739e-08_r8,7.7448e-09_r8/) + kbo(:, 4,55, 1) = (/ & + &2.7649e-08_r8,4.7215e-08_r8,4.6970e-08_r8,3.9144e-08_r8,1.0056e-08_r8/) + kbo(:, 5,55, 1) = (/ & + &3.1553e-08_r8,5.9776e-08_r8,6.0219e-08_r8,5.0851e-08_r8,1.2897e-08_r8/) + kbo(:, 1,56, 1) = (/ & + &2.5871e-08_r8,2.7896e-08_r8,2.4025e-08_r8,1.9941e-08_r8,2.5789e-09_r8/) + kbo(:, 2,56, 1) = (/ & + &2.4111e-08_r8,2.9230e-08_r8,2.6562e-08_r8,2.2012e-08_r8,3.9211e-09_r8/) + kbo(:, 3,56, 1) = (/ & + &2.3260e-08_r8,3.2443e-08_r8,3.0891e-08_r8,2.5392e-08_r8,5.7991e-09_r8/) + kbo(:, 4,56, 1) = (/ & + &2.3744e-08_r8,3.8105e-08_r8,3.7441e-08_r8,3.0750e-08_r8,7.7370e-09_r8/) + kbo(:, 5,56, 1) = (/ & + &2.6357e-08_r8,4.7419e-08_r8,4.7264e-08_r8,3.9435e-08_r8,9.8948e-09_r8/) + kbo(:, 1,57, 1) = (/ & + &2.3535e-08_r8,2.4259e-08_r8,2.0309e-08_r8,1.6435e-08_r8,1.8424e-09_r8/) + kbo(:, 2,57, 1) = (/ & + &2.1750e-08_r8,2.4981e-08_r8,2.1975e-08_r8,1.7965e-08_r8,2.8485e-09_r8/) + kbo(:, 3,57, 1) = (/ & + &2.0716e-08_r8,2.7095e-08_r8,2.5073e-08_r8,2.0518e-08_r8,4.3296e-09_r8/) + kbo(:, 4,57, 1) = (/ & + &2.0688e-08_r8,3.1150e-08_r8,2.9998e-08_r8,2.4389e-08_r8,6.0949e-09_r8/) + kbo(:, 5,57, 1) = (/ & + &2.2336e-08_r8,3.7957e-08_r8,3.7415e-08_r8,3.0783e-08_r8,7.5649e-09_r8/) + kbo(:, 1,58, 1) = (/ & + &1.0425e-08_r8,1.1830e-08_r8,1.1340e-08_r8,1.0982e-08_r8,1.3443e-09_r8/) + kbo(:, 2,58, 1) = (/ & + &9.5648e-09_r8,1.2002e-08_r8,1.2045e-08_r8,1.1710e-08_r8,2.0849e-09_r8/) + kbo(:, 3,58, 1) = (/ & + &9.0146e-09_r8,1.2747e-08_r8,1.3512e-08_r8,1.3201e-08_r8,3.2654e-09_r8/) + kbo(:, 4,58, 1) = (/ & + &8.8493e-09_r8,1.4369e-08_r8,1.5929e-08_r8,1.5466e-08_r8,4.7356e-09_r8/) + kbo(:, 5,58, 1) = (/ & + &9.3086e-09_r8,1.7138e-08_r8,1.9573e-08_r8,1.9214e-08_r8,5.8278e-09_r8/) + kbo(:, 1,59, 1) = (/ & + &9.0380e-09_r8,1.0080e-08_r8,9.6059e-09_r8,9.1584e-09_r8,1.1081e-09_r8/) + kbo(:, 2,59, 1) = (/ & + &8.2691e-09_r8,1.0165e-08_r8,1.0115e-08_r8,9.7014e-09_r8,1.7533e-09_r8/) + kbo(:, 3,59, 1) = (/ & + &7.7641e-09_r8,1.0688e-08_r8,1.1200e-08_r8,1.0889e-08_r8,2.7394e-09_r8/) + kbo(:, 4,59, 1) = (/ & + &7.5756e-09_r8,1.1927e-08_r8,1.3083e-08_r8,1.2667e-08_r8,3.9313e-09_r8/) + kbo(:, 5,59, 1) = (/ & + &7.8886e-09_r8,1.4088e-08_r8,1.5992e-08_r8,1.5688e-08_r8,4.8202e-09_r8/) + kbo(:, 1,13, 2) = (/ & + &2.3347e-04_r8,3.2740e-04_r8,3.1964e-04_r8,2.7562e-04_r8,2.3674e-04_r8/) + kbo(:, 2,13, 2) = (/ & + &2.9027e-04_r8,4.3170e-04_r8,4.3482e-04_r8,3.8943e-04_r8,3.2365e-04_r8/) + kbo(:, 3,13, 2) = (/ & + &3.9534e-04_r8,6.0684e-04_r8,6.1602e-04_r8,5.5281e-04_r8,4.2550e-04_r8/) + kbo(:, 4,13, 2) = (/ & + &5.7501e-04_r8,8.8229e-04_r8,8.9214e-04_r8,7.8504e-04_r8,5.3481e-04_r8/) + kbo(:, 5,13, 2) = (/ & + &8.7274e-04_r8,1.2992e-03_r8,1.2957e-03_r8,1.1072e-03_r8,6.5845e-04_r8/) + kbo(:, 1,14, 2) = (/ & + &2.0019e-04_r8,2.7999e-04_r8,2.7248e-04_r8,2.3561e-04_r8,2.0892e-04_r8/) + kbo(:, 2,14, 2) = (/ & + &2.5252e-04_r8,3.7448e-04_r8,3.7546e-04_r8,3.3478e-04_r8,2.8574e-04_r8/) + kbo(:, 3,14, 2) = (/ & + &3.4599e-04_r8,5.3246e-04_r8,5.3788e-04_r8,4.7751e-04_r8,3.6978e-04_r8/) + kbo(:, 4,14, 2) = (/ & + &5.0873e-04_r8,7.7992e-04_r8,7.8607e-04_r8,6.8145e-04_r8,4.6369e-04_r8/) + kbo(:, 5,14, 2) = (/ & + &7.7937e-04_r8,1.1544e-03_r8,1.1464e-03_r8,9.6300e-04_r8,5.7084e-04_r8/) + kbo(:, 1,15, 2) = (/ & + &1.6496e-04_r8,2.3313e-04_r8,2.2745e-04_r8,1.9815e-04_r8,1.7191e-04_r8/) + kbo(:, 2,15, 2) = (/ & + &2.0995e-04_r8,3.1642e-04_r8,3.1725e-04_r8,2.8352e-04_r8,2.3300e-04_r8/) + kbo(:, 3,15, 2) = (/ & + &2.9058e-04_r8,4.5406e-04_r8,4.6090e-04_r8,4.0582e-04_r8,3.0079e-04_r8/) + kbo(:, 4,15, 2) = (/ & + &4.3180e-04_r8,6.6786e-04_r8,6.7439e-04_r8,5.7938e-04_r8,3.7802e-04_r8/) + kbo(:, 5,15, 2) = (/ & + &6.6674e-04_r8,9.9697e-04_r8,9.8451e-04_r8,8.2076e-04_r8,4.7099e-04_r8/) + kbo(:, 1,16, 2) = (/ & + &1.3273e-04_r8,1.9160e-04_r8,1.8863e-04_r8,1.6534e-04_r8,1.4034e-04_r8/) + kbo(:, 2,16, 2) = (/ & + &1.7022e-04_r8,2.6274e-04_r8,2.6590e-04_r8,2.3774e-04_r8,1.8655e-04_r8/) + kbo(:, 3,16, 2) = (/ & + &2.3798e-04_r8,3.7894e-04_r8,3.8748e-04_r8,3.4032e-04_r8,2.3998e-04_r8/) + kbo(:, 4,16, 2) = (/ & + &3.5812e-04_r8,5.6381e-04_r8,5.6807e-04_r8,4.8599e-04_r8,3.0617e-04_r8/) + kbo(:, 5,16, 2) = (/ & + &5.5540e-04_r8,8.4478e-04_r8,8.3109e-04_r8,6.8770e-04_r8,3.7973e-04_r8/) + kbo(:, 1,17, 2) = (/ & + &1.0577e-04_r8,1.5680e-04_r8,1.5536e-04_r8,1.3786e-04_r8,1.1416e-04_r8/) + kbo(:, 2,17, 2) = (/ & + &1.3659e-04_r8,2.1658e-04_r8,2.2147e-04_r8,1.9766e-04_r8,1.5136e-04_r8/) + kbo(:, 3,17, 2) = (/ & + &1.9353e-04_r8,3.1591e-04_r8,3.2447e-04_r8,2.8337e-04_r8,1.9661e-04_r8/) + kbo(:, 4,17, 2) = (/ & + &2.9393e-04_r8,4.7241e-04_r8,4.7609e-04_r8,4.0460e-04_r8,2.4887e-04_r8/) + kbo(:, 5,17, 2) = (/ & + &4.5598e-04_r8,7.0740e-04_r8,6.9589e-04_r8,5.7452e-04_r8,3.0304e-04_r8/) + kbo(:, 1,18, 2) = (/ & + &8.2750e-05_r8,1.2686e-04_r8,1.2742e-04_r8,1.1403e-04_r8,9.3961e-05_r8/) + kbo(:, 2,18, 2) = (/ & + &1.0793e-04_r8,1.7707e-04_r8,1.8353e-04_r8,1.6336e-04_r8,1.2524e-04_r8/) + kbo(:, 3,18, 2) = (/ & + &1.5481e-04_r8,2.6078e-04_r8,2.6950e-04_r8,2.3444e-04_r8,1.6211e-04_r8/) + kbo(:, 4,18, 2) = (/ & + &2.3641e-04_r8,3.9024e-04_r8,3.9536e-04_r8,3.3586e-04_r8,2.0255e-04_r8/) + kbo(:, 5,18, 2) = (/ & + &3.6699e-04_r8,5.8299e-04_r8,5.7531e-04_r8,4.7694e-04_r8,2.4459e-04_r8/) + kbo(:, 1,19, 2) = (/ & + &6.5789e-05_r8,1.0377e-04_r8,1.0573e-04_r8,9.4747e-05_r8,7.8309e-05_r8/) + kbo(:, 2,19, 2) = (/ & + &8.6739e-05_r8,1.4667e-04_r8,1.5321e-04_r8,1.3630e-04_r8,1.0400e-04_r8/) + kbo(:, 3,19, 2) = (/ & + &1.2570e-04_r8,2.1696e-04_r8,2.2493e-04_r8,1.9585e-04_r8,1.3355e-04_r8/) + kbo(:, 4,19, 2) = (/ & + &1.9254e-04_r8,3.2492e-04_r8,3.2972e-04_r8,2.8110e-04_r8,1.6478e-04_r8/) + kbo(:, 5,19, 2) = (/ & + &2.9952e-04_r8,4.8402e-04_r8,4.8010e-04_r8,3.9892e-04_r8,1.9831e-04_r8/) + kbo(:, 1,20, 2) = (/ & + &5.3588e-05_r8,8.6632e-05_r8,8.9247e-05_r8,8.0067e-05_r8,6.5775e-05_r8/) + kbo(:, 2,20, 2) = (/ & + &7.1606e-05_r8,1.2377e-04_r8,1.3011e-04_r8,1.1561e-04_r8,8.7374e-05_r8/) + kbo(:, 3,20, 2) = (/ & + &1.0490e-04_r8,1.8400e-04_r8,1.9125e-04_r8,1.6630e-04_r8,1.1025e-04_r8/) + kbo(:, 4,20, 2) = (/ & + &1.6107e-04_r8,2.7570e-04_r8,2.7972e-04_r8,2.3864e-04_r8,1.3590e-04_r8/) + kbo(:, 5,20, 2) = (/ & + &2.5044e-04_r8,4.0870e-04_r8,4.0643e-04_r8,3.3832e-04_r8,1.6243e-04_r8/) + kbo(:, 1,21, 2) = (/ & + &4.3995e-05_r8,7.2776e-05_r8,7.5695e-05_r8,6.8050e-05_r8,5.5495e-05_r8/) + kbo(:, 2,21, 2) = (/ & + &5.9611e-05_r8,1.0482e-04_r8,1.1056e-04_r8,9.8202e-05_r8,7.3158e-05_r8/) + kbo(:, 3,21, 2) = (/ & + &8.7989e-05_r8,1.5634e-04_r8,1.6268e-04_r8,1.4172e-04_r8,9.0987e-05_r8/) + kbo(:, 4,21, 2) = (/ & + &1.3548e-04_r8,2.3394e-04_r8,2.3798e-04_r8,2.0295e-04_r8,1.1189e-04_r8/) + kbo(:, 5,21, 2) = (/ & + &2.1032e-04_r8,3.4525e-04_r8,3.4399e-04_r8,2.8683e-04_r8,1.3326e-04_r8/) + kbo(:, 1,22, 2) = (/ & + &3.6803e-05_r8,6.2518e-05_r8,6.5746e-05_r8,5.8989e-05_r8,4.7547e-05_r8/) + kbo(:, 2,22, 2) = (/ & + &5.0761e-05_r8,9.1003e-05_r8,9.6193e-05_r8,8.5393e-05_r8,6.0785e-05_r8/) + kbo(:, 3,22, 2) = (/ & + &7.5680e-05_r8,1.3601e-04_r8,1.4124e-04_r8,1.2316e-04_r8,7.5929e-05_r8/) + kbo(:, 4,22, 2) = (/ & + &1.1711e-04_r8,2.0303e-04_r8,2.0625e-04_r8,1.7599e-04_r8,9.2008e-05_r8/) + kbo(:, 5,22, 2) = (/ & + &1.8108e-04_r8,2.9768e-04_r8,2.9683e-04_r8,2.4768e-04_r8,1.0998e-04_r8/) + kbo(:, 1,23, 2) = (/ & + &3.1003e-05_r8,5.3823e-05_r8,5.7061e-05_r8,5.1271e-05_r8,4.0280e-05_r8/) + kbo(:, 2,23, 2) = (/ & + &4.3496e-05_r8,7.9103e-05_r8,8.3635e-05_r8,7.4369e-05_r8,5.0624e-05_r8/) + kbo(:, 3,23, 2) = (/ & + &6.5401e-05_r8,1.1830e-04_r8,1.2269e-04_r8,1.0707e-04_r8,6.2127e-05_r8/) + kbo(:, 4,23, 2) = (/ & + &1.0147e-04_r8,1.7576e-04_r8,1.7852e-04_r8,1.5248e-04_r8,7.5578e-05_r8/) + kbo(:, 5,23, 2) = (/ & + &1.5625e-04_r8,2.5690e-04_r8,2.5634e-04_r8,2.1357e-04_r8,9.0733e-05_r8/) + kbo(:, 1,24, 2) = (/ & + &2.6471e-05_r8,4.6863e-05_r8,4.9818e-05_r8,4.4807e-05_r8,3.2886e-05_r8/) + kbo(:, 2,24, 2) = (/ & + &3.7731e-05_r8,6.9280e-05_r8,7.2915e-05_r8,6.4892e-05_r8,4.1198e-05_r8/) + kbo(:, 3,24, 2) = (/ & + &5.7248e-05_r8,1.0347e-04_r8,1.0698e-04_r8,9.3403e-05_r8,5.0808e-05_r8/) + kbo(:, 4,24, 2) = (/ & + &8.8791e-05_r8,1.5319e-04_r8,1.5530e-04_r8,1.3247e-04_r8,6.1812e-05_r8/) + kbo(:, 5,24, 2) = (/ & + &1.3624e-04_r8,2.2303e-04_r8,2.2220e-04_r8,1.8474e-04_r8,7.4324e-05_r8/) + kbo(:, 1,25, 2) = (/ & + &2.2808e-05_r8,4.1048e-05_r8,4.3589e-05_r8,3.9316e-05_r8,2.6891e-05_r8/) + kbo(:, 2,25, 2) = (/ & + &3.2985e-05_r8,6.0936e-05_r8,6.3907e-05_r8,5.6898e-05_r8,3.3888e-05_r8/) + kbo(:, 3,25, 2) = (/ & + &5.0481e-05_r8,9.0713e-05_r8,9.3687e-05_r8,8.1693e-05_r8,4.1615e-05_r8/) + kbo(:, 4,25, 2) = (/ & + &7.8151e-05_r8,1.3406e-04_r8,1.3563e-04_r8,1.1547e-04_r8,5.0834e-05_r8/) + kbo(:, 5,25, 2) = (/ & + &1.1946e-04_r8,1.9452e-04_r8,1.9337e-04_r8,1.6037e-04_r8,6.0346e-05_r8/) + kbo(:, 1,26, 2) = (/ & + &1.9934e-05_r8,3.6349e-05_r8,3.8562e-05_r8,3.4809e-05_r8,2.2369e-05_r8/) + kbo(:, 2,26, 2) = (/ & + &2.9291e-05_r8,5.4051e-05_r8,5.6667e-05_r8,5.0301e-05_r8,2.7895e-05_r8/) + kbo(:, 3,26, 2) = (/ & + &4.5044e-05_r8,8.0419e-05_r8,8.2812e-05_r8,7.2007e-05_r8,3.4611e-05_r8/) + kbo(:, 4,26, 2) = (/ & + &6.9643e-05_r8,1.1855e-04_r8,1.1958e-04_r8,1.0144e-04_r8,4.1836e-05_r8/) + kbo(:, 5,26, 2) = (/ & + &1.0589e-04_r8,1.7128e-04_r8,1.6969e-04_r8,1.4033e-04_r8,4.9219e-05_r8/) + kbo(:, 1,27, 2) = (/ & + &1.7559e-05_r8,3.2313e-05_r8,3.4216e-05_r8,3.0835e-05_r8,1.8255e-05_r8/) + kbo(:, 2,27, 2) = (/ & + &2.6182e-05_r8,4.8079e-05_r8,5.0267e-05_r8,4.4498e-05_r8,2.3042e-05_r8/) + kbo(:, 3,27, 2) = (/ & + &4.0350e-05_r8,7.1540e-05_r8,7.3359e-05_r8,6.3538e-05_r8,2.8359e-05_r8/) + kbo(:, 4,27, 2) = (/ & + &6.2227e-05_r8,1.0500e-04_r8,1.0550e-04_r8,8.9231e-05_r8,3.3804e-05_r8/) + kbo(:, 5,27, 2) = (/ & + &9.4129e-05_r8,1.5114e-04_r8,1.4903e-04_r8,1.2285e-04_r8,4.0082e-05_r8/) + kbo(:, 1,28, 2) = (/ & + &1.5570e-05_r8,2.8729e-05_r8,3.0391e-05_r8,2.7331e-05_r8,1.4928e-05_r8/) + kbo(:, 2,28, 2) = (/ & + &2.3454e-05_r8,4.2868e-05_r8,4.4647e-05_r8,3.9416e-05_r8,1.8685e-05_r8/) + kbo(:, 3,28, 2) = (/ & + &3.6218e-05_r8,6.3627e-05_r8,6.4995e-05_r8,5.6106e-05_r8,2.2770e-05_r8/) + kbo(:, 4,28, 2) = (/ & + &5.5686e-05_r8,9.3113e-05_r8,9.3100e-05_r8,7.8497e-05_r8,2.7363e-05_r8/) + kbo(:, 5,28, 2) = (/ & + &8.3686e-05_r8,1.3339e-04_r8,1.3104e-04_r8,1.0755e-04_r8,3.2541e-05_r8/) + kbo(:, 1,29, 2) = (/ & + &1.3843e-05_r8,2.5623e-05_r8,2.7065e-05_r8,2.4295e-05_r8,1.2134e-05_r8/) + kbo(:, 2,29, 2) = (/ & + &2.1009e-05_r8,3.8248e-05_r8,3.9732e-05_r8,3.4977e-05_r8,1.5044e-05_r8/) + kbo(:, 3,29, 2) = (/ & + &3.2483e-05_r8,5.6676e-05_r8,5.7569e-05_r8,4.9592e-05_r8,1.8408e-05_r8/) + kbo(:, 4,29, 2) = (/ & + &4.9712e-05_r8,8.2574e-05_r8,8.2234e-05_r8,6.9025e-05_r8,2.2259e-05_r8/) + kbo(:, 5,29, 2) = (/ & + &7.4303e-05_r8,1.1753e-04_r8,1.1526e-04_r8,9.4159e-05_r8,2.6343e-05_r8/) + kbo(:, 1,30, 2) = (/ & + &1.2283e-05_r8,2.2826e-05_r8,2.4077e-05_r8,2.1586e-05_r8,9.7017e-06_r8/) + kbo(:, 2,30, 2) = (/ & + &1.8796e-05_r8,3.4070e-05_r8,3.5216e-05_r8,3.0990e-05_r8,1.2060e-05_r8/) + kbo(:, 3,30, 2) = (/ & + &2.9052e-05_r8,5.0361e-05_r8,5.0950e-05_r8,4.3716e-05_r8,1.4847e-05_r8/) + kbo(:, 4,30, 2) = (/ & + &4.4245e-05_r8,7.2929e-05_r8,7.2487e-05_r8,6.0571e-05_r8,1.7868e-05_r8/) + kbo(:, 5,30, 2) = (/ & + &6.5686e-05_r8,1.0336e-04_r8,1.0108e-04_r8,8.2235e-05_r8,2.0877e-05_r8/) + kbo(:, 1,31, 2) = (/ & + &1.0864e-05_r8,2.0303e-05_r8,2.1341e-05_r8,1.9138e-05_r8,7.8312e-06_r8/) + kbo(:, 2,31, 2) = (/ & + &1.6718e-05_r8,3.0263e-05_r8,3.1180e-05_r8,2.7363e-05_r8,9.6909e-06_r8/) + kbo(:, 3,31, 2) = (/ & + &2.5784e-05_r8,4.4485e-05_r8,4.4959e-05_r8,3.8436e-05_r8,1.1703e-05_r8/) + kbo(:, 4,31, 2) = (/ & + &3.9035e-05_r8,6.4113e-05_r8,6.3593e-05_r8,5.2930e-05_r8,1.4083e-05_r8/) + kbo(:, 5,31, 2) = (/ & + &5.7600e-05_r8,9.0427e-05_r8,8.8190e-05_r8,7.1491e-05_r8,1.6696e-05_r8/) + kbo(:, 1,32, 2) = (/ & + &9.6861e-06_r8,1.8129e-05_r8,1.9009e-05_r8,1.7005e-05_r8,6.3389e-06_r8/) + kbo(:, 2,32, 2) = (/ & + &1.4957e-05_r8,2.6929e-05_r8,2.7692e-05_r8,2.4209e-05_r8,7.7689e-06_r8/) + kbo(:, 3,32, 2) = (/ & + &2.2989e-05_r8,3.9434e-05_r8,3.9744e-05_r8,3.3837e-05_r8,9.3738e-06_r8/) + kbo(:, 4,32, 2) = (/ & + &3.4606e-05_r8,5.6545e-05_r8,5.5926e-05_r8,4.6356e-05_r8,1.1253e-05_r8/) + kbo(:, 5,32, 2) = (/ & + &5.0712e-05_r8,7.9301e-05_r8,7.7059e-05_r8,6.2285e-05_r8,1.3276e-05_r8/) + kbo(:, 1,33, 2) = (/ & + &8.6881e-06_r8,1.6215e-05_r8,1.6965e-05_r8,1.5122e-05_r8,5.0839e-06_r8/) + kbo(:, 2,33, 2) = (/ & + &1.3426e-05_r8,2.4037e-05_r8,2.4628e-05_r8,2.1434e-05_r8,6.2318e-06_r8/) + kbo(:, 3,33, 2) = (/ & + &2.0550e-05_r8,3.5027e-05_r8,3.5160e-05_r8,2.9820e-05_r8,7.5123e-06_r8/) + kbo(:, 4,33, 2) = (/ & + &3.0762e-05_r8,4.9971e-05_r8,4.9236e-05_r8,4.0640e-05_r8,8.9286e-06_r8/) + kbo(:, 5,33, 2) = (/ & + &4.4719e-05_r8,6.9592e-05_r8,6.7432e-05_r8,5.4322e-05_r8,1.0569e-05_r8/) + kbo(:, 1,34, 2) = (/ & + &7.7791e-06_r8,1.4442e-05_r8,1.5046e-05_r8,1.3360e-05_r8,4.1600e-06_r8/) + kbo(:, 2,34, 2) = (/ & + &1.2019e-05_r8,2.1346e-05_r8,2.1771e-05_r8,1.8857e-05_r8,5.0353e-06_r8/) + kbo(:, 3,34, 2) = (/ & + &1.8324e-05_r8,3.0972e-05_r8,3.0949e-05_r8,2.6117e-05_r8,6.0447e-06_r8/) + kbo(:, 4,34, 2) = (/ & + &2.7261e-05_r8,4.3932e-05_r8,4.3157e-05_r8,3.5442e-05_r8,7.1905e-06_r8/) + kbo(:, 5,34, 2) = (/ & + &3.9385e-05_r8,6.0888e-05_r8,5.8795e-05_r8,4.7179e-05_r8,8.5133e-06_r8/) + kbo(:, 1,35, 2) = (/ & + &6.6949e-06_r8,1.2390e-05_r8,1.2873e-05_r8,1.1410e-05_r8,3.2837e-06_r8/) + kbo(:, 2,35, 2) = (/ & + &1.0342e-05_r8,1.8289e-05_r8,1.8599e-05_r8,1.6068e-05_r8,4.0072e-06_r8/) + kbo(:, 3,35, 2) = (/ & + &1.5729e-05_r8,2.6447e-05_r8,2.6382e-05_r8,2.2198e-05_r8,4.8111e-06_r8/) + kbo(:, 4,35, 2) = (/ & + &2.3326e-05_r8,3.7424e-05_r8,3.6694e-05_r8,3.0052e-05_r8,5.7503e-06_r8/) + kbo(:, 5,35, 2) = (/ & + &3.3582e-05_r8,5.1735e-05_r8,4.9852e-05_r8,3.9921e-05_r8,6.8317e-06_r8/) + kbo(:, 1,36, 2) = (/ & + &5.5116e-06_r8,1.0195e-05_r8,1.0585e-05_r8,9.3814e-06_r8,2.5556e-06_r8/) + kbo(:, 2,36, 2) = (/ & + &8.5137e-06_r8,1.5037e-05_r8,1.5296e-05_r8,1.3209e-05_r8,3.1325e-06_r8/) + kbo(:, 3,36, 2) = (/ & + &1.2948e-05_r8,2.1753e-05_r8,2.1694e-05_r8,1.8250e-05_r8,3.7680e-06_r8/) + kbo(:, 4,36, 2) = (/ & + &1.9198e-05_r8,3.0787e-05_r8,3.0171e-05_r8,2.4706e-05_r8,4.5193e-06_r8/) + kbo(:, 5,36, 2) = (/ & + &2.7624e-05_r8,4.2550e-05_r8,4.0975e-05_r8,3.2811e-05_r8,5.3463e-06_r8/) + kbo(:, 1,37, 2) = (/ & + &4.2943e-06_r8,7.9625e-06_r8,8.2825e-06_r8,7.3555e-06_r8,1.9862e-06_r8/) + kbo(:, 2,37, 2) = (/ & + &6.6379e-06_r8,1.1772e-05_r8,1.1998e-05_r8,1.0386e-05_r8,2.4388e-06_r8/) + kbo(:, 3,37, 2) = (/ & + &1.0124e-05_r8,1.7087e-05_r8,1.7068e-05_r8,1.4395e-05_r8,2.9448e-06_r8/) + kbo(:, 4,37, 2) = (/ & + &1.5070e-05_r8,2.4266e-05_r8,2.3812e-05_r8,1.9543e-05_r8,3.5287e-06_r8/) + kbo(:, 5,37, 2) = (/ & + &2.1767e-05_r8,3.3653e-05_r8,3.2450e-05_r8,2.6024e-05_r8,4.1879e-06_r8/) + kbo(:, 1,38, 2) = (/ & + &3.3357e-06_r8,6.1963e-06_r8,6.4603e-06_r8,5.7499e-06_r8,1.5402e-06_r8/) + kbo(:, 2,38, 2) = (/ & + &5.1578e-06_r8,9.1863e-06_r8,9.3819e-06_r8,8.1434e-06_r8,1.8945e-06_r8/) + kbo(:, 3,38, 2) = (/ & + &7.8901e-06_r8,1.3380e-05_r8,1.3389e-05_r8,1.1321e-05_r8,2.2920e-06_r8/) + kbo(:, 4,38, 2) = (/ & + &1.1791e-05_r8,1.9066e-05_r8,1.8739e-05_r8,1.5418e-05_r8,2.7521e-06_r8/) + kbo(:, 5,38, 2) = (/ & + &1.7101e-05_r8,2.6537e-05_r8,2.5629e-05_r8,2.0591e-05_r8,3.2788e-06_r8/) + kbo(:, 1,39, 2) = (/ & + &2.5925e-06_r8,4.8221e-06_r8,5.0377e-06_r8,4.4928e-06_r8,1.1896e-06_r8/) + kbo(:, 2,39, 2) = (/ & + &4.0080e-06_r8,7.1657e-06_r8,7.3339e-06_r8,6.3822e-06_r8,1.4636e-06_r8/) + kbo(:, 3,39, 2) = (/ & + &6.1480e-06_r8,1.0471e-05_r8,1.0498e-05_r8,8.8998e-06_r8,1.7757e-06_r8/) + kbo(:, 4,39, 2) = (/ & + &9.2224e-06_r8,1.4975e-05_r8,1.4740e-05_r8,1.2159e-05_r8,2.1407e-06_r8/) + kbo(:, 5,39, 2) = (/ & + &1.3430e-05_r8,2.0919e-05_r8,2.0232e-05_r8,1.6286e-05_r8,2.5517e-06_r8/) + kbo(:, 1,40, 2) = (/ & + &1.9503e-06_r8,3.6256e-06_r8,3.7983e-06_r8,3.3983e-06_r8,9.0970e-07_r8/) + kbo(:, 2,40, 2) = (/ & + &3.0096e-06_r8,5.4072e-06_r8,5.5509e-06_r8,4.8509e-06_r8,1.1295e-06_r8/) + kbo(:, 3,40, 2) = (/ & + &4.6341e-06_r8,7.9436e-06_r8,7.9881e-06_r8,6.7974e-06_r8,1.3749e-06_r8/) + kbo(:, 4,40, 2) = (/ & + &6.9959e-06_r8,1.1429e-05_r8,1.1278e-05_r8,9.3390e-06_r8,1.6560e-06_r8/) + kbo(:, 5,40, 2) = (/ & + &1.0262e-05_r8,1.6061e-05_r8,1.5575e-05_r8,1.2573e-05_r8,1.9765e-06_r8/) + kbo(:, 1,41, 2) = (/ & + &1.4645e-06_r8,2.7131e-06_r8,2.8491e-06_r8,2.5571e-06_r8,6.9451e-07_r8/) + kbo(:, 2,41, 2) = (/ & + &2.2502e-06_r8,4.0586e-06_r8,4.1799e-06_r8,3.6674e-06_r8,8.6660e-07_r8/) + kbo(:, 3,41, 2) = (/ & + &3.4750e-06_r8,5.9931e-06_r8,6.0465e-06_r8,5.1654e-06_r8,1.0602e-06_r8/) + kbo(:, 4,41, 2) = (/ & + &5.2792e-06_r8,8.6774e-06_r8,8.5850e-06_r8,7.1396e-06_r8,1.2820e-06_r8/) + kbo(:, 5,41, 2) = (/ & + &7.8024e-06_r8,1.2273e-05_r8,1.1934e-05_r8,9.6653e-06_r8,1.5281e-06_r8/) + kbo(:, 1,42, 2) = (/ & + &1.1030e-06_r8,2.0298e-06_r8,2.1354e-06_r8,1.9220e-06_r8,5.2769e-07_r8/) + kbo(:, 2,42, 2) = (/ & + &1.6830e-06_r8,3.0429e-06_r8,3.1437e-06_r8,2.7680e-06_r8,6.5992e-07_r8/) + kbo(:, 3,42, 2) = (/ & + &2.6031e-06_r8,4.5149e-06_r8,4.5688e-06_r8,3.9192e-06_r8,8.1465e-07_r8/) + kbo(:, 4,42, 2) = (/ & + &3.9772e-06_r8,6.5768e-06_r8,6.5252e-06_r8,5.4495e-06_r8,9.8750e-07_r8/) + kbo(:, 5,42, 2) = (/ & + &5.9212e-06_r8,9.3604e-06_r8,9.1253e-06_r8,7.4182e-06_r8,1.1776e-06_r8/) + kbo(:, 1,43, 2) = (/ & + &8.2428e-07_r8,1.4953e-06_r8,1.5737e-06_r8,1.4196e-06_r8,3.9479e-07_r8/) + kbo(:, 2,43, 2) = (/ & + &1.2422e-06_r8,2.2430e-06_r8,2.3243e-06_r8,2.0532e-06_r8,4.9846e-07_r8/) + kbo(:, 3,43, 2) = (/ & + &1.9204e-06_r8,3.3444e-06_r8,3.3959e-06_r8,2.9263e-06_r8,6.1792e-07_r8/) + kbo(:, 4,43, 2) = (/ & + &2.9515e-06_r8,4.9083e-06_r8,4.8847e-06_r8,4.0977e-06_r8,7.5196e-07_r8/) + kbo(:, 5,43, 2) = (/ & + &4.4328e-06_r8,7.0409e-06_r8,6.8831e-06_r8,5.6178e-06_r8,9.0060e-07_r8/) + kbo(:, 1,44, 2) = (/ & + &6.1791e-07_r8,1.0964e-06_r8,1.1526e-06_r8,1.0396e-06_r8,2.9276e-07_r8/) + kbo(:, 2,44, 2) = (/ & + &9.1458e-07_r8,1.6410e-06_r8,1.7044e-06_r8,1.5103e-06_r8,3.7305e-07_r8/) + kbo(:, 3,44, 2) = (/ & + &1.4081e-06_r8,2.4567e-06_r8,2.5035e-06_r8,2.1667e-06_r8,4.6414e-07_r8/) + kbo(:, 4,44, 2) = (/ & + &2.1742e-06_r8,3.6323e-06_r8,3.6267e-06_r8,3.0560e-06_r8,5.6825e-07_r8/) + kbo(:, 5,44, 2) = (/ & + &3.2939e-06_r8,5.2553e-06_r8,5.1516e-06_r8,4.2228e-06_r8,6.8470e-07_r8/) + kbo(:, 1,45, 2) = (/ & + &4.6818e-07_r8,8.0720e-07_r8,8.4515e-07_r8,7.6099e-07_r8,2.1643e-07_r8/) + kbo(:, 2,45, 2) = (/ & + &6.7728e-07_r8,1.2013e-06_r8,1.2493e-06_r8,1.1096e-06_r8,2.7840e-07_r8/) + kbo(:, 3,45, 2) = (/ & + &1.0340e-06_r8,1.8032e-06_r8,1.8431e-06_r8,1.6011e-06_r8,3.4809e-07_r8/) + kbo(:, 4,45, 2) = (/ & + &1.6004e-06_r8,2.6834e-06_r8,2.6875e-06_r8,2.2740e-06_r8,4.2767e-07_r8/) + kbo(:, 5,45, 2) = (/ & + &2.4431e-06_r8,3.9144e-06_r8,3.8469e-06_r8,3.1675e-06_r8,5.1847e-07_r8/) + kbo(:, 1,46, 2) = (/ & + &3.5715e-07_r8,5.9421e-07_r8,6.1734e-07_r8,5.5305e-07_r8,1.5800e-07_r8/) + kbo(:, 2,46, 2) = (/ & + &5.0187e-07_r8,8.7381e-07_r8,9.0848e-07_r8,8.0843e-07_r8,2.0563e-07_r8/) + kbo(:, 3,46, 2) = (/ & + &7.5515e-07_r8,1.3118e-06_r8,1.3445e-06_r8,1.1721e-06_r8,2.5967e-07_r8/) + kbo(:, 4,46, 2) = (/ & + &1.1677e-06_r8,1.9633e-06_r8,1.9726e-06_r8,1.6766e-06_r8,3.2108e-07_r8/) + kbo(:, 5,46, 2) = (/ & + &1.7950e-06_r8,2.8885e-06_r8,2.8468e-06_r8,2.3553e-06_r8,3.9011e-07_r8/) + kbo(:, 1,47, 2) = (/ & + &2.7398e-07_r8,4.3581e-07_r8,4.4704e-07_r8,3.9668e-07_r8,1.1323e-07_r8/) + kbo(:, 2,47, 2) = (/ & + &3.7103e-07_r8,6.2850e-07_r8,6.5163e-07_r8,5.8000e-07_r8,1.4990e-07_r8/) + kbo(:, 3,47, 2) = (/ & + &5.4577e-07_r8,9.3956e-07_r8,9.6531e-07_r8,8.4415e-07_r8,1.9262e-07_r8/) + kbo(:, 4,47, 2) = (/ & + &8.3895e-07_r8,1.4116e-06_r8,1.4241e-06_r8,1.2169e-06_r8,2.3951e-07_r8/) + kbo(:, 5,47, 2) = (/ & + &1.2964e-06_r8,2.0956e-06_r8,2.0729e-06_r8,1.7247e-06_r8,2.9208e-07_r8/) + kbo(:, 1,48, 2) = (/ & + &2.1387e-07_r8,3.2471e-07_r8,3.2631e-07_r8,2.8559e-07_r8,7.9995e-08_r8/) + kbo(:, 2,48, 2) = (/ & + &2.7873e-07_r8,4.5569e-07_r8,4.6902e-07_r8,4.1584e-07_r8,1.0856e-07_r8/) + kbo(:, 3,48, 2) = (/ & + &3.9810e-07_r8,6.7425e-07_r8,6.9287e-07_r8,6.0740e-07_r8,1.4073e-07_r8/) + kbo(:, 4,48, 2) = (/ & + &6.0448e-07_r8,1.0143e-06_r8,1.0265e-06_r8,8.8097e-07_r8,1.7712e-07_r8/) + kbo(:, 5,48, 2) = (/ & + &9.3542e-07_r8,1.5166e-06_r8,1.5052e-06_r8,1.2587e-06_r8,2.1758e-07_r8/) + kbo(:, 1,49, 2) = (/ & + &1.6983e-07_r8,2.4624e-07_r8,2.4047e-07_r8,2.0742e-07_r8,5.5874e-08_r8/) + kbo(:, 2,49, 2) = (/ & + &2.1316e-07_r8,3.3392e-07_r8,3.3939e-07_r8,2.9852e-07_r8,7.7373e-08_r8/) + kbo(:, 3,49, 2) = (/ & + &2.9400e-07_r8,4.8579e-07_r8,4.9802e-07_r8,4.3681e-07_r8,1.0173e-07_r8/) + kbo(:, 4,49, 2) = (/ & + &4.3777e-07_r8,7.2867e-07_r8,7.3912e-07_r8,6.3632e-07_r8,1.2966e-07_r8/) + kbo(:, 5,49, 2) = (/ & + &6.7522e-07_r8,1.0953e-06_r8,1.0905e-06_r8,9.1600e-07_r8,1.6042e-07_r8/) + kbo(:, 1,50, 2) = (/ & + &1.3748e-07_r8,1.9105e-07_r8,1.8074e-07_r8,1.5294e-07_r8,4.0734e-08_r8/) + kbo(:, 2,50, 2) = (/ & + &1.6685e-07_r8,2.5027e-07_r8,2.4971e-07_r8,2.1712e-07_r8,5.5541e-08_r8/) + kbo(:, 3,50, 2) = (/ & + &2.2205e-07_r8,3.5580e-07_r8,3.6241e-07_r8,3.1709e-07_r8,7.4088e-08_r8/) + kbo(:, 4,50, 2) = (/ & + &3.2265e-07_r8,5.2953e-07_r8,5.3723e-07_r8,4.6323e-07_r8,9.5830e-08_r8/) + kbo(:, 5,50, 2) = (/ & + &4.9355e-07_r8,7.9777e-07_r8,7.9617e-07_r8,6.7111e-07_r8,1.2000e-07_r8/) + kbo(:, 1,51, 2) = (/ & + &1.1310e-07_r8,1.5095e-07_r8,1.3873e-07_r8,1.1416e-07_r8,2.8930e-08_r8/) + kbo(:, 2,51, 2) = (/ & + &1.3297e-07_r8,1.9104e-07_r8,1.8603e-07_r8,1.5944e-07_r8,3.9649e-08_r8/) + kbo(:, 3,51, 2) = (/ & + &1.7089e-07_r8,2.6387e-07_r8,2.6609e-07_r8,2.3142e-07_r8,5.4118e-08_r8/) + kbo(:, 4,51, 2) = (/ & + &2.4121e-07_r8,3.8782e-07_r8,3.9262e-07_r8,3.3860e-07_r8,7.0920e-08_r8/) + kbo(:, 5,51, 2) = (/ & + &3.6391e-07_r8,5.8370e-07_r8,5.8331e-07_r8,4.9304e-07_r8,8.9643e-08_r8/) + kbo(:, 1,52, 2) = (/ & + &9.4432e-08_r8,1.2100e-07_r8,1.0830e-07_r8,8.6173e-08_r8,2.0454e-08_r8/) + kbo(:, 2,52, 2) = (/ & + &1.0754e-07_r8,1.4816e-07_r8,1.4031e-07_r8,1.1784e-07_r8,2.8884e-08_r8/) + kbo(:, 3,52, 2) = (/ & + &1.3365e-07_r8,1.9803e-07_r8,1.9664e-07_r8,1.6925e-07_r8,3.9314e-08_r8/) + kbo(:, 4,52, 2) = (/ & + &1.8256e-07_r8,2.8565e-07_r8,2.8767e-07_r8,2.4757e-07_r8,5.1552e-08_r8/) + kbo(:, 5,52, 2) = (/ & + &2.7006e-07_r8,4.2782e-07_r8,4.2750e-07_r8,3.6187e-07_r8,6.6239e-08_r8/) + kbo(:, 1,53, 2) = (/ & + &7.9939e-08_r8,9.8272e-08_r8,8.6307e-08_r8,6.6012e-08_r8,1.4604e-08_r8/) + kbo(:, 2,53, 2) = (/ & + &8.8279e-08_r8,1.1673e-07_r8,1.0758e-07_r8,8.7937e-08_r8,2.0451e-08_r8/) + kbo(:, 3,53, 2) = (/ & + &1.0623e-07_r8,1.5078e-07_r8,1.4654e-07_r8,1.2425e-07_r8,2.8208e-08_r8/) + kbo(:, 4,53, 2) = (/ & + &1.4011e-07_r8,2.1203e-07_r8,2.1153e-07_r8,1.8129e-07_r8,3.7255e-08_r8/) + kbo(:, 5,53, 2) = (/ & + &2.0211e-07_r8,3.1443e-07_r8,3.1357e-07_r8,2.6539e-07_r8,4.8314e-08_r8/) + kbo(:, 1,54, 2) = (/ & + &6.8612e-08_r8,8.0858e-08_r8,7.0080e-08_r8,5.1088e-08_r8,1.0952e-08_r8/) + kbo(:, 2,54, 2) = (/ & + &7.3786e-08_r8,9.3902e-08_r8,8.4431e-08_r8,6.7059e-08_r8,1.4950e-08_r8/) + kbo(:, 3,54, 2) = (/ & + &8.6236e-08_r8,1.1751e-07_r8,1.1148e-07_r8,9.2909e-08_r8,2.0689e-08_r8/) + kbo(:, 4,54, 2) = (/ & + &1.1017e-07_r8,1.6065e-07_r8,1.5823e-07_r8,1.3458e-07_r8,2.7837e-08_r8/) + kbo(:, 5,54, 2) = (/ & + &1.5462e-07_r8,2.3495e-07_r8,2.3325e-07_r8,1.9698e-07_r8,3.6383e-08_r8/) + kbo(:, 1,55, 2) = (/ & + &5.9732e-08_r8,6.7403e-08_r8,5.7777e-08_r8,3.9915e-08_r8,8.5037e-09_r8/) + kbo(:, 2,55, 2) = (/ & + &6.2576e-08_r8,7.6690e-08_r8,6.7863e-08_r8,5.1930e-08_r8,1.1059e-08_r8/) + kbo(:, 3,55, 2) = (/ & + &7.1126e-08_r8,9.3200e-08_r8,8.6382e-08_r8,7.0395e-08_r8,1.5573e-08_r8/) + kbo(:, 4,55, 2) = (/ & + &8.8230e-08_r8,1.2378e-07_r8,1.1984e-07_r8,1.0085e-07_r8,2.1225e-08_r8/) + kbo(:, 5,55, 2) = (/ & + &1.2026e-07_r8,1.7765e-07_r8,1.7500e-07_r8,1.4721e-07_r8,2.7783e-08_r8/) + kbo(:, 1,56, 2) = (/ & + &5.2687e-08_r8,5.6857e-08_r8,4.7895e-08_r8,3.2001e-08_r8,6.6275e-09_r8/) + kbo(:, 2,56, 2) = (/ & + &5.3766e-08_r8,6.3415e-08_r8,5.5171e-08_r8,4.0341e-08_r8,8.2176e-09_r8/) + kbo(:, 3,56, 2) = (/ & + &5.9487e-08_r8,7.5070e-08_r8,6.7900e-08_r8,5.3874e-08_r8,1.1605e-08_r8/) + kbo(:, 4,56, 2) = (/ & + &7.1736e-08_r8,9.6663e-08_r8,9.1606e-08_r8,7.5983e-08_r8,1.6105e-08_r8/) + kbo(:, 5,56, 2) = (/ & + &9.4811e-08_r8,1.3547e-07_r8,1.3204e-07_r8,1.1036e-07_r8,2.1203e-08_r8/) + kbo(:, 1,57, 2) = (/ & + &4.7030e-08_r8,4.8568e-08_r8,3.9988e-08_r8,2.6219e-08_r8,4.9408e-09_r8/) + kbo(:, 2,57, 2) = (/ & + &4.6811e-08_r8,5.3015e-08_r8,4.5546e-08_r8,3.1769e-08_r8,6.1353e-09_r8/) + kbo(:, 3,57, 2) = (/ & + &5.0494e-08_r8,6.1370e-08_r8,5.4487e-08_r8,4.1710e-08_r8,8.6536e-09_r8/) + kbo(:, 4,57, 2) = (/ & + &5.9216e-08_r8,7.6592e-08_r8,7.0994e-08_r8,5.7693e-08_r8,1.1916e-08_r8/) + kbo(:, 5,57, 2) = (/ & + &7.5908e-08_r8,1.0451e-07_r8,1.0035e-07_r8,8.3097e-08_r8,1.6230e-08_r8/) + kbo(:, 1,58, 2) = (/ & + &2.0524e-08_r8,2.3377e-08_r8,2.2103e-08_r8,1.7291e-08_r8,3.6303e-09_r8/) + kbo(:, 2,58, 2) = (/ & + &2.0023e-08_r8,2.5008e-08_r8,2.4831e-08_r8,2.0273e-08_r8,4.7070e-09_r8/) + kbo(:, 3,58, 2) = (/ & + &2.1076e-08_r8,2.8356e-08_r8,2.8987e-08_r8,2.5840e-08_r8,6.5048e-09_r8/) + kbo(:, 4,58, 2) = (/ & + &2.4072e-08_r8,3.4377e-08_r8,3.6577e-08_r8,3.5144e-08_r8,8.9689e-09_r8/) + kbo(:, 5,58, 2) = (/ & + &3.0004e-08_r8,4.5626e-08_r8,5.0474e-08_r8,4.9976e-08_r8,1.2428e-08_r8/) + kbo(:, 1,59, 2) = (/ & + &1.7700e-08_r8,1.9843e-08_r8,1.8643e-08_r8,1.4520e-08_r8,2.9679e-09_r8/) + kbo(:, 2,59, 2) = (/ & + &1.7149e-08_r8,2.1008e-08_r8,2.0747e-08_r8,1.6830e-08_r8,3.9081e-09_r8/) + kbo(:, 3,59, 2) = (/ & + &1.7873e-08_r8,2.3612e-08_r8,2.4046e-08_r8,2.1098e-08_r8,5.4593e-09_r8/) + kbo(:, 4,59, 2) = (/ & + &2.0201e-08_r8,2.8287e-08_r8,2.9905e-08_r8,2.8473e-08_r8,7.4791e-09_r8/) + kbo(:, 5,59, 2) = (/ & + &2.4905e-08_r8,3.7065e-08_r8,4.0703e-08_r8,4.0125e-08_r8,1.0391e-08_r8/) + kbo(:, 1,13, 3) = (/ & + &7.5570e-04_r8,1.0772e-03_r8,1.0524e-03_r8,8.5610e-04_r8,5.7960e-04_r8/) + kbo(:, 2,13, 3) = (/ & + &1.1289e-03_r8,1.5736e-03_r8,1.5191e-03_r8,1.2213e-03_r8,7.5295e-04_r8/) + kbo(:, 3,13, 3) = (/ & + &1.7896e-03_r8,2.3714e-03_r8,2.2650e-03_r8,1.7547e-03_r8,9.2113e-04_r8/) + kbo(:, 4,13, 3) = (/ & + &2.8881e-03_r8,3.6381e-03_r8,3.3414e-03_r8,2.5211e-03_r8,1.0886e-03_r8/) + kbo(:, 5,13, 3) = (/ & + &4.6526e-03_r8,5.5012e-03_r8,4.9005e-03_r8,3.6099e-03_r8,1.2715e-03_r8/) + kbo(:, 1,14, 3) = (/ & + &6.5628e-04_r8,9.2369e-04_r8,9.0249e-04_r8,7.3144e-04_r8,5.2166e-04_r8/) + kbo(:, 2,14, 3) = (/ & + &1.0001e-03_r8,1.3681e-03_r8,1.3197e-03_r8,1.0469e-03_r8,6.6148e-04_r8/) + kbo(:, 3,14, 3) = (/ & + &1.6037e-03_r8,2.0859e-03_r8,1.9738e-03_r8,1.5151e-03_r8,7.9350e-04_r8/) + kbo(:, 4,14, 3) = (/ & + &2.6225e-03_r8,3.2284e-03_r8,2.9281e-03_r8,2.1941e-03_r8,9.2716e-04_r8/) + kbo(:, 5,14, 3) = (/ & + &4.2437e-03_r8,4.9002e-03_r8,4.3187e-03_r8,3.1691e-03_r8,1.0609e-03_r8/) + kbo(:, 1,15, 3) = (/ & + &5.5021e-04_r8,7.7058e-04_r8,7.4997e-04_r8,6.0721e-04_r8,4.5513e-04_r8/) + kbo(:, 2,15, 3) = (/ & + &8.5046e-04_r8,1.1533e-03_r8,1.1173e-03_r8,8.7626e-04_r8,5.6093e-04_r8/) + kbo(:, 3,15, 3) = (/ & + &1.3828e-03_r8,1.7898e-03_r8,1.6630e-03_r8,1.2772e-03_r8,6.6129e-04_r8/) + kbo(:, 4,15, 3) = (/ & + &2.2885e-03_r8,2.7671e-03_r8,2.4977e-03_r8,1.8674e-03_r8,7.6057e-04_r8/) + kbo(:, 5,15, 3) = (/ & + &3.7000e-03_r8,4.2354e-03_r8,3.7118e-03_r8,2.7146e-03_r8,8.7024e-04_r8/) + kbo(:, 1,16, 3) = (/ & + &4.5181e-04_r8,6.3192e-04_r8,6.1748e-04_r8,4.9522e-04_r8,3.6566e-04_r8/) + kbo(:, 2,16, 3) = (/ & + &7.0837e-04_r8,9.6443e-04_r8,9.2028e-04_r8,7.2449e-04_r8,4.4224e-04_r8/) + kbo(:, 3,16, 3) = (/ & + &1.1719e-03_r8,1.5071e-03_r8,1.3916e-03_r8,1.0704e-03_r8,5.1878e-04_r8/) + kbo(:, 4,16, 3) = (/ & + &1.9347e-03_r8,2.3410e-03_r8,2.1054e-03_r8,1.5750e-03_r8,5.9381e-04_r8/) + kbo(:, 5,16, 3) = (/ & + &3.1267e-03_r8,3.5933e-03_r8,3.1446e-03_r8,2.3012e-03_r8,6.8790e-04_r8/) + kbo(:, 1,17, 3) = (/ & + &3.7149e-04_r8,5.2008e-04_r8,5.0762e-04_r8,4.0757e-04_r8,2.8847e-04_r8/) + kbo(:, 2,17, 3) = (/ & + &5.8832e-04_r8,8.0612e-04_r8,7.6169e-04_r8,6.0348e-04_r8,3.4723e-04_r8/) + kbo(:, 3,17, 3) = (/ & + &9.7995e-04_r8,1.2582e-03_r8,1.1654e-03_r8,8.9803e-04_r8,4.0483e-04_r8/) + kbo(:, 4,17, 3) = (/ & + &1.6147e-03_r8,1.9685e-03_r8,1.7733e-03_r8,1.3298e-03_r8,4.7136e-04_r8/) + kbo(:, 5,17, 3) = (/ & + &2.6071e-03_r8,3.0247e-03_r8,2.6450e-03_r8,1.9458e-03_r8,5.5921e-04_r8/) + kbo(:, 1,18, 3) = (/ & + &3.0061e-04_r8,4.2884e-04_r8,4.1648e-04_r8,3.3754e-04_r8,2.3127e-04_r8/) + kbo(:, 2,18, 3) = (/ & + &4.8246e-04_r8,6.6793e-04_r8,6.3270e-04_r8,5.0432e-04_r8,2.7279e-04_r8/) + kbo(:, 3,18, 3) = (/ & + &8.0392e-04_r8,1.0486e-03_r8,9.7147e-04_r8,7.5301e-04_r8,3.2007e-04_r8/) + kbo(:, 4,18, 3) = (/ & + &1.3260e-03_r8,1.6386e-03_r8,1.4792e-03_r8,1.1164e-03_r8,3.8144e-04_r8/) + kbo(:, 5,18, 3) = (/ & + &2.1473e-03_r8,2.5126e-03_r8,2.2067e-03_r8,1.6276e-03_r8,4.4653e-04_r8/) + kbo(:, 1,19, 3) = (/ & + &2.4724e-04_r8,3.5910e-04_r8,3.4734e-04_r8,2.8349e-04_r8,1.8511e-04_r8/) + kbo(:, 2,19, 3) = (/ & + &4.0125e-04_r8,5.6017e-04_r8,5.3189e-04_r8,4.2493e-04_r8,2.2055e-04_r8/) + kbo(:, 3,19, 3) = (/ & + &6.6924e-04_r8,8.8342e-04_r8,8.2067e-04_r8,6.3860e-04_r8,2.6260e-04_r8/) + kbo(:, 4,19, 3) = (/ & + &1.1061e-03_r8,1.3792e-03_r8,1.2462e-03_r8,9.4376e-04_r8,3.1226e-04_r8/) + kbo(:, 5,19, 3) = (/ & + &1.7964e-03_r8,2.1126e-03_r8,1.8583e-03_r8,1.3721e-03_r8,3.6746e-04_r8/) + kbo(:, 1,20, 3) = (/ & + &2.0934e-04_r8,3.0700e-04_r8,2.9722e-04_r8,2.4267e-04_r8,1.4926e-04_r8/) + kbo(:, 2,20, 3) = (/ & + &3.4260e-04_r8,4.8187e-04_r8,4.5763e-04_r8,3.6566e-04_r8,1.7991e-04_r8/) + kbo(:, 3,20, 3) = (/ & + &5.7163e-04_r8,7.5991e-04_r8,7.0644e-04_r8,5.4990e-04_r8,2.1557e-04_r8/) + kbo(:, 4,20, 3) = (/ & + &9.4873e-04_r8,1.1845e-03_r8,1.0719e-03_r8,8.1150e-04_r8,2.5564e-04_r8/) + kbo(:, 5,20, 3) = (/ & + &1.5383e-03_r8,1.8175e-03_r8,1.5965e-03_r8,1.1755e-03_r8,3.0407e-04_r8/) + kbo(:, 1,21, 3) = (/ & + &1.7843e-04_r8,2.6350e-04_r8,2.5564e-04_r8,2.0870e-04_r8,1.2133e-04_r8/) + kbo(:, 2,21, 3) = (/ & + &2.9332e-04_r8,4.1557e-04_r8,3.9544e-04_r8,3.1597e-04_r8,1.4677e-04_r8/) + kbo(:, 3,21, 3) = (/ & + &4.9132e-04_r8,6.5537e-04_r8,6.0874e-04_r8,4.7437e-04_r8,1.7728e-04_r8/) + kbo(:, 4,21, 3) = (/ & + &8.1854e-04_r8,1.0220e-03_r8,9.2374e-04_r8,6.9881e-04_r8,2.1085e-04_r8/) + kbo(:, 5,21, 3) = (/ & + &1.3233e-03_r8,1.5674e-03_r8,1.3737e-03_r8,1.0105e-03_r8,2.5000e-04_r8/) + kbo(:, 1,22, 3) = (/ & + &1.5600e-04_r8,2.3165e-04_r8,2.2455e-04_r8,1.8380e-04_r8,9.8965e-05_r8/) + kbo(:, 2,22, 3) = (/ & + &2.5879e-04_r8,3.6647e-04_r8,3.4891e-04_r8,2.7934e-04_r8,1.2038e-04_r8/) + kbo(:, 3,22, 3) = (/ & + &4.3583e-04_r8,5.7888e-04_r8,5.3753e-04_r8,4.1782e-04_r8,1.4492e-04_r8/) + kbo(:, 4,22, 3) = (/ & + &7.2393e-04_r8,9.0328e-04_r8,8.1451e-04_r8,6.1366e-04_r8,1.7404e-04_r8/) + kbo(:, 5,22, 3) = (/ & + &1.1641e-03_r8,1.3807e-03_r8,1.2062e-03_r8,8.8532e-04_r8,2.0548e-04_r8/) + kbo(:, 1,23, 3) = (/ & + &1.3677e-04_r8,2.0433e-04_r8,1.9788e-04_r8,1.6232e-04_r8,8.0071e-05_r8/) + kbo(:, 2,23, 3) = (/ & + &2.2851e-04_r8,3.2392e-04_r8,3.0774e-04_r8,2.4623e-04_r8,9.8059e-05_r8/) + kbo(:, 3,23, 3) = (/ & + &3.8639e-04_r8,5.1167e-04_r8,4.7457e-04_r8,3.6749e-04_r8,1.1880e-04_r8/) + kbo(:, 4,23, 3) = (/ & + &6.3801e-04_r8,7.9694e-04_r8,7.1675e-04_r8,5.3954e-04_r8,1.4295e-04_r8/) + kbo(:, 5,23, 3) = (/ & + &1.0211e-03_r8,1.2096e-03_r8,1.0561e-03_r8,7.7552e-04_r8,1.6841e-04_r8/) + kbo(:, 1,24, 3) = (/ & + &1.2065e-04_r8,1.8059e-04_r8,1.7513e-04_r8,1.4381e-04_r8,6.4790e-05_r8/) + kbo(:, 2,24, 3) = (/ & + &2.0387e-04_r8,2.8742e-04_r8,2.7331e-04_r8,2.1771e-04_r8,7.9169e-05_r8/) + kbo(:, 3,24, 3) = (/ & + &3.4413e-04_r8,4.5518e-04_r8,4.2044e-04_r8,3.2458e-04_r8,9.5995e-05_r8/) + kbo(:, 4,24, 3) = (/ & + &5.6569e-04_r8,7.0542e-04_r8,6.3169e-04_r8,4.7542e-04_r8,1.1593e-04_r8/) + kbo(:, 5,24, 3) = (/ & + &8.9817e-04_r8,1.0616e-03_r8,9.2695e-04_r8,6.8043e-04_r8,1.3621e-04_r8/) + kbo(:, 1,25, 3) = (/ & + &1.0740e-04_r8,1.6092e-04_r8,1.5588e-04_r8,1.2763e-04_r8,5.2835e-05_r8/) + kbo(:, 2,25, 3) = (/ & + &1.8277e-04_r8,2.5653e-04_r8,2.4346e-04_r8,1.9325e-04_r8,6.4708e-05_r8/) + kbo(:, 3,25, 3) = (/ & + &3.0775e-04_r8,4.0577e-04_r8,3.7301e-04_r8,2.8766e-04_r8,7.8479e-05_r8/) + kbo(:, 4,25, 3) = (/ & + &5.0348e-04_r8,6.2434e-04_r8,5.5838e-04_r8,4.1972e-04_r8,9.2999e-05_r8/) + kbo(:, 5,25, 3) = (/ & + &7.9236e-04_r8,9.3393e-04_r8,8.1486e-04_r8,5.9712e-04_r8,1.1091e-04_r8/) + kbo(:, 1,26, 3) = (/ & + &9.7543e-05_r8,1.4515e-04_r8,1.4079e-04_r8,1.1469e-04_r8,4.3203e-05_r8/) + kbo(:, 2,26, 3) = (/ & + &1.6637e-04_r8,2.3211e-04_r8,2.1906e-04_r8,1.7338e-04_r8,5.3501e-05_r8/) + kbo(:, 3,26, 3) = (/ & + &2.7898e-04_r8,3.6497e-04_r8,3.3420e-04_r8,2.5717e-04_r8,6.4391e-05_r8/) + kbo(:, 4,26, 3) = (/ & + &4.5278e-04_r8,5.5785e-04_r8,4.9753e-04_r8,3.7293e-04_r8,7.6357e-05_r8/) + kbo(:, 5,26, 3) = (/ & + &7.0495e-04_r8,8.2859e-04_r8,7.2055e-04_r8,5.2702e-04_r8,9.1483e-05_r8/) + kbo(:, 1,27, 3) = (/ & + &8.8905e-05_r8,1.3136e-04_r8,1.2690e-04_r8,1.0312e-04_r8,3.5556e-05_r8/) + kbo(:, 2,27, 3) = (/ & + &1.5157e-04_r8,2.0993e-04_r8,1.9708e-04_r8,1.5550e-04_r8,4.3708e-05_r8/) + kbo(:, 3,27, 3) = (/ & + &2.5313e-04_r8,3.2779e-04_r8,2.9943e-04_r8,2.2974e-04_r8,5.2449e-05_r8/) + kbo(:, 4,27, 3) = (/ & + &4.0707e-04_r8,4.9850e-04_r8,4.4267e-04_r8,3.3107e-04_r8,6.3153e-05_r8/) + kbo(:, 5,27, 3) = (/ & + &6.2804e-04_r8,7.3434e-04_r8,6.3748e-04_r8,4.6470e-04_r8,7.4410e-05_r8/) + kbo(:, 1,28, 3) = (/ & + &8.1071e-05_r8,1.1893e-04_r8,1.1441e-04_r8,9.2670e-05_r8,2.9048e-05_r8/) + kbo(:, 2,28, 3) = (/ & + &1.3818e-04_r8,1.8937e-04_r8,1.7730e-04_r8,1.3932e-04_r8,3.5467e-05_r8/) + kbo(:, 3,28, 3) = (/ & + &2.2925e-04_r8,2.9449e-04_r8,2.6762e-04_r8,2.0484e-04_r8,4.2994e-05_r8/) + kbo(:, 4,28, 3) = (/ & + &3.6544e-04_r8,4.4427e-04_r8,3.9356e-04_r8,2.9338e-04_r8,5.1335e-05_r8/) + kbo(:, 5,28, 3) = (/ & + &5.5873e-04_r8,6.5113e-04_r8,5.6346e-04_r8,4.0933e-04_r8,6.0144e-05_r8/) + kbo(:, 1,29, 3) = (/ & + &7.4203e-05_r8,1.0781e-04_r8,1.0341e-04_r8,8.3458e-05_r8,2.3671e-05_r8/) + kbo(:, 2,29, 3) = (/ & + &1.2605e-04_r8,1.7113e-04_r8,1.5936e-04_r8,1.2487e-04_r8,2.9121e-05_r8/) + kbo(:, 3,29, 3) = (/ & + &2.0703e-04_r8,2.6395e-04_r8,2.3919e-04_r8,1.8248e-04_r8,3.5057e-05_r8/) + kbo(:, 4,29, 3) = (/ & + &3.2741e-04_r8,3.9598e-04_r8,3.4952e-04_r8,2.5961e-04_r8,4.1444e-05_r8/) + kbo(:, 5,29, 3) = (/ & + &4.9624e-04_r8,5.7661e-04_r8,4.9724e-04_r8,3.6006e-04_r8,4.8751e-05_r8/) + kbo(:, 1,30, 3) = (/ & + &6.7677e-05_r8,9.7468e-05_r8,9.3138e-05_r8,7.4923e-05_r8,1.9287e-05_r8/) + kbo(:, 2,30, 3) = (/ & + &1.1431e-04_r8,1.5374e-04_r8,1.4284e-04_r8,1.1153e-04_r8,2.3591e-05_r8/) + kbo(:, 3,30, 3) = (/ & + &1.8623e-04_r8,2.3583e-04_r8,2.1291e-04_r8,1.6193e-04_r8,2.8158e-05_r8/) + kbo(:, 4,30, 3) = (/ & + &2.9180e-04_r8,3.5163e-04_r8,3.0921e-04_r8,2.2892e-04_r8,3.3328e-05_r8/) + kbo(:, 5,30, 3) = (/ & + &4.3918e-04_r8,5.0854e-04_r8,4.3751e-04_r8,3.1569e-04_r8,3.9501e-05_r8/) + kbo(:, 1,31, 3) = (/ & + &6.1393e-05_r8,8.7694e-05_r8,8.3630e-05_r8,6.7048e-05_r8,1.5382e-05_r8/) + kbo(:, 2,31, 3) = (/ & + &1.0290e-04_r8,1.3743e-04_r8,1.2731e-04_r8,9.9241e-05_r8,1.8651e-05_r8/) + kbo(:, 3,31, 3) = (/ & + &1.6626e-04_r8,2.0956e-04_r8,1.8851e-04_r8,1.4301e-04_r8,2.2748e-05_r8/) + kbo(:, 4,31, 3) = (/ & + &2.5819e-04_r8,3.1016e-04_r8,2.7211e-04_r8,2.0081e-04_r8,2.7039e-05_r8/) + kbo(:, 5,31, 3) = (/ & + &3.8535e-04_r8,4.4535e-04_r8,3.8254e-04_r8,2.7522e-04_r8,3.1790e-05_r8/) + kbo(:, 1,32, 3) = (/ & + &5.5908e-05_r8,7.9178e-05_r8,7.5227e-05_r8,6.0166e-05_r8,1.2301e-05_r8/) + kbo(:, 2,32, 3) = (/ & + &9.3029e-05_r8,1.2336e-04_r8,1.1373e-04_r8,8.8415e-05_r8,1.5236e-05_r8/) + kbo(:, 3,32, 3) = (/ & + &1.4900e-04_r8,1.8677e-04_r8,1.6744e-04_r8,1.2652e-04_r8,1.8544e-05_r8/) + kbo(:, 4,32, 3) = (/ & + &2.2938e-04_r8,2.7443e-04_r8,2.4002e-04_r8,1.7648e-04_r8,2.2012e-05_r8/) + kbo(:, 5,32, 3) = (/ & + &3.3936e-04_r8,3.9112e-04_r8,3.3532e-04_r8,2.4040e-04_r8,2.5885e-05_r8/) + kbo(:, 1,33, 3) = (/ & + &5.1027e-05_r8,7.1592e-05_r8,6.7752e-05_r8,5.3984e-05_r8,1.0069e-05_r8/) + kbo(:, 2,33, 3) = (/ & + &8.4306e-05_r8,1.1082e-04_r8,1.0178e-04_r8,7.8786e-05_r8,1.2424e-05_r8/) + kbo(:, 3,33, 3) = (/ & + &1.3378e-04_r8,1.6666e-04_r8,1.4886e-04_r8,1.1198e-04_r8,1.5017e-05_r8/) + kbo(:, 4,33, 3) = (/ & + &2.0407e-04_r8,2.4310e-04_r8,2.1204e-04_r8,1.5519e-04_r8,1.7833e-05_r8/) + kbo(:, 5,33, 3) = (/ & + &2.9932e-04_r8,3.4399e-04_r8,2.9425e-04_r8,2.1002e-04_r8,2.0751e-05_r8/) + kbo(:, 1,34, 3) = (/ & + &4.6423e-05_r8,6.4385e-05_r8,6.0651e-05_r8,4.8084e-05_r8,8.2313e-06_r8/) + kbo(:, 2,34, 3) = (/ & + &7.6075e-05_r8,9.9124e-05_r8,9.0586e-05_r8,6.9780e-05_r8,1.0168e-05_r8/) + kbo(:, 3,34, 3) = (/ & + &1.1981e-04_r8,1.4811e-04_r8,1.3176e-04_r8,9.8597e-05_r8,1.2205e-05_r8/) + kbo(:, 4,34, 3) = (/ & + &1.8123e-04_r8,2.1472e-04_r8,1.8662e-04_r8,1.3590e-04_r8,1.4492e-05_r8/) + kbo(:, 5,34, 3) = (/ & + &2.6376e-04_r8,3.0190e-04_r8,2.5753e-04_r8,1.8301e-04_r8,1.6946e-05_r8/) + kbo(:, 1,35, 3) = (/ & + &4.0215e-05_r8,5.5516e-05_r8,5.2178e-05_r8,4.1265e-05_r8,6.6300e-06_r8/) + kbo(:, 2,35, 3) = (/ & + &6.5646e-05_r8,8.5207e-05_r8,7.7691e-05_r8,5.9694e-05_r8,8.1351e-06_r8/) + kbo(:, 3,35, 3) = (/ & + &1.0298e-04_r8,1.2694e-04_r8,1.1266e-04_r8,8.4059e-05_r8,9.8103e-06_r8/) + kbo(:, 4,35, 3) = (/ & + &1.5503e-04_r8,1.8334e-04_r8,1.5905e-04_r8,1.1551e-04_r8,1.1630e-05_r8/) + kbo(:, 5,35, 3) = (/ & + &2.2476e-04_r8,2.5697e-04_r8,2.1886e-04_r8,1.5514e-04_r8,1.3591e-05_r8/) + kbo(:, 1,36, 3) = (/ & + &3.2994e-05_r8,4.5660e-05_r8,4.2930e-05_r8,3.3969e-05_r8,5.1542e-06_r8/) + kbo(:, 2,36, 3) = (/ & + &5.3916e-05_r8,7.0104e-05_r8,6.3946e-05_r8,4.9132e-05_r8,6.3498e-06_r8/) + kbo(:, 3,36, 3) = (/ & + &8.4552e-05_r8,1.0443e-04_r8,9.2717e-05_r8,6.9170e-05_r8,7.6665e-06_r8/) + kbo(:, 4,36, 3) = (/ & + &1.2731e-04_r8,1.5086e-04_r8,1.3088e-04_r8,9.4999e-05_r8,9.0883e-06_r8/) + kbo(:, 5,36, 3) = (/ & + &1.8455e-04_r8,2.1131e-04_r8,1.8000e-04_r8,1.2756e-04_r8,1.0606e-05_r8/) + kbo(:, 1,37, 3) = (/ & + &2.5429e-05_r8,3.5502e-05_r8,3.3507e-05_r8,2.6612e-05_r8,3.9872e-06_r8/) + kbo(:, 2,37, 3) = (/ & + &4.1789e-05_r8,5.4774e-05_r8,5.0118e-05_r8,3.8644e-05_r8,4.9244e-06_r8/) + kbo(:, 3,37, 3) = (/ & + &6.5920e-05_r8,8.1963e-05_r8,7.2974e-05_r8,5.4610e-05_r8,5.9794e-06_r8/) + kbo(:, 4,37, 3) = (/ & + &9.9825e-05_r8,1.1892e-04_r8,1.0339e-04_r8,7.5254e-05_r8,7.1021e-06_r8/) + kbo(:, 5,37, 3) = (/ & + &1.4543e-04_r8,1.6731e-04_r8,1.4273e-04_r8,1.0135e-04_r8,8.2993e-06_r8/) + kbo(:, 1,38, 3) = (/ & + &1.9510e-05_r8,2.7499e-05_r8,2.6048e-05_r8,2.0774e-05_r8,3.0726e-06_r8/) + kbo(:, 2,38, 3) = (/ & + &3.2252e-05_r8,4.2623e-05_r8,3.9146e-05_r8,3.0291e-05_r8,3.8102e-06_r8/) + kbo(:, 3,38, 3) = (/ & + &5.1187e-05_r8,6.4097e-05_r8,5.7223e-05_r8,4.2970e-05_r8,4.6390e-06_r8/) + kbo(:, 4,38, 3) = (/ & + &7.8004e-05_r8,9.3430e-05_r8,8.1421e-05_r8,5.9437e-05_r8,5.5099e-06_r8/) + kbo(:, 5,38, 3) = (/ & + &1.1424e-04_r8,1.3207e-04_r8,1.1286e-04_r8,8.0305e-05_r8,6.4580e-06_r8/) + kbo(:, 1,39, 3) = (/ & + &1.4955e-05_r8,2.1282e-05_r8,2.0237e-05_r8,1.6208e-05_r8,2.3414e-06_r8/) + kbo(:, 2,39, 3) = (/ & + &2.4867e-05_r8,3.3144e-05_r8,3.0547e-05_r8,2.3724e-05_r8,2.9298e-06_r8/) + kbo(:, 3,39, 3) = (/ & + &3.9718e-05_r8,5.0092e-05_r8,4.4848e-05_r8,3.3792e-05_r8,3.5597e-06_r8/) + kbo(:, 4,39, 3) = (/ & + &6.0902e-05_r8,7.3365e-05_r8,6.4080e-05_r8,4.6913e-05_r8,4.2665e-06_r8/) + kbo(:, 5,39, 3) = (/ & + &8.9673e-05_r8,1.0416e-04_r8,8.9163e-05_r8,6.3592e-05_r8,5.0003e-06_r8/) + kbo(:, 1,40, 3) = (/ & + &1.0973e-05_r8,1.5834e-05_r8,1.5141e-05_r8,1.2207e-05_r8,1.7695e-06_r8/) + kbo(:, 2,40, 3) = (/ & + &1.8417e-05_r8,2.4851e-05_r8,2.3037e-05_r8,1.7992e-05_r8,2.2304e-06_r8/) + kbo(:, 3,40, 3) = (/ & + &2.9718e-05_r8,3.7867e-05_r8,3.4065e-05_r8,2.5810e-05_r8,2.7325e-06_r8/) + kbo(:, 4,40, 3) = (/ & + &4.6050e-05_r8,5.5927e-05_r8,4.9024e-05_r8,3.6065e-05_r8,3.2836e-06_r8/) + kbo(:, 5,40, 3) = (/ & + &6.8462e-05_r8,8.0022e-05_r8,6.8684e-05_r8,4.9179e-05_r8,3.8780e-06_r8/) + kbo(:, 1,41, 3) = (/ & + &7.9936e-06_r8,1.1702e-05_r8,1.1250e-05_r8,9.1326e-06_r8,1.3289e-06_r8/) + kbo(:, 2,41, 3) = (/ & + &1.3541e-05_r8,1.8510e-05_r8,1.7261e-05_r8,1.3563e-05_r8,1.6876e-06_r8/) + kbo(:, 3,41, 3) = (/ & + &2.2085e-05_r8,2.8450e-05_r8,2.5728e-05_r8,1.9606e-05_r8,2.0896e-06_r8/) + kbo(:, 4,41, 3) = (/ & + &3.4599e-05_r8,4.2393e-05_r8,3.7310e-05_r8,2.7591e-05_r8,2.5142e-06_r8/) + kbo(:, 5,41, 3) = (/ & + &5.1973e-05_r8,6.1166e-05_r8,5.2649e-05_r8,3.7859e-05_r8,2.9985e-06_r8/) + kbo(:, 1,42, 3) = (/ & + &5.8131e-06_r8,8.6287e-06_r8,8.3395e-06_r8,6.8180e-06_r8,9.9321e-07_r8/) + kbo(:, 2,42, 3) = (/ & + &9.9286e-06_r8,1.3753e-05_r8,1.2903e-05_r8,1.0201e-05_r8,1.2739e-06_r8/) + kbo(:, 3,42, 3) = (/ & + &1.6369e-05_r8,2.1324e-05_r8,1.9387e-05_r8,1.4861e-05_r8,1.5862e-06_r8/) + kbo(:, 4,42, 3) = (/ & + &2.5917e-05_r8,3.2058e-05_r8,2.8333e-05_r8,2.1064e-05_r8,1.9289e-06_r8/) + kbo(:, 5,42, 3) = (/ & + &3.9355e-05_r8,4.6652e-05_r8,4.0275e-05_r8,2.9099e-05_r8,2.3091e-06_r8/) + kbo(:, 1,43, 3) = (/ & + &4.1379e-06_r8,6.2276e-06_r8,6.0505e-06_r8,4.9862e-06_r8,7.3153e-07_r8/) + kbo(:, 2,43, 3) = (/ & + &7.1228e-06_r8,1.0012e-05_r8,9.4538e-06_r8,7.5288e-06_r8,9.4466e-07_r8/) + kbo(:, 3,43, 3) = (/ & + &1.1889e-05_r8,1.5688e-05_r8,1.4350e-05_r8,1.1075e-05_r8,1.1892e-06_r8/) + kbo(:, 4,43, 3) = (/ & + &1.9074e-05_r8,2.3844e-05_r8,2.1179e-05_r8,1.5845e-05_r8,1.4637e-06_r8/) + kbo(:, 5,43, 3) = (/ & + &2.9351e-05_r8,3.5073e-05_r8,3.0382e-05_r8,2.2068e-05_r8,1.7581e-06_r8/) + kbo(:, 1,44, 3) = (/ & + &2.9204e-06_r8,4.4462e-06_r8,4.3423e-06_r8,3.6069e-06_r8,5.3481e-07_r8/) + kbo(:, 2,44, 3) = (/ & + &5.0527e-06_r8,7.2110e-06_r8,6.8508e-06_r8,5.4982e-06_r8,6.9481e-07_r8/) + kbo(:, 3,44, 3) = (/ & + &8.5402e-06_r8,1.1419e-05_r8,1.0515e-05_r8,8.1724e-06_r8,8.8543e-07_r8/) + kbo(:, 4,44, 3) = (/ & + &1.3894e-05_r8,1.7562e-05_r8,1.5682e-05_r8,1.1814e-05_r8,1.0984e-06_r8/) + kbo(:, 5,44, 3) = (/ & + &2.1692e-05_r8,2.6150e-05_r8,2.2738e-05_r8,1.6619e-05_r8,1.3258e-06_r8/) + kbo(:, 1,45, 3) = (/ & + &2.0654e-06_r8,3.1706e-06_r8,3.1106e-06_r8,2.6027e-06_r8,3.8843e-07_r8/) + kbo(:, 2,45, 3) = (/ & + &3.5785e-06_r8,5.1800e-06_r8,4.9498e-06_r8,4.0029e-06_r8,5.0552e-07_r8/) + kbo(:, 3,45, 3) = (/ & + &6.1156e-06_r8,8.2899e-06_r8,7.6825e-06_r8,6.0114e-06_r8,6.4899e-07_r8/) + kbo(:, 4,45, 3) = (/ & + &1.0090e-05_r8,1.2899e-05_r8,1.1584e-05_r8,8.7849e-06_r8,8.1182e-07_r8/) + kbo(:, 5,45, 3) = (/ & + &1.5974e-05_r8,1.9436e-05_r8,1.6972e-05_r8,1.2481e-05_r8,9.9260e-07_r8/) + kbo(:, 1,46, 3) = (/ & + &1.4538e-06_r8,2.2381e-06_r8,2.2044e-06_r8,1.8570e-06_r8,2.7780e-07_r8/) + kbo(:, 2,46, 3) = (/ & + &2.5054e-06_r8,3.6761e-06_r8,3.5333e-06_r8,2.8803e-06_r8,3.6666e-07_r8/) + kbo(:, 3,46, 3) = (/ & + &4.3205e-06_r8,5.9430e-06_r8,5.5451e-06_r8,4.3709e-06_r8,4.7052e-07_r8/) + kbo(:, 4,46, 3) = (/ & + &7.2299e-06_r8,9.3616e-06_r8,8.4601e-06_r8,6.4628e-06_r8,5.9539e-07_r8/) + kbo(:, 5,46, 3) = (/ & + &1.1621e-05_r8,1.4285e-05_r8,1.2535e-05_r8,9.2836e-06_r8,7.3565e-07_r8/) + kbo(:, 1,47, 3) = (/ & + &1.0143e-06_r8,1.5538e-06_r8,1.5325e-06_r8,1.2979e-06_r8,1.9733e-07_r8/) + kbo(:, 2,47, 3) = (/ & + &1.7208e-06_r8,2.5538e-06_r8,2.4694e-06_r8,2.0305e-06_r8,2.6304e-07_r8/) + kbo(:, 3,47, 3) = (/ & + &2.9828e-06_r8,4.1702e-06_r8,3.9202e-06_r8,3.1167e-06_r8,3.4065e-07_r8/) + kbo(:, 4,47, 3) = (/ & + &5.0644e-06_r8,6.6541e-06_r8,6.0593e-06_r8,4.6660e-06_r8,4.3326e-07_r8/) + kbo(:, 5,47, 3) = (/ & + &8.2782e-06_r8,1.0300e-05_r8,9.0956e-06_r8,6.7879e-06_r8,5.4017e-07_r8/) + kbo(:, 1,48, 3) = (/ & + &7.2030e-07_r8,1.0845e-06_r8,1.0676e-06_r8,9.0611e-07_r8,1.3761e-07_r8/) + kbo(:, 2,48, 3) = (/ & + &1.1872e-06_r8,1.7730e-06_r8,1.7228e-06_r8,1.4271e-06_r8,1.8706e-07_r8/) + kbo(:, 3,48, 3) = (/ & + &2.0561e-06_r8,2.9161e-06_r8,2.7609e-06_r8,2.2135e-06_r8,2.4544e-07_r8/) + kbo(:, 4,48, 3) = (/ & + &3.5327e-06_r8,4.7102e-06_r8,4.3223e-06_r8,3.3540e-06_r8,3.1231e-07_r8/) + kbo(:, 5,48, 3) = (/ & + &5.8701e-06_r8,7.3943e-06_r8,6.5729e-06_r8,4.9432e-06_r8,3.9364e-07_r8/) + kbo(:, 1,49, 3) = (/ & + &5.2463e-07_r8,7.6406e-07_r8,7.4789e-07_r8,6.3224e-07_r8,9.4269e-08_r8/) + kbo(:, 2,49, 3) = (/ & + &8.2733e-07_r8,1.2326e-06_r8,1.2007e-06_r8,1.0005e-06_r8,1.3092e-07_r8/) + kbo(:, 3,49, 3) = (/ & + &1.4174e-06_r8,2.0342e-06_r8,1.9376e-06_r8,1.5657e-06_r8,1.7460e-07_r8/) + kbo(:, 4,49, 3) = (/ & + &2.4552e-06_r8,3.3221e-06_r8,3.0702e-06_r8,2.4004e-06_r8,2.2553e-07_r8/) + kbo(:, 5,49, 3) = (/ & + &4.1423e-06_r8,5.2851e-06_r8,4.7305e-06_r8,3.5840e-06_r8,2.8424e-07_r8/) + kbo(:, 1,50, 3) = (/ & + &3.9659e-07_r8,5.5178e-07_r8,5.3440e-07_r8,4.4722e-07_r8,6.5930e-08_r8/) + kbo(:, 2,50, 3) = (/ & + &5.9210e-07_r8,8.7140e-07_r8,8.4803e-07_r8,7.0817e-07_r8,9.3562e-08_r8/) + kbo(:, 3,50, 3) = (/ & + &9.9396e-07_r8,1.4345e-06_r8,1.3722e-06_r8,1.1160e-06_r8,1.2619e-07_r8/) + kbo(:, 4,50, 3) = (/ & + &1.7258e-06_r8,2.3624e-06_r8,2.1973e-06_r8,1.7292e-06_r8,1.6444e-07_r8/) + kbo(:, 5,50, 3) = (/ & + &2.9480e-06_r8,3.8052e-06_r8,3.4270e-06_r8,2.6131e-06_r8,2.0855e-07_r8/) + kbo(:, 1,51, 3) = (/ & + &3.0780e-07_r8,4.0724e-07_r8,3.8772e-07_r8,3.1909e-07_r8,4.7152e-08_r8/) + kbo(:, 2,51, 3) = (/ & + &4.3389e-07_r8,6.2376e-07_r8,6.0442e-07_r8,5.0387e-07_r8,6.6848e-08_r8/) + kbo(:, 3,51, 3) = (/ & + &7.0578e-07_r8,1.0183e-06_r8,9.7661e-07_r8,7.9773e-07_r8,9.1673e-08_r8/) + kbo(:, 4,51, 3) = (/ & + &1.2202e-06_r8,1.6857e-06_r8,1.5762e-06_r8,1.2481e-06_r8,1.2080e-07_r8/) + kbo(:, 5,51, 3) = (/ & + &2.1050e-06_r8,2.7463e-06_r8,2.4878e-06_r8,1.9078e-06_r8,1.5488e-07_r8/) + kbo(:, 1,52, 3) = (/ & + &2.4467e-07_r8,3.0672e-07_r8,2.8540e-07_r8,2.2927e-07_r8,3.3766e-08_r8/) + kbo(:, 2,52, 3) = (/ & + &3.2577e-07_r8,4.5139e-07_r8,4.3382e-07_r8,3.5906e-07_r8,4.7409e-08_r8/) + kbo(:, 3,52, 3) = (/ & + &5.0672e-07_r8,7.2555e-07_r8,6.9595e-07_r8,5.7001e-07_r8,6.5991e-08_r8/) + kbo(:, 4,52, 3) = (/ & + &8.6516e-07_r8,1.2018e-06_r8,1.1289e-06_r8,8.9884e-07_r8,8.8646e-08_r8/) + kbo(:, 5,52, 3) = (/ & + &1.5011e-06_r8,1.9777e-06_r8,1.8012e-06_r8,1.3890e-06_r8,1.1411e-07_r8/) + kbo(:, 1,53, 3) = (/ & + &1.9893e-07_r8,2.3655e-07_r8,2.1398e-07_r8,1.6650e-07_r8,2.3697e-08_r8/) + kbo(:, 2,53, 3) = (/ & + &2.5083e-07_r8,3.3159e-07_r8,3.1422e-07_r8,2.5680e-07_r8,3.3792e-08_r8/) + kbo(:, 3,53, 3) = (/ & + &3.6925e-07_r8,5.1963e-07_r8,4.9710e-07_r8,4.0705e-07_r8,4.7057e-08_r8/) + kbo(:, 4,53, 3) = (/ & + &6.1624e-07_r8,8.5716e-07_r8,8.0760e-07_r8,6.4558e-07_r8,6.4327e-08_r8/) + kbo(:, 5,53, 3) = (/ & + &1.0701e-06_r8,1.4207e-06_r8,1.3006e-06_r8,1.0081e-06_r8,8.3703e-08_r8/) + kbo(:, 1,54, 3) = (/ & + &1.6569e-07_r8,1.8826e-07_r8,1.6516e-07_r8,1.2463e-07_r8,1.7341e-08_r8/) + kbo(:, 2,54, 3) = (/ & + &1.9916e-07_r8,2.5095e-07_r8,2.3323e-07_r8,1.8716e-07_r8,2.4743e-08_r8/) + kbo(:, 3,54, 3) = (/ & + &2.7800e-07_r8,3.8083e-07_r8,3.6198e-07_r8,2.9489e-07_r8,3.4593e-08_r8/) + kbo(:, 4,54, 3) = (/ & + &4.4953e-07_r8,6.2218e-07_r8,5.8637e-07_r8,4.6947e-07_r8,4.7657e-08_r8/) + kbo(:, 5,54, 3) = (/ & + &7.7653e-07_r8,1.0348e-06_r8,9.5106e-07_r8,7.3964e-07_r8,6.2914e-08_r8/) + kbo(:, 1,55, 3) = (/ & + &1.4043e-07_r8,1.5348e-07_r8,1.3050e-07_r8,9.5790e-08_r8,1.3021e-08_r8/) + kbo(:, 2,55, 3) = (/ & + &1.6195e-07_r8,1.9454e-07_r8,1.7661e-07_r8,1.3842e-07_r8,1.8310e-08_r8/) + kbo(:, 3,55, 3) = (/ & + &2.1498e-07_r8,2.8400e-07_r8,2.6714e-07_r8,2.1561e-07_r8,2.5769e-08_r8/) + kbo(:, 4,55, 3) = (/ & + &3.3384e-07_r8,4.5663e-07_r8,4.2946e-07_r8,3.4367e-07_r8,3.5731e-08_r8/) + kbo(:, 5,55, 3) = (/ & + &5.6980e-07_r8,7.5956e-07_r8,6.9954e-07_r8,5.4544e-07_r8,4.7978e-08_r8/) + kbo(:, 1,56, 3) = (/ & + &1.2086e-07_r8,1.2723e-07_r8,1.0539e-07_r8,7.4446e-08_r8,9.2261e-09_r8/) + kbo(:, 2,56, 3) = (/ & + &1.3434e-07_r8,1.5407e-07_r8,1.3616e-07_r8,1.0396e-07_r8,1.3447e-08_r8/) + kbo(:, 3,56, 3) = (/ & + &1.7000e-07_r8,2.1506e-07_r8,1.9916e-07_r8,1.5861e-07_r8,1.9233e-08_r8/) + kbo(:, 4,56, 3) = (/ & + &2.5155e-07_r8,3.3746e-07_r8,3.1592e-07_r8,2.5204e-07_r8,2.6859e-08_r8/) + kbo(:, 5,56, 3) = (/ & + &4.2088e-07_r8,5.5907e-07_r8,5.1525e-07_r8,4.0220e-07_r8,3.6549e-08_r8/) + kbo(:, 1,57, 3) = (/ & + &1.0553e-07_r8,1.0707e-07_r8,8.7153e-08_r8,5.8944e-08_r8,6.8033e-09_r8/) + kbo(:, 2,57, 3) = (/ & + &1.1362e-07_r8,1.2487e-07_r8,1.0708e-07_r8,7.9506e-08_r8,9.8943e-09_r8/) + kbo(:, 3,57, 3) = (/ & + &1.3729e-07_r8,1.6577e-07_r8,1.5039e-07_r8,1.1755e-07_r8,1.4310e-08_r8/) + kbo(:, 4,57, 3) = (/ & + &1.9303e-07_r8,2.5185e-07_r8,2.3386e-07_r8,1.8533e-07_r8,2.0155e-08_r8/) + kbo(:, 5,57, 3) = (/ & + &3.1378e-07_r8,4.1313e-07_r8,3.8025e-07_r8,2.9656e-07_r8,2.7619e-08_r8/) + kbo(:, 1,58, 3) = (/ & + &4.5186e-08_r8,5.0890e-08_r8,4.7832e-08_r8,3.7472e-08_r8,5.1696e-09_r8/) + kbo(:, 2,58, 3) = (/ & + &4.7401e-08_r8,5.7618e-08_r8,5.6357e-08_r8,4.8955e-08_r8,7.4243e-09_r8/) + kbo(:, 3,58, 3) = (/ & + &5.5010e-08_r8,7.2882e-08_r8,7.5797e-08_r8,7.0136e-08_r8,1.0687e-08_r8/) + kbo(:, 4,58, 3) = (/ & + &7.3718e-08_r8,1.0653e-07_r8,1.1470e-07_r8,1.0884e-07_r8,1.5198e-08_r8/) + kbo(:, 5,58, 3) = (/ & + &1.1547e-07_r8,1.7203e-07_r8,1.8517e-07_r8,1.7422e-07_r8,2.1153e-08_r8/) + kbo(:, 1,59, 3) = (/ & + &3.8720e-08_r8,4.3027e-08_r8,4.0190e-08_r8,3.1252e-08_r8,4.1397e-09_r8/) + kbo(:, 2,59, 3) = (/ & + &4.0213e-08_r8,4.8103e-08_r8,4.6638e-08_r8,4.0062e-08_r8,6.0380e-09_r8/) + kbo(:, 3,59, 3) = (/ & + &4.5994e-08_r8,5.9694e-08_r8,6.1452e-08_r8,5.6505e-08_r8,8.8443e-09_r8/) + kbo(:, 4,59, 3) = (/ & + &6.0487e-08_r8,8.5685e-08_r8,9.1743e-08_r8,8.6818e-08_r8,1.2879e-08_r8/) + kbo(:, 5,59, 3) = (/ & + &9.3188e-08_r8,1.3722e-07_r8,1.4752e-07_r8,1.3892e-07_r8,1.7999e-08_r8/) + kbo(:, 1,13, 4) = (/ & + &4.3869e-03_r8,5.0989e-03_r8,4.3794e-03_r8,3.0521e-03_r8,9.4784e-04_r8/) + kbo(:, 2,13, 4) = (/ & + &6.9481e-03_r8,7.8458e-03_r8,6.6078e-03_r8,4.5663e-03_r8,1.0961e-03_r8/) + kbo(:, 3,13, 4) = (/ & + &1.1023e-02_r8,1.1980e-02_r8,9.8280e-03_r8,6.7431e-03_r8,1.2240e-03_r8/) + kbo(:, 4,13, 4) = (/ & + &1.7316e-02_r8,1.8007e-02_r8,1.4661e-02_r8,9.8568e-03_r8,1.4326e-03_r8/) + kbo(:, 5,13, 4) = (/ & + &2.6628e-02_r8,2.6632e-02_r8,2.1301e-02_r8,1.4107e-02_r8,1.6715e-03_r8/) + kbo(:, 1,14, 4) = (/ & + &3.8856e-03_r8,4.5615e-03_r8,3.8907e-03_r8,2.6924e-03_r8,7.6763e-04_r8/) + kbo(:, 2,14, 4) = (/ & + &6.2253e-03_r8,7.0528e-03_r8,5.8968e-03_r8,4.0418e-03_r8,8.6051e-04_r8/) + kbo(:, 3,14, 4) = (/ & + &1.0002e-02_r8,1.0752e-02_r8,8.8582e-03_r8,6.0065e-03_r8,1.0065e-03_r8/) + kbo(:, 4,14, 4) = (/ & + &1.5699e-02_r8,1.6229e-02_r8,1.3163e-02_r8,8.7970e-03_r8,1.2227e-03_r8/) + kbo(:, 5,14, 4) = (/ & + &2.4269e-02_r8,2.4030e-02_r8,1.9137e-02_r8,1.2536e-02_r8,1.4474e-03_r8/) + kbo(:, 1,15, 4) = (/ & + &3.2659e-03_r8,3.8770e-03_r8,3.3101e-03_r8,2.3048e-03_r8,5.7573e-04_r8/) + kbo(:, 2,15, 4) = (/ & + &5.3241e-03_r8,6.0372e-03_r8,5.0494e-03_r8,3.4916e-03_r8,6.8321e-04_r8/) + kbo(:, 3,15, 4) = (/ & + &8.6002e-03_r8,9.2086e-03_r8,7.6334e-03_r8,5.1974e-03_r8,8.4736e-04_r8/) + kbo(:, 4,15, 4) = (/ & + &1.3547e-02_r8,1.3992e-02_r8,1.1347e-02_r8,7.5834e-03_r8,1.0287e-03_r8/) + kbo(:, 5,15, 4) = (/ & + &2.1009e-02_r8,2.0762e-02_r8,1.6574e-02_r8,1.0811e-02_r8,1.2066e-03_r8/) + kbo(:, 1,16, 4) = (/ & + &2.6697e-03_r8,3.2234e-03_r8,2.7529e-03_r8,1.9451e-03_r8,4.4184e-04_r8/) + kbo(:, 2,16, 4) = (/ & + &4.4186e-03_r8,5.0347e-03_r8,4.2523e-03_r8,2.9486e-03_r8,5.5826e-04_r8/) + kbo(:, 3,16, 4) = (/ & + &7.1546e-03_r8,7.7280e-03_r8,6.4040e-03_r8,4.4001e-03_r8,6.8881e-04_r8/) + kbo(:, 4,16, 4) = (/ & + &1.1406e-02_r8,1.1811e-02_r8,9.5855e-03_r8,6.4241e-03_r8,8.3295e-04_r8/) + kbo(:, 5,16, 4) = (/ & + &1.7781e-02_r8,1.7577e-02_r8,1.4001e-02_r8,9.1645e-03_r8,9.7098e-04_r8/) + kbo(:, 1,17, 4) = (/ & + &2.1896e-03_r8,2.6538e-03_r8,2.2904e-03_r8,1.6414e-03_r8,3.5480e-04_r8/) + kbo(:, 2,17, 4) = (/ & + &3.6444e-03_r8,4.1897e-03_r8,3.5440e-03_r8,2.4805e-03_r8,4.4971e-04_r8/) + kbo(:, 3,17, 4) = (/ & + &5.9916e-03_r8,6.4686e-03_r8,5.3743e-03_r8,3.6974e-03_r8,5.5799e-04_r8/) + kbo(:, 4,17, 4) = (/ & + &9.5963e-03_r8,9.9128e-03_r8,8.0553e-03_r8,5.4068e-03_r8,6.7241e-04_r8/) + kbo(:, 5,17, 4) = (/ & + &1.5025e-02_r8,1.4809e-02_r8,1.1810e-02_r8,7.7160e-03_r8,7.7063e-04_r8/) + kbo(:, 1,18, 4) = (/ & + &1.7997e-03_r8,2.1886e-03_r8,1.9082e-03_r8,1.3670e-03_r8,2.9021e-04_r8/) + kbo(:, 2,18, 4) = (/ & + &3.0120e-03_r8,3.4746e-03_r8,2.9450e-03_r8,2.0706e-03_r8,3.7282e-04_r8/) + kbo(:, 3,18, 4) = (/ & + &4.9798e-03_r8,5.3990e-03_r8,4.4938e-03_r8,3.0816e-03_r8,4.5930e-04_r8/) + kbo(:, 4,18, 4) = (/ & + &8.0081e-03_r8,8.2644e-03_r8,6.7223e-03_r8,4.5032e-03_r8,5.4734e-04_r8/) + kbo(:, 5,18, 4) = (/ & + &1.2492e-02_r8,1.2373e-02_r8,9.8644e-03_r8,6.4255e-03_r8,6.3020e-04_r8/) + kbo(:, 1,19, 4) = (/ & + &1.5064e-03_r8,1.8451e-03_r8,1.6056e-03_r8,1.1522e-03_r8,2.4682e-04_r8/) + kbo(:, 2,19, 4) = (/ & + &2.5474e-03_r8,2.9294e-03_r8,2.4915e-03_r8,1.7507e-03_r8,3.1538e-04_r8/) + kbo(:, 3,19, 4) = (/ & + &4.2186e-03_r8,4.5798e-03_r8,3.8063e-03_r8,2.5988e-03_r8,3.8674e-04_r8/) + kbo(:, 4,19, 4) = (/ & + &6.8019e-03_r8,7.0063e-03_r8,5.6982e-03_r8,3.8032e-03_r8,4.6124e-04_r8/) + kbo(:, 5,19, 4) = (/ & + &1.0595e-02_r8,1.0486e-02_r8,8.3528e-03_r8,5.4249e-03_r8,5.3320e-04_r8/) + kbo(:, 1,20, 4) = (/ & + &1.3102e-03_r8,1.5983e-03_r8,1.3859e-03_r8,9.9291e-04_r8,2.1228e-04_r8/) + kbo(:, 2,20, 4) = (/ & + &2.2269e-03_r8,2.5410e-03_r8,2.1563e-03_r8,1.5072e-03_r8,2.6816e-04_r8/) + kbo(:, 3,20, 4) = (/ & + &3.6896e-03_r8,3.9778e-03_r8,3.2977e-03_r8,2.2454e-03_r8,3.2819e-04_r8/) + kbo(:, 4,20, 4) = (/ & + &5.9414e-03_r8,6.0960e-03_r8,4.9353e-03_r8,3.2744e-03_r8,3.9225e-04_r8/) + kbo(:, 5,20, 4) = (/ & + &9.2578e-03_r8,9.1102e-03_r8,7.2255e-03_r8,4.6712e-03_r8,4.5336e-04_r8/) + kbo(:, 1,21, 4) = (/ & + &1.1473e-03_r8,1.3888e-03_r8,1.2016e-03_r8,8.6011e-04_r8,1.8127e-04_r8/) + kbo(:, 2,21, 4) = (/ & + &1.9565e-03_r8,2.2181e-03_r8,1.8746e-03_r8,1.3038e-03_r8,2.2830e-04_r8/) + kbo(:, 3,21, 4) = (/ & + &3.2520e-03_r8,3.4808e-03_r8,2.8694e-03_r8,1.9461e-03_r8,2.7800e-04_r8/) + kbo(:, 4,21, 4) = (/ & + &5.2204e-03_r8,5.3317e-03_r8,4.2972e-03_r8,2.8342e-03_r8,3.3105e-04_r8/) + kbo(:, 5,21, 4) = (/ & + &8.1069e-03_r8,7.9508e-03_r8,6.2747e-03_r8,4.0360e-03_r8,3.8585e-04_r8/) + kbo(:, 1,22, 4) = (/ & + &1.0382e-03_r8,1.2396e-03_r8,1.0678e-03_r8,7.6273e-04_r8,1.5466e-04_r8/) + kbo(:, 2,22, 4) = (/ & + &1.7720e-03_r8,1.9893e-03_r8,1.6695e-03_r8,1.1556e-03_r8,1.9356e-04_r8/) + kbo(:, 3,22, 4) = (/ & + &2.9369e-03_r8,3.1200e-03_r8,2.5557e-03_r8,1.7237e-03_r8,2.3624e-04_r8/) + kbo(:, 4,22, 4) = (/ & + &4.6992e-03_r8,4.7636e-03_r8,3.8178e-03_r8,2.5063e-03_r8,2.7855e-04_r8/) + kbo(:, 5,22, 4) = (/ & + &7.2282e-03_r8,7.0542e-03_r8,5.5487e-03_r8,3.5490e-03_r8,3.2630e-04_r8/) + kbo(:, 1,23, 4) = (/ & + &9.4131e-04_r8,1.1095e-03_r8,9.5148e-04_r8,6.7660e-04_r8,1.3244e-04_r8/) + kbo(:, 2,23, 4) = (/ & + &1.6035e-03_r8,1.7844e-03_r8,1.4894e-03_r8,1.0262e-03_r8,1.6442e-04_r8/) + kbo(:, 3,23, 4) = (/ & + &2.6522e-03_r8,2.7950e-03_r8,2.2775e-03_r8,1.5271e-03_r8,2.0008e-04_r8/) + kbo(:, 4,23, 4) = (/ & + &4.2106e-03_r8,4.2402e-03_r8,3.3871e-03_r8,2.2131e-03_r8,2.3445e-04_r8/) + kbo(:, 5,23, 4) = (/ & + &6.4196e-03_r8,6.2427e-03_r8,4.8940e-03_r8,3.1130e-03_r8,2.7496e-04_r8/) + kbo(:, 1,24, 4) = (/ & + &8.5493e-04_r8,1.0008e-03_r8,8.5274e-04_r8,6.0213e-04_r8,1.1224e-04_r8/) + kbo(:, 2,24, 4) = (/ & + &1.4576e-03_r8,1.6070e-03_r8,1.3354e-03_r8,9.1642e-04_r8,1.3965e-04_r8/) + kbo(:, 3,24, 4) = (/ & + &2.4005e-03_r8,2.5083e-03_r8,2.0375e-03_r8,1.3606e-03_r8,1.6869e-04_r8/) + kbo(:, 4,24, 4) = (/ & + &3.7805e-03_r8,3.7882e-03_r8,3.0168e-03_r8,1.9590e-03_r8,1.9824e-04_r8/) + kbo(:, 5,24, 4) = (/ & + &5.7340e-03_r8,5.5429e-03_r8,4.3252e-03_r8,2.7397e-03_r8,2.2899e-04_r8/) + kbo(:, 1,25, 4) = (/ & + &7.8083e-04_r8,9.0613e-04_r8,7.6855e-04_r8,5.3955e-04_r8,9.3397e-05_r8/) + kbo(:, 2,25, 4) = (/ & + &1.3293e-03_r8,1.4516e-03_r8,1.2021e-03_r8,8.2125e-04_r8,1.1644e-04_r8/) + kbo(:, 3,25, 4) = (/ & + &2.1730e-03_r8,2.2546e-03_r8,1.8276e-03_r8,1.2136e-03_r8,1.4039e-04_r8/) + kbo(:, 4,25, 4) = (/ & + &3.3994e-03_r8,3.3901e-03_r8,2.6854e-03_r8,1.7374e-03_r8,1.6529e-04_r8/) + kbo(:, 5,25, 4) = (/ & + &5.1177e-03_r8,4.9296e-03_r8,3.8308e-03_r8,2.4138e-03_r8,1.9292e-04_r8/) + kbo(:, 1,26, 4) = (/ & + &7.2414e-04_r8,8.2998e-04_r8,6.9991e-04_r8,4.8962e-04_r8,7.9259e-05_r8/) + kbo(:, 2,26, 4) = (/ & + &1.2259e-03_r8,1.3255e-03_r8,1.0917e-03_r8,7.4177e-04_r8,9.7580e-05_r8/) + kbo(:, 3,26, 4) = (/ & + &1.9848e-03_r8,2.0462e-03_r8,1.6503e-03_r8,1.0895e-03_r8,1.1629e-04_r8/) + kbo(:, 4,26, 4) = (/ & + &3.0863e-03_r8,3.0554e-03_r8,2.4123e-03_r8,1.5502e-03_r8,1.3732e-04_r8/) + kbo(:, 5,26, 4) = (/ & + &4.5999e-03_r8,4.4081e-03_r8,3.4159e-03_r8,2.1402e-03_r8,1.6386e-04_r8/) + kbo(:, 1,27, 4) = (/ & + &6.7040e-04_r8,7.6049e-04_r8,6.3931e-04_r8,4.4424e-04_r8,6.5890e-05_r8/) + kbo(:, 2,27, 4) = (/ & + &1.1282e-03_r8,1.2096e-03_r8,9.9105e-04_r8,6.6941e-04_r8,8.0876e-05_r8/) + kbo(:, 3,27, 4) = (/ & + &1.8147e-03_r8,1.8556e-03_r8,1.4889e-03_r8,9.7714e-04_r8,9.6344e-05_r8/) + kbo(:, 4,27, 4) = (/ & + &2.7940e-03_r8,2.7516e-03_r8,2.1627e-03_r8,1.3811e-03_r8,1.1546e-04_r8/) + kbo(:, 5,27, 4) = (/ & + &4.1206e-03_r8,3.9340e-03_r8,3.0363e-03_r8,1.8956e-03_r8,1.3791e-04_r8/) + kbo(:, 1,28, 4) = (/ & + &6.1963e-04_r8,6.9617e-04_r8,5.8205e-04_r8,4.0239e-04_r8,5.3842e-05_r8/) + kbo(:, 2,28, 4) = (/ & + &1.0354e-03_r8,1.1013e-03_r8,8.9815e-04_r8,6.0298e-04_r8,6.6022e-05_r8/) + kbo(:, 3,28, 4) = (/ & + &1.6516e-03_r8,1.6797e-03_r8,1.3412e-03_r8,8.7507e-04_r8,8.0123e-05_r8/) + kbo(:, 4,28, 4) = (/ & + &2.5197e-03_r8,2.4709e-03_r8,1.9338e-03_r8,1.2274e-03_r8,9.7074e-05_r8/) + kbo(:, 5,28, 4) = (/ & + &3.6744e-03_r8,3.4958e-03_r8,2.6900e-03_r8,1.6731e-03_r8,1.1603e-04_r8/) + kbo(:, 1,29, 4) = (/ & + &5.7255e-04_r8,6.3719e-04_r8,5.3001e-04_r8,3.6415e-04_r8,4.3783e-05_r8/) + kbo(:, 2,29, 4) = (/ & + &9.4899e-04_r8,1.0006e-03_r8,8.1341e-04_r8,5.4243e-04_r8,5.3930e-05_r8/) + kbo(:, 3,29, 4) = (/ & + &1.4973e-03_r8,1.5143e-03_r8,1.2048e-03_r8,7.8083e-04_r8,6.6803e-05_r8/) + kbo(:, 4,29, 4) = (/ & + &2.2572e-03_r8,2.2044e-03_r8,1.7199e-03_r8,1.0861e-03_r8,8.0985e-05_r8/) + kbo(:, 5,29, 4) = (/ & + &3.2527e-03_r8,3.0849e-03_r8,2.3685e-03_r8,1.4686e-03_r8,9.6201e-05_r8/) + kbo(:, 1,30, 4) = (/ & + &5.2637e-04_r8,5.8081e-04_r8,4.8010e-04_r8,3.2816e-04_r8,3.5536e-05_r8/) + kbo(:, 2,30, 4) = (/ & + &8.6289e-04_r8,9.0357e-04_r8,7.3215e-04_r8,4.8521e-04_r8,4.4824e-05_r8/) + kbo(:, 3,30, 4) = (/ & + &1.3456e-03_r8,1.3553e-03_r8,1.0747e-03_r8,6.9223e-04_r8,5.5319e-05_r8/) + kbo(:, 4,30, 4) = (/ & + &2.0065e-03_r8,1.9507e-03_r8,1.5172e-03_r8,9.5518e-04_r8,6.6828e-05_r8/) + kbo(:, 5,30, 4) = (/ & + &2.8573e-03_r8,2.7008e-03_r8,2.0712e-03_r8,1.2802e-03_r8,7.9313e-05_r8/) + kbo(:, 1,31, 4) = (/ & + &4.7945e-04_r8,5.2447e-04_r8,4.3249e-04_r8,2.9383e-04_r8,2.9390e-05_r8/) + kbo(:, 2,31, 4) = (/ & + &7.7587e-04_r8,8.0972e-04_r8,6.5328e-04_r8,4.3065e-04_r8,3.6906e-05_r8/) + kbo(:, 3,31, 4) = (/ & + &1.1974e-03_r8,1.2004e-03_r8,9.4868e-04_r8,6.0827e-04_r8,4.5016e-05_r8/) + kbo(:, 4,31, 4) = (/ & + &1.7617e-03_r8,1.7074e-03_r8,1.3255e-03_r8,8.3172e-04_r8,5.4252e-05_r8/) + kbo(:, 5,31, 4) = (/ & + &2.4825e-03_r8,2.3423e-03_r8,1.7933e-03_r8,1.1061e-03_r8,6.4138e-05_r8/) + kbo(:, 1,32, 4) = (/ & + &4.3738e-04_r8,4.7509e-04_r8,3.9041e-04_r8,2.6369e-04_r8,2.4019e-05_r8/) + kbo(:, 2,32, 4) = (/ & + &6.9937e-04_r8,7.2599e-04_r8,5.8354e-04_r8,3.8245e-04_r8,2.9892e-05_r8/) + kbo(:, 3,32, 4) = (/ & + &1.0660e-03_r8,1.0639e-03_r8,8.3776e-04_r8,5.3497e-04_r8,3.6437e-05_r8/) + kbo(:, 4,32, 4) = (/ & + &1.5490e-03_r8,1.4965e-03_r8,1.1588e-03_r8,7.2497e-04_r8,4.3698e-05_r8/) + kbo(:, 5,32, 4) = (/ & + &2.1609e-03_r8,2.0352e-03_r8,1.5553e-03_r8,9.5666e-04_r8,5.1532e-05_r8/) + kbo(:, 1,33, 4) = (/ & + &3.9889e-04_r8,4.2999e-04_r8,3.5197e-04_r8,2.3634e-04_r8,1.9311e-05_r8/) + kbo(:, 2,33, 4) = (/ & + &6.2991e-04_r8,6.5021e-04_r8,5.2059e-04_r8,3.3932e-04_r8,2.4117e-05_r8/) + kbo(:, 3,33, 4) = (/ & + &9.4755e-04_r8,9.4129e-04_r8,7.3904e-04_r8,4.6991e-04_r8,2.9354e-05_r8/) + kbo(:, 4,33, 4) = (/ & + &1.3617e-03_r8,1.3113e-03_r8,1.0129e-03_r8,6.3180e-04_r8,3.5029e-05_r8/) + kbo(:, 5,33, 4) = (/ & + &1.8805e-03_r8,1.7688e-03_r8,1.3485e-03_r8,8.2760e-04_r8,4.1309e-05_r8/) + kbo(:, 1,34, 4) = (/ & + &3.6214e-04_r8,3.8716e-04_r8,3.1549e-04_r8,2.1059e-04_r8,1.5692e-05_r8/) + kbo(:, 2,34, 4) = (/ & + &5.6474e-04_r8,5.7963e-04_r8,4.6204e-04_r8,2.9966e-04_r8,1.9450e-05_r8/) + kbo(:, 3,34, 4) = (/ & + &8.4034e-04_r8,8.3067e-04_r8,6.4971e-04_r8,4.1144e-04_r8,2.3693e-05_r8/) + kbo(:, 4,34, 4) = (/ & + &1.1957e-03_r8,1.1475e-03_r8,8.8389e-04_r8,5.4962e-04_r8,2.8253e-05_r8/) + kbo(:, 5,34, 4) = (/ & + &1.6380e-03_r8,1.5373e-03_r8,1.1695e-03_r8,7.1576e-04_r8,3.2957e-05_r8/) + kbo(:, 1,35, 4) = (/ & + &3.1359e-04_r8,3.3446e-04_r8,2.7193e-04_r8,1.8091e-04_r8,1.2437e-05_r8/) + kbo(:, 2,35, 4) = (/ & + &4.8583e-04_r8,4.9752e-04_r8,3.9566e-04_r8,2.5593e-04_r8,1.5305e-05_r8/) + kbo(:, 3,35, 4) = (/ & + &7.1875e-04_r8,7.0909e-04_r8,5.5358e-04_r8,3.4993e-04_r8,1.8635e-05_r8/) + kbo(:, 4,35, 4) = (/ & + &1.0171e-03_r8,9.7513e-04_r8,7.5023e-04_r8,4.6569e-04_r8,2.2205e-05_r8/) + kbo(:, 5,35, 4) = (/ & + &1.3872e-03_r8,1.3015e-03_r8,9.8912e-04_r8,6.0449e-04_r8,2.6045e-05_r8/) + kbo(:, 1,36, 4) = (/ & + &2.5808e-04_r8,2.7599e-04_r8,2.2440e-04_r8,1.4937e-04_r8,9.6631e-06_r8/) + kbo(:, 2,36, 4) = (/ & + &3.9964e-04_r8,4.1003e-04_r8,3.2602e-04_r8,2.1097e-04_r8,1.1834e-05_r8/) + kbo(:, 3,36, 4) = (/ & + &5.9092e-04_r8,5.8383e-04_r8,4.5590e-04_r8,2.8824e-04_r8,1.4353e-05_r8/) + kbo(:, 4,36, 4) = (/ & + &8.3595e-04_r8,8.0277e-04_r8,6.1763e-04_r8,3.8334e-04_r8,1.7189e-05_r8/) + kbo(:, 5,36, 4) = (/ & + &1.1396e-03_r8,1.0707e-03_r8,8.1375e-04_r8,4.9743e-04_r8,2.0326e-05_r8/) + kbo(:, 1,37, 4) = (/ & + &2.0121e-04_r8,2.1647e-04_r8,1.7647e-04_r8,1.1785e-04_r8,7.4310e-06_r8/) + kbo(:, 2,37, 4) = (/ & + &3.1330e-04_r8,3.2327e-04_r8,2.5768e-04_r8,1.6717e-04_r8,9.1199e-06_r8/) + kbo(:, 3,37, 4) = (/ & + &4.6580e-04_r8,4.6262e-04_r8,3.6181e-04_r8,2.2919e-04_r8,1.1050e-05_r8/) + kbo(:, 4,37, 4) = (/ & + &6.6212e-04_r8,6.3859e-04_r8,4.9190e-04_r8,3.0576e-04_r8,1.3280e-05_r8/) + kbo(:, 5,37, 4) = (/ & + &9.0672e-04_r8,8.5472e-04_r8,6.5027e-04_r8,3.9796e-04_r8,1.5719e-05_r8/) + kbo(:, 1,38, 4) = (/ & + &1.5610e-04_r8,1.6913e-04_r8,1.3823e-04_r8,9.2645e-05_r8,5.6716e-06_r8/) + kbo(:, 2,38, 4) = (/ & + &2.4467e-04_r8,2.5398e-04_r8,2.0295e-04_r8,1.3206e-04_r8,6.9811e-06_r8/) + kbo(:, 3,38, 4) = (/ & + &3.6591e-04_r8,3.6541e-04_r8,2.8633e-04_r8,1.8175e-04_r8,8.4645e-06_r8/) + kbo(:, 4,38, 4) = (/ & + &5.2302e-04_r8,5.0671e-04_r8,3.9077e-04_r8,2.4331e-04_r8,1.0160e-05_r8/) + kbo(:, 5,38, 4) = (/ & + &7.1953e-04_r8,6.8071e-04_r8,5.1841e-04_r8,3.1771e-04_r8,1.2087e-05_r8/) + kbo(:, 1,39, 4) = (/ & + &1.2096e-04_r8,1.3199e-04_r8,1.0815e-04_r8,7.2736e-05_r8,4.3132e-06_r8/) + kbo(:, 2,39, 4) = (/ & + &1.9086e-04_r8,1.9937e-04_r8,1.5970e-04_r8,1.0426e-04_r8,5.3181e-06_r8/) + kbo(:, 3,39, 4) = (/ & + &2.8720e-04_r8,2.8844e-04_r8,2.2641e-04_r8,1.4405e-04_r8,6.4566e-06_r8/) + kbo(:, 4,39, 4) = (/ & + &4.1286e-04_r8,4.0180e-04_r8,3.1020e-04_r8,1.9350e-04_r8,7.7296e-06_r8/) + kbo(:, 5,39, 4) = (/ & + &5.7063e-04_r8,5.4191e-04_r8,4.1317e-04_r8,2.5355e-04_r8,9.2083e-06_r8/) + kbo(:, 1,40, 4) = (/ & + &9.0120e-05_r8,9.9405e-05_r8,8.1774e-05_r8,5.5348e-05_r8,3.2802e-06_r8/) + kbo(:, 2,40, 4) = (/ & + &1.4396e-04_r8,1.5172e-04_r8,1.2199e-04_r8,8.0081e-05_r8,4.0450e-06_r8/) + kbo(:, 3,40, 4) = (/ & + &2.1897e-04_r8,2.2172e-04_r8,1.7453e-04_r8,1.1150e-04_r8,4.9391e-06_r8/) + kbo(:, 4,40, 4) = (/ & + &3.1818e-04_r8,3.1148e-04_r8,2.4096e-04_r8,1.5075e-04_r8,5.9260e-06_r8/) + kbo(:, 5,40, 4) = (/ & + &4.4338e-04_r8,4.2299e-04_r8,3.2304e-04_r8,1.9869e-04_r8,7.0429e-06_r8/) + kbo(:, 1,41, 4) = (/ & + &6.6586e-05_r8,7.4344e-05_r8,6.1391e-05_r8,4.1826e-05_r8,2.4789e-06_r8/) + kbo(:, 2,41, 4) = (/ & + &1.0786e-04_r8,1.1471e-04_r8,9.2627e-05_r8,6.1134e-05_r8,3.0831e-06_r8/) + kbo(:, 3,41, 4) = (/ & + &1.6588e-04_r8,1.6943e-04_r8,1.3383e-04_r8,8.5899e-05_r8,3.7712e-06_r8/) + kbo(:, 4,41, 4) = (/ & + &2.4383e-04_r8,2.4037e-04_r8,1.8645e-04_r8,1.1700e-04_r8,4.5478e-06_r8/) + kbo(:, 5,41, 4) = (/ & + &3.4300e-04_r8,3.2889e-04_r8,2.5168e-04_r8,1.5514e-04_r8,5.3910e-06_r8/) + kbo(:, 1,42, 4) = (/ & + &4.8998e-05_r8,5.5419e-05_r8,4.5947e-05_r8,3.1516e-05_r8,1.8667e-06_r8/) + kbo(:, 2,42, 4) = (/ & + &8.0484e-05_r8,8.6481e-05_r8,7.0103e-05_r8,4.6544e-05_r8,2.3354e-06_r8/) + kbo(:, 3,42, 4) = (/ & + &1.2531e-04_r8,1.2923e-04_r8,1.0238e-04_r8,6.6044e-05_r8,2.8708e-06_r8/) + kbo(:, 4,42, 4) = (/ & + &1.8633e-04_r8,1.8503e-04_r8,1.4397e-04_r8,9.0645e-05_r8,3.4606e-06_r8/) + kbo(:, 5,42, 4) = (/ & + &2.6476e-04_r8,2.5534e-04_r8,1.9578e-04_r8,1.2098e-04_r8,4.1084e-06_r8/) + kbo(:, 1,43, 4) = (/ & + &3.5242e-05_r8,4.0436e-05_r8,3.3714e-05_r8,2.3281e-05_r8,1.3919e-06_r8/) + kbo(:, 2,43, 4) = (/ & + &5.8897e-05_r8,6.4054e-05_r8,5.2168e-05_r8,3.4865e-05_r8,1.7548e-06_r8/) + kbo(:, 3,43, 4) = (/ & + &9.3170e-05_r8,9.7046e-05_r8,7.7251e-05_r8,5.0106e-05_r8,2.1668e-06_r8/) + kbo(:, 4,43, 4) = (/ & + &1.4048e-04_r8,1.4075e-04_r8,1.0986e-04_r8,6.9448e-05_r8,2.6074e-06_r8/) + kbo(:, 5,43, 4) = (/ & + &2.0220e-04_r8,1.9644e-04_r8,1.5089e-04_r8,9.3492e-05_r8,3.1278e-06_r8/) + kbo(:, 1,44, 4) = (/ & + &2.5004e-05_r8,2.9138e-05_r8,2.4437e-05_r8,1.6989e-05_r8,1.0250e-06_r8/) + kbo(:, 2,44, 4) = (/ & + &4.2585e-05_r8,4.6938e-05_r8,3.8422e-05_r8,2.5865e-05_r8,1.3112e-06_r8/) + kbo(:, 3,44, 4) = (/ & + &6.8563e-05_r8,7.2232e-05_r8,5.7761e-05_r8,3.7700e-05_r8,1.6186e-06_r8/) + kbo(:, 4,44, 4) = (/ & + &1.0501e-04_r8,1.0630e-04_r8,8.3253e-05_r8,5.2860e-05_r8,1.9651e-06_r8/) + kbo(:, 5,44, 4) = (/ & + &1.5343e-04_r8,1.5019e-04_r8,1.1567e-04_r8,7.1872e-05_r8,2.3710e-06_r8/) + kbo(:, 1,45, 4) = (/ & + &1.7648e-05_r8,2.0899e-05_r8,1.7624e-05_r8,1.2332e-05_r8,7.4778e-07_r8/) + kbo(:, 2,45, 4) = (/ & + &3.0648e-05_r8,3.4228e-05_r8,2.8145e-05_r8,1.9101e-05_r8,9.7150e-07_r8/) + kbo(:, 3,45, 4) = (/ & + &5.0244e-05_r8,5.3520e-05_r8,4.3001e-05_r8,2.8243e-05_r8,1.2073e-06_r8/) + kbo(:, 4,45, 4) = (/ & + &7.8191e-05_r8,7.9995e-05_r8,6.2888e-05_r8,4.0157e-05_r8,1.4831e-06_r8/) + kbo(:, 5,45, 4) = (/ & + &1.1605e-04_r8,1.1449e-04_r8,8.8448e-05_r8,5.5140e-05_r8,1.7858e-06_r8/) + kbo(:, 1,46, 4) = (/ & + &1.2241e-05_r8,1.4754e-05_r8,1.2528e-05_r8,8.8151e-06_r8,5.3848e-07_r8/) + kbo(:, 2,46, 4) = (/ & + &2.1731e-05_r8,2.4625e-05_r8,2.0352e-05_r8,1.3921e-05_r8,7.0792e-07_r8/) + kbo(:, 3,46, 4) = (/ & + &3.6328e-05_r8,3.9139e-05_r8,3.1626e-05_r8,2.0940e-05_r8,8.9555e-07_r8/) + kbo(:, 4,46, 4) = (/ & + &5.7531e-05_r8,5.9510e-05_r8,4.7024e-05_r8,3.0210e-05_r8,1.1090e-06_r8/) + kbo(:, 5,46, 4) = (/ & + &8.6821e-05_r8,8.6443e-05_r8,6.7046e-05_r8,4.1968e-05_r8,1.3451e-06_r8/) + kbo(:, 1,47, 4) = (/ & + &8.2449e-06_r8,1.0146e-05_r8,8.6807e-06_r8,6.1518e-06_r8,3.8332e-07_r8/) + kbo(:, 2,47, 4) = (/ & + &1.4999e-05_r8,1.7293e-05_r8,1.4384e-05_r8,9.9184e-06_r8,5.1069e-07_r8/) + kbo(:, 3,47, 4) = (/ & + &2.5663e-05_r8,2.8031e-05_r8,2.2776e-05_r8,1.5214e-05_r8,6.5507e-07_r8/) + kbo(:, 4,47, 4) = (/ & + &4.1483e-05_r8,4.3442e-05_r8,3.4514e-05_r8,2.2339e-05_r8,8.2140e-07_r8/) + kbo(:, 5,47, 4) = (/ & + &6.3807e-05_r8,6.4263e-05_r8,5.0034e-05_r8,3.1504e-05_r8,1.0057e-06_r8/) + kbo(:, 1,48, 4) = (/ & + &5.5161e-06_r8,6.9345e-06_r8,5.9711e-06_r8,4.2630e-06_r8,2.7090e-07_r8/) + kbo(:, 2,48, 4) = (/ & + &1.0274e-05_r8,1.2067e-05_r8,1.0101e-05_r8,7.0075e-06_r8,3.6468e-07_r8/) + kbo(:, 3,48, 4) = (/ & + &1.7999e-05_r8,1.9964e-05_r8,1.6291e-05_r8,1.0982e-05_r8,4.7593e-07_r8/) + kbo(:, 4,48, 4) = (/ & + &2.9748e-05_r8,3.1502e-05_r8,2.5173e-05_r8,1.6424e-05_r8,6.0510e-07_r8/) + kbo(:, 5,48, 4) = (/ & + &4.6627e-05_r8,4.7519e-05_r8,3.7159e-05_r8,2.3556e-05_r8,7.4697e-07_r8/) + kbo(:, 1,49, 4) = (/ & + &3.6712e-06_r8,4.7085e-06_r8,4.0821e-06_r8,2.9344e-06_r8,1.8902e-07_r8/) + kbo(:, 2,49, 4) = (/ & + &6.9808e-06_r8,8.3574e-06_r8,7.0495e-06_r8,4.9158e-06_r8,2.5862e-07_r8/) + kbo(:, 3,49, 4) = (/ & + &1.2533e-05_r8,1.4129e-05_r8,1.1598e-05_r8,7.8741e-06_r8,3.4164e-07_r8/) + kbo(:, 4,49, 4) = (/ & + &2.1199e-05_r8,2.2725e-05_r8,1.8253e-05_r8,1.2008e-05_r8,4.3895e-07_r8/) + kbo(:, 5,49, 4) = (/ & + &3.3893e-05_r8,3.4945e-05_r8,2.7461e-05_r8,1.7529e-05_r8,5.4985e-07_r8/) + kbo(:, 1,50, 4) = (/ & + &2.4835e-06_r8,3.2299e-06_r8,2.8168e-06_r8,2.0358e-06_r8,1.3342e-07_r8/) + kbo(:, 2,50, 4) = (/ & + &4.7895e-06_r8,5.8338e-06_r8,4.9516e-06_r8,3.4721e-06_r8,1.8475e-07_r8/) + kbo(:, 3,50, 4) = (/ & + &8.7933e-06_r8,1.0062e-05_r8,8.3077e-06_r8,5.6722e-06_r8,2.4761e-07_r8/) + kbo(:, 4,50, 4) = (/ & + &1.5202e-05_r8,1.6503e-05_r8,1.3305e-05_r8,8.8168e-06_r8,3.2240e-07_r8/) + kbo(:, 5,50, 4) = (/ & + &2.4800e-05_r8,2.5828e-05_r8,2.0397e-05_r8,1.3093e-05_r8,4.0814e-07_r8/) + kbo(:, 1,51, 4) = (/ & + &1.7011e-06_r8,2.2256e-06_r8,1.9504e-06_r8,1.4154e-06_r8,9.4900e-08_r8/) + kbo(:, 2,51, 4) = (/ & + &3.2953e-06_r8,4.0790e-06_r8,3.4794e-06_r8,2.4537e-06_r8,1.3273e-07_r8/) + kbo(:, 3,51, 4) = (/ & + &6.1746e-06_r8,7.1689e-06_r8,5.9544e-06_r8,4.0832e-06_r8,1.8014e-07_r8/) + kbo(:, 4,51, 4) = (/ & + &1.0912e-05_r8,1.1993e-05_r8,9.7046e-06_r8,6.4754e-06_r8,2.3777e-07_r8/) + kbo(:, 5,51, 4) = (/ & + &1.8173e-05_r8,1.9097e-05_r8,1.5144e-05_r8,9.7867e-06_r8,3.0334e-07_r8/) + kbo(:, 1,52, 4) = (/ & + &1.1779e-06_r8,1.5381e-06_r8,1.3497e-06_r8,9.8158e-07_r8,6.6305e-08_r8/) + kbo(:, 2,52, 4) = (/ & + &2.2623e-06_r8,2.8412e-06_r8,2.4342e-06_r8,1.7266e-06_r8,9.4865e-08_r8/) + kbo(:, 3,52, 4) = (/ & + &4.3170e-06_r8,5.0854e-06_r8,4.2468e-06_r8,2.9260e-06_r8,1.3026e-07_r8/) + kbo(:, 4,52, 4) = (/ & + &7.7969e-06_r8,8.6772e-06_r8,7.0531e-06_r8,4.7333e-06_r8,1.7384e-07_r8/) + kbo(:, 5,52, 4) = (/ & + &1.3261e-05_r8,1.4075e-05_r8,1.1203e-05_r8,7.2837e-06_r8,2.2485e-07_r8/) + kbo(:, 1,53, 4) = (/ & + &8.3089e-07_r8,1.0687e-06_r8,9.3518e-07_r8,6.7997e-07_r8,4.5831e-08_r8/) + kbo(:, 2,53, 4) = (/ & + &1.5556e-06_r8,1.9711e-06_r8,1.6966e-06_r8,1.2083e-06_r8,6.7497e-08_r8/) + kbo(:, 3,53, 4) = (/ & + &3.0048e-06_r8,3.5908e-06_r8,3.0131e-06_r8,2.0844e-06_r8,9.3485e-08_r8/) + kbo(:, 4,53, 4) = (/ & + &5.5438e-06_r8,6.2468e-06_r8,5.1016e-06_r8,3.4387e-06_r8,1.2594e-07_r8/) + kbo(:, 5,53, 4) = (/ & + &9.6328e-06_r8,1.0329e-05_r8,8.2446e-06_r8,5.3978e-06_r8,1.6450e-07_r8/) + kbo(:, 1,54, 4) = (/ & + &6.1034e-07_r8,7.6407e-07_r8,6.6371e-07_r8,4.8016e-07_r8,3.1960e-08_r8/) + kbo(:, 2,54, 4) = (/ & + &1.0977e-06_r8,1.3930e-06_r8,1.2021e-06_r8,8.5784e-07_r8,4.9012e-08_r8/) + kbo(:, 3,54, 4) = (/ & + &2.1270e-06_r8,2.5705e-06_r8,2.1637e-06_r8,1.5024e-06_r8,6.8673e-08_r8/) + kbo(:, 4,54, 4) = (/ & + &3.9965e-06_r8,4.5514e-06_r8,3.7320e-06_r8,2.5226e-06_r8,9.3587e-08_r8/) + kbo(:, 5,54, 4) = (/ & + &7.0830e-06_r8,7.6654e-06_r8,6.1329e-06_r8,4.0351e-06_r8,1.2382e-07_r8/) + kbo(:, 1,55, 4) = (/ & + &4.6385e-07_r8,5.5921e-07_r8,4.8019e-07_r8,3.4337e-07_r8,2.2394e-08_r8/) + kbo(:, 2,55, 4) = (/ & + &7.8989e-07_r8,9.9640e-07_r8,8.5986e-07_r8,6.1313e-07_r8,3.5977e-08_r8/) + kbo(:, 3,55, 4) = (/ & + &1.5192e-06_r8,1.8516e-06_r8,1.5624e-06_r8,1.0878e-06_r8,5.1500e-08_r8/) + kbo(:, 4,55, 4) = (/ & + &2.8980e-06_r8,3.3321e-06_r8,2.7426e-06_r8,1.8581e-06_r8,7.0762e-08_r8/) + kbo(:, 5,55, 4) = (/ & + &5.2356e-06_r8,5.7136e-06_r8,4.5826e-06_r8,3.0253e-06_r8,9.4338e-08_r8/) + kbo(:, 1,56, 4) = (/ & + &3.6371e-07_r8,4.1822e-07_r8,3.5281e-07_r8,2.4786e-07_r8,1.6072e-08_r8/) + kbo(:, 2,56, 4) = (/ & + &5.7786e-07_r8,7.1776e-07_r8,6.1684e-07_r8,4.3889e-07_r8,2.6450e-08_r8/) + kbo(:, 3,56, 4) = (/ & + &1.0893e-06_r8,1.3335e-06_r8,1.1271e-06_r8,7.8636e-07_r8,3.8603e-08_r8/) + kbo(:, 4,56, 4) = (/ & + &2.1010e-06_r8,2.4368e-06_r8,2.0114e-06_r8,1.3652e-06_r8,5.3303e-08_r8/) + kbo(:, 5,56, 4) = (/ & + &3.8675e-06_r8,4.2536e-06_r8,3.4205e-06_r8,2.2622e-06_r8,7.1626e-08_r8/) + kbo(:, 1,57, 4) = (/ & + &2.9431e-07_r8,3.2133e-07_r8,2.6457e-07_r8,1.8146e-07_r8,1.1259e-08_r8/) + kbo(:, 2,57, 4) = (/ & + &4.3212e-07_r8,5.2280e-07_r8,4.4601e-07_r8,3.1527e-07_r8,1.9122e-08_r8/) + kbo(:, 3,57, 4) = (/ & + &7.8679e-07_r8,9.6129e-07_r8,8.1340e-07_r8,5.6766e-07_r8,2.8681e-08_r8/) + kbo(:, 4,57, 4) = (/ & + &1.5240e-06_r8,1.7810e-06_r8,1.4725e-06_r8,1.0013e-06_r8,4.0212e-08_r8/) + kbo(:, 5,57, 4) = (/ & + &2.8546e-06_r8,3.1617e-06_r8,2.5494e-06_r8,1.6875e-06_r8,5.4480e-08_r8/) + kbo(:, 1,58, 4) = (/ & + &1.1920e-07_r8,1.4193e-07_r8,1.3380e-07_r8,1.0782e-07_r8,7.9525e-09_r8/) + kbo(:, 2,58, 4) = (/ & + &1.6186e-07_r8,2.1696e-07_r8,2.1477e-07_r8,1.8165e-07_r8,1.3814e-08_r8/) + kbo(:, 3,58, 4) = (/ & + &2.8087e-07_r8,3.9076e-07_r8,3.8760e-07_r8,3.2679e-07_r8,2.1394e-08_r8/) + kbo(:, 4,58, 4) = (/ & + &5.4191e-07_r8,7.3009e-07_r8,7.0916e-07_r8,5.8413e-07_r8,3.0724e-08_r8/) + kbo(:, 5,58, 4) = (/ & + &1.0299e-06_r8,1.3167e-06_r8,1.2488e-06_r8,1.0008e-06_r8,4.1885e-08_r8/) + kbo(:, 1,59, 4) = (/ & + &1.0039e-07_r8,1.1714e-07_r8,1.0974e-07_r8,8.7504e-08_r8,6.4674e-09_r8/) + kbo(:, 2,59, 4) = (/ & + &1.3241e-07_r8,1.7435e-07_r8,1.7189e-07_r8,1.4496e-07_r8,1.1458e-08_r8/) + kbo(:, 3,59, 4) = (/ & + &2.2493e-07_r8,3.1060e-07_r8,3.0841e-07_r8,2.6052e-07_r8,1.7735e-08_r8/) + kbo(:, 4,59, 4) = (/ & + &4.3202e-07_r8,5.8172e-07_r8,5.6654e-07_r8,4.6829e-07_r8,2.5818e-08_r8/) + kbo(:, 5,59, 4) = (/ & + &8.2523e-07_r8,1.0563e-06_r8,1.0053e-06_r8,8.0852e-07_r8,3.5572e-08_r8/) + kbo(:, 1,13, 5) = (/ & + &3.5348e-02_r8,3.1651e-02_r8,2.3972e-02_r8,1.4520e-02_r8,1.2073e-03_r8/) + kbo(:, 2,13, 5) = (/ & + &5.4657e-02_r8,4.7880e-02_r8,3.5919e-02_r8,2.1424e-02_r8,1.4997e-03_r8/) + kbo(:, 3,13, 5) = (/ & + &8.2602e-02_r8,7.1045e-02_r8,5.2562e-02_r8,3.0599e-02_r8,1.8487e-03_r8/) + kbo(:, 4,13, 5) = (/ & + &1.1970e-01_r8,1.0136e-01_r8,7.4139e-02_r8,4.2733e-02_r8,2.2117e-03_r8/) + kbo(:, 5,13, 5) = (/ & + &1.6697e-01_r8,1.3996e-01_r8,1.0160e-01_r8,5.7755e-02_r8,2.6210e-03_r8/) + kbo(:, 1,14, 5) = (/ & + &3.1413e-02_r8,2.7971e-02_r8,2.1089e-02_r8,1.2782e-02_r8,9.9834e-04_r8/) + kbo(:, 2,14, 5) = (/ & + &4.9001e-02_r8,4.2669e-02_r8,3.1890e-02_r8,1.8901e-02_r8,1.2749e-03_r8/) + kbo(:, 3,14, 5) = (/ & + &7.3648e-02_r8,6.3169e-02_r8,4.6557e-02_r8,2.7140e-02_r8,1.5545e-03_r8/) + kbo(:, 4,14, 5) = (/ & + &1.0633e-01_r8,9.0035e-02_r8,6.5788e-02_r8,3.7842e-02_r8,1.8680e-03_r8/) + kbo(:, 5,14, 5) = (/ & + &1.4847e-01_r8,1.2452e-01_r8,9.0180e-02_r8,5.1123e-02_r8,2.2124e-03_r8/) + kbo(:, 1,15, 5) = (/ & + &2.6691e-02_r8,2.3767e-02_r8,1.7918e-02_r8,1.0846e-02_r8,8.4376e-04_r8/) + kbo(:, 2,15, 5) = (/ & + &4.1563e-02_r8,3.6328e-02_r8,2.7130e-02_r8,1.6082e-02_r8,1.0611e-03_r8/) + kbo(:, 3,15, 5) = (/ & + &6.2559e-02_r8,5.3858e-02_r8,3.9632e-02_r8,2.3133e-02_r8,1.2845e-03_r8/) + kbo(:, 4,15, 5) = (/ & + &9.0477e-02_r8,7.6844e-02_r8,5.6216e-02_r8,3.2223e-02_r8,1.5617e-03_r8/) + kbo(:, 5,15, 5) = (/ & + &1.2655e-01_r8,1.0613e-01_r8,7.6652e-02_r8,4.3561e-02_r8,1.9061e-03_r8/) + kbo(:, 1,16, 5) = (/ & + &2.1986e-02_r8,1.9716e-02_r8,1.4938e-02_r8,9.0172e-03_r8,6.9426e-04_r8/) + kbo(:, 2,16, 5) = (/ & + &3.4448e-02_r8,3.0201e-02_r8,2.2563e-02_r8,1.3402e-02_r8,8.6528e-04_r8/) + kbo(:, 3,16, 5) = (/ & + &5.1943e-02_r8,4.4837e-02_r8,3.3116e-02_r8,1.9274e-02_r8,1.0580e-03_r8/) + kbo(:, 4,16, 5) = (/ & + &7.5192e-02_r8,6.4048e-02_r8,4.6767e-02_r8,2.6829e-02_r8,1.3132e-03_r8/) + kbo(:, 5,16, 5) = (/ & + &1.0492e-01_r8,8.8109e-02_r8,6.3827e-02_r8,3.6312e-02_r8,1.6006e-03_r8/) + kbo(:, 1,17, 5) = (/ & + &1.8067e-02_r8,1.6242e-02_r8,1.2317e-02_r8,7.4587e-03_r8,5.8084e-04_r8/) + kbo(:, 2,17, 5) = (/ & + &2.8443e-02_r8,2.5054e-02_r8,1.8720e-02_r8,1.1098e-02_r8,7.2334e-04_r8/) + kbo(:, 3,17, 5) = (/ & + &4.2795e-02_r8,3.7062e-02_r8,2.7408e-02_r8,1.5965e-02_r8,9.0099e-04_r8/) + kbo(:, 4,17, 5) = (/ & + &6.1919e-02_r8,5.2891e-02_r8,3.8653e-02_r8,2.2221e-02_r8,1.1193e-03_r8/) + kbo(:, 5,17, 5) = (/ & + &8.6219e-02_r8,7.2608e-02_r8,5.2687e-02_r8,2.9957e-02_r8,1.3671e-03_r8/) + kbo(:, 1,18, 5) = (/ & + &1.4708e-02_r8,1.3327e-02_r8,1.0113e-02_r8,6.1290e-03_r8,4.8316e-04_r8/) + kbo(:, 2,18, 5) = (/ & + &2.3136e-02_r8,2.0491e-02_r8,1.5341e-02_r8,9.1147e-03_r8,6.0374e-04_r8/) + kbo(:, 3,18, 5) = (/ & + &3.4747e-02_r8,3.0283e-02_r8,2.2393e-02_r8,1.3077e-02_r8,7.6598e-04_r8/) + kbo(:, 4,18, 5) = (/ & + &5.0288e-02_r8,4.3057e-02_r8,3.1490e-02_r8,1.8130e-02_r8,9.5069e-04_r8/) + kbo(:, 5,18, 5) = (/ & + &6.9756e-02_r8,5.9005e-02_r8,4.2850e-02_r8,2.4412e-02_r8,1.1633e-03_r8/) + kbo(:, 1,19, 5) = (/ & + &1.2271e-02_r8,1.1130e-02_r8,8.4511e-03_r8,5.1168e-03_r8,4.1293e-04_r8/) + kbo(:, 2,19, 5) = (/ & + &1.9205e-02_r8,1.7036e-02_r8,1.2763e-02_r8,7.5902e-03_r8,5.1993e-04_r8/) + kbo(:, 3,19, 5) = (/ & + &2.8789e-02_r8,2.5103e-02_r8,1.8579e-02_r8,1.0864e-02_r8,6.5561e-04_r8/) + kbo(:, 4,19, 5) = (/ & + &4.1470e-02_r8,3.5549e-02_r8,2.6049e-02_r8,1.5006e-02_r8,8.1395e-04_r8/) + kbo(:, 5,19, 5) = (/ & + &5.7470e-02_r8,4.8743e-02_r8,3.5383e-02_r8,2.0175e-02_r8,9.9598e-04_r8/) + kbo(:, 1,20, 5) = (/ & + &1.0604e-02_r8,9.5861e-03_r8,7.2655e-03_r8,4.3823e-03_r8,3.5617e-04_r8/) + kbo(:, 2,20, 5) = (/ & + &1.6495e-02_r8,1.4613e-02_r8,1.0934e-02_r8,6.4798e-03_r8,4.4865e-04_r8/) + kbo(:, 3,20, 5) = (/ & + &2.4651e-02_r8,2.1430e-02_r8,1.5803e-02_r8,9.2155e-03_r8,5.6360e-04_r8/) + kbo(:, 4,20, 5) = (/ & + &3.5214e-02_r8,3.0218e-02_r8,2.2119e-02_r8,1.2722e-02_r8,7.0046e-04_r8/) + kbo(:, 5,20, 5) = (/ & + &4.8685e-02_r8,4.1243e-02_r8,2.9948e-02_r8,1.7048e-02_r8,8.5450e-04_r8/) + kbo(:, 1,21, 5) = (/ & + &9.2365e-03_r8,8.3349e-03_r8,6.3064e-03_r8,3.7870e-03_r8,3.0556e-04_r8/) + kbo(:, 2,21, 5) = (/ & + &1.4270e-02_r8,1.2642e-02_r8,9.4383e-03_r8,5.5694e-03_r8,3.8499e-04_r8/) + kbo(:, 3,21, 5) = (/ & + &2.1188e-02_r8,1.8415e-02_r8,1.3582e-02_r8,7.8888e-03_r8,4.8632e-04_r8/) + kbo(:, 4,21, 5) = (/ & + &3.0204e-02_r8,2.5895e-02_r8,1.8922e-02_r8,1.0859e-02_r8,6.0144e-04_r8/) + kbo(:, 5,21, 5) = (/ & + &4.1738e-02_r8,3.5266e-02_r8,2.5553e-02_r8,1.4491e-02_r8,7.3167e-04_r8/) + kbo(:, 1,22, 5) = (/ & + &8.2084e-03_r8,7.4154e-03_r8,5.5986e-03_r8,3.3447e-03_r8,2.6030e-04_r8/) + kbo(:, 2,22, 5) = (/ & + &1.2593e-02_r8,1.1132e-02_r8,8.2855e-03_r8,4.8830e-03_r8,3.3150e-04_r8/) + kbo(:, 3,22, 5) = (/ & + &1.8558e-02_r8,1.6118e-02_r8,1.1879e-02_r8,6.8818e-03_r8,4.1718e-04_r8/) + kbo(:, 4,22, 5) = (/ & + &2.6423e-02_r8,2.2608e-02_r8,1.6490e-02_r8,9.4242e-03_r8,5.1837e-04_r8/) + kbo(:, 5,22, 5) = (/ & + &3.6423e-02_r8,3.0712e-02_r8,2.2210e-02_r8,1.2556e-02_r8,6.2757e-04_r8/) + kbo(:, 1,23, 5) = (/ & + &7.2962e-03_r8,6.5767e-03_r8,4.9576e-03_r8,2.9518e-03_r8,2.2147e-04_r8/) + kbo(:, 2,23, 5) = (/ & + &1.1116e-02_r8,9.7878e-03_r8,7.2822e-03_r8,4.2736e-03_r8,2.8452e-04_r8/) + kbo(:, 3,23, 5) = (/ & + &1.6294e-02_r8,1.4142e-02_r8,1.0397e-02_r8,6.0039e-03_r8,3.5768e-04_r8/) + kbo(:, 4,23, 5) = (/ & + &2.3164e-02_r8,1.9768e-02_r8,1.4383e-02_r8,8.1899e-03_r8,4.4507e-04_r8/) + kbo(:, 5,23, 5) = (/ & + &3.1815e-02_r8,2.6782e-02_r8,1.9341e-02_r8,1.0913e-02_r8,5.3593e-04_r8/) + kbo(:, 1,24, 5) = (/ & + &6.5132e-03_r8,5.8530e-03_r8,4.4011e-03_r8,2.6156e-03_r8,1.8866e-04_r8/) + kbo(:, 2,24, 5) = (/ & + &9.8979e-03_r8,8.6925e-03_r8,6.4521e-03_r8,3.7670e-03_r8,2.4398e-04_r8/) + kbo(:, 3,24, 5) = (/ & + &1.4458e-02_r8,1.2498e-02_r8,9.1615e-03_r8,5.2667e-03_r8,3.0838e-04_r8/) + kbo(:, 4,24, 5) = (/ & + &2.0434e-02_r8,1.7400e-02_r8,1.2635e-02_r8,7.1775e-03_r8,3.8038e-04_r8/) + kbo(:, 5,24, 5) = (/ & + &2.8011e-02_r8,2.3552e-02_r8,1.6988e-02_r8,9.5542e-03_r8,4.5842e-04_r8/) + kbo(:, 1,25, 5) = (/ & + &5.8496e-03_r8,5.2463e-03_r8,3.9347e-03_r8,2.3271e-03_r8,1.6445e-04_r8/) + kbo(:, 2,25, 5) = (/ & + &8.8417e-03_r8,7.7604e-03_r8,5.7347e-03_r8,3.3321e-03_r8,2.1081e-04_r8/) + kbo(:, 3,25, 5) = (/ & + &1.2868e-02_r8,1.1077e-02_r8,8.0978e-03_r8,4.6433e-03_r8,2.6559e-04_r8/) + kbo(:, 4,25, 5) = (/ & + &1.8100e-02_r8,1.5382e-02_r8,1.1156e-02_r8,6.3115e-03_r8,3.2583e-04_r8/) + kbo(:, 5,25, 5) = (/ & + &2.4695e-02_r8,2.0722e-02_r8,1.4925e-02_r8,8.3824e-03_r8,3.9105e-04_r8/) + kbo(:, 1,26, 5) = (/ & + &5.3224e-03_r8,4.7440e-03_r8,3.5455e-03_r8,2.0856e-03_r8,1.4273e-04_r8/) + kbo(:, 2,26, 5) = (/ & + &7.9880e-03_r8,6.9773e-03_r8,5.1401e-03_r8,2.9750e-03_r8,1.8261e-04_r8/) + kbo(:, 3,26, 5) = (/ & + &1.1564e-02_r8,9.9215e-03_r8,7.2343e-03_r8,4.1334e-03_r8,2.2903e-04_r8/) + kbo(:, 4,26, 5) = (/ & + &1.6157e-02_r8,1.3698e-02_r8,9.9057e-03_r8,5.5934e-03_r8,2.7897e-04_r8/) + kbo(:, 5,26, 5) = (/ & + &2.1895e-02_r8,1.8349e-02_r8,1.3199e-02_r8,7.3992e-03_r8,3.3238e-04_r8/) + kbo(:, 1,27, 5) = (/ & + &4.8372e-03_r8,4.2909e-03_r8,3.1935e-03_r8,1.8703e-03_r8,1.2222e-04_r8/) + kbo(:, 2,27, 5) = (/ & + &7.2219e-03_r8,6.2785e-03_r8,4.6150e-03_r8,2.6594e-03_r8,1.5564e-04_r8/) + kbo(:, 3,27, 5) = (/ & + &1.0384e-02_r8,8.8912e-03_r8,6.4664e-03_r8,3.6778e-03_r8,1.9361e-04_r8/) + kbo(:, 4,27, 5) = (/ & + &1.4401e-02_r8,1.2183e-02_r8,8.7984e-03_r8,4.9566e-03_r8,2.3445e-04_r8/) + kbo(:, 5,27, 5) = (/ & + &1.9400e-02_r8,1.6243e-02_r8,1.1670e-02_r8,6.5316e-03_r8,2.7869e-04_r8/) + kbo(:, 1,28, 5) = (/ & + &4.3907e-03_r8,3.8800e-03_r8,2.8785e-03_r8,1.6793e-03_r8,1.0352e-04_r8/) + kbo(:, 2,28, 5) = (/ & + &6.5180e-03_r8,5.6500e-03_r8,4.1431e-03_r8,2.3781e-03_r8,1.3090e-04_r8/) + kbo(:, 3,28, 5) = (/ & + &9.2995e-03_r8,7.9428e-03_r8,5.7641e-03_r8,3.2684e-03_r8,1.6163e-04_r8/) + kbo(:, 4,28, 5) = (/ & + &1.2806e-02_r8,1.0816e-02_r8,7.7992e-03_r8,4.3863e-03_r8,1.9422e-04_r8/) + kbo(:, 5,28, 5) = (/ & + &1.7155e-02_r8,1.4361e-02_r8,1.0305e-02_r8,5.7599e-03_r8,2.3020e-04_r8/) + kbo(:, 1,29, 5) = (/ & + &3.9730e-03_r8,3.5033e-03_r8,2.5903e-03_r8,1.5043e-03_r8,8.6138e-05_r8/) + kbo(:, 2,29, 5) = (/ & + &5.8501e-03_r8,5.0589e-03_r8,3.6981e-03_r8,2.1165e-03_r8,1.0866e-04_r8/) + kbo(:, 3,29, 5) = (/ & + &8.2752e-03_r8,7.0540e-03_r8,5.1122e-03_r8,2.8938e-03_r8,1.3206e-04_r8/) + kbo(:, 4,29, 5) = (/ & + &1.1323e-02_r8,9.5548e-03_r8,6.8809e-03_r8,3.8639e-03_r8,1.5770e-04_r8/) + kbo(:, 5,29, 5) = (/ & + &1.5087e-02_r8,1.2624e-02_r8,9.0498e-03_r8,5.0491e-03_r8,1.8805e-04_r8/) + kbo(:, 1,30, 5) = (/ & + &3.5719e-03_r8,3.1399e-03_r8,2.3162e-03_r8,1.3392e-03_r8,7.1373e-05_r8/) + kbo(:, 2,30, 5) = (/ & + &5.2107e-03_r8,4.4986e-03_r8,3.2816e-03_r8,1.8730e-03_r8,8.8119e-05_r8/) + kbo(:, 3,30, 5) = (/ & + &7.3165e-03_r8,6.2315e-03_r8,4.5078e-03_r8,2.5469e-03_r8,1.0662e-04_r8/) + kbo(:, 4,30, 5) = (/ & + &9.9520e-03_r8,8.3892e-03_r8,6.0327e-03_r8,3.3847e-03_r8,1.2803e-04_r8/) + kbo(:, 5,30, 5) = (/ & + &1.3166e-02_r8,1.1029e-02_r8,7.9003e-03_r8,4.4030e-03_r8,1.5121e-04_r8/) + kbo(:, 1,31, 5) = (/ & + &3.1788e-03_r8,2.7864e-03_r8,2.0507e-03_r8,1.1825e-03_r8,5.7200e-05_r8/) + kbo(:, 2,31, 5) = (/ & + &4.5964e-03_r8,3.9617e-03_r8,2.8849e-03_r8,1.6429e-03_r8,7.0401e-05_r8/) + kbo(:, 3,31, 5) = (/ & + &6.4014e-03_r8,5.4495e-03_r8,3.9350e-03_r8,2.2208e-03_r8,8.5247e-05_r8/) + kbo(:, 4,31, 5) = (/ & + &8.6375e-03_r8,7.2878e-03_r8,5.2393e-03_r8,2.9385e-03_r8,1.0146e-04_r8/) + kbo(:, 5,31, 5) = (/ & + &1.1347e-02_r8,9.5229e-03_r8,6.8169e-03_r8,3.7997e-03_r8,1.1891e-04_r8/) + kbo(:, 1,32, 5) = (/ & + &2.8359e-03_r8,2.4792e-03_r8,1.8198e-03_r8,1.0462e-03_r8,4.5712e-05_r8/) + kbo(:, 2,32, 5) = (/ & + &4.0627e-03_r8,3.4962e-03_r8,2.5410e-03_r8,1.4431e-03_r8,5.6022e-05_r8/) + kbo(:, 3,32, 5) = (/ & + &5.6078e-03_r8,4.7711e-03_r8,3.4442e-03_r8,1.9418e-03_r8,6.7267e-05_r8/) + kbo(:, 4,32, 5) = (/ & + &7.5047e-03_r8,6.3406e-03_r8,4.5581e-03_r8,2.5548e-03_r8,7.9547e-05_r8/) + kbo(:, 5,32, 5) = (/ & + &9.7792e-03_r8,8.2213e-03_r8,5.8868e-03_r8,3.2848e-03_r8,9.2763e-05_r8/) + kbo(:, 1,33, 5) = (/ & + &2.5284e-03_r8,2.2057e-03_r8,1.6155e-03_r8,9.2588e-04_r8,3.6267e-05_r8/) + kbo(:, 2,33, 5) = (/ & + &3.5886e-03_r8,3.0844e-03_r8,2.2382e-03_r8,1.2695e-03_r8,4.4003e-05_r8/) + kbo(:, 3,33, 5) = (/ & + &4.9097e-03_r8,4.1805e-03_r8,3.0157e-03_r8,1.6993e-03_r8,5.2825e-05_r8/) + kbo(:, 4,33, 5) = (/ & + &6.5165e-03_r8,5.5167e-03_r8,3.9645e-03_r8,2.2215e-03_r8,6.1889e-05_r8/) + kbo(:, 5,33, 5) = (/ & + &8.4209e-03_r8,7.0899e-03_r8,5.0775e-03_r8,2.8354e-03_r8,7.2610e-05_r8/) + kbo(:, 1,34, 5) = (/ & + &2.2520e-03_r8,1.9602e-03_r8,1.4328e-03_r8,8.1868e-04_r8,2.9417e-05_r8/) + kbo(:, 2,34, 5) = (/ & + &3.1681e-03_r8,2.7215e-03_r8,1.9717e-03_r8,1.1166e-03_r8,3.5490e-05_r8/) + kbo(:, 3,34, 5) = (/ & + &4.2977e-03_r8,3.6615e-03_r8,2.6403e-03_r8,1.4869e-03_r8,4.1854e-05_r8/) + kbo(:, 4,34, 5) = (/ & + &5.6597e-03_r8,4.7967e-03_r8,3.4462e-03_r8,1.9298e-03_r8,4.9348e-05_r8/) + kbo(:, 5,34, 5) = (/ & + &7.2681e-03_r8,6.1253e-03_r8,4.3873e-03_r8,2.4514e-03_r8,5.8186e-05_r8/) + kbo(:, 1,35, 5) = (/ & + &1.9366e-03_r8,1.6854e-03_r8,1.2304e-03_r8,7.0199e-04_r8,2.3008e-05_r8/) + kbo(:, 2,35, 5) = (/ & + &2.7102e-03_r8,2.3296e-03_r8,1.6872e-03_r8,9.5490e-04_r8,2.7664e-05_r8/) + kbo(:, 3,35, 5) = (/ & + &3.6574e-03_r8,3.1206e-03_r8,2.2499e-03_r8,1.2662e-03_r8,3.3089e-05_r8/) + kbo(:, 4,35, 5) = (/ & + &4.7963e-03_r8,4.0694e-03_r8,2.9228e-03_r8,1.6371e-03_r8,3.9372e-05_r8/) + kbo(:, 5,35, 5) = (/ & + &6.1352e-03_r8,5.1795e-03_r8,3.7111e-03_r8,2.0740e-03_r8,4.6276e-05_r8/) + kbo(:, 1,36, 5) = (/ & + &1.6034e-03_r8,1.3976e-03_r8,1.0202e-03_r8,5.8186e-04_r8,1.7663e-05_r8/) + kbo(:, 2,36, 5) = (/ & + &2.2421e-03_r8,1.9307e-03_r8,1.3983e-03_r8,7.9118e-04_r8,2.1547e-05_r8/) + kbo(:, 3,36, 5) = (/ & + &3.0206e-03_r8,2.5824e-03_r8,1.8623e-03_r8,1.0484e-03_r8,2.5886e-05_r8/) + kbo(:, 4,36, 5) = (/ & + &3.9570e-03_r8,3.3630e-03_r8,2.4161e-03_r8,1.3541e-03_r8,3.0872e-05_r8/) + kbo(:, 5,36, 5) = (/ & + &5.0582e-03_r8,4.2785e-03_r8,3.0668e-03_r8,1.7150e-03_r8,3.6301e-05_r8/) + kbo(:, 1,37, 5) = (/ & + &1.2748e-03_r8,1.1146e-03_r8,8.1407e-04_r8,4.6450e-04_r8,1.3581e-05_r8/) + kbo(:, 2,37, 5) = (/ & + &1.7898e-03_r8,1.5447e-03_r8,1.1192e-03_r8,6.3354e-04_r8,1.6729e-05_r8/) + kbo(:, 3,37, 5) = (/ & + &2.4187e-03_r8,2.0714e-03_r8,1.4947e-03_r8,8.4187e-04_r8,2.0205e-05_r8/) + kbo(:, 4,37, 5) = (/ & + &3.1762e-03_r8,2.7057e-03_r8,1.9449e-03_r8,1.0902e-03_r8,2.4038e-05_r8/) + kbo(:, 5,37, 5) = (/ & + &4.0701e-03_r8,3.4504e-03_r8,2.4741e-03_r8,1.3836e-03_r8,2.8365e-05_r8/) + kbo(:, 1,38, 5) = (/ & + &1.0102e-03_r8,8.8559e-04_r8,6.4741e-04_r8,3.6947e-04_r8,1.0412e-05_r8/) + kbo(:, 2,38, 5) = (/ & + &1.4249e-03_r8,1.2327e-03_r8,8.9319e-04_r8,5.0584e-04_r8,1.2901e-05_r8/) + kbo(:, 3,38, 5) = (/ & + &1.9318e-03_r8,1.6579e-03_r8,1.1967e-03_r8,6.7434e-04_r8,1.5672e-05_r8/) + kbo(:, 4,38, 5) = (/ & + &2.5434e-03_r8,2.1714e-03_r8,1.5616e-03_r8,8.7562e-04_r8,1.8795e-05_r8/) + kbo(:, 5,38, 5) = (/ & + &3.2683e-03_r8,2.7765e-03_r8,1.9923e-03_r8,1.1142e-03_r8,2.2145e-05_r8/) + kbo(:, 1,39, 5) = (/ & + &7.9946e-04_r8,7.0298e-04_r8,5.1416e-04_r8,2.9368e-04_r8,7.9720e-06_r8/) + kbo(:, 2,39, 5) = (/ & + &1.1333e-03_r8,9.8290e-04_r8,7.1255e-04_r8,4.0353e-04_r8,9.9223e-06_r8/) + kbo(:, 3,39, 5) = (/ & + &1.5418e-03_r8,1.3259e-03_r8,9.5739e-04_r8,5.3970e-04_r8,1.2141e-05_r8/) + kbo(:, 4,39, 5) = (/ & + &2.0355e-03_r8,1.7418e-03_r8,1.2533e-03_r8,7.0303e-04_r8,1.4591e-05_r8/) + kbo(:, 5,39, 5) = (/ & + &2.6233e-03_r8,2.2332e-03_r8,1.6027e-03_r8,8.9673e-04_r8,1.7278e-05_r8/) + kbo(:, 1,40, 5) = (/ & + &6.1558e-04_r8,5.4339e-04_r8,3.9799e-04_r8,2.2761e-04_r8,6.0679e-06_r8/) + kbo(:, 2,40, 5) = (/ & + &8.8100e-04_r8,7.6638e-04_r8,5.5623e-04_r8,3.1507e-04_r8,7.6104e-06_r8/) + kbo(:, 3,40, 5) = (/ & + &1.2072e-03_r8,1.0404e-03_r8,7.5136e-04_r8,4.2373e-04_r8,9.3444e-06_r8/) + kbo(:, 4,40, 5) = (/ & + &1.6029e-03_r8,1.3742e-03_r8,9.8944e-04_r8,5.5501e-04_r8,1.1318e-05_r8/) + kbo(:, 5,40, 5) = (/ & + &2.0762e-03_r8,1.7710e-03_r8,1.2711e-03_r8,7.1134e-04_r8,1.3497e-05_r8/) + kbo(:, 1,41, 5) = (/ & + &4.7150e-04_r8,4.1786e-04_r8,3.0641e-04_r8,1.7559e-04_r8,4.6077e-06_r8/) + kbo(:, 2,41, 5) = (/ & + &6.8147e-04_r8,5.9486e-04_r8,4.3209e-04_r8,2.4498e-04_r8,5.8135e-06_r8/) + kbo(:, 3,41, 5) = (/ & + &9.4213e-04_r8,8.1372e-04_r8,5.8780e-04_r8,3.3145e-04_r8,7.1715e-06_r8/) + kbo(:, 4,41, 5) = (/ & + &1.2582e-03_r8,1.0809e-03_r8,7.7844e-04_r8,4.3685e-04_r8,8.7285e-06_r8/) + kbo(:, 5,41, 5) = (/ & + &1.6388e-03_r8,1.4010e-03_r8,1.0055e-03_r8,5.6266e-04_r8,1.0465e-05_r8/) + kbo(:, 1,42, 5) = (/ & + &3.6009e-04_r8,3.2039e-04_r8,2.3540e-04_r8,1.3511e-04_r8,3.4818e-06_r8/) + kbo(:, 2,42, 5) = (/ & + &5.2591e-04_r8,4.6075e-04_r8,3.3505e-04_r8,1.9005e-04_r8,4.4174e-06_r8/) + kbo(:, 3,42, 5) = (/ & + &7.3377e-04_r8,6.3539e-04_r8,4.5927e-04_r8,2.5904e-04_r8,5.4797e-06_r8/) + kbo(:, 4,42, 5) = (/ & + &9.8665e-04_r8,8.4900e-04_r8,6.1152e-04_r8,3.4335e-04_r8,6.7219e-06_r8/) + kbo(:, 5,42, 5) = (/ & + &1.2919e-03_r8,1.1071e-03_r8,7.9454e-04_r8,4.4455e-04_r8,8.0996e-06_r8/) + kbo(:, 1,43, 5) = (/ & + &2.7068e-04_r8,2.4195e-04_r8,1.7816e-04_r8,1.0249e-04_r8,2.5837e-06_r8/) + kbo(:, 2,43, 5) = (/ & + &4.0104e-04_r8,3.5254e-04_r8,2.5672e-04_r8,1.4582e-04_r8,3.3146e-06_r8/) + kbo(:, 3,43, 5) = (/ & + &5.6618e-04_r8,4.9150e-04_r8,3.5538e-04_r8,2.0045e-04_r8,4.1432e-06_r8/) + kbo(:, 4,43, 5) = (/ & + &7.6835e-04_r8,6.6216e-04_r8,4.7675e-04_r8,2.6781e-04_r8,5.1315e-06_r8/) + kbo(:, 5,43, 5) = (/ & + &1.0127e-03_r8,8.6923e-04_r8,6.2405e-04_r8,3.4899e-04_r8,6.1983e-06_r8/) + kbo(:, 1,44, 5) = (/ & + &2.0139e-04_r8,1.8106e-04_r8,1.3358e-04_r8,7.7094e-05_r8,1.8960e-06_r8/) + kbo(:, 2,44, 5) = (/ & + &3.0345e-04_r8,2.6774e-04_r8,1.9525e-04_r8,1.1112e-04_r8,2.4595e-06_r8/) + kbo(:, 3,44, 5) = (/ & + &4.3439e-04_r8,3.7822e-04_r8,2.7355e-04_r8,1.5433e-04_r8,3.1158e-06_r8/) + kbo(:, 4,44, 5) = (/ & + &5.9600e-04_r8,5.1425e-04_r8,3.7025e-04_r8,2.0795e-04_r8,3.8746e-06_r8/) + kbo(:, 5,44, 5) = (/ & + &7.9184e-04_r8,6.8038e-04_r8,4.8839e-04_r8,2.7303e-04_r8,4.7113e-06_r8/) + kbo(:, 1,45, 5) = (/ & + &1.4924e-04_r8,1.3479e-04_r8,9.9739e-05_r8,5.7756e-05_r8,1.3827e-06_r8/) + kbo(:, 2,45, 5) = (/ & + &2.2880e-04_r8,2.0270e-04_r8,1.4808e-04_r8,8.4395e-05_r8,1.8081e-06_r8/) + kbo(:, 3,45, 5) = (/ & + &3.3229e-04_r8,2.9032e-04_r8,2.1015e-04_r8,1.1857e-04_r8,2.3261e-06_r8/) + kbo(:, 4,45, 5) = (/ & + &4.6152e-04_r8,3.9893e-04_r8,2.8721e-04_r8,1.6120e-04_r8,2.9080e-06_r8/) + kbo(:, 5,45, 5) = (/ & + &6.1857e-04_r8,5.3204e-04_r8,3.8190e-04_r8,2.1341e-04_r8,3.5612e-06_r8/) + kbo(:, 1,46, 5) = (/ & + &1.0906e-04_r8,9.9059e-05_r8,7.3477e-05_r8,4.2734e-05_r8,1.0024e-06_r8/) + kbo(:, 2,46, 5) = (/ & + &1.7043e-04_r8,1.5165e-04_r8,1.1108e-04_r8,6.3473e-05_r8,1.3227e-06_r8/) + kbo(:, 3,46, 5) = (/ & + &2.5193e-04_r8,2.2079e-04_r8,1.6005e-04_r8,9.0376e-05_r8,1.7191e-06_r8/) + kbo(:, 4,46, 5) = (/ & + &3.5457e-04_r8,3.0711e-04_r8,2.2121e-04_r8,1.2412e-04_r8,2.1640e-06_r8/) + kbo(:, 5,46, 5) = (/ & + &4.8016e-04_r8,4.1350e-04_r8,2.9669e-04_r8,1.6585e-04_r8,2.6681e-06_r8/) + kbo(:, 1,47, 5) = (/ & + &7.7791e-05_r8,7.1164e-05_r8,5.2966e-05_r8,3.0950e-05_r8,7.1979e-07_r8/) + kbo(:, 2,47, 5) = (/ & + &1.2436e-04_r8,1.1134e-04_r8,8.1758e-05_r8,4.6856e-05_r8,9.5466e-07_r8/) + kbo(:, 3,47, 5) = (/ & + &1.8767e-04_r8,1.6518e-04_r8,1.1995e-04_r8,6.7855e-05_r8,1.2553e-06_r8/) + kbo(:, 4,47, 5) = (/ & + &2.6877e-04_r8,2.3350e-04_r8,1.6823e-04_r8,9.4438e-05_r8,1.6001e-06_r8/) + kbo(:, 5,47, 5) = (/ & + &3.6855e-04_r8,3.1774e-04_r8,2.2797e-04_r8,1.2742e-04_r8,1.9855e-06_r8/) + kbo(:, 1,48, 5) = (/ & + &5.5044e-05_r8,5.0693e-05_r8,3.7891e-05_r8,2.2267e-05_r8,5.1420e-07_r8/) + kbo(:, 2,48, 5) = (/ & + &9.0215e-05_r8,8.1170e-05_r8,5.9770e-05_r8,3.4413e-05_r8,6.9075e-07_r8/) + kbo(:, 3,48, 5) = (/ & + &1.3907e-04_r8,1.2292e-04_r8,8.9447e-05_r8,5.0716e-05_r8,9.0307e-07_r8/) + kbo(:, 4,48, 5) = (/ & + &2.0282e-04_r8,1.7688e-04_r8,1.2753e-04_r8,7.1593e-05_r8,1.1665e-06_r8/) + kbo(:, 5,48, 5) = (/ & + &2.8252e-04_r8,2.4382e-04_r8,1.7492e-04_r8,9.7702e-05_r8,1.4649e-06_r8/) + kbo(:, 1,49, 5) = (/ & + &3.8587e-05_r8,3.5798e-05_r8,2.6873e-05_r8,1.5895e-05_r8,3.6284e-07_r8/) + kbo(:, 2,49, 5) = (/ & + &6.4973e-05_r8,5.8784e-05_r8,4.3404e-05_r8,2.5118e-05_r8,4.9340e-07_r8/) + kbo(:, 3,49, 5) = (/ & + &1.0247e-04_r8,9.0960e-05_r8,6.6355e-05_r8,3.7720e-05_r8,6.5251e-07_r8/) + kbo(:, 4,49, 5) = (/ & + &1.5241e-04_r8,1.3334e-04_r8,9.6283e-05_r8,5.4131e-05_r8,8.4176e-07_r8/) + kbo(:, 5,49, 5) = (/ & + &2.1585e-04_r8,1.8661e-04_r8,1.3387e-04_r8,7.4762e-05_r8,1.0688e-06_r8/) + kbo(:, 1,50, 5) = (/ & + &2.7204e-05_r8,2.5412e-05_r8,1.9146e-05_r8,1.1397e-05_r8,2.5753e-07_r8/) + kbo(:, 2,50, 5) = (/ & + &4.7009e-05_r8,4.2778e-05_r8,3.1689e-05_r8,1.8416e-05_r8,3.5668e-07_r8/) + kbo(:, 3,50, 5) = (/ & + &7.5923e-05_r8,6.7680e-05_r8,4.9459e-05_r8,2.8188e-05_r8,4.7630e-07_r8/) + kbo(:, 4,50, 5) = (/ & + &1.1516e-04_r8,1.0107e-04_r8,7.3089e-05_r8,4.1129e-05_r8,6.1736e-07_r8/) + kbo(:, 5,50, 5) = (/ & + &1.6568e-04_r8,1.4364e-04_r8,1.0307e-04_r8,5.7556e-05_r8,7.8811e-07_r8/) + kbo(:, 1,51, 5) = (/ & + &1.9132e-05_r8,1.8022e-05_r8,1.3620e-05_r8,8.1585e-06_r8,1.8251e-07_r8/) + kbo(:, 2,51, 5) = (/ & + &3.4015e-05_r8,3.1104e-05_r8,2.3112e-05_r8,1.3493e-05_r8,2.5742e-07_r8/) + kbo(:, 3,51, 5) = (/ & + &5.6251e-05_r8,5.0351e-05_r8,3.6864e-05_r8,2.1082e-05_r8,3.4853e-07_r8/) + kbo(:, 4,51, 5) = (/ & + &8.7117e-05_r8,7.6686e-05_r8,5.5526e-05_r8,3.1296e-05_r8,4.5614e-07_r8/) + kbo(:, 5,51, 5) = (/ & + &1.2742e-04_r8,1.1075e-04_r8,7.9490e-05_r8,4.4386e-05_r8,5.8324e-07_r8/) + kbo(:, 1,52, 5) = (/ & + &1.3343e-05_r8,1.2680e-05_r8,9.6205e-06_r8,5.7937e-06_r8,1.2757e-07_r8/) + kbo(:, 2,52, 5) = (/ & + &2.4457e-05_r8,2.2489e-05_r8,1.6762e-05_r8,9.8342e-06_r8,1.8427e-07_r8/) + kbo(:, 3,52, 5) = (/ & + &4.1490e-05_r8,3.7272e-05_r8,2.7347e-05_r8,1.5697e-05_r8,2.5311e-07_r8/) + kbo(:, 4,52, 5) = (/ & + &6.5698e-05_r8,5.8019e-05_r8,4.2067e-05_r8,2.3741e-05_r8,3.3454e-07_r8/) + kbo(:, 5,52, 5) = (/ & + &9.7769e-05_r8,8.5199e-05_r8,6.1200e-05_r8,3.4184e-05_r8,4.3074e-07_r8/) + kbo(:, 1,53, 5) = (/ & + &9.2286e-06_r8,8.8438e-06_r8,6.7394e-06_r8,4.0796e-06_r8,8.7990e-08_r8/) + kbo(:, 2,53, 5) = (/ & + &1.7462e-05_r8,1.6145e-05_r8,1.2071e-05_r8,7.1204e-06_r8,1.3004e-07_r8/) + kbo(:, 3,53, 5) = (/ & + &3.0397e-05_r8,2.7436e-05_r8,2.0177e-05_r8,1.1626e-05_r8,1.8173e-07_r8/) + kbo(:, 4,53, 5) = (/ & + &4.9319e-05_r8,4.3681e-05_r8,3.1722e-05_r8,1.7943e-05_r8,2.4392e-07_r8/) + kbo(:, 5,53, 5) = (/ & + &7.4848e-05_r8,6.5369e-05_r8,4.7021e-05_r8,2.6269e-05_r8,3.1719e-07_r8/) + kbo(:, 1,54, 5) = (/ & + &6.4770e-06_r8,6.2515e-06_r8,4.7770e-06_r8,2.9074e-06_r8,6.2611e-08_r8/) + kbo(:, 2,54, 5) = (/ & + &1.2608e-05_r8,1.1724e-05_r8,8.7837e-06_r8,5.2044e-06_r8,9.4222e-08_r8/) + kbo(:, 3,54, 5) = (/ & + &2.2532e-05_r8,2.0405e-05_r8,1.5043e-05_r8,8.6950e-06_r8,1.3411e-07_r8/) + kbo(:, 4,54, 5) = (/ & + &3.7397e-05_r8,3.3212e-05_r8,2.4145e-05_r8,1.3685e-05_r8,1.8245e-07_r8/) + kbo(:, 5,54, 5) = (/ & + &5.7878e-05_r8,5.0645e-05_r8,3.6444e-05_r8,2.0382e-05_r8,2.3871e-07_r8/) + kbo(:, 1,55, 5) = (/ & + &4.5852e-06_r8,4.4390e-06_r8,3.4016e-06_r8,2.0767e-06_r8,4.4961e-08_r8/) + kbo(:, 2,55, 5) = (/ & + &9.1363e-06_r8,8.5468e-06_r8,6.4138e-06_r8,3.8136e-06_r8,6.9204e-08_r8/) + kbo(:, 3,55, 5) = (/ & + &1.6770e-05_r8,1.5238e-05_r8,1.1251e-05_r8,6.5245e-06_r8,1.0020e-07_r8/) + kbo(:, 4,55, 5) = (/ & + &2.8475e-05_r8,2.5343e-05_r8,1.8439e-05_r8,1.0474e-05_r8,1.3796e-07_r8/) + kbo(:, 5,55, 5) = (/ & + &4.4988e-05_r8,3.9423e-05_r8,2.8373e-05_r8,1.5872e-05_r8,1.8258e-07_r8/) + kbo(:, 1,56, 5) = (/ & + &3.2543e-06_r8,3.1469e-06_r8,2.4158e-06_r8,1.4787e-06_r8,3.1932e-08_r8/) + kbo(:, 2,56, 5) = (/ & + &6.5989e-06_r8,6.2038e-06_r8,4.6696e-06_r8,2.7831e-06_r8,5.0531e-08_r8/) + kbo(:, 3,56, 5) = (/ & + &1.2453e-05_r8,1.1352e-05_r8,8.3945e-06_r8,4.8820e-06_r8,7.4538e-08_r8/) + kbo(:, 4,56, 5) = (/ & + &2.1655e-05_r8,1.9314e-05_r8,1.4065e-05_r8,8.0028e-06_r8,1.0397e-07_r8/) + kbo(:, 5,56, 5) = (/ & + &3.4950e-05_r8,3.0673e-05_r8,2.2085e-05_r8,1.2363e-05_r8,1.3925e-07_r8/) + kbo(:, 1,57, 5) = (/ & + &2.3166e-06_r8,2.2390e-06_r8,1.7142e-06_r8,1.0504e-06_r8,2.2682e-08_r8/) + kbo(:, 2,57, 5) = (/ & + &4.7540e-06_r8,4.4892e-06_r8,3.3846e-06_r8,2.0245e-06_r8,3.6988e-08_r8/) + kbo(:, 3,57, 5) = (/ & + &9.2246e-06_r8,8.4320e-06_r8,6.2438e-06_r8,3.6425e-06_r8,5.5328e-08_r8/) + kbo(:, 4,57, 5) = (/ & + &1.6448e-05_r8,1.4704e-05_r8,1.0717e-05_r8,6.1069e-06_r8,7.8210e-08_r8/) + kbo(:, 5,57, 5) = (/ & + &2.7140e-05_r8,2.3849e-05_r8,1.7182e-05_r8,9.6233e-06_r8,1.0611e-07_r8/) + kbo(:, 1,58, 5) = (/ & + &8.1594e-07_r8,9.0016e-07_r8,8.0661e-07_r8,5.9543e-07_r8,1.6269e-08_r8/) + kbo(:, 2,58, 5) = (/ & + &1.6728e-06_r8,1.8193e-06_r8,1.6122e-06_r8,1.1689e-06_r8,2.7161e-08_r8/) + kbo(:, 3,58, 5) = (/ & + &3.3325e-06_r8,3.5076e-06_r8,3.0497e-06_r8,2.1581e-06_r8,4.1468e-08_r8/) + kbo(:, 4,58, 5) = (/ & + &6.0908e-06_r8,6.2615e-06_r8,5.3621e-06_r8,3.7018e-06_r8,5.9556e-08_r8/) + kbo(:, 5,58, 5) = (/ & + &1.0274e-05_r8,1.0375e-05_r8,8.7754e-06_r8,5.9519e-06_r8,8.1351e-08_r8/) + kbo(:, 1,59, 5) = (/ & + &6.5199e-07_r8,7.1682e-07_r8,6.4285e-07_r8,4.7533e-07_r8,1.3398e-08_r8/) + kbo(:, 2,59, 5) = (/ & + &1.3361e-06_r8,1.4531e-06_r8,1.2913e-06_r8,9.4099e-07_r8,2.2445e-08_r8/) + kbo(:, 3,59, 5) = (/ & + &2.6852e-06_r8,2.8341e-06_r8,2.4717e-06_r8,1.7572e-06_r8,3.4660e-08_r8/) + kbo(:, 4,59, 5) = (/ & + &4.9575e-06_r8,5.1104e-06_r8,4.3915e-06_r8,3.0485e-06_r8,4.9566e-08_r8/) + kbo(:, 5,59, 5) = (/ & + &8.4320e-06_r8,8.5398e-06_r8,7.2464e-06_r8,4.9418e-06_r8,6.8105e-08_r8/) + kbo(:, 1,13, 6) = (/ & + &1.5548e-01_r8,1.2226e-01_r8,8.5068e-02_r8,4.5702e-02_r8,2.0740e-03_r8/) + kbo(:, 2,13, 6) = (/ & + &2.1897e-01_r8,1.7240e-01_r8,1.2003e-01_r8,6.4538e-02_r8,2.5124e-03_r8/) + kbo(:, 3,13, 6) = (/ & + &3.0095e-01_r8,2.3621e-01_r8,1.6479e-01_r8,8.8859e-02_r8,3.0382e-03_r8/) + kbo(:, 4,13, 6) = (/ & + &4.0485e-01_r8,3.1719e-01_r8,2.2079e-01_r8,1.1848e-01_r8,3.6959e-03_r8/) + kbo(:, 5,13, 6) = (/ & + &5.3118e-01_r8,4.1467e-01_r8,2.8796e-01_r8,1.5438e-01_r8,4.3103e-03_r8/) + kbo(:, 1,14, 6) = (/ & + &1.3732e-01_r8,1.0825e-01_r8,7.5397e-02_r8,4.0495e-02_r8,1.7538e-03_r8/) + kbo(:, 2,14, 6) = (/ & + &1.9463e-01_r8,1.5344e-01_r8,1.0670e-01_r8,5.7417e-02_r8,2.1725e-03_r8/) + kbo(:, 3,14, 6) = (/ & + &2.6896e-01_r8,2.1173e-01_r8,1.4739e-01_r8,7.9254e-02_r8,2.6810e-03_r8/) + kbo(:, 4,14, 6) = (/ & + &3.6294e-01_r8,2.8446e-01_r8,1.9761e-01_r8,1.0591e-01_r8,3.1748e-03_r8/) + kbo(:, 5,14, 6) = (/ & + &4.7752e-01_r8,3.7323e-01_r8,2.5905e-01_r8,1.3864e-01_r8,3.7684e-03_r8/) + kbo(:, 1,15, 6) = (/ & + &1.1609e-01_r8,9.1864e-02_r8,6.4056e-02_r8,3.4496e-02_r8,1.4724e-03_r8/) + kbo(:, 2,15, 6) = (/ & + &1.6575e-01_r8,1.3099e-01_r8,9.1234e-02_r8,4.9161e-02_r8,1.8695e-03_r8/) + kbo(:, 3,15, 6) = (/ & + &2.2962e-01_r8,1.8109e-01_r8,1.2603e-01_r8,6.7814e-02_r8,2.2935e-03_r8/) + kbo(:, 4,15, 6) = (/ & + &3.1077e-01_r8,2.4430e-01_r8,1.6934e-01_r8,9.0957e-02_r8,2.7633e-03_r8/) + kbo(:, 5,15, 6) = (/ & + &4.0968e-01_r8,3.2160e-01_r8,2.2302e-01_r8,1.1925e-01_r8,3.2819e-03_r8/) + kbo(:, 1,16, 6) = (/ & + &9.6387e-02_r8,7.6493e-02_r8,5.3335e-02_r8,2.8835e-02_r8,1.2273e-03_r8/) + kbo(:, 2,16, 6) = (/ & + &1.3769e-01_r8,1.0917e-01_r8,7.6074e-02_r8,4.1117e-02_r8,1.5607e-03_r8/) + kbo(:, 3,16, 6) = (/ & + &1.9131e-01_r8,1.5123e-01_r8,1.0523e-01_r8,5.6738e-02_r8,1.9638e-03_r8/) + kbo(:, 4,16, 6) = (/ & + &2.5899e-01_r8,2.0399e-01_r8,1.4165e-01_r8,7.6203e-02_r8,2.3618e-03_r8/) + kbo(:, 5,16, 6) = (/ & + &3.4214e-01_r8,2.6934e-01_r8,1.8675e-01_r8,1.0014e-01_r8,2.8281e-03_r8/) + kbo(:, 1,17, 6) = (/ & + &7.9271e-02_r8,6.3126e-02_r8,4.4100e-02_r8,2.3917e-02_r8,1.0217e-03_r8/) + kbo(:, 2,17, 6) = (/ & + &1.1345e-01_r8,9.0182e-02_r8,6.2977e-02_r8,3.4156e-02_r8,1.3299e-03_r8/) + kbo(:, 3,17, 6) = (/ & + &1.5797e-01_r8,1.2511e-01_r8,8.7087e-02_r8,4.7059e-02_r8,1.6628e-03_r8/) + kbo(:, 4,17, 6) = (/ & + &2.1402e-01_r8,1.6897e-01_r8,1.1752e-01_r8,6.3332e-02_r8,2.0151e-03_r8/) + kbo(:, 5,17, 6) = (/ & + &2.8305e-01_r8,2.2332e-01_r8,1.5502e-01_r8,8.3415e-02_r8,2.4638e-03_r8/) + kbo(:, 1,18, 6) = (/ & + &6.4211e-02_r8,5.1302e-02_r8,3.5902e-02_r8,1.9554e-02_r8,8.7983e-04_r8/) + kbo(:, 2,18, 6) = (/ & + &9.2120e-02_r8,7.3433e-02_r8,5.1355e-02_r8,2.7890e-02_r8,1.1536e-03_r8/) + kbo(:, 3,18, 6) = (/ & + &1.2833e-01_r8,1.0186e-01_r8,7.1081e-02_r8,3.8483e-02_r8,1.4378e-03_r8/) + kbo(:, 4,18, 6) = (/ & + &1.7390e-01_r8,1.3787e-01_r8,9.6012e-02_r8,5.1930e-02_r8,1.7641e-03_r8/) + kbo(:, 5,18, 6) = (/ & + &2.3011e-01_r8,1.8206e-01_r8,1.2668e-01_r8,6.8404e-02_r8,2.1654e-03_r8/) + kbo(:, 1,19, 6) = (/ & + &5.2788e-02_r8,4.2299e-02_r8,2.9673e-02_r8,1.6227e-02_r8,7.6310e-04_r8/) + kbo(:, 2,19, 6) = (/ & + &7.5889e-02_r8,6.0648e-02_r8,4.2457e-02_r8,2.3108e-02_r8,1.0035e-03_r8/) + kbo(:, 3,19, 6) = (/ & + &1.0575e-01_r8,8.4190e-02_r8,5.8852e-02_r8,3.1993e-02_r8,1.2648e-03_r8/) + kbo(:, 4,19, 6) = (/ & + &1.4328e-01_r8,1.1394e-01_r8,7.9533e-02_r8,4.3155e-02_r8,1.5714e-03_r8/) + kbo(:, 5,19, 6) = (/ & + &1.8940e-01_r8,1.5028e-01_r8,1.0488e-01_r8,5.6817e-02_r8,1.9149e-03_r8/) + kbo(:, 1,20, 6) = (/ & + &4.4520e-02_r8,3.5758e-02_r8,2.5128e-02_r8,1.3753e-02_r8,6.6571e-04_r8/) + kbo(:, 2,20, 6) = (/ & + &6.4045e-02_r8,5.1271e-02_r8,3.5901e-02_r8,1.9582e-02_r8,8.7391e-04_r8/) + kbo(:, 3,20, 6) = (/ & + &8.9082e-02_r8,7.1164e-02_r8,4.9821e-02_r8,2.7122e-02_r8,1.1092e-03_r8/) + kbo(:, 4,20, 6) = (/ & + &1.2061e-01_r8,9.6051e-02_r8,6.7127e-02_r8,3.6518e-02_r8,1.3635e-03_r8/) + kbo(:, 5,20, 6) = (/ & + &1.5922e-01_r8,1.2658e-01_r8,8.8405e-02_r8,4.7977e-02_r8,1.6664e-03_r8/) + kbo(:, 1,21, 6) = (/ & + &3.7777e-02_r8,3.0383e-02_r8,2.1331e-02_r8,1.1694e-02_r8,5.7845e-04_r8/) + kbo(:, 2,21, 6) = (/ & + &5.4331e-02_r8,4.3484e-02_r8,3.0481e-02_r8,1.6684e-02_r8,7.5762e-04_r8/) + kbo(:, 3,21, 6) = (/ & + &7.5428e-02_r8,6.0294e-02_r8,4.2245e-02_r8,2.3058e-02_r8,9.5396e-04_r8/) + kbo(:, 4,21, 6) = (/ & + &1.0181e-01_r8,8.1193e-02_r8,5.6844e-02_r8,3.0978e-02_r8,1.1796e-03_r8/) + kbo(:, 5,21, 6) = (/ & + &1.3419e-01_r8,1.0693e-01_r8,7.4825e-02_r8,4.0693e-02_r8,1.4376e-03_r8/) + kbo(:, 1,22, 6) = (/ & + &3.2832e-02_r8,2.6387e-02_r8,1.8543e-02_r8,1.0190e-02_r8,5.0764e-04_r8/) + kbo(:, 2,22, 6) = (/ & + &4.6987e-02_r8,3.7684e-02_r8,2.6458e-02_r8,1.4480e-02_r8,6.6076e-04_r8/) + kbo(:, 3,22, 6) = (/ & + &6.5046e-02_r8,5.2018e-02_r8,3.6448e-02_r8,1.9932e-02_r8,8.2689e-04_r8/) + kbo(:, 4,22, 6) = (/ & + &8.7447e-02_r8,6.9814e-02_r8,4.8898e-02_r8,2.6679e-02_r8,1.0180e-03_r8/) + kbo(:, 5,22, 6) = (/ & + &1.1504e-01_r8,9.1878e-02_r8,6.4286e-02_r8,3.4972e-02_r8,1.2412e-03_r8/) + kbo(:, 1,23, 6) = (/ & + &2.8625e-02_r8,2.3013e-02_r8,1.6180e-02_r8,8.8954e-03_r8,4.4551e-04_r8/) + kbo(:, 2,23, 6) = (/ & + &4.0740e-02_r8,3.2715e-02_r8,2.2979e-02_r8,1.2589e-02_r8,5.7081e-04_r8/) + kbo(:, 3,23, 6) = (/ & + &5.6140e-02_r8,4.4931e-02_r8,3.1539e-02_r8,1.7244e-02_r8,7.1483e-04_r8/) + kbo(:, 4,23, 6) = (/ & + &7.5282e-02_r8,6.0221e-02_r8,4.2218e-02_r8,2.3054e-02_r8,8.7570e-04_r8/) + kbo(:, 5,23, 6) = (/ & + &9.9200e-02_r8,7.9197e-02_r8,5.5422e-02_r8,3.0138e-02_r8,1.0690e-03_r8/) + kbo(:, 1,24, 6) = (/ & + &2.5225e-02_r8,2.0294e-02_r8,1.4276e-02_r8,7.8427e-03_r8,3.8602e-04_r8/) + kbo(:, 2,24, 6) = (/ & + &3.5712e-02_r8,2.8695e-02_r8,2.0149e-02_r8,1.1049e-02_r8,4.9372e-04_r8/) + kbo(:, 3,24, 6) = (/ & + &4.9060e-02_r8,3.9310e-02_r8,2.7586e-02_r8,1.5091e-02_r8,6.1539e-04_r8/) + kbo(:, 4,24, 6) = (/ & + &6.5785e-02_r8,5.2643e-02_r8,3.6889e-02_r8,2.0124e-02_r8,7.5365e-04_r8/) + kbo(:, 5,24, 6) = (/ & + &8.6520e-02_r8,6.9119e-02_r8,4.8335e-02_r8,2.6295e-02_r8,9.2000e-04_r8/) + kbo(:, 1,25, 6) = (/ & + &2.2344e-02_r8,1.7976e-02_r8,1.2645e-02_r8,6.9412e-03_r8,3.3195e-04_r8/) + kbo(:, 2,25, 6) = (/ & + &3.1531e-02_r8,2.5281e-02_r8,1.7784e-02_r8,9.7415e-03_r8,4.2393e-04_r8/) + kbo(:, 3,25, 6) = (/ & + &4.3153e-02_r8,3.4621e-02_r8,2.4312e-02_r8,1.3288e-02_r8,5.2565e-04_r8/) + kbo(:, 4,25, 6) = (/ & + &5.7875e-02_r8,4.6285e-02_r8,3.2426e-02_r8,1.7676e-02_r8,6.4832e-04_r8/) + kbo(:, 5,25, 6) = (/ & + &7.6134e-02_r8,6.0793e-02_r8,4.2524e-02_r8,2.3109e-02_r8,7.8380e-04_r8/) + kbo(:, 1,26, 6) = (/ & + &1.9994e-02_r8,1.6102e-02_r8,1.1323e-02_r8,6.2216e-03_r8,2.8629e-04_r8/) + kbo(:, 2,26, 6) = (/ & + &2.8079e-02_r8,2.2581e-02_r8,1.5869e-02_r8,8.6875e-03_r8,3.6314e-04_r8/) + kbo(:, 3,26, 6) = (/ & + &3.8417e-02_r8,3.0834e-02_r8,2.1637e-02_r8,1.1805e-02_r8,4.5229e-04_r8/) + kbo(:, 4,26, 6) = (/ & + &5.1448e-02_r8,4.1174e-02_r8,2.8844e-02_r8,1.5712e-02_r8,5.5890e-04_r8/) + kbo(:, 5,26, 6) = (/ & + &6.7708e-02_r8,5.4151e-02_r8,3.7876e-02_r8,2.0559e-02_r8,6.6983e-04_r8/) + kbo(:, 1,27, 6) = (/ & + &1.7896e-02_r8,1.4429e-02_r8,1.0152e-02_r8,5.5772e-03_r8,2.4427e-04_r8/) + kbo(:, 2,27, 6) = (/ & + &2.5042e-02_r8,2.0157e-02_r8,1.4173e-02_r8,7.7571e-03_r8,3.0979e-04_r8/) + kbo(:, 3,27, 6) = (/ & + &3.4208e-02_r8,2.7475e-02_r8,1.9284e-02_r8,1.0527e-02_r8,3.8671e-04_r8/) + kbo(:, 4,27, 6) = (/ & + &4.5837e-02_r8,3.6717e-02_r8,2.5729e-02_r8,1.4005e-02_r8,4.7399e-04_r8/) + kbo(:, 5,27, 6) = (/ & + &6.0284e-02_r8,4.8205e-02_r8,3.3722e-02_r8,1.8275e-02_r8,5.6657e-04_r8/) + kbo(:, 1,28, 6) = (/ & + &1.6009e-02_r8,1.2912e-02_r8,9.0950e-03_r8,4.9907e-03_r8,2.0749e-04_r8/) + kbo(:, 2,28, 6) = (/ & + &2.2344e-02_r8,1.7993e-02_r8,1.2646e-02_r8,6.9273e-03_r8,2.6196e-04_r8/) + kbo(:, 3,28, 6) = (/ & + &3.0516e-02_r8,2.4521e-02_r8,1.7216e-02_r8,9.3897e-03_r8,3.2594e-04_r8/) + kbo(:, 4,28, 6) = (/ & + &4.0856e-02_r8,3.2755e-02_r8,2.2958e-02_r8,1.2475e-02_r8,3.9748e-04_r8/) + kbo(:, 5,28, 6) = (/ & + &5.3627e-02_r8,4.2900e-02_r8,3.0014e-02_r8,1.6247e-02_r8,4.7387e-04_r8/) + kbo(:, 1,29, 6) = (/ & + &1.4262e-02_r8,1.1522e-02_r8,8.1115e-03_r8,4.4530e-03_r8,1.7407e-04_r8/) + kbo(:, 2,29, 6) = (/ & + &1.9887e-02_r8,1.6027e-02_r8,1.1276e-02_r8,6.1687e-03_r8,2.1854e-04_r8/) + kbo(:, 3,29, 6) = (/ & + &2.7141e-02_r8,2.1827e-02_r8,1.5323e-02_r8,8.3518e-03_r8,2.7116e-04_r8/) + kbo(:, 4,29, 6) = (/ & + &3.6246e-02_r8,2.9092e-02_r8,2.0386e-02_r8,1.1064e-02_r8,3.2874e-04_r8/) + kbo(:, 5,29, 6) = (/ & + &4.7427e-02_r8,3.8019e-02_r8,2.6585e-02_r8,1.4385e-02_r8,3.8972e-04_r8/) + kbo(:, 1,30, 6) = (/ & + &1.2676e-02_r8,1.0246e-02_r8,7.2173e-03_r8,3.9637e-03_r8,1.4416e-04_r8/) + kbo(:, 2,30, 6) = (/ & + &1.7653e-02_r8,1.4244e-02_r8,1.0017e-02_r8,5.4770e-03_r8,1.8113e-04_r8/) + kbo(:, 3,30, 6) = (/ & + &2.4022e-02_r8,1.9341e-02_r8,1.3583e-02_r8,7.3998e-03_r8,2.2282e-04_r8/) + kbo(:, 4,30, 6) = (/ & + &3.1996e-02_r8,2.5721e-02_r8,1.8027e-02_r8,9.7785e-03_r8,2.6784e-04_r8/) + kbo(:, 5,30, 6) = (/ & + &4.1773e-02_r8,3.3512e-02_r8,2.3450e-02_r8,1.2688e-02_r8,3.1737e-04_r8/) + kbo(:, 1,31, 6) = (/ & + &1.1178e-02_r8,9.0514e-03_r8,6.3801e-03_r8,3.5048e-03_r8,1.1770e-04_r8/) + kbo(:, 2,31, 6) = (/ & + &1.5523e-02_r8,1.2547e-02_r8,8.8303e-03_r8,4.8276e-03_r8,1.4724e-04_r8/) + kbo(:, 3,31, 6) = (/ & + &2.1060e-02_r8,1.6992e-02_r8,1.1943e-02_r8,6.5025e-03_r8,1.7875e-04_r8/) + kbo(:, 4,31, 6) = (/ & + &2.7976e-02_r8,2.2531e-02_r8,1.5799e-02_r8,8.5667e-03_r8,2.1450e-04_r8/) + kbo(:, 5,31, 6) = (/ & + &3.6405e-02_r8,2.9271e-02_r8,2.0490e-02_r8,1.1088e-02_r8,2.5503e-04_r8/) + kbo(:, 1,32, 6) = (/ & + &9.9013e-03_r8,8.0343e-03_r8,5.6674e-03_r8,3.1129e-03_r8,9.6361e-05_r8/) + kbo(:, 2,32, 6) = (/ & + &1.3706e-02_r8,1.1101e-02_r8,7.8125e-03_r8,4.2746e-03_r8,1.1902e-04_r8/) + kbo(:, 3,32, 6) = (/ & + &1.8546e-02_r8,1.4995e-02_r8,1.0536e-02_r8,5.7328e-03_r8,1.4373e-04_r8/) + kbo(:, 4,32, 6) = (/ & + &2.4550e-02_r8,1.9811e-02_r8,1.3886e-02_r8,7.5313e-03_r8,1.7332e-04_r8/) + kbo(:, 5,32, 6) = (/ & + &3.1853e-02_r8,2.5667e-02_r8,1.7969e-02_r8,9.7246e-03_r8,2.0625e-04_r8/) + kbo(:, 1,33, 6) = (/ & + &8.7980e-03_r8,7.1519e-03_r8,5.0451e-03_r8,2.7712e-03_r8,7.8202e-05_r8/) + kbo(:, 2,33, 6) = (/ & + &1.2135e-02_r8,9.8435e-03_r8,6.9325e-03_r8,3.7902e-03_r8,9.6250e-05_r8/) + kbo(:, 3,33, 6) = (/ & + &1.6367e-02_r8,1.3251e-02_r8,9.3075e-03_r8,5.0637e-03_r8,1.1723e-04_r8/) + kbo(:, 4,33, 6) = (/ & + &2.1594e-02_r8,1.7451e-02_r8,1.2238e-02_r8,6.6390e-03_r8,1.4129e-04_r8/) + kbo(:, 5,33, 6) = (/ & + &2.7922e-02_r8,2.2553e-02_r8,1.5798e-02_r8,8.5480e-03_r8,1.6598e-04_r8/) + kbo(:, 1,34, 6) = (/ & + &7.8297e-03_r8,6.3727e-03_r8,4.4952e-03_r8,2.4671e-03_r8,6.3879e-05_r8/) + kbo(:, 2,34, 6) = (/ & + &1.0770e-02_r8,8.7510e-03_r8,6.1616e-03_r8,3.3644e-03_r8,7.9137e-05_r8/) + kbo(:, 3,34, 6) = (/ & + &1.4484e-02_r8,1.1741e-02_r8,8.2482e-03_r8,4.4844e-03_r8,9.6600e-05_r8/) + kbo(:, 4,34, 6) = (/ & + &1.9050e-02_r8,1.5427e-02_r8,1.0820e-02_r8,5.8678e-03_r8,1.1495e-04_r8/) + kbo(:, 5,34, 6) = (/ & + &2.4524e-02_r8,1.9867e-02_r8,1.3919e-02_r8,7.5292e-03_r8,1.3453e-04_r8/) + kbo(:, 1,35, 6) = (/ & + &6.7630e-03_r8,5.5126e-03_r8,3.8884e-03_r8,2.1340e-03_r8,5.1721e-05_r8/) + kbo(:, 2,35, 6) = (/ & + &9.2985e-03_r8,7.5662e-03_r8,5.3252e-03_r8,2.9070e-03_r8,6.4032e-05_r8/) + kbo(:, 3,35, 6) = (/ & + &1.2489e-02_r8,1.0141e-02_r8,7.1246e-03_r8,3.8749e-03_r8,7.6974e-05_r8/) + kbo(:, 4,35, 6) = (/ & + &1.6400e-02_r8,1.3312e-02_r8,9.3389e-03_r8,5.0659e-03_r8,9.1148e-05_r8/) + kbo(:, 5,35, 6) = (/ & + &2.1049e-02_r8,1.7098e-02_r8,1.1985e-02_r8,6.4857e-03_r8,1.0683e-04_r8/) + kbo(:, 1,36, 6) = (/ & + &5.6496e-03_r8,4.6119e-03_r8,3.2530e-03_r8,1.7852e-03_r8,4.0312e-05_r8/) + kbo(:, 2,36, 6) = (/ & + &7.7767e-03_r8,6.3372e-03_r8,4.4630e-03_r8,2.4380e-03_r8,4.9929e-05_r8/) + kbo(:, 3,36, 6) = (/ & + &1.0461e-02_r8,8.5144e-03_r8,5.9836e-03_r8,3.2549e-03_r8,6.0118e-05_r8/) + kbo(:, 4,36, 6) = (/ & + &1.3740e-02_r8,1.1182e-02_r8,7.8492e-03_r8,4.2598e-03_r8,7.1064e-05_r8/) + kbo(:, 5,36, 6) = (/ & + &1.7612e-02_r8,1.4350e-02_r8,1.0064e-02_r8,5.4485e-03_r8,8.3577e-05_r8/) + kbo(:, 1,37, 6) = (/ & + &4.5423e-03_r8,3.7134e-03_r8,2.6216e-03_r8,1.4392e-03_r8,3.1256e-05_r8/) + kbo(:, 2,37, 6) = (/ & + &6.2879e-03_r8,5.1321e-03_r8,3.6149e-03_r8,1.9739e-03_r8,3.8734e-05_r8/) + kbo(:, 3,37, 6) = (/ & + &8.4900e-03_r8,6.9227e-03_r8,4.8667e-03_r8,2.6482e-03_r8,4.6682e-05_r8/) + kbo(:, 4,37, 6) = (/ & + &1.1183e-02_r8,9.1172e-03_r8,6.4017e-03_r8,3.4761e-03_r8,5.5592e-05_r8/) + kbo(:, 5,37, 6) = (/ & + &1.4352e-02_r8,1.1719e-02_r8,8.2209e-03_r8,4.4549e-03_r8,6.5503e-05_r8/) + kbo(:, 1,38, 6) = (/ & + &3.6392e-03_r8,2.9801e-03_r8,2.1050e-03_r8,1.1562e-03_r8,2.4090e-05_r8/) + kbo(:, 2,38, 6) = (/ & + &5.0658e-03_r8,4.1416e-03_r8,2.9194e-03_r8,1.5946e-03_r8,2.9868e-05_r8/) + kbo(:, 3,38, 6) = (/ & + &6.8711e-03_r8,5.6107e-03_r8,3.9454e-03_r8,2.1481e-03_r8,3.6072e-05_r8/) + kbo(:, 4,38, 6) = (/ & + &9.0731e-03_r8,7.4127e-03_r8,5.2066e-03_r8,2.8281e-03_r8,4.3140e-05_r8/) + kbo(:, 5,38, 6) = (/ & + &1.1663e-02_r8,9.5418e-03_r8,6.6954e-03_r8,3.6310e-03_r8,5.1139e-05_r8/) + kbo(:, 1,39, 6) = (/ & + &2.9118e-03_r8,2.3886e-03_r8,1.6882e-03_r8,9.2755e-04_r8,1.8391e-05_r8/) + kbo(:, 2,39, 6) = (/ & + &4.0750e-03_r8,3.3381e-03_r8,2.3540e-03_r8,1.2863e-03_r8,2.2806e-05_r8/) + kbo(:, 3,39, 6) = (/ & + &5.5513e-03_r8,4.5420e-03_r8,3.1948e-03_r8,1.7397e-03_r8,2.7682e-05_r8/) + kbo(:, 4,39, 6) = (/ & + &7.3492e-03_r8,6.0179e-03_r8,4.2285e-03_r8,2.2979e-03_r8,3.3352e-05_r8/) + kbo(:, 5,39, 6) = (/ & + &9.4667e-03_r8,7.7616e-03_r8,5.4485e-03_r8,2.9560e-03_r8,3.9651e-05_r8/) + kbo(:, 1,40, 6) = (/ & + &2.2712e-03_r8,1.8658e-03_r8,1.3192e-03_r8,7.2479e-04_r8,1.3995e-05_r8/) + kbo(:, 2,40, 6) = (/ & + &3.2040e-03_r8,2.6288e-03_r8,1.8549e-03_r8,1.0140e-03_r8,1.7455e-05_r8/) + kbo(:, 3,40, 6) = (/ & + &4.3985e-03_r8,3.6050e-03_r8,2.5372e-03_r8,1.3813e-03_r8,2.1295e-05_r8/) + kbo(:, 4,40, 6) = (/ & + &5.8565e-03_r8,4.8013e-03_r8,3.3753e-03_r8,1.8342e-03_r8,2.5756e-05_r8/) + kbo(:, 5,40, 6) = (/ & + &7.5776e-03_r8,6.2219e-03_r8,4.3685e-03_r8,2.3699e-03_r8,3.0715e-05_r8/) + kbo(:, 1,41, 6) = (/ & + &1.7612e-03_r8,1.4492e-03_r8,1.0250e-03_r8,5.6325e-04_r8,1.0604e-05_r8/) + kbo(:, 2,41, 6) = (/ & + &2.5080e-03_r8,2.0608e-03_r8,1.4546e-03_r8,7.9552e-04_r8,1.3310e-05_r8/) + kbo(:, 3,41, 6) = (/ & + &3.4681e-03_r8,2.8477e-03_r8,2.0051e-03_r8,1.0923e-03_r8,1.6349e-05_r8/) + kbo(:, 4,41, 6) = (/ & + &4.6501e-03_r8,3.8188e-03_r8,2.6845e-03_r8,1.4588e-03_r8,1.9855e-05_r8/) + kbo(:, 5,41, 6) = (/ & + &6.0491e-03_r8,4.9741e-03_r8,3.4944e-03_r8,1.8953e-03_r8,2.3793e-05_r8/) + kbo(:, 1,42, 6) = (/ & + &1.3619e-03_r8,1.1225e-03_r8,7.9390e-04_r8,4.3654e-04_r8,7.9892e-06_r8/) + kbo(:, 2,42, 6) = (/ & + &1.9585e-03_r8,1.6109e-03_r8,1.1375e-03_r8,6.2244e-04_r8,1.0111e-05_r8/) + kbo(:, 3,42, 6) = (/ & + &2.7289e-03_r8,2.2437e-03_r8,1.5805e-03_r8,8.6127e-04_r8,1.2500e-05_r8/) + kbo(:, 4,42, 6) = (/ & + &3.6852e-03_r8,3.0311e-03_r8,2.1316e-03_r8,1.1583e-03_r8,1.5248e-05_r8/) + kbo(:, 5,42, 6) = (/ & + &4.8235e-03_r8,3.9702e-03_r8,2.7892e-03_r8,1.5134e-03_r8,1.8350e-05_r8/) + kbo(:, 1,43, 6) = (/ & + &1.0392e-03_r8,8.5695e-04_r8,6.0598e-04_r8,3.3332e-04_r8,5.9552e-06_r8/) + kbo(:, 2,43, 6) = (/ & + &1.5101e-03_r8,1.2436e-03_r8,8.7832e-04_r8,4.8071e-04_r8,7.5961e-06_r8/) + kbo(:, 3,43, 6) = (/ & + &2.1254e-03_r8,1.7498e-03_r8,1.2325e-03_r8,6.7181e-04_r8,9.4477e-06_r8/) + kbo(:, 4,43, 6) = (/ & + &2.8974e-03_r8,2.3860e-03_r8,1.6788e-03_r8,9.1195e-04_r8,1.1585e-05_r8/) + kbo(:, 5,43, 6) = (/ & + &3.8244e-03_r8,3.1517e-03_r8,2.2140e-03_r8,1.2005e-03_r8,1.4013e-05_r8/) + kbo(:, 1,44, 6) = (/ & + &7.8683e-04_r8,6.4875e-04_r8,4.5878e-04_r8,2.5223e-04_r8,4.3968e-06_r8/) + kbo(:, 2,44, 6) = (/ & + &1.1559e-03_r8,9.5305e-04_r8,6.7277e-04_r8,3.6830e-04_r8,5.6394e-06_r8/) + kbo(:, 3,44, 6) = (/ & + &1.6454e-03_r8,1.3558e-03_r8,9.5534e-04_r8,5.2055e-04_r8,7.0859e-06_r8/) + kbo(:, 4,44, 6) = (/ & + &2.2669e-03_r8,1.8686e-03_r8,1.3148e-03_r8,7.1399e-04_r8,8.7462e-06_r8/) + kbo(:, 5,44, 6) = (/ & + &3.0201e-03_r8,2.4917e-03_r8,1.7509e-03_r8,9.4904e-04_r8,1.0639e-05_r8/) + kbo(:, 1,45, 6) = (/ & + &5.9365e-04_r8,4.8959e-04_r8,3.4607e-04_r8,1.9020e-04_r8,3.2229e-06_r8/) + kbo(:, 2,45, 6) = (/ & + &8.8218e-04_r8,7.2803e-04_r8,5.1390e-04_r8,2.8115e-04_r8,4.1709e-06_r8/) + kbo(:, 3,45, 6) = (/ & + &1.2705e-03_r8,1.0482e-03_r8,7.3838e-04_r8,4.0225e-04_r8,5.2818e-06_r8/) + kbo(:, 4,45, 6) = (/ & + &1.7692e-03_r8,1.4597e-03_r8,1.0269e-03_r8,5.5768e-04_r8,6.5567e-06_r8/) + kbo(:, 5,45, 6) = (/ & + &2.3806e-03_r8,1.9657e-03_r8,1.3812e-03_r8,7.4841e-04_r8,8.0347e-06_r8/) + kbo(:, 1,46, 6) = (/ & + &4.4335e-04_r8,3.6560e-04_r8,2.5820e-04_r8,1.4186e-04_r8,2.3394e-06_r8/) + kbo(:, 2,46, 6) = (/ & + &6.6652e-04_r8,5.5048e-04_r8,3.8857e-04_r8,2.1254e-04_r8,3.0543e-06_r8/) + kbo(:, 3,46, 6) = (/ & + &9.7139e-04_r8,8.0233e-04_r8,5.6521e-04_r8,3.0796e-04_r8,3.9016e-06_r8/) + kbo(:, 4,46, 6) = (/ & + &1.3697e-03_r8,1.1313e-03_r8,7.9539e-04_r8,4.3177e-04_r8,4.8930e-06_r8/) + kbo(:, 5,46, 6) = (/ & + &1.8630e-03_r8,1.5401e-03_r8,1.0822e-03_r8,5.8603e-04_r8,6.0211e-06_r8/) + kbo(:, 1,47, 6) = (/ & + &3.2494e-04_r8,2.6781e-04_r8,1.8906e-04_r8,1.0379e-04_r8,1.6703e-06_r8/) + kbo(:, 2,47, 6) = (/ & + &4.9477e-04_r8,4.0876e-04_r8,2.8822e-04_r8,1.5780e-04_r8,2.2235e-06_r8/) + kbo(:, 3,47, 6) = (/ & + &7.3190e-04_r8,6.0441e-04_r8,4.2581e-04_r8,2.3196e-04_r8,2.8600e-06_r8/) + kbo(:, 4,47, 6) = (/ & + &1.0450e-03_r8,8.6362e-04_r8,6.0711e-04_r8,3.2954e-04_r8,3.6203e-06_r8/) + kbo(:, 5,47, 6) = (/ & + &1.4403e-03_r8,1.1920e-03_r8,8.3715e-04_r8,4.5311e-04_r8,4.4864e-06_r8/) + kbo(:, 1,48, 6) = (/ & + &2.3680e-04_r8,1.9527e-04_r8,1.3764e-04_r8,7.5497e-05_r8,1.1789e-06_r8/) + kbo(:, 2,48, 6) = (/ & + &3.6634e-04_r8,3.0233e-04_r8,2.1313e-04_r8,1.1661e-04_r8,1.5963e-06_r8/) + kbo(:, 3,48, 6) = (/ & + &5.4895e-04_r8,4.5372e-04_r8,3.1944e-04_r8,1.7402e-04_r8,2.0888e-06_r8/) + kbo(:, 4,48, 6) = (/ & + &7.9543e-04_r8,6.5717e-04_r8,4.6181e-04_r8,2.5062e-04_r8,2.6621e-06_r8/) + kbo(:, 5,48, 6) = (/ & + &1.1099e-03_r8,9.1890e-04_r8,6.4520e-04_r8,3.4917e-04_r8,3.3226e-06_r8/) + kbo(:, 1,49, 6) = (/ & + &1.7167e-04_r8,1.4156e-04_r8,9.9697e-05_r8,5.4621e-05_r8,8.2177e-07_r8/) + kbo(:, 2,49, 6) = (/ & + &2.6978e-04_r8,2.2270e-04_r8,1.5688e-04_r8,8.5772e-05_r8,1.1335e-06_r8/) + kbo(:, 3,49, 6) = (/ & + &4.1033e-04_r8,3.3911e-04_r8,2.3859e-04_r8,1.2993e-04_r8,1.5022e-06_r8/) + kbo(:, 4,49, 6) = (/ & + &6.0289e-04_r8,4.9870e-04_r8,3.5040e-04_r8,1.9001e-04_r8,1.9421e-06_r8/) + kbo(:, 5,49, 6) = (/ & + &8.5268e-04_r8,7.0612e-04_r8,4.9559e-04_r8,2.6808e-04_r8,2.4464e-06_r8/) + kbo(:, 1,50, 6) = (/ & + &1.2531e-04_r8,1.0333e-04_r8,7.2754e-05_r8,3.9781e-05_r8,5.8260e-07_r8/) + kbo(:, 2,50, 6) = (/ & + &2.0028e-04_r8,1.6520e-04_r8,1.1625e-04_r8,6.3517e-05_r8,8.1312e-07_r8/) + kbo(:, 3,50, 6) = (/ & + &3.0881e-04_r8,2.5524e-04_r8,1.7955e-04_r8,9.7765e-05_r8,1.0963e-06_r8/) + kbo(:, 4,50, 6) = (/ & + &4.6015e-04_r8,3.8061e-04_r8,2.6731e-04_r8,1.4488e-04_r8,1.4340e-06_r8/) + kbo(:, 5,50, 6) = (/ & + &6.5988e-04_r8,5.4636e-04_r8,3.8320e-04_r8,2.0709e-04_r8,1.8202e-06_r8/) + kbo(:, 1,51, 6) = (/ & + &9.1633e-05_r8,7.5509e-05_r8,5.3128e-05_r8,2.9020e-05_r8,4.1464e-07_r8/) + kbo(:, 2,51, 6) = (/ & + &1.4891e-04_r8,1.2270e-04_r8,8.6279e-05_r8,4.7099e-05_r8,5.8807e-07_r8/) + kbo(:, 3,51, 6) = (/ & + &2.3292e-04_r8,1.9249e-04_r8,1.3529e-04_r8,7.3646e-05_r8,8.0371e-07_r8/) + kbo(:, 4,51, 6) = (/ & + &3.5233e-04_r8,2.9123e-04_r8,2.0433e-04_r8,1.1072e-04_r8,1.0615e-06_r8/) + kbo(:, 5,51, 6) = (/ & + &5.1166e-04_r8,4.2368e-04_r8,2.9697e-04_r8,1.6038e-04_r8,1.3623e-06_r8/) + kbo(:, 1,52, 6) = (/ & + &6.6748e-05_r8,5.4951e-05_r8,3.8637e-05_r8,2.1072e-05_r8,2.9423e-07_r8/) + kbo(:, 2,52, 6) = (/ & + &1.1034e-04_r8,9.0898e-05_r8,6.3804e-05_r8,3.4773e-05_r8,4.2185e-07_r8/) + kbo(:, 3,52, 6) = (/ & + &1.7525e-04_r8,1.4472e-04_r8,1.0161e-04_r8,5.5277e-05_r8,5.8386e-07_r8/) + kbo(:, 4,52, 6) = (/ & + &2.6896e-04_r8,2.2246e-04_r8,1.5598e-04_r8,8.4497e-05_r8,7.8029e-07_r8/) + kbo(:, 5,52, 6) = (/ & + &3.9638e-04_r8,3.2814e-04_r8,2.2978e-04_r8,1.2397e-04_r8,1.0114e-06_r8/) + kbo(:, 1,53, 6) = (/ & + &4.8387e-05_r8,3.9789e-05_r8,2.7956e-05_r8,1.5224e-05_r8,2.0710e-07_r8/) + kbo(:, 2,53, 6) = (/ & + &8.1422e-05_r8,6.7055e-05_r8,4.7034e-05_r8,2.5569e-05_r8,3.0032e-07_r8/) + kbo(:, 3,53, 6) = (/ & + &1.3143e-04_r8,1.0846e-04_r8,7.6092e-05_r8,4.1325e-05_r8,4.2132e-07_r8/) + kbo(:, 4,53, 6) = (/ & + &2.0478e-04_r8,1.6937e-04_r8,1.1872e-04_r8,6.4236e-05_r8,5.6954e-07_r8/) + kbo(:, 5,53, 6) = (/ & + &3.0662e-04_r8,2.5374e-04_r8,1.7755e-04_r8,9.5705e-05_r8,7.4673e-07_r8/) + kbo(:, 1,54, 6) = (/ & + &3.5548e-05_r8,2.9201e-05_r8,2.0499e-05_r8,1.1142e-05_r8,1.4888e-07_r8/) + kbo(:, 2,54, 6) = (/ & + &6.0867e-05_r8,5.0080e-05_r8,3.5102e-05_r8,1.9053e-05_r8,2.1957e-07_r8/) + kbo(:, 3,54, 6) = (/ & + &9.9905e-05_r8,8.2294e-05_r8,5.7679e-05_r8,3.1278e-05_r8,3.1167e-07_r8/) + kbo(:, 4,54, 6) = (/ & + &1.5784e-04_r8,1.3048e-04_r8,9.1376e-05_r8,4.9396e-05_r8,4.2569e-07_r8/) + kbo(:, 5,54, 6) = (/ & + &2.3990e-04_r8,1.9844e-04_r8,1.3879e-04_r8,7.4726e-05_r8,5.6432e-07_r8/) + kbo(:, 1,55, 6) = (/ & + &2.6254e-05_r8,2.1551e-05_r8,1.5109e-05_r8,8.2013e-06_r8,1.0776e-07_r8/) + kbo(:, 2,55, 6) = (/ & + &4.5756e-05_r8,3.7594e-05_r8,2.6330e-05_r8,1.4266e-05_r8,1.6227e-07_r8/) + kbo(:, 3,55, 6) = (/ & + &7.6387e-05_r8,6.2840e-05_r8,4.3983e-05_r8,2.3813e-05_r8,2.3322e-07_r8/) + kbo(:, 4,55, 6) = (/ & + &1.2233e-04_r8,1.0105e-04_r8,7.0729e-05_r8,3.8184e-05_r8,3.2242e-07_r8/) + kbo(:, 5,55, 6) = (/ & + &1.8866e-04_r8,1.5604e-04_r8,1.0907e-04_r8,5.8660e-05_r8,4.3190e-07_r8/) + kbo(:, 1,56, 6) = (/ & + &1.9352e-05_r8,1.5886e-05_r8,1.1124e-05_r8,6.0284e-06_r8,7.7832e-08_r8/) + kbo(:, 2,56, 6) = (/ & + &3.4378e-05_r8,2.8197e-05_r8,1.9721e-05_r8,1.0667e-05_r8,1.1948e-07_r8/) + kbo(:, 3,56, 6) = (/ & + &5.8349e-05_r8,4.7950e-05_r8,3.3520e-05_r8,1.8111e-05_r8,1.7363e-07_r8/) + kbo(:, 4,56, 6) = (/ & + &9.4866e-05_r8,7.8290e-05_r8,5.4723e-05_r8,2.9510e-05_r8,2.4385e-07_r8/) + kbo(:, 5,56, 6) = (/ & + &1.4839e-04_r8,1.2273e-04_r8,8.5680e-05_r8,4.6045e-05_r8,3.3022e-07_r8/) + kbo(:, 1,57, 6) = (/ & + &1.4255e-05_r8,1.1680e-05_r8,8.1776e-06_r8,4.4235e-06_r8,5.5927e-08_r8/) + kbo(:, 2,57, 6) = (/ & + &2.5815e-05_r8,2.1132e-05_r8,1.4763e-05_r8,7.9663e-06_r8,8.7522e-08_r8/) + kbo(:, 3,57, 6) = (/ & + &4.4552e-05_r8,3.6579e-05_r8,2.5531e-05_r8,1.3761e-05_r8,1.2925e-07_r8/) + kbo(:, 4,57, 6) = (/ & + &7.3589e-05_r8,6.0640e-05_r8,4.2341e-05_r8,2.2797e-05_r8,1.8364e-07_r8/) + kbo(:, 5,57, 6) = (/ & + &1.1687e-04_r8,9.6565e-05_r8,6.7349e-05_r8,3.6145e-05_r8,2.5190e-07_r8/) + kbo(:, 1,58, 6) = (/ & + &5.1283e-06_r8,4.8164e-06_r8,3.9533e-06_r8,2.5844e-06_r8,4.0411e-08_r8/) + kbo(:, 2,58, 6) = (/ & + &9.4663e-06_r8,8.8829e-06_r8,7.2756e-06_r8,4.7397e-06_r8,6.4616e-08_r8/) + kbo(:, 3,58, 6) = (/ & + &1.6608e-05_r8,1.5628e-05_r8,1.2791e-05_r8,8.3232e-06_r8,9.6916e-08_r8/) + kbo(:, 4,58, 6) = (/ & + &2.7869e-05_r8,2.6331e-05_r8,2.1549e-05_r8,1.4010e-05_r8,1.3884e-07_r8/) + kbo(:, 5,58, 6) = (/ & + &4.4916e-05_r8,4.2582e-05_r8,3.4830e-05_r8,2.2586e-05_r8,1.9305e-07_r8/) + kbo(:, 1,59, 6) = (/ & + &4.1166e-06_r8,3.8763e-06_r8,3.1932e-06_r8,2.0984e-06_r8,3.3138e-08_r8/) + kbo(:, 2,59, 6) = (/ & + &7.6679e-06_r8,7.2183e-06_r8,5.9356e-06_r8,3.8849e-06_r8,5.3542e-08_r8/) + kbo(:, 3,59, 6) = (/ & + &1.3578e-05_r8,1.2809e-05_r8,1.0527e-05_r8,6.8844e-06_r8,8.1037e-08_r8/) + kbo(:, 4,59, 6) = (/ & + &2.2972e-05_r8,2.1775e-05_r8,1.7891e-05_r8,1.1690e-05_r8,1.1735e-07_r8/) + kbo(:, 5,59, 6) = (/ & + &3.7296e-05_r8,3.5490e-05_r8,2.9150e-05_r8,1.9007e-05_r8,1.6270e-07_r8/) + kbo(:, 1,13, 7) = (/ & + &4.2167e-01_r8,3.2553e-01_r8,2.2695e-01_r8,1.2184e-01_r8,4.0030e-03_r8/) + kbo(:, 2,13, 7) = (/ & + &6.0140e-01_r8,4.6380e-01_r8,3.2184e-01_r8,1.7190e-01_r8,5.1104e-03_r8/) + kbo(:, 3,13, 7) = (/ & + &8.1816e-01_r8,6.3015e-01_r8,4.3650e-01_r8,2.3296e-01_r8,6.4365e-03_r8/) + kbo(:, 4,13, 7) = (/ & + &1.0780e+00_r8,8.2908e-01_r8,5.7271e-01_r8,3.0519e-01_r8,7.8514e-03_r8/) + kbo(:, 5,13, 7) = (/ & + &1.3871e+00_r8,1.0650e+00_r8,7.3566e-01_r8,3.9202e-01_r8,9.6931e-03_r8/) + kbo(:, 1,14, 7) = (/ & + &3.8425e-01_r8,2.9801e-01_r8,2.0688e-01_r8,1.1055e-01_r8,3.4668e-03_r8/) + kbo(:, 2,14, 7) = (/ & + &5.4386e-01_r8,4.2093e-01_r8,2.9177e-01_r8,1.5544e-01_r8,4.5429e-03_r8/) + kbo(:, 3,14, 7) = (/ & + &7.3998e-01_r8,5.7137e-01_r8,3.9497e-01_r8,2.0995e-01_r8,5.6171e-03_r8/) + kbo(:, 4,14, 7) = (/ & + &9.7642e-01_r8,7.5246e-01_r8,5.1952e-01_r8,2.7577e-01_r8,6.9867e-03_r8/) + kbo(:, 5,14, 7) = (/ & + &1.2610e+00_r8,9.7017e-01_r8,6.6888e-01_r8,3.5427e-01_r8,8.6535e-03_r8/) + kbo(:, 1,15, 7) = (/ & + &3.3299e-01_r8,2.5933e-01_r8,1.7991e-01_r8,9.5905e-02_r8,2.9886e-03_r8/) + kbo(:, 2,15, 7) = (/ & + &4.6962e-01_r8,3.6448e-01_r8,2.5234e-01_r8,1.3421e-01_r8,3.8718e-03_r8/) + kbo(:, 3,15, 7) = (/ & + &6.3987e-01_r8,4.9512e-01_r8,3.4211e-01_r8,1.8150e-01_r8,4.8805e-03_r8/) + kbo(:, 4,15, 7) = (/ & + &8.4586e-01_r8,6.5388e-01_r8,4.5155e-01_r8,2.3908e-01_r8,6.1279e-03_r8/) + kbo(:, 5,15, 7) = (/ & + &1.0948e+00_r8,8.4428e-01_r8,5.8246e-01_r8,3.0839e-01_r8,7.4849e-03_r8/) + kbo(:, 1,16, 7) = (/ & + &2.8051e-01_r8,2.1899e-01_r8,1.5183e-01_r8,8.0896e-02_r8,2.5509e-03_r8/) + kbo(:, 2,16, 7) = (/ & + &3.9506e-01_r8,3.0781e-01_r8,2.1302e-01_r8,1.1324e-01_r8,3.3108e-03_r8/) + kbo(:, 3,16, 7) = (/ & + &5.3870e-01_r8,4.1855e-01_r8,2.8938e-01_r8,1.5357e-01_r8,4.2013e-03_r8/) + kbo(:, 4,16, 7) = (/ & + &7.1526e-01_r8,5.5449e-01_r8,3.8283e-01_r8,2.0269e-01_r8,5.1902e-03_r8/) + kbo(:, 5,16, 7) = (/ & + &9.2727e-01_r8,7.1785e-01_r8,4.9548e-01_r8,2.6200e-01_r8,6.4068e-03_r8/) + kbo(:, 1,17, 7) = (/ & + &2.3378e-01_r8,1.8318e-01_r8,1.2698e-01_r8,6.7717e-02_r8,2.1927e-03_r8/) + kbo(:, 2,17, 7) = (/ & + &3.2948e-01_r8,2.5742e-01_r8,1.7822e-01_r8,9.4896e-02_r8,2.8584e-03_r8/) + kbo(:, 3,17, 7) = (/ & + &4.5000e-01_r8,3.5080e-01_r8,2.4241e-01_r8,1.2872e-01_r8,3.6126e-03_r8/) + kbo(:, 4,17, 7) = (/ & + &5.9887e-01_r8,4.6579e-01_r8,3.2151e-01_r8,1.7042e-01_r8,4.5208e-03_r8/) + kbo(:, 5,17, 7) = (/ & + &7.7711e-01_r8,6.0357e-01_r8,4.1660e-01_r8,2.2035e-01_r8,5.5539e-03_r8/) + kbo(:, 1,18, 7) = (/ & + &1.9227e-01_r8,1.5110e-01_r8,1.0483e-01_r8,5.6032e-02_r8,1.9220e-03_r8/) + kbo(:, 2,18, 7) = (/ & + &2.7135e-01_r8,2.1238e-01_r8,1.4707e-01_r8,7.8382e-02_r8,2.4923e-03_r8/) + kbo(:, 3,18, 7) = (/ & + &3.7049e-01_r8,2.8960e-01_r8,2.0022e-01_r8,1.0642e-01_r8,3.1976e-03_r8/) + kbo(:, 4,18, 7) = (/ & + &4.9231e-01_r8,3.8398e-01_r8,2.6515e-01_r8,1.4069e-01_r8,3.9529e-03_r8/) + kbo(:, 5,18, 7) = (/ & + &6.4035e-01_r8,4.9892e-01_r8,3.4418e-01_r8,1.8220e-01_r8,4.8074e-03_r8/) + kbo(:, 1,19, 7) = (/ & + &1.6097e-01_r8,1.2681e-01_r8,8.7983e-02_r8,4.7067e-02_r8,1.6998e-03_r8/) + kbo(:, 2,19, 7) = (/ & + &2.2674e-01_r8,1.7812e-01_r8,1.2337e-01_r8,6.5758e-02_r8,2.2148e-03_r8/) + kbo(:, 3,19, 7) = (/ & + &3.0942e-01_r8,2.4239e-01_r8,1.6768e-01_r8,8.9247e-02_r8,2.8171e-03_r8/) + kbo(:, 4,19, 7) = (/ & + &4.1121e-01_r8,3.2156e-01_r8,2.2226e-01_r8,1.1805e-01_r8,3.4852e-03_r8/) + kbo(:, 5,19, 7) = (/ & + &5.3661e-01_r8,4.1891e-01_r8,2.8897e-01_r8,1.5308e-01_r8,4.2703e-03_r8/) + kbo(:, 1,20, 7) = (/ & + &1.3816e-01_r8,1.0899e-01_r8,7.5568e-02_r8,4.0384e-02_r8,1.5084e-03_r8/) + kbo(:, 2,20, 7) = (/ & + &1.9390e-01_r8,1.5237e-01_r8,1.0558e-01_r8,5.6347e-02_r8,1.9533e-03_r8/) + kbo(:, 3,20, 7) = (/ & + &2.6431e-01_r8,2.0734e-01_r8,1.4349e-01_r8,7.6381e-02_r8,2.4829e-03_r8/) + kbo(:, 4,20, 7) = (/ & + &3.5230e-01_r8,2.7579e-01_r8,1.9049e-01_r8,1.0107e-01_r8,3.1175e-03_r8/) + kbo(:, 5,20, 7) = (/ & + &4.5959e-01_r8,3.5917e-01_r8,2.4774e-01_r8,1.3132e-01_r8,3.8257e-03_r8/) + kbo(:, 1,21, 7) = (/ & + &1.1885e-01_r8,9.3725e-02_r8,6.5041e-02_r8,3.4803e-02_r8,1.3411e-03_r8/) + kbo(:, 2,21, 7) = (/ & + &1.6635e-01_r8,1.3102e-01_r8,9.0813e-02_r8,4.8481e-02_r8,1.7301e-03_r8/) + kbo(:, 3,21, 7) = (/ & + &2.2707e-01_r8,1.7845e-01_r8,1.2348e-01_r8,6.5731e-02_r8,2.2027e-03_r8/) + kbo(:, 4,21, 7) = (/ & + &3.0299e-01_r8,2.3748e-01_r8,1.6403e-01_r8,8.7154e-02_r8,2.7646e-03_r8/) + kbo(:, 5,21, 7) = (/ & + &3.9491e-01_r8,3.0909e-01_r8,2.1323e-01_r8,1.1320e-01_r8,3.3663e-03_r8/) + kbo(:, 1,22, 7) = (/ & + &1.0371e-01_r8,8.1936e-02_r8,5.6886e-02_r8,3.0452e-02_r8,1.1973e-03_r8/) + kbo(:, 2,22, 7) = (/ & + &1.4515e-01_r8,1.1443e-01_r8,7.9345e-02_r8,4.2377e-02_r8,1.5408e-03_r8/) + kbo(:, 3,22, 7) = (/ & + &1.9815e-01_r8,1.5584e-01_r8,1.0788e-01_r8,5.7461e-02_r8,1.9609e-03_r8/) + kbo(:, 4,22, 7) = (/ & + &2.6352e-01_r8,2.0697e-01_r8,1.4313e-01_r8,7.6128e-02_r8,2.4333e-03_r8/) + kbo(:, 5,22, 7) = (/ & + &3.4221e-01_r8,2.6821e-01_r8,1.8537e-01_r8,9.8647e-02_r8,2.9393e-03_r8/) + kbo(:, 1,23, 7) = (/ & + &9.0639e-02_r8,7.1734e-02_r8,4.9824e-02_r8,2.6695e-02_r8,1.0611e-03_r8/) + kbo(:, 2,23, 7) = (/ & + &1.2684e-01_r8,1.0014e-01_r8,6.9426e-02_r8,3.7107e-02_r8,1.3714e-03_r8/) + kbo(:, 3,23, 7) = (/ & + &1.7268e-01_r8,1.3597e-01_r8,9.4123e-02_r8,5.0237e-02_r8,1.7212e-03_r8/) + kbo(:, 4,23, 7) = (/ & + &2.2866e-01_r8,1.7972e-01_r8,1.2432e-01_r8,6.6277e-02_r8,2.1161e-03_r8/) + kbo(:, 5,23, 7) = (/ & + &2.9584e-01_r8,2.3227e-01_r8,1.6067e-01_r8,8.5547e-02_r8,2.5346e-03_r8/) + kbo(:, 1,24, 7) = (/ & + &8.0071e-02_r8,6.3444e-02_r8,4.4064e-02_r8,2.3644e-02_r8,9.3348e-04_r8/) + kbo(:, 2,24, 7) = (/ & + &1.1181e-01_r8,8.8354e-02_r8,6.1271e-02_r8,3.2794e-02_r8,1.1882e-03_r8/) + kbo(:, 3,24, 7) = (/ & + &1.5149e-01_r8,1.1939e-01_r8,8.2725e-02_r8,4.4223e-02_r8,1.4832e-03_r8/) + kbo(:, 4,24, 7) = (/ & + &1.9978e-01_r8,1.5722e-01_r8,1.0888e-01_r8,5.8128e-02_r8,1.8190e-03_r8/) + kbo(:, 5,24, 7) = (/ & + &2.5770e-01_r8,2.0260e-01_r8,1.4030e-01_r8,7.4844e-02_r8,2.1747e-03_r8/) + kbo(:, 1,25, 7) = (/ & + &7.0951e-02_r8,5.6269e-02_r8,3.9108e-02_r8,2.1016e-02_r8,8.0964e-04_r8/) + kbo(:, 2,25, 7) = (/ & + &9.8623e-02_r8,7.8013e-02_r8,5.4088e-02_r8,2.9015e-02_r8,1.0247e-03_r8/) + kbo(:, 3,25, 7) = (/ & + &1.3295e-01_r8,1.0488e-01_r8,7.2709e-02_r8,3.8919e-02_r8,1.2776e-03_r8/) + kbo(:, 4,25, 7) = (/ & + &1.7470e-01_r8,1.3764e-01_r8,9.5373e-02_r8,5.0958e-02_r8,1.5592e-03_r8/) + kbo(:, 5,25, 7) = (/ & + &2.2493e-01_r8,1.7708e-01_r8,1.2270e-01_r8,6.5502e-02_r8,1.8657e-03_r8/) + kbo(:, 1,26, 7) = (/ & + &6.3451e-02_r8,5.0352e-02_r8,3.4999e-02_r8,1.8811e-02_r8,7.0696e-04_r8/) + kbo(:, 2,26, 7) = (/ & + &8.7646e-02_r8,6.9321e-02_r8,4.8128e-02_r8,2.5820e-02_r8,8.9108e-04_r8/) + kbo(:, 3,26, 7) = (/ & + &1.1756e-01_r8,9.2804e-02_r8,6.4336e-02_r8,3.4465e-02_r8,1.1063e-03_r8/) + kbo(:, 4,26, 7) = (/ & + &1.5401e-01_r8,1.2150e-01_r8,8.4218e-02_r8,4.5022e-02_r8,1.3420e-03_r8/) + kbo(:, 5,26, 7) = (/ & + &1.9847e-01_r8,1.5626e-01_r8,1.0822e-01_r8,5.7833e-02_r8,1.6057e-03_r8/) + kbo(:, 1,27, 7) = (/ & + &5.6793e-02_r8,4.5057e-02_r8,3.1339e-02_r8,1.6842e-02_r8,6.0571e-04_r8/) + kbo(:, 2,27, 7) = (/ & + &7.8027e-02_r8,6.1732e-02_r8,4.2853e-02_r8,2.2968e-02_r8,7.6180e-04_r8/) + kbo(:, 3,27, 7) = (/ & + &1.0421e-01_r8,8.2314e-02_r8,5.7109e-02_r8,3.0579e-02_r8,9.4573e-04_r8/) + kbo(:, 4,27, 7) = (/ & + &1.3651e-01_r8,1.0769e-01_r8,7.4645e-02_r8,3.9915e-02_r8,1.1425e-03_r8/) + kbo(:, 5,27, 7) = (/ & + &1.7591e-01_r8,1.3862e-01_r8,9.6018e-02_r8,5.1325e-02_r8,1.3608e-03_r8/) + kbo(:, 1,28, 7) = (/ & + &5.0832e-02_r8,4.0335e-02_r8,2.8062e-02_r8,1.5080e-02_r8,5.0959e-04_r8/) + kbo(:, 2,28, 7) = (/ & + &6.9491e-02_r8,5.4973e-02_r8,3.8187e-02_r8,2.0466e-02_r8,6.4488e-04_r8/) + kbo(:, 3,28, 7) = (/ & + &9.2684e-02_r8,7.3230e-02_r8,5.0823e-02_r8,2.7216e-02_r8,7.9606e-04_r8/) + kbo(:, 4,28, 7) = (/ & + &1.2155e-01_r8,9.5886e-02_r8,6.6455e-02_r8,3.5548e-02_r8,9.5678e-04_r8/) + kbo(:, 5,28, 7) = (/ & + &1.5688e-01_r8,1.2363e-01_r8,8.5583e-02_r8,4.5732e-02_r8,1.1415e-03_r8/) + kbo(:, 1,29, 7) = (/ & + &4.5296e-02_r8,3.5922e-02_r8,2.4992e-02_r8,1.3423e-02_r8,4.2743e-04_r8/) + kbo(:, 2,29, 7) = (/ & + &6.1694e-02_r8,4.8833e-02_r8,3.3922e-02_r8,1.8191e-02_r8,5.3907e-04_r8/) + kbo(:, 3,29, 7) = (/ & + &8.2276e-02_r8,6.5053e-02_r8,4.5148e-02_r8,2.4171e-02_r8,6.5935e-04_r8/) + kbo(:, 4,29, 7) = (/ & + &1.0791e-01_r8,8.5197e-02_r8,5.9066e-02_r8,3.1598e-02_r8,7.9358e-04_r8/) + kbo(:, 5,29, 7) = (/ & + &1.3964e-01_r8,1.1005e-01_r8,7.6235e-02_r8,4.0713e-02_r8,9.4519e-04_r8/) + kbo(:, 1,30, 7) = (/ & + &4.0185e-02_r8,3.1886e-02_r8,2.2195e-02_r8,1.1919e-02_r8,3.5485e-04_r8/) + kbo(:, 2,30, 7) = (/ & + &5.4626e-02_r8,4.3278e-02_r8,3.0084e-02_r8,1.6135e-02_r8,4.4303e-04_r8/) + kbo(:, 3,30, 7) = (/ & + &7.2953e-02_r8,5.7701e-02_r8,4.0048e-02_r8,2.1442e-02_r8,5.4169e-04_r8/) + kbo(:, 4,30, 7) = (/ & + &9.5812e-02_r8,7.5701e-02_r8,5.2497e-02_r8,2.8075e-02_r8,6.5509e-04_r8/) + kbo(:, 5,30, 7) = (/ & + &1.2402e-01_r8,9.7862e-02_r8,6.7806e-02_r8,3.6235e-02_r8,7.7850e-04_r8/) + kbo(:, 1,31, 7) = (/ & + &3.5348e-02_r8,2.8090e-02_r8,1.9559e-02_r8,1.0513e-02_r8,2.9039e-04_r8/) + kbo(:, 2,31, 7) = (/ & + &4.8053e-02_r8,3.8118e-02_r8,2.6496e-02_r8,1.4221e-02_r8,3.5964e-04_r8/) + kbo(:, 3,31, 7) = (/ & + &6.4212e-02_r8,5.0845e-02_r8,3.5309e-02_r8,1.8919e-02_r8,4.4117e-04_r8/) + kbo(:, 4,31, 7) = (/ & + &8.4429e-02_r8,6.6772e-02_r8,4.6322e-02_r8,2.4787e-02_r8,5.3116e-04_r8/) + kbo(:, 5,31, 7) = (/ & + &1.0928e-01_r8,8.6339e-02_r8,5.9901e-02_r8,3.2032e-02_r8,6.3348e-04_r8/) + kbo(:, 1,32, 7) = (/ & + &3.1311e-02_r8,2.4896e-02_r8,1.7336e-02_r8,9.3247e-03_r8,2.3608e-04_r8/) + kbo(:, 2,32, 7) = (/ & + &4.2575e-02_r8,3.3801e-02_r8,2.3511e-02_r8,1.2616e-02_r8,2.9452e-04_r8/) + kbo(:, 3,32, 7) = (/ & + &5.6935e-02_r8,4.5129e-02_r8,3.1359e-02_r8,1.6809e-02_r8,3.6093e-04_r8/) + kbo(:, 4,32, 7) = (/ & + &7.4842e-02_r8,5.9256e-02_r8,4.1156e-02_r8,2.2039e-02_r8,4.3435e-04_r8/) + kbo(:, 5,32, 7) = (/ & + &9.6933e-02_r8,7.6740e-02_r8,5.3274e-02_r8,2.8476e-02_r8,5.1533e-04_r8/) + kbo(:, 1,33, 7) = (/ & + &2.7886e-02_r8,2.2206e-02_r8,1.5465e-02_r8,8.3176e-03_r8,1.9330e-04_r8/) + kbo(:, 2,33, 7) = (/ & + &3.7954e-02_r8,3.0161e-02_r8,2.0981e-02_r8,1.1260e-02_r8,2.4048e-04_r8/) + kbo(:, 3,33, 7) = (/ & + &5.0729e-02_r8,4.0269e-02_r8,2.7996e-02_r8,1.5008e-02_r8,2.9283e-04_r8/) + kbo(:, 4,33, 7) = (/ & + &6.6680e-02_r8,5.2910e-02_r8,3.6768e-02_r8,1.9685e-02_r8,3.5174e-04_r8/) + kbo(:, 5,33, 7) = (/ & + &8.6325e-02_r8,6.8491e-02_r8,4.7579e-02_r8,2.5448e-02_r8,4.1781e-04_r8/) + kbo(:, 1,34, 7) = (/ & + &2.4971e-02_r8,1.9901e-02_r8,1.3860e-02_r8,7.4508e-03_r8,1.5943e-04_r8/) + kbo(:, 2,34, 7) = (/ & + &3.3993e-02_r8,2.7044e-02_r8,1.8817e-02_r8,1.0102e-02_r8,1.9737e-04_r8/) + kbo(:, 3,34, 7) = (/ & + &4.5431e-02_r8,3.6116e-02_r8,2.5118e-02_r8,1.3468e-02_r8,2.4097e-04_r8/) + kbo(:, 4,34, 7) = (/ & + &5.9751e-02_r8,4.7485e-02_r8,3.3007e-02_r8,1.7673e-02_r8,2.8983e-04_r8/) + kbo(:, 5,34, 7) = (/ & + &7.7416e-02_r8,6.1530e-02_r8,4.2751e-02_r8,2.2863e-02_r8,3.4328e-04_r8/) + kbo(:, 1,35, 7) = (/ & + &2.1796e-02_r8,1.7387e-02_r8,1.2111e-02_r8,6.5084e-03_r8,1.2835e-04_r8/) + kbo(:, 2,35, 7) = (/ & + &2.9698e-02_r8,2.3666e-02_r8,1.6479e-02_r8,8.8433e-03_r8,1.5863e-04_r8/) + kbo(:, 3,35, 7) = (/ & + &3.9760e-02_r8,3.1675e-02_r8,2.2035e-02_r8,1.1812e-02_r8,1.9396e-04_r8/) + kbo(:, 4,35, 7) = (/ & + &5.2402e-02_r8,4.1735e-02_r8,2.9029e-02_r8,1.5538e-02_r8,2.3292e-04_r8/) + kbo(:, 5,35, 7) = (/ & + &6.8053e-02_r8,5.4173e-02_r8,3.7664e-02_r8,2.0141e-02_r8,2.7598e-04_r8/) + kbo(:, 1,36, 7) = (/ & + &1.8439e-02_r8,1.4736e-02_r8,1.0269e-02_r8,5.5181e-03_r8,1.0059e-04_r8/) + kbo(:, 2,36, 7) = (/ & + &2.5228e-02_r8,2.0135e-02_r8,1.4024e-02_r8,7.5257e-03_r8,1.2421e-04_r8/) + kbo(:, 3,36, 7) = (/ & + &3.3891e-02_r8,2.7058e-02_r8,1.8832e-02_r8,1.0097e-02_r8,1.5179e-04_r8/) + kbo(:, 4,36, 7) = (/ & + &4.4855e-02_r8,3.5783e-02_r8,2.4899e-02_r8,1.3331e-02_r8,1.8254e-04_r8/) + kbo(:, 5,36, 7) = (/ & + &5.8411e-02_r8,4.6611e-02_r8,3.2419e-02_r8,1.7335e-02_r8,2.1654e-04_r8/) + kbo(:, 1,37, 7) = (/ & + &1.5025e-02_r8,1.2025e-02_r8,8.3808e-03_r8,4.5043e-03_r8,7.8293e-05_r8/) + kbo(:, 2,37, 7) = (/ & + &2.0678e-02_r8,1.6540e-02_r8,1.1522e-02_r8,6.1849e-03_r8,9.7252e-05_r8/) + kbo(:, 3,37, 7) = (/ & + &2.7964e-02_r8,2.2364e-02_r8,1.5572e-02_r8,8.3486e-03_r8,1.1926e-04_r8/) + kbo(:, 4,37, 7) = (/ & + &3.7225e-02_r8,2.9764e-02_r8,2.0719e-02_r8,1.1092e-02_r8,1.4386e-04_r8/) + kbo(:, 5,37, 7) = (/ & + &4.8779e-02_r8,3.9013e-02_r8,2.7143e-02_r8,1.4513e-02_r8,1.7127e-04_r8/) + kbo(:, 1,38, 7) = (/ & + &1.2194e-02_r8,9.7772e-03_r8,6.8154e-03_r8,3.6630e-03_r8,6.0721e-05_r8/) + kbo(:, 2,38, 7) = (/ & + &1.6892e-02_r8,1.3540e-02_r8,9.4349e-03_r8,5.0655e-03_r8,7.5931e-05_r8/) + kbo(:, 3,38, 7) = (/ & + &2.2993e-02_r8,1.8427e-02_r8,1.2834e-02_r8,6.8825e-03_r8,9.3480e-05_r8/) + kbo(:, 4,38, 7) = (/ & + &3.0804e-02_r8,2.4686e-02_r8,1.7192e-02_r8,9.2065e-03_r8,1.1312e-04_r8/) + kbo(:, 5,38, 7) = (/ & + &4.0626e-02_r8,3.2569e-02_r8,2.2673e-02_r8,1.2127e-02_r8,1.3481e-04_r8/) + kbo(:, 1,39, 7) = (/ & + &9.8863e-03_r8,7.9385e-03_r8,5.5336e-03_r8,2.9753e-03_r8,4.6829e-05_r8/) + kbo(:, 2,39, 7) = (/ & + &1.3782e-02_r8,1.1068e-02_r8,7.7135e-03_r8,4.1426e-03_r8,5.8903e-05_r8/) + kbo(:, 3,39, 7) = (/ & + &1.8884e-02_r8,1.5163e-02_r8,1.0568e-02_r8,5.6692e-03_r8,7.2758e-05_r8/) + kbo(:, 4,39, 7) = (/ & + &2.5472e-02_r8,2.0459e-02_r8,1.4252e-02_r8,7.6329e-03_r8,8.8280e-05_r8/) + kbo(:, 5,39, 7) = (/ & + &3.3793e-02_r8,2.7159e-02_r8,1.8912e-02_r8,1.0123e-02_r8,1.0549e-04_r8/) + kbo(:, 1,40, 7) = (/ & + &7.8183e-03_r8,6.2872e-03_r8,4.3840e-03_r8,2.3583e-03_r8,3.5934e-05_r8/) + kbo(:, 2,40, 7) = (/ & + &1.1002e-02_r8,8.8456e-03_r8,6.1665e-03_r8,3.3129e-03_r8,4.5505e-05_r8/) + kbo(:, 3,40, 7) = (/ & + &1.5204e-02_r8,1.2224e-02_r8,8.5201e-03_r8,4.5727e-03_r8,5.6603e-05_r8/) + kbo(:, 4,40, 7) = (/ & + &2.0667e-02_r8,1.6639e-02_r8,1.1596e-02_r8,6.2148e-03_r8,6.8922e-05_r8/) + kbo(:, 5,40, 7) = (/ & + &2.7656e-02_r8,2.2280e-02_r8,1.5521e-02_r8,8.3102e-03_r8,8.2779e-05_r8/) + kbo(:, 1,41, 7) = (/ & + &6.1500e-03_r8,4.9524e-03_r8,3.4538e-03_r8,1.8579e-03_r8,2.7494e-05_r8/) + kbo(:, 2,41, 7) = (/ & + &8.7326e-03_r8,7.0361e-03_r8,4.9035e-03_r8,2.6349e-03_r8,3.5036e-05_r8/) + kbo(:, 3,41, 7) = (/ & + &1.2182e-02_r8,9.8121e-03_r8,6.8364e-03_r8,3.6704e-03_r8,4.3900e-05_r8/) + kbo(:, 4,41, 7) = (/ & + &1.6698e-02_r8,1.3470e-02_r8,9.3901e-03_r8,5.0360e-03_r8,5.3809e-05_r8/) + kbo(:, 5,41, 7) = (/ & + &2.2541e-02_r8,1.8202e-02_r8,1.2686e-02_r8,6.7978e-03_r8,6.4784e-05_r8/) + kbo(:, 1,42, 7) = (/ & + &4.8216e-03_r8,3.8878e-03_r8,2.7121e-03_r8,1.4585e-03_r8,2.0930e-05_r8/) + kbo(:, 2,42, 7) = (/ & + &6.9151e-03_r8,5.5793e-03_r8,3.8882e-03_r8,2.0902e-03_r8,2.6862e-05_r8/) + kbo(:, 3,42, 7) = (/ & + &9.7317e-03_r8,7.8533e-03_r8,5.4747e-03_r8,2.9388e-03_r8,3.3897e-05_r8/) + kbo(:, 4,42, 7) = (/ & + &1.3459e-02_r8,1.0876e-02_r8,7.5844e-03_r8,4.0697e-03_r8,4.1759e-05_r8/) + kbo(:, 5,42, 7) = (/ & + &1.8320e-02_r8,1.4838e-02_r8,1.0343e-02_r8,5.5456e-03_r8,5.0540e-05_r8/) + kbo(:, 1,43, 7) = (/ & + &3.7271e-03_r8,3.0076e-03_r8,2.0983e-03_r8,1.1283e-03_r8,1.5715e-05_r8/) + kbo(:, 2,43, 7) = (/ & + &5.4034e-03_r8,4.3650e-03_r8,3.0427e-03_r8,1.6347e-03_r8,2.0366e-05_r8/) + kbo(:, 3,43, 7) = (/ & + &7.6865e-03_r8,6.2120e-03_r8,4.3312e-03_r8,2.3251e-03_r8,2.5938e-05_r8/) + kbo(:, 4,43, 7) = (/ & + &1.0735e-02_r8,8.6871e-03_r8,6.0565e-03_r8,3.2504e-03_r8,3.2151e-05_r8/) + kbo(:, 5,43, 7) = (/ & + &1.4744e-02_r8,1.1965e-02_r8,8.3459e-03_r8,4.4756e-03_r8,3.9126e-05_r8/) + kbo(:, 1,44, 7) = (/ & + &2.8560e-03_r8,2.3067e-03_r8,1.6088e-03_r8,8.6423e-04_r8,1.1691e-05_r8/) + kbo(:, 2,44, 7) = (/ & + &4.1914e-03_r8,3.3878e-03_r8,2.3617e-03_r8,1.2680e-03_r8,1.5336e-05_r8/) + kbo(:, 3,44, 7) = (/ & + &6.0257e-03_r8,4.8753e-03_r8,3.3991e-03_r8,1.8248e-03_r8,1.9674e-05_r8/) + kbo(:, 4,44, 7) = (/ & + &8.5074e-03_r8,6.8953e-03_r8,4.8067e-03_r8,2.5783e-03_r8,2.4601e-05_r8/) + kbo(:, 5,44, 7) = (/ & + &1.1798e-02_r8,9.5893e-03_r8,6.6876e-03_r8,3.5866e-03_r8,3.0110e-05_r8/) + kbo(:, 1,45, 7) = (/ & + &2.1795e-03_r8,1.7620e-03_r8,1.2288e-03_r8,6.5976e-04_r8,8.6355e-06_r8/) + kbo(:, 2,45, 7) = (/ & + &3.2384e-03_r8,2.6190e-03_r8,1.8255e-03_r8,9.8000e-04_r8,1.1470e-05_r8/) + kbo(:, 3,45, 7) = (/ & + &4.7095e-03_r8,3.8135e-03_r8,2.6589e-03_r8,1.4269e-03_r8,1.4819e-05_r8/) + kbo(:, 4,45, 7) = (/ & + &6.7188e-03_r8,5.4533e-03_r8,3.8021e-03_r8,2.0391e-03_r8,1.8692e-05_r8/) + kbo(:, 5,45, 7) = (/ & + &9.4160e-03_r8,7.6627e-03_r8,5.3428e-03_r8,2.8648e-03_r8,2.3071e-05_r8/) + kbo(:, 1,46, 7) = (/ & + &1.6442e-03_r8,1.3301e-03_r8,9.2731e-04_r8,4.9724e-04_r8,6.3123e-06_r8/) + kbo(:, 2,46, 7) = (/ & + &2.4756e-03_r8,2.0038e-03_r8,1.3961e-03_r8,7.4858e-04_r8,8.4887e-06_r8/) + kbo(:, 3,46, 7) = (/ & + &3.6430e-03_r8,2.9527e-03_r8,2.0584e-03_r8,1.1034e-03_r8,1.1065e-05_r8/) + kbo(:, 4,46, 7) = (/ & + &5.2551e-03_r8,4.2702e-03_r8,2.9775e-03_r8,1.5960e-03_r8,1.4093e-05_r8/) + kbo(:, 5,46, 7) = (/ & + &7.4490e-03_r8,6.0700e-03_r8,4.2323e-03_r8,2.2675e-03_r8,1.7540e-05_r8/) + kbo(:, 1,47, 7) = (/ & + &1.2145e-03_r8,9.8337e-04_r8,6.8536e-04_r8,3.6730e-04_r8,4.5517e-06_r8/) + kbo(:, 2,47, 7) = (/ & + &1.8591e-03_r8,1.5045e-03_r8,1.0482e-03_r8,5.6130e-04_r8,6.1946e-06_r8/) + kbo(:, 3,47, 7) = (/ & + &2.7714e-03_r8,2.2470e-03_r8,1.5654e-03_r8,8.3875e-04_r8,8.1842e-06_r8/) + kbo(:, 4,47, 7) = (/ & + &4.0468e-03_r8,3.2903e-03_r8,2.2941e-03_r8,1.2283e-03_r8,1.0514e-05_r8/) + kbo(:, 5,47, 7) = (/ & + &5.8053e-03_r8,4.7349e-03_r8,3.3018e-03_r8,1.7685e-03_r8,1.3244e-05_r8/) + kbo(:, 1,48, 7) = (/ & + &8.9209e-04_r8,7.2273e-04_r8,5.0348e-04_r8,2.6958e-04_r8,3.2450e-06_r8/) + kbo(:, 2,48, 7) = (/ & + &1.3877e-03_r8,1.1243e-03_r8,7.8261e-04_r8,4.1863e-04_r8,4.4867e-06_r8/) + kbo(:, 3,48, 7) = (/ & + &2.0991e-03_r8,1.7020e-03_r8,1.1852e-03_r8,6.3416e-04_r8,6.0052e-06_r8/) + kbo(:, 4,48, 7) = (/ & + &3.1030e-03_r8,2.5246e-03_r8,1.7595e-03_r8,9.4166e-04_r8,7.8064e-06_r8/) + kbo(:, 5,48, 7) = (/ & + &4.5012e-03_r8,3.6752e-03_r8,2.5627e-03_r8,1.3716e-03_r8,9.9188e-06_r8/) + kbo(:, 1,49, 7) = (/ & + &6.5052e-04_r8,5.2741e-04_r8,3.6738e-04_r8,1.9665e-04_r8,2.2928e-06_r8/) + kbo(:, 2,49, 7) = (/ & + &1.0291e-03_r8,8.3378e-04_r8,5.8035e-04_r8,3.1024e-04_r8,3.2141e-06_r8/) + kbo(:, 3,49, 7) = (/ & + &1.5816e-03_r8,1.2832e-03_r8,8.9291e-04_r8,4.7687e-04_r8,4.3608e-06_r8/) + kbo(:, 4,49, 7) = (/ & + &2.3687e-03_r8,1.9273e-03_r8,1.3422e-03_r8,7.1737e-04_r8,5.7390e-06_r8/) + kbo(:, 5,49, 7) = (/ & + &3.4765e-03_r8,2.8403e-03_r8,1.9797e-03_r8,1.0580e-03_r8,7.3616e-06_r8/) + kbo(:, 1,50, 7) = (/ & + &4.7889e-04_r8,3.8798e-04_r8,2.7009e-04_r8,1.4448e-04_r8,1.6356e-06_r8/) + kbo(:, 2,50, 7) = (/ & + &7.6956e-04_r8,6.2385e-04_r8,4.3396e-04_r8,2.3170e-04_r8,2.3299e-06_r8/) + kbo(:, 3,50, 7) = (/ & + &1.1998e-03_r8,9.7385e-04_r8,6.7714e-04_r8,3.6138e-04_r8,3.2007e-06_r8/) + kbo(:, 4,50, 7) = (/ & + &1.8222e-03_r8,1.4833e-03_r8,1.0320e-03_r8,5.5070e-04_r8,4.2632e-06_r8/) + kbo(:, 5,50, 7) = (/ & + &2.7064e-03_r8,2.2113e-03_r8,1.5405e-03_r8,8.2234e-04_r8,5.5273e-06_r8/) + kbo(:, 1,51, 7) = (/ & + &3.5344e-04_r8,2.8635e-04_r8,1.9912e-04_r8,1.0636e-04_r8,1.1680e-06_r8/) + kbo(:, 2,51, 7) = (/ & + &5.7631e-04_r8,4.6738e-04_r8,3.2502e-04_r8,1.7332e-04_r8,1.6902e-06_r8/) + kbo(:, 3,51, 7) = (/ & + &9.1142e-04_r8,7.3982e-04_r8,5.1424e-04_r8,2.7410e-04_r8,2.3543e-06_r8/) + kbo(:, 4,51, 7) = (/ & + &1.4045e-03_r8,1.1437e-03_r8,7.9544e-04_r8,4.2395e-04_r8,3.1729e-06_r8/) + kbo(:, 5,51, 7) = (/ & + &2.1131e-03_r8,1.7268e-03_r8,1.2023e-03_r8,6.4090e-04_r8,4.1620e-06_r8/) + kbo(:, 1,52, 7) = (/ & + &2.5933e-04_r8,2.1020e-04_r8,1.4608e-04_r8,7.7951e-05_r8,8.2759e-07_r8/) + kbo(:, 2,52, 7) = (/ & + &4.3070e-04_r8,3.4917e-04_r8,2.4257e-04_r8,1.2919e-04_r8,1.2165e-06_r8/) + kbo(:, 3,52, 7) = (/ & + &6.9048e-04_r8,5.6079e-04_r8,3.8962e-04_r8,2.0733e-04_r8,1.7208e-06_r8/) + kbo(:, 4,52, 7) = (/ & + &1.0785e-03_r8,8.7815e-04_r8,6.1039e-04_r8,3.2491e-04_r8,2.3474e-06_r8/) + kbo(:, 5,52, 7) = (/ & + &1.6449e-03_r8,1.3448e-03_r8,9.3585e-04_r8,4.9830e-04_r8,3.1177e-06_r8/) + kbo(:, 1,53, 7) = (/ & + &1.8893e-04_r8,1.5324e-04_r8,1.0643e-04_r8,5.6765e-05_r8,5.8012e-07_r8/) + kbo(:, 2,53, 7) = (/ & + &3.2030e-04_r8,2.5977e-04_r8,1.8033e-04_r8,9.5988e-05_r8,8.6790e-07_r8/) + kbo(:, 3,53, 7) = (/ & + &5.2133e-04_r8,4.2303e-04_r8,2.9359e-04_r8,1.5604e-04_r8,1.2459e-06_r8/) + kbo(:, 4,53, 7) = (/ & + &8.2474e-04_r8,6.7149e-04_r8,4.6612e-04_r8,2.4781e-04_r8,1.7256e-06_r8/) + kbo(:, 5,53, 7) = (/ & + &1.2742e-03_r8,1.0424e-03_r8,7.2493e-04_r8,3.8558e-04_r8,2.3164e-06_r8/) + kbo(:, 1,54, 7) = (/ & + &1.3969e-04_r8,1.1317e-04_r8,7.8561e-05_r8,4.1870e-05_r8,4.1563e-07_r8/) + kbo(:, 2,54, 7) = (/ & + &2.4197e-04_r8,1.9607e-04_r8,1.3602e-04_r8,7.2325e-05_r8,6.3273e-07_r8/) + kbo(:, 3,54, 7) = (/ & + &4.0015e-04_r8,3.2487e-04_r8,2.2527e-04_r8,1.1951e-04_r8,9.2081e-07_r8/) + kbo(:, 4,54, 7) = (/ & + &6.4075e-04_r8,5.2162e-04_r8,3.6218e-04_r8,1.9219e-04_r8,1.2926e-06_r8/) + kbo(:, 5,54, 7) = (/ & + &1.0011e-03_r8,8.1978e-04_r8,5.6992e-04_r8,3.0275e-04_r8,1.7539e-06_r8/) + kbo(:, 1,55, 7) = (/ & + &1.0370e-04_r8,8.4064e-05_r8,5.8320e-05_r8,3.1035e-05_r8,3.0125e-07_r8/) + kbo(:, 2,55, 7) = (/ & + &1.8386e-04_r8,1.4899e-04_r8,1.0330e-04_r8,5.4881e-05_r8,4.6624e-07_r8/) + kbo(:, 3,55, 7) = (/ & + &3.0954e-04_r8,2.5123e-04_r8,1.7413e-04_r8,9.2312e-05_r8,6.8850e-07_r8/) + kbo(:, 4,55, 7) = (/ & + &5.0203e-04_r8,4.0855e-04_r8,2.8330e-04_r8,1.5019e-04_r8,9.7772e-07_r8/) + kbo(:, 5,55, 7) = (/ & + &7.9354e-04_r8,6.4976e-04_r8,4.5113e-04_r8,2.3954e-04_r8,1.3409e-06_r8/) + kbo(:, 1,56, 7) = (/ & + &7.6693e-05_r8,6.2162e-05_r8,4.3120e-05_r8,2.2933e-05_r8,2.1684e-07_r8/) + kbo(:, 2,56, 7) = (/ & + &1.3934e-04_r8,1.1294e-04_r8,7.8219e-05_r8,4.1520e-05_r8,3.4179e-07_r8/) + kbo(:, 3,56, 7) = (/ & + &2.3910e-04_r8,1.9403e-04_r8,1.3441e-04_r8,7.1189e-05_r8,5.1274e-07_r8/) + kbo(:, 4,56, 7) = (/ & + &3.9378e-04_r8,3.2054e-04_r8,2.2198e-04_r8,1.1748e-04_r8,7.3840e-07_r8/) + kbo(:, 5,56, 7) = (/ & + &6.2957e-04_r8,5.1531e-04_r8,3.5753e-04_r8,1.8952e-04_r8,1.0222e-06_r8/) + kbo(:, 1,57, 7) = (/ & + &5.6535e-05_r8,4.5829e-05_r8,3.1754e-05_r8,1.6880e-05_r8,1.5535e-07_r8/) + kbo(:, 2,57, 7) = (/ & + &1.0543e-04_r8,8.5393e-05_r8,5.9099e-05_r8,3.1336e-05_r8,2.4941e-07_r8/) + kbo(:, 3,57, 7) = (/ & + &1.8447e-04_r8,1.4976e-04_r8,1.0364e-04_r8,5.4850e-05_r8,3.7980e-07_r8/) + kbo(:, 4,57, 7) = (/ & + &3.0910e-04_r8,2.5132e-04_r8,1.7397e-04_r8,9.1976e-05_r8,5.5506e-07_r8/) + kbo(:, 5,57, 7) = (/ & + &4.9998e-04_r8,4.0888e-04_r8,2.8341e-04_r8,1.4999e-04_r8,7.7934e-07_r8/) + kbo(:, 1,58, 7) = (/ & + &2.0338e-05_r8,1.8913e-05_r8,1.5378e-05_r8,9.8853e-06_r8,1.1183e-07_r8/) + kbo(:, 2,58, 7) = (/ & + &3.8917e-05_r8,3.6144e-05_r8,2.9335e-05_r8,1.8800e-05_r8,1.8309e-07_r8/) + kbo(:, 3,58, 7) = (/ & + &6.9478e-05_r8,6.4684e-05_r8,5.2517e-05_r8,3.3620e-05_r8,2.8333e-07_r8/) + kbo(:, 4,58, 7) = (/ & + &1.1843e-04_r8,1.1052e-04_r8,8.9713e-05_r8,5.7328e-05_r8,4.1951e-07_r8/) + kbo(:, 5,58, 7) = (/ & + &1.9434e-04_r8,1.8218e-04_r8,1.4806e-04_r8,9.4685e-05_r8,5.9796e-07_r8/) + kbo(:, 1,59, 7) = (/ & + &1.6486e-05_r8,1.5394e-05_r8,1.2565e-05_r8,8.1204e-06_r8,9.1178e-08_r8/) + kbo(:, 2,59, 7) = (/ & + &3.1937e-05_r8,2.9800e-05_r8,2.4292e-05_r8,1.5665e-05_r8,1.5065e-07_r8/) + kbo(:, 3,59, 7) = (/ & + &5.7683e-05_r8,5.3905e-05_r8,4.3942e-05_r8,2.8299e-05_r8,2.3496e-07_r8/) + kbo(:, 4,59, 7) = (/ & + &9.9323e-05_r8,9.3088e-05_r8,7.5927e-05_r8,4.8813e-05_r8,3.4922e-07_r8/) + kbo(:, 5,59, 7) = (/ & + &1.6451e-04_r8,1.5507e-04_r8,1.2661e-04_r8,8.1439e-05_r8,5.0093e-07_r8/) + kbo(:, 1,13, 8) = (/ & + &1.2116e+00_r8,9.1758e-01_r8,6.2996e-01_r8,3.3536e-01_r8,1.5468e-02_r8/) + kbo(:, 2,13, 8) = (/ & + &1.6818e+00_r8,1.2746e+00_r8,8.7634e-01_r8,4.6518e-01_r8,1.8709e-02_r8/) + kbo(:, 3,13, 8) = (/ & + &2.2865e+00_r8,1.7360e+00_r8,1.1942e+00_r8,6.3525e-01_r8,2.2469e-02_r8/) + kbo(:, 4,13, 8) = (/ & + &3.0754e+00_r8,2.3371e+00_r8,1.6054e+00_r8,8.5102e-01_r8,2.6288e-02_r8/) + kbo(:, 5,13, 8) = (/ & + &4.0473e+00_r8,3.0761e+00_r8,2.1113e+00_r8,1.1162e+00_r8,3.0276e-02_r8/) + kbo(:, 1,14, 8) = (/ & + &1.1078e+00_r8,8.4059e-01_r8,5.7946e-01_r8,3.0612e-01_r8,1.2063e-02_r8/) + kbo(:, 2,14, 8) = (/ & + &1.5335e+00_r8,1.1661e+00_r8,8.0499e-01_r8,4.2627e-01_r8,1.4718e-02_r8/) + kbo(:, 3,14, 8) = (/ & + &2.0884e+00_r8,1.5886e+00_r8,1.0949e+00_r8,5.8050e-01_r8,1.7857e-02_r8/) + kbo(:, 4,14, 8) = (/ & + &2.8120e+00_r8,2.1413e+00_r8,1.4745e+00_r8,7.8098e-01_r8,2.1007e-02_r8/) + kbo(:, 5,14, 8) = (/ & + &3.6989e+00_r8,2.8189e+00_r8,1.9396e+00_r8,1.0257e+00_r8,2.4295e-02_r8/) + kbo(:, 1,15, 8) = (/ & + &9.7042e-01_r8,7.3947e-01_r8,5.1034e-01_r8,2.6949e-01_r8,9.7938e-03_r8/) + kbo(:, 2,15, 8) = (/ & + &1.3436e+00_r8,1.0262e+00_r8,7.0874e-01_r8,3.7517e-01_r8,1.2203e-02_r8/) + kbo(:, 3,15, 8) = (/ & + &1.8449e+00_r8,1.4109e+00_r8,9.7248e-01_r8,5.1316e-01_r8,1.4807e-02_r8/) + kbo(:, 4,15, 8) = (/ & + &2.4626e+00_r8,1.8840e+00_r8,1.3006e+00_r8,6.9030e-01_r8,1.7518e-02_r8/) + kbo(:, 5,15, 8) = (/ & + &3.2241e+00_r8,2.4640e+00_r8,1.6957e+00_r8,8.9766e-01_r8,2.0767e-02_r8/) + kbo(:, 1,16, 8) = (/ & + &8.2995e-01_r8,6.3671e-01_r8,4.3954e-01_r8,2.3206e-01_r8,8.0720e-03_r8/) + kbo(:, 2,16, 8) = (/ & + &1.1570e+00_r8,8.8835e-01_r8,6.1260e-01_r8,3.2369e-01_r8,1.0091e-02_r8/) + kbo(:, 3,16, 8) = (/ & + &1.5781e+00_r8,1.2128e+00_r8,8.3725e-01_r8,4.4354e-01_r8,1.2349e-02_r8/) + kbo(:, 4,16, 8) = (/ & + &2.1038e+00_r8,1.6176e+00_r8,1.1171e+00_r8,5.9216e-01_r8,1.4755e-02_r8/) + kbo(:, 5,16, 8) = (/ & + &2.7385e+00_r8,2.1023e+00_r8,1.4490e+00_r8,7.6892e-01_r8,1.7667e-02_r8/) + kbo(:, 1,17, 8) = (/ & + &7.0692e-01_r8,5.4586e-01_r8,3.7661e-01_r8,1.9889e-01_r8,6.7483e-03_r8/) + kbo(:, 2,17, 8) = (/ & + &9.8295e-01_r8,7.5893e-01_r8,5.2307e-01_r8,2.7659e-01_r8,8.4850e-03_r8/) + kbo(:, 3,17, 8) = (/ & + &1.3367e+00_r8,1.0327e+00_r8,7.1373e-01_r8,3.7884e-01_r8,1.0478e-02_r8/) + kbo(:, 4,17, 8) = (/ & + &1.7756e+00_r8,1.3697e+00_r8,9.4344e-01_r8,4.9980e-01_r8,1.2797e-02_r8/) + kbo(:, 5,17, 8) = (/ & + &2.3127e+00_r8,1.7838e+00_r8,1.2303e+00_r8,6.5347e-01_r8,1.5355e-02_r8/) + kbo(:, 1,18, 8) = (/ & + &5.9108e-01_r8,4.5836e-01_r8,3.1625e-01_r8,1.6744e-01_r8,5.7287e-03_r8/) + kbo(:, 2,18, 8) = (/ & + &8.2052e-01_r8,6.3681e-01_r8,4.3945e-01_r8,2.3289e-01_r8,7.3032e-03_r8/) + kbo(:, 3,18, 8) = (/ & + &1.1131e+00_r8,8.6338e-01_r8,5.9577e-01_r8,3.1578e-01_r8,9.0895e-03_r8/) + kbo(:, 4,18, 8) = (/ & + &1.4765e+00_r8,1.1444e+00_r8,7.8909e-01_r8,4.1827e-01_r8,1.1179e-02_r8/) + kbo(:, 5,18, 8) = (/ & + &1.9250e+00_r8,1.4898e+00_r8,1.0284e+00_r8,5.4576e-01_r8,1.3498e-02_r8/) + kbo(:, 1,19, 8) = (/ & + &5.0114e-01_r8,3.9028e-01_r8,2.6968e-01_r8,1.4303e-01_r8,5.0299e-03_r8/) + kbo(:, 2,19, 8) = (/ & + &6.9768e-01_r8,5.4308e-01_r8,3.7493e-01_r8,1.9896e-01_r8,6.4752e-03_r8/) + kbo(:, 3,19, 8) = (/ & + &9.4555e-01_r8,7.3537e-01_r8,5.0733e-01_r8,2.6864e-01_r8,8.1323e-03_r8/) + kbo(:, 4,19, 8) = (/ & + &1.2515e+00_r8,9.7204e-01_r8,6.7090e-01_r8,3.5577e-01_r8,1.0007e-02_r8/) + kbo(:, 5,19, 8) = (/ & + &1.6326e+00_r8,1.2674e+00_r8,8.7478e-01_r8,4.6363e-01_r8,1.2144e-02_r8/) + kbo(:, 1,20, 8) = (/ & + &4.3618e-01_r8,3.4070e-01_r8,2.3544e-01_r8,1.2514e-01_r8,4.4918e-03_r8/) + kbo(:, 2,20, 8) = (/ & + &6.0844e-01_r8,4.7506e-01_r8,3.2779e-01_r8,1.7405e-01_r8,5.8213e-03_r8/) + kbo(:, 3,20, 8) = (/ & + &8.2504e-01_r8,6.4315e-01_r8,4.4377e-01_r8,2.3521e-01_r8,7.3449e-03_r8/) + kbo(:, 4,20, 8) = (/ & + &1.0904e+00_r8,8.4892e-01_r8,5.8560e-01_r8,3.1033e-01_r8,9.1136e-03_r8/) + kbo(:, 5,20, 8) = (/ & + &1.4182e+00_r8,1.1040e+00_r8,7.6212e-01_r8,4.0404e-01_r8,1.1084e-02_r8/) + kbo(:, 1,21, 8) = (/ & + &3.8157e-01_r8,2.9889e-01_r8,2.0662e-01_r8,1.0989e-01_r8,4.0172e-03_r8/) + kbo(:, 2,21, 8) = (/ & + &5.3249e-01_r8,4.1652e-01_r8,2.8764e-01_r8,1.5288e-01_r8,5.2442e-03_r8/) + kbo(:, 3,21, 8) = (/ & + &7.2280e-01_r8,5.6456e-01_r8,3.8951e-01_r8,2.0661e-01_r8,6.6692e-03_r8/) + kbo(:, 4,21, 8) = (/ & + &9.5675e-01_r8,7.4634e-01_r8,5.1474e-01_r8,2.7285e-01_r8,8.2754e-03_r8/) + kbo(:, 5,21, 8) = (/ & + &1.2430e+00_r8,9.6862e-01_r8,6.6782e-01_r8,3.5364e-01_r8,1.0090e-02_r8/) + kbo(:, 1,22, 8) = (/ & + &3.4101e-01_r8,2.6749e-01_r8,1.8491e-01_r8,9.8339e-02_r8,3.6398e-03_r8/) + kbo(:, 2,22, 8) = (/ & + &4.7480e-01_r8,3.7184e-01_r8,2.5674e-01_r8,1.3643e-01_r8,4.7506e-03_r8/) + kbo(:, 3,22, 8) = (/ & + &6.4273e-01_r8,5.0295e-01_r8,3.4722e-01_r8,1.8435e-01_r8,6.0333e-03_r8/) + kbo(:, 4,22, 8) = (/ & + &8.5104e-01_r8,6.6530e-01_r8,4.5905e-01_r8,2.4340e-01_r8,7.4888e-03_r8/) + kbo(:, 5,22, 8) = (/ & + &1.1079e+00_r8,8.6526e-01_r8,5.9621e-01_r8,3.1544e-01_r8,9.1269e-03_r8/) + kbo(:, 1,23, 8) = (/ & + &3.0421e-01_r8,2.3897e-01_r8,1.6516e-01_r8,8.7923e-02_r8,3.2631e-03_r8/) + kbo(:, 2,23, 8) = (/ & + &4.2200e-01_r8,3.3116e-01_r8,2.2888e-01_r8,1.2169e-01_r8,4.2529e-03_r8/) + kbo(:, 3,23, 8) = (/ & + &5.7072e-01_r8,4.4747e-01_r8,3.0900e-01_r8,1.6407e-01_r8,5.3912e-03_r8/) + kbo(:, 4,23, 8) = (/ & + &7.5672e-01_r8,5.9253e-01_r8,4.0891e-01_r8,2.1688e-01_r8,6.6960e-03_r8/) + kbo(:, 5,23, 8) = (/ & + &9.8731e-01_r8,7.7239e-01_r8,5.3220e-01_r8,2.8204e-01_r8,8.2651e-03_r8/) + kbo(:, 1,24, 8) = (/ & + &2.7335e-01_r8,2.1493e-01_r8,1.4863e-01_r8,7.9120e-02_r8,2.9206e-03_r8/) + kbo(:, 2,24, 8) = (/ & + &3.7818e-01_r8,2.9704e-01_r8,2.0533e-01_r8,1.0922e-01_r8,3.7959e-03_r8/) + kbo(:, 3,24, 8) = (/ & + &5.1197e-01_r8,4.0167e-01_r8,2.7730e-01_r8,1.4723e-01_r8,4.8218e-03_r8/) + kbo(:, 4,24, 8) = (/ & + &6.8021e-01_r8,5.3323e-01_r8,3.6769e-01_r8,1.9508e-01_r8,6.0367e-03_r8/) + kbo(:, 5,24, 8) = (/ & + &8.8740e-01_r8,6.9520e-01_r8,4.7892e-01_r8,2.5373e-01_r8,7.4083e-03_r8/) + kbo(:, 1,25, 8) = (/ & + &2.4667e-01_r8,1.9408e-01_r8,1.3424e-01_r8,7.1436e-02_r8,2.6098e-03_r8/) + kbo(:, 2,25, 8) = (/ & + &3.4107e-01_r8,2.6809e-01_r8,1.8527e-01_r8,9.8480e-02_r8,3.3820e-03_r8/) + kbo(:, 3,25, 8) = (/ & + &4.6237e-01_r8,3.6308e-01_r8,2.5057e-01_r8,1.3298e-01_r8,4.3157e-03_r8/) + kbo(:, 4,25, 8) = (/ & + &6.1385e-01_r8,4.8168e-01_r8,3.3224e-01_r8,1.7632e-01_r8,5.3399e-03_r8/) + kbo(:, 5,25, 8) = (/ & + &7.9905e-01_r8,6.2682e-01_r8,4.3186e-01_r8,2.2913e-01_r8,6.4913e-03_r8/) + kbo(:, 1,26, 8) = (/ & + &2.2404e-01_r8,1.7649e-01_r8,1.2214e-01_r8,6.5022e-02_r8,2.3384e-03_r8/) + kbo(:, 2,26, 8) = (/ & + &3.1013e-01_r8,2.4403e-01_r8,1.6870e-01_r8,8.9741e-02_r8,3.0179e-03_r8/) + kbo(:, 3,26, 8) = (/ & + &4.2049e-01_r8,3.3066e-01_r8,2.2838e-01_r8,1.2138e-01_r8,3.8039e-03_r8/) + kbo(:, 4,26, 8) = (/ & + &5.5790e-01_r8,4.3821e-01_r8,3.0237e-01_r8,1.6056e-01_r8,4.6658e-03_r8/) + kbo(:, 5,26, 8) = (/ & + &7.2377e-01_r8,5.6837e-01_r8,3.9196e-01_r8,2.0795e-01_r8,5.6275e-03_r8/) + kbo(:, 1,27, 8) = (/ & + &2.0411e-01_r8,1.6088e-01_r8,1.1131e-01_r8,5.9303e-02_r8,2.0568e-03_r8/) + kbo(:, 2,27, 8) = (/ & + &2.8256e-01_r8,2.2260e-01_r8,1.5392e-01_r8,8.1961e-02_r8,2.6349e-03_r8/) + kbo(:, 3,27, 8) = (/ & + &3.8251e-01_r8,3.0112e-01_r8,2.0805e-01_r8,1.1068e-01_r8,3.2772e-03_r8/) + kbo(:, 4,27, 8) = (/ & + &5.0562e-01_r8,3.9785e-01_r8,2.7464e-01_r8,1.4598e-01_r8,4.0077e-03_r8/) + kbo(:, 5,27, 8) = (/ & + &6.5445e-01_r8,5.1441e-01_r8,3.5497e-01_r8,1.8851e-01_r8,4.8055e-03_r8/) + kbo(:, 1,28, 8) = (/ & + &1.8628e-01_r8,1.4699e-01_r8,1.0171e-01_r8,5.4235e-02_r8,1.7799e-03_r8/) + kbo(:, 2,28, 8) = (/ & + &2.5749e-01_r8,2.0322e-01_r8,1.4053e-01_r8,7.4881e-02_r8,2.2515e-03_r8/) + kbo(:, 3,28, 8) = (/ & + &3.4728e-01_r8,2.7380e-01_r8,1.8920e-01_r8,1.0075e-01_r8,2.7863e-03_r8/) + kbo(:, 4,28, 8) = (/ & + &4.5755e-01_r8,3.6044e-01_r8,2.4894e-01_r8,1.3243e-01_r8,3.3903e-03_r8/) + kbo(:, 5,28, 8) = (/ & + &5.9045e-01_r8,4.6494e-01_r8,3.2101e-01_r8,1.7052e-01_r8,4.0404e-03_r8/) + kbo(:, 1,29, 8) = (/ & + &1.6897e-01_r8,1.3358e-01_r8,9.2501e-02_r8,4.9422e-02_r8,1.5070e-03_r8/) + kbo(:, 2,29, 8) = (/ & + &2.3294e-01_r8,1.8406e-01_r8,1.2733e-01_r8,6.7942e-02_r8,1.8975e-03_r8/) + kbo(:, 3,29, 8) = (/ & + &3.1307e-01_r8,2.4704e-01_r8,1.7081e-01_r8,9.1043e-02_r8,2.3375e-03_r8/) + kbo(:, 4,29, 8) = (/ & + &4.1126e-01_r8,3.2432e-01_r8,2.2417e-01_r8,1.1931e-01_r8,2.8199e-03_r8/) + kbo(:, 5,29, 8) = (/ & + &5.2992e-01_r8,4.1770e-01_r8,2.8860e-01_r8,1.5337e-01_r8,3.3535e-03_r8/) + kbo(:, 1,30, 8) = (/ & + &1.5242e-01_r8,1.2071e-01_r8,8.3664e-02_r8,4.4778e-02_r8,1.2669e-03_r8/) + kbo(:, 2,30, 8) = (/ & + &2.0927e-01_r8,1.6559e-01_r8,1.1465e-01_r8,6.1290e-02_r8,1.5824e-03_r8/) + kbo(:, 3,30, 8) = (/ & + &2.8036e-01_r8,2.2167e-01_r8,1.5340e-01_r8,8.1865e-02_r8,1.9342e-03_r8/) + kbo(:, 4,30, 8) = (/ & + &3.6796e-01_r8,2.9065e-01_r8,2.0100e-01_r8,1.0707e-01_r8,2.3143e-03_r8/) + kbo(:, 5,30, 8) = (/ & + &4.7407e-01_r8,3.7431e-01_r8,2.5849e-01_r8,1.3745e-01_r8,2.7612e-03_r8/) + kbo(:, 1,31, 8) = (/ & + &1.3611e-01_r8,1.0796e-01_r8,7.4865e-02_r8,4.0122e-02_r8,1.0479e-03_r8/) + kbo(:, 2,31, 8) = (/ & + &1.8611e-01_r8,1.4751e-01_r8,1.0224e-01_r8,5.4734e-02_r8,1.2997e-03_r8/) + kbo(:, 3,31, 8) = (/ & + &2.4882e-01_r8,1.9706e-01_r8,1.3650e-01_r8,7.2954e-02_r8,1.5789e-03_r8/) + kbo(:, 4,31, 8) = (/ & + &3.2631e-01_r8,2.5819e-01_r8,1.7872e-01_r8,9.5286e-02_r8,1.8990e-03_r8/) + kbo(:, 5,31, 8) = (/ & + &4.2088e-01_r8,3.3264e-01_r8,2.2986e-01_r8,1.2231e-01_r8,2.2523e-03_r8/) + kbo(:, 1,32, 8) = (/ & + &1.2210e-01_r8,9.6994e-02_r8,6.7326e-02_r8,3.6123e-02_r8,8.5904e-04_r8/) + kbo(:, 2,32, 8) = (/ & + &1.6652e-01_r8,1.3210e-01_r8,9.1670e-02_r8,4.9107e-02_r8,1.0623e-03_r8/) + kbo(:, 3,32, 8) = (/ & + &2.2222e-01_r8,1.7626e-01_r8,1.2220e-01_r8,6.5357e-02_r8,1.2931e-03_r8/) + kbo(:, 4,32, 8) = (/ & + &2.9160e-01_r8,2.3096e-01_r8,1.5993e-01_r8,8.5342e-02_r8,1.5468e-03_r8/) + kbo(:, 5,32, 8) = (/ & + &3.7617e-01_r8,2.9768e-01_r8,2.0589e-01_r8,1.0971e-01_r8,1.8394e-03_r8/) + kbo(:, 1,33, 8) = (/ & + &1.0986e-01_r8,8.7382e-02_r8,6.0737e-02_r8,3.2609e-02_r8,7.0177e-04_r8/) + kbo(:, 2,33, 8) = (/ & + &1.4961e-01_r8,1.1887e-01_r8,8.2542e-02_r8,4.4260e-02_r8,8.6489e-04_r8/) + kbo(:, 3,33, 8) = (/ & + &1.9974e-01_r8,1.5861e-01_r8,1.0995e-01_r8,5.8836e-02_r8,1.0533e-03_r8/) + kbo(:, 4,33, 8) = (/ & + &2.6219e-01_r8,2.0793e-01_r8,1.4396e-01_r8,7.6884e-02_r8,1.2624e-03_r8/) + kbo(:, 5,33, 8) = (/ & + &3.3855e-01_r8,2.6852e-01_r8,1.8574e-01_r8,9.9060e-02_r8,1.4976e-03_r8/) + kbo(:, 1,34, 8) = (/ & + &9.9355e-02_r8,7.9091e-02_r8,5.5001e-02_r8,2.9534e-02_r8,5.8155e-04_r8/) + kbo(:, 2,34, 8) = (/ & + &1.3530e-01_r8,1.0764e-01_r8,7.4771e-02_r8,4.0076e-02_r8,7.1503e-04_r8/) + kbo(:, 3,34, 8) = (/ & + &1.8087e-01_r8,1.4373e-01_r8,9.9666e-02_r8,5.3339e-02_r8,8.6827e-04_r8/) + kbo(:, 4,34, 8) = (/ & + &2.3750e-01_r8,1.8867e-01_r8,1.3063e-01_r8,6.9822e-02_r8,1.0409e-03_r8/) + kbo(:, 5,34, 8) = (/ & + &3.0762e-01_r8,2.4432e-01_r8,1.6897e-01_r8,9.0140e-02_r8,1.2357e-03_r8/) + kbo(:, 1,35, 8) = (/ & + &8.7519e-02_r8,6.9769e-02_r8,4.8552e-02_r8,2.6085e-02_r8,4.6868e-04_r8/) + kbo(:, 2,35, 8) = (/ & + &1.1953e-01_r8,9.5204e-02_r8,6.6129e-02_r8,3.5470e-02_r8,5.7740e-04_r8/) + kbo(:, 3,35, 8) = (/ & + &1.6035e-01_r8,1.2756e-01_r8,8.8463e-02_r8,4.7361e-02_r8,7.0118e-04_r8/) + kbo(:, 4,35, 8) = (/ & + &2.1123e-01_r8,1.6801e-01_r8,1.1639e-01_r8,6.2235e-02_r8,8.4220e-04_r8/) + kbo(:, 5,35, 8) = (/ & + &2.7484e-01_r8,2.1861e-01_r8,1.5121e-01_r8,8.0717e-02_r8,1.0033e-03_r8/) + kbo(:, 1,36, 8) = (/ & + &7.4849e-02_r8,5.9737e-02_r8,4.1593e-02_r8,2.2353e-02_r8,3.6660e-04_r8/) + kbo(:, 2,36, 8) = (/ & + &1.0278e-01_r8,8.1972e-02_r8,5.6955e-02_r8,3.0544e-02_r8,4.5336e-04_r8/) + kbo(:, 3,36, 8) = (/ & + &1.3843e-01_r8,1.1029e-01_r8,7.6519e-02_r8,4.1000e-02_r8,5.5390e-04_r8/) + kbo(:, 4,36, 8) = (/ & + &1.8385e-01_r8,1.4649e-01_r8,1.0149e-01_r8,5.4257e-02_r8,6.6682e-04_r8/) + kbo(:, 5,36, 8) = (/ & + &2.4059e-01_r8,1.9160e-01_r8,1.3256e-01_r8,7.0808e-02_r8,7.9593e-04_r8/) + kbo(:, 1,37, 8) = (/ & + &6.1778e-02_r8,4.9350e-02_r8,3.4377e-02_r8,1.8481e-02_r8,2.8834e-04_r8/) + kbo(:, 2,37, 8) = (/ & + &8.5595e-02_r8,6.8343e-02_r8,4.7513e-02_r8,2.5474e-02_r8,3.5693e-04_r8/) + kbo(:, 3,37, 8) = (/ & + &1.1627e-01_r8,9.2744e-02_r8,6.4387e-02_r8,3.4481e-02_r8,4.3707e-04_r8/) + kbo(:, 4,37, 8) = (/ & + &1.5562e-01_r8,1.2411e-01_r8,8.6025e-02_r8,4.6007e-02_r8,5.2965e-04_r8/) + kbo(:, 5,37, 8) = (/ & + &2.0514e-01_r8,1.6357e-01_r8,1.1324e-01_r8,6.0461e-02_r8,6.3315e-04_r8/) + kbo(:, 1,38, 8) = (/ & + &5.0881e-02_r8,4.0678e-02_r8,2.8356e-02_r8,1.5247e-02_r8,2.2603e-04_r8/) + kbo(:, 2,38, 8) = (/ & + &7.1115e-02_r8,5.6873e-02_r8,3.9548e-02_r8,2.1211e-02_r8,2.8054e-04_r8/) + kbo(:, 3,38, 8) = (/ & + &9.7490e-02_r8,7.7896e-02_r8,5.4103e-02_r8,2.8959e-02_r8,3.4399e-04_r8/) + kbo(:, 4,38, 8) = (/ & + &1.3157e-01_r8,1.0506e-01_r8,7.2849e-02_r8,3.8945e-02_r8,4.1860e-04_r8/) + kbo(:, 5,38, 8) = (/ & + &1.7483e-01_r8,1.3966e-01_r8,9.6758e-02_r8,5.1645e-02_r8,5.0365e-04_r8/) + kbo(:, 1,39, 8) = (/ & + &4.1872e-02_r8,3.3548e-02_r8,2.3398e-02_r8,1.2576e-02_r8,1.7614e-04_r8/) + kbo(:, 2,39, 8) = (/ & + &5.9094e-02_r8,4.7316e-02_r8,3.2924e-02_r8,1.7662e-02_r8,2.1952e-04_r8/) + kbo(:, 3,39, 8) = (/ & + &8.1814e-02_r8,6.5458e-02_r8,4.5468e-02_r8,2.4343e-02_r8,2.7005e-04_r8/) + kbo(:, 4,39, 8) = (/ & + &1.1129e-01_r8,8.9026e-02_r8,6.1776e-02_r8,3.3031e-02_r8,3.3030e-04_r8/) + kbo(:, 5,39, 8) = (/ & + &1.4922e-01_r8,1.1944e-01_r8,8.2784e-02_r8,4.4132e-02_r8,4.0030e-04_r8/) + kbo(:, 1,40, 8) = (/ & + &3.3647e-02_r8,2.6996e-02_r8,1.8830e-02_r8,1.0123e-02_r8,1.3664e-04_r8/) + kbo(:, 2,40, 8) = (/ & + &4.8077e-02_r8,3.8535e-02_r8,2.6836e-02_r8,1.4394e-02_r8,1.7115e-04_r8/) + kbo(:, 3,40, 8) = (/ & + &6.7356e-02_r8,5.3948e-02_r8,3.7498e-02_r8,2.0063e-02_r8,2.1194e-04_r8/) + kbo(:, 4,40, 8) = (/ & + &9.2612e-02_r8,7.4161e-02_r8,5.1473e-02_r8,2.7514e-02_r8,2.6017e-04_r8/) + kbo(:, 5,40, 8) = (/ & + &1.2534e-01_r8,1.0040e-01_r8,6.9623e-02_r8,3.7148e-02_r8,3.1694e-04_r8/) + kbo(:, 1,41, 8) = (/ & + &2.6919e-02_r8,2.1625e-02_r8,1.5091e-02_r8,8.1073e-03_r8,1.0569e-04_r8/) + kbo(:, 2,41, 8) = (/ & + &3.8959e-02_r8,3.1258e-02_r8,2.1769e-02_r8,1.1674e-02_r8,1.3335e-04_r8/) + kbo(:, 3,41, 8) = (/ & + &5.5227e-02_r8,4.4304e-02_r8,3.0810e-02_r8,1.6485e-02_r8,1.6620e-04_r8/) + kbo(:, 4,41, 8) = (/ & + &7.6819e-02_r8,6.1609e-02_r8,4.2770e-02_r8,2.2843e-02_r8,2.0484e-04_r8/) + kbo(:, 5,41, 8) = (/ & + &1.0504e-01_r8,8.4290e-02_r8,5.8439e-02_r8,3.1171e-02_r8,2.5031e-04_r8/) + kbo(:, 1,42, 8) = (/ & + &2.1470e-02_r8,1.7281e-02_r8,1.2058e-02_r8,6.4788e-03_r8,8.1238e-05_r8/) + kbo(:, 2,42, 8) = (/ & + &3.1494e-02_r8,2.5316e-02_r8,1.7631e-02_r8,9.4523e-03_r8,1.0344e-04_r8/) + kbo(:, 3,42, 8) = (/ & + &4.5222e-02_r8,3.6333e-02_r8,2.5262e-02_r8,1.3522e-02_r8,1.2977e-04_r8/) + kbo(:, 4,42, 8) = (/ & + &6.3644e-02_r8,5.1128e-02_r8,3.5506e-02_r8,1.8951e-02_r8,1.6105e-04_r8/) + kbo(:, 5,42, 8) = (/ & + &8.7974e-02_r8,7.0671e-02_r8,4.9043e-02_r8,2.6143e-02_r8,1.9719e-04_r8/) + kbo(:, 1,43, 8) = (/ & + &1.6861e-02_r8,1.3590e-02_r8,9.4853e-03_r8,5.0945e-03_r8,6.1844e-05_r8/) + kbo(:, 2,43, 8) = (/ & + &2.5102e-02_r8,2.0210e-02_r8,1.4080e-02_r8,7.5450e-03_r8,7.9573e-05_r8/) + kbo(:, 3,43, 8) = (/ & + &3.6570e-02_r8,2.9430e-02_r8,2.0473e-02_r8,1.0954e-02_r8,1.0063e-04_r8/) + kbo(:, 4,43, 8) = (/ & + &5.2231e-02_r8,4.1980e-02_r8,2.9163e-02_r8,1.5562e-02_r8,1.2552e-04_r8/) + kbo(:, 5,43, 8) = (/ & + &7.3055e-02_r8,5.8741e-02_r8,4.0761e-02_r8,2.1719e-02_r8,1.5491e-04_r8/) + kbo(:, 1,44, 8) = (/ & + &1.3112e-02_r8,1.0583e-02_r8,7.3867e-03_r8,3.9656e-03_r8,4.6708e-05_r8/) + kbo(:, 2,44, 8) = (/ & + &1.9838e-02_r8,1.5995e-02_r8,1.1144e-02_r8,5.9703e-03_r8,6.0776e-05_r8/) + kbo(:, 3,44, 8) = (/ & + &2.9345e-02_r8,2.3649e-02_r8,1.6458e-02_r8,8.7984e-03_r8,7.7487e-05_r8/) + kbo(:, 4,44, 8) = (/ & + &4.2542e-02_r8,3.4237e-02_r8,2.3782e-02_r8,1.2696e-02_r8,9.7391e-05_r8/) + kbo(:, 5,44, 8) = (/ & + &6.0327e-02_r8,4.8544e-02_r8,3.3677e-02_r8,1.7934e-02_r8,1.2115e-04_r8/) + kbo(:, 1,45, 8) = (/ & + &1.0146e-02_r8,8.1985e-03_r8,5.7225e-03_r8,3.0712e-03_r8,3.5068e-05_r8/) + kbo(:, 2,45, 8) = (/ & + &1.5607e-02_r8,1.2601e-02_r8,8.7806e-03_r8,4.7019e-03_r8,4.6144e-05_r8/) + kbo(:, 3,45, 8) = (/ & + &2.3451e-02_r8,1.8930e-02_r8,1.3177e-02_r8,7.0434e-03_r8,5.9457e-05_r8/) + kbo(:, 4,45, 8) = (/ & + &3.4514e-02_r8,2.7825e-02_r8,1.9327e-02_r8,1.0311e-02_r8,7.5434e-05_r8/) + kbo(:, 5,45, 8) = (/ & + &4.9675e-02_r8,4.0043e-02_r8,2.7784e-02_r8,1.4786e-02_r8,9.4540e-05_r8/) + kbo(:, 1,46, 8) = (/ & + &7.7351e-03_r8,6.2590e-03_r8,4.3712e-03_r8,2.3470e-03_r8,2.6024e-05_r8/) + kbo(:, 2,46, 8) = (/ & + &1.2117e-02_r8,9.8019e-03_r8,6.8312e-03_r8,3.6581e-03_r8,3.4737e-05_r8/) + kbo(:, 3,46, 8) = (/ & + &1.8521e-02_r8,1.4972e-02_r8,1.0423e-02_r8,5.5707e-03_r8,4.5227e-05_r8/) + kbo(:, 4,46, 8) = (/ & + &2.7718e-02_r8,2.2376e-02_r8,1.5549e-02_r8,8.2942e-03_r8,5.8064e-05_r8/) + kbo(:, 5,46, 8) = (/ & + &4.0521e-02_r8,3.2720e-02_r8,2.2708e-02_r8,1.2084e-02_r8,7.3480e-05_r8/) + kbo(:, 1,47, 8) = (/ & + &5.7592e-03_r8,4.6672e-03_r8,3.2593e-03_r8,1.7501e-03_r8,1.9095e-05_r8/) + kbo(:, 2,47, 8) = (/ & + &9.2060e-03_r8,7.4576e-03_r8,5.1997e-03_r8,2.7848e-03_r8,2.5839e-05_r8/) + kbo(:, 3,47, 8) = (/ & + &1.4346e-02_r8,1.1614e-02_r8,8.0835e-03_r8,4.3208e-03_r8,3.4203e-05_r8/) + kbo(:, 4,47, 8) = (/ & + &2.1845e-02_r8,1.7678e-02_r8,1.2284e-02_r8,6.5493e-03_r8,4.4407e-05_r8/) + kbo(:, 5,47, 8) = (/ & + &3.2496e-02_r8,2.6280e-02_r8,1.8234e-02_r8,9.7018e-03_r8,5.6773e-05_r8/) + kbo(:, 1,48, 8) = (/ & + &4.2511e-03_r8,3.4498e-03_r8,2.4093e-03_r8,1.2936e-03_r8,1.3859e-05_r8/) + kbo(:, 2,48, 8) = (/ & + &6.9347e-03_r8,5.6254e-03_r8,3.9226e-03_r8,2.1019e-03_r8,1.9117e-05_r8/) + kbo(:, 3,48, 8) = (/ & + &1.1018e-02_r8,8.9390e-03_r8,6.2242e-03_r8,3.3284e-03_r8,2.5648e-05_r8/) + kbo(:, 4,48, 8) = (/ & + &1.7113e-02_r8,1.3870e-02_r8,9.6439e-03_r8,5.1401e-03_r8,3.3736e-05_r8/) + kbo(:, 5,48, 8) = (/ & + &2.5919e-02_r8,2.1005e-02_r8,1.4575e-02_r8,7.7539e-03_r8,4.3617e-05_r8/) + kbo(:, 1,49, 8) = (/ & + &3.1098e-03_r8,2.5273e-03_r8,1.7645e-03_r8,9.4708e-04_r8,9.9370e-06_r8/) + kbo(:, 2,49, 8) = (/ & + &5.1784e-03_r8,4.2068e-03_r8,2.9339e-03_r8,1.5725e-03_r8,1.3987e-05_r8/) + kbo(:, 3,49, 8) = (/ & + &8.3947e-03_r8,6.8228e-03_r8,4.7538e-03_r8,2.5418e-03_r8,1.9085e-05_r8/) + kbo(:, 4,49, 8) = (/ & + &1.3293e-02_r8,1.0799e-02_r8,7.5113e-03_r8,4.0058e-03_r8,2.5451e-05_r8/) + kbo(:, 5,49, 8) = (/ & + &2.0521e-02_r8,1.6668e-02_r8,1.1574e-02_r8,6.1522e-03_r8,3.3363e-05_r8/) + kbo(:, 1,50, 8) = (/ & + &2.2918e-03_r8,1.8636e-03_r8,1.3008e-03_r8,6.9789e-04_r8,7.1979e-06_r8/) + kbo(:, 2,50, 8) = (/ & + &3.8913e-03_r8,3.1670e-03_r8,2.2089e-03_r8,1.1842e-03_r8,1.0331e-05_r8/) + kbo(:, 3,50, 8) = (/ & + &6.4390e-03_r8,5.2441e-03_r8,3.6531e-03_r8,1.9538e-03_r8,1.4344e-05_r8/) + kbo(:, 4,50, 8) = (/ & + &1.0397e-02_r8,8.4649e-03_r8,5.8892e-03_r8,3.1423e-03_r8,1.9397e-05_r8/) + kbo(:, 5,50, 8) = (/ & + &1.6371e-02_r8,1.3317e-02_r8,9.2504e-03_r8,4.9185e-03_r8,2.5741e-05_r8/) + kbo(:, 1,51, 8) = (/ & + &1.6928e-03_r8,1.3767e-03_r8,9.6023e-04_r8,5.1382e-04_r8,5.2246e-06_r8/) + kbo(:, 2,51, 8) = (/ & + &2.9272e-03_r8,2.3839e-03_r8,1.6628e-03_r8,8.9103e-04_r8,7.6388e-06_r8/) + kbo(:, 3,51, 8) = (/ & + &4.9429e-03_r8,4.0319e-03_r8,2.8087e-03_r8,1.5020e-03_r8,1.0781e-05_r8/) + kbo(:, 4,51, 8) = (/ & + &8.1364e-03_r8,6.6389e-03_r8,4.6188e-03_r8,2.4654e-03_r8,1.4827e-05_r8/) + kbo(:, 5,51, 8) = (/ & + &1.3068e-02_r8,1.0656e-02_r8,7.4020e-03_r8,3.9372e-03_r8,1.9921e-05_r8/) + kbo(:, 1,52, 8) = (/ & + &1.2399e-03_r8,1.0091e-03_r8,7.0357e-04_r8,3.7650e-04_r8,3.7522e-06_r8/) + kbo(:, 2,52, 8) = (/ & + &2.1899e-03_r8,1.7829e-03_r8,1.2430e-03_r8,6.6579e-04_r8,5.6100e-06_r8/) + kbo(:, 3,52, 8) = (/ & + &3.7665e-03_r8,3.0795e-03_r8,2.1447e-03_r8,1.1464e-03_r8,8.0632e-06_r8/) + kbo(:, 4,52, 8) = (/ & + &6.3261e-03_r8,5.1729e-03_r8,3.5994e-03_r8,1.9224e-03_r8,1.1265e-05_r8/) + kbo(:, 5,52, 8) = (/ & + &1.0363e-02_r8,8.4710e-03_r8,5.8842e-03_r8,3.1302e-03_r8,1.5370e-05_r8/) + kbo(:, 1,53, 8) = (/ & + &9.0216e-04_r8,7.3408e-04_r8,5.1164e-04_r8,2.7340e-04_r8,2.6590e-06_r8/) + kbo(:, 2,53, 8) = (/ & + &1.6262e-03_r8,1.3270e-03_r8,9.2425e-04_r8,4.9425e-04_r8,4.0810e-06_r8/) + kbo(:, 3,53, 8) = (/ & + &2.8513e-03_r8,2.3327e-03_r8,1.6237e-03_r8,8.6789e-04_r8,5.9668e-06_r8/) + kbo(:, 4,53, 8) = (/ & + &4.8843e-03_r8,4.0007e-03_r8,2.7846e-03_r8,1.4866e-03_r8,8.4879e-06_r8/) + kbo(:, 5,53, 8) = (/ & + &8.1619e-03_r8,6.6885e-03_r8,4.6478e-03_r8,2.4735e-03_r8,1.1744e-05_r8/) + kbo(:, 1,54, 8) = (/ & + &6.6939e-04_r8,5.4497e-04_r8,3.7910e-04_r8,2.0225e-04_r8,1.9239e-06_r8/) + kbo(:, 2,54, 8) = (/ & + &1.2278e-03_r8,1.0030e-03_r8,6.9836e-04_r8,3.7314e-04_r8,3.0194e-06_r8/) + kbo(:, 3,54, 8) = (/ & + &2.1984e-03_r8,1.7996e-03_r8,1.2511e-03_r8,6.6777e-04_r8,4.5056e-06_r8/) + kbo(:, 4,54, 8) = (/ & + &3.8331e-03_r8,3.1457e-03_r8,2.1886e-03_r8,1.1687e-03_r8,6.4964e-06_r8/) + kbo(:, 5,54, 8) = (/ & + &6.5432e-03_r8,5.3709e-03_r8,3.7307e-03_r8,1.9859e-03_r8,9.1107e-06_r8/) + kbo(:, 1,55, 8) = (/ & + &5.0111e-04_r8,4.0755e-04_r8,2.8321e-04_r8,1.5081e-04_r8,1.4025e-06_r8/) + kbo(:, 2,55, 8) = (/ & + &9.3502e-04_r8,7.6365e-04_r8,5.3113e-04_r8,2.8338e-04_r8,2.2498e-06_r8/) + kbo(:, 3,55, 8) = (/ & + &1.7077e-03_r8,1.3993e-03_r8,9.7261e-04_r8,5.1891e-04_r8,3.4289e-06_r8/) + kbo(:, 4,55, 8) = (/ & + &3.0342e-03_r8,2.4941e-03_r8,1.7338e-03_r8,9.2454e-04_r8,5.0131e-06_r8/) + kbo(:, 5,55, 8) = (/ & + &5.2834e-03_r8,4.3447e-03_r8,3.0182e-03_r8,1.6053e-03_r8,7.1210e-06_r8/) + kbo(:, 1,56, 8) = (/ & + &3.7616e-04_r8,3.0519e-04_r8,2.1170e-04_r8,1.1247e-04_r8,1.0140e-06_r8/) + kbo(:, 2,56, 8) = (/ & + &7.1281e-04_r8,5.8173e-04_r8,4.0420e-04_r8,2.1505e-04_r8,1.6673e-06_r8/) + kbo(:, 3,56, 8) = (/ & + &1.3229e-03_r8,1.0846e-03_r8,7.5367e-04_r8,4.0126e-04_r8,2.5921e-06_r8/) + kbo(:, 4,56, 8) = (/ & + &2.4034e-03_r8,1.9754e-03_r8,1.3714e-03_r8,7.3027e-04_r8,3.8577e-06_r8/) + kbo(:, 5,56, 8) = (/ & + &4.2589e-03_r8,3.5089e-03_r8,2.4364e-03_r8,1.2956e-03_r8,5.5656e-06_r8/) + kbo(:, 1,57, 8) = (/ & + &2.8163e-04_r8,2.2851e-04_r8,1.5825e-04_r8,8.3801e-05_r8,7.2920e-07_r8/) + kbo(:, 2,57, 8) = (/ & + &5.4316e-04_r8,4.4288e-04_r8,3.0736e-04_r8,1.6324e-04_r8,1.2275e-06_r8/) + kbo(:, 3,57, 8) = (/ & + &1.0242e-03_r8,8.3907e-04_r8,5.8250e-04_r8,3.0984e-04_r8,1.9504e-06_r8/) + kbo(:, 4,57, 8) = (/ & + &1.8977e-03_r8,1.5630e-03_r8,1.0848e-03_r8,5.7691e-04_r8,2.9526e-06_r8/) + kbo(:, 5,57, 8) = (/ & + &3.4290e-03_r8,2.8298e-03_r8,1.9639e-03_r8,1.0437e-03_r8,4.3203e-06_r8/) + kbo(:, 1,58, 8) = (/ & + &1.0299e-04_r8,9.5896e-05_r8,7.7844e-05_r8,4.9788e-05_r8,5.2623e-07_r8/) + kbo(:, 2,58, 8) = (/ & + &2.0307e-04_r8,1.9013e-04_r8,1.5450e-04_r8,9.9035e-05_r8,9.0616e-07_r8/) + kbo(:, 3,58, 8) = (/ & + &3.8839e-04_r8,3.6515e-04_r8,2.9695e-04_r8,1.9078e-04_r8,1.4737e-06_r8/) + kbo(:, 4,58, 8) = (/ & + &7.3294e-04_r8,6.9303e-04_r8,5.6426e-04_r8,3.6255e-04_r8,2.2710e-06_r8/) + kbo(:, 5,58, 8) = (/ & + &1.3532e-03_r8,1.2806e-03_r8,1.0426e-03_r8,6.7017e-04_r8,3.3698e-06_r8/) + kbo(:, 1,59, 8) = (/ & + &8.5450e-05_r8,7.9848e-05_r8,6.5073e-05_r8,4.1875e-05_r8,4.3253e-07_r8/) + kbo(:, 2,59, 8) = (/ & + &1.7170e-04_r8,1.6133e-04_r8,1.3170e-04_r8,8.4866e-05_r8,7.5223e-07_r8/) + kbo(:, 3,59, 8) = (/ & + &3.3324e-04_r8,3.1480e-04_r8,2.5716e-04_r8,1.6610e-04_r8,1.2329e-06_r8/) + kbo(:, 4,59, 8) = (/ & + &6.4000e-04_r8,6.0786e-04_r8,4.9691e-04_r8,3.2112e-04_r8,1.9165e-06_r8/) + kbo(:, 5,59, 8) = (/ & + &1.2020e-03_r8,1.1456e-03_r8,9.3584e-04_r8,6.0398e-04_r8,2.8638e-06_r8/) + kbo(:, 1,13, 9) = (/ & + &7.4699e+00_r8,5.6062e+00_r8,3.7650e+00_r8,1.9560e+00_r8,8.5273e-02_r8/) + kbo(:, 2,13, 9) = (/ & + &1.0680e+01_r8,8.0165e+00_r8,5.3854e+00_r8,2.8036e+00_r8,1.0411e-01_r8/) + kbo(:, 3,13, 9) = (/ & + &1.4623e+01_r8,1.0976e+01_r8,7.3752e+00_r8,3.8391e+00_r8,1.2390e-01_r8/) + kbo(:, 4,13, 9) = (/ & + &1.9264e+01_r8,1.4459e+01_r8,9.7226e+00_r8,5.0654e+00_r8,1.4616e-01_r8/) + kbo(:, 5,13, 9) = (/ & + &2.4629e+01_r8,1.8491e+01_r8,1.2437e+01_r8,6.4792e+00_r8,1.7014e-01_r8/) + kbo(:, 1,14, 9) = (/ & + &6.8938e+00_r8,5.1783e+00_r8,3.4875e+00_r8,1.8264e+00_r8,7.6714e-02_r8/) + kbo(:, 2,14, 9) = (/ & + &9.8527e+00_r8,7.4006e+00_r8,4.9851e+00_r8,2.6106e+00_r8,9.2077e-02_r8/) + kbo(:, 3,14, 9) = (/ & + &1.3464e+01_r8,1.0115e+01_r8,6.8188e+00_r8,3.5707e+00_r8,1.0926e-01_r8/) + kbo(:, 4,14, 9) = (/ & + &1.7717e+01_r8,1.3311e+01_r8,8.9749e+00_r8,4.7000e+00_r8,1.2815e-01_r8/) + kbo(:, 5,14, 9) = (/ & + &2.2681e+01_r8,1.7041e+01_r8,1.1492e+01_r8,6.0178e+00_r8,1.4885e-01_r8/) + kbo(:, 1,15, 9) = (/ & + &6.1047e+00_r8,4.5908e+00_r8,3.1074e+00_r8,1.6392e+00_r8,6.2768e-02_r8/) + kbo(:, 2,15, 9) = (/ & + &8.7019e+00_r8,6.5442e+00_r8,4.4301e+00_r8,2.3356e+00_r8,7.5768e-02_r8/) + kbo(:, 3,15, 9) = (/ & + &1.1847e+01_r8,8.9091e+00_r8,6.0354e+00_r8,3.1840e+00_r8,9.0152e-02_r8/) + kbo(:, 4,15, 9) = (/ & + &1.5627e+01_r8,1.1753e+01_r8,7.9592e+00_r8,4.1918e+00_r8,1.0596e-01_r8/) + kbo(:, 5,15, 9) = (/ & + &2.0065e+01_r8,1.5096e+01_r8,1.0229e+01_r8,5.3867e+00_r8,1.2348e-01_r8/) + kbo(:, 1,16, 9) = (/ & + &5.2710e+00_r8,3.9706e+00_r8,2.7052e+00_r8,1.4383e+00_r8,5.0640e-02_r8/) + kbo(:, 2,16, 9) = (/ & + &7.4843e+00_r8,5.6386e+00_r8,3.8435e+00_r8,2.0428e+00_r8,6.0690e-02_r8/) + kbo(:, 3,16, 9) = (/ & + &1.0203e+01_r8,7.6869e+00_r8,5.2380e+00_r8,2.7809e+00_r8,7.2017e-02_r8/) + kbo(:, 4,16, 9) = (/ & + &1.3478e+01_r8,1.0155e+01_r8,6.9170e+00_r8,3.6687e+00_r8,8.5243e-02_r8/) + kbo(:, 5,16, 9) = (/ & + &1.7365e+01_r8,1.3088e+01_r8,8.9123e+00_r8,4.7182e+00_r8,9.9040e-02_r8/) + kbo(:, 1,17, 9) = (/ & + &4.4902e+00_r8,3.3911e+00_r8,2.3244e+00_r8,1.2481e+00_r8,4.0283e-02_r8/) + kbo(:, 2,17, 9) = (/ & + &6.3739e+00_r8,4.8152e+00_r8,3.3005e+00_r8,1.7693e+00_r8,4.9025e-02_r8/) + kbo(:, 3,17, 9) = (/ & + &8.7028e+00_r8,6.5740e+00_r8,4.5022e+00_r8,2.4070e+00_r8,5.9283e-02_r8/) + kbo(:, 4,17, 9) = (/ & + &1.1530e+01_r8,8.7139e+00_r8,5.9683e+00_r8,3.1839e+00_r8,7.0217e-02_r8/) + kbo(:, 5,17, 9) = (/ & + &1.4910e+01_r8,1.1266e+01_r8,7.7058e+00_r8,4.0973e+00_r8,8.1092e-02_r8/) + kbo(:, 1,18, 9) = (/ & + &3.7512e+00_r8,2.8459e+00_r8,1.9612e+00_r8,1.0622e+00_r8,3.4382e-02_r8/) + kbo(:, 2,18, 9) = (/ & + &5.3265e+00_r8,4.0412e+00_r8,2.7835e+00_r8,1.5026e+00_r8,4.2209e-02_r8/) + kbo(:, 3,18, 9) = (/ & + &7.2937e+00_r8,5.5341e+00_r8,3.8093e+00_r8,2.0485e+00_r8,5.1165e-02_r8/) + kbo(:, 4,18, 9) = (/ & + &9.7044e+00_r8,7.3625e+00_r8,5.0637e+00_r8,2.7136e+00_r8,6.0247e-02_r8/) + kbo(:, 5,18, 9) = (/ & + &1.2597e+01_r8,9.5561e+00_r8,6.5653e+00_r8,3.5052e+00_r8,7.0721e-02_r8/) + kbo(:, 1,19, 9) = (/ & + &3.1949e+00_r8,2.4358e+00_r8,1.6862e+00_r8,9.1523e-01_r8,2.9755e-02_r8/) + kbo(:, 2,19, 9) = (/ & + &4.5382e+00_r8,3.4601e+00_r8,2.3940e+00_r8,1.2945e+00_r8,3.7026e-02_r8/) + kbo(:, 3,19, 9) = (/ & + &6.2344e+00_r8,4.7532e+00_r8,3.2851e+00_r8,1.7697e+00_r8,4.5045e-02_r8/) + kbo(:, 4,19, 9) = (/ & + &8.3349e+00_r8,6.3521e+00_r8,4.3827e+00_r8,2.3518e+00_r8,5.3532e-02_r8/) + kbo(:, 5,19, 9) = (/ & + &1.0858e+01_r8,8.2689e+00_r8,5.6978e+00_r8,3.0490e+00_r8,6.2338e-02_r8/) + kbo(:, 1,20, 9) = (/ & + &2.7983e+00_r8,2.1430e+00_r8,1.4907e+00_r8,8.0787e-01_r8,2.6638e-02_r8/) + kbo(:, 2,20, 9) = (/ & + &3.9801e+00_r8,3.0473e+00_r8,2.1167e+00_r8,1.1423e+00_r8,3.3344e-02_r8/) + kbo(:, 3,20, 9) = (/ & + &5.4854e+00_r8,4.1978e+00_r8,2.9095e+00_r8,1.5650e+00_r8,4.0067e-02_r8/) + kbo(:, 4,20, 9) = (/ & + &7.3522e+00_r8,5.6240e+00_r8,3.8910e+00_r8,2.0868e+00_r8,4.7603e-02_r8/) + kbo(:, 5,20, 9) = (/ & + &9.6006e+00_r8,7.3375e+00_r8,5.0662e+00_r8,2.7087e+00_r8,5.5504e-02_r8/) + kbo(:, 1,21, 9) = (/ & + &2.4723e+00_r8,1.9017e+00_r8,1.3269e+00_r8,7.1717e-01_r8,2.3842e-02_r8/) + kbo(:, 2,21, 9) = (/ & + &3.5234e+00_r8,2.7089e+00_r8,1.8854e+00_r8,1.0156e+00_r8,2.9423e-02_r8/) + kbo(:, 3,21, 9) = (/ & + &4.8624e+00_r8,3.7359e+00_r8,2.5948e+00_r8,1.3934e+00_r8,3.5538e-02_r8/) + kbo(:, 4,21, 9) = (/ & + &6.5245e+00_r8,5.0095e+00_r8,3.4715e+00_r8,1.8586e+00_r8,4.1992e-02_r8/) + kbo(:, 5,21, 9) = (/ & + &8.5269e+00_r8,6.5419e+00_r8,4.5264e+00_r8,2.4180e+00_r8,4.9380e-02_r8/) + kbo(:, 1,22, 9) = (/ & + &2.2453e+00_r8,1.7353e+00_r8,1.2110e+00_r8,6.5234e-01_r8,2.1295e-02_r8/) + kbo(:, 2,22, 9) = (/ & + &3.1933e+00_r8,2.4664e+00_r8,1.7176e+00_r8,9.2252e-01_r8,2.6174e-02_r8/) + kbo(:, 3,22, 9) = (/ & + &4.4012e+00_r8,3.3958e+00_r8,2.3595e+00_r8,1.2638e+00_r8,3.1657e-02_r8/) + kbo(:, 4,22, 9) = (/ & + &5.8834e+00_r8,4.5350e+00_r8,3.1467e+00_r8,1.6824e+00_r8,3.7644e-02_r8/) + kbo(:, 5,22, 9) = (/ & + &7.6501e+00_r8,5.8912e+00_r8,4.0828e+00_r8,2.1806e+00_r8,4.4263e-02_r8/) + kbo(:, 1,23, 9) = (/ & + &2.0571e+00_r8,1.5967e+00_r8,1.1115e+00_r8,5.9605e-01_r8,1.8827e-02_r8/) + kbo(:, 2,23, 9) = (/ & + &2.9057e+00_r8,2.2535e+00_r8,1.5681e+00_r8,8.3999e-01_r8,2.3337e-02_r8/) + kbo(:, 3,23, 9) = (/ & + &3.9800e+00_r8,3.0833e+00_r8,2.1434e+00_r8,1.1464e+00_r8,2.8190e-02_r8/) + kbo(:, 4,23, 9) = (/ & + &5.2885e+00_r8,4.0922e+00_r8,2.8421e+00_r8,1.5182e+00_r8,3.3828e-02_r8/) + kbo(:, 5,23, 9) = (/ & + &6.8471e+00_r8,5.2918e+00_r8,3.6724e+00_r8,1.9594e+00_r8,3.9956e-02_r8/) + kbo(:, 1,24, 9) = (/ & + &1.9070e+00_r8,1.4857e+00_r8,1.0329e+00_r8,5.5181e-01_r8,1.6663e-02_r8/) + kbo(:, 2,24, 9) = (/ & + &2.6677e+00_r8,2.0773e+00_r8,1.4448e+00_r8,7.7214e-01_r8,2.0662e-02_r8/) + kbo(:, 3,24, 9) = (/ & + &3.6252e+00_r8,2.8187e+00_r8,1.9595e+00_r8,1.0463e+00_r8,2.5179e-02_r8/) + kbo(:, 4,24, 9) = (/ & + &4.7921e+00_r8,3.7213e+00_r8,2.5847e+00_r8,1.3784e+00_r8,3.0300e-02_r8/) + kbo(:, 5,24, 9) = (/ & + &6.1875e+00_r8,4.7981e+00_r8,3.3299e+00_r8,1.7738e+00_r8,3.5858e-02_r8/) + kbo(:, 1,25, 9) = (/ & + &1.7679e+00_r8,1.3823e+00_r8,9.6005e-01_r8,5.1215e-01_r8,1.4756e-02_r8/) + kbo(:, 2,25, 9) = (/ & + &2.4506e+00_r8,1.9149e+00_r8,1.3310e+00_r8,7.1009e-01_r8,1.8413e-02_r8/) + kbo(:, 3,25, 9) = (/ & + &3.3092e+00_r8,2.5821e+00_r8,1.7930e+00_r8,9.5566e-01_r8,2.2613e-02_r8/) + kbo(:, 4,25, 9) = (/ & + &4.3581e+00_r8,3.3956e+00_r8,2.3561e+00_r8,1.2539e+00_r8,2.7407e-02_r8/) + kbo(:, 5,25, 9) = (/ & + &5.6148e+00_r8,4.3684e+00_r8,3.0296e+00_r8,1.6108e+00_r8,3.2730e-02_r8/) + kbo(:, 1,26, 9) = (/ & + &1.6550e+00_r8,1.2970e+00_r8,8.9910e-01_r8,4.7856e-01_r8,1.3235e-02_r8/) + kbo(:, 2,26, 9) = (/ & + &2.2724e+00_r8,1.7804e+00_r8,1.2348e+00_r8,6.5702e-01_r8,1.6632e-02_r8/) + kbo(:, 3,26, 9) = (/ & + &3.0501e+00_r8,2.3862e+00_r8,1.6545e+00_r8,8.7945e-01_r8,2.0602e-02_r8/) + kbo(:, 4,26, 9) = (/ & + &3.9998e+00_r8,3.1253e+00_r8,2.1658e+00_r8,1.1505e+00_r8,2.5120e-02_r8/) + kbo(:, 5,26, 9) = (/ & + &5.1417e+00_r8,4.0125e+00_r8,2.7805e+00_r8,1.4756e+00_r8,3.0188e-02_r8/) + kbo(:, 1,27, 9) = (/ & + &1.5517e+00_r8,1.2181e+00_r8,8.4303e-01_r8,4.4762e-01_r8,1.1922e-02_r8/) + kbo(:, 2,27, 9) = (/ & + &2.1187e+00_r8,1.6625e+00_r8,1.1508e+00_r8,6.1078e-01_r8,1.5090e-02_r8/) + kbo(:, 3,27, 9) = (/ & + &2.8285e+00_r8,2.2174e+00_r8,1.5344e+00_r8,8.1390e-01_r8,1.8733e-02_r8/) + kbo(:, 4,27, 9) = (/ & + &3.6946e+00_r8,2.8938e+00_r8,2.0026e+00_r8,1.0611e+00_r8,2.2964e-02_r8/) + kbo(:, 5,27, 9) = (/ & + &4.7297e+00_r8,3.7026e+00_r8,2.5639e+00_r8,1.3585e+00_r8,2.7799e-02_r8/) + kbo(:, 1,28, 9) = (/ & + &1.4557e+00_r8,1.1450e+00_r8,7.9124e-01_r8,4.1922e-01_r8,1.0671e-02_r8/) + kbo(:, 2,28, 9) = (/ & + &1.9807e+00_r8,1.5572e+00_r8,1.0762e+00_r8,5.7024e-01_r8,1.3585e-02_r8/) + kbo(:, 3,28, 9) = (/ & + &2.6353e+00_r8,2.0694e+00_r8,1.4297e+00_r8,7.5652e-01_r8,1.7012e-02_r8/) + kbo(:, 4,28, 9) = (/ & + &3.4268e+00_r8,2.6900e+00_r8,1.8600e+00_r8,9.8357e-01_r8,2.1005e-02_r8/) + kbo(:, 5,28, 9) = (/ & + &4.3754e+00_r8,3.4337e+00_r8,2.3745e+00_r8,1.2550e+00_r8,2.5556e-02_r8/) + kbo(:, 1,29, 9) = (/ & + &1.3575e+00_r8,1.0707e+00_r8,7.3899e-01_r8,3.9163e-01_r8,9.5187e-03_r8/) + kbo(:, 2,29, 9) = (/ & + &1.8443e+00_r8,1.4534e+00_r8,1.0029e+00_r8,5.3089e-01_r8,1.2207e-02_r8/) + kbo(:, 3,29, 9) = (/ & + &2.4443e+00_r8,1.9245e+00_r8,1.3293e+00_r8,7.0249e-01_r8,1.5292e-02_r8/) + kbo(:, 4,29, 9) = (/ & + &3.1715e+00_r8,2.4958e+00_r8,1.7237e+00_r8,9.1036e-01_r8,1.8851e-02_r8/) + kbo(:, 5,29, 9) = (/ & + &4.0410e+00_r8,3.1790e+00_r8,2.1964e+00_r8,1.1590e+00_r8,2.3121e-02_r8/) + kbo(:, 1,30, 9) = (/ & + &1.2615e+00_r8,9.9705e-01_r8,6.8810e-01_r8,3.6451e-01_r8,8.4241e-03_r8/) + kbo(:, 2,30, 9) = (/ & + &1.7102e+00_r8,1.3510e+00_r8,9.3203e-01_r8,4.9262e-01_r8,1.0769e-02_r8/) + kbo(:, 3,30, 9) = (/ & + &2.2602e+00_r8,1.7845e+00_r8,1.2315e+00_r8,6.5024e-01_r8,1.3569e-02_r8/) + kbo(:, 4,30, 9) = (/ & + &2.9275e+00_r8,2.3103e+00_r8,1.5947e+00_r8,8.4085e-01_r8,1.6868e-02_r8/) + kbo(:, 5,30, 9) = (/ & + &3.7272e+00_r8,2.9401e+00_r8,2.0301e+00_r8,1.0701e+00_r8,2.0720e-02_r8/) + kbo(:, 1,31, 9) = (/ & + &1.1628e+00_r8,9.2130e-01_r8,6.3548e-01_r8,3.3629e-01_r8,7.3212e-03_r8/) + kbo(:, 2,31, 9) = (/ & + &1.5710e+00_r8,1.2442e+00_r8,8.5840e-01_r8,4.5341e-01_r8,9.4089e-03_r8/) + kbo(:, 3,31, 9) = (/ & + &2.0741e+00_r8,1.6418e+00_r8,1.1326e+00_r8,5.9743e-01_r8,1.1908e-02_r8/) + kbo(:, 4,31, 9) = (/ & + &2.6838e+00_r8,2.1236e+00_r8,1.4650e+00_r8,7.7246e-01_r8,1.4841e-02_r8/) + kbo(:, 5,31, 9) = (/ & + &3.4158e+00_r8,2.7036e+00_r8,1.8662e+00_r8,9.8360e-01_r8,1.8280e-02_r8/) + kbo(:, 1,32, 9) = (/ & + &1.0770e+00_r8,8.5530e-01_r8,5.8998e-01_r8,3.1205e-01_r8,6.3886e-03_r8/) + kbo(:, 2,32, 9) = (/ & + &1.4521e+00_r8,1.1529e+00_r8,7.9467e-01_r8,4.1942e-01_r8,8.2479e-03_r8/) + kbo(:, 3,32, 9) = (/ & + &1.9141e+00_r8,1.5187e+00_r8,1.0473e+00_r8,5.5229e-01_r8,1.0468e-02_r8/) + kbo(:, 4,32, 9) = (/ & + &2.4773e+00_r8,1.9665e+00_r8,1.3565e+00_r8,7.1494e-01_r8,1.3077e-02_r8/) + kbo(:, 5,32, 9) = (/ & + &3.1536e+00_r8,2.5044e+00_r8,1.7279e+00_r8,9.1011e-01_r8,1.6196e-02_r8/) + kbo(:, 1,33, 9) = (/ & + &1.0004e+00_r8,7.9686e-01_r8,5.4943e-01_r8,2.9036e-01_r8,5.6169e-03_r8/) + kbo(:, 2,33, 9) = (/ & + &1.3472e+00_r8,1.0720e+00_r8,7.3887e-01_r8,3.9002e-01_r8,7.2464e-03_r8/) + kbo(:, 3,33, 9) = (/ & + &1.7767e+00_r8,1.4145e+00_r8,9.7493e-01_r8,5.1400e-01_r8,9.1682e-03_r8/) + kbo(:, 4,33, 9) = (/ & + &2.3006e+00_r8,1.8321e+00_r8,1.2634e+00_r8,6.6568e-01_r8,1.1493e-02_r8/) + kbo(:, 5,33, 9) = (/ & + &2.9306e+00_r8,2.3339e+00_r8,1.6102e+00_r8,8.4827e-01_r8,1.4147e-02_r8/) + kbo(:, 1,34, 9) = (/ & + &9.3256e-01_r8,7.4416e-01_r8,5.1264e-01_r8,2.7079e-01_r8,4.9465e-03_r8/) + kbo(:, 2,34, 9) = (/ & + &1.2561e+00_r8,1.0020e+00_r8,6.9034e-01_r8,3.6434e-01_r8,6.3960e-03_r8/) + kbo(:, 3,34, 9) = (/ & + &1.6587e+00_r8,1.3239e+00_r8,9.1206e-01_r8,4.8092e-01_r8,8.1576e-03_r8/) + kbo(:, 4,34, 9) = (/ & + &2.1501e+00_r8,1.7167e+00_r8,1.1837e+00_r8,6.2351e-01_r8,1.0194e-02_r8/) + kbo(:, 5,34, 9) = (/ & + &2.7413e+00_r8,2.1905e+00_r8,1.5115e+00_r8,7.9635e-01_r8,1.2542e-02_r8/) + kbo(:, 1,35, 9) = (/ & + &8.4840e-01_r8,6.7846e-01_r8,4.6725e-01_r8,2.4678e-01_r8,4.2581e-03_r8/) + kbo(:, 2,35, 9) = (/ & + &1.1466e+00_r8,9.1713e-01_r8,6.3179e-01_r8,3.3319e-01_r8,5.5317e-03_r8/) + kbo(:, 3,35, 9) = (/ & + &1.5185e+00_r8,1.2151e+00_r8,8.3727e-01_r8,4.4133e-01_r8,7.0625e-03_r8/) + kbo(:, 4,35, 9) = (/ & + &1.9737e+00_r8,1.5810e+00_r8,1.0899e+00_r8,5.7421e-01_r8,8.8571e-03_r8/) + kbo(:, 5,35, 9) = (/ & + &2.5262e+00_r8,2.0251e+00_r8,1.3975e+00_r8,7.3625e-01_r8,1.0897e-02_r8/) + kbo(:, 1,36, 9) = (/ & + &7.5165e-01_r8,6.0226e-01_r8,4.1465e-01_r8,2.1892e-01_r8,3.5512e-03_r8/) + kbo(:, 2,36, 9) = (/ & + &1.0210e+00_r8,8.1866e-01_r8,5.6371e-01_r8,2.9729e-01_r8,4.6496e-03_r8/) + kbo(:, 3,36, 9) = (/ & + &1.3584e+00_r8,1.0902e+00_r8,7.5109e-01_r8,3.9583e-01_r8,5.9580e-03_r8/) + kbo(:, 4,36, 9) = (/ & + &1.7752e+00_r8,1.4261e+00_r8,9.8305e-01_r8,5.1817e-01_r8,7.4947e-03_r8/) + kbo(:, 5,36, 9) = (/ & + &2.2842e+00_r8,1.8370e+00_r8,1.2679e+00_r8,6.6806e-01_r8,9.2616e-03_r8/) + kbo(:, 1,37, 9) = (/ & + &6.4071e-01_r8,5.1457e-01_r8,3.5423e-01_r8,1.8691e-01_r8,2.9273e-03_r8/) + kbo(:, 2,37, 9) = (/ & + &8.7819e-01_r8,7.0566e-01_r8,4.8576e-01_r8,2.5612e-01_r8,3.8482e-03_r8/) + kbo(:, 3,37, 9) = (/ & + &1.1781e+00_r8,9.4755e-01_r8,6.5255e-01_r8,3.4395e-01_r8,4.9507e-03_r8/) + kbo(:, 4,37, 9) = (/ & + &1.5513e+00_r8,1.2498e+00_r8,8.6132e-01_r8,4.5404e-01_r8,6.2679e-03_r8/) + kbo(:, 5,37, 9) = (/ & + &2.0117e+00_r8,1.6227e+00_r8,1.1201e+00_r8,5.9042e-01_r8,7.7688e-03_r8/) + kbo(:, 1,38, 9) = (/ & + &5.4507e-01_r8,4.3885e-01_r8,3.0197e-01_r8,1.5934e-01_r8,2.3915e-03_r8/) + kbo(:, 2,38, 9) = (/ & + &7.5435e-01_r8,6.0772e-01_r8,4.1826e-01_r8,2.2053e-01_r8,3.1638e-03_r8/) + kbo(:, 3,38, 9) = (/ & + &1.0211e+00_r8,8.2323e-01_r8,5.6695e-01_r8,2.9883e-01_r8,4.0903e-03_r8/) + kbo(:, 4,38, 9) = (/ & + &1.3557e+00_r8,1.0950e+00_r8,7.5476e-01_r8,3.9799e-01_r8,5.2077e-03_r8/) + kbo(:, 5,38, 9) = (/ & + &1.7730e+00_r8,1.4345e+00_r8,9.9017e-01_r8,5.2203e-01_r8,6.5004e-03_r8/) + kbo(:, 1,39, 9) = (/ & + &4.6353e-01_r8,3.7406e-01_r8,2.5754e-01_r8,1.3588e-01_r8,1.9343e-03_r8/) + kbo(:, 2,39, 9) = (/ & + &6.4812e-01_r8,5.2360e-01_r8,3.6039e-01_r8,1.9002e-01_r8,2.5847e-03_r8/) + kbo(:, 3,39, 9) = (/ & + &8.8607e-01_r8,7.1665e-01_r8,4.9365e-01_r8,2.6013e-01_r8,3.3630e-03_r8/) + kbo(:, 4,39, 9) = (/ & + &1.1877e+00_r8,9.6199e-01_r8,6.6338e-01_r8,3.4986e-01_r8,4.2963e-03_r8/) + kbo(:, 5,39, 9) = (/ & + &1.5671e+00_r8,1.2712e+00_r8,8.7761e-01_r8,4.6286e-01_r8,5.3839e-03_r8/) + kbo(:, 1,40, 9) = (/ & + &3.8448e-01_r8,3.1107e-01_r8,2.1410e-01_r8,1.1297e-01_r8,1.5568e-03_r8/) + kbo(:, 2,40, 9) = (/ & + &5.4501e-01_r8,4.4126e-01_r8,3.0380e-01_r8,1.6009e-01_r8,2.1042e-03_r8/) + kbo(:, 3,40, 9) = (/ & + &7.5403e-01_r8,6.1132e-01_r8,4.2098e-01_r8,2.2180e-01_r8,2.7494e-03_r8/) + kbo(:, 4,40, 9) = (/ & + &1.0220e+00_r8,8.2995e-01_r8,5.7215e-01_r8,3.0165e-01_r8,3.5443e-03_r8/) + kbo(:, 5,40, 9) = (/ & + &1.3627e+00_r8,1.1080e+00_r8,7.6492e-01_r8,4.0348e-01_r8,4.4643e-03_r8/) + kbo(:, 1,41, 9) = (/ & + &3.1745e-01_r8,2.5733e-01_r8,1.7713e-01_r8,9.3436e-02_r8,1.2472e-03_r8/) + kbo(:, 2,41, 9) = (/ & + &4.5638e-01_r8,3.7042e-01_r8,2.5491e-01_r8,1.3436e-01_r8,1.6993e-03_r8/) + kbo(:, 3,41, 9) = (/ & + &6.3982e-01_r8,5.1972e-01_r8,3.5784e-01_r8,1.8851e-01_r8,2.2393e-03_r8/) + kbo(:, 4,41, 9) = (/ & + &8.7763e-01_r8,7.1397e-01_r8,4.9232e-01_r8,2.5948e-01_r8,2.9086e-03_r8/) + kbo(:, 5,41, 9) = (/ & + &1.1829e+00_r8,9.6420e-01_r8,6.6569e-01_r8,3.5114e-01_r8,3.6948e-03_r8/) + kbo(:, 1,42, 9) = (/ & + &2.6148e-01_r8,2.1244e-01_r8,1.4620e-01_r8,7.7106e-02_r8,9.9249e-04_r8/) + kbo(:, 2,42, 9) = (/ & + &3.8152e-01_r8,3.1036e-01_r8,2.1367e-01_r8,1.1258e-01_r8,1.3669e-03_r8/) + kbo(:, 3,42, 9) = (/ & + &5.4219e-01_r8,4.4152e-01_r8,3.0416e-01_r8,1.6017e-01_r8,1.8223e-03_r8/) + kbo(:, 4,42, 9) = (/ & + &7.5310e-01_r8,6.1412e-01_r8,4.2345e-01_r8,2.2321e-01_r8,2.3766e-03_r8/) + kbo(:, 5,42, 9) = (/ & + &1.0272e+00_r8,8.3945e-01_r8,5.7960e-01_r8,3.0577e-01_r8,3.0463e-03_r8/) + kbo(:, 1,43, 9) = (/ & + &2.1184e-01_r8,1.7233e-01_r8,1.1866e-01_r8,6.2577e-02_r8,7.7589e-04_r8/) + kbo(:, 2,43, 9) = (/ & + &3.1451e-01_r8,2.5652e-01_r8,1.7660e-01_r8,9.2987e-02_r8,1.0831e-03_r8/) + kbo(:, 3,43, 9) = (/ & + &4.5438e-01_r8,3.7074e-01_r8,2.5543e-01_r8,1.3448e-01_r8,1.4611e-03_r8/) + kbo(:, 4,43, 9) = (/ & + &6.4007e-01_r8,5.2328e-01_r8,3.6079e-01_r8,1.9007e-01_r8,1.9178e-03_r8/) + kbo(:, 5,43, 9) = (/ & + &8.8479e-01_r8,7.2477e-01_r8,5.0046e-01_r8,2.6398e-01_r8,2.4774e-03_r8/) + kbo(:, 1,44, 9) = (/ & + &1.6982e-01_r8,1.3846e-01_r8,9.5299e-02_r8,5.0248e-02_r8,5.9857e-04_r8/) + kbo(:, 2,44, 9) = (/ & + &2.5706e-01_r8,2.1005e-01_r8,1.4462e-01_r8,7.6126e-02_r8,8.4785e-04_r8/) + kbo(:, 3,44, 9) = (/ & + &3.7786e-01_r8,3.0904e-01_r8,2.1286e-01_r8,1.1204e-01_r8,1.1605e-03_r8/) + kbo(:, 4,44, 9) = (/ & + &5.4071e-01_r8,4.4303e-01_r8,3.0555e-01_r8,1.6090e-01_r8,1.5453e-03_r8/) + kbo(:, 5,44, 9) = (/ & + &7.5841e-01_r8,6.2258e-01_r8,4.2996e-01_r8,2.2675e-01_r8,1.9959e-03_r8/) + kbo(:, 1,45, 9) = (/ & + &1.3545e-01_r8,1.1062e-01_r8,7.6155e-02_r8,4.0151e-02_r8,4.5711e-04_r8/) + kbo(:, 2,45, 9) = (/ & + &2.0919e-01_r8,1.7120e-01_r8,1.1790e-01_r8,6.2073e-02_r8,6.5798e-04_r8/) + kbo(:, 3,45, 9) = (/ & + &3.1316e-01_r8,2.5663e-01_r8,1.7679e-01_r8,9.2995e-02_r8,9.1164e-04_r8/) + kbo(:, 4,45, 9) = (/ & + &4.5567e-01_r8,3.7416e-01_r8,2.5813e-01_r8,1.3590e-01_r8,1.2287e-03_r8/) + kbo(:, 5,45, 9) = (/ & + &6.4919e-01_r8,5.3401e-01_r8,3.6882e-01_r8,1.9448e-01_r8,1.6029e-03_r8/) + kbo(:, 1,46, 9) = (/ & + &1.0668e-01_r8,8.7165e-02_r8,6.0007e-02_r8,3.1628e-02_r8,3.4444e-04_r8/) + kbo(:, 2,46, 9) = (/ & + &1.6793e-01_r8,1.3770e-01_r8,9.4805e-02_r8,4.9929e-02_r8,5.0372e-04_r8/) + kbo(:, 3,46, 9) = (/ & + &2.5640e-01_r8,2.1057e-01_r8,1.4511e-01_r8,7.6324e-02_r8,7.0786e-04_r8/) + kbo(:, 4,46, 9) = (/ & + &3.8014e-01_r8,3.1276e-01_r8,2.1587e-01_r8,1.1362e-01_r8,9.6784e-04_r8/) + kbo(:, 5,46, 9) = (/ & + &5.5078e-01_r8,4.5406e-01_r8,3.1364e-01_r8,1.6534e-01_r8,1.2803e-03_r8/) + kbo(:, 1,47, 9) = (/ & + &8.2159e-02_r8,6.7194e-02_r8,4.6255e-02_r8,2.4369e-02_r8,2.5696e-04_r8/) + kbo(:, 2,47, 9) = (/ & + &1.3183e-01_r8,1.0829e-01_r8,7.4558e-02_r8,3.9260e-02_r8,3.8064e-04_r8/) + kbo(:, 3,47, 9) = (/ & + &2.0579e-01_r8,1.6932e-01_r8,1.1664e-01_r8,6.1365e-02_r8,5.4299e-04_r8/) + kbo(:, 4,47, 9) = (/ & + &3.1127e-01_r8,2.5673e-01_r8,1.7713e-01_r8,9.3234e-02_r8,7.5354e-04_r8/) + kbo(:, 5,47, 9) = (/ & + &4.5944e-01_r8,3.7947e-01_r8,2.6220e-01_r8,1.3818e-01_r8,1.0123e-03_r8/) + kbo(:, 1,48, 9) = (/ & + &6.2805e-02_r8,5.1372e-02_r8,3.5337e-02_r8,1.8627e-02_r8,1.8799e-04_r8/) + kbo(:, 2,48, 9) = (/ & + &1.0282e-01_r8,8.4440e-02_r8,5.8150e-02_r8,3.0624e-02_r8,2.8497e-04_r8/) + kbo(:, 3,48, 9) = (/ & + &1.6397e-01_r8,1.3516e-01_r8,9.3148e-02_r8,4.8994e-02_r8,4.1296e-04_r8/) + kbo(:, 4,48, 9) = (/ & + &2.5353e-01_r8,2.0948e-01_r8,1.4454e-01_r8,7.6030e-02_r8,5.7970e-04_r8/) + kbo(:, 5,48, 9) = (/ & + &3.8151e-01_r8,3.1578e-01_r8,2.1823e-01_r8,1.1499e-01_r8,7.9062e-04_r8/) + kbo(:, 1,49, 9) = (/ & + &4.7675e-02_r8,3.9033e-02_r8,2.6875e-02_r8,1.4167e-02_r8,1.3591e-04_r8/) + kbo(:, 2,49, 9) = (/ & + &7.9683e-02_r8,6.5540e-02_r8,4.5120e-02_r8,2.3756e-02_r8,2.0952e-04_r8/) + kbo(:, 3,49, 9) = (/ & + &1.2966e-01_r8,1.0708e-01_r8,7.3804e-02_r8,3.8837e-02_r8,3.0991e-04_r8/) + kbo(:, 4,49, 9) = (/ & + &2.0506e-01_r8,1.6980e-01_r8,1.1714e-01_r8,6.1628e-02_r8,4.4095e-04_r8/) + kbo(:, 5,49, 9) = (/ & + &3.1515e-01_r8,2.6147e-01_r8,1.8074e-01_r8,9.5226e-02_r8,6.0820e-04_r8/) + kbo(:, 1,50, 9) = (/ & + &3.6548e-02_r8,2.9943e-02_r8,2.0610e-02_r8,1.0865e-02_r8,9.9917e-05_r8/) + kbo(:, 2,50, 9) = (/ & + &6.2279e-02_r8,5.1209e-02_r8,3.5254e-02_r8,1.8566e-02_r8,1.5653e-04_r8/) + kbo(:, 3,50, 9) = (/ & + &1.0318e-01_r8,8.5332e-02_r8,5.8808e-02_r8,3.0962e-02_r8,2.3703e-04_r8/) + kbo(:, 4,50, 9) = (/ & + &1.6688e-01_r8,1.3839e-01_r8,9.5487e-02_r8,5.0236e-02_r8,3.4171e-04_r8/) + kbo(:, 5,50, 9) = (/ & + &2.6185e-01_r8,2.1767e-01_r8,1.5045e-01_r8,7.9263e-02_r8,4.7617e-04_r8/) + kbo(:, 1,51, 9) = (/ & + &2.7952e-02_r8,2.2969e-02_r8,1.5811e-02_r8,8.3417e-03_r8,7.4671e-05_r8/) + kbo(:, 2,51, 9) = (/ & + &4.8817e-02_r8,4.0171e-02_r8,2.7641e-02_r8,1.4555e-02_r8,1.1814e-04_r8/) + kbo(:, 3,51, 9) = (/ & + &8.2508e-02_r8,6.8219e-02_r8,4.6983e-02_r8,2.4707e-02_r8,1.8096e-04_r8/) + kbo(:, 4,51, 9) = (/ & + &1.3588e-01_r8,1.1285e-01_r8,7.7859e-02_r8,4.0970e-02_r8,2.6754e-04_r8/) + kbo(:, 5,51, 9) = (/ & + &2.1776e-01_r8,1.8131e-01_r8,1.2532e-01_r8,6.5999e-02_r8,3.7856e-04_r8/) + kbo(:, 1,52, 9) = (/ & + &2.1199e-02_r8,1.7459e-02_r8,1.2025e-02_r8,6.3452e-03_r8,5.5107e-05_r8/) + kbo(:, 2,52, 9) = (/ & + &3.8088e-02_r8,3.1354e-02_r8,2.1571e-02_r8,1.1353e-02_r8,8.8069e-05_r8/) + kbo(:, 3,52, 9) = (/ & + &6.5619e-02_r8,5.4321e-02_r8,3.7416e-02_r8,1.9692e-02_r8,1.3680e-04_r8/) + kbo(:, 4,52, 9) = (/ & + &1.1018e-01_r8,9.1593e-02_r8,6.3191e-02_r8,3.3254e-02_r8,2.0641e-04_r8/) + kbo(:, 5,52, 9) = (/ & + &1.8039e-01_r8,1.5044e-01_r8,1.0398e-01_r8,5.4762e-02_r8,2.9766e-04_r8/) + kbo(:, 1,53, 9) = (/ & + &1.5917e-02_r8,1.3124e-02_r8,9.0469e-03_r8,4.7728e-03_r8,4.0227e-05_r8/) + kbo(:, 2,53, 9) = (/ & + &2.9453e-02_r8,2.4295e-02_r8,1.6728e-02_r8,8.8064e-03_r8,6.5428e-05_r8/) + kbo(:, 3,53, 9) = (/ & + &5.2020e-02_r8,4.3058e-02_r8,2.9653e-02_r8,1.5599e-02_r8,1.0270e-04_r8/) + kbo(:, 4,53, 9) = (/ & + &8.9031e-02_r8,7.3955e-02_r8,5.0990e-02_r8,2.6843e-02_r8,1.5632e-04_r8/) + kbo(:, 5,53, 9) = (/ & + &1.4878e-01_r8,1.2427e-01_r8,8.5889e-02_r8,4.5242e-02_r8,2.3095e-04_r8/) + kbo(:, 1,54, 9) = (/ & + &1.2118e-02_r8,1.0014e-02_r8,6.9093e-03_r8,3.6479e-03_r8,3.0413e-05_r8/) + kbo(:, 2,54, 9) = (/ & + &2.3157e-02_r8,1.9122e-02_r8,1.3172e-02_r8,6.9364e-03_r8,5.0720e-05_r8/) + kbo(:, 3,54, 9) = (/ & + &4.1929e-02_r8,3.4711e-02_r8,2.3913e-02_r8,1.2578e-02_r8,8.0499e-05_r8/) + kbo(:, 4,54, 9) = (/ & + &7.3182e-02_r8,6.0821e-02_r8,4.1911e-02_r8,2.2054e-02_r8,1.2452e-04_r8/) + kbo(:, 5,54, 9) = (/ & + &1.2434e-01_r8,1.0391e-01_r8,7.1807e-02_r8,3.7810e-02_r8,1.8706e-04_r8/) + kbo(:, 1,55, 9) = (/ & + &9.2663e-03_r8,7.6785e-03_r8,5.3030e-03_r8,2.7962e-03_r8,2.3331e-05_r8/) + kbo(:, 2,55, 9) = (/ & + &1.8303e-02_r8,1.5169e-02_r8,1.0453e-02_r8,5.5039e-03_r8,4.0062e-05_r8/) + kbo(:, 3,55, 9) = (/ & + &3.4131e-02_r8,2.8258e-02_r8,1.9454e-02_r8,1.0230e-02_r8,6.4887e-05_r8/) + kbo(:, 4,55, 9) = (/ & + &6.0672e-02_r8,5.0398e-02_r8,3.4733e-02_r8,1.8270e-02_r8,1.0169e-04_r8/) + kbo(:, 5,55, 9) = (/ & + &1.0468e-01_r8,8.7488e-02_r8,6.0450e-02_r8,3.1810e-02_r8,1.5537e-04_r8/) + kbo(:, 1,56, 9) = (/ & + &7.0383e-03_r8,5.8452e-03_r8,4.0381e-03_r8,2.1288e-03_r8,1.7811e-05_r8/) + kbo(:, 2,56, 9) = (/ & + &1.4408e-02_r8,1.1966e-02_r8,8.2523e-03_r8,4.3448e-03_r8,3.1488e-05_r8/) + kbo(:, 3,56, 9) = (/ & + &2.7695e-02_r8,2.2953e-02_r8,1.5811e-02_r8,8.3080e-03_r8,5.2239e-05_r8/) + kbo(:, 4,56, 9) = (/ & + &5.0327e-02_r8,4.1815e-02_r8,2.8827e-02_r8,1.5149e-02_r8,8.2952e-05_r8/) + kbo(:, 5,56, 9) = (/ & + &8.8477e-02_r8,7.3786e-02_r8,5.0905e-02_r8,2.6783e-02_r8,1.2900e-04_r8/) + kbo(:, 1,57, 9) = (/ & + &5.2984e-03_r8,4.4048e-03_r8,3.0442e-03_r8,1.6062e-03_r8,1.3485e-05_r8/) + kbo(:, 2,57, 9) = (/ & + &1.1277e-02_r8,9.3839e-03_r8,6.4745e-03_r8,3.4126e-03_r8,2.4664e-05_r8/) + kbo(:, 3,57, 9) = (/ & + &2.2383e-02_r8,1.8598e-02_r8,1.2810e-02_r8,6.7278e-03_r8,4.2073e-05_r8/) + kbo(:, 4,57, 9) = (/ & + &4.1793e-02_r8,3.4722e-02_r8,2.3901e-02_r8,1.2561e-02_r8,6.8099e-05_r8/) + kbo(:, 5,57, 9) = (/ & + &7.4879e-02_r8,6.2449e-02_r8,4.3075e-02_r8,2.2643e-02_r8,1.0701e-04_r8/) + kbo(:, 1,58, 9) = (/ & + &1.9422e-03_r8,1.8562e-03_r8,1.5070e-03_r8,9.6178e-04_r8,1.0242e-05_r8/) + kbo(:, 2,58, 9) = (/ & + &4.2963e-03_r8,4.1126e-03_r8,3.3378e-03_r8,2.1278e-03_r8,1.9475e-05_r8/) + kbo(:, 3,58, 9) = (/ & + &8.8321e-03_r8,8.4312e-03_r8,6.8267e-03_r8,4.3437e-03_r8,3.4347e-05_r8/) + kbo(:, 4,58, 9) = (/ & + &1.7006e-02_r8,1.6220e-02_r8,1.3112e-02_r8,8.3245e-03_r8,5.6453e-05_r8/) + kbo(:, 5,58, 9) = (/ & + &3.1001e-02_r8,2.9664e-02_r8,2.4013e-02_r8,1.5274e-02_r8,9.0315e-05_r8/) + kbo(:, 1,59, 9) = (/ & + &1.6680e-03_r8,1.5995e-03_r8,1.3049e-03_r8,8.3836e-04_r8,9.2179e-06_r8/) + kbo(:, 2,59, 9) = (/ & + &3.7712e-03_r8,3.6258e-03_r8,2.9561e-03_r8,1.8979e-03_r8,1.8017e-05_r8/) + kbo(:, 3,59, 9) = (/ & + &7.9144e-03_r8,7.6082e-03_r8,6.1886e-03_r8,3.9647e-03_r8,3.2435e-05_r8/) + kbo(:, 4,59, 9) = (/ & + &1.5562e-02_r8,1.4917e-02_r8,1.2127e-02_r8,7.7579e-03_r8,5.4862e-05_r8/) + kbo(:, 5,59, 9) = (/ & + &2.8789e-02_r8,2.7607e-02_r8,2.2446e-02_r8,1.4356e-02_r8,8.9155e-05_r8/) + kbo(:, 1,13,10) = (/ & + &3.5965e+01_r8,2.6975e+01_r8,1.7984e+01_r8,9.0232e+00_r8,2.4705e-01_r8/) + kbo(:, 2,13,10) = (/ & + &5.0800e+01_r8,3.8101e+01_r8,2.5403e+01_r8,1.2739e+01_r8,2.8941e-01_r8/) + kbo(:, 3,13,10) = (/ & + &6.8409e+01_r8,5.1309e+01_r8,3.4208e+01_r8,1.7156e+01_r8,3.3771e-01_r8/) + kbo(:, 4,13,10) = (/ & + &8.8981e+01_r8,6.6739e+01_r8,4.4497e+01_r8,2.2337e+01_r8,3.9418e-01_r8/) + kbo(:, 5,13,10) = (/ & + &1.1252e+02_r8,8.4389e+01_r8,5.6260e+01_r8,2.8284e+01_r8,4.6348e-01_r8/) + kbo(:, 1,14,10) = (/ & + &3.4773e+01_r8,2.6079e+01_r8,1.7386e+01_r8,8.7850e+00_r8,2.3514e-01_r8/) + kbo(:, 2,14,10) = (/ & + &4.8754e+01_r8,3.6565e+01_r8,2.4376e+01_r8,1.2316e+01_r8,2.9035e-01_r8/) + kbo(:, 3,14,10) = (/ & + &6.5535e+01_r8,4.9151e+01_r8,3.2769e+01_r8,1.6566e+01_r8,3.5401e-01_r8/) + kbo(:, 4,14,10) = (/ & + &8.5152e+01_r8,6.3871e+01_r8,4.2583e+01_r8,2.1543e+01_r8,4.0952e-01_r8/) + kbo(:, 5,14,10) = (/ & + &1.0714e+02_r8,8.0354e+01_r8,5.3570e+01_r8,2.7127e+01_r8,4.6861e-01_r8/) + kbo(:, 1,15,10) = (/ & + &3.1708e+01_r8,2.3780e+01_r8,1.5854e+01_r8,8.0780e+00_r8,2.2725e-01_r8/) + kbo(:, 2,15,10) = (/ & + &4.4299e+01_r8,3.3227e+01_r8,2.2149e+01_r8,1.1301e+01_r8,2.7237e-01_r8/) + kbo(:, 3,15,10) = (/ & + &5.9451e+01_r8,4.4587e+01_r8,2.9727e+01_r8,1.5175e+01_r8,3.1480e-01_r8/) + kbo(:, 4,15,10) = (/ & + &7.6914e+01_r8,5.7688e+01_r8,3.8460e+01_r8,1.9633e+01_r8,3.5895e-01_r8/) + kbo(:, 5,15,10) = (/ & + &9.6187e+01_r8,7.2137e+01_r8,4.8097e+01_r8,2.4537e+01_r8,4.0136e-01_r8/) + kbo(:, 1,16,10) = (/ & + &2.8000e+01_r8,2.1001e+01_r8,1.4008e+01_r8,7.1879e+00_r8,1.8684e-01_r8/) + kbo(:, 2,16,10) = (/ & + &3.8983e+01_r8,2.9238e+01_r8,1.9500e+01_r8,1.0007e+01_r8,2.3111e-01_r8/) + kbo(:, 3,16,10) = (/ & + &5.2090e+01_r8,3.9071e+01_r8,2.6063e+01_r8,1.3380e+01_r8,2.7168e-01_r8/) + kbo(:, 4,16,10) = (/ & + &6.6962e+01_r8,5.0223e+01_r8,3.3517e+01_r8,1.7217e+01_r8,3.1091e-01_r8/) + kbo(:, 5,16,10) = (/ & + &8.3570e+01_r8,6.2687e+01_r8,4.1858e+01_r8,2.1531e+01_r8,3.6276e-01_r8/) + kbo(:, 1,17,10) = (/ & + &2.4264e+01_r8,1.8198e+01_r8,1.2195e+01_r8,6.2664e+00_r8,1.7021e-01_r8/) + kbo(:, 2,17,10) = (/ & + &3.3645e+01_r8,2.5234e+01_r8,1.6913e+01_r8,8.7049e+00_r8,1.9751e-01_r8/) + kbo(:, 3,17,10) = (/ & + &4.4643e+01_r8,3.3486e+01_r8,2.2452e+01_r8,1.1586e+01_r8,2.2201e-01_r8/) + kbo(:, 4,17,10) = (/ & + &5.7207e+01_r8,4.2902e+01_r8,2.8791e+01_r8,1.4899e+01_r8,2.5554e-01_r8/) + kbo(:, 5,17,10) = (/ & + &7.1193e+01_r8,5.3402e+01_r8,3.5856e+01_r8,1.8608e+01_r8,2.9547e-01_r8/) + kbo(:, 1,18,10) = (/ & + &2.0477e+01_r8,1.5356e+01_r8,1.0367e+01_r8,5.3622e+00_r8,1.3534e-01_r8/) + kbo(:, 2,18,10) = (/ & + &2.8178e+01_r8,2.1132e+01_r8,1.4278e+01_r8,7.4149e+00_r8,1.5634e-01_r8/) + kbo(:, 3,18,10) = (/ & + &3.7210e+01_r8,2.7911e+01_r8,1.8862e+01_r8,9.8384e+00_r8,1.8020e-01_r8/) + kbo(:, 4,18,10) = (/ & + &4.7546e+01_r8,3.5659e+01_r8,2.4100e+01_r8,1.2600e+01_r8,2.1507e-01_r8/) + kbo(:, 5,18,10) = (/ & + &5.8973e+01_r8,4.4229e+01_r8,2.9880e+01_r8,1.5650e+01_r8,2.3467e-01_r8/) + kbo(:, 1,19,10) = (/ & + &1.7373e+01_r8,1.3040e+01_r8,8.8390e+00_r8,4.6588e+00_r8,1.1972e-01_r8/) + kbo(:, 2,19,10) = (/ & + &2.3793e+01_r8,1.7857e+01_r8,1.2109e+01_r8,6.3963e+00_r8,1.3774e-01_r8/) + kbo(:, 3,19,10) = (/ & + &3.1336e+01_r8,2.3520e+01_r8,1.5961e+01_r8,8.4390e+00_r8,1.6091e-01_r8/) + kbo(:, 4,19,10) = (/ & + &3.9866e+01_r8,2.9935e+01_r8,2.0331e+01_r8,1.0756e+01_r8,1.7955e-01_r8/) + kbo(:, 5,19,10) = (/ & + &4.9495e+01_r8,3.7175e+01_r8,2.5257e+01_r8,1.3339e+01_r8,2.0663e-01_r8/) + kbo(:, 1,20,10) = (/ & + &1.5037e+01_r8,1.1322e+01_r8,7.6844e+00_r8,4.1127e+00_r8,1.0485e-01_r8/) + kbo(:, 2,20,10) = (/ & + &2.0515e+01_r8,1.5450e+01_r8,1.0499e+01_r8,5.6182e+00_r8,1.2148e-01_r8/) + kbo(:, 3,20,10) = (/ & + &2.6886e+01_r8,2.0252e+01_r8,1.3792e+01_r8,7.3741e+00_r8,1.4561e-01_r8/) + kbo(:, 4,20,10) = (/ & + &3.4287e+01_r8,2.5832e+01_r8,1.7615e+01_r8,9.3860e+00_r8,1.6294e-01_r8/) + kbo(:, 5,20,10) = (/ & + &4.2841e+01_r8,3.2278e+01_r8,2.2023e+01_r8,1.1711e+01_r8,1.8624e-01_r8/) + kbo(:, 1,21,10) = (/ & + &1.3152e+01_r8,9.9438e+00_r8,6.7780e+00_r8,3.6471e+00_r8,9.1853e-02_r8/) + kbo(:, 2,21,10) = (/ & + &1.7866e+01_r8,1.3511e+01_r8,9.2298e+00_r8,4.9595e+00_r8,1.1141e-01_r8/) + kbo(:, 3,21,10) = (/ & + &2.3469e+01_r8,1.7747e+01_r8,1.2135e+01_r8,6.5086e+00_r8,1.2785e-01_r8/) + kbo(:, 4,21,10) = (/ & + &3.0120e+01_r8,2.2761e+01_r8,1.5567e+01_r8,8.3305e+00_r8,1.5176e-01_r8/) + kbo(:, 5,21,10) = (/ & + &3.7884e+01_r8,2.8609e+01_r8,1.9560e+01_r8,1.0448e+01_r8,1.7309e-01_r8/) + kbo(:, 1,22,10) = (/ & + &1.1757e+01_r8,8.9118e+00_r8,6.1382e+00_r8,3.3115e+00_r8,8.1057e-02_r8/) + kbo(:, 2,22,10) = (/ & + &1.5980e+01_r8,1.2109e+01_r8,8.3336e+00_r8,4.4832e+00_r8,9.8906e-02_r8/) + kbo(:, 3,22,10) = (/ & + &2.1108e+01_r8,1.5991e+01_r8,1.0992e+01_r8,5.8971e+00_r8,1.1586e-01_r8/) + kbo(:, 4,22,10) = (/ & + &2.7285e+01_r8,2.0659e+01_r8,1.4174e+01_r8,7.5863e+00_r8,1.3507e-01_r8/) + kbo(:, 5,22,10) = (/ & + &3.4676e+01_r8,2.6248e+01_r8,1.7966e+01_r8,9.5810e+00_r8,1.5851e-01_r8/) + kbo(:, 1,23,10) = (/ & + &1.0481e+01_r8,7.9685e+00_r8,5.5490e+00_r8,2.9996e+00_r8,7.4309e-02_r8/) + kbo(:, 2,23,10) = (/ & + &1.4420e+01_r8,1.0955e+01_r8,7.5878e+00_r8,4.0805e+00_r8,8.6253e-02_r8/) + kbo(:, 3,23,10) = (/ & + &1.9219e+01_r8,1.4600e+01_r8,1.0073e+01_r8,5.3977e+00_r8,1.0580e-01_r8/) + kbo(:, 4,23,10) = (/ & + &2.5108e+01_r8,1.9069e+01_r8,1.3115e+01_r8,7.0020e+00_r8,1.2265e-01_r8/) + kbo(:, 5,23,10) = (/ & + &3.2043e+01_r8,2.4337e+01_r8,1.6704e+01_r8,8.8942e+00_r8,1.4381e-01_r8/) + kbo(:, 1,24,10) = (/ & + &9.5276e+00_r8,7.2768e+00_r8,5.0826e+00_r8,2.7465e+00_r8,6.4655e-02_r8/) + kbo(:, 2,24,10) = (/ & + &1.3271e+01_r8,1.0121e+01_r8,7.0214e+00_r8,3.7657e+00_r8,7.9291e-02_r8/) + kbo(:, 3,24,10) = (/ & + &1.7863e+01_r8,1.3622e+01_r8,9.4201e+00_r8,5.0307e+00_r8,9.5461e-02_r8/) + kbo(:, 4,24,10) = (/ & + &2.3325e+01_r8,1.7783e+01_r8,1.2273e+01_r8,6.5420e+00_r8,1.1274e-01_r8/) + kbo(:, 5,24,10) = (/ & + &2.9564e+01_r8,2.2536e+01_r8,1.5537e+01_r8,8.2816e+00_r8,1.3418e-01_r8/) + kbo(:, 1,25,10) = (/ & + &8.8160e+00_r8,6.7673e+00_r8,4.7220e+00_r8,2.5379e+00_r8,5.8489e-02_r8/) + kbo(:, 2,25,10) = (/ & + &1.2357e+01_r8,9.4685e+00_r8,6.5735e+00_r8,3.5130e+00_r8,7.2064e-02_r8/) + kbo(:, 3,25,10) = (/ & + &1.6557e+01_r8,1.2678e+01_r8,8.7976e+00_r8,4.6917e+00_r8,8.6281e-02_r8/) + kbo(:, 4,25,10) = (/ & + &2.1444e+01_r8,1.6408e+01_r8,1.1376e+01_r8,6.0717e+00_r8,1.0416e-01_r8/) + kbo(:, 5,25,10) = (/ & + &2.7072e+01_r8,2.0703e+01_r8,1.4347e+01_r8,7.6551e+00_r8,1.2572e-01_r8/) + kbo(:, 1,26,10) = (/ & + &8.2437e+00_r8,6.3645e+00_r8,4.4442e+00_r8,2.3799e+00_r8,5.3046e-02_r8/) + kbo(:, 2,26,10) = (/ & + &1.1483e+01_r8,8.8437e+00_r8,6.1605e+00_r8,3.2883e+00_r8,6.5278e-02_r8/) + kbo(:, 3,26,10) = (/ & + &1.5261e+01_r8,1.1739e+01_r8,8.1695e+00_r8,4.3593e+00_r8,8.0191e-02_r8/) + kbo(:, 4,26,10) = (/ & + &1.9700e+01_r8,1.5135e+01_r8,1.0534e+01_r8,5.6197e+00_r8,9.7601e-02_r8/) + kbo(:, 5,26,10) = (/ & + &2.4857e+01_r8,1.9072e+01_r8,1.3248e+01_r8,7.0653e+00_r8,1.1704e-01_r8/) + kbo(:, 1,27,10) = (/ & + &7.7081e+00_r8,5.9885e+00_r8,4.1814e+00_r8,2.2306e+00_r8,4.7409e-02_r8/) + kbo(:, 2,27,10) = (/ & + &1.0576e+01_r8,8.1915e+00_r8,5.7182e+00_r8,3.0504e+00_r8,5.8512e-02_r8/) + kbo(:, 3,27,10) = (/ & + &1.4014e+01_r8,1.0837e+01_r8,7.5629e+00_r8,4.0315e+00_r8,7.3955e-02_r8/) + kbo(:, 4,27,10) = (/ & + &1.8113e+01_r8,1.3973e+01_r8,9.7390e+00_r8,5.1847e+00_r8,9.0794e-02_r8/) + kbo(:, 5,27,10) = (/ & + &2.2862e+01_r8,1.7593e+01_r8,1.2246e+01_r8,6.5228e+00_r8,1.0871e-01_r8/) + kbo(:, 1,28,10) = (/ & + &7.2063e+00_r8,5.6196e+00_r8,3.9203e+00_r8,2.0882e+00_r8,4.3129e-02_r8/) + kbo(:, 2,28,10) = (/ & + &9.7817e+00_r8,7.6085e+00_r8,5.3084e+00_r8,2.8196e+00_r8,5.4812e-02_r8/) + kbo(:, 3,28,10) = (/ & + &1.2904e+01_r8,1.0029e+01_r8,7.0025e+00_r8,3.7236e+00_r8,6.8395e-02_r8/) + kbo(:, 4,28,10) = (/ & + &1.6696e+01_r8,1.2935e+01_r8,9.0135e+00_r8,4.7943e+00_r8,8.2716e-02_r8/) + kbo(:, 5,28,10) = (/ & + &2.1096e+01_r8,1.6309e+01_r8,1.1368e+01_r8,6.0506e+00_r8,9.9935e-02_r8/) + kbo(:, 1,29,10) = (/ & + &6.7278e+00_r8,5.2636e+00_r8,3.6717e+00_r8,1.9437e+00_r8,3.9266e-02_r8/) + kbo(:, 2,29,10) = (/ & + &9.0515e+00_r8,7.0710e+00_r8,4.9355e+00_r8,2.6130e+00_r8,4.9834e-02_r8/) + kbo(:, 3,29,10) = (/ & + &1.1919e+01_r8,9.2978e+00_r8,6.4770e+00_r8,3.4412e+00_r8,6.2077e-02_r8/) + kbo(:, 4,29,10) = (/ & + &1.5380e+01_r8,1.1978e+01_r8,8.3499e+00_r8,4.4362e+00_r8,7.6798e-02_r8/) + kbo(:, 5,29,10) = (/ & + &1.9420e+01_r8,1.5097e+01_r8,1.0536e+01_r8,5.6045e+00_r8,9.1669e-02_r8/) + kbo(:, 1,30,10) = (/ & + &6.2882e+00_r8,4.9355e+00_r8,3.4323e+00_r8,1.8115e+00_r8,3.5713e-02_r8/) + kbo(:, 2,30,10) = (/ & + &8.4169e+00_r8,6.5906e+00_r8,4.5841e+00_r8,2.4262e+00_r8,4.5752e-02_r8/) + kbo(:, 3,30,10) = (/ & + &1.1024e+01_r8,8.6363e+00_r8,6.0145e+00_r8,3.1864e+00_r8,5.7473e-02_r8/) + kbo(:, 4,30,10) = (/ & + &1.4192e+01_r8,1.1103e+01_r8,7.7439e+00_r8,4.1120e+00_r8,7.0729e-02_r8/) + kbo(:, 5,30,10) = (/ & + &1.7890e+01_r8,1.3978e+01_r8,9.7651e+00_r8,5.1860e+00_r8,8.5534e-02_r8/) + kbo(:, 1,31,10) = (/ & + &5.8439e+00_r8,4.6051e+00_r8,3.1957e+00_r8,1.6863e+00_r8,3.2654e-02_r8/) + kbo(:, 2,31,10) = (/ & + &7.8033e+00_r8,6.1378e+00_r8,4.2622e+00_r8,2.2515e+00_r8,4.2183e-02_r8/) + kbo(:, 3,31,10) = (/ & + &1.0196e+01_r8,8.0235e+00_r8,5.5836e+00_r8,2.9533e+00_r8,5.3011e-02_r8/) + kbo(:, 4,31,10) = (/ & + &1.3072e+01_r8,1.0286e+01_r8,7.1778e+00_r8,3.8005e+00_r8,6.4875e-02_r8/) + kbo(:, 5,31,10) = (/ & + &1.6463e+01_r8,1.2924e+01_r8,9.0292e+00_r8,4.7849e+00_r8,7.7772e-02_r8/) + kbo(:, 1,32,10) = (/ & + &5.4664e+00_r8,4.3291e+00_r8,2.9999e+00_r8,1.5808e+00_r8,2.9923e-02_r8/) + kbo(:, 2,32,10) = (/ & + &7.2874e+00_r8,5.7710e+00_r8,4.0068e+00_r8,2.1122e+00_r8,3.8267e-02_r8/) + kbo(:, 3,32,10) = (/ & + &9.5041e+00_r8,7.5231e+00_r8,5.2374e+00_r8,2.7661e+00_r8,4.7331e-02_r8/) + kbo(:, 4,32,10) = (/ & + &1.2176e+01_r8,9.6156e+00_r8,6.7066e+00_r8,3.5449e+00_r8,5.8625e-02_r8/) + kbo(:, 5,32,10) = (/ & + &1.5322e+01_r8,1.2084e+01_r8,8.4483e+00_r8,4.4709e+00_r8,6.9340e-02_r8/) + kbo(:, 1,33,10) = (/ & + &5.1512e+00_r8,4.0967e+00_r8,2.8362e+00_r8,1.4933e+00_r8,2.6393e-02_r8/) + kbo(:, 2,33,10) = (/ & + &6.8599e+00_r8,5.4552e+00_r8,3.7902e+00_r8,1.9993e+00_r8,3.4040e-02_r8/) + kbo(:, 3,33,10) = (/ & + &8.9395e+00_r8,7.1038e+00_r8,4.9489e+00_r8,2.6104e+00_r8,4.2820e-02_r8/) + kbo(:, 4,33,10) = (/ & + &1.1449e+01_r8,9.0816e+00_r8,6.3367e+00_r8,3.3421e+00_r8,5.1919e-02_r8/) + kbo(:, 5,33,10) = (/ & + &1.4423e+01_r8,1.1426e+01_r8,7.9850e+00_r8,4.2179e+00_r8,6.2402e-02_r8/) + kbo(:, 1,34,10) = (/ & + &4.8646e+00_r8,3.8880e+00_r8,2.6932e+00_r8,1.4194e+00_r8,2.3781e-02_r8/) + kbo(:, 2,34,10) = (/ & + &6.4672e+00_r8,5.1782e+00_r8,3.6018e+00_r8,1.8962e+00_r8,3.0492e-02_r8/) + kbo(:, 3,34,10) = (/ & + &8.4535e+00_r8,6.7497e+00_r8,4.7054e+00_r8,2.4770e+00_r8,3.8339e-02_r8/) + kbo(:, 4,34,10) = (/ & + &1.0856e+01_r8,8.6484e+00_r8,6.0350e+00_r8,3.1793e+00_r8,4.6570e-02_r8/) + kbo(:, 5,34,10) = (/ & + &1.3723e+01_r8,1.0909e+01_r8,7.6246e+00_r8,4.0214e+00_r8,5.6226e-02_r8/) + kbo(:, 1,35,10) = (/ & + &4.4902e+00_r8,3.6079e+00_r8,2.5027e+00_r8,1.3156e+00_r8,2.1238e-02_r8/) + kbo(:, 2,35,10) = (/ & + &5.9918e+00_r8,4.8154e+00_r8,3.3497e+00_r8,1.7639e+00_r8,2.7153e-02_r8/) + kbo(:, 3,35,10) = (/ & + &7.8693e+00_r8,6.3098e+00_r8,4.3964e+00_r8,2.3124e+00_r8,3.3573e-02_r8/) + kbo(:, 4,35,10) = (/ & + &1.0156e+01_r8,8.1193e+00_r8,5.6658e+00_r8,2.9812e+00_r8,4.1298e-02_r8/) + kbo(:, 5,35,10) = (/ & + &1.2867e+01_r8,1.0277e+01_r8,7.1860e+00_r8,3.7872e+00_r8,4.9619e-02_r8/) + kbo(:, 1,36,10) = (/ & + &4.0317e+00_r8,3.2575e+00_r8,2.2591e+00_r8,1.1864e+00_r8,1.8322e-02_r8/) + kbo(:, 2,36,10) = (/ & + &5.4230e+00_r8,4.3764e+00_r8,3.0444e+00_r8,1.6008e+00_r8,2.3437e-02_r8/) + kbo(:, 3,36,10) = (/ & + &7.1807e+00_r8,5.7770e+00_r8,4.0236e+00_r8,2.1147e+00_r8,2.8934e-02_r8/) + kbo(:, 4,36,10) = (/ & + &9.3214e+00_r8,7.4860e+00_r8,5.2247e+00_r8,2.7453e+00_r8,3.5476e-02_r8/) + kbo(:, 5,36,10) = (/ & + &1.1871e+01_r8,9.5152e+00_r8,6.6538e+00_r8,3.5057e+00_r8,4.2476e-02_r8/) + kbo(:, 1,37,10) = (/ & + &3.4945e+00_r8,2.8322e+00_r8,1.9642e+00_r8,1.0316e+00_r8,1.5292e-02_r8/) + kbo(:, 2,37,10) = (/ & + &4.7474e+00_r8,3.8477e+00_r8,2.6749e+00_r8,1.4057e+00_r8,1.9829e-02_r8/) + kbo(:, 3,37,10) = (/ & + &6.3563e+00_r8,5.1351e+00_r8,3.5754e+00_r8,1.8774e+00_r8,2.4925e-02_r8/) + kbo(:, 4,37,10) = (/ & + &8.3333e+00_r8,6.7182e+00_r8,4.6872e+00_r8,2.4610e+00_r8,3.0513e-02_r8/) + kbo(:, 5,37,10) = (/ & + &1.0705e+01_r8,8.6094e+00_r8,6.0143e+00_r8,3.1664e+00_r8,3.6834e-02_r8/) + kbo(:, 1,38,10) = (/ & + &3.0288e+00_r8,2.4619e+00_r8,1.7084e+00_r8,8.9674e-01_r8,1.2715e-02_r8/) + kbo(:, 2,38,10) = (/ & + &4.1608e+00_r8,3.3834e+00_r8,2.3515e+00_r8,1.2353e+00_r8,1.6555e-02_r8/) + kbo(:, 3,38,10) = (/ & + &5.6346e+00_r8,4.5721e+00_r8,3.1807e+00_r8,1.6688e+00_r8,2.1253e-02_r8/) + kbo(:, 4,38,10) = (/ & + &7.4639e+00_r8,6.0370e+00_r8,4.2092e+00_r8,2.2090e+00_r8,2.6215e-02_r8/) + kbo(:, 5,38,10) = (/ & + &9.6723e+00_r8,7.8054e+00_r8,5.4498e+00_r8,2.8669e+00_r8,3.1673e-02_r8/) + kbo(:, 1,39,10) = (/ & + &2.6346e+00_r8,2.1501e+00_r8,1.4897e+00_r8,7.8179e-01_r8,1.0494e-02_r8/) + kbo(:, 2,39,10) = (/ & + &3.6623e+00_r8,2.9868e+00_r8,2.0748e+00_r8,1.0900e+00_r8,1.3801e-02_r8/) + kbo(:, 3,39,10) = (/ & + &5.0149e+00_r8,4.0819e+00_r8,2.8376e+00_r8,1.4889e+00_r8,1.7948e-02_r8/) + kbo(:, 4,39,10) = (/ & + &6.7074e+00_r8,5.4432e+00_r8,3.7906e+00_r8,1.9883e+00_r8,2.2190e-02_r8/) + kbo(:, 5,39,10) = (/ & + &8.7675e+00_r8,7.1019e+00_r8,4.9572e+00_r8,2.6054e+00_r8,2.6961e-02_r8/) + kbo(:, 1,40,10) = (/ & + &2.2414e+00_r8,1.8312e+00_r8,1.2669e+00_r8,6.6464e-01_r8,8.6033e-03_r8/) + kbo(:, 2,40,10) = (/ & + &3.1461e+00_r8,2.5731e+00_r8,1.7855e+00_r8,9.3826e-01_r8,1.1425e-02_r8/) + kbo(:, 3,40,10) = (/ & + &4.3645e+00_r8,3.5639e+00_r8,2.4772e+00_r8,1.3001e+00_r8,1.5150e-02_r8/) + kbo(:, 4,40,10) = (/ & + &5.9195e+00_r8,4.8196e+00_r8,3.3561e+00_r8,1.7603e+00_r8,1.8984e-02_r8/) + kbo(:, 5,40,10) = (/ & + &7.8344e+00_r8,6.3662e+00_r8,4.4409e+00_r8,2.3324e+00_r8,2.3286e-02_r8/) + kbo(:, 1,41,10) = (/ & + &1.9009e+00_r8,1.5581e+00_r8,1.0772e+00_r8,5.6390e-01_r8,7.0145e-03_r8/) + kbo(:, 2,41,10) = (/ & + &2.6997e+00_r8,2.2094e+00_r8,1.5334e+00_r8,8.0488e-01_r8,9.5005e-03_r8/) + kbo(:, 3,41,10) = (/ & + &3.7885e+00_r8,3.1035e+00_r8,2.1567e+00_r8,1.1320e+00_r8,1.2665e-02_r8/) + kbo(:, 4,41,10) = (/ & + &5.2083e+00_r8,4.2587e+00_r8,2.9632e+00_r8,1.5552e+00_r8,1.6096e-02_r8/) + kbo(:, 5,41,10) = (/ & + &6.9899e+00_r8,5.6957e+00_r8,3.9715e+00_r8,2.0851e+00_r8,2.0007e-02_r8/) + kbo(:, 1,42,10) = (/ & + &1.6073e+00_r8,1.3214e+00_r8,9.1410e-01_r8,4.7869e-01_r8,5.6658e-03_r8/) + kbo(:, 2,42,10) = (/ & + &2.3166e+00_r8,1.9016e+00_r8,1.3175e+00_r8,6.9100e-01_r8,7.8082e-03_r8/) + kbo(:, 3,42,10) = (/ & + &3.2935e+00_r8,2.7045e+00_r8,1.8773e+00_r8,9.8575e-01_r8,1.0484e-02_r8/) + kbo(:, 4,42,10) = (/ & + &4.5881e+00_r8,3.7639e+00_r8,2.6177e+00_r8,1.3737e+00_r8,1.3601e-02_r8/) + kbo(:, 5,42,10) = (/ & + &6.2370e+00_r8,5.0967e+00_r8,3.5534e+00_r8,1.8654e+00_r8,1.7039e-02_r8/) + kbo(:, 1,43,10) = (/ & + &1.3404e+00_r8,1.1058e+00_r8,7.6461e-01_r8,4.0031e-01_r8,4.4847e-03_r8/) + kbo(:, 2,43,10) = (/ & + &1.9669e+00_r8,1.6173e+00_r8,1.1194e+00_r8,5.8704e-01_r8,6.2717e-03_r8/) + kbo(:, 3,43,10) = (/ & + &2.8361e+00_r8,2.3337e+00_r8,1.6185e+00_r8,8.4949e-01_r8,8.5308e-03_r8/) + kbo(:, 4,43,10) = (/ & + &4.0094e+00_r8,3.2948e+00_r8,2.2900e+00_r8,1.2020e+00_r8,1.1259e-02_r8/) + kbo(:, 5,43,10) = (/ & + &5.5262e+00_r8,4.5280e+00_r8,3.1542e+00_r8,1.6556e+00_r8,1.4384e-02_r8/) + kbo(:, 1,44,10) = (/ & + &1.1066e+00_r8,9.1547e-01_r8,6.3275e-01_r8,3.3150e-01_r8,3.4897e-03_r8/) + kbo(:, 2,44,10) = (/ & + &1.6542e+00_r8,1.3635e+00_r8,9.4399e-01_r8,4.9494e-01_r8,4.9430e-03_r8/) + kbo(:, 3,44,10) = (/ & + &2.4266e+00_r8,2.0020e+00_r8,1.3887e+00_r8,7.2847e-01_r8,6.8682e-03_r8/) + kbo(:, 4,44,10) = (/ & + &3.4886e+00_r8,2.8708e+00_r8,1.9931e+00_r8,1.0459e+00_r8,9.1381e-03_r8/) + kbo(:, 5,44,10) = (/ & + &4.8773e+00_r8,4.0046e+00_r8,2.7873e+00_r8,1.4630e+00_r8,1.1960e-02_r8/) + kbo(:, 1,45,10) = (/ & + &9.0739e-01_r8,7.5424e-01_r8,5.2128e-01_r8,2.7273e-01_r8,2.7098e-03_r8/) + kbo(:, 2,45,10) = (/ & + &1.3852e+00_r8,1.1467e+00_r8,7.9304e-01_r8,4.1578e-01_r8,3.8548e-03_r8/) + kbo(:, 3,45,10) = (/ & + &2.0713e+00_r8,1.7151e+00_r8,1.1892e+00_r8,6.2426e-01_r8,5.4604e-03_r8/) + kbo(:, 4,45,10) = (/ & + &3.0326e+00_r8,2.5006e+00_r8,1.7345e+00_r8,9.0988e-01_r8,7.3887e-03_r8/) + kbo(:, 5,45,10) = (/ & + &4.3008e+00_r8,3.5387e+00_r8,2.4612e+00_r8,1.2914e+00_r8,9.7321e-03_r8/) + kbo(:, 1,46,10) = (/ & + &7.3199e-01_r8,6.1145e-01_r8,4.2240e-01_r8,2.2117e-01_r8,2.0785e-03_r8/) + kbo(:, 2,46,10) = (/ & + &1.1438e+00_r8,9.5098e-01_r8,6.5833e-01_r8,3.4471e-01_r8,2.9805e-03_r8/) + kbo(:, 3,46,10) = (/ & + &1.7481e+00_r8,1.4525e+00_r8,1.0068e+00_r8,5.2845e-01_r8,4.2717e-03_r8/) + kbo(:, 4,46,10) = (/ & + &2.6098e+00_r8,2.1582e+00_r8,1.4963e+00_r8,7.8501e-01_r8,5.8631e-03_r8/) + kbo(:, 5,46,10) = (/ & + &3.7663e+00_r8,3.1031e+00_r8,2.1564e+00_r8,1.1312e+00_r8,7.7831e-03_r8/) + kbo(:, 1,47,10) = (/ & + &5.7232e-01_r8,4.8032e-01_r8,3.3210e-01_r8,1.7403e-01_r8,1.5461e-03_r8/) + kbo(:, 2,47,10) = (/ & + &9.2386e-01_r8,7.7116e-01_r8,5.3364e-01_r8,2.7934e-01_r8,2.3209e-03_r8/) + kbo(:, 3,47,10) = (/ & + &1.4429e+00_r8,1.2024e+00_r8,8.3406e-01_r8,4.3757e-01_r8,3.2763e-03_r8/) + kbo(:, 4,47,10) = (/ & + &2.2047e+00_r8,1.8273e+00_r8,1.2675e+00_r8,6.6495e-01_r8,4.5628e-03_r8/) + kbo(:, 5,47,10) = (/ & + &3.2456e+00_r8,2.6812e+00_r8,1.8614e+00_r8,9.7623e-01_r8,6.1070e-03_r8/) + kbo(:, 1,48,10) = (/ & + &4.4270e-01_r8,3.7313e-01_r8,2.5809e-01_r8,1.3535e-01_r8,1.1374e-03_r8/) + kbo(:, 2,48,10) = (/ & + &7.3749e-01_r8,6.1935e-01_r8,4.2906e-01_r8,2.2453e-01_r8,1.7379e-03_r8/) + kbo(:, 3,48,10) = (/ & + &1.1839e+00_r8,9.8928e-01_r8,6.8613e-01_r8,3.6002e-01_r8,2.5032e-03_r8/) + kbo(:, 4,48,10) = (/ & + &1.8512e+00_r8,1.5395e+00_r8,1.0677e+00_r8,5.6075e-01_r8,3.5238e-03_r8/) + kbo(:, 5,48,10) = (/ & + &2.7862e+00_r8,2.3065e+00_r8,1.6009e+00_r8,8.3981e-01_r8,4.7398e-03_r8/) + kbo(:, 1,49,10) = (/ & + &3.3829e-01_r8,2.8482e-01_r8,1.9699e-01_r8,1.0339e-01_r8,8.1861e-04_r8/) + kbo(:, 2,49,10) = (/ & + &5.8200e-01_r8,4.9068e-01_r8,3.4013e-01_r8,1.7816e-01_r8,1.2634e-03_r8/) + kbo(:, 3,49,10) = (/ & + &9.6365e-01_r8,8.0857e-01_r8,5.6081e-01_r8,2.9418e-01_r8,1.8795e-03_r8/) + kbo(:, 4,49,10) = (/ & + &1.5457e+00_r8,1.2894e+00_r8,8.9458e-01_r8,4.6973e-01_r8,2.7104e-03_r8/) + kbo(:, 5,49,10) = (/ & + &2.3812e+00_r8,1.9755e+00_r8,1.3708e+00_r8,7.1925e-01_r8,3.6105e-03_r8/) + kbo(:, 1,50,10) = (/ & + &2.5998e-01_r8,2.1962e-01_r8,1.5188e-01_r8,7.9506e-02_r8,6.0363e-04_r8/) + kbo(:, 2,50,10) = (/ & + &4.5974e-01_r8,3.8940e-01_r8,2.6982e-01_r8,1.4155e-01_r8,9.5023e-04_r8/) + kbo(:, 3,50,10) = (/ & + &7.8578e-01_r8,6.6189e-01_r8,4.5931e-01_r8,2.4091e-01_r8,1.4366e-03_r8/) + kbo(:, 4,50,10) = (/ & + &1.2930e+00_r8,1.0829e+00_r8,7.5147e-01_r8,3.9450e-01_r8,2.1250e-03_r8/) + kbo(:, 5,50,10) = (/ & + &2.0418e+00_r8,1.6990e+00_r8,1.1790e+00_r8,6.1880e-01_r8,2.8716e-03_r8/) + kbo(:, 1,51,10) = (/ & + &2.0132e-01_r8,1.6910e-01_r8,1.1674e-01_r8,6.1107e-02_r8,4.4485e-04_r8/) + kbo(:, 2,51,10) = (/ & + &3.6041e-01_r8,3.0656e-01_r8,2.1282e-01_r8,1.1161e-01_r8,7.3157e-04_r8/) + kbo(:, 3,51,10) = (/ & + &6.3582e-01_r8,5.3869e-01_r8,3.7423e-01_r8,1.9656e-01_r8,1.1225e-03_r8/) + kbo(:, 4,51,10) = (/ & + &1.0802e+00_r8,9.0777e-01_r8,6.3030e-01_r8,3.3074e-01_r8,1.6531e-03_r8/) + kbo(:, 5,51,10) = (/ & + &1.7498e+00_r8,1.4602e+00_r8,1.0135e+00_r8,5.3219e-01_r8,2.3172e-03_r8/) + kbo(:, 1,52,10) = (/ & + &1.5547e-01_r8,1.3052e-01_r8,9.0061e-02_r8,4.7075e-02_r8,3.3160e-04_r8/) + kbo(:, 2,52,10) = (/ & + &2.8347e-01_r8,2.4049e-01_r8,1.6666e-01_r8,8.7433e-02_r8,5.5078e-04_r8/) + kbo(:, 3,52,10) = (/ & + &5.1184e-01_r8,4.3501e-01_r8,3.0211e-01_r8,1.5868e-01_r8,8.7008e-04_r8/) + kbo(:, 4,52,10) = (/ & + &8.9697e-01_r8,7.5690e-01_r8,5.2561e-01_r8,2.7576e-01_r8,1.2672e-03_r8/) + kbo(:, 5,52,10) = (/ & + &1.4927e+00_r8,1.2493e+00_r8,8.6741e-01_r8,4.5551e-01_r8,1.8458e-03_r8/) + kbo(:, 1,53,10) = (/ & + &1.2003e-01_r8,1.0051e-01_r8,6.9268e-02_r8,3.6248e-02_r8,2.4457e-04_r8/) + kbo(:, 2,53,10) = (/ & + &2.2120e-01_r8,1.8754e-01_r8,1.2989e-01_r8,6.8226e-02_r8,4.0791e-04_r8/) + kbo(:, 3,53,10) = (/ & + &4.0694e-01_r8,3.4775e-01_r8,2.4176e-01_r8,1.2712e-01_r8,6.5057e-04_r8/) + kbo(:, 4,53,10) = (/ & + &7.3824e-01_r8,6.2670e-01_r8,4.3556e-01_r8,2.2862e-01_r8,9.8738e-04_r8/) + kbo(:, 5,53,10) = (/ & + &1.2666e+00_r8,1.0632e+00_r8,7.3852e-01_r8,3.8765e-01_r8,1.4077e-03_r8/) + kbo(:, 1,54,10) = (/ & + &9.3960e-02_r8,7.8771e-02_r8,5.4240e-02_r8,2.8401e-02_r8,1.9316e-04_r8/) + kbo(:, 2,54,10) = (/ & + &1.7676e-01_r8,1.4984e-01_r8,1.0336e-01_r8,5.4121e-02_r8,3.1568e-04_r8/) + kbo(:, 3,54,10) = (/ & + &3.2867e-01_r8,2.7969e-01_r8,1.9447e-01_r8,1.0231e-01_r8,5.2512e-04_r8/) + kbo(:, 4,54,10) = (/ & + &6.0965e-01_r8,5.1980e-01_r8,3.6169e-01_r8,1.9003e-01_r8,8.0976e-04_r8/) + kbo(:, 5,54,10) = (/ & + &1.0822e+00_r8,9.1223e-01_r8,6.3374e-01_r8,3.3269e-01_r8,1.1750e-03_r8/) + kbo(:, 1,55,10) = (/ & + &7.3906e-02_r8,6.2107e-02_r8,4.2864e-02_r8,2.2445e-02_r8,1.5599e-04_r8/) + kbo(:, 2,55,10) = (/ & + &1.4369e-01_r8,1.2050e-01_r8,8.3134e-02_r8,4.3567e-02_r8,2.5335e-04_r8/) + kbo(:, 3,55,10) = (/ & + &2.6760e-01_r8,2.2827e-01_r8,1.5835e-01_r8,8.3096e-02_r8,4.2909e-04_r8/) + kbo(:, 4,55,10) = (/ & + &5.0351e-01_r8,4.3105e-01_r8,3.0006e-01_r8,1.5782e-01_r8,6.9202e-04_r8/) + kbo(:, 5,55,10) = (/ & + &9.2458e-01_r8,7.8288e-01_r8,5.4396e-01_r8,2.8582e-01_r8,1.0207e-03_r8/) + kbo(:, 1,56,10) = (/ & + &5.7777e-02_r8,4.8496e-02_r8,3.3489e-02_r8,1.7579e-02_r8,1.2442e-04_r8/) + kbo(:, 2,56,10) = (/ & + &1.1665e-01_r8,9.7805e-02_r8,6.7433e-02_r8,3.5342e-02_r8,2.0689e-04_r8/) + kbo(:, 3,56,10) = (/ & + &2.1880e-01_r8,1.8636e-01_r8,1.2905e-01_r8,6.7804e-02_r8,3.5149e-04_r8/) + kbo(:, 4,56,10) = (/ & + &4.1579e-01_r8,3.5633e-01_r8,2.4779e-01_r8,1.3043e-01_r8,5.7437e-04_r8/) + kbo(:, 5,56,10) = (/ & + &7.8392e-01_r8,6.6810e-01_r8,4.6498e-01_r8,2.4434e-01_r8,8.7392e-04_r8/) + kbo(:, 1,57,10) = (/ & + &4.4962e-02_r8,3.7745e-02_r8,2.6020e-02_r8,1.3669e-02_r8,1.0074e-04_r8/) + kbo(:, 2,57,10) = (/ & + &9.3975e-02_r8,7.9039e-02_r8,5.4468e-02_r8,2.8583e-02_r8,1.6888e-04_r8/) + kbo(:, 3,57,10) = (/ & + &1.8083e-01_r8,1.5305e-01_r8,1.0598e-01_r8,5.5519e-02_r8,2.8180e-04_r8/) + kbo(:, 4,57,10) = (/ & + &3.4541e-01_r8,2.9431e-01_r8,2.0476e-01_r8,1.0780e-01_r8,4.7931e-04_r8/) + kbo(:, 5,57,10) = (/ & + &6.6212e-01_r8,5.6589e-01_r8,3.9390e-01_r8,2.0726e-01_r8,7.5979e-04_r8/) + kbo(:, 1,58,10) = (/ & + &1.7062e-02_r8,1.6422e-02_r8,1.3301e-02_r8,8.4676e-03_r8,8.2142e-05_r8/) + kbo(:, 2,58,10) = (/ & + &3.7044e-02_r8,3.5791e-02_r8,2.8933e-02_r8,1.8344e-02_r8,1.3979e-04_r8/) + kbo(:, 3,58,10) = (/ & + &7.3627e-02_r8,7.1176e-02_r8,5.7648e-02_r8,3.6534e-02_r8,2.3072e-04_r8/) + kbo(:, 4,58,10) = (/ & + &1.4036e-01_r8,1.3776e-01_r8,1.1219e-01_r8,7.1459e-02_r8,4.0521e-04_r8/) + kbo(:, 5,58,10) = (/ & + &2.7375e-01_r8,2.6857e-01_r8,2.1925e-01_r8,1.3965e-01_r8,6.6868e-04_r8/) + kbo(:, 1,59,10) = (/ & + &1.5026e-02_r8,1.4620e-02_r8,1.1891e-02_r8,7.6139e-03_r8,7.7772e-05_r8/) + kbo(:, 2,59,10) = (/ & + &3.3598e-02_r8,3.2618e-02_r8,2.6475e-02_r8,1.6873e-02_r8,1.3363e-04_r8/) + kbo(:, 3,59,10) = (/ & + &6.7778e-02_r8,6.5724e-02_r8,5.3548e-02_r8,3.4085e-02_r8,2.3127e-04_r8/) + kbo(:, 4,59,10) = (/ & + &1.2973e-01_r8,1.2749e-01_r8,1.0439e-01_r8,6.6705e-02_r8,3.9949e-04_r8/) + kbo(:, 5,59,10) = (/ & + &2.5383e-01_r8,2.5006e-01_r8,2.0520e-01_r8,1.3156e-01_r8,6.6551e-04_r8/) + kbo(:, 1,13,11) = (/ & + &6.1162e+01_r8,4.5871e+01_r8,3.0581e+01_r8,1.5291e+01_r8,3.0501e-01_r8/) + kbo(:, 2,13,11) = (/ & + &8.6643e+01_r8,6.4984e+01_r8,4.3324e+01_r8,2.1662e+01_r8,3.8069e-01_r8/) + kbo(:, 3,13,11) = (/ & + &1.1700e+02_r8,8.7751e+01_r8,5.8502e+01_r8,2.9250e+01_r8,4.9491e-01_r8/) + kbo(:, 4,13,11) = (/ & + &1.5190e+02_r8,1.1392e+02_r8,7.5955e+01_r8,3.7977e+01_r8,5.7908e-01_r8/) + kbo(:, 5,13,11) = (/ & + &1.9085e+02_r8,1.4314e+02_r8,9.5429e+01_r8,4.7715e+01_r8,6.6979e-01_r8/) + kbo(:, 1,14,11) = (/ & + &6.2014e+01_r8,4.6511e+01_r8,3.1007e+01_r8,1.5504e+01_r8,3.5592e-01_r8/) + kbo(:, 2,14,11) = (/ & + &8.7238e+01_r8,6.5431e+01_r8,4.3621e+01_r8,2.1811e+01_r8,3.9219e-01_r8/) + kbo(:, 3,14,11) = (/ & + &1.1714e+02_r8,8.7851e+01_r8,5.8570e+01_r8,2.9287e+01_r8,4.4292e-01_r8/) + kbo(:, 4,14,11) = (/ & + &1.5139e+02_r8,1.1354e+02_r8,7.5699e+01_r8,3.7864e+01_r8,5.2460e-01_r8/) + kbo(:, 5,14,11) = (/ & + &1.8982e+02_r8,1.4235e+02_r8,9.4908e+01_r8,4.7484e+01_r8,6.6257e-01_r8/) + kbo(:, 1,15,11) = (/ & + &5.9186e+01_r8,4.4388e+01_r8,2.9592e+01_r8,1.4841e+01_r8,3.2021e-01_r8/) + kbo(:, 2,15,11) = (/ & + &8.2638e+01_r8,6.1979e+01_r8,4.1319e+01_r8,2.0713e+01_r8,3.7708e-01_r8/) + kbo(:, 3,15,11) = (/ & + &1.1028e+02_r8,8.2716e+01_r8,5.5144e+01_r8,2.7652e+01_r8,4.6488e-01_r8/) + kbo(:, 4,15,11) = (/ & + &1.4201e+02_r8,1.0651e+02_r8,7.1008e+01_r8,3.5635e+01_r8,5.3643e-01_r8/) + kbo(:, 5,15,11) = (/ & + &1.7780e+02_r8,1.3336e+02_r8,8.8908e+01_r8,4.4680e+01_r8,6.1809e-01_r8/) + kbo(:, 1,16,11) = (/ & + &5.3877e+01_r8,4.0407e+01_r8,2.6940e+01_r8,1.3617e+01_r8,3.0459e-01_r8/) + kbo(:, 2,16,11) = (/ & + &7.4732e+01_r8,5.6052e+01_r8,3.7368e+01_r8,1.8895e+01_r8,3.6381e-01_r8/) + kbo(:, 3,16,11) = (/ & + &9.9303e+01_r8,7.4473e+01_r8,4.9649e+01_r8,2.5124e+01_r8,4.2325e-01_r8/) + kbo(:, 4,16,11) = (/ & + &1.2768e+02_r8,9.5754e+01_r8,6.3837e+01_r8,3.2325e+01_r8,4.7285e-01_r8/) + kbo(:, 5,16,11) = (/ & + &1.5927e+02_r8,1.1945e+02_r8,7.9632e+01_r8,4.0351e+01_r8,5.0976e-01_r8/) + kbo(:, 1,17,11) = (/ & + &4.7648e+01_r8,3.5735e+01_r8,2.3823e+01_r8,1.2164e+01_r8,2.5744e-01_r8/) + kbo(:, 2,17,11) = (/ & + &6.5724e+01_r8,4.9293e+01_r8,3.2863e+01_r8,1.6792e+01_r8,3.1059e-01_r8/) + kbo(:, 3,17,11) = (/ & + &8.7138e+01_r8,6.5349e+01_r8,4.3569e+01_r8,2.2270e+01_r8,3.5847e-01_r8/) + kbo(:, 4,17,11) = (/ & + &1.1169e+02_r8,8.3769e+01_r8,5.5845e+01_r8,2.8543e+01_r8,4.0184e-01_r8/) + kbo(:, 5,17,11) = (/ & + &1.3846e+02_r8,1.0385e+02_r8,6.9237e+01_r8,3.5386e+01_r8,4.6254e-01_r8/) + kbo(:, 1,18,11) = (/ & + &4.0731e+01_r8,3.0550e+01_r8,2.0398e+01_r8,1.0482e+01_r8,2.2929e-01_r8/) + kbo(:, 2,18,11) = (/ & + &5.6038e+01_r8,4.2027e+01_r8,2.8058e+01_r8,1.4421e+01_r8,2.6841e-01_r8/) + kbo(:, 3,18,11) = (/ & + &7.4130e+01_r8,5.5602e+01_r8,3.7127e+01_r8,1.9095e+01_r8,3.0083e-01_r8/) + kbo(:, 4,18,11) = (/ & + &9.4414e+01_r8,7.0811e+01_r8,4.7323e+01_r8,2.4371e+01_r8,3.4142e-01_r8/) + kbo(:, 5,18,11) = (/ & + &1.1687e+02_r8,8.7655e+01_r8,5.8604e+01_r8,3.0228e+01_r8,3.9932e-01_r8/) + kbo(:, 1,19,11) = (/ & + &3.5043e+01_r8,2.6281e+01_r8,1.7645e+01_r8,9.0880e+00_r8,1.9041e-01_r8/) + kbo(:, 2,19,11) = (/ & + &4.8095e+01_r8,3.6072e+01_r8,2.4224e+01_r8,1.2500e+01_r8,2.2005e-01_r8/) + kbo(:, 3,19,11) = (/ & + &6.3280e+01_r8,4.7465e+01_r8,3.1884e+01_r8,1.6505e+01_r8,2.5190e-01_r8/) + kbo(:, 4,19,11) = (/ & + &8.0459e+01_r8,6.0352e+01_r8,4.0562e+01_r8,2.1050e+01_r8,3.0347e-01_r8/) + kbo(:, 5,19,11) = (/ & + &9.9405e+01_r8,7.4555e+01_r8,5.0141e+01_r8,2.6072e+01_r8,3.3814e-01_r8/) + kbo(:, 1,20,11) = (/ & + &3.0698e+01_r8,2.3028e+01_r8,1.5559e+01_r8,8.0744e+00_r8,1.6851e-01_r8/) + kbo(:, 2,20,11) = (/ & + &4.1938e+01_r8,3.1449e+01_r8,2.1266e+01_r8,1.1075e+01_r8,1.9604e-01_r8/) + kbo(:, 3,20,11) = (/ & + &5.4971e+01_r8,4.1226e+01_r8,2.7873e+01_r8,1.4553e+01_r8,2.3334e-01_r8/) + kbo(:, 4,20,11) = (/ & + &6.9683e+01_r8,5.2264e+01_r8,3.5322e+01_r8,1.8474e+01_r8,2.8155e-01_r8/) + kbo(:, 5,20,11) = (/ & + &8.5796e+01_r8,6.4350e+01_r8,4.3496e+01_r8,2.2781e+01_r8,3.1819e-01_r8/) + kbo(:, 1,21,11) = (/ & + &2.6961e+01_r8,2.0239e+01_r8,1.3721e+01_r8,7.2357e+00_r8,1.5633e-01_r8/) + kbo(:, 2,21,11) = (/ & + &3.6624e+01_r8,2.7486e+01_r8,1.8642e+01_r8,9.8382e+00_r8,1.8477e-01_r8/) + kbo(:, 3,21,11) = (/ & + &4.7842e+01_r8,3.5913e+01_r8,2.4362e+01_r8,1.2852e+01_r8,2.2793e-01_r8/) + kbo(:, 4,21,11) = (/ & + &6.0403e+01_r8,4.5355e+01_r8,3.0794e+01_r8,1.6247e+01_r8,2.5875e-01_r8/) + kbo(:, 5,21,11) = (/ & + &7.4328e+01_r8,5.5827e+01_r8,3.7921e+01_r8,1.9978e+01_r8,3.0003e-01_r8/) + kbo(:, 1,22,11) = (/ & + &2.4106e+01_r8,1.8145e+01_r8,1.2318e+01_r8,6.5788e+00_r8,1.4346e-01_r8/) + kbo(:, 2,22,11) = (/ & + &3.2489e+01_r8,2.4455e+01_r8,1.6620e+01_r8,8.8645e+00_r8,1.7673e-01_r8/) + kbo(:, 3,22,11) = (/ & + &4.2111e+01_r8,3.1704e+01_r8,2.1585e+01_r8,1.1502e+01_r8,2.1135e-01_r8/) + kbo(:, 4,22,11) = (/ & + &5.3091e+01_r8,3.9979e+01_r8,2.7248e+01_r8,1.4479e+01_r8,2.4545e-01_r8/) + kbo(:, 5,22,11) = (/ & + &6.5531e+01_r8,4.9344e+01_r8,3.3661e+01_r8,1.7840e+01_r8,2.8184e-01_r8/) + kbo(:, 1,23,11) = (/ & + &2.1586e+01_r8,1.6314e+01_r8,1.1115e+01_r8,5.9696e+00_r8,1.3118e-01_r8/) + kbo(:, 2,23,11) = (/ & + &2.8872e+01_r8,2.1824e+01_r8,1.4900e+01_r8,7.9884e+00_r8,1.6791e-01_r8/) + kbo(:, 3,23,11) = (/ & + &3.7392e+01_r8,2.8256e+01_r8,1.9318e+01_r8,1.0333e+01_r8,1.9239e-01_r8/) + kbo(:, 4,23,11) = (/ & + &4.7286e+01_r8,3.5715e+01_r8,2.4417e+01_r8,1.3025e+01_r8,2.2854e-01_r8/) + kbo(:, 5,23,11) = (/ & + &5.8587e+01_r8,4.4225e+01_r8,3.0228e+01_r8,1.6103e+01_r8,2.6383e-01_r8/) + kbo(:, 1,24,11) = (/ & + &1.9610e+01_r8,1.4859e+01_r8,1.0204e+01_r8,5.4843e+00_r8,1.2305e-01_r8/) + kbo(:, 2,24,11) = (/ & + &2.6168e+01_r8,1.9825e+01_r8,1.3617e+01_r8,7.3028e+00_r8,1.4696e-01_r8/) + kbo(:, 3,24,11) = (/ & + &3.4009e+01_r8,2.5754e+01_r8,1.7666e+01_r8,9.4475e+00_r8,1.7619e-01_r8/) + kbo(:, 4,24,11) = (/ & + &4.3202e+01_r8,3.2697e+01_r8,2.2398e+01_r8,1.1966e+01_r8,2.0711e-01_r8/) + kbo(:, 5,24,11) = (/ & + &5.3950e+01_r8,4.0810e+01_r8,2.7914e+01_r8,1.4881e+01_r8,2.4491e-01_r8/) + kbo(:, 1,25,11) = (/ & + &1.7913e+01_r8,1.3599e+01_r8,9.4137e+00_r8,5.0616e+00_r8,1.1244e-01_r8/) + kbo(:, 2,25,11) = (/ & + &2.4002e+01_r8,1.8218e+01_r8,1.2577e+01_r8,6.7433e+00_r8,1.3574e-01_r8/) + kbo(:, 3,25,11) = (/ & + &3.1373e+01_r8,2.3808e+01_r8,1.6390e+01_r8,8.7732e+00_r8,1.6587e-01_r8/) + kbo(:, 4,25,11) = (/ & + &4.0212e+01_r8,3.0510e+01_r8,2.0949e+01_r8,1.1182e+01_r8,1.9353e-01_r8/) + kbo(:, 5,25,11) = (/ & + &5.0507e+01_r8,3.8314e+01_r8,2.6252e+01_r8,1.3993e+01_r8,2.2689e-01_r8/) + kbo(:, 1,26,11) = (/ & + &1.6610e+01_r8,1.2648e+01_r8,8.7899e+00_r8,4.7180e+00_r8,1.0410e-01_r8/) + kbo(:, 2,26,11) = (/ & + &2.2395e+01_r8,1.7048e+01_r8,1.1804e+01_r8,6.3257e+00_r8,1.2812e-01_r8/) + kbo(:, 3,26,11) = (/ & + &2.9495e+01_r8,2.2453e+01_r8,1.5498e+01_r8,8.2851e+00_r8,1.5321e-01_r8/) + kbo(:, 4,26,11) = (/ & + &3.7868e+01_r8,2.8829e+01_r8,1.9854e+01_r8,1.0593e+01_r8,1.8381e-01_r8/) + kbo(:, 5,26,11) = (/ & + &4.7321e+01_r8,3.6030e+01_r8,2.4795e+01_r8,1.3247e+01_r8,2.1577e-01_r8/) + kbo(:, 1,27,11) = (/ & + &1.5552e+01_r8,1.1893e+01_r8,8.2787e+00_r8,4.4401e+00_r8,9.5478e-02_r8/) + kbo(:, 2,27,11) = (/ & + &2.1129e+01_r8,1.6157e+01_r8,1.1211e+01_r8,5.9970e+00_r8,1.1930e-01_r8/) + kbo(:, 3,27,11) = (/ & + &2.7798e+01_r8,2.1248e+01_r8,1.4714e+01_r8,7.8588e+00_r8,1.4147e-01_r8/) + kbo(:, 4,27,11) = (/ & + &3.5437e+01_r8,2.7084e+01_r8,1.8740e+01_r8,1.0024e+01_r8,1.6966e-01_r8/) + kbo(:, 5,27,11) = (/ & + &4.4196e+01_r8,3.3778e+01_r8,2.3350e+01_r8,1.2494e+01_r8,2.0142e-01_r8/) + kbo(:, 1,28,11) = (/ & + &1.4683e+01_r8,1.1292e+01_r8,7.8718e+00_r8,4.2106e+00_r8,8.7356e-02_r8/) + kbo(:, 2,28,11) = (/ & + &1.9886e+01_r8,1.5281e+01_r8,1.0638e+01_r8,5.6861e+00_r8,1.0714e-01_r8/) + kbo(:, 3,28,11) = (/ & + &2.5973e+01_r8,1.9937e+01_r8,1.3871e+01_r8,7.4210e+00_r8,1.3061e-01_r8/) + kbo(:, 4,28,11) = (/ & + &3.3032e+01_r8,2.5345e+01_r8,1.7630e+01_r8,9.4399e+00_r8,1.5744e-01_r8/) + kbo(:, 5,28,11) = (/ & + &4.1210e+01_r8,3.1582e+01_r8,2.1933e+01_r8,1.1759e+01_r8,1.8456e-01_r8/) + kbo(:, 1,29,11) = (/ & + &1.3790e+01_r8,1.0662e+01_r8,7.4451e+00_r8,3.9766e+00_r8,7.8021e-02_r8/) + kbo(:, 2,29,11) = (/ & + &1.8507e+01_r8,1.4288e+01_r8,9.9758e+00_r8,5.3363e+00_r8,9.5820e-02_r8/) + kbo(:, 3,29,11) = (/ & + &2.4091e+01_r8,1.8575e+01_r8,1.2977e+01_r8,6.9398e+00_r8,1.1898e-01_r8/) + kbo(:, 4,29,11) = (/ & + &3.0652e+01_r8,2.3593e+01_r8,1.6474e+01_r8,8.8251e+00_r8,1.4373e-01_r8/) + kbo(:, 5,29,11) = (/ & + &3.8268e+01_r8,2.9419e+01_r8,2.0534e+01_r8,1.1026e+01_r8,1.6837e-01_r8/) + kbo(:, 1,30,11) = (/ & + &1.2835e+01_r8,9.9842e+00_r8,6.9893e+00_r8,3.7286e+00_r8,6.9765e-02_r8/) + kbo(:, 2,30,11) = (/ & + &1.7126e+01_r8,1.3305e+01_r8,9.3238e+00_r8,4.9785e+00_r8,8.7990e-02_r8/) + kbo(:, 3,30,11) = (/ & + &2.2319e+01_r8,1.7278e+01_r8,1.2100e+01_r8,6.4728e+00_r8,1.0830e-01_r8/) + kbo(:, 4,30,11) = (/ & + &2.8412e+01_r8,2.1956e+01_r8,1.5383e+01_r8,8.2493e+00_r8,1.2854e-01_r8/) + kbo(:, 5,30,11) = (/ & + &3.5540e+01_r8,2.7422e+01_r8,1.9221e+01_r8,1.0332e+01_r8,1.5041e-01_r8/) + kbo(:, 1,31,11) = (/ & + &1.1866e+01_r8,9.2840e+00_r8,6.5153e+00_r8,3.4693e+00_r8,6.2880e-02_r8/) + kbo(:, 2,31,11) = (/ & + &1.5808e+01_r8,1.2342e+01_r8,8.6596e+00_r8,4.6193e+00_r8,7.8616e-02_r8/) + kbo(:, 3,31,11) = (/ & + &2.0587e+01_r8,1.6022e+01_r8,1.1250e+01_r8,6.0171e+00_r8,9.4908e-02_r8/) + kbo(:, 4,31,11) = (/ & + &2.6251e+01_r8,2.0378e+01_r8,1.4318e+01_r8,7.6818e+00_r8,1.1384e-01_r8/) + kbo(:, 5,31,11) = (/ & + &3.2893e+01_r8,2.5487e+01_r8,1.7928e+01_r8,9.6467e+00_r8,1.3241e-01_r8/) + kbo(:, 1,32,11) = (/ & + &1.1095e+01_r8,8.7224e+00_r8,6.1226e+00_r8,3.2519e+00_r8,5.6839e-02_r8/) + kbo(:, 2,32,11) = (/ & + &1.4751e+01_r8,1.1560e+01_r8,8.1226e+00_r8,4.3325e+00_r8,7.0855e-02_r8/) + kbo(:, 3,32,11) = (/ & + &1.9205e+01_r8,1.5015e+01_r8,1.0554e+01_r8,5.6424e+00_r8,8.5721e-02_r8/) + kbo(:, 4,32,11) = (/ & + &2.4504e+01_r8,1.9119e+01_r8,1.3461e+01_r8,7.2214e+00_r8,1.0137e-01_r8/) + kbo(:, 5,32,11) = (/ & + &3.0723e+01_r8,2.3918e+01_r8,1.6887e+01_r8,9.0922e+00_r8,1.2101e-01_r8/) + kbo(:, 1,33,11) = (/ & + &1.0469e+01_r8,8.2653e+00_r8,5.8027e+00_r8,3.0803e+00_r8,5.1389e-02_r8/) + kbo(:, 2,33,11) = (/ & + &1.3905e+01_r8,1.0963e+01_r8,7.7038e+00_r8,4.0998e+00_r8,6.3408e-02_r8/) + kbo(:, 3,33,11) = (/ & + &1.8080e+01_r8,1.4209e+01_r8,9.9969e+00_r8,5.3421e+00_r8,7.7128e-02_r8/) + kbo(:, 4,33,11) = (/ & + &2.3055e+01_r8,1.8085e+01_r8,1.2765e+01_r8,6.8504e+00_r8,9.2141e-02_r8/) + kbo(:, 5,33,11) = (/ & + &2.8901e+01_r8,2.2629e+01_r8,1.6031e+01_r8,8.6400e+00_r8,1.0949e-01_r8/) + kbo(:, 1,34,11) = (/ & + &9.9524e+00_r8,7.8988e+00_r8,5.5437e+00_r8,2.9382e+00_r8,4.7321e-02_r8/) + kbo(:, 2,34,11) = (/ & + &1.3224e+01_r8,1.0461e+01_r8,7.3463e+00_r8,3.9087e+00_r8,5.8418e-02_r8/) + kbo(:, 3,34,11) = (/ & + &1.7166e+01_r8,1.3560e+01_r8,9.5537e+00_r8,5.1034e+00_r8,7.0181e-02_r8/) + kbo(:, 4,34,11) = (/ & + &2.1887e+01_r8,1.7264e+01_r8,1.2211e+01_r8,6.5526e+00_r8,8.4706e-02_r8/) + kbo(:, 5,34,11) = (/ & + &2.7487e+01_r8,2.1622e+01_r8,1.5350e+01_r8,8.2698e+00_r8,9.8588e-02_r8/) + kbo(:, 1,35,11) = (/ & + &9.2896e+00_r8,7.3988e+00_r8,5.1836e+00_r8,2.7478e+00_r8,4.1417e-02_r8/) + kbo(:, 2,35,11) = (/ & + &1.2346e+01_r8,9.8120e+00_r8,6.8895e+00_r8,3.6621e+00_r8,5.1614e-02_r8/) + kbo(:, 3,35,11) = (/ & + &1.6038e+01_r8,1.2737e+01_r8,8.9856e+00_r8,4.7992e+00_r8,6.2173e-02_r8/) + kbo(:, 4,35,11) = (/ & + &2.0501e+01_r8,1.6246e+01_r8,1.1507e+01_r8,6.1715e+00_r8,7.4346e-02_r8/) + kbo(:, 5,35,11) = (/ & + &2.5865e+01_r8,2.0429e+01_r8,1.4515e+01_r8,7.8139e+00_r8,8.6989e-02_r8/) + kbo(:, 1,36,11) = (/ & + &8.4641e+00_r8,6.7680e+00_r8,4.7384e+00_r8,2.5089e+00_r8,3.5370e-02_r8/) + kbo(:, 2,36,11) = (/ & + &1.1283e+01_r8,9.0077e+00_r8,6.3272e+00_r8,3.3586e+00_r8,4.3427e-02_r8/) + kbo(:, 3,36,11) = (/ & + &1.4709e+01_r8,1.1740e+01_r8,8.2852e+00_r8,4.4192e+00_r8,5.3699e-02_r8/) + kbo(:, 4,36,11) = (/ & + &1.8892e+01_r8,1.5035e+01_r8,1.0652e+01_r8,5.7082e+00_r8,6.4287e-02_r8/) + kbo(:, 5,36,11) = (/ & + &2.3976e+01_r8,1.9028e+01_r8,1.3526e+01_r8,7.2706e+00_r8,7.5870e-02_r8/) + kbo(:, 1,37,11) = (/ & + &7.4506e+00_r8,5.9897e+00_r8,4.1905e+00_r8,2.2153e+00_r8,2.9963e-02_r8/) + kbo(:, 2,37,11) = (/ & + &1.0029e+01_r8,8.0389e+00_r8,5.6426e+00_r8,2.9898e+00_r8,3.7220e-02_r8/) + kbo(:, 3,37,11) = (/ & + &1.3144e+01_r8,1.0534e+01_r8,7.4309e+00_r8,3.9559e+00_r8,4.6416e-02_r8/) + kbo(:, 4,37,11) = (/ & + &1.6999e+01_r8,1.3585e+01_r8,9.6217e+00_r8,5.1490e+00_r8,5.5486e-02_r8/) + kbo(:, 5,37,11) = (/ & + &2.1741e+01_r8,1.7327e+01_r8,1.2322e+01_r8,6.6152e+00_r8,6.5816e-02_r8/) + kbo(:, 1,38,11) = (/ & + &6.5566e+00_r8,5.3014e+00_r8,3.7057e+00_r8,1.9579e+00_r8,2.5356e-02_r8/) + kbo(:, 2,38,11) = (/ & + &8.9151e+00_r8,7.1841e+00_r8,5.0400e+00_r8,2.6656e+00_r8,3.1891e-02_r8/) + kbo(:, 3,38,11) = (/ & + &1.1778e+01_r8,9.4689e+00_r8,6.6768e+00_r8,3.5488e+00_r8,3.9709e-02_r8/) + kbo(:, 4,38,11) = (/ & + &1.5333e+01_r8,1.2304e+01_r8,8.7122e+00_r8,4.6542e+00_r8,4.7360e-02_r8/) + kbo(:, 5,38,11) = (/ & + &1.9762e+01_r8,1.5812e+01_r8,1.1244e+01_r8,6.0319e+00_r8,5.6650e-02_r8/) + kbo(:, 1,39,11) = (/ & + &5.7815e+00_r8,4.6987e+00_r8,3.2839e+00_r8,1.7336e+00_r8,2.1361e-02_r8/) + kbo(:, 2,39,11) = (/ & + &7.9403e+00_r8,6.4302e+00_r8,4.5109e+00_r8,2.3848e+00_r8,2.6909e-02_r8/) + kbo(:, 3,39,11) = (/ & + &1.0589e+01_r8,8.5486e+00_r8,6.0232e+00_r8,3.1966e+00_r8,3.3274e-02_r8/) + kbo(:, 4,39,11) = (/ & + &1.3890e+01_r8,1.1188e+01_r8,7.9191e+00_r8,4.2244e+00_r8,4.0390e-02_r8/) + kbo(:, 5,39,11) = (/ & + &1.8032e+01_r8,1.4487e+01_r8,1.0297e+01_r8,5.5201e+00_r8,4.8824e-02_r8/) + kbo(:, 1,40,11) = (/ & + &4.9663e+00_r8,4.0580e+00_r8,2.8368e+00_r8,1.4961e+00_r8,1.7977e-02_r8/) + kbo(:, 2,40,11) = (/ & + &6.9269e+00_r8,5.6391e+00_r8,3.9540e+00_r8,2.0894e+00_r8,2.2949e-02_r8/) + kbo(:, 3,40,11) = (/ & + &9.3578e+00_r8,7.5891e+00_r8,5.3452e+00_r8,2.8327e+00_r8,2.8350e-02_r8/) + kbo(:, 4,40,11) = (/ & + &1.2407e+01_r8,1.0028e+01_r8,7.0894e+00_r8,3.7744e+00_r8,3.4399e-02_r8/) + kbo(:, 5,40,11) = (/ & + &1.6240e+01_r8,1.3091e+01_r8,9.2991e+00_r8,4.9787e+00_r8,4.2027e-02_r8/) + kbo(:, 1,41,11) = (/ & + &4.2485e+00_r8,3.4862e+00_r8,2.4352e+00_r8,1.2849e+00_r8,1.5088e-02_r8/) + kbo(:, 2,41,11) = (/ & + &6.0166e+00_r8,4.9271e+00_r8,3.4537e+00_r8,1.8243e+00_r8,1.9453e-02_r8/) + kbo(:, 3,41,11) = (/ & + &8.2485e+00_r8,6.7221e+00_r8,4.7321e+00_r8,2.5060e+00_r8,2.4198e-02_r8/) + kbo(:, 4,41,11) = (/ & + &1.1066e+01_r8,8.9791e+00_r8,6.3459e+00_r8,3.3734e+00_r8,2.9570e-02_r8/) + kbo(:, 5,41,11) = (/ & + &1.4636e+01_r8,1.1834e+01_r8,8.3996e+00_r8,4.4886e+00_r8,3.6128e-02_r8/) + kbo(:, 1,42,11) = (/ & + &3.6346e+00_r8,2.9948e+00_r8,2.0896e+00_r8,1.1018e+00_r8,1.2599e-02_r8/) + kbo(:, 2,42,11) = (/ & + &5.2244e+00_r8,4.2974e+00_r8,3.0116e+00_r8,1.5911e+00_r8,1.6323e-02_r8/) + kbo(:, 3,42,11) = (/ & + &7.2643e+00_r8,5.9499e+00_r8,4.1877e+00_r8,2.2172e+00_r8,2.0619e-02_r8/) + kbo(:, 4,42,11) = (/ & + &9.8747e+00_r8,8.0447e+00_r8,5.6854e+00_r8,3.0206e+00_r8,2.5282e-02_r8/) + kbo(:, 5,42,11) = (/ & + &1.3206e+01_r8,1.0716e+01_r8,7.6001e+00_r8,4.0544e+00_r8,3.0876e-02_r8/) + kbo(:, 1,43,11) = (/ & + &3.0660e+00_r8,2.5370e+00_r8,1.7687e+00_r8,9.3216e-01_r8,1.0308e-02_r8/) + kbo(:, 2,43,11) = (/ & + &4.4856e+00_r8,3.7056e+00_r8,2.5945e+00_r8,1.3700e+00_r8,1.3601e-02_r8/) + kbo(:, 3,43,11) = (/ & + &6.3372e+00_r8,5.2140e+00_r8,3.6676e+00_r8,1.9419e+00_r8,1.7306e-02_r8/) + kbo(:, 4,43,11) = (/ & + &8.7409e+00_r8,7.1536e+00_r8,5.0545e+00_r8,2.6839e+00_r8,2.1526e-02_r8/) + kbo(:, 5,43,11) = (/ & + &1.1846e+01_r8,9.6432e+00_r8,6.8374e+00_r8,3.6437e+00_r8,2.6238e-02_r8/) + kbo(:, 1,44,11) = (/ & + &2.5664e+00_r8,2.1306e+00_r8,1.4853e+00_r8,7.8185e-01_r8,8.3390e-03_r8/) + kbo(:, 2,44,11) = (/ & + &3.8265e+00_r8,3.1748e+00_r8,2.2204e+00_r8,1.1717e+00_r8,1.1111e-02_r8/) + kbo(:, 3,44,11) = (/ & + &5.5006e+00_r8,4.5418e+00_r8,3.1915e+00_r8,1.6892e+00_r8,1.4312e-02_r8/) + kbo(:, 4,44,11) = (/ & + &7.6990e+00_r8,6.3295e+00_r8,4.4707e+00_r8,2.3728e+00_r8,1.8022e-02_r8/) + kbo(:, 5,44,11) = (/ & + &1.0590e+01_r8,8.6508e+00_r8,6.1308e+00_r8,3.2656e+00_r8,2.2284e-02_r8/) + kbo(:, 1,45,11) = (/ & + &2.1449e+00_r8,1.7852e+00_r8,1.2434e+00_r8,6.5459e-01_r8,6.5374e-03_r8/) + kbo(:, 2,45,11) = (/ & + &3.2586e+00_r8,2.7120e+00_r8,1.8962e+00_r8,1.0002e+00_r8,8.9661e-03_r8/) + kbo(:, 3,45,11) = (/ & + &4.7677e+00_r8,3.9512e+00_r8,2.7729e+00_r8,1.4668e+00_r8,1.1723e-02_r8/) + kbo(:, 4,45,11) = (/ & + &6.7759e+00_r8,5.5907e+00_r8,3.9459e+00_r8,2.0943e+00_r8,1.4893e-02_r8/) + kbo(:, 5,45,11) = (/ & + &9.4617e+00_r8,7.7574e+00_r8,5.4954e+00_r8,2.9257e+00_r8,1.8879e-02_r8/) + kbo(:, 1,46,11) = (/ & + &1.7693e+00_r8,1.4778e+00_r8,1.0286e+00_r8,5.4110e-01_r8,5.0474e-03_r8/) + kbo(:, 2,46,11) = (/ & + &2.7478e+00_r8,2.2930e+00_r8,1.6009e+00_r8,8.4457e-01_r8,7.0726e-03_r8/) + kbo(:, 3,46,11) = (/ & + &4.0941e+00_r8,3.4053e+00_r8,2.3875e+00_r8,1.2626e+00_r8,9.5023e-03_r8/) + kbo(:, 4,46,11) = (/ & + &5.9189e+00_r8,4.8999e+00_r8,3.4535e+00_r8,1.8324e+00_r8,1.2322e-02_r8/) + kbo(:, 5,46,11) = (/ & + &8.3887e+00_r8,6.9026e+00_r8,4.8893e+00_r8,2.6020e+00_r8,1.5617e-02_r8/) + kbo(:, 1,47,11) = (/ & + &1.4241e+00_r8,1.1941e+00_r8,8.3002e-01_r8,4.3643e-01_r8,3.7828e-03_r8/) + kbo(:, 2,47,11) = (/ & + &2.2698e+00_r8,1.8986e+00_r8,1.3247e+00_r8,6.9822e-01_r8,5.4676e-03_r8/) + kbo(:, 3,47,11) = (/ & + &3.4547e+00_r8,2.8836e+00_r8,2.0196e+00_r8,1.0678e+00_r8,7.6213e-03_r8/) + kbo(:, 4,47,11) = (/ & + &5.0871e+00_r8,4.2288e+00_r8,2.9766e+00_r8,1.5778e+00_r8,9.9658e-03_r8/) + kbo(:, 5,47,11) = (/ & + &7.3321e+00_r8,6.0542e+00_r8,4.2837e+00_r8,2.2790e+00_r8,1.3055e-02_r8/) + kbo(:, 1,48,11) = (/ & + &1.1337e+00_r8,9.5606e-01_r8,6.6479e-01_r8,3.4941e-01_r8,2.8319e-03_r8/) + kbo(:, 2,48,11) = (/ & + &1.8661e+00_r8,1.5653e+00_r8,1.0902e+00_r8,5.7432e-01_r8,4.1758e-03_r8/) + kbo(:, 3,48,11) = (/ & + &2.9045e+00_r8,2.4321e+00_r8,1.7012e+00_r8,8.9870e-01_r8,5.9617e-03_r8/) + kbo(:, 4,48,11) = (/ & + &4.3570e+00_r8,3.6357e+00_r8,2.5565e+00_r8,1.3546e+00_r8,7.9840e-03_r8/) + kbo(:, 5,48,11) = (/ & + &6.3922e+00_r8,5.2980e+00_r8,3.7432e+00_r8,1.9904e+00_r8,1.0519e-02_r8/) + kbo(:, 1,49,11) = (/ & + &8.9211e-01_r8,7.5781e-01_r8,5.2674e-01_r8,2.7699e-01_r8,2.0587e-03_r8/) + kbo(:, 2,49,11) = (/ & + &1.5203e+00_r8,1.2812e+00_r8,8.9206e-01_r8,4.6970e-01_r8,3.1077e-03_r8/) + kbo(:, 3,49,11) = (/ & + &2.4343e+00_r8,2.0415e+00_r8,1.4265e+00_r8,7.5292e-01_r8,4.5062e-03_r8/) + kbo(:, 4,49,11) = (/ & + &3.7205e+00_r8,3.1142e+00_r8,2.1868e+00_r8,1.1585e+00_r8,6.1377e-03_r8/) + kbo(:, 5,49,11) = (/ & + &5.5564e+00_r8,4.6243e+00_r8,3.2638e+00_r8,1.7346e+00_r8,8.3879e-03_r8/) + kbo(:, 1,50,11) = (/ & + &6.9944e-01_r8,5.9730e-01_r8,4.1544e-01_r8,2.1892e-01_r8,1.5159e-03_r8/) + kbo(:, 2,50,11) = (/ & + &1.2386e+00_r8,1.0495e+00_r8,7.3105e-01_r8,3.8493e-01_r8,2.3639e-03_r8/) + kbo(:, 3,50,11) = (/ & + &2.0475e+00_r8,1.7233e+00_r8,1.2030e+00_r8,6.3443e-01_r8,3.5129e-03_r8/) + kbo(:, 4,50,11) = (/ & + &3.1987e+00_r8,2.6838e+00_r8,1.8828e+00_r8,9.9721e-01_r8,4.9131e-03_r8/) + kbo(:, 5,50,11) = (/ & + &4.8613e+00_r8,4.0604e+00_r8,2.8638e+00_r8,1.5216e+00_r8,6.8102e-03_r8/) + kbo(:, 1,51,11) = (/ & + &5.4324e-01_r8,4.6725e-01_r8,3.2546e-01_r8,1.7172e-01_r8,1.1297e-03_r8/) + kbo(:, 2,51,11) = (/ & + &1.0054e+00_r8,8.5632e-01_r8,5.9623e-01_r8,3.1426e-01_r8,1.7844e-03_r8/) + kbo(:, 3,51,11) = (/ & + &1.7180e+00_r8,1.4523e+00_r8,1.0136e+00_r8,5.3456e-01_r8,2.7288e-03_r8/) + kbo(:, 4,51,11) = (/ & + &2.7560e+00_r8,2.3178e+00_r8,1.6244e+00_r8,8.6011e-01_r8,3.9147e-03_r8/) + kbo(:, 5,51,11) = (/ & + &4.2636e+00_r8,3.5725e+00_r8,2.5176e+00_r8,1.3376e+00_r8,5.4601e-03_r8/) + kbo(:, 1,52,11) = (/ & + &4.1659e-01_r8,3.6012e-01_r8,2.5102e-01_r8,1.3270e-01_r8,8.3775e-04_r8/) + kbo(:, 2,52,11) = (/ & + &8.0451e-01_r8,6.9074e-01_r8,4.8148e-01_r8,2.5404e-01_r8,1.3424e-03_r8/) + kbo(:, 3,52,11) = (/ & + &1.4303e+00_r8,1.2146e+00_r8,8.4783e-01_r8,4.4730e-01_r8,2.0961e-03_r8/) + kbo(:, 4,52,11) = (/ & + &2.3661e+00_r8,1.9968e+00_r8,1.3985e+00_r8,7.3984e-01_r8,3.0912e-03_r8/) + kbo(:, 5,52,11) = (/ & + &3.7364e+00_r8,3.1393e+00_r8,2.2101e+00_r8,1.1738e+00_r8,4.3230e-03_r8/) + kbo(:, 1,53,11) = (/ & + &3.1784e-01_r8,2.7470e-01_r8,1.9112e-01_r8,1.0099e-01_r8,6.0100e-04_r8/) + kbo(:, 2,53,11) = (/ & + &6.3733e-01_r8,5.5043e-01_r8,3.8376e-01_r8,2.0263e-01_r8,1.0152e-03_r8/) + kbo(:, 3,53,11) = (/ & + &1.1810e+00_r8,1.0077e+00_r8,7.0333e-01_r8,3.7118e-01_r8,1.5799e-03_r8/) + kbo(:, 4,53,11) = (/ & + &2.0184e+00_r8,1.7109e+00_r8,1.1985e+00_r8,6.3377e-01_r8,2.3636e-03_r8/) + kbo(:, 5,53,11) = (/ & + &3.2693e+00_r8,2.7525e+00_r8,1.9355e+00_r8,1.0278e+00_r8,3.4086e-03_r8/) + kbo(:, 1,54,11) = (/ & + &2.4587e-01_r8,2.1298e-01_r8,1.4829e-01_r8,7.8206e-02_r8,4.4874e-04_r8/) + kbo(:, 2,54,11) = (/ & + &5.0524e-01_r8,4.3896e-01_r8,3.0674e-01_r8,1.6236e-01_r8,7.8054e-04_r8/) + kbo(:, 3,54,11) = (/ & + &9.7870e-01_r8,8.4204e-01_r8,5.8784e-01_r8,3.1052e-01_r8,1.2701e-03_r8/) + kbo(:, 4,54,11) = (/ & + &1.7368e+00_r8,1.4787e+00_r8,1.0357e+00_r8,5.4775e-01_r8,1.9340e-03_r8/) + kbo(:, 5,54,11) = (/ & + &2.8933e+00_r8,2.4419e+00_r8,1.7163e+00_r8,9.1082e-01_r8,2.8443e-03_r8/) + kbo(:, 1,55,11) = (/ & + &1.9418e-01_r8,1.6698e-01_r8,1.1582e-01_r8,6.0924e-02_r8,3.5209e-04_r8/) + kbo(:, 2,55,11) = (/ & + &3.9791e-01_r8,3.4892e-01_r8,2.4392e-01_r8,1.2929e-01_r8,6.3188e-04_r8/) + kbo(:, 3,55,11) = (/ & + &8.0845e-01_r8,6.9946e-01_r8,4.8912e-01_r8,2.5894e-01_r8,1.0591e-03_r8/) + kbo(:, 4,55,11) = (/ & + &1.4970e+00_r8,1.2804e+00_r8,8.9678e-01_r8,4.7424e-01_r8,1.6138e-03_r8/) + kbo(:, 5,55,11) = (/ & + &2.5700e+00_r8,2.1774e+00_r8,1.5304e+00_r8,8.1150e-01_r8,2.4277e-03_r8/) + kbo(:, 1,56,11) = (/ & + &1.5370e-01_r8,1.3145e-01_r8,9.1321e-02_r8,4.8124e-02_r8,2.7531e-04_r8/) + kbo(:, 2,56,11) = (/ & + &3.1616e-01_r8,2.7583e-01_r8,1.9245e-01_r8,1.0171e-01_r8,5.0269e-04_r8/) + kbo(:, 3,56,11) = (/ & + &6.6199e-01_r8,5.7649e-01_r8,4.0352e-01_r8,2.1386e-01_r8,8.6775e-04_r8/) + kbo(:, 4,56,11) = (/ & + &1.2822e+00_r8,1.1021e+00_r8,7.7256e-01_r8,4.0891e-01_r8,1.3519e-03_r8/) + kbo(:, 5,56,11) = (/ & + &2.2783e+00_r8,1.9368e+00_r8,1.3622e+00_r8,7.2221e-01_r8,2.0801e-03_r8/) + kbo(:, 1,57,11) = (/ & + &1.2165e-01_r8,1.0433e-01_r8,7.2303e-02_r8,3.8009e-02_r8,2.1938e-04_r8/) + kbo(:, 2,57,11) = (/ & + &2.5198e-01_r8,2.1938e-01_r8,1.5311e-01_r8,8.0877e-02_r8,3.9875e-04_r8/) + kbo(:, 3,57,11) = (/ & + &5.3606e-01_r8,4.7039e-01_r8,3.2945e-01_r8,1.7508e-01_r8,6.9954e-04_r8/) + kbo(:, 4,57,11) = (/ & + &1.0880e+00_r8,9.4273e-01_r8,6.6142e-01_r8,3.5027e-01_r8,1.1454e-03_r8/) + kbo(:, 5,57,11) = (/ & + &2.0139e+00_r8,1.7191e+00_r8,1.2097e+00_r8,6.4100e-01_r8,1.7901e-03_r8/) + kbo(:, 1,58,11) = (/ & + &4.6919e-02_r8,4.6268e-02_r8,3.7584e-02_r8,2.3911e-02_r8,1.7988e-04_r8/) + kbo(:, 2,58,11) = (/ & + &9.9628e-02_r8,9.8832e-02_r8,8.0744e-02_r8,5.1438e-02_r8,3.2482e-04_r8/) + kbo(:, 3,58,11) = (/ & + &2.1097e-01_r8,2.1358e-01_r8,1.7570e-01_r8,1.1318e-01_r8,5.8194e-04_r8/) + kbo(:, 4,58,11) = (/ & + &4.4837e-01_r8,4.4802e-01_r8,3.6936e-01_r8,2.3727e-01_r8,9.7962e-04_r8/) + kbo(:, 5,58,11) = (/ & + &8.6568e-01_r8,8.5230e-01_r8,7.0456e-01_r8,4.5178e-01_r8,1.5789e-03_r8/) + kbo(:, 1,59,11) = (/ & + &4.1955e-02_r8,4.1496e-02_r8,3.3924e-02_r8,2.1748e-02_r8,1.7054e-04_r8/) + kbo(:, 2,59,11) = (/ & + &9.0096e-02_r8,8.9872e-02_r8,7.3696e-02_r8,4.7378e-02_r8,3.1638e-04_r8/) + kbo(:, 3,59,11) = (/ & + &1.9169e-01_r8,1.9390e-01_r8,1.6037e-01_r8,1.0394e-01_r8,5.9374e-04_r8/) + kbo(:, 4,59,11) = (/ & + &4.1170e-01_r8,4.1459e-01_r8,3.4386e-01_r8,2.2297e-01_r8,1.0082e-03_r8/) + kbo(:, 5,59,11) = (/ & + &8.1839e-01_r8,8.1107e-01_r8,6.7470e-01_r8,4.3624e-01_r8,1.6869e-03_r8/) + kbo(:, 1,13,12) = (/ & + &1.0396e+02_r8,7.7973e+01_r8,5.1984e+01_r8,2.5992e+01_r8,2.8896e-01_r8/) + kbo(:, 2,13,12) = (/ & + &1.4817e+02_r8,1.1113e+02_r8,7.4089e+01_r8,3.7043e+01_r8,6.4071e-01_r8/) + kbo(:, 3,13,12) = (/ & + &2.0061e+02_r8,1.5046e+02_r8,1.0030e+02_r8,5.0152e+01_r8,7.6116e-01_r8/) + kbo(:, 4,13,12) = (/ & + &2.6114e+02_r8,1.9586e+02_r8,1.3057e+02_r8,6.5284e+01_r8,1.0553e+00_r8/) + kbo(:, 5,13,12) = (/ & + &3.2831e+02_r8,2.4622e+02_r8,1.6415e+02_r8,8.2071e+01_r8,1.4067e+00_r8/) + kbo(:, 1,14,12) = (/ & + &1.1135e+02_r8,8.3512e+01_r8,5.5676e+01_r8,2.7839e+01_r8,4.1053e-01_r8/) + kbo(:, 2,14,12) = (/ & + &1.5695e+02_r8,1.1771e+02_r8,7.8475e+01_r8,3.9240e+01_r8,6.2372e-01_r8/) + kbo(:, 3,14,12) = (/ & + &2.1121e+02_r8,1.5841e+02_r8,1.0560e+02_r8,5.2802e+01_r8,8.0301e-01_r8/) + kbo(:, 4,14,12) = (/ & + &2.7313e+02_r8,2.0485e+02_r8,1.3657e+02_r8,6.8283e+01_r8,1.0170e+00_r8/) + kbo(:, 5,14,12) = (/ & + &3.4124e+02_r8,2.5592e+02_r8,1.7062e+02_r8,8.5308e+01_r8,1.1064e+00_r8/) + kbo(:, 1,15,12) = (/ & + &1.1186e+02_r8,8.3897e+01_r8,5.5935e+01_r8,2.7966e+01_r8,4.8952e-01_r8/) + kbo(:, 2,15,12) = (/ & + &1.5638e+02_r8,1.1729e+02_r8,7.8194e+01_r8,3.9097e+01_r8,5.8507e-01_r8/) + kbo(:, 3,15,12) = (/ & + &2.0878e+02_r8,1.5659e+02_r8,1.0439e+02_r8,5.2197e+01_r8,6.7687e-01_r8/) + kbo(:, 4,15,12) = (/ & + &2.6790e+02_r8,2.0092e+02_r8,1.3395e+02_r8,6.6979e+01_r8,7.8981e-01_r8/) + kbo(:, 5,15,12) = (/ & + &3.3305e+02_r8,2.4981e+02_r8,1.6654e+02_r8,8.3272e+01_r8,9.5540e-01_r8/) + kbo(:, 1,16,12) = (/ & + &1.0741e+02_r8,8.0552e+01_r8,5.3706e+01_r8,2.6852e+01_r8,4.1874e-01_r8/) + kbo(:, 2,16,12) = (/ & + &1.4898e+02_r8,1.1174e+02_r8,7.4489e+01_r8,3.7244e+01_r8,5.0405e-01_r8/) + kbo(:, 3,16,12) = (/ & + &1.9721e+02_r8,1.4789e+02_r8,9.8599e+01_r8,4.9301e+01_r8,6.1901e-01_r8/) + kbo(:, 4,16,12) = (/ & + &2.5144e+02_r8,1.8859e+02_r8,1.2573e+02_r8,6.2879e+01_r8,7.4947e-01_r8/) + kbo(:, 5,16,12) = (/ & + &3.1058e+02_r8,2.3295e+02_r8,1.5529e+02_r8,7.7686e+01_r8,8.7491e-01_r8/) + kbo(:, 1,17,12) = (/ & + &9.9838e+01_r8,7.4879e+01_r8,4.9919e+01_r8,2.5012e+01_r8,3.9338e-01_r8/) + kbo(:, 2,17,12) = (/ & + &1.3717e+02_r8,1.0287e+02_r8,6.8583e+01_r8,3.4361e+01_r8,4.7893e-01_r8/) + kbo(:, 3,17,12) = (/ & + &1.8052e+02_r8,1.3539e+02_r8,9.0259e+01_r8,4.5242e+01_r8,5.7262e-01_r8/) + kbo(:, 4,17,12) = (/ & + &2.2880e+02_r8,1.7160e+02_r8,1.1440e+02_r8,5.7395e+01_r8,6.8306e-01_r8/) + kbo(:, 5,17,12) = (/ & + &2.8220e+02_r8,2.1165e+02_r8,1.4109e+02_r8,7.0870e+01_r8,7.6022e-01_r8/) + kbo(:, 1,18,12) = (/ & + &8.8836e+01_r8,6.6627e+01_r8,4.4421e+01_r8,2.2423e+01_r8,3.7355e-01_r8/) + kbo(:, 2,18,12) = (/ & + &1.2136e+02_r8,9.1017e+01_r8,6.0679e+01_r8,3.0651e+01_r8,4.3123e-01_r8/) + kbo(:, 3,18,12) = (/ & + &1.5857e+02_r8,1.1893e+02_r8,7.9284e+01_r8,4.0088e+01_r8,5.1039e-01_r8/) + kbo(:, 4,18,12) = (/ & + &2.0050e+02_r8,1.5036e+02_r8,1.0025e+02_r8,5.0735e+01_r8,5.8388e-01_r8/) + kbo(:, 5,18,12) = (/ & + &2.4631e+02_r8,1.8473e+02_r8,1.2316e+02_r8,6.2388e+01_r8,6.7078e-01_r8/) + kbo(:, 1,19,12) = (/ & + &7.8886e+01_r8,5.9167e+01_r8,3.9445e+01_r8,2.0119e+01_r8,3.3866e-01_r8/) + kbo(:, 2,19,12) = (/ & + &1.0689e+02_r8,8.0167e+01_r8,5.3444e+01_r8,2.7289e+01_r8,4.0283e-01_r8/) + kbo(:, 3,19,12) = (/ & + &1.3921e+02_r8,1.0440e+02_r8,6.9601e+01_r8,3.5553e+01_r8,4.5001e-01_r8/) + kbo(:, 4,19,12) = (/ & + &1.7541e+02_r8,1.3156e+02_r8,8.7714e+01_r8,4.4793e+01_r8,5.0843e-01_r8/) + kbo(:, 5,19,12) = (/ & + &2.1523e+02_r8,1.6142e+02_r8,1.0764e+02_r8,5.4993e+01_r8,5.9607e-01_r8/) + kbo(:, 1,20,12) = (/ & + &7.0328e+01_r8,5.2750e+01_r8,3.5209e+01_r8,1.8081e+01_r8,3.1237e-01_r8/) + kbo(:, 2,20,12) = (/ & + &9.4812e+01_r8,7.1110e+01_r8,4.7453e+01_r8,2.4387e+01_r8,3.6655e-01_r8/) + kbo(:, 3,20,12) = (/ & + &1.2307e+02_r8,9.2305e+01_r8,6.1607e+01_r8,3.1685e+01_r8,4.1127e-01_r8/) + kbo(:, 4,20,12) = (/ & + &1.5482e+02_r8,1.1612e+02_r8,7.7556e+01_r8,3.9922e+01_r8,4.7264e-01_r8/) + kbo(:, 5,20,12) = (/ & + &1.8921e+02_r8,1.4190e+02_r8,9.4818e+01_r8,4.8866e+01_r8,5.5288e-01_r8/) + kbo(:, 1,21,12) = (/ & + &6.2329e+01_r8,4.6745e+01_r8,3.1314e+01_r8,1.6132e+01_r8,2.8533e-01_r8/) + kbo(:, 2,21,12) = (/ & + &8.3734e+01_r8,6.2791e+01_r8,4.2073e+01_r8,2.1717e+01_r8,3.3097e-01_r8/) + kbo(:, 3,21,12) = (/ & + &1.0843e+02_r8,8.1321e+01_r8,5.4516e+01_r8,2.8198e+01_r8,3.8205e-01_r8/) + kbo(:, 4,21,12) = (/ & + &1.3597e+02_r8,1.0198e+02_r8,6.8398e+01_r8,3.5455e+01_r8,4.6172e-01_r8/) + kbo(:, 5,21,12) = (/ & + &1.6566e+02_r8,1.2424e+02_r8,8.3370e+01_r8,4.3320e+01_r8,5.2289e-01_r8/) + kbo(:, 1,22,12) = (/ & + &5.5853e+01_r8,4.1896e+01_r8,2.8239e+01_r8,1.4630e+01_r8,2.6479e-01_r8/) + kbo(:, 2,22,12) = (/ & + &7.4659e+01_r8,5.5993e+01_r8,3.7758e+01_r8,1.9621e+01_r8,3.0587e-01_r8/) + kbo(:, 3,22,12) = (/ & + &9.6287e+01_r8,7.2215e+01_r8,4.8710e+01_r8,2.5388e+01_r8,3.6961e-01_r8/) + kbo(:, 4,22,12) = (/ & + &1.2002e+02_r8,9.0023e+01_r8,6.0736e+01_r8,3.1753e+01_r8,4.4273e-01_r8/) + kbo(:, 5,22,12) = (/ & + &1.4596e+02_r8,1.0947e+02_r8,7.3878e+01_r8,3.8690e+01_r8,5.0560e-01_r8/) + kbo(:, 1,23,12) = (/ & + &4.9987e+01_r8,3.7501e+01_r8,2.5418e+01_r8,1.3325e+01_r8,2.4880e-01_r8/) + kbo(:, 2,23,12) = (/ & + &6.6514e+01_r8,4.9903e+01_r8,3.3828e+01_r8,1.7769e+01_r8,2.9089e-01_r8/) + kbo(:, 3,23,12) = (/ & + &8.5155e+01_r8,6.3887e+01_r8,4.3325e+01_r8,2.2796e+01_r8,3.6730e-01_r8/) + kbo(:, 4,23,12) = (/ & + &1.0588e+02_r8,7.9440e+01_r8,5.3898e+01_r8,2.8390e+01_r8,4.2226e-01_r8/) + kbo(:, 5,23,12) = (/ & + &1.2867e+02_r8,9.6554e+01_r8,6.5521e+01_r8,3.4526e+01_r8,4.8786e-01_r8/) + kbo(:, 1,24,12) = (/ & + &4.5237e+01_r8,3.3990e+01_r8,2.3082e+01_r8,1.2266e+01_r8,2.3374e-01_r8/) + kbo(:, 2,24,12) = (/ & + &5.9731e+01_r8,4.4882e+01_r8,3.0518e+01_r8,1.6222e+01_r8,2.9093e-01_r8/) + kbo(:, 3,24,12) = (/ & + &7.6147e+01_r8,5.7227e+01_r8,3.8961e+01_r8,2.0700e+01_r8,3.4607e-01_r8/) + kbo(:, 4,24,12) = (/ & + &9.4592e+01_r8,7.1092e+01_r8,4.8449e+01_r8,2.5703e+01_r8,4.0338e-01_r8/) + kbo(:, 5,24,12) = (/ & + &1.1508e+02_r8,8.6507e+01_r8,5.8986e+01_r8,3.1241e+01_r8,4.6347e-01_r8/) + kbo(:, 1,25,12) = (/ & + &4.1207e+01_r8,3.1054e+01_r8,2.1145e+01_r8,1.1344e+01_r8,2.1959e-01_r8/) + kbo(:, 2,25,12) = (/ & + &5.4029e+01_r8,4.0717e+01_r8,2.7774e+01_r8,1.4878e+01_r8,2.7843e-01_r8/) + kbo(:, 3,25,12) = (/ & + &6.8735e+01_r8,5.1802e+01_r8,3.5391e+01_r8,1.8919e+01_r8,3.2302e-01_r8/) + kbo(:, 4,25,12) = (/ & + &8.5416e+01_r8,6.4368e+01_r8,4.4030e+01_r8,2.3485e+01_r8,3.8140e-01_r8/) + kbo(:, 5,25,12) = (/ & + &1.0430e+02_r8,7.8570e+01_r8,5.3767e+01_r8,2.8613e+01_r8,4.3338e-01_r8/) + kbo(:, 1,26,12) = (/ & + &3.7870e+01_r8,2.8646e+01_r8,1.9592e+01_r8,1.0560e+01_r8,2.1067e-01_r8/) + kbo(:, 2,26,12) = (/ & + &4.9486e+01_r8,3.7425e+01_r8,2.5645e+01_r8,1.3791e+01_r8,2.5277e-01_r8/) + kbo(:, 3,26,12) = (/ & + &6.2993e+01_r8,4.7626e+01_r8,3.2666e+01_r8,1.7516e+01_r8,3.0077e-01_r8/) + kbo(:, 4,26,12) = (/ & + &7.8659e+01_r8,5.9439e+01_r8,4.0756e+01_r8,2.1814e+01_r8,3.5095e-01_r8/) + kbo(:, 5,26,12) = (/ & + &9.6658e+01_r8,7.2997e+01_r8,5.0039e+01_r8,2.6742e+01_r8,4.0727e-01_r8/) + kbo(:, 1,27,12) = (/ & + &3.5089e+01_r8,2.6619e+01_r8,1.8325e+01_r8,9.8881e+00_r8,1.9876e-01_r8/) + kbo(:, 2,27,12) = (/ & + &4.5899e+01_r8,3.4800e+01_r8,2.3944e+01_r8,1.2890e+01_r8,2.3298e-01_r8/) + kbo(:, 3,27,12) = (/ & + &5.8737e+01_r8,4.4506e+01_r8,3.0596e+01_r8,1.6445e+01_r8,2.8191e-01_r8/) + kbo(:, 4,27,12) = (/ & + &7.3770e+01_r8,5.5858e+01_r8,3.8369e+01_r8,2.0601e+01_r8,3.2481e-01_r8/) + kbo(:, 5,27,12) = (/ & + &9.1107e+01_r8,6.8940e+01_r8,4.7296e+01_r8,2.5356e+01_r8,3.8171e-01_r8/) + kbo(:, 1,28,12) = (/ & + &3.2818e+01_r8,2.4943e+01_r8,1.7280e+01_r8,9.3226e+00_r8,1.7817e-01_r8/) + kbo(:, 2,28,12) = (/ & + &4.3184e+01_r8,3.2811e+01_r8,2.2668e+01_r8,1.2208e+01_r8,2.1857e-01_r8/) + kbo(:, 3,28,12) = (/ & + &5.5616e+01_r8,4.2235e+01_r8,2.9105e+01_r8,1.5656e+01_r8,2.5762e-01_r8/) + kbo(:, 4,28,12) = (/ & + &7.0259e+01_r8,5.3319e+01_r8,3.6659e+01_r8,1.9693e+01_r8,3.0371e-01_r8/) + kbo(:, 5,28,12) = (/ & + &8.7123e+01_r8,6.6079e+01_r8,4.5396e+01_r8,2.4379e+01_r8,3.5478e-01_r8/) + kbo(:, 1,29,12) = (/ & + &3.0859e+01_r8,2.3511e+01_r8,1.6360e+01_r8,8.8280e+00_r8,1.6679e-01_r8/) + kbo(:, 2,29,12) = (/ & + &4.0867e+01_r8,3.1128e+01_r8,2.1584e+01_r8,1.1631e+01_r8,2.0451e-01_r8/) + kbo(:, 3,29,12) = (/ & + &5.2915e+01_r8,4.0294e+01_r8,2.7845e+01_r8,1.4987e+01_r8,2.3670e-01_r8/) + kbo(:, 4,29,12) = (/ & + &6.7028e+01_r8,5.1030e+01_r8,3.5190e+01_r8,1.8944e+01_r8,2.7999e-01_r8/) + kbo(:, 5,29,12) = (/ & + &8.3169e+01_r8,6.3273e+01_r8,4.3571e+01_r8,2.3474e+01_r8,3.2963e-01_r8/) + kbo(:, 1,30,12) = (/ & + &2.9181e+01_r8,2.2308e+01_r8,1.5570e+01_r8,8.4046e+00_r8,1.5217e-01_r8/) + kbo(:, 2,30,12) = (/ & + &3.8810e+01_r8,2.9664e+01_r8,2.0634e+01_r8,1.1131e+01_r8,1.8255e-01_r8/) + kbo(:, 3,30,12) = (/ & + &5.0316e+01_r8,3.8456e+01_r8,2.6686e+01_r8,1.4393e+01_r8,2.1489e-01_r8/) + kbo(:, 4,30,12) = (/ & + &6.3652e+01_r8,4.8625e+01_r8,3.3675e+01_r8,1.8188e+01_r8,2.5258e-01_r8/) + kbo(:, 5,30,12) = (/ & + &7.8956e+01_r8,6.0282e+01_r8,4.1671e+01_r8,2.2569e+01_r8,2.9642e-01_r8/) + kbo(:, 1,31,12) = (/ & + &2.7538e+01_r8,2.1159e+01_r8,1.4815e+01_r8,8.0002e+00_r8,1.3523e-01_r8/) + kbo(:, 2,31,12) = (/ & + &3.6621e+01_r8,2.8123e+01_r8,1.9646e+01_r8,1.0617e+01_r8,1.6072e-01_r8/) + kbo(:, 3,31,12) = (/ & + &4.7347e+01_r8,3.6341e+01_r8,2.5341e+01_r8,1.3718e+01_r8,1.9204e-01_r8/) + kbo(:, 4,31,12) = (/ & + &5.9881e+01_r8,4.5936e+01_r8,3.1977e+01_r8,1.7350e+01_r8,2.2658e-01_r8/) + kbo(:, 5,31,12) = (/ & + &7.4375e+01_r8,5.6987e+01_r8,3.9602e+01_r8,2.1563e+01_r8,2.6205e-01_r8/) + kbo(:, 1,32,12) = (/ & + &2.6147e+01_r8,2.0200e+01_r8,1.4192e+01_r8,7.6720e+00_r8,1.1829e-01_r8/) + kbo(:, 2,32,12) = (/ & + &3.4618e+01_r8,2.6728e+01_r8,1.8768e+01_r8,1.0173e+01_r8,1.4448e-01_r8/) + kbo(:, 3,32,12) = (/ & + &4.4733e+01_r8,3.4488e+01_r8,2.4181e+01_r8,1.3140e+01_r8,1.7290e-01_r8/) + kbo(:, 4,32,12) = (/ & + &5.6644e+01_r8,4.3620e+01_r8,3.0542e+01_r8,1.6653e+01_r8,2.0200e-01_r8/) + kbo(:, 5,32,12) = (/ & + &7.0667e+01_r8,5.4331e+01_r8,3.7949e+01_r8,2.0755e+01_r8,2.3023e-01_r8/) + kbo(:, 1,33,12) = (/ & + &2.4867e+01_r8,1.9325e+01_r8,1.3642e+01_r8,7.3884e+00_r8,1.0477e-01_r8/) + kbo(:, 2,33,12) = (/ & + &3.2857e+01_r8,2.5486e+01_r8,1.7993e+01_r8,9.7748e+00_r8,1.2807e-01_r8/) + kbo(:, 3,33,12) = (/ & + &4.2482e+01_r8,3.2899e+01_r8,2.3208e+01_r8,1.2658e+01_r8,1.5122e-01_r8/) + kbo(:, 4,33,12) = (/ & + &5.4028e+01_r8,4.1749e+01_r8,2.9378e+01_r8,1.6087e+01_r8,1.7656e-01_r8/) + kbo(:, 5,33,12) = (/ & + &6.7699e+01_r8,5.2220e+01_r8,3.6682e+01_r8,2.0157e+01_r8,2.0029e-01_r8/) + kbo(:, 1,34,12) = (/ & + &2.3698e+01_r8,1.8505e+01_r8,1.3121e+01_r8,7.1187e+00_r8,9.5888e-02_r8/) + kbo(:, 2,34,12) = (/ & + &3.1359e+01_r8,2.4427e+01_r8,1.7335e+01_r8,9.4402e+00_r8,1.1540e-01_r8/) + kbo(:, 3,34,12) = (/ & + &4.0701e+01_r8,3.1624e+01_r8,2.2413e+01_r8,1.2266e+01_r8,1.3371e-01_r8/) + kbo(:, 4,34,12) = (/ & + &5.2041e+01_r8,4.0338e+01_r8,2.8530e+01_r8,1.5676e+01_r8,1.5490e-01_r8/) + kbo(:, 5,34,12) = (/ & + &6.5491e+01_r8,5.0663e+01_r8,3.5768e+01_r8,1.9755e+01_r8,1.8157e-01_r8/) + kbo(:, 1,35,12) = (/ & + &2.2108e+01_r8,1.7359e+01_r8,1.2354e+01_r8,6.7085e+00_r8,8.3925e-02_r8/) + kbo(:, 2,35,12) = (/ & + &2.9390e+01_r8,2.2999e+01_r8,1.6388e+01_r8,8.9464e+00_r8,9.9962e-02_r8/) + kbo(:, 3,35,12) = (/ & + &3.8435e+01_r8,2.9966e+01_r8,2.1324e+01_r8,1.1694e+01_r8,1.1806e-01_r8/) + kbo(:, 4,35,12) = (/ & + &4.9418e+01_r8,3.8439e+01_r8,2.7323e+01_r8,1.5063e+01_r8,1.3630e-01_r8/) + kbo(:, 5,35,12) = (/ & + &6.2546e+01_r8,4.8535e+01_r8,3.4447e+01_r8,1.9092e+01_r8,1.6585e-01_r8/) + kbo(:, 1,36,12) = (/ & + &2.0129e+01_r8,1.5891e+01_r8,1.1346e+01_r8,6.1643e+00_r8,7.2166e-02_r8/) + kbo(:, 2,36,12) = (/ & + &2.6967e+01_r8,2.1198e+01_r8,1.5154e+01_r8,8.2858e+00_r8,8.5917e-02_r8/) + kbo(:, 3,36,12) = (/ & + &3.5568e+01_r8,2.7847e+01_r8,1.9901e+01_r8,1.0934e+01_r8,1.0193e-01_r8/) + kbo(:, 4,36,12) = (/ & + &4.6092e+01_r8,3.5975e+01_r8,2.5697e+01_r8,1.4200e+01_r8,1.2167e-01_r8/) + kbo(:, 5,36,12) = (/ & + &5.8785e+01_r8,4.5750e+01_r8,3.2634e+01_r8,1.8141e+01_r8,1.4958e-01_r8/) + kbo(:, 1,37,12) = (/ & + &1.7737e+01_r8,1.4074e+01_r8,1.0069e+01_r8,5.4659e+00_r8,6.3045e-02_r8/) + kbo(:, 2,37,12) = (/ & + &2.3991e+01_r8,1.8955e+01_r8,1.3586e+01_r8,7.4275e+00_r8,7.4702e-02_r8/) + kbo(:, 3,37,12) = (/ & + &3.1985e+01_r8,2.5160e+01_r8,1.8048e+01_r8,9.9281e+00_r8,8.9095e-02_r8/) + kbo(:, 4,37,12) = (/ & + &4.1889e+01_r8,3.2824e+01_r8,2.3555e+01_r8,1.3031e+01_r8,1.0656e-01_r8/) + kbo(:, 5,37,12) = (/ & + &5.3988e+01_r8,4.2162e+01_r8,3.0205e+01_r8,1.6815e+01_r8,1.3149e-01_r8/) + kbo(:, 1,38,12) = (/ & + &1.5671e+01_r8,1.2491e+01_r8,8.9462e+00_r8,4.8489e+00_r8,5.4067e-02_r8/) + kbo(:, 2,38,12) = (/ & + &2.1387e+01_r8,1.6974e+01_r8,1.2184e+01_r8,6.6604e+00_r8,6.5509e-02_r8/) + kbo(:, 3,38,12) = (/ & + &2.8785e+01_r8,2.2756e+01_r8,1.6373e+01_r8,9.0146e+00_r8,7.7568e-02_r8/) + kbo(:, 4,38,12) = (/ & + &3.8117e+01_r8,2.9996e+01_r8,2.1601e+01_r8,1.1967e+01_r8,9.4071e-02_r8/) + kbo(:, 5,38,12) = (/ & + &4.9667e+01_r8,3.8921e+01_r8,2.7995e+01_r8,1.5610e+01_r8,1.1469e-01_r8/) + kbo(:, 1,39,12) = (/ & + &1.3901e+01_r8,1.1137e+01_r8,7.9846e+00_r8,4.3195e+00_r8,4.6183e-02_r8/) + kbo(:, 2,39,12) = (/ & + &1.9150e+01_r8,1.5270e+01_r8,1.0976e+01_r8,5.9905e+00_r8,5.6093e-02_r8/) + kbo(:, 3,39,12) = (/ & + &2.6010e+01_r8,2.0653e+01_r8,1.4897e+01_r8,8.2086e+00_r8,6.7656e-02_r8/) + kbo(:, 4,39,12) = (/ & + &3.4809e+01_r8,2.7511e+01_r8,1.9872e+01_r8,1.1026e+01_r8,8.1649e-02_r8/) + kbo(:, 5,39,12) = (/ & + &4.5848e+01_r8,3.6052e+01_r8,2.6039e+01_r8,1.4537e+01_r8,9.9747e-02_r8/) + kbo(:, 1,40,12) = (/ & + &1.2081e+01_r8,9.7243e+00_r8,6.9733e+00_r8,3.7653e+00_r8,3.9581e-02_r8/) + kbo(:, 2,40,12) = (/ & + &1.6838e+01_r8,1.3484e+01_r8,9.6953e+00_r8,5.2801e+00_r8,4.8568e-02_r8/) + kbo(:, 3,40,12) = (/ & + &2.3104e+01_r8,1.8425e+01_r8,1.3302e+01_r8,7.3218e+00_r8,5.8955e-02_r8/) + kbo(:, 4,40,12) = (/ & + &3.1273e+01_r8,2.4818e+01_r8,1.7967e+01_r8,9.9757e+00_r8,7.0859e-02_r8/) + kbo(:, 5,40,12) = (/ & + &4.1711e+01_r8,3.2920e+01_r8,2.3848e+01_r8,1.3319e+01_r8,8.6539e-02_r8/) + kbo(:, 1,41,12) = (/ & + &1.0485e+01_r8,8.4800e+00_r8,6.0787e+00_r8,3.2769e+00_r8,3.3606e-02_r8/) + kbo(:, 2,41,12) = (/ & + &1.4786e+01_r8,1.1894e+01_r8,8.5576e+00_r8,4.6493e+00_r8,4.1457e-02_r8/) + kbo(:, 3,41,12) = (/ & + &2.0530e+01_r8,1.6437e+01_r8,1.1871e+01_r8,6.5218e+00_r8,5.0842e-02_r8/) + kbo(:, 4,41,12) = (/ & + &2.8093e+01_r8,2.2374e+01_r8,1.6223e+01_r8,9.0068e+00_r8,6.1229e-02_r8/) + kbo(:, 5,41,12) = (/ & + &3.7921e+01_r8,3.0039e+01_r8,2.1812e+01_r8,1.2190e+01_r8,7.5282e-02_r8/) + kbo(:, 1,42,12) = (/ & + &9.1079e+00_r8,7.3993e+00_r8,5.3023e+00_r8,2.8534e+00_r8,2.8075e-02_r8/) + kbo(:, 2,42,12) = (/ & + &1.3005e+01_r8,1.0510e+01_r8,7.5619e+00_r8,4.1019e+00_r8,3.5441e-02_r8/) + kbo(:, 3,42,12) = (/ & + &1.8277e+01_r8,1.4697e+01_r8,1.0617e+01_r8,5.8190e+00_r8,4.3089e-02_r8/) + kbo(:, 4,42,12) = (/ & + &2.5289e+01_r8,2.0221e+01_r8,1.4670e+01_r8,8.1365e+00_r8,5.2317e-02_r8/) + kbo(:, 5,42,12) = (/ & + &3.4535e+01_r8,2.7452e+01_r8,1.9969e+01_r8,1.1164e+01_r8,6.5436e-02_r8/) + kbo(:, 1,43,12) = (/ & + &7.8247e+00_r8,6.3834e+00_r8,4.5697e+00_r8,2.4551e+00_r8,2.3117e-02_r8/) + kbo(:, 2,43,12) = (/ & + &1.1336e+01_r8,9.1978e+00_r8,6.6143e+00_r8,3.5804e+00_r8,2.9659e-02_r8/) + kbo(:, 3,43,12) = (/ & + &1.6137e+01_r8,1.3030e+01_r8,9.4153e+00_r8,5.1449e+00_r8,3.6857e-02_r8/) + kbo(:, 4,43,12) = (/ & + &2.2622e+01_r8,1.8150e+01_r8,1.3165e+01_r8,7.2856e+00_r8,4.4557e-02_r8/) + kbo(:, 5,43,12) = (/ & + &3.1253e+01_r8,2.4925e+01_r8,1.8144e+01_r8,1.0136e+01_r8,5.5864e-02_r8/) + kbo(:, 1,44,12) = (/ & + &6.6782e+00_r8,5.4729e+00_r8,3.9116e+00_r8,2.0984e+00_r8,1.9194e-02_r8/) + kbo(:, 2,44,12) = (/ & + &9.8370e+00_r8,8.0127e+00_r8,5.7576e+00_r8,3.1087e+00_r8,2.4741e-02_r8/) + kbo(:, 3,44,12) = (/ & + &1.4194e+01_r8,1.1506e+01_r8,8.3119e+00_r8,4.5308e+00_r8,3.1291e-02_r8/) + kbo(:, 4,44,12) = (/ & + &2.0172e+01_r8,1.6246e+01_r8,1.1781e+01_r8,6.4997e+00_r8,3.7622e-02_r8/) + kbo(:, 5,44,12) = (/ & + &2.8219e+01_r8,2.2570e+01_r8,1.6428e+01_r8,9.1628e+00_r8,4.7831e-02_r8/) + kbo(:, 1,45,12) = (/ & + &5.6770e+00_r8,4.6794e+00_r8,3.3425e+00_r8,1.7902e+00_r8,1.5806e-02_r8/) + kbo(:, 2,45,12) = (/ & + &8.5322e+00_r8,6.9760e+00_r8,5.0078e+00_r8,2.6991e+00_r8,2.0417e-02_r8/) + kbo(:, 3,45,12) = (/ & + &1.2498e+01_r8,1.0162e+01_r8,7.3367e+00_r8,3.9899e+00_r8,2.6093e-02_r8/) + kbo(:, 4,45,12) = (/ & + &1.7997e+01_r8,1.4548e+01_r8,1.0552e+01_r8,5.8018e+00_r8,3.2356e-02_r8/) + kbo(:, 5,45,12) = (/ & + &2.5510e+01_r8,2.0455e+01_r8,1.4885e+01_r8,8.2823e+00_r8,4.0610e-02_r8/) + kbo(:, 1,46,12) = (/ & + &4.7638e+00_r8,3.9496e+00_r8,2.8218e+00_r8,1.5105e+00_r8,1.2604e-02_r8/) + kbo(:, 2,46,12) = (/ & + &7.3248e+00_r8,6.0189e+00_r8,4.3157e+00_r8,2.3220e+00_r8,1.6943e-02_r8/) + kbo(:, 3,46,12) = (/ & + &1.0931e+01_r8,8.9155e+00_r8,6.4285e+00_r8,3.4858e+00_r8,2.1734e-02_r8/) + kbo(:, 4,46,12) = (/ & + &1.5948e+01_r8,1.2933e+01_r8,9.3805e+00_r8,5.1432e+00_r8,2.7407e-02_r8/) + kbo(:, 5,46,12) = (/ & + &2.2923e+01_r8,1.8438e+01_r8,1.3407e+01_r8,7.4358e+00_r8,3.4309e-02_r8/) + kbo(:, 1,47,12) = (/ & + &3.9080e+00_r8,3.2569e+00_r8,2.3263e+00_r8,1.2446e+00_r8,1.0169e-02_r8/) + kbo(:, 2,47,12) = (/ & + &6.1567e+00_r8,5.0883e+00_r8,3.6497e+00_r8,1.9607e+00_r8,1.3733e-02_r8/) + kbo(:, 3,47,12) = (/ & + &9.4053e+00_r8,7.6982e+00_r8,5.5432e+00_r8,2.9978e+00_r8,1.8162e-02_r8/) + kbo(:, 4,47,12) = (/ & + &1.3941e+01_r8,1.1337e+01_r8,8.2150e+00_r8,4.4897e+00_r8,2.3207e-02_r8/) + kbo(:, 5,47,12) = (/ & + &2.0314e+01_r8,1.6396e+01_r8,1.1915e+01_r8,6.5825e+00_r8,2.8974e-02_r8/) + kbo(:, 1,48,12) = (/ & + &3.1887e+00_r8,2.6690e+00_r8,1.9049e+00_r8,1.0177e+00_r8,7.9795e-03_r8/) + kbo(:, 2,48,12) = (/ & + &5.1425e+00_r8,4.2754e+00_r8,3.0657e+00_r8,1.6476e+00_r8,1.1064e-02_r8/) + kbo(:, 3,48,12) = (/ & + &8.0497e+00_r8,6.6225e+00_r8,4.7642e+00_r8,2.5722e+00_r8,1.4743e-02_r8/) + kbo(:, 4,48,12) = (/ & + &1.2183e+01_r8,9.9349e+00_r8,7.1838e+00_r8,3.9122e+00_r8,1.9211e-02_r8/) + kbo(:, 5,48,12) = (/ & + &1.7984e+01_r8,1.4555e+01_r8,1.0573e+01_r8,5.8220e+00_r8,2.4214e-02_r8/) + kbo(:, 1,49,12) = (/ & + &2.5869e+00_r8,2.1741e+00_r8,1.5486e+00_r8,8.2603e-01_r8,6.2330e-03_r8/) + kbo(:, 2,49,12) = (/ & + &4.2741e+00_r8,3.5702e+00_r8,2.5591e+00_r8,1.3745e+00_r8,8.6780e-03_r8/) + kbo(:, 3,49,12) = (/ & + &6.8485e+00_r8,5.6671e+00_r8,4.0787e+00_r8,2.1997e+00_r8,1.1935e-02_r8/) + kbo(:, 4,49,12) = (/ & + &1.0623e+01_r8,8.6880e+00_r8,6.2733e+00_r8,3.4054e+00_r8,1.5780e-02_r8/) + kbo(:, 5,49,12) = (/ & + &1.5914e+01_r8,1.2906e+01_r8,9.3651e+00_r8,5.1392e+00_r8,2.0415e-02_r8/) + kbo(:, 1,50,12) = (/ & + &2.1098e+00_r8,1.7804e+00_r8,1.2663e+00_r8,6.7426e-01_r8,4.8509e-03_r8/) + kbo(:, 2,50,12) = (/ & + &3.5764e+00_r8,2.9999e+00_r8,2.1487e+00_r8,1.1529e+00_r8,6.9665e-03_r8/) + kbo(:, 3,50,12) = (/ & + &5.8619e+00_r8,4.8746e+00_r8,3.5094e+00_r8,1.8934e+00_r8,9.7336e-03_r8/) + kbo(:, 4,50,12) = (/ & + &9.3128e+00_r8,7.6488e+00_r8,5.5163e+00_r8,2.9881e+00_r8,1.3124e-02_r8/) + kbo(:, 5,50,12) = (/ & + &1.4210e+01_r8,1.1543e+01_r8,8.3635e+00_r8,4.5727e+00_r8,1.7352e-02_r8/) + kbo(:, 1,51,12) = (/ & + &1.7153e+00_r8,1.4551e+00_r8,1.0341e+00_r8,5.4981e-01_r8,3.8011e-03_r8/) + kbo(:, 2,51,12) = (/ & + &2.9969e+00_r8,2.5231e+00_r8,1.8054e+00_r8,9.6765e-01_r8,5.5539e-03_r8/) + kbo(:, 3,51,12) = (/ & + &5.0265e+00_r8,4.1972e+00_r8,3.0205e+00_r8,1.6294e+00_r8,8.0318e-03_r8/) + kbo(:, 4,51,12) = (/ & + &8.1641e+00_r8,6.7342e+00_r8,4.8593e+00_r8,2.6284e+00_r8,1.0987e-02_r8/) + kbo(:, 5,51,12) = (/ & + &1.2731e+01_r8,1.0364e+01_r8,7.4966e+00_r8,4.0842e+00_r8,1.4784e-02_r8/) + kbo(:, 1,52,12) = (/ & + &1.3829e+00_r8,1.1793e+00_r8,8.3692e-01_r8,4.4489e-01_r8,2.9111e-03_r8/) + kbo(:, 2,52,12) = (/ & + &2.5001e+00_r8,2.1140e+00_r8,1.5110e+00_r8,8.0824e-01_r8,4.4285e-03_r8/) + kbo(:, 3,52,12) = (/ & + &4.2993e+00_r8,3.6038e+00_r8,2.5920e+00_r8,1.3972e+00_r8,6.4988e-03_r8/) + kbo(:, 4,52,12) = (/ & + &7.1362e+00_r8,5.9093e+00_r8,4.2654e+00_r8,2.3076e+00_r8,9.0777e-03_r8/) + kbo(:, 5,52,12) = (/ & + &1.1388e+01_r8,9.2949e+00_r8,6.7113e+00_r8,3.6475e+00_r8,1.2584e-02_r8/) + kbo(:, 1,53,12) = (/ & + &1.0996e+00_r8,9.4448e-01_r8,6.6999e-01_r8,3.5618e-01_r8,2.1752e-03_r8/) + kbo(:, 2,53,12) = (/ & + &2.0714e+00_r8,1.7598e+00_r8,1.2567e+00_r8,6.7105e-01_r8,3.4164e-03_r8/) + kbo(:, 3,53,12) = (/ & + &3.6653e+00_r8,3.0827e+00_r8,2.2148e+00_r8,1.1926e+00_r8,5.1289e-03_r8/) + kbo(:, 4,53,12) = (/ & + &6.2207e+00_r8,5.1680e+00_r8,3.7282e+00_r8,2.0166e+00_r8,7.4836e-03_r8/) + kbo(:, 5,53,12) = (/ & + &1.0144e+01_r8,8.3054e+00_r8,5.9967e+00_r8,3.2508e+00_r8,1.0390e-02_r8/) + kbo(:, 1,54,12) = (/ & + &8.8096e-01_r8,7.6003e-01_r8,5.3828e-01_r8,2.8652e-01_r8,1.7028e-03_r8/) + kbo(:, 2,54,12) = (/ & + &1.7342e+00_r8,1.4790e+00_r8,1.0559e+00_r8,5.6372e-01_r8,2.7715e-03_r8/) + kbo(:, 3,54,12) = (/ & + &3.1660e+00_r8,2.6700e+00_r8,1.9162e+00_r8,1.0305e+00_r8,4.2409e-03_r8/) + kbo(:, 4,54,12) = (/ & + &5.4916e+00_r8,4.5733e+00_r8,3.2967e+00_r8,1.7833e+00_r8,6.3614e-03_r8/) + kbo(:, 5,54,12) = (/ & + &9.1316e+00_r8,7.4962e+00_r8,5.4128e+00_r8,2.9325e+00_r8,9.0996e-03_r8/) + kbo(:, 1,55,12) = (/ & + &7.0080e-01_r8,6.0941e-01_r8,4.3132e-01_r8,2.2991e-01_r8,1.3497e-03_r8/) + kbo(:, 2,55,12) = (/ & + &1.4554e+00_r8,1.2471e+00_r8,8.8937e-01_r8,4.7463e-01_r8,2.3282e-03_r8/) + kbo(:, 3,55,12) = (/ & + &2.7458e+00_r8,2.3243e+00_r8,1.6671e+00_r8,8.9493e-01_r8,3.6585e-03_r8/) + kbo(:, 4,55,12) = (/ & + &4.8778e+00_r8,4.0704e+00_r8,2.9318e+00_r8,1.5851e+00_r8,5.5673e-03_r8/) + kbo(:, 5,55,12) = (/ & + &8.2670e+00_r8,6.7971e+00_r8,4.9063e+00_r8,2.6581e+00_r8,8.0481e-03_r8/) + kbo(:, 1,56,12) = (/ & + &5.5050e-01_r8,4.8277e-01_r8,3.4128e-01_r8,1.8181e-01_r8,1.0666e-03_r8/) + kbo(:, 2,56,12) = (/ & + &1.2088e+00_r8,1.0426e+00_r8,7.4350e-01_r8,3.9744e-01_r8,1.9421e-03_r8/) + kbo(:, 3,56,12) = (/ & + &2.3753e+00_r8,2.0178e+00_r8,1.4463e+00_r8,7.7559e-01_r8,3.1486e-03_r8/) + kbo(:, 4,56,12) = (/ & + &4.3336e+00_r8,3.6227e+00_r8,2.6061e+00_r8,1.4075e+00_r8,4.8772e-03_r8/) + kbo(:, 5,56,12) = (/ & + &7.4871e+00_r8,6.1648e+00_r8,4.4455e+00_r8,2.4084e+00_r8,7.2633e-03_r8/) + kbo(:, 1,57,12) = (/ & + &4.2691e-01_r8,3.7593e-01_r8,2.6606e-01_r8,1.4195e-01_r8,8.3793e-04_r8/) + kbo(:, 2,57,12) = (/ & + &9.9567e-01_r8,8.6325e-01_r8,6.1463e-01_r8,3.2859e-01_r8,1.6242e-03_r8/) + kbo(:, 3,57,12) = (/ & + &2.0486e+00_r8,1.7449e+00_r8,1.2502e+00_r8,6.7018e-01_r8,2.7399e-03_r8/) + kbo(:, 4,57,12) = (/ & + &3.8496e+00_r8,3.2234e+00_r8,2.3159e+00_r8,1.2492e+00_r8,4.2649e-03_r8/) + kbo(:, 5,57,12) = (/ & + &6.7867e+00_r8,5.5927e+00_r8,4.0285e+00_r8,2.1823e+00_r8,6.5093e-03_r8/) + kbo(:, 1,58,12) = (/ & + &1.6356e-01_r8,1.6482e-01_r8,1.3630e-01_r8,8.7916e-02_r8,6.5877e-04_r8/) + kbo(:, 2,58,12) = (/ & + &3.9653e-01_r8,3.9771e-01_r8,3.3219e-01_r8,2.1522e-01_r8,1.3561e-03_r8/) + kbo(:, 3,58,12) = (/ & + &8.5978e-01_r8,8.4388e-01_r8,7.0959e-01_r8,4.6009e-01_r8,2.4231e-03_r8/) + kbo(:, 4,58,12) = (/ & + &1.6685e+00_r8,1.6071e+00_r8,1.3546e+00_r8,8.8295e-01_r8,3.8944e-03_r8/) + kbo(:, 5,58,12) = (/ & + &3.0057e+00_r8,2.8445e+00_r8,2.4022e+00_r8,1.5741e+00_r8,5.9596e-03_r8/) + kbo(:, 1,59,12) = (/ & + &1.4551e-01_r8,1.4725e-01_r8,1.2251e-01_r8,7.9561e-02_r8,6.8074e-04_r8/) + kbo(:, 2,59,12) = (/ & + &3.6080e-01_r8,3.6451e-01_r8,3.0649e-01_r8,2.0003e-01_r8,1.4324e-03_r8/) + kbo(:, 3,59,12) = (/ & + &8.0811e-01_r8,7.9823e-01_r8,6.7489e-01_r8,4.4138e-01_r8,2.5709e-03_r8/) + kbo(:, 4,59,12) = (/ & + &1.6058e+00_r8,1.5512e+00_r8,1.3138e+00_r8,8.6244e-01_r8,4.2753e-03_r8/) + kbo(:, 5,59,12) = (/ & + &2.9249e+00_r8,2.7730e+00_r8,2.3517e+00_r8,1.5520e+00_r8,6.3367e-03_r8/) + kbo(:, 1,13,13) = (/ & + &1.6844e+02_r8,1.2633e+02_r8,8.4219e+01_r8,4.2110e+01_r8,6.4746e-01_r8/) + kbo(:, 2,13,13) = (/ & + &2.3974e+02_r8,1.7981e+02_r8,1.1987e+02_r8,5.9937e+01_r8,7.7977e-01_r8/) + kbo(:, 3,13,13) = (/ & + &3.2626e+02_r8,2.4469e+02_r8,1.6313e+02_r8,8.1566e+01_r8,1.5118e+00_r8/) + kbo(:, 4,13,13) = (/ & + &4.2676e+02_r8,3.2006e+02_r8,2.1338e+02_r8,1.0669e+02_r8,1.6642e+00_r8/) + kbo(:, 5,13,13) = (/ & + &5.4119e+02_r8,4.0589e+02_r8,2.7059e+02_r8,1.3530e+02_r8,1.7313e+00_r8/) + kbo(:, 1,14,13) = (/ & + &1.9041e+02_r8,1.4281e+02_r8,9.5205e+01_r8,4.7604e+01_r8,4.8593e-01_r8/) + kbo(:, 2,14,13) = (/ & + &2.6943e+02_r8,2.0207e+02_r8,1.3472e+02_r8,6.7360e+01_r8,1.0523e+00_r8/) + kbo(:, 3,14,13) = (/ & + &3.6326e+02_r8,2.7244e+02_r8,1.8162e+02_r8,9.0813e+01_r8,1.4658e+00_r8/) + kbo(:, 4,14,13) = (/ & + &4.7082e+02_r8,3.5312e+02_r8,2.3542e+02_r8,1.1771e+02_r8,1.6120e+00_r8/) + kbo(:, 5,14,13) = (/ & + &5.9086e+02_r8,4.4312e+02_r8,2.9542e+02_r8,1.4771e+02_r8,1.8462e+00_r8/) + kbo(:, 1,15,13) = (/ & + &2.0331e+02_r8,1.5249e+02_r8,1.0165e+02_r8,5.0828e+01_r8,7.0211e-01_r8/) + kbo(:, 2,15,13) = (/ & + &2.8491e+02_r8,2.1369e+02_r8,1.4246e+02_r8,7.1232e+01_r8,1.1193e+00_r8/) + kbo(:, 3,15,13) = (/ & + &3.8104e+02_r8,2.8579e+02_r8,1.9054e+02_r8,9.5263e+01_r8,1.3482e+00_r8/) + kbo(:, 4,15,13) = (/ & + &4.8986e+02_r8,3.6740e+02_r8,2.4492e+02_r8,1.2246e+02_r8,1.6094e+00_r8/) + kbo(:, 5,15,13) = (/ & + &6.0932e+02_r8,4.5699e+02_r8,3.0468e+02_r8,1.5233e+02_r8,1.6798e+00_r8/) + kbo(:, 1,16,13) = (/ & + &2.0774e+02_r8,1.5583e+02_r8,1.0388e+02_r8,5.1937e+01_r8,8.3999e-01_r8/) + kbo(:, 2,16,13) = (/ & + &2.8883e+02_r8,2.1662e+02_r8,1.4442e+02_r8,7.2209e+01_r8,1.0268e+00_r8/) + kbo(:, 3,16,13) = (/ & + &3.8302e+02_r8,2.8729e+02_r8,1.9153e+02_r8,9.5770e+01_r8,1.2054e+00_r8/) + kbo(:, 4,16,13) = (/ & + &4.8856e+02_r8,3.6642e+02_r8,2.4427e+02_r8,1.2213e+02_r8,1.2630e+00_r8/) + kbo(:, 5,16,13) = (/ & + &6.0471e+02_r8,4.5354e+02_r8,3.0235e+02_r8,1.5118e+02_r8,1.5611e+00_r8/) + kbo(:, 1,17,13) = (/ & + &2.0589e+02_r8,1.5442e+02_r8,1.0294e+02_r8,5.1473e+01_r8,7.0898e-01_r8/) + kbo(:, 2,17,13) = (/ & + &2.8383e+02_r8,2.1287e+02_r8,1.4191e+02_r8,7.0957e+01_r8,8.7566e-01_r8/) + kbo(:, 3,17,13) = (/ & + &3.7354e+02_r8,2.8016e+02_r8,1.8678e+02_r8,9.3389e+01_r8,1.0083e+00_r8/) + kbo(:, 4,17,13) = (/ & + &4.7406e+02_r8,3.5553e+02_r8,2.3702e+02_r8,1.1851e+02_r8,1.2409e+00_r8/) + kbo(:, 5,17,13) = (/ & + &5.8252e+02_r8,4.3688e+02_r8,2.9126e+02_r8,1.4563e+02_r8,1.5701e+00_r8/) + kbo(:, 1,18,13) = (/ & + &1.9631e+02_r8,1.4723e+02_r8,9.8151e+01_r8,4.9076e+01_r8,6.5277e-01_r8/) + kbo(:, 2,18,13) = (/ & + &2.6794e+02_r8,2.0095e+02_r8,1.3397e+02_r8,6.6983e+01_r8,7.9253e-01_r8/) + kbo(:, 3,18,13) = (/ & + &3.5060e+02_r8,2.6297e+02_r8,1.7531e+02_r8,8.7658e+01_r8,9.7984e-01_r8/) + kbo(:, 4,18,13) = (/ & + &4.4214e+02_r8,3.3161e+02_r8,2.2107e+02_r8,1.1054e+02_r8,1.2414e+00_r8/) + kbo(:, 5,18,13) = (/ & + &5.4117e+02_r8,4.0586e+02_r8,2.7058e+02_r8,1.3530e+02_r8,1.5487e+00_r8/) + kbo(:, 1,19,13) = (/ & + &1.8546e+02_r8,1.3909e+02_r8,9.2728e+01_r8,4.6396e+01_r8,6.1789e-01_r8/) + kbo(:, 2,19,13) = (/ & + &2.5191e+02_r8,1.8893e+02_r8,1.2596e+02_r8,6.3020e+01_r8,7.3049e-01_r8/) + kbo(:, 3,19,13) = (/ & + &3.2752e+02_r8,2.4563e+02_r8,1.6376e+02_r8,8.1963e+01_r8,9.1418e-01_r8/) + kbo(:, 4,19,13) = (/ & + &4.1109e+02_r8,3.0832e+02_r8,2.0555e+02_r8,1.0295e+02_r8,1.1663e+00_r8/) + kbo(:, 5,19,13) = (/ & + &5.0069e+02_r8,3.7554e+02_r8,2.5035e+02_r8,1.2551e+02_r8,1.4682e+00_r8/) + kbo(:, 1,20,13) = (/ & + &1.7660e+02_r8,1.3245e+02_r8,8.8301e+01_r8,4.4344e+01_r8,5.8624e-01_r8/) + kbo(:, 2,20,13) = (/ & + &2.3782e+02_r8,1.7835e+02_r8,1.1891e+02_r8,5.9734e+01_r8,7.0627e-01_r8/) + kbo(:, 3,20,13) = (/ & + &3.0729e+02_r8,2.3046e+02_r8,1.5365e+02_r8,7.7248e+01_r8,8.6369e-01_r8/) + kbo(:, 4,20,13) = (/ & + &3.8357e+02_r8,2.8768e+02_r8,1.9179e+02_r8,9.6513e+01_r8,1.0255e+00_r8/) + kbo(:, 5,20,13) = (/ & + &4.6652e+02_r8,3.4991e+02_r8,2.3327e+02_r8,1.1751e+02_r8,1.3105e+00_r8/) + kbo(:, 1,21,13) = (/ & + &1.6552e+02_r8,1.2414e+02_r8,8.2761e+01_r8,4.1834e+01_r8,5.4233e-01_r8/) + kbo(:, 2,21,13) = (/ & + &2.2144e+02_r8,1.6608e+02_r8,1.1072e+02_r8,5.6006e+01_r8,6.6551e-01_r8/) + kbo(:, 3,21,13) = (/ & + &2.8447e+02_r8,2.1334e+02_r8,1.4223e+02_r8,7.2029e+01_r8,7.8267e-01_r8/) + kbo(:, 4,21,13) = (/ & + &3.5426e+02_r8,2.6570e+02_r8,1.7714e+02_r8,8.9791e+01_r8,9.3322e-01_r8/) + kbo(:, 5,21,13) = (/ & + &4.3028e+02_r8,3.2271e+02_r8,2.1513e+02_r8,1.0915e+02_r8,1.1469e+00_r8/) + kbo(:, 1,22,13) = (/ & + &1.5536e+02_r8,1.1652e+02_r8,7.7681e+01_r8,3.9611e+01_r8,5.1617e-01_r8/) + kbo(:, 2,22,13) = (/ & + &2.0596e+02_r8,1.5446e+02_r8,1.0298e+02_r8,5.2572e+01_r8,6.2474e-01_r8/) + kbo(:, 3,22,13) = (/ & + &2.6312e+02_r8,1.9733e+02_r8,1.3157e+02_r8,6.7220e+01_r8,7.4033e-01_r8/) + kbo(:, 4,22,13) = (/ & + &3.2670e+02_r8,2.4500e+02_r8,1.6337e+02_r8,8.3538e+01_r8,8.8562e-01_r8/) + kbo(:, 5,22,13) = (/ & + &3.9539e+02_r8,2.9656e+02_r8,1.9778e+02_r8,1.0126e+02_r8,1.0777e+00_r8/) + kbo(:, 1,23,13) = (/ & + &1.4370e+02_r8,1.0779e+02_r8,7.1941e+01_r8,3.6979e+01_r8,5.0881e-01_r8/) + kbo(:, 2,23,13) = (/ & + &1.8910e+02_r8,1.4182e+02_r8,9.4675e+01_r8,4.8747e+01_r8,5.9561e-01_r8/) + kbo(:, 3,23,13) = (/ & + &2.4065e+02_r8,1.8048e+02_r8,1.2051e+02_r8,6.2134e+01_r8,7.0317e-01_r8/) + kbo(:, 4,23,13) = (/ & + &2.9775e+02_r8,2.2332e+02_r8,1.4916e+02_r8,7.6994e+01_r8,8.5956e-01_r8/) + kbo(:, 5,23,13) = (/ & + &3.5987e+02_r8,2.6990e+02_r8,1.8034e+02_r8,9.3182e+01_r8,1.0114e+00_r8/) + kbo(:, 1,24,13) = (/ & + &1.3242e+02_r8,9.9313e+01_r8,6.6507e+01_r8,3.4403e+01_r8,4.7778e-01_r8/) + kbo(:, 2,24,13) = (/ & + &1.7334e+02_r8,1.3001e+02_r8,8.7073e+01_r8,4.5133e+01_r8,5.5652e-01_r8/) + kbo(:, 3,24,13) = (/ & + &2.1981e+02_r8,1.6486e+02_r8,1.1045e+02_r8,5.7389e+01_r8,6.8303e-01_r8/) + kbo(:, 4,24,13) = (/ & + &2.7150e+02_r8,2.0360e+02_r8,1.3644e+02_r8,7.1035e+01_r8,8.3312e-01_r8/) + kbo(:, 5,24,13) = (/ & + &3.2837e+02_r8,2.4630e+02_r8,1.6509e+02_r8,8.6103e+01_r8,9.5638e-01_r8/) + kbo(:, 1,25,13) = (/ & + &1.2137e+02_r8,9.1042e+01_r8,6.1224e+01_r8,3.1886e+01_r8,4.5611e-01_r8/) + kbo(:, 2,25,13) = (/ & + &1.5823e+02_r8,1.1867e+02_r8,7.9841e+01_r8,4.1707e+01_r8,5.3430e-01_r8/) + kbo(:, 3,25,13) = (/ & + &2.0017e+02_r8,1.5012e+02_r8,1.0102e+02_r8,5.2903e+01_r8,6.6826e-01_r8/) + kbo(:, 4,25,13) = (/ & + &2.4727e+02_r8,1.8545e+02_r8,1.2481e+02_r8,6.5530e+01_r8,7.9106e-01_r8/) + kbo(:, 5,25,13) = (/ & + &2.9868e+02_r8,2.2401e+02_r8,1.5081e+02_r8,7.9363e+01_r8,9.2773e-01_r8/) + kbo(:, 1,26,13) = (/ & + &1.1166e+02_r8,8.3750e+01_r8,5.6641e+01_r8,2.9761e+01_r8,4.3741e-01_r8/) + kbo(:, 2,26,13) = (/ & + &1.4505e+02_r8,1.0880e+02_r8,7.3586e+01_r8,3.8778e+01_r8,5.3620e-01_r8/) + kbo(:, 3,26,13) = (/ & + &1.8336e+02_r8,1.3753e+02_r8,9.3041e+01_r8,4.9168e+01_r8,6.5727e-01_r8/) + kbo(:, 4,26,13) = (/ & + &2.2613e+02_r8,1.6961e+02_r8,1.1481e+02_r8,6.0809e+01_r8,7.5877e-01_r8/) + kbo(:, 5,26,13) = (/ & + &2.7339e+02_r8,2.0507e+02_r8,1.3883e+02_r8,7.3616e+01_r8,9.0221e-01_r8/) + kbo(:, 1,27,13) = (/ & + &1.0286e+02_r8,7.7197e+01_r8,5.2520e+01_r8,2.7881e+01_r8,4.2067e-01_r8/) + kbo(:, 2,27,13) = (/ & + &1.3339e+02_r8,1.0010e+02_r8,6.8159e+01_r8,3.6272e+01_r8,5.2994e-01_r8/) + kbo(:, 3,27,13) = (/ & + &1.6841e+02_r8,1.2640e+02_r8,8.6087e+01_r8,4.5886e+01_r8,6.2144e-01_r8/) + kbo(:, 4,27,13) = (/ & + &2.0796e+02_r8,1.5610e+02_r8,1.0629e+02_r8,5.6702e+01_r8,7.2963e-01_r8/) + kbo(:, 5,27,13) = (/ & + &2.5159e+02_r8,1.8888e+02_r8,1.2865e+02_r8,6.8691e+01_r8,8.6563e-01_r8/) + kbo(:, 1,28,13) = (/ & + &9.5256e+01_r8,7.1619e+01_r8,4.8936e+01_r8,2.6277e+01_r8,4.0676e-01_r8/) + kbo(:, 2,28,13) = (/ & + &1.2337e+02_r8,9.2726e+01_r8,6.3443e+01_r8,3.4072e+01_r8,4.9978e-01_r8/) + kbo(:, 3,28,13) = (/ & + &1.5583e+02_r8,1.1712e+02_r8,8.0174e+01_r8,4.3046e+01_r8,5.7218e-01_r8/) + kbo(:, 4,28,13) = (/ & + &1.9223e+02_r8,1.4447e+02_r8,9.8926e+01_r8,5.3164e+01_r8,6.9683e-01_r8/) + kbo(:, 5,28,13) = (/ & + &2.3315e+02_r8,1.7521e+02_r8,1.1992e+02_r8,6.4418e+01_r8,8.1878e-01_r8/) + kbo(:, 1,29,13) = (/ & + &8.8532e+01_r8,6.6695e+01_r8,4.5757e+01_r8,2.4810e+01_r8,3.8492e-01_r8/) + kbo(:, 2,29,13) = (/ & + &1.1463e+02_r8,8.6325e+01_r8,5.9300e+01_r8,3.2087e+01_r8,4.4646e-01_r8/) + kbo(:, 3,29,13) = (/ & + &1.4438e+02_r8,1.0869e+02_r8,7.4772e+01_r8,4.0468e+01_r8,5.3953e-01_r8/) + kbo(:, 4,29,13) = (/ & + &1.7851e+02_r8,1.3434e+02_r8,9.2412e+01_r8,4.9954e+01_r8,6.4107e-01_r8/) + kbo(:, 5,29,13) = (/ & + &2.1752e+02_r8,1.6365e+02_r8,1.1246e+02_r8,6.0724e+01_r8,7.6365e-01_r8/) + kbo(:, 1,30,13) = (/ & + &8.2710e+01_r8,6.2476e+01_r8,4.3045e+01_r8,2.3511e+01_r8,3.4189e-01_r8/) + kbo(:, 2,30,13) = (/ & + &1.0675e+02_r8,8.0586e+01_r8,5.5620e+01_r8,3.0345e+01_r8,4.0578e-01_r8/) + kbo(:, 3,30,13) = (/ & + &1.3482e+02_r8,1.0169e+02_r8,7.0226e+01_r8,3.8224e+01_r8,5.0418e-01_r8/) + kbo(:, 4,30,13) = (/ & + &1.6752e+02_r8,1.2628e+02_r8,8.7179e+01_r8,4.7334e+01_r8,5.9789e-01_r8/) + kbo(:, 5,30,13) = (/ & + &2.0548e+02_r8,1.5477e+02_r8,1.0678e+02_r8,5.7811e+01_r8,7.2304e-01_r8/) + kbo(:, 1,31,13) = (/ & + &7.6989e+01_r8,5.8322e+01_r8,4.0414e+01_r8,2.2252e+01_r8,3.0592e-01_r8/) + kbo(:, 2,31,13) = (/ & + &9.9596e+01_r8,7.5380e+01_r8,5.2274e+01_r8,2.8707e+01_r8,3.7677e-01_r8/) + kbo(:, 3,31,13) = (/ & + &1.2653e+02_r8,9.5656e+01_r8,6.6313e+01_r8,3.6293e+01_r8,4.5864e-01_r8/) + kbo(:, 4,31,13) = (/ & + &1.5839e+02_r8,1.1960e+02_r8,8.2835e+01_r8,4.5152e+01_r8,5.5168e-01_r8/) + kbo(:, 5,31,13) = (/ & + &1.9525e+02_r8,1.4733e+02_r8,1.0199e+02_r8,5.5418e+01_r8,6.7878e-01_r8/) + kbo(:, 1,32,13) = (/ & + &7.2617e+01_r8,5.5198e+01_r8,3.8454e+01_r8,2.1285e+01_r8,2.7831e-01_r8/) + kbo(:, 2,32,13) = (/ & + &9.4496e+01_r8,7.1727e+01_r8,4.9927e+01_r8,2.7539e+01_r8,3.4616e-01_r8/) + kbo(:, 3,32,13) = (/ & + &1.2095e+02_r8,9.1662e+01_r8,6.3739e+01_r8,3.5032e+01_r8,4.1226e-01_r8/) + kbo(:, 4,32,13) = (/ & + &1.5220e+02_r8,1.1521e+02_r8,8.0042e+01_r8,4.3833e+01_r8,5.1531e-01_r8/) + kbo(:, 5,32,13) = (/ & + &1.8837e+02_r8,1.4240e+02_r8,9.8836e+01_r8,5.3991e+01_r8,6.4895e-01_r8/) + kbo(:, 1,33,13) = (/ & + &6.9586e+01_r8,5.3075e+01_r8,3.7119e+01_r8,2.0620e+01_r8,2.5421e-01_r8/) + kbo(:, 2,33,13) = (/ & + &9.1190e+01_r8,6.9432e+01_r8,4.8467e+01_r8,2.6834e+01_r8,3.0964e-01_r8/) + kbo(:, 3,33,13) = (/ & + &1.1725e+02_r8,8.9117e+01_r8,6.2134e+01_r8,3.4318e+01_r8,3.8320e-01_r8/) + kbo(:, 4,33,13) = (/ & + &1.4810e+02_r8,1.1236e+02_r8,7.8257e+01_r8,4.3108e+01_r8,4.8588e-01_r8/) + kbo(:, 5,33,13) = (/ & + &1.8404e+02_r8,1.3940e+02_r8,9.6928e+01_r8,5.3246e+01_r8,6.2021e-01_r8/) + kbo(:, 1,34,13) = (/ & + &6.7703e+01_r8,5.1785e+01_r8,3.6334e+01_r8,2.0214e+01_r8,2.2826e-01_r8/) + kbo(:, 2,34,13) = (/ & + &8.9165e+01_r8,6.8046e+01_r8,4.7643e+01_r8,2.6485e+01_r8,2.7978e-01_r8/) + kbo(:, 3,34,13) = (/ & + &1.1511e+02_r8,8.7692e+01_r8,6.1290e+01_r8,3.4007e+01_r8,3.5723e-01_r8/) + kbo(:, 4,34,13) = (/ & + &1.4598e+02_r8,1.1096e+02_r8,7.7422e+01_r8,4.2877e+01_r8,4.6377e-01_r8/) + kbo(:, 5,34,13) = (/ & + &1.8238e+02_r8,1.3836e+02_r8,9.6327e+01_r8,5.3168e+01_r8,5.7690e-01_r8/) + kbo(:, 1,35,13) = (/ & + &6.4861e+01_r8,4.9746e+01_r8,3.5026e+01_r8,1.9551e+01_r8,2.0156e-01_r8/) + kbo(:, 2,35,13) = (/ & + &8.5976e+01_r8,6.5785e+01_r8,4.6175e+01_r8,2.5782e+01_r8,2.5401e-01_r8/) + kbo(:, 3,35,13) = (/ & + &1.1165e+02_r8,8.5245e+01_r8,5.9716e+01_r8,3.3273e+01_r8,3.2846e-01_r8/) + kbo(:, 4,35,13) = (/ & + &1.4250e+02_r8,1.0853e+02_r8,7.5838e+01_r8,4.2162e+01_r8,4.2675e-01_r8/) + kbo(:, 5,35,13) = (/ & + &1.7910e+02_r8,1.3608e+02_r8,9.4891e+01_r8,5.2581e+01_r8,5.2256e-01_r8/) + kbo(:, 1,36,13) = (/ & + &6.0764e+01_r8,4.6732e+01_r8,3.3052e+01_r8,1.8514e+01_r8,1.7227e-01_r8/) + kbo(:, 2,36,13) = (/ & + &8.1347e+01_r8,6.2416e+01_r8,4.3933e+01_r8,2.4619e+01_r8,2.3170e-01_r8/) + kbo(:, 3,36,13) = (/ & + &1.0653e+02_r8,8.1514e+01_r8,5.7203e+01_r8,3.2018e+01_r8,2.9859e-01_r8/) + kbo(:, 4,36,13) = (/ & + &1.3711e+02_r8,1.0461e+02_r8,7.3196e+01_r8,4.0838e+01_r8,3.8265e-01_r8/) + kbo(:, 5,36,13) = (/ & + &1.7349e+02_r8,1.3202e+02_r8,9.2179e+01_r8,5.1271e+01_r8,4.7154e-01_r8/) + kbo(:, 1,37,13) = (/ & + &5.5040e+01_r8,4.2456e+01_r8,3.0166e+01_r8,1.6967e+01_r8,1.4686e-01_r8/) + kbo(:, 2,37,13) = (/ & + &7.4751e+01_r8,5.7522e+01_r8,4.0627e+01_r8,2.2828e+01_r8,1.9745e-01_r8/) + kbo(:, 3,37,13) = (/ & + &9.9126e+01_r8,7.6001e+01_r8,5.3446e+01_r8,3.0003e+01_r8,2.5830e-01_r8/) + kbo(:, 4,37,13) = (/ & + &1.2888e+02_r8,9.8527e+01_r8,6.9056e+01_r8,3.8643e+01_r8,3.3278e-01_r8/) + kbo(:, 5,37,13) = (/ & + &1.6453e+02_r8,1.2541e+02_r8,8.7685e+01_r8,4.8918e+01_r8,4.1260e-01_r8/) + kbo(:, 1,38,13) = (/ & + &4.9859e+01_r8,3.8586e+01_r8,2.7550e+01_r8,1.5547e+01_r8,1.2396e-01_r8/) + kbo(:, 2,38,13) = (/ & + &6.8738e+01_r8,5.3032e+01_r8,3.7612e+01_r8,2.1200e+01_r8,1.6720e-01_r8/) + kbo(:, 3,38,13) = (/ & + &9.2373e+01_r8,7.0999e+01_r8,5.0053e+01_r8,2.8170e+01_r8,2.2370e-01_r8/) + kbo(:, 4,38,13) = (/ & + &1.2130e+02_r8,9.2918e+01_r8,6.5279e+01_r8,3.6626e+01_r8,2.8704e-01_r8/) + kbo(:, 5,38,13) = (/ & + &1.5627e+02_r8,1.1930e+02_r8,8.3547e+01_r8,4.6739e+01_r8,3.6180e-01_r8/) + kbo(:, 1,39,13) = (/ & + &4.5302e+01_r8,3.5171e+01_r8,2.5236e+01_r8,1.4286e+01_r8,1.0568e-01_r8/) + kbo(:, 2,39,13) = (/ & + &6.3391e+01_r8,4.9041e+01_r8,3.4923e+01_r8,1.9751e+01_r8,1.4249e-01_r8/) + kbo(:, 3,39,13) = (/ & + &8.6323e+01_r8,6.6507e+01_r8,4.7040e+01_r8,2.6533e+01_r8,1.9303e-01_r8/) + kbo(:, 4,39,13) = (/ & + &1.1457e+02_r8,8.7914e+01_r8,6.1899e+01_r8,3.4824e+01_r8,2.4868e-01_r8/) + kbo(:, 5,39,13) = (/ & + &1.4887e+02_r8,1.1383e+02_r8,7.9847e+01_r8,4.4779e+01_r8,3.1416e-01_r8/) + kbo(:, 1,40,13) = (/ & + &4.0177e+01_r8,3.1298e+01_r8,2.2565e+01_r8,1.2805e+01_r8,8.8138e-02_r8/) + kbo(:, 2,40,13) = (/ & + &5.7199e+01_r8,4.4376e+01_r8,3.1743e+01_r8,1.8006e+01_r8,1.1856e-01_r8/) + kbo(:, 3,40,13) = (/ & + &7.9150e+01_r8,6.1135e+01_r8,4.3398e+01_r8,2.4540e+01_r8,1.6359e-01_r8/) + kbo(:, 4,40,13) = (/ & + &1.0651e+02_r8,8.1890e+01_r8,5.7786e+01_r8,3.2576e+01_r8,2.1421e-01_r8/) + kbo(:, 5,40,13) = (/ & + &1.3985e+02_r8,1.0710e+02_r8,7.5255e+01_r8,4.2282e+01_r8,2.7560e-01_r8/) + kbo(:, 1,41,13) = (/ & + &3.5483e+01_r8,2.7745e+01_r8,2.0104e+01_r8,1.1435e+01_r8,7.4578e-02_r8/) + kbo(:, 2,41,13) = (/ & + &5.1443e+01_r8,4.0033e+01_r8,2.8766e+01_r8,1.6358e+01_r8,1.0080e-01_r8/) + kbo(:, 3,41,13) = (/ & + &7.2353e+01_r8,5.6024e+01_r8,3.9928e+01_r8,2.2644e+01_r8,1.3798e-01_r8/) + kbo(:, 4,41,13) = (/ & + &9.8821e+01_r8,7.6124e+01_r8,5.3862e+01_r8,3.0414e+01_r8,1.8395e-01_r8/) + kbo(:, 5,41,13) = (/ & + &1.3121e+02_r8,1.0062e+02_r8,7.0817e+01_r8,3.9858e+01_r8,2.3971e-01_r8/) + kbo(:, 1,42,13) = (/ & + &3.1312e+01_r8,2.4582e+01_r8,1.7898e+01_r8,1.0203e+01_r8,6.3311e-02_r8/) + kbo(:, 2,42,13) = (/ & + &4.6257e+01_r8,3.6106e+01_r8,2.6059e+01_r8,1.4850e+01_r8,8.5987e-02_r8/) + kbo(:, 3,42,13) = (/ & + &6.6134e+01_r8,5.1324e+01_r8,3.6711e+01_r8,2.0879e+01_r8,1.1696e-01_r8/) + kbo(:, 4,42,13) = (/ & + &9.1649e+01_r8,7.0739e+01_r8,5.0191e+01_r8,2.8396e+01_r8,1.5868e-01_r8/) + kbo(:, 5,42,13) = (/ & + &1.2315e+02_r8,9.4550e+01_r8,6.6649e+01_r8,3.7570e+01_r8,2.0886e-01_r8/) + kbo(:, 1,43,13) = (/ & + &2.7228e+01_r8,2.1458e+01_r8,1.5694e+01_r8,8.9614e+00_r8,5.3608e-02_r8/) + kbo(:, 2,43,13) = (/ & + &4.1053e+01_r8,3.2140e+01_r8,2.3306e+01_r8,1.3302e+01_r8,7.1800e-02_r8/) + kbo(:, 3,43,13) = (/ & + &5.9801e+01_r8,4.6516e+01_r8,3.3390e+01_r8,1.9030e+01_r8,9.7105e-02_r8/) + kbo(:, 4,43,13) = (/ & + &8.4239e+01_r8,6.5135e+01_r8,4.6335e+01_r8,2.6274e+01_r8,1.3391e-01_r8/) + kbo(:, 5,43,13) = (/ & + &1.1479e+02_r8,8.8247e+01_r8,6.2314e+01_r8,3.5145e+01_r8,1.7840e-01_r8/) + kbo(:, 1,44,13) = (/ & + &2.3465e+01_r8,1.8562e+01_r8,1.3638e+01_r8,7.7925e+00_r8,4.4874e-02_r8/) + kbo(:, 2,44,13) = (/ & + &3.6146e+01_r8,2.8382e+01_r8,2.0672e+01_r8,1.1814e+01_r8,5.9063e-02_r8/) + kbo(:, 3,44,13) = (/ & + &5.3714e+01_r8,4.1873e+01_r8,3.0165e+01_r8,1.7212e+01_r8,7.9828e-02_r8/) + kbo(:, 4,44,13) = (/ & + &7.6981e+01_r8,5.9614e+01_r8,4.2519e+01_r8,2.4160e+01_r8,1.1248e-01_r8/) + kbo(:, 5,44,13) = (/ & + &1.0651e+02_r8,8.1983e+01_r8,5.8013e+01_r8,3.2734e+01_r8,1.4901e-01_r8/) + kbo(:, 1,45,13) = (/ & + &2.0186e+01_r8,1.6021e+01_r8,1.1808e+01_r8,6.7511e+00_r8,3.7575e-02_r8/) + kbo(:, 2,45,13) = (/ & + &3.1735e+01_r8,2.4996e+01_r8,1.8280e+01_r8,1.0459e+01_r8,4.9524e-02_r8/) + kbo(:, 3,45,13) = (/ & + &4.8111e+01_r8,3.7595e+01_r8,2.7182e+01_r8,1.5526e+01_r8,6.7700e-02_r8/) + kbo(:, 4,45,13) = (/ & + &7.0180e+01_r8,5.4438e+01_r8,3.8926e+01_r8,2.2155e+01_r8,9.2168e-02_r8/) + kbo(:, 5,45,13) = (/ & + &9.8620e+01_r8,7.6015e+01_r8,5.3889e+01_r8,3.0449e+01_r8,1.2546e-01_r8/) + kbo(:, 1,46,13) = (/ & + &1.7168e+01_r8,1.3674e+01_r8,1.0102e+01_r8,5.7721e+00_r8,3.1506e-02_r8/) + kbo(:, 2,46,13) = (/ & + &2.7551e+01_r8,2.1759e+01_r8,1.5975e+01_r8,9.1472e+00_r8,4.1368e-02_r8/) + kbo(:, 3,46,13) = (/ & + &4.2631e+01_r8,3.3389e+01_r8,2.4233e+01_r8,1.3855e+01_r8,5.6581e-02_r8/) + kbo(:, 4,46,13) = (/ & + &6.3374e+01_r8,4.9245e+01_r8,3.5311e+01_r8,2.0117e+01_r8,7.4981e-02_r8/) + kbo(:, 5,46,13) = (/ & + &9.0545e+01_r8,6.9872e+01_r8,4.9627e+01_r8,2.8091e+01_r8,1.0356e-01_r8/) + kbo(:, 1,47,13) = (/ & + &1.4285e+01_r8,1.1420e+01_r8,8.4474e+00_r8,4.8173e+00_r8,2.6647e-02_r8/) + kbo(:, 2,47,13) = (/ & + &2.3421e+01_r8,1.8547e+01_r8,1.3658e+01_r8,7.8222e+00_r8,3.5142e-02_r8/) + kbo(:, 3,47,13) = (/ & + &3.7014e+01_r8,2.9064e+01_r8,2.1182e+01_r8,1.2119e+01_r8,4.6223e-02_r8/) + kbo(:, 4,47,13) = (/ & + &5.6196e+01_r8,4.3754e+01_r8,3.1477e+01_r8,1.7951e+01_r8,6.2561e-02_r8/) + kbo(:, 5,47,13) = (/ & + &8.1804e+01_r8,6.3215e+01_r8,4.5000e+01_r8,2.5512e+01_r8,8.4936e-02_r8/) + kbo(:, 1,48,13) = (/ & + &1.1839e+01_r8,9.5013e+00_r8,7.0342e+00_r8,3.9991e+00_r8,2.2276e-02_r8/) + kbo(:, 2,48,13) = (/ & + &1.9820e+01_r8,1.5737e+01_r8,1.1620e+01_r8,6.6464e+00_r8,2.9148e-02_r8/) + kbo(:, 3,48,13) = (/ & + &3.1994e+01_r8,2.5174e+01_r8,1.8417e+01_r8,1.0540e+01_r8,3.8297e-02_r8/) + kbo(:, 4,48,13) = (/ & + &4.9572e+01_r8,3.8675e+01_r8,2.7923e+01_r8,1.5936e+01_r8,5.2300e-02_r8/) + kbo(:, 5,48,13) = (/ & + &7.3600e+01_r8,5.6966e+01_r8,4.0638e+01_r8,2.3068e+01_r8,6.9650e-02_r8/) + kbo(:, 1,49,13) = (/ & + &9.7471e+00_r8,7.8584e+00_r8,5.8267e+00_r8,3.3020e+00_r8,1.8196e-02_r8/) + kbo(:, 2,49,13) = (/ & + &1.6704e+01_r8,1.3302e+01_r8,9.8376e+00_r8,5.6165e+00_r8,2.4552e-02_r8/) + kbo(:, 3,49,13) = (/ & + &2.7532e+01_r8,2.1706e+01_r8,1.5922e+01_r8,9.1112e+00_r8,3.1859e-02_r8/) + kbo(:, 4,49,13) = (/ & + &4.3516e+01_r8,3.4017e+01_r8,2.4645e+01_r8,1.4071e+01_r8,4.2368e-02_r8/) + kbo(:, 5,49,13) = (/ & + &6.5913e+01_r8,5.1094e+01_r8,3.6540e+01_r8,2.0762e+01_r8,5.7956e-02_r8/) + kbo(:, 1,50,13) = (/ & + &8.0804e+00_r8,6.5442e+00_r8,4.8528e+00_r8,2.7471e+00_r8,1.5480e-02_r8/) + kbo(:, 2,50,13) = (/ & + &1.4208e+01_r8,1.1343e+01_r8,8.3916e+00_r8,4.7793e+00_r8,2.1108e-02_r8/) + kbo(:, 3,50,13) = (/ & + &2.3865e+01_r8,1.8845e+01_r8,1.3856e+01_r8,7.9173e+00_r8,2.8070e-02_r8/) + kbo(:, 4,50,13) = (/ & + &3.8439e+01_r8,3.0084e+01_r8,2.1861e+01_r8,1.2484e+01_r8,3.6716e-02_r8/) + kbo(:, 5,50,13) = (/ & + &5.9311e+01_r8,4.6040e+01_r8,3.3007e+01_r8,1.8765e+01_r8,4.7982e-02_r8/) + kbo(:, 1,51,13) = (/ & + &6.6974e+00_r8,5.4506e+00_r8,4.0401e+00_r8,2.2835e+00_r8,1.2897e-02_r8/) + kbo(:, 2,51,13) = (/ & + &1.2105e+01_r8,9.6894e+00_r8,7.1742e+00_r8,4.0729e+00_r8,1.8234e-02_r8/) + kbo(:, 3,51,13) = (/ & + &2.0726e+01_r8,1.6392e+01_r8,1.2076e+01_r8,6.8856e+00_r8,2.4297e-02_r8/) + kbo(:, 4,51,13) = (/ & + &3.4010e+01_r8,2.6646e+01_r8,1.9402e+01_r8,1.1077e+01_r8,3.1447e-02_r8/) + kbo(:, 5,51,13) = (/ & + &5.3414e+01_r8,4.1508e+01_r8,2.9825e+01_r8,1.6965e+01_r8,4.1659e-02_r8/) + kbo(:, 1,52,13) = (/ & + &5.5139e+00_r8,4.5099e+00_r8,3.3452e+00_r8,1.8859e+00_r8,1.0839e-02_r8/) + kbo(:, 2,52,13) = (/ & + &1.0265e+01_r8,8.2392e+00_r8,6.1066e+00_r8,3.4594e+00_r8,1.5307e-02_r8/) + kbo(:, 3,52,13) = (/ & + &1.7969e+01_r8,1.4231e+01_r8,1.0492e+01_r8,5.9702e+00_r8,2.0782e-02_r8/) + kbo(:, 4,52,13) = (/ & + &3.0022e+01_r8,2.3539e+01_r8,1.7173e+01_r8,9.7942e+00_r8,2.7615e-02_r8/) + kbo(:, 5,52,13) = (/ & + &4.7976e+01_r8,3.7311e+01_r8,2.6868e+01_r8,1.5284e+01_r8,3.5883e-02_r8/) + kbo(:, 1,53,13) = (/ & + &4.5089e+00_r8,3.7050e+00_r8,2.7486e+00_r8,1.5449e+00_r8,8.8988e-03_r8/) + kbo(:, 2,53,13) = (/ & + &8.6595e+00_r8,6.9701e+00_r8,5.1646e+00_r8,2.9217e+00_r8,1.2928e-02_r8/) + kbo(:, 3,53,13) = (/ & + &1.5539e+01_r8,1.2324e+01_r8,9.0856e+00_r8,5.1569e+00_r8,1.7922e-02_r8/) + kbo(:, 4,53,13) = (/ & + &2.6425e+01_r8,2.0735e+01_r8,1.5153e+01_r8,8.6253e+00_r8,2.3907e-02_r8/) + kbo(:, 5,53,13) = (/ & + &4.2979e+01_r8,3.3444e+01_r8,2.4119e+01_r8,1.3719e+01_r8,3.1307e-02_r8/) + kbo(:, 1,54,13) = (/ & + &3.7369e+00_r8,3.0844e+00_r8,2.2855e+00_r8,1.2806e+00_r8,7.5969e-03_r8/) + kbo(:, 2,54,13) = (/ & + &7.3945e+00_r8,5.9700e+00_r8,4.4241e+00_r8,2.4976e+00_r8,1.1170e-02_r8/) + kbo(:, 3,54,13) = (/ & + &1.3610e+01_r8,1.0807e+01_r8,7.9714e+00_r8,4.5128e+00_r8,1.6129e-02_r8/) + kbo(:, 4,54,13) = (/ & + &2.3560e+01_r8,1.8494e+01_r8,1.3530e+01_r8,7.6837e+00_r8,2.1838e-02_r8/) + kbo(:, 5,54,13) = (/ & + &3.8949e+01_r8,3.0311e+01_r8,2.1882e+01_r8,1.2434e+01_r8,2.8239e-02_r8/) + kbo(:, 1,55,13) = (/ & + &3.1147e+00_r8,2.5777e+00_r8,1.9050e+00_r8,1.0637e+00_r8,6.5369e-03_r8/) + kbo(:, 2,55,13) = (/ & + &6.3439e+00_r8,5.1347e+00_r8,3.8054e+00_r8,2.1454e+00_r8,1.0024e-02_r8/) + kbo(:, 3,55,13) = (/ & + &1.1985e+01_r8,9.5229e+00_r8,7.0258e+00_r8,3.9713e+00_r8,1.4330e-02_r8/) + kbo(:, 4,55,13) = (/ & + &2.1145e+01_r8,1.6600e+01_r8,1.2148e+01_r8,6.8814e+00_r8,1.9929e-02_r8/) + kbo(:, 5,55,13) = (/ & + &3.5505e+01_r8,2.7628e+01_r8,1.9956e+01_r8,1.1323e+01_r8,2.6070e-02_r8/) + kbo(:, 1,56,13) = (/ & + &2.5841e+00_r8,2.1412e+00_r8,1.5792e+00_r8,8.7847e-01_r8,5.7272e-03_r8/) + kbo(:, 2,56,13) = (/ & + &5.4279e+00_r8,4.4047e+00_r8,3.2621e+00_r8,1.8370e+00_r8,9.0085e-03_r8/) + kbo(:, 3,56,13) = (/ & + &1.0541e+01_r8,8.3802e+00_r8,6.1801e+00_r8,3.4870e+00_r8,1.2894e-02_r8/) + kbo(:, 4,56,13) = (/ & + &1.8998e+01_r8,1.4914e+01_r8,1.0910e+01_r8,6.1631e+00_r8,1.8216e-02_r8/) + kbo(:, 5,56,13) = (/ & + &3.2387e+01_r8,2.5195e+01_r8,1.8200e+01_r8,1.0311e+01_r8,2.5017e-02_r8/) + kbo(:, 1,57,13) = (/ & + &2.1273e+00_r8,1.7663e+00_r8,1.2997e+00_r8,7.2182e-01_r8,4.9990e-03_r8/) + kbo(:, 2,57,13) = (/ & + &4.6288e+00_r8,3.7653e+00_r8,2.7876e+00_r8,1.5653e+00_r8,7.9939e-03_r8/) + kbo(:, 3,57,13) = (/ & + &9.2459e+00_r8,7.3572e+00_r8,5.4258e+00_r8,3.0550e+00_r8,1.1761e-02_r8/) + kbo(:, 4,57,13) = (/ & + &1.7067e+01_r8,1.3395e+01_r8,9.7952e+00_r8,5.5222e+00_r8,1.6851e-02_r8/) + kbo(:, 5,57,13) = (/ & + &2.9574e+01_r8,2.2993e+01_r8,1.6606e+01_r8,9.3912e+00_r8,2.2852e-02_r8/) + kbo(:, 1,58,13) = (/ & + &8.4744e-01_r8,8.1145e-01_r8,7.0194e-01_r8,4.7172e-01_r8,4.4639e-03_r8/) + kbo(:, 2,58,13) = (/ & + &1.9303e+00_r8,1.8049e+00_r8,1.5645e+00_r8,1.0595e+00_r8,7.1718e-03_r8/) + kbo(:, 3,58,13) = (/ & + &3.9593e+00_r8,3.6185e+00_r8,3.1318e+00_r8,2.1308e+00_r8,1.0759e-02_r8/) + kbo(:, 4,58,13) = (/ & + &7.4878e+00_r8,6.7423e+00_r8,5.7807e+00_r8,3.9390e+00_r8,1.5270e-02_r8/) + kbo(:, 5,58,13) = (/ & + &1.3201e+01_r8,1.1774e+01_r8,9.9717e+00_r8,6.8098e+00_r8,2.1046e-02_r8/) + kbo(:, 1,59,13) = (/ & + &7.8389e-01_r8,7.5361e-01_r8,6.5545e-01_r8,4.4390e-01_r8,4.7731e-03_r8/) + kbo(:, 2,59,13) = (/ & + &1.8316e+00_r8,1.7144e+00_r8,1.4906e+00_r8,1.0154e+00_r8,7.3182e-03_r8/) + kbo(:, 3,59,13) = (/ & + &3.8012e+00_r8,3.4796e+00_r8,3.0220e+00_r8,2.0697e+00_r8,1.0970e-02_r8/) + kbo(:, 4,59,13) = (/ & + &7.2668e+00_r8,6.5534e+00_r8,5.6332e+00_r8,3.8611e+00_r8,1.5317e-02_r8/) + kbo(:, 5,59,13) = (/ & + &1.2911e+01_r8,1.1536e+01_r8,9.7915e+00_r8,6.7229e+00_r8,2.2015e-02_r8/) + kbo(:, 1,13,14) = (/ & + &2.9725e+02_r8,2.2295e+02_r8,1.4862e+02_r8,7.4314e+01_r8,8.5883e-01_r8/) + kbo(:, 2,13,14) = (/ & + &4.1294e+02_r8,3.0971e+02_r8,2.0649e+02_r8,1.0324e+02_r8,7.4403e-01_r8/) + kbo(:, 3,13,14) = (/ & + &5.5502e+02_r8,4.1625e+02_r8,2.7751e+02_r8,1.3875e+02_r8,6.6008e-01_r8/) + kbo(:, 4,13,14) = (/ & + &7.2029e+02_r8,5.4024e+02_r8,3.6017e+02_r8,1.8008e+02_r8,1.1155e+00_r8/) + kbo(:, 5,13,14) = (/ & + &9.0592e+02_r8,6.7946e+02_r8,4.5296e+02_r8,2.2648e+02_r8,2.5465e+00_r8/) + kbo(:, 1,14,14) = (/ & + &3.2435e+02_r8,2.4326e+02_r8,1.6217e+02_r8,8.1092e+01_r8,7.8098e-01_r8/) + kbo(:, 2,14,14) = (/ & + &4.4892e+02_r8,3.3668e+02_r8,2.2444e+02_r8,1.1223e+02_r8,5.4602e-01_r8/) + kbo(:, 3,14,14) = (/ & + &6.0099e+02_r8,4.5075e+02_r8,3.0049e+02_r8,1.5025e+02_r8,1.0325e+00_r8/) + kbo(:, 4,14,14) = (/ & + &7.7937e+02_r8,5.8453e+02_r8,3.8969e+02_r8,1.9485e+02_r8,1.5016e+00_r8/) + kbo(:, 5,14,14) = (/ & + &9.8034e+02_r8,7.3527e+02_r8,4.9018e+02_r8,2.4510e+02_r8,3.4894e+00_r8/) + kbo(:, 1,15,14) = (/ & + &3.4430e+02_r8,2.5823e+02_r8,1.7215e+02_r8,8.6071e+01_r8,4.7442e-01_r8/) + kbo(:, 2,15,14) = (/ & + &4.7694e+02_r8,3.5770e+02_r8,2.3846e+02_r8,1.1924e+02_r8,9.8957e-01_r8/) + kbo(:, 3,15,14) = (/ & + &6.3659e+02_r8,4.7745e+02_r8,3.1829e+02_r8,1.5915e+02_r8,1.3277e+00_r8/) + kbo(:, 4,15,14) = (/ & + &8.2316e+02_r8,6.1735e+02_r8,4.1157e+02_r8,2.0578e+02_r8,2.6545e+00_r8/) + kbo(:, 5,15,14) = (/ & + &1.0339e+03_r8,7.7536e+02_r8,5.1695e+02_r8,2.5844e+02_r8,4.8753e+00_r8/) + kbo(:, 1,16,14) = (/ & + &3.6224e+02_r8,2.7168e+02_r8,1.8111e+02_r8,9.0555e+01_r8,8.6361e-01_r8/) + kbo(:, 2,16,14) = (/ & + &5.0155e+02_r8,3.7615e+02_r8,2.5077e+02_r8,1.2539e+02_r8,1.3098e+00_r8/) + kbo(:, 3,16,14) = (/ & + &6.6682e+02_r8,5.0012e+02_r8,3.3343e+02_r8,1.6672e+02_r8,2.0810e+00_r8/) + kbo(:, 4,16,14) = (/ & + &8.5980e+02_r8,6.4485e+02_r8,4.2990e+02_r8,2.1496e+02_r8,4.0118e+00_r8/) + kbo(:, 5,16,14) = (/ & + &1.0768e+03_r8,8.0756e+02_r8,5.3838e+02_r8,2.6919e+02_r8,6.0151e+00_r8/) + kbo(:, 1,17,14) = (/ & + &3.8011e+02_r8,2.8509e+02_r8,1.9007e+02_r8,9.5029e+01_r8,1.2720e+00_r8/) + kbo(:, 2,17,14) = (/ & + &5.2601e+02_r8,3.9448e+02_r8,2.6301e+02_r8,1.3150e+02_r8,1.5543e+00_r8/) + kbo(:, 3,17,14) = (/ & + &6.9761e+02_r8,5.2320e+02_r8,3.4880e+02_r8,1.7439e+02_r8,2.9841e+00_r8/) + kbo(:, 4,17,14) = (/ & + &8.9515e+02_r8,6.7136e+02_r8,4.4757e+02_r8,2.2378e+02_r8,4.6409e+00_r8/) + kbo(:, 5,17,14) = (/ & + &1.1181e+03_r8,8.3857e+02_r8,5.5903e+02_r8,2.7954e+02_r8,6.6157e+00_r8/) + kbo(:, 1,18,14) = (/ & + &3.9222e+02_r8,2.9415e+02_r8,1.9611e+02_r8,9.8051e+01_r8,1.3802e+00_r8/) + kbo(:, 2,18,14) = (/ & + &5.4105e+02_r8,4.0577e+02_r8,2.7053e+02_r8,1.3526e+02_r8,2.0079e+00_r8/) + kbo(:, 3,18,14) = (/ & + &7.1441e+02_r8,5.3583e+02_r8,3.5723e+02_r8,1.7861e+02_r8,3.3624e+00_r8/) + kbo(:, 4,18,14) = (/ & + &9.1265e+02_r8,6.8450e+02_r8,4.5632e+02_r8,2.2816e+02_r8,4.9650e+00_r8/) + kbo(:, 5,18,14) = (/ & + &1.1336e+03_r8,8.5015e+02_r8,5.6679e+02_r8,2.8338e+02_r8,6.8761e+00_r8/) + kbo(:, 1,19,14) = (/ & + &4.0839e+02_r8,3.0630e+02_r8,2.0420e+02_r8,1.0209e+02_r8,1.4198e+00_r8/) + kbo(:, 2,19,14) = (/ & + &5.5968e+02_r8,4.1977e+02_r8,2.7985e+02_r8,1.3992e+02_r8,2.2241e+00_r8/) + kbo(:, 3,19,14) = (/ & + &7.3637e+02_r8,5.5226e+02_r8,3.6818e+02_r8,1.8410e+02_r8,3.5653e+00_r8/) + kbo(:, 4,19,14) = (/ & + &9.3504e+02_r8,7.0126e+02_r8,4.6751e+02_r8,2.3375e+02_r8,5.1035e+00_r8/) + kbo(:, 5,19,14) = (/ & + &1.1560e+03_r8,8.6697e+02_r8,5.7801e+02_r8,2.8901e+02_r8,6.9044e+00_r8/) + kbo(:, 1,20,14) = (/ & + &4.2971e+02_r8,3.2229e+02_r8,2.1485e+02_r8,1.0743e+02_r8,1.5393e+00_r8/) + kbo(:, 2,20,14) = (/ & + &5.8587e+02_r8,4.3942e+02_r8,2.9293e+02_r8,1.4647e+02_r8,2.2601e+00_r8/) + kbo(:, 3,20,14) = (/ & + &7.6617e+02_r8,5.7464e+02_r8,3.8311e+02_r8,1.9155e+02_r8,3.5353e+00_r8/) + kbo(:, 4,20,14) = (/ & + &9.6798e+02_r8,7.2594e+02_r8,4.8398e+02_r8,2.4197e+02_r8,5.0919e+00_r8/) + kbo(:, 5,20,14) = (/ & + &1.1898e+03_r8,8.9235e+02_r8,5.9489e+02_r8,2.9744e+02_r8,6.7835e+00_r8/) + kbo(:, 1,21,14) = (/ & + &4.4889e+02_r8,3.3666e+02_r8,2.2444e+02_r8,1.1222e+02_r8,1.6427e+00_r8/) + kbo(:, 2,21,14) = (/ & + &6.0830e+02_r8,4.5623e+02_r8,3.0417e+02_r8,1.5208e+02_r8,2.2298e+00_r8/) + kbo(:, 3,21,14) = (/ & + &7.9080e+02_r8,5.9312e+02_r8,3.9541e+02_r8,1.9769e+02_r8,3.4367e+00_r8/) + kbo(:, 4,21,14) = (/ & + &9.9371e+02_r8,7.4527e+02_r8,4.9684e+02_r8,2.4842e+02_r8,4.8609e+00_r8/) + kbo(:, 5,21,14) = (/ & + &1.2155e+03_r8,9.1159e+02_r8,6.0771e+02_r8,3.0387e+02_r8,6.5479e+00_r8/) + kbo(:, 1,22,14) = (/ & + &4.7127e+02_r8,3.5343e+02_r8,2.3563e+02_r8,1.1782e+02_r8,1.6925e+00_r8/) + kbo(:, 2,22,14) = (/ & + &6.3239e+02_r8,4.7428e+02_r8,3.1618e+02_r8,1.5809e+02_r8,2.2427e+00_r8/) + kbo(:, 3,22,14) = (/ & + &8.1553e+02_r8,6.1164e+02_r8,4.0775e+02_r8,2.0390e+02_r8,3.3409e+00_r8/) + kbo(:, 4,22,14) = (/ & + &1.0189e+03_r8,7.6417e+02_r8,5.0944e+02_r8,2.5480e+02_r8,4.6697e+00_r8/) + kbo(:, 5,22,14) = (/ & + &1.2378e+03_r8,9.2835e+02_r8,6.1890e+02_r8,3.0965e+02_r8,6.2760e+00_r8/) + kbo(:, 1,23,14) = (/ & + &4.8713e+02_r8,3.6534e+02_r8,2.4356e+02_r8,1.2192e+02_r8,1.6599e+00_r8/) + kbo(:, 2,23,14) = (/ & + &6.4775e+02_r8,4.8583e+02_r8,3.2387e+02_r8,1.6212e+02_r8,2.1938e+00_r8/) + kbo(:, 3,23,14) = (/ & + &8.3023e+02_r8,6.2268e+02_r8,4.1512e+02_r8,2.0786e+02_r8,3.2003e+00_r8/) + kbo(:, 4,23,14) = (/ & + &1.0300e+03_r8,7.7249e+02_r8,5.1499e+02_r8,2.5803e+02_r8,4.4341e+00_r8/) + kbo(:, 5,23,14) = (/ & + &1.2450e+03_r8,9.3374e+02_r8,6.2249e+02_r8,3.1208e+02_r8,5.9729e+00_r8/) + kbo(:, 1,24,14) = (/ & + &5.0112e+02_r8,3.7583e+02_r8,2.5056e+02_r8,1.2575e+02_r8,1.5724e+00_r8/) + kbo(:, 2,24,14) = (/ & + &6.6153e+02_r8,4.9614e+02_r8,3.3076e+02_r8,1.6604e+02_r8,2.1250e+00_r8/) + kbo(:, 3,24,14) = (/ & + &8.4162e+02_r8,6.3120e+02_r8,4.2079e+02_r8,2.1132e+02_r8,3.0488e+00_r8/) + kbo(:, 4,24,14) = (/ & + &1.0387e+03_r8,7.7903e+02_r8,5.1934e+02_r8,2.6092e+02_r8,4.1964e+00_r8/) + kbo(:, 5,24,14) = (/ & + &1.2497e+03_r8,9.3727e+02_r8,6.2485e+02_r8,3.1407e+02_r8,5.6661e+00_r8/) + kbo(:, 1,25,14) = (/ & + &5.0957e+02_r8,3.8217e+02_r8,2.5479e+02_r8,1.2836e+02_r8,1.4865e+00_r8/) + kbo(:, 2,25,14) = (/ & + &6.6771e+02_r8,5.0078e+02_r8,3.3385e+02_r8,1.6824e+02_r8,2.0184e+00_r8/) + kbo(:, 3,25,14) = (/ & + &8.4466e+02_r8,6.3351e+02_r8,4.2233e+02_r8,2.1290e+02_r8,2.8760e+00_r8/) + kbo(:, 4,25,14) = (/ & + &1.0379e+03_r8,7.7843e+02_r8,5.1895e+02_r8,2.6171e+02_r8,3.9646e+00_r8/) + kbo(:, 5,25,14) = (/ & + &1.2454e+03_r8,9.3411e+02_r8,6.2273e+02_r8,3.1409e+02_r8,5.3432e+00_r8/) + kbo(:, 1,26,14) = (/ & + &5.1543e+02_r8,3.8657e+02_r8,2.5772e+02_r8,1.3040e+02_r8,1.4310e+00_r8/) + kbo(:, 2,26,14) = (/ & + &6.7055e+02_r8,5.0292e+02_r8,3.3528e+02_r8,1.6969e+02_r8,1.9779e+00_r8/) + kbo(:, 3,26,14) = (/ & + &8.4393e+02_r8,6.3294e+02_r8,4.2195e+02_r8,2.1362e+02_r8,2.7140e+00_r8/) + kbo(:, 4,26,14) = (/ & + &1.0339e+03_r8,7.7538e+02_r8,5.1691e+02_r8,2.6173e+02_r8,3.7614e+00_r8/) + kbo(:, 5,26,14) = (/ & + &1.2377e+03_r8,9.2822e+02_r8,6.1881e+02_r8,3.1339e+02_r8,5.0524e+00_r8/) + kbo(:, 1,27,14) = (/ & + &5.1680e+02_r8,3.8760e+02_r8,2.5844e+02_r8,1.3139e+02_r8,1.4644e+00_r8/) + kbo(:, 2,27,14) = (/ & + &6.6877e+02_r8,5.0158e+02_r8,3.3442e+02_r8,1.7006e+02_r8,1.9743e+00_r8/) + kbo(:, 3,27,14) = (/ & + &8.3912e+02_r8,6.2935e+02_r8,4.1964e+02_r8,2.1343e+02_r8,2.6423e+00_r8/) + kbo(:, 4,27,14) = (/ & + &1.0255e+03_r8,7.6907e+02_r8,5.1284e+02_r8,2.6091e+02_r8,3.5939e+00_r8/) + kbo(:, 5,27,14) = (/ & + &1.2273e+03_r8,9.2048e+02_r8,6.1378e+02_r8,3.1226e+02_r8,4.8265e+00_r8/) + kbo(:, 1,28,14) = (/ & + &5.1471e+02_r8,3.8604e+02_r8,2.5761e+02_r8,1.3161e+02_r8,1.4975e+00_r8/) + kbo(:, 2,28,14) = (/ & + &6.6390e+02_r8,4.9793e+02_r8,3.3227e+02_r8,1.6984e+02_r8,1.9755e+00_r8/) + kbo(:, 3,28,14) = (/ & + &8.3099e+02_r8,6.2328e+02_r8,4.1590e+02_r8,2.1266e+02_r8,2.6592e+00_r8/) + kbo(:, 4,28,14) = (/ & + &1.0159e+03_r8,7.6197e+02_r8,5.0842e+02_r8,2.5994e+02_r8,3.4854e+00_r8/) + kbo(:, 5,28,14) = (/ & + &1.2168e+03_r8,9.1262e+02_r8,6.0898e+02_r8,3.1138e+02_r8,4.6837e+00_r8/) + kbo(:, 1,29,14) = (/ & + &5.0817e+02_r8,3.8113e+02_r8,2.5474e+02_r8,1.3092e+02_r8,1.4861e+00_r8/) + kbo(:, 2,29,14) = (/ & + &6.5385e+02_r8,4.9038e+02_r8,3.2768e+02_r8,1.6851e+02_r8,1.9807e+00_r8/) + kbo(:, 3,29,14) = (/ & + &8.1862e+02_r8,6.1397e+02_r8,4.1013e+02_r8,2.1090e+02_r8,2.6083e+00_r8/) + kbo(:, 4,29,14) = (/ & + &1.0015e+03_r8,7.5115e+02_r8,5.0169e+02_r8,2.5799e+02_r8,3.4366e+00_r8/) + kbo(:, 5,29,14) = (/ & + &1.2004e+03_r8,9.0023e+02_r8,6.0130e+02_r8,3.0911e+02_r8,4.6309e+00_r8/) + kbo(:, 1,30,14) = (/ & + &4.9890e+02_r8,3.7416e+02_r8,2.5051e+02_r8,1.2967e+02_r8,1.4792e+00_r8/) + kbo(:, 2,30,14) = (/ & + &6.4183e+02_r8,4.8137e+02_r8,3.2213e+02_r8,1.6671e+02_r8,1.9639e+00_r8/) + kbo(:, 3,30,14) = (/ & + &8.0457e+02_r8,6.0342e+02_r8,4.0369e+02_r8,2.0889e+02_r8,2.5564e+00_r8/) + kbo(:, 4,30,14) = (/ & + &9.8521e+02_r8,7.3890e+02_r8,4.9415e+02_r8,2.5564e+02_r8,3.4162e+00_r8/) + kbo(:, 5,30,14) = (/ & + &1.1820e+03_r8,8.8651e+02_r8,5.9274e+02_r8,3.0646e+02_r8,4.6345e+00_r8/) + kbo(:, 1,31,14) = (/ & + &4.8682e+02_r8,3.6513e+02_r8,2.4494e+02_r8,1.2775e+02_r8,1.4549e+00_r8/) + kbo(:, 2,31,14) = (/ & + &6.2686e+02_r8,4.7014e+02_r8,3.1520e+02_r8,1.6432e+02_r8,1.8973e+00_r8/) + kbo(:, 3,31,14) = (/ & + &7.8640e+02_r8,5.8981e+02_r8,3.9524e+02_r8,2.0591e+02_r8,2.5203e+00_r8/) + kbo(:, 4,31,14) = (/ & + &9.6406e+02_r8,7.2305e+02_r8,4.8423e+02_r8,2.5217e+02_r8,3.4800e+00_r8/) + kbo(:, 5,31,14) = (/ & + &1.1586e+03_r8,8.6894e+02_r8,5.8171e+02_r8,3.0260e+02_r8,4.7311e+00_r8/) + kbo(:, 1,32,14) = (/ & + &4.7960e+02_r8,3.5970e+02_r8,2.4176e+02_r8,1.2713e+02_r8,1.4049e+00_r8/) + kbo(:, 2,32,14) = (/ & + &6.1788e+02_r8,4.6339e+02_r8,3.1125e+02_r8,1.6347e+02_r8,1.8610e+00_r8/) + kbo(:, 3,32,14) = (/ & + &7.7566e+02_r8,5.8175e+02_r8,3.9047e+02_r8,2.0479e+02_r8,2.5736e+00_r8/) + kbo(:, 4,32,14) = (/ & + &9.5231e+02_r8,7.1420e+02_r8,4.7904e+02_r8,2.5086e+02_r8,3.5724e+00_r8/) + kbo(:, 5,32,14) = (/ & + &1.1464e+03_r8,8.5978e+02_r8,5.7626e+02_r8,3.0128e+02_r8,4.8525e+00_r8/) + kbo(:, 1,33,14) = (/ & + &4.7673e+02_r8,3.5758e+02_r8,2.4086e+02_r8,1.2764e+02_r8,1.3592e+00_r8/) + kbo(:, 2,33,14) = (/ & + &6.1463e+02_r8,4.6099e+02_r8,3.1024e+02_r8,1.6404e+02_r8,1.8844e+00_r8/) + kbo(:, 3,33,14) = (/ & + &7.7253e+02_r8,5.7937e+02_r8,3.8948e+02_r8,2.0544e+02_r8,2.6672e+00_r8/) + kbo(:, 4,33,14) = (/ & + &9.4922e+02_r8,7.1189e+02_r8,4.7815e+02_r8,2.5158e+02_r8,3.7054e+00_r8/) + kbo(:, 5,33,14) = (/ & + &1.1446e+03_r8,8.5842e+02_r8,5.7603e+02_r8,3.0239e+02_r8,5.0353e+00_r8/) + kbo(:, 1,34,14) = (/ & + &4.7829e+02_r8,3.5882e+02_r8,2.4214e+02_r8,1.2917e+02_r8,1.3360e+00_r8/) + kbo(:, 2,34,14) = (/ & + &6.1765e+02_r8,4.6331e+02_r8,3.1226e+02_r8,1.6594e+02_r8,1.9203e+00_r8/) + kbo(:, 3,34,14) = (/ & + &7.7743e+02_r8,5.8310e+02_r8,3.9256e+02_r8,2.0792e+02_r8,2.7349e+00_r8/) + kbo(:, 4,34,14) = (/ & + &9.5686e+02_r8,7.1762e+02_r8,4.8256e+02_r8,2.5475e+02_r8,3.8031e+00_r8/) + kbo(:, 5,34,14) = (/ & + &1.1550e+03_r8,8.6629e+02_r8,5.8189e+02_r8,3.0631e+02_r8,5.2021e+00_r8/) + kbo(:, 1,35,14) = (/ & + &4.7226e+02_r8,3.5443e+02_r8,2.3957e+02_r8,1.2851e+02_r8,1.3086e+00_r8/) + kbo(:, 2,35,14) = (/ & + &6.1214e+02_r8,4.5923e+02_r8,3.0998e+02_r8,1.6546e+02_r8,1.9154e+00_r8/) + kbo(:, 3,35,14) = (/ & + &7.7280e+02_r8,5.7976e+02_r8,3.9077e+02_r8,2.0773e+02_r8,2.7357e+00_r8/) + kbo(:, 4,35,14) = (/ & + &9.5397e+02_r8,7.1554e+02_r8,4.8165e+02_r8,2.5508e+02_r8,3.8286e+00_r8/) + kbo(:, 5,35,14) = (/ & + &1.1540e+03_r8,8.6552e+02_r8,5.8187e+02_r8,3.0708e+02_r8,5.2636e+00_r8/) + kbo(:, 1,36,14) = (/ & + &4.5693e+02_r8,3.4301e+02_r8,2.3220e+02_r8,1.2520e+02_r8,1.2533e+00_r8/) + kbo(:, 2,36,14) = (/ & + &5.9574e+02_r8,4.4710e+02_r8,3.0221e+02_r8,1.6199e+02_r8,1.8411e+00_r8/) + kbo(:, 3,36,14) = (/ & + &7.5609e+02_r8,5.6723e+02_r8,3.8282e+02_r8,2.0421e+02_r8,2.6504e+00_r8/) + kbo(:, 4,36,14) = (/ & + &9.3751e+02_r8,7.0328e+02_r8,4.7386e+02_r8,2.5165e+02_r8,3.7407e+00_r8/) + kbo(:, 5,36,14) = (/ & + &1.1381e+03_r8,8.5353e+02_r8,5.7430e+02_r8,3.0378e+02_r8,5.1704e+00_r8/) + kbo(:, 1,37,14) = (/ & + &4.2922e+02_r8,3.2232e+02_r8,2.1847e+02_r8,1.1834e+02_r8,1.1213e+00_r8/) + kbo(:, 2,37,14) = (/ & + &5.6522e+02_r8,4.2422e+02_r8,2.8713e+02_r8,1.5453e+02_r8,1.6760e+00_r8/) + kbo(:, 3,37,14) = (/ & + &7.2332e+02_r8,5.4281e+02_r8,3.6673e+02_r8,1.9621e+02_r8,2.4344e+00_r8/) + kbo(:, 4,37,14) = (/ & + &9.0338e+02_r8,6.7777e+02_r8,4.5711e+02_r8,2.4334e+02_r8,3.4735e+00_r8/) + kbo(:, 5,37,14) = (/ & + &1.1034e+03_r8,8.2764e+02_r8,5.5725e+02_r8,2.9534e+02_r8,4.8510e+00_r8/) + kbo(:, 1,38,14) = (/ & + &4.0355e+02_r8,3.0314e+02_r8,2.0578e+02_r8,1.1195e+02_r8,1.0088e+00_r8/) + kbo(:, 2,38,14) = (/ & + &5.3660e+02_r8,4.0286e+02_r8,2.7296e+02_r8,1.4742e+02_r8,1.5281e+00_r8/) + kbo(:, 3,38,14) = (/ & + &6.9245e+02_r8,5.1973e+02_r8,3.5152e+02_r8,1.8858e+02_r8,2.2407e+00_r8/) + kbo(:, 4,38,14) = (/ & + &8.7113e+02_r8,6.5360e+02_r8,4.4117e+02_r8,2.3535e+02_r8,3.2324e+00_r8/) + kbo(:, 5,38,14) = (/ & + &1.0703e+03_r8,8.0291e+02_r8,5.4092e+02_r8,2.8714e+02_r8,4.5526e+00_r8/) + kbo(:, 1,39,14) = (/ & + &3.8048e+02_r8,2.8595e+02_r8,1.9433e+02_r8,1.0614e+02_r8,9.1242e-01_r8/) + kbo(:, 2,39,14) = (/ & + &5.1067e+02_r8,3.8348e+02_r8,2.6010e+02_r8,1.4089e+02_r8,1.4025e+00_r8/) + kbo(:, 3,39,14) = (/ & + &6.6451e+02_r8,4.9880e+02_r8,3.3759e+02_r8,1.8159e+02_r8,2.0765e+00_r8/) + kbo(:, 4,39,14) = (/ & + &8.4141e+02_r8,6.3140e+02_r8,4.2638e+02_r8,2.2792e+02_r8,3.0229e+00_r8/) + kbo(:, 5,39,14) = (/ & + &1.0396e+03_r8,7.7992e+02_r8,5.2571e+02_r8,2.7947e+02_r8,4.2952e+00_r8/) + kbo(:, 1,40,14) = (/ & + &3.5133e+02_r8,2.6415e+02_r8,1.7970e+02_r8,9.8495e+01_r8,7.8366e-01_r8/) + kbo(:, 2,40,14) = (/ & + &4.7771e+02_r8,3.5880e+02_r8,2.4356e+02_r8,1.3227e+02_r8,1.2276e+00_r8/) + kbo(:, 3,40,14) = (/ & + &6.2817e+02_r8,4.7163e+02_r8,3.1937e+02_r8,1.7209e+02_r8,1.8434e+00_r8/) + kbo(:, 4,40,14) = (/ & + &8.0277e+02_r8,6.0241e+02_r8,4.0711e+02_r8,2.1788e+02_r8,2.7123e+00_r8/) + kbo(:, 5,40,14) = (/ & + &9.9978e+02_r8,7.5011e+02_r8,5.0577e+02_r8,2.6911e+02_r8,3.8911e+00_r8/) + kbo(:, 1,41,14) = (/ & + &3.2342e+02_r8,2.4324e+02_r8,1.6567e+02_r8,9.1094e+01_r8,6.6818e-01_r8/) + kbo(:, 2,41,14) = (/ & + &4.4573e+02_r8,3.3493e+02_r8,2.2747e+02_r8,1.2382e+02_r8,1.0662e+00_r8/) + kbo(:, 3,41,14) = (/ & + &5.9252e+02_r8,4.4488e+02_r8,3.0145e+02_r8,1.6269e+02_r8,1.6310e+00_r8/) + kbo(:, 4,41,14) = (/ & + &7.6447e+02_r8,5.7369e+02_r8,3.8787e+02_r8,2.0780e+02_r8,2.4231e+00_r8/) + kbo(:, 5,41,14) = (/ & + &9.6002e+02_r8,7.2027e+02_r8,4.8589e+02_r8,2.5869e+02_r8,3.5110e+00_r8/) + kbo(:, 1,42,14) = (/ & + &2.9741e+02_r8,2.2375e+02_r8,1.5256e+02_r8,8.4130e+01_r8,5.7099e-01_r8/) + kbo(:, 2,42,14) = (/ & + &4.1545e+02_r8,3.1224e+02_r8,2.1217e+02_r8,1.1576e+02_r8,9.2628e-01_r8/) + kbo(:, 3,42,14) = (/ & + &5.5858e+02_r8,4.1944e+02_r8,2.8433e+02_r8,1.5367e+02_r8,1.4426e+00_r8/) + kbo(:, 4,42,14) = (/ & + &7.2759e+02_r8,5.4609e+02_r8,3.6933e+02_r8,1.9808e+02_r8,2.1657e+00_r8/) + kbo(:, 5,42,14) = (/ & + &9.2131e+02_r8,6.9128e+02_r8,4.6648e+02_r8,2.4850e+02_r8,3.1673e+00_r8/) + kbo(:, 1,43,14) = (/ & + &2.7012e+02_r8,2.0330e+02_r8,1.3875e+02_r8,7.6704e+01_r8,4.7188e-01_r8/) + kbo(:, 2,43,14) = (/ & + &3.8333e+02_r8,2.8816e+02_r8,1.9596e+02_r8,1.0707e+02_r8,7.8390e-01_r8/) + kbo(:, 3,43,14) = (/ & + &5.2268e+02_r8,3.9255e+02_r8,2.6617e+02_r8,1.4400e+02_r8,1.2434e+00_r8/) + kbo(:, 4,43,14) = (/ & + &6.8847e+02_r8,5.1676e+02_r8,3.4954e+02_r8,1.8752e+02_r8,1.8919e+00_r8/) + kbo(:, 5,43,14) = (/ & + &8.8050e+02_r8,6.6068e+02_r8,4.4591e+02_r8,2.3760e+02_r8,2.7970e+00_r8/) + kbo(:, 1,44,14) = (/ & + &2.4333e+02_r8,1.8320e+02_r8,1.2513e+02_r8,6.9324e+01_r8,3.8543e-01_r8/) + kbo(:, 2,44,14) = (/ & + &3.5160e+02_r8,2.6439e+02_r8,1.7983e+02_r8,9.8391e+01_r8,6.5410e-01_r8/) + kbo(:, 3,44,14) = (/ & + &4.8672e+02_r8,3.6559e+02_r8,2.4794e+02_r8,1.3422e+02_r8,1.0574e+00_r8/) + kbo(:, 4,44,14) = (/ & + &6.4907e+02_r8,4.8721e+02_r8,3.2959e+02_r8,1.7683e+02_r8,1.6338e+00_r8/) + kbo(:, 5,44,14) = (/ & + &8.3935e+02_r8,6.2981e+02_r8,4.2512e+02_r8,2.2646e+02_r8,2.4460e+00_r8/) + kbo(:, 1,45,14) = (/ & + &2.1826e+02_r8,1.6439e+02_r8,1.1240e+02_r8,6.2387e+01_r8,3.1362e-01_r8/) + kbo(:, 2,45,14) = (/ & + &3.2151e+02_r8,2.4179e+02_r8,1.6452e+02_r8,9.0130e+01_r8,5.4229e-01_r8/) + kbo(:, 3,45,14) = (/ & + &4.5202e+02_r8,3.3957e+02_r8,2.3034e+02_r8,1.2476e+02_r8,8.9432e-01_r8/) + kbo(:, 4,45,14) = (/ & + &6.1098e+02_r8,4.5864e+02_r8,3.1027e+02_r8,1.6648e+02_r8,1.4094e+00_r8/) + kbo(:, 5,45,14) = (/ & + &7.9903e+02_r8,5.9956e+02_r8,4.0465e+02_r8,2.1549e+02_r8,2.1336e+00_r8/) + kbo(:, 1,46,14) = (/ & + &1.9334e+02_r8,1.4567e+02_r8,9.9705e+01_r8,5.5445e+01_r8,2.5106e-01_r8/) + kbo(:, 2,46,14) = (/ & + &2.9084e+02_r8,2.1878e+02_r8,1.4895e+02_r8,8.1712e+01_r8,4.4167e-01_r8/) + kbo(:, 3,46,14) = (/ & + &4.1605e+02_r8,3.1260e+02_r8,2.1206e+02_r8,1.1494e+02_r8,7.4589e-01_r8/) + kbo(:, 4,46,14) = (/ & + &5.7087e+02_r8,4.2857e+02_r8,2.8993e+02_r8,1.5559e+02_r8,1.1995e+00_r8/) + kbo(:, 5,46,14) = (/ & + &7.5566e+02_r8,5.6703e+02_r8,3.8272e+02_r8,2.0372e+02_r8,1.8420e+00_r8/) + kbo(:, 1,47,14) = (/ & + &1.6734e+02_r8,1.2615e+02_r8,8.6467e+01_r8,4.8182e+01_r8,1.9607e-01_r8/) + kbo(:, 2,47,14) = (/ & + &2.5798e+02_r8,1.9414e+02_r8,1.3227e+02_r8,7.2690e+01_r8,3.4728e-01_r8/) + kbo(:, 3,47,14) = (/ & + &3.7682e+02_r8,2.8319e+02_r8,1.9216e+02_r8,1.0425e+02_r8,6.0496e-01_r8/) + kbo(:, 4,47,14) = (/ & + &5.2596e+02_r8,3.9489e+02_r8,2.6718e+02_r8,1.4343e+02_r8,9.9190e-01_r8/) + kbo(:, 5,47,14) = (/ & + &7.0637e+02_r8,5.3006e+02_r8,3.5776e+02_r8,1.9039e+02_r8,1.5539e+00_r8/) + kbo(:, 1,48,14) = (/ & + &1.4359e+02_r8,1.0831e+02_r8,7.4350e+01_r8,4.1515e+01_r8,1.5112e-01_r8/) + kbo(:, 2,48,14) = (/ & + &2.2736e+02_r8,1.7115e+02_r8,1.1670e+02_r8,6.4242e+01_r8,2.7228e-01_r8/) + kbo(:, 3,48,14) = (/ & + &3.3955e+02_r8,2.5527e+02_r8,1.7326e+02_r8,9.4064e+01_r8,4.8587e-01_r8/) + kbo(:, 4,48,14) = (/ & + &4.8257e+02_r8,3.6236e+02_r8,2.4521e+02_r8,1.3165e+02_r8,8.1598e-01_r8/) + kbo(:, 5,48,14) = (/ & + &6.5841e+02_r8,4.9408e+02_r8,3.3351e+02_r8,1.7744e+02_r8,1.3043e+00_r8/) + kbo(:, 1,49,14) = (/ & + &1.2205e+02_r8,9.2102e+01_r8,6.3332e+01_r8,3.5432e+01_r8,1.1595e-01_r8/) + kbo(:, 2,49,14) = (/ & + &1.9899e+02_r8,1.4985e+02_r8,1.0228e+02_r8,5.6393e+01_r8,2.1177e-01_r8/) + kbo(:, 3,49,14) = (/ & + &3.0425e+02_r8,2.2876e+02_r8,1.5534e+02_r8,8.4415e+01_r8,3.8749e-01_r8/) + kbo(:, 4,49,14) = (/ & + &4.4104e+02_r8,3.3122e+02_r8,2.2413e+02_r8,1.2036e+02_r8,6.6950e-01_r8/) + kbo(:, 5,49,14) = (/ & + &6.1182e+02_r8,4.5914e+02_r8,3.0987e+02_r8,1.6480e+02_r8,1.0872e+00_r8/) + kbo(:, 1,50,14) = (/ & + &1.0410e+02_r8,7.8601e+01_r8,5.4134e+01_r8,3.0320e+01_r8,8.9437e-02_r8/) + kbo(:, 2,50,14) = (/ & + &1.7476e+02_r8,1.3166e+02_r8,8.9943e+01_r8,4.9647e+01_r8,1.6487e-01_r8/) + kbo(:, 3,50,14) = (/ & + &2.7363e+02_r8,2.0578e+02_r8,1.3977e+02_r8,7.5998e+01_r8,3.0880e-01_r8/) + kbo(:, 4,50,14) = (/ & + &4.0470e+02_r8,3.0398e+02_r8,2.0569e+02_r8,1.1045e+02_r8,5.4711e-01_r8/) + kbo(:, 5,50,14) = (/ & + &5.7059e+02_r8,4.2823e+02_r8,2.8900e+02_r8,1.5363e+02_r8,9.1135e-01_r8/) + kbo(:, 1,51,14) = (/ & + &8.8591e+01_r8,6.6918e+01_r8,4.6161e+01_r8,2.5881e+01_r8,7.0825e-02_r8/) + kbo(:, 2,51,14) = (/ & + &1.5315e+02_r8,1.1542e+02_r8,7.8914e+01_r8,4.3611e+01_r8,1.2808e-01_r8/) + kbo(:, 3,51,14) = (/ & + &2.4591e+02_r8,1.8497e+02_r8,1.2567e+02_r8,6.8391e+01_r8,2.4633e-01_r8/) + kbo(:, 4,51,14) = (/ & + &3.7125e+02_r8,2.7889e+02_r8,1.8871e+02_r8,1.0133e+02_r8,4.4644e-01_r8/) + kbo(:, 5,51,14) = (/ & + &5.3232e+02_r8,3.9953e+02_r8,2.6959e+02_r8,1.4324e+02_r8,7.6098e-01_r8/) + kbo(:, 1,52,14) = (/ & + &7.4832e+01_r8,5.6551e+01_r8,3.9072e+01_r8,2.1921e+01_r8,5.8568e-02_r8/) + kbo(:, 2,52,14) = (/ & + &1.3340e+02_r8,1.0056e+02_r8,6.8804e+01_r8,3.8048e+01_r8,9.9737e-02_r8/) + kbo(:, 3,52,14) = (/ & + &2.2000e+02_r8,1.6553e+02_r8,1.1251e+02_r8,6.1251e+01_r8,1.9573e-01_r8/) + kbo(:, 4,52,14) = (/ & + &3.3944e+02_r8,2.5503e+02_r8,1.7256e+02_r8,9.2621e+01_r8,3.6167e-01_r8/) + kbo(:, 5,52,14) = (/ & + &4.9563e+02_r8,3.7201e+02_r8,2.5099e+02_r8,1.3326e+02_r8,6.3209e-01_r8/) + kbo(:, 1,53,14) = (/ & + &6.2655e+01_r8,4.7378e+01_r8,3.2786e+01_r8,1.8402e+01_r8,5.0324e-02_r8/) + kbo(:, 2,53,14) = (/ & + &1.1533e+02_r8,8.6961e+01_r8,5.9562e+01_r8,3.2947e+01_r8,7.6555e-02_r8/) + kbo(:, 3,53,14) = (/ & + &1.9565e+02_r8,1.4725e+02_r8,1.0014e+02_r8,5.4560e+01_r8,1.5441e-01_r8/) + kbo(:, 4,53,14) = (/ & + &3.0901e+02_r8,2.3220e+02_r8,1.5711e+02_r8,8.4327e+01_r8,2.9159e-01_r8/) + kbo(:, 5,53,14) = (/ & + &4.6024e+02_r8,3.4547e+02_r8,2.3304e+02_r8,1.2363e+02_r8,5.2012e-01_r8/) + kbo(:, 1,54,14) = (/ & + &5.3046e+01_r8,4.0133e+01_r8,2.7816e+01_r8,1.5611e+01_r8,4.2542e-02_r8/) + kbo(:, 2,54,14) = (/ & + &1.0074e+02_r8,7.5982e+01_r8,5.2075e+01_r8,2.8803e+01_r8,6.4322e-02_r8/) + kbo(:, 3,54,14) = (/ & + &1.7557e+02_r8,1.3215e+02_r8,8.9882e+01_r8,4.8976e+01_r8,1.2163e-01_r8/) + kbo(:, 4,54,14) = (/ & + &2.8382e+02_r8,2.1329e+02_r8,1.4431e+02_r8,7.7417e+01_r8,2.3542e-01_r8/) + kbo(:, 5,54,14) = (/ & + &4.3075e+02_r8,3.2335e+02_r8,2.1806e+02_r8,1.1557e+02_r8,4.2927e-01_r8/) + kbo(:, 1,55,14) = (/ & + &4.5010e+01_r8,3.4076e+01_r8,2.3656e+01_r8,1.3271e+01_r8,3.8508e-02_r8/) + kbo(:, 2,55,14) = (/ & + &8.8262e+01_r8,6.6580e+01_r8,4.5655e+01_r8,2.5232e+01_r8,5.7123e-02_r8/) + kbo(:, 3,55,14) = (/ & + &1.5805e+02_r8,1.1897e+02_r8,8.0930e+01_r8,4.4073e+01_r8,9.5519e-02_r8/) + kbo(:, 4,55,14) = (/ & + &2.6161e+02_r8,1.9662e+02_r8,1.3302e+02_r8,7.1301e+01_r8,1.9000e-01_r8/) + kbo(:, 5,55,14) = (/ & + &4.0466e+02_r8,3.0378e+02_r8,2.0480e+02_r8,1.0841e+02_r8,3.5396e-01_r8/) + kbo(:, 1,56,14) = (/ & + &3.7999e+01_r8,2.8791e+01_r8,2.0014e+01_r8,1.1214e+01_r8,3.4994e-02_r8/) + kbo(:, 2,56,14) = (/ & + &7.7059e+01_r8,5.8140e+01_r8,3.9888e+01_r8,2.2021e+01_r8,5.1685e-02_r8/) + kbo(:, 3,56,14) = (/ & + &1.4187e+02_r8,1.0680e+02_r8,7.2655e+01_r8,3.9531e+01_r8,7.7408e-02_r8/) + kbo(:, 4,56,14) = (/ & + &2.4069e+02_r8,1.8091e+02_r8,1.2237e+02_r8,6.5530e+01_r8,1.5216e-01_r8/) + kbo(:, 5,56,14) = (/ & + &3.8007e+02_r8,2.8533e+02_r8,1.9230e+02_r8,1.0164e+02_r8,2.8842e-01_r8/) + kbo(:, 1,57,14) = (/ & + &3.1951e+01_r8,2.4226e+01_r8,1.6863e+01_r8,9.4281e+00_r8,3.3086e-02_r8/) + kbo(:, 2,57,14) = (/ & + &6.6995e+01_r8,5.0555e+01_r8,3.4699e+01_r8,1.9133e+01_r8,4.5516e-02_r8/) + kbo(:, 3,57,14) = (/ & + &1.2705e+02_r8,9.5650e+01_r8,6.5062e+01_r8,3.5359e+01_r8,6.7958e-02_r8/) + kbo(:, 4,57,14) = (/ & + &2.2106e+02_r8,1.6616e+02_r8,1.1237e+02_r8,6.0096e+01_r8,1.2025e-01_r8/) + kbo(:, 5,57,14) = (/ & + &3.5683e+02_r8,2.6789e+02_r8,1.8049e+02_r8,9.5240e+01_r8,2.3463e-01_r8/) + kbo(:, 1,58,14) = (/ & + &1.3120e+01_r8,1.1427e+01_r8,9.3421e+00_r8,6.3041e+00_r8,2.9290e-02_r8/) + kbo(:, 2,58,14) = (/ & + &2.8375e+01_r8,2.4586e+01_r8,1.9815e+01_r8,1.3205e+01_r8,4.1783e-02_r8/) + kbo(:, 3,58,14) = (/ & + &5.5462e+01_r8,4.7938e+01_r8,3.8264e+01_r8,2.5126e+01_r8,6.2497e-02_r8/) + kbo(:, 4,58,14) = (/ & + &9.8962e+01_r8,8.5397e+01_r8,6.7764e+01_r8,4.3784e+01_r8,9.9579e-02_r8/) + kbo(:, 5,58,14) = (/ & + &1.6330e+02_r8,1.4075e+02_r8,1.1126e+02_r8,7.0923e+01_r8,1.9106e-01_r8/) + kbo(:, 1,59,14) = (/ & + &1.2384e+01_r8,1.0821e+01_r8,8.8760e+00_r8,6.0092e+00_r8,2.9802e-02_r8/) + kbo(:, 2,59,14) = (/ & + &2.7135e+01_r8,2.3592e+01_r8,1.9085e+01_r8,1.2767e+01_r8,4.3735e-02_r8/) + kbo(:, 3,59,14) = (/ & + &5.3692e+01_r8,4.6568e+01_r8,3.7314e+01_r8,2.4591e+01_r8,6.7061e-02_r8/) + kbo(:, 4,59,14) = (/ & + &9.6831e+01_r8,8.3852e+01_r8,6.6810e+01_r8,4.3324e+01_r8,1.0825e-01_r8/) + kbo(:, 5,59,14) = (/ & + &1.6129e+02_r8,1.3951e+02_r8,1.1076e+02_r8,7.0881e+01_r8,1.7652e-01_r8/) + kbo(:, 1,13,15) = (/ & + &4.3408e+02_r8,3.2553e+02_r8,2.1704e+02_r8,1.0851e+02_r8,3.3387e-01_r8/) + kbo(:, 2,13,15) = (/ & + &6.1113e+02_r8,4.5841e+02_r8,3.0560e+02_r8,1.5279e+02_r8,3.4060e+00_r8/) + kbo(:, 3,13,15) = (/ & + &8.2062e+02_r8,6.1547e+02_r8,4.1031e+02_r8,2.0516e+02_r8,7.3889e+00_r8/) + kbo(:, 4,13,15) = (/ & + &1.0625e+03_r8,7.9684e+02_r8,5.3120e+02_r8,2.6560e+02_r8,1.3324e+01_r8/) + kbo(:, 5,13,15) = (/ & + &1.3314e+03_r8,9.9861e+02_r8,6.6575e+02_r8,3.3287e+02_r8,1.8510e+01_r8/) + kbo(:, 1,14,15) = (/ & + &4.8927e+02_r8,3.6696e+02_r8,2.4465e+02_r8,1.2233e+02_r8,1.4639e+00_r8/) + kbo(:, 2,14,15) = (/ & + &6.9247e+02_r8,5.1938e+02_r8,3.4624e+02_r8,1.7311e+02_r8,5.0161e+00_r8/) + kbo(:, 3,14,15) = (/ & + &9.3693e+02_r8,7.0263e+02_r8,4.6839e+02_r8,2.3422e+02_r8,9.2136e+00_r8/) + kbo(:, 4,14,15) = (/ & + &1.2198e+03_r8,9.1484e+02_r8,6.0989e+02_r8,3.0495e+02_r8,1.6015e+01_r8/) + kbo(:, 5,14,15) = (/ & + &1.5424e+03_r8,1.1568e+03_r8,7.7122e+02_r8,3.8560e+02_r8,2.0607e+01_r8/) + kbo(:, 1,15,15) = (/ & + &5.4419e+02_r8,4.0815e+02_r8,2.7209e+02_r8,1.3605e+02_r8,3.3205e+00_r8/) + kbo(:, 2,15,15) = (/ & + &7.6785e+02_r8,5.7588e+02_r8,3.8392e+02_r8,1.9198e+02_r8,6.4585e+00_r8/) + kbo(:, 3,15,15) = (/ & + &1.0420e+03_r8,7.8154e+02_r8,5.2102e+02_r8,2.6050e+02_r8,1.2593e+01_r8/) + kbo(:, 4,15,15) = (/ & + &1.3650e+03_r8,1.0239e+03_r8,6.8254e+02_r8,3.4127e+02_r8,1.7743e+01_r8/) + kbo(:, 5,15,15) = (/ & + &1.7328e+03_r8,1.2995e+03_r8,8.6636e+02_r8,4.3319e+02_r8,2.2779e+01_r8/) + kbo(:, 1,16,15) = (/ & + &5.9961e+02_r8,4.4968e+02_r8,2.9978e+02_r8,1.4989e+02_r8,4.3949e+00_r8/) + kbo(:, 2,16,15) = (/ & + &8.4044e+02_r8,6.3032e+02_r8,4.2019e+02_r8,2.1011e+02_r8,9.1201e+00_r8/) + kbo(:, 3,16,15) = (/ & + &1.1438e+03_r8,8.5770e+02_r8,5.7195e+02_r8,2.8595e+02_r8,1.4709e+01_r8/) + kbo(:, 4,16,15) = (/ & + &1.4993e+03_r8,1.1245e+03_r8,7.4965e+02_r8,3.7484e+02_r8,1.9517e+01_r8/) + kbo(:, 5,16,15) = (/ & + &1.9026e+03_r8,1.4270e+03_r8,9.5133e+02_r8,4.7569e+02_r8,2.4995e+01_r8/) + kbo(:, 1,17,15) = (/ & + &6.5740e+02_r8,4.9304e+02_r8,3.2868e+02_r8,1.6434e+02_r8,5.9877e+00_r8/) + kbo(:, 2,17,15) = (/ & + &9.1769e+02_r8,6.8825e+02_r8,4.5884e+02_r8,2.2941e+02_r8,1.1589e+01_r8/) + kbo(:, 3,17,15) = (/ & + &1.2441e+03_r8,9.3311e+02_r8,6.2203e+02_r8,3.1103e+02_r8,1.6070e+01_r8/) + kbo(:, 4,17,15) = (/ & + &1.6286e+03_r8,1.2214e+03_r8,8.1435e+02_r8,4.0716e+02_r8,2.1263e+01_r8/) + kbo(:, 5,17,15) = (/ & + &2.0647e+03_r8,1.5485e+03_r8,1.0323e+03_r8,5.1617e+02_r8,2.7194e+01_r8/) + kbo(:, 1,18,15) = (/ & + &7.0743e+02_r8,5.3056e+02_r8,3.5371e+02_r8,1.7685e+02_r8,7.5465e+00_r8/) + kbo(:, 2,18,15) = (/ & + &9.8473e+02_r8,7.3856e+02_r8,4.9235e+02_r8,2.4618e+02_r8,1.2708e+01_r8/) + kbo(:, 3,18,15) = (/ & + &1.3299e+03_r8,9.9741e+02_r8,6.6495e+02_r8,3.3248e+02_r8,1.7433e+01_r8/) + kbo(:, 4,18,15) = (/ & + &1.7379e+03_r8,1.3034e+03_r8,8.6887e+02_r8,4.3447e+02_r8,2.2996e+01_r8/) + kbo(:, 5,18,15) = (/ & + &2.2009e+03_r8,1.6506e+03_r8,1.1004e+03_r8,5.5020e+02_r8,2.9358e+01_r8/) + kbo(:, 1,19,15) = (/ & + &7.7797e+02_r8,5.8347e+02_r8,3.8898e+02_r8,1.9449e+02_r8,8.9058e+00_r8/) + kbo(:, 2,19,15) = (/ & + &1.0795e+03_r8,8.0964e+02_r8,5.3974e+02_r8,2.6988e+02_r8,1.3760e+01_r8/) + kbo(:, 3,19,15) = (/ & + &1.4503e+03_r8,1.0877e+03_r8,7.2515e+02_r8,3.6258e+02_r8,1.8739e+01_r8/) + kbo(:, 4,19,15) = (/ & + &1.8906e+03_r8,1.4179e+03_r8,9.4523e+02_r8,4.7263e+02_r8,2.4641e+01_r8/) + kbo(:, 5,19,15) = (/ & + &2.3863e+03_r8,1.7897e+03_r8,1.1933e+03_r8,5.9656e+02_r8,3.1485e+01_r8/) + kbo(:, 1,20,15) = (/ & + &8.7874e+02_r8,6.5907e+02_r8,4.3939e+02_r8,2.1969e+02_r8,9.7556e+00_r8/) + kbo(:, 2,20,15) = (/ & + &1.2128e+03_r8,9.0962e+02_r8,6.0638e+02_r8,3.0319e+02_r8,1.4896e+01_r8/) + kbo(:, 3,20,15) = (/ & + &1.6209e+03_r8,1.2157e+03_r8,8.1051e+02_r8,4.0524e+02_r8,2.0180e+01_r8/) + kbo(:, 4,20,15) = (/ & + &2.1009e+03_r8,1.5756e+03_r8,1.0504e+03_r8,5.2525e+02_r8,2.6433e+01_r8/) + kbo(:, 5,20,15) = (/ & + &2.6410e+03_r8,1.9808e+03_r8,1.3205e+03_r8,6.6026e+02_r8,3.3724e+01_r8/) + kbo(:, 1,21,15) = (/ & + &9.9673e+02_r8,7.4761e+02_r8,4.9839e+02_r8,2.4919e+02_r8,1.0524e+01_r8/) + kbo(:, 2,21,15) = (/ & + &1.3673e+03_r8,1.0255e+03_r8,6.8366e+02_r8,3.4184e+02_r8,1.6075e+01_r8/) + kbo(:, 3,21,15) = (/ & + &1.8166e+03_r8,1.3625e+03_r8,9.0829e+02_r8,4.5412e+02_r8,2.1690e+01_r8/) + kbo(:, 4,21,15) = (/ & + &2.3404e+03_r8,1.7553e+03_r8,1.1702e+03_r8,5.8508e+02_r8,2.8346e+01_r8/) + kbo(:, 5,21,15) = (/ & + &2.9258e+03_r8,2.1942e+03_r8,1.4629e+03_r8,7.3140e+02_r8,3.6033e+01_r8/) + kbo(:, 1,22,15) = (/ & + &1.1483e+03_r8,8.6125e+02_r8,5.7415e+02_r8,2.8707e+02_r8,1.1768e+01_r8/) + kbo(:, 2,22,15) = (/ & + &1.5630e+03_r8,1.1723e+03_r8,7.8152e+02_r8,3.9076e+02_r8,1.7624e+01_r8/) + kbo(:, 3,22,15) = (/ & + &2.0593e+03_r8,1.5445e+03_r8,1.0296e+03_r8,5.1484e+02_r8,2.3654e+01_r8/) + kbo(:, 4,22,15) = (/ & + &2.6282e+03_r8,1.9711e+03_r8,1.3140e+03_r8,6.5702e+02_r8,3.0777e+01_r8/) + kbo(:, 5,22,15) = (/ & + &3.2625e+03_r8,2.4468e+03_r8,1.6313e+03_r8,8.1566e+02_r8,3.8871e+01_r8/) + kbo(:, 1,23,15) = (/ & + &1.3167e+03_r8,9.8756e+02_r8,6.5833e+02_r8,3.2919e+02_r8,1.3119e+01_r8/) + kbo(:, 2,23,15) = (/ & + &1.7766e+03_r8,1.3324e+03_r8,8.8830e+02_r8,4.4413e+02_r8,1.9267e+01_r8/) + kbo(:, 3,23,15) = (/ & + &2.3173e+03_r8,1.7380e+03_r8,1.1586e+03_r8,5.7933e+02_r8,2.5707e+01_r8/) + kbo(:, 4,23,15) = (/ & + &2.9343e+03_r8,2.2007e+03_r8,1.4671e+03_r8,7.3355e+02_r8,3.3186e+01_r8/) + kbo(:, 5,23,15) = (/ & + &3.6141e+03_r8,2.7105e+03_r8,1.8070e+03_r8,9.0351e+02_r8,4.1634e+01_r8/) + kbo(:, 1,24,15) = (/ & + &1.5139e+03_r8,1.1354e+03_r8,7.5695e+02_r8,3.7848e+02_r8,1.4766e+01_r8/) + kbo(:, 2,24,15) = (/ & + &2.0213e+03_r8,1.5159e+03_r8,1.0107e+03_r8,5.0532e+02_r8,2.1039e+01_r8/) + kbo(:, 3,24,15) = (/ & + &2.6132e+03_r8,1.9598e+03_r8,1.3066e+03_r8,6.5328e+02_r8,2.7799e+01_r8/) + kbo(:, 4,24,15) = (/ & + &3.2798e+03_r8,2.4598e+03_r8,1.6399e+03_r8,8.1993e+02_r8,3.5585e+01_r8/) + kbo(:, 5,24,15) = (/ & + &4.0096e+03_r8,3.0073e+03_r8,2.0048e+03_r8,1.0024e+03_r8,4.4343e+01_r8/) + kbo(:, 1,25,15) = (/ & + &1.7311e+03_r8,1.2983e+03_r8,8.6555e+02_r8,4.3279e+02_r8,1.6410e+01_r8/) + kbo(:, 2,25,15) = (/ & + &2.2880e+03_r8,1.7160e+03_r8,1.1440e+03_r8,5.7204e+02_r8,2.2852e+01_r8/) + kbo(:, 3,25,15) = (/ & + &2.9293e+03_r8,2.1970e+03_r8,1.4646e+03_r8,7.3234e+02_r8,2.9897e+01_r8/) + kbo(:, 4,25,15) = (/ & + &3.6441e+03_r8,2.7331e+03_r8,1.8220e+03_r8,9.1101e+02_r8,3.8003e+01_r8/) + kbo(:, 5,25,15) = (/ & + &4.4209e+03_r8,3.3157e+03_r8,2.2104e+03_r8,1.1052e+03_r8,4.7037e+01_r8/) + kbo(:, 1,26,15) = (/ & + &1.9753e+03_r8,1.4814e+03_r8,9.8766e+02_r8,4.9382e+02_r8,1.8018e+01_r8/) + kbo(:, 2,26,15) = (/ & + &2.5844e+03_r8,1.9383e+03_r8,1.2922e+03_r8,6.4606e+02_r8,2.4551e+01_r8/) + kbo(:, 3,26,15) = (/ & + &3.2758e+03_r8,2.4567e+03_r8,1.6379e+03_r8,8.1896e+02_r8,3.2091e+01_r8/) + kbo(:, 4,26,15) = (/ & + &4.0392e+03_r8,3.0293e+03_r8,2.0196e+03_r8,1.0098e+03_r8,4.0504e+01_r8/) + kbo(:, 5,26,15) = (/ & + &4.8643e+03_r8,3.6484e+03_r8,2.4323e+03_r8,1.2161e+03_r8,4.9853e+01_r8/) + kbo(:, 1,27,15) = (/ & + &2.2372e+03_r8,1.6779e+03_r8,1.1187e+03_r8,5.5932e+02_r8,1.9412e+01_r8/) + kbo(:, 2,27,15) = (/ & + &2.8964e+03_r8,2.1723e+03_r8,1.4482e+03_r8,7.2410e+02_r8,2.6199e+01_r8/) + kbo(:, 3,27,15) = (/ & + &3.6363e+03_r8,2.7272e+03_r8,1.8181e+03_r8,9.0912e+02_r8,3.4164e+01_r8/) + kbo(:, 4,27,15) = (/ & + &4.4487e+03_r8,3.3365e+03_r8,2.2244e+03_r8,1.1122e+03_r8,4.3003e+01_r8/) + kbo(:, 5,27,15) = (/ & + &5.3193e+03_r8,3.9894e+03_r8,2.6596e+03_r8,1.3298e+03_r8,5.2701e+01_r8/) + kbo(:, 1,28,15) = (/ & + &2.5116e+03_r8,1.8837e+03_r8,1.2558e+03_r8,6.2784e+02_r8,2.0876e+01_r8/) + kbo(:, 2,28,15) = (/ & + &3.2189e+03_r8,2.4142e+03_r8,1.6096e+03_r8,8.0476e+02_r8,2.7949e+01_r8/) + kbo(:, 3,28,15) = (/ & + &4.0085e+03_r8,3.0060e+03_r8,2.0042e+03_r8,1.0021e+03_r8,3.6156e+01_r8/) + kbo(:, 4,28,15) = (/ & + &4.8660e+03_r8,3.6495e+03_r8,2.4329e+03_r8,1.2165e+03_r8,4.5448e+01_r8/) + kbo(:, 5,28,15) = (/ & + &5.7764e+03_r8,4.3322e+03_r8,2.8883e+03_r8,1.4442e+03_r8,5.5591e+01_r8/) + kbo(:, 1,29,15) = (/ & + &2.7788e+03_r8,2.0842e+03_r8,1.3895e+03_r8,6.9477e+02_r8,2.2561e+01_r8/) + kbo(:, 2,29,15) = (/ & + &3.5298e+03_r8,2.6472e+03_r8,1.7648e+03_r8,8.8246e+02_r8,2.9936e+01_r8/) + kbo(:, 3,29,15) = (/ & + &4.3597e+03_r8,3.2696e+03_r8,2.1798e+03_r8,1.0899e+03_r8,3.8464e+01_r8/) + kbo(:, 4,29,15) = (/ & + &5.2526e+03_r8,3.9395e+03_r8,2.6263e+03_r8,1.3131e+03_r8,4.8125e+01_r8/) + kbo(:, 5,29,15) = (/ & + &6.1956e+03_r8,4.6467e+03_r8,3.0979e+03_r8,1.5489e+03_r8,5.8615e+01_r8/) + kbo(:, 1,30,15) = (/ & + &3.0369e+03_r8,2.2777e+03_r8,1.5185e+03_r8,7.5926e+02_r8,2.4413e+01_r8/) + kbo(:, 2,30,15) = (/ & + &3.8244e+03_r8,2.8684e+03_r8,1.9122e+03_r8,9.5609e+02_r8,3.2061e+01_r8/) + kbo(:, 3,30,15) = (/ & + &4.6859e+03_r8,3.5141e+03_r8,2.3430e+03_r8,1.1715e+03_r8,4.0933e+01_r8/) + kbo(:, 4,30,15) = (/ & + &5.6065e+03_r8,4.2050e+03_r8,2.8032e+03_r8,1.4016e+03_r8,5.0897e+01_r8/) + kbo(:, 5,30,15) = (/ & + &6.5717e+03_r8,4.9287e+03_r8,3.2858e+03_r8,1.6429e+03_r8,6.1721e+01_r8/) + kbo(:, 1,31,15) = (/ & + &3.2648e+03_r8,2.4486e+03_r8,1.6324e+03_r8,8.1618e+02_r8,2.6426e+01_r8/) + kbo(:, 2,31,15) = (/ & + &4.0756e+03_r8,3.0566e+03_r8,2.0378e+03_r8,1.0190e+03_r8,3.4471e+01_r8/) + kbo(:, 3,31,15) = (/ & + &4.9563e+03_r8,3.7173e+03_r8,2.4782e+03_r8,1.2392e+03_r8,4.3666e+01_r8/) + kbo(:, 4,31,15) = (/ & + &5.8911e+03_r8,4.4181e+03_r8,2.9455e+03_r8,1.4727e+03_r8,5.3750e+01_r8/) + kbo(:, 5,31,15) = (/ & + &6.8637e+03_r8,5.1477e+03_r8,3.4319e+03_r8,1.7160e+03_r8,6.4980e+01_r8/) + kbo(:, 1,32,15) = (/ & + &3.4972e+03_r8,2.6230e+03_r8,1.7487e+03_r8,8.7434e+02_r8,2.8607e+01_r8/) + kbo(:, 2,32,15) = (/ & + &4.3306e+03_r8,3.2480e+03_r8,2.1653e+03_r8,1.0827e+03_r8,3.6943e+01_r8/) + kbo(:, 3,32,15) = (/ & + &5.2288e+03_r8,3.9216e+03_r8,2.6144e+03_r8,1.3072e+03_r8,4.6342e+01_r8/) + kbo(:, 4,32,15) = (/ & + &6.1756e+03_r8,4.6314e+03_r8,3.0875e+03_r8,1.5439e+03_r8,5.6744e+01_r8/) + kbo(:, 5,32,15) = (/ & + &7.1543e+03_r8,5.3657e+03_r8,3.5769e+03_r8,1.7884e+03_r8,6.8387e+01_r8/) + kbo(:, 1,33,15) = (/ & + &3.7323e+03_r8,2.7993e+03_r8,1.8662e+03_r8,9.3310e+02_r8,3.0880e+01_r8/) + kbo(:, 2,33,15) = (/ & + &4.5855e+03_r8,3.4391e+03_r8,2.2927e+03_r8,1.1463e+03_r8,3.9458e+01_r8/) + kbo(:, 3,33,15) = (/ & + &5.4988e+03_r8,4.1239e+03_r8,2.7494e+03_r8,1.3747e+03_r8,4.9066e+01_r8/) + kbo(:, 4,33,15) = (/ & + &6.4556e+03_r8,4.8415e+03_r8,3.2279e+03_r8,1.6139e+03_r8,5.9834e+01_r8/) + kbo(:, 5,33,15) = (/ & + &7.4364e+03_r8,5.5775e+03_r8,3.7183e+03_r8,1.8591e+03_r8,7.1936e+01_r8/) + kbo(:, 1,34,15) = (/ & + &3.9743e+03_r8,2.9808e+03_r8,1.9872e+03_r8,9.9359e+02_r8,3.2850e+01_r8/) + kbo(:, 2,34,15) = (/ & + &4.8517e+03_r8,3.6384e+03_r8,2.4257e+03_r8,1.2129e+03_r8,4.1615e+01_r8/) + kbo(:, 3,34,15) = (/ & + &5.7848e+03_r8,4.3386e+03_r8,2.8923e+03_r8,1.4462e+03_r8,5.1514e+01_r8/) + kbo(:, 4,34,15) = (/ & + &6.7566e+03_r8,5.0673e+03_r8,3.3783e+03_r8,1.6891e+03_r8,6.2632e+01_r8/) + kbo(:, 5,34,15) = (/ & + &7.7467e+03_r8,5.8099e+03_r8,3.8734e+03_r8,1.9367e+03_r8,7.5129e+01_r8/) + kbo(:, 1,35,15) = (/ & + &4.1392e+03_r8,3.1044e+03_r8,2.0697e+03_r8,1.0348e+03_r8,3.4005e+01_r8/) + kbo(:, 2,35,15) = (/ & + &5.0338e+03_r8,3.7756e+03_r8,2.5169e+03_r8,1.2585e+03_r8,4.2889e+01_r8/) + kbo(:, 3,35,15) = (/ & + &5.9824e+03_r8,4.4867e+03_r8,2.9910e+03_r8,1.4955e+03_r8,5.2983e+01_r8/) + kbo(:, 4,35,15) = (/ & + &6.9652e+03_r8,5.2239e+03_r8,3.4826e+03_r8,1.7414e+03_r8,6.4327e+01_r8/) + kbo(:, 5,35,15) = (/ & + &7.9642e+03_r8,5.9733e+03_r8,3.9822e+03_r8,1.9911e+03_r8,7.7087e+01_r8/) + kbo(:, 1,36,15) = (/ & + &4.2146e+03_r8,3.1608e+03_r8,2.1072e+03_r8,1.0536e+03_r8,3.4225e+01_r8/) + kbo(:, 2,36,15) = (/ & + &5.1200e+03_r8,3.8401e+03_r8,2.5599e+03_r8,1.2800e+03_r8,4.3139e+01_r8/) + kbo(:, 3,36,15) = (/ & + &6.0791e+03_r8,4.5594e+03_r8,3.0396e+03_r8,1.5198e+03_r8,5.3291e+01_r8/) + kbo(:, 4,36,15) = (/ & + &7.0718e+03_r8,5.3037e+03_r8,3.5357e+03_r8,1.7679e+03_r8,6.4713e+01_r8/) + kbo(:, 5,36,15) = (/ & + &8.0803e+03_r8,6.0601e+03_r8,4.0401e+03_r8,2.0201e+03_r8,7.7535e+01_r8/) + kbo(:, 1,37,15) = (/ & + &4.1830e+03_r8,3.1372e+03_r8,2.0915e+03_r8,1.0457e+03_r8,3.3171e+01_r8/) + kbo(:, 2,37,15) = (/ & + &5.0955e+03_r8,3.8218e+03_r8,2.5477e+03_r8,1.2739e+03_r8,4.1938e+01_r8/) + kbo(:, 3,37,15) = (/ & + &6.0651e+03_r8,4.5490e+03_r8,3.0327e+03_r8,1.5163e+03_r8,5.1957e+01_r8/) + kbo(:, 4,37,15) = (/ & + &7.0708e+03_r8,5.3029e+03_r8,3.5354e+03_r8,1.7678e+03_r8,6.3244e+01_r8/) + kbo(:, 5,37,15) = (/ & + &8.0937e+03_r8,6.0708e+03_r8,4.0470e+03_r8,2.0235e+03_r8,7.5914e+01_r8/) + kbo(:, 1,38,15) = (/ & + &4.1367e+03_r8,3.1023e+03_r8,2.0683e+03_r8,1.0342e+03_r8,3.2061e+01_r8/) + kbo(:, 2,38,15) = (/ & + &5.0552e+03_r8,3.7913e+03_r8,2.5275e+03_r8,1.2638e+03_r8,4.0668e+01_r8/) + kbo(:, 3,38,15) = (/ & + &6.0331e+03_r8,4.5250e+03_r8,3.0168e+03_r8,1.5083e+03_r8,5.0542e+01_r8/) + kbo(:, 4,38,15) = (/ & + &7.0503e+03_r8,5.2874e+03_r8,3.5252e+03_r8,1.7626e+03_r8,6.1670e+01_r8/) + kbo(:, 5,38,15) = (/ & + &8.0886e+03_r8,6.0662e+03_r8,4.0441e+03_r8,2.0220e+03_r8,7.4175e+01_r8/) + kbo(:, 1,39,15) = (/ & + &4.0836e+03_r8,3.0625e+03_r8,2.0418e+03_r8,1.0208e+03_r8,3.0973e+01_r8/) + kbo(:, 2,39,15) = (/ & + &5.0068e+03_r8,3.7549e+03_r8,2.5034e+03_r8,1.2516e+03_r8,3.9423e+01_r8/) + kbo(:, 3,39,15) = (/ & + &5.9917e+03_r8,4.4934e+03_r8,2.9959e+03_r8,1.4979e+03_r8,4.9140e+01_r8/) + kbo(:, 4,39,15) = (/ & + &7.0190e+03_r8,5.2646e+03_r8,3.5096e+03_r8,1.7548e+03_r8,6.0110e+01_r8/) + kbo(:, 5,39,15) = (/ & + &8.0703e+03_r8,6.0526e+03_r8,4.0352e+03_r8,2.0176e+03_r8,7.2442e+01_r8/) + kbo(:, 1,40,15) = (/ & + &3.9731e+03_r8,2.9800e+03_r8,1.9865e+03_r8,9.9327e+02_r8,2.9119e+01_r8/) + kbo(:, 2,40,15) = (/ & + &4.9010e+03_r8,3.6760e+03_r8,2.4505e+03_r8,1.2252e+03_r8,3.7284e+01_r8/) + kbo(:, 3,40,15) = (/ & + &5.8967e+03_r8,4.4226e+03_r8,2.9482e+03_r8,1.4742e+03_r8,4.6706e+01_r8/) + kbo(:, 4,40,15) = (/ & + &6.9401e+03_r8,5.2049e+03_r8,3.4701e+03_r8,1.7350e+03_r8,5.7383e+01_r8/) + kbo(:, 5,40,15) = (/ & + &8.0134e+03_r8,6.0096e+03_r8,4.0066e+03_r8,2.0033e+03_r8,6.9395e+01_r8/) + kbo(:, 1,41,15) = (/ & + &3.8503e+03_r8,2.8877e+03_r8,1.9252e+03_r8,9.6258e+02_r8,2.7224e+01_r8/) + kbo(:, 2,41,15) = (/ & + &4.7815e+03_r8,3.5862e+03_r8,2.3908e+03_r8,1.1953e+03_r8,3.5101e+01_r8/) + kbo(:, 3,41,15) = (/ & + &5.7872e+03_r8,4.3401e+03_r8,2.8935e+03_r8,1.4467e+03_r8,4.4197e+01_r8/) + kbo(:, 4,41,15) = (/ & + &6.8458e+03_r8,5.1341e+03_r8,3.4225e+03_r8,1.7115e+03_r8,5.4583e+01_r8/) + kbo(:, 5,41,15) = (/ & + &7.9396e+03_r8,5.9547e+03_r8,3.9699e+03_r8,1.9849e+03_r8,6.6259e+01_r8/) + kbo(:, 1,42,15) = (/ & + &3.7218e+03_r8,2.7913e+03_r8,1.8581e+03_r8,9.3043e+02_r8,2.5397e+01_r8/) + kbo(:, 2,42,15) = (/ & + &4.6552e+03_r8,3.4913e+03_r8,2.3275e+03_r8,1.1638e+03_r8,3.2985e+01_r8/) + kbo(:, 3,42,15) = (/ & + &5.6676e+03_r8,4.2515e+03_r8,2.8342e+03_r8,1.4169e+03_r8,4.1777e+01_r8/) + kbo(:, 4,42,15) = (/ & + &6.7404e+03_r8,5.0552e+03_r8,3.3706e+03_r8,1.6852e+03_r8,5.1833e+01_r8/) + kbo(:, 5,42,15) = (/ & + &7.8548e+03_r8,5.8911e+03_r8,3.9277e+03_r8,1.9637e+03_r8,6.3188e+01_r8/) + kbo(:, 1,43,15) = (/ & + &3.5738e+03_r8,2.6801e+03_r8,1.7870e+03_r8,8.9342e+02_r8,2.3264e+01_r8/) + kbo(:, 2,43,15) = (/ & + &4.5111e+03_r8,3.3834e+03_r8,2.2559e+03_r8,1.1277e+03_r8,3.0494e+01_r8/) + kbo(:, 3,43,15) = (/ & + &5.5364e+03_r8,4.1522e+03_r8,2.7681e+03_r8,1.3841e+03_r8,3.8909e+01_r8/) + kbo(:, 4,43,15) = (/ & + &6.6297e+03_r8,4.9723e+03_r8,3.3147e+03_r8,1.6574e+03_r8,4.8575e+01_r8/) + kbo(:, 5,43,15) = (/ & + &7.7713e+03_r8,5.8285e+03_r8,3.8856e+03_r8,1.9429e+03_r8,5.9539e+01_r8/) + kbo(:, 1,44,15) = (/ & + &3.4144e+03_r8,2.5608e+03_r8,1.7072e+03_r8,8.5364e+02_r8,2.1065e+01_r8/) + kbo(:, 2,44,15) = (/ & + &4.3569e+03_r8,3.2674e+03_r8,2.1784e+03_r8,1.0893e+03_r8,2.7929e+01_r8/) + kbo(:, 3,44,15) = (/ & + &5.3944e+03_r8,4.0458e+03_r8,2.6971e+03_r8,1.3486e+03_r8,3.5943e+01_r8/) + kbo(:, 4,44,15) = (/ & + &6.5105e+03_r8,4.8828e+03_r8,3.2554e+03_r8,1.6276e+03_r8,4.5182e+01_r8/) + kbo(:, 5,44,15) = (/ & + &7.6829e+03_r8,5.7622e+03_r8,3.8414e+03_r8,1.9208e+03_r8,5.5715e+01_r8/) + kbo(:, 1,45,15) = (/ & + &3.2505e+03_r8,2.4379e+03_r8,1.6254e+03_r8,8.1271e+02_r8,1.8984e+01_r8/) + kbo(:, 2,45,15) = (/ & + &4.1974e+03_r8,3.1481e+03_r8,2.0989e+03_r8,1.0493e+03_r8,2.5493e+01_r8/) + kbo(:, 3,45,15) = (/ & + &5.2466e+03_r8,3.9350e+03_r8,2.6232e+03_r8,1.3117e+03_r8,3.3113e+01_r8/) + kbo(:, 4,45,15) = (/ & + &6.3833e+03_r8,4.7875e+03_r8,3.1918e+03_r8,1.5958e+03_r8,4.1930e+01_r8/) + kbo(:, 5,45,15) = (/ & + &7.5868e+03_r8,5.6901e+03_r8,3.7934e+03_r8,1.8967e+03_r8,5.2027e+01_r8/) + kbo(:, 1,46,15) = (/ & + &3.0662e+03_r8,2.2996e+03_r8,1.5331e+03_r8,7.6672e+02_r8,1.6905e+01_r8/) + kbo(:, 2,46,15) = (/ & + &4.0155e+03_r8,3.0116e+03_r8,2.0079e+03_r8,1.0039e+03_r8,2.3041e+01_r8/) + kbo(:, 3,46,15) = (/ & + &5.0741e+03_r8,3.8056e+03_r8,2.5370e+03_r8,1.2685e+03_r8,3.0241e+01_r8/) + kbo(:, 4,46,15) = (/ & + &6.2294e+03_r8,4.6721e+03_r8,3.1149e+03_r8,1.5573e+03_r8,3.8622e+01_r8/) + kbo(:, 5,46,15) = (/ & + &7.4637e+03_r8,5.5978e+03_r8,3.7320e+03_r8,1.8660e+03_r8,4.8257e+01_r8/) + kbo(:, 1,47,15) = (/ & + &2.8472e+03_r8,2.1354e+03_r8,1.4236e+03_r8,7.1208e+02_r8,1.4723e+01_r8/) + kbo(:, 2,47,15) = (/ & + &3.7952e+03_r8,2.8464e+03_r8,1.8976e+03_r8,9.4874e+02_r8,2.0451e+01_r8/) + kbo(:, 3,47,15) = (/ & + &4.8581e+03_r8,3.6436e+03_r8,2.4290e+03_r8,1.2145e+03_r8,2.7203e+01_r8/) + kbo(:, 4,47,15) = (/ & + &6.0303e+03_r8,4.5227e+03_r8,3.0151e+03_r8,1.5075e+03_r8,3.5112e+01_r8/) + kbo(:, 5,47,15) = (/ & + &7.2931e+03_r8,5.4698e+03_r8,3.6467e+03_r8,1.8233e+03_r8,4.4239e+01_r8/) + kbo(:, 1,48,15) = (/ & + &2.6253e+03_r8,1.9691e+03_r8,1.3127e+03_r8,6.5679e+02_r8,1.2715e+01_r8/) + kbo(:, 2,48,15) = (/ & + &3.5692e+03_r8,2.6769e+03_r8,1.7846e+03_r8,8.9231e+02_r8,1.8030e+01_r8/) + kbo(:, 3,48,15) = (/ & + &4.6375e+03_r8,3.4782e+03_r8,2.3188e+03_r8,1.1595e+03_r8,2.4364e+01_r8/) + kbo(:, 4,48,15) = (/ & + &5.8244e+03_r8,4.3683e+03_r8,2.9120e+03_r8,1.4560e+03_r8,3.1792e+01_r8/) + kbo(:, 5,48,15) = (/ & + &7.1141e+03_r8,5.3356e+03_r8,3.5570e+03_r8,1.7785e+03_r8,4.0424e+01_r8/) + kbo(:, 1,49,15) = (/ & + &2.4040e+03_r8,1.8030e+03_r8,1.2020e+03_r8,6.0155e+02_r8,1.0861e+01_r8/) + kbo(:, 2,49,15) = (/ & + &3.3401e+03_r8,2.5051e+03_r8,1.6700e+03_r8,8.3512e+02_r8,1.5777e+01_r8/) + kbo(:, 3,49,15) = (/ & + &4.4127e+03_r8,3.3095e+03_r8,2.2063e+03_r8,1.1031e+03_r8,2.1693e+01_r8/) + kbo(:, 4,49,15) = (/ & + &5.6115e+03_r8,4.2087e+03_r8,2.8058e+03_r8,1.4030e+03_r8,2.8659e+01_r8/) + kbo(:, 5,49,15) = (/ & + &6.9274e+03_r8,5.1956e+03_r8,3.4636e+03_r8,1.7318e+03_r8,3.6808e+01_r8/) + kbo(:, 1,50,15) = (/ & + &2.2030e+03_r8,1.6523e+03_r8,1.1015e+03_r8,5.5137e+02_r8,9.2813e+00_r8/) + kbo(:, 2,50,15) = (/ & + &3.1297e+03_r8,2.3473e+03_r8,1.5649e+03_r8,7.8265e+02_r8,1.3818e+01_r8/) + kbo(:, 3,50,15) = (/ & + &4.2081e+03_r8,3.1561e+03_r8,2.1041e+03_r8,1.0519e+03_r8,1.9341e+01_r8/) + kbo(:, 4,50,15) = (/ & + &5.4214e+03_r8,4.0660e+03_r8,2.7107e+03_r8,1.3553e+03_r8,2.5902e+01_r8/) + kbo(:, 5,50,15) = (/ & + &6.7641e+03_r8,5.0731e+03_r8,3.3821e+03_r8,1.6910e+03_r8,3.3602e+01_r8/) + kbo(:, 1,51,15) = (/ & + &2.0128e+03_r8,1.5096e+03_r8,1.0064e+03_r8,5.0390e+02_r8,7.8927e+00_r8/) + kbo(:, 2,51,15) = (/ & + &2.9276e+03_r8,2.1957e+03_r8,1.4638e+03_r8,7.3206e+02_r8,1.2046e+01_r8/) + kbo(:, 3,51,15) = (/ & + &4.0098e+03_r8,3.0073e+03_r8,2.0049e+03_r8,1.0025e+03_r8,1.7204e+01_r8/) + kbo(:, 4,51,15) = (/ & + &5.2399e+03_r8,3.9299e+03_r8,2.6200e+03_r8,1.3100e+03_r8,2.3387e+01_r8/) + kbo(:, 5,51,15) = (/ & + &6.6101e+03_r8,4.9575e+03_r8,3.3050e+03_r8,1.6525e+03_r8,3.0654e+01_r8/) + kbo(:, 1,52,15) = (/ & + &1.8272e+03_r8,1.3704e+03_r8,9.1373e+02_r8,4.5761e+02_r8,6.6428e+00_r8/) + kbo(:, 2,52,15) = (/ & + &2.7256e+03_r8,2.0442e+03_r8,1.3627e+03_r8,6.8167e+02_r8,1.0409e+01_r8/) + kbo(:, 3,52,15) = (/ & + &3.8098e+03_r8,2.8573e+03_r8,1.9049e+03_r8,9.5240e+02_r8,1.5205e+01_r8/) + kbo(:, 4,52,15) = (/ & + &5.0575e+03_r8,3.7931e+03_r8,2.5288e+03_r8,1.2643e+03_r8,2.1008e+01_r8/) + kbo(:, 5,52,15) = (/ & + &6.4544e+03_r8,4.8408e+03_r8,3.2272e+03_r8,1.6135e+03_r8,2.7863e+01_r8/) + kbo(:, 1,53,15) = (/ & + &1.6455e+03_r8,1.2341e+03_r8,8.2275e+02_r8,4.1218e+02_r8,5.5292e+00_r8/) + kbo(:, 2,53,15) = (/ & + &2.5225e+03_r8,1.8919e+03_r8,1.2613e+03_r8,6.3102e+02_r8,8.9199e+00_r8/) + kbo(:, 3,53,15) = (/ & + &3.6054e+03_r8,2.7042e+03_r8,1.8028e+03_r8,9.0141e+02_r8,1.3342e+01_r8/) + kbo(:, 4,53,15) = (/ & + &4.8703e+03_r8,3.6527e+03_r8,2.4352e+03_r8,1.2176e+03_r8,1.8766e+01_r8/) + kbo(:, 5,53,15) = (/ & + &6.2970e+03_r8,4.7228e+03_r8,3.1485e+03_r8,1.5742e+03_r8,2.5231e+01_r8/) + kbo(:, 1,54,15) = (/ & + &1.4905e+03_r8,1.1179e+03_r8,7.4526e+02_r8,3.7343e+02_r8,4.6241e+00_r8/) + kbo(:, 2,54,15) = (/ & + &2.3494e+03_r8,1.7621e+03_r8,1.1747e+03_r8,5.8778e+02_r8,7.6666e+00_r8/) + kbo(:, 3,54,15) = (/ & + &3.4317e+03_r8,2.5738e+03_r8,1.7159e+03_r8,8.5793e+02_r8,1.1744e+01_r8/) + kbo(:, 4,54,15) = (/ & + &4.7173e+03_r8,3.5380e+03_r8,2.3587e+03_r8,1.1793e+03_r8,1.6836e+01_r8/) + kbo(:, 5,54,15) = (/ & + &6.1810e+03_r8,4.6357e+03_r8,3.0905e+03_r8,1.5452e+03_r8,2.2955e+01_r8/) + kbo(:, 1,55,15) = (/ & + &1.3503e+03_r8,1.0127e+03_r8,6.7517e+02_r8,3.3837e+02_r8,3.8496e+00_r8/) + kbo(:, 2,55,15) = (/ & + &2.1922e+03_r8,1.6441e+03_r8,1.0961e+03_r8,5.4853e+02_r8,6.5708e+00_r8/) + kbo(:, 3,55,15) = (/ & + &3.2739e+03_r8,2.4554e+03_r8,1.6370e+03_r8,8.1853e+02_r8,1.0320e+01_r8/) + kbo(:, 4,55,15) = (/ & + &4.5818e+03_r8,3.4364e+03_r8,2.2910e+03_r8,1.1455e+03_r8,1.5094e+01_r8/) + kbo(:, 5,55,15) = (/ & + &6.0888e+03_r8,4.5666e+03_r8,3.0444e+03_r8,1.5222e+03_r8,2.0876e+01_r8/) + kbo(:, 1,56,15) = (/ & + &1.2164e+03_r8,9.1227e+02_r8,6.0818e+02_r8,3.0487e+02_r8,3.1724e+00_r8/) + kbo(:, 2,56,15) = (/ & + &2.0376e+03_r8,1.5282e+03_r8,1.0188e+03_r8,5.0989e+02_r8,5.5890e+00_r8/) + kbo(:, 3,56,15) = (/ & + &3.1175e+03_r8,2.3381e+03_r8,1.5588e+03_r8,7.7947e+02_r8,9.0060e+00_r8/) + kbo(:, 4,56,15) = (/ & + &4.4491e+03_r8,3.3368e+03_r8,2.2246e+03_r8,1.1123e+03_r8,1.3463e+01_r8/) + kbo(:, 5,56,15) = (/ & + &6.0027e+03_r8,4.5020e+03_r8,3.0014e+03_r8,1.5007e+03_r8,1.8912e+01_r8/) + kbo(:, 1,57,15) = (/ & + &1.0889e+03_r8,8.1664e+02_r8,5.4443e+02_r8,2.7298e+02_r8,2.5821e+00_r8/) + kbo(:, 2,57,15) = (/ & + &1.8871e+03_r8,1.4154e+03_r8,9.4357e+02_r8,4.7231e+02_r8,4.7102e+00_r8/) + kbo(:, 3,57,15) = (/ & + &2.9648e+03_r8,2.2236e+03_r8,1.4824e+03_r8,7.4131e+02_r8,7.7911e+00_r8/) + kbo(:, 4,57,15) = (/ & + &4.3194e+03_r8,3.2395e+03_r8,2.1597e+03_r8,1.0798e+03_r8,1.1924e+01_r8/) + kbo(:, 5,57,15) = (/ & + &5.9252e+03_r8,4.4439e+03_r8,2.9626e+03_r8,1.4813e+03_r8,1.7058e+01_r8/) + kbo(:, 1,58,15) = (/ & + &4.7296e+02_r8,4.0724e+02_r8,3.1867e+02_r8,1.9341e+02_r8,2.1052e+00_r8/) + kbo(:, 2,58,15) = (/ & + &8.4958e+02_r8,7.3152e+02_r8,5.7242e+02_r8,3.4682e+02_r8,3.9643e+00_r8/) + kbo(:, 3,58,15) = (/ & + &1.3719e+03_r8,1.1812e+03_r8,9.2434e+02_r8,5.5948e+02_r8,6.7352e+00_r8/) + kbo(:, 4,58,15) = (/ & + &2.0410e+03_r8,1.7574e+03_r8,1.3752e+03_r8,8.3221e+02_r8,1.0550e+01_r8/) + kbo(:, 5,58,15) = (/ & + &2.8472e+03_r8,2.4515e+03_r8,1.9184e+03_r8,1.1609e+03_r8,1.5395e+01_r8/) + kbo(:, 1,59,15) = (/ & + &4.5680e+02_r8,3.9477e+02_r8,3.1046e+02_r8,1.8976e+02_r8,1.9256e+00_r8/) + kbo(:, 2,59,15) = (/ & + &8.3327e+02_r8,7.2012e+02_r8,5.6632e+02_r8,3.4555e+02_r8,3.6779e+00_r8/) + kbo(:, 3,59,15) = (/ & + &1.3611e+03_r8,1.1763e+03_r8,9.2510e+02_r8,5.6393e+02_r8,6.3201e+00_r8/) + kbo(:, 4,59,15) = (/ & + &2.0429e+03_r8,1.7655e+03_r8,1.3884e+03_r8,8.4623e+02_r8,9.9804e+00_r8/) + kbo(:, 5,59,15) = (/ & + &2.8700e+03_r8,2.4803e+03_r8,1.9506e+03_r8,1.1889e+03_r8,1.4739e+01_r8/) + kbo(:, 1,13,16) = (/ & + &4.8122e+02_r8,3.6087e+02_r8,2.4060e+02_r8,1.2030e+02_r8,7.3993e+00_r8/) + kbo(:, 2,13,16) = (/ & + &6.9206e+02_r8,5.1907e+02_r8,3.4603e+02_r8,1.7302e+02_r8,1.5501e+01_r8/) + kbo(:, 3,13,16) = (/ & + &9.4738e+02_r8,7.1056e+02_r8,4.7372e+02_r8,2.3683e+02_r8,2.1040e+01_r8/) + kbo(:, 4,13,16) = (/ & + &1.2406e+03_r8,9.3042e+02_r8,6.2029e+02_r8,3.1014e+02_r8,2.9139e+01_r8/) + kbo(:, 5,13,16) = (/ & + &1.5703e+03_r8,1.1778e+03_r8,7.8522e+02_r8,3.9259e+02_r8,3.9308e+01_r8/) + kbo(:, 1,14,16) = (/ & + &5.7576e+02_r8,4.3182e+02_r8,2.8788e+02_r8,1.4394e+02_r8,1.4009e+01_r8/) + kbo(:, 2,14,16) = (/ & + &8.3244e+02_r8,6.2431e+02_r8,4.1619e+02_r8,2.0809e+02_r8,1.9135e+01_r8/) + kbo(:, 3,14,16) = (/ & + &1.1392e+03_r8,8.5436e+02_r8,5.6956e+02_r8,2.8480e+02_r8,2.5798e+01_r8/) + kbo(:, 4,14,16) = (/ & + &1.4970e+03_r8,1.1226e+03_r8,7.4844e+02_r8,3.7423e+02_r8,3.5612e+01_r8/) + kbo(:, 5,14,16) = (/ & + &1.8999e+03_r8,1.4249e+03_r8,9.4985e+02_r8,4.7498e+02_r8,4.7897e+01_r8/) + kbo(:, 1,15,16) = (/ & + &6.7686e+02_r8,5.0758e+02_r8,3.3845e+02_r8,1.6922e+02_r8,1.7232e+01_r8/) + kbo(:, 2,15,16) = (/ & + &9.7585e+02_r8,7.3193e+02_r8,4.8790e+02_r8,2.4395e+02_r8,2.3521e+01_r8/) + kbo(:, 3,15,16) = (/ & + &1.3377e+03_r8,1.0032e+03_r8,6.6881e+02_r8,3.3441e+02_r8,3.1740e+01_r8/) + kbo(:, 4,15,16) = (/ & + &1.7575e+03_r8,1.3181e+03_r8,8.7876e+02_r8,4.3935e+02_r8,4.3321e+01_r8/) + kbo(:, 5,15,16) = (/ & + &2.2308e+03_r8,1.6730e+03_r8,1.1154e+03_r8,5.5774e+02_r8,5.7999e+01_r8/) + kbo(:, 1,16,16) = (/ & + &7.8637e+02_r8,5.8983e+02_r8,3.9321e+02_r8,1.9661e+02_r8,2.1088e+01_r8/) + kbo(:, 2,16,16) = (/ & + &1.1333e+03_r8,8.4995e+02_r8,5.6666e+02_r8,2.8332e+02_r8,2.8690e+01_r8/) + kbo(:, 3,16,16) = (/ & + &1.5497e+03_r8,1.1623e+03_r8,7.7493e+02_r8,3.8745e+02_r8,3.8949e+01_r8/) + kbo(:, 4,16,16) = (/ & + &2.0330e+03_r8,1.5247e+03_r8,1.0164e+03_r8,5.0821e+02_r8,5.2500e+01_r8/) + kbo(:, 5,16,16) = (/ & + &2.5789e+03_r8,1.9342e+03_r8,1.2895e+03_r8,6.4478e+02_r8,6.9505e+01_r8/) + kbo(:, 1,17,16) = (/ & + &9.1371e+02_r8,6.8529e+02_r8,4.5686e+02_r8,2.2843e+02_r8,2.5518e+01_r8/) + kbo(:, 2,17,16) = (/ & + &1.3116e+03_r8,9.8366e+02_r8,6.5574e+02_r8,3.2788e+02_r8,3.4904e+01_r8/) + kbo(:, 3,17,16) = (/ & + &1.7880e+03_r8,1.3410e+03_r8,8.9396e+02_r8,4.4698e+02_r8,4.7412e+01_r8/) + kbo(:, 4,17,16) = (/ & + &2.3411e+03_r8,1.7558e+03_r8,1.1705e+03_r8,5.8526e+02_r8,6.3218e+01_r8/) + kbo(:, 5,17,16) = (/ & + &2.9603e+03_r8,2.2204e+03_r8,1.4801e+03_r8,7.4006e+02_r8,8.2344e+01_r8/) + kbo(:, 1,18,16) = (/ & + &1.0453e+03_r8,7.8401e+02_r8,5.2267e+02_r8,2.6132e+02_r8,3.0565e+01_r8/) + kbo(:, 2,18,16) = (/ & + &1.4935e+03_r8,1.1202e+03_r8,7.4674e+02_r8,3.7341e+02_r8,4.2204e+01_r8/) + kbo(:, 3,18,16) = (/ & + &2.0309e+03_r8,1.5232e+03_r8,1.0154e+03_r8,5.0502e+02_r8,5.7127e+01_r8/) + kbo(:, 4,18,16) = (/ & + &2.6479e+03_r8,1.9862e+03_r8,1.3241e+03_r8,6.6202e+02_r8,7.5429e+01_r8/) + kbo(:, 5,18,16) = (/ & + &3.3399e+03_r8,2.5049e+03_r8,1.6700e+03_r8,8.3500e+02_r8,9.7021e+01_r8/) + kbo(:, 1,19,16) = (/ & + &1.2157e+03_r8,9.1179e+02_r8,6.0790e+02_r8,3.0394e+02_r8,3.6497e+01_r8/) + kbo(:, 2,19,16) = (/ & + &1.7308e+03_r8,1.2981e+03_r8,8.6539e+02_r8,4.3270e+02_r8,5.0186e+01_r8/) + kbo(:, 3,19,16) = (/ & + &2.3421e+03_r8,1.7565e+03_r8,1.1710e+03_r8,5.8556e+02_r8,6.7960e+01_r8/) + kbo(:, 4,19,16) = (/ & + &3.0436e+03_r8,2.2829e+03_r8,1.5219e+03_r8,7.6093e+02_r8,8.8940e+01_r8/) + kbo(:, 5,19,16) = (/ & + &3.8257e+03_r8,2.8691e+03_r8,1.9129e+03_r8,9.5637e+02_r8,1.1320e+02_r8/) + kbo(:, 1,20,16) = (/ & + &1.4499e+03_r8,1.0875e+03_r8,7.2502e+02_r8,3.6250e+02_r8,4.3451e+01_r8/) + kbo(:, 2,20,16) = (/ & + &2.0494e+03_r8,1.5371e+03_r8,1.0247e+03_r8,5.1236e+02_r8,5.9923e+01_r8/) + kbo(:, 3,20,16) = (/ & + &2.7595e+03_r8,2.0695e+03_r8,1.3797e+03_r8,6.8984e+02_r8,8.0107e+01_r8/) + kbo(:, 4,20,16) = (/ & + &3.5702e+03_r8,2.6775e+03_r8,1.7850e+03_r8,8.9253e+02_r8,1.0388e+02_r8/) + kbo(:, 5,20,16) = (/ & + &4.4675e+03_r8,3.3505e+03_r8,2.2337e+03_r8,1.1168e+03_r8,1.3102e+02_r8/) + kbo(:, 1,21,16) = (/ & + &1.7354e+03_r8,1.3015e+03_r8,8.6762e+02_r8,4.3383e+02_r8,5.1121e+01_r8/) + kbo(:, 2,21,16) = (/ & + &2.4333e+03_r8,1.8248e+03_r8,1.2166e+03_r8,6.0831e+02_r8,7.0122e+01_r8/) + kbo(:, 3,21,16) = (/ & + &3.2566e+03_r8,2.4426e+03_r8,1.6283e+03_r8,8.1420e+02_r8,9.3037e+01_r8/) + kbo(:, 4,21,16) = (/ & + &4.1875e+03_r8,3.1404e+03_r8,2.0937e+03_r8,1.0468e+03_r8,1.1968e+02_r8/) + kbo(:, 5,21,16) = (/ & + &5.2269e+03_r8,3.9201e+03_r8,2.6133e+03_r8,1.3066e+03_r8,1.4963e+02_r8/) + kbo(:, 1,22,16) = (/ & + &2.1136e+03_r8,1.5853e+03_r8,1.0569e+03_r8,5.2844e+02_r8,6.0581e+01_r8/) + kbo(:, 2,22,16) = (/ & + &2.9316e+03_r8,2.1987e+03_r8,1.4659e+03_r8,7.3292e+02_r8,8.2385e+01_r8/) + kbo(:, 3,22,16) = (/ & + &3.8802e+03_r8,2.9101e+03_r8,1.9401e+03_r8,9.7007e+02_r8,1.0823e+02_r8/) + kbo(:, 4,22,16) = (/ & + &4.9544e+03_r8,3.7156e+03_r8,2.4770e+03_r8,1.2386e+03_r8,1.3781e+02_r8/) + kbo(:, 5,22,16) = (/ & + &6.1512e+03_r8,4.6135e+03_r8,3.0579e+03_r8,1.5378e+03_r8,1.7127e+02_r8/) + kbo(:, 1,23,16) = (/ & + &2.5612e+03_r8,1.9208e+03_r8,1.2805e+03_r8,6.4031e+02_r8,7.0795e+01_r8/) + kbo(:, 2,23,16) = (/ & + &3.5078e+03_r8,2.6308e+03_r8,1.7538e+03_r8,8.7684e+02_r8,9.5347e+01_r8/) + kbo(:, 3,23,16) = (/ & + &4.5972e+03_r8,3.4475e+03_r8,2.2984e+03_r8,1.1493e+03_r8,1.2411e+02_r8/) + kbo(:, 4,23,16) = (/ & + &5.8246e+03_r8,4.3680e+03_r8,2.9119e+03_r8,1.4559e+03_r8,1.5734e+02_r8/) + kbo(:, 5,23,16) = (/ & + &7.1749e+03_r8,5.3812e+03_r8,3.5874e+03_r8,1.7937e+03_r8,1.9485e+02_r8/) + kbo(:, 1,24,16) = (/ & + &3.1040e+03_r8,2.3279e+03_r8,1.5520e+03_r8,7.7603e+02_r8,8.1731e+01_r8/) + kbo(:, 2,24,16) = (/ & + &4.2015e+03_r8,3.1511e+03_r8,2.1007e+03_r8,1.0503e+03_r8,1.0915e+02_r8/) + kbo(:, 3,24,16) = (/ & + &5.4526e+03_r8,4.0896e+03_r8,2.7263e+03_r8,1.3632e+03_r8,1.4142e+02_r8/) + kbo(:, 4,24,16) = (/ & + &6.8486e+03_r8,5.1365e+03_r8,3.4243e+03_r8,1.7120e+03_r8,1.7856e+02_r8/) + kbo(:, 5,24,16) = (/ & + &8.3592e+03_r8,6.2694e+03_r8,4.1793e+03_r8,2.0896e+03_r8,2.2042e+02_r8/) + kbo(:, 1,25,16) = (/ & + &3.7353e+03_r8,2.8011e+03_r8,1.8675e+03_r8,9.3379e+02_r8,9.3752e+01_r8/) + kbo(:, 2,25,16) = (/ & + &4.9915e+03_r8,3.7438e+03_r8,2.4959e+03_r8,1.2479e+03_r8,1.2447e+02_r8/) + kbo(:, 3,25,16) = (/ & + &6.4159e+03_r8,4.8120e+03_r8,3.2081e+03_r8,1.6040e+03_r8,1.6041e+02_r8/) + kbo(:, 4,25,16) = (/ & + &7.9803e+03_r8,5.9849e+03_r8,3.9899e+03_r8,1.9951e+03_r8,2.0157e+02_r8/) + kbo(:, 5,25,16) = (/ & + &9.6532e+03_r8,7.2408e+03_r8,4.8272e+03_r8,2.4135e+03_r8,2.4756e+02_r8/) + kbo(:, 1,26,16) = (/ & + &4.4736e+03_r8,3.3551e+03_r8,2.2367e+03_r8,1.1183e+03_r8,1.0731e+02_r8/) + kbo(:, 2,26,16) = (/ & + &5.9023e+03_r8,4.4264e+03_r8,2.9511e+03_r8,1.4756e+03_r8,1.4156e+02_r8/) + kbo(:, 3,26,16) = (/ & + &7.5046e+03_r8,5.6279e+03_r8,3.7521e+03_r8,1.8761e+03_r8,1.8123e+02_r8/) + kbo(:, 4,26,16) = (/ & + &9.2412e+03_r8,6.9304e+03_r8,4.6207e+03_r8,2.3102e+03_r8,2.2639e+02_r8/) + kbo(:, 5,26,16) = (/ & + &1.1070e+04_r8,8.3029e+03_r8,5.5351e+03_r8,2.7676e+03_r8,2.7645e+02_r8/) + kbo(:, 1,27,16) = (/ & + &5.2658e+03_r8,3.9745e+03_r8,2.6497e+03_r8,1.3248e+03_r8,1.2199e+02_r8/) + kbo(:, 2,27,16) = (/ & + &6.9046e+03_r8,5.1781e+03_r8,3.4305e+03_r8,1.7261e+03_r8,1.5967e+02_r8/) + kbo(:, 3,27,16) = (/ & + &8.6809e+03_r8,6.5105e+03_r8,4.3403e+03_r8,2.1700e+03_r8,2.0317e+02_r8/) + kbo(:, 4,27,16) = (/ & + &1.0514e+04_r8,7.9337e+03_r8,5.2893e+03_r8,2.6448e+03_r8,2.5202e+02_r8/) + kbo(:, 5,27,16) = (/ & + &1.2548e+04_r8,9.4115e+03_r8,6.2746e+03_r8,3.1373e+03_r8,3.0568e+02_r8/) + kbo(:, 1,28,16) = (/ & + &6.2040e+03_r8,4.6529e+03_r8,3.1020e+03_r8,1.5511e+03_r8,1.3749e+02_r8/) + kbo(:, 2,28,16) = (/ & + &7.9799e+03_r8,5.9854e+03_r8,3.9901e+03_r8,1.9952e+03_r8,1.7869e+02_r8/) + kbo(:, 3,28,16) = (/ & + &9.9157e+03_r8,7.4385e+03_r8,4.9578e+03_r8,2.4793e+03_r8,2.2573e+02_r8/) + kbo(:, 4,28,16) = (/ & + &1.1961e+04_r8,8.9706e+03_r8,5.9799e+03_r8,2.9900e+03_r8,2.7806e+02_r8/) + kbo(:, 5,28,16) = (/ & + &1.4060e+04_r8,1.0545e+04_r8,7.0300e+03_r8,3.5151e+03_r8,3.3499e+02_r8/) + kbo(:, 1,29,16) = (/ & + &7.1341e+03_r8,5.3506e+03_r8,3.5671e+03_r8,1.7835e+03_r8,1.5398e+02_r8/) + kbo(:, 2,29,16) = (/ & + &9.0577e+03_r8,6.7935e+03_r8,4.5290e+03_r8,2.2643e+03_r8,1.9863e+02_r8/) + kbo(:, 3,29,16) = (/ & + &1.1122e+04_r8,8.3426e+03_r8,5.5615e+03_r8,2.7806e+03_r8,2.4903e+02_r8/) + kbo(:, 4,29,16) = (/ & + &1.3280e+04_r8,9.9609e+03_r8,6.6400e+03_r8,3.3199e+03_r8,3.0450e+02_r8/) + kbo(:, 5,29,16) = (/ & + &1.5478e+04_r8,1.1609e+04_r8,7.7394e+03_r8,3.8697e+03_r8,3.6431e+02_r8/) + kbo(:, 1,30,16) = (/ & + &8.0566e+03_r8,6.0423e+03_r8,4.0284e+03_r8,2.0142e+03_r8,1.7115e+02_r8/) + kbo(:, 2,30,16) = (/ & + &1.0101e+04_r8,7.5759e+03_r8,5.0505e+03_r8,2.5252e+03_r8,2.1901e+02_r8/) + kbo(:, 3,30,16) = (/ & + &1.2267e+04_r8,9.1995e+03_r8,6.1334e+03_r8,3.0668e+03_r8,2.7243e+02_r8/) + kbo(:, 4,30,16) = (/ & + &1.4511e+04_r8,1.0883e+04_r8,7.2556e+03_r8,3.6279e+03_r8,3.3082e+02_r8/) + kbo(:, 5,30,16) = (/ & + &1.6772e+04_r8,1.2579e+04_r8,8.3858e+03_r8,4.1931e+03_r8,3.9317e+02_r8/) + kbo(:, 1,31,16) = (/ & + &8.8982e+03_r8,6.6739e+03_r8,4.4493e+03_r8,2.2245e+03_r8,1.8901e+02_r8/) + kbo(:, 2,31,16) = (/ & + &1.1025e+04_r8,8.2681e+03_r8,5.5122e+03_r8,2.7560e+03_r8,2.3984e+02_r8/) + kbo(:, 3,31,16) = (/ & + &1.3250e+04_r8,9.9387e+03_r8,6.6258e+03_r8,3.3127e+03_r8,2.9609e+02_r8/) + kbo(:, 4,31,16) = (/ & + &1.5535e+04_r8,1.1652e+04_r8,7.7678e+03_r8,3.8841e+03_r8,3.5699e+02_r8/) + kbo(:, 5,31,16) = (/ & + &1.7813e+04_r8,1.3361e+04_r8,8.9075e+03_r8,4.4535e+03_r8,4.2172e+02_r8/) + kbo(:, 1,32,16) = (/ & + &9.7468e+03_r8,7.3100e+03_r8,4.8729e+03_r8,2.4366e+03_r8,2.0736e+02_r8/) + kbo(:, 2,32,16) = (/ & + &1.1942e+04_r8,8.9562e+03_r8,5.9708e+03_r8,2.9855e+03_r8,2.6092e+02_r8/) + kbo(:, 3,32,16) = (/ & + &1.4217e+04_r8,1.0663e+04_r8,7.1086e+03_r8,3.5542e+03_r8,3.1978e+02_r8/) + kbo(:, 4,32,16) = (/ & + &1.6526e+04_r8,1.2394e+04_r8,8.2625e+03_r8,4.1313e+03_r8,3.8300e+02_r8/) + kbo(:, 5,32,16) = (/ & + &1.8815e+04_r8,1.4111e+04_r8,9.4077e+03_r8,4.7034e+03_r8,4.4968e+02_r8/) + kbo(:, 1,33,16) = (/ & + &1.0585e+04_r8,7.8868e+03_r8,5.2924e+03_r8,2.6461e+03_r8,2.2603e+02_r8/) + kbo(:, 2,33,16) = (/ & + &1.2835e+04_r8,9.6280e+03_r8,6.4182e+03_r8,3.2091e+03_r8,2.8215e+02_r8/) + kbo(:, 3,33,16) = (/ & + &1.5147e+04_r8,1.1359e+04_r8,7.5723e+03_r8,3.7863e+03_r8,3.3983e+02_r8/) + kbo(:, 4,33,16) = (/ & + &1.7461e+04_r8,1.3096e+04_r8,8.7313e+03_r8,4.3654e+03_r8,4.0847e+02_r8/) + kbo(:, 5,33,16) = (/ & + &1.9631e+04_r8,1.4815e+04_r8,9.8770e+03_r8,4.9389e+03_r8,4.7201e+02_r8/) + kbo(:, 1,34,16) = (/ & + &1.1432e+04_r8,8.5737e+03_r8,5.7158e+03_r8,2.8579e+03_r8,2.4293e+02_r8/) + kbo(:, 2,34,16) = (/ & + &1.3656e+04_r8,1.0308e+04_r8,6.8715e+03_r8,3.4360e+03_r8,3.0114e+02_r8/) + kbo(:, 3,34,16) = (/ & + &1.6096e+04_r8,1.2073e+04_r8,8.0473e+03_r8,4.0240e+03_r8,3.6423e+02_r8/) + kbo(:, 4,34,16) = (/ & + &1.8435e+04_r8,1.3744e+04_r8,9.2181e+03_r8,4.6088e+03_r8,4.3111e+02_r8/) + kbo(:, 5,34,16) = (/ & + &2.0743e+04_r8,1.5458e+04_r8,1.0371e+04_r8,5.1857e+03_r8,5.0086e+02_r8/) + kbo(:, 1,35,16) = (/ & + &1.2052e+04_r8,9.0391e+03_r8,6.0261e+03_r8,3.0130e+03_r8,2.5425e+02_r8/) + kbo(:, 2,35,16) = (/ & + &1.4410e+04_r8,1.0808e+04_r8,7.2046e+03_r8,3.6026e+03_r8,3.1392e+02_r8/) + kbo(:, 3,35,16) = (/ & + &1.6796e+04_r8,1.2598e+04_r8,8.3987e+03_r8,4.1994e+03_r8,3.7832e+02_r8/) + kbo(:, 4,35,16) = (/ & + &1.9160e+04_r8,1.4370e+04_r8,9.5799e+03_r8,4.7904e+03_r8,4.4634e+02_r8/) + kbo(:, 5,35,16) = (/ & + &2.1483e+04_r8,1.6114e+04_r8,1.0742e+04_r8,5.3711e+03_r8,5.1708e+02_r8/) + kbo(:, 1,36,16) = (/ & + &1.2411e+04_r8,9.3078e+03_r8,6.2050e+03_r8,3.1026e+03_r8,2.5887e+02_r8/) + kbo(:, 2,36,16) = (/ & + &1.4808e+04_r8,1.1106e+04_r8,7.4043e+03_r8,3.7021e+03_r8,3.1927e+02_r8/) + kbo(:, 3,36,16) = (/ & + &1.7228e+04_r8,1.2921e+04_r8,8.6130e+03_r8,4.3067e+03_r8,3.8442e+02_r8/) + kbo(:, 4,36,16) = (/ & + &1.9618e+04_r8,1.4714e+04_r8,9.8092e+03_r8,4.9047e+03_r8,4.5297e+02_r8/) + kbo(:, 5,36,16) = (/ & + &2.1965e+04_r8,1.6474e+04_r8,1.0982e+04_r8,5.4915e+03_r8,5.1909e+02_r8/) + kbo(:, 1,37,16) = (/ & + &1.2464e+04_r8,9.3487e+03_r8,6.2318e+03_r8,3.1159e+03_r8,2.5416e+02_r8/) + kbo(:, 2,37,16) = (/ & + &1.4910e+04_r8,1.1181e+04_r8,7.4551e+03_r8,3.7272e+03_r8,3.1436e+02_r8/) + kbo(:, 3,37,16) = (/ & + &1.7377e+04_r8,1.3033e+04_r8,8.6893e+03_r8,4.3442e+03_r8,3.7942e+02_r8/) + kbo(:, 4,37,16) = (/ & + &1.9817e+04_r8,1.4862e+04_r8,9.9088e+03_r8,4.9531e+03_r8,4.4815e+02_r8/) + kbo(:, 5,37,16) = (/ & + &2.2212e+04_r8,1.6660e+04_r8,1.1107e+04_r8,5.5531e+03_r8,5.1970e+02_r8/) + kbo(:, 1,38,16) = (/ & + &1.2455e+04_r8,9.3421e+03_r8,6.2277e+03_r8,3.1139e+03_r8,2.4843e+02_r8/) + kbo(:, 2,38,16) = (/ & + &1.4944e+04_r8,1.1208e+04_r8,7.4715e+03_r8,3.7356e+03_r8,3.0837e+02_r8/) + kbo(:, 3,38,16) = (/ & + &1.7458e+04_r8,1.3093e+04_r8,8.7289e+03_r8,4.3646e+03_r8,3.7326e+02_r8/) + kbo(:, 4,38,16) = (/ & + &1.9945e+04_r8,1.4959e+04_r8,9.9720e+03_r8,4.9866e+03_r8,4.4198e+02_r8/) + kbo(:, 5,38,16) = (/ & + &2.2391e+04_r8,1.6792e+04_r8,1.1195e+04_r8,5.5974e+03_r8,5.1349e+02_r8/) + kbo(:, 1,39,16) = (/ & + &1.2406e+04_r8,9.3076e+03_r8,6.2035e+03_r8,3.1024e+03_r8,2.4239e+02_r8/) + kbo(:, 2,39,16) = (/ & + &1.4934e+04_r8,1.1200e+04_r8,7.4672e+03_r8,3.7337e+03_r8,3.0193e+02_r8/) + kbo(:, 3,39,16) = (/ & + &1.7492e+04_r8,1.3118e+04_r8,8.7456e+03_r8,4.3725e+03_r8,3.6650e+02_r8/) + kbo(:, 4,39,16) = (/ & + &2.0028e+04_r8,1.5022e+04_r8,1.0013e+04_r8,5.0072e+03_r8,4.3512e+02_r8/) + kbo(:, 5,39,16) = (/ & + &2.2512e+04_r8,1.6885e+04_r8,1.1257e+04_r8,5.6280e+03_r8,5.0671e+02_r8/) + kbo(:, 1,40,16) = (/ & + &1.2191e+04_r8,9.1428e+03_r8,6.0955e+03_r8,3.0476e+03_r8,2.3031e+02_r8/) + kbo(:, 2,40,16) = (/ & + &1.4768e+04_r8,1.1076e+04_r8,7.3840e+03_r8,3.6920e+03_r8,2.8879e+02_r8/) + kbo(:, 3,40,16) = (/ & + &1.7391e+04_r8,1.3044e+04_r8,8.6959e+03_r8,4.3483e+03_r8,3.5253e+02_r8/) + kbo(:, 4,40,16) = (/ & + &2.0001e+04_r8,1.5001e+04_r8,1.0001e+04_r8,5.0007e+03_r8,4.2055e+02_r8/) + kbo(:, 5,40,16) = (/ & + &2.2559e+04_r8,1.6919e+04_r8,1.1281e+04_r8,5.6404e+03_r8,4.9160e+02_r8/) + kbo(:, 1,41,16) = (/ & + &1.1918e+04_r8,8.9381e+03_r8,5.9590e+03_r8,2.9794e+03_r8,2.1766e+02_r8/) + kbo(:, 2,41,16) = (/ & + &1.4546e+04_r8,1.0910e+04_r8,7.2239e+03_r8,3.6364e+03_r8,2.7473e+02_r8/) + kbo(:, 3,41,16) = (/ & + &1.7237e+04_r8,1.2927e+04_r8,8.6187e+03_r8,4.3092e+03_r8,3.3421e+02_r8/) + kbo(:, 4,41,16) = (/ & + &1.9925e+04_r8,1.4942e+04_r8,9.9613e+03_r8,4.9808e+03_r8,4.0468e+02_r8/) + kbo(:, 5,41,16) = (/ & + &2.2566e+04_r8,1.6925e+04_r8,1.1282e+04_r8,5.6408e+03_r8,4.7546e+02_r8/) + kbo(:, 1,42,16) = (/ & + &1.1611e+04_r8,8.7088e+03_r8,5.8053e+03_r8,2.9027e+03_r8,2.0505e+02_r8/) + kbo(:, 2,42,16) = (/ & + &1.4284e+04_r8,1.0639e+04_r8,7.1417e+03_r8,3.5709e+03_r8,2.6066e+02_r8/) + kbo(:, 3,42,16) = (/ & + &1.7038e+04_r8,1.2778e+04_r8,8.5196e+03_r8,4.2591e+03_r8,3.2228e+02_r8/) + kbo(:, 4,42,16) = (/ & + &1.9799e+04_r8,1.4850e+04_r8,9.8997e+03_r8,4.9502e+03_r8,3.8865e+02_r8/) + kbo(:, 5,42,16) = (/ & + &2.2525e+04_r8,1.6894e+04_r8,1.1262e+04_r8,5.6311e+03_r8,4.5874e+02_r8/) + kbo(:, 1,43,16) = (/ & + &1.1239e+04_r8,8.4296e+03_r8,5.6199e+03_r8,2.8098e+03_r8,1.8981e+02_r8/) + kbo(:, 2,43,16) = (/ & + &1.3966e+04_r8,1.0473e+04_r8,6.9839e+03_r8,3.4914e+03_r8,2.4348e+02_r8/) + kbo(:, 3,43,16) = (/ & + &1.6803e+04_r8,1.2602e+04_r8,8.4011e+03_r8,4.2005e+03_r8,3.0350e+02_r8/) + kbo(:, 4,43,16) = (/ & + &1.9668e+04_r8,1.4751e+04_r8,9.8339e+03_r8,4.9166e+03_r8,3.6865e+02_r8/) + kbo(:, 5,43,16) = (/ & + &2.2506e+04_r8,1.6879e+04_r8,1.1254e+04_r8,5.6261e+03_r8,4.3789e+02_r8/) + kbo(:, 1,44,16) = (/ & + &1.0825e+04_r8,8.1186e+03_r8,5.4125e+03_r8,2.7064e+03_r8,1.7391e+02_r8/) + kbo(:, 2,44,16) = (/ & + &1.3603e+04_r8,1.0202e+04_r8,6.8014e+03_r8,3.4006e+03_r8,2.2526e+02_r8/) + kbo(:, 3,44,16) = (/ & + &1.6530e+04_r8,1.2398e+04_r8,8.2649e+03_r8,4.1327e+03_r8,2.8337e+02_r8/) + kbo(:, 4,44,16) = (/ & + &1.9511e+04_r8,1.4634e+04_r8,9.7557e+03_r8,4.8778e+03_r8,3.4703e+02_r8/) + kbo(:, 5,44,16) = (/ & + &2.2482e+04_r8,1.6861e+04_r8,1.1241e+04_r8,5.6203e+03_r8,4.1512e+02_r8/) + kbo(:, 1,45,16) = (/ & + &1.0398e+04_r8,7.7989e+03_r8,5.1994e+03_r8,2.5997e+03_r8,1.5876e+02_r8/) + kbo(:, 2,45,16) = (/ & + &1.3207e+04_r8,9.9052e+03_r8,6.6032e+03_r8,3.3018e+03_r8,2.0761e+02_r8/) + kbo(:, 3,45,16) = (/ & + &1.6220e+04_r8,1.2165e+04_r8,8.1095e+03_r8,4.0543e+03_r8,2.6368e+02_r8/) + kbo(:, 4,45,16) = (/ & + &1.9318e+04_r8,1.4390e+04_r8,9.6588e+03_r8,4.8297e+03_r8,3.2574e+02_r8/) + kbo(:, 5,45,16) = (/ & + &2.2424e+04_r8,1.6818e+04_r8,1.1212e+04_r8,5.6061e+03_r8,3.9259e+02_r8/) + kbo(:, 1,46,16) = (/ & + &9.9189e+03_r8,7.4400e+03_r8,4.9600e+03_r8,2.4797e+03_r8,1.4342e+02_r8/) + kbo(:, 2,46,16) = (/ & + &1.2731e+04_r8,9.5482e+03_r8,6.3653e+03_r8,3.1826e+03_r8,1.8954e+02_r8/) + kbo(:, 3,46,16) = (/ & + &1.5820e+04_r8,1.1865e+04_r8,7.9099e+03_r8,3.9548e+03_r8,2.4324e+02_r8/) + kbo(:, 4,46,16) = (/ & + &1.9036e+04_r8,1.4277e+04_r8,9.5173e+03_r8,4.7590e+03_r8,3.0340e+02_r8/) + kbo(:, 5,46,16) = (/ & + &2.2283e+04_r8,1.6712e+04_r8,1.1068e+04_r8,5.5708e+03_r8,3.6873e+02_r8/) + kbo(:, 1,47,16) = (/ & + &9.3465e+03_r8,7.0098e+03_r8,4.6733e+03_r8,2.3366e+03_r8,1.2741e+02_r8/) + kbo(:, 2,47,16) = (/ & + &1.2131e+04_r8,9.0979e+03_r8,6.0653e+03_r8,3.0325e+03_r8,1.7033e+02_r8/) + kbo(:, 3,47,16) = (/ & + &1.5279e+04_r8,1.1459e+04_r8,7.6395e+03_r8,3.8199e+03_r8,2.2121e+02_r8/) + kbo(:, 4,47,16) = (/ & + &1.8609e+04_r8,1.3956e+04_r8,9.3042e+03_r8,4.6522e+03_r8,2.7888e+02_r8/) + kbo(:, 5,47,16) = (/ & + &2.2011e+04_r8,1.6508e+04_r8,1.1006e+04_r8,5.5025e+03_r8,3.4244e+02_r8/) + kbo(:, 1,48,16) = (/ & + &8.7925e+03_r8,6.5945e+03_r8,4.3966e+03_r8,2.1981e+03_r8,1.1262e+02_r8/) + kbo(:, 2,48,16) = (/ & + &1.1529e+04_r8,8.6468e+03_r8,5.7644e+03_r8,2.8824e+03_r8,1.5232e+02_r8/) + kbo(:, 3,48,16) = (/ & + &1.4702e+04_r8,1.1027e+04_r8,7.3513e+03_r8,3.6755e+03_r8,2.0009e+02_r8/) + kbo(:, 4,48,16) = (/ & + &1.8139e+04_r8,1.3604e+04_r8,9.0700e+03_r8,4.5350e+03_r8,2.5528e+02_r8/) + kbo(:, 5,48,16) = (/ & + &2.1696e+04_r8,1.6272e+04_r8,1.0846e+04_r8,5.4236e+03_r8,3.1666e+02_r8/) + kbo(:, 1,49,16) = (/ & + &8.2532e+03_r8,6.1899e+03_r8,4.1262e+03_r8,2.0633e+03_r8,9.9158e+01_r8/) + kbo(:, 2,49,16) = (/ & + &1.0925e+04_r8,8.1939e+03_r8,5.4625e+03_r8,2.7312e+03_r8,1.3556e+02_r8/) + kbo(:, 3,49,16) = (/ & + &1.4098e+04_r8,1.0574e+04_r8,7.0499e+03_r8,3.5250e+03_r8,1.8015e+02_r8/) + kbo(:, 4,49,16) = (/ & + &1.7628e+04_r8,1.3221e+04_r8,8.8139e+03_r8,4.4071e+03_r8,2.3258e+02_r8/) + kbo(:, 5,49,16) = (/ & + &2.1334e+04_r8,1.6000e+04_r8,1.0668e+04_r8,5.3338e+03_r8,2.8877e+02_r8/) + kbo(:, 1,50,16) = (/ & + &7.7886e+03_r8,5.8414e+03_r8,3.8943e+03_r8,1.9471e+03_r8,8.7562e+01_r8/) + kbo(:, 2,50,16) = (/ & + &1.0399e+04_r8,7.7996e+03_r8,5.1995e+03_r8,2.6000e+03_r8,1.2099e+02_r8/) + kbo(:, 3,50,16) = (/ & + &1.3554e+04_r8,1.0165e+04_r8,6.7769e+03_r8,3.3882e+03_r8,1.6257e+02_r8/) + kbo(:, 4,50,16) = (/ & + &1.7158e+04_r8,1.2869e+04_r8,8.5791e+03_r8,4.2889e+03_r8,2.1215e+02_r8/) + kbo(:, 5,50,16) = (/ & + &2.1011e+04_r8,1.5758e+04_r8,1.0505e+04_r8,5.2531e+03_r8,2.6885e+02_r8/) + kbo(:, 1,51,16) = (/ & + &7.3653e+03_r8,5.5240e+03_r8,3.6827e+03_r8,1.8412e+03_r8,7.7231e+01_r8/) + kbo(:, 2,51,16) = (/ & + &9.9189e+03_r8,7.4392e+03_r8,4.9594e+03_r8,2.4660e+03_r8,1.0798e+02_r8/) + kbo(:, 3,51,16) = (/ & + &1.3047e+04_r8,9.7852e+03_r8,6.5235e+03_r8,3.2615e+03_r8,1.4656e+02_r8/) + kbo(:, 4,51,16) = (/ & + &1.6702e+04_r8,1.2527e+04_r8,8.3510e+03_r8,4.1752e+03_r8,1.9328e+02_r8/) + kbo(:, 5,51,16) = (/ & + &2.0693e+04_r8,1.5520e+04_r8,1.0347e+04_r8,5.1734e+03_r8,2.4760e+02_r8/) + kbo(:, 1,52,16) = (/ & + &6.9562e+03_r8,5.2172e+03_r8,3.4778e+03_r8,1.7389e+03_r8,6.7762e+01_r8/) + kbo(:, 2,52,16) = (/ & + &9.4563e+03_r8,7.0922e+03_r8,4.7284e+03_r8,2.3642e+03_r8,9.6034e+01_r8/) + kbo(:, 3,52,16) = (/ & + &1.2544e+04_r8,9.4081e+03_r8,6.2721e+03_r8,3.1358e+03_r8,1.3163e+02_r8/) + kbo(:, 4,52,16) = (/ & + &1.6228e+04_r8,1.2171e+04_r8,8.1139e+03_r8,4.0563e+03_r8,1.7544e+02_r8/) + kbo(:, 5,52,16) = (/ & + &2.0214e+04_r8,1.5266e+04_r8,1.0177e+04_r8,5.0897e+03_r8,2.2714e+02_r8/) + kbo(:, 1,53,16) = (/ & + &6.5707e+03_r8,4.8896e+03_r8,3.2854e+03_r8,1.6428e+03_r8,5.9086e+01_r8/) + kbo(:, 2,53,16) = (/ & + &9.0178e+03_r8,6.7633e+03_r8,4.5088e+03_r8,2.2544e+03_r8,8.4973e+01_r8/) + kbo(:, 3,53,16) = (/ & + &1.2063e+04_r8,9.0476e+03_r8,6.0317e+03_r8,3.0159e+03_r8,1.1770e+02_r8/) + kbo(:, 4,53,16) = (/ & + &1.5755e+04_r8,1.1816e+04_r8,7.8772e+03_r8,3.9386e+03_r8,1.5858e+02_r8/) + kbo(:, 5,53,16) = (/ & + &1.9999e+04_r8,1.4999e+04_r8,9.9995e+03_r8,5.0000e+03_r8,2.0751e+02_r8/) + kbo(:, 1,54,16) = (/ & + &6.2721e+03_r8,4.7041e+03_r8,3.1362e+03_r8,1.5681e+03_r8,5.1875e+01_r8/) + kbo(:, 2,54,16) = (/ & + &8.6741e+03_r8,6.5056e+03_r8,4.3370e+03_r8,2.1682e+03_r8,7.5628e+01_r8/) + kbo(:, 3,54,16) = (/ & + &1.1700e+04_r8,8.7748e+03_r8,5.8499e+03_r8,2.9249e+03_r8,1.0596e+02_r8/) + kbo(:, 4,54,16) = (/ & + &1.5404e+04_r8,1.1553e+04_r8,7.7020e+03_r8,3.8510e+03_r8,1.4404e+02_r8/) + kbo(:, 5,54,16) = (/ & + &1.9752e+04_r8,1.4814e+04_r8,9.8758e+03_r8,4.9379e+03_r8,1.9030e+02_r8/) + kbo(:, 1,55,16) = (/ & + &6.0231e+03_r8,4.5173e+03_r8,3.0116e+03_r8,1.5058e+03_r8,4.5583e+01_r8/) + kbo(:, 2,55,16) = (/ & + &8.3823e+03_r8,6.2868e+03_r8,4.1912e+03_r8,2.0956e+03_r8,6.7362e+01_r8/) + kbo(:, 3,55,16) = (/ & + &1.1398e+04_r8,8.5488e+03_r8,5.6992e+03_r8,2.8496e+03_r8,9.5542e+01_r8/) + kbo(:, 4,55,16) = (/ & + &1.5124e+04_r8,1.1343e+04_r8,7.5617e+03_r8,3.7808e+03_r8,1.3099e+02_r8/) + kbo(:, 5,55,16) = (/ & + &1.9568e+04_r8,1.4676e+04_r8,9.7841e+03_r8,4.8920e+03_r8,1.7464e+02_r8/) + kbo(:, 1,56,16) = (/ & + &5.7989e+03_r8,4.3492e+03_r8,2.8995e+03_r8,1.4497e+03_r8,3.9828e+01_r8/) + kbo(:, 2,56,16) = (/ & + &8.1232e+03_r8,6.0924e+03_r8,4.0616e+03_r8,2.0308e+03_r8,5.9729e+01_r8/) + kbo(:, 3,56,16) = (/ & + &1.1139e+04_r8,8.3546e+03_r8,5.5697e+03_r8,2.7849e+03_r8,8.5801e+01_r8/) + kbo(:, 4,56,16) = (/ & + &1.4890e+04_r8,1.1167e+04_r8,7.4448e+03_r8,3.7224e+03_r8,1.1874e+02_r8/) + kbo(:, 5,56,16) = (/ & + &1.9429e+04_r8,1.4572e+04_r8,9.7148e+03_r8,4.8574e+03_r8,1.5988e+02_r8/) + kbo(:, 1,57,16) = (/ & + &5.6021e+03_r8,4.2016e+03_r8,2.8010e+03_r8,1.4005e+03_r8,3.4593e+01_r8/) + kbo(:, 2,57,16) = (/ & + &7.9032e+03_r8,5.9274e+03_r8,3.9516e+03_r8,1.9758e+03_r8,5.2766e+01_r8/) + kbo(:, 3,57,16) = (/ & + &1.0919e+04_r8,8.1889e+03_r8,5.4593e+03_r8,2.7295e+03_r8,7.6784e+01_r8/) + kbo(:, 4,57,16) = (/ & + &1.4709e+04_r8,1.1031e+04_r8,7.3542e+03_r8,3.6771e+03_r8,1.0741e+02_r8/) + kbo(:, 5,57,16) = (/ & + &1.9344e+04_r8,1.4508e+04_r8,9.6719e+03_r8,4.8359e+03_r8,1.4582e+02_r8/) + kbo(:, 1,58,16) = (/ & + &2.6461e+03_r8,2.2784e+03_r8,1.7829e+03_r8,1.0638e+03_r8,3.0084e+01_r8/) + kbo(:, 2,58,16) = (/ & + &3.7547e+03_r8,3.2329e+03_r8,2.5298e+03_r8,1.5309e+03_r8,4.6706e+01_r8/) + kbo(:, 3,58,16) = (/ & + &5.2182e+03_r8,4.4930e+03_r8,3.5159e+03_r8,2.1276e+03_r8,6.8855e+01_r8/) + kbo(:, 4,58,16) = (/ & + &7.0852e+03_r8,6.1006e+03_r8,4.7738e+03_r8,2.8889e+03_r8,9.7411e+01_r8/) + kbo(:, 5,58,16) = (/ & + &9.3867e+03_r8,8.0822e+03_r8,6.3244e+03_r8,3.8273e+03_r8,1.3335e+02_r8/) + kbo(:, 1,59,16) = (/ & + &2.6519e+03_r8,2.2918e+03_r8,1.8023e+03_r8,1.0985e+03_r8,2.8399e+01_r8/) + kbo(:, 2,59,16) = (/ & + &3.7709e+03_r8,3.2589e+03_r8,2.5629e+03_r8,1.5620e+03_r8,4.4429e+01_r8/) + kbo(:, 3,59,16) = (/ & + &5.2534e+03_r8,4.5401e+03_r8,3.5704e+03_r8,2.1761e+03_r8,6.5844e+01_r8/) + kbo(:, 4,59,16) = (/ & + &7.1555e+03_r8,6.1839e+03_r8,4.8632e+03_r8,2.9640e+03_r8,9.3608e+01_r8/) + kbo(:, 5,59,16) = (/ & + &9.5069e+03_r8,8.2160e+03_r8,6.4613e+03_r8,3.9381e+03_r8,1.2854e+02_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mn2o( 1, :, 1) = (/ & + & 1.28178e-05_r8, 1.55472e-05_r8, 1.88578e-05_r8, 2.28735e-05_r8, 2.77442e-05_r8, & + & 3.36520e-05_r8, 4.08179e-05_r8, 4.95098e-05_r8, 6.00525e-05_r8, 7.28401e-05_r8, & + & 8.83508e-05_r8, 1.07164e-04_r8, 1.29984e-04_r8, 1.57663e-04_r8, 1.91236e-04_r8, & + & 2.31958e-04_r8, 2.81352e-04_r8, 3.41263e-04_r8, 4.13932e-04_r8/) + kao_mn2o( 2, :, 1) = (/ & + & 1.00725e-01_r8, 1.04470e-01_r8, 1.08355e-01_r8, 1.12384e-01_r8, 1.16563e-01_r8, & + & 1.20898e-01_r8, 1.25394e-01_r8, 1.30057e-01_r8, 1.34893e-01_r8, 1.39909e-01_r8, & + & 1.45112e-01_r8, 1.50508e-01_r8, 1.56104e-01_r8, 1.61909e-01_r8, 1.67930e-01_r8, & + & 1.74175e-01_r8, 1.80652e-01_r8, 1.87369e-01_r8, 1.94337e-01_r8/) + kao_mn2o( 3, :, 1) = (/ & + & 1.94143e-01_r8, 1.97380e-01_r8, 2.00670e-01_r8, 2.04016e-01_r8, 2.07417e-01_r8, & + & 2.10875e-01_r8, 2.14390e-01_r8, 2.17964e-01_r8, 2.21598e-01_r8, 2.25292e-01_r8, & + & 2.29048e-01_r8, 2.32867e-01_r8, 2.36749e-01_r8, 2.40696e-01_r8, 2.44708e-01_r8, & + & 2.48788e-01_r8, 2.52936e-01_r8, 2.57152e-01_r8, 2.61439e-01_r8/) + kao_mn2o( 4, :, 1) = (/ & + & 2.98127e-01_r8, 3.00016e-01_r8, 3.01916e-01_r8, 3.03829e-01_r8, 3.05754e-01_r8, & + & 3.07691e-01_r8, 3.09640e-01_r8, 3.11601e-01_r8, 3.13575e-01_r8, 3.15562e-01_r8, & + & 3.17561e-01_r8, 3.19572e-01_r8, 3.21597e-01_r8, 3.23634e-01_r8, 3.25684e-01_r8, & + & 3.27748e-01_r8, 3.29824e-01_r8, 3.31913e-01_r8, 3.34016e-01_r8/) + kao_mn2o( 5, :, 1) = (/ & + & 4.45029e-01_r8, 4.45243e-01_r8, 4.45458e-01_r8, 4.45673e-01_r8, 4.45889e-01_r8, & + & 4.46104e-01_r8, 4.46319e-01_r8, 4.46535e-01_r8, 4.46750e-01_r8, 4.46966e-01_r8, & + & 4.47182e-01_r8, 4.47398e-01_r8, 4.47614e-01_r8, 4.47830e-01_r8, 4.48046e-01_r8, & + & 4.48262e-01_r8, 4.48479e-01_r8, 4.48695e-01_r8, 4.48912e-01_r8/) + kao_mn2o( 6, :, 1) = (/ & + & 7.15677e-01_r8, 7.14564e-01_r8, 7.13452e-01_r8, 7.12342e-01_r8, 7.11234e-01_r8, & + & 7.10127e-01_r8, 7.09022e-01_r8, 7.07919e-01_r8, 7.06818e-01_r8, 7.05718e-01_r8, & + & 7.04620e-01_r8, 7.03524e-01_r8, 7.02429e-01_r8, 7.01336e-01_r8, 7.00245e-01_r8, & + & 6.99156e-01_r8, 6.98068e-01_r8, 6.96982e-01_r8, 6.95898e-01_r8/) + kao_mn2o( 7, :, 1) = (/ & + & 9.89605e-01_r8, 9.85128e-01_r8, 9.80671e-01_r8, 9.76234e-01_r8, 9.71817e-01_r8, & + & 9.67421e-01_r8, 9.63044e-01_r8, 9.58687e-01_r8, 9.54350e-01_r8, 9.50032e-01_r8, & + & 9.45734e-01_r8, 9.41455e-01_r8, 9.37196e-01_r8, 9.32956e-01_r8, 9.28735e-01_r8, & + & 9.24533e-01_r8, 9.20350e-01_r8, 9.16187e-01_r8, 9.12042e-01_r8/) + kao_mn2o( 8, :, 1) = (/ & + & 1.12229e+00_r8, 1.11502e+00_r8, 1.10779e+00_r8, 1.10061e+00_r8, 1.09348e+00_r8, & + & 1.08639e+00_r8, 1.07935e+00_r8, 1.07235e+00_r8, 1.06540e+00_r8, 1.05850e+00_r8, & + & 1.05164e+00_r8, 1.04482e+00_r8, 1.03805e+00_r8, 1.03132e+00_r8, 1.02464e+00_r8, & + & 1.01799e+00_r8, 1.01140e+00_r8, 1.00484e+00_r8, 9.98328e-01_r8/) + kao_mn2o( 9, :, 1) = (/ & + & 7.20959e-01_r8, 7.22839e-01_r8, 7.24723e-01_r8, 7.26612e-01_r8, 7.28506e-01_r8, & + & 7.30405e-01_r8, 7.32309e-01_r8, 7.34218e-01_r8, 7.36132e-01_r8, 7.38051e-01_r8, & + & 7.39975e-01_r8, 7.41904e-01_r8, 7.43838e-01_r8, 7.45777e-01_r8, 7.47721e-01_r8, & + & 7.49670e-01_r8, 7.51624e-01_r8, 7.53584e-01_r8, 7.55548e-01_r8/) + kao_mn2o( 1, :, 2) = (/ & + & 1.62152e-03_r8, 1.81627e-03_r8, 2.03443e-03_r8, 2.27878e-03_r8, 2.55248e-03_r8, & + & 2.85906e-03_r8, 3.20245e-03_r8, 3.58710e-03_r8, 4.01794e-03_r8, 4.50053e-03_r8, & + & 5.04109e-03_r8, 5.64657e-03_r8, 6.32477e-03_r8, 7.08444e-03_r8, 7.93534e-03_r8, & + & 8.88845e-03_r8, 9.95603e-03_r8, 1.11518e-02_r8, 1.24913e-02_r8/) + kao_mn2o( 2, :, 2) = (/ & + & 3.73716e-01_r8, 3.72491e-01_r8, 3.71271e-01_r8, 3.70054e-01_r8, 3.68841e-01_r8, & + & 3.67633e-01_r8, 3.66428e-01_r8, 3.65227e-01_r8, 3.64031e-01_r8, 3.62838e-01_r8, & + & 3.61649e-01_r8, 3.60464e-01_r8, 3.59283e-01_r8, 3.58106e-01_r8, 3.56932e-01_r8, & + & 3.55763e-01_r8, 3.54597e-01_r8, 3.53435e-01_r8, 3.52277e-01_r8/) + kao_mn2o( 3, :, 2) = (/ & + & 5.46240e-01_r8, 5.42972e-01_r8, 5.39724e-01_r8, 5.36495e-01_r8, 5.33285e-01_r8, & + & 5.30095e-01_r8, 5.26923e-01_r8, 5.23771e-01_r8, 5.20637e-01_r8, 5.17523e-01_r8, & + & 5.14426e-01_r8, 5.11349e-01_r8, 5.08290e-01_r8, 5.05249e-01_r8, 5.02226e-01_r8, & + & 4.99221e-01_r8, 4.96235e-01_r8, 4.93266e-01_r8, 4.90315e-01_r8/) + kao_mn2o( 4, :, 2) = (/ & + & 8.35399e-01_r8, 8.36766e-01_r8, 8.38135e-01_r8, 8.39507e-01_r8, 8.40880e-01_r8, & + & 8.42256e-01_r8, 8.43635e-01_r8, 8.45015e-01_r8, 8.46398e-01_r8, 8.47783e-01_r8, & + & 8.49170e-01_r8, 8.50559e-01_r8, 8.51951e-01_r8, 8.53345e-01_r8, 8.54742e-01_r8, & + & 8.56140e-01_r8, 8.57541e-01_r8, 8.58944e-01_r8, 8.60350e-01_r8/) + kao_mn2o( 5, :, 2) = (/ & + & 1.04433e+00_r8, 1.04864e+00_r8, 1.05297e+00_r8, 1.05731e+00_r8, 1.06168e+00_r8, & + & 1.06606e+00_r8, 1.07046e+00_r8, 1.07488e+00_r8, 1.07932e+00_r8, 1.08377e+00_r8, & + & 1.08824e+00_r8, 1.09274e+00_r8, 1.09725e+00_r8, 1.10178e+00_r8, 1.10632e+00_r8, & + & 1.11089e+00_r8, 1.11547e+00_r8, 1.12008e+00_r8, 1.12470e+00_r8/) + kao_mn2o( 6, :, 2) = (/ & + & 1.22341e+00_r8, 1.22885e+00_r8, 1.23431e+00_r8, 1.23980e+00_r8, 1.24531e+00_r8, & + & 1.25084e+00_r8, 1.25640e+00_r8, 1.26199e+00_r8, 1.26760e+00_r8, 1.27323e+00_r8, & + & 1.27889e+00_r8, 1.28458e+00_r8, 1.29029e+00_r8, 1.29602e+00_r8, 1.30178e+00_r8, & + & 1.30757e+00_r8, 1.31338e+00_r8, 1.31922e+00_r8, 1.32508e+00_r8/) + kao_mn2o( 7, :, 2) = (/ & + & 1.67595e+00_r8, 1.68296e+00_r8, 1.69000e+00_r8, 1.69707e+00_r8, 1.70417e+00_r8, & + & 1.71130e+00_r8, 1.71846e+00_r8, 1.72565e+00_r8, 1.73287e+00_r8, 1.74012e+00_r8, & + & 1.74740e+00_r8, 1.75471e+00_r8, 1.76206e+00_r8, 1.76943e+00_r8, 1.77683e+00_r8, & + & 1.78426e+00_r8, 1.79173e+00_r8, 1.79922e+00_r8, 1.80675e+00_r8/) + kao_mn2o( 8, :, 2) = (/ & + & 2.76890e+00_r8, 2.76981e+00_r8, 2.77072e+00_r8, 2.77163e+00_r8, 2.77254e+00_r8, & + & 2.77345e+00_r8, 2.77436e+00_r8, 2.77527e+00_r8, 2.77618e+00_r8, 2.77709e+00_r8, & + & 2.77800e+00_r8, 2.77891e+00_r8, 2.77982e+00_r8, 2.78074e+00_r8, 2.78165e+00_r8, & + & 2.78256e+00_r8, 2.78348e+00_r8, 2.78439e+00_r8, 2.78530e+00_r8/) + kao_mn2o( 9, :, 2) = (/ & + & 8.00944e-01_r8, 7.95531e-01_r8, 7.90155e-01_r8, 7.84815e-01_r8, 7.79511e-01_r8, & + & 7.74243e-01_r8, 7.69011e-01_r8, 7.63813e-01_r8, 7.58652e-01_r8, 7.53525e-01_r8, & + & 7.48432e-01_r8, 7.43374e-01_r8, 7.38350e-01_r8, 7.33360e-01_r8, 7.28404e-01_r8, & + & 7.23482e-01_r8, 7.18592e-01_r8, 7.13736e-01_r8, 7.08912e-01_r8/) + kao_mn2o( 1, :, 3) = (/ & + & 5.26578e-02_r8, 5.59000e-02_r8, 5.93419e-02_r8, 6.29957e-02_r8, 6.68744e-02_r8, & + & 7.09920e-02_r8, 7.53631e-02_r8, 8.00034e-02_r8, 8.49294e-02_r8, 9.01586e-02_r8, & + & 9.57099e-02_r8, 1.01603e-01_r8, 1.07859e-01_r8, 1.14500e-01_r8, 1.21550e-01_r8, & + & 1.29034e-01_r8, 1.36979e-01_r8, 1.45413e-01_r8, 1.54366e-01_r8/) + kao_mn2o( 2, :, 3) = (/ & + & 8.18393e-01_r8, 8.20623e-01_r8, 8.22860e-01_r8, 8.25103e-01_r8, 8.27352e-01_r8, & + & 8.29608e-01_r8, 8.31869e-01_r8, 8.34137e-01_r8, 8.36410e-01_r8, 8.38690e-01_r8, & + & 8.40976e-01_r8, 8.43269e-01_r8, 8.45567e-01_r8, 8.47872e-01_r8, 8.50183e-01_r8, & + & 8.52501e-01_r8, 8.54825e-01_r8, 8.57155e-01_r8, 8.59491e-01_r8/) + kao_mn2o( 3, :, 3) = (/ & + & 1.02454e+00_r8, 1.03210e+00_r8, 1.03972e+00_r8, 1.04740e+00_r8, 1.05514e+00_r8, & + & 1.06293e+00_r8, 1.07077e+00_r8, 1.07868e+00_r8, 1.08665e+00_r8, 1.09467e+00_r8, & + & 1.10275e+00_r8, 1.11089e+00_r8, 1.11910e+00_r8, 1.12736e+00_r8, 1.13568e+00_r8, & + & 1.14407e+00_r8, 1.15252e+00_r8, 1.16103e+00_r8, 1.16960e+00_r8/) + kao_mn2o( 4, :, 3) = (/ & + & 1.11755e+00_r8, 1.12348e+00_r8, 1.12944e+00_r8, 1.13543e+00_r8, 1.14146e+00_r8, & + & 1.14752e+00_r8, 1.15360e+00_r8, 1.15972e+00_r8, 1.16588e+00_r8, 1.17206e+00_r8, & + & 1.17828e+00_r8, 1.18453e+00_r8, 1.19082e+00_r8, 1.19714e+00_r8, 1.20349e+00_r8, & + & 1.20988e+00_r8, 1.21630e+00_r8, 1.22275e+00_r8, 1.22924e+00_r8/) + kao_mn2o( 5, :, 3) = (/ & + & 1.41993e+00_r8, 1.42353e+00_r8, 1.42713e+00_r8, 1.43074e+00_r8, 1.43436e+00_r8, & + & 1.43799e+00_r8, 1.44163e+00_r8, 1.44528e+00_r8, 1.44894e+00_r8, 1.45261e+00_r8, & + & 1.45628e+00_r8, 1.45997e+00_r8, 1.46367e+00_r8, 1.46737e+00_r8, 1.47108e+00_r8, & + & 1.47481e+00_r8, 1.47854e+00_r8, 1.48228e+00_r8, 1.48603e+00_r8/) + kao_mn2o( 6, :, 3) = (/ & + & 1.37725e+00_r8, 1.38029e+00_r8, 1.38334e+00_r8, 1.38640e+00_r8, 1.38947e+00_r8, & + & 1.39254e+00_r8, 1.39562e+00_r8, 1.39870e+00_r8, 1.40179e+00_r8, 1.40489e+00_r8, & + & 1.40800e+00_r8, 1.41111e+00_r8, 1.41423e+00_r8, 1.41736e+00_r8, 1.42049e+00_r8, & + & 1.42363e+00_r8, 1.42678e+00_r8, 1.42993e+00_r8, 1.43309e+00_r8/) + kao_mn2o( 7, :, 3) = (/ & + & 1.34579e+00_r8, 1.34584e+00_r8, 1.34589e+00_r8, 1.34594e+00_r8, 1.34599e+00_r8, & + & 1.34603e+00_r8, 1.34608e+00_r8, 1.34613e+00_r8, 1.34618e+00_r8, 1.34623e+00_r8, & + & 1.34627e+00_r8, 1.34632e+00_r8, 1.34637e+00_r8, 1.34642e+00_r8, 1.34647e+00_r8, & + & 1.34651e+00_r8, 1.34656e+00_r8, 1.34661e+00_r8, 1.34666e+00_r8/) + kao_mn2o( 8, :, 3) = (/ & + & 9.15268e-01_r8, 9.12779e-01_r8, 9.10298e-01_r8, 9.07823e-01_r8, 9.05355e-01_r8, & + & 9.02893e-01_r8, 9.00438e-01_r8, 8.97990e-01_r8, 8.95549e-01_r8, 8.93114e-01_r8, & + & 8.90686e-01_r8, 8.88264e-01_r8, 8.85849e-01_r8, 8.83441e-01_r8, 8.81039e-01_r8, & + & 8.78644e-01_r8, 8.76255e-01_r8, 8.73873e-01_r8, 8.71497e-01_r8/) + kao_mn2o( 9, :, 3) = (/ & + & 1.12514e+00_r8, 1.13523e+00_r8, 1.14541e+00_r8, 1.15568e+00_r8, 1.16604e+00_r8, & + & 1.17649e+00_r8, 1.18704e+00_r8, 1.19768e+00_r8, 1.20841e+00_r8, 1.21925e+00_r8, & + & 1.23018e+00_r8, 1.24121e+00_r8, 1.25233e+00_r8, 1.26356e+00_r8, 1.27489e+00_r8, & + & 1.28632e+00_r8, 1.29785e+00_r8, 1.30948e+00_r8, 1.32122e+00_r8/) + kao_mn2o( 1, :, 4) = (/ & + & 4.65135e-01_r8, 4.69677e-01_r8, 4.74264e-01_r8, 4.78895e-01_r8, 4.83572e-01_r8, & + & 4.88294e-01_r8, 4.93063e-01_r8, 4.97878e-01_r8, 5.02740e-01_r8, 5.07649e-01_r8, & + & 5.12607e-01_r8, 5.17613e-01_r8, 5.22667e-01_r8, 5.27771e-01_r8, 5.32925e-01_r8, & + & 5.38130e-01_r8, 5.43385e-01_r8, 5.48691e-01_r8, 5.54049e-01_r8/) + kao_mn2o( 2, :, 4) = (/ & + & 9.71592e-01_r8, 9.74472e-01_r8, 9.77360e-01_r8, 9.80257e-01_r8, 9.83163e-01_r8, & + & 9.86077e-01_r8, 9.89000e-01_r8, 9.91931e-01_r8, 9.94871e-01_r8, 9.97820e-01_r8, & + & 1.00078e+00_r8, 1.00374e+00_r8, 1.00672e+00_r8, 1.00970e+00_r8, 1.01270e+00_r8, & + & 1.01570e+00_r8, 1.01871e+00_r8, 1.02173e+00_r8, 1.02476e+00_r8/) + kao_mn2o( 3, :, 4) = (/ & + & 1.48090e+00_r8, 1.48238e+00_r8, 1.48385e+00_r8, 1.48532e+00_r8, 1.48680e+00_r8, & + & 1.48828e+00_r8, 1.48976e+00_r8, 1.49124e+00_r8, 1.49272e+00_r8, 1.49420e+00_r8, & + & 1.49569e+00_r8, 1.49717e+00_r8, 1.49866e+00_r8, 1.50015e+00_r8, 1.50164e+00_r8, & + & 1.50313e+00_r8, 1.50463e+00_r8, 1.50612e+00_r8, 1.50762e+00_r8/) + kao_mn2o( 4, :, 4) = (/ & + & 1.50599e+00_r8, 1.50541e+00_r8, 1.50483e+00_r8, 1.50426e+00_r8, 1.50368e+00_r8, & + & 1.50310e+00_r8, 1.50252e+00_r8, 1.50195e+00_r8, 1.50137e+00_r8, 1.50079e+00_r8, & + & 1.50022e+00_r8, 1.49964e+00_r8, 1.49906e+00_r8, 1.49849e+00_r8, 1.49791e+00_r8, & + & 1.49734e+00_r8, 1.49676e+00_r8, 1.49619e+00_r8, 1.49561e+00_r8/) + kao_mn2o( 5, :, 4) = (/ & + & 1.25396e+00_r8, 1.25230e+00_r8, 1.25065e+00_r8, 1.24900e+00_r8, 1.24735e+00_r8, & + & 1.24570e+00_r8, 1.24405e+00_r8, 1.24241e+00_r8, 1.24077e+00_r8, 1.23913e+00_r8, & + & 1.23749e+00_r8, 1.23586e+00_r8, 1.23423e+00_r8, 1.23260e+00_r8, 1.23097e+00_r8, & + & 1.22934e+00_r8, 1.22772e+00_r8, 1.22610e+00_r8, 1.22448e+00_r8/) + kao_mn2o( 6, :, 4) = (/ & + & 1.27104e+00_r8, 1.26416e+00_r8, 1.25731e+00_r8, 1.25050e+00_r8, 1.24373e+00_r8, & + & 1.23700e+00_r8, 1.23030e+00_r8, 1.22364e+00_r8, 1.21701e+00_r8, 1.21043e+00_r8, & + & 1.20387e+00_r8, 1.19735e+00_r8, 1.19087e+00_r8, 1.18442e+00_r8, 1.17801e+00_r8, & + & 1.17163e+00_r8, 1.16529e+00_r8, 1.15898e+00_r8, 1.15270e+00_r8/) + kao_mn2o( 7, :, 4) = (/ & + & 9.57877e-01_r8, 9.49712e-01_r8, 9.41617e-01_r8, 9.33591e-01_r8, 9.25633e-01_r8, & + & 9.17743e-01_r8, 9.09920e-01_r8, 9.02164e-01_r8, 8.94473e-01_r8, 8.86849e-01_r8, & + & 8.79289e-01_r8, 8.71794e-01_r8, 8.64363e-01_r8, 8.56995e-01_r8, 8.49690e-01_r8, & + & 8.42447e-01_r8, 8.35266e-01_r8, 8.28147e-01_r8, 8.21087e-01_r8/) + kao_mn2o( 8, :, 4) = (/ & + & 4.75787e-01_r8, 4.77208e-01_r8, 4.78633e-01_r8, 4.80063e-01_r8, 4.81496e-01_r8, & + & 4.82934e-01_r8, 4.84377e-01_r8, 4.85823e-01_r8, 4.87274e-01_r8, 4.88730e-01_r8, & + & 4.90189e-01_r8, 4.91653e-01_r8, 4.93122e-01_r8, 4.94595e-01_r8, 4.96072e-01_r8, & + & 4.97553e-01_r8, 4.99039e-01_r8, 5.00530e-01_r8, 5.02025e-01_r8/) + kao_mn2o( 9, :, 4) = (/ & + & 2.42533e+00_r8, 2.41357e+00_r8, 2.40188e+00_r8, 2.39024e+00_r8, 2.37866e+00_r8, & + & 2.36713e+00_r8, 2.35566e+00_r8, 2.34425e+00_r8, 2.33289e+00_r8, 2.32158e+00_r8, & + & 2.31033e+00_r8, 2.29914e+00_r8, 2.28800e+00_r8, 2.27691e+00_r8, 2.26588e+00_r8, & + & 2.25490e+00_r8, 2.24397e+00_r8, 2.23310e+00_r8, 2.22228e+00_r8/) + kao_mn2o( 1, :, 5) = (/ & + & 1.53885e+00_r8, 1.53590e+00_r8, 1.53297e+00_r8, 1.53004e+00_r8, 1.52711e+00_r8, & + & 1.52419e+00_r8, 1.52128e+00_r8, 1.51837e+00_r8, 1.51547e+00_r8, 1.51257e+00_r8, & + & 1.50968e+00_r8, 1.50679e+00_r8, 1.50391e+00_r8, 1.50104e+00_r8, 1.49817e+00_r8, & + & 1.49530e+00_r8, 1.49245e+00_r8, 1.48959e+00_r8, 1.48675e+00_r8/) + kao_mn2o( 2, :, 5) = (/ & + & 1.83368e+00_r8, 1.83530e+00_r8, 1.83692e+00_r8, 1.83854e+00_r8, 1.84016e+00_r8, & + & 1.84178e+00_r8, 1.84340e+00_r8, 1.84503e+00_r8, 1.84665e+00_r8, 1.84828e+00_r8, & + & 1.84991e+00_r8, 1.85154e+00_r8, 1.85317e+00_r8, 1.85480e+00_r8, 1.85644e+00_r8, & + & 1.85807e+00_r8, 1.85971e+00_r8, 1.86135e+00_r8, 1.86299e+00_r8/) + kao_mn2o( 3, :, 5) = (/ & + & 1.49593e+00_r8, 1.49279e+00_r8, 1.48965e+00_r8, 1.48652e+00_r8, 1.48340e+00_r8, & + & 1.48028e+00_r8, 1.47717e+00_r8, 1.47406e+00_r8, 1.47096e+00_r8, 1.46787e+00_r8, & + & 1.46479e+00_r8, 1.46171e+00_r8, 1.45863e+00_r8, 1.45557e+00_r8, 1.45251e+00_r8, & + & 1.44946e+00_r8, 1.44641e+00_r8, 1.44337e+00_r8, 1.44033e+00_r8/) + kao_mn2o( 4, :, 5) = (/ & + & 1.40048e+00_r8, 1.39228e+00_r8, 1.38413e+00_r8, 1.37603e+00_r8, 1.36798e+00_r8, & + & 1.35997e+00_r8, 1.35201e+00_r8, 1.34410e+00_r8, 1.33623e+00_r8, 1.32841e+00_r8, & + & 1.32064e+00_r8, 1.31291e+00_r8, 1.30522e+00_r8, 1.29758e+00_r8, 1.28999e+00_r8, & + & 1.28244e+00_r8, 1.27493e+00_r8, 1.26747e+00_r8, 1.26005e+00_r8/) + kao_mn2o( 5, :, 5) = (/ & + & 1.22253e+00_r8, 1.21202e+00_r8, 1.20160e+00_r8, 1.19126e+00_r8, 1.18102e+00_r8, & + & 1.17087e+00_r8, 1.16080e+00_r8, 1.15082e+00_r8, 1.14092e+00_r8, 1.13111e+00_r8, & + & 1.12139e+00_r8, 1.11174e+00_r8, 1.10219e+00_r8, 1.09271e+00_r8, 1.08331e+00_r8, & + & 1.07400e+00_r8, 1.06476e+00_r8, 1.05561e+00_r8, 1.04653e+00_r8/) + kao_mn2o( 6, :, 5) = (/ & + & 1.07930e+00_r8, 1.06998e+00_r8, 1.06075e+00_r8, 1.05159e+00_r8, 1.04251e+00_r8, & + & 1.03352e+00_r8, 1.02459e+00_r8, 1.01575e+00_r8, 1.00698e+00_r8, 9.98291e-01_r8, & + & 9.89674e-01_r8, 9.81131e-01_r8, 9.72663e-01_r8, 9.64267e-01_r8, 9.55944e-01_r8, & + & 9.47692e-01_r8, 9.39512e-01_r8, 9.31402e-01_r8, 9.23363e-01_r8/) + kao_mn2o( 7, :, 5) = (/ & + & 7.87066e-01_r8, 7.82767e-01_r8, 7.78490e-01_r8, 7.74237e-01_r8, 7.70008e-01_r8, & + & 7.65801e-01_r8, 7.61617e-01_r8, 7.57457e-01_r8, 7.53319e-01_r8, 7.49203e-01_r8, & + & 7.45110e-01_r8, 7.41040e-01_r8, 7.36991e-01_r8, 7.32965e-01_r8, 7.28961e-01_r8, & + & 7.24979e-01_r8, 7.21018e-01_r8, 7.17079e-01_r8, 7.13161e-01_r8/) + kao_mn2o( 8, :, 5) = (/ & + & 3.83362e-01_r8, 3.84405e-01_r8, 3.85452e-01_r8, 3.86501e-01_r8, 3.87552e-01_r8, & + & 3.88607e-01_r8, 3.89665e-01_r8, 3.90725e-01_r8, 3.91788e-01_r8, 3.92855e-01_r8, & + & 3.93924e-01_r8, 3.94996e-01_r8, 3.96071e-01_r8, 3.97149e-01_r8, 3.98229e-01_r8, & + & 3.99313e-01_r8, 4.00400e-01_r8, 4.01489e-01_r8, 4.02582e-01_r8/) + kao_mn2o( 9, :, 5) = (/ & + & 8.97278e-01_r8, 8.92873e-01_r8, 8.88490e-01_r8, 8.84128e-01_r8, 8.79787e-01_r8, & + & 8.75468e-01_r8, 8.71170e-01_r8, 8.66893e-01_r8, 8.62637e-01_r8, 8.58402e-01_r8, & + & 8.54187e-01_r8, 8.49994e-01_r8, 8.45821e-01_r8, 8.41668e-01_r8, 8.37536e-01_r8, & + & 8.33424e-01_r8, 8.29333e-01_r8, 8.25261e-01_r8, 8.21209e-01_r8/) + kao_mn2o( 1, :, 6) = (/ & + & 1.83809e+00_r8, 1.84036e+00_r8, 1.84264e+00_r8, 1.84491e+00_r8, 1.84720e+00_r8, & + & 1.84948e+00_r8, 1.85177e+00_r8, 1.85406e+00_r8, 1.85635e+00_r8, 1.85864e+00_r8, & + & 1.86094e+00_r8, 1.86324e+00_r8, 1.86555e+00_r8, 1.86785e+00_r8, 1.87016e+00_r8, & + & 1.87247e+00_r8, 1.87479e+00_r8, 1.87711e+00_r8, 1.87943e+00_r8/) + kao_mn2o( 2, :, 6) = (/ & + & 1.82624e+00_r8, 1.81564e+00_r8, 1.80510e+00_r8, 1.79463e+00_r8, 1.78421e+00_r8, & + & 1.77386e+00_r8, 1.76356e+00_r8, 1.75333e+00_r8, 1.74315e+00_r8, 1.73304e+00_r8, & + & 1.72298e+00_r8, 1.71298e+00_r8, 1.70304e+00_r8, 1.69316e+00_r8, 1.68333e+00_r8, & + & 1.67356e+00_r8, 1.66385e+00_r8, 1.65419e+00_r8, 1.64459e+00_r8/) + kao_mn2o( 3, :, 6) = (/ & + & 1.35442e+00_r8, 1.34174e+00_r8, 1.32918e+00_r8, 1.31673e+00_r8, 1.30440e+00_r8, & + & 1.29219e+00_r8, 1.28010e+00_r8, 1.26811e+00_r8, 1.25624e+00_r8, 1.24448e+00_r8, & + & 1.23283e+00_r8, 1.22129e+00_r8, 1.20985e+00_r8, 1.19853e+00_r8, 1.18731e+00_r8, & + & 1.17619e+00_r8, 1.16518e+00_r8, 1.15427e+00_r8, 1.14347e+00_r8/) + kao_mn2o( 4, :, 6) = (/ & + & 1.10510e+00_r8, 1.09473e+00_r8, 1.08446e+00_r8, 1.07429e+00_r8, 1.06420e+00_r8, & + & 1.05422e+00_r8, 1.04433e+00_r8, 1.03453e+00_r8, 1.02482e+00_r8, 1.01520e+00_r8, & + & 1.00568e+00_r8, 9.96238e-01_r8, 9.86890e-01_r8, 9.77629e-01_r8, 9.68455e-01_r8, & + & 9.59367e-01_r8, 9.50365e-01_r8, 9.41447e-01_r8, 9.32612e-01_r8/) + kao_mn2o( 5, :, 6) = (/ & + & 1.01083e+00_r8, 1.00221e+00_r8, 9.93656e-01_r8, 9.85178e-01_r8, 9.76772e-01_r8, & + & 9.68437e-01_r8, 9.60174e-01_r8, 9.51981e-01_r8, 9.43859e-01_r8, 9.35805e-01_r8, & + & 9.27821e-01_r8, 9.19904e-01_r8, 9.12055e-01_r8, 9.04273e-01_r8, 8.96557e-01_r8, & + & 8.88907e-01_r8, 8.81323e-01_r8, 8.73803e-01_r8, 8.66347e-01_r8/) + kao_mn2o( 6, :, 6) = (/ & + & 5.91415e-01_r8, 5.90427e-01_r8, 5.89441e-01_r8, 5.88457e-01_r8, 5.87474e-01_r8, & + & 5.86493e-01_r8, 5.85514e-01_r8, 5.84536e-01_r8, 5.83559e-01_r8, 5.82585e-01_r8, & + & 5.81612e-01_r8, 5.80640e-01_r8, 5.79671e-01_r8, 5.78703e-01_r8, 5.77736e-01_r8, & + & 5.76771e-01_r8, 5.75808e-01_r8, 5.74846e-01_r8, 5.73886e-01_r8/) + kao_mn2o( 7, :, 6) = (/ & + & 3.68189e-01_r8, 3.70029e-01_r8, 3.71877e-01_r8, 3.73735e-01_r8, 3.75603e-01_r8, & + & 3.77479e-01_r8, 3.79365e-01_r8, 3.81260e-01_r8, 3.83165e-01_r8, 3.85079e-01_r8, & + & 3.87003e-01_r8, 3.88937e-01_r8, 3.90880e-01_r8, 3.92833e-01_r8, 3.94795e-01_r8, & + & 3.96768e-01_r8, 3.98750e-01_r8, 4.00742e-01_r8, 4.02744e-01_r8/) + kao_mn2o( 8, :, 6) = (/ & + & 2.98721e-01_r8, 2.99932e-01_r8, 3.01149e-01_r8, 3.02370e-01_r8, 3.03597e-01_r8, & + & 3.04828e-01_r8, 3.06064e-01_r8, 3.07306e-01_r8, 3.08552e-01_r8, 3.09804e-01_r8, & + & 3.11060e-01_r8, 3.12322e-01_r8, 3.13589e-01_r8, 3.14860e-01_r8, 3.16138e-01_r8, & + & 3.17420e-01_r8, 3.18707e-01_r8, 3.20000e-01_r8, 3.21298e-01_r8/) + kao_mn2o( 9, :, 6) = (/ & + & 3.76116e-01_r8, 3.77276e-01_r8, 3.78439e-01_r8, 3.79606e-01_r8, 3.80777e-01_r8, & + & 3.81951e-01_r8, 3.83129e-01_r8, 3.84310e-01_r8, 3.85495e-01_r8, 3.86684e-01_r8, & + & 3.87876e-01_r8, 3.89072e-01_r8, 3.90272e-01_r8, 3.91475e-01_r8, 3.92682e-01_r8, & + & 3.93893e-01_r8, 3.95107e-01_r8, 3.96326e-01_r8, 3.97548e-01_r8/) + kao_mn2o( 1, :, 7) = (/ & + & 3.22705e+00_r8, 3.21966e+00_r8, 3.21230e+00_r8, 3.20494e+00_r8, 3.19761e+00_r8, & + & 3.19029e+00_r8, 3.18299e+00_r8, 3.17571e+00_r8, 3.16844e+00_r8, 3.16119e+00_r8, & + & 3.15395e+00_r8, 3.14673e+00_r8, 3.13953e+00_r8, 3.13235e+00_r8, 3.12518e+00_r8, & + & 3.11803e+00_r8, 3.11089e+00_r8, 3.10377e+00_r8, 3.09667e+00_r8/) + kao_mn2o( 2, :, 7) = (/ & + & 1.43811e+00_r8, 1.42367e+00_r8, 1.40938e+00_r8, 1.39522e+00_r8, 1.38121e+00_r8, & + & 1.36735e+00_r8, 1.35362e+00_r8, 1.34002e+00_r8, 1.32657e+00_r8, 1.31325e+00_r8, & + & 1.30006e+00_r8, 1.28701e+00_r8, 1.27408e+00_r8, 1.26129e+00_r8, 1.24862e+00_r8, & + & 1.23609e+00_r8, 1.22367e+00_r8, 1.21139e+00_r8, 1.19922e+00_r8/) + kao_mn2o( 3, :, 7) = (/ & + & 1.22586e+00_r8, 1.21639e+00_r8, 1.20700e+00_r8, 1.19767e+00_r8, 1.18842e+00_r8, & + & 1.17924e+00_r8, 1.17014e+00_r8, 1.16110e+00_r8, 1.15213e+00_r8, 1.14323e+00_r8, & + & 1.13440e+00_r8, 1.12564e+00_r8, 1.11695e+00_r8, 1.10832e+00_r8, 1.09976e+00_r8, & + & 1.09127e+00_r8, 1.08284e+00_r8, 1.07447e+00_r8, 1.06618e+00_r8/) + kao_mn2o( 4, :, 7) = (/ & + & 7.94380e-01_r8, 7.92795e-01_r8, 7.91213e-01_r8, 7.89634e-01_r8, 7.88059e-01_r8, & + & 7.86486e-01_r8, 7.84917e-01_r8, 7.83351e-01_r8, 7.81787e-01_r8, 7.80227e-01_r8, & + & 7.78671e-01_r8, 7.77117e-01_r8, 7.75566e-01_r8, 7.74019e-01_r8, 7.72474e-01_r8, & + & 7.70933e-01_r8, 7.69394e-01_r8, 7.67859e-01_r8, 7.66327e-01_r8/) + kao_mn2o( 5, :, 7) = (/ & + & 4.46935e-01_r8, 4.49760e-01_r8, 4.52602e-01_r8, 4.55462e-01_r8, 4.58340e-01_r8, & + & 4.61237e-01_r8, 4.64152e-01_r8, 4.67085e-01_r8, 4.70037e-01_r8, 4.73007e-01_r8, & + & 4.75996e-01_r8, 4.79004e-01_r8, 4.82031e-01_r8, 4.85078e-01_r8, 4.88143e-01_r8, & + & 4.91228e-01_r8, 4.94332e-01_r8, 4.97456e-01_r8, 5.00600e-01_r8/) + kao_mn2o( 6, :, 7) = (/ & + & 4.20211e-01_r8, 4.21711e-01_r8, 4.23216e-01_r8, 4.24726e-01_r8, 4.26242e-01_r8, & + & 4.27763e-01_r8, 4.29290e-01_r8, 4.30822e-01_r8, 4.32359e-01_r8, 4.33902e-01_r8, & + & 4.35450e-01_r8, 4.37004e-01_r8, 4.38564e-01_r8, 4.40129e-01_r8, 4.41700e-01_r8, & + & 4.43276e-01_r8, 4.44858e-01_r8, 4.46445e-01_r8, 4.48038e-01_r8/) + kao_mn2o( 7, :, 7) = (/ & + & 3.42094e-01_r8, 3.43589e-01_r8, 3.45091e-01_r8, 3.46600e-01_r8, 3.48115e-01_r8, & + & 3.49637e-01_r8, 3.51165e-01_r8, 3.52700e-01_r8, 3.54242e-01_r8, 3.55791e-01_r8, & + & 3.57346e-01_r8, 3.58908e-01_r8, 3.60477e-01_r8, 3.62053e-01_r8, 3.63636e-01_r8, & + & 3.65225e-01_r8, 3.66822e-01_r8, 3.68426e-01_r8, 3.70036e-01_r8/) + kao_mn2o( 8, :, 7) = (/ & + & 2.94919e-01_r8, 2.97460e-01_r8, 3.00022e-01_r8, 3.02606e-01_r8, 3.05212e-01_r8, & + & 3.07841e-01_r8, 3.10492e-01_r8, 3.13167e-01_r8, 3.15864e-01_r8, 3.18584e-01_r8, & + & 3.21328e-01_r8, 3.24096e-01_r8, 3.26887e-01_r8, 3.29703e-01_r8, 3.32543e-01_r8, & + & 3.35407e-01_r8, 3.38296e-01_r8, 3.41210e-01_r8, 3.44148e-01_r8/) + kao_mn2o( 9, :, 7) = (/ & + & 2.97441e-01_r8, 2.99207e-01_r8, 3.00984e-01_r8, 3.02772e-01_r8, 3.04570e-01_r8, & + & 3.06379e-01_r8, 3.08199e-01_r8, 3.10029e-01_r8, 3.11870e-01_r8, 3.13723e-01_r8, & + & 3.15586e-01_r8, 3.17460e-01_r8, 3.19345e-01_r8, 3.21242e-01_r8, 3.23150e-01_r8, & + & 3.25069e-01_r8, 3.27000e-01_r8, 3.28942e-01_r8, 3.30895e-01_r8/) + kao_mn2o( 1, :, 8) = (/ & + & 2.14641e+00_r8, 2.12585e+00_r8, 2.10549e+00_r8, 2.08532e+00_r8, 2.06534e+00_r8, & + & 2.04556e+00_r8, 2.02596e+00_r8, 2.00656e+00_r8, 1.98733e+00_r8, 1.96830e+00_r8, & + & 1.94944e+00_r8, 1.93077e+00_r8, 1.91227e+00_r8, 1.89395e+00_r8, 1.87581e+00_r8, & + & 1.85784e+00_r8, 1.84004e+00_r8, 1.82242e+00_r8, 1.80496e+00_r8/) + kao_mn2o( 2, :, 8) = (/ & + & 8.83687e-01_r8, 8.83170e-01_r8, 8.82654e-01_r8, 8.82137e-01_r8, 8.81621e-01_r8, & + & 8.81106e-01_r8, 8.80590e-01_r8, 8.80075e-01_r8, 8.79560e-01_r8, 8.79046e-01_r8, & + & 8.78531e-01_r8, 8.78017e-01_r8, 8.77504e-01_r8, 8.76990e-01_r8, 8.76477e-01_r8, & + & 8.75965e-01_r8, 8.75452e-01_r8, 8.74940e-01_r8, 8.74428e-01_r8/) + kao_mn2o( 3, :, 8) = (/ & + & 4.49840e-01_r8, 4.52683e-01_r8, 4.55543e-01_r8, 4.58421e-01_r8, 4.61318e-01_r8, & + & 4.64233e-01_r8, 4.67166e-01_r8, 4.70118e-01_r8, 4.73088e-01_r8, 4.76078e-01_r8, & + & 4.79086e-01_r8, 4.82113e-01_r8, 4.85159e-01_r8, 4.88225e-01_r8, 4.91310e-01_r8, & + & 4.94414e-01_r8, 4.97538e-01_r8, 5.00682e-01_r8, 5.03845e-01_r8/) + kao_mn2o( 4, :, 8) = (/ & + & 3.92292e-01_r8, 3.93574e-01_r8, 3.94861e-01_r8, 3.96151e-01_r8, 3.97446e-01_r8, & + & 3.98746e-01_r8, 4.00049e-01_r8, 4.01357e-01_r8, 4.02669e-01_r8, 4.03985e-01_r8, & + & 4.05306e-01_r8, 4.06630e-01_r8, 4.07960e-01_r8, 4.09293e-01_r8, 4.10631e-01_r8, & + & 4.11973e-01_r8, 4.13320e-01_r8, 4.14671e-01_r8, 4.16027e-01_r8/) + kao_mn2o( 5, :, 8) = (/ & + & 3.38920e-01_r8, 3.41151e-01_r8, 3.43397e-01_r8, 3.45658e-01_r8, 3.47934e-01_r8, & + & 3.50225e-01_r8, 3.52531e-01_r8, 3.54852e-01_r8, 3.57189e-01_r8, 3.59541e-01_r8, & + & 3.61908e-01_r8, 3.64291e-01_r8, 3.66689e-01_r8, 3.69104e-01_r8, 3.71534e-01_r8, & + & 3.73980e-01_r8, 3.76443e-01_r8, 3.78921e-01_r8, 3.81416e-01_r8/) + kao_mn2o( 6, :, 8) = (/ & + & 3.01673e-01_r8, 3.04752e-01_r8, 3.07863e-01_r8, 3.11005e-01_r8, 3.14180e-01_r8, & + & 3.17387e-01_r8, 3.20626e-01_r8, 3.23899e-01_r8, 3.27205e-01_r8, 3.30545e-01_r8, & + & 3.33919e-01_r8, 3.37328e-01_r8, 3.40771e-01_r8, 3.44249e-01_r8, 3.47763e-01_r8, & + & 3.51313e-01_r8, 3.54899e-01_r8, 3.58521e-01_r8, 3.62181e-01_r8/) + kao_mn2o( 7, :, 8) = (/ & + & 2.99381e-01_r8, 3.02431e-01_r8, 3.05512e-01_r8, 3.08624e-01_r8, 3.11768e-01_r8, & + & 3.14945e-01_r8, 3.18153e-01_r8, 3.21394e-01_r8, 3.24668e-01_r8, 3.27976e-01_r8, & + & 3.31317e-01_r8, 3.34693e-01_r8, 3.38102e-01_r8, 3.41547e-01_r8, 3.45026e-01_r8, & + & 3.48541e-01_r8, 3.52092e-01_r8, 3.55679e-01_r8, 3.59302e-01_r8/) + kao_mn2o( 8, :, 8) = (/ & + & 2.87559e-01_r8, 2.89153e-01_r8, 2.90756e-01_r8, 2.92367e-01_r8, 2.93987e-01_r8, & + & 2.95617e-01_r8, 2.97255e-01_r8, 2.98902e-01_r8, 3.00559e-01_r8, 3.02225e-01_r8, & + & 3.03899e-01_r8, 3.05584e-01_r8, 3.07277e-01_r8, 3.08980e-01_r8, 3.10693e-01_r8, & + & 3.12414e-01_r8, 3.14146e-01_r8, 3.15887e-01_r8, 3.17638e-01_r8/) + kao_mn2o( 9, :, 8) = (/ & + & 2.96238e-01_r8, 2.97588e-01_r8, 2.98945e-01_r8, 3.00309e-01_r8, 3.01678e-01_r8, & + & 3.03054e-01_r8, 3.04436e-01_r8, 3.05824e-01_r8, 3.07219e-01_r8, 3.08620e-01_r8, & + & 3.10027e-01_r8, 3.11441e-01_r8, 3.12861e-01_r8, 3.14288e-01_r8, 3.15721e-01_r8, & + & 3.17161e-01_r8, 3.18607e-01_r8, 3.20060e-01_r8, 3.21520e-01_r8/) + kao_mn2o( 1, :, 9) = (/ & + & 1.56483e+00_r8, 1.55792e+00_r8, 1.55105e+00_r8, 1.54420e+00_r8, 1.53739e+00_r8, & + & 1.53060e+00_r8, 1.52384e+00_r8, 1.51712e+00_r8, 1.51042e+00_r8, 1.50376e+00_r8, & + & 1.49712e+00_r8, 1.49051e+00_r8, 1.48393e+00_r8, 1.47738e+00_r8, 1.47086e+00_r8, & + & 1.46437e+00_r8, 1.45791e+00_r8, 1.45147e+00_r8, 1.44507e+00_r8/) + kao_mn2o( 2, :, 9) = (/ & + & 4.09526e-01_r8, 4.10301e-01_r8, 4.11078e-01_r8, 4.11857e-01_r8, 4.12637e-01_r8, & + & 4.13418e-01_r8, 4.14201e-01_r8, 4.14986e-01_r8, 4.15771e-01_r8, 4.16559e-01_r8, & + & 4.17348e-01_r8, 4.18138e-01_r8, 4.18930e-01_r8, 4.19723e-01_r8, 4.20518e-01_r8, & + & 4.21315e-01_r8, 4.22112e-01_r8, 4.22912e-01_r8, 4.23713e-01_r8/) + kao_mn2o( 3, :, 9) = (/ & + & 3.35672e-01_r8, 3.38982e-01_r8, 3.42326e-01_r8, 3.45702e-01_r8, 3.49111e-01_r8, & + & 3.52554e-01_r8, 3.56031e-01_r8, 3.59543e-01_r8, 3.63089e-01_r8, 3.66670e-01_r8, & + & 3.70286e-01_r8, 3.73938e-01_r8, 3.77626e-01_r8, 3.81350e-01_r8, 3.85111e-01_r8, & + & 3.88909e-01_r8, 3.92745e-01_r8, 3.96618e-01_r8, 4.00530e-01_r8/) + kao_mn2o( 4, :, 9) = (/ & + & 3.19130e-01_r8, 3.23028e-01_r8, 3.26973e-01_r8, 3.30966e-01_r8, 3.35008e-01_r8, & + & 3.39100e-01_r8, 3.43241e-01_r8, 3.47433e-01_r8, 3.51676e-01_r8, 3.55971e-01_r8, & + & 3.60319e-01_r8, 3.64719e-01_r8, 3.69173e-01_r8, 3.73682e-01_r8, 3.78246e-01_r8, & + & 3.82865e-01_r8, 3.87541e-01_r8, 3.92274e-01_r8, 3.97065e-01_r8/) + kao_mn2o( 5, :, 9) = (/ & + & 3.04385e-01_r8, 3.07155e-01_r8, 3.09949e-01_r8, 3.12770e-01_r8, 3.15616e-01_r8, & + & 3.18488e-01_r8, 3.21386e-01_r8, 3.24310e-01_r8, 3.27261e-01_r8, 3.30239e-01_r8, & + & 3.33244e-01_r8, 3.36276e-01_r8, 3.39336e-01_r8, 3.42424e-01_r8, 3.45540e-01_r8, & + & 3.48684e-01_r8, 3.51857e-01_r8, 3.55059e-01_r8, 3.58289e-01_r8/) + kao_mn2o( 6, :, 9) = (/ & + & 2.98789e-01_r8, 3.00996e-01_r8, 3.03220e-01_r8, 3.05460e-01_r8, 3.07717e-01_r8, & + & 3.09990e-01_r8, 3.12281e-01_r8, 3.14588e-01_r8, 3.16912e-01_r8, 3.19253e-01_r8, & + & 3.21612e-01_r8, 3.23988e-01_r8, 3.26382e-01_r8, 3.28793e-01_r8, 3.31222e-01_r8, & + & 3.33669e-01_r8, 3.36134e-01_r8, 3.38618e-01_r8, 3.41119e-01_r8/) + kao_mn2o( 7, :, 9) = (/ & + & 3.08712e-01_r8, 3.10491e-01_r8, 3.12281e-01_r8, 3.14080e-01_r8, 3.15890e-01_r8, & + & 3.17710e-01_r8, 3.19541e-01_r8, 3.21382e-01_r8, 3.23234e-01_r8, 3.25097e-01_r8, & + & 3.26970e-01_r8, 3.28854e-01_r8, 3.30749e-01_r8, 3.32655e-01_r8, 3.34572e-01_r8, & + & 3.36500e-01_r8, 3.38439e-01_r8, 3.40390e-01_r8, 3.42351e-01_r8/) + kao_mn2o( 8, :, 9) = (/ & + & 3.10571e-01_r8, 3.12262e-01_r8, 3.13961e-01_r8, 3.15670e-01_r8, 3.17388e-01_r8, & + & 3.19115e-01_r8, 3.20852e-01_r8, 3.22598e-01_r8, 3.24354e-01_r8, 3.26120e-01_r8, & + & 3.27895e-01_r8, 3.29679e-01_r8, 3.31474e-01_r8, 3.33278e-01_r8, 3.35092e-01_r8, & + & 3.36915e-01_r8, 3.38749e-01_r8, 3.40593e-01_r8, 3.42447e-01_r8/) + kao_mn2o( 9, :, 9) = (/ & + & 3.16436e-01_r8, 3.18200e-01_r8, 3.19974e-01_r8, 3.21759e-01_r8, 3.23553e-01_r8, & + & 3.25357e-01_r8, 3.27172e-01_r8, 3.28996e-01_r8, 3.30831e-01_r8, 3.32675e-01_r8, & + & 3.34530e-01_r8, 3.36396e-01_r8, 3.38272e-01_r8, 3.40158e-01_r8, 3.42055e-01_r8, & + & 3.43962e-01_r8, 3.45880e-01_r8, 3.47809e-01_r8, 3.49749e-01_r8/) + kao_mn2o( 1, :,10) = (/ & + & 7.68616e-01_r8, 7.63263e-01_r8, 7.57948e-01_r8, 7.52669e-01_r8, 7.47428e-01_r8, & + & 7.42223e-01_r8, 7.37054e-01_r8, 7.31921e-01_r8, 7.26824e-01_r8, 7.21762e-01_r8, & + & 7.16736e-01_r8, 7.11744e-01_r8, 7.06788e-01_r8, 7.01866e-01_r8, 6.96978e-01_r8, & + & 6.92124e-01_r8, 6.87304e-01_r8, 6.82517e-01_r8, 6.77764e-01_r8/) + kao_mn2o( 2, :,10) = (/ & + & 4.97271e-01_r8, 5.10054e-01_r8, 5.23165e-01_r8, 5.36614e-01_r8, 5.50408e-01_r8, & + & 5.64556e-01_r8, 5.79069e-01_r8, 5.93954e-01_r8, 6.09222e-01_r8, 6.24883e-01_r8, & + & 6.40946e-01_r8, 6.57422e-01_r8, 6.74321e-01_r8, 6.91655e-01_r8, 7.09435e-01_r8, & + & 7.27671e-01_r8, 7.46377e-01_r8, 7.65563e-01_r8, 7.85242e-01_r8/) + kao_mn2o( 3, :,10) = (/ & + & 2.44443e-01_r8, 2.47096e-01_r8, 2.49778e-01_r8, 2.52489e-01_r8, 2.55229e-01_r8, & + & 2.57999e-01_r8, 2.60799e-01_r8, 2.63630e-01_r8, 2.66491e-01_r8, 2.69383e-01_r8, & + & 2.72307e-01_r8, 2.75262e-01_r8, 2.78250e-01_r8, 2.81269e-01_r8, 2.84322e-01_r8, & + & 2.87408e-01_r8, 2.90527e-01_r8, 2.93680e-01_r8, 2.96868e-01_r8/) + kao_mn2o( 4, :,10) = (/ & + & 2.01964e-01_r8, 2.02869e-01_r8, 2.03777e-01_r8, 2.04690e-01_r8, 2.05606e-01_r8, & + & 2.06527e-01_r8, 2.07452e-01_r8, 2.08381e-01_r8, 2.09314e-01_r8, 2.10251e-01_r8, & + & 2.11193e-01_r8, 2.12139e-01_r8, 2.13089e-01_r8, 2.14043e-01_r8, 2.15002e-01_r8, & + & 2.15964e-01_r8, 2.16932e-01_r8, 2.17903e-01_r8, 2.18879e-01_r8/) + kao_mn2o( 5, :,10) = (/ & + & 2.56972e-01_r8, 2.56837e-01_r8, 2.56702e-01_r8, 2.56567e-01_r8, 2.56432e-01_r8, & + & 2.56297e-01_r8, 2.56162e-01_r8, 2.56027e-01_r8, 2.55893e-01_r8, 2.55758e-01_r8, & + & 2.55624e-01_r8, 2.55489e-01_r8, 2.55355e-01_r8, 2.55220e-01_r8, 2.55086e-01_r8, & + & 2.54952e-01_r8, 2.54818e-01_r8, 2.54684e-01_r8, 2.54550e-01_r8/) + kao_mn2o( 6, :,10) = (/ & + & 2.57322e-01_r8, 2.57187e-01_r8, 2.57052e-01_r8, 2.56917e-01_r8, 2.56782e-01_r8, & + & 2.56647e-01_r8, 2.56512e-01_r8, 2.56377e-01_r8, 2.56243e-01_r8, 2.56108e-01_r8, & + & 2.55974e-01_r8, 2.55839e-01_r8, 2.55705e-01_r8, 2.55570e-01_r8, 2.55436e-01_r8, & + & 2.55302e-01_r8, 2.55168e-01_r8, 2.55034e-01_r8, 2.54900e-01_r8/) + kao_mn2o( 7, :,10) = (/ & + & 2.56551e-01_r8, 2.56421e-01_r8, 2.56291e-01_r8, 2.56161e-01_r8, 2.56030e-01_r8, & + & 2.55900e-01_r8, 2.55770e-01_r8, 2.55640e-01_r8, 2.55511e-01_r8, 2.55381e-01_r8, & + & 2.55251e-01_r8, 2.55121e-01_r8, 2.54992e-01_r8, 2.54862e-01_r8, 2.54733e-01_r8, & + & 2.54603e-01_r8, 2.54474e-01_r8, 2.54345e-01_r8, 2.54215e-01_r8/) + kao_mn2o( 8, :,10) = (/ & + & 2.73629e-01_r8, 2.73460e-01_r8, 2.73291e-01_r8, 2.73122e-01_r8, 2.72953e-01_r8, & + & 2.72784e-01_r8, 2.72615e-01_r8, 2.72447e-01_r8, 2.72279e-01_r8, 2.72110e-01_r8, & + & 2.71942e-01_r8, 2.71774e-01_r8, 2.71606e-01_r8, 2.71438e-01_r8, 2.71270e-01_r8, & + & 2.71102e-01_r8, 2.70935e-01_r8, 2.70767e-01_r8, 2.70600e-01_r8/) + kao_mn2o( 9, :,10) = (/ & + & 2.57294e-01_r8, 2.57149e-01_r8, 2.57004e-01_r8, 2.56860e-01_r8, 2.56715e-01_r8, & + & 2.56570e-01_r8, 2.56426e-01_r8, 2.56282e-01_r8, 2.56137e-01_r8, 2.55993e-01_r8, & + & 2.55849e-01_r8, 2.55705e-01_r8, 2.55561e-01_r8, 2.55417e-01_r8, 2.55273e-01_r8, & + & 2.55129e-01_r8, 2.54986e-01_r8, 2.54842e-01_r8, 2.54698e-01_r8/) + kao_mn2o( 1, :,11) = (/ & + & 6.91062e-01_r8, 6.84151e-01_r8, 6.77309e-01_r8, 6.70535e-01_r8, 6.63829e-01_r8, & + & 6.57190e-01_r8, 6.50617e-01_r8, 6.44111e-01_r8, 6.37669e-01_r8, 6.31292e-01_r8, & + & 6.24978e-01_r8, 6.18728e-01_r8, 6.12540e-01_r8, 6.06414e-01_r8, 6.00349e-01_r8, & + & 5.94345e-01_r8, 5.88401e-01_r8, 5.82517e-01_r8, 5.76691e-01_r8/) + kao_mn2o( 2, :,11) = (/ & + & 1.98698e-01_r8, 2.01182e-01_r8, 2.03698e-01_r8, 2.06244e-01_r8, 2.08823e-01_r8, & + & 2.11433e-01_r8, 2.14077e-01_r8, 2.16753e-01_r8, 2.19463e-01_r8, 2.22207e-01_r8, & + & 2.24985e-01_r8, 2.27798e-01_r8, 2.30646e-01_r8, 2.33529e-01_r8, 2.36449e-01_r8, & + & 2.39405e-01_r8, 2.42398e-01_r8, 2.45429e-01_r8, 2.48497e-01_r8/) + kao_mn2o( 3, :,11) = (/ & + & 2.11950e-01_r8, 2.13560e-01_r8, 2.15184e-01_r8, 2.16819e-01_r8, 2.18467e-01_r8, & + & 2.20127e-01_r8, 2.21800e-01_r8, 2.23486e-01_r8, 2.25185e-01_r8, 2.26896e-01_r8, & + & 2.28621e-01_r8, 2.30358e-01_r8, 2.32109e-01_r8, 2.33873e-01_r8, 2.35651e-01_r8, & + & 2.37442e-01_r8, 2.39247e-01_r8, 2.41065e-01_r8, 2.42897e-01_r8/) + kao_mn2o( 4, :,11) = (/ & + & 3.14210e-01_r8, 3.13143e-01_r8, 3.12080e-01_r8, 3.11021e-01_r8, 3.09965e-01_r8, & + & 3.08913e-01_r8, 3.07864e-01_r8, 3.06819e-01_r8, 3.05777e-01_r8, 3.04739e-01_r8, & + & 3.03705e-01_r8, 3.02674e-01_r8, 3.01646e-01_r8, 3.00622e-01_r8, 2.99602e-01_r8, & + & 2.98584e-01_r8, 2.97571e-01_r8, 2.96561e-01_r8, 2.95554e-01_r8/) + kao_mn2o( 5, :,11) = (/ & + & 3.13536e-01_r8, 3.12459e-01_r8, 3.11386e-01_r8, 3.10316e-01_r8, 3.09250e-01_r8, & + & 3.08188e-01_r8, 3.07129e-01_r8, 3.06074e-01_r8, 3.05022e-01_r8, 3.03974e-01_r8, & + & 3.02930e-01_r8, 3.01889e-01_r8, 3.00852e-01_r8, 2.99819e-01_r8, 2.98789e-01_r8, & + & 2.97762e-01_r8, 2.96739e-01_r8, 2.95720e-01_r8, 2.94704e-01_r8/) + kao_mn2o( 6, :,11) = (/ & + & 3.13215e-01_r8, 3.12123e-01_r8, 3.11034e-01_r8, 3.09949e-01_r8, 3.08867e-01_r8, & + & 3.07790e-01_r8, 3.06716e-01_r8, 3.05646e-01_r8, 3.04579e-01_r8, 3.03517e-01_r8, & + & 3.02458e-01_r8, 3.01403e-01_r8, 3.00351e-01_r8, 2.99303e-01_r8, 2.98259e-01_r8, & + & 2.97219e-01_r8, 2.96182e-01_r8, 2.95148e-01_r8, 2.94119e-01_r8/) + kao_mn2o( 7, :,11) = (/ & + & 3.14236e-01_r8, 3.13123e-01_r8, 3.12014e-01_r8, 3.10908e-01_r8, 3.09806e-01_r8, & + & 3.08709e-01_r8, 3.07615e-01_r8, 3.06525e-01_r8, 3.05439e-01_r8, 3.04357e-01_r8, & + & 3.03278e-01_r8, 3.02204e-01_r8, 3.01133e-01_r8, 3.00066e-01_r8, 2.99003e-01_r8, & + & 2.97944e-01_r8, 2.96888e-01_r8, 2.95836e-01_r8, 2.94788e-01_r8/) + kao_mn2o( 8, :,11) = (/ & + & 2.97453e-01_r8, 2.96420e-01_r8, 2.95391e-01_r8, 2.94366e-01_r8, 2.93344e-01_r8, & + & 2.92325e-01_r8, 2.91311e-01_r8, 2.90299e-01_r8, 2.89291e-01_r8, 2.88287e-01_r8, & + & 2.87286e-01_r8, 2.86289e-01_r8, 2.85295e-01_r8, 2.84304e-01_r8, 2.83317e-01_r8, & + & 2.82334e-01_r8, 2.81354e-01_r8, 2.80377e-01_r8, 2.79404e-01_r8/) + kao_mn2o( 9, :,11) = (/ & + & 3.12694e-01_r8, 3.11622e-01_r8, 3.10554e-01_r8, 3.09489e-01_r8, 3.08428e-01_r8, & + & 3.07370e-01_r8, 3.06316e-01_r8, 3.05266e-01_r8, 3.04220e-01_r8, 3.03177e-01_r8, & + & 3.02137e-01_r8, 3.01101e-01_r8, 3.00069e-01_r8, 2.99040e-01_r8, 2.98015e-01_r8, & + & 2.96993e-01_r8, 2.95975e-01_r8, 2.94960e-01_r8, 2.93949e-01_r8/) + kao_mn2o( 1, :,12) = (/ & + & 5.30796e-01_r8, 5.50444e-01_r8, 5.70818e-01_r8, 5.91947e-01_r8, 6.13857e-01_r8, & + & 6.36579e-01_r8, 6.60142e-01_r8, 6.84577e-01_r8, 7.09916e-01_r8, 7.36194e-01_r8, & + & 7.63444e-01_r8, 7.91702e-01_r8, 8.21007e-01_r8, 8.51396e-01_r8, 8.82910e-01_r8, & + & 9.15591e-01_r8, 9.49481e-01_r8, 9.84626e-01_r8, 1.02107e+00_r8/) + kao_mn2o( 2, :,12) = (/ & + & 1.38469e-01_r8, 1.40959e-01_r8, 1.43493e-01_r8, 1.46073e-01_r8, 1.48699e-01_r8, & + & 1.51373e-01_r8, 1.54094e-01_r8, 1.56865e-01_r8, 1.59685e-01_r8, 1.62556e-01_r8, & + & 1.65478e-01_r8, 1.68454e-01_r8, 1.71482e-01_r8, 1.74565e-01_r8, 1.77704e-01_r8, & + & 1.80899e-01_r8, 1.84151e-01_r8, 1.87462e-01_r8, 1.90833e-01_r8/) + kao_mn2o( 3, :,12) = (/ & + & 1.50741e-01_r8, 1.50855e-01_r8, 1.50969e-01_r8, 1.51084e-01_r8, 1.51198e-01_r8, & + & 1.51313e-01_r8, 1.51427e-01_r8, 1.51542e-01_r8, 1.51657e-01_r8, 1.51772e-01_r8, & + & 1.51887e-01_r8, 1.52002e-01_r8, 1.52117e-01_r8, 1.52233e-01_r8, 1.52348e-01_r8, & + & 1.52463e-01_r8, 1.52579e-01_r8, 1.52695e-01_r8, 1.52810e-01_r8/) + kao_mn2o( 4, :,12) = (/ & + & 1.80444e-01_r8, 1.79944e-01_r8, 1.79445e-01_r8, 1.78948e-01_r8, 1.78452e-01_r8, & + & 1.77958e-01_r8, 1.77465e-01_r8, 1.76973e-01_r8, 1.76483e-01_r8, 1.75994e-01_r8, & + & 1.75506e-01_r8, 1.75020e-01_r8, 1.74535e-01_r8, 1.74051e-01_r8, 1.73569e-01_r8, & + & 1.73088e-01_r8, 1.72609e-01_r8, 1.72131e-01_r8, 1.71654e-01_r8/) + kao_mn2o( 5, :,12) = (/ & + & 1.80595e-01_r8, 1.80033e-01_r8, 1.79474e-01_r8, 1.78916e-01_r8, 1.78359e-01_r8, & + & 1.77805e-01_r8, 1.77252e-01_r8, 1.76701e-01_r8, 1.76152e-01_r8, 1.75604e-01_r8, & + & 1.75058e-01_r8, 1.74514e-01_r8, 1.73971e-01_r8, 1.73430e-01_r8, 1.72891e-01_r8, & + & 1.72354e-01_r8, 1.71818e-01_r8, 1.71284e-01_r8, 1.70751e-01_r8/) + kao_mn2o( 6, :,12) = (/ & + & 1.79904e-01_r8, 1.79254e-01_r8, 1.78607e-01_r8, 1.77962e-01_r8, 1.77320e-01_r8, & + & 1.76680e-01_r8, 1.76042e-01_r8, 1.75406e-01_r8, 1.74773e-01_r8, 1.74142e-01_r8, & + & 1.73513e-01_r8, 1.72887e-01_r8, 1.72262e-01_r8, 1.71640e-01_r8, 1.71021e-01_r8, & + & 1.70403e-01_r8, 1.69788e-01_r8, 1.69175e-01_r8, 1.68564e-01_r8/) + kao_mn2o( 7, :,12) = (/ & + & 1.78712e-01_r8, 1.77868e-01_r8, 1.77027e-01_r8, 1.76190e-01_r8, 1.75357e-01_r8, & + & 1.74528e-01_r8, 1.73703e-01_r8, 1.72882e-01_r8, 1.72064e-01_r8, 1.71251e-01_r8, & + & 1.70441e-01_r8, 1.69636e-01_r8, 1.68834e-01_r8, 1.68036e-01_r8, 1.67241e-01_r8, & + & 1.66451e-01_r8, 1.65664e-01_r8, 1.64881e-01_r8, 1.64101e-01_r8/) + kao_mn2o( 8, :,12) = (/ & + & 1.72346e-01_r8, 1.70873e-01_r8, 1.69413e-01_r8, 1.67965e-01_r8, 1.66530e-01_r8, & + & 1.65107e-01_r8, 1.63696e-01_r8, 1.62297e-01_r8, 1.60910e-01_r8, 1.59535e-01_r8, & + & 1.58171e-01_r8, 1.56819e-01_r8, 1.55479e-01_r8, 1.54150e-01_r8, 1.52833e-01_r8, & + & 1.51527e-01_r8, 1.50232e-01_r8, 1.48948e-01_r8, 1.47675e-01_r8/) + kao_mn2o( 9, :,12) = (/ & + & 1.80517e-01_r8, 1.79951e-01_r8, 1.79386e-01_r8, 1.78823e-01_r8, 1.78262e-01_r8, & + & 1.77702e-01_r8, 1.77144e-01_r8, 1.76588e-01_r8, 1.76034e-01_r8, 1.75481e-01_r8, & + & 1.74931e-01_r8, 1.74382e-01_r8, 1.73834e-01_r8, 1.73289e-01_r8, 1.72745e-01_r8, & + & 1.72202e-01_r8, 1.71662e-01_r8, 1.71123e-01_r8, 1.70586e-01_r8/) + kao_mn2o( 1, :,13) = (/ & + & 2.41966e-01_r8, 2.50534e-01_r8, 2.59406e-01_r8, 2.68591e-01_r8, 2.78102e-01_r8, & + & 2.87950e-01_r8, 2.98146e-01_r8, 3.08704e-01_r8, 3.19635e-01_r8, 3.30953e-01_r8, & + & 3.42672e-01_r8, 3.54806e-01_r8, 3.67370e-01_r8, 3.80379e-01_r8, 3.93848e-01_r8, & + & 4.07794e-01_r8, 4.22234e-01_r8, 4.37186e-01_r8, 4.52667e-01_r8/) + kao_mn2o( 2, :,13) = (/ & + & 1.54385e-01_r8, 1.54015e-01_r8, 1.53646e-01_r8, 1.53279e-01_r8, 1.52912e-01_r8, & + & 1.52545e-01_r8, 1.52180e-01_r8, 1.51816e-01_r8, 1.51452e-01_r8, 1.51089e-01_r8, & + & 1.50728e-01_r8, 1.50367e-01_r8, 1.50007e-01_r8, 1.49647e-01_r8, 1.49289e-01_r8, & + & 1.48932e-01_r8, 1.48575e-01_r8, 1.48219e-01_r8, 1.47864e-01_r8/) + kao_mn2o( 3, :,13) = (/ & + & 2.00518e-01_r8, 1.94901e-01_r8, 1.89442e-01_r8, 1.84136e-01_r8, 1.78978e-01_r8, & + & 1.73965e-01_r8, 1.69092e-01_r8, 1.64356e-01_r8, 1.59752e-01_r8, 1.55278e-01_r8, & + & 1.50928e-01_r8, 1.46701e-01_r8, 1.42592e-01_r8, 1.38598e-01_r8, 1.34715e-01_r8, & + & 1.30942e-01_r8, 1.27274e-01_r8, 1.23709e-01_r8, 1.20244e-01_r8/) + kao_mn2o( 4, :,13) = (/ & + & 2.03974e-01_r8, 1.98258e-01_r8, 1.92703e-01_r8, 1.87302e-01_r8, 1.82054e-01_r8, & + & 1.76952e-01_r8, 1.71993e-01_r8, 1.67173e-01_r8, 1.62489e-01_r8, 1.57935e-01_r8, & + & 1.53509e-01_r8, 1.49207e-01_r8, 1.45026e-01_r8, 1.40962e-01_r8, 1.37012e-01_r8, & + & 1.33172e-01_r8, 1.29440e-01_r8, 1.25813e-01_r8, 1.22287e-01_r8/) + kao_mn2o( 5, :,13) = (/ & + & 2.09410e-01_r8, 2.03543e-01_r8, 1.97841e-01_r8, 1.92298e-01_r8, 1.86911e-01_r8, & + & 1.81674e-01_r8, 1.76585e-01_r8, 1.71637e-01_r8, 1.66829e-01_r8, 1.62155e-01_r8, & + & 1.57612e-01_r8, 1.53196e-01_r8, 1.48904e-01_r8, 1.44733e-01_r8, 1.40678e-01_r8, & + & 1.36736e-01_r8, 1.32906e-01_r8, 1.29182e-01_r8, 1.25563e-01_r8/) + kao_mn2o( 6, :,13) = (/ & + & 2.19808e-01_r8, 2.13643e-01_r8, 2.07651e-01_r8, 2.01827e-01_r8, 1.96166e-01_r8, & + & 1.90664e-01_r8, 1.85317e-01_r8, 1.80119e-01_r8, 1.75067e-01_r8, 1.70157e-01_r8, & + & 1.65385e-01_r8, 1.60746e-01_r8, 1.56238e-01_r8, 1.51856e-01_r8, 1.47596e-01_r8, & + & 1.43457e-01_r8, 1.39433e-01_r8, 1.35523e-01_r8, 1.31722e-01_r8/) + kao_mn2o( 7, :,13) = (/ & + & 2.47074e-01_r8, 2.40127e-01_r8, 2.33375e-01_r8, 2.26813e-01_r8, 2.20436e-01_r8, & + & 2.14238e-01_r8, 2.08215e-01_r8, 2.02360e-01_r8, 1.96671e-01_r8, 1.91141e-01_r8, & + & 1.85767e-01_r8, 1.80544e-01_r8, 1.75467e-01_r8, 1.70534e-01_r8, 1.65739e-01_r8, & + & 1.61079e-01_r8, 1.56550e-01_r8, 1.52148e-01_r8, 1.47870e-01_r8/) + kao_mn2o( 8, :,13) = (/ & + & 2.55282e-01_r8, 2.48105e-01_r8, 2.41130e-01_r8, 2.34350e-01_r8, 2.27762e-01_r8, & + & 2.21358e-01_r8, 2.15135e-01_r8, 2.09086e-01_r8, 2.03208e-01_r8, 1.97495e-01_r8, & + & 1.91942e-01_r8, 1.86546e-01_r8, 1.81301e-01_r8, 1.76204e-01_r8, 1.71250e-01_r8, & + & 1.66435e-01_r8, 1.61756e-01_r8, 1.57208e-01_r8, 1.52788e-01_r8/) + kao_mn2o( 9, :,13) = (/ & + & 2.09991e-01_r8, 2.04103e-01_r8, 1.98380e-01_r8, 1.92818e-01_r8, 1.87411e-01_r8, & + & 1.82156e-01_r8, 1.77048e-01_r8, 1.72084e-01_r8, 1.67259e-01_r8, 1.62569e-01_r8, & + & 1.58010e-01_r8, 1.53580e-01_r8, 1.49273e-01_r8, 1.45087e-01_r8, 1.41019e-01_r8, & + & 1.37065e-01_r8, 1.33222e-01_r8, 1.29486e-01_r8, 1.25855e-01_r8/) + kao_mn2o( 1, :,14) = (/ & + & 9.08340e-02_r8, 9.50421e-02_r8, 9.94452e-02_r8, 1.04052e-01_r8, 1.08873e-01_r8, & + & 1.13917e-01_r8, 1.19194e-01_r8, 1.24716e-01_r8, 1.30494e-01_r8, 1.36540e-01_r8, & + & 1.42865e-01_r8, 1.49484e-01_r8, 1.56409e-01_r8, 1.63655e-01_r8, 1.71237e-01_r8, & + & 1.79170e-01_r8, 1.87471e-01_r8, 1.96156e-01_r8, 2.05243e-01_r8/) + kao_mn2o( 2, :,14) = (/ & + & 3.36945e-02_r8, 3.45144e-02_r8, 3.53542e-02_r8, 3.62144e-02_r8, 3.70956e-02_r8, & + & 3.79982e-02_r8, 3.89228e-02_r8, 3.98698e-02_r8, 4.08399e-02_r8, 4.18336e-02_r8, & + & 4.28515e-02_r8, 4.38942e-02_r8, 4.49622e-02_r8, 4.60562e-02_r8, 4.71769e-02_r8, & + & 4.83248e-02_r8, 4.95006e-02_r8, 5.07051e-02_r8, 5.19388e-02_r8/) + kao_mn2o( 3, :,14) = (/ & + & 9.11678e-02_r8, 8.85761e-02_r8, 8.60580e-02_r8, 8.36116e-02_r8, 8.12347e-02_r8, & + & 7.89253e-02_r8, 7.66817e-02_r8, 7.45017e-02_r8, 7.23838e-02_r8, 7.03261e-02_r8, & + & 6.83269e-02_r8, 6.63845e-02_r8, 6.44973e-02_r8, 6.26638e-02_r8, 6.08824e-02_r8, & + & 5.91516e-02_r8, 5.74700e-02_r8, 5.58363e-02_r8, 5.42490e-02_r8/) + kao_mn2o( 4, :,14) = (/ & + & 8.43999e-02_r8, 8.20004e-02_r8, 7.96692e-02_r8, 7.74042e-02_r8, 7.52037e-02_r8, & + & 7.30656e-02_r8, 7.09884e-02_r8, 6.89702e-02_r8, 6.70094e-02_r8, 6.51044e-02_r8, & + & 6.32535e-02_r8, 6.14552e-02_r8, 5.97081e-02_r8, 5.80106e-02_r8, 5.63614e-02_r8, & + & 5.47590e-02_r8, 5.32022e-02_r8, 5.16897e-02_r8, 5.02202e-02_r8/) + kao_mn2o( 5, :,14) = (/ & + & 7.41279e-02_r8, 7.20196e-02_r8, 6.99712e-02_r8, 6.79811e-02_r8, 6.60476e-02_r8, & + & 6.41691e-02_r8, 6.23440e-02_r8, 6.05708e-02_r8, 5.88481e-02_r8, 5.71743e-02_r8, & + & 5.55482e-02_r8, 5.39683e-02_r8, 5.24334e-02_r8, 5.09421e-02_r8, 4.94932e-02_r8, & + & 4.80855e-02_r8, 4.67179e-02_r8, 4.53891e-02_r8, 4.40982e-02_r8/) + kao_mn2o( 6, :,14) = (/ & + & 5.66805e-02_r8, 5.50676e-02_r8, 5.35006e-02_r8, 5.19782e-02_r8, 5.04991e-02_r8, & + & 4.90621e-02_r8, 4.76659e-02_r8, 4.63096e-02_r8, 4.49918e-02_r8, 4.37115e-02_r8, & + & 4.24676e-02_r8, 4.12592e-02_r8, 4.00851e-02_r8, 3.89444e-02_r8, 3.78362e-02_r8, & + & 3.67595e-02_r8, 3.57135e-02_r8, 3.46972e-02_r8, 3.37099e-02_r8/) + kao_mn2o( 7, :,14) = (/ & + & 1.23018e-02_r8, 1.19517e-02_r8, 1.16116e-02_r8, 1.12811e-02_r8, 1.09601e-02_r8, & + & 1.06482e-02_r8, 1.03452e-02_r8, 1.00508e-02_r8, 9.76474e-03_r8, 9.48685e-03_r8, & + & 9.21687e-03_r8, 8.95458e-03_r8, 8.69974e-03_r8, 8.45216e-03_r8, 8.21163e-03_r8, & + & 7.97794e-03_r8, 7.75091e-03_r8, 7.53033e-03_r8, 7.31603e-03_r8/) + kao_mn2o( 8, :,14) = (/ & + & 3.22403e-07_r8, 3.75986e-07_r8, 4.38475e-07_r8, 5.11349e-07_r8, 5.96335e-07_r8, & + & 6.95446e-07_r8, 8.11028e-07_r8, 9.45821e-07_r8, 1.10302e-06_r8, 1.28634e-06_r8, & + & 1.50012e-06_r8, 1.74944e-06_r8, 2.04020e-06_r8, 2.37928e-06_r8, 2.77472e-06_r8, & + & 3.23587e-06_r8, 3.77367e-06_r8, 4.40085e-06_r8, 5.13227e-06_r8/) + kao_mn2o( 9, :,14) = (/ & + & 7.33052e-02_r8, 7.12199e-02_r8, 6.91939e-02_r8, 6.72255e-02_r8, 6.53131e-02_r8, & + & 6.34551e-02_r8, 6.16500e-02_r8, 5.98963e-02_r8, 5.81924e-02_r8, 5.65370e-02_r8, & + & 5.49287e-02_r8, 5.33661e-02_r8, 5.18480e-02_r8, 5.03730e-02_r8, 4.89401e-02_r8, & + & 4.75479e-02_r8, 4.61953e-02_r8, 4.48811e-02_r8, 4.36044e-02_r8/) + kao_mn2o( 1, :,15) = (/ & + & 8.80247e-02_r8, 9.01793e-02_r8, 9.23868e-02_r8, 9.46482e-02_r8, 9.69650e-02_r8, & + & 9.93385e-02_r8, 1.01770e-01_r8, 1.04261e-01_r8, 1.06813e-01_r8, 1.09428e-01_r8, & + & 1.12107e-01_r8, 1.14851e-01_r8, 1.17662e-01_r8, 1.20542e-01_r8, 1.23493e-01_r8, & + & 1.26516e-01_r8, 1.29613e-01_r8, 1.32785e-01_r8, 1.36036e-01_r8/) + kao_mn2o( 2, :,15) = (/ & + & 3.89107e-07_r8, 4.53768e-07_r8, 5.29173e-07_r8, 6.17109e-07_r8, 7.19658e-07_r8, & + & 8.39248e-07_r8, 9.78710e-07_r8, 1.14135e-06_r8, 1.33101e-06_r8, 1.55220e-06_r8, & + & 1.81013e-06_r8, 2.11094e-06_r8, 2.46172e-06_r8, 2.87080e-06_r8, 3.34786e-06_r8, & + & 3.90420e-06_r8, 4.55298e-06_r8, 5.30958e-06_r8, 6.19190e-06_r8/) + kao_mn2o( 3, :,15) = (/ & + & 3.86537e-07_r8, 4.50763e-07_r8, 5.25662e-07_r8, 6.13006e-07_r8, 7.14863e-07_r8, & + & 8.33644e-07_r8, 9.72162e-07_r8, 1.13370e-06_r8, 1.32207e-06_r8, 1.54175e-06_r8, & + & 1.79792e-06_r8, 2.09666e-06_r8, 2.44504e-06_r8, 2.85131e-06_r8, 3.32508e-06_r8, & + & 3.87758e-06_r8, 4.52188e-06_r8, 5.27323e-06_r8, 6.14943e-06_r8/) + kao_mn2o( 4, :,15) = (/ & + & 3.81913e-07_r8, 4.45369e-07_r8, 5.19369e-07_r8, 6.05664e-07_r8, 7.06297e-07_r8, & + & 8.23651e-07_r8, 9.60503e-07_r8, 1.12009e-06_r8, 1.30620e-06_r8, 1.52323e-06_r8, & + & 1.77632e-06_r8, 2.07147e-06_r8, 2.41565e-06_r8, 2.81701e-06_r8, 3.28507e-06_r8, & + & 3.83090e-06_r8, 4.46741e-06_r8, 5.20969e-06_r8, 6.07529e-06_r8/) + kao_mn2o( 5, :,15) = (/ & + & 3.77265e-07_r8, 4.39951e-07_r8, 5.13053e-07_r8, 5.98303e-07_r8, 6.97717e-07_r8, & + & 8.13650e-07_r8, 9.48846e-07_r8, 1.10651e-06_r8, 1.29036e-06_r8, 1.50477e-06_r8, & + & 1.75480e-06_r8, 2.04638e-06_r8, 2.38641e-06_r8, 2.78294e-06_r8, 3.24535e-06_r8, & + & 3.78460e-06_r8, 4.41345e-06_r8, 5.14679e-06_r8, 6.00198e-06_r8/) + kao_mn2o( 6, :,15) = (/ & + & 3.77877e-07_r8, 4.40670e-07_r8, 5.13897e-07_r8, 5.99292e-07_r8, 6.98878e-07_r8, & + & 8.15012e-07_r8, 9.50444e-07_r8, 1.10838e-06_r8, 1.29256e-06_r8, 1.50735e-06_r8, & + & 1.75783e-06_r8, 2.04993e-06_r8, 2.39057e-06_r8, 2.78782e-06_r8, 3.25107e-06_r8, & + & 3.79131e-06_r8, 4.42132e-06_r8, 5.15602e-06_r8, 6.01280e-06_r8/) + kao_mn2o( 7, :,15) = (/ & + & 3.80495e-07_r8, 4.43726e-07_r8, 5.17465e-07_r8, 6.03458e-07_r8, 7.03741e-07_r8, & + & 8.20689e-07_r8, 9.57072e-07_r8, 1.11612e-06_r8, 1.30160e-06_r8, 1.51790e-06_r8, & + & 1.77014e-06_r8, 2.06430e-06_r8, 2.40735e-06_r8, 2.80741e-06_r8, 3.27394e-06_r8, & + & 3.81801e-06_r8, 4.45249e-06_r8, 5.19241e-06_r8, 6.05528e-06_r8/) + kao_mn2o( 8, :,15) = (/ & + & 3.87881e-07_r8, 4.52329e-07_r8, 5.27486e-07_r8, 6.15129e-07_r8, 7.17335e-07_r8, & + & 8.36523e-07_r8, 9.75515e-07_r8, 1.13760e-06_r8, 1.32662e-06_r8, 1.54704e-06_r8, & + & 1.80409e-06_r8, 2.10384e-06_r8, 2.45340e-06_r8, 2.86105e-06_r8, 3.33642e-06_r8, & + & 3.89078e-06_r8, 4.53725e-06_r8, 5.29112e-06_r8, 6.17026e-06_r8/) + kao_mn2o( 9, :,15) = (/ & + & 3.77265e-07_r8, 4.39951e-07_r8, 5.13053e-07_r8, 5.98303e-07_r8, 6.97717e-07_r8, & + & 8.13650e-07_r8, 9.48846e-07_r8, 1.10651e-06_r8, 1.29036e-06_r8, 1.50477e-06_r8, & + & 1.75480e-06_r8, 2.04638e-06_r8, 2.38641e-06_r8, 2.78294e-06_r8, 3.24535e-06_r8, & + & 3.78460e-06_r8, 4.41345e-06_r8, 5.14679e-06_r8, 6.00198e-06_r8/) + kao_mn2o( 1, :,16) = (/ & + & 8.84606e-02_r8, 9.05971e-02_r8, 9.27852e-02_r8, 9.50261e-02_r8, 9.73212e-02_r8, & + & 9.96717e-02_r8, 1.02079e-01_r8, 1.04544e-01_r8, 1.07069e-01_r8, 1.09655e-01_r8, & + & 1.12304e-01_r8, 1.15016e-01_r8, 1.17794e-01_r8, 1.20639e-01_r8, 1.23553e-01_r8, & + & 1.26537e-01_r8, 1.29593e-01_r8, 1.32723e-01_r8, 1.35928e-01_r8/) + kao_mn2o( 2, :,16) = (/ & + & 8.13898e-07_r8, 9.49130e-07_r8, 1.10683e-06_r8, 1.29073e-06_r8, 1.50519e-06_r8, & + & 1.75528e-06_r8, 2.04693e-06_r8, 2.38703e-06_r8, 2.78364e-06_r8, 3.24615e-06_r8, & + & 3.78551e-06_r8, 4.41449e-06_r8, 5.14796e-06_r8, 6.00331e-06_r8, 7.00078e-06_r8, & + & 8.16398e-06_r8, 9.52045e-06_r8, 1.11023e-05_r8, 1.29470e-05_r8/) + kao_mn2o( 3, :,16) = (/ & + & 8.32666e-07_r8, 9.71021e-07_r8, 1.13237e-06_r8, 1.32052e-06_r8, 1.53994e-06_r8, & + & 1.79581e-06_r8, 2.09420e-06_r8, 2.44217e-06_r8, 2.84796e-06_r8, 3.32117e-06_r8, & + & 3.87302e-06_r8, 4.51656e-06_r8, 5.26703e-06_r8, 6.14219e-06_r8, 7.16277e-06_r8, & + & 8.35294e-06_r8, 9.74086e-06_r8, 1.13594e-05_r8, 1.32468e-05_r8/) + kao_mn2o( 4, :,16) = (/ & + & 8.70348e-07_r8, 1.01496e-06_r8, 1.18360e-06_r8, 1.38026e-06_r8, 1.60959e-06_r8, & + & 1.87703e-06_r8, 2.18890e-06_r8, 2.55259e-06_r8, 2.97671e-06_r8, 3.47130e-06_r8, & + & 4.04807e-06_r8, 4.72067e-06_r8, 5.50502e-06_r8, 6.41970e-06_r8, 7.48635e-06_r8, & + & 8.73023e-06_r8, 1.01808e-05_r8, 1.18724e-05_r8, 1.38450e-05_r8/) + kao_mn2o( 5, :,16) = (/ & + & 9.07957e-07_r8, 1.05882e-06_r8, 1.23475e-06_r8, 1.43991e-06_r8, 1.67916e-06_r8, & + & 1.95816e-06_r8, 2.28352e-06_r8, 2.66294e-06_r8, 3.10541e-06_r8, 3.62139e-06_r8, & + & 4.22310e-06_r8, 4.92480e-06_r8, 5.74308e-06_r8, 6.69733e-06_r8, 7.81013e-06_r8, & + & 9.10784e-06_r8, 1.06212e-05_r8, 1.23859e-05_r8, 1.44439e-05_r8/) + kao_mn2o( 6, :,16) = (/ & + & 8.59072e-04_r8, 9.19773e-04_r8, 9.84764e-04_r8, 1.05435e-03_r8, 1.12885e-03_r8, & + & 1.20861e-03_r8, 1.29401e-03_r8, 1.38544e-03_r8, 1.48334e-03_r8, 1.58815e-03_r8, & + & 1.70037e-03_r8, 1.82052e-03_r8, 1.94915e-03_r8, 2.08688e-03_r8, 2.23434e-03_r8, & + & 2.39222e-03_r8, 2.56125e-03_r8, 2.74223e-03_r8, 2.93599e-03_r8/) + kao_mn2o( 7, :,16) = (/ & + & 9.17294e-07_r8, 1.06971e-06_r8, 1.24746e-06_r8, 1.45474e-06_r8, 1.69646e-06_r8, & + & 1.97835e-06_r8, 2.30708e-06_r8, 2.69043e-06_r8, 3.13748e-06_r8, 3.65880e-06_r8, & + & 4.26676e-06_r8, 4.97574e-06_r8, 5.80251e-06_r8, 6.76667e-06_r8, 7.89104e-06_r8, & + & 9.20223e-06_r8, 1.07313e-05_r8, 1.25144e-05_r8, 1.45939e-05_r8/) + kao_mn2o( 8, :,16) = (/ & + & 9.17341e-07_r8, 1.06977e-06_r8, 1.24752e-06_r8, 1.45480e-06_r8, 1.69653e-06_r8, & + & 1.97843e-06_r8, 2.30716e-06_r8, 2.69051e-06_r8, 3.13757e-06_r8, 3.65890e-06_r8, & + & 4.26686e-06_r8, 4.97584e-06_r8, 5.80261e-06_r8, 6.76677e-06_r8, 7.89113e-06_r8, & + & 9.20231e-06_r8, 1.07314e-05_r8, 1.25145e-05_r8, 1.45939e-05_r8/) + kao_mn2o( 9, :,16) = (/ & + & 9.07957e-07_r8, 1.05882e-06_r8, 1.23475e-06_r8, 1.43991e-06_r8, 1.67916e-06_r8, & + & 1.95816e-06_r8, 2.28352e-06_r8, 2.66294e-06_r8, 3.10541e-06_r8, 3.62139e-06_r8, & + & 4.22310e-06_r8, 4.92480e-06_r8, 5.74308e-06_r8, 6.69733e-06_r8, 7.81013e-06_r8, & + & 9.10784e-06_r8, 1.06212e-05_r8, 1.23859e-05_r8, 1.44439e-05_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amounts ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 to +! that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kbo_mn2o( 1, :, 1) = (/ & + & 7.72009e-08_r8, 1.15883e-07_r8, 1.73947e-07_r8, 2.61104e-07_r8, 3.91932e-07_r8, & + & 5.88311e-07_r8, 8.83088e-07_r8, 1.32556e-06_r8, 1.98975e-06_r8, 2.98672e-06_r8, & + & 4.48324e-06_r8, 6.72960e-06_r8, 1.01015e-05_r8, 1.51629e-05_r8, 2.27604e-05_r8, & + & 3.41646e-05_r8, 5.12831e-05_r8, 7.69787e-05_r8, 1.15549e-04_r8/) + kbo_mn2o( 2, :, 1) = (/ & + & 1.29932e-05_r8, 1.78207e-05_r8, 2.44419e-05_r8, 3.35232e-05_r8, 4.59786e-05_r8, & + & 6.30617e-05_r8, 8.64920e-05_r8, 1.18628e-04_r8, 1.62703e-04_r8, 2.23155e-04_r8, & + & 3.06067e-04_r8, 4.19784e-04_r8, 5.75753e-04_r8, 7.89671e-04_r8, 1.08307e-03_r8, & + & 1.48548e-03_r8, 2.03740e-03_r8, 2.79439e-03_r8, 3.83262e-03_r8/) + kbo_mn2o( 3, :, 1) = (/ & + & 6.44518e-05_r8, 8.10996e-05_r8, 1.02047e-04_r8, 1.28406e-04_r8, 1.61573e-04_r8, & + & 2.03307e-04_r8, 2.55821e-04_r8, 3.21899e-04_r8, 4.05045e-04_r8, 5.09667e-04_r8, & + & 6.41313e-04_r8, 8.06964e-04_r8, 1.01540e-03_r8, 1.27768e-03_r8, 1.60770e-03_r8, & + & 2.02296e-03_r8, 2.54549e-03_r8, 3.20298e-03_r8, 4.03031e-03_r8/) + kbo_mn2o( 4, :, 1) = (/ & + & 3.23454e-04_r8, 3.82112e-04_r8, 4.51408e-04_r8, 5.33270e-04_r8, 6.29978e-04_r8, & + & 7.44223e-04_r8, 8.79187e-04_r8, 1.03863e-03_r8, 1.22698e-03_r8, 1.44949e-03_r8, & + & 1.71235e-03_r8, 2.02289e-03_r8, 2.38974e-03_r8, 2.82311e-03_r8, 3.33508e-03_r8, & + & 3.93989e-03_r8, 4.65439e-03_r8, 5.49845e-03_r8, 6.49558e-03_r8/) + kbo_mn2o( 5, :, 1) = (/ & + & 1.45978e-04_r8, 1.75646e-04_r8, 2.11344e-04_r8, 2.54296e-04_r8, 3.05978e-04_r8, & + & 3.68163e-04_r8, 4.42986e-04_r8, 5.33017e-04_r8, 6.41344e-04_r8, 7.71687e-04_r8, & + & 9.28522e-04_r8, 1.11723e-03_r8, 1.34429e-03_r8, 1.61750e-03_r8, 1.94623e-03_r8, & + & 2.34177e-03_r8, 2.81770e-03_r8, 3.39035e-03_r8, 4.07939e-03_r8/) + kbo_mn2o( 1, :, 2) = (/ & + & 1.94527e-04_r8, 2.38609e-04_r8, 2.92680e-04_r8, 3.59005e-04_r8, 4.40360e-04_r8, & + & 5.40150e-04_r8, 6.62554e-04_r8, 8.12697e-04_r8, 9.96864e-04_r8, 1.22276e-03_r8, & + & 1.49986e-03_r8, 1.83974e-03_r8, 2.25665e-03_r8, 2.76803e-03_r8, 3.39530e-03_r8, & + & 4.16472e-03_r8, 5.10849e-03_r8, 6.26613e-03_r8, 7.68611e-03_r8/) + kbo_mn2o( 2, :, 2) = (/ & + & 7.49615e-04_r8, 8.82716e-04_r8, 1.03945e-03_r8, 1.22401e-03_r8, 1.44135e-03_r8, & + & 1.69727e-03_r8, 1.99863e-03_r8, 2.35351e-03_r8, 2.77139e-03_r8, 3.26347e-03_r8, & + & 3.84293e-03_r8, 4.52528e-03_r8, 5.32878e-03_r8, 6.27495e-03_r8, 7.38911e-03_r8, & + & 8.70111e-03_r8, 1.02461e-02_r8, 1.20653e-02_r8, 1.42076e-02_r8/) + kbo_mn2o( 3, :, 2) = (/ & + & 1.39162e-03_r8, 1.59859e-03_r8, 1.83634e-03_r8, 2.10946e-03_r8, 2.42319e-03_r8, & + & 2.78358e-03_r8, 3.19758e-03_r8, 3.67314e-03_r8, 4.21944e-03_r8, 4.84698e-03_r8, & + & 5.56786e-03_r8, 6.39595e-03_r8, 7.34720e-03_r8, 8.43992e-03_r8, 9.69516e-03_r8, & + & 1.11371e-02_r8, 1.27935e-02_r8, 1.46962e-02_r8, 1.68819e-02_r8/) + kbo_mn2o( 4, :, 2) = (/ & + & 2.42354e-03_r8, 2.73623e-03_r8, 3.08926e-03_r8, 3.48783e-03_r8, 3.93783e-03_r8, & + & 4.44589e-03_r8, 5.01950e-03_r8, 5.66712e-03_r8, 6.39829e-03_r8, 7.22379e-03_r8, & + & 8.15581e-03_r8, 9.20807e-03_r8, 1.03961e-02_r8, 1.17374e-02_r8, 1.32517e-02_r8, & + & 1.49615e-02_r8, 1.68918e-02_r8, 1.90712e-02_r8, 2.15318e-02_r8/) + kbo_mn2o( 5, :, 2) = (/ & + & 1.39908e-03_r8, 1.59133e-03_r8, 1.81000e-03_r8, 2.05872e-03_r8, 2.34161e-03_r8, & + & 2.66338e-03_r8, 3.02937e-03_r8, 3.44564e-03_r8, 3.91912e-03_r8, 4.45766e-03_r8, & + & 5.07021e-03_r8, 5.76693e-03_r8, 6.55938e-03_r8, 7.46073e-03_r8, 8.48594e-03_r8, & + & 9.65202e-03_r8, 1.09783e-02_r8, 1.24869e-02_r8, 1.42028e-02_r8/) + kbo_mn2o( 1, :, 3) = (/ & + & 8.74797e-03_r8, 9.66828e-03_r8, 1.06854e-02_r8, 1.18095e-02_r8, 1.30519e-02_r8, & + & 1.44250e-02_r8, 1.59426e-02_r8, 1.76198e-02_r8, 1.94735e-02_r8, 2.15221e-02_r8, & + & 2.37863e-02_r8, 2.62887e-02_r8, 2.90544e-02_r8, 3.21110e-02_r8, 3.54891e-02_r8, & + & 3.92227e-02_r8, 4.33491e-02_r8, 4.79095e-02_r8, 5.29497e-02_r8/) + kbo_mn2o( 2, :, 3) = (/ & + & 1.43974e-02_r8, 1.56118e-02_r8, 1.69286e-02_r8, 1.83564e-02_r8, 1.99047e-02_r8, & + & 2.15836e-02_r8, 2.34041e-02_r8, 2.53781e-02_r8, 2.75187e-02_r8, 2.98397e-02_r8, & + & 3.23566e-02_r8, 3.50857e-02_r8, 3.80451e-02_r8, 4.12540e-02_r8, 4.47336e-02_r8, & + & 4.85067e-02_r8, 5.25980e-02_r8, 5.70344e-02_r8, 6.18450e-02_r8/) + kbo_mn2o( 3, :, 3) = (/ & + & 1.83051e-02_r8, 1.96851e-02_r8, 2.11692e-02_r8, 2.27651e-02_r8, 2.44813e-02_r8, & + & 2.63270e-02_r8, 2.83117e-02_r8, 3.04461e-02_r8, 3.27414e-02_r8, 3.52097e-02_r8, & + & 3.78642e-02_r8, 4.07187e-02_r8, 4.37884e-02_r8, 4.70896e-02_r8, 5.06396e-02_r8, & + & 5.44573e-02_r8, 5.85628e-02_r8, 6.29777e-02_r8, 6.77256e-02_r8/) + kbo_mn2o( 4, :, 3) = (/ & + & 2.81258e-02_r8, 2.97806e-02_r8, 3.15328e-02_r8, 3.33880e-02_r8, 3.53524e-02_r8, & + & 3.74324e-02_r8, 3.96348e-02_r8, 4.19667e-02_r8, 4.44358e-02_r8, 4.70502e-02_r8, & + & 4.98185e-02_r8, 5.27496e-02_r8, 5.58531e-02_r8, 5.91393e-02_r8, 6.26187e-02_r8, & + & 6.63030e-02_r8, 7.02039e-02_r8, 7.43344e-02_r8, 7.87079e-02_r8/) + kbo_mn2o( 5, :, 3) = (/ & + & 8.82958e-03_r8, 9.53842e-03_r8, 1.03042e-02_r8, 1.11314e-02_r8, 1.20250e-02_r8, & + & 1.29904e-02_r8, 1.40333e-02_r8, 1.51599e-02_r8, 1.63769e-02_r8, 1.76917e-02_r8, & + & 1.91120e-02_r8, 2.06463e-02_r8, 2.23038e-02_r8, 2.40944e-02_r8, 2.60287e-02_r8, & + & 2.81183e-02_r8, 3.03757e-02_r8, 3.28142e-02_r8, 3.54486e-02_r8/) + kbo_mn2o( 1, :, 4) = (/ & + & 1.18673e-01_r8, 1.22983e-01_r8, 1.27449e-01_r8, 1.32077e-01_r8, 1.36874e-01_r8, & + & 1.41845e-01_r8, 1.46996e-01_r8, 1.52334e-01_r8, 1.57866e-01_r8, 1.63599e-01_r8, & + & 1.69541e-01_r8, 1.75698e-01_r8, 1.82078e-01_r8, 1.88691e-01_r8, 1.95543e-01_r8, & + & 2.02645e-01_r8, 2.10004e-01_r8, 2.17631e-01_r8, 2.25534e-01_r8/) + kbo_mn2o( 2, :, 4) = (/ & + & 1.32161e-01_r8, 1.36550e-01_r8, 1.41084e-01_r8, 1.45769e-01_r8, 1.50610e-01_r8, & + & 1.55611e-01_r8, 1.60779e-01_r8, 1.66118e-01_r8, 1.71634e-01_r8, 1.77334e-01_r8, & + & 1.83223e-01_r8, 1.89307e-01_r8, 1.95594e-01_r8, 2.02089e-01_r8, 2.08800e-01_r8, & + & 2.15734e-01_r8, 2.22898e-01_r8, 2.30300e-01_r8, 2.37947e-01_r8/) + kbo_mn2o( 3, :, 4) = (/ & + & 1.44384e-01_r8, 1.48820e-01_r8, 1.53392e-01_r8, 1.58104e-01_r8, 1.62962e-01_r8, & + & 1.67968e-01_r8, 1.73128e-01_r8, 1.78447e-01_r8, 1.83929e-01_r8, 1.89580e-01_r8, & + & 1.95404e-01_r8, 2.01407e-01_r8, 2.07594e-01_r8, 2.13972e-01_r8, 2.20546e-01_r8, & + & 2.27321e-01_r8, 2.34305e-01_r8, 2.41503e-01_r8, 2.48922e-01_r8/) + kbo_mn2o( 4, :, 4) = (/ & + & 1.58026e-01_r8, 1.62626e-01_r8, 1.67360e-01_r8, 1.72232e-01_r8, 1.77245e-01_r8, & + & 1.82405e-01_r8, 1.87714e-01_r8, 1.93179e-01_r8, 1.98802e-01_r8, 2.04589e-01_r8, & + & 2.10544e-01_r8, 2.16673e-01_r8, 2.22980e-01_r8, 2.29471e-01_r8, 2.36151e-01_r8, & + & 2.43025e-01_r8, 2.50100e-01_r8, 2.57380e-01_r8, 2.64872e-01_r8/) + kbo_mn2o( 5, :, 4) = (/ & + & 4.04885e-02_r8, 4.16064e-02_r8, 4.27551e-02_r8, 4.39355e-02_r8, 4.51485e-02_r8, & + & 4.63950e-02_r8, 4.76759e-02_r8, 4.89921e-02_r8, 5.03448e-02_r8, 5.17347e-02_r8, & + & 5.31630e-02_r8, 5.46308e-02_r8, 5.61391e-02_r8, 5.76890e-02_r8, 5.92817e-02_r8, & + & 6.09184e-02_r8, 6.26003e-02_r8, 6.43286e-02_r8, 6.61047e-02_r8/) + kbo_mn2o( 1, :, 5) = (/ & + & 3.97757e-01_r8, 4.01082e-01_r8, 4.04434e-01_r8, 4.07814e-01_r8, 4.11223e-01_r8, & + & 4.14659e-01_r8, 4.18125e-01_r8, 4.21620e-01_r8, 4.25144e-01_r8, 4.28697e-01_r8, & + & 4.32280e-01_r8, 4.35893e-01_r8, 4.39536e-01_r8, 4.43209e-01_r8, 4.46913e-01_r8, & + & 4.50649e-01_r8, 4.54415e-01_r8, 4.58213e-01_r8, 4.62043e-01_r8/) + kbo_mn2o( 2, :, 5) = (/ & + & 3.99425e-01_r8, 4.02035e-01_r8, 4.04662e-01_r8, 4.07306e-01_r8, 4.09968e-01_r8, & + & 4.12647e-01_r8, 4.15343e-01_r8, 4.18057e-01_r8, 4.20789e-01_r8, 4.23539e-01_r8, & + & 4.26307e-01_r8, 4.29092e-01_r8, 4.31896e-01_r8, 4.34719e-01_r8, 4.37559e-01_r8, & + & 4.40419e-01_r8, 4.43296e-01_r8, 4.46193e-01_r8, 4.49109e-01_r8/) + kbo_mn2o( 3, :, 5) = (/ & + & 4.00527e-01_r8, 4.02848e-01_r8, 4.05182e-01_r8, 4.07530e-01_r8, 4.09892e-01_r8, & + & 4.12267e-01_r8, 4.14656e-01_r8, 4.17058e-01_r8, 4.19475e-01_r8, 4.21906e-01_r8, & + & 4.24351e-01_r8, 4.26809e-01_r8, 4.29283e-01_r8, 4.31770e-01_r8, 4.34272e-01_r8, & + & 4.36788e-01_r8, 4.39319e-01_r8, 4.41865e-01_r8, 4.44426e-01_r8/) + kbo_mn2o( 4, :, 5) = (/ & + & 4.11455e-01_r8, 4.13077e-01_r8, 4.14705e-01_r8, 4.16340e-01_r8, 4.17981e-01_r8, & + & 4.19629e-01_r8, 4.21283e-01_r8, 4.22944e-01_r8, 4.24611e-01_r8, 4.26285e-01_r8, & + & 4.27966e-01_r8, 4.29653e-01_r8, 4.31346e-01_r8, 4.33047e-01_r8, 4.34754e-01_r8, & + & 4.36468e-01_r8, 4.38188e-01_r8, 4.39916e-01_r8, 4.41650e-01_r8/) + kbo_mn2o( 5, :, 5) = (/ & + & 8.65576e-02_r8, 8.83622e-02_r8, 9.02044e-02_r8, 9.20850e-02_r8, 9.40049e-02_r8, & + & 9.59647e-02_r8, 9.79655e-02_r8, 1.00008e-01_r8, 1.02093e-01_r8, 1.04221e-01_r8, & + & 1.06394e-01_r8, 1.08612e-01_r8, 1.10877e-01_r8, 1.13188e-01_r8, 1.15548e-01_r8, & + & 1.17957e-01_r8, 1.20417e-01_r8, 1.22927e-01_r8, 1.25490e-01_r8/) + kbo_mn2o( 1, :, 6) = (/ & + & 6.98675e-01_r8, 7.00999e-01_r8, 7.03331e-01_r8, 7.05671e-01_r8, 7.08019e-01_r8, & + & 7.10375e-01_r8, 7.12738e-01_r8, 7.15110e-01_r8, 7.17489e-01_r8, 7.19876e-01_r8, & + & 7.22271e-01_r8, 7.24674e-01_r8, 7.27085e-01_r8, 7.29504e-01_r8, 7.31931e-01_r8, & + & 7.34366e-01_r8, 7.36809e-01_r8, 7.39261e-01_r8, 7.41720e-01_r8/) + kbo_mn2o( 2, :, 6) = (/ & + & 6.98858e-01_r8, 7.01424e-01_r8, 7.03999e-01_r8, 7.06583e-01_r8, 7.09177e-01_r8, & + & 7.11780e-01_r8, 7.14393e-01_r8, 7.17016e-01_r8, 7.19648e-01_r8, 7.22289e-01_r8, & + & 7.24941e-01_r8, 7.27602e-01_r8, 7.30273e-01_r8, 7.32954e-01_r8, 7.35644e-01_r8, & + & 7.38345e-01_r8, 7.41055e-01_r8, 7.43775e-01_r8, 7.46506e-01_r8/) + kbo_mn2o( 3, :, 6) = (/ & + & 7.08151e-01_r8, 7.10727e-01_r8, 7.13311e-01_r8, 7.15905e-01_r8, 7.18508e-01_r8, & + & 7.21121e-01_r8, 7.23743e-01_r8, 7.26375e-01_r8, 7.29017e-01_r8, 7.31668e-01_r8, & + & 7.34329e-01_r8, 7.36999e-01_r8, 7.39679e-01_r8, 7.42369e-01_r8, 7.45068e-01_r8, & + & 7.47778e-01_r8, 7.50497e-01_r8, 7.53226e-01_r8, 7.55965e-01_r8/) + kbo_mn2o( 4, :, 6) = (/ & + & 7.22269e-01_r8, 7.24981e-01_r8, 7.27704e-01_r8, 7.30437e-01_r8, 7.33180e-01_r8, & + & 7.35933e-01_r8, 7.38697e-01_r8, 7.41471e-01_r8, 7.44256e-01_r8, 7.47051e-01_r8, & + & 7.49856e-01_r8, 7.52672e-01_r8, 7.55499e-01_r8, 7.58336e-01_r8, 7.61184e-01_r8, & + & 7.64043e-01_r8, 7.66912e-01_r8, 7.69792e-01_r8, 7.72683e-01_r8/) + kbo_mn2o( 5, :, 6) = (/ & + & 1.75877e-01_r8, 1.78578e-01_r8, 1.81321e-01_r8, 1.84107e-01_r8, 1.86935e-01_r8, & + & 1.89806e-01_r8, 1.92722e-01_r8, 1.95682e-01_r8, 1.98688e-01_r8, 2.01740e-01_r8, & + & 2.04839e-01_r8, 2.07986e-01_r8, 2.11181e-01_r8, 2.14425e-01_r8, 2.17719e-01_r8, & + & 2.21063e-01_r8, 2.24459e-01_r8, 2.27907e-01_r8, 2.31408e-01_r8/) + kbo_mn2o( 1, :, 7) = (/ & + & 1.82985e+00_r8, 1.83684e+00_r8, 1.84386e+00_r8, 1.85091e+00_r8, 1.85798e+00_r8, & + & 1.86508e+00_r8, 1.87221e+00_r8, 1.87937e+00_r8, 1.88655e+00_r8, 1.89376e+00_r8, & + & 1.90100e+00_r8, 1.90827e+00_r8, 1.91556e+00_r8, 1.92288e+00_r8, 1.93023e+00_r8, & + & 1.93761e+00_r8, 1.94502e+00_r8, 1.95245e+00_r8, 1.95991e+00_r8/) + kbo_mn2o( 2, :, 7) = (/ & + & 1.83229e+00_r8, 1.83943e+00_r8, 1.84659e+00_r8, 1.85379e+00_r8, 1.86100e+00_r8, & + & 1.86825e+00_r8, 1.87553e+00_r8, 1.88283e+00_r8, 1.89016e+00_r8, 1.89753e+00_r8, & + & 1.90492e+00_r8, 1.91233e+00_r8, 1.91978e+00_r8, 1.92726e+00_r8, 1.93476e+00_r8, & + & 1.94230e+00_r8, 1.94986e+00_r8, 1.95746e+00_r8, 1.96508e+00_r8/) + kbo_mn2o( 3, :, 7) = (/ & + & 1.84946e+00_r8, 1.85707e+00_r8, 1.86471e+00_r8, 1.87238e+00_r8, 1.88008e+00_r8, & + & 1.88781e+00_r8, 1.89558e+00_r8, 1.90338e+00_r8, 1.91120e+00_r8, 1.91907e+00_r8, & + & 1.92696e+00_r8, 1.93489e+00_r8, 1.94285e+00_r8, 1.95084e+00_r8, 1.95886e+00_r8, & + & 1.96692e+00_r8, 1.97501e+00_r8, 1.98313e+00_r8, 1.99129e+00_r8/) + kbo_mn2o( 4, :, 7) = (/ & + & 1.88354e+00_r8, 1.89167e+00_r8, 1.89983e+00_r8, 1.90803e+00_r8, 1.91626e+00_r8, & + & 1.92453e+00_r8, 1.93283e+00_r8, 1.94117e+00_r8, 1.94955e+00_r8, 1.95796e+00_r8, & + & 1.96641e+00_r8, 1.97489e+00_r8, 1.98341e+00_r8, 1.99197e+00_r8, 2.00056e+00_r8, & + & 2.00920e+00_r8, 2.01787e+00_r8, 2.02657e+00_r8, 2.03532e+00_r8/) + kbo_mn2o( 5, :, 7) = (/ & + & 3.35154e-01_r8, 3.43258e-01_r8, 3.51557e-01_r8, 3.60058e-01_r8, 3.68764e-01_r8, & + & 3.77680e-01_r8, 3.86812e-01_r8, 3.96164e-01_r8, 4.05743e-01_r8, 4.15553e-01_r8, & + & 4.25601e-01_r8, 4.35892e-01_r8, 4.46431e-01_r8, 4.57225e-01_r8, 4.68280e-01_r8, & + & 4.79603e-01_r8, 4.91199e-01_r8, 5.03075e-01_r8, 5.15239e-01_r8/) + kbo_mn2o( 1, :, 8) = (/ & + & 4.46843e+00_r8, 4.49793e+00_r8, 4.52763e+00_r8, 4.55752e+00_r8, 4.58761e+00_r8, & + & 4.61790e+00_r8, 4.64839e+00_r8, 4.67908e+00_r8, 4.70997e+00_r8, 4.74106e+00_r8, & + & 4.77236e+00_r8, 4.80387e+00_r8, 4.83559e+00_r8, 4.86751e+00_r8, 4.89965e+00_r8, & + & 4.93200e+00_r8, 4.96456e+00_r8, 4.99733e+00_r8, 5.03033e+00_r8/) + kbo_mn2o( 2, :, 8) = (/ & + & 4.44347e+00_r8, 4.47278e+00_r8, 4.50228e+00_r8, 4.53198e+00_r8, 4.56188e+00_r8, & + & 4.59197e+00_r8, 4.62227e+00_r8, 4.65276e+00_r8, 4.68345e+00_r8, 4.71435e+00_r8, & + & 4.74544e+00_r8, 4.77675e+00_r8, 4.80826e+00_r8, 4.83998e+00_r8, 4.87191e+00_r8, & + & 4.90405e+00_r8, 4.93640e+00_r8, 4.96896e+00_r8, 5.00174e+00_r8/) + kbo_mn2o( 3, :, 8) = (/ & + & 4.43138e+00_r8, 4.46017e+00_r8, 4.48916e+00_r8, 4.51834e+00_r8, 4.54770e+00_r8, & + & 4.57725e+00_r8, 4.60700e+00_r8, 4.63694e+00_r8, 4.66708e+00_r8, 4.69741e+00_r8, & + & 4.72793e+00_r8, 4.75866e+00_r8, 4.78958e+00_r8, 4.82071e+00_r8, 4.85204e+00_r8, & + & 4.88357e+00_r8, 4.91531e+00_r8, 4.94725e+00_r8, 4.97941e+00_r8/) + kbo_mn2o( 4, :, 8) = (/ & + & 4.47437e+00_r8, 4.50396e+00_r8, 4.53375e+00_r8, 4.56374e+00_r8, 4.59392e+00_r8, & + & 4.62431e+00_r8, 4.65490e+00_r8, 4.68569e+00_r8, 4.71668e+00_r8, 4.74788e+00_r8, & + & 4.77928e+00_r8, 4.81089e+00_r8, 4.84271e+00_r8, 4.87474e+00_r8, 4.90698e+00_r8, & + & 4.93944e+00_r8, 4.97211e+00_r8, 5.00500e+00_r8, 5.03810e+00_r8/) + kbo_mn2o( 5, :, 8) = (/ & + & 8.82838e-01_r8, 8.92257e-01_r8, 9.01777e-01_r8, 9.11398e-01_r8, 9.21122e-01_r8, & + & 9.30950e-01_r8, 9.40883e-01_r8, 9.50921e-01_r8, 9.61067e-01_r8, 9.71321e-01_r8, & + & 9.81685e-01_r8, 9.92159e-01_r8, 1.00274e+00_r8, 1.01344e+00_r8, 1.02426e+00_r8, & + & 1.03518e+00_r8, 1.04623e+00_r8, 1.05739e+00_r8, 1.06867e+00_r8/) + kbo_mn2o( 1, :, 9) = (/ & + & 7.92826e+00_r8, 7.83168e+00_r8, 7.73628e+00_r8, 7.64204e+00_r8, 7.54895e+00_r8, & + & 7.45699e+00_r8, 7.36616e+00_r8, 7.27643e+00_r8, 7.18779e+00_r8, 7.10023e+00_r8, & + & 7.01374e+00_r8, 6.92831e+00_r8, 6.84391e+00_r8, 6.76054e+00_r8, 6.67819e+00_r8, & + & 6.59684e+00_r8, 6.51648e+00_r8, 6.43710e+00_r8, 6.35869e+00_r8/) + kbo_mn2o( 2, :, 9) = (/ & + & 7.89244e+00_r8, 7.79570e+00_r8, 7.70014e+00_r8, 7.60576e+00_r8, 7.51253e+00_r8, & + & 7.42045e+00_r8, 7.32949e+00_r8, 7.23965e+00_r8, 7.15091e+00_r8, 7.06325e+00_r8, & + & 6.97668e+00_r8, 6.89116e+00_r8, 6.80669e+00_r8, 6.72326e+00_r8, 6.64085e+00_r8, & + & 6.55945e+00_r8, 6.47904e+00_r8, 6.39963e+00_r8, 6.32118e+00_r8/) + kbo_mn2o( 3, :, 9) = (/ & + & 7.79799e+00_r8, 7.70076e+00_r8, 7.60474e+00_r8, 7.50991e+00_r8, 7.41627e+00_r8, & + & 7.32379e+00_r8, 7.23247e+00_r8, 7.14229e+00_r8, 7.05323e+00_r8, 6.96528e+00_r8, & + & 6.87843e+00_r8, 6.79266e+00_r8, 6.70797e+00_r8, 6.62432e+00_r8, 6.54172e+00_r8, & + & 6.46015e+00_r8, 6.37960e+00_r8, 6.30005e+00_r8, 6.22150e+00_r8/) + kbo_mn2o( 4, :, 9) = (/ & + & 7.53750e+00_r8, 7.43715e+00_r8, 7.33814e+00_r8, 7.24045e+00_r8, 7.14406e+00_r8, & + & 7.04895e+00_r8, 6.95510e+00_r8, 6.86251e+00_r8, 6.77115e+00_r8, 6.68101e+00_r8, & + & 6.59206e+00_r8, 6.50430e+00_r8, 6.41771e+00_r8, 6.33227e+00_r8, 6.24797e+00_r8, & + & 6.16479e+00_r8, 6.08272e+00_r8, 6.00174e+00_r8, 5.92184e+00_r8/) + kbo_mn2o( 5, :, 9) = (/ & + & 5.06319e+00_r8, 5.08595e+00_r8, 5.10881e+00_r8, 5.13177e+00_r8, 5.15483e+00_r8, & + & 5.17800e+00_r8, 5.20127e+00_r8, 5.22464e+00_r8, 5.24813e+00_r8, 5.27171e+00_r8, & + & 5.29540e+00_r8, 5.31920e+00_r8, 5.34311e+00_r8, 5.36712e+00_r8, 5.39124e+00_r8, & + & 5.41547e+00_r8, 5.43981e+00_r8, 5.46426e+00_r8, 5.48882e+00_r8/) + kbo_mn2o( 1, :,10) = (/ & + & 1.05265e+00_r8, 1.03986e+00_r8, 1.02723e+00_r8, 1.01475e+00_r8, 1.00243e+00_r8, & + & 9.90250e-01_r8, 9.78220e-01_r8, 9.66338e-01_r8, 9.54599e-01_r8, 9.43003e-01_r8, & + & 9.31548e-01_r8, 9.20232e-01_r8, 9.09054e-01_r8, 8.98011e-01_r8, 8.87102e-01_r8, & + & 8.76326e-01_r8, 8.65681e-01_r8, 8.55165e-01_r8, 8.44777e-01_r8/) + kbo_mn2o( 2, :,10) = (/ & + & 1.05246e+00_r8, 1.03973e+00_r8, 1.02714e+00_r8, 1.01471e+00_r8, 1.00243e+00_r8, & + & 9.90303e-01_r8, 9.78319e-01_r8, 9.66480e-01_r8, 9.54784e-01_r8, 9.43230e-01_r8, & + & 9.31815e-01_r8, 9.20539e-01_r8, 9.09399e-01_r8, 8.98394e-01_r8, 8.87522e-01_r8, & + & 8.76782e-01_r8, 8.66171e-01_r8, 8.55690e-01_r8, 8.45335e-01_r8/) + kbo_mn2o( 3, :,10) = (/ & + & 1.05236e+00_r8, 1.03963e+00_r8, 1.02704e+00_r8, 1.01461e+00_r8, 1.00233e+00_r8, & + & 9.90203e-01_r8, 9.78219e-01_r8, 9.66380e-01_r8, 9.54684e-01_r8, 9.43130e-01_r8, & + & 9.31715e-01_r8, 9.20439e-01_r8, 9.09300e-01_r8, 8.98295e-01_r8, 8.87423e-01_r8, & + & 8.76683e-01_r8, 8.66073e-01_r8, 8.55591e-01_r8, 8.45236e-01_r8/) + kbo_mn2o( 4, :,10) = (/ & + & 9.30836e-01_r8, 9.21099e-01_r8, 9.11464e-01_r8, 9.01930e-01_r8, 8.92495e-01_r8, & + & 8.83159e-01_r8, 8.73921e-01_r8, 8.64779e-01_r8, 8.55733e-01_r8, 8.46781e-01_r8, & + & 8.37923e-01_r8, 8.29158e-01_r8, 8.20485e-01_r8, 8.11902e-01_r8, 8.03409e-01_r8, & + & 7.95005e-01_r8, 7.86689e-01_r8, 7.78460e-01_r8, 7.70316e-01_r8/) + kbo_mn2o( 5, :,10) = (/ & + & 1.65786e+01_r8, 1.66541e+01_r8, 1.67299e+01_r8, 1.68062e+01_r8, 1.68827e+01_r8, & + & 1.69596e+01_r8, 1.70369e+01_r8, 1.71145e+01_r8, 1.71925e+01_r8, 1.72708e+01_r8, & + & 1.73495e+01_r8, 1.74285e+01_r8, 1.75079e+01_r8, 1.75877e+01_r8, 1.76678e+01_r8, & + & 1.77483e+01_r8, 1.78291e+01_r8, 1.79103e+01_r8, 1.79919e+01_r8/) + kbo_mn2o( 1, :,11) = (/ & + & 1.74239e-01_r8, 1.77873e-01_r8, 1.81583e-01_r8, 1.85370e-01_r8, 1.89236e-01_r8, & + & 1.93182e-01_r8, 1.97211e-01_r8, 2.01324e-01_r8, 2.05523e-01_r8, 2.09809e-01_r8, & + & 2.14185e-01_r8, 2.18652e-01_r8, 2.23212e-01_r8, 2.27867e-01_r8, 2.32620e-01_r8, & + & 2.37471e-01_r8, 2.42424e-01_r8, 2.47479e-01_r8, 2.52641e-01_r8/) + kbo_mn2o( 2, :,11) = (/ & + & 1.74114e-01_r8, 1.77756e-01_r8, 1.81475e-01_r8, 1.85271e-01_r8, 1.89147e-01_r8, & + & 1.93104e-01_r8, 1.97144e-01_r8, 2.01268e-01_r8, 2.05479e-01_r8, 2.09778e-01_r8, & + & 2.14166e-01_r8, 2.18647e-01_r8, 2.23221e-01_r8, 2.27890e-01_r8, 2.32658e-01_r8, & + & 2.37525e-01_r8, 2.42494e-01_r8, 2.47567e-01_r8, 2.52746e-01_r8/) + kbo_mn2o( 3, :,11) = (/ & + & 1.74142e-01_r8, 1.77780e-01_r8, 1.81494e-01_r8, 1.85286e-01_r8, 1.89157e-01_r8, & + & 1.93108e-01_r8, 1.97143e-01_r8, 2.01261e-01_r8, 2.05466e-01_r8, 2.09759e-01_r8, & + & 2.14141e-01_r8, 2.18615e-01_r8, 2.23182e-01_r8, 2.27845e-01_r8, 2.32605e-01_r8, & + & 2.37464e-01_r8, 2.42425e-01_r8, 2.47490e-01_r8, 2.52661e-01_r8/) + kbo_mn2o( 4, :,11) = (/ & + & 1.74074e-01_r8, 1.77716e-01_r8, 1.81435e-01_r8, 1.85231e-01_r8, 1.89107e-01_r8, & + & 1.93064e-01_r8, 1.97104e-01_r8, 2.01229e-01_r8, 2.05439e-01_r8, 2.09738e-01_r8, & + & 2.14127e-01_r8, 2.18607e-01_r8, 2.23181e-01_r8, 2.27852e-01_r8, 2.32619e-01_r8, & + & 2.37487e-01_r8, 2.42456e-01_r8, 2.47529e-01_r8, 2.52709e-01_r8/) + kbo_mn2o( 5, :,11) = (/ & + & 2.31905e+01_r8, 2.33011e+01_r8, 2.34123e+01_r8, 2.35240e+01_r8, 2.36362e+01_r8, & + & 2.37489e+01_r8, 2.38622e+01_r8, 2.39760e+01_r8, 2.40904e+01_r8, 2.42053e+01_r8, & + & 2.43208e+01_r8, 2.44368e+01_r8, 2.45533e+01_r8, 2.46705e+01_r8, 2.47881e+01_r8, & + & 2.49064e+01_r8, 2.50252e+01_r8, 2.51446e+01_r8, 2.52645e+01_r8/) + kbo_mn2o( 1, :,12) = (/ & + & 1.60269e-01_r8, 1.62873e-01_r8, 1.65519e-01_r8, 1.68208e-01_r8, 1.70940e-01_r8, & + & 1.73717e-01_r8, 1.76540e-01_r8, 1.79408e-01_r8, 1.82322e-01_r8, 1.85284e-01_r8, & + & 1.88295e-01_r8, 1.91354e-01_r8, 1.94462e-01_r8, 1.97622e-01_r8, 2.00832e-01_r8, & + & 2.04095e-01_r8, 2.07411e-01_r8, 2.10780e-01_r8, 2.14205e-01_r8/) + kbo_mn2o( 2, :,12) = (/ & + & 1.60497e-01_r8, 1.63096e-01_r8, 1.65738e-01_r8, 1.68422e-01_r8, 1.71150e-01_r8, & + & 1.73922e-01_r8, 1.76738e-01_r8, 1.79601e-01_r8, 1.82510e-01_r8, 1.85466e-01_r8, & + & 1.88469e-01_r8, 1.91522e-01_r8, 1.94624e-01_r8, 1.97776e-01_r8, 2.00979e-01_r8, & + & 2.04234e-01_r8, 2.07542e-01_r8, 2.10903e-01_r8, 2.14319e-01_r8/) + kbo_mn2o( 3, :,12) = (/ & + & 1.60407e-01_r8, 1.63006e-01_r8, 1.65648e-01_r8, 1.68332e-01_r8, 1.71060e-01_r8, & + & 1.73832e-01_r8, 1.76649e-01_r8, 1.79511e-01_r8, 1.82420e-01_r8, 1.85376e-01_r8, & + & 1.88380e-01_r8, 1.91433e-01_r8, 1.94535e-01_r8, 1.97687e-01_r8, 2.00891e-01_r8, & + & 2.04146e-01_r8, 2.07454e-01_r8, 2.10816e-01_r8, 2.14232e-01_r8/) + kbo_mn2o( 4, :,12) = (/ & + & 1.60475e-01_r8, 1.63070e-01_r8, 1.65706e-01_r8, 1.68386e-01_r8, 1.71109e-01_r8, & + & 1.73876e-01_r8, 1.76687e-01_r8, 1.79544e-01_r8, 1.82448e-01_r8, 1.85398e-01_r8, & + & 1.88396e-01_r8, 1.91442e-01_r8, 1.94538e-01_r8, 1.97684e-01_r8, 2.00881e-01_r8, & + & 2.04129e-01_r8, 2.07430e-01_r8, 2.10784e-01_r8, 2.14192e-01_r8/) + kbo_mn2o( 5, :,12) = (/ & + & 3.25743e+01_r8, 3.27992e+01_r8, 3.30256e+01_r8, 3.32536e+01_r8, 3.34832e+01_r8, & + & 3.37143e+01_r8, 3.39471e+01_r8, 3.41815e+01_r8, 3.44174e+01_r8, 3.46550e+01_r8, & + & 3.48943e+01_r8, 3.51352e+01_r8, 3.53778e+01_r8, 3.56220e+01_r8, 3.58679e+01_r8, & + & 3.61156e+01_r8, 3.63649e+01_r8, 3.66159e+01_r8, 3.68687e+01_r8/) + kbo_mn2o( 1, :,13) = (/ & + & 2.01846e-01_r8, 2.03110e-01_r8, 2.04381e-01_r8, 2.05660e-01_r8, 2.06947e-01_r8, & + & 2.08242e-01_r8, 2.09546e-01_r8, 2.10857e-01_r8, 2.12177e-01_r8, 2.13505e-01_r8, & + & 2.14841e-01_r8, 2.16186e-01_r8, 2.17539e-01_r8, 2.18900e-01_r8, 2.20270e-01_r8, & + & 2.21649e-01_r8, 2.23036e-01_r8, 2.24432e-01_r8, 2.25837e-01_r8/) + kbo_mn2o( 2, :,13) = (/ & + & 2.01756e-01_r8, 2.03020e-01_r8, 2.04291e-01_r8, 2.05570e-01_r8, 2.06857e-01_r8, & + & 2.08152e-01_r8, 2.09456e-01_r8, 2.10767e-01_r8, 2.12087e-01_r8, 2.13415e-01_r8, & + & 2.14751e-01_r8, 2.16096e-01_r8, 2.17449e-01_r8, 2.18810e-01_r8, 2.20181e-01_r8, & + & 2.21559e-01_r8, 2.22946e-01_r8, 2.24342e-01_r8, 2.25747e-01_r8/) + kbo_mn2o( 3, :,13) = (/ & + & 2.01836e-01_r8, 2.03100e-01_r8, 2.04371e-01_r8, 2.05650e-01_r8, 2.06937e-01_r8, & + & 2.08232e-01_r8, 2.09536e-01_r8, 2.10847e-01_r8, 2.12167e-01_r8, 2.13495e-01_r8, & + & 2.14831e-01_r8, 2.16176e-01_r8, 2.17529e-01_r8, 2.18890e-01_r8, 2.20260e-01_r8, & + & 2.21639e-01_r8, 2.23026e-01_r8, 2.24422e-01_r8, 2.25827e-01_r8/) + kbo_mn2o( 4, :,13) = (/ & + & 2.01845e-01_r8, 2.03103e-01_r8, 2.04370e-01_r8, 2.05644e-01_r8, 2.06926e-01_r8, & + & 2.08217e-01_r8, 2.09515e-01_r8, 2.10822e-01_r8, 2.12136e-01_r8, 2.13459e-01_r8, & + & 2.14790e-01_r8, 2.16129e-01_r8, 2.17477e-01_r8, 2.18833e-01_r8, 2.20198e-01_r8, & + & 2.21571e-01_r8, 2.22952e-01_r8, 2.24343e-01_r8, 2.25741e-01_r8/) + kbo_mn2o( 5, :,13) = (/ & + & 5.34154e+01_r8, 5.31954e+01_r8, 5.29763e+01_r8, 5.27582e+01_r8, 5.25409e+01_r8, & + & 5.23245e+01_r8, 5.21090e+01_r8, 5.18943e+01_r8, 5.16806e+01_r8, 5.14677e+01_r8, & + & 5.12558e+01_r8, 5.10446e+01_r8, 5.08344e+01_r8, 5.06250e+01_r8, 5.04165e+01_r8, & + & 5.02089e+01_r8, 5.00021e+01_r8, 4.97961e+01_r8, 4.95910e+01_r8/) + kbo_mn2o( 1, :,14) = (/ & + & 2.87818e-02_r8, 3.17868e-02_r8, 3.51056e-02_r8, 3.87708e-02_r8, 4.28187e-02_r8, & + & 4.72893e-02_r8, 5.22266e-02_r8, 5.76794e-02_r8, 6.37015e-02_r8, 7.03523e-02_r8, & + & 7.76976e-02_r8, 8.58097e-02_r8, 9.47688e-02_r8, 1.04663e-01_r8, 1.15591e-01_r8, & + & 1.27659e-01_r8, 1.40988e-01_r8, 1.55708e-01_r8, 1.71965e-01_r8/) + kbo_mn2o( 2, :,14) = (/ & + & 2.88500e-02_r8, 3.18494e-02_r8, 3.51606e-02_r8, 3.88161e-02_r8, 4.28517e-02_r8, & + & 4.73068e-02_r8, 5.22251e-02_r8, 5.76547e-02_r8, 6.36488e-02_r8, 7.02661e-02_r8, & + & 7.75714e-02_r8, 8.56362e-02_r8, 9.45395e-02_r8, 1.04368e-01_r8, 1.15219e-01_r8, & + & 1.27198e-01_r8, 1.40422e-01_r8, 1.55021e-01_r8, 1.71138e-01_r8/) + kbo_mn2o( 3, :,14) = (/ & + & 2.88036e-02_r8, 3.18109e-02_r8, 3.51322e-02_r8, 3.88002e-02_r8, 4.28512e-02_r8, & + & 4.73252e-02_r8, 5.22663e-02_r8, 5.77232e-02_r8, 6.37499e-02_r8, 7.04058e-02_r8, & + & 7.77567e-02_r8, 8.58751e-02_r8, 9.48410e-02_r8, 1.04743e-01_r8, 1.15679e-01_r8, & + & 1.27757e-01_r8, 1.41095e-01_r8, 1.55827e-01_r8, 1.72096e-01_r8/) + kbo_mn2o( 4, :,14) = (/ & + & 2.87750e-02_r8, 3.17783e-02_r8, 3.50951e-02_r8, 3.87580e-02_r8, 4.28033e-02_r8, & + & 4.72708e-02_r8, 5.22046e-02_r8, 5.76533e-02_r8, 6.36707e-02_r8, 7.03162e-02_r8, & + & 7.76553e-02_r8, 8.57604e-02_r8, 9.47114e-02_r8, 1.04597e-01_r8, 1.15514e-01_r8, & + & 1.27570e-01_r8, 1.40885e-01_r8, 1.55589e-01_r8, 1.71829e-01_r8/) + kbo_mn2o( 5, :,14) = (/ & + & 1.11848e+02_r8, 1.09489e+02_r8, 1.07179e+02_r8, 1.04918e+02_r8, 1.02705e+02_r8, & + & 1.00538e+02_r8, 9.84175e+01_r8, 9.63414e+01_r8, 9.43091e+01_r8, 9.23196e+01_r8, & + & 9.03722e+01_r8, 8.84658e+01_r8, 8.65996e+01_r8, 8.47728e+01_r8, 8.29845e+01_r8, & + & 8.12339e+01_r8, 7.95203e+01_r8, 7.78428e+01_r8, 7.62007e+01_r8/) + kbo_mn2o( 1, :,15) = (/ & + & 1.52234e-02_r8, 1.69256e-02_r8, 1.88181e-02_r8, 2.09222e-02_r8, 2.32617e-02_r8, & + & 2.58626e-02_r8, 2.87545e-02_r8, 3.19696e-02_r8, 3.55443e-02_r8, 3.95187e-02_r8, & + & 4.39374e-02_r8, 4.88503e-02_r8, 5.43124e-02_r8, 6.03854e-02_r8, 6.71373e-02_r8, & + & 7.46443e-02_r8, 8.29906e-02_r8, 9.22701e-02_r8, 1.02587e-01_r8/) + kbo_mn2o( 2, :,15) = (/ & + & 1.52234e-02_r8, 1.69256e-02_r8, 1.88181e-02_r8, 2.09222e-02_r8, 2.32617e-02_r8, & + & 2.58626e-02_r8, 2.87545e-02_r8, 3.19696e-02_r8, 3.55443e-02_r8, 3.95187e-02_r8, & + & 4.39374e-02_r8, 4.88503e-02_r8, 5.43124e-02_r8, 6.03854e-02_r8, 6.71373e-02_r8, & + & 7.46443e-02_r8, 8.29906e-02_r8, 9.22701e-02_r8, 1.02587e-01_r8/) + kbo_mn2o( 3, :,15) = (/ & + & 1.52076e-02_r8, 1.69049e-02_r8, 1.87916e-02_r8, 2.08890e-02_r8, 2.32203e-02_r8, & + & 2.58119e-02_r8, 2.86928e-02_r8, 3.18951e-02_r8, 3.54549e-02_r8, 3.94120e-02_r8, & + & 4.38107e-02_r8, 4.87003e-02_r8, 5.41357e-02_r8, 6.01777e-02_r8, 6.68940e-02_r8, & + & 7.43600e-02_r8, 8.26593e-02_r8, 9.18847e-02_r8, 1.02140e-01_r8/) + kbo_mn2o( 4, :,15) = (/ & + & 1.52422e-02_r8, 1.69488e-02_r8, 1.88464e-02_r8, 2.09565e-02_r8, 2.33028e-02_r8, & + & 2.59118e-02_r8, 2.88129e-02_r8, 3.20389e-02_r8, 3.56260e-02_r8, 3.96148e-02_r8, & + & 4.40501e-02_r8, 4.89821e-02_r8, 5.44662e-02_r8, 6.05643e-02_r8, 6.73452e-02_r8, & + & 7.48853e-02_r8, 8.32696e-02_r8, 9.25927e-02_r8, 1.02959e-01_r8/) + kbo_mn2o( 5, :,15) = (/ & + & 6.94782e+01_r8, 6.73469e+01_r8, 6.52810e+01_r8, 6.32785e+01_r8, 6.13373e+01_r8, & + & 5.94558e+01_r8, 5.76319e+01_r8, 5.58640e+01_r8, 5.41503e+01_r8, 5.24892e+01_r8, & + & 5.08791e+01_r8, 4.93183e+01_r8, 4.78055e+01_r8, 4.63390e+01_r8, 4.49175e+01_r8, & + & 4.35396e+01_r8, 4.22040e+01_r8, 4.09094e+01_r8, 3.96544e+01_r8/) + kbo_mn2o( 1, :,16) = (/ & + & 1.08257e-02_r8, 1.15188e-02_r8, 1.22563e-02_r8, 1.30410e-02_r8, 1.38759e-02_r8, & + & 1.47643e-02_r8, 1.57096e-02_r8, 1.67154e-02_r8, 1.77857e-02_r8, 1.89244e-02_r8, & + & 2.01360e-02_r8, 2.14252e-02_r8, 2.27970e-02_r8, 2.42565e-02_r8, 2.58096e-02_r8, & + & 2.74620e-02_r8, 2.92203e-02_r8, 3.10911e-02_r8, 3.30817e-02_r8/) + kbo_mn2o( 2, :,16) = (/ & + & 1.08257e-02_r8, 1.15188e-02_r8, 1.22563e-02_r8, 1.30410e-02_r8, 1.38759e-02_r8, & + & 1.47643e-02_r8, 1.57096e-02_r8, 1.67154e-02_r8, 1.77857e-02_r8, 1.89244e-02_r8, & + & 2.01360e-02_r8, 2.14252e-02_r8, 2.27970e-02_r8, 2.42565e-02_r8, 2.58096e-02_r8, & + & 2.74620e-02_r8, 2.92203e-02_r8, 3.10911e-02_r8, 3.30817e-02_r8/) + kbo_mn2o( 3, :,16) = (/ & + & 1.08257e-02_r8, 1.15188e-02_r8, 1.22563e-02_r8, 1.30410e-02_r8, 1.38759e-02_r8, & + & 1.47643e-02_r8, 1.57096e-02_r8, 1.67154e-02_r8, 1.77857e-02_r8, 1.89244e-02_r8, & + & 2.01360e-02_r8, 2.14252e-02_r8, 2.27970e-02_r8, 2.42565e-02_r8, 2.58096e-02_r8, & + & 2.74620e-02_r8, 2.92203e-02_r8, 3.10911e-02_r8, 3.30817e-02_r8/) + kbo_mn2o( 4, :,16) = (/ & + & 1.08263e-02_r8, 1.15191e-02_r8, 1.22562e-02_r8, 1.30404e-02_r8, 1.38749e-02_r8, & + & 1.47627e-02_r8, 1.57073e-02_r8, 1.67124e-02_r8, 1.77818e-02_r8, 1.89196e-02_r8, & + & 2.01302e-02_r8, 2.14183e-02_r8, 2.27888e-02_r8, 2.42470e-02_r8, 2.57986e-02_r8, & + & 2.74494e-02_r8, 2.92058e-02_r8, 3.10746e-02_r8, 3.30630e-02_r8/) + kbo_mn2o( 5, :,16) = (/ & + & 4.53450e-08_r8, 5.75193e-08_r8, 7.29620e-08_r8, 9.25509e-08_r8, 1.17399e-07_r8, & + & 1.48918e-07_r8, 1.88900e-07_r8, 2.39616e-07_r8, 3.03948e-07_r8, 3.85551e-07_r8, & + & 4.89064e-07_r8, 6.20369e-07_r8, 7.86925e-07_r8, 9.98199e-07_r8, 1.26619e-06_r8, & + & 1.60614e-06_r8, 2.03736e-06_r8, 2.58435e-06_r8, 3.27819e-06_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &9.0039e-04_r8,1.1081e-03_r8,1.0732e-03_r8,1.1881e-03_r8,1.2488e-03_r8,1.3170e-03_r8, & + &1.3317e-03_r8,1.3168e-03_r8,1.3369e-03_r8,1.4228e-03_r8,1.5385e-03_r8,1.7376e-03_r8, & + &1.7122e-03_r8,1.9002e-03_r8,1.8881e-03_r8,2.1595e-03_r8/) + forrefo(2,:) = (/ & + &1.2726e-03_r8,1.3680e-03_r8,1.2494e-03_r8,1.2049e-03_r8,1.2048e-03_r8,1.1256e-03_r8, & + &1.1170e-03_r8,1.0697e-03_r8,1.1177e-03_r8,1.1883e-03_r8,1.2219e-03_r8,1.2179e-03_r8, & + &1.5692e-03_r8,1.9103e-03_r8,2.0219e-03_r8,1.6937e-03_r8/) + forrefo(3,:) = (/ & + &1.5527e-03_r8,1.6477e-03_r8,1.4973e-03_r8,1.3400e-03_r8,1.0820e-03_r8,9.3315e-04_r8, & + &8.8132e-04_r8,8.1508e-04_r8,8.3559e-04_r8,7.6492e-04_r8,8.2343e-04_r8,7.1274e-04_r8, & + &6.6011e-04_r8,6.7179e-04_r8,6.7039e-04_r8,6.7021e-04_r8/) + forrefo(4,:) = (/ & + &1.6763e-03_r8,1.6066e-03_r8,1.3927e-03_r8,1.2087e-03_r8,9.8463e-04_r8,8.8414e-04_r8, & + &8.0976e-04_r8,7.8758e-04_r8,7.7376e-04_r8,7.5785e-04_r8,7.4152e-04_r8,7.3814e-04_r8, & + &7.4278e-04_r8,7.1745e-04_r8,6.7216e-04_r8,6.4097e-04_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 5.11926e-01_r8, 4.32863e-01_r8, 3.66010e-01_r8, 3.09482e-01_r8, 2.61685e-01_r8, & + & 2.21269e-01_r8, 1.87096e-01_r8, 1.58200e-01_r8, 1.33767e-01_r8, 1.13108e-01_r8/) + selfrefo(:, 2) = (/ & + & 5.02863e-01_r8, 4.35008e-01_r8, 3.76310e-01_r8, 3.25532e-01_r8, 2.81606e-01_r8, & + & 2.43607e-01_r8, 2.10736e-01_r8, 1.82300e-01_r8, 1.57701e-01_r8, 1.36422e-01_r8/) + selfrefo(:, 3) = (/ & + & 4.57628e-01_r8, 3.99663e-01_r8, 3.49040e-01_r8, 3.04829e-01_r8, 2.66218e-01_r8, & + & 2.32498e-01_r8, 2.03049e-01_r8, 1.77330e-01_r8, 1.54869e-01_r8, 1.35252e-01_r8/) + selfrefo(:, 4) = (/ & + & 4.28634e-01_r8, 3.81736e-01_r8, 3.39970e-01_r8, 3.02773e-01_r8, 2.69647e-01_r8, & + & 2.40144e-01_r8, 2.13870e-01_r8, 1.90470e-01_r8, 1.69630e-01_r8, 1.51071e-01_r8/) + selfrefo(:, 5) = (/ & + & 4.21002e-01_r8, 3.77493e-01_r8, 3.38480e-01_r8, 3.03499e-01_r8, 2.72133e-01_r8, & + & 2.44009e-01_r8, 2.18792e-01_r8, 1.96180e-01_r8, 1.75905e-01_r8, 1.57726e-01_r8/) + selfrefo(:, 6) = (/ & + & 3.97517e-01_r8, 3.61167e-01_r8, 3.28140e-01_r8, 2.98133e-01_r8, 2.70871e-01_r8, & + & 2.46101e-01_r8, 2.23597e-01_r8, 2.03150e-01_r8, 1.84573e-01_r8, 1.67695e-01_r8/) + selfrefo(:, 7) = (/ & + & 3.92114e-01_r8, 3.57554e-01_r8, 3.26040e-01_r8, 2.97304e-01_r8, 2.71100e-01_r8, & + & 2.47206e-01_r8, 2.25418e-01_r8, 2.05550e-01_r8, 1.87433e-01_r8, 1.70913e-01_r8/) + selfrefo(:, 8) = (/ & + & 3.79555e-01_r8, 3.47264e-01_r8, 3.17720e-01_r8, 2.90690e-01_r8, 2.65959e-01_r8, & + & 2.43332e-01_r8, 2.22631e-01_r8, 2.03690e-01_r8, 1.86361e-01_r8, 1.70506e-01_r8/) + selfrefo(:, 9) = (/ & + & 3.92644e-01_r8, 3.58048e-01_r8, 3.26500e-01_r8, 2.97732e-01_r8, 2.71498e-01_r8, & + & 2.47576e-01_r8, 2.25762e-01_r8, 2.05870e-01_r8, 1.87731e-01_r8, 1.71190e-01_r8/) + selfrefo(:,10) = (/ & + & 4.06542e-01_r8, 3.71200e-01_r8, 3.38930e-01_r8, 3.09465e-01_r8, 2.82562e-01_r8, & + & 2.57998e-01_r8, 2.35569e-01_r8, 2.15090e-01_r8, 1.96391e-01_r8, 1.79318e-01_r8/) + selfrefo(:,11) = (/ & + & 4.09672e-01_r8, 3.76237e-01_r8, 3.45530e-01_r8, 3.17329e-01_r8, 2.91430e-01_r8, & + & 2.67645e-01_r8, 2.45801e-01_r8, 2.25740e-01_r8, 2.07316e-01_r8, 1.90396e-01_r8/) + selfrefo(:,12) = (/ & + & 3.85140e-01_r8, 3.61989e-01_r8, 3.40230e-01_r8, 3.19779e-01_r8, 3.00557e-01_r8, & + & 2.82490e-01_r8, 2.65510e-01_r8, 2.49550e-01_r8, 2.34549e-01_r8, 2.20451e-01_r8/) + selfrefo(:,13) = (/ & + & 4.87349e-01_r8, 4.42192e-01_r8, 4.01220e-01_r8, 3.64044e-01_r8, 3.30313e-01_r8, & + & 2.99707e-01_r8, 2.71937e-01_r8, 2.46740e-01_r8, 2.23878e-01_r8, 2.03134e-01_r8/) + selfrefo(:,14) = (/ & + & 5.64339e-01_r8, 5.06194e-01_r8, 4.54040e-01_r8, 4.07259e-01_r8, 3.65298e-01_r8, & + & 3.27661e-01_r8, 2.93901e-01_r8, 2.63620e-01_r8, 2.36459e-01_r8, 2.12096e-01_r8/) + selfrefo(:,15) = (/ & + & 5.91123e-01_r8, 5.26420e-01_r8, 4.68800e-01_r8, 4.17486e-01_r8, 3.71790e-01_r8, & + & 3.31095e-01_r8, 2.94854e-01_r8, 2.62580e-01_r8, 2.33839e-01_r8, 2.08243e-01_r8/) + selfrefo(:,16) = (/ & + & 5.04590e-01_r8, 4.65235e-01_r8, 4.28950e-01_r8, 3.95495e-01_r8, 3.64649e-01_r8, & + & 3.36209e-01_r8, 3.09987e-01_r8, 2.85810e-01_r8, 2.63519e-01_r8, 2.42966e-01_r8/) + + end subroutine lw_kgb03 + +! ************************************************************************** + subroutine lw_kgb04 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg04, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 142.5940 mbar, T = 215.70 K + fracrefao(:, 1) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7965e-03_r8,2.9744e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 2) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2392e-02_r8,4.2146e-02_r8,4.5906e-03_r8,3.7965e-03_r8,2.9745e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 3) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7965e-03_r8,2.9745e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 4) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7964e-03_r8,2.9744e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 5) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7965e-03_r8,2.9744e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 6) = (/ & + & 1.5572e-01_r8,1.4925e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7965e-03_r8,2.9744e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 7) = (/ & + & 1.5572e-01_r8,1.4926e-01_r8,1.4107e-01_r8,1.3126e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5908e-03_r8,3.7964e-03_r8,2.9745e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 8) = (/ & + & 1.5571e-01_r8,1.4926e-01_r8,1.4107e-01_r8,1.3125e-01_r8,1.1791e-01_r8,1.0173e-01_r8, & + & 8.2949e-02_r8,6.2393e-02_r8,4.2146e-02_r8,4.5907e-03_r8,3.7964e-03_r8,2.9744e-03_r8, & + & 2.2074e-03_r8,1.4063e-03_r8,5.3012e-04_r8,7.4595e-05_r8/) + fracrefao(:, 9) = (/ & + & 1.5952e-01_r8,1.5155e-01_r8,1.4217e-01_r8,1.3077e-01_r8,1.1667e-01_r8,1.0048e-01_r8, & + & 8.1511e-02_r8,6.1076e-02_r8,4.1111e-02_r8,4.4432e-03_r8,3.6910e-03_r8,2.9076e-03_r8, & + & 2.1329e-03_r8,1.3566e-03_r8,5.2235e-04_r8,7.9935e-05_r8/) + +! Planck fraction mapping level : P = 95.58350 mb, T = 215.70 K + fracrefbo(:, 1) = (/ & + & 1.5558e-01_r8,1.4931e-01_r8,1.4104e-01_r8,1.3124e-01_r8,1.1793e-01_r8,1.0160e-01_r8, & + & 8.3142e-02_r8,6.2403e-02_r8,4.2170e-02_r8,4.5935e-03_r8,3.7976e-03_r8,2.9986e-03_r8, & + & 2.1890e-03_r8,1.4061e-03_r8,5.3005e-04_r8,7.4587e-05_r8/) + fracrefbo(:, 2) = (/ & + & 1.5558e-01_r8,1.4932e-01_r8,1.4104e-01_r8,1.3124e-01_r8,1.1792e-01_r8,1.0159e-01_r8, & + & 8.3142e-02_r8,6.2403e-02_r8,4.2170e-02_r8,4.5935e-03_r8,3.7976e-03_r8,2.9986e-03_r8, & + & 2.1890e-03_r8,1.4061e-03_r8,5.3005e-04_r8,7.4587e-05_r8/) + fracrefbo(:, 3) = (/ & + & 1.5558e-01_r8,1.4933e-01_r8,1.4103e-01_r8,1.3124e-01_r8,1.1792e-01_r8,1.0159e-01_r8, & + & 8.3142e-02_r8,6.2403e-02_r8,4.2170e-02_r8,4.5935e-03_r8,3.7976e-03_r8,2.9986e-03_r8, & + & 2.1890e-03_r8,1.4061e-03_r8,5.3005e-04_r8,7.4587e-05_r8/) + fracrefbo(:, 4) = (/ & + & 1.5569e-01_r8,1.4926e-01_r8,1.4102e-01_r8,1.3122e-01_r8,1.1791e-01_r8,1.0159e-01_r8, & + & 8.3141e-02_r8,6.2403e-02_r8,4.2170e-02_r8,4.5935e-03_r8,3.7976e-03_r8,2.9986e-03_r8, & + & 2.1890e-03_r8,1.4061e-03_r8,5.3005e-04_r8,7.4587e-05_r8/) + fracrefbo(:, 5) = (/ & + & 1.5947e-01_r8,1.5132e-01_r8,1.4195e-01_r8,1.3061e-01_r8,1.1680e-01_r8,1.0054e-01_r8, & + & 8.1785e-02_r8,6.1212e-02_r8,4.1276e-02_r8,4.4424e-03_r8,3.6628e-03_r8,2.8943e-03_r8, & + & 2.1134e-03_r8,1.3457e-03_r8,5.1024e-04_r8,7.3998e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &1.0697e-02_r8,1.0151e-02_r8,9.2549e-03_r8,8.2645e-03_r8,7.2061e-03_r8,6.0662e-03_r8, & + &4.9816e-03_r8,4.8867e-03_r8,2.0269e-04_r8/) + kao(:, 2, 1, 1) = (/ & + &1.1677e-02_r8,1.1138e-02_r8,1.0216e-02_r8,9.1909e-03_r8,8.0553e-03_r8,6.8223e-03_r8, & + &5.5408e-03_r8,4.6854e-03_r8,2.3825e-04_r8/) + kao(:, 3, 1, 1) = (/ & + &1.2605e-02_r8,1.2092e-02_r8,1.1179e-02_r8,1.0121e-02_r8,8.9159e-03_r8,7.6027e-03_r8, & + &6.0392e-03_r8,4.3498e-03_r8,2.8245e-04_r8/) + kao(:, 4, 1, 1) = (/ & + &1.3484e-02_r8,1.3046e-02_r8,1.2153e-02_r8,1.1041e-02_r8,9.7806e-03_r8,8.2921e-03_r8, & + &6.5023e-03_r8,4.3023e-03_r8,3.0318e-04_r8/) + kao(:, 5, 1, 1) = (/ & + &1.4330e-02_r8,1.3997e-02_r8,1.3114e-02_r8,1.1943e-02_r8,1.0557e-02_r8,8.8567e-03_r8, & + &6.8709e-03_r8,4.3577e-03_r8,3.2751e-04_r8/) + kao(:, 1, 2, 1) = (/ & + &1.3833e-02_r8,1.2806e-02_r8,1.1465e-02_r8,1.0025e-02_r8,8.5208e-03_r8,6.9589e-03_r8, & + &5.3336e-03_r8,4.2294e-03_r8,1.4419e-04_r8/) + kao(:, 2, 2, 1) = (/ & + &1.5144e-02_r8,1.4068e-02_r8,1.2644e-02_r8,1.1119e-02_r8,9.5204e-03_r8,7.8236e-03_r8, & + &6.0220e-03_r8,4.4086e-03_r8,1.7355e-04_r8/) + kao(:, 3, 2, 1) = (/ & + &1.6397e-02_r8,1.5299e-02_r8,1.3819e-02_r8,1.2230e-02_r8,1.0525e-02_r8,8.6894e-03_r8, & + &6.7322e-03_r8,4.5883e-03_r8,2.1022e-04_r8/) + kao(:, 4, 2, 1) = (/ & + &1.7608e-02_r8,1.6518e-02_r8,1.5010e-02_r8,1.3349e-02_r8,1.1524e-02_r8,9.5665e-03_r8, & + &7.3586e-03_r8,4.7702e-03_r8,2.1845e-04_r8/) + kao(:, 5, 2, 1) = (/ & + &1.8795e-02_r8,1.7739e-02_r8,1.6211e-02_r8,1.4458e-02_r8,1.2504e-02_r8,1.0367e-02_r8, & + &7.8746e-03_r8,4.9505e-03_r8,2.4452e-04_r8/) + kao(:, 1, 3, 1) = (/ & + &2.3349e-02_r8,2.1073e-02_r8,1.8534e-02_r8,1.5886e-02_r8,1.3154e-02_r8,1.0346e-02_r8, & + &7.4749e-03_r8,4.5440e-03_r8,9.5522e-05_r8/) + kao(:, 2, 3, 1) = (/ & + &2.5718e-02_r8,2.3272e-02_r8,2.0503e-02_r8,1.7622e-02_r8,1.4648e-02_r8,1.1596e-02_r8, & + &8.4531e-03_r8,5.1652e-03_r8,1.1957e-04_r8/) + kao(:, 3, 3, 1) = (/ & + &2.8025e-02_r8,2.5421e-02_r8,2.2452e-02_r8,1.9353e-02_r8,1.6163e-02_r8,1.2876e-02_r8, & + &9.4440e-03_r8,5.8151e-03_r8,1.4638e-04_r8/) + kao(:, 4, 3, 1) = (/ & + &3.0273e-02_r8,2.7542e-02_r8,2.4400e-02_r8,2.1110e-02_r8,1.7713e-02_r8,1.4169e-02_r8, & + &1.0445e-02_r8,6.4078e-03_r8,1.5375e-04_r8/) + kao(:, 5, 3, 1) = (/ & + &3.2488e-02_r8,2.9668e-02_r8,2.6366e-02_r8,2.2912e-02_r8,1.9285e-02_r8,1.5463e-02_r8, & + &1.1411e-02_r8,6.9035e-03_r8,1.7414e-04_r8/) + kao(:, 1, 4, 1) = (/ & + &3.9680e-02_r8,3.5246e-02_r8,3.0687e-02_r8,2.5989e-02_r8,2.1199e-02_r8,1.6340e-02_r8, & + &1.1394e-02_r8,6.3232e-03_r8,6.3142e-05_r8/) + kao(:, 2, 4, 1) = (/ & + &4.4067e-02_r8,3.9245e-02_r8,3.4186e-02_r8,2.8983e-02_r8,2.3690e-02_r8,1.8315e-02_r8, & + &1.2835e-02_r8,7.2156e-03_r8,8.2154e-05_r8/) + kao(:, 3, 4, 1) = (/ & + &4.8382e-02_r8,4.3189e-02_r8,3.7634e-02_r8,3.1955e-02_r8,2.6184e-02_r8,2.0317e-02_r8, & + &1.4329e-02_r8,8.1343e-03_r8,1.0015e-04_r8/) + kao(:, 4, 4, 1) = (/ & + &5.2631e-02_r8,4.7051e-02_r8,4.1069e-02_r8,3.4945e-02_r8,2.8716e-02_r8,2.2361e-02_r8, & + &1.5856e-02_r8,9.0735e-03_r8,1.0763e-04_r8/) + kao(:, 5, 4, 1) = (/ & + &5.6812e-02_r8,5.0879e-02_r8,4.4486e-02_r8,3.7949e-02_r8,3.1266e-02_r8,2.4439e-02_r8, & + &1.7397e-02_r8,9.9865e-03_r8,1.2433e-04_r8/) + kao(:, 1, 5, 1) = (/ & + &6.1659e-02_r8,5.4360e-02_r8,4.7000e-02_r8,3.9571e-02_r8,3.2046e-02_r8,2.4431e-02_r8, & + &1.6731e-02_r8,8.9002e-03_r8,4.4135e-05_r8/) + kao(:, 2, 5, 1) = (/ & + &6.9177e-02_r8,6.1077e-02_r8,5.2885e-02_r8,4.4540e-02_r8,3.6083e-02_r8,2.7553e-02_r8, & + &1.8920e-02_r8,1.0138e-02_r8,5.7278e-05_r8/) + kao(:, 3, 5, 1) = (/ & + &7.6561e-02_r8,6.7721e-02_r8,5.8676e-02_r8,4.9436e-02_r8,4.0109e-02_r8,3.0675e-02_r8, & + &2.1149e-02_r8,1.1429e-02_r8,6.8177e-05_r8/) + kao(:, 4, 5, 1) = (/ & + &8.3855e-02_r8,7.4287e-02_r8,6.4398e-02_r8,5.4317e-02_r8,4.4139e-02_r8,3.3855e-02_r8, & + &2.3434e-02_r8,1.2758e-02_r8,7.5655e-05_r8/) + kao(:, 5, 5, 1) = (/ & + &9.1112e-02_r8,8.0836e-02_r8,7.0093e-02_r8,5.9205e-02_r8,4.8195e-02_r8,3.7076e-02_r8, & + &2.5757e-02_r8,1.4110e-02_r8,8.9921e-05_r8/) + kao(:, 1, 6, 1) = (/ & + &8.8882e-02_r8,7.8094e-02_r8,6.7257e-02_r8,5.6376e-02_r8,4.5468e-02_r8,3.4471e-02_r8, & + &2.3372e-02_r8,1.2141e-02_r8,3.4008e-05_r8/) + kao(:, 2, 6, 1) = (/ & + &1.0088e-01_r8,8.8690e-02_r8,7.6454e-02_r8,6.4166e-02_r8,5.1764e-02_r8,3.9256e-02_r8, & + &2.6651e-02_r8,1.3906e-02_r8,4.1496e-05_r8/) + kao(:, 3, 6, 1) = (/ & + &1.1268e-01_r8,9.9170e-02_r8,8.5584e-02_r8,7.1867e-02_r8,5.7997e-02_r8,4.4019e-02_r8, & + &2.9951e-02_r8,1.5714e-02_r8,4.7587e-05_r8/) + kao(:, 4, 6, 1) = (/ & + &1.2443e-01_r8,1.0961e-01_r8,9.4686e-02_r8,7.9524e-02_r8,6.4216e-02_r8,4.8825e-02_r8, & + &3.3307e-02_r8,1.7586e-02_r8,5.4734e-05_r8/) + kao(:, 5, 6, 1) = (/ & + &1.3608e-01_r8,1.2003e-01_r8,1.0372e-01_r8,8.7155e-02_r8,7.0466e-02_r8,5.3660e-02_r8, & + &3.6716e-02_r8,1.9490e-02_r8,6.4532e-05_r8/) + kao(:, 1, 7, 1) = (/ & + &1.3393e-01_r8,1.1743e-01_r8,1.0091e-01_r8,8.4366e-02_r8,6.7796e-02_r8,5.1191e-02_r8, & + &3.4487e-02_r8,1.7647e-02_r8,2.6258e-05_r8/) + kao(:, 2, 7, 1) = (/ & + &1.5385e-01_r8,1.3496e-01_r8,1.1603e-01_r8,9.7081e-02_r8,7.8079e-02_r8,5.8981e-02_r8, & + &3.9763e-02_r8,2.0387e-02_r8,3.2089e-05_r8/) + kao(:, 3, 7, 1) = (/ & + &1.7362e-01_r8,1.5237e-01_r8,1.3107e-01_r8,1.0975e-01_r8,8.8299e-02_r8,6.6730e-02_r8, & + &4.5023e-02_r8,2.3161e-02_r8,4.0067e-05_r8/) + kao(:, 4, 7, 1) = (/ & + &1.9325e-01_r8,1.6971e-01_r8,1.4609e-01_r8,1.2238e-01_r8,9.8509e-02_r8,7.4481e-02_r8, & + &5.0334e-02_r8,2.5995e-02_r8,4.6630e-05_r8/) + kao(:, 5, 7, 1) = (/ & + &2.1303e-01_r8,1.8717e-01_r8,1.6126e-01_r8,1.3511e-01_r8,1.0879e-01_r8,8.2319e-02_r8, & + &5.5720e-02_r8,2.8900e-02_r8,5.5874e-05_r8/) + kao(:, 1, 8, 1) = (/ & + &2.4085e-01_r8,2.1093e-01_r8,1.8102e-01_r8,1.5107e-01_r8,1.2112e-01_r8,9.1137e-02_r8, & + &6.1112e-02_r8,3.0964e-02_r8,2.6704e-05_r8/) + kao(:, 2, 8, 1) = (/ & + &2.8040e-01_r8,2.4563e-01_r8,2.1082e-01_r8,1.7598e-01_r8,1.4114e-01_r8,1.0627e-01_r8, & + &7.1313e-02_r8,3.6159e-02_r8,3.4463e-05_r8/) + kao(:, 3, 8, 1) = (/ & + &3.1986e-01_r8,2.8024e-01_r8,2.4058e-01_r8,2.0091e-01_r8,1.6119e-01_r8,1.2143e-01_r8, & + &8.1504e-02_r8,4.1377e-02_r8,4.2885e-05_r8/) + kao(:, 4, 8, 1) = (/ & + &3.5910e-01_r8,3.1468e-01_r8,2.7026e-01_r8,2.2578e-01_r8,1.8126e-01_r8,1.3658e-01_r8, & + &9.1734e-02_r8,4.6641e-02_r8,5.1508e-05_r8/) + kao(:, 5, 8, 1) = (/ & + &3.9881e-01_r8,3.4958e-01_r8,3.0035e-01_r8,2.5107e-01_r8,2.0163e-01_r8,1.5198e-01_r8, & + &1.0212e-01_r8,5.2034e-02_r8,5.9872e-05_r8/) + kao(:, 1, 9, 1) = (/ & + &8.1251e-01_r8,7.1113e-01_r8,6.0978e-01_r8,5.0834e-01_r8,4.0692e-01_r8,3.0549e-01_r8, & + &2.0401e-01_r8,1.0247e-01_r8,4.2060e-05_r8/) + kao(:, 2, 9, 1) = (/ & + &9.6024e-01_r8,8.4039e-01_r8,7.2060e-01_r8,6.0079e-01_r8,4.8095e-01_r8,3.6106e-01_r8, & + &2.4120e-01_r8,1.2123e-01_r8,5.7363e-05_r8/) + kao(:, 3, 9, 1) = (/ & + &1.1088e+00_r8,9.7056e-01_r8,8.3222e-01_r8,6.9393e-01_r8,5.5555e-01_r8,4.1720e-01_r8, & + &2.7875e-01_r8,1.4021e-01_r8,7.4113e-05_r8/) + kao(:, 4, 9, 1) = (/ & + &1.2568e+00_r8,1.1001e+00_r8,9.4342e-01_r8,7.8665e-01_r8,6.2985e-01_r8,4.7311e-01_r8, & + &3.1630e-01_r8,1.5915e-01_r8,9.2862e-05_r8/) + kao(:, 5, 9, 1) = (/ & + &1.4062e+00_r8,1.2309e+00_r8,1.0557e+00_r8,8.8039e-01_r8,7.0513e-01_r8,5.2977e-01_r8, & + &3.5432e-01_r8,1.7839e-01_r8,1.0954e-04_r8/) + kao(:, 1,10, 1) = (/ & + &3.0868e+00_r8,2.7010e+00_r8,2.3154e+00_r8,1.9296e+00_r8,1.5440e+00_r8,1.1583e+00_r8, & + &7.7257e-01_r8,3.8682e-01_r8,7.9650e-05_r8/) + kao(:, 2,10, 1) = (/ & + &3.6992e+00_r8,3.2371e+00_r8,2.7749e+00_r8,2.3126e+00_r8,1.8504e+00_r8,1.3883e+00_r8, & + &9.2595e-01_r8,4.6361e-01_r8,1.1315e-04_r8/) + kao(:, 3,10, 1) = (/ & + &4.3239e+00_r8,3.7838e+00_r8,3.2436e+00_r8,2.7034e+00_r8,2.1630e+00_r8,1.6228e+00_r8, & + &1.0824e+00_r8,5.4204e-01_r8,1.4419e-04_r8/) + kao(:, 4,10, 1) = (/ & + &4.9483e+00_r8,4.3302e+00_r8,3.7121e+00_r8,3.0937e+00_r8,2.4754e+00_r8,1.8572e+00_r8, & + &1.2389e+00_r8,6.2062e-01_r8,1.7752e-04_r8/) + kao(:, 5,10, 1) = (/ & + &5.5745e+00_r8,4.8780e+00_r8,4.1816e+00_r8,3.4855e+00_r8,2.7890e+00_r8,2.0926e+00_r8, & + &1.3962e+00_r8,6.9963e-01_r8,2.1449e-04_r8/) + kao(:, 1,11, 1) = (/ & + &4.4731e+00_r8,3.9138e+00_r8,3.3549e+00_r8,2.7960e+00_r8,2.2371e+00_r8,1.6781e+00_r8, & + &1.1191e+00_r8,5.6013e-01_r8,1.1739e-04_r8/) + kao(:, 2,11, 1) = (/ & + &5.3673e+00_r8,4.6967e+00_r8,4.0260e+00_r8,3.3552e+00_r8,2.6847e+00_r8,2.0138e+00_r8, & + &1.3431e+00_r8,6.7224e-01_r8,1.4272e-04_r8/) + kao(:, 3,11, 1) = (/ & + &6.2805e+00_r8,5.4954e+00_r8,4.7109e+00_r8,3.9260e+00_r8,3.1412e+00_r8,2.3563e+00_r8, & + &1.5716e+00_r8,7.8663e-01_r8,1.8731e-04_r8/) + kao(:, 4,11, 1) = (/ & + &7.1941e+00_r8,6.2951e+00_r8,5.3963e+00_r8,4.4973e+00_r8,3.5984e+00_r8,2.6993e+00_r8, & + &1.8005e+00_r8,9.0138e-01_r8,2.2429e-04_r8/) + kao(:, 5,11, 1) = (/ & + &8.1084e+00_r8,7.0952e+00_r8,6.0822e+00_r8,5.0692e+00_r8,4.0560e+00_r8,3.0428e+00_r8, & + &2.0297e+00_r8,1.0163e+00_r8,2.6588e-04_r8/) + kao(:, 1,12, 1) = (/ & + &4.8324e+00_r8,4.2285e+00_r8,3.6244e+00_r8,3.0205e+00_r8,2.4167e+00_r8,1.8130e+00_r8, & + &1.2091e+00_r8,6.0509e-01_r8,1.2228e-04_r8/) + kao(:, 2,12, 1) = (/ & + &5.8007e+00_r8,5.0761e+00_r8,4.3512e+00_r8,3.6264e+00_r8,2.9012e+00_r8,2.1763e+00_r8, & + &1.4515e+00_r8,7.2651e-01_r8,1.6183e-04_r8/) + kao(:, 3,12, 1) = (/ & + &6.7955e+00_r8,5.9463e+00_r8,5.0972e+00_r8,4.2481e+00_r8,3.3989e+00_r8,2.5498e+00_r8, & + &1.7005e+00_r8,8.5109e-01_r8,1.9622e-04_r8/) + kao(:, 4,12, 1) = (/ & + &7.7871e+00_r8,6.8141e+00_r8,5.8412e+00_r8,4.8680e+00_r8,3.8949e+00_r8,2.9218e+00_r8, & + &1.9487e+00_r8,9.7554e-01_r8,2.4527e-04_r8/) + kao(:, 5,12, 1) = (/ & + &8.7731e+00_r8,7.6770e+00_r8,6.5805e+00_r8,5.4843e+00_r8,4.3883e+00_r8,3.2921e+00_r8, & + &2.1959e+00_r8,1.0994e+00_r8,2.9421e-04_r8/) + kao(:, 1,13, 1) = (/ & + &4.1936e+00_r8,3.6695e+00_r8,3.1456e+00_r8,2.6217e+00_r8,2.0976e+00_r8,1.5735e+00_r8, & + &1.0495e+00_r8,5.2527e-01_r8,1.1808e-04_r8/) + kao(:, 2,13, 1) = (/ & + &5.0398e+00_r8,4.4101e+00_r8,3.7804e+00_r8,3.1506e+00_r8,2.5209e+00_r8,1.8912e+00_r8, & + &1.2614e+00_r8,6.3136e-01_r8,1.5519e-04_r8/) + kao(:, 3,13, 1) = (/ & + &5.9030e+00_r8,5.1655e+00_r8,4.4278e+00_r8,3.6903e+00_r8,2.9527e+00_r8,2.2152e+00_r8, & + &1.4774e+00_r8,7.3950e-01_r8,1.9283e-04_r8/) + kao(:, 4,13, 1) = (/ & + &6.7598e+00_r8,5.9151e+00_r8,5.0706e+00_r8,4.2260e+00_r8,3.3815e+00_r8,2.5368e+00_r8, & + &1.6919e+00_r8,8.4706e-01_r8,2.3479e-04_r8/) + kao(:, 5,13, 1) = (/ & + &7.6160e+00_r8,6.6645e+00_r8,5.7130e+00_r8,4.7615e+00_r8,3.8100e+00_r8,2.8583e+00_r8, & + &1.9066e+00_r8,9.5472e-01_r8,2.9034e-04_r8/) + kao(:, 1, 1, 2) = (/ & + &2.4501e-02_r8,2.2546e-02_r8,2.0206e-02_r8,1.7580e-02_r8,1.4733e-02_r8,1.1757e-02_r8, & + &8.5871e-03_r8,4.9715e-03_r8,4.1358e-04_r8/) + kao(:, 2, 1, 2) = (/ & + &2.5392e-02_r8,2.3504e-02_r8,2.1061e-02_r8,1.8282e-02_r8,1.5340e-02_r8,1.2238e-02_r8, & + &8.8921e-03_r8,5.1114e-03_r8,3.8966e-04_r8/) + kao(:, 3, 1, 2) = (/ & + &2.6027e-02_r8,2.4221e-02_r8,2.1673e-02_r8,1.8830e-02_r8,1.5807e-02_r8,1.2525e-02_r8, & + &9.1668e-03_r8,5.5997e-03_r8,3.7711e-04_r8/) + kao(:, 4, 1, 2) = (/ & + &2.6673e-02_r8,2.4919e-02_r8,2.2282e-02_r8,1.9349e-02_r8,1.6139e-02_r8,1.2835e-02_r8, & + &9.4247e-03_r8,5.9143e-03_r8,4.3807e-04_r8/) + kao(:, 5, 1, 2) = (/ & + &2.7193e-02_r8,2.5447e-02_r8,2.2733e-02_r8,1.9712e-02_r8,1.6469e-02_r8,1.3190e-02_r8, & + &9.7078e-03_r8,6.2746e-03_r8,5.1500e-04_r8/) + kao(:, 1, 2, 2) = (/ & + &3.1935e-02_r8,2.8971e-02_r8,2.5689e-02_r8,2.2139e-02_r8,1.8357e-02_r8,1.4398e-02_r8, & + &1.0314e-02_r8,5.7860e-03_r8,2.7704e-04_r8/) + kao(:, 2, 2, 2) = (/ & + &3.3322e-02_r8,3.0388e-02_r8,2.6935e-02_r8,2.3180e-02_r8,1.9196e-02_r8,1.5076e-02_r8, & + &1.0778e-02_r8,6.0195e-03_r8,2.7933e-04_r8/) + kao(:, 3, 2, 2) = (/ & + &3.4372e-02_r8,3.1484e-02_r8,2.7888e-02_r8,2.3966e-02_r8,1.9860e-02_r8,1.5585e-02_r8, & + &1.1079e-02_r8,6.3448e-03_r8,2.7118e-04_r8/) + kao(:, 4, 2, 2) = (/ & + &3.5247e-02_r8,3.2382e-02_r8,2.8654e-02_r8,2.4627e-02_r8,2.0404e-02_r8,1.5949e-02_r8, & + &1.1392e-02_r8,6.6539e-03_r8,3.3360e-04_r8/) + kao(:, 5, 2, 2) = (/ & + &3.6022e-02_r8,3.3132e-02_r8,2.9304e-02_r8,2.5200e-02_r8,2.0861e-02_r8,1.6331e-02_r8, & + &1.1785e-02_r8,6.9927e-03_r8,3.9477e-04_r8/) + kao(:, 1, 3, 2) = (/ & + &5.5981e-02_r8,4.9895e-02_r8,4.3680e-02_r8,3.7190e-02_r8,3.0485e-02_r8,2.3562e-02_r8, & + &1.6425e-02_r8,9.0449e-03_r8,1.7015e-04_r8/) + kao(:, 2, 3, 2) = (/ & + &5.8799e-02_r8,5.2631e-02_r8,4.6091e-02_r8,3.9226e-02_r8,3.2137e-02_r8,2.4836e-02_r8, & + &1.7301e-02_r8,9.5109e-03_r8,1.8305e-04_r8/) + kao(:, 3, 3, 2) = (/ & + &6.0996e-02_r8,5.4813e-02_r8,4.8006e-02_r8,4.0820e-02_r8,3.3414e-02_r8,2.5787e-02_r8, & + &1.7985e-02_r8,9.8187e-03_r8,1.8905e-04_r8/) + kao(:, 4, 3, 2) = (/ & + &6.2707e-02_r8,5.6481e-02_r8,4.9388e-02_r8,4.1983e-02_r8,3.4344e-02_r8,2.6526e-02_r8, & + &1.8461e-02_r8,1.0117e-02_r8,2.4096e-04_r8/) + kao(:, 5, 3, 2) = (/ & + &6.4195e-02_r8,5.7890e-02_r8,5.0593e-02_r8,4.2977e-02_r8,3.5166e-02_r8,2.7170e-02_r8, & + &1.8910e-02_r8,1.0511e-02_r8,2.9172e-04_r8/) + kao(:, 1, 4, 2) = (/ & + &1.0046e-01_r8,8.8696e-02_r8,7.6950e-02_r8,6.5010e-02_r8,5.2854e-02_r8,4.0445e-02_r8, & + &2.7753e-02_r8,1.4715e-02_r8,1.1527e-04_r8/) + kao(:, 2, 4, 2) = (/ & + &1.0584e-01_r8,9.3644e-02_r8,8.1343e-02_r8,6.8725e-02_r8,5.5817e-02_r8,4.2663e-02_r8, & + &2.9258e-02_r8,1.5519e-02_r8,1.2102e-04_r8/) + kao(:, 3, 4, 2) = (/ & + &1.1041e-01_r8,9.7926e-02_r8,8.5123e-02_r8,7.1882e-02_r8,5.8341e-02_r8,4.4558e-02_r8, & + &3.0554e-02_r8,1.6224e-02_r8,1.3450e-04_r8/) + kao(:, 4, 4, 2) = (/ & + &1.1403e-01_r8,1.0136e-01_r8,8.8078e-02_r8,7.4319e-02_r8,6.0266e-02_r8,4.6028e-02_r8, & + &3.1549e-02_r8,1.6730e-02_r8,1.7483e-04_r8/) + kao(:, 5, 4, 2) = (/ & + &1.1675e-01_r8,1.0391e-01_r8,9.0226e-02_r8,7.6062e-02_r8,6.1699e-02_r8,4.7119e-02_r8, & + &3.2315e-02_r8,1.7160e-02_r8,2.1415e-04_r8/) + kao(:, 1, 5, 2) = (/ & + &1.6440e-01_r8,1.4448e-01_r8,1.2464e-01_r8,1.0475e-01_r8,8.4706e-02_r8,6.4458e-02_r8, & + &4.3883e-02_r8,2.2824e-02_r8,7.5213e-05_r8/) + kao(:, 2, 5, 2) = (/ & + &1.7418e-01_r8,1.5330e-01_r8,1.3243e-01_r8,1.1140e-01_r8,9.0109e-02_r8,6.8519e-02_r8, & + &4.6576e-02_r8,2.4202e-02_r8,8.0510e-05_r8/) + kao(:, 3, 5, 2) = (/ & + &1.8254e-01_r8,1.6088e-01_r8,1.3912e-01_r8,1.1702e-01_r8,9.4586e-02_r8,7.1837e-02_r8, & + &4.8767e-02_r8,2.5350e-02_r8,9.6196e-05_r8/) + kao(:, 4, 5, 2) = (/ & + &1.8937e-01_r8,1.6713e-01_r8,1.4454e-01_r8,1.2155e-01_r8,9.8195e-02_r8,7.4514e-02_r8, & + &5.0569e-02_r8,2.6308e-02_r8,1.2696e-04_r8/) + kao(:, 5, 5, 2) = (/ & + &1.9452e-01_r8,1.7183e-01_r8,1.4864e-01_r8,1.2495e-01_r8,1.0086e-01_r8,7.6520e-02_r8, & + &5.1964e-02_r8,2.7040e-02_r8,1.5611e-04_r8/) + kao(:, 1, 6, 2) = (/ & + &2.4921e-01_r8,2.1859e-01_r8,1.8798e-01_r8,1.5740e-01_r8,1.2679e-01_r8,9.6030e-02_r8, & + &6.5011e-02_r8,3.3513e-02_r8,4.7816e-05_r8/) + kao(:, 2, 6, 2) = (/ & + &2.6657e-01_r8,2.3398e-01_r8,2.0147e-01_r8,1.6890e-01_r8,1.3619e-01_r8,1.0322e-01_r8, & + &6.9866e-02_r8,3.5915e-02_r8,5.5771e-05_r8/) + kao(:, 3, 6, 2) = (/ & + &2.8078e-01_r8,2.4667e-01_r8,2.1258e-01_r8,1.7831e-01_r8,1.4376e-01_r8,1.0887e-01_r8, & + &7.3553e-02_r8,3.7752e-02_r8,7.2324e-05_r8/) + kao(:, 4, 6, 2) = (/ & + &2.9281e-01_r8,2.5752e-01_r8,2.2202e-01_r8,1.8622e-01_r8,1.5008e-01_r8,1.1356e-01_r8, & + &7.6693e-02_r8,3.9339e-02_r8,9.1831e-05_r8/) + kao(:, 5, 6, 2) = (/ & + &3.0221e-01_r8,2.6598e-01_r8,2.2929e-01_r8,1.9231e-01_r8,1.5490e-01_r8,1.1717e-01_r8, & + &7.9072e-02_r8,4.0614e-02_r8,1.1670e-04_r8/) + kao(:, 1, 7, 2) = (/ & + &3.9471e-01_r8,3.4576e-01_r8,2.9687e-01_r8,2.4797e-01_r8,1.9909e-01_r8,1.5016e-01_r8, & + &1.0112e-01_r8,5.1719e-02_r8,4.5280e-05_r8/) + kao(:, 2, 7, 2) = (/ & + &4.2660e-01_r8,3.7391e-01_r8,3.2118e-01_r8,2.6853e-01_r8,2.1577e-01_r8,1.6297e-01_r8, & + &1.0986e-01_r8,5.6145e-02_r8,5.4459e-05_r8/) + kao(:, 3, 7, 2) = (/ & + &4.5301e-01_r8,3.9723e-01_r8,3.4149e-01_r8,2.8568e-01_r8,2.2975e-01_r8,1.7359e-01_r8, & + &1.1695e-01_r8,5.9583e-02_r8,6.4819e-05_r8/) + kao(:, 4, 7, 2) = (/ & + &4.7467e-01_r8,4.1649e-01_r8,3.5820e-01_r8,2.9973e-01_r8,2.4109e-01_r8,1.8208e-01_r8, & + &1.2251e-01_r8,6.2380e-02_r8,7.8660e-05_r8/) + kao(:, 5, 7, 2) = (/ & + &4.9199e-01_r8,4.3192e-01_r8,3.7144e-01_r8,3.1090e-01_r8,2.5000e-01_r8,1.8865e-01_r8, & + &1.2686e-01_r8,6.4563e-02_r8,9.4184e-05_r8/) + kao(:, 1, 8, 2) = (/ & + &7.4598e-01_r8,6.5300e-01_r8,5.6009e-01_r8,4.6718e-01_r8,3.7433e-01_r8,2.8142e-01_r8, & + &1.8848e-01_r8,9.5403e-02_r8,4.9176e-05_r8/) + kao(:, 2, 8, 2) = (/ & + &8.1434e-01_r8,7.1301e-01_r8,6.1173e-01_r8,5.1044e-01_r8,4.0917e-01_r8,3.0788e-01_r8, & + &2.0653e-01_r8,1.0477e-01_r8,6.1468e-05_r8/) + kao(:, 3, 8, 2) = (/ & + &8.7268e-01_r8,7.6440e-01_r8,6.5604e-01_r8,5.4759e-01_r8,4.3920e-01_r8,3.3065e-01_r8, & + &2.2200e-01_r8,1.1269e-01_r8,7.5902e-05_r8/) + kao(:, 4, 8, 2) = (/ & + &9.2025e-01_r8,8.0619e-01_r8,6.9208e-01_r8,5.7794e-01_r8,4.6363e-01_r8,3.4928e-01_r8, & + &2.3455e-01_r8,1.1876e-01_r8,9.2466e-05_r8/) + kao(:, 5, 8, 2) = (/ & + &9.5892e-01_r8,8.4025e-01_r8,7.2136e-01_r8,6.0245e-01_r8,4.8344e-01_r8,3.6420e-01_r8, & + &2.4431e-01_r8,1.2353e-01_r8,1.1186e-04_r8/) + kao(:, 1, 9, 2) = (/ & + &2.6457e+00_r8,2.3152e+00_r8,1.9846e+00_r8,1.6541e+00_r8,1.3236e+00_r8,9.9317e-01_r8, & + &6.6276e-01_r8,3.3240e-01_r8,8.9892e-05_r8/) + kao(:, 2, 9, 2) = (/ & + &2.9186e+00_r8,2.5541e+00_r8,2.1896e+00_r8,1.8252e+00_r8,1.4607e+00_r8,1.0963e+00_r8, & + &7.3190e-01_r8,3.6751e-01_r8,1.0914e-04_r8/) + kao(:, 3, 9, 2) = (/ & + &3.1587e+00_r8,2.7643e+00_r8,2.3700e+00_r8,1.9759e+00_r8,1.5816e+00_r8,1.1873e+00_r8, & + &7.9301e-01_r8,3.9869e-01_r8,1.2624e-04_r8/) + kao(:, 4, 9, 2) = (/ & + &3.3556e+00_r8,2.9370e+00_r8,2.5183e+00_r8,2.0996e+00_r8,1.6808e+00_r8,1.2622e+00_r8, & + &8.4339e-01_r8,4.2436e-01_r8,1.5596e-04_r8/) + kao(:, 5, 9, 2) = (/ & + &3.5177e+00_r8,3.0788e+00_r8,2.6401e+00_r8,2.2013e+00_r8,1.7625e+00_r8,1.3234e+00_r8, & + &8.8445e-01_r8,4.4528e-01_r8,1.9369e-04_r8/) + kao(:, 1,10, 2) = (/ & + &1.0501e+01_r8,9.1884e+00_r8,7.8763e+00_r8,6.5637e+00_r8,5.2509e+00_r8,3.9387e+00_r8, & + &2.6260e+00_r8,1.3137e+00_r8,1.7951e-04_r8/) + kao(:, 2,10, 2) = (/ & + &1.1694e+01_r8,1.0233e+01_r8,8.7714e+00_r8,7.3095e+00_r8,5.8477e+00_r8,4.3863e+00_r8, & + &2.9249e+00_r8,1.4636e+00_r8,2.1880e-04_r8/) + kao(:, 3,10, 2) = (/ & + &1.2771e+01_r8,1.1175e+01_r8,9.5787e+00_r8,7.9832e+00_r8,6.3867e+00_r8,4.7910e+00_r8, & + &3.1952e+00_r8,1.5993e+00_r8,2.5504e-04_r8/) + kao(:, 4,10, 2) = (/ & + &1.3661e+01_r8,1.1954e+01_r8,1.0247e+01_r8,8.5403e+00_r8,6.8331e+00_r8,5.1260e+00_r8, & + &3.4191e+00_r8,1.7121e+00_r8,3.1556e-04_r8/) + kao(:, 5,10, 2) = (/ & + &1.4403e+01_r8,1.2603e+01_r8,1.0804e+01_r8,9.0041e+00_r8,7.2046e+00_r8,5.4047e+00_r8, & + &3.6050e+00_r8,1.8055e+00_r8,3.5095e-04_r8/) + kao(:, 1,11, 2) = (/ & + &1.5305e+01_r8,1.3391e+01_r8,1.1479e+01_r8,9.5654e+00_r8,7.6527e+00_r8,5.7399e+00_r8, & + &3.8269e+00_r8,1.9139e+00_r8,2.5263e-04_r8/) + kao(:, 2,11, 2) = (/ & + &1.7053e+01_r8,1.4921e+01_r8,1.2790e+01_r8,1.0658e+01_r8,8.5272e+00_r8,6.3954e+00_r8, & + &4.2646e+00_r8,2.1334e+00_r8,3.2671e-04_r8/) + kao(:, 3,11, 2) = (/ & + &1.8597e+01_r8,1.6273e+01_r8,1.3949e+01_r8,1.1625e+01_r8,9.3007e+00_r8,6.9759e+00_r8, & + &4.6520e+00_r8,2.3277e+00_r8,3.9618e-04_r8/) + kao(:, 4,11, 2) = (/ & + &1.9894e+01_r8,1.7409e+01_r8,1.4922e+01_r8,1.2436e+01_r8,9.9497e+00_r8,7.4632e+00_r8, & + &4.9771e+00_r8,2.4907e+00_r8,4.6029e-04_r8/) + kao(:, 5,11, 2) = (/ & + &2.0957e+01_r8,1.8337e+01_r8,1.5718e+01_r8,1.3099e+01_r8,1.0480e+01_r8,7.8611e+00_r8, & + &5.2427e+00_r8,2.6238e+00_r8,5.1000e-04_r8/) + kao(:, 1,12, 2) = (/ & + &1.6595e+01_r8,1.4521e+01_r8,1.2446e+01_r8,1.0372e+01_r8,8.2975e+00_r8,6.2234e+00_r8, & + &4.1492e+00_r8,2.0749e+00_r8,2.8721e-04_r8/) + kao(:, 2,12, 2) = (/ & + &1.8487e+01_r8,1.6178e+01_r8,1.3866e+01_r8,1.1556e+01_r8,9.2444e+00_r8,6.9339e+00_r8, & + &4.6231e+00_r8,2.3126e+00_r8,3.5210e-04_r8/) + kao(:, 3,12, 2) = (/ & + &2.0157e+01_r8,1.7638e+01_r8,1.5119e+01_r8,1.2600e+01_r8,1.0080e+01_r8,7.5607e+00_r8, & + &5.0414e+00_r8,2.5223e+00_r8,4.4248e-04_r8/) + kao(:, 4,12, 2) = (/ & + &2.1568e+01_r8,1.8872e+01_r8,1.6176e+01_r8,1.3480e+01_r8,1.0785e+01_r8,8.0897e+00_r8, & + &5.3945e+00_r8,2.6993e+00_r8,5.0244e-04_r8/) + kao(:, 5,12, 2) = (/ & + &2.2671e+01_r8,1.9838e+01_r8,1.7004e+01_r8,1.4170e+01_r8,1.1337e+01_r8,8.5042e+00_r8, & + &5.6711e+00_r8,2.8381e+00_r8,5.5567e-04_r8/) + kao(:, 1,13, 2) = (/ & + &1.4451e+01_r8,1.2644e+01_r8,1.0838e+01_r8,9.0321e+00_r8,7.2259e+00_r8,5.4197e+00_r8, & + &3.6133e+00_r8,1.8070e+00_r8,2.7932e-04_r8/) + kao(:, 2,13, 2) = (/ & + &1.6097e+01_r8,1.4085e+01_r8,1.2073e+01_r8,1.0061e+01_r8,8.0489e+00_r8,6.0372e+00_r8, & + &4.0253e+00_r8,2.0137e+00_r8,3.2799e-04_r8/) + kao(:, 3,13, 2) = (/ & + &1.7564e+01_r8,1.5369e+01_r8,1.3173e+01_r8,1.0978e+01_r8,8.7826e+00_r8,6.5876e+00_r8, & + &4.3925e+00_r8,2.1975e+00_r8,4.0780e-04_r8/) + kao(:, 4,13, 2) = (/ & + &1.8771e+01_r8,1.6426e+01_r8,1.4079e+01_r8,1.1733e+01_r8,9.3868e+00_r8,7.0409e+00_r8, & + &4.6954e+00_r8,2.3495e+00_r8,5.0230e-04_r8/) + kao(:, 5,13, 2) = (/ & + &1.9694e+01_r8,1.7232e+01_r8,1.4771e+01_r8,1.2310e+01_r8,9.8489e+00_r8,7.3875e+00_r8, & + &4.9264e+00_r8,2.4656e+00_r8,5.5102e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &3.7564e-02_r8,3.3492e-02_r8,2.9385e-02_r8,2.5064e-02_r8,2.0679e-02_r8,1.6159e-02_r8, & + &1.1502e-02_r8,6.5367e-03_r8,3.9794e-04_r8/) + kao(:, 2, 1, 3) = (/ & + &3.6916e-02_r8,3.3151e-02_r8,2.9160e-02_r8,2.5018e-02_r8,2.0751e-02_r8,1.6389e-02_r8, & + &1.1901e-02_r8,7.2678e-03_r8,5.4686e-04_r8/) + kao(:, 3, 1, 3) = (/ & + &3.6399e-02_r8,3.2903e-02_r8,2.9031e-02_r8,2.5012e-02_r8,2.0900e-02_r8,1.6718e-02_r8, & + &1.2389e-02_r8,8.0801e-03_r8,7.4220e-04_r8/) + kao(:, 4, 1, 3) = (/ & + &3.6126e-02_r8,3.2782e-02_r8,2.9047e-02_r8,2.5198e-02_r8,2.1279e-02_r8,1.7152e-02_r8, & + &1.3045e-02_r8,8.9482e-03_r8,8.9478e-04_r8/) + kao(:, 5, 1, 3) = (/ & + &3.5996e-02_r8,3.2833e-02_r8,2.9270e-02_r8,2.5593e-02_r8,2.1712e-02_r8,1.7723e-02_r8, & + &1.3812e-02_r8,9.7243e-03_r8,1.0975e-03_r8/) + kao(:, 1, 2, 3) = (/ & + &4.9545e-02_r8,4.3840e-02_r8,3.8273e-02_r8,3.2472e-02_r8,2.6558e-02_r8,2.0510e-02_r8, & + &1.4332e-02_r8,7.7992e-03_r8,3.0769e-04_r8/) + kao(:, 2, 2, 3) = (/ & + &4.8709e-02_r8,4.3359e-02_r8,3.7969e-02_r8,3.2304e-02_r8,2.6513e-02_r8,2.0603e-02_r8, & + &1.4626e-02_r8,8.4051e-03_r8,4.1476e-04_r8/) + kao(:, 3, 2, 3) = (/ & + &4.8165e-02_r8,4.3120e-02_r8,3.7795e-02_r8,3.2248e-02_r8,2.6570e-02_r8,2.0838e-02_r8, & + &1.4977e-02_r8,8.9685e-03_r8,5.6832e-04_r8/) + kao(:, 4, 2, 3) = (/ & + &4.7962e-02_r8,4.3077e-02_r8,3.7844e-02_r8,3.2393e-02_r8,2.6873e-02_r8,2.1238e-02_r8, & + &1.5407e-02_r8,9.6431e-03_r8,6.7745e-04_r8/) + kao(:, 5, 2, 3) = (/ & + &4.8025e-02_r8,4.3378e-02_r8,3.8202e-02_r8,3.2847e-02_r8,2.7374e-02_r8,2.1742e-02_r8, & + &1.5999e-02_r8,1.0391e-02_r8,8.3539e-04_r8/) + kao(:, 1, 3, 3) = (/ & + &8.8120e-02_r8,7.7386e-02_r8,6.6977e-02_r8,5.6500e-02_r8,4.5838e-02_r8,3.5027e-02_r8, & + &2.3995e-02_r8,1.2704e-02_r8,2.2676e-04_r8/) + kao(:, 2, 3, 3) = (/ & + &8.6799e-02_r8,7.6419e-02_r8,6.6419e-02_r8,5.6119e-02_r8,4.5623e-02_r8,3.4916e-02_r8, & + &2.4025e-02_r8,1.3004e-02_r8,3.0168e-04_r8/) + kao(:, 3, 3, 3) = (/ & + &8.6001e-02_r8,7.6005e-02_r8,6.6184e-02_r8,5.6008e-02_r8,4.5591e-02_r8,3.4990e-02_r8, & + &2.4263e-02_r8,1.3424e-02_r8,3.9676e-04_r8/) + kao(:, 4, 3, 3) = (/ & + &8.5691e-02_r8,7.5994e-02_r8,6.6270e-02_r8,5.6158e-02_r8,4.5788e-02_r8,3.5296e-02_r8, & + &2.4707e-02_r8,1.3830e-02_r8,4.9186e-04_r8/) + kao(:, 5, 3, 3) = (/ & + &8.6172e-02_r8,7.6716e-02_r8,6.6965e-02_r8,5.6820e-02_r8,4.6489e-02_r8,3.5977e-02_r8, & + &2.5332e-02_r8,1.4387e-02_r8,6.1173e-04_r8/) + kao(:, 1, 4, 3) = (/ & + &1.6100e-01_r8,1.4106e-01_r8,1.2117e-01_r8,1.0160e-01_r8,8.1953e-02_r8,6.2189e-02_r8, & + &4.2184e-02_r8,2.1860e-02_r8,1.5920e-04_r8/) + kao(:, 2, 4, 3) = (/ & + &1.5854e-01_r8,1.3897e-01_r8,1.1977e-01_r8,1.0067e-01_r8,8.1408e-02_r8,6.1866e-02_r8, & + &4.2083e-02_r8,2.1896e-02_r8,2.1901e-04_r8/) + kao(:, 3, 4, 3) = (/ & + &1.5713e-01_r8,1.3793e-01_r8,1.1924e-01_r8,1.0046e-01_r8,8.1310e-02_r8,6.1926e-02_r8, & + &4.2176e-02_r8,2.2134e-02_r8,2.8281e-04_r8/) + kao(:, 4, 4, 3) = (/ & + &1.5680e-01_r8,1.3795e-01_r8,1.1956e-01_r8,1.0071e-01_r8,8.1588e-02_r8,6.2136e-02_r8, & + &4.2469e-02_r8,2.2574e-02_r8,3.5509e-04_r8/) + kao(:, 5, 4, 3) = (/ & + &1.5807e-01_r8,1.3940e-01_r8,1.2093e-01_r8,1.0191e-01_r8,8.2580e-02_r8,6.3036e-02_r8, & + &4.3252e-02_r8,2.3169e-02_r8,4.4437e-04_r8/) + kao(:, 1, 5, 3) = (/ & + &2.7295e-01_r8,2.3896e-01_r8,2.0497e-01_r8,1.7107e-01_r8,1.3742e-01_r8,1.0372e-01_r8, & + &6.9897e-02_r8,3.5756e-02_r8,1.1345e-04_r8/) + kao(:, 2, 5, 3) = (/ & + &2.6909e-01_r8,2.3567e-01_r8,2.0228e-01_r8,1.6922e-01_r8,1.3618e-01_r8,1.0303e-01_r8, & + &6.9598e-02_r8,3.5741e-02_r8,1.5887e-04_r8/) + kao(:, 3, 5, 3) = (/ & + &2.6654e-01_r8,2.3348e-01_r8,2.0077e-01_r8,1.6833e-01_r8,1.3583e-01_r8,1.0288e-01_r8, & + &6.9627e-02_r8,3.5834e-02_r8,2.0432e-04_r8/) + kao(:, 4, 5, 3) = (/ & + &2.6633e-01_r8,2.3346e-01_r8,2.0125e-01_r8,1.6903e-01_r8,1.3632e-01_r8,1.0334e-01_r8, & + &6.9968e-02_r8,3.6152e-02_r8,2.5784e-04_r8/) + kao(:, 5, 5, 3) = (/ & + &2.6868e-01_r8,2.3592e-01_r8,2.0366e-01_r8,1.7109e-01_r8,1.3803e-01_r8,1.0467e-01_r8, & + &7.0932e-02_r8,3.6877e-02_r8,3.2436e-04_r8/) + kao(:, 1, 6, 3) = (/ & + &4.3357e-01_r8,3.7951e-01_r8,3.2542e-01_r8,2.7129e-01_r8,2.1728e-01_r8,1.6346e-01_r8, & + &1.0964e-01_r8,5.5662e-02_r8,8.3325e-05_r8/) + kao(:, 2, 6, 3) = (/ & + &4.2794e-01_r8,3.7459e-01_r8,3.2123e-01_r8,2.6798e-01_r8,2.1494e-01_r8,1.6197e-01_r8, & + &1.0894e-01_r8,5.5488e-02_r8,1.1433e-04_r8/) + kao(:, 3, 6, 3) = (/ & + &4.2362e-01_r8,3.7090e-01_r8,3.1822e-01_r8,2.6585e-01_r8,2.1359e-01_r8,1.6133e-01_r8, & + &1.0870e-01_r8,5.5444e-02_r8,1.4294e-04_r8/) + kao(:, 4, 6, 3) = (/ & + &4.2356e-01_r8,3.7092e-01_r8,3.1860e-01_r8,2.6656e-01_r8,2.1457e-01_r8,1.6217e-01_r8, & + &1.0928e-01_r8,5.5858e-02_r8,1.8487e-04_r8/) + kao(:, 5, 6, 3) = (/ & + &4.2732e-01_r8,3.7444e-01_r8,3.2213e-01_r8,2.6992e-01_r8,2.1742e-01_r8,1.6433e-01_r8, & + &1.1084e-01_r8,5.6756e-02_r8,2.3367e-04_r8/) + kao(:, 1, 7, 3) = (/ & + &7.2201e-01_r8,6.3185e-01_r8,5.4168e-01_r8,4.5148e-01_r8,3.6131e-01_r8,2.7123e-01_r8, & + &1.8131e-01_r8,9.1347e-02_r8,6.1051e-05_r8/) + kao(:, 2, 7, 3) = (/ & + &7.1295e-01_r8,6.2391e-01_r8,5.3487e-01_r8,4.4585e-01_r8,3.5694e-01_r8,2.6824e-01_r8, & + &1.7961e-01_r8,9.0876e-02_r8,8.2662e-05_r8/) + kao(:, 3, 7, 3) = (/ & + &7.0704e-01_r8,6.1882e-01_r8,5.3061e-01_r8,4.4252e-01_r8,3.5463e-01_r8,2.6681e-01_r8, & + &1.7908e-01_r8,9.0926e-02_r8,1.0796e-04_r8/) + kao(:, 4, 7, 3) = (/ & + &7.0657e-01_r8,6.1841e-01_r8,5.3039e-01_r8,4.4278e-01_r8,3.5513e-01_r8,2.6769e-01_r8, & + &1.7995e-01_r8,9.1305e-02_r8,1.3920e-04_r8/) + kao(:, 5, 7, 3) = (/ & + &7.1310e-01_r8,6.2430e-01_r8,5.3600e-01_r8,4.4782e-01_r8,3.5976e-01_r8,2.7158e-01_r8, & + &1.8261e-01_r8,9.2814e-02_r8,1.7572e-04_r8/) + kao(:, 1, 8, 3) = (/ & + &1.4344e+00_r8,1.2551e+00_r8,1.0759e+00_r8,8.9667e-01_r8,7.1735e-01_r8,5.3821e-01_r8, & + &3.5899e-01_r8,1.8011e-01_r8,7.5748e-05_r8/) + kao(:, 2, 8, 3) = (/ & + &1.4191e+00_r8,1.2419e+00_r8,1.0645e+00_r8,8.8713e-01_r8,7.0979e-01_r8,5.3268e-01_r8, & + &3.5557e-01_r8,1.7867e-01_r8,9.9921e-05_r8/) + kao(:, 3, 8, 3) = (/ & + &1.4086e+00_r8,1.2327e+00_r8,1.0566e+00_r8,8.8065e-01_r8,7.0478e-01_r8,5.2920e-01_r8, & + &3.5364e-01_r8,1.7813e-01_r8,1.2236e-04_r8/) + kao(:, 4, 8, 3) = (/ & + &1.4087e+00_r8,1.2327e+00_r8,1.0568e+00_r8,8.8106e-01_r8,7.0553e-01_r8,5.2998e-01_r8, & + &3.5460e-01_r8,1.7919e-01_r8,1.5414e-04_r8/) + kao(:, 5, 8, 3) = (/ & + &1.4217e+00_r8,1.2444e+00_r8,1.0672e+00_r8,8.9025e-01_r8,7.1327e-01_r8,5.3627e-01_r8, & + &3.5965e-01_r8,1.8202e-01_r8,1.9115e-04_r8/) + kao(:, 1, 9, 3) = (/ & + &5.3656e+00_r8,4.6949e+00_r8,4.0244e+00_r8,3.3536e+00_r8,2.6829e+00_r8,2.0124e+00_r8, & + &1.3418e+00_r8,6.7121e-01_r8,1.2938e-04_r8/) + kao(:, 2, 9, 3) = (/ & + &5.3249e+00_r8,4.6593e+00_r8,3.9938e+00_r8,3.3284e+00_r8,2.6628e+00_r8,1.9972e+00_r8, & + &1.3317e+00_r8,6.6623e-01_r8,1.6248e-04_r8/) + kao(:, 3, 9, 3) = (/ & + &5.2842e+00_r8,4.6238e+00_r8,3.9633e+00_r8,3.3029e+00_r8,2.6426e+00_r8,1.9822e+00_r8, & + &1.3219e+00_r8,6.6174e-01_r8,2.1505e-04_r8/) + kao(:, 4, 9, 3) = (/ & + &5.2909e+00_r8,4.6297e+00_r8,3.9685e+00_r8,3.3074e+00_r8,2.6461e+00_r8,1.9850e+00_r8, & + &1.3243e+00_r8,6.6344e-01_r8,2.5323e-04_r8/) + kao(:, 5, 9, 3) = (/ & + &5.3328e+00_r8,4.6665e+00_r8,4.0003e+00_r8,3.3342e+00_r8,2.6682e+00_r8,2.0021e+00_r8, & + &1.3361e+00_r8,6.6998e-01_r8,2.8724e-04_r8/) + kao(:, 1,10, 3) = (/ & + &2.2338e+01_r8,1.9545e+01_r8,1.6753e+01_r8,1.3961e+01_r8,1.1170e+01_r8,8.3767e+00_r8, & + &5.5849e+00_r8,2.7925e+00_r8,2.7123e-04_r8/) + kao(:, 2,10, 3) = (/ & + &2.2247e+01_r8,1.9467e+01_r8,1.6686e+01_r8,1.3905e+01_r8,1.1124e+01_r8,8.3431e+00_r8, & + &5.5623e+00_r8,2.7817e+00_r8,3.3076e-04_r8/) + kao(:, 3,10, 3) = (/ & + &2.2079e+01_r8,1.9319e+01_r8,1.6560e+01_r8,1.3800e+01_r8,1.1040e+01_r8,8.2801e+00_r8, & + &5.5205e+00_r8,2.7607e+00_r8,4.2235e-04_r8/) + kao(:, 4,10, 3) = (/ & + &2.2133e+01_r8,1.9366e+01_r8,1.6600e+01_r8,1.3833e+01_r8,1.1067e+01_r8,8.3005e+00_r8, & + &5.5343e+00_r8,2.7680e+00_r8,4.8628e-04_r8/) + kao(:, 5,10, 3) = (/ & + &2.2337e+01_r8,1.9545e+01_r8,1.6754e+01_r8,1.3962e+01_r8,1.1171e+01_r8,8.3788e+00_r8, & + &5.5873e+00_r8,2.7956e+00_r8,6.0636e-04_r8/) + kao(:, 1,11, 3) = (/ & + &3.2372e+01_r8,2.8324e+01_r8,2.4279e+01_r8,2.0232e+01_r8,1.6186e+01_r8,1.2140e+01_r8, & + &8.0929e+00_r8,4.0469e+00_r8,3.8659e-04_r8/) + kao(:, 2,11, 3) = (/ & + &3.2225e+01_r8,2.8197e+01_r8,2.4169e+01_r8,2.0141e+01_r8,1.6113e+01_r8,1.2085e+01_r8, & + &8.0568e+00_r8,4.0284e+00_r8,4.6837e-04_r8/) + kao(:, 3,11, 3) = (/ & + &3.2089e+01_r8,2.8078e+01_r8,2.4068e+01_r8,2.0057e+01_r8,1.6046e+01_r8,1.2035e+01_r8, & + &8.0232e+00_r8,4.0121e+00_r8,5.6676e-04_r8/) + kao(:, 4,11, 3) = (/ & + &3.2281e+01_r8,2.8246e+01_r8,2.4212e+01_r8,2.0176e+01_r8,1.6141e+01_r8,1.2106e+01_r8, & + &8.0716e+00_r8,4.0370e+00_r8,7.3031e-04_r8/) + kao(:, 5,11, 3) = (/ & + &3.2736e+01_r8,2.8646e+01_r8,2.4553e+01_r8,2.0462e+01_r8,1.6370e+01_r8,1.2278e+01_r8, & + &8.1864e+00_r8,4.0949e+00_r8,8.3516e-04_r8/) + kao(:, 1,12, 3) = (/ & + &3.4882e+01_r8,3.0522e+01_r8,2.6162e+01_r8,2.1802e+01_r8,1.7441e+01_r8,1.3081e+01_r8, & + &8.7208e+00_r8,4.3607e+00_r8,4.1853e-04_r8/) + kao(:, 2,12, 3) = (/ & + &3.4744e+01_r8,3.0400e+01_r8,2.6058e+01_r8,2.1715e+01_r8,1.7372e+01_r8,1.3029e+01_r8, & + &8.6862e+00_r8,4.3435e+00_r8,5.1635e-04_r8/) + kao(:, 3,12, 3) = (/ & + &3.4694e+01_r8,3.0356e+01_r8,2.6020e+01_r8,2.1683e+01_r8,1.7347e+01_r8,1.3010e+01_r8, & + &8.6737e+00_r8,4.3374e+00_r8,5.8258e-04_r8/) + kao(:, 4,12, 3) = (/ & + &3.4999e+01_r8,3.0625e+01_r8,2.6249e+01_r8,2.1876e+01_r8,1.7501e+01_r8,1.3126e+01_r8, & + &8.7513e+00_r8,4.3768e+00_r8,7.2545e-04_r8/) + kao(:, 5,12, 3) = (/ & + &3.5658e+01_r8,3.1201e+01_r8,2.6744e+01_r8,2.2288e+01_r8,1.7831e+01_r8,1.3374e+01_r8, & + &8.9165e+00_r8,4.4593e+00_r8,9.3950e-04_r8/) + kao(:, 1,13, 3) = (/ & + &3.0168e+01_r8,2.6399e+01_r8,2.2627e+01_r8,1.8855e+01_r8,1.5085e+01_r8,1.1314e+01_r8, & + &7.5425e+00_r8,3.7715e+00_r8,4.1524e-04_r8/) + kao(:, 2,13, 3) = (/ & + &3.0082e+01_r8,2.6321e+01_r8,2.2562e+01_r8,1.8800e+01_r8,1.5040e+01_r8,1.1280e+01_r8, & + &7.5203e+00_r8,3.7604e+00_r8,5.1897e-04_r8/) + kao(:, 3,13, 3) = (/ & + &3.0098e+01_r8,2.6336e+01_r8,2.2574e+01_r8,1.8812e+01_r8,1.5049e+01_r8,1.1287e+01_r8, & + &7.5253e+00_r8,3.7634e+00_r8,6.3490e-04_r8/) + kao(:, 4,13, 3) = (/ & + &3.0488e+01_r8,2.6677e+01_r8,2.2867e+01_r8,1.9056e+01_r8,1.5245e+01_r8,1.1434e+01_r8, & + &7.6233e+00_r8,3.8122e+00_r8,7.3304e-04_r8/) + kao(:, 5,13, 3) = (/ & + &3.1139e+01_r8,2.7247e+01_r8,2.3355e+01_r8,1.9463e+01_r8,1.5570e+01_r8,1.1678e+01_r8, & + &7.7859e+00_r8,3.8940e+00_r8,8.6573e-04_r8/) + kao(:, 1, 1, 4) = (/ & + &5.2057e-02_r8,4.6191e-02_r8,4.0791e-02_r8,3.5264e-02_r8,2.9386e-02_r8,2.3311e-02_r8, & + &1.6933e-02_r8,9.9741e-03_r8,9.4742e-04_r8/) + kao(:, 2, 1, 4) = (/ & + &5.1799e-02_r8,4.6370e-02_r8,4.1424e-02_r8,3.5942e-02_r8,3.0151e-02_r8,2.4090e-02_r8, & + &1.7827e-02_r8,1.1138e-02_r8,1.1643e-03_r8/) + kao(:, 3, 1, 4) = (/ & + &5.1774e-02_r8,4.6875e-02_r8,4.2240e-02_r8,3.6825e-02_r8,3.1105e-02_r8,2.5101e-02_r8, & + &1.8967e-02_r8,1.2189e-02_r8,1.4467e-03_r8/) + kao(:, 4, 1, 4) = (/ & + &5.2049e-02_r8,4.7822e-02_r8,4.3286e-02_r8,3.7962e-02_r8,3.2336e-02_r8,2.6505e-02_r8, & + &2.0163e-02_r8,1.3176e-02_r8,1.8457e-03_r8/) + kao(:, 5, 1, 4) = (/ & + &5.2435e-02_r8,4.8877e-02_r8,4.4449e-02_r8,3.9288e-02_r8,3.3894e-02_r8,2.7971e-02_r8, & + &2.1357e-02_r8,1.4142e-02_r8,2.2765e-03_r8/) + kao(:, 1, 2, 4) = (/ & + &6.9283e-02_r8,6.1124e-02_r8,5.3312e-02_r8,4.5637e-02_r8,3.7639e-02_r8,2.9444e-02_r8, & + &2.0926e-02_r8,1.1987e-02_r8,6.7708e-04_r8/) + kao(:, 2, 2, 4) = (/ & + &6.9230e-02_r8,6.1365e-02_r8,5.4052e-02_r8,4.6528e-02_r8,3.8569e-02_r8,3.0382e-02_r8, & + &2.1758e-02_r8,1.2938e-02_r8,8.4618e-04_r8/) + kao(:, 3, 2, 4) = (/ & + &6.9474e-02_r8,6.2065e-02_r8,5.5235e-02_r8,4.7695e-02_r8,3.9803e-02_r8,3.1502e-02_r8, & + &2.2924e-02_r8,1.3989e-02_r8,1.0726e-03_r8/) + kao(:, 4, 2, 4) = (/ & + &7.0041e-02_r8,6.3262e-02_r8,5.6631e-02_r8,4.9140e-02_r8,4.1246e-02_r8,3.2954e-02_r8, & + &2.4393e-02_r8,1.5061e-02_r8,1.3926e-03_r8/) + kao(:, 5, 2, 4) = (/ & + &7.0798e-02_r8,6.4648e-02_r8,5.8174e-02_r8,5.0781e-02_r8,4.2976e-02_r8,3.4744e-02_r8, & + &2.5864e-02_r8,1.6092e-02_r8,1.7223e-03_r8/) + kao(:, 1, 3, 4) = (/ & + &1.2468e-01_r8,1.0948e-01_r8,9.4277e-02_r8,7.9471e-02_r8,6.4703e-02_r8,4.9713e-02_r8, & + &3.4483e-02_r8,1.8729e-02_r8,4.6220e-04_r8/) + kao(:, 2, 3, 4) = (/ & + &1.2473e-01_r8,1.0972e-01_r8,9.4939e-02_r8,8.0505e-02_r8,6.5924e-02_r8,5.0895e-02_r8, & + &3.5571e-02_r8,1.9546e-02_r8,5.8785e-04_r8/) + kao(:, 3, 3, 4) = (/ & + &1.2557e-01_r8,1.1074e-01_r8,9.6443e-02_r8,8.2330e-02_r8,6.7617e-02_r8,5.2547e-02_r8, & + &3.6938e-02_r8,2.0666e-02_r8,7.7467e-04_r8/) + kao(:, 4, 3, 4) = (/ & + &1.2675e-01_r8,1.1231e-01_r8,9.8604e-02_r8,8.4502e-02_r8,6.9700e-02_r8,5.4472e-02_r8, & + &3.8553e-02_r8,2.2075e-02_r8,9.9922e-04_r8/) + kao(:, 5, 3, 4) = (/ & + &1.2846e-01_r8,1.1449e-01_r8,1.0119e-01_r8,8.7016e-02_r8,7.2084e-02_r8,5.6669e-02_r8, & + &4.0555e-02_r8,2.3518e-02_r8,1.2453e-03_r8/) + kao(:, 1, 4, 4) = (/ & + &2.3029e-01_r8,2.0185e-01_r8,1.7335e-01_r8,1.4485e-01_r8,1.1669e-01_r8,8.8611e-02_r8, & + &6.0409e-02_r8,3.1699e-02_r8,3.0371e-04_r8/) + kao(:, 2, 4, 4) = (/ & + &2.2988e-01_r8,2.0158e-01_r8,1.7329e-01_r8,1.4525e-01_r8,1.1751e-01_r8,8.9738e-02_r8, & + &6.1449e-02_r8,3.2569e-02_r8,4.0236e-04_r8/) + kao(:, 3, 4, 4) = (/ & + &2.3229e-01_r8,2.0393e-01_r8,1.7566e-01_r8,1.4780e-01_r8,1.2020e-01_r8,9.2062e-02_r8, & + &6.3397e-02_r8,3.3957e-02_r8,5.4454e-04_r8/) + kao(:, 4, 4, 4) = (/ & + &2.3507e-01_r8,2.0665e-01_r8,1.7868e-01_r8,1.5121e-01_r8,1.2350e-01_r8,9.4964e-02_r8, & + &6.5854e-02_r8,3.5604e-02_r8,7.0998e-04_r8/) + kao(:, 5, 4, 4) = (/ & + &2.3825e-01_r8,2.0990e-01_r8,1.8240e-01_r8,1.5515e-01_r8,1.2704e-01_r8,9.8075e-02_r8, & + &6.8384e-02_r8,3.7494e-02_r8,8.9536e-04_r8/) + kao(:, 1, 5, 4) = (/ & + &3.8945e-01_r8,3.4103e-01_r8,2.9259e-01_r8,2.4415e-01_r8,1.9571e-01_r8,1.4754e-01_r8, & + &9.9565e-02_r8,5.1352e-02_r8,2.0409e-04_r8/) + kao(:, 2, 5, 4) = (/ & + &3.8981e-01_r8,3.4147e-01_r8,2.9305e-01_r8,2.4466e-01_r8,1.9659e-01_r8,1.4875e-01_r8, & + &1.0088e-01_r8,5.2387e-02_r8,2.7339e-04_r8/) + kao(:, 3, 5, 4) = (/ & + &3.9497e-01_r8,3.4612e-01_r8,2.9724e-01_r8,2.4861e-01_r8,2.0028e-01_r8,1.5226e-01_r8, & + &1.0369e-01_r8,5.4177e-02_r8,3.7984e-04_r8/) + kao(:, 4, 5, 4) = (/ & + &4.0149e-01_r8,3.5204e-01_r8,3.0270e-01_r8,2.5382e-01_r8,2.0546e-01_r8,1.5684e-01_r8, & + &1.0724e-01_r8,5.6458e-02_r8,5.0160e-04_r8/) + kao(:, 5, 5, 4) = (/ & + &4.0773e-01_r8,3.5786e-01_r8,3.0839e-01_r8,2.5956e-01_r8,2.1090e-01_r8,1.6141e-01_r8, & + &1.1086e-01_r8,5.8838e-02_r8,6.4384e-04_r8/) + kao(:, 1, 6, 4) = (/ & + &6.2109e-01_r8,5.4370e-01_r8,4.6619e-01_r8,3.8877e-01_r8,3.1132e-01_r8,2.3383e-01_r8, & + &1.5671e-01_r8,7.9602e-02_r8,1.3341e-04_r8/) + kao(:, 2, 6, 4) = (/ & + &6.2314e-01_r8,5.4556e-01_r8,4.6793e-01_r8,3.9037e-01_r8,3.1270e-01_r8,2.3534e-01_r8, & + &1.5827e-01_r8,8.0992e-02_r8,1.8152e-04_r8/) + kao(:, 3, 6, 4) = (/ & + &6.2957e-01_r8,5.5136e-01_r8,4.7308e-01_r8,3.9475e-01_r8,3.1676e-01_r8,2.3906e-01_r8, & + &1.6147e-01_r8,8.3225e-02_r8,2.5970e-04_r8/) + kao(:, 4, 6, 4) = (/ & + &6.4091e-01_r8,5.6147e-01_r8,4.8196e-01_r8,4.0265e-01_r8,3.2370e-01_r8,2.4515e-01_r8, & + &1.6638e-01_r8,8.6255e-02_r8,3.5139e-04_r8/) + kao(:, 5, 6, 4) = (/ & + &6.5388e-01_r8,5.7307e-01_r8,4.9223e-01_r8,4.1191e-01_r8,3.3205e-01_r8,2.5237e-01_r8, & + &1.7171e-01_r8,8.9448e-02_r8,4.5531e-04_r8/) + kao(:, 1, 7, 4) = (/ & + &1.0457e+00_r8,9.1519e-01_r8,7.8460e-01_r8,6.5401e-01_r8,5.2349e-01_r8,3.9292e-01_r8, & + &2.6230e-01_r8,1.3220e-01_r8,1.0032e-04_r8/) + kao(:, 2, 7, 4) = (/ & + &1.0500e+00_r8,9.1906e-01_r8,7.8807e-01_r8,6.5699e-01_r8,5.2599e-01_r8,3.9492e-01_r8, & + &2.6410e-01_r8,1.3358e-01_r8,1.3899e-04_r8/) + kao(:, 3, 7, 4) = (/ & + &1.0598e+00_r8,9.2774e-01_r8,7.9565e-01_r8,6.6349e-01_r8,5.3130e-01_r8,3.9936e-01_r8, & + &2.6782e-01_r8,1.3620e-01_r8,1.8444e-04_r8/) + kao(:, 4, 7, 4) = (/ & + &1.0743e+00_r8,9.4059e-01_r8,8.0685e-01_r8,6.7311e-01_r8,5.3945e-01_r8,4.0621e-01_r8, & + &2.7331e-01_r8,1.3995e-01_r8,2.4657e-04_r8/) + kao(:, 5, 7, 4) = (/ & + &1.0996e+00_r8,9.6289e-01_r8,8.2608e-01_r8,6.8953e-01_r8,5.5342e-01_r8,4.1738e-01_r8, & + &2.8182e-01_r8,1.4485e-01_r8,3.2431e-04_r8/) + kao(:, 1, 8, 4) = (/ & + &2.1071e+00_r8,1.8438e+00_r8,1.5804e+00_r8,1.3173e+00_r8,1.0540e+00_r8,7.9071e-01_r8, & + &5.2749e-01_r8,2.6416e-01_r8,1.1085e-04_r8/) + kao(:, 2, 8, 4) = (/ & + &2.1142e+00_r8,1.8501e+00_r8,1.5861e+00_r8,1.3219e+00_r8,1.0578e+00_r8,7.9379e-01_r8, & + &5.2971e-01_r8,2.6585e-01_r8,1.4810e-04_r8/) + kao(:, 3, 8, 4) = (/ & + &2.1318e+00_r8,1.8656e+00_r8,1.5995e+00_r8,1.3333e+00_r8,1.0671e+00_r8,8.0094e-01_r8, & + &5.3475e-01_r8,2.6918e-01_r8,1.9501e-04_r8/) + kao(:, 4, 8, 4) = (/ & + &2.1555e+00_r8,1.8865e+00_r8,1.6175e+00_r8,1.3486e+00_r8,1.0795e+00_r8,8.1059e-01_r8, & + &5.4205e-01_r8,2.7386e-01_r8,2.4224e-04_r8/) + kao(:, 5, 8, 4) = (/ & + &2.2062e+00_r8,1.9311e+00_r8,1.6560e+00_r8,1.3807e+00_r8,1.1056e+00_r8,8.3087e-01_r8, & + &5.5626e-01_r8,2.8214e-01_r8,2.8558e-04_r8/) + kao(:, 1, 9, 4) = (/ & + &7.9972e+00_r8,6.9979e+00_r8,5.9979e+00_r8,4.9986e+00_r8,3.9987e+00_r8,2.9994e+00_r8, & + &1.9999e+00_r8,1.0002e+00_r8,1.8668e-04_r8/) + kao(:, 2, 9, 4) = (/ & + &8.0128e+00_r8,7.0114e+00_r8,6.0097e+00_r8,5.0085e+00_r8,4.0070e+00_r8,3.0056e+00_r8, & + &2.0042e+00_r8,1.0027e+00_r8,2.5150e-04_r8/) + kao(:, 3, 9, 4) = (/ & + &8.0805e+00_r8,7.0702e+00_r8,6.0607e+00_r8,5.0509e+00_r8,4.0412e+00_r8,3.0319e+00_r8, & + &2.0219e+00_r8,1.0119e+00_r8,3.0396e-04_r8/) + kao(:, 4, 9, 4) = (/ & + &8.1743e+00_r8,7.1533e+00_r8,6.1315e+00_r8,5.1108e+00_r8,4.0892e+00_r8,3.0678e+00_r8, & + &2.0462e+00_r8,1.0247e+00_r8,3.5321e-04_r8/) + kao(:, 5, 9, 4) = (/ & + &8.3409e+00_r8,7.2988e+00_r8,6.2567e+00_r8,5.2146e+00_r8,4.1728e+00_r8,3.1306e+00_r8, & + &2.0885e+00_r8,1.0471e+00_r8,4.4198e-04_r8/) + kao(:, 1,10, 4) = (/ & + &3.3771e+01_r8,2.9548e+01_r8,2.5328e+01_r8,2.1105e+01_r8,1.6886e+01_r8,1.2665e+01_r8, & + &8.4427e+00_r8,4.2216e+00_r8,4.3200e-04_r8/) + kao(:, 2,10, 4) = (/ & + &3.3810e+01_r8,2.9587e+01_r8,2.5358e+01_r8,2.1131e+01_r8,1.6905e+01_r8,1.2680e+01_r8, & + &8.4534e+00_r8,4.2274e+00_r8,5.4393e-04_r8/) + kao(:, 3,10, 4) = (/ & + &3.4144e+01_r8,2.9876e+01_r8,2.5609e+01_r8,2.1340e+01_r8,1.7073e+01_r8,1.2805e+01_r8, & + &8.5375e+00_r8,4.2697e+00_r8,6.4726e-04_r8/) + kao(:, 4,10, 4) = (/ & + &3.4577e+01_r8,3.0255e+01_r8,2.5934e+01_r8,2.1613e+01_r8,1.7291e+01_r8,1.2969e+01_r8, & + &8.6471e+00_r8,4.3251e+00_r8,7.9967e-04_r8/) + kao(:, 5,10, 4) = (/ & + &3.5279e+01_r8,3.0869e+01_r8,2.6459e+01_r8,2.2050e+01_r8,1.7642e+01_r8,1.3232e+01_r8, & + &8.8233e+00_r8,4.4139e+00_r8,8.8613e-04_r8/) + kao(:, 1,11, 4) = (/ & + &4.9379e+01_r8,4.3210e+01_r8,3.7035e+01_r8,3.0865e+01_r8,2.4692e+01_r8,1.8519e+01_r8, & + &1.2346e+01_r8,6.1734e+00_r8,5.9531e-04_r8/) + kao(:, 2,11, 4) = (/ & + &4.9664e+01_r8,4.3455e+01_r8,3.7247e+01_r8,3.1040e+01_r8,2.4833e+01_r8,1.8625e+01_r8, & + &1.2417e+01_r8,6.2092e+00_r8,7.3911e-04_r8/) + kao(:, 3,11, 4) = (/ & + &5.0351e+01_r8,4.4056e+01_r8,3.7762e+01_r8,3.1470e+01_r8,2.5175e+01_r8,1.8882e+01_r8, & + &1.2589e+01_r8,6.2954e+00_r8,9.0535e-04_r8/) + kao(:, 4,11, 4) = (/ & + &5.1310e+01_r8,4.4899e+01_r8,3.8484e+01_r8,3.2071e+01_r8,2.5657e+01_r8,1.9244e+01_r8, & + &1.2831e+01_r8,6.4171e+00_r8,1.0300e-03_r8/) + kao(:, 5,11, 4) = (/ & + &5.2691e+01_r8,4.6105e+01_r8,3.9519e+01_r8,3.2933e+01_r8,2.6348e+01_r8,1.9763e+01_r8, & + &1.3176e+01_r8,6.5918e+00_r8,1.3056e-03_r8/) + kao(:, 1,12, 4) = (/ & + &5.3682e+01_r8,4.6971e+01_r8,4.0260e+01_r8,3.3552e+01_r8,2.6842e+01_r8,2.0131e+01_r8, & + &1.3420e+01_r8,6.7107e+00_r8,5.9618e-04_r8/) + kao(:, 2,12, 4) = (/ & + &5.4209e+01_r8,4.7433e+01_r8,4.0657e+01_r8,3.3879e+01_r8,2.7104e+01_r8,2.0329e+01_r8, & + &1.3553e+01_r8,6.7772e+00_r8,7.6649e-04_r8/) + kao(:, 3,12, 4) = (/ & + &5.5191e+01_r8,4.8293e+01_r8,4.1395e+01_r8,3.4495e+01_r8,2.7597e+01_r8,2.0697e+01_r8, & + &1.3799e+01_r8,6.9009e+00_r8,9.6570e-04_r8/) + kao(:, 4,12, 4) = (/ & + &5.6606e+01_r8,4.9530e+01_r8,4.2455e+01_r8,3.5382e+01_r8,2.8306e+01_r8,2.1230e+01_r8, & + &1.4154e+01_r8,7.0794e+00_r8,1.1503e-03_r8/) + kao(:, 5,12, 4) = (/ & + &5.8604e+01_r8,5.1279e+01_r8,4.3956e+01_r8,3.6631e+01_r8,2.9306e+01_r8,2.1982e+01_r8, & + &1.4657e+01_r8,7.3321e+00_r8,1.3037e-03_r8/) + kao(:, 1,13, 4) = (/ & + &4.6897e+01_r8,4.1036e+01_r8,3.5173e+01_r8,2.9311e+01_r8,2.3449e+01_r8,1.7586e+01_r8, & + &1.1724e+01_r8,5.8626e+00_r8,5.3404e-04_r8/) + kao(:, 2,13, 4) = (/ & + &4.7510e+01_r8,4.1569e+01_r8,3.5631e+01_r8,2.9695e+01_r8,2.3756e+01_r8,1.7817e+01_r8, & + &1.1878e+01_r8,5.9396e+00_r8,7.0585e-04_r8/) + kao(:, 3,13, 4) = (/ & + &4.8599e+01_r8,4.2525e+01_r8,3.6450e+01_r8,3.0375e+01_r8,2.4299e+01_r8,1.8226e+01_r8, & + &1.2152e+01_r8,6.0774e+00_r8,8.6599e-04_r8/) + kao(:, 4,13, 4) = (/ & + &5.0122e+01_r8,4.3856e+01_r8,3.7591e+01_r8,3.1328e+01_r8,2.5063e+01_r8,1.8798e+01_r8, & + &1.2534e+01_r8,6.2697e+00_r8,1.0053e-03_r8/) + kao(:, 5,13, 4) = (/ & + &5.2215e+01_r8,4.5689e+01_r8,3.9164e+01_r8,3.2638e+01_r8,2.6111e+01_r8,1.9586e+01_r8, & + &1.3060e+01_r8,6.5334e+00_r8,1.2313e-03_r8/) + kao(:, 1, 1, 5) = (/ & + &8.2901e-02_r8,7.3924e-02_r8,6.4657e-02_r8,5.5597e-02_r8,4.6472e-02_r8,3.6796e-02_r8, & + &2.6709e-02_r8,1.5948e-02_r8,1.7802e-03_r8/) + kao(:, 2, 1, 5) = (/ & + &8.3370e-02_r8,7.4618e-02_r8,6.5698e-02_r8,5.7019e-02_r8,4.7812e-02_r8,3.7978e-02_r8, & + &2.7855e-02_r8,1.7146e-02_r8,2.3935e-03_r8/) + kao(:, 3, 1, 5) = (/ & + &8.4235e-02_r8,7.5730e-02_r8,6.7257e-02_r8,5.8667e-02_r8,4.9229e-02_r8,3.9298e-02_r8, & + &2.8966e-02_r8,1.8334e-02_r8,3.0382e-03_r8/) + kao(:, 4, 1, 5) = (/ & + &8.5176e-02_r8,7.7019e-02_r8,6.8972e-02_r8,6.0287e-02_r8,5.0680e-02_r8,4.0612e-02_r8, & + &3.0271e-02_r8,1.9679e-02_r8,3.7478e-03_r8/) + kao(:, 5, 1, 5) = (/ & + &8.6230e-02_r8,7.8450e-02_r8,7.0705e-02_r8,6.1832e-02_r8,5.2066e-02_r8,4.2065e-02_r8, & + &3.1638e-02_r8,2.1127e-02_r8,4.5344e-03_r8/) + kao(:, 1, 2, 5) = (/ & + &1.1319e-01_r8,1.0032e-01_r8,8.7141e-02_r8,7.4086e-02_r8,6.1196e-02_r8,4.7903e-02_r8, & + &3.4053e-02_r8,1.9479e-02_r8,1.3324e-03_r8/) + kao(:, 2, 2, 5) = (/ & + &1.1444e-01_r8,1.0174e-01_r8,8.8783e-02_r8,7.6019e-02_r8,6.3135e-02_r8,4.9508e-02_r8, & + &3.5403e-02_r8,2.0488e-02_r8,1.7827e-03_r8/) + kao(:, 3, 2, 5) = (/ & + &1.1608e-01_r8,1.0349e-01_r8,9.0802e-02_r8,7.8322e-02_r8,6.5118e-02_r8,5.1198e-02_r8, & + &3.6801e-02_r8,2.1623e-02_r8,2.2789e-03_r8/) + kao(:, 4, 2, 5) = (/ & + &1.1786e-01_r8,1.0545e-01_r8,9.3147e-02_r8,8.0587e-02_r8,6.7042e-02_r8,5.2943e-02_r8, & + &3.8201e-02_r8,2.2798e-02_r8,2.8272e-03_r8/) + kao(:, 5, 2, 5) = (/ & + &1.1969e-01_r8,1.0757e-01_r8,9.5567e-02_r8,8.2763e-02_r8,6.8961e-02_r8,5.4626e-02_r8, & + &3.9785e-02_r8,2.4020e-02_r8,3.4454e-03_r8/) + kao(:, 1, 3, 5) = (/ & + &2.0690e-01_r8,1.8215e-01_r8,1.5725e-01_r8,1.3219e-01_r8,1.0725e-01_r8,8.2467e-02_r8, & + &5.7330e-02_r8,3.1338e-02_r8,9.1573e-04_r8/) + kao(:, 2, 3, 5) = (/ & + &2.1013e-01_r8,1.8537e-01_r8,1.6026e-01_r8,1.3517e-01_r8,1.1017e-01_r8,8.5255e-02_r8, & + &5.9448e-02_r8,3.2689e-02_r8,1.2507e-03_r8/) + kao(:, 3, 3, 5) = (/ & + &2.1385e-01_r8,1.8904e-01_r8,1.6379e-01_r8,1.3865e-01_r8,1.1374e-01_r8,8.8133e-02_r8, & + &6.1604e-02_r8,3.4070e-02_r8,1.6182e-03_r8/) + kao(:, 4, 3, 5) = (/ & + &2.1772e-01_r8,1.9276e-01_r8,1.6753e-01_r8,1.4253e-01_r8,1.1723e-01_r8,9.0813e-02_r8, & + &6.3766e-02_r8,3.5513e-02_r8,2.0311e-03_r8/) + kao(:, 5, 3, 5) = (/ & + &2.2143e-01_r8,1.9638e-01_r8,1.7123e-01_r8,1.4633e-01_r8,1.2052e-01_r8,9.3556e-02_r8, & + &6.5944e-02_r8,3.7115e-02_r8,2.5088e-03_r8/) + kao(:, 1, 4, 5) = (/ & + &3.8507e-01_r8,3.3780e-01_r8,2.9048e-01_r8,2.4314e-01_r8,1.9570e-01_r8,1.4827e-01_r8, & + &1.0100e-01_r8,5.3296e-02_r8,6.2147e-04_r8/) + kao(:, 2, 4, 5) = (/ & + &3.9146e-01_r8,3.4379e-01_r8,2.9605e-01_r8,2.4819e-01_r8,2.0018e-01_r8,1.5228e-01_r8, & + &1.0449e-01_r8,5.5540e-02_r8,8.6088e-04_r8/) + kao(:, 3, 4, 5) = (/ & + &3.9930e-01_r8,3.5111e-01_r8,3.0278e-01_r8,2.5411e-01_r8,2.0550e-01_r8,1.5718e-01_r8, & + &1.0825e-01_r8,5.7768e-02_r8,1.1308e-03_r8/) + kao(:, 4, 4, 5) = (/ & + &4.0750e-01_r8,3.5883e-01_r8,3.0957e-01_r8,2.6026e-01_r8,2.1112e-01_r8,1.6215e-01_r8, & + &1.1175e-01_r8,5.9905e-02_r8,1.4435e-03_r8/) + kao(:, 5, 4, 5) = (/ & + &4.1540e-01_r8,3.6624e-01_r8,3.1618e-01_r8,2.6641e-01_r8,2.1709e-01_r8,1.6699e-01_r8, & + &1.1521e-01_r8,6.2079e-02_r8,1.8081e-03_r8/) + kao(:, 1, 5, 5) = (/ & + &6.6039e-01_r8,5.7849e-01_r8,4.9659e-01_r8,4.1465e-01_r8,3.3268e-01_r8,2.5068e-01_r8, & + &1.6878e-01_r8,8.6906e-02_r8,4.1392e-04_r8/) + kao(:, 2, 5, 5) = (/ & + &6.7138e-01_r8,5.8843e-01_r8,5.0538e-01_r8,4.2238e-01_r8,3.3940e-01_r8,2.5633e-01_r8, & + &1.7334e-01_r8,9.0010e-02_r8,5.9039e-04_r8/) + kao(:, 3, 5, 5) = (/ & + &6.8434e-01_r8,6.0014e-01_r8,5.1596e-01_r8,4.3167e-01_r8,3.4721e-01_r8,2.6273e-01_r8, & + &1.7850e-01_r8,9.3277e-02_r8,7.8856e-04_r8/) + kao(:, 4, 5, 5) = (/ & + &6.9935e-01_r8,6.1381e-01_r8,5.2821e-01_r8,4.4224e-01_r8,3.5606e-01_r8,2.7005e-01_r8, & + &1.8435e-01_r8,9.6630e-02_r8,1.0256e-03_r8/) + kao(:, 5, 5, 5) = (/ & + &7.1524e-01_r8,6.2827e-01_r8,5.4104e-01_r8,4.5319e-01_r8,3.6550e-01_r8,2.7828e-01_r8, & + &1.9025e-01_r8,9.9988e-02_r8,1.3023e-03_r8/) + kao(:, 1, 6, 5) = (/ & + &1.0605e+00_r8,9.2835e-01_r8,7.9638e-01_r8,6.6416e-01_r8,5.3204e-01_r8,3.9988e-01_r8, & + &2.6772e-01_r8,1.3599e-01_r8,2.6665e-04_r8/) + kao(:, 2, 6, 5) = (/ & + &1.0793e+00_r8,9.4508e-01_r8,8.1097e-01_r8,6.7669e-01_r8,5.4239e-01_r8,4.0816e-01_r8, & + &2.7396e-01_r8,1.4011e-01_r8,3.9578e-04_r8/) + kao(:, 3, 6, 5) = (/ & + &1.0996e+00_r8,9.6312e-01_r8,8.2674e-01_r8,6.9026e-01_r8,5.5385e-01_r8,4.1734e-01_r8, & + &2.8093e-01_r8,1.4437e-01_r8,5.4281e-04_r8/) + kao(:, 4, 6, 5) = (/ & + &1.1270e+00_r8,9.8758e-01_r8,8.4814e-01_r8,7.0877e-01_r8,5.6910e-01_r8,4.2937e-01_r8, & + &2.8968e-01_r8,1.4948e-01_r8,7.1692e-04_r8/) + kao(:, 5, 6, 5) = (/ & + &1.1549e+00_r8,1.0125e+00_r8,8.7022e-01_r8,7.2764e-01_r8,5.8478e-01_r8,4.4170e-01_r8, & + &2.9907e-01_r8,1.5477e-01_r8,9.2735e-04_r8/) + kao(:, 1, 7, 5) = (/ & + &1.7902e+00_r8,1.5666e+00_r8,1.3432e+00_r8,1.1198e+00_r8,8.9630e-01_r8,6.7291e-01_r8, & + &4.4939e-01_r8,2.2594e-01_r8,1.7788e-04_r8/) + kao(:, 2, 7, 5) = (/ & + &1.8253e+00_r8,1.5977e+00_r8,1.3701e+00_r8,1.1424e+00_r8,9.1476e-01_r8,6.8709e-01_r8, & + &4.5936e-01_r8,2.3207e-01_r8,2.6007e-04_r8/) + kao(:, 3, 7, 5) = (/ & + &1.8661e+00_r8,1.6335e+00_r8,1.4010e+00_r8,1.1685e+00_r8,9.3601e-01_r8,7.0359e-01_r8, & + &4.7118e-01_r8,2.3911e-01_r8,3.6579e-04_r8/) + kao(:, 4, 7, 5) = (/ & + &1.9131e+00_r8,1.6751e+00_r8,1.4368e+00_r8,1.1989e+00_r8,9.6095e-01_r8,7.2299e-01_r8, & + &4.8503e-01_r8,2.4706e-01_r8,4.9009e-04_r8/) + kao(:, 5, 7, 5) = (/ & + &1.9618e+00_r8,1.7182e+00_r8,1.4745e+00_r8,1.2310e+00_r8,9.8739e-01_r8,7.4364e-01_r8, & + &4.9951e-01_r8,2.5543e-01_r8,6.4417e-04_r8/) + kao(:, 1, 8, 5) = (/ & + &3.6222e+00_r8,3.1697e+00_r8,2.7175e+00_r8,2.2647e+00_r8,1.8122e+00_r8,1.3595e+00_r8, & + &9.0703e-01_r8,4.5436e-01_r8,1.7700e-04_r8/) + kao(:, 2, 8, 5) = (/ & + &3.6989e+00_r8,3.2367e+00_r8,2.7747e+00_r8,2.3129e+00_r8,1.8509e+00_r8,1.3888e+00_r8, & + &9.2689e-01_r8,4.6487e-01_r8,2.2396e-04_r8/) + kao(:, 3, 8, 5) = (/ & + &3.7900e+00_r8,3.3168e+00_r8,2.8434e+00_r8,2.3702e+00_r8,1.8972e+00_r8,1.4240e+00_r8, & + &9.5085e-01_r8,4.7797e-01_r8,2.7417e-04_r8/) + kao(:, 4, 8, 5) = (/ & + &3.8908e+00_r8,3.4054e+00_r8,2.9198e+00_r8,2.4343e+00_r8,1.9488e+00_r8,1.4634e+00_r8, & + &9.7805e-01_r8,4.9296e-01_r8,3.4875e-04_r8/) + kao(:, 5, 8, 5) = (/ & + &3.9856e+00_r8,3.4886e+00_r8,2.9916e+00_r8,2.4947e+00_r8,1.9978e+00_r8,1.5012e+00_r8, & + &1.0044e+00_r8,5.0758e-01_r8,4.5934e-04_r8/) + kao(:, 1, 9, 5) = (/ & + &1.3794e+01_r8,1.2070e+01_r8,1.0346e+01_r8,8.6224e+00_r8,6.8983e+00_r8,5.1738e+00_r8, & + &3.4497e+00_r8,1.7256e+00_r8,2.3317e-04_r8/) + kao(:, 2, 9, 5) = (/ & + &1.4093e+01_r8,1.2332e+01_r8,1.0571e+01_r8,8.8090e+00_r8,7.0478e+00_r8,5.2864e+00_r8, & + &3.5250e+00_r8,1.7636e+00_r8,2.9550e-04_r8/) + kao(:, 3, 9, 5) = (/ & + &1.4464e+01_r8,1.2658e+01_r8,1.0848e+01_r8,9.0415e+00_r8,7.2337e+00_r8,5.4264e+00_r8, & + &3.6184e+00_r8,1.8107e+00_r8,3.8639e-04_r8/) + kao(:, 4, 9, 5) = (/ & + &1.4855e+01_r8,1.2999e+01_r8,1.1143e+01_r8,9.2862e+00_r8,7.4306e+00_r8,5.5737e+00_r8, & + &3.7173e+00_r8,1.8614e+00_r8,5.0786e-04_r8/) + kao(:, 5, 9, 5) = (/ & + &1.5210e+01_r8,1.3311e+01_r8,1.1410e+01_r8,9.5097e+00_r8,7.6091e+00_r8,5.7087e+00_r8, & + &3.8087e+00_r8,1.9087e+00_r8,5.8982e-04_r8/) + kao(:, 1,10, 5) = (/ & + &5.8496e+01_r8,5.1180e+01_r8,4.3867e+01_r8,3.6556e+01_r8,2.9247e+01_r8,2.1935e+01_r8, & + &1.4623e+01_r8,7.3123e+00_r8,5.6403e-04_r8/) + kao(:, 2,10, 5) = (/ & + &5.9786e+01_r8,5.2317e+01_r8,4.4840e+01_r8,3.7369e+01_r8,2.9895e+01_r8,2.2423e+01_r8, & + &1.4947e+01_r8,7.4749e+00_r8,6.9685e-04_r8/) + kao(:, 3,10, 5) = (/ & + &6.1366e+01_r8,5.3692e+01_r8,4.6022e+01_r8,3.8353e+01_r8,3.0682e+01_r8,2.3012e+01_r8, & + &1.5344e+01_r8,7.6729e+00_r8,8.6661e-04_r8/) + kao(:, 4,10, 5) = (/ & + &6.3002e+01_r8,5.5128e+01_r8,4.7254e+01_r8,3.9377e+01_r8,3.1505e+01_r8,2.3630e+01_r8, & + &1.5753e+01_r8,7.8780e+00_r8,1.0403e-03_r8/) + kao(:, 5,10, 5) = (/ & + &6.4493e+01_r8,5.6436e+01_r8,4.8374e+01_r8,4.0310e+01_r8,3.2253e+01_r8,2.4189e+01_r8, & + &1.6127e+01_r8,8.0668e+00_r8,1.2361e-03_r8/) + kao(:, 1,11, 5) = (/ & + &8.7182e+01_r8,7.6287e+01_r8,6.5394e+01_r8,5.4493e+01_r8,4.3594e+01_r8,3.2696e+01_r8, & + &2.1798e+01_r8,1.0900e+01_r8,7.4362e-04_r8/) + kao(:, 2,11, 5) = (/ & + &8.9336e+01_r8,7.8172e+01_r8,6.7002e+01_r8,5.5836e+01_r8,4.4668e+01_r8,3.3502e+01_r8, & + &2.2335e+01_r8,1.1168e+01_r8,9.0702e-04_r8/) + kao(:, 3,11, 5) = (/ & + &9.1581e+01_r8,8.0131e+01_r8,6.8688e+01_r8,5.7237e+01_r8,4.5792e+01_r8,3.4345e+01_r8, & + &2.2896e+01_r8,1.1449e+01_r8,1.0809e-03_r8/) + kao(:, 4,11, 5) = (/ & + &9.3839e+01_r8,8.2107e+01_r8,7.0383e+01_r8,5.8658e+01_r8,4.6921e+01_r8,3.5193e+01_r8, & + &2.3462e+01_r8,1.1732e+01_r8,1.3235e-03_r8/) + kao(:, 5,11, 5) = (/ & + &9.5958e+01_r8,8.3967e+01_r8,7.1970e+01_r8,5.9973e+01_r8,4.7982e+01_r8,3.5987e+01_r8, & + &2.3994e+01_r8,1.1998e+01_r8,1.5458e-03_r8/) + kao(:, 1,12, 5) = (/ & + &9.6680e+01_r8,8.4597e+01_r8,7.2516e+01_r8,6.0430e+01_r8,4.8347e+01_r8,3.6257e+01_r8, & + &2.4172e+01_r8,1.2087e+01_r8,8.8792e-04_r8/) + kao(:, 2,12, 5) = (/ & + &9.9039e+01_r8,8.6662e+01_r8,7.4284e+01_r8,6.1903e+01_r8,4.9522e+01_r8,3.7144e+01_r8, & + &2.4762e+01_r8,1.2382e+01_r8,1.0348e-03_r8/) + kao(:, 3,12, 5) = (/ & + &1.0152e+02_r8,8.8834e+01_r8,7.6150e+01_r8,6.3450e+01_r8,5.0765e+01_r8,3.8071e+01_r8, & + &2.5383e+01_r8,1.2692e+01_r8,1.2734e-03_r8/) + kao(:, 4,12, 5) = (/ & + &1.0389e+02_r8,9.0902e+01_r8,7.7912e+01_r8,6.4935e+01_r8,5.1946e+01_r8,3.8960e+01_r8, & + &2.5973e+01_r8,1.2989e+01_r8,1.5461e-03_r8/) + kao(:, 5,12, 5) = (/ & + &1.0614e+02_r8,9.2872e+01_r8,7.9616e+01_r8,6.6343e+01_r8,5.3076e+01_r8,3.9807e+01_r8, & + &2.6538e+01_r8,1.3271e+01_r8,1.7863e-03_r8/) + kao(:, 1,13, 5) = (/ & + &8.5924e+01_r8,7.5190e+01_r8,6.4446e+01_r8,5.3705e+01_r8,4.2964e+01_r8,3.2222e+01_r8, & + &2.1482e+01_r8,1.0742e+01_r8,9.3650e-04_r8/) + kao(:, 2,13, 5) = (/ & + &8.8011e+01_r8,7.7009e+01_r8,6.6010e+01_r8,5.5012e+01_r8,4.4009e+01_r8,3.3008e+01_r8, & + &2.2004e+01_r8,1.1003e+01_r8,1.0453e-03_r8/) + kao(:, 3,13, 5) = (/ & + &9.0165e+01_r8,7.8893e+01_r8,6.7623e+01_r8,5.6350e+01_r8,4.5080e+01_r8,3.3811e+01_r8, & + &2.2542e+01_r8,1.1273e+01_r8,1.2632e-03_r8/) + kao(:, 4,13, 5) = (/ & + &9.2294e+01_r8,8.0759e+01_r8,6.9218e+01_r8,5.7683e+01_r8,4.6146e+01_r8,3.4609e+01_r8, & + &2.3075e+01_r8,1.1539e+01_r8,1.5901e-03_r8/) + kao(:, 5,13, 5) = (/ & + &9.4515e+01_r8,8.2699e+01_r8,7.0891e+01_r8,5.9075e+01_r8,4.7260e+01_r8,3.5445e+01_r8, & + &2.3631e+01_r8,1.1818e+01_r8,1.9283e-03_r8/) + kao(:, 1, 1, 6) = (/ & + &1.3664e-01_r8,1.2142e-01_r8,1.0604e-01_r8,9.0673e-02_r8,7.5307e-02_r8,5.9951e-02_r8, & + &4.4049e-02_r8,2.7037e-02_r8,3.4200e-03_r8/) + kao(:, 2, 1, 6) = (/ & + &1.3479e-01_r8,1.2041e-01_r8,1.0581e-01_r8,9.1114e-02_r8,7.6669e-02_r8,6.1851e-02_r8, & + &4.6009e-02_r8,2.9151e-02_r8,4.4244e-03_r8/) + kao(:, 3, 1, 6) = (/ & + &1.3313e-01_r8,1.1956e-01_r8,1.0561e-01_r8,9.1887e-02_r8,7.8237e-02_r8,6.3771e-02_r8, & + &4.8109e-02_r8,3.1604e-02_r8,5.5644e-03_r8/) + kao(:, 4, 1, 6) = (/ & + &1.3195e-01_r8,1.1904e-01_r8,1.0583e-01_r8,9.3212e-02_r8,7.9889e-02_r8,6.5652e-02_r8, & + &5.0318e-02_r8,3.4334e-02_r8,6.8097e-03_r8/) + kao(:, 5, 1, 6) = (/ & + &1.3100e-01_r8,1.1871e-01_r8,1.0645e-01_r8,9.4491e-02_r8,8.1510e-02_r8,6.7455e-02_r8, & + &5.2648e-02_r8,3.7142e-02_r8,8.1798e-03_r8/) + kao(:, 1, 2, 6) = (/ & + &1.8948e-01_r8,1.6745e-01_r8,1.4512e-01_r8,1.2300e-01_r8,1.0098e-01_r8,7.9021e-02_r8, & + &5.6595e-02_r8,3.3068e-02_r8,2.5064e-03_r8/) + kao(:, 2, 2, 6) = (/ & + &1.8719e-01_r8,1.6582e-01_r8,1.4439e-01_r8,1.2310e-01_r8,1.0186e-01_r8,8.0667e-02_r8, & + &5.8428e-02_r8,3.4918e-02_r8,3.2805e-03_r8/) + kao(:, 3, 2, 6) = (/ & + &1.8550e-01_r8,1.6475e-01_r8,1.4416e-01_r8,1.2351e-01_r8,1.0330e-01_r8,8.2465e-02_r8, & + &6.0314e-02_r8,3.6962e-02_r8,4.1499e-03_r8/) + kao(:, 4, 2, 6) = (/ & + &1.8451e-01_r8,1.6460e-01_r8,1.4454e-01_r8,1.2487e-01_r8,1.0515e-01_r8,8.4419e-02_r8, & + &6.2353e-02_r8,3.9320e-02_r8,5.1265e-03_r8/) + kao(:, 5, 2, 6) = (/ & + &1.8423e-01_r8,1.6501e-01_r8,1.4553e-01_r8,1.2672e-01_r8,1.0715e-01_r8,8.6338e-02_r8, & + &6.4353e-02_r8,4.1893e-02_r8,6.2102e-03_r8/) + kao(:, 1, 3, 6) = (/ & + &3.5249e-01_r8,3.0976e-01_r8,2.6683e-01_r8,2.2378e-01_r8,1.8098e-01_r8,1.3846e-01_r8, & + &9.6219e-02_r8,5.2862e-02_r8,1.7476e-03_r8/) + kao(:, 2, 3, 6) = (/ & + &3.4945e-01_r8,3.0729e-01_r8,2.6503e-01_r8,2.2304e-01_r8,1.8135e-01_r8,1.3971e-01_r8, & + &9.8147e-02_r8,5.4704e-02_r8,2.3082e-03_r8/) + kao(:, 3, 3, 6) = (/ & + &3.4786e-01_r8,3.0616e-01_r8,2.6475e-01_r8,2.2367e-01_r8,1.8257e-01_r8,1.4178e-01_r8, & + &1.0043e-01_r8,5.6633e-02_r8,2.9556e-03_r8/) + kao(:, 4, 3, 6) = (/ & + &3.4805e-01_r8,3.0690e-01_r8,2.6623e-01_r8,2.2552e-01_r8,1.8508e-01_r8,1.4480e-01_r8, & + &1.0306e-01_r8,5.8846e-02_r8,3.6970e-03_r8/) + kao(:, 5, 3, 6) = (/ & + &3.5013e-01_r8,3.0948e-01_r8,2.6918e-01_r8,2.2850e-01_r8,1.8865e-01_r8,1.4799e-01_r8, & + &1.0568e-01_r8,6.1131e-02_r8,4.5281e-03_r8/) + kao(:, 1, 4, 6) = (/ & + &6.6623e-01_r8,5.8386e-01_r8,5.0153e-01_r8,4.1899e-01_r8,3.3640e-01_r8,2.5407e-01_r8, & + &1.7225e-01_r8,9.1058e-02_r8,1.1958e-03_r8/) + kao(:, 2, 4, 6) = (/ & + &6.6340e-01_r8,5.8167e-01_r8,4.9974e-01_r8,4.1776e-01_r8,3.3619e-01_r8,2.5503e-01_r8, & + &1.7423e-01_r8,9.3289e-02_r8,1.6080e-03_r8/) + kao(:, 3, 4, 6) = (/ & + &6.6480e-01_r8,5.8306e-01_r8,5.0121e-01_r8,4.1990e-01_r8,3.3893e-01_r8,2.5818e-01_r8, & + &1.7768e-01_r8,9.5987e-02_r8,2.0929e-03_r8/) + kao(:, 4, 4, 6) = (/ & + &6.7003e-01_r8,5.8789e-01_r8,5.0627e-01_r8,4.2518e-01_r8,3.4417e-01_r8,2.6306e-01_r8, & + &1.8230e-01_r8,9.9134e-02_r8,2.6527e-03_r8/) + kao(:, 5, 4, 6) = (/ & + &6.7815e-01_r8,5.9566e-01_r8,5.1416e-01_r8,4.3281e-01_r8,3.5098e-01_r8,2.6952e-01_r8, & + &1.8764e-01_r8,1.0249e-01_r8,3.2896e-03_r8/) + kao(:, 1, 5, 6) = (/ & + &1.1550e+00_r8,1.0112e+00_r8,8.6772e-01_r8,7.2399e-01_r8,5.8018e-01_r8,4.3620e-01_r8, & + &2.9244e-01_r8,1.4976e-01_r8,8.1069e-04_r8/) + kao(:, 2, 5, 6) = (/ & + &1.1564e+00_r8,1.0128e+00_r8,8.6891e-01_r8,7.2534e-01_r8,5.8147e-01_r8,4.3781e-01_r8, & + &2.9477e-01_r8,1.5282e-01_r8,1.1157e-03_r8/) + kao(:, 3, 5, 6) = (/ & + &1.1669e+00_r8,1.0223e+00_r8,8.7752e-01_r8,7.3265e-01_r8,5.8799e-01_r8,4.4399e-01_r8, & + &3.0054e-01_r8,1.5735e-01_r8,1.4779e-03_r8/) + kao(:, 4, 5, 6) = (/ & + &1.1830e+00_r8,1.0368e+00_r8,8.9030e-01_r8,7.4407e-01_r8,5.9861e-01_r8,4.5354e-01_r8, & + &3.0826e-01_r8,1.6275e-01_r8,1.9001e-03_r8/) + kao(:, 5, 5, 6) = (/ & + &1.2016e+00_r8,1.0534e+00_r8,9.0529e-01_r8,7.5813e-01_r8,6.1140e-01_r8,4.6432e-01_r8, & + &3.1746e-01_r8,1.6866e-01_r8,2.3885e-03_r8/) + kao(:, 1, 6, 6) = (/ & + &1.8728e+00_r8,1.6394e+00_r8,1.4057e+00_r8,1.1724e+00_r8,9.3873e-01_r8,7.0502e-01_r8, & + &4.7119e-01_r8,2.3746e-01_r8,5.3401e-04_r8/) + kao(:, 2, 6, 6) = (/ & + &1.8855e+00_r8,1.6506e+00_r8,1.4159e+00_r8,1.1808e+00_r8,9.4575e-01_r8,7.1049e-01_r8, & + &4.7534e-01_r8,2.4122e-01_r8,7.5510e-04_r8/) + kao(:, 3, 6, 6) = (/ & + &1.9127e+00_r8,1.6747e+00_r8,1.4367e+00_r8,1.1985e+00_r8,9.6017e-01_r8,7.2202e-01_r8, & + &4.8438e-01_r8,2.4807e-01_r8,1.0228e-03_r8/) + kao(:, 4, 6, 6) = (/ & + &1.9458e+00_r8,1.7041e+00_r8,1.4622e+00_r8,1.2202e+00_r8,9.7826e-01_r8,7.3694e-01_r8, & + &4.9644e-01_r8,2.5634e-01_r8,1.3413e-03_r8/) + kao(:, 5, 6, 6) = (/ & + &1.9819e+00_r8,1.7360e+00_r8,1.4899e+00_r8,1.2440e+00_r8,9.9883e-01_r8,7.5442e-01_r8, & + &5.0981e-01_r8,2.6524e-01_r8,1.7130e-03_r8/) + kao(:, 1, 7, 6) = (/ & + &3.1956e+00_r8,2.7964e+00_r8,2.3973e+00_r8,1.9983e+00_r8,1.5994e+00_r8,1.2005e+00_r8, & + &8.0140e-01_r8,4.0204e-01_r8,3.4739e-04_r8/) + kao(:, 2, 7, 6) = (/ & + &3.2319e+00_r8,2.8287e+00_r8,2.4254e+00_r8,2.0219e+00_r8,1.6186e+00_r8,1.2150e+00_r8, & + &8.1138e-01_r8,4.0767e-01_r8,4.9767e-04_r8/) + kao(:, 3, 7, 6) = (/ & + &3.2870e+00_r8,2.8773e+00_r8,2.4673e+00_r8,2.0573e+00_r8,1.6471e+00_r8,1.2367e+00_r8, & + &8.2648e-01_r8,4.1699e-01_r8,6.8883e-04_r8/) + kao(:, 4, 7, 6) = (/ & + &3.3536e+00_r8,2.9357e+00_r8,2.5178e+00_r8,2.0997e+00_r8,1.6816e+00_r8,1.2633e+00_r8, & + &8.4550e-01_r8,4.2915e-01_r8,9.2075e-04_r8/) + kao(:, 5, 7, 6) = (/ & + &3.4247e+00_r8,2.9983e+00_r8,2.5718e+00_r8,2.1451e+00_r8,1.7185e+00_r8,1.2924e+00_r8, & + &8.6745e-01_r8,4.4266e-01_r8,1.1994e-03_r8/) + kao(:, 1, 8, 6) = (/ & + &6.5522e+00_r8,5.7333e+00_r8,4.9154e+00_r8,4.0958e+00_r8,3.2773e+00_r8,2.4586e+00_r8, & + &1.6399e+00_r8,8.2128e-01_r8,2.5000e-04_r8/) + kao(:, 2, 8, 6) = (/ & + &6.6534e+00_r8,5.8224e+00_r8,4.9909e+00_r8,4.1598e+00_r8,3.3284e+00_r8,2.4975e+00_r8, & + &1.6667e+00_r8,8.3486e-01_r8,3.5933e-04_r8/) + kao(:, 3, 8, 6) = (/ & + &6.7871e+00_r8,5.9396e+00_r8,5.0919e+00_r8,4.2443e+00_r8,3.3968e+00_r8,2.5492e+00_r8, & + &1.7012e+00_r8,8.5283e-01_r8,4.9387e-04_r8/) + kao(:, 4, 8, 6) = (/ & + &6.9317e+00_r8,6.0662e+00_r8,5.2009e+00_r8,4.3357e+00_r8,3.4705e+00_r8,2.6048e+00_r8, & + &1.7389e+00_r8,8.7334e-01_r8,6.4756e-04_r8/) + kao(:, 5, 8, 6) = (/ & + &7.0935e+00_r8,6.2081e+00_r8,5.3230e+00_r8,4.4380e+00_r8,3.5524e+00_r8,2.6671e+00_r8, & + &1.7815e+00_r8,8.9762e-01_r8,8.2195e-04_r8/) + kao(:, 1, 9, 6) = (/ & + &2.5444e+01_r8,2.2265e+01_r8,1.9084e+01_r8,1.5904e+01_r8,1.2723e+01_r8,9.5428e+00_r8, & + &6.3622e+00_r8,3.1820e+00_r8,4.0178e-04_r8/) + kao(:, 2, 9, 6) = (/ & + &2.5907e+01_r8,2.2668e+01_r8,1.9432e+01_r8,1.6194e+01_r8,1.2956e+01_r8,9.7177e+00_r8, & + &6.4794e+00_r8,3.2416e+00_r8,4.9820e-04_r8/) + kao(:, 3, 9, 6) = (/ & + &2.6491e+01_r8,2.3181e+01_r8,1.9870e+01_r8,1.6559e+01_r8,1.3249e+01_r8,9.9392e+00_r8, & + &6.6274e+00_r8,3.3163e+00_r8,5.8675e-04_r8/) + kao(:, 4, 9, 6) = (/ & + &2.7100e+01_r8,2.3714e+01_r8,2.0326e+01_r8,1.6941e+01_r8,1.3555e+01_r8,1.0168e+01_r8, & + &6.7813e+00_r8,3.3943e+00_r8,7.0841e-04_r8/) + kao(:, 5, 9, 6) = (/ & + &2.7765e+01_r8,2.4297e+01_r8,2.0827e+01_r8,1.7358e+01_r8,1.3889e+01_r8,1.0420e+01_r8, & + &6.9499e+00_r8,3.4794e+00_r8,8.5424e-04_r8/) + kao(:, 1,10, 6) = (/ & + &1.1023e+02_r8,9.6432e+01_r8,8.2664e+01_r8,6.8898e+01_r8,5.5114e+01_r8,4.1339e+01_r8, & + &2.7555e+01_r8,1.3778e+01_r8,8.1537e-04_r8/) + kao(:, 2,10, 6) = (/ & + &1.1247e+02_r8,9.8427e+01_r8,8.4346e+01_r8,7.0300e+01_r8,5.6236e+01_r8,4.2180e+01_r8, & + &2.8118e+01_r8,1.4061e+01_r8,9.9310e-04_r8/) + kao(:, 3,10, 6) = (/ & + &1.1514e+02_r8,1.0076e+02_r8,8.6358e+01_r8,7.1971e+01_r8,5.7576e+01_r8,4.3183e+01_r8, & + &2.8789e+01_r8,1.4396e+01_r8,1.1831e-03_r8/) + kao(:, 4,10, 6) = (/ & + &1.1802e+02_r8,1.0327e+02_r8,8.8510e+01_r8,7.3765e+01_r8,5.9016e+01_r8,4.4263e+01_r8, & + &2.9511e+01_r8,1.4759e+01_r8,1.3868e-03_r8/) + kao(:, 5,10, 6) = (/ & + &1.2130e+02_r8,1.0614e+02_r8,9.0978e+01_r8,7.5815e+01_r8,6.0657e+01_r8,4.5493e+01_r8, & + &3.0333e+01_r8,1.5172e+01_r8,1.7070e-03_r8/) + kao(:, 1,11, 6) = (/ & + &1.6690e+02_r8,1.4603e+02_r8,1.2516e+02_r8,1.0431e+02_r8,8.3442e+01_r8,6.2583e+01_r8, & + &4.1722e+01_r8,2.0862e+01_r8,1.5727e-03_r8/) + kao(:, 2,11, 6) = (/ & + &1.7086e+02_r8,1.4949e+02_r8,1.2814e+02_r8,1.0678e+02_r8,8.5424e+01_r8,6.4067e+01_r8, & + &4.2718e+01_r8,2.1360e+01_r8,1.6234e-03_r8/) + kao(:, 3,11, 6) = (/ & + &1.7519e+02_r8,1.5329e+02_r8,1.3139e+02_r8,1.0949e+02_r8,8.7589e+01_r8,6.5698e+01_r8, & + &4.3799e+01_r8,2.1903e+01_r8,1.7884e-03_r8/) + kao(:, 4,11, 6) = (/ & + &1.8016e+02_r8,1.5762e+02_r8,1.3510e+02_r8,1.1259e+02_r8,9.0076e+01_r8,6.7557e+01_r8, & + &4.5039e+01_r8,2.2524e+01_r8,2.1215e-03_r8/) + kao(:, 5,11, 6) = (/ & + &1.8518e+02_r8,1.6203e+02_r8,1.3888e+02_r8,1.1573e+02_r8,9.2591e+01_r8,6.9449e+01_r8, & + &4.6302e+01_r8,2.3157e+01_r8,2.4813e-03_r8/) + kao(:, 1,12, 6) = (/ & + &1.8707e+02_r8,1.6368e+02_r8,1.4030e+02_r8,1.1692e+02_r8,9.3541e+01_r8,7.0153e+01_r8, & + &4.6766e+01_r8,2.3384e+01_r8,1.9770e-03_r8/) + kao(:, 2,12, 6) = (/ & + &1.9183e+02_r8,1.6788e+02_r8,1.4389e+02_r8,1.1990e+02_r8,9.5932e+01_r8,7.1949e+01_r8, & + &4.7966e+01_r8,2.3985e+01_r8,2.1043e-03_r8/) + kao(:, 3,12, 6) = (/ & + &1.9710e+02_r8,1.7246e+02_r8,1.4784e+02_r8,1.2320e+02_r8,9.8552e+01_r8,7.3917e+01_r8, & + &4.9278e+01_r8,2.4644e+01_r8,2.2289e-03_r8/) + kao(:, 4,12, 6) = (/ & + &2.0265e+02_r8,1.7731e+02_r8,1.5198e+02_r8,1.2666e+02_r8,1.0133e+02_r8,7.5997e+01_r8, & + &5.0665e+01_r8,2.5338e+01_r8,2.5070e-03_r8/) + kao(:, 5,12, 6) = (/ & + &2.0830e+02_r8,1.8227e+02_r8,1.5623e+02_r8,1.3019e+02_r8,1.0416e+02_r8,7.8120e+01_r8, & + &5.2086e+01_r8,2.6047e+01_r8,2.9426e-03_r8/) + kao(:, 1,13, 6) = (/ & + &1.6768e+02_r8,1.4672e+02_r8,1.2576e+02_r8,1.0480e+02_r8,8.3836e+01_r8,6.2874e+01_r8, & + &4.1918e+01_r8,2.0960e+01_r8,1.9900e-03_r8/) + kao(:, 2,13, 6) = (/ & + &1.7225e+02_r8,1.5072e+02_r8,1.2919e+02_r8,1.0767e+02_r8,8.6132e+01_r8,6.4601e+01_r8, & + &4.3064e+01_r8,2.1534e+01_r8,2.2115e-03_r8/) + kao(:, 3,13, 6) = (/ & + &1.7710e+02_r8,1.5497e+02_r8,1.3283e+02_r8,1.1069e+02_r8,8.8549e+01_r8,6.6413e+01_r8, & + &4.4281e+01_r8,2.2144e+01_r8,2.4087e-03_r8/) + kao(:, 4,13, 6) = (/ & + &1.8201e+02_r8,1.5926e+02_r8,1.3651e+02_r8,1.1376e+02_r8,9.1007e+01_r8,6.8257e+01_r8, & + &4.5512e+01_r8,2.2758e+01_r8,2.6872e-03_r8/) + kao(:, 5,13, 6) = (/ & + &1.8703e+02_r8,1.6366e+02_r8,1.4029e+02_r8,1.1690e+02_r8,9.3529e+01_r8,7.0144e+01_r8, & + &4.6769e+01_r8,2.3390e+01_r8,2.9430e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &2.6412e-01_r8,2.3209e-01_r8,2.0136e-01_r8,1.7041e-01_r8,1.3987e-01_r8,1.0997e-01_r8, & + &7.9977e-02_r8,4.8294e-02_r8,7.1406e-03_r8/) + kao(:, 2, 1, 7) = (/ & + &2.6114e-01_r8,2.3041e-01_r8,2.0084e-01_r8,1.7141e-01_r8,1.4253e-01_r8,1.1370e-01_r8, & + &8.4426e-02_r8,5.2292e-02_r8,9.2339e-03_r8/) + kao(:, 3, 1, 7) = (/ & + &2.5746e-01_r8,2.2846e-01_r8,2.0043e-01_r8,1.7294e-01_r8,1.4558e-01_r8,1.1774e-01_r8, & + &8.8686e-02_r8,5.6161e-02_r8,1.1607e-02_r8/) + kao(:, 4, 1, 7) = (/ & + &2.5329e-01_r8,2.2641e-01_r8,2.0046e-01_r8,1.7465e-01_r8,1.4868e-01_r8,1.2202e-01_r8, & + &9.2933e-02_r8,6.0129e-02_r8,1.4258e-02_r8/) + kao(:, 5, 1, 7) = (/ & + &2.4914e-01_r8,2.2449e-01_r8,2.0080e-01_r8,1.7670e-01_r8,1.5234e-01_r8,1.2632e-01_r8, & + &9.7469e-02_r8,6.4803e-02_r8,1.7193e-02_r8/) + kao(:, 1, 2, 7) = (/ & + &3.8226e-01_r8,3.3530e-01_r8,2.8943e-01_r8,2.4384e-01_r8,1.9786e-01_r8,1.5259e-01_r8, & + &1.0817e-01_r8,6.3161e-02_r8,5.4372e-03_r8/) + kao(:, 2, 2, 7) = (/ & + &3.7769e-01_r8,3.3226e-01_r8,2.8798e-01_r8,2.4326e-01_r8,1.9923e-01_r8,1.5589e-01_r8, & + &1.1262e-01_r8,6.7329e-02_r8,7.0870e-03_r8/) + kao(:, 3, 2, 7) = (/ & + &3.7182e-01_r8,3.2842e-01_r8,2.8559e-01_r8,2.4304e-01_r8,2.0123e-01_r8,1.5952e-01_r8, & + &1.1734e-01_r8,7.1516e-02_r8,8.9693e-03_r8/) + kao(:, 4, 2, 7) = (/ & + &3.6545e-01_r8,3.2421e-01_r8,2.8324e-01_r8,2.4318e-01_r8,2.0343e-01_r8,1.6337e-01_r8, & + &1.2179e-01_r8,7.5704e-02_r8,1.1062e-02_r8/) + kao(:, 5, 2, 7) = (/ & + &3.5934e-01_r8,3.2018e-01_r8,2.8184e-01_r8,2.4404e-01_r8,2.0628e-01_r8,1.6781e-01_r8, & + &1.2654e-01_r8,8.0391e-02_r8,1.3382e-02_r8/) + kao(:, 1, 3, 7) = (/ & + &7.3419e-01_r8,6.4302e-01_r8,5.5249e-01_r8,4.6249e-01_r8,3.7279e-01_r8,2.8244e-01_r8, & + &1.9254e-01_r8,1.0461e-01_r8,3.8320e-03_r8/) + kao(:, 2, 3, 7) = (/ & + &7.2438e-01_r8,6.3531e-01_r8,5.4697e-01_r8,4.5910e-01_r8,3.7055e-01_r8,2.8234e-01_r8, & + &1.9553e-01_r8,1.0953e-01_r8,5.0607e-03_r8/) + kao(:, 3, 3, 7) = (/ & + &7.1308e-01_r8,6.2644e-01_r8,5.4060e-01_r8,4.5437e-01_r8,3.6826e-01_r8,2.8333e-01_r8, & + &1.9916e-01_r8,1.1441e-01_r8,6.4784e-03_r8/) + kao(:, 4, 3, 7) = (/ & + &7.0097e-01_r8,6.1696e-01_r8,5.3353e-01_r8,4.4963e-01_r8,3.6700e-01_r8,2.8530e-01_r8, & + &2.0351e-01_r8,1.1914e-01_r8,8.0908e-03_r8/) + kao(:, 5, 3, 7) = (/ & + &6.8962e-01_r8,6.0838e-01_r8,5.2688e-01_r8,4.4648e-01_r8,3.6708e-01_r8,2.8814e-01_r8, & + &2.0859e-01_r8,1.2387e-01_r8,9.8988e-03_r8/) + kao(:, 1, 4, 7) = (/ & + &1.4238e+00_r8,1.2465e+00_r8,1.0693e+00_r8,8.9242e-01_r8,7.1591e-01_r8,5.3976e-01_r8, & + &3.6322e-01_r8,1.8668e-01_r8,2.6351e-03_r8/) + kao(:, 2, 4, 7) = (/ & + &1.4051e+00_r8,1.2306e+00_r8,1.0566e+00_r8,8.8285e-01_r8,7.0951e-01_r8,5.3582e-01_r8, & + &3.6165e-01_r8,1.8980e-01_r8,3.5337e-03_r8/) + kao(:, 3, 4, 7) = (/ & + &1.3826e+00_r8,1.2117e+00_r8,1.0413e+00_r8,8.7137e-01_r8,7.0120e-01_r8,5.3024e-01_r8, & + &3.6085e-01_r8,1.9367e-01_r8,4.5912e-03_r8/) + kao(:, 4, 4, 7) = (/ & + &1.3609e+00_r8,1.1937e+00_r8,1.0271e+00_r8,8.6049e-01_r8,6.9280e-01_r8,5.2650e-01_r8, & + &3.6231e-01_r8,1.9848e-01_r8,5.8142e-03_r8/) + kao(:, 5, 4, 7) = (/ & + &1.3409e+00_r8,1.1773e+00_r8,1.0140e+00_r8,8.4932e-01_r8,6.8606e-01_r8,5.2486e-01_r8, & + &3.6482e-01_r8,2.0369e-01_r8,7.2048e-03_r8/) + kao(:, 1, 5, 7) = (/ & + &2.5206e+00_r8,2.2062e+00_r8,1.8917e+00_r8,1.5773e+00_r8,1.2631e+00_r8,9.4923e-01_r8, & + &6.3588e-01_r8,3.2194e-01_r8,1.8039e-03_r8/) + kao(:, 2, 5, 7) = (/ & + &2.4864e+00_r8,2.1765e+00_r8,1.8669e+00_r8,1.5575e+00_r8,1.2483e+00_r8,9.3953e-01_r8, & + &6.3051e-01_r8,3.2080e-01_r8,2.4598e-03_r8/) + kao(:, 3, 5, 7) = (/ & + &2.4502e+00_r8,2.1455e+00_r8,1.8410e+00_r8,1.5370e+00_r8,1.2333e+00_r8,9.2942e-01_r8, & + &6.2403e-01_r8,3.2160e-01_r8,3.2471e-03_r8/) + kao(:, 4, 5, 7) = (/ & + &2.4176e+00_r8,2.1177e+00_r8,1.8181e+00_r8,1.5189e+00_r8,1.2193e+00_r8,9.1845e-01_r8, & + &6.1937e-01_r8,3.2415e-01_r8,4.1727e-03_r8/) + kao(:, 5, 5, 7) = (/ & + &2.3943e+00_r8,2.0977e+00_r8,1.8015e+00_r8,1.5055e+00_r8,1.2082e+00_r8,9.1210e-01_r8, & + &6.1892e-01_r8,3.2856e-01_r8,5.2383e-03_r8/) + kao(:, 1, 6, 7) = (/ & + &4.1535e+00_r8,3.6349e+00_r8,3.1163e+00_r8,2.5976e+00_r8,2.0789e+00_r8,1.5604e+00_r8, & + &1.0424e+00_r8,5.2499e-01_r8,1.2119e-03_r8/) + kao(:, 2, 6, 7) = (/ & + &4.0999e+00_r8,3.5882e+00_r8,3.0765e+00_r8,2.5650e+00_r8,2.0536e+00_r8,1.5426e+00_r8, & + &1.0319e+00_r8,5.2076e-01_r8,1.6878e-03_r8/) + kao(:, 3, 6, 7) = (/ & + &4.0501e+00_r8,3.5452e+00_r8,3.0400e+00_r8,2.5354e+00_r8,2.0310e+00_r8,1.5269e+00_r8, & + &1.0226e+00_r8,5.1681e-01_r8,2.2703e-03_r8/) + kao(:, 4, 6, 7) = (/ & + &4.0172e+00_r8,3.5170e+00_r8,3.0163e+00_r8,2.5163e+00_r8,2.0166e+00_r8,1.5168e+00_r8, & + &1.0153e+00_r8,5.1695e-01_r8,2.9634e-03_r8/) + kao(:, 5, 6, 7) = (/ & + &4.0047e+00_r8,3.5059e+00_r8,3.0081e+00_r8,2.5099e+00_r8,2.0120e+00_r8,1.5128e+00_r8, & + &1.0149e+00_r8,5.2194e-01_r8,3.7748e-03_r8/) + kao(:, 1, 7, 7) = (/ & + &7.1454e+00_r8,6.2526e+00_r8,5.3597e+00_r8,4.4669e+00_r8,3.5744e+00_r8,2.6816e+00_r8, & + &1.7891e+00_r8,8.9724e-01_r8,7.5005e-04_r8/) + kao(:, 2, 7, 7) = (/ & + &7.0662e+00_r8,6.1833e+00_r8,5.3006e+00_r8,4.4177e+00_r8,3.5356e+00_r8,2.6534e+00_r8, & + &1.7715e+00_r8,8.9007e-01_r8,1.0984e-03_r8/) + kao(:, 3, 7, 7) = (/ & + &7.0091e+00_r8,6.1337e+00_r8,5.2586e+00_r8,4.3836e+00_r8,3.5085e+00_r8,2.6339e+00_r8, & + &1.7596e+00_r8,8.8470e-01_r8,1.5427e-03_r8/) + kao(:, 4, 7, 7) = (/ & + &6.9967e+00_r8,6.1229e+00_r8,5.2499e+00_r8,4.3767e+00_r8,3.5037e+00_r8,2.6314e+00_r8, & + &1.7589e+00_r8,8.8464e-01_r8,2.0814e-03_r8/) + kao(:, 5, 7, 7) = (/ & + &7.0262e+00_r8,6.1495e+00_r8,5.2733e+00_r8,4.3969e+00_r8,3.5208e+00_r8,2.6451e+00_r8, & + &1.7672e+00_r8,8.9234e-01_r8,2.7067e-03_r8/) + kao(:, 1, 8, 7) = (/ & + &1.4691e+01_r8,1.2856e+01_r8,1.1019e+01_r8,9.1832e+00_r8,7.3472e+00_r8,5.5112e+00_r8, & + &3.6752e+00_r8,1.8392e+00_r8,5.0466e-04_r8/) + kao(:, 2, 8, 7) = (/ & + &1.4561e+01_r8,1.2741e+01_r8,1.0922e+01_r8,9.1018e+00_r8,7.2824e+00_r8,5.4631e+00_r8, & + &3.6434e+00_r8,1.8247e+00_r8,7.0108e-04_r8/) + kao(:, 3, 8, 7) = (/ & + &1.4517e+01_r8,1.2702e+01_r8,1.0889e+01_r8,9.0751e+00_r8,7.2609e+00_r8,5.4474e+00_r8, & + &3.6338e+00_r8,1.8215e+00_r8,9.5134e-04_r8/) + kao(:, 4, 8, 7) = (/ & + &1.4592e+01_r8,1.2768e+01_r8,1.0945e+01_r8,9.1223e+00_r8,7.2994e+00_r8,5.4774e+00_r8, & + &3.6552e+00_r8,1.8334e+00_r8,1.2923e-03_r8/) + kao(:, 5, 8, 7) = (/ & + &1.4780e+01_r8,1.2933e+01_r8,1.1086e+01_r8,9.2409e+00_r8,7.3952e+00_r8,5.5498e+00_r8, & + &3.7048e+00_r8,1.8578e+00_r8,1.7359e-03_r8/) + kao(:, 1, 9, 7) = (/ & + &5.6885e+01_r8,4.9776e+01_r8,4.2665e+01_r8,3.5554e+01_r8,2.8444e+01_r8,2.1332e+01_r8, & + &1.4224e+01_r8,7.1126e+00_r8,6.2609e-04_r8/) + kao(:, 2, 9, 7) = (/ & + &5.6580e+01_r8,4.9509e+01_r8,4.2436e+01_r8,3.5363e+01_r8,2.8291e+01_r8,2.1219e+01_r8, & + &1.4147e+01_r8,7.0751e+00_r8,8.0177e-04_r8/) + kao(:, 3, 9, 7) = (/ & + &5.6732e+01_r8,4.9637e+01_r8,4.2548e+01_r8,3.5458e+01_r8,2.8366e+01_r8,2.1276e+01_r8, & + &1.4184e+01_r8,7.0949e+00_r8,1.0220e-03_r8/) + kao(:, 4, 9, 7) = (/ & + &5.7468e+01_r8,5.0286e+01_r8,4.3101e+01_r8,3.5920e+01_r8,2.8736e+01_r8,2.1553e+01_r8, & + &1.4371e+01_r8,7.1892e+00_r8,1.2387e-03_r8/) + kao(:, 5, 9, 7) = (/ & + &5.8635e+01_r8,5.1306e+01_r8,4.3977e+01_r8,3.6648e+01_r8,2.9321e+01_r8,2.1992e+01_r8, & + &1.4665e+01_r8,7.3378e+00_r8,1.5501e-03_r8/) + kao(:, 1,10, 7) = (/ & + &2.4487e+02_r8,2.1424e+02_r8,1.8364e+02_r8,1.5304e+02_r8,1.2243e+02_r8,9.1825e+01_r8, & + &6.1214e+01_r8,3.0606e+01_r8,1.7354e-03_r8/) + kao(:, 2,10, 7) = (/ & + &2.4490e+02_r8,2.1431e+02_r8,1.8369e+02_r8,1.5309e+02_r8,1.2247e+02_r8,9.1851e+01_r8, & + &6.1230e+01_r8,3.0619e+01_r8,1.7748e-03_r8/) + kao(:, 3,10, 7) = (/ & + &2.4755e+02_r8,2.1661e+02_r8,1.8568e+02_r8,1.5472e+02_r8,1.2378e+02_r8,9.2834e+01_r8, & + &6.1889e+01_r8,3.0945e+01_r8,1.9607e-03_r8/) + kao(:, 4,10, 7) = (/ & + &2.5293e+02_r8,2.2132e+02_r8,1.8970e+02_r8,1.5807e+02_r8,1.2647e+02_r8,9.4852e+01_r8, & + &6.3238e+01_r8,3.1620e+01_r8,2.3523e-03_r8/) + kao(:, 5,10, 7) = (/ & + &2.5940e+02_r8,2.2699e+02_r8,1.9456e+02_r8,1.6213e+02_r8,1.2971e+02_r8,9.7282e+01_r8, & + &6.4856e+01_r8,3.2431e+01_r8,2.7354e-03_r8/) + kao(:, 1,11, 7) = (/ & + &3.6899e+02_r8,3.2288e+02_r8,2.7677e+02_r8,2.3063e+02_r8,1.8452e+02_r8,1.3837e+02_r8, & + &9.2255e+01_r8,4.6125e+01_r8,2.1265e-03_r8/) + kao(:, 2,11, 7) = (/ & + &3.7335e+02_r8,3.2670e+02_r8,2.8002e+02_r8,2.3334e+02_r8,1.8669e+02_r8,1.4002e+02_r8, & + &9.3341e+01_r8,4.6674e+01_r8,3.2080e-03_r8/) + kao(:, 3,11, 7) = (/ & + &3.8233e+02_r8,3.3453e+02_r8,2.8674e+02_r8,2.3896e+02_r8,1.9116e+02_r8,1.4337e+02_r8, & + &9.5577e+01_r8,4.7794e+01_r8,3.4910e-03_r8/) + kao(:, 4,11, 7) = (/ & + &3.9299e+02_r8,3.4383e+02_r8,2.9472e+02_r8,2.4561e+02_r8,1.9648e+02_r8,1.4736e+02_r8, & + &9.8242e+01_r8,4.9120e+01_r8,3.8208e-03_r8/) + kao(:, 5,11, 7) = (/ & + &4.0483e+02_r8,3.5423e+02_r8,3.0363e+02_r8,2.5301e+02_r8,2.0242e+02_r8,1.5182e+02_r8, & + &1.0121e+02_r8,5.0609e+01_r8,4.2123e-03_r8/) + kao(:, 1,12, 7) = (/ & + &4.1937e+02_r8,3.6695e+02_r8,3.1452e+02_r8,2.6211e+02_r8,2.0969e+02_r8,1.5726e+02_r8, & + &1.0485e+02_r8,5.2423e+01_r8,2.2784e-03_r8/) + kao(:, 2,12, 7) = (/ & + &4.2956e+02_r8,3.7586e+02_r8,3.2216e+02_r8,2.6848e+02_r8,2.1478e+02_r8,1.6108e+02_r8, & + &1.0739e+02_r8,5.3697e+01_r8,3.5938e-03_r8/) + kao(:, 3,12, 7) = (/ & + &4.4222e+02_r8,3.8693e+02_r8,3.3164e+02_r8,2.7638e+02_r8,2.2109e+02_r8,1.6582e+02_r8, & + &1.1055e+02_r8,5.5277e+01_r8,4.4037e-03_r8/) + kao(:, 4,12, 7) = (/ & + &4.5624e+02_r8,3.9921e+02_r8,3.4220e+02_r8,2.8517e+02_r8,2.2812e+02_r8,1.7109e+02_r8, & + &1.1406e+02_r8,5.7035e+01_r8,4.5266e-03_r8/) + kao(:, 5,12, 7) = (/ & + &4.7013e+02_r8,4.1136e+02_r8,3.5259e+02_r8,2.9384e+02_r8,2.3506e+02_r8,1.7630e+02_r8, & + &1.1754e+02_r8,5.8765e+01_r8,5.1545e-03_r8/) + kao(:, 1,13, 7) = (/ & + &3.8573e+02_r8,3.3753e+02_r8,2.8932e+02_r8,2.4110e+02_r8,1.9287e+02_r8,1.4465e+02_r8, & + &9.6435e+01_r8,4.8220e+01_r8,2.4127e-03_r8/) + kao(:, 2,13, 7) = (/ & + &3.9713e+02_r8,3.4748e+02_r8,2.9784e+02_r8,2.4821e+02_r8,1.9856e+02_r8,1.4893e+02_r8, & + &9.9282e+01_r8,4.9641e+01_r8,3.8706e-03_r8/) + kao(:, 3,13, 7) = (/ & + &4.1029e+02_r8,3.5900e+02_r8,3.0771e+02_r8,2.5644e+02_r8,2.0514e+02_r8,1.5386e+02_r8, & + &1.0257e+02_r8,5.1288e+01_r8,4.7695e-03_r8/) + kao(:, 4,13, 7) = (/ & + &4.2344e+02_r8,3.7050e+02_r8,3.1756e+02_r8,2.6463e+02_r8,2.1170e+02_r8,1.5878e+02_r8, & + &1.0586e+02_r8,5.2932e+01_r8,4.9706e-03_r8/) + kao(:, 5,13, 7) = (/ & + &4.3615e+02_r8,3.8165e+02_r8,3.2713e+02_r8,2.7260e+02_r8,2.1808e+02_r8,1.6356e+02_r8, & + &1.0904e+02_r8,5.4523e+01_r8,5.6617e-03_r8/) + kao(:, 1, 1, 8) = (/ & + &5.2022e-01_r8,4.5635e-01_r8,3.9252e-01_r8,3.3010e-01_r8,2.6823e-01_r8,2.0567e-01_r8, & + &1.4452e-01_r8,8.4865e-02_r8,1.8396e-02_r8/) + kao(:, 2, 1, 8) = (/ & + &5.2177e-01_r8,4.5789e-01_r8,3.9474e-01_r8,3.3342e-01_r8,2.7114e-01_r8,2.1031e-01_r8, & + &1.5104e-01_r8,9.2174e-02_r8,2.3774e-02_r8/) + kao(:, 3, 1, 8) = (/ & + &5.2246e-01_r8,4.5863e-01_r8,3.9708e-01_r8,3.3604e-01_r8,2.7541e-01_r8,2.1692e-01_r8, & + &1.5876e-01_r8,9.9961e-02_r8,3.0156e-02_r8/) + kao(:, 4, 1, 8) = (/ & + &5.2222e-01_r8,4.5904e-01_r8,3.9936e-01_r8,3.3918e-01_r8,2.8145e-01_r8,2.2396e-01_r8, & + &1.6789e-01_r8,1.0815e-01_r8,3.7634e-02_r8/) + kao(:, 5, 1, 8) = (/ & + &5.2130e-01_r8,4.5967e-01_r8,4.0135e-01_r8,3.4393e-01_r8,2.8807e-01_r8,2.3225e-01_r8, & + &1.7760e-01_r8,1.1669e-01_r8,4.6345e-02_r8/) + kao(:, 1, 2, 8) = (/ & + &8.1852e-01_r8,7.1745e-01_r8,6.1633e-01_r8,5.1564e-01_r8,4.1643e-01_r8,3.1732e-01_r8, & + &2.1786e-01_r8,1.2067e-01_r8,1.4675e-02_r8/) + kao(:, 2, 2, 8) = (/ & + &8.1998e-01_r8,7.1886e-01_r8,6.1787e-01_r8,5.1883e-01_r8,4.2047e-01_r8,3.2108e-01_r8, & + &2.2369e-01_r8,1.2867e-01_r8,1.9122e-02_r8/) + kao(:, 3, 2, 8) = (/ & + &8.2161e-01_r8,7.2051e-01_r8,6.2063e-01_r8,5.2305e-01_r8,4.2413e-01_r8,3.2660e-01_r8, & + &2.3145e-01_r8,1.3782e-01_r8,2.4473e-02_r8/) + kao(:, 4, 2, 8) = (/ & + &8.2149e-01_r8,7.2071e-01_r8,6.2301e-01_r8,5.2587e-01_r8,4.2865e-01_r8,3.3407e-01_r8, & + &2.4032e-01_r8,1.4761e-01_r8,3.0869e-02_r8/) + kao(:, 5, 2, 8) = (/ & + &8.1957e-01_r8,7.1986e-01_r8,6.2436e-01_r8,5.2838e-01_r8,4.3462e-01_r8,3.4210e-01_r8, & + &2.5070e-01_r8,1.5726e-01_r8,3.8311e-02_r8/) + kao(:, 1, 3, 8) = (/ & + &1.7050e+00_r8,1.4932e+00_r8,1.2814e+00_r8,1.0695e+00_r8,8.5775e-01_r8,6.4751e-01_r8, & + &4.3833e-01_r8,2.2806e-01_r8,1.0910e-02_r8/) + kao(:, 2, 3, 8) = (/ & + &1.7093e+00_r8,1.4971e+00_r8,1.2848e+00_r8,1.0726e+00_r8,8.6216e-01_r8,6.5288e-01_r8, & + &4.4261e-01_r8,2.3435e-01_r8,1.4370e-02_r8/) + kao(:, 3, 3, 8) = (/ & + &1.7123e+00_r8,1.5000e+00_r8,1.2874e+00_r8,1.0764e+00_r8,8.6711e-01_r8,6.5794e-01_r8, & + &4.4842e-01_r8,2.4360e-01_r8,1.8590e-02_r8/) + kao(:, 4, 3, 8) = (/ & + &1.7121e+00_r8,1.4998e+00_r8,1.2880e+00_r8,1.0792e+00_r8,8.7145e-01_r8,6.6223e-01_r8, & + &4.5614e-01_r8,2.5394e-01_r8,2.3699e-02_r8/) + kao(:, 5, 3, 8) = (/ & + &1.7072e+00_r8,1.4957e+00_r8,1.2869e+00_r8,1.0807e+00_r8,8.7401e-01_r8,6.6818e-01_r8, & + &4.6582e-01_r8,2.6619e-01_r8,2.9551e-02_r8/) + kao(:, 1, 4, 8) = (/ & + &3.5671e+00_r8,3.1226e+00_r8,2.6780e+00_r8,2.2334e+00_r8,1.7887e+00_r8,1.3439e+00_r8, & + &9.0030e-01_r8,4.5879e-01_r8,7.8646e-03_r8/) + kao(:, 2, 4, 8) = (/ & + &3.5784e+00_r8,3.1324e+00_r8,2.6867e+00_r8,2.2405e+00_r8,1.7945e+00_r8,1.3495e+00_r8, & + &9.0658e-01_r8,4.6395e-01_r8,1.0548e-02_r8/) + kao(:, 3, 4, 8) = (/ & + &3.5832e+00_r8,3.1369e+00_r8,2.6902e+00_r8,2.2437e+00_r8,1.7981e+00_r8,1.3549e+00_r8, & + &9.1305e-01_r8,4.7036e-01_r8,1.3834e-02_r8/) + kao(:, 4, 4, 8) = (/ & + &3.5802e+00_r8,3.1343e+00_r8,2.6882e+00_r8,2.2430e+00_r8,1.8006e+00_r8,1.3596e+00_r8, & + &9.1785e-01_r8,4.7927e-01_r8,1.7787e-02_r8/) + kao(:, 5, 4, 8) = (/ & + &3.5714e+00_r8,3.1267e+00_r8,2.6827e+00_r8,2.2417e+00_r8,1.8022e+00_r8,1.3635e+00_r8, & + &9.2392e-01_r8,4.9076e-01_r8,2.2306e-02_r8/) + kao(:, 1, 5, 8) = (/ & + &6.7418e+00_r8,5.9003e+00_r8,5.0587e+00_r8,4.2171e+00_r8,3.3754e+00_r8,2.5338e+00_r8, & + &1.6921e+00_r8,8.5173e-01_r8,5.5269e-03_r8/) + kao(:, 2, 5, 8) = (/ & + &6.7656e+00_r8,5.9212e+00_r8,5.0765e+00_r8,4.2319e+00_r8,3.3873e+00_r8,2.5428e+00_r8, & + &1.6990e+00_r8,8.5857e-01_r8,7.5732e-03_r8/) + kao(:, 3, 5, 8) = (/ & + &6.7746e+00_r8,5.9289e+00_r8,5.0835e+00_r8,4.2380e+00_r8,3.3924e+00_r8,2.5474e+00_r8, & + &1.7057e+00_r8,8.6548e-01_r8,1.0137e-02_r8/) + kao(:, 4, 5, 8) = (/ & + &6.7641e+00_r8,5.9200e+00_r8,5.0759e+00_r8,4.2320e+00_r8,3.3891e+00_r8,2.5487e+00_r8, & + &1.7099e+00_r8,8.7100e-01_r8,1.3219e-02_r8/) + kao(:, 5, 5, 8) = (/ & + &6.7413e+00_r8,5.9008e+00_r8,5.0606e+00_r8,4.2207e+00_r8,3.3833e+00_r8,2.5475e+00_r8, & + &1.7128e+00_r8,8.7813e-01_r8,1.6736e-02_r8/) + kao(:, 1, 6, 8) = (/ & + &1.1755e+01_r8,1.0287e+01_r8,8.8182e+00_r8,7.3494e+00_r8,5.8812e+00_r8,4.4127e+00_r8, & + &2.9442e+00_r8,1.4757e+00_r8,3.7670e-03_r8/) + kao(:, 2, 6, 8) = (/ & + &1.1790e+01_r8,1.0318e+01_r8,8.8444e+00_r8,7.3718e+00_r8,5.8990e+00_r8,4.4261e+00_r8, & + &2.9535e+00_r8,1.4824e+00_r8,5.2756e-03_r8/) + kao(:, 3, 6, 8) = (/ & + &1.1802e+01_r8,1.0328e+01_r8,8.8538e+00_r8,7.3796e+00_r8,5.9055e+00_r8,4.4312e+00_r8, & + &2.9580e+00_r8,1.4892e+00_r8,7.2031e-03_r8/) + kao(:, 4, 6, 8) = (/ & + &1.1771e+01_r8,1.0301e+01_r8,8.8310e+00_r8,7.3612e+00_r8,5.8917e+00_r8,4.4224e+00_r8, & + &2.9568e+00_r8,1.4927e+00_r8,9.5398e-03_r8/) + kao(:, 5, 6, 8) = (/ & + &1.1717e+01_r8,1.0254e+01_r8,8.7912e+00_r8,7.3292e+00_r8,5.8672e+00_r8,4.4080e+00_r8, & + &2.9504e+00_r8,1.4942e+00_r8,1.2264e-02_r8/) + kao(:, 1, 7, 8) = (/ & + &2.1201e+01_r8,1.8552e+01_r8,1.5902e+01_r8,1.3253e+01_r8,1.0604e+01_r8,7.9546e+00_r8, & + &5.3049e+00_r8,2.6554e+00_r8,2.5163e-03_r8/) + kao(:, 2, 7, 8) = (/ & + &2.1258e+01_r8,1.8602e+01_r8,1.5945e+01_r8,1.3288e+01_r8,1.0632e+01_r8,7.9754e+00_r8, & + &5.3196e+00_r8,2.6631e+00_r8,3.6166e-03_r8/) + kao(:, 3, 7, 8) = (/ & + &2.1271e+01_r8,1.8614e+01_r8,1.5957e+01_r8,1.3298e+01_r8,1.0640e+01_r8,7.9825e+00_r8, & + &5.3244e+00_r8,2.6683e+00_r8,5.0339e-03_r8/) + kao(:, 4, 7, 8) = (/ & + &2.1213e+01_r8,1.8564e+01_r8,1.5913e+01_r8,1.3262e+01_r8,1.0612e+01_r8,7.9619e+00_r8, & + &5.3122e+00_r8,2.6672e+00_r8,6.7768e-03_r8/) + kao(:, 5, 7, 8) = (/ & + &2.1089e+01_r8,1.8455e+01_r8,1.5820e+01_r8,1.3186e+01_r8,1.0552e+01_r8,7.9178e+00_r8, & + &5.2873e+00_r8,2.6593e+00_r8,8.8413e-03_r8/) + kao(:, 1, 8, 8) = (/ & + &4.5180e+01_r8,3.9535e+01_r8,3.3887e+01_r8,2.8239e+01_r8,2.2591e+01_r8,1.6944e+01_r8, & + &1.1298e+01_r8,5.6517e+00_r8,1.3715e-03_r8/) + kao(:, 2, 8, 8) = (/ & + &4.5290e+01_r8,3.9627e+01_r8,3.3969e+01_r8,2.8308e+01_r8,2.2647e+01_r8,1.6987e+01_r8, & + &1.1327e+01_r8,5.6660e+00_r8,2.0845e-03_r8/) + kao(:, 3, 8, 8) = (/ & + &4.5261e+01_r8,3.9605e+01_r8,3.3948e+01_r8,2.8290e+01_r8,2.2633e+01_r8,1.6977e+01_r8, & + &1.1320e+01_r8,5.6637e+00_r8,3.2057e-03_r8/) + kao(:, 4, 8, 8) = (/ & + &4.5126e+01_r8,3.9486e+01_r8,3.3848e+01_r8,2.8205e+01_r8,2.2567e+01_r8,1.6928e+01_r8, & + &1.1288e+01_r8,5.6493e+00_r8,4.5853e-03_r8/) + kao(:, 5, 8, 8) = (/ & + &4.4865e+01_r8,3.9259e+01_r8,3.3651e+01_r8,2.8046e+01_r8,2.2438e+01_r8,1.6832e+01_r8, & + &1.1226e+01_r8,5.6233e+00_r8,6.2243e-03_r8/) + kao(:, 1, 9, 8) = (/ & + &1.7982e+02_r8,1.5734e+02_r8,1.3487e+02_r8,1.1239e+02_r8,8.9912e+01_r8,6.7434e+01_r8, & + &4.4957e+01_r8,2.2481e+01_r8,1.3106e-03_r8/) + kao(:, 2, 9, 8) = (/ & + &1.7996e+02_r8,1.5746e+02_r8,1.3497e+02_r8,1.1247e+02_r8,8.9976e+01_r8,6.7488e+01_r8, & + &4.4992e+01_r8,2.2498e+01_r8,1.6404e-03_r8/) + kao(:, 3, 9, 8) = (/ & + &1.7965e+02_r8,1.5719e+02_r8,1.3473e+02_r8,1.1228e+02_r8,8.9821e+01_r8,6.7370e+01_r8, & + &4.4914e+01_r8,2.2461e+01_r8,2.0268e-03_r8/) + kao(:, 4, 9, 8) = (/ & + &1.7888e+02_r8,1.5653e+02_r8,1.3416e+02_r8,1.1181e+02_r8,8.9443e+01_r8,6.7088e+01_r8, & + &4.4727e+01_r8,2.2367e+01_r8,2.6824e-03_r8/) + kao(:, 5, 9, 8) = (/ & + &1.7801e+02_r8,1.5576e+02_r8,1.3351e+02_r8,1.1126e+02_r8,8.9014e+01_r8,6.6762e+01_r8, & + &4.4512e+01_r8,2.2261e+01_r8,3.2961e-03_r8/) + kao(:, 1,10, 8) = (/ & + &7.9186e+02_r8,6.9285e+02_r8,5.9387e+02_r8,4.9485e+02_r8,3.9587e+02_r8,2.9692e+02_r8, & + &1.9795e+02_r8,9.8980e+01_r8,2.6434e-03_r8/) + kao(:, 2,10, 8) = (/ & + &7.9156e+02_r8,6.9260e+02_r8,5.9370e+02_r8,4.9476e+02_r8,3.9580e+02_r8,2.9685e+02_r8, & + &1.9789e+02_r8,9.8956e+01_r8,3.6689e-03_r8/) + kao(:, 3,10, 8) = (/ & + &7.8897e+02_r8,6.9037e+02_r8,5.9173e+02_r8,4.9309e+02_r8,3.9450e+02_r8,2.9589e+02_r8, & + &1.9725e+02_r8,9.8635e+01_r8,4.1214e-03_r8/) + kao(:, 4,10, 8) = (/ & + &7.8518e+02_r8,6.8703e+02_r8,5.8889e+02_r8,4.9073e+02_r8,3.9258e+02_r8,2.9444e+02_r8, & + &1.9631e+02_r8,9.8149e+01_r8,4.6533e-03_r8/) + kao(:, 5,10, 8) = (/ & + &7.8271e+02_r8,6.8490e+02_r8,5.8707e+02_r8,4.8922e+02_r8,3.9137e+02_r8,2.9354e+02_r8, & + &1.9568e+02_r8,9.7851e+01_r8,5.3114e-03_r8/) + kao(:, 1,11, 8) = (/ & + &1.2023e+03_r8,1.0521e+03_r8,9.0173e+02_r8,7.5144e+02_r8,6.0116e+02_r8,4.5091e+02_r8, & + &3.0058e+02_r8,1.5029e+02_r8,2.8585e-03_r8/) + kao(:, 2,11, 8) = (/ & + &1.1987e+03_r8,1.0489e+03_r8,8.9906e+02_r8,7.4919e+02_r8,5.9938e+02_r8,4.4951e+02_r8, & + &2.9969e+02_r8,1.4984e+02_r8,4.2381e-03_r8/) + kao(:, 3,11, 8) = (/ & + &1.1938e+03_r8,1.0446e+03_r8,8.9539e+02_r8,7.4611e+02_r8,5.9694e+02_r8,4.4768e+02_r8, & + &2.9847e+02_r8,1.4923e+02_r8,6.1776e-03_r8/) + kao(:, 4,11, 8) = (/ & + &1.1919e+03_r8,1.0429e+03_r8,8.9396e+02_r8,7.4498e+02_r8,5.9597e+02_r8,4.4698e+02_r8, & + &2.9797e+02_r8,1.4900e+02_r8,6.8124e-03_r8/) + kao(:, 5,11, 8) = (/ & + &1.1943e+03_r8,1.0450e+03_r8,8.9567e+02_r8,7.4646e+02_r8,5.9716e+02_r8,4.4786e+02_r8, & + &2.9857e+02_r8,1.4929e+02_r8,7.2330e-03_r8/) + kao(:, 1,12, 8) = (/ & + &1.3468e+03_r8,1.1784e+03_r8,1.0101e+03_r8,8.4170e+02_r8,6.7334e+02_r8,5.0503e+02_r8, & + &3.3668e+02_r8,1.6834e+02_r8,3.2180e-03_r8/) + kao(:, 2,12, 8) = (/ & + &1.3417e+03_r8,1.1740e+03_r8,1.0062e+03_r8,8.3855e+02_r8,6.7082e+02_r8,5.0314e+02_r8, & + &3.3541e+02_r8,1.6772e+02_r8,4.6846e-03_r8/) + kao(:, 3,12, 8) = (/ & + &1.3409e+03_r8,1.1734e+03_r8,1.0058e+03_r8,8.3814e+02_r8,6.7048e+02_r8,5.0287e+02_r8, & + &3.3524e+02_r8,1.6763e+02_r8,6.5606e-03_r8/) + kao(:, 4,12, 8) = (/ & + &1.3471e+03_r8,1.1787e+03_r8,1.0103e+03_r8,8.4192e+02_r8,6.7354e+02_r8,5.0515e+02_r8, & + &3.3677e+02_r8,1.6839e+02_r8,8.6936e-03_r8/) + kao(:, 5,12, 8) = (/ & + &1.3615e+03_r8,1.1913e+03_r8,1.0211e+03_r8,8.5093e+02_r8,6.8072e+02_r8,5.1056e+02_r8, & + &3.4035e+02_r8,1.7018e+02_r8,9.2918e-03_r8/) + kao(:, 1,13, 8) = (/ & + &1.2096e+03_r8,1.0584e+03_r8,9.0717e+02_r8,7.5599e+02_r8,6.0478e+02_r8,4.5359e+02_r8, & + &3.0240e+02_r8,1.5119e+02_r8,3.1447e-03_r8/) + kao(:, 2,13, 8) = (/ & + &1.2095e+03_r8,1.0583e+03_r8,9.0711e+02_r8,7.5597e+02_r8,6.0474e+02_r8,4.5355e+02_r8, & + &3.0238e+02_r8,1.5119e+02_r8,4.9163e-03_r8/) + kao(:, 3,13, 8) = (/ & + &1.2161e+03_r8,1.0641e+03_r8,9.1208e+02_r8,7.6006e+02_r8,6.0804e+02_r8,4.5603e+02_r8, & + &3.0401e+02_r8,1.5201e+02_r8,6.8865e-03_r8/) + kao(:, 4,13, 8) = (/ & + &1.2328e+03_r8,1.0787e+03_r8,9.2458e+02_r8,7.7050e+02_r8,6.1637e+02_r8,4.6230e+02_r8, & + &3.0819e+02_r8,1.5410e+02_r8,9.4613e-03_r8/) + kao(:, 5,13, 8) = (/ & + &1.2601e+03_r8,1.1026e+03_r8,9.4505e+02_r8,7.8755e+02_r8,6.3004e+02_r8,4.7254e+02_r8, & + &3.1501e+02_r8,1.5751e+02_r8,1.0283e-02_r8/) + kao(:, 1, 1, 9) = (/ & + &1.0370e+00_r8,9.0857e-01_r8,7.8023e-01_r8,6.5192e-01_r8,5.2457e-01_r8,4.0025e-01_r8, & + &2.7828e-01_r8,1.5804e-01_r8,5.8897e-02_r8/) + kao(:, 2, 1, 9) = (/ & + &1.0492e+00_r8,9.1962e-01_r8,7.9014e-01_r8,6.6101e-01_r8,5.3535e-01_r8,4.1219e-01_r8, & + &2.9064e-01_r8,1.7381e-01_r8,7.6414e-02_r8/) + kao(:, 3, 1, 9) = (/ & + &1.0617e+00_r8,9.3102e-01_r8,8.0032e-01_r8,6.7200e-01_r8,5.4761e-01_r8,4.2620e-01_r8, & + &3.0674e-01_r8,1.9538e-01_r8,9.6701e-02_r8/) + kao(:, 4, 1, 9) = (/ & + &1.0715e+00_r8,9.3980e-01_r8,8.0850e-01_r8,6.8264e-01_r8,5.6043e-01_r8,4.4205e-01_r8, & + &3.2592e-01_r8,2.2229e-01_r8,1.1943e-01_r8/) + kao(:, 5, 1, 9) = (/ & + &1.0801e+00_r8,9.4751e-01_r8,8.1733e-01_r8,6.9368e-01_r8,5.7613e-01_r8,4.6079e-01_r8, & + &3.5014e-01_r8,2.5319e-01_r8,1.4487e-01_r8/) + kao(:, 1, 2, 9) = (/ & + &1.7442e+00_r8,1.5272e+00_r8,1.3102e+00_r8,1.0933e+00_r8,8.7649e-01_r8,6.6091e-01_r8, & + &4.4902e-01_r8,2.3891e-01_r8,5.2362e-02_r8/) + kao(:, 2, 2, 9) = (/ & + &1.7617e+00_r8,1.5427e+00_r8,1.3238e+00_r8,1.1049e+00_r8,8.8687e-01_r8,6.7276e-01_r8, & + &4.6180e-01_r8,2.5188e-01_r8,6.8691e-02_r8/) + kao(:, 3, 2, 9) = (/ & + &1.7768e+00_r8,1.5563e+00_r8,1.3359e+00_r8,1.1155e+00_r8,8.9933e-01_r8,6.8666e-01_r8, & + &4.7568e-01_r8,2.6925e-01_r8,8.7599e-02_r8/) + kao(:, 4, 2, 9) = (/ & + &1.7902e+00_r8,1.5683e+00_r8,1.3467e+00_r8,1.1272e+00_r8,9.1292e-01_r8,7.0212e-01_r8, & + &4.9313e-01_r8,2.9218e-01_r8,1.0892e-01_r8/) + kao(:, 5, 2, 9) = (/ & + &1.8007e+00_r8,1.5781e+00_r8,1.3558e+00_r8,1.1390e+00_r8,9.2668e-01_r8,7.1895e-01_r8, & + &5.1345e-01_r8,3.2009e-01_r8,1.3290e-01_r8/) + kao(:, 1, 3, 9) = (/ & + &3.9769e+00_r8,3.4805e+00_r8,2.9839e+00_r8,2.4875e+00_r8,1.9912e+00_r8,1.4948e+00_r8, & + &9.9892e-01_r8,5.0928e-01_r8,4.2777e-02_r8/) + kao(:, 2, 3, 9) = (/ & + &4.0084e+00_r8,3.5082e+00_r8,3.0084e+00_r8,2.5082e+00_r8,2.0082e+00_r8,1.5084e+00_r8, & + &1.0123e+00_r8,5.2189e-01_r8,5.7041e-02_r8/) + kao(:, 3, 3, 9) = (/ & + &4.0345e+00_r8,3.5316e+00_r8,3.0286e+00_r8,2.5259e+00_r8,2.0232e+00_r8,1.5223e+00_r8, & + &1.0275e+00_r8,5.3508e-01_r8,7.3780e-02_r8/) + kao(:, 4, 3, 9) = (/ & + &4.0588e+00_r8,3.5535e+00_r8,3.0482e+00_r8,2.5430e+00_r8,2.0380e+00_r8,1.5389e+00_r8, & + &1.0447e+00_r8,5.5284e-01_r8,9.2939e-02_r8/) + kao(:, 5, 3, 9) = (/ & + &4.0766e+00_r8,3.5694e+00_r8,3.0624e+00_r8,2.5553e+00_r8,2.0517e+00_r8,1.5545e+00_r8, & + &1.0614e+00_r8,5.7409e-01_r8,1.1487e-01_r8/) + kao(:, 1, 4, 9) = (/ & + &9.2347e+00_r8,8.0808e+00_r8,6.9267e+00_r8,5.7730e+00_r8,4.6191e+00_r8,3.4653e+00_r8, & + &2.3115e+00_r8,1.1586e+00_r8,3.3639e-02_r8/) + kao(:, 2, 4, 9) = (/ & + &9.3231e+00_r8,8.1587e+00_r8,6.9942e+00_r8,5.8295e+00_r8,4.6650e+00_r8,3.5006e+00_r8, & + &2.3364e+00_r8,1.1757e+00_r8,4.5584e-02_r8/) + kao(:, 3, 4, 9) = (/ & + &9.3883e+00_r8,8.2160e+00_r8,7.0435e+00_r8,5.8714e+00_r8,4.6992e+00_r8,3.5271e+00_r8, & + &2.3555e+00_r8,1.1930e+00_r8,5.9759e-02_r8/) + kao(:, 4, 4, 9) = (/ & + &9.4383e+00_r8,8.2599e+00_r8,7.0821e+00_r8,5.9042e+00_r8,4.7261e+00_r8,3.5482e+00_r8, & + &2.3742e+00_r8,1.2110e+00_r8,7.6294e-02_r8/) + kao(:, 5, 4, 9) = (/ & + &9.4750e+00_r8,8.2926e+00_r8,7.1106e+00_r8,5.9283e+00_r8,4.7463e+00_r8,3.5648e+00_r8, & + &2.3926e+00_r8,1.2283e+00_r8,9.5542e-02_r8/) + kao(:, 1, 5, 9) = (/ & + &1.9585e+01_r8,1.7137e+01_r8,1.4689e+01_r8,1.2242e+01_r8,9.7941e+00_r8,7.3465e+00_r8, & + &4.8988e+00_r8,2.4515e+00_r8,2.6102e-02_r8/) + kao(:, 2, 5, 9) = (/ & + &1.9780e+01_r8,1.7309e+01_r8,1.4837e+01_r8,1.2365e+01_r8,9.8932e+00_r8,7.4216e+00_r8, & + &4.9500e+00_r8,2.4789e+00_r8,3.5859e-02_r8/) + kao(:, 3, 5, 9) = (/ & + &1.9935e+01_r8,1.7444e+01_r8,1.4954e+01_r8,1.2463e+01_r8,9.9721e+00_r8,7.4814e+00_r8, & + &4.9911e+00_r8,2.5017e+00_r8,4.7575e-02_r8/) + kao(:, 4, 5, 9) = (/ & + &2.0051e+01_r8,1.7546e+01_r8,1.5041e+01_r8,1.2537e+01_r8,1.0032e+01_r8,7.5273e+00_r8, & + &5.0227e+00_r8,2.5239e+00_r8,6.1484e-02_r8/) + kao(:, 5, 5, 9) = (/ & + &2.0135e+01_r8,1.7620e+01_r8,1.5106e+01_r8,1.2591e+01_r8,1.0076e+01_r8,7.5609e+00_r8, & + &5.0463e+00_r8,2.5450e+00_r8,7.7952e-02_r8/) + kao(:, 1, 6, 9) = (/ & + &3.8631e+01_r8,3.3801e+01_r8,2.8974e+01_r8,2.4144e+01_r8,1.9316e+01_r8,1.4488e+01_r8, & + &9.6597e+00_r8,4.8315e+00_r8,1.9604e-02_r8/) + kao(:, 2, 6, 9) = (/ & + &3.9022e+01_r8,3.4145e+01_r8,2.9268e+01_r8,2.4390e+01_r8,1.9513e+01_r8,1.4636e+01_r8, & + &9.7595e+00_r8,4.8831e+00_r8,2.7435e-02_r8/) + kao(:, 3, 6, 9) = (/ & + &3.9348e+01_r8,3.4431e+01_r8,2.9514e+01_r8,2.4596e+01_r8,1.9679e+01_r8,1.4761e+01_r8, & + &9.8442e+00_r8,4.9267e+00_r8,3.6949e-02_r8/) + kao(:, 4, 6, 9) = (/ & + &3.9594e+01_r8,3.4646e+01_r8,2.9698e+01_r8,2.4751e+01_r8,1.9803e+01_r8,1.4855e+01_r8, & + &9.9079e+00_r8,4.9603e+00_r8,4.8442e-02_r8/) + kao(:, 5, 6, 9) = (/ & + &3.9770e+01_r8,3.4801e+01_r8,2.9832e+01_r8,2.4862e+01_r8,1.9893e+01_r8,1.4924e+01_r8, & + &9.9544e+00_r8,4.9871e+00_r8,6.2169e-02_r8/) + kao(:, 1, 7, 9) = (/ & + &7.9230e+01_r8,6.9326e+01_r8,5.9424e+01_r8,4.9520e+01_r8,3.9617e+01_r8,2.9713e+01_r8, & + &1.9810e+01_r8,9.9063e+00_r8,1.4333e-02_r8/) + kao(:, 2, 7, 9) = (/ & + &8.0053e+01_r8,7.0047e+01_r8,6.0041e+01_r8,5.0034e+01_r8,4.0029e+01_r8,3.0023e+01_r8, & + &2.0018e+01_r8,1.0011e+01_r8,2.0474e-02_r8/) + kao(:, 3, 7, 9) = (/ & + &8.0747e+01_r8,7.0654e+01_r8,6.0562e+01_r8,5.0470e+01_r8,4.0378e+01_r8,3.0286e+01_r8, & + &2.0193e+01_r8,1.0101e+01_r8,2.8098e-02_r8/) + kao(:, 4, 7, 9) = (/ & + &8.1303e+01_r8,7.1142e+01_r8,6.0980e+01_r8,5.0819e+01_r8,4.0658e+01_r8,3.0496e+01_r8, & + &2.0334e+01_r8,1.0173e+01_r8,3.7439e-02_r8/) + kao(:, 5, 7, 9) = (/ & + &8.1680e+01_r8,7.1472e+01_r8,6.1265e+01_r8,5.1057e+01_r8,4.0847e+01_r8,3.0638e+01_r8, & + &2.0431e+01_r8,1.0223e+01_r8,4.8718e-02_r8/) + kao(:, 1, 8, 9) = (/ & + &1.9140e+02_r8,1.6747e+02_r8,1.4355e+02_r8,1.1962e+02_r8,9.5701e+01_r8,7.1775e+01_r8, & + &4.7850e+01_r8,2.3927e+01_r8,1.0137e-02_r8/) + kao(:, 2, 8, 9) = (/ & + &1.9353e+02_r8,1.6934e+02_r8,1.4515e+02_r8,1.2096e+02_r8,9.6769e+01_r8,7.2577e+01_r8, & + &4.8385e+01_r8,2.4195e+01_r8,1.4960e-02_r8/) + kao(:, 3, 8, 9) = (/ & + &1.9528e+02_r8,1.7086e+02_r8,1.4646e+02_r8,1.2205e+02_r8,9.7642e+01_r8,7.3231e+01_r8, & + &4.8824e+01_r8,2.4416e+01_r8,2.0883e-02_r8/) + kao(:, 4, 8, 9) = (/ & + &1.9672e+02_r8,1.7213e+02_r8,1.4754e+02_r8,1.2295e+02_r8,9.8361e+01_r8,7.3773e+01_r8, & + &4.9186e+01_r8,2.4598e+01_r8,2.8267e-02_r8/) + kao(:, 5, 8, 9) = (/ & + &1.9763e+02_r8,1.7293e+02_r8,1.4824e+02_r8,1.2352e+02_r8,9.8820e+01_r8,7.4120e+01_r8, & + &4.9417e+01_r8,2.4716e+01_r8,3.7324e-02_r8/) + kao(:, 1, 9, 9) = (/ & + &8.5696e+02_r8,7.4986e+02_r8,6.4272e+02_r8,5.3561e+02_r8,4.2849e+02_r8,3.2137e+02_r8, & + &2.1425e+02_r8,1.0712e+02_r8,4.9710e-03_r8/) + kao(:, 2, 9, 9) = (/ & + &8.6661e+02_r8,7.5827e+02_r8,6.4996e+02_r8,5.4164e+02_r8,4.3331e+02_r8,3.2498e+02_r8, & + &2.1666e+02_r8,1.0833e+02_r8,7.7324e-03_r8/) + kao(:, 3, 9, 9) = (/ & + &8.7472e+02_r8,7.6537e+02_r8,6.5602e+02_r8,5.4669e+02_r8,4.3735e+02_r8,3.2801e+02_r8, & + &2.1868e+02_r8,1.0935e+02_r8,1.2302e-02_r8/) + kao(:, 4, 9, 9) = (/ & + &8.8128e+02_r8,7.7113e+02_r8,6.6095e+02_r8,5.5081e+02_r8,4.4064e+02_r8,3.3048e+02_r8, & + &2.2033e+02_r8,1.1017e+02_r8,1.8205e-02_r8/) + kao(:, 5, 9, 9) = (/ & + &8.8594e+02_r8,7.7518e+02_r8,6.6448e+02_r8,5.5372e+02_r8,4.4298e+02_r8,3.3223e+02_r8, & + &2.2150e+02_r8,1.1076e+02_r8,2.5853e-02_r8/) + kao(:, 1,10, 9) = (/ & + &4.2110e+03_r8,3.6847e+03_r8,3.1582e+03_r8,2.6319e+03_r8,2.1055e+03_r8,1.5792e+03_r8, & + &1.0527e+03_r8,5.2637e+02_r8,5.0235e-03_r8/) + kao(:, 2,10, 9) = (/ & + &4.2578e+03_r8,3.7256e+03_r8,3.1934e+03_r8,2.6613e+03_r8,2.1289e+03_r8,1.5967e+03_r8, & + &1.0645e+03_r8,5.3224e+02_r8,7.3952e-03_r8/) + kao(:, 3,10, 9) = (/ & + &4.2976e+03_r8,3.7604e+03_r8,3.2232e+03_r8,2.6860e+03_r8,2.1488e+03_r8,1.6116e+03_r8, & + &1.0744e+03_r8,5.3720e+02_r8,1.0255e-02_r8/) + kao(:, 4,10, 9) = (/ & + &4.3279e+03_r8,3.7869e+03_r8,3.2460e+03_r8,2.7049e+03_r8,2.1640e+03_r8,1.6230e+03_r8, & + &1.0820e+03_r8,5.4099e+02_r8,1.2154e-02_r8/) + kao(:, 5,10, 9) = (/ & + &4.3496e+03_r8,3.8060e+03_r8,3.2622e+03_r8,2.7186e+03_r8,2.1748e+03_r8,1.6311e+03_r8, & + &1.0874e+03_r8,5.4372e+02_r8,1.4719e-02_r8/) + kao(:, 1,11, 9) = (/ & + &7.1173e+03_r8,6.2277e+03_r8,5.3380e+03_r8,4.4482e+03_r8,3.5586e+03_r8,2.6690e+03_r8, & + &1.7793e+03_r8,8.8967e+02_r8,4.7950e-03_r8/) + kao(:, 2,11, 9) = (/ & + &7.1866e+03_r8,6.2881e+03_r8,5.3900e+03_r8,4.4917e+03_r8,3.5933e+03_r8,2.6950e+03_r8, & + &1.7967e+03_r8,8.9836e+02_r8,1.0381e-02_r8/) + kao(:, 3,11, 9) = (/ & + &7.2420e+03_r8,6.3363e+03_r8,5.4313e+03_r8,4.5262e+03_r8,3.6209e+03_r8,2.7156e+03_r8, & + &1.8104e+03_r8,9.0520e+02_r8,1.1192e-02_r8/) + kao(:, 4,11, 9) = (/ & + &7.2818e+03_r8,6.3715e+03_r8,5.4613e+03_r8,4.5511e+03_r8,3.6409e+03_r8,2.7307e+03_r8, & + &1.8205e+03_r8,9.1025e+02_r8,1.5145e-02_r8/) + kao(:, 5,11, 9) = (/ & + &7.3078e+03_r8,6.3944e+03_r8,5.4808e+03_r8,4.5675e+03_r8,3.6540e+03_r8,2.7404e+03_r8, & + &1.8270e+03_r8,9.1351e+02_r8,1.9391e-02_r8/) + kao(:, 1,12, 9) = (/ & + &8.7768e+03_r8,7.6797e+03_r8,6.5826e+03_r8,5.4853e+03_r8,4.3884e+03_r8,3.2912e+03_r8, & + &2.1942e+03_r8,1.0970e+03_r8,4.5625e-03_r8/) + kao(:, 2,12, 9) = (/ & + &8.8507e+03_r8,7.7442e+03_r8,6.6378e+03_r8,5.5316e+03_r8,4.4251e+03_r8,3.3189e+03_r8, & + &2.2126e+03_r8,1.1063e+03_r8,8.7877e-03_r8/) + kao(:, 3,12, 9) = (/ & + &8.9020e+03_r8,7.7891e+03_r8,6.6765e+03_r8,5.5638e+03_r8,4.4512e+03_r8,3.3383e+03_r8, & + &2.2256e+03_r8,1.1128e+03_r8,1.5209e-02_r8/) + kao(:, 4,12, 9) = (/ & + &8.9305e+03_r8,7.8144e+03_r8,6.6981e+03_r8,5.5817e+03_r8,4.4653e+03_r8,3.3489e+03_r8, & + &2.2326e+03_r8,1.1163e+03_r8,1.7795e-02_r8/) + kao(:, 5,12, 9) = (/ & + &8.9442e+03_r8,7.8262e+03_r8,6.7079e+03_r8,5.5901e+03_r8,4.4720e+03_r8,3.3539e+03_r8, & + &2.2360e+03_r8,1.1180e+03_r8,2.1474e-02_r8/) + kao(:, 1,13, 9) = (/ & + &8.5284e+03_r8,7.4622e+03_r8,6.3962e+03_r8,5.3302e+03_r8,4.2643e+03_r8,3.1981e+03_r8, & + &2.1321e+03_r8,1.0660e+03_r8,6.4304e-03_r8/) + kao(:, 2,13, 9) = (/ & + &8.5795e+03_r8,7.5072e+03_r8,6.4348e+03_r8,5.3623e+03_r8,4.2900e+03_r8,3.2173e+03_r8, & + &2.1449e+03_r8,1.0725e+03_r8,8.8022e-03_r8/) + kao(:, 3,13, 9) = (/ & + &8.6101e+03_r8,7.5338e+03_r8,6.4575e+03_r8,5.3813e+03_r8,4.3050e+03_r8,3.2288e+03_r8, & + &2.1525e+03_r8,1.0763e+03_r8,1.7025e-02_r8/) + kao(:, 4,13, 9) = (/ & + &8.6267e+03_r8,7.5481e+03_r8,6.4701e+03_r8,5.3916e+03_r8,4.3132e+03_r8,3.2351e+03_r8, & + &2.1567e+03_r8,1.0783e+03_r8,2.0223e-02_r8/) + kao(:, 5,13, 9) = (/ & + &8.6229e+03_r8,7.5451e+03_r8,6.4669e+03_r8,5.3892e+03_r8,4.3114e+03_r8,3.2335e+03_r8, & + &2.1558e+03_r8,1.0779e+03_r8,2.3841e-02_r8/) + kao(:, 1, 1,10) = (/ & + &3.0277e+00_r8,2.6495e+00_r8,2.2716e+00_r8,1.8933e+00_r8,1.5153e+00_r8,1.1372e+00_r8, & + &7.5951e-01_r8,4.2431e-01_r8,1.1653e-01_r8/) + kao(:, 2, 1,10) = (/ & + &3.0877e+00_r8,2.7021e+00_r8,2.3167e+00_r8,1.9311e+00_r8,1.5454e+00_r8,1.1599e+00_r8, & + &7.9480e-01_r8,4.6158e-01_r8,1.5133e-01_r8/) + kao(:, 3, 1,10) = (/ & + &3.1443e+00_r8,2.7514e+00_r8,2.3589e+00_r8,1.9665e+00_r8,1.5738e+00_r8,1.1839e+00_r8, & + &8.4936e-01_r8,4.8883e-01_r8,1.8963e-01_r8/) + kao(:, 4, 1,10) = (/ & + &3.1902e+00_r8,2.7921e+00_r8,2.3935e+00_r8,1.9952e+00_r8,1.5971e+00_r8,1.2268e+00_r8, & + &8.9927e-01_r8,5.1426e-01_r8,2.3885e-01_r8/) + kao(:, 5, 1,10) = (/ & + &3.2311e+00_r8,2.8275e+00_r8,2.4242e+00_r8,2.0206e+00_r8,1.6182e+00_r8,1.2846e+00_r8, & + &9.3468e-01_r8,5.5470e-01_r8,2.9337e-01_r8/) + kao(:, 1, 2,10) = (/ & + &4.5362e+00_r8,3.9696e+00_r8,3.4027e+00_r8,2.8358e+00_r8,2.2692e+00_r8,1.7025e+00_r8, & + &1.1358e+00_r8,5.9446e-01_r8,1.1450e-01_r8/) + kao(:, 2, 2,10) = (/ & + &4.6490e+00_r8,4.0681e+00_r8,3.4874e+00_r8,2.9068e+00_r8,2.3258e+00_r8,1.7450e+00_r8, & + &1.1656e+00_r8,6.4847e-01_r8,1.4911e-01_r8/) + kao(:, 3, 2,10) = (/ & + &4.7559e+00_r8,4.1617e+00_r8,3.5676e+00_r8,2.9735e+00_r8,2.3793e+00_r8,1.7851e+00_r8, & + &1.2174e+00_r8,6.9018e-01_r8,1.9066e-01_r8/) + kao(:, 4, 2,10) = (/ & + &4.8499e+00_r8,4.2438e+00_r8,3.6378e+00_r8,3.0322e+00_r8,2.4263e+00_r8,1.8213e+00_r8, & + &1.2864e+00_r8,7.2155e-01_r8,2.3838e-01_r8/) + kao(:, 5, 2,10) = (/ & + &4.9283e+00_r8,4.3130e+00_r8,3.6972e+00_r8,3.0815e+00_r8,2.4657e+00_r8,1.8737e+00_r8, & + &1.3480e+00_r8,7.6180e-01_r8,2.9224e-01_r8/) + kao(:, 1, 3,10) = (/ & + &9.1512e+00_r8,8.0077e+00_r8,6.8647e+00_r8,5.7202e+00_r8,4.5764e+00_r8,3.4330e+00_r8, & + &2.2893e+00_r8,1.1456e+00_r8,1.0238e-01_r8/) + kao(:, 2, 3,10) = (/ & + &9.4295e+00_r8,8.2512e+00_r8,7.0726e+00_r8,5.8941e+00_r8,4.7160e+00_r8,3.5376e+00_r8, & + &2.3591e+00_r8,1.1894e+00_r8,1.3683e-01_r8/) + kao(:, 3, 3,10) = (/ & + &9.6929e+00_r8,8.4812e+00_r8,7.2704e+00_r8,6.0594e+00_r8,4.8479e+00_r8,3.6364e+00_r8, & + &2.4250e+00_r8,1.2581e+00_r8,1.7750e-01_r8/) + kao(:, 4, 3,10) = (/ & + &9.9289e+00_r8,8.6885e+00_r8,7.4477e+00_r8,6.2066e+00_r8,4.9652e+00_r8,3.7251e+00_r8, & + &2.4842e+00_r8,1.3376e+00_r8,2.2412e-01_r8/) + kao(:, 5, 3,10) = (/ & + &1.0116e+01_r8,8.8511e+00_r8,7.5880e+00_r8,6.3233e+00_r8,5.0592e+00_r8,3.7951e+00_r8, & + &2.5511e+00_r8,1.3941e+00_r8,2.7545e-01_r8/) + kao(:, 1, 4,10) = (/ & + &1.9425e+01_r8,1.6997e+01_r8,1.4568e+01_r8,1.2141e+01_r8,9.7127e+00_r8,7.2856e+00_r8, & + &4.8569e+00_r8,2.4292e+00_r8,8.5208e-02_r8/) + kao(:, 2, 4,10) = (/ & + &1.9954e+01_r8,1.7460e+01_r8,1.4965e+01_r8,1.2471e+01_r8,9.9767e+00_r8,7.4831e+00_r8, & + &4.9893e+00_r8,2.4954e+00_r8,1.1708e-01_r8/) + kao(:, 3, 4,10) = (/ & + &2.0423e+01_r8,1.7870e+01_r8,1.5318e+01_r8,1.2764e+01_r8,1.0212e+01_r8,7.6596e+00_r8, & + &5.1068e+00_r8,2.5544e+00_r8,1.5673e-01_r8/) + kao(:, 4, 4,10) = (/ & + &2.0864e+01_r8,1.8257e+01_r8,1.5649e+01_r8,1.3042e+01_r8,1.0433e+01_r8,7.8250e+00_r8, & + &5.2173e+00_r8,2.6098e+00_r8,2.0293e-01_r8/) + kao(:, 5, 4,10) = (/ & + &2.1248e+01_r8,1.8592e+01_r8,1.5938e+01_r8,1.3281e+01_r8,1.0624e+01_r8,7.9692e+00_r8, & + &5.3131e+00_r8,2.6931e+00_r8,2.5421e-01_r8/) + kao(:, 1, 5,10) = (/ & + &4.0147e+01_r8,3.5130e+01_r8,3.0111e+01_r8,2.5093e+01_r8,2.0073e+01_r8,1.5056e+01_r8, & + &1.0038e+01_r8,5.0189e+00_r8,6.8359e-02_r8/) + kao(:, 2, 5,10) = (/ & + &4.0924e+01_r8,3.5810e+01_r8,3.0692e+01_r8,2.5576e+01_r8,2.0461e+01_r8,1.5346e+01_r8, & + &1.0232e+01_r8,5.1160e+00_r8,9.6926e-02_r8/) + kao(:, 3, 5,10) = (/ & + &4.1536e+01_r8,3.6343e+01_r8,3.1153e+01_r8,2.5962e+01_r8,2.0769e+01_r8,1.5577e+01_r8, & + &1.0385e+01_r8,5.1928e+00_r8,1.3304e-01_r8/) + kao(:, 4, 5,10) = (/ & + &4.2166e+01_r8,3.6896e+01_r8,3.1624e+01_r8,2.6353e+01_r8,2.1083e+01_r8,1.5813e+01_r8, & + &1.0542e+01_r8,5.2715e+00_r8,1.7579e-01_r8/) + kao(:, 5, 5,10) = (/ & + &4.2771e+01_r8,3.7425e+01_r8,3.2079e+01_r8,2.6732e+01_r8,2.1385e+01_r8,1.6040e+01_r8, & + &1.0693e+01_r8,5.3473e+00_r8,2.2393e-01_r8/) + kao(:, 1, 6,10) = (/ & + &8.0027e+01_r8,7.0022e+01_r8,6.0023e+01_r8,5.0019e+01_r8,4.0013e+01_r8,3.0011e+01_r8, & + &2.0007e+01_r8,1.0004e+01_r8,5.3924e-02_r8/) + kao(:, 2, 6,10) = (/ & + &8.1173e+01_r8,7.1024e+01_r8,6.0878e+01_r8,5.0731e+01_r8,4.0584e+01_r8,3.0439e+01_r8, & + &2.0293e+01_r8,1.0147e+01_r8,7.8165e-02_r8/) + kao(:, 3, 6,10) = (/ & + &8.2280e+01_r8,7.1996e+01_r8,6.1710e+01_r8,5.1425e+01_r8,4.1141e+01_r8,3.0855e+01_r8, & + &2.0570e+01_r8,1.0285e+01_r8,1.0934e-01_r8/) + kao(:, 4, 6,10) = (/ & + &8.3115e+01_r8,7.2722e+01_r8,6.2336e+01_r8,5.1947e+01_r8,4.1558e+01_r8,3.1167e+01_r8, & + &2.0778e+01_r8,1.0390e+01_r8,1.4595e-01_r8/) + kao(:, 5, 6,10) = (/ & + &8.3819e+01_r8,7.3349e+01_r8,6.2867e+01_r8,5.2391e+01_r8,4.1913e+01_r8,3.1434e+01_r8, & + &2.0957e+01_r8,1.0479e+01_r8,1.8806e-01_r8/) + kao(:, 1, 7,10) = (/ & + &1.6996e+02_r8,1.4871e+02_r8,1.2747e+02_r8,1.0622e+02_r8,8.4977e+01_r8,6.3734e+01_r8, & + &4.2490e+01_r8,2.1246e+01_r8,4.2588e-02_r8/) + kao(:, 2, 7,10) = (/ & + &1.7243e+02_r8,1.5088e+02_r8,1.2932e+02_r8,1.0776e+02_r8,8.6211e+01_r8,6.4660e+01_r8, & + &4.3106e+01_r8,2.1553e+01_r8,6.2851e-02_r8/) + kao(:, 3, 7,10) = (/ & + &1.7457e+02_r8,1.5274e+02_r8,1.3092e+02_r8,1.0910e+02_r8,8.7283e+01_r8,6.5459e+01_r8, & + &4.3641e+01_r8,2.1821e+01_r8,8.8704e-02_r8/) + kao(:, 4, 7,10) = (/ & + &1.7636e+02_r8,1.5432e+02_r8,1.3227e+02_r8,1.1023e+02_r8,8.8183e+01_r8,6.6138e+01_r8, & + &4.4090e+01_r8,2.2046e+01_r8,1.1966e-01_r8/) + kao(:, 5, 7,10) = (/ & + &1.7764e+02_r8,1.5544e+02_r8,1.3323e+02_r8,1.1102e+02_r8,8.8816e+01_r8,6.6613e+01_r8, & + &4.4410e+01_r8,2.2206e+01_r8,1.5600e-01_r8/) + kao(:, 1, 8,10) = (/ & + &4.3531e+02_r8,3.8090e+02_r8,3.2647e+02_r8,2.7207e+02_r8,2.1766e+02_r8,1.6325e+02_r8, & + &1.0883e+02_r8,5.4412e+01_r8,3.2634e-02_r8/) + kao(:, 2, 8,10) = (/ & + &4.4098e+02_r8,3.8585e+02_r8,3.3074e+02_r8,2.7562e+02_r8,2.2050e+02_r8,1.6536e+02_r8, & + &1.1025e+02_r8,5.5123e+01_r8,4.9788e-02_r8/) + kao(:, 3, 8,10) = (/ & + &4.4650e+02_r8,3.9069e+02_r8,3.3490e+02_r8,2.7906e+02_r8,2.2325e+02_r8,1.6744e+02_r8, & + &1.1162e+02_r8,5.5816e+01_r8,7.2094e-02_r8/) + kao(:, 4, 8,10) = (/ & + &4.5108e+02_r8,3.9470e+02_r8,3.3831e+02_r8,2.8194e+02_r8,2.2555e+02_r8,1.6915e+02_r8, & + &1.1277e+02_r8,5.6387e+01_r8,9.8901e-02_r8/) + kao(:, 5, 8,10) = (/ & + &4.5442e+02_r8,3.9761e+02_r8,3.4081e+02_r8,2.8400e+02_r8,2.2721e+02_r8,1.7040e+02_r8, & + &1.1360e+02_r8,5.6798e+01_r8,1.3038e-01_r8/) + kao(:, 1, 9,10) = (/ & + &2.1147e+03_r8,1.8504e+03_r8,1.5860e+03_r8,1.3217e+03_r8,1.0574e+03_r8,7.9304e+02_r8, & + &5.2867e+02_r8,2.6435e+02_r8,1.9424e-02_r8/) + kao(:, 2, 9,10) = (/ & + &2.1442e+03_r8,1.8762e+03_r8,1.6082e+03_r8,1.3401e+03_r8,1.0721e+03_r8,8.0408e+02_r8, & + &5.3608e+02_r8,2.6803e+02_r8,3.6865e-02_r8/) + kao(:, 3, 9,10) = (/ & + &2.1685e+03_r8,1.8976e+03_r8,1.6264e+03_r8,1.3553e+03_r8,1.0842e+03_r8,8.1317e+02_r8, & + &5.4213e+02_r8,2.7107e+02_r8,5.5684e-02_r8/) + kao(:, 4, 9,10) = (/ & + &2.1886e+03_r8,1.9151e+03_r8,1.6415e+03_r8,1.3680e+03_r8,1.0943e+03_r8,8.2077e+02_r8, & + &5.4720e+02_r8,2.7360e+02_r8,7.8135e-02_r8/) + kao(:, 5, 9,10) = (/ & + &2.2035e+03_r8,1.9281e+03_r8,1.6526e+03_r8,1.3772e+03_r8,1.1018e+03_r8,8.2634e+02_r8, & + &5.5093e+02_r8,2.7546e+02_r8,1.0558e-01_r8/) + kao(:, 1,10,10) = (/ & + &1.1340e+04_r8,9.9225e+03_r8,8.5053e+03_r8,7.0882e+03_r8,5.6700e+03_r8,4.2524e+03_r8, & + &2.8350e+03_r8,1.4175e+03_r8,1.1591e-02_r8/) + kao(:, 2,10,10) = (/ & + &1.1483e+04_r8,1.0048e+04_r8,8.6127e+03_r8,7.1771e+03_r8,5.7419e+03_r8,4.3066e+03_r8, & + &2.8709e+03_r8,1.4354e+03_r8,1.2588e-02_r8/) + kao(:, 3,10,10) = (/ & + &1.1610e+04_r8,1.0159e+04_r8,8.7071e+03_r8,7.2559e+03_r8,5.8048e+03_r8,4.3532e+03_r8, & + &2.9023e+03_r8,1.4511e+03_r8,2.5538e-02_r8/) + kao(:, 4,10,10) = (/ & + &1.1702e+04_r8,1.0239e+04_r8,8.7766e+03_r8,7.3135e+03_r8,5.8511e+03_r8,4.3884e+03_r8, & + &2.9255e+03_r8,1.4628e+03_r8,4.5275e-02_r8/) + kao(:, 5,10,10) = (/ & + &1.1737e+04_r8,1.0270e+04_r8,8.8031e+03_r8,7.3358e+03_r8,5.8688e+03_r8,4.4014e+03_r8, & + &2.9344e+03_r8,1.4670e+03_r8,5.8192e-02_r8/) + kao(:, 1,11,10) = (/ & + &2.0903e+04_r8,1.8291e+04_r8,1.5678e+04_r8,1.3065e+04_r8,1.0451e+04_r8,7.8389e+03_r8, & + &5.2261e+03_r8,2.6129e+03_r8,7.1886e-03_r8/) + kao(:, 2,11,10) = (/ & + &2.1095e+04_r8,1.8459e+04_r8,1.5821e+04_r8,1.3184e+04_r8,1.0548e+04_r8,7.9109e+03_r8, & + &5.2736e+03_r8,2.6368e+03_r8,6.0460e-03_r8/) + kao(:, 3,11,10) = (/ & + &2.1210e+04_r8,1.8559e+04_r8,1.5908e+04_r8,1.3256e+04_r8,1.0605e+04_r8,7.9536e+03_r8, & + &5.3027e+03_r8,2.6511e+03_r8,2.6262e-02_r8/) + kao(:, 4,11,10) = (/ & + &2.1260e+04_r8,1.8603e+04_r8,1.5945e+04_r8,1.3287e+04_r8,1.0630e+04_r8,7.9726e+03_r8, & + &5.3149e+03_r8,2.6575e+03_r8,3.1824e-02_r8/) + kao(:, 5,11,10) = (/ & + &2.1221e+04_r8,1.8569e+04_r8,1.5915e+04_r8,1.3263e+04_r8,1.0611e+04_r8,7.9580e+03_r8, & + &5.3053e+03_r8,2.6525e+03_r8,4.2831e-02_r8/) + kao(:, 1,12,10) = (/ & + &2.8005e+04_r8,2.4506e+04_r8,2.1003e+04_r8,1.7504e+04_r8,1.4003e+04_r8,1.0502e+04_r8, & + &7.0018e+03_r8,3.5007e+03_r8,1.9282e-02_r8/) + kao(:, 2,12,10) = (/ & + &2.8178e+04_r8,2.4656e+04_r8,2.1135e+04_r8,1.7611e+04_r8,1.4090e+04_r8,1.0567e+04_r8, & + &7.0445e+03_r8,3.5221e+03_r8,8.6382e-03_r8/) + kao(:, 3,12,10) = (/ & + &2.8205e+04_r8,2.4680e+04_r8,2.1153e+04_r8,1.7628e+04_r8,1.4103e+04_r8,1.0577e+04_r8, & + &7.0512e+03_r8,3.5256e+03_r8,2.9773e-02_r8/) + kao(:, 4,12,10) = (/ & + &2.8170e+04_r8,2.4648e+04_r8,2.1126e+04_r8,1.7606e+04_r8,1.4084e+04_r8,1.0563e+04_r8, & + &7.0421e+03_r8,3.5211e+03_r8,3.9720e-02_r8/) + kao(:, 5,12,10) = (/ & + &2.8047e+04_r8,2.4540e+04_r8,2.1034e+04_r8,1.7529e+04_r8,1.4023e+04_r8,1.0517e+04_r8, & + &7.0115e+03_r8,3.5058e+03_r8,4.1794e-02_r8/) + kao(:, 1,13,10) = (/ & + &2.9533e+04_r8,2.5841e+04_r8,2.2150e+04_r8,1.8457e+04_r8,1.4766e+04_r8,1.1075e+04_r8, & + &7.3833e+03_r8,3.6917e+03_r8,1.5098e-03_r8/) + kao(:, 2,13,10) = (/ & + &2.9558e+04_r8,2.5865e+04_r8,2.2169e+04_r8,1.8475e+04_r8,1.4779e+04_r8,1.1085e+04_r8, & + &7.3900e+03_r8,3.6949e+03_r8,1.2533e-02_r8/) + kao(:, 3,13,10) = (/ & + &2.9540e+04_r8,2.5844e+04_r8,2.2155e+04_r8,1.8463e+04_r8,1.4769e+04_r8,1.1077e+04_r8, & + &7.3851e+03_r8,3.6924e+03_r8,1.7410e-02_r8/) + kao(:, 4,13,10) = (/ & + &2.9338e+04_r8,2.5670e+04_r8,2.2004e+04_r8,1.8336e+04_r8,1.4669e+04_r8,1.1002e+04_r8, & + &7.3346e+03_r8,3.6671e+03_r8,4.5009e-02_r8/) + kao(:, 5,13,10) = (/ & + &2.9073e+04_r8,2.5440e+04_r8,2.1806e+04_r8,1.8171e+04_r8,1.4537e+04_r8,1.0903e+04_r8, & + &7.2684e+03_r8,3.6344e+03_r8,5.0725e-02_r8/) + kao(:, 1, 1,11) = (/ & + &5.0284e+00_r8,4.3997e+00_r8,3.7713e+00_r8,3.1433e+00_r8,2.5148e+00_r8,1.8867e+00_r8, & + &1.2585e+00_r8,6.3034e-01_r8,1.3324e-01_r8/) + kao(:, 2, 1,11) = (/ & + &5.0428e+00_r8,4.4122e+00_r8,3.7822e+00_r8,3.1521e+00_r8,2.5223e+00_r8,1.8921e+00_r8, & + &1.2620e+00_r8,6.6040e-01_r8,1.7160e-01_r8/) + kao(:, 3, 1,11) = (/ & + &5.0450e+00_r8,4.4148e+00_r8,3.7841e+00_r8,3.1540e+00_r8,2.5234e+00_r8,1.8930e+00_r8, & + &1.2629e+00_r8,7.0553e-01_r8,2.2033e-01_r8/) + kao(:, 4, 1,11) = (/ & + &5.0314e+00_r8,4.4027e+00_r8,3.7741e+00_r8,3.1454e+00_r8,2.5166e+00_r8,1.8879e+00_r8, & + &1.2828e+00_r8,7.2981e-01_r8,2.7819e-01_r8/) + kao(:, 5, 1,11) = (/ & + &5.0061e+00_r8,4.3808e+00_r8,3.7550e+00_r8,3.1298e+00_r8,2.5041e+00_r8,1.8785e+00_r8, & + &1.3311e+00_r8,7.4514e-01_r8,3.4945e-01_r8/) + kao(:, 1, 2,11) = (/ & + &7.7109e+00_r8,6.7474e+00_r8,5.7839e+00_r8,4.8201e+00_r8,3.8564e+00_r8,2.8926e+00_r8, & + &1.9289e+00_r8,9.6516e-01_r8,1.3538e-01_r8/) + kao(:, 2, 2,11) = (/ & + &7.7553e+00_r8,6.7857e+00_r8,5.8167e+00_r8,4.8473e+00_r8,3.8784e+00_r8,2.9091e+00_r8, & + &1.9400e+00_r8,9.7434e-01_r8,1.7899e-01_r8/) + kao(:, 3, 2,11) = (/ & + &7.7777e+00_r8,6.8060e+00_r8,5.8332e+00_r8,4.8617e+00_r8,3.8897e+00_r8,2.9178e+00_r8, & + &1.9457e+00_r8,1.0175e+00_r8,2.2662e-01_r8/) + kao(:, 4, 2,11) = (/ & + &7.7756e+00_r8,6.8039e+00_r8,5.8323e+00_r8,4.8602e+00_r8,3.8885e+00_r8,2.9169e+00_r8, & + &1.9452e+00_r8,1.0634e+00_r8,2.8531e-01_r8/) + kao(:, 5, 2,11) = (/ & + &7.7495e+00_r8,6.7817e+00_r8,5.8131e+00_r8,4.8446e+00_r8,3.8758e+00_r8,2.9075e+00_r8, & + &1.9643e+00_r8,1.0863e+00_r8,3.5634e-01_r8/) + kao(:, 1, 3,11) = (/ & + &1.5932e+01_r8,1.3941e+01_r8,1.1949e+01_r8,9.9578e+00_r8,7.9671e+00_r8,5.9754e+00_r8, & + &3.9840e+00_r8,1.9926e+00_r8,1.2714e-01_r8/) + kao(:, 2, 3,11) = (/ & + &1.6076e+01_r8,1.4067e+01_r8,1.2058e+01_r8,1.0048e+01_r8,8.0387e+00_r8,6.0296e+00_r8, & + &4.0199e+00_r8,2.0105e+00_r8,1.7056e-01_r8/) + kao(:, 3, 3,11) = (/ & + &1.6164e+01_r8,1.4145e+01_r8,1.2124e+01_r8,1.0103e+01_r8,8.0829e+00_r8,6.0627e+00_r8, & + &4.0424e+00_r8,2.0217e+00_r8,2.2135e-01_r8/) + kao(:, 4, 3,11) = (/ & + &1.6211e+01_r8,1.4185e+01_r8,1.2159e+01_r8,1.0132e+01_r8,8.1062e+00_r8,6.0800e+00_r8, & + &4.0538e+00_r8,2.0361e+00_r8,2.7967e-01_r8/) + kao(:, 5, 3,11) = (/ & + &1.6213e+01_r8,1.4187e+01_r8,1.2160e+01_r8,1.0134e+01_r8,8.1068e+00_r8,6.0810e+00_r8, & + &4.0544e+00_r8,2.0887e+00_r8,3.5085e-01_r8/) + kao(:, 1, 4,11) = (/ & + &3.3505e+01_r8,2.9316e+01_r8,2.5128e+01_r8,2.0940e+01_r8,1.6753e+01_r8,1.2564e+01_r8, & + &8.3770e+00_r8,4.1888e+00_r8,1.1343e-01_r8/) + kao(:, 2, 4,11) = (/ & + &3.3957e+01_r8,2.9712e+01_r8,2.5469e+01_r8,2.1224e+01_r8,1.6979e+01_r8,1.2735e+01_r8, & + &8.4899e+00_r8,4.2456e+00_r8,1.5601e-01_r8/) + kao(:, 3, 4,11) = (/ & + &3.4273e+01_r8,2.9992e+01_r8,2.5707e+01_r8,2.1421e+01_r8,1.7138e+01_r8,1.2854e+01_r8, & + &8.5693e+00_r8,4.2852e+00_r8,2.0536e-01_r8/) + kao(:, 4, 4,11) = (/ & + &3.4537e+01_r8,3.0216e+01_r8,2.5901e+01_r8,2.1585e+01_r8,1.7269e+01_r8,1.2951e+01_r8, & + &8.6346e+00_r8,4.3178e+00_r8,2.6462e-01_r8/) + kao(:, 5, 4,11) = (/ & + &3.4713e+01_r8,3.0370e+01_r8,2.6032e+01_r8,2.1696e+01_r8,1.7356e+01_r8,1.3018e+01_r8, & + &8.6791e+00_r8,4.3400e+00_r8,3.3230e-01_r8/) + kao(:, 1, 5,11) = (/ & + &6.4813e+01_r8,5.6712e+01_r8,4.8608e+01_r8,4.0507e+01_r8,3.2408e+01_r8,2.4306e+01_r8, & + &1.6204e+01_r8,8.1017e+00_r8,9.6356e-02_r8/) + kao(:, 2, 5,11) = (/ & + &6.6164e+01_r8,5.7895e+01_r8,4.9623e+01_r8,4.1352e+01_r8,3.3084e+01_r8,2.4813e+01_r8, & + &1.6542e+01_r8,8.2707e+00_r8,1.3652e-01_r8/) + kao(:, 3, 5,11) = (/ & + &6.7228e+01_r8,5.8826e+01_r8,5.0425e+01_r8,4.2018e+01_r8,3.3613e+01_r8,2.5211e+01_r8, & + &1.6808e+01_r8,8.4044e+00_r8,1.8472e-01_r8/) + kao(:, 4, 5,11) = (/ & + &6.8035e+01_r8,5.9536e+01_r8,5.1024e+01_r8,4.2523e+01_r8,3.4019e+01_r8,2.5513e+01_r8, & + &1.7010e+01_r8,8.5064e+00_r8,2.4242e-01_r8/) + kao(:, 5, 5,11) = (/ & + &6.8554e+01_r8,5.9987e+01_r8,5.1420e+01_r8,4.2849e+01_r8,3.4277e+01_r8,2.5710e+01_r8, & + &1.7140e+01_r8,8.5702e+00_r8,3.0919e-01_r8/) + kao(:, 1, 6,11) = (/ & + &1.1801e+02_r8,1.0326e+02_r8,8.8506e+01_r8,7.3757e+01_r8,5.9002e+01_r8,4.4254e+01_r8, & + &2.9503e+01_r8,1.4751e+01_r8,7.7344e-02_r8/) + kao(:, 2, 6,11) = (/ & + &1.2108e+02_r8,1.0594e+02_r8,9.0808e+01_r8,7.5672e+01_r8,6.0541e+01_r8,4.5406e+01_r8, & + &3.0271e+01_r8,1.5134e+01_r8,1.1263e-01_r8/) + kao(:, 3, 6,11) = (/ & + &1.2354e+02_r8,1.0810e+02_r8,9.2652e+01_r8,7.7213e+01_r8,6.1769e+01_r8,4.6330e+01_r8, & + &3.0886e+01_r8,1.5443e+01_r8,1.5682e-01_r8/) + kao(:, 4, 6,11) = (/ & + &1.2526e+02_r8,1.0960e+02_r8,9.3943e+01_r8,7.8284e+01_r8,6.2629e+01_r8,4.6975e+01_r8, & + &3.1316e+01_r8,1.5657e+01_r8,2.1207e-01_r8/) + kao(:, 5, 6,11) = (/ & + &1.2664e+02_r8,1.1081e+02_r8,9.4976e+01_r8,7.9149e+01_r8,6.3321e+01_r8,4.7490e+01_r8, & + &3.1658e+01_r8,1.5831e+01_r8,2.7724e-01_r8/) + kao(:, 1, 7,11) = (/ & + &2.3249e+02_r8,2.0341e+02_r8,1.7435e+02_r8,1.4529e+02_r8,1.1624e+02_r8,8.7178e+01_r8, & + &5.8117e+01_r8,2.9059e+01_r8,6.0308e-02_r8/) + kao(:, 2, 7,11) = (/ & + &2.3796e+02_r8,2.0820e+02_r8,1.7846e+02_r8,1.4871e+02_r8,1.1897e+02_r8,8.9231e+01_r8, & + &5.9488e+01_r8,2.9745e+01_r8,9.0208e-02_r8/) + kao(:, 3, 7,11) = (/ & + &2.4226e+02_r8,2.1197e+02_r8,1.8170e+02_r8,1.5141e+02_r8,1.2113e+02_r8,9.0843e+01_r8, & + &6.0568e+01_r8,3.0281e+01_r8,1.2927e-01_r8/) + kao(:, 4, 7,11) = (/ & + &2.4544e+02_r8,2.1477e+02_r8,1.8409e+02_r8,1.5341e+02_r8,1.2272e+02_r8,9.2044e+01_r8, & + &6.1361e+01_r8,3.0682e+01_r8,1.7878e-01_r8/) + kao(:, 5, 7,11) = (/ & + &2.4764e+02_r8,2.1668e+02_r8,1.8573e+02_r8,1.5477e+02_r8,1.2381e+02_r8,9.2866e+01_r8, & + &6.1907e+01_r8,3.0956e+01_r8,2.3824e-01_r8/) + kao(:, 1, 8,11) = (/ & + &5.7428e+02_r8,5.0249e+02_r8,4.3070e+02_r8,3.5893e+02_r8,2.8714e+02_r8,2.1536e+02_r8, & + &1.4357e+02_r8,7.1786e+01_r8,4.7227e-02_r8/) + kao(:, 2, 8,11) = (/ & + &5.8499e+02_r8,5.1190e+02_r8,4.3878e+02_r8,3.6564e+02_r8,2.9252e+02_r8,2.1939e+02_r8, & + &1.4626e+02_r8,7.3130e+01_r8,7.2171e-02_r8/) + kao(:, 3, 8,11) = (/ & + &5.9291e+02_r8,5.1879e+02_r8,4.4470e+02_r8,3.7058e+02_r8,2.9645e+02_r8,2.2235e+02_r8, & + &1.4822e+02_r8,7.4114e+01_r8,1.0536e-01_r8/) + kao(:, 4, 8,11) = (/ & + &5.9816e+02_r8,5.2341e+02_r8,4.4862e+02_r8,3.7386e+02_r8,2.9908e+02_r8,2.2431e+02_r8, & + &1.4954e+02_r8,7.4773e+01_r8,1.4833e-01_r8/) + kao(:, 5, 8,11) = (/ & + &6.0144e+02_r8,5.2627e+02_r8,4.5109e+02_r8,3.7590e+02_r8,3.0070e+02_r8,2.2554e+02_r8, & + &1.5036e+02_r8,7.5181e+01_r8,1.9981e-01_r8/) + kao(:, 1, 9,11) = (/ & + &2.7514e+03_r8,2.4073e+03_r8,2.0635e+03_r8,1.7196e+03_r8,1.3757e+03_r8,1.0318e+03_r8, & + &6.8788e+02_r8,3.4393e+02_r8,3.3107e-02_r8/) + kao(:, 2, 9,11) = (/ & + &2.7973e+03_r8,2.4476e+03_r8,2.0979e+03_r8,1.7482e+03_r8,1.3986e+03_r8,1.0490e+03_r8, & + &6.9932e+02_r8,3.4966e+02_r8,5.6998e-02_r8/) + kao(:, 3, 9,11) = (/ & + &2.8265e+03_r8,2.4731e+03_r8,2.1197e+03_r8,1.7664e+03_r8,1.4131e+03_r8,1.0599e+03_r8, & + &7.0662e+02_r8,3.5330e+02_r8,8.5901e-02_r8/) + kao(:, 4, 9,11) = (/ & + &2.8388e+03_r8,2.4841e+03_r8,2.1291e+03_r8,1.7743e+03_r8,1.4194e+03_r8,1.0646e+03_r8, & + &7.0974e+02_r8,3.5484e+02_r8,1.2233e-01_r8/) + kao(:, 5, 9,11) = (/ & + &2.8373e+03_r8,2.4828e+03_r8,2.1280e+03_r8,1.7734e+03_r8,1.4187e+03_r8,1.0640e+03_r8, & + &7.0933e+02_r8,3.5467e+02_r8,1.6642e-01_r8/) + kao(:, 1,10,11) = (/ & + &1.4796e+04_r8,1.2947e+04_r8,1.1097e+04_r8,9.2476e+03_r8,7.3982e+03_r8,5.5489e+03_r8, & + &3.6992e+03_r8,1.8496e+03_r8,1.7335e-02_r8/) + kao(:, 2,10,11) = (/ & + &1.4975e+04_r8,1.3103e+04_r8,1.1231e+04_r8,9.3585e+03_r8,7.4871e+03_r8,5.6155e+03_r8, & + &3.7435e+03_r8,1.8717e+03_r8,3.1226e-02_r8/) + kao(:, 3,10,11) = (/ & + &1.5074e+04_r8,1.3189e+04_r8,1.1305e+04_r8,9.4210e+03_r8,7.5370e+03_r8,5.6528e+03_r8, & + &3.7685e+03_r8,1.8842e+03_r8,4.3228e-02_r8/) + kao(:, 4,10,11) = (/ & + &1.5109e+04_r8,1.3220e+04_r8,1.1331e+04_r8,9.4424e+03_r8,7.5542e+03_r8,5.6659e+03_r8, & + &3.7773e+03_r8,1.8886e+03_r8,5.6685e-02_r8/) + kao(:, 5,10,11) = (/ & + &1.5082e+04_r8,1.3196e+04_r8,1.1311e+04_r8,9.4257e+03_r8,7.5405e+03_r8,5.6555e+03_r8, & + &3.7704e+03_r8,1.8852e+03_r8,8.6311e-02_r8/) + kao(:, 1,11,11) = (/ & + &2.7889e+04_r8,2.4402e+04_r8,2.0916e+04_r8,1.7430e+04_r8,1.3944e+04_r8,1.0458e+04_r8, & + &6.9720e+03_r8,3.4860e+03_r8,1.1432e-02_r8/) + kao(:, 2,11,11) = (/ & + &2.8116e+04_r8,2.4602e+04_r8,2.1087e+04_r8,1.7573e+04_r8,1.4058e+04_r8,1.0543e+04_r8, & + &7.0292e+03_r8,3.5144e+03_r8,1.1075e-02_r8/) + kao(:, 3,11,11) = (/ & + &2.8224e+04_r8,2.4695e+04_r8,2.1166e+04_r8,1.7640e+04_r8,1.4112e+04_r8,1.0583e+04_r8, & + &7.0560e+03_r8,3.5276e+03_r8,4.6547e-02_r8/) + kao(:, 4,11,11) = (/ & + &2.8217e+04_r8,2.4690e+04_r8,2.1162e+04_r8,1.7636e+04_r8,1.4108e+04_r8,1.0581e+04_r8, & + &7.0540e+03_r8,3.5272e+03_r8,6.2488e-02_r8/) + kao(:, 5,11,11) = (/ & + &2.8126e+04_r8,2.4609e+04_r8,2.1093e+04_r8,1.7578e+04_r8,1.4063e+04_r8,1.0547e+04_r8, & + &7.0311e+03_r8,3.5155e+03_r8,7.5051e-02_r8/) + kao(:, 1,12,11) = (/ & + &3.8808e+04_r8,3.3958e+04_r8,2.9106e+04_r8,2.4255e+04_r8,1.9403e+04_r8,1.4552e+04_r8, & + &9.7020e+03_r8,4.8510e+03_r8,3.0879e-04_r8/) + kao(:, 2,12,11) = (/ & + &3.8964e+04_r8,3.4093e+04_r8,2.9222e+04_r8,2.4351e+04_r8,1.9482e+04_r8,1.4612e+04_r8, & + &9.7411e+03_r8,4.8703e+03_r8,1.3840e-02_r8/) + kao(:, 3,12,11) = (/ & + &3.8935e+04_r8,3.4067e+04_r8,2.9198e+04_r8,2.4333e+04_r8,1.9466e+04_r8,1.4600e+04_r8, & + &9.7333e+03_r8,4.8667e+03_r8,2.1306e-02_r8/) + kao(:, 4,12,11) = (/ & + &3.8831e+04_r8,3.3979e+04_r8,2.9123e+04_r8,2.4270e+04_r8,1.9417e+04_r8,1.4562e+04_r8, & + &9.7077e+03_r8,4.8538e+03_r8,6.5973e-02_r8/) + kao(:, 5,12,11) = (/ & + &3.8549e+04_r8,3.3728e+04_r8,2.8909e+04_r8,2.4091e+04_r8,1.9273e+04_r8,1.4455e+04_r8, & + &9.6358e+03_r8,4.8182e+03_r8,7.9959e-02_r8/) + kao(:, 1,13,11) = (/ & + &4.2486e+04_r8,3.7175e+04_r8,3.1864e+04_r8,2.6552e+04_r8,2.1242e+04_r8,1.5932e+04_r8, & + &1.0621e+04_r8,5.3106e+03_r8,2.4053e-04_r8/) + kao(:, 2,13,11) = (/ & + &4.2536e+04_r8,3.7221e+04_r8,3.1903e+04_r8,2.6585e+04_r8,2.1268e+04_r8,1.5951e+04_r8, & + &1.0634e+04_r8,5.3169e+03_r8,2.3604e-02_r8/) + kao(:, 3,13,11) = (/ & + &4.2342e+04_r8,3.7047e+04_r8,3.1757e+04_r8,2.6467e+04_r8,2.1172e+04_r8,1.5879e+04_r8, & + &1.0585e+04_r8,5.2925e+03_r8,1.5018e-02_r8/) + kao(:, 4,13,11) = (/ & + &4.2048e+04_r8,3.6792e+04_r8,3.1537e+04_r8,2.6281e+04_r8,2.1024e+04_r8,1.5767e+04_r8, & + &1.0512e+04_r8,5.2560e+03_r8,5.3807e-02_r8/) + kao(:, 5,13,11) = (/ & + &4.1662e+04_r8,3.6457e+04_r8,3.1248e+04_r8,2.6040e+04_r8,2.0833e+04_r8,1.5623e+04_r8, & + &1.0416e+04_r8,5.2082e+03_r8,6.8318e-02_r8/) + kao(:, 1, 1,12) = (/ & + &7.2849e+00_r8,6.3745e+00_r8,5.4643e+00_r8,4.5537e+00_r8,3.6431e+00_r8,2.7326e+00_r8, & + &1.8223e+00_r8,9.1190e-01_r8,1.6091e-01_r8/) + kao(:, 2, 1,12) = (/ & + &7.1530e+00_r8,6.2588e+00_r8,5.3648e+00_r8,4.4709e+00_r8,3.5770e+00_r8,2.6830e+00_r8, & + &1.7891e+00_r8,8.9548e-01_r8,2.2421e-01_r8/) + kao(:, 3, 1,12) = (/ & + &7.0158e+00_r8,6.1389e+00_r8,5.2624e+00_r8,4.3853e+00_r8,3.5089e+00_r8,2.6317e+00_r8, & + &1.7551e+00_r8,9.0204e-01_r8,3.0513e-01_r8/) + kao(:, 4, 1,12) = (/ & + &6.8752e+00_r8,6.0158e+00_r8,5.1568e+00_r8,4.2975e+00_r8,3.4386e+00_r8,2.5792e+00_r8, & + &1.7200e+00_r8,9.2056e-01_r8,4.0130e-01_r8/) + kao(:, 5, 1,12) = (/ & + &6.7312e+00_r8,5.8897e+00_r8,5.0486e+00_r8,4.2075e+00_r8,3.3663e+00_r8,2.5251e+00_r8, & + &1.6886e+00_r8,9.1312e-01_r8,5.1163e-01_r8/) + kao(:, 1, 2,12) = (/ & + &1.1380e+01_r8,9.9571e+00_r8,8.5349e+00_r8,7.1126e+00_r8,5.6896e+00_r8,4.2680e+00_r8, & + &2.8456e+00_r8,1.4234e+00_r8,1.6023e-01_r8/) + kao(:, 2, 2,12) = (/ & + &1.1190e+01_r8,9.7913e+00_r8,8.3926e+00_r8,6.9944e+00_r8,5.5956e+00_r8,4.1971e+00_r8, & + &2.7983e+00_r8,1.3998e+00_r8,2.1092e-01_r8/) + kao(:, 3, 2,12) = (/ & + &1.0994e+01_r8,9.6196e+00_r8,8.2451e+00_r8,6.8714e+00_r8,5.4970e+00_r8,4.1233e+00_r8, & + &2.7491e+00_r8,1.3753e+00_r8,2.8249e-01_r8/) + kao(:, 4, 2,12) = (/ & + &1.0789e+01_r8,9.4404e+00_r8,8.0917e+00_r8,6.7431e+00_r8,5.3950e+00_r8,4.0464e+00_r8, & + &2.6980e+00_r8,1.3854e+00_r8,3.7167e-01_r8/) + kao(:, 5, 2,12) = (/ & + &1.0574e+01_r8,9.2528e+00_r8,7.9306e+00_r8,6.6095e+00_r8,5.2877e+00_r8,3.9662e+00_r8, & + &2.6446e+00_r8,1.3862e+00_r8,4.7628e-01_r8/) + kao(:, 1, 3,12) = (/ & + &2.4019e+01_r8,2.1015e+01_r8,1.8012e+01_r8,1.5011e+01_r8,1.2010e+01_r8,9.0070e+00_r8, & + &6.0051e+00_r8,3.0029e+00_r8,1.5458e-01_r8/) + kao(:, 2, 3,12) = (/ & + &2.3668e+01_r8,2.0712e+01_r8,1.7752e+01_r8,1.4794e+01_r8,1.1835e+01_r8,8.8764e+00_r8, & + &5.9181e+00_r8,2.9594e+00_r8,2.0548e-01_r8/) + kao(:, 3, 3,12) = (/ & + &2.3299e+01_r8,2.0389e+01_r8,1.7475e+01_r8,1.4563e+01_r8,1.1650e+01_r8,8.7378e+00_r8, & + &5.8256e+00_r8,2.9134e+00_r8,2.6510e-01_r8/) + kao(:, 4, 3,12) = (/ & + &2.2895e+01_r8,2.0033e+01_r8,1.7172e+01_r8,1.4310e+01_r8,1.1449e+01_r8,8.5868e+00_r8, & + &5.7250e+00_r8,2.8629e+00_r8,3.4340e-01_r8/) + kao(:, 5, 3,12) = (/ & + &2.2457e+01_r8,1.9650e+01_r8,1.6845e+01_r8,1.4036e+01_r8,1.1229e+01_r8,8.4225e+00_r8, & + &5.6152e+00_r8,2.8081e+00_r8,4.3834e-01_r8/) + kao(:, 1, 4,12) = (/ & + &5.1943e+01_r8,4.5448e+01_r8,3.8958e+01_r8,3.2464e+01_r8,2.5972e+01_r8,1.9479e+01_r8, & + &1.2986e+01_r8,6.4930e+00_r8,1.4248e-01_r8/) + kao(:, 2, 4,12) = (/ & + &5.1352e+01_r8,4.4935e+01_r8,3.8514e+01_r8,3.2094e+01_r8,2.5675e+01_r8,1.9257e+01_r8, & + &1.2838e+01_r8,6.4195e+00_r8,1.9502e-01_r8/) + kao(:, 3, 4,12) = (/ & + &5.0623e+01_r8,4.4294e+01_r8,3.7964e+01_r8,3.1639e+01_r8,2.5309e+01_r8,1.8983e+01_r8, & + &1.2655e+01_r8,6.3280e+00_r8,2.5898e-01_r8/) + kao(:, 4, 4,12) = (/ & + &4.9799e+01_r8,4.3576e+01_r8,3.7352e+01_r8,3.1124e+01_r8,2.4901e+01_r8,1.8676e+01_r8, & + &1.2451e+01_r8,6.2257e+00_r8,3.3035e-01_r8/) + kao(:, 5, 4,12) = (/ & + &4.8898e+01_r8,4.2791e+01_r8,3.6677e+01_r8,3.0566e+01_r8,2.4452e+01_r8,1.8340e+01_r8, & + &1.2226e+01_r8,6.1134e+00_r8,4.1835e-01_r8/) + kao(:, 1, 5,12) = (/ & + &1.0373e+02_r8,9.0759e+01_r8,7.7796e+01_r8,6.4826e+01_r8,5.1857e+01_r8,3.8894e+01_r8, & + &2.5931e+01_r8,1.2966e+01_r8,1.2887e-01_r8/) + kao(:, 2, 5,12) = (/ & + &1.0276e+02_r8,8.9908e+01_r8,7.7065e+01_r8,6.4222e+01_r8,5.1382e+01_r8,3.8535e+01_r8, & + &2.5690e+01_r8,1.2845e+01_r8,1.8027e-01_r8/) + kao(:, 3, 5,12) = (/ & + &1.0148e+02_r8,8.8794e+01_r8,7.6113e+01_r8,6.3420e+01_r8,5.0736e+01_r8,3.8055e+01_r8, & + &2.5371e+01_r8,1.2686e+01_r8,2.4350e-01_r8/) + kao(:, 4, 5,12) = (/ & + &9.9981e+01_r8,8.7486e+01_r8,7.4989e+01_r8,6.2492e+01_r8,4.9992e+01_r8,3.7496e+01_r8, & + &2.4996e+01_r8,1.2498e+01_r8,3.1895e-01_r8/) + kao(:, 5, 5,12) = (/ & + &9.8403e+01_r8,8.6098e+01_r8,7.3801e+01_r8,6.1498e+01_r8,4.9199e+01_r8,3.6902e+01_r8, & + &2.4598e+01_r8,1.2301e+01_r8,4.0491e-01_r8/) + kao(:, 1, 6,12) = (/ & + &1.9449e+02_r8,1.7021e+02_r8,1.4589e+02_r8,1.2157e+02_r8,9.7258e+01_r8,7.2943e+01_r8, & + &4.8628e+01_r8,2.4314e+01_r8,1.1014e-01_r8/) + kao(:, 2, 6,12) = (/ & + &1.9309e+02_r8,1.6897e+02_r8,1.4483e+02_r8,1.2070e+02_r8,9.6559e+01_r8,7.2419e+01_r8, & + &4.8279e+01_r8,2.4139e+01_r8,1.6004e-01_r8/) + kao(:, 3, 6,12) = (/ & + &1.9140e+02_r8,1.6747e+02_r8,1.4356e+02_r8,1.1963e+02_r8,9.5709e+01_r8,7.1777e+01_r8, & + &4.7853e+01_r8,2.3926e+01_r8,2.2190e-01_r8/) + kao(:, 4, 6,12) = (/ & + &1.8899e+02_r8,1.6537e+02_r8,1.4174e+02_r8,1.1810e+02_r8,9.4493e+01_r8,7.0867e+01_r8, & + &4.7246e+01_r8,2.3622e+01_r8,2.9571e-01_r8/) + kao(:, 5, 6,12) = (/ & + &1.8566e+02_r8,1.6245e+02_r8,1.3925e+02_r8,1.1603e+02_r8,9.2834e+01_r8,6.9623e+01_r8, & + &4.6415e+01_r8,2.3209e+01_r8,3.8274e-01_r8/) + kao(:, 1, 7,12) = (/ & + &3.8417e+02_r8,3.3613e+02_r8,2.8811e+02_r8,2.4009e+02_r8,1.9205e+02_r8,1.4405e+02_r8, & + &9.6037e+01_r8,4.8023e+01_r8,9.0335e-02_r8/) + kao(:, 2, 7,12) = (/ & + &3.8253e+02_r8,3.3473e+02_r8,2.8690e+02_r8,2.3908e+02_r8,1.9128e+02_r8,1.4345e+02_r8, & + &9.5632e+01_r8,4.7816e+01_r8,1.3557e-01_r8/) + kao(:, 3, 7,12) = (/ & + &3.7949e+02_r8,3.3204e+02_r8,2.8460e+02_r8,2.3719e+02_r8,1.8975e+02_r8,1.4230e+02_r8, & + &9.4872e+01_r8,4.7438e+01_r8,1.9476e-01_r8/) + kao(:, 4, 7,12) = (/ & + &3.7465e+02_r8,3.2783e+02_r8,2.8099e+02_r8,2.3416e+02_r8,1.8732e+02_r8,1.4050e+02_r8, & + &9.3670e+01_r8,4.6831e+01_r8,2.6694e-01_r8/) + kao(:, 5, 7,12) = (/ & + &3.6931e+02_r8,3.2313e+02_r8,2.7696e+02_r8,2.3080e+02_r8,1.8464e+02_r8,1.3849e+02_r8, & + &9.2317e+01_r8,4.6160e+01_r8,3.5213e-01_r8/) + kao(:, 1, 8,12) = (/ & + &9.0810e+02_r8,7.9455e+02_r8,6.8107e+02_r8,5.6755e+02_r8,4.5403e+02_r8,3.4053e+02_r8, & + &2.2701e+02_r8,1.1352e+02_r8,7.1564e-02_r8/) + kao(:, 2, 8,12) = (/ & + &9.0605e+02_r8,7.9275e+02_r8,6.7956e+02_r8,5.6628e+02_r8,4.5302e+02_r8,3.3978e+02_r8, & + &2.2652e+02_r8,1.1325e+02_r8,1.1086e-01_r8/) + kao(:, 3, 8,12) = (/ & + &9.0093e+02_r8,7.8832e+02_r8,6.7569e+02_r8,5.6306e+02_r8,4.5046e+02_r8,3.3783e+02_r8, & + &2.2521e+02_r8,1.1262e+02_r8,1.6463e-01_r8/) + kao(:, 4, 8,12) = (/ & + &8.9363e+02_r8,7.8197e+02_r8,6.7027e+02_r8,5.5850e+02_r8,4.4681e+02_r8,3.3513e+02_r8, & + &2.2342e+02_r8,1.1170e+02_r8,2.3145e-01_r8/) + kao(:, 5, 8,12) = (/ & + &8.8174e+02_r8,7.7148e+02_r8,6.6129e+02_r8,5.5110e+02_r8,4.4085e+02_r8,3.3064e+02_r8, & + &2.2045e+02_r8,1.1021e+02_r8,3.1429e-01_r8/) + kao(:, 1, 9,12) = (/ & + &4.0575e+03_r8,3.5502e+03_r8,3.0431e+03_r8,2.5358e+03_r8,2.0286e+03_r8,1.5215e+03_r8, & + &1.0143e+03_r8,5.0720e+02_r8,5.5603e-02_r8/) + kao(:, 2, 9,12) = (/ & + &4.0575e+03_r8,3.5503e+03_r8,3.0431e+03_r8,2.5359e+03_r8,2.0286e+03_r8,1.5216e+03_r8, & + &1.0143e+03_r8,5.0715e+02_r8,8.8381e-02_r8/) + kao(:, 3, 9,12) = (/ & + &4.0490e+03_r8,3.5425e+03_r8,3.0365e+03_r8,2.5303e+03_r8,2.0243e+03_r8,1.5183e+03_r8, & + &1.0122e+03_r8,5.0611e+02_r8,1.3462e-01_r8/) + kao(:, 4, 9,12) = (/ & + &4.0163e+03_r8,3.5141e+03_r8,3.0122e+03_r8,2.5100e+03_r8,2.0082e+03_r8,1.5061e+03_r8, & + &1.0041e+03_r8,5.0202e+02_r8,1.9418e-01_r8/) + kao(:, 5, 9,12) = (/ & + &3.9738e+03_r8,3.4768e+03_r8,2.9801e+03_r8,2.4835e+03_r8,1.9868e+03_r8,1.4900e+03_r8, & + &9.9338e+02_r8,4.9668e+02_r8,2.7001e-01_r8/) + kao(:, 1,10,12) = (/ & + &2.0782e+04_r8,1.8184e+04_r8,1.5586e+04_r8,1.2989e+04_r8,1.0391e+04_r8,7.7931e+03_r8, & + &5.1956e+03_r8,2.5977e+03_r8,1.5076e-02_r8/) + kao(:, 2,10,12) = (/ & + &2.0847e+04_r8,1.8242e+04_r8,1.5636e+04_r8,1.3030e+04_r8,1.0424e+04_r8,7.8180e+03_r8, & + &5.2120e+03_r8,2.6061e+03_r8,3.9283e-02_r8/) + kao(:, 3,10,12) = (/ & + &2.0776e+04_r8,1.8179e+04_r8,1.5582e+04_r8,1.2985e+04_r8,1.0387e+04_r8,7.7905e+03_r8, & + &5.1937e+03_r8,2.5968e+03_r8,5.3678e-02_r8/) + kao(:, 4,10,12) = (/ & + &2.0635e+04_r8,1.8055e+04_r8,1.5476e+04_r8,1.2897e+04_r8,1.0317e+04_r8,7.7379e+03_r8, & + &5.1584e+03_r8,2.5793e+03_r8,8.4869e-02_r8/) + kao(:, 5,10,12) = (/ & + &2.0468e+04_r8,1.7910e+04_r8,1.5352e+04_r8,1.2793e+04_r8,1.0235e+04_r8,7.6761e+03_r8, & + &5.1174e+03_r8,2.5585e+03_r8,1.7840e-01_r8/) + kao(:, 1,11,12) = (/ & + &3.8086e+04_r8,3.3327e+04_r8,2.8563e+04_r8,2.3804e+04_r8,1.9042e+04_r8,1.4282e+04_r8, & + &9.5217e+03_r8,4.7607e+03_r8,3.5535e-02_r8/) + kao(:, 2,11,12) = (/ & + &3.8167e+04_r8,3.3395e+04_r8,2.8624e+04_r8,2.3853e+04_r8,1.9083e+04_r8,1.4312e+04_r8, & + &9.5414e+03_r8,4.7707e+03_r8,2.0336e-02_r8/) + kao(:, 3,11,12) = (/ & + &3.8095e+04_r8,3.3333e+04_r8,2.8571e+04_r8,2.3809e+04_r8,1.9048e+04_r8,1.4285e+04_r8, & + &9.5235e+03_r8,4.7617e+03_r8,7.3058e-02_r8/) + kao(:, 4,11,12) = (/ & + &3.7840e+04_r8,3.3110e+04_r8,2.8380e+04_r8,2.3651e+04_r8,1.8921e+04_r8,1.4191e+04_r8, & + &9.4603e+03_r8,4.7302e+03_r8,9.2342e-02_r8/) + kao(:, 5,11,12) = (/ & + &3.7466e+04_r8,3.2782e+04_r8,2.8098e+04_r8,2.3416e+04_r8,1.8732e+04_r8,1.4049e+04_r8, & + &9.3659e+03_r8,4.6831e+03_r8,1.1387e-01_r8/) + kao(:, 1,12,12) = (/ & + &5.3068e+04_r8,4.6434e+04_r8,3.9801e+04_r8,3.3167e+04_r8,2.6533e+04_r8,1.9901e+04_r8, & + &1.3266e+04_r8,6.6334e+03_r8,5.3631e-05_r8/) + kao(:, 2,12,12) = (/ & + &5.2912e+04_r8,4.6296e+04_r8,3.9684e+04_r8,3.3067e+04_r8,2.6455e+04_r8,1.9841e+04_r8, & + &1.3228e+04_r8,6.6136e+03_r8,3.3045e-02_r8/) + kao(:, 3,12,12) = (/ & + &5.2742e+04_r8,4.6150e+04_r8,3.9556e+04_r8,3.2963e+04_r8,2.6372e+04_r8,1.9779e+04_r8, & + &1.3186e+04_r8,6.5925e+03_r8,2.4038e-02_r8/) + kao(:, 4,12,12) = (/ & + &5.2329e+04_r8,4.5788e+04_r8,3.9248e+04_r8,3.2707e+04_r8,2.6165e+04_r8,1.9623e+04_r8, & + &1.3082e+04_r8,6.5410e+03_r8,8.8033e-02_r8/) + kao(:, 5,12,12) = (/ & + &5.1702e+04_r8,4.5237e+04_r8,3.8772e+04_r8,3.2311e+04_r8,2.5848e+04_r8,1.9386e+04_r8, & + &1.2925e+04_r8,6.4623e+03_r8,1.0528e-01_r8/) + kao(:, 1,13,12) = (/ & + &5.9181e+04_r8,5.1784e+04_r8,4.4385e+04_r8,3.6986e+04_r8,2.9590e+04_r8,2.2192e+04_r8, & + &1.4795e+04_r8,7.3976e+03_r8,6.3472e-05_r8/) + kao(:, 2,13,12) = (/ & + &5.9042e+04_r8,5.1661e+04_r8,4.4282e+04_r8,3.6901e+04_r8,2.9521e+04_r8,2.2141e+04_r8, & + &1.4760e+04_r8,7.3802e+03_r8,8.2093e-03_r8/) + kao(:, 3,13,12) = (/ & + &5.8661e+04_r8,5.1328e+04_r8,4.3997e+04_r8,3.6663e+04_r8,2.9331e+04_r8,2.1998e+04_r8, & + &1.4665e+04_r8,7.3324e+03_r8,2.9843e-02_r8/) + kao(:, 4,13,12) = (/ & + &5.8145e+04_r8,5.0874e+04_r8,4.3608e+04_r8,3.6342e+04_r8,2.9072e+04_r8,2.1804e+04_r8, & + &1.4536e+04_r8,7.2678e+03_r8,5.7821e-02_r8/) + kao(:, 5,13,12) = (/ & + &5.7447e+04_r8,5.0266e+04_r8,4.3086e+04_r8,3.5905e+04_r8,2.8722e+04_r8,2.1542e+04_r8, & + &1.4361e+04_r8,7.1808e+03_r8,1.1510e-01_r8/) + kao(:, 1, 1,13) = (/ & + &9.2441e+00_r8,8.0893e+00_r8,6.9334e+00_r8,5.7782e+00_r8,4.6228e+00_r8,3.4672e+00_r8, & + &2.3119e+00_r8,1.1567e+00_r8,2.2855e-01_r8/) + kao(:, 2, 1,13) = (/ & + &8.8623e+00_r8,7.7552e+00_r8,6.6473e+00_r8,5.5397e+00_r8,4.4320e+00_r8,3.3245e+00_r8, & + &2.2168e+00_r8,1.1091e+00_r8,3.2335e-01_r8/) + kao(:, 3, 1,13) = (/ & + &8.4833e+00_r8,7.4233e+00_r8,6.3625e+00_r8,5.3026e+00_r8,4.2423e+00_r8,3.1825e+00_r8, & + &2.1219e+00_r8,1.0618e+00_r8,4.4367e-01_r8/) + kao(:, 4, 1,13) = (/ & + &8.1215e+00_r8,7.1065e+00_r8,6.0917e+00_r8,5.0761e+00_r8,4.0614e+00_r8,3.0468e+00_r8, & + &2.0316e+00_r8,1.0641e+00_r8,5.9167e-01_r8/) + kao(:, 5, 1,13) = (/ & + &7.7672e+00_r8,6.7964e+00_r8,5.8258e+00_r8,4.8545e+00_r8,3.8845e+00_r8,2.9137e+00_r8, & + &1.9430e+00_r8,1.0446e+00_r8,7.6901e-01_r8/) + kao(:, 1, 2,13) = (/ & + &1.4699e+01_r8,1.2863e+01_r8,1.1024e+01_r8,9.1876e+00_r8,7.3499e+00_r8,5.5129e+00_r8, & + &3.6758e+00_r8,1.8383e+00_r8,2.1901e-01_r8/) + kao(:, 2, 2,13) = (/ & + &1.4081e+01_r8,1.2321e+01_r8,1.0561e+01_r8,8.8012e+00_r8,7.0414e+00_r8,5.2809e+00_r8, & + &3.5211e+00_r8,1.7613e+00_r8,3.1665e-01_r8/) + kao(:, 3, 2,13) = (/ & + &1.3470e+01_r8,1.1786e+01_r8,1.0102e+01_r8,8.4178e+00_r8,6.7345e+00_r8,5.0512e+00_r8, & + &3.3678e+00_r8,1.6847e+00_r8,4.4141e-01_r8/) + kao(:, 4, 2,13) = (/ & + &1.2871e+01_r8,1.1263e+01_r8,9.6542e+00_r8,8.0452e+00_r8,6.4365e+00_r8,4.8276e+00_r8, & + &3.2187e+00_r8,1.6111e+00_r8,5.9558e-01_r8/) + kao(:, 5, 2,13) = (/ & + &1.2298e+01_r8,1.0761e+01_r8,9.2242e+00_r8,7.6869e+00_r8,6.1502e+00_r8,4.6127e+00_r8, & + &3.0756e+00_r8,1.6035e+00_r8,7.7652e-01_r8/) + kao(:, 1, 3,13) = (/ & + &3.1779e+01_r8,2.7807e+01_r8,2.3834e+01_r8,1.9863e+01_r8,1.5890e+01_r8,1.1918e+01_r8, & + &7.9454e+00_r8,3.9733e+00_r8,1.9638e-01_r8/) + kao(:, 2, 3,13) = (/ & + &3.0431e+01_r8,2.6628e+01_r8,2.2823e+01_r8,1.9020e+01_r8,1.5217e+01_r8,1.1412e+01_r8, & + &7.6086e+00_r8,3.8049e+00_r8,2.7736e-01_r8/) + kao(:, 3, 3,13) = (/ & + &2.9103e+01_r8,2.5465e+01_r8,2.1826e+01_r8,1.8188e+01_r8,1.4551e+01_r8,1.0914e+01_r8, & + &7.2766e+00_r8,3.6387e+00_r8,3.9551e-01_r8/) + kao(:, 4, 3,13) = (/ & + &2.7810e+01_r8,2.4334e+01_r8,2.0858e+01_r8,1.7381e+01_r8,1.3906e+01_r8,1.0429e+01_r8, & + &6.9532e+00_r8,3.4769e+00_r8,5.4452e-01_r8/) + kao(:, 5, 3,13) = (/ & + &2.6585e+01_r8,2.3262e+01_r8,1.9938e+01_r8,1.6616e+01_r8,1.3293e+01_r8,9.9693e+00_r8, & + &6.6465e+00_r8,3.3243e+00_r8,7.1925e-01_r8/) + kao(:, 1, 4,13) = (/ & + &7.0542e+01_r8,6.1725e+01_r8,5.2909e+01_r8,4.4087e+01_r8,3.5272e+01_r8,2.6453e+01_r8, & + &1.7635e+01_r8,8.8184e+00_r8,1.8199e-01_r8/) + kao(:, 2, 4,13) = (/ & + &6.7511e+01_r8,5.9069e+01_r8,5.0634e+01_r8,4.2192e+01_r8,3.3755e+01_r8,2.5317e+01_r8, & + &1.6878e+01_r8,8.4389e+00_r8,2.4599e-01_r8/) + kao(:, 3, 4,13) = (/ & + &6.4633e+01_r8,5.6554e+01_r8,4.8477e+01_r8,4.0397e+01_r8,3.2316e+01_r8,2.4237e+01_r8, & + &1.6158e+01_r8,8.0799e+00_r8,3.3970e-01_r8/) + kao(:, 4, 4,13) = (/ & + &6.1828e+01_r8,5.4103e+01_r8,4.6370e+01_r8,3.8643e+01_r8,3.0915e+01_r8,2.3186e+01_r8, & + &1.5458e+01_r8,7.7299e+00_r8,4.6987e-01_r8/) + kao(:, 5, 4,13) = (/ & + &5.9112e+01_r8,5.1730e+01_r8,4.4337e+01_r8,3.6946e+01_r8,2.9558e+01_r8,2.2169e+01_r8, & + &1.4779e+01_r8,7.3903e+00_r8,6.3062e-01_r8/) + kao(:, 1, 5,13) = (/ & + &1.4439e+02_r8,1.2634e+02_r8,1.0830e+02_r8,9.0248e+01_r8,7.2199e+01_r8,5.4151e+01_r8, & + &3.6099e+01_r8,1.8050e+01_r8,1.6579e-01_r8/) + kao(:, 2, 5,13) = (/ & + &1.3838e+02_r8,1.2109e+02_r8,1.0378e+02_r8,8.6480e+01_r8,6.9180e+01_r8,5.1890e+01_r8, & + &3.4593e+01_r8,1.7299e+01_r8,2.2988e-01_r8/) + kao(:, 3, 5,13) = (/ & + &1.3259e+02_r8,1.1602e+02_r8,9.9432e+01_r8,8.2860e+01_r8,6.6285e+01_r8,4.9718e+01_r8, & + &3.3146e+01_r8,1.6573e+01_r8,3.1063e-01_r8/) + kao(:, 4, 5,13) = (/ & + &1.2697e+02_r8,1.1110e+02_r8,9.5219e+01_r8,7.9357e+01_r8,6.3482e+01_r8,4.7609e+01_r8, & + &3.1740e+01_r8,1.5871e+01_r8,4.1510e-01_r8/) + kao(:, 5, 5,13) = (/ & + &1.2152e+02_r8,1.0632e+02_r8,9.1129e+01_r8,7.5942e+01_r8,6.0752e+01_r8,4.5568e+01_r8, & + &3.0378e+01_r8,1.5190e+01_r8,5.5503e-01_r8/) + kao(:, 1, 6,13) = (/ & + &2.7815e+02_r8,2.4339e+02_r8,2.0862e+02_r8,1.7384e+02_r8,1.3908e+02_r8,1.0430e+02_r8, & + &6.9541e+01_r8,3.4769e+01_r8,1.4932e-01_r8/) + kao(:, 2, 6,13) = (/ & + &2.6703e+02_r8,2.3365e+02_r8,2.0028e+02_r8,1.6690e+02_r8,1.3351e+02_r8,1.0014e+02_r8, & + &6.6764e+01_r8,3.3381e+01_r8,2.1038e-01_r8/) + kao(:, 3, 6,13) = (/ & + &2.5610e+02_r8,2.2409e+02_r8,1.9207e+02_r8,1.6007e+02_r8,1.2805e+02_r8,9.6039e+01_r8, & + &6.4025e+01_r8,3.2016e+01_r8,2.9193e-01_r8/) + kao(:, 4, 6,13) = (/ & + &2.4602e+02_r8,2.1527e+02_r8,1.8451e+02_r8,1.5376e+02_r8,1.2300e+02_r8,9.2253e+01_r8, & + &6.1503e+01_r8,3.0752e+01_r8,3.8735e-01_r8/) + kao(:, 5, 6,13) = (/ & + &2.3698e+02_r8,2.0737e+02_r8,1.7775e+02_r8,1.4811e+02_r8,1.1849e+02_r8,8.8866e+01_r8, & + &5.9248e+01_r8,2.9622e+01_r8,5.0567e-01_r8/) + kao(:, 1, 7,13) = (/ & + &5.6531e+02_r8,4.9465e+02_r8,4.2396e+02_r8,3.5331e+02_r8,2.8267e+02_r8,2.1198e+02_r8, & + &1.4132e+02_r8,7.0665e+01_r8,1.3236e-01_r8/) + kao(:, 2, 7,13) = (/ & + &5.4477e+02_r8,4.7663e+02_r8,4.0854e+02_r8,3.4045e+02_r8,2.7236e+02_r8,2.0426e+02_r8, & + &1.3618e+02_r8,6.8089e+01_r8,1.9224e-01_r8/) + kao(:, 3, 7,13) = (/ & + &5.2553e+02_r8,4.5986e+02_r8,3.9416e+02_r8,3.2848e+02_r8,2.6277e+02_r8,1.9706e+02_r8, & + &1.3138e+02_r8,6.5693e+01_r8,2.7007e-01_r8/) + kao(:, 4, 7,13) = (/ & + &5.0736e+02_r8,4.4395e+02_r8,3.8050e+02_r8,3.1709e+02_r8,2.5367e+02_r8,1.9026e+02_r8, & + &1.2684e+02_r8,6.3421e+01_r8,3.6853e-01_r8/) + kao(:, 5, 7,13) = (/ & + &4.8966e+02_r8,4.2846e+02_r8,3.6727e+02_r8,3.0605e+02_r8,2.4484e+02_r8,1.8364e+02_r8, & + &1.2242e+02_r8,6.1208e+01_r8,4.8516e-01_r8/) + kao(:, 1, 8,13) = (/ & + &1.3865e+03_r8,1.2132e+03_r8,1.0399e+03_r8,8.6656e+02_r8,6.9323e+02_r8,5.1995e+02_r8, & + &3.4663e+02_r8,1.7332e+02_r8,1.1342e-01_r8/) + kao(:, 2, 8,13) = (/ & + &1.3418e+03_r8,1.1740e+03_r8,1.0063e+03_r8,8.3858e+02_r8,6.7084e+02_r8,5.0312e+02_r8, & + &3.3544e+02_r8,1.6771e+02_r8,1.7153e-01_r8/) + kao(:, 3, 8,13) = (/ & + &1.2982e+03_r8,1.1360e+03_r8,9.7362e+02_r8,8.1138e+02_r8,6.4912e+02_r8,4.8683e+02_r8, & + &3.2456e+02_r8,1.6229e+02_r8,2.4648e-01_r8/) + kao(:, 4, 8,13) = (/ & + &1.2554e+03_r8,1.0986e+03_r8,9.4155e+02_r8,7.8470e+02_r8,6.2776e+02_r8,4.7081e+02_r8, & + &3.1388e+02_r8,1.5694e+02_r8,3.4456e-01_r8/) + kao(:, 5, 8,13) = (/ & + &1.2173e+03_r8,1.0650e+03_r8,9.1289e+02_r8,7.6069e+02_r8,6.0860e+02_r8,4.5645e+02_r8, & + &3.0428e+02_r8,1.5215e+02_r8,4.6320e-01_r8/) + kao(:, 1, 9,13) = (/ & + &6.4287e+03_r8,5.6254e+03_r8,4.8220e+03_r8,4.0184e+03_r8,3.2146e+03_r8,2.4108e+03_r8, & + &1.6072e+03_r8,8.0366e+02_r8,9.3435e-02_r8/) + kao(:, 2, 9,13) = (/ & + &6.2433e+03_r8,5.4627e+03_r8,4.6824e+03_r8,3.9018e+03_r8,3.1215e+03_r8,2.3411e+03_r8, & + &1.5608e+03_r8,7.8032e+02_r8,1.4681e-01_r8/) + kao(:, 3, 9,13) = (/ & + &6.0612e+03_r8,5.3034e+03_r8,4.5455e+03_r8,3.7883e+03_r8,3.0305e+03_r8,2.2728e+03_r8, & + &1.5153e+03_r8,7.5756e+02_r8,2.1819e-01_r8/) + kao(:, 4, 9,13) = (/ & + &5.8977e+03_r8,5.1604e+03_r8,4.4231e+03_r8,3.6861e+03_r8,2.9487e+03_r8,2.2117e+03_r8, & + &1.4744e+03_r8,7.3720e+02_r8,3.1394e-01_r8/) + kao(:, 5, 9,13) = (/ & + &5.7293e+03_r8,5.0131e+03_r8,4.2969e+03_r8,3.5807e+03_r8,2.8646e+03_r8,2.1484e+03_r8, & + &1.4323e+03_r8,7.1617e+02_r8,4.3083e-01_r8/) + kao(:, 1,10,13) = (/ & + &3.3200e+04_r8,2.9050e+04_r8,2.4899e+04_r8,2.0749e+04_r8,1.6600e+04_r8,1.2450e+04_r8, & + &8.2998e+03_r8,4.1501e+03_r8,1.3035e-02_r8/) + kao(:, 2,10,13) = (/ & + &3.2379e+04_r8,2.8331e+04_r8,2.4286e+04_r8,2.0236e+04_r8,1.6189e+04_r8,1.2142e+04_r8, & + &8.0946e+03_r8,4.0474e+03_r8,6.4014e-02_r8/) + kao(:, 3,10,13) = (/ & + &3.1566e+04_r8,2.7621e+04_r8,2.3674e+04_r8,1.9730e+04_r8,1.5784e+04_r8,1.1837e+04_r8, & + &7.8919e+03_r8,3.9461e+03_r8,1.0897e-01_r8/) + kao(:, 4,10,13) = (/ & + &3.0728e+04_r8,2.6888e+04_r8,2.3048e+04_r8,1.9205e+04_r8,1.5364e+04_r8,1.1523e+04_r8, & + &7.6820e+03_r8,3.8409e+03_r8,2.5342e-01_r8/) + kao(:, 5,10,13) = (/ & + &2.9824e+04_r8,2.6098e+04_r8,2.2369e+04_r8,1.8641e+04_r8,1.4913e+04_r8,1.1185e+04_r8, & + &7.4563e+03_r8,3.7282e+03_r8,3.9865e-01_r8/) + kao(:, 1,11,13) = (/ & + &5.8997e+04_r8,5.1626e+04_r8,4.4246e+04_r8,3.6876e+04_r8,2.9498e+04_r8,2.2124e+04_r8, & + &1.4750e+04_r8,7.3749e+03_r8,3.4853e-05_r8/) + kao(:, 2,11,13) = (/ & + &5.7601e+04_r8,5.0403e+04_r8,4.3203e+04_r8,3.6002e+04_r8,2.8802e+04_r8,2.1601e+04_r8, & + &1.4400e+04_r8,7.2004e+03_r8,3.9149e-02_r8/) + kao(:, 3,11,13) = (/ & + &5.6184e+04_r8,4.9162e+04_r8,4.2136e+04_r8,3.5117e+04_r8,2.8092e+04_r8,2.1068e+04_r8, & + &1.4046e+04_r8,7.0226e+03_r8,4.1745e-02_r8/) + kao(:, 4,11,13) = (/ & + &5.4639e+04_r8,4.7807e+04_r8,4.0979e+04_r8,3.4149e+04_r8,2.7319e+04_r8,2.0489e+04_r8, & + &1.3659e+04_r8,6.8303e+03_r8,1.4397e-01_r8/) + kao(:, 5,11,13) = (/ & + &5.3017e+04_r8,4.6389e+04_r8,3.9763e+04_r8,3.3137e+04_r8,2.6509e+04_r8,1.9881e+04_r8, & + &1.3255e+04_r8,6.6269e+03_r8,2.2772e-01_r8/) + kao(:, 1,12,13) = (/ & + &7.7971e+04_r8,6.8226e+04_r8,5.8475e+04_r8,4.8732e+04_r8,3.8985e+04_r8,2.9238e+04_r8, & + &1.9491e+04_r8,9.7458e+03_r8,2.6211e-05_r8/) + kao(:, 2,12,13) = (/ & + &7.6358e+04_r8,6.6812e+04_r8,5.7265e+04_r8,4.7721e+04_r8,3.8180e+04_r8,2.8631e+04_r8, & + &1.9088e+04_r8,9.5449e+03_r8,1.6658e-02_r8/) + kao(:, 3,12,13) = (/ & + &7.4598e+04_r8,6.5272e+04_r8,5.5949e+04_r8,4.6623e+04_r8,3.7300e+04_r8,2.7976e+04_r8, & + &1.8650e+04_r8,9.3250e+03_r8,6.1472e-02_r8/) + kao(:, 4,12,13) = (/ & + &7.2683e+04_r8,6.3600e+04_r8,5.4513e+04_r8,4.5429e+04_r8,3.6343e+04_r8,2.7256e+04_r8, & + &1.8171e+04_r8,9.0852e+03_r8,8.7020e-02_r8/) + kao(:, 5,12,13) = (/ & + &7.0749e+04_r8,6.1901e+04_r8,5.3059e+04_r8,4.4221e+04_r8,3.5375e+04_r8,2.6529e+04_r8, & + &1.7687e+04_r8,8.8438e+03_r8,2.2135e-01_r8/) + kao(:, 1,13,13) = (/ & + &8.4389e+04_r8,7.3841e+04_r8,6.3292e+04_r8,5.2741e+04_r8,4.2193e+04_r8,3.1646e+04_r8, & + &2.1097e+04_r8,1.0548e+04_r8,3.5977e-05_r8/) + kao(:, 2,13,13) = (/ & + &8.2810e+04_r8,7.2462e+04_r8,6.2107e+04_r8,5.1755e+04_r8,4.1404e+04_r8,3.1055e+04_r8, & + &2.0703e+04_r8,1.0351e+04_r8,2.8201e-02_r8/) + kao(:, 3,13,13) = (/ & + &8.1175e+04_r8,7.1028e+04_r8,6.0878e+04_r8,5.0733e+04_r8,4.0585e+04_r8,3.0440e+04_r8, & + &2.0293e+04_r8,1.0147e+04_r8,3.8140e-02_r8/) + kao(:, 4,13,13) = (/ & + &7.9409e+04_r8,6.9476e+04_r8,5.9554e+04_r8,4.9626e+04_r8,3.9700e+04_r8,2.9777e+04_r8, & + &1.9850e+04_r8,9.9254e+03_r8,1.0573e-01_r8/) + kao(:, 5,13,13) = (/ & + &7.7670e+04_r8,6.7959e+04_r8,5.8251e+04_r8,4.8545e+04_r8,3.8836e+04_r8,2.9127e+04_r8, & + &1.9417e+04_r8,9.7081e+03_r8,2.2322e-01_r8/) + kao(:, 1, 1,14) = (/ & + &1.0586e+01_r8,9.2639e+00_r8,7.9401e+00_r8,6.6170e+00_r8,5.2941e+00_r8,3.9707e+00_r8, & + &2.6478e+00_r8,1.3250e+00_r8,4.3918e-01_r8/) + kao(:, 2, 1,14) = (/ & + &1.0067e+01_r8,8.8090e+00_r8,7.5510e+00_r8,6.2924e+00_r8,5.0343e+00_r8,3.7761e+00_r8, & + &2.5179e+00_r8,1.2597e+00_r8,5.9709e-01_r8/) + kao(:, 3, 1,14) = (/ & + &9.5510e+00_r8,8.3580e+00_r8,7.1635e+00_r8,5.9699e+00_r8,4.7763e+00_r8,3.5829e+00_r8, & + &2.3891e+00_r8,1.1957e+00_r8,7.8623e-01_r8/) + kao(:, 4, 1,14) = (/ & + &9.0745e+00_r8,7.9402e+00_r8,6.8068e+00_r8,5.6724e+00_r8,4.5382e+00_r8,3.4039e+00_r8, & + &2.2698e+00_r8,1.1544e+00_r8,1.0064e+00_r8/) + kao(:, 5, 1,14) = (/ & + &8.6119e+00_r8,7.5354e+00_r8,6.4586e+00_r8,5.3823e+00_r8,4.3069e+00_r8,3.2305e+00_r8, & + &2.1544e+00_r8,1.1513e+00_r8,1.2568e+00_r8/) + kao(:, 1, 2,14) = (/ & + &1.7127e+01_r8,1.4988e+01_r8,1.2847e+01_r8,1.0706e+01_r8,8.5644e+00_r8,6.4237e+00_r8, & + &4.2830e+00_r8,2.1424e+00_r8,4.0087e-01_r8/) + kao(:, 2, 2,14) = (/ & + &1.6266e+01_r8,1.4233e+01_r8,1.2199e+01_r8,1.0167e+01_r8,8.1334e+00_r8,6.1003e+00_r8, & + &4.0675e+00_r8,2.0344e+00_r8,5.5811e-01_r8/) + kao(:, 3, 2,14) = (/ & + &1.5417e+01_r8,1.3492e+01_r8,1.1564e+01_r8,9.6364e+00_r8,7.7096e+00_r8,5.7829e+00_r8, & + &3.8557e+00_r8,1.9285e+00_r8,7.4958e-01_r8/) + kao(:, 4, 2,14) = (/ & + &1.4610e+01_r8,1.2785e+01_r8,1.0958e+01_r8,9.1323e+00_r8,7.3057e+00_r8,5.4803e+00_r8, & + &3.6538e+00_r8,1.8278e+00_r8,9.7668e-01_r8/) + kao(:, 5, 2,14) = (/ & + &1.3849e+01_r8,1.2118e+01_r8,1.0388e+01_r8,8.6567e+00_r8,6.9253e+00_r8,5.1944e+00_r8, & + &3.4637e+00_r8,1.7621e+00_r8,1.2463e+00_r8/) + kao(:, 1, 3,14) = (/ & + &3.7731e+01_r8,3.3014e+01_r8,2.8298e+01_r8,2.3584e+01_r8,1.8865e+01_r8,1.4149e+01_r8, & + &9.4337e+00_r8,4.7180e+00_r8,3.4082e-01_r8/) + kao(:, 2, 3,14) = (/ & + &3.5785e+01_r8,3.1314e+01_r8,2.6842e+01_r8,2.2368e+01_r8,1.7895e+01_r8,1.3421e+01_r8, & + &8.9480e+00_r8,4.4747e+00_r8,4.8919e-01_r8/) + kao(:, 3, 3,14) = (/ & + &3.3896e+01_r8,2.9659e+01_r8,2.5426e+01_r8,2.1185e+01_r8,1.6948e+01_r8,1.2712e+01_r8, & + &8.4759e+00_r8,4.2386e+00_r8,6.7406e-01_r8/) + kao(:, 4, 3,14) = (/ & + &3.2057e+01_r8,2.8051e+01_r8,2.4047e+01_r8,2.0037e+01_r8,1.6031e+01_r8,1.2024e+01_r8, & + &8.0158e+00_r8,4.0086e+00_r8,8.9895e-01_r8/) + kao(:, 5, 3,14) = (/ & + &3.0352e+01_r8,2.6560e+01_r8,2.2767e+01_r8,1.8972e+01_r8,1.5176e+01_r8,1.1383e+01_r8, & + &7.5899e+00_r8,3.7954e+00_r8,1.1745e+00_r8/) + kao(:, 1, 4,14) = (/ & + &8.5512e+01_r8,7.4816e+01_r8,6.4130e+01_r8,5.3439e+01_r8,4.2750e+01_r8,3.2066e+01_r8, & + &2.1376e+01_r8,1.0689e+01_r8,2.7979e-01_r8/) + kao(:, 2, 4,14) = (/ & + &8.0825e+01_r8,7.0719e+01_r8,6.0615e+01_r8,5.0514e+01_r8,4.0410e+01_r8,3.0306e+01_r8, & + &2.0206e+01_r8,1.0104e+01_r8,4.1456e-01_r8/) + kao(:, 3, 4,14) = (/ & + &7.6512e+01_r8,6.6951e+01_r8,5.7383e+01_r8,4.7821e+01_r8,3.8259e+01_r8,2.8694e+01_r8, & + &1.9130e+01_r8,9.5655e+00_r8,5.8875e-01_r8/) + kao(:, 4, 4,14) = (/ & + &7.2339e+01_r8,6.3299e+01_r8,5.4254e+01_r8,4.5213e+01_r8,3.6173e+01_r8,2.7127e+01_r8, & + &1.8087e+01_r8,9.0435e+00_r8,8.0998e-01_r8/) + kao(:, 5, 4,14) = (/ & + &6.8331e+01_r8,5.9800e+01_r8,5.1253e+01_r8,4.2714e+01_r8,3.4172e+01_r8,2.5627e+01_r8, & + &1.7086e+01_r8,8.5443e+00_r8,1.0852e+00_r8/) + kao(:, 1, 5,14) = (/ & + &1.7862e+02_r8,1.5630e+02_r8,1.3397e+02_r8,1.1164e+02_r8,8.9317e+01_r8,6.6992e+01_r8, & + &4.4659e+01_r8,2.2329e+01_r8,2.4222e-01_r8/) + kao(:, 2, 5,14) = (/ & + &1.6866e+02_r8,1.4756e+02_r8,1.2649e+02_r8,1.0541e+02_r8,8.4332e+01_r8,6.3244e+01_r8, & + &4.2162e+01_r8,2.1082e+01_r8,3.4856e-01_r8/) + kao(:, 3, 5,14) = (/ & + &1.5941e+02_r8,1.3948e+02_r8,1.1955e+02_r8,9.9631e+01_r8,7.9709e+01_r8,5.9780e+01_r8, & + &3.9852e+01_r8,1.9927e+01_r8,5.0734e-01_r8/) + kao(:, 4, 5,14) = (/ & + &1.5067e+02_r8,1.3184e+02_r8,1.1302e+02_r8,9.4183e+01_r8,7.5341e+01_r8,5.6507e+01_r8, & + &3.7674e+01_r8,1.8837e+01_r8,7.2180e-01_r8/) + kao(:, 5, 5,14) = (/ & + &1.4230e+02_r8,1.2451e+02_r8,1.0671e+02_r8,8.8935e+01_r8,7.1153e+01_r8,5.3363e+01_r8, & + &3.5577e+01_r8,1.7789e+01_r8,9.9362e-01_r8/) + kao(:, 1, 6,14) = (/ & + &3.5096e+02_r8,3.0703e+02_r8,2.6318e+02_r8,2.1933e+02_r8,1.7546e+02_r8,1.3159e+02_r8, & + &8.7733e+01_r8,4.3865e+01_r8,2.1734e-01_r8/) + kao(:, 2, 6,14) = (/ & + &3.3138e+02_r8,2.8996e+02_r8,2.4854e+02_r8,2.0711e+02_r8,1.6569e+02_r8,1.2426e+02_r8, & + &8.2845e+01_r8,4.1423e+01_r8,3.0507e-01_r8/) + kao(:, 3, 6,14) = (/ & + &3.1254e+02_r8,2.7346e+02_r8,2.3441e+02_r8,1.9532e+02_r8,1.5627e+02_r8,1.1720e+02_r8, & + &7.8130e+01_r8,3.9066e+01_r8,4.3270e-01_r8/) + kao(:, 4, 6,14) = (/ & + &2.9529e+02_r8,2.5841e+02_r8,2.2148e+02_r8,1.8456e+02_r8,1.4764e+02_r8,1.1074e+02_r8, & + &7.3826e+01_r8,3.6914e+01_r8,6.2701e-01_r8/) + kao(:, 5, 6,14) = (/ & + &2.7880e+02_r8,2.4396e+02_r8,2.0911e+02_r8,1.7424e+02_r8,1.3940e+02_r8,1.0455e+02_r8, & + &6.9706e+01_r8,3.4852e+01_r8,8.8890e-01_r8/) + kao(:, 1, 7,14) = (/ & + &7.2513e+02_r8,6.3446e+02_r8,5.4381e+02_r8,4.5320e+02_r8,3.6257e+02_r8,2.7191e+02_r8, & + &1.8128e+02_r8,9.0650e+01_r8,1.9831e-01_r8/) + kao(:, 2, 7,14) = (/ & + &6.8456e+02_r8,5.9902e+02_r8,5.1343e+02_r8,4.2785e+02_r8,3.4230e+02_r8,2.5672e+02_r8, & + &1.7115e+02_r8,8.5572e+01_r8,2.7818e-01_r8/) + kao(:, 3, 7,14) = (/ & + &6.4547e+02_r8,5.6482e+02_r8,4.8412e+02_r8,4.0342e+02_r8,3.2273e+02_r8,2.4204e+02_r8, & + &1.6137e+02_r8,8.0688e+01_r8,3.8833e-01_r8/) + kao(:, 4, 7,14) = (/ & + &6.0978e+02_r8,5.3357e+02_r8,4.5735e+02_r8,3.8114e+02_r8,3.0489e+02_r8,2.2868e+02_r8, & + &1.5246e+02_r8,7.6224e+01_r8,5.4866e-01_r8/) + kao(:, 5, 7,14) = (/ & + &5.7729e+02_r8,5.0509e+02_r8,4.3294e+02_r8,3.6078e+02_r8,2.8862e+02_r8,2.1646e+02_r8, & + &1.4432e+02_r8,7.2163e+01_r8,7.7837e-01_r8/) + kao(:, 1, 8,14) = (/ & + &1.7967e+03_r8,1.5721e+03_r8,1.3476e+03_r8,1.1230e+03_r8,8.9837e+02_r8,6.7379e+02_r8, & + &4.4917e+02_r8,2.2458e+02_r8,1.7788e-01_r8/) + kao(:, 2, 8,14) = (/ & + &1.7006e+03_r8,1.4881e+03_r8,1.2754e+03_r8,1.0629e+03_r8,8.5028e+02_r8,6.3778e+02_r8, & + &4.2515e+02_r8,2.1258e+02_r8,2.5421e-01_r8/) + kao(:, 3, 8,14) = (/ & + &1.6106e+03_r8,1.4094e+03_r8,1.2079e+03_r8,1.0068e+03_r8,8.0532e+02_r8,6.0404e+02_r8, & + &4.0268e+02_r8,2.0135e+02_r8,3.5995e-01_r8/) + kao(:, 4, 8,14) = (/ & + &1.5246e+03_r8,1.3340e+03_r8,1.1435e+03_r8,9.5278e+02_r8,7.6226e+02_r8,5.7172e+02_r8, & + &3.8114e+02_r8,1.9058e+02_r8,4.9908e-01_r8/) + kao(:, 5, 8,14) = (/ & + &1.4465e+03_r8,1.2656e+03_r8,1.0849e+03_r8,9.0407e+02_r8,7.2320e+02_r8,5.4242e+02_r8, & + &3.6158e+02_r8,1.8081e+02_r8,6.9586e-01_r8/) + kao(:, 1, 9,14) = (/ & + &8.4840e+03_r8,7.4233e+03_r8,6.3628e+03_r8,5.3023e+03_r8,4.2423e+03_r8,3.1813e+03_r8, & + &2.1210e+03_r8,1.0605e+03_r8,1.5591e-01_r8/) + kao(:, 2, 9,14) = (/ & + &8.0479e+03_r8,7.0418e+03_r8,6.0359e+03_r8,5.0301e+03_r8,4.0241e+03_r8,3.0180e+03_r8, & + &2.0121e+03_r8,1.0060e+03_r8,2.2879e-01_r8/) + kao(:, 3, 9,14) = (/ & + &7.6325e+03_r8,6.6786e+03_r8,5.7241e+03_r8,4.7707e+03_r8,3.8161e+03_r8,2.8622e+03_r8, & + &1.9081e+03_r8,9.5403e+02_r8,3.3113e-01_r8/) + kao(:, 4, 9,14) = (/ & + &7.2431e+03_r8,6.3376e+03_r8,5.4325e+03_r8,4.5268e+03_r8,3.6217e+03_r8,2.7162e+03_r8, & + &1.8109e+03_r8,9.0539e+02_r8,4.6545e-01_r8/) + kao(:, 5, 9,14) = (/ & + &6.8956e+03_r8,6.0340e+03_r8,5.1720e+03_r8,4.3099e+03_r8,3.4482e+03_r8,2.5859e+03_r8, & + &1.7240e+03_r8,8.6204e+02_r8,6.4091e-01_r8/) + kao(:, 1,10,14) = (/ & + &4.4703e+04_r8,3.9114e+04_r8,3.3523e+04_r8,2.7938e+04_r8,2.2351e+04_r8,1.6764e+04_r8, & + &1.1175e+04_r8,5.5874e+03_r8,4.1455e-02_r8/) + kao(:, 2,10,14) = (/ & + &4.2474e+04_r8,3.7167e+04_r8,3.1854e+04_r8,2.6544e+04_r8,2.1238e+04_r8,1.5927e+04_r8, & + &1.0619e+04_r8,5.3089e+03_r8,6.6750e-02_r8/) + kao(:, 3,10,14) = (/ & + &4.0460e+04_r8,3.5405e+04_r8,3.0347e+04_r8,2.5289e+04_r8,2.0232e+04_r8,1.5174e+04_r8, & + &1.0116e+04_r8,5.0578e+03_r8,2.7442e-01_r8/) + kao(:, 4,10,14) = (/ & + &3.8625e+04_r8,3.3797e+04_r8,2.8970e+04_r8,2.4141e+04_r8,1.9313e+04_r8,1.4484e+04_r8, & + &9.6562e+03_r8,4.8282e+03_r8,4.4714e-01_r8/) + kao(:, 5,10,14) = (/ & + &3.6998e+04_r8,3.2375e+04_r8,2.7750e+04_r8,2.3124e+04_r8,1.8498e+04_r8,1.3874e+04_r8, & + &9.2495e+03_r8,4.6247e+03_r8,6.1795e-01_r8/) + kao(:, 1,11,14) = (/ & + &8.0689e+04_r8,7.0605e+04_r8,6.0514e+04_r8,5.0431e+04_r8,4.0345e+04_r8,3.0258e+04_r8, & + &2.0175e+04_r8,1.0088e+04_r8,2.7556e-05_r8/) + kao(:, 2,11,14) = (/ & + &7.7103e+04_r8,6.7463e+04_r8,5.7832e+04_r8,4.8186e+04_r8,3.8550e+04_r8,2.8913e+04_r8, & + &1.9275e+04_r8,9.6376e+03_r8,4.0930e-02_r8/) + kao(:, 3,11,14) = (/ & + &7.3820e+04_r8,6.4596e+04_r8,5.5369e+04_r8,4.6139e+04_r8,3.6913e+04_r8,2.7687e+04_r8, & + &1.8457e+04_r8,9.2272e+03_r8,8.1894e-02_r8/) + kao(:, 4,11,14) = (/ & + &7.1047e+04_r8,6.2162e+04_r8,5.3281e+04_r8,4.4402e+04_r8,3.5522e+04_r8,2.6643e+04_r8, & + &1.7761e+04_r8,8.8802e+03_r8,2.3203e-01_r8/) + kao(:, 5,11,14) = (/ & + &6.8729e+04_r8,6.0139e+04_r8,5.1549e+04_r8,4.2956e+04_r8,3.4366e+04_r8,2.5774e+04_r8, & + &1.7184e+04_r8,8.5912e+03_r8,5.4821e-01_r8/) + kao(:, 1,12,14) = (/ & + &1.0931e+05_r8,9.5652e+04_r8,8.1990e+04_r8,6.8319e+04_r8,5.4655e+04_r8,4.0991e+04_r8, & + &2.7328e+04_r8,1.3665e+04_r8,2.8846e-05_r8/) + kao(:, 2,12,14) = (/ & + &1.0521e+05_r8,9.2062e+04_r8,7.8903e+04_r8,6.5759e+04_r8,5.2606e+04_r8,3.9453e+04_r8, & + &2.6301e+04_r8,1.3151e+04_r8,4.7358e-02_r8/) + kao(:, 3,12,14) = (/ & + &1.0163e+05_r8,8.8927e+04_r8,7.6219e+04_r8,6.3520e+04_r8,5.0816e+04_r8,3.8110e+04_r8, & + &2.5405e+04_r8,1.2704e+04_r8,2.4382e-02_r8/) + kao(:, 4,12,14) = (/ & + &9.8710e+04_r8,8.6365e+04_r8,7.4034e+04_r8,6.1691e+04_r8,4.9353e+04_r8,3.7016e+04_r8, & + &2.4677e+04_r8,1.2338e+04_r8,1.4381e-01_r8/) + kao(:, 5,12,14) = (/ & + &9.6361e+04_r8,8.4318e+04_r8,7.2271e+04_r8,6.0231e+04_r8,4.8183e+04_r8,3.6135e+04_r8, & + &2.4090e+04_r8,1.2044e+04_r8,3.4843e-01_r8/) + kao(:, 1,13,14) = (/ & + &1.2026e+05_r8,1.0522e+05_r8,9.0197e+04_r8,7.5158e+04_r8,6.0121e+04_r8,4.5095e+04_r8, & + &3.0062e+04_r8,1.5030e+04_r8,2.3562e-05_r8/) + kao(:, 2,13,14) = (/ & + &1.1659e+05_r8,1.0201e+05_r8,8.7436e+04_r8,7.2864e+04_r8,5.8293e+04_r8,4.3717e+04_r8, & + &2.9144e+04_r8,1.4573e+04_r8,1.6351e-02_r8/) + kao(:, 3,13,14) = (/ & + &1.1367e+05_r8,9.9464e+04_r8,8.5255e+04_r8,7.1046e+04_r8,5.6835e+04_r8,4.2627e+04_r8, & + &2.8420e+04_r8,1.4209e+04_r8,2.9522e-02_r8/) + kao(:, 4,13,14) = (/ & + &1.1129e+05_r8,9.7380e+04_r8,8.3472e+04_r8,6.9552e+04_r8,5.5648e+04_r8,4.1732e+04_r8, & + &2.7823e+04_r8,1.3911e+04_r8,7.5810e-02_r8/) + kao(:, 5,13,14) = (/ & + &1.0918e+05_r8,9.5534e+04_r8,8.1880e+04_r8,6.8241e+04_r8,5.4595e+04_r8,4.0946e+04_r8, & + &2.7297e+04_r8,1.3648e+04_r8,2.4333e-01_r8/) + kao(:, 1, 1,15) = (/ & + &1.0978e+01_r8,9.6088e+00_r8,8.2350e+00_r8,6.8632e+00_r8,5.4910e+00_r8,4.1182e+00_r8, & + &2.7459e+00_r8,1.3741e+00_r8,7.5097e-01_r8/) + kao(:, 2, 1,15) = (/ & + &1.0420e+01_r8,9.1192e+00_r8,7.8159e+00_r8,6.5136e+00_r8,5.2114e+00_r8,3.9092e+00_r8, & + &2.6067e+00_r8,1.3044e+00_r8,1.0341e+00_r8/) + kao(:, 3, 1,15) = (/ & + &9.8688e+00_r8,8.6360e+00_r8,7.4026e+00_r8,6.1689e+00_r8,4.9358e+00_r8,3.7018e+00_r8, & + &2.4689e+00_r8,1.2355e+00_r8,1.3726e+00_r8/) + kao(:, 4, 1,15) = (/ & + &9.3623e+00_r8,8.1910e+00_r8,7.0229e+00_r8,5.8526e+00_r8,4.6825e+00_r8,3.5124e+00_r8, & + &2.3423e+00_r8,1.1838e+00_r8,1.7645e+00_r8/) + kao(:, 5, 1,15) = (/ & + &8.8716e+00_r8,7.7621e+00_r8,6.6540e+00_r8,5.5450e+00_r8,4.4367e+00_r8,3.3283e+00_r8, & + &2.2197e+00_r8,1.4532e+00_r8,2.2082e+00_r8/) + kao(:, 1, 2,15) = (/ & + &1.7872e+01_r8,1.5635e+01_r8,1.3402e+01_r8,1.1169e+01_r8,8.9360e+00_r8,6.7019e+00_r8, & + &4.4692e+00_r8,2.2349e+00_r8,7.8713e-01_r8/) + kao(:, 2, 2,15) = (/ & + &1.6936e+01_r8,1.4818e+01_r8,1.2703e+01_r8,1.0586e+01_r8,8.4684e+00_r8,6.3517e+00_r8, & + &4.2352e+00_r8,2.1186e+00_r8,1.1015e+00_r8/) + kao(:, 3, 2,15) = (/ & + &1.6019e+01_r8,1.4019e+01_r8,1.2014e+01_r8,1.0011e+01_r8,8.0107e+00_r8,6.0080e+00_r8, & + &4.0069e+00_r8,2.0039e+00_r8,1.4812e+00_r8/) + kao(:, 4, 2,15) = (/ & + &1.5152e+01_r8,1.3257e+01_r8,1.1364e+01_r8,9.4698e+00_r8,7.5770e+00_r8,5.6829e+00_r8, & + &3.7895e+00_r8,1.8958e+00_r8,1.9253e+00_r8/) + kao(:, 5, 2,15) = (/ & + &1.4341e+01_r8,1.2547e+01_r8,1.0755e+01_r8,8.9625e+00_r8,7.1702e+00_r8,5.3783e+00_r8, & + &3.5866e+00_r8,1.8251e+00_r8,2.4314e+00_r8/) + kao(:, 1, 3,15) = (/ & + &3.9644e+01_r8,3.4688e+01_r8,2.9736e+01_r8,2.4782e+01_r8,1.9827e+01_r8,1.4870e+01_r8, & + &9.9132e+00_r8,4.9569e+00_r8,7.5098e-01_r8/) + kao(:, 2, 3,15) = (/ & + &3.7522e+01_r8,3.2831e+01_r8,2.8147e+01_r8,2.3453e+01_r8,1.8762e+01_r8,1.4073e+01_r8, & + &9.3827e+00_r8,4.6920e+00_r8,1.0782e+00_r8/) + kao(:, 3, 3,15) = (/ & + &3.5460e+01_r8,3.1027e+01_r8,2.6599e+01_r8,2.2162e+01_r8,1.7731e+01_r8,1.3300e+01_r8, & + &8.8666e+00_r8,4.4344e+00_r8,1.4809e+00_r8/) + kao(:, 4, 3,15) = (/ & + &3.3460e+01_r8,2.9273e+01_r8,2.5092e+01_r8,2.0911e+01_r8,1.6733e+01_r8,1.2547e+01_r8, & + &8.3663e+00_r8,4.1837e+00_r8,1.9598e+00_r8/) + kao(:, 5, 3,15) = (/ & + &3.1621e+01_r8,2.7670e+01_r8,2.3718e+01_r8,1.9764e+01_r8,1.5811e+01_r8,1.1859e+01_r8, & + &7.9074e+00_r8,3.9548e+00_r8,2.5132e+00_r8/) + kao(:, 1, 4,15) = (/ & + &9.0592e+01_r8,7.9274e+01_r8,6.7952e+01_r8,5.6623e+01_r8,4.5292e+01_r8,3.3974e+01_r8, & + &2.2650e+01_r8,1.1327e+01_r8,6.7358e-01_r8/) + kao(:, 2, 4,15) = (/ & + &8.5357e+01_r8,7.4682e+01_r8,6.4009e+01_r8,5.3347e+01_r8,4.2676e+01_r8,3.2015e+01_r8, & + &2.1340e+01_r8,1.0671e+01_r8,9.9693e-01_r8/) + kao(:, 3, 4,15) = (/ & + &8.0608e+01_r8,7.0531e+01_r8,6.0449e+01_r8,5.0384e+01_r8,4.0308e+01_r8,3.0230e+01_r8, & + &2.0154e+01_r8,1.0079e+01_r8,1.4044e+00_r8/) + kao(:, 4, 4,15) = (/ & + &7.6021e+01_r8,6.6519e+01_r8,5.7017e+01_r8,4.7513e+01_r8,3.8009e+01_r8,2.8510e+01_r8, & + &1.9006e+01_r8,9.5047e+00_r8,1.8983e+00_r8/) + kao(:, 5, 4,15) = (/ & + &7.1646e+01_r8,6.2695e+01_r8,5.3735e+01_r8,4.4783e+01_r8,3.5822e+01_r8,2.6870e+01_r8, & + &1.7917e+01_r8,8.9586e+00_r8,2.4776e+00_r8/) + kao(:, 1, 5,15) = (/ & + &1.9065e+02_r8,1.6683e+02_r8,1.4299e+02_r8,1.1917e+02_r8,9.5320e+01_r8,7.1489e+01_r8, & + &4.7665e+01_r8,2.3834e+01_r8,5.8170e-01_r8/) + kao(:, 2, 5,15) = (/ & + &1.7924e+02_r8,1.5681e+02_r8,1.3443e+02_r8,1.1201e+02_r8,8.9613e+01_r8,6.7209e+01_r8, & + &4.4814e+01_r8,2.2406e+01_r8,8.9003e-01_r8/) + kao(:, 3, 5,15) = (/ & + &1.6878e+02_r8,1.4769e+02_r8,1.2660e+02_r8,1.0549e+02_r8,8.4396e+01_r8,6.3295e+01_r8, & + &4.2198e+01_r8,2.1098e+01_r8,1.2889e+00_r8/) + kao(:, 4, 5,15) = (/ & + &1.5901e+02_r8,1.3914e+02_r8,1.1927e+02_r8,9.9403e+01_r8,7.9524e+01_r8,5.9641e+01_r8, & + &3.9759e+01_r8,1.9881e+01_r8,1.7818e+00_r8/) + kao(:, 5, 5,15) = (/ & + &1.4967e+02_r8,1.3098e+02_r8,1.1227e+02_r8,9.3560e+01_r8,7.4846e+01_r8,5.6123e+01_r8, & + &3.7423e+01_r8,1.8714e+01_r8,2.3703e+00_r8/) + kao(:, 1, 6,15) = (/ & + &3.7689e+02_r8,3.2969e+02_r8,2.8264e+02_r8,2.3553e+02_r8,1.8841e+02_r8,1.4134e+02_r8, & + &9.4214e+01_r8,4.7104e+01_r8,4.7634e-01_r8/) + kao(:, 2, 6,15) = (/ & + &3.5386e+02_r8,3.0960e+02_r8,2.6540e+02_r8,2.2119e+02_r8,1.7694e+02_r8,1.3270e+02_r8, & + &8.8456e+01_r8,4.4232e+01_r8,7.5759e-01_r8/) + kao(:, 3, 6,15) = (/ & + &3.3202e+02_r8,2.9052e+02_r8,2.4901e+02_r8,2.0752e+02_r8,1.6601e+02_r8,1.2451e+02_r8, & + &8.3003e+01_r8,4.1506e+01_r8,1.1321e+00_r8/) + kao(:, 4, 6,15) = (/ & + &3.1280e+02_r8,2.7368e+02_r8,2.3460e+02_r8,1.9550e+02_r8,1.5640e+02_r8,1.1729e+02_r8, & + &7.8200e+01_r8,3.9102e+01_r8,1.6067e+00_r8/) + kao(:, 5, 6,15) = (/ & + &2.9457e+02_r8,2.5772e+02_r8,2.2093e+02_r8,1.8412e+02_r8,1.4729e+02_r8,1.1048e+02_r8, & + &7.3641e+01_r8,3.6825e+01_r8,2.1838e+00_r8/) + kao(:, 1, 7,15) = (/ & + &7.8539e+02_r8,6.8719e+02_r8,5.8900e+02_r8,4.9081e+02_r8,3.9268e+02_r8,2.9449e+02_r8, & + &1.9633e+02_r8,9.8167e+01_r8,3.8693e-01_r8/) + kao(:, 2, 7,15) = (/ & + &7.3697e+02_r8,6.4481e+02_r8,5.5276e+02_r8,4.6063e+02_r8,3.6848e+02_r8,2.7636e+02_r8, & + &1.8426e+02_r8,9.2135e+01_r8,6.2265e-01_r8/) + kao(:, 3, 7,15) = (/ & + &6.9166e+02_r8,6.0516e+02_r8,5.1875e+02_r8,4.3231e+02_r8,3.4580e+02_r8,2.5935e+02_r8, & + &1.7293e+02_r8,8.6458e+01_r8,9.6225e-01_r8/) + kao(:, 4, 7,15) = (/ & + &6.5012e+02_r8,5.6880e+02_r8,4.8758e+02_r8,4.0634e+02_r8,3.2506e+02_r8,2.4380e+02_r8, & + &1.6251e+02_r8,8.1260e+01_r8,1.4063e+00_r8/) + kao(:, 5, 7,15) = (/ & + &6.1251e+02_r8,5.3595e+02_r8,4.5937e+02_r8,3.8280e+02_r8,3.0627e+02_r8,2.2970e+02_r8, & + &1.5314e+02_r8,7.6572e+01_r8,1.9665e+00_r8/) + kao(:, 1, 8,15) = (/ & + &1.9678e+03_r8,1.7217e+03_r8,1.4759e+03_r8,1.2298e+03_r8,9.8389e+02_r8,7.3793e+02_r8, & + &4.9200e+02_r8,2.4597e+02_r8,3.3326e-01_r8/) + kao(:, 2, 8,15) = (/ & + &1.8454e+03_r8,1.6147e+03_r8,1.3840e+03_r8,1.1533e+03_r8,9.2274e+02_r8,6.9199e+02_r8, & + &4.6133e+02_r8,2.3066e+02_r8,5.2281e-01_r8/) + kao(:, 3, 8,15) = (/ & + &1.7316e+03_r8,1.5151e+03_r8,1.2986e+03_r8,1.0821e+03_r8,8.6576e+02_r8,6.4926e+02_r8, & + &4.3287e+02_r8,2.1643e+02_r8,8.0537e-01_r8/) + kao(:, 4, 8,15) = (/ & + &1.6274e+03_r8,1.4239e+03_r8,1.2204e+03_r8,1.0169e+03_r8,8.1360e+02_r8,6.1025e+02_r8, & + &4.0681e+02_r8,2.0342e+02_r8,1.2167e+00_r8/) + kao(:, 5, 8,15) = (/ & + &1.5364e+03_r8,1.3443e+03_r8,1.1523e+03_r8,9.6013e+02_r8,7.6820e+02_r8,5.7614e+02_r8, & + &3.8407e+02_r8,1.9205e+02_r8,1.7524e+00_r8/) + kao(:, 1, 9,15) = (/ & + &9.3073e+03_r8,8.1544e+03_r8,6.9894e+03_r8,5.8248e+03_r8,4.6604e+03_r8,3.4950e+03_r8, & + &2.3299e+03_r8,1.1651e+03_r8,2.9954e-01_r8/) + kao(:, 2, 9,15) = (/ & + &8.7551e+03_r8,7.6608e+03_r8,6.5662e+03_r8,5.4720e+03_r8,4.3776e+03_r8,3.2831e+03_r8, & + &2.1886e+03_r8,1.0944e+03_r8,4.5642e-01_r8/) + kao(:, 3, 9,15) = (/ & + &8.2482e+03_r8,7.2167e+03_r8,6.1860e+03_r8,5.1552e+03_r8,4.1239e+03_r8,3.0929e+03_r8, & + &2.0618e+03_r8,1.0309e+03_r8,6.9066e-01_r8/) + kao(:, 4, 9,15) = (/ & + &7.8082e+03_r8,6.8324e+03_r8,5.8568e+03_r8,4.8805e+03_r8,3.9039e+03_r8,2.9280e+03_r8, & + &1.9520e+03_r8,9.7612e+02_r8,1.0400e+00_r8/) + kao(:, 5, 9,15) = (/ & + &7.4317e+03_r8,6.5021e+03_r8,5.5734e+03_r8,4.6446e+03_r8,3.7157e+03_r8,2.7869e+03_r8, & + &1.8578e+03_r8,9.2892e+02_r8,1.5452e+00_r8/) + kao(:, 1,10,15) = (/ & + &4.9432e+04_r8,4.3258e+04_r8,3.7074e+04_r8,3.0897e+04_r8,2.4721e+04_r8,1.8537e+04_r8, & + &1.2358e+04_r8,6.1790e+03_r8,1.8223e-01_r8/) + kao(:, 2,10,15) = (/ & + &4.6742e+04_r8,4.0903e+04_r8,3.5058e+04_r8,2.9212e+04_r8,2.3371e+04_r8,1.7528e+04_r8, & + &1.1686e+04_r8,5.8428e+03_r8,4.2300e-01_r8/) + kao(:, 3,10,15) = (/ & + &4.4467e+04_r8,3.8905e+04_r8,3.3347e+04_r8,2.7787e+04_r8,2.2232e+04_r8,1.6675e+04_r8, & + &1.1116e+04_r8,5.5580e+03_r8,6.2837e-01_r8/) + kao(:, 4,10,15) = (/ & + &4.2571e+04_r8,3.7248e+04_r8,3.1929e+04_r8,2.6604e+04_r8,2.1284e+04_r8,1.5965e+04_r8, & + &1.0643e+04_r8,5.3212e+03_r8,9.2886e-01_r8/) + kao(:, 5,10,15) = (/ & + &4.1045e+04_r8,3.5912e+04_r8,3.0783e+04_r8,2.5652e+04_r8,2.0522e+04_r8,1.5392e+04_r8, & + &1.0261e+04_r8,5.1304e+03_r8,1.3856e+00_r8/) + kao(:, 1,11,15) = (/ & + &9.0769e+04_r8,7.9427e+04_r8,6.8076e+04_r8,5.6731e+04_r8,4.5387e+04_r8,3.4039e+04_r8, & + &2.2692e+04_r8,1.1348e+04_r8,6.3351e-06_r8/) + kao(:, 2,11,15) = (/ & + &8.7118e+04_r8,7.6228e+04_r8,6.5339e+04_r8,5.4453e+04_r8,4.3558e+04_r8,3.2668e+04_r8, & + &2.1780e+04_r8,1.0890e+04_r8,1.2897e-01_r8/) + kao(:, 3,11,15) = (/ & + &8.4111e+04_r8,7.3597e+04_r8,6.3086e+04_r8,5.2568e+04_r8,4.2058e+04_r8,3.1544e+04_r8, & + &2.1027e+04_r8,1.0514e+04_r8,3.6063e-01_r8/) + kao(:, 4,11,15) = (/ & + &8.1812e+04_r8,7.1584e+04_r8,6.1356e+04_r8,5.1132e+04_r8,4.0904e+04_r8,3.0678e+04_r8, & + &2.0453e+04_r8,1.0225e+04_r8,8.1674e-01_r8/) + kao(:, 5,11,15) = (/ & + &7.9895e+04_r8,6.9910e+04_r8,5.9923e+04_r8,4.9935e+04_r8,3.9950e+04_r8,2.9961e+04_r8, & + &1.9975e+04_r8,9.9870e+03_r8,1.4894e+00_r8/) + kao(:, 1,12,15) = (/ & + &1.2814e+05_r8,1.1213e+05_r8,9.6104e+04_r8,8.0085e+04_r8,6.4069e+04_r8,4.8051e+04_r8, & + &3.2036e+04_r8,1.6017e+04_r8,4.6990e-06_r8/) + kao(:, 2,12,15) = (/ & + &1.2486e+05_r8,1.0925e+05_r8,9.3637e+04_r8,7.8034e+04_r8,6.2430e+04_r8,4.6820e+04_r8, & + &3.1210e+04_r8,1.5606e+04_r8,1.4051e-05_r8/) + kao(:, 3,12,15) = (/ & + &1.2228e+05_r8,1.0700e+05_r8,9.1710e+04_r8,7.6429e+04_r8,6.1136e+04_r8,4.5856e+04_r8, & + &3.0569e+04_r8,1.5285e+04_r8,1.5080e-01_r8/) + kao(:, 4,12,15) = (/ & + &1.2022e+05_r8,1.0520e+05_r8,9.0163e+04_r8,7.5135e+04_r8,6.0115e+04_r8,4.5084e+04_r8, & + &3.0055e+04_r8,1.5027e+04_r8,4.4115e-01_r8/) + kao(:, 5,12,15) = (/ & + &1.1876e+05_r8,1.0392e+05_r8,8.9071e+04_r8,7.4229e+04_r8,5.9383e+04_r8,4.4534e+04_r8, & + &2.9691e+04_r8,1.4845e+04_r8,1.2230e+00_r8/) + kao(:, 1,13,15) = (/ & + &1.4959e+05_r8,1.3089e+05_r8,1.1219e+05_r8,9.3492e+04_r8,7.4791e+04_r8,5.6100e+04_r8, & + &3.7396e+04_r8,1.8698e+04_r8,1.6068e-05_r8/) + kao(:, 2,13,15) = (/ & + &1.4739e+05_r8,1.2897e+05_r8,1.1053e+05_r8,9.2121e+04_r8,7.3693e+04_r8,5.5270e+04_r8, & + &3.6845e+04_r8,1.8424e+04_r8,2.4216e-05_r8/) + kao(:, 3,13,15) = (/ & + &1.4569e+05_r8,1.2748e+05_r8,1.0927e+05_r8,9.1057e+04_r8,7.2849e+04_r8,5.4630e+04_r8, & + &3.6423e+04_r8,1.8211e+04_r8,2.3267e-01_r8/) + kao(:, 4,13,15) = (/ & + &1.4449e+05_r8,1.2643e+05_r8,1.0837e+05_r8,9.0297e+04_r8,7.2240e+04_r8,5.4184e+04_r8, & + &3.6121e+04_r8,1.8059e+04_r8,3.2297e-01_r8/) + kao(:, 5,13,15) = (/ & + &1.4334e+05_r8,1.2542e+05_r8,1.0750e+05_r8,8.9583e+04_r8,7.1673e+04_r8,5.3754e+04_r8, & + &3.5834e+04_r8,1.7916e+04_r8,9.5703e-01_r8/) + kao(:, 1, 1,16) = (/ & + &1.1012e+01_r8,9.6385e+00_r8,8.2597e+00_r8,6.8841e+00_r8,5.5077e+00_r8,4.1310e+00_r8, & + &2.7545e+00_r8,1.3780e+00_r8,8.0170e-01_r8/) + kao(:, 2, 1,16) = (/ & + &1.0449e+01_r8,9.1438e+00_r8,7.8382e+00_r8,6.5335e+00_r8,5.2262e+00_r8,3.9202e+00_r8, & + &2.6149e+00_r8,1.3083e+00_r8,1.1089e+00_r8/) + kao(:, 3, 1,16) = (/ & + &9.8963e+00_r8,8.6604e+00_r8,7.4233e+00_r8,6.1853e+00_r8,4.9489e+00_r8,3.7122e+00_r8, & + &2.4757e+00_r8,1.2390e+00_r8,1.4762e+00_r8/) + kao(:, 4, 1,16) = (/ & + &9.3879e+00_r8,8.2127e+00_r8,7.0407e+00_r8,5.8670e+00_r8,4.6947e+00_r8,3.5210e+00_r8, & + &2.3483e+00_r8,1.2086e+00_r8,1.9022e+00_r8/) + kao(:, 5, 1,16) = (/ & + &8.8935e+00_r8,7.7813e+00_r8,6.6705e+00_r8,5.5589e+00_r8,4.4480e+00_r8,3.3366e+00_r8, & + &2.2250e+00_r8,1.5141e+00_r8,2.3892e+00_r8/) + kao(:, 1, 2,16) = (/ & + &1.7937e+01_r8,1.5695e+01_r8,1.3452e+01_r8,1.1211e+01_r8,8.9664e+00_r8,6.7267e+00_r8, & + &4.4861e+00_r8,2.2435e+00_r8,8.6848e-01_r8/) + kao(:, 2, 2,16) = (/ & + &1.6997e+01_r8,1.4871e+01_r8,1.2749e+01_r8,1.0624e+01_r8,8.4984e+00_r8,6.3745e+00_r8, & + &4.2497e+00_r8,2.1262e+00_r8,1.2205e+00_r8/) + kao(:, 3, 2,16) = (/ & + &1.6073e+01_r8,1.4067e+01_r8,1.2054e+01_r8,1.0046e+01_r8,8.0383e+00_r8,6.0294e+00_r8, & + &4.0202e+00_r8,2.0108e+00_r8,1.6477e+00_r8/) + kao(:, 4, 2,16) = (/ & + &1.5204e+01_r8,1.3304e+01_r8,1.1402e+01_r8,9.4999e+00_r8,7.6031e+00_r8,5.7017e+00_r8, & + &3.8022e+00_r8,1.9021e+00_r8,2.1539e+00_r8/) + kao(:, 5, 2,16) = (/ & + &1.4385e+01_r8,1.2589e+01_r8,1.0791e+01_r8,8.9907e+00_r8,7.1928e+00_r8,5.3962e+00_r8, & + &3.5994e+00_r8,1.9006e+00_r8,2.7317e+00_r8/) + kao(:, 1, 3,16) = (/ & + &3.9826e+01_r8,3.4837e+01_r8,2.9874e+01_r8,2.4893e+01_r8,1.9916e+01_r8,1.4937e+01_r8, & + &9.9605e+00_r8,4.9801e+00_r8,8.6605e-01_r8/) + kao(:, 2, 3,16) = (/ & + &3.7687e+01_r8,3.2981e+01_r8,2.8272e+01_r8,2.3555e+01_r8,1.8843e+01_r8,1.4136e+01_r8, & + &9.4254e+00_r8,4.7126e+00_r8,1.2506e+00_r8/) + kao(:, 3, 3,16) = (/ & + &3.5608e+01_r8,3.1162e+01_r8,2.6711e+01_r8,2.2256e+01_r8,1.7812e+01_r8,1.3358e+01_r8, & + &8.9032e+00_r8,4.4535e+00_r8,1.7305e+00_r8/) + kao(:, 4, 3,16) = (/ & + &3.3599e+01_r8,2.9402e+01_r8,2.5206e+01_r8,2.1000e+01_r8,1.6804e+01_r8,1.2601e+01_r8, & + &8.4019e+00_r8,4.2020e+00_r8,2.3040e+00_r8/) + kao(:, 5, 3,16) = (/ & + &3.1757e+01_r8,2.7783e+01_r8,2.3809e+01_r8,1.9848e+01_r8,1.5875e+01_r8,1.1908e+01_r8, & + &7.9407e+00_r8,3.9713e+00_r8,2.9736e+00_r8/) + kao(:, 1, 4,16) = (/ & + &9.1010e+01_r8,7.9617e+01_r8,6.8261e+01_r8,5.6883e+01_r8,4.5501e+01_r8,3.4135e+01_r8, & + &2.2756e+01_r8,1.1381e+01_r8,8.2098e-01_r8/) + kao(:, 2, 4,16) = (/ & + &8.5710e+01_r8,7.5003e+01_r8,6.4275e+01_r8,5.3587e+01_r8,4.2849e+01_r8,3.2139e+01_r8, & + &2.1425e+01_r8,1.0717e+01_r8,1.2260e+00_r8/) + kao(:, 3, 4,16) = (/ & + &8.0903e+01_r8,7.0806e+01_r8,6.0673e+01_r8,5.0561e+01_r8,4.0455e+01_r8,3.0343e+01_r8, & + &2.0221e+01_r8,1.0019e+01_r8,1.7427e+00_r8/) + kao(:, 4, 4,16) = (/ & + &7.6250e+01_r8,6.6729e+01_r8,5.7190e+01_r8,4.7658e+01_r8,3.8119e+01_r8,2.8596e+01_r8, & + &1.9064e+01_r8,9.5357e+00_r8,2.3756e+00_r8/) + kao(:, 5, 4,16) = (/ & + &7.1845e+01_r8,6.2892e+01_r8,5.3881e+01_r8,4.4904e+01_r8,3.5931e+01_r8,2.6946e+01_r8, & + &1.7968e+01_r8,8.9829e+00_r8,3.1270e+00_r8/) + kao(:, 1, 5,16) = (/ & + &1.9171e+02_r8,1.6775e+02_r8,1.4380e+02_r8,1.1981e+02_r8,9.5875e+01_r8,7.1871e+01_r8, & + &4.7928e+01_r8,2.3964e+01_r8,7.5940e-01_r8/) + kao(:, 2, 5,16) = (/ & + &1.8016e+02_r8,1.5760e+02_r8,1.3509e+02_r8,1.1260e+02_r8,9.0071e+01_r8,6.7551e+01_r8, & + &4.5046e+01_r8,2.2517e+01_r8,1.1757e+00_r8/) + kao(:, 3, 5,16) = (/ & + &1.6962e+02_r8,1.4839e+02_r8,1.2718e+02_r8,1.0601e+02_r8,8.4813e+01_r8,6.3608e+01_r8, & + &4.2403e+01_r8,2.1198e+01_r8,1.7223e+00_r8/) + kao(:, 4, 5,16) = (/ & + &1.5982e+02_r8,1.3980e+02_r8,1.1984e+02_r8,9.9881e+01_r8,7.9889e+01_r8,5.9924e+01_r8, & + &3.9950e+01_r8,1.9975e+01_r8,2.4076e+00_r8/) + kao(:, 5, 5,16) = (/ & + &1.5041e+02_r8,1.3158e+02_r8,1.1281e+02_r8,9.3993e+01_r8,7.5196e+01_r8,5.6401e+01_r8, & + &3.7598e+01_r8,1.8805e+01_r8,3.2368e+00_r8/) + kao(:, 1, 6,16) = (/ & + &3.8096e+02_r8,3.3337e+02_r8,2.8576e+02_r8,2.3807e+02_r8,1.9047e+02_r8,1.4289e+02_r8, & + &9.5250e+01_r8,4.7621e+01_r8,6.7593e-01_r8/) + kao(:, 2, 6,16) = (/ & + &3.5801e+02_r8,3.1325e+02_r8,2.6851e+02_r8,2.2376e+02_r8,1.7905e+02_r8,1.3426e+02_r8, & + &8.9499e+01_r8,4.4742e+01_r8,1.0913e+00_r8/) + kao(:, 3, 6,16) = (/ & + &3.3608e+02_r8,2.9405e+02_r8,2.5208e+02_r8,2.1010e+02_r8,1.6803e+02_r8,1.2602e+02_r8, & + &8.4040e+01_r8,4.2005e+01_r8,1.6542e+00_r8/) + kao(:, 4, 6,16) = (/ & + &3.1667e+02_r8,2.7704e+02_r8,2.3752e+02_r8,1.9794e+02_r8,1.5835e+02_r8,1.1877e+02_r8, & + &7.9157e+01_r8,3.9584e+01_r8,2.3801e+00_r8/) + kao(:, 5, 6,16) = (/ & + &2.9810e+02_r8,2.6093e+02_r8,2.2364e+02_r8,1.8637e+02_r8,1.4910e+02_r8,1.1183e+02_r8, & + &7.4550e+01_r8,3.7278e+01_r8,3.2789e+00_r8/) + kao(:, 1, 7,16) = (/ & + &7.9749e+02_r8,6.9796e+02_r8,5.9825e+02_r8,4.9855e+02_r8,3.9886e+02_r8,2.9907e+02_r8, & + &1.9939e+02_r8,9.9689e+01_r8,5.8719e-01_r8/) + kao(:, 2, 7,16) = (/ & + &7.4948e+02_r8,6.5592e+02_r8,5.6211e+02_r8,4.6855e+02_r8,3.7478e+02_r8,2.8116e+02_r8, & + &1.8738e+02_r8,9.3692e+01_r8,9.9296e-01_r8/) + kao(:, 3, 7,16) = (/ & + &7.0403e+02_r8,6.1598e+02_r8,5.2804e+02_r8,4.4008e+02_r8,3.5206e+02_r8,2.6406e+02_r8, & + &1.7605e+02_r8,8.8000e+01_r8,1.5629e+00_r8/) + kao(:, 4, 7,16) = (/ & + &6.6205e+02_r8,5.7919e+02_r8,4.9648e+02_r8,4.1378e+02_r8,3.3107e+02_r8,2.4827e+02_r8, & + &1.6552e+02_r8,8.2766e+01_r8,2.3202e+00_r8/) + kao(:, 5, 7,16) = (/ & + &6.2380e+02_r8,5.4580e+02_r8,4.6792e+02_r8,3.8985e+02_r8,3.1191e+02_r8,2.3394e+02_r8, & + &1.5598e+02_r8,7.7978e+01_r8,3.2803e+00_r8/) + kao(:, 1, 8,16) = (/ & + &2.0029e+03_r8,1.7526e+03_r8,1.5027e+03_r8,1.2518e+03_r8,1.0017e+03_r8,7.5137e+02_r8, & + &5.0076e+02_r8,2.5041e+02_r8,5.0039e-01_r8/) + kao(:, 2, 8,16) = (/ & + &1.8839e+03_r8,1.6487e+03_r8,1.4132e+03_r8,1.1775e+03_r8,9.4211e+02_r8,7.0656e+02_r8, & + &4.7103e+02_r8,2.3550e+02_r8,8.8968e-01_r8/) + kao(:, 3, 8,16) = (/ & + &1.7724e+03_r8,1.5508e+03_r8,1.3295e+03_r8,1.1080e+03_r8,8.8638e+02_r8,6.6461e+02_r8, & + &4.4304e+02_r8,2.2162e+02_r8,1.4586e+00_r8/) + kao(:, 4, 8,16) = (/ & + &1.6681e+03_r8,1.4594e+03_r8,1.2510e+03_r8,1.0422e+03_r8,8.3394e+02_r8,6.2548e+02_r8, & + &4.1698e+02_r8,2.0850e+02_r8,2.2386e+00_r8/) + kao(:, 5, 8,16) = (/ & + &1.5734e+03_r8,1.3768e+03_r8,1.1803e+03_r8,9.8337e+02_r8,7.8678e+02_r8,5.9008e+02_r8, & + &3.9340e+02_r8,1.9668e+02_r8,3.2542e+00_r8/) + kao(:, 1, 9,16) = (/ & + &9.5422e+03_r8,8.3482e+03_r8,7.1572e+03_r8,5.9648e+03_r8,4.7724e+03_r8,3.5785e+03_r8, & + &2.3856e+03_r8,1.1929e+03_r8,4.1531e-01_r8/) + kao(:, 2, 9,16) = (/ & + &8.9979e+03_r8,7.8727e+03_r8,6.7481e+03_r8,5.6240e+03_r8,4.4988e+03_r8,3.3743e+03_r8, & + &2.2493e+03_r8,1.1247e+03_r8,7.8014e-01_r8/) + kao(:, 3, 9,16) = (/ & + &8.4879e+03_r8,7.4273e+03_r8,6.3662e+03_r8,5.3047e+03_r8,4.2442e+03_r8,3.1830e+03_r8, & + &2.1217e+03_r8,1.0610e+03_r8,1.3368e+00_r8/) + kao(:, 4, 9,16) = (/ & + &8.0145e+03_r8,7.0116e+03_r8,6.0099e+03_r8,5.0094e+03_r8,4.0072e+03_r8,3.0052e+03_r8, & + &2.0036e+03_r8,1.0018e+03_r8,2.1276e+00_r8/) + kao(:, 5, 9,16) = (/ & + &7.6138e+03_r8,6.6618e+03_r8,5.7100e+03_r8,4.7582e+03_r8,3.8067e+03_r8,2.8551e+03_r8, & + &1.9031e+03_r8,9.5177e+02_r8,3.1866e+00_r8/) + kao(:, 1,10,16) = (/ & + &5.0991e+04_r8,4.4616e+04_r8,3.8235e+04_r8,3.1865e+04_r8,2.5493e+04_r8,1.9119e+04_r8, & + &1.2748e+04_r8,6.3734e+03_r8,3.5386e-01_r8/) + kao(:, 2,10,16) = (/ & + &4.8246e+04_r8,4.2216e+04_r8,3.6189e+04_r8,3.0155e+04_r8,2.4122e+04_r8,1.8092e+04_r8, & + &1.2062e+04_r8,6.0316e+03_r8,7.0256e-01_r8/) + kao(:, 3,10,16) = (/ & + &4.5828e+04_r8,4.0101e+04_r8,3.4373e+04_r8,2.8642e+04_r8,2.2916e+04_r8,1.7187e+04_r8, & + &1.1458e+04_r8,5.7294e+03_r8,1.2547e+00_r8/) + kao(:, 4,10,16) = (/ & + &4.3978e+04_r8,3.8481e+04_r8,3.2983e+04_r8,2.7486e+04_r8,2.1988e+04_r8,1.6492e+04_r8, & + &1.0995e+04_r8,5.4969e+03_r8,2.0651e+00_r8/) + kao(:, 5,10,16) = (/ & + &4.2519e+04_r8,3.7205e+04_r8,3.1889e+04_r8,2.6577e+04_r8,2.1264e+04_r8,1.5948e+04_r8, & + &1.0631e+04_r8,5.3154e+03_r8,3.1779e+00_r8/) + kao(:, 1,11,16) = (/ & + &9.4155e+04_r8,8.2392e+04_r8,7.0618e+04_r8,5.8856e+04_r8,4.7081e+04_r8,3.5308e+04_r8, & + &2.3542e+04_r8,1.1770e+04_r8,6.1346e-06_r8/) + kao(:, 2,11,16) = (/ & + &9.0590e+04_r8,7.9258e+04_r8,6.7935e+04_r8,5.6620e+04_r8,4.5292e+04_r8,3.3967e+04_r8, & + &2.2646e+04_r8,1.1323e+04_r8,3.3281e-01_r8/) + kao(:, 3,11,16) = (/ & + &8.8119e+04_r8,7.7104e+04_r8,6.6094e+04_r8,5.5078e+04_r8,4.4061e+04_r8,3.3053e+04_r8, & + &2.2031e+04_r8,1.1015e+04_r8,1.5023e+00_r8/) + kao(:, 4,11,16) = (/ & + &8.6175e+04_r8,7.5401e+04_r8,6.4627e+04_r8,5.3860e+04_r8,4.3092e+04_r8,3.2317e+04_r8, & + &2.1545e+04_r8,1.0771e+04_r8,2.4696e+00_r8/) + kao(:, 5,11,16) = (/ & + &8.4570e+04_r8,7.4002e+04_r8,6.3432e+04_r8,5.2859e+04_r8,4.2288e+04_r8,3.1714e+04_r8, & + &2.1142e+04_r8,1.0572e+04_r8,3.7979e+00_r8/) + kao(:, 1,12,16) = (/ & + &1.3547e+05_r8,1.1853e+05_r8,1.0160e+05_r8,8.4660e+04_r8,6.7729e+04_r8,5.0794e+04_r8, & + &3.3867e+04_r8,1.6929e+04_r8,5.0265e-06_r8/) + kao(:, 2,12,16) = (/ & + &1.3284e+05_r8,1.1623e+05_r8,9.9623e+04_r8,8.3023e+04_r8,6.6416e+04_r8,4.9810e+04_r8, & + &3.3206e+04_r8,1.6603e+04_r8,9.0705e-06_r8/) + kao(:, 3,12,16) = (/ & + &1.3111e+05_r8,1.1471e+05_r8,9.8324e+04_r8,8.1946e+04_r8,6.5544e+04_r8,4.9165e+04_r8, & + &3.2777e+04_r8,1.6388e+04_r8,1.7901e+00_r8/) + kao(:, 4,12,16) = (/ & + &1.2947e+05_r8,1.1329e+05_r8,9.7103e+04_r8,8.0920e+04_r8,6.4734e+04_r8,4.8090e+04_r8, & + &3.2370e+04_r8,1.6184e+04_r8,2.9393e+00_r8/) + kao(:, 5,12,16) = (/ & + &1.2773e+05_r8,1.1176e+05_r8,9.5799e+04_r8,7.9830e+04_r8,6.3866e+04_r8,4.7901e+04_r8, & + &3.1932e+04_r8,1.5966e+04_r8,4.5138e+00_r8/) + kao(:, 1,13,16) = (/ & + &1.6206e+05_r8,1.4180e+05_r8,1.2155e+05_r8,1.0128e+05_r8,8.1025e+04_r8,6.0775e+04_r8, & + &4.0514e+04_r8,2.0257e+04_r8,4.1164e-06_r8/) + kao(:, 2,13,16) = (/ & + &1.6103e+05_r8,1.4091e+05_r8,1.2078e+05_r8,1.0065e+05_r8,8.0525e+04_r8,6.0389e+04_r8, & + &4.0260e+04_r8,2.0131e+04_r8,7.4285e-06_r8/) + kao(:, 3,13,16) = (/ & + &1.6003e+05_r8,1.4003e+05_r8,1.2001e+05_r8,1.0001e+05_r8,8.0009e+04_r8,6.0009e+04_r8, & + &4.0005e+04_r8,2.0004e+04_r8,8.7132e-01_r8/) + kao(:, 4,13,16) = (/ & + &1.5863e+05_r8,1.3882e+05_r8,1.1899e+05_r8,9.9157e+04_r8,7.9319e+04_r8,5.9492e+04_r8, & + &3.9661e+04_r8,1.9830e+04_r8,3.4650e+00_r8/) + kao(:, 5,13,16) = (/ & + &1.5756e+05_r8,1.3786e+05_r8,1.1816e+05_r8,9.8476e+04_r8,7.8780e+04_r8,5.9085e+04_r8, & + &3.9388e+04_r8,1.9695e+04_r8,5.3123e+00_r8/) + +! The array KBO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels < ~100mb, temperatures, and ratios +! of H2O to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index, JT, which +! runs from 1 to 5, corresponds to different temperatures. More +! specifically, JT = 3 means that the data are for the corresponding +! reference temperature TREF for this pressure level, JT = 2 refers +! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and +! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and +! refers to the corresponding pressure level in PREF (e.g. JP = 13 is +! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to +! 16, and tells us which g-interval the absorption coefficients are for. + + kbo(:, 1,13, 1) = (/ & + &1.9283e+01_r8,1.4533e+01_r8,9.7765e+00_r8,4.9986e+00_r8,1.2562e-02_r8/) + kbo(:, 2,13, 1) = (/ & + &2.3187e+01_r8,1.7461e+01_r8,1.1734e+01_r8,5.9860e+00_r8,1.4622e-02_r8/) + kbo(:, 3,13, 1) = (/ & + &2.7169e+01_r8,2.0447e+01_r8,1.3724e+01_r8,6.9897e+00_r8,1.6755e-02_r8/) + kbo(:, 4,13, 1) = (/ & + &3.1114e+01_r8,2.3405e+01_r8,1.5695e+01_r8,7.9803e+00_r8,1.8932e-02_r8/) + kbo(:, 5,13, 1) = (/ & + &3.5056e+01_r8,2.6360e+01_r8,1.7664e+01_r8,8.9659e+00_r8,2.1071e-02_r8/) + kbo(:, 1,14, 1) = (/ & + &1.0180e+01_r8,7.7052e+00_r8,5.2175e+00_r8,2.7059e+00_r8,1.0725e-02_r8/) + kbo(:, 2,14, 1) = (/ & + &1.2216e+01_r8,9.2332e+00_r8,6.2420e+00_r8,3.2235e+00_r8,1.2472e-02_r8/) + kbo(:, 3,14, 1) = (/ & + &1.4258e+01_r8,1.0764e+01_r8,7.2673e+00_r8,3.7434e+00_r8,1.4271e-02_r8/) + kbo(:, 4,14, 1) = (/ & + &1.6297e+01_r8,1.2292e+01_r8,8.2867e+00_r8,4.2597e+00_r8,1.6035e-02_r8/) + kbo(:, 5,14, 1) = (/ & + &1.8337e+01_r8,1.3822e+01_r8,9.3061e+00_r8,4.7742e+00_r8,1.7777e-02_r8/) + kbo(:, 1,15, 1) = (/ & + &5.4843e+00_r8,4.1814e+00_r8,2.8583e+00_r8,1.5122e+00_r8,9.1712e-03_r8/) + kbo(:, 2,15, 1) = (/ & + &6.5509e+00_r8,4.9839e+00_r8,3.3981e+00_r8,1.7878e+00_r8,1.0654e-02_r8/) + kbo(:, 3,15, 1) = (/ & + &7.6172e+00_r8,5.7836e+00_r8,3.9371e+00_r8,2.0620e+00_r8,1.2109e-02_r8/) + kbo(:, 4,15, 1) = (/ & + &8.6919e+00_r8,6.5886e+00_r8,4.4776e+00_r8,2.3372e+00_r8,1.3585e-02_r8/) + kbo(:, 5,15, 1) = (/ & + &9.7770e+00_r8,7.4027e+00_r8,5.0231e+00_r8,2.6136e+00_r8,1.5008e-02_r8/) + kbo(:, 1,16, 1) = (/ & + &3.5143e+00_r8,2.7004e+00_r8,1.8632e+00_r8,1.0005e+00_r8,7.8549e-03_r8/) + kbo(:, 2,16, 1) = (/ & + &4.1782e+00_r8,3.2010e+00_r8,2.2008e+00_r8,1.1754e+00_r8,9.0596e-03_r8/) + kbo(:, 3,16, 1) = (/ & + &4.8461e+00_r8,3.7036e+00_r8,2.5395e+00_r8,1.3499e+00_r8,1.0291e-02_r8/) + kbo(:, 4,16, 1) = (/ & + &5.5241e+00_r8,4.2125e+00_r8,2.8833e+00_r8,1.5266e+00_r8,1.1500e-02_r8/) + kbo(:, 5,16, 1) = (/ & + &6.2095e+00_r8,4.7270e+00_r8,3.2297e+00_r8,1.7035e+00_r8,1.2669e-02_r8/) + kbo(:, 1,17, 1) = (/ & + &2.3317e+00_r8,1.8082e+00_r8,1.2606e+00_r8,6.8451e-01_r8,6.6638e-03_r8/) + kbo(:, 2,17, 1) = (/ & + &2.7625e+00_r8,2.1339e+00_r8,1.4816e+00_r8,7.9994e-01_r8,7.6839e-03_r8/) + kbo(:, 3,17, 1) = (/ & + &3.1980e+00_r8,2.4632e+00_r8,1.7043e+00_r8,9.1671e-01_r8,8.7134e-03_r8/) + kbo(:, 4,17, 1) = (/ & + &3.6437e+00_r8,2.7995e+00_r8,1.9319e+00_r8,1.0349e+00_r8,9.7011e-03_r8/) + kbo(:, 5,17, 1) = (/ & + &4.0944e+00_r8,3.1388e+00_r8,2.1608e+00_r8,1.1535e+00_r8,1.0621e-02_r8/) + kbo(:, 1,18, 1) = (/ & + &1.5862e+00_r8,1.2436e+00_r8,8.7489e-01_r8,4.7986e-01_r8,5.6356e-03_r8/) + kbo(:, 2,18, 1) = (/ & + &1.8744e+00_r8,1.4623e+00_r8,1.0242e+00_r8,5.5874e-01_r8,6.4918e-03_r8/) + kbo(:, 3,18, 1) = (/ & + &2.1671e+00_r8,1.6845e+00_r8,1.1763e+00_r8,6.3905e-01_r8,7.3340e-03_r8/) + kbo(:, 4,18, 1) = (/ & + &2.4666e+00_r8,1.9117e+00_r8,1.3311e+00_r8,7.2008e-01_r8,8.1312e-03_r8/) + kbo(:, 5,18, 1) = (/ & + &2.7713e+00_r8,2.1418e+00_r8,1.4869e+00_r8,8.0122e-01_r8,8.8525e-03_r8/) + kbo(:, 1,19, 1) = (/ & + &1.0610e+00_r8,8.4360e-01_r8,5.9805e-01_r8,3.3172e-01_r8,4.7490e-03_r8/) + kbo(:, 2,19, 1) = (/ & + &1.2512e+00_r8,9.8882e-01_r8,6.9811e-01_r8,3.8521e-01_r8,5.4538e-03_r8/) + kbo(:, 3,19, 1) = (/ & + &1.4451e+00_r8,1.1370e+00_r8,8.0056e-01_r8,4.3959e-01_r8,6.1291e-03_r8/) + kbo(:, 4,19, 1) = (/ & + &1.6437e+00_r8,1.2883e+00_r8,9.0437e-01_r8,4.9444e-01_r8,6.7635e-03_r8/) + kbo(:, 5,19, 1) = (/ & + &1.8467e+00_r8,1.4425e+00_r8,1.0099e+00_r8,5.4929e-01_r8,7.3353e-03_r8/) + kbo(:, 1,20, 1) = (/ & + &7.7133e-01_r8,6.2032e-01_r8,4.4197e-01_r8,2.4707e-01_r8,4.0032e-03_r8/) + kbo(:, 2,20, 1) = (/ & + &9.0743e-01_r8,7.2503e-01_r8,5.1466e-01_r8,2.8622e-01_r8,4.5715e-03_r8/) + kbo(:, 3,20, 1) = (/ & + &1.0470e+00_r8,8.3267e-01_r8,5.8918e-01_r8,3.2603e-01_r8,5.1125e-03_r8/) + kbo(:, 4,20, 1) = (/ & + &1.1900e+00_r8,9.4226e-01_r8,6.6481e-01_r8,3.6603e-01_r8,5.6145e-03_r8/) + kbo(:, 5,20, 1) = (/ & + &1.3362e+00_r8,1.0539e+00_r8,7.4130e-01_r8,4.0582e-01_r8,6.0699e-03_r8/) + kbo(:, 1,21, 1) = (/ & + &5.7866e-01_r8,4.6986e-01_r8,3.3621e-01_r8,1.8917e-01_r8,3.3621e-03_r8/) + kbo(:, 2,21, 1) = (/ & + &6.7950e-01_r8,5.4811e-01_r8,3.9072e-01_r8,2.1877e-01_r8,3.8183e-03_r8/) + kbo(:, 3,21, 1) = (/ & + &7.8326e-01_r8,6.2869e-01_r8,4.4658e-01_r8,2.4873e-01_r8,4.2512e-03_r8/) + kbo(:, 4,21, 1) = (/ & + &8.8933e-01_r8,7.1063e-01_r8,5.0334e-01_r8,2.7872e-01_r8,4.6532e-03_r8/) + kbo(:, 5,21, 1) = (/ & + &9.9790e-01_r8,7.9397e-01_r8,5.6013e-01_r8,3.0841e-01_r8,5.0189e-03_r8/) + kbo(:, 1,22, 1) = (/ & + &4.5035e-01_r8,3.6838e-01_r8,2.6449e-01_r8,1.4961e-01_r8,2.8371e-03_r8/) + kbo(:, 2,22, 1) = (/ & + &5.2710e-01_r8,4.2854e-01_r8,3.0641e-01_r8,1.7248e-01_r8,3.2033e-03_r8/) + kbo(:, 3,22, 1) = (/ & + &6.0621e-01_r8,4.9027e-01_r8,3.4931e-01_r8,1.9546e-01_r8,3.5507e-03_r8/) + kbo(:, 4,22, 1) = (/ & + &6.8687e-01_r8,5.5302e-01_r8,3.9268e-01_r8,2.1836e-01_r8,3.8721e-03_r8/) + kbo(:, 5,22, 1) = (/ & + &7.6986e-01_r8,6.1676e-01_r8,4.3619e-01_r8,2.4105e-01_r8,4.1644e-03_r8/) + kbo(:, 1,23, 1) = (/ & + &3.5288e-01_r8,2.9059e-01_r8,2.0929e-01_r8,1.1896e-01_r8,2.3878e-03_r8/) + kbo(:, 2,23, 1) = (/ & + &4.1165e-01_r8,3.3703e-01_r8,2.4169e-01_r8,1.3668e-01_r8,2.6830e-03_r8/) + kbo(:, 3,23, 1) = (/ & + &4.7210e-01_r8,3.8447e-01_r8,2.7478e-01_r8,1.5435e-01_r8,2.9616e-03_r8/) + kbo(:, 4,23, 1) = (/ & + &5.3412e-01_r8,4.3294e-01_r8,3.0818e-01_r8,1.7203e-01_r8,3.2196e-03_r8/) + kbo(:, 5,23, 1) = (/ & + &5.9758e-01_r8,4.8162e-01_r8,3.4147e-01_r8,1.8925e-01_r8,3.4517e-03_r8/) + kbo(:, 1,24, 1) = (/ & + &2.7554e-01_r8,2.2847e-01_r8,1.6509e-01_r8,9.4305e-02_r8,2.0058e-03_r8/) + kbo(:, 2,24, 1) = (/ & + &3.2038e-01_r8,2.6411e-01_r8,1.9003e-01_r8,1.0793e-01_r8,2.2440e-03_r8/) + kbo(:, 3,24, 1) = (/ & + &3.6644e-01_r8,3.0049e-01_r8,2.1543e-01_r8,1.2148e-01_r8,2.4688e-03_r8/) + kbo(:, 4,24, 1) = (/ & + &4.1394e-01_r8,3.3761e-01_r8,2.4100e-01_r8,1.3500e-01_r8,2.6754e-03_r8/) + kbo(:, 5,24, 1) = (/ & + &4.6205e-01_r8,3.7459e-01_r8,2.6626e-01_r8,1.4798e-01_r8,2.8597e-03_r8/) + kbo(:, 1,25, 1) = (/ & + &2.1831e-01_r8,1.8211e-01_r8,1.3197e-01_r8,7.5672e-02_r8,1.6848e-03_r8/) + kbo(:, 2,25, 1) = (/ & + &2.5300e-01_r8,2.0977e-01_r8,1.5139e-01_r8,8.6229e-02_r8,1.8770e-03_r8/) + kbo(:, 3,25, 1) = (/ & + &2.8861e-01_r8,2.3809e-01_r8,1.7109e-01_r8,9.6778e-02_r8,2.0567e-03_r8/) + kbo(:, 4,25, 1) = (/ & + &3.2559e-01_r8,2.6686e-01_r8,1.9096e-01_r8,1.0719e-01_r8,2.2230e-03_r8/) + kbo(:, 5,25, 1) = (/ & + &3.6217e-01_r8,2.9511e-01_r8,2.1013e-01_r8,1.1707e-01_r8,2.3678e-03_r8/) + kbo(:, 1,26, 1) = (/ & + &1.7639e-01_r8,1.4786e-01_r8,1.0735e-01_r8,6.1680e-02_r8,1.4167e-03_r8/) + kbo(:, 2,26, 1) = (/ & + &2.0373e-01_r8,1.6972e-01_r8,1.2271e-01_r8,7.0008e-02_r8,1.5712e-03_r8/) + kbo(:, 3,26, 1) = (/ & + &2.3189e-01_r8,1.9218e-01_r8,1.3830e-01_r8,7.8351e-02_r8,1.7155e-03_r8/) + kbo(:, 4,26, 1) = (/ & + &2.6096e-01_r8,2.1478e-01_r8,1.5388e-01_r8,8.6437e-02_r8,1.8482e-03_r8/) + kbo(:, 5,26, 1) = (/ & + &2.8921e-01_r8,2.3658e-01_r8,1.6864e-01_r8,9.4016e-02_r8,1.9628e-03_r8/) + kbo(:, 1,27, 1) = (/ & + &1.4816e-01_r8,1.2446e-01_r8,9.0381e-02_r8,5.1884e-02_r8,1.1905e-03_r8/) + kbo(:, 2,27, 1) = (/ & + &1.7052e-01_r8,1.4243e-01_r8,1.0297e-01_r8,5.8708e-02_r8,1.3153e-03_r8/) + kbo(:, 3,27, 1) = (/ & + &1.9369e-01_r8,1.6085e-01_r8,1.1575e-01_r8,6.5493e-02_r8,1.4309e-03_r8/) + kbo(:, 4,27, 1) = (/ & + &2.1729e-01_r8,1.7923e-01_r8,1.2834e-01_r8,7.1951e-02_r8,1.5370e-03_r8/) + kbo(:, 5,27, 1) = (/ & + &2.3994e-01_r8,1.9663e-01_r8,1.4015e-01_r8,7.7968e-02_r8,1.6265e-03_r8/) + kbo(:, 1,28, 1) = (/ & + &1.2786e-01_r8,1.0743e-01_r8,7.7947e-02_r8,4.4624e-02_r8,1.0001e-03_r8/) + kbo(:, 2,28, 1) = (/ & + &1.4668e-01_r8,1.2262e-01_r8,8.8533e-02_r8,5.0350e-02_r8,1.1007e-03_r8/) + kbo(:, 3,28, 1) = (/ & + &1.6624e-01_r8,1.3809e-01_r8,9.9259e-02_r8,5.5949e-02_r8,1.1936e-03_r8/) + kbo(:, 4,28, 1) = (/ & + &1.8582e-01_r8,1.5336e-01_r8,1.0964e-01_r8,6.1251e-02_r8,1.2774e-03_r8/) + kbo(:, 5,28, 1) = (/ & + &2.0447e-01_r8,1.6760e-01_r8,1.1929e-01_r8,6.6127e-02_r8,1.3481e-03_r8/) + kbo(:, 1,29, 1) = (/ & + &1.1723e-01_r8,9.8203e-02_r8,7.1006e-02_r8,4.0413e-02_r8,8.4082e-04_r8/) + kbo(:, 2,29, 1) = (/ & + &1.3410e-01_r8,1.1181e-01_r8,8.0444e-02_r8,4.5462e-02_r8,9.2201e-04_r8/) + kbo(:, 3,29, 1) = (/ & + &1.5159e-01_r8,1.2556e-01_r8,8.9943e-02_r8,5.0342e-02_r8,9.9652e-04_r8/) + kbo(:, 4,29, 1) = (/ & + &1.6878e-01_r8,1.3892e-01_r8,9.8991e-02_r8,5.4945e-02_r8,1.0624e-03_r8/) + kbo(:, 5,29, 1) = (/ & + &1.8506e-01_r8,1.5133e-01_r8,1.0733e-01_r8,5.9130e-02_r8,1.1186e-03_r8/) + kbo(:, 1,30, 1) = (/ & + &1.1017e-01_r8,9.1915e-02_r8,6.6158e-02_r8,3.7385e-02_r8,7.0716e-04_r8/) + kbo(:, 2,30, 1) = (/ & + &1.2571e-01_r8,1.0438e-01_r8,7.4791e-02_r8,4.1937e-02_r8,7.7222e-04_r8/) + kbo(:, 3,30, 1) = (/ & + &1.4165e-01_r8,1.1688e-01_r8,8.3361e-02_r8,4.6295e-02_r8,8.3205e-04_r8/) + kbo(:, 4,30, 1) = (/ & + &1.5709e-01_r8,1.2882e-01_r8,9.1412e-02_r8,5.0358e-02_r8,8.8422e-04_r8/) + kbo(:, 5,30, 1) = (/ & + &1.7161e-01_r8,1.3989e-01_r8,9.8798e-02_r8,5.4060e-02_r8,9.2829e-04_r8/) + kbo(:, 1,31, 1) = (/ & + &1.0894e-01_r8,9.0338e-02_r8,6.4636e-02_r8,3.6175e-02_r8,5.9489e-04_r8/) + kbo(:, 2,31, 1) = (/ & + &1.2399e-01_r8,1.0230e-01_r8,7.2900e-02_r8,4.0465e-02_r8,6.4753e-04_r8/) + kbo(:, 3,31, 1) = (/ & + &1.3920e-01_r8,1.1419e-01_r8,8.0980e-02_r8,4.4552e-02_r8,6.9507e-04_r8/) + kbo(:, 4,31, 1) = (/ & + &1.5373e-01_r8,1.2537e-01_r8,8.8479e-02_r8,4.8317e-02_r8,7.3661e-04_r8/) + kbo(:, 5,31, 1) = (/ & + &1.6735e-01_r8,1.3577e-01_r8,9.5380e-02_r8,5.1770e-02_r8,7.7104e-04_r8/) + kbo(:, 1,32, 1) = (/ & + &1.0900e-01_r8,8.9827e-02_r8,6.3903e-02_r8,3.5410e-02_r8,5.0043e-04_r8/) + kbo(:, 2,32, 1) = (/ & + &1.2373e-01_r8,1.0144e-01_r8,7.1880e-02_r8,3.9506e-02_r8,5.4269e-04_r8/) + kbo(:, 3,32, 1) = (/ & + &1.3829e-01_r8,1.1278e-01_r8,7.9528e-02_r8,4.3367e-02_r8,5.8080e-04_r8/) + kbo(:, 4,32, 1) = (/ & + &1.5213e-01_r8,1.2340e-01_r8,8.6611e-02_r8,4.6908e-02_r8,6.1297e-04_r8/) + kbo(:, 5,32, 1) = (/ & + &1.6513e-01_r8,1.3334e-01_r8,9.3188e-02_r8,5.0191e-02_r8,6.4067e-04_r8/) + kbo(:, 1,33, 1) = (/ & + &1.1105e-01_r8,9.0919e-02_r8,6.4301e-02_r8,3.5277e-02_r8,4.2055e-04_r8/) + kbo(:, 2,33, 1) = (/ & + &1.2562e-01_r8,1.0235e-01_r8,7.2096e-02_r8,3.9245e-02_r8,4.5474e-04_r8/) + kbo(:, 3,33, 1) = (/ & + &1.3981e-01_r8,1.1334e-01_r8,7.9473e-02_r8,4.2949e-02_r8,4.8461e-04_r8/) + kbo(:, 4,33, 1) = (/ & + &1.5326e-01_r8,1.2363e-01_r8,8.6303e-02_r8,4.6360e-02_r8,5.1014e-04_r8/) + kbo(:, 5,33, 1) = (/ & + &1.6587e-01_r8,1.3331e-01_r8,9.2704e-02_r8,4.9561e-02_r8,5.3252e-04_r8/) + kbo(:, 1,34, 1) = (/ & + &1.0980e-01_r8,8.9454e-02_r8,6.2967e-02_r8,3.4264e-02_r8,3.5179e-04_r8/) + kbo(:, 2,34, 1) = (/ & + &1.2374e-01_r8,1.0037e-01_r8,7.0363e-02_r8,3.8004e-02_r8,3.7955e-04_r8/) + kbo(:, 3,34, 1) = (/ & + &1.3725e-01_r8,1.1080e-01_r8,7.7340e-02_r8,4.1494e-02_r8,4.0292e-04_r8/) + kbo(:, 4,34, 1) = (/ & + &1.5005e-01_r8,1.2058e-01_r8,8.3803e-02_r8,4.4722e-02_r8,4.2388e-04_r8/) + kbo(:, 5,34, 1) = (/ & + &1.6190e-01_r8,1.2971e-01_r8,8.9844e-02_r8,4.7765e-02_r8,4.4175e-04_r8/) + kbo(:, 1,35, 1) = (/ & + &1.0733e-01_r8,8.7091e-02_r8,6.1056e-02_r8,3.2994e-02_r8,2.9230e-04_r8/) + kbo(:, 2,35, 1) = (/ & + &1.2074e-01_r8,9.7561e-02_r8,6.8117e-02_r8,3.6550e-02_r8,3.1434e-04_r8/) + kbo(:, 3,35, 1) = (/ & + &1.3369e-01_r8,1.0755e-01_r8,7.4768e-02_r8,3.9873e-02_r8,3.3363e-04_r8/) + kbo(:, 4,35, 1) = (/ & + &1.4588e-01_r8,1.1689e-01_r8,8.0950e-02_r8,4.2958e-02_r8,3.5062e-04_r8/) + kbo(:, 5,35, 1) = (/ & + &1.5707e-01_r8,1.2552e-01_r8,8.6668e-02_r8,4.5847e-02_r8,3.6479e-04_r8/) + kbo(:, 1,36, 1) = (/ & + &1.0289e-01_r8,8.3241e-02_r8,5.8159e-02_r8,3.1253e-02_r8,2.4069e-04_r8/) + kbo(:, 2,36, 1) = (/ & + &1.1571e-01_r8,9.3253e-02_r8,6.4895e-02_r8,3.4641e-02_r8,2.5868e-04_r8/) + kbo(:, 3,36, 1) = (/ & + &1.2815e-01_r8,1.0284e-01_r8,7.1277e-02_r8,3.7824e-02_r8,2.7449e-04_r8/) + kbo(:, 4,36, 1) = (/ & + &1.3974e-01_r8,1.1174e-01_r8,7.7168e-02_r8,4.0766e-02_r8,2.8849e-04_r8/) + kbo(:, 5,36, 1) = (/ & + &1.5033e-01_r8,1.1990e-01_r8,8.2576e-02_r8,4.3496e-02_r8,2.9983e-04_r8/) + kbo(:, 1,37, 1) = (/ & + &9.4340e-02_r8,7.6226e-02_r8,5.3140e-02_r8,2.8456e-02_r8,1.9559e-04_r8/) + kbo(:, 2,37, 1) = (/ & + &1.0634e-01_r8,8.5612e-02_r8,5.9452e-02_r8,3.1630e-02_r8,2.1059e-04_r8/) + kbo(:, 3,37, 1) = (/ & + &1.1803e-01_r8,9.4641e-02_r8,6.5469e-02_r8,3.4631e-02_r8,2.2381e-04_r8/) + kbo(:, 4,37, 1) = (/ & + &1.2893e-01_r8,1.0302e-01_r8,7.1019e-02_r8,3.7400e-02_r8,2.3549e-04_r8/) + kbo(:, 5,37, 1) = (/ & + &1.3882e-01_r8,1.1066e-01_r8,7.6074e-02_r8,3.9944e-02_r8,2.4505e-04_r8/) + kbo(:, 1,38, 1) = (/ & + &8.7666e-02_r8,7.0724e-02_r8,4.9189e-02_r8,2.6244e-02_r8,1.5881e-04_r8/) + kbo(:, 2,38, 1) = (/ & + &9.9075e-02_r8,7.9666e-02_r8,5.5208e-02_r8,2.9270e-02_r8,1.7135e-04_r8/) + kbo(:, 3,38, 1) = (/ & + &1.1022e-01_r8,8.8294e-02_r8,6.0961e-02_r8,3.2140e-02_r8,1.8248e-04_r8/) + kbo(:, 4,38, 1) = (/ & + &1.2063e-01_r8,9.6310e-02_r8,6.6270e-02_r8,3.4786e-02_r8,1.9228e-04_r8/) + kbo(:, 5,38, 1) = (/ & + &1.3002e-01_r8,1.0355e-01_r8,7.1058e-02_r8,3.7188e-02_r8,2.0028e-04_r8/) + kbo(:, 1,39, 1) = (/ & + &8.3319e-02_r8,6.7083e-02_r8,4.6540e-02_r8,2.4732e-02_r8,1.2903e-04_r8/) + kbo(:, 2,39, 1) = (/ & + &9.4409e-02_r8,7.5788e-02_r8,5.2401e-02_r8,2.7679e-02_r8,1.3958e-04_r8/) + kbo(:, 3,39, 1) = (/ & + &1.0530e-01_r8,8.4225e-02_r8,5.8027e-02_r8,3.0486e-02_r8,1.4894e-04_r8/) + kbo(:, 4,39, 1) = (/ & + &1.1544e-01_r8,9.2061e-02_r8,6.3226e-02_r8,3.3071e-02_r8,1.5713e-04_r8/) + kbo(:, 5,39, 1) = (/ & + &1.2457e-01_r8,9.9102e-02_r8,6.7879e-02_r8,3.5400e-02_r8,1.6372e-04_r8/) + kbo(:, 1,40, 1) = (/ & + &7.3382e-02_r8,5.9091e-02_r8,4.0949e-02_r8,2.1720e-02_r8,1.0369e-04_r8/) + kbo(:, 2,40, 1) = (/ & + &8.3492e-02_r8,6.7054e-02_r8,4.6317e-02_r8,2.4422e-02_r8,1.1258e-04_r8/) + kbo(:, 3,40, 1) = (/ & + &9.3502e-02_r8,7.4845e-02_r8,5.1514e-02_r8,2.7021e-02_r8,1.2049e-04_r8/) + kbo(:, 4,40, 1) = (/ & + &1.0289e-01_r8,8.2115e-02_r8,5.6339e-02_r8,2.9419e-02_r8,1.2744e-04_r8/) + kbo(:, 5,40, 1) = (/ & + &1.1132e-01_r8,8.8604e-02_r8,6.0629e-02_r8,3.1559e-02_r8,1.3317e-04_r8/) + kbo(:, 1,41, 1) = (/ & + &6.4289e-02_r8,5.1783e-02_r8,3.5851e-02_r8,1.8983e-02_r8,8.3205e-05_r8/) + kbo(:, 2,41, 1) = (/ & + &7.3486e-02_r8,5.9047e-02_r8,4.0756e-02_r8,2.1456e-02_r8,9.0601e-05_r8/) + kbo(:, 3,41, 1) = (/ & + &8.2657e-02_r8,6.6211e-02_r8,4.5539e-02_r8,2.3850e-02_r8,9.7309e-05_r8/) + kbo(:, 4,41, 1) = (/ & + &9.1325e-02_r8,7.2956e-02_r8,5.0013e-02_r8,2.6075e-02_r8,1.0320e-04_r8/) + kbo(:, 5,41, 1) = (/ & + &9.9149e-02_r8,7.8969e-02_r8,5.3991e-02_r8,2.8057e-02_r8,1.0825e-04_r8/) + kbo(:, 1,42, 1) = (/ & + &5.6899e-02_r8,4.5812e-02_r8,3.1686e-02_r8,1.6747e-02_r8,6.6719e-05_r8/) + kbo(:, 2,42, 1) = (/ & + &6.5316e-02_r8,5.2494e-02_r8,3.6198e-02_r8,1.9026e-02_r8,7.2862e-05_r8/) + kbo(:, 3,42, 1) = (/ & + &7.3779e-02_r8,5.9136e-02_r8,4.0639e-02_r8,2.1249e-02_r8,7.8557e-05_r8/) + kbo(:, 4,42, 1) = (/ & + &8.1877e-02_r8,6.5448e-02_r8,4.4826e-02_r8,2.3334e-02_r8,8.3575e-05_r8/) + kbo(:, 5,42, 1) = (/ & + &8.9207e-02_r8,7.1094e-02_r8,4.8562e-02_r8,2.5195e-02_r8,8.7912e-05_r8/) + kbo(:, 1,43, 1) = (/ & + &5.0334e-02_r8,4.0495e-02_r8,2.7979e-02_r8,1.4764e-02_r8,5.3104e-05_r8/) + kbo(:, 2,43, 1) = (/ & + &5.8063e-02_r8,4.6679e-02_r8,3.2159e-02_r8,1.6880e-02_r8,5.8298e-05_r8/) + kbo(:, 3,43, 1) = (/ & + &6.5961e-02_r8,5.2905e-02_r8,3.6327e-02_r8,1.8968e-02_r8,6.3123e-05_r8/) + kbo(:, 4,43, 1) = (/ & + &7.3585e-02_r8,5.8862e-02_r8,4.0291e-02_r8,2.0945e-02_r8,6.7425e-05_r8/) + kbo(:, 5,43, 1) = (/ & + &8.0560e-02_r8,6.4257e-02_r8,4.3859e-02_r8,2.2720e-02_r8,7.1177e-05_r8/) + kbo(:, 1,44, 1) = (/ & + &4.4899e-02_r8,3.6074e-02_r8,2.4891e-02_r8,1.3115e-02_r8,4.2029e-05_r8/) + kbo(:, 2,44, 1) = (/ & + &5.2065e-02_r8,4.1850e-02_r8,2.8809e-02_r8,1.5097e-02_r8,4.6479e-05_r8/) + kbo(:, 3,44, 1) = (/ & + &5.9485e-02_r8,4.7740e-02_r8,3.2758e-02_r8,1.7077e-02_r8,5.0599e-05_r8/) + kbo(:, 4,44, 1) = (/ & + &6.6781e-02_r8,5.3454e-02_r8,3.6566e-02_r8,1.8982e-02_r8,5.4263e-05_r8/) + kbo(:, 5,44, 1) = (/ & + &7.3522e-02_r8,5.8690e-02_r8,4.0031e-02_r8,2.0702e-02_r8,5.7530e-05_r8/) + kbo(:, 1,45, 1) = (/ & + &4.0792e-02_r8,3.2725e-02_r8,2.2543e-02_r8,1.1850e-02_r8,3.3244e-05_r8/) + kbo(:, 2,45, 1) = (/ & + &4.7552e-02_r8,3.8195e-02_r8,2.6267e-02_r8,1.3739e-02_r8,3.7011e-05_r8/) + kbo(:, 3,45, 1) = (/ & + &5.4656e-02_r8,4.3858e-02_r8,3.0076e-02_r8,1.5653e-02_r8,4.0475e-05_r8/) + kbo(:, 4,45, 1) = (/ & + &6.1725e-02_r8,4.9413e-02_r8,3.3782e-02_r8,1.7505e-02_r8,4.3662e-05_r8/) + kbo(:, 5,45, 1) = (/ & + &6.8362e-02_r8,5.4599e-02_r8,3.7216e-02_r8,1.9215e-02_r8,4.6426e-05_r8/) + kbo(:, 1,46, 1) = (/ & + &3.7210e-02_r8,2.9813e-02_r8,2.0505e-02_r8,1.0753e-02_r8,2.6192e-05_r8/) + kbo(:, 2,46, 1) = (/ & + &4.3666e-02_r8,3.5023e-02_r8,2.4062e-02_r8,1.2564e-02_r8,2.9338e-05_r8/) + kbo(:, 3,46, 1) = (/ & + &5.0484e-02_r8,4.0487e-02_r8,2.7746e-02_r8,1.4418e-02_r8,3.2269e-05_r8/) + kbo(:, 4,46, 1) = (/ & + &5.7389e-02_r8,4.5948e-02_r8,3.1393e-02_r8,1.6243e-02_r8,3.5047e-05_r8/) + kbo(:, 5,46, 1) = (/ & + &6.3983e-02_r8,5.1116e-02_r8,3.4828e-02_r8,1.7955e-02_r8,3.7412e-05_r8/) + kbo(:, 1,47, 1) = (/ & + &3.3307e-02_r8,2.6647e-02_r8,1.8307e-02_r8,9.5851e-03_r8,2.0446e-05_r8/) + kbo(:, 2,47, 1) = (/ & + &3.9395e-02_r8,3.1552e-02_r8,2.1654e-02_r8,1.1293e-02_r8,2.3124e-05_r8/) + kbo(:, 3,47, 1) = (/ & + &4.5832e-02_r8,3.6752e-02_r8,2.5172e-02_r8,1.3065e-02_r8,2.5601e-05_r8/) + kbo(:, 4,47, 1) = (/ & + &5.2491e-02_r8,4.2052e-02_r8,2.8722e-02_r8,1.4843e-02_r8,2.7940e-05_r8/) + kbo(:, 5,47, 1) = (/ & + &5.8958e-02_r8,4.7137e-02_r8,3.2108e-02_r8,1.6536e-02_r8,3.0007e-05_r8/) + kbo(:, 1,48, 1) = (/ & + &3.0577e-02_r8,2.4411e-02_r8,1.6745e-02_r8,8.7495e-03_r8,1.5922e-05_r8/) + kbo(:, 2,48, 1) = (/ & + &3.6464e-02_r8,2.9147e-02_r8,1.9975e-02_r8,1.0397e-02_r8,1.8148e-05_r8/) + kbo(:, 3,48, 1) = (/ & + &4.2691e-02_r8,3.4197e-02_r8,2.3406e-02_r8,1.2132e-02_r8,2.0290e-05_r8/) + kbo(:, 4,48, 1) = (/ & + &4.9243e-02_r8,3.9438e-02_r8,2.6932e-02_r8,1.3903e-02_r8,2.2244e-05_r8/) + kbo(:, 5,48, 1) = (/ & + &5.5751e-02_r8,4.4571e-02_r8,3.0355e-02_r8,1.5610e-02_r8,2.4044e-05_r8/) + kbo(:, 1,49, 1) = (/ & + &2.9139e-02_r8,2.3202e-02_r8,1.5887e-02_r8,8.2788e-03_r8,1.2379e-05_r8/) + kbo(:, 2,49, 1) = (/ & + &3.5049e-02_r8,2.7954e-02_r8,1.9124e-02_r8,9.9302e-03_r8,1.4214e-05_r8/) + kbo(:, 3,49, 1) = (/ & + &4.1342e-02_r8,3.3034e-02_r8,2.2588e-02_r8,1.1686e-02_r8,1.6044e-05_r8/) + kbo(:, 4,49, 1) = (/ & + &4.8011e-02_r8,3.8402e-02_r8,2.6208e-02_r8,1.3508e-02_r8,1.7733e-05_r8/) + kbo(:, 5,49, 1) = (/ & + &5.4790e-02_r8,4.3771e-02_r8,2.9799e-02_r8,1.5302e-02_r8,1.9282e-05_r8/) + kbo(:, 1,50, 1) = (/ & + &2.6464e-02_r8,2.1057e-02_r8,1.4400e-02_r8,7.4918e-03_r8,9.6160e-06_r8/) + kbo(:, 2,50, 1) = (/ & + &3.2138e-02_r8,2.5589e-02_r8,1.7489e-02_r8,9.0674e-03_r8,1.1117e-05_r8/) + kbo(:, 3,50, 1) = (/ & + &3.8201e-02_r8,3.0472e-02_r8,2.0816e-02_r8,1.0758e-02_r8,1.2650e-05_r8/) + kbo(:, 4,50, 1) = (/ & + &4.4627e-02_r8,3.5684e-02_r8,2.4344e-02_r8,1.2533e-02_r8,1.4094e-05_r8/) + kbo(:, 5,50, 1) = (/ & + &5.1304e-02_r8,4.1009e-02_r8,2.7917e-02_r8,1.4322e-02_r8,1.5452e-05_r8/) + kbo(:, 1,51, 1) = (/ & + &2.3471e-02_r8,1.8670e-02_r8,1.2760e-02_r8,6.6303e-03_r8,7.4600e-06_r8/) + kbo(:, 2,51, 1) = (/ & + &2.8809e-02_r8,2.2911e-02_r8,1.5642e-02_r8,8.0988e-03_r8,8.6870e-06_r8/) + kbo(:, 3,51, 1) = (/ & + &3.4515e-02_r8,2.7502e-02_r8,1.8771e-02_r8,9.6885e-03_r8,9.9502e-06_r8/) + kbo(:, 4,51, 1) = (/ & + &4.0564e-02_r8,3.2426e-02_r8,2.2116e-02_r8,1.1378e-02_r8,1.1172e-05_r8/) + kbo(:, 5,51, 1) = (/ & + &4.6952e-02_r8,3.7546e-02_r8,2.5560e-02_r8,1.3107e-02_r8,1.2317e-05_r8/) + kbo(:, 1,52, 1) = (/ & + &2.1330e-02_r8,1.6945e-02_r8,1.1569e-02_r8,6.0043e-03_r8,5.7740e-06_r8/) + kbo(:, 2,52, 1) = (/ & + &2.6486e-02_r8,2.1033e-02_r8,1.4344e-02_r8,7.4158e-03_r8,6.7739e-06_r8/) + kbo(:, 3,52, 1) = (/ & + &3.1984e-02_r8,2.5459e-02_r8,1.7358e-02_r8,8.9483e-03_r8,7.8163e-06_r8/) + kbo(:, 4,52, 1) = (/ & + &3.7859e-02_r8,3.0220e-02_r8,2.0602e-02_r8,1.0589e-02_r8,8.8379e-06_r8/) + kbo(:, 5,52, 1) = (/ & + &4.4095e-02_r8,3.5255e-02_r8,2.3994e-02_r8,1.2295e-02_r8,9.8102e-06_r8/) + kbo(:, 1,53, 1) = (/ & + &2.0104e-02_r8,1.5937e-02_r8,1.0867e-02_r8,5.6295e-03_r8,4.4532e-06_r8/) + kbo(:, 2,53, 1) = (/ & + &2.5267e-02_r8,2.0039e-02_r8,1.3647e-02_r8,7.0429e-03_r8,5.2727e-06_r8/) + kbo(:, 3,53, 1) = (/ & + &3.0800e-02_r8,2.4464e-02_r8,1.6661e-02_r8,8.5763e-03_r8,6.1352e-06_r8/) + kbo(:, 4,53, 1) = (/ & + &3.6739e-02_r8,2.9255e-02_r8,1.9925e-02_r8,1.0232e-02_r8,6.9843e-06_r8/) + kbo(:, 5,53, 1) = (/ & + &4.3045e-02_r8,3.4379e-02_r8,2.3392e-02_r8,1.1975e-02_r8,7.8095e-06_r8/) + kbo(:, 1,54, 1) = (/ & + &1.6441e-02_r8,1.3030e-02_r8,8.8847e-03_r8,4.6022e-03_r8,3.4230e-06_r8/) + kbo(:, 2,54, 1) = (/ & + &2.0888e-02_r8,1.6582e-02_r8,1.1293e-02_r8,5.8278e-03_r8,4.0956e-06_r8/) + kbo(:, 3,54, 1) = (/ & + &2.5721e-02_r8,2.0433e-02_r8,1.3910e-02_r8,7.1575e-03_r8,4.7876e-06_r8/) + kbo(:, 4,54, 1) = (/ & + &3.0904e-02_r8,2.4618e-02_r8,1.6759e-02_r8,8.6032e-03_r8,5.4982e-06_r8/) + kbo(:, 5,54, 1) = (/ & + &3.6412e-02_r8,2.9120e-02_r8,1.9814e-02_r8,1.0143e-02_r8,6.1750e-06_r8/) + kbo(:, 1,55, 1) = (/ & + &1.2258e-02_r8,9.7268e-03_r8,6.6366e-03_r8,3.4428e-03_r8,2.6213e-06_r8/) + kbo(:, 2,55, 1) = (/ & + &1.5748e-02_r8,1.2527e-02_r8,8.5365e-03_r8,4.4115e-03_r8,3.1717e-06_r8/) + kbo(:, 3,55, 1) = (/ & + &1.9594e-02_r8,1.5595e-02_r8,1.0619e-02_r8,5.4666e-03_r8,3.7237e-06_r8/) + kbo(:, 4,55, 1) = (/ & + &2.3710e-02_r8,1.8931e-02_r8,1.2889e-02_r8,6.6186e-03_r8,4.3031e-06_r8/) + kbo(:, 5,55, 1) = (/ & + &2.8112e-02_r8,2.2537e-02_r8,1.5336e-02_r8,7.8537e-03_r8,4.8648e-06_r8/) + kbo(:, 1,56, 1) = (/ & + &9.1055e-03_r8,7.2363e-03_r8,4.9401e-03_r8,2.5664e-03_r8,1.9997e-06_r8/) + kbo(:, 2,56, 1) = (/ & + &1.1834e-02_r8,9.4303e-03_r8,6.4310e-03_r8,3.3278e-03_r8,2.4479e-06_r8/) + kbo(:, 3,56, 1) = (/ & + &1.4882e-02_r8,1.1870e-02_r8,8.0848e-03_r8,4.1651e-03_r8,2.8963e-06_r8/) + kbo(:, 4,56, 1) = (/ & + &1.8155e-02_r8,1.4526e-02_r8,9.8917e-03_r8,5.0809e-03_r8,3.3616e-06_r8/) + kbo(:, 5,56, 1) = (/ & + &2.1671e-02_r8,1.7405e-02_r8,1.1845e-02_r8,6.0691e-03_r8,3.8293e-06_r8/) + kbo(:, 1,57, 1) = (/ & + &6.7286e-03_r8,5.3591e-03_r8,3.6618e-03_r8,1.9048e-03_r8,1.5179e-06_r8/) + kbo(:, 2,57, 1) = (/ & + &8.8620e-03_r8,7.0733e-03_r8,4.8264e-03_r8,2.5013e-03_r8,1.8807e-06_r8/) + kbo(:, 3,57, 1) = (/ & + &1.1265e-02_r8,9.0088e-03_r8,6.1382e-03_r8,3.1650e-03_r8,2.2483e-06_r8/) + kbo(:, 4,57, 1) = (/ & + &1.3873e-02_r8,1.1116e-02_r8,7.5709e-03_r8,3.8911e-03_r8,2.6184e-06_r8/) + kbo(:, 5,57, 1) = (/ & + &1.6676e-02_r8,1.3415e-02_r8,9.1296e-03_r8,4.6803e-03_r8,3.0020e-06_r8/) + kbo(:, 1,58, 1) = (/ & + &1.3112e-03_r8,1.2811e-03_r8,1.1274e-03_r8,8.2340e-04_r8,1.1519e-06_r8/) + kbo(:, 2,58, 1) = (/ & + &1.7518e-03_r8,1.7126e-03_r8,1.5045e-03_r8,1.0941e-03_r8,1.4467e-06_r8/) + kbo(:, 3,58, 1) = (/ & + &2.2498e-03_r8,2.2053e-03_r8,1.9345e-03_r8,1.3994e-03_r8,1.7445e-06_r8/) + kbo(:, 4,58, 1) = (/ & + &2.7980e-03_r8,2.7467e-03_r8,2.4064e-03_r8,1.7337e-03_r8,2.0427e-06_r8/) + kbo(:, 5,58, 1) = (/ & + &3.3868e-03_r8,3.3394e-03_r8,2.9224e-03_r8,2.0998e-03_r8,2.3542e-06_r8/) + kbo(:, 1,59, 1) = (/ & + &1.2094e-03_r8,1.1351e-03_r8,9.3340e-04_r8,6.0964e-04_r8,9.0654e-07_r8/) + kbo(:, 2,59, 1) = (/ & + &1.6257e-03_r8,1.5254e-03_r8,1.2509e-03_r8,8.1260e-04_r8,1.1440e-06_r8/) + kbo(:, 3,59, 1) = (/ & + &2.0981e-03_r8,1.9741e-03_r8,1.6151e-03_r8,1.0426e-03_r8,1.3852e-06_r8/) + kbo(:, 4,59, 1) = (/ & + &2.6203e-03_r8,2.4691e-03_r8,2.0150e-03_r8,1.2943e-03_r8,1.6270e-06_r8/) + kbo(:, 5,59, 1) = (/ & + &3.1814e-03_r8,3.0122e-03_r8,2.4540e-03_r8,1.5709e-03_r8,1.8687e-06_r8/) + kbo(:, 1,13, 2) = (/ & + &6.6529e+01_r8,4.9985e+01_r8,3.3446e+01_r8,1.6923e+01_r8,3.5914e-02_r8/) + kbo(:, 2,13, 2) = (/ & + &7.4095e+01_r8,5.5661e+01_r8,3.7226e+01_r8,1.8804e+01_r8,3.9958e-02_r8/) + kbo(:, 3,13, 2) = (/ & + &8.0840e+01_r8,6.0720e+01_r8,4.0598e+01_r8,2.0484e+01_r8,4.3881e-02_r8/) + kbo(:, 4,13, 2) = (/ & + &8.6396e+01_r8,6.4888e+01_r8,4.3378e+01_r8,2.1867e+01_r8,4.7563e-02_r8/) + kbo(:, 5,13, 2) = (/ & + &9.0642e+01_r8,6.8073e+01_r8,4.5503e+01_r8,2.2931e+01_r8,5.1188e-02_r8/) + kbo(:, 1,14, 2) = (/ & + &3.4987e+01_r8,2.6327e+01_r8,1.7678e+01_r8,9.0444e+00_r8,3.1025e-02_r8/) + kbo(:, 2,14, 2) = (/ & + &3.8934e+01_r8,2.9288e+01_r8,1.9648e+01_r8,1.0023e+01_r8,3.4459e-02_r8/) + kbo(:, 3,14, 2) = (/ & + &4.2399e+01_r8,3.1888e+01_r8,2.1376e+01_r8,1.0881e+01_r8,3.7786e-02_r8/) + kbo(:, 4,14, 2) = (/ & + &4.5141e+01_r8,3.3946e+01_r8,2.2749e+01_r8,1.1559e+01_r8,4.1037e-02_r8/) + kbo(:, 5,14, 2) = (/ & + &4.7193e+01_r8,3.5485e+01_r8,2.3775e+01_r8,1.2071e+01_r8,4.3970e-02_r8/) + kbo(:, 1,15, 2) = (/ & + &1.8797e+01_r8,1.4186e+01_r8,9.5905e+00_r8,4.9916e+00_r8,2.6741e-02_r8/) + kbo(:, 2,15, 2) = (/ & + &2.0897e+01_r8,1.5761e+01_r8,1.0636e+01_r8,5.5075e+00_r8,2.9658e-02_r8/) + kbo(:, 3,15, 2) = (/ & + &2.2675e+01_r8,1.7093e+01_r8,1.1518e+01_r8,5.9424e+00_r8,3.2475e-02_r8/) + kbo(:, 4,15, 2) = (/ & + &2.4040e+01_r8,1.8121e+01_r8,1.2200e+01_r8,6.2773e+00_r8,3.5159e-02_r8/) + kbo(:, 5,15, 2) = (/ & + &2.5038e+01_r8,1.8870e+01_r8,1.2700e+01_r8,6.5270e+00_r8,3.7635e-02_r8/) + kbo(:, 1,16, 2) = (/ & + &1.2062e+01_r8,9.1374e+00_r8,6.2260e+00_r8,3.2778e+00_r8,2.3010e-02_r8/) + kbo(:, 2,16, 2) = (/ & + &1.3368e+01_r8,1.0114e+01_r8,6.8731e+00_r8,3.5955e+00_r8,2.5515e-02_r8/) + kbo(:, 3,16, 2) = (/ & + &1.4432e+01_r8,1.0911e+01_r8,7.4005e+00_r8,3.8523e+00_r8,2.7873e-02_r8/) + kbo(:, 4,16, 2) = (/ & + &1.5210e+01_r8,1.1498e+01_r8,7.7878e+00_r8,4.0427e+00_r8,3.0096e-02_r8/) + kbo(:, 5,16, 2) = (/ & + &1.5795e+01_r8,1.1938e+01_r8,8.0810e+00_r8,4.1897e+00_r8,3.2123e-02_r8/) + kbo(:, 1,17, 2) = (/ & + &8.0343e+00_r8,6.1202e+00_r8,4.2057e+00_r8,2.2416e+00_r8,1.9722e-02_r8/) + kbo(:, 2,17, 2) = (/ & + &8.8550e+00_r8,6.7335e+00_r8,4.6112e+00_r8,2.4399e+00_r8,2.1833e-02_r8/) + kbo(:, 3,17, 2) = (/ & + &9.5028e+00_r8,7.2176e+00_r8,4.9290e+00_r8,2.5918e+00_r8,2.3771e-02_r8/) + kbo(:, 4,17, 2) = (/ & + &9.9681e+00_r8,7.5665e+00_r8,5.1592e+00_r8,2.7054e+00_r8,2.5587e-02_r8/) + kbo(:, 5,17, 2) = (/ & + &1.0341e+01_r8,7.8464e+00_r8,5.3464e+00_r8,2.7998e+00_r8,2.7262e-02_r8/) + kbo(:, 1,18, 2) = (/ & + &5.4784e+00_r8,4.2063e+00_r8,2.9118e+00_r8,1.5707e+00_r8,1.6843e-02_r8/) + kbo(:, 2,18, 2) = (/ & + &6.0003e+00_r8,4.5949e+00_r8,3.1671e+00_r8,1.6950e+00_r8,1.8568e-02_r8/) + kbo(:, 3,18, 2) = (/ & + &6.4044e+00_r8,4.8955e+00_r8,3.3617e+00_r8,1.7866e+00_r8,2.0170e-02_r8/) + kbo(:, 4,18, 2) = (/ & + &6.7000e+00_r8,5.1163e+00_r8,3.5087e+00_r8,1.8600e+00_r8,2.1658e-02_r8/) + kbo(:, 5,18, 2) = (/ & + &6.9467e+00_r8,5.3017e+00_r8,3.6339e+00_r8,1.9245e+00_r8,2.2992e-02_r8/) + kbo(:, 1,19, 2) = (/ & + &3.6607e+00_r8,2.8397e+00_r8,1.9832e+00_r8,1.0810e+00_r8,1.4294e-02_r8/) + kbo(:, 2,19, 2) = (/ & + &3.9888e+00_r8,3.0825e+00_r8,2.1422e+00_r8,1.1564e+00_r8,1.5700e-02_r8/) + kbo(:, 3,19, 2) = (/ & + &4.2403e+00_r8,3.2678e+00_r8,2.2604e+00_r8,1.2129e+00_r8,1.7026e-02_r8/) + kbo(:, 4,19, 2) = (/ & + &4.4304e+00_r8,3.4105e+00_r8,2.3562e+00_r8,1.2611e+00_r8,1.8223e-02_r8/) + kbo(:, 5,19, 2) = (/ & + &4.5892e+00_r8,3.5305e+00_r8,2.4376e+00_r8,1.3052e+00_r8,1.9250e-02_r8/) + kbo(:, 1,20, 2) = (/ & + &2.6484e+00_r8,2.0725e+00_r8,1.4576e+00_r8,7.9887e-01_r8,1.2095e-02_r8/) + kbo(:, 2,20, 2) = (/ & + &2.8723e+00_r8,2.2377e+00_r8,1.5638e+00_r8,8.4850e-01_r8,1.3258e-02_r8/) + kbo(:, 3,20, 2) = (/ & + &3.0432e+00_r8,2.3620e+00_r8,1.6433e+00_r8,8.8749e-01_r8,1.4323e-02_r8/) + kbo(:, 4,20, 2) = (/ & + &3.1766e+00_r8,2.4628e+00_r8,1.7113e+00_r8,9.2233e-01_r8,1.5251e-02_r8/) + kbo(:, 5,20, 2) = (/ & + &3.2896e+00_r8,2.5490e+00_r8,1.7710e+00_r8,9.5551e-01_r8,1.6040e-02_r8/) + kbo(:, 1,21, 2) = (/ & + &1.9737e+00_r8,1.5589e+00_r8,1.1005e+00_r8,6.0564e-01_r8,1.0202e-02_r8/) + kbo(:, 2,21, 2) = (/ & + &2.1324e+00_r8,1.6743e+00_r8,1.1736e+00_r8,6.4004e-01_r8,1.1146e-02_r8/) + kbo(:, 3,21, 2) = (/ & + &2.2543e+00_r8,1.7630e+00_r8,1.2313e+00_r8,6.6865e-01_r8,1.1981e-02_r8/) + kbo(:, 4,21, 2) = (/ & + &2.3508e+00_r8,1.8360e+00_r8,1.2809e+00_r8,6.9497e-01_r8,1.2686e-02_r8/) + kbo(:, 5,21, 2) = (/ & + &2.4312e+00_r8,1.8986e+00_r8,1.3258e+00_r8,7.2010e-01_r8,1.3291e-02_r8/) + kbo(:, 1,22, 2) = (/ & + &1.5156e+00_r8,1.2064e+00_r8,8.5276e-01_r8,4.7037e-01_r8,8.6256e-03_r8/) + kbo(:, 2,22, 2) = (/ & + &1.6299e+00_r8,1.2880e+00_r8,9.0439e-01_r8,4.9507e-01_r8,9.3659e-03_r8/) + kbo(:, 3,22, 2) = (/ & + &1.7167e+00_r8,1.3521e+00_r8,9.4701e-01_r8,5.1663e-01_r8,1.0004e-02_r8/) + kbo(:, 4,22, 2) = (/ & + &1.7876e+00_r8,1.4059e+00_r8,9.8421e-01_r8,5.3690e-01_r8,1.0541e-02_r8/) + kbo(:, 5,22, 2) = (/ & + &1.8482e+00_r8,1.4540e+00_r8,1.0190e+00_r8,5.5667e-01_r8,1.1012e-02_r8/) + kbo(:, 1,23, 2) = (/ & + &1.1701e+00_r8,9.3735e-01_r8,6.6344e-01_r8,3.6672e-01_r8,7.2585e-03_r8/) + kbo(:, 2,23, 2) = (/ & + &1.2526e+00_r8,9.9560e-01_r8,7.0066e-01_r8,3.8497e-01_r8,7.8298e-03_r8/) + kbo(:, 3,23, 2) = (/ & + &1.3157e+00_r8,1.0429e+00_r8,7.3247e-01_r8,4.0155e-01_r8,8.3206e-03_r8/) + kbo(:, 4,23, 2) = (/ & + &1.3685e+00_r8,1.0835e+00_r8,7.6114e-01_r8,4.1717e-01_r8,8.7383e-03_r8/) + kbo(:, 5,23, 2) = (/ & + &1.4146e+00_r8,1.1207e+00_r8,7.8818e-01_r8,4.3301e-01_r8,9.1036e-03_r8/) + kbo(:, 1,24, 2) = (/ & + &8.9949e-01_r8,7.2462e-01_r8,5.1357e-01_r8,2.8470e-01_r8,6.0789e-03_r8/) + kbo(:, 2,24, 2) = (/ & + &9.5867e-01_r8,7.6639e-01_r8,5.4063e-01_r8,2.9829e-01_r8,6.5218e-03_r8/) + kbo(:, 3,24, 2) = (/ & + &1.0042e+00_r8,8.0114e-01_r8,5.6436e-01_r8,3.1100e-01_r8,6.9029e-03_r8/) + kbo(:, 4,24, 2) = (/ & + &1.0431e+00_r8,8.3179e-01_r8,5.8619e-01_r8,3.2299e-01_r8,7.2295e-03_r8/) + kbo(:, 5,24, 2) = (/ & + &1.0790e+00_r8,8.6138e-01_r8,6.0791e-01_r8,3.3588e-01_r8,7.5120e-03_r8/) + kbo(:, 1,25, 2) = (/ & + &7.0112e-01_r8,5.6715e-01_r8,4.0233e-01_r8,2.2369e-01_r8,5.0763e-03_r8/) + kbo(:, 2,25, 2) = (/ & + &7.4350e-01_r8,5.9764e-01_r8,4.2250e-01_r8,2.3404e-01_r8,5.4222e-03_r8/) + kbo(:, 3,25, 2) = (/ & + &7.7710e-01_r8,6.2349e-01_r8,4.4048e-01_r8,2.4369e-01_r8,5.7195e-03_r8/) + kbo(:, 4,25, 2) = (/ & + &8.0619e-01_r8,6.4737e-01_r8,4.5753e-01_r8,2.5334e-01_r8,5.9744e-03_r8/) + kbo(:, 5,25, 2) = (/ & + &8.3531e-01_r8,6.7147e-01_r8,4.7545e-01_r8,2.6391e-01_r8,6.1951e-03_r8/) + kbo(:, 1,26, 2) = (/ & + &5.5605e-01_r8,4.5118e-01_r8,3.2039e-01_r8,1.7855e-01_r8,4.2346e-03_r8/) + kbo(:, 2,26, 2) = (/ & + &5.8683e-01_r8,4.7392e-01_r8,3.3566e-01_r8,1.8647e-01_r8,4.5042e-03_r8/) + kbo(:, 3,26, 2) = (/ & + &6.1229e-01_r8,4.9380e-01_r8,3.4972e-01_r8,1.9404e-01_r8,4.7382e-03_r8/) + kbo(:, 4,26, 2) = (/ & + &6.3488e-01_r8,5.1281e-01_r8,3.6343e-01_r8,2.0206e-01_r8,4.9373e-03_r8/) + kbo(:, 5,26, 2) = (/ & + &6.5886e-01_r8,5.3298e-01_r8,3.7847e-01_r8,2.1092e-01_r8,5.1112e-03_r8/) + kbo(:, 1,27, 2) = (/ & + &4.5766e-01_r8,3.7194e-01_r8,2.6418e-01_r8,1.4728e-01_r8,3.5266e-03_r8/) + kbo(:, 2,27, 2) = (/ & + &4.8116e-01_r8,3.8971e-01_r8,2.7627e-01_r8,1.5359e-01_r8,3.7388e-03_r8/) + kbo(:, 3,27, 2) = (/ & + &5.0141e-01_r8,4.0592e-01_r8,2.8779e-01_r8,1.5989e-01_r8,3.9220e-03_r8/) + kbo(:, 4,27, 2) = (/ & + &5.1998e-01_r8,4.2171e-01_r8,2.9940e-01_r8,1.6680e-01_r8,4.0803e-03_r8/) + kbo(:, 5,27, 2) = (/ & + &5.4049e-01_r8,4.3926e-01_r8,3.1241e-01_r8,1.7445e-01_r8,4.2171e-03_r8/) + kbo(:, 1,28, 2) = (/ & + &3.8656e-01_r8,3.1440e-01_r8,2.2322e-01_r8,1.2431e-01_r8,2.9341e-03_r8/) + kbo(:, 2,28, 2) = (/ & + &4.0539e-01_r8,3.2888e-01_r8,2.3321e-01_r8,1.2952e-01_r8,3.1008e-03_r8/) + kbo(:, 3,28, 2) = (/ & + &4.2208e-01_r8,3.4256e-01_r8,2.4291e-01_r8,1.3505e-01_r8,3.2456e-03_r8/) + kbo(:, 4,28, 2) = (/ & + &4.3788e-01_r8,3.5618e-01_r8,2.5311e-01_r8,1.4108e-01_r8,3.3707e-03_r8/) + kbo(:, 5,28, 2) = (/ & + &4.5599e-01_r8,3.7197e-01_r8,2.6475e-01_r8,1.4784e-01_r8,3.4778e-03_r8/) + kbo(:, 1,29, 2) = (/ & + &3.4663e-01_r8,2.8147e-01_r8,1.9935e-01_r8,1.1053e-01_r8,2.4407e-03_r8/) + kbo(:, 2,29, 2) = (/ & + &3.6288e-01_r8,2.9416e-01_r8,2.0825e-01_r8,1.1525e-01_r8,2.5726e-03_r8/) + kbo(:, 3,29, 2) = (/ & + &3.7738e-01_r8,3.0636e-01_r8,2.1696e-01_r8,1.2034e-01_r8,2.6876e-03_r8/) + kbo(:, 4,29, 2) = (/ & + &3.9208e-01_r8,3.1911e-01_r8,2.2648e-01_r8,1.2589e-01_r8,2.7881e-03_r8/) + kbo(:, 5,29, 2) = (/ & + &4.0886e-01_r8,3.3389e-01_r8,2.3740e-01_r8,1.3220e-01_r8,2.8698e-03_r8/) + kbo(:, 1,30, 2) = (/ & + &3.1859e-01_r8,2.5807e-01_r8,1.8226e-01_r8,1.0052e-01_r8,2.0286e-03_r8/) + kbo(:, 2,30, 2) = (/ & + &3.3300e-01_r8,2.6960e-01_r8,1.9038e-01_r8,1.0493e-01_r8,2.1345e-03_r8/) + kbo(:, 3,30, 2) = (/ & + &3.4608e-01_r8,2.8079e-01_r8,1.9849e-01_r8,1.0968e-01_r8,2.2264e-03_r8/) + kbo(:, 4,30, 2) = (/ & + &3.6002e-01_r8,2.9303e-01_r8,2.0760e-01_r8,1.1495e-01_r8,2.3052e-03_r8/) + kbo(:, 5,30, 2) = (/ & + &3.7616e-01_r8,3.0718e-01_r8,2.1802e-01_r8,1.2086e-01_r8,2.3703e-03_r8/) + kbo(:, 1,31, 2) = (/ & + &3.0804e-01_r8,2.4854e-01_r8,1.7488e-01_r8,9.5771e-02_r8,1.6879e-03_r8/) + kbo(:, 2,31, 2) = (/ & + &3.2148e-01_r8,2.5954e-01_r8,1.8261e-01_r8,1.0007e-01_r8,1.7724e-03_r8/) + kbo(:, 3,31, 2) = (/ & + &3.3418e-01_r8,2.7047e-01_r8,1.9064e-01_r8,1.0472e-01_r8,1.8461e-03_r8/) + kbo(:, 4,31, 2) = (/ & + &3.4816e-01_r8,2.8282e-01_r8,1.9976e-01_r8,1.0990e-01_r8,1.9082e-03_r8/) + kbo(:, 5,31, 2) = (/ & + &3.6451e-01_r8,2.9706e-01_r8,2.1019e-01_r8,1.1572e-01_r8,1.9578e-03_r8/) + kbo(:, 1,32, 2) = (/ & + &3.0134e-01_r8,2.4222e-01_r8,1.6982e-01_r8,9.2391e-02_r8,1.4045e-03_r8/) + kbo(:, 2,32, 2) = (/ & + &3.1413e-01_r8,2.5288e-01_r8,1.7732e-01_r8,9.6600e-02_r8,1.4719e-03_r8/) + kbo(:, 3,32, 2) = (/ & + &3.2677e-01_r8,2.6386e-01_r8,1.8545e-01_r8,1.0123e-01_r8,1.5309e-03_r8/) + kbo(:, 4,32, 2) = (/ & + &3.4104e-01_r8,2.7646e-01_r8,1.9466e-01_r8,1.0637e-01_r8,1.5796e-03_r8/) + kbo(:, 5,32, 2) = (/ & + &3.5782e-01_r8,2.9105e-01_r8,2.0529e-01_r8,1.1222e-01_r8,1.6199e-03_r8/) + kbo(:, 1,33, 2) = (/ & + &3.0007e-01_r8,2.4036e-01_r8,1.6789e-01_r8,9.0749e-02_r8,1.1692e-03_r8/) + kbo(:, 2,33, 2) = (/ & + &3.1257e-01_r8,2.5093e-01_r8,1.7540e-01_r8,9.4970e-02_r8,1.2231e-03_r8/) + kbo(:, 3,33, 2) = (/ & + &3.2551e-01_r8,2.6224e-01_r8,1.8373e-01_r8,9.9635e-02_r8,1.2703e-03_r8/) + kbo(:, 4,33, 2) = (/ & + &3.4043e-01_r8,2.7535e-01_r8,1.9325e-01_r8,1.0486e-01_r8,1.3103e-03_r8/) + kbo(:, 5,33, 2) = (/ & + &3.5814e-01_r8,2.9066e-01_r8,2.0432e-01_r8,1.1086e-01_r8,1.3413e-03_r8/) + kbo(:, 1,34, 2) = (/ & + &2.9092e-01_r8,2.3257e-01_r8,1.6200e-01_r8,8.7114e-02_r8,9.7104e-04_r8/) + kbo(:, 2,34, 2) = (/ & + &3.0301e-01_r8,2.4286e-01_r8,1.6939e-01_r8,9.1256e-02_r8,1.0146e-03_r8/) + kbo(:, 3,34, 2) = (/ & + &3.1600e-01_r8,2.5431e-01_r8,1.7773e-01_r8,9.5863e-02_r8,1.0532e-03_r8/) + kbo(:, 4,34, 2) = (/ & + &3.3116e-01_r8,2.6756e-01_r8,1.8732e-01_r8,1.0106e-01_r8,1.0840e-03_r8/) + kbo(:, 5,34, 2) = (/ & + &3.4944e-01_r8,2.8336e-01_r8,1.9862e-01_r8,1.0710e-01_r8,1.1076e-03_r8/) + kbo(:, 1,35, 2) = (/ & + &2.8133e-01_r8,2.2448e-01_r8,1.5598e-01_r8,8.3470e-02_r8,8.0326e-04_r8/) + kbo(:, 2,35, 2) = (/ & + &2.9315e-01_r8,2.3461e-01_r8,1.6327e-01_r8,8.7518e-02_r8,8.3948e-04_r8/) + kbo(:, 3,35, 2) = (/ & + &3.0606e-01_r8,2.4602e-01_r8,1.7152e-01_r8,9.2018e-02_r8,8.6953e-04_r8/) + kbo(:, 4,35, 2) = (/ & + &3.2135e-01_r8,2.5937e-01_r8,1.8112e-01_r8,9.7174e-02_r8,8.9330e-04_r8/) + kbo(:, 5,35, 2) = (/ & + &3.3996e-01_r8,2.7548e-01_r8,1.9256e-01_r8,1.0324e-01_r8,9.1326e-04_r8/) + kbo(:, 1,36, 2) = (/ & + &2.6927e-01_r8,2.1450e-01_r8,1.4871e-01_r8,7.9228e-02_r8,6.6044e-04_r8/) + kbo(:, 2,36, 2) = (/ & + &2.8072e-01_r8,2.2434e-01_r8,1.5577e-01_r8,8.3114e-02_r8,6.9019e-04_r8/) + kbo(:, 3,36, 2) = (/ & + &2.9329e-01_r8,2.3546e-01_r8,1.6379e-01_r8,8.7445e-02_r8,7.1471e-04_r8/) + kbo(:, 4,36, 2) = (/ & + &3.0843e-01_r8,2.4872e-01_r8,1.7326e-01_r8,9.2498e-02_r8,7.3506e-04_r8/) + kbo(:, 5,36, 2) = (/ & + &3.2685e-01_r8,2.6470e-01_r8,1.8459e-01_r8,9.8476e-02_r8,7.5121e-04_r8/) + kbo(:, 1,37, 2) = (/ & + &2.4965e-01_r8,1.9865e-01_r8,1.3749e-01_r8,7.2983e-02_r8,5.3914e-04_r8/) + kbo(:, 2,37, 2) = (/ & + &2.6042e-01_r8,2.0789e-01_r8,1.4407e-01_r8,7.6575e-02_r8,5.6372e-04_r8/) + kbo(:, 3,37, 2) = (/ & + &2.7217e-01_r8,2.1833e-01_r8,1.5157e-01_r8,8.0593e-02_r8,5.8448e-04_r8/) + kbo(:, 4,37, 2) = (/ & + &2.8633e-01_r8,2.3076e-01_r8,1.6043e-01_r8,8.5310e-02_r8,6.0216e-04_r8/) + kbo(:, 5,37, 2) = (/ & + &3.0356e-01_r8,2.4582e-01_r8,1.7110e-01_r8,9.0929e-02_r8,6.1615e-04_r8/) + kbo(:, 1,38, 2) = (/ & + &2.3485e-01_r8,1.8661e-01_r8,1.2891e-01_r8,6.8178e-02_r8,4.3970e-04_r8/) + kbo(:, 2,38, 2) = (/ & + &2.4515e-01_r8,1.9543e-01_r8,1.3515e-01_r8,7.1546e-02_r8,4.6052e-04_r8/) + kbo(:, 3,38, 2) = (/ & + &2.5629e-01_r8,2.0533e-01_r8,1.4225e-01_r8,7.5330e-02_r8,4.7811e-04_r8/) + kbo(:, 4,38, 2) = (/ & + &2.6971e-01_r8,2.1715e-01_r8,1.5065e-01_r8,7.9788e-02_r8,4.9330e-04_r8/) + kbo(:, 5,38, 2) = (/ & + &2.8605e-01_r8,2.3151e-01_r8,1.6083e-01_r8,8.5133e-02_r8,5.0547e-04_r8/) + kbo(:, 1,39, 2) = (/ & + &2.2602e-01_r8,1.7927e-01_r8,1.2358e-01_r8,6.5103e-02_r8,3.5893e-04_r8/) + kbo(:, 2,39, 2) = (/ & + &2.3611e-01_r8,1.8789e-01_r8,1.2965e-01_r8,6.8347e-02_r8,3.7626e-04_r8/) + kbo(:, 3,39, 2) = (/ & + &2.4693e-01_r8,1.9751e-01_r8,1.3653e-01_r8,7.1994e-02_r8,3.9112e-04_r8/) + kbo(:, 4,39, 2) = (/ & + &2.5998e-01_r8,2.0903e-01_r8,1.4470e-01_r8,7.6316e-02_r8,4.0431e-04_r8/) + kbo(:, 5,39, 2) = (/ & + &2.7577e-01_r8,2.2297e-01_r8,1.5458e-01_r8,8.1500e-02_r8,4.1520e-04_r8/) + kbo(:, 1,40, 2) = (/ & + &2.0347e-01_r8,1.6128e-01_r8,1.1107e-01_r8,5.8373e-02_r8,2.9088e-04_r8/) + kbo(:, 2,40, 2) = (/ & + &2.1275e-01_r8,1.6921e-01_r8,1.1659e-01_r8,6.1296e-02_r8,3.0550e-04_r8/) + kbo(:, 3,40, 2) = (/ & + &2.2248e-01_r8,1.7787e-01_r8,1.2279e-01_r8,6.4562e-02_r8,3.1830e-04_r8/) + kbo(:, 4,40, 2) = (/ & + &2.3419e-01_r8,1.8824e-01_r8,1.3013e-01_r8,6.8434e-02_r8,3.2975e-04_r8/) + kbo(:, 5,40, 2) = (/ & + &2.4824e-01_r8,2.0081e-01_r8,1.3903e-01_r8,7.3098e-02_r8,3.3913e-04_r8/) + kbo(:, 1,41, 2) = (/ & + &1.8258e-01_r8,1.4470e-01_r8,9.9535e-02_r8,5.2202e-02_r8,2.3535e-04_r8/) + kbo(:, 2,41, 2) = (/ & + &1.9113e-01_r8,1.5197e-01_r8,1.0458e-01_r8,5.4844e-02_r8,2.4773e-04_r8/) + kbo(:, 3,41, 2) = (/ & + &1.9995e-01_r8,1.5977e-01_r8,1.1015e-01_r8,5.7766e-02_r8,2.5866e-04_r8/) + kbo(:, 4,41, 2) = (/ & + &2.1035e-01_r8,1.6906e-01_r8,1.1672e-01_r8,6.1215e-02_r8,2.6866e-04_r8/) + kbo(:, 5,41, 2) = (/ & + &2.2281e-01_r8,1.8031e-01_r8,1.2469e-01_r8,6.5393e-02_r8,2.7675e-04_r8/) + kbo(:, 1,42, 2) = (/ & + &1.6555e-01_r8,1.3118e-01_r8,9.0125e-02_r8,4.7172e-02_r8,1.9035e-04_r8/) + kbo(:, 2,42, 2) = (/ & + &1.7351e-01_r8,1.3791e-01_r8,9.4797e-02_r8,4.9586e-02_r8,2.0086e-04_r8/) + kbo(:, 3,42, 2) = (/ & + &1.8167e-01_r8,1.4504e-01_r8,9.9843e-02_r8,5.2229e-02_r8,2.1016e-04_r8/) + kbo(:, 4,42, 2) = (/ & + &1.9101e-01_r8,1.5346e-01_r8,1.0581e-01_r8,5.5333e-02_r8,2.1875e-04_r8/) + kbo(:, 5,42, 2) = (/ & + &2.0220e-01_r8,1.6362e-01_r8,1.1299e-01_r8,5.9103e-02_r8,2.2587e-04_r8/) + kbo(:, 1,43, 2) = (/ & + &1.5093e-01_r8,1.1961e-01_r8,8.2075e-02_r8,4.2874e-02_r8,1.5326e-04_r8/) + kbo(:, 2,43, 2) = (/ & + &1.5853e-01_r8,1.2589e-01_r8,8.6428e-02_r8,4.5110e-02_r8,1.6227e-04_r8/) + kbo(:, 3,43, 2) = (/ & + &1.6609e-01_r8,1.3244e-01_r8,9.1034e-02_r8,4.7504e-02_r8,1.7029e-04_r8/) + kbo(:, 4,43, 2) = (/ & + &1.7452e-01_r8,1.4008e-01_r8,9.6428e-02_r8,5.0296e-02_r8,1.7773e-04_r8/) + kbo(:, 5,43, 2) = (/ & + &1.8456e-01_r8,1.4921e-01_r8,1.0290e-01_r8,5.3684e-02_r8,1.8398e-04_r8/) + kbo(:, 1,44, 2) = (/ & + &1.3921e-01_r8,1.1030e-01_r8,7.5620e-02_r8,3.9420e-02_r8,1.2316e-04_r8/) + kbo(:, 2,44, 2) = (/ & + &1.4661e-01_r8,1.1628e-01_r8,7.9723e-02_r8,4.1521e-02_r8,1.3084e-04_r8/) + kbo(:, 3,44, 2) = (/ & + &1.5377e-01_r8,1.2242e-01_r8,8.4004e-02_r8,4.3727e-02_r8,1.3764e-04_r8/) + kbo(:, 4,44, 2) = (/ & + &1.6148e-01_r8,1.2941e-01_r8,8.8933e-02_r8,4.6269e-02_r8,1.4416e-04_r8/) + kbo(:, 5,44, 2) = (/ & + &1.7060e-01_r8,1.3772e-01_r8,9.4815e-02_r8,4.9343e-02_r8,1.4964e-04_r8/) + kbo(:, 1,45, 2) = (/ & + &1.3086e-01_r8,1.0364e-01_r8,7.0980e-02_r8,3.6935e-02_r8,9.8771e-05_r8/) + kbo(:, 2,45, 2) = (/ & + &1.3832e-01_r8,1.0957e-01_r8,7.5010e-02_r8,3.8986e-02_r8,1.0533e-04_r8/) + kbo(:, 3,45, 2) = (/ & + &1.4520e-01_r8,1.1543e-01_r8,7.9072e-02_r8,4.1056e-02_r8,1.1127e-04_r8/) + kbo(:, 4,45, 2) = (/ & + &1.5249e-01_r8,1.2195e-01_r8,8.3674e-02_r8,4.3425e-02_r8,1.1690e-04_r8/) + kbo(:, 5,45, 2) = (/ & + &1.6094e-01_r8,1.2967e-01_r8,8.9124e-02_r8,4.6256e-02_r8,1.2176e-04_r8/) + kbo(:, 1,46, 2) = (/ & + &1.2395e-01_r8,9.8133e-02_r8,6.7135e-02_r8,3.4876e-02_r8,7.8972e-05_r8/) + kbo(:, 2,46, 2) = (/ & + &1.3154e-01_r8,1.0413e-01_r8,7.1186e-02_r8,3.6923e-02_r8,8.4580e-05_r8/) + kbo(:, 3,46, 2) = (/ & + &1.3835e-01_r8,1.0981e-01_r8,7.5111e-02_r8,3.8913e-02_r8,8.9707e-05_r8/) + kbo(:, 4,46, 2) = (/ & + &1.4539e-01_r8,1.1598e-01_r8,7.9454e-02_r8,4.1140e-02_r8,9.4570e-05_r8/) + kbo(:, 5,46, 2) = (/ & + &1.5328e-01_r8,1.2322e-01_r8,8.4552e-02_r8,4.3768e-02_r8,9.8952e-05_r8/) + kbo(:, 1,47, 2) = (/ & + &1.1561e-01_r8,9.1621e-02_r8,6.2646e-02_r8,3.2504e-02_r8,6.2836e-05_r8/) + kbo(:, 2,47, 2) = (/ & + &1.2359e-01_r8,9.7799e-02_r8,6.6803e-02_r8,3.4586e-02_r8,6.7612e-05_r8/) + kbo(:, 3,47, 2) = (/ & + &1.3036e-01_r8,1.0330e-01_r8,7.0567e-02_r8,3.6497e-02_r8,7.2040e-05_r8/) + kbo(:, 4,47, 2) = (/ & + &1.3710e-01_r8,1.0912e-01_r8,7.4632e-02_r8,3.8567e-02_r8,7.6196e-05_r8/) + kbo(:, 5,47, 2) = (/ & + &1.4440e-01_r8,1.1580e-01_r8,7.9334e-02_r8,4.0981e-02_r8,8.0080e-05_r8/) + kbo(:, 1,48, 2) = (/ & + &1.1035e-01_r8,8.7581e-02_r8,5.9868e-02_r8,3.1032e-02_r8,4.9884e-05_r8/) + kbo(:, 2,48, 2) = (/ & + &1.1928e-01_r8,9.4310e-02_r8,6.4353e-02_r8,3.3267e-02_r8,5.4019e-05_r8/) + kbo(:, 3,48, 2) = (/ & + &1.2628e-01_r8,9.9898e-02_r8,6.8156e-02_r8,3.5187e-02_r8,5.7777e-05_r8/) + kbo(:, 4,48, 2) = (/ & + &1.3294e-01_r8,1.0557e-01_r8,7.2080e-02_r8,3.7168e-02_r8,6.1393e-05_r8/) + kbo(:, 5,48, 2) = (/ & + &1.3996e-01_r8,1.1191e-01_r8,7.6553e-02_r8,3.9465e-02_r8,6.4815e-05_r8/) + kbo(:, 1,49, 2) = (/ & + &1.0914e-01_r8,8.6684e-02_r8,5.9236e-02_r8,3.0679e-02_r8,3.9521e-05_r8/) + kbo(:, 2,49, 2) = (/ & + &1.1962e-01_r8,9.4485e-02_r8,6.4406e-02_r8,3.3233e-02_r8,4.3077e-05_r8/) + kbo(:, 3,49, 2) = (/ & + &1.2732e-01_r8,1.0058e-01_r8,6.8523e-02_r8,3.5308e-02_r8,4.6318e-05_r8/) + kbo(:, 4,49, 2) = (/ & + &1.3429e-01_r8,1.0636e-01_r8,7.2504e-02_r8,3.7320e-02_r8,4.9451e-05_r8/) + kbo(:, 5,49, 2) = (/ & + &1.4147e-01_r8,1.1268e-01_r8,7.6951e-02_r8,3.9591e-02_r8,5.2405e-05_r8/) + kbo(:, 1,50, 2) = (/ & + &1.0267e-01_r8,8.1582e-02_r8,5.5735e-02_r8,2.8850e-02_r8,3.1268e-05_r8/) + kbo(:, 2,50, 2) = (/ & + &1.1402e-01_r8,9.0165e-02_r8,6.1437e-02_r8,3.1671e-02_r8,3.4319e-05_r8/) + kbo(:, 3,50, 2) = (/ & + &1.2234e-01_r8,9.6602e-02_r8,6.5766e-02_r8,3.3840e-02_r8,3.7076e-05_r8/) + kbo(:, 4,50, 2) = (/ & + &1.2939e-01_r8,1.0230e-01_r8,6.9668e-02_r8,3.5813e-02_r8,3.9737e-05_r8/) + kbo(:, 5,50, 2) = (/ & + &1.3639e-01_r8,1.0837e-01_r8,7.3903e-02_r8,3.7967e-02_r8,4.2232e-05_r8/) + kbo(:, 1,51, 2) = (/ & + &9.4284e-02_r8,7.4953e-02_r8,5.1186e-02_r8,2.6482e-02_r8,2.4659e-05_r8/) + kbo(:, 2,51, 2) = (/ & + &1.0593e-01_r8,8.3948e-02_r8,5.7209e-02_r8,2.9486e-02_r8,2.7298e-05_r8/) + kbo(:, 3,51, 2) = (/ & + &1.1492e-01_r8,9.0727e-02_r8,6.1733e-02_r8,3.1740e-02_r8,2.9657e-05_r8/) + kbo(:, 4,51, 2) = (/ & + &1.2197e-01_r8,9.6371e-02_r8,6.5573e-02_r8,3.3673e-02_r8,3.1882e-05_r8/) + kbo(:, 5,51, 2) = (/ & + &1.2870e-01_r8,1.0212e-01_r8,6.9569e-02_r8,3.5694e-02_r8,3.4030e-05_r8/) + kbo(:, 1,52, 2) = (/ & + &8.8743e-02_r8,7.0542e-02_r8,4.8148e-02_r8,2.4885e-02_r8,1.9415e-05_r8/) + kbo(:, 2,52, 2) = (/ & + &1.0078e-01_r8,7.9976e-02_r8,5.4503e-02_r8,2.8085e-02_r8,2.1689e-05_r8/) + kbo(:, 3,52, 2) = (/ & + &1.1078e-01_r8,8.7454e-02_r8,5.9476e-02_r8,3.0551e-02_r8,2.3703e-05_r8/) + kbo(:, 4,52, 2) = (/ & + &1.1817e-01_r8,9.3325e-02_r8,6.3448e-02_r8,3.2545e-02_r8,2.5596e-05_r8/) + kbo(:, 5,52, 2) = (/ & + &1.2490e-01_r8,9.8940e-02_r8,6.7340e-02_r8,3.4514e-02_r8,2.7422e-05_r8/) + kbo(:, 1,53, 2) = (/ & + &8.6662e-02_r8,6.8864e-02_r8,4.6962e-02_r8,2.4236e-02_r8,1.5263e-05_r8/) + kbo(:, 2,53, 2) = (/ & + &9.9515e-02_r8,7.8952e-02_r8,5.3787e-02_r8,2.7692e-02_r8,1.7200e-05_r8/) + kbo(:, 3,53, 2) = (/ & + &1.1085e-01_r8,8.7554e-02_r8,5.9520e-02_r8,3.0542e-02_r8,1.8920e-05_r8/) + kbo(:, 4,53, 2) = (/ & + &1.1918e-01_r8,9.4022e-02_r8,6.3885e-02_r8,3.2726e-02_r8,2.0582e-05_r8/) + kbo(:, 5,53, 2) = (/ & + &1.2628e-01_r8,9.9818e-02_r8,6.7862e-02_r8,3.4747e-02_r8,2.2128e-05_r8/) + kbo(:, 1,54, 2) = (/ & + &7.3195e-02_r8,5.8286e-02_r8,3.9755e-02_r8,2.0520e-02_r8,1.1967e-05_r8/) + kbo(:, 2,54, 2) = (/ & + &8.4972e-02_r8,6.7544e-02_r8,4.6023e-02_r8,2.3702e-02_r8,1.3585e-05_r8/) + kbo(:, 3,54, 2) = (/ & + &9.5709e-02_r8,7.5855e-02_r8,5.1595e-02_r8,2.6489e-02_r8,1.5051e-05_r8/) + kbo(:, 4,54, 2) = (/ & + &1.0394e-01_r8,8.2096e-02_r8,5.5779e-02_r8,2.8575e-02_r8,1.6406e-05_r8/) + kbo(:, 5,54, 2) = (/ & + &1.1051e-01_r8,8.7391e-02_r8,5.9394e-02_r8,3.0393e-02_r8,1.7745e-05_r8/) + kbo(:, 1,55, 2) = (/ & + &5.6277e-02_r8,4.4947e-02_r8,3.0672e-02_r8,1.5850e-02_r8,9.3585e-06_r8/) + kbo(:, 2,55, 2) = (/ & + &6.6102e-02_r8,5.2729e-02_r8,3.5949e-02_r8,1.8531e-02_r8,1.0684e-05_r8/) + kbo(:, 3,55, 2) = (/ & + &7.5193e-02_r8,5.9877e-02_r8,4.0765e-02_r8,2.0959e-02_r8,1.1938e-05_r8/) + kbo(:, 4,55, 2) = (/ & + &8.2620e-02_r8,6.5458e-02_r8,4.4488e-02_r8,2.2798e-02_r8,1.3050e-05_r8/) + kbo(:, 5,55, 2) = (/ & + &8.8216e-02_r8,6.9936e-02_r8,4.7530e-02_r8,2.4316e-02_r8,1.4154e-05_r8/) + kbo(:, 1,56, 2) = (/ & + &4.3039e-02_r8,3.4453e-02_r8,2.3524e-02_r8,1.2170e-02_r8,7.2880e-06_r8/) + kbo(:, 2,56, 2) = (/ & + &5.1258e-02_r8,4.1038e-02_r8,2.7994e-02_r8,1.4446e-02_r8,8.3961e-06_r8/) + kbo(:, 3,56, 2) = (/ & + &5.8906e-02_r8,4.7098e-02_r8,3.2089e-02_r8,1.6519e-02_r8,9.4488e-06_r8/) + kbo(:, 4,56, 2) = (/ & + &6.5506e-02_r8,5.2094e-02_r8,3.5421e-02_r8,1.8161e-02_r8,1.0382e-05_r8/) + kbo(:, 5,56, 2) = (/ & + &7.0360e-02_r8,5.5940e-02_r8,3.8018e-02_r8,1.9445e-02_r8,1.1248e-05_r8/) + kbo(:, 1,57, 2) = (/ & + &3.2674e-02_r8,2.6237e-02_r8,1.7922e-02_r8,9.2805e-03_r8,5.6715e-06_r8/) + kbo(:, 2,57, 2) = (/ & + &3.9609e-02_r8,3.1835e-02_r8,2.1730e-02_r8,1.1223e-02_r8,6.5904e-06_r8/) + kbo(:, 3,57, 2) = (/ & + &4.6006e-02_r8,3.6922e-02_r8,2.5172e-02_r8,1.2973e-02_r8,7.4542e-06_r8/) + kbo(:, 4,57, 2) = (/ & + &5.1740e-02_r8,4.1352e-02_r8,2.8137e-02_r8,1.4436e-02_r8,8.2537e-06_r8/) + kbo(:, 5,57, 2) = (/ & + &5.6054e-02_r8,4.4686e-02_r8,3.0382e-02_r8,1.5541e-02_r8,8.9675e-06_r8/) + kbo(:, 1,58, 2) = (/ & + &6.5163e-03_r8,6.4215e-03_r8,5.6470e-03_r8,4.1032e-03_r8,4.4127e-06_r8/) + kbo(:, 2,58, 2) = (/ & + &8.0617e-03_r8,7.9508e-03_r8,6.9853e-03_r8,5.0619e-03_r8,5.1550e-06_r8/) + kbo(:, 3,58, 2) = (/ & + &9.4685e-03_r8,9.3297e-03_r8,8.1872e-03_r8,5.9187e-03_r8,5.8809e-06_r8/) + kbo(:, 4,58, 2) = (/ & + &1.0753e-02_r8,1.0568e-02_r8,9.2585e-03_r8,6.6629e-03_r8,6.5571e-06_r8/) + kbo(:, 5,58, 2) = (/ & + &1.1773e-02_r8,1.1514e-02_r8,1.0073e-02_r8,7.2198e-03_r8,7.1478e-06_r8/) + kbo(:, 1,59, 2) = (/ & + &6.0678e-03_r8,5.7484e-03_r8,4.7181e-03_r8,3.0625e-03_r8,3.5292e-06_r8/) + kbo(:, 2,59, 2) = (/ & + &7.5775e-03_r8,7.1843e-03_r8,5.8871e-03_r8,3.8076e-03_r8,4.1244e-06_r8/) + kbo(:, 3,59, 2) = (/ & + &8.9504e-03_r8,8.4793e-03_r8,6.9385e-03_r8,4.4706e-03_r8,4.7056e-06_r8/) + kbo(:, 4,59, 2) = (/ & + &1.0202e-02_r8,9.6400e-03_r8,7.8732e-03_r8,5.0416e-03_r8,5.2546e-06_r8/) + kbo(:, 5,59, 2) = (/ & + &1.1221e-02_r8,1.0539e-02_r8,8.5853e-03_r8,5.4711e-03_r8,5.7591e-06_r8/) + kbo(:, 1,13, 3) = (/ & + &1.3886e+02_r8,1.0424e+02_r8,6.9618e+01_r8,3.4998e+01_r8,6.8908e-02_r8/) + kbo(:, 2,13, 3) = (/ & + &1.3847e+02_r8,1.0394e+02_r8,6.9423e+01_r8,3.4905e+01_r8,7.3584e-02_r8/) + kbo(:, 3,13, 3) = (/ & + &1.3854e+02_r8,1.0400e+02_r8,6.9461e+01_r8,3.4924e+01_r8,7.8137e-02_r8/) + kbo(:, 4,13, 3) = (/ & + &1.4034e+02_r8,1.0534e+02_r8,7.0354e+01_r8,3.5368e+01_r8,8.2835e-02_r8/) + kbo(:, 5,13, 3) = (/ & + &1.4333e+02_r8,1.0759e+02_r8,7.1853e+01_r8,3.6116e+01_r8,8.7500e-02_r8/) + kbo(:, 1,14, 3) = (/ & + &7.1765e+01_r8,5.3918e+01_r8,3.6073e+01_r8,1.8228e+01_r8,5.9867e-02_r8/) + kbo(:, 2,14, 3) = (/ & + &7.1567e+01_r8,5.3771e+01_r8,3.5977e+01_r8,1.8183e+01_r8,6.3947e-02_r8/) + kbo(:, 3,14, 3) = (/ & + &7.1902e+01_r8,5.4021e+01_r8,3.6141e+01_r8,1.8266e+01_r8,6.8160e-02_r8/) + kbo(:, 4,14, 3) = (/ & + &7.3101e+01_r8,5.4919e+01_r8,3.6739e+01_r8,1.8569e+01_r8,7.2138e-02_r8/) + kbo(:, 5,14, 3) = (/ & + &7.4813e+01_r8,5.6202e+01_r8,3.7593e+01_r8,1.8992e+01_r8,7.6299e-02_r8/) + kbo(:, 1,15, 3) = (/ & + &3.7762e+01_r8,2.8418e+01_r8,1.9073e+01_r8,9.7323e+00_r8,5.1937e-02_r8/) + kbo(:, 2,15, 3) = (/ & + &3.7725e+01_r8,2.8390e+01_r8,1.9057e+01_r8,9.7303e+00_r8,5.5591e-02_r8/) + kbo(:, 3,15, 3) = (/ & + &3.8048e+01_r8,2.8634e+01_r8,1.9221e+01_r8,9.8224e+00_r8,5.9263e-02_r8/) + kbo(:, 4,15, 3) = (/ & + &3.8784e+01_r8,2.9182e+01_r8,1.9585e+01_r8,1.0010e+01_r8,6.2883e-02_r8/) + kbo(:, 5,15, 3) = (/ & + &3.9804e+01_r8,2.9945e+01_r8,2.0089e+01_r8,1.0260e+01_r8,6.6326e-02_r8/) + kbo(:, 1,16, 3) = (/ & + &2.3667e+01_r8,1.7845e+01_r8,1.2024e+01_r8,6.2150e+00_r8,4.4961e-02_r8/) + kbo(:, 2,16, 3) = (/ & + &2.3710e+01_r8,1.7881e+01_r8,1.2053e+01_r8,6.2413e+00_r8,4.8227e-02_r8/) + kbo(:, 3,16, 3) = (/ & + &2.3983e+01_r8,1.8085e+01_r8,1.2193e+01_r8,6.3263e+00_r8,5.1418e-02_r8/) + kbo(:, 4,16, 3) = (/ & + &2.4541e+01_r8,1.8499e+01_r8,1.2468e+01_r8,6.4708e+00_r8,5.4587e-02_r8/) + kbo(:, 5,16, 3) = (/ & + &2.5247e+01_r8,1.9026e+01_r8,1.2815e+01_r8,6.6457e+00_r8,5.7578e-02_r8/) + kbo(:, 1,17, 3) = (/ & + &1.5411e+01_r8,1.1654e+01_r8,7.9029e+00_r8,4.1290e+00_r8,3.8761e-02_r8/) + kbo(:, 2,17, 3) = (/ & + &1.5483e+01_r8,1.1712e+01_r8,7.9484e+00_r8,4.1656e+00_r8,4.1564e-02_r8/) + kbo(:, 3,17, 3) = (/ & + &1.5715e+01_r8,1.1885e+01_r8,8.0713e+00_r8,4.2451e+00_r8,4.4369e-02_r8/) + kbo(:, 4,17, 3) = (/ & + &1.6109e+01_r8,1.2177e+01_r8,8.2663e+00_r8,4.3534e+00_r8,4.7100e-02_r8/) + kbo(:, 5,17, 3) = (/ & + &1.6611e+01_r8,1.2551e+01_r8,8.5125e+00_r8,4.4825e+00_r8,4.9594e-02_r8/) + kbo(:, 1,18, 3) = (/ & + &1.0325e+01_r8,7.8390e+00_r8,5.3612e+00_r8,2.8294e+00_r8,3.3186e-02_r8/) + kbo(:, 2,18, 3) = (/ & + &1.0398e+01_r8,7.8984e+00_r8,5.4111e+00_r8,2.8675e+00_r8,3.5625e-02_r8/) + kbo(:, 3,18, 3) = (/ & + &1.0571e+01_r8,8.0297e+00_r8,5.5102e+00_r8,2.9332e+00_r8,3.8042e-02_r8/) + kbo(:, 4,18, 3) = (/ & + &1.0854e+01_r8,8.2395e+00_r8,5.6528e+00_r8,3.0140e+00_r8,4.0327e-02_r8/) + kbo(:, 5,18, 3) = (/ & + &1.1221e+01_r8,8.5111e+00_r8,5.8333e+00_r8,3.1124e+00_r8,4.2414e-02_r8/) + kbo(:, 1,19, 3) = (/ & + &6.8208e+00_r8,5.2153e+00_r8,3.5957e+00_r8,1.9227e+00_r8,2.8261e-02_r8/) + kbo(:, 2,19, 3) = (/ & + &6.8751e+00_r8,5.2621e+00_r8,3.6379e+00_r8,1.9560e+00_r8,3.0383e-02_r8/) + kbo(:, 3,19, 3) = (/ & + &7.0006e+00_r8,5.3588e+00_r8,3.7145e+00_r8,2.0054e+00_r8,3.2394e-02_r8/) + kbo(:, 4,19, 3) = (/ & + &7.2016e+00_r8,5.5069e+00_r8,3.8180e+00_r8,2.0649e+00_r8,3.4293e-02_r8/) + kbo(:, 5,19, 3) = (/ & + &7.4662e+00_r8,5.7018e+00_r8,3.9518e+00_r8,2.1403e+00_r8,3.6047e-02_r8/) + kbo(:, 1,20, 3) = (/ & + &4.8794e+00_r8,3.7616e+00_r8,2.6099e+00_r8,1.4082e+00_r8,2.4010e-02_r8/) + kbo(:, 2,20, 3) = (/ & + &4.9222e+00_r8,3.8008e+00_r8,2.6471e+00_r8,1.4364e+00_r8,2.5795e-02_r8/) + kbo(:, 3,20, 3) = (/ & + &5.0241e+00_r8,3.8811e+00_r8,2.7106e+00_r8,1.4758e+00_r8,2.7487e-02_r8/) + kbo(:, 4,20, 3) = (/ & + &5.1822e+00_r8,3.9983e+00_r8,2.7942e+00_r8,1.5252e+00_r8,2.9078e-02_r8/) + kbo(:, 5,20, 3) = (/ & + &5.3938e+00_r8,4.1543e+00_r8,2.9036e+00_r8,1.5872e+00_r8,3.0457e-02_r8/) + kbo(:, 1,21, 3) = (/ & + &3.5976e+00_r8,2.7957e+00_r8,1.9525e+00_r8,1.0602e+00_r8,2.0310e-02_r8/) + kbo(:, 2,21, 3) = (/ & + &3.6356e+00_r8,2.8321e+00_r8,1.9867e+00_r8,1.0846e+00_r8,2.1803e-02_r8/) + kbo(:, 3,21, 3) = (/ & + &3.7222e+00_r8,2.9011e+00_r8,2.0401e+00_r8,1.1175e+00_r8,2.3227e-02_r8/) + kbo(:, 4,21, 3) = (/ & + &3.8497e+00_r8,2.9972e+00_r8,2.1098e+00_r8,1.1593e+00_r8,2.4505e-02_r8/) + kbo(:, 5,21, 3) = (/ & + &4.0214e+00_r8,3.1255e+00_r8,2.2004e+00_r8,1.2111e+00_r8,2.5550e-02_r8/) + kbo(:, 1,22, 3) = (/ & + &2.7203e+00_r8,2.1314e+00_r8,1.4964e+00_r8,8.1782e-01_r8,1.7205e-02_r8/) + kbo(:, 2,22, 3) = (/ & + &2.7584e+00_r8,2.1682e+00_r8,1.5287e+00_r8,8.3963e-01_r8,1.8458e-02_r8/) + kbo(:, 3,22, 3) = (/ & + &2.8354e+00_r8,2.2296e+00_r8,1.5749e+00_r8,8.6850e-01_r8,1.9598e-02_r8/) + kbo(:, 4,22, 3) = (/ & + &2.9415e+00_r8,2.3111e+00_r8,1.6346e+00_r8,9.0426e-01_r8,2.0559e-02_r8/) + kbo(:, 5,22, 3) = (/ & + &3.0867e+00_r8,2.4212e+00_r8,1.7134e+00_r8,9.4960e-01_r8,2.1311e-02_r8/) + kbo(:, 1,23, 3) = (/ & + &2.0695e+00_r8,1.6369e+00_r8,1.1532e+00_r8,6.3485e-01_r8,1.4544e-02_r8/) + kbo(:, 2,23, 3) = (/ & + &2.1080e+00_r8,1.6730e+00_r8,1.1833e+00_r8,6.5423e-01_r8,1.5557e-02_r8/) + kbo(:, 3,23, 3) = (/ & + &2.1745e+00_r8,1.7262e+00_r8,1.2233e+00_r8,6.7947e-01_r8,1.6419e-02_r8/) + kbo(:, 4,23, 3) = (/ & + &2.2647e+00_r8,1.7970e+00_r8,1.2752e+00_r8,7.1089e-01_r8,1.7120e-02_r8/) + kbo(:, 5,23, 3) = (/ & + &2.3823e+00_r8,1.8879e+00_r8,1.3412e+00_r8,7.4903e-01_r8,1.7674e-02_r8/) + kbo(:, 1,24, 3) = (/ & + &1.5697e+00_r8,1.2531e+00_r8,8.8637e-01_r8,4.9139e-01_r8,1.2257e-02_r8/) + kbo(:, 2,24, 3) = (/ & + &1.6055e+00_r8,1.2864e+00_r8,9.1332e-01_r8,5.0866e-01_r8,1.3031e-02_r8/) + kbo(:, 3,24, 3) = (/ & + &1.6631e+00_r8,1.3329e+00_r8,9.4834e-01_r8,5.3086e-01_r8,1.3670e-02_r8/) + kbo(:, 4,24, 3) = (/ & + &1.7374e+00_r8,1.3923e+00_r8,9.9245e-01_r8,5.5764e-01_r8,1.4194e-02_r8/) + kbo(:, 5,24, 3) = (/ & + &1.8327e+00_r8,1.4671e+00_r8,1.0467e+00_r8,5.8890e-01_r8,1.4611e-02_r8/) + kbo(:, 1,25, 3) = (/ & + &1.2086e+00_r8,9.7309e-01_r8,6.9155e-01_r8,3.8568e-01_r8,1.0281e-02_r8/) + kbo(:, 2,25, 3) = (/ & + &1.2420e+00_r8,1.0035e+00_r8,7.1528e-01_r8,4.0109e-01_r8,1.0857e-02_r8/) + kbo(:, 3,25, 3) = (/ & + &1.2906e+00_r8,1.0433e+00_r8,7.4566e-01_r8,4.2042e-01_r8,1.1339e-02_r8/) + kbo(:, 4,25, 3) = (/ & + &1.3533e+00_r8,1.0941e+00_r8,7.8339e-01_r8,4.4308e-01_r8,1.1737e-02_r8/) + kbo(:, 5,25, 3) = (/ & + &1.4315e+00_r8,1.1563e+00_r8,8.2868e-01_r8,4.6855e-01_r8,1.2054e-02_r8/) + kbo(:, 1,26, 3) = (/ & + &9.4867e-01_r8,7.6987e-01_r8,5.4929e-01_r8,3.0788e-01_r8,8.5827e-03_r8/) + kbo(:, 2,26, 3) = (/ & + &9.7957e-01_r8,7.9721e-01_r8,5.7050e-01_r8,3.2189e-01_r8,9.0225e-03_r8/) + kbo(:, 3,26, 3) = (/ & + &1.0209e+00_r8,8.3198e-01_r8,5.9699e-01_r8,3.3862e-01_r8,9.3908e-03_r8/) + kbo(:, 4,26, 3) = (/ & + &1.0742e+00_r8,8.7561e-01_r8,6.2951e-01_r8,3.5776e-01_r8,9.6952e-03_r8/) + kbo(:, 5,26, 3) = (/ & + &1.1410e+00_r8,9.2907e-01_r8,6.6837e-01_r8,3.7907e-01_r8,9.9345e-03_r8/) + kbo(:, 1,27, 3) = (/ & + &7.7558e-01_r8,6.3324e-01_r8,4.5279e-01_r8,2.5468e-01_r8,7.1414e-03_r8/) + kbo(:, 2,27, 3) = (/ & + &8.0374e-01_r8,6.5793e-01_r8,4.7219e-01_r8,2.6746e-01_r8,7.4832e-03_r8/) + kbo(:, 3,27, 3) = (/ & + &8.4002e-01_r8,6.8874e-01_r8,4.9567e-01_r8,2.8203e-01_r8,7.7674e-03_r8/) + kbo(:, 4,27, 3) = (/ & + &8.8798e-01_r8,7.2827e-01_r8,5.2483e-01_r8,2.9866e-01_r8,7.9993e-03_r8/) + kbo(:, 5,27, 3) = (/ & + &9.4670e-01_r8,7.7585e-01_r8,5.5890e-01_r8,3.1722e-01_r8,8.1810e-03_r8/) + kbo(:, 1,28, 3) = (/ & + &6.5247e-01_r8,5.3505e-01_r8,3.8309e-01_r8,2.1606e-01_r8,5.9313e-03_r8/) + kbo(:, 2,28, 3) = (/ & + &6.7805e-01_r8,5.5765e-01_r8,4.0088e-01_r8,2.2763e-01_r8,6.1964e-03_r8/) + kbo(:, 3,28, 3) = (/ & + &7.1138e-01_r8,5.8602e-01_r8,4.2234e-01_r8,2.4051e-01_r8,6.4170e-03_r8/) + kbo(:, 4,28, 3) = (/ & + &7.5565e-01_r8,6.2271e-01_r8,4.4913e-01_r8,2.5531e-01_r8,6.5956e-03_r8/) + kbo(:, 5,28, 3) = (/ & + &8.0810e-01_r8,6.6536e-01_r8,4.7931e-01_r8,2.7186e-01_r8,6.7356e-03_r8/) + kbo(:, 1,29, 3) = (/ & + &5.8359e-01_r8,4.7922e-01_r8,3.4299e-01_r8,1.9330e-01_r8,4.9222e-03_r8/) + kbo(:, 2,29, 3) = (/ & + &6.0836e-01_r8,5.0105e-01_r8,3.5992e-01_r8,2.0402e-01_r8,5.1279e-03_r8/) + kbo(:, 3,29, 3) = (/ & + &6.4169e-01_r8,5.2929e-01_r8,3.8096e-01_r8,2.1613e-01_r8,5.2989e-03_r8/) + kbo(:, 4,29, 3) = (/ & + &6.8418e-01_r8,5.6479e-01_r8,4.0659e-01_r8,2.3010e-01_r8,5.4376e-03_r8/) + kbo(:, 5,29, 3) = (/ & + &7.3388e-01_r8,6.0487e-01_r8,4.3487e-01_r8,2.4554e-01_r8,5.5459e-03_r8/) + kbo(:, 1,30, 3) = (/ & + &5.3559e-01_r8,4.3987e-01_r8,3.1446e-01_r8,1.7681e-01_r8,4.0812e-03_r8/) + kbo(:, 2,30, 3) = (/ & + &5.6092e-01_r8,4.6195e-01_r8,3.3123e-01_r8,1.8699e-01_r8,4.2410e-03_r8/) + kbo(:, 3,30, 3) = (/ & + &5.9467e-01_r8,4.9061e-01_r8,3.5234e-01_r8,1.9880e-01_r8,4.3756e-03_r8/) + kbo(:, 4,30, 3) = (/ & + &6.3620e-01_r8,5.2529e-01_r8,3.7692e-01_r8,2.1218e-01_r8,4.4820e-03_r8/) + kbo(:, 5,30, 3) = (/ & + &6.8416e-01_r8,5.6390e-01_r8,4.0420e-01_r8,2.2692e-01_r8,4.5637e-03_r8/) + kbo(:, 1,31, 3) = (/ & + &5.1816e-01_r8,4.2464e-01_r8,3.0261e-01_r8,1.6922e-01_r8,3.3825e-03_r8/) + kbo(:, 2,31, 3) = (/ & + &5.4536e-01_r8,4.4814e-01_r8,3.2013e-01_r8,1.7945e-01_r8,3.5084e-03_r8/) + kbo(:, 3,31, 3) = (/ & + &5.8079e-01_r8,4.7822e-01_r8,3.4203e-01_r8,1.9145e-01_r8,3.6133e-03_r8/) + kbo(:, 4,31, 3) = (/ & + &6.2360e-01_r8,5.1355e-01_r8,3.6685e-01_r8,2.0495e-01_r8,3.6964e-03_r8/) + kbo(:, 5,31, 3) = (/ & + &6.7136e-01_r8,5.5242e-01_r8,3.9433e-01_r8,2.1968e-01_r8,3.7632e-03_r8/) + kbo(:, 1,32, 3) = (/ & + &5.0836e-01_r8,4.1565e-01_r8,2.9513e-01_r8,1.6401e-01_r8,2.8023e-03_r8/) + kbo(:, 2,32, 3) = (/ & + &5.3755e-01_r8,4.4081e-01_r8,3.1373e-01_r8,1.7458e-01_r8,2.9031e-03_r8/) + kbo(:, 3,32, 3) = (/ & + &5.7518e-01_r8,4.7260e-01_r8,3.3647e-01_r8,1.8685e-01_r8,2.9841e-03_r8/) + kbo(:, 4,32, 3) = (/ & + &6.1917e-01_r8,5.0863e-01_r8,3.6188e-01_r8,2.0060e-01_r8,3.0523e-03_r8/) + kbo(:, 5,32, 3) = (/ & + &6.6737e-01_r8,5.4799e-01_r8,3.8954e-01_r8,2.1543e-01_r8,3.1032e-03_r8/) + kbo(:, 1,33, 3) = (/ & + &5.0907e-01_r8,4.1513e-01_r8,2.9365e-01_r8,1.6205e-01_r8,2.3233e-03_r8/) + kbo(:, 2,33, 3) = (/ & + &5.4095e-01_r8,4.4243e-01_r8,3.1363e-01_r8,1.7315e-01_r8,2.4017e-03_r8/) + kbo(:, 3,33, 3) = (/ & + &5.8099e-01_r8,4.7617e-01_r8,3.3742e-01_r8,1.8595e-01_r8,2.4676e-03_r8/) + kbo(:, 4,33, 3) = (/ & + &6.2648e-01_r8,5.1328e-01_r8,3.6375e-01_r8,2.0009e-01_r8,2.5196e-03_r8/) + kbo(:, 5,33, 3) = (/ & + &6.7646e-01_r8,5.5394e-01_r8,3.9218e-01_r8,2.1533e-01_r8,2.5609e-03_r8/) + kbo(:, 1,34, 3) = (/ & + &4.9704e-01_r8,4.0480e-01_r8,2.8555e-01_r8,1.5673e-01_r8,1.9225e-03_r8/) + kbo(:, 2,34, 3) = (/ & + &5.3069e-01_r8,4.3364e-01_r8,3.0643e-01_r8,1.6807e-01_r8,1.9847e-03_r8/) + kbo(:, 3,34, 3) = (/ & + &5.7151e-01_r8,4.6776e-01_r8,3.3046e-01_r8,1.8101e-01_r8,2.0370e-03_r8/) + kbo(:, 4,34, 3) = (/ & + &6.1711e-01_r8,5.0510e-01_r8,3.5686e-01_r8,1.9508e-01_r8,2.0801e-03_r8/) + kbo(:, 5,34, 3) = (/ & + &6.6746e-01_r8,5.4585e-01_r8,3.8550e-01_r8,2.1045e-01_r8,2.1144e-03_r8/) + kbo(:, 1,35, 3) = (/ & + &4.8386e-01_r8,3.9362e-01_r8,2.7689e-01_r8,1.5116e-01_r8,1.5847e-03_r8/) + kbo(:, 2,35, 3) = (/ & + &5.1832e-01_r8,4.2323e-01_r8,2.9822e-01_r8,1.6263e-01_r8,1.6362e-03_r8/) + kbo(:, 3,35, 3) = (/ & + &5.5929e-01_r8,4.5721e-01_r8,3.2219e-01_r8,1.7550e-01_r8,1.6795e-03_r8/) + kbo(:, 4,35, 3) = (/ & + &6.0482e-01_r8,4.9463e-01_r8,3.4852e-01_r8,1.8949e-01_r8,1.7156e-03_r8/) + kbo(:, 5,35, 3) = (/ & + &6.5512e-01_r8,5.3534e-01_r8,3.7729e-01_r8,2.0487e-01_r8,1.7410e-03_r8/) + kbo(:, 1,36, 3) = (/ & + &4.6553e-01_r8,3.7836e-01_r8,2.6548e-01_r8,1.4421e-01_r8,1.3024e-03_r8/) + kbo(:, 2,36, 3) = (/ & + &4.9953e-01_r8,4.0773e-01_r8,2.8657e-01_r8,1.5552e-01_r8,1.3449e-03_r8/) + kbo(:, 3,36, 3) = (/ & + &5.3980e-01_r8,4.4109e-01_r8,3.1015e-01_r8,1.6814e-01_r8,1.3813e-03_r8/) + kbo(:, 4,36, 3) = (/ & + &5.8461e-01_r8,4.7793e-01_r8,3.3603e-01_r8,1.8187e-01_r8,1.4105e-03_r8/) + kbo(:, 5,36, 3) = (/ & + &6.3401e-01_r8,5.1804e-01_r8,3.6447e-01_r8,1.9702e-01_r8,1.4329e-03_r8/) + kbo(:, 1,37, 3) = (/ & + &4.3247e-01_r8,3.5136e-01_r8,2.4603e-01_r8,1.3313e-01_r8,1.0644e-03_r8/) + kbo(:, 2,37, 3) = (/ & + &4.6409e-01_r8,3.7893e-01_r8,2.6588e-01_r8,1.4378e-01_r8,1.1011e-03_r8/) + kbo(:, 3,37, 3) = (/ & + &5.0193e-01_r8,4.1040e-01_r8,2.8814e-01_r8,1.5568e-01_r8,1.1313e-03_r8/) + kbo(:, 4,37, 3) = (/ & + &5.4423e-01_r8,4.4538e-01_r8,3.1275e-01_r8,1.6870e-01_r8,1.1563e-03_r8/) + kbo(:, 5,37, 3) = (/ & + &5.9125e-01_r8,4.8359e-01_r8,3.3982e-01_r8,1.8310e-01_r8,1.1762e-03_r8/) + kbo(:, 1,38, 3) = (/ & + &4.0752e-01_r8,3.3084e-01_r8,2.3116e-01_r8,1.2457e-01_r8,8.6985e-04_r8/) + kbo(:, 2,38, 3) = (/ & + &4.3734e-01_r8,3.5701e-01_r8,2.5006e-01_r8,1.3472e-01_r8,9.0011e-04_r8/) + kbo(:, 3,38, 3) = (/ & + &4.7342e-01_r8,3.8717e-01_r8,2.7137e-01_r8,1.4611e-01_r8,9.2699e-04_r8/) + kbo(:, 4,38, 3) = (/ & + &5.1398e-01_r8,4.2080e-01_r8,2.9507e-01_r8,1.5862e-01_r8,9.4795e-04_r8/) + kbo(:, 5,38, 3) = (/ & + &5.5926e-01_r8,4.5769e-01_r8,3.2123e-01_r8,1.7252e-01_r8,9.6539e-04_r8/) + kbo(:, 1,39, 3) = (/ & + &3.9286e-01_r8,3.1853e-01_r8,2.2204e-01_r8,1.1910e-01_r8,7.1027e-04_r8/) + kbo(:, 2,39, 3) = (/ & + &4.2168e-01_r8,3.4392e-01_r8,2.4040e-01_r8,1.2899e-01_r8,7.3606e-04_r8/) + kbo(:, 3,39, 3) = (/ & + &4.5685e-01_r8,3.7344e-01_r8,2.6129e-01_r8,1.4014e-01_r8,7.5956e-04_r8/) + kbo(:, 4,39, 3) = (/ & + &4.9667e-01_r8,4.0652e-01_r8,2.8462e-01_r8,1.5245e-01_r8,7.7770e-04_r8/) + kbo(:, 5,39, 3) = (/ & + &5.4133e-01_r8,4.4296e-01_r8,3.1045e-01_r8,1.6619e-01_r8,7.9334e-04_r8/) + kbo(:, 1,40, 3) = (/ & + &3.5355e-01_r8,2.8669e-01_r8,1.9956e-01_r8,1.0673e-01_r8,5.7721e-04_r8/) + kbo(:, 2,40, 3) = (/ & + &3.7907e-01_r8,3.0944e-01_r8,2.1608e-01_r8,1.1569e-01_r8,5.9933e-04_r8/) + kbo(:, 3,40, 3) = (/ & + &4.1075e-01_r8,3.3635e-01_r8,2.3514e-01_r8,1.2587e-01_r8,6.1943e-04_r8/) + kbo(:, 4,40, 3) = (/ & + &4.4707e-01_r8,3.6668e-01_r8,2.5658e-01_r8,1.3717e-01_r8,6.3526e-04_r8/) + kbo(:, 5,40, 3) = (/ & + &4.8803e-01_r8,4.0025e-01_r8,2.8039e-01_r8,1.4981e-01_r8,6.4905e-04_r8/) + kbo(:, 1,41, 3) = (/ & + &3.1722e-01_r8,2.5721e-01_r8,1.7878e-01_r8,9.5352e-02_r8,4.6830e-04_r8/) + kbo(:, 2,41, 3) = (/ & + &3.3984e-01_r8,2.7762e-01_r8,1.9366e-01_r8,1.0349e-01_r8,4.8763e-04_r8/) + kbo(:, 3,41, 3) = (/ & + &3.6801e-01_r8,3.0195e-01_r8,2.1092e-01_r8,1.1268e-01_r8,5.0461e-04_r8/) + kbo(:, 4,41, 3) = (/ & + &4.0101e-01_r8,3.2964e-01_r8,2.3053e-01_r8,1.2303e-01_r8,5.1866e-04_r8/) + kbo(:, 5,41, 3) = (/ & + &4.3854e-01_r8,3.6057e-01_r8,2.5249e-01_r8,1.3467e-01_r8,5.3060e-04_r8/) + kbo(:, 1,42, 3) = (/ & + &2.8780e-01_r8,2.3320e-01_r8,1.6182e-01_r8,8.6050e-02_r8,3.7987e-04_r8/) + kbo(:, 2,42, 3) = (/ & + &3.0806e-01_r8,2.5171e-01_r8,1.7535e-01_r8,9.3494e-02_r8,3.9649e-04_r8/) + kbo(:, 3,42, 3) = (/ & + &3.3326e-01_r8,2.7383e-01_r8,1.9111e-01_r8,1.0188e-01_r8,4.1103e-04_r8/) + kbo(:, 4,42, 3) = (/ & + &3.6352e-01_r8,2.9931e-01_r8,2.0921e-01_r8,1.1145e-01_r8,4.2329e-04_r8/) + kbo(:, 5,42, 3) = (/ & + &3.9814e-01_r8,3.2805e-01_r8,2.2962e-01_r8,1.2223e-01_r8,4.3386e-04_r8/) + kbo(:, 1,43, 3) = (/ & + &2.6265e-01_r8,2.1245e-01_r8,1.4714e-01_r8,7.7969e-02_r8,3.0714e-04_r8/) + kbo(:, 2,43, 3) = (/ & + &2.8068e-01_r8,2.2918e-01_r8,1.5940e-01_r8,8.4750e-02_r8,3.2151e-04_r8/) + kbo(:, 3,43, 3) = (/ & + &3.0314e-01_r8,2.4932e-01_r8,1.7384e-01_r8,9.2466e-02_r8,3.3415e-04_r8/) + kbo(:, 4,43, 3) = (/ & + &3.3080e-01_r8,2.7269e-01_r8,1.9045e-01_r8,1.0127e-01_r8,3.4470e-04_r8/) + kbo(:, 5,43, 3) = (/ & + &3.6272e-01_r8,2.9942e-01_r8,2.0942e-01_r8,1.1129e-01_r8,3.5407e-04_r8/) + kbo(:, 1,44, 3) = (/ & + &2.4281e-01_r8,1.9594e-01_r8,1.3540e-01_r8,7.1467e-02_r8,2.4789e-04_r8/) + kbo(:, 2,44, 3) = (/ & + &2.5884e-01_r8,2.1103e-01_r8,1.4648e-01_r8,7.7626e-02_r8,2.6014e-04_r8/) + kbo(:, 3,44, 3) = (/ & + &2.7897e-01_r8,2.2939e-01_r8,1.5978e-01_r8,8.4794e-02_r8,2.7117e-04_r8/) + kbo(:, 4,44, 3) = (/ & + &3.0448e-01_r8,2.5115e-01_r8,1.7522e-01_r8,9.2989e-02_r8,2.8049e-04_r8/) + kbo(:, 5,44, 3) = (/ & + &3.3408e-01_r8,2.7612e-01_r8,1.9297e-01_r8,1.0236e-01_r8,2.8861e-04_r8/) + kbo(:, 1,45, 3) = (/ & + &2.2924e-01_r8,1.8447e-01_r8,1.2716e-01_r8,6.6832e-02_r8,2.0004e-04_r8/) + kbo(:, 2,45, 3) = (/ & + &2.4373e-01_r8,1.9820e-01_r8,1.3728e-01_r8,7.2484e-02_r8,2.1065e-04_r8/) + kbo(:, 3,45, 3) = (/ & + &2.6228e-01_r8,2.1536e-01_r8,1.4978e-01_r8,7.9297e-02_r8,2.1996e-04_r8/) + kbo(:, 4,45, 3) = (/ & + &2.8578e-01_r8,2.3573e-01_r8,1.6427e-01_r8,8.6976e-02_r8,2.2795e-04_r8/) + kbo(:, 5,45, 3) = (/ & + &3.1387e-01_r8,2.5954e-01_r8,1.8123e-01_r8,9.5940e-02_r8,2.3501e-04_r8/) + kbo(:, 1,46, 3) = (/ & + &2.1864e-01_r8,1.7537e-01_r8,1.2059e-01_r8,6.3114e-02_r8,1.6106e-04_r8/) + kbo(:, 2,46, 3) = (/ & + &2.3164e-01_r8,1.8773e-01_r8,1.2971e-01_r8,6.8234e-02_r8,1.7008e-04_r8/) + kbo(:, 3,46, 3) = (/ & + &2.4878e-01_r8,2.0380e-01_r8,1.4148e-01_r8,7.4690e-02_r8,1.7817e-04_r8/) + kbo(:, 4,46, 3) = (/ & + &2.7041e-01_r8,2.2298e-01_r8,1.5518e-01_r8,8.1986e-02_r8,1.8514e-04_r8/) + kbo(:, 5,46, 3) = (/ & + &2.9717e-01_r8,2.4573e-01_r8,1.7143e-01_r8,9.0585e-02_r8,1.9112e-04_r8/) + kbo(:, 1,47, 3) = (/ & + &2.0666e-01_r8,1.6515e-01_r8,1.1329e-01_r8,5.9056e-02_r8,1.2901e-04_r8/) + kbo(:, 2,47, 3) = (/ & + &2.1779e-01_r8,1.7589e-01_r8,1.2122e-01_r8,6.3515e-02_r8,1.3680e-04_r8/) + kbo(:, 3,47, 3) = (/ & + &2.3320e-01_r8,1.9053e-01_r8,1.3198e-01_r8,6.9466e-02_r8,1.4384e-04_r8/) + kbo(:, 4,47, 3) = (/ & + &2.5274e-01_r8,2.0828e-01_r8,1.4478e-01_r8,7.6351e-02_r8,1.4999e-04_r8/) + kbo(:, 5,47, 3) = (/ & + &2.7761e-01_r8,2.2954e-01_r8,1.5995e-01_r8,8.4385e-02_r8,1.5514e-04_r8/) + kbo(:, 1,48, 3) = (/ & + &2.0159e-01_r8,1.6032e-01_r8,1.0970e-01_r8,5.6945e-02_r8,1.0330e-04_r8/) + kbo(:, 2,48, 3) = (/ & + &2.1094e-01_r8,1.6966e-01_r8,1.1661e-01_r8,6.0834e-02_r8,1.0997e-04_r8/) + kbo(:, 3,48, 3) = (/ & + &2.2505e-01_r8,1.8313e-01_r8,1.2656e-01_r8,6.6365e-02_r8,1.1606e-04_r8/) + kbo(:, 4,48, 3) = (/ & + &2.4321e-01_r8,1.9993e-01_r8,1.3877e-01_r8,7.3027e-02_r8,1.2143e-04_r8/) + kbo(:, 5,48, 3) = (/ & + &2.6669e-01_r8,2.2023e-01_r8,1.5323e-01_r8,8.0709e-02_r8,1.2582e-04_r8/) + kbo(:, 1,49, 3) = (/ & + &2.0550e-01_r8,1.6255e-01_r8,1.1090e-01_r8,5.7322e-02_r8,8.2624e-05_r8/) + kbo(:, 2,49, 3) = (/ & + &2.1330e-01_r8,1.7068e-01_r8,1.1698e-01_r8,6.0751e-02_r8,8.8378e-05_r8/) + kbo(:, 3,49, 3) = (/ & + &2.2651e-01_r8,1.8330e-01_r8,1.2630e-01_r8,6.5972e-02_r8,9.3615e-05_r8/) + kbo(:, 4,49, 3) = (/ & + &2.4409e-01_r8,1.9975e-01_r8,1.3835e-01_r8,7.2591e-02_r8,9.8246e-05_r8/) + kbo(:, 5,49, 3) = (/ & + &2.6685e-01_r8,2.1980e-01_r8,1.5269e-01_r8,8.0258e-02_r8,1.0201e-04_r8/) + kbo(:, 1,50, 3) = (/ & + &2.0001e-01_r8,1.5763e-01_r8,1.0735e-01_r8,5.5313e-02_r8,6.6052e-05_r8/) + kbo(:, 2,50, 3) = (/ & + &2.0622e-01_r8,1.6433e-01_r8,1.1239e-01_r8,5.8166e-02_r8,7.0964e-05_r8/) + kbo(:, 3,50, 3) = (/ & + &2.1782e-01_r8,1.7560e-01_r8,1.2070e-01_r8,6.2821e-02_r8,7.5460e-05_r8/) + kbo(:, 4,50, 3) = (/ & + &2.3393e-01_r8,1.9090e-01_r8,1.3196e-01_r8,6.9056e-02_r8,7.9402e-05_r8/) + kbo(:, 5,50, 3) = (/ & + &2.5520e-01_r8,2.0998e-01_r8,1.4571e-01_r8,7.6464e-02_r8,8.2692e-05_r8/) + kbo(:, 1,51, 3) = (/ & + &1.9065e-01_r8,1.4985e-01_r8,1.0188e-01_r8,5.2372e-02_r8,5.2796e-05_r8/) + kbo(:, 2,51, 3) = (/ & + &1.9564e-01_r8,1.5535e-01_r8,1.0604e-01_r8,5.4717e-02_r8,5.6909e-05_r8/) + kbo(:, 3,51, 3) = (/ & + &2.0531e-01_r8,1.6500e-01_r8,1.1319e-01_r8,5.8726e-02_r8,6.0736e-05_r8/) + kbo(:, 4,51, 3) = (/ & + &2.1974e-01_r8,1.7886e-01_r8,1.2342e-01_r8,6.4424e-02_r8,6.4172e-05_r8/) + kbo(:, 5,51, 3) = (/ & + &2.3909e-01_r8,1.9652e-01_r8,1.3622e-01_r8,7.1393e-02_r8,6.6971e-05_r8/) + kbo(:, 1,52, 3) = (/ & + &1.8687e-01_r8,1.4652e-01_r8,9.9463e-02_r8,5.1012e-02_r8,4.2174e-05_r8/) + kbo(:, 2,52, 3) = (/ & + &1.9141e-01_r8,1.5137e-01_r8,1.0312e-01_r8,5.3053e-02_r8,4.5594e-05_r8/) + kbo(:, 3,52, 3) = (/ & + &1.9940e-01_r8,1.5962e-01_r8,1.0927e-01_r8,5.6516e-02_r8,4.8848e-05_r8/) + kbo(:, 4,52, 3) = (/ & + &2.1252e-01_r8,1.7228e-01_r8,1.1865e-01_r8,6.1768e-02_r8,5.1771e-05_r8/) + kbo(:, 5,52, 3) = (/ & + &2.3051e-01_r8,1.8896e-01_r8,1.3079e-01_r8,6.8431e-02_r8,5.4234e-05_r8/) + kbo(:, 1,53, 3) = (/ & + &1.9049e-01_r8,1.4907e-01_r8,1.0107e-01_r8,5.1727e-02_r8,3.3675e-05_r8/) + kbo(:, 2,53, 3) = (/ & + &1.9537e-01_r8,1.5387e-01_r8,1.0462e-01_r8,5.3675e-02_r8,3.6498e-05_r8/) + kbo(:, 3,53, 3) = (/ & + &2.0221e-01_r8,1.6109e-01_r8,1.1002e-01_r8,5.6715e-02_r8,3.9286e-05_r8/) + kbo(:, 4,53, 3) = (/ & + &2.1438e-01_r8,1.7292e-01_r8,1.1878e-01_r8,6.1645e-02_r8,4.1745e-05_r8/) + kbo(:, 5,53, 3) = (/ & + &2.3164e-01_r8,1.8913e-01_r8,1.3065e-01_r8,6.8198e-02_r8,4.3903e-05_r8/) + kbo(:, 1,54, 3) = (/ & + &1.6750e-01_r8,1.3117e-01_r8,8.8914e-02_r8,4.5482e-02_r8,2.6834e-05_r8/) + kbo(:, 2,54, 3) = (/ & + &1.7260e-01_r8,1.3577e-01_r8,9.2225e-02_r8,4.7257e-02_r8,2.9152e-05_r8/) + kbo(:, 3,54, 3) = (/ & + &1.7790e-01_r8,1.4144e-01_r8,9.6473e-02_r8,4.9632e-02_r8,3.1487e-05_r8/) + kbo(:, 4,54, 3) = (/ & + &1.8750e-01_r8,1.5107e-01_r8,1.0362e-01_r8,5.3663e-02_r8,3.3610e-05_r8/) + kbo(:, 5,54, 3) = (/ & + &2.0185e-01_r8,1.6484e-01_r8,1.1376e-01_r8,5.9292e-02_r8,3.5416e-05_r8/) + kbo(:, 1,55, 3) = (/ & + &1.3399e-01_r8,1.0522e-01_r8,7.1343e-02_r8,3.6503e-02_r8,2.1364e-05_r8/) + kbo(:, 2,55, 3) = (/ & + &1.3914e-01_r8,1.0951e-01_r8,7.4357e-02_r8,3.8080e-02_r8,2.3275e-05_r8/) + kbo(:, 3,55, 3) = (/ & + &1.4309e-01_r8,1.1374e-01_r8,7.7519e-02_r8,3.9837e-02_r8,2.5155e-05_r8/) + kbo(:, 4,55, 3) = (/ & + &1.4990e-01_r8,1.2087e-01_r8,8.2841e-02_r8,4.2848e-02_r8,2.6955e-05_r8/) + kbo(:, 5,55, 3) = (/ & + &1.6076e-01_r8,1.3155e-01_r8,9.0755e-02_r8,4.7259e-02_r8,2.8512e-05_r8/) + kbo(:, 1,56, 3) = (/ & + &1.0674e-01_r8,8.4150e-02_r8,5.7088e-02_r8,2.9230e-02_r8,1.7018e-05_r8/) + kbo(:, 2,56, 3) = (/ & + &1.1202e-01_r8,8.8284e-02_r8,5.9924e-02_r8,3.0675e-02_r8,1.8552e-05_r8/) + kbo(:, 3,56, 3) = (/ & + &1.1522e-01_r8,9.1603e-02_r8,6.2380e-02_r8,3.2028e-02_r8,2.0079e-05_r8/) + kbo(:, 4,56, 3) = (/ & + &1.2002e-01_r8,9.6801e-02_r8,6.6273e-02_r8,3.4240e-02_r8,2.1582e-05_r8/) + kbo(:, 5,56, 3) = (/ & + &1.2813e-01_r8,1.0499e-01_r8,7.2382e-02_r8,3.7660e-02_r8,2.2972e-05_r8/) + kbo(:, 1,57, 3) = (/ & + &8.4657e-02_r8,6.6996e-02_r8,4.5488e-02_r8,2.3320e-02_r8,1.3524e-05_r8/) + kbo(:, 2,57, 3) = (/ & + &8.9961e-02_r8,7.1035e-02_r8,4.8219e-02_r8,2.4686e-02_r8,1.4787e-05_r8/) + kbo(:, 3,57, 3) = (/ & + &9.2828e-02_r8,7.3808e-02_r8,5.0230e-02_r8,2.5772e-02_r8,1.6030e-05_r8/) + kbo(:, 4,57, 3) = (/ & + &9.6271e-02_r8,7.7620e-02_r8,5.3068e-02_r8,2.7385e-02_r8,1.7279e-05_r8/) + kbo(:, 5,57, 3) = (/ & + &1.0221e-01_r8,8.3835e-02_r8,5.7725e-02_r8,3.0004e-02_r8,1.8442e-05_r8/) + kbo(:, 1,58, 3) = (/ & + &1.7656e-02_r8,1.7150e-02_r8,1.4988e-02_r8,1.0779e-02_r8,1.0747e-05_r8/) + kbo(:, 2,58, 3) = (/ & + &1.9015e-02_r8,1.8411e-02_r8,1.6077e-02_r8,1.1536e-02_r8,1.1805e-05_r8/) + kbo(:, 3,58, 3) = (/ & + &1.9736e-02_r8,1.9199e-02_r8,1.6794e-02_r8,1.2067e-02_r8,1.2808e-05_r8/) + kbo(:, 4,58, 3) = (/ & + &2.0419e-02_r8,2.0127e-02_r8,1.7678e-02_r8,1.2766e-02_r8,1.3807e-05_r8/) + kbo(:, 5,58, 3) = (/ & + &2.1547e-02_r8,2.1640e-02_r8,1.9143e-02_r8,1.3925e-02_r8,1.4766e-05_r8/) + kbo(:, 1,59, 3) = (/ & + &1.6768e-02_r8,1.5635e-02_r8,1.2738e-02_r8,8.1686e-03_r8,8.6706e-06_r8/) + kbo(:, 2,59, 3) = (/ & + &1.8151e-02_r8,1.6868e-02_r8,1.3724e-02_r8,8.7749e-03_r8,9.5360e-06_r8/) + kbo(:, 3,59, 3) = (/ & + &1.8900e-02_r8,1.7641e-02_r8,1.4372e-02_r8,9.2015e-03_r8,1.0356e-05_r8/) + kbo(:, 4,59, 3) = (/ & + &1.9564e-02_r8,1.8529e-02_r8,1.5159e-02_r8,9.7488e-03_r8,1.1149e-05_r8/) + kbo(:, 5,59, 3) = (/ & + &2.0620e-02_r8,1.9962e-02_r8,1.6458e-02_r8,1.0647e-02_r8,1.1905e-05_r8/) + kbo(:, 1,13, 4) = (/ & + &2.1586e+02_r8,1.6199e+02_r8,1.0811e+02_r8,5.4245e+01_r8,1.2105e-01_r8/) + kbo(:, 2,13, 4) = (/ & + &2.1869e+02_r8,1.6410e+02_r8,1.0952e+02_r8,5.4940e+01_r8,1.2618e-01_r8/) + kbo(:, 3,13, 4) = (/ & + &2.2370e+02_r8,1.6786e+02_r8,1.1202e+02_r8,5.6190e+01_r8,1.3118e-01_r8/) + kbo(:, 4,13, 4) = (/ & + &2.3070e+02_r8,1.7312e+02_r8,1.1553e+02_r8,5.7947e+01_r8,1.3630e-01_r8/) + kbo(:, 5,13, 4) = (/ & + &2.4034e+02_r8,1.8034e+02_r8,1.2035e+02_r8,6.0352e+01_r8,1.4080e-01_r8/) + kbo(:, 1,14, 4) = (/ & + &1.1263e+02_r8,8.4567e+01_r8,5.6502e+01_r8,2.8444e+01_r8,1.0638e-01_r8/) + kbo(:, 2,14, 4) = (/ & + &1.1465e+02_r8,8.6072e+01_r8,5.7500e+01_r8,2.8941e+01_r8,1.1108e-01_r8/) + kbo(:, 3,14, 4) = (/ & + &1.1796e+02_r8,8.8560e+01_r8,5.9161e+01_r8,2.9768e+01_r8,1.1550e-01_r8/) + kbo(:, 4,14, 4) = (/ & + &1.2248e+02_r8,9.1950e+01_r8,6.1421e+01_r8,3.0896e+01_r8,1.2021e-01_r8/) + kbo(:, 5,14, 4) = (/ & + &1.2816e+02_r8,9.6211e+01_r8,6.4260e+01_r8,3.2312e+01_r8,1.2485e-01_r8/) + kbo(:, 1,15, 4) = (/ & + &5.9854e+01_r8,4.4984e+01_r8,3.0119e+01_r8,1.5274e+01_r8,9.2887e-02_r8/) + kbo(:, 2,15, 4) = (/ & + &6.1271e+01_r8,4.6045e+01_r8,3.0823e+01_r8,1.5619e+01_r8,9.7129e-02_r8/) + kbo(:, 3,15, 4) = (/ & + &6.3412e+01_r8,4.7652e+01_r8,3.1894e+01_r8,1.6144e+01_r8,1.0153e-01_r8/) + kbo(:, 4,15, 4) = (/ & + &6.6234e+01_r8,4.9767e+01_r8,3.3302e+01_r8,1.6842e+01_r8,1.0585e-01_r8/) + kbo(:, 5,15, 4) = (/ & + &6.9392e+01_r8,5.2133e+01_r8,3.4876e+01_r8,1.7625e+01_r8,1.1025e-01_r8/) + kbo(:, 1,16, 4) = (/ & + &3.7898e+01_r8,2.8521e+01_r8,1.9151e+01_r8,9.8246e+00_r8,8.0720e-02_r8/) + kbo(:, 2,16, 4) = (/ & + &3.9024e+01_r8,2.9361e+01_r8,1.9706e+01_r8,1.0088e+01_r8,8.4821e-02_r8/) + kbo(:, 3,16, 4) = (/ & + &4.0630e+01_r8,3.0565e+01_r8,2.0505e+01_r8,1.0472e+01_r8,8.9056e-02_r8/) + kbo(:, 4,16, 4) = (/ & + &4.2559e+01_r8,3.2011e+01_r8,2.1467e+01_r8,1.0943e+01_r8,9.3186e-02_r8/) + kbo(:, 5,16, 4) = (/ & + &4.4564e+01_r8,3.3513e+01_r8,2.2465e+01_r8,1.1432e+01_r8,9.7171e-02_r8/) + kbo(:, 1,17, 4) = (/ & + &2.4925e+01_r8,1.8792e+01_r8,1.2674e+01_r8,6.6287e+00_r8,6.9974e-02_r8/) + kbo(:, 2,17, 4) = (/ & + &2.5814e+01_r8,1.9454e+01_r8,1.3108e+01_r8,6.8325e+00_r8,7.3907e-02_r8/) + kbo(:, 3,17, 4) = (/ & + &2.6980e+01_r8,2.0330e+01_r8,1.3687e+01_r8,7.1100e+00_r8,7.7821e-02_r8/) + kbo(:, 4,17, 4) = (/ & + &2.8287e+01_r8,2.1307e+01_r8,1.4334e+01_r8,7.4176e+00_r8,8.1565e-02_r8/) + kbo(:, 5,17, 4) = (/ & + &2.9635e+01_r8,2.2318e+01_r8,1.5005e+01_r8,7.7402e+00_r8,8.5222e-02_r8/) + kbo(:, 1,18, 4) = (/ & + &1.6833e+01_r8,1.2726e+01_r8,8.6533e+00_r8,4.6132e+00_r8,6.0568e-02_r8/) + kbo(:, 2,18, 4) = (/ & + &1.7515e+01_r8,1.3234e+01_r8,8.9835e+00_r8,4.7781e+00_r8,6.4137e-02_r8/) + kbo(:, 3,18, 4) = (/ & + &1.8359e+01_r8,1.3866e+01_r8,9.3947e+00_r8,4.9795e+00_r8,6.7564e-02_r8/) + kbo(:, 4,18, 4) = (/ & + &1.9269e+01_r8,1.4545e+01_r8,9.8365e+00_r8,5.1909e+00_r8,7.0941e-02_r8/) + kbo(:, 5,18, 4) = (/ & + &2.0186e+01_r8,1.5233e+01_r8,1.0291e+01_r8,5.4115e+00_r8,7.4160e-02_r8/) + kbo(:, 1,19, 4) = (/ & + &1.1200e+01_r8,8.5062e+00_r8,5.8670e+00_r8,3.1832e+00_r8,5.2174e-02_r8/) + kbo(:, 2,19, 4) = (/ & + &1.1703e+01_r8,8.8805e+00_r8,6.1092e+00_r8,3.3121e+00_r8,5.5280e-02_r8/) + kbo(:, 3,19, 4) = (/ & + &1.2289e+01_r8,9.3153e+00_r8,6.3897e+00_r8,3.4520e+00_r8,5.8298e-02_r8/) + kbo(:, 4,19, 4) = (/ & + &1.2879e+01_r8,9.7549e+00_r8,6.6727e+00_r8,3.5951e+00_r8,6.1230e-02_r8/) + kbo(:, 5,19, 4) = (/ & + &1.3509e+01_r8,1.0228e+01_r8,6.9797e+00_r8,3.7461e+00_r8,6.3987e-02_r8/) + kbo(:, 1,20, 4) = (/ & + &8.1017e+00_r8,6.1940e+00_r8,4.3223e+00_r8,2.3773e+00_r8,4.4725e-02_r8/) + kbo(:, 2,20, 4) = (/ & + &8.4816e+00_r8,6.4735e+00_r8,4.5091e+00_r8,2.4775e+00_r8,4.7408e-02_r8/) + kbo(:, 3,20, 4) = (/ & + &8.8970e+00_r8,6.7793e+00_r8,4.7079e+00_r8,2.5791e+00_r8,5.0027e-02_r8/) + kbo(:, 4,20, 4) = (/ & + &9.3252e+00_r8,7.0958e+00_r8,4.9137e+00_r8,2.6856e+00_r8,5.2539e-02_r8/) + kbo(:, 5,20, 4) = (/ & + &9.8057e+00_r8,7.4546e+00_r8,5.1456e+00_r8,2.8027e+00_r8,5.4910e-02_r8/) + kbo(:, 1,21, 4) = (/ & + &6.0501e+00_r8,4.6688e+00_r8,3.2884e+00_r8,1.8254e+00_r8,3.8136e-02_r8/) + kbo(:, 2,21, 4) = (/ & + &6.3357e+00_r8,4.8779e+00_r8,3.4312e+00_r8,1.9011e+00_r8,4.0441e-02_r8/) + kbo(:, 3,21, 4) = (/ & + &6.6449e+00_r8,5.1029e+00_r8,3.5792e+00_r8,1.9785e+00_r8,4.2660e-02_r8/) + kbo(:, 4,21, 4) = (/ & + &6.9762e+00_r8,5.3455e+00_r8,3.7404e+00_r8,2.0617e+00_r8,4.4823e-02_r8/) + kbo(:, 5,21, 4) = (/ & + &7.3528e+00_r8,5.6235e+00_r8,3.9228e+00_r8,2.1569e+00_r8,4.6872e-02_r8/) + kbo(:, 1,22, 4) = (/ & + &4.6404e+00_r8,3.6182e+00_r8,2.5692e+00_r8,1.4322e+00_r8,3.2495e-02_r8/) + kbo(:, 2,22, 4) = (/ & + &4.8647e+00_r8,3.7820e+00_r8,2.6806e+00_r8,1.4906e+00_r8,3.4441e-02_r8/) + kbo(:, 3,22, 4) = (/ & + &5.1076e+00_r8,3.9577e+00_r8,2.7989e+00_r8,1.5529e+00_r8,3.6349e-02_r8/) + kbo(:, 4,22, 4) = (/ & + &5.3767e+00_r8,4.1547e+00_r8,2.9316e+00_r8,1.6226e+00_r8,3.8200e-02_r8/) + kbo(:, 5,22, 4) = (/ & + &5.6763e+00_r8,4.3747e+00_r8,3.0789e+00_r8,1.7012e+00_r8,3.9814e-02_r8/) + kbo(:, 1,23, 4) = (/ & + &3.5795e+00_r8,2.8211e+00_r8,2.0153e+00_r8,1.1263e+00_r8,2.7571e-02_r8/) + kbo(:, 2,23, 4) = (/ & + &3.7577e+00_r8,2.9513e+00_r8,2.1035e+00_r8,1.1732e+00_r8,2.9222e-02_r8/) + kbo(:, 3,23, 4) = (/ & + &3.9530e+00_r8,3.0936e+00_r8,2.2016e+00_r8,1.2254e+00_r8,3.0874e-02_r8/) + kbo(:, 4,23, 4) = (/ & + &4.1701e+00_r8,3.2524e+00_r8,2.3097e+00_r8,1.2838e+00_r8,3.2339e-02_r8/) + kbo(:, 5,23, 4) = (/ & + &4.4121e+00_r8,3.4311e+00_r8,2.4318e+00_r8,1.3490e+00_r8,3.3498e-02_r8/) + kbo(:, 1,24, 4) = (/ & + &2.7499e+00_r8,2.1929e+00_r8,1.5716e+00_r8,8.8208e-01_r8,2.3328e-02_r8/) + kbo(:, 2,24, 4) = (/ & + &2.8912e+00_r8,2.2961e+00_r8,1.6422e+00_r8,9.2052e-01_r8,2.4747e-02_r8/) + kbo(:, 3,24, 4) = (/ & + &3.0489e+00_r8,2.4127e+00_r8,1.7231e+00_r8,9.6426e-01_r8,2.6067e-02_r8/) + kbo(:, 4,24, 4) = (/ & + &3.2231e+00_r8,2.5412e+00_r8,1.8120e+00_r8,1.0128e+00_r8,2.7124e-02_r8/) + kbo(:, 5,24, 4) = (/ & + &3.4149e+00_r8,2.6844e+00_r8,1.9115e+00_r8,1.0663e+00_r8,2.7906e-02_r8/) + kbo(:, 1,25, 4) = (/ & + &2.1432e+00_r8,1.7277e+00_r8,1.2393e+00_r8,6.9912e-01_r8,1.9707e-02_r8/) + kbo(:, 2,25, 4) = (/ & + &2.2580e+00_r8,1.8124e+00_r8,1.2983e+00_r8,7.3186e-01_r8,2.0862e-02_r8/) + kbo(:, 3,25, 4) = (/ & + &2.3862e+00_r8,1.9090e+00_r8,1.3657e+00_r8,7.6856e-01_r8,2.1834e-02_r8/) + kbo(:, 4,25, 4) = (/ & + &2.5268e+00_r8,2.0149e+00_r8,1.4403e+00_r8,8.0968e-01_r8,2.2567e-02_r8/) + kbo(:, 5,25, 4) = (/ & + &2.6782e+00_r8,2.1290e+00_r8,1.5196e+00_r8,8.5344e-01_r8,2.3120e-02_r8/) + kbo(:, 1,26, 4) = (/ & + &1.7021e+00_r8,1.3844e+00_r8,9.9410e-01_r8,5.6358e-01_r8,1.6610e-02_r8/) + kbo(:, 2,26, 4) = (/ & + &1.7967e+00_r8,1.4558e+00_r8,1.0446e+00_r8,5.9163e-01_r8,1.7478e-02_r8/) + kbo(:, 3,26, 4) = (/ & + &1.9029e+00_r8,1.5366e+00_r8,1.1015e+00_r8,6.2314e-01_r8,1.8168e-02_r8/) + kbo(:, 4,26, 4) = (/ & + &2.0167e+00_r8,1.6240e+00_r8,1.1633e+00_r8,6.5758e-01_r8,1.8695e-02_r8/) + kbo(:, 5,26, 4) = (/ & + &2.1386e+00_r8,1.7169e+00_r8,1.2284e+00_r8,6.9400e-01_r8,1.9096e-02_r8/) + kbo(:, 1,27, 4) = (/ & + &1.4057e+00_r8,1.1500e+00_r8,8.2663e-01_r8,4.7009e-01_r8,1.3925e-02_r8/) + kbo(:, 2,27, 4) = (/ & + &1.4879e+00_r8,1.2132e+00_r8,8.7128e-01_r8,4.9476e-01_r8,1.4552e-02_r8/) + kbo(:, 3,27, 4) = (/ & + &1.5769e+00_r8,1.2821e+00_r8,9.2036e-01_r8,5.2229e-01_r8,1.5059e-02_r8/) + kbo(:, 4,27, 4) = (/ & + &1.6734e+00_r8,1.3576e+00_r8,9.7388e-01_r8,5.5224e-01_r8,1.5448e-02_r8/) + kbo(:, 5,27, 4) = (/ & + &1.7761e+00_r8,1.4364e+00_r8,1.0297e+00_r8,5.8351e-01_r8,1.5741e-02_r8/) + kbo(:, 1,28, 4) = (/ & + &1.1944e+00_r8,9.8092e-01_r8,7.0555e-01_r8,4.0148e-01_r8,1.1607e-02_r8/) + kbo(:, 2,28, 4) = (/ & + &1.2669e+00_r8,1.0377e+00_r8,7.4577e-01_r8,4.2386e-01_r8,1.2073e-02_r8/) + kbo(:, 3,28, 4) = (/ & + &1.3434e+00_r8,1.0982e+00_r8,7.8916e-01_r8,4.4819e-01_r8,1.2454e-02_r8/) + kbo(:, 4,28, 4) = (/ & + &1.4276e+00_r8,1.1642e+00_r8,8.3605e-01_r8,4.7463e-01_r8,1.2747e-02_r8/) + kbo(:, 5,28, 4) = (/ & + &1.5174e+00_r8,1.2340e+00_r8,8.8572e-01_r8,5.0242e-01_r8,1.2962e-02_r8/) + kbo(:, 1,29, 4) = (/ & + &1.0796e+00_r8,8.8738e-01_r8,6.3729e-01_r8,3.6140e-01_r8,9.6469e-03_r8/) + kbo(:, 2,29, 4) = (/ & + &1.1462e+00_r8,9.4012e-01_r8,6.7481e-01_r8,3.8241e-01_r8,1.0006e-02_r8/) + kbo(:, 3,29, 4) = (/ & + &1.2166e+00_r8,9.9676e-01_r8,7.1549e-01_r8,4.0534e-01_r8,1.0291e-02_r8/) + kbo(:, 4,29, 4) = (/ & + &1.2950e+00_r8,1.0580e+00_r8,7.5913e-01_r8,4.2989e-01_r8,1.0512e-02_r8/) + kbo(:, 5,29, 4) = (/ & + &1.3796e+00_r8,1.1246e+00_r8,8.0670e-01_r8,4.5638e-01_r8,1.0678e-02_r8/) + kbo(:, 1,30, 4) = (/ & + &1.0009e+00_r8,8.2254e-01_r8,5.8934e-01_r8,3.3271e-01_r8,8.0058e-03_r8/) + kbo(:, 2,30, 4) = (/ & + &1.0631e+00_r8,8.7256e-01_r8,6.2533e-01_r8,3.5305e-01_r8,8.2800e-03_r8/) + kbo(:, 3,30, 4) = (/ & + &1.1308e+00_r8,9.2710e-01_r8,6.6420e-01_r8,3.7481e-01_r8,8.4963e-03_r8/) + kbo(:, 4,30, 4) = (/ & + &1.2063e+00_r8,9.8617e-01_r8,7.0646e-01_r8,3.9833e-01_r8,8.6678e-03_r8/) + kbo(:, 5,30, 4) = (/ & + &1.2872e+00_r8,1.0507e+00_r8,7.5301e-01_r8,4.2433e-01_r8,8.7939e-03_r8/) + kbo(:, 1,31, 4) = (/ & + &9.7660e-01_r8,8.0084e-01_r8,5.7177e-01_r8,3.2070e-01_r8,6.6382e-03_r8/) + kbo(:, 2,31, 4) = (/ & + &1.0374e+00_r8,8.5014e-01_r8,6.0734e-01_r8,3.4069e-01_r8,6.8456e-03_r8/) + kbo(:, 3,31, 4) = (/ & + &1.1075e+00_r8,9.0581e-01_r8,6.4681e-01_r8,3.6261e-01_r8,7.0127e-03_r8/) + kbo(:, 4,31, 4) = (/ & + &1.1834e+00_r8,9.6644e-01_r8,6.9039e-01_r8,3.8675e-01_r8,7.1469e-03_r8/) + kbo(:, 5,31, 4) = (/ & + &1.2660e+00_r8,1.0326e+00_r8,7.3825e-01_r8,4.1334e-01_r8,7.2367e-03_r8/) + kbo(:, 1,32, 4) = (/ & + &9.6422e-01_r8,7.8878e-01_r8,5.6132e-01_r8,3.1280e-01_r8,5.4958e-03_r8/) + kbo(:, 2,32, 4) = (/ & + &1.0268e+00_r8,8.3964e-01_r8,5.9767e-01_r8,3.3295e-01_r8,5.6574e-03_r8/) + kbo(:, 3,32, 4) = (/ & + &1.0993e+00_r8,8.9729e-01_r8,6.3870e-01_r8,3.5556e-01_r8,5.7908e-03_r8/) + kbo(:, 4,32, 4) = (/ & + &1.1769e+00_r8,9.5960e-01_r8,6.8365e-01_r8,3.8056e-01_r8,5.8892e-03_r8/) + kbo(:, 5,32, 4) = (/ & + &1.2618e+00_r8,1.0283e+00_r8,7.3351e-01_r8,4.0808e-01_r8,5.9563e-03_r8/) + kbo(:, 1,33, 4) = (/ & + &9.7044e-01_r8,7.9175e-01_r8,5.6148e-01_r8,3.1071e-01_r8,4.5479e-03_r8/) + kbo(:, 2,33, 4) = (/ & + &1.0377e+00_r8,8.4609e-01_r8,5.9989e-01_r8,3.3169e-01_r8,4.6770e-03_r8/) + kbo(:, 3,33, 4) = (/ & + &1.1127e+00_r8,9.0612e-01_r8,6.4309e-01_r8,3.5556e-01_r8,4.7785e-03_r8/) + kbo(:, 4,33, 4) = (/ & + &1.1941e+00_r8,9.7205e-01_r8,6.9062e-01_r8,3.8191e-01_r8,4.8530e-03_r8/) + kbo(:, 5,33, 4) = (/ & + &1.2827e+00_r8,1.0440e+00_r8,7.4287e-01_r8,4.1072e-01_r8,4.9022e-03_r8/) + kbo(:, 1,34, 4) = (/ & + &9.5216e-01_r8,7.7596e-01_r8,5.4886e-01_r8,3.0190e-01_r8,3.7602e-03_r8/) + kbo(:, 2,34, 4) = (/ & + &1.0214e+00_r8,8.3168e-01_r8,5.8836e-01_r8,3.2354e-01_r8,3.8612e-03_r8/) + kbo(:, 3,34, 4) = (/ & + &1.0976e+00_r8,8.9321e-01_r8,6.3261e-01_r8,3.4797e-01_r8,3.9398e-03_r8/) + kbo(:, 4,34, 4) = (/ & + &1.1802e+00_r8,9.6059e-01_r8,6.8153e-01_r8,3.7517e-01_r8,3.9961e-03_r8/) + kbo(:, 5,34, 4) = (/ & + &1.2700e+00_r8,1.0340e+00_r8,7.3462e-01_r8,4.0436e-01_r8,4.0321e-03_r8/) + kbo(:, 1,35, 4) = (/ & + &9.3109e-01_r8,7.5807e-01_r8,5.3485e-01_r8,2.9258e-01_r8,3.0990e-03_r8/) + kbo(:, 2,35, 4) = (/ & + &1.0014e+00_r8,8.1463e-01_r8,5.7510e-01_r8,3.1470e-01_r8,3.1794e-03_r8/) + kbo(:, 3,35, 4) = (/ & + &1.0779e+00_r8,8.7703e-01_r8,6.2017e-01_r8,3.3965e-01_r8,3.2414e-03_r8/) + kbo(:, 4,35, 4) = (/ & + &1.1611e+00_r8,9.4542e-01_r8,6.6993e-01_r8,3.6723e-01_r8,3.2866e-03_r8/) + kbo(:, 5,35, 4) = (/ & + &1.2524e+00_r8,1.0199e+00_r8,7.2388e-01_r8,3.9699e-01_r8,3.3190e-03_r8/) + kbo(:, 1,36, 4) = (/ & + &8.9907e-01_r8,7.3170e-01_r8,5.1516e-01_r8,2.8053e-01_r8,2.5454e-03_r8/) + kbo(:, 2,36, 4) = (/ & + &9.6904e-01_r8,7.8811e-01_r8,5.5541e-01_r8,3.0260e-01_r8,2.6116e-03_r8/) + kbo(:, 3,36, 4) = (/ & + &1.0454e+00_r8,8.5074e-01_r8,6.0077e-01_r8,3.2780e-01_r8,2.6639e-03_r8/) + kbo(:, 4,36, 4) = (/ & + &1.1275e+00_r8,9.1876e-01_r8,6.5041e-01_r8,3.5533e-01_r8,2.7017e-03_r8/) + kbo(:, 5,36, 4) = (/ & + &1.2188e+00_r8,9.9337e-01_r8,7.0446e-01_r8,3.8526e-01_r8,2.7298e-03_r8/) + kbo(:, 1,37, 4) = (/ & + &8.3748e-01_r8,6.8208e-01_r8,4.7958e-01_r8,2.6026e-01_r8,2.0819e-03_r8/) + kbo(:, 2,37, 4) = (/ & + &9.0437e-01_r8,7.3619e-01_r8,5.1822e-01_r8,2.8144e-01_r8,2.1383e-03_r8/) + kbo(:, 3,37, 4) = (/ & + &9.7724e-01_r8,7.9645e-01_r8,5.6196e-01_r8,3.0574e-01_r8,2.1835e-03_r8/) + kbo(:, 4,37, 4) = (/ & + &1.0560e+00_r8,8.6198e-01_r8,6.0986e-01_r8,3.3246e-01_r8,2.2167e-03_r8/) + kbo(:, 5,37, 4) = (/ & + &1.1435e+00_r8,9.3399e-01_r8,6.6218e-01_r8,3.6148e-01_r8,2.2423e-03_r8/) + kbo(:, 1,38, 4) = (/ & + &7.9164e-01_r8,6.4489e-01_r8,4.5275e-01_r8,2.4481e-01_r8,1.7033e-03_r8/) + kbo(:, 2,38, 4) = (/ & + &8.5631e-01_r8,6.9735e-01_r8,4.9025e-01_r8,2.6537e-01_r8,1.7520e-03_r8/) + kbo(:, 3,38, 4) = (/ & + &9.2681e-01_r8,7.5605e-01_r8,5.3294e-01_r8,2.8911e-01_r8,1.7893e-03_r8/) + kbo(:, 4,38, 4) = (/ & + &1.0032e+00_r8,8.1986e-01_r8,5.7959e-01_r8,3.1521e-01_r8,1.8197e-03_r8/) + kbo(:, 5,38, 4) = (/ & + &1.0885e+00_r8,8.9047e-01_r8,6.3102e-01_r8,3.4379e-01_r8,1.8432e-03_r8/) + kbo(:, 1,39, 4) = (/ & + &7.6561e-01_r8,6.2337e-01_r8,4.3685e-01_r8,2.3531e-01_r8,1.3951e-03_r8/) + kbo(:, 2,39, 4) = (/ & + &8.2959e-01_r8,6.7544e-01_r8,4.7411e-01_r8,2.5572e-01_r8,1.4362e-03_r8/) + kbo(:, 3,39, 4) = (/ & + &8.9955e-01_r8,7.3386e-01_r8,5.1664e-01_r8,2.7941e-01_r8,1.4681e-03_r8/) + kbo(:, 4,39, 4) = (/ & + &9.7533e-01_r8,7.9745e-01_r8,5.6319e-01_r8,3.0547e-01_r8,1.4952e-03_r8/) + kbo(:, 5,39, 4) = (/ & + &1.0606e+00_r8,8.6829e-01_r8,6.1487e-01_r8,3.3424e-01_r8,1.5163e-03_r8/) + kbo(:, 1,40, 4) = (/ & + &6.9042e-01_r8,5.6314e-01_r8,3.9439e-01_r8,2.1202e-01_r8,1.1367e-03_r8/) + kbo(:, 2,40, 4) = (/ & + &7.4888e-01_r8,6.1108e-01_r8,4.2878e-01_r8,2.3085e-01_r8,1.1721e-03_r8/) + kbo(:, 3,40, 4) = (/ & + &8.1362e-01_r8,6.6539e-01_r8,4.6832e-01_r8,2.5287e-01_r8,1.1998e-03_r8/) + kbo(:, 4,40, 4) = (/ & + &8.8373e-01_r8,7.2479e-01_r8,5.1188e-01_r8,2.7730e-01_r8,1.2242e-03_r8/) + kbo(:, 5,40, 4) = (/ & + &9.6254e-01_r8,7.9070e-01_r8,5.6015e-01_r8,3.0430e-01_r8,1.2434e-03_r8/) + kbo(:, 1,41, 4) = (/ & + &6.2032e-01_r8,5.0688e-01_r8,3.5482e-01_r8,1.9040e-01_r8,9.2546e-04_r8/) + kbo(:, 2,41, 4) = (/ & + &6.7393e-01_r8,5.5118e-01_r8,3.8660e-01_r8,2.0779e-01_r8,9.5549e-04_r8/) + kbo(:, 3,41, 4) = (/ & + &7.3329e-01_r8,6.0114e-01_r8,4.2302e-01_r8,2.2810e-01_r8,9.8005e-04_r8/) + kbo(:, 4,41, 4) = (/ & + &7.9788e-01_r8,6.5636e-01_r8,4.6356e-01_r8,2.5084e-01_r8,1.0016e-03_r8/) + kbo(:, 5,41, 4) = (/ & + &8.7082e-01_r8,7.1789e-01_r8,5.0871e-01_r8,2.7615e-01_r8,1.0188e-03_r8/) + kbo(:, 1,42, 4) = (/ & + &5.6327e-01_r8,4.6093e-01_r8,3.2241e-01_r8,1.7266e-01_r8,7.5328e-04_r8/) + kbo(:, 2,42, 4) = (/ & + &6.1295e-01_r8,5.0232e-01_r8,3.5212e-01_r8,1.8890e-01_r8,7.7877e-04_r8/) + kbo(:, 3,42, 4) = (/ & + &6.6777e-01_r8,5.4861e-01_r8,3.8590e-01_r8,2.0776e-01_r8,8.0043e-04_r8/) + kbo(:, 4,42, 4) = (/ & + &7.2797e-01_r8,6.0039e-01_r8,4.2397e-01_r8,2.2912e-01_r8,8.1936e-04_r8/) + kbo(:, 5,42, 4) = (/ & + &7.9621e-01_r8,6.5839e-01_r8,4.6656e-01_r8,2.5303e-01_r8,8.3483e-04_r8/) + kbo(:, 1,43, 4) = (/ & + &5.1362e-01_r8,4.2068e-01_r8,2.9391e-01_r8,1.5704e-01_r8,6.1131e-04_r8/) + kbo(:, 2,43, 4) = (/ & + &5.5956e-01_r8,4.5932e-01_r8,3.2171e-01_r8,1.7223e-01_r8,6.3359e-04_r8/) + kbo(:, 3,43, 4) = (/ & + &6.1053e-01_r8,5.0241e-01_r8,3.5315e-01_r8,1.8977e-01_r8,6.5237e-04_r8/) + kbo(:, 4,43, 4) = (/ & + &6.6664e-01_r8,5.5084e-01_r8,3.8881e-01_r8,2.0981e-01_r8,6.6921e-04_r8/) + kbo(:, 5,43, 4) = (/ & + &7.3047e-01_r8,6.0544e-01_r8,4.2894e-01_r8,2.3232e-01_r8,6.8300e-04_r8/) + kbo(:, 1,44, 4) = (/ & + &4.7369e-01_r8,3.8803e-01_r8,2.7069e-01_r8,1.4426e-01_r8,4.9540e-04_r8/) + kbo(:, 2,44, 4) = (/ & + &5.1629e-01_r8,4.2426e-01_r8,2.9688e-01_r8,1.5856e-01_r8,5.1475e-04_r8/) + kbo(:, 3,44, 4) = (/ & + &5.6430e-01_r8,4.6484e-01_r8,3.2640e-01_r8,1.7499e-01_r8,5.3131e-04_r8/) + kbo(:, 4,44, 4) = (/ & + &6.1717e-01_r8,5.1049e-01_r8,3.6006e-01_r8,1.9393e-01_r8,5.4642e-04_r8/) + kbo(:, 5,44, 4) = (/ & + &6.7746e-01_r8,5.6241e-01_r8,3.9820e-01_r8,2.1537e-01_r8,5.5870e-04_r8/) + kbo(:, 1,45, 4) = (/ & + &4.4552e-01_r8,3.6469e-01_r8,2.5398e-01_r8,1.3497e-01_r8,4.0119e-04_r8/) + kbo(:, 2,45, 4) = (/ & + &4.8593e-01_r8,3.9940e-01_r8,2.7911e-01_r8,1.4871e-01_r8,4.1803e-04_r8/) + kbo(:, 3,45, 4) = (/ & + &5.3210e-01_r8,4.3837e-01_r8,3.0742e-01_r8,1.6436e-01_r8,4.3281e-04_r8/) + kbo(:, 4,45, 4) = (/ & + &5.8266e-01_r8,4.8202e-01_r8,3.3961e-01_r8,1.8254e-01_r8,4.4586e-04_r8/) + kbo(:, 5,45, 4) = (/ & + &6.4061e-01_r8,5.3215e-01_r8,3.7643e-01_r8,2.0327e-01_r8,4.5687e-04_r8/) + kbo(:, 1,46, 4) = (/ & + &4.2249e-01_r8,3.4536e-01_r8,2.4007e-01_r8,1.2719e-01_r8,3.2444e-04_r8/) + kbo(:, 2,46, 4) = (/ & + &4.6085e-01_r8,3.7858e-01_r8,2.6416e-01_r8,1.4037e-01_r8,3.3911e-04_r8/) + kbo(:, 3,46, 4) = (/ & + &5.0558e-01_r8,4.1641e-01_r8,2.9158e-01_r8,1.5550e-01_r8,3.5210e-04_r8/) + kbo(:, 4,46, 4) = (/ & + &5.5446e-01_r8,4.5852e-01_r8,3.2261e-01_r8,1.7296e-01_r8,3.6323e-04_r8/) + kbo(:, 5,46, 4) = (/ & + &6.1034e-01_r8,5.0695e-01_r8,3.5817e-01_r8,1.9305e-01_r8,3.7330e-04_r8/) + kbo(:, 1,47, 4) = (/ & + &3.9554e-01_r8,3.2291e-01_r8,2.2401e-01_r8,1.1833e-01_r8,2.6160e-04_r8/) + kbo(:, 2,47, 4) = (/ & + &4.3146e-01_r8,3.5412e-01_r8,2.4668e-01_r8,1.3078e-01_r8,2.7433e-04_r8/) + kbo(:, 3,47, 4) = (/ & + &4.7369e-01_r8,3.9022e-01_r8,2.7284e-01_r8,1.4515e-01_r8,2.8554e-04_r8/) + kbo(:, 4,47, 4) = (/ & + &5.2055e-01_r8,4.3044e-01_r8,3.0232e-01_r8,1.6167e-01_r8,2.9527e-04_r8/) + kbo(:, 5,47, 4) = (/ & + &5.7336e-01_r8,4.7635e-01_r8,3.3620e-01_r8,1.8084e-01_r8,3.0428e-04_r8/) + kbo(:, 1,48, 4) = (/ & + &3.8090e-01_r8,3.1036e-01_r8,2.1482e-01_r8,1.1310e-01_r8,2.1085e-04_r8/) + kbo(:, 2,48, 4) = (/ & + &4.1533e-01_r8,3.4019e-01_r8,2.3651e-01_r8,1.2501e-01_r8,2.2180e-04_r8/) + kbo(:, 3,48, 4) = (/ & + &4.5614e-01_r8,3.7537e-01_r8,2.6197e-01_r8,1.3898e-01_r8,2.3143e-04_r8/) + kbo(:, 4,48, 4) = (/ & + &5.0246e-01_r8,4.1492e-01_r8,2.9081e-01_r8,1.5505e-01_r8,2.3998e-04_r8/) + kbo(:, 5,48, 4) = (/ & + &5.5365e-01_r8,4.5945e-01_r8,3.2372e-01_r8,1.7366e-01_r8,2.4799e-04_r8/) + kbo(:, 1,49, 4) = (/ & + &3.8223e-01_r8,3.1052e-01_r8,2.1444e-01_r8,1.1246e-01_r8,1.6987e-04_r8/) + kbo(:, 2,49, 4) = (/ & + &4.1659e-01_r8,3.4001e-01_r8,2.3576e-01_r8,1.2419e-01_r8,1.7919e-04_r8/) + kbo(:, 3,49, 4) = (/ & + &4.5734e-01_r8,3.7525e-01_r8,2.6133e-01_r8,1.3821e-01_r8,1.8743e-04_r8/) + kbo(:, 4,49, 4) = (/ & + &5.0487e-01_r8,4.1574e-01_r8,2.9072e-01_r8,1.5448e-01_r8,1.9508e-04_r8/) + kbo(:, 5,49, 4) = (/ & + &5.5695e-01_r8,4.6079e-01_r8,3.2385e-01_r8,1.7317e-01_r8,2.0224e-04_r8/) + kbo(:, 1,50, 4) = (/ & + &3.6631e-01_r8,2.9712e-01_r8,2.0481e-01_r8,1.0712e-01_r8,1.3672e-04_r8/) + kbo(:, 2,50, 4) = (/ & + &3.9879e-01_r8,3.2486e-01_r8,2.2483e-01_r8,1.1811e-01_r8,1.4458e-04_r8/) + kbo(:, 3,50, 4) = (/ & + &4.3761e-01_r8,3.5858e-01_r8,2.4934e-01_r8,1.3160e-01_r8,1.5166e-04_r8/) + kbo(:, 4,50, 4) = (/ & + &4.8398e-01_r8,3.9821e-01_r8,2.7799e-01_r8,1.4737e-01_r8,1.5830e-04_r8/) + kbo(:, 5,50, 4) = (/ & + &5.3499e-01_r8,4.4212e-01_r8,3.1022e-01_r8,1.6549e-01_r8,1.6465e-04_r8/) + kbo(:, 1,51, 4) = (/ & + &3.4406e-01_r8,2.7861e-01_r8,1.9179e-01_r8,1.0006e-01_r8,1.0998e-04_r8/) + kbo(:, 2,51, 4) = (/ & + &3.7372e-01_r8,3.0420e-01_r8,2.1018e-01_r8,1.1015e-01_r8,1.1652e-04_r8/) + kbo(:, 3,51, 4) = (/ & + &4.0998e-01_r8,3.3570e-01_r8,2.3310e-01_r8,1.2281e-01_r8,1.2263e-04_r8/) + kbo(:, 4,51, 4) = (/ & + &4.5397e-01_r8,3.7347e-01_r8,2.6041e-01_r8,1.3780e-01_r8,1.2829e-04_r8/) + kbo(:, 5,51, 4) = (/ & + &5.0293e-01_r8,4.1560e-01_r8,2.9124e-01_r8,1.5503e-01_r8,1.3386e-04_r8/) + kbo(:, 1,52, 4) = (/ & + &3.3305e-01_r8,2.6887e-01_r8,1.8470e-01_r8,9.6116e-02_r8,8.8414e-05_r8/) + kbo(:, 2,52, 4) = (/ & + &3.6030e-01_r8,2.9285e-01_r8,2.0201e-01_r8,1.0559e-01_r8,9.3941e-05_r8/) + kbo(:, 3,52, 4) = (/ & + &3.9501e-01_r8,3.2288e-01_r8,2.2382e-01_r8,1.1765e-01_r8,9.9142e-05_r8/) + kbo(:, 4,52, 4) = (/ & + &4.3753e-01_r8,3.5954e-01_r8,2.5031e-01_r8,1.3217e-01_r8,1.0404e-04_r8/) + kbo(:, 5,52, 4) = (/ & + &4.8592e-01_r8,4.0113e-01_r8,2.8062e-01_r8,1.4902e-01_r8,1.0887e-04_r8/) + kbo(:, 1,53, 4) = (/ & + &3.3673e-01_r8,2.7062e-01_r8,1.8541e-01_r8,9.6126e-02_r8,7.1043e-05_r8/) + kbo(:, 2,53, 4) = (/ & + &3.6211e-01_r8,2.9355e-01_r8,2.0209e-01_r8,1.0535e-01_r8,7.5715e-05_r8/) + kbo(:, 3,53, 4) = (/ & + &3.9659e-01_r8,3.2308e-01_r8,2.2347e-01_r8,1.1715e-01_r8,8.0134e-05_r8/) + kbo(:, 4,53, 4) = (/ & + &4.3895e-01_r8,3.5976e-01_r8,2.5000e-01_r8,1.3170e-01_r8,8.4354e-05_r8/) + kbo(:, 5,53, 4) = (/ & + &4.8875e-01_r8,4.0230e-01_r8,2.8086e-01_r8,1.4875e-01_r8,8.8431e-05_r8/) + kbo(:, 1,54, 4) = (/ & + &2.9565e-01_r8,2.3718e-01_r8,1.6225e-01_r8,8.3929e-02_r8,5.7062e-05_r8/) + kbo(:, 2,54, 4) = (/ & + &3.1566e-01_r8,2.5610e-01_r8,1.7621e-01_r8,9.1726e-02_r8,6.0930e-05_r8/) + kbo(:, 3,54, 4) = (/ & + &3.4501e-01_r8,2.8145e-01_r8,1.9453e-01_r8,1.0184e-01_r8,6.4630e-05_r8/) + kbo(:, 4,54, 4) = (/ & + &3.8166e-01_r8,3.1342e-01_r8,2.1772e-01_r8,1.1458e-01_r8,6.8122e-05_r8/) + kbo(:, 5,54, 4) = (/ & + &4.2580e-01_r8,3.5139e-01_r8,2.4524e-01_r8,1.2978e-01_r8,7.1556e-05_r8/) + kbo(:, 1,55, 4) = (/ & + &2.3763e-01_r8,1.9054e-01_r8,1.3023e-01_r8,6.7270e-02_r8,4.5734e-05_r8/) + kbo(:, 2,55, 4) = (/ & + &2.5160e-01_r8,2.0457e-01_r8,1.4076e-01_r8,7.3233e-02_r8,4.8936e-05_r8/) + kbo(:, 3,55, 4) = (/ & + &2.7408e-01_r8,2.2452e-01_r8,1.5520e-01_r8,8.1193e-02_r8,5.2040e-05_r8/) + kbo(:, 4,55, 4) = (/ & + &3.0302e-01_r8,2.4999e-01_r8,1.7374e-01_r8,9.1409e-02_r8,5.4914e-05_r8/) + kbo(:, 5,55, 4) = (/ & + &3.3851e-01_r8,2.8105e-01_r8,1.9629e-01_r8,1.0386e-01_r8,5.7717e-05_r8/) + kbo(:, 1,56, 4) = (/ & + &1.9160e-01_r8,1.5340e-01_r8,1.0472e-01_r8,5.4007e-02_r8,3.6625e-05_r8/) + kbo(:, 2,56, 4) = (/ & + &2.0095e-01_r8,1.6357e-01_r8,1.1247e-01_r8,5.8467e-02_r8,3.9320e-05_r8/) + kbo(:, 3,56, 4) = (/ & + &2.1781e-01_r8,1.7908e-01_r8,1.2379e-01_r8,6.4708e-02_r8,4.1872e-05_r8/) + kbo(:, 4,56, 4) = (/ & + &2.4047e-01_r8,1.9929e-01_r8,1.3856e-01_r8,7.2864e-02_r8,4.4297e-05_r8/) + kbo(:, 5,56, 4) = (/ & + &2.6886e-01_r8,2.2463e-01_r8,1.5695e-01_r8,8.3003e-02_r8,4.6496e-05_r8/) + kbo(:, 1,57, 4) = (/ & + &1.5488e-01_r8,1.2382e-01_r8,8.4407e-02_r8,4.3459e-02_r8,2.9307e-05_r8/) + kbo(:, 2,57, 4) = (/ & + &1.6082e-01_r8,1.3093e-01_r8,8.9925e-02_r8,4.6681e-02_r8,3.1559e-05_r8/) + kbo(:, 3,57, 4) = (/ & + &1.7312e-01_r8,1.4284e-01_r8,9.8719e-02_r8,5.1558e-02_r8,3.3681e-05_r8/) + kbo(:, 4,57, 4) = (/ & + &1.9084e-01_r8,1.5883e-01_r8,1.1043e-01_r8,5.8031e-02_r8,3.5680e-05_r8/) + kbo(:, 5,57, 4) = (/ & + &2.1336e-01_r8,1.7931e-01_r8,1.2534e-01_r8,6.6236e-02_r8,3.7524e-05_r8/) + kbo(:, 1,58, 4) = (/ & + &3.3087e-02_r8,3.2322e-02_r8,2.8310e-02_r8,2.0395e-02_r8,2.3455e-05_r8/) + kbo(:, 2,58, 4) = (/ & + &3.4053e-02_r8,3.3907e-02_r8,2.9921e-02_r8,2.1729e-02_r8,2.5336e-05_r8/) + kbo(:, 3,58, 4) = (/ & + &3.6376e-02_r8,3.6839e-02_r8,3.2736e-02_r8,2.3935e-02_r8,2.7095e-05_r8/) + kbo(:, 4,58, 4) = (/ & + &4.0009e-02_r8,4.0914e-02_r8,3.6586e-02_r8,2.6918e-02_r8,2.8737e-05_r8/) + kbo(:, 5,58, 4) = (/ & + &4.4706e-02_r8,4.6236e-02_r8,4.1585e-02_r8,3.0778e-02_r8,3.0324e-05_r8/) + kbo(:, 1,59, 4) = (/ & + &3.1774e-02_r8,2.9779e-02_r8,2.4302e-02_r8,1.5595e-02_r8,1.9010e-05_r8/) + kbo(:, 2,59, 4) = (/ & + &3.2644e-02_r8,3.1267e-02_r8,2.5718e-02_r8,1.6636e-02_r8,2.0536e-05_r8/) + kbo(:, 3,59, 4) = (/ & + &3.4800e-02_r8,3.4041e-02_r8,2.8207e-02_r8,1.8368e-02_r8,2.1957e-05_r8/) + kbo(:, 4,59, 4) = (/ & + &3.8295e-02_r8,3.7946e-02_r8,3.1647e-02_r8,2.0746e-02_r8,2.3288e-05_r8/) + kbo(:, 5,59, 4) = (/ & + &4.2857e-02_r8,4.3069e-02_r8,3.6135e-02_r8,2.3842e-02_r8,2.4528e-05_r8/) + kbo(:, 1,13, 5) = (/ & + &3.9549e+02_r8,2.9672e+02_r8,1.9794e+02_r8,9.9160e+01_r8,2.1101e-01_r8/) + kbo(:, 2,13, 5) = (/ & + &4.0510e+02_r8,3.0393e+02_r8,2.0275e+02_r8,1.0157e+02_r8,2.1805e-01_r8/) + kbo(:, 3,13, 5) = (/ & + &4.1502e+02_r8,3.1136e+02_r8,2.0770e+02_r8,1.0405e+02_r8,2.2406e-01_r8/) + kbo(:, 4,13, 5) = (/ & + &4.2481e+02_r8,3.1871e+02_r8,2.1261e+02_r8,1.0651e+02_r8,2.2934e-01_r8/) + kbo(:, 5,13, 5) = (/ & + &4.3504e+02_r8,3.2638e+02_r8,2.1772e+02_r8,1.0907e+02_r8,2.3453e-01_r8/) + kbo(:, 1,14, 5) = (/ & + &2.0979e+02_r8,1.5743e+02_r8,1.0508e+02_r8,5.2736e+01_r8,1.8842e-01_r8/) + kbo(:, 2,14, 5) = (/ & + &2.1502e+02_r8,1.6136e+02_r8,1.0770e+02_r8,5.4046e+01_r8,1.9486e-01_r8/) + kbo(:, 3,14, 5) = (/ & + &2.2030e+02_r8,1.6532e+02_r8,1.1034e+02_r8,5.5365e+01_r8,2.0050e-01_r8/) + kbo(:, 4,14, 5) = (/ & + &2.2600e+02_r8,1.6960e+02_r8,1.1320e+02_r8,5.6802e+01_r8,2.0562e-01_r8/) + kbo(:, 5,14, 5) = (/ & + &2.3272e+02_r8,1.7464e+02_r8,1.1657e+02_r8,5.8488e+01_r8,2.1024e-01_r8/) + kbo(:, 1,15, 5) = (/ & + &1.1299e+02_r8,8.4842e+01_r8,5.6692e+01_r8,2.8544e+01_r8,1.6706e-01_r8/) + kbo(:, 2,15, 5) = (/ & + &1.1594e+02_r8,8.7050e+01_r8,5.8163e+01_r8,2.9281e+01_r8,1.7285e-01_r8/) + kbo(:, 3,15, 5) = (/ & + &1.1912e+02_r8,8.9439e+01_r8,5.9757e+01_r8,3.0081e+01_r8,1.7816e-01_r8/) + kbo(:, 4,15, 5) = (/ & + &1.2274e+02_r8,9.2159e+01_r8,6.1575e+01_r8,3.0997e+01_r8,1.8306e-01_r8/) + kbo(:, 5,15, 5) = (/ & + &1.2711e+02_r8,9.5434e+01_r8,6.3760e+01_r8,3.2089e+01_r8,1.8793e-01_r8/) + kbo(:, 1,16, 5) = (/ & + &7.2342e+01_r8,5.4353e+01_r8,3.6365e+01_r8,1.8388e+01_r8,1.4721e-01_r8/) + kbo(:, 2,16, 5) = (/ & + &7.4310e+01_r8,5.5827e+01_r8,3.7348e+01_r8,1.8883e+01_r8,1.5241e-01_r8/) + kbo(:, 3,16, 5) = (/ & + &7.6651e+01_r8,5.7588e+01_r8,3.8528e+01_r8,1.9478e+01_r8,1.5739e-01_r8/) + kbo(:, 4,16, 5) = (/ & + &7.9417e+01_r8,5.9665e+01_r8,3.9914e+01_r8,2.0174e+01_r8,1.6237e-01_r8/) + kbo(:, 5,16, 5) = (/ & + &8.2509e+01_r8,6.1984e+01_r8,4.1462e+01_r8,2.0947e+01_r8,1.6729e-01_r8/) + kbo(:, 1,17, 5) = (/ & + &4.7912e+01_r8,3.6032e+01_r8,2.4156e+01_r8,1.2312e+01_r8,1.2867e-01_r8/) + kbo(:, 2,17, 5) = (/ & + &4.9396e+01_r8,3.7145e+01_r8,2.4898e+01_r8,1.2683e+01_r8,1.3345e-01_r8/) + kbo(:, 3,17, 5) = (/ & + &5.1211e+01_r8,3.8509e+01_r8,2.5812e+01_r8,1.3139e+01_r8,1.3833e-01_r8/) + kbo(:, 4,17, 5) = (/ & + &5.3243e+01_r8,4.0036e+01_r8,2.6830e+01_r8,1.3649e+01_r8,1.4345e-01_r8/) + kbo(:, 5,17, 5) = (/ & + &5.5359e+01_r8,4.1621e+01_r8,2.7887e+01_r8,1.4174e+01_r8,1.4839e-01_r8/) + kbo(:, 1,18, 5) = (/ & + &3.2517e+01_r8,2.4486e+01_r8,1.6464e+01_r8,8.5255e+00_r8,1.1175e-01_r8/) + kbo(:, 2,18, 5) = (/ & + &3.3702e+01_r8,2.5376e+01_r8,1.7056e+01_r8,8.8105e+00_r8,1.1647e-01_r8/) + kbo(:, 3,18, 5) = (/ & + &3.5055e+01_r8,2.6392e+01_r8,1.7736e+01_r8,9.1463e+00_r8,1.2136e-01_r8/) + kbo(:, 4,18, 5) = (/ & + &3.6466e+01_r8,2.7452e+01_r8,1.8446e+01_r8,9.5008e+00_r8,1.2627e-01_r8/) + kbo(:, 5,18, 5) = (/ & + &3.7955e+01_r8,2.8569e+01_r8,1.9189e+01_r8,9.8619e+00_r8,1.3101e-01_r8/) + kbo(:, 1,19, 5) = (/ & + &2.1727e+01_r8,1.6393e+01_r8,1.1086e+01_r8,5.8761e+00_r8,9.6819e-02_r8/) + kbo(:, 2,19, 5) = (/ & + &2.2617e+01_r8,1.7062e+01_r8,1.1530e+01_r8,6.0896e+00_r8,1.0144e-01_r8/) + kbo(:, 3,19, 5) = (/ & + &2.3543e+01_r8,1.7760e+01_r8,1.1998e+01_r8,6.3260e+00_r8,1.0605e-01_r8/) + kbo(:, 4,19, 5) = (/ & + &2.4512e+01_r8,1.8488e+01_r8,1.2483e+01_r8,6.5653e+00_r8,1.1055e-01_r8/) + kbo(:, 5,19, 5) = (/ & + &2.5548e+01_r8,1.9265e+01_r8,1.2998e+01_r8,6.8170e+00_r8,1.1478e-01_r8/) + kbo(:, 1,20, 5) = (/ & + &1.5756e+01_r8,1.1916e+01_r8,8.1383e+00_r8,4.3914e+00_r8,8.3853e-02_r8/) + kbo(:, 2,20, 5) = (/ & + &1.6431e+01_r8,1.2425e+01_r8,8.4724e+00_r8,4.5624e+00_r8,8.8103e-02_r8/) + kbo(:, 3,20, 5) = (/ & + &1.7121e+01_r8,1.2945e+01_r8,8.8179e+00_r8,4.7428e+00_r8,9.2252e-02_r8/) + kbo(:, 4,20, 5) = (/ & + &1.7848e+01_r8,1.3492e+01_r8,9.1779e+00_r8,4.9264e+00_r8,9.6228e-02_r8/) + kbo(:, 5,20, 5) = (/ & + &1.8606e+01_r8,1.4060e+01_r8,9.5528e+00_r8,5.1134e+00_r8,9.9993e-02_r8/) + kbo(:, 1,21, 5) = (/ & + &1.1787e+01_r8,8.9459e+00_r8,6.1836e+00_r8,3.3861e+00_r8,7.2353e-02_r8/) + kbo(:, 2,21, 5) = (/ & + &1.2303e+01_r8,9.3354e+00_r8,6.4401e+00_r8,3.5254e+00_r8,7.6084e-02_r8/) + kbo(:, 3,21, 5) = (/ & + &1.2826e+01_r8,9.7292e+00_r8,6.7034e+00_r8,3.6681e+00_r8,7.9750e-02_r8/) + kbo(:, 4,21, 5) = (/ & + &1.3367e+01_r8,1.0136e+01_r8,6.9714e+00_r8,3.8111e+00_r8,8.3233e-02_r8/) + kbo(:, 5,21, 5) = (/ & + &1.3957e+01_r8,1.0578e+01_r8,7.2613e+00_r8,3.9589e+00_r8,8.6478e-02_r8/) + kbo(:, 1,22, 5) = (/ & + &9.0718e+00_r8,6.9242e+00_r8,4.8361e+00_r8,2.6781e+00_r8,6.2307e-02_r8/) + kbo(:, 2,22, 5) = (/ & + &9.4616e+00_r8,7.2180e+00_r8,5.0370e+00_r8,2.7912e+00_r8,6.5577e-02_r8/) + kbo(:, 3,22, 5) = (/ & + &9.8598e+00_r8,7.5169e+00_r8,5.2399e+00_r8,2.9065e+00_r8,6.8755e-02_r8/) + kbo(:, 4,22, 5) = (/ & + &1.0285e+01_r8,7.8355e+00_r8,5.4531e+00_r8,3.0213e+00_r8,7.1732e-02_r8/) + kbo(:, 5,22, 5) = (/ & + &1.0774e+01_r8,8.1994e+00_r8,5.6924e+00_r8,3.1454e+00_r8,7.4544e-02_r8/) + kbo(:, 1,23, 5) = (/ & + &7.0162e+00_r8,5.3998e+00_r8,3.8098e+00_r8,2.1262e+00_r8,5.3397e-02_r8/) + kbo(:, 2,23, 5) = (/ & + &7.3118e+00_r8,5.6231e+00_r8,3.9665e+00_r8,2.2161e+00_r8,5.6221e-02_r8/) + kbo(:, 3,23, 5) = (/ & + &7.6257e+00_r8,5.8582e+00_r8,4.1301e+00_r8,2.3090e+00_r8,5.8902e-02_r8/) + kbo(:, 4,23, 5) = (/ & + &7.9740e+00_r8,6.1181e+00_r8,4.3060e+00_r8,2.4033e+00_r8,6.1507e-02_r8/) + kbo(:, 5,23, 5) = (/ & + &8.3852e+00_r8,6.4219e+00_r8,4.5083e+00_r8,2.5100e+00_r8,6.3983e-02_r8/) + kbo(:, 1,24, 5) = (/ & + &5.3945e+00_r8,4.1959e+00_r8,2.9887e+00_r8,1.6764e+00_r8,4.5562e-02_r8/) + kbo(:, 2,24, 5) = (/ & + &5.6263e+00_r8,4.3723e+00_r8,3.1153e+00_r8,1.7491e+00_r8,4.7953e-02_r8/) + kbo(:, 3,24, 5) = (/ & + &5.8803e+00_r8,4.5632e+00_r8,3.2505e+00_r8,1.8236e+00_r8,5.0272e-02_r8/) + kbo(:, 4,24, 5) = (/ & + &6.1740e+00_r8,4.7820e+00_r8,3.4008e+00_r8,1.9048e+00_r8,5.2561e-02_r8/) + kbo(:, 5,24, 5) = (/ & + &6.5136e+00_r8,5.0303e+00_r8,3.5679e+00_r8,1.9952e+00_r8,5.4580e-02_r8/) + kbo(:, 1,25, 5) = (/ & + &4.2050e+00_r8,3.3091e+00_r8,2.3724e+00_r8,1.3359e+00_r8,3.8734e-02_r8/) + kbo(:, 2,25, 5) = (/ & + &4.3935e+00_r8,3.4537e+00_r8,2.4783e+00_r8,1.3955e+00_r8,4.0785e-02_r8/) + kbo(:, 3,25, 5) = (/ & + &4.6090e+00_r8,3.6169e+00_r8,2.5944e+00_r8,1.4600e+00_r8,4.2817e-02_r8/) + kbo(:, 4,25, 5) = (/ & + &4.8571e+00_r8,3.8012e+00_r8,2.7227e+00_r8,1.5304e+00_r8,4.4658e-02_r8/) + kbo(:, 5,25, 5) = (/ & + &5.1379e+00_r8,4.0071e+00_r8,2.8658e+00_r8,1.6091e+00_r8,4.6106e-02_r8/) + kbo(:, 1,26, 5) = (/ & + &3.3393e+00_r8,2.6590e+00_r8,1.9126e+00_r8,1.0812e+00_r8,3.2872e-02_r8/) + kbo(:, 2,26, 5) = (/ & + &3.4998e+00_r8,2.7840e+00_r8,2.0042e+00_r8,1.1322e+00_r8,3.4655e-02_r8/) + kbo(:, 3,26, 5) = (/ & + &3.6839e+00_r8,2.9244e+00_r8,2.1044e+00_r8,1.1892e+00_r8,3.6289e-02_r8/) + kbo(:, 4,26, 5) = (/ & + &3.8971e+00_r8,3.0834e+00_r8,2.2165e+00_r8,1.2514e+00_r8,3.7614e-02_r8/) + kbo(:, 5,26, 5) = (/ & + &4.1266e+00_r8,3.2542e+00_r8,2.3379e+00_r8,1.3199e+00_r8,3.8535e-02_r8/) + kbo(:, 1,27, 5) = (/ & + &2.7587e+00_r8,2.2186e+00_r8,1.5971e+00_r8,9.0467e-01_r8,2.7863e-02_r8/) + kbo(:, 2,27, 5) = (/ & + &2.9012e+00_r8,2.3317e+00_r8,1.6793e+00_r8,9.5148e-01_r8,2.9310e-02_r8/) + kbo(:, 3,27, 5) = (/ & + &3.0653e+00_r8,2.4577e+00_r8,1.7694e+00_r8,1.0026e+00_r8,3.0500e-02_r8/) + kbo(:, 4,27, 5) = (/ & + &3.2491e+00_r8,2.5968e+00_r8,1.8696e+00_r8,1.0593e+00_r8,3.1389e-02_r8/) + kbo(:, 5,27, 5) = (/ & + &3.4443e+00_r8,2.7432e+00_r8,1.9752e+00_r8,1.1204e+00_r8,3.1994e-02_r8/) + kbo(:, 1,28, 5) = (/ & + &2.3461e+00_r8,1.9019e+00_r8,1.3684e+00_r8,7.7601e-01_r8,2.3534e-02_r8/) + kbo(:, 2,28, 5) = (/ & + &2.4760e+00_r8,2.0059e+00_r8,1.4439e+00_r8,8.1944e-01_r8,2.4611e-02_r8/) + kbo(:, 3,28, 5) = (/ & + &2.6235e+00_r8,2.1209e+00_r8,1.5268e+00_r8,8.6687e-01_r8,2.5434e-02_r8/) + kbo(:, 4,28, 5) = (/ & + &2.7836e+00_r8,2.2441e+00_r8,1.6160e+00_r8,9.1849e-01_r8,2.6044e-02_r8/) + kbo(:, 5,28, 5) = (/ & + &2.9562e+00_r8,2.3753e+00_r8,1.7120e+00_r8,9.7389e-01_r8,2.6449e-02_r8/) + kbo(:, 1,29, 5) = (/ & + &2.1229e+00_r8,1.7281e+00_r8,1.2411e+00_r8,7.0258e-01_r8,1.9767e-02_r8/) + kbo(:, 2,29, 5) = (/ & + &2.2483e+00_r8,1.8286e+00_r8,1.3142e+00_r8,7.4438e-01_r8,2.0526e-02_r8/) + kbo(:, 3,29, 5) = (/ & + &2.3867e+00_r8,1.9376e+00_r8,1.3932e+00_r8,7.8990e-01_r8,2.1121e-02_r8/) + kbo(:, 4,29, 5) = (/ & + &2.5370e+00_r8,2.0544e+00_r8,1.4782e+00_r8,8.3936e-01_r8,2.1540e-02_r8/) + kbo(:, 5,29, 5) = (/ & + &2.7005e+00_r8,2.1808e+00_r8,1.5709e+00_r8,8.9251e-01_r8,2.1826e-02_r8/) + kbo(:, 1,30, 5) = (/ & + &1.9731e+00_r8,1.6098e+00_r8,1.1534e+00_r8,6.5097e-01_r8,1.6498e-02_r8/) + kbo(:, 2,30, 5) = (/ & + &2.0958e+00_r8,1.7088e+00_r8,1.2257e+00_r8,6.9208e-01_r8,1.7054e-02_r8/) + kbo(:, 3,30, 5) = (/ & + &2.2285e+00_r8,1.8139e+00_r8,1.3022e+00_r8,7.3642e-01_r8,1.7482e-02_r8/) + kbo(:, 4,30, 5) = (/ & + &2.3729e+00_r8,1.9280e+00_r8,1.3861e+00_r8,7.8518e-01_r8,1.7790e-02_r8/) + kbo(:, 5,30, 5) = (/ & + &2.5353e+00_r8,2.0546e+00_r8,1.4785e+00_r8,8.3767e-01_r8,1.7989e-02_r8/) + kbo(:, 1,31, 5) = (/ & + &1.9340e+00_r8,1.5772e+00_r8,1.1264e+00_r8,6.3182e-01_r8,1.3731e-02_r8/) + kbo(:, 2,31, 5) = (/ & + &2.0574e+00_r8,1.6773e+00_r8,1.1995e+00_r8,6.7358e-01_r8,1.4152e-02_r8/) + kbo(:, 3,31, 5) = (/ & + &2.1914e+00_r8,1.7848e+00_r8,1.2781e+00_r8,7.1915e-01_r8,1.4466e-02_r8/) + kbo(:, 4,31, 5) = (/ & + &2.3406e+00_r8,1.9025e+00_r8,1.3648e+00_r8,7.6925e-01_r8,1.4687e-02_r8/) + kbo(:, 5,31, 5) = (/ & + &2.5107e+00_r8,2.0354e+00_r8,1.4612e+00_r8,8.2397e-01_r8,1.4843e-02_r8/) + kbo(:, 1,32, 5) = (/ & + &1.9204e+00_r8,1.5654e+00_r8,1.1148e+00_r8,6.2147e-01_r8,1.1411e-02_r8/) + kbo(:, 2,32, 5) = (/ & + &2.0455e+00_r8,1.6672e+00_r8,1.1895e+00_r8,6.6431e-01_r8,1.1723e-02_r8/) + kbo(:, 3,32, 5) = (/ & + &2.1839e+00_r8,1.7785e+00_r8,1.2711e+00_r8,7.1180e-01_r8,1.1953e-02_r8/) + kbo(:, 4,32, 5) = (/ & + &2.3424e+00_r8,1.9038e+00_r8,1.3629e+00_r8,7.6419e-01_r8,1.2125e-02_r8/) + kbo(:, 5,32, 5) = (/ & + &2.5216e+00_r8,2.0435e+00_r8,1.4643e+00_r8,8.2232e-01_r8,1.2240e-02_r8/) + kbo(:, 1,33, 5) = (/ & + &1.9423e+00_r8,1.5823e+00_r8,1.1236e+00_r8,6.2280e-01_r8,9.4667e-03_r8/) + kbo(:, 2,33, 5) = (/ & + &2.0728e+00_r8,1.6884e+00_r8,1.2018e+00_r8,6.6778e-01_r8,9.6991e-03_r8/) + kbo(:, 3,33, 5) = (/ & + &2.2222e+00_r8,1.8079e+00_r8,1.2892e+00_r8,7.1818e-01_r8,9.8807e-03_r8/) + kbo(:, 4,33, 5) = (/ & + &2.3928e+00_r8,1.9430e+00_r8,1.3880e+00_r8,7.7444e-01_r8,1.0013e-02_r8/) + kbo(:, 5,33, 5) = (/ & + &2.5873e+00_r8,2.0935e+00_r8,1.4975e+00_r8,8.3717e-01_r8,1.0093e-02_r8/) + kbo(:, 1,34, 5) = (/ & + &1.9127e+00_r8,1.5588e+00_r8,1.1053e+00_r8,6.1048e-01_r8,7.8309e-03_r8/) + kbo(:, 2,34, 5) = (/ & + &2.0473e+00_r8,1.6687e+00_r8,1.1862e+00_r8,6.5698e-01_r8,8.0168e-03_r8/) + kbo(:, 3,34, 5) = (/ & + &2.2050e+00_r8,1.7947e+00_r8,1.2785e+00_r8,7.0977e-01_r8,8.1571e-03_r8/) + kbo(:, 4,34, 5) = (/ & + &2.3844e+00_r8,1.9366e+00_r8,1.3818e+00_r8,7.6872e-01_r8,8.2588e-03_r8/) + kbo(:, 5,34, 5) = (/ & + &2.5878e+00_r8,2.0945e+00_r8,1.4977e+00_r8,8.3524e-01_r8,8.3102e-03_r8/) + kbo(:, 1,35, 5) = (/ & + &1.8762e+00_r8,1.5298e+00_r8,1.0833e+00_r8,5.9624e-01_r8,6.4645e-03_r8/) + kbo(:, 2,35, 5) = (/ & + &2.0161e+00_r8,1.6440e+00_r8,1.1673e+00_r8,6.4448e-01_r8,6.6144e-03_r8/) + kbo(:, 3,35, 5) = (/ & + &2.1796e+00_r8,1.7750e+00_r8,1.2632e+00_r8,6.9909e-01_r8,6.7276e-03_r8/) + kbo(:, 4,35, 5) = (/ & + &2.3668e+00_r8,1.9227e+00_r8,1.3710e+00_r8,7.6090e-01_r8,6.8022e-03_r8/) + kbo(:, 5,35, 5) = (/ & + &2.5757e+00_r8,2.0863e+00_r8,1.4915e+00_r8,8.3029e-01_r8,6.8468e-03_r8/) + kbo(:, 1,36, 5) = (/ & + &1.8177e+00_r8,1.4833e+00_r8,1.0492e+00_r8,5.7567e-01_r8,5.3254e-03_r8/) + kbo(:, 2,36, 5) = (/ & + &1.9605e+00_r8,1.6001e+00_r8,1.1349e+00_r8,6.2477e-01_r8,5.4464e-03_r8/) + kbo(:, 3,36, 5) = (/ & + &2.1269e+00_r8,1.7343e+00_r8,1.2332e+00_r8,6.8062e-01_r8,5.5407e-03_r8/) + kbo(:, 4,36, 5) = (/ & + &2.3182e+00_r8,1.8849e+00_r8,1.3435e+00_r8,7.4416e-01_r8,5.6019e-03_r8/) + kbo(:, 5,36, 5) = (/ & + &2.5291e+00_r8,2.0513e+00_r8,1.4663e+00_r8,8.1509e-01_r8,5.6408e-03_r8/) + kbo(:, 1,37, 5) = (/ & + &1.6997e+00_r8,1.3894e+00_r8,9.8190e-01_r8,5.3748e-01_r8,4.3666e-03_r8/) + kbo(:, 2,37, 5) = (/ & + &1.8378e+00_r8,1.5030e+00_r8,1.0654e+00_r8,5.8540e-01_r8,4.4691e-03_r8/) + kbo(:, 3,37, 5) = (/ & + &1.9994e+00_r8,1.6341e+00_r8,1.1617e+00_r8,6.4019e-01_r8,4.5481e-03_r8/) + kbo(:, 4,37, 5) = (/ & + &2.1860e+00_r8,1.7826e+00_r8,1.2707e+00_r8,7.0283e-01_r8,4.6056e-03_r8/) + kbo(:, 5,37, 5) = (/ & + &2.3914e+00_r8,1.9456e+00_r8,1.3911e+00_r8,7.7270e-01_r8,4.6416e-03_r8/) + kbo(:, 1,38, 5) = (/ & + &1.6123e+00_r8,1.3193e+00_r8,9.3139e-01_r8,5.0849e-01_r8,3.5784e-03_r8/) + kbo(:, 2,38, 5) = (/ & + &1.7479e+00_r8,1.4316e+00_r8,1.0139e+00_r8,5.5580e-01_r8,3.6670e-03_r8/) + kbo(:, 3,38, 5) = (/ & + &1.9074e+00_r8,1.5615e+00_r8,1.1092e+00_r8,6.1015e-01_r8,3.7371e-03_r8/) + kbo(:, 4,38, 5) = (/ & + &2.0911e+00_r8,1.7089e+00_r8,1.2176e+00_r8,6.7256e-01_r8,3.7869e-03_r8/) + kbo(:, 5,38, 5) = (/ & + &2.2948e+00_r8,1.8712e+00_r8,1.3379e+00_r8,7.4236e-01_r8,3.8180e-03_r8/) + kbo(:, 1,39, 5) = (/ & + &1.5653e+00_r8,1.2809e+00_r8,9.0306e-01_r8,4.9152e-01_r8,2.9339e-03_r8/) + kbo(:, 2,39, 5) = (/ & + &1.7011e+00_r8,1.3939e+00_r8,9.8605e-01_r8,5.3903e-01_r8,3.0110e-03_r8/) + kbo(:, 3,39, 5) = (/ & + &1.8625e+00_r8,1.5257e+00_r8,1.0827e+00_r8,5.9416e-01_r8,3.0720e-03_r8/) + kbo(:, 4,39, 5) = (/ & + &2.0480e+00_r8,1.6749e+00_r8,1.1927e+00_r8,6.5763e-01_r8,3.1176e-03_r8/) + kbo(:, 5,39, 5) = (/ & + &2.2545e+00_r8,1.8403e+00_r8,1.3150e+00_r8,7.2854e-01_r8,3.1424e-03_r8/) + kbo(:, 1,40, 5) = (/ & + &1.4161e+00_r8,1.1618e+00_r8,8.1883e-01_r8,4.4506e-01_r8,2.3961e-03_r8/) + kbo(:, 2,40, 5) = (/ & + &1.5422e+00_r8,1.2675e+00_r8,8.9661e-01_r8,4.8961e-01_r8,2.4634e-03_r8/) + kbo(:, 3,40, 5) = (/ & + &1.6929e+00_r8,1.3914e+00_r8,9.8762e-01_r8,5.4178e-01_r8,2.5182e-03_r8/) + kbo(:, 4,40, 5) = (/ & + &1.8671e+00_r8,1.5327e+00_r8,1.0918e+00_r8,6.0196e-01_r8,2.5595e-03_r8/) + kbo(:, 5,40, 5) = (/ & + &2.0610e+00_r8,1.6900e+00_r8,1.2084e+00_r8,6.6961e-01_r8,2.5831e-03_r8/) + kbo(:, 1,41, 5) = (/ & + &1.2765e+00_r8,1.0500e+00_r8,7.3977e-01_r8,4.0158e-01_r8,1.9558e-03_r8/) + kbo(:, 2,41, 5) = (/ & + &1.3934e+00_r8,1.1486e+00_r8,8.1252e-01_r8,4.4320e-01_r8,2.0159e-03_r8/) + kbo(:, 3,41, 5) = (/ & + &1.5329e+00_r8,1.2644e+00_r8,8.9774e-01_r8,4.9220e-01_r8,2.0644e-03_r8/) + kbo(:, 4,41, 5) = (/ & + &1.6957e+00_r8,1.3977e+00_r8,9.9605e-01_r8,5.4916e-01_r8,2.0998e-03_r8/) + kbo(:, 5,41, 5) = (/ & + &1.8778e+00_r8,1.5466e+00_r8,1.1067e+00_r8,6.1346e-01_r8,2.1224e-03_r8/) + kbo(:, 1,42, 5) = (/ & + &1.1627e+00_r8,9.5841e-01_r8,6.7494e-01_r8,3.6583e-01_r8,1.5975e-03_r8/) + kbo(:, 2,42, 5) = (/ & + &1.2723e+00_r8,1.0513e+00_r8,7.4339e-01_r8,4.0496e-01_r8,1.6498e-03_r8/) + kbo(:, 3,42, 5) = (/ & + &1.4029e+00_r8,1.1604e+00_r8,8.2397e-01_r8,4.5136e-01_r8,1.6921e-03_r8/) + kbo(:, 4,42, 5) = (/ & + &1.5564e+00_r8,1.2873e+00_r8,9.1770e-01_r8,5.0574e-01_r8,1.7229e-03_r8/) + kbo(:, 5,42, 5) = (/ & + &1.7292e+00_r8,1.4295e+00_r8,1.0235e+00_r8,5.6732e-01_r8,1.7439e-03_r8/) + kbo(:, 1,43, 5) = (/ & + &1.0630e+00_r8,8.7767e-01_r8,6.1763e-01_r8,3.3410e-01_r8,1.3020e-03_r8/) + kbo(:, 2,43, 5) = (/ & + &1.1654e+00_r8,9.6474e-01_r8,6.8178e-01_r8,3.7078e-01_r8,1.3472e-03_r8/) + kbo(:, 3,43, 5) = (/ & + &1.2879e+00_r8,1.0676e+00_r8,7.5775e-01_r8,4.1456e-01_r8,1.3843e-03_r8/) + kbo(:, 4,43, 5) = (/ & + &1.4323e+00_r8,1.1883e+00_r8,8.4702e-01_r8,4.6628e-01_r8,1.4122e-03_r8/) + kbo(:, 5,43, 5) = (/ & + &1.5961e+00_r8,1.3241e+00_r8,9.4813e-01_r8,5.2525e-01_r8,1.4316e-03_r8/) + kbo(:, 1,44, 5) = (/ & + &9.8265e-01_r8,8.1189e-01_r8,5.7078e-01_r8,3.0805e-01_r8,1.0595e-03_r8/) + kbo(:, 2,44, 5) = (/ & + &1.0790e+00_r8,8.9402e-01_r8,6.3105e-01_r8,3.4248e-01_r8,1.0984e-03_r8/) + kbo(:, 3,44, 5) = (/ & + &1.1944e+00_r8,9.9169e-01_r8,7.0312e-01_r8,3.8396e-01_r8,1.1318e-03_r8/) + kbo(:, 4,44, 5) = (/ & + &1.3318e+00_r8,1.1077e+00_r8,7.8899e-01_r8,4.3356e-01_r8,1.1566e-03_r8/) + kbo(:, 5,44, 5) = (/ & + &1.4887e+00_r8,1.2383e+00_r8,8.8644e-01_r8,4.9053e-01_r8,1.1752e-03_r8/) + kbo(:, 1,45, 5) = (/ & + &9.2676e-01_r8,7.6543e-01_r8,5.3731e-01_r8,2.8917e-01_r8,8.6207e-04_r8/) + kbo(:, 2,45, 5) = (/ & + &1.0188e+00_r8,8.4420e-01_r8,5.9503e-01_r8,3.2211e-01_r8,8.9589e-04_r8/) + kbo(:, 3,45, 5) = (/ & + &1.1295e+00_r8,9.3840e-01_r8,6.6449e-01_r8,3.6207e-01_r8,9.2491e-04_r8/) + kbo(:, 4,45, 5) = (/ & + &1.2624e+00_r8,1.0512e+00_r8,7.4797e-01_r8,4.1011e-01_r8,9.4724e-04_r8/) + kbo(:, 5,45, 5) = (/ & + &1.4159e+00_r8,1.1794e+00_r8,8.4359e-01_r8,4.6598e-01_r8,9.6431e-04_r8/) + kbo(:, 1,46, 5) = (/ & + &8.8115e-01_r8,7.2712e-01_r8,5.0946e-01_r8,2.7333e-01_r8,7.0044e-04_r8/) + kbo(:, 2,46, 5) = (/ & + &9.6873e-01_r8,8.0252e-01_r8,5.6477e-01_r8,3.0486e-01_r8,7.2940e-04_r8/) + kbo(:, 3,46, 5) = (/ & + &1.0759e+00_r8,8.9393e-01_r8,6.3210e-01_r8,3.4344e-01_r8,7.5456e-04_r8/) + kbo(:, 4,46, 5) = (/ & + &1.2051e+00_r8,1.0038e+00_r8,7.1323e-01_r8,3.9017e-01_r8,7.7543e-04_r8/) + kbo(:, 5,46, 5) = (/ & + &1.3559e+00_r8,1.1306e+00_r8,8.0761e-01_r8,4.4513e-01_r8,7.9123e-04_r8/) + kbo(:, 1,47, 5) = (/ & + &8.2708e-01_r8,6.8179e-01_r8,4.7670e-01_r8,2.5496e-01_r8,5.6723e-04_r8/) + kbo(:, 2,47, 5) = (/ & + &9.0841e-01_r8,7.5254e-01_r8,5.2877e-01_r8,2.8459e-01_r8,5.9237e-04_r8/) + kbo(:, 3,47, 5) = (/ & + &1.0102e+00_r8,8.3938e-01_r8,5.9264e-01_r8,3.2108e-01_r8,6.1461e-04_r8/) + kbo(:, 4,47, 5) = (/ & + &1.1336e+00_r8,9.4433e-01_r8,6.7005e-01_r8,3.6564e-01_r8,6.3367e-04_r8/) + kbo(:, 5,47, 5) = (/ & + &1.2789e+00_r8,1.0675e+00_r8,7.6147e-01_r8,4.1873e-01_r8,6.4826e-04_r8/) + kbo(:, 1,48, 5) = (/ & + &7.9882e-01_r8,6.5670e-01_r8,4.5801e-01_r8,2.4404e-01_r8,4.5910e-04_r8/) + kbo(:, 2,48, 5) = (/ & + &8.7602e-01_r8,7.2469e-01_r8,5.0814e-01_r8,2.7259e-01_r8,4.8082e-04_r8/) + kbo(:, 3,48, 5) = (/ & + &9.7485e-01_r8,8.0906e-01_r8,5.6998e-01_r8,3.0783e-01_r8,5.0059e-04_r8/) + kbo(:, 4,48, 5) = (/ & + &1.0951e+00_r8,9.1136e-01_r8,6.4533e-01_r8,3.5105e-01_r8,5.1769e-04_r8/) + kbo(:, 5,48, 5) = (/ & + &1.2389e+00_r8,1.0335e+00_r8,7.3563e-01_r8,4.0331e-01_r8,5.3087e-04_r8/) + kbo(:, 1,49, 5) = (/ & + &8.0402e-01_r8,6.5823e-01_r8,4.5761e-01_r8,2.4276e-01_r8,3.7137e-04_r8/) + kbo(:, 2,49, 5) = (/ & + &8.8031e-01_r8,7.2577e-01_r8,5.0751e-01_r8,2.7123e-01_r8,3.9017e-04_r8/) + kbo(:, 3,49, 5) = (/ & + &9.7946e-01_r8,8.1065e-01_r8,5.6941e-01_r8,3.0628e-01_r8,4.0777e-04_r8/) + kbo(:, 4,49, 5) = (/ & + &1.1011e+00_r8,9.1410e-01_r8,6.4521e-01_r8,3.4961e-01_r8,4.2272e-04_r8/) + kbo(:, 5,49, 5) = (/ & + &1.2484e+00_r8,1.0389e+00_r8,7.3730e-01_r8,4.0277e-01_r8,4.3479e-04_r8/) + kbo(:, 1,50, 5) = (/ & + &7.7254e-01_r8,6.3104e-01_r8,4.3765e-01_r8,2.3137e-01_r8,3.0017e-04_r8/) + kbo(:, 2,50, 5) = (/ & + &8.4478e-01_r8,6.9541e-01_r8,4.8529e-01_r8,2.5862e-01_r8,3.1617e-04_r8/) + kbo(:, 3,50, 5) = (/ & + &9.3925e-01_r8,7.7679e-01_r8,5.4465e-01_r8,2.9213e-01_r8,3.3160e-04_r8/) + kbo(:, 4,50, 5) = (/ & + &1.0567e+00_r8,8.7678e-01_r8,6.1788e-01_r8,3.3395e-01_r8,3.4487e-04_r8/) + kbo(:, 5,50, 5) = (/ & + &1.2008e+00_r8,9.9924e-01_r8,7.0798e-01_r8,3.8577e-01_r8,3.5577e-04_r8/) + kbo(:, 1,51, 5) = (/ & + &7.2669e-01_r8,5.9284e-01_r8,4.1030e-01_r8,2.1627e-01_r8,2.4246e-04_r8/) + kbo(:, 2,51, 5) = (/ & + &7.9410e-01_r8,6.5300e-01_r8,4.5497e-01_r8,2.4184e-01_r8,2.5602e-04_r8/) + kbo(:, 3,51, 5) = (/ & + &8.8167e-01_r8,7.2916e-01_r8,5.1056e-01_r8,2.7327e-01_r8,2.6933e-04_r8/) + kbo(:, 4,51, 5) = (/ & + &9.9265e-01_r8,8.2410e-01_r8,5.8011e-01_r8,3.1286e-01_r8,2.8099e-04_r8/) + kbo(:, 5,51, 5) = (/ & + &1.1303e+00_r8,9.4117e-01_r8,6.6603e-01_r8,3.6222e-01_r8,2.9075e-04_r8/) + kbo(:, 1,52, 5) = (/ & + &7.0293e-01_r8,5.7224e-01_r8,3.9526e-01_r8,2.0761e-01_r8,1.9566e-04_r8/) + kbo(:, 2,52, 5) = (/ & + &7.6814e-01_r8,6.3021e-01_r8,4.3806e-01_r8,2.3215e-01_r8,2.0717e-04_r8/) + kbo(:, 3,52, 5) = (/ & + &8.5099e-01_r8,7.0282e-01_r8,4.9133e-01_r8,2.6231e-01_r8,2.1874e-04_r8/) + kbo(:, 4,52, 5) = (/ & + &9.5857e-01_r8,7.9517e-01_r8,5.5876e-01_r8,3.0061e-01_r8,2.2893e-04_r8/) + kbo(:, 5,52, 5) = (/ & + &1.0928e+00_r8,9.0923e-01_r8,6.4230e-01_r8,3.4850e-01_r8,2.3751e-04_r8/) + kbo(:, 1,53, 5) = (/ & + &7.0799e-01_r8,5.7451e-01_r8,3.9589e-01_r8,2.0725e-01_r8,1.5775e-04_r8/) + kbo(:, 2,53, 5) = (/ & + &7.7421e-01_r8,6.3284e-01_r8,4.3870e-01_r8,2.3160e-01_r8,1.6771e-04_r8/) + kbo(:, 3,53, 5) = (/ & + &8.5551e-01_r8,7.0456e-01_r8,4.9136e-01_r8,2.6152e-01_r8,1.7761e-04_r8/) + kbo(:, 4,53, 5) = (/ & + &9.6362e-01_r8,7.9737e-01_r8,5.5891e-01_r8,2.9974e-01_r8,1.8647e-04_r8/) + kbo(:, 5,53, 5) = (/ & + &1.0993e+00_r8,9.1246e-01_r8,6.4296e-01_r8,3.4771e-01_r8,1.9425e-04_r8/) + kbo(:, 1,54, 5) = (/ & + &6.1781e-01_r8,5.0174e-01_r8,3.4551e-01_r8,1.8062e-01_r8,1.2698e-04_r8/) + kbo(:, 2,54, 5) = (/ & + &6.7617e-01_r8,5.5332e-01_r8,3.8324e-01_r8,2.0204e-01_r8,1.3548e-04_r8/) + kbo(:, 3,54, 5) = (/ & + &7.4609e-01_r8,6.1568e-01_r8,4.2927e-01_r8,2.2831e-01_r8,1.4360e-04_r8/) + kbo(:, 4,54, 5) = (/ & + &8.3975e-01_r8,6.9703e-01_r8,4.8868e-01_r8,2.6191e-01_r8,1.5134e-04_r8/) + kbo(:, 5,54, 5) = (/ & + &9.5851e-01_r8,7.9875e-01_r8,5.6310e-01_r8,3.0440e-01_r8,1.5803e-04_r8/) + kbo(:, 1,55, 5) = (/ & + &4.9218e-01_r8,4.0097e-01_r8,2.7614e-01_r8,1.4430e-01_r8,1.0197e-04_r8/) + kbo(:, 2,55, 5) = (/ & + &5.3911e-01_r8,4.4293e-01_r8,3.0686e-01_r8,1.6168e-01_r8,1.0930e-04_r8/) + kbo(:, 3,55, 5) = (/ & + &5.9446e-01_r8,4.9291e-01_r8,3.4401e-01_r8,1.8302e-01_r8,1.1592e-04_r8/) + kbo(:, 4,55, 5) = (/ & + &6.6816e-01_r8,5.5826e-01_r8,3.9205e-01_r8,2.1030e-01_r8,1.2249e-04_r8/) + kbo(:, 5,55, 5) = (/ & + &7.6300e-01_r8,6.4076e-01_r8,4.5273e-01_r8,2.4510e-01_r8,1.2815e-04_r8/) + kbo(:, 1,56, 5) = (/ & + &3.9213e-01_r8,3.2040e-01_r8,2.2062e-01_r8,1.1519e-01_r8,8.1886e-05_r8/) + kbo(:, 2,56, 5) = (/ & + &4.2970e-01_r8,3.5433e-01_r8,2.4555e-01_r8,1.2928e-01_r8,8.8029e-05_r8/) + kbo(:, 3,56, 5) = (/ & + &4.7372e-01_r8,3.9458e-01_r8,2.7557e-01_r8,1.4657e-01_r8,9.3592e-05_r8/) + kbo(:, 4,56, 5) = (/ & + &5.3136e-01_r8,4.4682e-01_r8,3.1425e-01_r8,1.6867e-01_r8,9.8924e-05_r8/) + kbo(:, 5,56, 5) = (/ & + &6.0680e-01_r8,5.1356e-01_r8,3.6377e-01_r8,1.9714e-01_r8,1.0388e-04_r8/) + kbo(:, 1,57, 5) = (/ & + &3.1256e-01_r8,2.5603e-01_r8,1.7627e-01_r8,9.1926e-02_r8,6.5686e-05_r8/) + kbo(:, 2,57, 5) = (/ & + &3.4230e-01_r8,2.8322e-01_r8,1.9630e-01_r8,1.0325e-01_r8,7.0810e-05_r8/) + kbo(:, 3,57, 5) = (/ & + &3.7748e-01_r8,3.1574e-01_r8,2.2058e-01_r8,1.1723e-01_r8,7.5533e-05_r8/) + kbo(:, 4,57, 5) = (/ & + &4.2229e-01_r8,3.5725e-01_r8,2.5162e-01_r8,1.3506e-01_r8,7.9907e-05_r8/) + kbo(:, 5,57, 5) = (/ & + &4.8209e-01_r8,4.1127e-01_r8,2.9188e-01_r8,1.5833e-01_r8,8.4096e-05_r8/) + kbo(:, 1,58, 5) = (/ & + &6.5834e-02_r8,6.6132e-02_r8,5.8548e-02_r8,4.2734e-02_r8,5.2667e-05_r8/) + kbo(:, 2,58, 5) = (/ & + &7.1968e-02_r8,7.3109e-02_r8,6.5197e-02_r8,4.8002e-02_r8,5.6984e-05_r8/) + kbo(:, 3,58, 5) = (/ & + &7.9437e-02_r8,8.1656e-02_r8,7.3428e-02_r8,5.4631e-02_r8,6.0874e-05_r8/) + kbo(:, 4,58, 5) = (/ & + &8.8662e-02_r8,9.2383e-02_r8,8.3809e-02_r8,6.3035e-02_r8,6.4619e-05_r8/) + kbo(:, 5,58, 5) = (/ & + &1.0118e-01_r8,1.0653e-01_r8,9.7458e-02_r8,7.4110e-02_r8,6.7988e-05_r8/) + kbo(:, 1,59, 5) = (/ & + &6.3055e-02_r8,6.1069e-02_r8,5.0451e-02_r8,3.2825e-02_r8,4.2796e-05_r8/) + kbo(:, 2,59, 5) = (/ & + &6.8995e-02_r8,6.7782e-02_r8,5.6462e-02_r8,3.7059e-02_r8,4.6289e-05_r8/) + kbo(:, 3,59, 5) = (/ & + &7.6280e-02_r8,7.6111e-02_r8,6.4009e-02_r8,4.2464e-02_r8,4.9459e-05_r8/) + kbo(:, 4,59, 5) = (/ & + &8.5284e-02_r8,8.6606e-02_r8,7.3583e-02_r8,4.9384e-02_r8,5.2442e-05_r8/) + kbo(:, 5,59, 5) = (/ & + &9.7585e-02_r8,1.0050e-01_r8,8.6230e-02_r8,5.8574e-02_r8,5.5198e-05_r8/) + kbo(:, 1,13, 6) = (/ & + &7.7180e+02_r8,5.7896e+02_r8,3.8611e+02_r8,1.9327e+02_r8,3.6289e-01_r8/) + kbo(:, 2,13, 6) = (/ & + &7.9285e+02_r8,5.9474e+02_r8,3.9664e+02_r8,1.9853e+02_r8,3.7298e-01_r8/) + kbo(:, 3,13, 6) = (/ & + &8.1518e+02_r8,6.1149e+02_r8,4.0780e+02_r8,2.0411e+02_r8,3.8121e-01_r8/) + kbo(:, 4,13, 6) = (/ & + &8.3776e+02_r8,6.2842e+02_r8,4.1908e+02_r8,2.0974e+02_r8,3.8734e-01_r8/) + kbo(:, 5,13, 6) = (/ & + &8.6087e+02_r8,6.4575e+02_r8,4.3063e+02_r8,2.1551e+02_r8,3.9230e-01_r8/) + kbo(:, 1,14, 6) = (/ & + &4.1395e+02_r8,3.1056e+02_r8,2.0718e+02_r8,1.0380e+02_r8,3.3381e-01_r8/) + kbo(:, 2,14, 6) = (/ & + &4.2539e+02_r8,3.1915e+02_r8,2.1290e+02_r8,1.0666e+02_r8,3.4169e-01_r8/) + kbo(:, 3,14, 6) = (/ & + &4.3723e+02_r8,3.2803e+02_r8,2.1882e+02_r8,1.0962e+02_r8,3.4947e-01_r8/) + kbo(:, 4,14, 6) = (/ & + &4.4927e+02_r8,3.3705e+02_r8,2.2483e+02_r8,1.1261e+02_r8,3.5567e-01_r8/) + kbo(:, 5,14, 6) = (/ & + &4.6195e+02_r8,3.4656e+02_r8,2.3117e+02_r8,1.1578e+02_r8,3.6065e-01_r8/) + kbo(:, 1,15, 6) = (/ & + &2.2585e+02_r8,1.6949e+02_r8,1.1313e+02_r8,5.6770e+01_r8,3.0356e-01_r8/) + kbo(:, 2,15, 6) = (/ & + &2.3201e+02_r8,1.7411e+02_r8,1.1621e+02_r8,5.8311e+01_r8,3.1091e-01_r8/) + kbo(:, 3,15, 6) = (/ & + &2.3839e+02_r8,1.7889e+02_r8,1.1939e+02_r8,5.9899e+01_r8,3.1810e-01_r8/) + kbo(:, 4,15, 6) = (/ & + &2.4502e+02_r8,1.8386e+02_r8,1.2270e+02_r8,6.1544e+01_r8,3.2391e-01_r8/) + kbo(:, 5,15, 6) = (/ & + &2.5289e+02_r8,1.8977e+02_r8,1.2664e+02_r8,6.3520e+01_r8,3.2850e-01_r8/) + kbo(:, 1,16, 6) = (/ & + &1.4635e+02_r8,1.0986e+02_r8,7.3372e+01_r8,3.6890e+01_r8,2.7344e-01_r8/) + kbo(:, 2,16, 6) = (/ & + &1.5031e+02_r8,1.1283e+02_r8,7.5356e+01_r8,3.7881e+01_r8,2.8092e-01_r8/) + kbo(:, 3,16, 6) = (/ & + &1.5444e+02_r8,1.1592e+02_r8,7.7407e+01_r8,3.8900e+01_r8,2.8781e-01_r8/) + kbo(:, 4,16, 6) = (/ & + &1.5922e+02_r8,1.1951e+02_r8,7.9797e+01_r8,4.0091e+01_r8,2.9332e-01_r8/) + kbo(:, 5,16, 6) = (/ & + &1.6548e+02_r8,1.2420e+02_r8,8.2930e+01_r8,4.1661e+01_r8,2.9808e-01_r8/) + kbo(:, 1,17, 6) = (/ & + &9.8142e+01_r8,7.3705e+01_r8,4.9268e+01_r8,2.4840e+01_r8,2.4429e-01_r8/) + kbo(:, 2,17, 6) = (/ & + &1.0076e+02_r8,7.5668e+01_r8,5.0576e+01_r8,2.5493e+01_r8,2.5184e-01_r8/) + kbo(:, 3,17, 6) = (/ & + &1.0378e+02_r8,7.7926e+01_r8,5.2073e+01_r8,2.6235e+01_r8,2.5821e-01_r8/) + kbo(:, 4,17, 6) = (/ & + &1.0768e+02_r8,8.0849e+01_r8,5.4024e+01_r8,2.7211e+01_r8,2.6339e-01_r8/) + kbo(:, 5,17, 6) = (/ & + &1.1267e+02_r8,8.4599e+01_r8,5.6526e+01_r8,2.8462e+01_r8,2.6841e-01_r8/) + kbo(:, 1,18, 6) = (/ & + &6.7329e+01_r8,5.0594e+01_r8,3.3862e+01_r8,1.7162e+01_r8,2.1677e-01_r8/) + kbo(:, 2,18, 6) = (/ & + &6.9224e+01_r8,5.2009e+01_r8,3.4803e+01_r8,1.7627e+01_r8,2.2376e-01_r8/) + kbo(:, 3,18, 6) = (/ & + &7.1671e+01_r8,5.3842e+01_r8,3.6019e+01_r8,1.8223e+01_r8,2.2981e-01_r8/) + kbo(:, 4,18, 6) = (/ & + &7.4922e+01_r8,5.6283e+01_r8,3.7648e+01_r8,1.9036e+01_r8,2.3516e-01_r8/) + kbo(:, 5,18, 6) = (/ & + &7.8609e+01_r8,5.9048e+01_r8,3.9493e+01_r8,1.9956e+01_r8,2.4055e-01_r8/) + kbo(:, 1,19, 6) = (/ & + &4.5351e+01_r8,3.4111e+01_r8,2.2879e+01_r8,1.1748e+01_r8,1.9068e-01_r8/) + kbo(:, 2,19, 6) = (/ & + &4.6788e+01_r8,3.5180e+01_r8,2.3587e+01_r8,1.2086e+01_r8,1.9727e-01_r8/) + kbo(:, 3,19, 6) = (/ & + &4.8819e+01_r8,3.6704e+01_r8,2.4596e+01_r8,1.2571e+01_r8,2.0322e-01_r8/) + kbo(:, 4,19, 6) = (/ & + &5.1243e+01_r8,3.8523e+01_r8,2.5810e+01_r8,1.3165e+01_r8,2.0895e-01_r8/) + kbo(:, 5,19, 6) = (/ & + &5.3759e+01_r8,4.0411e+01_r8,2.7071e+01_r8,1.3784e+01_r8,2.1468e-01_r8/) + kbo(:, 1,20, 6) = (/ & + &3.3050e+01_r8,2.4885e+01_r8,1.6741e+01_r8,8.7700e+00_r8,1.6695e-01_r8/) + kbo(:, 2,20, 6) = (/ & + &3.4346e+01_r8,2.5850e+01_r8,1.7375e+01_r8,9.0666e+00_r8,1.7321e-01_r8/) + kbo(:, 3,20, 6) = (/ & + &3.6031e+01_r8,2.7114e+01_r8,1.8213e+01_r8,9.4660e+00_r8,1.7929e-01_r8/) + kbo(:, 4,20, 6) = (/ & + &3.7866e+01_r8,2.8491e+01_r8,1.9130e+01_r8,9.9045e+00_r8,1.8515e-01_r8/) + kbo(:, 5,20, 6) = (/ & + &3.9713e+01_r8,2.9876e+01_r8,2.0052e+01_r8,1.0350e+01_r8,1.9066e-01_r8/) + kbo(:, 1,21, 6) = (/ & + &2.4844e+01_r8,1.8731e+01_r8,1.2673e+01_r8,6.7851e+00_r8,1.4553e-01_r8/) + kbo(:, 2,21, 6) = (/ & + &2.6012e+01_r8,1.9600e+01_r8,1.3239e+01_r8,7.0557e+00_r8,1.5180e-01_r8/) + kbo(:, 3,21, 6) = (/ & + &2.7347e+01_r8,2.0602e+01_r8,1.3900e+01_r8,7.3743e+00_r8,1.5767e-01_r8/) + kbo(:, 4,21, 6) = (/ & + &2.8734e+01_r8,2.1643e+01_r8,1.4586e+01_r8,7.7037e+00_r8,1.6319e-01_r8/) + kbo(:, 5,21, 6) = (/ & + &3.0137e+01_r8,2.2696e+01_r8,1.5284e+01_r8,8.0405e+00_r8,1.6831e-01_r8/) + kbo(:, 1,22, 6) = (/ & + &1.9244e+01_r8,1.4532e+01_r8,9.9298e+00_r8,5.4125e+00_r8,1.2703e-01_r8/) + kbo(:, 2,22, 6) = (/ & + &2.0224e+01_r8,1.5263e+01_r8,1.0402e+01_r8,5.6515e+00_r8,1.3287e-01_r8/) + kbo(:, 3,22, 6) = (/ & + &2.1278e+01_r8,1.6053e+01_r8,1.0915e+01_r8,5.9058e+00_r8,1.3815e-01_r8/) + kbo(:, 4,22, 6) = (/ & + &2.2359e+01_r8,1.6864e+01_r8,1.1443e+01_r8,6.1676e+00_r8,1.4315e-01_r8/) + kbo(:, 5,22, 6) = (/ & + &2.3448e+01_r8,1.7683e+01_r8,1.1980e+01_r8,6.4316e+00_r8,1.4780e-01_r8/) + kbo(:, 1,23, 6) = (/ & + &1.5003e+01_r8,1.1361e+01_r8,7.8631e+00_r8,4.3544e+00_r8,1.1053e-01_r8/) + kbo(:, 2,23, 6) = (/ & + &1.5788e+01_r8,1.1946e+01_r8,8.2434e+00_r8,4.5541e+00_r8,1.1564e-01_r8/) + kbo(:, 3,23, 6) = (/ & + &1.6609e+01_r8,1.2560e+01_r8,8.6387e+00_r8,4.7603e+00_r8,1.2034e-01_r8/) + kbo(:, 4,23, 6) = (/ & + &1.7444e+01_r8,1.3184e+01_r8,9.0429e+00_r8,4.9691e+00_r8,1.2479e-01_r8/) + kbo(:, 5,23, 6) = (/ & + &1.8318e+01_r8,1.3840e+01_r8,9.4687e+00_r8,5.1869e+00_r8,1.2894e-01_r8/) + kbo(:, 1,24, 6) = (/ & + &1.1642e+01_r8,8.8646e+00_r8,6.2180e+00_r8,3.4890e+00_r8,9.5642e-02_r8/) + kbo(:, 2,24, 6) = (/ & + &1.2250e+01_r8,9.3143e+00_r8,6.5164e+00_r8,3.6525e+00_r8,1.0007e-01_r8/) + kbo(:, 3,24, 6) = (/ & + &1.2878e+01_r8,9.7800e+00_r8,6.8207e+00_r8,3.8184e+00_r8,1.0423e-01_r8/) + kbo(:, 4,24, 6) = (/ & + &1.3534e+01_r8,1.0267e+01_r8,7.1387e+00_r8,3.9893e+00_r8,1.0818e-01_r8/) + kbo(:, 5,24, 6) = (/ & + &1.4255e+01_r8,1.0806e+01_r8,7.4905e+00_r8,4.1737e+00_r8,1.1190e-01_r8/) + kbo(:, 1,25, 6) = (/ & + &9.1475e+00_r8,7.0241e+00_r8,4.9880e+00_r8,2.8234e+00_r8,8.2353e-02_r8/) + kbo(:, 2,25, 6) = (/ & + &9.6194e+00_r8,7.3705e+00_r8,5.2236e+00_r8,2.9556e+00_r8,8.6208e-02_r8/) + kbo(:, 3,25, 6) = (/ & + &1.0118e+01_r8,7.7356e+00_r8,5.4684e+00_r8,3.0922e+00_r8,8.9882e-02_r8/) + kbo(:, 4,25, 6) = (/ & + &1.0662e+01_r8,8.1371e+00_r8,5.7357e+00_r8,3.2382e+00_r8,9.3407e-02_r8/) + kbo(:, 5,25, 6) = (/ & + &1.1279e+01_r8,8.5947e+00_r8,6.0377e+00_r8,3.4015e+00_r8,9.6770e-02_r8/) + kbo(:, 1,26, 6) = (/ & + &7.3112e+00_r8,5.6725e+00_r8,4.0689e+00_r8,2.3123e+00_r8,7.0640e-02_r8/) + kbo(:, 2,26, 6) = (/ & + &7.6950e+00_r8,5.9535e+00_r8,4.2634e+00_r8,2.4227e+00_r8,7.4010e-02_r8/) + kbo(:, 3,26, 6) = (/ & + &8.1066e+00_r8,6.2538e+00_r8,4.4719e+00_r8,2.5387e+00_r8,7.7271e-02_r8/) + kbo(:, 4,26, 6) = (/ & + &8.5794e+00_r8,6.6014e+00_r8,4.7086e+00_r8,2.6686e+00_r8,8.0450e-02_r8/) + kbo(:, 5,26, 6) = (/ & + &9.1099e+00_r8,6.9909e+00_r8,4.9735e+00_r8,2.8158e+00_r8,8.3380e-02_r8/) + kbo(:, 1,27, 6) = (/ & + &6.0744e+00_r8,4.7606e+00_r8,3.4368e+00_r8,1.9534e+00_r8,6.0404e-02_r8/) + kbo(:, 2,27, 6) = (/ & + &6.4010e+00_r8,4.9996e+00_r8,3.6064e+00_r8,2.0495e+00_r8,6.3391e-02_r8/) + kbo(:, 3,27, 6) = (/ & + &6.7712e+00_r8,5.2713e+00_r8,3.7979e+00_r8,2.1556e+00_r8,6.6293e-02_r8/) + kbo(:, 4,27, 6) = (/ & + &7.1986e+00_r8,5.5846e+00_r8,4.0153e+00_r8,2.2772e+00_r8,6.9007e-02_r8/) + kbo(:, 5,27, 6) = (/ & + &7.6755e+00_r8,5.9357e+00_r8,4.2585e+00_r8,2.4127e+00_r8,7.1247e-02_r8/) + kbo(:, 1,28, 6) = (/ & + &5.1866e+00_r8,4.1033e+00_r8,2.9724e+00_r8,1.6878e+00_r8,5.1571e-02_r8/) + kbo(:, 2,28, 6) = (/ & + &5.4861e+00_r8,4.3239e+00_r8,3.1305e+00_r8,1.7765e+00_r8,5.4219e-02_r8/) + kbo(:, 3,28, 6) = (/ & + &5.8320e+00_r8,4.5795e+00_r8,3.3130e+00_r8,1.8782e+00_r8,5.6690e-02_r8/) + kbo(:, 4,28, 6) = (/ & + &6.2247e+00_r8,4.8686e+00_r8,3.5188e+00_r8,1.9940e+00_r8,5.8750e-02_r8/) + kbo(:, 5,28, 6) = (/ & + &6.6558e+00_r8,5.1871e+00_r8,3.7446e+00_r8,2.1214e+00_r8,6.0243e-02_r8/) + kbo(:, 1,29, 6) = (/ & + &4.7142e+00_r8,3.7524e+00_r8,2.7162e+00_r8,1.5365e+00_r8,4.4039e-02_r8/) + kbo(:, 2,29, 6) = (/ & + &5.0090e+00_r8,3.9723e+00_r8,2.8754e+00_r8,1.6258e+00_r8,4.6277e-02_r8/) + kbo(:, 3,29, 6) = (/ & + &5.3480e+00_r8,4.2236e+00_r8,3.0565e+00_r8,1.7286e+00_r8,4.8156e-02_r8/) + kbo(:, 4,29, 6) = (/ & + &5.7292e+00_r8,4.5074e+00_r8,3.2622e+00_r8,1.8442e+00_r8,4.9560e-02_r8/) + kbo(:, 5,29, 6) = (/ & + &6.1329e+00_r8,4.8058e+00_r8,3.4771e+00_r8,1.9687e+00_r8,5.0487e-02_r8/) + kbo(:, 1,30, 6) = (/ & + &4.4038e+00_r8,3.5211e+00_r8,2.5447e+00_r8,1.4336e+00_r8,3.7528e-02_r8/) + kbo(:, 2,30, 6) = (/ & + &4.6996e+00_r8,3.7441e+00_r8,2.7067e+00_r8,1.5257e+00_r8,3.9262e-02_r8/) + kbo(:, 3,30, 6) = (/ & + &5.0396e+00_r8,3.9983e+00_r8,2.8921e+00_r8,1.6308e+00_r8,4.0573e-02_r8/) + kbo(:, 4,30, 6) = (/ & + &5.4089e+00_r8,4.2744e+00_r8,3.0942e+00_r8,1.7467e+00_r8,4.1475e-02_r8/) + kbo(:, 5,30, 6) = (/ & + &5.8026e+00_r8,4.5655e+00_r8,3.3058e+00_r8,1.8693e+00_r8,4.2084e-02_r8/) + kbo(:, 1,31, 6) = (/ & + &4.3406e+00_r8,3.4756e+00_r8,2.5043e+00_r8,1.4029e+00_r8,3.1837e-02_r8/) + kbo(:, 2,31, 6) = (/ & + &4.6530e+00_r8,3.7116e+00_r8,2.6766e+00_r8,1.5014e+00_r8,3.3063e-02_r8/) + kbo(:, 3,31, 6) = (/ & + &5.0025e+00_r8,3.9754e+00_r8,2.8716e+00_r8,1.6130e+00_r8,3.3948e-02_r8/) + kbo(:, 4,31, 6) = (/ & + &5.3785e+00_r8,4.2562e+00_r8,3.0774e+00_r8,1.7319e+00_r8,3.4570e-02_r8/) + kbo(:, 5,31, 6) = (/ & + &5.7889e+00_r8,4.5595e+00_r8,3.2989e+00_r8,1.8598e+00_r8,3.4986e-02_r8/) + kbo(:, 1,32, 6) = (/ & + &4.3396e+00_r8,3.4769e+00_r8,2.4992e+00_r8,1.3933e+00_r8,2.6827e-02_r8/) + kbo(:, 2,32, 6) = (/ & + &4.6714e+00_r8,3.7286e+00_r8,2.6844e+00_r8,1.4997e+00_r8,2.7685e-02_r8/) + kbo(:, 3,32, 6) = (/ & + &5.0312e+00_r8,4.0002e+00_r8,2.8855e+00_r8,1.6156e+00_r8,2.8303e-02_r8/) + kbo(:, 4,32, 6) = (/ & + &5.4256e+00_r8,4.2946e+00_r8,3.1010e+00_r8,1.7399e+00_r8,2.8748e-02_r8/) + kbo(:, 5,32, 6) = (/ & + &5.8665e+00_r8,4.6212e+00_r8,3.3393e+00_r8,1.8767e+00_r8,2.9064e-02_r8/) + kbo(:, 1,33, 6) = (/ & + &4.4332e+00_r8,3.5489e+00_r8,2.5452e+00_r8,1.4121e+00_r8,2.2496e-02_r8/) + kbo(:, 2,33, 6) = (/ & + &4.7823e+00_r8,3.8149e+00_r8,2.7429e+00_r8,1.5266e+00_r8,2.3111e-02_r8/) + kbo(:, 3,33, 6) = (/ & + &5.1647e+00_r8,4.1029e+00_r8,2.9548e+00_r8,1.6483e+00_r8,2.3573e-02_r8/) + kbo(:, 4,33, 6) = (/ & + &5.5917e+00_r8,4.4208e+00_r8,3.1884e+00_r8,1.7830e+00_r8,2.3904e-02_r8/) + kbo(:, 5,33, 6) = (/ & + &6.0743e+00_r8,4.7788e+00_r8,3.4474e+00_r8,1.9321e+00_r8,2.4134e-02_r8/) + kbo(:, 1,34, 6) = (/ & + &4.4125e+00_r8,3.5356e+00_r8,2.5335e+00_r8,1.4023e+00_r8,1.8787e-02_r8/) + kbo(:, 2,34, 6) = (/ & + &4.7724e+00_r8,3.8103e+00_r8,2.7374e+00_r8,1.5195e+00_r8,1.9239e-02_r8/) + kbo(:, 3,34, 6) = (/ & + &5.1721e+00_r8,4.1112e+00_r8,2.9584e+00_r8,1.6475e+00_r8,1.9590e-02_r8/) + kbo(:, 4,34, 6) = (/ & + &5.6244e+00_r8,4.4492e+00_r8,3.2069e+00_r8,1.7903e+00_r8,1.9843e-02_r8/) + kbo(:, 5,34, 6) = (/ & + &6.1384e+00_r8,4.8292e+00_r8,3.4834e+00_r8,1.9492e+00_r8,2.0036e-02_r8/) + kbo(:, 1,35, 6) = (/ & + &4.3717e+00_r8,3.5073e+00_r8,2.5119e+00_r8,1.3871e+00_r8,1.5622e-02_r8/) + kbo(:, 2,35, 6) = (/ & + &4.7431e+00_r8,3.7911e+00_r8,2.7216e+00_r8,1.5076e+00_r8,1.5975e-02_r8/) + kbo(:, 3,35, 6) = (/ & + &5.1596e+00_r8,4.1047e+00_r8,2.9535e+00_r8,1.6419e+00_r8,1.6252e-02_r8/) + kbo(:, 4,35, 6) = (/ & + &5.6365e+00_r8,4.4612e+00_r8,3.2141e+00_r8,1.7918e+00_r8,1.6461e-02_r8/) + kbo(:, 5,35, 6) = (/ & + &6.1774e+00_r8,4.8609e+00_r8,3.5048e+00_r8,1.9589e+00_r8,1.6599e-02_r8/) + kbo(:, 1,36, 6) = (/ & + &4.2736e+00_r8,3.4354e+00_r8,2.4585e+00_r8,1.3548e+00_r8,1.2936e-02_r8/) + kbo(:, 2,36, 6) = (/ & + &4.6496e+00_r8,3.7234e+00_r8,2.6724e+00_r8,1.4783e+00_r8,1.3228e-02_r8/) + kbo(:, 3,36, 6) = (/ & + &5.0769e+00_r8,4.0460e+00_r8,2.9111e+00_r8,1.6163e+00_r8,1.3462e-02_r8/) + kbo(:, 4,36, 6) = (/ & + &5.5708e+00_r8,4.4155e+00_r8,3.1813e+00_r8,1.7716e+00_r8,1.3637e-02_r8/) + kbo(:, 5,36, 6) = (/ & + &6.1338e+00_r8,4.8311e+00_r8,3.4822e+00_r8,1.9445e+00_r8,1.3753e-02_r8/) + kbo(:, 1,37, 6) = (/ & + &4.0234e+00_r8,3.2473e+00_r8,2.3232e+00_r8,1.2788e+00_r8,1.0671e-02_r8/) + kbo(:, 2,37, 6) = (/ & + &4.3892e+00_r8,3.5290e+00_r8,2.5324e+00_r8,1.3998e+00_r8,1.0924e-02_r8/) + kbo(:, 3,37, 6) = (/ & + &4.8090e+00_r8,3.8477e+00_r8,2.7688e+00_r8,1.5370e+00_r8,1.1122e-02_r8/) + kbo(:, 4,37, 6) = (/ & + &5.2982e+00_r8,4.2143e+00_r8,3.0374e+00_r8,1.6915e+00_r8,1.1275e-02_r8/) + kbo(:, 5,37, 6) = (/ & + &5.8599e+00_r8,4.6308e+00_r8,3.3399e+00_r8,1.8652e+00_r8,1.1382e-02_r8/) + kbo(:, 1,38, 6) = (/ & + &3.8405e+00_r8,3.1094e+00_r8,2.2232e+00_r8,1.2223e+00_r8,8.8011e-03_r8/) + kbo(:, 2,38, 6) = (/ & + &4.2026e+00_r8,3.3894e+00_r8,2.4317e+00_r8,1.3429e+00_r8,9.0204e-03_r8/) + kbo(:, 3,38, 6) = (/ & + &4.6223e+00_r8,3.7094e+00_r8,2.6688e+00_r8,1.4805e+00_r8,9.1889e-03_r8/) + kbo(:, 4,38, 6) = (/ & + &5.1135e+00_r8,4.0786e+00_r8,2.9400e+00_r8,1.6366e+00_r8,9.3266e-03_r8/) + kbo(:, 5,38, 6) = (/ & + &5.6812e+00_r8,4.4997e+00_r8,3.2457e+00_r8,1.8125e+00_r8,9.4327e-03_r8/) + kbo(:, 1,39, 6) = (/ & + &3.7513e+00_r8,3.0429e+00_r8,2.1735e+00_r8,1.1927e+00_r8,7.2681e-03_r8/) + kbo(:, 2,39, 6) = (/ & + &4.1185e+00_r8,3.3272e+00_r8,2.3853e+00_r8,1.3156e+00_r8,7.4517e-03_r8/) + kbo(:, 3,39, 6) = (/ & + &4.5480e+00_r8,3.6554e+00_r8,2.6285e+00_r8,1.4564e+00_r8,7.6013e-03_r8/) + kbo(:, 4,39, 6) = (/ & + &5.0522e+00_r8,4.0351e+00_r8,2.9074e+00_r8,1.6167e+00_r8,7.7185e-03_r8/) + kbo(:, 5,39, 6) = (/ & + &5.6411e+00_r8,4.4721e+00_r8,3.2250e+00_r8,1.7992e+00_r8,7.8245e-03_r8/) + kbo(:, 1,40, 6) = (/ & + &3.4100e+00_r8,2.7806e+00_r8,1.9856e+00_r8,1.0896e+00_r8,5.9768e-03_r8/) + kbo(:, 2,40, 6) = (/ & + &3.7541e+00_r8,3.0505e+00_r8,2.1868e+00_r8,1.2067e+00_r8,6.1348e-03_r8/) + kbo(:, 3,40, 6) = (/ & + &4.1600e+00_r8,3.3636e+00_r8,2.4194e+00_r8,1.3415e+00_r8,6.2676e-03_r8/) + kbo(:, 4,40, 6) = (/ & + &4.6404e+00_r8,3.7278e+00_r8,2.6880e+00_r8,1.4963e+00_r8,6.3713e-03_r8/) + kbo(:, 5,40, 6) = (/ & + &5.2035e+00_r8,4.1476e+00_r8,2.9948e+00_r8,1.6730e+00_r8,6.4667e-03_r8/) + kbo(:, 1,41, 6) = (/ & + &3.0891e+00_r8,2.5323e+00_r8,1.8076e+00_r8,9.9199e-01_r8,4.9106e-03_r8/) + kbo(:, 2,41, 6) = (/ & + &3.4100e+00_r8,2.7866e+00_r8,1.9972e+00_r8,1.1027e+00_r8,5.0459e-03_r8/) + kbo(:, 3,41, 6) = (/ & + &3.7913e+00_r8,3.0833e+00_r8,2.2185e+00_r8,1.2311e+00_r8,5.1622e-03_r8/) + kbo(:, 4,41, 6) = (/ & + &4.2439e+00_r8,3.4304e+00_r8,2.4754e+00_r8,1.3795e+00_r8,5.2594e-03_r8/) + kbo(:, 5,41, 6) = (/ & + &4.7807e+00_r8,3.8337e+00_r8,2.7715e+00_r8,1.5507e+00_r8,5.3436e-03_r8/) + kbo(:, 1,42, 6) = (/ & + &2.8278e+00_r8,2.3283e+00_r8,1.6611e+00_r8,9.1142e-01_r8,4.0331e-03_r8/) + kbo(:, 2,42, 6) = (/ & + &3.1295e+00_r8,2.5702e+00_r8,1.8417e+00_r8,1.0169e+00_r8,4.1507e-03_r8/) + kbo(:, 3,42, 6) = (/ & + &3.4910e+00_r8,2.8544e+00_r8,2.0536e+00_r8,1.1401e+00_r8,4.2525e-03_r8/) + kbo(:, 4,42, 6) = (/ & + &3.9235e+00_r8,3.1883e+00_r8,2.3016e+00_r8,1.2837e+00_r8,4.3408e-03_r8/) + kbo(:, 5,42, 6) = (/ & + &4.4380e+00_r8,3.5784e+00_r8,2.5896e+00_r8,1.4506e+00_r8,4.4170e-03_r8/) + kbo(:, 1,43, 6) = (/ & + &2.5971e+00_r8,2.1460e+00_r8,1.5298e+00_r8,8.3854e-01_r8,3.3049e-03_r8/) + kbo(:, 2,43, 6) = (/ & + &2.8799e+00_r8,2.3759e+00_r8,1.7013e+00_r8,9.3880e-01_r8,3.4092e-03_r8/) + kbo(:, 3,43, 6) = (/ & + &3.2202e+00_r8,2.6461e+00_r8,1.9035e+00_r8,1.0566e+00_r8,3.5003e-03_r8/) + kbo(:, 4,43, 6) = (/ & + &3.6329e+00_r8,2.9678e+00_r8,2.1426e+00_r8,1.1949e+00_r8,3.5773e-03_r8/) + kbo(:, 5,43, 6) = (/ & + &4.1275e+00_r8,3.3455e+00_r8,2.4216e+00_r8,1.3572e+00_r8,3.6480e-03_r8/) + kbo(:, 1,44, 6) = (/ & + &2.4109e+00_r8,1.9983e+00_r8,1.4225e+00_r8,7.7812e-01_r8,2.7054e-03_r8/) + kbo(:, 2,44, 6) = (/ & + &2.6776e+00_r8,2.2170e+00_r8,1.5862e+00_r8,8.7403e-01_r8,2.7971e-03_r8/) + kbo(:, 3,44, 6) = (/ & + &3.0022e+00_r8,2.4769e+00_r8,1.7806e+00_r8,9.8740e-01_r8,2.8773e-03_r8/) + kbo(:, 4,44, 6) = (/ & + &3.3965e+00_r8,2.7871e+00_r8,2.0115e+00_r8,1.1213e+00_r8,2.9478e-03_r8/) + kbo(:, 5,44, 6) = (/ & + &3.8747e+00_r8,3.1555e+00_r8,2.2836e+00_r8,1.2791e+00_r8,3.0101e-03_r8/) + kbo(:, 1,45, 6) = (/ & + &2.2815e+00_r8,1.8944e+00_r8,1.3464e+00_r8,7.3467e-01_r8,2.2130e-03_r8/) + kbo(:, 2,45, 6) = (/ & + &2.5401e+00_r8,2.1081e+00_r8,1.5065e+00_r8,8.2816e-01_r8,2.2948e-03_r8/) + kbo(:, 3,45, 6) = (/ & + &2.8533e+00_r8,2.3602e+00_r8,1.6948e+00_r8,9.3826e-01_r8,2.3656e-03_r8/) + kbo(:, 4,45, 6) = (/ & + &3.2382e+00_r8,2.6655e+00_r8,1.9218e+00_r8,1.0700e+00_r8,2.4291e-03_r8/) + kbo(:, 5,45, 6) = (/ & + &3.7076e+00_r8,3.0298e+00_r8,2.1912e+00_r8,1.2259e+00_r8,2.4852e-03_r8/) + kbo(:, 1,46, 6) = (/ & + &2.1752e+00_r8,1.8075e+00_r8,1.2824e+00_r8,6.9758e-01_r8,1.8083e-03_r8/) + kbo(:, 2,46, 6) = (/ & + &2.4262e+00_r8,2.0168e+00_r8,1.4391e+00_r8,7.8916e-01_r8,1.8803e-03_r8/) + kbo(:, 3,46, 6) = (/ & + &2.7306e+00_r8,2.2636e+00_r8,1.6229e+00_r8,8.9649e-01_r8,1.9453e-03_r8/) + kbo(:, 4,46, 6) = (/ & + &3.1079e+00_r8,2.5651e+00_r8,1.8473e+00_r8,1.0263e+00_r8,2.0023e-03_r8/) + kbo(:, 5,46, 6) = (/ & + &3.5715e+00_r8,2.9262e+00_r8,2.1144e+00_r8,1.1808e+00_r8,2.0547e-03_r8/) + kbo(:, 1,47, 6) = (/ & + &2.0439e+00_r8,1.6998e+00_r8,1.2039e+00_r8,6.5284e-01_r8,1.4728e-03_r8/) + kbo(:, 2,47, 6) = (/ & + &2.2849e+00_r8,1.9026e+00_r8,1.3552e+00_r8,7.4124e-01_r8,1.5378e-03_r8/) + kbo(:, 3,47, 6) = (/ & + &2.5739e+00_r8,2.1396e+00_r8,1.5317e+00_r8,8.4434e-01_r8,1.5971e-03_r8/) + kbo(:, 4,47, 6) = (/ & + &2.9355e+00_r8,2.4308e+00_r8,1.7484e+00_r8,9.6939e-01_r8,1.6478e-03_r8/) + kbo(:, 5,47, 6) = (/ & + &3.3837e+00_r8,2.7824e+00_r8,2.0088e+00_r8,1.1198e+00_r8,1.6945e-03_r8/) + kbo(:, 1,48, 6) = (/ & + &1.9729e+00_r8,1.6396e+00_r8,1.1585e+00_r8,6.2585e-01_r8,1.1998e-03_r8/) + kbo(:, 2,48, 6) = (/ & + &2.2114e+00_r8,1.8415e+00_r8,1.3088e+00_r8,7.1328e-01_r8,1.2575e-03_r8/) + kbo(:, 3,48, 6) = (/ & + &2.4937e+00_r8,2.0747e+00_r8,1.4825e+00_r8,8.1439e-01_r8,1.3096e-03_r8/) + kbo(:, 4,48, 6) = (/ & + &2.8486e+00_r8,2.3616e+00_r8,1.6960e+00_r8,9.3764e-01_r8,1.3556e-03_r8/) + kbo(:, 5,48, 6) = (/ & + &3.2936e+00_r8,2.7131e+00_r8,1.9561e+00_r8,1.0874e+00_r8,1.3979e-03_r8/) + kbo(:, 1,49, 6) = (/ & + &1.9817e+00_r8,1.6421e+00_r8,1.1570e+00_r8,6.2210e-01_r8,9.7602e-04_r8/) + kbo(:, 2,49, 6) = (/ & + &2.2272e+00_r8,1.8506e+00_r8,1.3118e+00_r8,7.1147e-01_r8,1.0279e-03_r8/) + kbo(:, 3,49, 6) = (/ & + &2.5150e+00_r8,2.0896e+00_r8,1.4898e+00_r8,8.1454e-01_r8,1.0745e-03_r8/) + kbo(:, 4,49, 6) = (/ & + &2.8769e+00_r8,2.3813e+00_r8,1.7067e+00_r8,9.3965e-01_r8,1.1160e-03_r8/) + kbo(:, 5,49, 6) = (/ & + &3.3353e+00_r8,2.7446e+00_r8,1.9747e+00_r8,1.0933e+00_r8,1.1545e-03_r8/) + kbo(:, 1,50, 6) = (/ & + &1.8978e+00_r8,1.5720e+00_r8,1.1055e+00_r8,5.9245e-01_r8,7.9308e-04_r8/) + kbo(:, 2,50, 6) = (/ & + &2.1399e+00_r8,1.7779e+00_r8,1.2580e+00_r8,6.8007e-01_r8,8.3888e-04_r8/) + kbo(:, 3,50, 6) = (/ & + &2.4218e+00_r8,2.0138e+00_r8,1.4333e+00_r8,7.8150e-01_r8,8.7996e-04_r8/) + kbo(:, 4,50, 6) = (/ & + &2.7742e+00_r8,2.2995e+00_r8,1.6455e+00_r8,9.0381e-01_r8,9.1698e-04_r8/) + kbo(:, 5,50, 6) = (/ & + &3.2255e+00_r8,2.6590e+00_r8,1.9107e+00_r8,1.0555e+00_r8,9.5164e-04_r8/) + kbo(:, 1,51, 6) = (/ & + &1.7787e+00_r8,1.4741e+00_r8,1.0351e+00_r8,5.5321e-01_r8,6.4322e-04_r8/) + kbo(:, 2,51, 6) = (/ & + &2.0121e+00_r8,1.6731e+00_r8,1.1819e+00_r8,6.3736e-01_r8,6.8396e-04_r8/) + kbo(:, 3,51, 6) = (/ & + &2.2825e+00_r8,1.9012e+00_r8,1.3514e+00_r8,7.3514e-01_r8,7.1977e-04_r8/) + kbo(:, 4,51, 6) = (/ & + &2.6184e+00_r8,2.1760e+00_r8,1.5550e+00_r8,8.5263e-01_r8,7.5276e-04_r8/) + kbo(:, 5,51, 6) = (/ & + &3.0526e+00_r8,2.5248e+00_r8,1.8126e+00_r8,9.9966e-01_r8,7.8322e-04_r8/) + kbo(:, 1,52, 6) = (/ & + &1.7138e+00_r8,1.4190e+00_r8,9.9450e-01_r8,5.2987e-01_r8,5.2154e-04_r8/) + kbo(:, 2,52, 6) = (/ & + &1.9434e+00_r8,1.6150e+00_r8,1.1387e+00_r8,6.1204e-01_r8,5.5749e-04_r8/) + kbo(:, 3,52, 6) = (/ & + &2.2115e+00_r8,1.8422e+00_r8,1.3069e+00_r8,7.0863e-01_r8,5.8864e-04_r8/) + kbo(:, 4,52, 6) = (/ & + &2.5398e+00_r8,2.1125e+00_r8,1.5071e+00_r8,8.2393e-01_r8,6.1775e-04_r8/) + kbo(:, 5,52, 6) = (/ & + &2.9672e+00_r8,2.4581e+00_r8,1.7623e+00_r8,9.6952e-01_r8,6.4493e-04_r8/) + kbo(:, 1,53, 6) = (/ & + &1.7198e+00_r8,1.4203e+00_r8,9.9324e-01_r8,5.2715e-01_r8,4.2262e-04_r8/) + kbo(:, 2,53, 6) = (/ & + &1.9529e+00_r8,1.6185e+00_r8,1.1384e+00_r8,6.0925e-01_r8,4.5399e-04_r8/) + kbo(:, 3,53, 6) = (/ & + &2.2293e+00_r8,1.8530e+00_r8,1.3116e+00_r8,7.0805e-01_r8,4.8128e-04_r8/) + kbo(:, 4,53, 6) = (/ & + &2.5636e+00_r8,2.1294e+00_r8,1.5160e+00_r8,8.2535e-01_r8,5.0713e-04_r8/) + kbo(:, 5,53, 6) = (/ & + &3.0004e+00_r8,2.4827e+00_r8,1.7770e+00_r8,9.7383e-01_r8,5.3111e-04_r8/) + kbo(:, 1,54, 6) = (/ & + &1.4969e+00_r8,1.2401e+00_r8,8.6613e-01_r8,4.5904e-01_r8,3.4135e-04_r8/) + kbo(:, 2,54, 6) = (/ & + &1.7004e+00_r8,1.4146e+00_r8,9.9400e-01_r8,5.3139e-01_r8,3.6835e-04_r8/) + kbo(:, 3,54, 6) = (/ & + &1.9475e+00_r8,1.6269e+00_r8,1.1506e+00_r8,6.2081e-01_r8,3.9232e-04_r8/) + kbo(:, 4,54, 6) = (/ & + &2.2441e+00_r8,1.8758e+00_r8,1.3350e+00_r8,7.2699e-01_r8,4.1441e-04_r8/) + kbo(:, 5,54, 6) = (/ & + &2.6322e+00_r8,2.1931e+00_r8,1.5695e+00_r8,8.6094e-01_r8,4.3501e-04_r8/) + kbo(:, 1,55, 6) = (/ & + &1.1902e+00_r8,9.9203e-01_r8,6.9261e-01_r8,3.6696e-01_r8,2.7539e-04_r8/) + kbo(:, 2,55, 6) = (/ & + &1.3514e+00_r8,1.1327e+00_r8,7.9579e-01_r8,4.2578e-01_r8,2.9805e-04_r8/) + kbo(:, 3,55, 6) = (/ & + &1.5528e+00_r8,1.3090e+00_r8,9.2585e-01_r8,5.0048e-01_r8,3.1883e-04_r8/) + kbo(:, 4,55, 6) = (/ & + &1.7945e+00_r8,1.5161e+00_r8,1.0797e+00_r8,5.8958e-01_r8,3.3758e-04_r8/) + kbo(:, 5,55, 6) = (/ & + &2.1091e+00_r8,1.7786e+00_r8,1.2743e+00_r8,7.0161e-01_r8,3.5497e-04_r8/) + kbo(:, 1,56, 6) = (/ & + &9.4564e-01_r8,7.9256e-01_r8,5.5332e-01_r8,2.9317e-01_r8,2.2189e-04_r8/) + kbo(:, 2,56, 6) = (/ & + &1.0727e+00_r8,9.0556e-01_r8,6.3622e-01_r8,3.4063e-01_r8,2.4090e-04_r8/) + kbo(:, 3,56, 6) = (/ & + &1.2368e+00_r8,1.0514e+00_r8,7.4402e-01_r8,4.0280e-01_r8,2.5859e-04_r8/) + kbo(:, 4,56, 6) = (/ & + &1.4335e+00_r8,1.2238e+00_r8,8.7212e-01_r8,4.7748e-01_r8,2.7478e-04_r8/) + kbo(:, 5,56, 6) = (/ & + &1.6876e+00_r8,1.4404e+00_r8,1.0331e+00_r8,5.7092e-01_r8,2.8964e-04_r8/) + kbo(:, 1,57, 6) = (/ & + &7.5151e-01_r8,6.3315e-01_r8,4.4196e-01_r8,2.3414e-01_r8,1.7834e-04_r8/) + kbo(:, 2,57, 6) = (/ & + &8.5091e-01_r8,7.2306e-01_r8,5.0804e-01_r8,2.7214e-01_r8,1.9471e-04_r8/) + kbo(:, 3,57, 6) = (/ & + &9.8353e-01_r8,8.4281e-01_r8,5.9656e-01_r8,3.2337e-01_r8,2.0961e-04_r8/) + kbo(:, 4,57, 6) = (/ & + &1.1433e+00_r8,9.8609e-01_r8,7.0325e-01_r8,3.8594e-01_r8,2.2327e-04_r8/) + kbo(:, 5,57, 6) = (/ & + &1.3484e+00_r8,1.1650e+00_r8,8.3657e-01_r8,4.6393e-01_r8,2.3604e-04_r8/) + kbo(:, 1,58, 6) = (/ & + &1.5793e-01_r8,1.6356e-01_r8,1.4683e-01_r8,1.0896e-01_r8,1.4326e-04_r8/) + kbo(:, 2,58, 6) = (/ & + &1.7834e-01_r8,1.8665e-01_r8,1.6872e-01_r8,1.2675e-01_r8,1.5731e-04_r8/) + kbo(:, 3,58, 6) = (/ & + &2.0650e-01_r8,2.1828e-01_r8,1.9887e-01_r8,1.5129e-01_r8,1.6986e-04_r8/) + kbo(:, 4,58, 6) = (/ & + &2.4084e-01_r8,2.5688e-01_r8,2.3602e-01_r8,1.8197e-01_r8,1.8127e-04_r8/) + kbo(:, 5,58, 6) = (/ & + &2.8453e-01_r8,3.0466e-01_r8,2.8209e-01_r8,2.2013e-01_r8,1.9222e-04_r8/) + kbo(:, 1,59, 6) = (/ & + &1.5159e-01_r8,1.5229e-01_r8,1.2764e-01_r8,8.4631e-02_r8,1.1680e-04_r8/) + kbo(:, 2,59, 6) = (/ & + &1.7166e-01_r8,1.7481e-01_r8,1.4781e-01_r8,9.9479e-02_r8,1.2840e-04_r8/) + kbo(:, 3,59, 6) = (/ & + &1.9953e-01_r8,2.0595e-01_r8,1.7587e-01_r8,1.2013e-01_r8,1.3871e-04_r8/) + kbo(:, 4,59, 6) = (/ & + &2.3377e-01_r8,2.4439e-01_r8,2.1097e-01_r8,1.4631e-01_r8,1.4804e-04_r8/) + kbo(:, 5,59, 6) = (/ & + &2.7769e-01_r8,2.9243e-01_r8,2.5484e-01_r8,1.7920e-01_r8,1.5678e-04_r8/) + kbo(:, 1,13, 7) = (/ & + &1.7755e+03_r8,1.3317e+03_r8,8.8796e+02_r8,4.4421e+02_r8,6.5972e-01_r8/) + kbo(:, 2,13, 7) = (/ & + &1.8279e+03_r8,1.3710e+03_r8,9.1418e+02_r8,4.5731e+02_r8,6.6173e-01_r8/) + kbo(:, 3,13, 7) = (/ & + &1.8885e+03_r8,1.4165e+03_r8,9.4446e+02_r8,4.7244e+02_r8,6.6577e-01_r8/) + kbo(:, 4,13, 7) = (/ & + &1.9490e+03_r8,1.4619e+03_r8,9.7472e+02_r8,4.8757e+02_r8,6.7090e-01_r8/) + kbo(:, 5,13, 7) = (/ & + &2.0075e+03_r8,1.5058e+03_r8,1.0040e+03_r8,5.0220e+02_r8,6.7193e-01_r8/) + kbo(:, 1,14, 7) = (/ & + &9.7594e+02_r8,7.3206e+02_r8,4.8819e+02_r8,2.4432e+02_r8,6.3121e-01_r8/) + kbo(:, 2,14, 7) = (/ & + &1.0087e+03_r8,7.5661e+02_r8,5.0455e+02_r8,2.5249e+02_r8,6.3502e-01_r8/) + kbo(:, 3,14, 7) = (/ & + &1.0415e+03_r8,7.8124e+02_r8,5.2096e+02_r8,2.6069e+02_r8,6.3710e-01_r8/) + kbo(:, 4,14, 7) = (/ & + &1.0744e+03_r8,8.0589e+02_r8,5.3739e+02_r8,2.6890e+02_r8,6.4004e-01_r8/) + kbo(:, 5,14, 7) = (/ & + &1.1054e+03_r8,8.2913e+02_r8,5.5288e+02_r8,2.7664e+02_r8,6.4122e-01_r8/) + kbo(:, 1,15, 7) = (/ & + &5.4478e+02_r8,4.0870e+02_r8,2.7262e+02_r8,1.3654e+02_r8,5.9523e-01_r8/) + kbo(:, 2,15, 7) = (/ & + &5.6305e+02_r8,4.2240e+02_r8,2.8175e+02_r8,1.4110e+02_r8,6.0003e-01_r8/) + kbo(:, 3,15, 7) = (/ & + &5.8123e+02_r8,4.3603e+02_r8,2.9083e+02_r8,1.4563e+02_r8,6.0181e-01_r8/) + kbo(:, 4,15, 7) = (/ & + &5.9882e+02_r8,4.4922e+02_r8,2.9962e+02_r8,1.5002e+02_r8,6.0320e-01_r8/) + kbo(:, 5,15, 7) = (/ & + &6.1530e+02_r8,4.6158e+02_r8,3.0785e+02_r8,1.5413e+02_r8,6.0492e-01_r8/) + kbo(:, 1,16, 7) = (/ & + &3.5993e+02_r8,2.7006e+02_r8,1.8020e+02_r8,9.0332e+01_r8,5.5493e-01_r8/) + kbo(:, 2,16, 7) = (/ & + &3.7215e+02_r8,2.7922e+02_r8,1.8629e+02_r8,9.3372e+01_r8,5.5851e-01_r8/) + kbo(:, 3,16, 7) = (/ & + &3.8394e+02_r8,2.8806e+02_r8,1.9218e+02_r8,9.6308e+01_r8,5.6035e-01_r8/) + kbo(:, 4,16, 7) = (/ & + &3.9518e+02_r8,2.9649e+02_r8,1.9779e+02_r8,9.9106e+01_r8,5.6267e-01_r8/) + kbo(:, 5,16, 7) = (/ & + &4.0564e+02_r8,3.0433e+02_r8,2.0302e+02_r8,1.0171e+02_r8,5.6476e-01_r8/) + kbo(:, 1,17, 7) = (/ & + &2.4595e+02_r8,1.8458e+02_r8,1.2320e+02_r8,6.1838e+01_r8,5.0905e-01_r8/) + kbo(:, 2,17, 7) = (/ & + &2.5413e+02_r8,1.9070e+02_r8,1.2728e+02_r8,6.3868e+01_r8,5.1185e-01_r8/) + kbo(:, 3,17, 7) = (/ & + &2.6187e+02_r8,1.9651e+02_r8,1.3115e+02_r8,6.5795e+01_r8,5.1474e-01_r8/) + kbo(:, 4,17, 7) = (/ & + &2.6921e+02_r8,2.0201e+02_r8,1.3481e+02_r8,6.7615e+01_r8,5.1865e-01_r8/) + kbo(:, 5,17, 7) = (/ & + &2.7688e+02_r8,2.0776e+02_r8,1.3865e+02_r8,6.9531e+01_r8,5.2170e-01_r8/) + kbo(:, 1,18, 7) = (/ & + &1.7164e+02_r8,1.2884e+02_r8,8.6050e+01_r8,4.3266e+01_r8,4.6055e-01_r8/) + kbo(:, 2,18, 7) = (/ & + &1.7713e+02_r8,1.3296e+02_r8,8.8791e+01_r8,4.4628e+01_r8,4.6405e-01_r8/) + kbo(:, 3,18, 7) = (/ & + &1.8233e+02_r8,1.3686e+02_r8,9.1384e+01_r8,4.5916e+01_r8,4.6825e-01_r8/) + kbo(:, 4,18, 7) = (/ & + &1.8765e+02_r8,1.4084e+02_r8,9.4032e+01_r8,4.7229e+01_r8,4.7329e-01_r8/) + kbo(:, 5,18, 7) = (/ & + &1.9405e+02_r8,1.4564e+02_r8,9.7227e+01_r8,4.8824e+01_r8,4.7705e-01_r8/) + kbo(:, 1,19, 7) = (/ & + &1.1725e+02_r8,8.8048e+01_r8,5.8853e+01_r8,2.9674e+01_r8,4.1247e-01_r8/) + kbo(:, 2,19, 7) = (/ & + &1.2086e+02_r8,9.0759e+01_r8,6.0656e+01_r8,3.0566e+01_r8,4.1661e-01_r8/) + kbo(:, 3,19, 7) = (/ & + &1.2440e+02_r8,9.3403e+01_r8,6.2413e+01_r8,3.1438e+01_r8,4.2213e-01_r8/) + kbo(:, 4,19, 7) = (/ & + &1.2864e+02_r8,9.6587e+01_r8,6.4532e+01_r8,3.2489e+01_r8,4.2779e-01_r8/) + kbo(:, 5,19, 7) = (/ & + &1.3396e+02_r8,1.0057e+02_r8,6.7181e+01_r8,3.3807e+01_r8,4.3260e-01_r8/) + kbo(:, 1,20, 7) = (/ & + &8.6468e+01_r8,6.4964e+01_r8,4.3467e+01_r8,2.2017e+01_r8,3.6582e-01_r8/) + kbo(:, 2,20, 7) = (/ & + &8.9024e+01_r8,6.6879e+01_r8,4.4738e+01_r8,2.2636e+01_r8,3.7131e-01_r8/) + kbo(:, 3,20, 7) = (/ & + &9.1943e+01_r8,6.9064e+01_r8,4.6188e+01_r8,2.3347e+01_r8,3.7766e-01_r8/) + kbo(:, 4,20, 7) = (/ & + &9.5737e+01_r8,7.1906e+01_r8,4.8080e+01_r8,2.4283e+01_r8,3.8413e-01_r8/) + kbo(:, 5,20, 7) = (/ & + &1.0032e+02_r8,7.5342e+01_r8,5.0362e+01_r8,2.5410e+01_r8,3.9048e-01_r8/) + kbo(:, 1,21, 7) = (/ & + &6.5580e+01_r8,4.9300e+01_r8,3.3030e+01_r8,1.6896e+01_r8,3.2248e-01_r8/) + kbo(:, 2,21, 7) = (/ & + &6.7679e+01_r8,5.0870e+01_r8,3.4072e+01_r8,1.7386e+01_r8,3.2902e-01_r8/) + kbo(:, 3,21, 7) = (/ & + &7.0353e+01_r8,5.2872e+01_r8,3.5398e+01_r8,1.8022e+01_r8,3.3617e-01_r8/) + kbo(:, 4,21, 7) = (/ & + &7.3710e+01_r8,5.5384e+01_r8,3.7067e+01_r8,1.8833e+01_r8,3.4337e-01_r8/) + kbo(:, 5,21, 7) = (/ & + &7.7378e+01_r8,5.8129e+01_r8,3.8887e+01_r8,1.9718e+01_r8,3.5091e-01_r8/) + kbo(:, 1,22, 7) = (/ & + &5.0990e+01_r8,3.8360e+01_r8,2.5747e+01_r8,1.3390e+01_r8,2.8355e-01_r8/) + kbo(:, 2,22, 7) = (/ & + &5.2937e+01_r8,3.9813e+01_r8,2.6706e+01_r8,1.3827e+01_r8,2.9084e-01_r8/) + kbo(:, 3,22, 7) = (/ & + &5.5472e+01_r8,4.1712e+01_r8,2.7965e+01_r8,1.4417e+01_r8,2.9863e-01_r8/) + kbo(:, 4,22, 7) = (/ & + &5.8295e+01_r8,4.3822e+01_r8,2.9362e+01_r8,1.5079e+01_r8,3.0668e-01_r8/) + kbo(:, 5,22, 7) = (/ & + &6.1215e+01_r8,4.6005e+01_r8,3.0807e+01_r8,1.5766e+01_r8,3.1501e-01_r8/) + kbo(:, 1,23, 7) = (/ & + &3.9928e+01_r8,3.0064e+01_r8,2.0251e+01_r8,1.0753e+01_r8,2.4875e-01_r8/) + kbo(:, 2,23, 7) = (/ & + &4.1783e+01_r8,3.1450e+01_r8,2.1160e+01_r8,1.1173e+01_r8,2.5662e-01_r8/) + kbo(:, 3,23, 7) = (/ & + &4.3954e+01_r8,3.3072e+01_r8,2.2227e+01_r8,1.1670e+01_r8,2.6505e-01_r8/) + kbo(:, 4,23, 7) = (/ & + &4.6239e+01_r8,3.4779e+01_r8,2.3350e+01_r8,1.2195e+01_r8,2.7351e-01_r8/) + kbo(:, 5,23, 7) = (/ & + &4.8555e+01_r8,3.6509e+01_r8,2.4489e+01_r8,1.2725e+01_r8,2.8191e-01_r8/) + kbo(:, 1,24, 7) = (/ & + &3.1198e+01_r8,2.3518e+01_r8,1.5962e+01_r8,8.6666e+00_r8,2.1812e-01_r8/) + kbo(:, 2,24, 7) = (/ & + &3.2836e+01_r8,2.4742e+01_r8,1.6752e+01_r8,9.0412e+00_r8,2.2642e-01_r8/) + kbo(:, 3,24, 7) = (/ & + &3.4586e+01_r8,2.6047e+01_r8,1.7597e+01_r8,9.4445e+00_r8,2.3475e-01_r8/) + kbo(:, 4,24, 7) = (/ & + &3.6388e+01_r8,2.7390e+01_r8,1.8470e+01_r8,9.8567e+00_r8,2.4289e-01_r8/) + kbo(:, 5,24, 7) = (/ & + &3.8237e+01_r8,2.8772e+01_r8,1.9370e+01_r8,1.0281e+01_r8,2.5096e-01_r8/) + kbo(:, 1,25, 7) = (/ & + &2.4765e+01_r8,1.8701e+01_r8,1.2839e+01_r8,7.1044e+00_r8,1.9118e-01_r8/) + kbo(:, 2,25, 7) = (/ & + &2.6117e+01_r8,1.9708e+01_r8,1.3481e+01_r8,7.4248e+00_r8,1.9923e-01_r8/) + kbo(:, 3,25, 7) = (/ & + &2.7518e+01_r8,2.0749e+01_r8,1.4145e+01_r8,7.7545e+00_r8,2.0704e-01_r8/) + kbo(:, 4,25, 7) = (/ & + &2.8948e+01_r8,2.1814e+01_r8,1.4825e+01_r8,8.0892e+00_r8,2.1475e-01_r8/) + kbo(:, 5,25, 7) = (/ & + &3.0459e+01_r8,2.2943e+01_r8,1.5551e+01_r8,8.4409e+00_r8,2.2240e-01_r8/) + kbo(:, 1,26, 7) = (/ & + &1.9997e+01_r8,1.5145e+01_r8,1.0541e+01_r8,5.9203e+00_r8,1.6734e-01_r8/) + kbo(:, 2,26, 7) = (/ & + &2.1098e+01_r8,1.5958e+01_r8,1.1060e+01_r8,6.1929e+00_r8,1.7471e-01_r8/) + kbo(:, 3,26, 7) = (/ & + &2.2238e+01_r8,1.6802e+01_r8,1.1594e+01_r8,6.4727e+00_r8,1.8196e-01_r8/) + kbo(:, 4,26, 7) = (/ & + &2.3407e+01_r8,1.7668e+01_r8,1.2141e+01_r8,6.7596e+00_r8,1.8921e-01_r8/) + kbo(:, 5,26, 7) = (/ & + &2.4698e+01_r8,1.8629e+01_r8,1.2749e+01_r8,7.0654e+00_r8,1.9648e-01_r8/) + kbo(:, 1,27, 7) = (/ & + &1.6756e+01_r8,1.2745e+01_r8,8.9780e+00_r8,5.0906e+00_r8,1.4596e-01_r8/) + kbo(:, 2,27, 7) = (/ & + &1.7682e+01_r8,1.3422e+01_r8,9.4167e+00_r8,5.3320e+00_r8,1.5263e-01_r8/) + kbo(:, 3,27, 7) = (/ & + &1.8639e+01_r8,1.4123e+01_r8,9.8653e+00_r8,5.5814e+00_r8,1.5946e-01_r8/) + kbo(:, 4,27, 7) = (/ & + &1.9672e+01_r8,1.4884e+01_r8,1.0349e+01_r8,5.8433e+00_r8,1.6641e-01_r8/) + kbo(:, 5,27, 7) = (/ & + &2.0853e+01_r8,1.5759e+01_r8,1.0902e+01_r8,6.1333e+00_r8,1.7345e-01_r8/) + kbo(:, 1,28, 7) = (/ & + &1.4405e+01_r8,1.1016e+01_r8,7.8395e+00_r8,4.4691e+00_r8,1.2690e-01_r8/) + kbo(:, 2,28, 7) = (/ & + &1.5206e+01_r8,1.1594e+01_r8,8.2236e+00_r8,4.6907e+00_r8,1.3310e-01_r8/) + kbo(:, 3,28, 7) = (/ & + &1.6055e+01_r8,1.2210e+01_r8,8.6248e+00_r8,4.9200e+00_r8,1.3960e-01_r8/) + kbo(:, 4,28, 7) = (/ & + &1.7030e+01_r8,1.2924e+01_r8,9.0823e+00_r8,5.1747e+00_r8,1.4629e-01_r8/) + kbo(:, 5,28, 7) = (/ & + &1.8152e+01_r8,1.3752e+01_r8,9.6123e+00_r8,5.4653e+00_r8,1.5306e-01_r8/) + kbo(:, 1,29, 7) = (/ & + &1.3149e+01_r8,1.0099e+01_r8,7.2312e+00_r8,4.1269e+00_r8,1.1016e-01_r8/) + kbo(:, 2,29, 7) = (/ & + &1.3892e+01_r8,1.0633e+01_r8,7.5916e+00_r8,4.3391e+00_r8,1.1614e-01_r8/) + kbo(:, 3,29, 7) = (/ & + &1.4735e+01_r8,1.1242e+01_r8,7.9958e+00_r8,4.5718e+00_r8,1.2237e-01_r8/) + kbo(:, 4,29, 7) = (/ & + &1.5717e+01_r8,1.1957e+01_r8,8.4609e+00_r8,4.8366e+00_r8,1.2878e-01_r8/) + kbo(:, 5,29, 7) = (/ & + &1.6850e+01_r8,1.2790e+01_r8,8.9991e+00_r8,5.1366e+00_r8,1.3504e-01_r8/) + kbo(:, 1,30, 7) = (/ & + &1.2314e+01_r8,9.4945e+00_r8,6.8243e+00_r8,3.8903e+00_r8,9.5721e-02_r8/) + kbo(:, 2,30, 7) = (/ & + &1.3054e+01_r8,1.0024e+01_r8,7.1887e+00_r8,4.1054e+00_r8,1.0142e-01_r8/) + kbo(:, 3,30, 7) = (/ & + &1.3921e+01_r8,1.0650e+01_r8,7.6093e+00_r8,4.3517e+00_r8,1.0739e-01_r8/) + kbo(:, 4,30, 7) = (/ & + &1.4944e+01_r8,1.1393e+01_r8,8.1010e+00_r8,4.6344e+00_r8,1.1328e-01_r8/) + kbo(:, 5,30, 7) = (/ & + &1.6104e+01_r8,1.2245e+01_r8,8.6565e+00_r8,4.9501e+00_r8,1.1877e-01_r8/) + kbo(:, 1,31, 7) = (/ & + &1.2157e+01_r8,9.3878e+00_r8,6.7548e+00_r8,3.8381e+00_r8,8.3345e-02_r8/) + kbo(:, 2,31, 7) = (/ & + &1.2955e+01_r8,9.9594e+00_r8,7.1498e+00_r8,4.0728e+00_r8,8.8771e-02_r8/) + kbo(:, 3,31, 7) = (/ & + &1.3911e+01_r8,1.0649e+01_r8,7.6174e+00_r8,4.3452e+00_r8,9.4250e-02_r8/) + kbo(:, 4,31, 7) = (/ & + &1.5017e+01_r8,1.1456e+01_r8,8.1532e+00_r8,4.6551e+00_r8,9.9406e-02_r8/) + kbo(:, 5,31, 7) = (/ & + &1.6266e+01_r8,1.2373e+01_r8,8.7552e+00_r8,5.0004e+00_r8,1.0401e-01_r8/) + kbo(:, 1,32, 7) = (/ & + &1.2189e+01_r8,9.4190e+00_r8,6.7775e+00_r8,3.8398e+00_r8,7.2780e-02_r8/) + kbo(:, 2,32, 7) = (/ & + &1.3084e+01_r8,1.0062e+01_r8,7.2229e+00_r8,4.1020e+00_r8,7.7761e-02_r8/) + kbo(:, 3,32, 7) = (/ & + &1.4139e+01_r8,1.0827e+01_r8,7.7437e+00_r8,4.4056e+00_r8,8.2541e-02_r8/) + kbo(:, 4,32, 7) = (/ & + &1.5347e+01_r8,1.1710e+01_r8,8.3333e+00_r8,4.7481e+00_r8,8.6905e-02_r8/) + kbo(:, 5,32, 7) = (/ & + &1.6687e+01_r8,1.2692e+01_r8,8.9809e+00_r8,5.1206e+00_r8,9.0564e-02_r8/) + kbo(:, 1,33, 7) = (/ & + &1.2504e+01_r8,9.6581e+00_r8,6.9429e+00_r8,3.9220e+00_r8,6.3643e-02_r8/) + kbo(:, 2,33, 7) = (/ & + &1.3523e+01_r8,1.0393e+01_r8,7.4532e+00_r8,4.2218e+00_r8,6.8037e-02_r8/) + kbo(:, 3,33, 7) = (/ & + &1.4701e+01_r8,1.1251e+01_r8,8.0374e+00_r8,4.5635e+00_r8,7.2051e-02_r8/) + kbo(:, 4,33, 7) = (/ & + &1.6035e+01_r8,1.2227e+01_r8,8.6879e+00_r8,4.9410e+00_r8,7.5520e-02_r8/) + kbo(:, 5,33, 7) = (/ & + &1.7498e+01_r8,1.3301e+01_r8,9.3946e+00_r8,5.3470e+00_r8,7.8343e-02_r8/) + kbo(:, 1,34, 7) = (/ & + &1.2544e+01_r8,9.6932e+00_r8,6.9709e+00_r8,3.9324e+00_r8,5.5495e-02_r8/) + kbo(:, 2,34, 7) = (/ & + &1.3652e+01_r8,1.0495e+01_r8,7.5288e+00_r8,4.2613e+00_r8,5.9207e-02_r8/) + kbo(:, 3,34, 7) = (/ & + &1.4931e+01_r8,1.1428e+01_r8,8.1665e+00_r8,4.6328e+00_r8,6.2449e-02_r8/) + kbo(:, 4,34, 7) = (/ & + &1.6342e+01_r8,1.2460e+01_r8,8.8567e+00_r8,5.0367e+00_r8,6.5144e-02_r8/) + kbo(:, 5,34, 7) = (/ & + &1.7926e+01_r8,1.3623e+01_r8,9.6166e+00_r8,5.4694e+00_r8,6.7469e-02_r8/) + kbo(:, 1,35, 7) = (/ & + &1.2550e+01_r8,9.7037e+00_r8,6.9833e+00_r8,3.9358e+00_r8,4.7960e-02_r8/) + kbo(:, 2,35, 7) = (/ & + &1.3742e+01_r8,1.0569e+01_r8,7.5854e+00_r8,4.2904e+00_r8,5.1023e-02_r8/) + kbo(:, 3,35, 7) = (/ & + &1.5093e+01_r8,1.1555e+01_r8,8.2621e+00_r8,4.6878e+00_r8,5.3624e-02_r8/) + kbo(:, 4,35, 7) = (/ & + &1.6591e+01_r8,1.2650e+01_r8,8.9950e+00_r8,5.1151e+00_r8,5.5900e-02_r8/) + kbo(:, 5,35, 7) = (/ & + &1.8304e+01_r8,1.3907e+01_r8,9.8148e+00_r8,5.5812e+00_r8,5.7988e-02_r8/) + kbo(:, 1,36, 7) = (/ & + &1.2397e+01_r8,9.5976e+00_r8,6.9138e+00_r8,3.8949e+00_r8,4.1048e-02_r8/) + kbo(:, 2,36, 7) = (/ & + &1.3655e+01_r8,1.0513e+01_r8,7.5553e+00_r8,4.2704e+00_r8,4.3574e-02_r8/) + kbo(:, 3,36, 7) = (/ & + &1.5056e+01_r8,1.1535e+01_r8,8.2577e+00_r8,4.6863e+00_r8,4.5767e-02_r8/) + kbo(:, 4,36, 7) = (/ & + &1.6621e+01_r8,1.2678e+01_r8,9.0220e+00_r8,5.1309e+00_r8,4.7778e-02_r8/) + kbo(:, 5,36, 7) = (/ & + &1.8454e+01_r8,1.4024e+01_r8,9.9036e+00_r8,5.6291e+00_r8,4.9683e-02_r8/) + kbo(:, 1,37, 7) = (/ & + &1.1793e+01_r8,9.1604e+00_r8,6.6146e+00_r8,3.7234e+00_r8,3.4707e-02_r8/) + kbo(:, 2,37, 7) = (/ & + &1.3041e+01_r8,1.0070e+01_r8,7.2604e+00_r8,4.1046e+00_r8,3.6864e-02_r8/) + kbo(:, 3,37, 7) = (/ & + &1.4439e+01_r8,1.1088e+01_r8,7.9659e+00_r8,4.5244e+00_r8,3.8795e-02_r8/) + kbo(:, 4,37, 7) = (/ & + &1.6025e+01_r8,1.2245e+01_r8,8.7442e+00_r8,4.9773e+00_r8,4.0613e-02_r8/) + kbo(:, 5,37, 7) = (/ & + &1.7882e+01_r8,1.3605e+01_r8,9.6420e+00_r8,5.4880e+00_r8,4.2339e-02_r8/) + kbo(:, 1,38, 7) = (/ & + &1.1383e+01_r8,8.8666e+00_r8,6.4134e+00_r8,3.6072e+00_r8,2.9298e-02_r8/) + kbo(:, 2,38, 7) = (/ & + &1.2643e+01_r8,9.7859e+00_r8,7.0699e+00_r8,3.9972e+00_r8,3.1148e-02_r8/) + kbo(:, 3,38, 7) = (/ & + &1.4056e+01_r8,1.0814e+01_r8,7.7862e+00_r8,4.4229e+00_r8,3.2867e-02_r8/) + kbo(:, 4,38, 7) = (/ & + &1.5686e+01_r8,1.2002e+01_r8,8.5915e+00_r8,4.8935e+00_r8,3.4517e-02_r8/) + kbo(:, 5,38, 7) = (/ & + &1.7595e+01_r8,1.3400e+01_r8,9.5179e+00_r8,5.4208e+00_r8,3.6067e-02_r8/) + kbo(:, 1,39, 7) = (/ & + &1.1254e+01_r8,8.7785e+00_r8,6.3532e+00_r8,3.5698e+00_r8,2.4703e-02_r8/) + kbo(:, 2,39, 7) = (/ & + &1.2546e+01_r8,9.7238e+00_r8,7.0319e+00_r8,3.9725e+00_r8,2.6328e-02_r8/) + kbo(:, 3,39, 7) = (/ & + &1.4010e+01_r8,1.0789e+01_r8,7.7764e+00_r8,4.4152e+00_r8,2.7854e-02_r8/) + kbo(:, 4,39, 7) = (/ & + &1.5714e+01_r8,1.2031e+01_r8,8.6190e+00_r8,4.9070e+00_r8,2.9325e-02_r8/) + kbo(:, 5,39, 7) = (/ & + &1.7752e+01_r8,1.3525e+01_r8,9.6124e+00_r8,5.4718e+00_r8,3.0788e-02_r8/) + kbo(:, 1,40, 7) = (/ & + &1.0343e+01_r8,8.1149e+00_r8,5.8880e+00_r8,3.3077e+00_r8,2.0662e-02_r8/) + kbo(:, 2,40, 7) = (/ & + &1.1581e+01_r8,9.0215e+00_r8,6.5477e+00_r8,3.7008e+00_r8,2.2084e-02_r8/) + kbo(:, 3,40, 7) = (/ & + &1.2986e+01_r8,1.0044e+01_r8,7.2710e+00_r8,4.1322e+00_r8,2.3431e-02_r8/) + kbo(:, 4,40, 7) = (/ & + &1.4638e+01_r8,1.1247e+01_r8,8.0993e+00_r8,4.6196e+00_r8,2.4776e-02_r8/) + kbo(:, 5,40, 7) = (/ & + &1.6625e+01_r8,1.2700e+01_r8,9.0740e+00_r8,5.1787e+00_r8,2.6103e-02_r8/) + kbo(:, 1,41, 7) = (/ & + &9.4683e+00_r8,7.4757e+00_r8,5.4378e+00_r8,3.0540e+00_r8,1.7243e-02_r8/) + kbo(:, 2,41, 7) = (/ & + &1.0645e+01_r8,8.3400e+00_r8,6.0743e+00_r8,3.4334e+00_r8,1.8487e-02_r8/) + kbo(:, 3,41, 7) = (/ & + &1.1996e+01_r8,9.3250e+00_r8,6.7794e+00_r8,3.8546e+00_r8,1.9684e-02_r8/) + kbo(:, 4,41, 7) = (/ & + &1.3587e+01_r8,1.0480e+01_r8,7.5843e+00_r8,4.3322e+00_r8,2.0909e-02_r8/) + kbo(:, 5,41, 7) = (/ & + &1.5513e+01_r8,1.1886e+01_r8,8.5396e+00_r8,4.8864e+00_r8,2.2113e-02_r8/) + kbo(:, 1,42, 7) = (/ & + &8.7596e+00_r8,6.9575e+00_r8,5.0695e+00_r8,2.8442e+00_r8,1.4375e-02_r8/) + kbo(:, 2,42, 7) = (/ & + &9.8918e+00_r8,7.7921e+00_r8,5.6895e+00_r8,3.2145e+00_r8,1.5469e-02_r8/) + kbo(:, 3,42, 7) = (/ & + &1.1196e+01_r8,8.7450e+00_r8,6.3808e+00_r8,3.6290e+00_r8,1.6542e-02_r8/) + kbo(:, 4,42, 7) = (/ & + &1.2750e+01_r8,9.8741e+00_r8,7.1757e+00_r8,4.1018e+00_r8,1.7643e-02_r8/) + kbo(:, 5,42, 7) = (/ & + &1.4631e+01_r8,1.1244e+01_r8,8.1146e+00_r8,4.6494e+00_r8,1.8736e-02_r8/) + kbo(:, 1,43, 7) = (/ & + &8.1129e+00_r8,6.4828e+00_r8,4.7282e+00_r8,2.6502e+00_r8,1.1920e-02_r8/) + kbo(:, 2,43, 7) = (/ & + &9.2040e+00_r8,7.2919e+00_r8,5.3332e+00_r8,3.0110e+00_r8,1.2884e-02_r8/) + kbo(:, 3,43, 7) = (/ & + &1.0467e+01_r8,8.2176e+00_r8,6.0123e+00_r8,3.4195e+00_r8,1.3839e-02_r8/) + kbo(:, 4,43, 7) = (/ & + &1.1975e+01_r8,9.3139e+00_r8,6.7911e+00_r8,3.8837e+00_r8,1.4824e-02_r8/) + kbo(:, 5,43, 7) = (/ & + &1.3821e+01_r8,1.0658e+01_r8,7.7247e+00_r8,4.4294e+00_r8,1.5816e-02_r8/) + kbo(:, 1,44, 7) = (/ & + &7.5813e+00_r8,6.0889e+00_r8,4.4438e+00_r8,2.4886e+00_r8,9.8504e-03_r8/) + kbo(:, 2,44, 7) = (/ & + &8.6433e+00_r8,6.8838e+00_r8,5.0388e+00_r8,2.8416e+00_r8,1.0695e-02_r8/) + kbo(:, 3,44, 7) = (/ & + &9.8815e+00_r8,7.7937e+00_r8,5.7119e+00_r8,3.2452e+00_r8,1.1549e-02_r8/) + kbo(:, 4,44, 7) = (/ & + &1.1354e+01_r8,8.8664e+00_r8,6.4827e+00_r8,3.7047e+00_r8,1.2430e-02_r8/) + kbo(:, 5,44, 7) = (/ & + &1.3162e+01_r8,1.0183e+01_r8,7.4060e+00_r8,4.2473e+00_r8,1.3335e-02_r8/) + kbo(:, 1,45, 7) = (/ & + &7.2186e+00_r8,5.8199e+00_r8,4.2461e+00_r8,2.3747e+00_r8,8.1314e-03_r8/) + kbo(:, 2,45, 7) = (/ & + &8.2698e+00_r8,6.6114e+00_r8,4.8385e+00_r8,2.7251e+00_r8,8.8750e-03_r8/) + kbo(:, 3,45, 7) = (/ & + &9.5031e+00_r8,7.5246e+00_r8,5.5174e+00_r8,3.1306e+00_r8,9.6297e-03_r8/) + kbo(:, 4,45, 7) = (/ & + &1.0974e+01_r8,8.5972e+00_r8,6.2944e+00_r8,3.5936e+00_r8,1.0417e-02_r8/) + kbo(:, 5,45, 7) = (/ & + &1.2791e+01_r8,9.9194e+00_r8,7.2286e+00_r8,4.1456e+00_r8,1.1234e-02_r8/) + kbo(:, 1,46, 7) = (/ & + &6.9141e+00_r8,5.5940e+00_r8,4.0776e+00_r8,2.2758e+00_r8,6.6876e-03_r8/) + kbo(:, 2,46, 7) = (/ & + &7.9503e+00_r8,6.3788e+00_r8,4.6670e+00_r8,2.6226e+00_r8,7.3399e-03_r8/) + kbo(:, 3,46, 7) = (/ & + &9.1864e+00_r8,7.2991e+00_r8,5.3560e+00_r8,3.0335e+00_r8,8.0038e-03_r8/) + kbo(:, 4,46, 7) = (/ & + &1.0667e+01_r8,8.3803e+00_r8,6.1440e+00_r8,3.5030e+00_r8,8.7040e-03_r8/) + kbo(:, 5,46, 7) = (/ & + &1.2488e+01_r8,9.7091e+00_r8,7.0857e+00_r8,4.0595e+00_r8,9.4400e-03_r8/) + kbo(:, 1,47, 7) = (/ & + &6.5158e+00_r8,5.2952e+00_r8,3.8553e+00_r8,2.1461e+00_r8,5.4578e-03_r8/) + kbo(:, 2,47, 7) = (/ & + &7.5125e+00_r8,6.0542e+00_r8,4.4282e+00_r8,2.4823e+00_r8,6.0287e-03_r8/) + kbo(:, 3,47, 7) = (/ & + &8.7277e+00_r8,6.9654e+00_r8,5.1130e+00_r8,2.8905e+00_r8,6.6123e-03_r8/) + kbo(:, 4,47, 7) = (/ & + &1.0180e+01_r8,8.0330e+00_r8,5.8977e+00_r8,3.3599e+00_r8,7.2304e-03_r8/) + kbo(:, 5,47, 7) = (/ & + &1.1985e+01_r8,9.3498e+00_r8,6.8393e+00_r8,3.9162e+00_r8,7.8875e-03_r8/) + kbo(:, 1,48, 7) = (/ & + &6.3104e+00_r8,5.1398e+00_r8,3.7343e+00_r8,2.0712e+00_r8,4.4438e-03_r8/) + kbo(:, 2,48, 7) = (/ & + &7.2865e+00_r8,5.8865e+00_r8,4.2999e+00_r8,2.4038e+00_r8,4.9412e-03_r8/) + kbo(:, 3,48, 7) = (/ & + &8.5071e+00_r8,6.8079e+00_r8,4.9920e+00_r8,2.8153e+00_r8,5.4521e-03_r8/) + kbo(:, 4,48, 7) = (/ & + &9.9728e+00_r8,7.8905e+00_r8,5.7928e+00_r8,3.2942e+00_r8,5.9945e-03_r8/) + kbo(:, 5,48, 7) = (/ & + &1.1799e+01_r8,9.2259e+00_r8,6.7537e+00_r8,3.8639e+00_r8,6.5748e-03_r8/) + kbo(:, 1,49, 7) = (/ & + &6.3637e+00_r8,5.1793e+00_r8,3.7516e+00_r8,2.0723e+00_r8,3.6085e-03_r8/) + kbo(:, 2,49, 7) = (/ & + &7.3474e+00_r8,5.9332e+00_r8,4.3233e+00_r8,2.4087e+00_r8,4.0406e-03_r8/) + kbo(:, 3,49, 7) = (/ & + &8.6221e+00_r8,6.8978e+00_r8,5.0458e+00_r8,2.8357e+00_r8,4.4876e-03_r8/) + kbo(:, 4,49, 7) = (/ & + &1.0155e+01_r8,8.0340e+00_r8,5.8866e+00_r8,3.3379e+00_r8,4.9641e-03_r8/) + kbo(:, 5,49, 7) = (/ & + &1.2071e+01_r8,9.4371e+00_r8,6.8986e+00_r8,3.9361e+00_r8,5.4780e-03_r8/) + kbo(:, 1,50, 7) = (/ & + &6.1287e+00_r8,4.9982e+00_r8,3.6130e+00_r8,1.9898e+00_r8,2.9263e-03_r8/) + kbo(:, 2,50, 7) = (/ & + &7.0793e+00_r8,5.7315e+00_r8,4.1690e+00_r8,2.3166e+00_r8,3.3022e-03_r8/) + kbo(:, 3,50, 7) = (/ & + &8.3385e+00_r8,6.6892e+00_r8,4.8872e+00_r8,2.7388e+00_r8,3.6894e-03_r8/) + kbo(:, 4,50, 7) = (/ & + &9.8705e+00_r8,7.8310e+00_r8,5.7364e+00_r8,3.2460e+00_r8,4.1061e-03_r8/) + kbo(:, 5,50, 7) = (/ & + &1.1792e+01_r8,9.2428e+00_r8,6.7611e+00_r8,3.8534e+00_r8,4.5631e-03_r8/) + kbo(:, 1,51, 7) = (/ & + &5.7768e+00_r8,4.7273e+00_r8,3.4121e+00_r8,1.8743e+00_r8,2.3693e-03_r8/) + kbo(:, 2,51, 7) = (/ & + &6.6763e+00_r8,5.4272e+00_r8,3.9426e+00_r8,2.1849e+00_r8,2.6931e-03_r8/) + kbo(:, 3,51, 7) = (/ & + &7.8931e+00_r8,6.3576e+00_r8,4.6398e+00_r8,2.5939e+00_r8,3.0298e-03_r8/) + kbo(:, 4,51, 7) = (/ & + &9.3905e+00_r8,7.4818e+00_r8,5.4825e+00_r8,3.0966e+00_r8,3.3909e-03_r8/) + kbo(:, 5,51, 7) = (/ & + &1.1270e+01_r8,8.8663e+00_r8,6.4953e+00_r8,3.6986e+00_r8,3.7911e-03_r8/) + kbo(:, 1,52, 7) = (/ & + &5.5982e+00_r8,4.5875e+00_r8,3.3045e+00_r8,1.8093e+00_r8,1.9133e-03_r8/) + kbo(:, 2,52, 7) = (/ & + &6.4669e+00_r8,5.2676e+00_r8,3.8189e+00_r8,2.1105e+00_r8,2.1929e-03_r8/) + kbo(:, 3,52, 7) = (/ & + &7.6692e+00_r8,6.1904e+00_r8,4.5114e+00_r8,2.5133e+00_r8,2.4833e-03_r8/) + kbo(:, 4,52, 7) = (/ & + &9.1760e+00_r8,7.3261e+00_r8,5.3623e+00_r8,3.0203e+00_r8,2.7953e-03_r8/) + kbo(:, 5,52, 7) = (/ & + &1.1059e+01_r8,8.7181e+00_r8,6.3851e+00_r8,3.6291e+00_r8,3.1452e-03_r8/) + kbo(:, 1,53, 7) = (/ & + &5.6498e+00_r8,4.6222e+00_r8,3.3203e+00_r8,1.8115e+00_r8,1.5408e-03_r8/) + kbo(:, 2,53, 7) = (/ & + &6.5197e+00_r8,5.3054e+00_r8,3.8365e+00_r8,2.1129e+00_r8,1.7821e-03_r8/) + kbo(:, 3,53, 7) = (/ & + &7.7464e+00_r8,6.2478e+00_r8,4.5414e+00_r8,2.5222e+00_r8,2.0319e-03_r8/) + kbo(:, 4,53, 7) = (/ & + &9.3204e+00_r8,7.4376e+00_r8,5.4308e+00_r8,3.0476e+00_r8,2.3029e-03_r8/) + kbo(:, 5,53, 7) = (/ & + &1.1294e+01_r8,8.9013e+00_r8,6.5042e+00_r8,3.6848e+00_r8,2.6089e-03_r8/) + kbo(:, 1,54, 7) = (/ & + &4.9410e+00_r8,4.0701e+00_r8,2.9220e+00_r8,1.5920e+00_r8,1.2393e-03_r8/) + kbo(:, 2,54, 7) = (/ & + &5.7011e+00_r8,4.6779e+00_r8,3.3818e+00_r8,1.8599e+00_r8,1.4465e-03_r8/) + kbo(:, 3,54, 7) = (/ & + &6.7851e+00_r8,5.5214e+00_r8,4.0167e+00_r8,2.2288e+00_r8,1.6602e-03_r8/) + kbo(:, 4,54, 7) = (/ & + &8.2133e+00_r8,6.6133e+00_r8,4.8372e+00_r8,2.7129e+00_r8,1.8918e-03_r8/) + kbo(:, 5,54, 7) = (/ & + &1.0009e+01_r8,7.9570e+00_r8,5.8358e+00_r8,3.3045e+00_r8,2.1561e-03_r8/) + kbo(:, 1,55, 7) = (/ & + &3.9448e+00_r8,3.2894e+00_r8,2.3617e+00_r8,1.2863e+00_r8,9.9479e-04_r8/) + kbo(:, 2,55, 7) = (/ & + &4.5510e+00_r8,3.7868e+00_r8,2.7406e+00_r8,1.5076e+00_r8,1.1698e-03_r8/) + kbo(:, 3,55, 7) = (/ & + &5.4272e+00_r8,4.4849e+00_r8,3.2681e+00_r8,1.8142e+00_r8,1.3510e-03_r8/) + kbo(:, 4,55, 7) = (/ & + &6.6050e+00_r8,5.4031e+00_r8,3.9651e+00_r8,2.2259e+00_r8,1.5494e-03_r8/) + kbo(:, 5,55, 7) = (/ & + &8.0992e+00_r8,6.5420e+00_r8,4.8249e+00_r8,2.7373e+00_r8,1.7731e-03_r8/) + kbo(:, 1,56, 7) = (/ & + &3.1456e+00_r8,2.6539e+00_r8,1.9051e+00_r8,1.0370e+00_r8,7.9618e-04_r8/) + kbo(:, 2,56, 7) = (/ & + &3.6287e+00_r8,3.0618e+00_r8,2.2169e+00_r8,1.2199e+00_r8,9.4437e-04_r8/) + kbo(:, 3,56, 7) = (/ & + &4.3315e+00_r8,3.6363e+00_r8,2.6526e+00_r8,1.4737e+00_r8,1.0978e-03_r8/) + kbo(:, 4,56, 7) = (/ & + &5.3003e+00_r8,4.4092e+00_r8,3.2425e+00_r8,1.8210e+00_r8,1.2654e-03_r8/) + kbo(:, 5,56, 7) = (/ & + &6.5412e+00_r8,5.3749e+00_r8,3.9813e+00_r8,2.2622e+00_r8,1.4546e-03_r8/) + kbo(:, 1,57, 7) = (/ & + &2.5050e+00_r8,2.1372e+00_r8,1.5333e+00_r8,8.3409e-01_r8,6.3524e-04_r8/) + kbo(:, 2,57, 7) = (/ & + &2.8897e+00_r8,2.4717e+00_r8,1.7900e+00_r8,9.8489e-01_r8,7.5959e-04_r8/) + kbo(:, 3,57, 7) = (/ & + &3.4502e+00_r8,2.9412e+00_r8,2.1481e+00_r8,1.1943e+00_r8,8.8948e-04_r8/) + kbo(:, 4,57, 7) = (/ & + &4.2411e+00_r8,3.5892e+00_r8,2.6434e+00_r8,1.4858e+00_r8,1.0311e-03_r8/) + kbo(:, 5,57, 7) = (/ & + &5.2712e+00_r8,4.4105e+00_r8,3.2776e+00_r8,1.8647e+00_r8,1.1913e-03_r8/) + kbo(:, 1,58, 7) = (/ & + &5.2639e-01_r8,5.5628e-01_r8,5.1310e-01_r8,3.9091e-01_r8,5.0641e-04_r8/) + kbo(:, 2,58, 7) = (/ & + &6.0772e-01_r8,6.4553e-01_r8,6.0135e-01_r8,4.6372e-01_r8,6.1035e-04_r8/) + kbo(:, 3,58, 7) = (/ & + &7.2539e-01_r8,7.7016e-01_r8,7.2403e-01_r8,5.6463e-01_r8,7.2056e-04_r8/) + kbo(:, 4,58, 7) = (/ & + &8.9558e-01_r8,9.4507e-01_r8,8.9682e-01_r8,7.0739e-01_r8,8.3918e-04_r8/) + kbo(:, 5,58, 7) = (/ & + &1.1215e+00_r8,1.1728e+00_r8,1.1240e+00_r8,8.9769e-01_r8,9.7498e-04_r8/) + kbo(:, 1,59, 7) = (/ & + &5.0774e-01_r8,5.2725e-01_r8,4.5400e-01_r8,3.0925e-01_r8,4.1598e-04_r8/) + kbo(:, 2,59, 7) = (/ & + &5.8906e-01_r8,6.1772e-01_r8,5.3777e-01_r8,3.7151e-01_r8,5.0342e-04_r8/) + kbo(:, 3,59, 7) = (/ & + &7.0796e-01_r8,7.4490e-01_r8,6.5525e-01_r8,4.5851e-01_r8,5.9609e-04_r8/) + kbo(:, 4,59, 7) = (/ & + &8.8130e-01_r8,9.2517e-01_r8,8.2251e-01_r8,5.8308e-01_r8,6.9661e-04_r8/) + kbo(:, 5,59, 7) = (/ & + &1.1130e+00_r8,1.1619e+00_r8,1.0449e+00_r8,7.5118e-01_r8,8.1226e-04_r8/) + kbo(:, 1,13, 8) = (/ & + &5.5674e+03_r8,4.1757e+03_r8,2.7839e+03_r8,1.3922e+03_r8,1.1827e+00_r8/) + kbo(:, 2,13, 8) = (/ & + &5.5672e+03_r8,4.1755e+03_r8,2.7838e+03_r8,1.3922e+03_r8,1.1780e+00_r8/) + kbo(:, 3,13, 8) = (/ & + &5.5974e+03_r8,4.1981e+03_r8,2.7989e+03_r8,1.3997e+03_r8,1.1714e+00_r8/) + kbo(:, 4,13, 8) = (/ & + &5.6743e+03_r8,4.2558e+03_r8,2.8374e+03_r8,1.4189e+03_r8,1.1612e+00_r8/) + kbo(:, 5,13, 8) = (/ & + &5.7999e+03_r8,4.3500e+03_r8,2.9002e+03_r8,1.4503e+03_r8,1.1566e+00_r8/) + kbo(:, 1,14, 8) = (/ & + &3.0072e+03_r8,2.2555e+03_r8,1.5038e+03_r8,7.5211e+02_r8,1.1873e+00_r8/) + kbo(:, 2,14, 8) = (/ & + &3.0260e+03_r8,2.2696e+03_r8,1.5132e+03_r8,7.5683e+02_r8,1.1778e+00_r8/) + kbo(:, 3,14, 8) = (/ & + &3.0739e+03_r8,2.3055e+03_r8,1.5371e+03_r8,7.6880e+02_r8,1.1759e+00_r8/) + kbo(:, 4,14, 8) = (/ & + &3.1534e+03_r8,2.3651e+03_r8,1.5769e+03_r8,7.8868e+02_r8,1.1686e+00_r8/) + kbo(:, 5,14, 8) = (/ & + &3.2601e+03_r8,2.4451e+03_r8,1.6302e+03_r8,8.1536e+02_r8,1.1588e+00_r8/) + kbo(:, 1,15, 8) = (/ & + &1.6681e+03_r8,1.2512e+03_r8,8.3428e+02_r8,4.1737e+02_r8,1.1796e+00_r8/) + kbo(:, 2,15, 8) = (/ & + &1.6959e+03_r8,1.2720e+03_r8,8.4818e+02_r8,4.2432e+02_r8,1.1712e+00_r8/) + kbo(:, 3,15, 8) = (/ & + &1.7438e+03_r8,1.3080e+03_r8,8.7214e+02_r8,4.3631e+02_r8,1.1630e+00_r8/) + kbo(:, 4,15, 8) = (/ & + &1.8057e+03_r8,1.3544e+03_r8,9.0311e+02_r8,4.5180e+02_r8,1.1584e+00_r8/) + kbo(:, 5,15, 8) = (/ & + &1.8729e+03_r8,1.4048e+03_r8,9.3671e+02_r8,4.6860e+02_r8,1.1490e+00_r8/) + kbo(:, 1,16, 8) = (/ & + &1.1127e+03_r8,8.3463e+02_r8,5.5657e+02_r8,2.7851e+02_r8,1.1544e+00_r8/) + kbo(:, 2,16, 8) = (/ & + &1.1452e+03_r8,8.5902e+02_r8,5.7284e+02_r8,2.8665e+02_r8,1.1489e+00_r8/) + kbo(:, 3,16, 8) = (/ & + &1.1859e+03_r8,8.8958e+02_r8,5.9321e+02_r8,2.9685e+02_r8,1.1423e+00_r8/) + kbo(:, 4,16, 8) = (/ & + &1.2314e+03_r8,9.2370e+02_r8,6.1596e+02_r8,3.0822e+02_r8,1.1380e+00_r8/) + kbo(:, 5,16, 8) = (/ & + &1.2793e+03_r8,9.5963e+02_r8,6.3991e+02_r8,3.2020e+02_r8,1.1307e+00_r8/) + kbo(:, 1,17, 8) = (/ & + &7.7661e+02_r8,5.8258e+02_r8,3.8854e+02_r8,1.9450e+02_r8,1.1162e+00_r8/) + kbo(:, 2,17, 8) = (/ & + &8.0415e+02_r8,6.0323e+02_r8,4.0231e+02_r8,2.0139e+02_r8,1.1130e+00_r8/) + kbo(:, 3,17, 8) = (/ & + &8.3554e+02_r8,6.2677e+02_r8,4.1801e+02_r8,2.0924e+02_r8,1.1093e+00_r8/) + kbo(:, 4,17, 8) = (/ & + &8.6787e+02_r8,6.5102e+02_r8,4.3418e+02_r8,2.1733e+02_r8,1.1057e+00_r8/) + kbo(:, 5,17, 8) = (/ & + &9.0039e+02_r8,6.7541e+02_r8,4.5043e+02_r8,2.2545e+02_r8,1.0994e+00_r8/) + kbo(:, 1,18, 8) = (/ & + &5.5593e+02_r8,4.1706e+02_r8,2.7819e+02_r8,1.3933e+02_r8,1.0653e+00_r8/) + kbo(:, 2,18, 8) = (/ & + &5.7731e+02_r8,4.3309e+02_r8,2.8888e+02_r8,1.4467e+02_r8,1.0637e+00_r8/) + kbo(:, 3,18, 8) = (/ & + &5.9962e+02_r8,4.4983e+02_r8,3.0005e+02_r8,1.5026e+02_r8,1.0625e+00_r8/) + kbo(:, 4,18, 8) = (/ & + &6.2213e+02_r8,4.6672e+02_r8,3.1130e+02_r8,1.5589e+02_r8,1.0595e+00_r8/) + kbo(:, 5,18, 8) = (/ & + &6.4470e+02_r8,4.8364e+02_r8,3.2258e+02_r8,1.6152e+02_r8,1.0552e+00_r8/) + kbo(:, 1,19, 8) = (/ & + &3.9059e+02_r8,2.9306e+02_r8,1.9552e+02_r8,9.7992e+01_r8,1.0025e+00_r8/) + kbo(:, 2,19, 8) = (/ & + &4.0544e+02_r8,3.0420e+02_r8,2.0295e+02_r8,1.0172e+02_r8,1.0019e+00_r8/) + kbo(:, 3,19, 8) = (/ & + &4.2056e+02_r8,3.1554e+02_r8,2.1052e+02_r8,1.0550e+02_r8,1.0025e+00_r8/) + kbo(:, 4,19, 8) = (/ & + &4.3576e+02_r8,3.2693e+02_r8,2.1811e+02_r8,1.0930e+02_r8,1.0012e+00_r8/) + kbo(:, 5,19, 8) = (/ & + &4.5126e+02_r8,3.3856e+02_r8,2.2586e+02_r8,1.1317e+02_r8,9.9899e-01_r8/) + kbo(:, 1,20, 8) = (/ & + &2.9617e+02_r8,2.2224e+02_r8,1.4831e+02_r8,7.4392e+01_r8,9.3059e-01_r8/) + kbo(:, 2,20, 8) = (/ & + &3.0716e+02_r8,2.3049e+02_r8,1.5382e+02_r8,7.7154e+01_r8,9.3219e-01_r8/) + kbo(:, 3,20, 8) = (/ & + &3.1816e+02_r8,2.3874e+02_r8,1.5932e+02_r8,7.9908e+01_r8,9.3370e-01_r8/) + kbo(:, 4,20, 8) = (/ & + &3.2952e+02_r8,2.4726e+02_r8,1.6500e+02_r8,8.2741e+01_r8,9.3435e-01_r8/) + kbo(:, 5,20, 8) = (/ & + &3.4150e+02_r8,2.5625e+02_r8,1.7099e+02_r8,8.5741e+01_r8,9.3474e-01_r8/) + kbo(:, 1,21, 8) = (/ & + &2.3042e+02_r8,1.7293e+02_r8,1.1544e+02_r8,5.7965e+01_r8,8.5235e-01_r8/) + kbo(:, 2,21, 8) = (/ & + &2.3880e+02_r8,1.7922e+02_r8,1.1964e+02_r8,6.0070e+01_r8,8.5599e-01_r8/) + kbo(:, 3,21, 8) = (/ & + &2.4721e+02_r8,1.8553e+02_r8,1.2385e+02_r8,6.2177e+01_r8,8.5938e-01_r8/) + kbo(:, 4,21, 8) = (/ & + &2.5622e+02_r8,1.9229e+02_r8,1.2835e+02_r8,6.4426e+01_r8,8.6241e-01_r8/) + kbo(:, 5,21, 8) = (/ & + &2.6653e+02_r8,2.0002e+02_r8,1.3351e+02_r8,6.7009e+01_r8,8.6670e-01_r8/) + kbo(:, 1,22, 8) = (/ & + &1.8346e+02_r8,1.3771e+02_r8,9.1962e+01_r8,4.6247e+01_r8,7.7175e-01_r8/) + kbo(:, 2,22, 8) = (/ & + &1.8996e+02_r8,1.4259e+02_r8,9.5222e+01_r8,4.7880e+01_r8,7.7757e-01_r8/) + kbo(:, 3,22, 8) = (/ & + &1.9685e+02_r8,1.4775e+02_r8,9.8665e+01_r8,4.9599e+01_r8,7.8369e-01_r8/) + kbo(:, 4,22, 8) = (/ & + &2.0481e+02_r8,1.5373e+02_r8,1.0265e+02_r8,5.1591e+01_r8,7.9052e-01_r8/) + kbo(:, 5,22, 8) = (/ & + &2.1438e+02_r8,1.6091e+02_r8,1.0745e+02_r8,5.3989e+01_r8,7.9865e-01_r8/) + kbo(:, 1,23, 8) = (/ & + &1.4619e+02_r8,1.0976e+02_r8,7.3333e+01_r8,3.7009e+01_r8,6.9269e-01_r8/) + kbo(:, 2,23, 8) = (/ & + &1.5146e+02_r8,1.1371e+02_r8,7.5969e+01_r8,3.8312e+01_r8,7.0058e-01_r8/) + kbo(:, 3,23, 8) = (/ & + &1.5752e+02_r8,1.1826e+02_r8,7.9004e+01_r8,3.9812e+01_r8,7.0997e-01_r8/) + kbo(:, 4,23, 8) = (/ & + &1.6498e+02_r8,1.2386e+02_r8,8.2742e+01_r8,4.1669e+01_r8,7.2082e-01_r8/) + kbo(:, 5,23, 8) = (/ & + &1.7382e+02_r8,1.3049e+02_r8,8.7175e+01_r8,4.3881e+01_r8,7.3247e-01_r8/) + kbo(:, 1,24, 8) = (/ & + &1.1546e+02_r8,8.6713e+01_r8,5.7975e+01_r8,2.9484e+01_r8,6.1736e-01_r8/) + kbo(:, 2,24, 8) = (/ & + &1.1997e+02_r8,9.0096e+01_r8,6.0229e+01_r8,3.0574e+01_r8,6.2822e-01_r8/) + kbo(:, 3,24, 8) = (/ & + &1.2560e+02_r8,9.4324e+01_r8,6.3051e+01_r8,3.1946e+01_r8,6.4118e-01_r8/) + kbo(:, 4,24, 8) = (/ & + &1.3251e+02_r8,9.9515e+01_r8,6.6517e+01_r8,3.3646e+01_r8,6.5583e-01_r8/) + kbo(:, 5,24, 8) = (/ & + &1.4039e+02_r8,1.0542e+02_r8,7.0467e+01_r8,3.5600e+01_r8,6.7045e-01_r8/) + kbo(:, 1,25, 8) = (/ & + &9.2335e+01_r8,6.9366e+01_r8,4.6428e+01_r8,2.3921e+01_r8,5.4857e-01_r8/) + kbo(:, 2,25, 8) = (/ & + &9.6533e+01_r8,7.2518e+01_r8,4.8524e+01_r8,2.4911e+01_r8,5.6301e-01_r8/) + kbo(:, 3,25, 8) = (/ & + &1.0186e+02_r8,7.6521e+01_r8,5.1191e+01_r8,2.6188e+01_r8,5.7925e-01_r8/) + kbo(:, 4,25, 8) = (/ & + &1.0808e+02_r8,8.1193e+01_r8,5.4315e+01_r8,2.7693e+01_r8,5.9615e-01_r8/) + kbo(:, 5,25, 8) = (/ & + &1.1475e+02_r8,8.6195e+01_r8,5.7652e+01_r8,2.9318e+01_r8,6.1289e-01_r8/) + kbo(:, 1,26, 8) = (/ & + &7.5309e+01_r8,5.6599e+01_r8,3.7963e+01_r8,1.9911e+01_r8,4.8832e-01_r8/) + kbo(:, 2,26, 8) = (/ & + &7.9402e+01_r8,5.9672e+01_r8,3.9995e+01_r8,2.0863e+01_r8,5.0531e-01_r8/) + kbo(:, 3,26, 8) = (/ & + &8.4365e+01_r8,6.3403e+01_r8,4.2472e+01_r8,2.2029e+01_r8,5.2357e-01_r8/) + kbo(:, 4,26, 8) = (/ & + &8.9751e+01_r8,6.7447e+01_r8,4.5169e+01_r8,2.3307e+01_r8,5.4165e-01_r8/) + kbo(:, 5,26, 8) = (/ & + &9.5432e+01_r8,7.1708e+01_r8,4.8005e+01_r8,2.4657e+01_r8,5.6018e-01_r8/) + kbo(:, 1,27, 8) = (/ & + &6.4036e+01_r8,4.8147e+01_r8,3.2405e+01_r8,1.7310e+01_r8,4.3584e-01_r8/) + kbo(:, 2,27, 8) = (/ & + &6.8098e+01_r8,5.1198e+01_r8,3.4406e+01_r8,1.8250e+01_r8,4.5420e-01_r8/) + kbo(:, 3,27, 8) = (/ & + &7.2623e+01_r8,5.4602e+01_r8,3.6656e+01_r8,1.9303e+01_r8,4.7326e-01_r8/) + kbo(:, 4,27, 8) = (/ & + &7.7443e+01_r8,5.8217e+01_r8,3.9050e+01_r8,2.0426e+01_r8,4.9239e-01_r8/) + kbo(:, 5,27, 8) = (/ & + &8.2321e+01_r8,6.1875e+01_r8,4.1476e+01_r8,2.1557e+01_r8,5.1192e-01_r8/) + kbo(:, 1,28, 8) = (/ & + &5.6234e+01_r8,4.2299e+01_r8,2.8597e+01_r8,1.5531e+01_r8,3.8958e-01_r8/) + kbo(:, 2,28, 8) = (/ & + &6.0088e+01_r8,4.5199e+01_r8,3.0486e+01_r8,1.6430e+01_r8,4.0865e-01_r8/) + kbo(:, 3,28, 8) = (/ & + &6.4206e+01_r8,4.8292e+01_r8,3.2515e+01_r8,1.7385e+01_r8,4.2800e-01_r8/) + kbo(:, 4,28, 8) = (/ & + &6.8496e+01_r8,5.1510e+01_r8,3.4630e+01_r8,1.8368e+01_r8,4.4785e-01_r8/) + kbo(:, 5,28, 8) = (/ & + &7.2933e+01_r8,5.4831e+01_r8,3.6814e+01_r8,1.9374e+01_r8,4.6830e-01_r8/) + kbo(:, 1,29, 8) = (/ & + &5.2522e+01_r8,3.9524e+01_r8,2.6825e+01_r8,1.4721e+01_r8,3.4924e-01_r8/) + kbo(:, 2,29, 8) = (/ & + &5.6330e+01_r8,4.2387e+01_r8,2.8683e+01_r8,1.5618e+01_r8,3.6822e-01_r8/) + kbo(:, 3,29, 8) = (/ & + &6.0271e+01_r8,4.5343e+01_r8,3.0606e+01_r8,1.6531e+01_r8,3.8784e-01_r8/) + kbo(:, 4,29, 8) = (/ & + &6.4389e+01_r8,4.8431e+01_r8,3.2623e+01_r8,1.7468e+01_r8,4.0814e-01_r8/) + kbo(:, 5,29, 8) = (/ & + &6.8669e+01_r8,5.1633e+01_r8,3.4713e+01_r8,1.8422e+01_r8,4.2953e-01_r8/) + kbo(:, 1,30, 8) = (/ & + &5.0335e+01_r8,3.7896e+01_r8,2.5810e+01_r8,1.4271e+01_r8,3.1347e-01_r8/) + kbo(:, 2,30, 8) = (/ & + &5.4100e+01_r8,4.0719e+01_r8,2.7633e+01_r8,1.5165e+01_r8,3.3234e-01_r8/) + kbo(:, 3,30, 8) = (/ & + &5.7975e+01_r8,4.3625e+01_r8,2.9511e+01_r8,1.6060e+01_r8,3.5217e-01_r8/) + kbo(:, 4,30, 8) = (/ & + &6.2057e+01_r8,4.6681e+01_r8,3.1490e+01_r8,1.6979e+01_r8,3.7324e-01_r8/) + kbo(:, 5,30, 8) = (/ & + &6.6429e+01_r8,4.9951e+01_r8,3.3616e+01_r8,1.7947e+01_r8,3.9520e-01_r8/) + kbo(:, 1,31, 8) = (/ & + &5.0736e+01_r8,3.8204e+01_r8,2.6057e+01_r8,1.4444e+01_r8,2.8199e-01_r8/) + kbo(:, 2,31, 8) = (/ & + &5.4607e+01_r8,4.1105e+01_r8,2.7922e+01_r8,1.5358e+01_r8,3.0094e-01_r8/) + kbo(:, 3,31, 8) = (/ & + &5.8681e+01_r8,4.4155e+01_r8,2.9887e+01_r8,1.6295e+01_r8,3.2130e-01_r8/) + kbo(:, 4,31, 8) = (/ & + &6.3068e+01_r8,4.7436e+01_r8,3.2008e+01_r8,1.7279e+01_r8,3.4300e-01_r8/) + kbo(:, 5,31, 8) = (/ & + &6.7873e+01_r8,5.1031e+01_r8,3.4344e+01_r8,1.8340e+01_r8,3.6582e-01_r8/) + kbo(:, 1,32, 8) = (/ & + &5.1816e+01_r8,3.9019e+01_r8,2.6627e+01_r8,1.4770e+01_r8,2.5449e-01_r8/) + kbo(:, 2,32, 8) = (/ & + &5.5914e+01_r8,4.2088e+01_r8,2.8597e+01_r8,1.5735e+01_r8,2.7379e-01_r8/) + kbo(:, 3,32, 8) = (/ & + &6.0292e+01_r8,4.5361e+01_r8,3.0700e+01_r8,1.6736e+01_r8,2.9480e-01_r8/) + kbo(:, 4,32, 8) = (/ & + &6.5110e+01_r8,4.8965e+01_r8,3.3030e+01_r8,1.7812e+01_r8,3.1717e-01_r8/) + kbo(:, 5,32, 8) = (/ & + &7.0477e+01_r8,5.2981e+01_r8,3.5640e+01_r8,1.8999e+01_r8,3.4101e-01_r8/) + kbo(:, 1,33, 8) = (/ & + &5.3927e+01_r8,4.0606e+01_r8,2.7695e+01_r8,1.5341e+01_r8,2.3093e-01_r8/) + kbo(:, 2,33, 8) = (/ & + &5.8395e+01_r8,4.3947e+01_r8,2.9836e+01_r8,1.6383e+01_r8,2.5073e-01_r8/) + kbo(:, 3,33, 8) = (/ & + &6.3254e+01_r8,4.7578e+01_r8,3.2172e+01_r8,1.7485e+01_r8,2.7229e-01_r8/) + kbo(:, 4,33, 8) = (/ & + &6.8732e+01_r8,5.1678e+01_r8,3.4827e+01_r8,1.8707e+01_r8,2.9562e-01_r8/) + kbo(:, 5,33, 8) = (/ & + &7.4993e+01_r8,5.6366e+01_r8,3.7885e+01_r8,2.0105e+01_r8,3.2058e-01_r8/) + kbo(:, 1,34, 8) = (/ & + &5.4725e+01_r8,4.1207e+01_r8,2.8111e+01_r8,1.5582e+01_r8,2.1030e-01_r8/) + kbo(:, 2,34, 8) = (/ & + &5.9482e+01_r8,4.4761e+01_r8,3.0384e+01_r8,1.6682e+01_r8,2.3046e-01_r8/) + kbo(:, 3,34, 8) = (/ & + &6.4816e+01_r8,4.8747e+01_r8,3.2949e+01_r8,1.7887e+01_r8,2.5288e-01_r8/) + kbo(:, 4,34, 8) = (/ & + &7.0970e+01_r8,5.3352e+01_r8,3.5935e+01_r8,1.9263e+01_r8,2.7720e-01_r8/) + kbo(:, 5,34, 8) = (/ & + &7.8000e+01_r8,5.8622e+01_r8,3.9384e+01_r8,2.0853e+01_r8,3.0314e-01_r8/) + kbo(:, 1,35, 8) = (/ & + &5.5341e+01_r8,4.1670e+01_r8,2.8432e+01_r8,1.5766e+01_r8,1.9105e-01_r8/) + kbo(:, 2,35, 8) = (/ & + &6.0475e+01_r8,4.5504e+01_r8,3.0887e+01_r8,1.6952e+01_r8,2.1167e-01_r8/) + kbo(:, 3,35, 8) = (/ & + &6.6351e+01_r8,4.9895e+01_r8,3.3711e+01_r8,1.8277e+01_r8,2.3461e-01_r8/) + kbo(:, 4,35, 8) = (/ & + &7.3222e+01_r8,5.5040e+01_r8,3.7057e+01_r8,1.9828e+01_r8,2.5964e-01_r8/) + kbo(:, 5,35, 8) = (/ & + &8.0936e+01_r8,6.0824e+01_r8,4.0848e+01_r8,2.1583e+01_r8,2.8629e-01_r8/) + kbo(:, 1,36, 8) = (/ & + &5.5260e+01_r8,4.1610e+01_r8,2.8415e+01_r8,1.5779e+01_r8,1.7255e-01_r8/) + kbo(:, 2,36, 8) = (/ & + &6.0687e+01_r8,4.5661e+01_r8,3.1003e+01_r8,1.7034e+01_r8,1.9343e-01_r8/) + kbo(:, 3,36, 8) = (/ & + &6.7095e+01_r8,5.0451e+01_r8,3.4089e+01_r8,1.8486e+01_r8,2.1666e-01_r8/) + kbo(:, 4,36, 8) = (/ & + &7.4593e+01_r8,5.6070e+01_r8,3.7750e+01_r8,2.0193e+01_r8,2.4210e-01_r8/) + kbo(:, 5,36, 8) = (/ & + &8.2912e+01_r8,6.2305e+01_r8,4.1836e+01_r8,2.2093e+01_r8,2.6939e-01_r8/) + kbo(:, 1,37, 8) = (/ & + &5.3136e+01_r8,4.0024e+01_r8,2.7403e+01_r8,1.5295e+01_r8,1.5374e-01_r8/) + kbo(:, 2,37, 8) = (/ & + &5.8700e+01_r8,4.4173e+01_r8,3.0048e+01_r8,1.6588e+01_r8,1.7430e-01_r8/) + kbo(:, 3,37, 8) = (/ & + &6.5370e+01_r8,4.9158e+01_r8,3.3257e+01_r8,1.8110e+01_r8,1.9744e-01_r8/) + kbo(:, 4,37, 8) = (/ & + &7.3079e+01_r8,5.4934e+01_r8,3.7017e+01_r8,1.9876e+01_r8,2.2299e-01_r8/) + kbo(:, 5,37, 8) = (/ & + &8.1729e+01_r8,6.1417e+01_r8,4.1258e+01_r8,2.1852e+01_r8,2.5074e-01_r8/) + kbo(:, 1,38, 8) = (/ & + &5.1889e+01_r8,3.9094e+01_r8,2.6819e+01_r8,1.5017e+01_r8,1.3711e-01_r8/) + kbo(:, 2,38, 8) = (/ & + &5.7665e+01_r8,4.3397e+01_r8,2.9561e+01_r8,1.6368e+01_r8,1.5734e-01_r8/) + kbo(:, 3,38, 8) = (/ & + &6.4668e+01_r8,4.8631e+01_r8,3.2933e+01_r8,1.7981e+01_r8,1.8028e-01_r8/) + kbo(:, 4,38, 8) = (/ & + &7.2785e+01_r8,5.4713e+01_r8,3.6887e+01_r8,1.9846e+01_r8,2.0601e-01_r8/) + kbo(:, 5,38, 8) = (/ & + &8.1846e+01_r8,6.1504e+01_r8,4.1328e+01_r8,2.1921e+01_r8,2.3415e-01_r8/) + kbo(:, 1,39, 8) = (/ & + &5.1946e+01_r8,3.9141e+01_r8,2.6874e+01_r8,1.5056e+01_r8,1.2254e-01_r8/) + kbo(:, 2,39, 8) = (/ & + &5.8115e+01_r8,4.3735e+01_r8,2.9803e+01_r8,1.6507e+01_r8,1.4241e-01_r8/) + kbo(:, 3,39, 8) = (/ & + &6.5638e+01_r8,4.9361e+01_r8,3.3432e+01_r8,1.8252e+01_r8,1.6535e-01_r8/) + kbo(:, 4,39, 8) = (/ & + &7.4281e+01_r8,5.5835e+01_r8,3.7644e+01_r8,2.0246e+01_r8,1.9114e-01_r8/) + kbo(:, 5,39, 8) = (/ & + &8.4117e+01_r8,6.3205e+01_r8,4.2465e+01_r8,2.2507e+01_r8,2.1954e-01_r8/) + kbo(:, 1,40, 8) = (/ & + &4.8372e+01_r8,3.6476e+01_r8,2.5167e+01_r8,1.4200e+01_r8,1.0786e-01_r8/) + kbo(:, 2,40, 8) = (/ & + &5.4435e+01_r8,4.0985e+01_r8,2.8035e+01_r8,1.5644e+01_r8,1.2713e-01_r8/) + kbo(:, 3,40, 8) = (/ & + &6.1814e+01_r8,4.6498e+01_r8,3.1582e+01_r8,1.7371e+01_r8,1.4957e-01_r8/) + kbo(:, 4,40, 8) = (/ & + &7.0455e+01_r8,5.2966e+01_r8,3.5777e+01_r8,1.9373e+01_r8,1.7507e-01_r8/) + kbo(:, 5,40, 8) = (/ & + &8.0314e+01_r8,6.0352e+01_r8,4.0598e+01_r8,2.1643e+01_r8,2.0339e-01_r8/) + kbo(:, 1,41, 8) = (/ & + &4.4863e+01_r8,3.3865e+01_r8,2.3494e+01_r8,1.3347e+01_r8,9.4622e-02_r8/) + kbo(:, 2,41, 8) = (/ & + &5.0838e+01_r8,3.8301e+01_r8,2.6314e+01_r8,1.4793e+01_r8,1.1320e-01_r8/) + kbo(:, 3,41, 8) = (/ & + &5.8061e+01_r8,4.3692e+01_r8,2.9774e+01_r8,1.6500e+01_r8,1.3504e-01_r8/) + kbo(:, 4,41, 8) = (/ & + &6.6603e+01_r8,5.0081e+01_r8,3.3908e+01_r8,1.8494e+01_r8,1.6019e-01_r8/) + kbo(:, 5,41, 8) = (/ & + &7.6448e+01_r8,5.7454e+01_r8,3.8706e+01_r8,2.0765e+01_r8,1.8828e-01_r8/) + kbo(:, 1,42, 8) = (/ & + &4.2143e+01_r8,3.1846e+01_r8,2.2204e+01_r8,1.2680e+01_r8,8.2928e-02_r8/) + kbo(:, 2,42, 8) = (/ & + &4.7973e+01_r8,3.6167e+01_r8,2.4953e+01_r8,1.4117e+01_r8,1.0072e-01_r8/) + kbo(:, 3,42, 8) = (/ & + &5.5183e+01_r8,4.1542e+01_r8,2.8395e+01_r8,1.5835e+01_r8,1.2195e-01_r8/) + kbo(:, 4,42, 8) = (/ & + &6.3709e+01_r8,4.7914e+01_r8,3.2510e+01_r8,1.7836e+01_r8,1.4663e-01_r8/) + kbo(:, 5,42, 8) = (/ & + &7.3621e+01_r8,5.5334e+01_r8,3.7330e+01_r8,2.0134e+01_r8,1.7447e-01_r8/) + kbo(:, 1,43, 8) = (/ & + &3.9594e+01_r8,2.9962e+01_r8,2.1003e+01_r8,1.2048e+01_r8,7.1693e-02_r8/) + kbo(:, 2,43, 8) = (/ & + &4.5330e+01_r8,3.4203e+01_r8,2.3706e+01_r8,1.3485e+01_r8,8.8502e-02_r8/) + kbo(:, 3,43, 8) = (/ & + &5.2493e+01_r8,3.9537e+01_r8,2.7118e+01_r8,1.5213e+01_r8,1.0887e-01_r8/) + kbo(:, 4,43, 8) = (/ & + &6.1012e+01_r8,4.5896e+01_r8,3.1221e+01_r8,1.7230e+01_r8,1.3283e-01_r8/) + kbo(:, 5,43, 8) = (/ & + &7.1011e+01_r8,5.3379e+01_r8,3.6070e+01_r8,1.9559e+01_r8,1.6011e-01_r8/) + kbo(:, 1,44, 8) = (/ & + &3.7616e+01_r8,2.8507e+01_r8,2.0078e+01_r8,1.1553e+01_r8,6.1401e-02_r8/) + kbo(:, 2,44, 8) = (/ & + &4.3274e+01_r8,3.2681e+01_r8,2.2747e+01_r8,1.2992e+01_r8,7.7099e-02_r8/) + kbo(:, 3,44, 8) = (/ & + &5.0385e+01_r8,3.7971e+01_r8,2.6133e+01_r8,1.4732e+01_r8,9.6479e-02_r8/) + kbo(:, 4,44, 8) = (/ & + &5.8976e+01_r8,4.4379e+01_r8,3.0259e+01_r8,1.6785e+01_r8,1.1952e-01_r8/) + kbo(:, 5,44, 8) = (/ & + &6.9172e+01_r8,5.2003e+01_r8,3.5195e+01_r8,1.9170e+01_r8,1.4606e-01_r8/) + kbo(:, 1,45, 8) = (/ & + &3.6417e+01_r8,2.7634e+01_r8,1.9534e+01_r8,1.1252e+01_r8,5.2391e-02_r8/) + kbo(:, 2,45, 8) = (/ & + &4.2083e+01_r8,3.1808e+01_r8,2.2209e+01_r8,1.2716e+01_r8,6.6909e-02_r8/) + kbo(:, 3,45, 8) = (/ & + &4.9318e+01_r8,3.7181e+01_r8,2.5653e+01_r8,1.4499e+01_r8,8.5223e-02_r8/) + kbo(:, 4,45, 8) = (/ & + &5.8109e+01_r8,4.3735e+01_r8,2.9873e+01_r8,1.6620e+01_r8,1.0731e-01_r8/) + kbo(:, 5,45, 8) = (/ & + &6.8675e+01_r8,5.1635e+01_r8,3.4984e+01_r8,1.9103e+01_r8,1.3302e-01_r8/) + kbo(:, 1,46, 8) = (/ & + &3.5397e+01_r8,2.6895e+01_r8,1.9070e+01_r8,1.0989e+01_r8,4.4228e-02_r8/) + kbo(:, 2,46, 8) = (/ & + &4.1150e+01_r8,3.1127e+01_r8,2.1795e+01_r8,1.2497e+01_r8,5.7487e-02_r8/) + kbo(:, 3,46, 8) = (/ & + &4.8494e+01_r8,3.6574e+01_r8,2.5287e+01_r8,1.4324e+01_r8,7.4577e-02_r8/) + kbo(:, 4,46, 8) = (/ & + &5.7598e+01_r8,4.3359e+01_r8,2.9657e+01_r8,1.6535e+01_r8,9.5575e-02_r8/) + kbo(:, 5,46, 8) = (/ & + &6.8559e+01_r8,5.1549e+01_r8,3.4961e+01_r8,1.9128e+01_r8,1.2028e-01_r8/) + kbo(:, 1,47, 8) = (/ & + &3.3892e+01_r8,2.5799e+01_r8,1.8369e+01_r8,1.0592e+01_r8,3.6658e-02_r8/) + kbo(:, 2,47, 8) = (/ & + &3.9558e+01_r8,2.9961e+01_r8,2.1065e+01_r8,1.2104e+01_r8,4.8512e-02_r8/) + kbo(:, 3,47, 8) = (/ & + &4.6821e+01_r8,3.5338e+01_r8,2.4514e+01_r8,1.3933e+01_r8,6.4199e-02_r8/) + kbo(:, 4,47, 8) = (/ & + &5.6038e+01_r8,4.2200e+01_r8,2.8934e+01_r8,1.6192e+01_r8,8.3849e-02_r8/) + kbo(:, 5,47, 8) = (/ & + &6.7239e+01_r8,5.0568e+01_r8,3.4350e+01_r8,1.8859e+01_r8,1.0731e-01_r8/) + kbo(:, 1,48, 8) = (/ & + &3.3363e+01_r8,2.5430e+01_r8,1.8144e+01_r8,1.0446e+01_r8,3.0177e-02_r8/) + kbo(:, 2,48, 8) = (/ & + &3.9055e+01_r8,2.9607e+01_r8,2.0861e+01_r8,1.1982e+01_r8,4.0640e-02_r8/) + kbo(:, 3,48, 8) = (/ & + &4.6430e+01_r8,3.5057e+01_r8,2.4367e+01_r8,1.3859e+01_r8,5.4873e-02_r8/) + kbo(:, 4,48, 8) = (/ & + &5.5939e+01_r8,4.2134e+01_r8,2.8926e+01_r8,1.6205e+01_r8,7.3130e-02_r8/) + kbo(:, 5,48, 8) = (/ & + &6.7675e+01_r8,5.0896e+01_r8,3.4598e+01_r8,1.9010e+01_r8,9.5352e-02_r8/) + kbo(:, 1,49, 8) = (/ & + &3.4087e+01_r8,2.5989e+01_r8,1.8530e+01_r8,1.0628e+01_r8,2.4642e-02_r8/) + kbo(:, 2,49, 8) = (/ & + &4.0143e+01_r8,3.0436e+01_r8,2.1433e+01_r8,1.2264e+01_r8,3.3771e-02_r8/) + kbo(:, 3,49, 8) = (/ & + &4.7859e+01_r8,3.6137e+01_r8,2.5106e+01_r8,1.4243e+01_r8,4.6570e-02_r8/) + kbo(:, 4,49, 8) = (/ & + &5.8042e+01_r8,4.3715e+01_r8,2.9997e+01_r8,1.6759e+01_r8,6.3406e-02_r8/) + kbo(:, 5,49, 8) = (/ & + &7.0774e+01_r8,5.3220e+01_r8,3.6156e+01_r8,1.9813e+01_r8,8.4317e-02_r8/) + kbo(:, 1,50, 8) = (/ & + &3.3271e+01_r8,2.5407e+01_r8,1.8155e+01_r8,1.0394e+01_r8,2.0105e-02_r8/) + kbo(:, 2,50, 8) = (/ & + &3.9337e+01_r8,2.9859e+01_r8,2.1080e+01_r8,1.2062e+01_r8,2.8045e-02_r8/) + kbo(:, 3,50, 8) = (/ & + &4.7124e+01_r8,3.5606e+01_r8,2.4793e+01_r8,1.4082e+01_r8,3.9522e-02_r8/) + kbo(:, 4,50, 8) = (/ & + &5.7525e+01_r8,4.3340e+01_r8,2.9788e+01_r8,1.6668e+01_r8,5.4974e-02_r8/) + kbo(:, 5,50, 8) = (/ & + &7.0694e+01_r8,5.3165e+01_r8,3.6155e+01_r8,1.9842e+01_r8,7.4569e-02_r8/) + kbo(:, 1,51, 8) = (/ & + &3.1799e+01_r8,2.4339e+01_r8,1.7448e+01_r8,9.9788e+00_r8,1.6322e-02_r8/) + kbo(:, 2,51, 8) = (/ & + &3.7729e+01_r8,2.8686e+01_r8,2.0331e+01_r8,1.1646e+01_r8,2.3187e-02_r8/) + kbo(:, 3,51, 8) = (/ & + &4.5428e+01_r8,3.4361e+01_r8,2.4014e+01_r8,1.3675e+01_r8,3.3395e-02_r8/) + kbo(:, 4,51, 8) = (/ & + &5.5764e+01_r8,4.2036e+01_r8,2.8971e+01_r8,1.6259e+01_r8,4.7474e-02_r8/) + kbo(:, 5,51, 8) = (/ & + &6.9086e+01_r8,5.1969e+01_r8,3.5405e+01_r8,1.9496e+01_r8,6.5720e-02_r8/) + kbo(:, 1,52, 8) = (/ & + &3.1125e+01_r8,2.3861e+01_r8,1.7130e+01_r8,9.7762e+00_r8,1.3165e-02_r8/) + kbo(:, 2,52, 8) = (/ & + &3.7206e+01_r8,2.8320e+01_r8,2.0110e+01_r8,1.1507e+01_r8,1.9020e-02_r8/) + kbo(:, 3,52, 8) = (/ & + &4.4966e+01_r8,3.4037e+01_r8,2.3832e+01_r8,1.3576e+01_r8,2.8007e-02_r8/) + kbo(:, 4,52, 8) = (/ & + &5.5475e+01_r8,4.1834e+01_r8,2.8875e+01_r8,1.6222e+01_r8,4.0752e-02_r8/) + kbo(:, 5,52, 8) = (/ & + &6.9286e+01_r8,5.2127e+01_r8,3.5547e+01_r8,1.9593e+01_r8,5.7616e-02_r8/) + kbo(:, 1,53, 8) = (/ & + &3.1628e+01_r8,2.4253e+01_r8,1.7391e+01_r8,9.8844e+00_r8,1.0543e-02_r8/) + kbo(:, 2,53, 8) = (/ & + &3.8058e+01_r8,2.8975e+01_r8,2.0560e+01_r8,1.1731e+01_r8,1.5472e-02_r8/) + kbo(:, 3,53, 8) = (/ & + &4.6305e+01_r8,3.5054e+01_r8,2.4529e+01_r8,1.3933e+01_r8,2.3276e-02_r8/) + kbo(:, 4,53, 8) = (/ & + &5.7328e+01_r8,4.3229e+01_r8,2.9824e+01_r8,1.6717e+01_r8,3.4695e-02_r8/) + kbo(:, 5,53, 8) = (/ & + &7.2228e+01_r8,5.4335e+01_r8,3.7034e+01_r8,2.0360e+01_r8,5.0210e-02_r8/) + kbo(:, 1,54, 8) = (/ & + &2.7866e+01_r8,2.1495e+01_r8,1.5519e+01_r8,8.8346e+00_r8,8.4580e-03_r8/) + kbo(:, 2,54, 8) = (/ & + &3.3763e+01_r8,2.5815e+01_r8,1.8473e+01_r8,1.0588e+01_r8,1.2602e-02_r8/) + kbo(:, 3,54, 8) = (/ & + &4.1361e+01_r8,3.1401e+01_r8,2.2155e+01_r8,1.2668e+01_r8,1.9366e-02_r8/) + kbo(:, 4,54, 8) = (/ & + &5.1507e+01_r8,3.8906e+01_r8,2.7027e+01_r8,1.5284e+01_r8,2.9589e-02_r8/) + kbo(:, 5,54, 8) = (/ & + &6.5378e+01_r8,4.9225e+01_r8,3.3718e+01_r8,1.8724e+01_r8,4.3797e-02_r8/) + kbo(:, 1,55, 8) = (/ & + &2.2404e+01_r8,1.7484e+01_r8,1.2754e+01_r8,7.2917e+00_r8,6.7620e-03_r8/) + kbo(:, 2,55, 8) = (/ & + &2.7309e+01_r8,2.1069e+01_r8,1.5293e+01_r8,8.8299e+00_r8,1.0220e-02_r8/) + kbo(:, 3,55, 8) = (/ & + &3.3683e+01_r8,2.5733e+01_r8,1.8431e+01_r8,1.0660e+01_r8,1.6054e-02_r8/) + kbo(:, 4,55, 8) = (/ & + &4.2194e+01_r8,3.1999e+01_r8,2.2529e+01_r8,1.2931e+01_r8,2.5150e-02_r8/) + kbo(:, 5,55, 8) = (/ & + &5.4011e+01_r8,4.0754e+01_r8,2.8208e+01_r8,1.5935e+01_r8,3.8077e-02_r8/) + kbo(:, 1,56, 8) = (/ & + &1.7963e+01_r8,1.4222e+01_r8,1.0460e+01_r8,5.9968e+00_r8,5.3696e-03_r8/) + kbo(:, 2,56, 8) = (/ & + &2.2011e+01_r8,1.7185e+01_r8,1.2632e+01_r8,7.3359e+00_r8,8.2238e-03_r8/) + kbo(:, 3,56, 8) = (/ & + &2.7341e+01_r8,2.1070e+01_r8,1.5329e+01_r8,8.9492e+00_r8,1.3200e-02_r8/) + kbo(:, 4,56, 8) = (/ & + &3.4490e+01_r8,2.6306e+01_r8,1.8809e+01_r8,1.0943e+01_r8,2.1214e-02_r8/) + kbo(:, 5,56, 8) = (/ & + &4.4535e+01_r8,3.3715e+01_r8,2.3630e+01_r8,1.3559e+01_r8,3.2915e-02_r8/) + kbo(:, 1,57, 8) = (/ & + &1.4368e+01_r8,1.1564e+01_r8,8.5550e+00_r8,4.9118e+00_r8,4.2402e-03_r8/) + kbo(:, 2,57, 8) = (/ & + &1.7718e+01_r8,1.4043e+01_r8,1.0433e+01_r8,6.0838e+00_r8,6.5672e-03_r8/) + kbo(:, 3,57, 8) = (/ & + &2.2119e+01_r8,1.7250e+01_r8,1.2736e+01_r8,7.4914e+00_r8,1.0750e-02_r8/) + kbo(:, 4,57, 8) = (/ & + &2.8111e+01_r8,2.1614e+01_r8,1.5710e+01_r8,9.2466e+00_r8,1.7729e-02_r8/) + kbo(:, 5,57, 8) = (/ & + &3.6581e+01_r8,2.7832e+01_r8,1.9800e+01_r8,1.1525e+01_r8,2.8247e-02_r8/) + kbo(:, 1,58, 8) = (/ & + &3.0334e+00_r8,3.0458e+00_r8,2.9118e+00_r8,2.3449e+00_r8,3.3480e-03_r8/) + kbo(:, 2,58, 8) = (/ & + &3.7595e+00_r8,3.7165e+00_r8,3.5857e+00_r8,2.9410e+00_r8,5.2345e-03_r8/) + kbo(:, 3,58, 8) = (/ & + &4.7309e+00_r8,4.5866e+00_r8,4.4204e+00_r8,3.6685e+00_r8,8.7466e-03_r8/) + kbo(:, 4,58, 8) = (/ & + &6.0543e+00_r8,5.7620e+00_r8,5.4869e+00_r8,4.5723e+00_r8,1.4810e-02_r8/) + kbo(:, 5,58, 8) = (/ & + &7.9336e+00_r8,7.4372e+00_r8,6.9325e+00_r8,5.7367e+00_r8,2.4215e-02_r8/) + kbo(:, 1,59, 8) = (/ & + &2.9765e+00_r8,2.9765e+00_r8,2.6845e+00_r8,1.9427e+00_r8,2.8320e-03_r8/) + kbo(:, 2,59, 8) = (/ & + &3.7193e+00_r8,3.6697e+00_r8,3.3576e+00_r8,2.4792e+00_r8,4.5261e-03_r8/) + kbo(:, 3,59, 8) = (/ & + &4.7245e+00_r8,4.5542e+00_r8,4.1916e+00_r8,3.1428e+00_r8,7.7669e-03_r8/) + kbo(:, 4,59, 8) = (/ & + &6.1120e+00_r8,5.7342e+00_r8,5.2520e+00_r8,3.9688e+00_r8,1.3461e-02_r8/) + kbo(:, 5,59, 8) = (/ & + &8.1086e+00_r8,7.4151e+00_r8,6.6769e+00_r8,5.0327e+00_r8,2.2363e-02_r8/) + kbo(:, 1,13, 9) = (/ & + &3.9255e+04_r8,2.9441e+04_r8,1.9628e+04_r8,9.8141e+03_r8,2.1650e+00_r8/) + kbo(:, 2,13, 9) = (/ & + &3.9490e+04_r8,2.9618e+04_r8,1.9745e+04_r8,9.8730e+03_r8,2.1321e+00_r8/) + kbo(:, 3,13, 9) = (/ & + &3.9631e+04_r8,2.9723e+04_r8,1.9816e+04_r8,9.9081e+03_r8,2.0803e+00_r8/) + kbo(:, 4,13, 9) = (/ & + &3.9707e+04_r8,2.9781e+04_r8,1.9854e+04_r8,9.9272e+03_r8,2.0587e+00_r8/) + kbo(:, 5,13, 9) = (/ & + &3.9690e+04_r8,2.9768e+04_r8,1.9845e+04_r8,9.9229e+03_r8,2.0351e+00_r8/) + kbo(:, 1,14, 9) = (/ & + &2.2391e+04_r8,1.6793e+04_r8,1.1196e+04_r8,5.5981e+03_r8,2.2958e+00_r8/) + kbo(:, 2,14, 9) = (/ & + &2.2483e+04_r8,1.6862e+04_r8,1.1241e+04_r8,5.6209e+03_r8,2.2646e+00_r8/) + kbo(:, 3,14, 9) = (/ & + &2.2517e+04_r8,1.6888e+04_r8,1.1259e+04_r8,5.6296e+03_r8,2.2164e+00_r8/) + kbo(:, 4,14, 9) = (/ & + &2.2511e+04_r8,1.6883e+04_r8,1.1256e+04_r8,5.6281e+03_r8,2.1692e+00_r8/) + kbo(:, 5,14, 9) = (/ & + &2.2470e+04_r8,1.6853e+04_r8,1.1235e+04_r8,5.6178e+03_r8,2.1488e+00_r8/) + kbo(:, 1,15, 9) = (/ & + &1.2806e+04_r8,9.6046e+03_r8,6.4033e+03_r8,3.2019e+03_r8,2.4251e+00_r8/) + kbo(:, 2,15, 9) = (/ & + &1.2828e+04_r8,9.6209e+03_r8,6.4142e+03_r8,3.2073e+03_r8,2.3960e+00_r8/) + kbo(:, 3,15, 9) = (/ & + &1.2826e+04_r8,9.6195e+03_r8,6.4132e+03_r8,3.2069e+03_r8,2.3588e+00_r8/) + kbo(:, 4,15, 9) = (/ & + &1.2818e+04_r8,9.6139e+03_r8,6.4095e+03_r8,3.2050e+03_r8,2.3106e+00_r8/) + kbo(:, 5,15, 9) = (/ & + &1.2808e+04_r8,9.6063e+03_r8,6.4044e+03_r8,3.2025e+03_r8,2.2722e+00_r8/) + kbo(:, 1,16, 9) = (/ & + &8.5967e+03_r8,6.4476e+03_r8,4.2986e+03_r8,2.1496e+03_r8,2.5476e+00_r8/) + kbo(:, 2,16, 9) = (/ & + &8.5987e+03_r8,6.4492e+03_r8,4.2996e+03_r8,2.1501e+03_r8,2.5204e+00_r8/) + kbo(:, 3,16, 9) = (/ & + &8.5999e+03_r8,6.4500e+03_r8,4.3002e+03_r8,2.1504e+03_r8,2.4878e+00_r8/) + kbo(:, 4,16, 9) = (/ & + &8.6043e+03_r8,6.4534e+03_r8,4.3024e+03_r8,2.1515e+03_r8,2.4397e+00_r8/) + kbo(:, 5,16, 9) = (/ & + &8.6176e+03_r8,6.4634e+03_r8,4.3091e+03_r8,2.1548e+03_r8,2.4008e+00_r8/) + kbo(:, 1,17, 9) = (/ & + &5.9284e+03_r8,4.4464e+03_r8,2.9645e+03_r8,1.4825e+03_r8,2.6544e+00_r8/) + kbo(:, 2,17, 9) = (/ & + &5.9327e+03_r8,4.4497e+03_r8,2.9666e+03_r8,1.4836e+03_r8,2.6300e+00_r8/) + kbo(:, 3,17, 9) = (/ & + &5.9411e+03_r8,4.4560e+03_r8,2.9708e+03_r8,1.4857e+03_r8,2.5993e+00_r8/) + kbo(:, 4,17, 9) = (/ & + &5.9634e+03_r8,4.4727e+03_r8,2.9820e+03_r8,1.4912e+03_r8,2.5553e+00_r8/) + kbo(:, 5,17, 9) = (/ & + &6.0032e+03_r8,4.5025e+03_r8,3.0018e+03_r8,1.5012e+03_r8,2.5167e+00_r8/) + kbo(:, 1,18, 9) = (/ & + &4.1696e+03_r8,3.1274e+03_r8,2.0851e+03_r8,1.0428e+03_r8,2.7386e+00_r8/) + kbo(:, 2,18, 9) = (/ & + &4.1796e+03_r8,3.1348e+03_r8,2.0901e+03_r8,1.0453e+03_r8,2.7184e+00_r8/) + kbo(:, 3,18, 9) = (/ & + &4.2028e+03_r8,3.1522e+03_r8,2.1017e+03_r8,1.0511e+03_r8,2.6888e+00_r8/) + kbo(:, 4,18, 9) = (/ & + &4.2429e+03_r8,3.1823e+03_r8,2.1217e+03_r8,1.0611e+03_r8,2.6491e+00_r8/) + kbo(:, 5,18, 9) = (/ & + &4.2973e+03_r8,3.2231e+03_r8,2.1489e+03_r8,1.0747e+03_r8,2.6124e+00_r8/) + kbo(:, 1,19, 9) = (/ & + &2.8753e+03_r8,2.1566e+03_r8,1.4379e+03_r8,7.1922e+02_r8,2.7969e+00_r8/) + kbo(:, 2,19, 9) = (/ & + &2.8953e+03_r8,2.1716e+03_r8,1.4479e+03_r8,7.2422e+02_r8,2.7817e+00_r8/) + kbo(:, 3,19, 9) = (/ & + &2.9302e+03_r8,2.1978e+03_r8,1.4654e+03_r8,7.3295e+02_r8,2.7548e+00_r8/) + kbo(:, 4,19, 9) = (/ & + &2.9782e+03_r8,2.2338e+03_r8,1.4894e+03_r8,7.4494e+02_r8,2.7189e+00_r8/) + kbo(:, 5,19, 9) = (/ & + &3.0360e+03_r8,2.2771e+03_r8,1.5183e+03_r8,7.5939e+02_r8,2.6829e+00_r8/) + kbo(:, 1,20, 9) = (/ & + &2.1517e+03_r8,1.6139e+03_r8,1.0761e+03_r8,5.3833e+02_r8,2.8251e+00_r8/) + kbo(:, 2,20, 9) = (/ & + &2.1814e+03_r8,1.6362e+03_r8,1.0910e+03_r8,5.4575e+02_r8,2.8122e+00_r8/) + kbo(:, 3,20, 9) = (/ & + &2.2241e+03_r8,1.6682e+03_r8,1.1123e+03_r8,5.5643e+02_r8,2.7893e+00_r8/) + kbo(:, 4,20, 9) = (/ & + &2.2758e+03_r8,1.7069e+03_r8,1.1381e+03_r8,5.6933e+02_r8,2.7572e+00_r8/) + kbo(:, 5,20, 9) = (/ & + &2.3338e+03_r8,1.7505e+03_r8,1.1672e+03_r8,5.8384e+02_r8,2.7245e+00_r8/) + kbo(:, 1,21, 9) = (/ & + &1.6700e+03_r8,1.2526e+03_r8,8.3526e+02_r8,4.1790e+02_r8,2.8188e+00_r8/) + kbo(:, 2,21, 9) = (/ & + &1.7058e+03_r8,1.2795e+03_r8,8.5318e+02_r8,4.2686e+02_r8,2.8087e+00_r8/) + kbo(:, 3,21, 9) = (/ & + &1.7510e+03_r8,1.3134e+03_r8,8.7578e+02_r8,4.3816e+02_r8,2.7899e+00_r8/) + kbo(:, 4,21, 9) = (/ & + &1.8029e+03_r8,1.3523e+03_r8,9.0173e+02_r8,4.5113e+02_r8,2.7632e+00_r8/) + kbo(:, 5,21, 9) = (/ & + &1.8601e+03_r8,1.3952e+03_r8,9.3032e+02_r8,4.6542e+02_r8,2.7328e+00_r8/) + kbo(:, 1,22, 9) = (/ & + &1.3403e+03_r8,1.0054e+03_r8,6.7043e+02_r8,3.3549e+02_r8,2.7778e+00_r8/) + kbo(:, 2,22, 9) = (/ & + &1.3792e+03_r8,1.0345e+03_r8,6.8985e+02_r8,3.4520e+02_r8,2.7715e+00_r8/) + kbo(:, 3,22, 9) = (/ & + &1.4248e+03_r8,1.0688e+03_r8,7.1269e+02_r8,3.5661e+02_r8,2.7559e+00_r8/) + kbo(:, 4,22, 9) = (/ & + &1.4749e+03_r8,1.1063e+03_r8,7.3770e+02_r8,3.6911e+02_r8,2.7316e+00_r8/) + kbo(:, 5,22, 9) = (/ & + &1.5223e+03_r8,1.1418e+03_r8,7.6138e+02_r8,3.8094e+02_r8,2.7088e+00_r8/) + kbo(:, 1,23, 9) = (/ & + &1.0891e+03_r8,8.1698e+02_r8,5.4484e+02_r8,2.7270e+02_r8,2.7041e+00_r8/) + kbo(:, 2,23, 9) = (/ & + &1.1283e+03_r8,8.4637e+02_r8,5.6443e+02_r8,2.8249e+02_r8,2.7027e+00_r8/) + kbo(:, 3,23, 9) = (/ & + &1.1704e+03_r8,8.7791e+02_r8,5.8545e+02_r8,2.9300e+02_r8,2.6907e+00_r8/) + kbo(:, 4,23, 9) = (/ & + &1.2113e+03_r8,9.0862e+02_r8,6.0592e+02_r8,3.0322e+02_r8,2.6730e+00_r8/) + kbo(:, 5,23, 9) = (/ & + &1.2507e+03_r8,9.3816e+02_r8,6.2560e+02_r8,3.1305e+02_r8,2.6594e+00_r8/) + kbo(:, 1,24, 9) = (/ & + &8.8581e+02_r8,6.6450e+02_r8,4.4318e+02_r8,2.2188e+02_r8,2.6023e+00_r8/) + kbo(:, 2,24, 9) = (/ & + &9.2040e+02_r8,6.9044e+02_r8,4.6047e+02_r8,2.3052e+02_r8,2.6060e+00_r8/) + kbo(:, 3,24, 9) = (/ & + &9.5496e+02_r8,7.1635e+02_r8,4.7775e+02_r8,2.3914e+02_r8,2.6005e+00_r8/) + kbo(:, 4,24, 9) = (/ & + &9.8776e+02_r8,7.4094e+02_r8,4.9413e+02_r8,2.4733e+02_r8,2.5922e+00_r8/) + kbo(:, 5,24, 9) = (/ & + &1.0196e+03_r8,7.6479e+02_r8,5.1001e+02_r8,2.5525e+02_r8,2.5914e+00_r8/) + kbo(:, 1,25, 9) = (/ & + &7.3035e+02_r8,5.4790e+02_r8,3.6545e+02_r8,1.8302e+02_r8,2.4806e+00_r8/) + kbo(:, 2,25, 9) = (/ & + &7.5932e+02_r8,5.6963e+02_r8,3.7993e+02_r8,1.9025e+02_r8,2.4895e+00_r8/) + kbo(:, 3,25, 9) = (/ & + &7.8665e+02_r8,5.9012e+02_r8,3.9359e+02_r8,1.9707e+02_r8,2.4921e+00_r8/) + kbo(:, 4,25, 9) = (/ & + &8.1328e+02_r8,6.1007e+02_r8,4.0688e+02_r8,2.0370e+02_r8,2.4969e+00_r8/) + kbo(:, 5,25, 9) = (/ & + &8.3956e+02_r8,6.2979e+02_r8,4.2001e+02_r8,2.1025e+02_r8,2.5085e+00_r8/) + kbo(:, 1,26, 9) = (/ & + &6.1100e+02_r8,4.5838e+02_r8,3.0577e+02_r8,1.5319e+02_r8,2.3442e+00_r8/) + kbo(:, 2,26, 9) = (/ & + &6.3406e+02_r8,4.7568e+02_r8,3.1730e+02_r8,1.5893e+02_r8,2.3618e+00_r8/) + kbo(:, 3,26, 9) = (/ & + &6.5658e+02_r8,4.9255e+02_r8,3.2854e+02_r8,1.6455e+02_r8,2.3770e+00_r8/) + kbo(:, 4,26, 9) = (/ & + &6.7915e+02_r8,5.0948e+02_r8,3.3981e+02_r8,1.7016e+02_r8,2.3964e+00_r8/) + kbo(:, 5,26, 9) = (/ & + &7.0247e+02_r8,5.2696e+02_r8,3.5146e+02_r8,1.7598e+02_r8,2.4222e+00_r8/) + kbo(:, 1,27, 9) = (/ & + &5.2844e+02_r8,3.9646e+02_r8,2.6449e+02_r8,1.3259e+02_r8,2.2032e+00_r8/) + kbo(:, 2,27, 9) = (/ & + &5.4789e+02_r8,4.1105e+02_r8,2.7421e+02_r8,1.3742e+02_r8,2.2331e+00_r8/) + kbo(:, 3,27, 9) = (/ & + &5.6778e+02_r8,4.2595e+02_r8,2.8414e+02_r8,1.4236e+02_r8,2.2623e+00_r8/) + kbo(:, 4,27, 9) = (/ & + &5.8850e+02_r8,4.4149e+02_r8,2.9449e+02_r8,1.4751e+02_r8,2.3009e+00_r8/) + kbo(:, 5,27, 9) = (/ & + &6.1090e+02_r8,4.5829e+02_r8,3.0567e+02_r8,1.5309e+02_r8,2.3382e+00_r8/) + kbo(:, 1,28, 9) = (/ & + &4.6826e+02_r8,3.5133e+02_r8,2.3440e+02_r8,1.1763e+02_r8,2.0680e+00_r8/) + kbo(:, 2,28, 9) = (/ & + &4.8590e+02_r8,3.6454e+02_r8,2.4321e+02_r8,1.2197e+02_r8,2.1100e+00_r8/) + kbo(:, 3,28, 9) = (/ & + &5.0445e+02_r8,3.7846e+02_r8,2.5247e+02_r8,1.2655e+02_r8,2.1567e+00_r8/) + kbo(:, 4,28, 9) = (/ & + &5.2474e+02_r8,3.9367e+02_r8,2.6260e+02_r8,1.3159e+02_r8,2.2098e+00_r8/) + kbo(:, 5,28, 9) = (/ & + &5.4720e+02_r8,4.1051e+02_r8,2.7382e+02_r8,1.3717e+02_r8,2.2620e+00_r8/) + kbo(:, 1,29, 9) = (/ & + &4.4072e+02_r8,3.3067e+02_r8,2.2063e+02_r8,1.1082e+02_r8,1.9419e+00_r8/) + kbo(:, 2,29, 9) = (/ & + &4.5821e+02_r8,3.4378e+02_r8,2.2936e+02_r8,1.1511e+02_r8,1.9998e+00_r8/) + kbo(:, 3,29, 9) = (/ & + &4.7729e+02_r8,3.5808e+02_r8,2.3889e+02_r8,1.1980e+02_r8,2.0671e+00_r8/) + kbo(:, 4,29, 9) = (/ & + &4.9882e+02_r8,3.7422e+02_r8,2.4964e+02_r8,1.2512e+02_r8,2.1341e+00_r8/) + kbo(:, 5,29, 9) = (/ & + &5.2331e+02_r8,3.9259e+02_r8,2.6188e+02_r8,1.3121e+02_r8,2.1979e+00_r8/) + kbo(:, 1,30, 9) = (/ & + &4.2556e+02_r8,3.1930e+02_r8,2.1305e+02_r8,1.0711e+02_r8,1.8309e+00_r8/) + kbo(:, 2,30, 9) = (/ & + &4.4407e+02_r8,3.3317e+02_r8,2.2229e+02_r8,1.1161e+02_r8,1.9101e+00_r8/) + kbo(:, 3,30, 9) = (/ & + &4.6505e+02_r8,3.4890e+02_r8,2.3276e+02_r8,1.1676e+02_r8,1.9914e+00_r8/) + kbo(:, 4,30, 9) = (/ & + &4.8908e+02_r8,3.6692e+02_r8,2.4477e+02_r8,1.2270e+02_r8,2.0709e+00_r8/) + kbo(:, 5,30, 9) = (/ & + &5.1660e+02_r8,3.8756e+02_r8,2.5853e+02_r8,1.2954e+02_r8,2.1480e+00_r8/) + kbo(:, 1,31, 9) = (/ & + &4.3357e+02_r8,3.2530e+02_r8,2.1704e+02_r8,1.0913e+02_r8,1.7458e+00_r8/) + kbo(:, 2,31, 9) = (/ & + &4.5478e+02_r8,3.4120e+02_r8,2.2764e+02_r8,1.1430e+02_r8,1.8393e+00_r8/) + kbo(:, 3,31, 9) = (/ & + &4.7940e+02_r8,3.5966e+02_r8,2.3993e+02_r8,1.2035e+02_r8,1.9333e+00_r8/) + kbo(:, 4,31, 9) = (/ & + &5.0804e+02_r8,3.8115e+02_r8,2.5425e+02_r8,1.2744e+02_r8,2.0234e+00_r8/) + kbo(:, 5,31, 9) = (/ & + &5.4033e+02_r8,4.0536e+02_r8,2.7039e+02_r8,1.3548e+02_r8,2.1150e+00_r8/) + kbo(:, 1,32, 9) = (/ & + &4.4897e+02_r8,3.3685e+02_r8,2.2474e+02_r8,1.1298e+02_r8,1.6787e+00_r8/) + kbo(:, 2,32, 9) = (/ & + &4.7419e+02_r8,3.5576e+02_r8,2.3734e+02_r8,1.1915e+02_r8,1.7859e+00_r8/) + kbo(:, 3,32, 9) = (/ & + &5.0379e+02_r8,3.7796e+02_r8,2.5213e+02_r8,1.2644e+02_r8,1.8899e+00_r8/) + kbo(:, 4,32, 9) = (/ & + &5.3795e+02_r8,4.0357e+02_r8,2.6921e+02_r8,1.3492e+02_r8,1.9968e+00_r8/) + kbo(:, 5,32, 9) = (/ & + &5.7556e+02_r8,4.3179e+02_r8,2.8802e+02_r8,1.4429e+02_r8,2.0977e+00_r8/) + kbo(:, 1,33, 9) = (/ & + &4.7613e+02_r8,3.5721e+02_r8,2.3831e+02_r8,1.1974e+02_r8,1.6313e+00_r8/) + kbo(:, 2,33, 9) = (/ & + &5.0727e+02_r8,3.8056e+02_r8,2.5387e+02_r8,1.2739e+02_r8,1.7486e+00_r8/) + kbo(:, 3,33, 9) = (/ & + &5.4363e+02_r8,4.0783e+02_r8,2.7205e+02_r8,1.3639e+02_r8,1.8695e+00_r8/) + kbo(:, 4,33, 9) = (/ & + &5.8421e+02_r8,4.3828e+02_r8,2.9234e+02_r8,1.4648e+02_r8,1.9835e+00_r8/) + kbo(:, 5,33, 9) = (/ & + &6.2742e+02_r8,4.7068e+02_r8,3.1394e+02_r8,1.5725e+02_r8,2.0938e+00_r8/) + kbo(:, 1,34, 9) = (/ & + &4.9479e+02_r8,3.7120e+02_r8,2.4764e+02_r8,1.2439e+02_r8,1.5951e+00_r8/) + kbo(:, 2,34, 9) = (/ & + &5.3209e+02_r8,3.9918e+02_r8,2.6628e+02_r8,1.3359e+02_r8,1.7258e+00_r8/) + kbo(:, 3,34, 9) = (/ & + &5.7463e+02_r8,4.3109e+02_r8,2.8755e+02_r8,1.4413e+02_r8,1.8546e+00_r8/) + kbo(:, 4,34, 9) = (/ & + &6.2052e+02_r8,4.6551e+02_r8,3.1050e+02_r8,1.5556e+02_r8,1.9770e+00_r8/) + kbo(:, 5,34, 9) = (/ & + &6.6892e+02_r8,5.0180e+02_r8,3.3469e+02_r8,1.6762e+02_r8,2.0917e+00_r8/) + kbo(:, 1,35, 9) = (/ & + &5.1474e+02_r8,3.8617e+02_r8,2.5762e+02_r8,1.2939e+02_r8,1.5620e+00_r8/) + kbo(:, 2,35, 9) = (/ & + &5.5847e+02_r8,4.1897e+02_r8,2.7948e+02_r8,1.4019e+02_r8,1.7022e+00_r8/) + kbo(:, 3,35, 9) = (/ & + &6.0709e+02_r8,4.5544e+02_r8,3.0379e+02_r8,1.5226e+02_r8,1.8365e+00_r8/) + kbo(:, 4,35, 9) = (/ & + &6.5852e+02_r8,4.9401e+02_r8,3.2950e+02_r8,1.6506e+02_r8,1.9663e+00_r8/) + kbo(:, 5,35, 9) = (/ & + &7.1282e+02_r8,5.3473e+02_r8,3.5664e+02_r8,1.7860e+02_r8,2.0876e+00_r8/) + kbo(:, 1,36, 9) = (/ & + &5.3040e+02_r8,3.9792e+02_r8,2.6545e+02_r8,1.3332e+02_r8,1.5229e+00_r8/) + kbo(:, 2,36, 9) = (/ & + &5.8002e+02_r8,4.3513e+02_r8,2.9026e+02_r8,1.4559e+02_r8,1.6698e+00_r8/) + kbo(:, 3,36, 9) = (/ & + &6.3422e+02_r8,4.7578e+02_r8,3.1736e+02_r8,1.5904e+02_r8,1.8112e+00_r8/) + kbo(:, 4,36, 9) = (/ & + &6.9154e+02_r8,5.1877e+02_r8,3.4601e+02_r8,1.7331e+02_r8,1.9470e+00_r8/) + kbo(:, 5,36, 9) = (/ & + &7.5259e+02_r8,5.6456e+02_r8,3.7653e+02_r8,1.8854e+02_r8,2.0786e+00_r8/) + kbo(:, 1,37, 9) = (/ & + &5.2761e+02_r8,3.9583e+02_r8,2.6405e+02_r8,1.3269e+02_r8,1.4669e+00_r8/) + kbo(:, 2,37, 9) = (/ & + &5.8107e+02_r8,4.3593e+02_r8,2.9079e+02_r8,1.4590e+02_r8,1.6200e+00_r8/) + kbo(:, 3,37, 9) = (/ & + &6.3936e+02_r8,4.7964e+02_r8,3.1993e+02_r8,1.6036e+02_r8,1.7687e+00_r8/) + kbo(:, 4,37, 9) = (/ & + &7.0149e+02_r8,5.2623e+02_r8,3.5098e+02_r8,1.7581e+02_r8,1.9104e+00_r8/) + kbo(:, 5,37, 9) = (/ & + &7.6801e+02_r8,5.7612e+02_r8,3.8424e+02_r8,1.9240e+02_r8,2.0492e+00_r8/) + kbo(:, 1,38, 9) = (/ & + &5.3320e+02_r8,4.0002e+02_r8,2.6686e+02_r8,1.3414e+02_r8,1.4150e+00_r8/) + kbo(:, 2,38, 9) = (/ & + &5.9148e+02_r8,4.4373e+02_r8,2.9599e+02_r8,1.4854e+02_r8,1.5738e+00_r8/) + kbo(:, 3,38, 9) = (/ & + &6.5505e+02_r8,4.9141e+02_r8,3.2778e+02_r8,1.6430e+02_r8,1.7289e+00_r8/) + kbo(:, 4,38, 9) = (/ & + &7.2345e+02_r8,5.4270e+02_r8,3.6197e+02_r8,1.8131e+02_r8,1.8759e+00_r8/) + kbo(:, 5,38, 9) = (/ & + &7.9740e+02_r8,5.9816e+02_r8,3.9894e+02_r8,1.9975e+02_r8,2.0221e+00_r8/) + kbo(:, 1,39, 9) = (/ & + &5.5268e+02_r8,4.1463e+02_r8,2.7660e+02_r8,1.3905e+02_r8,1.3683e+00_r8/) + kbo(:, 2,39, 9) = (/ & + &6.1737e+02_r8,4.6316e+02_r8,3.0895e+02_r8,1.5504e+02_r8,1.5320e+00_r8/) + kbo(:, 3,39, 9) = (/ & + &6.8821e+02_r8,5.1628e+02_r8,3.4436e+02_r8,1.7260e+02_r8,1.6920e+00_r8/) + kbo(:, 4,39, 9) = (/ & + &7.6555e+02_r8,5.7429e+02_r8,3.8302e+02_r8,1.9184e+02_r8,1.8468e+00_r8/) + kbo(:, 5,39, 9) = (/ & + &8.4965e+02_r8,6.3736e+02_r8,4.2508e+02_r8,2.1282e+02_r8,1.9969e+00_r8/) + kbo(:, 1,40, 9) = (/ & + &5.3311e+02_r8,3.9996e+02_r8,2.6682e+02_r8,1.3428e+02_r8,1.3069e+00_r8/) + kbo(:, 2,40, 9) = (/ & + &5.9979e+02_r8,4.4997e+02_r8,3.0016e+02_r8,1.5072e+02_r8,1.4753e+00_r8/) + kbo(:, 3,40, 9) = (/ & + &6.7343e+02_r8,5.0519e+02_r8,3.3697e+02_r8,1.6896e+02_r8,1.6406e+00_r8/) + kbo(:, 4,40, 9) = (/ & + &7.5472e+02_r8,5.6615e+02_r8,3.7760e+02_r8,1.8916e+02_r8,1.7999e+00_r8/) + kbo(:, 5,40, 9) = (/ & + &8.4379e+02_r8,6.3296e+02_r8,4.2214e+02_r8,2.1136e+02_r8,1.9558e+00_r8/) + kbo(:, 1,41, 9) = (/ & + &5.1260e+02_r8,3.8458e+02_r8,2.5658e+02_r8,1.2928e+02_r8,1.2459e+00_r8/) + kbo(:, 2,41, 9) = (/ & + &5.8131e+02_r8,4.3611e+02_r8,2.9093e+02_r8,1.4621e+02_r8,1.4179e+00_r8/) + kbo(:, 3,41, 9) = (/ & + &6.5741e+02_r8,4.9318e+02_r8,3.2896e+02_r8,1.6503e+02_r8,1.5871e+00_r8/) + kbo(:, 4,41, 9) = (/ & + &7.4227e+02_r8,5.5683e+02_r8,3.7139e+02_r8,1.8609e+02_r8,1.7498e+00_r8/) + kbo(:, 5,41, 9) = (/ & + &8.3623e+02_r8,6.2730e+02_r8,4.1837e+02_r8,2.0950e+02_r8,1.9122e+00_r8/) + kbo(:, 1,42, 9) = (/ & + &4.9831e+02_r8,3.7386e+02_r8,2.4944e+02_r8,1.2584e+02_r8,1.1865e+00_r8/) + kbo(:, 2,42, 9) = (/ & + &5.6980e+02_r8,4.2748e+02_r8,2.8517e+02_r8,1.4342e+02_r8,1.3622e+00_r8/) + kbo(:, 3,42, 9) = (/ & + &6.4955e+02_r8,4.8728e+02_r8,3.2503e+02_r8,1.6313e+02_r8,1.5361e+00_r8/) + kbo(:, 4,42, 9) = (/ & + &7.3900e+02_r8,5.5437e+02_r8,3.6975e+02_r8,1.8531e+02_r8,1.7026e+00_r8/) + kbo(:, 5,42, 9) = (/ & + &8.3900e+02_r8,6.2937e+02_r8,4.1975e+02_r8,2.1021e+02_r8,1.8688e+00_r8/) + kbo(:, 1,43, 9) = (/ & + &4.8522e+02_r8,3.6405e+02_r8,2.4292e+02_r8,1.2271e+02_r8,1.1188e+00_r8/) + kbo(:, 2,43, 9) = (/ & + &5.5936e+02_r8,4.1965e+02_r8,2.7996e+02_r8,1.4092e+02_r8,1.2979e+00_r8/) + kbo(:, 3,43, 9) = (/ & + &6.4330e+02_r8,4.8260e+02_r8,3.2191e+02_r8,1.6164e+02_r8,1.4736e+00_r8/) + kbo(:, 4,43, 9) = (/ & + &7.3773e+02_r8,5.5342e+02_r8,3.6912e+02_r8,1.8505e+02_r8,1.6463e+00_r8/) + kbo(:, 5,43, 9) = (/ & + &8.4419e+02_r8,6.3327e+02_r8,4.2235e+02_r8,2.1154e+02_r8,1.8168e+00_r8/) + kbo(:, 1,44, 9) = (/ & + &4.7662e+02_r8,3.5759e+02_r8,2.3863e+02_r8,1.2069e+02_r8,1.0480e+00_r8/) + kbo(:, 2,44, 9) = (/ & + &5.5453e+02_r8,4.1603e+02_r8,2.7755e+02_r8,1.3982e+02_r8,1.2297e+00_r8/) + kbo(:, 3,44, 9) = (/ & + &6.4348e+02_r8,4.8273e+02_r8,3.2200e+02_r8,1.6176e+02_r8,1.4085e+00_r8/) + kbo(:, 4,44, 9) = (/ & + &7.4447e+02_r8,5.5848e+02_r8,3.7249e+02_r8,1.8678e+02_r8,1.5847e+00_r8/) + kbo(:, 5,44, 9) = (/ & + &8.5855e+02_r8,6.4403e+02_r8,4.2953e+02_r8,2.1515e+02_r8,1.7587e+00_r8/) + kbo(:, 1,45, 9) = (/ & + &4.7694e+02_r8,3.5784e+02_r8,2.3881e+02_r8,1.2088e+02_r8,9.8025e-01_r8/) + kbo(:, 2,45, 9) = (/ & + &5.6049e+02_r8,4.2050e+02_r8,2.8054e+02_r8,1.4139e+02_r8,1.1623e+00_r8/) + kbo(:, 3,45, 9) = (/ & + &6.5632e+02_r8,4.9237e+02_r8,3.2842e+02_r8,1.6503e+02_r8,1.3439e+00_r8/) + kbo(:, 4,45, 9) = (/ & + &7.6635e+02_r8,5.7488e+02_r8,3.8343e+02_r8,1.9228e+02_r8,1.5236e+00_r8/) + kbo(:, 5,45, 9) = (/ & + &8.9123e+02_r8,6.6854e+02_r8,4.4587e+02_r8,2.2334e+02_r8,1.7007e+00_r8/) + kbo(:, 1,46, 9) = (/ & + &4.7924e+02_r8,3.5957e+02_r8,2.3999e+02_r8,1.2157e+02_r8,9.0983e-01_r8/) + kbo(:, 2,46, 9) = (/ & + &5.6922e+02_r8,4.2705e+02_r8,2.8491e+02_r8,1.4366e+02_r8,1.0922e+00_r8/) + kbo(:, 3,46, 9) = (/ & + &6.7352e+02_r8,5.0527e+02_r8,3.3703e+02_r8,1.6939e+02_r8,1.2757e+00_r8/) + kbo(:, 4,46, 9) = (/ & + &7.9367e+02_r8,5.9538e+02_r8,3.9709e+02_r8,1.9915e+02_r8,1.4579e+00_r8/) + kbo(:, 5,46, 9) = (/ & + &9.3189e+02_r8,6.9904e+02_r8,4.6620e+02_r8,2.3352e+02_r8,1.6382e+00_r8/) + kbo(:, 1,47, 9) = (/ & + &4.7215e+02_r8,3.5425e+02_r8,2.3648e+02_r8,1.1995e+02_r8,8.3319e-01_r8/) + kbo(:, 2,47, 9) = (/ & + &5.6710e+02_r8,4.2546e+02_r8,2.8387e+02_r8,1.4325e+02_r8,1.0142e+00_r8/) + kbo(:, 3,47, 9) = (/ & + &6.7881e+02_r8,5.0924e+02_r8,3.3968e+02_r8,1.7081e+02_r8,1.1988e+00_r8/) + kbo(:, 4,47, 9) = (/ & + &8.0796e+02_r8,6.0609e+02_r8,4.0424e+02_r8,2.0278e+02_r8,1.3835e+00_r8/) + kbo(:, 5,47, 9) = (/ & + &9.5794e+02_r8,7.1858e+02_r8,4.7923e+02_r8,2.4007e+02_r8,1.5668e+00_r8/) + kbo(:, 1,48, 9) = (/ & + &4.7667e+02_r8,3.5764e+02_r8,2.3876e+02_r8,1.2119e+02_r8,7.5823e-01_r8/) + kbo(:, 2,48, 9) = (/ & + &5.7865e+02_r8,4.3413e+02_r8,2.8965e+02_r8,1.4623e+02_r8,9.3799e-01_r8/) + kbo(:, 3,48, 9) = (/ & + &7.0145e+02_r8,5.2622e+02_r8,3.5101e+02_r8,1.7653e+02_r8,1.1229e+00_r8/) + kbo(:, 4,48, 9) = (/ & + &8.4427e+02_r8,6.3333e+02_r8,4.2240e+02_r8,2.1190e+02_r8,1.3089e+00_r8/) + kbo(:, 5,48, 9) = (/ & + &1.0109e+03_r8,7.5832e+02_r8,5.0573e+02_r8,2.5334e+02_r8,1.4951e+00_r8/) + kbo(:, 1,49, 9) = (/ & + &4.9957e+02_r8,3.7481e+02_r8,2.5022e+02_r8,1.2697e+02_r8,6.8631e-01_r8/) + kbo(:, 2,49, 9) = (/ & + &6.1224e+02_r8,4.5931e+02_r8,3.0645e+02_r8,1.5466e+02_r8,8.6353e-01_r8/) + kbo(:, 3,49, 9) = (/ & + &7.5197e+02_r8,5.6411e+02_r8,3.7627e+02_r8,1.8917e+02_r8,1.0480e+00_r8/) + kbo(:, 4,49, 9) = (/ & + &9.1643e+02_r8,6.8745e+02_r8,4.5848e+02_r8,2.2994e+02_r8,1.2341e+00_r8/) + kbo(:, 5,49, 9) = (/ & + &1.1094e+03_r8,8.3219e+02_r8,5.5497e+02_r8,2.7795e+02_r8,1.4234e+00_r8/) + kbo(:, 1,50, 9) = (/ & + &4.9927e+02_r8,3.7459e+02_r8,2.5011e+02_r8,1.2702e+02_r8,6.2082e-01_r8/) + kbo(:, 2,50, 9) = (/ & + &6.1745e+02_r8,4.6322e+02_r8,3.0907e+02_r8,1.5606e+02_r8,7.9337e-01_r8/) + kbo(:, 3,50, 9) = (/ & + &7.6850e+02_r8,5.7651e+02_r8,3.8454e+02_r8,1.9338e+02_r8,9.7702e-01_r8/) + kbo(:, 4,50, 9) = (/ & + &9.4909e+02_r8,7.1195e+02_r8,4.7482e+02_r8,2.3816e+02_r8,1.1637e+00_r8/) + kbo(:, 5,50, 9) = (/ & + &1.1628e+03_r8,8.7227e+02_r8,5.8169e+02_r8,2.9133e+02_r8,1.3527e+00_r8/) + kbo(:, 1,51, 9) = (/ & + &4.8758e+02_r8,3.6583e+02_r8,2.4432e+02_r8,1.2426e+02_r8,5.5888e-01_r8/) + kbo(:, 2,51, 9) = (/ & + &6.0851e+02_r8,4.5652e+02_r8,3.0463e+02_r8,1.5396e+02_r8,7.2702e-01_r8/) + kbo(:, 3,51, 9) = (/ & + &7.6706e+02_r8,5.7543e+02_r8,3.8383e+02_r8,1.9312e+02_r8,9.0804e-01_r8/) + kbo(:, 4,51, 9) = (/ & + &9.6042e+02_r8,7.2045e+02_r8,4.8049e+02_r8,2.4107e+02_r8,1.0946e+00_r8/) + kbo(:, 5,51, 9) = (/ & + &1.1920e+03_r8,8.9415e+02_r8,5.9629e+02_r8,2.9867e+02_r8,1.2844e+00_r8/) + kbo(:, 1,52, 9) = (/ & + &4.8860e+02_r8,3.6660e+02_r8,2.4488e+02_r8,1.2464e+02_r8,4.9962e-01_r8/) + kbo(:, 2,52, 9) = (/ & + &6.1451e+02_r8,4.6102e+02_r8,3.0765e+02_r8,1.5555e+02_r8,6.6320e-01_r8/) + kbo(:, 3,52, 9) = (/ & + &7.8418e+02_r8,5.8827e+02_r8,3.9240e+02_r8,1.9747e+02_r8,8.4128e-01_r8/) + kbo(:, 4,52, 9) = (/ & + &9.9602e+02_r8,7.4715e+02_r8,4.9829e+02_r8,2.5001e+02_r8,1.0268e+00_r8/) + kbo(:, 5,52, 9) = (/ & + &1.2534e+03_r8,9.4018e+02_r8,6.2698e+02_r8,3.1403e+02_r8,1.2165e+00_r8/) + kbo(:, 1,53, 9) = (/ & + &5.0881e+02_r8,3.8175e+02_r8,2.5500e+02_r8,1.2975e+02_r8,4.4418e-01_r8/) + kbo(:, 2,53, 9) = (/ & + &6.4426e+02_r8,4.8334e+02_r8,3.2253e+02_r8,1.6302e+02_r8,6.0138e-01_r8/) + kbo(:, 3,53, 9) = (/ & + &8.3158e+02_r8,6.2382e+02_r8,4.1611e+02_r8,2.0933e+02_r8,7.7570e-01_r8/) + kbo(:, 4,53, 9) = (/ & + &1.0715e+03_r8,8.0375e+02_r8,5.3603e+02_r8,2.6888e+02_r8,9.5940e-01_r8/) + kbo(:, 5,53, 9) = (/ & + &1.3680e+03_r8,1.0262e+03_r8,6.8430e+02_r8,3.4269e+02_r8,1.1487e+00_r8/) + kbo(:, 1,54, 9) = (/ & + &4.6019e+02_r8,3.4529e+02_r8,2.3082e+02_r8,1.1788e+02_r8,3.9422e-01_r8/) + kbo(:, 2,54, 9) = (/ & + &5.8633e+02_r8,4.3988e+02_r8,2.9364e+02_r8,1.4879e+02_r8,5.4422e-01_r8/) + kbo(:, 3,54, 9) = (/ & + &7.6477e+02_r8,5.7372e+02_r8,3.8273e+02_r8,1.9285e+02_r8,7.1419e-01_r8/) + kbo(:, 4,54, 9) = (/ & + &9.9975e+02_r8,7.4995e+02_r8,5.0017e+02_r8,2.5112e+02_r8,8.9603e-01_r8/) + kbo(:, 5,54, 9) = (/ & + &1.2952e+03_r8,9.7153e+02_r8,6.4788e+02_r8,3.2458e+02_r8,1.0830e+00_r8/) + kbo(:, 1,55, 9) = (/ & + &3.8020e+02_r8,2.8531e+02_r8,1.9107e+02_r8,9.8307e+01_r8,3.4739e-01_r8/) + kbo(:, 2,55, 9) = (/ & + &4.8735e+02_r8,3.6565e+02_r8,2.4430e+02_r8,1.2445e+02_r8,4.9078e-01_r8/) + kbo(:, 3,55, 9) = (/ & + &6.4163e+02_r8,4.8136e+02_r8,3.2124e+02_r8,1.6243e+02_r8,6.5484e-01_r8/) + kbo(:, 4,55, 9) = (/ & + &8.5082e+02_r8,6.3825e+02_r8,4.2573e+02_r8,2.1419e+02_r8,8.3371e-01_r8/) + kbo(:, 5,55, 9) = (/ & + &1.1188e+03_r8,8.3927e+02_r8,5.5970e+02_r8,2.8072e+02_r8,1.0198e+00_r8/) + kbo(:, 1,56, 9) = (/ & + &3.1368e+02_r8,2.3545e+02_r8,1.5809e+02_r8,8.2086e+01_r8,3.0410e-01_r8/) + kbo(:, 2,56, 9) = (/ & + &4.0416e+02_r8,3.0326e+02_r8,2.0292e+02_r8,1.0407e+02_r8,4.3985e-01_r8/) + kbo(:, 3,56, 9) = (/ & + &5.3658e+02_r8,4.0257e+02_r8,2.6883e+02_r8,1.3655e+02_r8,5.9766e-01_r8/) + kbo(:, 4,56, 9) = (/ & + &7.2129e+02_r8,5.4110e+02_r8,3.6102e+02_r8,1.8214e+02_r8,7.7256e-01_r8/) + kbo(:, 5,56, 9) = (/ & + &9.6339e+02_r8,7.2268e+02_r8,4.8200e+02_r8,2.4214e+02_r8,9.5689e-01_r8/) + kbo(:, 1,57, 9) = (/ & + &2.5819e+02_r8,1.9390e+02_r8,1.3066e+02_r8,6.8602e+01_r8,2.6463e-01_r8/) + kbo(:, 2,57, 9) = (/ & + &3.3457e+02_r8,2.5110e+02_r8,1.6838e+02_r8,8.7076e+01_r8,3.9133e-01_r8/) + kbo(:, 3,57, 9) = (/ & + &4.4726e+02_r8,3.3558e+02_r8,2.2435e+02_r8,1.1462e+02_r8,5.4231e-01_r8/) + kbo(:, 4,57, 9) = (/ & + &6.0897e+02_r8,4.5687e+02_r8,3.0496e+02_r8,1.5443e+02_r8,7.1198e-01_r8/) + kbo(:, 5,57, 9) = (/ & + &8.2628e+02_r8,6.1985e+02_r8,4.1347e+02_r8,2.0818e+02_r8,8.9451e-01_r8/) + kbo(:, 1,58, 9) = (/ & + &5.6144e+01_r8,5.1598e+01_r8,4.4952e+01_r8,3.3575e+01_r8,2.2945e-01_r8/) + kbo(:, 2,58, 9) = (/ & + &7.3248e+01_r8,6.7230e+01_r8,5.8185e+01_r8,4.2642e+01_r8,3.4680e-01_r8/) + kbo(:, 3,58, 9) = (/ & + &9.8566e+01_r8,9.0421e+01_r8,7.7903e+01_r8,5.6215e+01_r8,4.9127e-01_r8/) + kbo(:, 4,58, 9) = (/ & + &1.3577e+02_r8,1.2452e+02_r8,1.0700e+02_r8,7.6316e+01_r8,6.5580e-01_r8/) + kbo(:, 5,58, 9) = (/ & + &1.8716e+02_r8,1.7164e+02_r8,1.4731e+02_r8,1.0424e+02_r8,8.3481e-01_r8/) + kbo(:, 1,59, 9) = (/ & + &5.7246e+01_r8,5.0299e+01_r8,4.1347e+01_r8,2.8542e+01_r8,2.1390e-01_r8/) + kbo(:, 2,59, 9) = (/ & + &7.5569e+01_r8,6.6181e+01_r8,5.3818e+01_r8,3.6138e+01_r8,3.2687e-01_r8/) + kbo(:, 3,59, 9) = (/ & + &1.0297e+02_r8,9.0031e+01_r8,7.2620e+01_r8,4.7606e+01_r8,4.6582e-01_r8/) + kbo(:, 4,59, 9) = (/ & + &1.4369e+02_r8,1.2555e+02_r8,1.0072e+02_r8,6.4807e+01_r8,6.2712e-01_r8/) + kbo(:, 5,59, 9) = (/ & + &2.0105e+02_r8,1.7562e+02_r8,1.4046e+02_r8,8.9199e+01_r8,8.0292e-01_r8/) + kbo(:, 1,13,10) = (/ & + &1.3594e+05_r8,1.0195e+05_r8,6.7969e+04_r8,3.3985e+04_r8,3.3627e+00_r8/) + kbo(:, 2,13,10) = (/ & + &1.3605e+05_r8,1.0204e+05_r8,6.8026e+04_r8,3.4013e+04_r8,3.2528e+00_r8/) + kbo(:, 3,13,10) = (/ & + &1.3597e+05_r8,1.0198e+05_r8,6.7984e+04_r8,3.3992e+04_r8,3.1814e+00_r8/) + kbo(:, 4,13,10) = (/ & + &1.3504e+05_r8,1.0128e+05_r8,6.7520e+04_r8,3.3760e+04_r8,3.0515e+00_r8/) + kbo(:, 5,13,10) = (/ & + &1.3382e+05_r8,1.0037e+05_r8,6.6910e+04_r8,3.3456e+04_r8,3.0303e+00_r8/) + kbo(:, 1,14,10) = (/ & + &8.3672e+04_r8,6.2754e+04_r8,4.1836e+04_r8,2.0918e+04_r8,3.6220e+00_r8/) + kbo(:, 2,14,10) = (/ & + &8.3355e+04_r8,6.2516e+04_r8,4.1677e+04_r8,2.0839e+04_r8,3.5454e+00_r8/) + kbo(:, 3,14,10) = (/ & + &8.2924e+04_r8,6.2193e+04_r8,4.1462e+04_r8,2.0731e+04_r8,3.4328e+00_r8/) + kbo(:, 4,14,10) = (/ & + &8.2189e+04_r8,6.1641e+04_r8,4.1094e+04_r8,2.0547e+04_r8,3.3922e+00_r8/) + kbo(:, 5,14,10) = (/ & + &8.1205e+04_r8,6.0904e+04_r8,4.0602e+04_r8,2.0301e+04_r8,3.2425e+00_r8/) + kbo(:, 1,15,10) = (/ & + &5.1150e+04_r8,3.8363e+04_r8,2.5576e+04_r8,1.2788e+04_r8,3.9145e+00_r8/) + kbo(:, 2,15,10) = (/ & + &5.0875e+04_r8,3.8157e+04_r8,2.5438e+04_r8,1.2719e+04_r8,3.8152e+00_r8/) + kbo(:, 3,15,10) = (/ & + &5.0407e+04_r8,3.7806e+04_r8,2.5204e+04_r8,1.2602e+04_r8,3.7733e+00_r8/) + kbo(:, 4,15,10) = (/ & + &4.9693e+04_r8,3.7270e+04_r8,2.4847e+04_r8,1.2424e+04_r8,3.6717e+00_r8/) + kbo(:, 5,15,10) = (/ & + &4.8987e+04_r8,3.6740e+04_r8,2.4494e+04_r8,1.2247e+04_r8,3.5647e+00_r8/) + kbo(:, 1,16,10) = (/ & + &3.6535e+04_r8,2.7401e+04_r8,1.8268e+04_r8,9.1341e+03_r8,4.2542e+00_r8/) + kbo(:, 2,16,10) = (/ & + &3.6151e+04_r8,2.7114e+04_r8,1.8076e+04_r8,9.0383e+03_r8,4.1666e+00_r8/) + kbo(:, 3,16,10) = (/ & + &3.5666e+04_r8,2.6750e+04_r8,1.7833e+04_r8,8.9169e+03_r8,4.1063e+00_r8/) + kbo(:, 4,16,10) = (/ & + &3.5133e+04_r8,2.6350e+04_r8,1.7567e+04_r8,8.7838e+03_r8,4.0309e+00_r8/) + kbo(:, 5,16,10) = (/ & + &3.4526e+04_r8,2.5894e+04_r8,1.7263e+04_r8,8.6318e+03_r8,3.8978e+00_r8/) + kbo(:, 1,17,10) = (/ & + &2.6414e+04_r8,1.9811e+04_r8,1.3207e+04_r8,6.6039e+03_r8,4.6454e+00_r8/) + kbo(:, 2,17,10) = (/ & + &2.6068e+04_r8,1.9551e+04_r8,1.3034e+04_r8,6.5174e+03_r8,4.5633e+00_r8/) + kbo(:, 3,17,10) = (/ & + &2.5689e+04_r8,1.9267e+04_r8,1.2845e+04_r8,6.4225e+03_r8,4.4826e+00_r8/) + kbo(:, 4,17,10) = (/ & + &2.5209e+04_r8,1.8907e+04_r8,1.2605e+04_r8,6.3027e+03_r8,4.3889e+00_r8/) + kbo(:, 5,17,10) = (/ & + &2.4661e+04_r8,1.8496e+04_r8,1.2331e+04_r8,6.1658e+03_r8,4.2589e+00_r8/) + kbo(:, 1,18,10) = (/ & + &1.9208e+04_r8,1.4406e+04_r8,9.6044e+03_r8,4.8025e+03_r8,5.0342e+00_r8/) + kbo(:, 2,18,10) = (/ & + &1.8927e+04_r8,1.4195e+04_r8,9.4636e+03_r8,4.7320e+03_r8,4.9453e+00_r8/) + kbo(:, 3,18,10) = (/ & + &1.8575e+04_r8,1.3931e+04_r8,9.2875e+03_r8,4.6440e+03_r8,4.8565e+00_r8/) + kbo(:, 4,18,10) = (/ & + &1.8151e+04_r8,1.3614e+04_r8,9.0760e+03_r8,4.5383e+03_r8,4.7616e+00_r8/) + kbo(:, 5,18,10) = (/ & + &1.7715e+04_r8,1.3287e+04_r8,8.8579e+03_r8,4.4292e+03_r8,4.6381e+00_r8/) + kbo(:, 1,19,10) = (/ & + &1.3561e+04_r8,1.0171e+04_r8,6.7808e+03_r8,3.3906e+03_r8,5.4045e+00_r8/) + kbo(:, 2,19,10) = (/ & + &1.3305e+04_r8,9.9790e+03_r8,6.6528e+03_r8,3.3267e+03_r8,5.3114e+00_r8/) + kbo(:, 3,19,10) = (/ & + &1.3001e+04_r8,9.7507e+03_r8,6.5006e+03_r8,3.2506e+03_r8,5.2250e+00_r8/) + kbo(:, 4,19,10) = (/ & + &1.2687e+04_r8,9.5155e+03_r8,6.3438e+03_r8,3.1722e+03_r8,5.1407e+00_r8/) + kbo(:, 5,19,10) = (/ & + &1.2394e+04_r8,9.2960e+03_r8,6.1975e+03_r8,3.0991e+03_r8,5.0251e+00_r8/) + kbo(:, 1,20,10) = (/ & + &1.0195e+04_r8,7.6466e+03_r8,5.0979e+03_r8,2.5492e+03_r8,5.7652e+00_r8/) + kbo(:, 2,20,10) = (/ & + &9.9631e+03_r8,7.4725e+03_r8,4.9818e+03_r8,2.4912e+03_r8,5.6804e+00_r8/) + kbo(:, 3,20,10) = (/ & + &9.7293e+03_r8,7.2971e+03_r8,4.8649e+03_r8,2.4328e+03_r8,5.6092e+00_r8/) + kbo(:, 4,20,10) = (/ & + &9.5227e+03_r8,7.1421e+03_r8,4.7616e+03_r8,2.3811e+03_r8,5.5285e+00_r8/) + kbo(:, 5,20,10) = (/ & + &9.3625e+03_r8,7.0220e+03_r8,4.6816e+03_r8,2.3411e+03_r8,5.3995e+00_r8/) + kbo(:, 1,21,10) = (/ & + &7.7885e+03_r8,5.8415e+03_r8,3.8945e+03_r8,1.9475e+03_r8,6.1280e+00_r8/) + kbo(:, 2,21,10) = (/ & + &7.6092e+03_r8,5.7071e+03_r8,3.8049e+03_r8,1.9027e+03_r8,6.0467e+00_r8/) + kbo(:, 3,21,10) = (/ & + &7.4658e+03_r8,5.5995e+03_r8,3.7332e+03_r8,1.8669e+03_r8,5.9782e+00_r8/) + kbo(:, 4,21,10) = (/ & + &7.3647e+03_r8,5.5237e+03_r8,3.6826e+03_r8,1.8416e+03_r8,5.8911e+00_r8/) + kbo(:, 5,21,10) = (/ & + &7.2928e+03_r8,5.4698e+03_r8,3.6467e+03_r8,1.8237e+03_r8,5.7660e+00_r8/) + kbo(:, 1,22,10) = (/ & + &6.0472e+03_r8,4.5355e+03_r8,3.0239e+03_r8,1.5122e+03_r8,6.4389e+00_r8/) + kbo(:, 2,22,10) = (/ & + &5.9457e+03_r8,4.4594e+03_r8,2.9731e+03_r8,1.4868e+03_r8,6.3534e+00_r8/) + kbo(:, 3,22,10) = (/ & + &5.8843e+03_r8,4.4133e+03_r8,2.9424e+03_r8,1.4715e+03_r8,6.3043e+00_r8/) + kbo(:, 4,22,10) = (/ & + &5.8543e+03_r8,4.3909e+03_r8,2.9274e+03_r8,1.4640e+03_r8,6.2309e+00_r8/) + kbo(:, 5,22,10) = (/ & + &5.8906e+03_r8,4.4181e+03_r8,2.9456e+03_r8,1.4732e+03_r8,6.0993e+00_r8/) + kbo(:, 1,23,10) = (/ & + &4.7512e+03_r8,3.5635e+03_r8,2.3758e+03_r8,1.1882e+03_r8,6.6888e+00_r8/) + kbo(:, 2,23,10) = (/ & + &4.7151e+03_r8,3.5365e+03_r8,2.3578e+03_r8,1.1792e+03_r8,6.6289e+00_r8/) + kbo(:, 3,23,10) = (/ & + &4.7153e+03_r8,3.5366e+03_r8,2.3579e+03_r8,1.1792e+03_r8,6.5888e+00_r8/) + kbo(:, 4,23,10) = (/ & + &4.7757e+03_r8,3.5820e+03_r8,2.3882e+03_r8,1.1944e+03_r8,6.5103e+00_r8/) + kbo(:, 5,23,10) = (/ & + &4.8784e+03_r8,3.6590e+03_r8,2.4396e+03_r8,1.2201e+03_r8,6.3750e+00_r8/) + kbo(:, 1,24,10) = (/ & + &3.7664e+03_r8,2.8249e+03_r8,1.8835e+03_r8,9.4199e+02_r8,6.8939e+00_r8/) + kbo(:, 2,24,10) = (/ & + &3.7833e+03_r8,2.8376e+03_r8,1.8919e+03_r8,9.4626e+02_r8,6.8560e+00_r8/) + kbo(:, 3,24,10) = (/ & + &3.8524e+03_r8,2.8895e+03_r8,1.9265e+03_r8,9.6361e+02_r8,6.8233e+00_r8/) + kbo(:, 4,24,10) = (/ & + &3.9503e+03_r8,2.9629e+03_r8,1.9755e+03_r8,9.8811e+02_r8,6.7364e+00_r8/) + kbo(:, 5,24,10) = (/ & + &4.0500e+03_r8,3.0377e+03_r8,2.0254e+03_r8,1.0130e+03_r8,6.5861e+00_r8/) + kbo(:, 1,25,10) = (/ & + &3.0705e+03_r8,2.3030e+03_r8,1.5356e+03_r8,7.6808e+02_r8,7.0352e+00_r8/) + kbo(:, 2,25,10) = (/ & + &3.1368e+03_r8,2.3527e+03_r8,1.5687e+03_r8,7.8472e+02_r8,7.0310e+00_r8/) + kbo(:, 3,25,10) = (/ & + &3.2299e+03_r8,2.4226e+03_r8,1.6153e+03_r8,8.0803e+02_r8,7.0074e+00_r8/) + kbo(:, 4,25,10) = (/ & + &3.3291e+03_r8,2.4970e+03_r8,1.6649e+03_r8,8.3282e+02_r8,6.9138e+00_r8/) + kbo(:, 5,25,10) = (/ & + &3.4334e+03_r8,2.5753e+03_r8,1.7171e+03_r8,8.5889e+02_r8,6.7836e+00_r8/) + kbo(:, 1,26,10) = (/ & + &2.5973e+03_r8,1.9481e+03_r8,1.2990e+03_r8,6.4986e+02_r8,7.1301e+00_r8/) + kbo(:, 2,26,10) = (/ & + &2.6809e+03_r8,2.0109e+03_r8,1.3408e+03_r8,6.7078e+02_r8,7.1546e+00_r8/) + kbo(:, 3,26,10) = (/ & + &2.7748e+03_r8,2.0813e+03_r8,1.3878e+03_r8,6.9426e+02_r8,7.1359e+00_r8/) + kbo(:, 4,26,10) = (/ & + &2.8656e+03_r8,2.1494e+03_r8,1.4332e+03_r8,7.1694e+02_r8,7.0388e+00_r8/) + kbo(:, 5,26,10) = (/ & + &2.9554e+03_r8,2.2167e+03_r8,1.4780e+03_r8,7.3936e+02_r8,6.9309e+00_r8/) + kbo(:, 1,27,10) = (/ & + &2.3040e+03_r8,1.7282e+03_r8,1.1524e+03_r8,5.7657e+02_r8,7.1805e+00_r8/) + kbo(:, 2,27,10) = (/ & + &2.3938e+03_r8,1.7956e+03_r8,1.1973e+03_r8,5.9902e+02_r8,7.2265e+00_r8/) + kbo(:, 3,27,10) = (/ & + &2.4776e+03_r8,1.8584e+03_r8,1.2392e+03_r8,6.1996e+02_r8,7.2160e+00_r8/) + kbo(:, 4,27,10) = (/ & + &2.5592e+03_r8,1.9196e+03_r8,1.2799e+03_r8,6.4031e+02_r8,7.1019e+00_r8/) + kbo(:, 5,27,10) = (/ & + &2.6344e+03_r8,1.9760e+03_r8,1.3176e+03_r8,6.5914e+02_r8,7.0533e+00_r8/) + kbo(:, 1,28,10) = (/ & + &2.1016e+03_r8,1.5764e+03_r8,1.0512e+03_r8,5.2597e+02_r8,7.1943e+00_r8/) + kbo(:, 2,28,10) = (/ & + &2.1832e+03_r8,1.6376e+03_r8,1.0920e+03_r8,5.4637e+02_r8,7.2562e+00_r8/) + kbo(:, 3,28,10) = (/ & + &2.2626e+03_r8,1.6971e+03_r8,1.1316e+03_r8,5.6618e+02_r8,7.2356e+00_r8/) + kbo(:, 4,28,10) = (/ & + &2.3367e+03_r8,1.7527e+03_r8,1.1687e+03_r8,5.8470e+02_r8,7.1672e+00_r8/) + kbo(:, 5,28,10) = (/ & + &2.4052e+03_r8,1.8041e+03_r8,1.2030e+03_r8,6.0186e+02_r8,7.1806e+00_r8/) + kbo(:, 1,29,10) = (/ & + &2.0213e+03_r8,1.5162e+03_r8,1.0110e+03_r8,5.0592e+02_r8,7.1826e+00_r8/) + kbo(:, 2,29,10) = (/ & + &2.1025e+03_r8,1.5771e+03_r8,1.0516e+03_r8,5.2618e+02_r8,7.2449e+00_r8/) + kbo(:, 3,29,10) = (/ & + &2.1817e+03_r8,1.6365e+03_r8,1.0912e+03_r8,5.4596e+02_r8,7.2200e+00_r8/) + kbo(:, 4,29,10) = (/ & + &2.2556e+03_r8,1.6919e+03_r8,1.1282e+03_r8,5.6447e+02_r8,7.2591e+00_r8/) + kbo(:, 5,29,10) = (/ & + &2.3246e+03_r8,1.7436e+03_r8,1.1626e+03_r8,5.8167e+02_r8,7.2912e+00_r8/) + kbo(:, 1,30,10) = (/ & + &1.9891e+03_r8,1.4920e+03_r8,9.9489e+02_r8,4.9783e+02_r8,7.1696e+00_r8/) + kbo(:, 2,30,10) = (/ & + &2.0704e+03_r8,1.5530e+03_r8,1.0355e+03_r8,5.1812e+02_r8,7.1996e+00_r8/) + kbo(:, 3,30,10) = (/ & + &2.1486e+03_r8,1.6117e+03_r8,1.0747e+03_r8,5.3773e+02_r8,7.2564e+00_r8/) + kbo(:, 4,30,10) = (/ & + &2.2243e+03_r8,1.6684e+03_r8,1.1125e+03_r8,5.5660e+02_r8,7.3491e+00_r8/) + kbo(:, 5,30,10) = (/ & + &2.2969e+03_r8,1.7228e+03_r8,1.1488e+03_r8,5.7471e+02_r8,7.3950e+00_r8/) + kbo(:, 1,31,10) = (/ & + &2.0600e+03_r8,1.5452e+03_r8,1.0303e+03_r8,5.1552e+02_r8,7.0891e+00_r8/) + kbo(:, 2,31,10) = (/ & + &2.1442e+03_r8,1.6083e+03_r8,1.0725e+03_r8,5.3661e+02_r8,7.1940e+00_r8/) + kbo(:, 3,31,10) = (/ & + &2.2267e+03_r8,1.6702e+03_r8,1.1137e+03_r8,5.5720e+02_r8,7.3519e+00_r8/) + kbo(:, 4,31,10) = (/ & + &2.3069e+03_r8,1.7303e+03_r8,1.1538e+03_r8,5.7721e+02_r8,7.4783e+00_r8/) + kbo(:, 5,31,10) = (/ & + &2.3951e+03_r8,1.7965e+03_r8,1.1978e+03_r8,5.9922e+02_r8,7.4978e+00_r8/) + kbo(:, 1,32,10) = (/ & + &2.1607e+03_r8,1.6207e+03_r8,1.0807e+03_r8,5.4073e+02_r8,7.0921e+00_r8/) + kbo(:, 2,32,10) = (/ & + &2.2499e+03_r8,1.6876e+03_r8,1.1253e+03_r8,5.6302e+02_r8,7.2853e+00_r8/) + kbo(:, 3,32,10) = (/ & + &2.3389e+03_r8,1.7543e+03_r8,1.1698e+03_r8,5.8523e+02_r8,7.4637e+00_r8/) + kbo(:, 4,32,10) = (/ & + &2.4345e+03_r8,1.8261e+03_r8,1.2176e+03_r8,6.0908e+02_r8,7.5300e+00_r8/) + kbo(:, 5,32,10) = (/ & + &2.5534e+03_r8,1.9152e+03_r8,1.2769e+03_r8,6.3872e+02_r8,7.5836e+00_r8/) + kbo(:, 1,33,10) = (/ & + &2.3147e+03_r8,1.7362e+03_r8,1.1577e+03_r8,5.7922e+02_r8,7.1422e+00_r8/) + kbo(:, 2,33,10) = (/ & + &2.4114e+03_r8,1.8087e+03_r8,1.2060e+03_r8,6.0335e+02_r8,7.3798e+00_r8/) + kbo(:, 3,33,10) = (/ & + &2.5142e+03_r8,1.8858e+03_r8,1.2574e+03_r8,6.2900e+02_r8,7.4990e+00_r8/) + kbo(:, 4,33,10) = (/ & + &2.6436e+03_r8,1.9829e+03_r8,1.3221e+03_r8,6.6129e+02_r8,7.6018e+00_r8/) + kbo(:, 5,33,10) = (/ & + &2.8166e+03_r8,2.1125e+03_r8,1.4085e+03_r8,7.0447e+02_r8,7.6468e+00_r8/) + kbo(:, 1,34,10) = (/ & + &2.4210e+03_r8,1.8159e+03_r8,1.2108e+03_r8,6.0577e+02_r8,7.2083e+00_r8/) + kbo(:, 2,34,10) = (/ & + &2.5284e+03_r8,1.8965e+03_r8,1.2645e+03_r8,6.3255e+02_r8,7.4180e+00_r8/) + kbo(:, 3,34,10) = (/ & + &2.6591e+03_r8,1.9944e+03_r8,1.3298e+03_r8,6.6516e+02_r8,7.5418e+00_r8/) + kbo(:, 4,34,10) = (/ & + &2.8359e+03_r8,2.1270e+03_r8,1.4182e+03_r8,7.0928e+02_r8,7.6931e+00_r8/) + kbo(:, 5,34,10) = (/ & + &3.0680e+03_r8,2.3011e+03_r8,1.5342e+03_r8,7.6730e+02_r8,7.7811e+00_r8/) + kbo(:, 1,35,10) = (/ & + &2.5363e+03_r8,1.9024e+03_r8,1.2685e+03_r8,6.3456e+02_r8,7.2309e+00_r8/) + kbo(:, 2,35,10) = (/ & + &2.6634e+03_r8,1.9977e+03_r8,1.3320e+03_r8,6.6631e+02_r8,7.4393e+00_r8/) + kbo(:, 3,35,10) = (/ & + &2.8345e+03_r8,2.1260e+03_r8,1.4175e+03_r8,7.0897e+02_r8,7.6569e+00_r8/) + kbo(:, 4,35,10) = (/ & + &3.0674e+03_r8,2.3007e+03_r8,1.5339e+03_r8,7.6716e+02_r8,7.7801e+00_r8/) + kbo(:, 5,35,10) = (/ & + &3.3573e+03_r8,2.5181e+03_r8,1.6788e+03_r8,8.3963e+02_r8,7.8561e+00_r8/) + kbo(:, 1,36,10) = (/ & + &2.6451e+03_r8,1.9840e+03_r8,1.3229e+03_r8,6.6175e+02_r8,7.2395e+00_r8/) + kbo(:, 2,36,10) = (/ & + &2.7976e+03_r8,2.0983e+03_r8,1.3991e+03_r8,6.9981e+02_r8,7.4813e+00_r8/) + kbo(:, 3,36,10) = (/ & + &3.0125e+03_r8,2.2595e+03_r8,1.5065e+03_r8,7.5346e+02_r8,7.7309e+00_r8/) + kbo(:, 4,36,10) = (/ & + &3.2979e+03_r8,2.4736e+03_r8,1.6492e+03_r8,8.2479e+02_r8,7.8735e+00_r8/) + kbo(:, 5,36,10) = (/ & + &3.6475e+03_r8,2.7357e+03_r8,1.8239e+03_r8,9.1218e+02_r8,7.9027e+00_r8/) + kbo(:, 1,37,10) = (/ & + &2.6819e+03_r8,2.0116e+03_r8,1.3413e+03_r8,6.7096e+02_r8,7.2017e+00_r8/) + kbo(:, 2,37,10) = (/ & + &2.8583e+03_r8,2.1439e+03_r8,1.4294e+03_r8,7.1495e+02_r8,7.5003e+00_r8/) + kbo(:, 3,37,10) = (/ & + &3.1042e+03_r8,2.3283e+03_r8,1.5523e+03_r8,7.7640e+02_r8,7.7646e+00_r8/) + kbo(:, 4,37,10) = (/ & + &3.4272e+03_r8,2.5705e+03_r8,1.7138e+03_r8,8.5714e+02_r8,7.9233e+00_r8/) + kbo(:, 5,37,10) = (/ & + &3.8225e+03_r8,2.8670e+03_r8,1.9115e+03_r8,9.5596e+02_r8,7.9456e+00_r8/) + kbo(:, 1,38,10) = (/ & + &2.7669e+03_r8,2.0753e+03_r8,1.3837e+03_r8,6.9217e+02_r8,7.1724e+00_r8/) + kbo(:, 2,38,10) = (/ & + &2.9772e+03_r8,2.2330e+03_r8,1.4888e+03_r8,7.4467e+02_r8,7.5382e+00_r8/) + kbo(:, 3,38,10) = (/ & + &3.2630e+03_r8,2.4473e+03_r8,1.6317e+03_r8,8.1609e+02_r8,7.7857e+00_r8/) + kbo(:, 4,38,10) = (/ & + &3.6292e+03_r8,2.7220e+03_r8,1.8149e+03_r8,9.0769e+02_r8,7.9649e+00_r8/) + kbo(:, 5,38,10) = (/ & + &4.0743e+03_r8,3.0559e+03_r8,2.0374e+03_r8,1.0190e+03_r8,7.9771e+00_r8/) + kbo(:, 1,39,10) = (/ & + &2.9268e+03_r8,2.1953e+03_r8,1.4637e+03_r8,7.3213e+02_r8,7.1691e+00_r8/) + kbo(:, 2,39,10) = (/ & + &3.1832e+03_r8,2.3875e+03_r8,1.5919e+03_r8,7.9619e+02_r8,7.5536e+00_r8/) + kbo(:, 3,39,10) = (/ & + &3.5251e+03_r8,2.6440e+03_r8,1.7628e+03_r8,8.8168e+02_r8,7.8089e+00_r8/) + kbo(:, 4,39,10) = (/ & + &3.9504e+03_r8,2.9629e+03_r8,1.9755e+03_r8,9.8804e+02_r8,7.9786e+00_r8/) + kbo(:, 5,39,10) = (/ & + &4.4598e+03_r8,3.3450e+03_r8,2.2302e+03_r8,1.1154e+03_r8,8.0073e+00_r8/) + kbo(:, 1,40,10) = (/ & + &2.8874e+03_r8,2.1657e+03_r8,1.4439e+03_r8,7.2221e+02_r8,7.0746e+00_r8/) + kbo(:, 2,40,10) = (/ & + &3.1724e+03_r8,2.3794e+03_r8,1.5864e+03_r8,7.9346e+02_r8,7.4831e+00_r8/) + kbo(:, 3,40,10) = (/ & + &3.5465e+03_r8,2.6600e+03_r8,1.7735e+03_r8,8.8703e+02_r8,7.7692e+00_r8/) + kbo(:, 4,40,10) = (/ & + &4.0044e+03_r8,3.0035e+03_r8,2.0025e+03_r8,1.0016e+03_r8,7.9632e+00_r8/) + kbo(:, 5,40,10) = (/ & + &4.5454e+03_r8,3.4092e+03_r8,2.2730e+03_r8,1.1368e+03_r8,8.0081e+00_r8/) + kbo(:, 1,41,10) = (/ & + &2.8406e+03_r8,2.1306e+03_r8,1.4205e+03_r8,7.1050e+02_r8,6.9600e+00_r8/) + kbo(:, 2,41,10) = (/ & + &3.1484e+03_r8,2.3614e+03_r8,1.5744e+03_r8,7.8747e+02_r8,7.3954e+00_r8/) + kbo(:, 3,41,10) = (/ & + &3.5576e+03_r8,2.6684e+03_r8,1.7791e+03_r8,8.8987e+02_r8,7.7179e+00_r8/) + kbo(:, 4,41,10) = (/ & + &4.0527e+03_r8,3.0397e+03_r8,2.0267e+03_r8,1.0137e+03_r8,7.9444e+00_r8/) + kbo(:, 5,41,10) = (/ & + &4.6270e+03_r8,3.4704e+03_r8,2.3138e+03_r8,1.1572e+03_r8,8.0108e+00_r8/) + kbo(:, 1,42,10) = (/ & + &2.8258e+03_r8,2.1194e+03_r8,1.4131e+03_r8,7.0678e+02_r8,6.8517e+00_r8/) + kbo(:, 2,42,10) = (/ & + &3.1581e+03_r8,2.3687e+03_r8,1.5793e+03_r8,7.8990e+02_r8,7.3049e+00_r8/) + kbo(:, 3,42,10) = (/ & + &3.6059e+03_r8,2.7046e+03_r8,1.8032e+03_r8,9.0193e+02_r8,7.6524e+00_r8/) + kbo(:, 4,42,10) = (/ & + &4.1499e+03_r8,3.1126e+03_r8,2.0753e+03_r8,1.0380e+03_r8,7.9111e+00_r8/) + kbo(:, 5,42,10) = (/ & + &4.7763e+03_r8,3.5824e+03_r8,2.3885e+03_r8,1.1945e+03_r8,8.0026e+00_r8/) + kbo(:, 1,43,10) = (/ & + &2.8194e+03_r8,2.1147e+03_r8,1.4100e+03_r8,7.0522e+02_r8,6.7032e+00_r8/) + kbo(:, 2,43,10) = (/ & + &3.1747e+03_r8,2.3812e+03_r8,1.5876e+03_r8,7.9408e+02_r8,7.1735e+00_r8/) + kbo(:, 3,43,10) = (/ & + &3.6549e+03_r8,2.7413e+03_r8,1.8278e+03_r8,9.1420e+02_r8,7.5844e+00_r8/) + kbo(:, 4,43,10) = (/ & + &4.2522e+03_r8,3.1893e+03_r8,2.1264e+03_r8,1.0635e+03_r8,7.8420e+00_r8/) + kbo(:, 5,43,10) = (/ & + &4.9421e+03_r8,3.7067e+03_r8,2.4714e+03_r8,1.2360e+03_r8,7.9777e+00_r8/) + kbo(:, 1,44,10) = (/ & + &2.8469e+03_r8,2.1353e+03_r8,1.4237e+03_r8,7.1206e+02_r8,6.5380e+00_r8/) + kbo(:, 2,44,10) = (/ & + &3.2203e+03_r8,2.4153e+03_r8,1.6104e+03_r8,8.0548e+02_r8,7.0393e+00_r8/) + kbo(:, 3,44,10) = (/ & + &3.7360e+03_r8,2.8021e+03_r8,1.8683e+03_r8,9.3448e+02_r8,7.4778e+00_r8/) + kbo(:, 4,44,10) = (/ & + &4.3910e+03_r8,3.2934e+03_r8,2.1958e+03_r8,1.0982e+03_r8,7.7716e+00_r8/) + kbo(:, 5,44,10) = (/ & + &5.1620e+03_r8,3.8716e+03_r8,2.5813e+03_r8,1.2909e+03_r8,7.9568e+00_r8/) + kbo(:, 1,45,10) = (/ & + &2.9370e+03_r8,2.2029e+03_r8,1.4687e+03_r8,7.3461e+02_r8,6.3596e+00_r8/) + kbo(:, 2,45,10) = (/ & + &3.3323e+03_r8,2.4994e+03_r8,1.6664e+03_r8,8.3351e+02_r8,6.8956e+00_r8/) + kbo(:, 3,45,10) = (/ & + &3.8921e+03_r8,2.9193e+03_r8,1.9464e+03_r8,9.7354e+02_r8,7.3748e+00_r8/) + kbo(:, 4,45,10) = (/ & + &4.6196e+03_r8,3.4648e+03_r8,2.3101e+03_r8,1.1554e+03_r8,7.7094e+00_r8/) + kbo(:, 5,45,10) = (/ & + &5.4975e+03_r8,4.1233e+03_r8,2.7490e+03_r8,1.3748e+03_r8,7.9394e+00_r8/) + kbo(:, 1,46,10) = (/ & + &3.0543e+03_r8,2.2908e+03_r8,1.5274e+03_r8,7.6393e+02_r8,6.1665e+00_r8/) + kbo(:, 2,46,10) = (/ & + &3.4757e+03_r8,2.6069e+03_r8,1.7382e+03_r8,8.6940e+02_r8,6.7524e+00_r8/) + kbo(:, 3,46,10) = (/ & + &4.0758e+03_r8,3.0570e+03_r8,2.0382e+03_r8,1.0195e+03_r8,7.2688e+00_r8/) + kbo(:, 4,46,10) = (/ & + &4.8832e+03_r8,3.6626e+03_r8,2.4419e+03_r8,1.2213e+03_r8,7.6299e+00_r8/) + kbo(:, 5,46,10) = (/ & + &5.8799e+03_r8,4.4101e+03_r8,2.9402e+03_r8,1.4704e+03_r8,7.9039e+00_r8/) + kbo(:, 1,47,10) = (/ & + &3.1321e+03_r8,2.3492e+03_r8,1.5663e+03_r8,7.8341e+02_r8,5.9258e+00_r8/) + kbo(:, 2,47,10) = (/ & + &3.5703e+03_r8,2.6779e+03_r8,1.7855e+03_r8,8.9306e+02_r8,6.5564e+00_r8/) + kbo(:, 3,47,10) = (/ & + &4.1981e+03_r8,3.1488e+03_r8,2.0994e+03_r8,1.0501e+03_r8,7.1267e+00_r8/) + kbo(:, 4,47,10) = (/ & + &5.0652e+03_r8,3.7991e+03_r8,2.5329e+03_r8,1.2668e+03_r8,7.5455e+00_r8/) + kbo(:, 5,47,10) = (/ & + &6.1689e+03_r8,4.6268e+03_r8,3.0847e+03_r8,1.5426e+03_r8,7.8470e+00_r8/) + kbo(:, 1,48,10) = (/ & + &3.3047e+03_r8,2.4787e+03_r8,1.6526e+03_r8,8.2657e+02_r8,5.6694e+00_r8/) + kbo(:, 2,48,10) = (/ & + &3.7747e+03_r8,2.8312e+03_r8,1.8877e+03_r8,9.4418e+02_r8,6.3589e+00_r8/) + kbo(:, 3,48,10) = (/ & + &4.4483e+03_r8,3.3364e+03_r8,2.2245e+03_r8,1.1126e+03_r8,6.9569e+00_r8/) + kbo(:, 4,48,10) = (/ & + &5.3940e+03_r8,4.0457e+03_r8,2.6973e+03_r8,1.3490e+03_r8,7.4395e+00_r8/) + kbo(:, 5,48,10) = (/ & + &6.6398e+03_r8,4.9800e+03_r8,3.3201e+03_r8,1.6603e+03_r8,7.7751e+00_r8/) + kbo(:, 1,49,10) = (/ & + &3.6256e+03_r8,2.7194e+03_r8,1.8131e+03_r8,9.0682e+02_r8,5.4147e+00_r8/) + kbo(:, 2,49,10) = (/ & + &4.1643e+03_r8,3.1234e+03_r8,2.0825e+03_r8,1.0416e+03_r8,6.1453e+00_r8/) + kbo(:, 3,49,10) = (/ & + &4.9094e+03_r8,3.6822e+03_r8,2.4550e+03_r8,1.2279e+03_r8,6.7872e+00_r8/) + kbo(:, 4,49,10) = (/ & + &5.9847e+03_r8,4.4886e+03_r8,2.9926e+03_r8,1.4966e+03_r8,7.3168e+00_r8/) + kbo(:, 5,49,10) = (/ & + &7.4258e+03_r8,5.5695e+03_r8,3.7131e+03_r8,1.8568e+03_r8,7.6869e+00_r8/) + kbo(:, 1,50,10) = (/ & + &3.7913e+03_r8,2.8436e+03_r8,1.8959e+03_r8,9.4825e+02_r8,5.1338e+00_r8/) + kbo(:, 2,50,10) = (/ & + &4.3920e+03_r8,3.2942e+03_r8,2.1963e+03_r8,1.0985e+03_r8,5.9203e+00_r8/) + kbo(:, 3,50,10) = (/ & + &5.1851e+03_r8,3.8890e+03_r8,2.5929e+03_r8,1.2968e+03_r8,6.5802e+00_r8/) + kbo(:, 4,50,10) = (/ & + &6.3489e+03_r8,4.7618e+03_r8,3.1748e+03_r8,1.5877e+03_r8,7.1705e+00_r8/) + kbo(:, 5,50,10) = (/ & + &7.9377e+03_r8,5.9534e+03_r8,3.9691e+03_r8,1.9848e+03_r8,7.5922e+00_r8/) + kbo(:, 1,51,10) = (/ & + &3.8669e+03_r8,2.9003e+03_r8,1.9338e+03_r8,9.6719e+02_r8,4.8302e+00_r8/) + kbo(:, 2,51,10) = (/ & + &4.5318e+03_r8,3.3991e+03_r8,2.2663e+03_r8,1.1335e+03_r8,5.6653e+00_r8/) + kbo(:, 3,51,10) = (/ & + &5.3773e+03_r8,4.0331e+03_r8,2.6890e+03_r8,1.3448e+03_r8,6.3736e+00_r8/) + kbo(:, 4,51,10) = (/ & + &6.6015e+03_r8,4.9513e+03_r8,3.3010e+03_r8,1.6508e+03_r8,7.0028e+00_r8/) + kbo(:, 5,51,10) = (/ & + &8.3208e+03_r8,6.2407e+03_r8,4.1606e+03_r8,2.0805e+03_r8,7.4729e+00_r8/) + kbo(:, 1,52,10) = (/ & + &4.0341e+03_r8,3.0258e+03_r8,2.0174e+03_r8,1.0090e+03_r8,4.5505e+00_r8/) + kbo(:, 2,52,10) = (/ & + &4.7982e+03_r8,3.5989e+03_r8,2.3995e+03_r8,1.2001e+03_r8,5.4004e+00_r8/) + kbo(:, 3,52,10) = (/ & + &5.7356e+03_r8,4.3019e+03_r8,2.8682e+03_r8,1.4344e+03_r8,6.1556e+00_r8/) + kbo(:, 4,52,10) = (/ & + &7.0672e+03_r8,5.3005e+03_r8,3.5339e+03_r8,1.7672e+03_r8,6.8208e+00_r8/) + kbo(:, 5,52,10) = (/ & + &8.9657e+03_r8,6.7244e+03_r8,4.4831e+03_r8,2.2418e+03_r8,7.3432e+00_r8/) + kbo(:, 1,53,10) = (/ & + &4.3581e+03_r8,3.2687e+03_r8,2.1794e+03_r8,1.0900e+03_r8,4.2696e+00_r8/) + kbo(:, 2,53,10) = (/ & + &5.2688e+03_r8,3.9518e+03_r8,2.6348e+03_r8,1.3178e+03_r8,5.1422e+00_r8/) + kbo(:, 3,53,10) = (/ & + &6.3653e+03_r8,4.7742e+03_r8,3.1830e+03_r8,1.5919e+03_r8,5.9288e+00_r8/) + kbo(:, 4,53,10) = (/ & + &7.8870e+03_r8,5.9154e+03_r8,3.9438e+03_r8,1.9722e+03_r8,6.6345e+00_r8/) + kbo(:, 5,53,10) = (/ & + &1.0051e+04_r8,7.5383e+03_r8,5.0257e+03_r8,2.5131e+03_r8,7.2054e+00_r8/) + kbo(:, 1,54,10) = (/ & + &4.0664e+03_r8,3.0500e+03_r8,2.0336e+03_r8,1.0171e+03_r8,3.9912e+00_r8/) + kbo(:, 2,54,10) = (/ & + &5.0070e+03_r8,3.7555e+03_r8,2.5039e+03_r8,1.2523e+03_r8,4.8673e+00_r8/) + kbo(:, 3,54,10) = (/ & + &6.1329e+03_r8,4.5998e+03_r8,3.0668e+03_r8,1.5337e+03_r8,5.6727e+00_r8/) + kbo(:, 4,54,10) = (/ & + &7.6570e+03_r8,5.7429e+03_r8,3.8288e+03_r8,1.9147e+03_r8,6.4112e+00_r8/) + kbo(:, 5,54,10) = (/ & + &9.8073e+03_r8,7.3556e+03_r8,4.9039e+03_r8,2.4522e+03_r8,7.0431e+00_r8/) + kbo(:, 1,55,10) = (/ & + &3.4487e+03_r8,2.5868e+03_r8,1.7247e+03_r8,8.6275e+02_r8,3.7023e+00_r8/) + kbo(:, 2,55,10) = (/ & + &4.3277e+03_r8,3.2460e+03_r8,2.1642e+03_r8,1.0825e+03_r8,4.5324e+00_r8/) + kbo(:, 3,55,10) = (/ & + &5.3892e+03_r8,4.0421e+03_r8,2.6950e+03_r8,1.3479e+03_r8,5.4035e+00_r8/) + kbo(:, 4,55,10) = (/ & + &6.7963e+03_r8,5.0973e+03_r8,3.3984e+03_r8,1.6995e+03_r8,6.1546e+00_r8/) + kbo(:, 5,55,10) = (/ & + &8.7627e+03_r8,6.5722e+03_r8,4.3816e+03_r8,2.1910e+03_r8,6.8267e+00_r8/) + kbo(:, 1,56,10) = (/ & + &2.9072e+03_r8,2.1806e+03_r8,1.4540e+03_r8,7.2734e+02_r8,3.4115e+00_r8/) + kbo(:, 2,56,10) = (/ & + &3.7198e+03_r8,2.7901e+03_r8,1.8603e+03_r8,9.3056e+02_r8,4.2571e+00_r8/) + kbo(:, 3,56,10) = (/ & + &4.7203e+03_r8,3.5403e+03_r8,2.3605e+03_r8,1.1806e+03_r8,5.1151e+00_r8/) + kbo(:, 4,56,10) = (/ & + &6.0279e+03_r8,4.5211e+03_r8,3.0142e+03_r8,1.5074e+03_r8,5.8984e+00_r8/) + kbo(:, 5,56,10) = (/ & + &7.8366e+03_r8,5.8775e+03_r8,3.9185e+03_r8,1.9594e+03_r8,6.6003e+00_r8/) + kbo(:, 1,57,10) = (/ & + &2.4367e+03_r8,1.8277e+03_r8,1.2187e+03_r8,6.0970e+02_r8,3.1098e+00_r8/) + kbo(:, 2,57,10) = (/ & + &3.1766e+03_r8,2.3826e+03_r8,1.5887e+03_r8,7.9475e+02_r8,3.9704e+00_r8/) + kbo(:, 3,57,10) = (/ & + &4.1136e+03_r8,3.0854e+03_r8,2.0572e+03_r8,1.0290e+03_r8,4.8038e+00_r8/) + kbo(:, 4,57,10) = (/ & + &5.3345e+03_r8,4.0010e+03_r8,2.6675e+03_r8,1.3340e+03_r8,5.6428e+00_r8/) + kbo(:, 5,57,10) = (/ & + &7.0017e+03_r8,5.2513e+03_r8,3.5010e+03_r8,1.7507e+03_r8,6.3564e+00_r8/) + kbo(:, 1,58,10) = (/ & + &5.3797e+02_r8,4.9330e+02_r8,4.2306e+02_r8,2.9653e+02_r8,2.8402e+00_r8/) + kbo(:, 2,58,10) = (/ & + &7.1438e+02_r8,6.5505e+02_r8,5.6177e+02_r8,3.9372e+02_r8,3.6954e+00_r8/) + kbo(:, 3,58,10) = (/ & + &9.4508e+02_r8,8.6656e+02_r8,7.4311e+02_r8,5.2072e+02_r8,4.5299e+00_r8/) + kbo(:, 4,58,10) = (/ & + &1.2473e+03_r8,1.1436e+03_r8,9.8061e+02_r8,6.8699e+02_r8,5.3595e+00_r8/) + kbo(:, 5,58,10) = (/ & + &1.6559e+03_r8,1.5182e+03_r8,1.3018e+03_r8,9.1191e+02_r8,6.1054e+00_r8/) + kbo(:, 1,59,10) = (/ & + &5.5953e+02_r8,4.8866e+02_r8,3.8993e+02_r8,2.4311e+02_r8,2.7081e+00_r8/) + kbo(:, 2,59,10) = (/ & + &7.5600e+02_r8,6.6022e+02_r8,5.2680e+02_r8,3.2817e+02_r8,3.5280e+00_r8/) + kbo(:, 3,59,10) = (/ & + &1.0213e+03_r8,8.9185e+02_r8,7.1155e+02_r8,4.4309e+02_r8,4.3511e+00_r8/) + kbo(:, 4,59,10) = (/ & + &1.3747e+03_r8,1.2004e+03_r8,9.5765e+02_r8,5.9615e+02_r8,5.1215e+00_r8/) + kbo(:, 5,59,10) = (/ & + &1.8474e+03_r8,1.6131e+03_r8,1.2868e+03_r8,8.0091e+02_r8,5.9179e+00_r8/) + kbo(:, 1,13,11) = (/ & + &1.9556e+05_r8,1.4667e+05_r8,9.7780e+04_r8,4.8890e+04_r8,3.8293e+00_r8/) + kbo(:, 2,13,11) = (/ & + &1.9579e+05_r8,1.4684e+05_r8,9.7894e+04_r8,4.8947e+04_r8,3.6477e+00_r8/) + kbo(:, 3,13,11) = (/ & + &1.9489e+05_r8,1.4617e+05_r8,9.7447e+04_r8,4.8724e+04_r8,3.6240e+00_r8/) + kbo(:, 4,13,11) = (/ & + &1.9354e+05_r8,1.4515e+05_r8,9.6770e+04_r8,4.8385e+04_r8,3.4253e+00_r8/) + kbo(:, 5,13,11) = (/ & + &1.9176e+05_r8,1.4382e+05_r8,9.5882e+04_r8,4.7942e+04_r8,3.3965e+00_r8/) + kbo(:, 1,14,11) = (/ & + &1.2532e+05_r8,9.3990e+04_r8,6.2660e+04_r8,3.1330e+04_r8,4.2132e+00_r8/) + kbo(:, 2,14,11) = (/ & + &1.2490e+05_r8,9.3675e+04_r8,6.2450e+04_r8,3.1225e+04_r8,4.0914e+00_r8/) + kbo(:, 3,14,11) = (/ & + &1.2400e+05_r8,9.3003e+04_r8,6.2001e+04_r8,3.1001e+04_r8,4.0126e+00_r8/) + kbo(:, 4,14,11) = (/ & + &1.2262e+05_r8,9.1963e+04_r8,6.1309e+04_r8,3.0654e+04_r8,3.8288e+00_r8/) + kbo(:, 5,14,11) = (/ & + &1.2099e+05_r8,9.0745e+04_r8,6.0496e+04_r8,3.0248e+04_r8,3.6494e+00_r8/) + kbo(:, 1,15,11) = (/ & + &8.0146e+04_r8,6.0110e+04_r8,4.0074e+04_r8,2.0037e+04_r8,4.6025e+00_r8/) + kbo(:, 2,15,11) = (/ & + &7.9365e+04_r8,5.9524e+04_r8,3.9683e+04_r8,1.9842e+04_r8,4.5011e+00_r8/) + kbo(:, 3,15,11) = (/ & + &7.8437e+04_r8,5.8828e+04_r8,3.9219e+04_r8,1.9610e+04_r8,4.3995e+00_r8/) + kbo(:, 4,15,11) = (/ & + &7.7471e+04_r8,5.8104e+04_r8,3.8736e+04_r8,1.9369e+04_r8,4.3087e+00_r8/) + kbo(:, 5,15,11) = (/ & + &7.6167e+04_r8,5.7126e+04_r8,3.8084e+04_r8,1.9043e+04_r8,4.1657e+00_r8/) + kbo(:, 1,16,11) = (/ & + &5.9412e+04_r8,4.4559e+04_r8,2.9706e+04_r8,1.4854e+04_r8,4.9879e+00_r8/) + kbo(:, 2,16,11) = (/ & + &5.8737e+04_r8,4.4053e+04_r8,2.9369e+04_r8,1.4685e+04_r8,4.8952e+00_r8/) + kbo(:, 3,16,11) = (/ & + &5.7913e+04_r8,4.3435e+04_r8,2.8957e+04_r8,1.4479e+04_r8,4.7931e+00_r8/) + kbo(:, 4,16,11) = (/ & + &5.6912e+04_r8,4.2684e+04_r8,2.8456e+04_r8,1.4229e+04_r8,4.7058e+00_r8/) + kbo(:, 5,16,11) = (/ & + &5.5858e+04_r8,4.1894e+04_r8,2.7929e+04_r8,1.3965e+04_r8,4.5654e+00_r8/) + kbo(:, 1,17,11) = (/ & + &4.4739e+04_r8,3.3554e+04_r8,2.2370e+04_r8,1.1185e+04_r8,5.4258e+00_r8/) + kbo(:, 2,17,11) = (/ & + &4.4040e+04_r8,3.3030e+04_r8,2.2020e+04_r8,1.1011e+04_r8,5.3316e+00_r8/) + kbo(:, 3,17,11) = (/ & + &4.3278e+04_r8,3.2459e+04_r8,2.1639e+04_r8,1.0820e+04_r8,5.2258e+00_r8/) + kbo(:, 4,17,11) = (/ & + &4.2484e+04_r8,3.1863e+04_r8,2.1242e+04_r8,1.0622e+04_r8,5.1306e+00_r8/) + kbo(:, 5,17,11) = (/ & + &4.1610e+04_r8,3.1208e+04_r8,2.0805e+04_r8,1.0403e+04_r8,4.9611e+00_r8/) + kbo(:, 1,18,11) = (/ & + &3.3808e+04_r8,2.5356e+04_r8,1.6904e+04_r8,8.4526e+03_r8,5.9588e+00_r8/) + kbo(:, 2,18,11) = (/ & + &3.3205e+04_r8,2.4904e+04_r8,1.6603e+04_r8,8.3019e+03_r8,5.8553e+00_r8/) + kbo(:, 3,18,11) = (/ & + &3.2587e+04_r8,2.4440e+04_r8,1.6294e+04_r8,8.1473e+03_r8,5.7407e+00_r8/) + kbo(:, 4,18,11) = (/ & + &3.1890e+04_r8,2.3917e+04_r8,1.5945e+04_r8,7.9729e+03_r8,5.6396e+00_r8/) + kbo(:, 5,18,11) = (/ & + &3.1157e+04_r8,2.3368e+04_r8,1.5579e+04_r8,7.7897e+03_r8,5.4685e+00_r8/) + kbo(:, 1,19,11) = (/ & + &2.4641e+04_r8,1.8481e+04_r8,1.2321e+04_r8,6.1608e+03_r8,6.5634e+00_r8/) + kbo(:, 2,19,11) = (/ & + &2.4168e+04_r8,1.8126e+04_r8,1.2084e+04_r8,6.0424e+03_r8,6.4593e+00_r8/) + kbo(:, 3,19,11) = (/ & + &2.3646e+04_r8,1.7735e+04_r8,1.1823e+04_r8,5.9120e+03_r8,6.3292e+00_r8/) + kbo(:, 4,19,11) = (/ & + &2.3077e+04_r8,1.7308e+04_r8,1.1539e+04_r8,5.7697e+03_r8,6.2034e+00_r8/) + kbo(:, 5,19,11) = (/ & + &2.2489e+04_r8,1.6867e+04_r8,1.1245e+04_r8,5.6226e+03_r8,6.0369e+00_r8/) + kbo(:, 1,20,11) = (/ & + &1.9106e+04_r8,1.4330e+04_r8,9.5533e+03_r8,4.7770e+03_r8,7.1646e+00_r8/) + kbo(:, 2,20,11) = (/ & + &1.8682e+04_r8,1.4011e+04_r8,9.3411e+03_r8,4.6709e+03_r8,7.0409e+00_r8/) + kbo(:, 3,20,11) = (/ & + &1.8224e+04_r8,1.3668e+04_r8,9.1125e+03_r8,4.5566e+03_r8,6.8869e+00_r8/) + kbo(:, 4,20,11) = (/ & + &1.7734e+04_r8,1.3300e+04_r8,8.8671e+03_r8,4.4339e+03_r8,6.7557e+00_r8/) + kbo(:, 5,20,11) = (/ & + &1.7241e+04_r8,1.2931e+04_r8,8.6211e+03_r8,4.3109e+03_r8,6.6027e+00_r8/) + kbo(:, 1,21,11) = (/ & + &1.5039e+04_r8,1.1280e+04_r8,7.5200e+03_r8,3.7604e+03_r8,7.7170e+00_r8/) + kbo(:, 2,21,11) = (/ & + &1.4660e+04_r8,1.0995e+04_r8,7.3306e+03_r8,3.6657e+03_r8,7.5835e+00_r8/) + kbo(:, 3,21,11) = (/ & + &1.4253e+04_r8,1.0690e+04_r8,7.1270e+03_r8,3.5639e+03_r8,7.4413e+00_r8/) + kbo(:, 4,21,11) = (/ & + &1.3848e+04_r8,1.0387e+04_r8,6.9246e+03_r8,3.4627e+03_r8,7.3214e+00_r8/) + kbo(:, 5,21,11) = (/ & + &1.3474e+04_r8,1.0106e+04_r8,6.7374e+03_r8,3.3691e+03_r8,7.1721e+00_r8/) + kbo(:, 1,22,11) = (/ & + &1.1928e+04_r8,8.9459e+03_r8,5.9642e+03_r8,2.9825e+03_r8,8.2536e+00_r8/) + kbo(:, 2,22,11) = (/ & + &1.1588e+04_r8,8.6914e+03_r8,5.7946e+03_r8,2.8977e+03_r8,8.1353e+00_r8/) + kbo(:, 3,22,11) = (/ & + &1.1261e+04_r8,8.4462e+03_r8,5.6311e+03_r8,2.8159e+03_r8,8.0046e+00_r8/) + kbo(:, 4,22,11) = (/ & + &1.0981e+04_r8,8.2362e+03_r8,5.4911e+03_r8,2.7459e+03_r8,7.8868e+00_r8/) + kbo(:, 5,22,11) = (/ & + &1.0767e+04_r8,8.0756e+03_r8,5.3840e+03_r8,2.6924e+03_r8,7.7103e+00_r8/) + kbo(:, 1,23,11) = (/ & + &9.3738e+03_r8,7.0305e+03_r8,4.6873e+03_r8,2.3441e+03_r8,8.7957e+00_r8/) + kbo(:, 2,23,11) = (/ & + &9.1120e+03_r8,6.8342e+03_r8,4.5564e+03_r8,2.2786e+03_r8,8.6750e+00_r8/) + kbo(:, 3,23,11) = (/ & + &8.9119e+03_r8,6.6842e+03_r8,4.4564e+03_r8,2.2286e+03_r8,8.5667e+00_r8/) + kbo(:, 4,23,11) = (/ & + &8.7698e+03_r8,6.5776e+03_r8,4.3853e+03_r8,2.1931e+03_r8,8.4437e+00_r8/) + kbo(:, 5,23,11) = (/ & + &8.7064e+03_r8,6.5300e+03_r8,4.3536e+03_r8,2.1772e+03_r8,8.2499e+00_r8/) + kbo(:, 1,24,11) = (/ & + &7.2818e+03_r8,5.4615e+03_r8,3.6413e+03_r8,1.8211e+03_r8,9.3047e+00_r8/) + kbo(:, 2,24,11) = (/ & + &7.1398e+03_r8,5.3551e+03_r8,3.5703e+03_r8,1.7856e+03_r8,9.1844e+00_r8/) + kbo(:, 3,24,11) = (/ & + &7.0551e+03_r8,5.2916e+03_r8,3.5280e+03_r8,1.7644e+03_r8,9.0906e+00_r8/) + kbo(:, 4,24,11) = (/ & + &7.0561e+03_r8,5.2923e+03_r8,3.5284e+03_r8,1.7646e+03_r8,8.9639e+00_r8/) + kbo(:, 5,24,11) = (/ & + &7.1200e+03_r8,5.3402e+03_r8,3.5604e+03_r8,1.7806e+03_r8,8.7597e+00_r8/) + kbo(:, 1,25,11) = (/ & + &5.7829e+03_r8,4.3374e+03_r8,2.8918e+03_r8,1.4463e+03_r8,9.7531e+00_r8/) + kbo(:, 2,25,11) = (/ & + &5.7416e+03_r8,4.3064e+03_r8,2.8712e+03_r8,1.4360e+03_r8,9.6333e+00_r8/) + kbo(:, 3,25,11) = (/ & + &5.7703e+03_r8,4.3279e+03_r8,2.8855e+03_r8,1.4432e+03_r8,9.5575e+00_r8/) + kbo(:, 4,25,11) = (/ & + &5.8528e+03_r8,4.3898e+03_r8,2.9268e+03_r8,1.4638e+03_r8,9.4320e+00_r8/) + kbo(:, 5,25,11) = (/ & + &5.9946e+03_r8,4.4961e+03_r8,2.9977e+03_r8,1.4993e+03_r8,9.2048e+00_r8/) + kbo(:, 1,26,11) = (/ & + &4.7547e+03_r8,3.5662e+03_r8,2.3777e+03_r8,1.1892e+03_r8,1.0127e+01_r8/) + kbo(:, 2,26,11) = (/ & + &4.7969e+03_r8,3.5979e+03_r8,2.3989e+03_r8,1.1999e+03_r8,1.0014e+01_r8/) + kbo(:, 3,26,11) = (/ & + &4.8916e+03_r8,3.6689e+03_r8,2.4462e+03_r8,1.2235e+03_r8,9.9567e+00_r8/) + kbo(:, 4,26,11) = (/ & + &5.0339e+03_r8,3.7756e+03_r8,2.5174e+03_r8,1.2591e+03_r8,9.8430e+00_r8/) + kbo(:, 5,26,11) = (/ & + &5.1881e+03_r8,3.8913e+03_r8,2.5944e+03_r8,1.2976e+03_r8,9.5879e+00_r8/) + kbo(:, 1,27,11) = (/ & + &4.1434e+03_r8,3.1078e+03_r8,2.0721e+03_r8,1.0365e+03_r8,1.0438e+01_r8/) + kbo(:, 2,27,11) = (/ & + &4.2449e+03_r8,3.1839e+03_r8,2.1229e+03_r8,1.0619e+03_r8,1.0375e+01_r8/) + kbo(:, 3,27,11) = (/ & + &4.3814e+03_r8,3.2863e+03_r8,2.1911e+03_r8,1.0960e+03_r8,1.0314e+01_r8/) + kbo(:, 4,27,11) = (/ & + &4.5344e+03_r8,3.4010e+03_r8,2.2676e+03_r8,1.1342e+03_r8,1.0178e+01_r8/) + kbo(:, 5,27,11) = (/ & + &4.7035e+03_r8,3.5278e+03_r8,2.3521e+03_r8,1.1764e+03_r8,9.9184e+00_r8/) + kbo(:, 1,28,11) = (/ & + &3.7712e+03_r8,2.8287e+03_r8,1.8861e+03_r8,9.4351e+02_r8,1.0688e+01_r8/) + kbo(:, 2,28,11) = (/ & + &3.9032e+03_r8,2.9276e+03_r8,1.9520e+03_r8,9.7644e+02_r8,1.0679e+01_r8/) + kbo(:, 3,28,11) = (/ & + &4.0571e+03_r8,3.0430e+03_r8,2.0289e+03_r8,1.0148e+03_r8,1.0623e+01_r8/) + kbo(:, 4,28,11) = (/ & + &4.2272e+03_r8,3.1706e+03_r8,2.1139e+03_r8,1.0573e+03_r8,1.0454e+01_r8/) + kbo(:, 5,28,11) = (/ & + &4.4031e+03_r8,3.3025e+03_r8,2.2018e+03_r8,1.1012e+03_r8,1.0168e+01_r8/) + kbo(:, 1,29,11) = (/ & + &3.6879e+03_r8,2.7661e+03_r8,1.8444e+03_r8,9.2260e+02_r8,1.0914e+01_r8/) + kbo(:, 2,29,11) = (/ & + &3.8440e+03_r8,2.8832e+03_r8,1.9224e+03_r8,9.6157e+02_r8,1.0945e+01_r8/) + kbo(:, 3,29,11) = (/ & + &4.0134e+03_r8,3.0102e+03_r8,2.0070e+03_r8,1.0038e+03_r8,1.0853e+01_r8/) + kbo(:, 4,29,11) = (/ & + &4.1909e+03_r8,3.1433e+03_r8,2.0957e+03_r8,1.0481e+03_r8,1.0578e+01_r8/) + kbo(:, 5,29,11) = (/ & + &4.3726e+03_r8,3.2796e+03_r8,2.1866e+03_r8,1.0936e+03_r8,1.0403e+01_r8/) + kbo(:, 1,30,11) = (/ & + &3.7192e+03_r8,2.7896e+03_r8,1.8600e+03_r8,9.3035e+02_r8,1.1141e+01_r8/) + kbo(:, 2,30,11) = (/ & + &3.8944e+03_r8,2.9210e+03_r8,1.9475e+03_r8,9.7411e+02_r8,1.1139e+01_r8/) + kbo(:, 3,30,11) = (/ & + &4.0753e+03_r8,3.0566e+03_r8,2.0379e+03_r8,1.0192e+03_r8,1.0970e+01_r8/) + kbo(:, 4,30,11) = (/ & + &4.2621e+03_r8,3.1967e+03_r8,2.1313e+03_r8,1.0660e+03_r8,1.0736e+01_r8/) + kbo(:, 5,30,11) = (/ & + &4.4544e+03_r8,3.3410e+03_r8,2.2275e+03_r8,1.1141e+03_r8,1.0663e+01_r8/) + kbo(:, 1,31,11) = (/ & + &3.9494e+03_r8,2.9622e+03_r8,1.9750e+03_r8,9.8786e+02_r8,1.1309e+01_r8/) + kbo(:, 2,31,11) = (/ & + &4.1497e+03_r8,3.1124e+03_r8,2.0751e+03_r8,1.0378e+03_r8,1.1233e+01_r8/) + kbo(:, 3,31,11) = (/ & + &4.3564e+03_r8,3.2674e+03_r8,2.1785e+03_r8,1.0895e+03_r8,1.1031e+01_r8/) + kbo(:, 4,31,11) = (/ & + &4.5677e+03_r8,3.4259e+03_r8,2.2841e+03_r8,1.1423e+03_r8,1.1018e+01_r8/) + kbo(:, 5,31,11) = (/ & + &4.7823e+03_r8,3.5869e+03_r8,2.3915e+03_r8,1.1960e+03_r8,1.0922e+01_r8/) + kbo(:, 1,32,11) = (/ & + &4.2398e+03_r8,3.1800e+03_r8,2.1202e+03_r8,1.0604e+03_r8,1.1395e+01_r8/) + kbo(:, 2,32,11) = (/ & + &4.4759e+03_r8,3.3571e+03_r8,2.2382e+03_r8,1.1194e+03_r8,1.1282e+01_r8/) + kbo(:, 3,32,11) = (/ & + &4.7161e+03_r8,3.5372e+03_r8,2.3583e+03_r8,1.1795e+03_r8,1.1286e+01_r8/) + kbo(:, 4,32,11) = (/ & + &4.9603e+03_r8,3.7204e+03_r8,2.4805e+03_r8,1.2406e+03_r8,1.1267e+01_r8/) + kbo(:, 5,32,11) = (/ & + &5.2103e+03_r8,3.9079e+03_r8,2.6055e+03_r8,1.3031e+03_r8,1.1177e+01_r8/) + kbo(:, 1,33,11) = (/ & + &4.6404e+03_r8,3.4804e+03_r8,2.3205e+03_r8,1.1605e+03_r8,1.1433e+01_r8/) + kbo(:, 2,33,11) = (/ & + &4.9200e+03_r8,3.6901e+03_r8,2.4603e+03_r8,1.2304e+03_r8,1.1468e+01_r8/) + kbo(:, 3,33,11) = (/ & + &5.2076e+03_r8,3.9059e+03_r8,2.6041e+03_r8,1.3024e+03_r8,1.1541e+01_r8/) + kbo(:, 4,33,11) = (/ & + &5.4986e+03_r8,4.1241e+03_r8,2.7496e+03_r8,1.3751e+03_r8,1.1519e+01_r8/) + kbo(:, 5,33,11) = (/ & + &5.8045e+03_r8,4.3535e+03_r8,2.9026e+03_r8,1.4516e+03_r8,1.1398e+01_r8/) + kbo(:, 1,34,11) = (/ & + &4.9577e+03_r8,3.7184e+03_r8,2.4791e+03_r8,1.2399e+03_r8,1.1582e+01_r8/) + kbo(:, 2,34,11) = (/ & + &5.2771e+03_r8,3.9580e+03_r8,2.6389e+03_r8,1.3198e+03_r8,1.1708e+01_r8/) + kbo(:, 3,34,11) = (/ & + &5.6109e+03_r8,4.2083e+03_r8,2.8058e+03_r8,1.4032e+03_r8,1.1770e+01_r8/) + kbo(:, 4,34,11) = (/ & + &5.9588e+03_r8,4.4693e+03_r8,2.9798e+03_r8,1.4902e+03_r8,1.1629e+01_r8/) + kbo(:, 5,34,11) = (/ & + &6.3300e+03_r8,4.7477e+03_r8,3.1654e+03_r8,1.5830e+03_r8,1.1520e+01_r8/) + kbo(:, 1,35,11) = (/ & + &5.2909e+03_r8,3.9683e+03_r8,2.6458e+03_r8,1.3232e+03_r8,1.1741e+01_r8/) + kbo(:, 2,35,11) = (/ & + &5.6548e+03_r8,4.2413e+03_r8,2.8277e+03_r8,1.4142e+03_r8,1.1903e+01_r8/) + kbo(:, 3,35,11) = (/ & + &6.0420e+03_r8,4.5317e+03_r8,3.0214e+03_r8,1.5110e+03_r8,1.1866e+01_r8/) + kbo(:, 4,35,11) = (/ & + &6.4601e+03_r8,4.8453e+03_r8,3.2304e+03_r8,1.6156e+03_r8,1.1803e+01_r8/) + kbo(:, 5,35,11) = (/ & + &6.9268e+03_r8,5.1953e+03_r8,3.4637e+03_r8,1.7322e+03_r8,1.1652e+01_r8/) + kbo(:, 1,36,11) = (/ & + &5.5884e+03_r8,4.1915e+03_r8,2.7945e+03_r8,1.3976e+03_r8,1.1878e+01_r8/) + kbo(:, 2,36,11) = (/ & + &6.0018e+03_r8,4.5015e+03_r8,3.0012e+03_r8,1.5010e+03_r8,1.2049e+01_r8/) + kbo(:, 3,36,11) = (/ & + &6.4517e+03_r8,4.8389e+03_r8,3.2262e+03_r8,1.6135e+03_r8,1.1951e+01_r8/) + kbo(:, 4,36,11) = (/ & + &6.9515e+03_r8,5.2138e+03_r8,3.4761e+03_r8,1.7384e+03_r8,1.1938e+01_r8/) + kbo(:, 5,36,11) = (/ & + &7.5289e+03_r8,5.6469e+03_r8,3.7648e+03_r8,1.8827e+03_r8,1.1892e+01_r8/) + kbo(:, 1,37,11) = (/ & + &5.7114e+03_r8,4.2838e+03_r8,2.8561e+03_r8,1.4284e+03_r8,1.1983e+01_r8/) + kbo(:, 2,37,11) = (/ & + &6.1629e+03_r8,4.6224e+03_r8,3.0818e+03_r8,1.5413e+03_r8,1.2105e+01_r8/) + kbo(:, 3,37,11) = (/ & + &6.6668e+03_r8,5.0003e+03_r8,3.3338e+03_r8,1.6673e+03_r8,1.2063e+01_r8/) + kbo(:, 4,37,11) = (/ & + &7.2441e+03_r8,5.4333e+03_r8,3.6224e+03_r8,1.8115e+03_r8,1.2103e+01_r8/) + kbo(:, 5,37,11) = (/ & + &7.9256e+03_r8,5.9443e+03_r8,3.9631e+03_r8,1.9819e+03_r8,1.2052e+01_r8/) + kbo(:, 1,38,11) = (/ & + &5.9457e+03_r8,4.4595e+03_r8,2.9732e+03_r8,1.4870e+03_r8,1.2040e+01_r8/) + kbo(:, 2,38,11) = (/ & + &6.4404e+03_r8,4.8305e+03_r8,3.2206e+03_r8,1.6107e+03_r8,1.2135e+01_r8/) + kbo(:, 3,38,11) = (/ & + &7.0103e+03_r8,5.2579e+03_r8,3.5055e+03_r8,1.7531e+03_r8,1.2201e+01_r8/) + kbo(:, 4,38,11) = (/ & + &7.6883e+03_r8,5.7664e+03_r8,3.8444e+03_r8,1.9225e+03_r8,1.2264e+01_r8/) + kbo(:, 5,38,11) = (/ & + &8.5003e+03_r8,6.3754e+03_r8,4.2504e+03_r8,2.1255e+03_r8,1.2214e+01_r8/) + kbo(:, 1,39,11) = (/ & + &6.3574e+03_r8,4.7683e+03_r8,3.1792e+03_r8,1.5900e+03_r8,1.2058e+01_r8/) + kbo(:, 2,39,11) = (/ & + &6.9172e+03_r8,5.1882e+03_r8,3.4591e+03_r8,1.7299e+03_r8,1.2221e+01_r8/) + kbo(:, 3,39,11) = (/ & + &7.5768e+03_r8,5.6828e+03_r8,3.7888e+03_r8,1.8948e+03_r8,1.2385e+01_r8/) + kbo(:, 4,39,11) = (/ & + &8.3852e+03_r8,6.2891e+03_r8,4.1930e+03_r8,2.0968e+03_r8,1.2417e+01_r8/) + kbo(:, 5,39,11) = (/ & + &9.3744e+03_r8,7.0310e+03_r8,4.6875e+03_r8,2.3441e+03_r8,1.2400e+01_r8/) + kbo(:, 1,40,11) = (/ & + &6.3544e+03_r8,4.7660e+03_r8,3.1776e+03_r8,1.5893e+03_r8,1.2034e+01_r8/) + kbo(:, 2,40,11) = (/ & + &6.9547e+03_r8,5.2162e+03_r8,3.4777e+03_r8,1.7393e+03_r8,1.2252e+01_r8/) + kbo(:, 3,40,11) = (/ & + &7.6538e+03_r8,5.7405e+03_r8,3.8272e+03_r8,1.9140e+03_r8,1.2461e+01_r8/) + kbo(:, 4,40,11) = (/ & + &8.5373e+03_r8,6.4031e+03_r8,4.2689e+03_r8,2.1348e+03_r8,1.2533e+01_r8/) + kbo(:, 5,40,11) = (/ & + &9.6388e+03_r8,7.2292e+03_r8,4.8196e+03_r8,2.4101e+03_r8,1.2526e+01_r8/) + kbo(:, 1,41,11) = (/ & + &6.3521e+03_r8,4.7643e+03_r8,3.1765e+03_r8,1.5887e+03_r8,1.1995e+01_r8/) + kbo(:, 2,41,11) = (/ & + &6.9920e+03_r8,5.2442e+03_r8,3.4964e+03_r8,1.7486e+03_r8,1.2280e+01_r8/) + kbo(:, 3,41,11) = (/ & + &7.7375e+03_r8,5.8033e+03_r8,3.8691e+03_r8,1.9349e+03_r8,1.2499e+01_r8/) + kbo(:, 4,41,11) = (/ & + &8.6900e+03_r8,6.5177e+03_r8,4.3453e+03_r8,2.1730e+03_r8,1.2628e+01_r8/) + kbo(:, 5,41,11) = (/ & + &9.9008e+03_r8,7.4257e+03_r8,4.9507e+03_r8,2.4756e+03_r8,1.2622e+01_r8/) + kbo(:, 1,42,11) = (/ & + &6.4377e+03_r8,4.8285e+03_r8,3.2193e+03_r8,1.6101e+03_r8,1.1943e+01_r8/) + kbo(:, 2,42,11) = (/ & + &7.1284e+03_r8,5.3465e+03_r8,3.5646e+03_r8,1.7827e+03_r8,1.2311e+01_r8/) + kbo(:, 3,42,11) = (/ & + &7.9472e+03_r8,5.9606e+03_r8,3.9739e+03_r8,1.9873e+03_r8,1.2580e+01_r8/) + kbo(:, 4,42,11) = (/ & + &8.9767e+03_r8,6.7326e+03_r8,4.4886e+03_r8,2.2446e+03_r8,1.2710e+01_r8/) + kbo(:, 5,42,11) = (/ & + &1.0302e+04_r8,7.7266e+03_r8,5.1512e+03_r8,2.5758e+03_r8,1.2734e+01_r8/) + kbo(:, 1,43,11) = (/ & + &6.5684e+03_r8,4.9266e+03_r8,3.2847e+03_r8,1.6428e+03_r8,1.1839e+01_r8/) + kbo(:, 2,43,11) = (/ & + &7.3100e+03_r8,5.4827e+03_r8,3.6554e+03_r8,1.8281e+03_r8,1.2298e+01_r8/) + kbo(:, 3,43,11) = (/ & + &8.2069e+03_r8,6.1553e+03_r8,4.1038e+03_r8,2.0523e+03_r8,1.2585e+01_r8/) + kbo(:, 4,43,11) = (/ & + &9.3215e+03_r8,6.9913e+03_r8,4.6611e+03_r8,2.3308e+03_r8,1.2796e+01_r8/) + kbo(:, 5,43,11) = (/ & + &1.0756e+04_r8,8.0671e+03_r8,5.3782e+03_r8,2.6894e+03_r8,1.2802e+01_r8/) + kbo(:, 1,44,11) = (/ & + &6.7770e+03_r8,5.0829e+03_r8,3.3889e+03_r8,1.6949e+03_r8,1.1696e+01_r8/) + kbo(:, 2,44,11) = (/ & + &7.6014e+03_r8,5.7012e+03_r8,3.8011e+03_r8,1.9009e+03_r8,1.2235e+01_r8/) + kbo(:, 3,44,11) = (/ & + &8.5905e+03_r8,6.4430e+03_r8,4.2955e+03_r8,2.1481e+03_r8,1.2598e+01_r8/) + kbo(:, 4,44,11) = (/ & + &9.8167e+03_r8,7.3626e+03_r8,4.9086e+03_r8,2.4546e+03_r8,1.2843e+01_r8/) + kbo(:, 5,44,11) = (/ & + &1.1370e+04_r8,8.5274e+03_r8,5.6850e+03_r8,2.8427e+03_r8,1.2862e+01_r8/) + kbo(:, 1,45,11) = (/ & + &7.1337e+03_r8,5.3505e+03_r8,3.5673e+03_r8,1.7841e+03_r8,1.1553e+01_r8/) + kbo(:, 2,45,11) = (/ & + &8.0813e+03_r8,6.0612e+03_r8,4.0411e+03_r8,2.0209e+03_r8,1.2213e+01_r8/) + kbo(:, 3,45,11) = (/ & + &9.1915e+03_r8,6.8938e+03_r8,4.5961e+03_r8,2.2984e+03_r8,1.2577e+01_r8/) + kbo(:, 4,45,11) = (/ & + &1.0572e+04_r8,7.9290e+03_r8,5.2862e+03_r8,2.6434e+03_r8,1.2862e+01_r8/) + kbo(:, 5,45,11) = (/ & + &1.2294e+04_r8,9.2203e+03_r8,6.1470e+03_r8,3.0738e+03_r8,1.2905e+01_r8/) + kbo(:, 1,46,11) = (/ & + &7.5574e+03_r8,5.6683e+03_r8,3.7792e+03_r8,1.8901e+03_r8,1.1372e+01_r8/) + kbo(:, 2,46,11) = (/ & + &8.6566e+03_r8,6.4927e+03_r8,4.3287e+03_r8,2.1648e+03_r8,1.2098e+01_r8/) + kbo(:, 3,46,11) = (/ & + &9.9311e+03_r8,7.4485e+03_r8,4.9659e+03_r8,2.4833e+03_r8,1.2508e+01_r8/) + kbo(:, 4,46,11) = (/ & + &1.1483e+04_r8,8.6121e+03_r8,5.7416e+03_r8,2.8711e+03_r8,1.2889e+01_r8/) + kbo(:, 5,46,11) = (/ & + &1.3417e+04_r8,1.0063e+04_r8,6.7088e+03_r8,3.3546e+03_r8,1.2962e+01_r8/) + kbo(:, 1,47,11) = (/ & + &7.8727e+03_r8,5.9048e+03_r8,3.9368e+03_r8,1.9689e+03_r8,1.1120e+01_r8/) + kbo(:, 2,47,11) = (/ & + &9.1356e+03_r8,6.8519e+03_r8,4.5682e+03_r8,2.2845e+03_r8,1.1918e+01_r8/) + kbo(:, 3,47,11) = (/ & + &1.0582e+04_r8,7.9368e+03_r8,5.2914e+03_r8,2.6461e+03_r8,1.2406e+01_r8/) + kbo(:, 4,47,11) = (/ & + &1.2301e+04_r8,9.2260e+03_r8,6.1509e+03_r8,3.0757e+03_r8,1.2816e+01_r8/) + kbo(:, 5,47,11) = (/ & + &1.4433e+04_r8,1.0825e+04_r8,7.2167e+03_r8,3.6086e+03_r8,1.2983e+01_r8/) + kbo(:, 1,48,11) = (/ & + &8.4035e+03_r8,6.3029e+03_r8,4.2022e+03_r8,2.1016e+03_r8,1.0897e+01_r8/) + kbo(:, 2,48,11) = (/ & + &9.8931e+03_r8,7.4200e+03_r8,4.9470e+03_r8,2.4739e+03_r8,1.1706e+01_r8/) + kbo(:, 3,48,11) = (/ & + &1.1589e+04_r8,8.6922e+03_r8,5.7950e+03_r8,2.8979e+03_r8,1.2313e+01_r8/) + kbo(:, 4,48,11) = (/ & + &1.3567e+04_r8,1.0175e+04_r8,6.7839e+03_r8,3.3922e+03_r8,1.2741e+01_r8/) + kbo(:, 5,48,11) = (/ & + &1.5977e+04_r8,1.1983e+04_r8,7.9888e+03_r8,3.9947e+03_r8,1.2994e+01_r8/) + kbo(:, 1,49,11) = (/ & + &9.3222e+03_r8,6.9919e+03_r8,4.6615e+03_r8,2.3312e+03_r8,1.0633e+01_r8/) + kbo(:, 2,49,11) = (/ & + &1.1123e+04_r8,8.3424e+03_r8,5.5619e+03_r8,2.7813e+03_r8,1.1478e+01_r8/) + kbo(:, 3,49,11) = (/ & + &1.3212e+04_r8,9.9089e+03_r8,6.6061e+03_r8,3.3034e+03_r8,1.2190e+01_r8/) + kbo(:, 4,49,11) = (/ & + &1.5603e+04_r8,1.1702e+04_r8,7.8017e+03_r8,3.9011e+03_r8,1.2697e+01_r8/) + kbo(:, 5,49,11) = (/ & + &1.8442e+04_r8,1.3832e+04_r8,9.2215e+03_r8,4.6110e+03_r8,1.3027e+01_r8/) + kbo(:, 1,50,11) = (/ & + &9.8729e+03_r8,7.4049e+03_r8,4.9369e+03_r8,2.4688e+03_r8,1.0346e+01_r8/) + kbo(:, 2,50,11) = (/ & + &1.1927e+04_r8,8.9452e+03_r8,5.9637e+03_r8,2.9822e+03_r8,1.1213e+01_r8/) + kbo(:, 3,50,11) = (/ & + &1.4376e+04_r8,1.0782e+04_r8,7.1884e+03_r8,3.5945e+03_r8,1.2042e+01_r8/) + kbo(:, 4,50,11) = (/ & + &1.7156e+04_r8,1.2867e+04_r8,8.5782e+03_r8,4.2894e+03_r8,1.2592e+01_r8/) + kbo(:, 5,50,11) = (/ & + &2.0387e+04_r8,1.5290e+04_r8,1.0194e+04_r8,5.0970e+03_r8,1.3035e+01_r8/) + kbo(:, 1,51,11) = (/ & + &1.0246e+04_r8,7.6846e+03_r8,5.1234e+03_r8,2.5621e+03_r8,1.0080e+01_r8/) + kbo(:, 2,51,11) = (/ & + &1.2504e+04_r8,9.3781e+03_r8,6.2523e+03_r8,3.1265e+03_r8,1.0959e+01_r8/) + kbo(:, 3,51,11) = (/ & + &1.5294e+04_r8,1.1471e+04_r8,7.6476e+03_r8,3.8241e+03_r8,1.1913e+01_r8/) + kbo(:, 4,51,11) = (/ & + &1.8483e+04_r8,1.3863e+04_r8,9.2420e+03_r8,4.6213e+03_r8,1.2523e+01_r8/) + kbo(:, 5,51,11) = (/ & + &2.2103e+04_r8,1.6577e+04_r8,1.1052e+04_r8,5.5261e+03_r8,1.3008e+01_r8/) + kbo(:, 1,52,11) = (/ & + &1.0919e+04_r8,8.1898e+03_r8,5.4601e+03_r8,2.7304e+03_r8,9.7365e+00_r8/) + kbo(:, 2,52,11) = (/ & + &1.3474e+04_r8,1.0106e+04_r8,6.7375e+03_r8,3.3691e+03_r8,1.0715e+01_r8/) + kbo(:, 3,52,11) = (/ & + &1.6692e+04_r8,1.2519e+04_r8,8.3465e+03_r8,4.1736e+03_r8,1.1714e+01_r8/) + kbo(:, 4,52,11) = (/ & + &2.0445e+04_r8,1.5334e+04_r8,1.0223e+04_r8,5.1117e+03_r8,1.2415e+01_r8/) + kbo(:, 5,52,11) = (/ & + &2.4642e+04_r8,1.8481e+04_r8,1.2321e+04_r8,6.1608e+03_r8,1.2964e+01_r8/) + kbo(:, 1,53,11) = (/ & + &1.2096e+04_r8,9.0720e+03_r8,6.0483e+03_r8,3.0245e+03_r8,9.3807e+00_r8/) + kbo(:, 2,53,11) = (/ & + &1.5115e+04_r8,1.1337e+04_r8,7.5582e+03_r8,3.7794e+03_r8,1.0467e+01_r8/) + kbo(:, 3,53,11) = (/ & + &1.8931e+04_r8,1.4199e+04_r8,9.4661e+03_r8,4.7334e+03_r8,1.1520e+01_r8/) + kbo(:, 4,53,11) = (/ & + &2.3491e+04_r8,1.7618e+04_r8,1.1746e+04_r8,5.8732e+03_r8,1.2292e+01_r8/) + kbo(:, 5,53,11) = (/ & + &2.8602e+04_r8,2.1452e+04_r8,1.4301e+04_r8,7.1510e+03_r8,1.2913e+01_r8/) + kbo(:, 1,54,11) = (/ & + &1.1628e+04_r8,8.7215e+03_r8,5.8146e+03_r8,2.9077e+03_r8,8.9653e+00_r8/) + kbo(:, 2,54,11) = (/ & + &1.4721e+04_r8,1.1041e+04_r8,7.3608e+03_r8,3.6808e+03_r8,1.0130e+01_r8/) + kbo(:, 3,54,11) = (/ & + &1.8638e+04_r8,1.3979e+04_r8,9.3193e+03_r8,4.6600e+03_r8,1.1195e+01_r8/) + kbo(:, 4,54,11) = (/ & + &2.3417e+04_r8,1.7563e+04_r8,1.1709e+04_r8,5.8547e+03_r8,1.2060e+01_r8/) + kbo(:, 5,54,11) = (/ & + &2.8828e+04_r8,2.1621e+04_r8,1.4414e+04_r8,7.2075e+03_r8,1.2739e+01_r8/) + kbo(:, 1,55,11) = (/ & + &1.0209e+04_r8,7.6567e+03_r8,5.1047e+03_r8,2.5527e+03_r8,8.5323e+00_r8/) + kbo(:, 2,55,11) = (/ & + &1.3095e+04_r8,9.8211e+03_r8,6.5477e+03_r8,3.2742e+03_r8,9.7667e+00_r8/) + kbo(:, 3,55,11) = (/ & + &1.6780e+04_r8,1.2585e+04_r8,8.3901e+03_r8,4.1954e+03_r8,1.0760e+01_r8/) + kbo(:, 4,55,11) = (/ & + &2.1308e+04_r8,1.5981e+04_r8,1.0654e+04_r8,5.3275e+03_r8,1.1787e+01_r8/) + kbo(:, 5,55,11) = (/ & + &2.6526e+04_r8,1.9895e+04_r8,1.3264e+04_r8,6.6321e+03_r8,1.2490e+01_r8/) + kbo(:, 1,56,11) = (/ & + &8.9242e+03_r8,6.6933e+03_r8,4.4624e+03_r8,2.2315e+03_r8,8.1192e+00_r8/) + kbo(:, 2,56,11) = (/ & + &1.1623e+04_r8,8.7170e+03_r8,5.8115e+03_r8,2.9061e+03_r8,9.3346e+00_r8/) + kbo(:, 3,56,11) = (/ & + &1.5096e+04_r8,1.1322e+04_r8,7.5482e+03_r8,3.7744e+03_r8,1.0408e+01_r8/) + kbo(:, 4,56,11) = (/ & + &1.9354e+04_r8,1.4515e+04_r8,9.6771e+03_r8,4.8388e+03_r8,1.1396e+01_r8/) + kbo(:, 5,56,11) = (/ & + &2.4338e+04_r8,1.8253e+04_r8,1.2169e+04_r8,6.0847e+03_r8,1.2212e+01_r8/) + kbo(:, 1,57,11) = (/ & + &7.7622e+03_r8,5.8218e+03_r8,3.8814e+03_r8,1.9410e+03_r8,7.7106e+00_r8/) + kbo(:, 2,57,11) = (/ & + &1.0290e+04_r8,7.7178e+03_r8,5.1454e+03_r8,2.5730e+03_r8,8.9363e+00_r8/) + kbo(:, 3,57,11) = (/ & + &1.3552e+04_r8,1.0164e+04_r8,6.7760e+03_r8,3.3882e+03_r8,1.0051e+01_r8/) + kbo(:, 4,57,11) = (/ & + &1.7543e+04_r8,1.3157e+04_r8,8.7715e+03_r8,4.3860e+03_r8,1.0990e+01_r8/) + kbo(:, 5,57,11) = (/ & + &2.2284e+04_r8,1.6713e+04_r8,1.1142e+04_r8,5.5714e+03_r8,1.1934e+01_r8/) + kbo(:, 1,58,11) = (/ & + &1.7767e+03_r8,1.6290e+03_r8,1.3968e+03_r8,9.7855e+02_r8,7.2858e+00_r8/) + kbo(:, 2,58,11) = (/ & + &2.4068e+03_r8,2.2067e+03_r8,1.8922e+03_r8,1.3254e+03_r8,8.5609e+00_r8/) + kbo(:, 3,58,11) = (/ & + &3.2122e+03_r8,2.9452e+03_r8,2.5253e+03_r8,1.7688e+03_r8,9.6597e+00_r8/) + kbo(:, 4,58,11) = (/ & + &4.2027e+03_r8,3.8533e+03_r8,3.3039e+03_r8,2.3142e+03_r8,1.0637e+01_r8/) + kbo(:, 5,58,11) = (/ & + &5.3882e+03_r8,4.9402e+03_r8,4.2359e+03_r8,2.9669e+03_r8,1.1542e+01_r8/) + kbo(:, 1,59,11) = (/ & + &1.9233e+03_r8,1.6794e+03_r8,1.3397e+03_r8,8.3393e+02_r8,7.1275e+00_r8/) + kbo(:, 2,59,11) = (/ & + &2.6585e+03_r8,2.3214e+03_r8,1.8518e+03_r8,1.1525e+03_r8,8.4302e+00_r8/) + kbo(:, 3,59,11) = (/ & + &3.5898e+03_r8,3.1345e+03_r8,2.5004e+03_r8,1.5561e+03_r8,9.5360e+00_r8/) + kbo(:, 4,59,11) = (/ & + &4.7292e+03_r8,4.1294e+03_r8,3.2940e+03_r8,2.0499e+03_r8,1.0472e+01_r8/) + kbo(:, 5,59,11) = (/ & + &6.0902e+03_r8,5.3178e+03_r8,4.2419e+03_r8,2.6398e+03_r8,1.1150e+01_r8/) + kbo(:, 1,13,12) = (/ & + &2.7240e+05_r8,2.0430e+05_r8,1.3620e+05_r8,6.8101e+04_r8,4.4161e+00_r8/) + kbo(:, 2,13,12) = (/ & + &2.7176e+05_r8,2.0382e+05_r8,1.3588e+05_r8,6.7942e+04_r8,4.2840e+00_r8/) + kbo(:, 3,13,12) = (/ & + &2.7001e+05_r8,2.0251e+05_r8,1.3501e+05_r8,6.7503e+04_r8,4.1173e+00_r8/) + kbo(:, 4,13,12) = (/ & + &2.6763e+05_r8,2.0073e+05_r8,1.3382e+05_r8,6.6909e+04_r8,3.9336e+00_r8/) + kbo(:, 5,13,12) = (/ & + &2.6442e+05_r8,1.9831e+05_r8,1.3221e+05_r8,6.6105e+04_r8,3.6961e+00_r8/) + kbo(:, 1,14,12) = (/ & + &1.8113e+05_r8,1.3585e+05_r8,9.0565e+04_r8,4.5283e+04_r8,4.8454e+00_r8/) + kbo(:, 2,14,12) = (/ & + &1.8030e+05_r8,1.3523e+05_r8,9.0150e+04_r8,4.5075e+04_r8,4.6873e+00_r8/) + kbo(:, 3,14,12) = (/ & + &1.7856e+05_r8,1.3392e+05_r8,8.9279e+04_r8,4.4640e+04_r8,4.6210e+00_r8/) + kbo(:, 4,14,12) = (/ & + &1.7661e+05_r8,1.3246e+05_r8,8.8303e+04_r8,4.4152e+04_r8,4.4506e+00_r8/) + kbo(:, 5,14,12) = (/ & + &1.7414e+05_r8,1.3060e+05_r8,8.7069e+04_r8,4.3535e+04_r8,4.3231e+00_r8/) + kbo(:, 1,15,12) = (/ & + &1.2085e+05_r8,9.0635e+04_r8,6.0424e+04_r8,3.0213e+04_r8,5.3476e+00_r8/) + kbo(:, 2,15,12) = (/ & + &1.1987e+05_r8,8.9903e+04_r8,5.9936e+04_r8,2.9969e+04_r8,5.2285e+00_r8/) + kbo(:, 3,15,12) = (/ & + &1.1863e+05_r8,8.8976e+04_r8,5.9318e+04_r8,2.9660e+04_r8,5.0918e+00_r8/) + kbo(:, 4,15,12) = (/ & + &1.1686e+05_r8,8.7649e+04_r8,5.8433e+04_r8,2.9217e+04_r8,4.9903e+00_r8/) + kbo(:, 5,15,12) = (/ & + &1.1485e+05_r8,8.6139e+04_r8,5.7427e+04_r8,2.8714e+04_r8,4.7856e+00_r8/) + kbo(:, 1,16,12) = (/ & + &9.4371e+04_r8,7.0779e+04_r8,4.7186e+04_r8,2.3593e+04_r8,5.9193e+00_r8/) + kbo(:, 2,16,12) = (/ & + &9.3237e+04_r8,6.9928e+04_r8,4.6619e+04_r8,2.3310e+04_r8,5.7778e+00_r8/) + kbo(:, 3,16,12) = (/ & + &9.1868e+04_r8,6.8901e+04_r8,4.5935e+04_r8,2.2968e+04_r8,5.6214e+00_r8/) + kbo(:, 4,16,12) = (/ & + &9.0372e+04_r8,6.7780e+04_r8,4.5187e+04_r8,2.2594e+04_r8,5.5103e+00_r8/) + kbo(:, 5,16,12) = (/ & + &8.8699e+04_r8,6.6525e+04_r8,4.4350e+04_r8,2.2176e+04_r8,5.3472e+00_r8/) + kbo(:, 1,17,12) = (/ & + &7.4737e+04_r8,5.6053e+04_r8,3.7369e+04_r8,1.8685e+04_r8,6.5296e+00_r8/) + kbo(:, 2,17,12) = (/ & + &7.3678e+04_r8,5.5259e+04_r8,3.6840e+04_r8,1.8420e+04_r8,6.3899e+00_r8/) + kbo(:, 3,17,12) = (/ & + &7.2463e+04_r8,5.4347e+04_r8,3.6232e+04_r8,1.8116e+04_r8,6.2234e+00_r8/) + kbo(:, 4,17,12) = (/ & + &7.1178e+04_r8,5.3383e+04_r8,3.5589e+04_r8,1.7795e+04_r8,6.1262e+00_r8/) + kbo(:, 5,17,12) = (/ & + &6.9846e+04_r8,5.2385e+04_r8,3.4923e+04_r8,1.7462e+04_r8,6.0038e+00_r8/) + kbo(:, 1,18,12) = (/ & + &5.9561e+04_r8,4.4671e+04_r8,2.9781e+04_r8,1.4891e+04_r8,7.2106e+00_r8/) + kbo(:, 2,18,12) = (/ & + &5.8573e+04_r8,4.3930e+04_r8,2.9287e+04_r8,1.4644e+04_r8,7.0772e+00_r8/) + kbo(:, 3,18,12) = (/ & + &5.7514e+04_r8,4.3136e+04_r8,2.8757e+04_r8,1.4379e+04_r8,6.9067e+00_r8/) + kbo(:, 4,18,12) = (/ & + &5.6474e+04_r8,4.2356e+04_r8,2.8238e+04_r8,1.4119e+04_r8,6.7942e+00_r8/) + kbo(:, 5,18,12) = (/ & + &5.5403e+04_r8,4.1552e+04_r8,2.7702e+04_r8,1.3851e+04_r8,6.6477e+00_r8/) + kbo(:, 1,19,12) = (/ & + &4.5689e+04_r8,3.4267e+04_r8,2.2845e+04_r8,1.1423e+04_r8,7.9750e+00_r8/) + kbo(:, 2,19,12) = (/ & + &4.4876e+04_r8,3.3657e+04_r8,2.2438e+04_r8,1.1220e+04_r8,7.8278e+00_r8/) + kbo(:, 3,19,12) = (/ & + &4.4040e+04_r8,3.3030e+04_r8,2.2021e+04_r8,1.1011e+04_r8,7.6237e+00_r8/) + kbo(:, 4,19,12) = (/ & + &4.3227e+04_r8,3.2420e+04_r8,2.1614e+04_r8,1.0807e+04_r8,7.5070e+00_r8/) + kbo(:, 5,19,12) = (/ & + &4.2374e+04_r8,3.1781e+04_r8,2.1187e+04_r8,1.0594e+04_r8,7.3430e+00_r8/) + kbo(:, 1,20,12) = (/ & + &3.7246e+04_r8,2.7935e+04_r8,1.8623e+04_r8,9.3122e+03_r8,8.8153e+00_r8/) + kbo(:, 2,20,12) = (/ & + &3.6550e+04_r8,2.7413e+04_r8,1.8276e+04_r8,9.1383e+03_r8,8.6532e+00_r8/) + kbo(:, 3,20,12) = (/ & + &3.5840e+04_r8,2.6880e+04_r8,1.7920e+04_r8,8.9607e+03_r8,8.4391e+00_r8/) + kbo(:, 4,20,12) = (/ & + &3.5149e+04_r8,2.6362e+04_r8,1.7575e+04_r8,8.7878e+03_r8,8.2995e+00_r8/) + kbo(:, 5,20,12) = (/ & + &3.4405e+04_r8,2.5804e+04_r8,1.7203e+04_r8,8.6018e+03_r8,8.1167e+00_r8/) + kbo(:, 1,21,12) = (/ & + &3.0709e+04_r8,2.3032e+04_r8,1.5355e+04_r8,7.6780e+03_r8,9.7372e+00_r8/) + kbo(:, 2,21,12) = (/ & + &3.0108e+04_r8,2.2581e+04_r8,1.5055e+04_r8,7.5277e+03_r8,9.5645e+00_r8/) + kbo(:, 3,21,12) = (/ & + &2.9509e+04_r8,2.2132e+04_r8,1.4755e+04_r8,7.3780e+03_r8,9.3267e+00_r8/) + kbo(:, 4,21,12) = (/ & + &2.8892e+04_r8,2.1670e+04_r8,1.4447e+04_r8,7.2238e+03_r8,9.1690e+00_r8/) + kbo(:, 5,21,12) = (/ & + &2.8241e+04_r8,2.1181e+04_r8,1.4121e+04_r8,7.0607e+03_r8,8.9671e+00_r8/) + kbo(:, 1,22,12) = (/ & + &2.5484e+04_r8,1.9113e+04_r8,1.2742e+04_r8,6.3717e+03_r8,1.0681e+01_r8/) + kbo(:, 2,22,12) = (/ & + &2.4964e+04_r8,1.8723e+04_r8,1.2483e+04_r8,6.2417e+03_r8,1.0497e+01_r8/) + kbo(:, 3,22,12) = (/ & + &2.4423e+04_r8,1.8317e+04_r8,1.2212e+04_r8,6.1064e+03_r8,1.0234e+01_r8/) + kbo(:, 4,22,12) = (/ & + &2.3869e+04_r8,1.7902e+04_r8,1.1935e+04_r8,5.9678e+03_r8,1.0059e+01_r8/) + kbo(:, 5,22,12) = (/ & + &2.3286e+04_r8,1.7465e+04_r8,1.1643e+04_r8,5.8221e+03_r8,9.8315e+00_r8/) + kbo(:, 1,23,12) = (/ & + &2.0918e+04_r8,1.5688e+04_r8,1.0459e+04_r8,5.2302e+03_r8,1.1614e+01_r8/) + kbo(:, 2,23,12) = (/ & + &2.0451e+04_r8,1.5339e+04_r8,1.0226e+04_r8,5.1135e+03_r8,1.1417e+01_r8/) + kbo(:, 3,23,12) = (/ & + &1.9969e+04_r8,1.4977e+04_r8,9.9848e+03_r8,4.9928e+03_r8,1.1125e+01_r8/) + kbo(:, 4,23,12) = (/ & + &1.9481e+04_r8,1.4611e+04_r8,9.7407e+03_r8,4.8708e+03_r8,1.0942e+01_r8/) + kbo(:, 5,23,12) = (/ & + &1.8998e+04_r8,1.4249e+04_r8,9.4994e+03_r8,4.7501e+03_r8,1.0699e+01_r8/) + kbo(:, 1,24,12) = (/ & + &1.6828e+04_r8,1.2621e+04_r8,8.4145e+03_r8,4.2078e+03_r8,1.2522e+01_r8/) + kbo(:, 2,24,12) = (/ & + &1.6415e+04_r8,1.2311e+04_r8,8.2079e+03_r8,4.1044e+03_r8,1.2299e+01_r8/) + kbo(:, 3,24,12) = (/ & + &1.6005e+04_r8,1.2004e+04_r8,8.0027e+03_r8,4.0018e+03_r8,1.2004e+01_r8/) + kbo(:, 4,24,12) = (/ & + &1.5632e+04_r8,1.1724e+04_r8,7.8164e+03_r8,3.9086e+03_r8,1.1796e+01_r8/) + kbo(:, 5,24,12) = (/ & + &1.5350e+04_r8,1.1513e+04_r8,7.6755e+03_r8,3.8381e+03_r8,1.1532e+01_r8/) + kbo(:, 1,25,12) = (/ & + &1.3517e+04_r8,1.0138e+04_r8,6.7590e+03_r8,3.3800e+03_r8,1.3378e+01_r8/) + kbo(:, 2,25,12) = (/ & + &1.3176e+04_r8,9.8826e+03_r8,6.5887e+03_r8,3.2948e+03_r8,1.3150e+01_r8/) + kbo(:, 3,25,12) = (/ & + &1.2900e+04_r8,9.6753e+03_r8,6.4505e+03_r8,3.2257e+03_r8,1.2858e+01_r8/) + kbo(:, 4,25,12) = (/ & + &1.2719e+04_r8,9.5392e+03_r8,6.3597e+03_r8,3.1803e+03_r8,1.2628e+01_r8/) + kbo(:, 5,25,12) = (/ & + &1.2623e+04_r8,9.4672e+03_r8,6.3117e+03_r8,3.1562e+03_r8,1.2342e+01_r8/) + kbo(:, 1,26,12) = (/ & + &1.0917e+04_r8,8.1877e+03_r8,5.4588e+03_r8,2.7299e+03_r8,1.4213e+01_r8/) + kbo(:, 2,26,12) = (/ & + &1.0711e+04_r8,8.0332e+03_r8,5.3557e+03_r8,2.6783e+03_r8,1.3979e+01_r8/) + kbo(:, 3,26,12) = (/ & + &1.0602e+04_r8,7.9514e+03_r8,5.3012e+03_r8,2.6510e+03_r8,1.3677e+01_r8/) + kbo(:, 4,26,12) = (/ & + &1.0604e+04_r8,7.9535e+03_r8,5.3026e+03_r8,2.6517e+03_r8,1.3410e+01_r8/) + kbo(:, 5,26,12) = (/ & + &1.0730e+04_r8,8.0477e+03_r8,5.3654e+03_r8,2.6831e+03_r8,1.3099e+01_r8/) + kbo(:, 1,27,12) = (/ & + &9.1749e+03_r8,6.8814e+03_r8,4.5879e+03_r8,2.2944e+03_r8,1.5000e+01_r8/) + kbo(:, 2,27,12) = (/ & + &9.1157e+03_r8,6.8370e+03_r8,4.5583e+03_r8,2.2796e+03_r8,1.4706e+01_r8/) + kbo(:, 3,27,12) = (/ & + &9.1873e+03_r8,6.8907e+03_r8,4.5941e+03_r8,2.2975e+03_r8,1.4431e+01_r8/) + kbo(:, 4,27,12) = (/ & + &9.3840e+03_r8,7.0382e+03_r8,4.6924e+03_r8,2.3467e+03_r8,1.4137e+01_r8/) + kbo(:, 5,27,12) = (/ & + &9.6488e+03_r8,7.2368e+03_r8,4.8249e+03_r8,2.4129e+03_r8,1.3775e+01_r8/) + kbo(:, 1,28,12) = (/ & + &8.0307e+03_r8,6.0232e+03_r8,4.0158e+03_r8,2.0083e+03_r8,1.5711e+01_r8/) + kbo(:, 2,28,12) = (/ & + &8.1446e+03_r8,6.1087e+03_r8,4.0727e+03_r8,2.0368e+03_r8,1.5384e+01_r8/) + kbo(:, 3,28,12) = (/ & + &8.3784e+03_r8,6.2841e+03_r8,4.1897e+03_r8,2.0953e+03_r8,1.5123e+01_r8/) + kbo(:, 4,28,12) = (/ & + &8.6648e+03_r8,6.4989e+03_r8,4.3329e+03_r8,2.1669e+03_r8,1.4791e+01_r8/) + kbo(:, 5,28,12) = (/ & + &9.0065e+03_r8,6.7551e+03_r8,4.5037e+03_r8,2.2523e+03_r8,1.4343e+01_r8/) + kbo(:, 1,29,12) = (/ & + &7.6471e+03_r8,5.7356e+03_r8,3.8240e+03_r8,1.9124e+03_r8,1.6341e+01_r8/) + kbo(:, 2,29,12) = (/ & + &7.9071e+03_r8,5.9306e+03_r8,3.9540e+03_r8,1.9775e+03_r8,1.6013e+01_r8/) + kbo(:, 3,29,12) = (/ & + &8.2292e+03_r8,6.1721e+03_r8,4.1151e+03_r8,2.0580e+03_r8,1.5732e+01_r8/) + kbo(:, 4,29,12) = (/ & + &8.6240e+03_r8,6.4682e+03_r8,4.3125e+03_r8,2.1567e+03_r8,1.5372e+01_r8/) + kbo(:, 5,29,12) = (/ & + &9.0598e+03_r8,6.7951e+03_r8,4.5304e+03_r8,2.2657e+03_r8,1.4767e+01_r8/) + kbo(:, 1,30,12) = (/ & + &7.6323e+03_r8,5.7245e+03_r8,3.8166e+03_r8,1.9088e+03_r8,1.6832e+01_r8/) + kbo(:, 2,30,12) = (/ & + &7.9856e+03_r8,5.9894e+03_r8,3.9933e+03_r8,1.9972e+03_r8,1.6592e+01_r8/) + kbo(:, 3,30,12) = (/ & + &8.4256e+03_r8,6.3195e+03_r8,4.2133e+03_r8,2.1072e+03_r8,1.6260e+01_r8/) + kbo(:, 4,30,12) = (/ & + &8.9027e+03_r8,6.6772e+03_r8,4.4518e+03_r8,2.2264e+03_r8,1.5767e+01_r8/) + kbo(:, 5,30,12) = (/ & + &9.4138e+03_r8,7.0606e+03_r8,4.7073e+03_r8,2.3541e+03_r8,1.5140e+01_r8/) + kbo(:, 1,31,12) = (/ & + &8.1459e+03_r8,6.1097e+03_r8,4.0735e+03_r8,2.0373e+03_r8,1.7334e+01_r8/) + kbo(:, 2,31,12) = (/ & + &8.6243e+03_r8,6.4685e+03_r8,4.3127e+03_r8,2.1569e+03_r8,1.7064e+01_r8/) + kbo(:, 3,31,12) = (/ & + &9.1518e+03_r8,6.8642e+03_r8,4.5764e+03_r8,2.2887e+03_r8,1.6609e+01_r8/) + kbo(:, 4,31,12) = (/ & + &9.7356e+03_r8,7.3019e+03_r8,4.8683e+03_r8,2.4346e+03_r8,1.5848e+01_r8/) + kbo(:, 5,31,12) = (/ & + &1.0365e+04_r8,7.7736e+03_r8,5.1827e+03_r8,2.5918e+03_r8,1.5376e+01_r8/) + kbo(:, 1,32,12) = (/ & + &8.9083e+03_r8,6.6815e+03_r8,4.4547e+03_r8,2.2279e+03_r8,1.7730e+01_r8/) + kbo(:, 2,32,12) = (/ & + &9.4979e+03_r8,7.1237e+03_r8,4.7495e+03_r8,2.3753e+03_r8,1.7331e+01_r8/) + kbo(:, 3,32,12) = (/ & + &1.0147e+04_r8,7.6108e+03_r8,5.0742e+03_r8,2.5376e+03_r8,1.6589e+01_r8/) + kbo(:, 4,32,12) = (/ & + &1.0867e+04_r8,8.1507e+03_r8,5.4341e+03_r8,2.7175e+03_r8,1.6156e+01_r8/) + kbo(:, 5,32,12) = (/ & + &1.1646e+04_r8,8.7350e+03_r8,5.8236e+03_r8,2.9122e+03_r8,1.5848e+01_r8/) + kbo(:, 1,33,12) = (/ & + &9.9979e+03_r8,7.4987e+03_r8,4.9995e+03_r8,2.5003e+03_r8,1.7989e+01_r8/) + kbo(:, 2,33,12) = (/ & + &1.0743e+04_r8,8.0578e+03_r8,5.3722e+03_r8,2.6866e+03_r8,1.7365e+01_r8/) + kbo(:, 3,33,12) = (/ & + &1.1568e+04_r8,8.6761e+03_r8,5.7844e+03_r8,2.8926e+03_r8,1.6901e+01_r8/) + kbo(:, 4,33,12) = (/ & + &1.2466e+04_r8,9.3497e+03_r8,6.2334e+03_r8,3.1171e+03_r8,1.6592e+01_r8/) + kbo(:, 5,33,12) = (/ & + &1.3441e+04_r8,1.0081e+04_r8,6.7208e+03_r8,3.3608e+03_r8,1.6160e+01_r8/) + kbo(:, 1,34,12) = (/ & + &1.1005e+04_r8,8.2543e+03_r8,5.5032e+03_r8,2.7521e+03_r8,1.8094e+01_r8/) + kbo(:, 2,34,12) = (/ & + &1.1925e+04_r8,8.9436e+03_r8,5.9627e+03_r8,2.9818e+03_r8,1.7503e+01_r8/) + kbo(:, 3,34,12) = (/ & + &1.2929e+04_r8,9.6970e+03_r8,6.4650e+03_r8,3.2329e+03_r8,1.7258e+01_r8/) + kbo(:, 4,34,12) = (/ & + &1.4013e+04_r8,1.0510e+04_r8,7.0067e+03_r8,3.5037e+03_r8,1.6964e+01_r8/) + kbo(:, 5,34,12) = (/ & + &1.5204e+04_r8,1.1403e+04_r8,7.6022e+03_r8,3.8015e+03_r8,1.6506e+01_r8/) + kbo(:, 1,35,12) = (/ & + &1.2135e+04_r8,9.1016e+03_r8,6.0680e+03_r8,3.0345e+03_r8,1.8232e+01_r8/) + kbo(:, 2,35,12) = (/ & + &1.3244e+04_r8,9.9331e+03_r8,6.6223e+03_r8,3.3116e+03_r8,1.7908e+01_r8/) + kbo(:, 3,35,12) = (/ & + &1.4457e+04_r8,1.0843e+04_r8,7.2288e+03_r8,3.6148e+03_r8,1.7659e+01_r8/) + kbo(:, 4,35,12) = (/ & + &1.5776e+04_r8,1.1833e+04_r8,7.8886e+03_r8,3.9447e+03_r8,1.7305e+01_r8/) + kbo(:, 5,35,12) = (/ & + &1.7218e+04_r8,1.2914e+04_r8,8.6094e+03_r8,4.3051e+03_r8,1.6889e+01_r8/) + kbo(:, 1,36,12) = (/ & + &1.3247e+04_r8,9.9356e+03_r8,6.6240e+03_r8,3.3125e+03_r8,1.8488e+01_r8/) + kbo(:, 2,36,12) = (/ & + &1.4560e+04_r8,1.0920e+04_r8,7.2802e+03_r8,3.6405e+03_r8,1.8270e+01_r8/) + kbo(:, 3,36,12) = (/ & + &1.6016e+04_r8,1.2012e+04_r8,8.0085e+03_r8,4.0046e+03_r8,1.8063e+01_r8/) + kbo(:, 4,36,12) = (/ & + &1.7602e+04_r8,1.3202e+04_r8,8.8012e+03_r8,4.4010e+03_r8,1.7553e+01_r8/) + kbo(:, 5,36,12) = (/ & + &1.9328e+04_r8,1.4496e+04_r8,9.6641e+03_r8,4.8324e+03_r8,1.7048e+01_r8/) + kbo(:, 1,37,12) = (/ & + &1.3952e+04_r8,1.0464e+04_r8,6.9765e+03_r8,3.4887e+03_r8,1.8801e+01_r8/) + kbo(:, 2,37,12) = (/ & + &1.5457e+04_r8,1.1593e+04_r8,7.7287e+03_r8,3.8648e+03_r8,1.8637e+01_r8/) + kbo(:, 3,37,12) = (/ & + &1.7141e+04_r8,1.2856e+04_r8,8.5707e+03_r8,4.2857e+03_r8,1.8420e+01_r8/) + kbo(:, 4,37,12) = (/ & + &1.8985e+04_r8,1.4239e+04_r8,9.4928e+03_r8,4.7467e+03_r8,1.7805e+01_r8/) + kbo(:, 5,37,12) = (/ & + &2.0966e+04_r8,1.5724e+04_r8,1.0483e+04_r8,5.2419e+03_r8,1.7343e+01_r8/) + kbo(:, 1,38,12) = (/ & + &1.4936e+04_r8,1.1202e+04_r8,7.4684e+03_r8,3.7346e+03_r8,1.9067e+01_r8/) + kbo(:, 2,38,12) = (/ & + &1.6693e+04_r8,1.2520e+04_r8,8.3467e+03_r8,4.1737e+03_r8,1.8968e+01_r8/) + kbo(:, 3,38,12) = (/ & + &1.8667e+04_r8,1.4000e+04_r8,9.3337e+03_r8,4.6672e+03_r8,1.8667e+01_r8/) + kbo(:, 4,38,12) = (/ & + &2.0838e+04_r8,1.5628e+04_r8,1.0419e+04_r8,5.2098e+03_r8,1.8090e+01_r8/) + kbo(:, 5,38,12) = (/ & + &2.3152e+04_r8,1.7364e+04_r8,1.1576e+04_r8,5.7883e+03_r8,1.7634e+01_r8/) + kbo(:, 1,39,12) = (/ & + &1.6411e+04_r8,1.2309e+04_r8,8.2062e+03_r8,4.1035e+03_r8,1.9362e+01_r8/) + kbo(:, 2,39,12) = (/ & + &1.8520e+04_r8,1.3890e+04_r8,9.2603e+03_r8,4.6305e+03_r8,1.9256e+01_r8/) + kbo(:, 3,39,12) = (/ & + &2.0878e+04_r8,1.5659e+04_r8,1.0439e+04_r8,5.2200e+03_r8,1.8842e+01_r8/) + kbo(:, 4,39,12) = (/ & + &2.3481e+04_r8,1.7611e+04_r8,1.1741e+04_r8,5.8709e+03_r8,1.8427e+01_r8/) + kbo(:, 5,39,12) = (/ & + &2.6258e+04_r8,1.9693e+04_r8,1.3129e+04_r8,6.5649e+03_r8,1.8005e+01_r8/) + kbo(:, 1,40,12) = (/ & + &1.6779e+04_r8,1.2584e+04_r8,8.3898e+03_r8,4.1952e+03_r8,1.9573e+01_r8/) + kbo(:, 2,40,12) = (/ & + &1.9118e+04_r8,1.4339e+04_r8,9.5593e+03_r8,4.7800e+03_r8,1.9496e+01_r8/) + kbo(:, 3,40,12) = (/ & + &2.1747e+04_r8,1.6310e+04_r8,1.0874e+04_r8,5.4372e+03_r8,1.9078e+01_r8/) + kbo(:, 4,40,12) = (/ & + &2.4641e+04_r8,1.8481e+04_r8,1.2321e+04_r8,6.1605e+03_r8,1.8680e+01_r8/) + kbo(:, 5,40,12) = (/ & + &2.7741e+04_r8,2.0806e+04_r8,1.3871e+04_r8,6.9356e+03_r8,1.8305e+01_r8/) + kbo(:, 1,41,12) = (/ & + &1.7108e+04_r8,1.2831e+04_r8,8.5543e+03_r8,4.2775e+03_r8,1.9752e+01_r8/) + kbo(:, 2,41,12) = (/ & + &1.9696e+04_r8,1.4772e+04_r8,9.8483e+03_r8,4.9245e+03_r8,1.9665e+01_r8/) + kbo(:, 3,41,12) = (/ & + &2.2603e+04_r8,1.6953e+04_r8,1.1302e+04_r8,5.6514e+03_r8,1.9347e+01_r8/) + kbo(:, 4,41,12) = (/ & + &2.5797e+04_r8,1.9348e+04_r8,1.2899e+04_r8,6.4497e+03_r8,1.8925e+01_r8/) + kbo(:, 5,41,12) = (/ & + &2.9237e+04_r8,2.1928e+04_r8,1.4619e+04_r8,7.3098e+03_r8,1.8587e+01_r8/) + kbo(:, 1,42,12) = (/ & + &1.7650e+04_r8,1.3238e+04_r8,8.8253e+03_r8,4.4130e+03_r8,1.9913e+01_r8/) + kbo(:, 2,42,12) = (/ & + &2.0552e+04_r8,1.5414e+04_r8,1.0276e+04_r8,5.1385e+03_r8,1.9817e+01_r8/) + kbo(:, 3,42,12) = (/ & + &2.3780e+04_r8,1.7835e+04_r8,1.1890e+04_r8,5.9455e+03_r8,1.9487e+01_r8/) + kbo(:, 4,42,12) = (/ & + &2.7331e+04_r8,2.0498e+04_r8,1.3666e+04_r8,6.8331e+03_r8,1.9141e+01_r8/) + kbo(:, 5,42,12) = (/ & + &3.1174e+04_r8,2.3380e+04_r8,1.5587e+04_r8,7.7938e+03_r8,1.8842e+01_r8/) + kbo(:, 1,43,12) = (/ & + &1.8226e+04_r8,1.3670e+04_r8,9.1135e+03_r8,4.5571e+03_r8,2.0107e+01_r8/) + kbo(:, 2,43,12) = (/ & + &2.1466e+04_r8,1.6100e+04_r8,1.0734e+04_r8,5.3672e+03_r8,1.9969e+01_r8/) + kbo(:, 3,43,12) = (/ & + &2.5067e+04_r8,1.8800e+04_r8,1.2534e+04_r8,6.2672e+03_r8,1.9715e+01_r8/) + kbo(:, 4,43,12) = (/ & + &2.9022e+04_r8,2.1767e+04_r8,1.4512e+04_r8,7.2561e+03_r8,1.9331e+01_r8/) + kbo(:, 5,43,12) = (/ & + &3.3314e+04_r8,2.4986e+04_r8,1.6658e+04_r8,8.3291e+03_r8,1.9158e+01_r8/) + kbo(:, 1,44,12) = (/ & + &1.9005e+04_r8,1.4254e+04_r8,9.5029e+03_r8,4.7518e+03_r8,2.0271e+01_r8/) + kbo(:, 2,44,12) = (/ & + &2.2627e+04_r8,1.6970e+04_r8,1.1314e+04_r8,5.6570e+03_r8,2.0045e+01_r8/) + kbo(:, 3,44,12) = (/ & + &2.6689e+04_r8,2.0017e+04_r8,1.3345e+04_r8,6.6725e+03_r8,1.9909e+01_r8/) + kbo(:, 4,44,12) = (/ & + &3.1132e+04_r8,2.3349e+04_r8,1.5566e+04_r8,7.7832e+03_r8,1.9596e+01_r8/) + kbo(:, 5,44,12) = (/ & + &3.5955e+04_r8,2.6966e+04_r8,1.7978e+04_r8,8.9890e+03_r8,1.9454e+01_r8/) + kbo(:, 1,45,12) = (/ & + &2.0230e+04_r8,1.5173e+04_r8,1.0115e+04_r8,5.0580e+03_r8,2.0360e+01_r8/) + kbo(:, 2,45,12) = (/ & + &2.4315e+04_r8,1.8237e+04_r8,1.2158e+04_r8,6.0793e+03_r8,2.0061e+01_r8/) + kbo(:, 3,45,12) = (/ & + &2.8985e+04_r8,2.1739e+04_r8,1.4493e+04_r8,7.2467e+03_r8,2.0123e+01_r8/) + kbo(:, 4,45,12) = (/ & + &3.4069e+04_r8,2.5552e+04_r8,1.7035e+04_r8,8.5176e+03_r8,1.9825e+01_r8/) + kbo(:, 5,45,12) = (/ & + &3.9583e+04_r8,2.9687e+04_r8,1.9792e+04_r8,9.8961e+03_r8,1.9819e+01_r8/) + kbo(:, 1,46,12) = (/ & + &2.1692e+04_r8,1.6269e+04_r8,1.0846e+04_r8,5.4233e+03_r8,2.0397e+01_r8/) + kbo(:, 2,46,12) = (/ & + &2.6275e+04_r8,1.9706e+04_r8,1.3138e+04_r8,6.5691e+03_r8,2.0140e+01_r8/) + kbo(:, 3,46,12) = (/ & + &3.1629e+04_r8,2.3722e+04_r8,1.5815e+04_r8,7.9076e+03_r8,2.0308e+01_r8/) + kbo(:, 4,46,12) = (/ & + &3.7518e+04_r8,2.8139e+04_r8,1.8759e+04_r8,9.3799e+03_r8,2.0045e+01_r8/) + kbo(:, 5,46,12) = (/ & + &4.3856e+04_r8,3.2892e+04_r8,2.1928e+04_r8,1.0964e+04_r8,2.0102e+01_r8/) + kbo(:, 1,47,12) = (/ & + &2.2886e+04_r8,1.7165e+04_r8,1.1443e+04_r8,5.7220e+03_r8,2.0376e+01_r8/) + kbo(:, 2,47,12) = (/ & + &2.7889e+04_r8,2.0917e+04_r8,1.3945e+04_r8,6.9727e+03_r8,2.0171e+01_r8/) + kbo(:, 3,47,12) = (/ & + &3.3867e+04_r8,2.5401e+04_r8,1.6934e+04_r8,8.4673e+03_r8,2.0409e+01_r8/) + kbo(:, 4,47,12) = (/ & + &4.0597e+04_r8,3.0448e+04_r8,2.0299e+04_r8,1.0150e+04_r8,2.0291e+01_r8/) + kbo(:, 5,47,12) = (/ & + &4.7822e+04_r8,3.5866e+04_r8,2.3911e+04_r8,1.1956e+04_r8,2.0384e+01_r8/) + kbo(:, 1,48,12) = (/ & + &2.4867e+04_r8,1.8651e+04_r8,1.2434e+04_r8,6.2173e+03_r8,2.0295e+01_r8/) + kbo(:, 2,48,12) = (/ & + &3.0432e+04_r8,2.2824e+04_r8,1.5216e+04_r8,7.6085e+03_r8,2.0270e+01_r8/) + kbo(:, 3,48,12) = (/ & + &3.7235e+04_r8,2.7926e+04_r8,1.8618e+04_r8,9.3091e+03_r8,2.0484e+01_r8/) + kbo(:, 4,48,12) = (/ & + &4.5063e+04_r8,3.3797e+04_r8,2.2532e+04_r8,1.1266e+04_r8,2.0580e+01_r8/) + kbo(:, 5,48,12) = (/ & + &5.3530e+04_r8,4.0148e+04_r8,2.6765e+04_r8,1.3383e+04_r8,2.0621e+01_r8/) + kbo(:, 1,49,12) = (/ & + &2.8095e+04_r8,2.1071e+04_r8,1.4048e+04_r8,7.0242e+03_r8,2.0197e+01_r8/) + kbo(:, 2,49,12) = (/ & + &3.4618e+04_r8,2.5963e+04_r8,1.7309e+04_r8,8.6547e+03_r8,2.0319e+01_r8/) + kbo(:, 3,49,12) = (/ & + &4.2591e+04_r8,3.1943e+04_r8,2.1296e+04_r8,1.0648e+04_r8,2.0559e+01_r8/) + kbo(:, 4,49,12) = (/ & + &5.1945e+04_r8,3.8959e+04_r8,2.5973e+04_r8,1.2987e+04_r8,2.0853e+01_r8/) + kbo(:, 5,49,12) = (/ & + &6.2325e+04_r8,4.6744e+04_r8,3.1163e+04_r8,1.5581e+04_r8,2.0890e+01_r8/) + kbo(:, 1,50,12) = (/ & + &3.0354e+04_r8,2.2766e+04_r8,1.5178e+04_r8,7.5891e+03_r8,2.0062e+01_r8/) + kbo(:, 2,50,12) = (/ & + &3.7734e+04_r8,2.8300e+04_r8,1.8867e+04_r8,9.4338e+03_r8,2.0363e+01_r8/) + kbo(:, 3,50,12) = (/ & + &4.6589e+04_r8,3.4942e+04_r8,2.3295e+04_r8,1.1648e+04_r8,2.0543e+01_r8/) + kbo(:, 4,50,12) = (/ & + &5.7214e+04_r8,4.2910e+04_r8,2.8607e+04_r8,1.4304e+04_r8,2.0993e+01_r8/) + kbo(:, 5,50,12) = (/ & + &6.9238e+04_r8,5.1929e+04_r8,3.4619e+04_r8,1.7310e+04_r8,2.1035e+01_r8/) + kbo(:, 1,51,12) = (/ & + &3.2115e+04_r8,2.4086e+04_r8,1.6058e+04_r8,8.0292e+03_r8,1.9809e+01_r8/) + kbo(:, 2,51,12) = (/ & + &4.0277e+04_r8,3.0208e+04_r8,2.0139e+04_r8,1.0070e+04_r8,2.0313e+01_r8/) + kbo(:, 3,51,12) = (/ & + &4.9958e+04_r8,3.7469e+04_r8,2.4979e+04_r8,1.2490e+04_r8,2.0455e+01_r8/) + kbo(:, 4,51,12) = (/ & + &6.1681e+04_r8,4.6261e+04_r8,3.0841e+04_r8,1.5421e+04_r8,2.0964e+01_r8/) + kbo(:, 5,51,12) = (/ & + &7.5206e+04_r8,5.6405e+04_r8,3.7603e+04_r8,1.8802e+04_r8,2.1060e+01_r8/) + kbo(:, 1,52,12) = (/ & + &3.4912e+04_r8,2.6184e+04_r8,1.7456e+04_r8,8.7285e+03_r8,1.9582e+01_r8/) + kbo(:, 2,52,12) = (/ & + &4.4146e+04_r8,3.3110e+04_r8,2.2073e+04_r8,1.1037e+04_r8,2.0163e+01_r8/) + kbo(:, 3,52,12) = (/ & + &5.5147e+04_r8,4.1361e+04_r8,2.7574e+04_r8,1.3787e+04_r8,2.0386e+01_r8/) + kbo(:, 4,52,12) = (/ & + &6.8326e+04_r8,5.1245e+04_r8,3.4163e+04_r8,1.7082e+04_r8,2.0999e+01_r8/) + kbo(:, 5,52,12) = (/ & + &8.3853e+04_r8,6.2890e+04_r8,4.1927e+04_r8,2.0964e+04_r8,2.1183e+01_r8/) + kbo(:, 1,53,12) = (/ & + &3.9402e+04_r8,2.9552e+04_r8,1.9702e+04_r8,9.8513e+03_r8,1.9267e+01_r8/) + kbo(:, 2,53,12) = (/ & + &5.0308e+04_r8,3.7732e+04_r8,2.5155e+04_r8,1.2578e+04_r8,1.9908e+01_r8/) + kbo(:, 3,53,12) = (/ & + &6.3383e+04_r8,4.7538e+04_r8,3.1692e+04_r8,1.5846e+04_r8,2.0279e+01_r8/) + kbo(:, 4,53,12) = (/ & + &7.8778e+04_r8,5.9084e+04_r8,3.9389e+04_r8,1.9695e+04_r8,2.1039e+01_r8/) + kbo(:, 5,53,12) = (/ & + &9.7229e+04_r8,7.2923e+04_r8,4.8615e+04_r8,2.4308e+04_r8,2.1293e+01_r8/) + kbo(:, 1,54,12) = (/ & + &3.8624e+04_r8,2.8968e+04_r8,1.9312e+04_r8,9.6566e+03_r8,1.8946e+01_r8/) + kbo(:, 2,54,12) = (/ & + &4.9869e+04_r8,3.7402e+04_r8,2.4935e+04_r8,1.2468e+04_r8,1.9724e+01_r8/) + kbo(:, 3,54,12) = (/ & + &6.3267e+04_r8,4.7450e+04_r8,3.1634e+04_r8,1.5817e+04_r8,2.0221e+01_r8/) + kbo(:, 4,54,12) = (/ & + &7.9005e+04_r8,5.9254e+04_r8,3.9503e+04_r8,1.9752e+04_r8,2.0891e+01_r8/) + kbo(:, 5,54,12) = (/ & + &9.7899e+04_r8,7.3425e+04_r8,4.8950e+04_r8,2.4475e+04_r8,2.1235e+01_r8/) + kbo(:, 1,55,12) = (/ & + &3.4504e+04_r8,2.5878e+04_r8,1.7253e+04_r8,8.6267e+03_r8,1.8561e+01_r8/) + kbo(:, 2,55,12) = (/ & + &4.5154e+04_r8,3.3866e+04_r8,2.2578e+04_r8,1.1289e+04_r8,1.9514e+01_r8/) + kbo(:, 3,55,12) = (/ & + &5.7700e+04_r8,4.3275e+04_r8,2.8850e+04_r8,1.4425e+04_r8,2.0143e+01_r8/) + kbo(:, 4,55,12) = (/ & + &7.2513e+04_r8,5.4385e+04_r8,3.6257e+04_r8,1.8129e+04_r8,2.0526e+01_r8/) + kbo(:, 5,55,12) = (/ & + &9.0097e+04_r8,6.7573e+04_r8,4.5049e+04_r8,2.2525e+04_r8,2.1145e+01_r8/) + kbo(:, 1,56,12) = (/ & + &3.0670e+04_r8,2.3003e+04_r8,1.5335e+04_r8,7.6681e+03_r8,1.8208e+01_r8/) + kbo(:, 2,56,12) = (/ & + &4.0775e+04_r8,3.0581e+04_r8,2.0388e+04_r8,1.0194e+04_r8,1.9345e+01_r8/) + kbo(:, 3,56,12) = (/ & + &5.2534e+04_r8,3.9401e+04_r8,2.6267e+04_r8,1.3134e+04_r8,1.9986e+01_r8/) + kbo(:, 4,56,12) = (/ & + &6.6490e+04_r8,4.9868e+04_r8,3.3245e+04_r8,1.6623e+04_r8,2.0300e+01_r8/) + kbo(:, 5,56,12) = (/ & + &8.2863e+04_r8,6.2147e+04_r8,4.1431e+04_r8,2.0716e+04_r8,2.0929e+01_r8/) + kbo(:, 1,57,12) = (/ & + &2.7134e+04_r8,2.0351e+04_r8,1.3567e+04_r8,6.7841e+03_r8,1.7766e+01_r8/) + kbo(:, 2,57,12) = (/ & + &3.6730e+04_r8,2.7547e+04_r8,1.8365e+04_r8,9.1827e+03_r8,1.8983e+01_r8/) + kbo(:, 3,57,12) = (/ & + &4.7798e+04_r8,3.5848e+04_r8,2.3899e+04_r8,1.1950e+04_r8,1.9837e+01_r8/) + kbo(:, 4,57,12) = (/ & + &6.0858e+04_r8,4.5644e+04_r8,3.0429e+04_r8,1.5215e+04_r8,2.0288e+01_r8/) + kbo(:, 5,57,12) = (/ & + &7.6170e+04_r8,5.7127e+04_r8,3.8085e+04_r8,1.9043e+04_r8,2.0539e+01_r8/) + kbo(:, 1,58,12) = (/ & + &6.3468e+03_r8,5.8191e+03_r8,4.9895e+03_r8,3.4949e+03_r8,1.7351e+01_r8/) + kbo(:, 2,58,12) = (/ & + &8.7238e+03_r8,7.9984e+03_r8,6.8580e+03_r8,4.8035e+03_r8,1.8673e+01_r8/) + kbo(:, 3,58,12) = (/ & + &1.1493e+04_r8,1.0537e+04_r8,9.0349e+03_r8,6.3281e+03_r8,1.9708e+01_r8/) + kbo(:, 4,58,12) = (/ & + &1.4729e+04_r8,1.3504e+04_r8,1.1579e+04_r8,8.1099e+03_r8,2.0210e+01_r8/) + kbo(:, 5,58,12) = (/ & + &1.8531e+04_r8,1.6990e+04_r8,1.4568e+04_r8,1.0203e+04_r8,2.0346e+01_r8/) + kbo(:, 1,59,12) = (/ & + &7.0593e+03_r8,6.1640e+03_r8,4.9170e+03_r8,3.0600e+03_r8,1.7147e+01_r8/) + kbo(:, 2,59,12) = (/ & + &9.7799e+03_r8,8.5396e+03_r8,6.8118e+03_r8,4.2390e+03_r8,1.8584e+01_r8/) + kbo(:, 3,59,12) = (/ & + &1.2964e+04_r8,1.1320e+04_r8,9.0293e+03_r8,5.6188e+03_r8,1.9434e+01_r8/) + kbo(:, 4,59,12) = (/ & + &1.6671e+04_r8,1.4556e+04_r8,1.1611e+04_r8,7.2253e+03_r8,2.0175e+01_r8/) + kbo(:, 5,59,12) = (/ & + &2.1035e+04_r8,1.8367e+04_r8,1.4651e+04_r8,9.1168e+03_r8,2.0516e+01_r8/) + kbo(:, 1,13,13) = (/ & + &3.8843e+05_r8,2.9132e+05_r8,1.9422e+05_r8,9.7109e+04_r8,5.4111e+00_r8/) + kbo(:, 2,13,13) = (/ & + &3.8116e+05_r8,2.8587e+05_r8,1.9058e+05_r8,9.5291e+04_r8,5.1021e+00_r8/) + kbo(:, 3,13,13) = (/ & + &3.7364e+05_r8,2.8023e+05_r8,1.8682e+05_r8,9.3410e+04_r8,4.8974e+00_r8/) + kbo(:, 4,13,13) = (/ & + &3.6551e+05_r8,2.7413e+05_r8,1.8276e+05_r8,9.1378e+04_r8,4.4934e+00_r8/) + kbo(:, 5,13,13) = (/ & + &3.5750e+05_r8,2.6813e+05_r8,1.7875e+05_r8,8.9377e+04_r8,3.9773e+00_r8/) + kbo(:, 1,14,13) = (/ & + &2.5525e+05_r8,1.9143e+05_r8,1.2762e+05_r8,6.3811e+04_r8,5.8071e+00_r8/) + kbo(:, 2,14,13) = (/ & + &2.5096e+05_r8,1.8822e+05_r8,1.2548e+05_r8,6.2740e+04_r8,5.6102e+00_r8/) + kbo(:, 3,14,13) = (/ & + &2.4685e+05_r8,1.8514e+05_r8,1.2343e+05_r8,6.1713e+04_r8,5.4048e+00_r8/) + kbo(:, 4,14,13) = (/ & + &2.4253e+05_r8,1.8190e+05_r8,1.2126e+05_r8,6.0632e+04_r8,5.2557e+00_r8/) + kbo(:, 5,14,13) = (/ & + &2.3845e+05_r8,1.7884e+05_r8,1.1922e+05_r8,5.9612e+04_r8,4.9044e+00_r8/) + kbo(:, 1,15,13) = (/ & + &1.7262e+05_r8,1.2947e+05_r8,8.6313e+04_r8,4.3157e+04_r8,6.3397e+00_r8/) + kbo(:, 2,15,13) = (/ & + &1.7029e+05_r8,1.2772e+05_r8,8.5146e+04_r8,4.2574e+04_r8,6.1559e+00_r8/) + kbo(:, 3,15,13) = (/ & + &1.6778e+05_r8,1.2583e+05_r8,8.3891e+04_r8,4.1946e+04_r8,5.9275e+00_r8/) + kbo(:, 4,15,13) = (/ & + &1.6564e+05_r8,1.2423e+05_r8,8.2824e+04_r8,4.1413e+04_r8,5.8142e+00_r8/) + kbo(:, 5,15,13) = (/ & + &1.6363e+05_r8,1.2273e+05_r8,8.1819e+04_r8,4.0910e+04_r8,5.6466e+00_r8/) + kbo(:, 1,16,13) = (/ & + &1.3945e+05_r8,1.0459e+05_r8,6.9724e+04_r8,3.4863e+04_r8,7.0725e+00_r8/) + kbo(:, 2,16,13) = (/ & + &1.3799e+05_r8,1.0349e+05_r8,6.8996e+04_r8,3.4499e+04_r8,6.9039e+00_r8/) + kbo(:, 3,16,13) = (/ & + &1.3667e+05_r8,1.0250e+05_r8,6.8336e+04_r8,3.4169e+04_r8,6.6526e+00_r8/) + kbo(:, 4,16,13) = (/ & + &1.3532e+05_r8,1.0149e+05_r8,6.7659e+04_r8,3.3830e+04_r8,6.5506e+00_r8/) + kbo(:, 5,16,13) = (/ & + &1.3401e+05_r8,1.0051e+05_r8,6.7008e+04_r8,3.3505e+04_r8,6.3946e+00_r8/) + kbo(:, 1,17,13) = (/ & + &1.1728e+05_r8,8.7962e+04_r8,5.8642e+04_r8,2.9322e+04_r8,7.9743e+00_r8/) + kbo(:, 2,17,13) = (/ & + &1.1635e+05_r8,8.7266e+04_r8,5.8178e+04_r8,2.9090e+04_r8,7.7873e+00_r8/) + kbo(:, 3,17,13) = (/ & + &1.1534e+05_r8,8.6504e+04_r8,5.7670e+04_r8,2.8835e+04_r8,7.5449e+00_r8/) + kbo(:, 4,17,13) = (/ & + &1.1432e+05_r8,8.5738e+04_r8,5.7159e+04_r8,2.8580e+04_r8,7.3894e+00_r8/) + kbo(:, 5,17,13) = (/ & + &1.1312e+05_r8,8.4838e+04_r8,5.6559e+04_r8,2.8280e+04_r8,7.2243e+00_r8/) + kbo(:, 1,18,13) = (/ & + &1.0020e+05_r8,7.5148e+04_r8,5.0099e+04_r8,2.5050e+04_r8,8.9803e+00_r8/) + kbo(:, 2,18,13) = (/ & + &9.9423e+04_r8,7.4567e+04_r8,4.9712e+04_r8,2.4856e+04_r8,8.7551e+00_r8/) + kbo(:, 3,18,13) = (/ & + &9.8635e+04_r8,7.3977e+04_r8,4.9318e+04_r8,2.4660e+04_r8,8.5049e+00_r8/) + kbo(:, 4,18,13) = (/ & + &9.7679e+04_r8,7.3260e+04_r8,4.8840e+04_r8,2.4421e+04_r8,8.3083e+00_r8/) + kbo(:, 5,18,13) = (/ & + &9.6616e+04_r8,7.2462e+04_r8,4.8308e+04_r8,2.4155e+04_r8,8.1253e+00_r8/) + kbo(:, 1,19,13) = (/ & + &8.3124e+04_r8,6.2343e+04_r8,4.1562e+04_r8,2.0782e+04_r8,1.0036e+01_r8/) + kbo(:, 2,19,13) = (/ & + &8.2434e+04_r8,6.1826e+04_r8,4.1217e+04_r8,2.0609e+04_r8,9.7882e+00_r8/) + kbo(:, 3,19,13) = (/ & + &8.1692e+04_r8,6.1269e+04_r8,4.0847e+04_r8,2.0424e+04_r8,9.5505e+00_r8/) + kbo(:, 4,19,13) = (/ & + &8.0821e+04_r8,6.0616e+04_r8,4.0411e+04_r8,2.0206e+04_r8,9.2995e+00_r8/) + kbo(:, 5,19,13) = (/ & + &7.9844e+04_r8,5.9883e+04_r8,3.9922e+04_r8,1.9962e+04_r8,9.1204e+00_r8/) + kbo(:, 1,20,13) = (/ & + &7.3434e+04_r8,5.5076e+04_r8,3.6717e+04_r8,1.8359e+04_r8,1.1173e+01_r8/) + kbo(:, 2,20,13) = (/ & + &7.2781e+04_r8,5.4586e+04_r8,3.6391e+04_r8,1.8196e+04_r8,1.0919e+01_r8/) + kbo(:, 3,20,13) = (/ & + &7.2073e+04_r8,5.4055e+04_r8,3.6037e+04_r8,1.8019e+04_r8,1.0676e+01_r8/) + kbo(:, 4,20,13) = (/ & + &7.1226e+04_r8,5.3419e+04_r8,3.5613e+04_r8,1.7807e+04_r8,1.0406e+01_r8/) + kbo(:, 5,20,13) = (/ & + &7.0326e+04_r8,5.2745e+04_r8,3.5164e+04_r8,1.7582e+04_r8,1.0205e+01_r8/) + kbo(:, 1,21,13) = (/ & + &6.5684e+04_r8,4.9263e+04_r8,3.2843e+04_r8,1.6422e+04_r8,1.2437e+01_r8/) + kbo(:, 2,21,13) = (/ & + &6.5060e+04_r8,4.8795e+04_r8,3.2531e+04_r8,1.6266e+04_r8,1.2175e+01_r8/) + kbo(:, 3,21,13) = (/ & + &6.4347e+04_r8,4.8261e+04_r8,3.2174e+04_r8,1.6088e+04_r8,1.1913e+01_r8/) + kbo(:, 4,21,13) = (/ & + &6.3551e+04_r8,4.7664e+04_r8,3.1776e+04_r8,1.5889e+04_r8,1.1602e+01_r8/) + kbo(:, 5,21,13) = (/ & + &6.2699e+04_r8,4.7025e+04_r8,3.1350e+04_r8,1.5676e+04_r8,1.1366e+01_r8/) + kbo(:, 1,22,13) = (/ & + &5.8992e+04_r8,4.4244e+04_r8,2.9497e+04_r8,1.4749e+04_r8,1.3817e+01_r8/) + kbo(:, 2,22,13) = (/ & + &5.8377e+04_r8,4.3783e+04_r8,2.9189e+04_r8,1.4595e+04_r8,1.3522e+01_r8/) + kbo(:, 3,22,13) = (/ & + &5.7726e+04_r8,4.3295e+04_r8,2.8863e+04_r8,1.4432e+04_r8,1.3217e+01_r8/) + kbo(:, 4,22,13) = (/ & + &5.7003e+04_r8,4.2753e+04_r8,2.8502e+04_r8,1.4252e+04_r8,1.2864e+01_r8/) + kbo(:, 5,22,13) = (/ & + &5.6242e+04_r8,4.2182e+04_r8,2.8121e+04_r8,1.4061e+04_r8,1.2581e+01_r8/) + kbo(:, 1,23,13) = (/ & + &5.2234e+04_r8,3.9176e+04_r8,2.6118e+04_r8,1.3059e+04_r8,1.5301e+01_r8/) + kbo(:, 2,23,13) = (/ & + &5.1719e+04_r8,3.8789e+04_r8,2.5860e+04_r8,1.2931e+04_r8,1.4943e+01_r8/) + kbo(:, 3,23,13) = (/ & + &5.1144e+04_r8,3.8358e+04_r8,2.5572e+04_r8,1.2787e+04_r8,1.4585e+01_r8/) + kbo(:, 4,23,13) = (/ & + &5.0530e+04_r8,3.7898e+04_r8,2.5266e+04_r8,1.2633e+04_r8,1.4170e+01_r8/) + kbo(:, 5,23,13) = (/ & + &4.9854e+04_r8,3.7391e+04_r8,2.4928e+04_r8,1.2464e+04_r8,1.3822e+01_r8/) + kbo(:, 1,24,13) = (/ & + &4.5231e+04_r8,3.3923e+04_r8,2.2616e+04_r8,1.1309e+04_r8,1.6829e+01_r8/) + kbo(:, 2,24,13) = (/ & + &4.4807e+04_r8,3.3606e+04_r8,2.2404e+04_r8,1.1203e+04_r8,1.6434e+01_r8/) + kbo(:, 3,24,13) = (/ & + &4.4319e+04_r8,3.3240e+04_r8,2.2160e+04_r8,1.1081e+04_r8,1.5981e+01_r8/) + kbo(:, 4,24,13) = (/ & + &4.3813e+04_r8,3.2860e+04_r8,2.1907e+04_r8,1.0954e+04_r8,1.5519e+01_r8/) + kbo(:, 5,24,13) = (/ & + &4.3229e+04_r8,3.2422e+04_r8,2.1615e+04_r8,1.0808e+04_r8,1.5118e+01_r8/) + kbo(:, 1,25,13) = (/ & + &3.9084e+04_r8,2.9314e+04_r8,1.9543e+04_r8,9.7719e+03_r8,1.8397e+01_r8/) + kbo(:, 2,25,13) = (/ & + &3.8734e+04_r8,2.9050e+04_r8,1.9367e+04_r8,9.6842e+03_r8,1.7930e+01_r8/) + kbo(:, 3,25,13) = (/ & + &3.8359e+04_r8,2.8770e+04_r8,1.9180e+04_r8,9.5907e+03_r8,1.7387e+01_r8/) + kbo(:, 4,25,13) = (/ & + &3.7930e+04_r8,2.8448e+04_r8,1.8965e+04_r8,9.4832e+03_r8,1.6873e+01_r8/) + kbo(:, 5,25,13) = (/ & + &3.7467e+04_r8,2.8100e+04_r8,1.8734e+04_r8,9.3675e+03_r8,1.6400e+01_r8/) + kbo(:, 1,26,13) = (/ & + &3.3890e+04_r8,2.5418e+04_r8,1.6946e+04_r8,8.4734e+03_r8,1.9920e+01_r8/) + kbo(:, 2,26,13) = (/ & + &3.3621e+04_r8,2.5216e+04_r8,1.6811e+04_r8,8.4060e+03_r8,1.9382e+01_r8/) + kbo(:, 3,26,13) = (/ & + &3.3332e+04_r8,2.4999e+04_r8,1.6667e+04_r8,8.3338e+03_r8,1.8740e+01_r8/) + kbo(:, 4,26,13) = (/ & + &3.3002e+04_r8,2.4752e+04_r8,1.6501e+04_r8,8.2512e+03_r8,1.8176e+01_r8/) + kbo(:, 5,26,13) = (/ & + &3.2656e+04_r8,2.4492e+04_r8,1.6328e+04_r8,8.1646e+03_r8,1.7620e+01_r8/) + kbo(:, 1,27,13) = (/ & + &3.0166e+04_r8,2.2624e+04_r8,1.5083e+04_r8,7.5423e+03_r8,2.1376e+01_r8/) + kbo(:, 2,27,13) = (/ & + &2.9996e+04_r8,2.2497e+04_r8,1.4998e+04_r8,7.4998e+03_r8,2.0763e+01_r8/) + kbo(:, 3,27,13) = (/ & + &2.9787e+04_r8,2.2341e+04_r8,1.4894e+04_r8,7.4476e+03_r8,2.0015e+01_r8/) + kbo(:, 4,27,13) = (/ & + &2.9581e+04_r8,2.2186e+04_r8,1.4791e+04_r8,7.3962e+03_r8,1.9407e+01_r8/) + kbo(:, 5,27,13) = (/ & + &2.9406e+04_r8,2.2055e+04_r8,1.4703e+04_r8,7.3522e+03_r8,1.8770e+01_r8/) + kbo(:, 1,28,13) = (/ & + &2.7326e+04_r8,2.0495e+04_r8,1.3664e+04_r8,6.8324e+03_r8,2.2732e+01_r8/) + kbo(:, 2,28,13) = (/ & + &2.7236e+04_r8,2.0428e+04_r8,1.3619e+04_r8,6.8100e+03_r8,2.2041e+01_r8/) + kbo(:, 3,28,13) = (/ & + &2.7174e+04_r8,2.0381e+04_r8,1.3588e+04_r8,6.7945e+03_r8,2.1170e+01_r8/) + kbo(:, 4,28,13) = (/ & + &2.7191e+04_r8,2.0394e+04_r8,1.3596e+04_r8,6.7985e+03_r8,2.0533e+01_r8/) + kbo(:, 5,28,13) = (/ & + &2.7306e+04_r8,2.0480e+04_r8,1.3654e+04_r8,6.8273e+03_r8,1.9803e+01_r8/) + kbo(:, 1,29,13) = (/ & + &2.6107e+04_r8,1.9580e+04_r8,1.3054e+04_r8,6.5276e+03_r8,2.3952e+01_r8/) + kbo(:, 2,29,13) = (/ & + &2.6178e+04_r8,1.9634e+04_r8,1.3090e+04_r8,6.5453e+03_r8,2.3128e+01_r8/) + kbo(:, 3,29,13) = (/ & + &2.6373e+04_r8,1.9780e+04_r8,1.3187e+04_r8,6.5941e+03_r8,2.2276e+01_r8/) + kbo(:, 4,29,13) = (/ & + &2.6674e+04_r8,2.0006e+04_r8,1.3338e+04_r8,6.6693e+03_r8,2.1526e+01_r8/) + kbo(:, 5,29,13) = (/ & + &2.7070e+04_r8,2.0303e+04_r8,1.3535e+04_r8,6.7681e+03_r8,2.0703e+01_r8/) + kbo(:, 1,30,13) = (/ & + &2.5565e+04_r8,1.9174e+04_r8,1.2783e+04_r8,6.3921e+03_r8,2.5015e+01_r8/) + kbo(:, 2,30,13) = (/ & + &2.5924e+04_r8,1.9443e+04_r8,1.2962e+04_r8,6.4818e+03_r8,2.4026e+01_r8/) + kbo(:, 3,30,13) = (/ & + &2.6425e+04_r8,1.9819e+04_r8,1.3213e+04_r8,6.6070e+03_r8,2.3238e+01_r8/) + kbo(:, 4,30,13) = (/ & + &2.7081e+04_r8,2.0311e+04_r8,1.3541e+04_r8,6.7710e+03_r8,2.2369e+01_r8/) + kbo(:, 5,30,13) = (/ & + &2.7860e+04_r8,2.0896e+04_r8,1.3931e+04_r8,6.9658e+03_r8,2.1263e+01_r8/) + kbo(:, 1,31,13) = (/ & + &2.6519e+04_r8,1.9890e+04_r8,1.3260e+04_r8,6.6306e+03_r8,2.5829e+01_r8/) + kbo(:, 2,31,13) = (/ & + &2.7266e+04_r8,2.0450e+04_r8,1.3634e+04_r8,6.8173e+03_r8,2.4917e+01_r8/) + kbo(:, 3,31,13) = (/ & + &2.8229e+04_r8,2.1172e+04_r8,1.4115e+04_r8,7.0579e+03_r8,2.4029e+01_r8/) + kbo(:, 4,31,13) = (/ & + &2.9353e+04_r8,2.2015e+04_r8,1.4677e+04_r8,7.3390e+03_r8,2.2989e+01_r8/) + kbo(:, 5,31,13) = (/ & + &3.0590e+04_r8,2.2943e+04_r8,1.5295e+04_r8,7.6481e+03_r8,2.1638e+01_r8/) + kbo(:, 1,32,13) = (/ & + &2.8188e+04_r8,2.1141e+04_r8,1.4095e+04_r8,7.0478e+03_r8,2.6468e+01_r8/) + kbo(:, 2,32,13) = (/ & + &2.9479e+04_r8,2.2110e+04_r8,1.4740e+04_r8,7.3705e+03_r8,2.5641e+01_r8/) + kbo(:, 3,32,13) = (/ & + &3.0998e+04_r8,2.3249e+04_r8,1.5500e+04_r8,7.7503e+03_r8,2.4646e+01_r8/) + kbo(:, 4,32,13) = (/ & + &3.2677e+04_r8,2.4508e+04_r8,1.6339e+04_r8,8.1700e+03_r8,2.3083e+01_r8/) + kbo(:, 5,32,13) = (/ & + &3.4456e+04_r8,2.5842e+04_r8,1.7228e+04_r8,8.6146e+03_r8,2.1888e+01_r8/) + kbo(:, 1,33,13) = (/ & + &3.1038e+04_r8,2.3278e+04_r8,1.5519e+04_r8,7.7602e+03_r8,2.7208e+01_r8/) + kbo(:, 2,33,13) = (/ & + &3.2999e+04_r8,2.4749e+04_r8,1.6500e+04_r8,8.2505e+03_r8,2.6145e+01_r8/) + kbo(:, 3,33,13) = (/ & + &3.5228e+04_r8,2.6421e+04_r8,1.7614e+04_r8,8.8077e+03_r8,2.4544e+01_r8/) + kbo(:, 4,33,13) = (/ & + &3.7600e+04_r8,2.8200e+04_r8,1.8800e+04_r8,9.4007e+03_r8,2.3159e+01_r8/) + kbo(:, 5,33,13) = (/ & + &4.0073e+04_r8,3.0055e+04_r8,2.0037e+04_r8,1.0019e+04_r8,2.2387e+01_r8/) + kbo(:, 1,34,13) = (/ & + &3.3858e+04_r8,2.5394e+04_r8,1.6930e+04_r8,8.4653e+03_r8,2.7625e+01_r8/) + kbo(:, 2,34,13) = (/ & + &3.6566e+04_r8,2.7425e+04_r8,1.8284e+04_r8,9.1422e+03_r8,2.6243e+01_r8/) + kbo(:, 3,34,13) = (/ & + &3.9555e+04_r8,2.9666e+04_r8,1.9778e+04_r8,9.8893e+03_r8,2.4430e+01_r8/) + kbo(:, 4,34,13) = (/ & + &4.2704e+04_r8,3.2028e+04_r8,2.1352e+04_r8,1.0677e+04_r8,2.3679e+01_r8/) + kbo(:, 5,34,13) = (/ & + &4.5894e+04_r8,3.4420e+04_r8,2.2947e+04_r8,1.1474e+04_r8,2.2773e+01_r8/) + kbo(:, 1,35,13) = (/ & + &3.7312e+04_r8,2.7984e+04_r8,1.8657e+04_r8,9.3288e+03_r8,2.7942e+01_r8/) + kbo(:, 2,35,13) = (/ & + &4.0881e+04_r8,3.0661e+04_r8,2.0441e+04_r8,1.0221e+04_r8,2.6106e+01_r8/) + kbo(:, 3,35,13) = (/ & + &4.4738e+04_r8,3.3554e+04_r8,2.2369e+04_r8,1.1185e+04_r8,2.5080e+01_r8/) + kbo(:, 4,35,13) = (/ & + &4.8754e+04_r8,3.6566e+04_r8,2.4377e+04_r8,1.2189e+04_r8,2.4179e+01_r8/) + kbo(:, 5,35,13) = (/ & + &5.2762e+04_r8,3.9572e+04_r8,2.6381e+04_r8,1.3191e+04_r8,2.3224e+01_r8/) + kbo(:, 1,36,13) = (/ & + &4.0999e+04_r8,3.0749e+04_r8,2.0500e+04_r8,1.0250e+04_r8,2.8213e+01_r8/) + kbo(:, 2,36,13) = (/ & + &4.5493e+04_r8,3.4120e+04_r8,2.2747e+04_r8,1.1374e+04_r8,2.6516e+01_r8/) + kbo(:, 3,36,13) = (/ & + &5.0302e+04_r8,3.7726e+04_r8,2.5151e+04_r8,1.2576e+04_r8,2.5690e+01_r8/) + kbo(:, 4,36,13) = (/ & + &5.5257e+04_r8,4.1443e+04_r8,2.7629e+04_r8,1.3815e+04_r8,2.4819e+01_r8/) + kbo(:, 5,36,13) = (/ & + &6.0175e+04_r8,4.5131e+04_r8,3.0088e+04_r8,1.5044e+04_r8,2.3837e+01_r8/) + kbo(:, 1,37,13) = (/ & + &4.3597e+04_r8,3.2698e+04_r8,2.1799e+04_r8,1.0900e+04_r8,2.8678e+01_r8/) + kbo(:, 2,37,13) = (/ & + &4.8963e+04_r8,3.6723e+04_r8,2.4482e+04_r8,1.2241e+04_r8,2.7079e+01_r8/) + kbo(:, 3,37,13) = (/ & + &5.4655e+04_r8,4.0991e+04_r8,2.7328e+04_r8,1.3664e+04_r8,2.6274e+01_r8/) + kbo(:, 4,37,13) = (/ & + &6.0506e+04_r8,4.5380e+04_r8,3.0253e+04_r8,1.5127e+04_r8,2.5504e+01_r8/) + kbo(:, 5,37,13) = (/ & + &6.6353e+04_r8,4.9765e+04_r8,3.3177e+04_r8,1.6589e+04_r8,2.4385e+01_r8/) + kbo(:, 1,38,13) = (/ & + &4.7296e+04_r8,3.5472e+04_r8,2.3648e+04_r8,1.1825e+04_r8,2.9114e+01_r8/) + kbo(:, 2,38,13) = (/ & + &5.3691e+04_r8,4.0269e+04_r8,2.6846e+04_r8,1.3423e+04_r8,2.7730e+01_r8/) + kbo(:, 3,38,13) = (/ & + &6.0448e+04_r8,4.5336e+04_r8,3.0224e+04_r8,1.5113e+04_r8,2.6995e+01_r8/) + kbo(:, 4,38,13) = (/ & + &6.7408e+04_r8,5.0556e+04_r8,3.3704e+04_r8,1.6852e+04_r8,2.6164e+01_r8/) + kbo(:, 5,38,13) = (/ & + &7.4361e+04_r8,5.5771e+04_r8,3.7181e+04_r8,1.8591e+04_r8,2.5025e+01_r8/) + kbo(:, 1,39,13) = (/ & + &5.2787e+04_r8,3.9591e+04_r8,2.6394e+04_r8,1.3198e+04_r8,2.9543e+01_r8/) + kbo(:, 2,39,13) = (/ & + &6.0481e+04_r8,4.5362e+04_r8,3.0242e+04_r8,1.5121e+04_r8,2.8398e+01_r8/) + kbo(:, 3,39,13) = (/ & + &6.8644e+04_r8,5.1483e+04_r8,3.4323e+04_r8,1.7162e+04_r8,2.7686e+01_r8/) + kbo(:, 4,39,13) = (/ & + &7.7024e+04_r8,5.7768e+04_r8,3.8513e+04_r8,1.9257e+04_r8,2.6627e+01_r8/) + kbo(:, 5,39,13) = (/ & + &8.5404e+04_r8,6.4053e+04_r8,4.2703e+04_r8,2.1352e+04_r8,2.5499e+01_r8/) + kbo(:, 1,40,13) = (/ & + &5.4787e+04_r8,4.1090e+04_r8,2.7394e+04_r8,1.3697e+04_r8,3.0183e+01_r8/) + kbo(:, 2,40,13) = (/ & + &6.3323e+04_r8,4.7492e+04_r8,3.1662e+04_r8,1.5831e+04_r8,2.8961e+01_r8/) + kbo(:, 3,40,13) = (/ & + &7.2463e+04_r8,5.4348e+04_r8,3.6232e+04_r8,1.8116e+04_r8,2.8295e+01_r8/) + kbo(:, 4,40,13) = (/ & + &8.1867e+04_r8,6.1400e+04_r8,4.0933e+04_r8,2.0467e+04_r8,2.7184e+01_r8/) + kbo(:, 5,40,13) = (/ & + &9.1325e+04_r8,6.8494e+04_r8,4.5663e+04_r8,2.2832e+04_r8,2.5988e+01_r8/) + kbo(:, 1,41,13) = (/ & + &5.6764e+04_r8,4.2573e+04_r8,2.8383e+04_r8,1.4192e+04_r8,3.0791e+01_r8/) + kbo(:, 2,41,13) = (/ & + &6.6130e+04_r8,4.9598e+04_r8,3.3066e+04_r8,1.6533e+04_r8,2.9538e+01_r8/) + kbo(:, 3,41,13) = (/ & + &7.6243e+04_r8,5.7183e+04_r8,3.8122e+04_r8,1.9062e+04_r8,2.8774e+01_r8/) + kbo(:, 4,41,13) = (/ & + &8.6738e+04_r8,6.5054e+04_r8,4.3370e+04_r8,2.1685e+04_r8,2.7771e+01_r8/) + kbo(:, 5,41,13) = (/ & + &9.7338e+04_r8,7.3004e+04_r8,4.8670e+04_r8,2.4335e+04_r8,2.6481e+01_r8/) + kbo(:, 1,42,13) = (/ & + &5.9574e+04_r8,4.4680e+04_r8,2.9787e+04_r8,1.4894e+04_r8,3.1338e+01_r8/) + kbo(:, 2,42,13) = (/ & + &6.9874e+04_r8,5.2405e+04_r8,3.4937e+04_r8,1.7469e+04_r8,3.0066e+01_r8/) + kbo(:, 3,42,13) = (/ & + &8.1118e+04_r8,6.0839e+04_r8,4.0559e+04_r8,2.0280e+04_r8,2.9330e+01_r8/) + kbo(:, 4,42,13) = (/ & + &9.2915e+04_r8,6.9686e+04_r8,4.6457e+04_r8,2.3229e+04_r8,2.8281e+01_r8/) + kbo(:, 5,42,13) = (/ & + &1.0485e+05_r8,7.8636e+04_r8,5.2424e+04_r8,2.6212e+04_r8,2.6956e+01_r8/) + kbo(:, 1,43,13) = (/ & + &6.2565e+04_r8,4.6924e+04_r8,3.1283e+04_r8,1.5642e+04_r8,3.1947e+01_r8/) + kbo(:, 2,43,13) = (/ & + &7.3881e+04_r8,5.5411e+04_r8,3.6941e+04_r8,1.8471e+04_r8,3.0710e+01_r8/) + kbo(:, 3,43,13) = (/ & + &8.6376e+04_r8,6.4783e+04_r8,4.3189e+04_r8,2.1595e+04_r8,2.9823e+01_r8/) + kbo(:, 4,43,13) = (/ & + &9.9633e+04_r8,7.4725e+04_r8,4.9817e+04_r8,2.4909e+04_r8,2.8916e+01_r8/) + kbo(:, 5,43,13) = (/ & + &1.1317e+05_r8,8.4879e+04_r8,5.6586e+04_r8,2.8294e+04_r8,2.7433e+01_r8/) + kbo(:, 1,44,13) = (/ & + &6.6377e+04_r8,4.9783e+04_r8,3.3188e+04_r8,1.6595e+04_r8,3.2537e+01_r8/) + kbo(:, 2,44,13) = (/ & + &7.8875e+04_r8,5.9156e+04_r8,3.9437e+04_r8,1.9719e+04_r8,3.1463e+01_r8/) + kbo(:, 3,44,13) = (/ & + &9.2826e+04_r8,6.9619e+04_r8,4.6413e+04_r8,2.3207e+04_r8,3.0339e+01_r8/) + kbo(:, 4,44,13) = (/ & + &1.0782e+05_r8,8.0864e+04_r8,5.3909e+04_r8,2.6955e+04_r8,2.9519e+01_r8/) + kbo(:, 5,44,13) = (/ & + &1.2335e+05_r8,9.2508e+04_r8,6.1672e+04_r8,3.0836e+04_r8,2.7886e+01_r8/) + kbo(:, 1,45,13) = (/ & + &7.1874e+04_r8,5.3905e+04_r8,3.5937e+04_r8,1.7969e+04_r8,3.3146e+01_r8/) + kbo(:, 2,45,13) = (/ & + &8.5887e+04_r8,6.4415e+04_r8,4.2944e+04_r8,2.1472e+04_r8,3.2123e+01_r8/) + kbo(:, 3,45,13) = (/ & + &1.0168e+05_r8,7.6262e+04_r8,5.0841e+04_r8,2.5421e+04_r8,3.0727e+01_r8/) + kbo(:, 4,45,13) = (/ & + &1.1891e+05_r8,8.9181e+04_r8,5.9454e+04_r8,2.9727e+04_r8,3.0052e+01_r8/) + kbo(:, 5,45,13) = (/ & + &1.3695e+05_r8,1.0272e+05_r8,6.8477e+04_r8,3.4239e+04_r8,2.8423e+01_r8/) + kbo(:, 1,46,13) = (/ & + &7.8328e+04_r8,5.8747e+04_r8,3.9165e+04_r8,1.9583e+04_r8,3.3800e+01_r8/) + kbo(:, 2,46,13) = (/ & + &9.4082e+04_r8,7.0562e+04_r8,4.7041e+04_r8,2.3521e+04_r8,3.2751e+01_r8/) + kbo(:, 3,46,13) = (/ & + &1.1205e+05_r8,8.4041e+04_r8,5.6028e+04_r8,2.8014e+04_r8,3.1210e+01_r8/) + kbo(:, 4,46,13) = (/ & + &1.3188e+05_r8,9.8910e+04_r8,6.5940e+04_r8,3.2971e+04_r8,3.0670e+01_r8/) + kbo(:, 5,46,13) = (/ & + &1.5296e+05_r8,1.1472e+05_r8,7.6478e+04_r8,3.8239e+04_r8,2.9020e+01_r8/) + kbo(:, 1,47,13) = (/ & + &8.3810e+04_r8,6.2858e+04_r8,4.1906e+04_r8,2.0953e+04_r8,3.4456e+01_r8/) + kbo(:, 2,47,13) = (/ & + &1.0129e+05_r8,7.5968e+04_r8,5.0646e+04_r8,2.5323e+04_r8,3.3326e+01_r8/) + kbo(:, 3,47,13) = (/ & + &1.2133e+05_r8,9.0998e+04_r8,6.0666e+04_r8,3.0333e+04_r8,3.1897e+01_r8/) + kbo(:, 4,47,13) = (/ & + &1.4374e+05_r8,1.0781e+05_r8,7.1871e+04_r8,3.5936e+04_r8,3.1165e+01_r8/) + kbo(:, 5,47,13) = (/ & + &1.6790e+05_r8,1.2593e+05_r8,8.3952e+04_r8,4.1976e+04_r8,2.9653e+01_r8/) + kbo(:, 1,48,13) = (/ & + &9.2009e+04_r8,6.9007e+04_r8,4.6005e+04_r8,2.3003e+04_r8,3.5004e+01_r8/) + kbo(:, 2,48,13) = (/ & + &1.1207e+05_r8,8.4051e+04_r8,5.6034e+04_r8,2.8018e+04_r8,3.3918e+01_r8/) + kbo(:, 3,48,13) = (/ & + &1.3494e+05_r8,1.0121e+05_r8,6.7471e+04_r8,3.3736e+04_r8,3.2425e+01_r8/) + kbo(:, 4,48,13) = (/ & + &1.6083e+05_r8,1.2063e+05_r8,8.0418e+04_r8,4.0210e+04_r8,3.1652e+01_r8/) + kbo(:, 5,48,13) = (/ & + &1.8920e+05_r8,1.4190e+05_r8,9.4599e+04_r8,4.7300e+04_r8,3.0396e+01_r8/) + kbo(:, 1,49,13) = (/ & + &1.0515e+05_r8,7.8866e+04_r8,5.2577e+04_r8,2.6289e+04_r8,3.5598e+01_r8/) + kbo(:, 2,49,13) = (/ & + &1.2899e+05_r8,9.6745e+04_r8,6.4497e+04_r8,3.2249e+04_r8,3.4541e+01_r8/) + kbo(:, 3,49,13) = (/ & + &1.5618e+05_r8,1.1714e+05_r8,7.8092e+04_r8,3.9046e+04_r8,3.3166e+01_r8/) + kbo(:, 4,49,13) = (/ & + &1.8721e+05_r8,1.4041e+05_r8,9.3606e+04_r8,4.6803e+04_r8,3.2127e+01_r8/) + kbo(:, 5,49,13) = (/ & + &2.2166e+05_r8,1.6624e+05_r8,1.1083e+05_r8,5.5414e+04_r8,3.1114e+01_r8/) + kbo(:, 1,50,13) = (/ & + &1.1492e+05_r8,8.6190e+04_r8,5.7460e+04_r8,2.8730e+04_r8,3.5920e+01_r8/) + kbo(:, 2,50,13) = (/ & + &1.4177e+05_r8,1.0633e+05_r8,7.0884e+04_r8,3.5442e+04_r8,3.5009e+01_r8/) + kbo(:, 3,50,13) = (/ & + &1.7284e+05_r8,1.2963e+05_r8,8.6422e+04_r8,4.3212e+04_r8,3.3840e+01_r8/) + kbo(:, 4,50,13) = (/ & + &2.0816e+05_r8,1.5612e+05_r8,1.0408e+05_r8,5.2042e+04_r8,3.2614e+01_r8/) + kbo(:, 5,50,13) = (/ & + &2.4789e+05_r8,1.8591e+05_r8,1.2394e+05_r8,6.1972e+04_r8,3.1787e+01_r8/) + kbo(:, 1,51,13) = (/ & + &1.2316e+05_r8,9.2372e+04_r8,6.1582e+04_r8,3.0791e+04_r8,3.6248e+01_r8/) + kbo(:, 2,51,13) = (/ & + &1.5257e+05_r8,1.1443e+05_r8,7.6284e+04_r8,3.8142e+04_r8,3.5464e+01_r8/) + kbo(:, 3,51,13) = (/ & + &1.8735e+05_r8,1.4051e+05_r8,9.3677e+04_r8,4.6839e+04_r8,3.4431e+01_r8/) + kbo(:, 4,51,13) = (/ & + &2.2663e+05_r8,1.6997e+05_r8,1.1332e+05_r8,5.6659e+04_r8,3.2971e+01_r8/) + kbo(:, 5,51,13) = (/ & + &2.7128e+05_r8,2.0346e+05_r8,1.3564e+05_r8,6.7820e+04_r8,3.2477e+01_r8/) + kbo(:, 1,52,13) = (/ & + &1.3564e+05_r8,1.0173e+05_r8,6.7822e+04_r8,3.3911e+04_r8,3.6511e+01_r8/) + kbo(:, 2,52,13) = (/ & + &1.6873e+05_r8,1.2655e+05_r8,8.4367e+04_r8,4.2184e+04_r8,3.5955e+01_r8/) + kbo(:, 3,52,13) = (/ & + &2.0841e+05_r8,1.5631e+05_r8,1.0421e+05_r8,5.2104e+04_r8,3.4988e+01_r8/) + kbo(:, 4,52,13) = (/ & + &2.5356e+05_r8,1.9017e+05_r8,1.2678e+05_r8,6.3390e+04_r8,3.3412e+01_r8/) + kbo(:, 5,52,13) = (/ & + &3.0501e+05_r8,2.2876e+05_r8,1.5250e+05_r8,7.6253e+04_r8,3.3108e+01_r8/) + kbo(:, 1,53,13) = (/ & + &1.5552e+05_r8,1.1664e+05_r8,7.7762e+04_r8,3.8882e+04_r8,3.6856e+01_r8/) + kbo(:, 2,53,13) = (/ & + &1.9425e+05_r8,1.4569e+05_r8,9.7128e+04_r8,4.8565e+04_r8,3.6432e+01_r8/) + kbo(:, 3,53,13) = (/ & + &2.4103e+05_r8,1.8077e+05_r8,1.2051e+05_r8,6.0258e+04_r8,3.5535e+01_r8/) + kbo(:, 4,53,13) = (/ & + &2.9532e+05_r8,2.2149e+05_r8,1.4766e+05_r8,7.3832e+04_r8,3.3878e+01_r8/) + kbo(:, 5,53,13) = (/ & + &3.5673e+05_r8,2.6755e+05_r8,1.7837e+05_r8,8.9184e+04_r8,3.3830e+01_r8/) + kbo(:, 1,54,13) = (/ & + &1.5519e+05_r8,1.1639e+05_r8,7.7595e+04_r8,3.8798e+04_r8,3.7137e+01_r8/) + kbo(:, 2,54,13) = (/ & + &1.9455e+05_r8,1.4591e+05_r8,9.7277e+04_r8,4.8639e+04_r8,3.6719e+01_r8/) + kbo(:, 3,54,13) = (/ & + &2.4223e+05_r8,1.8167e+05_r8,1.2111e+05_r8,6.0558e+04_r8,3.5737e+01_r8/) + kbo(:, 4,54,13) = (/ & + &2.9863e+05_r8,2.2398e+05_r8,1.4932e+05_r8,7.4660e+04_r8,3.4182e+01_r8/) + kbo(:, 5,54,13) = (/ & + &3.6225e+05_r8,2.7169e+05_r8,1.8113e+05_r8,9.0564e+04_r8,3.4090e+01_r8/) + kbo(:, 1,55,13) = (/ & + &1.4179e+05_r8,1.0634e+05_r8,7.0895e+04_r8,3.5448e+04_r8,3.7500e+01_r8/) + kbo(:, 2,55,13) = (/ & + &1.7805e+05_r8,1.3354e+05_r8,8.9025e+04_r8,4.4513e+04_r8,3.6673e+01_r8/) + kbo(:, 3,55,13) = (/ & + &2.2250e+05_r8,1.6688e+05_r8,1.1125e+05_r8,5.5626e+04_r8,3.6002e+01_r8/) + kbo(:, 4,55,13) = (/ & + &2.7565e+05_r8,2.0674e+05_r8,1.3783e+05_r8,6.8913e+04_r8,3.4967e+01_r8/) + kbo(:, 5,55,13) = (/ & + &3.3613e+05_r8,2.5210e+05_r8,1.6807e+05_r8,8.4034e+04_r8,3.3605e+01_r8/) + kbo(:, 1,56,13) = (/ & + &1.2955e+05_r8,9.7160e+04_r8,6.4773e+04_r8,3.2387e+04_r8,3.7592e+01_r8/) + kbo(:, 2,56,13) = (/ & + &1.6291e+05_r8,1.2218e+05_r8,8.1452e+04_r8,4.0726e+04_r8,3.6892e+01_r8/) + kbo(:, 3,56,13) = (/ & + &2.0430e+05_r8,1.5322e+05_r8,1.0215e+05_r8,5.1074e+04_r8,3.6401e+01_r8/) + kbo(:, 4,56,13) = (/ & + &2.5407e+05_r8,1.9055e+05_r8,1.2704e+05_r8,6.3518e+04_r8,3.5416e+01_r8/) + kbo(:, 5,56,13) = (/ & + &3.1173e+05_r8,2.3380e+05_r8,1.5586e+05_r8,7.7932e+04_r8,3.3725e+01_r8/) + kbo(:, 1,57,13) = (/ & + &1.1844e+05_r8,8.8830e+04_r8,5.9220e+04_r8,2.9610e+04_r8,3.7590e+01_r8/) + kbo(:, 2,57,13) = (/ & + &1.4902e+05_r8,1.1176e+05_r8,7.4508e+04_r8,3.7254e+04_r8,3.7340e+01_r8/) + kbo(:, 3,57,13) = (/ & + &1.8747e+05_r8,1.4060e+05_r8,9.3736e+04_r8,4.6868e+04_r8,3.6437e+01_r8/) + kbo(:, 4,57,13) = (/ & + &2.3395e+05_r8,1.7546e+05_r8,1.1697e+05_r8,5.8487e+04_r8,3.5598e+01_r8/) + kbo(:, 5,57,13) = (/ & + &2.8870e+05_r8,2.1653e+05_r8,1.4435e+05_r8,7.2175e+04_r8,3.4562e+01_r8/) + kbo(:, 1,58,13) = (/ & + &2.8654e+04_r8,2.6272e+04_r8,2.2526e+04_r8,1.5777e+04_r8,3.7286e+01_r8/) + kbo(:, 2,58,13) = (/ & + &3.6090e+04_r8,3.3089e+04_r8,2.8371e+04_r8,1.9871e+04_r8,3.7547e+01_r8/) + kbo(:, 3,58,13) = (/ & + &4.5492e+04_r8,4.1710e+04_r8,3.5762e+04_r8,2.5048e+04_r8,3.6650e+01_r8/) + kbo(:, 4,58,13) = (/ & + &5.6953e+04_r8,5.2217e+04_r8,4.4772e+04_r8,3.1358e+04_r8,3.6005e+01_r8/) + kbo(:, 5,58,13) = (/ & + &7.0617e+04_r8,6.4745e+04_r8,5.5513e+04_r8,3.8881e+04_r8,3.4983e+01_r8/) + kbo(:, 1,59,13) = (/ & + &3.2425e+04_r8,2.8312e+04_r8,2.2583e+04_r8,1.4053e+04_r8,3.7337e+01_r8/) + kbo(:, 2,59,13) = (/ & + &4.0874e+04_r8,3.5689e+04_r8,2.8468e+04_r8,1.7715e+04_r8,3.7354e+01_r8/) + kbo(:, 3,59,13) = (/ & + &5.1569e+04_r8,4.5029e+04_r8,3.5917e+04_r8,2.2350e+04_r8,3.7146e+01_r8/) + kbo(:, 4,59,13) = (/ & + &6.4659e+04_r8,5.6458e+04_r8,4.5034e+04_r8,2.8023e+04_r8,3.5794e+01_r8/) + kbo(:, 5,59,13) = (/ & + &8.0312e+04_r8,7.0125e+04_r8,5.5936e+04_r8,3.4807e+04_r8,3.4858e+01_r8/) + kbo(:, 1,13,14) = (/ & + &5.5354e+05_r8,4.1516e+05_r8,2.7677e+05_r8,1.3839e+05_r8,6.6359e+00_r8/) + kbo(:, 2,13,14) = (/ & + &5.3662e+05_r8,4.0247e+05_r8,2.6831e+05_r8,1.3416e+05_r8,6.3521e+00_r8/) + kbo(:, 3,13,14) = (/ & + &5.2321e+05_r8,3.9241e+05_r8,2.6161e+05_r8,1.3080e+05_r8,6.1777e+00_r8/) + kbo(:, 4,13,14) = (/ & + &5.1223e+05_r8,3.8417e+05_r8,2.5612e+05_r8,1.2806e+05_r8,5.8113e+00_r8/) + kbo(:, 5,13,14) = (/ & + &5.0254e+05_r8,3.7690e+05_r8,2.5127e+05_r8,1.2564e+05_r8,5.1461e+00_r8/) + kbo(:, 1,14,14) = (/ & + &3.6531e+05_r8,2.7398e+05_r8,1.8265e+05_r8,9.1327e+04_r8,7.3146e+00_r8/) + kbo(:, 2,14,14) = (/ & + &3.5777e+05_r8,2.6833e+05_r8,1.7888e+05_r8,8.9442e+04_r8,7.0661e+00_r8/) + kbo(:, 3,14,14) = (/ & + &3.5166e+05_r8,2.6375e+05_r8,1.7583e+05_r8,8.7915e+04_r8,6.6597e+00_r8/) + kbo(:, 4,14,14) = (/ & + &3.4675e+05_r8,2.6006e+05_r8,1.7337e+05_r8,8.6687e+04_r8,6.5607e+00_r8/) + kbo(:, 5,14,14) = (/ & + &3.4224e+05_r8,2.5668e+05_r8,1.7112e+05_r8,8.5559e+04_r8,6.0728e+00_r8/) + kbo(:, 1,15,14) = (/ & + &2.5038e+05_r8,1.8779e+05_r8,1.2519e+05_r8,6.2598e+04_r8,8.1437e+00_r8/) + kbo(:, 2,15,14) = (/ & + &2.4740e+05_r8,1.8555e+05_r8,1.2370e+05_r8,6.1853e+04_r8,7.8645e+00_r8/) + kbo(:, 3,15,14) = (/ & + &2.4508e+05_r8,1.8381e+05_r8,1.2254e+05_r8,6.1272e+04_r8,7.4907e+00_r8/) + kbo(:, 4,15,14) = (/ & + &2.4271e+05_r8,1.8203e+05_r8,1.2136e+05_r8,6.0680e+04_r8,7.2641e+00_r8/) + kbo(:, 5,15,14) = (/ & + &2.4052e+05_r8,1.8039e+05_r8,1.2026e+05_r8,6.0131e+04_r8,7.0682e+00_r8/) + kbo(:, 1,16,14) = (/ & + &2.0782e+05_r8,1.5587e+05_r8,1.0391e+05_r8,5.1957e+04_r8,9.0703e+00_r8/) + kbo(:, 2,16,14) = (/ & + &2.0661e+05_r8,1.5496e+05_r8,1.0331e+05_r8,5.1654e+04_r8,8.7622e+00_r8/) + kbo(:, 3,16,14) = (/ & + &2.0513e+05_r8,1.5385e+05_r8,1.0257e+05_r8,5.1284e+04_r8,8.4635e+00_r8/) + kbo(:, 4,16,14) = (/ & + &2.0374e+05_r8,1.5280e+05_r8,1.0187e+05_r8,5.0936e+04_r8,8.1015e+00_r8/) + kbo(:, 5,16,14) = (/ & + &2.0191e+05_r8,1.5143e+05_r8,1.0096e+05_r8,5.0479e+04_r8,7.9045e+00_r8/) + kbo(:, 1,17,14) = (/ & + &1.8037e+05_r8,1.3528e+05_r8,9.0185e+04_r8,4.5093e+04_r8,1.0108e+01_r8/) + kbo(:, 2,17,14) = (/ & + &1.7972e+05_r8,1.3479e+05_r8,8.9862e+04_r8,4.4932e+04_r8,9.7857e+00_r8/) + kbo(:, 3,17,14) = (/ & + &1.7906e+05_r8,1.3430e+05_r8,8.9533e+04_r8,4.4767e+04_r8,9.4761e+00_r8/) + kbo(:, 4,17,14) = (/ & + &1.7788e+05_r8,1.3341e+05_r8,8.8942e+04_r8,4.4472e+04_r8,9.0551e+00_r8/) + kbo(:, 5,17,14) = (/ & + &1.7662e+05_r8,1.3247e+05_r8,8.8311e+04_r8,4.4156e+04_r8,8.8726e+00_r8/) + kbo(:, 1,18,14) = (/ & + &1.6160e+05_r8,1.2120e+05_r8,8.0801e+04_r8,4.0401e+04_r8,1.1327e+01_r8/) + kbo(:, 2,18,14) = (/ & + &1.6141e+05_r8,1.2106e+05_r8,8.0704e+04_r8,4.0353e+04_r8,1.1010e+01_r8/) + kbo(:, 3,18,14) = (/ & + &1.6076e+05_r8,1.2057e+05_r8,8.0382e+04_r8,4.0192e+04_r8,1.0693e+01_r8/) + kbo(:, 4,18,14) = (/ & + &1.6001e+05_r8,1.2001e+05_r8,8.0005e+04_r8,4.0003e+04_r8,1.0193e+01_r8/) + kbo(:, 5,18,14) = (/ & + &1.5881e+05_r8,1.1911e+05_r8,7.9406e+04_r8,3.9704e+04_r8,1.0071e+01_r8/) + kbo(:, 1,19,14) = (/ & + &1.4270e+05_r8,1.0702e+05_r8,7.1350e+04_r8,3.5676e+04_r8,1.2821e+01_r8/) + kbo(:, 2,19,14) = (/ & + &1.4247e+05_r8,1.0685e+05_r8,7.1236e+04_r8,3.5619e+04_r8,1.2498e+01_r8/) + kbo(:, 3,19,14) = (/ & + &1.4204e+05_r8,1.0653e+05_r8,7.1022e+04_r8,3.5511e+04_r8,1.2171e+01_r8/) + kbo(:, 4,19,14) = (/ & + &1.4126e+05_r8,1.0594e+05_r8,7.0629e+04_r8,3.5315e+04_r8,1.1680e+01_r8/) + kbo(:, 5,19,14) = (/ & + &1.4024e+05_r8,1.0518e+05_r8,7.0119e+04_r8,3.5060e+04_r8,1.1491e+01_r8/) + kbo(:, 1,20,14) = (/ & + &1.3563e+05_r8,1.0173e+05_r8,6.7817e+04_r8,3.3909e+04_r8,1.4618e+01_r8/) + kbo(:, 2,20,14) = (/ & + &1.3541e+05_r8,1.0156e+05_r8,6.7708e+04_r8,3.3855e+04_r8,1.4263e+01_r8/) + kbo(:, 3,20,14) = (/ & + &1.3484e+05_r8,1.0113e+05_r8,6.7419e+04_r8,3.3710e+04_r8,1.3906e+01_r8/) + kbo(:, 4,20,14) = (/ & + &1.3404e+05_r8,1.0053e+05_r8,6.7023e+04_r8,3.3512e+04_r8,1.3385e+01_r8/) + kbo(:, 5,20,14) = (/ & + &1.3293e+05_r8,9.9699e+04_r8,6.6466e+04_r8,3.3234e+04_r8,1.3122e+01_r8/) + kbo(:, 1,21,14) = (/ & + &1.3198e+05_r8,9.8983e+04_r8,6.5989e+04_r8,3.2995e+04_r8,1.6661e+01_r8/) + kbo(:, 2,21,14) = (/ & + &1.3158e+05_r8,9.8688e+04_r8,6.5792e+04_r8,3.2897e+04_r8,1.6248e+01_r8/) + kbo(:, 3,21,14) = (/ & + &1.3094e+05_r8,9.8202e+04_r8,6.5468e+04_r8,3.2735e+04_r8,1.5812e+01_r8/) + kbo(:, 4,21,14) = (/ & + &1.3001e+05_r8,9.7504e+04_r8,6.5003e+04_r8,3.2502e+04_r8,1.5225e+01_r8/) + kbo(:, 5,21,14) = (/ & + &1.2884e+05_r8,9.6632e+04_r8,6.4422e+04_r8,3.2211e+04_r8,1.4867e+01_r8/) + kbo(:, 1,22,14) = (/ & + &1.3028e+05_r8,9.7707e+04_r8,6.5139e+04_r8,3.2570e+04_r8,1.8806e+01_r8/) + kbo(:, 2,22,14) = (/ & + &1.2981e+05_r8,9.7355e+04_r8,6.4904e+04_r8,3.2452e+04_r8,1.8310e+01_r8/) + kbo(:, 3,22,14) = (/ & + &1.2902e+05_r8,9.6763e+04_r8,6.4509e+04_r8,3.2255e+04_r8,1.7798e+01_r8/) + kbo(:, 4,22,14) = (/ & + &1.2795e+05_r8,9.5966e+04_r8,6.3978e+04_r8,3.1989e+04_r8,1.7136e+01_r8/) + kbo(:, 5,22,14) = (/ & + &1.2666e+05_r8,9.4996e+04_r8,6.3331e+04_r8,3.1666e+04_r8,1.6711e+01_r8/) + kbo(:, 1,23,14) = (/ & + &1.2794e+05_r8,9.5952e+04_r8,6.3968e+04_r8,3.1985e+04_r8,2.1073e+01_r8/) + kbo(:, 2,23,14) = (/ & + &1.2735e+05_r8,9.5515e+04_r8,6.3677e+04_r8,3.1839e+04_r8,2.0511e+01_r8/) + kbo(:, 3,23,14) = (/ & + &1.2647e+05_r8,9.4850e+04_r8,6.3234e+04_r8,3.1617e+04_r8,1.9930e+01_r8/) + kbo(:, 4,23,14) = (/ & + &1.2537e+05_r8,9.4025e+04_r8,6.2684e+04_r8,3.1342e+04_r8,1.9174e+01_r8/) + kbo(:, 5,23,14) = (/ & + &1.2398e+05_r8,9.2985e+04_r8,6.1990e+04_r8,3.0996e+04_r8,1.8667e+01_r8/) + kbo(:, 1,24,14) = (/ & + &1.2343e+05_r8,9.2570e+04_r8,6.1714e+04_r8,3.0858e+04_r8,2.3485e+01_r8/) + kbo(:, 2,24,14) = (/ & + &1.2276e+05_r8,9.2074e+04_r8,6.1383e+04_r8,3.0692e+04_r8,2.2824e+01_r8/) + kbo(:, 3,24,14) = (/ & + &1.2194e+05_r8,9.1458e+04_r8,6.0973e+04_r8,3.0487e+04_r8,2.2153e+01_r8/) + kbo(:, 4,24,14) = (/ & + &1.2080e+05_r8,9.0601e+04_r8,6.0401e+04_r8,3.0201e+04_r8,2.1291e+01_r8/) + kbo(:, 5,24,14) = (/ & + &1.1949e+05_r8,8.9617e+04_r8,5.9745e+04_r8,2.9873e+04_r8,2.0633e+01_r8/) + kbo(:, 1,25,14) = (/ & + &1.1905e+05_r8,8.9291e+04_r8,5.9528e+04_r8,2.9764e+04_r8,2.5966e+01_r8/) + kbo(:, 2,25,14) = (/ & + &1.1853e+05_r8,8.8894e+04_r8,5.9263e+04_r8,2.9632e+04_r8,2.5184e+01_r8/) + kbo(:, 3,25,14) = (/ & + &1.1769e+05_r8,8.8271e+04_r8,5.8848e+04_r8,2.9424e+04_r8,2.4373e+01_r8/) + kbo(:, 4,25,14) = (/ & + &1.1666e+05_r8,8.7497e+04_r8,5.8331e+04_r8,2.9166e+04_r8,2.3367e+01_r8/) + kbo(:, 5,25,14) = (/ & + &1.1542e+05_r8,8.6565e+04_r8,5.7710e+04_r8,2.8855e+04_r8,2.2586e+01_r8/) + kbo(:, 1,26,14) = (/ & + &1.1553e+05_r8,8.6651e+04_r8,5.7768e+04_r8,2.8884e+04_r8,2.8441e+01_r8/) + kbo(:, 2,26,14) = (/ & + &1.1511e+05_r8,8.6329e+04_r8,5.7553e+04_r8,2.8777e+04_r8,2.7500e+01_r8/) + kbo(:, 3,26,14) = (/ & + &1.1443e+05_r8,8.5820e+04_r8,5.7213e+04_r8,2.8607e+04_r8,2.6532e+01_r8/) + kbo(:, 4,26,14) = (/ & + &1.1356e+05_r8,8.5172e+04_r8,5.6781e+04_r8,2.8391e+04_r8,2.5362e+01_r8/) + kbo(:, 5,26,14) = (/ & + &1.1241e+05_r8,8.4309e+04_r8,5.6206e+04_r8,2.8103e+04_r8,2.4468e+01_r8/) + kbo(:, 1,27,14) = (/ & + &1.1545e+05_r8,8.6587e+04_r8,5.7725e+04_r8,2.8863e+04_r8,3.0839e+01_r8/) + kbo(:, 2,27,14) = (/ & + &1.1514e+05_r8,8.6352e+04_r8,5.7568e+04_r8,2.8785e+04_r8,2.9713e+01_r8/) + kbo(:, 3,27,14) = (/ & + &1.1466e+05_r8,8.5998e+04_r8,5.7332e+04_r8,2.8667e+04_r8,2.8580e+01_r8/) + kbo(:, 4,27,14) = (/ & + &1.1391e+05_r8,8.5436e+04_r8,5.6958e+04_r8,2.8479e+04_r8,2.7213e+01_r8/) + kbo(:, 5,27,14) = (/ & + &1.1293e+05_r8,8.4701e+04_r8,5.6467e+04_r8,2.8234e+04_r8,2.6212e+01_r8/) + kbo(:, 1,28,14) = (/ & + &1.1769e+05_r8,8.8268e+04_r8,5.8845e+04_r8,2.9423e+04_r8,3.3091e+01_r8/) + kbo(:, 2,28,14) = (/ & + &1.1765e+05_r8,8.8234e+04_r8,5.8823e+04_r8,2.9412e+04_r8,3.1766e+01_r8/) + kbo(:, 3,28,14) = (/ & + &1.1733e+05_r8,8.7997e+04_r8,5.8665e+04_r8,2.9333e+04_r8,3.0463e+01_r8/) + kbo(:, 4,28,14) = (/ & + &1.1677e+05_r8,8.7580e+04_r8,5.8387e+04_r8,2.9194e+04_r8,2.8874e+01_r8/) + kbo(:, 5,28,14) = (/ & + &1.1593e+05_r8,8.6950e+04_r8,5.7967e+04_r8,2.8984e+04_r8,2.7821e+01_r8/) + kbo(:, 1,29,14) = (/ & + &1.2676e+05_r8,9.5071e+04_r8,6.3381e+04_r8,3.1691e+04_r8,3.5131e+01_r8/) + kbo(:, 2,29,14) = (/ & + &1.2709e+05_r8,9.5318e+04_r8,6.3545e+04_r8,3.1773e+04_r8,3.3613e+01_r8/) + kbo(:, 3,29,14) = (/ & + &1.2701e+05_r8,9.5260e+04_r8,6.3507e+04_r8,3.1754e+04_r8,3.1981e+01_r8/) + kbo(:, 4,29,14) = (/ & + &1.2660e+05_r8,9.4952e+04_r8,6.3301e+04_r8,3.1651e+04_r8,3.0369e+01_r8/) + kbo(:, 5,29,14) = (/ & + &1.2589e+05_r8,9.4414e+04_r8,6.2943e+04_r8,3.1472e+04_r8,2.9250e+01_r8/) + kbo(:, 1,30,14) = (/ & + &1.3959e+05_r8,1.0469e+05_r8,6.9793e+04_r8,3.4897e+04_r8,3.6931e+01_r8/) + kbo(:, 2,30,14) = (/ & + &1.4034e+05_r8,1.0525e+05_r8,7.0169e+04_r8,3.5085e+04_r8,3.5216e+01_r8/) + kbo(:, 3,30,14) = (/ & + &1.4057e+05_r8,1.0543e+05_r8,7.0285e+04_r8,3.5143e+04_r8,3.3253e+01_r8/) + kbo(:, 4,30,14) = (/ & + &1.4040e+05_r8,1.0530e+05_r8,7.0200e+04_r8,3.5100e+04_r8,3.1871e+01_r8/) + kbo(:, 5,30,14) = (/ & + &1.3970e+05_r8,1.0477e+05_r8,6.9850e+04_r8,3.4925e+04_r8,3.0435e+01_r8/) + kbo(:, 1,31,14) = (/ & + &1.6150e+05_r8,1.2112e+05_r8,8.0748e+04_r8,4.0374e+04_r8,3.8448e+01_r8/) + kbo(:, 2,31,14) = (/ & + &1.6274e+05_r8,1.2205e+05_r8,8.1369e+04_r8,4.0685e+04_r8,3.6340e+01_r8/) + kbo(:, 3,31,14) = (/ & + &1.6341e+05_r8,1.2256e+05_r8,8.1707e+04_r8,4.0854e+04_r8,3.4532e+01_r8/) + kbo(:, 4,31,14) = (/ & + &1.6341e+05_r8,1.2256e+05_r8,8.1706e+04_r8,4.0853e+04_r8,3.3032e+01_r8/) + kbo(:, 5,31,14) = (/ & + &1.6281e+05_r8,1.2211e+05_r8,8.1407e+04_r8,4.0704e+04_r8,3.1374e+01_r8/) + kbo(:, 1,32,14) = (/ & + &1.8902e+05_r8,1.4177e+05_r8,9.4511e+04_r8,4.7256e+04_r8,3.9673e+01_r8/) + kbo(:, 2,32,14) = (/ & + &1.9095e+05_r8,1.4322e+05_r8,9.5478e+04_r8,4.7739e+04_r8,3.7210e+01_r8/) + kbo(:, 3,32,14) = (/ & + &1.9208e+05_r8,1.4406e+05_r8,9.6041e+04_r8,4.8021e+04_r8,3.5668e+01_r8/) + kbo(:, 4,32,14) = (/ & + &1.9230e+05_r8,1.4423e+05_r8,9.6153e+04_r8,4.8077e+04_r8,3.3902e+01_r8/) + kbo(:, 5,32,14) = (/ & + &1.9178e+05_r8,1.4383e+05_r8,9.5890e+04_r8,4.7945e+04_r8,3.1255e+01_r8/) + kbo(:, 1,33,14) = (/ & + &2.2548e+05_r8,1.6911e+05_r8,1.1274e+05_r8,5.6370e+04_r8,4.0253e+01_r8/) + kbo(:, 2,33,14) = (/ & + &2.2820e+05_r8,1.7115e+05_r8,1.1410e+05_r8,5.7051e+04_r8,3.8356e+01_r8/) + kbo(:, 3,33,14) = (/ & + &2.2980e+05_r8,1.7235e+05_r8,1.1490e+05_r8,5.7450e+04_r8,3.6454e+01_r8/) + kbo(:, 4,33,14) = (/ & + &2.3033e+05_r8,1.7275e+05_r8,1.1517e+05_r8,5.7584e+04_r8,3.3797e+01_r8/) + kbo(:, 5,33,14) = (/ & + &2.2985e+05_r8,1.7239e+05_r8,1.1492e+05_r8,5.7463e+04_r8,3.1363e+01_r8/) + kbo(:, 1,34,14) = (/ & + &2.6250e+05_r8,1.9687e+05_r8,1.3125e+05_r8,6.5624e+04_r8,4.1136e+01_r8/) + kbo(:, 2,34,14) = (/ & + &2.6605e+05_r8,1.9954e+05_r8,1.3302e+05_r8,6.6512e+04_r8,3.9143e+01_r8/) + kbo(:, 3,34,14) = (/ & + &2.6820e+05_r8,2.0115e+05_r8,1.3410e+05_r8,6.7050e+04_r8,3.6807e+01_r8/) + kbo(:, 4,34,14) = (/ & + &2.6900e+05_r8,2.0175e+05_r8,1.3450e+05_r8,6.7251e+04_r8,3.3160e+01_r8/) + kbo(:, 5,34,14) = (/ & + &2.6861e+05_r8,2.0146e+05_r8,1.3431e+05_r8,6.7153e+04_r8,3.1344e+01_r8/) + kbo(:, 1,35,14) = (/ & + &3.0587e+05_r8,2.2940e+05_r8,1.5293e+05_r8,7.6467e+04_r8,4.2099e+01_r8/) + kbo(:, 2,35,14) = (/ & + &3.1048e+05_r8,2.3286e+05_r8,1.5524e+05_r8,7.7621e+04_r8,3.9785e+01_r8/) + kbo(:, 3,35,14) = (/ & + &3.1341e+05_r8,2.3506e+05_r8,1.5670e+05_r8,7.8352e+04_r8,3.6072e+01_r8/) + kbo(:, 4,35,14) = (/ & + &3.1462e+05_r8,2.3596e+05_r8,1.5731e+05_r8,7.8655e+04_r8,3.3490e+01_r8/) + kbo(:, 5,35,14) = (/ & + &3.1438e+05_r8,2.3579e+05_r8,1.5719e+05_r8,7.8596e+04_r8,3.1828e+01_r8/) + kbo(:, 1,36,14) = (/ & + &3.5380e+05_r8,2.6535e+05_r8,1.7690e+05_r8,8.8450e+04_r8,4.2948e+01_r8/) + kbo(:, 2,36,14) = (/ & + &3.5987e+05_r8,2.6990e+05_r8,1.7993e+05_r8,8.9967e+04_r8,3.9945e+01_r8/) + kbo(:, 3,36,14) = (/ & + &3.6383e+05_r8,2.7287e+05_r8,1.8191e+05_r8,9.0957e+04_r8,3.5908e+01_r8/) + kbo(:, 4,36,14) = (/ & + &3.6571e+05_r8,2.7429e+05_r8,1.8286e+05_r8,9.1429e+04_r8,3.3881e+01_r8/) + kbo(:, 5,36,14) = (/ & + &3.6576e+05_r8,2.7432e+05_r8,1.8288e+05_r8,9.1441e+04_r8,3.2580e+01_r8/) + kbo(:, 1,37,14) = (/ & + &3.9789e+05_r8,2.9842e+05_r8,1.9894e+05_r8,9.9472e+04_r8,4.3924e+01_r8/) + kbo(:, 2,37,14) = (/ & + &4.0582e+05_r8,3.0436e+05_r8,2.0291e+05_r8,1.0145e+05_r8,4.0613e+01_r8/) + kbo(:, 3,37,14) = (/ & + &4.1126e+05_r8,3.0845e+05_r8,2.0563e+05_r8,1.0282e+05_r8,3.6440e+01_r8/) + kbo(:, 4,37,14) = (/ & + &4.1422e+05_r8,3.1066e+05_r8,2.0711e+05_r8,1.0355e+05_r8,3.4966e+01_r8/) + kbo(:, 5,37,14) = (/ & + &4.1491e+05_r8,3.1118e+05_r8,2.0745e+05_r8,1.0373e+05_r8,3.3736e+01_r8/) + kbo(:, 1,38,14) = (/ & + &4.5404e+05_r8,3.4053e+05_r8,2.2702e+05_r8,1.1351e+05_r8,4.4908e+01_r8/) + kbo(:, 2,38,14) = (/ & + &4.6441e+05_r8,3.4830e+05_r8,2.3220e+05_r8,1.1610e+05_r8,4.0968e+01_r8/) + kbo(:, 3,38,14) = (/ & + &4.7167e+05_r8,3.5375e+05_r8,2.3583e+05_r8,1.1792e+05_r8,3.7185e+01_r8/) + kbo(:, 4,38,14) = (/ & + &4.7591e+05_r8,3.5693e+05_r8,2.3796e+05_r8,1.1898e+05_r8,3.5958e+01_r8/) + kbo(:, 5,38,14) = (/ & + &4.7747e+05_r8,3.5810e+05_r8,2.3873e+05_r8,1.1937e+05_r8,3.4345e+01_r8/) + kbo(:, 1,39,14) = (/ & + &5.3006e+05_r8,3.9755e+05_r8,2.6503e+05_r8,1.3252e+05_r8,4.5571e+01_r8/) + kbo(:, 2,39,14) = (/ & + &5.4370e+05_r8,4.0778e+05_r8,2.7185e+05_r8,1.3593e+05_r8,4.1350e+01_r8/) + kbo(:, 3,39,14) = (/ & + &5.5324e+05_r8,4.1494e+05_r8,2.7663e+05_r8,1.3831e+05_r8,3.8461e+01_r8/) + kbo(:, 4,39,14) = (/ & + &5.5931e+05_r8,4.1948e+05_r8,2.7966e+05_r8,1.3983e+05_r8,3.7172e+01_r8/) + kbo(:, 5,39,14) = (/ & + &5.6198e+05_r8,4.2149e+05_r8,2.8099e+05_r8,1.4050e+05_r8,3.5387e+01_r8/) + kbo(:, 1,40,14) = (/ & + &5.7962e+05_r8,4.3471e+05_r8,2.8981e+05_r8,1.4490e+05_r8,4.6708e+01_r8/) + kbo(:, 2,40,14) = (/ & + &5.9661e+05_r8,4.4745e+05_r8,2.9830e+05_r8,1.4915e+05_r8,4.2510e+01_r8/) + kbo(:, 3,40,14) = (/ & + &6.0879e+05_r8,4.5659e+05_r8,3.0439e+05_r8,1.5220e+05_r8,3.9273e+01_r8/) + kbo(:, 4,40,14) = (/ & + &6.1695e+05_r8,4.6271e+05_r8,3.0847e+05_r8,1.5424e+05_r8,3.8101e+01_r8/) + kbo(:, 5,40,14) = (/ & + &6.2122e+05_r8,4.6592e+05_r8,3.1061e+05_r8,1.5530e+05_r8,3.6493e+01_r8/) + kbo(:, 1,41,14) = (/ & + &6.3170e+05_r8,4.7378e+05_r8,3.1585e+05_r8,1.5793e+05_r8,4.7871e+01_r8/) + kbo(:, 2,41,14) = (/ & + &6.5265e+05_r8,4.8949e+05_r8,3.2633e+05_r8,1.6317e+05_r8,4.3729e+01_r8/) + kbo(:, 3,41,14) = (/ & + &6.6799e+05_r8,5.0099e+05_r8,3.3400e+05_r8,1.6700e+05_r8,4.0263e+01_r8/) + kbo(:, 4,41,14) = (/ & + &6.7856e+05_r8,5.0892e+05_r8,3.3928e+05_r8,1.6964e+05_r8,3.8971e+01_r8/) + kbo(:, 5,41,14) = (/ & + &6.8482e+05_r8,5.1361e+05_r8,3.4241e+05_r8,1.7121e+05_r8,3.7519e+01_r8/) + kbo(:, 1,42,14) = (/ & + &6.9554e+05_r8,5.2166e+05_r8,3.4777e+05_r8,1.7388e+05_r8,4.9144e+01_r8/) + kbo(:, 2,42,14) = (/ & + &7.2122e+05_r8,5.4091e+05_r8,3.6061e+05_r8,1.8030e+05_r8,4.4903e+01_r8/) + kbo(:, 3,42,14) = (/ & + &7.4054e+05_r8,5.5540e+05_r8,3.7027e+05_r8,1.8513e+05_r8,4.1239e+01_r8/) + kbo(:, 4,42,14) = (/ & + &7.5407e+05_r8,5.6555e+05_r8,3.7703e+05_r8,1.8852e+05_r8,4.0019e+01_r8/) + kbo(:, 5,42,14) = (/ & + &7.6271e+05_r8,5.7203e+05_r8,3.8135e+05_r8,1.9067e+05_r8,3.8545e+01_r8/) + kbo(:, 1,43,14) = (/ & + &7.7014e+05_r8,5.7761e+05_r8,3.8508e+05_r8,1.9254e+05_r8,5.0575e+01_r8/) + kbo(:, 2,43,14) = (/ & + &8.0215e+05_r8,6.0161e+05_r8,4.0108e+05_r8,2.0054e+05_r8,4.6180e+01_r8/) + kbo(:, 3,43,14) = (/ & + &8.2687e+05_r8,6.2015e+05_r8,4.1344e+05_r8,2.0672e+05_r8,4.2529e+01_r8/) + kbo(:, 4,43,14) = (/ & + &8.4441e+05_r8,6.3331e+05_r8,4.2221e+05_r8,2.1110e+05_r8,4.0958e+01_r8/) + kbo(:, 5,43,14) = (/ & + &8.5614e+05_r8,6.4211e+05_r8,4.2807e+05_r8,2.1404e+05_r8,3.9632e+01_r8/) + kbo(:, 1,44,14) = (/ & + &8.6239e+05_r8,6.4679e+05_r8,4.3119e+05_r8,2.1559e+05_r8,5.2080e+01_r8/) + kbo(:, 2,44,14) = (/ & + &9.0261e+05_r8,6.7696e+05_r8,4.5130e+05_r8,2.2565e+05_r8,4.7569e+01_r8/) + kbo(:, 3,44,14) = (/ & + &9.3442e+05_r8,7.0081e+05_r8,4.6721e+05_r8,2.3360e+05_r8,4.3904e+01_r8/) + kbo(:, 4,44,14) = (/ & + &9.5755e+05_r8,7.1816e+05_r8,4.7877e+05_r8,2.3938e+05_r8,4.2000e+01_r8/) + kbo(:, 5,44,14) = (/ & + &9.7341e+05_r8,7.3005e+05_r8,4.8670e+05_r8,2.4335e+05_r8,4.0861e+01_r8/) + kbo(:, 1,45,14) = (/ & + &9.8377e+05_r8,7.3783e+05_r8,4.9189e+05_r8,2.4594e+05_r8,5.3464e+01_r8/) + kbo(:, 2,45,14) = (/ & + &1.0352e+06_r8,7.7641e+05_r8,5.1760e+05_r8,2.5880e+05_r8,4.8989e+01_r8/) + kbo(:, 3,45,14) = (/ & + &1.0762e+06_r8,8.0713e+05_r8,5.3809e+05_r8,2.6904e+05_r8,4.5355e+01_r8/) + kbo(:, 4,45,14) = (/ & + &1.1070e+06_r8,8.3023e+05_r8,5.5349e+05_r8,2.7674e+05_r8,4.3217e+01_r8/) + kbo(:, 5,45,14) = (/ & + &1.1287e+06_r8,8.4649e+05_r8,5.6433e+05_r8,2.8216e+05_r8,4.1953e+01_r8/) + kbo(:, 1,46,14) = (/ & + &1.1307e+06_r8,8.4801e+05_r8,5.6534e+05_r8,2.8267e+05_r8,5.4903e+01_r8/) + kbo(:, 2,46,14) = (/ & + &1.1967e+06_r8,8.9750e+05_r8,5.9834e+05_r8,2.9917e+05_r8,5.0473e+01_r8/) + kbo(:, 3,46,14) = (/ & + &1.2497e+06_r8,9.3728e+05_r8,6.2485e+05_r8,3.1243e+05_r8,4.7017e+01_r8/) + kbo(:, 4,46,14) = (/ & + &1.2910e+06_r8,9.6823e+05_r8,6.4549e+05_r8,3.2274e+05_r8,4.4343e+01_r8/) + kbo(:, 5,46,14) = (/ & + &1.3205e+06_r8,9.9037e+05_r8,6.6025e+05_r8,3.3012e+05_r8,4.3085e+01_r8/) + kbo(:, 1,47,14) = (/ & + &1.2818e+06_r8,9.6133e+05_r8,6.4089e+05_r8,3.2045e+05_r8,5.6436e+01_r8/) + kbo(:, 2,47,14) = (/ & + &1.3655e+06_r8,1.0241e+06_r8,6.8273e+05_r8,3.4137e+05_r8,5.2412e+01_r8/) + kbo(:, 3,47,14) = (/ & + &1.4341e+06_r8,1.0756e+06_r8,7.1708e+05_r8,3.5854e+05_r8,4.8254e+01_r8/) + kbo(:, 4,47,14) = (/ & + &1.4885e+06_r8,1.1164e+06_r8,7.4427e+05_r8,3.7214e+05_r8,4.5497e+01_r8/) + kbo(:, 5,47,14) = (/ & + &1.5285e+06_r8,1.1464e+06_r8,7.6425e+05_r8,3.8213e+05_r8,4.4276e+01_r8/) + kbo(:, 1,48,14) = (/ & + &1.4912e+06_r8,1.1184e+06_r8,7.4558e+05_r8,3.7279e+05_r8,5.8070e+01_r8/) + kbo(:, 2,48,14) = (/ & + &1.5992e+06_r8,1.1994e+06_r8,7.9959e+05_r8,3.9979e+05_r8,5.4067e+01_r8/) + kbo(:, 3,48,14) = (/ & + &1.6898e+06_r8,1.2674e+06_r8,8.4492e+05_r8,4.2246e+05_r8,5.0095e+01_r8/) + kbo(:, 4,48,14) = (/ & + &1.7626e+06_r8,1.3220e+06_r8,8.8132e+05_r8,4.4066e+05_r8,4.6945e+01_r8/) + kbo(:, 5,48,14) = (/ & + &1.8180e+06_r8,1.3635e+06_r8,9.0900e+05_r8,4.5450e+05_r8,4.5438e+01_r8/) + kbo(:, 1,49,14) = (/ & + &1.8033e+06_r8,1.3525e+06_r8,9.0165e+05_r8,4.5083e+05_r8,5.9742e+01_r8/) + kbo(:, 2,49,14) = (/ & + &1.9472e+06_r8,1.4604e+06_r8,9.7361e+05_r8,4.8680e+05_r8,5.5654e+01_r8/) + kbo(:, 3,49,14) = (/ & + &2.0706e+06_r8,1.5529e+06_r8,1.0353e+06_r8,5.1764e+05_r8,5.1796e+01_r8/) + kbo(:, 4,49,14) = (/ & + &2.1711e+06_r8,1.6283e+06_r8,1.0855e+06_r8,5.4277e+05_r8,4.8429e+01_r8/) + kbo(:, 5,49,14) = (/ & + &2.2497e+06_r8,1.6872e+06_r8,1.1248e+06_r8,5.6241e+05_r8,4.6805e+01_r8/) + kbo(:, 1,50,14) = (/ & + &2.0759e+06_r8,1.5569e+06_r8,1.0379e+06_r8,5.1897e+05_r8,6.1720e+01_r8/) + kbo(:, 2,50,14) = (/ & + &2.2580e+06_r8,1.6935e+06_r8,1.1290e+06_r8,5.6451e+05_r8,5.7265e+01_r8/) + kbo(:, 3,50,14) = (/ & + &2.4154e+06_r8,1.8116e+06_r8,1.2077e+06_r8,6.0386e+05_r8,5.3335e+01_r8/) + kbo(:, 4,50,14) = (/ & + &2.5463e+06_r8,1.9097e+06_r8,1.2731e+06_r8,6.3657e+05_r8,5.0026e+01_r8/) + kbo(:, 5,50,14) = (/ & + &2.6508e+06_r8,1.9881e+06_r8,1.3254e+06_r8,6.6270e+05_r8,4.7879e+01_r8/) + kbo(:, 1,51,14) = (/ & + &2.3343e+06_r8,1.7507e+06_r8,1.1671e+06_r8,5.8357e+05_r8,6.3629e+01_r8/) + kbo(:, 2,51,14) = (/ & + &2.5583e+06_r8,1.9187e+06_r8,1.2791e+06_r8,6.3957e+05_r8,5.8823e+01_r8/) + kbo(:, 3,51,14) = (/ & + &2.7536e+06_r8,2.0652e+06_r8,1.3768e+06_r8,6.8840e+05_r8,5.4830e+01_r8/) + kbo(:, 4,51,14) = (/ & + &2.9192e+06_r8,2.1894e+06_r8,1.4596e+06_r8,7.2979e+05_r8,5.1797e+01_r8/) + kbo(:, 5,51,14) = (/ & + &3.0520e+06_r8,2.2890e+06_r8,1.5260e+06_r8,7.6300e+05_r8,4.8739e+01_r8/) + kbo(:, 1,52,14) = (/ & + &2.6927e+06_r8,2.0196e+06_r8,1.3464e+06_r8,6.7319e+05_r8,6.5473e+01_r8/) + kbo(:, 2,52,14) = (/ & + &2.9755e+06_r8,2.2317e+06_r8,1.4878e+06_r8,7.4389e+05_r8,6.0202e+01_r8/) + kbo(:, 3,52,14) = (/ & + &3.2232e+06_r8,2.4174e+06_r8,1.6116e+06_r8,8.0581e+05_r8,5.6406e+01_r8/) + kbo(:, 4,52,14) = (/ & + &3.4356e+06_r8,2.5767e+06_r8,1.7178e+06_r8,8.5891e+05_r8,5.3338e+01_r8/) + kbo(:, 5,52,14) = (/ & + &3.6105e+06_r8,2.7079e+06_r8,1.8053e+06_r8,9.0264e+05_r8,4.9535e+01_r8/) + kbo(:, 1,53,14) = (/ & + &3.2282e+06_r8,2.4212e+06_r8,1.6141e+06_r8,8.0707e+05_r8,6.7136e+01_r8/) + kbo(:, 2,53,14) = (/ & + &3.5968e+06_r8,2.6976e+06_r8,1.7984e+06_r8,8.9921e+05_r8,6.1503e+01_r8/) + kbo(:, 3,53,14) = (/ & + &3.9238e+06_r8,2.9429e+06_r8,1.9619e+06_r8,9.8097e+05_r8,5.8062e+01_r8/) + kbo(:, 4,53,14) = (/ & + &4.2071e+06_r8,3.1553e+06_r8,2.1035e+06_r8,1.0518e+06_r8,5.4982e+01_r8/) + kbo(:, 5,53,14) = (/ & + &4.4446e+06_r8,3.3334e+06_r8,2.2223e+06_r8,1.1112e+06_r8,5.0414e+01_r8/) + kbo(:, 1,54,14) = (/ & + &3.3478e+06_r8,2.5109e+06_r8,1.6739e+06_r8,8.3696e+05_r8,6.8647e+01_r8/) + kbo(:, 2,54,14) = (/ & + &3.7598e+06_r8,2.8199e+06_r8,1.8799e+06_r8,9.3996e+05_r8,6.3327e+01_r8/) + kbo(:, 3,54,14) = (/ & + &4.1308e+06_r8,3.0981e+06_r8,2.0654e+06_r8,1.0327e+06_r8,5.9705e+01_r8/) + kbo(:, 4,54,14) = (/ & + &4.4534e+06_r8,3.3401e+06_r8,2.2267e+06_r8,1.1134e+06_r8,5.5841e+01_r8/) + kbo(:, 5,54,14) = (/ & + &4.7287e+06_r8,3.5465e+06_r8,2.3644e+06_r8,1.1822e+06_r8,5.1312e+01_r8/) + kbo(:, 1,55,14) = (/ & + &3.1636e+06_r8,2.3727e+06_r8,1.5818e+06_r8,7.9090e+05_r8,6.9800e+01_r8/) + kbo(:, 2,55,14) = (/ & + &3.5827e+06_r8,2.6870e+06_r8,1.7914e+06_r8,8.9569e+05_r8,6.5650e+01_r8/) + kbo(:, 3,55,14) = (/ & + &3.9638e+06_r8,2.9728e+06_r8,1.9819e+06_r8,9.9095e+05_r8,6.0566e+01_r8/) + kbo(:, 4,55,14) = (/ & + &4.2985e+06_r8,3.2239e+06_r8,2.1493e+06_r8,1.0746e+06_r8,5.6657e+01_r8/) + kbo(:, 5,55,14) = (/ & + &4.5858e+06_r8,3.4394e+06_r8,2.2929e+06_r8,1.1465e+06_r8,5.3531e+01_r8/) + kbo(:, 1,56,14) = (/ & + &2.9822e+06_r8,2.2367e+06_r8,1.4911e+06_r8,7.4555e+05_r8,7.1031e+01_r8/) + kbo(:, 2,56,14) = (/ & + &3.4067e+06_r8,2.5550e+06_r8,1.7033e+06_r8,8.5166e+05_r8,6.7133e+01_r8/) + kbo(:, 3,56,14) = (/ & + &3.7967e+06_r8,2.8475e+06_r8,1.8983e+06_r8,9.4915e+05_r8,6.1784e+01_r8/) + kbo(:, 4,56,14) = (/ & + &4.1424e+06_r8,3.1068e+06_r8,2.0712e+06_r8,1.0356e+06_r8,5.8142e+01_r8/) + kbo(:, 5,56,14) = (/ & + &4.4422e+06_r8,3.3317e+06_r8,2.2211e+06_r8,1.1105e+06_r8,5.4348e+01_r8/) + kbo(:, 1,57,14) = (/ & + &2.8003e+06_r8,2.1002e+06_r8,1.4001e+06_r8,7.0006e+05_r8,7.2686e+01_r8/) + kbo(:, 2,57,14) = (/ & + &3.2322e+06_r8,2.4241e+06_r8,1.6161e+06_r8,8.0804e+05_r8,6.8121e+01_r8/) + kbo(:, 3,57,14) = (/ & + &3.6290e+06_r8,2.7217e+06_r8,1.8145e+06_r8,9.0724e+05_r8,6.3933e+01_r8/) + kbo(:, 4,57,14) = (/ & + &3.9857e+06_r8,2.9893e+06_r8,1.9928e+06_r8,9.9642e+05_r8,5.9242e+01_r8/) + kbo(:, 5,57,14) = (/ & + &4.2966e+06_r8,3.2224e+06_r8,2.1482e+06_r8,1.0741e+06_r8,5.5180e+01_r8/) + kbo(:, 1,58,14) = (/ & + &6.9277e+05_r8,6.3516e+05_r8,5.4460e+05_r8,3.8143e+05_r8,7.4521e+01_r8/) + kbo(:, 2,58,14) = (/ & + &8.0841e+05_r8,7.4119e+05_r8,6.3550e+05_r8,4.4510e+05_r8,6.9466e+01_r8/) + kbo(:, 3,58,14) = (/ & + &9.1451e+05_r8,8.3847e+05_r8,7.1891e+05_r8,5.0352e+05_r8,6.5445e+01_r8/) + kbo(:, 4,58,14) = (/ & + &1.0112e+06_r8,9.2715e+05_r8,7.9494e+05_r8,5.5677e+05_r8,6.0252e+01_r8/) + kbo(:, 5,58,14) = (/ & + &1.0957e+06_r8,1.0046e+06_r8,8.6135e+05_r8,6.0328e+05_r8,5.6261e+01_r8/) + kbo(:, 1,59,14) = (/ & + &7.9105e+05_r8,6.9072e+05_r8,5.5096e+05_r8,3.4284e+05_r8,7.5082e+01_r8/) + kbo(:, 2,59,14) = (/ & + &9.2759e+05_r8,8.0994e+05_r8,6.4605e+05_r8,4.0201e+05_r8,7.0591e+01_r8/) + kbo(:, 3,59,14) = (/ & + &1.0529e+06_r8,9.1931e+05_r8,7.3330e+05_r8,4.5630e+05_r8,6.5689e+01_r8/) + kbo(:, 4,59,14) = (/ & + &1.1673e+06_r8,1.0193e+06_r8,8.1302e+05_r8,5.0591e+05_r8,6.1427e+01_r8/) + kbo(:, 5,59,14) = (/ & + &1.2680e+06_r8,1.1071e+06_r8,8.8311e+05_r8,5.4953e+05_r8,5.7108e+01_r8/) + kbo(:, 1,13,15) = (/ & + &6.8853e+05_r8,5.1640e+05_r8,3.4427e+05_r8,1.7213e+05_r8,8.3646e+00_r8/) + kbo(:, 2,13,15) = (/ & + &6.7841e+05_r8,5.0881e+05_r8,3.3921e+05_r8,1.6961e+05_r8,8.1557e+00_r8/) + kbo(:, 3,13,15) = (/ & + &6.7058e+05_r8,5.0293e+05_r8,3.3529e+05_r8,1.6765e+05_r8,7.2355e+00_r8/) + kbo(:, 4,13,15) = (/ & + &6.6505e+05_r8,4.9879e+05_r8,3.3253e+05_r8,1.6627e+05_r8,7.1104e+00_r8/) + kbo(:, 5,13,15) = (/ & + &6.5977e+05_r8,4.9483e+05_r8,3.2989e+05_r8,1.6494e+05_r8,5.0356e+00_r8/) + kbo(:, 1,14,15) = (/ & + &4.8859e+05_r8,3.6644e+05_r8,2.4429e+05_r8,1.2215e+05_r8,9.3416e+00_r8/) + kbo(:, 2,14,15) = (/ & + &4.8530e+05_r8,3.6397e+05_r8,2.4265e+05_r8,1.2132e+05_r8,9.0997e+00_r8/) + kbo(:, 3,14,15) = (/ & + &4.8323e+05_r8,3.6243e+05_r8,2.4161e+05_r8,1.2081e+05_r8,8.4842e+00_r8/) + kbo(:, 4,14,15) = (/ & + &4.8076e+05_r8,3.6057e+05_r8,2.4038e+05_r8,1.2019e+05_r8,8.2141e+00_r8/) + kbo(:, 5,14,15) = (/ & + &4.7824e+05_r8,3.5868e+05_r8,2.3912e+05_r8,1.1956e+05_r8,7.9624e+00_r8/) + kbo(:, 1,15,15) = (/ & + &3.5725e+05_r8,2.6794e+05_r8,1.7863e+05_r8,8.9315e+04_r8,1.0416e+01_r8/) + kbo(:, 2,15,15) = (/ & + &3.5701e+05_r8,2.6776e+05_r8,1.7851e+05_r8,8.9255e+04_r8,1.0132e+01_r8/) + kbo(:, 3,15,15) = (/ & + &3.5620e+05_r8,2.6715e+05_r8,1.7810e+05_r8,8.9053e+04_r8,9.8342e+00_r8/) + kbo(:, 4,15,15) = (/ & + &3.5534e+05_r8,2.6651e+05_r8,1.7767e+05_r8,8.8838e+04_r8,8.7353e+00_r8/) + kbo(:, 5,15,15) = (/ & + &3.5411e+05_r8,2.6559e+05_r8,1.7706e+05_r8,8.8531e+04_r8,9.0528e+00_r8/) + kbo(:, 1,16,15) = (/ & + &3.1303e+05_r8,2.3478e+05_r8,1.5652e+05_r8,7.8260e+04_r8,1.1678e+01_r8/) + kbo(:, 2,16,15) = (/ & + &3.1296e+05_r8,2.3472e+05_r8,1.5648e+05_r8,7.8243e+04_r8,1.1373e+01_r8/) + kbo(:, 3,16,15) = (/ & + &3.1311e+05_r8,2.3483e+05_r8,1.5655e+05_r8,7.8278e+04_r8,1.1063e+01_r8/) + kbo(:, 4,16,15) = (/ & + &3.1270e+05_r8,2.3452e+05_r8,1.5635e+05_r8,7.8176e+04_r8,1.0185e+01_r8/) + kbo(:, 5,16,15) = (/ & + &3.1216e+05_r8,2.3412e+05_r8,1.5608e+05_r8,7.8040e+04_r8,1.0166e+01_r8/) + kbo(:, 1,17,15) = (/ & + &2.8440e+05_r8,2.1330e+05_r8,1.4220e+05_r8,7.1101e+04_r8,1.3334e+01_r8/) + kbo(:, 2,17,15) = (/ & + &2.8479e+05_r8,2.1359e+05_r8,1.4240e+05_r8,7.1199e+04_r8,1.2996e+01_r8/) + kbo(:, 3,17,15) = (/ & + &2.8480e+05_r8,2.1360e+05_r8,1.4240e+05_r8,7.1202e+04_r8,1.2651e+01_r8/) + kbo(:, 4,17,15) = (/ & + &2.8481e+05_r8,2.1361e+05_r8,1.4240e+05_r8,7.1203e+04_r8,1.1964e+01_r8/) + kbo(:, 5,17,15) = (/ & + &2.8402e+05_r8,2.1301e+05_r8,1.4201e+05_r8,7.1006e+04_r8,1.1649e+01_r8/) + kbo(:, 1,18,15) = (/ & + &2.6460e+05_r8,1.9845e+05_r8,1.3230e+05_r8,6.6150e+04_r8,1.5350e+01_r8/) + kbo(:, 2,18,15) = (/ & + &2.6490e+05_r8,1.9868e+05_r8,1.3245e+05_r8,6.6227e+04_r8,1.4954e+01_r8/) + kbo(:, 3,18,15) = (/ & + &2.6505e+05_r8,1.9879e+05_r8,1.3252e+05_r8,6.6263e+04_r8,1.4553e+01_r8/) + kbo(:, 4,18,15) = (/ & + &2.6448e+05_r8,1.9836e+05_r8,1.3224e+05_r8,6.6121e+04_r8,1.4057e+01_r8/) + kbo(:, 5,18,15) = (/ & + &2.6357e+05_r8,1.9768e+05_r8,1.3179e+05_r8,6.5894e+04_r8,1.3341e+01_r8/) + kbo(:, 1,19,15) = (/ & + &2.4108e+05_r8,1.8081e+05_r8,1.2054e+05_r8,6.0272e+04_r8,1.7626e+01_r8/) + kbo(:, 2,19,15) = (/ & + &2.4160e+05_r8,1.8120e+05_r8,1.2080e+05_r8,6.0400e+04_r8,1.7162e+01_r8/) + kbo(:, 3,19,15) = (/ & + &2.4138e+05_r8,1.8103e+05_r8,1.2069e+05_r8,6.0347e+04_r8,1.6660e+01_r8/) + kbo(:, 4,19,15) = (/ & + &2.4078e+05_r8,1.8058e+05_r8,1.2039e+05_r8,6.0195e+04_r8,1.6133e+01_r8/) + kbo(:, 5,19,15) = (/ & + &2.3956e+05_r8,1.7967e+05_r8,1.1978e+05_r8,5.9892e+04_r8,1.5032e+01_r8/) + kbo(:, 1,20,15) = (/ & + &2.3801e+05_r8,1.7851e+05_r8,1.1901e+05_r8,5.9503e+04_r8,2.0107e+01_r8/) + kbo(:, 2,20,15) = (/ & + &2.3824e+05_r8,1.7868e+05_r8,1.1912e+05_r8,5.9560e+04_r8,1.9545e+01_r8/) + kbo(:, 3,20,15) = (/ & + &2.3790e+05_r8,1.7842e+05_r8,1.1895e+05_r8,5.9475e+04_r8,1.8935e+01_r8/) + kbo(:, 4,20,15) = (/ & + &2.3694e+05_r8,1.7770e+05_r8,1.1847e+05_r8,5.9235e+04_r8,1.8318e+01_r8/) + kbo(:, 5,20,15) = (/ & + &2.3546e+05_r8,1.7659e+05_r8,1.1773e+05_r8,5.8866e+04_r8,1.6971e+01_r8/) + kbo(:, 1,21,15) = (/ & + &2.4153e+05_r8,1.8115e+05_r8,1.2077e+05_r8,6.0385e+04_r8,2.2844e+01_r8/) + kbo(:, 2,21,15) = (/ & + &2.4153e+05_r8,1.8115e+05_r8,1.2076e+05_r8,6.0383e+04_r8,2.2202e+01_r8/) + kbo(:, 3,21,15) = (/ & + &2.4090e+05_r8,1.8068e+05_r8,1.2045e+05_r8,6.0226e+04_r8,2.1535e+01_r8/) + kbo(:, 4,21,15) = (/ & + &2.3957e+05_r8,1.7968e+05_r8,1.1978e+05_r8,5.9893e+04_r8,2.0842e+01_r8/) + kbo(:, 5,21,15) = (/ & + &2.3762e+05_r8,1.7822e+05_r8,1.1881e+05_r8,5.9406e+04_r8,1.9479e+01_r8/) + kbo(:, 1,22,15) = (/ & + &2.5014e+05_r8,1.8760e+05_r8,1.2507e+05_r8,6.2536e+04_r8,2.6039e+01_r8/) + kbo(:, 2,22,15) = (/ & + &2.4958e+05_r8,1.8719e+05_r8,1.2479e+05_r8,6.2397e+04_r8,2.5280e+01_r8/) + kbo(:, 3,22,15) = (/ & + &2.4838e+05_r8,1.8628e+05_r8,1.2419e+05_r8,6.2096e+04_r8,2.4490e+01_r8/) + kbo(:, 4,22,15) = (/ & + &2.4655e+05_r8,1.8492e+05_r8,1.2328e+05_r8,6.1639e+04_r8,2.3671e+01_r8/) + kbo(:, 5,22,15) = (/ & + &2.4402e+05_r8,1.8302e+05_r8,1.2201e+05_r8,6.1006e+04_r8,2.2182e+01_r8/) + kbo(:, 1,23,15) = (/ & + &2.5892e+05_r8,1.9419e+05_r8,1.2946e+05_r8,6.4730e+04_r8,2.9635e+01_r8/) + kbo(:, 2,23,15) = (/ & + &2.5767e+05_r8,1.9325e+05_r8,1.2883e+05_r8,6.4418e+04_r8,2.8708e+01_r8/) + kbo(:, 3,23,15) = (/ & + &2.5584e+05_r8,1.9188e+05_r8,1.2792e+05_r8,6.3960e+04_r8,2.7743e+01_r8/) + kbo(:, 4,23,15) = (/ & + &2.5321e+05_r8,1.8991e+05_r8,1.2660e+05_r8,6.3303e+04_r8,2.6764e+01_r8/) + kbo(:, 5,23,15) = (/ & + &2.5010e+05_r8,1.8758e+05_r8,1.2505e+05_r8,6.2526e+04_r8,2.5122e+01_r8/) + kbo(:, 1,24,15) = (/ & + &2.6502e+05_r8,1.9877e+05_r8,1.3251e+05_r8,6.6257e+04_r8,3.3543e+01_r8/) + kbo(:, 2,24,15) = (/ & + &2.6308e+05_r8,1.9731e+05_r8,1.3154e+05_r8,6.5771e+04_r8,3.2390e+01_r8/) + kbo(:, 3,24,15) = (/ & + &2.6033e+05_r8,1.9524e+05_r8,1.3016e+05_r8,6.5082e+04_r8,3.1202e+01_r8/) + kbo(:, 4,24,15) = (/ & + &2.5704e+05_r8,1.9278e+05_r8,1.2852e+05_r8,6.4262e+04_r8,3.0027e+01_r8/) + kbo(:, 5,24,15) = (/ & + &2.5313e+05_r8,1.8984e+05_r8,1.2656e+05_r8,6.3282e+04_r8,2.8238e+01_r8/) + kbo(:, 1,25,15) = (/ & + &2.7306e+05_r8,2.0480e+05_r8,1.3653e+05_r8,6.8266e+04_r8,3.7656e+01_r8/) + kbo(:, 2,25,15) = (/ & + &2.7003e+05_r8,2.0252e+05_r8,1.3501e+05_r8,6.7507e+04_r8,3.6233e+01_r8/) + kbo(:, 3,25,15) = (/ & + &2.6644e+05_r8,1.9983e+05_r8,1.3322e+05_r8,6.6611e+04_r8,3.4804e+01_r8/) + kbo(:, 4,25,15) = (/ & + &2.6230e+05_r8,1.9672e+05_r8,1.3115e+05_r8,6.5574e+04_r8,3.3361e+01_r8/) + kbo(:, 5,25,15) = (/ & + &2.5745e+05_r8,1.9309e+05_r8,1.2873e+05_r8,6.4363e+04_r8,3.1338e+01_r8/) + kbo(:, 1,26,15) = (/ & + &2.8347e+05_r8,2.1261e+05_r8,1.4174e+05_r8,7.0869e+04_r8,4.1820e+01_r8/) + kbo(:, 2,26,15) = (/ & + &2.7951e+05_r8,2.0963e+05_r8,1.3976e+05_r8,6.9878e+04_r8,4.0076e+01_r8/) + kbo(:, 3,26,15) = (/ & + &2.7489e+05_r8,2.0617e+05_r8,1.3745e+05_r8,6.8723e+04_r8,3.8351e+01_r8/) + kbo(:, 4,26,15) = (/ & + &2.6958e+05_r8,2.0219e+05_r8,1.3479e+05_r8,6.7396e+04_r8,3.6631e+01_r8/) + kbo(:, 5,26,15) = (/ & + &2.6383e+05_r8,1.9788e+05_r8,1.3192e+05_r8,6.5959e+04_r8,3.4286e+01_r8/) + kbo(:, 1,27,15) = (/ & + &3.0277e+05_r8,2.2708e+05_r8,1.5139e+05_r8,7.5694e+04_r8,4.5895e+01_r8/) + kbo(:, 2,27,15) = (/ & + &2.9771e+05_r8,2.2329e+05_r8,1.4886e+05_r8,7.4429e+04_r8,4.3819e+01_r8/) + kbo(:, 3,27,15) = (/ & + &2.9175e+05_r8,2.1881e+05_r8,1.4587e+05_r8,7.2938e+04_r8,4.1746e+01_r8/) + kbo(:, 4,27,15) = (/ & + &2.8521e+05_r8,2.1391e+05_r8,1.4261e+05_r8,7.1304e+04_r8,3.9720e+01_r8/) + kbo(:, 5,27,15) = (/ & + &2.7826e+05_r8,2.0870e+05_r8,1.3913e+05_r8,6.9566e+04_r8,3.6964e+01_r8/) + kbo(:, 1,28,15) = (/ & + &3.2897e+05_r8,2.4673e+05_r8,1.6449e+05_r8,8.2243e+04_r8,4.9767e+01_r8/) + kbo(:, 2,28,15) = (/ & + &3.2244e+05_r8,2.4183e+05_r8,1.6122e+05_r8,8.0610e+04_r8,4.7309e+01_r8/) + kbo(:, 3,28,15) = (/ & + &3.1503e+05_r8,2.3628e+05_r8,1.5752e+05_r8,7.8759e+04_r8,4.4889e+01_r8/) + kbo(:, 4,28,15) = (/ & + &3.0709e+05_r8,2.3032e+05_r8,1.5355e+05_r8,7.6774e+04_r8,4.2541e+01_r8/) + kbo(:, 5,28,15) = (/ & + &2.9858e+05_r8,2.2393e+05_r8,1.4929e+05_r8,7.4645e+04_r8,3.9310e+01_r8/) + kbo(:, 1,29,15) = (/ & + &3.7585e+05_r8,2.8188e+05_r8,1.8792e+05_r8,9.3962e+04_r8,5.3281e+01_r8/) + kbo(:, 2,29,15) = (/ & + &3.6712e+05_r8,2.7534e+05_r8,1.8356e+05_r8,9.1780e+04_r8,5.0424e+01_r8/) + kbo(:, 3,29,15) = (/ & + &3.5767e+05_r8,2.6826e+05_r8,1.7884e+05_r8,8.9419e+04_r8,4.7662e+01_r8/) + kbo(:, 4,29,15) = (/ & + &3.4765e+05_r8,2.6073e+05_r8,1.7382e+05_r8,8.6912e+04_r8,4.4800e+01_r8/) + kbo(:, 5,29,15) = (/ & + &3.3714e+05_r8,2.5285e+05_r8,1.6857e+05_r8,8.4284e+04_r8,4.1166e+01_r8/) + kbo(:, 1,30,15) = (/ & + &4.3604e+05_r8,3.2703e+05_r8,2.1802e+05_r8,1.0901e+05_r8,5.6346e+01_r8/) + kbo(:, 2,30,15) = (/ & + &4.2462e+05_r8,3.1847e+05_r8,2.1231e+05_r8,1.0616e+05_r8,5.3119e+01_r8/) + kbo(:, 3,30,15) = (/ & + &4.1259e+05_r8,3.0944e+05_r8,2.0629e+05_r8,1.0315e+05_r8,5.0028e+01_r8/) + kbo(:, 4,30,15) = (/ & + &3.9989e+05_r8,2.9992e+05_r8,1.9995e+05_r8,9.9973e+04_r8,4.6067e+01_r8/) + kbo(:, 5,30,15) = (/ & + &3.8696e+05_r8,2.9022e+05_r8,1.9348e+05_r8,9.6741e+04_r8,4.3622e+01_r8/) + kbo(:, 1,31,15) = (/ & + &5.2737e+05_r8,3.9553e+05_r8,2.6369e+05_r8,1.3184e+05_r8,5.8898e+01_r8/) + kbo(:, 2,31,15) = (/ & + &5.1226e+05_r8,3.8420e+05_r8,2.5613e+05_r8,1.2807e+05_r8,5.5332e+01_r8/) + kbo(:, 3,31,15) = (/ & + &4.9638e+05_r8,3.7229e+05_r8,2.4819e+05_r8,1.2410e+05_r8,5.1303e+01_r8/) + kbo(:, 4,31,15) = (/ & + &4.8006e+05_r8,3.6004e+05_r8,2.4003e+05_r8,1.2001e+05_r8,4.7154e+01_r8/) + kbo(:, 5,31,15) = (/ & + &4.6345e+05_r8,3.4759e+05_r8,2.3173e+05_r8,1.1586e+05_r8,4.5673e+01_r8/) + kbo(:, 1,32,15) = (/ & + &6.4038e+05_r8,4.8028e+05_r8,3.2019e+05_r8,1.6010e+05_r8,6.0926e+01_r8/) + kbo(:, 2,32,15) = (/ & + &6.2037e+05_r8,4.6528e+05_r8,3.1019e+05_r8,1.5509e+05_r8,5.7062e+01_r8/) + kbo(:, 3,32,15) = (/ & + &5.9976e+05_r8,4.4982e+05_r8,2.9988e+05_r8,1.4994e+05_r8,5.1911e+01_r8/) + kbo(:, 4,32,15) = (/ & + &5.7886e+05_r8,4.3415e+05_r8,2.8943e+05_r8,1.4472e+05_r8,4.9758e+01_r8/) + kbo(:, 5,32,15) = (/ & + &5.5779e+05_r8,4.1835e+05_r8,2.7890e+05_r8,1.3945e+05_r8,4.7124e+01_r8/) + kbo(:, 1,33,15) = (/ & + &7.8604e+05_r8,5.8953e+05_r8,3.9302e+05_r8,1.9651e+05_r8,6.2449e+01_r8/) + kbo(:, 2,33,15) = (/ & + &7.5994e+05_r8,5.6995e+05_r8,3.7997e+05_r8,1.8999e+05_r8,5.7026e+01_r8/) + kbo(:, 3,33,15) = (/ & + &7.3324e+05_r8,5.4993e+05_r8,3.6662e+05_r8,1.8331e+05_r8,5.3959e+01_r8/) + kbo(:, 4,33,15) = (/ & + &7.0633e+05_r8,5.2975e+05_r8,3.5316e+05_r8,1.7658e+05_r8,5.1185e+01_r8/) + kbo(:, 5,33,15) = (/ & + &6.7933e+05_r8,5.0950e+05_r8,3.3967e+05_r8,1.6983e+05_r8,4.6145e+01_r8/) + kbo(:, 1,34,15) = (/ & + &9.3629e+05_r8,7.0222e+05_r8,4.6814e+05_r8,2.3407e+05_r8,6.2950e+01_r8/) + kbo(:, 2,34,15) = (/ & + &9.0361e+05_r8,6.7770e+05_r8,4.5180e+05_r8,2.2590e+05_r8,5.7628e+01_r8/) + kbo(:, 3,34,15) = (/ & + &8.7048e+05_r8,6.5286e+05_r8,4.3524e+05_r8,2.1762e+05_r8,5.5397e+01_r8/) + kbo(:, 4,34,15) = (/ & + &8.3718e+05_r8,6.2788e+05_r8,4.1859e+05_r8,2.0929e+05_r8,5.1885e+01_r8/) + kbo(:, 5,34,15) = (/ & + &8.0393e+05_r8,6.0294e+05_r8,4.0196e+05_r8,2.0098e+05_r8,4.4833e+01_r8/) + kbo(:, 1,35,15) = (/ & + &1.1151e+06_r8,8.3633e+05_r8,5.5755e+05_r8,2.7878e+05_r8,6.3401e+01_r8/) + kbo(:, 2,35,15) = (/ & + &1.0748e+06_r8,8.0608e+05_r8,5.3739e+05_r8,2.6869e+05_r8,5.9975e+01_r8/) + kbo(:, 3,35,15) = (/ & + &1.0341e+06_r8,7.7556e+05_r8,5.1704e+05_r8,2.5852e+05_r8,5.6633e+01_r8/) + kbo(:, 4,35,15) = (/ & + &9.9325e+05_r8,7.4494e+05_r8,4.9662e+05_r8,2.4831e+05_r8,5.0172e+01_r8/) + kbo(:, 5,35,15) = (/ & + &9.5274e+05_r8,7.1455e+05_r8,4.7637e+05_r8,2.3818e+05_r8,4.3180e+01_r8/) + kbo(:, 1,36,15) = (/ & + &1.3204e+06_r8,9.9032e+05_r8,6.6021e+05_r8,3.3011e+05_r8,6.4479e+01_r8/) + kbo(:, 2,36,15) = (/ & + &1.2713e+06_r8,9.5347e+05_r8,6.3565e+05_r8,3.1782e+05_r8,6.1661e+01_r8/) + kbo(:, 3,36,15) = (/ & + &1.2219e+06_r8,9.1640e+05_r8,6.1093e+05_r8,3.0547e+05_r8,5.7543e+01_r8/) + kbo(:, 4,36,15) = (/ & + &1.1726e+06_r8,8.7947e+05_r8,5.8632e+05_r8,2.9316e+05_r8,4.9268e+01_r8/) + kbo(:, 5,36,15) = (/ & + &1.1240e+06_r8,8.4303e+05_r8,5.6202e+05_r8,2.8101e+05_r8,4.3422e+01_r8/) + kbo(:, 1,37,15) = (/ & + &1.5283e+06_r8,1.1462e+06_r8,7.6413e+05_r8,3.8207e+05_r8,6.6367e+01_r8/) + kbo(:, 2,37,15) = (/ & + &1.4706e+06_r8,1.1030e+06_r8,7.3532e+05_r8,3.6766e+05_r8,6.3620e+01_r8/) + kbo(:, 3,37,15) = (/ & + &1.4128e+06_r8,1.0596e+06_r8,7.0638e+05_r8,3.5319e+05_r8,5.8851e+01_r8/) + kbo(:, 4,37,15) = (/ & + &1.3549e+06_r8,1.0162e+06_r8,6.7744e+05_r8,3.3872e+05_r8,4.8460e+01_r8/) + kbo(:, 5,37,15) = (/ & + &1.2980e+06_r8,9.7352e+05_r8,6.4901e+05_r8,3.2451e+05_r8,4.3139e+01_r8/) + kbo(:, 1,38,15) = (/ & + &1.7917e+06_r8,1.3437e+06_r8,8.9582e+05_r8,4.4791e+05_r8,6.8827e+01_r8/) + kbo(:, 2,38,15) = (/ & + &1.7232e+06_r8,1.2924e+06_r8,8.6157e+05_r8,4.3078e+05_r8,6.5495e+01_r8/) + kbo(:, 3,38,15) = (/ & + &1.6545e+06_r8,1.2409e+06_r8,8.2724e+05_r8,4.1362e+05_r8,5.8860e+01_r8/) + kbo(:, 4,38,15) = (/ & + &1.5862e+06_r8,1.1896e+06_r8,7.9309e+05_r8,3.9654e+05_r8,4.7251e+01_r8/) + kbo(:, 5,38,15) = (/ & + &1.5188e+06_r8,1.1391e+06_r8,7.5940e+05_r8,3.7970e+05_r8,4.3731e+01_r8/) + kbo(:, 1,39,15) = (/ & + &2.1445e+06_r8,1.6084e+06_r8,1.0723e+06_r8,5.3613e+05_r8,7.1068e+01_r8/) + kbo(:, 2,39,15) = (/ & + &2.0613e+06_r8,1.5460e+06_r8,1.0307e+06_r8,5.1533e+05_r8,6.6419e+01_r8/) + kbo(:, 3,39,15) = (/ & + &1.9786e+06_r8,1.4840e+06_r8,9.8932e+05_r8,4.9466e+05_r8,5.6988e+01_r8/) + kbo(:, 4,39,15) = (/ & + &1.8964e+06_r8,1.4223e+06_r8,9.4822e+05_r8,4.7411e+05_r8,4.6537e+01_r8/) + kbo(:, 5,39,15) = (/ & + &1.8152e+06_r8,1.3614e+06_r8,9.0762e+05_r8,4.5381e+05_r8,4.1463e+01_r8/) + kbo(:, 1,40,15) = (/ & + &2.4170e+06_r8,1.8127e+06_r8,1.2085e+06_r8,6.0424e+05_r8,7.3096e+01_r8/) + kbo(:, 2,40,15) = (/ & + &2.3226e+06_r8,1.7420e+06_r8,1.1613e+06_r8,5.8063e+05_r8,6.8150e+01_r8/) + kbo(:, 3,40,15) = (/ & + &2.2296e+06_r8,1.6722e+06_r8,1.1148e+06_r8,5.5739e+05_r8,5.8979e+01_r8/) + kbo(:, 4,40,15) = (/ & + &2.1366e+06_r8,1.6025e+06_r8,1.0683e+06_r8,5.3415e+05_r8,4.7816e+01_r8/) + kbo(:, 5,40,15) = (/ & + &2.0448e+06_r8,1.5336e+06_r8,1.0224e+06_r8,5.1120e+05_r8,4.2008e+01_r8/) + kbo(:, 1,41,15) = (/ & + &2.7164e+06_r8,2.0373e+06_r8,1.3582e+06_r8,6.7911e+05_r8,7.4782e+01_r8/) + kbo(:, 2,41,15) = (/ & + &2.6095e+06_r8,1.9571e+06_r8,1.3048e+06_r8,6.5238e+05_r8,6.9972e+01_r8/) + kbo(:, 3,41,15) = (/ & + &2.5049e+06_r8,1.8787e+06_r8,1.2525e+06_r8,6.2623e+05_r8,6.0957e+01_r8/) + kbo(:, 4,41,15) = (/ & + &2.4006e+06_r8,1.8005e+06_r8,1.2003e+06_r8,6.0017e+05_r8,4.9097e+01_r8/) + kbo(:, 5,41,15) = (/ & + &2.2975e+06_r8,1.7231e+06_r8,1.1487e+06_r8,5.7438e+05_r8,4.2980e+01_r8/) + kbo(:, 1,42,15) = (/ & + &3.0827e+06_r8,2.3120e+06_r8,1.5413e+06_r8,7.7067e+05_r8,7.6123e+01_r8/) + kbo(:, 2,42,15) = (/ & + &2.9612e+06_r8,2.2209e+06_r8,1.4806e+06_r8,7.4030e+05_r8,7.1662e+01_r8/) + kbo(:, 3,42,15) = (/ & + &2.8423e+06_r8,2.1317e+06_r8,1.4211e+06_r8,7.1056e+05_r8,6.2602e+01_r8/) + kbo(:, 4,42,15) = (/ & + &2.7244e+06_r8,2.0433e+06_r8,1.3622e+06_r8,6.8108e+05_r8,5.0093e+01_r8/) + kbo(:, 5,42,15) = (/ & + &2.6071e+06_r8,1.9553e+06_r8,1.3035e+06_r8,6.5176e+05_r8,4.3774e+01_r8/) + kbo(:, 1,43,15) = (/ & + &3.5341e+06_r8,2.6506e+06_r8,1.7671e+06_r8,8.8353e+05_r8,7.8436e+01_r8/) + kbo(:, 2,43,15) = (/ & + &3.3959e+06_r8,2.5467e+06_r8,1.6978e+06_r8,8.4891e+05_r8,7.3775e+01_r8/) + kbo(:, 3,43,15) = (/ & + &3.2585e+06_r8,2.4439e+06_r8,1.6293e+06_r8,8.1464e+05_r8,6.4695e+01_r8/) + kbo(:, 4,43,15) = (/ & + &3.1244e+06_r8,2.3433e+06_r8,1.5622e+06_r8,7.8111e+05_r8,5.1912e+01_r8/) + kbo(:, 5,43,15) = (/ & + &2.9906e+06_r8,2.2429e+06_r8,1.4953e+06_r8,7.4765e+05_r8,4.5444e+01_r8/) + kbo(:, 1,44,15) = (/ & + &4.1097e+06_r8,3.0823e+06_r8,2.0548e+06_r8,1.0274e+06_r8,8.1119e+01_r8/) + kbo(:, 2,44,15) = (/ & + &3.9487e+06_r8,2.9615e+06_r8,1.9743e+06_r8,9.8717e+05_r8,7.5797e+01_r8/) + kbo(:, 3,44,15) = (/ & + &3.7894e+06_r8,2.8420e+06_r8,1.8947e+06_r8,9.4733e+05_r8,6.6793e+01_r8/) + kbo(:, 4,44,15) = (/ & + &3.6341e+06_r8,2.7256e+06_r8,1.8170e+06_r8,9.0851e+05_r8,5.3433e+01_r8/) + kbo(:, 5,44,15) = (/ & + &3.4797e+06_r8,2.6097e+06_r8,1.7398e+06_r8,8.6990e+05_r8,4.7406e+01_r8/) + kbo(:, 1,45,15) = (/ & + &4.8722e+06_r8,3.6542e+06_r8,2.4361e+06_r8,1.2181e+06_r8,8.3949e+01_r8/) + kbo(:, 2,45,15) = (/ & + &4.6827e+06_r8,3.5120e+06_r8,2.3413e+06_r8,1.1707e+06_r8,7.7974e+01_r8/) + kbo(:, 3,45,15) = (/ & + &4.4945e+06_r8,3.3709e+06_r8,2.2473e+06_r8,1.1236e+06_r8,6.9073e+01_r8/) + kbo(:, 4,45,15) = (/ & + &4.3103e+06_r8,3.2327e+06_r8,2.1551e+06_r8,1.0776e+06_r8,5.6213e+01_r8/) + kbo(:, 5,45,15) = (/ & + &4.1290e+06_r8,3.0968e+06_r8,2.0645e+06_r8,1.0323e+06_r8,4.8762e+01_r8/) + kbo(:, 1,46,15) = (/ & + &5.8372e+06_r8,4.3779e+06_r8,2.9186e+06_r8,1.4593e+06_r8,8.7007e+01_r8/) + kbo(:, 2,46,15) = (/ & + &5.6126e+06_r8,4.2094e+06_r8,2.8063e+06_r8,1.4031e+06_r8,8.0166e+01_r8/) + kbo(:, 3,46,15) = (/ & + &5.3885e+06_r8,4.0414e+06_r8,2.6943e+06_r8,1.3471e+06_r8,7.0991e+01_r8/) + kbo(:, 4,46,15) = (/ & + &5.1687e+06_r8,3.8765e+06_r8,2.5843e+06_r8,1.2922e+06_r8,5.9015e+01_r8/) + kbo(:, 5,46,15) = (/ & + &4.9529e+06_r8,3.7147e+06_r8,2.4764e+06_r8,1.2382e+06_r8,5.0566e+01_r8/) + kbo(:, 1,47,15) = (/ & + &6.9385e+06_r8,5.2039e+06_r8,3.4693e+06_r8,1.7346e+06_r8,9.1194e+01_r8/) + kbo(:, 2,47,15) = (/ & + &6.6774e+06_r8,5.0081e+06_r8,3.3387e+06_r8,1.6694e+06_r8,8.2417e+01_r8/) + kbo(:, 3,47,15) = (/ & + &6.4127e+06_r8,4.8095e+06_r8,3.2064e+06_r8,1.6032e+06_r8,7.5225e+01_r8/) + kbo(:, 4,47,15) = (/ & + &6.1518e+06_r8,4.6139e+06_r8,3.0759e+06_r8,1.5380e+06_r8,6.2982e+01_r8/) + kbo(:, 5,47,15) = (/ & + &5.8970e+06_r8,4.4228e+06_r8,2.9485e+06_r8,1.4743e+06_r8,5.3315e+01_r8/) + kbo(:, 1,48,15) = (/ & + &8.4803e+06_r8,6.3603e+06_r8,4.2402e+06_r8,2.1201e+06_r8,9.5233e+01_r8/) + kbo(:, 2,48,15) = (/ & + &8.1666e+06_r8,6.1249e+06_r8,4.0833e+06_r8,2.0417e+06_r8,8.3938e+01_r8/) + kbo(:, 3,48,15) = (/ & + &7.8474e+06_r8,5.8855e+06_r8,3.9237e+06_r8,1.9618e+06_r8,7.8581e+01_r8/) + kbo(:, 4,48,15) = (/ & + &7.5308e+06_r8,5.6481e+06_r8,3.7654e+06_r8,1.8827e+06_r8,6.5837e+01_r8/) + kbo(:, 5,48,15) = (/ & + &7.2194e+06_r8,5.4145e+06_r8,3.6097e+06_r8,1.8049e+06_r8,5.5833e+01_r8/) + kbo(:, 1,49,15) = (/ & + &1.0795e+07_r8,8.0961e+06_r8,5.3974e+06_r8,2.6987e+06_r8,9.8694e+01_r8/) + kbo(:, 2,49,15) = (/ & + &1.0405e+07_r8,7.8035e+06_r8,5.2023e+06_r8,2.6011e+06_r8,8.7441e+01_r8/) + kbo(:, 3,49,15) = (/ & + &1.0006e+07_r8,7.5045e+06_r8,5.0030e+06_r8,2.5015e+06_r8,8.1233e+01_r8/) + kbo(:, 4,49,15) = (/ & + &9.6057e+06_r8,7.2043e+06_r8,4.8028e+06_r8,2.4014e+06_r8,6.9160e+01_r8/) + kbo(:, 5,49,15) = (/ & + &9.2104e+06_r8,6.9078e+06_r8,4.6052e+06_r8,2.3026e+06_r8,5.7442e+01_r8/) + kbo(:, 1,50,15) = (/ & + &1.3074e+07_r8,9.8054e+06_r8,6.5369e+06_r8,3.2685e+06_r8,1.0218e+02_r8/) + kbo(:, 2,50,15) = (/ & + &1.2610e+07_r8,9.4575e+06_r8,6.3050e+06_r8,3.1525e+06_r8,9.1395e+01_r8/) + kbo(:, 3,50,15) = (/ & + &1.2137e+07_r8,9.1025e+06_r8,6.0683e+06_r8,3.0342e+06_r8,8.4017e+01_r8/) + kbo(:, 4,50,15) = (/ & + &1.1655e+07_r8,8.7414e+06_r8,5.8276e+06_r8,2.9138e+06_r8,7.1620e+01_r8/) + kbo(:, 5,50,15) = (/ & + &1.1180e+07_r8,8.3848e+06_r8,5.5899e+06_r8,2.7949e+06_r8,6.0411e+01_r8/) + kbo(:, 1,51,15) = (/ & + &1.5480e+07_r8,1.1610e+07_r8,7.7399e+06_r8,3.8700e+06_r8,1.0595e+02_r8/) + kbo(:, 2,51,15) = (/ & + &1.4942e+07_r8,1.1207e+07_r8,7.4711e+06_r8,3.7356e+06_r8,9.5091e+01_r8/) + kbo(:, 3,51,15) = (/ & + &1.4390e+07_r8,1.0793e+07_r8,7.1952e+06_r8,3.5976e+06_r8,8.6843e+01_r8/) + kbo(:, 4,51,15) = (/ & + &1.3829e+07_r8,1.0371e+07_r8,6.9143e+06_r8,3.4572e+06_r8,7.4583e+01_r8/) + kbo(:, 5,51,15) = (/ & + &1.3268e+07_r8,9.9514e+06_r8,6.6343e+06_r8,3.3171e+06_r8,6.4529e+01_r8/) + kbo(:, 1,52,15) = (/ & + &1.8848e+07_r8,1.4136e+07_r8,9.4240e+06_r8,4.7120e+06_r8,1.0974e+02_r8/) + kbo(:, 2,52,15) = (/ & + &1.8206e+07_r8,1.3654e+07_r8,9.1030e+06_r8,4.5515e+06_r8,9.9547e+01_r8/) + kbo(:, 3,52,15) = (/ & + &1.7547e+07_r8,1.3161e+07_r8,8.7738e+06_r8,4.3869e+06_r8,8.9552e+01_r8/) + kbo(:, 4,52,15) = (/ & + &1.6877e+07_r8,1.2658e+07_r8,8.4384e+06_r8,4.2192e+06_r8,7.7635e+01_r8/) + kbo(:, 5,52,15) = (/ & + &1.6199e+07_r8,1.2149e+07_r8,8.0997e+06_r8,4.0499e+06_r8,6.8061e+01_r8/) + kbo(:, 1,53,15) = (/ & + &2.3903e+07_r8,1.7928e+07_r8,1.1952e+07_r8,5.9760e+06_r8,1.1360e+02_r8/) + kbo(:, 2,53,15) = (/ & + &2.3112e+07_r8,1.7334e+07_r8,1.1556e+07_r8,5.7781e+06_r8,1.0455e+02_r8/) + kbo(:, 3,53,15) = (/ & + &2.2293e+07_r8,1.6719e+07_r8,1.1146e+07_r8,5.5732e+06_r8,9.2320e+01_r8/) + kbo(:, 4,53,15) = (/ & + &2.1455e+07_r8,1.6091e+07_r8,1.0728e+07_r8,5.3638e+06_r8,8.0467e+01_r8/) + kbo(:, 5,53,15) = (/ & + &2.0604e+07_r8,1.5453e+07_r8,1.0302e+07_r8,5.1511e+06_r8,7.1688e+01_r8/) + kbo(:, 1,54,15) = (/ & + &2.6168e+07_r8,1.9626e+07_r8,1.3084e+07_r8,6.5420e+06_r8,1.1792e+02_r8/) + kbo(:, 2,54,15) = (/ & + &2.5326e+07_r8,1.8995e+07_r8,1.2663e+07_r8,6.3316e+06_r8,1.0689e+02_r8/) + kbo(:, 3,54,15) = (/ & + &2.4445e+07_r8,1.8334e+07_r8,1.2223e+07_r8,6.1114e+06_r8,9.4623e+01_r8/) + kbo(:, 4,54,15) = (/ & + &2.3543e+07_r8,1.7657e+07_r8,1.1772e+07_r8,5.8858e+06_r8,8.6034e+01_r8/) + kbo(:, 5,54,15) = (/ & + &2.2624e+07_r8,1.6968e+07_r8,1.1312e+07_r8,5.6560e+06_r8,7.5610e+01_r8/) + kbo(:, 1,55,15) = (/ & + &2.6110e+07_r8,1.9583e+07_r8,1.3055e+07_r8,6.5277e+06_r8,1.2293e+02_r8/) + kbo(:, 2,55,15) = (/ & + &2.5298e+07_r8,1.8974e+07_r8,1.2649e+07_r8,6.3247e+06_r8,1.0996e+02_r8/) + kbo(:, 3,55,15) = (/ & + &2.4435e+07_r8,1.8326e+07_r8,1.2218e+07_r8,6.1089e+06_r8,1.0025e+02_r8/) + kbo(:, 4,55,15) = (/ & + &2.3548e+07_r8,1.7661e+07_r8,1.1774e+07_r8,5.8870e+06_r8,8.9943e+01_r8/) + kbo(:, 5,55,15) = (/ & + &2.2646e+07_r8,1.6984e+07_r8,1.1323e+07_r8,5.6615e+06_r8,7.8052e+01_r8/) + kbo(:, 1,56,15) = (/ & + &2.6049e+07_r8,1.9537e+07_r8,1.3025e+07_r8,6.5123e+06_r8,1.2801e+02_r8/) + kbo(:, 2,56,15) = (/ & + &2.5263e+07_r8,1.8947e+07_r8,1.2631e+07_r8,6.3155e+06_r8,1.1426e+02_r8/) + kbo(:, 3,56,15) = (/ & + &2.4422e+07_r8,1.8316e+07_r8,1.2211e+07_r8,6.1054e+06_r8,1.0290e+02_r8/) + kbo(:, 4,56,15) = (/ & + &2.3554e+07_r8,1.7665e+07_r8,1.1777e+07_r8,5.8883e+06_r8,9.1587e+01_r8/) + kbo(:, 5,56,15) = (/ & + &2.2663e+07_r8,1.6997e+07_r8,1.1331e+07_r8,5.6657e+06_r8,8.3726e+01_r8/) + kbo(:, 1,57,15) = (/ & + &2.5975e+07_r8,1.9481e+07_r8,1.2987e+07_r8,6.4936e+06_r8,1.3227e+02_r8/) + kbo(:, 2,57,15) = (/ & + &2.5221e+07_r8,1.8915e+07_r8,1.2610e+07_r8,6.3050e+06_r8,1.1939e+02_r8/) + kbo(:, 3,57,15) = (/ & + &2.4401e+07_r8,1.8301e+07_r8,1.2201e+07_r8,6.1003e+06_r8,1.0672e+02_r8/) + kbo(:, 4,57,15) = (/ & + &2.3548e+07_r8,1.7661e+07_r8,1.1774e+07_r8,5.8869e+06_r8,9.6378e+01_r8/) + kbo(:, 5,57,15) = (/ & + &2.2676e+07_r8,1.7007e+07_r8,1.1338e+07_r8,5.6688e+06_r8,8.7523e+01_r8/) + kbo(:, 1,58,15) = (/ & + &6.8249e+06_r8,6.2574e+06_r8,5.3652e+06_r8,3.7577e+06_r8,1.3651e+02_r8/) + kbo(:, 2,58,15) = (/ & + &6.6343e+06_r8,6.0826e+06_r8,5.2153e+06_r8,3.6528e+06_r8,1.2352e+02_r8/) + kbo(:, 3,58,15) = (/ & + &6.4258e+06_r8,5.8914e+06_r8,5.0514e+06_r8,3.5379e+06_r8,1.1077e+02_r8/) + kbo(:, 4,58,15) = (/ & + &6.2048e+06_r8,5.6888e+06_r8,4.8776e+06_r8,3.4163e+06_r8,9.9878e+01_r8/) + kbo(:, 5,58,15) = (/ & + &5.9792e+06_r8,5.4820e+06_r8,4.7004e+06_r8,3.2921e+06_r8,8.9433e+01_r8/) + kbo(:, 1,59,15) = (/ & + &7.9949e+06_r8,6.9809e+06_r8,5.5683e+06_r8,3.4650e+06_r8,1.3832e+02_r8/) + kbo(:, 2,59,15) = (/ & + &7.7778e+06_r8,6.7913e+06_r8,5.4171e+06_r8,3.3709e+06_r8,1.2505e+02_r8/) + kbo(:, 3,59,15) = (/ & + &7.5359e+06_r8,6.5801e+06_r8,5.2486e+06_r8,3.2660e+06_r8,1.1363e+02_r8/) + kbo(:, 4,59,15) = (/ & + &7.2794e+06_r8,6.3561e+06_r8,5.0700e+06_r8,3.1549e+06_r8,1.0324e+02_r8/) + kbo(:, 5,59,15) = (/ & + &7.0157e+06_r8,6.1258e+06_r8,4.8863e+06_r8,3.0406e+06_r8,9.1722e+01_r8/) + kbo(:, 1,13,16) = (/ & + &7.4591e+05_r8,5.5944e+05_r8,3.7296e+05_r8,1.8648e+05_r8,1.0589e+01_r8/) + kbo(:, 2,13,16) = (/ & + &7.4121e+05_r8,5.5591e+05_r8,3.7061e+05_r8,1.8530e+05_r8,1.0476e+01_r8/) + kbo(:, 3,13,16) = (/ & + &7.3660e+05_r8,5.5245e+05_r8,3.6830e+05_r8,1.8415e+05_r8,6.4518e+00_r8/) + kbo(:, 4,13,16) = (/ & + &7.3017e+05_r8,5.4763e+05_r8,3.6509e+05_r8,1.8254e+05_r8,7.2400e-02_r8/) + kbo(:, 5,13,16) = (/ & + &7.2523e+05_r8,5.4392e+05_r8,3.6262e+05_r8,1.8131e+05_r8,8.3840e-02_r8/) + kbo(:, 1,14,16) = (/ & + &5.4546e+05_r8,4.0910e+05_r8,2.7273e+05_r8,1.3636e+05_r8,1.2083e+01_r8/) + kbo(:, 2,14,16) = (/ & + &5.4530e+05_r8,4.0897e+05_r8,2.7264e+05_r8,1.3632e+05_r8,1.1940e+01_r8/) + kbo(:, 3,14,16) = (/ & + &5.4326e+05_r8,4.0739e+05_r8,2.7163e+05_r8,1.3581e+05_r8,1.1721e+01_r8/) + kbo(:, 4,14,16) = (/ & + &5.4132e+05_r8,4.0599e+05_r8,2.7066e+05_r8,1.3533e+05_r8,4.5827e+00_r8/) + kbo(:, 5,14,16) = (/ & + &5.3886e+05_r8,4.0414e+05_r8,2.6943e+05_r8,1.3471e+05_r8,7.8150e-02_r8/) + kbo(:, 1,15,16) = (/ & + &4.1181e+05_r8,3.0886e+05_r8,2.0591e+05_r8,1.0295e+05_r8,1.3732e+01_r8/) + kbo(:, 2,15,16) = (/ & + &4.1235e+05_r8,3.0926e+05_r8,2.0618e+05_r8,1.0309e+05_r8,1.3536e+01_r8/) + kbo(:, 3,15,16) = (/ & + &4.1248e+05_r8,3.0936e+05_r8,2.0624e+05_r8,1.0312e+05_r8,1.3259e+01_r8/) + kbo(:, 4,15,16) = (/ & + &4.1181e+05_r8,3.0886e+05_r8,2.0591e+05_r8,1.0296e+05_r8,1.2919e+01_r8/) + kbo(:, 5,15,16) = (/ & + &4.1010e+05_r8,3.0757e+05_r8,2.0505e+05_r8,1.0253e+05_r8,4.0719e+00_r8/) + kbo(:, 1,16,16) = (/ & + &3.7257e+05_r8,2.7672e+05_r8,1.8628e+05_r8,9.3143e+04_r8,1.5485e+01_r8/) + kbo(:, 2,16,16) = (/ & + &3.7431e+05_r8,2.8074e+05_r8,1.8716e+05_r8,9.3579e+04_r8,1.5222e+01_r8/) + kbo(:, 3,16,16) = (/ & + &3.7500e+05_r8,2.8129e+05_r8,1.8753e+05_r8,9.3763e+04_r8,1.4862e+01_r8/) + kbo(:, 4,16,16) = (/ & + &3.7444e+05_r8,2.8083e+05_r8,1.8722e+05_r8,9.3612e+04_r8,1.4438e+01_r8/) + kbo(:, 5,16,16) = (/ & + &3.7332e+05_r8,2.7999e+05_r8,1.8666e+05_r8,9.3332e+04_r8,7.6230e+00_r8/) + kbo(:, 1,17,16) = (/ & + &3.5182e+05_r8,2.6386e+05_r8,1.7591e+05_r8,8.7955e+04_r8,1.7290e+01_r8/) + kbo(:, 2,17,16) = (/ & + &3.5397e+05_r8,2.6547e+05_r8,1.7698e+05_r8,8.8492e+04_r8,1.6932e+01_r8/) + kbo(:, 3,17,16) = (/ & + &3.5462e+05_r8,2.6597e+05_r8,1.7731e+05_r8,8.8656e+04_r8,1.6480e+01_r8/) + kbo(:, 4,17,16) = (/ & + &3.5402e+05_r8,2.6552e+05_r8,1.7701e+05_r8,8.8507e+04_r8,1.5962e+01_r8/) + kbo(:, 5,17,16) = (/ & + &3.5314e+05_r8,2.6486e+05_r8,1.7657e+05_r8,8.8287e+04_r8,1.0353e+01_r8/) + kbo(:, 1,18,16) = (/ & + &3.4176e+05_r8,2.5632e+05_r8,1.7088e+05_r8,8.5439e+04_r8,1.9139e+01_r8/) + kbo(:, 2,18,16) = (/ & + &3.4367e+05_r8,2.5775e+05_r8,1.7183e+05_r8,8.5917e+04_r8,1.8641e+01_r8/) + kbo(:, 3,18,16) = (/ & + &3.4399e+05_r8,2.5800e+05_r8,1.7200e+05_r8,8.5999e+04_r8,1.8079e+01_r8/) + kbo(:, 4,18,16) = (/ & + &3.4376e+05_r8,2.5782e+05_r8,1.7188e+05_r8,8.5941e+04_r8,1.7627e+01_r8/) + kbo(:, 5,18,16) = (/ & + &3.4258e+05_r8,2.5694e+05_r8,1.7129e+05_r8,8.5646e+04_r8,1.3174e+01_r8/) + kbo(:, 1,19,16) = (/ & + &3.2677e+05_r8,2.4508e+05_r8,1.6338e+05_r8,8.1692e+04_r8,2.1598e+01_r8/) + kbo(:, 2,19,16) = (/ & + &3.2775e+05_r8,2.4581e+05_r8,1.6387e+05_r8,8.1937e+04_r8,2.1013e+01_r8/) + kbo(:, 3,19,16) = (/ & + &3.2835e+05_r8,2.4626e+05_r8,1.6417e+05_r8,8.2068e+04_r8,2.0530e+01_r8/) + kbo(:, 4,19,16) = (/ & + &3.2780e+05_r8,2.4585e+05_r8,1.6390e+05_r8,8.1950e+04_r8,2.0057e+01_r8/) + kbo(:, 5,19,16) = (/ & + &3.2322e+05_r8,2.4484e+05_r8,1.6323e+05_r8,8.1613e+04_r8,1.8218e+01_r8/) + kbo(:, 1,20,16) = (/ & + &3.3791e+05_r8,2.5343e+05_r8,1.6896e+05_r8,8.4478e+04_r8,2.4811e+01_r8/) + kbo(:, 2,20,16) = (/ & + &3.3834e+05_r8,2.5376e+05_r8,1.6917e+05_r8,8.4586e+04_r8,2.4163e+01_r8/) + kbo(:, 3,20,16) = (/ & + &3.3842e+05_r8,2.5381e+05_r8,1.6921e+05_r8,8.4605e+04_r8,2.3647e+01_r8/) + kbo(:, 4,20,16) = (/ & + &3.3728e+05_r8,2.5296e+05_r8,1.6864e+05_r8,8.4321e+04_r8,2.3144e+01_r8/) + kbo(:, 5,20,16) = (/ & + &3.3569e+05_r8,2.5177e+05_r8,1.6785e+05_r8,8.3923e+04_r8,2.2618e+01_r8/) + kbo(:, 1,21,16) = (/ & + &3.5913e+05_r8,2.6935e+05_r8,1.7956e+05_r8,8.9782e+04_r8,2.8889e+01_r8/) + kbo(:, 2,21,16) = (/ & + &3.5914e+05_r8,2.6936e+05_r8,1.7957e+05_r8,8.9786e+04_r8,2.8114e+01_r8/) + kbo(:, 3,21,16) = (/ & + &3.5794e+05_r8,2.6846e+05_r8,1.7897e+05_r8,8.9486e+04_r8,2.7459e+01_r8/) + kbo(:, 4,21,16) = (/ & + &3.5626e+05_r8,2.6720e+05_r8,1.7813e+05_r8,8.9066e+04_r8,2.6836e+01_r8/) + kbo(:, 5,21,16) = (/ & + &3.5369e+05_r8,2.6527e+05_r8,1.7684e+05_r8,8.8423e+04_r8,2.6161e+01_r8/) + kbo(:, 1,22,16) = (/ & + &3.8948e+05_r8,2.9211e+05_r8,1.9474e+05_r8,9.7369e+04_r8,3.3724e+01_r8/) + kbo(:, 2,22,16) = (/ & + &3.8828e+05_r8,2.9121e+05_r8,1.9414e+05_r8,9.7069e+04_r8,3.2720e+01_r8/) + kbo(:, 3,22,16) = (/ & + &3.8560e+05_r8,2.8920e+05_r8,1.9280e+05_r8,9.6401e+04_r8,3.1834e+01_r8/) + kbo(:, 4,22,16) = (/ & + &3.8253e+05_r8,2.8690e+05_r8,1.9127e+05_r8,9.5633e+04_r8,3.0971e+01_r8/) + kbo(:, 5,22,16) = (/ & + &3.7845e+05_r8,2.8383e+05_r8,1.8922e+05_r8,9.4612e+04_r8,3.0080e+01_r8/) + kbo(:, 1,23,16) = (/ & + &4.2147e+05_r8,3.1611e+05_r8,2.1074e+05_r8,1.0537e+05_r8,3.9276e+01_r8/) + kbo(:, 2,23,16) = (/ & + &4.1843e+05_r8,3.1382e+05_r8,2.0921e+05_r8,1.0461e+05_r8,3.7947e+01_r8/) + kbo(:, 3,23,16) = (/ & + &4.1438e+05_r8,3.1079e+05_r8,2.0719e+05_r8,1.0360e+05_r8,3.6734e+01_r8/) + kbo(:, 4,23,16) = (/ & + &4.0918e+05_r8,3.0688e+05_r8,2.0459e+05_r8,1.0230e+05_r8,3.5522e+01_r8/) + kbo(:, 5,23,16) = (/ & + &4.0269e+05_r8,3.0202e+05_r8,2.0135e+05_r8,1.0067e+05_r8,3.4322e+01_r8/) + kbo(:, 1,24,16) = (/ & + &4.4910e+05_r8,3.3682e+05_r8,2.2455e+05_r8,1.1228e+05_r8,4.5446e+01_r8/) + kbo(:, 2,24,16) = (/ & + &4.4436e+05_r8,3.3327e+05_r8,2.2218e+05_r8,1.1109e+05_r8,4.3684e+01_r8/) + kbo(:, 3,24,16) = (/ & + &4.3822e+05_r8,3.2867e+05_r8,2.1911e+05_r8,1.0956e+05_r8,4.2010e+01_r8/) + kbo(:, 4,24,16) = (/ & + &4.3055e+05_r8,3.2291e+05_r8,2.1528e+05_r8,1.0764e+05_r8,4.0380e+01_r8/) + kbo(:, 5,24,16) = (/ & + &4.2183e+05_r8,3.1637e+05_r8,2.1092e+05_r8,1.0546e+05_r8,3.8819e+01_r8/) + kbo(:, 1,25,16) = (/ & + &4.7951e+05_r8,3.5963e+05_r8,2.3975e+05_r8,1.1988e+05_r8,5.2030e+01_r8/) + kbo(:, 2,25,16) = (/ & + &4.7236e+05_r8,3.5427e+05_r8,2.3618e+05_r8,1.1809e+05_r8,4.9759e+01_r8/) + kbo(:, 3,25,16) = (/ & + &4.6345e+05_r8,3.4759e+05_r8,2.3173e+05_r8,1.1586e+05_r8,4.7513e+01_r8/) + kbo(:, 4,25,16) = (/ & + &4.5307e+05_r8,3.3980e+05_r8,2.2654e+05_r8,1.1327e+05_r8,4.5411e+01_r8/) + kbo(:, 5,25,16) = (/ & + &4.4201e+05_r8,3.3151e+05_r8,2.2101e+05_r8,1.1050e+05_r8,4.3416e+01_r8/) + kbo(:, 1,26,16) = (/ & + &5.1412e+05_r8,3.8559e+05_r8,2.5706e+05_r8,1.2853e+05_r8,5.8735e+01_r8/) + kbo(:, 2,26,16) = (/ & + &5.0368e+05_r8,3.7776e+05_r8,2.5184e+05_r8,1.2592e+05_r8,5.5868e+01_r8/) + kbo(:, 3,26,16) = (/ & + &4.9157e+05_r8,3.6868e+05_r8,2.4579e+05_r8,1.2289e+05_r8,5.3078e+01_r8/) + kbo(:, 4,26,16) = (/ & + &4.7856e+05_r8,3.5892e+05_r8,2.3928e+05_r8,1.1964e+05_r8,5.0425e+01_r8/) + kbo(:, 5,26,16) = (/ & + &4.6464e+05_r8,3.4848e+05_r8,2.3232e+05_r8,1.1616e+05_r8,4.7921e+01_r8/) + kbo(:, 1,27,16) = (/ & + &5.6504e+05_r8,4.2378e+05_r8,2.8252e+05_r8,1.4126e+05_r8,6.5394e+01_r8/) + kbo(:, 2,27,16) = (/ & + &5.5002e+05_r8,4.1252e+05_r8,2.7501e+05_r8,1.3751e+05_r8,6.1825e+01_r8/) + kbo(:, 3,27,16) = (/ & + &5.3436e+05_r8,4.0077e+05_r8,2.6718e+05_r8,1.3359e+05_r8,5.8497e+01_r8/) + kbo(:, 4,27,16) = (/ & + &5.1782e+05_r8,3.8837e+05_r8,2.5891e+05_r8,1.2946e+05_r8,5.5282e+01_r8/) + kbo(:, 5,27,16) = (/ & + &5.0051e+05_r8,3.7538e+05_r8,2.5025e+05_r8,1.2513e+05_r8,5.2211e+01_r8/) + kbo(:, 1,28,16) = (/ & + &6.2869e+05_r8,4.7152e+05_r8,3.1435e+05_r8,1.5717e+05_r8,7.1700e+01_r8/) + kbo(:, 2,28,16) = (/ & + &6.0862e+05_r8,4.5646e+05_r8,3.0431e+05_r8,1.5215e+05_r8,6.7460e+01_r8/) + kbo(:, 3,28,16) = (/ & + &5.8860e+05_r8,4.4145e+05_r8,2.9430e+05_r8,1.4715e+05_r8,6.3511e+01_r8/) + kbo(:, 4,28,16) = (/ & + &5.6780e+05_r8,4.2585e+05_r8,2.8390e+05_r8,1.4195e+05_r8,5.9746e+01_r8/) + kbo(:, 5,28,16) = (/ & + &5.4624e+05_r8,4.0968e+05_r8,2.7312e+05_r8,1.3656e+05_r8,5.6156e+01_r8/) + kbo(:, 1,29,16) = (/ & + &7.3240e+05_r8,5.4930e+05_r8,3.6620e+05_r8,1.8310e+05_r8,7.7436e+01_r8/) + kbo(:, 2,29,16) = (/ & + &7.0567e+05_r8,5.2925e+05_r8,3.5284e+05_r8,1.7642e+05_r8,7.2532e+01_r8/) + kbo(:, 3,29,16) = (/ & + &6.7920e+05_r8,5.0940e+05_r8,3.3960e+05_r8,1.6980e+05_r8,6.7962e+01_r8/) + kbo(:, 4,29,16) = (/ & + &6.5231e+05_r8,4.8923e+05_r8,3.2615e+05_r8,1.6308e+05_r8,6.3669e+01_r8/) + kbo(:, 5,29,16) = (/ & + &6.2510e+05_r8,4.6882e+05_r8,3.1255e+05_r8,1.5627e+05_r8,5.9600e+01_r8/) + kbo(:, 1,30,16) = (/ & + &8.6319e+05_r8,6.4740e+05_r8,4.3160e+05_r8,2.1580e+05_r8,8.2489e+01_r8/) + kbo(:, 2,30,16) = (/ & + &8.2811e+05_r8,6.2108e+05_r8,4.1405e+05_r8,2.0703e+05_r8,7.6918e+01_r8/) + kbo(:, 3,30,16) = (/ & + &7.9339e+05_r8,5.9504e+05_r8,3.9669e+05_r8,1.9835e+05_r8,7.1793e+01_r8/) + kbo(:, 4,30,16) = (/ & + &7.5902e+05_r8,5.6926e+05_r8,3.7951e+05_r8,1.8975e+05_r8,6.6976e+01_r8/) + kbo(:, 5,30,16) = (/ & + &7.2513e+05_r8,5.4385e+05_r8,3.6256e+05_r8,1.8128e+05_r8,5.5921e+01_r8/) + kbo(:, 1,31,16) = (/ & + &1.0572e+06_r8,7.9291e+05_r8,5.2861e+05_r8,2.6430e+05_r8,8.6704e+01_r8/) + kbo(:, 2,31,16) = (/ & + &1.0099e+06_r8,7.5744e+05_r8,5.0496e+05_r8,2.5248e+05_r8,8.0546e+01_r8/) + kbo(:, 3,31,16) = (/ & + &9.6381e+05_r8,7.2285e+05_r8,4.8190e+05_r8,2.4095e+05_r8,7.4889e+01_r8/) + kbo(:, 4,31,16) = (/ & + &9.1917e+05_r8,6.8937e+05_r8,4.5958e+05_r8,2.2979e+05_r8,6.9630e+01_r8/) + kbo(:, 5,31,16) = (/ & + &8.7558e+05_r8,6.5669e+05_r8,4.3779e+05_r8,2.1889e+05_r8,5.1048e+01_r8/) + kbo(:, 1,32,16) = (/ & + &1.2953e+06_r8,9.7146e+05_r8,6.4764e+05_r8,3.2382e+05_r8,9.0053e+01_r8/) + kbo(:, 2,32,16) = (/ & + &1.2332e+06_r8,9.2492e+05_r8,6.1662e+05_r8,3.0831e+05_r8,8.3375e+01_r8/) + kbo(:, 3,32,16) = (/ & + &1.1732e+06_r8,8.7992e+05_r8,5.8661e+05_r8,2.9331e+05_r8,7.7283e+01_r8/) + kbo(:, 4,32,16) = (/ & + &1.1156e+06_r8,8.3672e+05_r8,5.5781e+05_r8,2.7891e+05_r8,5.9068e+01_r8/) + kbo(:, 5,32,16) = (/ & + &1.0600e+06_r8,7.9499e+05_r8,5.3000e+05_r8,2.6500e+05_r8,4.7615e+01_r8/) + kbo(:, 1,33,16) = (/ & + &1.6005e+06_r8,1.2004e+06_r8,8.0025e+05_r8,4.0013e+05_r8,9.2564e+01_r8/) + kbo(:, 2,33,16) = (/ & + &1.5042e+06_r8,1.1396e+06_r8,7.5976e+05_r8,3.7988e+05_r8,8.5451e+01_r8/) + kbo(:, 3,33,16) = (/ & + &1.4412e+06_r8,1.0809e+06_r8,7.2060e+05_r8,3.6030e+05_r8,6.7956e+01_r8/) + kbo(:, 4,33,16) = (/ & + &1.3676e+06_r8,1.0257e+06_r8,6.8379e+05_r8,3.4189e+05_r8,5.3693e+01_r8/) + kbo(:, 5,33,16) = (/ & + &1.2966e+06_r8,9.7245e+05_r8,6.4830e+05_r8,3.2415e+05_r8,4.3539e+01_r8/) + kbo(:, 1,34,16) = (/ & + &1.9162e+06_r8,1.4372e+06_r8,9.5812e+05_r8,4.7906e+05_r8,9.4564e+01_r8/) + kbo(:, 2,34,16) = (/ & + &1.8147e+06_r8,1.3610e+06_r8,9.0734e+05_r8,4.5367e+05_r8,8.5602e+01_r8/) + kbo(:, 3,34,16) = (/ & + &1.7177e+06_r8,1.2883e+06_r8,8.5884e+05_r8,4.2942e+05_r8,6.2695e+01_r8/) + kbo(:, 4,34,16) = (/ & + &1.6266e+06_r8,1.2199e+06_r8,8.1329e+05_r8,4.0664e+05_r8,5.0461e+01_r8/) + kbo(:, 5,34,16) = (/ & + &1.5395e+06_r8,1.1546e+06_r8,7.6973e+05_r8,3.8486e+05_r8,4.1009e+01_r8/) + kbo(:, 1,35,16) = (/ & + &2.2940e+06_r8,1.7205e+06_r8,1.1470e+06_r8,5.7350e+05_r8,9.6683e+01_r8/) + kbo(:, 2,35,16) = (/ & + &2.1679e+06_r8,1.6259e+06_r8,1.0839e+06_r8,5.4197e+05_r8,7.5706e+01_r8/) + kbo(:, 3,35,16) = (/ & + &2.0487e+06_r8,1.5365e+06_r8,1.0243e+06_r8,5.1216e+05_r8,5.9415e+01_r8/) + kbo(:, 4,35,16) = (/ & + &1.9369e+06_r8,1.4527e+06_r8,9.6844e+05_r8,4.8422e+05_r8,4.7837e+01_r8/) + kbo(:, 5,35,16) = (/ & + &1.8303e+06_r8,1.3728e+06_r8,9.1517e+05_r8,4.5758e+05_r8,3.3167e+01_r8/) + kbo(:, 1,36,16) = (/ & + &2.7323e+06_r8,2.0492e+06_r8,1.3661e+06_r8,6.8307e+05_r8,9.9200e+01_r8/) + kbo(:, 2,36,16) = (/ & + &2.5780e+06_r8,1.9335e+06_r8,1.2890e+06_r8,6.4450e+05_r8,7.2688e+01_r8/) + kbo(:, 3,36,16) = (/ & + &2.4326e+06_r8,1.8244e+06_r8,1.2163e+06_r8,6.0814e+05_r8,5.7708e+01_r8/) + kbo(:, 4,36,16) = (/ & + &2.2967e+06_r8,1.7225e+06_r8,1.1483e+06_r8,5.7417e+05_r8,4.6712e+01_r8/) + kbo(:, 5,36,16) = (/ & + &2.1679e+06_r8,1.6259e+06_r8,1.0839e+06_r8,5.4197e+05_r8,1.2791e+01_r8/) + kbo(:, 1,37,16) = (/ & + &3.1885e+06_r8,2.3914e+06_r8,1.5942e+06_r8,7.9711e+05_r8,1.0268e+02_r8/) + kbo(:, 2,37,16) = (/ & + &3.0040e+06_r8,2.2530e+06_r8,1.5020e+06_r8,7.5099e+05_r8,7.3443e+01_r8/) + kbo(:, 3,37,16) = (/ & + &2.8309e+06_r8,2.1232e+06_r8,1.4155e+06_r8,7.0773e+05_r8,5.8756e+01_r8/) + kbo(:, 4,37,16) = (/ & + &2.6696e+06_r8,2.0022e+06_r8,1.3348e+06_r8,6.6739e+05_r8,4.7388e+01_r8/) + kbo(:, 5,37,16) = (/ & + &2.5177e+06_r8,1.8883e+06_r8,1.2588e+06_r8,6.2942e+05_r8,7.8483e+00_r8/) + kbo(:, 1,38,16) = (/ & + &3.7660e+06_r8,2.8245e+06_r8,1.8830e+06_r8,9.4149e+05_r8,1.0053e+02_r8/) + kbo(:, 2,38,16) = (/ & + &3.5441e+06_r8,2.6581e+06_r8,1.7720e+06_r8,8.8602e+05_r8,7.3960e+01_r8/) + kbo(:, 3,38,16) = (/ & + &3.3357e+06_r8,2.5018e+06_r8,1.6678e+06_r8,8.3391e+05_r8,5.9673e+01_r8/) + kbo(:, 4,38,16) = (/ & + &3.1421e+06_r8,2.3566e+06_r8,1.5711e+06_r8,7.8553e+05_r8,4.7953e+01_r8/) + kbo(:, 5,38,16) = (/ & + &2.9610e+06_r8,2.2207e+06_r8,1.4805e+06_r8,7.4024e+05_r8,7.1016e-04_r8/) + kbo(:, 1,39,16) = (/ & + &4.5378e+06_r8,3.4034e+06_r8,2.2689e+06_r8,1.1345e+06_r8,9.8727e+01_r8/) + kbo(:, 2,39,16) = (/ & + &4.2667e+06_r8,3.2000e+06_r8,2.1334e+06_r8,1.0667e+06_r8,7.4242e+01_r8/) + kbo(:, 3,39,16) = (/ & + &4.0124e+06_r8,3.0093e+06_r8,2.0062e+06_r8,1.0031e+06_r8,5.9575e+01_r8/) + kbo(:, 4,39,16) = (/ & + &3.7760e+06_r8,2.8320e+06_r8,1.8880e+06_r8,9.4400e+05_r8,3.9674e+01_r8/) + kbo(:, 5,39,16) = (/ & + &3.5558e+06_r8,2.6669e+06_r8,1.7591e+06_r8,8.8898e+05_r8,5.7405e-04_r8/) + kbo(:, 1,40,16) = (/ & + &5.1586e+06_r8,3.8690e+06_r8,2.5793e+06_r8,1.2896e+06_r8,1.0433e+02_r8/) + kbo(:, 2,40,16) = (/ & + &4.8469e+06_r8,3.6347e+06_r8,2.4234e+06_r8,1.2117e+06_r8,7.7760e+01_r8/) + kbo(:, 3,40,16) = (/ & + &4.5541e+06_r8,3.4156e+06_r8,2.2770e+06_r8,1.1385e+06_r8,6.1585e+01_r8/) + kbo(:, 4,40,16) = (/ & + &4.2818e+06_r8,3.2114e+06_r8,2.1409e+06_r8,1.0704e+06_r8,4.0940e+01_r8/) + kbo(:, 5,40,16) = (/ & + &4.0296e+06_r8,3.0222e+06_r8,2.0148e+06_r8,1.0074e+06_r8,4.6888e-04_r8/) + kbo(:, 1,41,16) = (/ & + &5.8465e+06_r8,4.3849e+06_r8,2.9233e+06_r8,1.4616e+06_r8,1.1317e+02_r8/) + kbo(:, 2,41,16) = (/ & + &5.4907e+06_r8,4.1180e+06_r8,2.7454e+06_r8,1.3727e+06_r8,8.1398e+01_r8/) + kbo(:, 3,41,16) = (/ & + &5.1550e+06_r8,3.8663e+06_r8,2.5775e+06_r8,1.2888e+06_r8,6.4536e+01_r8/) + kbo(:, 4,41,16) = (/ & + &4.8434e+06_r8,3.6326e+06_r8,2.4217e+06_r8,1.2109e+06_r8,4.3960e+01_r8/) + kbo(:, 5,41,16) = (/ & + &4.5548e+06_r8,3.4161e+06_r8,2.2774e+06_r8,1.1387e+06_r8,3.7799e-04_r8/) + kbo(:, 1,42,16) = (/ & + &6.6900e+06_r8,5.0175e+06_r8,3.3450e+06_r8,1.6725e+06_r8,1.2124e+02_r8/) + kbo(:, 2,42,16) = (/ & + &6.2794e+06_r8,4.7096e+06_r8,3.1397e+06_r8,1.5698e+06_r8,8.5097e+01_r8/) + kbo(:, 3,42,16) = (/ & + &5.8926e+06_r8,4.4195e+06_r8,2.9463e+06_r8,1.4731e+06_r8,6.7520e+01_r8/) + kbo(:, 4,42,16) = (/ & + &5.5323e+06_r8,4.1492e+06_r8,2.7661e+06_r8,1.3831e+06_r8,4.6182e+01_r8/) + kbo(:, 5,42,16) = (/ & + &5.1983e+06_r8,3.8987e+06_r8,2.5991e+06_r8,1.2996e+06_r8,3.0509e-04_r8/) + kbo(:, 1,43,16) = (/ & + &7.7419e+06_r8,5.8065e+06_r8,3.8710e+06_r8,1.9355e+06_r8,1.2600e+02_r8/) + kbo(:, 2,43,16) = (/ & + &7.2619e+06_r8,5.4481e+06_r8,3.6321e+06_r8,1.8161e+06_r8,9.0385e+01_r8/) + kbo(:, 3,43,16) = (/ & + &6.8139e+06_r8,5.1104e+06_r8,3.4070e+06_r8,1.7035e+06_r8,7.0944e+01_r8/) + kbo(:, 4,43,16) = (/ & + &6.3928e+06_r8,4.7946e+06_r8,3.1964e+06_r8,1.5982e+06_r8,5.0507e+01_r8/) + kbo(:, 5,43,16) = (/ & + &6.0029e+06_r8,4.5022e+06_r8,3.0015e+06_r8,1.5007e+06_r8,2.4615e-04_r8/) + kbo(:, 1,44,16) = (/ & + &9.0918e+06_r8,6.8188e+06_r8,4.5458e+06_r8,2.2729e+06_r8,1.3122e+02_r8/) + kbo(:, 2,44,16) = (/ & + &8.5266e+06_r8,6.3949e+06_r8,4.2633e+06_r8,2.1316e+06_r8,9.7168e+01_r8/) + kbo(:, 3,44,16) = (/ & + &7.9959e+06_r8,5.9969e+06_r8,3.9979e+06_r8,1.9989e+06_r8,7.5640e+01_r8/) + kbo(:, 4,44,16) = (/ & + &7.4967e+06_r8,5.6225e+06_r8,3.7483e+06_r8,1.8741e+06_r8,5.7032e+01_r8/) + kbo(:, 5,44,16) = (/ & + &7.0357e+06_r8,5.2767e+06_r8,3.5178e+06_r8,1.7589e+06_r8,1.1125e-02_r8/) + kbo(:, 1,45,16) = (/ & + &1.0890e+07_r8,8.1678e+06_r8,5.4452e+06_r8,2.7226e+06_r8,1.3511e+02_r8/) + kbo(:, 2,45,16) = (/ & + &1.0206e+07_r8,7.6543e+06_r8,5.1028e+06_r8,2.5514e+06_r8,1.0320e+02_r8/) + kbo(:, 3,45,16) = (/ & + &9.5676e+06_r8,7.1757e+06_r8,4.7838e+06_r8,2.3919e+06_r8,7.9521e+01_r8/) + kbo(:, 4,45,16) = (/ & + &8.9682e+06_r8,6.7261e+06_r8,4.4841e+06_r8,2.2420e+06_r8,5.3314e+01_r8/) + kbo(:, 5,45,16) = (/ & + &8.4107e+06_r8,6.3080e+06_r8,4.2053e+06_r8,2.1027e+06_r8,2.2542e-04_r8/) + kbo(:, 1,46,16) = (/ & + &1.3200e+07_r8,9.8998e+06_r8,6.5999e+06_r8,3.2999e+06_r8,1.4245e+02_r8/) + kbo(:, 2,46,16) = (/ & + &1.2354e+07_r8,9.2658e+06_r8,6.1772e+06_r8,3.0886e+06_r8,1.1090e+02_r8/) + kbo(:, 3,46,16) = (/ & + &1.1578e+07_r8,8.6832e+06_r8,5.7888e+06_r8,2.8944e+06_r8,8.3717e+01_r8/) + kbo(:, 4,46,16) = (/ & + &1.0851e+07_r8,8.1384e+06_r8,5.4256e+06_r8,2.7128e+06_r8,5.1335e+01_r8/) + kbo(:, 5,46,16) = (/ & + &1.0172e+07_r8,7.6289e+06_r8,5.0860e+06_r8,2.5430e+06_r8,1.9729e-04_r8/) + kbo(:, 1,47,16) = (/ & + &1.5899e+07_r8,1.1924e+07_r8,7.9494e+06_r8,3.9747e+06_r8,1.4926e+02_r8/) + kbo(:, 2,47,16) = (/ & + &1.4859e+07_r8,1.1144e+07_r8,7.4297e+06_r8,3.7148e+06_r8,1.2298e+02_r8/) + kbo(:, 3,47,16) = (/ & + &1.3924e+07_r8,1.0443e+07_r8,6.9621e+06_r8,3.4810e+06_r8,8.5230e+01_r8/) + kbo(:, 4,47,16) = (/ & + &1.3046e+07_r8,9.7847e+06_r8,6.5231e+06_r8,3.2616e+06_r8,5.3561e+01_r8/) + kbo(:, 5,47,16) = (/ & + &1.2222e+07_r8,9.1665e+06_r8,6.1110e+06_r8,3.0555e+06_r8,1.6606e-04_r8/) + kbo(:, 1,48,16) = (/ & + &1.9701e+07_r8,1.4775e+07_r8,9.8503e+06_r8,4.9251e+06_r8,1.5645e+02_r8/) + kbo(:, 2,48,16) = (/ & + &1.8394e+07_r8,1.3796e+07_r8,9.1972e+06_r8,4.5986e+06_r8,1.4059e+02_r8/) + kbo(:, 3,48,16) = (/ & + &1.7217e+07_r8,1.2913e+07_r8,8.6087e+06_r8,4.3044e+06_r8,8.5580e+01_r8/) + kbo(:, 4,48,16) = (/ & + &1.6130e+07_r8,1.2097e+07_r8,8.0649e+06_r8,4.0324e+06_r8,5.5884e+01_r8/) + kbo(:, 5,48,16) = (/ & + &1.5108e+07_r8,1.1331e+07_r8,7.5542e+06_r8,3.7771e+06_r8,1.4110e-04_r8/) + kbo(:, 1,49,16) = (/ & + &2.5446e+07_r8,1.9085e+07_r8,1.2723e+07_r8,6.3615e+06_r8,1.6402e+02_r8/) + kbo(:, 2,49,16) = (/ & + &2.3735e+07_r8,1.7801e+07_r8,1.1868e+07_r8,5.9337e+06_r8,1.4463e+02_r8/) + kbo(:, 3,49,16) = (/ & + &2.2185e+07_r8,1.6639e+07_r8,1.1093e+07_r8,5.5463e+06_r8,8.5806e+01_r8/) + kbo(:, 4,49,16) = (/ & + &2.0781e+07_r8,1.5586e+07_r8,1.0390e+07_r8,5.1952e+06_r8,5.2515e+01_r8/) + kbo(:, 5,49,16) = (/ & + &1.9463e+07_r8,1.4597e+07_r8,9.7313e+06_r8,4.8656e+06_r8,1.1804e-04_r8/) + kbo(:, 1,50,16) = (/ & + &3.1256e+07_r8,2.3442e+07_r8,1.5628e+07_r8,7.8139e+06_r8,1.7145e+02_r8/) + kbo(:, 2,50,16) = (/ & + &2.9123e+07_r8,2.1842e+07_r8,1.4562e+07_r8,7.2808e+06_r8,1.4715e+02_r8/) + kbo(:, 3,50,16) = (/ & + &2.7197e+07_r8,2.0398e+07_r8,1.3599e+07_r8,6.7993e+06_r8,9.2079e+01_r8/) + kbo(:, 4,50,16) = (/ & + &2.5458e+07_r8,1.9094e+07_r8,1.2729e+07_r8,6.3645e+06_r8,5.7113e+01_r8/) + kbo(:, 5,50,16) = (/ & + &2.3842e+07_r8,1.7882e+07_r8,1.1921e+07_r8,5.9606e+06_r8,9.7879e-05_r8/) + kbo(:, 1,51,16) = (/ & + &3.7532e+07_r8,2.8149e+07_r8,1.8766e+07_r8,9.3831e+06_r8,1.7913e+02_r8/) + kbo(:, 2,51,16) = (/ & + &3.4951e+07_r8,2.6213e+07_r8,1.7476e+07_r8,8.7379e+06_r8,1.5348e+02_r8/) + kbo(:, 3,51,16) = (/ & + &3.2604e+07_r8,2.4453e+07_r8,1.6302e+07_r8,8.1511e+06_r8,9.9906e+01_r8/) + kbo(:, 4,51,16) = (/ & + &3.0489e+07_r8,2.2867e+07_r8,1.5245e+07_r8,7.6224e+06_r8,6.1926e+01_r8/) + kbo(:, 5,51,16) = (/ & + &2.8553e+07_r8,2.1415e+07_r8,1.4277e+07_r8,7.1383e+06_r8,8.2332e-05_r8/) + kbo(:, 1,52,16) = (/ & + &4.6363e+07_r8,3.4773e+07_r8,2.3182e+07_r8,1.1591e+07_r8,1.8724e+02_r8/) + kbo(:, 2,52,16) = (/ & + &4.3154e+07_r8,3.2365e+07_r8,2.1577e+07_r8,1.0789e+07_r8,1.5735e+02_r8/) + kbo(:, 3,52,16) = (/ & + &4.0219e+07_r8,3.0165e+07_r8,2.0110e+07_r8,1.0055e+07_r8,1.0819e+02_r8/) + kbo(:, 4,52,16) = (/ & + &3.7571e+07_r8,2.8178e+07_r8,1.8786e+07_r8,9.3929e+06_r8,6.5746e+01_r8/) + kbo(:, 5,52,16) = (/ & + &3.5175e+07_r8,2.6382e+07_r8,1.7588e+07_r8,8.7937e+06_r8,2.5991e+00_r8/) + kbo(:, 1,53,16) = (/ & + &5.9694e+07_r8,4.4771e+07_r8,2.9847e+07_r8,1.4924e+07_r8,1.9593e+02_r8/) + kbo(:, 2,53,16) = (/ & + &5.5520e+07_r8,4.1640e+07_r8,2.7760e+07_r8,1.3880e+07_r8,1.5986e+02_r8/) + kbo(:, 3,53,16) = (/ & + &5.1713e+07_r8,3.8785e+07_r8,2.5857e+07_r8,1.2928e+07_r8,1.1418e+02_r8/) + kbo(:, 4,53,16) = (/ & + &4.8267e+07_r8,3.6200e+07_r8,2.4134e+07_r8,1.2067e+07_r8,6.7101e+01_r8/) + kbo(:, 5,53,16) = (/ & + &4.5154e+07_r8,3.3866e+07_r8,2.2577e+07_r8,1.1289e+07_r8,5.4836e-05_r8/) + kbo(:, 1,54,16) = (/ & + &6.6291e+07_r8,4.9719e+07_r8,3.3146e+07_r8,1.6573e+07_r8,2.0438e+02_r8/) + kbo(:, 2,54,16) = (/ & + &6.1631e+07_r8,4.6223e+07_r8,3.0816e+07_r8,1.5408e+07_r8,1.7539e+02_r8/) + kbo(:, 3,54,16) = (/ & + &5.7374e+07_r8,4.3031e+07_r8,2.8687e+07_r8,1.4344e+07_r8,1.3582e+02_r8/) + kbo(:, 4,54,16) = (/ & + &5.3498e+07_r8,4.0123e+07_r8,2.6749e+07_r8,1.3375e+07_r8,7.9383e+01_r8/) + kbo(:, 5,54,16) = (/ & + &5.0001e+07_r8,3.7501e+07_r8,2.5001e+07_r8,1.2501e+07_r8,1.9380e+01_r8/) + kbo(:, 1,55,16) = (/ & + &6.7110e+07_r8,5.0333e+07_r8,3.3555e+07_r8,1.6778e+07_r8,2.1302e+02_r8/) + kbo(:, 2,55,16) = (/ & + &6.2350e+07_r8,4.6763e+07_r8,3.1175e+07_r8,1.5588e+07_r8,1.8842e+02_r8/) + kbo(:, 3,55,16) = (/ & + &5.8012e+07_r8,4.3509e+07_r8,2.9006e+07_r8,1.4503e+07_r8,1.5117e+02_r8/) + kbo(:, 4,55,16) = (/ & + &5.4054e+07_r8,4.0541e+07_r8,2.7027e+07_r8,1.3514e+07_r8,1.0060e+02_r8/) + kbo(:, 5,55,16) = (/ & + &5.0479e+07_r8,3.7859e+07_r8,2.5240e+07_r8,1.2620e+07_r8,5.1596e+01_r8/) + kbo(:, 1,56,16) = (/ & + &6.7946e+07_r8,5.0959e+07_r8,3.3973e+07_r8,1.6986e+07_r8,2.2213e+02_r8/) + kbo(:, 2,56,16) = (/ & + &6.3087e+07_r8,4.7315e+07_r8,3.1543e+07_r8,1.5771e+07_r8,1.9599e+02_r8/) + kbo(:, 3,56,16) = (/ & + &5.8660e+07_r8,4.3995e+07_r8,2.9330e+07_r8,1.4665e+07_r8,1.7426e+02_r8/) + kbo(:, 4,56,16) = (/ & + &5.4632e+07_r8,4.0974e+07_r8,2.7316e+07_r8,1.3658e+07_r8,1.3341e+02_r8/) + kbo(:, 5,56,16) = (/ & + &5.0980e+07_r8,3.8235e+07_r8,2.5490e+07_r8,1.2745e+07_r8,7.5113e+01_r8/) + kbo(:, 1,57,16) = (/ & + &6.8848e+07_r8,5.1636e+07_r8,3.4424e+07_r8,1.7212e+07_r8,2.3193e+02_r8/) + kbo(:, 2,57,16) = (/ & + &6.3831e+07_r8,4.7873e+07_r8,3.1915e+07_r8,1.5958e+07_r8,2.0396e+02_r8/) + kbo(:, 3,57,16) = (/ & + &5.9337e+07_r8,4.4503e+07_r8,2.9325e+07_r8,1.4834e+07_r8,1.8090e+02_r8/) + kbo(:, 4,57,16) = (/ & + &5.5232e+07_r8,4.1423e+07_r8,2.7615e+07_r8,1.3808e+07_r8,1.4946e+02_r8/) + kbo(:, 5,57,16) = (/ & + &5.1498e+07_r8,3.8623e+07_r8,2.5749e+07_r8,1.2874e+07_r8,9.6802e+01_r8/) + kbo(:, 1,58,16) = (/ & + &1.8392e+07_r8,1.6863e+07_r8,1.4458e+07_r8,1.0126e+07_r8,2.4193e+02_r8/) + kbo(:, 2,58,16) = (/ & + &1.7018e+07_r8,1.5603e+07_r8,1.3378e+07_r8,9.3701e+06_r8,2.1195e+02_r8/) + kbo(:, 3,58,16) = (/ & + &1.5812e+07_r8,1.4497e+07_r8,1.2430e+07_r8,8.7057e+06_r8,1.8755e+02_r8/) + kbo(:, 4,58,16) = (/ & + &1.4710e+07_r8,1.3487e+07_r8,1.1564e+07_r8,8.0993e+06_r8,1.6722e+02_r8/) + kbo(:, 5,58,16) = (/ & + &1.3707e+07_r8,1.2567e+07_r8,1.0775e+07_r8,7.5470e+06_r8,1.3461e+02_r8/) + kbo(:, 1,59,16) = (/ & + &2.1701e+07_r8,1.8948e+07_r8,1.5114e+07_r8,9.4051e+06_r8,2.4616e+02_r8/) + kbo(:, 2,59,16) = (/ & + &2.0062e+07_r8,1.7517e+07_r8,1.3973e+07_r8,8.5918e+06_r8,2.1536e+02_r8/) + kbo(:, 3,59,16) = (/ & + &1.8637e+07_r8,1.6273e+07_r8,1.2980e+07_r8,8.0770e+06_r8,1.9038e+02_r8/) + kbo(:, 4,59,16) = (/ & + &1.7332e+07_r8,1.5134e+07_r8,1.2072e+07_r8,7.5118e+06_r8,1.6959e+02_r8/) + kbo(:, 5,59,16) = (/ & + &1.6145e+07_r8,1.4097e+07_r8,1.1245e+07_r8,6.9973e+06_r8,1.5180e+02_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &3.3839e-04_r8,2.4739e-04_r8,2.2846e-04_r8,2.3376e-04_r8,2.2622e-04_r8,2.3188e-04_r8, & + &2.2990e-04_r8,2.2532e-04_r8,2.1233e-04_r8,2.0593e-04_r8,2.0716e-04_r8,2.0809e-04_r8, & + &2.0889e-04_r8,2.0932e-04_r8,2.0944e-04_r8,2.0945e-04_r8/) + forrefo(2,:) = (/ & + &3.4391e-04_r8,2.6022e-04_r8,2.3449e-04_r8,2.4544e-04_r8,2.3831e-04_r8,2.3014e-04_r8, & + &2.3729e-04_r8,2.2726e-04_r8,2.1892e-04_r8,1.9223e-04_r8,2.1291e-04_r8,2.1406e-04_r8, & + &2.1491e-04_r8,2.1548e-04_r8,2.1562e-04_r8,2.1567e-04_r8/) + forrefo(3,:) = (/ & + &3.4219e-04_r8,2.7334e-04_r8,2.3727e-04_r8,2.4515e-04_r8,2.5272e-04_r8,2.4212e-04_r8, & + &2.3824e-04_r8,2.3615e-04_r8,2.2724e-04_r8,2.2381e-04_r8,1.9634e-04_r8,2.1625e-04_r8, & + &2.1963e-04_r8,2.2032e-04_r8,2.2057e-04_r8,2.2058e-04_r8/) + forrefo(4,:) = (/ & + &3.1684e-04_r8,2.4823e-04_r8,2.4890e-04_r8,2.4577e-04_r8,2.4106e-04_r8,2.4353e-04_r8, & + &2.4038e-04_r8,2.3932e-04_r8,2.3604e-04_r8,2.3773e-04_r8,2.4243e-04_r8,2.2597e-04_r8, & + &2.2879e-04_r8,2.2440e-04_r8,2.1104e-04_r8,2.1460e-04_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 2.62922e-01_r8, 2.29106e-01_r8, 1.99640e-01_r8, 1.73964e-01_r8, 1.51589e-01_r8, & + & 1.32093e-01_r8, 1.15104e-01_r8, 1.00300e-01_r8, 8.74000e-02_r8, 7.61592e-02_r8/) + selfrefo(:, 2) = (/ & + & 2.45448e-01_r8, 2.13212e-01_r8, 1.85210e-01_r8, 1.60886e-01_r8, 1.39756e-01_r8, & + & 1.21401e-01_r8, 1.05457e-01_r8, 9.16070e-02_r8, 7.95759e-02_r8, 6.91249e-02_r8/) + selfrefo(:, 3) = (/ & + & 2.41595e-01_r8, 2.09697e-01_r8, 1.82010e-01_r8, 1.57979e-01_r8, 1.37121e-01_r8, & + & 1.19016e-01_r8, 1.03302e-01_r8, 8.96630e-02_r8, 7.78246e-02_r8, 6.75492e-02_r8/) + selfrefo(:, 4) = (/ & + & 2.44818e-01_r8, 2.12172e-01_r8, 1.83880e-01_r8, 1.59360e-01_r8, 1.38110e-01_r8, & + & 1.19694e-01_r8, 1.03733e-01_r8, 8.99010e-02_r8, 7.79131e-02_r8, 6.75238e-02_r8/) + selfrefo(:, 5) = (/ & + & 2.43458e-01_r8, 2.10983e-01_r8, 1.82840e-01_r8, 1.58451e-01_r8, 1.37315e-01_r8, & + & 1.18998e-01_r8, 1.03125e-01_r8, 8.93690e-02_r8, 7.74480e-02_r8, 6.71171e-02_r8/) + selfrefo(:, 6) = (/ & + & 2.40186e-01_r8, 2.08745e-01_r8, 1.81420e-01_r8, 1.57672e-01_r8, 1.37032e-01_r8, & + & 1.19095e-01_r8, 1.03505e-01_r8, 8.99560e-02_r8, 7.81806e-02_r8, 6.79467e-02_r8/) + selfrefo(:, 7) = (/ & + & 2.42752e-01_r8, 2.10579e-01_r8, 1.82670e-01_r8, 1.58460e-01_r8, 1.37459e-01_r8, & + & 1.19240e-01_r8, 1.03437e-01_r8, 8.97280e-02_r8, 7.78359e-02_r8, 6.75200e-02_r8/) + selfrefo(:, 8) = (/ & + & 2.39620e-01_r8, 2.08166e-01_r8, 1.80840e-01_r8, 1.57101e-01_r8, 1.36479e-01_r8, & + & 1.18563e-01_r8, 1.03000e-01_r8, 8.94790e-02_r8, 7.77332e-02_r8, 6.75292e-02_r8/) + selfrefo(:, 9) = (/ & + & 2.38856e-01_r8, 2.07166e-01_r8, 1.79680e-01_r8, 1.55841e-01_r8, 1.35165e-01_r8, & + & 1.17232e-01_r8, 1.01678e-01_r8, 8.81880e-02_r8, 7.64877e-02_r8, 6.63397e-02_r8/) + selfrefo(:,10) = (/ & + & 2.29821e-01_r8, 2.00586e-01_r8, 1.75070e-01_r8, 1.52800e-01_r8, 1.33363e-01_r8, & + & 1.16398e-01_r8, 1.01591e-01_r8, 8.86680e-02_r8, 7.73887e-02_r8, 6.75443e-02_r8/) + selfrefo(:,11) = (/ & + & 2.39945e-01_r8, 2.08186e-01_r8, 1.80630e-01_r8, 1.56722e-01_r8, 1.35978e-01_r8, & + & 1.17980e-01_r8, 1.02364e-01_r8, 8.88150e-02_r8, 7.70594e-02_r8, 6.68598e-02_r8/) + selfrefo(:,12) = (/ & + & 2.40271e-01_r8, 2.08465e-01_r8, 1.80870e-01_r8, 1.56927e-01_r8, 1.36154e-01_r8, & + & 1.18131e-01_r8, 1.02494e-01_r8, 8.89260e-02_r8, 7.71545e-02_r8, 6.69412e-02_r8/) + selfrefo(:,13) = (/ & + & 2.40503e-01_r8, 2.08670e-01_r8, 1.81050e-01_r8, 1.57086e-01_r8, 1.36294e-01_r8, & + & 1.18254e-01_r8, 1.02602e-01_r8, 8.90210e-02_r8, 7.72380e-02_r8, 6.70147e-02_r8/) + selfrefo(:,14) = (/ & + & 2.40670e-01_r8, 2.08811e-01_r8, 1.81170e-01_r8, 1.57188e-01_r8, 1.36380e-01_r8, & + & 1.18327e-01_r8, 1.02663e-01_r8, 8.90730e-02_r8, 7.72819e-02_r8, 6.70517e-02_r8/) + selfrefo(:,15) = (/ & + & 2.40711e-01_r8, 2.08846e-01_r8, 1.81200e-01_r8, 1.57213e-01_r8, 1.36402e-01_r8, & + & 1.18346e-01_r8, 1.02679e-01_r8, 8.90870e-02_r8, 7.72939e-02_r8, 6.70621e-02_r8/) + selfrefo(:,16) = (/ & + & 2.40727e-01_r8, 2.08859e-01_r8, 1.81210e-01_r8, 1.57221e-01_r8, 1.36408e-01_r8, & + & 1.18350e-01_r8, 1.02682e-01_r8, 8.90890e-02_r8, 7.72952e-02_r8, 6.70627e-02_r8/) + + end subroutine lw_kgb04 + +! ************************************************************************** + subroutine lw_kgb05 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg05, only : fracrefao, fracrefbo, kao, kbo, kao_mo3, & + selfrefo, forrefo, ccl4o + + implicit none + save + +! Planck fraction mapping level : P = 473.42 mb, T = 259.83 + fracrefao(:, 1) = (/ & + 1.4111e-01_r8,1.4222e-01_r8,1.3802e-01_r8,1.3101e-01_r8,1.2244e-01_r8,1.0691e-01_r8, & + 8.8703e-02_r8,6.7130e-02_r8,4.5509e-02_r8,4.9866e-03_r8,4.1214e-03_r8,3.2557e-03_r8, & + 2.3805e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 2) = (/ & + 1.4152e-01_r8,1.4271e-01_r8,1.3784e-01_r8,1.3075e-01_r8,1.2215e-01_r8,1.0674e-01_r8, & + 8.8686e-02_r8,6.7135e-02_r8,4.5508e-02_r8,4.9866e-03_r8,4.1214e-03_r8,3.2558e-03_r8, & + 2.3805e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 3) = (/ & + 1.4159e-01_r8,1.4300e-01_r8,1.3781e-01_r8,1.3094e-01_r8,1.2192e-01_r8,1.0661e-01_r8, & + 8.8529e-02_r8,6.7127e-02_r8,4.5511e-02_r8,4.9877e-03_r8,4.1214e-03_r8,3.2558e-03_r8, & + 2.3805e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 4) = (/ & + 1.4162e-01_r8,1.4337e-01_r8,1.3774e-01_r8,1.3122e-01_r8,1.2172e-01_r8,1.0641e-01_r8, & + 8.8384e-02_r8,6.7056e-02_r8,4.5514e-02_r8,4.9880e-03_r8,4.1214e-03_r8,3.2557e-03_r8, & + 2.3805e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 5) = (/ & + 1.4161e-01_r8,1.4370e-01_r8,1.3770e-01_r8,1.3143e-01_r8,1.2173e-01_r8,1.0613e-01_r8, & + 8.8357e-02_r8,6.6874e-02_r8,4.5509e-02_r8,4.9883e-03_r8,4.1214e-03_r8,3.2558e-03_r8, & + 2.3804e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 6) = (/ & + 1.4154e-01_r8,1.4405e-01_r8,1.3771e-01_r8,1.3169e-01_r8,1.2166e-01_r8,1.0603e-01_r8, & + 8.8193e-02_r8,6.6705e-02_r8,4.5469e-02_r8,4.9902e-03_r8,4.1214e-03_r8,3.2558e-03_r8, & + 2.3804e-03_r8,1.5450e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 7) = (/ & + 1.4126e-01_r8,1.4440e-01_r8,1.3790e-01_r8,1.3214e-01_r8,1.2153e-01_r8,1.0603e-01_r8, & + 8.7908e-02_r8,6.6612e-02_r8,4.5269e-02_r8,4.9900e-03_r8,4.1256e-03_r8,3.2558e-03_r8, & + 2.3804e-03_r8,1.5451e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 8) = (/ & + 1.4076e-01_r8,1.4415e-01_r8,1.3885e-01_r8,1.3286e-01_r8,1.2147e-01_r8,1.0612e-01_r8, & + 8.7579e-02_r8,6.6280e-02_r8,4.4977e-02_r8,4.9782e-03_r8,4.1200e-03_r8,3.2620e-03_r8, & + 2.3820e-03_r8,1.5452e-03_r8,5.8423e-04_r8,8.2275e-05_r8/) + fracrefao(:, 9) = (/ & + 1.4205e-01_r8,1.4496e-01_r8,1.4337e-01_r8,1.3504e-01_r8,1.2260e-01_r8,1.0428e-01_r8, & + 8.4946e-02_r8,6.3625e-02_r8,4.2951e-02_r8,4.7313e-03_r8,3.9157e-03_r8,3.0879e-03_r8, & + 2.2666e-03_r8,1.5193e-03_r8,5.7469e-04_r8,8.1674e-05_r8/) + +! Planck fraction mapping level : P = 0.2369280 mbar, T = 253.60 K + fracrefbo(:, 1) = (/ & + 1.4075e-01_r8,1.4196e-01_r8,1.3833e-01_r8,1.3345e-01_r8,1.2234e-01_r8,1.0718e-01_r8, & + 8.8004e-02_r8,6.6308e-02_r8,4.5028e-02_r8,4.9029e-03_r8,4.0377e-03_r8,3.1870e-03_r8, & + 2.3503e-03_r8,1.5146e-03_r8,5.7165e-04_r8,8.2371e-05_r8/) + fracrefbo(:, 2) = (/ & + 1.4081e-01_r8,1.4225e-01_r8,1.3890e-01_r8,1.3410e-01_r8,1.2254e-01_r8,1.0680e-01_r8, & + 8.7391e-02_r8,6.5819e-02_r8,4.4725e-02_r8,4.9121e-03_r8,4.0420e-03_r8,3.1869e-03_r8, & + 2.3504e-03_r8,1.5146e-03_r8,5.7165e-04_r8,8.2371e-05_r8/) + fracrefbo(:, 3) = (/ & + 1.4087e-01_r8,1.4227e-01_r8,1.3920e-01_r8,1.3395e-01_r8,1.2270e-01_r8,1.0694e-01_r8, & + 8.7229e-02_r8,6.5653e-02_r8,4.4554e-02_r8,4.8797e-03_r8,4.0460e-03_r8,3.1939e-03_r8, & + 2.3505e-03_r8,1.5146e-03_r8,5.7165e-04_r8,8.1910e-05_r8/) + fracrefbo(:, 4) = (/ & + 1.4089e-01_r8,1.4238e-01_r8,1.3956e-01_r8,1.3379e-01_r8,1.2284e-01_r8,1.0688e-01_r8, & + 8.7192e-02_r8,6.5490e-02_r8,4.4390e-02_r8,4.8395e-03_r8,4.0173e-03_r8,3.2070e-03_r8, & + 2.3559e-03_r8,1.5146e-03_r8,5.7165e-04_r8,8.2371e-05_r8/) + fracrefbo(:, 5) = (/ & + 1.4091e-01_r8,1.4417e-01_r8,1.4194e-01_r8,1.3457e-01_r8,1.2167e-01_r8,1.0551e-01_r8, & + 8.6450e-02_r8,6.4889e-02_r8,4.3584e-02_r8,4.7551e-03_r8,3.9509e-03_r8,3.1374e-03_r8, & + 2.3226e-03_r8,1.4942e-03_r8,5.7545e-04_r8,8.0887e-05_r8/) + +! Minor gas mapping level : +! lower - o3, p = 317.34 mbar, t = 240.77 k +! lower - ccl4 + + ccl4o(:) = (/ & + 26.1407_r8, 53.9776_r8, 63.8085_r8, 36.1701_r8, 15.4099_r8, 10.23116_r8, & + 4.82948_r8, 5.03836_r8, 1.75558_r8, 0._r8, 0._r8, 0._r8, & + 0._r8, 0._r8, 0._r8, 0._r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &2.0627e-06_r8,7.6619e-06_r8,1.2821e-05_r8,1.8547e-05_r8,2.5694e-05_r8,3.6833e-05_r8, & + &6.0675e-05_r8,1.0691e-04_r8,4.5186e-05_r8/) + kao(:, 2, 1, 1) = (/ & + &2.7702e-06_r8,1.0260e-05_r8,1.6067e-05_r8,2.2990e-05_r8,3.0808e-05_r8,4.1244e-05_r8, & + &5.9411e-05_r8,1.1066e-04_r8,5.2628e-05_r8/) + kao(:, 3, 1, 1) = (/ & + &3.6863e-06_r8,1.3689e-05_r8,2.0068e-05_r8,2.8133e-05_r8,3.7359e-05_r8,4.8756e-05_r8, & + &6.5660e-05_r8,1.0750e-04_r8,6.3147e-05_r8/) + kao(:, 4, 1, 1) = (/ & + &4.8209e-06_r8,1.8184e-05_r8,2.5811e-05_r8,3.2670e-05_r8,4.2393e-05_r8,5.7509e-05_r8, & + &7.7672e-05_r8,1.1739e-04_r8,6.0614e-05_r8/) + kao(:, 5, 1, 1) = (/ & + &6.2011e-06_r8,2.3679e-05_r8,3.3185e-05_r8,4.1098e-05_r8,4.8872e-05_r8,6.0199e-05_r8, & + &8.6830e-05_r8,1.3320e-04_r8,5.7959e-05_r8/) + kao(:, 1, 2, 1) = (/ & + &2.3538e-06_r8,6.7359e-06_r8,1.0280e-05_r8,1.4331e-05_r8,1.9304e-05_r8,2.5963e-05_r8, & + &4.0842e-05_r8,7.0297e-05_r8,3.0786e-05_r8/) + kao(:, 2, 2, 1) = (/ & + &3.1800e-06_r8,9.2776e-06_r8,1.3401e-05_r8,1.8014e-05_r8,2.3501e-05_r8,3.0468e-05_r8, & + &4.1030e-05_r8,7.2758e-05_r8,3.6807e-05_r8/) + kao(:, 3, 2, 1) = (/ & + &4.2644e-06_r8,1.2589e-05_r8,1.7414e-05_r8,2.2365e-05_r8,2.8924e-05_r8,3.6996e-05_r8, & + &4.7459e-05_r8,7.1458e-05_r8,4.4453e-05_r8/) + kao(:, 4, 2, 1) = (/ & + &5.6334e-06_r8,1.6843e-05_r8,2.2937e-05_r8,2.8083e-05_r8,3.3609e-05_r8,4.3642e-05_r8, & + &5.6794e-05_r8,7.9540e-05_r8,3.7769e-05_r8/) + kao(:, 5, 2, 1) = (/ & + &7.3165e-06_r8,2.2208e-05_r8,2.9987e-05_r8,3.5834e-05_r8,4.1117e-05_r8,4.7236e-05_r8, & + &6.4507e-05_r8,9.1784e-05_r8,4.0356e-05_r8/) + kao(:, 1, 3, 1) = (/ & + &3.4149e-06_r8,6.8426e-06_r8,8.9161e-06_r8,1.1292e-05_r8,1.3987e-05_r8,1.7689e-05_r8, & + &2.4623e-05_r8,4.0560e-05_r8,1.8741e-05_r8/) + kao(:, 2, 3, 1) = (/ & + &4.6295e-06_r8,9.5910e-06_r8,1.2218e-05_r8,1.4773e-05_r8,1.7906e-05_r8,2.1627e-05_r8, & + &2.7175e-05_r8,4.1902e-05_r8,2.3338e-05_r8/) + kao(:, 3, 3, 1) = (/ & + &6.2620e-06_r8,1.3265e-05_r8,1.6740e-05_r8,1.9517e-05_r8,2.2851e-05_r8,2.6791e-05_r8, & + &3.2311e-05_r8,4.3092e-05_r8,2.7303e-05_r8/) + kao(:, 4, 3, 1) = (/ & + &8.3825e-06_r8,1.8025e-05_r8,2.2633e-05_r8,2.5988e-05_r8,2.8756e-05_r8,3.2402e-05_r8, & + &3.9084e-05_r8,5.0182e-05_r8,2.3119e-05_r8/) + kao(:, 5, 3, 1) = (/ & + &1.1030e-05_r8,2.4184e-05_r8,3.0218e-05_r8,3.4428e-05_r8,3.7379e-05_r8,3.9667e-05_r8, & + &4.3975e-05_r8,5.8391e-05_r8,2.6206e-05_r8/) + kao(:, 1, 4, 1) = (/ & + &5.0171e-06_r8,7.6880e-06_r8,8.7791e-06_r8,9.8121e-06_r8,1.1212e-05_r8,1.2838e-05_r8, & + &1.6066e-05_r8,2.4377e-05_r8,1.1689e-05_r8/) + kao(:, 2, 4, 1) = (/ & + &6.7946e-06_r8,1.0789e-05_r8,1.2297e-05_r8,1.3454e-05_r8,1.4738e-05_r8,1.6388e-05_r8, & + &1.8978e-05_r8,2.5098e-05_r8,1.5123e-05_r8/) + kao(:, 3, 4, 1) = (/ & + &9.2346e-06_r8,1.5122e-05_r8,1.7217e-05_r8,1.8715e-05_r8,1.9870e-05_r8,2.1284e-05_r8, & + &2.3541e-05_r8,2.8475e-05_r8,1.5817e-05_r8/) + kao(:, 4, 4, 1) = (/ & + &1.2485e-05_r8,2.0883e-05_r8,2.3764e-05_r8,2.5687e-05_r8,2.6834e-05_r8,2.7524e-05_r8, & + &2.9511e-05_r8,3.4495e-05_r8,1.5461e-05_r8/) + kao(:, 5, 4, 1) = (/ & + &1.6688e-05_r8,2.8377e-05_r8,3.2282e-05_r8,3.4761e-05_r8,3.6075e-05_r8,3.6212e-05_r8, & + &3.5832e-05_r8,4.0812e-05_r8,1.7475e-05_r8/) + kao(:, 1, 5, 1) = (/ & + &6.8849e-06_r8,8.9001e-06_r8,9.3032e-06_r8,9.4606e-06_r8,9.6746e-06_r8,1.0252e-05_r8, & + &1.1422e-05_r8,1.5315e-05_r8,7.4550e-06_r8/) + kao(:, 2, 5, 1) = (/ & + &9.2829e-06_r8,1.2355e-05_r8,1.3006e-05_r8,1.3223e-05_r8,1.3294e-05_r8,1.3454e-05_r8, & + &1.4383e-05_r8,1.6505e-05_r8,9.6725e-06_r8/) + kao(:, 3, 5, 1) = (/ & + &1.2628e-05_r8,1.7354e-05_r8,1.8341e-05_r8,1.8646e-05_r8,1.8560e-05_r8,1.8269e-05_r8, & + &1.8381e-05_r8,1.9847e-05_r8,1.0746e-05_r8/) + kao(:, 4, 5, 1) = (/ & + &1.7178e-05_r8,2.4178e-05_r8,2.5699e-05_r8,2.6093e-05_r8,2.5857e-05_r8,2.5047e-05_r8, & + &2.4039e-05_r8,2.4517e-05_r8,1.1239e-05_r8/) + kao(:, 5, 5, 1) = (/ & + &2.3232e-05_r8,3.3207e-05_r8,3.5417e-05_r8,3.5933e-05_r8,3.5521e-05_r8,3.4179e-05_r8, & + &3.1639e-05_r8,3.0107e-05_r8,1.3413e-05_r8/) + kao(:, 1, 6, 1) = (/ & + &8.9763e-06_r8,1.0310e-05_r8,1.0152e-05_r8,9.7112e-06_r8,9.1573e-06_r8,8.7286e-06_r8, & + &8.7100e-06_r8,1.0151e-05_r8,5.0468e-06_r8/) + kao(:, 2, 6, 1) = (/ & + &1.1944e-05_r8,1.4094e-05_r8,1.4098e-05_r8,1.3570e-05_r8,1.2771e-05_r8,1.1934e-05_r8, & + &1.1288e-05_r8,1.1804e-05_r8,6.4542e-06_r8/) + kao(:, 3, 6, 1) = (/ & + &1.6264e-05_r8,1.9621e-05_r8,1.9778e-05_r8,1.9110e-05_r8,1.7995e-05_r8,1.6619e-05_r8, & + &1.5210e-05_r8,1.4762e-05_r8,7.7867e-06_r8/) + kao(:, 4, 6, 1) = (/ & + &2.2127e-05_r8,2.7394e-05_r8,2.7774e-05_r8,2.6897e-05_r8,2.5333e-05_r8,2.3366e-05_r8, & + &2.0855e-05_r8,1.8805e-05_r8,9.1527e-06_r8/) + kao(:, 5, 6, 1) = (/ & + &3.0031e-05_r8,3.7976e-05_r8,3.8538e-05_r8,3.7483e-05_r8,3.5390e-05_r8,3.2530e-05_r8, & + &2.8729e-05_r8,2.4137e-05_r8,1.0787e-05_r8/) + kao(:, 1, 7, 1) = (/ & + &1.2661e-05_r8,1.3255e-05_r8,1.2476e-05_r8,1.1360e-05_r8,1.0126e-05_r8,8.8167e-06_r8, & + &7.6811e-06_r8,7.2819e-06_r8,3.4701e-06_r8/) + kao(:, 2, 7, 1) = (/ & + &1.6507e-05_r8,1.7720e-05_r8,1.6880e-05_r8,1.5585e-05_r8,1.3986e-05_r8,1.2151e-05_r8, & + &1.0259e-05_r8,8.9670e-06_r8,4.6214e-06_r8/) + kao(:, 3, 7, 1) = (/ & + &2.2311e-05_r8,2.4431e-05_r8,2.3459e-05_r8,2.1822e-05_r8,1.9662e-05_r8,1.7085e-05_r8, & + &1.4272e-05_r8,1.1641e-05_r8,5.9077e-06_r8/) + kao(:, 4, 7, 1) = (/ & + &3.0470e-05_r8,3.3907e-05_r8,3.2735e-05_r8,3.0550e-05_r8,2.7736e-05_r8,2.4159e-05_r8, & + &2.0093e-05_r8,1.5711e-05_r8,7.6152e-06_r8/) + kao(:, 5, 7, 1) = (/ & + &4.1581e-05_r8,4.6778e-05_r8,4.5634e-05_r8,4.2827e-05_r8,3.9000e-05_r8,3.4010e-05_r8, & + &2.8185e-05_r8,2.1414e-05_r8,9.5151e-06_r8/) + kao(:, 1, 8, 1) = (/ & + &2.2110e-05_r8,2.1516e-05_r8,1.9520e-05_r8,1.7197e-05_r8,1.4610e-05_r8,1.1834e-05_r8, & + &8.9776e-06_r8,6.4038e-06_r8,2.9294e-06_r8/) + kao(:, 2, 8, 1) = (/ & + &2.8119e-05_r8,2.7833e-05_r8,2.5591e-05_r8,2.2815e-05_r8,1.9548e-05_r8,1.6035e-05_r8, & + &1.2291e-05_r8,8.4633e-06_r8,3.7469e-06_r8/) + kao(:, 3, 8, 1) = (/ & + &3.7519e-05_r8,3.7575e-05_r8,3.4963e-05_r8,3.1329e-05_r8,2.6989e-05_r8,2.2379e-05_r8, & + &1.7209e-05_r8,1.1658e-05_r8,5.1343e-06_r8/) + kao(:, 4, 8, 1) = (/ & + &5.1233e-05_r8,5.1900e-05_r8,4.8534e-05_r8,4.3661e-05_r8,3.7852e-05_r8,3.1455e-05_r8, & + &2.4380e-05_r8,1.6303e-05_r8,6.8677e-06_r8/) + kao(:, 5, 8, 1) = (/ & + &7.0275e-05_r8,7.1610e-05_r8,6.7129e-05_r8,6.0809e-05_r8,5.2885e-05_r8,4.4177e-05_r8, & + &3.4435e-05_r8,2.2981e-05_r8,8.8724e-06_r8/) + kao(:, 1, 9, 1) = (/ & + &7.5307e-05_r8,6.8982e-05_r8,6.0564e-05_r8,5.1649e-05_r8,4.2335e-05_r8,3.2789e-05_r8, & + &2.3004e-05_r8,1.2766e-05_r8,4.1976e-06_r8/) + kao(:, 2, 9, 1) = (/ & + &9.3306e-05_r8,8.6322e-05_r8,7.6065e-05_r8,6.5167e-05_r8,5.3786e-05_r8,4.2095e-05_r8, & + &2.9960e-05_r8,1.6892e-05_r8,6.0950e-06_r8/) + kao(:, 3, 9, 1) = (/ & + &1.2202e-04_r8,1.1392e-04_r8,1.0068e-04_r8,8.6696e-05_r8,7.2080e-05_r8,5.6739e-05_r8, & + &4.0820e-05_r8,2.3292e-05_r8,8.3200e-06_r8/) + kao(:, 4, 9, 1) = (/ & + &1.6580e-04_r8,1.5570e-04_r8,1.3769e-04_r8,1.1869e-04_r8,9.9119e-05_r8,7.8735e-05_r8, & + &5.6759e-05_r8,3.2860e-05_r8,1.0538e-05_r8/) + kao(:, 5, 9, 1) = (/ & + &2.2845e-04_r8,2.1403e-04_r8,1.8995e-04_r8,1.6428e-04_r8,1.3747e-04_r8,1.0943e-04_r8, & + &7.9478e-05_r8,4.6333e-05_r8,1.2645e-05_r8/) + kao(:, 1,10, 1) = (/ & + &2.9742e-04_r8,2.6515e-04_r8,2.2972e-04_r8,1.9315e-04_r8,1.5610e-04_r8,1.1880e-04_r8, & + &8.1117e-05_r8,4.2319e-05_r8,6.3944e-06_r8/) + kao(:, 2,10, 1) = (/ & + &3.6180e-04_r8,3.2444e-04_r8,2.8214e-04_r8,2.3809e-04_r8,1.9281e-04_r8,1.4714e-04_r8, & + &1.0099e-04_r8,5.3082e-05_r8,9.7791e-06_r8/) + kao(:, 3,10, 1) = (/ & + &4.6752e-04_r8,4.2137e-04_r8,3.6703e-04_r8,3.1031e-04_r8,2.5194e-04_r8,1.9278e-04_r8, & + &1.3274e-04_r8,7.0692e-05_r8,1.3731e-05_r8/) + kao(:, 4,10, 1) = (/ & + &6.3024e-04_r8,5.6976e-04_r8,4.9706e-04_r8,4.2128e-04_r8,3.4229e-04_r8,2.6250e-04_r8, & + &1.8103e-04_r8,9.7478e-05_r8,1.8873e-05_r8/) + kao(:, 5,10, 1) = (/ & + &8.6816e-04_r8,7.8510e-04_r8,6.8602e-04_r8,5.8224e-04_r8,4.7468e-04_r8,3.6394e-04_r8, & + &2.5185e-04_r8,1.3590e-04_r8,2.4864e-05_r8/) + kao(:, 1,11, 1) = (/ & + &4.4215e-04_r8,3.9273e-04_r8,3.3972e-04_r8,2.8576e-04_r8,2.3079e-04_r8,1.7475e-04_r8, & + &1.1858e-04_r8,6.1576e-05_r8,6.9970e-06_r8/) + kao(:, 2,11, 1) = (/ & + &5.4524e-04_r8,4.8624e-04_r8,4.2158e-04_r8,3.5507e-04_r8,2.8728e-04_r8,2.1797e-04_r8, & + &1.4849e-04_r8,7.7710e-05_r8,1.0796e-05_r8/) + kao(:, 3,11, 1) = (/ & + &7.1212e-04_r8,6.3874e-04_r8,5.5491e-04_r8,4.6791e-04_r8,3.7968e-04_r8,2.8946e-04_r8, & + &1.9751e-04_r8,1.0405e-04_r8,1.6156e-05_r8/) + kao(:, 4,11, 1) = (/ & + &9.7112e-04_r8,8.7198e-04_r8,7.5717e-04_r8,6.3918e-04_r8,5.1919e-04_r8,3.9650e-04_r8, & + &2.7055e-04_r8,1.4272e-04_r8,2.2761e-05_r8/) + kao(:, 5,11, 1) = (/ & + &1.3431e-03_r8,1.2076e-03_r8,1.0484e-03_r8,8.8503e-04_r8,7.1868e-04_r8,5.4992e-04_r8, & + &3.7609e-04_r8,1.9954e-04_r8,2.9940e-05_r8/) + kao(:, 1,12, 1) = (/ & + &4.8443e-04_r8,4.2968e-04_r8,3.7109e-04_r8,3.1171e-04_r8,2.5157e-04_r8,1.9045e-04_r8, & + &1.2868e-04_r8,6.6606e-05_r8,6.8294e-06_r8/) + kao(:, 2,12, 1) = (/ & + &6.0269e-04_r8,5.3630e-04_r8,4.6453e-04_r8,3.9092e-04_r8,3.1605e-04_r8,2.4000e-04_r8, & + &1.6259e-04_r8,8.4751e-05_r8,1.0182e-05_r8/) + kao(:, 3,12, 1) = (/ & + &7.9706e-04_r8,7.1250e-04_r8,6.1805e-04_r8,5.2087e-04_r8,4.2192e-04_r8,3.2125e-04_r8, & + &2.1834e-04_r8,1.1445e-04_r8,1.5140e-05_r8/) + kao(:, 4,12, 1) = (/ & + &1.0910e-03_r8,9.7656e-04_r8,8.4711e-04_r8,7.1442e-04_r8,5.7891e-04_r8,4.4221e-04_r8, & + &3.0181e-04_r8,1.5855e-04_r8,2.1388e-05_r8/) + kao(:, 5,12, 1) = (/ & + &1.5134e-03_r8,1.3551e-03_r8,1.1752e-03_r8,9.9093e-04_r8,8.0388e-04_r8,6.1444e-04_r8, & + &4.2020e-04_r8,2.2117e-04_r8,2.9059e-05_r8/) + kao(:, 1,13, 1) = (/ & + &4.2625e-04_r8,3.7812e-04_r8,3.2711e-04_r8,2.7465e-04_r8,2.2177e-04_r8,1.6800e-04_r8, & + &1.1342e-04_r8,5.8678e-05_r8,7.1193e-06_r8/) + kao(:, 2,13, 1) = (/ & + &5.3759e-04_r8,4.7832e-04_r8,4.1433e-04_r8,3.4844e-04_r8,2.8188e-04_r8,2.1423e-04_r8, & + &1.4519e-04_r8,7.5588e-05_r8,1.0317e-05_r8/) + kao(:, 3,13, 1) = (/ & + &7.2018e-04_r8,6.4309e-04_r8,5.5764e-04_r8,4.6948e-04_r8,3.8030e-04_r8,2.8938e-04_r8, & + &1.9678e-04_r8,1.0285e-04_r8,1.4041e-05_r8/) + kao(:, 4,13, 1) = (/ & + &9.8953e-04_r8,8.8546e-04_r8,7.6800e-04_r8,6.4711e-04_r8,5.2450e-04_r8,3.9956e-04_r8, & + &2.7312e-04_r8,1.4349e-04_r8,1.9954e-05_r8/) + kao(:, 5,13, 1) = (/ & + &1.3790e-03_r8,1.2366e-03_r8,1.0731e-03_r8,9.0477e-04_r8,7.3377e-04_r8,5.6037e-04_r8, & + &3.8365e-04_r8,2.0147e-04_r8,2.6871e-05_r8/) + kao(:, 1, 1, 2) = (/ & + &6.2300e-06_r8,2.3124e-05_r8,2.9698e-05_r8,3.9591e-05_r8,5.8380e-05_r8,9.5125e-05_r8, & + &1.3537e-04_r8,2.8288e-04_r8,9.7543e-05_r8/) + kao(:, 2, 1, 2) = (/ & + &9.0246e-06_r8,3.3229e-05_r8,4.2160e-05_r8,4.9478e-05_r8,6.0779e-05_r8,8.5533e-05_r8, & + &1.5267e-04_r8,2.3904e-04_r8,8.0422e-05_r8/) + kao(:, 3, 1, 2) = (/ & + &1.2807e-05_r8,4.6362e-05_r8,5.9074e-05_r8,6.7253e-05_r8,7.5131e-05_r8,8.9889e-05_r8, & + &1.2494e-04_r8,2.6418e-04_r8,7.9145e-05_r8/) + kao(:, 4, 1, 2) = (/ & + &1.7786e-05_r8,6.3031e-05_r8,8.0225e-05_r8,9.3521e-05_r8,1.0301e-04_r8,1.0987e-04_r8, & + &1.2899e-04_r8,2.0499e-04_r8,1.0830e-04_r8/) + kao(:, 5, 1, 2) = (/ & + &2.4116e-05_r8,8.3783e-05_r8,1.0646e-04_r8,1.2431e-04_r8,1.3944e-04_r8,1.5277e-04_r8, & + &1.5881e-04_r8,2.0933e-04_r8,1.4344e-04_r8/) + kao(:, 1, 2, 2) = (/ & + &7.1421e-06_r8,2.2132e-05_r8,2.7590e-05_r8,3.3376e-05_r8,4.3482e-05_r8,6.6128e-05_r8, & + &9.2521e-05_r8,1.8166e-04_r8,6.3119e-05_r8/) + kao(:, 2, 2, 2) = (/ & + &1.0480e-05_r8,3.2273e-05_r8,3.9804e-05_r8,4.4484e-05_r8,4.9766e-05_r8,6.2224e-05_r8, & + &1.0181e-04_r8,1.6062e-04_r8,5.5112e-05_r8/) + kao(:, 3, 2, 2) = (/ & + &1.5069e-05_r8,4.5805e-05_r8,5.6454e-05_r8,6.2730e-05_r8,6.6262e-05_r8,7.1655e-05_r8, & + &8.8554e-05_r8,1.7608e-04_r8,5.4833e-05_r8/) + kao(:, 4, 2, 2) = (/ & + &2.1158e-05_r8,6.3205e-05_r8,7.7534e-05_r8,8.6669e-05_r8,9.2743e-05_r8,9.3710e-05_r8, & + &9.8368e-05_r8,1.4175e-04_r8,8.3989e-05_r8/) + kao(:, 5, 2, 2) = (/ & + &2.9018e-05_r8,8.5014e-05_r8,1.0387e-04_r8,1.1638e-04_r8,1.2535e-04_r8,1.3160e-04_r8, & + &1.2952e-04_r8,1.4715e-04_r8,1.0168e-04_r8/) + kao(:, 1, 3, 2) = (/ & + &1.0134e-05_r8,2.3698e-05_r8,2.8098e-05_r8,3.0832e-05_r8,3.4559e-05_r8,4.2739e-05_r8, & + &5.8413e-05_r8,1.0086e-04_r8,3.2546e-05_r8/) + kao(:, 2, 3, 2) = (/ & + &1.5067e-05_r8,3.5478e-05_r8,4.1782e-05_r8,4.4927e-05_r8,4.6304e-05_r8,4.9338e-05_r8, & + &6.0952e-05_r8,9.7126e-05_r8,3.2271e-05_r8/) + kao(:, 3, 3, 2) = (/ & + &2.2020e-05_r8,5.1526e-05_r8,6.0415e-05_r8,6.4785e-05_r8,6.5815e-05_r8,6.4970e-05_r8, & + &6.6401e-05_r8,9.8577e-05_r8,3.7377e-05_r8/) + kao(:, 4, 3, 2) = (/ & + &3.1402e-05_r8,7.2606e-05_r8,8.4750e-05_r8,9.0680e-05_r8,9.2879e-05_r8,9.1127e-05_r8, & + &8.5666e-05_r8,9.2372e-05_r8,5.9881e-05_r8/) + kao(:, 5, 3, 2) = (/ & + &4.3798e-05_r8,9.9375e-05_r8,1.1577e-04_r8,1.2361e-04_r8,1.2645e-04_r8,1.2543e-04_r8, & + &1.1954e-04_r8,1.0799e-04_r8,6.6216e-05_r8/) + kao(:, 1, 4, 2) = (/ & + &1.4395e-05_r8,2.6113e-05_r8,2.9242e-05_r8,3.0501e-05_r8,3.0825e-05_r8,3.2335e-05_r8, & + &3.9824e-05_r8,5.5770e-05_r8,1.8987e-05_r8/) + kao(:, 2, 4, 2) = (/ & + &2.1448e-05_r8,3.9639e-05_r8,4.4560e-05_r8,4.6391e-05_r8,4.5970e-05_r8,4.4537e-05_r8, & + &4.5440e-05_r8,6.3416e-05_r8,1.9764e-05_r8/) + kao(:, 3, 4, 2) = (/ & + &3.1834e-05_r8,5.8680e-05_r8,6.6149e-05_r8,6.8528e-05_r8,6.7668e-05_r8,6.3937e-05_r8, & + &5.8285e-05_r8,6.2232e-05_r8,2.7306e-05_r8/) + kao(:, 4, 4, 2) = (/ & + &4.6271e-05_r8,8.4438e-05_r8,9.5181e-05_r8,9.8206e-05_r8,9.6873e-05_r8,9.1747e-05_r8, & + &8.1681e-05_r8,6.9834e-05_r8,3.9615e-05_r8/) + kao(:, 5, 4, 2) = (/ & + &6.5671e-05_r8,1.1809e-04_r8,1.3274e-04_r8,1.3673e-04_r8,1.3457e-04_r8,1.2744e-04_r8, & + &1.1523e-04_r8,9.3255e-05_r8,4.5946e-05_r8/) + kao(:, 1, 5, 2) = (/ & + &1.8932e-05_r8,2.8174e-05_r8,3.0127e-05_r8,3.0189e-05_r8,2.9303e-05_r8,2.7710e-05_r8, & + &2.8724e-05_r8,3.6981e-05_r8,1.2871e-05_r8/) + kao(:, 2, 5, 2) = (/ & + &2.8193e-05_r8,4.3103e-05_r8,4.6483e-05_r8,4.6716e-05_r8,4.5184e-05_r8,4.1972e-05_r8, & + &3.7796e-05_r8,4.2113e-05_r8,1.5002e-05_r8/) + kao(:, 3, 5, 2) = (/ & + &4.2171e-05_r8,6.4890e-05_r8,7.0138e-05_r8,7.0754e-05_r8,6.8197e-05_r8,6.2875e-05_r8, & + &5.4545e-05_r8,4.7871e-05_r8,1.9971e-05_r8/) + kao(:, 4, 5, 2) = (/ & + &6.2206e-05_r8,9.5463e-05_r8,1.0284e-04_r8,1.0393e-04_r8,9.9869e-05_r8,9.1904e-05_r8, & + &7.9592e-05_r8,6.1772e-05_r8,2.7676e-05_r8/) + kao(:, 5, 5, 2) = (/ & + &8.9897e-05_r8,1.3643e-04_r8,1.4635e-04_r8,1.4773e-04_r8,1.4191e-04_r8,1.3018e-04_r8, & + &1.1303e-04_r8,8.6827e-05_r8,3.3409e-05_r8/) + kao(:, 1, 6, 2) = (/ & + &2.3688e-05_r8,3.0481e-05_r8,3.1060e-05_r8,3.0054e-05_r8,2.7961e-05_r8,2.5367e-05_r8, & + &2.2999e-05_r8,2.6629e-05_r8,1.0275e-05_r8/) + kao(:, 2, 6, 2) = (/ & + &3.4582e-05_r8,4.5983e-05_r8,4.7133e-05_r8,4.6002e-05_r8,4.3141e-05_r8,3.8854e-05_r8, & + &3.3303e-05_r8,2.9897e-05_r8,1.2224e-05_r8/) + kao(:, 3, 6, 2) = (/ & + &5.1699e-05_r8,6.9356e-05_r8,7.1684e-05_r8,7.0505e-05_r8,6.6405e-05_r8,5.9819e-05_r8, & + &5.0541e-05_r8,3.9074e-05_r8,1.6179e-05_r8/) + kao(:, 4, 6, 2) = (/ & + &7.7368e-05_r8,1.0342e-04_r8,1.0714e-04_r8,1.0541e-04_r8,9.9595e-05_r8,8.9603e-05_r8, & + &7.5459e-05_r8,5.5384e-05_r8,2.1206e-05_r8/) + kao(:, 5, 6, 2) = (/ & + &1.1347e-04_r8,1.5064e-04_r8,1.5637e-04_r8,1.5316e-04_r8,1.4449e-04_r8,1.2985e-04_r8, & + &1.0910e-04_r8,8.0324e-05_r8,2.6862e-05_r8/) + kao(:, 1, 7, 2) = (/ & + &3.2355e-05_r8,3.6612e-05_r8,3.5642e-05_r8,3.3581e-05_r8,3.0393e-05_r8,2.6088e-05_r8, & + &2.1415e-05_r8,1.9368e-05_r8,9.5314e-06_r8/) + kao(:, 2, 7, 2) = (/ & + &4.6022e-05_r8,5.3816e-05_r8,5.2843e-05_r8,4.9963e-05_r8,4.5493e-05_r8,3.9581e-05_r8, & + &3.2262e-05_r8,2.4294e-05_r8,1.1772e-05_r8/) + kao(:, 3, 7, 2) = (/ & + &6.7685e-05_r8,8.0405e-05_r8,7.9935e-05_r8,7.5649e-05_r8,6.9218e-05_r8,6.0527e-05_r8, & + &4.9342e-05_r8,3.5155e-05_r8,1.4463e-05_r8/) + kao(:, 4, 7, 2) = (/ & + &1.0120e-04_r8,1.2036e-04_r8,1.2034e-04_r8,1.1418e-04_r8,1.0434e-04_r8,9.1774e-05_r8, & + &7.5257e-05_r8,5.2793e-05_r8,1.8375e-05_r8/) + kao(:, 5, 7, 2) = (/ & + &1.5071e-04_r8,1.7822e-04_r8,1.7733e-04_r8,1.6840e-04_r8,1.5410e-04_r8,1.3584e-04_r8, & + &1.1141e-04_r8,7.8080e-05_r8,2.3868e-05_r8/) + kao(:, 1, 8, 2) = (/ & + &5.5226e-05_r8,5.6106e-05_r8,5.2275e-05_r8,4.7400e-05_r8,4.1299e-05_r8,3.4449e-05_r8, & + &2.6593e-05_r8,1.7838e-05_r8,1.0224e-05_r8/) + kao(:, 2, 8, 2) = (/ & + &7.6682e-05_r8,7.9501e-05_r8,7.4950e-05_r8,6.8270e-05_r8,5.9838e-05_r8,5.0360e-05_r8, & + &3.9211e-05_r8,2.5644e-05_r8,1.3679e-05_r8/) + kao(:, 3, 8, 2) = (/ & + &1.1162e-04_r8,1.1744e-04_r8,1.1105e-04_r8,1.0166e-04_r8,8.9544e-05_r8,7.5446e-05_r8, & + &5.9105e-05_r8,3.8912e-05_r8,1.6924e-05_r8/) + kao(:, 4, 8, 2) = (/ & + &1.6426e-04_r8,1.7413e-04_r8,1.6536e-04_r8,1.5206e-04_r8,1.3480e-04_r8,1.1398e-04_r8, & + &8.9434e-05_r8,5.9125e-05_r8,2.1439e-05_r8/) + kao(:, 5, 8, 2) = (/ & + &2.4317e-04_r8,2.5868e-04_r8,2.4524e-04_r8,2.2533e-04_r8,2.0048e-04_r8,1.6943e-04_r8, & + &1.3297e-04_r8,8.8280e-05_r8,2.6395e-05_r8/) + kao(:, 1, 9, 2) = (/ & + &1.8480e-04_r8,1.7106e-04_r8,1.5192e-04_r8,1.3086e-04_r8,1.0905e-04_r8,8.6158e-05_r8, & + &6.2340e-05_r8,3.6177e-05_r8,1.4903e-05_r8/) + kao(:, 2, 9, 2) = (/ & + &2.4641e-04_r8,2.3135e-04_r8,2.0759e-04_r8,1.8017e-04_r8,1.5122e-04_r8,1.2054e-04_r8, & + &8.8111e-05_r8,5.2211e-05_r8,2.0425e-05_r8/) + kao(:, 3, 9, 2) = (/ & + &3.5294e-04_r8,3.3406e-04_r8,3.0047e-04_r8,2.6193e-04_r8,2.2100e-04_r8,1.7727e-04_r8, & + &1.3000e-04_r8,7.7386e-05_r8,2.5956e-05_r8/) + kao(:, 4, 9, 2) = (/ & + &5.2033e-04_r8,4.9504e-04_r8,4.4640e-04_r8,3.9034e-04_r8,3.2978e-04_r8,2.6409e-04_r8, & + &1.9434e-04_r8,1.1587e-04_r8,3.4101e-05_r8/) + kao(:, 5, 9, 2) = (/ & + &7.6495e-04_r8,7.3083e-04_r8,6.5854e-04_r8,5.7617e-04_r8,4.8713e-04_r8,3.9080e-04_r8, & + &2.8811e-04_r8,1.7251e-04_r8,4.3686e-05_r8/) + kao(:, 1,10, 2) = (/ & + &7.1951e-04_r8,6.4170e-04_r8,5.5848e-04_r8,4.7254e-04_r8,3.8543e-04_r8,2.9616e-04_r8, & + &2.0442e-04_r8,1.0914e-04_r8,2.8683e-05_r8/) + kao(:, 2,10, 2) = (/ & + &9.5077e-04_r8,8.5141e-04_r8,7.4327e-04_r8,6.3053e-04_r8,5.1626e-04_r8,3.9828e-04_r8, & + &2.7613e-04_r8,1.4913e-04_r8,3.8199e-05_r8/) + kao(:, 3,10, 2) = (/ & + &1.3355e-03_r8,1.2001e-03_r8,1.0504e-03_r8,8.9360e-04_r8,7.3324e-04_r8,5.6715e-04_r8, & + &3.9425e-04_r8,2.1480e-04_r8,4.7134e-05_r8/) + kao(:, 4,10, 2) = (/ & + &1.9553e-03_r8,1.7643e-03_r8,1.5470e-03_r8,1.3173e-03_r8,1.0803e-03_r8,8.3446e-04_r8, & + &5.8166e-04_r8,3.1871e-04_r8,5.8212e-05_r8/) + kao(:, 5,10, 2) = (/ & + &2.8783e-03_r8,2.5953e-03_r8,2.2770e-03_r8,1.9407e-03_r8,1.5909e-03_r8,1.2316e-03_r8, & + &8.6003e-04_r8,4.7307e-04_r8,7.1136e-05_r8/) + kao(:, 1,11, 2) = (/ & + &1.1139e-03_r8,9.8774e-04_r8,8.5580e-04_r8,7.2091e-04_r8,5.8416e-04_r8,4.4688e-04_r8, & + &3.0678e-04_r8,1.6222e-04_r8,3.9161e-05_r8/) + kao(:, 2,11, 2) = (/ & + &1.5083e-03_r8,1.3423e-03_r8,1.1649e-03_r8,9.8455e-04_r8,8.0047e-04_r8,6.1397e-04_r8, & + &4.2291e-04_r8,2.2482e-04_r8,5.4701e-05_r8/) + kao(:, 3,11, 2) = (/ & + &2.1559e-03_r8,1.9181e-03_r8,1.6686e-03_r8,1.4112e-03_r8,1.1484e-03_r8,8.7957e-04_r8, & + &6.0584e-04_r8,3.2346e-04_r8,6.6564e-05_r8/) + kao(:, 4,11, 2) = (/ & + &3.1472e-03_r8,2.8085e-03_r8,2.4474e-03_r8,2.0740e-03_r8,1.6883e-03_r8,1.2953e-03_r8, & + &8.9345e-04_r8,4.7890e-04_r8,8.3118e-05_r8/) + kao(:, 5,11, 2) = (/ & + &4.6362e-03_r8,4.1388e-03_r8,3.6072e-03_r8,3.0601e-03_r8,2.4938e-03_r8,1.9129e-03_r8, & + &1.3182e-03_r8,7.0366e-04_r8,1.0053e-04_r8/) + kao(:, 1,12, 2) = (/ & + &1.2746e-03_r8,1.1293e-03_r8,9.7744e-04_r8,8.2280e-04_r8,6.6509e-04_r8,5.0694e-04_r8, & + &3.4671e-04_r8,1.8255e-04_r8,4.0437e-05_r8/) + kao(:, 2,12, 2) = (/ & + &1.7556e-03_r8,1.5589e-03_r8,1.3508e-03_r8,1.1390e-03_r8,9.2389e-04_r8,7.0640e-04_r8, & + &4.8477e-04_r8,2.5611e-04_r8,5.8338e-05_r8/) + kao(:, 3,12, 2) = (/ & + &2.5208e-03_r8,2.2390e-03_r8,1.9427e-03_r8,1.6407e-03_r8,1.3325e-03_r8,1.0177e-03_r8, & + &6.9952e-04_r8,3.6990e-04_r8,7.2977e-05_r8/) + kao(:, 4,12, 2) = (/ & + &3.7199e-03_r8,3.3065e-03_r8,2.8736e-03_r8,2.4286e-03_r8,1.9715e-03_r8,1.5043e-03_r8, & + &1.0308e-03_r8,5.4613e-04_r8,9.0596e-05_r8/) + kao(:, 5,12, 2) = (/ & + &5.4892e-03_r8,4.8847e-03_r8,4.2441e-03_r8,3.5888e-03_r8,2.9119e-03_r8,2.2221e-03_r8, & + &1.5249e-03_r8,8.0704e-04_r8,1.1205e-04_r8/) + kao(:, 1,13, 2) = (/ & + &1.1670e-03_r8,1.0343e-03_r8,8.9403e-04_r8,7.5206e-04_r8,6.0815e-04_r8,4.6361e-04_r8, & + &3.1684e-04_r8,1.6665e-04_r8,3.8297e-05_r8/) + kao(:, 2,13, 2) = (/ & + &1.6263e-03_r8,1.4448e-03_r8,1.2518e-03_r8,1.0548e-03_r8,8.5537e-04_r8,6.5308e-04_r8, & + &4.4734e-04_r8,2.3634e-04_r8,5.4012e-05_r8/) + kao(:, 3,13, 2) = (/ & + &2.3576e-03_r8,2.0975e-03_r8,1.8201e-03_r8,1.5368e-03_r8,1.2479e-03_r8,9.5295e-04_r8, & + &6.5303e-04_r8,3.4532e-04_r8,6.8858e-05_r8/) + kao(:, 4,13, 2) = (/ & + &3.5158e-03_r8,3.1277e-03_r8,2.7158e-03_r8,2.2939e-03_r8,1.8617e-03_r8,1.4210e-03_r8, & + &9.7237e-04_r8,5.1302e-04_r8,8.6284e-05_r8/) + kao(:, 5,13, 2) = (/ & + &5.1868e-03_r8,4.6126e-03_r8,4.0043e-03_r8,3.3796e-03_r8,2.7407e-03_r8,2.0921e-03_r8, & + &1.4302e-03_r8,7.5554e-04_r8,1.0703e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &2.1967e-05_r8,7.0847e-05_r8,9.8056e-05_r8,1.1683e-04_r8,1.2672e-04_r8,1.3386e-04_r8, & + &1.7335e-04_r8,3.0889e-04_r8,1.4104e-04_r8/) + kao(:, 2, 1, 3) = (/ & + &3.2805e-05_r8,1.0021e-04_r8,1.3719e-04_r8,1.6469e-04_r8,1.8755e-04_r8,2.0275e-04_r8, & + &1.9715e-04_r8,2.9590e-04_r8,1.6430e-04_r8/) + kao(:, 3, 1, 3) = (/ & + &4.7330e-05_r8,1.3749e-04_r8,1.8575e-04_r8,2.2309e-04_r8,2.5257e-04_r8,2.7701e-04_r8, & + &3.0293e-04_r8,3.2277e-04_r8,1.5833e-04_r8/) + kao(:, 4, 1, 3) = (/ & + &6.6184e-05_r8,1.8358e-04_r8,2.4505e-04_r8,2.9115e-04_r8,3.2275e-04_r8,3.3970e-04_r8, & + &3.6327e-04_r8,4.7032e-04_r8,1.5296e-04_r8/) + kao(:, 5, 1, 3) = (/ & + &8.9953e-05_r8,2.3845e-04_r8,3.1568e-04_r8,3.7021e-04_r8,4.0111e-04_r8,4.1250e-04_r8, & + &4.1712e-04_r8,4.9013e-04_r8,1.7116e-04_r8/) + kao(:, 1, 2, 3) = (/ & + &2.6480e-05_r8,6.7795e-05_r8,8.8273e-05_r8,1.0239e-04_r8,1.1087e-04_r8,1.1252e-04_r8, & + &1.2626e-04_r8,1.7765e-04_r8,1.0235e-04_r8/) + kao(:, 2, 2, 3) = (/ & + &4.0229e-05_r8,9.8115e-05_r8,1.2639e-04_r8,1.4693e-04_r8,1.6171e-04_r8,1.7149e-04_r8, & + &1.6078e-04_r8,2.0296e-04_r8,1.0513e-04_r8/) + kao(:, 3, 2, 3) = (/ & + &5.9019e-05_r8,1.3751e-04_r8,1.7468e-04_r8,2.0166e-04_r8,2.2223e-04_r8,2.3730e-04_r8, & + &2.4647e-04_r8,2.3569e-04_r8,1.0639e-04_r8/) + kao(:, 4, 2, 3) = (/ & + &8.3741e-05_r8,1.8682e-04_r8,2.3419e-04_r8,2.6910e-04_r8,2.9309e-04_r8,3.0629e-04_r8, & + &3.1256e-04_r8,3.4516e-04_r8,1.0584e-04_r8/) + kao(:, 5, 2, 3) = (/ & + &1.1534e-04_r8,2.4682e-04_r8,3.0598e-04_r8,3.4903e-04_r8,3.7559e-04_r8,3.8169e-04_r8, & + &3.7221e-04_r8,3.8365e-04_r8,1.2786e-04_r8/) + kao(:, 1, 3, 3) = (/ & + &3.8574e-05_r8,7.5157e-05_r8,8.9382e-05_r8,9.8254e-05_r8,1.0233e-04_r8,1.0063e-04_r8, & + &1.0056e-04_r8,1.0870e-04_r8,6.8446e-05_r8/) + kao(:, 2, 3, 3) = (/ & + &6.0142e-05_r8,1.1264e-04_r8,1.3244e-04_r8,1.4504e-04_r8,1.5242e-04_r8,1.5259e-04_r8, & + &1.4806e-04_r8,1.3730e-04_r8,6.4347e-05_r8/) + kao(:, 3, 3, 3) = (/ & + &9.0381e-05_r8,1.6247e-04_r8,1.8926e-04_r8,2.0538e-04_r8,2.1407e-04_r8,2.1609e-04_r8, & + &2.1113e-04_r8,1.9332e-04_r8,6.7739e-05_r8/) + kao(:, 4, 3, 3) = (/ & + &1.3106e-04_r8,2.2712e-04_r8,2.6180e-04_r8,2.8099e-04_r8,2.9092e-04_r8,2.9292e-04_r8, & + &2.8375e-04_r8,2.7092e-04_r8,6.8866e-05_r8/) + kao(:, 5, 3, 3) = (/ & + &1.8403e-04_r8,3.0884e-04_r8,3.5100e-04_r8,3.7380e-04_r8,3.8510e-04_r8,3.8362e-04_r8, & + &3.6289e-04_r8,3.2300e-04_r8,9.2758e-05_r8/) + kao(:, 1, 4, 3) = (/ & + &5.4705e-05_r8,8.6072e-05_r8,9.6209e-05_r8,1.0034e-04_r8,9.9953e-05_r8,9.5189e-05_r8, & + &8.3161e-05_r8,7.9207e-05_r8,3.9423e-05_r8/) + kao(:, 2, 4, 3) = (/ & + &8.7751e-05_r8,1.3347e-04_r8,1.4769e-04_r8,1.5271e-04_r8,1.5230e-04_r8,1.4652e-04_r8, & + &1.3316e-04_r8,1.0796e-04_r8,4.2482e-05_r8/) + kao(:, 3, 4, 3) = (/ & + &1.3536e-04_r8,1.9949e-04_r8,2.1780e-04_r8,2.2400e-04_r8,2.2194e-04_r8,2.1254e-04_r8, & + &1.9475e-04_r8,1.6332e-04_r8,4.5138e-05_r8/) + kao(:, 4, 4, 3) = (/ & + &2.0116e-04_r8,2.8783e-04_r8,3.1041e-04_r8,3.1735e-04_r8,3.1196e-04_r8,2.9572e-04_r8, & + &2.7052e-04_r8,2.3211e-04_r8,5.0851e-05_r8/) + kao(:, 5, 4, 3) = (/ & + &2.8895e-04_r8,4.0188e-04_r8,4.2924e-04_r8,4.3500e-04_r8,4.2412e-04_r8,3.9959e-04_r8, & + &3.6227e-04_r8,3.0072e-04_r8,6.6760e-05_r8/) + kao(:, 1, 5, 3) = (/ & + &7.0137e-05_r8,9.4755e-05_r8,1.0063e-04_r8,1.0127e-04_r8,9.8061e-05_r8,9.0698e-05_r8, & + &7.7439e-05_r8,5.9138e-05_r8,2.6683e-05_r8/) + kao(:, 2, 5, 3) = (/ & + &1.1533e-04_r8,1.5194e-04_r8,1.5997e-04_r8,1.5979e-04_r8,1.5340e-04_r8,1.4208e-04_r8, & + &1.2486e-04_r8,9.3241e-05_r8,2.9592e-05_r8/) + kao(:, 3, 5, 3) = (/ & + &1.8276e-04_r8,2.3503e-04_r8,2.4432e-04_r8,2.4189e-04_r8,2.3109e-04_r8,2.1296e-04_r8, & + &1.8693e-04_r8,1.4538e-04_r8,3.2790e-05_r8/) + kao(:, 4, 5, 3) = (/ & + &2.7903e-04_r8,3.5030e-04_r8,3.5953e-04_r8,3.5303e-04_r8,3.3542e-04_r8,3.0702e-04_r8, & + &2.6606e-04_r8,2.0930e-04_r8,3.9551e-05_r8/) + kao(:, 5, 5, 3) = (/ & + &4.1070e-04_r8,5.0357e-04_r8,5.1208e-04_r8,4.9861e-04_r8,4.7008e-04_r8,4.2683e-04_r8, & + &3.6701e-04_r8,2.8592e-04_r8,5.1146e-05_r8/) + kao(:, 1, 6, 3) = (/ & + &8.1368e-05_r8,9.8431e-05_r8,1.0007e-04_r8,9.7542e-05_r8,9.2017e-05_r8,8.3169e-05_r8, & + &7.0090e-05_r8,4.8919e-05_r8,2.1156e-05_r8/) + kao(:, 2, 6, 3) = (/ & + &1.3706e-04_r8,1.6300e-04_r8,1.6503e-04_r8,1.5990e-04_r8,1.4992e-04_r8,1.3472e-04_r8, & + &1.1399e-04_r8,8.3619e-05_r8,2.5058e-05_r8/) + kao(:, 3, 6, 3) = (/ & + &2.2338e-04_r8,2.6147e-04_r8,2.6146e-04_r8,2.5118e-04_r8,2.3339e-04_r8,2.0831e-04_r8, & + &1.7568e-04_r8,1.3135e-04_r8,2.8387e-05_r8/) + kao(:, 4, 6, 3) = (/ & + &3.5127e-04_r8,4.0389e-04_r8,3.9905e-04_r8,3.7918e-04_r8,3.4971e-04_r8,3.1035e-04_r8, & + &2.5984e-04_r8,1.9266e-04_r8,3.2799e-05_r8/) + kao(:, 5, 6, 3) = (/ & + &5.3129e-04_r8,6.0001e-04_r8,5.8622e-04_r8,5.5309e-04_r8,5.0577e-04_r8,4.4569e-04_r8, & + &3.6955e-04_r8,2.7080e-04_r8,4.1496e-05_r8/) + kao(:, 1, 7, 3) = (/ & + &1.0007e-04_r8,1.0969e-04_r8,1.0696e-04_r8,1.0012e-04_r8,9.0860e-05_r8,7.9591e-05_r8, & + &6.5272e-05_r8,4.4404e-05_r8,1.8023e-05_r8/) + kao(:, 2, 7, 3) = (/ & + &1.6864e-04_r8,1.8414e-04_r8,1.7903e-04_r8,1.6759e-04_r8,1.5212e-04_r8,1.3294e-04_r8, & + &1.0932e-04_r8,7.7110e-05_r8,2.3161e-05_r8/) + kao(:, 3, 7, 3) = (/ & + &2.8238e-04_r8,3.0439e-04_r8,2.9352e-04_r8,2.7330e-04_r8,2.4706e-04_r8,2.1459e-04_r8, & + &1.7451e-04_r8,1.2351e-04_r8,2.8855e-05_r8/) + kao(:, 4, 7, 3) = (/ & + &4.5659e-04_r8,4.8716e-04_r8,4.6539e-04_r8,4.2996e-04_r8,3.8506e-04_r8,3.3112e-04_r8, & + &2.6671e-04_r8,1.8725e-04_r8,3.4923e-05_r8/) + kao(:, 5, 7, 3) = (/ & + &7.1027e-04_r8,7.4800e-04_r8,7.1021e-04_r8,6.5078e-04_r8,5.7777e-04_r8,4.9194e-04_r8, & + &3.9297e-04_r8,2.7155e-04_r8,4.1495e-05_r8/) + kao(:, 1, 8, 3) = (/ & + &1.5946e-04_r8,1.5842e-04_r8,1.4746e-04_r8,1.3211e-04_r8,1.1546e-04_r8,9.6168e-05_r8, & + &7.4324e-05_r8,4.8395e-05_r8,1.7989e-05_r8/) + kao(:, 2, 8, 3) = (/ & + &2.5770e-04_r8,2.5704e-04_r8,2.3941e-04_r8,2.1551e-04_r8,1.8837e-04_r8,1.5713e-04_r8, & + &1.2214e-04_r8,8.1368e-05_r8,2.3968e-05_r8/) + kao(:, 3, 8, 3) = (/ & + &4.2472e-04_r8,4.2443e-04_r8,3.9713e-04_r8,3.5763e-04_r8,3.1122e-04_r8,2.5901e-04_r8, & + &2.0043e-04_r8,1.3331e-04_r8,3.2118e-05_r8/) + kao(:, 4, 8, 3) = (/ & + &7.0597e-04_r8,6.9998e-04_r8,6.4911e-04_r8,5.8037e-04_r8,5.0147e-04_r8,4.1570e-04_r8, & + &3.1990e-04_r8,2.0974e-04_r8,3.9608e-05_r8/) + kao(:, 5, 8, 3) = (/ & + &1.1264e-03_r8,1.1057e-03_r8,1.0236e-03_r8,9.1299e-04_r8,7.8475e-04_r8,6.4516e-04_r8, & + &4.9155e-04_r8,3.1715e-04_r8,4.8541e-05_r8/) + kao(:, 1, 9, 3) = (/ & + &5.0227e-04_r8,4.5998e-04_r8,4.0915e-04_r8,3.5429e-04_r8,2.9541e-04_r8,2.3264e-04_r8, & + &1.6588e-04_r8,9.6165e-05_r8,2.6165e-05_r8/) + kao(:, 2, 9, 3) = (/ & + &7.8676e-04_r8,7.2202e-04_r8,6.4423e-04_r8,5.5868e-04_r8,4.6624e-04_r8,3.6840e-04_r8, & + &2.6387e-04_r8,1.5409e-04_r8,3.5446e-05_r8/) + kao(:, 3, 9, 3) = (/ & + &1.2789e-03_r8,1.1712e-03_r8,1.0462e-03_r8,9.0711e-04_r8,7.5900e-04_r8,5.9930e-04_r8, & + &4.3043e-04_r8,2.5008e-04_r8,4.6358e-05_r8/) + kao(:, 4, 9, 3) = (/ & + &2.0840e-03_r8,1.9016e-03_r8,1.6924e-03_r8,1.4648e-03_r8,1.2215e-03_r8,9.6366e-04_r8, & + &6.9084e-04_r8,4.0072e-04_r8,6.1001e-05_r8/) + kao(:, 5, 9, 3) = (/ & + &3.3367e-03_r8,3.0441e-03_r8,2.7105e-03_r8,2.3462e-03_r8,1.9558e-03_r8,1.5435e-03_r8, & + &1.1056e-03_r8,6.3552e-04_r8,7.9035e-05_r8/) + kao(:, 1,10, 3) = (/ & + &1.9385e-03_r8,1.7157e-03_r8,1.4863e-03_r8,1.2534e-03_r8,1.0193e-03_r8,7.7905e-04_r8, & + &5.3570e-04_r8,2.8621e-04_r8,4.8614e-05_r8/) + kao(:, 2,10, 3) = (/ & + &2.9395e-03_r8,2.6008e-03_r8,2.2566e-03_r8,1.9073e-03_r8,1.5534e-03_r8,1.1938e-03_r8, & + &8.2332e-04_r8,4.4169e-04_r8,7.1291e-05_r8/) + kao(:, 3,10, 3) = (/ & + &4.6962e-03_r8,4.1509e-03_r8,3.6037e-03_r8,3.0461e-03_r8,2.4817e-03_r8,1.9064e-03_r8, & + &1.3190e-03_r8,7.0872e-04_r8,9.5825e-05_r8/) + kao(:, 4,10, 3) = (/ & + &7.5852e-03_r8,6.6994e-03_r8,5.8186e-03_r8,4.9195e-03_r8,4.0087e-03_r8,3.0812e-03_r8, & + &2.1247e-03_r8,1.1368e-03_r8,1.1801e-04_r8/) + kao(:, 5,10, 3) = (/ & + &1.2000e-02_r8,1.0601e-02_r8,9.2089e-03_r8,7.7807e-03_r8,6.3408e-03_r8,4.8692e-03_r8, & + &3.3607e-03_r8,1.8001e-03_r8,1.5301e-04_r8/) + kao(:, 1,11, 3) = (/ & + &3.1614e-03_r8,2.7883e-03_r8,2.4150e-03_r8,2.0359e-03_r8,1.6451e-03_r8,1.2526e-03_r8, & + &8.5416e-04_r8,4.4797e-04_r8,5.8064e-05_r8/) + kao(:, 2,11, 3) = (/ & + &4.7730e-03_r8,4.2097e-03_r8,3.6498e-03_r8,3.0671e-03_r8,2.4809e-03_r8,1.8948e-03_r8, & + &1.2977e-03_r8,6.8686e-04_r8,8.3754e-05_r8/) + kao(:, 3,11, 3) = (/ & + &7.6614e-03_r8,6.7521e-03_r8,5.8435e-03_r8,4.9093e-03_r8,3.9758e-03_r8,3.0351e-03_r8, & + &2.0807e-03_r8,1.0948e-03_r8,1.2253e-04_r8/) + kao(:, 4,11, 3) = (/ & + &1.2246e-02_r8,1.0785e-02_r8,9.3301e-03_r8,7.8482e-03_r8,6.3562e-03_r8,4.8536e-03_r8, & + &3.3260e-03_r8,1.7481e-03_r8,1.5741e-04_r8/) + kao(:, 5,11, 3) = (/ & + &1.9021e-02_r8,1.6750e-02_r8,1.4500e-02_r8,1.2206e-02_r8,9.8921e-03_r8,7.5567e-03_r8, & + &5.1767e-03_r8,2.7251e-03_r8,2.0052e-04_r8/) + kao(:, 1,12, 3) = (/ & + &3.8826e-03_r8,3.4185e-03_r8,2.9574e-03_r8,2.4900e-03_r8,2.0123e-03_r8,1.5298e-03_r8, & + &1.0368e-03_r8,5.3904e-04_r8,6.3688e-05_r8/) + kao(:, 2,12, 3) = (/ & + &5.8362e-03_r8,5.1381e-03_r8,4.4457e-03_r8,3.7372e-03_r8,3.0206e-03_r8,2.2947e-03_r8, & + &1.5681e-03_r8,8.2298e-04_r8,8.9290e-05_r8/) + kao(:, 3,12, 3) = (/ & + &9.2251e-03_r8,8.1210e-03_r8,7.0237e-03_r8,5.8967e-03_r8,4.7688e-03_r8,3.6322e-03_r8, & + &2.4807e-03_r8,1.3032e-03_r8,1.3416e-04_r8/) + kao(:, 4,12, 3) = (/ & + &1.4709e-02_r8,1.2946e-02_r8,1.1191e-02_r8,9.4045e-03_r8,7.5956e-03_r8,5.7870e-03_r8, & + &3.9575e-03_r8,2.0727e-03_r8,1.8001e-04_r8/) + kao(:, 5,12, 3) = (/ & + &2.2619e-02_r8,1.9908e-02_r8,1.7216e-02_r8,1.4475e-02_r8,1.1703e-02_r8,8.9157e-03_r8, & + &6.0792e-03_r8,3.1754e-03_r8,2.2086e-04_r8/) + kao(:, 1,13, 3) = (/ & + &3.8309e-03_r8,3.3731e-03_r8,2.9187e-03_r8,2.4542e-03_r8,1.9844e-03_r8,1.5107e-03_r8, & + &1.0279e-03_r8,5.3642e-04_r8,6.4942e-05_r8/) + kao(:, 2,13, 3) = (/ & + &5.8347e-03_r8,5.1376e-03_r8,4.4461e-03_r8,3.7352e-03_r8,3.0197e-03_r8,2.2950e-03_r8, & + &1.5588e-03_r8,8.1629e-04_r8,9.2767e-05_r8/) + kao(:, 3,13, 3) = (/ & + &9.2194e-03_r8,8.1162e-03_r8,7.0173e-03_r8,5.8930e-03_r8,4.7598e-03_r8,3.6175e-03_r8, & + &2.4591e-03_r8,1.2857e-03_r8,1.3288e-04_r8/) + kao(:, 4,13, 3) = (/ & + &1.4386e-02_r8,1.2666e-02_r8,1.0949e-02_r8,9.1979e-03_r8,7.4294e-03_r8,5.6460e-03_r8, & + &3.8493e-03_r8,2.0075e-03_r8,1.7458e-04_r8/) + kao(:, 5,13, 3) = (/ & + &2.1887e-02_r8,1.9271e-02_r8,1.6664e-02_r8,1.4007e-02_r8,1.1332e-02_r8,8.6132e-03_r8, & + &5.8543e-03_r8,3.0399e-03_r8,2.1866e-04_r8/) + kao(:, 1, 1, 4) = (/ & + &1.2767e-04_r8,2.6436e-04_r8,3.0512e-04_r8,3.1799e-04_r8,3.1958e-04_r8,3.3191e-04_r8, & + &3.9104e-04_r8,5.0710e-04_r8,1.7855e-04_r8/) + kao(:, 2, 1, 4) = (/ & + &1.7738e-04_r8,3.5053e-04_r8,3.9839e-04_r8,4.1229e-04_r8,4.0492e-04_r8,3.8983e-04_r8, & + &4.1500e-04_r8,5.9614e-04_r8,1.6036e-04_r8/) + kao(:, 3, 1, 4) = (/ & + &2.3686e-04_r8,4.4965e-04_r8,5.0544e-04_r8,5.1877e-04_r8,5.0600e-04_r8,4.7740e-04_r8, & + &4.5052e-04_r8,5.7236e-04_r8,1.8787e-04_r8/) + kao(:, 4, 1, 4) = (/ & + &3.0650e-04_r8,5.6569e-04_r8,6.3165e-04_r8,6.4530e-04_r8,6.3512e-04_r8,6.1237e-04_r8, & + &5.6656e-04_r8,5.2891e-04_r8,2.7469e-04_r8/) + kao(:, 5, 1, 4) = (/ & + &3.8512e-04_r8,6.9752e-04_r8,7.7525e-04_r8,7.9245e-04_r8,7.8883e-04_r8,7.7085e-04_r8, & + &7.4060e-04_r8,6.7719e-04_r8,3.6282e-04_r8/) + kao(:, 1, 2, 4) = (/ & + &1.5390e-04_r8,2.7494e-04_r8,3.1261e-04_r8,3.2023e-04_r8,3.1151e-04_r8,2.9547e-04_r8, & + &3.1497e-04_r8,3.9039e-04_r8,1.0989e-04_r8/) + kao(:, 2, 2, 4) = (/ & + &2.1714e-04_r8,3.7453e-04_r8,4.1638e-04_r8,4.2413e-04_r8,4.1007e-04_r8,3.7857e-04_r8, & + &3.5354e-04_r8,4.2401e-04_r8,1.1763e-04_r8/) + kao(:, 3, 2, 4) = (/ & + &2.9352e-04_r8,4.8938e-04_r8,5.3784e-04_r8,5.4431e-04_r8,5.2257e-04_r8,4.7749e-04_r8, & + &4.2355e-04_r8,4.2211e-04_r8,1.4157e-04_r8/) + kao(:, 4, 2, 4) = (/ & + &3.8348e-04_r8,6.2214e-04_r8,6.8003e-04_r8,6.8421e-04_r8,6.5590e-04_r8,6.0605e-04_r8, & + &5.3467e-04_r8,4.5064e-04_r8,2.0612e-04_r8/) + kao(:, 5, 2, 4) = (/ & + &4.8704e-04_r8,7.7618e-04_r8,8.4540e-04_r8,8.4784e-04_r8,8.1484e-04_r8,7.6245e-04_r8, & + &6.8894e-04_r8,5.8453e-04_r8,2.7190e-04_r8/) + kao(:, 1, 3, 4) = (/ & + &2.3071e-04_r8,3.3499e-04_r8,3.6845e-04_r8,3.7270e-04_r8,3.5547e-04_r8,3.2203e-04_r8, & + &2.7656e-04_r8,2.6506e-04_r8,6.2779e-05_r8/) + kao(:, 2, 3, 4) = (/ & + &3.3368e-04_r8,4.7302e-04_r8,5.1131e-04_r8,5.0923e-04_r8,4.8101e-04_r8,4.3420e-04_r8, & + &3.6192e-04_r8,3.1963e-04_r8,7.8022e-05_r8/) + kao(:, 3, 3, 4) = (/ & + &4.6167e-04_r8,6.3817e-04_r8,6.7863e-04_r8,6.7148e-04_r8,6.3202e-04_r8,5.6610e-04_r8, & + &4.7208e-04_r8,3.5841e-04_r8,1.0032e-04_r8/) + kao(:, 4, 3, 4) = (/ & + &6.1421e-04_r8,8.2728e-04_r8,8.7092e-04_r8,8.6012e-04_r8,8.0666e-04_r8,7.1818e-04_r8, & + &5.9937e-04_r8,4.3811e-04_r8,1.4466e-04_r8/) + kao(:, 5, 3, 4) = (/ & + &7.9318e-04_r8,1.0499e-03_r8,1.1001e-03_r8,1.0825e-03_r8,1.0111e-03_r8,9.0157e-04_r8, & + &7.5964e-04_r8,5.7512e-04_r8,1.9432e-04_r8/) + kao(:, 1, 4, 4) = (/ & + &3.4200e-04_r8,4.1990e-04_r8,4.4259e-04_r8,4.3661e-04_r8,4.1163e-04_r8,3.6760e-04_r8, & + &3.0371e-04_r8,2.3149e-04_r8,4.6307e-05_r8/) + kao(:, 2, 4, 4) = (/ & + &5.0920e-04_r8,6.1539e-04_r8,6.3721e-04_r8,6.1994e-04_r8,5.7603e-04_r8,5.0827e-04_r8, & + &4.1402e-04_r8,2.9065e-04_r8,5.1907e-05_r8/) + kao(:, 3, 4, 4) = (/ & + &7.2424e-04_r8,8.6063e-04_r8,8.7699e-04_r8,8.4266e-04_r8,7.7721e-04_r8,6.8304e-04_r8, & + &5.5495e-04_r8,3.8326e-04_r8,6.9160e-05_r8/) + kao(:, 4, 4, 4) = (/ & + &9.8776e-04_r8,1.1516e-03_r8,1.1582e-03_r8,1.1044e-03_r8,1.0138e-03_r8,8.8821e-04_r8, & + &7.1753e-04_r8,4.9169e-04_r8,9.8233e-05_r8/) + kao(:, 5, 4, 4) = (/ & + &1.2975e-03_r8,1.4918e-03_r8,1.4869e-03_r8,1.4114e-03_r8,1.2930e-03_r8,1.1277e-03_r8, & + &9.0840e-04_r8,6.3197e-04_r8,1.3450e-04_r8/) + kao(:, 1, 5, 4) = (/ & + &4.6076e-04_r8,5.0474e-04_r8,5.1144e-04_r8,4.9140e-04_r8,4.5232e-04_r8,3.9779e-04_r8, & + &3.2321e-04_r8,2.2336e-04_r8,3.4201e-05_r8/) + kao(:, 2, 5, 4) = (/ & + &7.0989e-04_r8,7.6999e-04_r8,7.6963e-04_r8,7.2952e-04_r8,6.6336e-04_r8,5.7413e-04_r8, & + &4.5930e-04_r8,3.0843e-04_r8,4.2292e-05_r8/) + kao(:, 3, 5, 4) = (/ & + &1.0386e-03_r8,1.1133e-03_r8,1.0985e-03_r8,1.0276e-03_r8,9.2270e-04_r8,7.9078e-04_r8, & + &6.2825e-04_r8,4.1898e-04_r8,5.3586e-05_r8/) + kao(:, 4, 5, 4) = (/ & + &1.4541e-03_r8,1.5404e-03_r8,1.4988e-03_r8,1.3877e-03_r8,1.2375e-03_r8,1.0544e-03_r8, & + &8.3469e-04_r8,5.5179e-04_r8,6.8395e-05_r8/) + kao(:, 5, 5, 4) = (/ & + &1.9528e-03_r8,2.0463e-03_r8,1.9719e-03_r8,1.8145e-03_r8,1.6102e-03_r8,1.3677e-03_r8, & + &1.0776e-03_r8,7.0877e-04_r8,9.0444e-05_r8/) + kao(:, 1, 6, 4) = (/ & + &5.6492e-04_r8,5.7565e-04_r8,5.5931e-04_r8,5.2434e-04_r8,4.7320e-04_r8,4.0777e-04_r8, & + &3.2512e-04_r8,2.1641e-04_r8,2.6966e-05_r8/) + kao(:, 2, 6, 4) = (/ & + &9.0441e-04_r8,9.1447e-04_r8,8.8349e-04_r8,8.2170e-04_r8,7.3208e-04_r8,6.2190e-04_r8, & + &4.8768e-04_r8,3.1817e-04_r8,3.4982e-05_r8/) + kao(:, 3, 6, 4) = (/ & + &1.3664e-03_r8,1.3688e-03_r8,1.3074e-03_r8,1.2015e-03_r8,1.0584e-03_r8,8.8601e-04_r8, & + &6.8532e-04_r8,4.4190e-04_r8,4.5831e-05_r8/) + kao(:, 4, 6, 4) = (/ & + &1.9708e-03_r8,1.9570e-03_r8,1.8529e-03_r8,1.6859e-03_r8,1.4692e-03_r8,1.2199e-03_r8, & + &9.3583e-04_r8,6.0020e-04_r8,5.8072e-05_r8/) + kao(:, 5, 6, 4) = (/ & + &2.7158e-03_r8,2.6789e-03_r8,2.5132e-03_r8,2.2684e-03_r8,1.9663e-03_r8,1.6232e-03_r8, & + &1.2393e-03_r8,7.8815e-04_r8,7.1453e-05_r8/) + kao(:, 1, 7, 4) = (/ & + &7.1612e-04_r8,6.9080e-04_r8,6.4557e-04_r8,5.8741e-04_r8,5.1690e-04_r8,4.3484e-04_r8, & + &3.3811e-04_r8,2.1958e-04_r8,2.5385e-05_r8/) + kao(:, 2, 7, 4) = (/ & + &1.1940e-03_r8,1.1449e-03_r8,1.0668e-03_r8,9.6669e-04_r8,8.4588e-04_r8,7.0528e-04_r8, & + &5.3962e-04_r8,3.4196e-04_r8,3.2650e-05_r8/) + kao(:, 3, 7, 4) = (/ & + &1.8743e-03_r8,1.7868e-03_r8,1.6562e-03_r8,1.4906e-03_r8,1.2906e-03_r8,1.0612e-03_r8, & + &7.9912e-04_r8,4.9523e-04_r8,4.3298e-05_r8/) + kao(:, 4, 7, 4) = (/ & + &2.7760e-03_r8,2.6274e-03_r8,2.4197e-03_r8,2.1609e-03_r8,1.8570e-03_r8,1.5098e-03_r8, & + &1.1229e-03_r8,6.8654e-04_r8,5.4268e-05_r8/) + kao(:, 5, 7, 4) = (/ & + &3.9210e-03_r8,3.6980e-03_r8,3.3854e-03_r8,3.0037e-03_r8,2.5627e-03_r8,2.0710e-03_r8, & + &1.5295e-03_r8,9.2840e-04_r8,6.7940e-05_r8/) + kao(:, 1, 8, 4) = (/ & + &1.0670e-03_r8,9.8692e-04_r8,8.9134e-04_r8,7.8593e-04_r8,6.7073e-04_r8,5.4467e-04_r8, & + &4.0756e-04_r8,2.5210e-04_r8,2.8359e-05_r8/) + kao(:, 2, 8, 4) = (/ & + &1.8582e-03_r8,1.7102e-03_r8,1.5414e-03_r8,1.3557e-03_r8,1.1545e-03_r8,9.3501e-04_r8, & + &6.9502e-04_r8,4.2320e-04_r8,3.7233e-05_r8/) + kao(:, 3, 8, 4) = (/ & + &3.0392e-03_r8,2.7815e-03_r8,2.4987e-03_r8,2.1910e-03_r8,1.8592e-03_r8,1.4974e-03_r8, & + &1.1016e-03_r8,6.5354e-04_r8,4.6926e-05_r8/) + kao(:, 4, 8, 4) = (/ & + &4.6351e-03_r8,4.2251e-03_r8,3.7893e-03_r8,3.3101e-03_r8,2.7928e-03_r8,2.2311e-03_r8, & + &1.6189e-03_r8,9.4084e-04_r8,6.1285e-05_r8/) + kao(:, 5, 8, 4) = (/ & + &6.7053e-03_r8,6.1011e-03_r8,5.4490e-03_r8,4.7367e-03_r8,3.9743e-03_r8,3.1531e-03_r8, & + &2.2726e-03_r8,1.3072e-03_r8,7.4486e-05_r8/) + kao(:, 1, 9, 4) = (/ & + &3.0079e-03_r8,2.6671e-03_r8,2.3362e-03_r8,1.9921e-03_r8,1.6375e-03_r8,1.2739e-03_r8, & + &8.9947e-04_r8,5.0478e-04_r8,4.8310e-05_r8/) + kao(:, 2, 9, 4) = (/ & + &5.3604e-03_r8,4.7462e-03_r8,4.1492e-03_r8,3.5341e-03_r8,2.9054e-03_r8,2.2583e-03_r8, & + &1.5943e-03_r8,8.9078e-04_r8,6.1843e-05_r8/) + kao(:, 3, 9, 4) = (/ & + &9.0324e-03_r8,7.9882e-03_r8,6.9714e-03_r8,5.9320e-03_r8,4.8700e-03_r8,3.7864e-03_r8, & + &2.6693e-03_r8,1.4872e-03_r8,8.4369e-05_r8/) + kao(:, 4, 9, 4) = (/ & + &1.4329e-02_r8,1.2658e-02_r8,1.1032e-02_r8,9.3748e-03_r8,7.6880e-03_r8,5.9624e-03_r8, & + &4.1846e-03_r8,2.3075e-03_r8,1.0247e-04_r8/) + kao(:, 5, 9, 4) = (/ & + &2.1261e-02_r8,1.8755e-02_r8,1.6325e-02_r8,1.3858e-02_r8,1.1339e-02_r8,8.7669e-03_r8, & + &6.1142e-03_r8,3.3320e-03_r8,1.2163e-04_r8/) + kao(:, 1,10, 4) = (/ & + &1.0911e-02_r8,9.5635e-03_r8,8.2330e-03_r8,6.9092e-03_r8,5.5802e-03_r8,4.2396e-03_r8, & + &2.8819e-03_r8,1.5069e-03_r8,1.0164e-04_r8/) + kao(:, 2,10, 4) = (/ & + &1.8579e-02_r8,1.6289e-02_r8,1.4021e-02_r8,1.1757e-02_r8,9.4958e-03_r8,7.2115e-03_r8, & + &4.9034e-03_r8,2.5692e-03_r8,1.2765e-04_r8/) + kao(:, 3,10, 4) = (/ & + &3.1018e-02_r8,2.7193e-02_r8,2.3385e-02_r8,1.9601e-02_r8,1.5823e-02_r8,1.2032e-02_r8, & + &8.1956e-03_r8,4.3045e-03_r8,1.7856e-04_r8/) + kao(:, 4,10, 4) = (/ & + &5.0111e-02_r8,4.3919e-02_r8,3.7756e-02_r8,3.1628e-02_r8,2.5516e-02_r8,1.9374e-02_r8, & + &1.3194e-02_r8,6.9219e-03_r8,2.2724e-04_r8/) + kao(:, 5,10, 4) = (/ & + &7.6376e-02_r8,6.6924e-02_r8,5.7507e-02_r8,4.8151e-02_r8,3.8816e-02_r8,2.9439e-02_r8, & + &2.0003e-02_r8,1.0433e-02_r8,2.6085e-04_r8/) + kao(:, 1,11, 4) = (/ & + &1.8971e-02_r8,1.6611e-02_r8,1.4262e-02_r8,1.1923e-02_r8,9.5992e-03_r8,7.2680e-03_r8, & + &4.9113e-03_r8,2.5257e-03_r8,1.6715e-04_r8/) + kao(:, 2,11, 4) = (/ & + &3.0950e-02_r8,2.7103e-02_r8,2.3271e-02_r8,1.9463e-02_r8,1.5664e-02_r8,1.1847e-02_r8, & + &7.9981e-03_r8,4.1199e-03_r8,2.1489e-04_r8/) + kao(:, 3,11, 4) = (/ & + &4.9685e-02_r8,4.3517e-02_r8,3.7369e-02_r8,3.1256e-02_r8,2.5144e-02_r8,1.9021e-02_r8, & + &1.2853e-02_r8,6.6396e-03_r8,2.5990e-04_r8/) + kao(:, 4,11, 4) = (/ & + &7.7374e-02_r8,6.7750e-02_r8,5.8163e-02_r8,4.8608e-02_r8,3.9067e-02_r8,2.9542e-02_r8, & + &1.9962e-02_r8,1.0311e-02_r8,3.2116e-04_r8/) + kao(:, 5,11, 4) = (/ & + &1.1501e-01_r8,1.0072e-01_r8,8.6431e-02_r8,7.2217e-02_r8,5.8056e-02_r8,4.3898e-02_r8, & + &2.9647e-02_r8,1.5264e-02_r8,3.7485e-04_r8/) + kao(:, 1,12, 4) = (/ & + &2.3401e-02_r8,2.0486e-02_r8,1.7582e-02_r8,1.4686e-02_r8,1.1806e-02_r8,8.9258e-03_r8, & + &6.0297e-03_r8,3.0936e-03_r8,1.8693e-04_r8/) + kao(:, 2,12, 4) = (/ & + &3.8133e-02_r8,3.3387e-02_r8,2.8657e-02_r8,2.3944e-02_r8,1.9250e-02_r8,1.4544e-02_r8, & + &9.8021e-03_r8,5.0235e-03_r8,2.4530e-04_r8/) + kao(:, 3,12, 4) = (/ & + &6.0110e-02_r8,5.2620e-02_r8,4.5149e-02_r8,3.7710e-02_r8,3.0268e-02_r8,2.2852e-02_r8, & + &1.5390e-02_r8,7.8945e-03_r8,2.8864e-04_r8/) + kao(:, 4,12, 4) = (/ & + &9.0890e-02_r8,7.9571e-02_r8,6.8303e-02_r8,5.7049e-02_r8,4.5842e-02_r8,3.4594e-02_r8, & + &2.3289e-02_r8,1.1923e-02_r8,3.6228e-04_r8/) + kao(:, 5,12, 4) = (/ & + &1.3100e-01_r8,1.1462e-01_r8,9.8322e-02_r8,8.2088e-02_r8,6.5959e-02_r8,4.9780e-02_r8, & + &3.3534e-02_r8,1.7184e-02_r8,4.3158e-04_r8/) + kao(:, 1,13, 4) = (/ & + &2.4303e-02_r8,2.1262e-02_r8,1.8230e-02_r8,1.5211e-02_r8,1.2213e-02_r8,9.2155e-03_r8, & + &6.2046e-03_r8,3.1714e-03_r8,1.9233e-04_r8/) + kao(:, 2,13, 4) = (/ & + &3.8296e-02_r8,3.3521e-02_r8,2.8762e-02_r8,2.4031e-02_r8,1.9310e-02_r8,1.4568e-02_r8, & + &9.8072e-03_r8,5.0047e-03_r8,2.4842e-04_r8/) + kao(:, 3,13, 4) = (/ & + &5.8379e-02_r8,5.1065e-02_r8,4.3832e-02_r8,3.6631e-02_r8,2.9434e-02_r8,2.2205e-02_r8, & + &1.4940e-02_r8,7.6384e-03_r8,2.8734e-04_r8/) + kao(:, 4,13, 4) = (/ & + &8.5558e-02_r8,7.4841e-02_r8,6.4227e-02_r8,5.3638e-02_r8,4.3082e-02_r8,3.2499e-02_r8, & + &2.1863e-02_r8,1.1189e-02_r8,3.6167e-04_r8/) + kao(:, 5,13, 4) = (/ & + &1.2105e-01_r8,1.0601e-01_r8,9.0943e-02_r8,7.5945e-02_r8,6.0995e-02_r8,4.5990e-02_r8, & + &3.0953e-02_r8,1.5858e-02_r8,4.3014e-04_r8/) + kao(:, 1, 1, 5) = (/ & + &5.2897e-04_r8,6.3863e-04_r8,6.7716e-04_r8,6.8592e-04_r8,6.6781e-04_r8,6.0937e-04_r8, & + &5.2069e-04_r8,5.5022e-04_r8,1.8160e-04_r8/) + kao(:, 2, 1, 5) = (/ & + &6.5371e-04_r8,8.0837e-04_r8,8.6369e-04_r8,8.8295e-04_r8,8.7230e-04_r8,8.3067e-04_r8, & + &7.4453e-04_r8,6.6477e-04_r8,2.9044e-04_r8/) + kao(:, 3, 1, 5) = (/ & + &7.9309e-04_r8,1.0041e-03_r8,1.0806e-03_r8,1.1131e-03_r8,1.1135e-03_r8,1.0810e-03_r8, & + &1.0060e-03_r8,8.6363e-04_r8,4.3507e-04_r8/) + kao(:, 4, 1, 5) = (/ & + &9.5515e-04_r8,1.2330e-03_r8,1.3320e-03_r8,1.3798e-03_r8,1.3866e-03_r8,1.3599e-03_r8, & + &1.2978e-03_r8,1.1703e-03_r8,5.4823e-04_r8/) + kao(:, 5, 1, 5) = (/ & + &1.1370e-03_r8,1.4922e-03_r8,1.6168e-03_r8,1.6809e-03_r8,1.6969e-03_r8,1.6741e-03_r8, & + &1.6142e-03_r8,1.5306e-03_r8,7.1233e-04_r8/) + kao(:, 1, 2, 5) = (/ & + &6.4530e-04_r8,7.2673e-04_r8,7.3348e-04_r8,7.1463e-04_r8,6.7564e-04_r8,6.1110e-04_r8, & + &5.0123e-04_r8,4.4222e-04_r8,1.3962e-04_r8/) + kao(:, 2, 2, 5) = (/ & + &8.0957e-04_r8,9.2607e-04_r8,9.4414e-04_r8,9.2480e-04_r8,8.8433e-04_r8,8.1497e-04_r8, & + &7.0697e-04_r8,5.2414e-04_r8,2.1889e-04_r8/) + kao(:, 3, 2, 5) = (/ & + &9.9558e-04_r8,1.1596e-03_r8,1.1892e-03_r8,1.1731e-03_r8,1.1295e-03_r8,1.0550e-03_r8, & + &9.3776e-04_r8,7.6366e-04_r8,3.1779e-04_r8/) + kao(:, 4, 2, 5) = (/ & + &1.2093e-03_r8,1.4336e-03_r8,1.4751e-03_r8,1.4631e-03_r8,1.4149e-03_r8,1.3281e-03_r8, & + &1.2039e-03_r8,1.0264e-03_r8,4.0743e-04_r8/) + kao(:, 5, 2, 5) = (/ & + &1.4548e-03_r8,1.7501e-03_r8,1.8041e-03_r8,1.7977e-03_r8,1.7416e-03_r8,1.6424e-03_r8, & + &1.5037e-03_r8,1.3244e-03_r8,5.3155e-04_r8/) + kao(:, 1, 3, 5) = (/ & + &1.0073e-03_r8,1.0305e-03_r8,9.9170e-04_r8,9.1685e-04_r8,8.2334e-04_r8,7.1279e-04_r8, & + &5.7365e-04_r8,3.9412e-04_r8,1.0025e-04_r8/) + kao(:, 2, 3, 5) = (/ & + &1.2880e-03_r8,1.3316e-03_r8,1.2867e-03_r8,1.1967e-03_r8,1.0809e-03_r8,9.4443e-04_r8, & + &7.8179e-04_r8,5.3700e-04_r8,1.5384e-04_r8/) + kao(:, 3, 3, 5) = (/ & + &1.6107e-03_r8,1.6903e-03_r8,1.6390e-03_r8,1.5300e-03_r8,1.3886e-03_r8,1.2242e-03_r8, & + &1.0235e-03_r8,7.5425e-04_r8,2.1640e-04_r8/) + kao(:, 4, 3, 5) = (/ & + &1.9797e-03_r8,2.1107e-03_r8,2.0529e-03_r8,1.9209e-03_r8,1.7527e-03_r8,1.5541e-03_r8, & + &1.3094e-03_r8,9.9288e-04_r8,2.8803e-04_r8/) + kao(:, 5, 3, 5) = (/ & + &2.4113e-03_r8,2.6021e-03_r8,2.5366e-03_r8,2.3815e-03_r8,2.1822e-03_r8,1.9385e-03_r8, & + &1.6375e-03_r8,1.2689e-03_r8,3.7641e-04_r8/) + kao(:, 1, 4, 5) = (/ & + &1.5851e-03_r8,1.5181e-03_r8,1.4032e-03_r8,1.2606e-03_r8,1.0883e-03_r8,8.9739e-04_r8, & + &6.8560e-04_r8,4.2854e-04_r8,6.6391e-05_r8/) + kao(:, 2, 4, 5) = (/ & + &2.0501e-03_r8,1.9754e-03_r8,1.8387e-03_r8,1.6565e-03_r8,1.4386e-03_r8,1.1914e-03_r8, & + &9.2359e-04_r8,6.1319e-04_r8,1.0381e-04_r8/) + kao(:, 3, 4, 5) = (/ & + &2.6137e-03_r8,2.5384e-03_r8,2.3763e-03_r8,2.1489e-03_r8,1.8706e-03_r8,1.5557e-03_r8, & + &1.2160e-03_r8,8.2392e-04_r8,1.4611e-04_r8/) + kao(:, 4, 4, 5) = (/ & + &3.2665e-03_r8,3.2074e-03_r8,3.0134e-03_r8,2.7316e-03_r8,2.3866e-03_r8,1.9939e-03_r8, & + &1.5682e-03_r8,1.0781e-03_r8,1.9821e-04_r8/) + kao(:, 5, 4, 5) = (/ & + &4.0137e-03_r8,3.9873e-03_r8,3.7629e-03_r8,3.4158e-03_r8,2.9921e-03_r8,2.5128e-03_r8, & + &1.9870e-03_r8,1.3733e-03_r8,2.6370e-04_r8/) + kao(:, 1, 5, 5) = (/ & + &2.2692e-03_r8,2.1006e-03_r8,1.8869e-03_r8,1.6579e-03_r8,1.4070e-03_r8,1.1280e-03_r8, & + &8.2786e-04_r8,4.9332e-04_r8,4.7300e-05_r8/) + kao(:, 2, 5, 5) = (/ & + &2.9951e-03_r8,2.7795e-03_r8,2.5097e-03_r8,2.2151e-03_r8,1.8839e-03_r8,1.5178e-03_r8, & + &1.1209e-03_r8,6.8743e-04_r8,6.4441e-05_r8/) + kao(:, 3, 5, 5) = (/ & + &3.8783e-03_r8,3.6150e-03_r8,3.2821e-03_r8,2.9041e-03_r8,2.4789e-03_r8,2.0050e-03_r8, & + &1.4894e-03_r8,9.2698e-04_r8,9.4008e-05_r8/) + kao(:, 4, 5, 5) = (/ & + &4.9258e-03_r8,4.6186e-03_r8,4.2220e-03_r8,3.7446e-03_r8,3.2015e-03_r8,2.5968e-03_r8, & + &1.9395e-03_r8,1.2217e-03_r8,1.3185e-04_r8/) + kao(:, 5, 5, 5) = (/ & + &6.1149e-03_r8,5.7761e-03_r8,5.3147e-03_r8,4.7312e-03_r8,4.0567e-03_r8,3.3012e-03_r8, & + &2.4775e-03_r8,1.5747e-03_r8,1.8186e-04_r8/) + kao(:, 1, 6, 5) = (/ & + &2.9777e-03_r8,2.7020e-03_r8,2.3926e-03_r8,2.0653e-03_r8,1.7240e-03_r8,1.3628e-03_r8, & + &9.7585e-04_r8,5.5769e-04_r8,3.7018e-05_r8/) + kao(:, 2, 6, 5) = (/ & + &4.0405e-03_r8,3.6698e-03_r8,3.2527e-03_r8,2.8150e-03_r8,2.3582e-03_r8,1.8689e-03_r8, & + &1.3459e-03_r8,7.7825e-04_r8,5.0931e-05_r8/) + kao(:, 3, 6, 5) = (/ & + &5.2985e-03_r8,4.8259e-03_r8,4.2980e-03_r8,3.7351e-03_r8,3.1354e-03_r8,2.4956e-03_r8, & + &1.8046e-03_r8,1.0570e-03_r8,6.8165e-05_r8/) + kao(:, 4, 6, 5) = (/ & + &6.8330e-03_r8,6.2458e-03_r8,5.5922e-03_r8,4.8800e-03_r8,4.1117e-03_r8,3.2799e-03_r8, & + &2.3798e-03_r8,1.4059e-03_r8,8.9401e-05_r8/) + kao(:, 5, 6, 5) = (/ & + &8.6003e-03_r8,7.8905e-03_r8,7.1103e-03_r8,6.2229e-03_r8,5.2575e-03_r8,4.2076e-03_r8, & + &3.0687e-03_r8,1.8306e-03_r8,1.2028e-04_r8/) + kao(:, 1, 7, 5) = (/ & + &4.0427e-03_r8,3.6171e-03_r8,3.1732e-03_r8,2.7085e-03_r8,2.2305e-03_r8,1.7374e-03_r8, & + &1.2245e-03_r8,6.7631e-04_r8,3.7016e-05_r8/) + kao(:, 2, 7, 5) = (/ & + &5.6556e-03_r8,5.0622e-03_r8,4.4391e-03_r8,3.7915e-03_r8,3.1262e-03_r8,2.4381e-03_r8, & + &1.7215e-03_r8,9.5894e-04_r8,4.8862e-05_r8/) + kao(:, 3, 7, 5) = (/ & + &7.5823e-03_r8,6.7945e-03_r8,5.9706e-03_r8,5.1108e-03_r8,4.2263e-03_r8,3.3055e-03_r8, & + &2.3437e-03_r8,1.3169e-03_r8,6.1466e-05_r8/) + kao(:, 4, 7, 5) = (/ & + &9.8701e-03_r8,8.8589e-03_r8,7.8113e-03_r8,6.7131e-03_r8,5.5681e-03_r8,4.3736e-03_r8, & + &3.1150e-03_r8,1.7640e-03_r8,7.9784e-05_r8/) + kao(:, 5, 7, 5) = (/ & + &1.2627e-02_r8,1.1349e-02_r8,1.0044e-02_r8,8.6633e-03_r8,7.2033e-03_r8,5.6735e-03_r8, & + &4.0519e-03_r8,2.3093e-03_r8,9.9338e-05_r8/) + kao(:, 1, 8, 5) = (/ & + &6.5162e-03_r8,5.7610e-03_r8,5.0100e-03_r8,4.2382e-03_r8,3.4497e-03_r8,2.6520e-03_r8, & + &1.8357e-03_r8,9.8841e-04_r8,5.0893e-05_r8/) + kao(:, 2, 8, 5) = (/ & + &9.3894e-03_r8,8.3047e-03_r8,7.2233e-03_r8,6.1097e-03_r8,4.9767e-03_r8,3.8267e-03_r8, & + &2.6500e-03_r8,1.4278e-03_r8,6.6360e-05_r8/) + kao(:, 3, 8, 5) = (/ & + &1.2886e-02_r8,1.1402e-02_r8,9.9227e-03_r8,8.3986e-03_r8,6.8476e-03_r8,5.2715e-03_r8, & + &3.6563e-03_r8,1.9797e-03_r8,8.1964e-05_r8/) + kao(:, 4, 8, 5) = (/ & + &1.7029e-02_r8,1.5075e-02_r8,1.3132e-02_r8,1.1136e-02_r8,9.1030e-03_r8,7.0269e-03_r8, & + &4.8948e-03_r8,2.6694e-03_r8,1.0083e-04_r8/) + kao(:, 5, 8, 5) = (/ & + &2.2131e-02_r8,1.9595e-02_r8,1.7101e-02_r8,1.4537e-02_r8,1.1918e-02_r8,9.2249e-03_r8, & + &6.4389e-03_r8,3.5237e-03_r8,1.2644e-04_r8/) + kao(:, 1, 9, 5) = (/ & + &1.9574e-02_r8,1.7171e-02_r8,1.4767e-02_r8,1.2373e-02_r8,9.9784e-03_r8,7.5698e-03_r8, & + &5.1323e-03_r8,2.6624e-03_r8,7.9787e-05_r8/) + kao(:, 2, 9, 5) = (/ & + &2.9063e-02_r8,2.5494e-02_r8,2.1931e-02_r8,1.8384e-02_r8,1.4827e-02_r8,1.1241e-02_r8, & + &7.6171e-03_r8,3.9520e-03_r8,1.0489e-04_r8/) + kao(:, 3, 9, 5) = (/ & + &4.0973e-02_r8,3.5943e-02_r8,3.0923e-02_r8,2.5930e-02_r8,2.0911e-02_r8,1.5846e-02_r8, & + &1.0739e-02_r8,5.5789e-03_r8,1.2330e-04_r8/) + kao(:, 4, 9, 5) = (/ & + &5.5333e-02_r8,4.8546e-02_r8,4.1776e-02_r8,3.5034e-02_r8,2.8259e-02_r8,2.1435e-02_r8, & + &1.4550e-02_r8,7.5751e-03_r8,1.5097e-04_r8/) + kao(:, 5, 9, 5) = (/ & + &7.2795e-02_r8,6.3880e-02_r8,5.4976e-02_r8,4.6114e-02_r8,3.7235e-02_r8,2.8276e-02_r8, & + &1.9247e-02_r8,1.0060e-02_r8,1.9444e-04_r8/) + kao(:, 1,10, 5) = (/ & + &6.7876e-02_r8,5.9426e-02_r8,5.0975e-02_r8,4.2524e-02_r8,3.4085e-02_r8,2.5643e-02_r8, & + &1.7219e-02_r8,8.7441e-03_r8,2.1379e-04_r8/) + kao(:, 2,10, 5) = (/ & + &1.0363e-01_r8,9.0726e-02_r8,7.7824e-02_r8,6.4925e-02_r8,5.2032e-02_r8,3.9153e-02_r8, & + &2.6288e-02_r8,1.3336e-02_r8,2.7530e-04_r8/) + kao(:, 3,10, 5) = (/ & + &1.4868e-01_r8,1.3017e-01_r8,1.1167e-01_r8,9.3161e-02_r8,7.4667e-02_r8,5.6180e-02_r8, & + &3.7706e-02_r8,1.9125e-02_r8,3.1198e-04_r8/) + kao(:, 4,10, 5) = (/ & + &2.0441e-01_r8,1.7897e-01_r8,1.5353e-01_r8,1.2809e-01_r8,1.0267e-01_r8,7.7285e-02_r8, & + &5.1877e-02_r8,2.6327e-02_r8,3.7361e-04_r8/) + kao(:, 5,10, 5) = (/ & + &2.7248e-01_r8,2.3857e-01_r8,2.0467e-01_r8,1.7078e-01_r8,1.3689e-01_r8,1.0307e-01_r8, & + &6.9236e-02_r8,3.5215e-02_r8,4.4890e-04_r8/) + kao(:, 1,11, 5) = (/ & + &1.0259e-01_r8,8.9796e-02_r8,7.7004e-02_r8,6.4217e-02_r8,5.1425e-02_r8,3.8649e-02_r8, & + &2.5882e-02_r8,1.3106e-02_r8,2.9325e-04_r8/) + kao(:, 2,11, 5) = (/ & + &1.5400e-01_r8,1.3480e-01_r8,1.1559e-01_r8,9.6403e-02_r8,7.7200e-02_r8,5.8036e-02_r8, & + &3.8878e-02_r8,1.9667e-02_r8,3.5327e-04_r8/) + kao(:, 3,11, 5) = (/ & + &2.2118e-01_r8,1.9361e-01_r8,1.6603e-01_r8,1.3846e-01_r8,1.1090e-01_r8,8.3368e-02_r8, & + &5.5861e-02_r8,2.8242e-02_r8,4.6202e-04_r8/) + kao(:, 4,11, 5) = (/ & + &3.0353e-01_r8,2.6571e-01_r8,2.2790e-01_r8,1.9008e-01_r8,1.5227e-01_r8,1.1447e-01_r8, & + &7.6708e-02_r8,3.8764e-02_r8,5.6335e-04_r8/) + kao(:, 5,11, 5) = (/ & + &4.0552e-01_r8,3.5495e-01_r8,3.0446e-01_r8,2.5391e-01_r8,2.0338e-01_r8,1.5287e-01_r8, & + &1.0246e-01_r8,5.1876e-02_r8,6.9233e-04_r8/) + kao(:, 1,12, 5) = (/ & + &1.1805e-01_r8,1.0334e-01_r8,8.8617e-02_r8,7.3889e-02_r8,5.9170e-02_r8,4.4431e-02_r8, & + &2.9722e-02_r8,1.5007e-02_r8,3.3712e-04_r8/) + kao(:, 2,12, 5) = (/ & + &1.7261e-01_r8,1.5108e-01_r8,1.2954e-01_r8,1.0804e-01_r8,8.6508e-02_r8,6.5013e-02_r8, & + &4.3529e-02_r8,2.1984e-02_r8,3.8771e-04_r8/) + kao(:, 3,12, 5) = (/ & + &2.4519e-01_r8,2.1462e-01_r8,1.8406e-01_r8,1.5350e-01_r8,1.2297e-01_r8,9.2422e-02_r8, & + &6.1905e-02_r8,3.1241e-02_r8,5.1427e-04_r8/) + kao(:, 4,12, 5) = (/ & + &3.3550e-01_r8,2.9369e-01_r8,2.5183e-01_r8,2.1003e-01_r8,1.6821e-01_r8,1.2645e-01_r8, & + &8.4714e-02_r8,4.2803e-02_r8,6.2818e-04_r8/) + kao(:, 5,12, 5) = (/ & + &4.4900e-01_r8,3.9309e-01_r8,3.3714e-01_r8,2.8120e-01_r8,2.2522e-01_r8,1.6927e-01_r8, & + &1.1341e-01_r8,5.7326e-02_r8,7.6692e-04_r8/) + kao(:, 1,13, 5) = (/ & + &1.0921e-01_r8,9.5613e-02_r8,8.2016e-02_r8,6.8423e-02_r8,5.4814e-02_r8,4.1207e-02_r8, & + &2.7589e-02_r8,1.3915e-02_r8,3.0996e-04_r8/) + kao(:, 2,13, 5) = (/ & + &1.5908e-01_r8,1.3927e-01_r8,1.1945e-01_r8,9.9633e-02_r8,7.9786e-02_r8,5.9973e-02_r8, & + &4.0176e-02_r8,2.0276e-02_r8,3.7414e-04_r8/) + kao(:, 3,13, 5) = (/ & + &2.2086e-01_r8,1.9339e-01_r8,1.6582e-01_r8,1.3829e-01_r8,1.1077e-01_r8,8.3306e-02_r8, & + &5.5823e-02_r8,2.8176e-02_r8,4.9992e-04_r8/) + kao(:, 4,13, 5) = (/ & + &3.0195e-01_r8,2.6439e-01_r8,2.2676e-01_r8,1.8917e-01_r8,1.5156e-01_r8,1.1401e-01_r8, & + &7.6395e-02_r8,3.8587e-02_r8,6.2293e-04_r8/) + kao(:, 5,13, 5) = (/ & + &4.0305e-01_r8,3.5276e-01_r8,3.0259e-01_r8,2.5241e-01_r8,2.0221e-01_r8,1.5209e-01_r8, & + &1.0190e-01_r8,5.1477e-02_r8,7.6835e-04_r8/) + kao(:, 1, 1, 6) = (/ & + &1.3028e-03_r8,1.4792e-03_r8,1.5640e-03_r8,1.5783e-03_r8,1.5338e-03_r8,1.4263e-03_r8, & + &1.2426e-03_r8,1.0270e-03_r8,3.8769e-04_r8/) + kao(:, 2, 1, 6) = (/ & + &1.5941e-03_r8,1.8539e-03_r8,1.9924e-03_r8,2.0205e-03_r8,1.9782e-03_r8,1.8703e-03_r8, & + &1.6672e-03_r8,1.3063e-03_r8,5.8906e-04_r8/) + kao(:, 3, 1, 6) = (/ & + &1.9170e-03_r8,2.2892e-03_r8,2.4874e-03_r8,2.5352e-03_r8,2.4910e-03_r8,2.3785e-03_r8, & + &2.1678e-03_r8,1.7982e-03_r8,8.4228e-04_r8/) + kao(:, 4, 1, 6) = (/ & + &2.2745e-03_r8,2.7857e-03_r8,3.0496e-03_r8,3.1195e-03_r8,3.0784e-03_r8,2.9487e-03_r8, & + &2.7123e-03_r8,2.3729e-03_r8,1.1599e-03_r8/) + kao(:, 5, 1, 6) = (/ & + &2.6664e-03_r8,3.3396e-03_r8,3.6796e-03_r8,3.7742e-03_r8,3.7339e-03_r8,3.5735e-03_r8, & + &3.3124e-03_r8,2.9540e-03_r8,1.5049e-03_r8/) + kao(:, 1, 2, 6) = (/ & + &1.6105e-03_r8,1.7112e-03_r8,1.7440e-03_r8,1.7104e-03_r8,1.6159e-03_r8,1.4650e-03_r8, & + &1.2347e-03_r8,8.8371e-04_r8,2.8335e-04_r8/) + kao(:, 2, 2, 6) = (/ & + &1.9953e-03_r8,2.1575e-03_r8,2.2293e-03_r8,2.1981e-03_r8,2.0893e-03_r8,1.9131e-03_r8, & + &1.6649e-03_r8,1.2817e-03_r8,4.3740e-04_r8/) + kao(:, 3, 2, 6) = (/ & + &2.4284e-03_r8,2.6728e-03_r8,2.7960e-03_r8,2.7642e-03_r8,2.6394e-03_r8,2.4361e-03_r8, & + &2.1522e-03_r8,1.6930e-03_r8,6.3499e-04_r8/) + kao(:, 4, 2, 6) = (/ & + &2.9107e-03_r8,3.2657e-03_r8,3.4379e-03_r8,3.4084e-03_r8,3.2638e-03_r8,3.0336e-03_r8, & + &2.6919e-03_r8,2.1920e-03_r8,8.6677e-04_r8/) + kao(:, 5, 2, 6) = (/ & + &3.4457e-03_r8,3.9315e-03_r8,4.1602e-03_r8,4.1311e-03_r8,3.9674e-03_r8,3.6982e-03_r8, & + &3.2905e-03_r8,2.7416e-03_r8,1.1277e-03_r8/) + kao(:, 1, 3, 6) = (/ & + &2.5362e-03_r8,2.4734e-03_r8,2.3740e-03_r8,2.2299e-03_r8,2.0298e-03_r8,1.7661e-03_r8, & + &1.4316e-03_r8,9.7765e-04_r8,1.9718e-04_r8/) + kao(:, 2, 3, 6) = (/ & + &3.1979e-03_r8,3.1448e-03_r8,3.0502e-03_r8,2.8893e-03_r8,2.6412e-03_r8,2.3120e-03_r8, & + &1.8934e-03_r8,1.3566e-03_r8,3.0943e-04_r8/) + kao(:, 3, 3, 6) = (/ & + &3.9564e-03_r8,3.9245e-03_r8,3.8464e-03_r8,3.6625e-03_r8,3.3542e-03_r8,2.9452e-03_r8, & + &2.4362e-03_r8,1.8025e-03_r8,4.5105e-04_r8/) + kao(:, 4, 3, 6) = (/ & + &4.8099e-03_r8,4.8142e-03_r8,4.7669e-03_r8,4.5499e-03_r8,4.1705e-03_r8,3.6723e-03_r8, & + &3.0586e-03_r8,2.2944e-03_r8,6.1219e-04_r8/) + kao(:, 5, 3, 6) = (/ & + &5.7692e-03_r8,5.8286e-03_r8,5.8075e-03_r8,5.5468e-03_r8,5.0930e-03_r8,4.4966e-03_r8, & + &3.7644e-03_r8,2.8408e-03_r8,8.0331e-04_r8/) + kao(:, 1, 4, 6) = (/ & + &3.9832e-03_r8,3.6741e-03_r8,3.3865e-03_r8,3.0403e-03_r8,2.6684e-03_r8,2.2429e-03_r8, & + &1.7419e-03_r8,1.1291e-03_r8,1.3015e-04_r8/) + kao(:, 2, 4, 6) = (/ & + &5.1171e-03_r8,4.7408e-03_r8,4.3919e-03_r8,3.9718e-03_r8,3.5069e-03_r8,2.9654e-03_r8, & + &2.3168e-03_r8,1.5306e-03_r8,2.0974e-04_r8/) + kao(:, 3, 4, 6) = (/ & + &6.4449e-03_r8,5.9980e-03_r8,5.5858e-03_r8,5.0842e-03_r8,4.5074e-03_r8,3.8196e-03_r8, & + &2.9911e-03_r8,2.0056e-03_r8,3.1006e-04_r8/) + kao(:, 4, 4, 6) = (/ & + &7.9648e-03_r8,7.4434e-03_r8,6.9731e-03_r8,6.3878e-03_r8,5.6676e-03_r8,4.8062e-03_r8, & + &3.7737e-03_r8,2.5549e-03_r8,4.2568e-04_r8/) + kao(:, 5, 4, 6) = (/ & + &9.7092e-03_r8,9.1026e-03_r8,8.5703e-03_r8,7.8734e-03_r8,6.9867e-03_r8,5.9261e-03_r8, & + &4.6651e-03_r8,3.1844e-03_r8,5.6406e-04_r8/) + kao(:, 1, 5, 6) = (/ & + &5.7027e-03_r8,5.1210e-03_r8,4.6077e-03_r8,4.0275e-03_r8,3.4179e-03_r8,2.7812e-03_r8, & + &2.0863e-03_r8,1.2862e-03_r8,7.8383e-05_r8/) + kao(:, 2, 5, 6) = (/ & + &7.4791e-03_r8,6.7335e-03_r8,6.0729e-03_r8,5.3256e-03_r8,4.5457e-03_r8,3.7228e-03_r8, & + &2.8115e-03_r8,1.7506e-03_r8,1.3561e-04_r8/) + kao(:, 3, 5, 6) = (/ & + &9.5940e-03_r8,8.6573e-03_r8,7.8294e-03_r8,6.8962e-03_r8,5.9152e-03_r8,4.8604e-03_r8, & + &3.6801e-03_r8,2.2991e-03_r8,2.0565e-04_r8/) + kao(:, 4, 5, 6) = (/ & + &1.2079e-02_r8,1.0922e-02_r8,9.8984e-03_r8,8.7543e-03_r8,7.5389e-03_r8,6.1967e-03_r8, & + &4.6995e-03_r8,2.9469e-03_r8,2.9267e-04_r8/) + kao(:, 5, 5, 6) = (/ & + &1.4994e-02_r8,1.3590e-02_r8,1.2330e-02_r8,1.0933e-02_r8,9.4206e-03_r8,7.7402e-03_r8, & + &5.8678e-03_r8,3.6936e-03_r8,3.9433e-04_r8/) + kao(:, 1, 6, 6) = (/ & + &7.5110e-03_r8,6.6602e-03_r8,5.8889e-03_r8,5.0761e-03_r8,4.2229e-03_r8,3.3438e-03_r8, & + &2.4265e-03_r8,1.4290e-03_r8,6.0800e-05_r8/) + kao(:, 2, 6, 6) = (/ & + &1.0081e-02_r8,8.9573e-03_r8,7.9340e-03_r8,6.8466e-03_r8,5.7108e-03_r8,4.5453e-03_r8, & + &3.3197e-03_r8,1.9723e-03_r8,8.3721e-05_r8/) + kao(:, 3, 6, 6) = (/ & + &1.3198e-02_r8,1.1747e-02_r8,1.0417e-02_r8,9.0067e-03_r8,7.5375e-03_r8,6.0255e-03_r8, & + &4.4194e-03_r8,2.6335e-03_r8,1.2422e-04_r8/) + kao(:, 4, 6, 6) = (/ & + &1.6984e-02_r8,1.5135e-02_r8,1.3426e-02_r8,1.1628e-02_r8,9.7560e-03_r8,7.8119e-03_r8, & + &5.7333e-03_r8,3.4188e-03_r8,1.8443e-04_r8/) + kao(:, 5, 6, 6) = (/ & + &2.1488e-02_r8,1.9171e-02_r8,1.7013e-02_r8,1.4755e-02_r8,1.2406e-02_r8,9.9290e-03_r8, & + &7.2811e-03_r8,4.3367e-03_r8,2.5906e-04_r8/) + kao(:, 1, 7, 6) = (/ & + &1.0317e-02_r8,9.0822e-03_r8,7.9160e-03_r8,6.7515e-03_r8,5.5440e-03_r8,4.3074e-03_r8, & + &3.0340e-03_r8,1.7035e-03_r8,6.0426e-05_r8/) + kao(:, 2, 7, 6) = (/ & + &1.4191e-02_r8,1.2505e-02_r8,1.0919e-02_r8,9.3201e-03_r8,7.6597e-03_r8,5.9649e-03_r8, & + &4.2263e-03_r8,2.3919e-03_r8,8.0608e-05_r8/) + kao(:, 3, 7, 6) = (/ & + &1.9028e-02_r8,1.6789e-02_r8,1.4664e-02_r8,1.2525e-02_r8,1.0306e-02_r8,8.0458e-03_r8, & + &5.7261e-03_r8,3.2535e-03_r8,1.0671e-04_r8/) + kao(:, 4, 7, 6) = (/ & + &2.5018e-02_r8,2.2107e-02_r8,1.9309e-02_r8,1.6498e-02_r8,1.3592e-02_r8,1.0633e-02_r8, & + &7.5736e-03_r8,4.3041e-03_r8,1.3667e-04_r8/) + kao(:, 5, 7, 6) = (/ & + &3.2278e-02_r8,2.8550e-02_r8,2.4932e-02_r8,2.1309e-02_r8,1.7576e-02_r8,1.3764e-02_r8, & + &9.7979e-03_r8,5.5674e-03_r8,1.7569e-04_r8/) + kao(:, 1, 8, 6) = (/ & + &1.6908e-02_r8,1.4827e-02_r8,1.2781e-02_r8,1.0775e-02_r8,8.7653e-03_r8,6.7156e-03_r8, & + &4.6263e-03_r8,2.4796e-03_r8,7.2095e-05_r8/) + kao(:, 2, 8, 6) = (/ & + &2.3895e-02_r8,2.0964e-02_r8,1.8085e-02_r8,1.5267e-02_r8,1.2424e-02_r8,9.5170e-03_r8, & + &6.5710e-03_r8,3.5441e-03_r8,9.6806e-05_r8/) + kao(:, 3, 8, 6) = (/ & + &3.2855e-02_r8,2.8841e-02_r8,2.4900e-02_r8,2.1032e-02_r8,1.7114e-02_r8,1.3120e-02_r8, & + &9.0780e-03_r8,4.9231e-03_r8,1.2768e-04_r8/) + kao(:, 4, 8, 6) = (/ & + &4.4127e-02_r8,3.8763e-02_r8,3.3492e-02_r8,2.8282e-02_r8,2.3023e-02_r8,1.7668e-02_r8, & + &1.2245e-02_r8,6.6502e-03_r8,1.6091e-04_r8/) + kao(:, 5, 8, 6) = (/ & + &5.7992e-02_r8,5.0977e-02_r8,4.4047e-02_r8,3.7189e-02_r8,3.0275e-02_r8,2.3248e-02_r8, & + &1.6136e-02_r8,8.7683e-03_r8,1.9428e-04_r8/) + kao(:, 1, 9, 6) = (/ & + &5.1709e-02_r8,4.5263e-02_r8,3.8825e-02_r8,3.2404e-02_r8,2.6001e-02_r8,1.9630e-02_r8, & + &1.3270e-02_r8,6.8433e-03_r8,1.6819e-04_r8/) + kao(:, 2, 9, 6) = (/ & + &7.5377e-02_r8,6.5994e-02_r8,5.6614e-02_r8,4.7250e-02_r8,3.7927e-02_r8,2.8667e-02_r8, & + &1.9405e-02_r8,1.0007e-02_r8,2.0150e-04_r8/) + kao(:, 3, 9, 6) = (/ & + &1.0637e-01_r8,9.3142e-02_r8,7.9913e-02_r8,6.6713e-02_r8,5.3579e-02_r8,4.0525e-02_r8, & + &2.7438e-02_r8,1.4159e-02_r8,2.5395e-04_r8/) + kao(:, 4, 9, 6) = (/ & + &1.4601e-01_r8,1.2787e-01_r8,1.0973e-01_r8,9.1640e-02_r8,7.3643e-02_r8,5.5707e-02_r8, & + &3.7721e-02_r8,1.9493e-02_r8,2.9114e-04_r8/) + kao(:, 5, 9, 6) = (/ & + &1.9540e-01_r8,1.7114e-01_r8,1.4689e-01_r8,1.2270e-01_r8,9.8611e-02_r8,7.4576e-02_r8, & + &5.0506e-02_r8,2.6131e-02_r8,3.2502e-04_r8/) + kao(:, 1,10, 6) = (/ & + &1.7908e-01_r8,1.5672e-01_r8,1.3434e-01_r8,1.1197e-01_r8,8.9592e-02_r8,6.7243e-02_r8, & + &4.4903e-02_r8,2.2650e-02_r8,3.5407e-04_r8/) + kao(:, 2,10, 6) = (/ & + &2.6809e-01_r8,2.3461e-01_r8,2.0111e-01_r8,1.6763e-01_r8,1.3416e-01_r8,1.0070e-01_r8, & + &6.7289e-02_r8,3.4001e-02_r8,4.2267e-04_r8/) + kao(:, 3,10, 6) = (/ & + &3.8962e-01_r8,3.4094e-01_r8,2.9228e-01_r8,2.4365e-01_r8,1.9501e-01_r8,1.4639e-01_r8, & + &9.7852e-02_r8,4.9496e-02_r8,5.5217e-04_r8/) + kao(:, 4,10, 6) = (/ & + &5.4709e-01_r8,4.7880e-01_r8,4.1047e-01_r8,3.4221e-01_r8,2.7390e-01_r8,2.0562e-01_r8, & + &1.3748e-01_r8,6.9566e-02_r8,6.7800e-04_r8/) + kao(:, 5,10, 6) = (/ & + &7.4383e-01_r8,6.5097e-01_r8,5.5813e-01_r8,4.6528e-01_r8,3.7246e-01_r8,2.7966e-01_r8, & + &1.8702e-01_r8,9.4633e-02_r8,7.9930e-04_r8/) + kao(:, 1,11, 6) = (/ & + &2.6405e-01_r8,2.3107e-01_r8,1.9807e-01_r8,1.6508e-01_r8,1.3209e-01_r8,9.9087e-02_r8, & + &6.6140e-02_r8,3.3239e-02_r8,4.6661e-04_r8/) + kao(:, 2,11, 6) = (/ & + &3.9885e-01_r8,3.4898e-01_r8,2.9917e-01_r8,2.4935e-01_r8,1.9952e-01_r8,1.4970e-01_r8, & + &9.9938e-02_r8,5.0287e-02_r8,6.6831e-04_r8/) + kao(:, 3,11, 6) = (/ & + &5.8178e-01_r8,5.0910e-01_r8,4.3644e-01_r8,3.6379e-01_r8,2.9110e-01_r8,2.1843e-01_r8, & + &1.4582e-01_r8,7.3440e-02_r8,7.3058e-04_r8/) + kao(:, 4,11, 6) = (/ & + &8.2081e-01_r8,7.1832e-01_r8,6.1577e-01_r8,5.1330e-01_r8,4.1077e-01_r8,3.0826e-01_r8, & + &2.0583e-01_r8,1.0374e-01_r8,9.0801e-04_r8/) + kao(:, 5,11, 6) = (/ & + &1.1196e+00_r8,9.7976e-01_r8,8.3991e-01_r8,7.0013e-01_r8,5.6034e-01_r8,4.2058e-01_r8, & + &2.8087e-01_r8,1.4156e-01_r8,1.1083e-03_r8/) + kao(:, 1,12, 6) = (/ & + &2.9667e-01_r8,2.5960e-01_r8,2.2251e-01_r8,1.8545e-01_r8,1.4837e-01_r8,1.1135e-01_r8, & + &7.4300e-02_r8,3.7344e-02_r8,4.3166e-04_r8/) + kao(:, 2,12, 6) = (/ & + &4.4544e-01_r8,3.8980e-01_r8,3.3414e-01_r8,2.7849e-01_r8,2.2283e-01_r8,1.6719e-01_r8, & + &1.1158e-01_r8,5.6122e-02_r8,7.5682e-04_r8/) + kao(:, 3,12, 6) = (/ & + &6.4877e-01_r8,5.6770e-01_r8,4.8669e-01_r8,4.0564e-01_r8,3.2461e-01_r8,2.4355e-01_r8, & + &1.6257e-01_r8,8.1850e-02_r8,7.9167e-04_r8/) + kao(:, 4,12, 6) = (/ & + &9.1198e-01_r8,7.9809e-01_r8,6.8416e-01_r8,5.7025e-01_r8,4.5635e-01_r8,3.4245e-01_r8, & + &2.2863e-01_r8,1.1515e-01_r8,9.9906e-04_r8/) + kao(:, 5,12, 6) = (/ & + &1.2467e+00_r8,1.0910e+00_r8,9.3529e-01_r8,7.7959e-01_r8,6.2391e-01_r8,4.6827e-01_r8, & + &3.1271e-01_r8,1.5753e-01_r8,1.2003e-03_r8/) + kao(:, 1,13, 6) = (/ & + &2.7690e-01_r8,2.4228e-01_r8,2.0769e-01_r8,1.7308e-01_r8,1.3848e-01_r8,1.0389e-01_r8, & + &6.9340e-02_r8,3.4888e-02_r8,4.3050e-04_r8/) + kao(:, 2,13, 6) = (/ & + &4.0226e-01_r8,3.5198e-01_r8,3.0172e-01_r8,2.5145e-01_r8,2.0123e-01_r8,1.5101e-01_r8, & + &1.0081e-01_r8,5.0783e-02_r8,7.1649e-04_r8/) + kao(:, 3,13, 6) = (/ & + &5.7863e-01_r8,5.0634e-01_r8,4.3410e-01_r8,3.6182e-01_r8,2.8956e-01_r8,2.1728e-01_r8, & + &1.4512e-01_r8,7.3148e-02_r8,7.7482e-04_r8/) + kao(:, 4,13, 6) = (/ & + &8.1324e-01_r8,7.1165e-01_r8,6.1013e-01_r8,5.0851e-01_r8,4.0696e-01_r8,3.0541e-01_r8, & + &2.0404e-01_r8,1.0287e-01_r8,9.9392e-04_r8/) + kao(:, 5,13, 6) = (/ & + &1.1104e+00_r8,9.7179e-01_r8,8.3315e-01_r8,6.9450e-01_r8,5.5586e-01_r8,4.1728e-01_r8, & + &2.7889e-01_r8,1.4068e-01_r8,1.1816e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &3.5054e-03_r8,3.5055e-03_r8,3.5120e-03_r8,3.3810e-03_r8,3.1730e-03_r8,2.8811e-03_r8, & + &2.4850e-03_r8,1.7479e-03_r8,1.1652e-03_r8/) + kao(:, 2, 1, 7) = (/ & + &4.3050e-03_r8,4.3583e-03_r8,4.3910e-03_r8,4.2644e-03_r8,4.0306e-03_r8,3.6880e-03_r8, & + &3.2528e-03_r8,2.5892e-03_r8,1.6752e-03_r8/) + kao(:, 3, 1, 7) = (/ & + &5.1735e-03_r8,5.2976e-03_r8,5.3803e-03_r8,5.2761e-03_r8,5.0137e-03_r8,4.6183e-03_r8, & + &4.1353e-03_r8,3.5068e-03_r8,2.2495e-03_r8/) + kao(:, 4, 1, 7) = (/ & + &6.1057e-03_r8,6.3115e-03_r8,6.4786e-03_r8,6.4038e-03_r8,6.1210e-03_r8,5.6909e-03_r8, & + &5.1278e-03_r8,4.5615e-03_r8,2.9063e-03_r8/) + kao(:, 5, 1, 7) = (/ & + &7.0959e-03_r8,7.4049e-03_r8,7.6778e-03_r8,7.6470e-03_r8,7.3706e-03_r8,6.8965e-03_r8, & + &6.2418e-03_r8,5.7511e-03_r8,3.6720e-03_r8/) + kao(:, 1, 2, 7) = (/ & + &4.4522e-03_r8,4.2827e-03_r8,4.1712e-03_r8,3.9058e-03_r8,3.5730e-03_r8,3.1581e-03_r8, & + &2.6434e-03_r8,1.9182e-03_r8,8.6485e-04_r8/) + kao(:, 2, 2, 7) = (/ & + &5.5183e-03_r8,5.3551e-03_r8,5.2393e-03_r8,4.9436e-03_r8,4.5529e-03_r8,4.0469e-03_r8, & + &3.4309e-03_r8,2.6479e-03_r8,1.2370e-03_r8/) + kao(:, 3, 2, 7) = (/ & + &6.6858e-03_r8,6.5555e-03_r8,6.4351e-03_r8,6.1353e-03_r8,5.6849e-03_r8,5.0737e-03_r8, & + &4.3365e-03_r8,3.4457e-03_r8,1.6663e-03_r8/) + kao(:, 4, 2, 7) = (/ & + &7.9566e-03_r8,7.8606e-03_r8,7.7697e-03_r8,7.4702e-03_r8,6.9634e-03_r8,6.2571e-03_r8, & + &5.3849e-03_r8,4.3375e-03_r8,2.1739e-03_r8/) + kao(:, 5, 2, 7) = (/ & + &9.3107e-03_r8,9.2749e-03_r8,9.2506e-03_r8,8.9459e-03_r8,8.3896e-03_r8,7.5840e-03_r8, & + &6.5605e-03_r8,5.3408e-03_r8,2.7747e-03_r8/) + kao(:, 1, 3, 7) = (/ & + &7.1663e-03_r8,6.5385e-03_r8,6.0832e-03_r8,5.5176e-03_r8,4.8422e-03_r8,4.1012e-03_r8, & + &3.2557e-03_r8,2.2244e-03_r8,5.9815e-04_r8/) + kao(:, 2, 3, 7) = (/ & + &9.0118e-03_r8,8.2694e-03_r8,7.7301e-03_r8,7.0328e-03_r8,6.2053e-03_r8,5.2869e-03_r8, & + &4.2235e-03_r8,2.9652e-03_r8,8.5322e-04_r8/) + kao(:, 3, 3, 7) = (/ & + &1.1073e-02_r8,1.0215e-02_r8,9.5832e-03_r8,8.7498e-03_r8,7.7844e-03_r8,6.6733e-03_r8, & + &5.3588e-03_r8,3.8104e-03_r8,1.1597e-03_r8/) + kao(:, 4, 3, 7) = (/ & + &1.3336e-02_r8,1.2373e-02_r8,1.1642e-02_r8,1.0696e-02_r8,9.5807e-03_r8,8.2482e-03_r8, & + &6.6726e-03_r8,4.7891e-03_r8,1.5317e-03_r8/) + kao(:, 5, 3, 7) = (/ & + &1.5766e-02_r8,1.4727e-02_r8,1.3917e-02_r8,1.2876e-02_r8,1.1585e-02_r8,1.0016e-02_r8, & + &8.1535e-03_r8,5.8982e-03_r8,1.9785e-03_r8/) + kao(:, 1, 4, 7) = (/ & + &1.1443e-02_r8,1.0194e-02_r8,9.0847e-03_r8,8.0229e-03_r8,6.8443e-03_r8,5.5702e-03_r8, & + &4.2183e-03_r8,2.6813e-03_r8,4.0030e-04_r8/) + kao(:, 2, 4, 7) = (/ & + &1.4659e-02_r8,1.3095e-02_r8,1.1714e-02_r8,1.0375e-02_r8,8.8664e-03_r8,7.2483e-03_r8, & + &5.5253e-03_r8,3.5568e-03_r8,5.7754e-04_r8/) + kao(:, 3, 4, 7) = (/ & + &1.8306e-02_r8,1.6401e-02_r8,1.4719e-02_r8,1.3058e-02_r8,1.1190e-02_r8,9.2063e-03_r8, & + &7.0626e-03_r8,4.5942e-03_r8,7.9824e-04_r8/) + kao(:, 4, 4, 7) = (/ & + &2.2363e-02_r8,2.0101e-02_r8,1.8107e-02_r8,1.6087e-02_r8,1.3850e-02_r8,1.1470e-02_r8, & + &8.8334e-03_r8,5.7997e-03_r8,1.0688e-03_r8/) + kao(:, 5, 4, 7) = (/ & + &2.6741e-02_r8,2.4136e-02_r8,2.1831e-02_r8,1.9473e-02_r8,1.6867e-02_r8,1.4029e-02_r8, & + &1.0846e-02_r8,7.1614e-03_r8,1.3988e-03_r8/) + kao(:, 1, 5, 7) = (/ & + &1.6600e-02_r8,1.4668e-02_r8,1.2778e-02_r8,1.1029e-02_r8,9.2361e-03_r8,7.3333e-03_r8, & + &5.3444e-03_r8,3.2124e-03_r8,2.6040e-04_r8/) + kao(:, 2, 5, 7) = (/ & + &2.1709e-02_r8,1.9200e-02_r8,1.6777e-02_r8,1.4511e-02_r8,1.2172e-02_r8,9.6744e-03_r8, & + &7.0766e-03_r8,4.2987e-03_r8,3.8620e-04_r8/) + kao(:, 3, 5, 7) = (/ & + &2.7589e-02_r8,2.4430e-02_r8,2.1405e-02_r8,1.8550e-02_r8,1.5579e-02_r8,1.2414e-02_r8, & + &9.1361e-03_r8,5.5941e-03_r8,5.4726e-04_r8/) + kao(:, 4, 5, 7) = (/ & + &3.4183e-02_r8,3.0324e-02_r8,2.6641e-02_r8,2.3153e-02_r8,1.9480e-02_r8,1.5601e-02_r8, & + &1.1542e-02_r8,7.1098e-03_r8,7.4652e-04_r8/) + kao(:, 5, 5, 7) = (/ & + &4.1421e-02_r8,3.6823e-02_r8,3.2447e-02_r8,2.8275e-02_r8,2.3873e-02_r8,1.9232e-02_r8, & + &1.4297e-02_r8,8.8472e-03_r8,9.9177e-04_r8/) + kao(:, 1, 6, 7) = (/ & + &2.2041e-02_r8,1.9394e-02_r8,1.6757e-02_r8,1.4215e-02_r8,1.1736e-02_r8,9.1749e-03_r8, & + &6.5141e-03_r8,3.7310e-03_r8,1.4404e-04_r8/) + kao(:, 2, 6, 7) = (/ & + &2.9498e-02_r8,2.5961e-02_r8,2.2459e-02_r8,1.9104e-02_r8,1.5796e-02_r8,1.2359e-02_r8, & + &8.7857e-03_r8,5.0673e-03_r8,2.3466e-04_r8/) + kao(:, 3, 6, 7) = (/ & + &3.8260e-02_r8,3.3683e-02_r8,2.9196e-02_r8,2.4887e-02_r8,2.0608e-02_r8,1.6142e-02_r8, & + &1.1503e-02_r8,6.6775e-03_r8,3.4879e-04_r8/) + kao(:, 4, 6, 7) = (/ & + &4.8196e-02_r8,4.2468e-02_r8,3.6884e-02_r8,3.1502e-02_r8,2.6137e-02_r8,2.0520e-02_r8, & + &1.4704e-02_r8,8.5847e-03_r8,4.9990e-04_r8/) + kao(:, 5, 6, 7) = (/ & + &5.9282e-02_r8,5.2285e-02_r8,4.5513e-02_r8,3.8965e-02_r8,3.2393e-02_r8,2.5526e-02_r8, & + &1.8401e-02_r8,1.0794e-02_r8,6.8674e-04_r8/) + kao(:, 1, 7, 7) = (/ & + &3.0340e-02_r8,2.6632e-02_r8,2.2911e-02_r8,1.9238e-02_r8,1.5651e-02_r8,1.2078e-02_r8, & + &8.4116e-03_r8,4.6225e-03_r8,1.1044e-04_r8/) + kao(:, 2, 7, 7) = (/ & + &4.1630e-02_r8,3.6541e-02_r8,3.1448e-02_r8,2.6441e-02_r8,2.1565e-02_r8,1.6662e-02_r8, & + &1.1608e-02_r8,6.3979e-03_r8,1.5103e-04_r8/) + kao(:, 3, 7, 7) = (/ & + &5.5141e-02_r8,4.8404e-02_r8,4.1697e-02_r8,3.5120e-02_r8,2.8696e-02_r8,2.2204e-02_r8, & + &1.5482e-02_r8,8.5690e-03_r8,2.0480e-04_r8/) + kao(:, 4, 7, 7) = (/ & + &7.0797e-02_r8,6.2144e-02_r8,5.3596e-02_r8,4.5212e-02_r8,3.6995e-02_r8,2.8664e-02_r8, & + &2.0039e-02_r8,1.1163e-02_r8,2.9866e-04_r8/) + kao(:, 5, 7, 7) = (/ & + &8.8459e-02_r8,7.7674e-02_r8,6.7088e-02_r8,5.6677e-02_r8,4.6470e-02_r8,3.6087e-02_r8, & + &2.5332e-02_r8,1.4195e-02_r8,4.2372e-04_r8/) + kao(:, 1, 8, 7) = (/ & + &4.9601e-02_r8,4.3472e-02_r8,3.7321e-02_r8,3.1177e-02_r8,2.5072e-02_r8,1.9045e-02_r8, & + &1.3035e-02_r8,6.9120e-03_r8,1.2554e-04_r8/) + kao(:, 2, 8, 7) = (/ & + &6.9873e-02_r8,6.1229e-02_r8,5.2577e-02_r8,4.3926e-02_r8,3.5352e-02_r8,2.6911e-02_r8, & + &1.8460e-02_r8,9.7927e-03_r8,1.5143e-04_r8/) + kao(:, 3, 8, 7) = (/ & + &9.4645e-02_r8,8.2931e-02_r8,7.1217e-02_r8,5.9530e-02_r8,4.7979e-02_r8,3.6597e-02_r8, & + &2.5135e-02_r8,1.3350e-02_r8,1.8982e-04_r8/) + kao(:, 4, 8, 7) = (/ & + &1.2398e-01_r8,1.0863e-01_r8,9.3295e-02_r8,7.8049e-02_r8,6.2983e-02_r8,4.8099e-02_r8, & + &3.3072e-02_r8,1.7624e-02_r8,2.4338e-04_r8/) + kao(:, 5, 8, 7) = (/ & + &1.5756e-01_r8,1.3808e-01_r8,1.1863e-01_r8,9.9354e-02_r8,8.0265e-02_r8,6.1390e-02_r8, & + &4.2297e-02_r8,2.2655e-02_r8,3.0934e-04_r8/) + kao(:, 1, 9, 7) = (/ & + &1.5112e-01_r8,1.3227e-01_r8,1.1344e-01_r8,9.4596e-02_r8,7.5748e-02_r8,5.6892e-02_r8, & + &3.8080e-02_r8,1.9401e-02_r8,2.5169e-04_r8/) + kao(:, 2, 9, 7) = (/ & + &2.1904e-01_r8,1.9173e-01_r8,1.6442e-01_r8,1.3710e-01_r8,1.0978e-01_r8,8.2457e-02_r8, & + &5.5213e-02_r8,2.8220e-02_r8,3.2207e-04_r8/) + kao(:, 3, 9, 7) = (/ & + &3.0409e-01_r8,2.6618e-01_r8,2.2825e-01_r8,1.9033e-01_r8,1.5240e-01_r8,1.1448e-01_r8, & + &7.6724e-02_r8,3.9326e-02_r8,3.9043e-04_r8/) + kao(:, 4, 9, 7) = (/ & + &4.0691e-01_r8,3.5618e-01_r8,3.0544e-01_r8,2.5467e-01_r8,2.0393e-01_r8,1.5326e-01_r8, & + &1.0281e-01_r8,5.2796e-02_r8,4.7191e-04_r8/) + kao(:, 5, 9, 7) = (/ & + &5.2694e-01_r8,4.6123e-01_r8,3.9556e-01_r8,3.2985e-01_r8,2.6417e-01_r8,1.9865e-01_r8, & + &1.3342e-01_r8,6.8629e-02_r8,5.3966e-04_r8/) + kao(:, 1,10, 7) = (/ & + &5.2400e-01_r8,4.5853e-01_r8,3.9306e-01_r8,3.2760e-01_r8,2.6216e-01_r8,1.9669e-01_r8, & + &1.3123e-01_r8,6.5752e-02_r8,5.0343e-04_r8/) + kao(:, 2,10, 7) = (/ & + &7.8161e-01_r8,6.8400e-01_r8,5.8634e-01_r8,4.8867e-01_r8,3.9103e-01_r8,2.9337e-01_r8, & + &1.9570e-01_r8,9.8059e-02_r8,7.7212e-04_r8/) + kao(:, 3,10, 7) = (/ & + &1.1108e+00_r8,9.7208e-01_r8,8.3335e-01_r8,6.9453e-01_r8,5.5575e-01_r8,4.1693e-01_r8, & + &2.7814e-01_r8,1.3935e-01_r8,8.3303e-04_r8/) + kao(:, 4,10, 7) = (/ & + &1.5159e+00_r8,1.3265e+00_r8,1.1372e+00_r8,9.4781e-01_r8,7.5840e-01_r8,5.6900e-01_r8, & + &3.7960e-01_r8,1.9025e-01_r8,1.0516e-03_r8/) + kao(:, 5,10, 7) = (/ & + &2.0008e+00_r8,1.7509e+00_r8,1.5009e+00_r8,1.2510e+00_r8,1.0010e+00_r8,7.5106e-01_r8, & + &5.0105e-01_r8,2.5132e-01_r8,1.2795e-03_r8/) + kao(:, 1,11, 7) = (/ & + &7.6934e-01_r8,6.7322e-01_r8,5.7711e-01_r8,4.8095e-01_r8,3.8483e-01_r8,2.8868e-01_r8, & + &1.9254e-01_r8,9.6383e-02_r8,4.1213e-04_r8/) + kao(:, 2,11, 7) = (/ & + &1.1531e+00_r8,1.0090e+00_r8,8.6492e-01_r8,7.2086e-01_r8,5.7680e-01_r8,4.3268e-01_r8, & + &2.8857e-01_r8,1.4445e-01_r8,7.8643e-04_r8/) + kao(:, 3,11, 7) = (/ & + &1.6479e+00_r8,1.4420e+00_r8,1.2361e+00_r8,1.0302e+00_r8,8.2427e-01_r8,6.1836e-01_r8, & + &4.1243e-01_r8,2.0646e-01_r8,1.3424e-03_r8/) + kao(:, 4,11, 7) = (/ & + &2.2624e+00_r8,1.9796e+00_r8,1.6970e+00_r8,1.4143e+00_r8,1.1316e+00_r8,8.4892e-01_r8, & + &5.6619e-01_r8,2.8348e-01_r8,1.4044e-03_r8/) + kao(:, 5,11, 7) = (/ & + &3.0074e+00_r8,2.6315e+00_r8,2.2558e+00_r8,1.8800e+00_r8,1.5042e+00_r8,1.1285e+00_r8, & + &7.5266e-01_r8,3.7695e-01_r8,1.6947e-03_r8/) + kao(:, 1,12, 7) = (/ & + &8.4478e-01_r8,7.3926e-01_r8,6.3371e-01_r8,5.2813e-01_r8,4.2255e-01_r8,3.1696e-01_r8, & + &2.1141e-01_r8,1.0578e-01_r8,4.0897e-04_r8/) + kao(:, 2,12, 7) = (/ & + &1.2687e+00_r8,1.1101e+00_r8,9.5161e-01_r8,7.9307e-01_r8,6.3449e-01_r8,4.7596e-01_r8, & + &3.1742e-01_r8,1.5884e-01_r8,7.3572e-04_r8/) + kao(:, 3,12, 7) = (/ & + &1.8247e+00_r8,1.5966e+00_r8,1.3686e+00_r8,1.1406e+00_r8,9.1261e-01_r8,6.8459e-01_r8, & + &4.5656e-01_r8,2.2852e-01_r8,1.3876e-03_r8/) + kao(:, 4,12, 7) = (/ & + &2.5294e+00_r8,2.2134e+00_r8,1.8973e+00_r8,1.5812e+00_r8,1.2652e+00_r8,9.4906e-01_r8, & + &6.3294e-01_r8,3.1685e-01_r8,1.6774e-03_r8/) + kao(:, 5,12, 7) = (/ & + &3.3840e+00_r8,2.9611e+00_r8,2.5383e+00_r8,2.1154e+00_r8,1.6926e+00_r8,1.2697e+00_r8, & + &8.4679e-01_r8,4.2403e-01_r8,1.9227e-03_r8/) + kao(:, 1,13, 7) = (/ & + &7.4992e-01_r8,6.5626e-01_r8,5.6252e-01_r8,4.6882e-01_r8,3.7512e-01_r8,2.8140e-01_r8, & + &1.8768e-01_r8,9.3938e-02_r8,4.2556e-04_r8/) + kao(:, 2,13, 7) = (/ & + &1.1304e+00_r8,9.8913e-01_r8,8.4793e-01_r8,7.0671e-01_r8,5.6541e-01_r8,4.2417e-01_r8, & + &2.8288e-01_r8,1.4159e-01_r8,7.8986e-04_r8/) + kao(:, 3,13, 7) = (/ & + &1.6343e+00_r8,1.4300e+00_r8,1.2259e+00_r8,1.0217e+00_r8,8.1745e-01_r8,6.1321e-01_r8, & + &4.0897e-01_r8,2.0475e-01_r8,1.4019e-03_r8/) + kao(:, 4,13, 7) = (/ & + &2.2667e+00_r8,1.9834e+00_r8,1.7002e+00_r8,1.4170e+00_r8,1.1337e+00_r8,8.5047e-01_r8, & + &5.6722e-01_r8,2.8408e-01_r8,1.6857e-03_r8/) + kao(:, 5,13, 7) = (/ & + &3.0450e+00_r8,2.6646e+00_r8,2.2841e+00_r8,1.9036e+00_r8,1.5231e+00_r8,1.1426e+00_r8, & + &7.6204e-01_r8,3.8179e-01_r8,1.9578e-03_r8/) + kao(:, 1, 1, 8) = (/ & + &7.5530e-03_r8,7.1946e-03_r8,6.9309e-03_r8,6.6476e-03_r8,6.1286e-03_r8,5.5188e-03_r8, & + &4.8784e-03_r8,4.0369e-03_r8,3.2329e-03_r8/) + kao(:, 2, 1, 8) = (/ & + &9.1868e-03_r8,8.8285e-03_r8,8.6011e-03_r8,8.3060e-03_r8,7.7227e-03_r8,7.0815e-03_r8, & + &6.4738e-03_r8,5.8694e-03_r8,4.4599e-03_r8/) + kao(:, 3, 1, 8) = (/ & + &1.0993e-02_r8,1.0661e-02_r8,1.0487e-02_r8,1.0178e-02_r8,9.5750e-03_r8,8.9143e-03_r8, & + &8.3359e-03_r8,7.9019e-03_r8,5.9682e-03_r8/) + kao(:, 4, 1, 8) = (/ & + &1.2929e-02_r8,1.2692e-02_r8,1.2580e-02_r8,1.2285e-02_r8,1.1693e-02_r8,1.1035e-02_r8, & + &1.0548e-02_r8,1.0225e-02_r8,7.8210e-03_r8/) + kao(:, 5, 1, 8) = (/ & + &1.4992e-02_r8,1.4924e-02_r8,1.4888e-02_r8,1.4659e-02_r8,1.4068e-02_r8,1.3474e-02_r8, & + &1.3107e-02_r8,1.2867e-02_r8,1.0020e-02_r8/) + kao(:, 1, 2, 8) = (/ & + &1.0207e-02_r8,9.4797e-03_r8,8.8085e-03_r8,8.2309e-03_r8,7.4348e-03_r8,6.4679e-03_r8, & + &5.3282e-03_r8,4.0056e-03_r8,2.5229e-03_r8/) + kao(:, 2, 2, 8) = (/ & + &1.2558e-02_r8,1.1748e-02_r8,1.1002e-02_r8,1.0338e-02_r8,9.3997e-03_r8,8.2648e-03_r8, & + &6.9317e-03_r8,5.5570e-03_r8,3.5029e-03_r8/) + kao(:, 3, 2, 8) = (/ & + &1.5167e-02_r8,1.4277e-02_r8,1.3509e-02_r8,1.2727e-02_r8,1.1653e-02_r8,1.0352e-02_r8, & + &8.8205e-03_r8,7.4037e-03_r8,4.7140e-03_r8/) + kao(:, 4, 2, 8) = (/ & + &1.7986e-02_r8,1.7073e-02_r8,1.6287e-02_r8,1.5417e-02_r8,1.4234e-02_r8,1.2722e-02_r8, & + &1.1029e-02_r8,9.5450e-03_r8,6.1941e-03_r8/) + kao(:, 5, 2, 8) = (/ & + &2.1016e-02_r8,2.0104e-02_r8,1.9317e-02_r8,1.8415e-02_r8,1.7125e-02_r8,1.5397e-02_r8, & + &1.3573e-02_r8,1.2029e-02_r8,7.9674e-03_r8/) + kao(:, 1, 3, 8) = (/ & + &1.7495e-02_r8,1.5793e-02_r8,1.4039e-02_r8,1.2465e-02_r8,1.0907e-02_r8,9.1072e-03_r8, & + &7.1058e-03_r8,4.8343e-03_r8,1.7832e-03_r8/) + kao(:, 2, 3, 8) = (/ & + &2.1893e-02_r8,1.9841e-02_r8,1.7709e-02_r8,1.5801e-02_r8,1.3894e-02_r8,1.1662e-02_r8, & + &9.2038e-03_r8,6.3817e-03_r8,2.5128e-03_r8/) + kao(:, 3, 3, 8) = (/ & + &2.6790e-02_r8,2.4372e-02_r8,2.1871e-02_r8,1.9635e-02_r8,1.7311e-02_r8,1.4624e-02_r8, & + &1.1658e-02_r8,8.2109e-03_r8,3.4348e-03_r8/) + kao(:, 4, 3, 8) = (/ & + &3.2142e-02_r8,2.9358e-02_r8,2.6490e-02_r8,2.3921e-02_r8,2.1182e-02_r8,1.8026e-02_r8, & + &1.4487e-02_r8,1.0373e-02_r8,4.5646e-03_r8/) + kao(:, 5, 3, 8) = (/ & + &3.7933e-02_r8,3.4749e-02_r8,3.1541e-02_r8,2.8628e-02_r8,2.5501e-02_r8,2.1864e-02_r8, & + &1.7709e-02_r8,1.2883e-02_r8,5.9131e-03_r8/) + kao(:, 1, 4, 8) = (/ & + &2.9550e-02_r8,2.6227e-02_r8,2.2910e-02_r8,1.9604e-02_r8,1.6469e-02_r8,1.3339e-02_r8, & + &9.9415e-03_r8,6.2262e-03_r8,1.2135e-03_r8/) + kao(:, 2, 4, 8) = (/ & + &3.7687e-02_r8,3.3528e-02_r8,2.9343e-02_r8,2.5186e-02_r8,2.1249e-02_r8,1.7292e-02_r8, & + &1.2959e-02_r8,8.2307e-03_r8,1.7374e-03_r8/) + kao(:, 3, 4, 8) = (/ & + &4.6817e-02_r8,4.1770e-02_r8,3.6634e-02_r8,3.1558e-02_r8,2.6759e-02_r8,2.1861e-02_r8, & + &1.6492e-02_r8,1.0607e-02_r8,2.4118e-03_r8/) + kao(:, 4, 4, 8) = (/ & + &5.6963e-02_r8,5.0934e-02_r8,4.4739e-02_r8,3.8692e-02_r8,3.2979e-02_r8,2.7058e-02_r8, & + &2.0566e-02_r8,1.3387e-02_r8,3.2525e-03_r8/) + kao(:, 5, 4, 8) = (/ & + &6.8137e-02_r8,6.0987e-02_r8,5.3660e-02_r8,4.6589e-02_r8,3.9864e-02_r8,3.2872e-02_r8, & + &2.5218e-02_r8,1.6596e-02_r8,4.2777e-03_r8/) + kao(:, 1, 5, 8) = (/ & + &4.4958e-02_r8,3.9602e-02_r8,3.4298e-02_r8,2.8957e-02_r8,2.3691e-02_r8,1.8601e-02_r8, & + &1.3441e-02_r8,7.9068e-03_r8,8.1517e-04_r8/) + kao(:, 2, 5, 8) = (/ & + &5.8476e-02_r8,5.1578e-02_r8,4.4743e-02_r8,3.7815e-02_r8,3.1045e-02_r8,2.4482e-02_r8, & + &1.7770e-02_r8,1.0541e-02_r8,1.1885e-03_r8/) + kao(:, 3, 5, 8) = (/ & + &7.3906e-02_r8,6.5268e-02_r8,5.6679e-02_r8,4.8013e-02_r8,3.9537e-02_r8,3.1318e-02_r8, & + &2.2852e-02_r8,1.3697e-02_r8,1.6746e-03_r8/) + kao(:, 4, 5, 8) = (/ & + &9.1296e-02_r8,8.0739e-02_r8,7.0175e-02_r8,5.9533e-02_r8,4.9168e-02_r8,3.9100e-02_r8, & + &2.8676e-02_r8,1.7397e-02_r8,2.2909e-03_r8/) + kao(:, 5, 5, 8) = (/ & + &1.1069e-01_r8,9.7986e-02_r8,8.5202e-02_r8,7.2388e-02_r8,5.9975e-02_r8,4.7864e-02_r8, & + &3.5291e-02_r8,2.1668e-02_r8,3.0530e-03_r8/) + kao(:, 1, 6, 8) = (/ & + &6.2124e-02_r8,5.4544e-02_r8,4.6999e-02_r8,3.9470e-02_r8,3.1923e-02_r8,2.4497e-02_r8, & + &1.7234e-02_r8,9.7062e-03_r8,5.1266e-04_r8/) + kao(:, 2, 6, 8) = (/ & + &8.2639e-02_r8,7.2604e-02_r8,6.2611e-02_r8,5.2626e-02_r8,4.2613e-02_r8,3.2833e-02_r8, & + &2.3213e-02_r8,1.3144e-02_r8,7.8429e-04_r8/) + kao(:, 3, 6, 8) = (/ & + &1.0657e-01_r8,9.3700e-02_r8,8.0879e-02_r8,6.8013e-02_r8,5.5195e-02_r8,4.2665e-02_r8, & + &3.0306e-02_r8,1.7290e-02_r8,1.1388e-03_r8/) + kao(:, 4, 6, 8) = (/ & + &1.3398e-01_r8,1.1789e-01_r8,1.0183e-01_r8,8.5694e-02_r8,6.9665e-02_r8,5.3995e-02_r8, & + &3.8486e-02_r8,2.2145e-02_r8,1.5829e-03_r8/) + kao(:, 5, 6, 8) = (/ & + &1.6490e-01_r8,1.4520e-01_r8,1.2544e-01_r8,1.0568e-01_r8,8.6025e-02_r8,6.6861e-02_r8, & + &4.7818e-02_r8,2.7758e-02_r8,2.1408e-03_r8/) + kao(:, 1, 7, 8) = (/ & + &8.8474e-02_r8,7.7539e-02_r8,6.6627e-02_r8,5.5731e-02_r8,4.4842e-02_r8,3.3990e-02_r8, & + &2.3276e-02_r8,1.2620e-02_r8,2.5937e-04_r8/) + kao(:, 2, 7, 8) = (/ & + &1.2057e-01_r8,1.0571e-01_r8,9.0876e-02_r8,7.6061e-02_r8,6.1253e-02_r8,4.6466e-02_r8, & + &3.1963e-02_r8,1.7441e-02_r8,4.2731e-04_r8/) + kao(:, 3, 7, 8) = (/ & + &1.5880e-01_r8,1.3927e-01_r8,1.1980e-01_r8,1.0034e-01_r8,8.0808e-02_r8,6.1423e-02_r8, & + &4.2427e-02_r8,2.3279e-02_r8,6.8413e-04_r8/) + kao(:, 4, 7, 8) = (/ & + &2.0345e-01_r8,1.7853e-01_r8,1.5363e-01_r8,1.2871e-01_r8,1.0372e-01_r8,7.9011e-02_r8, & + &5.4743e-02_r8,3.0170e-02_r8,1.0214e-03_r8/) + kao(:, 5, 7, 8) = (/ & + &2.5461e-01_r8,2.2346e-01_r8,1.9234e-01_r8,1.6117e-01_r8,1.3002e-01_r8,9.9184e-02_r8, & + &6.8901e-02_r8,3.8181e-02_r8,1.4552e-03_r8/) + kao(:, 1, 8, 8) = (/ & + &1.4868e-01_r8,1.3017e-01_r8,1.1167e-01_r8,9.3201e-02_r8,7.4739e-02_r8,5.6278e-02_r8, & + &3.7905e-02_r8,1.9693e-02_r8,2.2804e-04_r8/) + kao(:, 2, 8, 8) = (/ & + &2.0798e-01_r8,1.8213e-01_r8,1.5630e-01_r8,1.3048e-01_r8,1.0468e-01_r8,7.8891e-02_r8, & + &5.3152e-02_r8,2.7778e-02_r8,2.9739e-04_r8/) + kao(:, 3, 8, 8) = (/ & + &2.8017e-01_r8,2.4539e-01_r8,2.1065e-01_r8,1.7590e-01_r8,1.4119e-01_r8,1.0644e-01_r8, & + &7.1779e-02_r8,3.7725e-02_r8,3.8946e-04_r8/) + kao(:, 4, 8, 8) = (/ & + &3.6604e-01_r8,3.2068e-01_r8,2.7532e-01_r8,2.2999e-01_r8,1.8464e-01_r8,1.3919e-01_r8, & + &9.4095e-02_r8,4.9659e-02_r8,5.6194e-04_r8/) + kao(:, 5, 8, 8) = (/ & + &4.6634e-01_r8,4.0858e-01_r8,3.5083e-01_r8,2.9310e-01_r8,2.3536e-01_r8,1.7756e-01_r8, & + &1.2024e-01_r8,6.3667e-02_r8,8.0698e-04_r8/) + kao(:, 1, 9, 8) = (/ & + &4.6269e-01_r8,4.0493e-01_r8,3.4715e-01_r8,2.8935e-01_r8,2.3157e-01_r8,1.7382e-01_r8, & + &1.1609e-01_r8,5.8382e-02_r8,3.9623e-04_r8/) + kao(:, 2, 9, 8) = (/ & + &6.6628e-01_r8,5.8309e-01_r8,4.9991e-01_r8,4.1673e-01_r8,3.3358e-01_r8,2.5043e-01_r8, & + &1.6730e-01_r8,8.4243e-02_r8,5.2033e-04_r8/) + kao(:, 3, 9, 8) = (/ & + &9.1981e-01_r8,8.0501e-01_r8,6.9024e-01_r8,5.7543e-01_r8,4.6067e-01_r8,3.4594e-01_r8, & + &2.3120e-01_r8,1.1646e-01_r8,6.1848e-04_r8/) + kao(:, 4, 9, 8) = (/ & + &1.2275e+00_r8,1.0743e+00_r8,9.2117e-01_r8,7.6798e-01_r8,6.1489e-01_r8,4.6180e-01_r8, & + &3.0869e-01_r8,1.5554e-01_r8,7.6432e-04_r8/) + kao(:, 5, 9, 8) = (/ & + &1.5931e+00_r8,1.3944e+00_r8,1.1956e+00_r8,9.9699e-01_r8,7.9825e-01_r8,5.9958e-01_r8, & + &4.0095e-01_r8,2.0227e-01_r8,9.3678e-04_r8/) + kao(:, 1,10, 8) = (/ & + &1.6306e+00_r8,1.4267e+00_r8,1.2230e+00_r8,1.0192e+00_r8,8.1547e-01_r8,6.1164e-01_r8, & + &4.0787e-01_r8,2.0413e-01_r8,4.5853e-04_r8/) + kao(:, 2,10, 8) = (/ & + &2.4126e+00_r8,2.1111e+00_r8,1.8096e+00_r8,1.5081e+00_r8,1.2066e+00_r8,9.0513e-01_r8, & + &6.0364e-01_r8,3.0217e-01_r8,8.3201e-04_r8/) + kao(:, 3,10, 8) = (/ & + &3.4093e+00_r8,2.9833e+00_r8,2.5573e+00_r8,2.1313e+00_r8,1.7053e+00_r8,1.2792e+00_r8, & + &8.5320e-01_r8,4.2724e-01_r8,1.5974e-03_r8/) + kao(:, 4,10, 8) = (/ & + &4.6433e+00_r8,4.0630e+00_r8,3.4826e+00_r8,2.9025e+00_r8,2.3226e+00_r8,1.7423e+00_r8, & + &1.1621e+00_r8,5.8201e-01_r8,1.5962e-03_r8/) + kao(:, 5,10, 8) = (/ & + &6.1277e+00_r8,5.3619e+00_r8,4.5964e+00_r8,3.8308e+00_r8,3.0651e+00_r8,2.2994e+00_r8, & + &1.5338e+00_r8,7.6843e-01_r8,2.0260e-03_r8/) + kao(:, 1,11, 8) = (/ & + &2.4162e+00_r8,2.1143e+00_r8,1.8124e+00_r8,1.5103e+00_r8,1.2083e+00_r8,9.0631e-01_r8, & + &6.0429e-01_r8,3.0233e-01_r8,6.1607e-04_r8/) + kao(:, 2,11, 8) = (/ & + &3.5951e+00_r8,3.1458e+00_r8,2.6963e+00_r8,2.2470e+00_r8,1.7978e+00_r8,1.3484e+00_r8, & + &8.9917e-01_r8,4.4993e-01_r8,6.5176e-04_r8/) + kao(:, 3,11, 8) = (/ & + &5.1060e+00_r8,4.4678e+00_r8,3.8297e+00_r8,3.1915e+00_r8,2.5535e+00_r8,1.9153e+00_r8, & + &1.2772e+00_r8,6.3920e-01_r8,1.2930e-03_r8/) + kao(:, 4,11, 8) = (/ & + &6.9828e+00_r8,6.1098e+00_r8,5.2373e+00_r8,4.3645e+00_r8,3.4923e+00_r8,2.6195e+00_r8, & + &1.7469e+00_r8,8.7439e-01_r8,2.6451e-03_r8/) + kao(:, 5,11, 8) = (/ & + &9.2372e+00_r8,8.0825e+00_r8,6.9284e+00_r8,5.7745e+00_r8,4.6202e+00_r8,3.4655e+00_r8, & + &2.3113e+00_r8,1.1571e+00_r8,3.2091e-03_r8/) + kao(:, 1,12, 8) = (/ & + &2.6551e+00_r8,2.3231e+00_r8,1.9913e+00_r8,1.6595e+00_r8,1.3276e+00_r8,9.9570e-01_r8, & + &6.6396e-01_r8,3.3215e-01_r8,5.7595e-04_r8/) + kao(:, 2,12, 8) = (/ & + &3.9875e+00_r8,3.4892e+00_r8,2.9906e+00_r8,2.4922e+00_r8,1.9940e+00_r8,1.4956e+00_r8, & + &9.9727e-01_r8,4.9897e-01_r8,7.2773e-04_r8/) + kao(:, 3,12, 8) = (/ & + &5.6951e+00_r8,4.9832e+00_r8,4.2714e+00_r8,3.5598e+00_r8,2.8480e+00_r8,2.1362e+00_r8, & + &1.4245e+00_r8,7.1282e-01_r8,1.1732e-03_r8/) + kao(:, 4,12, 8) = (/ & + &7.8078e+00_r8,6.8322e+00_r8,5.8562e+00_r8,4.8804e+00_r8,3.9048e+00_r8,2.9289e+00_r8, & + &1.9532e+00_r8,9.7758e-01_r8,2.5629e-03_r8/) + kao(:, 5,12, 8) = (/ & + &1.0362e+01_r8,9.0671e+00_r8,7.7724e+00_r8,6.4775e+00_r8,5.1823e+00_r8,3.8873e+00_r8, & + &2.5926e+00_r8,1.2977e+00_r8,3.8105e-03_r8/) + kao(:, 1,13, 8) = (/ & + &2.3258e+00_r8,2.0350e+00_r8,1.7444e+00_r8,1.4537e+00_r8,1.1630e+00_r8,8.7226e-01_r8, & + &5.8161e-01_r8,2.9098e-01_r8,5.9908e-04_r8/) + kao(:, 2,13, 8) = (/ & + &3.5360e+00_r8,3.0938e+00_r8,2.6520e+00_r8,2.2101e+00_r8,1.7681e+00_r8,1.3262e+00_r8, & + &8.8435e-01_r8,4.4250e-01_r8,8.1555e-04_r8/) + kao(:, 3,13, 8) = (/ & + &5.0896e+00_r8,4.4536e+00_r8,3.8175e+00_r8,3.1814e+00_r8,2.5452e+00_r8,1.9091e+00_r8, & + &1.2732e+00_r8,6.3712e-01_r8,1.2640e-03_r8/) + kao(:, 4,13, 8) = (/ & + &7.0210e+00_r8,6.1435e+00_r8,5.2660e+00_r8,4.3886e+00_r8,3.5112e+00_r8,2.6338e+00_r8, & + &1.7565e+00_r8,8.7919e-01_r8,2.6701e-03_r8/) + kao(:, 5,13, 8) = (/ & + &9.3671e+00_r8,8.1963e+00_r8,7.0260e+00_r8,5.8554e+00_r8,4.6849e+00_r8,3.5142e+00_r8, & + &2.3437e+00_r8,1.1734e+00_r8,3.9606e-03_r8/) + kao(:, 1, 1, 9) = (/ & + &1.7557e-02_r8,1.6098e-02_r8,1.5252e-02_r8,1.4591e-02_r8,1.4194e-02_r8,1.3841e-02_r8, & + &1.3213e-02_r8,1.1760e-02_r8,1.0941e-02_r8/) + kao(:, 2, 1, 9) = (/ & + &2.1322e-02_r8,1.9727e-02_r8,1.8932e-02_r8,1.8315e-02_r8,1.8048e-02_r8,1.7757e-02_r8, & + &1.7105e-02_r8,1.5377e-02_r8,1.4897e-02_r8/) + kao(:, 3, 1, 9) = (/ & + &2.5364e-02_r8,2.3730e-02_r8,2.3058e-02_r8,2.2569e-02_r8,2.2483e-02_r8,2.2337e-02_r8, & + &2.1647e-02_r8,1.9659e-02_r8,1.9740e-02_r8/) + kao(:, 4, 1, 9) = (/ & + &2.9651e-02_r8,2.8091e-02_r8,2.7567e-02_r8,2.7373e-02_r8,2.7544e-02_r8,2.7572e-02_r8, & + &2.6885e-02_r8,2.4698e-02_r8,2.5506e-02_r8/) + kao(:, 5, 1, 9) = (/ & + &3.4147e-02_r8,3.2801e-02_r8,3.2509e-02_r8,3.2696e-02_r8,3.3242e-02_r8,3.3466e-02_r8, & + &3.2763e-02_r8,3.0530e-02_r8,3.2414e-02_r8/) + kao(:, 1, 2, 9) = (/ & + &2.4912e-02_r8,2.2331e-02_r8,2.0288e-02_r8,1.8446e-02_r8,1.6840e-02_r8,1.5437e-02_r8, & + &1.4050e-02_r8,1.2105e-02_r8,9.2979e-03_r8/) + kao(:, 2, 2, 9) = (/ & + &3.0564e-02_r8,2.7515e-02_r8,2.5261e-02_r8,2.3219e-02_r8,2.1400e-02_r8,1.9828e-02_r8, & + &1.8282e-02_r8,1.5938e-02_r8,1.2847e-02_r8/) + kao(:, 3, 2, 9) = (/ & + &3.6716e-02_r8,3.3250e-02_r8,3.0813e-02_r8,2.8576e-02_r8,2.6652e-02_r8,2.4969e-02_r8, & + &2.3242e-02_r8,2.0434e-02_r8,1.7255e-02_r8/) + kao(:, 4, 2, 9) = (/ & + &4.3274e-02_r8,3.9470e-02_r8,3.6945e-02_r8,3.4546e-02_r8,3.2567e-02_r8,3.0902e-02_r8, & + &2.8990e-02_r8,2.5608e-02_r8,2.2622e-02_r8/) + kao(:, 5, 2, 9) = (/ & + &5.0151e-02_r8,4.6154e-02_r8,4.3548e-02_r8,4.1147e-02_r8,3.9208e-02_r8,3.7617e-02_r8, & + &3.5476e-02_r8,3.1506e-02_r8,2.9070e-02_r8/) + kao(:, 1, 3, 9) = (/ & + &4.5824e-02_r8,4.0428e-02_r8,3.5360e-02_r8,3.0531e-02_r8,2.5873e-02_r8,2.1515e-02_r8, & + &1.7437e-02_r8,1.3182e-02_r8,7.2135e-03_r8/) + kao(:, 2, 3, 9) = (/ & + &5.7122e-02_r8,5.0441e-02_r8,4.4296e-02_r8,3.8535e-02_r8,3.2887e-02_r8,2.7626e-02_r8, & + &2.2637e-02_r8,1.7470e-02_r8,1.0156e-02_r8/) + kao(:, 3, 3, 9) = (/ & + &6.9514e-02_r8,6.1484e-02_r8,5.4267e-02_r8,4.7520e-02_r8,4.0893e-02_r8,3.4647e-02_r8, & + &2.8731e-02_r8,2.2576e-02_r8,1.3878e-02_r8/) + kao(:, 4, 3, 9) = (/ & + &8.2919e-02_r8,7.3512e-02_r8,6.5273e-02_r8,5.7524e-02_r8,4.9783e-02_r8,4.2603e-02_r8, & + &3.5784e-02_r8,2.8563e-02_r8,1.8502e-02_r8/) + kao(:, 5, 3, 9) = (/ & + &9.7170e-02_r8,8.6431e-02_r8,7.7261e-02_r8,6.8346e-02_r8,5.9584e-02_r8,5.1514e-02_r8, & + &4.3768e-02_r8,3.5379e-02_r8,2.4141e-02_r8/) + kao(:, 1, 4, 9) = (/ & + &8.5028e-02_r8,7.4675e-02_r8,6.4408e-02_r8,5.4349e-02_r8,4.4385e-02_r8,3.4667e-02_r8, & + &2.5298e-02_r8,1.6347e-02_r8,5.3723e-03_r8/) + kao(:, 2, 4, 9) = (/ & + &1.0799e-01_r8,9.4832e-02_r8,8.1887e-02_r8,6.9265e-02_r8,5.6849e-02_r8,4.4649e-02_r8, & + &3.2963e-02_r8,2.1613e-02_r8,7.7235e-03_r8/) + kao(:, 3, 4, 9) = (/ & + &1.3350e-01_r8,1.1723e-01_r8,1.0141e-01_r8,8.6053e-02_r8,7.1006e-02_r8,5.6113e-02_r8, & + &4.1792e-02_r8,2.7868e-02_r8,1.0747e-02_r8/) + kao(:, 4, 4, 9) = (/ & + &1.6142e-01_r8,1.4180e-01_r8,1.2297e-01_r8,1.0476e-01_r8,8.6810e-02_r8,6.8956e-02_r8, & + &5.1841e-02_r8,3.5143e-02_r8,1.4564e-02_r8/) + kao(:, 5, 4, 9) = (/ & + &1.9126e-01_r8,1.6822e-01_r8,1.4629e-01_r8,1.2515e-01_r8,1.0422e-01_r8,8.3176e-02_r8, & + &6.3089e-02_r8,4.3500e-02_r8,1.9267e-02_r8/) + kao(:, 1, 5, 9) = (/ & + &1.4488e-01_r8,1.2702e-01_r8,1.0917e-01_r8,9.1352e-02_r8,7.3672e-02_r8,5.6082e-02_r8, & + &3.8867e-02_r8,2.2212e-02_r8,3.9357e-03_r8/) + kao(:, 2, 5, 9) = (/ & + &1.8767e-01_r8,1.6453e-01_r8,1.4140e-01_r8,1.1846e-01_r8,9.5672e-02_r8,7.3107e-02_r8, & + &5.0961e-02_r8,2.9559e-02_r8,5.7686e-03_r8/) + kao(:, 3, 5, 9) = (/ & + &2.3604e-01_r8,2.0693e-01_r8,1.7791e-01_r8,1.4922e-01_r8,1.2079e-01_r8,9.2713e-02_r8, & + &6.4987e-02_r8,3.8154e-02_r8,8.1725e-03_r8/) + kao(:, 4, 5, 9) = (/ & + &2.8921e-01_r8,2.5355e-01_r8,2.1818e-01_r8,1.8330e-01_r8,1.4882e-01_r8,1.1469e-01_r8, & + &8.0893e-02_r8,4.8061e-02_r8,1.1257e-02_r8/) + kao(:, 5, 5, 9) = (/ & + &3.4679e-01_r8,3.0409e-01_r8,2.6204e-01_r8,2.2057e-01_r8,1.7963e-01_r8,1.3899e-01_r8, & + &9.8558e-02_r8,5.9364e-02_r8,1.5113e-02_r8/) + kao(:, 1, 6, 9) = (/ & + &2.2687e-01_r8,1.9870e-01_r8,1.7053e-01_r8,1.4235e-01_r8,1.1424e-01_r8,8.6261e-02_r8, & + &5.8407e-02_r8,3.1198e-02_r8,2.7719e-03_r8/) + kao(:, 2, 6, 9) = (/ & + &3.0049e-01_r8,2.6318e-01_r8,2.2586e-01_r8,1.8856e-01_r8,1.5147e-01_r8,1.1450e-01_r8, & + &7.7818e-02_r8,4.1952e-02_r8,4.1659e-03_r8/) + kao(:, 3, 6, 9) = (/ & + &3.8494e-01_r8,3.3714e-01_r8,2.8934e-01_r8,2.4170e-01_r8,1.9431e-01_r8,1.4714e-01_r8, & + &1.0048e-01_r8,5.4667e-02_r8,6.0249e-03_r8/) + kao(:, 4, 6, 9) = (/ & + &4.7888e-01_r8,4.1941e-01_r8,3.6000e-01_r8,3.0097e-01_r8,2.4222e-01_r8,1.8390e-01_r8, & + &1.2612e-01_r8,6.9245e-02_r8,8.4412e-03_r8/) + kao(:, 5, 6, 9) = (/ & + &5.8181e-01_r8,5.0960e-01_r8,4.3765e-01_r8,3.6614e-01_r8,2.9513e-01_r8,2.2467e-01_r8, & + &1.5478e-01_r8,8.5677e-02_r8,1.1500e-02_r8/) + kao(:, 1, 7, 9) = (/ & + &3.6399e-01_r8,3.1864e-01_r8,2.7330e-01_r8,2.2796e-01_r8,1.8261e-01_r8,1.3731e-01_r8, & + &9.2161e-02_r8,4.7386e-02_r8,1.8335e-03_r8/) + kao(:, 2, 7, 9) = (/ & + &4.9404e-01_r8,4.3249e-01_r8,3.7094e-01_r8,3.0937e-01_r8,2.4784e-01_r8,1.8651e-01_r8, & + &1.2531e-01_r8,6.4814e-02_r8,2.9040e-03_r8/) + kao(:, 3, 7, 9) = (/ & + &6.4560e-01_r8,5.6518e-01_r8,4.8472e-01_r8,4.0430e-01_r8,3.2403e-01_r8,2.4402e-01_r8, & + &1.6421e-01_r8,8.5452e-02_r8,4.3365e-03_r8/) + kao(:, 4, 7, 9) = (/ & + &8.1690e-01_r8,7.1513e-01_r8,6.1336e-01_r8,5.1171e-01_r8,4.1038e-01_r8,3.0928e-01_r8, & + &2.0863e-01_r8,1.0932e-01_r8,6.1934e-03_r8/) + kao(:, 5, 7, 9) = (/ & + &1.0068e+00_r8,8.8147e-01_r8,7.5616e-01_r8,6.3106e-01_r8,5.0635e-01_r8,3.8205e-01_r8, & + &2.5843e-01_r8,1.3634e-01_r8,8.5588e-03_r8/) + kao(:, 1, 8, 9) = (/ & + &6.8384e-01_r8,5.9848e-01_r8,5.1310e-01_r8,4.2775e-01_r8,3.4242e-01_r8,2.5705e-01_r8, & + &1.7171e-01_r8,8.6607e-02_r8,8.9761e-04_r8/) + kao(:, 2, 8, 9) = (/ & + &9.5272e-01_r8,8.3382e-01_r8,7.1490e-01_r8,5.9597e-01_r8,4.7702e-01_r8,3.5811e-01_r8, & + &2.3935e-01_r8,1.2088e-01_r8,1.5768e-03_r8/) + kao(:, 3, 8, 9) = (/ & + &1.2716e+00_r8,1.1128e+00_r8,9.5409e-01_r8,7.9538e-01_r8,6.3666e-01_r8,4.7804e-01_r8, & + &3.1975e-01_r8,1.6179e-01_r8,2.6889e-03_r8/) + kao(:, 4, 8, 9) = (/ & + &1.6381e+00_r8,1.4337e+00_r8,1.2291e+00_r8,1.0247e+00_r8,8.2031e-01_r8,6.1622e-01_r8, & + &4.1239e-01_r8,2.0929e-01_r8,4.1353e-03_r8/) + kao(:, 5, 8, 9) = (/ & + &2.0497e+00_r8,1.7940e+00_r8,1.5381e+00_r8,1.2824e+00_r8,1.0268e+00_r8,7.7156e-01_r8, & + &5.1676e-01_r8,2.6319e-01_r8,6.0327e-03_r8/) + kao(:, 1, 9, 9) = (/ & + &2.3562e+00_r8,2.0618e+00_r8,1.7675e+00_r8,1.4730e+00_r8,1.1786e+00_r8,8.8409e-01_r8, & + &5.8968e-01_r8,2.9523e-01_r8,7.8820e-04_r8/) + kao(:, 2, 9, 9) = (/ & + &3.3780e+00_r8,2.9558e+00_r8,2.5337e+00_r8,2.1117e+00_r8,1.6896e+00_r8,1.2675e+00_r8, & + &8.4537e-01_r8,4.2322e-01_r8,1.1025e-03_r8/) + kao(:, 3, 9, 9) = (/ & + &4.6138e+00_r8,4.0373e+00_r8,3.4607e+00_r8,2.8840e+00_r8,2.3076e+00_r8,1.7311e+00_r8, & + &1.1546e+00_r8,5.7817e-01_r8,1.6643e-03_r8/) + kao(:, 4, 9, 9) = (/ & + &6.0608e+00_r8,5.3032e+00_r8,4.5462e+00_r8,3.7886e+00_r8,3.0313e+00_r8,2.2740e+00_r8, & + &1.5168e+00_r8,7.6000e-01_r8,2.3974e-03_r8/) + kao(:, 5, 9, 9) = (/ & + &7.7085e+00_r8,6.7454e+00_r8,5.7823e+00_r8,4.8189e+00_r8,3.8558e+00_r8,2.8925e+00_r8, & + &1.9295e+00_r8,9.6718e-01_r8,3.2535e-03_r8/) + kao(:, 1,10, 9) = (/ & + &9.1055e+00_r8,7.9675e+00_r8,6.8292e+00_r8,5.6913e+00_r8,4.5531e+00_r8,3.4149e+00_r8, & + &2.2769e+00_r8,1.1388e+00_r8,5.8809e-04_r8/) + kao(:, 2,10, 9) = (/ & + &1.3404e+01_r8,1.1729e+01_r8,1.0053e+01_r8,8.3780e+00_r8,6.7024e+00_r8,5.0271e+00_r8, & + &3.3517e+00_r8,1.6763e+00_r8,9.0563e-04_r8/) + kao(:, 3,10, 9) = (/ & + &1.8696e+01_r8,1.6359e+01_r8,1.4022e+01_r8,1.1685e+01_r8,9.3484e+00_r8,7.0117e+00_r8, & + &4.6747e+00_r8,2.3381e+00_r8,1.7881e-03_r8/) + kao(:, 4,10, 9) = (/ & + &2.4995e+01_r8,2.1869e+01_r8,1.8747e+01_r8,1.5622e+01_r8,1.2498e+01_r8,9.3741e+00_r8, & + &6.2500e+00_r8,3.1259e+00_r8,3.1813e-03_r8/) + kao(:, 5,10, 9) = (/ & + &3.2273e+01_r8,2.8239e+01_r8,2.4206e+01_r8,2.0172e+01_r8,1.6138e+01_r8,1.2104e+01_r8, & + &8.0701e+00_r8,4.0364e+00_r8,3.7345e-03_r8/) + kao(:, 1,11, 9) = (/ & + &1.4610e+01_r8,1.2784e+01_r8,1.0958e+01_r8,9.1318e+00_r8,7.3053e+00_r8,5.4792e+00_r8, & + &3.6529e+00_r8,1.8269e+00_r8,9.3673e-05_r8/) + kao(:, 2,11, 9) = (/ & + &2.1482e+01_r8,1.8797e+01_r8,1.6112e+01_r8,1.3427e+01_r8,1.0742e+01_r8,8.0564e+00_r8, & + &5.3711e+00_r8,2.6860e+00_r8,1.0848e-03_r8/) + kao(:, 3,11, 9) = (/ & + &2.9982e+01_r8,2.6234e+01_r8,2.2487e+01_r8,1.8739e+01_r8,1.4992e+01_r8,1.1244e+01_r8, & + &7.4965e+00_r8,3.7489e+00_r8,1.4593e-03_r8/) + kao(:, 4,11, 9) = (/ & + &4.0102e+01_r8,3.5090e+01_r8,3.0079e+01_r8,2.5065e+01_r8,2.0053e+01_r8,1.5039e+01_r8, & + &1.0027e+01_r8,5.0144e+00_r8,2.0582e-03_r8/) + kao(:, 5,11, 9) = (/ & + &5.1873e+01_r8,4.5387e+01_r8,3.8905e+01_r8,3.2421e+01_r8,2.5937e+01_r8,1.9453e+01_r8, & + &1.2970e+01_r8,6.4862e+00_r8,4.4703e-03_r8/) + kao(:, 1,12, 9) = (/ & + &1.7189e+01_r8,1.5041e+01_r8,1.2892e+01_r8,1.0744e+01_r8,8.5949e+00_r8,6.4462e+00_r8, & + &4.2976e+00_r8,2.1491e+00_r8,3.9266e-05_r8/) + kao(:, 2,12, 9) = (/ & + &2.5282e+01_r8,2.2121e+01_r8,1.8962e+01_r8,1.5801e+01_r8,1.2641e+01_r8,9.4811e+00_r8, & + &6.3210e+00_r8,3.1609e+00_r8,6.4444e-04_r8/) + kao(:, 3,12, 9) = (/ & + &3.5289e+01_r8,3.0879e+01_r8,2.6468e+01_r8,2.2056e+01_r8,1.7646e+01_r8,1.3235e+01_r8, & + &8.8231e+00_r8,4.4124e+00_r8,1.8228e-03_r8/) + kao(:, 4,12, 9) = (/ & + &4.7291e+01_r8,4.1381e+01_r8,3.5468e+01_r8,2.9558e+01_r8,2.3647e+01_r8,1.7735e+01_r8, & + &1.1825e+01_r8,5.9130e+00_r8,2.3757e-03_r8/) + kao(:, 5,12, 9) = (/ & + &6.1297e+01_r8,5.3636e+01_r8,4.5972e+01_r8,3.8311e+01_r8,3.0649e+01_r8,2.2988e+01_r8, & + &1.5326e+01_r8,7.6642e+00_r8,3.9341e-03_r8/) + kao(:, 1,13, 9) = (/ & + &1.6000e+01_r8,1.4000e+01_r8,1.2000e+01_r8,9.9998e+00_r8,8.0002e+00_r8,6.0002e+00_r8, & + &4.0003e+00_r8,2.0005e+00_r8,3.8486e-05_r8/) + kao(:, 2,13, 9) = (/ & + &2.3551e+01_r8,2.0607e+01_r8,1.7663e+01_r8,1.4719e+01_r8,1.1776e+01_r8,8.8325e+00_r8, & + &5.8883e+00_r8,2.9447e+00_r8,5.3945e-04_r8/) + kao(:, 3,13, 9) = (/ & + &3.2950e+01_r8,2.8830e+01_r8,2.4711e+01_r8,2.0594e+01_r8,1.6475e+01_r8,1.2356e+01_r8, & + &8.2382e+00_r8,4.1197e+00_r8,1.7722e-03_r8/) + kao(:, 4,13, 9) = (/ & + &4.4263e+01_r8,3.8730e+01_r8,3.3198e+01_r8,2.7666e+01_r8,2.2132e+01_r8,1.6600e+01_r8, & + &1.1067e+01_r8,5.5345e+00_r8,2.5081e-03_r8/) + kao(:, 5,13, 9) = (/ & + &5.7461e+01_r8,5.0277e+01_r8,4.3096e+01_r8,3.5913e+01_r8,2.8731e+01_r8,2.1549e+01_r8, & + &1.4366e+01_r8,7.1843e+00_r8,4.3602e-03_r8/) + kao(:, 1, 1,10) = (/ & + &4.8312e-02_r8,4.2395e-02_r8,3.7029e-02_r8,3.4268e-02_r8,3.1631e-02_r8,2.8012e-02_r8, & + &2.4227e-02_r8,1.9340e-02_r8,2.3819e-02_r8/) + kao(:, 2, 1,10) = (/ & + &5.7978e-02_r8,5.0880e-02_r8,4.5259e-02_r8,4.2684e-02_r8,3.9233e-02_r8,3.5182e-02_r8, & + &3.0643e-02_r8,2.5810e-02_r8,3.1295e-02_r8/) + kao(:, 3, 1,10) = (/ & + &6.8091e-02_r8,5.9773e-02_r8,5.4735e-02_r8,5.1517e-02_r8,4.7810e-02_r8,4.2960e-02_r8, & + &3.8310e-02_r8,3.3678e-02_r8,4.0832e-02_r8/) + kao(:, 4, 1,10) = (/ & + &7.8444e-02_r8,6.8870e-02_r8,6.5474e-02_r8,6.0764e-02_r8,5.6861e-02_r8,5.2020e-02_r8, & + &4.6525e-02_r8,4.3019e-02_r8,5.3025e-02_r8/) + kao(:, 5, 1,10) = (/ & + &8.8955e-02_r8,7.8190e-02_r8,7.6227e-02_r8,7.0877e-02_r8,6.6771e-02_r8,6.2214e-02_r8, & + &5.5680e-02_r8,5.4857e-02_r8,6.6965e-02_r8/) + kao(:, 1, 2,10) = (/ & + &6.8494e-02_r8,6.0019e-02_r8,5.1535e-02_r8,4.5753e-02_r8,4.0717e-02_r8,3.4636e-02_r8, & + &2.8735e-02_r8,2.2359e-02_r8,2.2396e-02_r8/) + kao(:, 2, 2,10) = (/ & + &8.3057e-02_r8,7.2786e-02_r8,6.2703e-02_r8,5.6353e-02_r8,5.0990e-02_r8,4.3733e-02_r8, & + &3.6309e-02_r8,2.8660e-02_r8,2.9863e-02_r8/) + kao(:, 3, 2,10) = (/ & + &9.8445e-02_r8,8.6268e-02_r8,7.5172e-02_r8,6.9101e-02_r8,6.1861e-02_r8,5.3608e-02_r8, & + &4.5462e-02_r8,3.5628e-02_r8,3.9584e-02_r8/) + kao(:, 4, 2,10) = (/ & + &1.1465e-01_r8,1.0047e-01_r8,8.9322e-02_r8,8.2399e-02_r8,7.3847e-02_r8,6.4459e-02_r8, & + &5.5729e-02_r8,4.5259e-02_r8,5.1011e-02_r8/) + kao(:, 5, 2,10) = (/ & + &1.3121e-01_r8,1.1499e-01_r8,1.0547e-01_r8,9.5942e-02_r8,8.6700e-02_r8,7.6912e-02_r8, & + &6.7683e-02_r8,5.7087e-02_r8,6.4331e-02_r8/) + kao(:, 1, 3,10) = (/ & + &1.2396e-01_r8,1.0851e-01_r8,9.3078e-02_r8,7.7936e-02_r8,6.5430e-02_r8,5.3555e-02_r8, & + &4.0149e-02_r8,2.8165e-02_r8,1.9103e-02_r8/) + kao(:, 2, 3,10) = (/ & + &1.5308e-01_r8,1.3401e-01_r8,1.1495e-01_r8,9.6317e-02_r8,8.2061e-02_r8,6.7720e-02_r8, & + &5.1563e-02_r8,3.6346e-02_r8,2.6147e-02_r8/) + kao(:, 3, 3,10) = (/ & + &1.8438e-01_r8,1.6143e-01_r8,1.3846e-01_r8,1.1685e-01_r8,1.0065e-01_r8,8.3573e-02_r8, & + &6.4169e-02_r8,4.6273e-02_r8,3.5249e-02_r8/) + kao(:, 4, 3,10) = (/ & + &2.1730e-01_r8,1.9024e-01_r8,1.6317e-01_r8,1.3937e-01_r8,1.2182e-01_r8,1.0076e-01_r8, & + &7.7802e-02_r8,5.7458e-02_r8,4.6106e-02_r8/) + kao(:, 5, 3,10) = (/ & + &2.5114e-01_r8,2.1989e-01_r8,1.8862e-01_r8,1.6558e-01_r8,1.4330e-01_r8,1.1936e-01_r8, & + &9.3594e-02_r8,7.0438e-02_r8,5.9048e-02_r8/) + kao(:, 1, 4,10) = (/ & + &2.2307e-01_r8,1.9520e-01_r8,1.6737e-01_r8,1.3960e-01_r8,1.1281e-01_r8,8.7662e-02_r8, & + &6.3355e-02_r8,3.7440e-02_r8,1.5143e-02_r8/) + kao(:, 2, 4,10) = (/ & + &2.8121e-01_r8,2.4610e-01_r8,2.1101e-01_r8,1.7601e-01_r8,1.4219e-01_r8,1.1180e-01_r8, & + &8.0961e-02_r8,4.9348e-02_r8,2.1248e-02_r8/) + kao(:, 3, 4,10) = (/ & + &3.4426e-01_r8,3.0128e-01_r8,2.5831e-01_r8,2.1545e-01_r8,1.7407e-01_r8,1.3850e-01_r8, & + &1.0170e-01_r8,6.2450e-02_r8,2.9486e-02_r8/) + kao(:, 4, 4,10) = (/ & + &4.1162e-01_r8,3.6021e-01_r8,3.0885e-01_r8,2.5755e-01_r8,2.0938e-01_r8,1.6873e-01_r8, & + &1.2428e-01_r8,7.7637e-02_r8,3.9623e-02_r8/) + kao(:, 5, 4,10) = (/ & + &4.8400e-01_r8,4.2357e-01_r8,3.6318e-01_r8,3.0275e-01_r8,2.4837e-01_r8,2.0175e-01_r8, & + &1.4904e-01_r8,9.5123e-02_r8,5.2032e-02_r8/) + kao(:, 1, 5,10) = (/ & + &3.6240e-01_r8,3.1713e-01_r8,2.7189e-01_r8,2.2715e-01_r8,1.8287e-01_r8,1.3915e-01_r8, & + &9.6038e-02_r8,5.3151e-02_r8,1.1469e-02_r8/) + kao(:, 2, 5,10) = (/ & + &4.6684e-01_r8,4.0853e-01_r8,3.5029e-01_r8,2.9260e-01_r8,2.3543e-01_r8,1.7892e-01_r8, & + &1.2501e-01_r8,6.9710e-02_r8,1.6590e-02_r8/) + kao(:, 3, 5,10) = (/ & + &5.8305e-01_r8,5.1017e-01_r8,4.3746e-01_r8,3.6540e-01_r8,2.9385e-01_r8,2.2314e-01_r8, & + &1.5770e-01_r8,8.9552e-02_r8,2.3682e-02_r8/) + kao(:, 4, 5,10) = (/ & + &7.1039e-01_r8,6.2164e-01_r8,5.3285e-01_r8,4.4486e-01_r8,3.5759e-01_r8,2.7242e-01_r8, & + &1.9452e-01_r8,1.1176e-01_r8,3.2616e-02_r8/) + kao(:, 5, 5,10) = (/ & + &8.4585e-01_r8,7.4016e-01_r8,6.3454e-01_r8,5.2965e-01_r8,4.2558e-01_r8,3.2651e-01_r8, & + &2.3601e-01_r8,1.3577e-01_r8,4.3721e-02_r8/) + kao(:, 1, 6,10) = (/ & + &5.4565e-01_r8,4.7774e-01_r8,4.0998e-01_r8,3.4242e-01_r8,2.7503e-01_r8,2.0802e-01_r8, & + &1.4092e-01_r8,7.4294e-02_r8,8.5994e-03_r8/) + kao(:, 2, 6,10) = (/ & + &7.2281e-01_r8,6.3285e-01_r8,5.4312e-01_r8,4.5353e-01_r8,3.6423e-01_r8,2.7526e-01_r8, & + &1.8607e-01_r8,9.8990e-02_r8,1.2620e-02_r8/) + kao(:, 3, 6,10) = (/ & + &9.2293e-01_r8,8.0812e-01_r8,6.9347e-01_r8,5.7897e-01_r8,4.6479e-01_r8,3.5103e-01_r8, & + &2.3728e-01_r8,1.2747e-01_r8,1.8407e-02_r8/) + kao(:, 4, 6,10) = (/ & + &1.1448e+00_r8,1.0023e+00_r8,8.6003e-01_r8,7.1795e-01_r8,5.7619e-01_r8,4.3493e-01_r8, & + &2.9519e-01_r8,1.6083e-01_r8,2.5918e-02_r8/) + kao(:, 5, 6,10) = (/ & + &1.3870e+00_r8,1.2144e+00_r8,1.0419e+00_r8,8.6977e-01_r8,6.9789e-01_r8,5.2651e-01_r8, & + &3.5987e-01_r8,1.9795e-01_r8,3.5516e-02_r8/) + kao(:, 1, 7,10) = (/ & + &9.0563e-01_r8,7.9294e-01_r8,6.8033e-01_r8,5.6775e-01_r8,4.5526e-01_r8,3.4288e-01_r8, & + &2.2993e-01_r8,1.1636e-01_r8,6.3281e-03_r8/) + kao(:, 2, 7,10) = (/ & + &1.2304e+00_r8,1.0774e+00_r8,9.2435e-01_r8,7.7129e-01_r8,6.1846e-01_r8,4.6574e-01_r8, & + &3.1230e-01_r8,1.5802e-01_r8,9.6345e-03_r8/) + kao(:, 3, 7,10) = (/ & + &1.6067e+00_r8,1.4068e+00_r8,1.2068e+00_r8,1.0069e+00_r8,8.0717e-01_r8,6.0759e-01_r8, & + &4.0707e-01_r8,2.0698e-01_r8,1.4230e-02_r8/) + kao(:, 4, 7,10) = (/ & + &2.0379e+00_r8,1.7842e+00_r8,1.5305e+00_r8,1.2770e+00_r8,1.0235e+00_r8,7.6992e-01_r8, & + &5.1539e-01_r8,2.6359e-01_r8,2.0362e-02_r8/) + kao(:, 5, 7,10) = (/ & + &2.5042e+00_r8,2.1925e+00_r8,1.8806e+00_r8,1.5690e+00_r8,1.2574e+00_r8,9.4558e-01_r8, & + &6.3281e-01_r8,3.2569e-01_r8,2.8537e-02_r8/) + kao(:, 1, 8,10) = (/ & + &1.8551e+00_r8,1.6239e+00_r8,1.3926e+00_r8,1.1613e+00_r8,9.2995e-01_r8,6.9848e-01_r8, & + &4.6667e-01_r8,2.3461e-01_r8,3.7282e-03_r8/) + kao(:, 2, 8,10) = (/ & + &2.5887e+00_r8,2.2659e+00_r8,1.9430e+00_r8,1.6201e+00_r8,1.2969e+00_r8,9.7383e-01_r8, & + &6.5051e-01_r8,3.2684e-01_r8,7.1685e-03_r8/) + kao(:, 3, 8,10) = (/ & + &3.4601e+00_r8,3.0282e+00_r8,2.5964e+00_r8,2.1645e+00_r8,1.7327e+00_r8,1.3007e+00_r8, & + &8.6869e-01_r8,4.3618e-01_r8,1.0869e-02_r8/) + kao(:, 4, 8,10) = (/ & + &4.4635e+00_r8,3.9062e+00_r8,3.3492e+00_r8,2.7923e+00_r8,2.2350e+00_r8,1.6778e+00_r8, & + &1.1202e+00_r8,5.6241e-01_r8,1.5855e-02_r8/) + kao(:, 5, 8,10) = (/ & + &5.5614e+00_r8,4.8670e+00_r8,4.1730e+00_r8,3.4788e+00_r8,2.7845e+00_r8,2.0899e+00_r8, & + &1.3954e+00_r8,7.0042e-01_r8,2.2369e-02_r8/) + kao(:, 1, 9,10) = (/ & + &7.0057e+00_r8,6.1306e+00_r8,5.2555e+00_r8,4.3802e+00_r8,3.5047e+00_r8,2.6291e+00_r8, & + &1.7537e+00_r8,8.7821e-01_r8,2.6651e-03_r8/) + kao(:, 2, 9,10) = (/ & + &1.0071e+01_r8,8.8120e+00_r8,7.5539e+00_r8,6.2955e+00_r8,5.0368e+00_r8,3.7786e+00_r8, & + &2.5204e+00_r8,1.2618e+00_r8,3.6187e-03_r8/) + kao(:, 3, 9,10) = (/ & + &1.3793e+01_r8,1.2069e+01_r8,1.0345e+01_r8,8.6215e+00_r8,6.8979e+00_r8,5.1747e+00_r8, & + &3.4512e+00_r8,1.7274e+00_r8,5.0886e-03_r8/) + kao(:, 4, 9,10) = (/ & + &1.8095e+01_r8,1.5834e+01_r8,1.3574e+01_r8,1.1311e+01_r8,9.0505e+00_r8,6.7893e+00_r8, & + &4.5277e+00_r8,2.2659e+00_r8,6.6445e-03_r8/) + kao(:, 5, 9,10) = (/ & + &2.2909e+01_r8,2.0046e+01_r8,1.7183e+01_r8,1.4320e+01_r8,1.1458e+01_r8,8.5941e+00_r8, & + &5.7315e+00_r8,2.8684e+00_r8,1.0715e-02_r8/) + kao(:, 1,10,10) = (/ & + &2.9637e+01_r8,2.5932e+01_r8,2.2227e+01_r8,1.8524e+01_r8,1.4818e+01_r8,1.1115e+01_r8, & + &7.4105e+00_r8,3.7062e+00_r8,1.7663e-03_r8/) + kao(:, 2,10,10) = (/ & + &4.3734e+01_r8,3.8266e+01_r8,3.2801e+01_r8,2.7334e+01_r8,2.1867e+01_r8,1.6402e+01_r8, & + &1.0936e+01_r8,5.4691e+00_r8,2.0817e-03_r8/) + kao(:, 3,10,10) = (/ & + &6.1232e+01_r8,5.3576e+01_r8,4.5921e+01_r8,3.8272e+01_r8,3.0616e+01_r8,2.2963e+01_r8, & + &1.5310e+01_r8,7.6576e+00_r8,1.7504e-03_r8/) + kao(:, 4,10,10) = (/ & + &8.1674e+01_r8,7.1459e+01_r8,6.1256e+01_r8,5.1048e+01_r8,4.0839e+01_r8,3.0631e+01_r8, & + &2.0421e+01_r8,1.0211e+01_r8,7.5551e-03_r8/) + kao(:, 5,10,10) = (/ & + &1.0484e+02_r8,9.1726e+01_r8,7.8618e+01_r8,6.5522e+01_r8,5.2414e+01_r8,3.9315e+01_r8, & + &2.6210e+01_r8,1.3108e+01_r8,1.2092e-02_r8/) + kao(:, 1,11,10) = (/ & + &5.2035e+01_r8,4.5533e+01_r8,3.9026e+01_r8,3.2522e+01_r8,2.6019e+01_r8,1.9514e+01_r8, & + &1.3010e+01_r8,6.5060e+00_r8,2.3377e-05_r8/) + kao(:, 2,11,10) = (/ & + &7.6878e+01_r8,6.7270e+01_r8,5.7660e+01_r8,4.8051e+01_r8,3.8444e+01_r8,2.8832e+01_r8, & + &1.9221e+01_r8,9.6129e+00_r8,3.4131e-05_r8/) + kao(:, 3,11,10) = (/ & + &1.0695e+02_r8,9.3584e+01_r8,8.0221e+01_r8,6.6851e+01_r8,5.3480e+01_r8,4.0109e+01_r8, & + &2.6742e+01_r8,1.3372e+01_r8,6.5532e-03_r8/) + kao(:, 4,11,10) = (/ & + &1.4204e+02_r8,1.2428e+02_r8,1.0653e+02_r8,8.8779e+01_r8,7.1025e+01_r8,5.3267e+01_r8, & + &3.5513e+01_r8,1.7760e+01_r8,3.6230e-03_r8/) + kao(:, 5,11,10) = (/ & + &1.8146e+02_r8,1.5877e+02_r8,1.3608e+02_r8,1.1341e+02_r8,9.0723e+01_r8,6.8041e+01_r8, & + &4.5364e+01_r8,2.2685e+01_r8,5.3060e-03_r8/) + kao(:, 1,12,10) = (/ & + &6.6709e+01_r8,5.8372e+01_r8,5.0033e+01_r8,4.1695e+01_r8,3.3357e+01_r8,2.5018e+01_r8, & + &1.6679e+01_r8,8.3409e+00_r8,1.6896e-05_r8/) + kao(:, 2,12,10) = (/ & + &9.8021e+01_r8,8.5767e+01_r8,7.3510e+01_r8,6.1263e+01_r8,4.9006e+01_r8,3.6758e+01_r8, & + &2.4506e+01_r8,1.2254e+01_r8,2.4443e-05_r8/) + kao(:, 3,12,10) = (/ & + &1.3575e+02_r8,1.1880e+02_r8,1.0183e+02_r8,8.4855e+01_r8,6.7883e+01_r8,5.0907e+01_r8, & + &3.3942e+01_r8,1.6972e+01_r8,3.9041e-05_r8/) + kao(:, 4,12,10) = (/ & + &1.7930e+02_r8,1.5689e+02_r8,1.3447e+02_r8,1.1206e+02_r8,8.9651e+01_r8,6.7236e+01_r8, & + &4.4831e+01_r8,2.2414e+01_r8,2.5406e-03_r8/) + kao(:, 5,12,10) = (/ & + &2.2752e+02_r8,1.9909e+02_r8,1.7067e+02_r8,1.4220e+02_r8,1.1376e+02_r8,8.5325e+01_r8, & + &5.6889e+01_r8,2.8448e+01_r8,5.4913e-03_r8/) + kao(:, 1,13,10) = (/ & + &6.7103e+01_r8,5.8720e+01_r8,5.0329e+01_r8,4.1943e+01_r8,3.3555e+01_r8,2.5165e+01_r8, & + &1.6777e+01_r8,8.3902e+00_r8,1.5511e-05_r8/) + kao(:, 2,13,10) = (/ & + &9.7787e+01_r8,8.5564e+01_r8,7.3344e+01_r8,6.1125e+01_r8,4.8896e+01_r8,3.6672e+01_r8, & + &2.4451e+01_r8,1.2226e+01_r8,2.1977e-05_r8/) + kao(:, 3,13,10) = (/ & + &1.3463e+02_r8,1.1780e+02_r8,1.0097e+02_r8,8.4145e+01_r8,6.7313e+01_r8,5.0486e+01_r8, & + &3.3658e+01_r8,1.6832e+01_r8,3.2342e-05_r8/) + kao(:, 4,13,10) = (/ & + &1.7688e+02_r8,1.5477e+02_r8,1.3267e+02_r8,1.1056e+02_r8,8.8438e+01_r8,6.6334e+01_r8, & + &4.4220e+01_r8,2.2113e+01_r8,5.6189e-03_r8/) + kao(:, 5,13,10) = (/ & + &2.2476e+02_r8,1.9667e+02_r8,1.6857e+02_r8,1.4047e+02_r8,1.1238e+02_r8,8.4289e+01_r8, & + &5.6195e+01_r8,2.8100e+01_r8,6.0459e-03_r8/) + kao(:, 1, 1,11) = (/ & + &6.9001e-02_r8,6.0529e-02_r8,5.2064e-02_r8,4.5590e-02_r8,4.0628e-02_r8,3.5945e-02_r8, & + &2.9389e-02_r8,2.3144e-02_r8,2.9176e-02_r8/) + kao(:, 2, 1,11) = (/ & + &8.2103e-02_r8,7.2020e-02_r8,6.1937e-02_r8,5.5694e-02_r8,5.0508e-02_r8,4.4515e-02_r8, & + &3.6553e-02_r8,3.0757e-02_r8,3.9695e-02_r8/) + kao(:, 3, 1,11) = (/ & + &9.5630e-02_r8,8.3878e-02_r8,7.2481e-02_r8,6.7965e-02_r8,6.0680e-02_r8,5.4180e-02_r8, & + &4.4143e-02_r8,4.0422e-02_r8,5.1968e-02_r8/) + kao(:, 4, 1,11) = (/ & + &1.0928e-01_r8,9.5880e-02_r8,8.4382e-02_r8,8.0469e-02_r8,7.1798e-02_r8,6.4108e-02_r8, & + &5.3608e-02_r8,5.2409e-02_r8,6.6870e-02_r8/) + kao(:, 5, 1,11) = (/ & + &1.2299e-01_r8,1.0790e-01_r8,9.8888e-02_r8,9.2808e-02_r8,8.4009e-02_r8,7.5069e-02_r8, & + &6.6004e-02_r8,6.6900e-02_r8,8.4455e-02_r8/) + kao(:, 1, 2,11) = (/ & + &1.0031e-01_r8,8.7857e-02_r8,7.5407e-02_r8,6.3060e-02_r8,5.4499e-02_r8,4.6504e-02_r8, & + &3.6770e-02_r8,2.6380e-02_r8,2.8413e-02_r8/) + kao(:, 2, 2,11) = (/ & + &1.2053e-01_r8,1.0559e-01_r8,9.0627e-02_r8,7.6829e-02_r8,6.7033e-02_r8,5.8104e-02_r8, & + &4.6509e-02_r8,3.3638e-02_r8,3.8310e-02_r8/) + kao(:, 3, 2,11) = (/ & + &1.4155e-01_r8,1.2398e-01_r8,1.0644e-01_r8,9.2248e-02_r8,8.1983e-02_r8,7.0441e-02_r8, & + &5.6590e-02_r8,4.3821e-02_r8,5.0130e-02_r8/) + kao(:, 4, 2,11) = (/ & + &1.6305e-01_r8,1.4282e-01_r8,1.2262e-01_r8,1.1049e-01_r8,9.7062e-02_r8,8.3848e-02_r8, & + &6.7975e-02_r8,5.5529e-02_r8,6.5378e-02_r8/) + kao(:, 5, 2,11) = (/ & + &1.8507e-01_r8,1.6212e-01_r8,1.3962e-01_r8,1.2935e-01_r8,1.1281e-01_r8,9.7726e-02_r8, & + &8.0117e-02_r8,6.9954e-02_r8,8.3371e-02_r8/) + kao(:, 1, 3,11) = (/ & + &1.8667e-01_r8,1.6338e-01_r8,1.4010e-01_r8,1.1682e-01_r8,9.3557e-02_r8,7.4325e-02_r8, & + &5.5984e-02_r8,3.5878e-02_r8,2.5531e-02_r8/) + kao(:, 2, 3,11) = (/ & + &2.2795e-01_r8,1.9954e-01_r8,1.7113e-01_r8,1.4270e-01_r8,1.1480e-01_r8,9.2509e-02_r8, & + &7.0623e-02_r8,4.6178e-02_r8,3.4917e-02_r8/) + kao(:, 3, 3,11) = (/ & + &2.7211e-01_r8,2.3816e-01_r8,2.0423e-01_r8,1.7032e-01_r8,1.3866e-01_r8,1.1338e-01_r8, & + &8.6877e-02_r8,5.7191e-02_r8,4.6054e-02_r8/) + kao(:, 4, 3,11) = (/ & + &3.1770e-01_r8,2.7809e-01_r8,2.3849e-01_r8,1.9887e-01_r8,1.6548e-01_r8,1.3614e-01_r8, & + &1.0464e-01_r8,7.0039e-02_r8,6.0217e-02_r8/) + kao(:, 5, 3,11) = (/ & + &3.6403e-01_r8,3.1863e-01_r8,2.7328e-01_r8,2.2795e-01_r8,1.9641e-01_r8,1.5908e-01_r8, & + &1.2312e-01_r8,8.3529e-02_r8,7.7572e-02_r8/) + kao(:, 1, 4,11) = (/ & + &3.4588e-01_r8,3.0268e-01_r8,2.5948e-01_r8,2.1629e-01_r8,1.7307e-01_r8,1.2990e-01_r8, & + &9.1217e-02_r8,5.3135e-02_r8,2.1767e-02_r8/) + kao(:, 2, 4,11) = (/ & + &4.3145e-01_r8,3.7755e-01_r8,3.2366e-01_r8,2.6977e-01_r8,2.1589e-01_r8,1.6201e-01_r8, & + &1.1572e-01_r8,6.8208e-02_r8,3.0409e-02_r8/) + kao(:, 3, 4,11) = (/ & + &5.2311e-01_r8,4.5776e-01_r8,3.9244e-01_r8,3.2707e-01_r8,2.6176e-01_r8,1.9718e-01_r8, & + &1.4225e-01_r8,8.5649e-02_r8,4.0906e-02_r8/) + kao(:, 4, 4,11) = (/ & + &6.1949e-01_r8,5.4214e-01_r8,4.6476e-01_r8,3.8737e-01_r8,3.1001e-01_r8,2.3606e-01_r8, & + &1.7310e-01_r8,1.0459e-01_r8,5.4382e-02_r8/) + kao(:, 5, 4,11) = (/ & + &7.1941e-01_r8,6.2950e-01_r8,5.3975e-01_r8,4.4985e-01_r8,3.6002e-01_r8,2.8013e-01_r8, & + &2.0492e-01_r8,1.2467e-01_r8,7.0400e-02_r8/) + kao(:, 1, 5,11) = (/ & + &5.8048e-01_r8,5.0796e-01_r8,4.3542e-01_r8,3.6286e-01_r8,2.9032e-01_r8,2.1780e-01_r8, & + &1.4642e-01_r8,8.0688e-02_r8,1.7624e-02_r8/) + kao(:, 2, 5,11) = (/ & + &7.4078e-01_r8,6.4817e-01_r8,5.5562e-01_r8,4.6305e-01_r8,3.7047e-01_r8,2.7793e-01_r8, & + &1.8667e-01_r8,1.0393e-01_r8,2.5321e-02_r8/) + kao(:, 3, 5,11) = (/ & + &9.1562e-01_r8,8.0121e-01_r8,6.8680e-01_r8,5.7241e-01_r8,4.5798e-01_r8,3.4354e-01_r8, & + &2.3145e-01_r8,1.3051e-01_r8,3.5008e-02_r8/) + kao(:, 4, 5,11) = (/ & + &1.1041e+00_r8,9.6607e-01_r8,8.2810e-01_r8,6.9018e-01_r8,5.5220e-01_r8,4.1422e-01_r8, & + &2.8137e-01_r8,1.6106e-01_r8,4.7504e-02_r8/) + kao(:, 5, 5,11) = (/ & + &1.3000e+00_r8,1.1374e+00_r8,9.7498e-01_r8,8.1255e-01_r8,6.5013e-01_r8,4.8767e-01_r8, & + &3.3622e-01_r8,1.9350e-01_r8,6.2782e-02_r8/) + kao(:, 1, 6,11) = (/ & + &8.9158e-01_r8,7.8014e-01_r8,6.6870e-01_r8,5.5724e-01_r8,4.4582e-01_r8,3.3441e-01_r8, & + &2.2372e-01_r8,1.1615e-01_r8,1.3452e-02_r8/) + kao(:, 2, 6,11) = (/ & + &1.1678e+00_r8,1.0218e+00_r8,8.7586e-01_r8,7.2991e-01_r8,5.8393e-01_r8,4.3799e-01_r8, & + &2.9305e-01_r8,1.5296e-01_r8,1.9872e-02_r8/) + kao(:, 3, 6,11) = (/ & + &1.4777e+00_r8,1.2930e+00_r8,1.1083e+00_r8,9.2359e-01_r8,7.3888e-01_r8,5.5427e-01_r8, & + &3.7059e-01_r8,1.9566e-01_r8,2.8227e-02_r8/) + kao(:, 4, 6,11) = (/ & + &1.8119e+00_r8,1.5855e+00_r8,1.3592e+00_r8,1.1325e+00_r8,9.0614e-01_r8,6.7964e-01_r8, & + &4.5430e-01_r8,2.4269e-01_r8,3.9342e-02_r8/) + kao(:, 5, 6,11) = (/ & + &2.1657e+00_r8,1.8951e+00_r8,1.6242e+00_r8,1.3536e+00_r8,1.0830e+00_r8,8.1233e-01_r8, & + &5.4303e-01_r8,2.9520e-01_r8,5.3415e-02_r8/) + kao(:, 1, 7,11) = (/ & + &1.4142e+00_r8,1.2374e+00_r8,1.0606e+00_r8,8.8396e-01_r8,7.0710e-01_r8,5.3041e-01_r8, & + &3.5484e-01_r8,1.8101e-01_r8,1.0092e-02_r8/) + kao(:, 2, 7,11) = (/ & + &1.9068e+00_r8,1.6686e+00_r8,1.4303e+00_r8,1.1919e+00_r8,9.5353e-01_r8,7.1519e-01_r8, & + &4.7813e-01_r8,2.4337e-01_r8,1.5041e-02_r8/) + kao(:, 3, 7,11) = (/ & + &2.4672e+00_r8,2.1587e+00_r8,1.8505e+00_r8,1.5421e+00_r8,1.2336e+00_r8,9.2548e-01_r8, & + &6.1872e-01_r8,3.1448e-01_r8,2.1900e-02_r8/) + kao(:, 4, 7,11) = (/ & + &3.0809e+00_r8,2.6959e+00_r8,2.3109e+00_r8,1.9258e+00_r8,1.5405e+00_r8,1.1559e+00_r8, & + &7.7290e-01_r8,3.9302e-01_r8,3.1410e-02_r8/) + kao(:, 5, 7,11) = (/ & + &3.7474e+00_r8,3.2787e+00_r8,2.8103e+00_r8,2.3419e+00_r8,1.8737e+00_r8,1.4060e+00_r8, & + &9.3991e-01_r8,4.7981e-01_r8,4.3693e-02_r8/) + kao(:, 1, 8,11) = (/ & + &2.6683e+00_r8,2.3349e+00_r8,2.0012e+00_r8,1.6677e+00_r8,1.3344e+00_r8,1.0014e+00_r8, & + &6.6874e-01_r8,3.3701e-01_r8,7.4648e-03_r8/) + kao(:, 2, 8,11) = (/ & + &3.7060e+00_r8,3.2430e+00_r8,2.7797e+00_r8,2.3168e+00_r8,1.8539e+00_r8,1.3914e+00_r8, & + &9.2912e-01_r8,4.6800e-01_r8,1.1435e-02_r8/) + kao(:, 3, 8,11) = (/ & + &4.9130e+00_r8,4.2993e+00_r8,3.6854e+00_r8,3.0718e+00_r8,2.4583e+00_r8,1.8451e+00_r8, & + &1.2322e+00_r8,6.2028e-01_r8,1.6885e-02_r8/) + kao(:, 4, 8,11) = (/ & + &6.2797e+00_r8,5.4950e+00_r8,4.7108e+00_r8,3.9265e+00_r8,3.1420e+00_r8,2.3582e+00_r8, & + &1.5746e+00_r8,7.9222e-01_r8,2.4688e-02_r8/) + kao(:, 5, 8,11) = (/ & + &7.7638e+00_r8,6.7943e+00_r8,5.8243e+00_r8,4.8546e+00_r8,3.8850e+00_r8,2.9154e+00_r8, & + &1.9466e+00_r8,9.7896e-01_r8,3.5101e-02_r8/) + kao(:, 1, 9,11) = (/ & + &9.7135e+00_r8,8.4998e+00_r8,7.2860e+00_r8,6.0723e+00_r8,4.8583e+00_r8,3.6448e+00_r8, & + &2.4304e+00_r8,1.2171e+00_r8,3.5233e-03_r8/) + kao(:, 2, 9,11) = (/ & + &1.3929e+01_r8,1.2189e+01_r8,1.0449e+01_r8,8.7078e+00_r8,6.9673e+00_r8,5.2263e+00_r8, & + &3.4856e+00_r8,1.7453e+00_r8,4.1308e-03_r8/) + kao(:, 3, 9,11) = (/ & + &1.8989e+01_r8,1.6615e+01_r8,1.4243e+01_r8,1.1869e+01_r8,9.4966e+00_r8,7.1244e+00_r8, & + &4.7516e+00_r8,2.3792e+00_r8,6.6319e-03_r8/) + kao(:, 4, 9,11) = (/ & + &2.4785e+01_r8,2.1688e+01_r8,1.8591e+01_r8,1.5493e+01_r8,1.2396e+01_r8,9.2991e+00_r8, & + &6.2019e+00_r8,3.1051e+00_r8,1.1490e-02_r8/) + kao(:, 5, 9,11) = (/ & + &3.1283e+01_r8,2.7373e+01_r8,2.3465e+01_r8,1.9556e+01_r8,1.5646e+01_r8,1.1737e+01_r8, & + &7.8279e+00_r8,3.9188e+00_r8,2.1019e-02_r8/) + kao(:, 1,10,11) = (/ & + &4.1666e+01_r8,3.6458e+01_r8,3.1251e+01_r8,2.6043e+01_r8,2.0835e+01_r8,1.5628e+01_r8, & + &1.0419e+01_r8,5.2119e+00_r8,1.6494e-03_r8/) + kao(:, 2,10,11) = (/ & + &6.1694e+01_r8,5.3987e+01_r8,4.6271e+01_r8,3.8561e+01_r8,3.0850e+01_r8,2.3139e+01_r8, & + &1.5428e+01_r8,7.7161e+00_r8,4.8320e-03_r8/) + kao(:, 3,10,11) = (/ & + &8.6109e+01_r8,7.5347e+01_r8,6.4581e+01_r8,5.3821e+01_r8,4.3056e+01_r8,3.2294e+01_r8, & + &2.1533e+01_r8,1.0770e+01_r8,3.2818e-03_r8/) + kao(:, 4,10,11) = (/ & + &1.1458e+02_r8,1.0025e+02_r8,8.5946e+01_r8,7.1620e+01_r8,5.7298e+01_r8,4.2975e+01_r8, & + &2.8651e+01_r8,1.4330e+01_r8,1.0923e-02_r8/) + kao(:, 5,10,11) = (/ & + &1.4689e+02_r8,1.2853e+02_r8,1.1017e+02_r8,9.1808e+01_r8,7.3452e+01_r8,5.5088e+01_r8, & + &3.6731e+01_r8,1.8371e+01_r8,1.7421e-02_r8/) + kao(:, 1,11,11) = (/ & + &7.6402e+01_r8,6.6855e+01_r8,5.7300e+01_r8,4.7753e+01_r8,3.8204e+01_r8,2.8655e+01_r8, & + &1.9105e+01_r8,9.5538e+00_r8,4.1075e-05_r8/) + kao(:, 2,11,11) = (/ & + &1.1253e+02_r8,9.8463e+01_r8,8.4399e+01_r8,7.0331e+01_r8,5.6269e+01_r8,4.2202e+01_r8, & + &2.8136e+01_r8,1.4070e+01_r8,5.7635e-05_r8/) + kao(:, 3,11,11) = (/ & + &1.5636e+02_r8,1.3680e+02_r8,1.1725e+02_r8,9.7724e+01_r8,7.8173e+01_r8,5.8632e+01_r8, & + &3.9090e+01_r8,1.9548e+01_r8,8.0706e-05_r8/) + kao(:, 4,11,11) = (/ & + &2.0774e+02_r8,1.8177e+02_r8,1.5580e+02_r8,1.2984e+02_r8,1.0387e+02_r8,7.7908e+01_r8, & + &5.1937e+01_r8,2.5972e+01_r8,1.1256e-02_r8/) + kao(:, 5,11,11) = (/ & + &2.6504e+02_r8,2.3192e+02_r8,1.9880e+02_r8,1.6566e+02_r8,1.3254e+02_r8,9.9402e+01_r8, & + &6.6269e+01_r8,3.3138e+01_r8,8.3317e-03_r8/) + kao(:, 1,12,11) = (/ & + &1.0209e+02_r8,8.9323e+01_r8,7.6564e+01_r8,6.3800e+01_r8,5.1042e+01_r8,3.8285e+01_r8, & + &2.5522e+01_r8,1.2763e+01_r8,2.5628e-05_r8/) + kao(:, 2,12,11) = (/ & + &1.4952e+02_r8,1.3083e+02_r8,1.1214e+02_r8,9.3447e+01_r8,7.4760e+01_r8,5.6068e+01_r8, & + &3.7381e+01_r8,1.8692e+01_r8,3.7727e-05_r8/) + kao(:, 3,12,11) = (/ & + &2.0709e+02_r8,1.8121e+02_r8,1.5533e+02_r8,1.2944e+02_r8,1.0355e+02_r8,7.7656e+01_r8, & + &5.1777e+01_r8,2.5887e+01_r8,4.7198e-05_r8/) + kao(:, 4,12,11) = (/ & + &2.7380e+02_r8,2.3961e+02_r8,2.0536e+02_r8,1.7114e+02_r8,1.3691e+02_r8,1.0268e+02_r8, & + &6.8461e+01_r8,3.4230e+01_r8,7.7074e-03_r8/) + kao(:, 5,12,11) = (/ & + &3.4895e+02_r8,3.0533e+02_r8,2.6172e+02_r8,2.1811e+02_r8,1.7449e+02_r8,1.3086e+02_r8, & + &8.7241e+01_r8,4.3626e+01_r8,8.7565e-03_r8/) + kao(:, 1,13,11) = (/ & + &1.0675e+02_r8,9.3411e+01_r8,8.0067e+01_r8,6.6725e+01_r8,5.3379e+01_r8,4.0032e+01_r8, & + &2.6688e+01_r8,1.3347e+01_r8,1.6230e-05_r8/) + kao(:, 2,13,11) = (/ & + &1.5608e+02_r8,1.3657e+02_r8,1.1706e+02_r8,9.7552e+01_r8,7.8046e+01_r8,5.8531e+01_r8, & + &3.9024e+01_r8,1.9513e+01_r8,2.2466e-05_r8/) + kao(:, 3,13,11) = (/ & + &2.1549e+02_r8,1.8855e+02_r8,1.6162e+02_r8,1.3468e+02_r8,1.0774e+02_r8,8.0803e+01_r8, & + &5.3874e+01_r8,2.6939e+01_r8,3.0542e-05_r8/) + kao(:, 4,13,11) = (/ & + &2.8371e+02_r8,2.4826e+02_r8,2.1280e+02_r8,1.7733e+02_r8,1.4186e+02_r8,1.0640e+02_r8, & + &7.0935e+01_r8,3.5470e+01_r8,1.3758e-03_r8/) + kao(:, 5,13,11) = (/ & + &3.5962e+02_r8,3.1467e+02_r8,2.6973e+02_r8,2.2478e+02_r8,1.7981e+02_r8,1.3487e+02_r8, & + &8.9910e+01_r8,4.4960e+01_r8,3.9903e-03_r8/) + kao(:, 1, 1,12) = (/ & + &9.6318e-02_r8,8.4306e-02_r8,7.2320e-02_r8,6.0347e-02_r8,5.2079e-02_r8,4.4235e-02_r8, & + &3.5296e-02_r8,3.0172e-02_r8,3.8372e-02_r8/) + kao(:, 2, 1,12) = (/ & + &1.1333e-01_r8,9.9268e-02_r8,8.5214e-02_r8,7.2014e-02_r8,6.3588e-02_r8,5.4323e-02_r8, & + &4.4306e-02_r8,4.1727e-02_r8,5.1292e-02_r8/) + kao(:, 3, 1,12) = (/ & + &1.3065e-01_r8,1.1448e-01_r8,9.8324e-02_r8,8.5358e-02_r8,7.7141e-02_r8,6.4277e-02_r8, & + &5.5750e-02_r8,5.5415e-02_r8,6.7933e-02_r8/) + kao(:, 4, 1,12) = (/ & + &1.4795e-01_r8,1.2969e-01_r8,1.1146e-01_r8,1.0185e-01_r8,9.0045e-02_r8,7.5178e-02_r8, & + &6.8885e-02_r8,7.0700e-02_r8,8.8138e-02_r8/) + kao(:, 5, 1,12) = (/ & + &1.6491e-01_r8,1.4461e-01_r8,1.2472e-01_r8,1.1761e-01_r8,1.0268e-01_r8,8.7802e-02_r8, & + &8.5057e-02_r8,9.0208e-02_r8,1.1284e-01_r8/) + kao(:, 1, 2,12) = (/ & + &1.4316e-01_r8,1.2534e-01_r8,1.0752e-01_r8,8.9701e-02_r8,7.2577e-02_r8,5.9608e-02_r8, & + &4.6628e-02_r8,3.2233e-02_r8,3.6922e-02_r8/) + kao(:, 2, 2,12) = (/ & + &1.7023e-01_r8,1.4907e-01_r8,1.2790e-01_r8,1.0674e-01_r8,8.8738e-02_r8,7.3250e-02_r8, & + &5.7353e-02_r8,4.3254e-02_r8,4.9659e-02_r8/) + kao(:, 3, 2,12) = (/ & + &1.9792e-01_r8,1.7332e-01_r8,1.4875e-01_r8,1.2418e-01_r8,1.0651e-01_r8,8.8601e-02_r8, & + &6.9038e-02_r8,5.5574e-02_r8,6.6062e-02_r8/) + kao(:, 4, 2,12) = (/ & + &2.2567e-01_r8,1.9768e-01_r8,1.6971e-01_r8,1.4278e-01_r8,1.2696e-01_r8,1.0366e-01_r8, & + &8.1948e-02_r8,7.1191e-02_r8,8.6127e-02_r8/) + kao(:, 5, 2,12) = (/ & + &2.5314e-01_r8,2.2175e-01_r8,1.9032e-01_r8,1.6565e-01_r8,1.4606e-01_r8,1.1970e-01_r8, & + &9.8165e-02_r8,9.0526e-02_r8,1.1061e-01_r8/) + kao(:, 1, 3,12) = (/ & + &2.7385e-01_r8,2.3971e-01_r8,2.0552e-01_r8,1.7136e-01_r8,1.3716e-01_r8,1.0300e-01_r8, & + &7.5178e-02_r8,4.5691e-02_r8,3.3533e-02_r8/) + kao(:, 2, 3,12) = (/ & + &3.3090e-01_r8,2.8961e-01_r8,2.4836e-01_r8,2.0707e-01_r8,1.6581e-01_r8,1.2597e-01_r8, & + &9.2542e-02_r8,5.7168e-02_r8,4.5647e-02_r8/) + kao(:, 3, 3,12) = (/ & + &3.8960e-01_r8,3.4098e-01_r8,2.9239e-01_r8,2.4379e-01_r8,1.9517e-01_r8,1.5181e-01_r8, & + &1.1308e-01_r8,7.0212e-02_r8,6.1610e-02_r8/) + kao(:, 4, 3,12) = (/ & + &4.4888e-01_r8,3.9285e-01_r8,3.3686e-01_r8,2.8085e-01_r8,2.2487e-01_r8,1.8074e-01_r8, & + &1.3367e-01_r8,8.4795e-02_r8,8.0803e-02_r8/) + kao(:, 5, 3,12) = (/ & + &5.0777e-01_r8,4.4444e-01_r8,3.8104e-01_r8,3.1773e-01_r8,2.5631e-01_r8,2.1146e-01_r8, & + &1.5502e-01_r8,1.0449e-01_r8,1.0410e-01_r8/) + kao(:, 1, 4,12) = (/ & + &5.2233e-01_r8,4.5708e-01_r8,3.9182e-01_r8,3.2654e-01_r8,2.6131e-01_r8,1.9604e-01_r8, & + &1.3079e-01_r8,7.4640e-02_r8,2.9498e-02_r8/) + kao(:, 2, 4,12) = (/ & + &6.4217e-01_r8,5.6200e-01_r8,4.8174e-01_r8,4.0151e-01_r8,3.2131e-01_r8,2.4104e-01_r8, & + &1.6124e-01_r8,9.3279e-02_r8,4.1076e-02_r8/) + kao(:, 3, 4,12) = (/ & + &7.6818e-01_r8,6.7216e-01_r8,5.7628e-01_r8,4.8026e-01_r8,3.8431e-01_r8,2.8834e-01_r8, & + &1.9584e-01_r8,1.1499e-01_r8,5.5764e-02_r8/) + kao(:, 4, 4,12) = (/ & + &8.9714e-01_r8,7.8510e-01_r8,6.7304e-01_r8,5.6095e-01_r8,4.4882e-01_r8,3.3677e-01_r8, & + &2.3398e-01_r8,1.3732e-01_r8,7.3695e-02_r8/) + kao(:, 5, 4,12) = (/ & + &1.0267e+00_r8,8.9838e-01_r8,7.7018e-01_r8,6.4193e-01_r8,5.1368e-01_r8,3.8545e-01_r8, & + &2.7687e-01_r8,1.6073e-01_r8,9.6046e-02_r8/) + kao(:, 1, 5,12) = (/ & + &9.0551e-01_r8,7.9235e-01_r8,6.7918e-01_r8,5.6601e-01_r8,4.5286e-01_r8,3.3967e-01_r8, & + &2.2649e-01_r8,1.1543e-01_r8,2.5575e-02_r8/) + kao(:, 2, 5,12) = (/ & + &1.1369e+00_r8,9.9490e-01_r8,8.5273e-01_r8,7.1065e-01_r8,5.6855e-01_r8,4.2647e-01_r8, & + &2.8441e-01_r8,1.4706e-01_r8,3.6472e-02_r8/) + kao(:, 3, 5,12) = (/ & + &1.3835e+00_r8,1.2106e+00_r8,1.0376e+00_r8,8.6468e-01_r8,6.9181e-01_r8,5.1896e-01_r8, & + &3.4607e-01_r8,1.8250e-01_r8,5.0201e-02_r8/) + kao(:, 4, 5,12) = (/ & + &1.6400e+00_r8,1.4350e+00_r8,1.2302e+00_r8,1.0252e+00_r8,8.2021e-01_r8,6.1526e-01_r8, & + &4.1028e-01_r8,2.2034e-01_r8,6.6839e-02_r8/) + kao(:, 5, 5,12) = (/ & + &1.9010e+00_r8,1.6635e+00_r8,1.4259e+00_r8,1.1884e+00_r8,9.5076e-01_r8,7.1323e-01_r8, & + &4.7563e-01_r8,2.6201e-01_r8,8.7568e-02_r8/) + kao(:, 1, 6,12) = (/ & + &1.4399e+00_r8,1.2599e+00_r8,1.0800e+00_r8,9.0001e-01_r8,7.2000e-01_r8,5.4003e-01_r8, & + &3.6008e-01_r8,1.8026e-01_r8,2.1293e-02_r8/) + kao(:, 2, 6,12) = (/ & + &1.8513e+00_r8,1.6198e+00_r8,1.3886e+00_r8,1.1570e+00_r8,9.2575e-01_r8,6.9429e-01_r8, & + &4.6294e-01_r8,2.3182e-01_r8,3.1128e-02_r8/) + kao(:, 3, 6,12) = (/ & + &2.3002e+00_r8,2.0128e+00_r8,1.7253e+00_r8,1.4377e+00_r8,1.1502e+00_r8,8.6271e-01_r8, & + &5.7522e-01_r8,2.8786e-01_r8,4.3673e-02_r8/) + kao(:, 4, 6,12) = (/ & + &2.7724e+00_r8,2.4259e+00_r8,2.0792e+00_r8,1.7327e+00_r8,1.3862e+00_r8,1.0398e+00_r8, & + &6.9321e-01_r8,3.4832e-01_r8,5.9465e-02_r8/) + kao(:, 5, 6,12) = (/ & + &3.2575e+00_r8,2.8504e+00_r8,2.4432e+00_r8,2.0359e+00_r8,1.6288e+00_r8,1.2216e+00_r8, & + &8.1457e-01_r8,4.1431e-01_r8,7.8852e-02_r8/) + kao(:, 1, 7,12) = (/ & + &2.3706e+00_r8,2.0741e+00_r8,1.7778e+00_r8,1.4816e+00_r8,1.1852e+00_r8,8.8892e-01_r8, & + &5.9261e-01_r8,2.9636e-01_r8,1.6814e-02_r8/) + kao(:, 2, 7,12) = (/ & + &3.1315e+00_r8,2.7398e+00_r8,2.3484e+00_r8,1.9572e+00_r8,1.5657e+00_r8,1.1742e+00_r8, & + &7.8297e-01_r8,3.9150e-01_r8,2.5425e-02_r8/) + kao(:, 3, 7,12) = (/ & + &3.9698e+00_r8,3.4734e+00_r8,2.9772e+00_r8,2.4811e+00_r8,1.9850e+00_r8,1.4887e+00_r8, & + &9.9245e-01_r8,4.9628e-01_r8,3.6698e-02_r8/) + kao(:, 4, 7,12) = (/ & + &4.8729e+00_r8,4.2639e+00_r8,3.6548e+00_r8,3.0457e+00_r8,2.4366e+00_r8,1.8275e+00_r8, & + &1.2184e+00_r8,6.0927e-01_r8,5.1098e-02_r8/) + kao(:, 5, 7,12) = (/ & + &5.8302e+00_r8,5.1015e+00_r8,4.3726e+00_r8,3.6438e+00_r8,2.9154e+00_r8,2.1865e+00_r8, & + &1.4578e+00_r8,7.2896e-01_r8,6.9201e-02_r8/) + kao(:, 1, 8,12) = (/ & + &4.6083e+00_r8,4.0328e+00_r8,3.4566e+00_r8,2.8804e+00_r8,2.3046e+00_r8,1.7283e+00_r8, & + &1.1523e+00_r8,5.7615e-01_r8,1.2896e-02_r8/) + kao(:, 2, 8,12) = (/ & + &6.2568e+00_r8,5.4739e+00_r8,4.6922e+00_r8,3.9099e+00_r8,3.1281e+00_r8,2.3461e+00_r8, & + &1.5641e+00_r8,7.8209e-01_r8,1.9880e-02_r8/) + kao(:, 3, 8,12) = (/ & + &8.1358e+00_r8,7.1187e+00_r8,6.1015e+00_r8,5.0849e+00_r8,4.0679e+00_r8,3.0509e+00_r8, & + &2.0338e+00_r8,1.0170e+00_r8,2.9497e-02_r8/) + kao(:, 4, 8,12) = (/ & + &1.0204e+01_r8,8.9284e+00_r8,7.6531e+00_r8,6.3773e+00_r8,5.1020e+00_r8,3.8269e+00_r8, & + &2.5510e+00_r8,1.2755e+00_r8,4.2115e-02_r8/) + kao(:, 5, 8,12) = (/ & + &1.2434e+01_r8,1.0880e+01_r8,9.3260e+00_r8,7.7708e+00_r8,6.2169e+00_r8,4.6632e+00_r8, & + &3.1088e+00_r8,1.5543e+00_r8,5.8665e-02_r8/) + kao(:, 1, 9,12) = (/ & + &1.6573e+01_r8,1.4502e+01_r8,1.2430e+01_r8,1.0358e+01_r8,8.2865e+00_r8,6.2149e+00_r8, & + &4.1429e+00_r8,2.0717e+00_r8,3.2506e-03_r8/) + kao(:, 2, 9,12) = (/ & + &2.3241e+01_r8,2.0336e+01_r8,1.7432e+01_r8,1.4525e+01_r8,1.1622e+01_r8,8.7162e+00_r8, & + &5.8106e+00_r8,2.9051e+00_r8,8.0054e-03_r8/) + kao(:, 3, 9,12) = (/ & + &3.1035e+01_r8,2.7156e+01_r8,2.3277e+01_r8,1.9396e+01_r8,1.5516e+01_r8,1.1638e+01_r8, & + &7.7589e+00_r8,3.8795e+00_r8,1.2478e-02_r8/) + kao(:, 4, 9,12) = (/ & + &3.9794e+01_r8,3.4820e+01_r8,2.9846e+01_r8,2.4871e+01_r8,1.9897e+01_r8,1.4923e+01_r8, & + &9.9485e+00_r8,4.9745e+00_r8,2.7934e-02_r8/) + kao(:, 5, 9,12) = (/ & + &4.9259e+01_r8,4.3099e+01_r8,3.6943e+01_r8,3.0785e+01_r8,2.4628e+01_r8,1.8472e+01_r8, & + &1.2315e+01_r8,6.1576e+00_r8,4.7661e-02_r8/) + kao(:, 1,10,12) = (/ & + &6.7160e+01_r8,5.8765e+01_r8,5.0369e+01_r8,4.1974e+01_r8,3.3581e+01_r8,2.5186e+01_r8, & + &1.6790e+01_r8,8.3953e+00_r8,3.7061e-05_r8/) + kao(:, 2,10,12) = (/ & + &9.7116e+01_r8,8.4979e+01_r8,7.2826e+01_r8,6.0693e+01_r8,4.8559e+01_r8,3.6416e+01_r8, & + &2.4277e+01_r8,1.2139e+01_r8,5.3890e-03_r8/) + kao(:, 3,10,12) = (/ & + &1.3274e+02_r8,1.1614e+02_r8,9.9552e+01_r8,8.2959e+01_r8,6.6370e+01_r8,4.9775e+01_r8, & + &3.3183e+01_r8,1.6592e+01_r8,5.5995e-03_r8/) + kao(:, 4,10,12) = (/ & + &1.7342e+02_r8,1.5174e+02_r8,1.3008e+02_r8,1.0839e+02_r8,8.6716e+01_r8,6.5036e+01_r8, & + &4.3354e+01_r8,2.1678e+01_r8,7.3568e-03_r8/) + kao(:, 5,10,12) = (/ & + &2.1869e+02_r8,1.9137e+02_r8,1.6402e+02_r8,1.3669e+02_r8,1.0934e+02_r8,8.2010e+01_r8, & + &5.4674e+01_r8,2.7339e+01_r8,1.9171e-02_r8/) + kao(:, 1,11,12) = (/ & + &1.1512e+02_r8,1.0073e+02_r8,8.6335e+01_r8,7.1940e+01_r8,5.7559e+01_r8,4.3164e+01_r8, & + &2.8776e+01_r8,1.4390e+01_r8,3.3905e-05_r8/) + kao(:, 2,11,12) = (/ & + &1.6697e+02_r8,1.4609e+02_r8,1.2523e+02_r8,1.0436e+02_r8,8.3482e+01_r8,6.2612e+01_r8, & + &4.1744e+01_r8,2.0873e+01_r8,5.9590e-05_r8/) + kao(:, 3,11,12) = (/ & + &2.2930e+02_r8,2.0064e+02_r8,1.7196e+02_r8,1.4331e+02_r8,1.1466e+02_r8,8.5994e+01_r8, & + &5.7327e+01_r8,2.8668e+01_r8,8.9833e-05_r8/) + kao(:, 4,11,12) = (/ & + &3.0132e+02_r8,2.6364e+02_r8,2.2598e+02_r8,1.8835e+02_r8,1.5066e+02_r8,1.1300e+02_r8, & + &7.5334e+01_r8,3.7671e+01_r8,8.4167e-03_r8/) + kao(:, 5,11,12) = (/ & + &3.8162e+02_r8,3.3392e+02_r8,2.8622e+02_r8,2.3853e+02_r8,1.9083e+02_r8,1.4312e+02_r8, & + &9.5410e+01_r8,4.7709e+01_r8,1.8161e-02_r8/) + kao(:, 1,12,12) = (/ & + &1.5129e+02_r8,1.3238e+02_r8,1.1347e+02_r8,9.4558e+01_r8,7.5645e+01_r8,5.6733e+01_r8, & + &3.7823e+01_r8,1.8915e+01_r8,3.6770e-05_r8/) + kao(:, 2,12,12) = (/ & + &2.2053e+02_r8,1.9297e+02_r8,1.6541e+02_r8,1.3784e+02_r8,1.1026e+02_r8,8.2702e+01_r8, & + &5.5137e+01_r8,2.7573e+01_r8,5.2389e-05_r8/) + kao(:, 3,12,12) = (/ & + &3.0464e+02_r8,2.6657e+02_r8,2.2849e+02_r8,1.9040e+02_r8,1.5233e+02_r8,1.1424e+02_r8, & + &7.6159e+01_r8,3.8090e+01_r8,7.1306e-05_r8/) + kao(:, 4,12,12) = (/ & + &4.0144e+02_r8,3.5128e+02_r8,3.0110e+02_r8,2.5092e+02_r8,2.0072e+02_r8,1.5055e+02_r8, & + &1.0037e+02_r8,5.0190e+01_r8,9.4766e-05_r8/) + kao(:, 5,12,12) = (/ & + &5.1041e+02_r8,4.4660e+02_r8,3.8281e+02_r8,3.1900e+02_r8,2.5521e+02_r8,1.9140e+02_r8, & + &1.2761e+02_r8,6.3809e+01_r8,8.9549e-03_r8/) + kao(:, 1,13,12) = (/ & + &1.6406e+02_r8,1.4356e+02_r8,1.2306e+02_r8,1.0255e+02_r8,8.2037e+01_r8,6.1534e+01_r8, & + &4.1023e+01_r8,2.0513e+01_r8,2.9105e-05_r8/) + kao(:, 2,13,12) = (/ & + &2.3966e+02_r8,2.0971e+02_r8,1.7976e+02_r8,1.4978e+02_r8,1.1983e+02_r8,8.9879e+01_r8, & + &5.9920e+01_r8,2.9966e+01_r8,3.6736e-05_r8/) + kao(:, 3,13,12) = (/ & + &3.3040e+02_r8,2.8909e+02_r8,2.4781e+02_r8,2.0651e+02_r8,1.6521e+02_r8,1.2390e+02_r8, & + &8.2608e+01_r8,4.1307e+01_r8,4.7139e-05_r8/) + kao(:, 4,13,12) = (/ & + &4.3608e+02_r8,3.8160e+02_r8,3.2708e+02_r8,2.7256e+02_r8,2.1804e+02_r8,1.6354e+02_r8, & + &1.0903e+02_r8,5.4517e+01_r8,5.9953e-05_r8/) + kao(:, 5,13,12) = (/ & + &5.5401e+02_r8,4.8478e+02_r8,4.1553e+02_r8,3.4627e+02_r8,2.7701e+02_r8,2.0776e+02_r8, & + &1.3851e+02_r8,6.9261e+01_r8,1.3826e-02_r8/) + kao(:, 1, 1,13) = (/ & + &1.2490e-01_r8,1.0932e-01_r8,9.3720e-02_r8,7.8121e-02_r8,6.3794e-02_r8,5.1600e-02_r8, & + &4.4680e-02_r8,4.2635e-02_r8,5.5634e-02_r8/) + kao(:, 2, 1,13) = (/ & + &1.4548e-01_r8,1.2733e-01_r8,1.0918e-01_r8,9.1021e-02_r8,7.6620e-02_r8,6.3500e-02_r8, & + &5.7581e-02_r8,5.7524e-02_r8,7.4793e-02_r8/) + kao(:, 3, 1,13) = (/ & + &1.6600e-01_r8,1.4529e-01_r8,1.2460e-01_r8,1.0392e-01_r8,9.0379e-02_r8,7.8694e-02_r8, & + &7.4384e-02_r8,7.8232e-02_r8,9.9775e-02_r8/) + kao(:, 4, 1,13) = (/ & + &1.8636e-01_r8,1.6314e-01_r8,1.3994e-01_r8,1.1863e-01_r8,1.0661e-01_r8,9.7110e-02_r8, & + &9.8012e-02_r8,1.0654e-01_r8,1.3265e-01_r8/) + kao(:, 5, 1,13) = (/ & + &2.0606e-01_r8,1.8040e-01_r8,1.5476e-01_r8,1.3669e-01_r8,1.2405e-01_r8,1.1873e-01_r8, & + &1.2869e-01_r8,1.4070e-01_r8,1.7529e-01_r8/) + kao(:, 1, 2,13) = (/ & + &1.8895e-01_r8,1.6535e-01_r8,1.4175e-01_r8,1.1814e-01_r8,9.4551e-02_r8,7.3809e-02_r8, & + &5.5615e-02_r8,4.4637e-02_r8,5.3030e-02_r8/) + kao(:, 2, 2,13) = (/ & + &2.2250e-01_r8,1.9470e-01_r8,1.6692e-01_r8,1.3914e-01_r8,1.1136e-01_r8,8.8262e-02_r8, & + &7.0022e-02_r8,6.0363e-02_r8,7.3472e-02_r8/) + kao(:, 3, 2,13) = (/ & + &2.5567e-01_r8,2.2376e-01_r8,1.9185e-01_r8,1.5991e-01_r8,1.3005e-01_r8,1.0599e-01_r8, & + &8.7655e-02_r8,7.9726e-02_r8,9.6994e-02_r8/) + kao(:, 4, 2,13) = (/ & + &2.8747e-01_r8,2.5157e-01_r8,2.1569e-01_r8,1.7980e-01_r8,1.5083e-01_r8,1.2699e-01_r8, & + &1.0917e-01_r8,1.0493e-01_r8,1.2703e-01_r8/) + kao(:, 5, 2,13) = (/ & + &3.1781e-01_r8,2.7817e-01_r8,2.3857e-01_r8,1.9898e-01_r8,1.7411e-01_r8,1.5016e-01_r8, & + &1.3454e-01_r8,1.3707e-01_r8,1.6656e-01_r8/) + kao(:, 1, 3,13) = (/ & + &3.6978e-01_r8,3.2357e-01_r8,2.7737e-01_r8,2.3116e-01_r8,1.8494e-01_r8,1.3872e-01_r8, & + &9.4432e-02_r8,5.7465e-02_r8,4.7026e-02_r8/) + kao(:, 2, 3,13) = (/ & + &4.3903e-01_r8,3.8415e-01_r8,3.2929e-01_r8,2.7445e-01_r8,2.1956e-01_r8,1.6470e-01_r8, & + &1.1482e-01_r8,7.4394e-02_r8,6.6138e-02_r8/) + kao(:, 3, 3,13) = (/ & + &5.0855e-01_r8,4.4506e-01_r8,3.8154e-01_r8,3.1805e-01_r8,2.5451e-01_r8,1.9102e-01_r8, & + &1.3670e-01_r8,9.4825e-02_r8,8.9406e-02_r8/) + kao(:, 4, 3,13) = (/ & + &5.7817e-01_r8,5.0599e-01_r8,4.3381e-01_r8,3.6166e-01_r8,2.8948e-01_r8,2.2042e-01_r8, & + &1.6420e-01_r8,1.1827e-01_r8,1.1730e-01_r8/) + kao(:, 5, 3,13) = (/ & + &6.4715e-01_r8,5.6638e-01_r8,4.8566e-01_r8,4.0494e-01_r8,3.2419e-01_r8,2.5446e-01_r8, & + &1.9367e-01_r8,1.4612e-01_r8,1.5219e-01_r8/) + kao(:, 1, 4,13) = (/ & + &7.1857e-01_r8,6.2877e-01_r8,5.3894e-01_r8,4.4919e-01_r8,3.5935e-01_r8,2.6957e-01_r8, & + &1.7976e-01_r8,9.3998e-02_r8,4.1187e-02_r8/) + kao(:, 2, 4,13) = (/ & + &8.6835e-01_r8,7.5986e-01_r8,6.5131e-01_r8,5.4283e-01_r8,4.3435e-01_r8,3.2583e-01_r8, & + &2.1731e-01_r8,1.1522e-01_r8,5.8302e-02_r8/) + kao(:, 3, 4,13) = (/ & + &1.0243e+00_r8,8.9626e-01_r8,7.6836e-01_r8,6.4035e-01_r8,5.1240e-01_r8,3.8438e-01_r8, & + &2.5643e-01_r8,1.3949e-01_r8,7.9878e-02_r8/) + kao(:, 4, 4,13) = (/ & + &1.1800e+00_r8,1.0326e+00_r8,8.8512e-01_r8,7.3767e-01_r8,5.9020e-01_r8,4.4282e-01_r8, & + &2.9609e-01_r8,1.6997e-01_r8,1.0651e-01_r8/) + kao(:, 5, 4,13) = (/ & + &1.3277e+00_r8,1.1619e+00_r8,9.9598e-01_r8,8.3009e-01_r8,6.6410e-01_r8,4.9823e-01_r8, & + &3.3917e-01_r8,2.0392e-01_r8,1.3923e-01_r8/) + kao(:, 1, 5,13) = (/ & + &1.2769e+00_r8,1.1173e+00_r8,9.5773e-01_r8,7.9808e-01_r8,6.3854e-01_r8,4.7892e-01_r8, & + &3.1932e-01_r8,1.5974e-01_r8,3.6366e-02_r8/) + kao(:, 2, 5,13) = (/ & + &1.5754e+00_r8,1.3783e+00_r8,1.1815e+00_r8,9.8457e-01_r8,7.8769e-01_r8,5.9081e-01_r8, & + &3.9400e-01_r8,1.9711e-01_r8,5.2068e-02_r8/) + kao(:, 3, 5,13) = (/ & + &1.8818e+00_r8,1.6466e+00_r8,1.4114e+00_r8,1.1761e+00_r8,9.4096e-01_r8,7.0577e-01_r8, & + &4.7057e-01_r8,2.3659e-01_r8,7.1428e-02_r8/) + kao(:, 4, 5,13) = (/ & + &2.1862e+00_r8,1.9130e+00_r8,1.6397e+00_r8,1.3666e+00_r8,1.0933e+00_r8,8.2000e-01_r8, & + &5.4672e-01_r8,2.8019e-01_r8,9.6282e-02_r8/) + kao(:, 5, 5,13) = (/ & + &2.4918e+00_r8,2.1806e+00_r8,1.8691e+00_r8,1.5576e+00_r8,1.2460e+00_r8,9.3474e-01_r8, & + &6.2322e-01_r8,3.2775e-01_r8,1.2758e-01_r8/) + kao(:, 1, 6,13) = (/ & + &2.0873e+00_r8,1.8265e+00_r8,1.5654e+00_r8,1.3046e+00_r8,1.0437e+00_r8,7.8276e-01_r8, & + &5.2187e-01_r8,2.6100e-01_r8,3.1022e-02_r8/) + kao(:, 2, 6,13) = (/ & + &2.6230e+00_r8,2.2953e+00_r8,1.9673e+00_r8,1.6394e+00_r8,1.3116e+00_r8,9.8380e-01_r8, & + &6.5587e-01_r8,3.2796e-01_r8,4.5564e-02_r8/) + kao(:, 3, 6,13) = (/ & + &3.1789e+00_r8,2.7816e+00_r8,2.3843e+00_r8,1.9870e+00_r8,1.5894e+00_r8,1.1921e+00_r8, & + &7.9481e-01_r8,3.9748e-01_r8,6.4081e-02_r8/) + kao(:, 4, 6,13) = (/ & + &3.7665e+00_r8,3.2952e+00_r8,2.8247e+00_r8,2.3538e+00_r8,1.8832e+00_r8,1.4124e+00_r8, & + &9.4165e-01_r8,4.7095e-01_r8,8.7003e-02_r8/) + kao(:, 5, 6,13) = (/ & + &4.3632e+00_r8,3.8180e+00_r8,3.2726e+00_r8,2.7273e+00_r8,2.1819e+00_r8,1.6363e+00_r8, & + &1.0910e+00_r8,5.4560e-01_r8,1.1609e-01_r8/) + kao(:, 1, 7,13) = (/ & + &3.5237e+00_r8,3.0834e+00_r8,2.6428e+00_r8,2.2023e+00_r8,1.7619e+00_r8,1.3214e+00_r8, & + &8.8102e-01_r8,4.4047e-01_r8,2.5898e-02_r8/) + kao(:, 2, 7,13) = (/ & + &4.5331e+00_r8,3.9665e+00_r8,3.3999e+00_r8,2.8333e+00_r8,2.2667e+00_r8,1.6999e+00_r8, & + &1.1334e+00_r8,5.6671e-01_r8,3.9066e-02_r8/) + kao(:, 3, 7,13) = (/ & + &5.6378e+00_r8,4.9326e+00_r8,4.2280e+00_r8,3.5234e+00_r8,2.8189e+00_r8,2.1142e+00_r8, & + &1.4094e+00_r8,7.0475e-01_r8,5.6679e-02_r8/) + kao(:, 4, 7,13) = (/ & + &6.8044e+00_r8,5.9541e+00_r8,5.1033e+00_r8,4.2525e+00_r8,3.4021e+00_r8,2.5518e+00_r8, & + &1.7012e+00_r8,8.5062e-01_r8,7.8214e-02_r8/) + kao(:, 5, 7,13) = (/ & + &7.9748e+00_r8,6.9785e+00_r8,5.9814e+00_r8,4.9841e+00_r8,3.9872e+00_r8,2.9906e+00_r8, & + &1.9939e+00_r8,9.9695e-01_r8,1.0573e-01_r8/) + kao(:, 1, 8,13) = (/ & + &7.0539e+00_r8,6.1726e+00_r8,5.2906e+00_r8,4.4088e+00_r8,3.5267e+00_r8,2.6453e+00_r8, & + &1.7634e+00_r8,8.8179e-01_r8,2.1249e-02_r8/) + kao(:, 2, 8,13) = (/ & + &9.3702e+00_r8,8.1985e+00_r8,7.0273e+00_r8,5.8560e+00_r8,4.6849e+00_r8,3.5137e+00_r8, & + &2.3424e+00_r8,1.1713e+00_r8,3.3095e-02_r8/) + kao(:, 3, 8,13) = (/ & + &1.1943e+01_r8,1.0450e+01_r8,8.9569e+00_r8,7.4646e+00_r8,5.9714e+00_r8,4.4785e+00_r8, & + &2.9858e+00_r8,1.4929e+00_r8,4.9465e-02_r8/) + kao(:, 4, 8,13) = (/ & + &1.4646e+01_r8,1.2815e+01_r8,1.0984e+01_r8,9.1536e+00_r8,7.3228e+00_r8,5.4925e+00_r8, & + &3.6616e+00_r8,1.8307e+00_r8,7.0099e-02_r8/) + kao(:, 5, 8,13) = (/ & + &1.7489e+01_r8,1.5303e+01_r8,1.3117e+01_r8,1.0930e+01_r8,8.7446e+00_r8,6.5589e+00_r8, & + &4.3724e+00_r8,2.1863e+00_r8,9.5981e-02_r8/) + kao(:, 1, 9,13) = (/ & + &2.6371e+01_r8,2.3078e+01_r8,1.9780e+01_r8,1.6484e+01_r8,1.3187e+01_r8,9.8900e+00_r8, & + &6.5930e+00_r8,3.2967e+00_r8,6.8943e-03_r8/) + kao(:, 2, 9,13) = (/ & + &3.6211e+01_r8,3.1684e+01_r8,2.7158e+01_r8,2.2631e+01_r8,1.8105e+01_r8,1.3579e+01_r8, & + &9.0530e+00_r8,4.5262e+00_r8,1.7485e-02_r8/) + kao(:, 3, 9,13) = (/ & + &4.7281e+01_r8,4.1374e+01_r8,3.5462e+01_r8,2.9549e+01_r8,2.3642e+01_r8,1.7731e+01_r8, & + &1.1820e+01_r8,5.9103e+00_r8,4.0011e-02_r8/) + kao(:, 4, 9,13) = (/ & + &5.9381e+01_r8,5.1957e+01_r8,4.4537e+01_r8,3.7114e+01_r8,2.9690e+01_r8,2.2267e+01_r8, & + &1.4846e+01_r8,7.4229e+00_r8,6.1300e-02_r8/) + kao(:, 5, 9,13) = (/ & + &7.2474e+01_r8,6.3419e+01_r8,5.4356e+01_r8,4.5296e+01_r8,3.6239e+01_r8,2.7178e+01_r8, & + &1.8119e+01_r8,9.0595e+00_r8,8.5682e-02_r8/) + kao(:, 1,10,13) = (/ & + &1.1184e+02_r8,9.7849e+01_r8,8.3875e+01_r8,6.9894e+01_r8,5.5915e+01_r8,4.1936e+01_r8, & + &2.7957e+01_r8,1.3979e+01_r8,1.8093e-05_r8/) + kao(:, 2,10,13) = (/ & + &1.5816e+02_r8,1.3839e+02_r8,1.1862e+02_r8,9.8846e+01_r8,7.9081e+01_r8,5.9311e+01_r8, & + &3.9538e+01_r8,1.9769e+01_r8,2.0368e-03_r8/) + kao(:, 3,10,13) = (/ & + &2.1176e+02_r8,1.8530e+02_r8,1.5882e+02_r8,1.3236e+02_r8,1.0588e+02_r8,7.9412e+01_r8, & + &5.2940e+01_r8,2.6470e+01_r8,1.0379e-02_r8/) + kao(:, 4,10,13) = (/ & + &2.7234e+02_r8,2.3829e+02_r8,2.0425e+02_r8,1.7021e+02_r8,1.3616e+02_r8,1.0213e+02_r8, & + &6.8082e+01_r8,3.4042e+01_r8,8.3550e-03_r8/) + kao(:, 5,10,13) = (/ & + &3.3838e+02_r8,2.9608e+02_r8,2.5378e+02_r8,2.1148e+02_r8,1.6919e+02_r8,1.2688e+02_r8, & + &8.4588e+01_r8,4.2296e+01_r8,2.4237e-02_r8/) + kao(:, 1,11,13) = (/ & + &1.9607e+02_r8,1.7156e+02_r8,1.4706e+02_r8,1.2254e+02_r8,9.8035e+01_r8,7.3528e+01_r8, & + &4.9019e+01_r8,2.4510e+01_r8,1.9563e-05_r8/) + kao(:, 2,11,13) = (/ & + &2.7783e+02_r8,2.4308e+02_r8,2.0836e+02_r8,1.7363e+02_r8,1.3891e+02_r8,1.0418e+02_r8, & + &6.9451e+01_r8,3.4727e+01_r8,2.1737e-05_r8/) + kao(:, 3,11,13) = (/ & + &3.7392e+02_r8,3.2720e+02_r8,2.8047e+02_r8,2.3371e+02_r8,1.8697e+02_r8,1.4023e+02_r8, & + &9.3485e+01_r8,4.6744e+01_r8,2.8098e-05_r8/) + kao(:, 4,11,13) = (/ & + &4.8258e+02_r8,4.2223e+02_r8,3.6194e+02_r8,3.0162e+02_r8,2.4128e+02_r8,1.8096e+02_r8, & + &1.2064e+02_r8,6.0325e+01_r8,6.2823e-03_r8/) + kao(:, 5,11,13) = (/ & + &6.0149e+02_r8,5.2626e+02_r8,4.5111e+02_r8,3.7591e+02_r8,3.0076e+02_r8,2.2554e+02_r8, & + &1.5037e+02_r8,7.5184e+01_r8,1.4409e-02_r8/) + kao(:, 1,12,13) = (/ & + &2.5475e+02_r8,2.2289e+02_r8,1.9106e+02_r8,1.5923e+02_r8,1.2737e+02_r8,9.5526e+01_r8, & + &6.3684e+01_r8,3.1843e+01_r8,2.0642e-05_r8/) + kao(:, 2,12,13) = (/ & + &3.6233e+02_r8,3.1704e+02_r8,2.7175e+02_r8,2.2647e+02_r8,1.8117e+02_r8,1.3587e+02_r8, & + &9.0584e+01_r8,4.5292e+01_r8,3.1983e-05_r8/) + kao(:, 3,12,13) = (/ & + &4.8916e+02_r8,4.2803e+02_r8,3.6684e+02_r8,3.0571e+02_r8,2.4456e+02_r8,1.8343e+02_r8, & + &1.2228e+02_r8,6.1143e+01_r8,4.9821e-05_r8/) + kao(:, 4,12,13) = (/ & + &6.3314e+02_r8,5.5397e+02_r8,4.7487e+02_r8,3.9571e+02_r8,3.1654e+02_r8,2.3742e+02_r8, & + &1.5828e+02_r8,7.9139e+01_r8,7.0156e-05_r8/) + kao(:, 5,12,13) = (/ & + &7.9128e+02_r8,6.9231e+02_r8,5.9347e+02_r8,4.9456e+02_r8,3.9565e+02_r8,2.9675e+02_r8, & + &1.9782e+02_r8,9.8911e+01_r8,2.0440e-02_r8/) + kao(:, 1,13,13) = (/ & + &2.6423e+02_r8,2.3120e+02_r8,1.9817e+02_r8,1.6514e+02_r8,1.3211e+02_r8,9.9077e+01_r8, & + &6.6055e+01_r8,3.3026e+01_r8,2.0316e-05_r8/) + kao(:, 2,13,13) = (/ & + &3.7762e+02_r8,3.3041e+02_r8,2.8322e+02_r8,2.3600e+02_r8,1.8882e+02_r8,1.4161e+02_r8, & + &9.4405e+01_r8,4.7199e+01_r8,3.9220e-05_r8/) + kao(:, 3,13,13) = (/ & + &5.1221e+02_r8,4.4817e+02_r8,3.8414e+02_r8,3.2014e+02_r8,2.5611e+02_r8,1.9208e+02_r8, & + &1.2806e+02_r8,6.4027e+01_r8,5.9611e-05_r8/) + kao(:, 4,13,13) = (/ & + &6.6615e+02_r8,5.8290e+02_r8,4.9961e+02_r8,4.1636e+02_r8,3.3309e+02_r8,2.4982e+02_r8, & + &1.6655e+02_r8,8.3275e+01_r8,8.3600e-05_r8/) + kao(:, 5,13,13) = (/ & + &8.3847e+02_r8,7.3367e+02_r8,6.2884e+02_r8,5.2405e+02_r8,4.1925e+02_r8,3.1441e+02_r8, & + &2.0962e+02_r8,1.0481e+02_r8,8.6814e-03_r8/) + kao(:, 1, 1,14) = (/ & + &1.4546e-01_r8,1.2729e-01_r8,1.0913e-01_r8,9.0969e-02_r8,7.2816e-02_r8,6.3783e-02_r8, & + &5.7732e-02_r8,5.8710e-02_r8,8.0301e-02_r8/) + kao(:, 2, 1,14) = (/ & + &1.6927e-01_r8,1.4814e-01_r8,1.2702e-01_r8,1.0589e-01_r8,8.6710e-02_r8,8.1091e-02_r8, & + &8.1369e-02_r8,8.2706e-02_r8,1.1649e-01_r8/) + kao(:, 3, 1,14) = (/ & + &1.9294e-01_r8,1.6889e-01_r8,1.4479e-01_r8,1.2072e-01_r8,1.0647e-01_r8,1.0625e-01_r8, & + &1.1521e-01_r8,1.1490e-01_r8,1.6620e-01_r8/) + kao(:, 4, 1,14) = (/ & + &2.1639e-01_r8,1.8940e-01_r8,1.6240e-01_r8,1.3541e-01_r8,1.3447e-01_r8,1.4239e-01_r8, & + &1.5920e-01_r8,1.5808e-01_r8,2.2919e-01_r8/) + kao(:, 5, 1,14) = (/ & + &2.3882e-01_r8,2.0905e-01_r8,1.7929e-01_r8,1.5673e-01_r8,1.6730e-01_r8,1.8853e-01_r8, & + &2.1227e-01_r8,2.1249e-01_r8,3.0359e-01_r8/) + kao(:, 1, 2,14) = (/ & + &2.2939e-01_r8,2.0073e-01_r8,1.7206e-01_r8,1.4339e-01_r8,1.1475e-01_r8,8.6951e-02_r8, & + &7.2184e-02_r8,6.3155e-02_r8,8.0463e-02_r8/) + kao(:, 2, 2,14) = (/ & + &2.6931e-01_r8,2.3569e-01_r8,2.0200e-01_r8,1.6840e-01_r8,1.3475e-01_r8,1.0880e-01_r8, & + &9.2729e-02_r8,8.6720e-02_r8,1.1351e-01_r8/) + kao(:, 3, 2,14) = (/ & + &3.0958e-01_r8,2.7100e-01_r8,2.3236e-01_r8,1.9370e-01_r8,1.5506e-01_r8,1.3547e-01_r8, & + &1.2355e-01_r8,1.2394e-01_r8,1.6330e-01_r8/) + kao(:, 4, 2,14) = (/ & + &3.5073e-01_r8,3.0694e-01_r8,2.6319e-01_r8,2.1943e-01_r8,1.7928e-01_r8,1.7126e-01_r8, & + &1.6643e-01_r8,1.7360e-01_r8,2.2783e-01_r8/) + kao(:, 5, 2,14) = (/ & + &3.9134e-01_r8,3.4248e-01_r8,2.9368e-01_r8,2.4496e-01_r8,2.1593e-01_r8,2.1367e-01_r8, & + &2.2253e-01_r8,2.3537e-01_r8,3.0544e-01_r8/) + kao(:, 1, 3,14) = (/ & + &4.7010e-01_r8,4.1135e-01_r8,3.5261e-01_r8,2.9387e-01_r8,2.3512e-01_r8,1.7638e-01_r8, & + &1.1764e-01_r8,7.8616e-02_r8,7.6241e-02_r8/) + kao(:, 2, 3,14) = (/ & + &5.6247e-01_r8,4.9221e-01_r8,4.2195e-01_r8,3.5165e-01_r8,2.8136e-01_r8,2.1111e-01_r8, & + &1.4480e-01_r8,1.0039e-01_r8,1.0523e-01_r8/) + kao(:, 3, 3,14) = (/ & + &6.5749e-01_r8,5.7537e-01_r8,4.9319e-01_r8,4.1105e-01_r8,3.2895e-01_r8,2.4684e-01_r8, & + &1.7889e-01_r8,1.3157e-01_r8,1.4752e-01_r8/) + kao(:, 4, 3,14) = (/ & + &7.5292e-01_r8,6.5895e-01_r8,5.6476e-01_r8,4.7081e-01_r8,3.7678e-01_r8,2.8272e-01_r8, & + &2.2206e-01_r8,1.7756e-01_r8,2.0769e-01_r8/) + kao(:, 5, 3,14) = (/ & + &8.4721e-01_r8,7.4147e-01_r8,6.3570e-01_r8,5.2989e-01_r8,4.2402e-01_r8,3.2414e-01_r8, & + &2.7831e-01_r8,2.3784e-01_r8,2.8406e-01_r8/) + kao(:, 1, 4,14) = (/ & + &9.7171e-01_r8,8.5020e-01_r8,7.2877e-01_r8,6.0734e-01_r8,4.8590e-01_r8,3.6445e-01_r8, & + &2.4301e-01_r8,1.2213e-01_r8,6.9724e-02_r8/) + kao(:, 2, 4,14) = (/ & + &1.1819e+00_r8,1.0342e+00_r8,8.8647e-01_r8,7.3863e-01_r8,5.9101e-01_r8,4.4338e-01_r8, & + &2.9560e-01_r8,1.5522e-01_r8,9.6103e-02_r8/) + kao(:, 3, 4,14) = (/ & + &1.3997e+00_r8,1.2249e+00_r8,1.0500e+00_r8,8.7515e-01_r8,7.0004e-01_r8,5.2502e-01_r8, & + &3.5022e-01_r8,1.9543e-01_r8,1.3302e-01_r8/) + kao(:, 4, 4,14) = (/ & + &1.6223e+00_r8,1.4197e+00_r8,1.2167e+00_r8,1.0141e+00_r8,8.1148e-01_r8,6.0893e-01_r8, & + &4.0620e-01_r8,2.4484e-01_r8,1.8472e-01_r8/) + kao(:, 5, 4,14) = (/ & + &1.8526e+00_r8,1.6213e+00_r8,1.3899e+00_r8,1.1585e+00_r8,9.2711e-01_r8,6.9563e-01_r8, & + &4.6462e-01_r8,3.0719e-01_r8,2.5304e-01_r8/) + kao(:, 1, 5,14) = (/ & + &1.8192e+00_r8,1.5916e+00_r8,1.3645e+00_r8,1.1369e+00_r8,9.0965e-01_r8,6.8222e-01_r8, & + &4.5478e-01_r8,2.2743e-01_r8,6.1385e-02_r8/) + kao(:, 2, 5,14) = (/ & + &2.2491e+00_r8,1.9677e+00_r8,1.6869e+00_r8,1.4056e+00_r8,1.1246e+00_r8,8.4332e-01_r8, & + &5.6233e-01_r8,2.8119e-01_r8,8.6006e-02_r8/) + kao(:, 3, 5,14) = (/ & + &2.7102e+00_r8,2.3722e+00_r8,2.0328e+00_r8,1.6939e+00_r8,1.3553e+00_r8,1.0165e+00_r8, & + &6.7791e-01_r8,3.3919e-01_r8,1.2062e-01_r8/) + kao(:, 4, 5,14) = (/ & + &3.1976e+00_r8,2.7982e+00_r8,2.3984e+00_r8,1.9988e+00_r8,1.5996e+00_r8,1.1997e+00_r8, & + &8.0003e-01_r8,4.0180e-01_r8,1.6649e-01_r8/) + kao(:, 5, 5,14) = (/ & + &3.6973e+00_r8,3.2349e+00_r8,2.7730e+00_r8,2.3110e+00_r8,1.8489e+00_r8,1.3873e+00_r8, & + &9.2506e-01_r8,4.7326e-01_r8,2.2654e-01_r8/) + kao(:, 1, 6,14) = (/ & + &3.1019e+00_r8,2.7140e+00_r8,2.3265e+00_r8,1.9387e+00_r8,1.5510e+00_r8,1.1633e+00_r8, & + &7.7552e-01_r8,3.8777e-01_r8,5.2928e-02_r8/) + kao(:, 2, 6,14) = (/ & + &3.9302e+00_r8,3.4386e+00_r8,2.9473e+00_r8,2.4561e+00_r8,1.9652e+00_r8,1.4738e+00_r8, & + &9.8267e-01_r8,4.9148e-01_r8,7.5058e-02_r8/) + kao(:, 3, 6,14) = (/ & + &4.8343e+00_r8,4.2298e+00_r8,3.6258e+00_r8,3.0217e+00_r8,2.4174e+00_r8,1.8133e+00_r8, & + &1.2090e+00_r8,6.0467e-01_r8,1.0698e-01_r8/) + kao(:, 4, 6,14) = (/ & + &5.7912e+00_r8,5.0677e+00_r8,4.3433e+00_r8,3.6195e+00_r8,2.8961e+00_r8,2.1723e+00_r8, & + &1.4483e+00_r8,7.2440e-01_r8,1.4901e-01_r8/) + kao(:, 5, 6,14) = (/ & + &6.7811e+00_r8,5.9338e+00_r8,5.0864e+00_r8,4.2388e+00_r8,3.3910e+00_r8,2.5430e+00_r8, & + &1.6957e+00_r8,8.4831e-01_r8,2.0161e-01_r8/) + kao(:, 1, 7,14) = (/ & + &5.4638e+00_r8,4.7799e+00_r8,4.0972e+00_r8,3.4147e+00_r8,2.7314e+00_r8,2.0488e+00_r8, & + &1.3659e+00_r8,6.8294e-01_r8,4.5673e-02_r8/) + kao(:, 2, 7,14) = (/ & + &7.1063e+00_r8,6.2177e+00_r8,5.3292e+00_r8,4.4410e+00_r8,3.5530e+00_r8,2.6647e+00_r8, & + &1.7765e+00_r8,8.8835e-01_r8,6.5608e-02_r8/) + kao(:, 3, 7,14) = (/ & + &8.9165e+00_r8,7.8008e+00_r8,6.6867e+00_r8,5.5727e+00_r8,4.4582e+00_r8,3.3435e+00_r8, & + &2.2293e+00_r8,1.1147e+00_r8,9.3558e-02_r8/) + kao(:, 4, 7,14) = (/ & + &1.0858e+01_r8,9.5015e+00_r8,8.1441e+00_r8,6.7868e+00_r8,5.4291e+00_r8,4.0729e+00_r8, & + &2.7150e+00_r8,1.3577e+00_r8,1.3310e-01_r8/) + kao(:, 5, 7,14) = (/ & + &1.2930e+01_r8,1.1317e+01_r8,9.6983e+00_r8,8.0819e+00_r8,6.4667e+00_r8,4.8496e+00_r8, & + &3.2333e+00_r8,1.6168e+00_r8,1.8236e-01_r8/) + kao(:, 1, 8,14) = (/ & + &1.1346e+01_r8,9.9283e+00_r8,8.5084e+00_r8,7.0912e+00_r8,5.6732e+00_r8,4.2544e+00_r8, & + &2.8362e+00_r8,1.4181e+00_r8,3.9157e-02_r8/) + kao(:, 2, 8,14) = (/ & + &1.5150e+01_r8,1.3257e+01_r8,1.1363e+01_r8,9.4692e+00_r8,7.5753e+00_r8,5.6816e+00_r8, & + &3.7878e+00_r8,1.8940e+00_r8,5.7302e-02_r8/) + kao(:, 3, 8,14) = (/ & + &1.9415e+01_r8,1.6989e+01_r8,1.4562e+01_r8,1.2134e+01_r8,9.7069e+00_r8,7.2806e+00_r8, & + &4.8539e+00_r8,2.4270e+00_r8,8.2333e-02_r8/) + kao(:, 4, 8,14) = (/ & + &2.4092e+01_r8,2.1079e+01_r8,1.8070e+01_r8,1.5059e+01_r8,1.2046e+01_r8,9.0355e+00_r8, & + &6.0239e+00_r8,3.0117e+00_r8,1.1787e-01_r8/) + kao(:, 5, 8,14) = (/ & + &2.9062e+01_r8,2.5429e+01_r8,2.1796e+01_r8,1.8164e+01_r8,1.4531e+01_r8,1.0899e+01_r8, & + &7.2663e+00_r8,3.6329e+00_r8,1.6482e-01_r8/) + kao(:, 1, 9,14) = (/ & + &4.3556e+01_r8,3.8120e+01_r8,3.2674e+01_r8,2.7224e+01_r8,2.1783e+01_r8,1.6334e+01_r8, & + &1.0888e+01_r8,5.4440e+00_r8,2.2652e-02_r8/) + kao(:, 2, 9,14) = (/ & + &5.9826e+01_r8,5.2350e+01_r8,4.4870e+01_r8,3.7394e+01_r8,2.9916e+01_r8,2.2436e+01_r8, & + &1.4957e+01_r8,7.4785e+00_r8,4.6893e-02_r8/) + kao(:, 3, 9,14) = (/ & + &7.8381e+01_r8,6.8585e+01_r8,5.8789e+01_r8,4.8993e+01_r8,3.9194e+01_r8,2.9396e+01_r8, & + &1.9597e+01_r8,9.7990e+00_r8,7.2210e-02_r8/) + kao(:, 4, 9,14) = (/ & + &9.9048e+01_r8,8.6676e+01_r8,7.4294e+01_r8,6.1915e+01_r8,4.9526e+01_r8,3.7147e+01_r8, & + &2.4767e+01_r8,1.2383e+01_r8,1.0452e-01_r8/) + kao(:, 5, 9,14) = (/ & + &1.2130e+02_r8,1.0614e+02_r8,9.0980e+01_r8,7.5818e+01_r8,6.0656e+01_r8,4.5493e+01_r8, & + &3.0327e+01_r8,1.5163e+01_r8,1.4798e-01_r8/) + kao(:, 1,10,14) = (/ & + &1.8821e+02_r8,1.6469e+02_r8,1.4116e+02_r8,1.1763e+02_r8,9.4105e+01_r8,7.0580e+01_r8, & + &4.7054e+01_r8,2.3527e+01_r8,9.8284e-06_r8/) + kao(:, 2,10,14) = (/ & + &2.6476e+02_r8,2.3166e+02_r8,1.9858e+02_r8,1.6548e+02_r8,1.3239e+02_r8,9.9294e+01_r8, & + &6.6189e+01_r8,3.3094e+01_r8,1.2967e-05_r8/) + kao(:, 3,10,14) = (/ & + &3.5496e+02_r8,3.1059e+02_r8,2.6621e+02_r8,2.2185e+02_r8,1.7748e+02_r8,1.3310e+02_r8, & + &8.8736e+01_r8,4.4370e+01_r8,2.4344e-02_r8/) + kao(:, 4,10,14) = (/ & + &4.5706e+02_r8,3.9992e+02_r8,3.4280e+02_r8,2.8566e+02_r8,2.2852e+02_r8,1.7137e+02_r8, & + &1.1427e+02_r8,5.7136e+01_r8,2.2864e-02_r8/) + kao(:, 5,10,14) = (/ & + &5.6918e+02_r8,4.9801e+02_r8,4.2687e+02_r8,3.5573e+02_r8,2.8459e+02_r8,2.1346e+02_r8, & + &1.4231e+02_r8,7.1148e+01_r8,3.1037e-02_r8/) + kao(:, 1,11,14) = (/ & + &3.3285e+02_r8,2.9123e+02_r8,2.4962e+02_r8,2.0803e+02_r8,1.6643e+02_r8,1.2482e+02_r8, & + &8.3209e+01_r8,4.1605e+01_r8,7.6787e-06_r8/) + kao(:, 2,11,14) = (/ & + &4.7091e+02_r8,4.1207e+02_r8,3.5320e+02_r8,2.9434e+02_r8,2.3549e+02_r8,1.7660e+02_r8, & + &1.1774e+02_r8,5.8871e+01_r8,1.2053e-05_r8/) + kao(:, 3,11,14) = (/ & + &6.3434e+02_r8,5.5505e+02_r8,4.7579e+02_r8,3.9648e+02_r8,3.1719e+02_r8,2.3787e+02_r8, & + &1.5859e+02_r8,7.9298e+01_r8,1.7979e-05_r8/) + kao(:, 4,11,14) = (/ & + &8.2080e+02_r8,7.1819e+02_r8,6.1562e+02_r8,5.1300e+02_r8,4.1039e+02_r8,3.0781e+02_r8, & + &2.0518e+02_r8,1.0261e+02_r8,2.6043e-05_r8/) + kao(:, 5,11,14) = (/ & + &1.0279e+03_r8,8.9936e+02_r8,7.7089e+02_r8,6.4243e+02_r8,5.1399e+02_r8,3.8545e+02_r8, & + &2.5700e+02_r8,1.2849e+02_r8,3.6811e-02_r8/) + kao(:, 1,12,14) = (/ & + &4.4072e+02_r8,3.8565e+02_r8,3.3056e+02_r8,2.7546e+02_r8,2.2036e+02_r8,1.6527e+02_r8, & + &1.1018e+02_r8,5.5100e+01_r8,6.3836e-06_r8/) + kao(:, 2,12,14) = (/ & + &6.2804e+02_r8,5.4949e+02_r8,4.7103e+02_r8,3.9252e+02_r8,3.1400e+02_r8,2.3550e+02_r8, & + &1.5700e+02_r8,7.8501e+01_r8,1.0354e-05_r8/) + kao(:, 3,12,14) = (/ & + &8.4964e+02_r8,7.4346e+02_r8,6.3726e+02_r8,5.3106e+02_r8,4.2484e+02_r8,3.1862e+02_r8, & + &2.1241e+02_r8,1.0621e+02_r8,1.6673e-05_r8/) + kao(:, 4,12,14) = (/ & + &1.1033e+03_r8,9.6532e+02_r8,8.2745e+02_r8,6.8953e+02_r8,5.5162e+02_r8,4.1376e+02_r8, & + &2.7582e+02_r8,1.3790e+02_r8,2.5500e-05_r8/) + kao(:, 5,12,14) = (/ & + &1.3847e+03_r8,1.2117e+03_r8,1.0386e+03_r8,8.6544e+02_r8,6.9241e+02_r8,5.1925e+02_r8, & + &3.4620e+02_r8,1.7310e+02_r8,3.8579e-05_r8/) + kao(:, 1,13,14) = (/ & + &4.7310e+02_r8,4.1397e+02_r8,3.5483e+02_r8,2.9569e+02_r8,2.3655e+02_r8,1.7741e+02_r8, & + &1.1827e+02_r8,5.9135e+01_r8,7.3062e-06_r8/) + kao(:, 2,13,14) = (/ & + &6.7569e+02_r8,5.9130e+02_r8,5.0679e+02_r8,4.2232e+02_r8,3.3786e+02_r8,2.5340e+02_r8, & + &1.6892e+02_r8,8.4465e+01_r8,8.6740e-06_r8/) + kao(:, 3,13,14) = (/ & + &9.1788e+02_r8,8.0315e+02_r8,6.8841e+02_r8,5.7369e+02_r8,4.5893e+02_r8,3.4424e+02_r8, & + &2.2946e+02_r8,1.1474e+02_r8,1.3663e-05_r8/) + kao(:, 4,13,14) = (/ & + &1.1975e+03_r8,1.0479e+03_r8,8.9816e+02_r8,7.4843e+02_r8,5.9874e+02_r8,4.4905e+02_r8, & + &2.9938e+02_r8,1.4969e+02_r8,2.1412e-05_r8/) + kao(:, 5,13,14) = (/ & + &1.5101e+03_r8,1.3214e+03_r8,1.1326e+03_r8,9.4376e+02_r8,7.5504e+02_r8,5.6626e+02_r8, & + &3.7752e+02_r8,1.8876e+02_r8,3.3615e-05_r8/) + kao(:, 1, 1,15) = (/ & + &1.9051e-01_r8,1.6674e-01_r8,1.4292e-01_r8,1.1918e-01_r8,9.5396e-02_r8,7.5613e-02_r8, & + &8.0457e-02_r8,7.8890e-02_r8,1.1694e-01_r8/) + kao(:, 2, 1,15) = (/ & + &2.2168e-01_r8,1.9400e-01_r8,1.6634e-01_r8,1.3865e-01_r8,1.1100e-01_r8,1.0009e-01_r8, & + &1.1113e-01_r8,1.0913e-01_r8,1.6166e-01_r8/) + kao(:, 3, 1,15) = (/ & + &2.5284e-01_r8,2.2130e-01_r8,1.8975e-01_r8,1.5816e-01_r8,1.2778e-01_r8,1.3319e-01_r8, & + &1.4805e-01_r8,1.4559e-01_r8,2.1625e-01_r8/) + kao(:, 4, 1,15) = (/ & + &2.8343e-01_r8,2.4807e-01_r8,2.1270e-01_r8,1.7731e-01_r8,1.5213e-01_r8,1.7480e-01_r8, & + &1.9314e-01_r8,1.8830e-01_r8,2.8691e-01_r8/) + kao(:, 5, 1,15) = (/ & + &3.1350e-01_r8,2.7439e-01_r8,2.3527e-01_r8,1.9622e-01_r8,1.9594e-01_r8,2.3135e-01_r8, & + &2.5307e-01_r8,2.4156e-01_r8,3.8082e-01_r8/) + kao(:, 1, 2,15) = (/ & + &3.2111e-01_r8,2.8102e-01_r8,2.4090e-01_r8,2.0079e-01_r8,1.6069e-01_r8,1.2054e-01_r8, & + &9.0034e-02_r8,8.9831e-02_r8,1.2243e-01_r8/) + kao(:, 2, 2,15) = (/ & + &3.7636e-01_r8,3.2926e-01_r8,2.8226e-01_r8,2.3534e-01_r8,1.8831e-01_r8,1.4126e-01_r8, & + &1.2281e-01_r8,1.2620e-01_r8,1.7187e-01_r8/) + kao(:, 3, 2,15) = (/ & + &4.3275e-01_r8,3.7860e-01_r8,3.2463e-01_r8,2.7055e-01_r8,2.1650e-01_r8,1.6706e-01_r8, & + &1.6578e-01_r8,1.7060e-01_r8,2.3384e-01_r8/) + kao(:, 4, 2,15) = (/ & + &4.8952e-01_r8,4.2824e-01_r8,3.6725e-01_r8,3.0597e-01_r8,2.4488e-01_r8,2.0300e-01_r8, & + &2.2012e-01_r8,2.2396e-01_r8,3.1375e-01_r8/) + kao(:, 5, 2,15) = (/ & + &5.4581e-01_r8,4.7748e-01_r8,4.0943e-01_r8,3.4119e-01_r8,2.7312e-01_r8,2.6005e-01_r8, & + &2.9166e-01_r8,2.9212e-01_r8,4.1866e-01_r8/) + kao(:, 1, 3,15) = (/ & + &6.9979e-01_r8,6.1213e-01_r8,5.2483e-01_r8,4.3719e-01_r8,3.4984e-01_r8,2.6243e-01_r8, & + &1.7501e-01_r8,9.9676e-02_r8,1.1688e-01_r8/) + kao(:, 2, 3,15) = (/ & + &8.3387e-01_r8,7.2959e-01_r8,6.2545e-01_r8,5.2112e-01_r8,4.1694e-01_r8,3.1278e-01_r8, & + &2.0862e-01_r8,1.3660e-01_r8,1.6827e-01_r8/) + kao(:, 3, 3,15) = (/ & + &9.7266e-01_r8,8.5098e-01_r8,7.2958e-01_r8,6.0802e-01_r8,4.8655e-01_r8,3.6492e-01_r8, & + &2.4335e-01_r8,1.8790e-01_r8,2.3450e-01_r8/) + kao(:, 4, 3,15) = (/ & + &1.1134e+00_r8,9.7421e-01_r8,8.3530e-01_r8,6.9606e-01_r8,5.5697e-01_r8,4.1779e-01_r8, & + &2.8251e-01_r8,2.5378e-01_r8,3.2011e-01_r8/) + kao(:, 5, 3,15) = (/ & + &1.2541e+00_r8,1.0974e+00_r8,9.4084e-01_r8,7.8396e-01_r8,6.2738e-01_r8,4.7061e-01_r8, & + &3.3812e-01_r8,3.3805e-01_r8,4.3341e-01_r8/) + kao(:, 1, 4,15) = (/ & + &1.5338e+00_r8,1.3422e+00_r8,1.1503e+00_r8,9.5870e-01_r8,7.6686e-01_r8,5.7527e-01_r8, & + &3.8351e-01_r8,1.9180e-01_r8,1.0723e-01_r8/) + kao(:, 2, 4,15) = (/ & + &1.8631e+00_r8,1.6302e+00_r8,1.3974e+00_r8,1.1644e+00_r8,9.3180e-01_r8,6.9872e-01_r8, & + &4.6589e-01_r8,2.3301e-01_r8,1.5610e-01_r8/) + kao(:, 3, 4,15) = (/ & + &2.2077e+00_r8,1.9315e+00_r8,1.6557e+00_r8,1.3803e+00_r8,1.1039e+00_r8,8.2801e-01_r8, & + &5.5191e-01_r8,2.7612e-01_r8,2.2377e-01_r8/) + kao(:, 4, 4,15) = (/ & + &2.5609e+00_r8,2.2407e+00_r8,1.9209e+00_r8,1.6005e+00_r8,1.2804e+00_r8,9.6050e-01_r8, & + &6.4039e-01_r8,3.2615e-01_r8,3.1195e-01_r8/) + kao(:, 5, 4,15) = (/ & + &2.9154e+00_r8,2.5514e+00_r8,2.1867e+00_r8,1.8223e+00_r8,1.4581e+00_r8,1.0937e+00_r8, & + &7.2913e-01_r8,3.9607e-01_r8,4.2846e-01_r8/) + kao(:, 1, 5,15) = (/ & + &3.0736e+00_r8,2.6896e+00_r8,2.3057e+00_r8,1.9212e+00_r8,1.5370e+00_r8,1.1527e+00_r8, & + &7.6854e-01_r8,3.8431e-01_r8,1.0147e-01_r8/) + kao(:, 2, 5,15) = (/ & + &3.8075e+00_r8,3.3314e+00_r8,2.8555e+00_r8,2.3797e+00_r8,1.9037e+00_r8,1.4279e+00_r8, & + &9.5192e-01_r8,4.7599e-01_r8,1.4471e-01_r8/) + kao(:, 3, 5,15) = (/ & + &4.5849e+00_r8,4.0117e+00_r8,3.4370e+00_r8,2.8652e+00_r8,2.2919e+00_r8,1.7190e+00_r8, & + &1.1462e+00_r8,5.7315e-01_r8,2.0749e-01_r8/) + kao(:, 4, 5,15) = (/ & + &5.3872e+00_r8,4.7143e+00_r8,4.0418e+00_r8,3.3672e+00_r8,2.6939e+00_r8,2.0205e+00_r8, & + &1.3469e+00_r8,6.7361e-01_r8,2.9614e-01_r8/) + kao(:, 5, 5,15) = (/ & + &6.2028e+00_r8,5.4263e+00_r8,4.6517e+00_r8,3.8766e+00_r8,3.1014e+00_r8,2.3260e+00_r8, & + &1.5507e+00_r8,7.7527e-01_r8,4.1447e-01_r8/) + kao(:, 1, 6,15) = (/ & + &5.6666e+00_r8,4.9583e+00_r8,4.2496e+00_r8,3.5417e+00_r8,2.8332e+00_r8,2.1246e+00_r8, & + &1.4165e+00_r8,7.0837e-01_r8,9.5689e-02_r8/) + kao(:, 2, 6,15) = (/ & + &7.1702e+00_r8,6.2735e+00_r8,5.3788e+00_r8,4.4810e+00_r8,3.5859e+00_r8,2.6888e+00_r8, & + &1.7925e+00_r8,8.9634e-01_r8,1.3582e-01_r8/) + kao(:, 3, 6,15) = (/ & + &8.7850e+00_r8,7.6873e+00_r8,6.5880e+00_r8,5.4902e+00_r8,4.3923e+00_r8,3.2943e+00_r8, & + &2.1960e+00_r8,1.0981e+00_r8,1.9014e-01_r8/) + kao(:, 4, 6,15) = (/ & + &1.0471e+01_r8,9.1623e+00_r8,7.8537e+00_r8,6.5443e+00_r8,5.2362e+00_r8,3.9265e+00_r8, & + &2.6173e+00_r8,1.3091e+00_r8,2.7084e-01_r8/) + kao(:, 5, 6,15) = (/ & + &1.2195e+01_r8,1.0670e+01_r8,9.1465e+00_r8,7.6219e+00_r8,6.0976e+00_r8,4.5729e+00_r8, & + &3.0483e+00_r8,1.5247e+00_r8,3.8788e-01_r8/) + kao(:, 1, 7,15) = (/ & + &1.0821e+01_r8,9.4694e+00_r8,8.1159e+00_r8,6.7641e+00_r8,5.4109e+00_r8,4.0578e+00_r8, & + &2.7049e+00_r8,1.3527e+00_r8,8.8090e-02_r8/) + kao(:, 2, 7,15) = (/ & + &1.4005e+01_r8,1.2256e+01_r8,1.0505e+01_r8,8.7544e+00_r8,7.0039e+00_r8,5.2527e+00_r8, & + &3.5019e+00_r8,1.7510e+00_r8,1.2836e-01_r8/) + kao(:, 3, 7,15) = (/ & + &1.7472e+01_r8,1.5288e+01_r8,1.3104e+01_r8,1.0920e+01_r8,8.7370e+00_r8,6.5526e+00_r8, & + &4.3682e+00_r8,2.1842e+00_r8,1.7912e-01_r8/) + kao(:, 4, 7,15) = (/ & + &2.1133e+01_r8,1.8491e+01_r8,1.5850e+01_r8,1.3209e+01_r8,1.0568e+01_r8,7.9265e+00_r8, & + &5.2835e+00_r8,2.6416e+00_r8,2.4968e-01_r8/) + kao(:, 5, 7,15) = (/ & + &2.4946e+01_r8,2.1829e+01_r8,1.8712e+01_r8,1.5594e+01_r8,1.2475e+01_r8,9.3563e+00_r8, & + &6.2369e+00_r8,3.1183e+00_r8,3.5418e-01_r8/) + kao(:, 1, 8,15) = (/ & + &2.4402e+01_r8,2.1362e+01_r8,1.8302e+01_r8,1.5253e+01_r8,1.2203e+01_r8,9.1488e+00_r8, & + &6.1012e+00_r8,3.0503e+00_r8,8.0172e-02_r8/) + kao(:, 2, 8,15) = (/ & + &3.2338e+01_r8,2.8299e+01_r8,2.4254e+01_r8,2.0211e+01_r8,1.6168e+01_r8,1.2127e+01_r8, & + &8.0850e+00_r8,4.0423e+00_r8,1.1917e-01_r8/) + kao(:, 3, 8,15) = (/ & + &4.1117e+01_r8,3.5977e+01_r8,3.0837e+01_r8,2.5703e+01_r8,2.0563e+01_r8,1.5418e+01_r8, & + &1.0280e+01_r8,5.1397e+00_r8,1.6937e-01_r8/) + kao(:, 4, 8,15) = (/ & + &5.0705e+01_r8,4.4368e+01_r8,3.8026e+01_r8,3.1698e+01_r8,2.5350e+01_r8,1.9014e+01_r8, & + &1.2673e+01_r8,6.3384e+00_r8,2.3470e-01_r8/) + kao(:, 5, 8,15) = (/ & + &6.0900e+01_r8,5.3282e+01_r8,4.5673e+01_r8,3.8064e+01_r8,3.0449e+01_r8,2.2835e+01_r8, & + &1.5224e+01_r8,7.6126e+00_r8,3.2704e-01_r8/) + kao(:, 1, 9,15) = (/ & + &1.0170e+02_r8,8.8996e+01_r8,7.6286e+01_r8,6.3569e+01_r8,5.0854e+01_r8,3.8145e+01_r8, & + &2.5429e+01_r8,1.2713e+01_r8,7.1359e-02_r8/) + kao(:, 2, 9,15) = (/ & + &1.3845e+02_r8,1.2114e+02_r8,1.0384e+02_r8,8.6532e+01_r8,6.9224e+01_r8,5.1921e+01_r8, & + &3.4611e+01_r8,1.7307e+01_r8,1.0767e-01_r8/) + kao(:, 3, 9,15) = (/ & + &1.8073e+02_r8,1.5810e+02_r8,1.3551e+02_r8,1.1293e+02_r8,9.0345e+01_r8,6.7755e+01_r8, & + &4.5176e+01_r8,2.2583e+01_r8,1.5849e-01_r8/) + kao(:, 4, 9,15) = (/ & + &2.2745e+02_r8,1.9903e+02_r8,1.7061e+02_r8,1.4217e+02_r8,1.1373e+02_r8,8.5301e+01_r8, & + &5.6875e+01_r8,2.8433e+01_r8,2.2030e-01_r8/) + kao(:, 5, 9,15) = (/ & + &2.7773e+02_r8,2.4298e+02_r8,2.0829e+02_r8,1.7358e+02_r8,1.3886e+02_r8,1.0414e+02_r8, & + &6.9430e+01_r8,3.4715e+01_r8,3.0575e-01_r8/) + kao(:, 1,10,15) = (/ & + &4.7674e+02_r8,4.1715e+02_r8,3.5753e+02_r8,2.9794e+02_r8,2.3835e+02_r8,1.7878e+02_r8, & + &1.1918e+02_r8,5.9592e+01_r8,7.9888e-06_r8/) + kao(:, 2,10,15) = (/ & + &6.6856e+02_r8,5.8521e+02_r8,5.0164e+02_r8,4.1786e+02_r8,3.3435e+02_r8,2.5071e+02_r8, & + &1.6719e+02_r8,8.3597e+01_r8,1.0572e-05_r8/) + kao(:, 3,10,15) = (/ & + &8.9281e+02_r8,7.8118e+02_r8,6.6956e+02_r8,5.5797e+02_r8,4.4639e+02_r8,3.3479e+02_r8, & + &2.2318e+02_r8,1.1160e+02_r8,1.3235e-05_r8/) + kao(:, 4,10,15) = (/ & + &1.1439e+03_r8,1.0009e+03_r8,8.5793e+02_r8,7.1497e+02_r8,5.7192e+02_r8,4.2885e+02_r8, & + &2.8596e+02_r8,1.4299e+02_r8,7.9928e-02_r8/) + kao(:, 5,10,15) = (/ & + &1.4160e+03_r8,1.2390e+03_r8,1.0620e+03_r8,8.8492e+02_r8,7.0798e+02_r8,5.3098e+02_r8, & + &3.5397e+02_r8,1.7699e+02_r8,2.0557e-01_r8/) + kao(:, 1,11,15) = (/ & + &9.1777e+02_r8,8.0296e+02_r8,6.8835e+02_r8,5.7354e+02_r8,4.5882e+02_r8,3.4414e+02_r8, & + &2.2941e+02_r8,1.1472e+02_r8,9.0079e-06_r8/) + kao(:, 2,11,15) = (/ & + &1.2897e+03_r8,1.1284e+03_r8,9.6718e+02_r8,8.0605e+02_r8,6.4484e+02_r8,4.8368e+02_r8, & + &3.2242e+02_r8,1.6120e+02_r8,1.0534e-05_r8/) + kao(:, 3,11,15) = (/ & + &1.7217e+03_r8,1.5064e+03_r8,1.2912e+03_r8,1.0761e+03_r8,8.6072e+02_r8,6.4564e+02_r8, & + &4.3042e+02_r8,2.1520e+02_r8,1.2890e-05_r8/) + kao(:, 4,11,15) = (/ & + &2.2030e+03_r8,1.9276e+03_r8,1.6522e+03_r8,1.3769e+03_r8,1.1015e+03_r8,8.2614e+02_r8, & + &5.5075e+02_r8,2.7537e+02_r8,1.8773e-05_r8/) + kao(:, 5,11,15) = (/ & + &2.7288e+03_r8,2.3877e+03_r8,2.0468e+03_r8,1.7056e+03_r8,1.3645e+03_r8,1.0232e+03_r8, & + &6.8218e+02_r8,3.4109e+02_r8,2.8192e-05_r8/) + kao(:, 1,12,15) = (/ & + &1.3049e+03_r8,1.1418e+03_r8,9.7855e+02_r8,8.1546e+02_r8,6.5249e+02_r8,4.8934e+02_r8, & + &3.2625e+02_r8,1.6311e+02_r8,7.4201e-06_r8/) + kao(:, 2,12,15) = (/ & + &1.8314e+03_r8,1.6024e+03_r8,1.3735e+03_r8,1.1446e+03_r8,9.1569e+02_r8,6.8677e+02_r8, & + &4.5789e+02_r8,2.2893e+02_r8,9.0712e-06_r8/) + kao(:, 3,12,15) = (/ & + &2.4447e+03_r8,2.1390e+03_r8,1.8335e+03_r8,1.5279e+03_r8,1.2222e+03_r8,9.1674e+02_r8, & + &6.1121e+02_r8,3.0557e+02_r8,9.2932e-06_r8/) + kao(:, 4,12,15) = (/ & + &3.1395e+03_r8,2.7470e+03_r8,2.3545e+03_r8,1.9622e+03_r8,1.5697e+03_r8,1.1774e+03_r8, & + &7.8488e+02_r8,3.9241e+02_r8,1.2651e-05_r8/) + kao(:, 5,12,15) = (/ & + &3.8988e+03_r8,3.4115e+03_r8,2.9243e+03_r8,2.4367e+03_r8,1.9495e+03_r8,1.4621e+03_r8, & + &9.7464e+02_r8,4.8737e+02_r8,2.0431e-05_r8/) + kao(:, 1,13,15) = (/ & + &1.4703e+03_r8,1.2867e+03_r8,1.1028e+03_r8,9.1904e+02_r8,7.3532e+02_r8,5.5150e+02_r8, & + &3.6759e+02_r8,1.8380e+02_r8,5.1458e-06_r8/) + kao(:, 2,13,15) = (/ & + &2.0704e+03_r8,1.8115e+03_r8,1.5528e+03_r8,1.2939e+03_r8,1.0351e+03_r8,7.7638e+02_r8, & + &5.1765e+02_r8,2.5875e+02_r8,6.1867e-06_r8/) + kao(:, 3,13,15) = (/ & + &2.7739e+03_r8,2.4272e+03_r8,2.0805e+03_r8,1.7336e+03_r8,1.3869e+03_r8,1.0403e+03_r8, & + &6.9356e+02_r8,3.4674e+02_r8,7.7061e-06_r8/) + kao(:, 4,13,15) = (/ & + &3.5658e+03_r8,3.1198e+03_r8,2.6740e+03_r8,2.2287e+03_r8,1.7830e+03_r8,1.3371e+03_r8, & + &8.9142e+02_r8,4.4572e+02_r8,1.1573e-05_r8/) + kao(:, 5,13,15) = (/ & + &4.4270e+03_r8,3.8738e+03_r8,3.3205e+03_r8,2.7670e+03_r8,2.2135e+03_r8,1.6602e+03_r8, & + &1.1068e+03_r8,5.5337e+02_r8,1.8919e-05_r8/) + kao(:, 1, 1,16) = (/ & + &2.0584e-01_r8,1.8014e-01_r8,1.5444e-01_r8,1.2874e-01_r8,1.0304e-01_r8,7.7345e-02_r8, & + &8.4273e-02_r8,8.1561e-02_r8,1.2397e-01_r8/) + kao(:, 2, 1,16) = (/ & + &2.4103e-01_r8,2.1093e-01_r8,1.8085e-01_r8,1.5075e-01_r8,1.2067e-01_r8,1.0583e-01_r8, & + &1.1670e-01_r8,1.1303e-01_r8,1.7190e-01_r8/) + kao(:, 3, 1,16) = (/ & + &2.7664e-01_r8,2.4213e-01_r8,2.0759e-01_r8,1.7305e-01_r8,1.3852e-01_r8,1.4127e-01_r8, & + &1.5588e-01_r8,1.5105e-01_r8,2.2980e-01_r8/) + kao(:, 4, 1,16) = (/ & + &3.1217e-01_r8,2.7321e-01_r8,2.3426e-01_r8,1.9529e-01_r8,1.5635e-01_r8,1.8285e-01_r8, & + &2.0187e-01_r8,1.9571e-01_r8,2.9781e-01_r8/) + kao(:, 5, 1,16) = (/ & + &3.4704e-01_r8,3.0374e-01_r8,2.6044e-01_r8,2.1712e-01_r8,2.0704e-01_r8,2.4179e-01_r8, & + &2.6249e-01_r8,2.4688e-01_r8,4.0744e-01_r8/) + kao(:, 1, 2,16) = (/ & + &3.5775e-01_r8,3.1302e-01_r8,2.6832e-01_r8,2.2363e-01_r8,1.7894e-01_r8,1.3423e-01_r8, & + &9.4199e-02_r8,9.5152e-02_r8,1.3347e-01_r8/) + kao(:, 2, 2,16) = (/ & + &4.2272e-01_r8,3.6993e-01_r8,3.1710e-01_r8,2.6431e-01_r8,2.1146e-01_r8,1.5866e-01_r8, & + &1.3268e-01_r8,1.3412e-01_r8,1.8823e-01_r8/) + kao(:, 3, 2,16) = (/ & + &4.8911e-01_r8,4.2798e-01_r8,3.6687e-01_r8,3.0577e-01_r8,2.4466e-01_r8,1.8360e-01_r8, & + &1.7978e-01_r8,1.8185e-01_r8,2.5529e-01_r8/) + kao(:, 4, 2,16) = (/ & + &5.5559e-01_r8,4.8623e-01_r8,4.1679e-01_r8,3.4735e-01_r8,2.7796e-01_r8,2.0932e-01_r8, & + &2.3570e-01_r8,2.3853e-01_r8,3.3493e-01_r8/) + kao(:, 5, 2,16) = (/ & + &6.2130e-01_r8,5.4374e-01_r8,4.6609e-01_r8,3.8845e-01_r8,3.1090e-01_r8,2.6998e-01_r8, & + &3.0230e-01_r8,3.0412e-01_r8,4.4787e-01_r8/) + kao(:, 1, 3,16) = (/ & + &8.0759e-01_r8,7.0655e-01_r8,6.0564e-01_r8,5.0473e-01_r8,4.0382e-01_r8,3.0291e-01_r8, & + &2.0195e-01_r8,1.0457e-01_r8,1.3240e-01_r8/) + kao(:, 2, 3,16) = (/ & + &9.6833e-01_r8,8.4737e-01_r8,7.2636e-01_r8,6.0527e-01_r8,4.8421e-01_r8,3.6321e-01_r8, & + &2.4220e-01_r8,1.5138e-01_r8,1.9184e-01_r8/) + kao(:, 3, 3,16) = (/ & + &1.1342e+00_r8,9.9245e-01_r8,8.5072e-01_r8,7.0903e-01_r8,5.6727e-01_r8,4.2548e-01_r8, & + &2.8373e-01_r8,2.0993e-01_r8,2.6621e-01_r8/) + kao(:, 4, 3,16) = (/ & + &1.3024e+00_r8,1.1395e+00_r8,9.7685e-01_r8,8.1409e-01_r8,6.5126e-01_r8,4.8855e-01_r8, & + &3.2575e-01_r8,2.8072e-01_r8,3.5605e-01_r8/) + kao(:, 5, 3,16) = (/ & + &1.4698e+00_r8,1.2860e+00_r8,1.1024e+00_r8,9.1880e-01_r8,7.3505e-01_r8,5.5132e-01_r8, & + &3.6767e-01_r8,3.6382e-01_r8,4.6256e-01_r8/) + kao(:, 1, 4,16) = (/ & + &1.8354e+00_r8,1.6059e+00_r8,1.3766e+00_r8,1.1471e+00_r8,9.1770e-01_r8,6.8825e-01_r8, & + &4.5887e-01_r8,2.2948e-01_r8,1.2512e-01_r8/) + kao(:, 2, 4,16) = (/ & + &2.2391e+00_r8,1.9593e+00_r8,1.6796e+00_r8,1.3998e+00_r8,1.1197e+00_r8,8.3982e-01_r8, & + &5.5988e-01_r8,2.7997e-01_r8,1.8724e-01_r8/) + kao(:, 3, 4,16) = (/ & + &2.6616e+00_r8,2.3290e+00_r8,1.9963e+00_r8,1.6635e+00_r8,1.3310e+00_r8,9.9835e-01_r8, & + &6.6551e-01_r8,3.3282e-01_r8,2.6695e-01_r8/) + kao(:, 4, 4,16) = (/ & + &3.0942e+00_r8,2.7077e+00_r8,2.3212e+00_r8,1.9341e+00_r8,1.5474e+00_r8,1.1605e+00_r8, & + &7.7373e-01_r8,3.8698e-01_r8,3.6534e-01_r8/) + kao(:, 5, 4,16) = (/ & + &3.5299e+00_r8,3.0886e+00_r8,2.6475e+00_r8,2.2065e+00_r8,1.7650e+00_r8,1.3239e+00_r8, & + &8.8260e-01_r8,4.4141e-01_r8,4.8300e-01_r8/) + kao(:, 1, 5,16) = (/ & + &3.8226e+00_r8,3.3446e+00_r8,2.8509e+00_r8,2.3892e+00_r8,1.9114e+00_r8,1.4335e+00_r8, & + &9.5565e-01_r8,4.7787e-01_r8,1.1560e-01_r8/) + kao(:, 2, 5,16) = (/ & + &4.7529e+00_r8,4.1589e+00_r8,3.5644e+00_r8,2.9706e+00_r8,2.3763e+00_r8,1.7823e+00_r8, & + &1.1883e+00_r8,5.9413e-01_r8,1.7922e-01_r8/) + kao(:, 3, 5,16) = (/ & + &5.7385e+00_r8,5.0213e+00_r8,4.3040e+00_r8,3.5869e+00_r8,2.8697e+00_r8,2.1522e+00_r8, & + &1.4347e+00_r8,7.1742e-01_r8,2.6311e-01_r8/) + kao(:, 4, 5,16) = (/ & + &6.7615e+00_r8,5.9164e+00_r8,5.0713e+00_r8,4.2261e+00_r8,3.3806e+00_r8,2.5357e+00_r8, & + &1.6905e+00_r8,8.4524e-01_r8,3.6914e-01_r8/) + kao(:, 5, 5,16) = (/ & + &7.8020e+00_r8,6.8269e+00_r8,5.8507e+00_r8,4.8765e+00_r8,3.9008e+00_r8,2.9261e+00_r8, & + &1.9507e+00_r8,9.7534e-01_r8,4.9832e-01_r8/) + kao(:, 1, 6,16) = (/ & + &7.3571e+00_r8,6.4369e+00_r8,5.5172e+00_r8,4.5985e+00_r8,3.6783e+00_r8,2.7589e+00_r8, & + &1.8291e+00_r8,9.1965e-01_r8,1.0645e-01_r8/) + kao(:, 2, 6,16) = (/ & + &9.3468e+00_r8,8.1778e+00_r8,7.0095e+00_r8,5.8414e+00_r8,4.6732e+00_r8,3.5051e+00_r8, & + &2.3366e+00_r8,1.1682e+00_r8,1.6617e-01_r8/) + kao(:, 3, 6,16) = (/ & + &1.1491e+01_r8,1.0055e+01_r8,8.6175e+00_r8,7.1820e+00_r8,5.7127e+00_r8,4.3090e+00_r8, & + &2.8724e+00_r8,1.4282e+00_r8,2.5233e-01_r8/) + kao(:, 4, 6,16) = (/ & + &1.3744e+01_r8,1.2025e+01_r8,1.0308e+01_r8,8.5898e+00_r8,6.8725e+00_r8,5.1546e+00_r8, & + &3.4361e+00_r8,1.7180e+00_r8,3.6410e-01_r8/) + kao(:, 5, 6,16) = (/ & + &1.6063e+01_r8,1.4056e+01_r8,1.2048e+01_r8,1.0040e+01_r8,8.0325e+00_r8,6.0238e+00_r8, & + &4.0162e+00_r8,2.0081e+00_r8,5.0340e-01_r8/) + kao(:, 1, 7,16) = (/ & + &1.4766e+01_r8,1.2923e+01_r8,1.1075e+01_r8,9.2294e+00_r8,7.3836e+00_r8,5.5378e+00_r8, & + &3.6915e+00_r8,1.8460e+00_r8,1.0988e-01_r8/) + kao(:, 2, 7,16) = (/ & + &1.9210e+01_r8,1.6809e+01_r8,1.4406e+01_r8,1.2004e+01_r8,9.6049e+00_r8,7.2040e+00_r8, & + &4.8023e+00_r8,2.4010e+00_r8,1.5119e-01_r8/) + kao(:, 3, 7,16) = (/ & + &2.4080e+01_r8,2.1071e+01_r8,1.8060e+01_r8,1.5050e+01_r8,1.2042e+01_r8,9.0305e+00_r8, & + &6.0199e+00_r8,2.9934e+00_r8,2.3822e-01_r8/) + kao(:, 4, 7,16) = (/ & + &2.9278e+01_r8,2.5619e+01_r8,2.1957e+01_r8,1.8300e+01_r8,1.4640e+01_r8,1.0980e+01_r8, & + &7.3208e+00_r8,3.6596e+00_r8,3.5444e-01_r8/) + kao(:, 5, 7,16) = (/ & + &3.4690e+01_r8,3.0352e+01_r8,2.6017e+01_r8,2.1683e+01_r8,1.7349e+01_r8,1.3009e+01_r8, & + &8.6734e+00_r8,4.3366e+00_r8,5.0281e-01_r8/) + kao(:, 1, 8,16) = (/ & + &3.5305e+01_r8,3.0898e+01_r8,2.6479e+01_r8,2.2066e+01_r8,1.7653e+01_r8,1.3237e+01_r8, & + &8.8267e+00_r8,4.4136e+00_r8,1.1225e-01_r8/) + kao(:, 2, 8,16) = (/ & + &4.7105e+01_r8,4.1217e+01_r8,3.5327e+01_r8,2.9443e+01_r8,2.3551e+01_r8,1.7664e+01_r8, & + &1.1776e+01_r8,5.8880e+00_r8,1.4909e-01_r8/) + kao(:, 3, 8,16) = (/ & + &6.0289e+01_r8,5.2760e+01_r8,4.5222e+01_r8,3.7680e+01_r8,3.0141e+01_r8,2.2609e+01_r8, & + &1.5075e+01_r8,7.5364e+00_r8,2.2235e-01_r8/) + kao(:, 4, 8,16) = (/ & + &7.4572e+01_r8,6.4882e+01_r8,5.5930e+01_r8,4.6614e+01_r8,3.7287e+01_r8,2.7965e+01_r8, & + &1.8642e+01_r8,9.3209e+00_r8,3.4182e-01_r8/) + kao(:, 5, 8,16) = (/ & + &8.9645e+01_r8,7.8444e+01_r8,6.7227e+01_r8,5.6021e+01_r8,4.4815e+01_r8,3.3612e+01_r8, & + &2.2408e+01_r8,1.1205e+01_r8,4.9824e-01_r8/) + kao(:, 1, 9,16) = (/ & + &1.5759e+02_r8,1.3788e+02_r8,1.1817e+02_r8,9.8475e+01_r8,7.8796e+01_r8,5.9083e+01_r8, & + &3.9390e+01_r8,1.9699e+01_r8,1.1304e-01_r8/) + kao(:, 2, 9,16) = (/ & + &2.1616e+02_r8,1.8914e+02_r8,1.6212e+02_r8,1.3510e+02_r8,1.0808e+02_r8,8.1068e+01_r8, & + &5.4043e+01_r8,2.7021e+01_r8,1.5445e-01_r8/) + kao(:, 3, 9,16) = (/ & + &2.8258e+02_r8,2.4760e+02_r8,2.1223e+02_r8,1.7686e+02_r8,1.4149e+02_r8,1.0611e+02_r8, & + &7.0744e+01_r8,3.5373e+01_r8,2.0441e-01_r8/) + kao(:, 4, 9,16) = (/ & + &3.5653e+02_r8,3.1192e+02_r8,2.6735e+02_r8,2.2280e+02_r8,1.7825e+02_r8,1.3369e+02_r8, & + &8.9123e+01_r8,4.4565e+01_r8,3.2503e-01_r8/) + kao(:, 5, 9,16) = (/ & + &4.3513e+02_r8,3.8075e+02_r8,3.2632e+02_r8,2.7197e+02_r8,2.1754e+02_r8,1.6316e+02_r8, & + &1.0877e+02_r8,5.4390e+01_r8,4.8785e-01_r8/) + kao(:, 1,10,16) = (/ & + &7.9828e+02_r8,6.9859e+02_r8,5.9871e+02_r8,4.9899e+02_r8,3.9914e+02_r8,2.9935e+02_r8, & + &1.9957e+02_r8,9.9786e+01_r8,1.4112e-06_r8/) + kao(:, 2,10,16) = (/ & + &1.1235e+03_r8,9.8329e+02_r8,8.4282e+02_r8,7.0236e+02_r8,5.6188e+02_r8,4.2131e+02_r8, & + &2.8094e+02_r8,1.4047e+02_r8,1.8812e-06_r8/) + kao(:, 3,10,16) = (/ & + &1.5014e+03_r8,1.3138e+03_r8,1.1261e+03_r8,9.3840e+02_r8,7.5072e+02_r8,5.6311e+02_r8, & + &3.7536e+02_r8,1.8771e+02_r8,2.5472e-06_r8/) + kao(:, 4,10,16) = (/ & + &1.9233e+03_r8,1.6832e+03_r8,1.4427e+03_r8,1.2020e+03_r8,9.6160e+02_r8,7.2135e+02_r8, & + &4.8081e+02_r8,2.4039e+02_r8,3.1592e-01_r8/) + kao(:, 5,10,16) = (/ & + &2.3793e+03_r8,2.0824e+03_r8,1.7849e+03_r8,1.4876e+03_r8,1.1900e+03_r8,8.9243e+02_r8, & + &5.9503e+02_r8,2.9747e+02_r8,4.8703e-01_r8/) + kao(:, 1,11,16) = (/ & + &1.6695e+03_r8,1.4608e+03_r8,1.2521e+03_r8,1.0434e+03_r8,8.3472e+02_r8,6.2605e+02_r8, & + &4.1737e+02_r8,2.0867e+02_r8,1.1529e-06_r8/) + kao(:, 2,11,16) = (/ & + &2.3476e+03_r8,2.0540e+03_r8,1.7608e+03_r8,1.4673e+03_r8,1.1739e+03_r8,8.8029e+02_r8, & + &5.8691e+02_r8,2.9349e+02_r8,1.5382e-06_r8/) + kao(:, 3,11,16) = (/ & + &3.1326e+03_r8,2.7416e+03_r8,2.3500e+03_r8,1.9579e+03_r8,1.5664e+03_r8,1.1749e+03_r8, & + &7.8334e+02_r8,3.9162e+02_r8,2.0823e-06_r8/) + kao(:, 4,11,16) = (/ & + &4.0087e+03_r8,3.5076e+03_r8,3.0065e+03_r8,2.5054e+03_r8,2.0043e+03_r8,1.5033e+03_r8, & + &1.0022e+03_r8,5.0110e+02_r8,2.4008e-06_r8/) + kao(:, 5,11,16) = (/ & + &4.9540e+03_r8,4.3346e+03_r8,3.7151e+03_r8,3.0963e+03_r8,2.4766e+03_r8,1.8577e+03_r8, & + &1.2385e+03_r8,6.1917e+02_r8,1.3302e-05_r8/) + kao(:, 1,12,16) = (/ & + &2.5940e+03_r8,2.2689e+03_r8,1.9455e+03_r8,1.6210e+03_r8,1.2970e+03_r8,9.7271e+02_r8, & + &6.4849e+02_r8,3.2418e+02_r8,9.4397e-07_r8/) + kao(:, 2,12,16) = (/ & + &3.6401e+03_r8,3.1850e+03_r8,2.7301e+03_r8,2.2751e+03_r8,1.8200e+03_r8,1.3650e+03_r8, & + &9.1001e+02_r8,4.5497e+02_r8,1.2594e-06_r8/) + kao(:, 3,12,16) = (/ & + &4.8482e+03_r8,4.2436e+03_r8,3.6368e+03_r8,3.0301e+03_r8,2.4250e+03_r8,1.8187e+03_r8, & + &1.2120e+03_r8,6.0606e+02_r8,1.2513e-05_r8/) + kao(:, 4,12,16) = (/ & + &6.1914e+03_r8,5.4187e+03_r8,4.6435e+03_r8,3.8696e+03_r8,3.0964e+03_r8,2.3220e+03_r8, & + &1.5479e+03_r8,7.7403e+02_r8,2.0845e-05_r8/) + kao(:, 5,12,16) = (/ & + &7.6366e+03_r8,6.6419e+03_r8,5.7257e+03_r8,4.7728e+03_r8,3.8188e+03_r8,2.8637e+03_r8, & + &1.9092e+03_r8,9.4962e+02_r8,2.1463e-05_r8/) + kao(:, 1,13,16) = (/ & + &3.2192e+03_r8,2.8160e+03_r8,2.4141e+03_r8,2.0117e+03_r8,1.6091e+03_r8,1.2070e+03_r8, & + &8.0460e+02_r8,4.0235e+02_r8,2.5866e-06_r8/) + kao(:, 2,13,16) = (/ & + &4.5059e+03_r8,3.9428e+03_r8,3.3791e+03_r8,2.8160e+03_r8,2.2531e+03_r8,1.6897e+03_r8, & + &1.1264e+03_r8,5.6328e+02_r8,9.4719e-06_r8/) + kao(:, 3,13,16) = (/ & + &5.9881e+03_r8,5.2388e+03_r8,4.4907e+03_r8,3.7423e+03_r8,2.9935e+03_r8,2.2450e+03_r8, & + &1.4968e+03_r8,7.4841e+02_r8,1.6561e-05_r8/) + kao(:, 4,13,16) = (/ & + &7.6265e+03_r8,6.6729e+03_r8,5.7200e+03_r8,4.7671e+03_r8,3.8133e+03_r8,2.8600e+03_r8, & + &1.9066e+03_r8,9.4757e+02_r8,2.1537e-05_r8/) + kao(:, 5,13,16) = (/ & + &9.3827e+03_r8,8.2086e+03_r8,7.0366e+03_r8,5.8639e+03_r8,4.6917e+03_r8,3.5181e+03_r8, & + &2.3456e+03_r8,1.1729e+03_r8,2.1283e-05_r8/) + +! The array KBO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels < ~100mb, temperatures, and ratios +! of H2O to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index, JT, which +! runs from 1 to 5, corresponds to different temperatures. More +! specifically, JT = 3 means that the data are for the corresponding +! reference temperature TREF for this pressure level, JT = 2 refers +! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and +! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and +! refers to the corresponding pressure level in PREF (e.g. JP = 13 is +! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to +! 16, and tells us which g-interval the absorption coefficients are for. + + kbo(:, 1,13, 1) = (/ & + &1.5731e-03_r8,1.8696e-03_r8,1.8486e-03_r8,1.7186e-03_r8,1.3898e-03_r8/) + kbo(:, 2,13, 1) = (/ & + &1.8623e-03_r8,2.3963e-03_r8,2.4362e-03_r8,2.2990e-03_r8,1.8223e-03_r8/) + kbo(:, 3,13, 1) = (/ & + &2.3718e-03_r8,3.1878e-03_r8,3.2540e-03_r8,3.0430e-03_r8,2.2915e-03_r8/) + kbo(:, 4,13, 1) = (/ & + &3.1921e-03_r8,4.3104e-03_r8,4.3590e-03_r8,3.9821e-03_r8,2.7709e-03_r8/) + kbo(:, 5,13, 1) = (/ & + &4.4313e-03_r8,5.8691e-03_r8,5.8118e-03_r8,5.1528e-03_r8,3.2426e-03_r8/) + kbo(:, 1,14, 1) = (/ & + &8.1496e-04_r8,1.1449e-03_r8,1.2521e-03_r8,1.2864e-03_r8,1.1830e-03_r8/) + kbo(:, 2,14, 1) = (/ & + &9.7291e-04_r8,1.4990e-03_r8,1.6700e-03_r8,1.7215e-03_r8,1.5434e-03_r8/) + kbo(:, 3,14, 1) = (/ & + &1.2487e-03_r8,2.0089e-03_r8,2.2296e-03_r8,2.2624e-03_r8,1.9289e-03_r8/) + kbo(:, 4,14, 1) = (/ & + &1.6881e-03_r8,2.7166e-03_r8,2.9639e-03_r8,2.9248e-03_r8,2.3207e-03_r8/) + kbo(:, 5,14, 1) = (/ & + &2.3524e-03_r8,3.6802e-03_r8,3.9082e-03_r8,3.7262e-03_r8,2.7008e-03_r8/) + kbo(:, 1,15, 1) = (/ & + &4.3177e-04_r8,7.4258e-04_r8,8.9651e-04_r8,1.0013e-03_r8,1.0098e-03_r8/) + kbo(:, 2,15, 1) = (/ & + &5.2028e-04_r8,9.8643e-04_r8,1.2013e-03_r8,1.3351e-03_r8,1.3087e-03_r8/) + kbo(:, 3,15, 1) = (/ & + &6.7289e-04_r8,1.3258e-03_r8,1.5978e-03_r8,1.7375e-03_r8,1.6233e-03_r8/) + kbo(:, 4,15, 1) = (/ & + &9.1389e-04_r8,1.7863e-03_r8,2.1013e-03_r8,2.2138e-03_r8,1.9402e-03_r8/) + kbo(:, 5,15, 1) = (/ & + &1.2783e-03_r8,2.4005e-03_r8,2.7322e-03_r8,2.7722e-03_r8,2.2422e-03_r8/) + kbo(:, 1,16, 1) = (/ & + &2.7315e-04_r8,5.4830e-04_r8,7.0218e-04_r8,8.1997e-04_r8,8.6240e-04_r8/) + kbo(:, 2,16, 1) = (/ & + &3.3240e-04_r8,7.3351e-04_r8,9.4112e-04_r8,1.0872e-03_r8,1.1098e-03_r8/) + kbo(:, 3,16, 1) = (/ & + &4.3314e-04_r8,9.8584e-04_r8,1.2457e-03_r8,1.4034e-03_r8,1.3664e-03_r8/) + kbo(:, 4,16, 1) = (/ & + &5.9092e-04_r8,1.3229e-03_r8,1.6223e-03_r8,1.7684e-03_r8,1.6211e-03_r8/) + kbo(:, 5,16, 1) = (/ & + &8.2878e-04_r8,1.7642e-03_r8,2.0878e-03_r8,2.1890e-03_r8,1.8647e-03_r8/) + kbo(:, 1,17, 1) = (/ & + &1.7965e-04_r8,4.1801e-04_r8,5.6155e-04_r8,6.7756e-04_r8,7.3362e-04_r8/) + kbo(:, 2,17, 1) = (/ & + &2.2058e-04_r8,5.6121e-04_r8,7.5064e-04_r8,8.9254e-04_r8,9.3681e-04_r8/) + kbo(:, 3,17, 1) = (/ & + &2.8939e-04_r8,7.5257e-04_r8,9.8597e-04_r8,1.1419e-03_r8,1.1452e-03_r8/) + kbo(:, 4,17, 1) = (/ & + &3.9639e-04_r8,1.0037e-03_r8,1.2718e-03_r8,1.4256e-03_r8,1.3514e-03_r8/) + kbo(:, 5,17, 1) = (/ & + &5.5678e-04_r8,1.3263e-03_r8,1.6209e-03_r8,1.7480e-03_r8,1.5479e-03_r8/) + kbo(:, 1,18, 1) = (/ & + &1.2144e-04_r8,3.2556e-04_r8,4.5465e-04_r8,5.6224e-04_r8,6.2157e-04_r8/) + kbo(:, 2,18, 1) = (/ & + &1.5036e-04_r8,4.3710e-04_r8,6.0499e-04_r8,7.3530e-04_r8,7.8763e-04_r8/) + kbo(:, 3,18, 1) = (/ & + &1.9855e-04_r8,5.8365e-04_r8,7.8791e-04_r8,9.3325e-04_r8,9.5745e-04_r8/) + kbo(:, 4,18, 1) = (/ & + &2.7288e-04_r8,7.7253e-04_r8,1.0079e-03_r8,1.1563e-03_r8,1.1247e-03_r8/) + kbo(:, 5,18, 1) = (/ & + &3.8348e-04_r8,1.0128e-03_r8,1.2724e-03_r8,1.4068e-03_r8,1.2838e-03_r8/) + kbo(:, 1,19, 1) = (/ & + &8.0908e-05_r8,2.5355e-04_r8,3.6780e-04_r8,4.6534e-04_r8,5.2420e-04_r8/) + kbo(:, 2,19, 1) = (/ & + &1.0097e-04_r8,3.3963e-04_r8,4.8637e-04_r8,6.0408e-04_r8,6.5997e-04_r8/) + kbo(:, 3,19, 1) = (/ & + &1.3403e-04_r8,4.5064e-04_r8,6.2806e-04_r8,7.6126e-04_r8,7.9854e-04_r8/) + kbo(:, 4,19, 1) = (/ & + &1.8471e-04_r8,5.9188e-04_r8,7.9637e-04_r8,9.3587e-04_r8,9.3436e-04_r8/) + kbo(:, 5,19, 1) = (/ & + &2.5970e-04_r8,7.6935e-04_r8,9.9605e-04_r8,1.1301e-03_r8,1.0631e-03_r8/) + kbo(:, 1,20, 1) = (/ & + &5.8651e-05_r8,2.0533e-04_r8,3.0468e-04_r8,3.8991e-04_r8,4.4299e-04_r8/) + kbo(:, 2,20, 1) = (/ & + &7.3858e-05_r8,2.7425e-04_r8,4.0056e-04_r8,5.0325e-04_r8,5.5439e-04_r8/) + kbo(:, 3,20, 1) = (/ & + &9.8558e-05_r8,3.6201e-04_r8,5.1389e-04_r8,6.3043e-04_r8,6.6745e-04_r8/) + kbo(:, 4,20, 1) = (/ & + &1.3624e-04_r8,4.7289e-04_r8,6.4732e-04_r8,7.7044e-04_r8,7.7770e-04_r8/) + kbo(:, 5,20, 1) = (/ & + &1.9168e-04_r8,6.1111e-04_r8,8.0443e-04_r8,9.2550e-04_r8,8.8213e-04_r8/) + kbo(:, 1,21, 1) = (/ & + &4.3969e-05_r8,1.6839e-04_r8,2.5404e-04_r8,3.2750e-04_r8,3.7386e-04_r8/) + kbo(:, 2,21, 1) = (/ & + &5.5807e-05_r8,2.2425e-04_r8,3.3214e-04_r8,4.2065e-04_r8,4.6519e-04_r8/) + kbo(:, 3,21, 1) = (/ & + &7.4871e-05_r8,2.9470e-04_r8,4.2375e-04_r8,5.2400e-04_r8,5.5744e-04_r8/) + kbo(:, 4,21, 1) = (/ & + &1.0381e-04_r8,3.8330e-04_r8,5.3089e-04_r8,6.3750e-04_r8,6.4727e-04_r8/) + kbo(:, 5,21, 1) = (/ & + &1.4611e-04_r8,4.9243e-04_r8,6.5637e-04_r8,7.6218e-04_r8,7.3199e-04_r8/) + kbo(:, 1,22, 1) = (/ & + &3.4337e-05_r8,1.4203e-04_r8,2.1658e-04_r8,2.8040e-04_r8,3.2005e-04_r8/) + kbo(:, 2,22, 1) = (/ & + &4.4095e-05_r8,1.8845e-04_r8,2.8132e-04_r8,3.5774e-04_r8,3.9514e-04_r8/) + kbo(:, 3,22, 1) = (/ & + &5.9627e-05_r8,2.4659e-04_r8,3.5661e-04_r8,4.4266e-04_r8,4.7049e-04_r8/) + kbo(:, 4,22, 1) = (/ & + &8.3001e-05_r8,3.1905e-04_r8,4.4430e-04_r8,5.3537e-04_r8,5.4306e-04_r8/) + kbo(:, 5,22, 1) = (/ & + &1.1688e-04_r8,4.0732e-04_r8,5.4669e-04_r8,6.3703e-04_r8,6.1162e-04_r8/) + kbo(:, 1,23, 1) = (/ & + &2.7088e-05_r8,1.2024e-04_r8,1.8486e-04_r8,2.4028e-04_r8,2.7381e-04_r8/) + kbo(:, 2,23, 1) = (/ & + &3.5182e-05_r8,1.5885e-04_r8,2.3849e-04_r8,3.0423e-04_r8,3.3547e-04_r8/) + kbo(:, 3,23, 1) = (/ & + &4.7910e-05_r8,2.0687e-04_r8,3.0043e-04_r8,3.7399e-04_r8,3.9686e-04_r8/) + kbo(:, 4,23, 1) = (/ & + &6.6975e-05_r8,2.6613e-04_r8,3.7259e-04_r8,4.4994e-04_r8,4.5570e-04_r8/) + kbo(:, 5,23, 1) = (/ & + &9.4305e-05_r8,3.3770e-04_r8,4.5596e-04_r8,5.3292e-04_r8,5.1097e-04_r8/) + kbo(:, 1,24, 1) = (/ & + &2.1382e-05_r8,1.0191e-04_r8,1.5778e-04_r8,2.0583e-04_r8,2.3424e-04_r8/) + kbo(:, 2,24, 1) = (/ & + &2.8085e-05_r8,1.3391e-04_r8,2.0214e-04_r8,2.5863e-04_r8,2.8484e-04_r8/) + kbo(:, 3,24, 1) = (/ & + &3.8505e-05_r8,1.7343e-04_r8,2.5313e-04_r8,3.1592e-04_r8,3.3477e-04_r8/) + kbo(:, 4,24, 1) = (/ & + &5.3997e-05_r8,2.2171e-04_r8,3.1228e-04_r8,3.7804e-04_r8,3.8231e-04_r8/) + kbo(:, 5,24, 1) = (/ & + &7.5953e-05_r8,2.7966e-04_r8,3.7978e-04_r8,4.4568e-04_r8,4.2681e-04_r8/) + kbo(:, 1,25, 1) = (/ & + &1.7217e-05_r8,8.6935e-05_r8,1.3520e-04_r8,1.7667e-04_r8,2.0051e-04_r8/) + kbo(:, 2,25, 1) = (/ & + &2.2860e-05_r8,1.1361e-04_r8,1.7201e-04_r8,2.2028e-04_r8,2.4198e-04_r8/) + kbo(:, 3,25, 1) = (/ & + &3.1540e-05_r8,1.4632e-04_r8,2.1426e-04_r8,2.6745e-04_r8,2.8247e-04_r8/) + kbo(:, 4,25, 1) = (/ & + &4.4330e-05_r8,1.8594e-04_r8,2.6272e-04_r8,3.1846e-04_r8,3.2089e-04_r8/) + kbo(:, 5,25, 1) = (/ & + &6.2260e-05_r8,2.3327e-04_r8,3.1770e-04_r8,3.7373e-04_r8,3.5666e-04_r8/) + kbo(:, 1,26, 1) = (/ & + &1.4222e-05_r8,7.4853e-05_r8,1.1659e-04_r8,1.5229e-04_r8,1.7205e-04_r8/) + kbo(:, 2,26, 1) = (/ & + &1.9097e-05_r8,9.7290e-05_r8,1.4733e-04_r8,1.8840e-04_r8,2.0595e-04_r8/) + kbo(:, 3,26, 1) = (/ & + &2.6498e-05_r8,1.2462e-04_r8,1.8247e-04_r8,2.2740e-04_r8,2.3871e-04_r8/) + kbo(:, 4,26, 1) = (/ & + &3.7304e-05_r8,1.5749e-04_r8,2.2244e-04_r8,2.6950e-04_r8,2.6966e-04_r8/) + kbo(:, 5,26, 1) = (/ & + &5.2263e-05_r8,1.9669e-04_r8,2.6764e-04_r8,3.1472e-04_r8,2.9848e-04_r8/) + kbo(:, 1,27, 1) = (/ & + &1.2263e-05_r8,6.5144e-05_r8,1.0108e-04_r8,1.3156e-04_r8,1.4744e-04_r8/) + kbo(:, 2,27, 1) = (/ & + &1.6644e-05_r8,8.4290e-05_r8,1.2696e-04_r8,1.6163e-04_r8,1.7509e-04_r8/) + kbo(:, 3,27, 1) = (/ & + &2.3202e-05_r8,1.0755e-04_r8,1.5651e-04_r8,1.9419e-04_r8,2.0159e-04_r8/) + kbo(:, 4,27, 1) = (/ & + &3.2669e-05_r8,1.3540e-04_r8,1.9003e-04_r8,2.2917e-04_r8,2.2657e-04_r8/) + kbo(:, 5,27, 1) = (/ & + &4.5636e-05_r8,1.6849e-04_r8,2.2778e-04_r8,2.6648e-04_r8,2.4966e-04_r8/) + kbo(:, 1,28, 1) = (/ & + &1.0907e-05_r8,5.7118e-05_r8,8.7946e-05_r8,1.1378e-04_r8,1.2622e-04_r8/) + kbo(:, 2,28, 1) = (/ & + &1.4925e-05_r8,7.3661e-05_r8,1.0996e-04_r8,1.3907e-04_r8,1.4872e-04_r8/) + kbo(:, 3,28, 1) = (/ & + &2.0909e-05_r8,9.3671e-05_r8,1.3497e-04_r8,1.6629e-04_r8,1.7014e-04_r8/) + kbo(:, 4,28, 1) = (/ & + &2.9425e-05_r8,1.1761e-04_r8,1.6330e-04_r8,1.9540e-04_r8,1.9022e-04_r8/) + kbo(:, 5,28, 1) = (/ & + &4.0966e-05_r8,1.4604e-04_r8,1.9535e-04_r8,2.2654e-04_r8,2.0877e-04_r8/) + kbo(:, 1,29, 1) = (/ & + &1.0363e-05_r8,5.1128e-05_r8,7.7457e-05_r8,9.9099e-05_r8,1.0807e-04_r8/) + kbo(:, 2,29, 1) = (/ & + &1.4287e-05_r8,6.5810e-05_r8,9.6485e-05_r8,1.2056e-04_r8,1.2631e-04_r8/) + kbo(:, 3,29, 1) = (/ & + &2.0078e-05_r8,8.3622e-05_r8,1.1822e-04_r8,1.4364e-04_r8,1.4366e-04_r8/) + kbo(:, 4,29, 1) = (/ & + &2.8213e-05_r8,1.0495e-04_r8,1.4288e-04_r8,1.6839e-04_r8,1.5982e-04_r8/) + kbo(:, 5,29, 1) = (/ & + &3.9150e-05_r8,1.3025e-04_r8,1.7086e-04_r8,1.9491e-04_r8,1.7468e-04_r8/) + kbo(:, 1,30, 1) = (/ & + &1.0130e-05_r8,4.6183e-05_r8,6.8547e-05_r8,8.6516e-05_r8,9.2360e-05_r8/) + kbo(:, 2,30, 1) = (/ & + &1.4060e-05_r8,5.9445e-05_r8,8.5241e-05_r8,1.0481e-04_r8,1.0719e-04_r8/) + kbo(:, 3,30, 1) = (/ & + &1.9789e-05_r8,7.5542e-05_r8,1.0433e-04_r8,1.2454e-04_r8,1.2117e-04_r8/) + kbo(:, 4,30, 1) = (/ & + &2.7737e-05_r8,9.4871e-05_r8,1.2613e-04_r8,1.4578e-04_r8,1.3421e-04_r8/) + kbo(:, 5,30, 1) = (/ & + &3.8345e-05_r8,1.1778e-04_r8,1.5088e-04_r8,1.6869e-04_r8,1.4612e-04_r8/) + kbo(:, 1,31, 1) = (/ & + &1.0468e-05_r8,4.2679e-05_r8,6.1533e-05_r8,7.6101e-05_r8,7.8936e-05_r8/) + kbo(:, 2,31, 1) = (/ & + &1.4602e-05_r8,5.5015e-05_r8,7.6472e-05_r8,9.1912e-05_r8,9.0925e-05_r8/) + kbo(:, 3,31, 1) = (/ & + &2.0565e-05_r8,7.0045e-05_r8,9.3754e-05_r8,1.0914e-04_r8,1.0226e-04_r8/) + kbo(:, 4,31, 1) = (/ & + &2.8741e-05_r8,8.8177e-05_r8,1.1361e-04_r8,1.2783e-04_r8,1.1277e-04_r8/) + kbo(:, 5,31, 1) = (/ & + &3.9551e-05_r8,1.0965e-04_r8,1.3625e-04_r8,1.4816e-04_r8,1.2240e-04_r8/) + kbo(:, 1,32, 1) = (/ & + &1.0980e-05_r8,3.9860e-05_r8,5.5596e-05_r8,6.7154e-05_r8,6.7396e-05_r8/) + kbo(:, 2,32, 1) = (/ & + &1.5378e-05_r8,5.1481e-05_r8,6.9207e-05_r8,8.1024e-05_r8,7.7105e-05_r8/) + kbo(:, 3,32, 1) = (/ & + &2.1641e-05_r8,6.5723e-05_r8,8.5005e-05_r8,9.6172e-05_r8,8.6258e-05_r8/) + kbo(:, 4,32, 1) = (/ & + &3.0131e-05_r8,8.2891e-05_r8,1.0329e-04_r8,1.1283e-04_r8,9.4767e-05_r8/) + kbo(:, 5,32, 1) = (/ & + &4.1276e-05_r8,1.0326e-04_r8,1.2427e-04_r8,1.3104e-04_r8,1.0241e-04_r8/) + kbo(:, 1,33, 1) = (/ & + &1.1748e-05_r8,3.7749e-05_r8,5.0777e-05_r8,5.9616e-05_r8,5.7446e-05_r8/) + kbo(:, 2,33, 1) = (/ & + &1.6501e-05_r8,4.8915e-05_r8,6.3363e-05_r8,7.1901e-05_r8,6.5353e-05_r8/) + kbo(:, 3,33, 1) = (/ & + &2.3188e-05_r8,6.2624e-05_r8,7.8070e-05_r8,8.5481e-05_r8,7.2776e-05_r8/) + kbo(:, 4,33, 1) = (/ & + &3.2156e-05_r8,7.9179e-05_r8,9.5194e-05_r8,1.0052e-04_r8,7.9571e-05_r8/) + kbo(:, 5,33, 1) = (/ & + &4.3815e-05_r8,9.8786e-05_r8,1.1493e-04_r8,1.1713e-04_r8,8.5692e-05_r8/) + kbo(:, 1,34, 1) = (/ & + &1.2122e-05_r8,3.5250e-05_r8,4.5906e-05_r8,5.2480e-05_r8,4.8658e-05_r8/) + kbo(:, 2,34, 1) = (/ & + &1.7058e-05_r8,4.5800e-05_r8,5.7395e-05_r8,6.3326e-05_r8,5.5101e-05_r8/) + kbo(:, 3,34, 1) = (/ & + &2.3918e-05_r8,5.8762e-05_r8,7.0946e-05_r8,7.5460e-05_r8,6.1101e-05_r8/) + kbo(:, 4,34, 1) = (/ & + &3.3054e-05_r8,7.4431e-05_r8,8.6803e-05_r8,8.8957e-05_r8,6.6540e-05_r8/) + kbo(:, 5,34, 1) = (/ & + &4.4827e-05_r8,9.2907e-05_r8,1.0510e-04_r8,1.0393e-04_r8,7.1470e-05_r8/) + kbo(:, 1,35, 1) = (/ & + &1.2136e-05_r8,3.2274e-05_r8,4.0784e-05_r8,4.5493e-05_r8,4.0671e-05_r8/) + kbo(:, 2,35, 1) = (/ & + &1.7085e-05_r8,4.2082e-05_r8,5.1198e-05_r8,5.5056e-05_r8,4.5918e-05_r8/) + kbo(:, 3,35, 1) = (/ & + &2.3916e-05_r8,5.4183e-05_r8,6.3553e-05_r8,6.5795e-05_r8,5.0794e-05_r8/) + kbo(:, 4,35, 1) = (/ & + &3.2983e-05_r8,6.8784e-05_r8,7.8061e-05_r8,7.7848e-05_r8,5.5215e-05_r8/) + kbo(:, 5,35, 1) = (/ & + &4.4608e-05_r8,8.5962e-05_r8,9.4799e-05_r8,9.1316e-05_r8,5.9185e-05_r8/) + kbo(:, 1,36, 1) = (/ & + &1.1639e-05_r8,2.8710e-05_r8,3.5389e-05_r8,3.8647e-05_r8,3.3496e-05_r8/) + kbo(:, 2,36, 1) = (/ & + &1.6387e-05_r8,3.7611e-05_r8,4.4660e-05_r8,4.6982e-05_r8,3.7819e-05_r8/) + kbo(:, 3,36, 1) = (/ & + &2.2931e-05_r8,4.8613e-05_r8,5.5727e-05_r8,5.6405e-05_r8,4.1793e-05_r8/) + kbo(:, 4,36, 1) = (/ & + &3.1614e-05_r8,6.1937e-05_r8,6.8745e-05_r8,6.7054e-05_r8,4.5416e-05_r8/) + kbo(:, 5,36, 1) = (/ & + &4.2736e-05_r8,7.7667e-05_r8,8.3834e-05_r8,7.9002e-05_r8,4.8700e-05_r8/) + kbo(:, 1,37, 1) = (/ & + &1.0334e-05_r8,2.4228e-05_r8,2.9412e-05_r8,3.1719e-05_r8,2.7018e-05_r8/) + kbo(:, 2,37, 1) = (/ & + &1.4545e-05_r8,3.1907e-05_r8,3.7329e-05_r8,3.8760e-05_r8,3.0586e-05_r8/) + kbo(:, 3,37, 1) = (/ & + &2.0385e-05_r8,4.1462e-05_r8,4.6849e-05_r8,4.6806e-05_r8,3.3891e-05_r8/) + kbo(:, 4,37, 1) = (/ & + &2.8167e-05_r8,5.3075e-05_r8,5.8122e-05_r8,5.5962e-05_r8,3.6915e-05_r8/) + kbo(:, 5,37, 1) = (/ & + &3.8188e-05_r8,6.6903e-05_r8,7.1250e-05_r8,6.6274e-05_r8,3.9679e-05_r8/) + kbo(:, 1,38, 1) = (/ & + &9.2873e-06_r8,2.0587e-05_r8,2.4545e-05_r8,2.6080e-05_r8,2.1759e-05_r8/) + kbo(:, 2,38, 1) = (/ & + &1.3062e-05_r8,2.7262e-05_r8,3.1359e-05_r8,3.2085e-05_r8,2.4714e-05_r8/) + kbo(:, 3,38, 1) = (/ & + &1.8340e-05_r8,3.5628e-05_r8,3.9617e-05_r8,3.8992e-05_r8,2.7465e-05_r8/) + kbo(:, 4,38, 1) = (/ & + &2.5394e-05_r8,4.5875e-05_r8,4.9461e-05_r8,4.6884e-05_r8,2.9998e-05_r8/) + kbo(:, 5,38, 1) = (/ & + &3.4528e-05_r8,5.8131e-05_r8,6.0967e-05_r8,5.5861e-05_r8,3.2334e-05_r8/) + kbo(:, 1,39, 1) = (/ & + &8.5453e-06_r8,1.7761e-05_r8,2.0713e-05_r8,2.1598e-05_r8,1.7527e-05_r8/) + kbo(:, 2,39, 1) = (/ & + &1.2008e-05_r8,2.3655e-05_r8,2.6655e-05_r8,2.6765e-05_r8,1.9983e-05_r8/) + kbo(:, 3,39, 1) = (/ & + &1.6881e-05_r8,3.1100e-05_r8,3.3909e-05_r8,3.2745e-05_r8,2.2276e-05_r8/) + kbo(:, 4,39, 1) = (/ & + &2.3421e-05_r8,4.0278e-05_r8,4.2620e-05_r8,3.9657e-05_r8,2.4422e-05_r8/) + kbo(:, 5,39, 1) = (/ & + &3.1935e-05_r8,5.1364e-05_r8,5.2889e-05_r8,4.7569e-05_r8,2.6373e-05_r8/) + kbo(:, 1,40, 1) = (/ & + &7.1461e-06_r8,1.4361e-05_r8,1.6604e-05_r8,1.7207e-05_r8,1.3880e-05_r8/) + kbo(:, 2,40, 1) = (/ & + &1.0009e-05_r8,1.9228e-05_r8,2.1496e-05_r8,2.1462e-05_r8,1.5923e-05_r8/) + kbo(:, 3,40, 1) = (/ & + &1.4089e-05_r8,2.5420e-05_r8,2.7521e-05_r8,2.6424e-05_r8,1.7845e-05_r8/) + kbo(:, 4,40, 1) = (/ & + &1.9620e-05_r8,3.3119e-05_r8,3.4800e-05_r8,3.2193e-05_r8,1.9645e-05_r8/) + kbo(:, 5,40, 1) = (/ & + &2.6885e-05_r8,4.2499e-05_r8,4.3444e-05_r8,3.8836e-05_r8,2.1269e-05_r8/) + kbo(:, 1,41, 1) = (/ & + &5.9442e-06_r8,1.1549e-05_r8,1.3242e-05_r8,1.3641e-05_r8,1.0951e-05_r8/) + kbo(:, 2,41, 1) = (/ & + &8.2890e-06_r8,1.5538e-05_r8,1.7245e-05_r8,1.7129e-05_r8,1.2647e-05_r8/) + kbo(:, 3,41, 1) = (/ & + &1.1675e-05_r8,2.0658e-05_r8,2.2220e-05_r8,2.1226e-05_r8,1.4267e-05_r8/) + kbo(:, 4,41, 1) = (/ & + &1.6317e-05_r8,2.7083e-05_r8,2.8276e-05_r8,2.6013e-05_r8,1.5751e-05_r8/) + kbo(:, 5,41, 1) = (/ & + &2.2462e-05_r8,3.4966e-05_r8,3.5519e-05_r8,3.1566e-05_r8,1.7118e-05_r8/) + kbo(:, 1,42, 1) = (/ & + &5.0039e-06_r8,9.3487e-06_r8,1.0601e-05_r8,1.0831e-05_r8,8.6234e-06_r8/) + kbo(:, 2,42, 1) = (/ & + &6.9419e-06_r8,1.2631e-05_r8,1.3888e-05_r8,1.3698e-05_r8,1.0034e-05_r8/) + kbo(:, 3,42, 1) = (/ & + &9.7739e-06_r8,1.6890e-05_r8,1.8015e-05_r8,1.7096e-05_r8,1.1383e-05_r8/) + kbo(:, 4,42, 1) = (/ & + &1.3702e-05_r8,2.2284e-05_r8,2.3078e-05_r8,2.1084e-05_r8,1.2617e-05_r8/) + kbo(:, 5,42, 1) = (/ & + &1.8946e-05_r8,2.8958e-05_r8,2.9188e-05_r8,2.5746e-05_r8,1.3767e-05_r8/) + kbo(:, 1,43, 1) = (/ & + &4.1873e-06_r8,7.4795e-06_r8,8.3830e-06_r8,8.4906e-06_r8,6.7096e-06_r8/) + kbo(:, 2,43, 1) = (/ & + &5.7609e-06_r8,1.0144e-05_r8,1.1051e-05_r8,1.0826e-05_r8,7.8872e-06_r8/) + kbo(:, 3,43, 1) = (/ & + &8.0947e-06_r8,1.3657e-05_r8,1.4441e-05_r8,1.3617e-05_r8,9.0007e-06_r8/) + kbo(:, 4,43, 1) = (/ & + &1.1379e-05_r8,1.8143e-05_r8,1.8645e-05_r8,1.6928e-05_r8,1.0041e-05_r8/) + kbo(:, 5,43, 1) = (/ & + &1.5813e-05_r8,2.3749e-05_r8,2.3760e-05_r8,2.0820e-05_r8,1.1010e-05_r8/) + kbo(:, 1,44, 1) = (/ & + &3.5435e-06_r8,5.9971e-06_r8,6.6151e-06_r8,6.6257e-06_r8,5.1813e-06_r8/) + kbo(:, 2,44, 1) = (/ & + &4.8184e-06_r8,8.1565e-06_r8,8.7802e-06_r8,8.5231e-06_r8,6.1554e-06_r8/) + kbo(:, 3,44, 1) = (/ & + &6.7381e-06_r8,1.1044e-05_r8,1.1560e-05_r8,1.0814e-05_r8,7.0815e-06_r8/) + kbo(:, 4,44, 1) = (/ & + &9.4910e-06_r8,1.4784e-05_r8,1.5050e-05_r8,1.3555e-05_r8,7.9532e-06_r8/) + kbo(:, 5,44, 1) = (/ & + &1.3248e-05_r8,1.9506e-05_r8,1.9344e-05_r8,1.6815e-05_r8,8.7723e-06_r8/) + kbo(:, 1,45, 1) = (/ & + &3.0781e-06_r8,4.8864e-06_r8,5.2730e-06_r8,5.1910e-06_r8,3.9885e-06_r8/) + kbo(:, 2,45, 1) = (/ & + &4.1281e-06_r8,6.6470e-06_r8,7.0382e-06_r8,6.7401e-06_r8,4.7888e-06_r8/) + kbo(:, 3,45, 1) = (/ & + &5.7272e-06_r8,9.0419e-06_r8,9.3373e-06_r8,8.6331e-06_r8,5.5575e-06_r8/) + kbo(:, 4,45, 1) = (/ & + &8.0675e-06_r8,1.2195e-05_r8,1.2269e-05_r8,1.0924e-05_r8,6.2888e-06_r8/) + kbo(:, 5,45, 1) = (/ & + &1.1304e-05_r8,1.6230e-05_r8,1.5911e-05_r8,1.3670e-05_r8,6.9809e-06_r8/) + kbo(:, 1,46, 1) = (/ & + &2.7031e-06_r8,4.0051e-06_r8,4.2052e-06_r8,4.0513e-06_r8,3.0391e-06_r8/) + kbo(:, 2,46, 1) = (/ & + &3.5629e-06_r8,5.4291e-06_r8,5.6384e-06_r8,5.3109e-06_r8,3.6957e-06_r8/) + kbo(:, 3,46, 1) = (/ & + &4.8917e-06_r8,7.4052e-06_r8,7.5318e-06_r8,6.8686e-06_r8,4.3368e-06_r8/) + kbo(:, 4,46, 1) = (/ & + &6.8735e-06_r8,1.0056e-05_r8,9.9863e-06_r8,8.7795e-06_r8,4.9486e-06_r8/) + kbo(:, 5,46, 1) = (/ & + &9.6601e-06_r8,1.3493e-05_r8,1.3073e-05_r8,1.1090e-05_r8,5.5328e-06_r8/) + kbo(:, 1,47, 1) = (/ & + &2.3513e-06_r8,3.2459e-06_r8,3.3109e-06_r8,3.1126e-06_r8,2.2809e-06_r8/) + kbo(:, 2,47, 1) = (/ & + &3.0285e-06_r8,4.3632e-06_r8,4.4435e-06_r8,4.1169e-06_r8,2.8160e-06_r8/) + kbo(:, 3,47, 1) = (/ & + &4.0963e-06_r8,5.9519e-06_r8,5.9675e-06_r8,5.3774e-06_r8,3.3494e-06_r8/) + kbo(:, 4,47, 1) = (/ & + &5.7200e-06_r8,8.1250e-06_r8,7.9789e-06_r8,6.9425e-06_r8,3.8611e-06_r8/) + kbo(:, 5,47, 1) = (/ & + &8.0548e-06_r8,1.0990e-05_r8,1.0545e-05_r8,8.8570e-06_r8,4.3522e-06_r8/) + kbo(:, 1,48, 1) = (/ & + &2.1277e-06_r8,2.7115e-06_r8,2.6627e-06_r8,2.4165e-06_r8,1.7021e-06_r8/) + kbo(:, 2,48, 1) = (/ & + &2.6703e-06_r8,3.5982e-06_r8,3.5641e-06_r8,3.2218e-06_r8,2.1347e-06_r8/) + kbo(:, 3,48, 1) = (/ & + &3.5476e-06_r8,4.8904e-06_r8,4.8030e-06_r8,4.2482e-06_r8,2.5746e-06_r8/) + kbo(:, 4,48, 1) = (/ & + &4.9045e-06_r8,6.6952e-06_r8,6.4687e-06_r8,5.5412e-06_r8,3.0044e-06_r8/) + kbo(:, 5,48, 1) = (/ & + &6.9032e-06_r8,9.1233e-06_r8,8.6345e-06_r8,7.1468e-06_r8,3.4162e-06_r8/) + kbo(:, 1,49, 1) = (/ & + &2.0328e-06_r8,2.3718e-06_r8,2.2199e-06_r8,1.9157e-06_r8,1.2610e-06_r8/) + kbo(:, 2,49, 1) = (/ & + &2.4767e-06_r8,3.0887e-06_r8,2.9459e-06_r8,2.5646e-06_r8,1.6091e-06_r8/) + kbo(:, 3,49, 1) = (/ & + &3.2245e-06_r8,4.1594e-06_r8,3.9687e-06_r8,3.4109e-06_r8,1.9688e-06_r8/) + kbo(:, 4,49, 1) = (/ & + &4.3950e-06_r8,5.6964e-06_r8,5.3766e-06_r8,4.4963e-06_r8,2.3270e-06_r8/) + kbo(:, 5,49, 1) = (/ & + &6.1628e-06_r8,7.8088e-06_r8,7.2467e-06_r8,5.8704e-06_r8,2.6722e-06_r8/) + kbo(:, 1,50, 1) = (/ & + &1.8800e-06_r8,2.0468e-06_r8,1.8384e-06_r8,1.5142e-06_r8,9.3123e-07_r8/) + kbo(:, 2,50, 1) = (/ & + &2.2261e-06_r8,2.6068e-06_r8,2.4062e-06_r8,2.0250e-06_r8,1.2100e-06_r8/) + kbo(:, 3,50, 1) = (/ & + &2.8323e-06_r8,3.4659e-06_r8,3.2264e-06_r8,2.7071e-06_r8,1.5035e-06_r8/) + kbo(:, 4,50, 1) = (/ & + &3.7999e-06_r8,4.7249e-06_r8,4.3788e-06_r8,3.5953e-06_r8,1.7997e-06_r8/) + kbo(:, 5,50, 1) = (/ & + &5.2884e-06_r8,6.4943e-06_r8,5.9393e-06_r8,4.7367e-06_r8,2.0882e-06_r8/) + kbo(:, 1,51, 1) = (/ & + &1.7210e-06_r8,1.7678e-06_r8,1.5277e-06_r8,1.2003e-06_r8,6.8440e-07_r8/) + kbo(:, 2,51, 1) = (/ & + &1.9818e-06_r8,2.1939e-06_r8,1.9638e-06_r8,1.5963e-06_r8,9.0698e-07_r8/) + kbo(:, 3,51, 1) = (/ & + &2.4588e-06_r8,2.8718e-06_r8,2.6104e-06_r8,2.1370e-06_r8,1.1441e-06_r8/) + kbo(:, 4,51, 1) = (/ & + &3.2428e-06_r8,3.8817e-06_r8,3.5358e-06_r8,2.8541e-06_r8,1.3878e-06_r8/) + kbo(:, 5,51, 1) = (/ & + &4.4645e-06_r8,5.3335e-06_r8,4.8140e-06_r8,3.7885e-06_r8,1.6275e-06_r8/) + kbo(:, 1,52, 1) = (/ & + &1.6367e-06_r8,1.5882e-06_r8,1.3178e-06_r8,9.7791e-07_r8,4.9920e-07_r8/) + kbo(:, 2,52, 1) = (/ & + &1.8355e-06_r8,1.9143e-06_r8,1.6527e-06_r8,1.2853e-06_r8,6.7537e-07_r8/) + kbo(:, 3,52, 1) = (/ & + &2.2162e-06_r8,2.4540e-06_r8,2.1676e-06_r8,1.7156e-06_r8,8.6642e-07_r8/) + kbo(:, 4,52, 1) = (/ & + &2.8651e-06_r8,3.2774e-06_r8,2.9188e-06_r8,2.2996e-06_r8,1.0660e-06_r8/) + kbo(:, 5,52, 1) = (/ & + &3.8903e-06_r8,4.4871e-06_r8,3.9803e-06_r8,3.0728e-06_r8,1.2649e-06_r8/) + kbo(:, 1,53, 1) = (/ & + &1.6359e-06_r8,1.5065e-06_r8,1.1971e-06_r8,8.3215e-07_r8,3.6108e-07_r8/) + kbo(:, 2,53, 1) = (/ & + &1.7884e-06_r8,1.7570e-06_r8,1.4552e-06_r8,1.0704e-06_r8,4.9954e-07_r8/) + kbo(:, 3,53, 1) = (/ & + &2.1010e-06_r8,2.1926e-06_r8,1.8706e-06_r8,1.4156e-06_r8,6.5257e-07_r8/) + kbo(:, 4,53, 1) = (/ & + &2.6543e-06_r8,2.8821e-06_r8,2.4935e-06_r8,1.8975e-06_r8,8.1519e-07_r8/) + kbo(:, 5,53, 1) = (/ & + &3.5462e-06_r8,3.9143e-06_r8,3.3945e-06_r8,2.5503e-06_r8,9.8011e-07_r8/) + kbo(:, 1,54, 1) = (/ & + &1.4300e-06_r8,1.2802e-06_r8,9.9257e-07_r8,6.6497e-07_r8,2.6129e-07_r8/) + kbo(:, 2,54, 1) = (/ & + &1.5262e-06_r8,1.4508e-06_r8,1.1768e-06_r8,8.3958e-07_r8,3.6958e-07_r8/) + kbo(:, 3,54, 1) = (/ & + &1.7484e-06_r8,1.7685e-06_r8,1.4827e-06_r8,1.0992e-06_r8,4.9169e-07_r8/) + kbo(:, 4,54, 1) = (/ & + &2.1569e-06_r8,2.2883e-06_r8,1.9539e-06_r8,1.4679e-06_r8,6.2244e-07_r8/) + kbo(:, 5,54, 1) = (/ & + &2.8354e-06_r8,3.0764e-06_r8,2.6455e-06_r8,1.9748e-06_r8,7.5773e-07_r8/) + kbo(:, 1,55, 1) = (/ & + &1.1496e-06_r8,1.0107e-06_r8,7.7300e-07_r8,5.0639e-07_r8,1.8790e-07_r8/) + kbo(:, 2,55, 1) = (/ & + &1.1995e-06_r8,1.1187e-06_r8,8.9719e-07_r8,6.3009e-07_r8,2.7269e-07_r8/) + kbo(:, 3,55, 1) = (/ & + &1.3422e-06_r8,1.3346e-06_r8,1.1096e-06_r8,8.1740e-07_r8,3.6933e-07_r8/) + kbo(:, 4,55, 1) = (/ & + &1.6169e-06_r8,1.6973e-06_r8,1.4454e-06_r8,1.0866e-06_r8,4.7429e-07_r8/) + kbo(:, 5,55, 1) = (/ & + &2.0871e-06_r8,2.2587e-06_r8,1.9432e-06_r8,1.4592e-06_r8,5.8406e-07_r8/) + kbo(:, 1,56, 1) = (/ & + &9.3098e-07_r8,8.0374e-07_r8,6.0662e-07_r8,3.8780e-07_r8,1.3395e-07_r8/) + kbo(:, 2,56, 1) = (/ & + &9.4853e-07_r8,8.6979e-07_r8,6.8824e-07_r8,4.7493e-07_r8,1.9978e-07_r8/) + kbo(:, 3,56, 1) = (/ & + &1.0383e-06_r8,1.0136e-06_r8,8.3527e-07_r8,6.0949e-07_r8,2.7592e-07_r8/) + kbo(:, 4,56, 1) = (/ & + &1.2210e-06_r8,1.2652e-06_r8,1.0730e-06_r8,8.0519e-07_r8,3.6001e-07_r8/) + kbo(:, 5,56, 1) = (/ & + &1.5443e-06_r8,1.6630e-06_r8,1.4302e-06_r8,1.0789e-06_r8,4.4877e-07_r8/) + kbo(:, 1,57, 1) = (/ & + &7.5869e-07_r8,6.4433e-07_r8,4.7913e-07_r8,2.9908e-07_r8,9.4559e-08_r8/) + kbo(:, 2,57, 1) = (/ & + &7.5680e-07_r8,6.8154e-07_r8,5.3140e-07_r8,3.5955e-07_r8,1.4504e-07_r8/) + kbo(:, 3,57, 1) = (/ & + &8.0958e-07_r8,7.7512e-07_r8,6.3252e-07_r8,4.5567e-07_r8,2.0501e-07_r8/) + kbo(:, 4,57, 1) = (/ & + &9.2953e-07_r8,9.4815e-07_r8,7.9932e-07_r8,5.9759e-07_r8,2.7208e-07_r8/) + kbo(:, 5,57, 1) = (/ & + &1.1491e-06_r8,1.2288e-06_r8,1.0552e-06_r8,7.9844e-07_r8,3.4355e-07_r8/) + kbo(:, 1,58, 1) = (/ & + &1.6388e-07_r8,1.6804e-07_r8,1.5881e-07_r8,1.3627e-07_r8,6.6479e-08_r8/) + kbo(:, 2,58, 1) = (/ & + &1.6042e-07_r8,1.7409e-07_r8,1.7274e-07_r8,1.6106e-07_r8,1.0511e-07_r8/) + kbo(:, 3,58, 1) = (/ & + &1.6792e-07_r8,1.9377e-07_r8,2.0193e-07_r8,2.0193e-07_r8,1.5191e-07_r8/) + kbo(:, 4,58, 1) = (/ & + &1.8861e-07_r8,2.3235e-07_r8,2.5117e-07_r8,2.6306e-07_r8,2.0537e-07_r8/) + kbo(:, 5,58, 1) = (/ & + &2.2793e-07_r8,2.9684e-07_r8,3.2824e-07_r8,3.5018e-07_r8,2.6292e-07_r8/) + kbo(:, 1,59, 1) = (/ & + &1.5765e-07_r8,1.5618e-07_r8,1.3958e-07_r8,1.1007e-07_r8,5.0739e-08_r8/) + kbo(:, 2,59, 1) = (/ & + &1.5325e-07_r8,1.6219e-07_r8,1.5348e-07_r8,1.3308e-07_r8,8.1077e-08_r8/) + kbo(:, 3,59, 1) = (/ & + &1.5900e-07_r8,1.8099e-07_r8,1.8121e-07_r8,1.6979e-07_r8,1.1831e-07_r8/) + kbo(:, 4,59, 1) = (/ & + &1.7701e-07_r8,2.1714e-07_r8,2.2693e-07_r8,2.2335e-07_r8,1.6137e-07_r8/) + kbo(:, 5,59, 1) = (/ & + &2.1198e-07_r8,2.7749e-07_r8,2.9703e-07_r8,2.9803e-07_r8,2.0840e-07_r8/) + kbo(:, 1,13, 2) = (/ & + &3.6279e-03_r8,6.1760e-03_r8,7.4137e-03_r8,8.1756e-03_r8,7.6678e-03_r8/) + kbo(:, 2,13, 2) = (/ & + &4.7275e-03_r8,8.3099e-03_r8,9.8779e-03_r8,1.0590e-02_r8,9.2190e-03_r8/) + kbo(:, 3,13, 2) = (/ & + &6.7817e-03_r8,1.1546e-02_r8,1.3324e-02_r8,1.3748e-02_r8,1.0778e-02_r8/) + kbo(:, 4,13, 2) = (/ & + &1.0391e-02_r8,1.6290e-02_r8,1.8048e-02_r8,1.7786e-02_r8,1.2299e-02_r8/) + kbo(:, 5,13, 2) = (/ & + &1.6231e-02_r8,2.2973e-02_r8,2.4369e-02_r8,2.2866e-02_r8,1.3775e-02_r8/) + kbo(:, 1,14, 2) = (/ & + &1.9069e-03_r8,4.2185e-03_r8,5.5573e-03_r8,6.5712e-03_r8,6.6234e-03_r8/) + kbo(:, 2,14, 2) = (/ & + &2.5180e-03_r8,5.7108e-03_r8,7.3682e-03_r8,8.4311e-03_r8,7.9352e-03_r8/) + kbo(:, 3,14, 2) = (/ & + &3.6614e-03_r8,7.8938e-03_r8,9.8216e-03_r8,1.0792e-02_r8,9.2480e-03_r8/) + kbo(:, 4,14, 2) = (/ & + &5.6530e-03_r8,1.1002e-02_r8,1.3072e-02_r8,1.3740e-02_r8,1.0517e-02_r8/) + kbo(:, 5,14, 2) = (/ & + &8.8619e-03_r8,1.5292e-02_r8,1.7338e-02_r8,1.7343e-02_r8,1.1731e-02_r8/) + kbo(:, 1,15, 2) = (/ & + &1.0269e-03_r8,3.0313e-03_r8,4.3258e-03_r8,5.3827e-03_r8,5.7089e-03_r8/) + kbo(:, 2,15, 2) = (/ & + &1.3765e-03_r8,4.1045e-03_r8,5.6876e-03_r8,6.8515e-03_r8,6.8087e-03_r8/) + kbo(:, 3,15, 2) = (/ & + &2.0273e-03_r8,5.6227e-03_r8,7.4759e-03_r8,8.6449e-03_r8,7.9051e-03_r8/) + kbo(:, 4,15, 2) = (/ & + &3.1553e-03_r8,7.7214e-03_r8,9.7810e-03_r8,1.0828e-02_r8,8.9583e-03_r8/) + kbo(:, 5,15, 2) = (/ & + &4.9678e-03_r8,1.0557e-02_r8,1.2725e-02_r8,1.3447e-02_r8,9.9499e-03_r8/) + kbo(:, 1,16, 2) = (/ & + &6.6110e-04_r8,2.3925e-03_r8,3.5607e-03_r8,4.5272e-03_r8,4.9025e-03_r8/) + kbo(:, 2,16, 2) = (/ & + &8.9912e-04_r8,3.2391e-03_r8,4.6534e-03_r8,5.7377e-03_r8,5.8262e-03_r8/) + kbo(:, 3,16, 2) = (/ & + &1.3419e-03_r8,4.4091e-03_r8,6.0651e-03_r8,7.1821e-03_r8,6.7308e-03_r8/) + kbo(:, 4,16, 2) = (/ & + &2.1065e-03_r8,5.9970e-03_r8,7.8566e-03_r8,8.9138e-03_r8,7.5936e-03_r8/) + kbo(:, 5,16, 2) = (/ & + &3.3254e-03_r8,8.1145e-03_r8,1.0111e-02_r8,1.0963e-02_r8,8.4021e-03_r8/) + kbo(:, 1,17, 2) = (/ & + &4.4242e-04_r8,1.9273e-03_r8,2.9584e-03_r8,3.8169e-03_r8,4.1910e-03_r8/) + kbo(:, 2,17, 2) = (/ & + &6.0993e-04_r8,2.6019e-03_r8,3.8415e-03_r8,4.8112e-03_r8,4.9579e-03_r8/) + kbo(:, 3,17, 2) = (/ & + &9.2221e-04_r8,3.5184e-03_r8,4.9669e-03_r8,5.9811e-03_r8,5.6981e-03_r8/) + kbo(:, 4,17, 2) = (/ & + &1.4572e-03_r8,4.7461e-03_r8,6.3751e-03_r8,7.3581e-03_r8,6.3963e-03_r8/) + kbo(:, 5,17, 2) = (/ & + &2.3036e-03_r8,6.3581e-03_r8,8.1281e-03_r8,8.9737e-03_r8,7.0378e-03_r8/) + kbo(:, 1,18, 2) = (/ & + &3.0388e-04_r8,1.5707e-03_r8,2.4656e-03_r8,3.2158e-03_r8,3.5652e-03_r8/) + kbo(:, 2,18, 2) = (/ & + &4.2513e-04_r8,2.1109e-03_r8,3.1840e-03_r8,4.0302e-03_r8,4.1950e-03_r8/) + kbo(:, 3,18, 2) = (/ & + &6.4993e-04_r8,2.8372e-03_r8,4.0815e-03_r8,4.9772e-03_r8,4.7960e-03_r8/) + kbo(:, 4,18, 2) = (/ & + &1.0315e-03_r8,3.7953e-03_r8,5.1949e-03_r8,6.0778e-03_r8,5.3518e-03_r8/) + kbo(:, 5,18, 2) = (/ & + &1.6331e-03_r8,5.0371e-03_r8,6.5707e-03_r8,7.3465e-03_r8,5.8586e-03_r8/) + kbo(:, 1,19, 2) = (/ & + &2.0547e-04_r8,1.2763e-03_r8,2.0458e-03_r8,2.6959e-03_r8,3.0176e-03_r8/) + kbo(:, 2,19, 2) = (/ & + &2.9169e-04_r8,1.7044e-03_r8,2.6231e-03_r8,3.3550e-03_r8,3.5313e-03_r8/) + kbo(:, 3,19, 2) = (/ & + &4.4987e-04_r8,2.2721e-03_r8,3.3322e-03_r8,4.1113e-03_r8,4.0121e-03_r8/) + kbo(:, 4,19, 2) = (/ & + &7.1653e-04_r8,3.0090e-03_r8,4.2013e-03_r8,4.9750e-03_r8,4.4532e-03_r8/) + kbo(:, 5,19, 2) = (/ & + &1.1358e-03_r8,3.9520e-03_r8,5.2567e-03_r8,5.9542e-03_r8,4.8572e-03_r8/) + kbo(:, 1,20, 2) = (/ & + &1.5174e-04_r8,1.0642e-03_r8,1.7200e-03_r8,2.2761e-03_r8,2.5514e-03_r8/) + kbo(:, 2,20, 2) = (/ & + &2.1846e-04_r8,1.4153e-03_r8,2.1942e-03_r8,2.8165e-03_r8,2.9650e-03_r8/) + kbo(:, 3,20, 2) = (/ & + &3.3982e-04_r8,1.8745e-03_r8,2.7705e-03_r8,3.4277e-03_r8,3.3482e-03_r8/) + kbo(:, 4,20, 2) = (/ & + &5.4313e-04_r8,2.4649e-03_r8,3.4676e-03_r8,4.1183e-03_r8,3.7008e-03_r8/) + kbo(:, 5,20, 2) = (/ & + &8.6061e-04_r8,3.2127e-03_r8,4.3062e-03_r8,4.9014e-03_r8,4.0252e-03_r8/) + kbo(:, 1,21, 2) = (/ & + &1.1592e-04_r8,8.9297e-04_r8,1.4493e-03_r8,1.9202e-03_r8,2.1482e-03_r8/) + kbo(:, 2,21, 2) = (/ & + &1.6918e-04_r8,1.1825e-03_r8,1.8389e-03_r8,2.3614e-03_r8,2.4794e-03_r8/) + kbo(:, 3,21, 2) = (/ & + &2.6522e-04_r8,1.5570e-03_r8,2.3088e-03_r8,2.8574e-03_r8,2.7868e-03_r8/) + kbo(:, 4,21, 2) = (/ & + &4.2461e-04_r8,2.0332e-03_r8,2.8744e-03_r8,3.4170e-03_r8,3.0702e-03_r8/) + kbo(:, 5,21, 2) = (/ & + &6.7177e-04_r8,2.6322e-03_r8,3.5494e-03_r8,4.0519e-03_r8,3.3309e-03_r8/) + kbo(:, 1,22, 2) = (/ & + &9.3055e-05_r8,7.6606e-04_r8,1.2409e-03_r8,1.6398e-03_r8,1.8197e-03_r8/) + kbo(:, 2,22, 2) = (/ & + &1.3841e-04_r8,1.0092e-03_r8,1.5660e-03_r8,2.0038e-03_r8,2.0843e-03_r8/) + kbo(:, 3,22, 2) = (/ & + &2.1899e-04_r8,1.3206e-03_r8,1.9566e-03_r8,2.4125e-03_r8,2.3311e-03_r8/) + kbo(:, 4,22, 2) = (/ & + &3.5071e-04_r8,1.7145e-03_r8,2.4240e-03_r8,2.8744e-03_r8,2.5586e-03_r8/) + kbo(:, 5,22, 2) = (/ & + &5.5216e-04_r8,2.2067e-03_r8,2.9792e-03_r8,3.3952e-03_r8,2.7680e-03_r8/) + kbo(:, 1,23, 2) = (/ & + &7.5659e-05_r8,6.5668e-04_r8,1.0605e-03_r8,1.3970e-03_r8,1.5365e-03_r8/) + kbo(:, 2,23, 2) = (/ & + &1.1449e-04_r8,8.6018e-04_r8,1.3327e-03_r8,1.6978e-03_r8,1.7494e-03_r8/) + kbo(:, 3,23, 2) = (/ & + &1.8237e-04_r8,1.1195e-03_r8,1.6581e-03_r8,2.0367e-03_r8,1.9476e-03_r8/) + kbo(:, 4,23, 2) = (/ & + &2.9157e-04_r8,1.4455e-03_r8,2.0441e-03_r8,2.4187e-03_r8,2.1305e-03_r8/) + kbo(:, 5,23, 2) = (/ & + &4.5638e-04_r8,1.8506e-03_r8,2.4994e-03_r8,2.8459e-03_r8,2.2986e-03_r8/) + kbo(:, 1,24, 2) = (/ & + &6.1686e-05_r8,5.6133e-04_r8,9.0530e-04_r8,1.1887e-03_r8,1.2959e-03_r8/) + kbo(:, 2,24, 2) = (/ & + &9.4868e-05_r8,7.3156e-04_r8,1.1327e-03_r8,1.4379e-03_r8,1.4672e-03_r8/) + kbo(:, 3,24, 2) = (/ & + &1.5170e-04_r8,9.4694e-04_r8,1.4023e-03_r8,1.7186e-03_r8,1.6265e-03_r8/) + kbo(:, 4,24, 2) = (/ & + &2.4184e-04_r8,1.2160e-03_r8,1.7202e-03_r8,2.0324e-03_r8,1.7732e-03_r8/) + kbo(:, 5,24, 2) = (/ & + &3.7584e-04_r8,1.5479e-03_r8,2.0924e-03_r8,2.3822e-03_r8,1.9076e-03_r8/) + kbo(:, 1,25, 2) = (/ & + &5.1420e-05_r8,4.8151e-04_r8,7.7480e-04_r8,1.0127e-03_r8,1.0925e-03_r8/) + kbo(:, 2,25, 2) = (/ & + &8.0205e-05_r8,6.2472e-04_r8,9.6537e-04_r8,1.2206e-03_r8,1.2305e-03_r8/) + kbo(:, 3,25, 2) = (/ & + &1.2852e-04_r8,8.0481e-04_r8,1.1895e-03_r8,1.4535e-03_r8,1.3583e-03_r8/) + kbo(:, 4,25, 2) = (/ & + &2.0384e-04_r8,1.0284e-03_r8,1.4523e-03_r8,1.7128e-03_r8,1.4762e-03_r8/) + kbo(:, 5,25, 2) = (/ & + &3.1446e-04_r8,1.3022e-03_r8,1.7587e-03_r8,1.9996e-03_r8,1.5839e-03_r8/) + kbo(:, 1,26, 2) = (/ & + &4.4173e-05_r8,4.1605e-04_r8,6.6653e-04_r8,8.6651e-04_r8,9.2186e-04_r8/) + kbo(:, 2,26, 2) = (/ & + &6.9706e-05_r8,5.3779e-04_r8,8.2701e-04_r8,1.0408e-03_r8,1.0329e-03_r8/) + kbo(:, 3,26, 2) = (/ & + &1.1164e-04_r8,6.8982e-04_r8,1.0147e-03_r8,1.2348e-03_r8,1.1353e-03_r8/) + kbo(:, 4,26, 2) = (/ & + &1.7590e-04_r8,8.7786e-04_r8,1.2337e-03_r8,1.4499e-03_r8,1.2294e-03_r8/) + kbo(:, 5,26, 2) = (/ & + &2.6942e-04_r8,1.1054e-03_r8,1.4885e-03_r8,1.6863e-03_r8,1.3161e-03_r8/) + kbo(:, 1,27, 2) = (/ & + &3.9675e-05_r8,3.6275e-04_r8,5.7658e-04_r8,7.4423e-04_r8,7.7727e-04_r8/) + kbo(:, 2,27, 2) = (/ & + &6.3079e-05_r8,4.6769e-04_r8,7.1304e-04_r8,8.9128e-04_r8,8.6622e-04_r8/) + kbo(:, 3,27, 2) = (/ & + &1.0080e-04_r8,5.9857e-04_r8,8.7226e-04_r8,1.0546e-03_r8,9.4873e-04_r8/) + kbo(:, 4,27, 2) = (/ & + &1.5784e-04_r8,7.5914e-04_r8,1.0582e-03_r8,1.2346e-03_r8,1.0243e-03_r8/) + kbo(:, 5,27, 2) = (/ & + &2.3988e-04_r8,9.5199e-04_r8,1.2727e-03_r8,1.4326e-03_r8,1.0935e-03_r8/) + kbo(:, 1,28, 2) = (/ & + &3.6787e-05_r8,3.1827e-04_r8,5.0054e-04_r8,6.4070e-04_r8,6.5436e-04_r8/) + kbo(:, 2,28, 2) = (/ & + &5.8744e-05_r8,4.0999e-04_r8,6.1769e-04_r8,7.6553e-04_r8,7.2608e-04_r8/) + kbo(:, 3,28, 2) = (/ & + &9.3496e-05_r8,5.2404e-04_r8,7.5434e-04_r8,9.0364e-04_r8,7.9234e-04_r8/) + kbo(:, 4,28, 2) = (/ & + &1.4539e-04_r8,6.6291e-04_r8,9.1412e-04_r8,1.0560e-03_r8,8.5294e-04_r8/) + kbo(:, 5,28, 2) = (/ & + &2.1931e-04_r8,8.2828e-04_r8,1.0967e-03_r8,1.2236e-03_r8,9.0840e-04_r8/) + kbo(:, 1,29, 2) = (/ & + &3.6448e-05_r8,2.8470e-04_r8,4.4017e-04_r8,5.5630e-04_r8,5.5097e-04_r8/) + kbo(:, 2,29, 2) = (/ & + &5.8278e-05_r8,3.6727e-04_r8,5.4285e-04_r8,6.6380e-04_r8,6.0864e-04_r8/) + kbo(:, 3,29, 2) = (/ & + &9.2358e-05_r8,4.6962e-04_r8,6.6368e-04_r8,7.8295e-04_r8,6.6201e-04_r8/) + kbo(:, 4,29, 2) = (/ & + &1.4253e-04_r8,5.9354e-04_r8,8.0405e-04_r8,9.1518e-04_r8,7.1060e-04_r8/) + kbo(:, 5,29, 2) = (/ & + &2.1329e-04_r8,7.4124e-04_r8,9.6341e-04_r8,1.0599e-03_r8,7.5499e-04_r8/) + kbo(:, 1,30, 2) = (/ & + &3.7091e-05_r8,2.5711e-04_r8,3.8922e-04_r8,4.8469e-04_r8,4.6359e-04_r8/) + kbo(:, 2,30, 2) = (/ & + &5.9310e-05_r8,3.3239e-04_r8,4.8070e-04_r8,5.7820e-04_r8,5.1002e-04_r8/) + kbo(:, 3,30, 2) = (/ & + &9.3453e-05_r8,4.2556e-04_r8,5.8851e-04_r8,6.8238e-04_r8,5.5293e-04_r8/) + kbo(:, 4,30, 2) = (/ & + &1.4319e-04_r8,5.3792e-04_r8,7.1341e-04_r8,7.9807e-04_r8,5.9204e-04_r8/) + kbo(:, 5,30, 2) = (/ & + &2.1251e-04_r8,6.7254e-04_r8,8.5446e-04_r8,9.2424e-04_r8,6.2785e-04_r8/) + kbo(:, 1,31, 2) = (/ & + &3.9864e-05_r8,2.3712e-04_r8,3.4911e-04_r8,4.2654e-04_r8,3.8998e-04_r8/) + kbo(:, 2,31, 2) = (/ & + &6.3592e-05_r8,3.0797e-04_r8,4.3283e-04_r8,5.0926e-04_r8,4.2741e-04_r8/) + kbo(:, 3,31, 2) = (/ & + &9.9603e-05_r8,3.9506e-04_r8,5.3137e-04_r8,6.0258e-04_r8,4.6195e-04_r8/) + kbo(:, 4,31, 2) = (/ & + &1.5142e-04_r8,5.0071e-04_r8,6.4518e-04_r8,7.0554e-04_r8,4.9395e-04_r8/) + kbo(:, 5,31, 2) = (/ & + &2.2297e-04_r8,6.2830e-04_r8,7.7442e-04_r8,8.1724e-04_r8,5.2260e-04_r8/) + kbo(:, 1,32, 2) = (/ & + &4.3430e-05_r8,2.2111e-04_r8,3.1573e-04_r8,3.7714e-04_r8,3.2795e-04_r8/) + kbo(:, 2,32, 2) = (/ & + &6.9083e-05_r8,2.8816e-04_r8,3.9276e-04_r8,4.5160e-04_r8,3.5813e-04_r8/) + kbo(:, 3,32, 2) = (/ & + &1.0740e-04_r8,3.7075e-04_r8,4.8372e-04_r8,5.3513e-04_r8,3.8620e-04_r8/) + kbo(:, 4,32, 2) = (/ & + &1.6196e-04_r8,4.7193e-04_r8,5.8843e-04_r8,6.2745e-04_r8,4.1195e-04_r8/) + kbo(:, 5,32, 2) = (/ & + &2.3647e-04_r8,5.9479e-04_r8,7.0866e-04_r8,7.2794e-04_r8,4.3506e-04_r8/) + kbo(:, 1,33, 2) = (/ & + &4.8220e-05_r8,2.0906e-04_r8,2.8832e-04_r8,3.3596e-04_r8,2.7570e-04_r8/) + kbo(:, 2,33, 2) = (/ & + &7.6368e-05_r8,2.7329e-04_r8,3.6023e-04_r8,4.0330e-04_r8,3.0019e-04_r8/) + kbo(:, 3,33, 2) = (/ & + &1.1780e-04_r8,3.5332e-04_r8,4.4506e-04_r8,4.7900e-04_r8,3.2295e-04_r8/) + kbo(:, 4,33, 2) = (/ & + &1.7613e-04_r8,4.5198e-04_r8,5.4349e-04_r8,5.6284e-04_r8,3.4357e-04_r8/) + kbo(:, 5,33, 2) = (/ & + &2.5515e-04_r8,5.7259e-04_r8,6.5773e-04_r8,6.5473e-04_r8,3.6197e-04_r8/) + kbo(:, 1,34, 2) = (/ & + &5.1326e-05_r8,1.9484e-04_r8,2.6083e-04_r8,2.9705e-04_r8,2.3085e-04_r8/) + kbo(:, 2,34, 2) = (/ & + &8.0913e-05_r8,2.5559e-04_r8,3.2688e-04_r8,3.5738e-04_r8,2.5079e-04_r8/) + kbo(:, 3,34, 2) = (/ & + &1.2390e-04_r8,3.3190e-04_r8,4.0497e-04_r8,4.2508e-04_r8,2.6902e-04_r8/) + kbo(:, 4,34, 2) = (/ & + &1.8386e-04_r8,4.2648e-04_r8,4.9662e-04_r8,5.0061e-04_r8,2.8571e-04_r8/) + kbo(:, 5,34, 2) = (/ & + &2.6467e-04_r8,5.4249e-04_r8,6.0361e-04_r8,5.8398e-04_r8,3.0059e-04_r8/) + kbo(:, 1,35, 2) = (/ & + &5.2281e-05_r8,1.7754e-04_r8,2.3171e-04_r8,2.5859e-04_r8,1.9168e-04_r8/) + kbo(:, 2,35, 2) = (/ & + &8.2157e-05_r8,2.3435e-04_r8,2.9174e-04_r8,3.1208e-04_r8,2.0781e-04_r8/) + kbo(:, 3,35, 2) = (/ & + &1.2528e-04_r8,3.0602e-04_r8,3.6300e-04_r8,3.7259e-04_r8,2.2270e-04_r8/) + kbo(:, 4,35, 2) = (/ & + &1.8516e-04_r8,3.9534e-04_r8,4.4759e-04_r8,4.4038e-04_r8,2.3630e-04_r8/) + kbo(:, 5,35, 2) = (/ & + &2.6552e-04_r8,5.0554e-04_r8,5.4703e-04_r8,5.1605e-04_r8,2.4840e-04_r8/) + kbo(:, 1,36, 2) = (/ & + &5.0331e-05_r8,1.5710e-04_r8,2.0093e-04_r8,2.2058e-04_r8,1.5759e-04_r8/) + kbo(:, 2,36, 2) = (/ & + &7.9043e-05_r8,2.0874e-04_r8,2.5435e-04_r8,2.6739e-04_r8,1.7077e-04_r8/) + kbo(:, 3,36, 2) = (/ & + &1.2045e-04_r8,2.7440e-04_r8,3.1834e-04_r8,3.2085e-04_r8,1.8310e-04_r8/) + kbo(:, 4,36, 2) = (/ & + &1.7786e-04_r8,3.5687e-04_r8,3.9494e-04_r8,3.8113e-04_r8,1.9431e-04_r8/) + kbo(:, 5,36, 2) = (/ & + &2.5490e-04_r8,4.5880e-04_r8,4.8570e-04_r8,4.4889e-04_r8,2.0416e-04_r8/) + kbo(:, 1,37, 2) = (/ & + &4.4029e-05_r8,1.3168e-04_r8,1.6668e-04_r8,1.8164e-04_r8,1.2776e-04_r8/) + kbo(:, 2,37, 2) = (/ & + &6.9369e-05_r8,1.7622e-04_r8,2.1241e-04_r8,2.2140e-04_r8,1.3874e-04_r8/) + kbo(:, 3,37, 2) = (/ & + &1.0612e-04_r8,2.3332e-04_r8,2.6770e-04_r8,2.6723e-04_r8,1.4898e-04_r8/) + kbo(:, 4,37, 2) = (/ & + &1.5731e-04_r8,3.0549e-04_r8,3.3418e-04_r8,3.1918e-04_r8,1.5836e-04_r8/) + kbo(:, 5,37, 2) = (/ & + &2.2631e-04_r8,3.9537e-04_r8,4.1350e-04_r8,3.7792e-04_r8,1.6663e-04_r8/) + kbo(:, 1,38, 2) = (/ & + &3.8922e-05_r8,1.1094e-04_r8,1.3878e-04_r8,1.4984e-04_r8,1.0348e-04_r8/) + kbo(:, 2,38, 2) = (/ & + &6.1507e-05_r8,1.4964e-04_r8,1.7814e-04_r8,1.8378e-04_r8,1.1264e-04_r8/) + kbo(:, 3,38, 2) = (/ & + &9.4510e-05_r8,1.9970e-04_r8,2.2619e-04_r8,2.2325e-04_r8,1.2117e-04_r8/) + kbo(:, 4,38, 2) = (/ & + &1.4072e-04_r8,2.6356e-04_r8,2.8447e-04_r8,2.6849e-04_r8,1.2897e-04_r8/) + kbo(:, 5,38, 2) = (/ & + &2.0319e-04_r8,3.4350e-04_r8,3.5441e-04_r8,3.1981e-04_r8,1.3588e-04_r8/) + kbo(:, 1,39, 2) = (/ & + &3.5197e-05_r8,9.4645e-05_r8,1.1658e-04_r8,1.2439e-04_r8,8.3852e-05_r8/) + kbo(:, 2,39, 2) = (/ & + &5.5773e-05_r8,1.2882e-04_r8,1.5091e-04_r8,1.5369e-04_r8,9.1477e-05_r8/) + kbo(:, 3,39, 2) = (/ & + &8.6079e-05_r8,1.7350e-04_r8,1.9331e-04_r8,1.8814e-04_r8,9.8545e-05_r8/) + kbo(:, 4,39, 2) = (/ & + &1.2878e-04_r8,2.3093e-04_r8,2.4509e-04_r8,2.2784e-04_r8,1.0505e-04_r8/) + kbo(:, 5,39, 2) = (/ & + &1.8672e-04_r8,3.0343e-04_r8,3.0781e-04_r8,2.7347e-04_r8,1.1084e-04_r8/) + kbo(:, 1,40, 2) = (/ & + &2.8482e-05_r8,7.5721e-05_r8,9.3100e-05_r8,9.9288e-05_r8,6.7184e-05_r8/) + kbo(:, 2,40, 2) = (/ & + &4.5322e-05_r8,1.0379e-04_r8,1.2136e-04_r8,1.2342e-04_r8,7.3552e-05_r8/) + kbo(:, 3,40, 2) = (/ & + &7.0466e-05_r8,1.4083e-04_r8,1.5650e-04_r8,1.5207e-04_r8,7.9463e-05_r8/) + kbo(:, 4,40, 2) = (/ & + &1.0624e-04_r8,1.8883e-04_r8,1.9975e-04_r8,1.8533e-04_r8,8.4957e-05_r8/) + kbo(:, 5,40, 2) = (/ & + &1.5520e-04_r8,2.4983e-04_r8,2.5250e-04_r8,2.2369e-04_r8,8.9879e-05_r8/) + kbo(:, 1,41, 2) = (/ & + &2.2852e-05_r8,6.0191e-05_r8,7.3911e-05_r8,7.8847e-05_r8,5.3707e-05_r8/) + kbo(:, 2,41, 2) = (/ & + &3.6477e-05_r8,8.3074e-05_r8,9.7030e-05_r8,9.8640e-05_r8,5.9019e-05_r8/) + kbo(:, 3,41, 2) = (/ & + &5.7117e-05_r8,1.1353e-04_r8,1.2598e-04_r8,1.2230e-04_r8,6.3954e-05_r8/) + kbo(:, 4,41, 2) = (/ & + &8.6797e-05_r8,1.5338e-04_r8,1.6193e-04_r8,1.5005e-04_r8,6.8580e-05_r8/) + kbo(:, 5,41, 2) = (/ & + &1.2784e-04_r8,2.0441e-04_r8,2.0604e-04_r8,1.8219e-04_r8,7.2757e-05_r8/) + kbo(:, 1,42, 2) = (/ & + &1.8532e-05_r8,4.8021e-05_r8,5.8809e-05_r8,6.2677e-05_r8,4.2889e-05_r8/) + kbo(:, 2,42, 2) = (/ & + &2.9639e-05_r8,6.6772e-05_r8,7.7781e-05_r8,7.8945e-05_r8,4.7319e-05_r8/) + kbo(:, 3,42, 2) = (/ & + &4.6699e-05_r8,9.1970e-05_r8,1.0173e-04_r8,9.8516e-05_r8,5.1447e-05_r8/) + kbo(:, 4,42, 2) = (/ & + &7.1536e-05_r8,1.2527e-04_r8,1.3174e-04_r8,1.2174e-04_r8,5.5341e-05_r8/) + kbo(:, 5,42, 2) = (/ & + &1.0622e-04_r8,1.6829e-04_r8,1.6888e-04_r8,1.4882e-04_r8,5.8857e-05_r8/) + kbo(:, 1,43, 2) = (/ & + &1.4784e-05_r8,3.7715e-05_r8,4.6105e-05_r8,4.9162e-05_r8,3.3989e-05_r8/) + kbo(:, 2,43, 2) = (/ & + &2.3635e-05_r8,5.2843e-05_r8,6.1488e-05_r8,6.2402e-05_r8,3.7696e-05_r8/) + kbo(:, 3,43, 2) = (/ & + &3.7482e-05_r8,7.3434e-05_r8,8.1121e-05_r8,7.8491e-05_r8,4.1167e-05_r8/) + kbo(:, 4,43, 2) = (/ & + &5.7957e-05_r8,1.0094e-04_r8,1.0596e-04_r8,9.7736e-05_r8,4.4450e-05_r8/) + kbo(:, 5,43, 2) = (/ & + &8.6918e-05_r8,1.3688e-04_r8,1.3695e-04_r8,1.2041e-04_r8,4.7444e-05_r8/) + kbo(:, 1,44, 2) = (/ & + &1.1851e-05_r8,2.9526e-05_r8,3.5985e-05_r8,3.8353e-05_r8,2.6802e-05_r8/) + kbo(:, 2,44, 2) = (/ & + &1.8865e-05_r8,4.1676e-05_r8,4.8402e-05_r8,4.9101e-05_r8,2.9917e-05_r8/) + kbo(:, 3,44, 2) = (/ & + &3.0080e-05_r8,5.8471e-05_r8,6.4462e-05_r8,6.2284e-05_r8,3.2834e-05_r8/) + kbo(:, 4,44, 2) = (/ & + &4.6945e-05_r8,8.1180e-05_r8,8.5021e-05_r8,7.8278e-05_r8,3.5598e-05_r8/) + kbo(:, 5,44, 2) = (/ & + &7.1168e-05_r8,1.1121e-04_r8,1.1093e-04_r8,9.7235e-05_r8,3.8149e-05_r8/) + kbo(:, 1,45, 2) = (/ & + &9.7426e-06_r8,2.3333e-05_r8,2.8230e-05_r8,2.9988e-05_r8,2.1086e-05_r8/) + kbo(:, 2,45, 2) = (/ & + &1.5361e-05_r8,3.3173e-05_r8,3.8317e-05_r8,3.8748e-05_r8,2.3700e-05_r8/) + kbo(:, 3,45, 2) = (/ & + &2.4573e-05_r8,4.7011e-05_r8,5.1561e-05_r8,4.9622e-05_r8,2.6158e-05_r8/) + kbo(:, 4,45, 2) = (/ & + &3.8674e-05_r8,6.5958e-05_r8,6.8724e-05_r8,6.2989e-05_r8,2.8488e-05_r8/) + kbo(:, 5,45, 2) = (/ & + &5.9269e-05_r8,9.1392e-05_r8,9.0638e-05_r8,7.9041e-05_r8,3.0648e-05_r8/) + kbo(:, 1,46, 2) = (/ & + &8.0813e-06_r8,1.8394e-05_r8,2.2048e-05_r8,2.3302e-05_r8,1.6499e-05_r8/) + kbo(:, 2,46, 2) = (/ & + &1.2533e-05_r8,2.6309e-05_r8,3.0179e-05_r8,3.0408e-05_r8,1.8696e-05_r8/) + kbo(:, 3,46, 2) = (/ & + &2.0044e-05_r8,3.7660e-05_r8,4.1056e-05_r8,3.9350e-05_r8,2.0768e-05_r8/) + kbo(:, 4,46, 2) = (/ & + &3.1770e-05_r8,5.3410e-05_r8,5.5319e-05_r8,5.0478e-05_r8,2.2728e-05_r8/) + kbo(:, 5,46, 2) = (/ & + &4.9215e-05_r8,7.4898e-05_r8,7.3800e-05_r8,6.4019e-05_r8,2.4552e-05_r8/) + kbo(:, 1,47, 2) = (/ & + &6.6192e-06_r8,1.4238e-05_r8,1.6907e-05_r8,1.7806e-05_r8,1.2778e-05_r8/) + kbo(:, 2,47, 2) = (/ & + &9.9788e-06_r8,2.0419e-05_r8,2.3301e-05_r8,2.3456e-05_r8,1.4630e-05_r8/) + kbo(:, 3,47, 2) = (/ & + &1.5864e-05_r8,2.9439e-05_r8,3.2011e-05_r8,3.0659e-05_r8,1.6375e-05_r8/) + kbo(:, 4,47, 2) = (/ & + &2.5298e-05_r8,4.2209e-05_r8,4.3617e-05_r8,3.9755e-05_r8,1.8027e-05_r8/) + kbo(:, 5,47, 2) = (/ & + &3.9602e-05_r8,5.9887e-05_r8,5.8840e-05_r8,5.0962e-05_r8,1.9570e-05_r8/) + kbo(:, 1,48, 2) = (/ & + &5.6786e-06_r8,1.1254e-05_r8,1.3112e-05_r8,1.3664e-05_r8,9.8559e-06_r8/) + kbo(:, 2,48, 2) = (/ & + &8.2415e-06_r8,1.6109e-05_r8,1.8176e-05_r8,1.8172e-05_r8,1.1406e-05_r8/) + kbo(:, 3,48, 2) = (/ & + &1.2920e-05_r8,2.3359e-05_r8,2.5209e-05_r8,2.4020e-05_r8,1.2882e-05_r8/) + kbo(:, 4,48, 2) = (/ & + &2.0668e-05_r8,3.3871e-05_r8,3.4762e-05_r8,3.1514e-05_r8,1.4268e-05_r8/) + kbo(:, 5,48, 2) = (/ & + &3.2629e-05_r8,4.8666e-05_r8,4.7495e-05_r8,4.0906e-05_r8,1.5578e-05_r8/) + kbo(:, 1,49, 2) = (/ & + &5.1748e-06_r8,9.2021e-06_r8,1.0379e-05_r8,1.0585e-05_r8,7.5665e-06_r8/) + kbo(:, 2,49, 2) = (/ & + &7.1867e-06_r8,1.3062e-05_r8,1.4427e-05_r8,1.4215e-05_r8,8.8627e-06_r8/) + kbo(:, 3,49, 2) = (/ & + &1.1001e-05_r8,1.9012e-05_r8,2.0206e-05_r8,1.9017e-05_r8,1.0112e-05_r8/) + kbo(:, 4,49, 2) = (/ & + &1.7557e-05_r8,2.7865e-05_r8,2.8224e-05_r8,2.5298e-05_r8,1.1279e-05_r8/) + kbo(:, 5,49, 2) = (/ & + &2.7899e-05_r8,4.0582e-05_r8,3.9130e-05_r8,3.3306e-05_r8,1.2389e-05_r8/) + kbo(:, 1,50, 2) = (/ & + &4.6020e-06_r8,7.4638e-06_r8,8.1645e-06_r8,8.1559e-06_r8,5.7980e-06_r8/) + kbo(:, 2,50, 2) = (/ & + &6.1191e-06_r8,1.0436e-05_r8,1.1320e-05_r8,1.1020e-05_r8,6.8814e-06_r8/) + kbo(:, 3,50, 2) = (/ & + &9.0820e-06_r8,1.5149e-05_r8,1.5926e-05_r8,1.4870e-05_r8,7.9274e-06_r8/) + kbo(:, 4,50, 2) = (/ & + &1.4367e-05_r8,2.2331e-05_r8,2.2448e-05_r8,1.9990e-05_r8,8.9091e-06_r8/) + kbo(:, 5,50, 2) = (/ & + &2.2930e-05_r8,3.2870e-05_r8,3.1485e-05_r8,2.6634e-05_r8,9.8428e-06_r8/) + kbo(:, 1,51, 2) = (/ & + &4.0738e-06_r8,6.0767e-06_r8,6.4322e-06_r8,6.2775e-06_r8,4.4265e-06_r8/) + kbo(:, 2,51, 2) = (/ & + &5.2028e-06_r8,8.3182e-06_r8,8.8519e-06_r8,8.5040e-06_r8,5.3268e-06_r8/) + kbo(:, 3,51, 2) = (/ & + &7.4386e-06_r8,1.1969e-05_r8,1.2454e-05_r8,1.1549e-05_r8,6.2015e-06_r8/) + kbo(:, 4,51, 2) = (/ & + &1.1580e-05_r8,1.7676e-05_r8,1.7666e-05_r8,1.5659e-05_r8,7.0249e-06_r8/) + kbo(:, 5,51, 2) = (/ & + &1.8500e-05_r8,2.6231e-05_r8,2.5018e-05_r8,2.1082e-05_r8,7.8088e-06_r8/) + kbo(:, 1,52, 2) = (/ & + &3.7602e-06_r8,5.1251e-06_r8,5.1954e-06_r8,4.8922e-06_r8,3.3637e-06_r8/) + kbo(:, 2,52, 2) = (/ & + &4.6219e-06_r8,6.8269e-06_r8,7.0581e-06_r8,6.6280e-06_r8,4.1074e-06_r8/) + kbo(:, 3,52, 2) = (/ & + &6.3416e-06_r8,9.6823e-06_r8,9.8934e-06_r8,9.0485e-06_r8,4.8363e-06_r8/) + kbo(:, 4,52, 2) = (/ & + &9.6360e-06_r8,1.4271e-05_r8,1.4108e-05_r8,1.2374e-05_r8,5.5264e-06_r8/) + kbo(:, 5,52, 2) = (/ & + &1.5337e-05_r8,2.1320e-05_r8,2.0165e-05_r8,1.6846e-05_r8,6.1865e-06_r8/) + kbo(:, 1,53, 2) = (/ & + &3.6702e-06_r8,4.5390e-06_r8,4.3659e-06_r8,3.9002e-06_r8,2.5423e-06_r8/) + kbo(:, 2,53, 2) = (/ & + &4.3437e-06_r8,5.8533e-06_r8,5.8072e-06_r8,5.2588e-06_r8,3.1537e-06_r8/) + kbo(:, 3,53, 2) = (/ & + &5.7127e-06_r8,8.1219e-06_r8,8.0674e-06_r8,7.2006e-06_r8,3.7613e-06_r8/) + kbo(:, 4,53, 2) = (/ & + &8.4068e-06_r8,1.1886e-05_r8,1.1528e-05_r8,9.9298e-06_r8,4.3399e-06_r8/) + kbo(:, 5,53, 2) = (/ & + &1.3242e-05_r8,1.7846e-05_r8,1.6632e-05_r8,1.3680e-05_r8,4.8970e-06_r8/) + kbo(:, 1,54, 2) = (/ & + &3.1403e-06_r8,3.6924e-06_r8,3.4557e-06_r8,2.9996e-06_r8,1.9177e-06_r8/) + kbo(:, 2,54, 2) = (/ & + &3.5986e-06_r8,4.6301e-06_r8,4.4986e-06_r8,4.0115e-06_r8,2.4155e-06_r8/) + kbo(:, 3,54, 2) = (/ & + &4.5617e-06_r8,6.2669e-06_r8,6.1686e-06_r8,5.4741e-06_r8,2.9175e-06_r8/) + kbo(:, 4,54, 2) = (/ & + &6.4783e-06_r8,9.0433e-06_r8,8.7626e-06_r8,7.5562e-06_r8,3.4007e-06_r8/) + kbo(:, 5,54, 2) = (/ & + &1.0042e-05_r8,1.3533e-05_r8,1.2655e-05_r8,1.0455e-05_r8,3.8639e-06_r8/) + kbo(:, 1,55, 2) = (/ & + &2.4739e-06_r8,2.8343e-06_r8,2.6165e-06_r8,2.2420e-06_r8,1.4427e-06_r8/) + kbo(:, 2,55, 2) = (/ & + &2.7553e-06_r8,3.4672e-06_r8,3.3435e-06_r8,2.9758e-06_r8,1.8442e-06_r8/) + kbo(:, 3,55, 2) = (/ & + &3.3782e-06_r8,4.5817e-06_r8,4.5186e-06_r8,4.0371e-06_r8,2.2544e-06_r8/) + kbo(:, 4,55, 2) = (/ & + &4.6246e-06_r8,6.4927e-06_r8,6.3529e-06_r8,5.5548e-06_r8,2.6558e-06_r8/) + kbo(:, 5,55, 2) = (/ & + &7.0125e-06_r8,9.6319e-06_r8,9.1393e-06_r8,7.6813e-06_r8,3.0372e-06_r8/) + kbo(:, 1,56, 2) = (/ & + &1.9604e-06_r8,2.1929e-06_r8,1.9920e-06_r8,1.6797e-06_r8,1.0797e-06_r8/) + kbo(:, 2,56, 2) = (/ & + &2.1351e-06_r8,2.6170e-06_r8,2.4998e-06_r8,2.2137e-06_r8,1.4022e-06_r8/) + kbo(:, 3,56, 2) = (/ & + &2.5317e-06_r8,3.3754e-06_r8,3.3236e-06_r8,2.9840e-06_r8,1.7372e-06_r8/) + kbo(:, 4,56, 2) = (/ & + &3.3387e-06_r8,4.6862e-06_r8,4.6202e-06_r8,4.0882e-06_r8,2.0679e-06_r8/) + kbo(:, 5,56, 2) = (/ & + &4.9234e-06_r8,6.8724e-06_r8,6.6108e-06_r8,5.6459e-06_r8,2.3854e-06_r8/) + kbo(:, 1,57, 2) = (/ & + &1.5649e-06_r8,1.7047e-06_r8,1.5250e-06_r8,1.2613e-06_r8,8.0294e-07_r8/) + kbo(:, 2,57, 2) = (/ & + &1.6685e-06_r8,1.9908e-06_r8,1.8801e-06_r8,1.6502e-06_r8,1.0613e-06_r8/) + kbo(:, 3,57, 2) = (/ & + &1.9178e-06_r8,2.5066e-06_r8,2.4556e-06_r8,2.2101e-06_r8,1.3329e-06_r8/) + kbo(:, 4,57, 2) = (/ & + &2.4407e-06_r8,3.4025e-06_r8,3.3722e-06_r8,3.0127e-06_r8,1.6045e-06_r8/) + kbo(:, 5,57, 2) = (/ & + &3.4802e-06_r8,4.9175e-06_r8,4.7870e-06_r8,4.1514e-06_r8,1.8688e-06_r8/) + kbo(:, 1,58, 2) = (/ & + &3.3188e-07_r8,4.3313e-07_r8,4.9294e-07_r8,5.6291e-07_r8,5.9615e-07_r8/) + kbo(:, 2,58, 2) = (/ & + &3.4670e-07_r8,4.9696e-07_r8,5.9930e-07_r8,7.3314e-07_r8,8.0253e-07_r8/) + kbo(:, 3,58, 2) = (/ & + &3.8806e-07_r8,6.1237e-07_r8,7.7019e-07_r8,9.7654e-07_r8,1.0216e-06_r8/) + kbo(:, 4,58, 2) = (/ & + &4.7831e-07_r8,8.1333e-07_r8,1.0442e-06_r8,1.3240e-06_r8,1.2449e-06_r8/) + kbo(:, 5,58, 2) = (/ & + &6.5898e-07_r8,1.1558e-06_r8,1.4682e-06_r8,1.8176e-06_r8,1.4615e-06_r8/) + kbo(:, 1,59, 2) = (/ & + &3.1712e-07_r8,4.1538e-07_r8,4.5873e-07_r8,4.9478e-07_r8,4.6737e-07_r8/) + kbo(:, 2,59, 2) = (/ & + &3.2863e-07_r8,4.7977e-07_r8,5.6611e-07_r8,6.5498e-07_r8,6.3397e-07_r8/) + kbo(:, 3,59, 2) = (/ & + &3.6418e-07_r8,5.9318e-07_r8,7.3191e-07_r8,8.7648e-07_r8,8.1119e-07_r8/) + kbo(:, 4,59, 2) = (/ & + &4.4347e-07_r8,7.8664e-07_r8,9.8989e-07_r8,1.1827e-06_r8,9.9218e-07_r8/) + kbo(:, 5,59, 2) = (/ & + &6.0215e-07_r8,1.1090e-06_r8,1.3813e-06_r8,1.6064e-06_r8,1.1684e-06_r8/) + kbo(:, 1,13, 3) = (/ & + &9.1540e-03_r8,2.0983e-02_r8,2.7409e-02_r8,3.0450e-02_r8,2.3144e-02_r8/) + kbo(:, 2,13, 3) = (/ & + &1.5150e-02_r8,2.9836e-02_r8,3.7088e-02_r8,3.9562e-02_r8,2.6157e-02_r8/) + kbo(:, 3,13, 3) = (/ & + &2.6705e-02_r8,4.3495e-02_r8,5.0489e-02_r8,5.0868e-02_r8,2.9169e-02_r8/) + kbo(:, 4,13, 3) = (/ & + &4.6501e-02_r8,6.3525e-02_r8,6.8930e-02_r8,6.5213e-02_r8,3.2207e-02_r8/) + kbo(:, 5,13, 3) = (/ & + &7.7883e-02_r8,9.1957e-02_r8,9.3471e-02_r8,8.3394e-02_r8,3.5205e-02_r8/) + kbo(:, 1,14, 3) = (/ & + &4.9769e-03_r8,1.5542e-02_r8,2.1404e-02_r8,2.4888e-02_r8,2.0102e-02_r8/) + kbo(:, 2,14, 3) = (/ & + &8.3891e-03_r8,2.1811e-02_r8,2.8513e-02_r8,3.1898e-02_r8,2.2689e-02_r8/) + kbo(:, 3,14, 3) = (/ & + &1.4857e-02_r8,3.0975e-02_r8,3.8046e-02_r8,4.0288e-02_r8,2.5289e-02_r8/) + kbo(:, 4,14, 3) = (/ & + &2.5874e-02_r8,4.3884e-02_r8,5.0681e-02_r8,5.0529e-02_r8,2.7965e-02_r8/) + kbo(:, 5,14, 3) = (/ & + &4.3258e-02_r8,6.1604e-02_r8,6.6800e-02_r8,6.3228e-02_r8,3.0564e-02_r8/) + kbo(:, 1,15, 3) = (/ & + &2.7780e-03_r8,1.1828e-02_r8,1.7073e-02_r8,2.0490e-02_r8,1.7377e-02_r8/) + kbo(:, 2,15, 3) = (/ & + &4.7591e-03_r8,1.6367e-02_r8,2.2382e-02_r8,2.5900e-02_r8,1.9610e-02_r8/) + kbo(:, 3,15, 3) = (/ & + &8.4707e-03_r8,2.2715e-02_r8,2.9226e-02_r8,3.2287e-02_r8,2.1849e-02_r8/) + kbo(:, 4,15, 3) = (/ & + &1.4726e-02_r8,3.1294e-02_r8,3.8074e-02_r8,3.9870e-02_r8,2.4127e-02_r8/) + kbo(:, 5,15, 3) = (/ & + &2.4582e-02_r8,4.2700e-02_r8,4.9087e-02_r8,4.8962e-02_r8,2.6357e-02_r8/) + kbo(:, 1,16, 3) = (/ & + &1.8575e-03_r8,9.6428e-03_r8,1.4258e-02_r8,1.7308e-02_r8,1.4967e-02_r8/) + kbo(:, 2,16, 3) = (/ & + &3.2295e-03_r8,1.3222e-02_r8,1.8534e-02_r8,2.1716e-02_r8,1.6894e-02_r8/) + kbo(:, 3,16, 3) = (/ & + &5.7622e-03_r8,1.8134e-02_r8,2.3952e-02_r8,2.6895e-02_r8,1.8844e-02_r8/) + kbo(:, 4,16, 3) = (/ & + &1.0014e-02_r8,2.4628e-02_r8,3.0790e-02_r8,3.2975e-02_r8,2.0792e-02_r8/) + kbo(:, 5,16, 3) = (/ & + &1.6651e-02_r8,3.3072e-02_r8,3.9202e-02_r8,4.0100e-02_r8,2.2651e-02_r8/) + kbo(:, 1,17, 3) = (/ & + &1.2913e-03_r8,7.9469e-03_r8,1.1927e-02_r8,1.4612e-02_r8,1.2832e-02_r8/) + kbo(:, 2,17, 3) = (/ & + &2.2741e-03_r8,1.0816e-02_r8,1.5424e-02_r8,1.8211e-02_r8,1.4484e-02_r8/) + kbo(:, 3,17, 3) = (/ & + &4.0659e-03_r8,1.4661e-02_r8,1.9799e-02_r8,2.2441e-02_r8,1.6158e-02_r8/) + kbo(:, 4,17, 3) = (/ & + &7.0575e-03_r8,1.9668e-02_r8,2.5205e-02_r8,2.7372e-02_r8,1.7784e-02_r8/) + kbo(:, 5,17, 3) = (/ & + &1.1701e-02_r8,2.6124e-02_r8,3.1755e-02_r8,3.3025e-02_r8,1.9312e-02_r8/) + kbo(:, 1,18, 3) = (/ & + &9.2490e-04_r8,6.5924e-03_r8,1.0000e-02_r8,1.2327e-02_r8,1.0954e-02_r8/) + kbo(:, 2,18, 3) = (/ & + &1.6450e-03_r8,8.9024e-03_r8,1.2876e-02_r8,1.5279e-02_r8,1.2362e-02_r8/) + kbo(:, 3,18, 3) = (/ & + &2.9476e-03_r8,1.1938e-02_r8,1.6432e-02_r8,1.8727e-02_r8,1.3771e-02_r8/) + kbo(:, 4,18, 3) = (/ & + &5.1050e-03_r8,1.5852e-02_r8,2.0747e-02_r8,2.2702e-02_r8,1.5108e-02_r8/) + kbo(:, 5,18, 3) = (/ & + &8.4407e-03_r8,2.0877e-02_r8,2.5905e-02_r8,2.7220e-02_r8,1.6353e-02_r8/) + kbo(:, 1,19, 3) = (/ & + &6.5306e-04_r8,5.4276e-03_r8,8.3228e-03_r8,1.0321e-02_r8,9.3064e-03_r8/) + kbo(:, 2,19, 3) = (/ & + &1.1720e-03_r8,7.2659e-03_r8,1.0659e-02_r8,1.2719e-02_r8,1.0490e-02_r8/) + kbo(:, 3,19, 3) = (/ & + &2.1010e-03_r8,9.6452e-03_r8,1.3501e-02_r8,1.5485e-02_r8,1.1656e-02_r8/) + kbo(:, 4,19, 3) = (/ & + &3.6298e-03_r8,1.2682e-02_r8,1.6890e-02_r8,1.8630e-02_r8,1.2744e-02_r8/) + kbo(:, 5,19, 3) = (/ & + &5.9733e-03_r8,1.6533e-02_r8,2.0894e-02_r8,2.2160e-02_r8,1.3725e-02_r8/) + kbo(:, 1,20, 3) = (/ & + &5.0525e-04_r8,4.5786e-03_r8,7.0416e-03_r8,8.7290e-03_r8,7.8885e-03_r8/) + kbo(:, 2,20, 3) = (/ & + &9.1391e-04_r8,6.1018e-03_r8,8.9804e-03_r8,1.0717e-02_r8,8.8768e-03_r8/) + kbo(:, 3,20, 3) = (/ & + &1.6371e-03_r8,8.0525e-03_r8,1.1310e-02_r8,1.2976e-02_r8,9.8259e-03_r8/) + kbo(:, 4,20, 3) = (/ & + &2.8150e-03_r8,1.0522e-02_r8,1.4057e-02_r8,1.5517e-02_r8,1.0692e-02_r8/) + kbo(:, 5,20, 3) = (/ & + &4.6066e-03_r8,1.3646e-02_r8,1.7296e-02_r8,1.8359e-02_r8,1.1448e-02_r8/) + kbo(:, 1,21, 3) = (/ & + &4.0425e-04_r8,3.8829e-03_r8,5.9693e-03_r8,7.3863e-03_r8,6.6651e-03_r8/) + kbo(:, 2,21, 3) = (/ & + &7.3484e-04_r8,5.1547e-03_r8,7.5787e-03_r8,9.0292e-03_r8,7.4787e-03_r8/) + kbo(:, 3,21, 3) = (/ & + &1.3153e-03_r8,6.7705e-03_r8,9.4934e-03_r8,1.0877e-02_r8,8.2368e-03_r8/) + kbo(:, 4,21, 3) = (/ & + &2.2503e-03_r8,8.8142e-03_r8,1.1739e-02_r8,1.2939e-02_r8,8.9114e-03_r8/) + kbo(:, 5,21, 3) = (/ & + &3.6575e-03_r8,1.1380e-02_r8,1.4377e-02_r8,1.5231e-02_r8,9.5025e-03_r8/) + kbo(:, 1,22, 3) = (/ & + &3.4523e-04_r8,3.3635e-03_r8,5.1429e-03_r8,6.3294e-03_r8,5.6535e-03_r8/) + kbo(:, 2,22, 3) = (/ & + &6.2993e-04_r8,4.4492e-03_r8,6.4923e-03_r8,7.6957e-03_r8,6.3107e-03_r8/) + kbo(:, 3,22, 3) = (/ & + &1.1206e-03_r8,5.8192e-03_r8,8.0871e-03_r8,9.2166e-03_r8,6.9018e-03_r8/) + kbo(:, 4,22, 3) = (/ & + &1.8990e-03_r8,7.5458e-03_r8,9.9517e-03_r8,1.0900e-02_r8,7.4316e-03_r8/) + kbo(:, 5,22, 3) = (/ & + &3.0583e-03_r8,9.7051e-03_r8,1.2139e-02_r8,1.2766e-02_r8,7.8941e-03_r8/) + kbo(:, 1,23, 3) = (/ & + &2.9783e-04_r8,2.9108e-03_r8,4.4177e-03_r8,5.4056e-03_r8,4.7807e-03_r8/) + kbo(:, 2,23, 3) = (/ & + &5.4387e-04_r8,3.8320e-03_r8,5.5435e-03_r8,6.5345e-03_r8,5.2974e-03_r8/) + kbo(:, 3,23, 3) = (/ & + &9.5952e-04_r8,4.9950e-03_r8,6.8655e-03_r8,7.7757e-03_r8,5.7630e-03_r8/) + kbo(:, 4,23, 3) = (/ & + &1.6092e-03_r8,6.4496e-03_r8,8.4095e-03_r8,9.1440e-03_r8,6.1817e-03_r8/) + kbo(:, 5,23, 3) = (/ & + &2.5684e-03_r8,8.2494e-03_r8,1.0215e-02_r8,1.0668e-02_r8,6.5447e-03_r8/) + kbo(:, 1,24, 3) = (/ & + &2.5715e-04_r8,2.5095e-03_r8,3.7777e-03_r8,4.5997e-03_r8,4.0260e-03_r8/) + kbo(:, 2,24, 3) = (/ & + &4.6827e-04_r8,3.2888e-03_r8,4.7107e-03_r8,5.5207e-03_r8,4.4325e-03_r8/) + kbo(:, 3,24, 3) = (/ & + &8.1828e-04_r8,4.2677e-03_r8,5.8000e-03_r8,6.5285e-03_r8,4.8028e-03_r8/) + kbo(:, 4,24, 3) = (/ & + &1.3581e-03_r8,5.4776e-03_r8,7.0696e-03_r8,7.6441e-03_r8,5.1338e-03_r8/) + kbo(:, 5,24, 3) = (/ & + &2.1494e-03_r8,6.9550e-03_r8,8.5500e-03_r8,8.8910e-03_r8,5.4193e-03_r8/) + kbo(:, 1,25, 3) = (/ & + &2.2632e-04_r8,2.1696e-03_r8,3.2330e-03_r8,3.9113e-03_r8,3.3801e-03_r8/) + kbo(:, 2,25, 3) = (/ & + &4.0936e-04_r8,2.8320e-03_r8,4.0052e-03_r8,4.6615e-03_r8,3.7035e-03_r8/) + kbo(:, 3,25, 3) = (/ & + &7.0836e-04_r8,3.6547e-03_r8,4.9096e-03_r8,5.4885e-03_r8,3.9989e-03_r8/) + kbo(:, 4,25, 3) = (/ & + &1.1642e-03_r8,4.6613e-03_r8,5.9642e-03_r8,6.4094e-03_r8,4.2600e-03_r8/) + kbo(:, 5,25, 3) = (/ & + &1.8243e-03_r8,5.8764e-03_r8,7.1830e-03_r8,7.4369e-03_r8,4.4844e-03_r8/) + kbo(:, 1,26, 3) = (/ & + &2.0471e-04_r8,1.8893e-03_r8,2.7768e-03_r8,3.3315e-03_r8,2.8361e-03_r8/) + kbo(:, 2,26, 3) = (/ & + &3.6709e-04_r8,2.4543e-03_r8,3.4258e-03_r8,3.9516e-03_r8,3.0939e-03_r8/) + kbo(:, 3,26, 3) = (/ & + &6.2789e-04_r8,3.1504e-03_r8,4.1849e-03_r8,4.6387e-03_r8,3.3286e-03_r8/) + kbo(:, 4,26, 3) = (/ & + &1.0213e-03_r8,3.9950e-03_r8,5.0687e-03_r8,5.4088e-03_r8,3.5346e-03_r8/) + kbo(:, 5,26, 3) = (/ & + &1.5815e-03_r8,5.0074e-03_r8,6.0787e-03_r8,6.2593e-03_r8,3.7107e-03_r8/) + kbo(:, 1,27, 3) = (/ & + &1.9251e-04_r8,1.6617e-03_r8,2.4029e-03_r8,2.8514e-03_r8,2.3762e-03_r8/) + kbo(:, 2,27, 3) = (/ & + &3.4185e-04_r8,2.1525e-03_r8,2.9600e-03_r8,3.3730e-03_r8,2.5825e-03_r8/) + kbo(:, 3,27, 3) = (/ & + &5.7778e-04_r8,2.7512e-03_r8,3.6092e-03_r8,3.9563e-03_r8,2.7684e-03_r8/) + kbo(:, 4,27, 3) = (/ & + &9.2854e-04_r8,3.4753e-03_r8,4.3621e-03_r8,4.6091e-03_r8,2.9308e-03_r8/) + kbo(:, 5,27, 3) = (/ & + &1.4199e-03_r8,4.3436e-03_r8,5.2156e-03_r8,5.3258e-03_r8,3.0691e-03_r8/) + kbo(:, 1,28, 3) = (/ & + &1.8568e-04_r8,1.4731e-03_r8,2.0943e-03_r8,2.4502e-03_r8,1.9883e-03_r8/) + kbo(:, 2,28, 3) = (/ & + &3.2639e-04_r8,1.9038e-03_r8,2.5783e-03_r8,2.8978e-03_r8,2.1535e-03_r8/) + kbo(:, 3,28, 3) = (/ & + &5.4487e-04_r8,2.4257e-03_r8,3.1398e-03_r8,3.3991e-03_r8,2.3010e-03_r8/) + kbo(:, 4,28, 3) = (/ & + &8.6497e-04_r8,3.0580e-03_r8,3.7865e-03_r8,3.9564e-03_r8,2.4290e-03_r8/) + kbo(:, 5,28, 3) = (/ & + &1.3039e-03_r8,3.8186e-03_r8,4.5211e-03_r8,4.5655e-03_r8,2.5382e-03_r8/) + kbo(:, 1,29, 3) = (/ & + &1.9062e-04_r8,1.3364e-03_r8,1.8603e-03_r8,2.1354e-03_r8,1.6643e-03_r8/) + kbo(:, 2,29, 3) = (/ & + &3.3121e-04_r8,1.7267e-03_r8,2.2927e-03_r8,2.5300e-03_r8,1.7960e-03_r8/) + kbo(:, 3,29, 3) = (/ & + &5.4570e-04_r8,2.2011e-03_r8,2.7931e-03_r8,2.9723e-03_r8,1.9129e-03_r8/) + kbo(:, 4,29, 3) = (/ & + &8.5435e-04_r8,2.7794e-03_r8,3.3678e-03_r8,3.4607e-03_r8,2.0139e-03_r8/) + kbo(:, 5,29, 3) = (/ & + &1.2701e-03_r8,3.4715e-03_r8,4.0279e-03_r8,3.9937e-03_r8,2.1000e-03_r8/) + kbo(:, 1,30, 3) = (/ & + &2.0043e-04_r8,1.2258e-03_r8,1.6689e-03_r8,1.8766e-03_r8,1.3916e-03_r8/) + kbo(:, 2,30, 3) = (/ & + &3.4350e-04_r8,1.5850e-03_r8,2.0586e-03_r8,2.2288e-03_r8,1.4967e-03_r8/) + kbo(:, 3,30, 3) = (/ & + &5.5868e-04_r8,2.0253e-03_r8,2.5096e-03_r8,2.6211e-03_r8,1.5893e-03_r8/) + kbo(:, 4,30, 3) = (/ & + &8.6173e-04_r8,2.5636e-03_r8,3.0320e-03_r8,3.0532e-03_r8,1.6692e-03_r8/) + kbo(:, 5,30, 3) = (/ & + &1.2648e-03_r8,3.2006e-03_r8,3.6329e-03_r8,3.5289e-03_r8,1.7373e-03_r8/) + kbo(:, 1,31, 3) = (/ & + &2.2172e-04_r8,1.1517e-03_r8,1.5273e-03_r8,1.6764e-03_r8,1.1637e-03_r8/) + kbo(:, 2,31, 3) = (/ & + &3.7478e-04_r8,1.4949e-03_r8,1.8875e-03_r8,1.9960e-03_r8,1.2474e-03_r8/) + kbo(:, 3,31, 3) = (/ & + &6.0019e-04_r8,1.9228e-03_r8,2.3094e-03_r8,2.3523e-03_r8,1.3210e-03_r8/) + kbo(:, 4,31, 3) = (/ & + &9.1186e-04_r8,2.4398e-03_r8,2.8016e-03_r8,2.7471e-03_r8,1.3843e-03_r8/) + kbo(:, 5,31, 3) = (/ & + &1.3231e-03_r8,3.0462e-03_r8,3.3613e-03_r8,3.1855e-03_r8,1.4373e-03_r8/) + kbo(:, 1,32, 3) = (/ & + &2.4768e-04_r8,1.0937e-03_r8,1.4089e-03_r8,1.5091e-03_r8,9.7256e-04_r8/) + kbo(:, 2,32, 3) = (/ & + &4.1248e-04_r8,1.4292e-03_r8,1.7477e-03_r8,1.8006e-03_r8,1.0394e-03_r8/) + kbo(:, 3,32, 3) = (/ & + &6.5047e-04_r8,1.8467e-03_r8,2.1484e-03_r8,2.1275e-03_r8,1.0979e-03_r8/) + kbo(:, 4,32, 3) = (/ & + &9.7457e-04_r8,2.3473e-03_r8,2.6140e-03_r8,2.4947e-03_r8,1.1482e-03_r8/) + kbo(:, 5,32, 3) = (/ & + &1.3990e-03_r8,2.9324e-03_r8,3.1399e-03_r8,2.8984e-03_r8,1.1898e-03_r8/) + kbo(:, 1,33, 3) = (/ & + &2.8078e-04_r8,1.0552e-03_r8,1.3156e-03_r8,1.3710e-03_r8,8.1280e-04_r8/) + kbo(:, 2,33, 3) = (/ & + &4.6027e-04_r8,1.3891e-03_r8,1.6405e-03_r8,1.6404e-03_r8,8.6605e-04_r8/) + kbo(:, 3,33, 3) = (/ & + &7.1527e-04_r8,1.8015e-03_r8,2.0264e-03_r8,1.9473e-03_r8,9.1257e-04_r8/) + kbo(:, 4,33, 3) = (/ & + &1.0579e-03_r8,2.2936e-03_r8,2.4711e-03_r8,2.2904e-03_r8,9.5249e-04_r8/) + kbo(:, 5,33, 3) = (/ & + &1.5037e-03_r8,2.8717e-03_r8,2.9734e-03_r8,2.6646e-03_r8,9.8557e-04_r8/) + kbo(:, 1,34, 3) = (/ & + &3.0359e-04_r8,1.0038e-03_r8,1.2140e-03_r8,1.2334e-03_r8,6.7695e-04_r8/) + kbo(:, 2,34, 3) = (/ & + &4.9090e-04_r8,1.3275e-03_r8,1.5216e-03_r8,1.4814e-03_r8,7.1957e-04_r8/) + kbo(:, 3,34, 3) = (/ & + &7.5358e-04_r8,1.7240e-03_r8,1.8846e-03_r8,1.7651e-03_r8,7.5712e-04_r8/) + kbo(:, 4,34, 3) = (/ & + &1.1033e-03_r8,2.1975e-03_r8,2.2999e-03_r8,2.0785e-03_r8,7.8887e-04_r8/) + kbo(:, 5,34, 3) = (/ & + &1.5542e-03_r8,2.7592e-03_r8,2.7749e-03_r8,2.4194e-03_r8,8.1541e-04_r8/) + kbo(:, 1,35, 3) = (/ & + &3.1210e-04_r8,9.3394e-04_r8,1.1014e-03_r8,1.0942e-03_r8,5.6016e-04_r8/) + kbo(:, 2,35, 3) = (/ & + &5.0058e-04_r8,1.2412e-03_r8,1.3879e-03_r8,1.3212e-03_r8,5.9529e-04_r8/) + kbo(:, 3,35, 3) = (/ & + &7.6299e-04_r8,1.6182e-03_r8,1.7248e-03_r8,1.5791e-03_r8,6.2556e-04_r8/) + kbo(:, 4,35, 3) = (/ & + &1.1110e-03_r8,2.0696e-03_r8,2.1107e-03_r8,1.8624e-03_r8,6.5155e-04_r8/) + kbo(:, 5,35, 3) = (/ & + &1.5579e-03_r8,2.6064e-03_r8,2.5562e-03_r8,2.1725e-03_r8,6.7276e-04_r8/) + kbo(:, 1,36, 3) = (/ & + &3.0156e-04_r8,8.4185e-04_r8,9.7484e-04_r8,9.5194e-04_r8,4.6045e-04_r8/) + kbo(:, 2,36, 3) = (/ & + &4.8313e-04_r8,1.1258e-03_r8,1.2357e-03_r8,1.1559e-03_r8,4.8953e-04_r8/) + kbo(:, 3,36, 3) = (/ & + &7.3505e-04_r8,1.4756e-03_r8,1.5422e-03_r8,1.3864e-03_r8,5.1450e-04_r8/) + kbo(:, 4,36, 3) = (/ & + &1.0692e-03_r8,1.8983e-03_r8,1.8970e-03_r8,1.6403e-03_r8,5.3594e-04_r8/) + kbo(:, 5,36, 3) = (/ & + &1.4983e-03_r8,2.4025e-03_r8,2.3079e-03_r8,1.9210e-03_r8,5.5373e-04_r8/) + kbo(:, 1,37, 3) = (/ & + &2.6336e-04_r8,7.1618e-04_r8,8.2306e-04_r8,7.9778e-04_r8,3.7474e-04_r8/) + kbo(:, 2,37, 3) = (/ & + &4.2453e-04_r8,9.6471e-04_r8,1.0505e-03_r8,9.7428e-04_r8,3.9893e-04_r8/) + kbo(:, 3,37, 3) = (/ & + &6.5002e-04_r8,1.2743e-03_r8,1.3189e-03_r8,1.1741e-03_r8,4.2011e-04_r8/) + kbo(:, 4,37, 3) = (/ & + &9.5041e-04_r8,1.6515e-03_r8,1.6323e-03_r8,1.3957e-03_r8,4.3822e-04_r8/) + kbo(:, 5,37, 3) = (/ & + &1.3379e-03_r8,2.1029e-03_r8,1.9967e-03_r8,1.6424e-03_r8,4.5330e-04_r8/) + kbo(:, 1,38, 3) = (/ & + &2.3216e-04_r8,6.1241e-04_r8,6.9804e-04_r8,6.7090e-04_r8,3.0479e-04_r8/) + kbo(:, 2,38, 3) = (/ & + &3.7692e-04_r8,8.3215e-04_r8,8.9807e-04_r8,8.2465e-04_r8,3.2506e-04_r8/) + kbo(:, 3,38, 3) = (/ & + &5.8109e-04_r8,1.1090e-03_r8,1.1350e-03_r8,9.9936e-04_r8,3.4289e-04_r8/) + kbo(:, 4,38, 3) = (/ & + &8.5435e-04_r8,1.4493e-03_r8,1.4148e-03_r8,1.1944e-03_r8,3.5825e-04_r8/) + kbo(:, 5,38, 3) = (/ & + &1.2083e-03_r8,1.8590e-03_r8,1.7421e-03_r8,1.4132e-03_r8,3.7105e-04_r8/) + kbo(:, 1,39, 3) = (/ & + &2.0931e-04_r8,5.3070e-04_r8,5.9845e-04_r8,5.6903e-04_r8,2.4791e-04_r8/) + kbo(:, 2,39, 3) = (/ & + &3.4220e-04_r8,7.2810e-04_r8,7.7651e-04_r8,7.0438e-04_r8,2.6488e-04_r8/) + kbo(:, 3,39, 3) = (/ & + &5.3115e-04_r8,9.8088e-04_r8,9.9044e-04_r8,8.5969e-04_r8,2.7995e-04_r8/) + kbo(:, 4,39, 3) = (/ & + &7.8539e-04_r8,1.2946e-03_r8,1.2451e-03_r8,1.0342e-03_r8,2.9299e-04_r8/) + kbo(:, 5,39, 3) = (/ & + &1.1164e-03_r8,1.6738e-03_r8,1.5453e-03_r8,1.2315e-03_r8,3.0388e-04_r8/) + kbo(:, 1,40, 3) = (/ & + &1.6775e-04_r8,4.2853e-04_r8,4.8421e-04_r8,4.6094e-04_r8,1.9976e-04_r8/) + kbo(:, 2,40, 3) = (/ & + &2.7762e-04_r8,5.9348e-04_r8,6.3343e-04_r8,5.7451e-04_r8,2.1416e-04_r8/) + kbo(:, 3,40, 3) = (/ & + &4.3621e-04_r8,8.0667e-04_r8,8.1437e-04_r8,7.0551e-04_r8,2.2701e-04_r8/) + kbo(:, 4,40, 3) = (/ & + &6.5215e-04_r8,1.0751e-03_r8,1.0317e-03_r8,8.5401e-04_r8,2.3821e-04_r8/) + kbo(:, 5,40, 3) = (/ & + &9.3504e-04_r8,1.4004e-03_r8,1.2886e-03_r8,1.0222e-03_r8,2.4759e-04_r8/) + kbo(:, 1,41, 3) = (/ & + &1.3280e-04_r8,3.4319e-04_r8,3.8888e-04_r8,3.7131e-04_r8,1.6067e-04_r8/) + kbo(:, 2,41, 3) = (/ & + &2.2274e-04_r8,4.8016e-04_r8,5.1341e-04_r8,4.6640e-04_r8,1.7291e-04_r8/) + kbo(:, 3,41, 3) = (/ & + &3.5456e-04_r8,6.5866e-04_r8,6.6545e-04_r8,5.7628e-04_r8,1.8383e-04_r8/) + kbo(:, 4,41, 3) = (/ & + &5.3629e-04_r8,8.8588e-04_r8,8.4970e-04_r8,7.0181e-04_r8,1.9338e-04_r8/) + kbo(:, 5,41, 3) = (/ & + &7.7683e-04_r8,1.1654e-03_r8,1.0693e-03_r8,8.4547e-04_r8,2.0151e-04_r8/) + kbo(:, 1,42, 3) = (/ & + &1.0593e-04_r8,2.7588e-04_r8,3.1299e-04_r8,2.9948e-04_r8,1.2916e-04_r8/) + kbo(:, 2,42, 3) = (/ & + &1.8005e-04_r8,3.9002e-04_r8,4.1742e-04_r8,3.7944e-04_r8,1.3949e-04_r8/) + kbo(:, 3,42, 3) = (/ & + &2.9034e-04_r8,5.4056e-04_r8,5.4599e-04_r8,4.7208e-04_r8,1.4879e-04_r8/) + kbo(:, 4,42, 3) = (/ & + &4.4476e-04_r8,7.3427e-04_r8,7.0341e-04_r8,5.7900e-04_r8,1.5686e-04_r8/) + kbo(:, 5,42, 3) = (/ & + &6.5058e-04_r8,9.7580e-04_r8,8.9207e-04_r8,7.0236e-04_r8,1.6390e-04_r8/) + kbo(:, 1,43, 3) = (/ & + &8.2227e-05_r8,2.1779e-04_r8,2.4797e-04_r8,2.3838e-04_r8,1.0321e-04_r8/) + kbo(:, 2,43, 3) = (/ & + &1.4211e-04_r8,3.1159e-04_r8,3.3460e-04_r8,3.0498e-04_r8,1.1196e-04_r8/) + kbo(:, 3,43, 3) = (/ & + &2.3284e-04_r8,4.3690e-04_r8,4.4252e-04_r8,3.8287e-04_r8,1.1989e-04_r8/) + kbo(:, 4,43, 3) = (/ & + &3.6233e-04_r8,6.0081e-04_r8,5.7601e-04_r8,4.7373e-04_r8,1.2682e-04_r8/) + kbo(:, 5,43, 3) = (/ & + &5.3702e-04_r8,8.0864e-04_r8,7.3797e-04_r8,5.7931e-04_r8,1.3294e-04_r8/) + kbo(:, 1,44, 3) = (/ & + &6.3384e-05_r8,1.7094e-04_r8,1.9525e-04_r8,1.8879e-04_r8,8.2201e-05_r8/) + kbo(:, 2,44, 3) = (/ & + &1.1160e-04_r8,2.4797e-04_r8,2.6713e-04_r8,2.4425e-04_r8,8.9566e-05_r8/) + kbo(:, 3,44, 3) = (/ & + &1.8608e-04_r8,3.5211e-04_r8,3.5750e-04_r8,3.0979e-04_r8,9.6374e-05_r8/) + kbo(:, 4,44, 3) = (/ & + &2.9467e-04_r8,4.9085e-04_r8,4.7122e-04_r8,3.8724e-04_r8,1.0229e-04_r8/) + kbo(:, 5,44, 3) = (/ & + &4.4331e-04_r8,6.6909e-04_r8,6.1037e-04_r8,4.7753e-04_r8,1.0759e-04_r8/) + kbo(:, 1,45, 3) = (/ & + &4.9661e-05_r8,1.3506e-04_r8,1.5438e-04_r8,1.4993e-04_r8,6.5369e-05_r8/) + kbo(:, 2,45, 3) = (/ & + &8.8927e-05_r8,1.9883e-04_r8,2.1432e-04_r8,1.9642e-04_r8,7.1593e-05_r8/) + kbo(:, 3,45, 3) = (/ & + &1.5097e-04_r8,2.8657e-04_r8,2.9095e-04_r8,2.5226e-04_r8,7.7369e-05_r8/) + kbo(:, 4,45, 3) = (/ & + &2.4324e-04_r8,4.0505e-04_r8,3.8855e-04_r8,3.1866e-04_r8,8.2473e-05_r8/) + kbo(:, 5,45, 3) = (/ & + &3.7189e-04_r8,5.6030e-04_r8,5.1022e-04_r8,3.9740e-04_r8,8.7038e-05_r8/) + kbo(:, 1,46, 3) = (/ & + &3.8628e-05_r8,1.0586e-04_r8,1.2112e-04_r8,1.1814e-04_r8,5.1792e-05_r8/) + kbo(:, 2,46, 3) = (/ & + &7.0302e-05_r8,1.5840e-04_r8,1.7081e-04_r8,1.5701e-04_r8,5.7032e-05_r8/) + kbo(:, 3,46, 3) = (/ & + &1.2164e-04_r8,2.3200e-04_r8,2.3559e-04_r8,2.0456e-04_r8,6.1939e-05_r8/) + kbo(:, 4,46, 3) = (/ & + &1.9963e-04_r8,3.3271e-04_r8,3.1891e-04_r8,2.6146e-04_r8,6.6327e-05_r8/) + kbo(:, 5,46, 3) = (/ & + &3.1076e-04_r8,4.6749e-04_r8,4.2492e-04_r8,3.2997e-04_r8,7.0248e-05_r8/) + kbo(:, 1,47, 3) = (/ & + &2.8886e-05_r8,8.0656e-05_r8,9.2760e-05_r8,9.1121e-05_r8,4.0766e-05_r8/) + kbo(:, 2,47, 3) = (/ & + &5.3342e-05_r8,1.2263e-04_r8,1.3276e-04_r8,1.2283e-04_r8,4.5144e-05_r8/) + kbo(:, 3,47, 3) = (/ & + &9.4301e-05_r8,1.8266e-04_r8,1.8617e-04_r8,1.6258e-04_r8,4.9298e-05_r8/) + kbo(:, 4,47, 3) = (/ & + &1.5800e-04_r8,2.6616e-04_r8,2.5579e-04_r8,2.1061e-04_r8,5.3068e-05_r8/) + kbo(:, 5,47, 3) = (/ & + &2.5109e-04_r8,3.7981e-04_r8,3.4582e-04_r8,2.6887e-04_r8,5.6458e-05_r8/) + kbo(:, 1,48, 3) = (/ & + &2.2227e-05_r8,6.2023e-05_r8,7.1458e-05_r8,7.0462e-05_r8,3.1996e-05_r8/) + kbo(:, 2,48, 3) = (/ & + &4.1346e-05_r8,9.5908e-05_r8,1.0391e-04_r8,9.6415e-05_r8,3.5660e-05_r8/) + kbo(:, 3,48, 3) = (/ & + &7.4574e-05_r8,1.4557e-04_r8,1.4830e-04_r8,1.2990e-04_r8,3.9158e-05_r8/) + kbo(:, 4,48, 3) = (/ & + &1.2768e-04_r8,2.1605e-04_r8,2.0753e-04_r8,1.7110e-04_r8,4.2391e-05_r8/) + kbo(:, 5,48, 3) = (/ & + &2.0727e-04_r8,3.1336e-04_r8,2.8498e-04_r8,2.2145e-04_r8,4.5305e-05_r8/) + kbo(:, 1,49, 3) = (/ & + &1.7958e-05_r8,4.8535e-05_r8,5.5723e-05_r8,5.4851e-05_r8,2.5055e-05_r8/) + kbo(:, 2,49, 3) = (/ & + &3.3224e-05_r8,7.6396e-05_r8,8.2450e-05_r8,7.6323e-05_r8,2.8114e-05_r8/) + kbo(:, 3,49, 3) = (/ & + &6.0934e-05_r8,1.1837e-04_r8,1.1999e-04_r8,1.0483e-04_r8,3.1052e-05_r8/) + kbo(:, 4,49, 3) = (/ & + &1.0660e-04_r8,1.7943e-04_r8,1.7133e-04_r8,1.4083e-04_r8,3.3806e-05_r8/) + kbo(:, 5,49, 3) = (/ & + &1.7683e-04_r8,2.6555e-04_r8,2.4004e-04_r8,1.8562e-04_r8,3.6333e-05_r8/) + kbo(:, 1,50, 3) = (/ & + &1.4221e-05_r8,3.7289e-05_r8,4.2772e-05_r8,4.2112e-05_r8,1.9622e-05_r8/) + kbo(:, 2,50, 3) = (/ & + &2.5770e-05_r8,5.9303e-05_r8,6.4074e-05_r8,5.9411e-05_r8,2.2155e-05_r8/) + kbo(:, 3,50, 3) = (/ & + &4.7760e-05_r8,9.3560e-05_r8,9.4851e-05_r8,8.2933e-05_r8,2.4619e-05_r8/) + kbo(:, 4,50, 3) = (/ & + &8.5239e-05_r8,1.4440e-04_r8,1.3769e-04_r8,1.1329e-04_r8,2.6943e-05_r8/) + kbo(:, 5,50, 3) = (/ & + &1.4427e-04_r8,2.1753e-04_r8,1.9626e-04_r8,1.5178e-04_r8,2.9098e-05_r8/) + kbo(:, 1,51, 3) = (/ & + &1.1317e-05_r8,2.8454e-05_r8,3.2589e-05_r8,3.2092e-05_r8,1.5353e-05_r8/) + kbo(:, 2,51, 3) = (/ & + &1.9742e-05_r8,4.5457e-05_r8,4.9229e-05_r8,4.5791e-05_r8,1.7432e-05_r8/) + kbo(:, 3,51, 3) = (/ & + &3.6711e-05_r8,7.2714e-05_r8,7.3963e-05_r8,6.4841e-05_r8,1.9496e-05_r8/) + kbo(:, 4,51, 3) = (/ & + &6.6639e-05_r8,1.1416e-04_r8,1.0901e-04_r8,8.9977e-05_r8,2.1439e-05_r8/) + kbo(:, 5,51, 3) = (/ & + &1.1501e-04_r8,1.7496e-04_r8,1.5780e-04_r8,1.2232e-04_r8,2.3266e-05_r8/) + kbo(:, 1,52, 3) = (/ & + &9.5193e-06_r8,2.2151e-05_r8,2.5124e-05_r8,2.4603e-05_r8,1.1980e-05_r8/) + kbo(:, 2,52, 3) = (/ & + &1.5692e-05_r8,3.5362e-05_r8,3.8197e-05_r8,3.5510e-05_r8,1.3701e-05_r8/) + kbo(:, 3,52, 3) = (/ & + &2.8933e-05_r8,5.7282e-05_r8,5.8273e-05_r8,5.1019e-05_r8,1.5415e-05_r8/) + kbo(:, 4,52, 3) = (/ & + &5.3248e-05_r8,9.1604e-05_r8,8.7350e-05_r8,7.2017e-05_r8,1.7048e-05_r8/) + kbo(:, 5,52, 3) = (/ & + &9.3646e-05_r8,1.4304e-04_r8,1.2865e-04_r8,9.9576e-05_r8,1.8583e-05_r8/) + kbo(:, 1,53, 3) = (/ & + &8.6013e-06_r8,1.7806e-05_r8,1.9756e-05_r8,1.9080e-05_r8,9.3222e-06_r8/) + kbo(:, 2,53, 3) = (/ & + &1.3174e-05_r8,2.8179e-05_r8,3.0144e-05_r8,2.7850e-05_r8,1.0743e-05_r8/) + kbo(:, 3,53, 3) = (/ & + &2.3711e-05_r8,4.6162e-05_r8,4.6700e-05_r8,4.0629e-05_r8,1.2161e-05_r8/) + kbo(:, 4,53, 3) = (/ & + &4.4006e-05_r8,7.5218e-05_r8,7.1366e-05_r8,5.8426e-05_r8,1.3528e-05_r8/) + kbo(:, 5,53, 3) = (/ & + &7.8885e-05_r8,1.1994e-04_r8,1.0719e-04_r8,8.2389e-05_r8,1.4819e-05_r8/) + kbo(:, 1,54, 3) = (/ & + &6.9789e-06_r8,1.3437e-05_r8,1.4771e-05_r8,1.4238e-05_r8,7.2546e-06_r8/) + kbo(:, 2,54, 3) = (/ & + &9.9119e-06_r8,2.0811e-05_r8,2.2371e-05_r8,2.0824e-05_r8,8.4185e-06_r8/) + kbo(:, 3,54, 3) = (/ & + &1.7167e-05_r8,3.4065e-05_r8,3.4800e-05_r8,3.0574e-05_r8,9.5808e-06_r8/) + kbo(:, 4,54, 3) = (/ & + &3.1909e-05_r8,5.5956e-05_r8,5.3708e-05_r8,4.4436e-05_r8,1.0721e-05_r8/) + kbo(:, 5,54, 3) = (/ & + &5.8081e-05_r8,9.0422e-05_r8,8.1544e-05_r8,6.3307e-05_r8,1.1799e-05_r8/) + kbo(:, 1,55, 3) = (/ & + &5.3128e-06_r8,9.7390e-06_r8,1.0688e-05_r8,1.0358e-05_r8,5.6367e-06_r8/) + kbo(:, 2,55, 3) = (/ & + &6.9987e-06_r8,1.4672e-05_r8,1.5984e-05_r8,1.5113e-05_r8,6.5876e-06_r8/) + kbo(:, 3,55, 3) = (/ & + &1.1522e-05_r8,2.3785e-05_r8,2.4757e-05_r8,2.2203e-05_r8,7.5366e-06_r8/) + kbo(:, 4,55, 3) = (/ & + &2.1231e-05_r8,3.9099e-05_r8,3.8355e-05_r8,3.2404e-05_r8,8.4801e-06_r8/) + kbo(:, 5,55, 3) = (/ & + &3.9115e-05_r8,6.3594e-05_r8,5.8504e-05_r8,4.6398e-05_r8,9.3778e-06_r8/) + kbo(:, 1,56, 3) = (/ & + &4.1255e-06_r8,7.1364e-06_r8,7.7808e-06_r8,7.5482e-06_r8,4.3681e-06_r8/) + kbo(:, 2,56, 3) = (/ & + &5.0603e-06_r8,1.0419e-05_r8,1.1462e-05_r8,1.0974e-05_r8,5.1464e-06_r8/) + kbo(:, 3,56, 3) = (/ & + &7.8194e-06_r8,1.6631e-05_r8,1.7619e-05_r8,1.6112e-05_r8,5.9174e-06_r8/) + kbo(:, 4,56, 3) = (/ & + &1.4119e-05_r8,2.7308e-05_r8,2.7375e-05_r8,2.3608e-05_r8,6.6946e-06_r8/) + kbo(:, 5,56, 3) = (/ & + &2.6208e-05_r8,4.4637e-05_r8,4.1923e-05_r8,3.3985e-05_r8,7.4429e-06_r8/) + kbo(:, 1,57, 3) = (/ & + &3.2493e-06_r8,5.2971e-06_r8,5.6993e-06_r8,5.5117e-06_r8,3.3724e-06_r8/) + kbo(:, 2,57, 3) = (/ & + &3.7488e-06_r8,7.4571e-06_r8,8.2480e-06_r8,7.9737e-06_r8,4.0105e-06_r8/) + kbo(:, 3,57, 3) = (/ & + &5.3914e-06_r8,1.1658e-05_r8,1.2555e-05_r8,1.1685e-05_r8,4.6429e-06_r8/) + kbo(:, 4,57, 3) = (/ & + &9.4028e-06_r8,1.9067e-05_r8,1.9516e-05_r8,1.7175e-05_r8,5.2749e-06_r8/) + kbo(:, 5,57, 3) = (/ & + &1.7491e-05_r8,3.1266e-05_r8,3.0002e-05_r8,2.4856e-05_r8,5.8965e-06_r8/) + kbo(:, 1,58, 3) = (/ & + &6.8210e-07_r8,1.3006e-06_r8,1.7801e-06_r8,2.4088e-06_r8,2.6011e-06_r8/) + kbo(:, 2,58, 3) = (/ & + &7.5233e-07_r8,1.7695e-06_r8,2.5293e-06_r8,3.4612e-06_r8,3.1260e-06_r8/) + kbo(:, 3,58, 3) = (/ & + &1.0077e-06_r8,2.6981e-06_r8,3.8040e-06_r8,5.0545e-06_r8,3.6427e-06_r8/) + kbo(:, 4,58, 3) = (/ & + &1.6789e-06_r8,4.3767e-06_r8,5.8928e-06_r8,7.4329e-06_r8,4.1541e-06_r8/) + kbo(:, 5,58, 3) = (/ & + &3.1035e-06_r8,7.1707e-06_r8,9.0733e-06_r8,1.0789e-05_r8,4.6675e-06_r8/) + kbo(:, 1,59, 3) = (/ & + &6.5007e-07_r8,1.2934e-06_r8,1.7266e-06_r8,2.1835e-06_r8,2.0738e-06_r8/) + kbo(:, 2,59, 3) = (/ & + &7.0640e-07_r8,1.7649e-06_r8,2.4593e-06_r8,3.1227e-06_r8,2.5027e-06_r8/) + kbo(:, 3,59, 3) = (/ & + &9.2077e-07_r8,2.6612e-06_r8,3.6625e-06_r8,4.5103e-06_r8,2.9231e-06_r8/) + kbo(:, 4,59, 3) = (/ & + &1.5013e-06_r8,4.2541e-06_r8,5.5816e-06_r8,6.5373e-06_r8,3.3365e-06_r8/) + kbo(:, 5,59, 3) = (/ & + &2.7629e-06_r8,6.8551e-06_r8,8.4568e-06_r8,9.3583e-06_r8,3.7483e-06_r8/) + kbo(:, 1,13, 4) = (/ & + &6.7049e-02_r8,1.0578e-01_r8,1.2049e-01_r8,1.1447e-01_r8,5.3996e-02_r8/) + kbo(:, 2,13, 4) = (/ & + &1.2378e-01_r8,1.5839e-01_r8,1.6716e-01_r8,1.4967e-01_r8,5.8724e-02_r8/) + kbo(:, 3,13, 4) = (/ & + &2.1508e-01_r8,2.3357e-01_r8,2.2807e-01_r8,1.9256e-01_r8,6.3468e-02_r8/) + kbo(:, 4,13, 4) = (/ & + &3.4658e-01_r8,3.3547e-01_r8,3.0532e-01_r8,2.4368e-01_r8,6.7895e-02_r8/) + kbo(:, 5,13, 4) = (/ & + &5.1918e-01_r8,4.6542e-01_r8,4.0071e-01_r8,3.0351e-01_r8,7.2180e-02_r8/) + kbo(:, 1,14, 4) = (/ & + &3.7591e-02_r8,7.5935e-02_r8,8.9834e-02_r8,8.8154e-02_r8,4.7370e-02_r8/) + kbo(:, 2,14, 4) = (/ & + &6.9282e-02_r8,1.0939e-01_r8,1.2082e-01_r8,1.1264e-01_r8,5.1597e-02_r8/) + kbo(:, 3,14, 4) = (/ & + &1.1973e-01_r8,1.5456e-01_r8,1.5973e-01_r8,1.4179e-01_r8,5.5698e-02_r8/) + kbo(:, 4,14, 4) = (/ & + &1.9141e-01_r8,2.1319e-01_r8,2.0757e-01_r8,1.7567e-01_r8,5.9503e-02_r8/) + kbo(:, 5,14, 4) = (/ & + &2.8419e-01_r8,2.8689e-01_r8,2.6537e-01_r8,2.1426e-01_r8,6.3167e-02_r8/) + kbo(:, 1,15, 4) = (/ & + &2.1562e-02_r8,5.5383e-02_r8,6.7683e-02_r8,6.8583e-02_r8,4.1403e-02_r8/) + kbo(:, 2,15, 4) = (/ & + &3.9720e-02_r8,7.6977e-02_r8,8.8827e-02_r8,8.5804e-02_r8,4.5107e-02_r8/) + kbo(:, 3,15, 4) = (/ & + &6.8049e-02_r8,1.0522e-01_r8,1.1458e-01_r8,1.0592e-01_r8,4.8636e-02_r8/) + kbo(:, 4,15, 4) = (/ & + &1.0779e-01_r8,1.4096e-01_r8,1.4532e-01_r8,1.2906e-01_r8,5.1972e-02_r8/) + kbo(:, 5,15, 4) = (/ & + &1.5865e-01_r8,1.8497e-01_r8,1.8175e-01_r8,1.5501e-01_r8,5.5102e-02_r8/) + kbo(:, 1,16, 4) = (/ & + &1.4772e-02_r8,4.3932e-02_r8,5.4513e-02_r8,5.6391e-02_r8,3.6009e-02_r8/) + kbo(:, 2,16, 4) = (/ & + &2.7132e-02_r8,5.9972e-02_r8,7.0550e-02_r8,6.9709e-02_r8,3.9169e-02_r8/) + kbo(:, 3,16, 4) = (/ & + &4.6049e-02_r8,8.0444e-02_r8,8.9769e-02_r8,8.5125e-02_r8,4.2209e-02_r8/) + kbo(:, 4,16, 4) = (/ & + &7.2213e-02_r8,1.0588e-01_r8,1.1245e-01_r8,1.0271e-01_r8,4.5097e-02_r8/) + kbo(:, 5,16, 4) = (/ & + &1.0534e-01_r8,1.3693e-01_r8,1.3910e-01_r8,1.2239e-01_r8,4.7833e-02_r8/) + kbo(:, 1,17, 4) = (/ & + &1.0505e-02_r8,3.5195e-02_r8,4.4278e-02_r8,4.6677e-02_r8,3.1091e-02_r8/) + kbo(:, 2,17, 4) = (/ & + &1.9166e-02_r8,4.7335e-02_r8,5.6632e-02_r8,5.7162e-02_r8,3.3802e-02_r8/) + kbo(:, 3,17, 4) = (/ & + &3.2242e-02_r8,6.2594e-02_r8,7.1319e-02_r8,6.9208e-02_r8,3.6407e-02_r8/) + kbo(:, 4,17, 4) = (/ & + &4.9961e-02_r8,8.1341e-02_r8,8.8470e-02_r8,8.2810e-02_r8,3.8893e-02_r8/) + kbo(:, 5,17, 4) = (/ & + &7.2404e-02_r8,1.0400e-01_r8,1.0862e-01_r8,9.8084e-02_r8,4.1273e-02_r8/) + kbo(:, 1,18, 4) = (/ & + &7.6562e-03_r8,2.8333e-02_r8,3.6121e-02_r8,3.8835e-02_r8,2.6686e-02_r8/) + kbo(:, 2,18, 4) = (/ & + &1.3867e-02_r8,3.7676e-02_r8,4.5765e-02_r8,4.7147e-02_r8,2.9013e-02_r8/) + kbo(:, 3,18, 4) = (/ & + &2.3086e-02_r8,4.9274e-02_r8,5.7143e-02_r8,5.6661e-02_r8,3.1231e-02_r8/) + kbo(:, 4,18, 4) = (/ & + &3.5350e-02_r8,6.3412e-02_r8,7.0379e-02_r8,6.7363e-02_r8,3.3367e-02_r8/) + kbo(:, 5,18, 4) = (/ & + &5.0974e-02_r8,8.0253e-02_r8,8.5775e-02_r8,7.9284e-02_r8,3.5380e-02_r8/) + kbo(:, 1,19, 4) = (/ & + &5.4803e-03_r8,2.2514e-02_r8,2.9208e-02_r8,3.2099e-02_r8,2.2789e-02_r8/) + kbo(:, 2,19, 4) = (/ & + &9.8317e-03_r8,2.9614e-02_r8,3.6650e-02_r8,3.8632e-02_r8,2.4757e-02_r8/) + kbo(:, 3,19, 4) = (/ & + &1.6184e-02_r8,3.8312e-02_r8,4.5365e-02_r8,4.6081e-02_r8,2.6634e-02_r8/) + kbo(:, 4,19, 4) = (/ & + &2.4529e-02_r8,4.8776e-02_r8,5.5440e-02_r8,5.4451e-02_r8,2.8434e-02_r8/) + kbo(:, 5,19, 4) = (/ & + &3.5233e-02_r8,6.1231e-02_r8,6.7107e-02_r8,6.3779e-02_r8,3.0105e-02_r8/) + kbo(:, 1,20, 4) = (/ & + &4.2828e-03_r8,1.8555e-02_r8,2.4277e-02_r8,2.6995e-02_r8,1.9406e-02_r8/) + kbo(:, 2,20, 4) = (/ & + &7.5931e-03_r8,2.4236e-02_r8,3.0290e-02_r8,3.2347e-02_r8,2.1050e-02_r8/) + kbo(:, 3,20, 4) = (/ & + &1.2330e-02_r8,3.1123e-02_r8,3.7288e-02_r8,3.8414e-02_r8,2.2621e-02_r8/) + kbo(:, 4,20, 4) = (/ & + &1.8510e-02_r8,3.9358e-02_r8,4.5374e-02_r8,4.5224e-02_r8,2.4107e-02_r8/) + kbo(:, 5,20, 4) = (/ & + &2.6546e-02_r8,4.9149e-02_r8,5.4720e-02_r8,5.2789e-02_r8,2.5443e-02_r8/) + kbo(:, 1,21, 4) = (/ & + &3.4446e-03_r8,1.5454e-02_r8,2.0322e-02_r8,2.2766e-02_r8,1.6445e-02_r8/) + kbo(:, 2,21, 4) = (/ & + &6.0284e-03_r8,2.0063e-02_r8,2.5258e-02_r8,2.7191e-02_r8,1.7819e-02_r8/) + kbo(:, 3,21, 4) = (/ & + &9.6698e-03_r8,2.5633e-02_r8,3.0993e-02_r8,3.2202e-02_r8,1.9116e-02_r8/) + kbo(:, 4,21, 4) = (/ & + &1.4416e-02_r8,3.2230e-02_r8,3.7573e-02_r8,3.7789e-02_r8,2.0305e-02_r8/) + kbo(:, 5,21, 4) = (/ & + &2.0653e-02_r8,4.0104e-02_r8,4.5153e-02_r8,4.3956e-02_r8,2.1322e-02_r8/) + kbo(:, 1,22, 4) = (/ & + &2.9417e-03_r8,1.3191e-02_r8,1.7364e-02_r8,1.9451e-02_r8,1.3960e-02_r8/) + kbo(:, 2,22, 4) = (/ & + &5.0614e-03_r8,1.7031e-02_r8,2.1496e-02_r8,2.3163e-02_r8,1.5084e-02_r8/) + kbo(:, 3,22, 4) = (/ & + &7.9857e-03_r8,2.1643e-02_r8,2.6269e-02_r8,2.7349e-02_r8,1.6128e-02_r8/) + kbo(:, 4,22, 4) = (/ & + &1.1815e-02_r8,2.7096e-02_r8,3.1716e-02_r8,3.1974e-02_r8,1.7035e-02_r8/) + kbo(:, 5,22, 4) = (/ & + &1.6874e-02_r8,3.3630e-02_r8,3.8023e-02_r8,3.7066e-02_r8,1.7780e-02_r8/) + kbo(:, 1,23, 4) = (/ & + &2.5270e-03_r8,1.1266e-02_r8,1.4840e-02_r8,1.6589e-02_r8,1.1804e-02_r8/) + kbo(:, 2,23, 4) = (/ & + &4.2729e-03_r8,1.4464e-02_r8,1.8293e-02_r8,1.9688e-02_r8,1.2713e-02_r8/) + kbo(:, 3,23, 4) = (/ & + &6.6524e-03_r8,1.8294e-02_r8,2.2254e-02_r8,2.3162e-02_r8,1.3520e-02_r8/) + kbo(:, 4,23, 4) = (/ & + &9.7631e-03_r8,2.2820e-02_r8,2.6759e-02_r8,2.6972e-02_r8,1.4190e-02_r8/) + kbo(:, 5,23, 4) = (/ & + &1.3880e-02_r8,2.8296e-02_r8,3.2015e-02_r8,3.1138e-02_r8,1.4756e-02_r8/) + kbo(:, 1,24, 4) = (/ & + &2.1649e-03_r8,9.5893e-03_r8,1.2641e-02_r8,1.4093e-02_r8,9.9437e-03_r8/) + kbo(:, 2,24, 4) = (/ & + &3.5984e-03_r8,1.2238e-02_r8,1.5497e-02_r8,1.6660e-02_r8,1.0660e-02_r8/) + kbo(:, 3,24, 4) = (/ & + &5.5343e-03_r8,1.5407e-02_r8,1.8761e-02_r8,1.9506e-02_r8,1.1265e-02_r8/) + kbo(:, 4,24, 4) = (/ & + &8.0630e-03_r8,1.9178e-02_r8,2.2493e-02_r8,2.2596e-02_r8,1.1775e-02_r8/) + kbo(:, 5,24, 4) = (/ & + &1.1384e-02_r8,2.3746e-02_r8,2.6831e-02_r8,2.5965e-02_r8,1.2211e-02_r8/) + kbo(:, 1,25, 4) = (/ & + &1.8852e-03_r8,8.1978e-03_r8,1.0793e-02_r8,1.1983e-02_r8,8.3500e-03_r8/) + kbo(:, 2,25, 4) = (/ & + &3.0822e-03_r8,1.0410e-02_r8,1.3161e-02_r8,1.4105e-02_r8,8.8930e-03_r8/) + kbo(:, 3,25, 4) = (/ & + &4.6788e-03_r8,1.3060e-02_r8,1.5866e-02_r8,1.6423e-02_r8,9.3555e-03_r8/) + kbo(:, 4,25, 4) = (/ & + &6.7672e-03_r8,1.6246e-02_r8,1.8965e-02_r8,1.8919e-02_r8,9.7508e-03_r8/) + kbo(:, 5,25, 4) = (/ & + &9.4703e-03_r8,2.0069e-02_r8,2.2560e-02_r8,2.1660e-02_r8,1.0087e-02_r8/) + kbo(:, 1,26, 4) = (/ & + &1.6838e-03_r8,7.0691e-03_r8,9.2649e-03_r8,1.0222e-02_r8,6.9856e-03_r8/) + kbo(:, 2,26, 4) = (/ & + &2.7021e-03_r8,8.9432e-03_r8,1.1240e-02_r8,1.1970e-02_r8,7.4013e-03_r8/) + kbo(:, 3,26, 4) = (/ & + &4.0452e-03_r8,1.1195e-02_r8,1.3497e-02_r8,1.3851e-02_r8,7.7588e-03_r8/) + kbo(:, 4,26, 4) = (/ & + &5.8017e-03_r8,1.3912e-02_r8,1.6094e-02_r8,1.5906e-02_r8,8.0669e-03_r8/) + kbo(:, 5,26, 4) = (/ & + &8.0448e-03_r8,1.7140e-02_r8,1.9095e-02_r8,1.8175e-02_r8,8.3263e-03_r8/) + kbo(:, 1,27, 4) = (/ & + &1.5607e-03_r8,6.1890e-03_r8,8.0258e-03_r8,8.7683e-03_r8,5.8228e-03_r8/) + kbo(:, 2,27, 4) = (/ & + &2.4561e-03_r8,7.8183e-03_r8,9.7010e-03_r8,1.0217e-02_r8,6.1459e-03_r8/) + kbo(:, 3,27, 4) = (/ & + &3.6253e-03_r8,9.7806e-03_r8,1.1625e-02_r8,1.1787e-02_r8,6.4270e-03_r8/) + kbo(:, 4,27, 4) = (/ & + &5.1578e-03_r8,1.2146e-02_r8,1.3856e-02_r8,1.3525e-02_r8,6.6670e-03_r8/) + kbo(:, 5,27, 4) = (/ & + &7.0917e-03_r8,1.4929e-02_r8,1.6419e-02_r8,1.5452e-02_r8,6.8676e-03_r8/) + kbo(:, 1,28, 4) = (/ & + &1.4790e-03_r8,5.4823e-03_r8,6.9976e-03_r8,7.5478e-03_r8,4.8444e-03_r8/) + kbo(:, 2,28, 4) = (/ & + &2.2841e-03_r8,6.9262e-03_r8,8.4418e-03_r8,8.7670e-03_r8,5.0989e-03_r8/) + kbo(:, 3,28, 4) = (/ & + &3.3280e-03_r8,8.6594e-03_r8,1.0117e-02_r8,1.0108e-02_r8,5.3174e-03_r8/) + kbo(:, 4,28, 4) = (/ & + &4.7002e-03_r8,1.0747e-02_r8,1.2065e-02_r8,1.1610e-02_r8,5.5053e-03_r8/) + kbo(:, 5,28, 4) = (/ & + &6.4216e-03_r8,1.3181e-02_r8,1.4294e-02_r8,1.3272e-02_r8,5.6597e-03_r8/) + kbo(:, 1,29, 4) = (/ & + &1.4846e-03_r8,5.0115e-03_r8,6.2330e-03_r8,6.5969e-03_r8,4.0271e-03_r8/) + kbo(:, 2,29, 4) = (/ & + &2.2530e-03_r8,6.3449e-03_r8,7.5362e-03_r8,7.6648e-03_r8,4.2267e-03_r8/) + kbo(:, 3,29, 4) = (/ & + &3.2510e-03_r8,7.9458e-03_r8,9.0603e-03_r8,8.8629e-03_r8,4.3989e-03_r8/) + kbo(:, 4,29, 4) = (/ & + &4.5516e-03_r8,9.8569e-03_r8,1.0828e-02_r8,1.0206e-02_r8,4.5467e-03_r8/) + kbo(:, 5,29, 4) = (/ & + &6.1805e-03_r8,1.2091e-02_r8,1.2839e-02_r8,1.1688e-02_r8,4.6649e-03_r8/) + kbo(:, 1,30, 4) = (/ & + &1.5199e-03_r8,4.6536e-03_r8,5.6184e-03_r8,5.8111e-03_r8,3.3446e-03_r8/) + kbo(:, 2,30, 4) = (/ & + &2.2691e-03_r8,5.9027e-03_r8,6.8239e-03_r8,6.7733e-03_r8,3.5018e-03_r8/) + kbo(:, 3,30, 4) = (/ & + &3.2488e-03_r8,7.4072e-03_r8,8.2321e-03_r8,7.8632e-03_r8,3.6376e-03_r8/) + kbo(:, 4,30, 4) = (/ & + &4.5119e-03_r8,9.1886e-03_r8,9.8595e-03_r8,9.0823e-03_r8,3.7530e-03_r8/) + kbo(:, 5,30, 4) = (/ & + &6.0862e-03_r8,1.1295e-02_r8,1.1709e-02_r8,1.0421e-02_r8,3.8437e-03_r8/) + kbo(:, 1,31, 4) = (/ & + &1.6311e-03_r8,4.4648e-03_r8,5.2027e-03_r8,5.2222e-03_r8,2.7768e-03_r8/) + kbo(:, 2,31, 4) = (/ & + &2.3988e-03_r8,5.6776e-03_r8,6.3545e-03_r8,6.1217e-03_r8,2.9011e-03_r8/) + kbo(:, 3,31, 4) = (/ & + &3.4145e-03_r8,7.1414e-03_r8,7.7030e-03_r8,7.1444e-03_r8,3.0093e-03_r8/) + kbo(:, 4,31, 4) = (/ & + &4.7033e-03_r8,8.8852e-03_r8,9.2526e-03_r8,8.2855e-03_r8,3.0977e-03_r8/) + kbo(:, 5,31, 4) = (/ & + &6.2907e-03_r8,1.0964e-02_r8,1.1034e-02_r8,9.5381e-03_r8,3.1698e-03_r8/) + kbo(:, 1,32, 4) = (/ & + &1.7646e-03_r8,4.3392e-03_r8,4.8857e-03_r8,4.7446e-03_r8,2.3054e-03_r8/) + kbo(:, 2,32, 4) = (/ & + &2.5651e-03_r8,5.5295e-03_r8,5.9929e-03_r8,5.5951e-03_r8,2.4036e-03_r8/) + kbo(:, 3,32, 4) = (/ & + &3.6260e-03_r8,6.9759e-03_r8,7.2903e-03_r8,6.5646e-03_r8,2.4876e-03_r8/) + kbo(:, 4,32, 4) = (/ & + &4.9515e-03_r8,8.7151e-03_r8,8.7927e-03_r8,7.6385e-03_r8,2.5574e-03_r8/) + kbo(:, 5,32, 4) = (/ & + &6.5598e-03_r8,1.0782e-02_r8,1.0540e-02_r8,8.8332e-03_r8,2.6142e-03_r8/) + kbo(:, 1,33, 4) = (/ & + &1.9374e-03_r8,4.2874e-03_r8,4.6591e-03_r8,4.3717e-03_r8,1.9130e-03_r8/) + kbo(:, 2,33, 4) = (/ & + &2.7949e-03_r8,5.4803e-03_r8,5.7408e-03_r8,5.1902e-03_r8,1.9904e-03_r8/) + kbo(:, 3,33, 4) = (/ & + &3.9103e-03_r8,6.9411e-03_r8,7.0122e-03_r8,6.1134e-03_r8,2.0570e-03_r8/) + kbo(:, 4,33, 4) = (/ & + &5.2898e-03_r8,8.7072e-03_r8,8.5064e-03_r8,7.1438e-03_r8,2.1115e-03_r8/) + kbo(:, 5,33, 4) = (/ & + &6.9527e-03_r8,1.0788e-02_r8,1.0239e-02_r8,8.3069e-03_r8,2.1568e-03_r8/) + kbo(:, 1,34, 4) = (/ & + &2.0406e-03_r8,4.1540e-03_r8,4.3826e-03_r8,3.9946e-03_r8,1.5845e-03_r8/) + kbo(:, 2,34, 4) = (/ & + &2.9261e-03_r8,5.3300e-03_r8,5.4194e-03_r8,4.7632e-03_r8,1.6461e-03_r8/) + kbo(:, 3,34, 4) = (/ & + &4.0546e-03_r8,6.7773e-03_r8,6.6513e-03_r8,5.6287e-03_r8,1.6983e-03_r8/) + kbo(:, 4,34, 4) = (/ & + &5.4348e-03_r8,8.5143e-03_r8,8.1040e-03_r8,6.6107e-03_r8,1.7421e-03_r8/) + kbo(:, 5,34, 4) = (/ & + &7.1060e-03_r8,1.0544e-02_r8,9.7699e-03_r8,7.7212e-03_r8,1.7780e-03_r8/) + kbo(:, 1,35, 4) = (/ & + &2.0728e-03_r8,3.9485e-03_r8,4.0574e-03_r8,3.6081e-03_r8,1.3068e-03_r8/) + kbo(:, 2,35, 4) = (/ & + &2.9602e-03_r8,5.0932e-03_r8,5.0438e-03_r8,4.3192e-03_r8,1.3565e-03_r8/) + kbo(:, 3,35, 4) = (/ & + &4.0769e-03_r8,6.5016e-03_r8,6.2270e-03_r8,5.1307e-03_r8,1.3990e-03_r8/) + kbo(:, 4,35, 4) = (/ & + &5.4354e-03_r8,8.1764e-03_r8,7.6137e-03_r8,6.0597e-03_r8,1.4343e-03_r8/) + kbo(:, 5,35, 4) = (/ & + &7.0821e-03_r8,1.0134e-02_r8,9.1905e-03_r8,7.1011e-03_r8,1.4630e-03_r8/) + kbo(:, 1,36, 4) = (/ & + &2.0103e-03_r8,3.6479e-03_r8,3.6691e-03_r8,3.1952e-03_r8,1.0729e-03_r8/) + kbo(:, 2,36, 4) = (/ & + &2.8662e-03_r8,4.7338e-03_r8,4.5904e-03_r8,3.8448e-03_r8,1.1132e-03_r8/) + kbo(:, 3,36, 4) = (/ & + &3.9368e-03_r8,6.0663e-03_r8,5.7008e-03_r8,4.5973e-03_r8,1.1487e-03_r8/) + kbo(:, 4,36, 4) = (/ & + &5.2410e-03_r8,7.6444e-03_r8,6.9919e-03_r8,5.4585e-03_r8,1.1779e-03_r8/) + kbo(:, 5,36, 4) = (/ & + &6.8204e-03_r8,9.5005e-03_r8,8.4610e-03_r8,6.4164e-03_r8,1.2022e-03_r8/) + kbo(:, 1,37, 4) = (/ & + &1.7959e-03_r8,3.1864e-03_r8,3.1663e-03_r8,2.7239e-03_r8,8.7469e-04_r8/) + kbo(:, 2,37, 4) = (/ & + &2.5697e-03_r8,4.1617e-03_r8,3.9876e-03_r8,3.2966e-03_r8,9.0931e-04_r8/) + kbo(:, 3,37, 4) = (/ & + &3.5391e-03_r8,5.3610e-03_r8,4.9818e-03_r8,3.9676e-03_r8,9.3897e-04_r8/) + kbo(:, 4,37, 4) = (/ & + &4.7240e-03_r8,6.7847e-03_r8,6.1364e-03_r8,4.7358e-03_r8,9.6399e-04_r8/) + kbo(:, 5,37, 4) = (/ & + &6.1586e-03_r8,8.4655e-03_r8,7.4564e-03_r8,5.5875e-03_r8,9.8533e-04_r8/) + kbo(:, 1,38, 4) = (/ & + &1.6221e-03_r8,2.8081e-03_r8,2.7522e-03_r8,2.3347e-03_r8,7.1314e-04_r8/) + kbo(:, 2,38, 4) = (/ & + &2.3291e-03_r8,3.6929e-03_r8,3.4899e-03_r8,2.8446e-03_r8,7.4249e-04_r8/) + kbo(:, 3,38, 4) = (/ & + &3.2190e-03_r8,4.7846e-03_r8,4.3892e-03_r8,3.4480e-03_r8,7.6765e-04_r8/) + kbo(:, 4,38, 4) = (/ & + &4.3100e-03_r8,6.0843e-03_r8,5.4322e-03_r8,4.1379e-03_r8,7.8970e-04_r8/) + kbo(:, 5,38, 4) = (/ & + &5.6295e-03_r8,7.6227e-03_r8,6.6325e-03_r8,4.9024e-03_r8,8.0762e-04_r8/) + kbo(:, 1,39, 4) = (/ & + &1.4985e-03_r8,2.5181e-03_r8,2.4272e-03_r8,2.0247e-03_r8,5.8188e-04_r8/) + kbo(:, 2,39, 4) = (/ & + &2.1580e-03_r8,3.3353e-03_r8,3.1025e-03_r8,2.4863e-03_r8,6.0647e-04_r8/) + kbo(:, 3,39, 4) = (/ & + &2.9946e-03_r8,4.3491e-03_r8,3.9298e-03_r8,3.0357e-03_r8,6.2817e-04_r8/) + kbo(:, 4,39, 4) = (/ & + &4.0211e-03_r8,5.5590e-03_r8,4.8918e-03_r8,3.6649e-03_r8,6.4668e-04_r8/) + kbo(:, 5,39, 4) = (/ & + &5.2642e-03_r8,6.9995e-03_r8,6.0040e-03_r8,4.3661e-03_r8,6.6239e-04_r8/) + kbo(:, 1,40, 4) = (/ & + &1.2480e-03_r8,2.0953e-03_r8,2.0102e-03_r8,1.6690e-03_r8,4.7210e-04_r8/) + kbo(:, 2,40, 4) = (/ & + &1.8115e-03_r8,2.7936e-03_r8,2.5861e-03_r8,2.0625e-03_r8,4.9296e-04_r8/) + kbo(:, 3,40, 4) = (/ & + &2.5332e-03_r8,3.6693e-03_r8,3.2977e-03_r8,2.5337e-03_r8,5.1142e-04_r8/) + kbo(:, 4,40, 4) = (/ & + &3.4226e-03_r8,4.7175e-03_r8,4.1297e-03_r8,3.0758e-03_r8,5.2719e-04_r8/) + kbo(:, 5,40, 4) = (/ & + &4.4988e-03_r8,5.9686e-03_r8,5.0929e-03_r8,3.6827e-03_r8,5.4108e-04_r8/) + kbo(:, 1,41, 4) = (/ & + &1.0279e-03_r8,1.7303e-03_r8,1.6546e-03_r8,1.3684e-03_r8,3.8259e-04_r8/) + kbo(:, 2,41, 4) = (/ & + &1.5100e-03_r8,2.3260e-03_r8,2.1442e-03_r8,1.7025e-03_r8,4.0029e-04_r8/) + kbo(:, 3,41, 4) = (/ & + &2.1257e-03_r8,3.0759e-03_r8,2.7514e-03_r8,2.1044e-03_r8,4.1598e-04_r8/) + kbo(:, 4,41, 4) = (/ & + &2.8920e-03_r8,3.9799e-03_r8,3.4670e-03_r8,2.5693e-03_r8,4.2980e-04_r8/) + kbo(:, 5,41, 4) = (/ & + &3.8245e-03_r8,5.0645e-03_r8,4.3009e-03_r8,3.0935e-03_r8,4.4154e-04_r8/) + kbo(:, 1,42, 4) = (/ & + &8.5248e-04_r8,1.4366e-03_r8,1.3681e-03_r8,1.1259e-03_r8,3.0986e-04_r8/) + kbo(:, 2,42, 4) = (/ & + &1.2693e-03_r8,1.9496e-03_r8,1.7879e-03_r8,1.4116e-03_r8,3.2494e-04_r8/) + kbo(:, 3,42, 4) = (/ & + &1.7992e-03_r8,2.5962e-03_r8,2.3093e-03_r8,1.7561e-03_r8,3.3826e-04_r8/) + kbo(:, 4,42, 4) = (/ & + &2.4657e-03_r8,3.3829e-03_r8,2.9302e-03_r8,2.1577e-03_r8,3.5033e-04_r8/) + kbo(:, 5,42, 4) = (/ & + &3.2835e-03_r8,4.3314e-03_r8,3.6581e-03_r8,2.6128e-03_r8,3.6051e-04_r8/) + kbo(:, 1,43, 4) = (/ & + &6.9299e-04_r8,1.1756e-03_r8,1.1172e-03_r8,9.1666e-04_r8,2.5008e-04_r8/) + kbo(:, 2,43, 4) = (/ & + &1.0504e-03_r8,1.6147e-03_r8,1.4746e-03_r8,1.1591e-03_r8,2.6296e-04_r8/) + kbo(:, 3,43, 4) = (/ & + &1.5042e-03_r8,2.1683e-03_r8,1.9190e-03_r8,1.4524e-03_r8,2.7439e-04_r8/) + kbo(:, 4,43, 4) = (/ & + &2.0819e-03_r8,2.8510e-03_r8,2.4566e-03_r8,1.7990e-03_r8,2.8482e-04_r8/) + kbo(:, 5,43, 4) = (/ & + &2.7959e-03_r8,3.6773e-03_r8,3.0899e-03_r8,2.1936e-03_r8,2.9376e-04_r8/) + kbo(:, 1,44, 4) = (/ & + &5.6092e-04_r8,9.5981e-04_r8,9.1038e-04_r8,7.4434e-04_r8,2.0138e-04_r8/) + kbo(:, 2,44, 4) = (/ & + &8.6869e-04_r8,1.3365e-03_r8,1.2153e-03_r8,9.5085e-04_r8,2.1240e-04_r8/) + kbo(:, 3,44, 4) = (/ & + &1.2605e-03_r8,1.8133e-03_r8,1.5968e-03_r8,1.2017e-03_r8,2.2220e-04_r8/) + kbo(:, 4,44, 4) = (/ & + &1.7639e-03_r8,2.4086e-03_r8,2.0630e-03_r8,1.5011e-03_r8,2.3130e-04_r8/) + kbo(:, 5,44, 4) = (/ & + &2.3892e-03_r8,3.1325e-03_r8,2.6172e-03_r8,1.8457e-03_r8,2.3904e-04_r8/) + kbo(:, 1,45, 4) = (/ & + &4.5956e-04_r8,7.9161e-04_r8,7.4840e-04_r8,6.0859e-04_r8,1.6203e-04_r8/) + kbo(:, 2,45, 4) = (/ & + &7.2822e-04_r8,1.1187e-03_r8,1.0117e-03_r8,7.8592e-04_r8,1.7142e-04_r8/) + kbo(:, 3,45, 4) = (/ & + &1.0767e-03_r8,1.5389e-03_r8,1.3458e-03_r8,1.0038e-03_r8,1.7986e-04_r8/) + kbo(:, 4,45, 4) = (/ & + &1.5195e-03_r8,2.0634e-03_r8,1.7544e-03_r8,1.2651e-03_r8,1.8773e-04_r8/) + kbo(:, 5,45, 4) = (/ & + &2.0790e-03_r8,2.7102e-03_r8,2.2473e-03_r8,1.5700e-03_r8,1.9451e-04_r8/) + kbo(:, 1,46, 4) = (/ & + &3.7292e-04_r8,6.4911e-04_r8,6.1209e-04_r8,4.9545e-04_r8,1.3008e-04_r8/) + kbo(:, 2,46, 4) = (/ & + &6.0673e-04_r8,9.3287e-04_r8,8.3976e-04_r8,6.4802e-04_r8,1.3811e-04_r8/) + kbo(:, 3,46, 4) = (/ & + &9.1635e-04_r8,1.3033e-03_r8,1.1323e-03_r8,8.3718e-04_r8,1.4541e-04_r8/) + kbo(:, 4,46, 4) = (/ & + &1.3083e-03_r8,1.7659e-03_r8,1.4916e-03_r8,1.0659e-03_r8,1.5214e-04_r8/) + kbo(:, 5,46, 4) = (/ & + &1.8099e-03_r8,2.3458e-03_r8,1.9309e-03_r8,1.3365e-03_r8,1.5810e-04_r8/) + kbo(:, 1,47, 4) = (/ & + &2.8950e-04_r8,5.1677e-04_r8,4.8802e-04_r8,3.9502e-04_r8,1.0398e-04_r8/) + kbo(:, 2,47, 4) = (/ & + &4.8670e-04_r8,7.5660e-04_r8,6.8049e-04_r8,5.2378e-04_r8,1.1085e-04_r8/) + kbo(:, 3,47, 4) = (/ & + &7.5525e-04_r8,1.0762e-03_r8,9.3123e-04_r8,6.8496e-04_r8,1.1715e-04_r8/) + kbo(:, 4,47, 4) = (/ & + &1.0969e-03_r8,1.4777e-03_r8,1.2426e-03_r8,8.8223e-04_r8,1.2295e-04_r8/) + kbo(:, 5,47, 4) = (/ & + &1.5354e-03_r8,1.9852e-03_r8,1.6256e-03_r8,1.1178e-03_r8,1.2805e-04_r8/) + kbo(:, 1,48, 4) = (/ & + &2.2732e-04_r8,4.1628e-04_r8,3.9316e-04_r8,3.1737e-04_r8,8.2969e-05_r8/) + kbo(:, 2,48, 4) = (/ & + &3.9696e-04_r8,6.2251e-04_r8,5.5852e-04_r8,4.2777e-04_r8,8.8908e-05_r8/) + kbo(:, 3,48, 4) = (/ & + &6.3462e-04_r8,9.0305e-04_r8,7.7729e-04_r8,5.6732e-04_r8,9.4308e-05_r8/) + kbo(:, 4,48, 4) = (/ & + &9.4204e-04_r8,1.2622e-03_r8,1.0539e-03_r8,7.4093e-04_r8,9.9236e-05_r8/) + kbo(:, 5,48, 4) = (/ & + &1.3331e-03_r8,1.7143e-03_r8,1.3938e-03_r8,9.4935e-04_r8,1.0368e-04_r8/) + kbo(:, 1,49, 4) = (/ & + &1.8300e-04_r8,3.4217e-04_r8,3.2264e-04_r8,2.5877e-04_r8,6.6118e-05_r8/) + kbo(:, 2,49, 4) = (/ & + &3.3312e-04_r8,5.2483e-04_r8,4.6829e-04_r8,3.5552e-04_r8,7.1194e-05_r8/) + kbo(:, 3,49, 4) = (/ & + &5.4973e-04_r8,7.7839e-04_r8,6.6473e-04_r8,4.7940e-04_r8,7.5813e-05_r8/) + kbo(:, 4,49, 4) = (/ & + &8.3663e-04_r8,1.1105e-03_r8,9.1800e-04_r8,6.3658e-04_r8,8.0100e-05_r8/) + kbo(:, 5,49, 4) = (/ & + &1.2004e-03_r8,1.5281e-03_r8,1.2307e-03_r8,8.2653e-04_r8,8.3935e-05_r8/) + kbo(:, 1,50, 4) = (/ & + &1.4039e-04_r8,2.7151e-04_r8,2.5713e-04_r8,2.0628e-04_r8,5.2648e-05_r8/) + kbo(:, 2,50, 4) = (/ & + &2.6610e-04_r8,4.2689e-04_r8,3.8091e-04_r8,2.8831e-04_r8,5.6961e-05_r8/) + kbo(:, 3,50, 4) = (/ & + &4.5427e-04_r8,6.4624e-04_r8,5.5025e-04_r8,3.9479e-04_r8,6.0907e-05_r8/) + kbo(:, 4,50, 4) = (/ & + &7.0950e-04_r8,9.4070e-04_r8,7.7361e-04_r8,5.3217e-04_r8,6.4571e-05_r8/) + kbo(:, 5,50, 4) = (/ & + &1.0374e-03_r8,1.3149e-03_r8,1.0530e-03_r8,7.0038e-04_r8,6.7890e-05_r8/) + kbo(:, 1,51, 4) = (/ & + &1.0489e-04_r8,2.1109e-04_r8,2.0141e-04_r8,1.6218e-04_r8,4.1878e-05_r8/) + kbo(:, 2,51, 4) = (/ & + &2.0633e-04_r8,3.4016e-04_r8,3.0444e-04_r8,2.3054e-04_r8,4.5538e-05_r8/) + kbo(:, 3,51, 4) = (/ & + &3.6536e-04_r8,5.2580e-04_r8,4.4746e-04_r8,3.2051e-04_r8,4.8874e-05_r8/) + kbo(:, 4,51, 4) = (/ & + &5.8696e-04_r8,7.8085e-04_r8,6.4023e-04_r8,4.3829e-04_r8,5.1997e-05_r8/) + kbo(:, 5,51, 4) = (/ & + &8.7556e-04_r8,1.1091e-03_r8,8.8460e-04_r8,5.8473e-04_r8,5.4858e-05_r8/) + kbo(:, 1,52, 4) = (/ & + &7.9793e-05_r8,1.6601e-04_r8,1.5918e-04_r8,1.2853e-04_r8,3.3276e-05_r8/) + kbo(:, 2,52, 4) = (/ & + &1.6247e-04_r8,2.7468e-04_r8,2.4631e-04_r8,1.8617e-04_r8,3.6357e-05_r8/) + kbo(:, 3,52, 4) = (/ & + &2.9905e-04_r8,4.3474e-04_r8,3.6924e-04_r8,2.6353e-04_r8,3.9196e-05_r8/) + kbo(:, 4,52, 4) = (/ & + &4.9530e-04_r8,6.5976e-04_r8,5.3847e-04_r8,3.6618e-04_r8,4.1839e-05_r8/) + kbo(:, 5,52, 4) = (/ & + &7.5546e-04_r8,9.5475e-04_r8,7.5721e-04_r8,4.9627e-04_r8,4.4317e-05_r8/) + kbo(:, 1,53, 4) = (/ & + &6.2729e-05_r8,1.3307e-04_r8,1.2792e-04_r8,1.0321e-04_r8,2.6401e-05_r8/) + kbo(:, 2,53, 4) = (/ & + &1.3138e-04_r8,2.2658e-04_r8,2.0324e-04_r8,1.5289e-04_r8,2.9006e-05_r8/) + kbo(:, 3,53, 4) = (/ & + &2.5160e-04_r8,3.6877e-04_r8,3.1205e-04_r8,2.2094e-04_r8,3.1410e-05_r8/) + kbo(:, 4,53, 4) = (/ & + &4.3128e-04_r8,5.7326e-04_r8,4.6479e-04_r8,3.1290e-04_r8,3.3663e-05_r8/) + kbo(:, 5,53, 4) = (/ & + &6.7436e-04_r8,8.4743e-04_r8,6.6688e-04_r8,4.3200e-04_r8,3.5790e-05_r8/) + kbo(:, 1,54, 4) = (/ & + &4.3536e-05_r8,9.6993e-05_r8,9.4650e-05_r8,7.7465e-05_r8,2.0921e-05_r8/) + kbo(:, 2,54, 4) = (/ & + &9.2752e-05_r8,1.6814e-04_r8,1.5268e-04_r8,1.1626e-04_r8,2.3103e-05_r8/) + kbo(:, 3,54, 4) = (/ & + &1.8378e-04_r8,2.7919e-04_r8,2.3835e-04_r8,1.7016e-04_r8,2.5121e-05_r8/) + kbo(:, 4,54, 4) = (/ & + &3.2645e-04_r8,4.4256e-04_r8,3.6033e-04_r8,2.4382e-04_r8,2.7012e-05_r8/) + kbo(:, 5,54, 4) = (/ & + &5.2349e-04_r8,6.6571e-04_r8,5.2497e-04_r8,3.4104e-04_r8,2.8788e-05_r8/) + kbo(:, 1,55, 4) = (/ & + &2.7968e-05_r8,6.6619e-05_r8,6.6506e-05_r8,5.5712e-05_r8,1.6550e-05_r8/) + kbo(:, 2,55, 4) = (/ & + &5.9858e-05_r8,1.1651e-04_r8,1.0803e-04_r8,8.4126e-05_r8,1.8363e-05_r8/) + kbo(:, 3,55, 4) = (/ & + &1.2216e-04_r8,1.9620e-04_r8,1.7047e-04_r8,1.2407e-04_r8,2.0057e-05_r8/) + kbo(:, 4,55, 4) = (/ & + &2.2490e-04_r8,3.1581e-04_r8,2.6032e-04_r8,1.7892e-04_r8,2.1634e-05_r8/) + kbo(:, 5,55, 4) = (/ & + &3.7032e-04_r8,4.8266e-04_r8,3.8398e-04_r8,2.5251e-04_r8,2.3108e-05_r8/) + kbo(:, 1,56, 4) = (/ & + &1.8187e-05_r8,4.5780e-05_r8,4.6700e-05_r8,4.0035e-05_r8,1.3073e-05_r8/) + kbo(:, 2,56, 4) = (/ & + &3.8391e-05_r8,8.0472e-05_r8,7.6243e-05_r8,6.0757e-05_r8,1.4582e-05_r8/) + kbo(:, 3,56, 4) = (/ & + &8.0424e-05_r8,1.3728e-04_r8,1.2154e-04_r8,9.0284e-05_r8,1.6006e-05_r8/) + kbo(:, 4,56, 4) = (/ & + &1.5350e-04_r8,2.2433e-04_r8,1.8750e-04_r8,1.3109e-04_r8,1.7305e-05_r8/) + kbo(:, 5,56, 4) = (/ & + &2.6031e-04_r8,3.4853e-04_r8,2.7994e-04_r8,1.8653e-04_r8,1.8526e-05_r8/) + kbo(:, 1,57, 4) = (/ & + &1.2069e-05_r8,3.1511e-05_r8,3.2815e-05_r8,2.8783e-05_r8,1.0310e-05_r8/) + kbo(:, 2,57, 4) = (/ & + &2.4551e-05_r8,5.5416e-05_r8,5.3688e-05_r8,4.3795e-05_r8,1.1563e-05_r8/) + kbo(:, 3,57, 4) = (/ & + &5.2372e-05_r8,9.5634e-05_r8,8.6379e-05_r8,6.5547e-05_r8,1.2748e-05_r8/) + kbo(:, 4,57, 4) = (/ & + &1.0355e-04_r8,1.5851e-04_r8,1.3458e-04_r8,9.5855e-05_r8,1.3838e-05_r8/) + kbo(:, 5,57, 4) = (/ & + &1.8156e-04_r8,2.5040e-04_r8,2.0330e-04_r8,1.3740e-04_r8,1.4854e-05_r8/) + kbo(:, 1,58, 4) = (/ & + &2.1923e-06_r8,7.1667e-06_r8,9.7990e-06_r8,1.2334e-05_r8,8.1331e-06_r8/) + kbo(:, 2,58, 4) = (/ & + &4.2014e-06_r8,1.2514e-05_r8,1.5980e-05_r8,1.8735e-05_r8,9.1661e-06_r8/) + kbo(:, 3,58, 4) = (/ & + &9.0349e-06_r8,2.1751e-05_r8,2.5847e-05_r8,2.8162e-05_r8,1.0154e-05_r8/) + kbo(:, 4,58, 4) = (/ & + &1.8408e-05_r8,3.6461e-05_r8,4.0575e-05_r8,4.1376e-05_r8,1.1069e-05_r8/) + kbo(:, 5,58, 4) = (/ & + &3.3398e-05_r8,5.8421e-05_r8,6.1871e-05_r8,5.9629e-05_r8,1.1910e-05_r8/) + kbo(:, 1,59, 4) = (/ & + &1.9895e-06_r8,7.0146e-06_r8,9.2666e-06_r8,1.0819e-05_r8,6.5530e-06_r8/) + kbo(:, 2,59, 4) = (/ & + &3.7103e-06_r8,1.1985e-05_r8,1.4798e-05_r8,1.6119e-05_r8,7.3922e-06_r8/) + kbo(:, 3,59, 4) = (/ & + &7.9795e-06_r8,2.0481e-05_r8,2.3504e-05_r8,2.3808e-05_r8,8.1931e-06_r8/) + kbo(:, 4,59, 4) = (/ & + &1.6446e-05_r8,3.3891e-05_r8,3.6329e-05_r8,3.4426e-05_r8,8.9453e-06_r8/) + kbo(:, 5,59, 4) = (/ & + &3.0202e-05_r8,5.3874e-05_r8,5.4799e-05_r8,4.8960e-05_r8,9.6374e-06_r8/) + kbo(:, 1,13, 5) = (/ & + &4.3236e-01_r8,4.3213e-01_r8,3.9701e-01_r8,3.2546e-01_r8,1.1197e-01_r8/) + kbo(:, 2,13, 5) = (/ & + &6.6372e-01_r8,6.1379e-01_r8,5.3578e-01_r8,4.1378e-01_r8,1.1749e-01_r8/) + kbo(:, 3,13, 5) = (/ & + &9.6012e-01_r8,8.4543e-01_r8,7.0690e-01_r8,5.2039e-01_r8,1.2229e-01_r8/) + kbo(:, 4,13, 5) = (/ & + &1.3340e+00_r8,1.1343e+00_r8,9.1491e-01_r8,6.4651e-01_r8,1.2717e-01_r8/) + kbo(:, 5,13, 5) = (/ & + &1.8059e+00_r8,1.4945e+00_r8,1.1687e+00_r8,7.9501e-01_r8,1.3200e-01_r8/) + kbo(:, 1,14, 5) = (/ & + &2.3576e-01_r8,2.7360e-01_r8,2.7141e-01_r8,2.4039e-01_r8,9.8792e-02_r8/) + kbo(:, 2,14, 5) = (/ & + &3.5903e-01_r8,3.7743e-01_r8,3.5638e-01_r8,2.9754e-01_r8,1.0359e-01_r8/) + kbo(:, 3,14, 5) = (/ & + &5.1761e-01_r8,5.0746e-01_r8,4.5981e-01_r8,3.6575e-01_r8,1.0816e-01_r8/) + kbo(:, 4,14, 5) = (/ & + &7.1963e-01_r8,6.6997e-01_r8,5.8434e-01_r8,4.4555e-01_r8,1.1272e-01_r8/) + kbo(:, 5,14, 5) = (/ & + &9.7673e-01_r8,8.7084e-01_r8,7.3356e-01_r8,5.3881e-01_r8,1.1732e-01_r8/) + kbo(:, 1,15, 5) = (/ & + &1.3110e-01_r8,1.8103e-01_r8,1.9281e-01_r8,1.8264e-01_r8,8.6582e-02_r8/) + kbo(:, 2,15, 5) = (/ & + &1.9817e-01_r8,2.4413e-01_r8,2.4684e-01_r8,2.2172e-01_r8,9.0925e-02_r8/) + kbo(:, 3,15, 5) = (/ & + &2.8519e-01_r8,3.2198e-01_r8,3.1178e-01_r8,2.6742e-01_r8,9.5231e-02_r8/) + kbo(:, 4,15, 5) = (/ & + &3.9693e-01_r8,4.1797e-01_r8,3.8987e-01_r8,3.1982e-01_r8,9.9470e-02_r8/) + kbo(:, 5,15, 5) = (/ & + &5.3979e-01_r8,5.3546e-01_r8,4.8283e-01_r8,3.8058e-01_r8,1.0367e-01_r8/) + kbo(:, 1,16, 5) = (/ & + &8.6780e-02_r8,1.3641e-01_r8,1.5186e-01_r8,1.4818e-01_r8,7.5514e-02_r8/) + kbo(:, 2,16, 5) = (/ & + &1.3047e-01_r8,1.8113e-01_r8,1.9135e-01_r8,1.7835e-01_r8,7.9533e-02_r8/) + kbo(:, 3,16, 5) = (/ & + &1.8753e-01_r8,2.3639e-01_r8,2.3875e-01_r8,2.1304e-01_r8,8.3481e-02_r8/) + kbo(:, 4,16, 5) = (/ & + &2.6140e-01_r8,3.0428e-01_r8,2.9551e-01_r8,2.5256e-01_r8,8.7293e-02_r8/) + kbo(:, 5,16, 5) = (/ & + &3.5574e-01_r8,3.8652e-01_r8,3.6267e-01_r8,2.9793e-01_r8,9.1094e-02_r8/) + kbo(:, 1,17, 5) = (/ & + &5.9400e-02_r8,1.0544e-01_r8,1.2175e-01_r8,1.2140e-01_r8,6.5571e-02_r8/) + kbo(:, 2,17, 5) = (/ & + &8.8982e-02_r8,1.3824e-01_r8,1.5175e-01_r8,1.4491e-01_r8,6.9197e-02_r8/) + kbo(:, 3,17, 5) = (/ & + &1.2788e-01_r8,1.7890e-01_r8,1.8755e-01_r8,1.7185e-01_r8,7.2708e-02_r8/) + kbo(:, 4,17, 5) = (/ & + &1.7835e-01_r8,2.2856e-01_r8,2.3024e-01_r8,2.0241e-01_r8,7.6161e-02_r8/) + kbo(:, 5,17, 5) = (/ & + &2.4297e-01_r8,2.8834e-01_r8,2.8043e-01_r8,2.3722e-01_r8,7.9603e-02_r8/) + kbo(:, 1,18, 5) = (/ & + &4.1651e-02_r8,8.2911e-02_r8,9.8455e-02_r8,9.9593e-02_r8,5.6662e-02_r8/) + kbo(:, 2,18, 5) = (/ & + &6.2251e-02_r8,1.0765e-01_r8,1.2173e-01_r8,1.1843e-01_r8,5.9831e-02_r8/) + kbo(:, 3,18, 5) = (/ & + &8.9419e-02_r8,1.3828e-01_r8,1.4944e-01_r8,1.3970e-01_r8,6.2923e-02_r8/) + kbo(:, 4,18, 5) = (/ & + &1.2470e-01_r8,1.7541e-01_r8,1.8216e-01_r8,1.6372e-01_r8,6.6077e-02_r8/) + kbo(:, 5,18, 5) = (/ & + &1.6992e-01_r8,2.1986e-01_r8,2.2047e-01_r8,1.9095e-01_r8,6.9212e-02_r8/) + kbo(:, 1,19, 5) = (/ & + &2.8717e-02_r8,6.4742e-02_r8,7.8819e-02_r8,8.0895e-02_r8,4.8664e-02_r8/) + kbo(:, 2,19, 5) = (/ & + &4.2849e-02_r8,8.3244e-02_r8,9.6815e-02_r8,9.5751e-02_r8,5.1433e-02_r8/) + kbo(:, 3,19, 5) = (/ & + &6.1454e-02_r8,1.0605e-01_r8,1.1801e-01_r8,1.1248e-01_r8,5.4215e-02_r8/) + kbo(:, 4,19, 5) = (/ & + &8.5699e-02_r8,1.3356e-01_r8,1.4292e-01_r8,1.3115e-01_r8,5.7031e-02_r8/) + kbo(:, 5,19, 5) = (/ & + &1.1681e-01_r8,1.6622e-01_r8,1.7182e-01_r8,1.5204e-01_r8,5.9790e-02_r8/) + kbo(:, 1,20, 5) = (/ & + &2.1632e-02_r8,5.2943e-02_r8,6.5235e-02_r8,6.7363e-02_r8,4.1610e-02_r8/) + kbo(:, 2,20, 5) = (/ & + &3.2163e-02_r8,6.7696e-02_r8,7.9852e-02_r8,7.9447e-02_r8,4.4062e-02_r8/) + kbo(:, 3,20, 5) = (/ & + &4.6057e-02_r8,8.5815e-02_r8,9.6980e-02_r8,9.3049e-02_r8,4.6553e-02_r8/) + kbo(:, 4,20, 5) = (/ & + &6.4136e-02_r8,1.0754e-01_r8,1.1694e-01_r8,1.0820e-01_r8,4.9013e-02_r8/) + kbo(:, 5,20, 5) = (/ & + &8.7379e-02_r8,1.3322e-01_r8,1.3995e-01_r8,1.2502e-01_r8,5.1455e-02_r8/) + kbo(:, 1,21, 5) = (/ & + &1.6823e-02_r8,4.3877e-02_r8,5.4527e-02_r8,5.6402e-02_r8,3.5455e-02_r8/) + kbo(:, 2,21, 5) = (/ & + &2.4936e-02_r8,5.5953e-02_r8,6.6511e-02_r8,6.6307e-02_r8,3.7602e-02_r8/) + kbo(:, 3,21, 5) = (/ & + &3.5634e-02_r8,7.0642e-02_r8,8.0513e-02_r8,7.7454e-02_r8,3.9786e-02_r8/) + kbo(:, 4,21, 5) = (/ & + &4.9531e-02_r8,8.8177e-02_r8,9.6745e-02_r8,8.9935e-02_r8,4.1920e-02_r8/) + kbo(:, 5,21, 5) = (/ & + &6.7455e-02_r8,1.0884e-01_r8,1.1539e-01_r8,1.0375e-01_r8,4.4030e-02_r8/) + kbo(:, 1,22, 5) = (/ & + &1.3789e-02_r8,3.7331e-02_r8,4.6413e-02_r8,4.7878e-02_r8,3.0220e-02_r8/) + kbo(:, 2,22, 5) = (/ & + &2.0294e-02_r8,4.7459e-02_r8,5.6444e-02_r8,5.6212e-02_r8,3.2091e-02_r8/) + kbo(:, 3,22, 5) = (/ & + &2.8887e-02_r8,5.9685e-02_r8,6.8142e-02_r8,6.5522e-02_r8,3.3949e-02_r8/) + kbo(:, 4,22, 5) = (/ & + &4.0024e-02_r8,7.4193e-02_r8,8.1621e-02_r8,7.5940e-02_r8,3.5793e-02_r8/) + kbo(:, 5,22, 5) = (/ & + &5.4487e-02_r8,9.1298e-02_r8,9.7079e-02_r8,8.7446e-02_r8,3.7515e-02_r8/) + kbo(:, 1,23, 5) = (/ & + &1.1373e-02_r8,3.1797e-02_r8,3.9445e-02_r8,4.0631e-02_r8,2.5676e-02_r8/) + kbo(:, 2,23, 5) = (/ & + &1.6630e-02_r8,4.0276e-02_r8,4.7874e-02_r8,4.7621e-02_r8,2.7276e-02_r8/) + kbo(:, 3,23, 5) = (/ & + &2.3572e-02_r8,5.0445e-02_r8,5.7632e-02_r8,5.5405e-02_r8,2.8857e-02_r8/) + kbo(:, 4,23, 5) = (/ & + &3.2590e-02_r8,6.2506e-02_r8,6.8883e-02_r8,6.4105e-02_r8,3.0360e-02_r8/) + kbo(:, 5,23, 5) = (/ & + &4.4383e-02_r8,7.6716e-02_r8,8.1703e-02_r8,7.3646e-02_r8,3.1632e-02_r8/) + kbo(:, 1,24, 5) = (/ & + &9.3521e-03_r8,2.6988e-02_r8,3.3405e-02_r8,3.4382e-02_r8,2.1758e-02_r8/) + kbo(:, 2,24, 5) = (/ & + &1.3592e-02_r8,3.4040e-02_r8,4.0452e-02_r8,4.0217e-02_r8,2.3106e-02_r8/) + kbo(:, 3,24, 5) = (/ & + &1.9190e-02_r8,4.2486e-02_r8,4.8570e-02_r8,4.6701e-02_r8,2.4399e-02_r8/) + kbo(:, 4,24, 5) = (/ & + &2.6527e-02_r8,5.2454e-02_r8,5.7886e-02_r8,5.3878e-02_r8,2.5528e-02_r8/) + kbo(:, 5,24, 5) = (/ & + &3.6127e-02_r8,6.4240e-02_r8,6.8480e-02_r8,6.1740e-02_r8,2.6418e-02_r8/) + kbo(:, 1,25, 5) = (/ & + &7.8143e-03_r8,2.3046e-02_r8,2.8423e-02_r8,2.9180e-02_r8,1.8391e-02_r8/) + kbo(:, 2,25, 5) = (/ & + &1.1292e-02_r8,2.8965e-02_r8,3.4350e-02_r8,3.4059e-02_r8,1.9498e-02_r8/) + kbo(:, 3,25, 5) = (/ & + &1.5906e-02_r8,3.6033e-02_r8,4.1158e-02_r8,3.9460e-02_r8,2.0484e-02_r8/) + kbo(:, 4,25, 5) = (/ & + &2.2015e-02_r8,4.4387e-02_r8,4.8915e-02_r8,4.5425e-02_r8,2.1291e-02_r8/) + kbo(:, 5,25, 5) = (/ & + &2.9929e-02_r8,5.4292e-02_r8,5.7748e-02_r8,5.1892e-02_r8,2.1939e-02_r8/) + kbo(:, 1,26, 5) = (/ & + &6.6841e-03_r8,1.9882e-02_r8,2.4386e-02_r8,2.4902e-02_r8,1.5507e-02_r8/) + kbo(:, 2,26, 5) = (/ & + &9.6187e-03_r8,2.4917e-02_r8,2.9404e-02_r8,2.8998e-02_r8,1.6368e-02_r8/) + kbo(:, 3,26, 5) = (/ & + &1.3541e-02_r8,3.0916e-02_r8,3.5147e-02_r8,3.3522e-02_r8,1.7088e-02_r8/) + kbo(:, 4,26, 5) = (/ & + &1.8734e-02_r8,3.8045e-02_r8,4.1676e-02_r8,3.8461e-02_r8,1.7679e-02_r8/) + kbo(:, 5,26, 5) = (/ & + &2.5382e-02_r8,4.6534e-02_r8,4.9183e-02_r8,4.3795e-02_r8,1.8164e-02_r8/) + kbo(:, 1,27, 5) = (/ & + &5.9464e-03_r8,1.7461e-02_r8,2.1207e-02_r8,2.1457e-02_r8,1.3019e-02_r8/) + kbo(:, 2,27, 5) = (/ & + &8.5411e-03_r8,2.1855e-02_r8,2.5534e-02_r8,2.4945e-02_r8,1.3658e-02_r8/) + kbo(:, 3,27, 5) = (/ & + &1.2012e-02_r8,2.7098e-02_r8,3.0472e-02_r8,2.8773e-02_r8,1.4192e-02_r8/) + kbo(:, 4,27, 5) = (/ & + &1.6580e-02_r8,3.3382e-02_r8,3.6146e-02_r8,3.2904e-02_r8,1.4638e-02_r8/) + kbo(:, 5,27, 5) = (/ & + &2.2392e-02_r8,4.0890e-02_r8,4.2671e-02_r8,3.7399e-02_r8,1.5005e-02_r8/) + kbo(:, 1,28, 5) = (/ & + &5.4489e-03_r8,1.5531e-02_r8,1.8614e-02_r8,1.8613e-02_r8,1.0873e-02_r8/) + kbo(:, 2,28, 5) = (/ & + &7.8148e-03_r8,1.9440e-02_r8,2.2401e-02_r8,2.1604e-02_r8,1.1349e-02_r8/) + kbo(:, 3,28, 5) = (/ & + &1.0969e-02_r8,2.4138e-02_r8,2.6729e-02_r8,2.4848e-02_r8,1.1757e-02_r8/) + kbo(:, 4,28, 5) = (/ & + &1.5087e-02_r8,2.9815e-02_r8,3.1728e-02_r8,2.8368e-02_r8,1.2101e-02_r8/) + kbo(:, 5,28, 5) = (/ & + &2.0299e-02_r8,3.6555e-02_r8,3.7502e-02_r8,3.2280e-02_r8,1.2378e-02_r8/) + kbo(:, 1,29, 5) = (/ & + &5.3270e-03_r8,1.4285e-02_r8,1.6775e-02_r8,1.6453e-02_r8,9.0474e-03_r8/) + kbo(:, 2,29, 5) = (/ & + &7.6276e-03_r8,1.7927e-02_r8,2.0207e-02_r8,1.9083e-02_r8,9.4132e-03_r8/) + kbo(:, 3,29, 5) = (/ & + &1.0673e-02_r8,2.2373e-02_r8,2.4172e-02_r8,2.1940e-02_r8,9.7284e-03_r8/) + kbo(:, 4,29, 5) = (/ & + &1.4614e-02_r8,2.7730e-02_r8,2.8795e-02_r8,2.5116e-02_r8,9.9926e-03_r8/) + kbo(:, 5,29, 5) = (/ & + &1.9579e-02_r8,3.4081e-02_r8,3.4110e-02_r8,2.8684e-02_r8,1.0207e-02_r8/) + kbo(:, 1,30, 5) = (/ & + &5.3535e-03_r8,1.3353e-02_r8,1.5300e-02_r8,1.4666e-02_r8,7.5129e-03_r8/) + kbo(:, 2,30, 5) = (/ & + &7.6380e-03_r8,1.6853e-02_r8,1.8473e-02_r8,1.7010e-02_r8,7.7968e-03_r8/) + kbo(:, 3,30, 5) = (/ & + &1.0647e-02_r8,2.1132e-02_r8,2.2202e-02_r8,1.9612e-02_r8,8.0434e-03_r8/) + kbo(:, 4,30, 5) = (/ & + &1.4510e-02_r8,2.6289e-02_r8,2.6550e-02_r8,2.2553e-02_r8,8.2450e-03_r8/) + kbo(:, 5,30, 5) = (/ & + &1.9367e-02_r8,3.2371e-02_r8,3.1546e-02_r8,2.5868e-02_r8,8.4082e-03_r8/) + kbo(:, 1,31, 5) = (/ & + &5.6746e-03_r8,1.2936e-02_r8,1.4343e-02_r8,1.3343e-02_r8,6.2303e-03_r8/) + kbo(:, 2,31, 5) = (/ & + &8.0577e-03_r8,1.6447e-02_r8,1.7425e-02_r8,1.5532e-02_r8,6.4556e-03_r8/) + kbo(:, 3,31, 5) = (/ & + &1.1174e-02_r8,2.0739e-02_r8,2.1078e-02_r8,1.8020e-02_r8,6.6441e-03_r8/) + kbo(:, 4,31, 5) = (/ & + &1.5165e-02_r8,2.5916e-02_r8,2.5346e-02_r8,2.0861e-02_r8,6.8034e-03_r8/) + kbo(:, 5,31, 5) = (/ & + &2.0188e-02_r8,3.1999e-02_r8,3.0259e-02_r8,2.4055e-02_r8,6.9268e-03_r8/) + kbo(:, 1,32, 5) = (/ & + &6.0895e-03_r8,1.2732e-02_r8,1.3622e-02_r8,1.2258e-02_r8,5.1656e-03_r8/) + kbo(:, 2,32, 5) = (/ & + &8.5996e-03_r8,1.6298e-02_r8,1.6681e-02_r8,1.4366e-02_r8,5.3392e-03_r8/) + kbo(:, 3,32, 5) = (/ & + &1.1871e-02_r8,2.0666e-02_r8,2.0302e-02_r8,1.6787e-02_r8,5.4899e-03_r8/) + kbo(:, 4,32, 5) = (/ & + &1.6059e-02_r8,2.5901e-02_r8,2.4547e-02_r8,1.9547e-02_r8,5.6119e-03_r8/) + kbo(:, 5,32, 5) = (/ & + &2.1313e-02_r8,3.2082e-02_r8,2.9454e-02_r8,2.2664e-02_r8,5.7070e-03_r8/) + kbo(:, 1,33, 5) = (/ & + &6.6515e-03_r8,1.2796e-02_r8,1.3188e-02_r8,1.1442e-02_r8,4.2781e-03_r8/) + kbo(:, 2,33, 5) = (/ & + &9.3384e-03_r8,1.6485e-02_r8,1.6266e-02_r8,1.3517e-02_r8,4.4167e-03_r8/) + kbo(:, 3,33, 5) = (/ & + &1.2846e-02_r8,2.0999e-02_r8,1.9943e-02_r8,1.5910e-02_r8,4.5341e-03_r8/) + kbo(:, 4,33, 5) = (/ & + &1.7327e-02_r8,2.6399e-02_r8,2.4247e-02_r8,1.8651e-02_r8,4.6303e-03_r8/) + kbo(:, 5,33, 5) = (/ & + &2.2895e-02_r8,3.2829e-02_r8,2.9267e-02_r8,2.1750e-02_r8,4.7019e-03_r8/) + kbo(:, 1,34, 5) = (/ & + &6.9862e-03_r8,1.2631e-02_r8,1.2600e-02_r8,1.0591e-02_r8,3.5376e-03_r8/) + kbo(:, 2,34, 5) = (/ & + &9.7726e-03_r8,1.6353e-02_r8,1.5653e-02_r8,1.2600e-02_r8,3.6473e-03_r8/) + kbo(:, 3,34, 5) = (/ & + &1.3409e-02_r8,2.0887e-02_r8,1.9295e-02_r8,1.4929e-02_r8,3.7406e-03_r8/) + kbo(:, 4,34, 5) = (/ & + &1.8037e-02_r8,2.6346e-02_r8,2.3581e-02_r8,1.7591e-02_r8,3.8148e-03_r8/) + kbo(:, 5,34, 5) = (/ & + &2.3704e-02_r8,3.2885e-02_r8,2.8616e-02_r8,2.0638e-02_r8,3.8707e-03_r8/) + kbo(:, 1,35, 5) = (/ & + &7.0977e-03_r8,1.2235e-02_r8,1.1878e-02_r8,9.7122e-03_r8,2.9156e-03_r8/) + kbo(:, 2,35, 5) = (/ & + &9.9249e-03_r8,1.5915e-02_r8,1.4862e-02_r8,1.1642e-02_r8,3.0042e-03_r8/) + kbo(:, 3,35, 5) = (/ & + &1.3615e-02_r8,2.0413e-02_r8,1.8425e-02_r8,1.3882e-02_r8,3.0791e-03_r8/) + kbo(:, 4,35, 5) = (/ & + &1.8271e-02_r8,2.5881e-02_r8,2.2655e-02_r8,1.6461e-02_r8,3.1387e-03_r8/) + kbo(:, 5,35, 5) = (/ & + &2.3900e-02_r8,3.2414e-02_r8,2.7651e-02_r8,1.9450e-02_r8,3.1837e-03_r8/) + kbo(:, 1,36, 5) = (/ & + &6.9060e-03_r8,1.1498e-02_r8,1.0932e-02_r8,8.7493e-03_r8,2.3952e-03_r8/) + kbo(:, 2,36, 5) = (/ & + &9.6735e-03_r8,1.5042e-02_r8,1.3779e-02_r8,1.0573e-02_r8,2.4672e-03_r8/) + kbo(:, 3,36, 5) = (/ & + &1.3291e-02_r8,1.9415e-02_r8,1.7205e-02_r8,1.2691e-02_r8,2.5290e-03_r8/) + kbo(:, 4,36, 5) = (/ & + &1.7820e-02_r8,2.4753e-02_r8,2.1299e-02_r8,1.5151e-02_r8,2.5791e-03_r8/) + kbo(:, 5,36, 5) = (/ & + &2.3253e-02_r8,3.1113e-02_r8,2.6141e-02_r8,1.8030e-02_r8,2.6175e-03_r8/) + kbo(:, 1,37, 5) = (/ & + &6.2139e-03_r8,1.0192e-02_r8,9.5802e-03_r8,7.5798e-03_r8,1.9567e-03_r8/) + kbo(:, 2,37, 5) = (/ & + &8.7456e-03_r8,1.3428e-02_r8,1.2164e-02_r8,9.2244e-03_r8,2.0181e-03_r8/) + kbo(:, 3,37, 5) = (/ & + &1.2068e-02_r8,1.7456e-02_r8,1.5302e-02_r8,1.1147e-02_r8,2.0706e-03_r8/) + kbo(:, 4,37, 5) = (/ & + &1.6229e-02_r8,2.2411e-02_r8,1.9089e-02_r8,1.3408e-02_r8,2.1134e-03_r8/) + kbo(:, 5,37, 5) = (/ & + &2.1208e-02_r8,2.8314e-02_r8,2.3560e-02_r8,1.6063e-02_r8,2.1467e-03_r8/) + kbo(:, 1,38, 5) = (/ & + &5.6546e-03_r8,9.1081e-03_r8,8.4597e-03_r8,6.6101e-03_r8,1.5995e-03_r8/) + kbo(:, 2,38, 5) = (/ & + &7.9966e-03_r8,1.2093e-02_r8,1.0832e-02_r8,8.1085e-03_r8,1.6506e-03_r8/) + kbo(:, 3,38, 5) = (/ & + &1.1084e-02_r8,1.5851e-02_r8,1.3740e-02_r8,9.8767e-03_r8,1.6948e-03_r8/) + kbo(:, 4,38, 5) = (/ & + &1.4944e-02_r8,2.0494e-02_r8,1.7272e-02_r8,1.1975e-02_r8,1.7322e-03_r8/) + kbo(:, 5,38, 5) = (/ & + &1.9571e-02_r8,2.6031e-02_r8,2.1445e-02_r8,1.4447e-02_r8,1.7614e-03_r8/) + kbo(:, 1,39, 5) = (/ & + &5.2606e-03_r8,8.2861e-03_r8,7.5918e-03_r8,5.8448e-03_r8,1.3077e-03_r8/) + kbo(:, 2,39, 5) = (/ & + &7.4758e-03_r8,1.1098e-02_r8,9.8108e-03_r8,7.2343e-03_r8,1.3505e-03_r8/) + kbo(:, 3,39, 5) = (/ & + &1.0407e-02_r8,1.4668e-02_r8,1.2553e-02_r8,8.8880e-03_r8,1.3888e-03_r8/) + kbo(:, 4,39, 5) = (/ & + &1.4072e-02_r8,1.9102e-02_r8,1.5911e-02_r8,1.0872e-02_r8,1.4211e-03_r8/) + kbo(:, 5,39, 5) = (/ & + &1.8472e-02_r8,2.4391e-02_r8,1.9883e-02_r8,1.3211e-02_r8,1.4470e-03_r8/) + kbo(:, 1,40, 5) = (/ & + &4.4239e-03_r8,6.9683e-03_r8,6.3619e-03_r8,4.8825e-03_r8,1.0643e-03_r8/) + kbo(:, 2,40, 5) = (/ & + &6.3289e-03_r8,9.4143e-03_r8,8.2870e-03_r8,6.0882e-03_r8,1.1007e-03_r8/) + kbo(:, 3,40, 5) = (/ & + &8.8723e-03_r8,1.2550e-02_r8,1.0689e-02_r8,7.5344e-03_r8,1.1340e-03_r8/) + kbo(:, 4,40, 5) = (/ & + &1.2075e-02_r8,1.6469e-02_r8,1.3655e-02_r8,9.2842e-03_r8,1.1620e-03_r8/) + kbo(:, 5,40, 5) = (/ & + &1.5933e-02_r8,2.1174e-02_r8,1.7180e-02_r8,1.1354e-02_r8,1.1848e-03_r8/) + kbo(:, 1,41, 5) = (/ & + &3.6867e-03_r8,5.8128e-03_r8,5.2949e-03_r8,4.0553e-03_r8,8.6561e-04_r8/) + kbo(:, 2,41, 5) = (/ & + &5.3143e-03_r8,7.9271e-03_r8,6.9551e-03_r8,5.0947e-03_r8,8.9710e-04_r8/) + kbo(:, 3,41, 5) = (/ & + &7.5044e-03_r8,1.0658e-02_r8,9.0449e-03_r8,6.3522e-03_r8,9.2517e-04_r8/) + kbo(:, 4,41, 5) = (/ & + &1.0281e-02_r8,1.4099e-02_r8,1.1643e-02_r8,7.8856e-03_r8,9.4938e-04_r8/) + kbo(:, 5,41, 5) = (/ & + &1.3649e-02_r8,1.8248e-02_r8,1.4748e-02_r8,9.7057e-03_r8,9.6963e-04_r8/) + kbo(:, 1,42, 5) = (/ & + &3.0985e-03_r8,4.8781e-03_r8,4.4299e-03_r8,3.3820e-03_r8,7.0400e-04_r8/) + kbo(:, 2,42, 5) = (/ & + &4.5009e-03_r8,6.7165e-03_r8,5.8698e-03_r8,4.2829e-03_r8,7.3071e-04_r8/) + kbo(:, 3,42, 5) = (/ & + &6.4001e-03_r8,9.1103e-03_r8,7.7007e-03_r8,5.3843e-03_r8,7.5479e-04_r8/) + kbo(:, 4,42, 5) = (/ & + &8.8324e-03_r8,1.2154e-02_r8,9.9941e-03_r8,6.7362e-03_r8,7.7572e-04_r8/) + kbo(:, 5,42, 5) = (/ & + &1.1799e-02_r8,1.5850e-02_r8,1.2750e-02_r8,8.3487e-03_r8,7.9315e-04_r8/) + kbo(:, 1,43, 5) = (/ & + &2.5629e-03_r8,4.0329e-03_r8,3.6588e-03_r8,2.7901e-03_r8,5.7114e-04_r8/) + kbo(:, 2,43, 5) = (/ & + &3.7578e-03_r8,5.6142e-03_r8,4.8977e-03_r8,3.5662e-03_r8,5.9379e-04_r8/) + kbo(:, 3,43, 5) = (/ & + &5.3881e-03_r8,7.6915e-03_r8,6.4844e-03_r8,4.5229e-03_r8,6.1455e-04_r8/) + kbo(:, 4,43, 5) = (/ & + &7.5091e-03_r8,1.0367e-02_r8,8.4990e-03_r8,5.7086e-03_r8,6.3259e-04_r8/) + kbo(:, 5,43, 5) = (/ & + &1.0110e-02_r8,1.3645e-02_r8,1.0937e-02_r8,7.1314e-03_r8,6.4809e-04_r8/) + kbo(:, 1,44, 5) = (/ & + &2.1195e-03_r8,3.3263e-03_r8,3.0153e-03_r8,2.2974e-03_r8,4.6259e-04_r8/) + kbo(:, 2,44, 5) = (/ & + &3.1405e-03_r8,4.6890e-03_r8,4.0834e-03_r8,2.9671e-03_r8,4.8211e-04_r8/) + kbo(:, 3,44, 5) = (/ & + &4.5449e-03_r8,6.4956e-03_r8,5.4625e-03_r8,3.8015e-03_r8,4.9986e-04_r8/) + kbo(:, 4,44, 5) = (/ & + &6.4001e-03_r8,8.8502e-03_r8,7.2321e-03_r8,4.8421e-03_r8,5.1551e-04_r8/) + kbo(:, 5,44, 5) = (/ & + &8.6977e-03_r8,1.1779e-02_r8,9.4064e-03_r8,6.1062e-03_r8,5.2910e-04_r8/) + kbo(:, 1,45, 5) = (/ & + &1.7814e-03_r8,2.7759e-03_r8,2.5092e-03_r8,1.9068e-03_r8,3.7475e-04_r8/) + kbo(:, 2,45, 5) = (/ & + &2.6678e-03_r8,3.9635e-03_r8,3.4407e-03_r8,2.4906e-03_r8,3.9120e-04_r8/) + kbo(:, 3,45, 5) = (/ & + &3.8999e-03_r8,5.5595e-03_r8,4.6558e-03_r8,3.2267e-03_r8,4.0640e-04_r8/) + kbo(:, 4,45, 5) = (/ & + &5.5475e-03_r8,7.6646e-03_r8,6.2331e-03_r8,4.1536e-03_r8,4.1988e-04_r8/) + kbo(:, 5,45, 5) = (/ & + &7.6146e-03_r8,1.0314e-02_r8,8.1967e-03_r8,5.2910e-03_r8,4.3189e-04_r8/) + kbo(:, 1,46, 5) = (/ & + &1.4913e-03_r8,2.3049e-03_r8,2.0781e-03_r8,1.5752e-03_r8,3.0303e-04_r8/) + kbo(:, 2,46, 5) = (/ & + &2.2619e-03_r8,3.3394e-03_r8,2.8896e-03_r8,2.0839e-03_r8,3.1705e-04_r8/) + kbo(:, 3,46, 5) = (/ & + &3.3424e-03_r8,4.7455e-03_r8,3.9592e-03_r8,2.7324e-03_r8,3.2997e-04_r8/) + kbo(:, 4,46, 5) = (/ & + &4.8041e-03_r8,6.6271e-03_r8,5.3667e-03_r8,3.5579e-03_r8,3.4174e-04_r8/) + kbo(:, 5,46, 5) = (/ & + &6.6700e-03_r8,9.0306e-03_r8,7.1468e-03_r8,4.5847e-03_r8,3.5220e-04_r8/) + kbo(:, 1,47, 5) = (/ & + &1.2089e-03_r8,1.8595e-03_r8,1.6774e-03_r8,1.2733e-03_r8,2.4435e-04_r8/) + kbo(:, 2,47, 5) = (/ & + &1.8589e-03_r8,2.7359e-03_r8,2.3669e-03_r8,1.7064e-03_r8,2.5622e-04_r8/) + kbo(:, 3,47, 5) = (/ & + &2.7805e-03_r8,3.9417e-03_r8,3.2867e-03_r8,2.2649e-03_r8,2.6731e-04_r8/) + kbo(:, 4,47, 5) = (/ & + &4.0468e-03_r8,5.5810e-03_r8,4.5086e-03_r8,2.9823e-03_r8,2.7740e-04_r8/) + kbo(:, 5,47, 5) = (/ & + &5.6890e-03_r8,7.7116e-03_r8,6.0862e-03_r8,3.8914e-03_r8,2.8663e-04_r8/) + kbo(:, 1,48, 5) = (/ & + &1.0010e-03_r8,1.5219e-03_r8,1.3705e-03_r8,1.0399e-03_r8,1.9690e-04_r8/) + kbo(:, 2,48, 5) = (/ & + &1.5623e-03_r8,2.2781e-03_r8,1.9661e-03_r8,1.4139e-03_r8,2.0690e-04_r8/) + kbo(:, 3,48, 5) = (/ & + &2.3663e-03_r8,3.3328e-03_r8,2.7724e-03_r8,1.9027e-03_r8,2.1643e-04_r8/) + kbo(:, 4,48, 5) = (/ & + &3.4895e-03_r8,4.7876e-03_r8,3.8543e-03_r8,2.5388e-03_r8,2.2513e-04_r8/) + kbo(:, 5,48, 5) = (/ & + &4.9716e-03_r8,6.7160e-03_r8,5.2797e-03_r8,3.3578e-03_r8,2.3320e-04_r8/) + kbo(:, 1,49, 5) = (/ & + &8.5765e-04_r8,1.2765e-03_r8,1.1434e-03_r8,8.6362e-04_r8,1.5857e-04_r8/) + kbo(:, 2,49, 5) = (/ & + &1.3602e-03_r8,1.9488e-03_r8,1.6723e-03_r8,1.1956e-03_r8,1.6712e-04_r8/) + kbo(:, 3,49, 5) = (/ & + &2.0873e-03_r8,2.8996e-03_r8,2.4000e-03_r8,1.6350e-03_r8,1.7515e-04_r8/) + kbo(:, 4,49, 5) = (/ & + &3.1195e-03_r8,4.2309e-03_r8,3.3880e-03_r8,2.2146e-03_r8,1.8269e-04_r8/) + kbo(:, 5,49, 5) = (/ & + &4.5042e-03_r8,6.0317e-03_r8,4.7143e-03_r8,2.9742e-03_r8,1.8971e-04_r8/) + kbo(:, 1,50, 5) = (/ & + &7.0327e-04_r8,1.0357e-03_r8,9.2617e-04_r8,6.9913e-04_r8,1.2768e-04_r8/) + kbo(:, 2,50, 5) = (/ & + &1.1341e-03_r8,1.6088e-03_r8,1.3773e-03_r8,9.8362e-04_r8,1.3488e-04_r8/) + kbo(:, 3,50, 5) = (/ & + &1.7633e-03_r8,2.4334e-03_r8,2.0087e-03_r8,1.3647e-03_r8,1.4174e-04_r8/) + kbo(:, 4,50, 5) = (/ & + &2.6686e-03_r8,3.6011e-03_r8,2.8760e-03_r8,1.8731e-03_r8,1.4819e-04_r8/) + kbo(:, 5,50, 5) = (/ & + &3.9042e-03_r8,5.2110e-03_r8,4.0582e-03_r8,2.5499e-03_r8,1.5417e-04_r8/) + kbo(:, 1,51, 5) = (/ & + &5.6283e-04_r8,8.2479e-04_r8,7.3777e-04_r8,5.5772e-04_r8,1.0280e-04_r8/) + kbo(:, 2,51, 5) = (/ & + &9.2490e-04_r8,1.3030e-03_r8,1.1149e-03_r8,7.9673e-04_r8,1.0882e-04_r8/) + kbo(:, 3,51, 5) = (/ & + &1.4569e-03_r8,2.0026e-03_r8,1.6508e-03_r8,1.1213e-03_r8,1.1463e-04_r8/) + kbo(:, 4,51, 5) = (/ & + &2.2322e-03_r8,3.0043e-03_r8,2.3967e-03_r8,1.5580e-03_r8,1.2010e-04_r8/) + kbo(:, 5,51, 5) = (/ & + &3.3090e-03_r8,4.4133e-03_r8,3.4281e-03_r8,2.1477e-03_r8,1.2516e-04_r8/) + kbo(:, 1,52, 5) = (/ & + &4.5964e-04_r8,6.6706e-04_r8,5.9570e-04_r8,4.4969e-04_r8,8.2695e-05_r8/) + kbo(:, 2,52, 5) = (/ & + &7.7113e-04_r8,1.0739e-03_r8,9.1646e-04_r8,6.5362e-04_r8,8.7774e-05_r8/) + kbo(:, 3,52, 5) = (/ & + &1.2329e-03_r8,1.6791e-03_r8,1.3796e-03_r8,9.3460e-04_r8,9.2675e-05_r8/) + kbo(:, 4,52, 5) = (/ & + &1.9124e-03_r8,2.5569e-03_r8,2.0345e-03_r8,1.3172e-03_r8,9.7314e-05_r8/) + kbo(:, 5,52, 5) = (/ & + &2.8744e-03_r8,3.8139e-03_r8,2.9526e-03_r8,1.8404e-03_r8,1.0157e-04_r8/) + kbo(:, 1,53, 5) = (/ & + &3.8730e-04_r8,5.5282e-04_r8,4.9108e-04_r8,3.6874e-04_r8,6.6480e-05_r8/) + kbo(:, 2,53, 5) = (/ & + &6.6529e-04_r8,9.0913e-04_r8,7.7130e-04_r8,5.4660e-04_r8,7.0743e-05_r8/) + kbo(:, 3,53, 5) = (/ & + &1.0811e-03_r8,1.4483e-03_r8,1.1832e-03_r8,7.9661e-04_r8,7.4902e-05_r8/) + kbo(:, 4,53, 5) = (/ & + &1.6977e-03_r8,2.2425e-03_r8,1.7750e-03_r8,1.1419e-03_r8,7.8801e-05_r8/) + kbo(:, 5,53, 5) = (/ & + &2.5875e-03_r8,3.3978e-03_r8,2.6180e-03_r8,1.6189e-03_r8,8.2434e-05_r8/) + kbo(:, 1,54, 5) = (/ & + &2.8438e-04_r8,4.1240e-04_r8,3.6923e-04_r8,2.8032e-04_r8,5.3391e-05_r8/) + kbo(:, 2,54, 5) = (/ & + &5.0038e-04_r8,6.8881e-04_r8,5.8764e-04_r8,4.1957e-04_r8,5.6986e-05_r8/) + kbo(:, 3,54, 5) = (/ & + &8.2710e-04_r8,1.1130e-03_r8,9.1323e-04_r8,6.1896e-04_r8,6.0464e-05_r8/) + kbo(:, 4,54, 5) = (/ & + &1.3140e-03_r8,1.7467e-03_r8,1.3863e-03_r8,8.9674e-04_r8,6.3698e-05_r8/) + kbo(:, 5,54, 5) = (/ & + &2.0289e-03_r8,2.6791e-03_r8,2.0677e-03_r8,1.2826e-03_r8,6.6754e-05_r8/) + kbo(:, 1,55, 5) = (/ & + &1.9032e-04_r8,2.8714e-04_r8,2.6164e-04_r8,2.0312e-04_r8,4.2857e-05_r8/) + kbo(:, 2,55, 5) = (/ & + &3.4354e-04_r8,4.8514e-04_r8,4.1940e-04_r8,3.0487e-04_r8,4.5872e-05_r8/) + kbo(:, 3,55, 5) = (/ & + &5.7798e-04_r8,7.9314e-04_r8,6.5789e-04_r8,4.5289e-04_r8,4.8737e-05_r8/) + kbo(:, 4,55, 5) = (/ & + &9.2977e-04_r8,1.2582e-03_r8,1.0072e-03_r8,6.6019e-04_r8,5.1425e-05_r8/) + kbo(:, 5,55, 5) = (/ & + &1.4533e-03_r8,1.9484e-03_r8,1.5135e-03_r8,9.4927e-04_r8,5.3965e-05_r8/) + kbo(:, 1,56, 5) = (/ & + &1.2624e-04_r8,1.9945e-04_r8,1.8526e-04_r8,1.4713e-04_r8,3.4367e-05_r8/) + kbo(:, 2,56, 5) = (/ & + &2.3425e-04_r8,3.4034e-04_r8,2.9855e-04_r8,2.2108e-04_r8,3.6885e-05_r8/) + kbo(:, 3,56, 5) = (/ & + &4.0201e-04_r8,5.6312e-04_r8,4.7257e-04_r8,3.3069e-04_r8,3.9253e-05_r8/) + kbo(:, 4,56, 5) = (/ & + &6.5545e-04_r8,9.0280e-04_r8,7.2955e-04_r8,4.8511e-04_r8,4.1521e-05_r8/) + kbo(:, 5,56, 5) = (/ & + &1.0372e-03_r8,1.4120e-03_r8,1.1051e-03_r8,7.0135e-04_r8,4.3631e-05_r8/) + kbo(:, 1,57, 5) = (/ & + &8.2825e-05_r8,1.3826e-04_r8,1.3105e-04_r8,1.0648e-04_r8,2.7541e-05_r8/) + kbo(:, 2,57, 5) = (/ & + &1.5848e-04_r8,2.3765e-04_r8,2.1180e-04_r8,1.6006e-04_r8,2.9646e-05_r8/) + kbo(:, 3,57, 5) = (/ & + &2.7802e-04_r8,3.9802e-04_r8,3.3815e-04_r8,2.4085e-04_r8,3.1604e-05_r8/) + kbo(:, 4,57, 5) = (/ & + &4.6014e-04_r8,6.4521e-04_r8,5.2696e-04_r8,3.5556e-04_r8,3.3502e-05_r8/) + kbo(:, 5,57, 5) = (/ & + &7.3676e-04_r8,1.0192e-03_r8,8.0418e-04_r8,5.1690e-04_r8,3.5248e-05_r8/) + kbo(:, 1,58, 5) = (/ & + &1.4413e-05_r8,3.1415e-05_r8,3.9206e-05_r8,4.5793e-05_r8,2.2070e-05_r8/) + kbo(:, 2,58, 5) = (/ & + &2.8319e-05_r8,5.4166e-05_r8,6.3295e-05_r8,6.8680e-05_r8,2.3823e-05_r8/) + kbo(:, 3,58, 5) = (/ & + &5.0851e-05_r8,9.1643e-05_r8,1.0172e-04_r8,1.0358e-04_r8,2.5450e-05_r8/) + kbo(:, 4,58, 5) = (/ & + &8.5536e-05_r8,1.4999e-04_r8,1.5967e-04_r8,1.5367e-04_r8,2.7016e-05_r8/) + kbo(:, 5,58, 5) = (/ & + &1.3845e-04_r8,2.3895e-04_r8,2.4509e-04_r8,2.2418e-04_r8,2.8488e-05_r8/) + kbo(:, 1,59, 5) = (/ & + &1.2766e-05_r8,2.9930e-05_r8,3.6342e-05_r8,3.9546e-05_r8,1.7924e-05_r8/) + kbo(:, 2,59, 5) = (/ & + &2.5308e-05_r8,5.0886e-05_r8,5.7559e-05_r8,5.8137e-05_r8,1.9351e-05_r8/) + kbo(:, 3,59, 5) = (/ & + &4.5886e-05_r8,8.5371e-05_r8,9.1314e-05_r8,8.6129e-05_r8,2.0681e-05_r8/) + kbo(:, 4,59, 5) = (/ & + &7.7783e-05_r8,1.3897e-04_r8,1.4192e-04_r8,1.2608e-04_r8,2.1937e-05_r8/) + kbo(:, 5,59, 5) = (/ & + &1.2671e-04_r8,2.2060e-04_r8,2.1586e-04_r8,1.8160e-04_r8,2.3122e-05_r8/) + kbo(:, 1,13, 6) = (/ & + &1.2091e+00_r8,1.0925e+00_r8,9.7132e-01_r8,7.6832e-01_r8,2.2429e-01_r8/) + kbo(:, 2,13, 6) = (/ & + &1.8464e+00_r8,1.5640e+00_r8,1.2977e+00_r8,9.6738e-01_r8,2.2945e-01_r8/) + kbo(:, 3,13, 6) = (/ & + &2.7006e+00_r8,2.1933e+00_r8,1.7174e+00_r8,1.2089e+00_r8,2.3586e-01_r8/) + kbo(:, 4,13, 6) = (/ & + &3.8041e+00_r8,3.0098e+00_r8,2.2534e+00_r8,1.4966e+00_r8,2.4148e-01_r8/) + kbo(:, 5,13, 6) = (/ & + &5.1874e+00_r8,4.0404e+00_r8,2.9277e+00_r8,1.8384e+00_r8,2.4717e-01_r8/) + kbo(:, 1,14, 6) = (/ & + &6.6672e-01_r8,6.8855e-01_r8,6.6353e-01_r8,5.5608e-01_r8,2.0092e-01_r8/) + kbo(:, 2,14, 6) = (/ & + &1.0160e+00_r8,9.4963e-01_r8,8.6392e-01_r8,6.8590e-01_r8,2.0621e-01_r8/) + kbo(:, 3,14, 6) = (/ & + &1.4836e+00_r8,1.2937e+00_r8,1.1112e+00_r8,8.3934e-01_r8,2.1228e-01_r8/) + kbo(:, 4,14, 6) = (/ & + &2.0856e+00_r8,1.7366e+00_r8,1.4142e+00_r8,1.0186e+00_r8,2.1791e-01_r8/) + kbo(:, 5,14, 6) = (/ & + &2.8402e+00_r8,2.2928e+00_r8,1.7814e+00_r8,1.2275e+00_r8,2.2338e-01_r8/) + kbo(:, 1,15, 6) = (/ & + &3.7534e-01_r8,4.5732e-01_r8,4.6750e-01_r8,4.0917e-01_r8,1.7874e-01_r8/) + kbo(:, 2,15, 6) = (/ & + &5.7029e-01_r8,6.1390e-01_r8,5.9540e-01_r8,4.9734e-01_r8,1.8407e-01_r8/) + kbo(:, 3,15, 6) = (/ & + &8.2994e-01_r8,8.1258e-01_r8,7.5038e-01_r8,5.9870e-01_r8,1.8982e-01_r8/) + kbo(:, 4,15, 6) = (/ & + &1.1635e+00_r8,1.0593e+00_r8,9.3529e-01_r8,7.1512e-01_r8,1.9538e-01_r8/) + kbo(:, 5,15, 6) = (/ & + &1.5834e+00_r8,1.3649e+00_r8,1.1537e+00_r8,8.4763e-01_r8,2.0092e-01_r8/) + kbo(:, 1,16, 6) = (/ & + &2.5139e-01_r8,3.4640e-01_r8,3.6560e-01_r8,3.2723e-01_r8,1.5796e-01_r8/) + kbo(:, 2,16, 6) = (/ & + &3.8033e-01_r8,4.5844e-01_r8,4.5962e-01_r8,3.9345e-01_r8,1.6322e-01_r8/) + kbo(:, 3,16, 6) = (/ & + &5.5135e-01_r8,5.9731e-01_r8,5.7234e-01_r8,4.6896e-01_r8,1.6890e-01_r8/) + kbo(:, 4,16, 6) = (/ & + &7.7178e-01_r8,7.6699e-01_r8,7.0504e-01_r8,5.5557e-01_r8,1.7446e-01_r8/) + kbo(:, 5,16, 6) = (/ & + &1.0505e+00_r8,9.7332e-01_r8,8.6035e-01_r8,6.5296e-01_r8,1.7998e-01_r8/) + kbo(:, 1,17, 6) = (/ & + &1.7391e-01_r8,2.6830e-01_r8,2.8935e-01_r8,2.6535e-01_r8,1.3871e-01_r8/) + kbo(:, 2,17, 6) = (/ & + &2.6196e-01_r8,3.5091e-01_r8,3.6089e-01_r8,3.1647e-01_r8,1.4388e-01_r8/) + kbo(:, 3,17, 6) = (/ & + &3.7888e-01_r8,4.5188e-01_r8,4.4522e-01_r8,3.7420e-01_r8,1.4950e-01_r8/) + kbo(:, 4,17, 6) = (/ & + &5.3041e-01_r8,5.7470e-01_r8,5.4379e-01_r8,4.3949e-01_r8,1.5497e-01_r8/) + kbo(:, 5,17, 6) = (/ & + &7.2254e-01_r8,7.2344e-01_r8,6.5849e-01_r8,5.1285e-01_r8,1.6018e-01_r8/) + kbo(:, 1,18, 6) = (/ & + &1.2310e-01_r8,2.1053e-01_r8,2.3152e-01_r8,2.1713e-01_r8,1.2112e-01_r8/) + kbo(:, 2,18, 6) = (/ & + &1.8497e-01_r8,2.7232e-01_r8,2.8648e-01_r8,2.5684e-01_r8,1.2635e-01_r8/) + kbo(:, 3,18, 6) = (/ & + &2.6727e-01_r8,3.4798e-01_r8,3.5045e-01_r8,3.0154e-01_r8,1.3167e-01_r8/) + kbo(:, 4,18, 6) = (/ & + &3.7442e-01_r8,4.3958e-01_r8,4.2522e-01_r8,3.5185e-01_r8,1.3670e-01_r8/) + kbo(:, 5,18, 6) = (/ & + &5.0994e-01_r8,5.4989e-01_r8,5.1174e-01_r8,4.0832e-01_r8,1.4125e-01_r8/) + kbo(:, 1,19, 6) = (/ & + &8.5532e-02_r8,1.6314e-01_r8,1.8367e-01_r8,1.7636e-01_r8,1.0532e-01_r8/) + kbo(:, 2,19, 6) = (/ & + &1.2828e-01_r8,2.0893e-01_r8,2.2484e-01_r8,2.0705e-01_r8,1.1032e-01_r8/) + kbo(:, 3,19, 6) = (/ & + &1.8543e-01_r8,2.6474e-01_r8,2.7268e-01_r8,2.4148e-01_r8,1.1512e-01_r8/) + kbo(:, 4,19, 6) = (/ & + &2.5984e-01_r8,3.3238e-01_r8,3.2852e-01_r8,2.8001e-01_r8,1.1952e-01_r8/) + kbo(:, 5,19, 6) = (/ & + &3.5320e-01_r8,4.1295e-01_r8,3.9317e-01_r8,3.2333e-01_r8,1.2366e-01_r8/) + kbo(:, 1,20, 6) = (/ & + &6.4796e-02_r8,1.3254e-01_r8,1.5120e-01_r8,1.4730e-01_r8,9.1341e-02_r8/) + kbo(:, 2,20, 6) = (/ & + &9.6990e-02_r8,1.6885e-01_r8,1.8400e-01_r8,1.7239e-01_r8,9.5796e-02_r8/) + kbo(:, 3,20, 6) = (/ & + &1.4017e-01_r8,2.1315e-01_r8,2.2212e-01_r8,2.0058e-01_r8,9.9929e-02_r8/) + kbo(:, 4,20, 6) = (/ & + &1.9600e-01_r8,2.6649e-01_r8,2.6658e-01_r8,2.3206e-01_r8,1.0386e-01_r8/) + kbo(:, 5,20, 6) = (/ & + &2.6559e-01_r8,3.2963e-01_r8,3.1802e-01_r8,2.6726e-01_r8,1.0762e-01_r8/) + kbo(:, 1,21, 6) = (/ & + &5.0649e-02_r8,1.0928e-01_r8,1.2583e-01_r8,1.2405e-01_r8,7.8779e-02_r8/) + kbo(:, 2,21, 6) = (/ & + &7.5738e-02_r8,1.3875e-01_r8,1.5264e-01_r8,1.4489e-01_r8,8.2609e-02_r8/) + kbo(:, 3,21, 6) = (/ & + &1.0925e-01_r8,1.7464e-01_r8,1.8399e-01_r8,1.6832e-01_r8,8.6258e-02_r8/) + kbo(:, 4,21, 6) = (/ & + &1.5216e-01_r8,2.1765e-01_r8,2.2035e-01_r8,1.9451e-01_r8,8.9821e-02_r8/) + kbo(:, 5,21, 6) = (/ & + &2.0550e-01_r8,2.6822e-01_r8,2.6230e-01_r8,2.2354e-01_r8,9.3160e-02_r8/) + kbo(:, 1,22, 6) = (/ & + &4.1767e-02_r8,9.2608e-02_r8,1.0699e-01_r8,1.0611e-01_r8,6.7766e-02_r8/) + kbo(:, 2,22, 6) = (/ & + &6.2192e-02_r8,1.1726e-01_r8,1.2959e-01_r8,1.2363e-01_r8,7.1096e-02_r8/) + kbo(:, 3,22, 6) = (/ & + &8.9136e-02_r8,1.4711e-01_r8,1.5605e-01_r8,1.4343e-01_r8,7.4363e-02_r8/) + kbo(:, 4,22, 6) = (/ & + &1.2346e-01_r8,1.8283e-01_r8,1.8672e-01_r8,1.6558e-01_r8,7.7494e-02_r8/) + kbo(:, 5,22, 6) = (/ & + &1.6595e-01_r8,2.2428e-01_r8,2.2184e-01_r8,1.9008e-01_r8,8.0478e-02_r8/) + kbo(:, 1,23, 6) = (/ & + &3.4739e-02_r8,7.8664e-02_r8,9.1136e-02_r8,9.0610e-02_r8,5.8065e-02_r8/) + kbo(:, 2,23, 6) = (/ & + &5.1379e-02_r8,9.9376e-02_r8,1.1032e-01_r8,1.0537e-01_r8,6.0980e-02_r8/) + kbo(:, 3,23, 6) = (/ & + &7.3154e-02_r8,1.2441e-01_r8,1.3261e-01_r8,1.2218e-01_r8,6.3866e-02_r8/) + kbo(:, 4,23, 6) = (/ & + &1.0075e-01_r8,1.5392e-01_r8,1.5845e-01_r8,1.4087e-01_r8,6.6610e-02_r8/) + kbo(:, 5,23, 6) = (/ & + &1.3481e-01_r8,1.8817e-01_r8,1.8784e-01_r8,1.6172e-01_r8,6.9269e-02_r8/) + kbo(:, 1,24, 6) = (/ & + &2.8818e-02_r8,6.6682e-02_r8,7.7471e-02_r8,7.7057e-02_r8,4.9574e-02_r8/) + kbo(:, 2,24, 6) = (/ & + &4.2313e-02_r8,8.4062e-02_r8,9.3582e-02_r8,8.9537e-02_r8,5.2146e-02_r8/) + kbo(:, 3,24, 6) = (/ & + &5.9843e-02_r8,1.0485e-01_r8,1.1232e-01_r8,1.0372e-01_r8,5.4645e-02_r8/) + kbo(:, 4,24, 6) = (/ & + &8.1952e-02_r8,1.2924e-01_r8,1.3388e-01_r8,1.1954e-01_r8,5.7051e-02_r8/) + kbo(:, 5,24, 6) = (/ & + &1.0925e-01_r8,1.5756e-01_r8,1.5837e-01_r8,1.3710e-01_r8,5.9328e-02_r8/) + kbo(:, 1,25, 6) = (/ & + &2.4289e-02_r8,5.7018e-02_r8,6.6182e-02_r8,6.5743e-02_r8,4.2224e-02_r8/) + kbo(:, 2,25, 6) = (/ & + &3.5371e-02_r8,7.1685e-02_r8,7.9860e-02_r8,7.6400e-02_r8,4.4451e-02_r8/) + kbo(:, 3,25, 6) = (/ & + &4.9695e-02_r8,8.9091e-02_r8,9.5704e-02_r8,8.8452e-02_r8,4.6603e-02_r8/) + kbo(:, 4,25, 6) = (/ & + &6.7687e-02_r8,1.0953e-01_r8,1.1385e-01_r8,1.0188e-01_r8,4.8655e-02_r8/) + kbo(:, 5,25, 6) = (/ & + &9.0080e-02_r8,1.3324e-01_r8,1.3448e-01_r8,1.1679e-01_r8,5.0366e-02_r8/) + kbo(:, 1,26, 6) = (/ & + &2.0940e-02_r8,4.9340e-02_r8,5.7029e-02_r8,5.6467e-02_r8,3.5910e-02_r8/) + kbo(:, 2,26, 6) = (/ & + &3.0229e-02_r8,6.1848e-02_r8,6.8786e-02_r8,6.5644e-02_r8,3.7816e-02_r8/) + kbo(:, 3,26, 6) = (/ & + &4.2173e-02_r8,7.6666e-02_r8,8.2327e-02_r8,7.6015e-02_r8,3.9629e-02_r8/) + kbo(:, 4,26, 6) = (/ & + &5.7238e-02_r8,9.4072e-02_r8,9.7854e-02_r8,8.7548e-02_r8,4.1173e-02_r8/) + kbo(:, 5,26, 6) = (/ & + &7.6058e-02_r8,1.1436e-01_r8,1.1545e-01_r8,1.0034e-01_r8,4.2300e-02_r8/) + kbo(:, 1,27, 6) = (/ & + &1.8730e-02_r8,4.3572e-02_r8,4.9937e-02_r8,4.9064e-02_r8,3.0474e-02_r8/) + kbo(:, 2,27, 6) = (/ & + &2.6831e-02_r8,5.4541e-02_r8,6.0259e-02_r8,5.7134e-02_r8,3.2064e-02_r8/) + kbo(:, 3,27, 6) = (/ & + &3.7216e-02_r8,6.7578e-02_r8,7.2151e-02_r8,6.6197e-02_r8,3.3458e-02_r8/) + kbo(:, 4,27, 6) = (/ & + &5.0417e-02_r8,8.2889e-02_r8,8.5762e-02_r8,7.6299e-02_r8,3.4507e-02_r8/) + kbo(:, 5,27, 6) = (/ & + &6.6884e-02_r8,1.0088e-01_r8,1.0129e-01_r8,8.7542e-02_r8,3.5247e-02_r8/) + kbo(:, 1,28, 6) = (/ & + &1.7190e-02_r8,3.9051e-02_r8,4.4263e-02_r8,4.3005e-02_r8,2.5796e-02_r8/) + kbo(:, 2,28, 6) = (/ & + &2.4452e-02_r8,4.8897e-02_r8,5.3477e-02_r8,5.0169e-02_r8,2.7044e-02_r8/) + kbo(:, 3,28, 6) = (/ & + &3.3807e-02_r8,6.0596e-02_r8,6.4111e-02_r8,5.8195e-02_r8,2.8015e-02_r8/) + kbo(:, 4,28, 6) = (/ & + &4.5722e-02_r8,7.4408e-02_r8,7.6314e-02_r8,6.7197e-02_r8,2.8722e-02_r8/) + kbo(:, 5,28, 6) = (/ & + &6.0503e-02_r8,9.0881e-02_r8,9.0351e-02_r8,7.7127e-02_r8,2.9243e-02_r8/) + kbo(:, 1,29, 6) = (/ & + &1.6778e-02_r8,3.6309e-02_r8,4.0421e-02_r8,3.8540e-02_r8,2.1757e-02_r8/) + kbo(:, 2,29, 6) = (/ & + &2.3732e-02_r8,4.5567e-02_r8,4.8987e-02_r8,4.5076e-02_r8,2.2654e-02_r8/) + kbo(:, 3,29, 6) = (/ & + &3.2754e-02_r8,5.6621e-02_r8,5.8900e-02_r8,5.2465e-02_r8,2.3325e-02_r8/) + kbo(:, 4,29, 6) = (/ & + &4.4197e-02_r8,6.9861e-02_r8,7.0379e-02_r8,6.0698e-02_r8,2.3826e-02_r8/) + kbo(:, 5,29, 6) = (/ & + &5.8243e-02_r8,8.5699e-02_r8,8.3806e-02_r8,6.9875e-02_r8,2.4188e-02_r8/) + kbo(:, 1,30, 6) = (/ & + &1.6788e-02_r8,3.4359e-02_r8,3.7447e-02_r8,3.4898e-02_r8,1.8241e-02_r8/) + kbo(:, 2,30, 6) = (/ & + &2.3674e-02_r8,4.3260e-02_r8,4.5554e-02_r8,4.0970e-02_r8,1.8874e-02_r8/) + kbo(:, 3,30, 6) = (/ & + &3.2611e-02_r8,5.3991e-02_r8,5.4995e-02_r8,4.7819e-02_r8,1.9352e-02_r8/) + kbo(:, 4,30, 6) = (/ & + &4.3823e-02_r8,6.7000e-02_r8,6.6123e-02_r8,5.5495e-02_r8,1.9717e-02_r8/) + kbo(:, 5,30, 6) = (/ & + &5.7496e-02_r8,8.2562e-02_r8,7.9216e-02_r8,6.4205e-02_r8,1.9974e-02_r8/) + kbo(:, 1,31, 6) = (/ & + &1.7729e-02_r8,3.3726e-02_r8,3.5756e-02_r8,3.2351e-02_r8,1.5217e-02_r8/) + kbo(:, 2,31, 6) = (/ & + &2.4948e-02_r8,4.2686e-02_r8,4.3734e-02_r8,3.8162e-02_r8,1.5670e-02_r8/) + kbo(:, 3,31, 6) = (/ & + &3.4225e-02_r8,5.3676e-02_r8,5.3194e-02_r8,4.4735e-02_r8,1.6031e-02_r8/) + kbo(:, 4,31, 6) = (/ & + &4.5784e-02_r8,6.7038e-02_r8,6.4468e-02_r8,5.2256e-02_r8,1.6295e-02_r8/) + kbo(:, 5,31, 6) = (/ & + &5.9817e-02_r8,8.2952e-02_r8,7.7737e-02_r8,6.0918e-02_r8,1.6485e-02_r8/) + kbo(:, 1,32, 6) = (/ & + &1.9003e-02_r8,3.3583e-02_r8,3.4583e-02_r8,3.0306e-02_r8,1.2654e-02_r8/) + kbo(:, 2,32, 6) = (/ & + &2.6663e-02_r8,4.2837e-02_r8,4.2596e-02_r8,3.5915e-02_r8,1.2998e-02_r8/) + kbo(:, 3,32, 6) = (/ & + &3.6385e-02_r8,5.4256e-02_r8,5.2269e-02_r8,4.2382e-02_r8,1.3260e-02_r8/) + kbo(:, 4,32, 6) = (/ & + &4.8425e-02_r8,6.8084e-02_r8,6.3837e-02_r8,4.9934e-02_r8,1.3455e-02_r8/) + kbo(:, 5,32, 6) = (/ & + &6.3023e-02_r8,8.4608e-02_r8,7.7399e-02_r8,5.8694e-02_r8,1.3589e-02_r8/) + kbo(:, 1,33, 6) = (/ & + &2.0794e-02_r8,3.4164e-02_r8,3.4049e-02_r8,2.8789e-02_r8,1.0506e-02_r8/) + kbo(:, 2,33, 6) = (/ & + &2.9020e-02_r8,4.3934e-02_r8,4.2358e-02_r8,3.4361e-02_r8,1.0761e-02_r8/) + kbo(:, 3,33, 6) = (/ & + &3.9409e-02_r8,5.5981e-02_r8,5.2449e-02_r8,4.0931e-02_r8,1.0954e-02_r8/) + kbo(:, 4,33, 6) = (/ & + &5.2184e-02_r8,7.0595e-02_r8,6.4456e-02_r8,4.8674e-02_r8,1.1100e-02_r8/) + kbo(:, 5,33, 6) = (/ & + &6.7723e-02_r8,8.8066e-02_r8,7.8614e-02_r8,5.7672e-02_r8,1.1201e-02_r8/) + kbo(:, 1,34, 6) = (/ & + &2.1935e-02_r8,3.4165e-02_r8,3.3105e-02_r8,2.7057e-02_r8,8.7014e-03_r8/) + kbo(:, 2,34, 6) = (/ & + &3.0477e-02_r8,4.4226e-02_r8,4.1562e-02_r8,3.2560e-02_r8,8.8925e-03_r8/) + kbo(:, 3,34, 6) = (/ & + &4.1199e-02_r8,5.6620e-02_r8,5.1809e-02_r8,3.9153e-02_r8,9.0424e-03_r8/) + kbo(:, 4,34, 6) = (/ & + &5.4372e-02_r8,7.1709e-02_r8,6.4039e-02_r8,4.6915e-02_r8,9.1557e-03_r8/) + kbo(:, 5,34, 6) = (/ & + &7.0476e-02_r8,8.9710e-02_r8,7.8542e-02_r8,5.5979e-02_r8,9.2318e-03_r8/) + kbo(:, 1,35, 6) = (/ & + &2.2432e-02_r8,3.3575e-02_r8,3.1770e-02_r8,2.5159e-02_r8,7.1825e-03_r8/) + kbo(:, 2,35, 6) = (/ & + &3.1101e-02_r8,4.3743e-02_r8,4.0231e-02_r8,3.0588e-02_r8,7.3372e-03_r8/) + kbo(:, 3,35, 6) = (/ & + &4.1959e-02_r8,5.6323e-02_r8,5.0491e-02_r8,3.7114e-02_r8,7.4571e-03_r8/) + kbo(:, 4,35, 6) = (/ & + &5.5361e-02_r8,7.1664e-02_r8,6.2827e-02_r8,4.4829e-02_r8,7.5457e-03_r8/) + kbo(:, 5,35, 6) = (/ & + &7.1841e-02_r8,8.9995e-02_r8,7.7538e-02_r8,5.3898e-02_r8,7.6098e-03_r8/) + kbo(:, 1,36, 6) = (/ & + &2.1971e-02_r8,3.2052e-02_r8,2.9773e-02_r8,2.2980e-02_r8,5.9169e-03_r8/) + kbo(:, 2,36, 6) = (/ & + &3.0496e-02_r8,4.2068e-02_r8,3.8012e-02_r8,2.8228e-02_r8,6.0417e-03_r8/) + kbo(:, 3,36, 6) = (/ & + &4.1195e-02_r8,5.4532e-02_r8,4.8068e-02_r8,3.4542e-02_r8,6.1403e-03_r8/) + kbo(:, 4,36, 6) = (/ & + &5.4471e-02_r8,6.9759e-02_r8,6.0254e-02_r8,4.2072e-02_r8,6.2148e-03_r8/) + kbo(:, 5,36, 6) = (/ & + &7.0911e-02_r8,8.8088e-02_r8,7.4912e-02_r8,5.0992e-02_r8,6.2662e-03_r8/) + kbo(:, 1,37, 6) = (/ & + &1.9922e-02_r8,2.8852e-02_r8,2.6493e-02_r8,2.0135e-02_r8,4.8546e-03_r8/) + kbo(:, 2,37, 6) = (/ & + &2.7802e-02_r8,3.8202e-02_r8,3.4133e-02_r8,2.4969e-02_r8,4.9597e-03_r8/) + kbo(:, 3,37, 6) = (/ & + &3.7750e-02_r8,4.9930e-02_r8,4.3532e-02_r8,3.0816e-02_r8,5.0441e-03_r8/) + kbo(:, 4,37, 6) = (/ & + &5.0184e-02_r8,6.4346e-02_r8,5.5012e-02_r8,3.7855e-02_r8,5.1082e-03_r8/) + kbo(:, 5,37, 6) = (/ & + &6.5650e-02_r8,8.1819e-02_r8,6.8970e-02_r8,4.6262e-02_r8,5.1546e-03_r8/) + kbo(:, 1,38, 6) = (/ & + &1.8261e-02_r8,2.6220e-02_r8,2.3783e-02_r8,1.7789e-02_r8,3.9817e-03_r8/) + kbo(:, 2,38, 6) = (/ & + &2.5634e-02_r8,3.5047e-02_r8,3.0941e-02_r8,2.2280e-02_r8,4.0729e-03_r8/) + kbo(:, 3,38, 6) = (/ & + &3.5007e-02_r8,4.6188e-02_r8,3.9826e-02_r8,2.7761e-02_r8,4.1447e-03_r8/) + kbo(:, 4,38, 6) = (/ & + &4.6818e-02_r8,5.9985e-02_r8,5.0782e-02_r8,3.4412e-02_r8,4.1996e-03_r8/) + kbo(:, 5,38, 6) = (/ & + &6.1549e-02_r8,7.6851e-02_r8,6.4240e-02_r8,4.2442e-02_r8,4.2409e-03_r8/) + kbo(:, 1,39, 6) = (/ & + &1.7120e-02_r8,2.4268e-02_r8,2.1723e-02_r8,1.5967e-02_r8,3.2683e-03_r8/) + kbo(:, 2,39, 6) = (/ & + &2.4172e-02_r8,3.2753e-02_r8,2.8567e-02_r8,2.0215e-02_r8,3.3454e-03_r8/) + kbo(:, 3,39, 6) = (/ & + &3.3206e-02_r8,4.3552e-02_r8,3.7135e-02_r8,2.5455e-02_r8,3.4062e-03_r8/) + kbo(:, 4,39, 6) = (/ & + &4.4652e-02_r8,5.7021e-02_r8,4.7802e-02_r8,3.1863e-02_r8,3.4542e-03_r8/) + kbo(:, 5,39, 6) = (/ & + &5.8989e-02_r8,7.3628e-02_r8,6.1045e-02_r8,3.9701e-02_r8,3.4927e-03_r8/) + kbo(:, 1,40, 6) = (/ & + &1.4508e-02_r8,2.0729e-02_r8,1.8466e-02_r8,1.3481e-02_r8,2.6735e-03_r8/) + kbo(:, 2,40, 6) = (/ & + &2.0675e-02_r8,2.8264e-02_r8,2.4526e-02_r8,1.7230e-02_r8,2.7394e-03_r8/) + kbo(:, 3,40, 6) = (/ & + &2.8640e-02_r8,3.7952e-02_r8,3.2186e-02_r8,2.1896e-02_r8,2.7930e-03_r8/) + kbo(:, 4,40, 6) = (/ & + &3.8810e-02_r8,5.0166e-02_r8,4.1826e-02_r8,2.7660e-02_r8,2.8356e-03_r8/) + kbo(:, 5,40, 6) = (/ & + &5.1624e-02_r8,6.5327e-02_r8,5.3925e-02_r8,3.4781e-02_r8,2.8708e-03_r8/) + kbo(:, 1,41, 6) = (/ & + &1.2173e-02_r8,1.7558e-02_r8,1.5577e-02_r8,1.1317e-02_r8,2.1860e-03_r8/) + kbo(:, 2,41, 6) = (/ & + &1.7521e-02_r8,2.4204e-02_r8,2.0905e-02_r8,1.4606e-02_r8,2.2431e-03_r8/) + kbo(:, 3,41, 6) = (/ & + &2.4494e-02_r8,3.2840e-02_r8,2.7710e-02_r8,1.8738e-02_r8,2.2897e-03_r8/) + kbo(:, 4,41, 6) = (/ & + &3.3465e-02_r8,4.3838e-02_r8,3.6359e-02_r8,2.3890e-02_r8,2.3273e-03_r8/) + kbo(:, 5,41, 6) = (/ & + &4.4815e-02_r8,5.7614e-02_r8,4.7337e-02_r8,3.0319e-02_r8,2.3593e-03_r8/) + kbo(:, 1,42, 6) = (/ & + &1.0295e-02_r8,1.4955e-02_r8,1.3204e-02_r8,9.5463e-03_r8,1.7869e-03_r8/) + kbo(:, 2,42, 6) = (/ & + &1.4969e-02_r8,2.0854e-02_r8,1.7923e-02_r8,1.2449e-02_r8,1.8368e-03_r8/) + kbo(:, 3,42, 6) = (/ & + &2.1120e-02_r8,2.8597e-02_r8,2.4004e-02_r8,1.6130e-02_r8,1.8766e-03_r8/) + kbo(:, 4,42, 6) = (/ & + &2.9097e-02_r8,3.8565e-02_r8,3.1822e-02_r8,2.0764e-02_r8,1.9105e-03_r8/) + kbo(:, 5,42, 6) = (/ & + &3.9250e-02_r8,5.1179e-02_r8,4.1851e-02_r8,2.6620e-02_r8,1.9390e-03_r8/) + kbo(:, 1,43, 6) = (/ & + &8.5600e-03_r8,1.2537e-02_r8,1.1032e-02_r8,7.9541e-03_r8,1.4581e-03_r8/) + kbo(:, 2,43, 6) = (/ & + &1.2604e-02_r8,1.7710e-02_r8,1.5163e-02_r8,1.0490e-02_r8,1.5008e-03_r8/) + kbo(:, 3,43, 6) = (/ & + &1.7986e-02_r8,2.4578e-02_r8,2.0552e-02_r8,1.3738e-02_r8,1.5357e-03_r8/) + kbo(:, 4,43, 6) = (/ & + &2.5016e-02_r8,3.3532e-02_r8,2.7550e-02_r8,1.7878e-02_r8,1.5671e-03_r8/) + kbo(:, 5,43, 6) = (/ & + &3.4031e-02_r8,4.4978e-02_r8,3.6624e-02_r8,2.3164e-02_r8,1.5928e-03_r8/) + kbo(:, 1,44, 6) = (/ & + &7.1102e-03_r8,1.0482e-02_r8,9.1923e-03_r8,6.6123e-03_r8,1.1883e-03_r8/) + kbo(:, 2,44, 6) = (/ & + &1.0618e-02_r8,1.5014e-02_r8,1.2809e-02_r8,8.8284e-03_r8,1.2254e-03_r8/) + kbo(:, 3,44, 6) = (/ & + &1.5336e-02_r8,2.1109e-02_r8,1.7587e-02_r8,1.1700e-02_r8,1.2566e-03_r8/) + kbo(:, 4,44, 6) = (/ & + &2.1558e-02_r8,2.9159e-02_r8,2.3862e-02_r8,1.5404e-02_r8,1.2849e-03_r8/) + kbo(:, 5,44, 6) = (/ & + &2.9601e-02_r8,3.9572e-02_r8,3.2092e-02_r8,2.0188e-02_r8,1.3081e-03_r8/) + kbo(:, 1,45, 6) = (/ & + &5.9959e-03_r8,8.8564e-03_r8,7.7363e-03_r8,5.5453e-03_r8,9.6825e-04_r8/) + kbo(:, 2,45, 6) = (/ & + &9.0798e-03_r8,1.2878e-02_r8,1.0936e-02_r8,7.5039e-03_r8,1.0003e-03_r8/) + kbo(:, 3,45, 6) = (/ & + &1.3290e-02_r8,1.8346e-02_r8,1.5227e-02_r8,1.0074e-02_r8,1.0284e-03_r8/) + kbo(:, 4,45, 6) = (/ & + &1.8884e-02_r8,2.5678e-02_r8,2.0927e-02_r8,1.3427e-02_r8,1.0535e-03_r8/) + kbo(:, 5,45, 6) = (/ & + &2.6185e-02_r8,3.5270e-02_r8,2.8485e-02_r8,1.7812e-02_r8,1.0746e-03_r8/) + kbo(:, 1,46, 6) = (/ & + &5.0299e-03_r8,7.4350e-03_r8,6.4749e-03_r8,4.6277e-03_r8,7.8776e-04_r8/) + kbo(:, 2,46, 6) = (/ & + &7.7400e-03_r8,1.0992e-02_r8,9.2918e-03_r8,6.3536e-03_r8,8.1609e-04_r8/) + kbo(:, 3,46, 6) = (/ & + &1.1482e-02_r8,1.5887e-02_r8,1.3136e-02_r8,8.6493e-03_r8,8.4114e-04_r8/) + kbo(:, 4,46, 6) = (/ & + &1.6521e-02_r8,2.2547e-02_r8,1.8306e-02_r8,1.1680e-02_r8,8.6343e-04_r8/) + kbo(:, 5,46, 6) = (/ & + &2.3160e-02_r8,3.1365e-02_r8,2.5232e-02_r8,1.5694e-02_r8,8.8222e-04_r8/) + kbo(:, 1,47, 6) = (/ & + &4.0735e-03_r8,6.0481e-03_r8,5.2664e-03_r8,3.7670e-03_r8,6.3966e-04_r8/) + kbo(:, 2,47, 6) = (/ & + &6.3819e-03_r8,9.1048e-03_r8,7.6804e-03_r8,5.2485e-03_r8,6.6459e-04_r8/) + kbo(:, 3,47, 6) = (/ & + &9.6180e-03_r8,1.3376e-02_r8,1.1030e-02_r8,7.2481e-03_r8,6.8646e-04_r8/) + kbo(:, 4,47, 6) = (/ & + &1.4038e-02_r8,1.9266e-02_r8,1.5600e-02_r8,9.9209e-03_r8,7.0632e-04_r8/) + kbo(:, 5,47, 6) = (/ & + &1.9923e-02_r8,2.7168e-02_r8,2.1786e-02_r8,1.3500e-02_r8,7.2294e-04_r8/) + kbo(:, 1,48, 6) = (/ & + &3.3654e-03_r8,4.9911e-03_r8,4.3393e-03_r8,3.1001e-03_r8,5.1894e-04_r8/) + kbo(:, 2,48, 6) = (/ & + &5.3738e-03_r8,7.6583e-03_r8,6.4413e-03_r8,4.3896e-03_r8,5.4055e-04_r8/) + kbo(:, 3,48, 6) = (/ & + &8.2348e-03_r8,1.1452e-02_r8,9.4090e-03_r8,6.1594e-03_r8,5.5982e-04_r8/) + kbo(:, 4,48, 6) = (/ & + &1.2194e-02_r8,1.6751e-02_r8,1.3518e-02_r8,8.5585e-03_r8,5.7759e-04_r8/) + kbo(:, 5,48, 6) = (/ & + &1.7535e-02_r8,2.3969e-02_r8,1.9153e-02_r8,1.1809e-02_r8,5.9223e-04_r8/) + kbo(:, 1,49, 6) = (/ & + &2.8714e-03_r8,4.2192e-03_r8,3.6533e-03_r8,2.6003e-03_r8,4.2066e-04_r8/) + kbo(:, 2,49, 6) = (/ & + &4.6796e-03_r8,6.6096e-03_r8,5.5332e-03_r8,3.7482e-03_r8,4.3948e-04_r8/) + kbo(:, 3,49, 6) = (/ & + &7.3002e-03_r8,1.0080e-02_r8,8.2347e-03_r8,5.3596e-03_r8,4.5652e-04_r8/) + kbo(:, 4,49, 6) = (/ & + &1.0971e-02_r8,1.4981e-02_r8,1.2046e-02_r8,7.5739e-03_r8,4.7234e-04_r8/) + kbo(:, 5,49, 6) = (/ & + &1.5995e-02_r8,2.1767e-02_r8,1.7330e-02_r8,1.0614e-02_r8,4.8568e-04_r8/) + kbo(:, 1,50, 6) = (/ & + &2.3434e-03_r8,3.4410e-03_r8,2.9786e-03_r8,2.1205e-03_r8,3.4069e-04_r8/) + kbo(:, 2,50, 6) = (/ & + &3.8971e-03_r8,5.4992e-03_r8,4.5940e-03_r8,3.1036e-03_r8,3.5714e-04_r8/) + kbo(:, 3,50, 6) = (/ & + &6.1900e-03_r8,8.5460e-03_r8,6.9553e-03_r8,4.5152e-03_r8,3.7212e-04_r8/) + kbo(:, 4,50, 6) = (/ & + &9.4451e-03_r8,1.2909e-02_r8,1.0349e-02_r8,6.4854e-03_r8,3.8582e-04_r8/) + kbo(:, 5,50, 6) = (/ & + &1.3954e-02_r8,1.9042e-02_r8,1.5119e-02_r8,9.2171e-03_r8,3.9788e-04_r8/) + kbo(:, 1,51, 6) = (/ & + &1.8670e-03_r8,2.7492e-03_r8,2.3841e-03_r8,1.7021e-03_r8,2.7578e-04_r8/) + kbo(:, 2,51, 6) = (/ & + &3.1678e-03_r8,4.4826e-03_r8,3.7408e-03_r8,2.5267e-03_r8,2.9005e-04_r8/) + kbo(:, 3,51, 6) = (/ & + &5.1260e-03_r8,7.0985e-03_r8,5.7656e-03_r8,3.7383e-03_r8,3.0300e-04_r8/) + kbo(:, 4,51, 6) = (/ & + &7.9439e-03_r8,1.0904e-02_r8,8.7196e-03_r8,5.4539e-03_r8,3.1487e-04_r8/) + kbo(:, 5,51, 6) = (/ & + &1.1900e-02_r8,1.6326e-02_r8,1.2929e-02_r8,7.8597e-03_r8,3.2578e-04_r8/) + kbo(:, 1,52, 6) = (/ & + &1.5181e-03_r8,2.2298e-03_r8,1.9337e-03_r8,1.3821e-03_r8,2.2294e-04_r8/) + kbo(:, 2,52, 6) = (/ & + &2.6323e-03_r8,3.7113e-03_r8,3.0904e-03_r8,2.0844e-03_r8,2.3535e-04_r8/) + kbo(:, 3,52, 6) = (/ & + &4.3389e-03_r8,5.9943e-03_r8,4.8574e-03_r8,3.1382e-03_r8,2.4655e-04_r8/) + kbo(:, 4,52, 6) = (/ & + &6.8363e-03_r8,9.3770e-03_r8,7.4736e-03_r8,4.6599e-03_r8,2.5711e-04_r8/) + kbo(:, 5,52, 6) = (/ & + &1.0389e-02_r8,1.4256e-02_r8,1.1263e-02_r8,6.8242e-03_r8,2.6665e-04_r8/) + kbo(:, 1,53, 6) = (/ & + &1.2752e-03_r8,1.8531e-03_r8,1.6024e-03_r8,1.1428e-03_r8,1.8014e-04_r8/) + kbo(:, 2,53, 6) = (/ & + &2.2594e-03_r8,3.1508e-03_r8,2.6140e-03_r8,1.7561e-03_r8,1.9085e-04_r8/) + kbo(:, 3,53, 6) = (/ & + &3.7990e-03_r8,5.2013e-03_r8,4.1982e-03_r8,2.6961e-03_r8,2.0067e-04_r8/) + kbo(:, 4,53, 6) = (/ & + &6.0922e-03_r8,8.2959e-03_r8,6.5816e-03_r8,4.0835e-03_r8,2.0982e-04_r8/) + kbo(:, 5,53, 6) = (/ & + &9.3947e-03_r8,1.2809e-02_r8,1.0095e-02_r8,6.0875e-03_r8,2.1819e-04_r8/) + kbo(:, 1,54, 6) = (/ & + &9.3663e-04_r8,1.3820e-03_r8,1.2040e-03_r8,8.6807e-04_r8,1.4544e-04_r8/) + kbo(:, 2,54, 6) = (/ & + &1.6914e-03_r8,2.3887e-03_r8,1.9911e-03_r8,1.3482e-03_r8,1.5460e-04_r8/) + kbo(:, 3,54, 6) = (/ & + &2.8997e-03_r8,4.0201e-03_r8,3.2494e-03_r8,2.0953e-03_r8,1.6297e-04_r8/) + kbo(:, 4,54, 6) = (/ & + &4.7306e-03_r8,6.5273e-03_r8,5.1758e-03_r8,3.2189e-03_r8,1.7075e-04_r8/) + kbo(:, 5,54, 6) = (/ & + &7.3984e-03_r8,1.0238e-02_r8,8.0539e-03_r8,4.8622e-03_r8,1.7797e-04_r8/) + kbo(:, 1,55, 6) = (/ & + &6.2935e-04_r8,9.5969e-04_r8,8.4900e-04_r8,6.2465e-04_r8,1.1738e-04_r8/) + kbo(:, 2,55, 6) = (/ & + &1.1558e-03_r8,1.6799e-03_r8,1.4161e-03_r8,9.7472e-04_r8,1.2508e-04_r8/) + kbo(:, 3,55, 6) = (/ & + &2.0209e-03_r8,2.8749e-03_r8,2.3378e-03_r8,1.5244e-03_r8,1.3211e-04_r8/) + kbo(:, 4,55, 6) = (/ & + &3.3522e-03_r8,4.7482e-03_r8,3.7736e-03_r8,2.3654e-03_r8,1.3870e-04_r8/) + kbo(:, 5,55, 6) = (/ & + &5.3187e-03_r8,7.5686e-03_r8,5.9480e-03_r8,3.6106e-03_r8,1.4478e-04_r8/) + kbo(:, 1,56, 6) = (/ & + &4.2101e-04_r8,6.6332e-04_r8,5.9672e-04_r8,4.4860e-04_r8,9.4587e-05_r8/) + kbo(:, 2,56, 6) = (/ & + &7.8466e-04_r8,1.1752e-03_r8,1.0029e-03_r8,7.0318e-04_r8,1.0112e-04_r8/) + kbo(:, 3,56, 6) = (/ & + &1.3999e-03_r8,2.0432e-03_r8,1.6739e-03_r8,1.1053e-03_r8,1.0709e-04_r8/) + kbo(:, 4,56, 6) = (/ & + &2.3635e-03_r8,3.4329e-03_r8,2.7372e-03_r8,1.7318e-03_r8,1.1258e-04_r8/) + kbo(:, 5,56, 6) = (/ & + &3.8069e-03_r8,5.5637e-03_r8,4.3696e-03_r8,2.6702e-03_r8,1.1773e-04_r8/) + kbo(:, 1,57, 6) = (/ & + &2.8076e-04_r8,4.5641e-04_r8,4.1815e-04_r8,3.2142e-04_r8,7.6115e-05_r8/) + kbo(:, 2,57, 6) = (/ & + &5.2895e-04_r8,8.1778e-04_r8,7.0771e-04_r8,5.0616e-04_r8,8.1716e-05_r8/) + kbo(:, 3,57, 6) = (/ & + &9.6334e-04_r8,1.4422e-03_r8,1.1917e-03_r8,7.9834e-04_r8,8.6757e-05_r8/) + kbo(:, 4,57, 6) = (/ & + &1.6571e-03_r8,2.4651e-03_r8,1.9746e-03_r8,1.2622e-03_r8,9.1332e-05_r8/) + kbo(:, 5,57, 6) = (/ & + &2.7119e-03_r8,4.0628e-03_r8,3.1926e-03_r8,1.9661e-03_r8,9.5684e-05_r8/) + kbo(:, 1,58, 6) = (/ & + &4.9720e-05_r8,1.0269e-04_r8,1.2366e-04_r8,1.3663e-04_r8,6.1273e-05_r8/) + kbo(:, 2,58, 6) = (/ & + &9.4473e-05_r8,1.8553e-04_r8,2.1007e-04_r8,2.1548e-04_r8,6.5992e-05_r8/) + kbo(:, 3,58, 6) = (/ & + &1.7530e-04_r8,3.3103e-04_r8,3.5575e-04_r8,3.4010e-04_r8,7.0239e-05_r8/) + kbo(:, 4,58, 6) = (/ & + &3.0720e-04_r8,5.7469e-04_r8,5.9600e-04_r8,5.4082e-04_r8,7.4141e-05_r8/) + kbo(:, 5,58, 6) = (/ & + &5.1103e-04_r8,9.6242e-04_r8,9.7487e-04_r8,8.4973e-04_r8,7.7747e-05_r8/) + kbo(:, 1,59, 6) = (/ & + &4.4314e-05_r8,9.6972e-05_r8,1.1293e-04_r8,1.1582e-04_r8,4.9949e-05_r8/) + kbo(:, 2,59, 6) = (/ & + &8.4700e-05_r8,1.7358e-04_r8,1.8881e-04_r8,1.7917e-04_r8,5.3859e-05_r8/) + kbo(:, 3,59, 6) = (/ & + &1.5856e-04_r8,3.0848e-04_r8,3.1562e-04_r8,2.7815e-04_r8,5.7310e-05_r8/) + kbo(:, 4,59, 6) = (/ & + &2.8032e-04_r8,5.3615e-04_r8,5.2587e-04_r8,4.3688e-04_r8,6.0507e-05_r8/) + kbo(:, 5,59, 6) = (/ & + &4.7008e-04_r8,9.0261e-04_r8,8.5908e-04_r8,6.8167e-04_r8,6.3447e-05_r8/) + kbo(:, 1,13, 7) = (/ & + &3.5002e+00_r8,2.8426e+00_r8,2.2229e+00_r8,1.5940e+00_r8,4.6284e-01_r8/) + kbo(:, 2,13, 7) = (/ & + &5.2764e+00_r8,4.1532e+00_r8,3.0774e+00_r8,2.0245e+00_r8,4.6449e-01_r8/) + kbo(:, 3,13, 7) = (/ & + &7.6096e+00_r8,5.8846e+00_r8,4.2048e+00_r8,2.5664e+00_r8,4.6564e-01_r8/) + kbo(:, 4,13, 7) = (/ & + &1.0545e+01_r8,8.0718e+00_r8,5.6353e+00_r8,3.2573e+00_r8,4.6805e-01_r8/) + kbo(:, 5,13, 7) = (/ & + &1.4101e+01_r8,1.0726e+01_r8,7.3776e+00_r8,4.1071e+00_r8,4.6959e-01_r8/) + kbo(:, 1,14, 7) = (/ & + &1.9332e+00_r8,1.6833e+00_r8,1.4584e+00_r8,1.1419e+00_r8,4.2549e-01_r8/) + kbo(:, 2,14, 7) = (/ & + &2.9208e+00_r8,2.4028e+00_r8,1.9264e+00_r8,1.4148e+00_r8,4.2845e-01_r8/) + kbo(:, 3,14, 7) = (/ & + &4.2111e+00_r8,3.3491e+00_r8,2.5401e+00_r8,1.7447e+00_r8,4.2997e-01_r8/) + kbo(:, 4,14, 7) = (/ & + &5.8219e+00_r8,4.5369e+00_r8,3.3137e+00_r8,2.1374e+00_r8,4.3233e-01_r8/) + kbo(:, 5,14, 7) = (/ & + &7.7805e+00_r8,5.9890e+00_r8,4.2588e+00_r8,2.5955e+00_r8,4.3475e-01_r8/) + kbo(:, 1,15, 7) = (/ & + &1.0958e+00_r8,1.0674e+00_r8,1.0130e+00_r8,8.4961e-01_r8,3.8730e-01_r8/) + kbo(:, 2,15, 7) = (/ & + &1.6536e+00_r8,1.4690e+00_r8,1.3041e+00_r8,1.0292e+00_r8,3.9101e-01_r8/) + kbo(:, 3,15, 7) = (/ & + &2.3745e+00_r8,1.9914e+00_r8,1.6603e+00_r8,1.2452e+00_r8,3.9344e-01_r8/) + kbo(:, 4,15, 7) = (/ & + &3.2750e+00_r8,2.6468e+00_r8,2.0887e+00_r8,1.4951e+00_r8,3.9613e-01_r8/) + kbo(:, 5,15, 7) = (/ & + &4.3749e+00_r8,3.4526e+00_r8,2.6092e+00_r8,1.7780e+00_r8,3.9900e-01_r8/) + kbo(:, 1,16, 7) = (/ & + &7.4165e-01_r8,8.0405e-01_r8,7.9283e-01_r8,6.9114e-01_r8,3.4911e-01_r8/) + kbo(:, 2,16, 7) = (/ & + &1.1136e+00_r8,1.0786e+00_r8,1.0091e+00_r8,8.2862e-01_r8,3.5314e-01_r8/) + kbo(:, 3,16, 7) = (/ & + &1.5923e+00_r8,1.4242e+00_r8,1.2681e+00_r8,9.9143e-01_r8,3.5636e-01_r8/) + kbo(:, 4,16, 7) = (/ & + &2.1926e+00_r8,1.8566e+00_r8,1.5712e+00_r8,1.1771e+00_r8,3.6013e-01_r8/) + kbo(:, 5,16, 7) = (/ & + &2.9285e+00_r8,2.3901e+00_r8,1.9279e+00_r8,1.3859e+00_r8,3.6399e-01_r8/) + kbo(:, 1,17, 7) = (/ & + &5.1887e-01_r8,6.2476e-01_r8,6.3724e-01_r8,5.7083e-01_r8,3.1167e-01_r8/) + kbo(:, 2,17, 7) = (/ & + &7.7486e-01_r8,8.2693e-01_r8,8.0143e-01_r8,6.7854e-01_r8,3.1621e-01_r8/) + kbo(:, 3,17, 7) = (/ & + &1.1045e+00_r8,1.0746e+00_r8,9.9649e-01_r8,8.0449e-01_r8,3.2014e-01_r8/) + kbo(:, 4,17, 7) = (/ & + &1.5180e+00_r8,1.3742e+00_r8,1.2231e+00_r8,9.4686e-01_r8,3.2461e-01_r8/) + kbo(:, 5,17, 7) = (/ & + &2.0257e+00_r8,1.7386e+00_r8,1.4858e+00_r8,1.1069e+00_r8,3.2955e-01_r8/) + kbo(:, 1,18, 7) = (/ & + &3.7097e-01_r8,4.9432e-01_r8,5.1840e-01_r8,4.7504e-01_r8,2.7614e-01_r8/) + kbo(:, 2,18, 7) = (/ & + &5.5115e-01_r8,6.4712e-01_r8,6.4514e-01_r8,5.6072e-01_r8,2.8084e-01_r8/) + kbo(:, 3,18, 7) = (/ & + &7.8296e-01_r8,8.3225e-01_r8,7.9447e-01_r8,6.5954e-01_r8,2.8571e-01_r8/) + kbo(:, 4,18, 7) = (/ & + &1.0738e+00_r8,1.0535e+00_r8,9.6779e-01_r8,7.7088e-01_r8,2.9112e-01_r8/) + kbo(:, 5,18, 7) = (/ & + &1.4335e+00_r8,1.3170e+00_r8,1.1664e+00_r8,8.9595e-01_r8,2.9703e-01_r8/) + kbo(:, 1,19, 7) = (/ & + &2.5985e-01_r8,3.8651e-01_r8,4.1602e-01_r8,3.9308e-01_r8,2.4307e-01_r8/) + kbo(:, 2,19, 7) = (/ & + &3.8422e-01_r8,5.0067e-01_r8,5.1275e-01_r8,4.5968e-01_r8,2.4809e-01_r8/) + kbo(:, 3,19, 7) = (/ & + &5.4420e-01_r8,6.3764e-01_r8,6.2617e-01_r8,5.3586e-01_r8,2.5358e-01_r8/) + kbo(:, 4,19, 7) = (/ & + &7.4603e-01_r8,7.9981e-01_r8,7.5671e-01_r8,6.2198e-01_r8,2.5998e-01_r8/) + kbo(:, 5,19, 7) = (/ & + &9.9708e-01_r8,9.9236e-01_r8,9.0617e-01_r8,7.1829e-01_r8,2.6615e-01_r8/) + kbo(:, 1,20, 7) = (/ & + &1.9760e-01_r8,3.1836e-01_r8,3.4770e-01_r8,3.3477e-01_r8,2.1277e-01_r8/) + kbo(:, 2,20, 7) = (/ & + &2.9095e-01_r8,4.0925e-01_r8,4.2592e-01_r8,3.8937e-01_r8,2.1827e-01_r8/) + kbo(:, 3,20, 7) = (/ & + &4.1127e-01_r8,5.1768e-01_r8,5.1739e-01_r8,4.5140e-01_r8,2.2458e-01_r8/) + kbo(:, 4,20, 7) = (/ & + &5.6427e-01_r8,6.4625e-01_r8,6.2247e-01_r8,5.2174e-01_r8,2.3101e-01_r8/) + kbo(:, 5,20, 7) = (/ & + &7.5526e-01_r8,7.9836e-01_r8,7.4304e-01_r8,6.0027e-01_r8,2.3711e-01_r8/) + kbo(:, 1,21, 7) = (/ & + &1.5484e-01_r8,2.6582e-01_r8,2.9382e-01_r8,2.8708e-01_r8,1.8550e-01_r8/) + kbo(:, 2,21, 7) = (/ & + &2.2722e-01_r8,3.3963e-01_r8,3.5832e-01_r8,3.3257e-01_r8,1.9141e-01_r8/) + kbo(:, 3,21, 7) = (/ & + &3.2108e-01_r8,4.2782e-01_r8,4.3333e-01_r8,3.8435e-01_r8,1.9782e-01_r8/) + kbo(:, 4,21, 7) = (/ & + &4.4098e-01_r8,5.3304e-01_r8,5.1997e-01_r8,4.4275e-01_r8,2.0379e-01_r8/) + kbo(:, 5,21, 7) = (/ & + &5.9030e-01_r8,6.5709e-01_r8,6.1970e-01_r8,5.0864e-01_r8,2.0956e-01_r8/) + kbo(:, 1,22, 7) = (/ & + &1.2753e-01_r8,2.2781e-01_r8,2.5360e-01_r8,2.4962e-01_r8,1.6164e-01_r8/) + kbo(:, 2,22, 7) = (/ & + &1.8637e-01_r8,2.8970e-01_r8,3.0789e-01_r8,2.8854e-01_r8,1.6761e-01_r8/) + kbo(:, 3,22, 7) = (/ & + &2.6299e-01_r8,3.6404e-01_r8,3.7114e-01_r8,3.3280e-01_r8,1.7333e-01_r8/) + kbo(:, 4,22, 7) = (/ & + &3.6059e-01_r8,4.5267e-01_r8,4.4472e-01_r8,3.8285e-01_r8,1.7883e-01_r8/) + kbo(:, 5,22, 7) = (/ & + &4.8104e-01_r8,5.5702e-01_r8,5.2923e-01_r8,4.3976e-01_r8,1.8428e-01_r8/) + kbo(:, 1,23, 7) = (/ & + &1.0589e-01_r8,1.9529e-01_r8,2.1876e-01_r8,2.1679e-01_r8,1.4037e-01_r8/) + kbo(:, 2,23, 7) = (/ & + &1.5420e-01_r8,2.4758e-01_r8,2.6461e-01_r8,2.5042e-01_r8,1.4579e-01_r8/) + kbo(:, 3,23, 7) = (/ & + &2.1702e-01_r8,3.1068e-01_r8,3.1854e-01_r8,2.8852e-01_r8,1.5094e-01_r8/) + kbo(:, 4,23, 7) = (/ & + &2.9661e-01_r8,3.8564e-01_r8,3.8128e-01_r8,3.3195e-01_r8,1.5614e-01_r8/) + kbo(:, 5,23, 7) = (/ & + &3.9397e-01_r8,4.7355e-01_r8,4.5341e-01_r8,3.8121e-01_r8,1.6132e-01_r8/) + kbo(:, 1,24, 7) = (/ & + &8.7788e-02_r8,1.6668e-01_r8,1.8799e-01_r8,1.8780e-01_r8,1.2140e-01_r8/) + kbo(:, 2,24, 7) = (/ & + &1.2734e-01_r8,2.1083e-01_r8,2.2703e-01_r8,2.1652e-01_r8,1.2618e-01_r8/) + kbo(:, 3,24, 7) = (/ & + &1.7857e-01_r8,2.6413e-01_r8,2.7303e-01_r8,2.4936e-01_r8,1.3098e-01_r8/) + kbo(:, 4,24, 7) = (/ & + &2.4296e-01_r8,3.2721e-01_r8,3.2661e-01_r8,2.8698e-01_r8,1.3586e-01_r8/) + kbo(:, 5,24, 7) = (/ & + &3.2098e-01_r8,4.0055e-01_r8,3.8785e-01_r8,3.2936e-01_r8,1.4075e-01_r8/) + kbo(:, 1,25, 7) = (/ & + &7.4114e-02_r8,1.4357e-01_r8,1.6268e-01_r8,1.6299e-01_r8,1.0454e-01_r8/) + kbo(:, 2,25, 7) = (/ & + &1.0696e-01_r8,1.8148e-01_r8,1.9639e-01_r8,1.8781e-01_r8,1.0890e-01_r8/) + kbo(:, 3,25, 7) = (/ & + &1.4921e-01_r8,2.2686e-01_r8,2.3627e-01_r8,2.1648e-01_r8,1.1337e-01_r8/) + kbo(:, 4,25, 7) = (/ & + &2.0169e-01_r8,2.8030e-01_r8,2.8233e-01_r8,2.4913e-01_r8,1.1793e-01_r8/) + kbo(:, 5,25, 7) = (/ & + &2.6511e-01_r8,3.4240e-01_r8,3.3494e-01_r8,2.8598e-01_r8,1.2261e-01_r8/) + kbo(:, 1,26, 7) = (/ & + &6.4102e-02_r8,1.2562e-01_r8,1.4220e-01_r8,1.4209e-01_r8,8.9836e-02_r8/) + kbo(:, 2,26, 7) = (/ & + &9.1903e-02_r8,1.5853e-01_r8,1.7179e-01_r8,1.6391e-01_r8,9.3830e-02_r8/) + kbo(:, 3,26, 7) = (/ & + &1.2732e-01_r8,1.9782e-01_r8,2.0670e-01_r8,1.8917e-01_r8,9.8002e-02_r8/) + kbo(:, 4,26, 7) = (/ & + &1.7095e-01_r8,2.4388e-01_r8,2.4691e-01_r8,2.1801e-01_r8,1.0234e-01_r8/) + kbo(:, 5,26, 7) = (/ & + &2.2376e-01_r8,2.9731e-01_r8,2.9277e-01_r8,2.5044e-01_r8,1.0674e-01_r8/) + kbo(:, 1,27, 7) = (/ & + &5.7622e-02_r8,1.1249e-01_r8,1.2636e-01_r8,1.2511e-01_r8,7.7055e-02_r8/) + kbo(:, 2,27, 7) = (/ & + &8.1983e-02_r8,1.4196e-01_r8,1.5312e-01_r8,1.4485e-01_r8,8.0791e-02_r8/) + kbo(:, 3,27, 7) = (/ & + &1.1275e-01_r8,1.7697e-01_r8,1.8437e-01_r8,1.6781e-01_r8,8.4713e-02_r8/) + kbo(:, 4,27, 7) = (/ & + &1.5055e-01_r8,2.1794e-01_r8,2.2039e-01_r8,1.9390e-01_r8,8.8731e-02_r8/) + kbo(:, 5,27, 7) = (/ & + &1.9638e-01_r8,2.6555e-01_r8,2.6132e-01_r8,2.2312e-01_r8,9.2655e-02_r8/) + kbo(:, 1,28, 7) = (/ & + &5.3140e-02_r8,1.0241e-01_r8,1.1379e-01_r8,1.1112e-01_r8,6.6059e-02_r8/) + kbo(:, 2,28, 7) = (/ & + &7.5045e-02_r8,1.2928e-01_r8,1.3817e-01_r8,1.2935e-01_r8,6.9529e-02_r8/) + kbo(:, 3,28, 7) = (/ & + &1.0252e-01_r8,1.6119e-01_r8,1.6672e-01_r8,1.5050e-01_r8,7.3142e-02_r8/) + kbo(:, 4,28, 7) = (/ & + &1.3625e-01_r8,1.9862e-01_r8,1.9953e-01_r8,1.7444e-01_r8,7.6746e-02_r8/) + kbo(:, 5,28, 7) = (/ & + &1.7752e-01_r8,2.4214e-01_r8,2.3714e-01_r8,2.0133e-01_r8,7.9941e-02_r8/) + kbo(:, 1,29, 7) = (/ & + &5.2099e-02_r8,9.6941e-02_r8,1.0563e-01_r8,1.0097e-01_r8,5.6668e-02_r8/) + kbo(:, 2,29, 7) = (/ & + &7.3009e-02_r8,1.2266e-01_r8,1.2890e-01_r8,1.1850e-01_r8,5.9859e-02_r8/) + kbo(:, 3,29, 7) = (/ & + &9.9110e-02_r8,1.5322e-01_r8,1.5608e-01_r8,1.3860e-01_r8,6.3089e-02_r8/) + kbo(:, 4,29, 7) = (/ & + &1.3136e-01_r8,1.8918e-01_r8,1.8750e-01_r8,1.6146e-01_r8,6.6000e-02_r8/) + kbo(:, 5,29, 7) = (/ & + &1.7133e-01_r8,2.3120e-01_r8,2.2375e-01_r8,1.8721e-01_r8,6.8384e-02_r8/) + kbo(:, 1,30, 7) = (/ & + &5.2298e-02_r8,9.3477e-02_r8,9.9631e-02_r8,9.3041e-02_r8,4.8653e-02_r8/) + kbo(:, 2,30, 7) = (/ & + &7.2744e-02_r8,1.1854e-01_r8,1.2224e-01_r8,1.0996e-01_r8,5.1507e-02_r8/) + kbo(:, 3,30, 7) = (/ & + &9.8307e-02_r8,1.4854e-01_r8,1.4866e-01_r8,1.2943e-01_r8,5.4141e-02_r8/) + kbo(:, 4,30, 7) = (/ & + &1.3030e-01_r8,1.8393e-01_r8,1.7946e-01_r8,1.5167e-01_r8,5.6316e-02_r8/) + kbo(:, 5,30, 7) = (/ & + &1.7017e-01_r8,2.2583e-01_r8,2.1516e-01_r8,1.7690e-01_r8,5.8003e-02_r8/) + kbo(:, 1,31, 7) = (/ & + &5.5237e-02_r8,9.3530e-02_r8,9.7080e-02_r8,8.7885e-02_r8,4.1801e-02_r8/) + kbo(:, 2,31, 7) = (/ & + &7.6342e-02_r8,1.1917e-01_r8,1.1987e-01_r8,1.0485e-01_r8,4.4162e-02_r8/) + kbo(:, 3,31, 7) = (/ & + &1.0297e-01_r8,1.4987e-01_r8,1.4665e-01_r8,1.2435e-01_r8,4.6139e-02_r8/) + kbo(:, 4,31, 7) = (/ & + &1.3657e-01_r8,1.8654e-01_r8,1.7810e-01_r8,1.4680e-01_r8,4.7704e-02_r8/) + kbo(:, 5,31, 7) = (/ & + &1.7842e-01_r8,2.3057e-01_r8,2.1509e-01_r8,1.7253e-01_r8,4.8947e-02_r8/) + kbo(:, 1,32, 7) = (/ & + &5.9027e-02_r8,9.4969e-02_r8,9.5943e-02_r8,8.4194e-02_r8,3.5812e-02_r8/) + kbo(:, 2,32, 7) = (/ & + &8.1201e-02_r8,1.2151e-01_r8,1.1922e-01_r8,1.0130e-01_r8,3.7617e-02_r8/) + kbo(:, 3,32, 7) = (/ & + &1.0955e-01_r8,1.5358e-01_r8,1.4681e-01_r8,1.2117e-01_r8,3.9058e-02_r8/) + kbo(:, 4,32, 7) = (/ & + &1.4540e-01_r8,1.9256e-01_r8,1.7966e-01_r8,1.4421e-01_r8,4.0236e-02_r8/) + kbo(:, 5,32, 7) = (/ & + &1.8982e-01_r8,2.3938e-01_r8,2.1889e-01_r8,1.7084e-01_r8,4.1181e-02_r8/) + kbo(:, 1,33, 7) = (/ & + &6.4219e-02_r8,9.8255e-02_r8,9.6625e-02_r8,8.2099e-02_r8,3.0519e-02_r8/) + kbo(:, 2,33, 7) = (/ & + &8.8246e-02_r8,1.2633e-01_r8,1.2088e-01_r8,9.9705e-02_r8,3.1855e-02_r8/) + kbo(:, 3,33, 7) = (/ & + &1.1912e-01_r8,1.6083e-01_r8,1.5001e-01_r8,1.2028e-01_r8,3.2953e-02_r8/) + kbo(:, 4,33, 7) = (/ & + &1.5802e-01_r8,2.0300e-01_r8,1.8528e-01_r8,1.4442e-01_r8,3.3850e-02_r8/) + kbo(:, 5,33, 7) = (/ & + &2.0596e-01_r8,2.5392e-01_r8,2.2791e-01_r8,1.7303e-01_r8,3.4585e-02_r8/) + kbo(:, 1,34, 7) = (/ & + &6.7485e-02_r8,9.9620e-02_r8,9.5868e-02_r8,7.9332e-02_r8,2.5830e-02_r8/) + kbo(:, 2,34, 7) = (/ & + &9.2815e-02_r8,1.2890e-01_r8,1.2075e-01_r8,9.7213e-02_r8,2.6848e-02_r8/) + kbo(:, 3,34, 7) = (/ & + &1.2537e-01_r8,1.6529e-01_r8,1.5122e-01_r8,1.1822e-01_r8,2.7699e-02_r8/) + kbo(:, 4,34, 7) = (/ & + &1.6617e-01_r8,2.0989e-01_r8,1.8860e-01_r8,1.4346e-01_r8,2.8411e-02_r8/) + kbo(:, 5,34, 7) = (/ & + &2.1641e-01_r8,2.6338e-01_r8,2.3365e-01_r8,1.7367e-01_r8,2.9006e-02_r8/) + kbo(:, 1,35, 7) = (/ & + &6.9002e-02_r8,9.9168e-02_r8,9.3611e-02_r8,7.5846e-02_r8,2.1704e-02_r8/) + kbo(:, 2,35, 7) = (/ & + &9.5177e-02_r8,1.2935e-01_r8,1.1903e-01_r8,9.3690e-02_r8,2.2517e-02_r8/) + kbo(:, 3,35, 7) = (/ & + &1.2872e-01_r8,1.6713e-01_r8,1.5066e-01_r8,1.1518e-01_r8,2.3202e-02_r8/) + kbo(:, 4,35, 7) = (/ & + &1.7076e-01_r8,2.1347e-01_r8,1.8964e-01_r8,1.4135e-01_r8,2.3785e-02_r8/) + kbo(:, 5,35, 7) = (/ & + &2.2264e-01_r8,2.6908e-01_r8,2.3665e-01_r8,1.7298e-01_r8,2.4252e-02_r8/) + kbo(:, 1,36, 7) = (/ & + &6.7865e-02_r8,9.5879e-02_r8,8.9211e-02_r8,7.0981e-02_r8,1.8133e-02_r8/) + kbo(:, 2,36, 7) = (/ & + &9.4007e-02_r8,1.2625e-01_r8,1.1466e-01_r8,8.8573e-02_r8,1.8797e-02_r8/) + kbo(:, 3,36, 7) = (/ & + &1.2751e-01_r8,1.6450e-01_r8,1.4669e-01_r8,1.1023e-01_r8,1.9364e-02_r8/) + kbo(:, 4,36, 7) = (/ & + &1.6969e-01_r8,2.1129e-01_r8,1.8634e-01_r8,1.3684e-01_r8,1.9848e-02_r8/) + kbo(:, 5,36, 7) = (/ & + &2.2199e-01_r8,2.6776e-01_r8,2.3416e-01_r8,1.6920e-01_r8,2.0253e-02_r8/) + kbo(:, 1,37, 7) = (/ & + &6.1910e-02_r8,8.7392e-02_r8,8.0722e-02_r8,6.3503e-02_r8,1.5050e-02_r8/) + kbo(:, 2,37, 7) = (/ & + &8.6402e-02_r8,1.1634e-01_r8,1.0496e-01_r8,8.0172e-02_r8,1.5605e-02_r8/) + kbo(:, 3,37, 7) = (/ & + &1.1792e-01_r8,1.5301e-01_r8,1.3575e-01_r8,1.0102e-01_r8,1.6089e-02_r8/) + kbo(:, 4,37, 7) = (/ & + &1.5786e-01_r8,1.9811e-01_r8,1.7416e-01_r8,1.2688e-01_r8,1.6504e-02_r8/) + kbo(:, 5,37, 7) = (/ & + &2.0776e-01_r8,2.5283e-01_r8,2.2073e-01_r8,1.5856e-01_r8,1.6861e-02_r8/) + kbo(:, 1,38, 7) = (/ & + &5.7180e-02_r8,8.0434e-02_r8,7.3641e-02_r8,5.7228e-02_r8,1.2479e-02_r8/) + kbo(:, 2,38, 7) = (/ & + &8.0361e-02_r8,1.0828e-01_r8,9.6955e-02_r8,7.3200e-02_r8,1.2947e-02_r8/) + kbo(:, 3,38, 7) = (/ & + &1.1043e-01_r8,1.4379e-01_r8,1.2688e-01_r8,9.3375e-02_r8,1.3365e-02_r8/) + kbo(:, 4,38, 7) = (/ & + &1.4883e-01_r8,1.8786e-01_r8,1.6450e-01_r8,1.1879e-01_r8,1.3732e-02_r8/) + kbo(:, 5,38, 7) = (/ & + &1.9707e-01_r8,2.4129e-01_r8,2.1013e-01_r8,1.4998e-01_r8,1.4049e-02_r8/) + kbo(:, 1,39, 7) = (/ & + &5.4044e-02_r8,7.5469e-02_r8,6.8324e-02_r8,5.2315e-02_r8,1.0342e-02_r8/) + kbo(:, 2,39, 7) = (/ & + &7.6525e-02_r8,1.0279e-01_r8,9.1154e-02_r8,6.7832e-02_r8,1.0747e-02_r8/) + kbo(:, 3,39, 7) = (/ & + &1.0591e-01_r8,1.3783e-01_r8,1.2080e-01_r8,8.7775e-02_r8,1.1116e-02_r8/) + kbo(:, 4,39, 7) = (/ & + &1.4369e-01_r8,1.8148e-01_r8,1.5809e-01_r8,1.1309e-01_r8,1.1438e-02_r8/) + kbo(:, 5,39, 7) = (/ & + &1.9144e-01_r8,2.3501e-01_r8,2.0393e-01_r8,1.4445e-01_r8,1.1716e-02_r8/) + kbo(:, 1,40, 7) = (/ & + &4.6217e-02_r8,6.5370e-02_r8,5.9012e-02_r8,4.4989e-02_r8,8.5358e-03_r8/) + kbo(:, 2,40, 7) = (/ & + &6.6114e-02_r8,9.0173e-02_r8,7.9777e-02_r8,5.9045e-02_r8,8.8901e-03_r8/) + kbo(:, 3,40, 7) = (/ & + &9.2339e-02_r8,1.2222e-01_r8,1.0699e-01_r8,7.7378e-02_r8,9.2084e-03_r8/) + kbo(:, 4,40, 7) = (/ & + &1.2639e-01_r8,1.6256e-01_r8,1.4164e-01_r8,1.0101e-01_r8,9.4930e-03_r8/) + kbo(:, 5,40, 7) = (/ & + &1.6986e-01_r8,2.1255e-01_r8,1.8467e-01_r8,1.3055e-01_r8,9.7467e-03_r8/) + kbo(:, 1,41, 7) = (/ & + &3.9155e-02_r8,5.6183e-02_r8,5.0596e-02_r8,3.8424e-02_r8,7.0383e-03_r8/) + kbo(:, 2,41, 7) = (/ & + &5.6659e-02_r8,7.8503e-02_r8,6.9340e-02_r8,5.1085e-02_r8,7.3470e-03_r8/) + kbo(:, 3,41, 7) = (/ & + &7.9928e-02_r8,1.0766e-01_r8,9.4225e-02_r8,6.7858e-02_r8,7.6230e-03_r8/) + kbo(:, 4,41, 7) = (/ & + &1.1042e-01_r8,1.4475e-01_r8,1.2626e-01_r8,8.9781e-02_r8,7.8762e-03_r8/) + kbo(:, 5,41, 7) = (/ & + &1.4975e-01_r8,1.9111e-01_r8,1.6637e-01_r8,1.1739e-01_r8,8.1039e-03_r8/) + kbo(:, 1,42, 7) = (/ & + &3.3442e-02_r8,4.8574e-02_r8,4.3613e-02_r8,3.2930e-02_r8,5.8050e-03_r8/) + kbo(:, 2,42, 7) = (/ & + &4.8965e-02_r8,6.8792e-02_r8,6.0620e-02_r8,4.4408e-02_r8,6.0682e-03_r8/) + kbo(:, 3,42, 7) = (/ & + &6.9803e-02_r8,9.5533e-02_r8,8.3532e-02_r8,5.9826e-02_r8,6.3116e-03_r8/) + kbo(:, 4,42, 7) = (/ & + &9.7360e-02_r8,1.2988e-01_r8,1.1328e-01_r8,8.0240e-02_r8,6.5330e-03_r8/) + kbo(:, 5,42, 7) = (/ & + &1.3333e-01_r8,1.7321e-01_r8,1.5102e-01_r8,1.0628e-01_r8,6.7345e-03_r8/) + kbo(:, 1,43, 7) = (/ & + &2.8074e-02_r8,4.1293e-02_r8,3.7000e-02_r8,2.7812e-02_r8,4.7712e-03_r8/) + kbo(:, 2,43, 7) = (/ & + &4.1661e-02_r8,5.9380e-02_r8,5.2205e-02_r8,3.8045e-02_r8,4.9985e-03_r8/) + kbo(:, 3,43, 7) = (/ & + &6.0156e-02_r8,8.3670e-02_r8,7.3060e-02_r8,5.2075e-02_r8,5.2119e-03_r8/) + kbo(:, 4,43, 7) = (/ & + &8.4838e-02_r8,1.1520e-01_r8,1.0043e-01_r8,7.0829e-02_r8,5.4068e-03_r8/) + kbo(:, 5,43, 7) = (/ & + &1.1748e-01_r8,1.5547e-01_r8,1.3568e-01_r8,9.5209e-02_r8,5.5907e-03_r8/) + kbo(:, 1,44, 7) = (/ & + &2.3517e-02_r8,3.4984e-02_r8,3.1261e-02_r8,2.3397e-02_r8,3.9133e-03_r8/) + kbo(:, 2,44, 7) = (/ & + &3.5440e-02_r8,5.1145e-02_r8,4.4838e-02_r8,3.2508e-02_r8,4.1113e-03_r8/) + kbo(:, 3,44, 7) = (/ & + &5.1856e-02_r8,7.3218e-02_r8,6.3748e-02_r8,4.5187e-02_r8,4.2980e-03_r8/) + kbo(:, 4,44, 7) = (/ & + &7.4068e-02_r8,1.0225e-01_r8,8.9058e-02_r8,6.2496e-02_r8,4.4682e-03_r8/) + kbo(:, 5,44, 7) = (/ & + &1.0378e-01_r8,1.3965e-01_r8,1.2187e-01_r8,8.5218e-02_r8,4.6319e-03_r8/) + kbo(:, 1,45, 7) = (/ & + &1.9987e-02_r8,2.9948e-02_r8,2.6638e-02_r8,1.9815e-02_r8,3.2076e-03_r8/) + kbo(:, 2,45, 7) = (/ & + &3.0595e-02_r8,4.4514e-02_r8,3.8859e-02_r8,2.7978e-02_r8,3.3798e-03_r8/) + kbo(:, 3,45, 7) = (/ & + &4.5403e-02_r8,6.4811e-02_r8,5.6194e-02_r8,3.9557e-02_r8,3.5406e-03_r8/) + kbo(:, 4,45, 7) = (/ & + &6.5696e-02_r8,9.1866e-02_r8,7.9797e-02_r8,5.5645e-02_r8,3.6912e-03_r8/) + kbo(:, 5,45, 7) = (/ & + &9.3194e-02_r8,1.2710e-01_r8,1.1078e-01_r8,7.7097e-02_r8,3.8387e-03_r8/) + kbo(:, 1,46, 7) = (/ & + &1.6883e-02_r8,2.5455e-02_r8,2.2540e-02_r8,1.6677e-02_r8,2.6234e-03_r8/) + kbo(:, 2,46, 7) = (/ & + &2.6297e-02_r8,3.8534e-02_r8,3.3486e-02_r8,2.3954e-02_r8,2.7725e-03_r8/) + kbo(:, 3,46, 7) = (/ & + &3.9636e-02_r8,5.7120e-02_r8,4.9278e-02_r8,3.4454e-02_r8,2.9133e-03_r8/) + kbo(:, 4,46, 7) = (/ & + &5.8158e-02_r8,8.2259e-02_r8,7.1230e-02_r8,4.9351e-02_r8,3.0483e-03_r8/) + kbo(:, 5,46, 7) = (/ & + &8.3561e-02_r8,1.1543e-01_r8,1.0042e-01_r8,6.9545e-02_r8,3.1794e-03_r8/) + kbo(:, 1,47, 7) = (/ & + &1.3750e-02_r8,2.0931e-02_r8,1.8489e-02_r8,1.3652e-02_r8,2.1369e-03_r8/) + kbo(:, 2,47, 7) = (/ & + &2.1838e-02_r8,3.2305e-02_r8,2.7989e-02_r8,1.9957e-02_r8,2.2678e-03_r8/) + kbo(:, 3,47, 7) = (/ & + &3.3497e-02_r8,4.8835e-02_r8,4.1985e-02_r8,2.9214e-02_r8,2.3899e-03_r8/) + kbo(:, 4,47, 7) = (/ & + &4.9929e-02_r8,7.1624e-02_r8,6.1836e-02_r8,4.2605e-02_r8,2.5094e-03_r8/) + kbo(:, 5,47, 7) = (/ & + &7.2757e-02_r8,1.0217e-01_r8,8.8738e-02_r8,6.1180e-02_r8,2.6247e-03_r8/) + kbo(:, 1,48, 7) = (/ & + &1.1414e-02_r8,1.7437e-02_r8,1.5334e-02_r8,1.1272e-02_r8,1.7386e-03_r8/) + kbo(:, 2,48, 7) = (/ & + &1.8495e-02_r8,2.7458e-02_r8,2.3694e-02_r8,1.6798e-02_r8,1.8526e-03_r8/) + kbo(:, 3,48, 7) = (/ & + &2.8896e-02_r8,4.2355e-02_r8,3.6253e-02_r8,2.5061e-02_r8,1.9592e-03_r8/) + kbo(:, 4,48, 7) = (/ & + &4.3780e-02_r8,6.3320e-02_r8,5.4439e-02_r8,3.7255e-02_r8,2.0628e-03_r8/) + kbo(:, 5,48, 7) = (/ & + &6.4736e-02_r8,9.1889e-02_r8,7.9609e-02_r8,5.4563e-02_r8,2.1644e-03_r8/) + kbo(:, 1,49, 7) = (/ & + &9.7792e-03_r8,1.4862e-02_r8,1.2975e-02_r8,9.4608e-03_r8,1.4121e-03_r8/) + kbo(:, 2,49, 7) = (/ & + &1.6175e-02_r8,2.3898e-02_r8,2.0488e-02_r8,1.4406e-02_r8,1.5117e-03_r8/) + kbo(:, 3,49, 7) = (/ & + &2.5763e-02_r8,3.7620e-02_r8,3.1995e-02_r8,2.1936e-02_r8,1.6039e-03_r8/) + kbo(:, 4,49, 7) = (/ & + &3.9714e-02_r8,5.7411e-02_r8,4.9041e-02_r8,3.3299e-02_r8,1.6946e-03_r8/) + kbo(:, 5,49, 7) = (/ & + &5.9638e-02_r8,8.4793e-02_r8,7.3080e-02_r8,4.9749e-02_r8,1.7852e-03_r8/) + kbo(:, 1,50, 7) = (/ & + &8.0131e-03_r8,1.2216e-02_r8,1.0631e-02_r8,7.7241e-03_r8,1.1467e-03_r8/) + kbo(:, 2,50, 7) = (/ & + &1.3522e-02_r8,2.0069e-02_r8,1.7141e-02_r8,1.2008e-02_r8,1.2327e-03_r8/) + kbo(:, 3,50, 7) = (/ & + &2.1961e-02_r8,3.2239e-02_r8,2.7314e-02_r8,1.8640e-02_r8,1.3124e-03_r8/) + kbo(:, 4,50, 7) = (/ & + &3.4440e-02_r8,5.0209e-02_r8,4.2737e-02_r8,2.8885e-02_r8,1.3920e-03_r8/) + kbo(:, 5,50, 7) = (/ & + &5.2495e-02_r8,7.5521e-02_r8,6.4947e-02_r8,4.4030e-02_r8,1.4733e-03_r8/) + kbo(:, 1,51, 7) = (/ & + &6.4036e-03_r8,9.8290e-03_r8,8.5406e-03_r8,6.2032e-03_r8,9.3043e-04_r8/) + kbo(:, 2,51, 7) = (/ & + &1.1026e-02_r8,1.6501e-02_r8,1.4064e-02_r8,9.8397e-03_r8,1.0045e-03_r8/) + kbo(:, 3,51, 7) = (/ & + &1.8273e-02_r8,2.7056e-02_r8,2.2864e-02_r8,1.5565e-02_r8,1.0742e-03_r8/) + kbo(:, 4,51, 7) = (/ & + &2.9163e-02_r8,4.3028e-02_r8,3.6523e-02_r8,2.4601e-02_r8,1.1437e-03_r8/) + kbo(:, 5,51, 7) = (/ & + &4.5145e-02_r8,6.5958e-02_r8,5.6628e-02_r8,3.8264e-02_r8,1.2140e-03_r8/) + kbo(:, 1,52, 7) = (/ & + &5.2190e-03_r8,8.0088e-03_r8,6.9367e-03_r8,5.0245e-03_r8,7.5434e-04_r8/) + kbo(:, 2,52, 7) = (/ & + &9.1694e-03_r8,1.3764e-02_r8,1.1684e-02_r8,8.1486e-03_r8,8.1834e-04_r8/) + kbo(:, 3,52, 7) = (/ & + &1.5524e-02_r8,2.3049e-02_r8,1.9394e-02_r8,1.3151e-02_r8,8.7913e-04_r8/) + kbo(:, 4,52, 7) = (/ & + &2.5232e-02_r8,3.7442e-02_r8,3.1647e-02_r8,2.1215e-02_r8,9.3902e-04_r8/) + kbo(:, 5,52, 7) = (/ & + &3.9698e-02_r8,5.8529e-02_r8,5.0101e-02_r8,3.3714e-02_r8,1.0010e-03_r8/) + kbo(:, 1,53, 7) = (/ & + &4.3882e-03_r8,6.6717e-03_r8,5.7454e-03_r8,4.1343e-03_r8,6.1055e-04_r8/) + kbo(:, 2,53, 7) = (/ & + &7.8762e-03_r8,1.1762e-02_r8,9.9163e-03_r8,6.8660e-03_r8,6.6611e-04_r8/) + kbo(:, 3,53, 7) = (/ & + &1.3621e-02_r8,2.0115e-02_r8,1.6825e-02_r8,1.1330e-02_r8,7.1874e-04_r8/) + kbo(:, 4,53, 7) = (/ & + &2.2577e-02_r8,3.3386e-02_r8,2.8049e-02_r8,1.8668e-02_r8,7.7087e-04_r8/) + kbo(:, 5,53, 7) = (/ & + &3.6135e-02_r8,5.3261e-02_r8,4.5341e-02_r8,3.0337e-02_r8,8.2493e-04_r8/) + kbo(:, 1,54, 7) = (/ & + &3.2171e-03_r8,4.9791e-03_r8,4.3152e-03_r8,3.1327e-03_r8,4.9375e-04_r8/) + kbo(:, 2,54, 7) = (/ & + &5.9006e-03_r8,8.9891e-03_r8,7.6027e-03_r8,5.2931e-03_r8,5.4126e-04_r8/) + kbo(:, 3,54, 7) = (/ & + &1.0411e-02_r8,1.5699e-02_r8,1.3153e-02_r8,8.8893e-03_r8,5.8635e-04_r8/) + kbo(:, 4,54, 7) = (/ & + &1.7599e-02_r8,2.6636e-02_r8,2.2397e-02_r8,1.4923e-02_r8,6.3108e-04_r8/) + kbo(:, 5,54, 7) = (/ & + &2.8648e-02_r8,4.3428e-02_r8,3.7016e-02_r8,2.4766e-02_r8,6.7747e-04_r8/) + kbo(:, 1,55, 7) = (/ & + &2.1501e-03_r8,3.4516e-03_r8,3.0360e-03_r8,2.2475e-03_r8,3.9872e-04_r8/) + kbo(:, 2,55, 7) = (/ & + &4.0344e-03_r8,6.3713e-03_r8,5.4431e-03_r8,3.8454e-03_r8,4.3910e-04_r8/) + kbo(:, 3,55, 7) = (/ & + &7.2610e-03_r8,1.1366e-02_r8,9.5883e-03_r8,6.5518e-03_r8,4.7768e-04_r8/) + kbo(:, 4,55, 7) = (/ & + &1.2517e-02_r8,1.9714e-02_r8,1.6657e-02_r8,1.1171e-02_r8,5.1535e-04_r8/) + kbo(:, 5,55, 7) = (/ & + &2.0727e-02_r8,3.2905e-02_r8,2.8181e-02_r8,1.8908e-02_r8,5.5486e-04_r8/) + kbo(:, 1,56, 7) = (/ & + &1.4245e-03_r8,2.3749e-03_r8,2.1236e-03_r8,1.6049e-03_r8,3.2130e-04_r8/) + kbo(:, 2,56, 7) = (/ & + &2.7381e-03_r8,4.4799e-03_r8,3.8718e-03_r8,2.7798e-03_r8,3.5587e-04_r8/) + kbo(:, 3,56, 7) = (/ & + &5.0259e-03_r8,8.1674e-03_r8,6.9450e-03_r8,4.8004e-03_r8,3.8862e-04_r8/) + kbo(:, 4,56, 7) = (/ & + &8.8432e-03_r8,1.4489e-02_r8,1.2307e-02_r8,8.3071e-03_r8,4.2064e-04_r8/) + kbo(:, 5,56, 7) = (/ & + &1.4910e-02_r8,2.4779e-02_r8,2.1310e-02_r8,1.4337e-02_r8,4.5360e-04_r8/) + kbo(:, 1,57, 7) = (/ & + &9.3471e-04_r8,1.6209e-03_r8,1.4751e-03_r8,1.1411e-03_r8,2.5838e-04_r8/) + kbo(:, 2,57, 7) = (/ & + &1.8436e-03_r8,3.1233e-03_r8,2.7344e-03_r8,1.9986e-03_r8,2.8780e-04_r8/) + kbo(:, 3,57, 7) = (/ & + &3.4502e-03_r8,5.8213e-03_r8,4.9934e-03_r8,3.4957e-03_r8,3.1565e-04_r8/) + kbo(:, 4,57, 7) = (/ & + &6.2020e-03_r8,1.0562e-02_r8,9.0212e-03_r8,6.1326e-03_r8,3.4283e-04_r8/) + kbo(:, 5,57, 7) = (/ & + &1.0656e-02_r8,1.8525e-02_r8,1.5995e-02_r8,1.0788e-02_r8,3.7043e-04_r8/) + kbo(:, 1,58, 7) = (/ & + &1.6224e-04_r8,3.6080e-04_r8,4.3166e-04_r8,4.8123e-04_r8,2.0767e-04_r8/) + kbo(:, 2,58, 7) = (/ & + &3.2835e-04_r8,7.0851e-04_r8,8.1160e-04_r8,8.4893e-04_r8,2.3260e-04_r8/) + kbo(:, 3,58, 7) = (/ & + &6.2650e-04_r8,1.3493e-03_r8,1.5057e-03_r8,1.4999e-03_r8,2.5617e-04_r8/) + kbo(:, 4,58, 7) = (/ & + &1.1500e-03_r8,2.5038e-03_r8,2.7715e-03_r8,2.6635e-03_r8,2.7921e-04_r8/) + kbo(:, 5,58, 7) = (/ & + &2.0128e-03_r8,4.5008e-03_r8,5.0240e-03_r8,4.7643e-03_r8,3.0249e-04_r8/) + kbo(:, 1,59, 7) = (/ & + &1.4374e-04_r8,3.4167e-04_r8,3.9743e-04_r8,4.1474e-04_r8,1.7016e-04_r8/) + kbo(:, 2,59, 7) = (/ & + &2.9460e-04_r8,6.7320e-04_r8,7.4449e-04_r8,7.2184e-04_r8,1.9072e-04_r8/) + kbo(:, 3,59, 7) = (/ & + &5.6936e-04_r8,1.2962e-03_r8,1.3859e-03_r8,1.2659e-03_r8,2.1044e-04_r8/) + kbo(:, 4,59, 7) = (/ & + &1.0579e-03_r8,2.4467e-03_r8,2.5761e-03_r8,2.2456e-03_r8,2.2959e-04_r8/) + kbo(:, 5,59, 7) = (/ & + &1.8733e-03_r8,4.4959e-03_r8,4.7523e-03_r8,4.0463e-03_r8,2.4889e-04_r8/) + kbo(:, 1,13, 8) = (/ & + &1.0984e+01_r8,8.3644e+00_r8,5.8323e+00_r8,3.5207e+00_r8,9.5573e-01_r8/) + kbo(:, 2,13, 8) = (/ & + &1.6457e+01_r8,1.2460e+01_r8,8.5024e+00_r8,4.7543e+00_r8,9.4898e-01_r8/) + kbo(:, 3,13, 8) = (/ & + &2.3514e+01_r8,1.7749e+01_r8,1.1998e+01_r8,6.4125e+00_r8,9.3955e-01_r8/) + kbo(:, 4,13, 8) = (/ & + &3.2333e+01_r8,2.4359e+01_r8,1.6389e+01_r8,8.5253e+00_r8,9.2689e-01_r8/) + kbo(:, 5,13, 8) = (/ & + &4.3124e+01_r8,3.2448e+01_r8,2.1775e+01_r8,1.1152e+01_r8,9.1779e-01_r8/) + kbo(:, 1,14, 8) = (/ & + &6.1000e+00_r8,4.7207e+00_r8,3.5104e+00_r8,2.4718e+00_r8,9.1734e-01_r8/) + kbo(:, 2,14, 8) = (/ & + &9.1253e+00_r8,6.9681e+00_r8,4.9378e+00_r8,3.1340e+00_r8,9.1181e-01_r8/) + kbo(:, 3,14, 8) = (/ & + &1.3035e+01_r8,9.8900e+00_r8,6.8208e+00_r8,3.9957e+00_r8,9.0546e-01_r8/) + kbo(:, 4,14, 8) = (/ & + &1.7969e+01_r8,1.3584e+01_r8,9.2328e+00_r8,5.1032e+00_r8,8.9760e-01_r8/) + kbo(:, 5,14, 8) = (/ & + &2.4021e+01_r8,1.8119e+01_r8,1.2229e+01_r8,6.5133e+00_r8,8.8920e-01_r8/) + kbo(:, 1,15, 8) = (/ & + &3.4743e+00_r8,2.8067e+00_r8,2.3437e+00_r8,1.8996e+00_r8,8.7156e-01_r8/) + kbo(:, 2,15, 8) = (/ & + &5.1884e+00_r8,4.0500e+00_r8,3.1125e+00_r8,2.2977e+00_r8,8.6786e-01_r8/) + kbo(:, 3,15, 8) = (/ & + &7.4263e+00_r8,5.6964e+00_r8,4.1330e+00_r8,2.7795e+00_r8,8.6394e-01_r8/) + kbo(:, 4,15, 8) = (/ & + &1.0261e+01_r8,7.8059e+00_r8,5.4699e+00_r8,3.3858e+00_r8,8.5908e-01_r8/) + kbo(:, 5,15, 8) = (/ & + &1.3736e+01_r8,1.0405e+01_r8,7.1459e+00_r8,4.1475e+00_r8,8.5337e-01_r8/) + kbo(:, 1,16, 8) = (/ & + &2.3668e+00_r8,2.0348e+00_r8,1.8716e+00_r8,1.6135e+00_r8,8.1894e-01_r8/) + kbo(:, 2,16, 8) = (/ & + &3.5375e+00_r8,2.8566e+00_r8,2.3918e+00_r8,1.9179e+00_r8,8.1793e-01_r8/) + kbo(:, 3,16, 8) = (/ & + &5.0738e+00_r8,3.9641e+00_r8,3.0738e+00_r8,2.2799e+00_r8,8.1574e-01_r8/) + kbo(:, 4,16, 8) = (/ & + &7.0147e+00_r8,5.3888e+00_r8,3.9564e+00_r8,2.7115e+00_r8,8.1291e-01_r8/) + kbo(:, 5,16, 8) = (/ & + &9.3829e+00_r8,7.1458e+00_r8,5.0571e+00_r8,3.2258e+00_r8,8.0943e-01_r8/) + kbo(:, 1,17, 8) = (/ & + &1.6738e+00_r8,1.5709e+00_r8,1.5512e+00_r8,1.3915e+00_r8,7.6163e-01_r8/) + kbo(:, 2,17, 8) = (/ & + &2.5071e+00_r8,2.1423e+00_r8,1.9466e+00_r8,1.6331e+00_r8,7.6194e-01_r8/) + kbo(:, 3,17, 8) = (/ & + &3.5973e+00_r8,2.9044e+00_r8,2.4376e+00_r8,1.9200e+00_r8,7.6176e-01_r8/) + kbo(:, 4,17, 8) = (/ & + &4.9653e+00_r8,3.8871e+00_r8,3.0499e+00_r8,2.2591e+00_r8,7.6112e-01_r8/) + kbo(:, 5,17, 8) = (/ & + &6.6200e+00_r8,5.0972e+00_r8,3.7961e+00_r8,2.6511e+00_r8,7.6001e-01_r8/) + kbo(:, 1,18, 8) = (/ & + &1.2159e+00_r8,1.2682e+00_r8,1.3055e+00_r8,1.2114e+00_r8,6.9972e-01_r8/) + kbo(:, 2,18, 8) = (/ & + &1.8215e+00_r8,1.6846e+00_r8,1.6207e+00_r8,1.4074e+00_r8,7.0172e-01_r8/) + kbo(:, 3,18, 8) = (/ & + &2.6063e+00_r8,2.2250e+00_r8,2.0059e+00_r8,1.6407e+00_r8,7.0349e-01_r8/) + kbo(:, 4,18, 8) = (/ & + &3.5864e+00_r8,2.9083e+00_r8,2.4603e+00_r8,1.9137e+00_r8,7.0440e-01_r8/) + kbo(:, 5,18, 8) = (/ & + &4.7701e+00_r8,3.7503e+00_r8,2.9936e+00_r8,2.2226e+00_r8,7.0559e-01_r8/) + kbo(:, 1,19, 8) = (/ & + &8.6896e-01_r8,1.0218e+00_r8,1.0917e+00_r8,1.0431e+00_r8,6.3571e-01_r8/) + kbo(:, 2,19, 8) = (/ & + &1.2971e+00_r8,1.3348e+00_r8,1.3390e+00_r8,1.2022e+00_r8,6.3915e-01_r8/) + kbo(:, 3,19, 8) = (/ & + &1.8500e+00_r8,1.7190e+00_r8,1.6367e+00_r8,1.3904e+00_r8,6.4265e-01_r8/) + kbo(:, 4,19, 8) = (/ & + &2.5377e+00_r8,2.1918e+00_r8,1.9845e+00_r8,1.6067e+00_r8,6.4523e-01_r8/) + kbo(:, 5,19, 8) = (/ & + &3.3694e+00_r8,2.7695e+00_r8,2.3848e+00_r8,1.8478e+00_r8,6.4962e-01_r8/) + kbo(:, 1,20, 8) = (/ & + &6.7593e-01_r8,8.7052e-01_r8,9.5066e-01_r8,9.1950e-01_r8,5.7154e-01_r8/) + kbo(:, 2,20, 8) = (/ & + &1.0037e+00_r8,1.1265e+00_r8,1.1588e+00_r8,1.0572e+00_r8,5.7670e-01_r8/) + kbo(:, 3,20, 8) = (/ & + &1.4256e+00_r8,1.4357e+00_r8,1.4052e+00_r8,1.2186e+00_r8,5.8150e-01_r8/) + kbo(:, 4,20, 8) = (/ & + &1.9488e+00_r8,1.8041e+00_r8,1.6911e+00_r8,1.4006e+00_r8,5.8703e-01_r8/) + kbo(:, 5,20, 8) = (/ & + &2.5835e+00_r8,2.2440e+00_r8,2.0193e+00_r8,1.6034e+00_r8,5.9399e-01_r8/) + kbo(:, 1,21, 8) = (/ & + &5.4036e-01_r8,7.5420e-01_r8,8.3572e-01_r8,8.1199e-01_r8,5.0987e-01_r8/) + kbo(:, 2,21, 8) = (/ & + &7.9845e-01_r8,9.6809e-01_r8,1.0141e+00_r8,9.3456e-01_r8,5.1627e-01_r8/) + kbo(:, 3,21, 8) = (/ & + &1.1289e+00_r8,1.2252e+00_r8,1.2225e+00_r8,1.0751e+00_r8,5.2292e-01_r8/) + kbo(:, 4,21, 8) = (/ & + &1.5394e+00_r8,1.5293e+00_r8,1.4635e+00_r8,1.2321e+00_r8,5.3121e-01_r8/) + kbo(:, 5,21, 8) = (/ & + &2.0388e+00_r8,1.8858e+00_r8,1.7395e+00_r8,1.4066e+00_r8,5.4074e-01_r8/) + kbo(:, 1,22, 8) = (/ & + &4.5347e-01_r8,6.7088e-01_r8,7.4705e-01_r8,7.2463e-01_r8,4.5233e-01_r8/) + kbo(:, 2,22, 8) = (/ & + &6.6420e-01_r8,8.5466e-01_r8,9.0352e-01_r8,8.3532e-01_r8,4.6020e-01_r8/) + kbo(:, 3,22, 8) = (/ & + &9.3312e-01_r8,1.0751e+00_r8,1.0854e+00_r8,9.5995e-01_r8,4.6942e-01_r8/) + kbo(:, 4,22, 8) = (/ & + &1.2674e+00_r8,1.3357e+00_r8,1.2944e+00_r8,1.0988e+00_r8,4.8015e-01_r8/) + kbo(:, 5,22, 8) = (/ & + &1.6769e+00_r8,1.6408e+00_r8,1.5338e+00_r8,1.2527e+00_r8,4.9182e-01_r8/) + kbo(:, 1,23, 8) = (/ & + &3.8192e-01_r8,5.9551e-01_r8,6.6526e-01_r8,6.4489e-01_r8,3.9997e-01_r8/) + kbo(:, 2,23, 8) = (/ & + &5.5484e-01_r8,7.5433e-01_r8,8.0227e-01_r8,7.4370e-01_r8,4.0956e-01_r8/) + kbo(:, 3,23, 8) = (/ & + &7.7517e-01_r8,9.4347e-01_r8,9.6125e-01_r8,8.5431e-01_r8,4.2064e-01_r8/) + kbo(:, 4,23, 8) = (/ & + &1.0504e+00_r8,1.1678e+00_r8,1.1437e+00_r8,9.7728e-01_r8,4.3319e-01_r8/) + kbo(:, 5,23, 8) = (/ & + &1.3891e+00_r8,1.4314e+00_r8,1.3533e+00_r8,1.1142e+00_r8,4.4599e-01_r8/) + kbo(:, 1,24, 8) = (/ & + &3.1980e-01_r8,5.2485e-01_r8,5.8816e-01_r8,5.7121e-01_r8,3.5303e-01_r8/) + kbo(:, 2,24, 8) = (/ & + &4.6136e-01_r8,6.6155e-01_r8,7.0757e-01_r8,6.5873e-01_r8,3.6427e-01_r8/) + kbo(:, 3,24, 8) = (/ & + &6.4223e-01_r8,8.2371e-01_r8,8.4561e-01_r8,7.5649e-01_r8,3.7674e-01_r8/) + kbo(:, 4,24, 8) = (/ & + &8.6939e-01_r8,1.0172e+00_r8,1.0047e+00_r8,8.6558e-01_r8,3.8981e-01_r8/) + kbo(:, 5,24, 8) = (/ & + &1.1484e+00_r8,1.2449e+00_r8,1.1880e+00_r8,9.8717e-01_r8,4.0255e-01_r8/) + kbo(:, 1,25, 8) = (/ & + &2.7156e-01_r8,4.6457e-01_r8,5.2127e-01_r8,5.0714e-01_r8,3.1176e-01_r8/) + kbo(:, 2,25, 8) = (/ & + &3.8962e-01_r8,5.8326e-01_r8,6.2605e-01_r8,5.8521e-01_r8,3.2376e-01_r8/) + kbo(:, 3,25, 8) = (/ & + &5.4140e-01_r8,7.2573e-01_r8,7.4721e-01_r8,6.7267e-01_r8,3.3654e-01_r8/) + kbo(:, 4,25, 8) = (/ & + &7.3158e-01_r8,8.9514e-01_r8,8.8800e-01_r8,7.7033e-01_r8,3.4916e-01_r8/) + kbo(:, 5,25, 8) = (/ & + &9.6557e-01_r8,1.0940e+00_r8,1.0510e+00_r8,8.7991e-01_r8,3.6188e-01_r8/) + kbo(:, 1,26, 8) = (/ & + &2.3603e-01_r8,4.1514e-01_r8,4.6570e-01_r8,4.5317e-01_r8,2.7528e-01_r8/) + kbo(:, 2,26, 8) = (/ & + &3.3729e-01_r8,5.2062e-01_r8,5.5904e-01_r8,5.2356e-01_r8,2.8722e-01_r8/) + kbo(:, 3,26, 8) = (/ & + &4.6762e-01_r8,6.4812e-01_r8,6.6791e-01_r8,6.0289e-01_r8,2.9963e-01_r8/) + kbo(:, 4,26, 8) = (/ & + &6.3043e-01_r8,7.9949e-01_r8,7.9540e-01_r8,6.9207e-01_r8,3.1197e-01_r8/) + kbo(:, 5,26, 8) = (/ & + &8.2894e-01_r8,9.7604e-01_r8,9.4222e-01_r8,7.9275e-01_r8,3.2460e-01_r8/) + kbo(:, 1,27, 8) = (/ & + &2.1329e-01_r8,3.7886e-01_r8,4.2295e-01_r8,4.0982e-01_r8,2.4262e-01_r8/) + kbo(:, 2,27, 8) = (/ & + &3.0405e-01_r8,4.7609e-01_r8,5.0881e-01_r8,4.7490e-01_r8,2.5434e-01_r8/) + kbo(:, 3,27, 8) = (/ & + &4.2047e-01_r8,5.9404e-01_r8,6.1027e-01_r8,5.4870e-01_r8,2.6611e-01_r8/) + kbo(:, 4,27, 8) = (/ & + &5.6493e-01_r8,7.3338e-01_r8,7.2904e-01_r8,6.3251e-01_r8,2.7831e-01_r8/) + kbo(:, 5,27, 8) = (/ & + &7.3961e-01_r8,8.9452e-01_r8,8.6490e-01_r8,7.2735e-01_r8,2.9101e-01_r8/) + kbo(:, 1,28, 8) = (/ & + &1.9857e-01_r8,3.5152e-01_r8,3.8897e-01_r8,3.7421e-01_r8,2.1366e-01_r8/) + kbo(:, 2,28, 8) = (/ & + &2.8199e-01_r8,4.4350e-01_r8,4.7029e-01_r8,4.3552e-01_r8,2.2475e-01_r8/) + kbo(:, 3,28, 8) = (/ & + &3.8828e-01_r8,5.5465e-01_r8,5.6697e-01_r8,5.0558e-01_r8,2.3636e-01_r8/) + kbo(:, 4,28, 8) = (/ & + &5.1944e-01_r8,6.8554e-01_r8,6.7950e-01_r8,5.8599e-01_r8,2.4843e-01_r8/) + kbo(:, 5,28, 8) = (/ & + &6.7804e-01_r8,8.3583e-01_r8,8.0789e-01_r8,6.7686e-01_r8,2.6132e-01_r8/) + kbo(:, 1,29, 8) = (/ & + &1.9699e-01_r8,3.4001e-01_r8,3.6948e-01_r8,3.4985e-01_r8,1.8812e-01_r8/) + kbo(:, 2,29, 8) = (/ & + &2.7846e-01_r8,4.3155e-01_r8,4.5041e-01_r8,4.0987e-01_r8,1.9891e-01_r8/) + kbo(:, 3,29, 8) = (/ & + &3.8140e-01_r8,5.4168e-01_r8,5.4658e-01_r8,4.7968e-01_r8,2.1027e-01_r8/) + kbo(:, 4,29, 8) = (/ & + &5.0817e-01_r8,6.7028e-01_r8,6.5795e-01_r8,5.5982e-01_r8,2.2267e-01_r8/) + kbo(:, 5,29, 8) = (/ & + &6.6092e-01_r8,8.1811e-01_r8,7.8466e-01_r8,6.5003e-01_r8,2.3569e-01_r8/) + kbo(:, 1,30, 8) = (/ & + &2.0038e-01_r8,3.3558e-01_r8,3.5744e-01_r8,3.3111e-01_r8,1.6586e-01_r8/) + kbo(:, 2,30, 8) = (/ & + &2.8170e-01_r8,4.2849e-01_r8,4.3945e-01_r8,3.9159e-01_r8,1.7645e-01_r8/) + kbo(:, 3,30, 8) = (/ & + &3.8386e-01_r8,5.3939e-01_r8,5.3663e-01_r8,4.6240e-01_r8,1.8797e-01_r8/) + kbo(:, 4,30, 8) = (/ & + &5.0944e-01_r8,6.6904e-01_r8,6.4909e-01_r8,5.4342e-01_r8,2.0032e-01_r8/) + kbo(:, 5,30, 8) = (/ & + &6.6110e-01_r8,8.1719e-01_r8,7.7645e-01_r8,6.3464e-01_r8,2.1343e-01_r8/) + kbo(:, 1,31, 8) = (/ & + &2.1457e-01_r8,3.4491e-01_r8,3.5799e-01_r8,3.2199e-01_r8,1.4677e-01_r8/) + kbo(:, 2,31, 8) = (/ & + &3.0025e-01_r8,4.4295e-01_r8,4.4440e-01_r8,3.8528e-01_r8,1.5733e-01_r8/) + kbo(:, 3,31, 8) = (/ & + &4.0706e-01_r8,5.5909e-01_r8,5.4635e-01_r8,4.5932e-01_r8,1.6888e-01_r8/) + kbo(:, 4,31, 8) = (/ & + &5.3865e-01_r8,6.9458e-01_r8,6.6400e-01_r8,5.4394e-01_r8,1.8129e-01_r8/) + kbo(:, 5,31, 8) = (/ & + &6.9836e-01_r8,8.4979e-01_r8,7.9754e-01_r8,6.3956e-01_r8,1.9424e-01_r8/) + kbo(:, 1,32, 8) = (/ & + &2.3301e-01_r8,3.6002e-01_r8,3.6447e-01_r8,3.1806e-01_r8,1.3061e-01_r8/) + kbo(:, 2,32, 8) = (/ & + &3.2391e-01_r8,4.6378e-01_r8,4.5628e-01_r8,3.8494e-01_r8,1.4116e-01_r8/) + kbo(:, 3,32, 8) = (/ & + &4.3762e-01_r8,5.8716e-01_r8,5.6420e-01_r8,4.6300e-01_r8,1.5266e-01_r8/) + kbo(:, 4,32, 8) = (/ & + &5.7844e-01_r8,7.3058e-01_r8,6.8894e-01_r8,5.5249e-01_r8,1.6489e-01_r8/) + kbo(:, 5,32, 8) = (/ & + &7.5012e-01_r8,8.9521e-01_r8,8.3056e-01_r8,6.5369e-01_r8,1.7758e-01_r8/) + kbo(:, 1,33, 8) = (/ & + &2.5790e-01_r8,3.8312e-01_r8,3.7883e-01_r8,3.2071e-01_r8,1.1691e-01_r8/) + kbo(:, 2,33, 8) = (/ & + &3.5669e-01_r8,4.9524e-01_r8,4.7746e-01_r8,3.9236e-01_r8,1.2744e-01_r8/) + kbo(:, 3,33, 8) = (/ & + &4.8068e-01_r8,6.2777e-01_r8,5.9359e-01_r8,4.7601e-01_r8,1.3874e-01_r8/) + kbo(:, 4,33, 8) = (/ & + &6.3465e-01_r8,7.8244e-01_r8,7.2784e-01_r8,5.7215e-01_r8,1.5065e-01_r8/) + kbo(:, 5,33, 8) = (/ & + &8.2463e-01_r8,9.6158e-01_r8,8.8094e-01_r8,6.8112e-01_r8,1.6290e-01_r8/) + kbo(:, 1,34, 8) = (/ & + &2.7501e-01_r8,3.9928e-01_r8,3.8789e-01_r8,3.2093e-01_r8,1.0495e-01_r8/) + kbo(:, 2,34, 8) = (/ & + &3.7955e-01_r8,5.1722e-01_r8,4.9202e-01_r8,3.9633e-01_r8,1.1524e-01_r8/) + kbo(:, 3,34, 8) = (/ & + &5.1074e-01_r8,6.5671e-01_r8,6.1416e-01_r8,4.8473e-01_r8,1.2623e-01_r8/) + kbo(:, 4,34, 8) = (/ & + &6.7545e-01_r8,8.2065e-01_r8,7.5592e-01_r8,5.8631e-01_r8,1.3772e-01_r8/) + kbo(:, 5,34, 8) = (/ & + &8.8010e-01_r8,1.0115e+00_r8,9.1893e-01_r8,7.0176e-01_r8,1.4967e-01_r8/) + kbo(:, 1,35, 8) = (/ & + &2.8491e-01_r8,4.0792e-01_r8,3.9124e-01_r8,3.1768e-01_r8,9.3815e-02_r8/) + kbo(:, 2,35, 8) = (/ & + &3.9304e-01_r8,5.3008e-01_r8,4.9917e-01_r8,3.9612e-01_r8,1.0372e-01_r8/) + kbo(:, 3,35, 8) = (/ & + &5.3059e-01_r8,6.7569e-01_r8,6.2665e-01_r8,4.8824e-01_r8,1.1431e-01_r8/) + kbo(:, 4,35, 8) = (/ & + &7.0463e-01_r8,8.4744e-01_r8,7.7517e-01_r8,5.9483e-01_r8,1.2547e-01_r8/) + kbo(:, 5,35, 8) = (/ & + &9.2289e-01_r8,1.0490e+00_r8,9.4773e-01_r8,7.1638e-01_r8,1.3729e-01_r8/) + kbo(:, 1,36, 8) = (/ & + &2.8335e-01_r8,4.0444e-01_r8,3.8444e-01_r8,3.0785e-01_r8,8.3181e-02_r8/) + kbo(:, 2,36, 8) = (/ & + &3.9231e-01_r8,5.2837e-01_r8,4.9425e-01_r8,3.8787e-01_r8,9.2674e-02_r8/) + kbo(:, 3,36, 8) = (/ & + &5.3277e-01_r8,6.7716e-01_r8,6.2485e-01_r8,4.8257e-01_r8,1.0284e-01_r8/) + kbo(:, 4,36, 8) = (/ & + &7.1164e-01_r8,8.5400e-01_r8,7.7825e-01_r8,5.9239e-01_r8,1.1370e-01_r8/) + kbo(:, 5,36, 8) = (/ & + &9.3841e-01_r8,1.0634e+00_r8,9.5733e-01_r8,7.1881e-01_r8,1.2521e-01_r8/) + kbo(:, 1,37, 8) = (/ & + &2.6099e-01_r8,3.7794e-01_r8,3.5839e-01_r8,2.8510e-01_r8,7.2608e-02_r8/) + kbo(:, 2,37, 8) = (/ & + &3.6453e-01_r8,4.9803e-01_r8,4.6544e-01_r8,3.6354e-01_r8,8.1599e-02_r8/) + kbo(:, 3,37, 8) = (/ & + &4.9925e-01_r8,6.4313e-01_r8,5.9376e-01_r8,4.5692e-01_r8,9.1324e-02_r8/) + kbo(:, 4,37, 8) = (/ & + &6.7318e-01_r8,8.1735e-01_r8,7.4579e-01_r8,5.6616e-01_r8,1.0177e-01_r8/) + kbo(:, 5,37, 8) = (/ & + &8.9497e-01_r8,1.0258e+00_r8,9.2402e-01_r8,6.9303e-01_r8,1.1300e-01_r8/) + kbo(:, 1,38, 8) = (/ & + &2.4331e-01_r8,3.5651e-01_r8,3.3705e-01_r8,2.6611e-01_r8,6.3364e-02_r8/) + kbo(:, 2,38, 8) = (/ & + &3.4315e-01_r8,4.7401e-01_r8,4.4240e-01_r8,3.4349e-01_r8,7.1841e-02_r8/) + kbo(:, 3,38, 8) = (/ & + &4.7415e-01_r8,6.1710e-01_r8,5.6959e-01_r8,4.3645e-01_r8,8.1122e-02_r8/) + kbo(:, 4,38, 8) = (/ & + &6.4535e-01_r8,7.9084e-01_r8,7.2136e-01_r8,5.4612e-01_r8,9.1255e-02_r8/) + kbo(:, 5,38, 8) = (/ & + &8.6575e-01_r8,1.0005e+00_r8,9.0147e-01_r8,6.7461e-01_r8,1.0216e-01_r8/) + kbo(:, 1,39, 8) = (/ & + &2.3205e-01_r8,3.4217e-01_r8,3.2219e-01_r8,2.5204e-01_r8,5.5366e-02_r8/) + kbo(:, 2,39, 8) = (/ & + &3.3051e-01_r8,4.5923e-01_r8,4.2752e-01_r8,3.2956e-01_r8,6.3325e-02_r8/) + kbo(:, 3,39, 8) = (/ & + &4.6126e-01_r8,6.0310e-01_r8,5.5564e-01_r8,4.2338e-01_r8,7.2166e-02_r8/) + kbo(:, 4,39, 8) = (/ & + &6.3405e-01_r8,7.7976e-01_r8,7.0985e-01_r8,5.3501e-01_r8,8.2008e-02_r8/) + kbo(:, 5,39, 8) = (/ & + &8.5903e-01_r8,9.9488e-01_r8,8.9458e-01_r8,6.6726e-01_r8,9.2704e-02_r8/) + kbo(:, 1,40, 8) = (/ & + &2.0024e-01_r8,3.0416e-01_r8,2.8720e-01_r8,2.2448e-01_r8,4.7646e-02_r8/) + kbo(:, 2,40, 8) = (/ & + &2.8846e-01_r8,4.1256e-01_r8,3.8572e-01_r8,2.9759e-01_r8,5.5021e-02_r8/) + kbo(:, 3,40, 8) = (/ & + &4.0740e-01_r8,5.4726e-01_r8,5.0694e-01_r8,3.8698e-01_r8,6.3373e-02_r8/) + kbo(:, 4,40, 8) = (/ & + &5.6679e-01_r8,7.1454e-01_r8,6.5407e-01_r8,4.9457e-01_r8,7.2804e-02_r8/) + kbo(:, 5,40, 8) = (/ & + &7.7703e-01_r8,9.2066e-01_r8,8.3239e-01_r8,6.2266e-01_r8,8.3210e-02_r8/) + kbo(:, 1,41, 8) = (/ & + &1.7113e-01_r8,2.6826e-01_r8,2.5417e-01_r8,1.9867e-01_r8,4.0876e-02_r8/) + kbo(:, 2,41, 8) = (/ & + &2.4978e-01_r8,3.6831e-01_r8,3.4599e-01_r8,2.6723e-01_r8,4.7680e-02_r8/) + kbo(:, 3,41, 8) = (/ & + &3.5705e-01_r8,4.9395e-01_r8,4.5991e-01_r8,3.5185e-01_r8,5.5528e-02_r8/) + kbo(:, 4,41, 8) = (/ & + &5.0326e-01_r8,6.5160e-01_r8,5.9993e-01_r8,4.5499e-01_r8,6.4535e-02_r8/) + kbo(:, 5,41, 8) = (/ & + &6.9778e-01_r8,8.4752e-01_r8,7.7088e-01_r8,5.7861e-01_r8,7.4659e-02_r8/) + kbo(:, 1,42, 8) = (/ & + &1.4736e-01_r8,2.3782e-01_r8,2.2594e-01_r8,1.7650e-01_r8,3.4992e-02_r8/) + kbo(:, 2,42, 8) = (/ & + &2.1817e-01_r8,3.3087e-01_r8,3.1198e-01_r8,2.4105e-01_r8,4.1263e-02_r8/) + kbo(:, 3,42, 8) = (/ & + &3.1590e-01_r8,4.4893e-01_r8,4.1987e-01_r8,3.2183e-01_r8,4.8631e-02_r8/) + kbo(:, 4,42, 8) = (/ & + &4.5063e-01_r8,5.9836e-01_r8,5.5343e-01_r8,4.2092e-01_r8,5.7226e-02_r8/) + kbo(:, 5,42, 8) = (/ & + &6.3264e-01_r8,7.8621e-01_r8,7.1837e-01_r8,5.4085e-01_r8,6.7074e-02_r8/) + kbo(:, 1,43, 8) = (/ & + &1.2471e-01_r8,2.0767e-01_r8,1.9765e-01_r8,1.5433e-01_r8,2.9617e-02_r8/) + kbo(:, 2,43, 8) = (/ & + &1.8736e-01_r8,2.9309e-01_r8,2.7736e-01_r8,2.1438e-01_r8,3.5333e-02_r8/) + kbo(:, 3,43, 8) = (/ & + &2.7561e-01_r8,4.0307e-01_r8,3.7854e-01_r8,2.9057e-01_r8,4.2142e-02_r8/) + kbo(:, 4,43, 8) = (/ & + &3.9834e-01_r8,5.4356e-01_r8,5.0521e-01_r8,3.8507e-01_r8,5.0246e-02_r8/) + kbo(:, 5,43, 8) = (/ & + &5.6689e-01_r8,7.2237e-01_r8,6.6289e-01_r8,5.0065e-01_r8,5.9725e-02_r8/) + kbo(:, 1,44, 8) = (/ & + &1.0535e-01_r8,1.8057e-01_r8,1.7198e-01_r8,1.3418e-01_r8,2.4874e-02_r8/) + kbo(:, 2,44, 8) = (/ & + &1.6101e-01_r8,2.5912e-01_r8,2.4579e-01_r8,1.8994e-01_r8,3.0018e-02_r8/) + kbo(:, 3,44, 8) = (/ & + &2.4038e-01_r8,3.6143e-01_r8,3.4064e-01_r8,2.6166e-01_r8,3.6275e-02_r8/) + kbo(:, 4,44, 8) = (/ & + &3.5302e-01_r8,4.9391e-01_r8,4.6079e-01_r8,3.5170e-01_r8,4.3858e-02_r8/) + kbo(:, 5,44, 8) = (/ & + &5.0915e-01_r8,6.6446e-01_r8,6.1193e-01_r8,4.6316e-01_r8,5.2911e-02_r8/) + kbo(:, 1,45, 8) = (/ & + &9.0316e-02_r8,1.5846e-01_r8,1.5081e-01_r8,1.1736e-01_r8,2.0815e-02_r8/) + kbo(:, 2,45, 8) = (/ & + &1.4022e-01_r8,2.3128e-01_r8,2.1952e-01_r8,1.6935e-01_r8,2.5419e-02_r8/) + kbo(:, 3,45, 8) = (/ & + &2.1290e-01_r8,3.2756e-01_r8,3.0923e-01_r8,2.3736e-01_r8,3.1129e-02_r8/) + kbo(:, 4,45, 8) = (/ & + &3.1767e-01_r8,4.5386e-01_r8,4.2443e-01_r8,3.2399e-01_r8,3.8187e-02_r8/) + kbo(:, 5,45, 8) = (/ & + &4.6514e-01_r8,6.1840e-01_r8,5.7081e-01_r8,4.3233e-01_r8,4.6782e-02_r8/) + kbo(:, 1,46, 8) = (/ & + &7.6970e-02_r8,1.3789e-01_r8,1.3114e-01_r8,1.0166e-01_r8,1.7264e-02_r8/) + kbo(:, 2,46, 8) = (/ & + &1.2176e-01_r8,2.0534e-01_r8,1.9482e-01_r8,1.4994e-01_r8,2.1346e-02_r8/) + kbo(:, 3,46, 8) = (/ & + &1.8790e-01_r8,2.9566e-01_r8,2.7941e-01_r8,2.1415e-01_r8,2.6490e-02_r8/) + kbo(:, 4,46, 8) = (/ & + &2.8511e-01_r8,4.1574e-01_r8,3.8936e-01_r8,2.9707e-01_r8,3.3007e-02_r8/) + kbo(:, 5,46, 8) = (/ & + &4.2418e-01_r8,5.7427e-01_r8,5.3095e-01_r8,4.0219e-01_r8,4.1080e-02_r8/) + kbo(:, 1,47, 8) = (/ & + &6.3210e-02_r8,1.1622e-01_r8,1.1043e-01_r8,8.5380e-02_r8,1.4119e-02_r8/) + kbo(:, 2,47, 8) = (/ & + &1.0215e-01_r8,1.7705e-01_r8,1.6808e-01_r8,1.2908e-01_r8,1.7662e-02_r8/) + kbo(:, 3,47, 8) = (/ & + &1.6053e-01_r8,2.5968e-01_r8,2.4579e-01_r8,1.8828e-01_r8,2.2222e-02_r8/) + kbo(:, 4,47, 8) = (/ & + &2.4774e-01_r8,3.7111e-01_r8,3.4851e-01_r8,2.6604e-01_r8,2.8126e-02_r8/) + kbo(:, 5,47, 8) = (/ & + &3.7525e-01_r8,5.2022e-01_r8,4.8241e-01_r8,3.6582e-01_r8,3.5589e-02_r8/) + kbo(:, 1,48, 8) = (/ & + &5.2856e-02_r8,9.8941e-02_r8,9.3700e-02_r8,7.2138e-02_r8,1.1481e-02_r8/) + kbo(:, 2,48, 8) = (/ & + &8.7380e-02_r8,1.5439e-01_r8,1.4631e-01_r8,1.1192e-01_r8,1.4532e-02_r8/) + kbo(:, 3,48, 8) = (/ & + &1.4008e-01_r8,2.3111e-01_r8,2.1862e-01_r8,1.6701e-01_r8,1.8538e-02_r8/) + kbo(:, 4,48, 8) = (/ & + &2.2000e-01_r8,3.3600e-01_r8,3.1573e-01_r8,2.4065e-01_r8,2.3829e-02_r8/) + kbo(:, 5,48, 8) = (/ & + &3.3939e-01_r8,4.7860e-01_r8,4.4403e-01_r8,3.3641e-01_r8,3.0679e-02_r8/) + kbo(:, 1,49, 8) = (/ & + &4.5594e-02_r8,8.5787e-02_r8,8.0733e-02_r8,6.1668e-02_r8,9.2832e-03_r8/) + kbo(:, 2,49, 8) = (/ & + &7.7236e-02_r8,1.3755e-01_r8,1.2964e-01_r8,9.8500e-02_r8,1.1885e-02_r8/) + kbo(:, 3,49, 8) = (/ & + &1.2646e-01_r8,2.1033e-01_r8,1.9831e-01_r8,1.5059e-01_r8,1.5367e-02_r8/) + kbo(:, 4,49, 8) = (/ & + &2.0223e-01_r8,3.1150e-01_r8,2.9194e-01_r8,2.2146e-01_r8,2.0076e-02_r8/) + kbo(:, 5,49, 8) = (/ & + &3.1773e-01_r8,4.5116e-01_r8,4.1757e-01_r8,3.1527e-01_r8,2.6302e-02_r8/) + kbo(:, 1,50, 8) = (/ & + &3.7552e-02_r8,7.1895e-02_r8,6.7424e-02_r8,5.1302e-02_r8,7.5009e-03_r8/) + kbo(:, 2,50, 8) = (/ & + &6.5207e-02_r8,1.1840e-01_r8,1.1139e-01_r8,8.4335e-02_r8,9.7205e-03_r8/) + kbo(:, 3,50, 8) = (/ & + &1.0908e-01_r8,1.8529e-01_r8,1.7464e-01_r8,1.3230e-01_r8,1.2741e-02_r8/) + kbo(:, 4,50, 8) = (/ & + &1.7795e-01_r8,2.7969e-01_r8,2.6224e-01_r8,1.9866e-01_r8,1.6912e-02_r8/) + kbo(:, 5,50, 8) = (/ & + &2.8480e-01_r8,4.1182e-01_r8,3.8156e-01_r8,2.8786e-01_r8,2.2557e-02_r8/) + kbo(:, 1,51, 8) = (/ & + &3.0119e-02_r8,5.9038e-02_r8,5.5227e-02_r8,4.1909e-02_r8,6.0436e-03_r8/) + kbo(:, 2,51, 8) = (/ & + &5.3723e-02_r8,1.0012e-01_r8,9.4083e-02_r8,7.1011e-02_r8,7.9244e-03_r8/) + kbo(:, 3,51, 8) = (/ & + &9.1816e-02_r8,1.6026e-01_r8,1.5113e-01_r8,1.1438e-01_r8,1.0530e-02_r8/) + kbo(:, 4,51, 8) = (/ & + &1.5289e-01_r8,2.4665e-01_r8,2.3169e-01_r8,1.7549e-01_r8,1.4198e-02_r8/) + kbo(:, 5,51, 8) = (/ & + &2.4923e-01_r8,3.6941e-01_r8,3.4309e-01_r8,2.5907e-01_r8,1.9285e-02_r8/) + kbo(:, 1,52, 8) = (/ & + &2.4575e-02_r8,4.8862e-02_r8,4.5516e-02_r8,3.4388e-02_r8,4.8448e-03_r8/) + kbo(:, 2,52, 8) = (/ & + &4.5073e-02_r8,8.5520e-02_r8,8.0105e-02_r8,6.0149e-02_r8,6.4237e-03_r8/) + kbo(:, 3,52, 8) = (/ & + &7.8951e-02_r8,1.4049e-01_r8,1.3220e-01_r8,9.9732e-02_r8,8.6480e-03_r8/) + kbo(:, 4,52, 8) = (/ & + &1.3416e-01_r8,2.2067e-01_r8,2.0720e-01_r8,1.5657e-01_r8,1.1852e-02_r8/) + kbo(:, 5,52, 8) = (/ & + &2.2319e-01_r8,3.3661e-01_r8,3.1253e-01_r8,2.3574e-01_r8,1.6412e-02_r8/) + kbo(:, 1,53, 8) = (/ & + &2.0612e-02_r8,4.1138e-02_r8,3.8068e-02_r8,2.8547e-02_r8,3.8662e-03_r8/) + kbo(:, 2,53, 8) = (/ & + &3.9008e-02_r8,7.4441e-02_r8,6.9299e-02_r8,5.1635e-02_r8,5.1786e-03_r8/) + kbo(:, 3,53, 8) = (/ & + &7.0078e-02_r8,1.2575e-01_r8,1.1775e-01_r8,8.8269e-02_r8,7.0623e-03_r8/) + kbo(:, 4,53, 8) = (/ & + &1.2164e-01_r8,2.0192e-01_r8,1.8894e-01_r8,1.4209e-01_r8,9.8285e-03_r8/) + kbo(:, 5,53, 8) = (/ & + &2.0657e-01_r8,3.1414e-01_r8,2.9077e-01_r8,2.1839e-01_r8,1.3889e-02_r8/) + kbo(:, 1,54, 8) = (/ & + &1.5065e-02_r8,3.1280e-02_r8,2.9021e-02_r8,2.1865e-02_r8,3.0881e-03_r8/) + kbo(:, 2,54, 8) = (/ & + &2.9415e-02_r8,5.8678e-02_r8,5.4740e-02_r8,4.0841e-02_r8,4.1803e-03_r8/) + kbo(:, 3,54, 8) = (/ & + &5.4186e-02_r8,1.0195e-01_r8,9.5873e-02_r8,7.1991e-02_r8,5.7700e-03_r8/) + kbo(:, 4,54, 8) = (/ & + &9.6215e-02_r8,1.6747e-01_r8,1.5763e-01_r8,1.1902e-01_r8,8.1641e-03_r8/) + kbo(:, 5,54, 8) = (/ & + &1.6671e-01_r8,2.6518e-01_r8,2.4733e-01_r8,1.8663e-01_r8,1.1760e-02_r8/) + kbo(:, 1,55, 8) = (/ & + &1.0025e-02_r8,2.2183e-02_r8,2.0776e-02_r8,1.5843e-02_r8,2.4606e-03_r8/) + kbo(:, 2,55, 8) = (/ & + &2.0216e-02_r8,4.3248e-02_r8,4.0605e-02_r8,3.0502e-02_r8,3.3650e-03_r8/) + kbo(:, 3,55, 8) = (/ & + &3.8225e-02_r8,7.7452e-02_r8,7.3454e-02_r8,5.5488e-02_r8,4.7010e-03_r8/) + kbo(:, 4,55, 8) = (/ & + &6.9405e-02_r8,1.3019e-01_r8,1.2386e-01_r8,9.4370e-02_r8,6.7604e-03_r8/) + kbo(:, 5,55, 8) = (/ & + &1.2275e-01_r8,2.0976e-01_r8,1.9836e-01_r8,1.5118e-01_r8,9.9237e-03_r8/) + kbo(:, 1,56, 8) = (/ & + &6.5953e-03_r8,1.5532e-02_r8,1.4697e-02_r8,1.1369e-02_r8,1.9523e-03_r8/) + kbo(:, 2,56, 8) = (/ & + &1.3758e-02_r8,3.1499e-02_r8,2.9770e-02_r8,2.2525e-02_r8,2.6931e-03_r8/) + kbo(:, 3,56, 8) = (/ & + &2.6733e-02_r8,5.8400e-02_r8,5.5794e-02_r8,4.2378e-02_r8,3.8077e-03_r8/) + kbo(:, 4,56, 8) = (/ & + &4.9676e-02_r8,1.0081e-01_r8,9.6783e-02_r8,7.4327e-02_r8,5.5587e-03_r8/) + kbo(:, 5,56, 8) = (/ & + &8.9711e-02_r8,1.6544e-01_r8,1.5844e-01_r8,1.2195e-01_r8,8.3185e-03_r8/) + kbo(:, 1,57, 8) = (/ & + &4.2820e-03_r8,1.0722e-02_r8,1.0258e-02_r8,8.0796e-03_r8,1.5428e-03_r8/) + kbo(:, 2,57, 8) = (/ & + &9.2544e-03_r8,2.2704e-02_r8,2.1598e-02_r8,1.6468e-02_r8,2.1441e-03_r8/) + kbo(:, 3,57, 8) = (/ & + &1.8521e-02_r8,4.3686e-02_r8,4.1983e-02_r8,3.2044e-02_r8,3.0664e-03_r8/) + kbo(:, 4,57, 8) = (/ & + &3.5250e-02_r8,7.7586e-02_r8,7.5143e-02_r8,5.8070e-02_r8,4.5371e-03_r8/) + kbo(:, 5,57, 8) = (/ & + &6.5084e-02_r8,1.3004e-01_r8,1.2594e-01_r8,9.7902e-02_r8,6.9329e-03_r8/) + kbo(:, 1,58, 8) = (/ & + &7.3360e-04_r8,2.4101e-03_r8,3.0107e-03_r8,3.3982e-03_r8,1.2193e-03_r8/) + kbo(:, 2,58, 8) = (/ & + &1.6434e-03_r8,5.3110e-03_r8,6.5569e-03_r8,7.0857e-03_r8,1.7049e-03_r8/) + kbo(:, 3,58, 8) = (/ & + &3.3887e-03_r8,1.0643e-02_r8,1.3244e-02_r8,1.4263e-02_r8,2.4670e-03_r8/) + kbo(:, 4,58, 8) = (/ & + &6.6116e-03_r8,1.9492e-02_r8,2.4519e-02_r8,2.6730e-02_r8,3.7032e-03_r8/) + kbo(:, 5,58, 8) = (/ & + &1.2475e-02_r8,3.3432e-02_r8,4.2135e-02_r8,4.6396e-02_r8,5.7742e-03_r8/) + kbo(:, 1,59, 8) = (/ & + &6.5322e-04_r8,2.3892e-03_r8,2.8729e-03_r8,2.9916e-03_r8,1.0154e-03_r8/) + kbo(:, 2,59, 8) = (/ & + &1.4925e-03_r8,5.3944e-03_r8,6.3528e-03_r8,6.2709e-03_r8,1.4376e-03_r8/) + kbo(:, 3,59, 8) = (/ & + &3.1352e-03_r8,1.1095e-02_r8,1.3136e-02_r8,1.2884e-02_r8,2.1132e-03_r8/) + kbo(:, 4,59, 8) = (/ & + &6.2265e-03_r8,2.0748e-02_r8,2.4885e-02_r8,2.4670e-02_r8,3.2435e-03_r8/) + kbo(:, 5,59, 8) = (/ & + &1.1971e-02_r8,3.6140e-02_r8,4.3523e-02_r8,4.3765e-02_r8,5.1685e-03_r8/) + kbo(:, 1,13, 9) = (/ & + &7.3666e+01_r8,5.5396e+01_r8,3.7129e+01_r8,1.8928e+01_r8,2.0240e+00_r8/) + kbo(:, 2,13, 9) = (/ & + &1.0840e+02_r8,8.1447e+01_r8,5.4490e+01_r8,2.7556e+01_r8,1.9929e+00_r8/) + kbo(:, 3,13, 9) = (/ & + &1.5167e+02_r8,1.1389e+02_r8,7.6113e+01_r8,3.8343e+01_r8,1.9601e+00_r8/) + kbo(:, 4,13, 9) = (/ & + &2.0374e+02_r8,1.5294e+02_r8,1.0214e+02_r8,5.1349e+01_r8,1.9301e+00_r8/) + kbo(:, 5,13, 9) = (/ & + &2.6449e+02_r8,1.9850e+02_r8,1.3251e+02_r8,6.6525e+01_r8,1.8945e+00_r8/) + kbo(:, 1,14, 9) = (/ & + &4.2021e+01_r8,3.1664e+01_r8,2.1327e+01_r8,1.1250e+01_r8,2.1001e+00_r8/) + kbo(:, 2,14, 9) = (/ & + &6.1662e+01_r8,4.6390e+01_r8,3.1123e+01_r8,1.5991e+01_r8,2.0721e+00_r8/) + kbo(:, 3,14, 9) = (/ & + &8.6125e+01_r8,6.4733e+01_r8,4.3345e+01_r8,2.2004e+01_r8,2.0419e+00_r8/) + kbo(:, 4,14, 9) = (/ & + &1.1550e+02_r8,8.6758e+01_r8,5.8024e+01_r8,2.9304e+01_r8,2.0094e+00_r8/) + kbo(:, 5,14, 9) = (/ & + &1.4971e+02_r8,1.1242e+02_r8,7.5125e+01_r8,3.7838e+01_r8,1.9780e+00_r8/) + kbo(:, 1,15, 9) = (/ & + &2.4325e+01_r8,1.8394e+01_r8,1.2572e+01_r8,7.1971e+00_r8,2.1558e+00_r8/) + kbo(:, 2,15, 9) = (/ & + &3.5582e+01_r8,2.6831e+01_r8,1.8117e+01_r8,9.7575e+00_r8,2.1305e+00_r8/) + kbo(:, 3,15, 9) = (/ & + &4.9567e+01_r8,3.7318e+01_r8,2.5078e+01_r8,1.3071e+01_r8,2.1029e+00_r8/) + kbo(:, 4,15, 9) = (/ & + &6.6327e+01_r8,4.9885e+01_r8,3.3445e+01_r8,1.7135e+01_r8,2.0733e+00_r8/) + kbo(:, 5,15, 9) = (/ & + &8.5909e+01_r8,6.4569e+01_r8,4.3231e+01_r8,2.1949e+01_r8,2.0415e+00_r8/) + kbo(:, 1,16, 9) = (/ & + &1.6702e+01_r8,1.2688e+01_r8,8.9156e+00_r8,5.6745e+00_r8,2.1884e+00_r8/) + kbo(:, 2,16, 9) = (/ & + &2.4341e+01_r8,1.8405e+01_r8,1.2602e+01_r8,7.2943e+00_r8,2.1658e+00_r8/) + kbo(:, 3,16, 9) = (/ & + &3.3812e+01_r8,2.5504e+01_r8,1.7253e+01_r8,9.4143e+00_r8,2.1418e+00_r8/) + kbo(:, 4,16, 9) = (/ & + &4.5185e+01_r8,3.4031e+01_r8,2.2894e+01_r8,1.2063e+01_r8,2.1149e+00_r8/) + kbo(:, 5,16, 9) = (/ & + &5.8502e+01_r8,4.4016e+01_r8,2.9536e+01_r8,1.5253e+01_r8,2.0863e+00_r8/) + kbo(:, 1,17, 9) = (/ & + &1.1824e+01_r8,9.0729e+00_r8,6.6968e+00_r8,4.8304e+00_r8,2.1968e+00_r8/) + kbo(:, 2,17, 9) = (/ & + &1.7172e+01_r8,1.3045e+01_r8,9.1828e+00_r8,5.8938e+00_r8,2.1784e+00_r8/) + kbo(:, 3,17, 9) = (/ & + &2.3815e+01_r8,1.8013e+01_r8,1.2370e+01_r8,7.2830e+00_r8,2.1580e+00_r8/) + kbo(:, 4,17, 9) = (/ & + &3.1829e+01_r8,2.4018e+01_r8,1.6287e+01_r8,9.0400e+00_r8,2.1352e+00_r8/) + kbo(:, 5,17, 9) = (/ & + &4.1298e+01_r8,3.1117e+01_r8,2.0970e+01_r8,1.1193e+01_r8,2.1100e+00_r8/) + kbo(:, 1,18, 9) = (/ & + &8.5582e+00_r8,6.6960e+00_r8,5.3232e+00_r8,4.2870e+00_r8,2.1819e+00_r8/) + kbo(:, 2,18, 9) = (/ & + &1.2402e+01_r8,9.5125e+00_r8,7.0290e+00_r8,5.0519e+00_r8,2.1680e+00_r8/) + kbo(:, 3,18, 9) = (/ & + &1.7200e+01_r8,1.3071e+01_r8,9.2389e+00_r8,6.0101e+00_r8,2.1517e+00_r8/) + kbo(:, 4,18, 9) = (/ & + &2.3032e+01_r8,1.7428e+01_r8,1.2014e+01_r8,7.2086e+00_r8,2.1334e+00_r8/) + kbo(:, 5,18, 9) = (/ & + &2.9959e+01_r8,2.2618e+01_r8,1.5385e+01_r8,8.6965e+00_r8,2.1122e+00_r8/) + kbo(:, 1,19, 9) = (/ & + &6.0876e+00_r8,4.9589e+00_r8,4.3617e+00_r8,3.8537e+00_r8,2.1426e+00_r8/) + kbo(:, 2,19, 9) = (/ & + &8.8178e+00_r8,6.9019e+00_r8,5.5120e+00_r8,4.4148e+00_r8,2.1341e+00_r8/) + kbo(:, 3,19, 9) = (/ & + &1.2247e+01_r8,9.4065e+00_r8,7.0194e+00_r8,5.0977e+00_r8,2.1226e+00_r8/) + kbo(:, 4,19, 9) = (/ & + &1.6435e+01_r8,1.2508e+01_r8,8.9285e+00_r8,5.9346e+00_r8,2.1084e+00_r8/) + kbo(:, 5,19, 9) = (/ & + &2.1395e+01_r8,1.6206e+01_r8,1.1260e+01_r8,6.9507e+00_r8,2.0906e+00_r8/) + kbo(:, 1,20, 9) = (/ & + &4.7338e+00_r8,4.0618e+00_r8,3.8673e+00_r8,3.5847e+00_r8,2.0812e+00_r8/) + kbo(:, 2,20, 9) = (/ & + &6.8571e+00_r8,5.5334e+00_r8,4.7582e+00_r8,4.0685e+00_r8,2.0765e+00_r8/) + kbo(:, 3,20, 9) = (/ & + &9.5336e+00_r8,7.4447e+00_r8,5.9012e+00_r8,4.6250e+00_r8,2.0694e+00_r8/) + kbo(:, 4,20, 9) = (/ & + &1.2791e+01_r8,9.8219e+00_r8,7.3358e+00_r8,5.2854e+00_r8,2.0598e+00_r8/) + kbo(:, 5,20, 9) = (/ & + &1.6650e+01_r8,1.2677e+01_r8,9.0899e+00_r8,6.0678e+00_r8,2.0475e+00_r8/) + kbo(:, 1,21, 9) = (/ & + &3.8172e+00_r8,3.4906e+00_r8,3.5314e+00_r8,3.3393e+00_r8,1.9987e+00_r8/) + kbo(:, 2,21, 9) = (/ & + &5.5293e+00_r8,4.6505e+00_r8,4.2636e+00_r8,3.7764e+00_r8,1.9988e+00_r8/) + kbo(:, 3,21, 9) = (/ & + &7.6789e+00_r8,6.1523e+00_r8,5.1831e+00_r8,4.2770e+00_r8,1.9964e+00_r8/) + kbo(:, 4,21, 9) = (/ & + &1.0301e+01_r8,8.0282e+00_r8,6.3179e+00_r8,4.8454e+00_r8,1.9916e+00_r8/) + kbo(:, 5,21, 9) = (/ & + &1.3413e+01_r8,1.0296e+01_r8,7.6922e+00_r8,5.4909e+00_r8,1.9849e+00_r8/) + kbo(:, 1,22, 9) = (/ & + &3.2538e+00_r8,3.1636e+00_r8,3.3083e+00_r8,3.1336e+00_r8,1.8994e+00_r8/) + kbo(:, 2,22, 9) = (/ & + &4.6904e+00_r8,4.1275e+00_r8,3.9601e+00_r8,3.5392e+00_r8,1.9038e+00_r8/) + kbo(:, 3,22, 9) = (/ & + &6.4936e+00_r8,5.3647e+00_r8,4.7415e+00_r8,4.0033e+00_r8,1.9062e+00_r8/) + kbo(:, 4,22, 9) = (/ & + &8.6858e+00_r8,6.9049e+00_r8,5.6919e+00_r8,4.5273e+00_r8,1.9068e+00_r8/) + kbo(:, 5,22, 9) = (/ & + &1.1287e+01_r8,8.7705e+00_r8,6.8305e+00_r8,5.1089e+00_r8,1.9070e+00_r8/) + kbo(:, 1,23, 9) = (/ & + &2.7990e+00_r8,2.9004e+00_r8,3.0888e+00_r8,2.9221e+00_r8,1.7866e+00_r8/) + kbo(:, 2,23, 9) = (/ & + &4.0164e+00_r8,3.7193e+00_r8,3.6884e+00_r8,3.3009e+00_r8,1.7963e+00_r8/) + kbo(:, 3,23, 9) = (/ & + &5.5385e+00_r8,4.7530e+00_r8,4.3835e+00_r8,3.7336e+00_r8,1.8046e+00_r8/) + kbo(:, 4,23, 9) = (/ & + &7.3874e+00_r8,6.0323e+00_r8,5.1957e+00_r8,4.2187e+00_r8,1.8111e+00_r8/) + kbo(:, 5,23, 9) = (/ & + &9.5697e+00_r8,7.5707e+00_r8,6.1486e+00_r8,4.7536e+00_r8,1.8191e+00_r8/) + kbo(:, 1,24, 9) = (/ & + &2.4093e+00_r8,2.6666e+00_r8,2.8613e+00_r8,2.7031e+00_r8,1.6662e+00_r8/) + kbo(:, 2,24, 9) = (/ & + &3.4388e+00_r8,3.3672e+00_r8,3.4097e+00_r8,3.0567e+00_r8,1.6812e+00_r8/) + kbo(:, 3,24, 9) = (/ & + &4.7196e+00_r8,4.2384e+00_r8,4.0418e+00_r8,3.4577e+00_r8,1.6956e+00_r8/) + kbo(:, 4,24, 9) = (/ & + &6.2610e+00_r8,5.2923e+00_r8,4.7542e+00_r8,3.9053e+00_r8,1.7103e+00_r8/) + kbo(:, 5,24, 9) = (/ & + &8.0725e+00_r8,6.5459e+00_r8,5.5528e+00_r8,4.3943e+00_r8,1.7280e+00_r8/) + kbo(:, 1,25, 9) = (/ & + &2.1093e+00_r8,2.4777e+00_r8,2.6576e+00_r8,2.5025e+00_r8,1.5428e+00_r8/) + kbo(:, 2,25, 9) = (/ & + &2.9902e+00_r8,3.0964e+00_r8,3.1653e+00_r8,2.8347e+00_r8,1.5643e+00_r8/) + kbo(:, 3,25, 9) = (/ & + &4.0768e+00_r8,3.8394e+00_r8,3.7463e+00_r8,3.2106e+00_r8,1.5865e+00_r8/) + kbo(:, 4,25, 9) = (/ & + &5.3785e+00_r8,4.7237e+00_r8,4.3881e+00_r8,3.6281e+00_r8,1.6115e+00_r8/) + kbo(:, 5,25, 9) = (/ & + &6.9128e+00_r8,5.7727e+00_r8,5.0863e+00_r8,4.0788e+00_r8,1.6376e+00_r8/) + kbo(:, 1,26, 9) = (/ & + &1.8856e+00_r8,2.3262e+00_r8,2.4875e+00_r8,2.3287e+00_r8,1.4224e+00_r8/) + kbo(:, 2,26, 9) = (/ & + &2.6493e+00_r8,2.8890e+00_r8,2.9641e+00_r8,2.6458e+00_r8,1.4515e+00_r8/) + kbo(:, 3,26, 9) = (/ & + &3.5871e+00_r8,3.5368e+00_r8,3.5013e+00_r8,3.0021e+00_r8,1.4824e+00_r8/) + kbo(:, 4,26, 9) = (/ & + &4.7140e+00_r8,4.3024e+00_r8,4.0862e+00_r8,3.3950e+00_r8,1.5166e+00_r8/) + kbo(:, 5,26, 9) = (/ & + &6.0446e+00_r8,5.2045e+00_r8,4.7238e+00_r8,3.8145e+00_r8,1.5518e+00_r8/) + kbo(:, 1,27, 9) = (/ & + &1.7455e+00_r8,2.2279e+00_r8,2.3691e+00_r8,2.1938e+00_r8,1.3093e+00_r8/) + kbo(:, 2,27, 9) = (/ & + &2.4331e+00_r8,2.7544e+00_r8,2.8270e+00_r8,2.5043e+00_r8,1.3459e+00_r8/) + kbo(:, 3,27, 9) = (/ & + &3.2766e+00_r8,3.3516e+00_r8,3.3333e+00_r8,2.8520e+00_r8,1.3862e+00_r8/) + kbo(:, 4,27, 9) = (/ & + &4.2923e+00_r8,4.0432e+00_r8,3.8852e+00_r8,3.2303e+00_r8,1.4289e+00_r8/) + kbo(:, 5,27, 9) = (/ & + &5.4942e+00_r8,4.8565e+00_r8,4.4878e+00_r8,3.6320e+00_r8,1.4726e+00_r8/) + kbo(:, 1,28, 9) = (/ & + &1.6557e+00_r8,2.1623e+00_r8,2.2857e+00_r8,2.0892e+00_r8,1.2058e+00_r8/) + kbo(:, 2,28, 9) = (/ & + &2.2924e+00_r8,2.6651e+00_r8,2.7290e+00_r8,2.3996e+00_r8,1.2506e+00_r8/) + kbo(:, 3,28, 9) = (/ & + &3.0749e+00_r8,3.2332e+00_r8,3.2167e+00_r8,2.7436e+00_r8,1.2996e+00_r8/) + kbo(:, 4,28, 9) = (/ & + &4.0186e+00_r8,3.8816e+00_r8,3.7505e+00_r8,3.1131e+00_r8,1.3503e+00_r8/) + kbo(:, 5,28, 9) = (/ & + &5.1433e+00_r8,4.6442e+00_r8,4.3346e+00_r8,3.5087e+00_r8,1.4023e+00_r8/) + kbo(:, 1,29, 9) = (/ & + &1.6682e+00_r8,2.1786e+00_r8,2.2786e+00_r8,2.0447e+00_r8,1.1144e+00_r8/) + kbo(:, 2,29, 9) = (/ & + &2.2981e+00_r8,2.6823e+00_r8,2.7239e+00_r8,2.3673e+00_r8,1.1675e+00_r8/) + kbo(:, 3,29, 9) = (/ & + &3.0738e+00_r8,3.2536e+00_r8,3.2170e+00_r8,2.7185e+00_r8,1.2244e+00_r8/) + kbo(:, 4,29, 9) = (/ & + &4.0119e+00_r8,3.9041e+00_r8,3.7595e+00_r8,3.0962e+00_r8,1.2824e+00_r8/) + kbo(:, 5,29, 9) = (/ & + &5.1340e+00_r8,4.6678e+00_r8,4.3550e+00_r8,3.5038e+00_r8,1.3425e+00_r8/) + kbo(:, 1,30, 9) = (/ & + &1.7221e+00_r8,2.2297e+00_r8,2.3038e+00_r8,2.0342e+00_r8,1.0364e+00_r8/) + kbo(:, 2,30, 9) = (/ & + &2.3632e+00_r8,2.7462e+00_r8,2.7611e+00_r8,2.3703e+00_r8,1.0967e+00_r8/) + kbo(:, 3,30, 9) = (/ & + &3.1545e+00_r8,3.3332e+00_r8,3.2697e+00_r8,2.7338e+00_r8,1.1597e+00_r8/) + kbo(:, 4,30, 9) = (/ & + &4.1176e+00_r8,4.0031e+00_r8,3.8327e+00_r8,3.1282e+00_r8,1.2250e+00_r8/) + kbo(:, 5,30, 9) = (/ & + &5.2710e+00_r8,4.7910e+00_r8,4.4538e+00_r8,3.5548e+00_r8,1.2942e+00_r8/) + kbo(:, 1,31, 9) = (/ & + &1.8733e+00_r8,2.3643e+00_r8,2.4037e+00_r8,2.0831e+00_r8,9.7071e-01_r8/) + kbo(:, 2,31, 9) = (/ & + &2.5621e+00_r8,2.9163e+00_r8,2.8917e+00_r8,2.4413e+00_r8,1.0371e+00_r8/) + kbo(:, 3,31, 9) = (/ & + &3.4185e+00_r8,3.5458e+00_r8,3.4392e+00_r8,2.8321e+00_r8,1.1068e+00_r8/) + kbo(:, 4,31, 9) = (/ & + &4.4630e+00_r8,4.2725e+00_r8,4.0472e+00_r8,3.2583e+00_r8,1.1813e+00_r8/) + kbo(:, 5,31, 9) = (/ & + &5.7201e+00_r8,5.1339e+00_r8,4.7206e+00_r8,3.7217e+00_r8,1.2572e+00_r8/) + kbo(:, 1,32, 9) = (/ & + &2.0653e+00_r8,2.5337e+00_r8,2.5386e+00_r8,2.1600e+00_r8,9.1680e-01_r8/) + kbo(:, 2,32, 9) = (/ & + &2.8216e+00_r8,3.1306e+00_r8,3.0669e+00_r8,2.5463e+00_r8,9.8936e-01_r8/) + kbo(:, 3,32, 9) = (/ & + &3.7648e+00_r8,3.8151e+00_r8,3.6619e+00_r8,2.9702e+00_r8,1.0685e+00_r8/) + kbo(:, 4,32, 9) = (/ & + &4.9201e+00_r8,4.6180e+00_r8,4.3259e+00_r8,3.4358e+00_r8,1.1502e+00_r8/) + kbo(:, 5,32, 9) = (/ & + &6.3088e+00_r8,5.5739e+00_r8,5.0619e+00_r8,3.9444e+00_r8,1.2333e+00_r8/) + kbo(:, 1,33, 9) = (/ & + &2.3272e+00_r8,2.7583e+00_r8,2.7254e+00_r8,2.2760e+00_r8,8.7514e-01_r8/) + kbo(:, 2,33, 9) = (/ & + &3.1779e+00_r8,3.4161e+00_r8,3.3066e+00_r8,2.6982e+00_r8,9.5639e-01_r8/) + kbo(:, 3,33, 9) = (/ & + &4.2411e+00_r8,4.1786e+00_r8,3.9626e+00_r8,3.1651e+00_r8,1.0431e+00_r8/) + kbo(:, 4,33, 9) = (/ & + &5.5462e+00_r8,5.0836e+00_r8,4.6978e+00_r8,3.6805e+00_r8,1.1309e+00_r8/) + kbo(:, 5,33, 9) = (/ & + &7.1174e+00_r8,6.1675e+00_r8,5.5124e+00_r8,4.2455e+00_r8,1.2216e+00_r8/) + kbo(:, 1,34, 9) = (/ & + &2.5377e+00_r8,2.9389e+00_r8,2.8782e+00_r8,2.3730e+00_r8,8.4364e-01_r8/) + kbo(:, 2,34, 9) = (/ & + &3.4681e+00_r8,3.6495e+00_r8,3.5041e+00_r8,2.8278e+00_r8,9.3211e-01_r8/) + kbo(:, 3,34, 9) = (/ & + &4.6355e+00_r8,4.4791e+00_r8,4.2141e+00_r8,3.3332e+00_r8,1.0240e+00_r8/) + kbo(:, 4,34, 9) = (/ & + &6.0678e+00_r8,5.4727e+00_r8,5.0128e+00_r8,3.8930e+00_r8,1.1193e+00_r8/) + kbo(:, 5,34, 9) = (/ & + &7.8056e+00_r8,6.6744e+00_r8,5.8925e+00_r8,4.5074e+00_r8,1.2154e+00_r8/) + kbo(:, 1,35, 9) = (/ & + &2.6973e+00_r8,3.0775e+00_r8,2.9953e+00_r8,2.4483e+00_r8,8.1381e-01_r8/) + kbo(:, 2,35, 9) = (/ & + &3.6991e+00_r8,3.8360e+00_r8,3.6636e+00_r8,2.9345e+00_r8,9.0760e-01_r8/) + kbo(:, 3,35, 9) = (/ & + &4.9601e+00_r8,4.7300e+00_r8,4.4278e+00_r8,3.4777e+00_r8,1.0051e+00_r8/) + kbo(:, 4,35, 9) = (/ & + &6.5186e+00_r8,5.8127e+00_r8,5.2832e+00_r8,4.0814e+00_r8,1.1048e+00_r8/) + kbo(:, 5,35, 9) = (/ & + &8.4126e+00_r8,7.1259e+00_r8,6.2273e+00_r8,4.7423e+00_r8,1.2066e+00_r8/) + kbo(:, 1,36, 9) = (/ & + &2.7598e+00_r8,3.1389e+00_r8,3.0464e+00_r8,2.4794e+00_r8,7.8185e-01_r8/) + kbo(:, 2,36, 9) = (/ & + &3.8096e+00_r8,3.9341e+00_r8,3.7503e+00_r8,2.9909e+00_r8,8.7896e-01_r8/) + kbo(:, 3,36, 9) = (/ & + &5.1379e+00_r8,4.8766e+00_r8,4.5549e+00_r8,3.5652e+00_r8,9.8107e-01_r8/) + kbo(:, 4,36, 9) = (/ & + &6.7937e+00_r8,6.0302e+00_r8,5.4578e+00_r8,4.2069e+00_r8,1.0852e+00_r8/) + kbo(:, 5,36, 9) = (/ & + &8.8141e+00_r8,7.4326e+00_r8,6.4589e+00_r8,4.9083e+00_r8,1.1912e+00_r8/) + kbo(:, 1,37, 9) = (/ & + &2.6230e+00_r8,3.0408e+00_r8,2.9596e+00_r8,2.4124e+00_r8,7.3962e-01_r8/) + kbo(:, 2,37, 9) = (/ & + &3.6580e+00_r8,3.8393e+00_r8,3.6702e+00_r8,2.9331e+00_r8,8.3992e-01_r8/) + kbo(:, 3,37, 9) = (/ & + &4.9824e+00_r8,4.7866e+00_r8,4.4878e+00_r8,3.5210e+00_r8,9.4491e-01_r8/) + kbo(:, 4,37, 9) = (/ & + &6.6454e+00_r8,5.9484e+00_r8,5.4110e+00_r8,4.1812e+00_r8,1.0538e+00_r8/) + kbo(:, 5,37, 9) = (/ & + &8.6934e+00_r8,7.3704e+00_r8,6.4379e+00_r8,4.9067e+00_r8,1.1625e+00_r8/) + kbo(:, 1,38, 9) = (/ & + &2.5251e+00_r8,2.9721e+00_r8,2.8975e+00_r8,2.3630e+00_r8,7.0093e-01_r8/) + kbo(:, 2,38, 9) = (/ & + &3.5600e+00_r8,3.7826e+00_r8,3.6219e+00_r8,2.8967e+00_r8,8.0383e-01_r8/) + kbo(:, 3,38, 9) = (/ & + &4.9004e+00_r8,4.7489e+00_r8,4.4611e+00_r8,3.5032e+00_r8,9.1176e-01_r8/) + kbo(:, 4,38, 9) = (/ & + &6.5939e+00_r8,5.9343e+00_r8,5.4149e+00_r8,4.1893e+00_r8,1.0245e+00_r8/) + kbo(:, 5,38, 9) = (/ & + &8.7067e+00_r8,7.4030e+00_r8,6.4798e+00_r8,4.9449e+00_r8,1.1358e+00_r8/) + kbo(:, 1,39, 9) = (/ & + &2.4904e+00_r8,2.9537e+00_r8,2.8793e+00_r8,2.3443e+00_r8,6.6673e-01_r8/) + kbo(:, 2,39, 9) = (/ & + &3.5509e+00_r8,3.7917e+00_r8,3.6298e+00_r8,2.8981e+00_r8,7.7181e-01_r8/) + kbo(:, 3,39, 9) = (/ & + &4.9392e+00_r8,4.7973e+00_r8,4.5055e+00_r8,3.5337e+00_r8,8.8209e-01_r8/) + kbo(:, 4,39, 9) = (/ & + &6.7119e+00_r8,6.0406e+00_r8,5.5079e+00_r8,4.2551e+00_r8,9.9828e-01_r8/) + kbo(:, 5,39, 9) = (/ & + &8.9447e+00_r8,7.5957e+00_r8,6.6321e+00_r8,5.0544e+00_r8,1.1121e+00_r8/) + kbo(:, 1,40, 9) = (/ & + &2.2209e+00_r8,2.7364e+00_r8,2.6885e+00_r8,2.2038e+00_r8,6.2428e-01_r8/) + kbo(:, 2,40, 9) = (/ & + &3.2135e+00_r8,3.5469e+00_r8,3.4206e+00_r8,2.7501e+00_r8,7.3025e-01_r8/) + kbo(:, 3,40, 9) = (/ & + &4.5302e+00_r8,4.5210e+00_r8,4.2832e+00_r8,3.3810e+00_r8,8.4222e-01_r8/) + kbo(:, 4,40, 9) = (/ & + &6.2335e+00_r8,5.7214e+00_r8,5.2769e+00_r8,4.1014e+00_r8,9.6000e-01_r8/) + kbo(:, 5,40, 9) = (/ & + &8.4037e+00_r8,7.2349e+00_r8,6.3985e+00_r8,4.9070e+00_r8,1.0766e+00_r8/) + kbo(:, 1,41, 9) = (/ & + &1.9647e+00_r8,2.5201e+00_r8,2.4974e+00_r8,2.0614e+00_r8,5.8325e-01_r8/) + kbo(:, 2,41, 9) = (/ & + &2.8852e+00_r8,3.2999e+00_r8,3.2081e+00_r8,2.5978e+00_r8,6.8959e-01_r8/) + kbo(:, 3,41, 9) = (/ & + &4.1243e+00_r8,4.2421e+00_r8,4.0540e+00_r8,3.2221e+00_r8,8.0263e-01_r8/) + kbo(:, 4,41, 9) = (/ & + &5.7517e+00_r8,5.3978e+00_r8,5.0364e+00_r8,3.9392e+00_r8,9.2181e-01_r8/) + kbo(:, 5,41, 9) = (/ & + &7.8523e+00_r8,6.8657e+00_r8,6.1521e+00_r8,4.7480e+00_r8,1.0405e+00_r8/) + kbo(:, 1,42, 9) = (/ & + &1.7512e+00_r8,2.3349e+00_r8,2.3318e+00_r8,1.9366e+00_r8,5.4463e-01_r8/) + kbo(:, 2,42, 9) = (/ & + &2.6144e+00_r8,3.0905e+00_r8,3.0258e+00_r8,2.4663e+00_r8,6.5106e-01_r8/) + kbo(:, 3,42, 9) = (/ & + &3.7920e+00_r8,4.0117e+00_r8,3.8605e+00_r8,3.0859e+00_r8,7.6489e-01_r8/) + kbo(:, 4,42, 9) = (/ & + &5.3603e+00_r8,5.1368e+00_r8,4.8392e+00_r8,3.8039e+00_r8,8.8471e-01_r8/) + kbo(:, 5,42, 9) = (/ & + &7.4143e+00_r8,6.5758e+00_r8,5.9582e+00_r8,4.6208e+00_r8,1.0054e+00_r8/) + kbo(:, 1,43, 9) = (/ & + &1.5310e+00_r8,2.1360e+00_r8,2.1508e+00_r8,1.7978e+00_r8,5.0265e-01_r8/) + kbo(:, 2,43, 9) = (/ & + &2.3335e+00_r8,2.8636e+00_r8,2.8240e+00_r8,2.3172e+00_r8,6.0791e-01_r8/) + kbo(:, 3,43, 9) = (/ & + &3.4398e+00_r8,3.7600e+00_r8,3.6428e+00_r8,2.9301e+00_r8,7.2170e-01_r8/) + kbo(:, 4,43, 9) = (/ & + &4.9392e+00_r8,4.8535e+00_r8,4.6142e+00_r8,3.6458e+00_r8,8.4218e-01_r8/) + kbo(:, 5,43, 9) = (/ & + &6.9338e+00_r8,6.2557e+00_r8,5.7358e+00_r8,4.4687e+00_r8,9.6366e-01_r8/) + kbo(:, 1,44, 9) = (/ & + &1.3351e+00_r8,1.9503e+00_r8,1.9789e+00_r8,1.6632e+00_r8,4.6023e-01_r8/) + kbo(:, 2,44, 9) = (/ & + &2.0772e+00_r8,2.6507e+00_r8,2.6321e+00_r8,2.1724e+00_r8,5.6381e-01_r8/) + kbo(:, 3,44, 9) = (/ & + &3.1248e+00_r8,3.5269e+00_r8,3.4366e+00_r8,2.7797e+00_r8,6.7693e-01_r8/) + kbo(:, 4,44, 9) = (/ & + &4.5611e+00_r8,4.5989e+00_r8,4.4033e+00_r8,3.4949e+00_r8,7.9737e-01_r8/) + kbo(:, 5,44, 9) = (/ & + &6.5042e+00_r8,5.9719e+00_r8,5.5317e+00_r8,4.3254e+00_r8,9.1937e-01_r8/) + kbo(:, 1,45, 9) = (/ & + &1.1794e+00_r8,1.7969e+00_r8,1.8343e+00_r8,1.5476e+00_r8,4.2007e-01_r8/) + kbo(:, 2,45, 9) = (/ & + &1.8762e+00_r8,2.4795e+00_r8,2.4742e+00_r8,2.0501e+00_r8,5.2163e-01_r8/) + kbo(:, 3,45, 9) = (/ & + &2.8809e+00_r8,3.3442e+00_r8,3.2721e+00_r8,2.6566e+00_r8,6.3409e-01_r8/) + kbo(:, 4,45, 9) = (/ & + &4.2825e+00_r8,4.4131e+00_r8,4.2443e+00_r8,3.3788e+00_r8,7.5354e-01_r8/) + kbo(:, 5,45, 9) = (/ & + &6.2077e+00_r8,5.7830e+00_r8,5.3934e+00_r8,4.2249e+00_r8,8.7651e-01_r8/) + kbo(:, 1,46, 9) = (/ & + &1.0327e+00_r8,1.6453e+00_r8,1.6900e+00_r8,1.4307e+00_r8,3.8001e-01_r8/) + kbo(:, 2,46, 9) = (/ & + &1.6840e+00_r8,2.3071e+00_r8,2.3154e+00_r8,1.9251e+00_r8,4.7892e-01_r8/) + kbo(:, 3,46, 9) = (/ & + &2.6449e+00_r8,3.1623e+00_r8,3.1054e+00_r8,2.5294e+00_r8,5.8968e-01_r8/) + kbo(:, 4,46, 9) = (/ & + &4.0149e+00_r8,4.2299e+00_r8,4.0828e+00_r8,3.2577e+00_r8,7.0805e-01_r8/) + kbo(:, 5,46, 9) = (/ & + &5.9211e+00_r8,5.5984e+00_r8,5.2528e+00_r8,4.1223e+00_r8,8.3110e-01_r8/) + kbo(:, 1,47, 9) = (/ & + &8.6791e-01_r8,1.4650e+00_r8,1.5175e+00_r8,1.2909e+00_r8,3.3829e-01_r8/) + kbo(:, 2,47, 9) = (/ & + &1.4548e+00_r8,2.0919e+00_r8,2.1155e+00_r8,1.7684e+00_r8,4.3374e-01_r8/) + kbo(:, 3,47, 9) = (/ & + &2.3437e+00_r8,2.9171e+00_r8,2.8820e+00_r8,2.3592e+00_r8,5.4146e-01_r8/) + kbo(:, 4,47, 9) = (/ & + &3.6410e+00_r8,3.9658e+00_r8,3.8455e+00_r8,3.0807e+00_r8,6.5808e-01_r8/) + kbo(:, 5,47, 9) = (/ & + &5.4757e+00_r8,5.2982e+00_r8,5.0168e+00_r8,3.9488e+00_r8,7.8042e-01_r8/) + kbo(:, 1,48, 9) = (/ & + &7.4197e-01_r8,1.3175e+00_r8,1.3727e+00_r8,1.1710e+00_r8,2.9912e-01_r8/) + kbo(:, 2,48, 9) = (/ & + &1.2795e+00_r8,1.9175e+00_r8,1.9504e+00_r8,1.6359e+00_r8,3.9088e-01_r8/) + kbo(:, 3,48, 9) = (/ & + &2.1163e+00_r8,2.7243e+00_r8,2.7026e+00_r8,2.2191e+00_r8,4.9535e-01_r8/) + kbo(:, 4,48, 9) = (/ & + &3.3685e+00_r8,3.7692e+00_r8,3.6648e+00_r8,2.9415e+00_r8,6.0991e-01_r8/) + kbo(:, 5,48, 9) = (/ & + &5.1784e+00_r8,5.1043e+00_r8,4.8553e+00_r8,3.8227e+00_r8,7.3131e-01_r8/) + kbo(:, 1,49, 9) = (/ & + &6.5229e-01_r8,1.2051e+00_r8,1.2591e+00_r8,1.0738e+00_r8,2.6269e-01_r8/) + kbo(:, 2,49, 9) = (/ & + &1.1591e+00_r8,1.7908e+00_r8,1.8269e+00_r8,1.5329e+00_r8,3.5032e-01_r8/) + kbo(:, 3,49, 9) = (/ & + &1.9719e+00_r8,2.5959e+00_r8,2.5784e+00_r8,2.1177e+00_r8,4.5127e-01_r8/) + kbo(:, 4,49, 9) = (/ & + &3.2176e+00_r8,3.6617e+00_r8,3.5592e+00_r8,2.8538e+00_r8,5.6309e-01_r8/) + kbo(:, 5,49, 9) = (/ & + &5.0660e+00_r8,5.0444e+00_r8,4.7964e+00_r8,3.7669e+00_r8,6.8298e-01_r8/) + kbo(:, 1,50, 9) = (/ & + &5.4718e-01_r8,1.0700e+00_r8,1.1242e+00_r8,9.6269e-01_r8,2.3041e-01_r8/) + kbo(:, 2,50, 9) = (/ & + &1.0029e+00_r8,1.6230e+00_r8,1.6660e+00_r8,1.4048e+00_r8,3.1350e-01_r8/) + kbo(:, 3,50, 9) = (/ & + &1.7557e+00_r8,2.3977e+00_r8,2.3952e+00_r8,1.9754e+00_r8,4.1052e-01_r8/) + kbo(:, 4,50, 9) = (/ & + &2.9398e+00_r8,3.4467e+00_r8,3.3608e+00_r8,2.7053e+00_r8,5.1916e-01_r8/) + kbo(:, 5,50, 9) = (/ & + &4.7374e+00_r8,4.8217e+00_r8,4.6033e+00_r8,3.6228e+00_r8,6.3755e-01_r8/) + kbo(:, 1,51, 9) = (/ & + &4.4659e-01_r8,9.3305e-01_r8,9.8713e-01_r8,8.5042e-01_r8,2.0131e-01_r8/) + kbo(:, 2,51, 9) = (/ & + &8.4503e-01_r8,1.4458e+00_r8,1.4962e+00_r8,1.2698e+00_r8,2.7950e-01_r8/) + kbo(:, 3,51, 9) = (/ & + &1.5227e+00_r8,2.1776e+00_r8,2.1908e+00_r8,1.8185e+00_r8,3.7211e-01_r8/) + kbo(:, 4,51, 9) = (/ & + &2.6197e+00_r8,3.1878e+00_r8,3.1271e+00_r8,2.5305e+00_r8,4.7775e-01_r8/) + kbo(:, 5,51, 9) = (/ & + &4.3246e+00_r8,4.5333e+00_r8,4.3504e+00_r8,3.4392e+00_r8,5.9331e-01_r8/) + kbo(:, 1,52, 9) = (/ & + &3.7000e-01_r8,8.2088e-01_r8,8.7232e-01_r8,7.5398e-01_r8,1.7473e-01_r8/) + kbo(:, 2,52, 9) = (/ & + &7.2411e-01_r8,1.3013e+00_r8,1.3548e+00_r8,1.1545e+00_r8,2.4775e-01_r8/) + kbo(:, 3,52, 9) = (/ & + &1.3455e+00_r8,2.0001e+00_r8,2.0236e+00_r8,1.6871e+00_r8,3.3555e-01_r8/) + kbo(:, 4,52, 9) = (/ & + &2.3815e+00_r8,2.9886e+00_r8,2.9408e+00_r8,2.3888e+00_r8,4.3798e-01_r8/) + kbo(:, 5,52, 9) = (/ & + &4.0315e+00_r8,4.3264e+00_r8,4.1654e+00_r8,3.2990e+00_r8,5.5079e-01_r8/) + kbo(:, 1,53, 9) = (/ & + &3.1522e-01_r8,7.3236e-01_r8,7.7935e-01_r8,6.7369e-01_r8,1.5034e-01_r8/) + kbo(:, 2,53, 9) = (/ & + &6.3787e-01_r8,1.1908e+00_r8,1.2433e+00_r8,1.0610e+00_r8,2.1835e-01_r8/) + kbo(:, 3,53, 9) = (/ & + &1.2250e+00_r8,1.8717e+00_r8,1.8985e+00_r8,1.5852e+00_r8,3.0124e-01_r8/) + kbo(:, 4,53, 9) = (/ & + &2.2328e+00_r8,2.8593e+00_r8,2.8149e+00_r8,2.2876e+00_r8,3.9993e-01_r8/) + kbo(:, 5,53, 9) = (/ & + &3.8806e+00_r8,4.2255e+00_r8,4.0654e+00_r8,3.2164e+00_r8,5.0965e-01_r8/) + kbo(:, 1,54, 9) = (/ & + &2.3422e-01_r8,6.0076e-01_r8,6.4671e-01_r8,5.6503e-01_r8,1.2928e-01_r8/) + kbo(:, 2,54, 9) = (/ & + &4.9005e-01_r8,1.0010e+00_r8,1.0587e+00_r8,9.1460e-01_r8,1.9217e-01_r8/) + kbo(:, 3,54, 9) = (/ & + &9.7166e-01_r8,1.6014e+00_r8,1.6473e+00_r8,1.3943e+00_r8,2.7068e-01_r8/) + kbo(:, 4,54, 9) = (/ & + &1.8237e+00_r8,2.4909e+00_r8,2.4828e+00_r8,2.0443e+00_r8,3.6438e-01_r8/) + kbo(:, 5,54, 9) = (/ & + &3.2575e+00_r8,3.7456e+00_r8,3.6419e+00_r8,2.9148e+00_r8,4.7112e-01_r8/) + kbo(:, 1,55, 9) = (/ & + &1.5838e-01_r8,4.6639e-01_r8,5.1049e-01_r8,4.5411e-01_r8,1.1083e-01_r8/) + kbo(:, 2,55, 9) = (/ & + &3.4306e-01_r8,7.9590e-01_r8,8.5878e-01_r8,7.5589e-01_r8,1.6856e-01_r8/) + kbo(:, 3,55, 9) = (/ & + &7.0266e-01_r8,1.2949e+00_r8,1.3605e+00_r8,1.1760e+00_r8,2.4233e-01_r8/) + kbo(:, 4,55, 9) = (/ & + &1.3593e+00_r8,2.0439e+00_r8,2.0790e+00_r8,1.7490e+00_r8,3.3108e-01_r8/) + kbo(:, 5,55, 9) = (/ & + &2.4959e+00_r8,3.1221e+00_r8,3.0894e+00_r8,2.5235e+00_r8,4.3367e-01_r8/) + kbo(:, 1,56, 9) = (/ & + &1.0564e-01_r8,3.5968e-01_r8,4.0062e-01_r8,3.6250e-01_r8,9.4093e-02_r8/) + kbo(:, 2,56, 9) = (/ & + &2.3778e-01_r8,6.3076e-01_r8,6.9353e-01_r8,6.2192e-01_r8,1.4691e-01_r8/) + kbo(:, 3,56, 9) = (/ & + &5.0289e-01_r8,1.0440e+00_r8,1.1212e+00_r8,9.8957e-01_r8,2.1564e-01_r8/) + kbo(:, 4,56, 9) = (/ & + &1.0047e+00_r8,1.6731e+00_r8,1.7388e+00_r8,1.4948e+00_r8,2.9947e-01_r8/) + kbo(:, 5,56, 9) = (/ & + &1.8976e+00_r8,2.5969e+00_r8,2.6179e+00_r8,2.1832e+00_r8,3.9803e-01_r8/) + kbo(:, 1,57, 9) = (/ & + &6.9404e-02_r8,2.7490e-01_r8,3.1190e-01_r8,2.8693e-01_r8,7.9174e-02_r8/) + kbo(:, 2,57, 9) = (/ & + &1.6275e-01_r8,4.9714e-01_r8,5.5717e-01_r8,5.0875e-01_r8,1.2713e-01_r8/) + kbo(:, 3,57, 9) = (/ & + &3.5620e-01_r8,8.3998e-01_r8,9.2115e-01_r8,8.2990e-01_r8,1.9063e-01_r8/) + kbo(:, 4,57, 9) = (/ & + &7.3515e-01_r8,1.3656e+00_r8,1.4515e+00_r8,1.2750e+00_r8,2.6981e-01_r8/) + kbo(:, 5,57, 9) = (/ & + &1.4305e+00_r8,2.1547e+00_r8,2.2152e+00_r8,1.8869e+00_r8,3.6361e-01_r8/) + kbo(:, 1,58, 9) = (/ & + &1.2018e-02_r8,6.8819e-02_r8,1.0253e-01_r8,1.3454e-01_r8,6.6409e-02_r8/) + kbo(:, 2,58, 9) = (/ & + &2.9376e-02_r8,1.2869e-01_r8,1.8932e-01_r8,2.4688e-01_r8,1.0988e-01_r8/) + kbo(:, 3,58, 9) = (/ & + &6.6678e-02_r8,2.2200e-01_r8,3.2071e-01_r8,4.1332e-01_r8,1.6852e-01_r8/) + kbo(:, 4,58, 9) = (/ & + &1.4218e-01_r8,3.6629e-01_r8,5.1309e-01_r8,6.4691e-01_r8,2.4300e-01_r8/) + kbo(:, 5,58, 9) = (/ & + &2.8506e-01_r8,5.8551e-01_r8,7.9229e-01_r8,9.6816e-01_r8,3.3198e-01_r8/) + kbo(:, 1,59, 9) = (/ & + &1.0974e-02_r8,7.7674e-02_r8,1.1174e-01_r8,1.3484e-01_r8,6.0877e-02_r8/) + kbo(:, 2,59, 9) = (/ & + &2.7572e-02_r8,1.4726e-01_r8,2.0947e-01_r8,2.5117e-01_r8,1.0237e-01_r8/) + kbo(:, 3,59, 9) = (/ & + &6.4218e-02_r8,2.5542e-01_r8,3.5789e-01_r8,4.2487e-01_r8,1.5885e-01_r8/) + kbo(:, 4,59, 9) = (/ & + &1.3998e-01_r8,4.2159e-01_r8,5.7382e-01_r8,6.6846e-01_r8,2.3069e-01_r8/) + kbo(:, 5,59, 9) = (/ & + &2.8653e-01_r8,6.7350e-01_r8,8.8507e-01_r8,9.9974e-01_r8,3.1701e-01_r8/) + kbo(:, 1,13,10) = (/ & + &3.0887e+02_r8,2.3182e+02_r8,1.5477e+02_r8,7.7734e+01_r8,3.2340e+00_r8/) + kbo(:, 2,13,10) = (/ & + &4.5010e+02_r8,3.3773e+02_r8,2.2537e+02_r8,1.1301e+02_r8,3.1679e+00_r8/) + kbo(:, 3,13,10) = (/ & + &6.1970e+02_r8,4.6492e+02_r8,3.1014e+02_r8,1.5536e+02_r8,3.1118e+00_r8/) + kbo(:, 4,13,10) = (/ & + &8.1413e+02_r8,6.1074e+02_r8,4.0734e+02_r8,2.0395e+02_r8,3.0351e+00_r8/) + kbo(:, 5,13,10) = (/ & + &1.0345e+03_r8,7.7604e+02_r8,5.1753e+02_r8,2.5903e+02_r8,2.9847e+00_r8/) + kbo(:, 1,14,10) = (/ & + &1.8722e+02_r8,1.4057e+02_r8,9.3932e+01_r8,4.7308e+01_r8,3.5502e+00_r8/) + kbo(:, 2,14,10) = (/ & + &2.7007e+02_r8,2.0269e+02_r8,1.3533e+02_r8,6.7970e+01_r8,3.4874e+00_r8/) + kbo(:, 3,14,10) = (/ & + &3.6889e+02_r8,2.7681e+02_r8,1.8473e+02_r8,9.2654e+01_r8,3.4323e+00_r8/) + kbo(:, 4,14,10) = (/ & + &4.8380e+02_r8,3.6298e+02_r8,2.4217e+02_r8,1.2136e+02_r8,3.3766e+00_r8/) + kbo(:, 5,14,10) = (/ & + &6.1384e+02_r8,4.6051e+02_r8,3.0717e+02_r8,1.5385e+02_r8,3.3022e+00_r8/) + kbo(:, 1,15,10) = (/ & + &1.1327e+02_r8,8.5100e+01_r8,5.6942e+01_r8,2.8827e+01_r8,3.8722e+00_r8/) + kbo(:, 2,15,10) = (/ & + &1.6194e+02_r8,1.2160e+02_r8,8.1262e+01_r8,4.0948e+01_r8,3.8151e+00_r8/) + kbo(:, 3,15,10) = (/ & + &2.2047e+02_r8,1.6549e+02_r8,1.1051e+02_r8,5.5552e+01_r8,3.7597e+00_r8/) + kbo(:, 4,15,10) = (/ & + &2.8853e+02_r8,2.1653e+02_r8,1.4453e+02_r8,7.2538e+01_r8,3.6967e+00_r8/) + kbo(:, 5,15,10) = (/ & + &3.6531e+02_r8,2.7411e+02_r8,1.8291e+02_r8,9.1708e+01_r8,3.6313e+00_r8/) + kbo(:, 1,16,10) = (/ & + &8.0065e+01_r8,6.0189e+01_r8,4.0328e+01_r8,2.0552e+01_r8,4.2109e+00_r8/) + kbo(:, 2,16,10) = (/ & + &1.1401e+02_r8,8.5639e+01_r8,5.7279e+01_r8,2.8971e+01_r8,4.1507e+00_r8/) + kbo(:, 3,16,10) = (/ & + &1.5472e+02_r8,1.1617e+02_r8,7.7619e+01_r8,3.9099e+01_r8,4.0906e+00_r8/) + kbo(:, 4,16,10) = (/ & + &2.0197e+02_r8,1.5160e+02_r8,1.0123e+02_r8,5.0878e+01_r8,4.0252e+00_r8/) + kbo(:, 5,16,10) = (/ & + &2.5492e+02_r8,1.9130e+02_r8,1.2769e+02_r8,6.4095e+01_r8,3.9532e+00_r8/) + kbo(:, 1,17,10) = (/ & + &5.7968e+01_r8,4.3609e+01_r8,2.9277e+01_r8,1.5223e+01_r8,4.5287e+00_r8/) + kbo(:, 2,17,10) = (/ & + &8.2190e+01_r8,6.1765e+01_r8,4.1354e+01_r8,2.1049e+01_r8,4.4713e+00_r8/) + kbo(:, 3,17,10) = (/ & + &1.1116e+02_r8,8.3481e+01_r8,5.5816e+01_r8,2.8216e+01_r8,4.4079e+00_r8/) + kbo(:, 4,17,10) = (/ & + &1.4447e+02_r8,1.0846e+02_r8,7.2459e+01_r8,3.6495e+01_r8,4.3339e+00_r8/) + kbo(:, 5,17,10) = (/ & + &1.8168e+02_r8,1.3637e+02_r8,9.1060e+01_r8,4.5781e+01_r8,4.2592e+00_r8/) + kbo(:, 1,18,10) = (/ & + &4.2612e+01_r8,3.2081e+01_r8,2.1612e+01_r8,1.2271e+01_r8,4.8071e+00_r8/) + kbo(:, 2,18,10) = (/ & + &6.0147e+01_r8,4.5223e+01_r8,3.0329e+01_r8,1.5934e+01_r8,4.7499e+00_r8/) + kbo(:, 3,18,10) = (/ & + &8.0941e+01_r8,6.0812e+01_r8,4.0702e+01_r8,2.0761e+01_r8,4.6797e+00_r8/) + kbo(:, 4,18,10) = (/ & + &1.0473e+02_r8,7.8652e+01_r8,5.2586e+01_r8,2.6600e+01_r8,4.6080e+00_r8/) + kbo(:, 5,18,10) = (/ & + &1.3143e+02_r8,9.8677e+01_r8,6.5930e+01_r8,3.3232e+01_r8,4.5353e+00_r8/) + kbo(:, 1,19,10) = (/ & + &3.0448e+01_r8,2.2951e+01_r8,1.5620e+01_r8,1.0168e+01_r8,5.0350e+00_r8/) + kbo(:, 2,19,10) = (/ & + &4.2741e+01_r8,3.2162e+01_r8,2.1658e+01_r8,1.2576e+01_r8,4.9712e+00_r8/) + kbo(:, 3,19,10) = (/ & + &5.7239e+01_r8,4.3029e+01_r8,2.8857e+01_r8,1.5561e+01_r8,4.9060e+00_r8/) + kbo(:, 4,19,10) = (/ & + &7.3990e+01_r8,5.5595e+01_r8,3.7227e+01_r8,1.9263e+01_r8,4.8462e+00_r8/) + kbo(:, 5,19,10) = (/ & + &9.3283e+01_r8,7.0062e+01_r8,4.6859e+01_r8,2.3820e+01_r8,4.7826e+00_r8/) + kbo(:, 1,20,10) = (/ & + &2.3494e+01_r8,1.7742e+01_r8,1.2645e+01_r8,9.3657e+00_r8,5.1974e+00_r8/) + kbo(:, 2,20,10) = (/ & + &3.2767e+01_r8,2.4679e+01_r8,1.6836e+01_r8,1.0930e+01_r8,5.1468e+00_r8/) + kbo(:, 3,20,10) = (/ & + &4.3805e+01_r8,3.2955e+01_r8,2.2186e+01_r8,1.3029e+01_r8,5.0951e+00_r8/) + kbo(:, 4,20,10) = (/ & + &5.6900e+01_r8,4.2771e+01_r8,2.8686e+01_r8,1.5712e+01_r8,5.0360e+00_r8/) + kbo(:, 5,20,10) = (/ & + &7.2009e+01_r8,5.4098e+01_r8,3.6220e+01_r8,1.9012e+01_r8,4.9716e+00_r8/) + kbo(:, 1,21,10) = (/ & + &1.8574e+01_r8,1.4067e+01_r8,1.0798e+01_r8,9.1144e+00_r8,5.2989e+00_r8/) + kbo(:, 2,21,10) = (/ & + &2.5833e+01_r8,1.9488e+01_r8,1.3882e+01_r8,1.0250e+01_r8,5.2602e+00_r8/) + kbo(:, 3,21,10) = (/ & + &3.4706e+01_r8,2.6128e+01_r8,1.7872e+01_r8,1.1627e+01_r8,5.2166e+00_r8/) + kbo(:, 4,21,10) = (/ & + &4.5183e+01_r8,3.3979e+01_r8,2.2895e+01_r8,1.3514e+01_r8,5.1658e+00_r8/) + kbo(:, 5,21,10) = (/ & + &5.7162e+01_r8,4.2958e+01_r8,2.8816e+01_r8,1.5946e+01_r8,5.1078e+00_r8/) + kbo(:, 1,22,10) = (/ & + &1.5385e+01_r8,1.1760e+01_r8,9.8072e+00_r8,8.9715e+00_r8,5.3316e+00_r8/) + kbo(:, 2,22,10) = (/ & + &2.1421e+01_r8,1.6187e+01_r8,1.2154e+01_r8,1.0019e+01_r8,5.3065e+00_r8/) + kbo(:, 3,22,10) = (/ & + &2.8763e+01_r8,2.1675e+01_r8,1.5363e+01_r8,1.1158e+01_r8,5.2767e+00_r8/) + kbo(:, 4,22,10) = (/ & + &3.7378e+01_r8,2.8123e+01_r8,1.9262e+01_r8,1.2474e+01_r8,5.2393e+00_r8/) + kbo(:, 5,22,10) = (/ & + &4.7335e+01_r8,3.5583e+01_r8,2.3996e+01_r8,1.4183e+01_r8,5.1848e+00_r8/) + kbo(:, 1,23,10) = (/ & + &1.2958e+01_r8,1.0148e+01_r8,9.3026e+00_r8,8.7646e+00_r8,5.3174e+00_r8/) + kbo(:, 2,23,10) = (/ & + &1.8016e+01_r8,1.3712e+01_r8,1.1027e+01_r8,9.7388e+00_r8,5.3065e+00_r8/) + kbo(:, 3,23,10) = (/ & + &2.4116e+01_r8,1.8203e+01_r8,1.3458e+01_r8,1.0800e+01_r8,5.2863e+00_r8/) + kbo(:, 4,23,10) = (/ & + &3.1331e+01_r8,2.3589e+01_r8,1.6625e+01_r8,1.1918e+01_r8,5.2605e+00_r8/) + kbo(:, 5,23,10) = (/ & + &3.9751e+01_r8,2.9901e+01_r8,2.0473e+01_r8,1.3180e+01_r8,5.2164e+00_r8/) + kbo(:, 1,24,10) = (/ & + &1.0965e+01_r8,8.9178e+00_r8,8.8968e+00_r8,8.4756e+00_r8,5.2609e+00_r8/) + kbo(:, 2,24,10) = (/ & + &1.5180e+01_r8,1.1787e+01_r8,1.0354e+01_r8,9.3845e+00_r8,5.2622e+00_r8/) + kbo(:, 3,24,10) = (/ & + &2.0304e+01_r8,1.5418e+01_r8,1.2131e+01_r8,1.0371e+01_r8,5.2552e+00_r8/) + kbo(:, 4,24,10) = (/ & + &2.6453e+01_r8,1.9955e+01_r8,1.4586e+01_r8,1.1412e+01_r8,5.2428e+00_r8/) + kbo(:, 5,24,10) = (/ & + &3.3727e+01_r8,2.5409e+01_r8,1.7807e+01_r8,1.2537e+01_r8,5.2080e+00_r8/) + kbo(:, 1,25,10) = (/ & + &9.4802e+00_r8,8.0678e+00_r8,8.5346e+00_r8,8.1689e+00_r8,5.1602e+00_r8/) + kbo(:, 2,25,10) = (/ & + &1.3091e+01_r8,1.0412e+01_r8,9.8804e+00_r8,9.0420e+00_r8,5.1798e+00_r8/) + kbo(:, 3,25,10) = (/ & + &1.7556e+01_r8,1.3502e+01_r8,1.1390e+01_r8,9.9740e+00_r8,5.1919e+00_r8/) + kbo(:, 4,25,10) = (/ & + &2.2937e+01_r8,1.7389e+01_r8,1.3318e+01_r8,1.0956e+01_r8,5.1855e+00_r8/) + kbo(:, 5,25,10) = (/ & + &2.9162e+01_r8,2.2007e+01_r8,1.5910e+01_r8,1.2043e+01_r8,5.1753e+00_r8/) + kbo(:, 1,26,10) = (/ & + &8.4883e+00_r8,7.6029e+00_r8,8.2305e+00_r8,7.8781e+00_r8,5.0300e+00_r8/) + kbo(:, 2,26,10) = (/ & + &1.1732e+01_r8,9.5611e+00_r8,9.4929e+00_r8,8.7340e+00_r8,5.0703e+00_r8/) + kbo(:, 3,26,10) = (/ & + &1.5710e+01_r8,1.2274e+01_r8,1.0941e+01_r8,9.6483e+00_r8,5.1008e+00_r8/) + kbo(:, 4,26,10) = (/ & + &2.0377e+01_r8,1.5577e+01_r8,1.2626e+01_r8,1.0617e+01_r8,5.1143e+00_r8/) + kbo(:, 5,26,10) = (/ & + &2.5762e+01_r8,1.9497e+01_r8,1.4646e+01_r8,1.1691e+01_r8,5.1337e+00_r8/) + kbo(:, 1,27,10) = (/ & + &7.9831e+00_r8,7.4657e+00_r8,8.0386e+00_r8,7.6712e+00_r8,4.8762e+00_r8/) + kbo(:, 2,27,10) = (/ & + &1.1007e+01_r8,9.2258e+00_r8,9.2928e+00_r8,8.5396e+00_r8,4.9402e+00_r8/) + kbo(:, 3,27,10) = (/ & + &1.4621e+01_r8,1.1594e+01_r8,1.0757e+01_r8,9.4652e+00_r8,4.9915e+00_r8/) + kbo(:, 4,27,10) = (/ & + &1.8847e+01_r8,1.4547e+01_r8,1.2326e+01_r8,1.0475e+01_r8,5.0304e+00_r8/) + kbo(:, 5,27,10) = (/ & + &2.3744e+01_r8,1.8045e+01_r8,1.4056e+01_r8,1.1545e+01_r8,5.0808e+00_r8/) + kbo(:, 1,28,10) = (/ & + &7.7237e+00_r8,7.4713e+00_r8,7.9486e+00_r8,7.5349e+00_r8,4.7172e+00_r8/) + kbo(:, 2,28,10) = (/ & + &1.0564e+01_r8,9.1113e+00_r8,9.2602e+00_r8,8.4182e+00_r8,4.8066e+00_r8/) + kbo(:, 3,28,10) = (/ & + &1.3950e+01_r8,1.1225e+01_r8,1.0715e+01_r8,9.3795e+00_r8,4.8773e+00_r8/) + kbo(:, 4,28,10) = (/ & + &1.7938e+01_r8,1.3957e+01_r8,1.2227e+01_r8,1.0437e+01_r8,4.9557e+00_r8/) + kbo(:, 5,28,10) = (/ & + &2.2520e+01_r8,1.7201e+01_r8,1.3827e+01_r8,1.1495e+01_r8,5.0256e+00_r8/) + kbo(:, 1,29,10) = (/ & + &7.9252e+00_r8,7.7575e+00_r8,8.1492e+00_r8,7.5791e+00_r8,4.5608e+00_r8/) + kbo(:, 2,29,10) = (/ & + &1.0756e+01_r8,9.3871e+00_r8,9.5612e+00_r8,8.5083e+00_r8,4.6721e+00_r8/) + kbo(:, 3,29,10) = (/ & + &1.4151e+01_r8,1.1455e+01_r8,1.1026e+01_r8,9.5615e+00_r8,4.7742e+00_r8/) + kbo(:, 4,29,10) = (/ & + &1.8135e+01_r8,1.4153e+01_r8,1.2557e+01_r8,1.0665e+01_r8,4.8851e+00_r8/) + kbo(:, 5,29,10) = (/ & + &2.2757e+01_r8,1.7409e+01_r8,1.4161e+01_r8,1.1730e+01_r8,4.9738e+00_r8/) + kbo(:, 1,30,10) = (/ & + &8.3260e+00_r8,8.1445e+00_r8,8.5115e+00_r8,7.7075e+00_r8,4.4112e+00_r8/) + kbo(:, 2,30,10) = (/ & + &1.1239e+01_r8,9.8059e+00_r8,9.9796e+00_r8,8.7369e+00_r8,4.5506e+00_r8/) + kbo(:, 3,30,10) = (/ & + &1.4731e+01_r8,1.1916e+01_r8,1.1495e+01_r8,9.8748e+00_r8,4.7011e+00_r8/) + kbo(:, 4,30,10) = (/ & + &1.8856e+01_r8,1.4710e+01_r8,1.3064e+01_r8,1.1008e+01_r8,4.8328e+00_r8/) + kbo(:, 5,30,10) = (/ & + &2.3705e+01_r8,1.8124e+01_r8,1.4716e+01_r8,1.2119e+01_r8,4.9257e+00_r8/) + kbo(:, 1,31,10) = (/ & + &9.2196e+00_r8,8.8116e+00_r8,9.1465e+00_r8,8.0622e+00_r8,4.2873e+00_r8/) + kbo(:, 2,31,10) = (/ & + &1.2392e+01_r8,1.0607e+01_r8,1.0704e+01_r8,9.2367e+00_r8,4.4733e+00_r8/) + kbo(:, 3,31,10) = (/ & + &1.6211e+01_r8,1.2983e+01_r8,1.2309e+01_r8,1.0449e+01_r8,4.6511e+00_r8/) + kbo(:, 4,31,10) = (/ & + &2.0762e+01_r8,1.6100e+01_r8,1.3996e+01_r8,1.1659e+01_r8,4.7878e+00_r8/) + kbo(:, 5,31,10) = (/ & + &2.6150e+01_r8,1.9908e+01_r8,1.5819e+01_r8,1.2859e+01_r8,4.9198e+00_r8/) + kbo(:, 1,32,10) = (/ & + &1.0359e+01_r8,9.6137e+00_r8,9.8752e+00_r8,8.5830e+00_r8,4.2174e+00_r8/) + kbo(:, 2,32,10) = (/ & + &1.3877e+01_r8,1.1631e+01_r8,1.1538e+01_r8,9.8576e+00_r8,4.4285e+00_r8/) + kbo(:, 3,32,10) = (/ & + &1.8140e+01_r8,1.4380e+01_r8,1.3269e+01_r8,1.1160e+01_r8,4.5970e+00_r8/) + kbo(:, 4,32,10) = (/ & + &2.3264e+01_r8,1.7927e+01_r8,1.5118e+01_r8,1.2461e+01_r8,4.7493e+00_r8/) + kbo(:, 5,32,10) = (/ & + &2.9418e+01_r8,2.2303e+01_r8,1.7227e+01_r8,1.3746e+01_r8,4.9087e+00_r8/) + kbo(:, 1,33,10) = (/ & + &1.1859e+01_r8,1.0640e+01_r8,1.0773e+01_r8,9.2560e+00_r8,4.1651e+00_r8/) + kbo(:, 2,33,10) = (/ & + &1.5884e+01_r8,1.3011e+01_r8,1.2572e+01_r8,1.0635e+01_r8,4.3715e+00_r8/) + kbo(:, 3,33,10) = (/ & + &2.0782e+01_r8,1.6260e+01_r8,1.4502e+01_r8,1.2047e+01_r8,4.5449e+00_r8/) + kbo(:, 4,33,10) = (/ & + &2.6731e+01_r8,2.0436e+01_r8,1.6585e+01_r8,1.3454e+01_r8,4.7445e+00_r8/) + kbo(:, 5,33,10) = (/ & + &3.3983e+01_r8,2.5659e+01_r8,1.9186e+01_r8,1.4880e+01_r8,4.8947e+00_r8/) + kbo(:, 1,34,10) = (/ & + &1.3139e+01_r8,1.1513e+01_r8,1.1537e+01_r8,9.8375e+00_r8,4.1077e+00_r8/) + kbo(:, 2,34,10) = (/ & + &1.7636e+01_r8,1.4225e+01_r8,1.3489e+01_r8,1.1311e+01_r8,4.3160e+00_r8/) + kbo(:, 3,34,10) = (/ & + &2.3141e+01_r8,1.7962e+01_r8,1.5594e+01_r8,1.2810e+01_r8,4.5443e+00_r8/) + kbo(:, 4,34,10) = (/ & + &2.9960e+01_r8,2.2778e+01_r8,1.7924e+01_r8,1.4335e+01_r8,4.7397e+00_r8/) + kbo(:, 5,34,10) = (/ & + &3.8261e+01_r8,2.8825e+01_r8,2.1079e+01_r8,1.5921e+01_r8,4.9149e+00_r8/) + kbo(:, 1,35,10) = (/ & + &1.4201e+01_r8,1.2261e+01_r8,1.2213e+01_r8,1.0330e+01_r8,4.0399e+00_r8/) + kbo(:, 2,35,10) = (/ & + &1.9135e+01_r8,1.5305e+01_r8,1.4323e+01_r8,1.1895e+01_r8,4.2894e+00_r8/) + kbo(:, 3,35,10) = (/ & + &2.5318e+01_r8,1.9545e+01_r8,1.6589e+01_r8,1.3508e+01_r8,4.5397e+00_r8/) + kbo(:, 4,35,10) = (/ & + &3.3021e+01_r8,2.5025e+01_r8,1.9285e+01_r8,1.5170e+01_r8,4.7565e+00_r8/) + kbo(:, 5,35,10) = (/ & + &4.2461e+01_r8,3.1954e+01_r8,2.3012e+01_r8,1.6958e+01_r8,4.9332e+00_r8/) + kbo(:, 1,36,10) = (/ & + &1.4798e+01_r8,1.2717e+01_r8,1.2670e+01_r8,1.0657e+01_r8,3.9724e+00_r8/) + kbo(:, 2,36,10) = (/ & + &2.0092e+01_r8,1.6016e+01_r8,1.4899e+01_r8,1.2316e+01_r8,4.2681e+00_r8/) + kbo(:, 3,36,10) = (/ & + &2.6852e+01_r8,2.0677e+01_r8,1.7358e+01_r8,1.4052e+01_r8,4.5368e+00_r8/) + kbo(:, 4,36,10) = (/ & + &3.5362e+01_r8,2.6747e+01_r8,2.0391e+01_r8,1.5864e+01_r8,4.7528e+00_r8/) + kbo(:, 5,36,10) = (/ & + &4.5869e+01_r8,3.4503e+01_r8,2.4644e+01_r8,1.7859e+01_r8,4.9480e+00_r8/) + kbo(:, 1,37,10) = (/ & + &1.4369e+01_r8,1.2549e+01_r8,1.2615e+01_r8,1.0629e+01_r8,3.8875e+00_r8/) + kbo(:, 2,37,10) = (/ & + &1.9757e+01_r8,1.5840e+01_r8,1.4922e+01_r8,1.2359e+01_r8,4.2086e+00_r8/) + kbo(:, 3,37,10) = (/ & + &2.6704e+01_r8,2.0605e+01_r8,1.7493e+01_r8,1.4185e+01_r8,4.4864e+00_r8/) + kbo(:, 4,37,10) = (/ & + &3.5588e+01_r8,2.6935e+01_r8,2.0650e+01_r8,1.6109e+01_r8,4.7274e+00_r8/) + kbo(:, 5,37,10) = (/ & + &4.6659e+01_r8,3.5099e+01_r8,2.5115e+01_r8,1.8232e+01_r8,4.9396e+00_r8/) + kbo(:, 1,38,10) = (/ & + &1.4144e+01_r8,1.2516e+01_r8,1.2646e+01_r8,1.0674e+01_r8,3.8121e+00_r8/) + kbo(:, 2,38,10) = (/ & + &1.9692e+01_r8,1.5869e+01_r8,1.5055e+01_r8,1.2490e+01_r8,4.1526e+00_r8/) + kbo(:, 3,38,10) = (/ & + &2.6928e+01_r8,2.0800e+01_r8,1.7766e+01_r8,1.4428e+01_r8,4.4461e+00_r8/) + kbo(:, 4,38,10) = (/ & + &3.6364e+01_r8,2.7528e+01_r8,2.1122e+01_r8,1.6470e+01_r8,4.6931e+00_r8/) + kbo(:, 5,38,10) = (/ & + &4.8190e+01_r8,3.6248e+01_r8,2.5894e+01_r8,1.8774e+01_r8,4.9281e+00_r8/) + kbo(:, 1,39,10) = (/ & + &1.4265e+01_r8,1.2699e+01_r8,1.2840e+01_r8,1.0848e+01_r8,3.7413e+00_r8/) + kbo(:, 2,39,10) = (/ & + &2.0117e+01_r8,1.6218e+01_r8,1.5387e+01_r8,1.2783e+01_r8,4.1060e+00_r8/) + kbo(:, 3,39,10) = (/ & + &2.7852e+01_r8,2.1494e+01_r8,1.8320e+01_r8,1.4851e+01_r8,4.4149e+00_r8/) + kbo(:, 4,39,10) = (/ & + &3.8047e+01_r8,2.8782e+01_r8,2.1981e+01_r8,1.7084e+01_r8,4.6584e+00_r8/) + kbo(:, 5,39,10) = (/ & + &5.1036e+01_r8,3.8378e+01_r8,2.7311e+01_r8,1.9599e+01_r8,4.9209e+00_r8/) + kbo(:, 1,40,10) = (/ & + &1.3045e+01_r8,1.2072e+01_r8,1.2332e+01_r8,1.0515e+01_r8,3.6349e+00_r8/) + kbo(:, 2,40,10) = (/ & + &1.8669e+01_r8,1.5342e+01_r8,1.4892e+01_r8,1.2474e+01_r8,4.0124e+00_r8/) + kbo(:, 3,40,10) = (/ & + &2.6244e+01_r8,2.0390e+01_r8,1.7841e+01_r8,1.4589e+01_r8,4.3337e+00_r8/) + kbo(:, 4,40,10) = (/ & + &3.6291e+01_r8,2.7528e+01_r8,2.1453e+01_r8,1.6896e+01_r8,4.5936e+00_r8/) + kbo(:, 5,40,10) = (/ & + &4.9350e+01_r8,3.7123e+01_r8,2.6680e+01_r8,1.9495e+01_r8,4.8667e+00_r8/) + kbo(:, 1,41,10) = (/ & + &1.1803e+01_r8,1.1439e+01_r8,1.1786e+01_r8,1.0149e+01_r8,3.5171e+00_r8/) + kbo(:, 2,41,10) = (/ & + &1.7194e+01_r8,1.4495e+01_r8,1.4344e+01_r8,1.2127e+01_r8,3.9113e+00_r8/) + kbo(:, 3,41,10) = (/ & + &2.4539e+01_r8,1.9243e+01_r8,1.7307e+01_r8,1.4275e+01_r8,4.2454e+00_r8/) + kbo(:, 4,41,10) = (/ & + &3.4381e+01_r8,2.6175e+01_r8,2.0871e+01_r8,1.6646e+01_r8,4.5236e+00_r8/) + kbo(:, 5,41,10) = (/ & + &4.7387e+01_r8,3.5674e+01_r8,2.5938e+01_r8,1.9314e+01_r8,4.8021e+00_r8/) + kbo(:, 1,42,10) = (/ & + &1.0775e+01_r8,1.0903e+01_r8,1.1326e+01_r8,9.8291e+00_r8,3.4027e+00_r8/) + kbo(:, 2,42,10) = (/ & + &1.5966e+01_r8,1.3847e+01_r8,1.3900e+01_r8,1.1829e+01_r8,3.8068e+00_r8/) + kbo(:, 3,42,10) = (/ & + &2.3163e+01_r8,1.8350e+01_r8,1.6888e+01_r8,1.4033e+01_r8,4.1524e+00_r8/) + kbo(:, 4,42,10) = (/ & + &3.2905e+01_r8,2.5146e+01_r8,2.0462e+01_r8,1.6474e+01_r8,4.4507e+00_r8/) + kbo(:, 5,42,10) = (/ & + &4.5959e+01_r8,3.4632e+01_r8,2.5458e+01_r8,1.9233e+01_r8,4.7372e+00_r8/) + kbo(:, 1,43,10) = (/ & + &9.6785e+00_r8,1.0293e+01_r8,1.0788e+01_r8,9.4380e+00_r8,3.2651e+00_r8/) + kbo(:, 2,43,10) = (/ & + &1.4578e+01_r8,1.3133e+01_r8,1.3380e+01_r8,1.1460e+01_r8,3.6820e+00_r8/) + kbo(:, 3,43,10) = (/ & + &2.1568e+01_r8,1.7343e+01_r8,1.6367e+01_r8,1.3704e+01_r8,4.0432e+00_r8/) + kbo(:, 4,43,10) = (/ & + &3.1160e+01_r8,2.3941e+01_r8,1.9961e+01_r8,1.6215e+01_r8,4.3540e+00_r8/) + kbo(:, 5,43,10) = (/ & + &4.4112e+01_r8,3.3295e+01_r8,2.4834e+01_r8,1.9063e+01_r8,4.6487e+00_r8/) + kbo(:, 1,44,10) = (/ & + &8.6703e+00_r8,9.7103e+00_r8,1.0263e+01_r8,9.0428e+00_r8,3.1167e+00_r8/) + kbo(:, 2,44,10) = (/ & + &1.3323e+01_r8,1.2507e+01_r8,1.2872e+01_r8,1.1099e+01_r8,3.5429e+00_r8/) + kbo(:, 3,44,10) = (/ & + &2.0055e+01_r8,1.6451e+01_r8,1.5900e+01_r8,1.3381e+01_r8,3.9213e+00_r8/) + kbo(:, 4,44,10) = (/ & + &2.9535e+01_r8,2.2835e+01_r8,1.9530e+01_r8,1.5970e+01_r8,4.2481e+00_r8/) + kbo(:, 5,44,10) = (/ & + &4.2449e+01_r8,3.2099e+01_r8,2.4329e+01_r8,1.8926e+01_r8,4.5571e+00_r8/) + kbo(:, 1,45,10) = (/ & + &7.8818e+00_r8,9.2454e+00_r8,9.8403e+00_r8,8.7130e+00_r8,2.9638e+00_r8/) + kbo(:, 2,45,10) = (/ & + &1.2355e+01_r8,1.2035e+01_r8,1.2482e+01_r8,1.0822e+01_r8,3.4038e+00_r8/) + kbo(:, 3,45,10) = (/ & + &1.8948e+01_r8,1.5842e+01_r8,1.5587e+01_r8,1.3162e+01_r8,3.7919e+00_r8/) + kbo(:, 4,45,10) = (/ & + &2.8443e+01_r8,2.2122e+01_r8,1.9322e+01_r8,1.5846e+01_r8,4.1405e+00_r8/) + kbo(:, 5,45,10) = (/ & + &4.1558e+01_r8,3.1475e+01_r8,2.4163e+01_r8,1.8949e+01_r8,4.4650e+00_r8/) + kbo(:, 1,46,10) = (/ & + &7.1089e+00_r8,8.7733e+00_r8,9.3941e+00_r8,8.3547e+00_r8,2.8054e+00_r8/) + kbo(:, 2,46,10) = (/ & + &1.1401e+01_r8,1.1562e+01_r8,1.2067e+01_r8,1.0520e+01_r8,3.2536e+00_r8/) + kbo(:, 3,46,10) = (/ & + &1.7834e+01_r8,1.5248e+01_r8,1.5247e+01_r8,1.2927e+01_r8,3.6528e+00_r8/) + kbo(:, 4,46,10) = (/ & + &2.7249e+01_r8,2.1375e+01_r8,1.9093e+01_r8,1.5705e+01_r8,4.0192e+00_r8/) + kbo(:, 5,46,10) = (/ & + &4.0651e+01_r8,3.0866e+01_r8,2.4015e+01_r8,1.8943e+01_r8,4.3574e+00_r8/) + kbo(:, 1,47,10) = (/ & + &6.1649e+00_r8,8.1403e+00_r8,8.7798e+00_r8,7.8562e+00_r8,2.6253e+00_r8/) + kbo(:, 2,47,10) = (/ & + &1.0138e+01_r8,1.0874e+01_r8,1.1437e+01_r8,1.0055e+01_r8,3.0768e+00_r8/) + kbo(:, 3,47,10) = (/ & + &1.6220e+01_r8,1.4389e+01_r8,1.4631e+01_r8,1.2502e+01_r8,3.4927e+00_r8/) + kbo(:, 4,47,10) = (/ & + &2.5292e+01_r8,2.0083e+01_r8,1.8506e+01_r8,1.5334e+01_r8,3.8713e+00_r8/) + kbo(:, 5,47,10) = (/ & + &3.8579e+01_r8,2.9419e+01_r8,2.3431e+01_r8,1.8659e+01_r8,4.2295e+00_r8/) + kbo(:, 1,48,10) = (/ & + &5.4216e+00_r8,7.6284e+00_r8,8.2781e+00_r8,7.4282e+00_r8,2.4448e+00_r8/) + kbo(:, 2,48,10) = (/ & + &9.1674e+00_r8,1.0353e+01_r8,1.0955e+01_r8,9.6794e+00_r8,2.8941e+00_r8/) + kbo(:, 3,48,10) = (/ & + &1.5043e+01_r8,1.3839e+01_r8,1.4203e+01_r8,1.2197e+01_r8,3.3245e+00_r8/) + kbo(:, 4,48,10) = (/ & + &2.3974e+01_r8,1.9288e+01_r8,1.8167e+01_r8,1.5125e+01_r8,3.7165e+00_r8/) + kbo(:, 5,48,10) = (/ & + &3.7305e+01_r8,2.8554e+01_r8,2.3217e+01_r8,1.8594e+01_r8,4.0932e+00_r8/) + kbo(:, 1,49,10) = (/ & + &4.8939e+00_r8,7.2548e+00_r8,7.9080e+00_r8,7.0906e+00_r8,2.2660e+00_r8/) + kbo(:, 2,49,10) = (/ & + &8.5415e+00_r8,1.0039e+01_r8,1.0662e+01_r8,9.4308e+00_r8,2.7166e+00_r8/) + kbo(:, 3,49,10) = (/ & + &1.4366e+01_r8,1.3618e+01_r8,1.4041e+01_r8,1.2074e+01_r8,3.1539e+00_r8/) + kbo(:, 4,49,10) = (/ & + &2.3519e+01_r8,1.9097e+01_r8,1.8194e+01_r8,1.5161e+01_r8,3.5625e+00_r8/) + kbo(:, 5,49,10) = (/ & + &3.7354e+01_r8,2.8637e+01_r8,2.3540e+01_r8,1.8862e+01_r8,3.9655e+00_r8/) + kbo(:, 1,50,10) = (/ & + &4.2089e+00_r8,6.7050e+00_r8,7.3787e+00_r8,6.6334e+00_r8,2.0951e+00_r8/) + kbo(:, 2,50,10) = (/ & + &7.5781e+00_r8,9.4477e+00_r8,1.0132e+01_r8,8.9977e+00_r8,2.5467e+00_r8/) + kbo(:, 3,50,10) = (/ & + &1.3098e+01_r8,1.3002e+01_r8,1.3521e+01_r8,1.1708e+01_r8,2.9888e+00_r8/) + kbo(:, 4,50,10) = (/ & + &2.2021e+01_r8,1.8246e+01_r8,1.7755e+01_r8,1.4869e+01_r8,3.4160e+00_r8/) + kbo(:, 5,50,10) = (/ & + &3.5802e+01_r8,2.7586e+01_r8,2.3214e+01_r8,1.8702e+01_r8,3.8321e+00_r8/) + kbo(:, 1,51,10) = (/ & + &3.5246e+00_r8,6.0952e+00_r8,6.7836e+00_r8,6.1221e+00_r8,1.9285e+00_r8/) + kbo(:, 2,51,10) = (/ & + &6.5392e+00_r8,8.7579e+00_r8,9.5007e+00_r8,8.4899e+00_r8,2.3790e+00_r8/) + kbo(:, 3,51,10) = (/ & + &1.1662e+01_r8,1.2207e+01_r8,1.2854e+01_r8,1.1229e+01_r8,2.8289e+00_r8/) + kbo(:, 4,51,10) = (/ & + &2.0094e+01_r8,1.7146e+01_r8,1.7077e+01_r8,1.4419e+01_r8,3.2637e+00_r8/) + kbo(:, 5,51,10) = (/ & + &3.3544e+01_r8,2.6031e+01_r8,2.2586e+01_r8,1.8311e+01_r8,3.6955e+00_r8/) + kbo(:, 1,52,10) = (/ & + &2.9972e+00_r8,5.5809e+00_r8,6.2670e+00_r8,5.6729e+00_r8,1.7637e+00_r8/) + kbo(:, 2,52,10) = (/ & + &5.7401e+00_r8,8.2025e+00_r8,8.9834e+00_r8,8.0597e+00_r8,2.2115e+00_r8/) + kbo(:, 3,52,10) = (/ & + &1.0553e+01_r8,1.1618e+01_r8,1.2357e+01_r8,1.0861e+01_r8,2.6710e+00_r8/) + kbo(:, 4,52,10) = (/ & + &1.8666e+01_r8,1.6392e+01_r8,1.6645e+01_r8,1.4126e+01_r8,3.1091e+00_r8/) + kbo(:, 5,52,10) = (/ & + &3.2058e+01_r8,2.5069e+01_r8,2.2259e+01_r8,1.8128e+01_r8,3.5578e+00_r8/) + kbo(:, 1,53,10) = (/ & + &2.6079e+00_r8,5.1734e+00_r8,5.8449e+00_r8,5.2987e+00_r8,1.6026e+00_r8/) + kbo(:, 2,53,10) = (/ & + &5.1862e+00_r8,7.8030e+00_r8,8.6055e+00_r8,7.7246e+00_r8,2.0456e+00_r8/) + kbo(:, 3,53,10) = (/ & + &9.8254e+00_r8,1.1267e+01_r8,1.2065e+01_r8,1.0633e+01_r8,2.5075e+00_r8/) + kbo(:, 4,53,10) = (/ & + &1.7902e+01_r8,1.6069e+01_r8,1.6506e+01_r8,1.4053e+01_r8,2.9528e+00_r8/) + kbo(:, 5,53,10) = (/ & + &3.1626e+01_r8,2.4842e+01_r8,2.2382e+01_r8,1.8272e+01_r8,3.4166e+00_r8/) + kbo(:, 1,54,10) = (/ & + &1.9692e+00_r8,4.4492e+00_r8,5.0971e+00_r8,4.6730e+00_r8,1.4560e+00_r8/) + kbo(:, 2,54,10) = (/ & + &4.0777e+00_r8,6.8483e+00_r8,7.6942e+00_r8,6.9748e+00_r8,1.8918e+00_r8/) + kbo(:, 3,54,10) = (/ & + &7.9636e+00_r8,1.0044e+01_r8,1.0960e+01_r8,9.7978e+00_r8,2.3486e+00_r8/) + kbo(:, 4,54,10) = (/ & + &1.4982e+01_r8,1.4434e+01_r8,1.5164e+01_r8,1.3125e+01_r8,2.8028e+00_r8/) + kbo(:, 5,54,10) = (/ & + &2.7158e+01_r8,2.1902e+01_r8,2.0733e+01_r8,1.7211e+01_r8,3.2543e+00_r8/) + kbo(:, 1,55,10) = (/ & + &1.3507e+00_r8,3.6433e+00_r8,4.2566e+00_r8,3.9661e+00_r8,1.3130e+00_r8/) + kbo(:, 2,55,10) = (/ & + &2.9154e+00_r8,5.7215e+00_r8,6.5830e+00_r8,6.0536e+00_r8,1.7424e+00_r8/) + kbo(:, 3,55,10) = (/ & + &5.8789e+00_r8,8.5105e+00_r8,9.5339e+00_r8,8.6749e+00_r8,2.1951e+00_r8/) + kbo(:, 4,55,10) = (/ & + &1.1400e+01_r8,1.2318e+01_r8,1.3311e+01_r8,1.1788e+01_r8,2.6530e+00_r8/) + kbo(:, 5,55,10) = (/ & + &2.1258e+01_r8,1.8155e+01_r8,1.8294e+01_r8,1.5532e+01_r8,3.0990e+00_r8/) + kbo(:, 1,56,10) = (/ & + &9.1417e-01_r8,2.9676e+00_r8,3.5310e+00_r8,3.3437e+00_r8,1.1797e+00_r8/) + kbo(:, 2,56,10) = (/ & + &2.0541e+00_r8,4.7744e+00_r8,5.6130e+00_r8,5.2303e+00_r8,1.5997e+00_r8/) + kbo(:, 3,56,10) = (/ & + &4.2988e+00_r8,7.2236e+00_r8,8.2994e+00_r8,7.6574e+00_r8,2.0435e+00_r8/) + kbo(:, 4,56,10) = (/ & + &8.5903e+00_r8,1.0539e+01_r8,1.1687e+01_r8,1.0572e+01_r8,2.5005e+00_r8/) + kbo(:, 5,56,10) = (/ & + &1.6506e+01_r8,1.5331e+01_r8,1.6174e+01_r8,1.4030e+01_r8,2.9531e+00_r8/) + kbo(:, 1,57,10) = (/ & + &6.0887e-01_r8,2.4030e+00_r8,2.9065e+00_r8,2.7971e+00_r8,1.0495e+00_r8/) + kbo(:, 2,57,10) = (/ & + &1.4281e+00_r8,3.9782e+00_r8,4.7656e+00_r8,4.4965e+00_r8,1.4561e+00_r8/) + kbo(:, 3,57,10) = (/ & + &3.1054e+00_r8,6.1238e+00_r8,7.2122e+00_r8,6.7209e+00_r8,1.8934e+00_r8/) + kbo(:, 4,57,10) = (/ & + &6.4056e+00_r8,9.0325e+00_r8,1.0294e+01_r8,9.4596e+00_r8,2.3523e+00_r8/) + kbo(:, 5,57,10) = (/ & + &1.2719e+01_r8,1.3167e+01_r8,1.4312e+01_r8,1.2682e+01_r8,2.8029e+00_r8/) + kbo(:, 1,58,10) = (/ & + &1.0707e-01_r8,6.3953e-01_r8,1.0127e+00_r8,1.3896e+00_r8,9.3114e-01_r8/) + kbo(:, 2,58,10) = (/ & + &2.6195e-01_r8,1.0902e+00_r8,1.7100e+00_r8,2.2949e+00_r8,1.3241e+00_r8/) + kbo(:, 3,58,10) = (/ & + &5.9147e-01_r8,1.7109e+00_r8,2.6503e+00_r8,3.5010e+00_r8,1.7544e+00_r8/) + kbo(:, 4,58,10) = (/ & + &1.2606e+00_r8,2.5523e+00_r8,3.8433e+00_r8,5.0138e+00_r8,2.2018e+00_r8/) + kbo(:, 5,58,10) = (/ & + &2.5874e+00_r8,3.7372e+00_r8,5.3689e+00_r8,6.8137e+00_r8,2.6612e+00_r8/) + kbo(:, 1,59,10) = (/ & + &9.9298e-02_r8,7.6667e-01_r8,1.1645e+00_r8,1.4612e+00_r8,8.8547e-01_r8/) + kbo(:, 2,59,10) = (/ & + &2.4968e-01_r8,1.3224e+00_r8,1.9807e+00_r8,2.4248e+00_r8,1.2655e+00_r8/) + kbo(:, 3,59,10) = (/ & + &5.7897e-01_r8,2.0921e+00_r8,3.0941e+00_r8,3.7073e+00_r8,1.6878e+00_r8/) + kbo(:, 4,59,10) = (/ & + &1.2660e+00_r8,3.1094e+00_r8,4.5051e+00_r8,5.3308e+00_r8,2.1316e+00_r8/) + kbo(:, 5,59,10) = (/ & + &2.6665e+00_r8,4.5101e+00_r8,6.2520e+00_r8,7.2627e+00_r8,2.5824e+00_r8/) + kbo(:, 1,13,11) = (/ & + &4.9137e+02_r8,3.6866e+02_r8,2.4595e+02_r8,1.2325e+02_r8,3.7154e+00_r8/) + kbo(:, 2,13,11) = (/ & + &7.1842e+02_r8,5.3894e+02_r8,3.5946e+02_r8,1.7998e+02_r8,3.6255e+00_r8/) + kbo(:, 3,13,11) = (/ & + &9.9186e+02_r8,7.4402e+02_r8,4.9618e+02_r8,2.4833e+02_r8,3.5452e+00_r8/) + kbo(:, 4,13,11) = (/ & + &1.3059e+03_r8,9.7954e+02_r8,6.5319e+02_r8,3.2683e+02_r8,3.4736e+00_r8/) + kbo(:, 5,13,11) = (/ & + &1.6553e+03_r8,1.2416e+03_r8,8.2787e+02_r8,4.1417e+02_r8,3.4158e+00_r8/) + kbo(:, 1,14,11) = (/ & + &3.1242e+02_r8,2.3443e+02_r8,1.5644e+02_r8,7.8454e+01_r8,4.0956e+00_r8/) + kbo(:, 2,14,11) = (/ & + &4.5149e+02_r8,3.3873e+02_r8,2.2597e+02_r8,1.1322e+02_r8,4.0089e+00_r8/) + kbo(:, 3,14,11) = (/ & + &6.1672e+02_r8,4.6265e+02_r8,3.0858e+02_r8,1.5452e+02_r8,3.9350e+00_r8/) + kbo(:, 4,14,11) = (/ & + &8.0574e+02_r8,6.0442e+02_r8,4.0309e+02_r8,2.0177e+02_r8,3.8665e+00_r8/) + kbo(:, 5,14,11) = (/ & + &1.0145e+03_r8,7.6099e+02_r8,5.0748e+02_r8,2.5397e+02_r8,3.7755e+00_r8/) + kbo(:, 1,15,11) = (/ & + &1.9759e+02_r8,1.4830e+02_r8,9.9018e+01_r8,4.9739e+01_r8,4.5712e+00_r8/) + kbo(:, 2,15,11) = (/ & + &2.8230e+02_r8,2.1184e+02_r8,1.4137e+02_r8,7.0907e+01_r8,4.4810e+00_r8/) + kbo(:, 3,15,11) = (/ & + &3.8219e+02_r8,2.8675e+02_r8,1.9132e+02_r8,9.5881e+01_r8,4.3973e+00_r8/) + kbo(:, 4,15,11) = (/ & + &4.9586e+02_r8,3.7201e+02_r8,2.4816e+02_r8,1.2430e+02_r8,4.3207e+00_r8/) + kbo(:, 5,15,11) = (/ & + &6.2301e+02_r8,4.6738e+02_r8,3.1174e+02_r8,1.5610e+02_r8,4.2419e+00_r8/) + kbo(:, 1,16,11) = (/ & + &1.4534e+02_r8,1.0912e+02_r8,7.2899e+01_r8,3.6687e+01_r8,5.0599e+00_r8/) + kbo(:, 2,16,11) = (/ & + &2.0548e+02_r8,1.5423e+02_r8,1.0297e+02_r8,5.1715e+01_r8,4.9736e+00_r8/) + kbo(:, 3,16,11) = (/ & + &2.7637e+02_r8,2.0739e+02_r8,1.3841e+02_r8,6.9439e+01_r8,4.8882e+00_r8/) + kbo(:, 4,16,11) = (/ & + &3.5789e+02_r8,2.6854e+02_r8,1.7918e+02_r8,8.9827e+01_r8,4.8052e+00_r8/) + kbo(:, 5,16,11) = (/ & + &4.4907e+02_r8,3.3692e+02_r8,2.2477e+02_r8,1.1262e+02_r8,4.7153e+00_r8/) + kbo(:, 1,17,11) = (/ & + &1.0823e+02_r8,8.1288e+01_r8,5.4344e+01_r8,2.7412e+01_r8,5.5645e+00_r8/) + kbo(:, 2,17,11) = (/ & + &1.5200e+02_r8,1.1412e+02_r8,7.6233e+01_r8,3.8355e+01_r8,5.4748e+00_r8/) + kbo(:, 3,17,11) = (/ & + &2.0403e+02_r8,1.5314e+02_r8,1.0225e+02_r8,5.1364e+01_r8,5.3859e+00_r8/) + kbo(:, 4,17,11) = (/ & + &2.6361e+02_r8,1.9782e+02_r8,1.3204e+02_r8,6.6255e+01_r8,5.2931e+00_r8/) + kbo(:, 5,17,11) = (/ & + &3.3009e+02_r8,2.4768e+02_r8,1.6528e+02_r8,8.2867e+01_r8,5.1961e+00_r8/) + kbo(:, 1,18,11) = (/ & + &8.1232e+01_r8,6.1036e+01_r8,4.0843e+01_r8,2.0768e+01_r8,6.0688e+00_r8/) + kbo(:, 2,18,11) = (/ & + &1.1380e+02_r8,8.5466e+01_r8,5.7129e+01_r8,2.8802e+01_r8,5.9719e+00_r8/) + kbo(:, 3,18,11) = (/ & + &1.5225e+02_r8,1.1430e+02_r8,7.6349e+01_r8,3.8404e+01_r8,5.8780e+00_r8/) + kbo(:, 4,18,11) = (/ & + &1.9624e+02_r8,1.4729e+02_r8,9.8340e+01_r8,4.9394e+01_r8,5.7787e+00_r8/) + kbo(:, 5,18,11) = (/ & + &2.4493e+02_r8,1.8381e+02_r8,1.2268e+02_r8,6.1561e+01_r8,5.6709e+00_r8/) + kbo(:, 1,19,11) = (/ & + &5.9301e+01_r8,4.4585e+01_r8,2.9875e+01_r8,1.6238e+01_r8,6.5385e+00_r8/) + kbo(:, 2,19,11) = (/ & + &8.2717e+01_r8,6.2145e+01_r8,4.1575e+01_r8,2.1335e+01_r8,6.4509e+00_r8/) + kbo(:, 3,19,11) = (/ & + &1.1031e+02_r8,8.2837e+01_r8,5.5366e+01_r8,2.7948e+01_r8,6.3522e+00_r8/) + kbo(:, 4,19,11) = (/ & + &1.4167e+02_r8,1.0635e+02_r8,7.1041e+01_r8,3.5737e+01_r8,6.2392e+00_r8/) + kbo(:, 5,19,11) = (/ & + &1.7630e+02_r8,1.3232e+02_r8,8.8349e+01_r8,4.4378e+01_r8,6.1191e+00_r8/) + kbo(:, 1,20,11) = (/ & + &4.6675e+01_r8,3.5111e+01_r8,2.3575e+01_r8,1.4266e+01_r8,6.9620e+00_r8/) + kbo(:, 2,20,11) = (/ & + &6.4787e+01_r8,4.8692e+01_r8,3.2603e+01_r8,1.7833e+01_r8,6.8738e+00_r8/) + kbo(:, 3,20,11) = (/ & + &8.5965e+01_r8,6.4574e+01_r8,4.3185e+01_r8,2.2381e+01_r8,6.7710e+00_r8/) + kbo(:, 4,20,11) = (/ & + &1.0993e+02_r8,8.2545e+01_r8,5.5164e+01_r8,2.7968e+01_r8,6.6598e+00_r8/) + kbo(:, 5,20,11) = (/ & + &1.3666e+02_r8,1.0259e+02_r8,6.8531e+01_r8,3.4499e+01_r8,6.5455e+00_r8/) + kbo(:, 1,21,11) = (/ & + &3.7501e+01_r8,2.8227e+01_r8,1.9281e+01_r8,1.3115e+01_r8,7.3104e+00_r8/) + kbo(:, 2,21,11) = (/ & + &5.1743e+01_r8,3.8905e+01_r8,2.6108e+01_r8,1.5684e+01_r8,7.2251e+00_r8/) + kbo(:, 3,21,11) = (/ & + &6.8349e+01_r8,5.1361e+01_r8,3.4375e+01_r8,1.9019e+01_r8,7.1334e+00_r8/) + kbo(:, 4,21,11) = (/ & + &8.7361e+01_r8,6.5620e+01_r8,4.3882e+01_r8,2.3034e+01_r8,7.0346e+00_r8/) + kbo(:, 5,21,11) = (/ & + &1.0904e+02_r8,8.1880e+01_r8,5.4724e+01_r8,2.7964e+01_r8,6.9286e+00_r8/) + kbo(:, 1,22,11) = (/ & + &3.1289e+01_r8,2.3566e+01_r8,1.6825e+01_r8,1.2828e+01_r8,7.5760e+00_r8/) + kbo(:, 2,22,11) = (/ & + &4.2825e+01_r8,3.2216e+01_r8,2.1971e+01_r8,1.4588e+01_r8,7.5079e+00_r8/) + kbo(:, 3,22,11) = (/ & + &5.6403e+01_r8,4.2401e+01_r8,2.8462e+01_r8,1.6984e+01_r8,7.4270e+00_r8/) + kbo(:, 4,22,11) = (/ & + &7.2294e+01_r8,5.4320e+01_r8,3.6353e+01_r8,2.0165e+01_r8,7.3380e+00_r8/) + kbo(:, 5,22,11) = (/ & + &9.0391e+01_r8,6.7890e+01_r8,4.5398e+01_r8,2.4037e+01_r8,7.2398e+00_r8/) + kbo(:, 1,23,11) = (/ & + &2.6113e+01_r8,1.9694e+01_r8,1.4984e+01_r8,1.2807e+01_r8,7.7662e+00_r8/) + kbo(:, 2,23,11) = (/ & + &3.5611e+01_r8,2.6805e+01_r8,1.8996e+01_r8,1.4145e+01_r8,7.7141e+00_r8/) + kbo(:, 3,23,11) = (/ & + &4.7007e+01_r8,3.5353e+01_r8,2.4112e+01_r8,1.5803e+01_r8,7.6529e+00_r8/) + kbo(:, 4,23,11) = (/ & + &6.0260e+01_r8,4.5296e+01_r8,3.0446e+01_r8,1.8119e+01_r8,7.5779e+00_r8/) + kbo(:, 5,23,11) = (/ & + &7.5402e+01_r8,5.6642e+01_r8,3.7917e+01_r8,2.1118e+01_r8,7.4889e+00_r8/) + kbo(:, 1,24,11) = (/ & + &2.1744e+01_r8,1.6531e+01_r8,1.3667e+01_r8,1.2705e+01_r8,7.8734e+00_r8/) + kbo(:, 2,24,11) = (/ & + &2.9665e+01_r8,2.2353e+01_r8,1.6710e+01_r8,1.3918e+01_r8,7.8466e+00_r8/) + kbo(:, 3,24,11) = (/ & + &3.9143e+01_r8,2.9459e+01_r8,2.0787e+01_r8,1.5226e+01_r8,7.8065e+00_r8/) + kbo(:, 4,24,11) = (/ & + &5.0222e+01_r8,3.7761e+01_r8,2.5773e+01_r8,1.6824e+01_r8,7.7511e+00_r8/) + kbo(:, 5,24,11) = (/ & + &6.2928e+01_r8,4.7282e+01_r8,3.1824e+01_r8,1.8958e+01_r8,7.6816e+00_r8/) + kbo(:, 1,25,11) = (/ & + &1.8556e+01_r8,1.4391e+01_r8,1.2986e+01_r8,1.2542e+01_r8,7.9223e+00_r8/) + kbo(:, 2,25,11) = (/ & + &2.5288e+01_r8,1.9166e+01_r8,1.5272e+01_r8,1.3696e+01_r8,7.9207e+00_r8/) + kbo(:, 3,25,11) = (/ & + &3.3328e+01_r8,2.5101e+01_r8,1.8448e+01_r8,1.4913e+01_r8,7.9039e+00_r8/) + kbo(:, 4,25,11) = (/ & + &4.2799e+01_r8,3.2187e+01_r8,2.2557e+01_r8,1.6216e+01_r8,7.8725e+00_r8/) + kbo(:, 5,25,11) = (/ & + &5.3844e+01_r8,4.0473e+01_r8,2.7585e+01_r8,1.7777e+01_r8,7.8216e+00_r8/) + kbo(:, 1,26,11) = (/ & + &1.6321e+01_r8,1.3012e+01_r8,1.2671e+01_r8,1.2389e+01_r8,7.9293e+00_r8/) + kbo(:, 2,26,11) = (/ & + &2.2176e+01_r8,1.7013e+01_r8,1.4541e+01_r8,1.3492e+01_r8,7.9549e+00_r8/) + kbo(:, 3,26,11) = (/ & + &2.9236e+01_r8,2.2092e+01_r8,1.7014e+01_r8,1.4647e+01_r8,7.9628e+00_r8/) + kbo(:, 4,26,11) = (/ & + &3.7703e+01_r8,2.8378e+01_r8,2.0439e+01_r8,1.5868e+01_r8,7.9537e+00_r8/) + kbo(:, 5,26,11) = (/ & + &4.7623e+01_r8,3.5826e+01_r8,2.4857e+01_r8,1.7188e+01_r8,7.9177e+00_r8/) + kbo(:, 1,27,11) = (/ & + &1.5028e+01_r8,1.2264e+01_r8,1.2582e+01_r8,1.2313e+01_r8,7.9116e+00_r8/) + kbo(:, 2,27,11) = (/ & + &2.0393e+01_r8,1.5855e+01_r8,1.4339e+01_r8,1.3407e+01_r8,7.9620e+00_r8/) + kbo(:, 3,27,11) = (/ & + &2.6998e+01_r8,2.0503e+01_r8,1.6441e+01_r8,1.4550e+01_r8,7.9958e+00_r8/) + kbo(:, 4,27,11) = (/ & + &3.4948e+01_r8,2.6342e+01_r8,1.9460e+01_r8,1.5757e+01_r8,8.0119e+00_r8/) + kbo(:, 5,27,11) = (/ & + &4.4164e+01_r8,3.3250e+01_r8,2.3464e+01_r8,1.7068e+01_r8,7.9872e+00_r8/) + kbo(:, 1,28,11) = (/ & + &1.4343e+01_r8,1.1935e+01_r8,1.2606e+01_r8,1.2286e+01_r8,7.8708e+00_r8/) + kbo(:, 2,28,11) = (/ & + &1.9534e+01_r8,1.5338e+01_r8,1.4333e+01_r8,1.3405e+01_r8,7.9546e+00_r8/) + kbo(:, 3,28,11) = (/ & + &2.5909e+01_r8,1.9792e+01_r8,1.6354e+01_r8,1.4575e+01_r8,8.0164e+00_r8/) + kbo(:, 4,28,11) = (/ & + &3.3450e+01_r8,2.5271e+01_r8,1.9104e+01_r8,1.5810e+01_r8,8.0394e+00_r8/) + kbo(:, 5,28,11) = (/ & + &4.2201e+01_r8,3.1789e+01_r8,2.2776e+01_r8,1.7191e+01_r8,8.0384e+00_r8/) + kbo(:, 1,29,11) = (/ & + &1.4799e+01_r8,1.2334e+01_r8,1.2951e+01_r8,1.2470e+01_r8,7.8248e+00_r8/) + kbo(:, 2,29,11) = (/ & + &2.0134e+01_r8,1.5845e+01_r8,1.4778e+01_r8,1.3682e+01_r8,7.9390e+00_r8/) + kbo(:, 3,29,11) = (/ & + &2.6563e+01_r8,2.0336e+01_r8,1.6926e+01_r8,1.4933e+01_r8,8.0194e+00_r8/) + kbo(:, 4,29,11) = (/ & + &3.4143e+01_r8,2.5818e+01_r8,1.9648e+01_r8,1.6307e+01_r8,8.0590e+00_r8/) + kbo(:, 5,29,11) = (/ & + &4.2969e+01_r8,3.2368e+01_r8,2.3282e+01_r8,1.7794e+01_r8,8.0931e+00_r8/) + kbo(:, 1,30,11) = (/ & + &1.5772e+01_r8,1.3097e+01_r8,1.3464e+01_r8,1.2783e+01_r8,7.7812e+00_r8/) + kbo(:, 2,30,11) = (/ & + &2.1344e+01_r8,1.6785e+01_r8,1.5505e+01_r8,1.4108e+01_r8,7.9232e+00_r8/) + kbo(:, 3,30,11) = (/ & + &2.7999e+01_r8,2.1429e+01_r8,1.7759e+01_r8,1.5492e+01_r8,8.0114e+00_r8/) + kbo(:, 4,30,11) = (/ & + &3.5848e+01_r8,2.7096e+01_r8,2.0562e+01_r8,1.7031e+01_r8,8.0836e+00_r8/) + kbo(:, 5,30,11) = (/ & + &4.5004e+01_r8,3.3889e+01_r8,2.4347e+01_r8,1.8589e+01_r8,8.1429e+00_r8/) + kbo(:, 1,31,11) = (/ & + &1.7716e+01_r8,1.4511e+01_r8,1.4478e+01_r8,1.3396e+01_r8,7.7478e+00_r8/) + kbo(:, 2,31,11) = (/ & + &2.3853e+01_r8,1.8632e+01_r8,1.6766e+01_r8,1.4874e+01_r8,7.8974e+00_r8/) + kbo(:, 3,31,11) = (/ & + &3.1182e+01_r8,2.3768e+01_r8,1.9223e+01_r8,1.6499e+01_r8,8.0055e+00_r8/) + kbo(:, 4,31,11) = (/ & + &3.9834e+01_r8,3.0054e+01_r8,2.2404e+01_r8,1.8165e+01_r8,8.1138e+00_r8/) + kbo(:, 5,31,11) = (/ & + &4.9938e+01_r8,3.7588e+01_r8,2.6690e+01_r8,1.9788e+01_r8,8.1481e+00_r8/) + kbo(:, 1,32,11) = (/ & + &2.0151e+01_r8,1.6250e+01_r8,1.5786e+01_r8,1.4153e+01_r8,7.7024e+00_r8/) + kbo(:, 2,32,11) = (/ & + &2.7022e+01_r8,2.0930e+01_r8,1.8243e+01_r8,1.5874e+01_r8,7.8766e+00_r8/) + kbo(:, 3,32,11) = (/ & + &3.5292e+01_r8,2.6776e+01_r8,2.1045e+01_r8,1.7666e+01_r8,8.0370e+00_r8/) + kbo(:, 4,32,11) = (/ & + &4.5050e+01_r8,3.3940e+01_r8,2.4811e+01_r8,1.9434e+01_r8,8.1312e+00_r8/) + kbo(:, 5,32,11) = (/ & + &5.6497e+01_r8,4.2506e+01_r8,2.9790e+01_r8,2.1188e+01_r8,8.1409e+00_r8/) + kbo(:, 1,33,11) = (/ & + &2.3401e+01_r8,1.8533e+01_r8,1.7371e+01_r8,1.5193e+01_r8,7.6839e+00_r8/) + kbo(:, 2,33,11) = (/ & + &3.1308e+01_r8,2.4009e+01_r8,2.0094e+01_r8,1.7155e+01_r8,7.9059e+00_r8/) + kbo(:, 3,33,11) = (/ & + &4.0829e+01_r8,3.0856e+01_r8,2.3455e+01_r8,1.9076e+01_r8,8.0587e+00_r8/) + kbo(:, 4,33,11) = (/ & + &5.2189e+01_r8,3.9272e+01_r8,2.8099e+01_r8,2.1008e+01_r8,8.1274e+00_r8/) + kbo(:, 5,33,11) = (/ & + &6.5586e+01_r8,4.9320e+01_r8,3.4075e+01_r8,2.2993e+01_r8,8.2027e+00_r8/) + kbo(:, 1,34,11) = (/ & + &2.6313e+01_r8,2.0607e+01_r8,1.8746e+01_r8,1.6201e+01_r8,7.7021e+00_r8/) + kbo(:, 2,34,11) = (/ & + &3.5155e+01_r8,2.6805e+01_r8,2.1758e+01_r8,1.8283e+01_r8,7.9397e+00_r8/) + kbo(:, 3,34,11) = (/ & + &4.5927e+01_r8,3.4632e+01_r8,2.5705e+01_r8,2.0353e+01_r8,8.0605e+00_r8/) + kbo(:, 4,34,11) = (/ & + &5.8835e+01_r8,4.4252e+01_r8,3.1197e+01_r8,2.2458e+01_r8,8.1311e+00_r8/) + kbo(:, 5,34,11) = (/ & + &7.4250e+01_r8,5.5815e+01_r8,3.8184e+01_r8,2.4701e+01_r8,8.2150e+00_r8/) + kbo(:, 1,35,11) = (/ & + &2.8876e+01_r8,2.2455e+01_r8,1.9946e+01_r8,1.7124e+01_r8,7.7224e+00_r8/) + kbo(:, 2,35,11) = (/ & + &3.8715e+01_r8,2.9405e+01_r8,2.3284e+01_r8,1.9326e+01_r8,7.9252e+00_r8/) + kbo(:, 3,35,11) = (/ & + &5.0778e+01_r8,3.8237e+01_r8,2.7902e+01_r8,2.1577e+01_r8,8.0258e+00_r8/) + kbo(:, 4,35,11) = (/ & + &6.5355e+01_r8,4.9140e+01_r8,3.4259e+01_r8,2.3860e+01_r8,8.1543e+00_r8/) + kbo(:, 5,35,11) = (/ & + &8.3003e+01_r8,6.2372e+01_r8,4.2365e+01_r8,2.6463e+01_r8,8.1938e+00_r8/) + kbo(:, 1,36,11) = (/ & + &3.0603e+01_r8,2.3731e+01_r8,2.0817e+01_r8,1.7816e+01_r8,7.6876e+00_r8/) + kbo(:, 2,36,11) = (/ & + &4.1304e+01_r8,3.1313e+01_r8,2.4462e+01_r8,2.0172e+01_r8,7.8715e+00_r8/) + kbo(:, 3,36,11) = (/ & + &5.4533e+01_r8,4.1035e+01_r8,2.9662e+01_r8,2.2576e+01_r8,7.9878e+00_r8/) + kbo(:, 4,36,11) = (/ & + &7.0736e+01_r8,5.3175e+01_r8,3.6832e+01_r8,2.5052e+01_r8,8.1404e+00_r8/) + kbo(:, 5,36,11) = (/ & + &9.0535e+01_r8,6.8017e+01_r8,4.6007e+01_r8,2.8044e+01_r8,8.2152e+00_r8/) + kbo(:, 1,37,11) = (/ & + &3.0255e+01_r8,2.3559e+01_r8,2.0925e+01_r8,1.7969e+01_r8,7.6093e+00_r8/) + kbo(:, 2,37,11) = (/ & + &4.1246e+01_r8,3.1319e+01_r8,2.4672e+01_r8,2.0442e+01_r8,7.8000e+00_r8/) + kbo(:, 3,37,11) = (/ & + &5.5008e+01_r8,4.1404e+01_r8,3.0029e+01_r8,2.2965e+01_r8,7.9652e+00_r8/) + kbo(:, 4,37,11) = (/ & + &7.2100e+01_r8,5.4198e+01_r8,3.7564e+01_r8,2.5602e+01_r8,8.1174e+00_r8/) + kbo(:, 5,37,11) = (/ & + &9.3252e+01_r8,7.0052e+01_r8,4.7363e+01_r8,2.8813e+01_r8,8.2379e+00_r8/) + kbo(:, 1,38,11) = (/ & + &3.0319e+01_r8,2.3676e+01_r8,2.1203e+01_r8,1.8223e+01_r8,7.5198e+00_r8/) + kbo(:, 2,38,11) = (/ & + &4.1784e+01_r8,3.1741e+01_r8,2.5125e+01_r8,2.0837e+01_r8,7.7243e+00_r8/) + kbo(:, 3,38,11) = (/ & + &5.6316e+01_r8,4.2385e+01_r8,3.0775e+01_r8,2.3517e+01_r8,7.9363e+00_r8/) + kbo(:, 4,38,11) = (/ & + &7.4582e+01_r8,5.6053e+01_r8,3.8823e+01_r8,2.6361e+01_r8,8.1242e+00_r8/) + kbo(:, 5,38,11) = (/ & + &9.7510e+01_r8,7.3243e+01_r8,4.9498e+01_r8,2.9889e+01_r8,8.2559e+00_r8/) + kbo(:, 1,39,11) = (/ & + &3.1111e+01_r8,2.4293e+01_r8,2.1786e+01_r8,1.8666e+01_r8,7.4239e+00_r8/) + kbo(:, 2,39,11) = (/ & + &4.3408e+01_r8,3.2962e+01_r8,2.6016e+01_r8,2.1461e+01_r8,7.6345e+00_r8/) + kbo(:, 3,39,11) = (/ & + &5.9150e+01_r8,4.4506e+01_r8,3.2172e+01_r8,2.4357e+01_r8,7.9192e+00_r8/) + kbo(:, 4,39,11) = (/ & + &7.9245e+01_r8,5.9549e+01_r8,4.1085e+01_r8,2.7494e+01_r8,8.1496e+00_r8/) + kbo(:, 5,39,11) = (/ & + &1.0467e+02_r8,7.8610e+01_r8,5.2990e+01_r8,3.1523e+01_r8,8.2789e+00_r8/) + kbo(:, 1,40,11) = (/ & + &2.8917e+01_r8,2.2849e+01_r8,2.1212e+01_r8,1.8303e+01_r8,7.3082e+00_r8/) + kbo(:, 2,40,11) = (/ & + &4.0995e+01_r8,3.1270e+01_r8,2.5375e+01_r8,2.1193e+01_r8,7.5582e+00_r8/) + kbo(:, 3,40,11) = (/ & + &5.6673e+01_r8,4.2684e+01_r8,3.1298e+01_r8,2.4183e+01_r8,7.8695e+00_r8/) + kbo(:, 4,40,11) = (/ & + &7.6946e+01_r8,5.7826e+01_r8,4.0125e+01_r8,2.7426e+01_r8,8.1312e+00_r8/) + kbo(:, 5,40,11) = (/ & + &1.0293e+02_r8,7.7305e+01_r8,5.2205e+01_r8,3.1496e+01_r8,8.2689e+00_r8/) + kbo(:, 1,41,11) = (/ & + &2.6634e+01_r8,2.1385e+01_r8,2.0561e+01_r8,1.7885e+01_r8,7.1901e+00_r8/) + kbo(:, 2,41,11) = (/ & + &3.8375e+01_r8,2.9451e+01_r8,2.4682e+01_r8,2.0867e+01_r8,7.4740e+00_r8/) + kbo(:, 3,41,11) = (/ & + &5.3928e+01_r8,4.0671e+01_r8,3.0356e+01_r8,2.3955e+01_r8,7.8182e+00_r8/) + kbo(:, 4,41,11) = (/ & + &7.4310e+01_r8,5.5850e+01_r8,3.9033e+01_r8,2.7309e+01_r8,8.0950e+00_r8/) + kbo(:, 5,41,11) = (/ & + &1.0067e+02_r8,7.5610e+01_r8,5.1206e+01_r8,3.1414e+01_r8,8.2644e+00_r8/) + kbo(:, 1,42,11) = (/ & + &2.4738e+01_r8,2.0233e+01_r8,2.0020e+01_r8,1.7547e+01_r8,7.0619e+00_r8/) + kbo(:, 2,42,11) = (/ & + &3.6234e+01_r8,2.7982e+01_r8,2.4175e+01_r8,2.0637e+01_r8,7.4025e+00_r8/) + kbo(:, 3,42,11) = (/ & + &5.1779e+01_r8,3.9115e+01_r8,2.9714e+01_r8,2.3853e+01_r8,7.7568e+00_r8/) + kbo(:, 4,42,11) = (/ & + &7.2527e+01_r8,5.4511e+01_r8,3.8357e+01_r8,2.7357e+01_r8,8.0593e+00_r8/) + kbo(:, 5,42,11) = (/ & + &9.9602e+01_r8,7.4807e+01_r8,5.0774e+01_r8,3.1579e+01_r8,8.2618e+00_r8/) + kbo(:, 1,43,11) = (/ & + &2.2598e+01_r8,1.8979e+01_r8,1.9339e+01_r8,1.7092e+01_r8,6.9063e+00_r8/) + kbo(:, 2,43,11) = (/ & + &3.3721e+01_r8,2.6289e+01_r8,2.3541e+01_r8,2.0300e+01_r8,7.2922e+00_r8/) + kbo(:, 3,43,11) = (/ & + &4.9059e+01_r8,3.7168e+01_r8,2.8920e+01_r8,2.3665e+01_r8,7.6599e+00_r8/) + kbo(:, 4,43,11) = (/ & + &6.9947e+01_r8,5.2582e+01_r8,3.7401e+01_r8,2.7324e+01_r8,7.9953e+00_r8/) + kbo(:, 5,43,11) = (/ & + &9.7637e+01_r8,7.3334e+01_r8,4.9954e+01_r8,3.1634e+01_r8,8.2449e+00_r8/) + kbo(:, 1,44,11) = (/ & + &2.0598e+01_r8,1.7877e+01_r8,1.8670e+01_r8,1.6634e+01_r8,6.7349e+00_r8/) + kbo(:, 2,44,11) = (/ & + &3.1385e+01_r8,2.4755e+01_r8,2.2973e+01_r8,1.9973e+01_r8,7.1646e+00_r8/) + kbo(:, 3,44,11) = (/ & + &4.6533e+01_r8,3.5381e+01_r8,2.8231e+01_r8,2.3518e+01_r8,7.5534e+00_r8/) + kbo(:, 4,44,11) = (/ & + &6.7572e+01_r8,5.0818e+01_r8,3.6582e+01_r8,2.7361e+01_r8,7.9184e+00_r8/) + kbo(:, 5,44,11) = (/ & + &9.6116e+01_r8,7.2195e+01_r8,4.9367e+01_r8,3.1819e+01_r8,8.2107e+00_r8/) + kbo(:, 1,45,11) = (/ & + &1.9103e+01_r8,1.7116e+01_r8,1.8163e+01_r8,1.6283e+01_r8,6.5605e+00_r8/) + kbo(:, 2,45,11) = (/ & + &2.9658e+01_r8,2.3682e+01_r8,2.2618e+01_r8,1.9789e+01_r8,7.0239e+00_r8/) + kbo(:, 3,45,11) = (/ & + &4.4853e+01_r8,3.4227e+01_r8,2.7909e+01_r8,2.3555e+01_r8,7.4383e+00_r8/) + kbo(:, 4,45,11) = (/ & + &6.6390e+01_r8,4.9954e+01_r8,3.6314e+01_r8,2.7640e+01_r8,7.8580e+00_r8/) + kbo(:, 5,45,11) = (/ & + &9.6230e+01_r8,7.2282e+01_r8,4.9573e+01_r8,3.2349e+01_r8,8.1505e+00_r8/) + kbo(:, 1,46,11) = (/ & + &1.7603e+01_r8,1.6408e+01_r8,1.7601e+01_r8,1.5877e+01_r8,6.3549e+00_r8/) + kbo(:, 2,46,11) = (/ & + &2.7890e+01_r8,2.2645e+01_r8,2.2217e+01_r8,1.9546e+01_r8,6.8535e+00_r8/) + kbo(:, 3,46,11) = (/ & + &4.3095e+01_r8,3.3035e+01_r8,2.7597e+01_r8,2.3556e+01_r8,7.2985e+00_r8/) + kbo(:, 4,46,11) = (/ & + &6.5080e+01_r8,4.9001e+01_r8,3.6011e+01_r8,2.7911e+01_r8,7.7668e+00_r8/) + kbo(:, 5,46,11) = (/ & + &9.6111e+01_r8,7.2194e+01_r8,4.9702e+01_r8,3.2895e+01_r8,8.0887e+00_r8/) + kbo(:, 1,47,11) = (/ & + &1.5582e+01_r8,1.5416e+01_r8,1.6712e+01_r8,1.5202e+01_r8,6.1058e+00_r8/) + kbo(:, 2,47,11) = (/ & + &2.5371e+01_r8,2.1144e+01_r8,2.1438e+01_r8,1.8984e+01_r8,6.6529e+00_r8/) + kbo(:, 3,47,11) = (/ & + &4.0058e+01_r8,3.0957e+01_r8,2.6834e+01_r8,2.3189e+01_r8,7.1345e+00_r8/) + kbo(:, 4,47,11) = (/ & + &6.1807e+01_r8,4.6615e+01_r8,3.4933e+01_r8,2.7758e+01_r8,7.6397e+00_r8/) + kbo(:, 5,47,11) = (/ & + &9.3127e+01_r8,6.9962e+01_r8,4.8499e+01_r8,3.2952e+01_r8,7.9851e+00_r8/) + kbo(:, 1,48,11) = (/ & + &1.4034e+01_r8,1.4681e+01_r8,1.5989e+01_r8,1.4629e+01_r8,5.8421e+00_r8/) + kbo(:, 2,48,11) = (/ & + &2.3558e+01_r8,2.0186e+01_r8,2.0890e+01_r8,1.8564e+01_r8,6.4412e+00_r8/) + kbo(:, 3,48,11) = (/ & + &3.8004e+01_r8,2.9609e+01_r8,2.6472e+01_r8,2.3010e+01_r8,6.9605e+00_r8/) + kbo(:, 4,48,11) = (/ & + &5.9949e+01_r8,4.5296e+01_r8,3.4518e+01_r8,2.7885e+01_r8,7.5000e+00_r8/) + kbo(:, 5,48,11) = (/ & + &9.2277e+01_r8,6.9322e+01_r8,4.8288e+01_r8,3.3402e+01_r8,7.8874e+00_r8/) + kbo(:, 1,49,11) = (/ & + &1.3020e+01_r8,1.4223e+01_r8,1.5508e+01_r8,1.4222e+01_r8,5.5629e+00_r8/) + kbo(:, 2,49,11) = (/ & + &2.2531e+01_r8,1.9765e+01_r8,2.0674e+01_r8,1.8360e+01_r8,6.2033e+00_r8/) + kbo(:, 3,49,11) = (/ & + &3.7326e+01_r8,2.9255e+01_r8,2.6622e+01_r8,2.3133e+01_r8,6.7696e+00_r8/) + kbo(:, 4,49,11) = (/ & + &6.0141e+01_r8,4.5507e+01_r8,3.5009e+01_r8,2.8438e+01_r8,7.3484e+00_r8/) + kbo(:, 5,49,11) = (/ & + &9.4669e+01_r8,7.1125e+01_r8,4.9613e+01_r8,3.4451e+01_r8,7.7676e+00_r8/) + kbo(:, 1,50,11) = (/ & + &1.1528e+01_r8,1.3385e+01_r8,1.4676e+01_r8,1.3553e+01_r8,5.2886e+00_r8/) + kbo(:, 2,50,11) = (/ & + &2.0590e+01_r8,1.8779e+01_r8,1.9954e+01_r8,1.7785e+01_r8,5.9683e+00_r8/) + kbo(:, 3,50,11) = (/ & + &3.5112e+01_r8,2.7878e+01_r8,2.6128e+01_r8,2.2750e+01_r8,6.5812e+00_r8/) + kbo(:, 4,50,11) = (/ & + &5.7821e+01_r8,4.3871e+01_r8,3.4428e+01_r8,2.8358e+01_r8,7.1800e+00_r8/) + kbo(:, 5,50,11) = (/ & + &9.2920e+01_r8,6.9817e+01_r8,4.9041e+01_r8,3.4691e+01_r8,7.6346e+00_r8/) + kbo(:, 1,51,11) = (/ & + &9.9087e+00_r8,1.2389e+01_r8,1.3702e+01_r8,1.2771e+01_r8,5.0110e+00_r8/) + kbo(:, 2,51,11) = (/ & + &1.8347e+01_r8,1.7625e+01_r8,1.8991e+01_r8,1.7018e+01_r8,5.7321e+00_r8/) + kbo(:, 3,51,11) = (/ & + &3.2210e+01_r8,2.6119e+01_r8,2.5308e+01_r8,2.2105e+01_r8,6.3824e+00_r8/) + kbo(:, 4,51,11) = (/ & + &5.4374e+01_r8,4.1438e+01_r8,3.3397e+01_r8,2.7944e+01_r8,7.0038e+00_r8/) + kbo(:, 5,51,11) = (/ & + &8.9118e+01_r8,6.6984e+01_r8,4.7570e+01_r8,3.4540e+01_r8,7.4941e+00_r8/) + kbo(:, 1,52,11) = (/ & + &8.6167e+00_r8,1.1576e+01_r8,1.2899e+01_r8,1.2089e+01_r8,4.7245e+00_r8/) + kbo(:, 2,52,11) = (/ & + &1.6651e+01_r8,1.6818e+01_r8,1.8231e+01_r8,1.6395e+01_r8,5.4842e+00_r8/) + kbo(:, 3,52,11) = (/ & + &3.0138e+01_r8,2.4957e+01_r8,2.4762e+01_r8,2.1646e+01_r8,6.1679e+00_r8/) + kbo(:, 4,52,11) = (/ & + &5.2273e+01_r8,4.0011e+01_r8,3.2952e+01_r8,2.7789e+01_r8,6.8199e+00_r8/) + kbo(:, 5,52,11) = (/ & + &8.7481e+01_r8,6.5781e+01_r8,4.7111e+01_r8,3.4770e+01_r8,7.3415e+00_r8/) + kbo(:, 1,53,11) = (/ & + &7.6702e+00_r8,1.0979e+01_r8,1.2289e+01_r8,1.1530e+01_r8,4.4295e+00_r8/) + kbo(:, 2,53,11) = (/ & + &1.5508e+01_r8,1.6366e+01_r8,1.7771e+01_r8,1.5970e+01_r8,5.2253e+00_r8/) + kbo(:, 3,53,11) = (/ & + &2.9086e+01_r8,2.4490e+01_r8,2.4633e+01_r8,2.1484e+01_r8,5.9485e+00_r8/) + kbo(:, 4,53,11) = (/ & + &5.1881e+01_r8,3.9852e+01_r8,3.3235e+01_r8,2.8055e+01_r8,6.6238e+00_r8/) + kbo(:, 5,53,11) = (/ & + &8.8988e+01_r8,6.6930e+01_r8,4.8082e+01_r8,3.5589e+01_r8,7.1849e+00_r8/) + kbo(:, 1,54,11) = (/ & + &5.9450e+00_r8,9.6177e+00_r8,1.0972e+01_r8,1.0431e+01_r8,4.1455e+00_r8/) + kbo(:, 2,54,11) = (/ & + &1.2556e+01_r8,1.4668e+01_r8,1.6126e+01_r8,1.4708e+01_r8,4.9524e+00_r8/) + kbo(:, 3,54,11) = (/ & + &2.4491e+01_r8,2.1770e+01_r8,2.2780e+01_r8,2.0031e+01_r8,5.7134e+00_r8/) + kbo(:, 4,54,11) = (/ & + &4.4954e+01_r8,3.5031e+01_r8,3.0908e+01_r8,2.6515e+01_r8,6.4122e+00_r8/) + kbo(:, 5,54,11) = (/ & + &7.9027e+01_r8,5.9569e+01_r8,4.4065e+01_r8,3.4001e+01_r8,7.0090e+00_r8/) + kbo(:, 1,55,11) = (/ & + &4.1710e+00_r8,8.0225e+00_r8,9.3978e+00_r8,9.1226e+00_r8,3.8682e+00_r8/) + kbo(:, 2,55,11) = (/ & + &9.2293e+00_r8,1.2486e+01_r8,1.4001e+01_r8,1.3070e+01_r8,4.6969e+00_r8/) + kbo(:, 3,55,11) = (/ & + &1.8778e+01_r8,1.8456e+01_r8,2.0084e+01_r8,1.7971e+01_r8,5.4658e+00_r8/) + kbo(:, 4,55,11) = (/ & + &3.5574e+01_r8,2.8777e+01_r8,2.7568e+01_r8,2.4021e+01_r8,6.1617e+00_r8/) + kbo(:, 5,55,11) = (/ & + &6.4114e+01_r8,4.8674e+01_r8,3.8113e+01_r8,3.1115e+01_r8,6.8236e+00_r8/) + kbo(:, 1,56,11) = (/ & + &2.8728e+00_r8,6.6889e+00_r8,8.0328e+00_r8,7.9557e+00_r8,3.5989e+00_r8/) + kbo(:, 2,56,11) = (/ & + &6.6874e+00_r8,1.0605e+01_r8,1.2156e+01_r8,1.1597e+01_r8,4.4247e+00_r8/) + kbo(:, 3,56,11) = (/ & + &1.4226e+01_r8,1.5908e+01_r8,1.7667e+01_r8,1.6104e+01_r8,5.2042e+00_r8/) + kbo(:, 4,56,11) = (/ & + &2.7945e+01_r8,2.3989e+01_r8,2.4626e+01_r8,2.1735e+01_r8,5.9393e+00_r8/) + kbo(:, 5,56,11) = (/ & + &5.1707e+01_r8,3.9775e+01_r8,3.3431e+01_r8,2.8442e+01_r8,6.5979e+00_r8/) + kbo(:, 1,57,11) = (/ & + &1.9429e+00_r8,5.5686e+00_r8,6.8405e+00_r8,6.9151e+00_r8,3.3226e+00_r8/) + kbo(:, 2,57,11) = (/ & + &4.7724e+00_r8,8.9791e+00_r8,1.0545e+01_r8,1.0240e+01_r8,4.1527e+00_r8/) + kbo(:, 3,57,11) = (/ & + &1.0641e+01_r8,1.3735e+01_r8,1.5504e+01_r8,1.4420e+01_r8,4.9657e+00_r8/) + kbo(:, 4,57,11) = (/ & + &2.1776e+01_r8,2.0320e+01_r8,2.1929e+01_r8,1.9615e+01_r8,5.6966e+00_r8/) + kbo(:, 5,57,11) = (/ & + &4.1383e+01_r8,3.2617e+01_r8,2.9771e+01_r8,2.5932e+01_r8,6.3597e+00_r8/) + kbo(:, 1,58,11) = (/ & + &3.4498e-01_r8,1.5267e+00_r8,2.4690e+00_r8,3.5849e+00_r8,3.0713e+00_r8/) + kbo(:, 2,58,11) = (/ & + &8.9647e-01_r8,2.5018e+00_r8,3.8790e+00_r8,5.3697e+00_r8,3.9024e+00_r8/) + kbo(:, 3,58,11) = (/ & + &2.0963e+00_r8,3.8966e+00_r8,5.7628e+00_r8,7.6647e+00_r8,4.7137e+00_r8/) + kbo(:, 4,58,11) = (/ & + &4.4774e+00_r8,5.7497e+00_r8,8.2495e+00_r8,1.0504e+01_r8,5.4718e+00_r8/) + kbo(:, 5,58,11) = (/ & + &8.7673e+00_r8,8.8663e+00_r8,1.1318e+01_r8,1.3996e+01_r8,6.1538e+00_r8/) + kbo(:, 1,59,11) = (/ & + &3.2685e-01_r8,1.8752e+00_r8,2.9232e+00_r8,3.9328e+00_r8,2.9672e+00_r8/) + kbo(:, 2,59,11) = (/ & + &8.8018e-01_r8,3.0635e+00_r8,4.5809e+00_r8,5.8034e+00_r8,3.8049e+00_r8/) + kbo(:, 3,59,11) = (/ & + &2.1278e+00_r8,4.7401e+00_r8,6.7591e+00_r8,8.2573e+00_r8,4.6076e+00_r8/) + kbo(:, 4,59,11) = (/ & + &4.6712e+00_r8,6.9756e+00_r8,9.6079e+00_r8,1.1224e+01_r8,5.3733e+00_r8/) + kbo(:, 5,59,11) = (/ & + &9.3271e+00_r8,1.0056e+01_r8,1.3155e+01_r8,1.4840e+01_r8,6.0503e+00_r8/) + kbo(:, 1,13,12) = (/ & + &7.5516e+02_r8,5.6651e+02_r8,3.7786e+02_r8,1.8921e+02_r8,4.6057e+00_r8/) + kbo(:, 2,13,12) = (/ & + &1.1031e+03_r8,8.2746e+02_r8,5.5183e+02_r8,2.7620e+02_r8,4.4752e+00_r8/) + kbo(:, 3,13,12) = (/ & + &1.5208e+03_r8,1.1407e+03_r8,7.6067e+02_r8,3.8062e+02_r8,4.3357e+00_r8/) + kbo(:, 4,13,12) = (/ & + &2.0072e+03_r8,1.5056e+03_r8,1.0039e+03_r8,5.0221e+02_r8,4.1960e+00_r8/) + kbo(:, 5,13,12) = (/ & + &2.5500e+03_r8,1.9126e+03_r8,1.2753e+03_r8,6.3790e+02_r8,4.0223e+00_r8/) + kbo(:, 1,14,12) = (/ & + &5.0313e+02_r8,3.7749e+02_r8,2.5185e+02_r8,1.2621e+02_r8,5.0046e+00_r8/) + kbo(:, 2,14,12) = (/ & + &7.2897e+02_r8,5.4687e+02_r8,3.6476e+02_r8,1.8266e+02_r8,4.8590e+00_r8/) + kbo(:, 3,14,12) = (/ & + &9.9893e+02_r8,7.4933e+02_r8,4.9972e+02_r8,2.5013e+02_r8,4.7095e+00_r8/) + kbo(:, 4,14,12) = (/ & + &1.3102e+03_r8,9.8276e+02_r8,6.5533e+02_r8,3.2791e+02_r8,4.5769e+00_r8/) + kbo(:, 5,14,12) = (/ & + &1.6551e+03_r8,1.2414e+03_r8,8.2775e+02_r8,4.1411e+02_r8,4.4631e+00_r8/) + kbo(:, 1,15,12) = (/ & + &3.3639e+02_r8,2.5243e+02_r8,1.6847e+02_r8,8.4507e+01_r8,5.4523e+00_r8/) + kbo(:, 2,15,12) = (/ & + &4.8280e+02_r8,3.6223e+02_r8,2.4166e+02_r8,1.2109e+02_r8,5.3133e+00_r8/) + kbo(:, 3,15,12) = (/ & + &6.5719e+02_r8,4.9302e+02_r8,3.2884e+02_r8,1.6466e+02_r8,5.1834e+00_r8/) + kbo(:, 4,15,12) = (/ & + &8.5550e+02_r8,6.4175e+02_r8,4.2799e+02_r8,2.1423e+02_r8,5.0660e+00_r8/) + kbo(:, 5,15,12) = (/ & + &1.0728e+03_r8,8.0472e+02_r8,5.3663e+02_r8,2.6854e+02_r8,4.9623e+00_r8/) + kbo(:, 1,16,12) = (/ & + &2.6229e+02_r8,1.9684e+02_r8,1.3139e+02_r8,6.5935e+01_r8,6.0512e+00_r8/) + kbo(:, 2,16,12) = (/ & + &3.7303e+02_r8,2.7989e+02_r8,1.8674e+02_r8,9.3604e+01_r8,5.9120e+00_r8/) + kbo(:, 3,16,12) = (/ & + &5.0297e+02_r8,3.7733e+02_r8,2.5170e+02_r8,1.2607e+02_r8,5.7872e+00_r8/) + kbo(:, 4,16,12) = (/ & + &6.4911e+02_r8,4.8694e+02_r8,3.2477e+02_r8,1.6260e+02_r8,5.6679e+00_r8/) + kbo(:, 5,16,12) = (/ & + &8.0986e+02_r8,6.0750e+02_r8,4.0515e+02_r8,2.0279e+02_r8,5.5547e+00_r8/) + kbo(:, 1,17,12) = (/ & + &2.0705e+02_r8,1.5540e+02_r8,1.0375e+02_r8,5.2106e+01_r8,6.7730e+00_r8/) + kbo(:, 2,17,12) = (/ & + &2.9135e+02_r8,2.1862e+02_r8,1.4589e+02_r8,7.3163e+01_r8,6.6333e+00_r8/) + kbo(:, 3,17,12) = (/ & + &3.8916e+02_r8,2.9197e+02_r8,1.9479e+02_r8,9.7603e+01_r8,6.4989e+00_r8/) + kbo(:, 4,17,12) = (/ & + &4.9976e+02_r8,3.7492e+02_r8,2.5009e+02_r8,1.2525e+02_r8,6.3687e+00_r8/) + kbo(:, 5,17,12) = (/ & + &6.2230e+02_r8,4.6683e+02_r8,3.1136e+02_r8,1.5589e+02_r8,6.2358e+00_r8/) + kbo(:, 1,18,12) = (/ & + &1.6333e+02_r8,1.2261e+02_r8,8.1888e+01_r8,4.1178e+01_r8,7.5424e+00_r8/) + kbo(:, 2,18,12) = (/ & + &2.2759e+02_r8,1.7080e+02_r8,1.1401e+02_r8,5.7226e+01_r8,7.4084e+00_r8/) + kbo(:, 3,18,12) = (/ & + &3.0244e+02_r8,2.2693e+02_r8,1.5143e+02_r8,7.5931e+01_r8,7.2669e+00_r8/) + kbo(:, 4,18,12) = (/ & + &3.8758e+02_r8,2.9079e+02_r8,1.9400e+02_r8,9.7216e+01_r8,7.1208e+00_r8/) + kbo(:, 5,18,12) = (/ & + &4.8269e+02_r8,3.6212e+02_r8,2.4155e+02_r8,1.2098e+02_r8,6.9720e+00_r8/) + kbo(:, 1,19,12) = (/ & + &1.2382e+02_r8,9.2977e+01_r8,6.2136e+01_r8,3.1325e+01_r8,8.3597e+00_r8/) + kbo(:, 2,19,12) = (/ & + &1.7154e+02_r8,1.2877e+02_r8,8.5994e+01_r8,4.3233e+01_r8,8.2061e+00_r8/) + kbo(:, 3,19,12) = (/ & + &2.2748e+02_r8,1.7072e+02_r8,1.1396e+02_r8,5.7206e+01_r8,8.0513e+00_r8/) + kbo(:, 4,19,12) = (/ & + &2.9138e+02_r8,2.1864e+02_r8,1.4590e+02_r8,7.3167e+01_r8,7.8994e+00_r8/) + kbo(:, 5,19,12) = (/ & + &3.6253e+02_r8,2.7200e+02_r8,1.8147e+02_r8,9.0939e+01_r8,7.7452e+00_r8/) + kbo(:, 1,20,12) = (/ & + &1.0042e+02_r8,7.5430e+01_r8,5.0444e+01_r8,2.5891e+01_r8,9.1675e+00_r8/) + kbo(:, 2,20,12) = (/ & + &1.3861e+02_r8,1.0407e+02_r8,6.9532e+01_r8,3.5031e+01_r8,9.0030e+00_r8/) + kbo(:, 3,20,12) = (/ & + &1.8351e+02_r8,1.3774e+02_r8,9.1975e+01_r8,4.6211e+01_r8,8.8390e+00_r8/) + kbo(:, 4,20,12) = (/ & + &2.3463e+02_r8,1.7607e+02_r8,1.1752e+02_r8,5.8971e+01_r8,8.6735e+00_r8/) + kbo(:, 5,20,12) = (/ & + &2.9128e+02_r8,2.1856e+02_r8,1.4583e+02_r8,7.3117e+01_r8,8.5016e+00_r8/) + kbo(:, 1,21,12) = (/ & + &8.3057e+01_r8,6.2407e+01_r8,4.1762e+01_r8,2.2683e+01_r8,9.9550e+00_r8/) + kbo(:, 2,21,12) = (/ & + &1.1435e+02_r8,8.5868e+01_r8,5.7394e+01_r8,2.9474e+01_r8,9.7863e+00_r8/) + kbo(:, 3,21,12) = (/ & + &1.5096e+02_r8,1.1332e+02_r8,7.5686e+01_r8,3.8128e+01_r8,9.6108e+00_r8/) + kbo(:, 4,21,12) = (/ & + &1.9244e+02_r8,1.4443e+02_r8,9.6415e+01_r8,4.8410e+01_r8,9.4311e+00_r8/) + kbo(:, 5,21,12) = (/ & + &2.3840e+02_r8,1.7889e+02_r8,1.1939e+02_r8,5.9885e+01_r8,9.2417e+00_r8/) + kbo(:, 1,22,12) = (/ & + &7.1250e+01_r8,5.3549e+01_r8,3.5853e+01_r8,2.1126e+01_r8,1.0685e+01_r8/) + kbo(:, 2,22,12) = (/ & + &9.7414e+01_r8,7.3164e+01_r8,4.8918e+01_r8,2.6307e+01_r8,1.0512e+01_r8/) + kbo(:, 3,22,12) = (/ & + &1.2780e+02_r8,9.5945e+01_r8,6.4097e+01_r8,3.2967e+01_r8,1.0335e+01_r8/) + kbo(:, 4,22,12) = (/ & + &1.6218e+02_r8,1.2173e+02_r8,8.1281e+01_r8,4.1038e+01_r8,1.0145e+01_r8/) + kbo(:, 5,22,12) = (/ & + &2.0041e+02_r8,1.5040e+02_r8,1.0039e+02_r8,5.0398e+01_r8,9.9454e+00_r8/) + kbo(:, 1,23,12) = (/ & + &6.0942e+01_r8,4.5813e+01_r8,3.0934e+01_r8,2.0012e+01_r8,1.1340e+01_r8/) + kbo(:, 2,23,12) = (/ & + &8.2640e+01_r8,6.2081e+01_r8,4.1527e+01_r8,2.4053e+01_r8,1.1180e+01_r8/) + kbo(:, 3,23,12) = (/ & + &1.0785e+02_r8,8.0983e+01_r8,5.4124e+01_r8,2.9110e+01_r8,1.1001e+01_r8/) + kbo(:, 4,23,12) = (/ & + &1.3652e+02_r8,1.0249e+02_r8,6.8454e+01_r8,3.5343e+01_r8,1.0812e+01_r8/) + kbo(:, 5,23,12) = (/ & + &1.6894e+02_r8,1.2680e+02_r8,8.4663e+01_r8,4.2880e+01_r8,1.0609e+01_r8/) + kbo(:, 1,24,12) = (/ & + &5.1406e+01_r8,3.8659e+01_r8,2.6835e+01_r8,1.9368e+01_r8,1.1917e+01_r8/) + kbo(:, 2,24,12) = (/ & + &6.9266e+01_r8,5.2052e+01_r8,3.5118e+01_r8,2.2283e+01_r8,1.1770e+01_r8/) + kbo(:, 3,24,12) = (/ & + &9.0127e+01_r8,6.7693e+01_r8,4.5282e+01_r8,2.6104e+01_r8,1.1607e+01_r8/) + kbo(:, 4,24,12) = (/ & + &1.1424e+02_r8,8.5780e+01_r8,5.7328e+01_r8,3.0937e+01_r8,1.1421e+01_r8/) + kbo(:, 5,24,12) = (/ & + &1.4182e+02_r8,1.0646e+02_r8,7.1109e+01_r8,3.6894e+01_r8,1.1218e+01_r8/) + kbo(:, 1,25,12) = (/ & + &4.3762e+01_r8,3.2928e+01_r8,2.3974e+01_r8,1.9297e+01_r8,1.2406e+01_r8/) + kbo(:, 2,25,12) = (/ & + &5.8726e+01_r8,4.4147e+01_r8,3.0453e+01_r8,2.1379e+01_r8,1.2284e+01_r8/) + kbo(:, 3,25,12) = (/ & + &7.6463e+01_r8,5.7453e+01_r8,3.8735e+01_r8,2.4187e+01_r8,1.2134e+01_r8/) + kbo(:, 4,25,12) = (/ & + &9.7222e+01_r8,7.3021e+01_r8,4.8859e+01_r8,2.7987e+01_r8,1.1961e+01_r8/) + kbo(:, 5,25,12) = (/ & + &1.2098e+02_r8,9.0828e+01_r8,6.0694e+01_r8,3.2765e+01_r8,1.1759e+01_r8/) + kbo(:, 1,26,12) = (/ & + &3.8022e+01_r8,2.8659e+01_r8,2.2105e+01_r8,1.9516e+01_r8,1.2805e+01_r8/) + kbo(:, 2,26,12) = (/ & + &5.0994e+01_r8,3.8356e+01_r8,2.7362e+01_r8,2.1131e+01_r8,1.2709e+01_r8/) + kbo(:, 3,26,12) = (/ & + &6.6538e+01_r8,5.0014e+01_r8,3.4258e+01_r8,2.3250e+01_r8,1.2582e+01_r8/) + kbo(:, 4,26,12) = (/ & + &8.4702e+01_r8,6.3631e+01_r8,4.2833e+01_r8,2.6169e+01_r8,1.2418e+01_r8/) + kbo(:, 5,26,12) = (/ & + &1.0565e+02_r8,7.9327e+01_r8,5.3062e+01_r8,3.0028e+01_r8,1.2216e+01_r8/) + kbo(:, 1,27,12) = (/ & + &3.4489e+01_r8,2.6132e+01_r8,2.1235e+01_r8,1.9878e+01_r8,1.3122e+01_r8/) + kbo(:, 2,27,12) = (/ & + &4.6305e+01_r8,3.4844e+01_r8,2.5714e+01_r8,2.1342e+01_r8,1.3062e+01_r8/) + kbo(:, 3,27,12) = (/ & + &6.0441e+01_r8,4.5443e+01_r8,3.1734e+01_r8,2.3085e+01_r8,1.2955e+01_r8/) + kbo(:, 4,27,12) = (/ & + &7.7109e+01_r8,5.7931e+01_r8,3.9347e+01_r8,2.5409e+01_r8,1.2800e+01_r8/) + kbo(:, 5,27,12) = (/ & + &9.6578e+01_r8,7.2521e+01_r8,4.8662e+01_r8,2.8654e+01_r8,1.2602e+01_r8/) + kbo(:, 1,28,12) = (/ & + &3.2427e+01_r8,2.4737e+01_r8,2.0948e+01_r8,2.0280e+01_r8,1.3386e+01_r8/) + kbo(:, 2,28,12) = (/ & + &4.3501e+01_r8,3.2787e+01_r8,2.4919e+01_r8,2.1714e+01_r8,1.3352e+01_r8/) + kbo(:, 3,28,12) = (/ & + &5.6891e+01_r8,4.2776e+01_r8,3.0416e+01_r8,2.3252e+01_r8,1.3262e+01_r8/) + kbo(:, 4,28,12) = (/ & + &7.2922e+01_r8,5.4789e+01_r8,3.7531e+01_r8,2.5273e+01_r8,1.3118e+01_r8/) + kbo(:, 5,28,12) = (/ & + &9.1872e+01_r8,6.8992e+01_r8,4.6457e+01_r8,2.8166e+01_r8,1.2926e+01_r8/) + kbo(:, 1,29,12) = (/ & + &3.2667e+01_r8,2.5018e+01_r8,2.1498e+01_r8,2.0955e+01_r8,1.3603e+01_r8/) + kbo(:, 2,29,12) = (/ & + &4.3912e+01_r8,3.3123e+01_r8,2.5431e+01_r8,2.2422e+01_r8,1.3591e+01_r8/) + kbo(:, 3,29,12) = (/ & + &5.7701e+01_r8,4.3385e+01_r8,3.1008e+01_r8,2.3974e+01_r8,1.3517e+01_r8/) + kbo(:, 4,29,12) = (/ & + &7.4275e+01_r8,5.5806e+01_r8,3.8313e+01_r8,2.6005e+01_r8,1.3383e+01_r8/) + kbo(:, 5,29,12) = (/ & + &9.3871e+01_r8,7.0500e+01_r8,4.7521e+01_r8,2.8930e+01_r8,1.3178e+01_r8/) + kbo(:, 1,30,12) = (/ & + &3.4156e+01_r8,2.6153e+01_r8,2.2429e+01_r8,2.1713e+01_r8,1.3788e+01_r8/) + kbo(:, 2,30,12) = (/ & + &4.6027e+01_r8,3.4711e+01_r8,2.6560e+01_r8,2.3234e+01_r8,1.3795e+01_r8/) + kbo(:, 3,30,12) = (/ & + &6.0622e+01_r8,4.5582e+01_r8,3.2488e+01_r8,2.4921e+01_r8,1.3734e+01_r8/) + kbo(:, 4,30,12) = (/ & + &7.8321e+01_r8,5.8857e+01_r8,4.0368e+01_r8,2.7080e+01_r8,1.3599e+01_r8/) + kbo(:, 5,30,12) = (/ & + &9.9301e+01_r8,7.4592e+01_r8,5.0256e+01_r8,3.0286e+01_r8,1.3384e+01_r8/) + kbo(:, 1,31,12) = (/ & + &3.8076e+01_r8,2.9005e+01_r8,2.4159e+01_r8,2.2772e+01_r8,1.3950e+01_r8/) + kbo(:, 2,31,12) = (/ & + &5.1386e+01_r8,3.8696e+01_r8,2.8953e+01_r8,2.4505e+01_r8,1.3973e+01_r8/) + kbo(:, 3,31,12) = (/ & + &6.7843e+01_r8,5.1009e+01_r8,3.5918e+01_r8,2.6433e+01_r8,1.3920e+01_r8/) + kbo(:, 4,31,12) = (/ & + &8.7812e+01_r8,6.5990e+01_r8,4.4995e+01_r8,2.9071e+01_r8,1.3753e+01_r8/) + kbo(:, 5,31,12) = (/ & + &1.1160e+02_r8,8.3824e+01_r8,5.6340e+01_r8,3.3050e+01_r8,1.3573e+01_r8/) + kbo(:, 1,32,12) = (/ & + &4.3422e+01_r8,3.2909e+01_r8,2.6354e+01_r8,2.4011e+01_r8,1.4101e+01_r8/) + kbo(:, 2,32,12) = (/ & + &5.8749e+01_r8,4.4202e+01_r8,3.2268e+01_r8,2.6008e+01_r8,1.4129e+01_r8/) + kbo(:, 3,32,12) = (/ & + &7.7682e+01_r8,5.8398e+01_r8,4.0569e+01_r8,2.8355e+01_r8,1.4037e+01_r8/) + kbo(:, 4,32,12) = (/ & + &1.0053e+02_r8,7.5534e+01_r8,5.1158e+01_r8,3.1768e+01_r8,1.3909e+01_r8/) + kbo(:, 5,32,12) = (/ & + &1.2780e+02_r8,9.5988e+01_r8,6.4344e+01_r8,3.6705e+01_r8,1.3757e+01_r8/) + kbo(:, 1,33,12) = (/ & + &5.0972e+01_r8,3.8474e+01_r8,2.9509e+01_r8,2.5608e+01_r8,1.4236e+01_r8/) + kbo(:, 2,33,12) = (/ & + &6.8978e+01_r8,5.1873e+01_r8,3.6983e+01_r8,2.7940e+01_r8,1.4225e+01_r8/) + kbo(:, 3,33,12) = (/ & + &9.1196e+01_r8,6.8536e+01_r8,4.6964e+01_r8,3.1045e+01_r8,1.4156e+01_r8/) + kbo(:, 4,33,12) = (/ & + &1.1806e+02_r8,8.8684e+01_r8,5.9688e+01_r8,3.5479e+01_r8,1.4053e+01_r8/) + kbo(:, 5,33,12) = (/ & + &1.5026e+02_r8,1.1283e+02_r8,7.5476e+01_r8,4.1722e+01_r8,1.3797e+01_r8/) + kbo(:, 1,34,12) = (/ & + &5.8196e+01_r8,4.3842e+01_r8,3.2696e+01_r8,2.7075e+01_r8,1.4322e+01_r8/) + kbo(:, 2,34,12) = (/ & + &7.8717e+01_r8,5.9180e+01_r8,4.1505e+01_r8,2.9899e+01_r8,1.4304e+01_r8/) + kbo(:, 3,34,12) = (/ & + &1.0408e+02_r8,7.8203e+01_r8,5.3150e+01_r8,3.3676e+01_r8,1.4279e+01_r8/) + kbo(:, 4,34,12) = (/ & + &1.3497e+02_r8,1.0137e+02_r8,6.8004e+01_r8,3.9142e+01_r8,1.4130e+01_r8/) + kbo(:, 5,34,12) = (/ & + &1.7215e+02_r8,1.2926e+02_r8,8.6400e+01_r8,4.6696e+01_r8,1.3817e+01_r8/) + kbo(:, 1,35,12) = (/ & + &6.4953e+01_r8,4.8885e+01_r8,3.5777e+01_r8,2.8513e+01_r8,1.4376e+01_r8/) + kbo(:, 2,35,12) = (/ & + &8.7973e+01_r8,6.6128e+01_r8,4.5876e+01_r8,3.1844e+01_r8,1.4423e+01_r8/) + kbo(:, 3,35,12) = (/ & + &1.1659e+02_r8,8.7588e+01_r8,5.9213e+01_r8,3.6344e+01_r8,1.4380e+01_r8/) + kbo(:, 4,35,12) = (/ & + &1.5177e+02_r8,1.1397e+02_r8,7.6316e+01_r8,4.2891e+01_r8,1.4142e+01_r8/) + kbo(:, 5,35,12) = (/ & + &1.9438e+02_r8,1.4593e+02_r8,9.7521e+01_r8,5.1793e+01_r8,1.3951e+01_r8/) + kbo(:, 1,36,12) = (/ & + &7.0028e+01_r8,5.2692e+01_r8,3.8196e+01_r8,2.9764e+01_r8,1.4429e+01_r8/) + kbo(:, 2,36,12) = (/ & + &9.5230e+01_r8,7.1580e+01_r8,4.9388e+01_r8,3.3491e+01_r8,1.4515e+01_r8/) + kbo(:, 3,36,12) = (/ & + &1.2679e+02_r8,9.5251e+01_r8,6.4219e+01_r8,3.8654e+01_r8,1.4447e+01_r8/) + kbo(:, 4,36,12) = (/ & + &1.6604e+02_r8,1.2468e+02_r8,8.3408e+01_r8,4.6199e+01_r8,1.4226e+01_r8/) + kbo(:, 5,36,12) = (/ & + &2.1406e+02_r8,1.6070e+02_r8,1.0737e+02_r8,5.6401e+01_r8,1.4079e+01_r8/) + kbo(:, 1,37,12) = (/ & + &7.0336e+01_r8,5.2944e+01_r8,3.8605e+01_r8,3.0262e+01_r8,1.4492e+01_r8/) + kbo(:, 2,37,12) = (/ & + &9.6465e+01_r8,7.2514e+01_r8,5.0131e+01_r8,3.4164e+01_r8,1.4585e+01_r8/) + kbo(:, 3,37,12) = (/ & + &1.2955e+02_r8,9.7324e+01_r8,6.5642e+01_r8,3.9574e+01_r8,1.4537e+01_r8/) + kbo(:, 4,37,12) = (/ & + &1.7114e+02_r8,1.2851e+02_r8,8.5971e+01_r8,4.7570e+01_r8,1.4312e+01_r8/) + kbo(:, 5,37,12) = (/ & + &2.2257e+02_r8,1.6708e+02_r8,1.1162e+02_r8,5.8523e+01_r8,1.4157e+01_r8/) + kbo(:, 1,38,12) = (/ & + &7.1653e+01_r8,5.3935e+01_r8,3.9443e+01_r8,3.0956e+01_r8,1.4537e+01_r8/) + kbo(:, 2,38,12) = (/ & + &9.9371e+01_r8,7.4697e+01_r8,5.1646e+01_r8,3.5117e+01_r8,1.4670e+01_r8/) + kbo(:, 3,38,12) = (/ & + &1.3467e+02_r8,1.0116e+02_r8,6.8199e+01_r8,4.0938e+01_r8,1.4595e+01_r8/) + kbo(:, 4,38,12) = (/ & + &1.7944e+02_r8,1.3474e+02_r8,9.0110e+01_r8,4.9614e+01_r8,1.4367e+01_r8/) + kbo(:, 5,38,12) = (/ & + &2.3537e+02_r8,1.7668e+02_r8,1.1802e+02_r8,6.1608e+01_r8,1.4213e+01_r8/) + kbo(:, 1,39,12) = (/ & + &7.4953e+01_r8,5.6404e+01_r8,4.1108e+01_r8,3.2048e+01_r8,1.4593e+01_r8/) + kbo(:, 2,39,12) = (/ & + &1.0508e+02_r8,7.8982e+01_r8,5.4463e+01_r8,3.6606e+01_r8,1.4737e+01_r8/) + kbo(:, 3,39,12) = (/ & + &1.4387e+02_r8,1.0807e+02_r8,7.2745e+01_r8,4.3123e+01_r8,1.4593e+01_r8/) + kbo(:, 4,39,12) = (/ & + &1.9336e+02_r8,1.4518e+02_r8,9.7046e+01_r8,5.2882e+01_r8,1.4422e+01_r8/) + kbo(:, 5,39,12) = (/ & + &2.5579e+02_r8,1.9200e+02_r8,1.2823e+02_r8,6.6478e+01_r8,1.4241e+01_r8/) + kbo(:, 1,40,12) = (/ & + &7.1125e+01_r8,5.3576e+01_r8,3.9744e+01_r8,3.1845e+01_r8,1.4584e+01_r8/) + kbo(:, 2,40,12) = (/ & + &1.0123e+02_r8,7.6093e+01_r8,5.2813e+01_r8,3.6464e+01_r8,1.4753e+01_r8/) + kbo(:, 3,40,12) = (/ & + &1.4047e+02_r8,1.0551e+02_r8,7.1189e+01_r8,4.2876e+01_r8,1.4635e+01_r8/) + kbo(:, 4,40,12) = (/ & + &1.9075e+02_r8,1.4322e+02_r8,9.5759e+01_r8,5.2592e+01_r8,1.4461e+01_r8/) + kbo(:, 5,40,12) = (/ & + &2.5487e+02_r8,1.9131e+02_r8,1.2777e+02_r8,6.6443e+01_r8,1.4311e+01_r8/) + kbo(:, 1,41,12) = (/ & + &6.6999e+01_r8,5.0553e+01_r8,3.8328e+01_r8,3.1540e+01_r8,1.4557e+01_r8/) + kbo(:, 2,41,12) = (/ & + &9.6989e+01_r8,7.2904e+01_r8,5.1038e+01_r8,3.6239e+01_r8,1.4754e+01_r8/) + kbo(:, 3,41,12) = (/ & + &1.3645e+02_r8,1.0250e+02_r8,6.9354e+01_r8,4.2559e+01_r8,1.4660e+01_r8/) + kbo(:, 4,41,12) = (/ & + &1.8750e+02_r8,1.4078e+02_r8,9.4178e+01_r8,5.2196e+01_r8,1.4491e+01_r8/) + kbo(:, 5,41,12) = (/ & + &2.5297e+02_r8,1.8988e+02_r8,1.2682e+02_r8,6.6184e+01_r8,1.4389e+01_r8/) + kbo(:, 1,42,12) = (/ & + &6.3698e+01_r8,4.8173e+01_r8,3.7314e+01_r8,3.1356e+01_r8,1.4515e+01_r8/) + kbo(:, 2,42,12) = (/ & + &9.3921e+01_r8,7.0600e+01_r8,4.9842e+01_r8,3.6216e+01_r8,1.4716e+01_r8/) + kbo(:, 3,42,12) = (/ & + &1.3407e+02_r8,1.0072e+02_r8,6.8313e+01_r8,4.2558e+01_r8,1.4673e+01_r8/) + kbo(:, 4,42,12) = (/ & + &1.8663e+02_r8,1.4013e+02_r8,9.3782e+01_r8,5.2338e+01_r8,1.4521e+01_r8/) + kbo(:, 5,42,12) = (/ & + &2.5424e+02_r8,1.9084e+02_r8,1.2745e+02_r8,6.6667e+01_r8,1.4444e+01_r8/) + kbo(:, 1,43,12) = (/ & + &5.9556e+01_r8,4.5221e+01_r8,3.6039e+01_r8,3.0985e+01_r8,1.4424e+01_r8/) + kbo(:, 2,43,12) = (/ & + &8.9715e+01_r8,6.7448e+01_r8,4.8196e+01_r8,3.6053e+01_r8,1.4672e+01_r8/) + kbo(:, 3,43,12) = (/ & + &1.3041e+02_r8,9.7958e+01_r8,6.6682e+01_r8,4.2356e+01_r8,1.4685e+01_r8/) + kbo(:, 4,43,12) = (/ & + &1.8413e+02_r8,1.3825e+02_r8,9.2592e+01_r8,5.2204e+01_r8,1.4530e+01_r8/) + kbo(:, 5,43,12) = (/ & + &2.5372e+02_r8,1.9044e+02_r8,1.2719e+02_r8,6.6793e+01_r8,1.4531e+01_r8/) + kbo(:, 1,44,12) = (/ & + &5.5617e+01_r8,4.2462e+01_r8,3.4926e+01_r8,3.0616e+01_r8,1.4301e+01_r8/) + kbo(:, 2,44,12) = (/ & + &8.5711e+01_r8,6.4467e+01_r8,4.6726e+01_r8,3.5948e+01_r8,1.4602e+01_r8/) + kbo(:, 3,44,12) = (/ & + &1.2713e+02_r8,9.5499e+01_r8,6.5283e+01_r8,4.2294e+01_r8,1.4674e+01_r8/) + kbo(:, 4,44,12) = (/ & + &1.8238e+02_r8,1.3694e+02_r8,9.1783e+01_r8,5.2246e+01_r8,1.4528e+01_r8/) + kbo(:, 5,44,12) = (/ & + &2.5466e+02_r8,1.9115e+02_r8,1.2766e+02_r8,6.7294e+01_r8,1.4570e+01_r8/) + kbo(:, 1,45,12) = (/ & + &5.2685e+01_r8,4.0486e+01_r8,3.4264e+01_r8,3.0427e+01_r8,1.4151e+01_r8/) + kbo(:, 2,45,12) = (/ & + &8.3179e+01_r8,6.2605e+01_r8,4.5965e+01_r8,3.6072e+01_r8,1.4507e+01_r8/) + kbo(:, 3,45,12) = (/ & + &1.2601e+02_r8,9.4652e+01_r8,6.4923e+01_r8,4.2669e+01_r8,1.4643e+01_r8/) + kbo(:, 4,45,12) = (/ & + &1.8401e+02_r8,1.3816e+02_r8,9.2634e+01_r8,5.3005e+01_r8,1.4503e+01_r8/) + kbo(:, 5,45,12) = (/ & + &2.6050e+02_r8,1.9553e+02_r8,1.3058e+02_r8,6.8905e+01_r8,1.4618e+01_r8/) + kbo(:, 1,46,12) = (/ & + &4.9550e+01_r8,3.8366e+01_r8,3.3605e+01_r8,3.0155e+01_r8,1.3963e+01_r8/) + kbo(:, 2,46,12) = (/ & + &8.0337e+01_r8,6.0538e+01_r8,4.5156e+01_r8,3.6142e+01_r8,1.4400e+01_r8/) + kbo(:, 3,46,12) = (/ & + &1.2453e+02_r8,9.3545e+01_r8,6.4429e+01_r8,4.3023e+01_r8,1.4594e+01_r8/) + kbo(:, 4,46,12) = (/ & + &1.8550e+02_r8,1.3927e+02_r8,9.3438e+01_r8,5.3784e+01_r8,1.4498e+01_r8/) + kbo(:, 5,46,12) = (/ & + &2.6666e+02_r8,2.0015e+02_r8,1.3366e+02_r8,7.0579e+01_r8,1.4676e+01_r8/) + kbo(:, 1,47,12) = (/ & + &4.4761e+01_r8,3.5144e+01_r8,3.2385e+01_r8,2.9408e+01_r8,1.3714e+01_r8/) + kbo(:, 2,47,12) = (/ & + &7.4836e+01_r8,5.6569e+01_r8,4.3337e+01_r8,3.5671e+01_r8,1.4241e+01_r8/) + kbo(:, 3,47,12) = (/ & + &1.1904e+02_r8,8.9427e+01_r8,6.2124e+01_r8,4.2720e+01_r8,1.4513e+01_r8/) + kbo(:, 4,47,12) = (/ & + &1.8135e+02_r8,1.3615e+02_r8,9.1529e+01_r8,5.3518e+01_r8,1.4491e+01_r8/) + kbo(:, 5,47,12) = (/ & + &2.6557e+02_r8,1.9933e+02_r8,1.3311e+02_r8,7.0671e+01_r8,1.4708e+01_r8/) + kbo(:, 1,48,12) = (/ & + &4.1069e+01_r8,3.2801e+01_r8,3.1586e+01_r8,2.8865e+01_r8,1.3457e+01_r8/) + kbo(:, 2,48,12) = (/ & + &7.0975e+01_r8,5.3819e+01_r8,4.2302e+01_r8,3.5478e+01_r8,1.4056e+01_r8/) + kbo(:, 3,48,12) = (/ & + &1.1614e+02_r8,8.7254e+01_r8,6.1078e+01_r8,4.2908e+01_r8,1.4399e+01_r8/) + kbo(:, 4,48,12) = (/ & + &1.8113e+02_r8,1.3599e+02_r8,9.1560e+01_r8,5.4099e+01_r8,1.4482e+01_r8/) + kbo(:, 5,48,12) = (/ & + &2.7078e+02_r8,2.0323e+02_r8,1.3570e+02_r8,7.2222e+01_r8,1.4704e+01_r8/) + kbo(:, 1,49,12) = (/ & + &3.8731e+01_r8,3.1486e+01_r8,3.1265e+01_r8,2.8628e+01_r8,1.3159e+01_r8/) + kbo(:, 2,49,12) = (/ & + &6.9397e+01_r8,5.2759e+01_r8,4.2223e+01_r8,3.5759e+01_r8,1.3841e+01_r8/) + kbo(:, 3,49,12) = (/ & + &1.1709e+02_r8,8.7966e+01_r8,6.1851e+01_r8,4.3836e+01_r8,1.4254e+01_r8/) + kbo(:, 4,49,12) = (/ & + &1.8714e+02_r8,1.4049e+02_r8,9.4623e+01_r8,5.5973e+01_r8,1.4472e+01_r8/) + kbo(:, 5,49,12) = (/ & + &2.8581e+02_r8,2.1450e+02_r8,1.4321e+02_r8,7.6013e+01_r8,1.4713e+01_r8/) + kbo(:, 1,50,12) = (/ & + &3.4845e+01_r8,2.9222e+01_r8,3.0219e+01_r8,2.7841e+01_r8,1.2848e+01_r8/) + kbo(:, 2,50,12) = (/ & + &6.4780e+01_r8,4.9517e+01_r8,4.0909e+01_r8,3.5306e+01_r8,1.3605e+01_r8/) + kbo(:, 3,50,12) = (/ & + &1.1280e+02_r8,8.4759e+01_r8,6.0286e+01_r8,4.3805e+01_r8,1.4114e+01_r8/) + kbo(:, 4,50,12) = (/ & + &1.8491e+02_r8,1.3882e+02_r8,9.3723e+01_r8,5.6179e+01_r8,1.4404e+01_r8/) + kbo(:, 5,50,12) = (/ & + &2.8849e+02_r8,2.1650e+02_r8,1.4455e+02_r8,7.7018e+01_r8,1.4673e+01_r8/) + kbo(:, 1,51,12) = (/ & + &3.0519e+01_r8,2.6754e+01_r8,2.8814e+01_r8,2.6775e+01_r8,1.2516e+01_r8/) + kbo(:, 2,51,12) = (/ & + &5.8895e+01_r8,4.5411e+01_r8,3.9106e+01_r8,3.4462e+01_r8,1.3344e+01_r8/) + kbo(:, 3,51,12) = (/ & + &1.0594e+02_r8,7.9673e+01_r8,5.7668e+01_r8,4.3297e+01_r8,1.3940e+01_r8/) + kbo(:, 4,51,12) = (/ & + &1.7846e+02_r8,1.3399e+02_r8,9.0800e+01_r8,5.5546e+01_r8,1.4316e+01_r8/) + kbo(:, 5,51,12) = (/ & + &2.8452e+02_r8,2.1353e+02_r8,1.4260e+02_r8,7.6552e+01_r8,1.4603e+01_r8/) + kbo(:, 1,52,12) = (/ & + &2.7172e+01_r8,2.4938e+01_r8,2.7638e+01_r8,2.5911e+01_r8,1.2154e+01_r8/) + kbo(:, 2,52,12) = (/ & + &5.4443e+01_r8,4.2404e+01_r8,3.7930e+01_r8,3.3867e+01_r8,1.3047e+01_r8/) + kbo(:, 3,52,12) = (/ & + &1.0140e+02_r8,7.6335e+01_r8,5.6140e+01_r8,4.3191e+01_r8,1.3744e+01_r8/) + kbo(:, 4,52,12) = (/ & + &1.7597e+02_r8,1.3212e+02_r8,8.9791e+01_r8,5.5744e+01_r8,1.4204e+01_r8/) + kbo(:, 5,52,12) = (/ & + &2.8690e+02_r8,2.1531e+02_r8,1.4382e+02_r8,7.7564e+01_r8,1.4539e+01_r8/) + kbo(:, 1,53,12) = (/ & + &2.4852e+01_r8,2.3783e+01_r8,2.6797e+01_r8,2.5306e+01_r8,1.1753e+01_r8/) + kbo(:, 2,53,12) = (/ & + &5.1806e+01_r8,4.0721e+01_r8,3.7447e+01_r8,3.3656e+01_r8,1.2720e+01_r8/) + kbo(:, 3,53,12) = (/ & + &1.0002e+02_r8,7.5369e+01_r8,5.6019e+01_r8,4.3667e+01_r8,1.3525e+01_r8/) + kbo(:, 4,53,12) = (/ & + &1.7916e+02_r8,1.3451e+02_r8,9.1517e+01_r8,5.7134e+01_r8,1.4067e+01_r8/) + kbo(:, 5,53,12) = (/ & + &2.9931e+02_r8,2.2462e+02_r8,1.5004e+02_r8,8.0825e+01_r8,1.4479e+01_r8/) + kbo(:, 1,54,12) = (/ & + &1.9814e+01_r8,2.1046e+01_r8,2.4392e+01_r8,2.3477e+01_r8,1.1367e+01_r8/) + kbo(:, 2,54,12) = (/ & + &4.3028e+01_r8,3.5019e+01_r8,3.4545e+01_r8,3.1504e+01_r8,1.2419e+01_r8/) + kbo(:, 3,54,12) = (/ & + &8.5988e+01_r8,6.5126e+01_r8,5.0588e+01_r8,4.1403e+01_r8,1.3282e+01_r8/) + kbo(:, 4,54,12) = (/ & + &1.5878e+02_r8,1.1923e+02_r8,8.2044e+01_r8,5.3856e+01_r8,1.3889e+01_r8/) + kbo(:, 5,54,12) = (/ & + &2.7225e+02_r8,2.0433e+02_r8,1.3669e+02_r8,7.5460e+01_r8,1.4357e+01_r8/) + kbo(:, 1,55,12) = (/ & + &1.4388e+01_r8,1.7950e+01_r8,2.1372e+01_r8,2.1168e+01_r8,1.0974e+01_r8/) + kbo(:, 2,55,12) = (/ & + &3.2596e+01_r8,2.8570e+01_r8,3.0630e+01_r8,2.8429e+01_r8,1.2112e+01_r8/) + kbo(:, 3,55,12) = (/ & + &6.7426e+01_r8,5.1747e+01_r8,4.3446e+01_r8,3.7705e+01_r8,1.3016e+01_r8/) + kbo(:, 4,55,12) = (/ & + &1.2839e+02_r8,9.6452e+01_r8,6.8218e+01_r8,4.8732e+01_r8,1.3748e+01_r8/) + kbo(:, 5,55,12) = (/ & + &2.2612e+02_r8,1.6973e+02_r8,1.1415e+02_r8,6.6296e+01_r8,1.4200e+01_r8/) + kbo(:, 1,56,12) = (/ & + &1.0289e+01_r8,1.5296e+01_r8,1.8729e+01_r8,1.9182e+01_r8,1.0528e+01_r8/) + kbo(:, 2,56,12) = (/ & + &2.4440e+01_r8,2.3761e+01_r8,2.7083e+01_r8,2.5668e+01_r8,1.1786e+01_r8/) + kbo(:, 3,56,12) = (/ & + &5.2397e+01_r8,4.1238e+01_r8,3.7979e+01_r8,3.4254e+01_r8,1.2753e+01_r8/) + kbo(:, 4,56,12) = (/ & + &1.0299e+02_r8,7.7598e+01_r8,5.7468e+01_r8,4.4519e+01_r8,1.3526e+01_r8/) + kbo(:, 5,56,12) = (/ & + &1.8650e+02_r8,1.4002e+02_r8,9.5113e+01_r8,5.8818e+01_r8,1.4062e+01_r8/) + kbo(:, 1,57,12) = (/ & + &7.2296e+00_r8,1.3018e+01_r8,1.6426e+01_r8,1.7434e+01_r8,1.0060e+01_r8/) + kbo(:, 2,57,12) = (/ & + &1.8079e+01_r8,2.0222e+01_r8,2.3856e+01_r8,2.3179e+01_r8,1.1422e+01_r8/) + kbo(:, 3,57,12) = (/ & + &4.0328e+01_r8,3.3389e+01_r8,3.3719e+01_r8,3.1042e+01_r8,1.2469e+01_r8/) + kbo(:, 4,57,12) = (/ & + &8.1861e+01_r8,6.2161e+01_r8,4.9031e+01_r8,4.0727e+01_r8,1.3313e+01_r8/) + kbo(:, 5,57,12) = (/ & + &1.5269e+02_r8,1.1466e+02_r8,7.9200e+01_r8,5.2806e+01_r8,1.3923e+01_r8/) + kbo(:, 1,58,12) = (/ & + &1.3378e+00_r8,3.6524e+00_r8,6.1661e+00_r8,9.4777e+00_r8,9.5880e+00_r8/) + kbo(:, 2,58,12) = (/ & + &3.5257e+00_r8,5.7408e+00_r8,8.9221e+00_r8,1.2503e+01_r8,1.1030e+01_r8/) + kbo(:, 3,58,12) = (/ & + &8.2101e+00_r8,9.0368e+00_r8,1.2733e+01_r8,1.6723e+01_r8,1.2197e+01_r8/) + kbo(:, 4,58,12) = (/ & + &1.7210e+01_r8,1.6233e+01_r8,1.7913e+01_r8,2.2101e+01_r8,1.3072e+01_r8/) + kbo(:, 5,58,12) = (/ & + &3.3035e+01_r8,3.0353e+01_r8,2.7850e+01_r8,2.8452e+01_r8,1.3763e+01_r8/) + kbo(:, 1,59,12) = (/ & + &1.3260e+00_r8,4.5998e+00_r8,7.5889e+00_r8,1.0717e+01_r8,9.4033e+00_r8/) + kbo(:, 2,59,12) = (/ & + &3.6097e+00_r8,7.0919e+00_r8,1.0659e+01_r8,1.3898e+01_r8,1.0849e+01_r8/) + kbo(:, 3,59,12) = (/ & + &8.5987e+00_r8,1.0607e+01_r8,1.5006e+01_r8,1.8102e+01_r8,1.2070e+01_r8/) + kbo(:, 4,59,12) = (/ & + &1.8312e+01_r8,1.7368e+01_r8,2.0492e+01_r8,2.3593e+01_r8,1.3009e+01_r8/) + kbo(:, 5,59,12) = (/ & + &3.5634e+01_r8,3.1449e+01_r8,2.9305e+01_r8,3.0122e+01_r8,1.3723e+01_r8/) + kbo(:, 1,13,13) = (/ & + &1.2162e+03_r8,9.1228e+02_r8,6.0835e+02_r8,3.0442e+02_r8,5.7609e+00_r8/) + kbo(:, 2,13,13) = (/ & + &1.7381e+03_r8,1.3037e+03_r8,8.6931e+02_r8,4.3490e+02_r8,5.6432e+00_r8/) + kbo(:, 3,13,13) = (/ & + &2.3576e+03_r8,1.7683e+03_r8,1.1791e+03_r8,5.8977e+02_r8,5.5255e+00_r8/) + kbo(:, 4,13,13) = (/ & + &3.0662e+03_r8,2.2998e+03_r8,1.5334e+03_r8,7.6694e+02_r8,5.4044e+00_r8/) + kbo(:, 5,13,13) = (/ & + &3.8594e+03_r8,2.8947e+03_r8,1.9299e+03_r8,9.6523e+02_r8,5.2355e+00_r8/) + kbo(:, 1,14,13) = (/ & + &7.9362e+02_r8,5.9533e+02_r8,3.9705e+02_r8,1.9877e+02_r8,6.3709e+00_r8/) + kbo(:, 2,14,13) = (/ & + &1.1345e+03_r8,8.5102e+02_r8,5.6751e+02_r8,2.8400e+02_r8,6.2388e+00_r8/) + kbo(:, 3,14,13) = (/ & + &1.5436e+03_r8,1.1578e+03_r8,7.7203e+02_r8,3.8627e+02_r8,6.0986e+00_r8/) + kbo(:, 4,14,13) = (/ & + &2.0139e+03_r8,1.5105e+03_r8,1.0072e+03_r8,5.0384e+02_r8,5.9465e+00_r8/) + kbo(:, 5,14,13) = (/ & + &2.5413e+03_r8,1.9061e+03_r8,1.2709e+03_r8,6.3569e+02_r8,5.7898e+00_r8/) + kbo(:, 1,15,13) = (/ & + &5.3943e+02_r8,4.0470e+02_r8,2.6997e+02_r8,1.3524e+02_r8,7.0503e+00_r8/) + kbo(:, 2,15,13) = (/ & + &7.7270e+02_r8,5.7965e+02_r8,3.8660e+02_r8,1.9355e+02_r8,6.8771e+00_r8/) + kbo(:, 3,15,13) = (/ & + &1.0520e+03_r8,7.8913e+02_r8,5.2626e+02_r8,2.6338e+02_r8,6.6997e+00_r8/) + kbo(:, 4,15,13) = (/ & + &1.3743e+03_r8,1.0308e+03_r8,6.8738e+02_r8,3.4394e+02_r8,6.5201e+00_r8/) + kbo(:, 5,15,13) = (/ & + &1.7371e+03_r8,1.3030e+03_r8,8.6881e+02_r8,4.3464e+02_r8,6.3410e+00_r8/) + kbo(:, 1,16,13) = (/ & + &4.4449e+02_r8,3.3349e+02_r8,2.2249e+02_r8,1.1150e+02_r8,7.7448e+00_r8/) + kbo(:, 2,16,13) = (/ & + &6.3512e+02_r8,4.7646e+02_r8,3.1780e+02_r8,1.5915e+02_r8,7.5481e+00_r8/) + kbo(:, 3,16,13) = (/ & + &8.6257e+02_r8,6.4705e+02_r8,4.3152e+02_r8,2.1600e+02_r8,7.3457e+00_r8/) + kbo(:, 4,16,13) = (/ & + &1.1249e+03_r8,8.4376e+02_r8,5.6265e+02_r8,2.8155e+02_r8,7.1472e+00_r8/) + kbo(:, 5,16,13) = (/ & + &1.4185e+03_r8,1.0640e+03_r8,7.0946e+02_r8,3.5494e+02_r8,6.9622e+00_r8/) + kbo(:, 1,17,13) = (/ & + &3.7725e+02_r8,2.8305e+02_r8,1.8886e+02_r8,9.4667e+01_r8,8.5153e+00_r8/) + kbo(:, 2,17,13) = (/ & + &5.3579e+02_r8,4.0195e+02_r8,2.6812e+02_r8,1.3428e+02_r8,8.2959e+00_r8/) + kbo(:, 3,17,13) = (/ & + &7.2432e+02_r8,5.4334e+02_r8,3.6237e+02_r8,1.8140e+02_r8,8.0790e+00_r8/) + kbo(:, 4,17,13) = (/ & + &9.4095e+02_r8,7.0582e+02_r8,4.7068e+02_r8,2.3555e+02_r8,7.8782e+00_r8/) + kbo(:, 5,17,13) = (/ & + &1.1800e+03_r8,8.8510e+02_r8,5.9020e+02_r8,2.9531e+02_r8,7.6889e+00_r8/) + kbo(:, 1,18,13) = (/ & + &3.2277e+02_r8,2.4218e+02_r8,1.6159e+02_r8,8.1002e+01_r8,9.4611e+00_r8/) + kbo(:, 2,18,13) = (/ & + &4.5535e+02_r8,3.4161e+02_r8,2.2787e+02_r8,1.1413e+02_r8,9.2187e+00_r8/) + kbo(:, 3,18,13) = (/ & + &6.1248e+02_r8,4.5945e+02_r8,3.0643e+02_r8,1.5340e+02_r8,8.9925e+00_r8/) + kbo(:, 4,18,13) = (/ & + &7.9039e+02_r8,5.9288e+02_r8,3.9538e+02_r8,1.9787e+02_r8,8.7824e+00_r8/) + kbo(:, 5,18,13) = (/ & + &9.8664e+02_r8,7.4007e+02_r8,4.9351e+02_r8,2.4694e+02_r8,8.5832e+00_r8/) + kbo(:, 1,19,13) = (/ & + &2.6617e+02_r8,1.9972e+02_r8,1.3326e+02_r8,6.6812e+01_r8,1.0581e+01_r8/) + kbo(:, 2,19,13) = (/ & + &3.7316e+02_r8,2.7996e+02_r8,1.8675e+02_r8,9.3549e+01_r8,1.0334e+01_r8/) + kbo(:, 3,19,13) = (/ & + &4.9811e+02_r8,3.7366e+02_r8,2.4922e+02_r8,1.2478e+02_r8,1.0097e+01_r8/) + kbo(:, 4,19,13) = (/ & + &6.3941e+02_r8,4.7964e+02_r8,3.1987e+02_r8,1.6011e+02_r8,9.8657e+00_r8/) + kbo(:, 5,19,13) = (/ & + &7.9554e+02_r8,5.9674e+02_r8,3.9794e+02_r8,1.9915e+02_r8,9.6319e+00_r8/) + kbo(:, 1,20,13) = (/ & + &2.3446e+02_r8,1.7592e+02_r8,1.1738e+02_r8,5.8849e+01_r8,1.1882e+01_r8/) + kbo(:, 2,20,13) = (/ & + &3.2565e+02_r8,2.4431e+02_r8,1.6298e+02_r8,8.1640e+01_r8,1.1619e+01_r8/) + kbo(:, 3,20,13) = (/ & + &4.3162e+02_r8,3.2380e+02_r8,2.1597e+02_r8,1.0814e+02_r8,1.1360e+01_r8/) + kbo(:, 4,20,13) = (/ & + &5.5163e+02_r8,4.1380e+02_r8,2.7598e+02_r8,1.3815e+02_r8,1.1092e+01_r8/) + kbo(:, 5,20,13) = (/ & + &6.8433e+02_r8,5.1333e+02_r8,3.4234e+02_r8,1.7134e+02_r8,1.0817e+01_r8/) + kbo(:, 1,21,13) = (/ & + &2.0791e+02_r8,1.5600e+02_r8,1.0410e+02_r8,5.2196e+01_r8,1.3299e+01_r8/) + kbo(:, 2,21,13) = (/ & + &2.8639e+02_r8,2.1487e+02_r8,1.4335e+02_r8,7.1825e+01_r8,1.3019e+01_r8/) + kbo(:, 3,21,13) = (/ & + &3.7808e+02_r8,2.8364e+02_r8,1.8920e+02_r8,9.4762e+01_r8,1.2725e+01_r8/) + kbo(:, 4,21,13) = (/ & + &4.8188e+02_r8,3.6150e+02_r8,2.4111e+02_r8,1.2072e+02_r8,1.2414e+01_r8/) + kbo(:, 5,21,13) = (/ & + &5.9751e+02_r8,4.4821e+02_r8,2.9892e+02_r8,1.4963e+02_r8,1.2098e+01_r8/) + kbo(:, 1,22,13) = (/ & + &1.8905e+02_r8,1.4186e+02_r8,9.4669e+01_r8,4.7658e+01_r8,1.4760e+01_r8/) + kbo(:, 2,22,13) = (/ & + &2.5846e+02_r8,1.9392e+02_r8,1.2939e+02_r8,6.4852e+01_r8,1.4444e+01_r8/) + kbo(:, 3,22,13) = (/ & + &3.3936e+02_r8,2.5460e+02_r8,1.6984e+02_r8,8.5086e+01_r8,1.4104e+01_r8/) + kbo(:, 4,22,13) = (/ & + &4.3137e+02_r8,3.2361e+02_r8,2.1585e+02_r8,1.0809e+02_r8,1.3746e+01_r8/) + kbo(:, 5,22,13) = (/ & + &5.3388e+02_r8,4.0049e+02_r8,2.6710e+02_r8,1.3372e+02_r8,1.3378e+01_r8/) + kbo(:, 1,23,13) = (/ & + &1.7012e+02_r8,1.2766e+02_r8,8.5209e+01_r8,4.3736e+01_r8,1.6211e+01_r8/) + kbo(:, 2,23,13) = (/ & + &2.3107e+02_r8,1.7338e+02_r8,1.1569e+02_r8,5.8148e+01_r8,1.5847e+01_r8/) + kbo(:, 3,23,13) = (/ & + &3.0241e+02_r8,2.2689e+02_r8,1.5137e+02_r8,7.5851e+01_r8,1.5467e+01_r8/) + kbo(:, 4,23,13) = (/ & + &3.8349e+02_r8,2.8770e+02_r8,1.9191e+02_r8,9.6125e+01_r8,1.5066e+01_r8/) + kbo(:, 5,23,13) = (/ & + &4.7369e+02_r8,3.5535e+02_r8,2.3701e+02_r8,1.1867e+02_r8,1.4651e+01_r8/) + kbo(:, 1,24,13) = (/ & + &1.5057e+02_r8,1.1300e+02_r8,7.5436e+01_r8,4.0246e+01_r8,1.7609e+01_r8/) + kbo(:, 2,24,13) = (/ & + &2.0367e+02_r8,1.5283e+02_r8,1.0199e+02_r8,5.2083e+01_r8,1.7203e+01_r8/) + kbo(:, 3,24,13) = (/ & + &2.6558e+02_r8,1.9927e+02_r8,1.3295e+02_r8,6.6835e+01_r8,1.6770e+01_r8/) + kbo(:, 4,24,13) = (/ & + &3.3594e+02_r8,2.5203e+02_r8,1.6813e+02_r8,8.4226e+01_r8,1.6325e+01_r8/) + kbo(:, 5,24,13) = (/ & + &4.1379e+02_r8,3.1042e+02_r8,2.0705e+02_r8,1.0369e+02_r8,1.5864e+01_r8/) + kbo(:, 1,25,13) = (/ & + &1.3420e+02_r8,1.0073e+02_r8,6.7255e+01_r8,3.7941e+01_r8,1.8922e+01_r8/) + kbo(:, 2,25,13) = (/ & + &1.8061e+02_r8,1.3554e+02_r8,9.0464e+01_r8,4.7603e+01_r8,1.8471e+01_r8/) + kbo(:, 3,25,13) = (/ & + &2.3464e+02_r8,1.7606e+02_r8,1.1747e+02_r8,5.9840e+01_r8,1.7998e+01_r8/) + kbo(:, 4,25,13) = (/ & + &2.9580e+02_r8,2.2193e+02_r8,1.4806e+02_r8,7.4446e+01_r8,1.7506e+01_r8/) + kbo(:, 5,25,13) = (/ & + &3.6422e+02_r8,2.7325e+02_r8,1.8228e+02_r8,9.1309e+01_r8,1.6997e+01_r8/) + kbo(:, 1,26,13) = (/ & + &1.2114e+02_r8,9.0934e+01_r8,6.0946e+01_r8,3.6699e+01_r8,2.0129e+01_r8/) + kbo(:, 2,26,13) = (/ & + &1.6224e+02_r8,1.2175e+02_r8,8.1268e+01_r8,4.4540e+01_r8,1.9645e+01_r8/) + kbo(:, 3,26,13) = (/ & + &2.0993e+02_r8,1.5753e+02_r8,1.0512e+02_r8,5.4768e+01_r8,1.9134e+01_r8/) + kbo(:, 4,26,13) = (/ & + &2.6457e+02_r8,1.9850e+02_r8,1.3244e+02_r8,6.7280e+01_r8,1.8599e+01_r8/) + kbo(:, 5,26,13) = (/ & + &3.2617e+02_r8,2.4471e+02_r8,1.6326e+02_r8,8.2064e+01_r8,1.8043e+01_r8/) + kbo(:, 1,27,13) = (/ & + &1.1288e+02_r8,8.4731e+01_r8,5.7258e+01_r8,3.6591e+01_r8,2.1235e+01_r8/) + kbo(:, 2,27,13) = (/ & + &1.5040e+02_r8,1.1288e+02_r8,7.5447e+01_r8,4.3146e+01_r8,2.0722e+01_r8/) + kbo(:, 3,27,13) = (/ & + &1.9447e+02_r8,1.4593e+02_r8,9.7397e+01_r8,5.2019e+01_r8,2.0175e+01_r8/) + kbo(:, 4,27,13) = (/ & + &2.4522e+02_r8,1.8400e+02_r8,1.2279e+02_r8,6.3250e+01_r8,1.9596e+01_r8/) + kbo(:, 5,27,13) = (/ & + &3.0305e+02_r8,2.2738e+02_r8,1.5172e+02_r8,7.6751e+01_r8,1.8997e+01_r8/) + kbo(:, 1,28,13) = (/ & + &1.0746e+02_r8,8.0667e+01_r8,5.5081e+01_r8,3.7035e+01_r8,2.2229e+01_r8/) + kbo(:, 2,28,13) = (/ & + &1.4298e+02_r8,1.0731e+02_r8,7.1965e+01_r8,4.2784e+01_r8,2.1691e+01_r8/) + kbo(:, 3,28,13) = (/ & + &1.8493e+02_r8,1.3878e+02_r8,9.2649e+01_r8,5.0725e+01_r8,2.1105e+01_r8/) + kbo(:, 4,28,13) = (/ & + &2.3378e+02_r8,1.7543e+02_r8,1.1708e+02_r8,6.1166e+01_r8,2.0486e+01_r8/) + kbo(:, 5,28,13) = (/ & + &2.9002e+02_r8,2.1761e+02_r8,1.4521e+02_r8,7.3973e+01_r8,1.9841e+01_r8/) + kbo(:, 1,29,13) = (/ & + &1.0862e+02_r8,8.1537e+01_r8,5.6008e+01_r8,3.8525e+01_r8,2.3108e+01_r8/) + kbo(:, 2,29,13) = (/ & + &1.4451e+02_r8,1.0847e+02_r8,7.2927e+01_r8,4.4121e+01_r8,2.2541e+01_r8/) + kbo(:, 3,29,13) = (/ & + &1.8742e+02_r8,1.4066e+02_r8,9.3939e+01_r8,5.2003e+01_r8,2.1917e+01_r8/) + kbo(:, 4,29,13) = (/ & + &2.3814e+02_r8,1.7870e+02_r8,1.1927e+02_r8,6.2626e+01_r8,2.1254e+01_r8/) + kbo(:, 5,29,13) = (/ & + &2.9712e+02_r8,2.2294e+02_r8,1.4877e+02_r8,7.5955e+01_r8,2.0559e+01_r8/) + kbo(:, 1,30,13) = (/ & + &1.1263e+02_r8,8.4559e+01_r8,5.8240e+01_r8,4.0363e+01_r8,2.3867e+01_r8/) + kbo(:, 2,30,13) = (/ & + &1.5031e+02_r8,1.1283e+02_r8,7.5908e+01_r8,4.6135e+01_r8,2.3263e+01_r8/) + kbo(:, 3,30,13) = (/ & + &1.9606e+02_r8,1.4715e+02_r8,9.8280e+01_r8,5.4419e+01_r8,2.2598e+01_r8/) + kbo(:, 4,30,13) = (/ & + &2.5065e+02_r8,1.8809e+02_r8,1.2553e+02_r8,6.5875e+01_r8,2.1889e+01_r8/) + kbo(:, 5,30,13) = (/ & + &3.1497e+02_r8,2.3633e+02_r8,1.5769e+02_r8,8.0462e+01_r8,2.1149e+01_r8/) + kbo(:, 1,31,13) = (/ & + &1.2378e+02_r8,9.2930e+01_r8,6.3680e+01_r8,4.3209e+01_r8,2.4494e+01_r8/) + kbo(:, 2,31,13) = (/ & + &1.6598e+02_r8,1.2458e+02_r8,8.3650e+01_r8,4.9789e+01_r8,2.3857e+01_r8/) + kbo(:, 3,31,13) = (/ & + &2.1788e+02_r8,1.6351e+02_r8,1.0916e+02_r8,5.9548e+01_r8,2.3152e+01_r8/) + kbo(:, 4,31,13) = (/ & + &2.8056e+02_r8,2.1051e+02_r8,1.4048e+02_r8,7.3069e+01_r8,2.2400e+01_r8/) + kbo(:, 5,31,13) = (/ & + &3.5485e+02_r8,2.6624e+02_r8,1.7763e+02_r8,9.0172e+01_r8,2.1588e+01_r8/) + kbo(:, 1,32,13) = (/ & + &1.3906e+02_r8,1.0439e+02_r8,7.1039e+01_r8,4.6595e+01_r8,2.5004e+01_r8/) + kbo(:, 2,32,13) = (/ & + &1.8760e+02_r8,1.4080e+02_r8,9.4311e+01_r8,5.4496e+01_r8,2.4327e+01_r8/) + kbo(:, 3,32,13) = (/ & + &2.4774e+02_r8,1.8590e+02_r8,1.2408e+02_r8,6.6467e+01_r8,2.3584e+01_r8/) + kbo(:, 4,32,13) = (/ & + &3.2109e+02_r8,2.4091e+02_r8,1.6074e+02_r8,8.2698e+01_r8,2.2768e+01_r8/) + kbo(:, 5,32,13) = (/ & + &4.0872e+02_r8,3.0664e+02_r8,2.0456e+02_r8,1.0327e+02_r8,2.1879e+01_r8/) + kbo(:, 1,33,13) = (/ & + &1.6104e+02_r8,1.2087e+02_r8,8.1641e+01_r8,5.1002e+01_r8,2.5402e+01_r8/) + kbo(:, 2,33,13) = (/ & + &2.1845e+02_r8,1.6394e+02_r8,1.0954e+02_r8,6.1146e+01_r8,2.4688e+01_r8/) + kbo(:, 3,33,13) = (/ & + &2.9039e+02_r8,2.1789e+02_r8,1.4539e+02_r8,7.6233e+01_r8,2.3897e+01_r8/) + kbo(:, 4,33,13) = (/ & + &3.7885e+02_r8,2.8424e+02_r8,1.8963e+02_r8,9.6481e+01_r8,2.2987e+01_r8/) + kbo(:, 5,33,13) = (/ & + &4.8539e+02_r8,3.6414e+02_r8,2.4290e+02_r8,1.2206e+02_r8,2.2183e+01_r8/) + kbo(:, 1,34,13) = (/ & + &1.8189e+02_r8,1.3651e+02_r8,9.1768e+01_r8,5.5207e+01_r8,2.5729e+01_r8/) + kbo(:, 2,34,13) = (/ & + &2.4868e+02_r8,1.8660e+02_r8,1.2456e+02_r8,6.7745e+01_r8,2.4984e+01_r8/) + kbo(:, 3,34,13) = (/ & + &3.3298e+02_r8,2.4983e+02_r8,1.6669e+02_r8,8.6174e+01_r8,2.4083e+01_r8/) + kbo(:, 4,34,13) = (/ & + &4.3751e+02_r8,3.2823e+02_r8,2.1895e+02_r8,1.1064e+02_r8,2.3253e+01_r8/) + kbo(:, 5,34,13) = (/ & + &5.6416e+02_r8,4.2322e+02_r8,2.8227e+02_r8,1.4151e+02_r8,2.2432e+01_r8/) + kbo(:, 1,35,13) = (/ & + &2.0192e+02_r8,1.5153e+02_r8,1.0158e+02_r8,5.9346e+01_r8,2.6044e+01_r8/) + kbo(:, 2,35,13) = (/ & + &2.7880e+02_r8,2.0919e+02_r8,1.3960e+02_r8,7.4527e+01_r8,2.5204e+01_r8/) + kbo(:, 3,35,13) = (/ & + &3.7683e+02_r8,2.8271e+02_r8,1.8860e+02_r8,9.6532e+01_r8,2.4315e+01_r8/) + kbo(:, 4,35,13) = (/ & + &4.9906e+02_r8,3.7439e+02_r8,2.4972e+02_r8,1.2566e+02_r8,2.3549e+01_r8/) + kbo(:, 5,35,13) = (/ & + &6.4817e+02_r8,4.8622e+02_r8,3.2427e+02_r8,1.6242e+02_r8,2.2556e+01_r8/) + kbo(:, 1,36,13) = (/ & + &2.1718e+02_r8,1.6298e+02_r8,1.0911e+02_r8,6.2682e+01_r8,2.6372e+01_r8/) + kbo(:, 2,36,13) = (/ & + &3.0353e+02_r8,2.2773e+02_r8,1.5196e+02_r8,8.0255e+01_r8,2.5484e+01_r8/) + kbo(:, 3,36,13) = (/ & + &4.1487e+02_r8,3.1124e+02_r8,2.0762e+02_r8,1.0565e+02_r8,2.4690e+01_r8/) + kbo(:, 4,36,13) = (/ & + &5.5465e+02_r8,4.1607e+02_r8,2.7750e+02_r8,1.3934e+02_r8,2.3815e+01_r8/) + kbo(:, 5,36,13) = (/ & + &7.2608e+02_r8,5.4465e+02_r8,3.6322e+02_r8,1.8189e+02_r8,2.2654e+01_r8/) + kbo(:, 1,37,13) = (/ & + &2.1788e+02_r8,1.6349e+02_r8,1.0950e+02_r8,6.3289e+01_r8,2.6719e+01_r8/) + kbo(:, 2,37,13) = (/ & + &3.0912e+02_r8,2.3193e+02_r8,1.5476e+02_r8,8.1797e+01_r8,2.5860e+01_r8/) + kbo(:, 3,37,13) = (/ & + &4.2846e+02_r8,3.2142e+02_r8,2.1440e+02_r8,1.0906e+02_r8,2.5054e+01_r8/) + kbo(:, 4,37,13) = (/ & + &5.7982e+02_r8,4.3495e+02_r8,2.9008e+02_r8,1.4561e+02_r8,2.4158e+01_r8/) + kbo(:, 5,37,13) = (/ & + &7.6717e+02_r8,5.7546e+02_r8,3.8377e+02_r8,1.9217e+02_r8,2.2948e+01_r8/) + kbo(:, 1,38,13) = (/ & + &2.2254e+02_r8,1.6699e+02_r8,1.1184e+02_r8,6.4633e+01_r8,2.7030e+01_r8/) + kbo(:, 2,38,13) = (/ & + &3.2031e+02_r8,2.4031e+02_r8,1.6035e+02_r8,8.4610e+01_r8,2.6154e+01_r8/) + kbo(:, 3,38,13) = (/ & + &4.5000e+02_r8,3.3758e+02_r8,2.2517e+02_r8,1.1439e+02_r8,2.5377e+01_r8/) + kbo(:, 4,38,13) = (/ & + &6.1626e+02_r8,4.6228e+02_r8,3.0831e+02_r8,1.5466e+02_r8,2.4449e+01_r8/) + kbo(:, 5,38,13) = (/ & + &8.2391e+02_r8,6.1802e+02_r8,4.1215e+02_r8,2.0635e+02_r8,2.3228e+01_r8/) + kbo(:, 1,39,13) = (/ & + &2.3401e+02_r8,1.7560e+02_r8,1.1754e+02_r8,6.7259e+01_r8,2.7265e+01_r8/) + kbo(:, 2,39,13) = (/ & + &3.4141e+02_r8,2.5613e+02_r8,1.7089e+02_r8,8.9638e+01_r8,2.6464e+01_r8/) + kbo(:, 3,39,13) = (/ & + &4.8579e+02_r8,3.6442e+02_r8,2.4308e+02_r8,1.2315e+02_r8,2.5687e+01_r8/) + kbo(:, 4,39,13) = (/ & + &6.7297e+02_r8,5.0482e+02_r8,3.3668e+02_r8,1.6875e+02_r8,2.4654e+01_r8/) + kbo(:, 5,39,13) = (/ & + &9.0884e+02_r8,6.8173e+02_r8,4.5462e+02_r8,2.2758e+02_r8,2.3620e+01_r8/) + kbo(:, 1,40,13) = (/ & + &2.2310e+02_r8,1.6742e+02_r8,1.1224e+02_r8,6.5625e+01_r8,2.7589e+01_r8/) + kbo(:, 2,40,13) = (/ & + &3.3051e+02_r8,2.4796e+02_r8,1.6546e+02_r8,8.7436e+01_r8,2.6816e+01_r8/) + kbo(:, 3,40,13) = (/ & + &4.7705e+02_r8,3.5787e+02_r8,2.3871e+02_r8,1.2127e+02_r8,2.6052e+01_r8/) + kbo(:, 4,40,13) = (/ & + &6.7033e+02_r8,5.0284e+02_r8,3.3536e+02_r8,1.6816e+02_r8,2.5038e+01_r8/) + kbo(:, 5,40,13) = (/ & + &9.1616e+02_r8,6.8722e+02_r8,4.5828e+02_r8,2.2941e+02_r8,2.4007e+01_r8/) + kbo(:, 1,41,13) = (/ & + &2.1165e+02_r8,1.5884e+02_r8,1.0674e+02_r8,6.4017e+01_r8,2.7888e+01_r8/) + kbo(:, 2,41,13) = (/ & + &3.1819e+02_r8,2.3873e+02_r8,1.5932e+02_r8,8.5003e+01_r8,2.7118e+01_r8/) + kbo(:, 3,41,13) = (/ & + &4.6591e+02_r8,3.4951e+02_r8,2.3314e+02_r8,1.1880e+02_r8,2.6396e+01_r8/) + kbo(:, 4,41,13) = (/ & + &6.6349e+02_r8,4.9771e+02_r8,3.3195e+02_r8,1.6656e+02_r8,2.5465e+01_r8/) + kbo(:, 5,41,13) = (/ & + &9.1847e+02_r8,6.8895e+02_r8,4.5944e+02_r8,2.3000e+02_r8,2.4337e+01_r8/) + kbo(:, 1,42,13) = (/ & + &2.0335e+02_r8,1.5260e+02_r8,1.0282e+02_r8,6.3023e+01_r8,2.8153e+01_r8/) + kbo(:, 2,42,13) = (/ & + &3.1003e+02_r8,2.3260e+02_r8,1.5524e+02_r8,8.3539e+01_r8,2.7395e+01_r8/) + kbo(:, 3,42,13) = (/ & + &4.6024e+02_r8,3.4526e+02_r8,2.3031e+02_r8,1.1765e+02_r8,2.6718e+01_r8/) + kbo(:, 4,42,13) = (/ & + &6.6381e+02_r8,4.9795e+02_r8,3.3210e+02_r8,1.6673e+02_r8,2.5846e+01_r8/) + kbo(:, 5,42,13) = (/ & + &9.3041e+02_r8,6.9790e+02_r8,4.6540e+02_r8,2.3298e+02_r8,2.4647e+01_r8/) + kbo(:, 1,43,13) = (/ & + &1.9244e+02_r8,1.4443e+02_r8,9.7744e+01_r8,6.1682e+01_r8,2.8431e+01_r8/) + kbo(:, 2,43,13) = (/ & + &2.9785e+02_r8,2.2347e+02_r8,1.4920e+02_r8,8.1276e+01_r8,2.7711e+01_r8/) + kbo(:, 3,43,13) = (/ & + &4.4872e+02_r8,3.3663e+02_r8,2.2458e+02_r8,1.1517e+02_r8,2.7073e+01_r8/) + kbo(:, 4,43,13) = (/ & + &6.5646e+02_r8,4.9243e+02_r8,3.2842e+02_r8,1.6500e+02_r8,2.6290e+01_r8/) + kbo(:, 5,43,13) = (/ & + &9.3268e+02_r8,6.9961e+02_r8,4.6654e+02_r8,2.3355e+02_r8,2.5000e+01_r8/) + kbo(:, 1,44,13) = (/ & + &1.8195e+02_r8,1.3656e+02_r8,9.2955e+01_r8,6.0559e+01_r8,2.8683e+01_r8/) + kbo(:, 2,44,13) = (/ & + &2.8673e+02_r8,2.1514e+02_r8,1.4371e+02_r8,7.9343e+01_r8,2.8022e+01_r8/) + kbo(:, 3,44,13) = (/ & + &4.3845e+02_r8,3.2893e+02_r8,2.1944e+02_r8,1.1299e+02_r8,2.7430e+01_r8/) + kbo(:, 4,44,13) = (/ & + &6.5082e+02_r8,4.8820e+02_r8,3.2560e+02_r8,1.6371e+02_r8,2.6724e+01_r8/) + kbo(:, 5,44,13) = (/ & + &9.3739e+02_r8,7.0313e+02_r8,4.6889e+02_r8,2.3472e+02_r8,2.5409e+01_r8/) + kbo(:, 1,45,13) = (/ & + &1.7490e+02_r8,1.3128e+02_r8,8.9889e+01_r8,6.0087e+01_r8,2.8892e+01_r8/) + kbo(:, 2,45,13) = (/ & + &2.8115e+02_r8,2.1096e+02_r8,1.4101e+02_r8,7.8697e+01_r8,2.8297e+01_r8/) + kbo(:, 3,45,13) = (/ & + &4.3612e+02_r8,3.2718e+02_r8,2.1828e+02_r8,1.1266e+02_r8,2.7806e+01_r8/) + kbo(:, 4,45,13) = (/ & + &6.5668e+02_r8,4.9260e+02_r8,3.2854e+02_r8,1.6526e+02_r8,2.7097e+01_r8/) + kbo(:, 5,45,13) = (/ & + &9.5876e+02_r8,7.1917e+02_r8,4.7958e+02_r8,2.4006e+02_r8,2.5776e+01_r8/) + kbo(:, 1,46,13) = (/ & + &1.6728e+02_r8,1.2556e+02_r8,8.6592e+01_r8,5.9568e+01_r8,2.9082e+01_r8/) + kbo(:, 2,46,13) = (/ & + &2.7457e+02_r8,2.0602e+02_r8,1.3784e+02_r8,7.7967e+01_r8,2.8545e+01_r8/) + kbo(:, 3,46,13) = (/ & + &4.3313e+02_r8,3.2494e+02_r8,2.1678e+02_r8,1.1222e+02_r8,2.8139e+01_r8/) + kbo(:, 4,46,13) = (/ & + &6.6163e+02_r8,4.9632e+02_r8,3.3103e+02_r8,1.6658e+02_r8,2.7449e+01_r8/) + kbo(:, 5,46,13) = (/ & + &9.8004e+02_r8,7.3512e+02_r8,4.9021e+02_r8,2.4539e+02_r8,2.6122e+01_r8/) + kbo(:, 1,47,13) = (/ & + &1.5431e+02_r8,1.1585e+02_r8,8.0931e+01_r8,5.8232e+01_r8,2.9262e+01_r8/) + kbo(:, 2,47,13) = (/ & + &2.5885e+02_r8,1.9423e+02_r8,1.3026e+02_r8,7.5643e+01_r8,2.8798e+01_r8/) + kbo(:, 3,47,13) = (/ & + &4.1682e+02_r8,3.1271e+02_r8,2.0862e+02_r8,1.0877e+02_r8,2.8446e+01_r8/) + kbo(:, 4,47,13) = (/ & + &6.4684e+02_r8,4.8523e+02_r8,3.2363e+02_r8,1.6308e+02_r8,2.7814e+01_r8/) + kbo(:, 5,47,13) = (/ & + &9.7279e+02_r8,7.2968e+02_r8,4.8659e+02_r8,2.4359e+02_r8,2.6548e+01_r8/) + kbo(:, 1,48,13) = (/ & + &1.4538e+02_r8,1.0915e+02_r8,7.7289e+01_r8,5.7662e+01_r8,2.9351e+01_r8/) + kbo(:, 2,48,13) = (/ & + &2.4931e+02_r8,1.8708e+02_r8,1.2577e+02_r8,7.4691e+01_r8,2.8998e+01_r8/) + kbo(:, 3,48,13) = (/ & + &4.1014e+02_r8,3.0770e+02_r8,2.0528e+02_r8,1.0766e+02_r8,2.8726e+01_r8/) + kbo(:, 4,48,13) = (/ & + &6.4756e+02_r8,4.8577e+02_r8,3.2399e+02_r8,1.6338e+02_r8,2.8115e+01_r8/) + kbo(:, 5,48,13) = (/ & + &9.8831e+02_r8,7.4133e+02_r8,4.9436e+02_r8,2.4748e+02_r8,2.6944e+01_r8/) + kbo(:, 1,49,13) = (/ & + &1.4120e+02_r8,1.0604e+02_r8,7.5941e+01_r8,5.8065e+01_r8,2.9380e+01_r8/) + kbo(:, 2,49,13) = (/ & + &2.4862e+02_r8,1.8657e+02_r8,1.2564e+02_r8,7.5519e+01_r8,2.9233e+01_r8/) + kbo(:, 3,49,13) = (/ & + &4.1758e+02_r8,3.1328e+02_r8,2.0900e+02_r8,1.0986e+02_r8,2.8989e+01_r8/) + kbo(:, 4,49,13) = (/ & + &6.7203e+02_r8,5.0412e+02_r8,3.3622e+02_r8,1.6950e+02_r8,2.8333e+01_r8/) + kbo(:, 5,49,13) = (/ & + &1.0415e+03_r8,7.8124e+02_r8,5.2096e+02_r8,2.6077e+02_r8,2.7256e+01_r8/) + kbo(:, 1,50,13) = (/ & + &1.3115e+02_r8,9.8605e+01_r8,7.2172e+01_r8,5.7503e+01_r8,2.9363e+01_r8/) + kbo(:, 2,50,13) = (/ & + &2.3790e+02_r8,1.7854e+02_r8,1.2070e+02_r8,7.4407e+01_r8,2.9364e+01_r8/) + kbo(:, 3,50,13) = (/ & + &4.0744e+02_r8,3.0568e+02_r8,2.0394e+02_r8,1.0804e+02_r8,2.9149e+01_r8/) + kbo(:, 4,50,13) = (/ & + &6.6872e+02_r8,5.0163e+02_r8,3.3456e+02_r8,1.6889e+02_r8,2.8599e+01_r8/) + kbo(:, 5,50,13) = (/ & + &1.0519e+03_r8,7.8905e+02_r8,5.2618e+02_r8,2.6337e+02_r8,2.7606e+01_r8/) + kbo(:, 1,51,13) = (/ & + &1.1865e+02_r8,8.9445e+01_r8,6.7680e+01_r8,5.6587e+01_r8,2.9290e+01_r8/) + kbo(:, 2,51,13) = (/ & + &2.2216e+02_r8,1.6674e+02_r8,1.1346e+02_r8,7.2415e+01_r8,2.9435e+01_r8/) + kbo(:, 3,51,13) = (/ & + &3.8895e+02_r8,2.9182e+02_r8,1.9472e+02_r8,1.0439e+02_r8,2.9207e+01_r8/) + kbo(:, 4,51,13) = (/ & + &6.5048e+02_r8,4.8795e+02_r8,3.2544e+02_r8,1.6473e+02_r8,2.8819e+01_r8/) + kbo(:, 5,51,13) = (/ & + &1.0401e+03_r8,7.8020e+02_r8,5.2027e+02_r8,2.6042e+02_r8,2.7943e+01_r8/) + kbo(:, 1,52,13) = (/ & + &1.0900e+02_r8,8.2517e+01_r8,6.4683e+01_r8,5.6184e+01_r8,2.9159e+01_r8/) + kbo(:, 2,52,13) = (/ & + &2.1154e+02_r8,1.5879e+02_r8,1.0876e+02_r8,7.1453e+01_r8,2.9466e+01_r8/) + kbo(:, 3,52,13) = (/ & + &3.8014e+02_r8,2.8522e+02_r8,1.9038e+02_r8,1.0306e+02_r8,2.9320e+01_r8/) + kbo(:, 4,52,13) = (/ & + &6.4723e+02_r8,4.8552e+02_r8,3.2381e+02_r8,1.6425e+02_r8,2.8993e+01_r8/) + kbo(:, 5,52,13) = (/ & + &1.0537e+03_r8,7.9041e+02_r8,5.2708e+02_r8,2.6382e+02_r8,2.8208e+01_r8/) + kbo(:, 1,53,13) = (/ & + &1.0283e+02_r8,7.8224e+01_r8,6.3272e+01_r8,5.6425e+01_r8,2.8966e+01_r8/) + kbo(:, 2,53,13) = (/ & + &2.0760e+02_r8,1.5584e+02_r8,1.0728e+02_r8,7.1858e+01_r8,2.9467e+01_r8/) + kbo(:, 3,53,13) = (/ & + &3.8429e+02_r8,2.8834e+02_r8,1.9251e+02_r8,1.0470e+02_r8,2.9381e+01_r8/) + kbo(:, 4,53,13) = (/ & + &6.6697e+02_r8,5.0033e+02_r8,3.3369e+02_r8,1.6926e+02_r8,2.9144e+01_r8/) + kbo(:, 5,53,13) = (/ & + &1.1061e+03_r8,8.2971e+02_r8,5.5328e+02_r8,2.7691e+02_r8,2.8402e+01_r8/) + kbo(:, 1,54,13) = (/ & + &8.4612e+01_r8,6.5337e+01_r8,5.7223e+01_r8,5.4259e+01_r8,2.8744e+01_r8/) + kbo(:, 2,54,13) = (/ & + &1.7755e+02_r8,1.3329e+02_r8,9.3740e+01_r8,6.7487e+01_r8,2.9376e+01_r8/) + kbo(:, 3,54,13) = (/ & + &3.3886e+02_r8,2.5427e+02_r8,1.7017e+02_r8,9.5886e+01_r8,2.9463e+01_r8/) + kbo(:, 4,54,13) = (/ & + &6.0067e+02_r8,4.5060e+02_r8,3.0055e+02_r8,1.5369e+02_r8,2.9315e+01_r8/) + kbo(:, 5,54,13) = (/ & + &1.0127e+03_r8,7.5962e+02_r8,5.0655e+02_r8,2.5368e+02_r8,2.8705e+01_r8/) + kbo(:, 1,55,13) = (/ & + &6.3387e+01_r8,5.0935e+01_r8,5.0168e+01_r8,5.0996e+01_r8,2.8487e+01_r8/) + kbo(:, 2,55,13) = (/ & + &1.3831e+02_r8,1.0410e+02_r8,7.7011e+01_r8,6.1667e+01_r8,2.9169e+01_r8/) + kbo(:, 3,55,13) = (/ & + &2.7282e+02_r8,2.0475e+02_r8,1.3822e+02_r8,8.3541e+01_r8,2.9521e+01_r8/) + kbo(:, 4,55,13) = (/ & + &4.9509e+02_r8,3.7143e+02_r8,2.4779e+02_r8,1.2925e+02_r8,2.9355e+01_r8/) + kbo(:, 5,55,13) = (/ & + &8.4764e+02_r8,6.3583e+02_r8,4.2402e+02_r8,2.1299e+02_r8,2.9013e+01_r8/) + kbo(:, 1,56,13) = (/ & + &4.6914e+01_r8,4.0782e+01_r8,4.5015e+01_r8,4.7952e+01_r8,2.8186e+01_r8/) + kbo(:, 2,56,13) = (/ & + &1.0661e+02_r8,8.1027e+01_r8,6.4934e+01_r8,5.7313e+01_r8,2.9008e+01_r8/) + kbo(:, 3,56,13) = (/ & + &2.1790e+02_r8,1.6356e+02_r8,1.1223e+02_r8,7.3951e+01_r8,2.9460e+01_r8/) + kbo(:, 4,56,13) = (/ & + &4.0585e+02_r8,3.0451e+02_r8,2.0325e+02_r8,1.0953e+02_r8,2.9455e+01_r8/) + kbo(:, 5,56,13) = (/ & + &7.0659e+02_r8,5.3004e+02_r8,3.5349e+02_r8,1.7883e+02_r8,2.9213e+01_r8/) + kbo(:, 1,57,13) = (/ & + &3.4230e+01_r8,3.3758e+01_r8,4.1164e+01_r8,4.5068e+01_r8,2.7829e+01_r8/) + kbo(:, 2,57,13) = (/ & + &8.1249e+01_r8,6.3007e+01_r8,5.6061e+01_r8,5.3761e+01_r8,2.8811e+01_r8/) + kbo(:, 3,57,13) = (/ & + &1.7223e+02_r8,1.2931e+02_r8,9.1411e+01_r8,6.6606e+01_r8,2.9335e+01_r8/) + kbo(:, 4,57,13) = (/ & + &3.3026e+02_r8,2.4783e+02_r8,1.6598e+02_r8,9.4193e+01_r8,2.9500e+01_r8/) + kbo(:, 5,57,13) = (/ & + &5.8636e+02_r8,4.3987e+02_r8,2.9340e+02_r8,1.5031e+02_r8,2.9335e+01_r8/) + kbo(:, 1,58,13) = (/ & + &6.5933e+00_r8,9.4893e+00_r8,1.6089e+01_r8,2.5300e+01_r8,2.7425e+01_r8/) + kbo(:, 2,58,13) = (/ & + &1.6360e+01_r8,1.6224e+01_r8,2.0957e+01_r8,3.0182e+01_r8,2.8583e+01_r8/) + kbo(:, 3,58,13) = (/ & + &3.5957e+01_r8,3.3123e+01_r8,3.1853e+01_r8,3.6291e+01_r8,2.9233e+01_r8/) + kbo(:, 4,58,13) = (/ & + &7.1076e+01_r8,6.5212e+01_r8,5.6746e+01_r8,4.8699e+01_r8,2.9472e+01_r8/) + kbo(:, 5,58,13) = (/ & + &1.2897e+02_r8,1.1828e+02_r8,1.0149e+02_r8,7.4519e+01_r8,2.9400e+01_r8/) + kbo(:, 1,59,13) = (/ & + &6.7458e+00_r8,1.2021e+01_r8,2.0178e+01_r8,2.9391e+01_r8,2.7237e+01_r8/) + kbo(:, 2,59,13) = (/ & + &1.7109e+01_r8,1.8183e+01_r8,2.5274e+01_r8,3.4440e+01_r8,2.8519e+01_r8/) + kbo(:, 3,59,13) = (/ & + &3.8233e+01_r8,3.4158e+01_r8,3.4619e+01_r8,4.0204e+01_r8,2.9240e+01_r8/) + kbo(:, 4,59,13) = (/ & + &7.6647e+01_r8,6.6998e+01_r8,5.6073e+01_r8,4.9489e+01_r8,2.9509e+01_r8/) + kbo(:, 5,59,13) = (/ & + &1.4043e+02_r8,1.2268e+02_r8,9.8230e+01_r8,6.8889e+01_r8,2.9402e+01_r8/) + kbo(:, 1,13,14) = (/ & + &2.1776e+03_r8,1.6333e+03_r8,1.0891e+03_r8,5.4478e+02_r8,7.3262e+00_r8/) + kbo(:, 2,13,14) = (/ & + &3.1101e+03_r8,2.3327e+03_r8,1.5553e+03_r8,7.7788e+02_r8,7.3124e+00_r8/) + kbo(:, 3,13,14) = (/ & + &4.2249e+03_r8,3.1687e+03_r8,2.1126e+03_r8,1.0565e+03_r8,7.2480e+00_r8/) + kbo(:, 4,13,14) = (/ & + &5.5118e+03_r8,4.1339e+03_r8,2.7561e+03_r8,1.3783e+03_r8,7.1568e+00_r8/) + kbo(:, 5,13,14) = (/ & + &6.9506e+03_r8,5.2131e+03_r8,3.4755e+03_r8,1.7380e+03_r8,7.0367e+00_r8/) + kbo(:, 1,14,14) = (/ & + &1.4496e+03_r8,1.0873e+03_r8,7.2501e+02_r8,3.6272e+02_r8,8.3339e+00_r8/) + kbo(:, 2,14,14) = (/ & + &2.0734e+03_r8,1.5551e+03_r8,1.0369e+03_r8,5.1863e+02_r8,8.2705e+00_r8/) + kbo(:, 3,14,14) = (/ & + &2.8238e+03_r8,2.1179e+03_r8,1.4121e+03_r8,7.0623e+02_r8,8.1703e+00_r8/) + kbo(:, 4,14,14) = (/ & + &3.6841e+03_r8,2.7632e+03_r8,1.8422e+03_r8,9.2131e+02_r8,8.0387e+00_r8/) + kbo(:, 5,14,14) = (/ & + &4.6457e+03_r8,3.4843e+03_r8,2.3230e+03_r8,1.1617e+03_r8,7.8896e+00_r8/) + kbo(:, 1,15,14) = (/ & + &9.9772e+02_r8,7.4839e+02_r8,4.9906e+02_r8,2.4972e+02_r8,9.4242e+00_r8/) + kbo(:, 2,15,14) = (/ & + &1.4271e+03_r8,1.0704e+03_r8,7.1374e+02_r8,3.5707e+02_r8,9.3124e+00_r8/) + kbo(:, 3,15,14) = (/ & + &1.9364e+03_r8,1.4524e+03_r8,9.6841e+02_r8,4.8440e+02_r8,9.1590e+00_r8/) + kbo(:, 4,15,14) = (/ & + &2.5268e+03_r8,1.8952e+03_r8,1.2636e+03_r8,6.3198e+02_r8,8.9837e+00_r8/) + kbo(:, 5,15,14) = (/ & + &3.1888e+03_r8,2.3917e+03_r8,1.5946e+03_r8,7.9748e+02_r8,8.7913e+00_r8/) + kbo(:, 1,16,14) = (/ & + &8.2535e+02_r8,6.1910e+02_r8,4.1286e+02_r8,2.0662e+02_r8,1.0617e+01_r8/) + kbo(:, 2,16,14) = (/ & + &1.1765e+03_r8,8.8250e+02_r8,5.8845e+02_r8,2.9441e+02_r8,1.0441e+01_r8/) + kbo(:, 3,16,14) = (/ & + &1.5988e+03_r8,1.1992e+03_r8,7.9956e+02_r8,3.9995e+02_r8,1.0240e+01_r8/) + kbo(:, 4,16,14) = (/ & + &2.0853e+03_r8,1.5640e+03_r8,1.0428e+03_r8,5.2160e+02_r8,1.0022e+01_r8/) + kbo(:, 5,16,14) = (/ & + &2.6260e+03_r8,1.9696e+03_r8,1.3132e+03_r8,6.5679e+02_r8,9.7853e+00_r8/) + kbo(:, 1,17,14) = (/ & + &7.1446e+02_r8,5.3593e+02_r8,3.5740e+02_r8,1.7888e+02_r8,1.1902e+01_r8/) + kbo(:, 2,17,14) = (/ & + &1.0170e+03_r8,7.6281e+02_r8,5.0866e+02_r8,2.5450e+02_r8,1.1678e+01_r8/) + kbo(:, 3,17,14) = (/ & + &1.3782e+03_r8,1.0338e+03_r8,6.8929e+02_r8,3.4482e+02_r8,1.1434e+01_r8/) + kbo(:, 4,17,14) = (/ & + &1.7913e+03_r8,1.3436e+03_r8,8.9585e+02_r8,4.4810e+02_r8,1.1160e+01_r8/) + kbo(:, 5,17,14) = (/ & + &2.2531e+03_r8,1.6899e+03_r8,1.1267e+03_r8,5.6354e+02_r8,1.0872e+01_r8/) + kbo(:, 1,18,14) = (/ & + &6.3627e+02_r8,4.7728e+02_r8,3.1830e+02_r8,1.5932e+02_r8,1.3306e+01_r8/) + kbo(:, 2,18,14) = (/ & + &9.0279e+02_r8,6.7718e+02_r8,4.5157e+02_r8,2.2596e+02_r8,1.3021e+01_r8/) + kbo(:, 3,18,14) = (/ & + &1.2176e+03_r8,9.1326e+02_r8,6.0896e+02_r8,3.0466e+02_r8,1.2705e+01_r8/) + kbo(:, 4,18,14) = (/ & + &1.5793e+03_r8,1.1846e+03_r8,7.8983e+02_r8,3.9509e+02_r8,1.2374e+01_r8/) + kbo(:, 5,18,14) = (/ & + &1.9821e+03_r8,1.4867e+03_r8,9.9125e+02_r8,4.9580e+02_r8,1.2038e+01_r8/) + kbo(:, 1,19,14) = (/ & + &5.5701e+02_r8,4.1784e+02_r8,2.7868e+02_r8,1.3951e+02_r8,1.4835e+01_r8/) + kbo(:, 2,19,14) = (/ & + &7.8555e+02_r8,5.8924e+02_r8,3.9294e+02_r8,1.9665e+02_r8,1.4471e+01_r8/) + kbo(:, 3,19,14) = (/ & + &1.0565e+03_r8,7.9246e+02_r8,5.2842e+02_r8,2.6438e+02_r8,1.4088e+01_r8/) + kbo(:, 4,19,14) = (/ & + &1.3666e+03_r8,1.0251e+03_r8,6.8348e+02_r8,3.4191e+02_r8,1.3700e+01_r8/) + kbo(:, 5,19,14) = (/ & + &1.7097e+03_r8,1.2824e+03_r8,8.5504e+02_r8,4.2769e+02_r8,1.3330e+01_r8/) + kbo(:, 1,20,14) = (/ & + &5.2902e+02_r8,3.9685e+02_r8,2.6468e+02_r8,1.3251e+02_r8,1.6461e+01_r8/) + kbo(:, 2,20,14) = (/ & + &7.4221e+02_r8,5.5674e+02_r8,3.7128e+02_r8,1.8581e+02_r8,1.6028e+01_r8/) + kbo(:, 3,20,14) = (/ & + &9.9413e+02_r8,7.4568e+02_r8,4.9723e+02_r8,2.4879e+02_r8,1.5588e+01_r8/) + kbo(:, 4,20,14) = (/ & + &1.2802e+03_r8,9.6022e+02_r8,6.4026e+02_r8,3.2030e+02_r8,1.5170e+01_r8/) + kbo(:, 5,20,14) = (/ & + &1.5959e+03_r8,1.1970e+03_r8,7.9814e+02_r8,3.9924e+02_r8,1.4766e+01_r8/) + kbo(:, 1,21,14) = (/ & + &5.1643e+02_r8,3.8740e+02_r8,2.5838e+02_r8,1.2935e+02_r8,1.8266e+01_r8/) + kbo(:, 2,21,14) = (/ & + &7.2079e+02_r8,5.4067e+02_r8,3.6056e+02_r8,1.8045e+02_r8,1.7763e+01_r8/) + kbo(:, 3,21,14) = (/ & + &9.5965e+02_r8,7.1982e+02_r8,4.7999e+02_r8,2.4017e+02_r8,1.7272e+01_r8/) + kbo(:, 4,21,14) = (/ & + &1.2302e+03_r8,9.2274e+02_r8,6.1527e+02_r8,3.0781e+02_r8,1.6803e+01_r8/) + kbo(:, 5,21,14) = (/ & + &1.5280e+03_r8,1.1461e+03_r8,7.6416e+02_r8,3.8225e+02_r8,1.6348e+01_r8/) + kbo(:, 1,22,14) = (/ & + &5.2623e+02_r8,3.9475e+02_r8,2.6327e+02_r8,1.3179e+02_r8,2.0243e+01_r8/) + kbo(:, 2,22,14) = (/ & + &7.2644e+02_r8,5.4491e+02_r8,3.6339e+02_r8,1.8186e+02_r8,1.9664e+01_r8/) + kbo(:, 3,22,14) = (/ & + &9.5925e+02_r8,7.1952e+02_r8,4.7979e+02_r8,2.4006e+02_r8,1.9116e+01_r8/) + kbo(:, 4,22,14) = (/ & + &1.2211e+03_r8,9.1590e+02_r8,6.1071e+02_r8,3.0553e+02_r8,1.8593e+01_r8/) + kbo(:, 5,22,14) = (/ & + &1.5078e+03_r8,1.1310e+03_r8,7.5409e+02_r8,3.7722e+02_r8,1.8080e+01_r8/) + kbo(:, 1,23,14) = (/ & + &5.3158e+02_r8,3.9876e+02_r8,2.6595e+02_r8,1.3313e+02_r8,2.2446e+01_r8/) + kbo(:, 2,23,14) = (/ & + &7.2667e+02_r8,5.4508e+02_r8,3.6349e+02_r8,1.8191e+02_r8,2.1789e+01_r8/) + kbo(:, 3,23,14) = (/ & + &9.5159e+02_r8,7.1378e+02_r8,4.7596e+02_r8,2.3814e+02_r8,2.1156e+01_r8/) + kbo(:, 4,23,14) = (/ & + &1.2042e+03_r8,9.0323e+02_r8,6.0227e+02_r8,3.0131e+02_r8,2.0541e+01_r8/) + kbo(:, 5,23,14) = (/ & + &1.4791e+03_r8,1.1094e+03_r8,7.3972e+02_r8,3.7004e+02_r8,1.9936e+01_r8/) + kbo(:, 1,24,14) = (/ & + &5.2674e+02_r8,3.9513e+02_r8,2.6351e+02_r8,1.3189e+02_r8,2.4861e+01_r8/) + kbo(:, 2,24,14) = (/ & + &7.1320e+02_r8,5.3497e+02_r8,3.5675e+02_r8,1.7852e+02_r8,2.4105e+01_r8/) + kbo(:, 3,24,14) = (/ & + &9.2799e+02_r8,6.9608e+02_r8,4.6416e+02_r8,2.3224e+02_r8,2.3357e+01_r8/) + kbo(:, 4,24,14) = (/ & + &1.1676e+03_r8,8.7581e+02_r8,5.8399e+02_r8,2.9218e+02_r8,2.2617e+01_r8/) + kbo(:, 5,24,14) = (/ & + &1.4298e+03_r8,1.0724e+03_r8,7.1508e+02_r8,3.5774e+02_r8,2.1888e+01_r8/) + kbo(:, 1,25,14) = (/ & + &5.2185e+02_r8,3.9145e+02_r8,2.6105e+02_r8,1.3066e+02_r8,2.7396e+01_r8/) + kbo(:, 2,25,14) = (/ & + &7.0140e+02_r8,5.2612e+02_r8,3.5084e+02_r8,1.7556e+02_r8,2.6509e+01_r8/) + kbo(:, 3,25,14) = (/ & + &9.0713e+02_r8,6.8043e+02_r8,4.5373e+02_r8,2.2703e+02_r8,2.5618e+01_r8/) + kbo(:, 4,25,14) = (/ & + &1.1371e+03_r8,8.5288e+02_r8,5.6870e+02_r8,2.8453e+02_r8,2.4730e+01_r8/) + kbo(:, 5,25,14) = (/ & + &1.3891e+03_r8,1.0419e+03_r8,6.9474e+02_r8,3.4757e+02_r8,2.3860e+01_r8/) + kbo(:, 1,26,14) = (/ & + &5.2251e+02_r8,3.9195e+02_r8,2.6138e+02_r8,1.3085e+02_r8,2.9927e+01_r8/) + kbo(:, 2,26,14) = (/ & + &6.9730e+02_r8,5.2305e+02_r8,3.4880e+02_r8,1.7455e+02_r8,2.8877e+01_r8/) + kbo(:, 3,26,14) = (/ & + &8.9735e+02_r8,6.7309e+02_r8,4.4884e+02_r8,2.2459e+02_r8,2.7820e+01_r8/) + kbo(:, 4,26,14) = (/ & + &1.1213e+03_r8,8.4105e+02_r8,5.6081e+02_r8,2.8058e+02_r8,2.6772e+01_r8/) + kbo(:, 5,26,14) = (/ & + &1.3665e+03_r8,1.0250e+03_r8,6.8346e+02_r8,3.4192e+02_r8,2.5741e+01_r8/) + kbo(:, 1,27,14) = (/ & + &5.3834e+02_r8,4.0383e+02_r8,2.6931e+02_r8,1.3510e+02_r8,3.2357e+01_r8/) + kbo(:, 2,27,14) = (/ & + &7.1439e+02_r8,5.3587e+02_r8,3.5735e+02_r8,1.7883e+02_r8,3.1116e+01_r8/) + kbo(:, 3,27,14) = (/ & + &9.1626e+02_r8,6.8728e+02_r8,4.5830e+02_r8,2.2932e+02_r8,2.9881e+01_r8/) + kbo(:, 4,27,14) = (/ & + &1.1424e+03_r8,8.5692e+02_r8,5.7140e+02_r8,2.8587e+02_r8,2.8666e+01_r8/) + kbo(:, 5,27,14) = (/ & + &1.3901e+03_r8,1.0427e+03_r8,6.9525e+02_r8,3.4781e+02_r8,2.7467e+01_r8/) + kbo(:, 1,28,14) = (/ & + &5.6592e+02_r8,4.2451e+02_r8,2.8310e+02_r8,1.4237e+02_r8,3.4583e+01_r8/) + kbo(:, 2,28,14) = (/ & + &7.4785e+02_r8,5.6096e+02_r8,3.7408e+02_r8,1.8720e+02_r8,3.3140e+01_r8/) + kbo(:, 3,28,14) = (/ & + &9.5690e+02_r8,7.1776e+02_r8,4.7862e+02_r8,2.3947e+02_r8,3.1724e+01_r8/) + kbo(:, 4,28,14) = (/ & + &1.1915e+03_r8,8.9371e+02_r8,5.9592e+02_r8,2.9814e+02_r8,3.0340e+01_r8/) + kbo(:, 5,28,14) = (/ & + &1.4480e+03_r8,1.0861e+03_r8,7.2421e+02_r8,3.6229e+02_r8,2.8988e+01_r8/) + kbo(:, 1,29,14) = (/ & + &6.3031e+02_r8,4.7280e+02_r8,3.1529e+02_r8,1.5867e+02_r8,3.6546e+01_r8/) + kbo(:, 2,29,14) = (/ & + &8.3056e+02_r8,6.2300e+02_r8,4.1543e+02_r8,2.0788e+02_r8,3.4912e+01_r8/) + kbo(:, 3,29,14) = (/ & + &1.0608e+03_r8,7.9566e+02_r8,5.3055e+02_r8,2.6544e+02_r8,3.3320e+01_r8/) + kbo(:, 4,29,14) = (/ & + &1.3185e+03_r8,9.8899e+02_r8,6.5945e+02_r8,3.2990e+02_r8,3.1769e+01_r8/) + kbo(:, 5,29,14) = (/ & + &1.6020e+03_r8,1.2016e+03_r8,8.0116e+02_r8,4.0076e+02_r8,3.0274e+01_r8/) + kbo(:, 1,30,14) = (/ & + &7.1878e+02_r8,5.3916e+02_r8,3.5953e+02_r8,1.8082e+02_r8,3.8231e+01_r8/) + kbo(:, 2,30,14) = (/ & + &9.4502e+02_r8,7.0884e+02_r8,4.7266e+02_r8,2.3650e+02_r8,3.6421e+01_r8/) + kbo(:, 3,30,14) = (/ & + &1.2048e+03_r8,9.0370e+02_r8,6.0258e+02_r8,3.0145e+02_r8,3.4660e+01_r8/) + kbo(:, 4,30,14) = (/ & + &1.4966e+03_r8,1.1225e+03_r8,7.4846e+02_r8,3.7440e+02_r8,3.2964e+01_r8/) + kbo(:, 5,30,14) = (/ & + &1.8180e+03_r8,1.3636e+03_r8,9.0918e+02_r8,4.5477e+02_r8,3.1338e+01_r8/) + kbo(:, 1,31,14) = (/ & + &8.6352e+02_r8,6.4770e+02_r8,4.3189e+02_r8,2.1681e+02_r8,3.9626e+01_r8/) + kbo(:, 2,31,14) = (/ & + &1.1338e+03_r8,8.5039e+02_r8,5.6702e+02_r8,2.8366e+02_r8,3.7649e+01_r8/) + kbo(:, 3,31,14) = (/ & + &1.4436e+03_r8,1.0827e+03_r8,7.2193e+02_r8,3.6112e+02_r8,3.5738e+01_r8/) + kbo(:, 4,31,14) = (/ & + &1.7919e+03_r8,1.3440e+03_r8,8.9611e+02_r8,4.4823e+02_r8,3.3911e+01_r8/) + kbo(:, 5,31,14) = (/ & + &2.1766e+03_r8,1.6325e+03_r8,1.0885e+03_r8,5.4442e+02_r8,3.2168e+01_r8/) + kbo(:, 1,32,14) = (/ & + &1.0534e+03_r8,7.9009e+02_r8,5.2682e+02_r8,2.6397e+02_r8,4.0725e+01_r8/) + kbo(:, 2,32,14) = (/ & + &1.3802e+03_r8,1.0352e+03_r8,6.9024e+02_r8,3.4527e+02_r8,3.8603e+01_r8/) + kbo(:, 3,32,14) = (/ & + &1.7557e+03_r8,1.3169e+03_r8,8.7802e+02_r8,4.3918e+02_r8,3.6565e+01_r8/) + kbo(:, 4,32,14) = (/ & + &2.1789e+03_r8,1.6342e+03_r8,1.0896e+03_r8,5.4499e+02_r8,3.4625e+01_r8/) + kbo(:, 5,32,14) = (/ & + &2.6446e+03_r8,1.9836e+03_r8,1.3225e+03_r8,6.6145e+02_r8,3.2784e+01_r8/) + kbo(:, 1,33,14) = (/ & + &1.3124e+03_r8,9.8436e+02_r8,6.5633e+02_r8,3.2843e+02_r8,4.1548e+01_r8/) + kbo(:, 2,33,14) = (/ & + &1.7177e+03_r8,1.2883e+03_r8,8.5900e+02_r8,4.2966e+02_r8,3.9303e+01_r8/) + kbo(:, 3,33,14) = (/ & + &2.1832e+03_r8,1.6375e+03_r8,1.0918e+03_r8,5.4605e+02_r8,3.7160e+01_r8/) + kbo(:, 4,33,14) = (/ & + &2.7063e+03_r8,2.0298e+03_r8,1.3533e+03_r8,6.7686e+02_r8,3.5130e+01_r8/) + kbo(:, 5,33,14) = (/ & + &3.2806e+03_r8,2.4606e+03_r8,1.6405e+03_r8,8.2046e+02_r8,3.3063e+01_r8/) + kbo(:, 1,34,14) = (/ & + &1.5860e+03_r8,1.1896e+03_r8,7.9315e+02_r8,3.9672e+02_r8,4.2202e+01_r8/) + kbo(:, 2,34,14) = (/ & + &2.0745e+03_r8,1.5559e+03_r8,1.0374e+03_r8,5.1886e+02_r8,3.9853e+01_r8/) + kbo(:, 3,34,14) = (/ & + &2.6355e+03_r8,1.9767e+03_r8,1.3179e+03_r8,6.5913e+02_r8,3.7623e+01_r8/) + kbo(:, 4,34,14) = (/ & + &3.2644e+03_r8,2.4484e+03_r8,1.6324e+03_r8,8.1637e+02_r8,3.5405e+01_r8/) + kbo(:, 5,34,14) = (/ & + &3.9520e+03_r8,2.9641e+03_r8,1.9762e+03_r8,9.8832e+02_r8,3.3276e+01_r8/) + kbo(:, 1,35,14) = (/ & + &1.8756e+03_r8,1.4068e+03_r8,9.3797e+02_r8,4.6914e+02_r8,4.2878e+01_r8/) + kbo(:, 2,35,14) = (/ & + &2.4578e+03_r8,1.8434e+03_r8,1.2290e+03_r8,6.1469e+02_r8,4.0440e+01_r8/) + kbo(:, 3,35,14) = (/ & + &3.1268e+03_r8,2.3452e+03_r8,1.5636e+03_r8,7.8197e+02_r8,3.8129e+01_r8/) + kbo(:, 4,35,14) = (/ & + &3.8751e+03_r8,2.9064e+03_r8,1.9378e+03_r8,9.6909e+02_r8,3.5715e+01_r8/) + kbo(:, 5,35,14) = (/ & + &4.6936e+03_r8,3.5203e+03_r8,2.3471e+03_r8,1.1738e+03_r8,3.3797e+01_r8/) + kbo(:, 1,36,14) = (/ & + &2.1453e+03_r8,1.6090e+03_r8,1.0728e+03_r8,5.3655e+02_r8,4.3664e+01_r8/) + kbo(:, 2,36,14) = (/ & + &2.8245e+03_r8,2.1184e+03_r8,1.4124e+03_r8,7.0636e+02_r8,4.1138e+01_r8/) + kbo(:, 3,36,14) = (/ & + &3.6063e+03_r8,2.7048e+03_r8,1.8033e+03_r8,9.0186e+02_r8,3.8589e+01_r8/) + kbo(:, 4,36,14) = (/ & + &4.4821e+03_r8,3.3616e+03_r8,2.2412e+03_r8,1.1208e+03_r8,3.6195e+01_r8/) + kbo(:, 5,36,14) = (/ & + &5.4418e+03_r8,4.0814e+03_r8,2.7211e+03_r8,1.3608e+03_r8,3.4367e+01_r8/) + kbo(:, 1,37,14) = (/ & + &2.2940e+03_r8,1.7205e+03_r8,1.1471e+03_r8,5.7372e+02_r8,4.4724e+01_r8/) + kbo(:, 2,37,14) = (/ & + &3.0476e+03_r8,2.2858e+03_r8,1.5240e+03_r8,7.6217e+02_r8,4.2103e+01_r8/) + kbo(:, 3,37,14) = (/ & + &3.9216e+03_r8,2.9413e+03_r8,1.9610e+03_r8,9.8070e+02_r8,3.9415e+01_r8/) + kbo(:, 4,37,14) = (/ & + &4.9050e+03_r8,3.6789e+03_r8,2.4527e+03_r8,1.2266e+03_r8,3.7136e+01_r8/) + kbo(:, 5,37,14) = (/ & + &5.9876e+03_r8,4.4908e+03_r8,2.9940e+03_r8,1.4972e+03_r8,3.5121e+01_r8/) + kbo(:, 1,38,14) = (/ & + &2.4855e+03_r8,1.8642e+03_r8,1.2429e+03_r8,6.2161e+02_r8,4.5721e+01_r8/) + kbo(:, 2,38,14) = (/ & + &3.3318e+03_r8,2.4989e+03_r8,1.6661e+03_r8,8.3322e+02_r8,4.3010e+01_r8/) + kbo(:, 3,38,14) = (/ & + &4.3213e+03_r8,3.2410e+03_r8,2.1608e+03_r8,1.0806e+03_r8,4.0195e+01_r8/) + kbo(:, 4,38,14) = (/ & + &5.4403e+03_r8,4.0803e+03_r8,2.7203e+03_r8,1.3604e+03_r8,3.7939e+01_r8/) + kbo(:, 5,38,14) = (/ & + &6.6754e+03_r8,5.0066e+03_r8,3.3379e+03_r8,1.6692e+03_r8,3.5824e+01_r8/) + kbo(:, 1,39,14) = (/ & + &2.7579e+03_r8,2.0685e+03_r8,1.3791e+03_r8,6.8973e+02_r8,4.6636e+01_r8/) + kbo(:, 2,39,14) = (/ & + &3.7311e+03_r8,2.7984e+03_r8,1.8657e+03_r8,9.3308e+02_r8,4.3764e+01_r8/) + kbo(:, 3,39,14) = (/ & + &4.8740e+03_r8,3.6556e+03_r8,2.4372e+03_r8,1.2188e+03_r8,4.0901e+01_r8/) + kbo(:, 4,39,14) = (/ & + &6.1755e+03_r8,4.6318e+03_r8,3.0880e+03_r8,1.5442e+03_r8,3.8692e+01_r8/) + kbo(:, 5,39,14) = (/ & + &7.6168e+03_r8,5.7128e+03_r8,3.8087e+03_r8,1.9046e+03_r8,3.6244e+01_r8/) + kbo(:, 1,40,14) = (/ & + &2.7806e+03_r8,2.0855e+03_r8,1.3905e+03_r8,6.9541e+02_r8,4.7781e+01_r8/) + kbo(:, 2,40,14) = (/ & + &3.8105e+03_r8,2.8580e+03_r8,1.9054e+03_r8,9.5291e+02_r8,4.4820e+01_r8/) + kbo(:, 3,40,14) = (/ & + &5.0317e+03_r8,3.7739e+03_r8,2.5160e+03_r8,1.2582e+03_r8,4.1870e+01_r8/) + kbo(:, 4,40,14) = (/ & + &6.4348e+03_r8,4.8262e+03_r8,3.2176e+03_r8,1.6090e+03_r8,3.9597e+01_r8/) + kbo(:, 5,40,14) = (/ & + &7.9965e+03_r8,5.9975e+03_r8,3.9985e+03_r8,1.9995e+03_r8,3.7061e+01_r8/) + kbo(:, 1,41,14) = (/ & + &2.7787e+03_r8,2.0841e+03_r8,1.3895e+03_r8,6.9500e+02_r8,4.8925e+01_r8/) + kbo(:, 2,41,14) = (/ & + &3.8614e+03_r8,2.8961e+03_r8,1.9309e+03_r8,9.6566e+02_r8,4.5922e+01_r8/) + kbo(:, 3,41,14) = (/ & + &5.1574e+03_r8,3.8681e+03_r8,2.5789e+03_r8,1.2897e+03_r8,4.2853e+01_r8/) + kbo(:, 4,41,14) = (/ & + &6.6587e+03_r8,4.9941e+03_r8,3.3296e+03_r8,1.6650e+03_r8,4.0428e+01_r8/) + kbo(:, 5,41,14) = (/ & + &8.3439e+03_r8,6.2581e+03_r8,4.1723e+03_r8,2.0864e+03_r8,3.7900e+01_r8/) + kbo(:, 1,42,14) = (/ & + &2.7998e+03_r8,2.0999e+03_r8,1.4001e+03_r8,7.0041e+02_r8,5.0031e+01_r8/) + kbo(:, 2,42,14) = (/ & + &3.9460e+03_r8,2.9596e+03_r8,1.9732e+03_r8,9.8680e+02_r8,4.6998e+01_r8/) + kbo(:, 3,42,14) = (/ & + &5.3323e+03_r8,3.9993e+03_r8,2.6663e+03_r8,1.3334e+03_r8,4.3819e+01_r8/) + kbo(:, 4,42,14) = (/ & + &6.9531e+03_r8,5.2149e+03_r8,3.4767e+03_r8,1.7386e+03_r8,4.1253e+01_r8/) + kbo(:, 5,42,14) = (/ & + &8.7873e+03_r8,6.5906e+03_r8,4.3939e+03_r8,2.1972e+03_r8,3.8745e+01_r8/) + kbo(:, 1,43,14) = (/ & + &2.7784e+03_r8,2.0839e+03_r8,1.3894e+03_r8,6.9544e+02_r8,5.1292e+01_r8/) + kbo(:, 2,43,14) = (/ & + &3.9830e+03_r8,2.9874e+03_r8,1.9917e+03_r8,9.9606e+02_r8,4.8177e+01_r8/) + kbo(:, 3,43,14) = (/ & + &5.4603e+03_r8,4.0953e+03_r8,2.7304e+03_r8,1.3654e+03_r8,4.4925e+01_r8/) + kbo(:, 4,43,14) = (/ & + &7.2065e+03_r8,5.4050e+03_r8,3.6035e+03_r8,1.8020e+03_r8,4.2242e+01_r8/) + kbo(:, 5,43,14) = (/ & + &9.2025e+03_r8,6.9020e+03_r8,4.6015e+03_r8,2.3010e+03_r8,3.9649e+01_r8/) + kbo(:, 1,44,14) = (/ & + &2.7542e+03_r8,2.0657e+03_r8,1.3772e+03_r8,6.8977e+02_r8,5.2617e+01_r8/) + kbo(:, 2,44,14) = (/ & + &4.0230e+03_r8,3.0173e+03_r8,2.0117e+03_r8,1.0060e+03_r8,4.9427e+01_r8/) + kbo(:, 3,44,14) = (/ & + &5.6050e+03_r8,4.2038e+03_r8,2.8027e+03_r8,1.4015e+03_r8,4.6077e+01_r8/) + kbo(:, 4,44,14) = (/ & + &7.4959e+03_r8,5.6220e+03_r8,3.7481e+03_r8,1.8743e+03_r8,4.3276e+01_r8/) + kbo(:, 5,44,14) = (/ & + &9.6875e+03_r8,7.2657e+03_r8,4.8439e+03_r8,2.4222e+03_r8,4.0647e+01_r8/) + kbo(:, 1,45,14) = (/ & + &2.7680e+03_r8,2.0761e+03_r8,1.3842e+03_r8,6.9371e+02_r8,5.3927e+01_r8/) + kbo(:, 2,45,14) = (/ & + &4.1247e+03_r8,3.0936e+03_r8,2.0625e+03_r8,1.0314e+03_r8,5.0672e+01_r8/) + kbo(:, 3,45,14) = (/ & + &5.8448e+03_r8,4.3837e+03_r8,2.9226e+03_r8,1.4615e+03_r8,4.7150e+01_r8/) + kbo(:, 4,45,14) = (/ & + &7.9284e+03_r8,5.9463e+03_r8,3.9644e+03_r8,1.9824e+03_r8,4.4329e+01_r8/) + kbo(:, 5,45,14) = (/ & + &1.0369e+04_r8,7.7768e+03_r8,5.1847e+03_r8,2.5926e+03_r8,4.1634e+01_r8/) + kbo(:, 1,46,14) = (/ & + &2.7642e+03_r8,2.0732e+03_r8,1.3822e+03_r8,6.9344e+02_r8,5.5299e+01_r8/) + kbo(:, 2,46,14) = (/ & + &4.2127e+03_r8,3.1596e+03_r8,2.1065e+03_r8,1.0534e+03_r8,5.1989e+01_r8/) + kbo(:, 3,46,14) = (/ & + &6.0817e+03_r8,4.5614e+03_r8,3.0411e+03_r8,1.5207e+03_r8,4.8362e+01_r8/) + kbo(:, 4,46,14) = (/ & + &8.3835e+03_r8,6.2877e+03_r8,4.1920e+03_r8,2.0962e+03_r8,4.5451e+01_r8/) + kbo(:, 5,46,14) = (/ & + &1.1109e+04_r8,8.3315e+03_r8,5.5545e+03_r8,2.7775e+03_r8,4.2710e+01_r8/) + kbo(:, 1,47,14) = (/ & + &2.6579e+03_r8,1.9935e+03_r8,1.3291e+03_r8,6.6810e+02_r8,5.6805e+01_r8/) + kbo(:, 2,47,14) = (/ & + &4.1618e+03_r8,3.1214e+03_r8,2.0811e+03_r8,1.0407e+03_r8,5.3447e+01_r8/) + kbo(:, 3,47,14) = (/ & + &6.1402e+03_r8,4.6053e+03_r8,3.0703e+03_r8,1.5354e+03_r8,4.9761e+01_r8/) + kbo(:, 4,47,14) = (/ & + &8.6262e+03_r8,6.4697e+03_r8,4.3133e+03_r8,2.1569e+03_r8,4.6695e+01_r8/) + kbo(:, 5,47,14) = (/ & + &1.1609e+04_r8,8.7071e+03_r8,5.8049e+03_r8,2.9027e+03_r8,4.4026e+01_r8/) + kbo(:, 1,48,14) = (/ & + &2.5983e+03_r8,1.9488e+03_r8,1.2993e+03_r8,6.5451e+02_r8,5.8316e+01_r8/) + kbo(:, 2,48,14) = (/ & + &4.1890e+03_r8,3.1418e+03_r8,2.0947e+03_r8,1.0476e+03_r8,5.4906e+01_r8/) + kbo(:, 3,48,14) = (/ & + &6.3280e+03_r8,4.7461e+03_r8,3.1642e+03_r8,1.5823e+03_r8,5.1153e+01_r8/) + kbo(:, 4,48,14) = (/ & + &9.0666e+03_r8,6.8001e+03_r8,4.5335e+03_r8,2.2670e+03_r8,4.7961e+01_r8/) + kbo(:, 5,48,14) = (/ & + &1.2413e+04_r8,9.3096e+03_r8,6.2066e+03_r8,3.1035e+03_r8,4.5348e+01_r8/) + kbo(:, 1,49,14) = (/ & + &2.6146e+03_r8,1.9610e+03_r8,1.3074e+03_r8,6.5952e+02_r8,5.9823e+01_r8/) + kbo(:, 2,49,14) = (/ & + &4.3479e+03_r8,3.2610e+03_r8,2.1741e+03_r8,1.0874e+03_r8,5.6229e+01_r8/) + kbo(:, 3,49,14) = (/ & + &6.7401e+03_r8,5.0552e+03_r8,3.3702e+03_r8,1.6853e+03_r8,5.2522e+01_r8/) + kbo(:, 4,49,14) = (/ & + &9.8602e+03_r8,7.3953e+03_r8,4.9303e+03_r8,2.4653e+03_r8,4.9326e+01_r8/) + kbo(:, 5,49,14) = (/ & + &1.3745e+04_r8,1.0309e+04_r8,6.8727e+03_r8,3.4366e+03_r8,4.6702e+01_r8/) + kbo(:, 1,50,14) = (/ & + &2.5099e+03_r8,1.8825e+03_r8,1.2551e+03_r8,6.3476e+02_r8,6.1230e+01_r8/) + kbo(:, 2,50,14) = (/ & + &4.3054e+03_r8,3.2291e+03_r8,2.1528e+03_r8,1.0772e+03_r8,5.7584e+01_r8/) + kbo(:, 3,50,14) = (/ & + &6.8503e+03_r8,5.1378e+03_r8,3.4253e+03_r8,1.7128e+03_r8,5.3876e+01_r8/) + kbo(:, 4,50,14) = (/ & + &1.0235e+04_r8,7.6760e+03_r8,5.1175e+03_r8,2.5589e+03_r8,5.0609e+01_r8/) + kbo(:, 5,50,14) = (/ & + &1.4527e+04_r8,1.0895e+04_r8,7.2636e+03_r8,3.6320e+03_r8,4.7904e+01_r8/) + kbo(:, 1,51,14) = (/ & + &2.3421e+03_r8,1.7566e+03_r8,1.1712e+03_r8,5.9456e+02_r8,6.2588e+01_r8/) + kbo(:, 2,51,14) = (/ & + &4.1517e+03_r8,3.1138e+03_r8,2.0760e+03_r8,1.0393e+03_r8,5.8927e+01_r8/) + kbo(:, 3,51,14) = (/ & + &6.7861e+03_r8,5.0897e+03_r8,3.3932e+03_r8,1.6968e+03_r8,5.5331e+01_r8/) + kbo(:, 4,51,14) = (/ & + &1.0366e+04_r8,7.7746e+03_r8,5.1832e+03_r8,2.5918e+03_r8,5.1728e+01_r8/) + kbo(:, 5,51,14) = (/ & + &1.4983e+04_r8,1.1238e+04_r8,7.4919e+03_r8,3.7462e+03_r8,4.9071e+01_r8/) + kbo(:, 1,52,14) = (/ & + &2.2192e+03_r8,1.6645e+03_r8,1.1098e+03_r8,5.6550e+02_r8,6.3929e+01_r8/) + kbo(:, 2,52,14) = (/ & + &4.0774e+03_r8,3.0581e+03_r8,2.0388e+03_r8,1.0215e+03_r8,6.0266e+01_r8/) + kbo(:, 3,52,14) = (/ & + &6.8574e+03_r8,5.1432e+03_r8,3.4289e+03_r8,1.7146e+03_r8,5.6630e+01_r8/) + kbo(:, 4,52,14) = (/ & + &1.0728e+04_r8,8.0459e+03_r8,5.3641e+03_r8,2.6822e+03_r8,5.3054e+01_r8/) + kbo(:, 5,52,14) = (/ & + &1.5806e+04_r8,1.1855e+04_r8,7.9035e+03_r8,3.9520e+03_r8,5.0321e+01_r8/) + kbo(:, 1,53,14) = (/ & + &2.1588e+03_r8,1.6192e+03_r8,1.0797e+03_r8,5.5175e+02_r8,6.5259e+01_r8/) + kbo(:, 2,53,14) = (/ & + &4.1225e+03_r8,3.0919e+03_r8,2.0614e+03_r8,1.0332e+03_r8,6.1546e+01_r8/) + kbo(:, 3,53,14) = (/ & + &7.1492e+03_r8,5.3620e+03_r8,3.5747e+03_r8,1.7875e+03_r8,5.7918e+01_r8/) + kbo(:, 4,53,14) = (/ & + &1.1475e+04_r8,8.6063e+03_r8,5.7376e+03_r8,2.8690e+03_r8,5.4409e+01_r8/) + kbo(:, 5,53,14) = (/ & + &1.7262e+04_r8,1.2946e+04_r8,8.6311e+03_r8,4.3158e+03_r8,5.1571e+01_r8/) + kbo(:, 1,54,14) = (/ & + &1.8282e+03_r8,1.3713e+03_r8,9.1520e+02_r8,4.7290e+02_r8,6.6448e+01_r8/) + kbo(:, 2,54,14) = (/ & + &3.6279e+03_r8,2.7210e+03_r8,1.8141e+03_r8,9.1135e+02_r8,6.2844e+01_r8/) + kbo(:, 3,54,14) = (/ & + &6.4841e+03_r8,4.8631e+03_r8,3.2422e+03_r8,1.6212e+03_r8,5.9155e+01_r8/) + kbo(:, 4,54,14) = (/ & + &1.0670e+04_r8,8.0025e+03_r8,5.3351e+03_r8,2.6677e+03_r8,5.5552e+01_r8/) + kbo(:, 5,54,14) = (/ & + &1.6384e+04_r8,1.2288e+04_r8,8.1922e+03_r8,4.0963e+03_r8,5.2636e+01_r8/) + kbo(:, 1,55,14) = (/ & + &1.4067e+03_r8,1.0551e+03_r8,7.0638e+02_r8,3.7354e+02_r8,6.7558e+01_r8/) + kbo(:, 2,55,14) = (/ & + &2.9041e+03_r8,2.1781e+03_r8,1.4522e+03_r8,7.3353e+02_r8,6.4148e+01_r8/) + kbo(:, 3,55,14) = (/ & + &5.3593e+03_r8,4.0195e+03_r8,2.6797e+03_r8,1.3404e+03_r8,6.0390e+01_r8/) + kbo(:, 4,55,14) = (/ & + &9.0439e+03_r8,6.7830e+03_r8,4.5221e+03_r8,2.2612e+03_r8,5.6702e+01_r8/) + kbo(:, 5,55,14) = (/ & + &1.4184e+04_r8,1.0638e+04_r8,7.0920e+03_r8,3.5462e+03_r8,5.3319e+01_r8/) + kbo(:, 1,56,14) = (/ & + &1.0676e+03_r8,8.0078e+02_r8,5.3961e+02_r8,2.9566e+02_r8,6.8630e+01_r8/) + kbo(:, 2,56,14) = (/ & + &2.3009e+03_r8,1.7258e+03_r8,1.1507e+03_r8,5.8655e+02_r8,6.5294e+01_r8/) + kbo(:, 3,56,14) = (/ & + &4.3913e+03_r8,3.2935e+03_r8,2.1958e+03_r8,1.1000e+03_r8,6.1700e+01_r8/) + kbo(:, 4,56,14) = (/ & + &7.6108e+03_r8,5.7081e+03_r8,3.8055e+03_r8,1.9028e+03_r8,5.7982e+01_r8/) + kbo(:, 5,56,14) = (/ & + &1.2207e+04_r8,9.1554e+03_r8,6.1037e+03_r8,3.0520e+03_r8,5.4269e+01_r8/) + kbo(:, 1,57,14) = (/ & + &7.9773e+02_r8,5.9861e+02_r8,4.0826e+02_r8,2.3574e+02_r8,6.9656e+01_r8/) + kbo(:, 2,57,14) = (/ & + &1.8005e+03_r8,1.3505e+03_r8,9.0146e+02_r8,4.6638e+02_r8,6.6420e+01_r8/) + kbo(:, 3,57,14) = (/ & + &3.5629e+03_r8,2.6722e+03_r8,1.7816e+03_r8,8.9534e+02_r8,6.2948e+01_r8/) + kbo(:, 4,57,14) = (/ & + &6.3553e+03_r8,4.7665e+03_r8,3.1777e+03_r8,1.5890e+03_r8,5.9228e+01_r8/) + kbo(:, 5,57,14) = (/ & + &1.0437e+04_r8,7.8281e+03_r8,5.2188e+03_r8,2.6095e+03_r8,5.5502e+01_r8/) + kbo(:, 1,58,14) = (/ & + &1.5691e+02_r8,1.4430e+02_r8,1.2945e+02_r8,1.1296e+02_r8,7.0583e+01_r8/) + kbo(:, 2,58,14) = (/ & + &3.7146e+02_r8,3.4061e+02_r8,2.9343e+02_r8,2.1801e+02_r8,6.7460e+01_r8/) + kbo(:, 3,58,14) = (/ & + &7.6282e+02_r8,6.9942e+02_r8,5.9974e+02_r8,4.2478e+02_r8,6.4030e+01_r8/) + kbo(:, 4,58,14) = (/ & + &1.4014e+03_r8,1.2849e+03_r8,1.1017e+03_r8,7.7206e+02_r8,6.0507e+01_r8/) + kbo(:, 5,58,14) = (/ & + &2.3564e+03_r8,2.1605e+03_r8,1.8525e+03_r8,1.2975e+03_r8,5.6760e+01_r8/) + kbo(:, 1,59,14) = (/ & + &1.6269e+02_r8,1.4372e+02_r8,1.2601e+02_r8,1.1040e+02_r8,7.0952e+01_r8/) + kbo(:, 2,59,14) = (/ & + &3.9338e+02_r8,3.4354e+02_r8,2.7833e+02_r8,1.9401e+02_r8,6.7878e+01_r8/) + kbo(:, 3,59,14) = (/ & + &8.2073e+02_r8,7.1668e+02_r8,5.7208e+02_r8,3.6616e+02_r8,6.4473e+01_r8/) + kbo(:, 4,59,14) = (/ & + &1.5267e+03_r8,1.3331e+03_r8,1.0634e+03_r8,6.6456e+02_r8,6.0953e+01_r8/) + kbo(:, 5,59,14) = (/ & + &2.5924e+03_r8,2.2637e+03_r8,1.8057e+03_r8,1.1237e+03_r8,5.7434e+01_r8/) + kbo(:, 1,13,15) = (/ & + &6.7676e+03_r8,5.0758e+03_r8,3.3840e+03_r8,1.6922e+03_r8,9.0910e+00_r8/) + kbo(:, 2,13,15) = (/ & + &9.5300e+03_r8,7.1475e+03_r8,4.7651e+03_r8,2.3827e+03_r8,8.9593e+00_r8/) + kbo(:, 3,13,15) = (/ & + &1.2768e+04_r8,9.5761e+03_r8,6.3842e+03_r8,3.1923e+03_r8,8.8860e+00_r8/) + kbo(:, 4,13,15) = (/ & + &1.6413e+04_r8,1.2310e+04_r8,8.2067e+03_r8,4.1035e+03_r8,8.8094e+00_r8/) + kbo(:, 5,13,15) = (/ & + &2.0377e+04_r8,1.5283e+04_r8,1.0189e+04_r8,5.0946e+03_r8,8.7010e+00_r8/) + kbo(:, 1,14,15) = (/ & + &4.6855e+03_r8,3.5142e+03_r8,2.3429e+03_r8,1.1716e+03_r8,1.0351e+01_r8/) + kbo(:, 2,14,15) = (/ & + &6.5777e+03_r8,4.9333e+03_r8,3.2890e+03_r8,1.6447e+03_r8,1.0245e+01_r8/) + kbo(:, 3,14,15) = (/ & + &8.7780e+03_r8,6.5835e+03_r8,4.3891e+03_r8,2.1947e+03_r8,1.0189e+01_r8/) + kbo(:, 4,14,15) = (/ & + &1.1257e+04_r8,8.4428e+03_r8,5.6286e+03_r8,2.8145e+03_r8,1.0105e+01_r8/) + kbo(:, 5,14,15) = (/ & + &1.3964e+04_r8,1.0473e+04_r8,6.9821e+03_r8,3.4912e+03_r8,9.9926e+00_r8/) + kbo(:, 1,15,15) = (/ & + &3.2854e+03_r8,2.4642e+03_r8,1.6429e+03_r8,8.2169e+02_r8,1.1907e+01_r8/) + kbo(:, 2,15,15) = (/ & + &4.5889e+03_r8,3.4418e+03_r8,2.2947e+03_r8,1.1475e+03_r8,1.1847e+01_r8/) + kbo(:, 3,15,15) = (/ & + &6.1056e+03_r8,4.5793e+03_r8,3.0530e+03_r8,1.5267e+03_r8,1.1796e+01_r8/) + kbo(:, 4,15,15) = (/ & + &7.8011e+03_r8,5.8510e+03_r8,3.9008e+03_r8,1.9506e+03_r8,1.1682e+01_r8/) + kbo(:, 5,15,15) = (/ & + &9.6352e+03_r8,7.2265e+03_r8,4.8178e+03_r8,2.4091e+03_r8,1.1548e+01_r8/) + kbo(:, 1,16,15) = (/ & + &2.7156e+03_r8,2.0368e+03_r8,1.3580e+03_r8,6.7918e+02_r8,1.3833e+01_r8/) + kbo(:, 2,16,15) = (/ & + &3.7730e+03_r8,2.8298e+03_r8,1.8867e+03_r8,9.4350e+02_r8,1.3786e+01_r8/) + kbo(:, 3,16,15) = (/ & + &4.9942e+03_r8,3.7457e+03_r8,2.4973e+03_r8,1.2488e+03_r8,1.3682e+01_r8/) + kbo(:, 4,16,15) = (/ & + &6.3607e+03_r8,4.7706e+03_r8,3.1805e+03_r8,1.5904e+03_r8,1.3533e+01_r8/) + kbo(:, 5,16,15) = (/ & + &7.8514e+03_r8,5.8886e+03_r8,3.9259e+03_r8,1.9631e+03_r8,1.3377e+01_r8/) + kbo(:, 1,17,15) = (/ & + &2.3075e+03_r8,1.7307e+03_r8,1.1539e+03_r8,5.7711e+02_r8,1.6126e+01_r8/) + kbo(:, 2,17,15) = (/ & + &3.1956e+03_r8,2.3967e+03_r8,1.5979e+03_r8,7.9911e+02_r8,1.6029e+01_r8/) + kbo(:, 3,17,15) = (/ & + &4.2241e+03_r8,3.1681e+03_r8,2.1122e+03_r8,1.0562e+03_r8,1.5863e+01_r8/) + kbo(:, 4,17,15) = (/ & + &5.3821e+03_r8,4.0366e+03_r8,2.6912e+03_r8,1.3457e+03_r8,1.5685e+01_r8/) + kbo(:, 5,17,15) = (/ & + &6.6465e+03_r8,4.9850e+03_r8,3.3234e+03_r8,1.6618e+03_r8,1.5496e+01_r8/) + kbo(:, 1,18,15) = (/ & + &2.0119e+03_r8,1.5090e+03_r8,1.0061e+03_r8,5.0318e+02_r8,1.8668e+01_r8/) + kbo(:, 2,18,15) = (/ & + &2.7815e+03_r8,2.0862e+03_r8,1.3909e+03_r8,6.9557e+02_r8,1.8505e+01_r8/) + kbo(:, 3,18,15) = (/ & + &3.6794e+03_r8,2.7596e+03_r8,1.8398e+03_r8,9.2005e+02_r8,1.8343e+01_r8/) + kbo(:, 4,18,15) = (/ & + &4.6884e+03_r8,3.5164e+03_r8,2.3443e+03_r8,1.1723e+03_r8,1.8140e+01_r8/) + kbo(:, 5,18,15) = (/ & + &5.7908e+03_r8,4.3432e+03_r8,2.8955e+03_r8,1.4479e+03_r8,1.7901e+01_r8/) + kbo(:, 1,19,15) = (/ & + &1.7281e+03_r8,1.2962e+03_r8,8.6418e+02_r8,4.3222e+02_r8,2.1496e+01_r8/) + kbo(:, 2,19,15) = (/ & + &2.3903e+03_r8,1.7928e+03_r8,1.1953e+03_r8,5.9777e+02_r8,2.1311e+01_r8/) + kbo(:, 3,19,15) = (/ & + &3.1615e+03_r8,2.3712e+03_r8,1.5809e+03_r8,7.9055e+02_r8,2.1106e+01_r8/) + kbo(:, 4,19,15) = (/ & + &4.0222e+03_r8,3.0167e+03_r8,2.0112e+03_r8,1.0057e+03_r8,2.0849e+01_r8/) + kbo(:, 5,19,15) = (/ & + &4.9621e+03_r8,3.7216e+03_r8,2.4811e+03_r8,1.2407e+03_r8,2.0531e+01_r8/) + kbo(:, 1,20,15) = (/ & + &1.6235e+03_r8,1.2177e+03_r8,8.1188e+02_r8,4.0606e+02_r8,2.4735e+01_r8/) + kbo(:, 2,20,15) = (/ & + &2.2387e+03_r8,1.6791e+03_r8,1.1195e+03_r8,5.5984e+02_r8,2.4475e+01_r8/) + kbo(:, 3,20,15) = (/ & + &2.9488e+03_r8,2.2116e+03_r8,1.4745e+03_r8,7.3737e+02_r8,2.4178e+01_r8/) + kbo(:, 4,20,15) = (/ & + &3.7459e+03_r8,2.8095e+03_r8,1.8731e+03_r8,9.3665e+02_r8,2.3818e+01_r8/) + kbo(:, 5,20,15) = (/ & + &4.6161e+03_r8,3.4621e+03_r8,2.3081e+03_r8,1.1542e+03_r8,2.3401e+01_r8/) + kbo(:, 1,21,15) = (/ & + &1.5705e+03_r8,1.1779e+03_r8,7.8536e+02_r8,3.9279e+02_r8,2.8368e+01_r8/) + kbo(:, 2,21,15) = (/ & + &2.1555e+03_r8,1.6166e+03_r8,1.0778e+03_r8,5.3903e+02_r8,2.7972e+01_r8/) + kbo(:, 3,21,15) = (/ & + &2.8340e+03_r8,2.1256e+03_r8,1.4171e+03_r8,7.0866e+02_r8,2.7543e+01_r8/) + kbo(:, 4,21,15) = (/ & + &3.5949e+03_r8,2.6962e+03_r8,1.7975e+03_r8,8.9888e+02_r8,2.7047e+01_r8/) + kbo(:, 5,21,15) = (/ & + &4.4249e+03_r8,3.3187e+03_r8,2.2126e+03_r8,1.1064e+03_r8,2.6508e+01_r8/) + kbo(:, 1,22,15) = (/ & + &1.5869e+03_r8,1.1902e+03_r8,7.9356e+02_r8,3.9688e+02_r8,3.2318e+01_r8/) + kbo(:, 2,22,15) = (/ & + &2.1673e+03_r8,1.6255e+03_r8,1.0838e+03_r8,5.4198e+02_r8,3.1767e+01_r8/) + kbo(:, 3,22,15) = (/ & + &2.8378e+03_r8,2.1284e+03_r8,1.4190e+03_r8,7.0961e+02_r8,3.1126e+01_r8/) + kbo(:, 4,22,15) = (/ & + &3.5877e+03_r8,2.6908e+03_r8,1.7940e+03_r8,8.9709e+02_r8,3.0424e+01_r8/) + kbo(:, 5,22,15) = (/ & + &4.4005e+03_r8,3.3004e+03_r8,2.2004e+03_r8,1.1003e+03_r8,2.9694e+01_r8/) + kbo(:, 1,23,15) = (/ & + &1.6232e+03_r8,1.2174e+03_r8,8.1169e+02_r8,4.0594e+02_r8,3.6426e+01_r8/) + kbo(:, 2,23,15) = (/ & + &2.2045e+03_r8,1.6534e+03_r8,1.1023e+03_r8,5.5127e+02_r8,3.5632e+01_r8/) + kbo(:, 3,23,15) = (/ & + &2.8697e+03_r8,2.1523e+03_r8,1.4350e+03_r8,7.1760e+02_r8,3.4766e+01_r8/) + kbo(:, 4,23,15) = (/ & + &3.6072e+03_r8,2.7054e+03_r8,1.8037e+03_r8,9.0197e+02_r8,3.3867e+01_r8/) + kbo(:, 5,23,15) = (/ & + &4.4070e+03_r8,3.3053e+03_r8,2.2036e+03_r8,1.1019e+03_r8,3.2942e+01_r8/) + kbo(:, 1,24,15) = (/ & + &1.6638e+03_r8,1.2479e+03_r8,8.3204e+02_r8,4.1615e+02_r8,4.0555e+01_r8/) + kbo(:, 2,24,15) = (/ & + &2.2399e+03_r8,1.6800e+03_r8,1.1201e+03_r8,5.6017e+02_r8,3.9512e+01_r8/) + kbo(:, 3,24,15) = (/ & + &2.8950e+03_r8,2.1713e+03_r8,1.4476e+03_r8,7.2392e+02_r8,3.8430e+01_r8/) + kbo(:, 4,24,15) = (/ & + &3.6214e+03_r8,2.7161e+03_r8,1.8108e+03_r8,9.0552e+02_r8,3.7312e+01_r8/) + kbo(:, 5,24,15) = (/ & + &4.4048e+03_r8,3.3036e+03_r8,2.2025e+03_r8,1.1014e+03_r8,3.6172e+01_r8/) + kbo(:, 1,25,15) = (/ & + &1.7332e+03_r8,1.2999e+03_r8,8.6673e+02_r8,4.3352e+02_r8,4.4719e+01_r8/) + kbo(:, 2,25,15) = (/ & + &2.3131e+03_r8,1.7349e+03_r8,1.1567e+03_r8,5.7851e+02_r8,4.3381e+01_r8/) + kbo(:, 3,25,15) = (/ & + &2.9711e+03_r8,2.2284e+03_r8,1.4857e+03_r8,7.4302e+02_r8,4.2032e+01_r8/) + kbo(:, 4,25,15) = (/ & + &3.6954e+03_r8,2.7716e+03_r8,1.8478e+03_r8,9.2407e+02_r8,4.0668e+01_r8/) + kbo(:, 5,25,15) = (/ & + &4.4711e+03_r8,3.3534e+03_r8,2.2357e+03_r8,1.1180e+03_r8,3.9312e+01_r8/) + kbo(:, 1,26,15) = (/ & + &1.8457e+03_r8,1.3843e+03_r8,9.2300e+02_r8,4.6166e+02_r8,4.8798e+01_r8/) + kbo(:, 2,26,15) = (/ & + &2.4421e+03_r8,1.8317e+03_r8,1.2212e+03_r8,6.1078e+02_r8,4.7150e+01_r8/) + kbo(:, 3,26,15) = (/ & + &3.1127e+03_r8,2.3346e+03_r8,1.5565e+03_r8,7.7843e+02_r8,4.5507e+01_r8/) + kbo(:, 4,26,15) = (/ & + &3.8432e+03_r8,2.8825e+03_r8,1.9217e+03_r8,9.6104e+02_r8,4.3884e+01_r8/) + kbo(:, 5,26,15) = (/ & + &4.6197e+03_r8,3.4648e+03_r8,2.3100e+03_r8,1.1552e+03_r8,4.2296e+01_r8/) + kbo(:, 1,27,15) = (/ & + &2.0401e+03_r8,1.5302e+03_r8,1.0202e+03_r8,5.1030e+02_r8,5.2748e+01_r8/) + kbo(:, 2,27,15) = (/ & + &2.6727e+03_r8,2.0046e+03_r8,1.3365e+03_r8,6.6845e+02_r8,5.0763e+01_r8/) + kbo(:, 3,27,15) = (/ & + &3.3765e+03_r8,2.5325e+03_r8,1.6885e+03_r8,8.4441e+02_r8,4.8815e+01_r8/) + kbo(:, 4,27,15) = (/ & + &4.1373e+03_r8,3.1031e+03_r8,2.0688e+03_r8,1.0346e+03_r8,4.6912e+01_r8/) + kbo(:, 5,27,15) = (/ & + &4.9426e+03_r8,3.7071e+03_r8,2.4715e+03_r8,1.2359e+03_r8,4.5084e+01_r8/) + kbo(:, 1,28,15) = (/ & + &2.3062e+03_r8,1.7297e+03_r8,1.1533e+03_r8,5.7684e+02_r8,5.6494e+01_r8/) + kbo(:, 2,28,15) = (/ & + &2.9911e+03_r8,2.2434e+03_r8,1.4957e+03_r8,7.4806e+02_r8,5.4164e+01_r8/) + kbo(:, 3,28,15) = (/ & + &3.7467e+03_r8,2.8101e+03_r8,1.8736e+03_r8,9.3698e+02_r8,5.1914e+01_r8/) + kbo(:, 4,28,15) = (/ & + &4.5581e+03_r8,3.4187e+03_r8,2.2792e+03_r8,1.1398e+03_r8,4.9734e+01_r8/) + kbo(:, 5,28,15) = (/ & + &5.4121e+03_r8,4.0592e+03_r8,2.7063e+03_r8,1.3533e+03_r8,4.7639e+01_r8/) + kbo(:, 1,29,15) = (/ & + &2.7587e+03_r8,2.0691e+03_r8,1.3796e+03_r8,6.8998e+02_r8,5.9883e+01_r8/) + kbo(:, 2,29,15) = (/ & + &3.5427e+03_r8,2.6571e+03_r8,1.7716e+03_r8,8.8598e+02_r8,5.7214e+01_r8/) + kbo(:, 3,29,15) = (/ & + &4.3997e+03_r8,3.2998e+03_r8,2.2000e+03_r8,1.1002e+03_r8,5.4658e+01_r8/) + kbo(:, 4,29,15) = (/ & + &5.3158e+03_r8,3.9869e+03_r8,2.6581e+03_r8,1.3292e+03_r8,5.2215e+01_r8/) + kbo(:, 5,29,15) = (/ & + &6.2710e+03_r8,4.7033e+03_r8,3.1357e+03_r8,1.5680e+03_r8,4.9872e+01_r8/) + kbo(:, 1,30,15) = (/ & + &3.3645e+03_r8,2.5235e+03_r8,1.6825e+03_r8,8.4145e+02_r8,6.2847e+01_r8/) + kbo(:, 2,30,15) = (/ & + &4.2782e+03_r8,3.2088e+03_r8,2.1393e+03_r8,1.0699e+03_r8,5.9850e+01_r8/) + kbo(:, 3,30,15) = (/ & + &5.2706e+03_r8,3.9531e+03_r8,2.6355e+03_r8,1.3180e+03_r8,5.7012e+01_r8/) + kbo(:, 4,30,15) = (/ & + &6.3236e+03_r8,4.7428e+03_r8,3.1620e+03_r8,1.5812e+03_r8,5.4322e+01_r8/) + kbo(:, 5,30,15) = (/ & + &7.4122e+03_r8,5.5592e+03_r8,3.7063e+03_r8,1.8534e+03_r8,5.1754e+01_r8/) + kbo(:, 1,31,15) = (/ & + &4.2971e+03_r8,3.2230e+03_r8,2.1488e+03_r8,1.0746e+03_r8,6.5331e+01_r8/) + kbo(:, 2,31,15) = (/ & + &5.4121e+03_r8,4.0592e+03_r8,2.7063e+03_r8,1.3534e+03_r8,6.2034e+01_r8/) + kbo(:, 3,31,15) = (/ & + &6.6141e+03_r8,4.9607e+03_r8,3.3073e+03_r8,1.6539e+03_r8,5.8947e+01_r8/) + kbo(:, 4,31,15) = (/ & + &7.8758e+03_r8,5.9069e+03_r8,3.9381e+03_r8,1.9693e+03_r8,5.6027e+01_r8/) + kbo(:, 5,31,15) = (/ & + &9.1717e+03_r8,6.8788e+03_r8,4.5860e+03_r8,2.2932e+03_r8,5.3266e+01_r8/) + kbo(:, 1,32,15) = (/ & + &5.5229e+03_r8,4.1423e+03_r8,2.7617e+03_r8,1.3811e+03_r8,6.7311e+01_r8/) + kbo(:, 2,32,15) = (/ & + &6.8909e+03_r8,5.1683e+03_r8,3.4457e+03_r8,1.7231e+03_r8,6.3759e+01_r8/) + kbo(:, 3,32,15) = (/ & + &8.3530e+03_r8,6.2649e+03_r8,4.1768e+03_r8,2.0886e+03_r8,6.0452e+01_r8/) + kbo(:, 4,32,15) = (/ & + &9.8746e+03_r8,7.4061e+03_r8,4.9375e+03_r8,2.4690e+03_r8,5.7340e+01_r8/) + kbo(:, 5,32,15) = (/ & + &1.1429e+04_r8,8.5717e+03_r8,5.7146e+03_r8,2.8575e+03_r8,5.4420e+01_r8/) + kbo(:, 1,33,15) = (/ & + &7.1868e+03_r8,5.3902e+03_r8,3.5936e+03_r8,1.7971e+03_r8,6.8810e+01_r8/) + kbo(:, 2,33,15) = (/ & + &8.8853e+03_r8,6.6641e+03_r8,4.4429e+03_r8,2.2217e+03_r8,6.5053e+01_r8/) + kbo(:, 3,33,15) = (/ & + &1.0684e+04_r8,8.0128e+03_r8,5.3420e+03_r8,2.6713e+03_r8,6.1559e+01_r8/) + kbo(:, 4,33,15) = (/ & + &1.2545e+04_r8,9.4087e+03_r8,6.2726e+03_r8,3.1365e+03_r8,5.8295e+01_r8/) + kbo(:, 5,33,15) = (/ & + &1.4437e+04_r8,1.0828e+04_r8,7.2187e+03_r8,3.6096e+03_r8,5.5243e+01_r8/) + kbo(:, 1,34,15) = (/ & + &8.9946e+03_r8,6.7461e+03_r8,4.4975e+03_r8,2.2490e+03_r8,7.0022e+01_r8/) + kbo(:, 2,34,15) = (/ & + &1.1036e+04_r8,8.2772e+03_r8,5.5183e+03_r8,2.7594e+03_r8,6.6087e+01_r8/) + kbo(:, 3,34,15) = (/ & + &1.3184e+04_r8,9.8877e+03_r8,6.5920e+03_r8,3.2962e+03_r8,6.2443e+01_r8/) + kbo(:, 4,34,15) = (/ & + &1.5394e+04_r8,1.1546e+04_r8,7.6972e+03_r8,3.8488e+03_r8,5.9052e+01_r8/) + kbo(:, 5,34,15) = (/ & + &1.7632e+04_r8,1.3224e+04_r8,8.8161e+03_r8,4.4083e+03_r8,5.5884e+01_r8/) + kbo(:, 1,35,15) = (/ & + &1.0993e+04_r8,8.2446e+03_r8,5.4966e+03_r8,2.7485e+03_r8,7.1272e+01_r8/) + kbo(:, 2,35,15) = (/ & + &1.3428e+04_r8,1.0071e+04_r8,6.7141e+03_r8,3.3573e+03_r8,6.7165e+01_r8/) + kbo(:, 3,35,15) = (/ & + &1.5977e+04_r8,1.1983e+04_r8,7.9889e+03_r8,3.9949e+03_r8,6.3376e+01_r8/) + kbo(:, 4,35,15) = (/ & + &1.8595e+04_r8,1.3946e+04_r8,9.2975e+03_r8,4.6490e+03_r8,5.9869e+01_r8/) + kbo(:, 5,35,15) = (/ & + &2.1231e+04_r8,1.5923e+04_r8,1.0616e+04_r8,5.3081e+03_r8,5.6025e+01_r8/) + kbo(:, 1,36,15) = (/ & + &1.3006e+04_r8,9.7547e+03_r8,6.5033e+03_r8,3.2519e+03_r8,7.2705e+01_r8/) + kbo(:, 2,36,15) = (/ & + &1.5874e+04_r8,1.1905e+04_r8,7.9370e+03_r8,3.9687e+03_r8,6.8413e+01_r8/) + kbo(:, 3,36,15) = (/ & + &1.8861e+04_r8,1.4146e+04_r8,9.4305e+03_r8,4.7155e+03_r8,6.4479e+01_r8/) + kbo(:, 4,36,15) = (/ & + &2.1927e+04_r8,1.6445e+04_r8,1.0964e+04_r8,5.4821e+03_r8,6.0843e+01_r8/) + kbo(:, 5,36,15) = (/ & + &2.5014e+04_r8,1.8760e+04_r8,1.2507e+04_r8,6.2537e+03_r8,5.6544e+01_r8/) + kbo(:, 1,37,15) = (/ & + &1.4489e+04_r8,1.0867e+04_r8,7.2447e+03_r8,3.6226e+03_r8,7.4617e+01_r8/) + kbo(:, 2,37,15) = (/ & + &1.7744e+04_r8,1.3308e+04_r8,8.8720e+03_r8,4.4362e+03_r8,7.0104e+01_r8/) + kbo(:, 3,37,15) = (/ & + &2.1142e+04_r8,1.5857e+04_r8,1.0571e+04_r8,5.2858e+03_r8,6.5985e+01_r8/) + kbo(:, 4,37,15) = (/ & + &2.4633e+04_r8,1.8475e+04_r8,1.2317e+04_r8,6.1586e+03_r8,6.1723e+01_r8/) + kbo(:, 5,37,15) = (/ & + &2.8152e+04_r8,2.1114e+04_r8,1.4076e+04_r8,7.0383e+03_r8,5.7616e+01_r8/) + kbo(:, 1,38,15) = (/ & + &1.6314e+04_r8,1.2236e+04_r8,8.1572e+03_r8,4.0788e+03_r8,7.6413e+01_r8/) + kbo(:, 2,38,15) = (/ & + &2.0055e+04_r8,1.5041e+04_r8,1.0028e+04_r8,5.0140e+03_r8,7.1696e+01_r8/) + kbo(:, 3,38,15) = (/ & + &2.3973e+04_r8,1.7980e+04_r8,1.1987e+04_r8,5.9936e+03_r8,6.7406e+01_r8/) + kbo(:, 4,38,15) = (/ & + &2.8001e+04_r8,2.1001e+04_r8,1.4001e+04_r8,7.0006e+03_r8,6.2768e+01_r8/) + kbo(:, 5,38,15) = (/ & + &3.2071e+04_r8,2.4053e+04_r8,1.6036e+04_r8,8.0180e+03_r8,5.8602e+01_r8/) + kbo(:, 1,39,15) = (/ & + &1.8759e+04_r8,1.4069e+04_r8,9.3797e+03_r8,4.6901e+03_r8,7.8086e+01_r8/) + kbo(:, 2,39,15) = (/ & + &2.3153e+04_r8,1.7365e+04_r8,1.1577e+04_r8,5.7886e+03_r8,7.3162e+01_r8/) + kbo(:, 3,39,15) = (/ & + &2.7770e+04_r8,2.0828e+04_r8,1.3886e+04_r8,6.9431e+03_r8,6.8719e+01_r8/) + kbo(:, 4,39,15) = (/ & + &3.2517e+04_r8,2.4388e+04_r8,1.6259e+04_r8,8.1299e+03_r8,6.3661e+01_r8/) + kbo(:, 5,39,15) = (/ & + &3.7323e+04_r8,2.7992e+04_r8,1.8662e+04_r8,9.3312e+03_r8,5.9468e+01_r8/) + kbo(:, 1,40,15) = (/ & + &1.9750e+04_r8,1.4812e+04_r8,9.8751e+03_r8,4.9378e+03_r8,8.0192e+01_r8/) + kbo(:, 2,40,15) = (/ & + &2.4562e+04_r8,1.8422e+04_r8,1.2281e+04_r8,6.1409e+03_r8,7.5032e+01_r8/) + kbo(:, 3,40,15) = (/ & + &2.9646e+04_r8,2.2235e+04_r8,1.4823e+04_r8,7.4118e+03_r8,7.0393e+01_r8/) + kbo(:, 4,40,15) = (/ & + &3.4890e+04_r8,2.6167e+04_r8,1.7445e+04_r8,8.7227e+03_r8,6.5151e+01_r8/) + kbo(:, 5,40,15) = (/ & + &4.0218e+04_r8,3.0164e+04_r8,2.0109e+04_r8,1.0055e+04_r8,6.0809e+01_r8/) + kbo(:, 1,41,15) = (/ & + &2.0620e+04_r8,1.5465e+04_r8,1.0310e+04_r8,5.1555e+03_r8,8.2333e+01_r8/) + kbo(:, 2,41,15) = (/ & + &2.5862e+04_r8,1.9396e+04_r8,1.2931e+04_r8,6.4659e+03_r8,7.6930e+01_r8/) + kbo(:, 3,41,15) = (/ & + &3.1429e+04_r8,2.3571e+04_r8,1.5714e+04_r8,7.8575e+03_r8,7.2080e+01_r8/) + kbo(:, 4,41,15) = (/ & + &3.7207e+04_r8,2.7905e+04_r8,1.8604e+04_r8,9.3022e+03_r8,6.6689e+01_r8/) + kbo(:, 5,41,15) = (/ & + &4.3090e+04_r8,3.2318e+04_r8,2.1545e+04_r8,1.0773e+04_r8,6.2194e+01_r8/) + kbo(:, 1,42,15) = (/ & + &2.1691e+04_r8,1.6268e+04_r8,1.0846e+04_r8,5.4231e+03_r8,8.4448e+01_r8/) + kbo(:, 2,42,15) = (/ & + &2.7444e+04_r8,2.0583e+04_r8,1.3722e+04_r8,6.8623e+03_r8,7.8791e+01_r8/) + kbo(:, 3,42,15) = (/ & + &3.3603e+04_r8,2.5202e+04_r8,1.6802e+04_r8,8.4010e+03_r8,7.3737e+01_r8/) + kbo(:, 4,42,15) = (/ & + &4.0024e+04_r8,3.0018e+04_r8,2.0012e+04_r8,1.0006e+04_r8,6.8167e+01_r8/) + kbo(:, 5,42,15) = (/ & + &4.6588e+04_r8,3.4941e+04_r8,2.3294e+04_r8,1.1647e+04_r8,6.3488e+01_r8/) + kbo(:, 1,43,15) = (/ & + &2.2603e+04_r8,1.6952e+04_r8,1.1302e+04_r8,5.6511e+03_r8,8.6896e+01_r8/) + kbo(:, 2,43,15) = (/ & + &2.8935e+04_r8,2.1702e+04_r8,1.4468e+04_r8,7.2343e+03_r8,8.0969e+01_r8/) + kbo(:, 3,43,15) = (/ & + &3.5766e+04_r8,2.6825e+04_r8,1.7883e+04_r8,8.9419e+03_r8,7.5666e+01_r8/) + kbo(:, 4,43,15) = (/ & + &4.2940e+04_r8,3.2205e+04_r8,2.1471e+04_r8,1.0736e+04_r8,6.9870e+01_r8/) + kbo(:, 5,43,15) = (/ & + &5.0307e+04_r8,3.7731e+04_r8,2.5154e+04_r8,1.2577e+04_r8,6.5095e+01_r8/) + kbo(:, 1,44,15) = (/ & + &2.3606e+04_r8,1.7705e+04_r8,1.1803e+04_r8,5.9018e+03_r8,8.9540e+01_r8/) + kbo(:, 2,44,15) = (/ & + &3.0627e+04_r8,2.2970e+04_r8,1.5314e+04_r8,7.6570e+03_r8,8.3300e+01_r8/) + kbo(:, 3,44,15) = (/ & + &3.8272e+04_r8,2.8704e+04_r8,1.9136e+04_r8,9.5682e+03_r8,7.7742e+01_r8/) + kbo(:, 4,44,15) = (/ & + &4.6369e+04_r8,3.4777e+04_r8,2.3185e+04_r8,1.1593e+04_r8,7.1787e+01_r8/) + kbo(:, 5,44,15) = (/ & + &5.4746e+04_r8,4.1060e+04_r8,2.7373e+04_r8,1.3687e+04_r8,6.6743e+01_r8/) + kbo(:, 1,45,15) = (/ & + &2.5020e+04_r8,1.8765e+04_r8,1.2510e+04_r8,6.2554e+03_r8,9.2249e+01_r8/) + kbo(:, 2,45,15) = (/ & + &3.2921e+04_r8,2.4691e+04_r8,1.6461e+04_r8,8.2305e+03_r8,8.5687e+01_r8/) + kbo(:, 3,45,15) = (/ & + &4.1630e+04_r8,3.1222e+04_r8,2.0815e+04_r8,1.0408e+04_r8,7.9854e+01_r8/) + kbo(:, 4,45,15) = (/ & + &5.0934e+04_r8,3.8200e+04_r8,2.5467e+04_r8,1.2734e+04_r8,7.3688e+01_r8/) + kbo(:, 5,45,15) = (/ & + &6.0623e+04_r8,4.5467e+04_r8,3.0312e+04_r8,1.5156e+04_r8,6.8450e+01_r8/) + kbo(:, 1,46,15) = (/ & + &2.6462e+04_r8,1.9847e+04_r8,1.3231e+04_r8,6.6159e+03_r8,9.5173e+01_r8/) + kbo(:, 2,46,15) = (/ & + &3.5388e+04_r8,2.6541e+04_r8,1.7694e+04_r8,8.8474e+03_r8,8.8256e+01_r8/) + kbo(:, 3,46,15) = (/ & + &4.5343e+04_r8,3.4008e+04_r8,2.2672e+04_r8,1.1336e+04_r8,8.2143e+01_r8/) + kbo(:, 4,46,15) = (/ & + &5.6094e+04_r8,4.2071e+04_r8,2.8047e+04_r8,1.4024e+04_r8,7.5728e+01_r8/) + kbo(:, 5,46,15) = (/ & + &6.7389e+04_r8,5.0542e+04_r8,3.3695e+04_r8,1.6848e+04_r8,7.0196e+01_r8/) + kbo(:, 1,47,15) = (/ & + &2.7156e+04_r8,2.0367e+04_r8,1.3578e+04_r8,6.7894e+03_r8,9.8564e+01_r8/) + kbo(:, 2,47,15) = (/ & + &3.7028e+04_r8,2.7771e+04_r8,1.8514e+04_r8,9.2574e+03_r8,9.1210e+01_r8/) + kbo(:, 3,47,15) = (/ & + &4.8225e+04_r8,3.6169e+04_r8,2.4113e+04_r8,1.2057e+04_r8,8.4753e+01_r8/) + kbo(:, 4,47,15) = (/ & + &6.0453e+04_r8,4.5340e+04_r8,3.0227e+04_r8,1.5114e+04_r8,7.8168e+01_r8/) + kbo(:, 5,47,15) = (/ & + &7.3441e+04_r8,5.5081e+04_r8,3.6721e+04_r8,1.8361e+04_r8,7.1964e+01_r8/) + kbo(:, 1,48,15) = (/ & + &2.8408e+04_r8,2.1306e+04_r8,1.4204e+04_r8,7.1024e+03_r8,1.0210e+02_r8/) + kbo(:, 2,48,15) = (/ & + &3.9561e+04_r8,2.9671e+04_r8,1.9781e+04_r8,9.8907e+03_r8,9.4282e+01_r8/) + kbo(:, 3,48,15) = (/ & + &5.2433e+04_r8,3.9325e+04_r8,2.6217e+04_r8,1.3109e+04_r8,8.7454e+01_r8/) + kbo(:, 4,48,15) = (/ & + &6.6685e+04_r8,5.0014e+04_r8,3.3343e+04_r8,1.6672e+04_r8,8.0648e+01_r8/) + kbo(:, 5,48,15) = (/ & + &8.1969e+04_r8,6.1477e+04_r8,4.0985e+04_r8,2.0493e+04_r8,7.3773e+01_r8/) + kbo(:, 1,49,15) = (/ & + &3.0665e+04_r8,2.2999e+04_r8,1.5333e+04_r8,7.6665e+03_r8,1.0579e+02_r8/) + kbo(:, 2,49,15) = (/ & + &4.3701e+04_r8,3.2776e+04_r8,2.1851e+04_r8,1.0926e+04_r8,9.7512e+01_r8/) + kbo(:, 3,49,15) = (/ & + &5.9013e+04_r8,4.4260e+04_r8,2.9506e+04_r8,1.4753e+04_r8,9.0273e+01_r8/) + kbo(:, 4,49,15) = (/ & + &7.6235e+04_r8,5.7177e+04_r8,3.8118e+04_r8,1.9059e+04_r8,8.3012e+01_r8/) + kbo(:, 5,49,15) = (/ & + &9.4928e+04_r8,7.1196e+04_r8,4.7464e+04_r8,2.3732e+04_r8,7.5643e+01_r8/) + kbo(:, 1,50,15) = (/ & + &3.1512e+04_r8,2.3634e+04_r8,1.5756e+04_r8,7.8783e+03_r8,1.0944e+02_r8/) + kbo(:, 2,50,15) = (/ & + &4.5989e+04_r8,3.4492e+04_r8,2.2995e+04_r8,1.1498e+04_r8,1.0069e+02_r8/) + kbo(:, 3,50,15) = (/ & + &6.3288e+04_r8,4.7466e+04_r8,3.1644e+04_r8,1.5822e+04_r8,9.3050e+01_r8/) + kbo(:, 4,50,15) = (/ & + &8.3061e+04_r8,6.2296e+04_r8,4.1531e+04_r8,2.0766e+04_r8,8.5379e+01_r8/) + kbo(:, 5,50,15) = (/ & + &1.0477e+05_r8,7.8579e+04_r8,5.2386e+04_r8,2.6193e+04_r8,7.7745e+01_r8/) + kbo(:, 1,51,15) = (/ & + &3.1512e+04_r8,2.3634e+04_r8,1.5756e+04_r8,7.8783e+03_r8,1.1317e+02_r8/) + kbo(:, 2,51,15) = (/ & + &4.7162e+04_r8,3.5373e+04_r8,2.3581e+04_r8,1.1791e+04_r8,1.0391e+02_r8/) + kbo(:, 3,51,15) = (/ & + &6.6209e+04_r8,4.9657e+04_r8,3.3105e+04_r8,1.6553e+04_r8,9.5852e+01_r8/) + kbo(:, 4,51,15) = (/ & + &8.8316e+04_r8,6.6238e+04_r8,4.4164e+04_r8,2.2080e+04_r8,8.8232e+01_r8/) + kbo(:, 5,51,15) = (/ & + &1.1292e+05_r8,8.4693e+04_r8,5.6462e+04_r8,2.8231e+04_r8,8.0003e+01_r8/) + kbo(:, 1,52,15) = (/ & + &3.2076e+04_r8,2.4057e+04_r8,1.6038e+04_r8,8.0198e+03_r8,1.1706e+02_r8/) + kbo(:, 2,52,15) = (/ & + &4.9342e+04_r8,3.7006e+04_r8,2.4671e+04_r8,1.2336e+04_r8,1.0727e+02_r8/) + kbo(:, 3,52,15) = (/ & + &7.0777e+04_r8,5.3083e+04_r8,3.5389e+04_r8,1.7695e+04_r8,9.8793e+01_r8/) + kbo(:, 4,52,15) = (/ & + &9.6072e+04_r8,7.2054e+04_r8,4.8037e+04_r8,2.4019e+04_r8,9.0662e+01_r8/) + kbo(:, 5,52,15) = (/ & + &1.2464e+05_r8,9.3484e+04_r8,6.2323e+04_r8,3.1162e+04_r8,8.2138e+01_r8/) + kbo(:, 1,53,15) = (/ & + &3.3608e+04_r8,2.5207e+04_r8,1.6805e+04_r8,8.4025e+03_r8,1.2114e+02_r8/) + kbo(:, 2,53,15) = (/ & + &5.3290e+04_r8,3.9968e+04_r8,2.6645e+04_r8,1.3323e+04_r8,1.1081e+02_r8/) + kbo(:, 3,53,15) = (/ & + &7.8269e+04_r8,5.8702e+04_r8,3.9135e+04_r8,1.9568e+04_r8,1.0185e+02_r8/) + kbo(:, 4,53,15) = (/ & + &1.0824e+05_r8,8.1183e+04_r8,5.4123e+04_r8,2.7062e+04_r8,9.3093e+01_r8/) + kbo(:, 5,53,15) = (/ & + &1.4266e+05_r8,1.0700e+05_r8,7.1333e+04_r8,3.5667e+04_r8,8.4356e+01_r8/) + kbo(:, 1,54,15) = (/ & + &3.0554e+04_r8,2.2916e+04_r8,1.5277e+04_r8,7.6389e+03_r8,1.2510e+02_r8/) + kbo(:, 2,54,15) = (/ & + &4.9936e+04_r8,3.7452e+04_r8,2.4968e+04_r8,1.2484e+04_r8,1.1423e+02_r8/) + kbo(:, 3,54,15) = (/ & + &7.5079e+04_r8,5.6309e+04_r8,3.7540e+04_r8,1.8770e+04_r8,1.0480e+02_r8/) + kbo(:, 4,54,15) = (/ & + &1.0578e+05_r8,7.9333e+04_r8,5.2889e+04_r8,2.6445e+04_r8,9.5981e+01_r8/) + kbo(:, 5,54,15) = (/ & + &1.4151e+05_r8,1.0613e+05_r8,7.0756e+04_r8,3.5378e+04_r8,8.6958e+01_r8/) + kbo(:, 1,55,15) = (/ & + &2.5242e+04_r8,1.8932e+04_r8,1.2621e+04_r8,6.3108e+03_r8,1.2910e+02_r8/) + kbo(:, 2,55,15) = (/ & + &4.2561e+04_r8,3.1921e+04_r8,2.1281e+04_r8,1.0641e+04_r8,1.1763e+02_r8/) + kbo(:, 3,55,15) = (/ & + &6.5579e+04_r8,4.9184e+04_r8,3.2790e+04_r8,1.6395e+04_r8,1.0775e+02_r8/) + kbo(:, 4,55,15) = (/ & + &9.4190e+04_r8,7.0643e+04_r8,4.7095e+04_r8,2.3548e+04_r8,9.9196e+01_r8/) + kbo(:, 5,55,15) = (/ & + &1.2798e+05_r8,9.5983e+04_r8,6.3989e+04_r8,3.1995e+04_r8,9.0570e+01_r8/) + kbo(:, 1,56,15) = (/ & + &2.0611e+04_r8,1.5459e+04_r8,1.0306e+04_r8,5.1530e+03_r8,1.3327e+02_r8/) + kbo(:, 2,56,15) = (/ & + &3.5961e+04_r8,2.6970e+04_r8,1.7980e+04_r8,8.9902e+03_r8,1.2118e+02_r8/) + kbo(:, 3,56,15) = (/ & + &5.6902e+04_r8,4.2676e+04_r8,2.8451e+04_r8,1.4227e+04_r8,1.1083e+02_r8/) + kbo(:, 4,56,15) = (/ & + &8.3426e+04_r8,6.2569e+04_r8,4.1713e+04_r8,2.0856e+04_r8,1.0187e+02_r8/) + kbo(:, 5,56,15) = (/ & + &1.1523e+05_r8,8.6424e+04_r8,5.7616e+04_r8,2.8808e+04_r8,9.3771e+01_r8/) + kbo(:, 1,57,15) = (/ & + &1.6610e+04_r8,1.2457e+04_r8,8.3049e+03_r8,4.1526e+03_r8,1.3769e+02_r8/) + kbo(:, 2,57,15) = (/ & + &3.0089e+04_r8,2.2567e+04_r8,1.5044e+04_r8,7.5226e+03_r8,1.2490e+02_r8/) + kbo(:, 3,57,15) = (/ & + &4.8979e+04_r8,3.6734e+04_r8,2.4489e+04_r8,1.2245e+04_r8,1.1405e+02_r8/) + kbo(:, 4,57,15) = (/ & + &7.3462e+04_r8,5.5096e+04_r8,3.6731e+04_r8,1.8365e+04_r8,1.0465e+02_r8/) + kbo(:, 5,57,15) = (/ & + &1.0326e+05_r8,7.7443e+04_r8,5.1628e+04_r8,2.5814e+04_r8,9.6480e+01_r8/) + kbo(:, 1,58,15) = (/ & + &3.5201e+03_r8,3.2274e+03_r8,2.7672e+03_r8,1.9382e+03_r8,1.4211e+02_r8/) + kbo(:, 2,58,15) = (/ & + &6.6315e+03_r8,6.0801e+03_r8,5.2132e+03_r8,3.6514e+03_r8,1.2863e+02_r8/) + kbo(:, 3,58,15) = (/ & + &1.1117e+04_r8,1.0193e+04_r8,8.7395e+03_r8,6.1212e+03_r8,1.1722e+02_r8/) + kbo(:, 4,58,15) = (/ & + &1.7057e+04_r8,1.5638e+04_r8,1.3409e+04_r8,9.3914e+03_r8,1.0740e+02_r8/) + kbo(:, 5,58,15) = (/ & + &2.4410e+04_r8,2.2380e+04_r8,1.9189e+04_r8,1.3440e+04_r8,9.8884e+01_r8/) + kbo(:, 1,59,15) = (/ & + &3.7699e+03_r8,3.2918e+03_r8,2.6257e+03_r8,1.6340e+03_r8,1.4398e+02_r8/) + kbo(:, 2,59,15) = (/ & + &7.2215e+03_r8,6.3055e+03_r8,5.0297e+03_r8,3.1299e+03_r8,1.3019e+02_r8/) + kbo(:, 3,59,15) = (/ & + &1.2258e+04_r8,1.0703e+04_r8,8.5377e+03_r8,5.3128e+03_r8,1.1856e+02_r8/) + kbo(:, 4,59,15) = (/ & + &1.8986e+04_r8,1.6578e+04_r8,1.3224e+04_r8,8.2288e+03_r8,1.0855e+02_r8/) + kbo(:, 5,59,15) = (/ & + &2.7379e+04_r8,2.3906e+04_r8,1.9069e+04_r8,1.1866e+04_r8,9.9884e+01_r8/) + kbo(:, 1,13,16) = (/ & + &1.4818e+04_r8,1.1113e+04_r8,7.4089e+03_r8,3.7045e+03_r8,1.1371e+01_r8/) + kbo(:, 2,13,16) = (/ & + &2.0739e+04_r8,1.5555e+04_r8,1.0370e+04_r8,5.1851e+03_r8,1.0985e+01_r8/) + kbo(:, 3,13,16) = (/ & + &2.7562e+04_r8,2.0672e+04_r8,1.3781e+04_r8,6.8906e+03_r8,1.0720e+01_r8/) + kbo(:, 4,13,16) = (/ & + &3.5104e+04_r8,2.6328e+04_r8,1.7552e+04_r8,8.7760e+03_r8,1.0594e+01_r8/) + kbo(:, 5,13,16) = (/ & + &4.3187e+04_r8,3.2390e+04_r8,2.1594e+04_r8,1.0797e+04_r8,1.0676e+01_r8/) + kbo(:, 1,14,16) = (/ & + &1.1265e+04_r8,8.4488e+03_r8,5.6325e+03_r8,2.8163e+03_r8,1.3004e+01_r8/) + kbo(:, 2,14,16) = (/ & + &1.5638e+04_r8,1.1729e+04_r8,7.8191e+03_r8,3.9096e+03_r8,1.2745e+01_r8/) + kbo(:, 3,14,16) = (/ & + &2.0632e+04_r8,1.5474e+04_r8,1.0316e+04_r8,5.1580e+03_r8,1.2511e+01_r8/) + kbo(:, 4,14,16) = (/ & + &2.6158e+04_r8,1.9619e+04_r8,1.3079e+04_r8,6.5395e+03_r8,1.2514e+01_r8/) + kbo(:, 5,14,16) = (/ & + &3.2161e+04_r8,2.4120e+04_r8,1.6080e+04_r8,8.0400e+03_r8,1.2574e+01_r8/) + kbo(:, 1,15,16) = (/ & + &8.6626e+03_r8,6.4970e+03_r8,4.3314e+03_r8,2.1657e+03_r8,1.5047e+01_r8/) + kbo(:, 2,15,16) = (/ & + &1.1944e+04_r8,8.8995e+03_r8,5.9720e+03_r8,2.9860e+03_r8,1.4804e+01_r8/) + kbo(:, 3,15,16) = (/ & + &1.5730e+04_r8,1.1798e+04_r8,7.8651e+03_r8,3.9326e+03_r8,1.4621e+01_r8/) + kbo(:, 4,15,16) = (/ & + &1.9953e+04_r8,1.4965e+04_r8,9.9768e+03_r8,4.9885e+03_r8,1.4704e+01_r8/) + kbo(:, 5,15,16) = (/ & + &2.4510e+04_r8,1.8382e+04_r8,1.2255e+04_r8,6.1276e+03_r8,1.4738e+01_r8/) + kbo(:, 1,16,16) = (/ & + &7.9177e+03_r8,5.9383e+03_r8,3.9589e+03_r8,1.9795e+03_r8,1.7379e+01_r8/) + kbo(:, 2,16,16) = (/ & + &1.0905e+04_r8,8.1790e+03_r8,5.4527e+03_r8,2.7264e+03_r8,1.7087e+01_r8/) + kbo(:, 3,16,16) = (/ & + &1.4336e+04_r8,1.0752e+04_r8,7.1680e+03_r8,3.5840e+03_r8,1.7079e+01_r8/) + kbo(:, 4,16,16) = (/ & + &1.8134e+04_r8,1.3600e+04_r8,9.0670e+03_r8,4.5335e+03_r8,1.7162e+01_r8/) + kbo(:, 5,16,16) = (/ & + &2.2206e+04_r8,1.6655e+04_r8,1.1103e+04_r8,5.5517e+03_r8,1.7193e+01_r8/) + kbo(:, 1,17,16) = (/ & + &7.5178e+03_r8,5.6384e+03_r8,3.7589e+03_r8,1.8795e+03_r8,1.9948e+01_r8/) + kbo(:, 2,17,16) = (/ & + &1.0311e+04_r8,7.7335e+03_r8,5.1557e+03_r8,2.5779e+03_r8,1.9796e+01_r8/) + kbo(:, 3,17,16) = (/ & + &1.3498e+04_r8,1.0124e+04_r8,6.7488e+03_r8,3.3746e+03_r8,1.9858e+01_r8/) + kbo(:, 4,17,16) = (/ & + &1.6996e+04_r8,1.2747e+04_r8,8.4978e+03_r8,4.2489e+03_r8,1.9944e+01_r8/) + kbo(:, 5,17,16) = (/ & + &2.0726e+04_r8,1.5544e+04_r8,1.0363e+04_r8,5.1815e+03_r8,1.9956e+01_r8/) + kbo(:, 1,18,16) = (/ & + &7.2889e+03_r8,5.4667e+03_r8,3.6445e+03_r8,1.8223e+03_r8,2.3259e+01_r8/) + kbo(:, 2,18,16) = (/ & + &9.9353e+03_r8,7.4515e+03_r8,4.9677e+03_r8,2.4839e+03_r8,2.3214e+01_r8/) + kbo(:, 3,18,16) = (/ & + &1.2928e+04_r8,9.6956e+03_r8,6.4638e+03_r8,3.2319e+03_r8,2.3116e+01_r8/) + kbo(:, 4,18,16) = (/ & + &1.6189e+04_r8,1.2142e+04_r8,8.0944e+03_r8,4.0472e+03_r8,2.3106e+01_r8/) + kbo(:, 5,18,16) = (/ & + &1.9640e+04_r8,1.4730e+04_r8,9.8201e+03_r8,4.9101e+03_r8,2.3045e+01_r8/) + kbo(:, 1,19,16) = (/ & + &6.8892e+03_r8,5.1669e+03_r8,3.4446e+03_r8,1.7223e+03_r8,2.7312e+01_r8/) + kbo(:, 2,19,16) = (/ & + &9.3210e+03_r8,6.9908e+03_r8,4.6605e+03_r8,2.3303e+03_r8,2.7199e+01_r8/) + kbo(:, 3,19,16) = (/ & + &1.2050e+04_r8,9.0375e+03_r8,6.0250e+03_r8,3.0125e+03_r8,2.6980e+01_r8/) + kbo(:, 4,19,16) = (/ & + &1.5046e+04_r8,1.1284e+04_r8,7.5228e+03_r8,3.7614e+03_r8,2.6786e+01_r8/) + kbo(:, 5,19,16) = (/ & + &1.8241e+04_r8,1.3681e+04_r8,9.1205e+03_r8,4.5603e+03_r8,2.6595e+01_r8/) + kbo(:, 1,20,16) = (/ & + &7.0094e+03_r8,5.2570e+03_r8,3.5047e+03_r8,1.7524e+03_r8,3.2009e+01_r8/) + kbo(:, 2,20,16) = (/ & + &9.4364e+03_r8,7.0773e+03_r8,4.7182e+03_r8,2.3591e+03_r8,3.1788e+01_r8/) + kbo(:, 3,20,16) = (/ & + &1.2173e+04_r8,9.1297e+03_r8,6.0865e+03_r8,3.0433e+03_r8,3.1450e+01_r8/) + kbo(:, 4,20,16) = (/ & + &1.5155e+04_r8,1.1367e+04_r8,7.5778e+03_r8,3.7889e+03_r8,3.1059e+01_r8/) + kbo(:, 5,20,16) = (/ & + &1.8307e+04_r8,1.3730e+04_r8,9.1534e+03_r8,4.5767e+03_r8,3.0674e+01_r8/) + kbo(:, 1,21,16) = (/ & + &7.3306e+03_r8,5.4980e+03_r8,3.6654e+03_r8,1.8327e+03_r8,3.7355e+01_r8/) + kbo(:, 2,21,16) = (/ & + &9.8238e+03_r8,7.3679e+03_r8,4.9119e+03_r8,2.4560e+03_r8,3.6998e+01_r8/) + kbo(:, 3,21,16) = (/ & + &1.2609e+04_r8,9.4571e+03_r8,6.3047e+03_r8,3.1524e+03_r8,3.6493e+01_r8/) + kbo(:, 4,21,16) = (/ & + &1.5617e+04_r8,1.1713e+04_r8,7.8084e+03_r8,3.9042e+03_r8,3.5962e+01_r8/) + kbo(:, 5,21,16) = (/ & + &1.8773e+04_r8,1.4079e+04_r8,9.3863e+03_r8,4.6932e+03_r8,3.5346e+01_r8/) + kbo(:, 1,22,16) = (/ & + &7.9668e+03_r8,5.9751e+03_r8,3.9834e+03_r8,1.9917e+03_r8,4.3325e+01_r8/) + kbo(:, 2,22,16) = (/ & + &1.0571e+04_r8,7.9286e+03_r8,5.2858e+03_r8,2.6429e+03_r8,4.2793e+01_r8/) + kbo(:, 3,22,16) = (/ & + &1.3449e+04_r8,1.0087e+04_r8,6.7244e+03_r8,3.3622e+03_r8,4.2221e+01_r8/) + kbo(:, 4,22,16) = (/ & + &1.6524e+04_r8,1.2393e+04_r8,8.2619e+03_r8,4.1310e+03_r8,4.1607e+01_r8/) + kbo(:, 5,22,16) = (/ & + &1.9754e+04_r8,1.4816e+04_r8,9.8771e+03_r8,4.9386e+03_r8,4.0888e+01_r8/) + kbo(:, 1,23,16) = (/ & + &8.6210e+03_r8,6.4658e+03_r8,4.3105e+03_r8,2.1553e+03_r8,5.0428e+01_r8/) + kbo(:, 2,23,16) = (/ & + &1.1316e+04_r8,8.4866e+03_r8,5.6578e+03_r8,2.8289e+03_r8,4.9764e+01_r8/) + kbo(:, 3,23,16) = (/ & + &1.4291e+04_r8,1.0718e+04_r8,7.1454e+03_r8,3.5727e+03_r8,4.9049e+01_r8/) + kbo(:, 4,23,16) = (/ & + &1.7469e+04_r8,1.3102e+04_r8,8.7344e+03_r8,4.3672e+03_r8,4.8146e+01_r8/) + kbo(:, 5,23,16) = (/ & + &2.0774e+04_r8,1.5580e+04_r8,1.0387e+04_r8,5.1935e+03_r8,4.7113e+01_r8/) + kbo(:, 1,24,16) = (/ & + &9.2015e+03_r8,6.9011e+03_r8,4.6008e+03_r8,2.3004e+03_r8,5.8527e+01_r8/) + kbo(:, 2,24,16) = (/ & + &1.1985e+04_r8,8.9232e+03_r8,5.9928e+03_r8,2.9964e+03_r8,5.7489e+01_r8/) + kbo(:, 3,24,16) = (/ & + &1.5026e+04_r8,1.1269e+04_r8,7.5129e+03_r8,3.7565e+03_r8,5.6333e+01_r8/) + kbo(:, 4,24,16) = (/ & + &1.8238e+04_r8,1.3679e+04_r8,9.1191e+03_r8,4.5596e+03_r8,5.5030e+01_r8/) + kbo(:, 5,24,16) = (/ & + &2.1539e+04_r8,1.6154e+04_r8,1.0769e+04_r8,5.3848e+03_r8,5.3599e+01_r8/) + kbo(:, 1,25,16) = (/ & + &9.9033e+03_r8,7.4275e+03_r8,4.9517e+03_r8,2.4759e+03_r8,6.7091e+01_r8/) + kbo(:, 2,25,16) = (/ & + &1.2768e+04_r8,9.5762e+03_r8,6.3841e+03_r8,3.1921e+03_r8,6.5542e+01_r8/) + kbo(:, 3,25,16) = (/ & + &1.5871e+04_r8,1.1903e+04_r8,7.9355e+03_r8,3.9678e+03_r8,6.3831e+01_r8/) + kbo(:, 4,25,16) = (/ & + &1.9110e+04_r8,1.4333e+04_r8,9.5551e+03_r8,4.7776e+03_r8,6.2029e+01_r8/) + kbo(:, 5,25,16) = (/ & + &2.2417e+04_r8,1.6813e+04_r8,1.1208e+04_r8,5.6043e+03_r8,6.0136e+01_r8/) + kbo(:, 1,26,16) = (/ & + &1.0777e+04_r8,8.0825e+03_r8,5.3884e+03_r8,2.6942e+03_r8,7.5807e+01_r8/) + kbo(:, 2,26,16) = (/ & + &1.3749e+04_r8,1.0312e+04_r8,6.8746e+03_r8,3.4373e+03_r8,7.3586e+01_r8/) + kbo(:, 3,26,16) = (/ & + &1.6921e+04_r8,1.2690e+04_r8,8.4603e+03_r8,4.2302e+03_r8,7.1246e+01_r8/) + kbo(:, 4,26,16) = (/ & + &2.0227e+04_r8,1.5170e+04_r8,1.0114e+04_r8,5.0568e+03_r8,6.8870e+01_r8/) + kbo(:, 5,26,16) = (/ & + &2.3585e+04_r8,1.7688e+04_r8,1.1792e+04_r8,5.8962e+03_r8,6.6424e+01_r8/) + kbo(:, 1,27,16) = (/ & + &1.2052e+04_r8,9.0388e+03_r8,6.0259e+03_r8,3.0130e+03_r8,8.4316e+01_r8/) + kbo(:, 2,27,16) = (/ & + &1.5222e+04_r8,1.1417e+04_r8,7.6111e+03_r8,3.8056e+03_r8,8.1386e+01_r8/) + kbo(:, 3,27,16) = (/ & + &1.8590e+04_r8,1.3942e+04_r8,9.2948e+03_r8,4.6474e+03_r8,7.8348e+01_r8/) + kbo(:, 4,27,16) = (/ & + &2.2058e+04_r8,1.6543e+04_r8,1.1029e+04_r8,5.5145e+03_r8,7.5340e+01_r8/) + kbo(:, 5,27,16) = (/ & + &2.5550e+04_r8,1.9162e+04_r8,1.2775e+04_r8,6.3875e+03_r8,7.2329e+01_r8/) + kbo(:, 1,28,16) = (/ & + &1.3724e+04_r8,1.0293e+04_r8,6.8620e+03_r8,3.4310e+03_r8,9.2351e+01_r8/) + kbo(:, 2,28,16) = (/ & + &1.7171e+04_r8,1.2878e+04_r8,8.5855e+03_r8,4.2928e+03_r8,8.8670e+01_r8/) + kbo(:, 3,28,16) = (/ & + &2.0788e+04_r8,1.5591e+04_r8,1.0394e+04_r8,5.1970e+03_r8,8.4928e+01_r8/) + kbo(:, 4,28,16) = (/ & + &2.4487e+04_r8,1.8365e+04_r8,1.2244e+04_r8,6.1218e+03_r8,8.1255e+01_r8/) + kbo(:, 5,28,16) = (/ & + &2.8173e+04_r8,2.1130e+04_r8,1.4087e+04_r8,7.0433e+03_r8,7.7666e+01_r8/) + kbo(:, 1,29,16) = (/ & + &1.6469e+04_r8,1.2352e+04_r8,8.2344e+03_r8,4.1172e+03_r8,9.9675e+01_r8/) + kbo(:, 2,29,16) = (/ & + &2.0402e+04_r8,1.5302e+04_r8,1.0201e+04_r8,5.1006e+03_r8,9.5182e+01_r8/) + kbo(:, 3,29,16) = (/ & + &2.4499e+04_r8,1.8374e+04_r8,1.2249e+04_r8,6.1246e+03_r8,9.0759e+01_r8/) + kbo(:, 4,29,16) = (/ & + &2.8632e+04_r8,2.1474e+04_r8,1.4316e+04_r8,7.1579e+03_r8,8.6444e+01_r8/) + kbo(:, 5,29,16) = (/ & + &3.2723e+04_r8,2.4542e+04_r8,1.6361e+04_r8,8.1807e+03_r8,8.2287e+01_r8/) + kbo(:, 1,30,16) = (/ & + &2.0078e+04_r8,1.5058e+04_r8,1.0039e+04_r8,5.0195e+03_r8,1.0609e+02_r8/) + kbo(:, 2,30,16) = (/ & + &2.4638e+04_r8,1.8479e+04_r8,1.2319e+04_r8,6.1595e+03_r8,1.0084e+02_r8/) + kbo(:, 3,30,16) = (/ & + &2.9329e+04_r8,2.1997e+04_r8,1.4664e+04_r8,7.3322e+03_r8,9.5740e+01_r8/) + kbo(:, 4,30,16) = (/ & + &3.4034e+04_r8,2.5525e+04_r8,1.7017e+04_r8,8.5085e+03_r8,9.0849e+01_r8/) + kbo(:, 5,30,16) = (/ & + &3.8657e+04_r8,2.8993e+04_r8,1.9329e+04_r8,9.6643e+03_r8,8.6169e+01_r8/) + kbo(:, 1,31,16) = (/ & + &2.5548e+04_r8,1.9161e+04_r8,1.2774e+04_r8,6.3870e+03_r8,1.1146e+02_r8/) + kbo(:, 2,31,16) = (/ & + &3.1052e+04_r8,2.3289e+04_r8,1.5526e+04_r8,7.7630e+03_r8,1.0555e+02_r8/) + kbo(:, 3,31,16) = (/ & + &3.6674e+04_r8,2.7505e+04_r8,1.8172e+04_r8,9.1684e+03_r8,9.9833e+01_r8/) + kbo(:, 4,31,16) = (/ & + &4.2278e+04_r8,3.1708e+04_r8,2.1139e+04_r8,1.0569e+04_r8,9.4413e+01_r8/) + kbo(:, 5,31,16) = (/ & + &4.7725e+04_r8,3.5794e+04_r8,2.3863e+04_r8,1.1931e+04_r8,8.9289e+01_r8/) + kbo(:, 1,32,16) = (/ & + &3.2648e+04_r8,2.4486e+04_r8,1.6324e+04_r8,8.1620e+03_r8,1.1579e+02_r8/) + kbo(:, 2,32,16) = (/ & + &3.9333e+04_r8,2.9500e+04_r8,1.9666e+04_r8,9.8333e+03_r8,1.0928e+02_r8/) + kbo(:, 3,32,16) = (/ & + &4.6114e+04_r8,3.4586e+04_r8,2.3057e+04_r8,1.1529e+04_r8,1.0305e+02_r8/) + kbo(:, 4,32,16) = (/ & + &5.2809e+04_r8,3.9607e+04_r8,2.6404e+04_r8,1.3202e+04_r8,9.7184e+01_r8/) + kbo(:, 5,32,16) = (/ & + &5.9284e+04_r8,4.4463e+04_r8,2.9311e+04_r8,1.4821e+04_r8,9.1687e+01_r8/) + kbo(:, 1,33,16) = (/ & + &4.2212e+04_r8,3.1659e+04_r8,2.1106e+04_r8,1.0553e+04_r8,1.1913e+02_r8/) + kbo(:, 2,33,16) = (/ & + &5.0427e+04_r8,3.7820e+04_r8,2.5214e+04_r8,1.2607e+04_r8,1.1210e+02_r8/) + kbo(:, 3,33,16) = (/ & + &5.8684e+04_r8,4.4013e+04_r8,2.9342e+04_r8,1.4671e+04_r8,1.0546e+02_r8/) + kbo(:, 4,33,16) = (/ & + &6.6793e+04_r8,5.0095e+04_r8,3.3396e+04_r8,1.6698e+04_r8,9.9210e+01_r8/) + kbo(:, 5,33,16) = (/ & + &7.4575e+04_r8,5.5932e+04_r8,3.7288e+04_r8,1.8644e+04_r8,9.3412e+01_r8/) + kbo(:, 1,34,16) = (/ & + &5.2540e+04_r8,3.9405e+04_r8,2.6270e+04_r8,1.3135e+04_r8,1.2180e+02_r8/) + kbo(:, 2,34,16) = (/ & + &6.2330e+04_r8,4.6748e+04_r8,3.1165e+04_r8,1.5582e+04_r8,1.1436e+02_r8/) + kbo(:, 3,34,16) = (/ & + &7.2093e+04_r8,5.4070e+04_r8,3.6046e+04_r8,1.8023e+04_r8,1.0734e+02_r8/) + kbo(:, 4,34,16) = (/ & + &8.1593e+04_r8,6.1194e+04_r8,4.0796e+04_r8,2.0398e+04_r8,1.0080e+02_r8/) + kbo(:, 5,34,16) = (/ & + &9.0697e+04_r8,6.8023e+04_r8,4.5349e+04_r8,2.2674e+04_r8,9.4753e+01_r8/) + kbo(:, 1,35,16) = (/ & + &6.4051e+04_r8,4.8038e+04_r8,3.2026e+04_r8,1.6013e+04_r8,1.2446e+02_r8/) + kbo(:, 2,35,16) = (/ & + &7.5644e+04_r8,5.6733e+04_r8,3.7822e+04_r8,1.8911e+04_r8,1.1662e+02_r8/) + kbo(:, 3,35,16) = (/ & + &8.7172e+04_r8,6.5379e+04_r8,4.3586e+04_r8,2.1792e+04_r8,1.0929e+02_r8/) + kbo(:, 4,35,16) = (/ & + &9.8380e+04_r8,7.3786e+04_r8,4.9191e+04_r8,2.4595e+04_r8,1.0249e+02_r8/) + kbo(:, 5,35,16) = (/ & + &1.0903e+05_r8,8.1776e+04_r8,5.4517e+04_r8,2.7259e+04_r8,9.6197e+01_r8/) + kbo(:, 1,36,16) = (/ & + &7.5878e+04_r8,5.6908e+04_r8,3.7939e+04_r8,1.8969e+04_r8,1.2742e+02_r8/) + kbo(:, 2,36,16) = (/ & + &8.9471e+04_r8,6.7103e+04_r8,4.4735e+04_r8,2.2368e+04_r8,1.1920e+02_r8/) + kbo(:, 3,36,16) = (/ & + &1.0302e+05_r8,7.7263e+04_r8,5.1509e+04_r8,2.5436e+04_r8,1.1154e+02_r8/) + kbo(:, 4,36,16) = (/ & + &1.1614e+05_r8,8.7108e+04_r8,5.8072e+04_r8,2.9036e+04_r8,1.0445e+02_r8/) + kbo(:, 5,36,16) = (/ & + &1.2862e+05_r8,9.6465e+04_r8,6.4310e+04_r8,3.2155e+04_r8,9.7922e+01_r8/) + kbo(:, 1,37,16) = (/ & + &8.5083e+04_r8,6.3812e+04_r8,4.2541e+04_r8,2.1271e+04_r8,1.3125e+02_r8/) + kbo(:, 2,37,16) = (/ & + &1.0058e+05_r8,7.5436e+04_r8,5.0291e+04_r8,2.5145e+04_r8,1.2185e+02_r8/) + kbo(:, 3,37,16) = (/ & + &1.1610e+05_r8,8.7073e+04_r8,5.8049e+04_r8,2.9024e+04_r8,1.1457e+02_r8/) + kbo(:, 4,37,16) = (/ & + &1.3117e+05_r8,9.8374e+04_r8,6.5582e+04_r8,3.2791e+04_r8,1.0715e+02_r8/) + kbo(:, 5,37,16) = (/ & + &1.4551e+05_r8,1.0913e+05_r8,7.2757e+04_r8,3.6378e+04_r8,1.0034e+02_r8/) + kbo(:, 1,38,16) = (/ & + &9.5077e+04_r8,7.2333e+04_r8,4.8222e+04_r8,2.4111e+04_r8,1.3486e+02_r8/) + kbo(:, 2,38,16) = (/ & + &1.1439e+05_r8,8.5793e+04_r8,5.7195e+04_r8,2.8598e+04_r8,1.2580e+02_r8/) + kbo(:, 3,38,16) = (/ & + &1.3231e+05_r8,9.9236e+04_r8,6.6157e+04_r8,3.3078e+04_r8,1.1743e+02_r8/) + kbo(:, 4,38,16) = (/ & + &1.4989e+05_r8,1.1242e+05_r8,7.4945e+04_r8,3.7472e+04_r8,1.0969e+02_r8/) + kbo(:, 5,38,16) = (/ & + &1.6664e+05_r8,1.2498e+05_r8,8.3321e+04_r8,4.1660e+04_r8,1.0261e+02_r8/) + kbo(:, 1,39,16) = (/ & + &1.1158e+05_r8,8.3685e+04_r8,5.5790e+04_r8,2.7895e+04_r8,1.3820e+02_r8/) + kbo(:, 2,39,16) = (/ & + &1.3280e+05_r8,9.9602e+04_r8,6.6401e+04_r8,3.3201e+04_r8,1.2875e+02_r8/) + kbo(:, 3,39,16) = (/ & + &1.5408e+05_r8,1.1556e+05_r8,7.7040e+04_r8,3.8520e+04_r8,1.2007e+02_r8/) + kbo(:, 4,39,16) = (/ & + &1.7495e+05_r8,1.3121e+05_r8,8.7476e+04_r8,4.3738e+04_r8,1.1204e+02_r8/) + kbo(:, 5,39,16) = (/ & + &1.9488e+05_r8,1.4616e+05_r8,9.7443e+04_r8,4.8722e+04_r8,1.0472e+02_r8/) + kbo(:, 1,40,16) = (/ & + &1.1876e+05_r8,8.9071e+04_r8,5.9380e+04_r8,2.9690e+04_r8,1.4235e+02_r8/) + kbo(:, 2,40,16) = (/ & + &1.4221e+05_r8,1.0666e+05_r8,7.1106e+04_r8,3.5553e+04_r8,1.3244e+02_r8/) + kbo(:, 3,40,16) = (/ & + &1.6587e+05_r8,1.2440e+05_r8,8.2934e+04_r8,4.1467e+04_r8,1.2341e+02_r8/) + kbo(:, 4,40,16) = (/ & + &1.8920e+05_r8,1.4190e+05_r8,9.4601e+04_r8,4.7300e+04_r8,1.1506e+02_r8/) + kbo(:, 5,40,16) = (/ & + &2.1165e+05_r8,1.5874e+05_r8,1.0583e+05_r8,5.2913e+04_r8,1.0743e+02_r8/) + kbo(:, 1,41,16) = (/ & + &1.2546e+05_r8,9.4099e+04_r8,6.2733e+04_r8,3.1367e+04_r8,1.4657e+02_r8/) + kbo(:, 2,41,16) = (/ & + &1.5125e+05_r8,1.1344e+05_r8,7.5625e+04_r8,3.7812e+04_r8,1.3531e+02_r8/) + kbo(:, 3,41,16) = (/ & + &1.7744e+05_r8,1.3308e+05_r8,8.8723e+04_r8,4.4362e+04_r8,1.2676e+02_r8/) + kbo(:, 4,41,16) = (/ & + &2.0341e+05_r8,1.5256e+05_r8,1.0171e+05_r8,5.0854e+04_r8,1.1810e+02_r8/) + kbo(:, 5,41,16) = (/ & + &2.2858e+05_r8,1.7144e+05_r8,1.1429e+05_r8,5.7146e+04_r8,1.1015e+02_r8/) + kbo(:, 1,42,16) = (/ & + &1.3356e+05_r8,1.0017e+05_r8,6.6777e+04_r8,3.3389e+04_r8,1.5077e+02_r8/) + kbo(:, 2,42,16) = (/ & + &1.6221e+05_r8,1.2166e+05_r8,8.1105e+04_r8,4.0545e+04_r8,1.3986e+02_r8/) + kbo(:, 3,42,16) = (/ & + &1.9146e+05_r8,1.4359e+05_r8,9.5729e+04_r8,4.7864e+04_r8,1.3005e+02_r8/) + kbo(:, 4,42,16) = (/ & + &2.1781e+05_r8,1.6546e+05_r8,1.1031e+05_r8,5.5153e+04_r8,1.2109e+02_r8/) + kbo(:, 5,42,16) = (/ & + &2.4912e+05_r8,1.8684e+05_r8,1.2456e+05_r8,6.2279e+04_r8,1.1284e+02_r8/) + kbo(:, 1,43,16) = (/ & + &1.4126e+05_r8,1.0594e+05_r8,7.0630e+04_r8,3.5315e+04_r8,1.5567e+02_r8/) + kbo(:, 2,43,16) = (/ & + &1.7322e+05_r8,1.2992e+05_r8,8.6612e+04_r8,4.3306e+04_r8,1.4408e+02_r8/) + kbo(:, 3,43,16) = (/ & + &2.0611e+05_r8,1.5458e+05_r8,1.0200e+05_r8,5.1528e+04_r8,1.3385e+02_r8/) + kbo(:, 4,43,16) = (/ & + &2.3919e+05_r8,1.7940e+05_r8,1.1960e+05_r8,5.9799e+04_r8,1.2454e+02_r8/) + kbo(:, 5,43,16) = (/ & + &2.7160e+05_r8,2.0370e+05_r8,1.3580e+05_r8,6.7900e+04_r8,1.1596e+02_r8/) + kbo(:, 1,44,16) = (/ & + &1.5000e+05_r8,1.1250e+05_r8,7.5001e+04_r8,3.7500e+04_r8,1.6094e+02_r8/) + kbo(:, 2,44,16) = (/ & + &1.8602e+05_r8,1.3952e+05_r8,9.3011e+04_r8,4.6505e+04_r8,1.4866e+02_r8/) + kbo(:, 3,44,16) = (/ & + &2.2342e+05_r8,1.6756e+05_r8,1.1171e+05_r8,5.5854e+04_r8,1.3792e+02_r8/) + kbo(:, 4,44,16) = (/ & + &2.6122e+05_r8,1.9592e+05_r8,1.3061e+05_r8,6.5304e+04_r8,1.2823e+02_r8/) + kbo(:, 5,44,16) = (/ & + &2.9874e+05_r8,2.2406e+05_r8,1.4937e+05_r8,7.4685e+04_r8,1.1932e+02_r8/) + kbo(:, 1,45,16) = (/ & + &1.6171e+05_r8,1.2128e+05_r8,8.0854e+04_r8,4.0427e+04_r8,1.6635e+02_r8/) + kbo(:, 2,45,16) = (/ & + &2.0304e+05_r8,1.5228e+05_r8,1.0152e+05_r8,5.0760e+04_r8,1.5336e+02_r8/) + kbo(:, 3,45,16) = (/ & + &2.4630e+05_r8,1.8473e+05_r8,1.2315e+05_r8,6.1576e+04_r8,1.4204e+02_r8/) + kbo(:, 4,45,16) = (/ & + &2.9041e+05_r8,2.1781e+05_r8,1.4520e+05_r8,7.2602e+04_r8,1.3193e+02_r8/) + kbo(:, 5,45,16) = (/ & + &3.3433e+05_r8,2.5074e+05_r8,1.6716e+05_r8,8.3581e+04_r8,1.2271e+02_r8/) + kbo(:, 1,46,16) = (/ & + &1.7432e+05_r8,1.3074e+05_r8,8.7162e+04_r8,4.3581e+04_r8,1.7227e+02_r8/) + kbo(:, 2,46,16) = (/ & + &2.2186e+05_r8,1.6640e+05_r8,1.1093e+05_r8,5.5465e+04_r8,1.5849e+02_r8/) + kbo(:, 3,46,16) = (/ & + &2.7221e+05_r8,2.0416e+05_r8,1.3611e+05_r8,6.8053e+04_r8,1.4648e+02_r8/) + kbo(:, 4,46,16) = (/ & + &3.2411e+05_r8,2.4308e+05_r8,1.6205e+05_r8,8.1026e+04_r8,1.3593e+02_r8/) + kbo(:, 5,46,16) = (/ & + &3.7610e+05_r8,2.8208e+05_r8,1.8805e+05_r8,9.4025e+04_r8,1.2634e+02_r8/) + kbo(:, 1,47,16) = (/ & + &1.8289e+05_r8,1.3717e+05_r8,9.1447e+04_r8,4.5723e+04_r8,1.7909e+02_r8/) + kbo(:, 2,47,16) = (/ & + &2.3679e+05_r8,1.7759e+05_r8,1.1839e+05_r8,5.9198e+04_r8,1.6436e+02_r8/) + kbo(:, 3,47,16) = (/ & + &2.9447e+05_r8,2.2085e+05_r8,1.4724e+05_r8,7.3618e+04_r8,1.5159e+02_r8/) + kbo(:, 4,47,16) = (/ & + &3.5454e+05_r8,2.6590e+05_r8,1.7727e+05_r8,8.8635e+04_r8,1.4045e+02_r8/) + kbo(:, 5,47,16) = (/ & + &4.1548e+05_r8,3.1161e+05_r8,2.0774e+05_r8,1.0387e+05_r8,1.3046e+02_r8/) + kbo(:, 1,48,16) = (/ & + &1.9579e+05_r8,1.4684e+05_r8,9.7896e+04_r8,4.8948e+04_r8,1.8623e+02_r8/) + kbo(:, 2,48,16) = (/ & + &2.5824e+05_r8,1.9368e+05_r8,1.2912e+05_r8,6.4559e+04_r8,1.7055e+02_r8/) + kbo(:, 3,48,16) = (/ & + &3.2608e+05_r8,2.4456e+05_r8,1.6304e+05_r8,8.0315e+04_r8,1.5696e+02_r8/) + kbo(:, 4,48,16) = (/ & + &3.9734e+05_r8,2.9801e+05_r8,1.9867e+05_r8,9.9336e+04_r8,1.4512e+02_r8/) + kbo(:, 5,48,16) = (/ & + &4.7039e+05_r8,3.5279e+05_r8,2.3519e+05_r8,1.1760e+05_r8,1.3467e+02_r8/) + kbo(:, 1,49,16) = (/ & + &2.1650e+05_r8,1.6238e+05_r8,1.0825e+05_r8,5.4125e+04_r8,1.9381e+02_r8/) + kbo(:, 2,49,16) = (/ & + &2.9149e+05_r8,2.1861e+05_r8,1.4574e+05_r8,7.2871e+04_r8,1.7704e+02_r8/) + kbo(:, 3,49,16) = (/ & + &3.7402e+05_r8,2.8052e+05_r8,1.8701e+05_r8,9.3505e+04_r8,1.6258e+02_r8/) + kbo(:, 4,49,16) = (/ & + &4.6192e+05_r8,3.4644e+05_r8,2.3096e+05_r8,1.1548e+05_r8,1.4999e+02_r8/) + kbo(:, 5,49,16) = (/ & + &5.5289e+05_r8,4.1467e+05_r8,2.7644e+05_r8,1.3822e+05_r8,1.3901e+02_r8/) + kbo(:, 1,50,16) = (/ & + &2.2791e+05_r8,1.7093e+05_r8,1.1395e+05_r8,5.6977e+04_r8,2.0134e+02_r8/) + kbo(:, 2,50,16) = (/ & + &3.1325e+05_r8,2.3494e+05_r8,1.5662e+05_r8,7.8312e+04_r8,1.8345e+02_r8/) + kbo(:, 3,50,16) = (/ & + &4.0878e+05_r8,3.0659e+05_r8,2.0439e+05_r8,1.0220e+05_r8,1.6811e+02_r8/) + kbo(:, 4,50,16) = (/ & + &5.1152e+05_r8,3.8364e+05_r8,2.5576e+05_r8,1.2788e+05_r8,1.5482e+02_r8/) + kbo(:, 5,50,16) = (/ & + &6.1913e+05_r8,4.6434e+05_r8,3.0956e+05_r8,1.5478e+05_r8,1.4323e+02_r8/) + kbo(:, 1,51,16) = (/ & + &2.3351e+05_r8,1.7513e+05_r8,1.1675e+05_r8,5.8377e+04_r8,2.0909e+02_r8/) + kbo(:, 2,51,16) = (/ & + &3.2811e+05_r8,2.4608e+05_r8,1.6406e+05_r8,8.2029e+04_r8,1.9001e+02_r8/) + kbo(:, 3,51,16) = (/ & + &4.3579e+05_r8,3.2684e+05_r8,2.1790e+05_r8,1.0895e+05_r8,1.7377e+02_r8/) + kbo(:, 4,51,16) = (/ & + &5.5314e+05_r8,4.1486e+05_r8,2.7653e+05_r8,1.3829e+05_r8,1.5970e+02_r8/) + kbo(:, 5,51,16) = (/ & + &6.7717e+05_r8,5.0788e+05_r8,3.3859e+05_r8,1.6929e+05_r8,1.4750e+02_r8/) + kbo(:, 1,52,16) = (/ & + &2.4395e+05_r8,1.8296e+05_r8,1.2197e+05_r8,6.0984e+04_r8,2.1739e+02_r8/) + kbo(:, 2,52,16) = (/ & + &3.5104e+05_r8,2.6328e+05_r8,1.7552e+05_r8,8.7761e+04_r8,1.9693e+02_r8/) + kbo(:, 3,52,16) = (/ & + &4.7523e+05_r8,3.5643e+05_r8,2.3762e+05_r8,1.1881e+05_r8,1.7968e+02_r8/) + kbo(:, 4,52,16) = (/ & + &6.1247e+05_r8,4.5936e+05_r8,3.0624e+05_r8,1.5312e+05_r8,1.6481e+02_r8/) + kbo(:, 5,52,16) = (/ & + &7.5898e+05_r8,5.6924e+05_r8,3.7949e+05_r8,1.8975e+05_r8,1.5192e+02_r8/) + kbo(:, 1,53,16) = (/ & + &2.6284e+05_r8,1.9713e+05_r8,1.3142e+05_r8,6.5712e+04_r8,2.2625e+02_r8/) + kbo(:, 2,53,16) = (/ & + &3.8810e+05_r8,2.9108e+05_r8,1.9405e+05_r8,9.7027e+04_r8,2.0424e+02_r8/) + kbo(:, 3,53,16) = (/ & + &5.3641e+05_r8,4.0231e+05_r8,2.6821e+05_r8,1.3410e+05_r8,1.8589e+02_r8/) + kbo(:, 4,53,16) = (/ & + &7.0283e+05_r8,5.2713e+05_r8,3.5142e+05_r8,1.7571e+05_r8,1.7018e+02_r8/) + kbo(:, 5,53,16) = (/ & + &8.8260e+05_r8,6.6195e+05_r8,4.4130e+05_r8,2.2065e+05_r8,1.5658e+02_r8/) + kbo(:, 1,54,16) = (/ & + &2.4532e+05_r8,1.8399e+05_r8,1.2266e+05_r8,6.1332e+04_r8,2.3489e+02_r8/) + kbo(:, 2,54,16) = (/ & + &3.7212e+05_r8,2.7909e+05_r8,1.8606e+05_r8,9.3031e+04_r8,2.1139e+02_r8/) + kbo(:, 3,54,16) = (/ & + &5.1860e+05_r8,3.9351e+05_r8,2.6234e+05_r8,1.3117e+05_r8,1.9188e+02_r8/) + kbo(:, 4,54,16) = (/ & + &6.9903e+05_r8,5.2427e+05_r8,3.4952e+05_r8,1.7476e+05_r8,1.7536e+02_r8/) + kbo(:, 5,54,16) = (/ & + &8.8946e+05_r8,6.6416e+05_r8,4.4474e+05_r8,2.2237e+05_r8,1.6106e+02_r8/) + kbo(:, 1,55,16) = (/ & + &2.0815e+05_r8,1.5612e+05_r8,1.0408e+05_r8,5.2039e+04_r8,2.4370e+02_r8/) + kbo(:, 2,55,16) = (/ & + &3.2440e+05_r8,2.4330e+05_r8,1.6220e+05_r8,8.1100e+04_r8,2.1865e+02_r8/) + kbo(:, 3,55,16) = (/ & + &4.6741e+05_r8,3.5056e+05_r8,2.3371e+05_r8,1.1685e+05_r8,1.9795e+02_r8/) + kbo(:, 4,55,16) = (/ & + &6.3338e+05_r8,4.7504e+05_r8,3.1669e+05_r8,1.5835e+05_r8,1.8053e+02_r8/) + kbo(:, 5,55,16) = (/ & + &8.1696e+05_r8,6.1272e+05_r8,4.0848e+05_r8,2.0424e+05_r8,1.6554e+02_r8/) + kbo(:, 1,56,16) = (/ & + &1.7485e+05_r8,1.3114e+05_r8,8.7424e+04_r8,4.3712e+04_r8,2.5296e+02_r8/) + kbo(:, 2,56,16) = (/ & + &2.8084e+05_r8,2.1063e+05_r8,1.4042e+05_r8,7.0208e+04_r8,2.2634e+02_r8/) + kbo(:, 3,56,16) = (/ & + &4.1394e+05_r8,3.1046e+05_r8,2.0697e+05_r8,1.0347e+05_r8,2.0431e+02_r8/) + kbo(:, 4,56,16) = (/ & + &5.7118e+05_r8,4.2838e+05_r8,2.8559e+05_r8,1.4279e+05_r8,1.8592e+02_r8/) + kbo(:, 5,56,16) = (/ & + &7.4759e+05_r8,5.6069e+05_r8,3.7379e+05_r8,1.8690e+05_r8,1.7020e+02_r8/) + kbo(:, 1,57,16) = (/ & + &1.4522e+05_r8,1.0891e+05_r8,7.2607e+04_r8,3.6303e+04_r8,2.6280e+02_r8/) + kbo(:, 2,57,16) = (/ & + &2.4098e+05_r8,1.8073e+05_r8,1.2049e+05_r8,6.0242e+04_r8,2.3450e+02_r8/) + kbo(:, 3,57,16) = (/ & + &3.6414e+05_r8,2.7311e+05_r8,1.8207e+05_r8,9.1034e+04_r8,2.1103e+02_r8/) + kbo(:, 4,57,16) = (/ & + &5.1231e+05_r8,3.8423e+05_r8,2.5615e+05_r8,1.2807e+05_r8,1.9160e+02_r8/) + kbo(:, 5,57,16) = (/ & + &6.8106e+05_r8,5.1079e+05_r8,3.4053e+05_r8,1.7026e+05_r8,1.7509e+02_r8/) + kbo(:, 1,58,16) = (/ & + &3.1730e+04_r8,2.9092e+04_r8,2.4944e+04_r8,1.7470e+04_r8,2.7269e+02_r8/) + kbo(:, 2,58,16) = (/ & + &5.4453e+04_r8,4.9925e+04_r8,4.2806e+04_r8,2.9981e+04_r8,2.4268e+02_r8/) + kbo(:, 3,58,16) = (/ & + &8.4447e+04_r8,7.7425e+04_r8,6.6385e+04_r8,4.6495e+04_r8,2.1781e+02_r8/) + kbo(:, 4,58,16) = (/ & + &1.2116e+05_r8,1.1108e+05_r8,9.5242e+04_r8,6.6707e+04_r8,1.9723e+02_r8/) + kbo(:, 5,58,16) = (/ & + &1.6365e+05_r8,1.5004e+05_r8,1.2865e+05_r8,9.0103e+04_r8,1.7991e+02_r8/) + kbo(:, 1,59,16) = (/ & + &3.4421e+04_r8,3.0055e+04_r8,2.3973e+04_r8,1.4918e+04_r8,2.7694e+02_r8/) + kbo(:, 2,59,16) = (/ & + &5.9930e+04_r8,5.2328e+04_r8,4.1740e+04_r8,2.5973e+04_r8,2.4614e+02_r8/) + kbo(:, 3,59,16) = (/ & + &9.3934e+04_r8,8.2019e+04_r8,6.5423e+04_r8,4.0711e+04_r8,2.2066e+02_r8/) + kbo(:, 4,59,16) = (/ & + &1.3595e+05_r8,1.1871e+05_r8,9.4687e+04_r8,5.8920e+04_r8,1.9962e+02_r8/) + kbo(:, 5,59,16) = (/ & + &1.8479e+05_r8,1.6135e+05_r8,1.2650e+05_r8,8.0089e+04_r8,1.8195e+02_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mo3( 1, :, 1) = (/ & + & 9.31040e-03_r8, 1.01286e-02_r8, 1.10186e-02_r8, 1.19869e-02_r8, 1.30403e-02_r8, & + & 1.41862e-02_r8, 1.54328e-02_r8, 1.67890e-02_r8, 1.82644e-02_r8, 1.98694e-02_r8, & + & 2.16154e-02_r8, 2.35149e-02_r8, 2.55813e-02_r8, 2.78293e-02_r8, 3.02749e-02_r8, & + & 3.29353e-02_r8, 3.58295e-02_r8, 3.89781e-02_r8, 4.24034e-02_r8/) + kao_mo3( 2, :, 1) = (/ & + & 1.11200e-02_r8, 1.20461e-02_r8, 1.30493e-02_r8, 1.41360e-02_r8, 1.53133e-02_r8, & + & 1.65886e-02_r8, 1.79701e-02_r8, 1.94666e-02_r8, 2.10878e-02_r8, 2.28440e-02_r8, & + & 2.47465e-02_r8, 2.68074e-02_r8, 2.90399e-02_r8, 3.14583e-02_r8, 3.40782e-02_r8, & + & 3.69162e-02_r8, 3.99907e-02_r8, 4.33211e-02_r8, 4.69289e-02_r8/) + kao_mo3( 3, :, 1) = (/ & + & 1.21630e-02_r8, 1.31401e-02_r8, 1.41956e-02_r8, 1.53359e-02_r8, 1.65679e-02_r8, & + & 1.78988e-02_r8, 1.93366e-02_r8, 2.08899e-02_r8, 2.25680e-02_r8, 2.43808e-02_r8, & + & 2.63394e-02_r8, 2.84552e-02_r8, 3.07410e-02_r8, 3.32104e-02_r8, 3.58782e-02_r8, & + & 3.87603e-02_r8, 4.18739e-02_r8, 4.52377e-02_r8, 4.88716e-02_r8/) + kao_mo3( 4, :, 1) = (/ & + & 1.26231e-02_r8, 1.36243e-02_r8, 1.47049e-02_r8, 1.58713e-02_r8, 1.71301e-02_r8, & + & 1.84888e-02_r8, 1.99553e-02_r8, 2.15380e-02_r8, 2.32463e-02_r8, 2.50901e-02_r8, & + & 2.70801e-02_r8, 2.92280e-02_r8, 3.15463e-02_r8, 3.40484e-02_r8, 3.67489e-02_r8, & + & 3.96637e-02_r8, 4.28097e-02_r8, 4.62051e-02_r8, 4.98699e-02_r8/) + kao_mo3( 5, :, 1) = (/ & + & 1.33345e-02_r8, 1.43736e-02_r8, 1.54938e-02_r8, 1.67012e-02_r8, 1.80027e-02_r8, & + & 1.94057e-02_r8, 2.09180e-02_r8, 2.25481e-02_r8, 2.43053e-02_r8, 2.61994e-02_r8, & + & 2.82411e-02_r8, 3.04419e-02_r8, 3.28142e-02_r8, 3.53714e-02_r8, 3.81279e-02_r8, & + & 4.10992e-02_r8, 4.43021e-02_r8, 4.77545e-02_r8, 5.14760e-02_r8/) + kao_mo3( 6, :, 1) = (/ & + & 1.43294e-02_r8, 1.54133e-02_r8, 1.65791e-02_r8, 1.78331e-02_r8, 1.91819e-02_r8, & + & 2.06328e-02_r8, 2.21935e-02_r8, 2.38721e-02_r8, 2.56778e-02_r8, 2.76200e-02_r8, & + & 2.97091e-02_r8, 3.19562e-02_r8, 3.43733e-02_r8, 3.69732e-02_r8, 3.97698e-02_r8, & + & 4.27779e-02_r8, 4.60136e-02_r8, 4.94939e-02_r8, 5.32375e-02_r8/) + kao_mo3( 7, :, 1) = (/ & + & 1.48298e-02_r8, 1.59503e-02_r8, 1.71554e-02_r8, 1.84517e-02_r8, 1.98458e-02_r8, & + & 2.13453e-02_r8, 2.29581e-02_r8, 2.46928e-02_r8, 2.65585e-02_r8, 2.85652e-02_r8, & + & 3.07235e-02_r8, 3.30449e-02_r8, 3.55417e-02_r8, 3.82272e-02_r8, 4.11155e-02_r8, & + & 4.42221e-02_r8, 4.75634e-02_r8, 5.11572e-02_r8, 5.50225e-02_r8/) + kao_mo3( 8, :, 1) = (/ & + & 1.41792e-02_r8, 1.53141e-02_r8, 1.65398e-02_r8, 1.78637e-02_r8, 1.92935e-02_r8, & + & 2.08378e-02_r8, 2.25057e-02_r8, 2.43071e-02_r8, 2.62526e-02_r8, 2.83539e-02_r8, & + & 3.06234e-02_r8, 3.30745e-02_r8, 3.57218e-02_r8, 3.85810e-02_r8, 4.16690e-02_r8, & + & 4.50042e-02_r8, 4.86064e-02_r8, 5.24969e-02_r8, 5.66988e-02_r8/) + kao_mo3( 9, :, 1) = (/ & + & 8.82784e-03_r8, 9.48321e-03_r8, 1.01872e-02_r8, 1.09435e-02_r8, 1.17560e-02_r8, & + & 1.26287e-02_r8, 1.35662e-02_r8, 1.45734e-02_r8, 1.56553e-02_r8, 1.68175e-02_r8, & + & 1.80660e-02_r8, 1.94072e-02_r8, 2.08480e-02_r8, 2.23958e-02_r8, 2.40584e-02_r8, & + & 2.58445e-02_r8, 2.77631e-02_r8, 2.98242e-02_r8, 3.20383e-02_r8/) + kao_mo3( 1, :, 2) = (/ & + & 4.28238e-02_r8, 4.51015e-02_r8, 4.75003e-02_r8, 5.00266e-02_r8, 5.26873e-02_r8, & + & 5.54896e-02_r8, 5.84409e-02_r8, 6.15491e-02_r8, 6.48227e-02_r8, 6.82704e-02_r8, & + & 7.19014e-02_r8, 7.57256e-02_r8, 7.97532e-02_r8, 8.39949e-02_r8, 8.84623e-02_r8, & + & 9.31673e-02_r8, 9.81225e-02_r8, 1.03341e-01_r8, 1.08838e-01_r8/) + kao_mo3( 2, :, 2) = (/ & + & 4.83672e-02_r8, 5.07219e-02_r8, 5.31911e-02_r8, 5.57806e-02_r8, 5.84962e-02_r8, & + & 6.13440e-02_r8, 6.43303e-02_r8, 6.74621e-02_r8, 7.07464e-02_r8, 7.41905e-02_r8, & + & 7.78023e-02_r8, 8.15899e-02_r8, 8.55619e-02_r8, 8.97273e-02_r8, 9.40955e-02_r8, & + & 9.86763e-02_r8, 1.03480e-01_r8, 1.08518e-01_r8, 1.13801e-01_r8/) + kao_mo3( 3, :, 2) = (/ & + & 5.24315e-02_r8, 5.48650e-02_r8, 5.74115e-02_r8, 6.00762e-02_r8, 6.28645e-02_r8, & + & 6.57822e-02_r8, 6.88354e-02_r8, 7.20302e-02_r8, 7.53734e-02_r8, 7.88717e-02_r8, & + & 8.25324e-02_r8, 8.63630e-02_r8, 9.03714e-02_r8, 9.45658e-02_r8, 9.89549e-02_r8, & + & 1.03548e-01_r8, 1.08354e-01_r8, 1.13383e-01_r8, 1.18645e-01_r8/) + kao_mo3( 4, :, 2) = (/ & + & 5.65191e-02_r8, 5.90383e-02_r8, 6.16699e-02_r8, 6.44187e-02_r8, 6.72901e-02_r8, & + & 7.02894e-02_r8, 7.34224e-02_r8, 7.66951e-02_r8, 8.01137e-02_r8, 8.36846e-02_r8, & + & 8.74147e-02_r8, 9.13111e-02_r8, 9.53812e-02_r8, 9.96326e-02_r8, 1.04074e-01_r8, & + & 1.08712e-01_r8, 1.13558e-01_r8, 1.18620e-01_r8, 1.23907e-01_r8/) + kao_mo3( 5, :, 2) = (/ & + & 6.03171e-02_r8, 6.29114e-02_r8, 6.56172e-02_r8, 6.84394e-02_r8, 7.13830e-02_r8, & + & 7.44532e-02_r8, 7.76555e-02_r8, 8.09955e-02_r8, 8.44791e-02_r8, 8.81125e-02_r8, & + & 9.19023e-02_r8, 9.58550e-02_r8, 9.99778e-02_r8, 1.04278e-01_r8, 1.08763e-01_r8, & + & 1.13441e-01_r8, 1.18320e-01_r8, 1.23409e-01_r8, 1.28717e-01_r8/) + kao_mo3( 6, :, 2) = (/ & + & 6.51092e-02_r8, 6.77827e-02_r8, 7.05660e-02_r8, 7.34635e-02_r8, 7.64801e-02_r8, & + & 7.96204e-02_r8, 8.28898e-02_r8, 8.62934e-02_r8, 8.98367e-02_r8, 9.35255e-02_r8, & + & 9.73658e-02_r8, 1.01364e-01_r8, 1.05526e-01_r8, 1.09859e-01_r8, 1.14370e-01_r8, & + & 1.19066e-01_r8, 1.23955e-01_r8, 1.29045e-01_r8, 1.34344e-01_r8/) + kao_mo3( 7, :, 2) = (/ & + & 7.09653e-02_r8, 7.37378e-02_r8, 7.66187e-02_r8, 7.96121e-02_r8, 8.27225e-02_r8, & + & 8.59543e-02_r8, 8.93125e-02_r8, 9.28018e-02_r8, 9.64275e-02_r8, 1.00195e-01_r8, & + & 1.04109e-01_r8, 1.08177e-01_r8, 1.12403e-01_r8, 1.16795e-01_r8, 1.21358e-01_r8, & + & 1.26099e-01_r8, 1.31026e-01_r8, 1.36145e-01_r8, 1.41464e-01_r8/) + kao_mo3( 8, :, 2) = (/ & + & 7.69193e-02_r8, 7.97926e-02_r8, 8.27733e-02_r8, 8.58653e-02_r8, 8.90728e-02_r8, & + & 9.24002e-02_r8, 9.58518e-02_r8, 9.94324e-02_r8, 1.03147e-01_r8, 1.07000e-01_r8, & + & 1.10997e-01_r8, 1.15143e-01_r8, 1.19444e-01_r8, 1.23906e-01_r8, 1.28535e-01_r8, & + & 1.33336e-01_r8, 1.38317e-01_r8, 1.43484e-01_r8, 1.48844e-01_r8/) + kao_mo3( 9, :, 2) = (/ & + & 4.57962e-02_r8, 4.76027e-02_r8, 4.94805e-02_r8, 5.14323e-02_r8, 5.34611e-02_r8, & + & 5.55700e-02_r8, 5.77620e-02_r8, 6.00405e-02_r8, 6.24089e-02_r8, 6.48707e-02_r8, & + & 6.74296e-02_r8, 7.00895e-02_r8, 7.28542e-02_r8, 7.57281e-02_r8, 7.87153e-02_r8, & + & 8.18203e-02_r8, 8.50478e-02_r8, 8.84027e-02_r8, 9.18898e-02_r8/) + kao_mo3( 1, :, 3) = (/ & + & 1.12607e-01_r8, 1.16047e-01_r8, 1.19591e-01_r8, 1.23244e-01_r8, 1.27009e-01_r8, & + & 1.30888e-01_r8, 1.34886e-01_r8, 1.39006e-01_r8, 1.43252e-01_r8, 1.47628e-01_r8, & + & 1.52137e-01_r8, 1.56785e-01_r8, 1.61574e-01_r8, 1.66509e-01_r8, 1.71595e-01_r8, & + & 1.76836e-01_r8, 1.82238e-01_r8, 1.87804e-01_r8, 1.93541e-01_r8/) + kao_mo3( 2, :, 3) = (/ & + & 1.14531e-01_r8, 1.17850e-01_r8, 1.21266e-01_r8, 1.24781e-01_r8, 1.28397e-01_r8, & + & 1.32119e-01_r8, 1.35948e-01_r8, 1.39888e-01_r8, 1.43943e-01_r8, 1.48115e-01_r8, & + & 1.52407e-01_r8, 1.56825e-01_r8, 1.61370e-01_r8, 1.66047e-01_r8, 1.70860e-01_r8, & + & 1.75812e-01_r8, 1.80907e-01_r8, 1.86150e-01_r8, 1.91546e-01_r8/) + kao_mo3( 3, :, 3) = (/ & + & 1.13986e-01_r8, 1.17222e-01_r8, 1.20551e-01_r8, 1.23974e-01_r8, 1.27494e-01_r8, & + & 1.31114e-01_r8, 1.34837e-01_r8, 1.38666e-01_r8, 1.42604e-01_r8, 1.46653e-01_r8, & + & 1.50817e-01_r8, 1.55099e-01_r8, 1.59503e-01_r8, 1.64032e-01_r8, 1.68690e-01_r8, & + & 1.73480e-01_r8, 1.78406e-01_r8, 1.83472e-01_r8, 1.88682e-01_r8/) + kao_mo3( 4, :, 3) = (/ & + & 1.13713e-01_r8, 1.16892e-01_r8, 1.20160e-01_r8, 1.23519e-01_r8, 1.26972e-01_r8, & + & 1.30522e-01_r8, 1.34171e-01_r8, 1.37922e-01_r8, 1.41778e-01_r8, 1.45742e-01_r8, & + & 1.49817e-01_r8, 1.54005e-01_r8, 1.58311e-01_r8, 1.62737e-01_r8, 1.67287e-01_r8, & + & 1.71964e-01_r8, 1.76771e-01_r8, 1.81714e-01_r8, 1.86794e-01_r8/) + kao_mo3( 5, :, 3) = (/ & + & 1.12321e-01_r8, 1.15413e-01_r8, 1.18591e-01_r8, 1.21856e-01_r8, 1.25211e-01_r8, & + & 1.28658e-01_r8, 1.32200e-01_r8, 1.35840e-01_r8, 1.39580e-01_r8, 1.43423e-01_r8, & + & 1.47372e-01_r8, 1.51429e-01_r8, 1.55599e-01_r8, 1.59883e-01_r8, 1.64284e-01_r8, & + & 1.68808e-01_r8, 1.73455e-01_r8, 1.78231e-01_r8, 1.83138e-01_r8/) + kao_mo3( 6, :, 3) = (/ & + & 1.14158e-01_r8, 1.17218e-01_r8, 1.20360e-01_r8, 1.23586e-01_r8, 1.26899e-01_r8, & + & 1.30300e-01_r8, 1.33793e-01_r8, 1.37379e-01_r8, 1.41061e-01_r8, 1.44842e-01_r8, & + & 1.48724e-01_r8, 1.52711e-01_r8, 1.56804e-01_r8, 1.61007e-01_r8, 1.65322e-01_r8, & + & 1.69754e-01_r8, 1.74304e-01_r8, 1.78976e-01_r8, 1.83773e-01_r8/) + kao_mo3( 7, :, 3) = (/ & + & 1.21015e-01_r8, 1.23989e-01_r8, 1.27036e-01_r8, 1.30157e-01_r8, 1.33355e-01_r8, & + & 1.36632e-01_r8, 1.39990e-01_r8, 1.43429e-01_r8, 1.46954e-01_r8, 1.50565e-01_r8, & + & 1.54264e-01_r8, 1.58055e-01_r8, 1.61939e-01_r8, 1.65918e-01_r8, 1.69995e-01_r8, & + & 1.74172e-01_r8, 1.78452e-01_r8, 1.82836e-01_r8, 1.87329e-01_r8/) + kao_mo3( 8, :, 3) = (/ & + & 1.33952e-01_r8, 1.36939e-01_r8, 1.39992e-01_r8, 1.43114e-01_r8, 1.46305e-01_r8, & + & 1.49567e-01_r8, 1.52902e-01_r8, 1.56311e-01_r8, 1.59797e-01_r8, 1.63360e-01_r8, & + & 1.67002e-01_r8, 1.70726e-01_r8, 1.74533e-01_r8, 1.78424e-01_r8, 1.82403e-01_r8, & + & 1.86470e-01_r8, 1.90627e-01_r8, 1.94878e-01_r8, 1.99223e-01_r8/) + kao_mo3( 9, :, 3) = (/ & + & 1.01003e-01_r8, 1.03713e-01_r8, 1.06495e-01_r8, 1.09352e-01_r8, 1.12285e-01_r8, & + & 1.15297e-01_r8, 1.18390e-01_r8, 1.21566e-01_r8, 1.24827e-01_r8, 1.28176e-01_r8, & + & 1.31614e-01_r8, 1.35145e-01_r8, 1.38770e-01_r8, 1.42493e-01_r8, 1.46315e-01_r8, & + & 1.50240e-01_r8, 1.54271e-01_r8, 1.58409e-01_r8, 1.62659e-01_r8/) + kao_mo3( 1, :, 4) = (/ & + & 2.35597e-01_r8, 2.37975e-01_r8, 2.40376e-01_r8, 2.42802e-01_r8, 2.45253e-01_r8, & + & 2.47728e-01_r8, 2.50228e-01_r8, 2.52753e-01_r8, 2.55304e-01_r8, 2.57881e-01_r8, & + & 2.60483e-01_r8, 2.63112e-01_r8, 2.65767e-01_r8, 2.68450e-01_r8, 2.71159e-01_r8, & + & 2.73895e-01_r8, 2.76660e-01_r8, 2.79452e-01_r8, 2.82272e-01_r8/) + kao_mo3( 2, :, 4) = (/ & + & 2.27965e-01_r8, 2.30334e-01_r8, 2.32728e-01_r8, 2.35146e-01_r8, 2.37590e-01_r8, & + & 2.40059e-01_r8, 2.42554e-01_r8, 2.45075e-01_r8, 2.47621e-01_r8, 2.50195e-01_r8, & + & 2.52795e-01_r8, 2.55422e-01_r8, 2.58077e-01_r8, 2.60759e-01_r8, 2.63468e-01_r8, & + & 2.66206e-01_r8, 2.68973e-01_r8, 2.71768e-01_r8, 2.74593e-01_r8/) + kao_mo3( 3, :, 4) = (/ & + & 2.25956e-01_r8, 2.28277e-01_r8, 2.30622e-01_r8, 2.32991e-01_r8, 2.35384e-01_r8, & + & 2.37802e-01_r8, 2.40244e-01_r8, 2.42712e-01_r8, 2.45205e-01_r8, 2.47724e-01_r8, & + & 2.50268e-01_r8, 2.52839e-01_r8, 2.55436e-01_r8, 2.58060e-01_r8, 2.60711e-01_r8, & + & 2.63389e-01_r8, 2.66094e-01_r8, 2.68827e-01_r8, 2.71589e-01_r8/) + kao_mo3( 4, :, 4) = (/ & + & 2.28371e-01_r8, 2.30595e-01_r8, 2.32840e-01_r8, 2.35107e-01_r8, 2.37397e-01_r8, & + & 2.39708e-01_r8, 2.42042e-01_r8, 2.44399e-01_r8, 2.46779e-01_r8, 2.49182e-01_r8, & + & 2.51608e-01_r8, 2.54058e-01_r8, 2.56532e-01_r8, 2.59030e-01_r8, 2.61552e-01_r8, & + & 2.64099e-01_r8, 2.66671e-01_r8, 2.69267e-01_r8, 2.71889e-01_r8/) + kao_mo3( 5, :, 4) = (/ & + & 2.42563e-01_r8, 2.44620e-01_r8, 2.46695e-01_r8, 2.48787e-01_r8, 2.50897e-01_r8, & + & 2.53024e-01_r8, 2.55170e-01_r8, 2.57334e-01_r8, 2.59516e-01_r8, 2.61717e-01_r8, & + & 2.63936e-01_r8, 2.66174e-01_r8, 2.68431e-01_r8, 2.70708e-01_r8, 2.73003e-01_r8, & + & 2.75318e-01_r8, 2.77653e-01_r8, 2.80008e-01_r8, 2.82382e-01_r8/) + kao_mo3( 6, :, 4) = (/ & + & 2.54052e-01_r8, 2.56017e-01_r8, 2.57997e-01_r8, 2.59992e-01_r8, 2.62003e-01_r8, & + & 2.64029e-01_r8, 2.66071e-01_r8, 2.68129e-01_r8, 2.70203e-01_r8, 2.72293e-01_r8, & + & 2.74398e-01_r8, 2.76521e-01_r8, 2.78659e-01_r8, 2.80814e-01_r8, 2.82986e-01_r8, & + & 2.85175e-01_r8, 2.87380e-01_r8, 2.89603e-01_r8, 2.91842e-01_r8/) + kao_mo3( 7, :, 4) = (/ & + & 2.54061e-01_r8, 2.55982e-01_r8, 2.57917e-01_r8, 2.59867e-01_r8, 2.61832e-01_r8, & + & 2.63811e-01_r8, 2.65806e-01_r8, 2.67815e-01_r8, 2.69840e-01_r8, 2.71880e-01_r8, & + & 2.73936e-01_r8, 2.76007e-01_r8, 2.78093e-01_r8, 2.80196e-01_r8, 2.82314e-01_r8, & + & 2.84449e-01_r8, 2.86599e-01_r8, 2.88766e-01_r8, 2.90949e-01_r8/) + kao_mo3( 8, :, 4) = (/ & + & 2.72482e-01_r8, 2.73916e-01_r8, 2.75358e-01_r8, 2.76807e-01_r8, 2.78264e-01_r8, & + & 2.79729e-01_r8, 2.81201e-01_r8, 2.82681e-01_r8, 2.84169e-01_r8, 2.85665e-01_r8, & + & 2.87168e-01_r8, 2.88680e-01_r8, 2.90199e-01_r8, 2.91726e-01_r8, 2.93262e-01_r8, & + & 2.94805e-01_r8, 2.96357e-01_r8, 2.97917e-01_r8, 2.99485e-01_r8/) + kao_mo3( 9, :, 4) = (/ & + & 1.93414e-01_r8, 1.95498e-01_r8, 1.97605e-01_r8, 1.99734e-01_r8, 2.01886e-01_r8, & + & 2.04062e-01_r8, 2.06261e-01_r8, 2.08483e-01_r8, 2.10730e-01_r8, 2.13001e-01_r8, & + & 2.15296e-01_r8, 2.17616e-01_r8, 2.19961e-01_r8, 2.22331e-01_r8, 2.24727e-01_r8, & + & 2.27148e-01_r8, 2.29596e-01_r8, 2.32070e-01_r8, 2.34571e-01_r8/) + kao_mo3( 1, :, 5) = (/ & + & 5.30785e-01_r8, 5.30477e-01_r8, 5.30169e-01_r8, 5.29861e-01_r8, 5.29553e-01_r8, & + & 5.29246e-01_r8, 5.28938e-01_r8, 5.28631e-01_r8, 5.28324e-01_r8, 5.28017e-01_r8, & + & 5.27711e-01_r8, 5.27404e-01_r8, 5.27098e-01_r8, 5.26792e-01_r8, 5.26486e-01_r8, & + & 5.26180e-01_r8, 5.25875e-01_r8, 5.25569e-01_r8, 5.25264e-01_r8/) + kao_mo3( 2, :, 5) = (/ & + & 5.33406e-01_r8, 5.32997e-01_r8, 5.32587e-01_r8, 5.32178e-01_r8, 5.31769e-01_r8, & + & 5.31360e-01_r8, 5.30952e-01_r8, 5.30544e-01_r8, 5.30137e-01_r8, 5.29729e-01_r8, & + & 5.29322e-01_r8, 5.28916e-01_r8, 5.28509e-01_r8, 5.28103e-01_r8, 5.27697e-01_r8, & + & 5.27292e-01_r8, 5.26887e-01_r8, 5.26482e-01_r8, 5.26077e-01_r8/) + kao_mo3( 3, :, 5) = (/ & + & 5.39814e-01_r8, 5.39234e-01_r8, 5.38655e-01_r8, 5.38077e-01_r8, 5.37499e-01_r8, & + & 5.36922e-01_r8, 5.36345e-01_r8, 5.35769e-01_r8, 5.35194e-01_r8, 5.34620e-01_r8, & + & 5.34045e-01_r8, 5.33472e-01_r8, 5.32899e-01_r8, 5.32327e-01_r8, 5.31756e-01_r8, & + & 5.31185e-01_r8, 5.30614e-01_r8, 5.30045e-01_r8, 5.29475e-01_r8/) + kao_mo3( 4, :, 5) = (/ & + & 5.39054e-01_r8, 5.38348e-01_r8, 5.37643e-01_r8, 5.36938e-01_r8, 5.36235e-01_r8, & + & 5.35532e-01_r8, 5.34831e-01_r8, 5.34130e-01_r8, 5.33431e-01_r8, 5.32732e-01_r8, & + & 5.32034e-01_r8, 5.31337e-01_r8, 5.30641e-01_r8, 5.29946e-01_r8, 5.29252e-01_r8, & + & 5.28559e-01_r8, 5.27866e-01_r8, 5.27175e-01_r8, 5.26484e-01_r8/) + kao_mo3( 5, :, 5) = (/ & + & 5.29240e-01_r8, 5.28475e-01_r8, 5.27711e-01_r8, 5.26949e-01_r8, 5.26187e-01_r8, & + & 5.25427e-01_r8, 5.24668e-01_r8, 5.23909e-01_r8, 5.23152e-01_r8, 5.22396e-01_r8, & + & 5.21641e-01_r8, 5.20888e-01_r8, 5.20135e-01_r8, 5.19383e-01_r8, 5.18633e-01_r8, & + & 5.17883e-01_r8, 5.17135e-01_r8, 5.16388e-01_r8, 5.15642e-01_r8/) + kao_mo3( 6, :, 5) = (/ & + & 5.21746e-01_r8, 5.20815e-01_r8, 5.19886e-01_r8, 5.18958e-01_r8, 5.18032e-01_r8, & + & 5.17107e-01_r8, 5.16184e-01_r8, 5.15263e-01_r8, 5.14343e-01_r8, 5.13425e-01_r8, & + & 5.12509e-01_r8, 5.11594e-01_r8, 5.10681e-01_r8, 5.09770e-01_r8, 5.08860e-01_r8, & + & 5.07952e-01_r8, 5.07045e-01_r8, 5.06140e-01_r8, 5.05237e-01_r8/) + kao_mo3( 7, :, 5) = (/ & + & 5.26752e-01_r8, 5.25550e-01_r8, 5.24352e-01_r8, 5.23156e-01_r8, 5.21963e-01_r8, & + & 5.20772e-01_r8, 5.19584e-01_r8, 5.18399e-01_r8, 5.17217e-01_r8, 5.16038e-01_r8, & + & 5.14861e-01_r8, 5.13686e-01_r8, 5.12515e-01_r8, 5.11346e-01_r8, 5.10180e-01_r8, & + & 5.09016e-01_r8, 5.07855e-01_r8, 5.06697e-01_r8, 5.05541e-01_r8/) + kao_mo3( 8, :, 5) = (/ & + & 5.23581e-01_r8, 5.22513e-01_r8, 5.21446e-01_r8, 5.20382e-01_r8, 5.19320e-01_r8, & + & 5.18260e-01_r8, 5.17203e-01_r8, 5.16147e-01_r8, 5.15094e-01_r8, 5.14042e-01_r8, & + & 5.12993e-01_r8, 5.11946e-01_r8, 5.10901e-01_r8, 5.09859e-01_r8, 5.08818e-01_r8, & + & 5.07780e-01_r8, 5.06743e-01_r8, 5.05709e-01_r8, 5.04677e-01_r8/) + kao_mo3( 9, :, 5) = (/ & + & 3.80393e-01_r8, 3.80680e-01_r8, 3.80967e-01_r8, 3.81254e-01_r8, 3.81542e-01_r8, & + & 3.81829e-01_r8, 3.82117e-01_r8, 3.82405e-01_r8, 3.82693e-01_r8, 3.82982e-01_r8, & + & 3.83271e-01_r8, 3.83559e-01_r8, 3.83849e-01_r8, 3.84138e-01_r8, 3.84428e-01_r8, & + & 3.84717e-01_r8, 3.85007e-01_r8, 3.85298e-01_r8, 3.85588e-01_r8/) + kao_mo3( 1, :, 6) = (/ & + & 6.14818e-01_r8, 6.10664e-01_r8, 6.06539e-01_r8, 6.02441e-01_r8, 5.98372e-01_r8, & + & 5.94330e-01_r8, 5.90315e-01_r8, 5.86327e-01_r8, 5.82366e-01_r8, 5.78432e-01_r8, & + & 5.74524e-01_r8, 5.70643e-01_r8, 5.66788e-01_r8, 5.62959e-01_r8, 5.59156e-01_r8, & + & 5.55379e-01_r8, 5.51627e-01_r8, 5.47901e-01_r8, 5.44199e-01_r8/) + kao_mo3( 2, :, 6) = (/ & + & 6.10199e-01_r8, 6.06143e-01_r8, 6.02114e-01_r8, 5.98112e-01_r8, 5.94136e-01_r8, & + & 5.90187e-01_r8, 5.86264e-01_r8, 5.82367e-01_r8, 5.78496e-01_r8, 5.74651e-01_r8, & + & 5.70831e-01_r8, 5.67037e-01_r8, 5.63268e-01_r8, 5.59524e-01_r8, 5.55805e-01_r8, & + & 5.52110e-01_r8, 5.48440e-01_r8, 5.44795e-01_r8, 5.41174e-01_r8/) + kao_mo3( 3, :, 6) = (/ & + & 6.02949e-01_r8, 5.99057e-01_r8, 5.95190e-01_r8, 5.91348e-01_r8, 5.87531e-01_r8, & + & 5.83739e-01_r8, 5.79971e-01_r8, 5.76227e-01_r8, 5.72508e-01_r8, 5.68812e-01_r8, & + & 5.65140e-01_r8, 5.61493e-01_r8, 5.57868e-01_r8, 5.54267e-01_r8, 5.50690e-01_r8, & + & 5.47135e-01_r8, 5.43603e-01_r8, 5.40094e-01_r8, 5.36608e-01_r8/) + kao_mo3( 4, :, 6) = (/ & + & 6.05047e-01_r8, 6.01155e-01_r8, 5.97289e-01_r8, 5.93448e-01_r8, 5.89631e-01_r8, & + & 5.85838e-01_r8, 5.82071e-01_r8, 5.78327e-01_r8, 5.74607e-01_r8, 5.70912e-01_r8, & + & 5.67240e-01_r8, 5.63592e-01_r8, 5.59967e-01_r8, 5.56365e-01_r8, 5.52787e-01_r8, & + & 5.49232e-01_r8, 5.45699e-01_r8, 5.42190e-01_r8, 5.38703e-01_r8/) + kao_mo3( 5, :, 6) = (/ & + & 6.03593e-01_r8, 5.99867e-01_r8, 5.96164e-01_r8, 5.92483e-01_r8, 5.88825e-01_r8, & + & 5.85190e-01_r8, 5.81577e-01_r8, 5.77987e-01_r8, 5.74419e-01_r8, 5.70872e-01_r8, & + & 5.67348e-01_r8, 5.63846e-01_r8, 5.60365e-01_r8, 5.56905e-01_r8, 5.53467e-01_r8, & + & 5.50050e-01_r8, 5.46654e-01_r8, 5.43279e-01_r8, 5.39926e-01_r8/) + kao_mo3( 6, :, 6) = (/ & + & 6.03940e-01_r8, 6.00224e-01_r8, 5.96531e-01_r8, 5.92861e-01_r8, 5.89213e-01_r8, & + & 5.85588e-01_r8, 5.81985e-01_r8, 5.78404e-01_r8, 5.74845e-01_r8, 5.71308e-01_r8, & + & 5.67793e-01_r8, 5.64299e-01_r8, 5.60827e-01_r8, 5.57377e-01_r8, 5.53947e-01_r8, & + & 5.50539e-01_r8, 5.47151e-01_r8, 5.43785e-01_r8, 5.40439e-01_r8/) + kao_mo3( 7, :, 6) = (/ & + & 6.06242e-01_r8, 6.02257e-01_r8, 5.98299e-01_r8, 5.94367e-01_r8, 5.90461e-01_r8, & + & 5.86580e-01_r8, 5.82725e-01_r8, 5.78895e-01_r8, 5.75090e-01_r8, 5.71311e-01_r8, & + & 5.67556e-01_r8, 5.63826e-01_r8, 5.60120e-01_r8, 5.56439e-01_r8, 5.52782e-01_r8, & + & 5.49149e-01_r8, 5.45540e-01_r8, 5.41954e-01_r8, 5.38393e-01_r8/) + kao_mo3( 8, :, 6) = (/ & + & 6.11929e-01_r8, 6.07173e-01_r8, 6.02454e-01_r8, 5.97773e-01_r8, 5.93127e-01_r8, & + & 5.88518e-01_r8, 5.83944e-01_r8, 5.79406e-01_r8, 5.74903e-01_r8, 5.70436e-01_r8, & + & 5.66002e-01_r8, 5.61604e-01_r8, 5.57239e-01_r8, 5.52909e-01_r8, 5.48612e-01_r8, & + & 5.44349e-01_r8, 5.40118e-01_r8, 5.35921e-01_r8, 5.31756e-01_r8/) + kao_mo3( 9, :, 6) = (/ & + & 6.21189e-01_r8, 6.17338e-01_r8, 6.13511e-01_r8, 6.09707e-01_r8, 6.05927e-01_r8, & + & 6.02170e-01_r8, 5.98437e-01_r8, 5.94726e-01_r8, 5.91039e-01_r8, 5.87375e-01_r8, & + & 5.83733e-01_r8, 5.80114e-01_r8, 5.76517e-01_r8, 5.72943e-01_r8, 5.69390e-01_r8, & + & 5.65860e-01_r8, 5.62352e-01_r8, 5.58865e-01_r8, 5.55400e-01_r8/) + kao_mo3( 1, :, 7) = (/ & + & 7.41310e-01_r8, 7.30108e-01_r8, 7.19075e-01_r8, 7.08209e-01_r8, 6.97507e-01_r8, & + & 6.86967e-01_r8, 6.76586e-01_r8, 6.66362e-01_r8, 6.56292e-01_r8, 6.46374e-01_r8, & + & 6.36607e-01_r8, 6.26987e-01_r8, 6.17512e-01_r8, 6.08181e-01_r8, 5.98990e-01_r8, & + & 5.89939e-01_r8, 5.81024e-01_r8, 5.72244e-01_r8, 5.63597e-01_r8/) + kao_mo3( 2, :, 7) = (/ & + & 7.38780e-01_r8, 7.27631e-01_r8, 7.16651e-01_r8, 7.05836e-01_r8, 6.95185e-01_r8, & + & 6.84695e-01_r8, 6.74362e-01_r8, 6.64186e-01_r8, 6.54163e-01_r8, 6.44292e-01_r8, & + & 6.34569e-01_r8, 6.24993e-01_r8, 6.15562e-01_r8, 6.06273e-01_r8, 5.97124e-01_r8, & + & 5.88113e-01_r8, 5.79238e-01_r8, 5.70498e-01_r8, 5.61889e-01_r8/) + kao_mo3( 3, :, 7) = (/ & + & 7.33846e-01_r8, 7.22799e-01_r8, 7.11919e-01_r8, 7.01203e-01_r8, 6.90648e-01_r8, & + & 6.80252e-01_r8, 6.70012e-01_r8, 6.59927e-01_r8, 6.49993e-01_r8, 6.40209e-01_r8, & + & 6.30572e-01_r8, 6.21080e-01_r8, 6.11731e-01_r8, 6.02523e-01_r8, 5.93453e-01_r8, & + & 5.84520e-01_r8, 5.75721e-01_r8, 5.67055e-01_r8, 5.58519e-01_r8/) + kao_mo3( 4, :, 7) = (/ & + & 7.21218e-01_r8, 7.10492e-01_r8, 6.99926e-01_r8, 6.89517e-01_r8, 6.79262e-01_r8, & + & 6.69160e-01_r8, 6.59209e-01_r8, 6.49405e-01_r8, 6.39747e-01_r8, 6.30233e-01_r8, & + & 6.20860e-01_r8, 6.11627e-01_r8, 6.02531e-01_r8, 5.93570e-01_r8, 5.84743e-01_r8, & + & 5.76047e-01_r8, 5.67480e-01_r8, 5.59040e-01_r8, 5.50726e-01_r8/) + kao_mo3( 5, :, 7) = (/ & + & 7.10588e-01_r8, 7.00014e-01_r8, 6.89596e-01_r8, 6.79334e-01_r8, 6.69225e-01_r8, & + & 6.59266e-01_r8, 6.49455e-01_r8, 6.39790e-01_r8, 6.30269e-01_r8, 6.20889e-01_r8, & + & 6.11650e-01_r8, 6.02547e-01_r8, 5.93581e-01_r8, 5.84747e-01_r8, 5.76045e-01_r8, & + & 5.67473e-01_r8, 5.59028e-01_r8, 5.50709e-01_r8, 5.42513e-01_r8/) + kao_mo3( 6, :, 7) = (/ & + & 6.98166e-01_r8, 6.87706e-01_r8, 6.77402e-01_r8, 6.67253e-01_r8, 6.57256e-01_r8, & + & 6.47408e-01_r8, 6.37708e-01_r8, 6.28154e-01_r8, 6.18742e-01_r8, 6.09472e-01_r8, & + & 6.00340e-01_r8, 5.91346e-01_r8, 5.82486e-01_r8, 5.73758e-01_r8, 5.65162e-01_r8, & + & 5.56694e-01_r8, 5.48353e-01_r8, 5.40138e-01_r8, 5.32045e-01_r8/) + kao_mo3( 7, :, 7) = (/ & + & 6.76974e-01_r8, 6.67034e-01_r8, 6.57240e-01_r8, 6.47590e-01_r8, 6.38081e-01_r8, & + & 6.28712e-01_r8, 6.19481e-01_r8, 6.10385e-01_r8, 6.01422e-01_r8, 5.92592e-01_r8, & + & 5.83891e-01_r8, 5.75317e-01_r8, 5.66870e-01_r8, 5.58547e-01_r8, 5.50345e-01_r8, & + & 5.42265e-01_r8, 5.34303e-01_r8, 5.26457e-01_r8, 5.18727e-01_r8/) + kao_mo3( 8, :, 7) = (/ & + & 6.30061e-01_r8, 6.21017e-01_r8, 6.12102e-01_r8, 6.03316e-01_r8, 5.94656e-01_r8, & + & 5.86120e-01_r8, 5.77706e-01_r8, 5.69414e-01_r8, 5.61240e-01_r8, 5.53184e-01_r8, & + & 5.45243e-01_r8, 5.37416e-01_r8, 5.29702e-01_r8, 5.22098e-01_r8, 5.14604e-01_r8, & + & 5.07217e-01_r8, 4.99936e-01_r8, 4.92760e-01_r8, 4.85687e-01_r8/) + kao_mo3( 9, :, 7) = (/ & + & 8.97633e-01_r8, 8.87307e-01_r8, 8.77100e-01_r8, 8.67010e-01_r8, 8.57036e-01_r8, & + & 8.47176e-01_r8, 8.37431e-01_r8, 8.27797e-01_r8, 8.18274e-01_r8, 8.08861e-01_r8, & + & 7.99555e-01_r8, 7.90357e-01_r8, 7.81265e-01_r8, 7.72278e-01_r8, 7.63393e-01_r8, & + & 7.54611e-01_r8, 7.45930e-01_r8, 7.37349e-01_r8, 7.28867e-01_r8/) + kao_mo3( 1, :, 8) = (/ & + & 4.87356e-01_r8, 4.80743e-01_r8, 4.74220e-01_r8, 4.67785e-01_r8, 4.61437e-01_r8, & + & 4.55176e-01_r8, 4.49000e-01_r8, 4.42907e-01_r8, 4.36897e-01_r8, 4.30969e-01_r8, & + & 4.25121e-01_r8, 4.19353e-01_r8, 4.13663e-01_r8, 4.08049e-01_r8, 4.02513e-01_r8, & + & 3.97051e-01_r8, 3.91663e-01_r8, 3.86349e-01_r8, 3.81106e-01_r8/) + kao_mo3( 2, :, 8) = (/ & + & 4.86776e-01_r8, 4.80157e-01_r8, 4.73627e-01_r8, 4.67187e-01_r8, 4.60834e-01_r8, & + & 4.54567e-01_r8, 4.48386e-01_r8, 4.42289e-01_r8, 4.36274e-01_r8, 4.30342e-01_r8, & + & 4.24490e-01_r8, 4.18718e-01_r8, 4.13024e-01_r8, 4.07407e-01_r8, 4.01867e-01_r8, & + & 3.96403e-01_r8, 3.91012e-01_r8, 3.85695e-01_r8, 3.80450e-01_r8/) + kao_mo3( 3, :, 8) = (/ & + & 4.86111e-01_r8, 4.79496e-01_r8, 4.72972e-01_r8, 4.66536e-01_r8, 4.60188e-01_r8, & + & 4.53926e-01_r8, 4.47750e-01_r8, 4.41657e-01_r8, 4.35648e-01_r8, 4.29720e-01_r8, & + & 4.23873e-01_r8, 4.18105e-01_r8, 4.12416e-01_r8, 4.06804e-01_r8, 4.01269e-01_r8, & + & 3.95809e-01_r8, 3.90423e-01_r8, 3.85111e-01_r8, 3.79871e-01_r8/) + kao_mo3( 4, :, 8) = (/ & + & 4.85501e-01_r8, 4.78880e-01_r8, 4.72350e-01_r8, 4.65908e-01_r8, 4.59554e-01_r8, & + & 4.53288e-01_r8, 4.47106e-01_r8, 4.41009e-01_r8, 4.34995e-01_r8, 4.29063e-01_r8, & + & 4.23211e-01_r8, 4.17440e-01_r8, 4.11747e-01_r8, 4.06132e-01_r8, 4.00594e-01_r8, & + & 3.95131e-01_r8, 3.89743e-01_r8, 3.84428e-01_r8, 3.79185e-01_r8/) + kao_mo3( 5, :, 8) = (/ & + & 4.83679e-01_r8, 4.77140e-01_r8, 4.70691e-01_r8, 4.64328e-01_r8, 4.58051e-01_r8, & + & 4.51859e-01_r8, 4.45751e-01_r8, 4.39726e-01_r8, 4.33781e-01_r8, 4.27918e-01_r8, & + & 4.22133e-01_r8, 4.16427e-01_r8, 4.10798e-01_r8, 4.05245e-01_r8, 3.99767e-01_r8, & + & 3.94363e-01_r8, 3.89032e-01_r8, 3.83773e-01_r8, 3.78585e-01_r8/) + kao_mo3( 6, :, 8) = (/ & + & 4.72120e-01_r8, 4.65834e-01_r8, 4.59630e-01_r8, 4.53510e-01_r8, 4.47471e-01_r8, & + & 4.41513e-01_r8, 4.35633e-01_r8, 4.29833e-01_r8, 4.24109e-01_r8, 4.18461e-01_r8, & + & 4.12889e-01_r8, 4.07391e-01_r8, 4.01966e-01_r8, 3.96614e-01_r8, 3.91332e-01_r8, & + & 3.86122e-01_r8, 3.80980e-01_r8, 3.75907e-01_r8, 3.70901e-01_r8/) + kao_mo3( 7, :, 8) = (/ & + & 4.58683e-01_r8, 4.52758e-01_r8, 4.46909e-01_r8, 4.41135e-01_r8, 4.35437e-01_r8, & + & 4.29812e-01_r8, 4.24259e-01_r8, 4.18779e-01_r8, 4.13369e-01_r8, 4.08029e-01_r8, & + & 4.02758e-01_r8, 3.97555e-01_r8, 3.92419e-01_r8, 3.87350e-01_r8, 3.82346e-01_r8, & + & 3.77406e-01_r8, 3.72531e-01_r8, 3.67719e-01_r8, 3.62968e-01_r8/) + kao_mo3( 8, :, 8) = (/ & + & 4.56091e-01_r8, 4.50481e-01_r8, 4.44940e-01_r8, 4.39467e-01_r8, 4.34062e-01_r8, & + & 4.28722e-01_r8, 4.23449e-01_r8, 4.18240e-01_r8, 4.13096e-01_r8, 4.08015e-01_r8, & + & 4.02996e-01_r8, 3.98039e-01_r8, 3.93143e-01_r8, 3.88307e-01_r8, 3.83531e-01_r8, & + & 3.78813e-01_r8, 3.74154e-01_r8, 3.69552e-01_r8, 3.65006e-01_r8/) + kao_mo3( 9, :, 8) = (/ & + & 9.11213e-01_r8, 9.03270e-01_r8, 8.95396e-01_r8, 8.87591e-01_r8, 8.79855e-01_r8, & + & 8.72185e-01_r8, 8.64583e-01_r8, 8.57046e-01_r8, 8.49576e-01_r8, 8.42170e-01_r8, & + & 8.34829e-01_r8, 8.27552e-01_r8, 8.20339e-01_r8, 8.13188e-01_r8, 8.06100e-01_r8, & + & 7.99073e-01_r8, 7.92108e-01_r8, 7.85204e-01_r8, 7.78359e-01_r8/) + kao_mo3( 1, :, 9) = (/ & + & 5.56194e-01_r8, 5.48595e-01_r8, 5.41100e-01_r8, 5.33707e-01_r8, 5.26415e-01_r8, & + & 5.19223e-01_r8, 5.12129e-01_r8, 5.05132e-01_r8, 4.98231e-01_r8, 4.91424e-01_r8, & + & 4.84710e-01_r8, 4.78087e-01_r8, 4.71556e-01_r8, 4.65113e-01_r8, 4.58758e-01_r8, & + & 4.52491e-01_r8, 4.46309e-01_r8, 4.40211e-01_r8, 4.34197e-01_r8/) + kao_mo3( 2, :, 9) = (/ & + & 5.56174e-01_r8, 5.48575e-01_r8, 5.41079e-01_r8, 5.33687e-01_r8, 5.26395e-01_r8, & + & 5.19203e-01_r8, 5.12109e-01_r8, 5.05112e-01_r8, 4.98211e-01_r8, 4.91404e-01_r8, & + & 4.84690e-01_r8, 4.78068e-01_r8, 4.71536e-01_r8, 4.65093e-01_r8, 4.58739e-01_r8, & + & 4.52471e-01_r8, 4.46289e-01_r8, 4.40191e-01_r8, 4.34177e-01_r8/) + kao_mo3( 3, :, 9) = (/ & + & 5.55996e-01_r8, 5.48403e-01_r8, 5.40913e-01_r8, 5.33526e-01_r8, 5.26239e-01_r8, & + & 5.19052e-01_r8, 5.11963e-01_r8, 5.04971e-01_r8, 4.98074e-01_r8, 4.91272e-01_r8, & + & 4.84562e-01_r8, 4.77944e-01_r8, 4.71417e-01_r8, 4.64978e-01_r8, 4.58628e-01_r8, & + & 4.52364e-01_r8, 4.46186e-01_r8, 4.40092e-01_r8, 4.34081e-01_r8/) + kao_mo3( 4, :, 9) = (/ & + & 5.55859e-01_r8, 5.48271e-01_r8, 5.40786e-01_r8, 5.33404e-01_r8, 5.26123e-01_r8, & + & 5.18941e-01_r8, 5.11856e-01_r8, 5.04869e-01_r8, 4.97977e-01_r8, 4.91179e-01_r8, & + & 4.84474e-01_r8, 4.77861e-01_r8, 4.71337e-01_r8, 4.64903e-01_r8, 4.58557e-01_r8, & + & 4.52297e-01_r8, 4.46123e-01_r8, 4.40033e-01_r8, 4.34026e-01_r8/) + kao_mo3( 5, :, 9) = (/ & + & 5.54550e-01_r8, 5.46921e-01_r8, 5.39397e-01_r8, 5.31976e-01_r8, 5.24657e-01_r8, & + & 5.17439e-01_r8, 5.10320e-01_r8, 5.03300e-01_r8, 4.96376e-01_r8, 4.89547e-01_r8, & + & 4.82812e-01_r8, 4.76170e-01_r8, 4.69619e-01_r8, 4.63158e-01_r8, 4.56786e-01_r8, & + & 4.50502e-01_r8, 4.44304e-01_r8, 4.38192e-01_r8, 4.32163e-01_r8/) + kao_mo3( 6, :, 9) = (/ & + & 5.53514e-01_r8, 5.45883e-01_r8, 5.38358e-01_r8, 5.30937e-01_r8, 5.23618e-01_r8, & + & 5.16399e-01_r8, 5.09280e-01_r8, 5.02260e-01_r8, 4.95336e-01_r8, 4.88507e-01_r8, & + & 4.81773e-01_r8, 4.75132e-01_r8, 4.68582e-01_r8, 4.62122e-01_r8, 4.55752e-01_r8, & + & 4.49469e-01_r8, 4.43273e-01_r8, 4.37162e-01_r8, 4.31136e-01_r8/) + kao_mo3( 7, :, 9) = (/ & + & 5.49865e-01_r8, 5.42303e-01_r8, 5.34846e-01_r8, 5.27491e-01_r8, 5.20237e-01_r8, & + & 5.13084e-01_r8, 5.06028e-01_r8, 4.99070e-01_r8, 4.92207e-01_r8, 4.85438e-01_r8, & + & 4.78763e-01_r8, 4.72179e-01_r8, 4.65686e-01_r8, 4.59282e-01_r8, 4.52967e-01_r8, & + & 4.46738e-01_r8, 4.40595e-01_r8, 4.34536e-01_r8, 4.28561e-01_r8/) + kao_mo3( 8, :, 9) = (/ & + & 5.25435e-01_r8, 5.18437e-01_r8, 5.11533e-01_r8, 5.04721e-01_r8, 4.97999e-01_r8, & + & 4.91367e-01_r8, 4.84823e-01_r8, 4.78366e-01_r8, 4.71996e-01_r8, 4.65710e-01_r8, & + & 4.59508e-01_r8, 4.53388e-01_r8, 4.47350e-01_r8, 4.41393e-01_r8, 4.35515e-01_r8, & + & 4.29715e-01_r8, 4.23992e-01_r8, 4.18345e-01_r8, 4.12774e-01_r8/) + kao_mo3( 9, :, 9) = (/ & + & 3.48228e-01_r8, 3.45949e-01_r8, 3.43686e-01_r8, 3.41437e-01_r8, 3.39203e-01_r8, & + & 3.36983e-01_r8, 3.34778e-01_r8, 3.32588e-01_r8, 3.30412e-01_r8, 3.28250e-01_r8, & + & 3.26102e-01_r8, 3.23968e-01_r8, 3.21848e-01_r8, 3.19742e-01_r8, 3.17650e-01_r8, & + & 3.15572e-01_r8, 3.13507e-01_r8, 3.11456e-01_r8, 3.09418e-01_r8/) + kao_mo3( 1, :,10) = (/ & + & 8.34107e-01_r8, 8.27276e-01_r8, 8.20501e-01_r8, 8.13781e-01_r8, 8.07117e-01_r8, & + & 8.00507e-01_r8, 7.93951e-01_r8, 7.87449e-01_r8, 7.81000e-01_r8, 7.74604e-01_r8, & + & 7.68260e-01_r8, 7.61968e-01_r8, 7.55728e-01_r8, 7.49539e-01_r8, 7.43400e-01_r8, & + & 7.37312e-01_r8, 7.31274e-01_r8, 7.25285e-01_r8, 7.19345e-01_r8/) + kao_mo3( 2, :,10) = (/ & + & 8.32838e-01_r8, 8.26022e-01_r8, 8.19263e-01_r8, 8.12558e-01_r8, 8.05908e-01_r8, & + & 7.99313e-01_r8, 7.92772e-01_r8, 7.86284e-01_r8, 7.79849e-01_r8, 7.73467e-01_r8, & + & 7.67137e-01_r8, 7.60859e-01_r8, 7.54633e-01_r8, 7.48457e-01_r8, 7.42332e-01_r8, & + & 7.36257e-01_r8, 7.30232e-01_r8, 7.24256e-01_r8, 7.18329e-01_r8/) + kao_mo3( 3, :,10) = (/ & + & 8.31167e-01_r8, 8.24361e-01_r8, 8.17611e-01_r8, 8.10916e-01_r8, 8.04276e-01_r8, & + & 7.97691e-01_r8, 7.91159e-01_r8, 7.84681e-01_r8, 7.78256e-01_r8, 7.71883e-01_r8, & + & 7.65563e-01_r8, 7.59294e-01_r8, 7.53077e-01_r8, 7.46910e-01_r8, 7.40795e-01_r8, & + & 7.34729e-01_r8, 7.28713e-01_r8, 7.22746e-01_r8, 7.16828e-01_r8/) + kao_mo3( 4, :,10) = (/ & + & 8.29026e-01_r8, 8.22246e-01_r8, 8.15521e-01_r8, 8.08851e-01_r8, 8.02236e-01_r8, & + & 7.95675e-01_r8, 7.89167e-01_r8, 7.82713e-01_r8, 7.76312e-01_r8, 7.69962e-01_r8, & + & 7.63665e-01_r8, 7.57419e-01_r8, 7.51225e-01_r8, 7.45081e-01_r8, 7.38987e-01_r8, & + & 7.32943e-01_r8, 7.26949e-01_r8, 7.21003e-01_r8, 7.15107e-01_r8/) + kao_mo3( 5, :,10) = (/ & + & 8.26226e-01_r8, 8.19471e-01_r8, 8.12771e-01_r8, 8.06126e-01_r8, 7.99536e-01_r8, & + & 7.92999e-01_r8, 7.86515e-01_r8, 7.80085e-01_r8, 7.73707e-01_r8, 7.67382e-01_r8, & + & 7.61108e-01_r8, 7.54885e-01_r8, 7.48714e-01_r8, 7.42592e-01_r8, 7.36521e-01_r8, & + & 7.30500e-01_r8, 7.24527e-01_r8, 7.18604e-01_r8, 7.12729e-01_r8/) + kao_mo3( 6, :,10) = (/ & + & 8.33246e-01_r8, 8.26510e-01_r8, 8.19828e-01_r8, 8.13200e-01_r8, 8.06626e-01_r8, & + & 8.00105e-01_r8, 7.93637e-01_r8, 7.87221e-01_r8, 7.80856e-01_r8, 7.74544e-01_r8, & + & 7.68282e-01_r8, 7.62071e-01_r8, 7.55910e-01_r8, 7.49799e-01_r8, 7.43737e-01_r8, & + & 7.37725e-01_r8, 7.31760e-01_r8, 7.25845e-01_r8, 7.19977e-01_r8/) + kao_mo3( 7, :,10) = (/ & + & 8.45693e-01_r8, 8.38967e-01_r8, 8.32295e-01_r8, 8.25675e-01_r8, 8.19108e-01_r8, & + & 8.12594e-01_r8, 8.06131e-01_r8, 7.99719e-01_r8, 7.93359e-01_r8, 7.87049e-01_r8, & + & 7.80789e-01_r8, 7.74579e-01_r8, 7.68419e-01_r8, 7.62307e-01_r8, 7.56244e-01_r8, & + & 7.50230e-01_r8, 7.44263e-01_r8, 7.38343e-01_r8, 7.32471e-01_r8/) + kao_mo3( 8, :,10) = (/ & + & 8.32139e-01_r8, 8.25565e-01_r8, 8.19044e-01_r8, 8.12574e-01_r8, 8.06156e-01_r8, & + & 7.99788e-01_r8, 7.93470e-01_r8, 7.87202e-01_r8, 7.80984e-01_r8, 7.74815e-01_r8, & + & 7.68694e-01_r8, 7.62622e-01_r8, 7.56598e-01_r8, 7.50622e-01_r8, 7.44692e-01_r8, & + & 7.38810e-01_r8, 7.32974e-01_r8, 7.27184e-01_r8, 7.21440e-01_r8/) + kao_mo3( 9, :,10) = (/ & + & 2.34258e-01_r8, 2.35247e-01_r8, 2.36239e-01_r8, 2.37236e-01_r8, 2.38237e-01_r8, & + & 2.39242e-01_r8, 2.40252e-01_r8, 2.41265e-01_r8, 2.42283e-01_r8, 2.43306e-01_r8, & + & 2.44332e-01_r8, 2.45363e-01_r8, 2.46398e-01_r8, 2.47438e-01_r8, 2.48482e-01_r8, & + & 2.49531e-01_r8, 2.50583e-01_r8, 2.51641e-01_r8, 2.52702e-01_r8/) + kao_mo3( 1, :,11) = (/ & + & 8.31308e-01_r8, 8.22153e-01_r8, 8.13098e-01_r8, 8.04143e-01_r8, 7.95287e-01_r8, & + & 7.86528e-01_r8, 7.77866e-01_r8, 7.69299e-01_r8, 7.60827e-01_r8, 7.52448e-01_r8, & + & 7.44161e-01_r8, 7.35965e-01_r8, 7.27860e-01_r8, 7.19844e-01_r8, 7.11916e-01_r8, & + & 7.04075e-01_r8, 6.96321e-01_r8, 6.88652e-01_r8, 6.81068e-01_r8/) + kao_mo3( 2, :,11) = (/ & + & 8.31577e-01_r8, 8.22400e-01_r8, 8.13324e-01_r8, 8.04349e-01_r8, 7.95472e-01_r8, & + & 7.86693e-01_r8, 7.78011e-01_r8, 7.69425e-01_r8, 7.60934e-01_r8, 7.52537e-01_r8, & + & 7.44232e-01_r8, 7.36019e-01_r8, 7.27896e-01_r8, 7.19863e-01_r8, 7.11919e-01_r8, & + & 7.04062e-01_r8, 6.96292e-01_r8, 6.88608e-01_r8, 6.81009e-01_r8/) + kao_mo3( 3, :,11) = (/ & + & 8.31578e-01_r8, 8.22422e-01_r8, 8.13368e-01_r8, 8.04413e-01_r8, 7.95557e-01_r8, & + & 7.86798e-01_r8, 7.78136e-01_r8, 7.69569e-01_r8, 7.61097e-01_r8, 7.52717e-01_r8, & + & 7.44430e-01_r8, 7.36235e-01_r8, 7.28129e-01_r8, 7.20113e-01_r8, 7.12185e-01_r8, & + & 7.04344e-01_r8, 6.96589e-01_r8, 6.88920e-01_r8, 6.81336e-01_r8/) + kao_mo3( 4, :,11) = (/ & + & 8.31261e-01_r8, 8.22111e-01_r8, 8.13062e-01_r8, 8.04112e-01_r8, 7.95261e-01_r8, & + & 7.86507e-01_r8, 7.77850e-01_r8, 7.69288e-01_r8, 7.60820e-01_r8, 7.52445e-01_r8, & + & 7.44163e-01_r8, 7.35971e-01_r8, 7.27870e-01_r8, 7.19858e-01_r8, 7.11935e-01_r8, & + & 7.04098e-01_r8, 6.96348e-01_r8, 6.88683e-01_r8, 6.81102e-01_r8/) + kao_mo3( 5, :,11) = (/ & + & 8.31565e-01_r8, 8.22404e-01_r8, 8.13344e-01_r8, 8.04384e-01_r8, 7.95523e-01_r8, & + & 7.86760e-01_r8, 7.78092e-01_r8, 7.69521e-01_r8, 7.61044e-01_r8, 7.52660e-01_r8, & + & 7.44368e-01_r8, 7.36168e-01_r8, 7.28058e-01_r8, 7.20038e-01_r8, 7.12106e-01_r8, & + & 7.04261e-01_r8, 6.96503e-01_r8, 6.88830e-01_r8, 6.81242e-01_r8/) + kao_mo3( 6, :,11) = (/ & + & 8.17636e-01_r8, 8.08497e-01_r8, 7.99461e-01_r8, 7.90525e-01_r8, 7.81690e-01_r8, & + & 7.72953e-01_r8, 7.64314e-01_r8, 7.55771e-01_r8, 7.47324e-01_r8, 7.38971e-01_r8, & + & 7.30712e-01_r8, 7.22545e-01_r8, 7.14469e-01_r8, 7.06483e-01_r8, 6.98587e-01_r8, & + & 6.90779e-01_r8, 6.83058e-01_r8, 6.75424e-01_r8, 6.67875e-01_r8/) + kao_mo3( 7, :,11) = (/ & + & 7.95247e-01_r8, 7.86140e-01_r8, 7.77137e-01_r8, 7.68238e-01_r8, 7.59440e-01_r8, & + & 7.50743e-01_r8, 7.42145e-01_r8, 7.33646e-01_r8, 7.25245e-01_r8, 7.16939e-01_r8, & + & 7.08729e-01_r8, 7.00612e-01_r8, 6.92589e-01_r8, 6.84658e-01_r8, 6.76817e-01_r8, & + & 6.69066e-01_r8, 6.61404e-01_r8, 6.53830e-01_r8, 6.46342e-01_r8/) + kao_mo3( 8, :,11) = (/ & + & 7.63069e-01_r8, 7.54006e-01_r8, 7.45051e-01_r8, 7.36202e-01_r8, 7.27458e-01_r8, & + & 7.18818e-01_r8, 7.10281e-01_r8, 7.01845e-01_r8, 6.93509e-01_r8, 6.85272e-01_r8, & + & 6.77133e-01_r8, 6.69091e-01_r8, 6.61144e-01_r8, 6.53292e-01_r8, 6.45533e-01_r8, & + & 6.37866e-01_r8, 6.30290e-01_r8, 6.22804e-01_r8, 6.15407e-01_r8/) + kao_mo3( 9, :,11) = (/ & + & 2.03255e-01_r8, 2.03004e-01_r8, 2.02753e-01_r8, 2.02502e-01_r8, 2.02252e-01_r8, & + & 2.02001e-01_r8, 2.01752e-01_r8, 2.01502e-01_r8, 2.01253e-01_r8, 2.01004e-01_r8, & + & 2.00755e-01_r8, 2.00507e-01_r8, 2.00259e-01_r8, 2.00011e-01_r8, 1.99764e-01_r8, & + & 1.99517e-01_r8, 1.99270e-01_r8, 1.99024e-01_r8, 1.98777e-01_r8/) + kao_mo3( 1, :,12) = (/ & + & 4.13201e-01_r8, 4.05258e-01_r8, 3.97468e-01_r8, 3.89828e-01_r8, 3.82334e-01_r8, & + & 3.74985e-01_r8, 3.67777e-01_r8, 3.60707e-01_r8, 3.53774e-01_r8, 3.46973e-01_r8, & + & 3.40303e-01_r8, 3.33762e-01_r8, 3.27346e-01_r8, 3.21054e-01_r8, 3.14882e-01_r8, & + & 3.08829e-01_r8, 3.02893e-01_r8, 2.97071e-01_r8, 2.91360e-01_r8/) + kao_mo3( 2, :,12) = (/ & + & 4.12835e-01_r8, 4.04897e-01_r8, 3.97112e-01_r8, 3.89477e-01_r8, 3.81988e-01_r8, & + & 3.74644e-01_r8, 3.67440e-01_r8, 3.60376e-01_r8, 3.53447e-01_r8, 3.46651e-01_r8, & + & 3.39986e-01_r8, 3.33449e-01_r8, 3.27038e-01_r8, 3.20750e-01_r8, 3.14582e-01_r8, & + & 3.08534e-01_r8, 3.02602e-01_r8, 2.96784e-01_r8, 2.91077e-01_r8/) + kao_mo3( 3, :,12) = (/ & + & 4.13023e-01_r8, 4.05079e-01_r8, 3.97289e-01_r8, 3.89648e-01_r8, 3.82155e-01_r8, & + & 3.74805e-01_r8, 3.67597e-01_r8, 3.60527e-01_r8, 3.53594e-01_r8, 3.46793e-01_r8, & + & 3.40124e-01_r8, 3.33583e-01_r8, 3.27167e-01_r8, 3.20875e-01_r8, 3.14704e-01_r8, & + & 3.08652e-01_r8, 3.02716e-01_r8, 2.96894e-01_r8, 2.91184e-01_r8/) + kao_mo3( 4, :,12) = (/ & + & 4.13397e-01_r8, 4.05437e-01_r8, 3.97630e-01_r8, 3.89973e-01_r8, 3.82463e-01_r8, & + & 3.75099e-01_r8, 3.67876e-01_r8, 3.60792e-01_r8, 3.53844e-01_r8, 3.47031e-01_r8, & + & 3.40348e-01_r8, 3.33794e-01_r8, 3.27367e-01_r8, 3.21063e-01_r8, 3.14880e-01_r8, & + & 3.08817e-01_r8, 3.02870e-01_r8, 2.97038e-01_r8, 2.91318e-01_r8/) + kao_mo3( 5, :,12) = (/ & + & 4.13043e-01_r8, 4.05106e-01_r8, 3.97321e-01_r8, 3.89686e-01_r8, 3.82198e-01_r8, & + & 3.74854e-01_r8, 3.67651e-01_r8, 3.60586e-01_r8, 3.53657e-01_r8, 3.46861e-01_r8, & + & 3.40195e-01_r8, 3.33658e-01_r8, 3.27246e-01_r8, 3.20958e-01_r8, 3.14790e-01_r8, & + & 3.08741e-01_r8, 3.02808e-01_r8, 2.96990e-01_r8, 2.91283e-01_r8/) + kao_mo3( 6, :,12) = (/ & + & 4.13151e-01_r8, 4.05202e-01_r8, 3.97406e-01_r8, 3.89760e-01_r8, 3.82261e-01_r8, & + & 3.74906e-01_r8, 3.67693e-01_r8, 3.60619e-01_r8, 3.53680e-01_r8, 3.46876e-01_r8, & + & 3.40202e-01_r8, 3.33656e-01_r8, 3.27237e-01_r8, 3.20941e-01_r8, 3.14766e-01_r8, & + & 3.08710e-01_r8, 3.02770e-01_r8, 2.96945e-01_r8, 2.91232e-01_r8/) + kao_mo3( 7, :,12) = (/ & + & 4.13052e-01_r8, 4.05109e-01_r8, 3.97319e-01_r8, 3.89678e-01_r8, 3.82185e-01_r8, & + & 3.74835e-01_r8, 3.67627e-01_r8, 3.60557e-01_r8, 3.53624e-01_r8, 3.46823e-01_r8, & + & 3.40154e-01_r8, 3.33612e-01_r8, 3.27197e-01_r8, 3.20905e-01_r8, 3.14734e-01_r8, & + & 3.08681e-01_r8, 3.02745e-01_r8, 2.96923e-01_r8, 2.91213e-01_r8/) + kao_mo3( 8, :,12) = (/ & + & 4.13152e-01_r8, 4.05209e-01_r8, 3.97418e-01_r8, 3.89778e-01_r8, 3.82284e-01_r8, & + & 3.74935e-01_r8, 3.67727e-01_r8, 3.60657e-01_r8, 3.53723e-01_r8, 3.46923e-01_r8, & + & 3.40253e-01_r8, 3.33712e-01_r8, 3.27296e-01_r8, 3.21004e-01_r8, 3.14833e-01_r8, & + & 3.08780e-01_r8, 3.02844e-01_r8, 2.97021e-01_r8, 2.91311e-01_r8/) + kao_mo3( 9, :,12) = (/ & + & 1.31008e-01_r8, 1.30607e-01_r8, 1.30208e-01_r8, 1.29810e-01_r8, 1.29413e-01_r8, & + & 1.29017e-01_r8, 1.28623e-01_r8, 1.28229e-01_r8, 1.27837e-01_r8, 1.27446e-01_r8, & + & 1.27056e-01_r8, 1.26668e-01_r8, 1.26280e-01_r8, 1.25894e-01_r8, 1.25509e-01_r8, & + & 1.25125e-01_r8, 1.24743e-01_r8, 1.24361e-01_r8, 1.23981e-01_r8/) + kao_mo3( 1, :,13) = (/ & + & 4.66826e-01_r8, 4.71437e-01_r8, 4.76094e-01_r8, 4.80798e-01_r8, 4.85547e-01_r8, & + & 4.90344e-01_r8, 4.95187e-01_r8, 5.00079e-01_r8, 5.05019e-01_r8, 5.10008e-01_r8, & + & 5.15046e-01_r8, 5.20134e-01_r8, 5.25272e-01_r8, 5.30461e-01_r8, 5.35701e-01_r8, & + & 5.40993e-01_r8, 5.46338e-01_r8, 5.51735e-01_r8, 5.57185e-01_r8/) + kao_mo3( 2, :,13) = (/ & + & 4.66579e-01_r8, 4.71199e-01_r8, 4.75865e-01_r8, 4.80577e-01_r8, 4.85336e-01_r8, & + & 4.90141e-01_r8, 4.94995e-01_r8, 4.99896e-01_r8, 5.04846e-01_r8, 5.09845e-01_r8, & + & 5.14893e-01_r8, 5.19992e-01_r8, 5.25141e-01_r8, 5.30340e-01_r8, 5.35592e-01_r8, & + & 5.40895e-01_r8, 5.46251e-01_r8, 5.51660e-01_r8, 5.57122e-01_r8/) + kao_mo3( 3, :,13) = (/ & + & 4.66956e-01_r8, 4.71567e-01_r8, 4.76224e-01_r8, 4.80927e-01_r8, 4.85677e-01_r8, & + & 4.90474e-01_r8, 4.95318e-01_r8, 5.00209e-01_r8, 5.05149e-01_r8, 5.10138e-01_r8, & + & 5.15176e-01_r8, 5.20264e-01_r8, 5.25402e-01_r8, 5.30591e-01_r8, 5.35831e-01_r8, & + & 5.41123e-01_r8, 5.46467e-01_r8, 5.51864e-01_r8, 5.57314e-01_r8/) + kao_mo3( 4, :,13) = (/ & + & 4.66456e-01_r8, 4.71080e-01_r8, 4.75750e-01_r8, 4.80467e-01_r8, 4.85230e-01_r8, & + & 4.90040e-01_r8, 4.94898e-01_r8, 4.99804e-01_r8, 5.04759e-01_r8, 5.09763e-01_r8, & + & 5.14817e-01_r8, 5.19920e-01_r8, 5.25075e-01_r8, 5.30280e-01_r8, 5.35537e-01_r8, & + & 5.40846e-01_r8, 5.46208e-01_r8, 5.51622e-01_r8, 5.57091e-01_r8/) + kao_mo3( 5, :,13) = (/ & + & 4.66853e-01_r8, 4.71456e-01_r8, 4.76104e-01_r8, 4.80798e-01_r8, 4.85539e-01_r8, & + & 4.90326e-01_r8, 4.95160e-01_r8, 5.00042e-01_r8, 5.04973e-01_r8, 5.09952e-01_r8, & + & 5.14979e-01_r8, 5.20057e-01_r8, 5.25185e-01_r8, 5.30363e-01_r8, 5.35592e-01_r8, & + & 5.40873e-01_r8, 5.46205e-01_r8, 5.51591e-01_r8, 5.57029e-01_r8/) + kao_mo3( 6, :,13) = (/ & + & 4.66832e-01_r8, 4.71448e-01_r8, 4.76110e-01_r8, 4.80817e-01_r8, 4.85571e-01_r8, & + & 4.90372e-01_r8, 4.95221e-01_r8, 5.00118e-01_r8, 5.05063e-01_r8, 5.10056e-01_r8, & + & 5.15100e-01_r8, 5.20193e-01_r8, 5.25336e-01_r8, 5.30531e-01_r8, 5.35776e-01_r8, & + & 5.41074e-01_r8, 5.46424e-01_r8, 5.51826e-01_r8, 5.57283e-01_r8/) + kao_mo3( 7, :,13) = (/ & + & 4.66679e-01_r8, 4.71299e-01_r8, 4.75965e-01_r8, 4.80677e-01_r8, 4.85436e-01_r8, & + & 4.90241e-01_r8, 4.95095e-01_r8, 4.99996e-01_r8, 5.04946e-01_r8, 5.09945e-01_r8, & + & 5.14993e-01_r8, 5.20092e-01_r8, 5.25240e-01_r8, 5.30440e-01_r8, 5.35692e-01_r8, & + & 5.40995e-01_r8, 5.46351e-01_r8, 5.51759e-01_r8, 5.57222e-01_r8/) + kao_mo3( 8, :,13) = (/ & + & 4.66982e-01_r8, 4.71598e-01_r8, 4.76260e-01_r8, 4.80967e-01_r8, 4.85721e-01_r8, & + & 4.90522e-01_r8, 4.95371e-01_r8, 5.00268e-01_r8, 5.05213e-01_r8, 5.10206e-01_r8, & + & 5.15250e-01_r8, 5.20343e-01_r8, 5.25486e-01_r8, 5.30680e-01_r8, 5.35926e-01_r8, & + & 5.41223e-01_r8, 5.46573e-01_r8, 5.51976e-01_r8, 5.57432e-01_r8/) + kao_mo3( 9, :,13) = (/ & + & 1.13709e-01_r8, 1.13141e-01_r8, 1.12576e-01_r8, 1.12013e-01_r8, 1.11453e-01_r8, & + & 1.10897e-01_r8, 1.10342e-01_r8, 1.09791e-01_r8, 1.09242e-01_r8, 1.08696e-01_r8, & + & 1.08153e-01_r8, 1.07613e-01_r8, 1.07075e-01_r8, 1.06540e-01_r8, 1.06007e-01_r8, & + & 1.05478e-01_r8, 1.04951e-01_r8, 1.04426e-01_r8, 1.03904e-01_r8/) + kao_mo3( 1, :,14) = (/ & + & 5.67608e-01_r8, 5.55796e-01_r8, 5.44230e-01_r8, 5.32904e-01_r8, 5.21814e-01_r8, & + & 5.10955e-01_r8, 5.00322e-01_r8, 4.89910e-01_r8, 4.79714e-01_r8, 4.69731e-01_r8, & + & 4.59956e-01_r8, 4.50384e-01_r8, 4.41011e-01_r8, 4.31834e-01_r8, 4.22847e-01_r8, & + & 4.14048e-01_r8, 4.05431e-01_r8, 3.96994e-01_r8, 3.88732e-01_r8/) + kao_mo3( 2, :,14) = (/ & + & 5.67766e-01_r8, 5.55948e-01_r8, 5.44376e-01_r8, 5.33045e-01_r8, 5.21950e-01_r8, & + & 5.11086e-01_r8, 5.00448e-01_r8, 4.90031e-01_r8, 4.79831e-01_r8, 4.69844e-01_r8, & + & 4.60064e-01_r8, 4.50488e-01_r8, 4.41111e-01_r8, 4.31930e-01_r8, 4.22939e-01_r8, & + & 4.14136e-01_r8, 4.05516e-01_r8, 3.97075e-01_r8, 3.88810e-01_r8/) + kao_mo3( 3, :,14) = (/ & + & 5.67460e-01_r8, 5.55647e-01_r8, 5.44080e-01_r8, 5.32754e-01_r8, 5.21664e-01_r8, & + & 5.10805e-01_r8, 5.00172e-01_r8, 4.89760e-01_r8, 4.79564e-01_r8, 4.69582e-01_r8, & + & 4.59806e-01_r8, 4.50235e-01_r8, 4.40862e-01_r8, 4.31685e-01_r8, 4.22699e-01_r8, & + & 4.13900e-01_r8, 4.05284e-01_r8, 3.96847e-01_r8, 3.88586e-01_r8/) + kao_mo3( 4, :,14) = (/ & + & 5.67925e-01_r8, 5.56107e-01_r8, 5.44536e-01_r8, 5.33205e-01_r8, 5.22110e-01_r8, & + & 5.11246e-01_r8, 5.00608e-01_r8, 4.90191e-01_r8, 4.79991e-01_r8, 4.70004e-01_r8, & + & 4.60224e-01_r8, 4.50647e-01_r8, 4.41270e-01_r8, 4.32088e-01_r8, 4.23097e-01_r8, & + & 4.14293e-01_r8, 4.05673e-01_r8, 3.97231e-01_r8, 3.88966e-01_r8/) + kao_mo3( 5, :,14) = (/ & + & 5.67520e-01_r8, 5.55733e-01_r8, 5.44190e-01_r8, 5.32887e-01_r8, 5.21818e-01_r8, & + & 5.10980e-01_r8, 5.00366e-01_r8, 4.89974e-01_r8, 4.79797e-01_r8, 4.69831e-01_r8, & + & 4.60072e-01_r8, 4.50516e-01_r8, 4.41159e-01_r8, 4.31996e-01_r8, 4.23023e-01_r8, & + & 4.14236e-01_r8, 4.05633e-01_r8, 3.97207e-01_r8, 3.88957e-01_r8/) + kao_mo3( 6, :,14) = (/ & + & 5.67549e-01_r8, 5.55749e-01_r8, 5.44195e-01_r8, 5.32880e-01_r8, 5.21801e-01_r8, & + & 5.10952e-01_r8, 5.00329e-01_r8, 4.89927e-01_r8, 4.79740e-01_r8, 4.69766e-01_r8, & + & 4.59999e-01_r8, 4.50435e-01_r8, 4.41070e-01_r8, 4.31900e-01_r8, 4.22920e-01_r8, & + & 4.14127e-01_r8, 4.05517e-01_r8, 3.97086e-01_r8, 3.88830e-01_r8/) + kao_mo3( 7, :,14) = (/ & + & 5.67727e-01_r8, 5.55909e-01_r8, 5.44337e-01_r8, 5.33005e-01_r8, 5.21910e-01_r8, & + & 5.11046e-01_r8, 5.00408e-01_r8, 4.89991e-01_r8, 4.79791e-01_r8, 4.69804e-01_r8, & + & 4.60024e-01_r8, 4.50448e-01_r8, 4.41071e-01_r8, 4.31890e-01_r8, 4.22900e-01_r8, & + & 4.14096e-01_r8, 4.05476e-01_r8, 3.97036e-01_r8, 3.88771e-01_r8/) + kao_mo3( 8, :,14) = (/ & + & 5.67795e-01_r8, 5.55965e-01_r8, 5.44381e-01_r8, 5.33039e-01_r8, 5.21933e-01_r8, & + & 5.11058e-01_r8, 5.00410e-01_r8, 4.89984e-01_r8, 4.79775e-01_r8, 4.69779e-01_r8, & + & 4.59991e-01_r8, 4.50407e-01_r8, 4.41023e-01_r8, 4.31834e-01_r8, 4.22836e-01_r8, & + & 4.14026e-01_r8, 4.05400e-01_r8, 3.96953e-01_r8, 3.88683e-01_r8/) + kao_mo3( 9, :,14) = (/ & + & 1.32957e-01_r8, 1.31737e-01_r8, 1.30528e-01_r8, 1.29330e-01_r8, 1.28143e-01_r8, & + & 1.26967e-01_r8, 1.25802e-01_r8, 1.24648e-01_r8, 1.23504e-01_r8, 1.22370e-01_r8, & + & 1.21247e-01_r8, 1.20135e-01_r8, 1.19032e-01_r8, 1.17940e-01_r8, 1.16857e-01_r8, & + & 1.15785e-01_r8, 1.14722e-01_r8, 1.13669e-01_r8, 1.12626e-01_r8/) + kao_mo3( 1, :,15) = (/ & + & 1.51281e-01_r8, 1.53439e-01_r8, 1.55628e-01_r8, 1.57848e-01_r8, 1.60100e-01_r8, & + & 1.62384e-01_r8, 1.64700e-01_r8, 1.67049e-01_r8, 1.69432e-01_r8, 1.71849e-01_r8, & + & 1.74301e-01_r8, 1.76787e-01_r8, 1.79309e-01_r8, 1.81866e-01_r8, 1.84461e-01_r8, & + & 1.87092e-01_r8, 1.89761e-01_r8, 1.92468e-01_r8, 1.95213e-01_r8/) + kao_mo3( 2, :,15) = (/ & + & 1.51431e-01_r8, 1.53589e-01_r8, 1.55778e-01_r8, 1.57998e-01_r8, 1.60250e-01_r8, & + & 1.62534e-01_r8, 1.64850e-01_r8, 1.67199e-01_r8, 1.69582e-01_r8, 1.71999e-01_r8, & + & 1.74450e-01_r8, 1.76937e-01_r8, 1.79458e-01_r8, 1.82016e-01_r8, 1.84610e-01_r8, & + & 1.87241e-01_r8, 1.89909e-01_r8, 1.92616e-01_r8, 1.95361e-01_r8/) + kao_mo3( 3, :,15) = (/ & + & 1.51299e-01_r8, 1.53461e-01_r8, 1.55654e-01_r8, 1.57878e-01_r8, 1.60134e-01_r8, & + & 1.62422e-01_r8, 1.64744e-01_r8, 1.67098e-01_r8, 1.69486e-01_r8, 1.71908e-01_r8, & + & 1.74364e-01_r8, 1.76856e-01_r8, 1.79383e-01_r8, 1.81947e-01_r8, 1.84547e-01_r8, & + & 1.87184e-01_r8, 1.89859e-01_r8, 1.92572e-01_r8, 1.95324e-01_r8/) + kao_mo3( 4, :,15) = (/ & + & 1.51281e-01_r8, 1.53439e-01_r8, 1.55628e-01_r8, 1.57848e-01_r8, 1.60100e-01_r8, & + & 1.62384e-01_r8, 1.64700e-01_r8, 1.67049e-01_r8, 1.69432e-01_r8, 1.71849e-01_r8, & + & 1.74301e-01_r8, 1.76787e-01_r8, 1.79309e-01_r8, 1.81866e-01_r8, 1.84461e-01_r8, & + & 1.87092e-01_r8, 1.89761e-01_r8, 1.92468e-01_r8, 1.95213e-01_r8/) + kao_mo3( 5, :,15) = (/ & + & 1.51281e-01_r8, 1.53439e-01_r8, 1.55628e-01_r8, 1.57848e-01_r8, 1.60100e-01_r8, & + & 1.62384e-01_r8, 1.64700e-01_r8, 1.67049e-01_r8, 1.69432e-01_r8, 1.71849e-01_r8, & + & 1.74301e-01_r8, 1.76787e-01_r8, 1.79309e-01_r8, 1.81866e-01_r8, 1.84461e-01_r8, & + & 1.87092e-01_r8, 1.89761e-01_r8, 1.92468e-01_r8, 1.95213e-01_r8/) + kao_mo3( 6, :,15) = (/ & + & 1.51299e-01_r8, 1.53461e-01_r8, 1.55654e-01_r8, 1.57878e-01_r8, 1.60134e-01_r8, & + & 1.62422e-01_r8, 1.64744e-01_r8, 1.67098e-01_r8, 1.69486e-01_r8, 1.71908e-01_r8, & + & 1.74364e-01_r8, 1.76856e-01_r8, 1.79383e-01_r8, 1.81947e-01_r8, 1.84547e-01_r8, & + & 1.87184e-01_r8, 1.89859e-01_r8, 1.92572e-01_r8, 1.95324e-01_r8/) + kao_mo3( 7, :,15) = (/ & + & 1.51299e-01_r8, 1.53461e-01_r8, 1.55654e-01_r8, 1.57878e-01_r8, 1.60134e-01_r8, & + & 1.62422e-01_r8, 1.64744e-01_r8, 1.67098e-01_r8, 1.69486e-01_r8, 1.71908e-01_r8, & + & 1.74364e-01_r8, 1.76856e-01_r8, 1.79383e-01_r8, 1.81947e-01_r8, 1.84547e-01_r8, & + & 1.87184e-01_r8, 1.89859e-01_r8, 1.92572e-01_r8, 1.95324e-01_r8/) + kao_mo3( 8, :,15) = (/ & + & 1.51281e-01_r8, 1.53439e-01_r8, 1.55628e-01_r8, 1.57848e-01_r8, 1.60100e-01_r8, & + & 1.62384e-01_r8, 1.64700e-01_r8, 1.67049e-01_r8, 1.69432e-01_r8, 1.71849e-01_r8, & + & 1.74301e-01_r8, 1.76787e-01_r8, 1.79309e-01_r8, 1.81866e-01_r8, 1.84461e-01_r8, & + & 1.87092e-01_r8, 1.89761e-01_r8, 1.92468e-01_r8, 1.95213e-01_r8/) + kao_mo3( 9, :,15) = (/ & + & 2.44180e-01_r8, 2.35686e-01_r8, 2.27487e-01_r8, 2.19574e-01_r8, 2.11935e-01_r8, & + & 2.04563e-01_r8, 1.97447e-01_r8, 1.90578e-01_r8, 1.83949e-01_r8, 1.77550e-01_r8, & + & 1.71373e-01_r8, 1.65412e-01_r8, 1.59658e-01_r8, 1.54104e-01_r8, 1.48743e-01_r8, & + & 1.43569e-01_r8, 1.38574e-01_r8, 1.33754e-01_r8, 1.29101e-01_r8/) + kao_mo3( 1, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 2, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 3, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 4, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 5, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 6, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 7, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 8, :,16) = (/ & + & 1.02934e-01_r8, 1.04369e-01_r8, 1.05825e-01_r8, 1.07300e-01_r8, 1.08797e-01_r8, & + & 1.10314e-01_r8, 1.11852e-01_r8, 1.13412e-01_r8, 1.14993e-01_r8, 1.16597e-01_r8, & + & 1.18223e-01_r8, 1.19871e-01_r8, 1.21543e-01_r8, 1.23238e-01_r8, 1.24956e-01_r8, & + & 1.26699e-01_r8, 1.28466e-01_r8, 1.30257e-01_r8, 1.32073e-01_r8/) + kao_mo3( 9, :,16) = (/ & + & 3.91531e-01_r8, 3.78978e-01_r8, 3.66827e-01_r8, 3.55067e-01_r8, 3.43683e-01_r8, & + & 3.32664e-01_r8, 3.21999e-01_r8, 3.11675e-01_r8, 3.01683e-01_r8, 2.92011e-01_r8, & + & 2.82648e-01_r8, 2.73586e-01_r8, 2.64815e-01_r8, 2.56325e-01_r8, 2.48107e-01_r8, & + & 2.40152e-01_r8, 2.32453e-01_r8, 2.25000e-01_r8, 2.17787e-01_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &1.0689e-05_r8,1.6987e-05_r8,1.8993e-05_r8,3.4470e-05_r8,4.0873e-05_r8,4.8275e-05_r8, & + &6.1178e-05_r8,6.4035e-05_r8,6.6253e-05_r8,7.8914e-05_r8,8.1640e-05_r8,7.9738e-05_r8, & + &7.8492e-05_r8,9.1565e-05_r8,1.0262e-04_r8,1.0368e-04_r8/) + forrefo(2,:) = (/ & + &1.1194e-05_r8,1.6128e-05_r8,1.7213e-05_r8,2.6845e-05_r8,4.1361e-05_r8,5.1508e-05_r8, & + &6.8245e-05_r8,7.4063e-05_r8,7.6273e-05_r8,8.4061e-05_r8,8.2492e-05_r8,8.1720e-05_r8, & + &7.7626e-05_r8,1.0096e-04_r8,1.0519e-04_r8,1.0631e-04_r8/) + forrefo(3,:) = (/ & + &1.0891e-05_r8,1.4933e-05_r8,1.7964e-05_r8,2.2577e-05_r8,4.4290e-05_r8,5.4675e-05_r8, & + &7.2494e-05_r8,7.8410e-05_r8,7.6948e-05_r8,7.5742e-05_r8,7.7654e-05_r8,8.2760e-05_r8, & + &7.8443e-05_r8,9.8384e-05_r8,1.0634e-04_r8,1.0838e-04_r8/) + forrefo(4,:) = (/ & + &1.1316e-05_r8,1.5470e-05_r8,2.1246e-05_r8,3.3349e-05_r8,4.8704e-05_r8,5.6424e-05_r8, & + &5.8569e-05_r8,5.8780e-05_r8,6.0358e-05_r8,6.1586e-05_r8,6.4281e-05_r8,6.9333e-05_r8, & + &7.2763e-05_r8,7.2675e-05_r8,7.3754e-05_r8,1.0131e-04_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 1.27686e-01_r8, 1.09347e-01_r8, 9.36410e-02_r8, 8.01912e-02_r8, 6.86732e-02_r8, & + & 5.88096e-02_r8, 5.03627e-02_r8, 4.31290e-02_r8, 3.69343e-02_r8, 3.16294e-02_r8/) + selfrefo(:, 2) = (/ & + & 1.40051e-01_r8, 1.20785e-01_r8, 1.04170e-01_r8, 8.98402e-02_r8, 7.74816e-02_r8, & + & 6.68231e-02_r8, 5.76308e-02_r8, 4.97030e-02_r8, 4.28658e-02_r8, 3.69691e-02_r8/) + selfrefo(:, 3) = (/ & + & 1.42322e-01_r8, 1.22872e-01_r8, 1.06080e-01_r8, 9.15829e-02_r8, 7.90671e-02_r8, & + & 6.82616e-02_r8, 5.89329e-02_r8, 5.08790e-02_r8, 4.39258e-02_r8, 3.79228e-02_r8/) + selfrefo(:, 4) = (/ & + & 1.53244e-01_r8, 1.33057e-01_r8, 1.15530e-01_r8, 1.00311e-01_r8, 8.70977e-02_r8, & + & 7.56244e-02_r8, 6.56626e-02_r8, 5.70130e-02_r8, 4.95028e-02_r8, 4.29819e-02_r8/) + selfrefo(:, 5) = (/ & + & 1.71011e-01_r8, 1.46680e-01_r8, 1.25810e-01_r8, 1.07910e-01_r8, 9.25563e-02_r8, & + & 7.93874e-02_r8, 6.80922e-02_r8, 5.84040e-02_r8, 5.00943e-02_r8, 4.29669e-02_r8/) + selfrefo(:, 6) = (/ & + & 1.76012e-01_r8, 1.51010e-01_r8, 1.29560e-01_r8, 1.11157e-01_r8, 9.53672e-02_r8, & + & 8.18207e-02_r8, 7.01984e-02_r8, 6.02270e-02_r8, 5.16720e-02_r8, 4.43322e-02_r8/) + selfrefo(:, 7) = (/ & + & 1.85600e-01_r8, 1.59051e-01_r8, 1.36300e-01_r8, 1.16803e-01_r8, 1.00095e-01_r8, & + & 8.57776e-02_r8, 7.35077e-02_r8, 6.29930e-02_r8, 5.39823e-02_r8, 4.62606e-02_r8/) + selfrefo(:, 8) = (/ & + & 1.88931e-01_r8, 1.61727e-01_r8, 1.38440e-01_r8, 1.18506e-01_r8, 1.01442e-01_r8, & + & 8.68356e-02_r8, 7.43321e-02_r8, 6.36290e-02_r8, 5.44670e-02_r8, 4.66243e-02_r8/) + selfrefo(:, 9) = (/ & + & 1.91122e-01_r8, 1.63407e-01_r8, 1.39710e-01_r8, 1.19450e-01_r8, 1.02128e-01_r8, & + & 8.73176e-02_r8, 7.46552e-02_r8, 6.38290e-02_r8, 5.45728e-02_r8, 4.66589e-02_r8/) + selfrefo(:,10) = (/ & + & 1.91334e-01_r8, 1.64872e-01_r8, 1.42070e-01_r8, 1.22421e-01_r8, 1.05490e-01_r8, & + & 9.09008e-02_r8, 7.83291e-02_r8, 6.74960e-02_r8, 5.81612e-02_r8, 5.01174e-02_r8/) + selfrefo(:,11) = (/ & + & 1.89858e-01_r8, 1.63934e-01_r8, 1.41550e-01_r8, 1.22222e-01_r8, 1.05534e-01_r8, & + & 9.11237e-02_r8, 7.86814e-02_r8, 6.79380e-02_r8, 5.86615e-02_r8, 5.06517e-02_r8/) + selfrefo(:,12) = (/ & + & 1.89783e-01_r8, 1.63757e-01_r8, 1.41300e-01_r8, 1.21923e-01_r8, 1.05203e-01_r8, & + & 9.07760e-02_r8, 7.83274e-02_r8, 6.75860e-02_r8, 5.83176e-02_r8, 5.03202e-02_r8/) + selfrefo(:,13) = (/ & + & 1.87534e-01_r8, 1.62016e-01_r8, 1.39970e-01_r8, 1.20924e-01_r8, 1.04470e-01_r8, & + & 9.02541e-02_r8, 7.79730e-02_r8, 6.73630e-02_r8, 5.81967e-02_r8, 5.02778e-02_r8/) + selfrefo(:,14) = (/ & + & 1.99128e-01_r8, 1.71410e-01_r8, 1.47550e-01_r8, 1.27011e-01_r8, 1.09332e-01_r8, & + & 9.41131e-02_r8, 8.10128e-02_r8, 6.97360e-02_r8, 6.00289e-02_r8, 5.16731e-02_r8/) + selfrefo(:,15) = (/ & + & 1.99460e-01_r8, 1.72342e-01_r8, 1.48910e-01_r8, 1.28664e-01_r8, 1.11171e-01_r8, & + & 9.60560e-02_r8, 8.29962e-02_r8, 7.17120e-02_r8, 6.19620e-02_r8, 5.35376e-02_r8/) + selfrefo(:,16) = (/ & + & 1.99906e-01_r8, 1.72737e-01_r8, 1.49260e-01_r8, 1.28974e-01_r8, 1.11445e-01_r8, & + & 9.62982e-02_r8, 8.32102e-02_r8, 7.19010e-02_r8, 6.21288e-02_r8, 5.36848e-02_r8/) + + end subroutine lw_kgb05 + +! ************************************************************************** + subroutine lw_kgb06 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg06, only : fracrefao, kao, kao_mco2, selfrefo, forrefo, & + cfc11adjo, cfc12o + + implicit none + save + +! Planck fraction mapping level : P = 473.4280 mb, T = 259.83 K + fracrefao(:) = (/ & + & 1.4353e-01_r8,1.4774e-01_r8,1.4467e-01_r8,1.3785e-01_r8,1.2376e-01_r8,1.0214e-01_r8, & + & 8.1984e-02_r8,6.1152e-02_r8,4.0987e-02_r8,4.5067e-03_r8,4.0020e-03_r8,3.1772e-03_r8, & + & 2.3458e-03_r8,1.5025e-03_r8,5.7415e-04_r8,8.2970e-05_r8/) + +! Minor gas mapping level: +! lower - co2, p = 706.2720 mb, t = 294.2 k +! upper - cfc11, cfc12 + +! cfc11(:) = (/ & +! & 0., 0., 26.5435, 108.850, & +! & 58.7804, 54.0875, 41.1065, 35.6120, & +! & 41.2328, 47.7402, 79.1026, 64.3005, & +! & 108.206, 141.617, 186.565, 58.4782/) +! Original cfc11 is multiplied by 1.385 to account for the 1060-1107 cm-1 band. + + cfc11adjo(:) = (/ & + & 0._r8, 0._r8, 36.7627_r8, 150.757_r8, & + & 81.4109_r8, 74.9112_r8, 56.9325_r8, 49.3226_r8, & + & 57.1074_r8, 66.1202_r8, 109.557_r8, 89.0562_r8, & + & 149.865_r8, 196.140_r8, 258.393_r8, 80.9923_r8/) + cfc12o(:) = (/ & + & 62.8368_r8, 43.2626_r8, 26.7549_r8, 22.2487_r8, & + & 23.5029_r8, 34.8323_r8, 26.2335_r8, 23.2306_r8, & + & 18.4062_r8, 13.9534_r8, 22.6268_r8, 24.2604_r8, & + & 30.0088_r8, 26.3634_r8, 15.8237_r8, 57.5050_r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &1.5108e-05_r8,1.6223e-05_r8,1.5899e-05_r8,1.5254e-05_r8,1.4889e-05_r8/) + kao(:, 2, 1) = (/ & + &1.0690e-05_r8,1.0800e-05_r8,1.0568e-05_r8,1.0057e-05_r8,9.4945e-06_r8/) + kao(:, 3, 1) = (/ & + &6.1072e-06_r8,5.8741e-06_r8,5.6796e-06_r8,5.3664e-06_r8,5.4934e-06_r8/) + kao(:, 4, 1) = (/ & + &3.0372e-06_r8,2.9964e-06_r8,2.6541e-06_r8,2.8791e-06_r8,3.9638e-06_r8/) + kao(:, 5, 1) = (/ & + &1.4777e-06_r8,1.4916e-06_r8,1.4819e-06_r8,2.2264e-06_r8,3.3268e-06_r8/) + kao(:, 6, 1) = (/ & + &7.4936e-07_r8,7.2240e-07_r8,1.1518e-06_r8,1.7724e-06_r8,2.8203e-06_r8/) + kao(:, 7, 1) = (/ & + &3.4904e-07_r8,5.1177e-07_r8,8.8489e-07_r8,1.5219e-06_r8,2.2871e-06_r8/) + kao(:, 8, 1) = (/ & + &2.1072e-07_r8,4.5257e-07_r8,7.4214e-07_r8,1.2628e-06_r8,1.9840e-06_r8/) + kao(:, 9, 1) = (/ & + &2.1779e-07_r8,4.8639e-07_r8,8.1133e-07_r8,1.3719e-06_r8,2.1663e-06_r8/) + kao(:,10, 1) = (/ & + &2.5134e-07_r8,5.9583e-07_r8,1.0449e-06_r8,1.5899e-06_r8,2.7441e-06_r8/) + kao(:,11, 1) = (/ & + &2.9178e-07_r8,6.5749e-07_r8,1.0958e-06_r8,1.7834e-06_r8,3.1413e-06_r8/) + kao(:,12, 1) = (/ & + &2.7268e-07_r8,6.1470e-07_r8,1.0270e-06_r8,1.7566e-06_r8,3.0441e-06_r8/) + kao(:,13, 1) = (/ & + &2.2995e-07_r8,5.2185e-07_r8,8.7916e-07_r8,1.4999e-06_r8,2.5740e-06_r8/) + kao(:, 1, 2) = (/ & + &2.1301e-05_r8,2.3060e-05_r8,2.1909e-05_r8,2.0972e-05_r8,2.1772e-05_r8/) + kao(:, 2, 2) = (/ & + &1.4382e-05_r8,1.4147e-05_r8,1.4339e-05_r8,1.3679e-05_r8,1.6973e-05_r8/) + kao(:, 3, 2) = (/ & + &8.0559e-06_r8,8.4180e-06_r8,7.4096e-06_r8,9.3490e-06_r8,1.0824e-05_r8/) + kao(:, 4, 2) = (/ & + &4.3614e-06_r8,3.9657e-06_r8,5.1299e-06_r8,6.1754e-06_r8,8.2925e-06_r8/) + kao(:, 5, 2) = (/ & + &2.2350e-06_r8,2.3231e-06_r8,3.3297e-06_r8,4.8612e-06_r8,6.5883e-06_r8/) + kao(:, 6, 2) = (/ & + &1.0863e-06_r8,1.7510e-06_r8,2.4185e-06_r8,3.5854e-06_r8,5.1511e-06_r8/) + kao(:, 7, 2) = (/ & + &7.6749e-07_r8,1.2024e-06_r8,1.9782e-06_r8,2.7223e-06_r8,4.2604e-06_r8/) + kao(:, 8, 2) = (/ & + &6.8738e-07_r8,9.7505e-07_r8,1.6738e-06_r8,2.4371e-06_r8,3.9386e-06_r8/) + kao(:, 9, 2) = (/ & + &7.3668e-07_r8,1.0167e-06_r8,1.9026e-06_r8,3.0451e-06_r8,5.0060e-06_r8/) + kao(:,10, 2) = (/ & + &9.8863e-07_r8,1.5373e-06_r8,2.5876e-06_r8,4.8975e-06_r8,7.8206e-06_r8/) + kao(:,11, 2) = (/ & + &1.0934e-06_r8,1.6488e-06_r8,2.7961e-06_r8,5.2441e-06_r8,8.5410e-06_r8/) + kao(:,12, 2) = (/ & + &1.0277e-06_r8,1.5126e-06_r8,2.6342e-06_r8,4.9122e-06_r8,8.0730e-06_r8/) + kao(:,13, 2) = (/ & + &8.7381e-07_r8,1.2665e-06_r8,2.2835e-06_r8,4.2048e-06_r8,6.9189e-06_r8/) + kao(:, 1, 3) = (/ & + &2.3993e-05_r8,2.2308e-05_r8,2.5893e-05_r8,3.3883e-05_r8,3.8280e-05_r8/) + kao(:, 2, 3) = (/ & + &1.4011e-05_r8,1.4296e-05_r8,2.1223e-05_r8,2.4417e-05_r8,2.7881e-05_r8/) + kao(:, 3, 3) = (/ & + &7.3965e-06_r8,9.9180e-06_r8,1.3735e-05_r8,1.4536e-05_r8,1.8056e-05_r8/) + kao(:, 4, 3) = (/ & + &4.5365e-06_r8,7.0513e-06_r8,7.2165e-06_r8,9.8585e-06_r8,1.1890e-05_r8/) + kao(:, 5, 3) = (/ & + &3.8953e-06_r8,4.3626e-06_r8,5.3805e-06_r8,6.6118e-06_r8,9.5204e-06_r8/) + kao(:, 6, 3) = (/ & + &2.4692e-06_r8,2.6620e-06_r8,3.5833e-06_r8,5.1748e-06_r8,7.8116e-06_r8/) + kao(:, 7, 3) = (/ & + &1.4531e-06_r8,2.0753e-06_r8,2.7794e-06_r8,4.8340e-06_r8,7.5049e-06_r8/) + kao(:, 8, 3) = (/ & + &8.9161e-07_r8,1.6554e-06_r8,2.7945e-06_r8,4.7401e-06_r8,7.3008e-06_r8/) + kao(:, 9, 3) = (/ & + &1.1556e-06_r8,2.3050e-06_r8,3.6767e-06_r8,6.4276e-06_r8,1.0393e-05_r8/) + kao(:,10, 3) = (/ & + &1.3936e-06_r8,2.7867e-06_r8,4.8066e-06_r8,7.9343e-06_r8,1.4027e-05_r8/) + kao(:,11, 3) = (/ & + &1.4469e-06_r8,3.0966e-06_r8,5.3467e-06_r8,9.2496e-06_r8,1.6488e-05_r8/) + kao(:,12, 3) = (/ & + &1.3797e-06_r8,2.9577e-06_r8,5.1784e-06_r8,9.2835e-06_r8,1.6169e-05_r8/) + kao(:,13, 3) = (/ & + &1.1793e-06_r8,2.5194e-06_r8,4.4903e-06_r8,8.2145e-06_r8,1.4209e-05_r8/) + kao(:, 1, 4) = (/ & + &4.3371e-05_r8,4.2284e-05_r8,4.2569e-05_r8,4.5333e-05_r8,4.9887e-05_r8/) + kao(:, 2, 4) = (/ & + &2.7836e-05_r8,3.0742e-05_r8,2.5159e-05_r8,3.1058e-05_r8,3.3502e-05_r8/) + kao(:, 3, 4) = (/ & + &1.5959e-05_r8,1.5689e-05_r8,1.8607e-05_r8,1.9311e-05_r8,2.2949e-05_r8/) + kao(:, 4, 4) = (/ & + &9.4357e-06_r8,8.9581e-06_r8,1.1706e-05_r8,1.2462e-05_r8,1.9504e-05_r8/) + kao(:, 5, 4) = (/ & + &4.6991e-06_r8,5.9565e-06_r8,7.1131e-06_r8,1.0656e-05_r8,1.6961e-05_r8/) + kao(:, 6, 4) = (/ & + &2.9104e-06_r8,3.9977e-06_r8,5.8385e-06_r8,9.8483e-06_r8,1.4910e-05_r8/) + kao(:, 7, 4) = (/ & + &2.0404e-06_r8,2.7360e-06_r8,5.0537e-06_r8,8.2979e-06_r8,1.2550e-05_r8/) + kao(:, 8, 4) = (/ & + &1.7124e-06_r8,2.7023e-06_r8,4.6383e-06_r8,7.6524e-06_r8,1.2059e-05_r8/) + kao(:, 9, 4) = (/ & + &1.7855e-06_r8,3.1326e-06_r8,5.8535e-06_r8,9.7627e-06_r8,1.5447e-05_r8/) + kao(:,10, 4) = (/ & + &2.2188e-06_r8,4.3098e-06_r8,8.7192e-06_r8,1.5363e-05_r8,2.4174e-05_r8/) + kao(:,11, 4) = (/ & + &2.5395e-06_r8,4.8780e-06_r8,1.0119e-05_r8,1.6942e-05_r8,2.6266e-05_r8/) + kao(:,12, 4) = (/ & + &2.4951e-06_r8,4.8859e-06_r8,9.7649e-06_r8,1.6137e-05_r8,2.5091e-05_r8/) + kao(:,13, 4) = (/ & + &2.2608e-06_r8,4.4391e-06_r8,8.5101e-06_r8,1.3874e-05_r8,2.1718e-05_r8/) + kao(:, 1, 5) = (/ & + &3.5802e-05_r8,4.9569e-05_r8,5.6081e-05_r8,5.4456e-05_r8,6.1620e-05_r8/) + kao(:, 2, 5) = (/ & + &2.7431e-05_r8,3.7092e-05_r8,4.0464e-05_r8,4.0603e-05_r8,5.2992e-05_r8/) + kao(:, 3, 5) = (/ & + &1.6511e-05_r8,2.1182e-05_r8,1.9952e-05_r8,2.9271e-05_r8,4.8230e-05_r8/) + kao(:, 4, 5) = (/ & + &1.1211e-05_r8,1.2922e-05_r8,1.4441e-05_r8,2.5935e-05_r8,3.8342e-05_r8/) + kao(:, 5, 5) = (/ & + &7.1937e-06_r8,7.6149e-06_r8,1.2471e-05_r8,2.1334e-05_r8,3.0465e-05_r8/) + kao(:, 6, 5) = (/ & + &4.6613e-06_r8,5.5104e-06_r8,1.0664e-05_r8,1.6922e-05_r8,2.4802e-05_r8/) + kao(:, 7, 5) = (/ & + &2.6908e-06_r8,5.1362e-06_r8,9.2865e-06_r8,1.4719e-05_r8,2.2004e-05_r8/) + kao(:, 8, 5) = (/ & + &2.4192e-06_r8,4.7977e-06_r8,8.6605e-06_r8,1.4122e-05_r8,2.1533e-05_r8/) + kao(:, 9, 5) = (/ & + &2.6505e-06_r8,5.2138e-06_r8,9.6090e-06_r8,1.6493e-05_r8,2.6941e-05_r8/) + kao(:,10, 5) = (/ & + &3.8793e-06_r8,7.0191e-06_r8,1.2677e-05_r8,2.2456e-05_r8,3.8574e-05_r8/) + kao(:,11, 5) = (/ & + &4.3385e-06_r8,8.1555e-06_r8,1.4661e-05_r8,2.7034e-05_r8,4.5538e-05_r8/) + kao(:,12, 5) = (/ & + &4.4806e-06_r8,8.0941e-06_r8,1.5170e-05_r8,2.7140e-05_r8,4.7747e-05_r8/) + kao(:,13, 5) = (/ & + &4.0859e-06_r8,7.4306e-06_r8,1.3915e-05_r8,2.5201e-05_r8,4.3638e-05_r8/) + kao(:, 1, 6) = (/ & + &6.3502e-05_r8,6.1626e-05_r8,6.7874e-05_r8,7.9926e-05_r8,1.4827e-04_r8/) + kao(:, 2, 6) = (/ & + &4.2546e-05_r8,3.3547e-05_r8,4.0025e-05_r8,7.0944e-05_r8,1.2242e-04_r8/) + kao(:, 3, 6) = (/ & + &2.4414e-05_r8,2.4466e-05_r8,3.6681e-05_r8,6.7397e-05_r8,9.7673e-05_r8/) + kao(:, 4, 6) = (/ & + &1.1878e-05_r8,1.6683e-05_r8,3.4310e-05_r8,5.3734e-05_r8,7.4953e-05_r8/) + kao(:, 5, 6) = (/ & + &8.0437e-06_r8,1.5133e-05_r8,2.7743e-05_r8,4.0147e-05_r8,5.6233e-05_r8/) + kao(:, 6, 6) = (/ & + &6.1550e-06_r8,1.2316e-05_r8,1.9945e-05_r8,3.0529e-05_r8,4.5113e-05_r8/) + kao(:, 7, 6) = (/ & + &4.8891e-06_r8,9.6377e-06_r8,1.6338e-05_r8,2.4863e-05_r8,3.7137e-05_r8/) + kao(:, 8, 6) = (/ & + &4.3692e-06_r8,8.7526e-06_r8,1.4669e-05_r8,2.2987e-05_r8,3.5150e-05_r8/) + kao(:, 9, 6) = (/ & + &5.3838e-06_r8,1.0727e-05_r8,1.8376e-05_r8,3.0485e-05_r8,4.8603e-05_r8/) + kao(:,10, 6) = (/ & + &6.7708e-06_r8,1.4529e-05_r8,2.6810e-05_r8,4.7617e-05_r8,7.8536e-05_r8/) + kao(:,11, 6) = (/ & + &8.3666e-06_r8,1.7190e-05_r8,3.3330e-05_r8,5.7837e-05_r8,9.5886e-05_r8/) + kao(:,12, 6) = (/ & + &8.6264e-06_r8,1.8503e-05_r8,3.4797e-05_r8,6.1435e-05_r8,1.0046e-04_r8/) + kao(:,13, 6) = (/ & + &8.2669e-06_r8,1.8055e-05_r8,3.3739e-05_r8,5.7805e-05_r8,9.4677e-05_r8/) + kao(:, 1, 7) = (/ & + &5.0894e-05_r8,6.7019e-05_r8,1.1702e-04_r8,2.4649e-04_r8,3.5046e-04_r8/) + kao(:, 2, 7) = (/ & + &4.3304e-05_r8,4.9708e-05_r8,1.0701e-04_r8,1.8228e-04_r8,2.5635e-04_r8/) + kao(:, 3, 7) = (/ & + &2.6855e-05_r8,4.5972e-05_r8,9.9426e-05_r8,1.4867e-04_r8,2.0722e-04_r8/) + kao(:, 4, 7) = (/ & + &2.0223e-05_r8,4.9973e-05_r8,8.2293e-05_r8,1.1822e-04_r8,1.6484e-04_r8/) + kao(:, 5, 7) = (/ & + &1.8923e-05_r8,4.1445e-05_r8,6.4003e-05_r8,9.2899e-05_r8,1.3171e-04_r8/) + kao(:, 6, 7) = (/ & + &1.5326e-05_r8,3.0718e-05_r8,4.7457e-05_r8,6.8025e-05_r8,9.5982e-05_r8/) + kao(:, 7, 7) = (/ & + &1.2448e-05_r8,2.1715e-05_r8,3.2987e-05_r8,4.9690e-05_r8,7.5010e-05_r8/) + kao(:, 8, 7) = (/ & + &1.0066e-05_r8,1.7102e-05_r8,2.7164e-05_r8,4.3976e-05_r8,6.9078e-05_r8/) + kao(:, 9, 7) = (/ & + &1.1685e-05_r8,2.0037e-05_r8,3.5620e-05_r8,5.8499e-05_r8,9.0997e-05_r8/) + kao(:,10, 7) = (/ & + &1.5861e-05_r8,2.8659e-05_r8,5.0802e-05_r8,8.4995e-05_r8,1.3698e-04_r8/) + kao(:,11, 7) = (/ & + &2.1379e-05_r8,3.8980e-05_r8,6.8341e-05_r8,1.1084e-04_r8,1.6745e-04_r8/) + kao(:,12, 7) = (/ & + &2.2487e-05_r8,4.0976e-05_r8,7.1749e-05_r8,1.1325e-04_r8,1.7051e-04_r8/) + kao(:,13, 7) = (/ & + &2.0952e-05_r8,3.7773e-05_r8,6.5636e-05_r8,1.0928e-04_r8,1.6488e-04_r8/) + kao(:, 1, 8) = (/ & + &1.0722e-04_r8,2.7983e-04_r8,4.9965e-04_r8,7.0430e-04_r8,9.5168e-04_r8/) + kao(:, 2, 8) = (/ & + &9.2566e-05_r8,2.4429e-04_r8,3.9143e-04_r8,5.5037e-04_r8,7.4482e-04_r8/) + kao(:, 3, 8) = (/ & + &8.2611e-05_r8,1.7009e-04_r8,2.5121e-04_r8,3.5806e-04_r8,4.9588e-04_r8/) + kao(:, 4, 8) = (/ & + &7.9199e-05_r8,1.3718e-04_r8,2.0767e-04_r8,3.0111e-04_r8,4.2301e-04_r8/) + kao(:, 5, 8) = (/ & + &6.6965e-05_r8,1.0994e-04_r8,1.6780e-04_r8,2.4484e-04_r8,3.4718e-04_r8/) + kao(:, 6, 8) = (/ & + &5.1557e-05_r8,8.4788e-05_r8,1.3259e-04_r8,1.9727e-04_r8,2.8537e-04_r8/) + kao(:, 7, 8) = (/ & + &3.8653e-05_r8,6.5013e-05_r8,1.0364e-04_r8,1.5866e-04_r8,2.2830e-04_r8/) + kao(:, 8, 8) = (/ & + &2.8949e-05_r8,4.9620e-05_r8,8.2718e-05_r8,1.3000e-04_r8,1.9256e-04_r8/) + kao(:, 9, 8) = (/ & + &2.6449e-05_r8,4.6951e-05_r8,7.7311e-05_r8,1.2263e-04_r8,1.9501e-04_r8/) + kao(:,10, 8) = (/ & + &4.1706e-05_r8,7.2947e-05_r8,1.1853e-04_r8,1.7821e-04_r8,2.7161e-04_r8/) + kao(:,11, 8) = (/ & + &4.6073e-05_r8,7.9291e-05_r8,1.2399e-04_r8,2.0469e-04_r8,3.0165e-04_r8/) + kao(:,12, 8) = (/ & + &4.9634e-05_r8,8.1819e-05_r8,1.2723e-04_r8,2.1479e-04_r8,3.2406e-04_r8/) + kao(:,13, 8) = (/ & + &4.8914e-05_r8,8.2845e-05_r8,1.3095e-04_r8,2.1611e-04_r8,3.1389e-04_r8/) + kao(:, 1, 9) = (/ & + &7.8561e-04_r8,1.1643e-03_r8,1.6394e-03_r8,2.2582e-03_r8,3.0560e-03_r8/) + kao(:, 2, 9) = (/ & + &6.6025e-04_r8,9.8571e-04_r8,1.4034e-03_r8,1.9479e-03_r8,2.6634e-03_r8/) + kao(:, 3, 9) = (/ & + &5.1307e-04_r8,7.6204e-04_r8,1.0925e-03_r8,1.5312e-03_r8,2.1163e-03_r8/) + kao(:, 4, 9) = (/ & + &3.4762e-04_r8,5.0219e-04_r8,7.2255e-04_r8,1.0302e-03_r8,1.4514e-03_r8/) + kao(:, 5, 9) = (/ & + &2.1712e-04_r8,3.4419e-04_r8,5.2965e-04_r8,7.8732e-04_r8,1.1464e-03_r8/) + kao(:, 6, 9) = (/ & + &1.8112e-04_r8,2.9769e-04_r8,4.6916e-04_r8,7.0360e-04_r8,1.0307e-03_r8/) + kao(:, 7, 9) = (/ & + &1.5449e-04_r8,2.5935e-04_r8,4.1089e-04_r8,6.2682e-04_r8,9.3587e-04_r8/) + kao(:, 8, 9) = (/ & + &1.4056e-04_r8,2.4062e-04_r8,3.8562e-04_r8,5.9348e-04_r8,8.8749e-04_r8/) + kao(:, 9, 9) = (/ & + &1.4311e-04_r8,2.5683e-04_r8,4.3997e-04_r8,6.9753e-04_r8,1.0500e-03_r8/) + kao(:,10, 9) = (/ & + &1.3733e-04_r8,2.3478e-04_r8,3.4047e-04_r8,4.8048e-04_r8,6.5263e-04_r8/) + kao(:,11, 9) = (/ & + &1.3199e-04_r8,1.9086e-04_r8,2.6427e-04_r8,3.3652e-04_r8,4.6218e-04_r8/) + kao(:,12, 9) = (/ & + &1.2421e-04_r8,1.8123e-04_r8,2.4759e-04_r8,3.0949e-04_r8,4.1038e-04_r8/) + kao(:,13, 9) = (/ & + &1.2135e-04_r8,1.9021e-04_r8,2.6678e-04_r8,3.4185e-04_r8,4.8239e-04_r8/) + kao(:, 1,10) = (/ & + &2.0319e-03_r8,2.8954e-03_r8,4.0208e-03_r8,5.4666e-03_r8,7.2307e-03_r8/) + kao(:, 2,10) = (/ & + &1.8594e-03_r8,2.6055e-03_r8,3.5896e-03_r8,4.9149e-03_r8,6.5643e-03_r8/) + kao(:, 3,10) = (/ & + &1.4858e-03_r8,2.1438e-03_r8,3.0067e-03_r8,4.1237e-03_r8,5.5345e-03_r8/) + kao(:, 4,10) = (/ & + &1.1237e-03_r8,1.6648e-03_r8,2.4078e-03_r8,3.3725e-03_r8,4.5628e-03_r8/) + kao(:, 5,10) = (/ & + &8.5681e-04_r8,1.0371e-03_r8,1.2665e-03_r8,1.6242e-03_r8,2.0962e-03_r8/) + kao(:, 6,10) = (/ & + &4.1878e-04_r8,6.5245e-04_r8,8.8673e-04_r8,1.4273e-03_r8,2.1165e-03_r8/) + kao(:, 7,10) = (/ & + &4.0657e-04_r8,6.7784e-04_r8,1.0299e-03_r8,1.5982e-03_r8,2.4416e-03_r8/) + kao(:, 8,10) = (/ & + &3.7189e-04_r8,6.5876e-04_r8,1.1259e-03_r8,1.8690e-03_r8,2.8514e-03_r8/) + kao(:, 9,10) = (/ & + &4.4113e-04_r8,8.4598e-04_r8,1.1991e-03_r8,1.8860e-03_r8,2.5835e-03_r8/) + kao(:,10,10) = (/ & + &1.8203e-04_r8,4.6909e-06_r8,8.8196e-06_r8,8.3149e-05_r8,1.6489e-04_r8/) + kao(:,11,10) = (/ & + &2.4843e-06_r8,5.0211e-06_r8,4.0342e-05_r8,1.0733e-04_r8,1.3735e-04_r8/) + kao(:,12,10) = (/ & + &2.2109e-06_r8,4.6775e-06_r8,6.3563e-05_r8,8.8385e-05_r8,1.1814e-04_r8/) + kao(:,13,10) = (/ & + &1.0306e-04_r8,2.9167e-05_r8,5.8184e-05_r8,8.2616e-05_r8,1.2141e-04_r8/) + kao(:, 1,11) = (/ & + &2.6851e-03_r8,3.8621e-03_r8,5.3296e-03_r8,7.1411e-03_r8,9.4750e-03_r8/) + kao(:, 2,11) = (/ & + &2.4213e-03_r8,3.4979e-03_r8,4.8929e-03_r8,6.6432e-03_r8,8.8031e-03_r8/) + kao(:, 3,11) = (/ & + &2.0817e-03_r8,2.9708e-03_r8,4.1510e-03_r8,5.7232e-03_r8,7.7624e-03_r8/) + kao(:, 4,11) = (/ & + &1.6627e-03_r8,2.4521e-03_r8,3.4576e-03_r8,4.7721e-03_r8,6.5543e-03_r8/) + kao(:, 5,11) = (/ & + &1.2664e-03_r8,1.9577e-03_r8,2.8702e-03_r8,4.0767e-03_r8,5.5807e-03_r8/) + kao(:, 6,11) = (/ & + &6.5451e-04_r8,7.6752e-04_r8,1.2109e-03_r8,1.8526e-03_r8,2.8298e-03_r8/) + kao(:, 7,11) = (/ & + &4.8621e-04_r8,7.7329e-04_r8,1.3520e-03_r8,2.1779e-03_r8,3.1034e-03_r8/) + kao(:, 8,11) = (/ & + &4.3573e-04_r8,8.1759e-04_r8,1.5409e-03_r8,2.1798e-03_r8,3.1170e-03_r8/) + kao(:, 9,11) = (/ & + &5.3220e-04_r8,6.5242e-04_r8,1.0365e-03_r8,8.6351e-04_r8,8.5932e-04_r8/) + kao(:,10,11) = (/ & + &4.1711e-06_r8,8.9963e-06_r8,1.7277e-05_r8,3.1054e-05_r8,5.1955e-05_r8/) + kao(:,11,11) = (/ & + &4.2641e-06_r8,9.2786e-06_r8,1.7917e-05_r8,3.2294e-05_r8,1.1099e-04_r8/) + kao(:,12,11) = (/ & + &4.4244e-06_r8,9.4799e-06_r8,1.8618e-05_r8,7.5019e-05_r8,1.5478e-04_r8/) + kao(:,13,11) = (/ & + &4.4439e-06_r8,9.5554e-06_r8,3.7663e-05_r8,9.5587e-05_r8,1.4453e-04_r8/) + kao(:, 1,12) = (/ & + &3.5676e-03_r8,4.9715e-03_r8,6.8023e-03_r8,9.2475e-03_r8,1.2425e-02_r8/) + kao(:, 2,12) = (/ & + &3.3730e-03_r8,4.7958e-03_r8,6.6635e-03_r8,9.0736e-03_r8,1.2194e-02_r8/) + kao(:, 3,12) = (/ & + &2.8824e-03_r8,4.1856e-03_r8,5.9756e-03_r8,8.2464e-03_r8,1.1067e-02_r8/) + kao(:, 4,12) = (/ & + &2.4288e-03_r8,3.5141e-03_r8,5.0677e-03_r8,7.1261e-03_r8,9.7127e-03_r8/) + kao(:, 5,12) = (/ & + &1.9807e-03_r8,2.9284e-03_r8,4.2016e-03_r8,5.9142e-03_r8,8.1484e-03_r8/) + kao(:, 6,12) = (/ & + &1.4728e-03_r8,2.2453e-03_r8,3.0533e-03_r8,3.8340e-03_r8,4.6395e-03_r8/) + kao(:, 7,12) = (/ & + &5.6245e-04_r8,9.9265e-04_r8,1.6138e-03_r8,2.6180e-03_r8,3.5983e-03_r8/) + kao(:, 8,12) = (/ & + &5.6232e-04_r8,1.0725e-03_r8,1.5736e-03_r8,2.7015e-03_r8,4.5325e-03_r8/) + kao(:, 9,12) = (/ & + &3.8503e-04_r8,4.5325e-04_r8,3.4069e-05_r8,5.9217e-05_r8,9.6016e-05_r8/) + kao(:,10,12) = (/ & + &6.7276e-06_r8,1.4849e-05_r8,2.8992e-05_r8,5.2371e-05_r8,8.7139e-05_r8/) + kao(:,11,12) = (/ & + &7.7381e-06_r8,1.7002e-05_r8,3.3523e-05_r8,6.0232e-05_r8,1.0004e-04_r8/) + kao(:,12,12) = (/ & + &8.5790e-06_r8,1.9107e-05_r8,3.7746e-05_r8,6.8157e-05_r8,1.1211e-04_r8/) + kao(:,13,12) = (/ & + &9.3399e-06_r8,2.1875e-05_r8,4.3407e-05_r8,7.7729e-05_r8,1.5956e-04_r8/) + kao(:, 1,13) = (/ & + &4.3788e-03_r8,6.3181e-03_r8,8.9543e-03_r8,1.2364e-02_r8,1.6648e-02_r8/) + kao(:, 2,13) = (/ & + &4.4160e-03_r8,6.2758e-03_r8,8.7769e-03_r8,1.2121e-02_r8,1.6531e-02_r8/) + kao(:, 3,13) = (/ & + &3.9967e-03_r8,5.8737e-03_r8,8.1369e-03_r8,1.1188e-02_r8,1.5344e-02_r8/) + kao(:, 4,13) = (/ & + &3.4004e-03_r8,5.1547e-03_r8,7.3735e-03_r8,1.0182e-02_r8,1.3939e-02_r8/) + kao(:, 5,13) = (/ & + &2.9021e-03_r8,4.3823e-03_r8,6.4495e-03_r8,9.1509e-03_r8,1.2669e-02_r8/) + kao(:, 6,13) = (/ & + &2.4396e-03_r8,3.6407e-03_r8,5.2497e-03_r8,7.5439e-03_r8,1.0675e-02_r8/) + kao(:, 7,13) = (/ & + &1.5932e-03_r8,1.8719e-03_r8,2.2033e-03_r8,2.5091e-03_r8,4.1046e-03_r8/) + kao(:, 8,13) = (/ & + &8.1439e-04_r8,1.2125e-03_r8,1.8190e-03_r8,2.8987e-03_r8,3.6148e-03_r8/) + kao(:, 9,13) = (/ & + &2.9962e-04_r8,2.5888e-05_r8,4.6085e-05_r8,7.7045e-05_r8,1.2285e-04_r8/) + kao(:,10,13) = (/ & + &9.2091e-06_r8,1.8817e-05_r8,3.5290e-05_r8,6.2611e-05_r8,1.0050e-04_r8/) + kao(:,11,13) = (/ & + &8.8922e-06_r8,1.8844e-05_r8,3.7039e-05_r8,6.5193e-05_r8,1.0998e-04_r8/) + kao(:,12,13) = (/ & + &9.1227e-06_r8,2.0282e-05_r8,3.9304e-05_r8,7.0536e-05_r8,1.1697e-04_r8/) + kao(:,13,13) = (/ & + &9.3384e-06_r8,2.0460e-05_r8,4.0361e-05_r8,7.2805e-05_r8,1.1815e-04_r8/) + kao(:, 1,14) = (/ & + &5.8176e-03_r8,8.5593e-03_r8,1.2130e-02_r8,1.6770e-02_r8,2.2682e-02_r8/) + kao(:, 2,14) = (/ & + &5.7661e-03_r8,8.5728e-03_r8,1.2312e-02_r8,1.7131e-02_r8,2.3220e-02_r8/) + kao(:, 3,14) = (/ & + &5.4299e-03_r8,7.9187e-03_r8,1.1613e-02_r8,1.6480e-02_r8,2.2670e-02_r8/) + kao(:, 4,14) = (/ & + &4.9805e-03_r8,7.1731e-03_r8,1.0470e-02_r8,1.5114e-02_r8,2.1203e-02_r8/) + kao(:, 5,14) = (/ & + &4.4098e-03_r8,6.5055e-03_r8,9.4518e-03_r8,1.3613e-02_r8,1.9313e-02_r8/) + kao(:, 6,14) = (/ & + &3.7762e-03_r8,5.6862e-03_r8,8.4288e-03_r8,1.2169e-02_r8,1.7260e-02_r8/) + kao(:, 7,14) = (/ & + &3.2464e-03_r8,4.8124e-03_r8,6.8092e-03_r8,9.1900e-03_r8,1.1370e-02_r8/) + kao(:, 8,14) = (/ & + &1.1521e-03_r8,1.1423e-03_r8,1.7687e-03_r8,1.5659e-03_r8,2.2329e-03_r8/) + kao(:, 9,14) = (/ & + &1.9075e-05_r8,4.4531e-05_r8,8.9053e-05_r8,1.1868e-04_r8,1.6905e-04_r8/) + kao(:,10,14) = (/ & + &1.1271e-05_r8,2.8156e-05_r8,6.0244e-05_r8,8.6340e-05_r8,1.3123e-04_r8/) + kao(:,11,14) = (/ & + &1.1591e-05_r8,2.8030e-05_r8,4.8484e-05_r8,7.4281e-05_r8,1.1022e-04_r8/) + kao(:,12,14) = (/ & + &1.1274e-05_r8,2.5700e-05_r8,4.0234e-05_r8,6.2656e-05_r8,9.8261e-05_r8/) + kao(:,13,14) = (/ & + &1.0130e-05_r8,1.8686e-05_r8,3.2466e-05_r8,5.4260e-05_r8,8.5980e-05_r8/) + kao(:, 1,15) = (/ & + &8.0623e-03_r8,1.1623e-02_r8,1.6754e-02_r8,2.3990e-02_r8,3.4103e-02_r8/) + kao(:, 2,15) = (/ & + &8.1053e-03_r8,1.1698e-02_r8,1.6865e-02_r8,2.3848e-02_r8,3.3543e-02_r8/) + kao(:, 3,15) = (/ & + &7.5058e-03_r8,1.0852e-02_r8,1.5814e-02_r8,2.2160e-02_r8,3.0813e-02_r8/) + kao(:, 4,15) = (/ & + &6.7816e-03_r8,9.9478e-03_r8,1.4382e-02_r8,2.0576e-02_r8,2.8388e-02_r8/) + kao(:, 5,15) = (/ & + &6.3211e-03_r8,9.1146e-03_r8,1.3301e-02_r8,1.9331e-02_r8,2.6874e-02_r8/) + kao(:, 6,15) = (/ & + &5.8531e-03_r8,8.4323e-03_r8,1.2188e-02_r8,1.7787e-02_r8,2.5518e-02_r8/) + kao(:, 7,15) = (/ & + &5.3028e-03_r8,7.8385e-03_r8,1.1331e-02_r8,1.6285e-02_r8,2.3804e-02_r8/) + kao(:, 8,15) = (/ & + &4.7139e-03_r8,4.9648e-03_r8,2.7936e-03_r8,2.1248e-03_r8,1.7982e-03_r8/) + kao(:, 9,15) = (/ & + &6.9507e-07_r8,1.4412e-06_r8,2.8345e-06_r8,1.0911e-04_r8,2.4370e-04_r8/) + kao(:,10,15) = (/ & + &3.6501e-07_r8,8.3446e-07_r8,1.6843e-06_r8,6.4065e-05_r8,1.5410e-04_r8/) + kao(:,11,15) = (/ & + &2.8886e-07_r8,6.6813e-07_r8,2.2629e-05_r8,7.8818e-05_r8,1.6163e-04_r8/) + kao(:,12,15) = (/ & + &2.6037e-07_r8,5.5485e-07_r8,3.1734e-05_r8,8.0123e-05_r8,1.4669e-04_r8/) + kao(:,13,15) = (/ & + &2.3446e-07_r8,1.2097e-05_r8,3.4961e-05_r8,7.1280e-05_r8,1.2611e-04_r8/) + kao(:, 1,16) = (/ & + &8.7570e-03_r8,1.2357e-02_r8,1.9959e-02_r8,3.2636e-02_r8,5.0897e-02_r8/) + kao(:, 2,16) = (/ & + &9.0825e-03_r8,1.2808e-02_r8,1.9776e-02_r8,3.3132e-02_r8,5.2704e-02_r8/) + kao(:, 3,16) = (/ & + &8.8201e-03_r8,1.2594e-02_r8,1.7588e-02_r8,3.0181e-02_r8,4.9544e-02_r8/) + kao(:, 4,16) = (/ & + &8.3170e-03_r8,1.2140e-02_r8,1.6975e-02_r8,2.5787e-02_r8,4.3638e-02_r8/) + kao(:, 5,16) = (/ & + &7.7605e-03_r8,1.1646e-02_r8,1.6641e-02_r8,2.2927e-02_r8,3.7740e-02_r8/) + kao(:, 6,16) = (/ & + &7.0356e-03_r8,1.0930e-02_r8,1.6057e-02_r8,2.2523e-02_r8,3.2226e-02_r8/) + kao(:, 7,16) = (/ & + &6.7105e-03_r8,1.0123e-02_r8,1.5354e-02_r8,2.2098e-02_r8,3.0452e-02_r8/) + kao(:, 8,16) = (/ & + &6.7590e-03_r8,9.3669e-03_r8,1.4563e-02_r8,1.3873e-02_r8,1.5872e-03_r8/) + kao(:, 9,16) = (/ & + &5.9690e-07_r8,1.4246e-06_r8,2.9975e-06_r8,4.2222e-06_r8,7.0710e-06_r8/) + kao(:,10,16) = (/ & + &3.1073e-07_r8,7.7259e-07_r8,1.8451e-06_r8,3.5923e-06_r8,5.6864e-06_r8/) + kao(:,11,16) = (/ & + &2.5196e-07_r8,6.5326e-07_r8,1.5669e-06_r8,3.1861e-06_r8,5.6813e-06_r8/) + kao(:,12,16) = (/ & + &1.8633e-07_r8,5.5942e-07_r8,1.3020e-06_r8,2.7030e-06_r8,4.5791e-06_r8/) + kao(:,13,16) = (/ & + &1.4070e-07_r8,4.5125e-07_r8,1.0269e-06_r8,2.1236e-06_r8,3.8826e-06_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kao_mco2(:, 1) = (/ & + & 1.45661e-05_r8, 1.73337e-05_r8, 2.06273e-05_r8, 2.45466e-05_r8, 2.92105e-05_r8, & + & 3.47607e-05_r8, 4.13654e-05_r8, 4.92251e-05_r8, 5.85781e-05_r8, 6.97083e-05_r8, & + & 8.29533e-05_r8, 9.87149e-05_r8, 1.17471e-04_r8, 1.39792e-04_r8, 1.66353e-04_r8, & + & 1.97961e-04_r8, 2.35574e-04_r8, 2.80335e-04_r8, 3.33600e-04_r8/) + kao_mco2(:, 2) = (/ & + & 9.96332e-06_r8, 1.21229e-05_r8, 1.47506e-05_r8, 1.79478e-05_r8, 2.18381e-05_r8, & + & 2.65716e-05_r8, 3.23310e-05_r8, 3.93389e-05_r8, 4.78658e-05_r8, 5.82408e-05_r8, & + & 7.08647e-05_r8, 8.62250e-05_r8, 1.04914e-04_r8, 1.27655e-04_r8, 1.55325e-04_r8, & + & 1.88992e-04_r8, 2.29957e-04_r8, 2.79801e-04_r8, 3.40448e-04_r8/) + kao_mco2(:, 3) = (/ & + & 1.14968e-05_r8, 1.39890e-05_r8, 1.70215e-05_r8, 2.07115e-05_r8, 2.52013e-05_r8, & + & 3.06644e-05_r8, 3.73118e-05_r8, 4.54002e-05_r8, 5.52420e-05_r8, 6.72173e-05_r8, & + & 8.17887e-05_r8, 9.95188e-05_r8, 1.21092e-04_r8, 1.47343e-04_r8, 1.79283e-04_r8, & + & 2.18148e-04_r8, 2.65438e-04_r8, 3.22980e-04_r8, 3.92995e-04_r8/) + kao_mco2(:, 4) = (/ & + & 1.02186e-05_r8, 1.23232e-05_r8, 1.48613e-05_r8, 1.79222e-05_r8, 2.16134e-05_r8, & + & 2.60649e-05_r8, 3.14332e-05_r8, 3.79071e-05_r8, 4.57145e-05_r8, 5.51297e-05_r8, & + & 6.64843e-05_r8, 8.01773e-05_r8, 9.66905e-05_r8, 1.16605e-04_r8, 1.40621e-04_r8, & + & 1.69583e-04_r8, 2.04510e-04_r8, 2.46631e-04_r8, 2.97426e-04_r8/) + kao_mco2(:, 5) = (/ & + & 1.03469e-05_r8, 1.24680e-05_r8, 1.50239e-05_r8, 1.81037e-05_r8, 2.18149e-05_r8, & + & 2.62869e-05_r8, 3.16756e-05_r8, 3.81690e-05_r8, 4.59935e-05_r8, 5.54220e-05_r8, & + & 6.67833e-05_r8, 8.04737e-05_r8, 9.69704e-05_r8, 1.16849e-04_r8, 1.40803e-04_r8, & + & 1.69667e-04_r8, 2.04448e-04_r8, 2.46359e-04_r8, 2.96861e-04_r8/) + kao_mco2(:, 6) = (/ & + & 1.71660e-05_r8, 2.07334e-05_r8, 2.50420e-05_r8, 3.02461e-05_r8, 3.65317e-05_r8, & + & 4.41235e-05_r8, 5.32930e-05_r8, 6.43680e-05_r8, 7.77446e-05_r8, 9.39010e-05_r8, & + & 1.13415e-04_r8, 1.36984e-04_r8, 1.65451e-04_r8, 1.99835e-04_r8, 2.41363e-04_r8, & + & 2.91522e-04_r8, 3.52104e-04_r8, 4.25276e-04_r8, 5.13654e-04_r8/) + kao_mco2(:, 7) = (/ & + & 4.78803e-05_r8, 5.79395e-05_r8, 7.01119e-05_r8, 8.48418e-05_r8, 1.02666e-04_r8, & + & 1.24235e-04_r8, 1.50336e-04_r8, 1.81920e-04_r8, 2.20139e-04_r8, 2.66388e-04_r8, & + & 3.22354e-04_r8, 3.90077e-04_r8, 4.72028e-04_r8, 5.71197e-04_r8, 6.91199e-04_r8, & + & 8.36413e-04_r8, 1.01214e-03_r8, 1.22477e-03_r8, 1.48209e-03_r8/) + kao_mco2(:, 8) = (/ & + & 1.27954e-04_r8, 1.55281e-04_r8, 1.88445e-04_r8, 2.28692e-04_r8, 2.77534e-04_r8, & + & 3.36808e-04_r8, 4.08741e-04_r8, 4.96037e-04_r8, 6.01977e-04_r8, 7.30542e-04_r8, & + & 8.86566e-04_r8, 1.07591e-03_r8, 1.30570e-03_r8, 1.58456e-03_r8, 1.92298e-03_r8, & + & 2.33367e-03_r8, 2.83208e-03_r8, 3.43694e-03_r8, 4.17097e-03_r8/) + kao_mco2(:, 9) = (/ & + & 2.93792e-05_r8, 3.55109e-05_r8, 4.29223e-05_r8, 5.18805e-05_r8, 6.27083e-05_r8, & + & 7.57960e-05_r8, 9.16151e-05_r8, 1.10736e-04_r8, 1.33847e-04_r8, 1.61782e-04_r8, & + & 1.95547e-04_r8, 2.36359e-04_r8, 2.85689e-04_r8, 3.45315e-04_r8, 4.17384e-04_r8, & + & 5.04495e-04_r8, 6.09787e-04_r8, 7.37054e-04_r8, 8.90882e-04_r8/) + kao_mco2(:,10) = (/ & + & 5.08569e-05_r8, 6.24700e-05_r8, 7.67350e-05_r8, 9.42574e-05_r8, 1.15781e-04_r8, & + & 1.42220e-04_r8, 1.74695e-04_r8, 2.14587e-04_r8, 2.63588e-04_r8, 3.23778e-04_r8, & + & 3.97712e-04_r8, 4.88530e-04_r8, 6.00085e-04_r8, 7.37114e-04_r8, 9.05433e-04_r8, & + & 1.11219e-03_r8, 1.36616e-03_r8, 1.67812e-03_r8, 2.06131e-03_r8/) + kao_mco2(:,11) = (/ & + & 4.82546e-06_r8, 6.21462e-06_r8, 8.00369e-06_r8, 1.03078e-05_r8, 1.32752e-05_r8, & + & 1.70969e-05_r8, 2.20188e-05_r8, 2.83575e-05_r8, 3.65211e-05_r8, 4.70348e-05_r8, & + & 6.05753e-05_r8, 7.80138e-05_r8, 1.00472e-04_r8, 1.29397e-04_r8, 1.66647e-04_r8, & + & 2.14622e-04_r8, 2.76407e-04_r8, 3.55980e-04_r8, 4.58459e-04_r8/) + kao_mco2(:,12) = (/ & + & 2.41346e-06_r8, 2.96282e-06_r8, 3.63723e-06_r8, 4.46516e-06_r8, 5.48153e-06_r8, & + & 6.72926e-06_r8, 8.26100e-06_r8, 1.01414e-05_r8, 1.24498e-05_r8, 1.52837e-05_r8, & + & 1.87627e-05_r8, 2.30335e-05_r8, 2.82765e-05_r8, 3.47129e-05_r8, 4.26144e-05_r8, & + & 5.23144e-05_r8, 6.42225e-05_r8, 7.88410e-05_r8, 9.67871e-05_r8/) + kao_mco2(:,13) = (/ & + & 2.76412e-06_r8, 3.46195e-06_r8, 4.33596e-06_r8, 5.43062e-06_r8, 6.80164e-06_r8, & + & 8.51879e-06_r8, 1.06695e-05_r8, 1.33631e-05_r8, 1.67367e-05_r8, 2.09621e-05_r8, & + & 2.62542e-05_r8, 3.28824e-05_r8, 4.11839e-05_r8, 5.15813e-05_r8, 6.46035e-05_r8, & + & 8.09134e-05_r8, 1.01341e-04_r8, 1.26925e-04_r8, 1.58969e-04_r8/) + kao_mco2(:,14) = (/ & + & 1.25126e-06_r8, 1.54971e-06_r8, 1.91935e-06_r8, 2.37715e-06_r8, 2.94416e-06_r8, & + & 3.64640e-06_r8, 4.51615e-06_r8, 5.59335e-06_r8, 6.92749e-06_r8, 8.57985e-06_r8, & + & 1.06263e-05_r8, 1.31610e-05_r8, 1.63001e-05_r8, 2.01881e-05_r8, 2.50034e-05_r8, & + & 3.09672e-05_r8, 3.83536e-05_r8, 4.75018e-05_r8, 5.88319e-05_r8/) + kao_mco2(:,15) = (/ & + & 1.59748e-06_r8, 2.08378e-06_r8, 2.71812e-06_r8, 3.54557e-06_r8, 4.62491e-06_r8, & + & 6.03282e-06_r8, 7.86932e-06_r8, 1.02649e-05_r8, 1.33897e-05_r8, 1.74658e-05_r8, & + & 2.27827e-05_r8, 2.97182e-05_r8, 3.87649e-05_r8, 5.05657e-05_r8, 6.59589e-05_r8, & + & 8.60380e-05_r8, 1.12230e-04_r8, 1.46394e-04_r8, 1.90959e-04_r8/) + kao_mco2(:,16) = (/ & + & 1.68148e-06_r8, 2.17133e-06_r8, 2.80388e-06_r8, 3.62071e-06_r8, 4.67549e-06_r8, & + & 6.03756e-06_r8, 7.79642e-06_r8, 1.00677e-05_r8, 1.30006e-05_r8, 1.67879e-05_r8, & + & 2.16786e-05_r8, 2.79941e-05_r8, 3.61493e-05_r8, 4.66803e-05_r8, 6.02792e-05_r8, & + & 7.78398e-05_r8, 1.00516e-04_r8, 1.29799e-04_r8, 1.67612e-04_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &3.2710e-07_r8,5.2119e-07_r8,8.4740e-07_r8,1.6908e-06_r8,2.3433e-06_r8,4.4129e-06_r8, & + &3.8930e-06_r8,2.3338e-06_r8,2.4115e-06_r8,2.4271e-06_r8,2.4836e-06_r8,2.6470e-06_r8, & + &2.9559e-06_r8,2.3940e-06_r8,2.9711e-06_r8,2.9511e-06_r8/) + forrefo(2,:) = (/ & + &6.5125e-07_r8,1.2128e-06_r8,1.7249e-06_r8,2.7126e-06_r8,3.1780e-06_r8,2.1444e-06_r8, & + &1.8265e-06_r8,1.7385e-06_r8,1.4574e-06_r8,1.6135e-06_r8,2.4966e-06_r8,2.8127e-06_r8, & + &2.5229e-06_r8,2.3251e-06_r8,2.5353e-06_r8,3.0200e-06_r8/) + forrefo(3,:) = (/ & + &1.4969e-06_r8,1.8516e-06_r8,2.5791e-06_r8,2.7846e-06_r8,1.9789e-06_r8,1.6688e-06_r8, & + &1.1037e-06_r8,9.9065e-07_r8,1.1557e-06_r8,7.0847e-07_r8,5.7758e-07_r8,4.0425e-07_r8, & + &3.2427e-07_r8,3.2267e-07_r8,3.1444e-07_r8,2.6046e-07_r8/) + forrefo(4,:) = (/ & + &1.7567e-06_r8,1.6891e-06_r8,2.1003e-06_r8,2.0957e-06_r8,2.3664e-06_r8,2.1538e-06_r8, & + &1.5275e-06_r8,1.0487e-06_r8,8.7390e-07_r8,7.9360e-07_r8,7.7778e-07_r8,8.1445e-07_r8, & + &8.2121e-07_r8,5.4395e-07_r8,3.1273e-07_r8,3.1848e-07_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 7.73921e-02_r8, 6.45225e-02_r8, 5.37930e-02_r8, 4.48477e-02_r8, 3.73900e-02_r8, & + & 3.11723e-02_r8, 2.59887e-02_r8, 2.16670e-02_r8, 1.80640e-02_r8, 1.50601e-02_r8/) + selfrefo(:, 2) = (/ & + & 8.47756e-02_r8, 7.10616e-02_r8, 5.95660e-02_r8, 4.99301e-02_r8, 4.18529e-02_r8, & + & 3.50824e-02_r8, 2.94072e-02_r8, 2.46500e-02_r8, 2.06624e-02_r8, 1.73199e-02_r8/) + selfrefo(:, 3) = (/ & + & 8.84829e-02_r8, 7.46093e-02_r8, 6.29110e-02_r8, 5.30469e-02_r8, 4.47295e-02_r8, & + & 3.77161e-02_r8, 3.18025e-02_r8, 2.68160e-02_r8, 2.26114e-02_r8, 1.90661e-02_r8/) + selfrefo(:, 4) = (/ & + & 9.27003e-02_r8, 7.88864e-02_r8, 6.71310e-02_r8, 5.71273e-02_r8, 4.86144e-02_r8, & + & 4.13700e-02_r8, 3.52052e-02_r8, 2.99590e-02_r8, 2.54946e-02_r8, 2.16955e-02_r8/) + selfrefo(:, 5) = (/ & + & 9.14315e-02_r8, 7.85661e-02_r8, 6.75110e-02_r8, 5.80115e-02_r8, 4.98487e-02_r8, & + & 4.28344e-02_r8, 3.68072e-02_r8, 3.16280e-02_r8, 2.71776e-02_r8, 2.33534e-02_r8/) + selfrefo(:, 6) = (/ & + & 7.72984e-02_r8, 6.91044e-02_r8, 6.17790e-02_r8, 5.52301e-02_r8, 4.93755e-02_r8, & + & 4.41414e-02_r8, 3.94622e-02_r8, 3.52790e-02_r8, 3.15392e-02_r8, 2.81959e-02_r8/) + selfrefo(:, 7) = (/ & + & 7.46998e-02_r8, 6.66597e-02_r8, 5.94850e-02_r8, 5.30825e-02_r8, 4.73691e-02_r8, & + & 4.22707e-02_r8, 3.77210e-02_r8, 3.36610e-02_r8, 3.00380e-02_r8, 2.68049e-02_r8/) + selfrefo(:, 8) = (/ & + & 7.59386e-02_r8, 6.66263e-02_r8, 5.84560e-02_r8, 5.12876e-02_r8, 4.49982e-02_r8, & + & 3.94801e-02_r8, 3.46387e-02_r8, 3.03910e-02_r8, 2.66642e-02_r8, 2.33944e-02_r8/) + selfrefo(:, 9) = (/ & + & 7.26921e-02_r8, 6.43261e-02_r8, 5.69230e-02_r8, 5.03719e-02_r8, 4.45747e-02_r8, & + & 3.94447e-02_r8, 3.49051e-02_r8, 3.08880e-02_r8, 2.73332e-02_r8, 2.41875e-02_r8/) + selfrefo(:,10) = (/ & + & 7.43684e-02_r8, 6.58735e-02_r8, 5.83490e-02_r8, 5.16840e-02_r8, 4.57803e-02_r8, & + & 4.05509e-02_r8, 3.59189e-02_r8, 3.18160e-02_r8, 2.81818e-02_r8, 2.49626e-02_r8/) + selfrefo(:,11) = (/ & + & 8.97599e-02_r8, 7.73727e-02_r8, 6.66950e-02_r8, 5.74908e-02_r8, 4.95569e-02_r8, & + & 4.27179e-02_r8, 3.68227e-02_r8, 3.17410e-02_r8, 2.73606e-02_r8, 2.35848e-02_r8/) + selfrefo(:,12) = (/ & + & 9.12262e-02_r8, 7.84848e-02_r8, 6.75230e-02_r8, 5.80922e-02_r8, 4.99786e-02_r8, & + & 4.29982e-02_r8, 3.69927e-02_r8, 3.18260e-02_r8, 2.73809e-02_r8, 2.35567e-02_r8/) + selfrefo(:,13) = (/ & + & 9.03254e-02_r8, 7.83291e-02_r8, 6.79260e-02_r8, 5.89046e-02_r8, 5.10813e-02_r8, & + & 4.42970e-02_r8, 3.84139e-02_r8, 3.33120e-02_r8, 2.88877e-02_r8, 2.50511e-02_r8/) + selfrefo(:,14) = (/ & + & 9.22803e-02_r8, 7.94172e-02_r8, 6.83470e-02_r8, 5.88199e-02_r8, 5.06209e-02_r8, & + & 4.35647e-02_r8, 3.74921e-02_r8, 3.22660e-02_r8, 2.77684e-02_r8, 2.38977e-02_r8/) + selfrefo(:,15) = (/ & + & 9.36819e-02_r8, 8.10810e-02_r8, 7.01750e-02_r8, 6.07359e-02_r8, 5.25665e-02_r8, & + & 4.54959e-02_r8, 3.93764e-02_r8, 3.40800e-02_r8, 2.94960e-02_r8, 2.55286e-02_r8/) + selfrefo(:,16) = (/ & + & 1.00195e-01_r8, 8.58713e-02_r8, 7.35950e-02_r8, 6.30737e-02_r8, 5.40566e-02_r8, & + & 4.63286e-02_r8, 3.97054e-02_r8, 3.40290e-02_r8, 2.91641e-02_r8, 2.49948e-02_r8/) + + end subroutine lw_kgb06 + +! ************************************************************************** + subroutine lw_kgb07 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg07, only : fracrefao, fracrefbo, kao, kbo, kao_mco2, & + kbo_mco2, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 706.27 mb, T = 278.94 K + fracrefao(:, 1) = (/ & + 1.6312e-01_r8,1.4949e-01_r8,1.4305e-01_r8,1.3161e-01_r8,1.1684e-01_r8,9.9900e-02_r8, & + 8.0912e-02_r8,6.0203e-02_r8,4.0149e-02_r8,4.3365e-03_r8,3.5844e-03_r8,2.8019e-03_r8, & + 2.0756e-03_r8,1.3449e-03_r8,5.0492e-04_r8,7.1194e-05_r8/) + fracrefao(:, 2) = (/ & + 1.6329e-01_r8,1.4989e-01_r8,1.4328e-01_r8,1.3101e-01_r8,1.1691e-01_r8,9.9754e-02_r8, & + 8.0956e-02_r8,5.9912e-02_r8,4.0271e-02_r8,4.3298e-03_r8,3.5626e-03_r8,2.8421e-03_r8, & + 2.1031e-03_r8,1.3360e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 3) = (/ & + 1.6236e-01_r8,1.5081e-01_r8,1.4341e-01_r8,1.3083e-01_r8,1.1684e-01_r8,9.9701e-02_r8, & + 8.0956e-02_r8,5.9884e-02_r8,4.0245e-02_r8,4.3837e-03_r8,3.6683e-03_r8,2.9250e-03_r8, & + 2.0969e-03_r8,1.3320e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 4) = (/ & + 1.6096e-01_r8,1.5183e-01_r8,1.4354e-01_r8,1.3081e-01_r8,1.1687e-01_r8,9.9619e-02_r8, & + 8.0947e-02_r8,5.9899e-02_r8,4.0416e-02_r8,4.4389e-03_r8,3.7280e-03_r8,2.9548e-03_r8, & + 2.0977e-03_r8,1.3305e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 5) = (/ & + 1.5661e-01_r8,1.5478e-01_r8,1.4414e-01_r8,1.3097e-01_r8,1.1695e-01_r8,9.9823e-02_r8, & + 8.0750e-02_r8,6.0100e-02_r8,4.0741e-02_r8,4.4598e-03_r8,3.7366e-03_r8,2.9521e-03_r8, & + 2.0980e-03_r8,1.3297e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 6) = (/ & + 1.4879e-01_r8,1.5853e-01_r8,1.4586e-01_r8,1.3162e-01_r8,1.1729e-01_r8,1.0031e-01_r8, & + 8.0908e-02_r8,6.0460e-02_r8,4.1100e-02_r8,4.4578e-03_r8,3.7388e-03_r8,2.9508e-03_r8, & + 2.0986e-03_r8,1.3288e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 7) = (/ & + 1.4117e-01_r8,1.4838e-01_r8,1.4807e-01_r8,1.3759e-01_r8,1.2218e-01_r8,1.0228e-01_r8, & + 8.2130e-02_r8,6.1546e-02_r8,4.1522e-02_r8,4.4577e-03_r8,3.7428e-03_r8,2.9475e-03_r8, & + 2.0997e-03_r8,1.3277e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 8) = (/ & + 1.4018e-01_r8,1.4207e-01_r8,1.3919e-01_r8,1.3332e-01_r8,1.2325e-01_r8,1.0915e-01_r8, & + 9.0280e-02_r8,6.5554e-02_r8,4.1852e-02_r8,4.4707e-03_r8,3.7572e-03_r8,2.9364e-03_r8, & + 2.1023e-03_r8,1.3249e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + fracrefao(:, 9) = (/ & + 1.4863e-01_r8,1.4926e-01_r8,1.4740e-01_r8,1.3558e-01_r8,1.1999e-01_r8,1.0044e-01_r8, & + 8.1927e-02_r8,6.0989e-02_r8,4.0665e-02_r8,4.4481e-03_r8,3.7369e-03_r8,2.9482e-03_r8, & + 2.0976e-03_r8,1.3281e-03_r8,4.8965e-04_r8,6.8900e-05_r8/) + +! Planck fraction mapping level : P=95.58 mbar, T= 215.70 K + fracrefbo(:) = (/ & + 1.5872e-01_r8,1.5443e-01_r8,1.4413e-01_r8,1.3147e-01_r8,1.1634e-01_r8,9.8914e-02_r8, & + 8.0236e-02_r8,6.0197e-02_r8,4.0624e-02_r8,4.4225e-03_r8,3.6688e-03_r8,2.9074e-03_r8, & + 2.0862e-03_r8,1.3039e-03_r8,4.8561e-04_r8,6.8854e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &2.0715e-06_r8,2.0394e-06_r8,5.0240e-06_r8,1.0614e-05_r8,1.1983e-05_r8,1.5554e-05_r8, & + &1.7831e-05_r8,2.6227e-05_r8,1.2374e-05_r8/) + kao(:, 2, 1, 1) = (/ & + &2.6968e-06_r8,2.7207e-06_r8,3.6723e-06_r8,1.1698e-05_r8,1.3601e-05_r8,1.5350e-05_r8, & + &2.0818e-05_r8,2.8393e-05_r8,1.1509e-05_r8/) + kao(:, 3, 1, 1) = (/ & + &3.4058e-06_r8,3.5757e-06_r8,3.8081e-06_r8,7.3554e-06_r8,1.4372e-05_r8,1.6368e-05_r8, & + &1.9019e-05_r8,3.0058e-05_r8,1.1256e-05_r8/) + kao(:, 4, 1, 1) = (/ & + &4.2245e-06_r8,4.8570e-06_r8,4.7347e-06_r8,6.0087e-06_r8,1.4347e-05_r8,1.6902e-05_r8, & + &1.9725e-05_r8,2.9609e-05_r8,1.0323e-05_r8/) + kao(:, 5, 1, 1) = (/ & + &5.1348e-06_r8,6.1189e-06_r8,5.9979e-06_r8,6.4031e-06_r8,9.6268e-06_r8,1.7276e-05_r8, & + &1.9533e-05_r8,2.5577e-05_r8,1.1200e-05_r8/) + kao(:, 1, 2, 1) = (/ & + &2.7400e-06_r8,2.6398e-06_r8,3.5715e-06_r8,8.9653e-06_r8,1.1704e-05_r8,1.2732e-05_r8, & + &1.5109e-05_r8,1.8326e-05_r8,7.6584e-06_r8/) + kao(:, 2, 2, 1) = (/ & + &3.7023e-06_r8,3.5996e-06_r8,3.5466e-06_r8,6.4138e-06_r8,1.4301e-05_r8,1.4484e-05_r8, & + &1.7298e-05_r8,2.1003e-05_r8,7.8450e-06_r8/) + kao(:, 3, 2, 1) = (/ & + &4.8529e-06_r8,4.7902e-06_r8,4.4795e-06_r8,5.2052e-06_r8,1.0079e-05_r8,1.6425e-05_r8, & + &1.7110e-05_r8,2.3533e-05_r8,8.0830e-06_r8/) + kao(:, 4, 2, 1) = (/ & + &6.0952e-06_r8,6.1266e-06_r8,5.7794e-06_r8,5.6603e-06_r8,7.5131e-06_r8,1.6775e-05_r8, & + &1.7862e-05_r8,2.1237e-05_r8,6.9720e-06_r8/) + kao(:, 5, 2, 1) = (/ & + &7.4621e-06_r8,7.9816e-06_r8,7.3755e-06_r8,7.0507e-06_r8,7.2782e-06_r8,1.2172e-05_r8, & + &1.8558e-05_r8,2.1490e-05_r8,7.0903e-06_r8/) + kao(:, 1, 3, 1) = (/ & + &4.8603e-06_r8,4.7726e-06_r8,4.1802e-06_r8,5.2554e-06_r8,9.0303e-06_r8,1.4041e-05_r8, & + &1.3465e-05_r8,1.4273e-05_r8,4.5115e-06_r8/) + kao(:, 2, 3, 1) = (/ & + &6.5045e-06_r8,6.5033e-06_r8,5.8343e-06_r8,5.3408e-06_r8,7.3167e-06_r8,1.4520e-05_r8, & + &1.5602e-05_r8,1.7982e-05_r8,4.5301e-06_r8/) + kao(:, 3, 3, 1) = (/ & + &8.5550e-06_r8,8.5301e-06_r8,7.7170e-06_r8,6.8750e-06_r8,6.6921e-06_r8,1.0610e-05_r8, & + &1.8653e-05_r8,1.7976e-05_r8,3.9894e-06_r8/) + kao(:, 4, 3, 1) = (/ & + &1.0940e-05_r8,1.0943e-05_r8,9.9861e-06_r8,8.8481e-06_r8,7.8291e-06_r8,8.3918e-06_r8, & + &1.7829e-05_r8,1.8992e-05_r8,3.8512e-06_r8/) + kao(:, 5, 3, 1) = (/ & + &1.3936e-05_r8,1.3811e-05_r8,1.2489e-05_r8,1.1153e-05_r8,9.8326e-06_r8,8.7685e-06_r8, & + &1.2193e-05_r8,1.9703e-05_r8,4.2059e-06_r8/) + kao(:, 1, 4, 1) = (/ & + &8.9960e-06_r8,8.6210e-06_r8,7.6632e-06_r8,6.4630e-06_r8,6.4239e-06_r8,9.4367e-06_r8, & + &1.6258e-05_r8,1.3756e-05_r8,2.4163e-06_r8/) + kao(:, 2, 4, 1) = (/ & + &1.2134e-05_r8,1.1807e-05_r8,1.0673e-05_r8,9.1029e-06_r8,7.7016e-06_r8,8.4861e-06_r8, & + &1.4567e-05_r8,1.5036e-05_r8,2.1658e-06_r8/) + kao(:, 3, 4, 1) = (/ & + &1.6015e-05_r8,1.5688e-05_r8,1.4339e-05_r8,1.2455e-05_r8,1.0313e-05_r8,8.5777e-06_r8, & + &1.1331e-05_r8,1.8116e-05_r8,2.2633e-06_r8/) + kao(:, 4, 4, 1) = (/ & + &2.0597e-05_r8,2.0155e-05_r8,1.8480e-05_r8,1.6165e-05_r8,1.3589e-05_r8,1.0837e-05_r8, & + &9.4849e-06_r8,2.1131e-05_r8,2.4289e-06_r8/) + kao(:, 5, 4, 1) = (/ & + &2.5729e-05_r8,2.5473e-05_r8,2.3255e-05_r8,2.0429e-05_r8,1.7213e-05_r8,1.3828e-05_r8, & + &1.0618e-05_r8,1.5874e-05_r8,3.2874e-06_r8/) + kao(:, 1, 5, 1) = (/ & + &1.6376e-05_r8,1.4981e-05_r8,1.3148e-05_r8,1.1171e-05_r8,9.2339e-06_r8,7.8648e-06_r8, & + &1.1215e-05_r8,1.5160e-05_r8,1.0907e-06_r8/) + kao(:, 2, 5, 1) = (/ & + &2.2074e-05_r8,2.0407e-05_r8,1.8083e-05_r8,1.5475e-05_r8,1.2746e-05_r8,1.0050e-05_r8, & + &1.0049e-05_r8,1.8902e-05_r8,1.3007e-06_r8/) + kao(:, 3, 5, 1) = (/ & + &2.9048e-05_r8,2.7094e-05_r8,2.4278e-05_r8,2.1033e-05_r8,1.7417e-05_r8,1.3618e-05_r8, & + &1.0309e-05_r8,1.5056e-05_r8,1.4150e-06_r8/) + kao(:, 4, 5, 1) = (/ & + &3.7623e-05_r8,3.5233e-05_r8,3.1800e-05_r8,2.7623e-05_r8,2.3164e-05_r8,1.8269e-05_r8, & + &1.3014e-05_r8,1.1951e-05_r8,2.0520e-06_r8/) + kao(:, 5, 5, 1) = (/ & + &4.7365e-05_r8,4.4556e-05_r8,4.0255e-05_r8,3.5279e-05_r8,2.9803e-05_r8,2.3695e-05_r8, & + &1.6824e-05_r8,1.0864e-05_r8,3.0931e-06_r8/) + kao(:, 1, 6, 1) = (/ & + &2.9059e-05_r8,2.6117e-05_r8,2.2727e-05_r8,1.9184e-05_r8,1.5516e-05_r8,1.1998e-05_r8, & + &9.5851e-06_r8,1.6016e-05_r8,6.6366e-07_r8/) + kao(:, 2, 6, 1) = (/ & + &3.9281e-05_r8,3.5568e-05_r8,3.1182e-05_r8,2.6432e-05_r8,2.1505e-05_r8,1.6402e-05_r8, & + &1.1717e-05_r8,1.2828e-05_r8,7.2868e-07_r8/) + kao(:, 3, 6, 1) = (/ & + &5.2094e-05_r8,4.7264e-05_r8,4.1432e-05_r8,3.5398e-05_r8,2.9041e-05_r8,2.2416e-05_r8, & + &1.5568e-05_r8,1.1439e-05_r8,1.0703e-06_r8/) + kao(:, 4, 6, 1) = (/ & + &6.7466e-05_r8,6.1301e-05_r8,5.3945e-05_r8,4.6275e-05_r8,3.8268e-05_r8,2.9782e-05_r8, & + &2.0926e-05_r8,1.2149e-05_r8,1.6636e-06_r8/) + kao(:, 5, 6, 1) = (/ & + &8.5711e-05_r8,7.8253e-05_r8,6.9113e-05_r8,5.9588e-05_r8,4.9429e-05_r8,3.8720e-05_r8, & + &2.7357e-05_r8,1.5302e-05_r8,2.4859e-06_r8/) + kao(:, 1, 7, 1) = (/ & + &5.4651e-05_r8,4.8396e-05_r8,4.1917e-05_r8,3.5300e-05_r8,2.8526e-05_r8,2.1678e-05_r8, & + &1.5027e-05_r8,1.1124e-05_r8,3.7210e-07_r8/) + kao(:, 2, 7, 1) = (/ & + &7.4826e-05_r8,6.6392e-05_r8,5.7621e-05_r8,4.8629e-05_r8,3.9371e-05_r8,2.9959e-05_r8, & + &2.0404e-05_r8,1.1926e-05_r8,4.6517e-07_r8/) + kao(:, 3, 7, 1) = (/ & + &9.9886e-05_r8,8.9008e-05_r8,7.7375e-05_r8,6.5427e-05_r8,5.3175e-05_r8,4.0667e-05_r8, & + &2.7777e-05_r8,1.4838e-05_r8,7.6733e-07_r8/) + kao(:, 4, 7, 1) = (/ & + &1.3028e-04_r8,1.1642e-04_r8,1.0145e-04_r8,8.5974e-05_r8,7.0058e-05_r8,5.3698e-05_r8, & + &3.6993e-05_r8,1.9660e-05_r8,1.2756e-06_r8/) + kao(:, 5, 7, 1) = (/ & + &1.6675e-04_r8,1.4925e-04_r8,1.3030e-04_r8,1.1056e-04_r8,9.0256e-05_r8,6.9412e-05_r8, & + &4.8077e-05_r8,2.5971e-05_r8,2.0598e-06_r8/) + kao(:, 1, 8, 1) = (/ & + &1.3360e-04_r8,1.1739e-04_r8,1.0102e-04_r8,8.4552e-05_r8,6.8007e-05_r8,5.1398e-05_r8, & + &3.4619e-05_r8,1.8035e-05_r8,1.9024e-07_r8/) + kao(:, 2, 8, 1) = (/ & + &1.8185e-04_r8,1.6006e-04_r8,1.3792e-04_r8,1.1564e-04_r8,9.3245e-05_r8,7.0615e-05_r8, & + &4.7676e-05_r8,2.4529e-05_r8,3.0949e-07_r8/) + kao(:, 3, 8, 1) = (/ & + &2.4405e-04_r8,2.1504e-04_r8,1.8547e-04_r8,1.5570e-04_r8,1.2559e-04_r8,9.5220e-05_r8, & + &6.4517e-05_r8,3.3270e-05_r8,5.6654e-07_r8/) + kao(:, 4, 8, 1) = (/ & + &3.2056e-04_r8,2.8296e-04_r8,2.4441e-04_r8,2.0538e-04_r8,1.6592e-04_r8,1.2607e-04_r8, & + &8.5723e-05_r8,4.4370e-05_r8,1.0126e-06_r8/) + kao(:, 5, 8, 1) = (/ & + &4.1126e-04_r8,3.6352e-04_r8,3.1426e-04_r8,2.6419e-04_r8,2.1364e-04_r8,1.6265e-04_r8, & + &1.1079e-04_r8,5.7674e-05_r8,1.7042e-06_r8/) + kao(:, 1, 9, 1) = (/ & + &6.2463e-04_r8,5.4698e-04_r8,4.6923e-04_r8,3.9140e-04_r8,3.1352e-04_r8,2.3558e-04_r8, & + &1.5756e-04_r8,7.9405e-05_r8,1.4148e-07_r8/) + kao(:, 2, 9, 1) = (/ & + &8.5834e-04_r8,7.5200e-04_r8,6.4533e-04_r8,5.3850e-04_r8,4.3155e-04_r8,3.2449e-04_r8, & + &2.1732e-04_r8,1.0986e-04_r8,2.9809e-07_r8/) + kao(:, 3, 9, 1) = (/ & + &1.1576e-03_r8,1.0147e-03_r8,8.7098e-04_r8,7.2712e-04_r8,5.8298e-04_r8,4.3871e-04_r8, & + &2.9418e-04_r8,1.4894e-04_r8,5.9602e-07_r8/) + kao(:, 4, 9, 1) = (/ & + &1.5307e-03_r8,1.3423e-03_r8,1.1527e-03_r8,9.6254e-04_r8,7.7214e-04_r8,5.8148e-04_r8, & + &3.9028e-04_r8,1.9773e-04_r8,1.1255e-06_r8/) + kao(:, 5, 9, 1) = (/ & + &1.9847e-03_r8,1.7410e-03_r8,1.4953e-03_r8,1.2490e-03_r8,1.0025e-03_r8,7.5537e-04_r8, & + &5.0679e-04_r8,2.5732e-04_r8,1.9162e-06_r8/) + kao(:, 1,10, 1) = (/ & + &3.6169e-03_r8,3.1652e-03_r8,2.7133e-03_r8,2.2615e-03_r8,1.8097e-03_r8,1.3577e-03_r8, & + &9.0574e-04_r8,4.5358e-04_r8,1.4845e-07_r8/) + kao(:, 2,10, 1) = (/ & + &4.9699e-03_r8,4.3495e-03_r8,3.7290e-03_r8,3.1084e-03_r8,2.4876e-03_r8,1.8667e-03_r8, & + &1.2456e-03_r8,6.2420e-04_r8,3.2434e-07_r8/) + kao(:, 3,10, 1) = (/ & + &6.7347e-03_r8,5.8945e-03_r8,5.0543e-03_r8,4.2138e-03_r8,3.3728e-03_r8,2.5314e-03_r8, & + &1.6895e-03_r8,8.4729e-04_r8,6.8830e-07_r8/) + kao(:, 4,10, 1) = (/ & + &8.9371e-03_r8,7.8231e-03_r8,6.7088e-03_r8,5.5938e-03_r8,4.4779e-03_r8,3.3612e-03_r8, & + &2.2441e-03_r8,1.1262e-03_r8,1.3449e-06_r8/) + kao(:, 5,10, 1) = (/ & + &1.1613e-02_r8,1.0166e-02_r8,8.7190e-03_r8,7.2700e-03_r8,5.8199e-03_r8,4.3690e-03_r8, & + &2.9176e-03_r8,1.4653e-03_r8,2.4729e-06_r8/) + kao(:, 1,11, 1) = (/ & + &8.2249e-03_r8,7.1970e-03_r8,6.1693e-03_r8,5.1415e-03_r8,4.1138e-03_r8,3.0859e-03_r8, & + &2.0579e-03_r8,1.0298e-03_r8,1.4864e-07_r8/) + kao(:, 2,11, 1) = (/ & + &1.1270e-02_r8,9.8625e-03_r8,8.4545e-03_r8,7.0466e-03_r8,5.6386e-03_r8,4.2301e-03_r8, & + &2.8215e-03_r8,1.4124e-03_r8,3.4574e-07_r8/) + kao(:, 3,11, 1) = (/ & + &1.5223e-02_r8,1.3322e-02_r8,1.1421e-02_r8,9.5200e-03_r8,7.6187e-03_r8,5.7167e-03_r8, & + &3.8140e-03_r8,1.9100e-03_r8,7.2590e-07_r8/) + kao(:, 4,11, 1) = (/ & + &2.0093e-02_r8,1.7585e-02_r8,1.5077e-02_r8,1.2568e-02_r8,1.0059e-02_r8,7.5477e-03_r8, & + &5.0358e-03_r8,2.5228e-03_r8,1.4168e-06_r8/) + kao(:, 5,11, 1) = (/ & + &2.5957e-02_r8,2.2717e-02_r8,1.9478e-02_r8,1.6238e-02_r8,1.2998e-02_r8,9.7533e-03_r8, & + &6.5080e-03_r8,3.2606e-03_r8,2.6860e-06_r8/) + kao(:, 1,12, 1) = (/ & + &1.1827e-02_r8,1.0349e-02_r8,8.8708e-03_r8,7.3929e-03_r8,5.9148e-03_r8,4.4367e-03_r8, & + &2.9587e-03_r8,1.4802e-03_r8,1.3931e-07_r8/) + kao(:, 2,12, 1) = (/ & + &1.6211e-02_r8,1.4185e-02_r8,1.2160e-02_r8,1.0134e-02_r8,8.1087e-03_r8,6.0831e-03_r8, & + &4.0569e-03_r8,2.0301e-03_r8,3.2171e-07_r8/) + kao(:, 3,12, 1) = (/ & + &2.1828e-02_r8,1.9101e-02_r8,1.6374e-02_r8,1.3648e-02_r8,1.0921e-02_r8,8.1937e-03_r8, & + &5.4651e-03_r8,2.7355e-03_r8,6.8081e-07_r8/) + kao(:, 4,12, 1) = (/ & + &2.8730e-02_r8,2.5142e-02_r8,2.1554e-02_r8,1.7967e-02_r8,1.4379e-02_r8,1.0788e-02_r8, & + &7.1961e-03_r8,3.6027e-03_r8,1.3459e-06_r8/) + kao(:, 5,12, 1) = (/ & + &3.6999e-02_r8,3.2380e-02_r8,2.7760e-02_r8,2.3140e-02_r8,1.8520e-02_r8,1.3896e-02_r8, & + &9.2700e-03_r8,4.6424e-03_r8,2.5690e-06_r8/) + kao(:, 1,13, 1) = (/ & + &1.3632e-02_r8,1.1928e-02_r8,1.0225e-02_r8,8.5212e-03_r8,6.8176e-03_r8,5.1139e-03_r8, & + &3.4100e-03_r8,1.7059e-03_r8,1.1695e-07_r8/) + kao(:, 2,13, 1) = (/ & + &1.8706e-02_r8,1.6369e-02_r8,1.4031e-02_r8,1.1694e-02_r8,9.3569e-03_r8,7.0195e-03_r8, & + &4.6811e-03_r8,2.3422e-03_r8,2.7119e-07_r8/) + kao(:, 3,13, 1) = (/ & + &2.5132e-02_r8,2.1993e-02_r8,1.8852e-02_r8,1.5713e-02_r8,1.2573e-02_r8,9.4331e-03_r8, & + &6.2911e-03_r8,3.1482e-03_r8,5.7144e-07_r8/) + kao(:, 4,13, 1) = (/ & + &3.3041e-02_r8,2.8914e-02_r8,2.4787e-02_r8,2.0660e-02_r8,1.6533e-02_r8,1.2406e-02_r8, & + &8.2739e-03_r8,4.1414e-03_r8,1.1335e-06_r8/) + kao(:, 5,13, 1) = (/ & + &4.2440e-02_r8,3.7140e-02_r8,3.1841e-02_r8,2.6541e-02_r8,2.1241e-02_r8,1.5937e-02_r8, & + &1.0630e-02_r8,5.3218e-03_r8,2.1676e-06_r8/) + kao(:, 1, 1, 2) = (/ & + &4.1413e-06_r8,5.7568e-06_r8,5.6875e-06_r8,2.2265e-05_r8,2.6421e-05_r8,2.7053e-05_r8, & + &2.9360e-05_r8,4.0970e-05_r8,1.4958e-05_r8/) + kao(:, 2, 1, 2) = (/ & + &5.1991e-06_r8,7.4465e-06_r8,7.4944e-06_r8,1.1514e-05_r8,2.6560e-05_r8,2.7448e-05_r8, & + &2.9314e-05_r8,3.8310e-05_r8,1.7668e-05_r8/) + kao(:, 3, 1, 2) = (/ & + &6.3145e-06_r8,9.3150e-06_r8,9.9659e-06_r8,1.0415e-05_r8,2.4448e-05_r8,2.8503e-05_r8, & + &3.1282e-05_r8,4.1769e-05_r8,1.5395e-05_r8/) + kao(:, 4, 1, 2) = (/ & + &7.5825e-06_r8,1.1197e-05_r8,1.2631e-05_r8,1.2849e-05_r8,1.2505e-05_r8,2.7705e-05_r8, & + &3.1429e-05_r8,4.1459e-05_r8,1.9577e-05_r8/) + kao(:, 5, 1, 2) = (/ & + &9.0691e-06_r8,1.3548e-05_r8,1.5444e-05_r8,1.5939e-05_r8,1.4634e-05_r8,2.1478e-05_r8, & + &3.0373e-05_r8,4.6504e-05_r8,1.5074e-05_r8/) + kao(:, 1, 2, 2) = (/ & + &6.1165e-06_r8,7.4934e-06_r8,6.8625e-06_r8,7.6121e-06_r8,3.0817e-05_r8,3.2183e-05_r8, & + &3.0483e-05_r8,3.3496e-05_r8,1.0690e-05_r8/) + kao(:, 2, 2, 2) = (/ & + &7.6538e-06_r8,9.6280e-06_r8,9.7301e-06_r8,8.1097e-06_r8,1.6826e-05_r8,3.2430e-05_r8, & + &3.0532e-05_r8,3.1851e-05_r8,9.7120e-06_r8/) + kao(:, 3, 2, 2) = (/ & + &9.2709e-06_r8,1.2057e-05_r8,1.2568e-05_r8,1.1762e-05_r8,1.2621e-05_r8,3.1032e-05_r8, & + &3.2269e-05_r8,3.2750e-05_r8,1.1309e-05_r8/) + kao(:, 4, 2, 2) = (/ & + &1.1033e-05_r8,1.5040e-05_r8,1.5728e-05_r8,1.5466e-05_r8,1.4259e-05_r8,1.7169e-05_r8, & + &3.1754e-05_r8,3.4497e-05_r8,1.2084e-05_r8/) + kao(:, 5, 2, 2) = (/ & + &1.2896e-05_r8,1.7847e-05_r8,1.9251e-05_r8,1.9193e-05_r8,1.8160e-05_r8,1.5443e-05_r8, & + &2.9856e-05_r8,3.4316e-05_r8,1.0107e-05_r8/) + kao(:, 1, 3, 2) = (/ & + &1.2491e-05_r8,1.2769e-05_r8,1.2392e-05_r8,1.0198e-05_r8,9.0495e-06_r8,2.4479e-05_r8, & + &4.2929e-05_r8,3.4687e-05_r8,5.7323e-06_r8/) + kao(:, 2, 3, 2) = (/ & + &1.5715e-05_r8,1.6378e-05_r8,1.5890e-05_r8,1.4699e-05_r8,1.1686e-05_r8,1.2801e-05_r8, & + &4.3476e-05_r8,3.5317e-05_r8,5.8828e-06_r8/) + kao(:, 3, 3, 2) = (/ & + &1.9226e-05_r8,2.0527e-05_r8,2.0237e-05_r8,1.8901e-05_r8,1.6806e-05_r8,1.2767e-05_r8, & + &3.2801e-05_r8,3.5650e-05_r8,7.0460e-06_r8/) + kao(:, 4, 3, 2) = (/ & + &2.3182e-05_r8,2.5284e-05_r8,2.5183e-05_r8,2.3943e-05_r8,2.1697e-05_r8,1.8156e-05_r8, & + &1.6231e-05_r8,3.6132e-05_r8,6.5848e-06_r8/) + kao(:, 5, 3, 2) = (/ & + &2.7146e-05_r8,3.0591e-05_r8,3.0801e-05_r8,2.9528e-05_r8,2.6930e-05_r8,2.3450e-05_r8, & + &1.7771e-05_r8,3.6010e-05_r8,8.7258e-06_r8/) + kao(:, 1, 4, 2) = (/ & + &2.6397e-05_r8,2.4798e-05_r8,2.2448e-05_r8,1.9931e-05_r8,1.6167e-05_r8,1.1187e-05_r8, & + &1.9967e-05_r8,5.0094e-05_r8,2.6889e-06_r8/) + kao(:, 2, 4, 2) = (/ & + &3.3110e-05_r8,3.1403e-05_r8,2.8621e-05_r8,2.5685e-05_r8,2.2077e-05_r8,1.6320e-05_r8, & + &1.2528e-05_r8,5.0766e-05_r8,3.5011e-06_r8/) + kao(:, 3, 4, 2) = (/ & + &4.1079e-05_r8,3.9262e-05_r8,3.5800e-05_r8,3.2065e-05_r8,2.7986e-05_r8,2.3135e-05_r8, & + &1.5357e-05_r8,4.2293e-05_r8,3.6570e-06_r8/) + kao(:, 4, 4, 2) = (/ & + &4.9814e-05_r8,4.8178e-05_r8,4.4142e-05_r8,4.0008e-05_r8,3.5086e-05_r8,2.9575e-05_r8, & + &2.2305e-05_r8,2.4338e-05_r8,5.5271e-06_r8/) + kao(:, 5, 4, 2) = (/ & + &5.8999e-05_r8,5.7911e-05_r8,5.3941e-05_r8,4.9131e-05_r8,4.3508e-05_r8,3.6745e-05_r8, & + &2.8595e-05_r8,1.7749e-05_r8,7.9465e-06_r8/) + kao(:, 1, 5, 2) = (/ & + &5.2146e-05_r8,4.7415e-05_r8,4.1895e-05_r8,3.6100e-05_r8,2.9831e-05_r8,2.2853e-05_r8, & + &1.2797e-05_r8,3.5615e-05_r8,1.8756e-06_r8/) + kao(:, 2, 5, 2) = (/ & + &6.6386e-05_r8,6.0667e-05_r8,5.3871e-05_r8,4.6587e-05_r8,3.8801e-05_r8,3.0645e-05_r8, & + &1.9749e-05_r8,1.7747e-05_r8,1.8651e-06_r8/) + kao(:, 3, 5, 2) = (/ & + &8.2249e-05_r8,7.5613e-05_r8,6.7372e-05_r8,5.8338e-05_r8,4.8872e-05_r8,3.9037e-05_r8, & + &2.7917e-05_r8,1.3785e-05_r8,2.9415e-06_r8/) + kao(:, 4, 5, 2) = (/ & + &1.0042e-04_r8,9.2832e-05_r8,8.2527e-05_r8,7.1569e-05_r8,6.0116e-05_r8,4.8290e-05_r8, & + &3.5743e-05_r8,1.9373e-05_r8,4.5717e-06_r8/) + kao(:, 5, 5, 2) = (/ & + &1.2062e-04_r8,1.1245e-04_r8,1.0036e-04_r8,8.7051e-05_r8,7.3237e-05_r8,5.8949e-05_r8, & + &4.4093e-05_r8,2.6901e-05_r8,6.6085e-06_r8/) + kao(:, 1, 6, 2) = (/ & + &9.7868e-05_r8,8.7352e-05_r8,7.6231e-05_r8,6.4624e-05_r8,5.2909e-05_r8,4.0689e-05_r8, & + &2.7103e-05_r8,1.2458e-05_r8,1.0529e-06_r8/) + kao(:, 2, 6, 2) = (/ & + &1.2683e-04_r8,1.1378e-04_r8,9.9028e-05_r8,8.4157e-05_r8,6.8945e-05_r8,5.3462e-05_r8, & + &3.6917e-05_r8,1.5991e-05_r8,1.3630e-06_r8/) + kao(:, 3, 6, 2) = (/ & + &1.5959e-04_r8,1.4323e-04_r8,1.2528e-04_r8,1.0669e-04_r8,8.7707e-05_r8,6.8030e-05_r8, & + &4.7823e-05_r8,2.4263e-05_r8,2.3097e-06_r8/) + kao(:, 4, 6, 2) = (/ & + &1.9648e-04_r8,1.7730e-04_r8,1.5536e-04_r8,1.3239e-04_r8,1.0876e-04_r8,8.4595e-05_r8, & + &5.9848e-05_r8,3.3068e-05_r8,3.7113e-06_r8/) + kao(:, 5, 6, 2) = (/ & + &2.3620e-04_r8,2.1365e-04_r8,1.8738e-04_r8,1.5973e-04_r8,1.3145e-04_r8,1.0268e-04_r8, & + &7.2957e-05_r8,4.1703e-05_r8,5.6387e-06_r8/) + kao(:, 1, 7, 2) = (/ & + &1.9683e-04_r8,1.7373e-04_r8,1.5000e-04_r8,1.2604e-04_r8,1.0197e-04_r8,7.7797e-05_r8, & + &5.2829e-05_r8,2.4870e-05_r8,6.2713e-07_r8/) + kao(:, 2, 7, 2) = (/ & + &2.5760e-04_r8,2.2793e-04_r8,1.9707e-04_r8,1.6593e-04_r8,1.3495e-04_r8,1.0291e-04_r8, & + &7.0455e-05_r8,3.6046e-05_r8,1.0898e-06_r8/) + kao(:, 3, 7, 2) = (/ & + &3.2772e-04_r8,2.9045e-04_r8,2.5191e-04_r8,2.1251e-04_r8,1.7232e-04_r8,1.3160e-04_r8, & + &9.0425e-05_r8,4.7870e-05_r8,1.9368e-06_r8/) + kao(:, 4, 7, 2) = (/ & + &4.0755e-04_r8,3.6253e-04_r8,3.1479e-04_r8,2.6553e-04_r8,2.1537e-04_r8,1.6486e-04_r8, & + &1.1337e-04_r8,6.0602e-05_r8,3.1700e-06_r8/) + kao(:, 5, 7, 2) = (/ & + &4.9614e-04_r8,4.4343e-04_r8,3.8479e-04_r8,3.2448e-04_r8,2.6368e-04_r8,2.0203e-04_r8, & + &1.3939e-04_r8,7.4791e-05_r8,4.9446e-06_r8/) + kao(:, 1, 8, 2) = (/ & + &5.0097e-04_r8,4.3939e-04_r8,3.7796e-04_r8,3.1605e-04_r8,2.5384e-04_r8,1.9144e-04_r8, & + &1.2886e-04_r8,6.5770e-05_r8,4.5473e-07_r8/) + kao(:, 2, 8, 2) = (/ & + &6.6297e-04_r8,5.8193e-04_r8,5.0094e-04_r8,4.1901e-04_r8,3.3675e-04_r8,2.5431e-04_r8, & + &1.7173e-04_r8,8.8413e-05_r8,9.2809e-07_r8/) + kao(:, 3, 8, 2) = (/ & + &8.5051e-04_r8,7.4751e-04_r8,6.4368e-04_r8,5.3885e-04_r8,4.3363e-04_r8,3.2808e-04_r8, & + &2.2228e-04_r8,1.1512e-04_r8,1.7364e-06_r8/) + kao(:, 4, 8, 2) = (/ & + &1.0693e-03_r8,9.4111e-04_r8,8.1096e-04_r8,6.7960e-04_r8,5.4760e-04_r8,4.1579e-04_r8, & + &2.8187e-04_r8,1.4563e-04_r8,2.9681e-06_r8/) + kao(:, 5, 8, 2) = (/ & + &1.3123e-03_r8,1.1563e-03_r8,9.9722e-04_r8,8.3695e-04_r8,6.7599e-04_r8,5.1257e-04_r8, & + &3.4753e-04_r8,1.7994e-04_r8,4.7447e-06_r8/) + kao(:, 1, 9, 2) = (/ & + &2.4740e-03_r8,2.1654e-03_r8,1.8568e-03_r8,1.5484e-03_r8,1.2400e-03_r8,9.3161e-04_r8, & + &6.2283e-04_r8,3.1298e-04_r8,4.6685e-07_r8/) + kao(:, 2, 9, 2) = (/ & + &3.2850e-03_r8,2.8753e-03_r8,2.4661e-03_r8,2.0570e-03_r8,1.6482e-03_r8,1.2389e-03_r8, & + &8.2844e-04_r8,4.1698e-04_r8,9.7197e-07_r8/) + kao(:, 3, 9, 2) = (/ & + &4.2422e-03_r8,3.7138e-03_r8,3.1860e-03_r8,2.6588e-03_r8,2.1312e-03_r8,1.6022e-03_r8, & + &1.0719e-03_r8,5.4052e-04_r8,1.8767e-06_r8/) + kao(:, 4, 9, 2) = (/ & + &5.3553e-03_r8,4.6891e-03_r8,4.0243e-03_r8,3.3598e-03_r8,2.6939e-03_r8,2.0261e-03_r8, & + &1.3568e-03_r8,6.8626e-04_r8,3.3456e-06_r8/) + kao(:, 5, 9, 2) = (/ & + &6.6220e-03_r8,5.7995e-03_r8,4.9792e-03_r8,4.1587e-03_r8,3.3345e-03_r8,2.5085e-03_r8, & + &1.6821e-03_r8,8.5317e-04_r8,5.6245e-06_r8/) + kao(:, 1,10, 2) = (/ & + &1.5050e-02_r8,1.3169e-02_r8,1.1289e-02_r8,9.4076e-03_r8,7.5270e-03_r8,5.6463e-03_r8, & + &3.7658e-03_r8,1.8853e-03_r8,4.7266e-07_r8/) + kao(:, 2,10, 2) = (/ & + &1.9971e-02_r8,1.7476e-02_r8,1.4981e-02_r8,1.2485e-02_r8,9.9900e-03_r8,7.4947e-03_r8, & + &4.9999e-03_r8,2.5053e-03_r8,1.0606e-06_r8/) + kao(:, 3,10, 2) = (/ & + &2.5996e-02_r8,2.2748e-02_r8,1.9499e-02_r8,1.6252e-02_r8,1.3005e-02_r8,9.7575e-03_r8, & + &6.5102e-03_r8,3.2633e-03_r8,2.1957e-06_r8/) + kao(:, 4,10, 2) = (/ & + &3.3067e-02_r8,2.8935e-02_r8,2.4804e-02_r8,2.0673e-02_r8,1.6543e-02_r8,1.2414e-02_r8, & + &8.2853e-03_r8,4.1549e-03_r8,4.2322e-06_r8/) + kao(:, 5,10, 2) = (/ & + &4.1113e-02_r8,3.5978e-02_r8,3.0842e-02_r8,2.5708e-02_r8,2.0575e-02_r8,1.5443e-02_r8, & + &1.0311e-02_r8,5.1716e-03_r8,7.6651e-06_r8/) + kao(:, 1,11, 2) = (/ & + &3.5447e-02_r8,3.1017e-02_r8,2.6586e-02_r8,2.2156e-02_r8,1.7726e-02_r8,1.3295e-02_r8, & + &8.8649e-03_r8,4.4348e-03_r8,5.0606e-07_r8/) + kao(:, 2,11, 2) = (/ & + &4.6742e-02_r8,4.0900e-02_r8,3.5058e-02_r8,2.9216e-02_r8,2.3374e-02_r8,1.7532e-02_r8, & + &1.1691e-02_r8,5.8504e-03_r8,1.1095e-06_r8/) + kao(:, 3,11, 2) = (/ & + &6.0406e-02_r8,5.2857e-02_r8,4.5306e-02_r8,3.7757e-02_r8,3.0208e-02_r8,2.2660e-02_r8, & + &1.5111e-02_r8,7.5645e-03_r8,2.3165e-06_r8/) + kao(:, 4,11, 2) = (/ & + &7.6519e-02_r8,6.6955e-02_r8,5.7393e-02_r8,4.7830e-02_r8,3.8268e-02_r8,2.8708e-02_r8, & + &1.9148e-02_r8,9.5895e-03_r8,4.5048e-06_r8/) + kao(:, 5,11, 2) = (/ & + &9.5074e-02_r8,8.3196e-02_r8,7.1315e-02_r8,5.9435e-02_r8,4.7553e-02_r8,3.5677e-02_r8, & + &2.3800e-02_r8,1.1926e-02_r8,8.0597e-06_r8/) + kao(:, 1,12, 2) = (/ & + &5.2692e-02_r8,4.6104e-02_r8,3.9518e-02_r8,3.2933e-02_r8,2.6346e-02_r8,1.9761e-02_r8, & + &1.3176e-02_r8,6.5900e-03_r8,4.7314e-07_r8/) + kao(:, 2,12, 2) = (/ & + &6.9235e-02_r8,6.0581e-02_r8,5.1926e-02_r8,4.3273e-02_r8,3.4620e-02_r8,2.5967e-02_r8, & + &1.7314e-02_r8,8.6616e-03_r8,1.0517e-06_r8/) + kao(:, 3,12, 2) = (/ & + &8.9222e-02_r8,7.8070e-02_r8,6.6918e-02_r8,5.5767e-02_r8,4.4616e-02_r8,3.3465e-02_r8, & + &2.2315e-02_r8,1.1167e-02_r8,2.1820e-06_r8/) + kao(:, 4,12, 2) = (/ & + &1.1266e-01_r8,9.8579e-02_r8,8.4496e-02_r8,7.0418e-02_r8,5.6336e-02_r8,4.2258e-02_r8, & + &2.8182e-02_r8,1.4107e-02_r8,4.2014e-06_r8/) + kao(:, 5,12, 2) = (/ & + &1.3942e-01_r8,1.2199e-01_r8,1.0457e-01_r8,8.7148e-02_r8,6.9722e-02_r8,5.2304e-02_r8, & + &3.4887e-02_r8,1.7469e-02_r8,7.4819e-06_r8/) + kao(:, 1,13, 2) = (/ & + &6.2876e-02_r8,5.5018e-02_r8,4.7159e-02_r8,3.9299e-02_r8,3.1440e-02_r8,2.3581e-02_r8, & + &1.5722e-02_r8,7.8632e-03_r8,4.0954e-07_r8/) + kao(:, 2,13, 2) = (/ & + &8.2400e-02_r8,7.2100e-02_r8,6.1801e-02_r8,5.1502e-02_r8,4.1203e-02_r8,3.0903e-02_r8, & + &2.0605e-02_r8,1.0307e-02_r8,9.1322e-07_r8/) + kao(:, 3,13, 2) = (/ & + &1.0586e-01_r8,9.2633e-02_r8,7.9402e-02_r8,6.6169e-02_r8,5.2938e-02_r8,3.9706e-02_r8, & + &2.6476e-02_r8,1.3248e-02_r8,1.8983e-06_r8/) + kao(:, 4,13, 2) = (/ & + &1.3330e-01_r8,1.1664e-01_r8,9.9979e-02_r8,8.3320e-02_r8,6.6657e-02_r8,4.9998e-02_r8, & + &3.3342e-02_r8,1.6688e-02_r8,3.6054e-06_r8/) + kao(:, 5,13, 2) = (/ & + &1.6451e-01_r8,1.4395e-01_r8,1.2339e-01_r8,1.0283e-01_r8,8.2267e-02_r8,6.1710e-02_r8, & + &4.1158e-02_r8,2.0605e-02_r8,6.1726e-06_r8/) + kao(:, 1, 1, 3) = (/ & + &1.0158e-05_r8,1.3198e-05_r8,1.2933e-05_r8,1.7710e-05_r8,3.0455e-05_r8,3.0829e-05_r8, & + &3.6460e-05_r8,4.7058e-05_r8,1.7479e-05_r8/) + kao(:, 2, 1, 3) = (/ & + &1.1438e-05_r8,1.5570e-05_r8,1.6943e-05_r8,1.4755e-05_r8,2.6165e-05_r8,3.0134e-05_r8, & + &3.4781e-05_r8,5.6113e-05_r8,2.1722e-05_r8/) + kao(:, 3, 1, 3) = (/ & + &1.2956e-05_r8,1.8129e-05_r8,1.9971e-05_r8,1.8485e-05_r8,1.6628e-05_r8,3.1264e-05_r8, & + &3.4010e-05_r8,5.1158e-05_r8,2.4518e-05_r8/) + kao(:, 4, 1, 3) = (/ & + &1.4615e-05_r8,2.0830e-05_r8,2.2660e-05_r8,2.2625e-05_r8,1.9967e-05_r8,2.4812e-05_r8, & + &3.9103e-05_r8,5.0423e-05_r8,1.7758e-05_r8/) + kao(:, 5, 1, 3) = (/ & + &1.6017e-05_r8,2.3480e-05_r8,2.5498e-05_r8,2.6186e-05_r8,2.5773e-05_r8,1.9360e-05_r8, & + &3.6373e-05_r8,5.8002e-05_r8,2.1777e-05_r8/) + kao(:, 1, 2, 3) = (/ & + &1.6325e-05_r8,1.8415e-05_r8,1.8317e-05_r8,1.4470e-05_r8,2.4482e-05_r8,3.9161e-05_r8, & + &3.6427e-05_r8,3.6776e-05_r8,1.2226e-05_r8/) + kao(:, 2, 2, 3) = (/ & + &1.8436e-05_r8,2.1492e-05_r8,2.2101e-05_r8,2.0928e-05_r8,1.7486e-05_r8,3.4569e-05_r8, & + &3.4173e-05_r8,4.1432e-05_r8,1.6945e-05_r8/) + kao(:, 3, 2, 3) = (/ & + &2.0725e-05_r8,2.4812e-05_r8,2.5608e-05_r8,2.5315e-05_r8,2.0861e-05_r8,2.2865e-05_r8, & + &3.3858e-05_r8,3.7106e-05_r8,1.4100e-05_r8/) + kao(:, 4, 2, 3) = (/ & + &2.3257e-05_r8,2.7888e-05_r8,2.9222e-05_r8,2.9285e-05_r8,2.7055e-05_r8,2.2581e-05_r8, & + &3.3589e-05_r8,3.8281e-05_r8,1.2084e-05_r8/) + kao(:, 5, 2, 3) = (/ & + &2.5809e-05_r8,3.1443e-05_r8,3.3009e-05_r8,3.2988e-05_r8,3.1499e-05_r8,2.8005e-05_r8, & + &2.1824e-05_r8,4.6522e-05_r8,1.8788e-05_r8/) + kao(:, 1, 3, 3) = (/ & + &3.6153e-05_r8,3.6160e-05_r8,3.3889e-05_r8,3.0515e-05_r8,2.3824e-05_r8,2.0510e-05_r8, & + &5.5046e-05_r8,4.3679e-05_r8,8.4874e-06_r8/) + kao(:, 2, 3, 3) = (/ & + &4.1441e-05_r8,4.2015e-05_r8,3.9744e-05_r8,3.6451e-05_r8,3.1872e-05_r8,2.2157e-05_r8, & + &3.7036e-05_r8,4.0290e-05_r8,7.7192e-06_r8/) + kao(:, 3, 3, 3) = (/ & + &4.6667e-05_r8,4.8191e-05_r8,4.5785e-05_r8,4.2457e-05_r8,3.7818e-05_r8,3.1272e-05_r8, & + &2.3354e-05_r8,3.9936e-05_r8,6.8348e-06_r8/) + kao(:, 4, 3, 3) = (/ & + &5.1877e-05_r8,5.4060e-05_r8,5.1719e-05_r8,4.8126e-05_r8,4.3652e-05_r8,3.8051e-05_r8, & + &2.7576e-05_r8,4.1113e-05_r8,1.0881e-05_r8/) + kao(:, 5, 3, 3) = (/ & + &5.7673e-05_r8,6.0087e-05_r8,5.7843e-05_r8,5.4035e-05_r8,4.9732e-05_r8,4.3859e-05_r8, & + &3.4661e-05_r8,3.3926e-05_r8,1.5564e-05_r8/) + kao(:, 1, 4, 3) = (/ & + &8.1569e-05_r8,7.6506e-05_r8,6.9052e-05_r8,6.0598e-05_r8,5.1130e-05_r8,3.9208e-05_r8, & + &2.1647e-05_r8,7.1331e-05_r8,4.7464e-06_r8/) + kao(:, 2, 4, 3) = (/ & + &9.5409e-05_r8,8.9513e-05_r8,8.1016e-05_r8,7.1228e-05_r8,6.0322e-05_r8,4.8270e-05_r8, & + &3.1172e-05_r8,4.9123e-05_r8,3.8536e-06_r8/) + kao(:, 3, 4, 3) = (/ & + &1.0835e-04_r8,1.0286e-04_r8,9.3383e-05_r8,8.2438e-05_r8,7.0089e-05_r8,5.7019e-05_r8, & + &4.1480e-05_r8,3.2272e-05_r8,5.8347e-06_r8/) + kao(:, 4, 4, 3) = (/ & + &1.2088e-04_r8,1.1587e-04_r8,1.0589e-04_r8,9.3297e-05_r8,7.9862e-05_r8,6.5329e-05_r8, & + &4.9231e-05_r8,2.5421e-05_r8,9.1036e-06_r8/) + kao(:, 5, 4, 3) = (/ & + &1.3349e-04_r8,1.2852e-04_r8,1.1738e-04_r8,1.0384e-04_r8,8.9286e-05_r8,7.3614e-05_r8, & + &5.6906e-05_r8,3.4260e-05_r8,1.3290e-05_r8/) + kao(:, 1, 5, 3) = (/ & + &1.7345e-04_r8,1.5727e-04_r8,1.3841e-04_r8,1.1872e-04_r8,9.8241e-05_r8,7.6833e-05_r8, & + &5.2762e-05_r8,2.6555e-05_r8,1.9880e-06_r8/) + kao(:, 2, 5, 3) = (/ & + &2.0342e-04_r8,1.8508e-04_r8,1.6349e-04_r8,1.4064e-04_r8,1.1678e-04_r8,9.1597e-05_r8, & + &6.4678e-05_r8,2.5634e-05_r8,3.0971e-06_r8/) + kao(:, 3, 5, 3) = (/ & + &2.3455e-04_r8,2.1397e-04_r8,1.8954e-04_r8,1.6295e-04_r8,1.3528e-04_r8,1.0632e-04_r8, & + &7.5971e-05_r8,4.0302e-05_r8,5.0300e-06_r8/) + kao(:, 4, 5, 3) = (/ & + &2.6426e-04_r8,2.4201e-04_r8,2.1476e-04_r8,1.8503e-04_r8,1.5431e-04_r8,1.2132e-04_r8, & + &8.7057e-05_r8,4.9691e-05_r8,7.6275e-06_r8/) + kao(:, 5, 5, 3) = (/ & + &2.9276e-04_r8,2.6878e-04_r8,2.3851e-04_r8,2.0652e-04_r8,1.7242e-04_r8,1.3630e-04_r8, & + &9.8498e-05_r8,5.7853e-05_r8,1.1134e-05_r8/) + kao(:, 1, 6, 3) = (/ & + &3.5315e-04_r8,3.1458e-04_r8,2.7325e-04_r8,2.3096e-04_r8,1.8808e-04_r8,1.4453e-04_r8, & + &9.9918e-05_r8,4.6331e-05_r8,1.2347e-06_r8/) + kao(:, 2, 6, 3) = (/ & + &4.1518e-04_r8,3.7021e-04_r8,3.2222e-04_r8,2.7318e-04_r8,2.2345e-04_r8,1.7257e-04_r8, & + &1.2006e-04_r8,6.3507e-05_r8,2.6453e-06_r8/) + kao(:, 3, 6, 3) = (/ & + &4.8020e-04_r8,4.2942e-04_r8,3.7435e-04_r8,3.1847e-04_r8,2.6105e-04_r8,2.0180e-04_r8, & + &1.4068e-04_r8,7.6253e-05_r8,4.2798e-06_r8/) + kao(:, 4, 6, 3) = (/ & + &5.4571e-04_r8,4.8797e-04_r8,4.2639e-04_r8,3.6432e-04_r8,2.9826e-04_r8,2.3028e-04_r8, & + &1.6074e-04_r8,8.8155e-05_r8,6.6580e-06_r8/) + kao(:, 5, 6, 3) = (/ & + &6.1051e-04_r8,5.4685e-04_r8,4.8080e-04_r8,4.0919e-04_r8,3.3486e-04_r8,2.5913e-04_r8, & + &1.8080e-04_r8,9.9384e-05_r8,9.9722e-06_r8/) + kao(:, 1, 7, 3) = (/ & + &7.5693e-04_r8,6.6624e-04_r8,5.7513e-04_r8,4.8344e-04_r8,3.9061e-04_r8,2.9600e-04_r8, & + &2.0095e-04_r8,1.0427e-04_r8,1.0591e-06_r8/) + kao(:, 2, 7, 3) = (/ & + &8.9608e-04_r8,7.8973e-04_r8,6.8311e-04_r8,5.7440e-04_r8,4.6329e-04_r8,3.5236e-04_r8, & + &2.4053e-04_r8,1.2653e-04_r8,2.0677e-06_r8/) + kao(:, 3, 7, 3) = (/ & + &1.0434e-03_r8,9.2160e-04_r8,7.9776e-04_r8,6.7036e-04_r8,5.4238e-04_r8,4.1393e-04_r8, & + &2.8414e-04_r8,1.5011e-04_r8,3.4509e-06_r8/) + kao(:, 4, 7, 3) = (/ & + &1.1912e-03_r8,1.0536e-03_r8,9.1065e-04_r8,7.6644e-04_r8,6.2208e-04_r8,4.7601e-04_r8, & + &3.2680e-04_r8,1.7285e-04_r8,5.5547e-06_r8/) + kao(:, 5, 7, 3) = (/ & + &1.3354e-03_r8,1.1809e-03_r8,1.0220e-03_r8,8.6241e-04_r8,7.0147e-04_r8,5.3735e-04_r8, & + &3.6893e-04_r8,1.9541e-04_r8,8.3477e-06_r8/) + kao(:, 1, 8, 3) = (/ & + &2.0322e-03_r8,1.7810e-03_r8,1.5293e-03_r8,1.2777e-03_r8,1.0262e-03_r8,7.7431e-04_r8, & + &5.2105e-04_r8,2.6538e-04_r8,9.6103e-07_r8/) + kao(:, 2, 8, 3) = (/ & + &2.4399e-03_r8,2.1393e-03_r8,1.8380e-03_r8,1.5373e-03_r8,1.2364e-03_r8,9.3375e-04_r8, & + &6.2913e-04_r8,3.2110e-04_r8,1.7921e-06_r8/) + kao(:, 3, 8, 3) = (/ & + &2.8537e-03_r8,2.5030e-03_r8,2.1528e-03_r8,1.8027e-03_r8,1.4507e-03_r8,1.0966e-03_r8, & + &7.3847e-04_r8,3.7883e-04_r8,3.0446e-06_r8/) + kao(:, 4, 8, 3) = (/ & + &3.2833e-03_r8,2.8808e-03_r8,2.4800e-03_r8,2.0779e-03_r8,1.6729e-03_r8,1.2622e-03_r8, & + &8.5179e-04_r8,4.3974e-04_r8,4.8671e-06_r8/) + kao(:, 5, 8, 3) = (/ & + &3.6992e-03_r8,3.2483e-03_r8,2.7990e-03_r8,2.3454e-03_r8,1.8857e-03_r8,1.4259e-03_r8, & + &9.6561e-04_r8,4.9917e-04_r8,7.5866e-06_r8/) + kao(:, 1, 9, 3) = (/ & + &1.0280e-02_r8,8.9965e-03_r8,7.7134e-03_r8,6.4300e-03_r8,5.1466e-03_r8,3.8628e-03_r8, & + &2.5792e-03_r8,1.2964e-03_r8,9.2162e-07_r8/) + kao(:, 2, 9, 3) = (/ & + &1.2564e-02_r8,1.0997e-02_r8,9.4289e-03_r8,7.8609e-03_r8,6.2929e-03_r8,4.7248e-03_r8, & + &3.1577e-03_r8,1.5902e-03_r8,1.8412e-06_r8/) + kao(:, 3, 9, 3) = (/ & + &1.4876e-02_r8,1.3021e-02_r8,1.1166e-02_r8,9.3099e-03_r8,7.4544e-03_r8,5.6000e-03_r8, & + &3.7464e-03_r8,1.8890e-03_r8,3.6551e-06_r8/) + kao(:, 4, 9, 3) = (/ & + &1.7233e-02_r8,1.5085e-02_r8,1.2936e-02_r8,1.0788e-02_r8,8.6402e-03_r8,6.4946e-03_r8, & + &4.3480e-03_r8,2.1937e-03_r8,6.4505e-06_r8/) + kao(:, 5, 9, 3) = (/ & + &1.9529e-02_r8,1.7097e-02_r8,1.4665e-02_r8,1.2232e-02_r8,9.8022e-03_r8,7.3739e-03_r8, & + &4.9380e-03_r8,2.4934e-03_r8,1.0329e-05_r8/) + kao(:, 1,10, 3) = (/ & + &6.2934e-02_r8,5.5068e-02_r8,4.7203e-02_r8,3.9337e-02_r8,3.1472e-02_r8,2.3606e-02_r8, & + &1.5740e-02_r8,7.8743e-03_r8,1.2141e-06_r8/) + kao(:, 2,10, 3) = (/ & + &7.7985e-02_r8,6.8239e-02_r8,5.8492e-02_r8,4.8746e-02_r8,3.8999e-02_r8,2.9252e-02_r8, & + &1.9507e-02_r8,9.7597e-03_r8,2.5517e-06_r8/) + kao(:, 3,10, 3) = (/ & + &9.3312e-02_r8,8.1650e-02_r8,6.9991e-02_r8,5.8328e-02_r8,4.6667e-02_r8,3.5007e-02_r8, & + &2.3345e-02_r8,1.1684e-02_r8,4.6909e-06_r8/) + kao(:, 4,10, 3) = (/ & + &1.0852e-01_r8,9.4962e-02_r8,8.1401e-02_r8,6.7840e-02_r8,5.4279e-02_r8,4.0718e-02_r8, & + &2.7157e-02_r8,1.3598e-02_r8,7.7426e-06_r8/) + kao(:, 5,10, 3) = (/ & + &1.2387e-01_r8,1.0840e-01_r8,9.2920e-02_r8,7.7443e-02_r8,6.1965e-02_r8,4.6488e-02_r8, & + &3.1009e-02_r8,1.5537e-02_r8,1.2033e-05_r8/) + kao(:, 1,11, 3) = (/ & + &1.4431e-01_r8,1.2627e-01_r8,1.0823e-01_r8,9.0195e-02_r8,7.2157e-02_r8,5.4120e-02_r8, & + &3.6082e-02_r8,1.8045e-02_r8,1.2885e-06_r8/) + kao(:, 2,11, 3) = (/ & + &1.7767e-01_r8,1.5546e-01_r8,1.3326e-01_r8,1.1105e-01_r8,8.8842e-02_r8,6.6637e-02_r8, & + &4.4429e-02_r8,2.2220e-02_r8,2.6746e-06_r8/) + kao(:, 3,11, 3) = (/ & + &2.1192e-01_r8,1.8543e-01_r8,1.5895e-01_r8,1.3246e-01_r8,1.0597e-01_r8,7.9483e-02_r8, & + &5.2995e-02_r8,2.6507e-02_r8,4.8840e-06_r8/) + kao(:, 4,11, 3) = (/ & + &2.4571e-01_r8,2.1501e-01_r8,1.8430e-01_r8,1.5358e-01_r8,1.2287e-01_r8,9.2163e-02_r8, & + &6.1452e-02_r8,3.0740e-02_r8,7.9723e-06_r8/) + kao(:, 5,11, 3) = (/ & + &2.7981e-01_r8,2.4483e-01_r8,2.0987e-01_r8,1.7490e-01_r8,1.3993e-01_r8,1.0496e-01_r8, & + &6.9988e-02_r8,3.5019e-02_r8,1.2223e-05_r8/) + kao(:, 1,12, 3) = (/ & + &2.0829e-01_r8,1.8226e-01_r8,1.5622e-01_r8,1.3018e-01_r8,1.0415e-01_r8,7.8112e-02_r8, & + &5.2077e-02_r8,2.6041e-02_r8,1.2025e-06_r8/) + kao(:, 2,12, 3) = (/ & + &2.5587e-01_r8,2.2388e-01_r8,1.9190e-01_r8,1.5992e-01_r8,1.2794e-01_r8,9.5954e-02_r8, & + &6.3973e-02_r8,3.1992e-02_r8,2.4634e-06_r8/) + kao(:, 3,12, 3) = (/ & + &3.0401e-01_r8,2.6600e-01_r8,2.2801e-01_r8,1.9001e-01_r8,1.5201e-01_r8,1.1401e-01_r8, & + &7.6014e-02_r8,3.8015e-02_r8,4.4929e-06_r8/) + kao(:, 4,12, 3) = (/ & + &3.5185e-01_r8,3.0787e-01_r8,2.6390e-01_r8,2.1992e-01_r8,1.7594e-01_r8,1.3196e-01_r8, & + &8.7984e-02_r8,4.4005e-02_r8,7.2358e-06_r8/) + kao(:, 5,12, 3) = (/ & + &3.9955e-01_r8,3.4961e-01_r8,2.9967e-01_r8,2.4973e-01_r8,1.9980e-01_r8,1.4985e-01_r8, & + &9.9920e-02_r8,4.9982e-02_r8,1.1171e-05_r8/) + kao(:, 1,13, 3) = (/ & + &2.4192e-01_r8,2.1167e-01_r8,1.8143e-01_r8,1.5120e-01_r8,1.2096e-01_r8,9.0718e-02_r8, & + &6.0481e-02_r8,3.0243e-02_r8,1.0138e-06_r8/) + kao(:, 2,13, 3) = (/ & + &2.9636e-01_r8,2.5932e-01_r8,2.2227e-01_r8,1.8523e-01_r8,1.4819e-01_r8,1.1114e-01_r8, & + &7.4096e-02_r8,3.7053e-02_r8,2.0810e-06_r8/) + kao(:, 3,13, 3) = (/ & + &3.5109e-01_r8,3.0721e-01_r8,2.6332e-01_r8,2.1944e-01_r8,1.7555e-01_r8,1.3167e-01_r8, & + &8.7782e-02_r8,4.3898e-02_r8,3.6752e-06_r8/) + kao(:, 4,13, 3) = (/ & + &4.0523e-01_r8,3.5457e-01_r8,3.0393e-01_r8,2.5327e-01_r8,2.0263e-01_r8,1.5197e-01_r8, & + &1.0132e-01_r8,5.0676e-02_r8,6.1123e-06_r8/) + kao(:, 5,13, 3) = (/ & + &4.5914e-01_r8,4.0175e-01_r8,3.4437e-01_r8,2.8698e-01_r8,2.2959e-01_r8,1.7221e-01_r8, & + &1.1482e-01_r8,5.7432e-02_r8,9.7404e-06_r8/) + kao(:, 1, 1, 4) = (/ & + &2.1350e-05_r8,2.4552e-05_r8,2.3723e-05_r8,1.5777e-05_r8,2.7169e-05_r8,3.2921e-05_r8, & + &3.9368e-05_r8,6.8629e-05_r8,2.6626e-05_r8/) + kao(:, 2, 1, 4) = (/ & + &2.2878e-05_r8,2.6833e-05_r8,2.6737e-05_r8,2.0377e-05_r8,2.2142e-05_r8,3.1966e-05_r8, & + &4.1566e-05_r8,6.1320e-05_r8,2.3858e-05_r8/) + kao(:, 3, 1, 4) = (/ & + &2.3851e-05_r8,2.8963e-05_r8,2.9322e-05_r8,2.7907e-05_r8,1.9726e-05_r8,2.5598e-05_r8, & + &4.2650e-05_r8,6.7498e-05_r8,2.1250e-05_r8/) + kao(:, 4, 1, 4) = (/ & + &2.4297e-05_r8,3.1053e-05_r8,3.2431e-05_r8,3.1771e-05_r8,2.7799e-05_r8,2.0892e-05_r8, & + &3.7144e-05_r8,7.1944e-05_r8,2.3747e-05_r8/) + kao(:, 5, 1, 4) = (/ & + &2.4515e-05_r8,3.3133e-05_r8,3.5554e-05_r8,3.5376e-05_r8,3.4171e-05_r8,2.9240e-05_r8, & + &2.7955e-05_r8,6.5059e-05_r8,3.8779e-05_r8/) + kao(:, 1, 2, 4) = (/ & + &3.5233e-05_r8,3.6967e-05_r8,3.5192e-05_r8,3.0346e-05_r8,1.9517e-05_r8,3.6227e-05_r8, & + &3.6486e-05_r8,4.4755e-05_r8,1.7210e-05_r8/) + kao(:, 2, 2, 4) = (/ & + &3.7659e-05_r8,4.0104e-05_r8,3.8633e-05_r8,3.5461e-05_r8,2.4007e-05_r8,2.9205e-05_r8, & + &3.6839e-05_r8,4.4274e-05_r8,1.6582e-05_r8/) + kao(:, 3, 2, 4) = (/ & + &3.9567e-05_r8,4.2994e-05_r8,4.2107e-05_r8,3.9324e-05_r8,3.3808e-05_r8,2.0621e-05_r8, & + &3.2387e-05_r8,5.0199e-05_r8,1.2696e-05_r8/) + kao(:, 4, 2, 4) = (/ & + &4.0697e-05_r8,4.5929e-05_r8,4.5740e-05_r8,4.2992e-05_r8,3.9709e-05_r8,2.8967e-05_r8, & + &2.4180e-05_r8,4.8120e-05_r8,2.0582e-05_r8/) + kao(:, 5, 2, 4) = (/ & + &4.1514e-05_r8,4.8565e-05_r8,4.9023e-05_r8,4.7662e-05_r8,4.4382e-05_r8,3.8389e-05_r8, & + &2.5686e-05_r8,4.1842e-05_r8,3.1906e-05_r8/) + kao(:, 1, 3, 4) = (/ & + &8.1562e-05_r8,7.8380e-05_r8,7.1455e-05_r8,6.3207e-05_r8,5.2782e-05_r8,3.3109e-05_r8, & + &4.1621e-05_r8,4.2434e-05_r8,8.8242e-06_r8/) + kao(:, 2, 3, 4) = (/ & + &8.6593e-05_r8,8.4470e-05_r8,7.7554e-05_r8,6.8896e-05_r8,5.8997e-05_r8,4.4824e-05_r8, & + &3.0840e-05_r8,4.1510e-05_r8,8.5693e-06_r8/) + kao(:, 3, 3, 4) = (/ & + &9.1353e-05_r8,8.9996e-05_r8,8.3114e-05_r8,7.4541e-05_r8,6.4935e-05_r8,5.3159e-05_r8, & + &2.8537e-05_r8,3.9838e-05_r8,1.1226e-05_r8/) + kao(:, 4, 3, 4) = (/ & + &9.5365e-05_r8,9.5648e-05_r8,8.9016e-05_r8,8.0719e-05_r8,7.0818e-05_r8,5.8632e-05_r8, & + &4.0977e-05_r8,3.3245e-05_r8,1.8214e-05_r8/) + kao(:, 5, 3, 4) = (/ & + &9.7542e-05_r8,1.0001e-04_r8,9.4766e-05_r8,8.7247e-05_r8,7.6489e-05_r8,6.4569e-05_r8, & + &5.1322e-05_r8,2.4346e-05_r8,2.6190e-05_r8/) + kao(:, 1, 4, 4) = (/ & + &1.9526e-04_r8,1.7866e-04_r8,1.5808e-04_r8,1.3593e-04_r8,1.1271e-04_r8,8.7918e-05_r8, & + &5.1266e-05_r8,5.4774e-05_r8,4.6025e-06_r8/) + kao(:, 2, 4, 4) = (/ & + &2.0650e-04_r8,1.9062e-04_r8,1.6960e-04_r8,1.4698e-04_r8,1.2286e-04_r8,9.7273e-05_r8, & + &6.7543e-05_r8,4.4150e-05_r8,5.6277e-06_r8/) + kao(:, 3, 4, 4) = (/ & + &2.1739e-04_r8,2.0276e-04_r8,1.8135e-04_r8,1.5734e-04_r8,1.3233e-04_r8,1.0548e-04_r8, & + &7.6274e-05_r8,3.0228e-05_r8,9.8992e-06_r8/) + kao(:, 4, 4, 4) = (/ & + &2.2749e-04_r8,2.1410e-04_r8,1.9235e-04_r8,1.6801e-04_r8,1.4178e-04_r8,1.1383e-04_r8, & + &8.3889e-05_r8,3.8831e-05_r8,1.4832e-05_r8/) + kao(:, 5, 4, 4) = (/ & + &2.3672e-04_r8,2.2535e-04_r8,2.0298e-04_r8,1.7817e-04_r8,1.5157e-04_r8,1.2285e-04_r8, & + &9.1248e-05_r8,5.4055e-05_r8,2.0953e-05_r8/) + kao(:, 1, 5, 4) = (/ & + &4.3901e-04_r8,3.9096e-04_r8,3.4083e-04_r8,2.8855e-04_r8,2.3566e-04_r8,1.8135e-04_r8, & + &1.2520e-04_r8,3.9791e-05_r8,2.8698e-06_r8/) + kao(:, 2, 5, 4) = (/ & + &4.6450e-04_r8,4.1602e-04_r8,3.6285e-04_r8,3.0879e-04_r8,2.5330e-04_r8,1.9642e-04_r8, & + &1.3685e-04_r8,6.9096e-05_r8,4.7432e-06_r8/) + kao(:, 3, 5, 4) = (/ & + &4.8882e-04_r8,4.4052e-04_r8,3.8581e-04_r8,3.3048e-04_r8,2.7253e-04_r8,2.1160e-04_r8, & + &1.4899e-04_r8,8.1167e-05_r8,8.1879e-06_r8/) + kao(:, 4, 5, 4) = (/ & + &5.1005e-04_r8,4.6303e-04_r8,4.0950e-04_r8,3.5246e-04_r8,2.9060e-04_r8,2.2675e-04_r8, & + &1.6042e-04_r8,8.9994e-05_r8,1.2389e-05_r8/) + kao(:, 5, 5, 4) = (/ & + &5.2999e-04_r8,4.8642e-04_r8,4.3340e-04_r8,3.7157e-04_r8,3.0721e-04_r8,2.4050e-04_r8, & + &1.7156e-04_r8,9.8341e-05_r8,1.7831e-05_r8/) + kao(:, 1, 6, 4) = (/ & + &9.3945e-04_r8,8.2623e-04_r8,7.1331e-04_r8,5.9949e-04_r8,4.8483e-04_r8,3.6836e-04_r8, & + &2.5086e-04_r8,1.2938e-04_r8,2.1494e-06_r8/) + kao(:, 2, 6, 4) = (/ & + &1.0016e-03_r8,8.8499e-04_r8,7.6750e-04_r8,6.4657e-04_r8,5.2304e-04_r8,3.9902e-04_r8, & + &2.7391e-04_r8,1.4413e-04_r8,3.8318e-06_r8/) + kao(:, 3, 6, 4) = (/ & + &1.0547e-03_r8,9.3464e-04_r8,8.1142e-04_r8,6.8349e-04_r8,5.5479e-04_r8,4.2609e-04_r8, & + &2.9394e-04_r8,1.5646e-04_r8,6.4475e-06_r8/) + kao(:, 4, 6, 4) = (/ & + &1.1032e-03_r8,9.8345e-04_r8,8.5527e-04_r8,7.2211e-04_r8,5.9000e-04_r8,4.5529e-04_r8, & + &3.1446e-04_r8,1.6904e-04_r8,9.9612e-06_r8/) + kao(:, 5, 6, 4) = (/ & + &1.1467e-03_r8,1.0269e-03_r8,8.9466e-04_r8,7.6180e-04_r8,6.2654e-04_r8,4.8317e-04_r8, & + &3.3526e-04_r8,1.8155e-04_r8,1.4635e-05_r8/) + kao(:, 1, 7, 4) = (/ & + &2.0968e-03_r8,1.8382e-03_r8,1.5799e-03_r8,1.3200e-03_r8,1.0602e-03_r8,8.0055e-04_r8, & + &5.3931e-04_r8,2.7613e-04_r8,1.7495e-06_r8/) + kao(:, 2, 7, 4) = (/ & + &2.2692e-03_r8,1.9926e-03_r8,1.7142e-03_r8,1.4356e-03_r8,1.1561e-03_r8,8.7560e-04_r8, & + &5.9192e-04_r8,3.0494e-04_r8,3.2823e-06_r8/) + kao(:, 3, 7, 4) = (/ & + &2.3957e-03_r8,2.1065e-03_r8,1.8155e-03_r8,1.5242e-03_r8,1.2302e-03_r8,9.3213e-04_r8, & + &6.3098e-04_r8,3.2845e-04_r8,5.4452e-06_r8/) + kao(:, 4, 7, 4) = (/ & + &2.5154e-03_r8,2.2153e-03_r8,1.9155e-03_r8,1.6120e-03_r8,1.3009e-03_r8,9.8717e-04_r8, & + &6.7313e-04_r8,3.5215e-04_r8,8.4591e-06_r8/) + kao(:, 5, 7, 4) = (/ & + &2.6221e-03_r8,2.3149e-03_r8,2.0078e-03_r8,1.6896e-03_r8,1.3663e-03_r8,1.0418e-03_r8, & + &7.1380e-04_r8,3.7558e-04_r8,1.3208e-05_r8/) + kao(:, 1, 8, 4) = (/ & + &5.9687e-03_r8,5.2249e-03_r8,4.4818e-03_r8,3.7390e-03_r8,2.9959e-03_r8,2.2513e-03_r8, & + &1.5068e-03_r8,7.6107e-04_r8,1.5072e-06_r8/) + kao(:, 2, 8, 4) = (/ & + &6.4060e-03_r8,5.6103e-03_r8,4.8155e-03_r8,4.0184e-03_r8,3.2203e-03_r8,2.4232e-03_r8, & + &1.6246e-03_r8,8.2361e-04_r8,2.9177e-06_r8/) + kao(:, 3, 8, 4) = (/ & + &6.8363e-03_r8,5.9919e-03_r8,5.1443e-03_r8,4.2950e-03_r8,3.4467e-03_r8,2.5980e-03_r8, & + &1.7471e-03_r8,8.8934e-04_r8,5.0920e-06_r8/) + kao(:, 4, 8, 4) = (/ & + &7.1796e-03_r8,6.2954e-03_r8,5.4063e-03_r8,4.5177e-03_r8,3.6307e-03_r8,2.7430e-03_r8, & + &1.8488e-03_r8,9.4284e-04_r8,8.3290e-06_r8/) + kao(:, 5, 8, 4) = (/ & + &7.5276e-03_r8,6.6017e-03_r8,5.6732e-03_r8,4.7473e-03_r8,3.8229e-03_r8,2.8925e-03_r8, & + &1.9515e-03_r8,1.0013e-03_r8,1.2816e-05_r8/) + kao(:, 1, 9, 4) = (/ & + &3.2487e-02_r8,2.8428e-02_r8,2.4369e-02_r8,2.0309e-02_r8,1.6251e-02_r8,1.2192e-02_r8, & + &8.1342e-03_r8,4.0755e-03_r8,1.9489e-06_r8/) + kao(:, 2, 9, 4) = (/ & + &3.4271e-02_r8,2.9992e-02_r8,2.5712e-02_r8,2.1432e-02_r8,1.7152e-02_r8,1.2873e-02_r8, & + &8.5913e-03_r8,4.3059e-03_r8,3.6526e-06_r8/) + kao(:, 3, 9, 4) = (/ & + &3.6903e-02_r8,3.2297e-02_r8,2.7692e-02_r8,2.3087e-02_r8,1.8480e-02_r8,1.3870e-02_r8, & + &9.2583e-03_r8,4.6485e-03_r8,5.8762e-06_r8/) + kao(:, 4, 9, 4) = (/ & + &3.8979e-02_r8,3.4119e-02_r8,2.9257e-02_r8,2.4392e-02_r8,1.9526e-02_r8,1.4659e-02_r8, & + &9.7912e-03_r8,4.9264e-03_r8,9.0883e-06_r8/) + kao(:, 5, 9, 4) = (/ & + &4.0909e-02_r8,3.5808e-02_r8,3.0705e-02_r8,2.5602e-02_r8,2.0497e-02_r8,1.5392e-02_r8, & + &1.0293e-02_r8,5.1880e-03_r8,1.4132e-05_r8/) + kao(:, 1,10, 4) = (/ & + &2.1003e-01_r8,1.8378e-01_r8,1.5753e-01_r8,1.3127e-01_r8,1.0502e-01_r8,7.8770e-02_r8, & + &5.2516e-02_r8,2.6264e-02_r8,2.2708e-06_r8/) + kao(:, 2,10, 4) = (/ & + &2.2303e-01_r8,1.9515e-01_r8,1.6728e-01_r8,1.3940e-01_r8,1.1153e-01_r8,8.3651e-02_r8, & + &5.5777e-02_r8,2.7901e-02_r8,4.3388e-06_r8/) + kao(:, 3,10, 4) = (/ & + &2.3715e-01_r8,2.0752e-01_r8,1.7788e-01_r8,1.4824e-01_r8,1.1861e-01_r8,8.8964e-02_r8, & + &5.9326e-02_r8,2.9681e-02_r8,8.0389e-06_r8/) + kao(:, 4,10, 4) = (/ & + &2.5270e-01_r8,2.2113e-01_r8,1.8955e-01_r8,1.5796e-01_r8,1.2638e-01_r8,9.4802e-02_r8, & + &6.3220e-02_r8,3.1633e-02_r8,1.4122e-05_r8/) + kao(:, 5,10, 4) = (/ & + &2.6544e-01_r8,2.3227e-01_r8,1.9911e-01_r8,1.6593e-01_r8,1.3276e-01_r8,9.9586e-02_r8, & + &6.6411e-02_r8,3.3237e-02_r8,2.0958e-05_r8/) + kao(:, 1,11, 4) = (/ & + &4.6663e-01_r8,4.0831e-01_r8,3.4998e-01_r8,2.9165e-01_r8,2.3332e-01_r8,1.7500e-01_r8, & + &1.1667e-01_r8,5.8341e-02_r8,2.3420e-06_r8/) + kao(:, 2,11, 4) = (/ & + &4.9719e-01_r8,4.3506e-01_r8,3.7290e-01_r8,3.1076e-01_r8,2.4862e-01_r8,1.8647e-01_r8, & + &1.2432e-01_r8,6.2174e-02_r8,4.5807e-06_r8/) + kao(:, 3,11, 4) = (/ & + &5.2774e-01_r8,4.6176e-01_r8,3.9581e-01_r8,3.2984e-01_r8,2.6389e-01_r8,1.9793e-01_r8, & + &1.3196e-01_r8,6.5997e-02_r8,8.8811e-06_r8/) + kao(:, 4,11, 4) = (/ & + &5.6221e-01_r8,4.9195e-01_r8,4.2167e-01_r8,3.5141e-01_r8,2.8114e-01_r8,2.1086e-01_r8, & + &1.4059e-01_r8,7.0317e-02_r8,1.5538e-05_r8/) + kao(:, 5,11, 4) = (/ & + &5.9121e-01_r8,5.1732e-01_r8,4.4343e-01_r8,3.6953e-01_r8,2.9564e-01_r8,2.2174e-01_r8, & + &1.4785e-01_r8,7.3949e-02_r8,2.4433e-05_r8/) + kao(:, 1,12, 4) = (/ & + &6.5249e-01_r8,5.7093e-01_r8,4.8937e-01_r8,4.0781e-01_r8,3.2625e-01_r8,2.4469e-01_r8, & + &1.6313e-01_r8,8.1572e-02_r8,2.2330e-06_r8/) + kao(:, 2,12, 4) = (/ & + &6.9534e-01_r8,6.0842e-01_r8,5.2151e-01_r8,4.3459e-01_r8,3.4768e-01_r8,2.6076e-01_r8, & + &1.7385e-01_r8,8.6935e-02_r8,4.3967e-06_r8/) + kao(:, 3,12, 4) = (/ & + &7.4143e-01_r8,6.4875e-01_r8,5.5607e-01_r8,4.6339e-01_r8,3.7072e-01_r8,2.7805e-01_r8, & + &1.8537e-01_r8,9.2701e-02_r8,8.3925e-06_r8/) + kao(:, 4,12, 4) = (/ & + &7.8904e-01_r8,6.9042e-01_r8,5.9179e-01_r8,4.9316e-01_r8,3.9453e-01_r8,2.9591e-01_r8, & + &1.9728e-01_r8,9.8661e-02_r8,1.5232e-05_r8/) + kao(:, 5,12, 4) = (/ & + &8.3131e-01_r8,7.2741e-01_r8,6.2350e-01_r8,5.1959e-01_r8,4.1567e-01_r8,3.1177e-01_r8, & + &2.0786e-01_r8,1.0395e-01_r8,2.3060e-05_r8/) + kao(:, 1,13, 4) = (/ & + &7.3322e-01_r8,6.4157e-01_r8,5.4992e-01_r8,4.5827e-01_r8,3.6662e-01_r8,2.7497e-01_r8, & + &1.8332e-01_r8,9.1663e-02_r8,1.8044e-06_r8/) + kao(:, 2,13, 4) = (/ & + &7.8224e-01_r8,6.8446e-01_r8,5.8668e-01_r8,4.8890e-01_r8,3.9113e-01_r8,2.9335e-01_r8, & + &1.9557e-01_r8,9.7794e-02_r8,3.6622e-06_r8/) + kao(:, 3,13, 4) = (/ & + &8.3769e-01_r8,7.3298e-01_r8,6.2826e-01_r8,5.2356e-01_r8,4.1885e-01_r8,3.1414e-01_r8, & + &2.0944e-01_r8,1.0473e-01_r8,6.8549e-06_r8/) + kao(:, 4,13, 4) = (/ & + &8.9145e-01_r8,7.8000e-01_r8,6.6858e-01_r8,5.5715e-01_r8,4.4572e-01_r8,3.3430e-01_r8, & + &2.2288e-01_r8,1.1145e-01_r8,1.1699e-05_r8/) + kao(:, 5,13, 4) = (/ & + &9.4256e-01_r8,8.2475e-01_r8,7.0694e-01_r8,5.8912e-01_r8,4.7129e-01_r8,3.5348e-01_r8, & + &2.3566e-01_r8,1.1785e-01_r8,1.9250e-05_r8/) + kao(:, 1, 1, 5) = (/ & + &3.1890e-05_r8,3.3428e-05_r8,3.1339e-05_r8,1.9062e-05_r8,2.1359e-05_r8,2.6190e-05_r8, & + &4.2364e-05_r8,7.2281e-05_r8,2.8801e-05_r8/) + kao(:, 2, 1, 5) = (/ & + &3.2241e-05_r8,3.5034e-05_r8,3.4311e-05_r8,2.9337e-05_r8,1.6956e-05_r8,2.7153e-05_r8, & + &4.1595e-05_r8,7.5807e-05_r8,2.1642e-05_r8/) + kao(:, 3, 1, 5) = (/ & + &3.2685e-05_r8,3.7104e-05_r8,3.7239e-05_r8,3.5440e-05_r8,2.4683e-05_r8,2.0584e-05_r8, & + &3.9467e-05_r8,7.0498e-05_r8,2.5433e-05_r8/) + kao(:, 4, 1, 5) = (/ & + &3.3108e-05_r8,3.9233e-05_r8,3.9843e-05_r8,4.0632e-05_r8,3.9351e-05_r8,2.7492e-05_r8, & + &2.7372e-05_r8,6.6136e-05_r8,4.2940e-05_r8/) + kao(:, 5, 1, 5) = (/ & + &3.3102e-05_r8,4.1126e-05_r8,4.3706e-05_r8,4.7600e-05_r8,5.0514e-05_r8,4.9463e-05_r8, & + &3.6482e-05_r8,4.9147e-05_r8,6.6970e-05_r8/) + kao(:, 1, 2, 5) = (/ & + &5.3936e-05_r8,5.3705e-05_r8,4.9534e-05_r8,4.3483e-05_r8,2.4468e-05_r8,2.7314e-05_r8, & + &3.0874e-05_r8,5.5614e-05_r8,1.6658e-05_r8/) + kao(:, 2, 2, 5) = (/ & + &5.4860e-05_r8,5.5845e-05_r8,5.2280e-05_r8,4.7572e-05_r8,3.6459e-05_r8,1.9946e-05_r8, & + &3.1643e-05_r8,4.8991e-05_r8,1.3490e-05_r8/) + kao(:, 3, 2, 5) = (/ & + &5.5709e-05_r8,5.8014e-05_r8,5.5306e-05_r8,5.1404e-05_r8,4.5520e-05_r8,2.7920e-05_r8, & + &2.4697e-05_r8,4.8298e-05_r8,2.2442e-05_r8/) + kao(:, 4, 2, 5) = (/ & + &5.6594e-05_r8,6.0421e-05_r8,5.8710e-05_r8,5.5553e-05_r8,5.0533e-05_r8,4.1849e-05_r8, & + &2.3926e-05_r8,4.4332e-05_r8,3.8077e-05_r8/) + kao(:, 5, 2, 5) = (/ & + &5.6989e-05_r8,6.3301e-05_r8,6.2702e-05_r8,5.9556e-05_r8,5.7075e-05_r8,5.4328e-05_r8, & + &4.2106e-05_r8,3.0435e-05_r8,5.5304e-05_r8/) + kao(:, 1, 3, 5) = (/ & + &1.3054e-04_r8,1.2243e-04_r8,1.0960e-04_r8,9.5396e-05_r8,7.9466e-05_r8,5.1293e-05_r8, & + &3.9755e-05_r8,3.4475e-05_r8,8.0698e-06_r8/) + kao(:, 2, 3, 5) = (/ & + &1.3254e-04_r8,1.2631e-04_r8,1.1422e-04_r8,1.0017e-04_r8,8.4724e-05_r8,6.6970e-05_r8, & + &3.1985e-05_r8,3.1748e-05_r8,1.1668e-05_r8/) + kao(:, 3, 3, 5) = (/ & + &1.3451e-04_r8,1.3069e-04_r8,1.1849e-04_r8,1.0449e-04_r8,8.9441e-05_r8,7.3066e-05_r8, & + &4.0433e-05_r8,3.2069e-05_r8,2.1119e-05_r8/) + kao(:, 4, 3, 5) = (/ & + &1.3620e-04_r8,1.3418e-04_r8,1.2287e-04_r8,1.0958e-04_r8,9.5020e-05_r8,7.9300e-05_r8, & + &5.8519e-05_r8,2.5240e-05_r8,3.2095e-05_r8/) + kao(:, 5, 3, 5) = (/ & + &1.3805e-04_r8,1.3888e-04_r8,1.2760e-04_r8,1.1481e-04_r8,1.0157e-04_r8,8.6256e-05_r8, & + &6.7417e-05_r8,3.0660e-05_r8,4.5147e-05_r8/) + kao(:, 1, 4, 5) = (/ & + &3.2379e-04_r8,2.9036e-04_r8,2.5461e-04_r8,2.1829e-04_r8,1.8055e-04_r8,1.4064e-04_r8, & + &9.6199e-05_r8,5.2600e-05_r8,5.3338e-06_r8/) + kao(:, 2, 4, 5) = (/ & + &3.2979e-04_r8,2.9999e-04_r8,2.6566e-04_r8,2.2924e-04_r8,1.9018e-04_r8,1.4831e-04_r8, & + &1.0429e-04_r8,3.7208e-05_r8,1.1382e-05_r8/) + kao(:, 3, 4, 5) = (/ & + &3.3647e-04_r8,3.0773e-04_r8,2.7537e-04_r8,2.3841e-04_r8,1.9818e-04_r8,1.5534e-04_r8, & + &1.1107e-04_r8,4.2940e-05_r8,1.8774e-05_r8/) + kao(:, 4, 4, 5) = (/ & + &3.4222e-04_r8,3.1790e-04_r8,2.8515e-04_r8,2.4672e-04_r8,2.0544e-04_r8,1.6267e-04_r8, & + &1.1806e-04_r8,6.5823e-05_r8,2.7569e-05_r8/) + kao(:, 5, 4, 5) = (/ & + &3.4598e-04_r8,3.2526e-04_r8,2.9297e-04_r8,2.5514e-04_r8,2.1384e-04_r8,1.7093e-04_r8, & + &1.2620e-04_r8,7.6156e-05_r8,3.8829e-05_r8/) + kao(:, 1, 5, 5) = (/ & + &7.4853e-04_r8,6.5989e-04_r8,5.7237e-04_r8,4.8339e-04_r8,3.9258e-04_r8,3.0112e-04_r8, & + &2.0775e-04_r8,1.0511e-04_r8,4.9046e-06_r8/) + kao(:, 2, 5, 5) = (/ & + &7.7296e-04_r8,6.8526e-04_r8,5.9860e-04_r8,5.0629e-04_r8,4.1334e-04_r8,3.1913e-04_r8, & + &2.2288e-04_r8,1.1662e-04_r8,9.7426e-06_r8/) + kao(:, 3, 5, 5) = (/ & + &7.8512e-04_r8,7.0191e-04_r8,6.1328e-04_r8,5.2156e-04_r8,4.2917e-04_r8,3.3432e-04_r8, & + &2.3232e-04_r8,1.2535e-04_r8,1.4908e-05_r8/) + kao(:, 4, 5, 5) = (/ & + &8.0065e-04_r8,7.1779e-04_r8,6.2814e-04_r8,5.3808e-04_r8,4.4471e-04_r8,3.4601e-04_r8, & + &2.4241e-04_r8,1.3326e-04_r8,2.1852e-05_r8/) + kao(:, 5, 5, 5) = (/ & + &8.1368e-04_r8,7.3211e-04_r8,6.4458e-04_r8,5.5662e-04_r8,4.6149e-04_r8,3.6022e-04_r8, & + &2.5323e-04_r8,1.4142e-04_r8,3.1532e-05_r8/) + kao(:, 1, 6, 5) = (/ & + &1.6528e-03_r8,1.4497e-03_r8,1.2477e-03_r8,1.0459e-03_r8,8.4296e-04_r8,6.4013e-04_r8, & + &4.3541e-04_r8,2.2882e-04_r8,4.1025e-06_r8/) + kao(:, 2, 6, 5) = (/ & + &1.7167e-03_r8,1.5070e-03_r8,1.2980e-03_r8,1.0901e-03_r8,8.8256e-04_r8,6.7196e-04_r8, & + &4.5785e-04_r8,2.4158e-04_r8,7.1575e-06_r8/) + kao(:, 3, 6, 5) = (/ & + &1.7542e-03_r8,1.5443e-03_r8,1.3374e-03_r8,1.1305e-03_r8,9.1589e-04_r8,6.9839e-04_r8, & + &4.8070e-04_r8,2.5576e-04_r8,1.1170e-05_r8/) + kao(:, 4, 6, 5) = (/ & + &1.7835e-03_r8,1.5745e-03_r8,1.3686e-03_r8,1.1552e-03_r8,9.3898e-04_r8,7.2100e-04_r8, & + &4.9974e-04_r8,2.6756e-04_r8,1.6778e-05_r8/) + kao(:, 5, 6, 5) = (/ & + &1.8173e-03_r8,1.6109e-03_r8,1.3997e-03_r8,1.1836e-03_r8,9.6533e-04_r8,7.4477e-04_r8, & + &5.1869e-04_r8,2.7889e-04_r8,2.4339e-05_r8/) + kao(:, 1, 7, 5) = (/ & + &3.9726e-03_r8,3.4772e-03_r8,2.9832e-03_r8,2.4912e-03_r8,1.9978e-03_r8,1.5048e-03_r8, & + &1.0114e-03_r8,5.1606e-04_r8,3.0815e-06_r8/) + kao(:, 2, 7, 5) = (/ & + &3.9885e-03_r8,3.4924e-03_r8,2.9992e-03_r8,2.5047e-03_r8,2.0117e-03_r8,1.5168e-03_r8, & + &1.0225e-03_r8,5.2471e-04_r8,5.4224e-06_r8/) + kao(:, 3, 7, 5) = (/ & + &4.1133e-03_r8,3.6053e-03_r8,3.0965e-03_r8,2.5896e-03_r8,2.0823e-03_r8,1.5758e-03_r8, & + &1.0680e-03_r8,5.5159e-04_r8,9.0931e-06_r8/) + kao(:, 4, 7, 5) = (/ & + &4.1858e-03_r8,3.6723e-03_r8,3.1582e-03_r8,2.6449e-03_r8,2.1343e-03_r8,1.6217e-03_r8, & + &1.1005e-03_r8,5.7513e-04_r8,1.3973e-05_r8/) + kao(:, 5, 7, 5) = (/ & + &4.2673e-03_r8,3.7471e-03_r8,3.2256e-03_r8,2.7082e-03_r8,2.1908e-03_r8,1.6652e-03_r8, & + &1.1349e-03_r8,5.9686e-04_r8,1.9907e-05_r8/) + kao(:, 1, 8, 5) = (/ & + &1.1789e-02_r8,1.0316e-02_r8,8.8432e-03_r8,7.3701e-03_r8,5.8982e-03_r8,4.4284e-03_r8, & + &2.9575e-03_r8,1.4868e-03_r8,2.6362e-06_r8/) + kao(:, 2, 8, 5) = (/ & + &1.1815e-02_r8,1.0339e-02_r8,8.8633e-03_r8,7.3911e-03_r8,5.9198e-03_r8,4.4454e-03_r8, & + &2.9722e-03_r8,1.4993e-03_r8,4.7391e-06_r8/) + kao(:, 3, 8, 5) = (/ & + &1.2063e-02_r8,1.0556e-02_r8,9.0547e-03_r8,7.5533e-03_r8,6.0485e-03_r8,4.5441e-03_r8, & + &3.0419e-03_r8,1.5395e-03_r8,7.9686e-06_r8/) + kao(:, 4, 8, 5) = (/ & + &1.2374e-02_r8,1.0835e-02_r8,9.2985e-03_r8,7.7571e-03_r8,6.2150e-03_r8,4.6751e-03_r8, & + &3.1349e-03_r8,1.5981e-03_r8,1.2907e-05_r8/) + kao(:, 5, 8, 5) = (/ & + &1.2586e-02_r8,1.1028e-02_r8,9.4648e-03_r8,7.8998e-03_r8,6.3362e-03_r8,4.7714e-03_r8, & + &3.2105e-03_r8,1.6437e-03_r8,1.9633e-05_r8/) + kao(:, 1, 9, 5) = (/ & + &6.5443e-02_r8,5.7264e-02_r8,4.9084e-02_r8,4.0904e-02_r8,3.2723e-02_r8,2.4543e-02_r8, & + &1.6364e-02_r8,8.1848e-03_r8,3.1432e-06_r8/) + kao(:, 2, 9, 5) = (/ & + &6.6880e-02_r8,5.8521e-02_r8,5.0162e-02_r8,4.1802e-02_r8,3.3443e-02_r8,2.5083e-02_r8, & + &1.6728e-02_r8,8.3763e-03_r8,5.7297e-06_r8/) + kao(:, 3, 9, 5) = (/ & + &6.6965e-02_r8,5.8596e-02_r8,5.0227e-02_r8,4.1857e-02_r8,3.3491e-02_r8,2.5128e-02_r8, & + &1.6767e-02_r8,8.3954e-03_r8,1.0132e-05_r8/) + kao(:, 4, 9, 5) = (/ & + &6.9095e-02_r8,6.0459e-02_r8,5.1827e-02_r8,4.3201e-02_r8,3.4575e-02_r8,2.5948e-02_r8, & + &1.7311e-02_r8,8.6749e-03_r8,1.6592e-05_r8/) + kao(:, 5, 9, 5) = (/ & + &7.0723e-02_r8,6.1894e-02_r8,5.3070e-02_r8,4.4247e-02_r8,3.5417e-02_r8,2.6580e-02_r8, & + &1.7739e-02_r8,8.9030e-03_r8,2.5109e-05_r8/) + kao(:, 1,10, 5) = (/ & + &4.3117e-01_r8,3.7727e-01_r8,3.2338e-01_r8,2.6948e-01_r8,2.1559e-01_r8,1.6169e-01_r8, & + &1.0779e-01_r8,5.3898e-02_r8,3.8321e-06_r8/) + kao(:, 2,10, 5) = (/ & + &4.4275e-01_r8,3.8740e-01_r8,3.3206e-01_r8,2.7672e-01_r8,2.2138e-01_r8,1.6603e-01_r8, & + &1.1069e-01_r8,5.5347e-02_r8,7.9189e-06_r8/) + kao(:, 3,10, 5) = (/ & + &4.5038e-01_r8,3.9409e-01_r8,3.3779e-01_r8,2.8149e-01_r8,2.2519e-01_r8,1.6890e-01_r8, & + &1.1260e-01_r8,5.6313e-02_r8,1.3890e-05_r8/) + kao(:, 4,10, 5) = (/ & + &4.5731e-01_r8,4.0015e-01_r8,3.4299e-01_r8,2.8583e-01_r8,2.2868e-01_r8,1.7152e-01_r8, & + &1.1436e-01_r8,5.7212e-02_r8,2.2042e-05_r8/) + kao(:, 5,10, 5) = (/ & + &4.7192e-01_r8,4.1294e-01_r8,3.5396e-01_r8,2.9499e-01_r8,2.3600e-01_r8,1.7703e-01_r8, & + &1.1805e-01_r8,5.9063e-02_r8,3.5819e-05_r8/) + kao(:, 1,11, 5) = (/ & + &9.6082e-01_r8,8.4073e-01_r8,7.2062e-01_r8,6.0052e-01_r8,4.8042e-01_r8,3.6032e-01_r8, & + &2.4021e-01_r8,1.2011e-01_r8,4.1252e-06_r8/) + kao(:, 2,11, 5) = (/ & + &9.8883e-01_r8,8.6524e-01_r8,7.4164e-01_r8,6.1802e-01_r8,4.9442e-01_r8,3.7082e-01_r8, & + &2.4722e-01_r8,1.2361e-01_r8,8.2890e-06_r8/) + kao(:, 3,11, 5) = (/ & + &1.0099e+00_r8,8.8371e-01_r8,7.5745e-01_r8,6.3122e-01_r8,5.0498e-01_r8,3.7874e-01_r8, & + &2.5251e-01_r8,1.2627e-01_r8,1.3752e-05_r8/) + kao(:, 4,11, 5) = (/ & + &1.0275e+00_r8,8.9904e-01_r8,7.7063e-01_r8,6.4220e-01_r8,5.1377e-01_r8,3.8534e-01_r8, & + &2.5691e-01_r8,1.2849e-01_r8,2.1878e-05_r8/) + kao(:, 5,11, 5) = (/ & + &1.0619e+00_r8,9.2921e-01_r8,7.9651e-01_r8,6.6374e-01_r8,5.3103e-01_r8,3.9829e-01_r8, & + &2.6556e-01_r8,1.3282e-01_r8,3.3798e-05_r8/) + kao(:, 1,12, 5) = (/ & + &1.3448e+00_r8,1.1767e+00_r8,1.0086e+00_r8,8.4049e-01_r8,6.7240e-01_r8,5.0429e-01_r8, & + &3.3620e-01_r8,1.6810e-01_r8,3.8444e-06_r8/) + kao(:, 2,12, 5) = (/ & + &1.3870e+00_r8,1.2136e+00_r8,1.0403e+00_r8,8.6689e-01_r8,6.9351e-01_r8,5.2014e-01_r8, & + &3.4675e-01_r8,1.7338e-01_r8,8.1656e-06_r8/) + kao(:, 3,12, 5) = (/ & + &1.4199e+00_r8,1.2424e+00_r8,1.0649e+00_r8,8.8747e-01_r8,7.0998e-01_r8,5.3249e-01_r8, & + &3.5500e-01_r8,1.7752e-01_r8,1.3518e-05_r8/) + kao(:, 4,12, 5) = (/ & + &1.4553e+00_r8,1.2734e+00_r8,1.0915e+00_r8,9.0958e-01_r8,7.2769e-01_r8,5.4578e-01_r8, & + &3.6386e-01_r8,1.8196e-01_r8,2.0674e-05_r8/) + kao(:, 5,12, 5) = (/ & + &1.5049e+00_r8,1.3168e+00_r8,1.1287e+00_r8,9.4058e-01_r8,7.5249e-01_r8,5.6439e-01_r8, & + &3.7628e-01_r8,1.8817e-01_r8,3.3221e-05_r8/) + kao(:, 1,13, 5) = (/ & + &1.5112e+00_r8,1.3223e+00_r8,1.1334e+00_r8,9.4452e-01_r8,7.5561e-01_r8,5.6670e-01_r8, & + &3.7781e-01_r8,1.8891e-01_r8,3.4136e-06_r8/) + kao(:, 2,13, 5) = (/ & + &1.5630e+00_r8,1.3677e+00_r8,1.1723e+00_r8,9.7690e-01_r8,7.8153e-01_r8,5.8614e-01_r8, & + &3.9077e-01_r8,1.9539e-01_r8,7.2314e-06_r8/) + kao(:, 3,13, 5) = (/ & + &1.6029e+00_r8,1.4025e+00_r8,1.2022e+00_r8,1.0018e+00_r8,8.0146e-01_r8,6.0110e-01_r8, & + &4.0074e-01_r8,2.0039e-01_r8,1.2933e-05_r8/) + kao(:, 4,13, 5) = (/ & + &1.6548e+00_r8,1.4480e+00_r8,1.2411e+00_r8,1.0343e+00_r8,8.2742e-01_r8,6.2059e-01_r8, & + &4.1374e-01_r8,2.0689e-01_r8,2.1420e-05_r8/) + kao(:, 5,13, 5) = (/ & + &1.7129e+00_r8,1.4988e+00_r8,1.2846e+00_r8,1.0706e+00_r8,8.5645e-01_r8,6.4235e-01_r8, & + &4.2827e-01_r8,2.1415e-01_r8,3.1482e-05_r8/) + kao(:, 1, 1, 6) = (/ & + &4.0608e-05_r8,4.2185e-05_r8,3.9730e-05_r8,2.6630e-05_r8,1.5870e-05_r8,2.1720e-05_r8, & + &4.0183e-05_r8,5.7933e-05_r8,1.9230e-05_r8/) + kao(:, 2, 1, 6) = (/ & + &4.0560e-05_r8,4.3924e-05_r8,4.2843e-05_r8,4.0587e-05_r8,1.9599e-05_r8,1.9434e-05_r8, & + &2.9187e-05_r8,8.1729e-05_r8,2.4180e-05_r8/) + kao(:, 3, 1, 6) = (/ & + &4.0596e-05_r8,4.5223e-05_r8,4.7233e-05_r8,4.8206e-05_r8,4.1815e-05_r8,2.4282e-05_r8, & + &2.7535e-05_r8,5.3025e-05_r8,4.5769e-05_r8/) + kao(:, 4, 1, 6) = (/ & + &4.0424e-05_r8,4.7527e-05_r8,5.3798e-05_r8,5.7119e-05_r8,5.7658e-05_r8,5.2268e-05_r8, & + &3.6355e-05_r8,4.4941e-05_r8,8.6910e-05_r8/) + kao(:, 5, 1, 6) = (/ & + &4.0234e-05_r8,5.1685e-05_r8,6.0703e-05_r8,6.7173e-05_r8,7.3473e-05_r8,7.8264e-05_r8, & + &7.7542e-05_r8,6.1561e-05_r8,1.1878e-04_r8/) + kao(:, 1, 2, 6) = (/ & + &7.1743e-05_r8,6.9776e-05_r8,6.4069e-05_r8,5.6253e-05_r8,3.2492e-05_r8,1.5299e-05_r8, & + &2.5979e-05_r8,5.8422e-05_r8,1.3265e-05_r8/) + kao(:, 2, 2, 6) = (/ & + &7.1061e-05_r8,7.2097e-05_r8,6.7274e-05_r8,6.0734e-05_r8,5.1280e-05_r8,2.1520e-05_r8, & + &1.9911e-05_r8,4.4529e-05_r8,1.9523e-05_r8/) + kao(:, 3, 2, 6) = (/ & + &7.0841e-05_r8,7.4370e-05_r8,7.0760e-05_r8,6.5655e-05_r8,6.0306e-05_r8,4.1020e-05_r8, & + &2.4466e-05_r8,3.0981e-05_r8,4.7368e-05_r8/) + kao(:, 4, 2, 6) = (/ & + &7.0995e-05_r8,7.6358e-05_r8,7.4085e-05_r8,7.2263e-05_r8,6.9627e-05_r8,6.3412e-05_r8, & + &3.9010e-05_r8,3.3220e-05_r8,7.3941e-05_r8/) + kao(:, 5, 2, 6) = (/ & + &7.1418e-05_r8,7.8720e-05_r8,7.9350e-05_r8,8.0487e-05_r8,8.0635e-05_r8,7.8967e-05_r8, & + &7.4070e-05_r8,4.7509e-05_r8,9.9451e-05_r8/) + kao(:, 1, 3, 6) = (/ & + &1.7804e-04_r8,1.6309e-04_r8,1.4603e-04_r8,1.2640e-04_r8,1.0532e-04_r8,7.7851e-05_r8, & + &3.0401e-05_r8,3.2808e-05_r8,1.0278e-05_r8/) + kao(:, 2, 3, 6) = (/ & + &1.7807e-04_r8,1.6656e-04_r8,1.5059e-04_r8,1.3159e-04_r8,1.1024e-04_r8,8.6966e-05_r8, & + &3.8390e-05_r8,2.7178e-05_r8,2.3712e-05_r8/) + kao(:, 3, 3, 6) = (/ & + &1.7838e-04_r8,1.6972e-04_r8,1.5616e-04_r8,1.3747e-04_r8,1.1728e-04_r8,9.5070e-05_r8, & + &6.7563e-05_r8,2.2396e-05_r8,4.2459e-05_r8/) + kao(:, 4, 3, 6) = (/ & + &1.7857e-04_r8,1.7475e-04_r8,1.6100e-04_r8,1.4311e-04_r8,1.2411e-04_r8,1.0321e-04_r8, & + &8.1061e-05_r8,2.7084e-05_r8,5.9922e-05_r8/) + kao(:, 5, 3, 6) = (/ & + &1.7913e-04_r8,1.7932e-04_r8,1.6663e-04_r8,1.4905e-04_r8,1.3079e-04_r8,1.1234e-04_r8, & + &9.4176e-05_r8,5.9304e-05_r8,8.0703e-05_r8/) + kao(:, 1, 4, 6) = (/ & + &4.5849e-04_r8,4.0719e-04_r8,3.5630e-04_r8,3.0212e-04_r8,2.4723e-04_r8,1.9208e-04_r8, & + &1.3224e-04_r8,4.0670e-05_r8,1.0786e-05_r8/) + kao(:, 2, 4, 6) = (/ & + &4.6326e-04_r8,4.1501e-04_r8,3.6371e-04_r8,3.1046e-04_r8,2.5726e-04_r8,2.0145e-04_r8, & + &1.4032e-04_r8,4.2661e-05_r8,2.2724e-05_r8/) + kao(:, 3, 4, 6) = (/ & + &4.5999e-04_r8,4.1805e-04_r8,3.6892e-04_r8,3.1975e-04_r8,2.6673e-04_r8,2.0947e-04_r8, & + &1.4924e-04_r8,6.8954e-05_r8,3.3787e-05_r8/) + kao(:, 4, 4, 6) = (/ & + &4.6003e-04_r8,4.1972e-04_r8,3.7753e-04_r8,3.3032e-04_r8,2.7779e-04_r8,2.1909e-04_r8, & + &1.5785e-04_r8,9.1573e-05_r8,4.7343e-05_r8/) + kao(:, 5, 4, 6) = (/ & + &4.6253e-04_r8,4.2854e-04_r8,3.8917e-04_r8,3.4007e-04_r8,2.8599e-04_r8,2.2760e-04_r8, & + &1.6713e-04_r8,1.0392e-04_r8,6.4507e-05_r8/) + kao(:, 1, 5, 6) = (/ & + &1.1046e-03_r8,9.7210e-04_r8,8.3818e-04_r8,7.0474e-04_r8,5.7182e-04_r8,4.3731e-04_r8, & + &3.0078e-04_r8,1.5849e-04_r8,1.0669e-05_r8/) + kao(:, 2, 5, 6) = (/ & + &1.1184e-03_r8,9.8522e-04_r8,8.5052e-04_r8,7.1956e-04_r8,5.8448e-04_r8,4.4708e-04_r8, & + &3.0943e-04_r8,1.6582e-04_r8,1.7856e-05_r8/) + kao(:, 3, 5, 6) = (/ & + &1.1214e-03_r8,9.8952e-04_r8,8.6298e-04_r8,7.3058e-04_r8,5.9526e-04_r8,4.5967e-04_r8, & + &3.2343e-04_r8,1.7504e-04_r8,2.7384e-05_r8/) + kao(:, 4, 5, 6) = (/ & + &1.1214e-03_r8,9.9887e-04_r8,8.7233e-04_r8,7.4058e-04_r8,6.1074e-04_r8,4.7706e-04_r8, & + &3.3627e-04_r8,1.8500e-04_r8,4.0071e-05_r8/) + kao(:, 5, 5, 6) = (/ & + &1.1239e-03_r8,1.0058e-03_r8,8.8047e-04_r8,7.5602e-04_r8,6.2667e-04_r8,4.9193e-04_r8, & + &3.4864e-04_r8,1.9526e-04_r8,5.6262e-05_r8/) + kao(:, 1, 6, 6) = (/ & + &2.6585e-03_r8,2.3289e-03_r8,2.0017e-03_r8,1.6725e-03_r8,1.3436e-03_r8,1.0134e-03_r8, & + &6.8348e-04_r8,3.5116e-04_r8,8.2810e-06_r8/) + kao(:, 2, 6, 6) = (/ & + &2.5863e-03_r8,2.2683e-03_r8,1.9501e-03_r8,1.6316e-03_r8,1.3110e-03_r8,9.9174e-04_r8, & + &6.7274e-04_r8,3.5111e-04_r8,1.4039e-05_r8/) + kao(:, 3, 6, 6) = (/ & + &2.6176e-03_r8,2.2991e-03_r8,1.9771e-03_r8,1.6537e-03_r8,1.3367e-03_r8,1.0179e-03_r8, & + &6.9352e-04_r8,3.6693e-04_r8,2.2683e-05_r8/) + kao(:, 4, 6, 6) = (/ & + &2.6217e-03_r8,2.3046e-03_r8,1.9871e-03_r8,1.6757e-03_r8,1.3567e-03_r8,1.0347e-03_r8, & + &7.1195e-04_r8,3.8176e-04_r8,3.4748e-05_r8/) + kao(:, 5, 6, 6) = (/ & + &2.6329e-03_r8,2.3195e-03_r8,2.0094e-03_r8,1.6960e-03_r8,1.3768e-03_r8,1.0589e-03_r8, & + &7.3230e-04_r8,3.9783e-04_r8,4.9695e-05_r8/) + kao(:, 1, 7, 6) = (/ & + &6.5036e-03_r8,5.6927e-03_r8,4.8817e-03_r8,4.0715e-03_r8,3.2636e-03_r8,2.4531e-03_r8, & + &1.6426e-03_r8,8.2916e-04_r8,6.2936e-06_r8/) + kao(:, 2, 7, 6) = (/ & + &6.4462e-03_r8,5.6438e-03_r8,4.8427e-03_r8,4.0443e-03_r8,3.2425e-03_r8,2.4409e-03_r8, & + &1.6364e-03_r8,8.3288e-04_r8,1.1136e-05_r8/) + kao(:, 3, 7, 6) = (/ & + &6.4103e-03_r8,5.6141e-03_r8,4.8233e-03_r8,4.0268e-03_r8,3.2317e-03_r8,2.4336e-03_r8, & + &1.6355e-03_r8,8.3675e-04_r8,1.7991e-05_r8/) + kao(:, 4, 7, 6) = (/ & + &6.4801e-03_r8,5.6797e-03_r8,4.8784e-03_r8,4.0772e-03_r8,3.2734e-03_r8,2.4699e-03_r8, & + &1.6705e-03_r8,8.6234e-04_r8,2.8124e-05_r8/) + kao(:, 5, 7, 6) = (/ & + &6.4899e-03_r8,5.6954e-03_r8,4.8999e-03_r8,4.1019e-03_r8,3.3007e-03_r8,2.5022e-03_r8, & + &1.6963e-03_r8,8.8568e-04_r8,4.2294e-05_r8/) + kao(:, 1, 8, 6) = (/ & + &1.9938e-02_r8,1.7447e-02_r8,1.4956e-02_r8,1.2465e-02_r8,9.9746e-03_r8,7.4836e-03_r8, & + &4.9963e-03_r8,2.5067e-03_r8,5.1161e-06_r8/) + kao(:, 2, 8, 6) = (/ & + &2.0028e-02_r8,1.7527e-02_r8,1.5026e-02_r8,1.2525e-02_r8,1.0025e-02_r8,7.5295e-03_r8, & + &5.0298e-03_r8,2.5282e-03_r8,9.0850e-06_r8/) + kao(:, 3, 8, 6) = (/ & + &1.9800e-02_r8,1.7330e-02_r8,1.4859e-02_r8,1.2391e-02_r8,9.9275e-03_r8,7.4581e-03_r8, & + &4.9868e-03_r8,2.5105e-03_r8,1.5352e-05_r8/) + kao(:, 4, 8, 6) = (/ & + &1.9943e-02_r8,1.7456e-02_r8,1.4973e-02_r8,1.2495e-02_r8,1.0008e-02_r8,7.5213e-03_r8, & + &5.0327e-03_r8,2.5396e-03_r8,2.4408e-05_r8/) + kao(:, 5, 8, 6) = (/ & + &2.0100e-02_r8,1.7597e-02_r8,1.5105e-02_r8,1.2604e-02_r8,1.0099e-02_r8,7.5963e-03_r8, & + &5.0871e-03_r8,2.5804e-03_r8,3.7067e-05_r8/) + kao(:, 1, 9, 6) = (/ & + &1.1579e-01_r8,1.0132e-01_r8,8.6843e-02_r8,7.2372e-02_r8,5.7899e-02_r8,4.3426e-02_r8, & + &2.8954e-02_r8,1.4481e-02_r8,4.8758e-06_r8/) + kao(:, 2, 9, 6) = (/ & + &1.1661e-01_r8,1.0203e-01_r8,8.7460e-02_r8,7.2886e-02_r8,5.8311e-02_r8,4.3737e-02_r8, & + &2.9163e-02_r8,1.4591e-02_r8,1.0307e-05_r8/) + kao(:, 3, 9, 6) = (/ & + &1.1709e-01_r8,1.0246e-01_r8,8.7825e-02_r8,7.3192e-02_r8,5.8559e-02_r8,4.3925e-02_r8, & + &2.9293e-02_r8,1.4674e-02_r8,1.8955e-05_r8/) + kao(:, 4, 9, 6) = (/ & + &1.1566e-01_r8,1.0121e-01_r8,8.6757e-02_r8,7.2304e-02_r8,5.7852e-02_r8,4.3402e-02_r8, & + &2.8967e-02_r8,1.4512e-02_r8,3.1114e-05_r8/) + kao(:, 5, 9, 6) = (/ & + &1.1720e-01_r8,1.0255e-01_r8,8.7909e-02_r8,7.3266e-02_r8,5.8634e-02_r8,4.4011e-02_r8, & + &2.9372e-02_r8,1.4720e-02_r8,4.7731e-05_r8/) + kao(:, 1,10, 6) = (/ & + &7.9704e-01_r8,6.9741e-01_r8,5.9778e-01_r8,4.9815e-01_r8,3.9852e-01_r8,2.9889e-01_r8, & + &1.9926e-01_r8,9.9635e-02_r8,6.0881e-06_r8/) + kao(:, 2,10, 6) = (/ & + &8.0524e-01_r8,7.0458e-01_r8,6.0393e-01_r8,5.0328e-01_r8,4.0263e-01_r8,3.0197e-01_r8, & + &2.0132e-01_r8,1.0067e-01_r8,9.9592e-06_r8/) + kao(:, 3,10, 6) = (/ & + &8.0944e-01_r8,7.0827e-01_r8,6.0708e-01_r8,5.0591e-01_r8,4.0473e-01_r8,3.0356e-01_r8, & + &2.0238e-01_r8,1.0120e-01_r8,1.7097e-05_r8/) + kao(:, 4,10, 6) = (/ & + &8.0782e-01_r8,7.0685e-01_r8,6.0589e-01_r8,5.0491e-01_r8,4.0393e-01_r8,3.0295e-01_r8, & + &2.0198e-01_r8,1.0100e-01_r8,2.9862e-05_r8/) + kao(:, 5,10, 6) = (/ & + &8.0293e-01_r8,7.0255e-01_r8,6.0220e-01_r8,5.0184e-01_r8,4.0149e-01_r8,3.0112e-01_r8, & + &2.0077e-01_r8,1.0043e-01_r8,4.8674e-05_r8/) + kao(:, 1,11, 6) = (/ & + &1.8320e+00_r8,1.6031e+00_r8,1.3740e+00_r8,1.1450e+00_r8,9.1602e-01_r8,6.8703e-01_r8, & + &4.5802e-01_r8,2.2901e-01_r8,6.4794e-06_r8/) + kao(:, 2,11, 6) = (/ & + &1.8510e+00_r8,1.6196e+00_r8,1.3883e+00_r8,1.1569e+00_r8,9.2553e-01_r8,6.9415e-01_r8, & + &4.6277e-01_r8,2.3139e-01_r8,1.1218e-05_r8/) + kao(:, 3,11, 6) = (/ & + &1.8631e+00_r8,1.6303e+00_r8,1.3974e+00_r8,1.1645e+00_r8,9.3160e-01_r8,6.9871e-01_r8, & + &4.6580e-01_r8,2.3291e-01_r8,1.9228e-05_r8/) + kao(:, 4,11, 6) = (/ & + &1.8640e+00_r8,1.6310e+00_r8,1.3980e+00_r8,1.1650e+00_r8,9.3201e-01_r8,6.9904e-01_r8, & + &4.6603e-01_r8,2.3304e-01_r8,3.3633e-05_r8/) + kao(:, 5,11, 6) = (/ & + &1.8480e+00_r8,1.6170e+00_r8,1.3860e+00_r8,1.1550e+00_r8,9.2402e-01_r8,6.9305e-01_r8, & + &4.6206e-01_r8,2.3108e-01_r8,5.6086e-05_r8/) + kao(:, 1,12, 6) = (/ & + &2.6276e+00_r8,2.2991e+00_r8,1.9707e+00_r8,1.6422e+00_r8,1.3138e+00_r8,9.8536e-01_r8, & + &6.5690e-01_r8,3.2845e-01_r8,6.1969e-06_r8/) + kao(:, 2,12, 6) = (/ & + &2.6587e+00_r8,2.3264e+00_r8,1.9940e+00_r8,1.6617e+00_r8,1.3293e+00_r8,9.9701e-01_r8, & + &6.6468e-01_r8,3.3234e-01_r8,9.9191e-06_r8/) + kao(:, 3,12, 6) = (/ & + &2.6771e+00_r8,2.3425e+00_r8,2.0078e+00_r8,1.6732e+00_r8,1.3386e+00_r8,1.0039e+00_r8, & + &6.6929e-01_r8,3.3465e-01_r8,1.7326e-05_r8/) + kao(:, 4,12, 6) = (/ & + &2.6786e+00_r8,2.3438e+00_r8,2.0090e+00_r8,1.6742e+00_r8,1.3393e+00_r8,1.0045e+00_r8, & + &6.6968e-01_r8,3.3487e-01_r8,3.0600e-05_r8/) + kao(:, 5,12, 6) = (/ & + &2.6738e+00_r8,2.3396e+00_r8,2.0054e+00_r8,1.6711e+00_r8,1.3369e+00_r8,1.0027e+00_r8, & + &6.6852e-01_r8,3.3432e-01_r8,4.9574e-05_r8/) + kao(:, 1,13, 6) = (/ & + &3.0141e+00_r8,2.6373e+00_r8,2.2606e+00_r8,1.8838e+00_r8,1.5070e+00_r8,1.1303e+00_r8, & + &7.5353e-01_r8,3.7676e-01_r8,5.4676e-06_r8/) + kao(:, 2,13, 6) = (/ & + &3.0533e+00_r8,2.6716e+00_r8,2.2900e+00_r8,1.9083e+00_r8,1.5266e+00_r8,1.1450e+00_r8, & + &7.6332e-01_r8,3.8166e-01_r8,9.0049e-06_r8/) + kao(:, 3,13, 6) = (/ & + &3.0797e+00_r8,2.6947e+00_r8,2.3097e+00_r8,1.9248e+00_r8,1.5398e+00_r8,1.1549e+00_r8, & + &7.6993e-01_r8,3.8499e-01_r8,1.5493e-05_r8/) + kao(:, 4,13, 6) = (/ & + &3.0841e+00_r8,2.6986e+00_r8,2.3131e+00_r8,1.9276e+00_r8,1.5421e+00_r8,1.1566e+00_r8, & + &7.7107e-01_r8,3.8557e-01_r8,2.5494e-05_r8/) + kao(:, 5,13, 6) = (/ & + &3.0968e+00_r8,2.7097e+00_r8,2.3226e+00_r8,1.9355e+00_r8,1.5484e+00_r8,1.1613e+00_r8, & + &7.7428e-01_r8,3.8723e-01_r8,4.2043e-05_r8/) + kao(:, 1, 1, 7) = (/ & + &4.9351e-05_r8,5.1634e-05_r8,5.0550e-05_r8,4.1436e-05_r8,1.6376e-05_r8,2.1065e-05_r8, & + &3.5627e-05_r8,5.1301e-05_r8,2.4192e-05_r8/) + kao(:, 2, 1, 7) = (/ & + &4.8474e-05_r8,5.5540e-05_r8,5.6343e-05_r8,5.4221e-05_r8,4.2170e-05_r8,2.4823e-05_r8, & + &3.1731e-05_r8,5.9201e-05_r8,4.8733e-05_r8/) + kao(:, 3, 1, 7) = (/ & + &4.7492e-05_r8,6.0199e-05_r8,6.3032e-05_r8,6.6317e-05_r8,6.8647e-05_r8,6.4541e-05_r8, & + &4.0308e-05_r8,5.5421e-05_r8,1.0385e-04_r8/) + kao(:, 4, 1, 7) = (/ & + &4.5731e-05_r8,6.4480e-05_r8,7.0656e-05_r8,8.0927e-05_r8,9.1209e-05_r8,1.0812e-04_r8, & + &1.1177e-04_r8,6.7578e-05_r8,1.5053e-04_r8/) + kao(:, 5, 1, 7) = (/ & + &4.5536e-05_r8,6.8791e-05_r8,8.4361e-05_r8,1.0008e-04_r8,1.1558e-04_r8,1.4310e-04_r8, & + &1.8138e-04_r8,1.7860e-04_r8,2.0339e-04_r8/) + kao(:, 1, 2, 7) = (/ & + &8.7853e-05_r8,8.5975e-05_r8,8.0217e-05_r8,7.2158e-05_r8,5.1923e-05_r8,1.7714e-05_r8, & + &2.3551e-05_r8,3.4001e-05_r8,1.8843e-05_r8/) + kao(:, 2, 2, 7) = (/ & + &8.7406e-05_r8,8.8950e-05_r8,8.5976e-05_r8,7.9247e-05_r8,6.9532e-05_r8,3.6395e-05_r8, & + &2.2706e-05_r8,4.1033e-05_r8,5.5544e-05_r8/) + kao(:, 3, 2, 7) = (/ & + &8.7368e-05_r8,9.3020e-05_r8,9.1442e-05_r8,8.8073e-05_r8,8.2295e-05_r8,7.2901e-05_r8, & + &4.3354e-05_r8,4.6618e-05_r8,9.4748e-05_r8/) + kao(:, 4, 2, 7) = (/ & + &8.6439e-05_r8,9.8041e-05_r8,9.9373e-05_r8,9.8643e-05_r8,9.7447e-05_r8,9.7462e-05_r8, & + &9.8905e-05_r8,6.1372e-05_r8,1.3473e-04_r8/) + kao(:, 5, 2, 7) = (/ & + &8.4149e-05_r8,1.0269e-04_r8,1.0851e-04_r8,1.1232e-04_r8,1.1694e-04_r8,1.2384e-04_r8, & + &1.3615e-04_r8,1.5254e-04_r8,1.8188e-04_r8/) + kao(:, 1, 3, 7) = (/ & + &2.2417e-04_r8,2.0404e-04_r8,1.8235e-04_r8,1.5974e-04_r8,1.3536e-04_r8,1.0733e-04_r8, & + &2.8889e-05_r8,2.3292e-05_r8,2.7610e-05_r8/) + kao(:, 2, 3, 7) = (/ & + &2.2507e-04_r8,2.0905e-04_r8,1.8945e-04_r8,1.6889e-04_r8,1.4442e-04_r8,1.1619e-04_r8, & + &5.9496e-05_r8,2.4524e-05_r8,5.6641e-05_r8/) + kao(:, 3, 3, 7) = (/ & + &2.2338e-04_r8,2.1298e-04_r8,1.9588e-04_r8,1.7647e-04_r8,1.5321e-04_r8,1.2706e-04_r8, & + &9.4765e-05_r8,2.7601e-05_r8,8.4458e-05_r8/) + kao(:, 4, 3, 7) = (/ & + &2.2342e-04_r8,2.1728e-04_r8,2.0413e-04_r8,1.8620e-04_r8,1.6349e-04_r8,1.4113e-04_r8, & + &1.1467e-04_r8,6.7006e-05_r8,1.1844e-04_r8/) + kao(:, 5, 3, 7) = (/ & + &2.2238e-04_r8,2.2192e-04_r8,2.1227e-04_r8,1.9647e-04_r8,1.7779e-04_r8,1.5802e-04_r8, & + &1.3658e-04_r8,1.1946e-04_r8,1.6048e-04_r8/) + kao(:, 1, 4, 7) = (/ & + &5.9406e-04_r8,5.2735e-04_r8,4.5854e-04_r8,3.9146e-04_r8,3.2173e-04_r8,2.5115e-04_r8, & + &1.8204e-04_r8,3.3380e-05_r8,2.9857e-05_r8/) + kao(:, 2, 4, 7) = (/ & + &6.0105e-04_r8,5.3531e-04_r8,4.6978e-04_r8,4.0022e-04_r8,3.3097e-04_r8,2.6221e-04_r8, & + &1.8773e-04_r8,5.6092e-05_r8,4.7642e-05_r8/) + kao(:, 3, 4, 7) = (/ & + &5.9920e-04_r8,5.3954e-04_r8,4.7635e-04_r8,4.1122e-04_r8,3.4497e-04_r8,2.7525e-04_r8, & + &1.9878e-04_r8,1.0920e-04_r8,7.1351e-05_r8/) + kao(:, 4, 4, 7) = (/ & + &5.9595e-04_r8,5.4459e-04_r8,4.8204e-04_r8,4.2190e-04_r8,3.5656e-04_r8,2.8691e-04_r8, & + &2.1194e-04_r8,1.2834e-04_r8,1.0247e-04_r8/) + kao(:, 5, 4, 7) = (/ & + &5.9682e-04_r8,5.4845e-04_r8,4.9542e-04_r8,4.3507e-04_r8,3.7084e-04_r8,3.0256e-04_r8, & + &2.2629e-04_r8,1.4673e-04_r8,1.4061e-04_r8/) + kao(:, 1, 5, 7) = (/ & + &1.5636e-03_r8,1.3738e-03_r8,1.1854e-03_r8,9.9627e-04_r8,8.0358e-04_r8,6.1134e-04_r8, & + &4.1794e-04_r8,2.1940e-04_r8,2.4302e-05_r8/) + kao(:, 2, 5, 7) = (/ & + &1.5046e-03_r8,1.3266e-03_r8,1.1472e-03_r8,9.6320e-04_r8,7.8248e-04_r8,5.9833e-04_r8, & + &4.1211e-04_r8,2.2595e-04_r8,3.8463e-05_r8/) + kao(:, 3, 5, 7) = (/ & + &1.5168e-03_r8,1.3431e-03_r8,1.1615e-03_r8,9.8412e-04_r8,8.0210e-04_r8,6.1684e-04_r8, & + &4.2935e-04_r8,2.3832e-04_r8,5.7958e-05_r8/) + kao(:, 4, 5, 7) = (/ & + &1.5026e-03_r8,1.3336e-03_r8,1.1649e-03_r8,9.9050e-04_r8,8.0890e-04_r8,6.2936e-04_r8, & + &4.4480e-04_r8,2.5053e-04_r8,8.4195e-05_r8/) + kao(:, 5, 5, 7) = (/ & + &1.4982e-03_r8,1.3418e-03_r8,1.1752e-03_r8,9.9791e-04_r8,8.2403e-04_r8,6.4480e-04_r8, & + &4.6309e-04_r8,2.6575e-04_r8,1.1855e-04_r8/) + kao(:, 1, 6, 7) = (/ & + &3.8022e-03_r8,3.3297e-03_r8,2.8587e-03_r8,2.3909e-03_r8,1.9206e-03_r8,1.4508e-03_r8, & + &9.7686e-04_r8,5.0103e-04_r8,1.8374e-05_r8/) + kao(:, 2, 6, 7) = (/ & + &3.7188e-03_r8,3.2606e-03_r8,2.8078e-03_r8,2.3509e-03_r8,1.8941e-03_r8,1.4317e-03_r8, & + &9.6949e-04_r8,5.0170e-04_r8,2.9781e-05_r8/) + kao(:, 3, 6, 7) = (/ & + &3.6568e-03_r8,3.2124e-03_r8,2.7660e-03_r8,2.3181e-03_r8,1.8667e-03_r8,1.4148e-03_r8, & + &9.6121e-04_r8,5.0473e-04_r8,4.5442e-05_r8/) + kao(:, 4, 6, 7) = (/ & + &3.6655e-03_r8,3.2274e-03_r8,2.7830e-03_r8,2.3318e-03_r8,1.8859e-03_r8,1.4380e-03_r8, & + &9.8239e-04_r8,5.2260e-04_r8,6.7780e-05_r8/) + kao(:, 5, 6, 7) = (/ & + &3.6236e-03_r8,3.1965e-03_r8,2.7643e-03_r8,2.3328e-03_r8,1.8928e-03_r8,1.4444e-03_r8, & + &9.9870e-04_r8,5.3910e-04_r8,9.8293e-05_r8/) + kao(:, 1, 7, 7) = (/ & + &9.7756e-03_r8,8.5557e-03_r8,7.3357e-03_r8,6.1160e-03_r8,4.8978e-03_r8,3.6826e-03_r8, & + &2.4642e-03_r8,1.2466e-03_r8,1.4263e-05_r8/) + kao(:, 2, 7, 7) = (/ & + &9.5966e-03_r8,8.4005e-03_r8,7.2050e-03_r8,6.0128e-03_r8,4.8216e-03_r8,3.6274e-03_r8, & + &2.4345e-03_r8,1.2337e-03_r8,2.4094e-05_r8/) + kao(:, 3, 7, 7) = (/ & + &9.2939e-03_r8,8.1388e-03_r8,6.9869e-03_r8,5.8375e-03_r8,4.6843e-03_r8,3.5321e-03_r8, & + &2.3720e-03_r8,1.2113e-03_r8,3.8518e-05_r8/) + kao(:, 4, 7, 7) = (/ & + &9.3185e-03_r8,8.1650e-03_r8,7.0200e-03_r8,5.8680e-03_r8,4.7180e-03_r8,3.5579e-03_r8, & + &2.3933e-03_r8,1.2260e-03_r8,6.0065e-05_r8/) + kao(:, 5, 7, 7) = (/ & + &9.2942e-03_r8,8.1544e-03_r8,7.0105e-03_r8,5.8689e-03_r8,4.7186e-03_r8,3.5646e-03_r8, & + &2.4113e-03_r8,1.2505e-03_r8,8.8114e-05_r8/) + kao(:, 1, 8, 7) = (/ & + &3.1428e-02_r8,2.7501e-02_r8,2.3574e-02_r8,1.9646e-02_r8,1.5719e-02_r8,1.1792e-02_r8, & + &7.8652e-03_r8,3.9445e-03_r8,1.1179e-05_r8/) + kao(:, 2, 8, 7) = (/ & + &3.0933e-02_r8,2.7068e-02_r8,2.3204e-02_r8,1.9341e-02_r8,1.5477e-02_r8,1.1614e-02_r8, & + &7.7579e-03_r8,3.8961e-03_r8,2.0761e-05_r8/) + kao(:, 3, 8, 7) = (/ & + &3.0367e-02_r8,2.6575e-02_r8,2.2784e-02_r8,1.8992e-02_r8,1.5203e-02_r8,1.1421e-02_r8, & + &7.6337e-03_r8,3.8475e-03_r8,3.6107e-05_r8/) + kao(:, 4, 8, 7) = (/ & + &2.9365e-02_r8,2.5702e-02_r8,2.2039e-02_r8,1.8381e-02_r8,1.4731e-02_r8,1.1072e-02_r8, & + &7.4163e-03_r8,3.7447e-03_r8,5.6666e-05_r8/) + kao(:, 5, 8, 7) = (/ & + &2.9621e-02_r8,2.5930e-02_r8,2.2243e-02_r8,1.8569e-02_r8,1.4884e-02_r8,1.1199e-02_r8, & + &7.5061e-03_r8,3.7957e-03_r8,8.4702e-05_r8/) + kao(:, 1, 9, 7) = (/ & + &1.9031e-01_r8,1.6652e-01_r8,1.4273e-01_r8,1.1894e-01_r8,9.5159e-02_r8,7.1370e-02_r8, & + &4.7583e-02_r8,2.3794e-02_r8,1.1825e-05_r8/) + kao(:, 2, 9, 7) = (/ & + &1.8790e-01_r8,1.6442e-01_r8,1.4093e-01_r8,1.1744e-01_r8,9.3958e-02_r8,7.0471e-02_r8, & + &4.6985e-02_r8,2.3500e-02_r8,2.0873e-05_r8/) + kao(:, 3, 9, 7) = (/ & + &1.8549e-01_r8,1.6231e-01_r8,1.3912e-01_r8,1.1594e-01_r8,9.2757e-02_r8,6.9574e-02_r8, & + &4.6391e-02_r8,2.3213e-02_r8,3.5554e-05_r8/) + kao(:, 4, 9, 7) = (/ & + &1.8255e-01_r8,1.5974e-01_r8,1.3693e-01_r8,1.1411e-01_r8,9.1298e-02_r8,6.8486e-02_r8, & + &4.5672e-02_r8,2.2886e-02_r8,5.8671e-05_r8/) + kao(:, 5, 9, 7) = (/ & + &1.7785e-01_r8,1.5563e-01_r8,1.3341e-01_r8,1.1118e-01_r8,8.8960e-02_r8,6.6737e-02_r8, & + &4.4547e-02_r8,2.2336e-02_r8,9.5234e-05_r8/) + kao(:, 1,10, 7) = (/ & + &1.3607e+00_r8,1.1905e+00_r8,1.0205e+00_r8,8.5040e-01_r8,6.8031e-01_r8,5.1024e-01_r8, & + &3.4016e-01_r8,1.7008e-01_r8,8.4759e-06_r8/) + kao(:, 2,10, 7) = (/ & + &1.3482e+00_r8,1.1796e+00_r8,1.0111e+00_r8,8.4260e-01_r8,6.7408e-01_r8,5.0556e-01_r8, & + &3.3705e-01_r8,1.6853e-01_r8,1.7938e-05_r8/) + kao(:, 3,10, 7) = (/ & + &1.3360e+00_r8,1.1690e+00_r8,1.0020e+00_r8,8.3498e-01_r8,6.6798e-01_r8,5.0099e-01_r8, & + &3.3400e-01_r8,1.6701e-01_r8,3.3302e-05_r8/) + kao(:, 4,10, 7) = (/ & + &1.3243e+00_r8,1.1588e+00_r8,9.9325e-01_r8,8.2771e-01_r8,6.6217e-01_r8,4.9664e-01_r8, & + &3.3111e-01_r8,1.6557e-01_r8,5.5097e-05_r8/) + kao(:, 5,10, 7) = (/ & + &1.3047e+00_r8,1.1416e+00_r8,9.7851e-01_r8,8.1543e-01_r8,6.5236e-01_r8,4.8929e-01_r8, & + &3.2621e-01_r8,1.6314e-01_r8,9.0393e-05_r8/) + kao(:, 1,11, 7) = (/ & + &3.2276e+00_r8,2.8242e+00_r8,2.4208e+00_r8,2.0173e+00_r8,1.6138e+00_r8,1.2104e+00_r8, & + &8.0693e-01_r8,4.0346e-01_r8,7.3681e-06_r8/) + kao(:, 2,11, 7) = (/ & + &3.2117e+00_r8,2.8103e+00_r8,2.4088e+00_r8,2.0073e+00_r8,1.6059e+00_r8,1.2044e+00_r8, & + &8.0294e-01_r8,4.0147e-01_r8,1.5281e-05_r8/) + kao(:, 3,11, 7) = (/ & + &3.1949e+00_r8,2.7955e+00_r8,2.3962e+00_r8,1.9968e+00_r8,1.5975e+00_r8,1.1981e+00_r8, & + &7.9874e-01_r8,3.9938e-01_r8,2.9166e-05_r8/) + kao(:, 4,11, 7) = (/ & + &3.1739e+00_r8,2.7771e+00_r8,2.3804e+00_r8,1.9837e+00_r8,1.5870e+00_r8,1.1902e+00_r8, & + &7.9350e-01_r8,3.9677e-01_r8,4.9026e-05_r8/) + kao(:, 5,11, 7) = (/ & + &3.1466e+00_r8,2.7532e+00_r8,2.3599e+00_r8,1.9666e+00_r8,1.5733e+00_r8,1.1800e+00_r8, & + &7.8668e-01_r8,3.9338e-01_r8,8.3128e-05_r8/) + kao(:, 1,12, 7) = (/ & + &4.8071e+00_r8,4.2062e+00_r8,3.6053e+00_r8,3.0044e+00_r8,2.4035e+00_r8,1.8027e+00_r8, & + &1.2018e+00_r8,6.0089e-01_r8,7.8311e-06_r8/) + kao(:, 2,12, 7) = (/ & + &4.7982e+00_r8,4.1985e+00_r8,3.5987e+00_r8,2.9989e+00_r8,2.3991e+00_r8,1.7993e+00_r8, & + &1.1996e+00_r8,5.9978e-01_r8,1.6500e-05_r8/) + kao(:, 3,12, 7) = (/ & + &4.7853e+00_r8,4.1872e+00_r8,3.5890e+00_r8,2.9909e+00_r8,2.3927e+00_r8,1.7945e+00_r8, & + &1.1963e+00_r8,5.9818e-01_r8,3.1398e-05_r8/) + kao(:, 4,12, 7) = (/ & + &4.7636e+00_r8,4.1682e+00_r8,3.5727e+00_r8,2.9773e+00_r8,2.3818e+00_r8,1.7864e+00_r8, & + &1.1909e+00_r8,5.9548e-01_r8,5.6315e-05_r8/) + kao(:, 5,12, 7) = (/ & + &4.7234e+00_r8,4.1330e+00_r8,3.5426e+00_r8,2.9521e+00_r8,2.3618e+00_r8,1.7713e+00_r8, & + &1.1809e+00_r8,5.9047e-01_r8,9.4104e-05_r8/) + kao(:, 1,13, 7) = (/ & + &5.7320e+00_r8,5.0155e+00_r8,4.2989e+00_r8,3.5824e+00_r8,2.8660e+00_r8,2.1495e+00_r8, & + &1.4330e+00_r8,7.1649e-01_r8,9.5542e-06_r8/) + kao(:, 2,13, 7) = (/ & + &5.7353e+00_r8,5.0184e+00_r8,4.3015e+00_r8,3.5845e+00_r8,2.8676e+00_r8,2.1507e+00_r8, & + &1.4338e+00_r8,7.1691e-01_r8,1.9109e-05_r8/) + kao(:, 3,13, 7) = (/ & + &5.7278e+00_r8,5.0119e+00_r8,4.2959e+00_r8,3.5799e+00_r8,2.8639e+00_r8,2.1479e+00_r8, & + &1.4320e+00_r8,7.1599e-01_r8,3.6436e-05_r8/) + kao(:, 4,13, 7) = (/ & + &5.7108e+00_r8,4.9969e+00_r8,4.2830e+00_r8,3.5692e+00_r8,2.8554e+00_r8,2.1415e+00_r8, & + &1.4277e+00_r8,7.1386e-01_r8,6.4763e-05_r8/) + kao(:, 5,13, 7) = (/ & + &5.6635e+00_r8,4.9556e+00_r8,4.2476e+00_r8,3.5397e+00_r8,2.8317e+00_r8,2.1238e+00_r8, & + &1.4159e+00_r8,7.0796e-01_r8,1.0153e-04_r8/) + kao(:, 1, 1, 8) = (/ & + &5.6440e-05_r8,6.3815e-05_r8,6.7040e-05_r8,7.2656e-05_r8,5.7075e-05_r8,3.5497e-05_r8, & + &4.7197e-05_r8,3.9064e-05_r8,8.4705e-05_r8/) + kao(:, 2, 1, 8) = (/ & + &5.6956e-05_r8,6.9440e-05_r8,7.5002e-05_r8,9.1724e-05_r8,1.1786e-04_r8,1.1581e-04_r8, & + &7.2124e-05_r8,6.3862e-05_r8,2.0332e-04_r8/) + kao(:, 3, 1, 8) = (/ & + &5.4856e-05_r8,7.4835e-05_r8,8.9381e-05_r8,1.1688e-04_r8,1.6480e-04_r8,2.0403e-04_r8, & + &2.1723e-04_r8,1.2068e-04_r8,2.9982e-04_r8/) + kao(:, 4, 1, 8) = (/ & + &5.2749e-05_r8,8.4849e-05_r8,1.1205e-04_r8,1.5064e-04_r8,2.1741e-04_r8,2.8178e-04_r8, & + &3.3958e-04_r8,3.6475e-04_r8,4.0572e-04_r8/) + kao(:, 5, 1, 8) = (/ & + &4.5645e-05_r8,1.0085e-04_r8,1.3954e-04_r8,1.9411e-04_r8,2.8393e-04_r8,3.7289e-04_r8, & + &4.5784e-04_r8,5.5744e-04_r8,5.3928e-04_r8/) + kao(:, 1, 2, 8) = (/ & + &1.0540e-04_r8,1.0513e-04_r8,1.0042e-04_r8,9.6258e-05_r8,8.8970e-05_r8,4.3184e-05_r8, & + &2.9692e-05_r8,3.3913e-05_r8,8.0284e-05_r8/) + kao(:, 2, 2, 8) = (/ & + &1.0559e-04_r8,1.0940e-04_r8,1.0770e-04_r8,1.0381e-04_r8,1.0664e-04_r8,1.1502e-04_r8, & + &8.1785e-05_r8,5.3525e-05_r8,1.4202e-04_r8/) + kao(:, 3, 2, 8) = (/ & + &1.0218e-04_r8,1.1568e-04_r8,1.1773e-04_r8,1.2016e-04_r8,1.3039e-04_r8,1.6512e-04_r8, & + &1.8884e-04_r8,1.2031e-04_r8,2.0363e-04_r8/) + kao(:, 4, 2, 8) = (/ & + &9.8487e-05_r8,1.1922e-04_r8,1.3281e-04_r8,1.4606e-04_r8,1.6549e-04_r8,2.1784e-04_r8, & + &2.7427e-04_r8,3.0595e-04_r8,2.8029e-04_r8/) + kao(:, 5, 2, 8) = (/ & + &9.4987e-05_r8,1.2846e-04_r8,1.5591e-04_r8,1.8268e-04_r8,2.1442e-04_r8,2.8547e-04_r8, & + &3.6877e-04_r8,4.4657e-04_r8,3.7746e-04_r8/) + kao(:, 1, 3, 8) = (/ & + &2.7647e-04_r8,2.5246e-04_r8,2.2770e-04_r8,2.0041e-04_r8,1.7472e-04_r8,1.4681e-04_r8, & + &4.5677e-05_r8,2.9185e-05_r8,7.9704e-05_r8/) + kao(:, 2, 3, 8) = (/ & + &2.7846e-04_r8,2.6060e-04_r8,2.3622e-04_r8,2.0968e-04_r8,1.8322e-04_r8,1.5414e-04_r8, & + &1.2348e-04_r8,3.8961e-05_r8,1.2336e-04_r8/) + kao(:, 3, 3, 8) = (/ & + &2.7763e-04_r8,2.6427e-04_r8,2.4553e-04_r8,2.2406e-04_r8,1.9856e-04_r8,1.7101e-04_r8, & + &1.5714e-04_r8,1.3645e-04_r8,1.7764e-04_r8/) + kao(:, 4, 3, 8) = (/ & + &2.7073e-04_r8,2.6684e-04_r8,2.5482e-04_r8,2.3763e-04_r8,2.1876e-04_r8,2.0158e-04_r8, & + &1.9981e-04_r8,2.4173e-04_r8,2.4735e-04_r8/) + kao(:, 5, 3, 8) = (/ & + &2.6027e-04_r8,2.7336e-04_r8,2.6560e-04_r8,2.5755e-04_r8,2.5236e-04_r8,2.4811e-04_r8, & + &2.5900e-04_r8,3.3153e-04_r8,3.3717e-04_r8/) + kao(:, 1, 4, 8) = (/ & + &7.9130e-04_r8,7.0063e-04_r8,6.1298e-04_r8,5.1987e-04_r8,4.2755e-04_r8,3.3326e-04_r8, & + &2.3363e-04_r8,3.7051e-05_r8,7.4199e-05_r8/) + kao(:, 2, 4, 8) = (/ & + &7.5980e-04_r8,6.7845e-04_r8,5.9445e-04_r8,5.1095e-04_r8,4.1981e-04_r8,3.2923e-04_r8, & + &2.4168e-04_r8,1.3135e-04_r8,1.1471e-04_r8/) + kao(:, 3, 4, 8) = (/ & + &7.6644e-04_r8,6.8984e-04_r8,6.0948e-04_r8,5.2391e-04_r8,4.3682e-04_r8,3.5056e-04_r8, & + &2.5756e-04_r8,1.6433e-04_r8,1.6687e-04_r8/) + kao(:, 4, 4, 8) = (/ & + &7.5595e-04_r8,6.9178e-04_r8,6.1629e-04_r8,5.3601e-04_r8,4.5434e-04_r8,3.7215e-04_r8, & + &2.8231e-04_r8,1.9566e-04_r8,2.3395e-04_r8/) + kao(:, 5, 4, 8) = (/ & + &7.4067e-04_r8,6.8825e-04_r8,6.1664e-04_r8,5.5301e-04_r8,4.7442e-04_r8,3.9621e-04_r8, & + &3.1512e-04_r8,2.4572e-04_r8,3.2210e-04_r8/) + kao(:, 1, 5, 8) = (/ & + &2.0703e-03_r8,1.8139e-03_r8,1.5621e-03_r8,1.3106e-03_r8,1.0600e-03_r8,8.0652e-04_r8, & + &5.5133e-04_r8,2.9069e-04_r8,6.3670e-05_r8/) + kao(:, 2, 5, 8) = (/ & + &1.9818e-03_r8,1.7441e-03_r8,1.5082e-03_r8,1.2728e-03_r8,1.0326e-03_r8,7.9434e-04_r8, & + &5.4918e-04_r8,2.9978e-04_r8,1.0147e-04_r8/) + kao(:, 3, 5, 8) = (/ & + &1.9776e-03_r8,1.7438e-03_r8,1.5149e-03_r8,1.2743e-03_r8,1.0380e-03_r8,7.9656e-04_r8, & + &5.5670e-04_r8,3.0633e-04_r8,1.5212e-04_r8/) + kao(:, 4, 5, 8) = (/ & + &1.9765e-03_r8,1.7561e-03_r8,1.5287e-03_r8,1.2973e-03_r8,1.0616e-03_r8,8.2154e-04_r8, & + &5.8167e-04_r8,3.3115e-04_r8,2.1510e-04_r8/) + kao(:, 5, 5, 8) = (/ & + &1.9526e-03_r8,1.7391e-03_r8,1.5270e-03_r8,1.3031e-03_r8,1.0804e-03_r8,8.4755e-04_r8, & + &6.0189e-04_r8,3.6102e-04_r8,2.9241e-04_r8/) + kao(:, 1, 6, 8) = (/ & + &5.2193e-03_r8,4.5684e-03_r8,3.9176e-03_r8,3.2705e-03_r8,2.6232e-03_r8,1.9766e-03_r8, & + &1.3309e-03_r8,6.8212e-04_r8,5.1398e-05_r8/) + kao(:, 2, 6, 8) = (/ & + &5.0808e-03_r8,4.4486e-03_r8,3.8217e-03_r8,3.1970e-03_r8,2.5720e-03_r8,1.9485e-03_r8, & + &1.3187e-03_r8,6.8335e-04_r8,8.5267e-05_r8/) + kao(:, 3, 6, 8) = (/ & + &4.8228e-03_r8,4.2284e-03_r8,3.6430e-03_r8,3.0578e-03_r8,2.4711e-03_r8,1.8742e-03_r8, & + &1.2774e-03_r8,6.7264e-04_r8,1.3245e-04_r8/) + kao(:, 4, 6, 8) = (/ & + &4.8943e-03_r8,4.3003e-03_r8,3.7080e-03_r8,3.1199e-03_r8,2.5213e-03_r8,1.9154e-03_r8, & + &1.3062e-03_r8,6.9055e-04_r8,1.9661e-04_r8/) + kao(:, 5, 6, 8) = (/ & + &4.8824e-03_r8,4.3025e-03_r8,3.7232e-03_r8,3.1333e-03_r8,2.5429e-03_r8,1.9512e-03_r8, & + &1.3415e-03_r8,7.2251e-04_r8,2.7802e-04_r8/) + kao(:, 1, 7, 8) = (/ & + &1.3875e-02_r8,1.2141e-02_r8,1.0408e-02_r8,8.6749e-03_r8,6.9418e-03_r8,5.2118e-03_r8, & + &3.4839e-03_r8,1.7560e-03_r8,4.0537e-05_r8/) + kao(:, 2, 7, 8) = (/ & + &1.3633e-02_r8,1.1931e-02_r8,1.0229e-02_r8,8.5279e-03_r8,6.8346e-03_r8,5.1400e-03_r8, & + &3.4444e-03_r8,1.7477e-03_r8,6.8687e-05_r8/) + kao(:, 3, 7, 8) = (/ & + &1.3328e-02_r8,1.1666e-02_r8,1.0007e-02_r8,8.3587e-03_r8,6.7074e-03_r8,5.0533e-03_r8, & + &3.4014e-03_r8,1.7372e-03_r8,1.1189e-04_r8/) + kao(:, 4, 7, 8) = (/ & + &1.2636e-02_r8,1.1066e-02_r8,9.5081e-03_r8,7.9486e-03_r8,6.3850e-03_r8,4.8258e-03_r8, & + &3.2564e-03_r8,1.6750e-03_r8,1.7143e-04_r8/) + kao(:, 5, 7, 8) = (/ & + &1.2752e-02_r8,1.1174e-02_r8,9.6135e-03_r8,8.0399e-03_r8,6.4759e-03_r8,4.9028e-03_r8, & + &3.3183e-03_r8,1.7153e-03_r8,2.5158e-04_r8/) + kao(:, 1, 8, 8) = (/ & + &4.6547e-02_r8,4.0730e-02_r8,3.4913e-02_r8,2.9095e-02_r8,2.3277e-02_r8,1.7460e-02_r8, & + &1.1642e-02_r8,5.8282e-03_r8,3.2784e-05_r8/) + kao(:, 2, 8, 8) = (/ & + &4.5721e-02_r8,4.0008e-02_r8,3.4294e-02_r8,2.8581e-02_r8,2.2868e-02_r8,1.7154e-02_r8, & + &1.1445e-02_r8,5.7448e-03_r8,5.6960e-05_r8/) + kao(:, 3, 8, 8) = (/ & + &4.4866e-02_r8,3.9261e-02_r8,3.3657e-02_r8,2.8053e-02_r8,2.2449e-02_r8,1.6850e-02_r8, & + &1.1263e-02_r8,5.6659e-03_r8,9.3969e-05_r8/) + kao(:, 4, 8, 8) = (/ & + &4.3949e-02_r8,3.8462e-02_r8,3.2975e-02_r8,2.7489e-02_r8,2.2013e-02_r8,1.6548e-02_r8, & + &1.1065e-02_r8,5.5874e-03_r8,1.4907e-04_r8/) + kao(:, 5, 8, 8) = (/ & + &4.1860e-02_r8,3.6641e-02_r8,3.1420e-02_r8,2.6211e-02_r8,2.1011e-02_r8,1.5788e-02_r8, & + &1.0584e-02_r8,5.3726e-03_r8,2.2697e-04_r8/) + kao(:, 1, 9, 8) = (/ & + &2.9682e-01_r8,2.5971e-01_r8,2.2262e-01_r8,1.8551e-01_r8,1.4841e-01_r8,1.1131e-01_r8, & + &7.4208e-02_r8,3.7107e-02_r8,2.8713e-05_r8/) + kao(:, 2, 9, 8) = (/ & + &2.9173e-01_r8,2.5526e-01_r8,2.1881e-01_r8,1.8234e-01_r8,1.4587e-01_r8,1.0941e-01_r8, & + &7.2941e-02_r8,3.6477e-02_r8,5.3026e-05_r8/) + kao(:, 3, 9, 8) = (/ & + &2.8647e-01_r8,2.5066e-01_r8,2.1486e-01_r8,1.7905e-01_r8,1.4325e-01_r8,1.0744e-01_r8, & + &7.1634e-02_r8,3.5829e-02_r8,9.1273e-05_r8/) + kao(:, 4, 9, 8) = (/ & + &2.8100e-01_r8,2.4588e-01_r8,2.1076e-01_r8,1.7564e-01_r8,1.4052e-01_r8,1.0540e-01_r8, & + &7.0282e-02_r8,3.5177e-02_r8,1.4937e-04_r8/) + kao(:, 5, 9, 8) = (/ & + &2.7385e-01_r8,2.3963e-01_r8,2.0540e-01_r8,1.7118e-01_r8,1.3696e-01_r8,1.0274e-01_r8, & + &6.8516e-02_r8,3.4350e-02_r8,2.3011e-04_r8/) + kao(:, 1,10, 8) = (/ & + &2.2461e+00_r8,1.9654e+00_r8,1.6846e+00_r8,1.4038e+00_r8,1.1231e+00_r8,8.4230e-01_r8, & + &5.6154e-01_r8,2.8077e-01_r8,2.2240e-05_r8/) + kao(:, 2,10, 8) = (/ & + &2.2106e+00_r8,1.9343e+00_r8,1.6579e+00_r8,1.3816e+00_r8,1.1053e+00_r8,8.2897e-01_r8, & + &5.5265e-01_r8,2.7633e-01_r8,4.4575e-05_r8/) + kao(:, 3,10, 8) = (/ & + &2.1737e+00_r8,1.9020e+00_r8,1.6303e+00_r8,1.3586e+00_r8,1.0869e+00_r8,8.1516e-01_r8, & + &5.4345e-01_r8,2.7173e-01_r8,8.8587e-05_r8/) + kao(:, 4,10, 8) = (/ & + &2.1348e+00_r8,1.8680e+00_r8,1.6011e+00_r8,1.3342e+00_r8,1.0674e+00_r8,8.0056e-01_r8, & + &5.3373e-01_r8,2.6688e-01_r8,1.5800e-04_r8/) + kao(:, 5,10, 8) = (/ & + &2.0952e+00_r8,1.8333e+00_r8,1.5714e+00_r8,1.3095e+00_r8,1.0476e+00_r8,7.8572e-01_r8, & + &5.2383e-01_r8,2.6194e-01_r8,2.5854e-04_r8/) + kao(:, 1,11, 8) = (/ & + &5.6263e+00_r8,4.9230e+00_r8,4.2197e+00_r8,3.5164e+00_r8,2.8132e+00_r8,2.1099e+00_r8, & + &1.4066e+00_r8,7.0330e-01_r8,2.4215e-05_r8/) + kao(:, 2,11, 8) = (/ & + &5.5442e+00_r8,4.8512e+00_r8,4.1582e+00_r8,3.4652e+00_r8,2.7721e+00_r8,2.0791e+00_r8, & + &1.3861e+00_r8,6.9304e-01_r8,5.0673e-05_r8/) + kao(:, 3,11, 8) = (/ & + &5.4573e+00_r8,4.7752e+00_r8,4.0930e+00_r8,3.4108e+00_r8,2.7286e+00_r8,2.0465e+00_r8, & + &1.3643e+00_r8,6.8218e-01_r8,9.6231e-05_r8/) + kao(:, 4,11, 8) = (/ & + &5.3719e+00_r8,4.7004e+00_r8,4.0290e+00_r8,3.3575e+00_r8,2.6860e+00_r8,2.0145e+00_r8, & + &1.3430e+00_r8,6.7153e-01_r8,1.7007e-04_r8/) + kao(:, 5,11, 8) = (/ & + &5.2804e+00_r8,4.6204e+00_r8,3.9603e+00_r8,3.3002e+00_r8,2.6402e+00_r8,1.9802e+00_r8, & + &1.3201e+00_r8,6.6009e-01_r8,2.7665e-04_r8/) + kao(:, 1,12, 8) = (/ & + &8.8343e+00_r8,7.7300e+00_r8,6.6256e+00_r8,5.5214e+00_r8,4.4171e+00_r8,3.3128e+00_r8, & + &2.2085e+00_r8,1.1043e+00_r8,2.5372e-05_r8/) + kao(:, 2,12, 8) = (/ & + &8.7174e+00_r8,7.6278e+00_r8,6.5381e+00_r8,5.4484e+00_r8,4.3587e+00_r8,3.2690e+00_r8, & + &2.1794e+00_r8,1.0897e+00_r8,5.2642e-05_r8/) + kao(:, 3,12, 8) = (/ & + &8.5962e+00_r8,7.5216e+00_r8,6.4471e+00_r8,5.3726e+00_r8,4.2981e+00_r8,3.2236e+00_r8, & + &2.1490e+00_r8,1.0745e+00_r8,9.9934e-05_r8/) + kao(:, 4,12, 8) = (/ & + &8.4730e+00_r8,7.4139e+00_r8,6.3547e+00_r8,5.2956e+00_r8,4.2365e+00_r8,3.1774e+00_r8, & + &2.1183e+00_r8,1.0591e+00_r8,1.7486e-04_r8/) + kao(:, 5,12, 8) = (/ & + &8.3427e+00_r8,7.2999e+00_r8,6.2571e+00_r8,5.2142e+00_r8,4.1714e+00_r8,3.1285e+00_r8, & + &2.0857e+00_r8,1.0429e+00_r8,2.8225e-04_r8/) + kao(:, 1,13, 8) = (/ & + &1.1088e+01_r8,9.7019e+00_r8,8.3159e+00_r8,6.9299e+00_r8,5.5439e+00_r8,4.1579e+00_r8, & + &2.7720e+00_r8,1.3860e+00_r8,2.2843e-05_r8/) + kao(:, 2,13, 8) = (/ & + &1.0963e+01_r8,9.5924e+00_r8,8.2220e+00_r8,6.8518e+00_r8,5.4814e+00_r8,4.1110e+00_r8, & + &2.7407e+00_r8,1.3703e+00_r8,4.7912e-05_r8/) + kao(:, 3,13, 8) = (/ & + &1.0836e+01_r8,9.4815e+00_r8,8.1269e+00_r8,6.7725e+00_r8,5.4179e+00_r8,4.0635e+00_r8, & + &2.7090e+00_r8,1.3545e+00_r8,9.1850e-05_r8/) + kao(:, 4,13, 8) = (/ & + &1.0705e+01_r8,9.3666e+00_r8,8.0284e+00_r8,6.6904e+00_r8,5.3523e+00_r8,4.0142e+00_r8, & + &2.6761e+00_r8,1.3381e+00_r8,1.6522e-04_r8/) + kao(:, 5,13, 8) = (/ & + &1.0568e+01_r8,9.2475e+00_r8,7.9263e+00_r8,6.6053e+00_r8,5.2842e+00_r8,3.9632e+00_r8, & + &2.6421e+00_r8,1.3211e+00_r8,2.8269e-04_r8/) + kao(:, 1, 1, 9) = (/ & + &6.2917e-05_r8,8.4558e-05_r8,1.3686e-04_r8,1.9740e-04_r8,2.4967e-04_r8,2.7515e-04_r8, & + &1.6338e-04_r8,4.8223e-05_r8,4.6728e-04_r8/) + kao(:, 2, 1, 9) = (/ & + &5.3089e-05_r8,9.0420e-05_r8,1.8251e-04_r8,2.7670e-04_r8,3.5886e-04_r8,4.3834e-04_r8, & + &4.9477e-04_r8,2.3929e-04_r8,6.8730e-04_r8/) + kao(:, 3, 1, 9) = (/ & + &4.3039e-05_r8,1.0946e-04_r8,2.4429e-04_r8,3.7961e-04_r8,4.9689e-04_r8,6.1288e-04_r8, & + &7.2274e-04_r8,7.7240e-04_r8,9.6431e-04_r8/) + kao(:, 4, 1, 9) = (/ & + &3.4069e-05_r8,1.3830e-04_r8,3.2177e-04_r8,5.0878e-04_r8,6.6994e-04_r8,8.2945e-04_r8, & + &9.8413e-04_r8,1.1125e-03_r8,1.3109e-03_r8/) + kao(:, 5, 1, 9) = (/ & + &3.0399e-05_r8,1.7548e-04_r8,4.1760e-04_r8,6.6731e-04_r8,8.8167e-04_r8,1.0941e-03_r8, & + &1.3015e-03_r8,1.4854e-03_r8,1.7348e-03_r8/) + kao(:, 1, 2, 9) = (/ & + &1.1900e-04_r8,1.2836e-04_r8,1.4231e-04_r8,1.8014e-04_r8,2.2526e-04_r8,2.6329e-04_r8, & + &2.2981e-04_r8,4.7447e-05_r8,3.9923e-04_r8/) + kao(:, 2, 2, 9) = (/ & + &1.1384e-04_r8,1.2703e-04_r8,1.6170e-04_r8,2.3947e-04_r8,3.1945e-04_r8,3.8888e-04_r8, & + &4.4936e-04_r8,3.6063e-04_r8,5.9020e-04_r8/) + kao(:, 3, 2, 9) = (/ & + &9.6344e-05_r8,1.3540e-04_r8,2.0202e-04_r8,3.2063e-04_r8,4.4367e-04_r8,5.4566e-04_r8, & + &6.4489e-04_r8,7.2550e-04_r8,8.3580e-04_r8/) + kao(:, 4, 2, 9) = (/ & + &7.7835e-05_r8,1.6099e-04_r8,2.5994e-04_r8,4.2610e-04_r8,6.0189e-04_r8,7.4414e-04_r8, & + &8.8531e-04_r8,1.0210e-03_r8,1.1481e-03_r8/) + kao(:, 5, 2, 9) = (/ & + &6.0959e-05_r8,1.9625e-04_r8,3.3515e-04_r8,5.6029e-04_r8,7.9618e-04_r8,9.9092e-04_r8, & + &1.1822e-03_r8,1.3661e-03_r8,1.5393e-03_r8/) + kao(:, 1, 3, 9) = (/ & + &3.4384e-04_r8,3.1901e-04_r8,2.9656e-04_r8,2.7161e-04_r8,2.4956e-04_r8,2.4575e-04_r8, & + &2.4892e-04_r8,1.2874e-04_r8,2.5500e-04_r8/) + kao(:, 2, 3, 9) = (/ & + &3.2651e-04_r8,2.9987e-04_r8,2.8407e-04_r8,2.6822e-04_r8,2.8382e-04_r8,3.2698e-04_r8, & + &3.7690e-04_r8,3.8984e-04_r8,3.8097e-04_r8/) + kao(:, 3, 3, 9) = (/ & + &3.1133e-04_r8,2.9825e-04_r8,2.8892e-04_r8,2.8983e-04_r8,3.4857e-04_r8,4.4151e-04_r8, & + &5.3596e-04_r8,6.0662e-04_r8,5.5422e-04_r8/) + kao(:, 4, 3, 9) = (/ & + &2.6650e-04_r8,2.9032e-04_r8,3.1626e-04_r8,3.4521e-04_r8,4.5449e-04_r8,5.9386e-04_r8, & + &7.4052e-04_r8,8.5104e-04_r8,7.8265e-04_r8/) + kao(:, 5, 3, 9) = (/ & + &2.2412e-04_r8,2.9039e-04_r8,3.7283e-04_r8,4.3223e-04_r8,5.9364e-04_r8,7.9041e-04_r8, & + &9.9696e-04_r8,1.1553e-03_r8,1.0705e-03_r8/) + kao(:, 1, 4, 9) = (/ & + &1.0105e-03_r8,8.9198e-04_r8,7.7732e-04_r8,6.6567e-04_r8,5.5452e-04_r8,4.4086e-04_r8, & + &3.2869e-04_r8,1.9418e-04_r8,1.7212e-04_r8/) + kao(:, 2, 4, 9) = (/ & + &9.2169e-04_r8,8.2421e-04_r8,7.2924e-04_r8,6.3857e-04_r8,5.4763e-04_r8,4.5198e-04_r8, & + &3.7244e-04_r8,3.3779e-04_r8,2.7365e-04_r8/) + kao(:, 3, 4, 9) = (/ & + &9.1340e-04_r8,8.1831e-04_r8,7.2882e-04_r8,6.3523e-04_r8,5.3088e-04_r8,4.5658e-04_r8, & + &4.4489e-04_r8,4.8577e-04_r8,4.2302e-04_r8/) + kao(:, 4, 4, 9) = (/ & + &8.9251e-04_r8,8.0269e-04_r8,7.3471e-04_r8,6.4402e-04_r8,5.5905e-04_r8,5.1386e-04_r8, & + &5.6577e-04_r8,6.8086e-04_r8,6.2344e-04_r8/) + kao(:, 5, 4, 9) = (/ & + &7.9475e-04_r8,7.3797e-04_r8,7.1362e-04_r8,6.7001e-04_r8,6.3957e-04_r8,6.1730e-04_r8, & + &7.4587e-04_r8,9.2826e-04_r8,8.7756e-04_r8/) + kao(:, 1, 5, 9) = (/ & + &2.6935e-03_r8,2.3593e-03_r8,2.0323e-03_r8,1.7047e-03_r8,1.3798e-03_r8,1.0522e-03_r8, & + &7.2780e-04_r8,3.9954e-04_r8,1.6653e-04_r8/) + kao(:, 2, 5, 9) = (/ & + &2.6191e-03_r8,2.2983e-03_r8,1.9871e-03_r8,1.6780e-03_r8,1.3636e-03_r8,1.0535e-03_r8, & + &7.4346e-04_r8,4.3038e-04_r8,2.6682e-04_r8/) + kao(:, 3, 5, 9) = (/ & + &2.3650e-03_r8,2.0866e-03_r8,1.8132e-03_r8,1.5443e-03_r8,1.2810e-03_r8,1.0093e-03_r8, & + &7.2606e-04_r8,4.8378e-04_r8,4.1282e-04_r8/) + kao(:, 4, 5, 9) = (/ & + &2.4014e-03_r8,2.1168e-03_r8,1.8401e-03_r8,1.5793e-03_r8,1.3157e-03_r8,1.0190e-03_r8, & + &7.3809e-04_r8,5.7085e-04_r8,6.1502e-04_r8/) + kao(:, 5, 5, 9) = (/ & + &2.3689e-03_r8,2.1027e-03_r8,1.8524e-03_r8,1.6218e-03_r8,1.3262e-03_r8,1.0531e-03_r8, & + &8.0904e-04_r8,7.1684e-04_r8,8.8985e-04_r8/) + kao(:, 1, 6, 9) = (/ & + &6.9308e-03_r8,6.0665e-03_r8,5.2022e-03_r8,4.3390e-03_r8,3.4845e-03_r8,2.6255e-03_r8, & + &1.7705e-03_r8,9.1297e-04_r8,1.4507e-04_r8/) + kao(:, 2, 6, 9) = (/ & + &6.7707e-03_r8,5.9271e-03_r8,5.0849e-03_r8,4.2542e-03_r8,3.4202e-03_r8,2.5899e-03_r8, & + &1.7563e-03_r8,9.2722e-04_r8,2.4197e-04_r8/) + kao(:, 3, 6, 9) = (/ & + &6.6111e-03_r8,5.7877e-03_r8,4.9821e-03_r8,4.1734e-03_r8,3.3664e-03_r8,2.5641e-03_r8, & + &1.7626e-03_r8,9.4198e-04_r8,3.8026e-04_r8/) + kao(:, 4, 6, 9) = (/ & + &6.0438e-03_r8,5.3003e-03_r8,4.5745e-03_r8,3.8441e-03_r8,3.1111e-03_r8,2.3922e-03_r8, & + &1.6672e-03_r8,9.3430e-04_r8,5.5692e-04_r8/) + kao(:, 5, 6, 9) = (/ & + &6.1335e-03_r8,5.3879e-03_r8,4.6501e-03_r8,3.9141e-03_r8,3.1883e-03_r8,2.4602e-03_r8, & + &1.7143e-03_r8,9.6080e-04_r8,7.9260e-04_r8/) + kao(:, 1, 7, 9) = (/ & + &1.9047e-02_r8,1.6668e-02_r8,1.4288e-02_r8,1.1909e-02_r8,9.5299e-03_r8,7.1507e-03_r8, & + &4.7825e-03_r8,2.4097e-03_r8,1.1330e-04_r8/) + kao(:, 2, 7, 9) = (/ & + &1.8614e-02_r8,1.6290e-02_r8,1.3965e-02_r8,1.1641e-02_r8,9.3171e-03_r8,7.0086e-03_r8, & + &4.6932e-03_r8,2.3827e-03_r8,1.9275e-04_r8/) + kao(:, 3, 7, 9) = (/ & + &1.8191e-02_r8,1.5921e-02_r8,1.3650e-02_r8,1.1382e-02_r8,9.1322e-03_r8,6.8769e-03_r8, & + &4.6246e-03_r8,2.3704e-03_r8,3.0881e-04_r8/) + kao(:, 4, 7, 9) = (/ & + &1.7657e-02_r8,1.5455e-02_r8,1.3252e-02_r8,1.1078e-02_r8,8.8961e-03_r8,6.7169e-03_r8, & + &4.5330e-03_r8,2.3676e-03_r8,4.7256e-04_r8/) + kao(:, 5, 7, 9) = (/ & + &1.6605e-02_r8,1.4537e-02_r8,1.2495e-02_r8,1.0448e-02_r8,8.3949e-03_r8,6.3348e-03_r8, & + &4.3112e-03_r8,2.2623e-03_r8,7.0061e-04_r8/) + kao(:, 1, 8, 9) = (/ & + &6.6522e-02_r8,5.8208e-02_r8,4.9894e-02_r8,4.1580e-02_r8,3.3266e-02_r8,2.4952e-02_r8, & + &1.6638e-02_r8,8.3237e-03_r8,8.8556e-05_r8/) + kao(:, 2, 8, 9) = (/ & + &6.5331e-02_r8,5.7166e-02_r8,4.9002e-02_r8,4.0837e-02_r8,3.2672e-02_r8,2.4508e-02_r8, & + &1.6344e-02_r8,8.1975e-03_r8,1.5988e-04_r8/) + kao(:, 3, 8, 9) = (/ & + &6.4113e-02_r8,5.6102e-02_r8,4.8090e-02_r8,4.0078e-02_r8,3.2067e-02_r8,2.4056e-02_r8, & + &1.6062e-02_r8,8.0735e-03_r8,2.6393e-04_r8/) + kao(:, 4, 8, 9) = (/ & + &6.2675e-02_r8,5.4844e-02_r8,4.7014e-02_r8,3.9184e-02_r8,3.1353e-02_r8,2.3542e-02_r8, & + &1.5747e-02_r8,7.9493e-03_r8,4.0578e-04_r8/) + kao(:, 5, 8, 9) = (/ & + &6.0829e-02_r8,5.3229e-02_r8,4.5632e-02_r8,3.8033e-02_r8,3.0464e-02_r8,2.2925e-02_r8, & + &1.5354e-02_r8,7.7739e-03_r8,6.0582e-04_r8/) + kao(:, 1, 9, 9) = (/ & + &4.4562e-01_r8,3.8992e-01_r8,3.3422e-01_r8,2.7852e-01_r8,2.2281e-01_r8,1.6711e-01_r8, & + &1.1141e-01_r8,5.5708e-02_r8,6.4708e-05_r8/) + kao(:, 2, 9, 9) = (/ & + &4.3840e-01_r8,3.8360e-01_r8,3.2881e-01_r8,2.7401e-01_r8,2.1921e-01_r8,1.6441e-01_r8, & + &1.0961e-01_r8,5.4811e-02_r8,1.2246e-04_r8/) + kao(:, 3, 9, 9) = (/ & + &4.3101e-01_r8,3.7714e-01_r8,3.2326e-01_r8,2.6939e-01_r8,2.1551e-01_r8,1.6164e-01_r8, & + &1.0777e-01_r8,5.3892e-02_r8,2.1404e-04_r8/) + kao(:, 4, 9, 9) = (/ & + &4.2341e-01_r8,3.7048e-01_r8,3.1756e-01_r8,2.6464e-01_r8,2.1171e-01_r8,1.5879e-01_r8, & + &1.0587e-01_r8,5.2950e-02_r8,3.4919e-04_r8/) + kao(:, 5, 9, 9) = (/ & + &4.1490e-01_r8,3.6305e-01_r8,3.1119e-01_r8,2.5933e-01_r8,2.0748e-01_r8,1.5561e-01_r8, & + &1.0376e-01_r8,5.1933e-02_r8,5.3978e-04_r8/) + kao(:, 1,10, 9) = (/ & + &3.5739e+00_r8,3.1272e+00_r8,2.6804e+00_r8,2.2337e+00_r8,1.7870e+00_r8,1.3402e+00_r8, & + &8.9349e-01_r8,4.4675e-01_r8,3.6923e-05_r8/) + kao(:, 2,10, 9) = (/ & + &3.5173e+00_r8,3.0777e+00_r8,2.6381e+00_r8,2.1983e+00_r8,1.7587e+00_r8,1.3190e+00_r8, & + &8.7936e-01_r8,4.3968e-01_r8,7.4734e-05_r8/) + kao(:, 3,10, 9) = (/ & + &3.4601e+00_r8,3.0276e+00_r8,2.5951e+00_r8,2.1626e+00_r8,1.7301e+00_r8,1.2976e+00_r8, & + &8.6506e-01_r8,4.3253e-01_r8,1.2645e-04_r8/) + kao(:, 4,10, 9) = (/ & + &3.4013e+00_r8,2.9762e+00_r8,2.5510e+00_r8,2.1258e+00_r8,1.7007e+00_r8,1.2755e+00_r8, & + &8.5034e-01_r8,4.2518e-01_r8,2.0434e-04_r8/) + kao(:, 5,10, 9) = (/ & + &3.3408e+00_r8,2.9231e+00_r8,2.5056e+00_r8,2.0880e+00_r8,1.6704e+00_r8,1.2528e+00_r8, & + &8.3521e-01_r8,4.1763e-01_r8,3.0930e-04_r8/) + kao(:, 1,11, 9) = (/ & + &9.5423e+00_r8,8.3495e+00_r8,7.1567e+00_r8,5.9639e+00_r8,4.7712e+00_r8,3.5784e+00_r8, & + &2.3856e+00_r8,1.1928e+00_r8,3.3494e-05_r8/) + kao(:, 2,11, 9) = (/ & + &9.3929e+00_r8,8.2188e+00_r8,7.0447e+00_r8,5.8706e+00_r8,4.6965e+00_r8,3.5224e+00_r8, & + &2.3483e+00_r8,1.1741e+00_r8,6.4875e-05_r8/) + kao(:, 3,11, 9) = (/ & + &9.2404e+00_r8,8.0853e+00_r8,6.9303e+00_r8,5.7752e+00_r8,4.6202e+00_r8,3.4651e+00_r8, & + &2.3101e+00_r8,1.1551e+00_r8,1.1378e-04_r8/) + kao(:, 4,11, 9) = (/ & + &9.0863e+00_r8,7.9506e+00_r8,6.8148e+00_r8,5.6790e+00_r8,4.5432e+00_r8,3.4074e+00_r8, & + &2.2716e+00_r8,1.1358e+00_r8,1.8195e-04_r8/) + kao(:, 5,11, 9) = (/ & + &8.9334e+00_r8,7.8167e+00_r8,6.7001e+00_r8,5.5834e+00_r8,4.4668e+00_r8,3.3501e+00_r8, & + &2.2334e+00_r8,1.1167e+00_r8,2.6874e-04_r8/) + kao(:, 1,12, 9) = (/ & + &1.6018e+01_r8,1.4016e+01_r8,1.2013e+01_r8,1.0011e+01_r8,8.0089e+00_r8,6.0065e+00_r8, & + &4.0043e+00_r8,2.0022e+00_r8,3.3227e-05_r8/) + kao(:, 2,12, 9) = (/ & + &1.5778e+01_r8,1.3806e+01_r8,1.1834e+01_r8,9.8614e+00_r8,7.8892e+00_r8,5.9169e+00_r8, & + &3.9446e+00_r8,1.9723e+00_r8,6.4843e-05_r8/) + kao(:, 3,12, 9) = (/ & + &1.5536e+01_r8,1.3594e+01_r8,1.1652e+01_r8,9.7100e+00_r8,7.7679e+00_r8,5.8260e+00_r8, & + &3.8840e+00_r8,1.9420e+00_r8,1.1290e-04_r8/) + kao(:, 4,12, 9) = (/ & + &1.5292e+01_r8,1.3380e+01_r8,1.1469e+01_r8,9.5575e+00_r8,7.6460e+00_r8,5.7344e+00_r8, & + &3.8230e+00_r8,1.9115e+00_r8,1.7636e-04_r8/) + kao(:, 5,12, 9) = (/ & + &1.5044e+01_r8,1.3163e+01_r8,1.1283e+01_r8,9.4022e+00_r8,7.5218e+00_r8,5.6414e+00_r8, & + &3.7609e+00_r8,1.8805e+00_r8,2.6723e-04_r8/) + kao(:, 1,13, 9) = (/ & + &2.1597e+01_r8,1.8897e+01_r8,1.6197e+01_r8,1.3498e+01_r8,1.0798e+01_r8,8.0986e+00_r8, & + &5.3991e+00_r8,2.6995e+00_r8,3.8904e-05_r8/) + kao(:, 2,13, 9) = (/ & + &2.1295e+01_r8,1.8633e+01_r8,1.5971e+01_r8,1.3309e+01_r8,1.0647e+01_r8,7.9855e+00_r8, & + &5.3237e+00_r8,2.6618e+00_r8,7.5857e-05_r8/) + kao(:, 3,13, 9) = (/ & + &2.0989e+01_r8,1.8366e+01_r8,1.5742e+01_r8,1.3118e+01_r8,1.0494e+01_r8,7.8710e+00_r8, & + &5.2472e+00_r8,2.6236e+00_r8,1.3015e-04_r8/) + kao(:, 4,13, 9) = (/ & + &2.0668e+01_r8,1.8085e+01_r8,1.5501e+01_r8,1.2918e+01_r8,1.0334e+01_r8,7.7506e+00_r8, & + &5.1670e+00_r8,2.5835e+00_r8,2.0228e-04_r8/) + kao(:, 5,13, 9) = (/ & + &2.0333e+01_r8,1.7791e+01_r8,1.5249e+01_r8,1.2708e+01_r8,1.0166e+01_r8,7.6247e+00_r8, & + &5.0831e+00_r8,2.5416e+00_r8,2.9840e-04_r8/) + kao(:, 1, 1,10) = (/ & + &5.6592e-05_r8,1.3380e-04_r8,2.8259e-04_r8,4.0725e-04_r8,5.2722e-04_r8,6.3771e-04_r8, & + &7.3618e-04_r8,6.8809e-05_r8,1.0230e-03_r8/) + kao(:, 2, 1,10) = (/ & + &3.4000e-05_r8,1.7762e-04_r8,3.9282e-04_r8,5.7189e-04_r8,7.4744e-04_r8,9.1578e-04_r8, & + &1.0739e-03_r8,1.1530e-03_r8,1.4652e-03_r8/) + kao(:, 3, 1,10) = (/ & + &3.1822e-05_r8,2.4313e-04_r8,5.2738e-04_r8,7.7595e-04_r8,1.0231e-03_r8,1.2640e-03_r8, & + &1.5000e-03_r8,1.6967e-03_r8,2.0181e-03_r8/) + kao(:, 4, 1,10) = (/ & + &3.1887e-05_r8,3.1730e-04_r8,7.0142e-04_r8,1.0376e-03_r8,1.3716e-03_r8,1.7032e-03_r8, & + &2.0256e-03_r8,2.3355e-03_r8,2.7159e-03_r8/) + kao(:, 5, 1,10) = (/ & + &3.2974e-05_r8,4.0500e-04_r8,9.2096e-04_r8,1.3701e-03_r8,1.8162e-03_r8,2.2594e-03_r8, & + &2.6867e-03_r8,3.0973e-03_r8,3.6043e-03_r8/) + kao(:, 1, 2,10) = (/ & + &1.2846e-04_r8,1.5522e-04_r8,2.7655e-04_r8,3.8379e-04_r8,4.9079e-04_r8,5.9529e-04_r8, & + &6.9141e-04_r8,5.6796e-04_r8,9.2767e-04_r8/) + kao(:, 2, 2,10) = (/ & + &6.5990e-05_r8,1.6552e-04_r8,3.7419e-04_r8,5.3648e-04_r8,6.9689e-04_r8,8.5375e-04_r8, & + &1.0031e-03_r8,1.1095e-03_r8,1.3393e-03_r8/) + kao(:, 3, 2,10) = (/ & + &5.6435e-05_r8,1.5534e-04_r8,5.0363e-04_r8,7.3034e-04_r8,9.5369e-04_r8,1.1711e-03_r8, & + &1.3827e-03_r8,1.5608e-03_r8,1.8461e-03_r8/) + kao(:, 4, 2,10) = (/ & + &5.4174e-05_r8,1.7810e-04_r8,6.6905e-04_r8,9.7686e-04_r8,1.2783e-03_r8,1.5737e-03_r8, & + &1.8611e-03_r8,2.1178e-03_r8,2.4942e-03_r8/) + kao(:, 5, 2,10) = (/ & + &5.2370e-05_r8,1.9597e-04_r8,8.6044e-04_r8,1.2706e-03_r8,1.6729e-03_r8,2.0703e-03_r8, & + &2.4603e-03_r8,2.8342e-03_r8,3.2918e-03_r8/) + kao(:, 1, 3,10) = (/ & + &4.4469e-04_r8,4.0346e-04_r8,3.7124e-04_r8,3.9072e-04_r8,4.6265e-04_r8,5.3518e-04_r8, & + &6.0670e-04_r8,6.5723e-04_r8,7.6901e-04_r8/) + kao(:, 2, 3,10) = (/ & + &2.7821e-04_r8,2.8769e-04_r8,3.4636e-04_r8,4.5772e-04_r8,6.3733e-04_r8,7.5575e-04_r8, & + &8.7290e-04_r8,9.7779e-04_r8,1.1248e-03_r8/) + kao(:, 3, 3,10) = (/ & + &1.6712e-04_r8,2.0135e-04_r8,3.1664e-04_r8,6.0259e-04_r8,8.6177e-04_r8,1.0373e-03_r8, & + &1.2106e-03_r8,1.3752e-03_r8,1.5723e-03_r8/) + kao(:, 4, 3,10) = (/ & + &1.5303e-04_r8,2.3452e-04_r8,3.6629e-04_r8,7.9270e-04_r8,1.1535e-03_r8,1.4036e-03_r8, & + &1.6498e-03_r8,1.8820e-03_r8,2.1596e-03_r8/) + kao(:, 5, 3,10) = (/ & + &1.4546e-04_r8,2.9515e-04_r8,4.4927e-04_r8,1.0579e-03_r8,1.5163e-03_r8,1.8612e-03_r8, & + &2.1985e-03_r8,2.5140e-03_r8,2.9016e-03_r8/) + kao(:, 1, 4,10) = (/ & + &1.2138e-03_r8,1.0643e-03_r8,9.4070e-04_r8,8.1504e-04_r8,7.0358e-04_r8,5.9316e-04_r8, & + &5.5104e-04_r8,5.6438e-04_r8,3.2078e-04_r8/) + kao(:, 2, 4,10) = (/ & + &1.1514e-03_r8,1.0125e-03_r8,9.4071e-04_r8,8.3600e-04_r8,7.4220e-04_r8,6.5907e-04_r8, & + &7.7143e-04_r8,8.3267e-04_r8,4.7891e-04_r8/) + kao(:, 3, 4,10) = (/ & + &8.3276e-04_r8,7.0376e-04_r8,7.1208e-04_r8,6.8052e-04_r8,7.6194e-04_r8,8.9019e-04_r8, & + &1.0682e-03_r8,1.1778e-03_r8,6.1825e-04_r8/) + kao(:, 4, 4,10) = (/ & + &6.2678e-04_r8,5.3178e-04_r8,5.1712e-04_r8,6.2090e-04_r8,7.5690e-04_r8,1.1872e-03_r8, & + &1.4563e-03_r8,1.6302e-03_r8,8.5537e-04_r8/) + kao(:, 5, 4,10) = (/ & + &4.2987e-04_r8,5.2033e-04_r8,6.3756e-04_r8,7.6564e-04_r8,7.8218e-04_r8,1.6224e-03_r8, & + &1.9482e-03_r8,2.2056e-03_r8,1.2455e-03_r8/) + kao(:, 1, 5,10) = (/ & + &3.3420e-03_r8,2.9247e-03_r8,2.5126e-03_r8,2.0946e-03_r8,1.6924e-03_r8,1.3030e-03_r8, & + &9.3410e-04_r8,5.8986e-04_r8,3.1969e-04_r8/) + kao(:, 2, 5,10) = (/ & + &3.1398e-03_r8,2.7488e-03_r8,2.3818e-03_r8,2.0259e-03_r8,1.6962e-03_r8,1.3524e-03_r8, & + &9.7217e-04_r8,7.2894e-04_r8,5.2320e-04_r8/) + kao(:, 3, 5,10) = (/ & + &3.0330e-03_r8,2.6759e-03_r8,2.3370e-03_r8,2.0014e-03_r8,1.6490e-03_r8,1.4032e-03_r8, & + &1.0593e-03_r8,1.0067e-03_r8,7.5418e-04_r8/) + kao(:, 4, 5,10) = (/ & + &2.5775e-03_r8,2.3167e-03_r8,2.0477e-03_r8,1.6916e-03_r8,1.3663e-03_r8,1.1599e-03_r8, & + &1.0841e-03_r8,1.3957e-03_r8,9.6520e-04_r8/) + kao(:, 5, 5,10) = (/ & + &2.1866e-03_r8,2.0017e-03_r8,1.5507e-03_r8,1.2425e-03_r8,1.2248e-03_r8,1.1086e-03_r8, & + &1.2483e-03_r8,1.9173e-03_r8,1.1788e-03_r8/) + kao(:, 1, 6,10) = (/ & + &8.8838e-03_r8,7.7745e-03_r8,6.6646e-03_r8,5.5555e-03_r8,4.4614e-03_r8,3.3623e-03_r8, & + &2.2796e-03_r8,1.1799e-03_r8,1.7827e-04_r8/) + kao(:, 2, 6,10) = (/ & + &8.6572e-03_r8,7.5770e-03_r8,6.4955e-03_r8,5.4321e-03_r8,4.3605e-03_r8,3.3104e-03_r8, & + &2.2427e-03_r8,1.2382e-03_r8,2.5800e-04_r8/) + kao(:, 3, 6,10) = (/ & + &8.3335e-03_r8,7.2931e-03_r8,6.2759e-03_r8,5.2475e-03_r8,4.2339e-03_r8,3.2059e-03_r8, & + &2.2047e-03_r8,1.3240e-03_r8,4.2156e-04_r8/) + kao(:, 4, 6,10) = (/ & + &7.5549e-03_r8,6.6060e-03_r8,5.7369e-03_r8,4.8380e-03_r8,4.0096e-03_r8,3.1204e-03_r8, & + &2.3001e-03_r8,1.3603e-03_r8,7.8178e-04_r8/) + kao(:, 5, 6,10) = (/ & + &6.8684e-03_r8,6.0886e-03_r8,5.1989e-03_r8,4.4067e-03_r8,3.6681e-03_r8,2.8099e-03_r8, & + &1.8970e-03_r8,1.4204e-03_r8,1.3480e-03_r8/) + kao(:, 1, 7,10) = (/ & + &2.4586e-02_r8,2.1513e-02_r8,1.8440e-02_r8,1.5369e-02_r8,1.2296e-02_r8,9.2230e-03_r8, & + &6.1633e-03_r8,3.1137e-03_r8,1.3933e-04_r8/) + kao(:, 2, 7,10) = (/ & + &2.4170e-02_r8,2.1150e-02_r8,1.8129e-02_r8,1.5109e-02_r8,1.2088e-02_r8,9.0886e-03_r8, & + &6.0878e-03_r8,3.1114e-03_r8,2.3190e-04_r8/) + kao(:, 3, 7,10) = (/ & + &2.3662e-02_r8,2.0705e-02_r8,1.7748e-02_r8,1.4791e-02_r8,1.1861e-02_r8,8.9271e-03_r8, & + &6.0215e-03_r8,3.0844e-03_r8,3.6298e-04_r8/) + kao(:, 4, 7,10) = (/ & + &2.2469e-02_r8,1.9660e-02_r8,1.6853e-02_r8,1.4086e-02_r8,1.1306e-02_r8,8.5420e-03_r8, & + &5.7631e-03_r8,3.0626e-03_r8,5.4029e-04_r8/) + kao(:, 5, 7,10) = (/ & + &1.9809e-02_r8,1.7349e-02_r8,1.4886e-02_r8,1.2460e-02_r8,1.0092e-02_r8,7.8522e-03_r8, & + &5.3378e-03_r8,3.0999e-03_r8,7.7423e-04_r8/) + kao(:, 1, 8,10) = (/ & + &8.6508e-02_r8,7.5696e-02_r8,6.4882e-02_r8,5.4068e-02_r8,4.3255e-02_r8,3.2443e-02_r8, & + &2.1630e-02_r8,1.0817e-02_r8,1.6191e-04_r8/) + kao(:, 2, 8,10) = (/ & + &8.4528e-02_r8,7.3960e-02_r8,6.3397e-02_r8,5.2832e-02_r8,4.2266e-02_r8,3.1701e-02_r8, & + &2.1136e-02_r8,1.0597e-02_r8,3.0221e-04_r8/) + kao(:, 3, 8,10) = (/ & + &8.2999e-02_r8,7.2627e-02_r8,6.2253e-02_r8,5.1878e-02_r8,4.1506e-02_r8,3.1132e-02_r8, & + &2.0757e-02_r8,1.0444e-02_r8,5.5391e-04_r8/) + kao(:, 4, 8,10) = (/ & + &8.1486e-02_r8,7.1301e-02_r8,6.1120e-02_r8,5.0928e-02_r8,4.0746e-02_r8,3.0564e-02_r8, & + &2.0452e-02_r8,1.0346e-02_r8,1.0152e-03_r8/) + kao(:, 5, 8,10) = (/ & + &7.7129e-02_r8,6.7490e-02_r8,5.7855e-02_r8,4.8214e-02_r8,3.8581e-02_r8,2.9014e-02_r8, & + &1.9443e-02_r8,9.9515e-03_r8,1.5121e-03_r8/) + kao(:, 1, 9,10) = (/ & + &5.8674e-01_r8,5.1340e-01_r8,4.4007e-01_r8,3.6671e-01_r8,2.9337e-01_r8,2.2003e-01_r8, & + &1.4669e-01_r8,7.3347e-02_r8,1.3954e-04_r8/) + kao(:, 2, 9,10) = (/ & + &5.7350e-01_r8,5.0184e-01_r8,4.3015e-01_r8,3.5845e-01_r8,2.8676e-01_r8,2.1507e-01_r8, & + &1.4339e-01_r8,7.1694e-02_r8,3.0044e-04_r8/) + kao(:, 3, 9,10) = (/ & + &5.6021e-01_r8,4.9017e-01_r8,4.2014e-01_r8,3.5012e-01_r8,2.8010e-01_r8,2.1008e-01_r8, & + &1.4005e-01_r8,7.0031e-02_r8,5.5636e-04_r8/) + kao(:, 4, 9,10) = (/ & + &5.4802e-01_r8,4.7953e-01_r8,4.1105e-01_r8,3.4251e-01_r8,2.7403e-01_r8,2.0552e-01_r8, & + &1.3702e-01_r8,6.8512e-02_r8,9.3561e-04_r8/) + kao(:, 5, 9,10) = (/ & + &5.3709e-01_r8,4.6991e-01_r8,4.0280e-01_r8,3.3568e-01_r8,2.6852e-01_r8,2.0142e-01_r8, & + &1.3428e-01_r8,6.7143e-02_r8,1.4485e-03_r8/) + kao(:, 1,10,10) = (/ & + &4.7861e+00_r8,4.1878e+00_r8,3.5896e+00_r8,2.9913e+00_r8,2.3930e+00_r8,1.7948e+00_r8, & + &1.1965e+00_r8,5.9827e-01_r8,3.2704e-06_r8/) + kao(:, 2,10,10) = (/ & + &4.6903e+00_r8,4.1040e+00_r8,3.5178e+00_r8,2.9315e+00_r8,2.3452e+00_r8,1.7589e+00_r8, & + &1.1726e+00_r8,5.8632e-01_r8,5.9185e-06_r8/) + kao(:, 3,10,10) = (/ & + &4.5984e+00_r8,4.0237e+00_r8,3.4487e+00_r8,2.8740e+00_r8,2.2992e+00_r8,1.7244e+00_r8, & + &1.1496e+00_r8,5.7479e-01_r8,9.9252e-06_r8/) + kao(:, 4,10,10) = (/ & + &4.5067e+00_r8,3.9434e+00_r8,3.3802e+00_r8,2.8168e+00_r8,2.2535e+00_r8,1.6901e+00_r8, & + &1.1267e+00_r8,5.6337e-01_r8,1.5639e-05_r8/) + kao(:, 5,10,10) = (/ & + &4.4320e+00_r8,3.8780e+00_r8,3.3239e+00_r8,2.7699e+00_r8,2.2160e+00_r8,1.6620e+00_r8, & + &1.1080e+00_r8,5.5401e-01_r8,2.3260e-05_r8/) + kao(:, 1,11,10) = (/ & + &1.3118e+01_r8,1.1478e+01_r8,9.8381e+00_r8,8.1983e+00_r8,6.5588e+00_r8,4.9192e+00_r8, & + &3.2794e+00_r8,1.6397e+00_r8,2.2734e-06_r8/) + kao(:, 2,11,10) = (/ & + &1.2878e+01_r8,1.1268e+01_r8,9.6587e+00_r8,8.0488e+00_r8,6.4391e+00_r8,4.8293e+00_r8, & + &3.2196e+00_r8,1.6098e+00_r8,4.2460e-06_r8/) + kao(:, 3,11,10) = (/ & + &1.2677e+01_r8,1.1092e+01_r8,9.5076e+00_r8,7.9230e+00_r8,6.3383e+00_r8,4.7539e+00_r8, & + &3.1692e+00_r8,1.5846e+00_r8,7.1509e-06_r8/) + kao(:, 4,11,10) = (/ & + &1.2452e+01_r8,1.0896e+01_r8,9.3395e+00_r8,7.7831e+00_r8,6.2263e+00_r8,4.6699e+00_r8, & + &3.1133e+00_r8,1.5566e+00_r8,1.2244e-05_r8/) + kao(:, 5,11,10) = (/ & + &1.2241e+01_r8,1.0711e+01_r8,9.1810e+00_r8,7.6509e+00_r8,6.1207e+00_r8,4.5903e+00_r8, & + &3.0604e+00_r8,1.5302e+00_r8,2.0967e-05_r8/) + kao(:, 1,12,10) = (/ & + &2.2864e+01_r8,2.0005e+01_r8,1.7148e+01_r8,1.4290e+01_r8,1.1432e+01_r8,8.5738e+00_r8, & + &5.7157e+00_r8,2.8580e+00_r8,1.8184e-06_r8/) + kao(:, 2,12,10) = (/ & + &2.2487e+01_r8,1.9676e+01_r8,1.6864e+01_r8,1.4054e+01_r8,1.1243e+01_r8,8.4321e+00_r8, & + &5.6215e+00_r8,2.8107e+00_r8,3.3852e-06_r8/) + kao(:, 3,12,10) = (/ & + &2.2126e+01_r8,1.9360e+01_r8,1.6594e+01_r8,1.3829e+01_r8,1.1063e+01_r8,8.2969e+00_r8, & + &5.5315e+00_r8,2.7657e+00_r8,6.4086e-06_r8/) + kao(:, 4,12,10) = (/ & + &2.1772e+01_r8,1.9050e+01_r8,1.6328e+01_r8,1.3607e+01_r8,1.0886e+01_r8,8.1644e+00_r8, & + &5.4429e+00_r8,2.7215e+00_r8,1.1402e-05_r8/) + kao(:, 5,12,10) = (/ & + &2.1416e+01_r8,1.8740e+01_r8,1.6063e+01_r8,1.3386e+01_r8,1.0708e+01_r8,8.0313e+00_r8, & + &5.3540e+00_r8,2.6771e+00_r8,1.6645e-05_r8/) + kao(:, 1,13,10) = (/ & + &3.2272e+01_r8,2.8237e+01_r8,2.4203e+01_r8,2.0170e+01_r8,1.6136e+01_r8,1.2101e+01_r8, & + &8.0677e+00_r8,4.0338e+00_r8,1.4317e-06_r8/) + kao(:, 2,13,10) = (/ & + &3.1783e+01_r8,2.7810e+01_r8,2.3837e+01_r8,1.9864e+01_r8,1.5891e+01_r8,1.1919e+01_r8, & + &7.9455e+00_r8,3.9728e+00_r8,3.0046e-06_r8/) + kao(:, 3,13,10) = (/ & + &3.1267e+01_r8,2.7359e+01_r8,2.3450e+01_r8,1.9542e+01_r8,1.5633e+01_r8,1.1725e+01_r8, & + &7.8169e+00_r8,3.9083e+00_r8,5.7473e-06_r8/) + kao(:, 4,13,10) = (/ & + &3.0805e+01_r8,2.6955e+01_r8,2.3103e+01_r8,1.9253e+01_r8,1.5402e+01_r8,1.1552e+01_r8, & + &7.7014e+00_r8,3.8506e+00_r8,8.5901e-06_r8/) + kao(:, 5,13,10) = (/ & + &3.0347e+01_r8,2.6554e+01_r8,2.2760e+01_r8,1.8967e+01_r8,1.5174e+01_r8,1.1380e+01_r8, & + &7.5867e+00_r8,3.7933e+00_r8,1.2367e-05_r8/) + kao(:, 1, 1,11) = (/ & + &4.7098e-05_r8,1.8036e-04_r8,3.4819e-04_r8,5.0638e-04_r8,6.6181e-04_r8,8.1065e-04_r8, & + &9.3902e-04_r8,7.7167e-04_r8,1.3022e-03_r8/) + kao(:, 2, 1,11) = (/ & + &3.0033e-05_r8,2.6523e-04_r8,5.0795e-04_r8,7.4803e-04_r8,9.8321e-04_r8,1.2080e-03_r8, & + &1.4174e-03_r8,1.6176e-03_r8,1.9428e-03_r8/) + kao(:, 3, 1,11) = (/ & + &3.0544e-05_r8,3.7128e-04_r8,7.2058e-04_r8,1.0671e-03_r8,1.4084e-03_r8,1.7391e-03_r8, & + &2.0379e-03_r8,2.3032e-03_r8,2.7938e-03_r8/) + kao(:, 4, 1,11) = (/ & + &3.0472e-05_r8,4.9757e-04_r8,9.8168e-04_r8,1.4606e-03_r8,1.9374e-03_r8,2.4057e-03_r8, & + &2.8449e-03_r8,3.1636e-03_r8,3.8517e-03_r8/) + kao(:, 5, 1,11) = (/ & + &2.4091e-05_r8,6.5444e-04_r8,1.2934e-03_r8,1.9295e-03_r8,2.5676e-03_r8,3.2003e-03_r8, & + &3.8144e-03_r8,4.2439e-03_r8,5.1123e-03_r8/) + kao(:, 1, 2,11) = (/ & + &1.3816e-04_r8,1.6153e-04_r8,3.3849e-04_r8,4.7695e-04_r8,6.1250e-04_r8,7.4207e-04_r8, & + &8.5768e-04_r8,9.1861e-04_r8,1.1708e-03_r8/) + kao(:, 2, 2,11) = (/ & + &6.1066e-05_r8,1.7974e-04_r8,4.7651e-04_r8,6.8520e-04_r8,8.9139e-04_r8,1.0930e-03_r8, & + &1.2848e-03_r8,1.4278e-03_r8,1.7346e-03_r8/) + kao(:, 3, 2,11) = (/ & + &5.7831e-05_r8,2.0028e-04_r8,6.5612e-04_r8,9.5859e-04_r8,1.2605e-03_r8,1.5625e-03_r8, & + &1.8554e-03_r8,2.0988e-03_r8,2.4798e-03_r8/) + kao(:, 4, 2,11) = (/ & + &5.4516e-05_r8,2.3064e-04_r8,8.8062e-04_r8,1.3017e-03_r8,1.7223e-03_r8,2.1436e-03_r8, & + &2.5645e-03_r8,2.9565e-03_r8,3.4038e-03_r8/) + kao(:, 5, 2,11) = (/ & + &5.5309e-05_r8,3.0448e-04_r8,1.1705e-03_r8,1.7340e-03_r8,2.2966e-03_r8,2.8601e-03_r8, & + &3.4280e-03_r8,3.9900e-03_r8,4.5458e-03_r8/) + kao(:, 1, 3,11) = (/ & + &4.5525e-04_r8,4.1659e-04_r8,4.0041e-04_r8,4.3594e-04_r8,5.6841e-04_r8,6.6824e-04_r8, & + &7.6559e-04_r8,8.3275e-04_r8,9.8673e-04_r8/) + kao(:, 2, 3,11) = (/ & + &2.7564e-04_r8,3.1143e-04_r8,4.0133e-04_r8,6.4539e-04_r8,8.1010e-04_r8,9.7483e-04_r8, & + &1.1326e-03_r8,1.2606e-03_r8,1.4783e-03_r8/) + kao(:, 3, 3,11) = (/ & + &1.5755e-04_r8,2.0262e-04_r8,4.4233e-04_r8,8.8058e-04_r8,1.1240e-03_r8,1.3655e-03_r8, & + &1.6023e-03_r8,1.8183e-03_r8,2.1060e-03_r8/) + kao(:, 4, 3,11) = (/ & + &1.5225e-04_r8,2.1360e-04_r8,4.5750e-04_r8,1.1722e-03_r8,1.5129e-03_r8,1.8525e-03_r8, & + &2.1885e-03_r8,2.5141e-03_r8,2.8848e-03_r8/) + kao(:, 5, 3,11) = (/ & + &1.4157e-04_r8,2.5829e-04_r8,4.6589e-04_r8,1.5429e-03_r8,2.0085e-03_r8,2.4737e-03_r8, & + &2.9344e-03_r8,3.3883e-03_r8,3.8756e-03_r8/) + kao(:, 1, 4,11) = (/ & + &1.2968e-03_r8,1.1627e-03_r8,1.0295e-03_r8,8.8852e-04_r8,7.5100e-04_r8,6.8878e-04_r8, & + &7.0217e-04_r8,7.2855e-04_r8,6.6909e-04_r8/) + kao(:, 2, 4,11) = (/ & + &1.2901e-03_r8,1.1618e-03_r8,9.9278e-04_r8,8.6686e-04_r8,8.2710e-04_r8,9.1628e-04_r8, & + &1.0053e-03_r8,1.0921e-03_r8,9.3719e-04_r8/) + kao(:, 3, 4,11) = (/ & + &8.4696e-04_r8,8.0992e-04_r8,6.6835e-04_r8,7.5797e-04_r8,8.8170e-04_r8,1.2538e-03_r8, & + &1.4194e-03_r8,1.5777e-03_r8,1.2930e-03_r8/) + kao(:, 4, 4,11) = (/ & + &4.0946e-04_r8,5.3575e-04_r8,5.3156e-04_r8,6.5607e-04_r8,1.0924e-03_r8,1.6886e-03_r8, & + &1.9410e-03_r8,2.1799e-03_r8,1.6795e-03_r8/) + kao(:, 5, 4,11) = (/ & + &4.1161e-04_r8,5.7102e-04_r8,5.8841e-04_r8,6.9122e-04_r8,1.4036e-03_r8,2.2467e-03_r8, & + &2.6025e-03_r8,2.9419e-03_r8,2.1668e-03_r8/) + kao(:, 1, 5,11) = (/ & + &3.5249e-03_r8,3.0877e-03_r8,2.6707e-03_r8,2.2562e-03_r8,1.8574e-03_r8,1.4440e-03_r8, & + &1.0135e-03_r8,7.0090e-04_r8,2.4879e-04_r8/) + kao(:, 2, 5,11) = (/ & + &3.4987e-03_r8,3.0660e-03_r8,2.6585e-03_r8,2.2616e-03_r8,1.8230e-03_r8,1.3947e-03_r8, & + &1.1338e-03_r8,9.8875e-04_r8,4.4035e-04_r8/) + kao(:, 3, 5,11) = (/ & + &3.2338e-03_r8,2.8640e-03_r8,2.5128e-03_r8,2.2224e-03_r8,1.8369e-03_r8,1.4590e-03_r8, & + &1.3054e-03_r8,1.4040e-03_r8,6.0764e-04_r8/) + kao(:, 4, 5,11) = (/ & + &2.1959e-03_r8,1.9312e-03_r8,1.7650e-03_r8,1.5181e-03_r8,1.3319e-03_r8,1.3218e-03_r8, & + &1.7587e-03_r8,1.9394e-03_r8,9.4777e-04_r8/) + kao(:, 5, 5,11) = (/ & + &1.2468e-03_r8,1.0861e-03_r8,1.1609e-03_r8,1.1515e-03_r8,1.2470e-03_r8,1.3220e-03_r8, & + &2.3659e-03_r8,2.6308e-03_r8,1.2356e-03_r8/) + kao(:, 1, 6,11) = (/ & + &9.5223e-03_r8,8.3335e-03_r8,7.1442e-03_r8,5.9544e-03_r8,4.7779e-03_r8,3.5984e-03_r8, & + &2.4247e-03_r8,1.2737e-03_r8,1.4692e-04_r8/) + kao(:, 2, 6,11) = (/ & + &9.2485e-03_r8,8.0943e-03_r8,6.9406e-03_r8,5.8161e-03_r8,4.6851e-03_r8,3.5677e-03_r8, & + &2.4748e-03_r8,1.3469e-03_r8,2.5178e-04_r8/) + kao(:, 3, 6,11) = (/ & + &8.7789e-03_r8,7.6827e-03_r8,6.6150e-03_r8,5.5437e-03_r8,4.4673e-03_r8,3.4787e-03_r8, & + &2.4528e-03_r8,1.4847e-03_r8,3.7920e-04_r8/) + kao(:, 4, 6,11) = (/ & + &8.2164e-03_r8,7.2018e-03_r8,6.2465e-03_r8,5.3375e-03_r8,4.3691e-03_r8,3.4064e-03_r8, & + &2.4151e-03_r8,1.7544e-03_r8,5.7438e-04_r8/) + kao(:, 5, 6,11) = (/ & + &6.8576e-03_r8,6.0356e-03_r8,5.1755e-03_r8,4.2553e-03_r8,3.2890e-03_r8,2.6043e-03_r8, & + &1.9585e-03_r8,2.3328e-03_r8,8.0859e-04_r8/) + kao(:, 1, 7,11) = (/ & + &2.6634e-02_r8,2.3306e-02_r8,1.9979e-02_r8,1.6651e-02_r8,1.3321e-02_r8,9.9924e-03_r8, & + &6.6684e-03_r8,3.3709e-03_r8,1.8920e-04_r8/) + kao(:, 2, 7,11) = (/ & + &2.5938e-02_r8,2.2696e-02_r8,1.9456e-02_r8,1.6215e-02_r8,1.2974e-02_r8,9.7488e-03_r8, & + &6.5437e-03_r8,3.3574e-03_r8,3.7520e-04_r8/) + kao(:, 3, 7,11) = (/ & + &2.5453e-02_r8,2.2274e-02_r8,1.9096e-02_r8,1.5918e-02_r8,1.2777e-02_r8,9.6455e-03_r8, & + &6.5081e-03_r8,3.3802e-03_r8,5.3158e-04_r8/) + kao(:, 4, 7,11) = (/ & + &2.4271e-02_r8,2.1241e-02_r8,1.8214e-02_r8,1.5233e-02_r8,1.2290e-02_r8,9.3599e-03_r8, & + &6.4912e-03_r8,3.4387e-03_r8,8.0667e-04_r8/) + kao(:, 5, 7,11) = (/ & + &2.2422e-02_r8,1.9613e-02_r8,1.6806e-02_r8,1.4145e-02_r8,1.1493e-02_r8,8.8108e-03_r8, & + &6.0692e-03_r8,3.4048e-03_r8,1.1367e-03_r8/) + kao(:, 1, 8,11) = (/ & + &9.5097e-02_r8,8.3206e-02_r8,7.1322e-02_r8,5.9437e-02_r8,4.7550e-02_r8,3.5664e-02_r8, & + &2.3777e-02_r8,1.1891e-02_r8,8.8895e-05_r8/) + kao(:, 2, 8,11) = (/ & + &9.2657e-02_r8,8.1078e-02_r8,6.9498e-02_r8,5.7915e-02_r8,4.6333e-02_r8,3.4754e-02_r8, & + &2.3172e-02_r8,1.1611e-02_r8,1.6093e-04_r8/) + kao(:, 3, 8,11) = (/ & + &8.9553e-02_r8,7.8360e-02_r8,6.7165e-02_r8,5.5974e-02_r8,4.4782e-02_r8,3.3592e-02_r8, & + &2.2399e-02_r8,1.1297e-02_r8,2.7559e-04_r8/) + kao(:, 4, 8,11) = (/ & + &8.7450e-02_r8,7.6527e-02_r8,6.5593e-02_r8,5.4667e-02_r8,4.3739e-02_r8,3.2808e-02_r8, & + &2.1983e-02_r8,1.1121e-02_r8,4.3678e-04_r8/) + kao(:, 5, 8,11) = (/ & + &8.6068e-02_r8,7.5315e-02_r8,6.4565e-02_r8,5.3811e-02_r8,4.3053e-02_r8,3.2463e-02_r8, & + &2.1814e-02_r8,1.1203e-02_r8,7.8846e-04_r8/) + kao(:, 1, 9,11) = (/ & + &6.4279e-01_r8,5.6245e-01_r8,4.8207e-01_r8,4.0173e-01_r8,3.2138e-01_r8,2.4105e-01_r8, & + &1.6070e-01_r8,8.0350e-02_r8,1.4861e-06_r8/) + kao(:, 2, 9,11) = (/ & + &6.2663e-01_r8,5.4828e-01_r8,4.6997e-01_r8,3.9164e-01_r8,3.1331e-01_r8,2.3498e-01_r8, & + &1.5666e-01_r8,7.8331e-02_r8,2.7002e-06_r8/) + kao(:, 3, 9,11) = (/ & + &6.1151e-01_r8,5.3505e-01_r8,4.5861e-01_r8,3.8220e-01_r8,3.0575e-01_r8,2.2931e-01_r8, & + &1.5288e-01_r8,7.6443e-02_r8,4.4491e-06_r8/) + kao(:, 4, 9,11) = (/ & + &5.9675e-01_r8,5.2214e-01_r8,4.4753e-01_r8,3.7296e-01_r8,2.9837e-01_r8,2.2379e-01_r8, & + &1.4920e-01_r8,7.4612e-02_r8,6.8192e-06_r8/) + kao(:, 5, 9,11) = (/ & + &5.8474e-01_r8,5.1167e-01_r8,4.3855e-01_r8,3.6547e-01_r8,2.9239e-01_r8,2.1930e-01_r8, & + &1.4621e-01_r8,7.3117e-02_r8,1.0152e-05_r8/) + kao(:, 1,10,11) = (/ & + &5.2427e+00_r8,4.5875e+00_r8,3.9320e+00_r8,3.2767e+00_r8,2.6214e+00_r8,1.9660e+00_r8, & + &1.3107e+00_r8,6.5538e-01_r8,3.2405e-06_r8/) + kao(:, 2,10,11) = (/ & + &5.1308e+00_r8,4.4894e+00_r8,3.8480e+00_r8,3.2067e+00_r8,2.5654e+00_r8,1.9241e+00_r8, & + &1.2827e+00_r8,6.4136e-01_r8,6.0207e-06_r8/) + kao(:, 3,10,11) = (/ & + &5.0278e+00_r8,4.3993e+00_r8,3.7708e+00_r8,3.1424e+00_r8,2.5139e+00_r8,1.8854e+00_r8, & + &1.2569e+00_r8,6.2847e-01_r8,1.0181e-05_r8/) + kao(:, 4,10,11) = (/ & + &4.9276e+00_r8,4.3117e+00_r8,3.6956e+00_r8,3.0798e+00_r8,2.4638e+00_r8,1.8478e+00_r8, & + &1.2319e+00_r8,6.1596e-01_r8,1.5690e-05_r8/) + kao(:, 5,10,11) = (/ & + &4.8175e+00_r8,4.2154e+00_r8,3.6129e+00_r8,3.0109e+00_r8,2.4088e+00_r8,1.8066e+00_r8, & + &1.2044e+00_r8,6.0226e-01_r8,2.2851e-05_r8/) + kao(:, 1,11,11) = (/ & + &1.4444e+01_r8,1.2639e+01_r8,1.0833e+01_r8,9.0277e+00_r8,7.2223e+00_r8,5.4167e+00_r8, & + &3.6111e+00_r8,1.8056e+00_r8,3.3928e-06_r8/) + kao(:, 2,11,11) = (/ & + &1.4191e+01_r8,1.2417e+01_r8,1.0643e+01_r8,8.8695e+00_r8,7.0956e+00_r8,5.3217e+00_r8, & + &3.5476e+00_r8,1.7739e+00_r8,6.3163e-06_r8/) + kao(:, 3,11,11) = (/ & + &1.3919e+01_r8,1.2179e+01_r8,1.0439e+01_r8,8.6994e+00_r8,6.9594e+00_r8,5.2197e+00_r8, & + &3.4797e+00_r8,1.7399e+00_r8,1.0603e-05_r8/) + kao(:, 4,11,11) = (/ & + &1.3652e+01_r8,1.1946e+01_r8,1.0239e+01_r8,8.5326e+00_r8,6.8259e+00_r8,5.1193e+00_r8, & + &3.4129e+00_r8,1.7065e+00_r8,1.6659e-05_r8/) + kao(:, 5,11,11) = (/ & + &1.3348e+01_r8,1.1680e+01_r8,1.0011e+01_r8,8.3424e+00_r8,6.6742e+00_r8,5.0056e+00_r8, & + &3.3371e+00_r8,1.6685e+00_r8,2.4500e-05_r8/) + kao(:, 1,12,11) = (/ & + &2.5285e+01_r8,2.2125e+01_r8,1.8964e+01_r8,1.5803e+01_r8,1.2642e+01_r8,9.4819e+00_r8, & + &6.3210e+00_r8,3.1605e+00_r8,2.1167e-06_r8/) + kao(:, 2,12,11) = (/ & + &2.4880e+01_r8,2.1769e+01_r8,1.8659e+01_r8,1.5550e+01_r8,1.2440e+01_r8,9.3299e+00_r8, & + &6.2198e+00_r8,3.1099e+00_r8,3.8897e-06_r8/) + kao(:, 3,12,11) = (/ & + &2.4433e+01_r8,2.1379e+01_r8,1.8325e+01_r8,1.5271e+01_r8,1.2217e+01_r8,9.1622e+00_r8, & + &6.1081e+00_r8,3.0541e+00_r8,6.6786e-06_r8/) + kao(:, 4,12,11) = (/ & + &2.3948e+01_r8,2.0955e+01_r8,1.7960e+01_r8,1.4967e+01_r8,1.1974e+01_r8,8.9803e+00_r8, & + &5.9870e+00_r8,2.9934e+00_r8,1.0649e-05_r8/) + kao(:, 5,12,11) = (/ & + &2.3474e+01_r8,2.0540e+01_r8,1.7606e+01_r8,1.4671e+01_r8,1.1737e+01_r8,8.8029e+00_r8, & + &5.8685e+00_r8,2.9342e+00_r8,1.7444e-05_r8/) + kao(:, 1,13,11) = (/ & + &3.6004e+01_r8,3.1505e+01_r8,2.7003e+01_r8,2.2503e+01_r8,1.8003e+01_r8,1.3502e+01_r8, & + &9.0009e+00_r8,4.5004e+00_r8,1.4918e-06_r8/) + kao(:, 2,13,11) = (/ & + &3.5389e+01_r8,3.0965e+01_r8,2.6541e+01_r8,2.2118e+01_r8,1.7694e+01_r8,1.3271e+01_r8, & + &8.8469e+00_r8,4.4235e+00_r8,2.8535e-06_r8/) + kao(:, 3,13,11) = (/ & + &3.4779e+01_r8,3.0432e+01_r8,2.6084e+01_r8,2.1737e+01_r8,1.7389e+01_r8,1.3042e+01_r8, & + &8.6948e+00_r8,4.3474e+00_r8,4.8793e-06_r8/) + kao(:, 4,13,11) = (/ & + &3.4139e+01_r8,2.9872e+01_r8,2.5605e+01_r8,2.1337e+01_r8,1.7070e+01_r8,1.2802e+01_r8, & + &8.5348e+00_r8,4.2675e+00_r8,8.8607e-06_r8/) + kao(:, 5,13,11) = (/ & + &3.3563e+01_r8,2.9368e+01_r8,2.5171e+01_r8,2.0976e+01_r8,1.6781e+01_r8,1.2586e+01_r8, & + &8.3906e+00_r8,4.1953e+00_r8,1.4420e-05_r8/) + kao(:, 1, 1,12) = (/ & + &6.4900e-05_r8,2.8719e-04_r8,5.6307e-04_r8,8.4351e-04_r8,1.1291e-03_r8,1.4211e-03_r8, & + &1.7201e-03_r8,1.9852e-03_r8,2.2469e-03_r8/) + kao(:, 2, 1,12) = (/ & + &3.4635e-05_r8,4.0542e-04_r8,7.9731e-04_r8,1.1929e-03_r8,1.5968e-03_r8,2.0148e-03_r8, & + &2.4518e-03_r8,2.8750e-03_r8,3.1817e-03_r8/) + kao(:, 3, 1,12) = (/ & + &3.0386e-05_r8,5.5544e-04_r8,1.0947e-03_r8,1.6361e-03_r8,2.1835e-03_r8,2.7444e-03_r8, & + &3.3456e-03_r8,3.9572e-03_r8,4.3509e-03_r8/) + kao(:, 4, 1,12) = (/ & + &2.1896e-05_r8,7.4746e-04_r8,1.4741e-03_r8,2.1992e-03_r8,2.9238e-03_r8,3.6527e-03_r8, & + &4.4093e-03_r8,5.2454e-03_r8,5.8288e-03_r8/) + kao(:, 5, 1,12) = (/ & + &2.2978e-05_r8,9.8728e-04_r8,1.9484e-03_r8,2.9034e-03_r8,3.8494e-03_r8,4.7859e-03_r8, & + &5.7216e-03_r8,6.7414e-03_r8,7.6777e-03_r8/) + kao(:, 1, 2,12) = (/ & + &1.5749e-04_r8,2.0866e-04_r8,4.6787e-04_r8,6.8742e-04_r8,9.1071e-04_r8,1.1382e-03_r8, & + &1.3780e-03_r8,1.6236e-03_r8,1.7971e-03_r8/) + kao(:, 2, 2,12) = (/ & + &6.4613e-05_r8,2.9516e-04_r8,6.7832e-04_r8,1.0033e-03_r8,1.3310e-03_r8,1.6630e-03_r8, & + &2.0071e-03_r8,2.4028e-03_r8,2.6327e-03_r8/) + kao(:, 3, 2,12) = (/ & + &5.7078e-05_r8,4.5933e-04_r8,9.6118e-04_r8,1.4236e-03_r8,1.8857e-03_r8,2.3486e-03_r8, & + &2.8168e-03_r8,3.3472e-03_r8,3.7377e-03_r8/) + kao(:, 4, 2,12) = (/ & + &4.9262e-05_r8,6.5877e-04_r8,1.3301e-03_r8,1.9726e-03_r8,2.6111e-03_r8,3.2436e-03_r8, & + &3.8662e-03_r8,4.5052e-03_r8,5.1847e-03_r8/) + kao(:, 5, 2,12) = (/ & + &4.0132e-05_r8,8.9682e-04_r8,1.7993e-03_r8,2.6705e-03_r8,3.5334e-03_r8,4.3806e-03_r8, & + &5.1960e-03_r8,5.9592e-03_r8,7.0262e-03_r8/) + kao(:, 1, 3,12) = (/ & + &4.4536e-04_r8,4.2140e-04_r8,4.1326e-04_r8,5.8784e-04_r8,7.3376e-04_r8,8.8410e-04_r8, & + &1.0353e-03_r8,1.1868e-03_r8,1.3506e-03_r8/) + kao(:, 2, 3,12) = (/ & + &3.6360e-04_r8,3.5667e-04_r8,4.9101e-04_r8,8.4210e-04_r8,1.0791e-03_r8,1.3181e-03_r8, & + &1.5590e-03_r8,1.8085e-03_r8,2.0516e-03_r8/) + kao(:, 3, 3,12) = (/ & + &1.5077e-04_r8,2.9297e-04_r8,7.2917e-04_r8,1.2081e-03_r8,1.5723e-03_r8,1.9339e-03_r8, & + &2.2902e-03_r8,2.6377e-03_r8,3.0400e-03_r8/) + kao(:, 4, 3,12) = (/ & + &1.4163e-04_r8,2.2426e-04_r8,1.0557e-03_r8,1.7084e-03_r8,2.2382e-03_r8,2.7621e-03_r8, & + &3.2708e-03_r8,3.7457e-03_r8,4.3687e-03_r8/) + kao(:, 5, 3,12) = (/ & + &1.3019e-04_r8,2.3338e-04_r8,1.4920e-03_r8,2.3388e-03_r8,3.0800e-03_r8,3.8155e-03_r8, & + &4.5352e-03_r8,5.1815e-03_r8,6.0536e-03_r8/) + kao(:, 1, 4,12) = (/ & + &1.4099e-03_r8,1.2519e-03_r8,1.0992e-03_r8,9.6157e-04_r8,8.5060e-04_r8,8.2135e-04_r8, & + &8.8574e-04_r8,9.4943e-04_r8,1.0571e-03_r8/) + kao(:, 2, 4,12) = (/ & + &1.2160e-03_r8,1.0633e-03_r8,1.0308e-03_r8,9.5807e-04_r8,9.2808e-04_r8,1.1772e-03_r8, & + &1.3218e-03_r8,1.4545e-03_r8,1.6420e-03_r8/) + kao(:, 3, 4,12) = (/ & + &7.7631e-04_r8,7.4153e-04_r8,7.5882e-04_r8,8.7236e-04_r8,1.3771e-03_r8,1.6770e-03_r8, & + &1.9300e-03_r8,2.1670e-03_r8,2.4676e-03_r8/) + kao(:, 4, 4,12) = (/ & + &4.5228e-04_r8,5.1764e-04_r8,4.9825e-04_r8,1.0410e-03_r8,1.9642e-03_r8,2.3602e-03_r8, & + &2.7572e-03_r8,3.1444e-03_r8,3.5784e-03_r8/) + kao(:, 5, 4,12) = (/ & + &3.7162e-04_r8,5.4517e-04_r8,4.7653e-04_r8,1.0804e-03_r8,2.6516e-03_r8,3.2347e-03_r8, & + &3.8223e-03_r8,4.4076e-03_r8,4.9248e-03_r8/) + kao(:, 1, 5,12) = (/ & + &3.8990e-03_r8,3.4146e-03_r8,2.9418e-03_r8,2.4792e-03_r8,1.9894e-03_r8,1.5917e-03_r8, & + &1.1813e-03_r8,8.6801e-04_r8,2.1028e-04_r8/) + kao(:, 2, 5,12) = (/ & + &3.6199e-03_r8,3.1680e-03_r8,2.6938e-03_r8,2.3090e-03_r8,1.9956e-03_r8,1.6463e-03_r8, & + &1.2997e-03_r8,1.3006e-03_r8,2.4494e-04_r8/) + kao(:, 3, 5,12) = (/ & + &3.4415e-03_r8,3.0220e-03_r8,2.5761e-03_r8,2.2036e-03_r8,1.8689e-03_r8,1.5859e-03_r8, & + &1.7898e-03_r8,1.9074e-03_r8,5.0679e-04_r8/) + kao(:, 4, 5,12) = (/ & + &2.1716e-03_r8,1.9079e-03_r8,1.6133e-03_r8,1.3356e-03_r8,1.5050e-03_r8,1.8145e-03_r8, & + &2.4880e-03_r8,2.7223e-03_r8,8.8637e-04_r8/) + kao(:, 5, 5,12) = (/ & + &1.3077e-03_r8,1.2440e-03_r8,1.1158e-03_r8,9.0020e-04_r8,1.2713e-03_r8,2.3698e-03_r8, & + &3.3646e-03_r8,3.7560e-03_r8,1.3375e-03_r8/) + kao(:, 1, 6,12) = (/ & + &1.0196e-02_r8,8.9244e-03_r8,7.6531e-03_r8,6.3818e-03_r8,5.1267e-03_r8,3.9081e-03_r8, & + &2.6537e-03_r8,1.4661e-03_r8,1.6889e-04_r8/) + kao(:, 2, 6,12) = (/ & + &1.0111e-02_r8,8.8532e-03_r8,7.5941e-03_r8,6.3593e-03_r8,5.1154e-03_r8,3.8577e-03_r8, & + &2.6627e-03_r8,1.5273e-03_r8,2.6786e-04_r8/) + kao(:, 3, 6,12) = (/ & + &9.5574e-03_r8,8.3745e-03_r8,7.2096e-03_r8,6.0967e-03_r8,4.9927e-03_r8,3.8753e-03_r8, & + &2.6940e-03_r8,1.7929e-03_r8,4.4721e-04_r8/) + kao(:, 4, 6,12) = (/ & + &9.1448e-03_r8,8.0065e-03_r8,6.8180e-03_r8,5.6454e-03_r8,4.5888e-03_r8,3.5047e-03_r8, & + &2.6334e-03_r8,2.4842e-03_r8,6.5846e-04_r8/) + kao(:, 5, 6,12) = (/ & + &5.7075e-03_r8,5.0049e-03_r8,4.5271e-03_r8,4.0365e-03_r8,3.0612e-03_r8,2.5106e-03_r8, & + &2.5238e-03_r8,3.3792e-03_r8,9.8239e-04_r8/) + kao(:, 1, 7,12) = (/ & + &2.9179e-02_r8,2.5534e-02_r8,2.1889e-02_r8,1.8245e-02_r8,1.4599e-02_r8,1.0955e-02_r8, & + &7.3101e-03_r8,3.7189e-03_r8,1.6629e-04_r8/) + kao(:, 2, 7,12) = (/ & + &2.8331e-02_r8,2.4795e-02_r8,2.1258e-02_r8,1.7722e-02_r8,1.4184e-02_r8,1.0647e-02_r8, & + &7.1746e-03_r8,3.6882e-03_r8,3.2759e-04_r8/) + kao(:, 3, 7,12) = (/ & + &2.7584e-02_r8,2.4141e-02_r8,2.0699e-02_r8,1.7251e-02_r8,1.3817e-02_r8,1.0419e-02_r8, & + &6.9883e-03_r8,3.6331e-03_r8,7.5693e-04_r8/) + kao(:, 4, 7,12) = (/ & + &2.7092e-02_r8,2.3710e-02_r8,2.0332e-02_r8,1.6950e-02_r8,1.3669e-02_r8,1.0331e-02_r8, & + &6.9978e-03_r8,3.6886e-03_r8,1.3272e-03_r8/) + kao(:, 5, 7,12) = (/ & + &2.4668e-02_r8,2.1578e-02_r8,1.8509e-02_r8,1.5691e-02_r8,1.2680e-02_r8,9.7141e-03_r8, & + &6.7022e-03_r8,3.7141e-03_r8,1.7778e-03_r8/) + kao(:, 1, 8,12) = (/ & + &1.0361e-01_r8,9.0667e-02_r8,7.7713e-02_r8,6.4765e-02_r8,5.1815e-02_r8,3.8864e-02_r8, & + &2.5914e-02_r8,1.2965e-02_r8,1.1677e-04_r8/) + kao(:, 2, 8,12) = (/ & + &1.0115e-01_r8,8.8507e-02_r8,7.5864e-02_r8,6.3225e-02_r8,5.0584e-02_r8,3.7943e-02_r8, & + &2.5302e-02_r8,1.2662e-02_r8,2.2624e-04_r8/) + kao(:, 3, 8,12) = (/ & + &9.8784e-02_r8,8.6438e-02_r8,7.4094e-02_r8,6.1749e-02_r8,4.9403e-02_r8,3.7059e-02_r8, & + &2.4715e-02_r8,1.2461e-02_r8,3.7810e-04_r8/) + kao(:, 4, 8,12) = (/ & + &9.5779e-02_r8,8.3802e-02_r8,7.1837e-02_r8,5.9866e-02_r8,4.7899e-02_r8,3.5935e-02_r8, & + &2.4068e-02_r8,1.2158e-02_r8,6.1406e-04_r8/) + kao(:, 5, 8,12) = (/ & + &9.3500e-02_r8,8.1816e-02_r8,7.0121e-02_r8,5.8448e-02_r8,4.6756e-02_r8,3.5152e-02_r8, & + &2.3515e-02_r8,1.2003e-02_r8,9.1223e-04_r8/) + kao(:, 1, 9,12) = (/ & + &7.0616e-01_r8,6.1791e-01_r8,5.2965e-01_r8,4.4136e-01_r8,3.5309e-01_r8,2.6483e-01_r8, & + &1.7655e-01_r8,8.8282e-02_r8,1.5290e-06_r8/) + kao(:, 2, 9,12) = (/ & + &6.9151e-01_r8,6.0507e-01_r8,5.1861e-01_r8,4.3218e-01_r8,3.4576e-01_r8,2.5930e-01_r8, & + &1.7288e-01_r8,8.6445e-02_r8,2.6717e-06_r8/) + kao(:, 3, 9,12) = (/ & + &6.7650e-01_r8,5.9194e-01_r8,5.0740e-01_r8,4.2284e-01_r8,3.3827e-01_r8,2.5371e-01_r8, & + &1.6914e-01_r8,8.4579e-02_r8,4.4922e-06_r8/) + kao(:, 4, 9,12) = (/ & + &6.5888e-01_r8,5.7654e-01_r8,4.9417e-01_r8,4.1183e-01_r8,3.2946e-01_r8,2.4710e-01_r8, & + &1.6473e-01_r8,8.2371e-02_r8,7.3887e-06_r8/) + kao(:, 5, 9,12) = (/ & + &6.4040e-01_r8,5.6034e-01_r8,4.8031e-01_r8,4.0028e-01_r8,3.2019e-01_r8,2.4016e-01_r8, & + &1.6010e-01_r8,8.0057e-02_r8,1.1597e-05_r8/) + kao(:, 1,10,12) = (/ & + &5.7734e+00_r8,5.0518e+00_r8,4.3301e+00_r8,3.6085e+00_r8,2.8866e+00_r8,2.1651e+00_r8, & + &1.4434e+00_r8,7.2167e-01_r8,9.1748e-07_r8/) + kao(:, 2,10,12) = (/ & + &5.6550e+00_r8,4.9481e+00_r8,4.2414e+00_r8,3.5344e+00_r8,2.8275e+00_r8,2.1206e+00_r8, & + &1.4138e+00_r8,7.0688e-01_r8,1.6728e-06_r8/) + kao(:, 3,10,12) = (/ & + &5.5293e+00_r8,4.8379e+00_r8,4.1470e+00_r8,3.4558e+00_r8,2.7646e+00_r8,2.0735e+00_r8, & + &1.3823e+00_r8,6.9113e-01_r8,2.9526e-06_r8/) + kao(:, 4,10,12) = (/ & + &5.4054e+00_r8,4.7297e+00_r8,4.0540e+00_r8,3.3783e+00_r8,2.7027e+00_r8,2.0270e+00_r8, & + &1.3514e+00_r8,6.7568e-01_r8,4.8767e-06_r8/) + kao(:, 5,10,12) = (/ & + &5.2733e+00_r8,4.6145e+00_r8,3.9550e+00_r8,3.2959e+00_r8,2.6366e+00_r8,1.9775e+00_r8, & + &1.3184e+00_r8,6.5919e-01_r8,7.7655e-06_r8/) + kao(:, 1,11,12) = (/ & + &1.5785e+01_r8,1.3812e+01_r8,1.1839e+01_r8,9.8659e+00_r8,7.8925e+00_r8,5.9194e+00_r8, & + &3.9463e+00_r8,1.9732e+00_r8,7.4549e-07_r8/) + kao(:, 2,11,12) = (/ & + &1.5479e+01_r8,1.3544e+01_r8,1.1609e+01_r8,9.6738e+00_r8,7.7393e+00_r8,5.8045e+00_r8, & + &3.8695e+00_r8,1.9348e+00_r8,1.4083e-06_r8/) + kao(:, 3,11,12) = (/ & + &1.5180e+01_r8,1.3283e+01_r8,1.1385e+01_r8,9.4881e+00_r8,7.5902e+00_r8,5.6927e+00_r8, & + &3.7951e+00_r8,1.8975e+00_r8,2.4492e-06_r8/) + kao(:, 4,11,12) = (/ & + &1.4875e+01_r8,1.3016e+01_r8,1.1157e+01_r8,9.2972e+00_r8,7.4378e+00_r8,5.5784e+00_r8, & + &3.7189e+00_r8,1.8594e+00_r8,4.0481e-06_r8/) + kao(:, 5,11,12) = (/ & + &1.4584e+01_r8,1.2761e+01_r8,1.0938e+01_r8,9.1150e+00_r8,7.2921e+00_r8,5.4689e+00_r8, & + &3.6460e+00_r8,1.8230e+00_r8,6.1324e-06_r8/) + kao(:, 1,12,12) = (/ & + &2.7851e+01_r8,2.4369e+01_r8,2.0888e+01_r8,1.7407e+01_r8,1.3925e+01_r8,1.0444e+01_r8, & + &6.9625e+00_r8,3.4813e+00_r8,1.7967e-06_r8/) + kao(:, 2,12,12) = (/ & + &2.7381e+01_r8,2.3958e+01_r8,2.0536e+01_r8,1.7113e+01_r8,1.3691e+01_r8,1.0268e+01_r8, & + &6.8453e+00_r8,3.4226e+00_r8,3.3551e-06_r8/) + kao(:, 3,12,12) = (/ & + &2.6898e+01_r8,2.3535e+01_r8,2.0173e+01_r8,1.6811e+01_r8,1.3449e+01_r8,1.0086e+01_r8, & + &6.7243e+00_r8,3.3621e+00_r8,5.7999e-06_r8/) + kao(:, 4,12,12) = (/ & + &2.6422e+01_r8,2.3120e+01_r8,1.9816e+01_r8,1.6513e+01_r8,1.3211e+01_r8,9.9083e+00_r8, & + &6.6055e+00_r8,3.3027e+00_r8,8.8648e-06_r8/) + kao(:, 5,12,12) = (/ & + &2.5893e+01_r8,2.2657e+01_r8,1.9420e+01_r8,1.6183e+01_r8,1.2946e+01_r8,9.7098e+00_r8, & + &6.4732e+00_r8,3.2366e+00_r8,1.3030e-05_r8/) + kao(:, 1,13,12) = (/ & + &4.0056e+01_r8,3.5049e+01_r8,3.0042e+01_r8,2.5035e+01_r8,2.0028e+01_r8,1.5021e+01_r8, & + &1.0014e+01_r8,5.0068e+00_r8,1.9339e-06_r8/) + kao(:, 2,13,12) = (/ & + &3.9543e+01_r8,3.4599e+01_r8,2.9657e+01_r8,2.4713e+01_r8,1.9771e+01_r8,1.4828e+01_r8, & + &9.8854e+00_r8,4.9428e+00_r8,3.6424e-06_r8/) + kao(:, 3,13,12) = (/ & + &3.8932e+01_r8,3.4065e+01_r8,2.9198e+01_r8,2.4333e+01_r8,1.9465e+01_r8,1.4599e+01_r8, & + &9.7330e+00_r8,4.8663e+00_r8,6.0957e-06_r8/) + kao(:, 4,13,12) = (/ & + &3.8278e+01_r8,3.3493e+01_r8,2.8708e+01_r8,2.3923e+01_r8,1.9139e+01_r8,1.4354e+01_r8, & + &9.5693e+00_r8,4.7847e+00_r8,9.5853e-06_r8/) + kao(:, 5,13,12) = (/ & + &3.7502e+01_r8,3.2815e+01_r8,2.8127e+01_r8,2.3438e+01_r8,1.8751e+01_r8,1.4063e+01_r8, & + &9.3751e+00_r8,4.6877e+00_r8,1.4124e-05_r8/) + kao(:, 1, 1,13) = (/ & + &7.4486e-05_r8,5.1116e-04_r8,1.0025e-03_r8,1.4842e-03_r8,1.9493e-03_r8,2.3797e-03_r8, & + &2.7258e-03_r8,2.8231e-03_r8,3.8853e-03_r8/) + kao(:, 2, 1,13) = (/ & + &6.5327e-05_r8,7.3706e-04_r8,1.4529e-03_r8,2.1556e-03_r8,2.8349e-03_r8,3.4671e-03_r8, & + &3.9764e-03_r8,4.1729e-03_r8,5.6550e-03_r8/) + kao(:, 3, 1,13) = (/ & + &2.8267e-05_r8,1.0173e-03_r8,2.0120e-03_r8,2.9905e-03_r8,3.9385e-03_r8,4.8257e-03_r8, & + &5.5630e-03_r8,5.8315e-03_r8,7.8638e-03_r8/) + kao(:, 4, 1,13) = (/ & + &2.3738e-05_r8,1.3547e-03_r8,2.6849e-03_r8,3.9940e-03_r8,5.2660e-03_r8,6.4652e-03_r8, & + &7.4857e-03_r8,7.8673e-03_r8,1.0519e-02_r8/) + kao(:, 5, 1,13) = (/ & + &2.6320e-05_r8,1.7490e-03_r8,3.4713e-03_r8,5.1691e-03_r8,6.8225e-03_r8,8.3917e-03_r8, & + &9.7490e-03_r8,1.0316e-02_r8,1.3632e-02_r8/) + kao(:, 1, 2,13) = (/ & + &1.3584e-04_r8,4.6683e-04_r8,9.0905e-04_r8,1.3477e-03_r8,1.7804e-03_r8,2.1997e-03_r8, & + &2.5843e-03_r8,2.8459e-03_r8,3.5348e-03_r8/) + kao(:, 2, 2,13) = (/ & + &1.2342e-04_r8,6.7608e-04_r8,1.3278e-03_r8,1.9757e-03_r8,2.6172e-03_r8,3.2432e-03_r8, & + &3.8268e-03_r8,4.2250e-03_r8,5.2098e-03_r8/) + kao(:, 3, 2,13) = (/ & + &5.7073e-05_r8,9.3916e-04_r8,1.8537e-03_r8,2.7640e-03_r8,3.6667e-03_r8,4.5531e-03_r8, & + &5.3892e-03_r8,5.9774e-03_r8,7.3088e-03_r8/) + kao(:, 4, 2,13) = (/ & + &4.3007e-05_r8,1.2575e-03_r8,2.4910e-03_r8,3.7207e-03_r8,4.9408e-03_r8,6.1442e-03_r8, & + &7.2881e-03_r8,8.1201e-03_r8,9.8567e-03_r8/) + kao(:, 5, 2,13) = (/ & + &4.4050e-05_r8,1.6325e-03_r8,3.2411e-03_r8,4.8448e-03_r8,6.4428e-03_r8,8.0196e-03_r8, & + &9.5284e-03_r8,1.0661e-02_r8,1.2860e-02_r8/) + kao(:, 1, 3,13) = (/ & + &4.8847e-04_r8,4.8646e-04_r8,7.2624e-04_r8,1.0874e-03_r8,1.4317e-03_r8,1.7747e-03_r8, & + &2.1141e-03_r8,2.4304e-03_r8,2.8058e-03_r8/) + kao(:, 2, 3,13) = (/ & + &3.4302e-04_r8,4.5845e-04_r8,1.0966e-03_r8,1.6182e-03_r8,2.1396e-03_r8,2.6609e-03_r8, & + &3.1797e-03_r8,3.6788e-03_r8,4.2203e-03_r8/) + kao(:, 3, 3,13) = (/ & + &2.3118e-04_r8,5.8673e-04_r8,1.5488e-03_r8,2.2966e-03_r8,3.0451e-03_r8,3.7949e-03_r8, & + &4.5473e-03_r8,5.2834e-03_r8,6.0295e-03_r8/) + kao(:, 4, 3,13) = (/ & + &1.2745e-04_r8,7.5679e-04_r8,2.1131e-03_r8,3.1366e-03_r8,4.1628e-03_r8,5.1929e-03_r8, & + &6.2318e-03_r8,7.2646e-03_r8,8.2577e-03_r8/) + kao(:, 5, 3,13) = (/ & + &1.0163e-04_r8,9.0005e-04_r8,2.8013e-03_r8,4.1651e-03_r8,5.5261e-03_r8,6.8877e-03_r8, & + &8.2517e-03_r8,9.6360e-03_r8,1.0972e-02_r8/) + kao(:, 1, 4,13) = (/ & + &1.4481e-03_r8,1.2897e-03_r8,1.1542e-03_r8,1.0925e-03_r8,1.1503e-03_r8,1.3566e-03_r8, & + &1.5821e-03_r8,1.8266e-03_r8,2.0462e-03_r8/) + kao(:, 2, 4,13) = (/ & + &1.3895e-03_r8,1.2964e-03_r8,1.0801e-03_r8,1.1824e-03_r8,1.6797e-03_r8,2.0441e-03_r8, & + &2.4259e-03_r8,2.8265e-03_r8,3.1666e-03_r8/) + kao(:, 3, 4,13) = (/ & + &8.4970e-04_r8,9.1322e-04_r8,9.4827e-04_r8,1.6805e-03_r8,2.4256e-03_r8,2.9871e-03_r8, & + &3.5538e-03_r8,4.1410e-03_r8,4.6574e-03_r8/) + kao(:, 4, 4,13) = (/ & + &4.1870e-04_r8,6.5230e-04_r8,1.1618e-03_r8,2.4565e-03_r8,3.3994e-03_r8,4.2007e-03_r8, & + &5.0069e-03_r8,5.8294e-03_r8,6.5858e-03_r8/) + kao(:, 5, 4,13) = (/ & + &3.3416e-04_r8,5.3110e-04_r8,1.2880e-03_r8,3.5329e-03_r8,4.6400e-03_r8,5.7434e-03_r8, & + &6.8465e-03_r8,7.9498e-03_r8,9.0475e-03_r8/) + kao(:, 1, 5,13) = (/ & + &4.2095e-03_r8,3.6897e-03_r8,3.1731e-03_r8,2.7426e-03_r8,2.2812e-03_r8,1.8053e-03_r8, & + &1.3867e-03_r8,1.3663e-03_r8,1.0788e-03_r8/) + kao(:, 2, 5,13) = (/ & + &4.0034e-03_r8,3.5161e-03_r8,3.1982e-03_r8,2.7135e-03_r8,2.2188e-03_r8,1.8636e-03_r8, & + &1.9269e-03_r8,2.1141e-03_r8,1.6636e-03_r8/) + kao(:, 3, 5,13) = (/ & + &3.5828e-03_r8,3.2123e-03_r8,2.7997e-03_r8,2.3571e-03_r8,1.9942e-03_r8,2.3633e-03_r8, & + &2.8135e-03_r8,3.1780e-03_r8,2.3977e-03_r8/) + kao(:, 4, 5,13) = (/ & + &2.0578e-03_r8,1.9948e-03_r8,1.9739e-03_r8,1.8494e-03_r8,2.1664e-03_r8,3.4722e-03_r8, & + &4.0379e-03_r8,4.6191e-03_r8,3.3853e-03_r8/) + kao(:, 5, 5,13) = (/ & + &8.8300e-04_r8,9.5901e-04_r8,1.3118e-03_r8,1.4619e-03_r8,2.8921e-03_r8,4.8304e-03_r8, & + &5.6699e-03_r8,6.5165e-03_r8,5.0451e-03_r8/) + kao(:, 1, 6,13) = (/ & + &1.1518e-02_r8,1.0082e-02_r8,8.6450e-03_r8,7.2094e-03_r8,5.7738e-03_r8,4.4142e-03_r8, & + &2.9967e-03_r8,1.6414e-03_r8,2.3528e-04_r8/) + kao(:, 2, 6,13) = (/ & + &1.0779e-02_r8,9.4346e-03_r8,8.0897e-03_r8,6.7606e-03_r8,5.5435e-03_r8,4.2583e-03_r8, & + &3.0675e-03_r8,1.8475e-03_r8,3.7683e-04_r8/) + kao(:, 3, 6,13) = (/ & + &1.0564e-02_r8,9.2493e-03_r8,7.9306e-03_r8,6.7005e-03_r8,5.4724e-03_r8,4.2002e-03_r8, & + &3.0432e-03_r8,2.5995e-03_r8,5.6137e-04_r8/) + kao(:, 4, 6,13) = (/ & + &8.9592e-03_r8,7.8426e-03_r8,6.9339e-03_r8,5.9610e-03_r8,4.9577e-03_r8,4.0115e-03_r8, & + &3.3973e-03_r8,3.7509e-03_r8,7.8787e-04_r8/) + kao(:, 5, 6,13) = (/ & + &5.6084e-03_r8,4.9031e-03_r8,4.1060e-03_r8,3.7154e-03_r8,3.3523e-03_r8,3.1522e-03_r8, & + &4.6655e-03_r8,5.3564e-03_r8,1.1263e-03_r8/) + kao(:, 1, 7,13) = (/ & + &3.2240e-02_r8,2.8212e-02_r8,2.4183e-02_r8,2.0155e-02_r8,1.6127e-02_r8,1.2099e-02_r8, & + &8.0718e-03_r8,4.1324e-03_r8,2.8875e-04_r8/) + kao(:, 2, 7,13) = (/ & + &3.1311e-02_r8,2.7399e-02_r8,2.3486e-02_r8,1.9574e-02_r8,1.5661e-02_r8,1.1749e-02_r8, & + &7.9670e-03_r8,4.1256e-03_r8,4.9392e-04_r8/) + kao(:, 3, 7,13) = (/ & + &2.9762e-02_r8,2.6043e-02_r8,2.2324e-02_r8,1.8611e-02_r8,1.4888e-02_r8,1.1369e-02_r8, & + &7.7126e-03_r8,4.2395e-03_r8,7.8171e-04_r8/) + kao(:, 4, 7,13) = (/ & + &2.8871e-02_r8,2.5265e-02_r8,2.1655e-02_r8,1.8050e-02_r8,1.4581e-02_r8,1.1027e-02_r8, & + &7.5640e-03_r8,4.2437e-03_r8,1.1828e-03_r8/) + kao(:, 5, 7,13) = (/ & + &2.6386e-02_r8,2.3095e-02_r8,1.9798e-02_r8,1.6677e-02_r8,1.3324e-02_r8,1.0191e-02_r8, & + &7.1310e-03_r8,4.8298e-03_r8,2.2511e-03_r8/) + kao(:, 1, 8,13) = (/ & + &1.1497e-01_r8,1.0060e-01_r8,8.6231e-02_r8,7.1859e-02_r8,5.7486e-02_r8,4.3117e-02_r8, & + &2.8748e-02_r8,1.4377e-02_r8,1.6465e-04_r8/) + kao(:, 2, 8,13) = (/ & + &1.1189e-01_r8,9.7901e-02_r8,8.3916e-02_r8,6.9933e-02_r8,5.5946e-02_r8,4.1961e-02_r8, & + &2.7977e-02_r8,1.3991e-02_r8,2.9555e-04_r8/) + kao(:, 3, 8,13) = (/ & + &1.0913e-01_r8,9.5494e-02_r8,8.1850e-02_r8,6.8211e-02_r8,5.4570e-02_r8,4.0928e-02_r8, & + &2.7290e-02_r8,1.3843e-02_r8,5.2136e-04_r8/) + kao(:, 4, 8,13) = (/ & + &1.0534e-01_r8,9.2180e-02_r8,7.9010e-02_r8,6.5847e-02_r8,5.2678e-02_r8,3.9513e-02_r8, & + &2.6523e-02_r8,1.3514e-02_r8,8.6919e-04_r8/) + kao(:, 5, 8,13) = (/ & + &1.0155e-01_r8,8.8866e-02_r8,7.6173e-02_r8,6.3476e-02_r8,5.0785e-02_r8,3.8190e-02_r8, & + &2.5826e-02_r8,1.3344e-02_r8,1.3651e-03_r8/) + kao(:, 1, 9,13) = (/ & + &7.8551e-01_r8,6.8732e-01_r8,5.8909e-01_r8,4.9092e-01_r8,3.9275e-01_r8,2.9457e-01_r8, & + &1.9638e-01_r8,9.8187e-02_r8,1.8629e-06_r8/) + kao(:, 2, 9,13) = (/ & + &7.6466e-01_r8,6.6906e-01_r8,5.7351e-01_r8,4.7791e-01_r8,3.8233e-01_r8,2.8675e-01_r8, & + &1.9117e-01_r8,9.5586e-02_r8,3.1593e-06_r8/) + kao(:, 3, 9,13) = (/ & + &7.4558e-01_r8,6.5237e-01_r8,5.5922e-01_r8,4.6601e-01_r8,3.7282e-01_r8,2.7960e-01_r8, & + &1.8640e-01_r8,9.3207e-02_r8,5.1342e-06_r8/) + kao(:, 4, 9,13) = (/ & + &7.2909e-01_r8,6.3798e-01_r8,5.4684e-01_r8,4.5571e-01_r8,3.6456e-01_r8,2.7343e-01_r8, & + &1.8229e-01_r8,9.1144e-02_r8,7.8192e-06_r8/) + kao(:, 5, 9,13) = (/ & + &7.0726e-01_r8,6.1887e-01_r8,5.3047e-01_r8,4.4203e-01_r8,3.5366e-01_r8,2.6523e-01_r8, & + &1.7683e-01_r8,8.8423e-02_r8,1.1206e-05_r8/) + kao(:, 1,10,13) = (/ & + &6.4269e+00_r8,5.6236e+00_r8,4.8204e+00_r8,4.0168e+00_r8,3.2134e+00_r8,2.4100e+00_r8, & + &1.6066e+00_r8,8.0335e-01_r8,1.1293e-06_r8/) + kao(:, 2,10,13) = (/ & + &6.2640e+00_r8,5.4811e+00_r8,4.6981e+00_r8,3.9150e+00_r8,3.1320e+00_r8,2.3491e+00_r8, & + &1.5660e+00_r8,7.8302e-01_r8,2.0871e-06_r8/) + kao(:, 3,10,13) = (/ & + &6.1220e+00_r8,5.3567e+00_r8,4.5912e+00_r8,3.8262e+00_r8,3.0609e+00_r8,2.2959e+00_r8, & + &1.5304e+00_r8,7.6518e-01_r8,3.5513e-06_r8/) + kao(:, 4,10,13) = (/ & + &5.9998e+00_r8,5.2499e+00_r8,4.4998e+00_r8,3.7498e+00_r8,2.9997e+00_r8,2.2499e+00_r8, & + &1.5000e+00_r8,7.4994e-01_r8,5.6768e-06_r8/) + kao(:, 5,10,13) = (/ & + &5.8812e+00_r8,5.1459e+00_r8,4.4109e+00_r8,3.6757e+00_r8,2.9406e+00_r8,2.2054e+00_r8, & + &1.4703e+00_r8,7.3514e-01_r8,8.5300e-06_r8/) + kao(:, 1,11,13) = (/ & + &1.7678e+01_r8,1.5468e+01_r8,1.3258e+01_r8,1.1049e+01_r8,8.8386e+00_r8,6.6292e+00_r8, & + &4.4195e+00_r8,2.2097e+00_r8,9.5807e-07_r8/) + kao(:, 2,11,13) = (/ & + &1.7256e+01_r8,1.5100e+01_r8,1.2942e+01_r8,1.0785e+01_r8,8.6284e+00_r8,6.4710e+00_r8, & + &4.3143e+00_r8,2.1571e+00_r8,1.8271e-06_r8/) + kao(:, 3,11,13) = (/ & + &1.6917e+01_r8,1.4802e+01_r8,1.2687e+01_r8,1.0572e+01_r8,8.4580e+00_r8,6.3436e+00_r8, & + &4.2290e+00_r8,2.1146e+00_r8,3.1322e-06_r8/) + kao(:, 4,11,13) = (/ & + &1.6624e+01_r8,1.4546e+01_r8,1.2468e+01_r8,1.0390e+01_r8,8.3118e+00_r8,6.2340e+00_r8, & + &4.1559e+00_r8,2.0780e+00_r8,4.9941e-06_r8/) + kao(:, 5,11,13) = (/ & + &1.6312e+01_r8,1.4273e+01_r8,1.2234e+01_r8,1.0195e+01_r8,8.1562e+00_r8,6.1169e+00_r8, & + &4.0780e+00_r8,2.0391e+00_r8,7.8208e-06_r8/) + kao(:, 1,12,13) = (/ & + &3.1083e+01_r8,2.7197e+01_r8,2.3312e+01_r8,1.9426e+01_r8,1.5541e+01_r8,1.1655e+01_r8, & + &7.7704e+00_r8,3.8852e+00_r8,7.4323e-07_r8/) + kao(:, 2,12,13) = (/ & + &3.0431e+01_r8,2.6627e+01_r8,2.2823e+01_r8,1.9019e+01_r8,1.5215e+01_r8,1.1411e+01_r8, & + &7.6077e+00_r8,3.8037e+00_r8,1.4468e-06_r8/) + kao(:, 3,12,13) = (/ & + &2.9924e+01_r8,2.6183e+01_r8,2.2443e+01_r8,1.8702e+01_r8,1.4961e+01_r8,1.1221e+01_r8, & + &7.4808e+00_r8,3.7405e+00_r8,2.6259e-06_r8/) + kao(:, 4,12,13) = (/ & + &2.9439e+01_r8,2.5759e+01_r8,2.2079e+01_r8,1.8399e+01_r8,1.4719e+01_r8,1.1040e+01_r8, & + &7.3599e+00_r8,3.6798e+00_r8,4.5448e-06_r8/) + kao(:, 5,12,13) = (/ & + &2.8940e+01_r8,2.5323e+01_r8,2.1705e+01_r8,1.8088e+01_r8,1.4470e+01_r8,1.0853e+01_r8, & + &7.2348e+00_r8,3.6174e+00_r8,7.3875e-06_r8/) + kao(:, 1,13,13) = (/ & + &4.5024e+01_r8,3.9395e+01_r8,3.3766e+01_r8,2.8140e+01_r8,2.2511e+01_r8,1.6883e+01_r8, & + &1.1256e+01_r8,5.6279e+00_r8,6.0376e-07_r8/) + kao(:, 2,13,13) = (/ & + &4.4143e+01_r8,3.8625e+01_r8,3.3107e+01_r8,2.7589e+01_r8,2.2071e+01_r8,1.6554e+01_r8, & + &1.1035e+01_r8,5.5177e+00_r8,1.1756e-06_r8/) + kao(:, 3,13,13) = (/ & + &4.3457e+01_r8,3.8026e+01_r8,3.2594e+01_r8,2.7161e+01_r8,2.1728e+01_r8,1.6297e+01_r8, & + &1.0864e+01_r8,5.4320e+00_r8,2.1118e-06_r8/) + kao(:, 4,13,13) = (/ & + &4.2787e+01_r8,3.7437e+01_r8,3.2089e+01_r8,2.6742e+01_r8,2.1393e+01_r8,1.6044e+01_r8, & + &1.0696e+01_r8,5.3482e+00_r8,3.5390e-06_r8/) + kao(:, 5,13,13) = (/ & + &4.2071e+01_r8,3.6811e+01_r8,3.1552e+01_r8,2.6294e+01_r8,2.1034e+01_r8,1.5776e+01_r8, & + &1.0517e+01_r8,5.2587e+00_r8,5.6752e-06_r8/) + kao(:, 1, 1,14) = (/ & + &8.0615e-05_r8,9.4684e-04_r8,1.8810e-03_r8,2.8058e-03_r8,3.7171e-03_r8,4.6066e-03_r8, & + &5.4471e-03_r8,6.0480e-03_r8,7.4265e-03_r8/) + kao(:, 2, 1,14) = (/ & + &7.2907e-05_r8,1.3385e-03_r8,2.6578e-03_r8,3.9621e-03_r8,5.2462e-03_r8,6.4943e-03_r8, & + &7.6854e-03_r8,8.5660e-03_r8,1.0483e-02_r8/) + kao(:, 3, 1,14) = (/ & + &6.3747e-05_r8,1.8288e-03_r8,3.6296e-03_r8,5.4086e-03_r8,7.1575e-03_r8,8.8508e-03_r8, & + &1.0431e-02_r8,1.1658e-02_r8,1.4300e-02_r8/) + kao(:, 4, 1,14) = (/ & + &3.9260e-05_r8,2.4240e-03_r8,4.8114e-03_r8,7.1688e-03_r8,9.4794e-03_r8,1.1704e-02_r8, & + &1.3748e-02_r8,1.5334e-02_r8,1.8941e-02_r8/) + kao(:, 5, 1,14) = (/ & + &2.4568e-05_r8,3.1272e-03_r8,6.2078e-03_r8,9.2494e-03_r8,1.2223e-02_r8,1.5067e-02_r8, & + &1.7657e-02_r8,1.9583e-02_r8,2.4427e-02_r8/) + kao(:, 1, 2,14) = (/ & + &1.5596e-04_r8,8.5463e-04_r8,1.6898e-03_r8,2.5200e-03_r8,3.3406e-03_r8,4.1439e-03_r8, & + &4.9117e-03_r8,5.5191e-03_r8,6.6708e-03_r8/) + kao(:, 2, 2,14) = (/ & + &1.3504e-04_r8,1.2362e-03_r8,2.4448e-03_r8,3.6435e-03_r8,4.8236e-03_r8,5.9777e-03_r8, & + &7.0641e-03_r8,7.9635e-03_r8,9.6287e-03_r8/) + kao(:, 3, 2,14) = (/ & + &1.1284e-04_r8,1.7193e-03_r8,3.4047e-03_r8,5.0732e-03_r8,6.7143e-03_r8,8.3092e-03_r8, & + &9.8022e-03_r8,1.1012e-02_r8,1.3405e-02_r8/) + kao(:, 4, 2,14) = (/ & + &7.1068e-05_r8,2.3136e-03_r8,4.5842e-03_r8,6.8306e-03_r8,9.0376e-03_r8,1.1180e-02_r8, & + &1.3169e-02_r8,1.4761e-02_r8,1.8047e-02_r8/) + kao(:, 5, 2,14) = (/ & + &4.9683e-05_r8,3.0234e-03_r8,5.9956e-03_r8,8.9376e-03_r8,1.1824e-02_r8,1.4613e-02_r8, & + &1.7201e-02_r8,1.9221e-02_r8,2.3615e-02_r8/) + kao(:, 1, 3,14) = (/ & + &4.8559e-04_r8,6.3562e-04_r8,1.4148e-03_r8,2.0956e-03_r8,2.7735e-03_r8,3.4411e-03_r8, & + &4.0892e-03_r8,4.6631e-03_r8,5.5086e-03_r8/) + kao(:, 2, 3,14) = (/ & + &3.9874e-04_r8,1.0860e-03_r8,2.1105e-03_r8,3.1322e-03_r8,4.1464e-03_r8,5.1442e-03_r8, & + &6.1073e-03_r8,6.9472e-03_r8,8.2419e-03_r8/) + kao(:, 3, 3,14) = (/ & + &3.0553e-04_r8,1.5424e-03_r8,3.0141e-03_r8,4.4802e-03_r8,5.9320e-03_r8,7.3631e-03_r8, & + &8.7355e-03_r8,9.9159e-03_r8,1.1803e-02_r8/) + kao(:, 4, 3,14) = (/ & + &2.0300e-04_r8,2.1134e-03_r8,4.1489e-03_r8,6.1729e-03_r8,8.1791e-03_r8,1.0152e-02_r8, & + &1.2037e-02_r8,1.3637e-02_r8,1.6288e-02_r8/) + kao(:, 5, 3,14) = (/ & + &1.2261e-04_r8,2.8083e-03_r8,5.5298e-03_r8,8.2360e-03_r8,1.0915e-02_r8,1.3546e-02_r8, & + &1.6061e-02_r8,1.8163e-02_r8,2.1753e-02_r8/) + kao(:, 1, 4,14) = (/ & + &1.6340e-03_r8,1.4799e-03_r8,1.3812e-03_r8,1.7164e-03_r8,2.2393e-03_r8,2.7610e-03_r8, & + &3.2750e-03_r8,3.7562e-03_r8,4.3569e-03_r8/) + kao(:, 2, 4,14) = (/ & + &1.3493e-03_r8,1.1314e-03_r8,1.6943e-03_r8,2.6409e-03_r8,3.4636e-03_r8,4.2822e-03_r8, & + &5.0857e-03_r8,5.8323e-03_r8,6.7806e-03_r8/) + kao(:, 3, 4,14) = (/ & + &9.9538e-04_r8,9.6503e-04_r8,2.6483e-03_r8,3.8772e-03_r8,5.1039e-03_r8,6.3200e-03_r8, & + &7.5138e-03_r8,8.6138e-03_r8,1.0038e-02_r8/) + kao(:, 4, 4,14) = (/ & + &7.1686e-04_r8,9.6594e-04_r8,3.7129e-03_r8,5.4649e-03_r8,7.2111e-03_r8,8.9436e-03_r8, & + &1.0638e-02_r8,1.2197e-02_r8,1.4232e-02_r8/) + kao(:, 5, 4,14) = (/ & + &3.7667e-04_r8,1.0457e-03_r8,5.0357e-03_r8,7.4391e-03_r8,9.8310e-03_r8,1.2205e-02_r8, & + &1.4525e-02_r8,1.6653e-02_r8,1.9453e-02_r8/) + kao(:, 1, 5,14) = (/ & + &4.8186e-03_r8,4.2167e-03_r8,3.6150e-03_r8,3.0747e-03_r8,2.5291e-03_r8,2.2936e-03_r8, & + &2.5986e-03_r8,2.9578e-03_r8,3.3675e-03_r8/) + kao(:, 2, 5,14) = (/ & + &4.3147e-03_r8,3.7763e-03_r8,3.3322e-03_r8,2.8723e-03_r8,2.9945e-03_r8,3.5591e-03_r8, & + &4.1803e-03_r8,4.7800e-03_r8,5.4630e-03_r8/) + kao(:, 3, 5,14) = (/ & + &3.5596e-03_r8,3.1147e-03_r8,2.7981e-03_r8,3.1802e-03_r8,4.4145e-03_r8,5.3933e-03_r8, & + &6.3651e-03_r8,7.3014e-03_r8,8.3701e-03_r8/) + kao(:, 4, 5,14) = (/ & + &2.3785e-03_r8,2.2217e-03_r8,2.2338e-03_r8,4.4885e-03_r8,6.3608e-03_r8,7.8120e-03_r8, & + &9.2509e-03_r8,1.0634e-02_r8,1.2219e-02_r8/) + kao(:, 5, 5,14) = (/ & + &1.3285e-03_r8,1.6004e-03_r8,2.5745e-03_r8,6.3438e-03_r8,8.8283e-03_r8,1.0885e-02_r8, & + &1.2921e-02_r8,1.4873e-02_r8,1.7112e-02_r8/) + kao(:, 1, 6,14) = (/ & + &1.2819e-02_r8,1.1217e-02_r8,9.6163e-03_r8,8.0152e-03_r8,6.4138e-03_r8,4.8948e-03_r8, & + &3.3434e-03_r8,2.3020e-03_r8,2.0077e-03_r8/) + kao(:, 2, 6,14) = (/ & + &1.2485e-02_r8,1.0926e-02_r8,9.3667e-03_r8,7.8075e-03_r8,6.3840e-03_r8,4.8805e-03_r8, & + &3.7061e-03_r8,3.8075e-03_r8,3.4020e-03_r8/) + kao(:, 3, 6,14) = (/ & + &1.1272e-02_r8,9.8625e-03_r8,8.4554e-03_r8,7.3206e-03_r8,6.0114e-03_r8,5.1792e-03_r8, & + &5.3340e-03_r8,6.0074e-03_r8,5.3316e-03_r8/) + kao(:, 4, 6,14) = (/ & + &1.0208e-02_r8,8.9332e-03_r8,7.9437e-03_r8,6.6798e-03_r8,5.8609e-03_r8,6.4855e-03_r8, & + &7.9228e-03_r8,9.0010e-03_r8,7.9567e-03_r8/) + kao(:, 5, 6,14) = (/ & + &6.0521e-03_r8,5.2891e-03_r8,4.8269e-03_r8,4.6206e-03_r8,6.6176e-03_r8,9.3039e-03_r8, & + &1.1293e-02_r8,1.2903e-02_r8,1.1196e-02_r8/) + kao(:, 1, 7,14) = (/ & + &3.6443e-02_r8,3.1891e-02_r8,2.7336e-02_r8,2.2781e-02_r8,1.8226e-02_r8,1.3673e-02_r8, & + &9.1182e-03_r8,4.6764e-03_r8,1.4855e-04_r8/) + kao(:, 2, 7,14) = (/ & + &3.5471e-02_r8,3.1039e-02_r8,2.6606e-02_r8,2.2173e-02_r8,1.7742e-02_r8,1.3309e-02_r8, & + &9.0490e-03_r8,4.6704e-03_r8,2.5095e-04_r8/) + kao(:, 3, 7,14) = (/ & + &3.4456e-02_r8,3.0149e-02_r8,2.5845e-02_r8,2.1540e-02_r8,1.7235e-02_r8,1.3185e-02_r8, & + &8.9735e-03_r8,5.4794e-03_r8,4.0737e-04_r8/) + kao(:, 4, 7,14) = (/ & + &3.1652e-02_r8,2.7700e-02_r8,2.3744e-02_r8,1.9792e-02_r8,1.6225e-02_r8,1.2450e-02_r8, & + &9.1363e-03_r8,7.6445e-03_r8,6.2917e-04_r8/) + kao(:, 5, 7,14) = (/ & + &2.9864e-02_r8,2.6135e-02_r8,2.2399e-02_r8,1.8923e-02_r8,1.5530e-02_r8,1.2143e-02_r8, & + &1.0151e-02_r8,1.1058e-02_r8,9.1130e-04_r8/) + kao(:, 1, 8,14) = (/ & + &1.3223e-01_r8,1.1571e-01_r8,9.9174e-02_r8,8.2651e-02_r8,6.6122e-02_r8,4.9592e-02_r8, & + &3.3063e-02_r8,1.6534e-02_r8,2.3921e-04_r8/) + kao(:, 2, 8,14) = (/ & + &1.2869e-01_r8,1.1260e-01_r8,9.6519e-02_r8,8.0434e-02_r8,6.4349e-02_r8,4.8263e-02_r8, & + &3.2179e-02_r8,1.6093e-02_r8,4.2965e-04_r8/) + kao(:, 3, 8,14) = (/ & + &1.2518e-01_r8,1.0953e-01_r8,9.3886e-02_r8,7.8243e-02_r8,6.2597e-02_r8,4.6952e-02_r8, & + &3.1306e-02_r8,1.5992e-02_r8,7.4452e-04_r8/) + kao(:, 4, 8,14) = (/ & + &1.2188e-01_r8,1.0664e-01_r8,9.1414e-02_r8,7.6180e-02_r8,6.0947e-02_r8,4.5714e-02_r8, & + &3.0548e-02_r8,1.5885e-02_r8,1.1502e-03_r8/) + kao(:, 5, 8,14) = (/ & + &1.1492e-01_r8,1.0055e-01_r8,8.6192e-02_r8,7.1832e-02_r8,5.7467e-02_r8,4.3105e-02_r8, & + &2.9610e-02_r8,1.5934e-02_r8,1.8646e-03_r8/) + kao(:, 1, 9,14) = (/ & + &9.2387e-01_r8,8.0839e-01_r8,6.9293e-01_r8,5.7740e-01_r8,4.6193e-01_r8,3.4646e-01_r8, & + &2.3098e-01_r8,1.1549e-01_r8,2.2371e-06_r8/) + kao(:, 2, 9,14) = (/ & + &9.0122e-01_r8,7.8856e-01_r8,6.7591e-01_r8,5.6327e-01_r8,4.5061e-01_r8,3.3795e-01_r8, & + &2.2531e-01_r8,1.1266e-01_r8,3.5853e-06_r8/) + kao(:, 3, 9,14) = (/ & + &8.7866e-01_r8,7.6881e-01_r8,6.5900e-01_r8,5.4913e-01_r8,4.3933e-01_r8,3.2948e-01_r8, & + &2.1967e-01_r8,1.0984e-01_r8,5.0567e-06_r8/) + kao(:, 4, 9,14) = (/ & + &8.5611e-01_r8,7.4910e-01_r8,6.4207e-01_r8,5.3506e-01_r8,4.2806e-01_r8,3.2105e-01_r8, & + &2.1404e-01_r8,1.0702e-01_r8,6.9838e-06_r8/) + kao(:, 5, 9,14) = (/ & + &8.3494e-01_r8,7.3059e-01_r8,6.2623e-01_r8,5.2185e-01_r8,4.1749e-01_r8,3.1312e-01_r8, & + &2.0874e-01_r8,1.0439e-01_r8,9.6651e-06_r8/) + kao(:, 1,10,14) = (/ & + &7.7336e+00_r8,6.7669e+00_r8,5.8002e+00_r8,4.8337e+00_r8,3.8667e+00_r8,2.9002e+00_r8, & + &1.9334e+00_r8,9.6674e-01_r8,1.4759e-06_r8/) + kao(:, 2,10,14) = (/ & + &7.5671e+00_r8,6.6210e+00_r8,5.6751e+00_r8,4.7295e+00_r8,3.7835e+00_r8,2.8377e+00_r8, & + &1.8919e+00_r8,9.4588e-01_r8,2.4483e-06_r8/) + kao(:, 3,10,14) = (/ & + &7.3934e+00_r8,6.4694e+00_r8,5.5449e+00_r8,4.6209e+00_r8,3.6964e+00_r8,2.7725e+00_r8, & + &1.8483e+00_r8,9.2413e-01_r8,3.6428e-06_r8/) + kao(:, 4,10,14) = (/ & + &7.2085e+00_r8,6.3072e+00_r8,5.4063e+00_r8,4.5053e+00_r8,3.6041e+00_r8,2.7031e+00_r8, & + &1.8022e+00_r8,9.0111e-01_r8,5.1643e-06_r8/) + kao(:, 5,10,14) = (/ & + &7.0344e+00_r8,6.1551e+00_r8,5.2759e+00_r8,4.3968e+00_r8,3.5172e+00_r8,2.6378e+00_r8, & + &1.7586e+00_r8,8.7933e-01_r8,7.2619e-06_r8/) + kao(:, 1,11,14) = (/ & + &2.1626e+01_r8,1.8923e+01_r8,1.6220e+01_r8,1.3516e+01_r8,1.0813e+01_r8,8.1097e+00_r8, & + &5.4065e+00_r8,2.7033e+00_r8,1.2148e-06_r8/) + kao(:, 2,11,14) = (/ & + &2.1170e+01_r8,1.8523e+01_r8,1.5877e+01_r8,1.3231e+01_r8,1.0585e+01_r8,7.9391e+00_r8, & + &5.2925e+00_r8,2.6462e+00_r8,1.9377e-06_r8/) + kao(:, 3,11,14) = (/ & + &2.0665e+01_r8,1.8082e+01_r8,1.5499e+01_r8,1.2916e+01_r8,1.0333e+01_r8,7.7495e+00_r8, & + &5.1662e+00_r8,2.5832e+00_r8,2.9701e-06_r8/) + kao(:, 4,11,14) = (/ & + &2.0140e+01_r8,1.7623e+01_r8,1.5106e+01_r8,1.2588e+01_r8,1.0071e+01_r8,7.5528e+00_r8, & + &5.0352e+00_r8,2.5176e+00_r8,4.4558e-06_r8/) + kao(:, 5,11,14) = (/ & + &1.9664e+01_r8,1.7206e+01_r8,1.4748e+01_r8,1.2290e+01_r8,9.8317e+00_r8,7.3738e+00_r8, & + &4.9159e+00_r8,2.4579e+00_r8,6.2661e-06_r8/) + kao(:, 1,12,14) = (/ & + &3.8270e+01_r8,3.3486e+01_r8,2.8703e+01_r8,2.3919e+01_r8,1.9135e+01_r8,1.4352e+01_r8, & + &9.5673e+00_r8,4.7836e+00_r8,1.1282e-06_r8/) + kao(:, 2,12,14) = (/ & + &3.7417e+01_r8,3.2741e+01_r8,2.8063e+01_r8,2.3387e+01_r8,1.8709e+01_r8,1.4031e+01_r8, & + &9.3545e+00_r8,4.6770e+00_r8,1.8527e-06_r8/) + kao(:, 3,12,14) = (/ & + &3.6489e+01_r8,3.1928e+01_r8,2.7367e+01_r8,2.2805e+01_r8,1.8244e+01_r8,1.3683e+01_r8, & + &9.1218e+00_r8,4.5610e+00_r8,2.7902e-06_r8/) + kao(:, 4,12,14) = (/ & + &3.5556e+01_r8,3.1112e+01_r8,2.6666e+01_r8,2.2223e+01_r8,1.7778e+01_r8,1.3333e+01_r8, & + &8.8890e+00_r8,4.4446e+00_r8,3.8795e-06_r8/) + kao(:, 5,12,14) = (/ & + &3.4682e+01_r8,3.0344e+01_r8,2.6011e+01_r8,2.1676e+01_r8,1.7341e+01_r8,1.3005e+01_r8, & + &8.6702e+00_r8,4.3349e+00_r8,5.0987e-06_r8/) + kao(:, 1,13,14) = (/ & + &5.4806e+01_r8,4.7955e+01_r8,4.1104e+01_r8,3.4254e+01_r8,2.7403e+01_r8,2.0551e+01_r8, & + &1.3701e+01_r8,6.8507e+00_r8,9.3782e-07_r8/) + kao(:, 2,13,14) = (/ & + &5.3507e+01_r8,4.6818e+01_r8,4.0130e+01_r8,3.3442e+01_r8,2.6753e+01_r8,2.0066e+01_r8, & + &1.3376e+01_r8,6.6886e+00_r8,1.6696e-06_r8/) + kao(:, 3,13,14) = (/ & + &5.2032e+01_r8,4.5528e+01_r8,3.9023e+01_r8,3.2519e+01_r8,2.6015e+01_r8,1.9512e+01_r8, & + &1.3008e+01_r8,6.5038e+00_r8,2.8850e-06_r8/) + kao(:, 4,13,14) = (/ & + &5.0622e+01_r8,4.4293e+01_r8,3.7966e+01_r8,3.1638e+01_r8,2.5310e+01_r8,1.8983e+01_r8, & + &1.2655e+01_r8,6.3275e+00_r8,4.3456e-06_r8/) + kao(:, 5,13,14) = (/ & + &4.9341e+01_r8,4.3174e+01_r8,3.7007e+01_r8,3.0838e+01_r8,2.4670e+01_r8,1.8503e+01_r8, & + &1.2335e+01_r8,6.1672e+00_r8,6.2672e-06_r8/) + kao(:, 1, 1,15) = (/ & + &9.0368e-05_r8,1.7587e-03_r8,3.4692e-03_r8,5.1215e-03_r8,6.6729e-03_r8,8.0447e-03_r8, & + &9.0360e-03_r8,8.9574e-03_r8,1.3337e-02_r8/) + kao(:, 2, 1,15) = (/ & + &8.5673e-05_r8,2.5288e-03_r8,4.9923e-03_r8,7.3709e-03_r8,9.6068e-03_r8,1.1588e-02_r8, & + &1.3021e-02_r8,1.2915e-02_r8,1.9203e-02_r8/) + kao(:, 3, 1,15) = (/ & + &7.5800e-05_r8,3.4920e-03_r8,6.8957e-03_r8,1.0184e-02_r8,1.3280e-02_r8,1.6021e-02_r8, & + &1.8010e-02_r8,1.7888e-02_r8,2.6548e-02_r8/) + kao(:, 4, 1,15) = (/ & + &6.6885e-05_r8,4.6582e-03_r8,9.2038e-03_r8,1.3596e-02_r8,1.7729e-02_r8,2.1393e-02_r8, & + &2.4064e-02_r8,2.3923e-02_r8,3.5446e-02_r8/) + kao(:, 5, 1,15) = (/ & + &2.9277e-05_r8,6.0336e-03_r8,1.1922e-02_r8,1.7611e-02_r8,2.2979e-02_r8,2.7733e-02_r8, & + &3.1220e-02_r8,3.1058e-02_r8,4.5944e-02_r8/) + kao(:, 1, 2,15) = (/ & + &1.6162e-04_r8,1.7658e-03_r8,3.4927e-03_r8,5.1816e-03_r8,6.8087e-03_r8,8.3146e-03_r8, & + &9.5542e-03_r8,9.9349e-03_r8,1.3602e-02_r8/) + kao(:, 2, 2,15) = (/ & + &1.4940e-04_r8,2.5810e-03_r8,5.1093e-03_r8,7.5846e-03_r8,9.9670e-03_r8,1.2178e-02_r8, & + &1.4000e-02_r8,1.4578e-02_r8,1.9917e-02_r8/) + kao(:, 3, 2,15) = (/ & + &1.4212e-04_r8,3.6142e-03_r8,7.1589e-03_r8,1.0631e-02_r8,1.3977e-02_r8,1.7085e-02_r8, & + &1.9645e-02_r8,2.0472e-02_r8,2.7934e-02_r8/) + kao(:, 4, 2,15) = (/ & + &1.2057e-04_r8,4.8773e-03_r8,9.6676e-03_r8,1.4359e-02_r8,1.8882e-02_r8,2.3081e-02_r8, & + &2.6561e-02_r8,2.7724e-02_r8,3.7741e-02_r8/) + kao(:, 5, 2,15) = (/ & + &6.0191e-05_r8,6.3788e-03_r8,1.2648e-02_r8,1.8790e-02_r8,2.4713e-02_r8,3.0224e-02_r8, & + &3.4797e-02_r8,3.6354e-02_r8,4.9402e-02_r8/) + kao(:, 1, 3,15) = (/ & + &4.4246e-04_r8,1.6142e-03_r8,3.1839e-03_r8,4.7378e-03_r8,6.2661e-03_r8,7.7441e-03_r8, & + &9.0975e-03_r8,1.0015e-02_r8,1.2497e-02_r8/) + kao(:, 2, 3,15) = (/ & + &3.8619e-04_r8,2.4195e-03_r8,4.7839e-03_r8,7.1249e-03_r8,9.4281e-03_r8,1.1657e-02_r8, & + &1.3699e-02_r8,1.5096e-02_r8,1.8815e-02_r8/) + kao(:, 3, 3,15) = (/ & + &3.7186e-04_r8,3.4615e-03_r8,6.8531e-03_r8,1.0215e-02_r8,1.3514e-02_r8,1.6722e-02_r8, & + &1.9664e-02_r8,2.1688e-02_r8,2.6981e-02_r8/) + kao(:, 4, 3,15) = (/ & + &3.4136e-04_r8,4.7556e-03_r8,9.4307e-03_r8,1.4062e-02_r8,1.8619e-02_r8,2.3030e-02_r8, & + &2.7098e-02_r8,2.9910e-02_r8,3.7185e-02_r8/) + kao(:, 5, 3,15) = (/ & + &2.7238e-04_r8,6.3154e-03_r8,1.2533e-02_r8,1.8695e-02_r8,2.4762e-02_r8,3.0640e-02_r8, & + &3.6060e-02_r8,3.9831e-02_r8,4.9464e-02_r8/) + kao(:, 1, 4,15) = (/ & + &1.8439e-03_r8,1.6255e-03_r8,2.7662e-03_r8,4.1011e-03_r8,5.4250e-03_r8,6.7307e-03_r8, & + &7.9903e-03_r8,9.0701e-03_r8,1.0766e-02_r8/) + kao(:, 2, 4,15) = (/ & + &1.2780e-03_r8,2.0382e-03_r8,4.2819e-03_r8,6.3618e-03_r8,8.4274e-03_r8,1.0464e-02_r8, & + &1.2431e-02_r8,1.4123e-02_r8,1.6753e-02_r8/) + kao(:, 3, 4,15) = (/ & + &1.0129e-03_r8,3.1935e-03_r8,6.2902e-03_r8,9.3615e-03_r8,1.2411e-02_r8,1.5417e-02_r8, & + &1.8325e-02_r8,2.0828e-02_r8,2.4703e-02_r8/) + kao(:, 4, 4,15) = (/ & + &9.5662e-04_r8,4.4942e-03_r8,8.8414e-03_r8,1.3166e-02_r8,1.7466e-02_r8,2.1716e-02_r8, & + &2.5826e-02_r8,2.9379e-02_r8,3.4795e-02_r8/) + kao(:, 5, 4,15) = (/ & + &7.9817e-04_r8,6.0664e-03_r8,1.1965e-02_r8,1.7841e-02_r8,2.3679e-02_r8,2.9437e-02_r8, & + &3.5012e-02_r8,3.9861e-02_r8,4.7202e-02_r8/) + kao(:, 1, 5,15) = (/ & + &5.1399e-03_r8,4.4963e-03_r8,3.8550e-03_r8,3.7300e-03_r8,4.5601e-03_r8,5.6445e-03_r8, & + &6.7084e-03_r8,7.7027e-03_r8,8.9288e-03_r8/) + kao(:, 2, 5,15) = (/ & + &4.9517e-03_r8,4.3316e-03_r8,4.1416e-03_r8,5.5566e-03_r8,7.3222e-03_r8,9.0762e-03_r8, & + &1.0805e-02_r8,1.2425e-02_r8,1.4409e-02_r8/) + kao(:, 3, 5,15) = (/ & + &3.6157e-03_r8,3.1633e-03_r8,5.3630e-03_r8,8.3885e-03_r8,1.1080e-02_r8,1.3756e-02_r8, & + &1.6391e-02_r8,1.8868e-02_r8,2.1878e-02_r8/) + kao(:, 4, 5,15) = (/ & + &2.5485e-03_r8,3.2448e-03_r8,8.0168e-03_r8,1.2065e-02_r8,1.5959e-02_r8,1.9835e-02_r8, & + &2.3656e-02_r8,2.7245e-02_r8,3.1588e-02_r8/) + kao(:, 5, 5,15) = (/ & + &2.2002e-03_r8,3.7004e-03_r8,1.1229e-02_r8,1.6648e-02_r8,2.2051e-02_r8,2.7414e-02_r8, & + &3.2714e-02_r8,3.7713e-02_r8,4.3725e-02_r8/) + kao(:, 1, 6,15) = (/ & + &1.3785e-02_r8,1.2061e-02_r8,1.0339e-02_r8,8.6158e-03_r8,6.8942e-03_r8,5.5266e-03_r8, & + &5.3843e-03_r8,6.1361e-03_r8,7.0081e-03_r8/) + kao(:, 2, 6,15) = (/ & + &1.3401e-02_r8,1.1726e-02_r8,1.0052e-02_r8,8.3774e-03_r8,7.3256e-03_r8,7.6626e-03_r8, & + &8.9483e-03_r8,1.0302e-02_r8,1.1787e-02_r8/) + kao(:, 3, 6,15) = (/ & + &1.3001e-02_r8,1.1375e-02_r8,9.7516e-03_r8,8.8385e-03_r8,9.7753e-03_r8,1.1803e-02_r8, & + &1.4015e-02_r8,1.6165e-02_r8,1.8521e-02_r8/) + kao(:, 4, 6,15) = (/ & + &1.0311e-02_r8,9.0242e-03_r8,7.7593e-03_r8,9.8758e-03_r8,1.4142e-02_r8,1.7458e-02_r8, & + &2.0764e-02_r8,2.3987e-02_r8,2.7500e-02_r8/) + kao(:, 5, 6,15) = (/ & + &6.1007e-03_r8,5.3334e-03_r8,8.4379e-03_r8,1.3947e-02_r8,1.9967e-02_r8,2.4665e-02_r8, & + &2.9359e-02_r8,3.3960e-02_r8,3.8947e-02_r8/) + kao(:, 1, 7,15) = (/ & + &3.9607e-02_r8,3.4655e-02_r8,2.9704e-02_r8,2.4754e-02_r8,1.9804e-02_r8,1.4853e-02_r8, & + &9.9024e-03_r8,5.6087e-03_r8,4.7437e-03_r8/) + kao(:, 2, 7,15) = (/ & + &3.8786e-02_r8,3.3939e-02_r8,2.9089e-02_r8,2.4244e-02_r8,1.9395e-02_r8,1.4546e-02_r8, & + &1.0087e-02_r8,8.3483e-03_r8,8.1480e-03_r8/) + kao(:, 3, 7,15) = (/ & + &3.7941e-02_r8,3.3203e-02_r8,2.8458e-02_r8,2.3715e-02_r8,1.8973e-02_r8,1.4624e-02_r8, & + &1.2669e-02_r8,1.3455e-02_r8,1.2971e-02_r8/) + kao(:, 4, 7,15) = (/ & + &3.7052e-02_r8,3.2423e-02_r8,2.7792e-02_r8,2.3160e-02_r8,1.8933e-02_r8,1.7157e-02_r8, & + &1.8083e-02_r8,2.0593e-02_r8,1.9406e-02_r8/) + kao(:, 5, 7,15) = (/ & + &3.1592e-02_r8,2.7646e-02_r8,2.3693e-02_r8,2.0299e-02_r8,1.8491e-02_r8,2.1228e-02_r8, & + &2.6244e-02_r8,2.9985e-02_r8,2.7520e-02_r8/) + kao(:, 1, 8,15) = (/ & + &1.4580e-01_r8,1.2758e-01_r8,1.0936e-01_r8,9.1128e-02_r8,7.2910e-02_r8,5.4675e-02_r8, & + &3.6454e-02_r8,1.8228e-02_r8,7.5823e-04_r8/) + kao(:, 2, 8,15) = (/ & + &1.4341e-01_r8,1.2548e-01_r8,1.0755e-01_r8,8.9631e-02_r8,7.1703e-02_r8,5.3780e-02_r8, & + &3.5854e-02_r8,1.7928e-02_r8,1.3701e-03_r8/) + kao(:, 3, 8,15) = (/ & + &1.4083e-01_r8,1.2323e-01_r8,1.0562e-01_r8,8.8019e-02_r8,7.0413e-02_r8,5.2809e-02_r8, & + &3.5210e-02_r8,1.8039e-02_r8,2.2984e-03_r8/) + kao(:, 4, 8,15) = (/ & + &1.3806e-01_r8,1.2080e-01_r8,1.0354e-01_r8,8.6290e-02_r8,6.9028e-02_r8,5.1771e-02_r8, & + &3.4515e-02_r8,2.0878e-02_r8,3.6182e-03_r8/) + kao(:, 5, 8,15) = (/ & + &1.3508e-01_r8,1.1820e-01_r8,1.0132e-01_r8,8.4431e-02_r8,6.7546e-02_r8,5.0657e-02_r8, & + &3.5330e-02_r8,2.7298e-02_r8,5.3909e-03_r8/) + kao(:, 1, 9,15) = (/ & + &1.0374e+00_r8,9.0767e-01_r8,7.7802e-01_r8,6.4832e-01_r8,5.1864e-01_r8,3.8900e-01_r8, & + &2.5933e-01_r8,1.2966e-01_r8,2.1397e-06_r8/) + kao(:, 2, 9,15) = (/ & + &1.0197e+00_r8,8.9224e-01_r8,7.6478e-01_r8,6.3733e-01_r8,5.0988e-01_r8,3.8239e-01_r8, & + &2.5493e-01_r8,1.2747e-01_r8,3.4826e-06_r8/) + kao(:, 3, 9,15) = (/ & + &1.0031e+00_r8,8.7777e-01_r8,7.5240e-01_r8,6.2700e-01_r8,5.0158e-01_r8,3.7619e-01_r8, & + &2.5081e-01_r8,1.2540e-01_r8,5.6811e-06_r8/) + kao(:, 4, 9,15) = (/ & + &9.8558e-01_r8,8.6233e-01_r8,7.3918e-01_r8,6.1597e-01_r8,4.9277e-01_r8,3.6960e-01_r8, & + &2.4641e-01_r8,1.2320e-01_r8,9.7907e-06_r8/) + kao(:, 5, 9,15) = (/ & + &9.6612e-01_r8,8.4542e-01_r8,7.2465e-01_r8,6.0387e-01_r8,4.8310e-01_r8,3.6231e-01_r8, & + &2.4155e-01_r8,1.2077e-01_r8,1.4737e-05_r8/) + kao(:, 1,10,15) = (/ & + &8.9111e+00_r8,7.7969e+00_r8,6.6836e+00_r8,5.5691e+00_r8,4.4554e+00_r8,3.3414e+00_r8, & + &2.2275e+00_r8,1.1138e+00_r8,1.1507e-06_r8/) + kao(:, 2,10,15) = (/ & + &8.7649e+00_r8,7.6684e+00_r8,6.5728e+00_r8,5.4777e+00_r8,4.3822e+00_r8,3.2866e+00_r8, & + &2.1910e+00_r8,1.0955e+00_r8,1.9584e-06_r8/) + kao(:, 3,10,15) = (/ & + &8.6133e+00_r8,7.5361e+00_r8,6.4598e+00_r8,5.3829e+00_r8,4.3064e+00_r8,3.2299e+00_r8, & + &2.1532e+00_r8,1.0766e+00_r8,3.2367e-06_r8/) + kao(:, 4,10,15) = (/ & + &8.4534e+00_r8,7.3969e+00_r8,6.3406e+00_r8,5.2836e+00_r8,4.2270e+00_r8,3.1701e+00_r8, & + &2.1135e+00_r8,1.0568e+00_r8,5.5316e-06_r8/) + kao(:, 5,10,15) = (/ & + &8.2801e+00_r8,7.2444e+00_r8,6.2095e+00_r8,5.1748e+00_r8,4.1398e+00_r8,3.1049e+00_r8, & + &2.0699e+00_r8,1.0350e+00_r8,8.6177e-06_r8/) + kao(:, 1,11,15) = (/ & + &2.5435e+01_r8,2.2258e+01_r8,1.9079e+01_r8,1.5898e+01_r8,1.2719e+01_r8,9.5392e+00_r8, & + &6.3596e+00_r8,3.1798e+00_r8,8.0677e-07_r8/) + kao(:, 2,11,15) = (/ & + &2.5109e+01_r8,2.1970e+01_r8,1.8832e+01_r8,1.5693e+01_r8,1.2554e+01_r8,9.4153e+00_r8, & + &6.2771e+00_r8,3.1385e+00_r8,1.4119e-06_r8/) + kao(:, 3,11,15) = (/ & + &2.4708e+01_r8,2.1620e+01_r8,1.8532e+01_r8,1.5442e+01_r8,1.2355e+01_r8,9.2660e+00_r8, & + &6.1771e+00_r8,3.0885e+00_r8,2.4283e-06_r8/) + kao(:, 4,11,15) = (/ & + &2.4206e+01_r8,2.1181e+01_r8,1.8155e+01_r8,1.5130e+01_r8,1.2103e+01_r8,9.0784e+00_r8, & + &6.0520e+00_r8,3.0256e+00_r8,3.8467e-06_r8/) + kao(:, 5,11,15) = (/ & + &2.3645e+01_r8,2.0690e+01_r8,1.7735e+01_r8,1.4778e+01_r8,1.1822e+01_r8,8.8671e+00_r8, & + &5.9114e+00_r8,2.9557e+00_r8,6.2945e-06_r8/) + kao(:, 1,12,15) = (/ & + &4.5821e+01_r8,4.0093e+01_r8,3.4365e+01_r8,2.8640e+01_r8,2.2910e+01_r8,1.7183e+01_r8, & + &1.1455e+01_r8,5.7277e+00_r8,5.6905e-07_r8/) + kao(:, 2,12,15) = (/ & + &4.5215e+01_r8,3.9561e+01_r8,3.3912e+01_r8,2.8260e+01_r8,2.2608e+01_r8,1.6955e+01_r8, & + &1.1304e+01_r8,5.6520e+00_r8,1.0466e-06_r8/) + kao(:, 3,12,15) = (/ & + &4.4441e+01_r8,3.8886e+01_r8,3.3332e+01_r8,2.7776e+01_r8,2.2220e+01_r8,1.6665e+01_r8, & + &1.1110e+01_r8,5.5552e+00_r8,1.8066e-06_r8/) + kao(:, 4,12,15) = (/ & + &4.3598e+01_r8,3.8150e+01_r8,3.2698e+01_r8,2.7250e+01_r8,2.1798e+01_r8,1.6350e+01_r8, & + &1.0900e+01_r8,5.4499e+00_r8,2.8751e-06_r8/) + kao(:, 5,12,15) = (/ & + &4.2666e+01_r8,3.7332e+01_r8,3.2000e+01_r8,2.6665e+01_r8,2.1333e+01_r8,1.6001e+01_r8, & + &1.0666e+01_r8,5.3333e+00_r8,4.5303e-06_r8/) + kao(:, 1,13,15) = (/ & + &6.6305e+01_r8,5.8017e+01_r8,4.9731e+01_r8,4.1443e+01_r8,3.3153e+01_r8,2.4866e+01_r8, & + &1.6576e+01_r8,8.2888e+00_r8,6.5868e-07_r8/) + kao(:, 2,13,15) = (/ & + &6.5425e+01_r8,5.7245e+01_r8,4.9068e+01_r8,4.0889e+01_r8,3.2711e+01_r8,2.4534e+01_r8, & + &1.6356e+01_r8,8.1783e+00_r8,1.0770e-06_r8/) + kao(:, 3,13,15) = (/ & + &6.4452e+01_r8,5.6397e+01_r8,4.8336e+01_r8,4.0283e+01_r8,3.2227e+01_r8,2.4169e+01_r8, & + &1.6113e+01_r8,8.0564e+00_r8,1.3521e-06_r8/) + kao(:, 4,13,15) = (/ & + &6.3313e+01_r8,5.5397e+01_r8,4.7486e+01_r8,3.9571e+01_r8,3.1655e+01_r8,2.3741e+01_r8, & + &1.5828e+01_r8,7.9140e+00_r8,2.2152e-06_r8/) + kao(:, 5,13,15) = (/ & + &6.1963e+01_r8,5.4219e+01_r8,4.6473e+01_r8,3.8726e+01_r8,3.0982e+01_r8,2.3236e+01_r8, & + &1.5490e+01_r8,7.7450e+00_r8,3.4066e-06_r8/) + kao(:, 1, 1,16) = (/ & + &8.8773e-05_r8,1.9140e-03_r8,3.7690e-03_r8,5.5469e-03_r8,7.2016e-03_r8,8.6351e-03_r8, & + &9.6093e-03_r8,9.3558e-03_r8,1.4394e-02_r8/) + kao(:, 2, 1,16) = (/ & + &8.4216e-05_r8,2.7660e-03_r8,5.4492e-03_r8,8.0218e-03_r8,1.0416e-02_r8,1.2486e-02_r8, & + &1.3893e-02_r8,1.3527e-02_r8,2.0822e-02_r8/) + kao(:, 3, 1,16) = (/ & + &8.0290e-05_r8,3.8383e-03_r8,7.5630e-03_r8,1.1136e-02_r8,1.4457e-02_r8,1.7334e-02_r8, & + &1.9290e-02_r8,1.8781e-02_r8,2.8902e-02_r8/) + kao(:, 4, 1,16) = (/ & + &7.6611e-05_r8,5.1452e-03_r8,1.0139e-02_r8,1.4930e-02_r8,1.9392e-02_r8,2.3248e-02_r8, & + &2.5870e-02_r8,2.5185e-02_r8,3.8771e-02_r8/) + kao(:, 5, 1,16) = (/ & + &7.3163e-05_r8,6.6935e-03_r8,1.3197e-02_r8,1.9435e-02_r8,2.5235e-02_r8,3.0263e-02_r8, & + &3.3675e-02_r8,3.2771e-02_r8,5.0455e-02_r8/) + kao(:, 1, 2,16) = (/ & + &1.5679e-04_r8,1.9888e-03_r8,3.9277e-03_r8,5.8149e-03_r8,7.6126e-03_r8,9.2475e-03_r8, & + &1.0521e-02_r8,1.0714e-02_r8,1.5210e-02_r8/) + kao(:, 2, 2,16) = (/ & + &1.4773e-04_r8,2.9274e-03_r8,5.7862e-03_r8,8.5677e-03_r8,1.1217e-02_r8,1.3627e-02_r8, & + &1.5504e-02_r8,1.5787e-02_r8,2.2417e-02_r8/) + kao(:, 3, 2,16) = (/ & + &1.4025e-04_r8,4.1262e-03_r8,8.1606e-03_r8,1.2085e-02_r8,1.5823e-02_r8,1.9223e-02_r8, & + &2.1876e-02_r8,2.2273e-02_r8,3.1626e-02_r8/) + kao(:, 4, 2,16) = (/ & + &1.3354e-04_r8,5.6053e-03_r8,1.1089e-02_r8,1.6429e-02_r8,2.1516e-02_r8,2.6138e-02_r8, & + &2.9742e-02_r8,3.0283e-02_r8,4.3010e-02_r8/) + kao(:, 5, 2,16) = (/ & + &1.2725e-04_r8,7.3793e-03_r8,1.4605e-02_r8,2.1632e-02_r8,2.8334e-02_r8,3.4423e-02_r8, & + &3.9175e-02_r8,3.9879e-02_r8,5.6642e-02_r8/) + kao(:, 1, 3,16) = (/ & + &4.1725e-04_r8,1.8982e-03_r8,3.7447e-03_r8,5.5658e-03_r8,7.3458e-03_r8,9.0433e-03_r8, & + &1.0548e-02_r8,1.1397e-02_r8,1.4655e-02_r8/) + kao(:, 2, 3,16) = (/ & + &3.9098e-04_r8,2.8734e-03_r8,5.6787e-03_r8,8.4482e-03_r8,1.1153e-02_r8,1.3733e-02_r8, & + &1.6021e-02_r8,1.7312e-02_r8,2.2262e-02_r8/) + kao(:, 3, 3,16) = (/ & + &3.4851e-04_r8,4.1474e-03_r8,8.2100e-03_r8,1.2218e-02_r8,1.6131e-02_r8,1.9869e-02_r8, & + &2.3184e-02_r8,2.5055e-02_r8,3.2211e-02_r8/) + kao(:, 4, 3,16) = (/ & + &3.3110e-04_r8,5.7507e-03_r8,1.1396e-02_r8,1.6965e-02_r8,2.2409e-02_r8,2.7601e-02_r8, & + &3.2208e-02_r8,3.4575e-02_r8,4.4760e-02_r8/) + kao(:, 5, 3,16) = (/ & + &3.1495e-04_r8,7.7054e-03_r8,1.5281e-02_r8,2.2758e-02_r8,3.0062e-02_r8,3.7025e-02_r8, & + &4.3208e-02_r8,4.6704e-02_r8,6.0059e-02_r8/) + kao(:, 1, 4,16) = (/ & + &1.7281e-03_r8,1.7667e-03_r8,3.4371e-03_r8,5.0959e-03_r8,6.7367e-03_r8,8.3430e-03_r8, & + &9.8600e-03_r8,1.1050e-02_r8,1.3383e-02_r8/) + kao(:, 2, 4,16) = (/ & + &1.1628e-03_r8,2.7537e-03_r8,5.3881e-03_r8,8.0069e-03_r8,1.0596e-02_r8,1.3125e-02_r8, & + &1.5518e-02_r8,1.7399e-02_r8,2.1083e-02_r8/) + kao(:, 3, 4,16) = (/ & + &1.1124e-03_r8,4.0786e-03_r8,8.0137e-03_r8,1.1921e-02_r8,1.5788e-02_r8,1.9566e-02_r8, & + &2.3141e-02_r8,2.5952e-02_r8,3.1447e-02_r8/) + kao(:, 4, 4,16) = (/ & + &1.0810e-03_r8,5.7837e-03_r8,1.1394e-02_r8,1.6970e-02_r8,2.2483e-02_r8,2.7876e-02_r8, & + &3.2974e-02_r8,3.6985e-02_r8,4.4815e-02_r8/) + kao(:, 5, 4,16) = (/ & + &9.9376e-04_r8,7.9012e-03_r8,1.5599e-02_r8,2.3249e-02_r8,3.0813e-02_r8,3.8207e-02_r8, & + &4.5202e-02_r8,5.0705e-02_r8,6.1455e-02_r8/) + kao(:, 1, 5,16) = (/ & + &5.4114e-03_r8,4.7354e-03_r8,4.0587e-03_r8,4.6142e-03_r8,6.0695e-03_r8,7.5080e-03_r8, & + &8.9059e-03_r8,1.0147e-02_r8,1.1928e-02_r8/) + kao(:, 2, 5,16) = (/ & + &5.1867e-03_r8,4.5542e-03_r8,5.0981e-03_r8,7.5059e-03_r8,9.9017e-03_r8,1.2267e-02_r8, & + &1.4567e-02_r8,1.6610e-02_r8,1.9542e-02_r8/) + kao(:, 3, 5,16) = (/ & + &3.0269e-03_r8,2.6488e-03_r8,7.7938e-03_r8,1.1517e-02_r8,1.5221e-02_r8,1.8876e-02_r8, & + &2.2431e-02_r8,2.5594e-02_r8,3.0125e-02_r8/) + kao(:, 4, 5,16) = (/ & + &2.9184e-03_r8,2.5534e-03_r8,1.1353e-02_r8,1.6816e-02_r8,2.2248e-02_r8,2.7623e-02_r8, & + &3.2847e-02_r8,3.7486e-02_r8,4.4122e-02_r8/) + kao(:, 5, 5,16) = (/ & + &2.8186e-03_r8,8.1567e-03_r8,1.5865e-02_r8,2.3545e-02_r8,3.1185e-02_r8,3.8732e-02_r8, & + &4.6076e-02_r8,5.2599e-02_r8,6.1936e-02_r8/) + kao(:, 1, 6,16) = (/ & + &1.4590e-02_r8,1.2765e-02_r8,1.0941e-02_r8,9.1186e-03_r8,7.2947e-03_r8,6.5373e-03_r8, & + &7.7212e-03_r8,8.8306e-03_r8,1.0195e-02_r8/) + kao(:, 2, 6,16) = (/ & + &1.4301e-02_r8,1.2513e-02_r8,1.0724e-02_r8,8.9392e-03_r8,9.0428e-03_r8,1.1132e-02_r8, & + &1.3188e-02_r8,1.5117e-02_r8,1.7482e-02_r8/) + kao(:, 3, 6,16) = (/ & + &1.3976e-02_r8,1.2228e-02_r8,1.0485e-02_r8,1.0970e-02_r8,1.4363e-02_r8,1.7735e-02_r8, & + &2.1052e-02_r8,2.4167e-02_r8,2.7980e-02_r8/) + kao(:, 4, 6,16) = (/ & + &7.5839e-03_r8,6.6346e-03_r8,9.3364e-03_r8,1.6444e-02_r8,2.1598e-02_r8,2.6720e-02_r8, & + &3.1771e-02_r8,3.6510e-02_r8,4.2297e-02_r8/) + kao(:, 5, 6,16) = (/ & + &7.3499e-03_r8,6.4297e-03_r8,1.6063e-02_r8,2.3546e-02_r8,3.1010e-02_r8,3.8427e-02_r8, & + &4.5729e-02_r8,5.2589e-02_r8,6.0961e-02_r8/) + kao(:, 1, 7,16) = (/ & + &4.2002e-02_r8,3.6747e-02_r8,3.1501e-02_r8,2.6251e-02_r8,2.1002e-02_r8,1.5754e-02_r8, & + &1.0500e-02_r8,7.5058e-03_r8,8.4905e-03_r8/) + kao(:, 2, 7,16) = (/ & + &4.1348e-02_r8,3.6182e-02_r8,3.1017e-02_r8,2.5842e-02_r8,2.0675e-02_r8,1.5509e-02_r8, & + &1.1819e-02_r8,1.3466e-02_r8,1.5310e-02_r8/) + kao(:, 3, 7,16) = (/ & + &4.0563e-02_r8,3.5489e-02_r8,3.0424e-02_r8,2.5351e-02_r8,2.0286e-02_r8,1.6643e-02_r8, & + &1.9563e-02_r8,2.2386e-02_r8,2.5539e-02_r8/) + kao(:, 4, 7,16) = (/ & + &3.9401e-02_r8,3.4717e-02_r8,2.9752e-02_r8,2.4793e-02_r8,2.1115e-02_r8,2.5798e-02_r8, & + &3.0449e-02_r8,3.4941e-02_r8,3.9945e-02_r8/) + kao(:, 5, 7,16) = (/ & + &2.0373e-02_r8,1.7827e-02_r8,1.5278e-02_r8,1.2733e-02_r8,3.0987e-02_r8,3.8017e-02_r8, & + &4.4987e-02_r8,5.1736e-02_r8,5.9242e-02_r8/) + kao(:, 1, 8,16) = (/ & + &1.5400e-01_r8,1.3474e-01_r8,1.1553e-01_r8,9.6239e-02_r8,7.7005e-02_r8,5.7761e-02_r8, & + &3.8504e-02_r8,1.9252e-02_r8,6.9298e-03_r8/) + kao(:, 2, 8,16) = (/ & + &1.5231e-01_r8,1.3330e-01_r8,1.1425e-01_r8,9.5219e-02_r8,7.6158e-02_r8,5.7117e-02_r8, & + &3.8082e-02_r8,1.9041e-02_r8,1.3109e-02_r8/) + kao(:, 3, 8,16) = (/ & + &1.4996e-01_r8,1.3122e-01_r8,1.1247e-01_r8,9.3714e-02_r8,7.4984e-02_r8,5.6235e-02_r8, & + &3.7492e-02_r8,2.0794e-02_r8,2.1673e-02_r8/) + kao(:, 4, 8,16) = (/ & + &1.4710e-01_r8,1.2871e-01_r8,1.1034e-01_r8,9.1947e-02_r8,7.3562e-02_r8,5.5161e-02_r8, & + &3.6783e-02_r8,3.3457e-02_r8,3.2749e-02_r8/) + kao(:, 5, 8,16) = (/ & + &1.4389e-01_r8,1.2590e-01_r8,1.0792e-01_r8,8.9927e-02_r8,7.1955e-02_r8,5.3965e-02_r8, & + &4.4963e-02_r8,5.0849e-02_r8,4.4095e-02_r8/) + kao(:, 1, 9,16) = (/ & + &1.0859e+00_r8,9.5014e-01_r8,8.1454e-01_r8,6.7879e-01_r8,5.4303e-01_r8,4.0724e-01_r8, & + &2.7149e-01_r8,1.3574e-01_r8,5.1220e-06_r8/) + kao(:, 2, 9,16) = (/ & + &1.0768e+00_r8,9.4216e-01_r8,8.0759e-01_r8,6.7299e-01_r8,5.3840e-01_r8,4.0381e-01_r8, & + &2.6917e-01_r8,1.3460e-01_r8,1.2021e-05_r8/) + kao(:, 3, 9,16) = (/ & + &1.0636e+00_r8,9.3068e-01_r8,7.9788e-01_r8,6.6477e-01_r8,5.3197e-01_r8,3.9888e-01_r8, & + &2.6599e-01_r8,1.3299e-01_r8,2.0747e-05_r8/) + kao(:, 4, 9,16) = (/ & + &1.0462e+00_r8,9.1536e-01_r8,7.8477e-01_r8,6.5394e-01_r8,5.2317e-01_r8,3.9241e-01_r8, & + &2.6164e-01_r8,1.3081e-01_r8,2.6757e-05_r8/) + kao(:, 5, 9,16) = (/ & + &1.0256e+00_r8,8.9712e-01_r8,7.6891e-01_r8,6.4089e-01_r8,5.1277e-01_r8,3.8454e-01_r8, & + &2.5635e-01_r8,1.2820e-01_r8,3.3237e-05_r8/) + kao(:, 1,10,16) = (/ & + &9.2943e+00_r8,8.1330e+00_r8,6.9713e+00_r8,5.8089e+00_r8,4.6478e+00_r8,3.4621e+00_r8, & + &2.3237e+00_r8,1.1620e+00_r8,2.5199e-06_r8/) + kao(:, 2,10,16) = (/ & + &9.1327e+00_r8,7.9905e+00_r8,6.8491e+00_r8,5.7077e+00_r8,4.5656e+00_r8,3.4245e+00_r8, & + &2.2832e+00_r8,1.1416e+00_r8,6.1820e-06_r8/) + kao(:, 3,10,16) = (/ & + &9.0419e+00_r8,7.9114e+00_r8,6.7812e+00_r8,5.6501e+00_r8,4.5208e+00_r8,3.3897e+00_r8, & + &2.2603e+00_r8,1.1303e+00_r8,1.2253e-05_r8/) + kao(:, 4,10,16) = (/ & + &8.9128e+00_r8,7.7986e+00_r8,6.6845e+00_r8,5.5708e+00_r8,4.4561e+00_r8,3.3428e+00_r8, & + &2.2285e+00_r8,1.1142e+00_r8,1.7974e-05_r8/) + kao(:, 5,10,16) = (/ & + &8.7796e+00_r8,7.6831e+00_r8,6.5851e+00_r8,5.4876e+00_r8,4.3892e+00_r8,3.2921e+00_r8, & + &2.1948e+00_r8,1.0975e+00_r8,2.4232e-05_r8/) + kao(:, 1,11,16) = (/ & + &2.7588e+01_r8,2.4141e+01_r8,2.0693e+01_r8,1.7244e+01_r8,1.3795e+01_r8,1.0345e+01_r8, & + &6.8978e+00_r8,3.4484e+00_r8,2.0595e-06_r8/) + kao(:, 2,11,16) = (/ & + &2.6657e+01_r8,2.3323e+01_r8,1.9991e+01_r8,1.6660e+01_r8,1.3327e+01_r8,9.9952e+00_r8, & + &6.6638e+00_r8,3.3322e+00_r8,4.7312e-06_r8/) + kao(:, 3,11,16) = (/ & + &2.5989e+01_r8,2.2740e+01_r8,1.9493e+01_r8,1.6242e+01_r8,1.2994e+01_r8,9.7462e+00_r8, & + &6.4977e+00_r8,3.2488e+00_r8,8.7718e-06_r8/) + kao(:, 4,11,16) = (/ & + &2.5704e+01_r8,2.2492e+01_r8,1.9279e+01_r8,1.6066e+01_r8,1.2854e+01_r8,9.6403e+00_r8, & + &6.4266e+00_r8,3.2130e+00_r8,1.4050e-05_r8/) + kao(:, 5,11,16) = (/ & + &2.5636e+01_r8,2.2431e+01_r8,1.9229e+01_r8,1.6023e+01_r8,1.2819e+01_r8,9.6138e+00_r8, & + &6.4100e+00_r8,3.2046e+00_r8,1.9441e-05_r8/) + kao(:, 1,12,16) = (/ & + &5.2064e+01_r8,4.5551e+01_r8,3.9046e+01_r8,3.2542e+01_r8,2.6032e+01_r8,1.9524e+01_r8, & + &1.3016e+01_r8,6.5078e+00_r8,1.7091e-06_r8/) + kao(:, 2,12,16) = (/ & + &5.0183e+01_r8,4.3912e+01_r8,3.7638e+01_r8,3.1363e+01_r8,2.5091e+01_r8,1.8819e+01_r8, & + &1.2545e+01_r8,6.2729e+00_r8,3.7298e-06_r8/) + kao(:, 3,12,16) = (/ & + &4.8961e+01_r8,4.2840e+01_r8,3.6719e+01_r8,3.0598e+01_r8,2.4478e+01_r8,1.8358e+01_r8, & + &1.2239e+01_r8,6.1197e+00_r8,6.4267e-06_r8/) + kao(:, 4,12,16) = (/ & + &4.8192e+01_r8,4.2165e+01_r8,3.6143e+01_r8,3.0118e+01_r8,2.4096e+01_r8,1.8071e+01_r8, & + &1.2047e+01_r8,6.0236e+00_r8,1.0438e-05_r8/) + kao(:, 5,12,16) = (/ & + &4.7950e+01_r8,4.1951e+01_r8,3.5955e+01_r8,2.9964e+01_r8,2.3968e+01_r8,1.7977e+01_r8, & + &1.1985e+01_r8,5.9924e+00_r8,1.5532e-05_r8/) + kao(:, 1,13,16) = (/ & + &7.9237e+01_r8,6.9320e+01_r8,5.9418e+01_r8,4.9515e+01_r8,3.9615e+01_r8,2.9712e+01_r8, & + &1.9806e+01_r8,9.9046e+00_r8,1.3997e-06_r8/) + kao(:, 2,13,16) = (/ & + &7.6481e+01_r8,6.6913e+01_r8,5.7358e+01_r8,4.7795e+01_r8,3.8238e+01_r8,2.8679e+01_r8, & + &1.9119e+01_r8,9.5593e+00_r8,2.8864e-06_r8/) + kao(:, 3,13,16) = (/ & + &7.4663e+01_r8,6.5336e+01_r8,5.5998e+01_r8,4.6664e+01_r8,3.7331e+01_r8,2.7999e+01_r8, & + &1.8666e+01_r8,9.3324e+00_r8,4.8512e-06_r8/) + kao(:, 4,13,16) = (/ & + &7.3334e+01_r8,6.4170e+01_r8,5.5002e+01_r8,4.5830e+01_r8,3.6668e+01_r8,2.7499e+01_r8, & + &1.8332e+01_r8,9.1667e+00_r8,7.8505e-06_r8/) + kao(:, 5,13,16) = (/ & + &7.2543e+01_r8,6.3471e+01_r8,5.4398e+01_r8,4.5335e+01_r8,3.6267e+01_r8,2.7201e+01_r8, & + &1.8133e+01_r8,9.0671e+00_r8,1.1235e-05_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &6.2747e-02_r8,8.6102e-02_r8,1.1568e-01_r8,1.5208e-01_r8,1.9535e-01_r8/) + kbo(:,14, 1) = (/ & + &5.7861e-02_r8,7.9151e-02_r8,1.0594e-01_r8,1.3846e-01_r8,1.7643e-01_r8/) + kbo(:,15, 1) = (/ & + &5.3092e-02_r8,7.2482e-02_r8,9.6781e-02_r8,1.2588e-01_r8,1.5918e-01_r8/) + kbo(:,16, 1) = (/ & + &4.8457e-02_r8,6.6047e-02_r8,8.7760e-02_r8,1.1351e-01_r8,1.4288e-01_r8/) + kbo(:,17, 1) = (/ & + &4.3912e-02_r8,5.9676e-02_r8,7.8923e-02_r8,1.0151e-01_r8,1.2709e-01_r8/) + kbo(:,18, 1) = (/ & + &3.9426e-02_r8,5.3365e-02_r8,7.0341e-02_r8,8.9953e-02_r8,1.1230e-01_r8/) + kbo(:,19, 1) = (/ & + &3.5046e-02_r8,4.7312e-02_r8,6.2046e-02_r8,7.9063e-02_r8,9.8334e-02_r8/) + kbo(:,20, 1) = (/ & + &3.1115e-02_r8,4.1839e-02_r8,5.4636e-02_r8,6.9407e-02_r8,8.5975e-02_r8/) + kbo(:,21, 1) = (/ & + &2.7465e-02_r8,3.6785e-02_r8,4.7830e-02_r8,6.0600e-02_r8,7.4770e-02_r8/) + kbo(:,22, 1) = (/ & + &2.4593e-02_r8,3.2747e-02_r8,4.2384e-02_r8,5.3412e-02_r8,6.5545e-02_r8/) + kbo(:,23, 1) = (/ & + &2.1937e-02_r8,2.9046e-02_r8,3.7411e-02_r8,4.6873e-02_r8,5.7167e-02_r8/) + kbo(:,24, 1) = (/ & + &1.9516e-02_r8,2.5711e-02_r8,3.2910e-02_r8,4.0910e-02_r8,4.9576e-02_r8/) + kbo(:,25, 1) = (/ & + &1.7347e-02_r8,2.2706e-02_r8,2.8823e-02_r8,3.5568e-02_r8,4.2803e-02_r8/) + kbo(:,26, 1) = (/ & + &1.5431e-02_r8,2.0022e-02_r8,2.5209e-02_r8,3.0861e-02_r8,3.6863e-02_r8/) + kbo(:,27, 1) = (/ & + &1.3676e-02_r8,1.7588e-02_r8,2.1954e-02_r8,2.6656e-02_r8,3.1628e-02_r8/) + kbo(:,28, 1) = (/ & + &1.2072e-02_r8,1.5389e-02_r8,1.9040e-02_r8,2.2944e-02_r8,2.7092e-02_r8/) + kbo(:,29, 1) = (/ & + &1.0638e-02_r8,1.3440e-02_r8,1.6483e-02_r8,1.9764e-02_r8,2.3215e-02_r8/) + kbo(:,30, 1) = (/ & + &9.3452e-03_r8,1.1695e-02_r8,1.4256e-02_r8,1.7011e-02_r8,1.9889e-02_r8/) + kbo(:,31, 1) = (/ & + &8.1958e-03_r8,1.0179e-02_r8,1.2343e-02_r8,1.4653e-02_r8,1.7063e-02_r8/) + kbo(:,32, 1) = (/ & + &7.1787e-03_r8,8.8627e-03_r8,1.0685e-02_r8,1.2626e-02_r8,1.4630e-02_r8/) + kbo(:,33, 1) = (/ & + &6.2851e-03_r8,7.7078e-03_r8,9.2476e-03_r8,1.0876e-02_r8,1.2551e-02_r8/) + kbo(:,34, 1) = (/ & + &5.4503e-03_r8,6.6513e-03_r8,7.9437e-03_r8,9.3044e-03_r8,1.0718e-02_r8/) + kbo(:,35, 1) = (/ & + &4.6286e-03_r8,5.6362e-03_r8,6.7164e-03_r8,7.8605e-03_r8,9.0307e-03_r8/) + kbo(:,36, 1) = (/ & + &3.8439e-03_r8,4.6777e-03_r8,5.5784e-03_r8,6.5325e-03_r8,7.4907e-03_r8/) + kbo(:,37, 1) = (/ & + &3.0907e-03_r8,3.7733e-03_r8,4.5151e-03_r8,5.2952e-03_r8,6.0875e-03_r8/) + kbo(:,38, 1) = (/ & + &2.4803e-03_r8,3.0385e-03_r8,3.6485e-03_r8,4.2895e-03_r8,4.9493e-03_r8/) + kbo(:,39, 1) = (/ & + &1.9914e-03_r8,2.4489e-03_r8,2.9506e-03_r8,3.4809e-03_r8,4.0250e-03_r8/) + kbo(:,40, 1) = (/ & + &1.5591e-03_r8,1.9289e-03_r8,2.3368e-03_r8,2.7699e-03_r8,3.2181e-03_r8/) + kbo(:,41, 1) = (/ & + &1.2156e-03_r8,1.5132e-03_r8,1.8431e-03_r8,2.1975e-03_r8,2.5662e-03_r8/) + kbo(:,42, 1) = (/ & + &9.4642e-04_r8,1.1860e-03_r8,1.4531e-03_r8,1.7422e-03_r8,2.0436e-03_r8/) + kbo(:,43, 1) = (/ & + &7.2576e-04_r8,9.1670e-04_r8,1.1319e-03_r8,1.3659e-03_r8,1.6136e-03_r8/) + kbo(:,44, 1) = (/ & + &5.5191e-04_r8,7.0339e-04_r8,8.7651e-04_r8,1.0654e-03_r8,1.2677e-03_r8/) + kbo(:,45, 1) = (/ & + &4.1864e-04_r8,5.3928e-04_r8,6.7793e-04_r8,8.3043e-04_r8,9.9568e-04_r8/) + kbo(:,46, 1) = (/ & + &3.1490e-04_r8,4.0992e-04_r8,5.2032e-04_r8,6.4322e-04_r8,7.7812e-04_r8/) + kbo(:,47, 1) = (/ & + &2.3273e-04_r8,3.0659e-04_r8,3.9375e-04_r8,4.9208e-04_r8,6.0088e-04_r8/) + kbo(:,48, 1) = (/ & + &1.7128e-04_r8,2.2854e-04_r8,2.9725e-04_r8,3.7557e-04_r8,4.6327e-04_r8/) + kbo(:,49, 1) = (/ & + &1.2553e-04_r8,1.6987e-04_r8,2.2375e-04_r8,2.8623e-04_r8,3.5677e-04_r8/) + kbo(:,50, 1) = (/ & + &9.2117e-05_r8,1.2634e-04_r8,1.6842e-04_r8,2.1802e-04_r8,2.7404e-04_r8/) + kbo(:,51, 1) = (/ & + &6.7482e-05_r8,9.3783e-05_r8,1.2646e-04_r8,1.6541e-04_r8,2.1004e-04_r8/) + kbo(:,52, 1) = (/ & + &4.9294e-05_r8,6.9377e-05_r8,9.4622e-05_r8,1.2516e-04_r8,1.6083e-04_r8/) + kbo(:,53, 1) = (/ & + &3.5898e-05_r8,5.1131e-05_r8,7.0555e-05_r8,9.4518e-05_r8,1.2315e-04_r8/) + kbo(:,54, 1) = (/ & + &2.6237e-05_r8,3.7710e-05_r8,5.2593e-05_r8,7.1209e-05_r8,9.3663e-05_r8/) + kbo(:,55, 1) = (/ & + &1.9162e-05_r8,2.7753e-05_r8,3.9112e-05_r8,5.3467e-05_r8,7.0840e-05_r8/) + kbo(:,56, 1) = (/ & + &1.3954e-05_r8,2.0386e-05_r8,2.8986e-05_r8,3.9982e-05_r8,5.3468e-05_r8/) + kbo(:,57, 1) = (/ & + &1.0137e-05_r8,1.4950e-05_r8,2.1433e-05_r8,2.9844e-05_r8,4.0285e-05_r8/) + kbo(:,58, 1) = (/ & + &7.3955e-06_r8,1.0988e-05_r8,1.5849e-05_r8,2.2304e-05_r8,3.0355e-05_r8/) + kbo(:,59, 1) = (/ & + &5.7756e-06_r8,8.5841e-06_r8,1.2417e-05_r8,1.7454e-05_r8,2.3825e-05_r8/) + kbo(:,13, 2) = (/ & + &2.8941e-01_r8,3.7928e-01_r8,4.8728e-01_r8,6.1356e-01_r8,7.5720e-01_r8/) + kbo(:,14, 2) = (/ & + &2.7482e-01_r8,3.5907e-01_r8,4.5923e-01_r8,5.7444e-01_r8,7.0479e-01_r8/) + kbo(:,15, 2) = (/ & + &2.6012e-01_r8,3.3844e-01_r8,4.3050e-01_r8,5.3565e-01_r8,6.5360e-01_r8/) + kbo(:,16, 2) = (/ & + &2.4469e-01_r8,3.1749e-01_r8,4.0174e-01_r8,4.9749e-01_r8,6.0352e-01_r8/) + kbo(:,17, 2) = (/ & + &2.2805e-01_r8,2.9482e-01_r8,3.7163e-01_r8,4.5800e-01_r8,5.5300e-01_r8/) + kbo(:,18, 2) = (/ & + &2.1066e-01_r8,2.7121e-01_r8,3.4050e-01_r8,4.1816e-01_r8,5.0173e-01_r8/) + kbo(:,19, 2) = (/ & + &1.9258e-01_r8,2.4696e-01_r8,3.0899e-01_r8,3.7763e-01_r8,4.5019e-01_r8/) + kbo(:,20, 2) = (/ & + &1.7535e-01_r8,2.2386e-01_r8,2.7870e-01_r8,3.3833e-01_r8,4.0121e-01_r8/) + kbo(:,21, 2) = (/ & + &1.5823e-01_r8,2.0117e-01_r8,2.4903e-01_r8,3.0059e-01_r8,3.5459e-01_r8/) + kbo(:,22, 2) = (/ & + &1.4393e-01_r8,1.8176e-01_r8,2.2349e-01_r8,2.6801e-01_r8,3.1434e-01_r8/) + kbo(:,23, 2) = (/ & + &1.2993e-01_r8,1.6307e-01_r8,1.9923e-01_r8,2.3752e-01_r8,2.7733e-01_r8/) + kbo(:,24, 2) = (/ & + &1.1668e-01_r8,1.4559e-01_r8,1.7680e-01_r8,2.0966e-01_r8,2.4384e-01_r8/) + kbo(:,25, 2) = (/ & + &1.0441e-01_r8,1.2946e-01_r8,1.5637e-01_r8,1.8462e-01_r8,2.1368e-01_r8/) + kbo(:,26, 2) = (/ & + &9.3354e-02_r8,1.1505e-01_r8,1.3816e-01_r8,1.6244e-01_r8,1.8706e-01_r8/) + kbo(:,27, 2) = (/ & + &8.3171e-02_r8,1.0190e-01_r8,1.2182e-01_r8,1.4246e-01_r8,1.6301e-01_r8/) + kbo(:,28, 2) = (/ & + &7.3897e-02_r8,9.0049e-02_r8,1.0712e-01_r8,1.2442e-01_r8,1.4130e-01_r8/) + kbo(:,29, 2) = (/ & + &6.5628e-02_r8,7.9501e-02_r8,9.3908e-02_r8,1.0826e-01_r8,1.2190e-01_r8/) + kbo(:,30, 2) = (/ & + &5.8144e-02_r8,6.9960e-02_r8,8.1950e-02_r8,9.3660e-02_r8,1.0454e-01_r8/) + kbo(:,31, 2) = (/ & + &5.1413e-02_r8,6.1336e-02_r8,7.1221e-02_r8,8.0615e-02_r8,8.9347e-02_r8/) + kbo(:,32, 2) = (/ & + &4.5308e-02_r8,5.3538e-02_r8,6.1586e-02_r8,6.9140e-02_r8,7.6180e-02_r8/) + kbo(:,33, 2) = (/ & + &3.9776e-02_r8,4.6552e-02_r8,5.3085e-02_r8,5.9155e-02_r8,6.4885e-02_r8/) + kbo(:,34, 2) = (/ & + &3.4566e-02_r8,4.0142e-02_r8,4.5387e-02_r8,5.0362e-02_r8,5.5085e-02_r8/) + kbo(:,35, 2) = (/ & + &2.9501e-02_r8,3.4063e-02_r8,3.8371e-02_r8,4.2482e-02_r8,4.6355e-02_r8/) + kbo(:,36, 2) = (/ & + &2.4731e-02_r8,2.8480e-02_r8,3.2042e-02_r8,3.5445e-02_r8,3.8685e-02_r8/) + kbo(:,37, 2) = (/ & + &2.0227e-02_r8,2.3337e-02_r8,2.6311e-02_r8,2.9150e-02_r8,3.1875e-02_r8/) + kbo(:,38, 2) = (/ & + &1.6522e-02_r8,1.9118e-02_r8,2.1594e-02_r8,2.3970e-02_r8,2.6280e-02_r8/) + kbo(:,39, 2) = (/ & + &1.3506e-02_r8,1.5663e-02_r8,1.7734e-02_r8,1.9723e-02_r8,2.1666e-02_r8/) + kbo(:,40, 2) = (/ & + &1.0839e-02_r8,1.2642e-02_r8,1.4374e-02_r8,1.6039e-02_r8,1.7665e-02_r8/) + kbo(:,41, 2) = (/ & + &8.6687e-03_r8,1.0169e-02_r8,1.1614e-02_r8,1.3014e-02_r8,1.4376e-02_r8/) + kbo(:,42, 2) = (/ & + &6.9249e-03_r8,8.1709e-03_r8,9.3824e-03_r8,1.0556e-02_r8,1.1694e-02_r8/) + kbo(:,43, 2) = (/ & + &5.4677e-03_r8,6.5006e-03_r8,7.5154e-03_r8,8.4985e-03_r8,9.4530e-03_r8/) + kbo(:,44, 2) = (/ & + &4.2855e-03_r8,5.1437e-03_r8,5.9926e-03_r8,6.8145e-03_r8,7.6201e-03_r8/) + kbo(:,45, 2) = (/ & + &3.3515e-03_r8,4.0607e-03_r8,4.7699e-03_r8,5.4599e-03_r8,6.1332e-03_r8/) + kbo(:,46, 2) = (/ & + &2.6019e-03_r8,3.1870e-03_r8,3.7777e-03_r8,4.3556e-03_r8,4.9205e-03_r8/) + kbo(:,47, 2) = (/ & + &1.9902e-03_r8,2.4722e-03_r8,2.9627e-03_r8,3.4486e-03_r8,3.9210e-03_r8/) + kbo(:,48, 2) = (/ & + &1.5153e-03_r8,1.9102e-03_r8,2.3171e-03_r8,2.7244e-03_r8,3.1206e-03_r8/) + kbo(:,49, 2) = (/ & + &1.1469e-03_r8,1.4720e-03_r8,1.8085e-03_r8,2.1494e-03_r8,2.4830e-03_r8/) + kbo(:,50, 2) = (/ & + &8.6648e-04_r8,1.1333e-03_r8,1.4108e-03_r8,1.6953e-03_r8,1.9769e-03_r8/) + kbo(:,51, 2) = (/ & + &6.5125e-04_r8,8.6980e-04_r8,1.0984e-03_r8,1.3342e-03_r8,1.5715e-03_r8/) + kbo(:,52, 2) = (/ & + &4.8660e-04_r8,6.6498e-04_r8,8.5250e-04_r8,1.0475e-03_r8,1.2461e-03_r8/) + kbo(:,53, 2) = (/ & + &3.6091e-04_r8,5.0560e-04_r8,6.5947e-04_r8,8.2040e-04_r8,9.8603e-04_r8/) + kbo(:,54, 2) = (/ & + &2.6798e-04_r8,3.8317e-04_r8,5.0899e-04_r8,6.4130e-04_r8,7.7856e-04_r8/) + kbo(:,55, 2) = (/ & + &1.9837e-04_r8,2.8906e-04_r8,3.9148e-04_r8,4.9955e-04_r8,6.1247e-04_r8/) + kbo(:,56, 2) = (/ & + &1.4613e-04_r8,2.1685e-04_r8,3.0004e-04_r8,3.8773e-04_r8,4.8096e-04_r8/) + kbo(:,57, 2) = (/ & + &1.0691e-04_r8,1.6173e-04_r8,2.2873e-04_r8,3.0001e-04_r8,3.7637e-04_r8/) + kbo(:,58, 2) = (/ & + &7.8236e-05_r8,1.2069e-04_r8,1.7421e-04_r8,2.3200e-04_r8,2.9412e-04_r8/) + kbo(:,59, 2) = (/ & + &6.1826e-05_r8,9.5990e-05_r8,1.3927e-04_r8,1.8625e-04_r8,2.3654e-04_r8/) + kbo(:,13, 3) = (/ & + &1.1135e+00_r8,1.3641e+00_r8,1.6160e+00_r8,1.8652e+00_r8,2.1134e+00_r8/) + kbo(:,14, 3) = (/ & + &1.0304e+00_r8,1.2521e+00_r8,1.4746e+00_r8,1.6946e+00_r8,1.9141e+00_r8/) + kbo(:,15, 3) = (/ & + &9.5384e-01_r8,1.1492e+00_r8,1.3443e+00_r8,1.5379e+00_r8,1.7345e+00_r8/) + kbo(:,16, 3) = (/ & + &8.8007e-01_r8,1.0512e+00_r8,1.2220e+00_r8,1.3952e+00_r8,1.5691e+00_r8/) + kbo(:,17, 3) = (/ & + &8.0715e-01_r8,9.5537e-01_r8,1.1063e+00_r8,1.2596e+00_r8,1.4122e+00_r8/) + kbo(:,18, 3) = (/ & + &7.3500e-01_r8,8.6436e-01_r8,9.9708e-01_r8,1.1308e+00_r8,1.2638e+00_r8/) + kbo(:,19, 3) = (/ & + &6.6442e-01_r8,7.7800e-01_r8,8.9341e-01_r8,1.0094e+00_r8,1.1240e+00_r8/) + kbo(:,20, 3) = (/ & + &5.9870e-01_r8,6.9782e-01_r8,7.9815e-01_r8,8.9858e-01_r8,9.9720e-01_r8/) + kbo(:,21, 3) = (/ & + &5.3577e-01_r8,6.2165e-01_r8,7.0893e-01_r8,7.9562e-01_r8,8.8013e-01_r8/) + kbo(:,22, 3) = (/ & + &4.8056e-01_r8,5.5531e-01_r8,6.3060e-01_r8,7.0436e-01_r8,7.7687e-01_r8/) + kbo(:,23, 3) = (/ & + &4.2855e-01_r8,4.9296e-01_r8,5.5690e-01_r8,6.1984e-01_r8,6.8212e-01_r8/) + kbo(:,24, 3) = (/ & + &3.8024e-01_r8,4.3497e-01_r8,4.8911e-01_r8,5.4325e-01_r8,5.9676e-01_r8/) + kbo(:,25, 3) = (/ & + &3.3570e-01_r8,3.8197e-01_r8,4.2813e-01_r8,4.7450e-01_r8,5.2085e-01_r8/) + kbo(:,26, 3) = (/ & + &2.9535e-01_r8,3.3462e-01_r8,3.7428e-01_r8,4.1425e-01_r8,4.5431e-01_r8/) + kbo(:,27, 3) = (/ & + &2.5873e-01_r8,2.9239e-01_r8,3.2655e-01_r8,3.6110e-01_r8,3.9601e-01_r8/) + kbo(:,28, 3) = (/ & + &2.2605e-01_r8,2.5498e-01_r8,2.8445e-01_r8,3.1460e-01_r8,3.4506e-01_r8/) + kbo(:,29, 3) = (/ & + &1.9728e-01_r8,2.2221e-01_r8,2.4794e-01_r8,2.7429e-01_r8,3.0081e-01_r8/) + kbo(:,30, 3) = (/ & + &1.7195e-01_r8,1.9369e-01_r8,2.1631e-01_r8,2.3929e-01_r8,2.6198e-01_r8/) + kbo(:,31, 3) = (/ & + &1.5004e-01_r8,1.6915e-01_r8,1.8896e-01_r8,2.0886e-01_r8,2.2799e-01_r8/) + kbo(:,32, 3) = (/ & + &1.3116e-01_r8,1.4802e-01_r8,1.6521e-01_r8,1.8200e-01_r8,1.9806e-01_r8/) + kbo(:,33, 3) = (/ & + &1.1493e-01_r8,1.2958e-01_r8,1.4418e-01_r8,1.5826e-01_r8,1.7170e-01_r8/) + kbo(:,34, 3) = (/ & + &1.0026e-01_r8,1.1281e-01_r8,1.2510e-01_r8,1.3692e-01_r8,1.4804e-01_r8/) + kbo(:,35, 3) = (/ & + &8.6407e-02_r8,9.7015e-02_r8,1.0743e-01_r8,1.1729e-01_r8,1.2663e-01_r8/) + kbo(:,36, 3) = (/ & + &7.3396e-02_r8,8.2443e-02_r8,9.1165e-02_r8,9.9519e-02_r8,1.0753e-01_r8/) + kbo(:,37, 3) = (/ & + &6.1173e-02_r8,6.8860e-02_r8,7.6255e-02_r8,8.3361e-02_r8,9.0284e-02_r8/) + kbo(:,38, 3) = (/ & + &5.0910e-02_r8,5.7435e-02_r8,6.3715e-02_r8,6.9817e-02_r8,7.5733e-02_r8/) + kbo(:,39, 3) = (/ & + &4.2376e-02_r8,4.7913e-02_r8,5.3247e-02_r8,5.8502e-02_r8,6.3619e-02_r8/) + kbo(:,40, 3) = (/ & + &3.4748e-02_r8,3.9459e-02_r8,4.3993e-02_r8,4.8510e-02_r8,5.2956e-02_r8/) + kbo(:,41, 3) = (/ & + &2.8418e-02_r8,3.2417e-02_r8,3.6282e-02_r8,4.0161e-02_r8,4.3993e-02_r8/) + kbo(:,42, 3) = (/ & + &2.3210e-02_r8,2.6614e-02_r8,2.9916e-02_r8,3.3242e-02_r8,3.6540e-02_r8/) + kbo(:,43, 3) = (/ & + &1.8779e-02_r8,2.1673e-02_r8,2.4493e-02_r8,2.7336e-02_r8,3.0182e-02_r8/) + kbo(:,44, 3) = (/ & + &1.5102e-02_r8,1.7567e-02_r8,1.9972e-02_r8,2.2410e-02_r8,2.4858e-02_r8/) + kbo(:,45, 3) = (/ & + &1.2119e-02_r8,1.4212e-02_r8,1.6271e-02_r8,1.8344e-02_r8,2.0451e-02_r8/) + kbo(:,46, 3) = (/ & + &9.6639e-03_r8,1.1430e-02_r8,1.3190e-02_r8,1.4958e-02_r8,1.6759e-02_r8/) + kbo(:,47, 3) = (/ & + &7.6185e-03_r8,9.1001e-03_r8,1.0599e-02_r8,1.2098e-02_r8,1.3639e-02_r8/) + kbo(:,48, 3) = (/ & + &5.9842e-03_r8,7.2206e-03_r8,8.5005e-03_r8,9.7716e-03_r8,1.1086e-02_r8/) + kbo(:,49, 3) = (/ & + &4.6860e-03_r8,5.7121e-03_r8,6.7999e-03_r8,7.8773e-03_r8,8.9943e-03_r8/) + kbo(:,50, 3) = (/ & + &3.6738e-03_r8,4.5201e-03_r8,5.4386e-03_r8,6.3525e-03_r8,7.2951e-03_r8/) + kbo(:,51, 3) = (/ & + &2.8749e-03_r8,3.5695e-03_r8,4.3389e-03_r8,5.1158e-03_r8,5.9116e-03_r8/) + kbo(:,52, 3) = (/ & + &2.2412e-03_r8,2.8111e-03_r8,3.4548e-03_r8,4.1149e-03_r8,4.7853e-03_r8/) + kbo(:,53, 3) = (/ & + &1.7396e-03_r8,2.2062e-03_r8,2.7406e-03_r8,3.3024e-03_r8,3.8694e-03_r8/) + kbo(:,54, 3) = (/ & + &1.3505e-03_r8,1.7325e-03_r8,2.1715e-03_r8,2.6457e-03_r8,3.1233e-03_r8/) + kbo(:,55, 3) = (/ & + &1.0458e-03_r8,1.3574e-03_r8,1.7165e-03_r8,2.1138e-03_r8,2.5149e-03_r8/) + kbo(:,56, 3) = (/ & + &8.0583e-04_r8,1.0599e-03_r8,1.3530e-03_r8,1.6840e-03_r8,2.0192e-03_r8/) + kbo(:,57, 3) = (/ & + &6.1766e-04_r8,8.2479e-04_r8,1.0628e-03_r8,1.3371e-03_r8,1.6185e-03_r8/) + kbo(:,58, 3) = (/ & + &4.7327e-04_r8,6.4160e-04_r8,8.3562e-04_r8,1.0608e-03_r8,1.2972e-03_r8/) + kbo(:,59, 3) = (/ & + &3.8292e-04_r8,5.2222e-04_r8,6.8284e-04_r8,8.6897e-04_r8,1.0664e-03_r8/) + kbo(:,13, 4) = (/ & + &3.3749e+00_r8,3.6005e+00_r8,3.8557e+00_r8,4.1032e+00_r8,4.3385e+00_r8/) + kbo(:,14, 4) = (/ & + &2.9858e+00_r8,3.1916e+00_r8,3.4148e+00_r8,3.6458e+00_r8,3.8704e+00_r8/) + kbo(:,15, 4) = (/ & + &2.6360e+00_r8,2.8231e+00_r8,3.0273e+00_r8,3.2443e+00_r8,3.4520e+00_r8/) + kbo(:,16, 4) = (/ & + &2.3243e+00_r8,2.4974e+00_r8,2.6921e+00_r8,2.8866e+00_r8,3.0804e+00_r8/) + kbo(:,17, 4) = (/ & + &2.0501e+00_r8,2.2124e+00_r8,2.3895e+00_r8,2.5647e+00_r8,2.7458e+00_r8/) + kbo(:,18, 4) = (/ & + &1.8079e+00_r8,1.9578e+00_r8,2.1149e+00_r8,2.2757e+00_r8,2.4444e+00_r8/) + kbo(:,19, 4) = (/ & + &1.5916e+00_r8,1.7262e+00_r8,1.8683e+00_r8,2.0160e+00_r8,2.1705e+00_r8/) + kbo(:,20, 4) = (/ & + &1.3988e+00_r8,1.5220e+00_r8,1.6508e+00_r8,1.7854e+00_r8,1.9234e+00_r8/) + kbo(:,21, 4) = (/ & + &1.2283e+00_r8,1.3399e+00_r8,1.4559e+00_r8,1.5766e+00_r8,1.6985e+00_r8/) + kbo(:,22, 4) = (/ & + &1.0842e+00_r8,1.1844e+00_r8,1.2884e+00_r8,1.3958e+00_r8,1.5035e+00_r8/) + kbo(:,23, 4) = (/ & + &9.5535e-01_r8,1.0448e+00_r8,1.1388e+00_r8,1.2338e+00_r8,1.3273e+00_r8/) + kbo(:,24, 4) = (/ & + &8.3937e-01_r8,9.2038e-01_r8,1.0041e+00_r8,1.0871e+00_r8,1.1675e+00_r8/) + kbo(:,25, 4) = (/ & + &7.3697e-01_r8,8.0962e-01_r8,8.8296e-01_r8,9.5450e-01_r8,1.0251e+00_r8/) + kbo(:,26, 4) = (/ & + &6.4730e-01_r8,7.1109e-01_r8,7.7450e-01_r8,8.3674e-01_r8,9.0032e-01_r8/) + kbo(:,27, 4) = (/ & + &5.6756e-01_r8,6.2293e-01_r8,6.7780e-01_r8,7.3355e-01_r8,7.9083e-01_r8/) + kbo(:,28, 4) = (/ & + &4.9666e-01_r8,5.4463e-01_r8,5.9308e-01_r8,6.4333e-01_r8,6.9525e-01_r8/) + kbo(:,29, 4) = (/ & + &4.3427e-01_r8,4.7629e-01_r8,5.1987e-01_r8,5.6530e-01_r8,6.1288e-01_r8/) + kbo(:,30, 4) = (/ & + &3.7957e-01_r8,4.1709e-01_r8,4.5651e-01_r8,4.9797e-01_r8,5.4181e-01_r8/) + kbo(:,31, 4) = (/ & + &3.3226e-01_r8,3.6617e-01_r8,4.0201e-01_r8,4.4025e-01_r8,4.8083e-01_r8/) + kbo(:,32, 4) = (/ & + &2.9152e-01_r8,3.2232e-01_r8,3.5534e-01_r8,3.9102e-01_r8,4.2785e-01_r8/) + kbo(:,33, 4) = (/ & + &2.5658e-01_r8,2.8478e-01_r8,3.1566e-01_r8,3.4846e-01_r8,3.8205e-01_r8/) + kbo(:,34, 4) = (/ & + &2.2568e-01_r8,2.5200e-01_r8,2.8059e-01_r8,3.1045e-01_r8,3.4133e-01_r8/) + kbo(:,35, 4) = (/ & + &1.9721e-01_r8,2.2158e-01_r8,2.4755e-01_r8,2.7492e-01_r8,3.0313e-01_r8/) + kbo(:,36, 4) = (/ & + &1.7069e-01_r8,1.9278e-01_r8,2.1640e-01_r8,2.4134e-01_r8,2.6698e-01_r8/) + kbo(:,37, 4) = (/ & + &1.4514e-01_r8,1.6486e-01_r8,1.8617e-01_r8,2.0876e-01_r8,2.3216e-01_r8/) + kbo(:,38, 4) = (/ & + &1.2328e-01_r8,1.4085e-01_r8,1.6011e-01_r8,1.8057e-01_r8,2.0182e-01_r8/) + kbo(:,39, 4) = (/ & + &1.0472e-01_r8,1.2042e-01_r8,1.3775e-01_r8,1.5631e-01_r8,1.7570e-01_r8/) + kbo(:,40, 4) = (/ & + &8.7593e-02_r8,1.0140e-01_r8,1.1682e-01_r8,1.3356e-01_r8,1.5106e-01_r8/) + kbo(:,41, 4) = (/ & + &7.2991e-02_r8,8.5111e-02_r8,9.8743e-02_r8,1.1375e-01_r8,1.2963e-01_r8/) + kbo(:,42, 4) = (/ & + &6.0719e-02_r8,7.1311e-02_r8,8.3382e-02_r8,9.6810e-02_r8,1.1115e-01_r8/) + kbo(:,43, 4) = (/ & + &4.9944e-02_r8,5.9103e-02_r8,6.9670e-02_r8,8.1603e-02_r8,9.4469e-02_r8/) + kbo(:,44, 4) = (/ & + &4.0785e-02_r8,4.8637e-02_r8,5.7853e-02_r8,6.8379e-02_r8,7.9912e-02_r8/) + kbo(:,45, 4) = (/ & + &3.3215e-02_r8,3.9939e-02_r8,4.7926e-02_r8,5.7208e-02_r8,6.7537e-02_r8/) + kbo(:,46, 4) = (/ & + &2.6843e-02_r8,3.2560e-02_r8,3.9436e-02_r8,4.7558e-02_r8,5.6745e-02_r8/) + kbo(:,47, 4) = (/ & + &2.1428e-02_r8,2.6226e-02_r8,3.2052e-02_r8,3.9057e-02_r8,4.7184e-02_r8/) + kbo(:,48, 4) = (/ & + &1.7029e-02_r8,2.1031e-02_r8,2.5943e-02_r8,3.1986e-02_r8,3.9099e-02_r8/) + kbo(:,49, 4) = (/ & + &1.3477e-02_r8,1.6802e-02_r8,2.0926e-02_r8,2.6109e-02_r8,3.2294e-02_r8/) + kbo(:,50, 4) = (/ & + &1.0673e-02_r8,1.3423e-02_r8,1.6872e-02_r8,2.1279e-02_r8,2.6629e-02_r8/) + kbo(:,51, 4) = (/ & + &8.4370e-03_r8,1.0700e-02_r8,1.3568e-02_r8,1.7289e-02_r8,2.1889e-02_r8/) + kbo(:,52, 4) = (/ & + &6.6453e-03_r8,8.4949e-03_r8,1.0870e-02_r8,1.3987e-02_r8,1.7931e-02_r8/) + kbo(:,53, 4) = (/ & + &5.2146e-03_r8,6.7176e-03_r8,8.6804e-03_r8,1.1275e-02_r8,1.4637e-02_r8/) + kbo(:,54, 4) = (/ & + &4.1029e-03_r8,5.3246e-03_r8,6.9354e-03_r8,9.0873e-03_r8,1.1925e-02_r8/) + kbo(:,55, 4) = (/ & + &3.2267e-03_r8,4.2135e-03_r8,5.5289e-03_r8,7.2992e-03_r8,9.6811e-03_r8/) + kbo(:,56, 4) = (/ & + &2.5269e-03_r8,3.3219e-03_r8,4.3912e-03_r8,5.8434e-03_r8,7.8299e-03_r8/) + kbo(:,57, 4) = (/ & + &1.9715e-03_r8,2.6095e-03_r8,3.4757e-03_r8,4.6583e-03_r8,6.3020e-03_r8/) + kbo(:,58, 4) = (/ & + &1.5393e-03_r8,2.0522e-03_r8,2.7523e-03_r8,3.7145e-03_r8,5.0709e-03_r8/) + kbo(:,59, 4) = (/ & + &1.2601e-03_r8,1.6926e-03_r8,2.2864e-03_r8,3.1046e-03_r8,4.2734e-03_r8/) + kbo(:,13, 5) = (/ & + &6.9559e+00_r8,7.1944e+00_r8,7.3778e+00_r8,7.6168e+00_r8,7.8840e+00_r8/) + kbo(:,14, 5) = (/ & + &6.1197e+00_r8,6.3419e+00_r8,6.5357e+00_r8,6.7535e+00_r8,7.0053e+00_r8/) + kbo(:,15, 5) = (/ & + &5.3579e+00_r8,5.5744e+00_r8,5.7766e+00_r8,5.9767e+00_r8,6.2167e+00_r8/) + kbo(:,16, 5) = (/ & + &4.6816e+00_r8,4.8936e+00_r8,5.0862e+00_r8,5.2967e+00_r8,5.5327e+00_r8/) + kbo(:,17, 5) = (/ & + &4.0899e+00_r8,4.2917e+00_r8,4.4812e+00_r8,4.7025e+00_r8,4.9201e+00_r8/) + kbo(:,18, 5) = (/ & + &3.5771e+00_r8,3.7678e+00_r8,3.9593e+00_r8,4.1715e+00_r8,4.3722e+00_r8/) + kbo(:,19, 5) = (/ & + &3.1364e+00_r8,3.3176e+00_r8,3.5013e+00_r8,3.6935e+00_r8,3.8830e+00_r8/) + kbo(:,20, 5) = (/ & + &2.7593e+00_r8,2.9230e+00_r8,3.0933e+00_r8,3.2687e+00_r8,3.4499e+00_r8/) + kbo(:,21, 5) = (/ & + &2.4256e+00_r8,2.5724e+00_r8,2.7298e+00_r8,2.8928e+00_r8,3.0638e+00_r8/) + kbo(:,22, 5) = (/ & + &2.1368e+00_r8,2.2729e+00_r8,2.4183e+00_r8,2.5689e+00_r8,2.7252e+00_r8/) + kbo(:,23, 5) = (/ & + &1.8817e+00_r8,2.0092e+00_r8,2.1410e+00_r8,2.2786e+00_r8,2.4217e+00_r8/) + kbo(:,24, 5) = (/ & + &1.6588e+00_r8,1.7749e+00_r8,1.8947e+00_r8,2.0208e+00_r8,2.1527e+00_r8/) + kbo(:,25, 5) = (/ & + &1.4616e+00_r8,1.5668e+00_r8,1.6777e+00_r8,1.7944e+00_r8,1.9128e+00_r8/) + kbo(:,26, 5) = (/ & + &1.2875e+00_r8,1.3850e+00_r8,1.4881e+00_r8,1.5943e+00_r8,1.7005e+00_r8/) + kbo(:,27, 5) = (/ & + &1.1342e+00_r8,1.2250e+00_r8,1.3195e+00_r8,1.4155e+00_r8,1.5121e+00_r8/) + kbo(:,28, 5) = (/ & + &1.0000e+00_r8,1.0834e+00_r8,1.1694e+00_r8,1.2569e+00_r8,1.3467e+00_r8/) + kbo(:,29, 5) = (/ & + &8.8272e-01_r8,9.5878e-01_r8,1.0375e+00_r8,1.1189e+00_r8,1.2039e+00_r8/) + kbo(:,30, 5) = (/ & + &7.8028e-01_r8,8.4986e-01_r8,9.2253e-01_r8,9.9927e-01_r8,1.0809e+00_r8/) + kbo(:,31, 5) = (/ & + &6.9115e-01_r8,7.5536e-01_r8,8.2388e-01_r8,8.9787e-01_r8,9.7590e-01_r8/) + kbo(:,32, 5) = (/ & + &6.1412e-01_r8,6.7446e-01_r8,7.4048e-01_r8,8.1095e-01_r8,8.8670e-01_r8/) + kbo(:,33, 5) = (/ & + &5.4810e-01_r8,6.0636e-01_r8,6.6911e-01_r8,7.3734e-01_r8,8.1091e-01_r8/) + kbo(:,34, 5) = (/ & + &4.9071e-01_r8,5.4601e-01_r8,6.0648e-01_r8,6.7271e-01_r8,7.4441e-01_r8/) + kbo(:,35, 5) = (/ & + &4.3693e-01_r8,4.8943e-01_r8,5.4769e-01_r8,6.1149e-01_r8,6.8198e-01_r8/) + kbo(:,36, 5) = (/ & + &3.8551e-01_r8,4.3547e-01_r8,4.9121e-01_r8,5.5301e-01_r8,6.2109e-01_r8/) + kbo(:,37, 5) = (/ & + &3.3480e-01_r8,3.8150e-01_r8,4.3408e-01_r8,4.9278e-01_r8,5.5808e-01_r8/) + kbo(:,38, 5) = (/ & + &2.9081e-01_r8,3.3450e-01_r8,3.8398e-01_r8,4.3987e-01_r8,5.0248e-01_r8/) + kbo(:,39, 5) = (/ & + &2.5305e-01_r8,2.9380e-01_r8,3.4050e-01_r8,3.9390e-01_r8,4.5364e-01_r8/) + kbo(:,40, 5) = (/ & + &2.1671e-01_r8,2.5418e-01_r8,2.9763e-01_r8,3.4779e-01_r8,4.0458e-01_r8/) + kbo(:,41, 5) = (/ & + &1.8493e-01_r8,2.1926e-01_r8,2.5954e-01_r8,3.0662e-01_r8,3.6037e-01_r8/) + kbo(:,42, 5) = (/ & + &1.5752e-01_r8,1.8888e-01_r8,2.2625e-01_r8,2.7031e-01_r8,3.2124e-01_r8/) + kbo(:,43, 5) = (/ & + &1.3255e-01_r8,1.6078e-01_r8,1.9491e-01_r8,2.3576e-01_r8,2.8350e-01_r8/) + kbo(:,44, 5) = (/ & + &1.1061e-01_r8,1.3578e-01_r8,1.6666e-01_r8,2.0425e-01_r8,2.4865e-01_r8/) + kbo(:,45, 5) = (/ & + &9.1951e-02_r8,1.1424e-01_r8,1.4202e-01_r8,1.7639e-01_r8,2.1757e-01_r8/) + kbo(:,46, 5) = (/ & + &7.5781e-02_r8,9.5221e-02_r8,1.1993e-01_r8,1.5099e-01_r8,1.8901e-01_r8/) + kbo(:,47, 5) = (/ & + &6.1487e-02_r8,7.8164e-02_r8,9.9731e-02_r8,1.2737e-01_r8,1.6179e-01_r8/) + kbo(:,48, 5) = (/ & + &4.9580e-02_r8,6.3770e-02_r8,8.2434e-02_r8,1.0684e-01_r8,1.3786e-01_r8/) + kbo(:,49, 5) = (/ & + &3.9738e-02_r8,5.1709e-02_r8,6.7733e-02_r8,8.9073e-02_r8,1.1686e-01_r8/) + kbo(:,50, 5) = (/ & + &3.1862e-02_r8,4.1943e-02_r8,5.5637e-02_r8,7.4270e-02_r8,9.9031e-02_r8/) + kbo(:,51, 5) = (/ & + &2.5469e-02_r8,3.3911e-02_r8,4.5561e-02_r8,6.1725e-02_r8,8.3692e-02_r8/) + kbo(:,52, 5) = (/ & + &2.0254e-02_r8,2.7266e-02_r8,3.7097e-02_r8,5.1018e-02_r8,7.0332e-02_r8/) + kbo(:,53, 5) = (/ & + &1.6008e-02_r8,2.1779e-02_r8,3.0012e-02_r8,4.1907e-02_r8,5.8779e-02_r8/) + kbo(:,54, 5) = (/ & + &1.2684e-02_r8,1.7422e-02_r8,2.4313e-02_r8,3.4417e-02_r8,4.9062e-02_r8/) + kbo(:,55, 5) = (/ & + &1.0038e-02_r8,1.3916e-02_r8,1.9644e-02_r8,2.8164e-02_r8,4.0795e-02_r8/) + kbo(:,56, 5) = (/ & + &7.9079e-03_r8,1.1053e-02_r8,1.5781e-02_r8,2.2925e-02_r8,3.3750e-02_r8/) + kbo(:,57, 5) = (/ & + &6.2010e-03_r8,8.7295e-03_r8,1.2598e-02_r8,1.8552e-02_r8,2.7742e-02_r8/) + kbo(:,58, 5) = (/ & + &4.8646e-03_r8,6.8966e-03_r8,1.0058e-02_r8,1.5005e-02_r8,2.2774e-02_r8/) + kbo(:,59, 5) = (/ & + &4.0331e-03_r8,5.7872e-03_r8,8.5542e-03_r8,1.2975e-02_r8,2.0014e-02_r8/) + kbo(:,13, 6) = (/ & + &1.3874e+01_r8,1.4054e+01_r8,1.4175e+01_r8,1.4196e+01_r8,1.4254e+01_r8/) + kbo(:,14, 6) = (/ & + &1.2387e+01_r8,1.2564e+01_r8,1.2698e+01_r8,1.2762e+01_r8,1.2781e+01_r8/) + kbo(:,15, 6) = (/ & + &1.0973e+01_r8,1.1145e+01_r8,1.1274e+01_r8,1.1365e+01_r8,1.1424e+01_r8/) + kbo(:,16, 6) = (/ & + &9.6521e+00_r8,9.8053e+00_r8,9.9370e+00_r8,1.0047e+01_r8,1.0150e+01_r8/) + kbo(:,17, 6) = (/ & + &8.4222e+00_r8,8.5719e+00_r8,8.7195e+00_r8,8.8488e+00_r8,9.0159e+00_r8/) + kbo(:,18, 6) = (/ & + &7.3090e+00_r8,7.4668e+00_r8,7.6322e+00_r8,7.7932e+00_r8,8.0086e+00_r8/) + kbo(:,19, 6) = (/ & + &6.3279e+00_r8,6.4985e+00_r8,6.6813e+00_r8,6.8756e+00_r8,7.1176e+00_r8/) + kbo(:,20, 6) = (/ & + &5.4862e+00_r8,5.6719e+00_r8,5.8682e+00_r8,6.0850e+00_r8,6.3337e+00_r8/) + kbo(:,21, 6) = (/ & + &4.7753e+00_r8,4.9682e+00_r8,5.1665e+00_r8,5.3943e+00_r8,5.6406e+00_r8/) + kbo(:,22, 6) = (/ & + &4.1854e+00_r8,4.3703e+00_r8,4.5713e+00_r8,4.7990e+00_r8,5.0439e+00_r8/) + kbo(:,23, 6) = (/ & + &3.6767e+00_r8,3.8508e+00_r8,4.0542e+00_r8,4.2776e+00_r8,4.5191e+00_r8/) + kbo(:,24, 6) = (/ & + &3.2355e+00_r8,3.4077e+00_r8,3.6072e+00_r8,3.8245e+00_r8,4.0534e+00_r8/) + kbo(:,25, 6) = (/ & + &2.8580e+00_r8,3.0303e+00_r8,3.2220e+00_r8,3.4257e+00_r8,3.6444e+00_r8/) + kbo(:,26, 6) = (/ & + &2.5405e+00_r8,2.7078e+00_r8,2.8872e+00_r8,3.0816e+00_r8,3.2880e+00_r8/) + kbo(:,27, 6) = (/ & + &2.2677e+00_r8,2.4258e+00_r8,2.5973e+00_r8,2.7818e+00_r8,2.9766e+00_r8/) + kbo(:,28, 6) = (/ & + &2.0273e+00_r8,2.1803e+00_r8,2.3462e+00_r8,2.5211e+00_r8,2.7040e+00_r8/) + kbo(:,29, 6) = (/ & + &1.8190e+00_r8,1.9689e+00_r8,2.1279e+00_r8,2.2941e+00_r8,2.4662e+00_r8/) + kbo(:,30, 6) = (/ & + &1.6397e+00_r8,1.7844e+00_r8,1.9371e+00_r8,2.0958e+00_r8,2.2590e+00_r8/) + kbo(:,31, 6) = (/ & + &1.4852e+00_r8,1.6249e+00_r8,1.7714e+00_r8,1.9226e+00_r8,2.0813e+00_r8/) + kbo(:,32, 6) = (/ & + &1.3517e+00_r8,1.4862e+00_r8,1.6264e+00_r8,1.7745e+00_r8,1.9335e+00_r8/) + kbo(:,33, 6) = (/ & + &1.2364e+00_r8,1.3651e+00_r8,1.5027e+00_r8,1.6513e+00_r8,1.8098e+00_r8/) + kbo(:,34, 6) = (/ & + &1.1317e+00_r8,1.2571e+00_r8,1.3947e+00_r8,1.5426e+00_r8,1.7001e+00_r8/) + kbo(:,35, 6) = (/ & + &1.0305e+00_r8,1.1540e+00_r8,1.2902e+00_r8,1.4368e+00_r8,1.5937e+00_r8/) + kbo(:,36, 6) = (/ & + &9.3137e-01_r8,1.0526e+00_r8,1.1856e+00_r8,1.3299e+00_r8,1.4860e+00_r8/) + kbo(:,37, 6) = (/ & + &8.2931e-01_r8,9.4564e-01_r8,1.0739e+00_r8,1.2152e+00_r8,1.3682e+00_r8/) + kbo(:,38, 6) = (/ & + &7.3906e-01_r8,8.5034e-01_r8,9.7478e-01_r8,1.1125e+00_r8,1.2627e+00_r8/) + kbo(:,39, 6) = (/ & + &6.6006e-01_r8,7.6663e-01_r8,8.8732e-01_r8,1.0214e+00_r8,1.1704e+00_r8/) + kbo(:,40, 6) = (/ & + &5.8074e-01_r8,6.8151e-01_r8,7.9698e-01_r8,9.2673e-01_r8,1.0719e+00_r8/) + kbo(:,41, 6) = (/ & + &5.0970e-01_r8,6.0467e-01_r8,7.1469e-01_r8,8.3962e-01_r8,9.8097e-01_r8/) + kbo(:,42, 6) = (/ & + &4.4691e-01_r8,5.3653e-01_r8,6.4112e-01_r8,7.6136e-01_r8,8.9846e-01_r8/) + kbo(:,43, 6) = (/ & + &3.8720e-01_r8,4.7067e-01_r8,5.6921e-01_r8,6.8346e-01_r8,8.1541e-01_r8/) + kbo(:,44, 6) = (/ & + &3.3270e-01_r8,4.0984e-01_r8,5.0209e-01_r8,6.1017e-01_r8,7.3637e-01_r8/) + kbo(:,45, 6) = (/ & + &2.8475e-01_r8,3.5595e-01_r8,4.4190e-01_r8,5.4378e-01_r8,6.6410e-01_r8/) + kbo(:,46, 6) = (/ & + &2.4137e-01_r8,3.0640e-01_r8,3.8581e-01_r8,4.8130e-01_r8,5.9507e-01_r8/) + kbo(:,47, 6) = (/ & + &2.0121e-01_r8,2.5952e-01_r8,3.3199e-01_r8,4.2038e-01_r8,5.2702e-01_r8/) + kbo(:,48, 6) = (/ & + &1.6644e-01_r8,2.1836e-01_r8,2.8412e-01_r8,3.6558e-01_r8,4.6520e-01_r8/) + kbo(:,49, 6) = (/ & + &1.3664e-01_r8,1.8247e-01_r8,2.4166e-01_r8,3.1637e-01_r8,4.0912e-01_r8/) + kbo(:,50, 6) = (/ & + &1.1203e-01_r8,1.5228e-01_r8,2.0551e-01_r8,2.7399e-01_r8,3.6023e-01_r8/) + kbo(:,51, 6) = (/ & + &9.1424e-02_r8,1.2652e-01_r8,1.7413e-01_r8,2.3648e-01_r8,3.1642e-01_r8/) + kbo(:,52, 6) = (/ & + &7.4033e-02_r8,1.0433e-01_r8,1.4653e-01_r8,2.0289e-01_r8,2.7670e-01_r8/) + kbo(:,53, 6) = (/ & + &5.9468e-02_r8,8.5397e-02_r8,1.2237e-01_r8,1.7301e-01_r8,2.4059e-01_r8/) + kbo(:,54, 6) = (/ & + &4.7831e-02_r8,6.9932e-02_r8,1.0222e-01_r8,1.4759e-01_r8,2.0954e-01_r8/) + kbo(:,55, 6) = (/ & + &3.8375e-02_r8,5.7032e-02_r8,8.5062e-02_r8,1.2546e-01_r8,1.8204e-01_r8/) + kbo(:,56, 6) = (/ & + &3.0600e-02_r8,4.6150e-02_r8,7.0262e-02_r8,1.0594e-01_r8,1.5707e-01_r8/) + kbo(:,57, 6) = (/ & + &2.4221e-02_r8,3.7043e-02_r8,5.7569e-02_r8,8.8786e-02_r8,1.3465e-01_r8/) + kbo(:,58, 6) = (/ & + &1.9170e-02_r8,2.9713e-02_r8,4.7101e-02_r8,7.4302e-02_r8,1.1534e-01_r8/) + kbo(:,59, 6) = (/ & + &1.6314e-02_r8,2.5760e-02_r8,4.1528e-02_r8,6.6912e-02_r8,1.0596e-01_r8/) + kbo(:,13, 7) = (/ & + &2.6383e+01_r8,2.6399e+01_r8,2.6364e+01_r8,2.6286e+01_r8,2.6068e+01_r8/) + kbo(:,14, 7) = (/ & + &2.4391e+01_r8,2.4435e+01_r8,2.4445e+01_r8,2.4411e+01_r8,2.4344e+01_r8/) + kbo(:,15, 7) = (/ & + &2.2267e+01_r8,2.2343e+01_r8,2.2391e+01_r8,2.2420e+01_r8,2.2406e+01_r8/) + kbo(:,16, 7) = (/ & + &2.0101e+01_r8,2.0222e+01_r8,2.0311e+01_r8,2.0370e+01_r8,2.0373e+01_r8/) + kbo(:,17, 7) = (/ & + &1.7987e+01_r8,1.8130e+01_r8,1.8242e+01_r8,1.8316e+01_r8,1.8338e+01_r8/) + kbo(:,18, 7) = (/ & + &1.5956e+01_r8,1.6114e+01_r8,1.6238e+01_r8,1.6337e+01_r8,1.6400e+01_r8/) + kbo(:,19, 7) = (/ & + &1.4050e+01_r8,1.4210e+01_r8,1.4354e+01_r8,1.4495e+01_r8,1.4623e+01_r8/) + kbo(:,20, 7) = (/ & + &1.2287e+01_r8,1.2462e+01_r8,1.2644e+01_r8,1.2837e+01_r8,1.3036e+01_r8/) + kbo(:,21, 7) = (/ & + &1.0697e+01_r8,1.0904e+01_r8,1.1136e+01_r8,1.1376e+01_r8,1.1647e+01_r8/) + kbo(:,22, 7) = (/ & + &9.3216e+00_r8,9.5704e+00_r8,9.8418e+00_r8,1.0134e+01_r8,1.0464e+01_r8/) + kbo(:,23, 7) = (/ & + &8.1552e+00_r8,8.4381e+00_r8,8.7358e+00_r8,9.0546e+00_r8,9.4274e+00_r8/) + kbo(:,24, 7) = (/ & + &7.1742e+00_r8,7.4714e+00_r8,7.7800e+00_r8,8.1293e+00_r8,8.5227e+00_r8/) + kbo(:,25, 7) = (/ & + &6.3453e+00_r8,6.6371e+00_r8,6.9572e+00_r8,7.3300e+00_r8,7.7371e+00_r8/) + kbo(:,26, 7) = (/ & + &5.6325e+00_r8,5.9213e+00_r8,6.2619e+00_r8,6.6436e+00_r8,7.0622e+00_r8/) + kbo(:,27, 7) = (/ & + &5.0177e+00_r8,5.3180e+00_r8,5.6685e+00_r8,6.0556e+00_r8,6.4791e+00_r8/) + kbo(:,28, 7) = (/ & + &4.5006e+00_r8,4.8114e+00_r8,5.1630e+00_r8,5.5512e+00_r8,5.9725e+00_r8/) + kbo(:,29, 7) = (/ & + &4.0763e+00_r8,4.3869e+00_r8,4.7357e+00_r8,5.1215e+00_r8,5.5415e+00_r8/) + kbo(:,30, 7) = (/ & + &3.7197e+00_r8,4.0279e+00_r8,4.3734e+00_r8,4.7560e+00_r8,5.1758e+00_r8/) + kbo(:,31, 7) = (/ & + &3.4217e+00_r8,3.7276e+00_r8,4.0700e+00_r8,4.4513e+00_r8,4.8709e+00_r8/) + kbo(:,32, 7) = (/ & + &3.1725e+00_r8,3.4760e+00_r8,3.8179e+00_r8,4.1999e+00_r8,4.6169e+00_r8/) + kbo(:,33, 7) = (/ & + &2.9640e+00_r8,3.2682e+00_r8,3.6118e+00_r8,3.9912e+00_r8,4.4110e+00_r8/) + kbo(:,34, 7) = (/ & + &2.7815e+00_r8,3.0881e+00_r8,3.4286e+00_r8,3.8090e+00_r8,4.2366e+00_r8/) + kbo(:,35, 7) = (/ & + &2.6027e+00_r8,2.9073e+00_r8,3.2445e+00_r8,3.6269e+00_r8,4.0627e+00_r8/) + kbo(:,36, 7) = (/ & + &2.4195e+00_r8,2.7195e+00_r8,3.0535e+00_r8,3.4362e+00_r8,3.8766e+00_r8/) + kbo(:,37, 7) = (/ & + &2.2155e+00_r8,2.5099e+00_r8,2.8373e+00_r8,3.2150e+00_r8,3.6504e+00_r8/) + kbo(:,38, 7) = (/ & + &2.0317e+00_r8,2.3214e+00_r8,2.6457e+00_r8,3.0187e+00_r8,3.4497e+00_r8/) + kbo(:,39, 7) = (/ & + &1.8675e+00_r8,2.1535e+00_r8,2.4775e+00_r8,2.8467e+00_r8,3.2732e+00_r8/) + kbo(:,40, 7) = (/ & + &1.6933e+00_r8,1.9726e+00_r8,2.2917e+00_r8,2.6527e+00_r8,3.0690e+00_r8/) + kbo(:,41, 7) = (/ & + &1.5321e+00_r8,1.8045e+00_r8,2.1184e+00_r8,2.4731e+00_r8,2.8788e+00_r8/) + kbo(:,42, 7) = (/ & + &1.3858e+00_r8,1.6512e+00_r8,1.9598e+00_r8,2.3096e+00_r8,2.7061e+00_r8/) + kbo(:,43, 7) = (/ & + &1.2395e+00_r8,1.4953e+00_r8,1.7959e+00_r8,2.1389e+00_r8,2.5250e+00_r8/) + kbo(:,44, 7) = (/ & + &1.1006e+00_r8,1.3456e+00_r8,1.6365e+00_r8,1.9712e+00_r8,2.3479e+00_r8/) + kbo(:,45, 7) = (/ & + &9.7411e-01_r8,1.2078e+00_r8,1.4892e+00_r8,1.8150e+00_r8,2.1832e+00_r8/) + kbo(:,46, 7) = (/ & + &8.5489e-01_r8,1.0759e+00_r8,1.3456e+00_r8,1.6612e+00_r8,2.0197e+00_r8/) + kbo(:,47, 7) = (/ & + &7.3930e-01_r8,9.4494e-01_r8,1.2000e+00_r8,1.5026e+00_r8,1.8496e+00_r8/) + kbo(:,48, 7) = (/ & + &6.3547e-01_r8,8.2535e-01_r8,1.0653e+00_r8,1.3544e+00_r8,1.6889e+00_r8/) + kbo(:,49, 7) = (/ & + &5.4241e-01_r8,7.1674e-01_r8,9.4139e-01_r8,1.2160e+00_r8,1.5375e+00_r8/) + kbo(:,50, 7) = (/ & + &4.6304e-01_r8,6.2300e-01_r8,8.3217e-01_r8,1.0925e+00_r8,1.4012e+00_r8/) + kbo(:,51, 7) = (/ & + &3.9371e-01_r8,5.3995e-01_r8,7.3373e-01_r8,9.7980e-01_r8,1.2748e+00_r8/) + kbo(:,52, 7) = (/ & + &3.3220e-01_r8,4.6493e-01_r8,6.4396e-01_r8,8.7508e-01_r8,1.1558e+00_r8/) + kbo(:,53, 7) = (/ & + &2.7778e-01_r8,3.9741e-01_r8,5.6181e-01_r8,7.7785e-01_r8,1.0434e+00_r8/) + kbo(:,54, 7) = (/ & + &2.3274e-01_r8,3.4050e-01_r8,4.9090e-01_r8,6.9261e-01_r8,9.4387e-01_r8/) + kbo(:,55, 7) = (/ & + &1.9435e-01_r8,2.9105e-01_r8,4.2805e-01_r8,6.1562e-01_r8,8.5235e-01_r8/) + kbo(:,56, 7) = (/ & + &1.6083e-01_r8,2.4693e-01_r8,3.7158e-01_r8,5.4415e-01_r8,7.6669e-01_r8/) + kbo(:,57, 7) = (/ & + &1.3183e-01_r8,2.0770e-01_r8,3.2034e-01_r8,4.7818e-01_r8,6.8649e-01_r8/) + kbo(:,58, 7) = (/ & + &1.0786e-01_r8,1.7445e-01_r8,2.7618e-01_r8,4.2058e-01_r8,6.1481e-01_r8/) + kbo(:,59, 7) = (/ & + &9.5778e-02_r8,1.5879e-01_r8,2.5699e-01_r8,3.9684e-01_r8,5.8283e-01_r8/) + kbo(:,13, 8) = (/ & + &5.1036e+01_r8,5.0460e+01_r8,4.9876e+01_r8,4.9272e+01_r8,4.8645e+01_r8/) + kbo(:,14, 8) = (/ & + &4.9659e+01_r8,4.9240e+01_r8,4.8789e+01_r8,4.8317e+01_r8,4.7813e+01_r8/) + kbo(:,15, 8) = (/ & + &4.7836e+01_r8,4.7533e+01_r8,4.7179e+01_r8,4.6807e+01_r8,4.6408e+01_r8/) + kbo(:,16, 8) = (/ & + &4.5523e+01_r8,4.5307e+01_r8,4.5074e+01_r8,4.4798e+01_r8,4.4497e+01_r8/) + kbo(:,17, 8) = (/ & + &4.2751e+01_r8,4.2659e+01_r8,4.2523e+01_r8,4.2351e+01_r8,4.2128e+01_r8/) + kbo(:,18, 8) = (/ & + &3.9675e+01_r8,3.9678e+01_r8,3.9613e+01_r8,3.9512e+01_r8,3.9377e+01_r8/) + kbo(:,19, 8) = (/ & + &3.6385e+01_r8,3.6442e+01_r8,3.6467e+01_r8,3.6453e+01_r8,3.6385e+01_r8/) + kbo(:,20, 8) = (/ & + &3.2988e+01_r8,3.3119e+01_r8,3.3207e+01_r8,3.3253e+01_r8,3.3266e+01_r8/) + kbo(:,21, 8) = (/ & + &2.9629e+01_r8,2.9807e+01_r8,2.9950e+01_r8,3.0074e+01_r8,3.0195e+01_r8/) + kbo(:,22, 8) = (/ & + &2.6389e+01_r8,2.6615e+01_r8,2.6833e+01_r8,2.7054e+01_r8,2.7281e+01_r8/) + kbo(:,23, 8) = (/ & + &2.3355e+01_r8,2.3644e+01_r8,2.3948e+01_r8,2.4296e+01_r8,2.4660e+01_r8/) + kbo(:,24, 8) = (/ & + &2.0595e+01_r8,2.0963e+01_r8,2.1391e+01_r8,2.1861e+01_r8,2.2380e+01_r8/) + kbo(:,25, 8) = (/ & + &1.8159e+01_r8,1.8637e+01_r8,1.9183e+01_r8,1.9778e+01_r8,2.0439e+01_r8/) + kbo(:,26, 8) = (/ & + &1.6089e+01_r8,1.6677e+01_r8,1.7319e+01_r8,1.8032e+01_r8,1.8814e+01_r8/) + kbo(:,27, 8) = (/ & + &1.4363e+01_r8,1.5028e+01_r8,1.5757e+01_r8,1.6564e+01_r8,1.7443e+01_r8/) + kbo(:,28, 8) = (/ & + &1.2926e+01_r8,1.3648e+01_r8,1.4446e+01_r8,1.5323e+01_r8,1.6326e+01_r8/) + kbo(:,29, 8) = (/ & + &1.1723e+01_r8,1.2493e+01_r8,1.3349e+01_r8,1.4336e+01_r8,1.5419e+01_r8/) + kbo(:,30, 8) = (/ & + &1.0720e+01_r8,1.1535e+01_r8,1.2485e+01_r8,1.3543e+01_r8,1.4696e+01_r8/) + kbo(:,31, 8) = (/ & + &9.8953e+00_r8,1.0794e+01_r8,1.1807e+01_r8,1.2928e+01_r8,1.4151e+01_r8/) + kbo(:,32, 8) = (/ & + &9.2630e+00_r8,1.0213e+01_r8,1.1281e+01_r8,1.2468e+01_r8,1.3783e+01_r8/) + kbo(:,33, 8) = (/ & + &8.7693e+00_r8,9.7682e+00_r8,1.0900e+01_r8,1.2171e+01_r8,1.3564e+01_r8/) + kbo(:,34, 8) = (/ & + &8.3550e+00_r8,9.4057e+00_r8,1.0612e+01_r8,1.1954e+01_r8,1.3416e+01_r8/) + kbo(:,35, 8) = (/ & + &7.9503e+00_r8,9.0506e+00_r8,1.0311e+01_r8,1.1711e+01_r8,1.3230e+01_r8/) + kbo(:,36, 8) = (/ & + &7.5260e+00_r8,8.6513e+00_r8,9.9500e+00_r8,1.1393e+01_r8,1.2954e+01_r8/) + kbo(:,37, 8) = (/ & + &7.0166e+00_r8,8.1408e+00_r8,9.4476e+00_r8,1.0907e+01_r8,1.2489e+01_r8/) + kbo(:,38, 8) = (/ & + &6.5631e+00_r8,7.6815e+00_r8,8.9895e+00_r8,1.0461e+01_r8,1.2064e+01_r8/) + kbo(:,39, 8) = (/ & + &6.1678e+00_r8,7.2805e+00_r8,8.5861e+00_r8,1.0065e+01_r8,1.1676e+01_r8/) + kbo(:,40, 8) = (/ & + &5.7155e+00_r8,6.7987e+00_r8,8.0775e+00_r8,9.5392e+00_r8,1.1142e+01_r8/) + kbo(:,41, 8) = (/ & + &5.2949e+00_r8,6.3470e+00_r8,7.5914e+00_r8,9.0258e+00_r8,1.0614e+01_r8/) + kbo(:,42, 8) = (/ & + &4.9139e+00_r8,5.9322e+00_r8,7.1403e+00_r8,8.5407e+00_r8,1.0110e+01_r8/) + kbo(:,43, 8) = (/ & + &4.5194e+00_r8,5.4902e+00_r8,6.6498e+00_r8,8.0033e+00_r8,9.5351e+00_r8/) + kbo(:,44, 8) = (/ & + &4.1399e+00_r8,5.0576e+00_r8,6.1633e+00_r8,7.4614e+00_r8,8.9447e+00_r8/) + kbo(:,45, 8) = (/ & + &3.7947e+00_r8,4.6596e+00_r8,5.7095e+00_r8,6.9501e+00_r8,8.3804e+00_r8/) + kbo(:,46, 8) = (/ & + &3.4645e+00_r8,4.2731e+00_r8,5.2631e+00_r8,6.4408e+00_r8,7.8107e+00_r8/) + kbo(:,47, 8) = (/ & + &3.1333e+00_r8,3.8817e+00_r8,4.8032e+00_r8,5.9109e+00_r8,7.2077e+00_r8/) + kbo(:,48, 8) = (/ & + &2.8272e+00_r8,3.5252e+00_r8,4.3790e+00_r8,5.4161e+00_r8,6.6403e+00_r8/) + kbo(:,49, 8) = (/ & + &2.5419e+00_r8,3.2000e+00_r8,3.9894e+00_r8,4.9550e+00_r8,6.1077e+00_r8/) + kbo(:,50, 8) = (/ & + &2.2876e+00_r8,2.9151e+00_r8,3.6507e+00_r8,4.5513e+00_r8,5.6358e+00_r8/) + kbo(:,51, 8) = (/ & + &2.0539e+00_r8,2.6537e+00_r8,3.3480e+00_r8,4.1860e+00_r8,5.2042e+00_r8/) + kbo(:,52, 8) = (/ & + &1.8359e+00_r8,2.4075e+00_r8,3.0676e+00_r8,3.8482e+00_r8,4.8005e+00_r8/) + kbo(:,53, 8) = (/ & + &1.6315e+00_r8,2.1744e+00_r8,2.8043e+00_r8,3.5342e+00_r8,4.4242e+00_r8/) + kbo(:,54, 8) = (/ & + &1.4536e+00_r8,1.9689e+00_r8,2.5734e+00_r8,3.2651e+00_r8,4.0977e+00_r8/) + kbo(:,55, 8) = (/ & + &1.2924e+00_r8,1.7818e+00_r8,2.3616e+00_r8,3.0234e+00_r8,3.8040e+00_r8/) + kbo(:,56, 8) = (/ & + &1.1428e+00_r8,1.6042e+00_r8,2.1584e+00_r8,2.7950e+00_r8,3.5303e+00_r8/) + kbo(:,57, 8) = (/ & + &1.0034e+00_r8,1.4376e+00_r8,1.9645e+00_r8,2.5766e+00_r8,3.2746e+00_r8/) + kbo(:,58, 8) = (/ & + &8.7989e-01_r8,1.2882e+00_r8,1.7895e+00_r8,2.3775e+00_r8,3.0470e+00_r8/) + kbo(:,59, 8) = (/ & + &8.2607e-01_r8,1.2253e+00_r8,1.7145e+00_r8,2.2929e+00_r8,2.9546e+00_r8/) + kbo(:,13, 9) = (/ & + &9.9406e+01_r8,9.8017e+01_r8,9.6610e+01_r8,9.5133e+01_r8,9.3589e+01_r8/) + kbo(:,14, 9) = (/ & + &1.0426e+02_r8,1.0289e+02_r8,1.0145e+02_r8,9.9955e+01_r8,9.8418e+01_r8/) + kbo(:,15, 9) = (/ & + &1.0831e+02_r8,1.0700e+02_r8,1.0565e+02_r8,1.0422e+02_r8,1.0271e+02_r8/) + kbo(:,16, 9) = (/ & + &1.1144e+02_r8,1.1027e+02_r8,1.0899e+02_r8,1.0766e+02_r8,1.0626e+02_r8/) + kbo(:,17, 9) = (/ & + &1.1357e+02_r8,1.1252e+02_r8,1.1140e+02_r8,1.1022e+02_r8,1.0897e+02_r8/) + kbo(:,18, 9) = (/ & + &1.1451e+02_r8,1.1366e+02_r8,1.1275e+02_r8,1.1172e+02_r8,1.1059e+02_r8/) + kbo(:,19, 9) = (/ & + &1.1419e+02_r8,1.1358e+02_r8,1.1283e+02_r8,1.1199e+02_r8,1.1108e+02_r8/) + kbo(:,20, 9) = (/ & + &1.1253e+02_r8,1.1217e+02_r8,1.1170e+02_r8,1.1113e+02_r8,1.1043e+02_r8/) + kbo(:,21, 9) = (/ & + &1.0964e+02_r8,1.0959e+02_r8,1.0941e+02_r8,1.0911e+02_r8,1.0868e+02_r8/) + kbo(:,22, 9) = (/ & + &1.0576e+02_r8,1.0601e+02_r8,1.0614e+02_r8,1.0616e+02_r8,1.0606e+02_r8/) + kbo(:,23, 9) = (/ & + &1.0113e+02_r8,1.0172e+02_r8,1.0220e+02_r8,1.0257e+02_r8,1.0280e+02_r8/) + kbo(:,24, 9) = (/ & + &9.6005e+01_r8,9.6976e+01_r8,9.7826e+01_r8,9.8561e+01_r8,9.9182e+01_r8/) + kbo(:,25, 9) = (/ & + &9.0658e+01_r8,9.2026e+01_r8,9.3302e+01_r8,9.4462e+01_r8,9.5504e+01_r8/) + kbo(:,26, 9) = (/ & + &8.5398e+01_r8,8.7188e+01_r8,8.8895e+01_r8,9.0506e+01_r8,9.1994e+01_r8/) + kbo(:,27, 9) = (/ & + &8.0425e+01_r8,8.2648e+01_r8,8.4817e+01_r8,8.6900e+01_r8,8.8861e+01_r8/) + kbo(:,28, 9) = (/ & + &7.5902e+01_r8,7.8597e+01_r8,8.1250e+01_r8,8.3817e+01_r8,8.6189e+01_r8/) + kbo(:,29, 9) = (/ & + &7.2021e+01_r8,7.5193e+01_r8,7.8323e+01_r8,8.1284e+01_r8,8.4079e+01_r8/) + kbo(:,30, 9) = (/ & + &6.8846e+01_r8,7.2476e+01_r8,7.5986e+01_r8,7.9352e+01_r8,8.2517e+01_r8/) + kbo(:,31, 9) = (/ & + &6.6391e+01_r8,7.0389e+01_r8,7.4280e+01_r8,7.7994e+01_r8,8.1462e+01_r8/) + kbo(:,32, 9) = (/ & + &6.4577e+01_r8,6.8942e+01_r8,7.3166e+01_r8,7.7157e+01_r8,8.0829e+01_r8/) + kbo(:,33, 9) = (/ & + &6.3392e+01_r8,6.8071e+01_r8,7.2548e+01_r8,7.6730e+01_r8,8.0569e+01_r8/) + kbo(:,34, 9) = (/ & + &6.2591e+01_r8,6.7517e+01_r8,7.2182e+01_r8,7.6523e+01_r8,8.0479e+01_r8/) + kbo(:,35, 9) = (/ & + &6.1727e+01_r8,6.6854e+01_r8,7.1692e+01_r8,7.6175e+01_r8,8.0232e+01_r8/) + kbo(:,36, 9) = (/ & + &6.0594e+01_r8,6.5914e+01_r8,7.0919e+01_r8,7.5536e+01_r8,7.9714e+01_r8/) + kbo(:,37, 9) = (/ & + &5.8846e+01_r8,6.4364e+01_r8,6.9558e+01_r8,7.4349e+01_r8,7.8713e+01_r8/) + kbo(:,38, 9) = (/ & + &5.7194e+01_r8,6.2887e+01_r8,6.8247e+01_r8,7.3195e+01_r8,7.8049e+01_r8/) + kbo(:,39, 9) = (/ & + &5.5665e+01_r8,6.1507e+01_r8,6.7008e+01_r8,7.2147e+01_r8,7.7547e+01_r8/) + kbo(:,40, 9) = (/ & + &5.3621e+01_r8,5.9617e+01_r8,6.5286e+01_r8,7.0695e+01_r8,7.6340e+01_r8/) + kbo(:,41, 9) = (/ & + &5.1554e+01_r8,5.7685e+01_r8,6.3510e+01_r8,6.9201e+01_r8,7.4982e+01_r8/) + kbo(:,42, 9) = (/ & + &4.9528e+01_r8,5.5776e+01_r8,6.1743e+01_r8,6.7740e+01_r8,7.3659e+01_r8/) + kbo(:,43, 9) = (/ & + &4.7178e+01_r8,5.3540e+01_r8,5.9647e+01_r8,6.5886e+01_r8,7.2015e+01_r8/) + kbo(:,44, 9) = (/ & + &4.4688e+01_r8,5.1145e+01_r8,5.7387e+01_r8,6.3891e+01_r8,7.0203e+01_r8/) + kbo(:,45, 9) = (/ & + &4.2221e+01_r8,4.8754e+01_r8,5.5108e+01_r8,6.1908e+01_r8,6.8361e+01_r8/) + kbo(:,46, 9) = (/ & + &3.9637e+01_r8,4.6220e+01_r8,5.2693e+01_r8,5.9708e+01_r8,6.6363e+01_r8/) + kbo(:,47, 9) = (/ & + &3.6803e+01_r8,4.3409e+01_r8,4.9987e+01_r8,5.7153e+01_r8,6.3987e+01_r8/) + kbo(:,48, 9) = (/ & + &3.4015e+01_r8,4.0603e+01_r8,4.7276e+01_r8,5.4594e+01_r8,6.1608e+01_r8/) + kbo(:,49, 9) = (/ & + &3.1288e+01_r8,3.7812e+01_r8,4.4636e+01_r8,5.2065e+01_r8,5.9201e+01_r8/) + kbo(:,50, 9) = (/ & + &2.8795e+01_r8,3.5220e+01_r8,4.2061e+01_r8,4.9552e+01_r8,5.6813e+01_r8/) + kbo(:,51, 9) = (/ & + &2.6450e+01_r8,3.2748e+01_r8,3.9528e+01_r8,4.7065e+01_r8,5.4424e+01_r8/) + kbo(:,52, 9) = (/ & + &2.4182e+01_r8,3.0329e+01_r8,3.7052e+01_r8,4.4584e+01_r8,5.2041e+01_r8/) + kbo(:,53, 9) = (/ & + &2.1996e+01_r8,2.7965e+01_r8,3.4636e+01_r8,4.2155e+01_r8,4.9659e+01_r8/) + kbo(:,54, 9) = (/ & + &2.0069e+01_r8,2.5858e+01_r8,3.2251e+01_r8,3.9700e+01_r8,4.7245e+01_r8/) + kbo(:,55, 9) = (/ & + &1.8302e+01_r8,2.3898e+01_r8,3.0045e+01_r8,3.7230e+01_r8,4.4781e+01_r8/) + kbo(:,56, 9) = (/ & + &1.6618e+01_r8,2.2006e+01_r8,2.7997e+01_r8,3.4787e+01_r8,4.2319e+01_r8/) + kbo(:,57, 9) = (/ & + &1.5017e+01_r8,2.0180e+01_r8,2.5997e+01_r8,3.2401e+01_r8,3.9855e+01_r8/) + kbo(:,58, 9) = (/ & + &1.3581e+01_r8,1.8514e+01_r8,2.4151e+01_r8,3.0332e+01_r8,3.7487e+01_r8/) + kbo(:,59, 9) = (/ & + &1.3022e+01_r8,1.7859e+01_r8,2.3425e+01_r8,2.9551e+01_r8,3.6092e+01_r8/) + kbo(:,13,10) = (/ & + &1.4854e+02_r8,1.4629e+02_r8,1.4392e+02_r8,1.4179e+02_r8,1.3968e+02_r8/) + kbo(:,14,10) = (/ & + &1.6449e+02_r8,1.6201e+02_r8,1.5966e+02_r8,1.5740e+02_r8,1.5475e+02_r8/) + kbo(:,15,10) = (/ & + &1.8113e+02_r8,1.7883e+02_r8,1.7633e+02_r8,1.7356e+02_r8,1.7082e+02_r8/) + kbo(:,16,10) = (/ & + &1.9869e+02_r8,1.9617e+02_r8,1.9337e+02_r8,1.9057e+02_r8,1.8767e+02_r8/) + kbo(:,17,10) = (/ & + &2.1579e+02_r8,2.1310e+02_r8,2.1009e+02_r8,2.0678e+02_r8,2.0344e+02_r8/) + kbo(:,18,10) = (/ & + &2.3175e+02_r8,2.2862e+02_r8,2.2543e+02_r8,2.2232e+02_r8,2.1916e+02_r8/) + kbo(:,19,10) = (/ & + &2.4595e+02_r8,2.4325e+02_r8,2.4040e+02_r8,2.3730e+02_r8,2.3384e+02_r8/) + kbo(:,20,10) = (/ & + &2.5917e+02_r8,2.5646e+02_r8,2.5347e+02_r8,2.5026e+02_r8,2.4697e+02_r8/) + kbo(:,21,10) = (/ & + &2.7002e+02_r8,2.6751e+02_r8,2.6472e+02_r8,2.6184e+02_r8,2.5881e+02_r8/) + kbo(:,22,10) = (/ & + &2.7788e+02_r8,2.7617e+02_r8,2.7411e+02_r8,2.7166e+02_r8,2.6869e+02_r8/) + kbo(:,23,10) = (/ & + &2.8310e+02_r8,2.8234e+02_r8,2.8114e+02_r8,2.7929e+02_r8,2.7687e+02_r8/) + kbo(:,24,10) = (/ & + &2.8635e+02_r8,2.8652e+02_r8,2.8615e+02_r8,2.8511e+02_r8,2.8345e+02_r8/) + kbo(:,25,10) = (/ & + &2.8819e+02_r8,2.8935e+02_r8,2.8976e+02_r8,2.8954e+02_r8,2.8857e+02_r8/) + kbo(:,26,10) = (/ & + &2.8894e+02_r8,2.9109e+02_r8,2.9250e+02_r8,2.9307e+02_r8,2.9272e+02_r8/) + kbo(:,27,10) = (/ & + &2.8895e+02_r8,2.9239e+02_r8,2.9473e+02_r8,2.9595e+02_r8,2.9616e+02_r8/) + kbo(:,28,10) = (/ & + &2.8893e+02_r8,2.9347e+02_r8,2.9660e+02_r8,2.9845e+02_r8,2.9908e+02_r8/) + kbo(:,29,10) = (/ & + &2.8896e+02_r8,2.9449e+02_r8,2.9830e+02_r8,3.0067e+02_r8,3.0167e+02_r8/) + kbo(:,30,10) = (/ & + &2.8928e+02_r8,2.9562e+02_r8,2.9995e+02_r8,3.0268e+02_r8,3.0395e+02_r8/) + kbo(:,31,10) = (/ & + &2.9009e+02_r8,2.9691e+02_r8,3.0163e+02_r8,3.0456e+02_r8,3.0602e+02_r8/) + kbo(:,32,10) = (/ & + &2.9131e+02_r8,2.9842e+02_r8,3.0331e+02_r8,3.0639e+02_r8,3.0785e+02_r8/) + kbo(:,33,10) = (/ & + &2.9285e+02_r8,3.0006e+02_r8,3.0500e+02_r8,3.0808e+02_r8,3.0942e+02_r8/) + kbo(:,34,10) = (/ & + &2.9430e+02_r8,3.0156e+02_r8,3.0650e+02_r8,3.0954e+02_r8,3.1081e+02_r8/) + kbo(:,35,10) = (/ & + &2.9506e+02_r8,3.0251e+02_r8,3.0756e+02_r8,3.1064e+02_r8,3.1189e+02_r8/) + kbo(:,36,10) = (/ & + &2.9495e+02_r8,3.0278e+02_r8,3.0811e+02_r8,3.1136e+02_r8,3.1273e+02_r8/) + kbo(:,37,10) = (/ & + &2.9340e+02_r8,3.0194e+02_r8,3.0787e+02_r8,3.1159e+02_r8,3.1314e+02_r8/) + kbo(:,38,10) = (/ & + &2.9167e+02_r8,3.0090e+02_r8,3.0743e+02_r8,3.1157e+02_r8,3.1035e+02_r8/) + kbo(:,39,10) = (/ & + &2.8984e+02_r8,2.9975e+02_r8,3.0683e+02_r8,3.1096e+02_r8,3.0638e+02_r8/) + kbo(:,40,10) = (/ & + &2.8667e+02_r8,2.9751e+02_r8,3.0546e+02_r8,3.0937e+02_r8,3.0473e+02_r8/) + kbo(:,41,10) = (/ & + &2.8308e+02_r8,2.9489e+02_r8,3.0373e+02_r8,3.0736e+02_r8,3.0363e+02_r8/) + kbo(:,42,10) = (/ & + &2.7921e+02_r8,2.9200e+02_r8,3.0174e+02_r8,3.0479e+02_r8,3.0187e+02_r8/) + kbo(:,43,10) = (/ & + &2.7420e+02_r8,2.8820e+02_r8,2.9899e+02_r8,3.0230e+02_r8,2.9999e+02_r8/) + kbo(:,44,10) = (/ & + &2.6840e+02_r8,2.8368e+02_r8,2.9562e+02_r8,2.9904e+02_r8,2.9872e+02_r8/) + kbo(:,45,10) = (/ & + &2.6218e+02_r8,2.7870e+02_r8,2.9185e+02_r8,2.9503e+02_r8,2.9798e+02_r8/) + kbo(:,46,10) = (/ & + &2.5505e+02_r8,2.7298e+02_r8,2.8727e+02_r8,2.9090e+02_r8,2.9720e+02_r8/) + kbo(:,47,10) = (/ & + &2.4654e+02_r8,2.6603e+02_r8,2.8160e+02_r8,2.8645e+02_r8,2.9469e+02_r8/) + kbo(:,48,10) = (/ & + &2.3740e+02_r8,2.5847e+02_r8,2.7519e+02_r8,2.8106e+02_r8,2.9248e+02_r8/) + kbo(:,49,10) = (/ & + &2.2763e+02_r8,2.5025e+02_r8,2.6743e+02_r8,2.7456e+02_r8,2.9049e+02_r8/) + kbo(:,50,10) = (/ & + &2.1791e+02_r8,2.4202e+02_r8,2.6048e+02_r8,2.6898e+02_r8,2.8731e+02_r8/) + kbo(:,51,10) = (/ & + &2.0797e+02_r8,2.3350e+02_r8,2.5355e+02_r8,2.6334e+02_r8,2.8310e+02_r8/) + kbo(:,52,10) = (/ & + &1.9757e+02_r8,2.2449e+02_r8,2.4576e+02_r8,2.5715e+02_r8,2.7915e+02_r8/) + kbo(:,53,10) = (/ & + &1.8669e+02_r8,2.1495e+02_r8,2.3714e+02_r8,2.5067e+02_r8,2.7496e+02_r8/) + kbo(:,54,10) = (/ & + &1.7638e+02_r8,2.0577e+02_r8,2.3068e+02_r8,2.4491e+02_r8,2.6874e+02_r8/) + kbo(:,55,10) = (/ & + &1.6621e+02_r8,1.9659e+02_r8,2.2369e+02_r8,2.4095e+02_r8,2.6031e+02_r8/) + kbo(:,56,10) = (/ & + &1.5581e+02_r8,1.8709e+02_r8,2.1533e+02_r8,2.3658e+02_r8,2.5187e+02_r8/) + kbo(:,57,10) = (/ & + &1.4523e+02_r8,1.7728e+02_r8,2.0662e+02_r8,2.3157e+02_r8,2.4581e+02_r8/) + kbo(:,58,10) = (/ & + &1.3508e+02_r8,1.6774e+02_r8,1.9802e+02_r8,2.2497e+02_r8,2.4252e+02_r8/) + kbo(:,59,10) = (/ & + &1.3094e+02_r8,1.6382e+02_r8,1.9446e+02_r8,2.2185e+02_r8,2.4525e+02_r8/) + kbo(:,13,11) = (/ & + &1.6572e+02_r8,1.6289e+02_r8,1.6008e+02_r8,1.5714e+02_r8,1.5448e+02_r8/) + kbo(:,14,11) = (/ & + &1.8540e+02_r8,1.8266e+02_r8,1.7967e+02_r8,1.7665e+02_r8,1.7387e+02_r8/) + kbo(:,15,11) = (/ & + &2.0814e+02_r8,2.0518e+02_r8,2.0210e+02_r8,1.9898e+02_r8,1.9569e+02_r8/) + kbo(:,16,11) = (/ & + &2.3282e+02_r8,2.2978e+02_r8,2.2643e+02_r8,2.2243e+02_r8,2.1800e+02_r8/) + kbo(:,17,11) = (/ & + &2.5856e+02_r8,2.5501e+02_r8,2.5085e+02_r8,2.4632e+02_r8,2.4166e+02_r8/) + kbo(:,18,11) = (/ & + &2.8422e+02_r8,2.8031e+02_r8,2.7577e+02_r8,2.7086e+02_r8,2.6564e+02_r8/) + kbo(:,19,11) = (/ & + &3.0919e+02_r8,3.0467e+02_r8,2.9960e+02_r8,2.9432e+02_r8,2.8897e+02_r8/) + kbo(:,20,11) = (/ & + &3.3207e+02_r8,3.2741e+02_r8,3.2245e+02_r8,3.1728e+02_r8,3.1181e+02_r8/) + kbo(:,21,11) = (/ & + &3.5360e+02_r8,3.4929e+02_r8,3.4457e+02_r8,3.3936e+02_r8,3.3368e+02_r8/) + kbo(:,22,11) = (/ & + &3.7366e+02_r8,3.6938e+02_r8,3.6457e+02_r8,3.5924e+02_r8,3.5347e+02_r8/) + kbo(:,23,11) = (/ & + &3.9151e+02_r8,3.8745e+02_r8,3.8282e+02_r8,3.7760e+02_r8,3.7188e+02_r8/) + kbo(:,24,11) = (/ & + &4.0699e+02_r8,4.0355e+02_r8,3.9930e+02_r8,3.9428e+02_r8,3.8859e+02_r8/) + kbo(:,25,11) = (/ & + &4.2010e+02_r8,4.1762e+02_r8,4.1382e+02_r8,4.0900e+02_r8,4.0333e+02_r8/) + kbo(:,26,11) = (/ & + &4.3097e+02_r8,4.2949e+02_r8,4.2634e+02_r8,4.2177e+02_r8,4.1610e+02_r8/) + kbo(:,27,11) = (/ & + &4.4020e+02_r8,4.3958e+02_r8,4.3704e+02_r8,4.3277e+02_r8,4.2718e+02_r8/) + kbo(:,28,11) = (/ & + &4.4818e+02_r8,4.4821e+02_r8,4.4611e+02_r8,4.4212e+02_r8,4.3652e+02_r8/) + kbo(:,29,11) = (/ & + &4.5504e+02_r8,4.5548e+02_r8,4.5376e+02_r8,4.4984e+02_r8,4.4415e+02_r8/) + kbo(:,30,11) = (/ & + &4.6091e+02_r8,4.6162e+02_r8,4.6010e+02_r8,4.5616e+02_r8,4.5025e+02_r8/) + kbo(:,31,11) = (/ & + &4.6598e+02_r8,4.6680e+02_r8,4.6528e+02_r8,4.6118e+02_r8,4.5498e+02_r8/) + kbo(:,32,11) = (/ & + &4.7040e+02_r8,4.7120e+02_r8,4.6944e+02_r8,4.6509e+02_r8,4.5862e+02_r8/) + kbo(:,33,11) = (/ & + &4.7430e+02_r8,4.7493e+02_r8,4.7283e+02_r8,4.6810e+02_r8,4.6122e+02_r8/) + kbo(:,34,11) = (/ & + &4.7770e+02_r8,4.7802e+02_r8,4.7557e+02_r8,4.7044e+02_r8,4.6319e+02_r8/) + kbo(:,35,11) = (/ & + &4.8041e+02_r8,4.8064e+02_r8,4.7804e+02_r8,4.7275e+02_r8,4.6531e+02_r8/) + kbo(:,36,11) = (/ & + &4.8253e+02_r8,4.8296e+02_r8,4.8047e+02_r8,4.7521e+02_r8,4.6778e+02_r8/) + kbo(:,37,11) = (/ & + &4.8393e+02_r8,4.8502e+02_r8,4.8301e+02_r8,4.7821e+02_r8,4.7102e+02_r8/) + kbo(:,38,11) = (/ & + &4.8486e+02_r8,4.8663e+02_r8,4.8514e+02_r8,4.8082e+02_r8,4.7394e+02_r8/) + kbo(:,39,11) = (/ & + &4.8541e+02_r8,4.8785e+02_r8,4.8691e+02_r8,4.8302e+02_r8,4.7647e+02_r8/) + kbo(:,40,11) = (/ & + &4.8510e+02_r8,4.8864e+02_r8,4.8854e+02_r8,4.8540e+02_r8,4.7945e+02_r8/) + kbo(:,41,11) = (/ & + &4.8418e+02_r8,4.8891e+02_r8,4.8975e+02_r8,4.8740e+02_r8,4.8219e+02_r8/) + kbo(:,42,11) = (/ & + &4.8279e+02_r8,4.8873e+02_r8,4.9057e+02_r8,4.8904e+02_r8,4.8458e+02_r8/) + kbo(:,43,11) = (/ & + &4.8041e+02_r8,4.8782e+02_r8,4.9100e+02_r8,4.9049e+02_r8,4.8682e+02_r8/) + kbo(:,44,11) = (/ & + &4.7714e+02_r8,4.8618e+02_r8,4.9081e+02_r8,4.9150e+02_r8,4.8756e+02_r8/) + kbo(:,45,11) = (/ & + &4.7308e+02_r8,4.8395e+02_r8,4.9007e+02_r8,4.9204e+02_r8,4.8671e+02_r8/) + kbo(:,46,11) = (/ & + &4.6783e+02_r8,4.8086e+02_r8,4.8862e+02_r8,4.9205e+02_r8,4.8480e+02_r8/) + kbo(:,47,11) = (/ & + &4.6080e+02_r8,4.7644e+02_r8,4.8623e+02_r8,4.9139e+02_r8,4.8469e+02_r8/) + kbo(:,48,11) = (/ & + &4.5259e+02_r8,4.7102e+02_r8,4.8306e+02_r8,4.9003e+02_r8,4.8230e+02_r8/) + kbo(:,49,11) = (/ & + &4.4320e+02_r8,4.6445e+02_r8,4.7901e+02_r8,4.8786e+02_r8,4.7807e+02_r8/) + kbo(:,50,11) = (/ & + &4.3321e+02_r8,4.5728e+02_r8,4.7435e+02_r8,4.8518e+02_r8,4.7550e+02_r8/) + kbo(:,51,11) = (/ & + &4.2248e+02_r8,4.4931e+02_r8,4.6891e+02_r8,4.8193e+02_r8,4.7366e+02_r8/) + kbo(:,52,11) = (/ & + &4.1065e+02_r8,4.4034e+02_r8,4.6257e+02_r8,4.7793e+02_r8,4.7004e+02_r8/) + kbo(:,53,11) = (/ & + &3.9765e+02_r8,4.3037e+02_r8,4.5526e+02_r8,4.7213e+02_r8,4.6510e+02_r8/) + kbo(:,54,11) = (/ & + &3.8467e+02_r8,4.2027e+02_r8,4.4777e+02_r8,4.6790e+02_r8,4.6484e+02_r8/) + kbo(:,55,11) = (/ & + &3.7132e+02_r8,4.0974e+02_r8,4.3973e+02_r8,4.6220e+02_r8,4.6820e+02_r8/) + kbo(:,56,11) = (/ & + &3.5710e+02_r8,3.9837e+02_r8,4.3097e+02_r8,4.5580e+02_r8,4.7038e+02_r8/) + kbo(:,57,11) = (/ & + &3.4209e+02_r8,3.8602e+02_r8,4.2139e+02_r8,4.4866e+02_r8,4.6860e+02_r8/) + kbo(:,58,11) = (/ & + &3.2702e+02_r8,3.7354e+02_r8,4.1153e+02_r8,4.4115e+02_r8,4.6327e+02_r8/) + kbo(:,59,11) = (/ & + &3.2074e+02_r8,3.6827e+02_r8,4.0735e+02_r8,4.3797e+02_r8,4.6099e+02_r8/) + kbo(:,13,12) = (/ & + &1.8437e+02_r8,1.8201e+02_r8,1.7920e+02_r8,1.7619e+02_r8,1.7262e+02_r8/) + kbo(:,14,12) = (/ & + &2.0920e+02_r8,2.0655e+02_r8,2.0368e+02_r8,2.0039e+02_r8,1.9660e+02_r8/) + kbo(:,15,12) = (/ & + &2.3807e+02_r8,2.3483e+02_r8,2.3126e+02_r8,2.2723e+02_r8,2.2261e+02_r8/) + kbo(:,16,12) = (/ & + &2.7050e+02_r8,2.6622e+02_r8,2.6148e+02_r8,2.5668e+02_r8,2.5203e+02_r8/) + kbo(:,17,12) = (/ & + &3.0550e+02_r8,3.0047e+02_r8,2.9528e+02_r8,2.8984e+02_r8,2.8414e+02_r8/) + kbo(:,18,12) = (/ & + &3.4308e+02_r8,3.3718e+02_r8,3.3104e+02_r8,3.2458e+02_r8,3.1787e+02_r8/) + kbo(:,19,12) = (/ & + &3.8177e+02_r8,3.7532e+02_r8,3.6857e+02_r8,3.6127e+02_r8,3.5363e+02_r8/) + kbo(:,20,12) = (/ & + &4.2186e+02_r8,4.1506e+02_r8,4.0728e+02_r8,3.9905e+02_r8,3.9052e+02_r8/) + kbo(:,21,12) = (/ & + &4.6246e+02_r8,4.5454e+02_r8,4.4606e+02_r8,4.3704e+02_r8,4.2747e+02_r8/) + kbo(:,22,12) = (/ & + &5.0135e+02_r8,4.9292e+02_r8,4.8363e+02_r8,4.7369e+02_r8,4.6338e+02_r8/) + kbo(:,23,12) = (/ & + &5.3861e+02_r8,5.2961e+02_r8,5.1962e+02_r8,5.0894e+02_r8,4.9767e+02_r8/) + kbo(:,24,12) = (/ & + &5.7338e+02_r8,5.6389e+02_r8,5.5338e+02_r8,5.4189e+02_r8,5.2932e+02_r8/) + kbo(:,25,12) = (/ & + &6.0539e+02_r8,5.9528e+02_r8,5.8404e+02_r8,5.7158e+02_r8,5.5798e+02_r8/) + kbo(:,26,12) = (/ & + &6.3403e+02_r8,6.2334e+02_r8,6.1112e+02_r8,5.9770e+02_r8,5.8310e+02_r8/) + kbo(:,27,12) = (/ & + &6.5936e+02_r8,6.4795e+02_r8,6.3483e+02_r8,6.2036e+02_r8,6.0455e+02_r8/) + kbo(:,28,12) = (/ & + &6.8125e+02_r8,6.6919e+02_r8,6.5513e+02_r8,6.3951e+02_r8,6.2260e+02_r8/) + kbo(:,29,12) = (/ & + &6.9998e+02_r8,6.8712e+02_r8,6.7207e+02_r8,6.5530e+02_r8,6.3734e+02_r8/) + kbo(:,30,12) = (/ & + &7.1583e+02_r8,7.0209e+02_r8,6.8590e+02_r8,6.6805e+02_r8,6.4904e+02_r8/) + kbo(:,31,12) = (/ & + &7.2876e+02_r8,7.1404e+02_r8,6.9677e+02_r8,6.7790e+02_r8,6.5793e+02_r8/) + kbo(:,32,12) = (/ & + &7.3900e+02_r8,7.2324e+02_r8,7.0493e+02_r8,6.8513e+02_r8,6.6427e+02_r8/) + kbo(:,33,12) = (/ & + &7.4681e+02_r8,7.2991e+02_r8,7.1072e+02_r8,6.9001e+02_r8,6.6847e+02_r8/) + kbo(:,34,12) = (/ & + &7.5291e+02_r8,7.3522e+02_r8,7.1519e+02_r8,6.9374e+02_r8,6.7158e+02_r8/) + kbo(:,35,12) = (/ & + &7.5888e+02_r8,7.4060e+02_r8,7.1995e+02_r8,6.9804e+02_r8,6.7534e+02_r8/) + kbo(:,36,12) = (/ & + &7.6530e+02_r8,7.4674e+02_r8,7.2578e+02_r8,7.0348e+02_r8,6.8047e+02_r8/) + kbo(:,37,12) = (/ & + &7.7324e+02_r8,7.5477e+02_r8,7.3385e+02_r8,7.1142e+02_r8,6.8821e+02_r8/) + kbo(:,38,12) = (/ & + &7.8031e+02_r8,7.6209e+02_r8,7.4126e+02_r8,7.1874e+02_r8,6.9540e+02_r8/) + kbo(:,39,12) = (/ & + &7.8648e+02_r8,7.6857e+02_r8,7.4796e+02_r8,7.2542e+02_r8,7.0198e+02_r8/) + kbo(:,40,12) = (/ & + &7.9353e+02_r8,7.7637e+02_r8,7.5617e+02_r8,7.3391e+02_r8,7.1045e+02_r8/) + kbo(:,41,12) = (/ & + &7.9989e+02_r8,7.8377e+02_r8,7.6410e+02_r8,7.4214e+02_r8,7.1879e+02_r8/) + kbo(:,42,12) = (/ & + &8.0558e+02_r8,7.9048e+02_r8,7.7152e+02_r8,7.4994e+02_r8,7.2677e+02_r8/) + kbo(:,43,12) = (/ & + &8.1116e+02_r8,7.9747e+02_r8,7.7955e+02_r8,7.5862e+02_r8,7.3574e+02_r8/) + kbo(:,44,12) = (/ & + &8.1607e+02_r8,8.0410e+02_r8,7.8744e+02_r8,7.6731e+02_r8,7.4497e+02_r8/) + kbo(:,45,12) = (/ & + &8.1994e+02_r8,8.0997e+02_r8,7.9477e+02_r8,7.7561e+02_r8,7.5385e+02_r8/) + kbo(:,46,12) = (/ & + &8.2292e+02_r8,8.1527e+02_r8,8.0168e+02_r8,7.8384e+02_r8,7.6285e+02_r8/) + kbo(:,47,12) = (/ & + &8.2480e+02_r8,8.1993e+02_r8,8.0858e+02_r8,7.9229e+02_r8,7.7235e+02_r8/) + kbo(:,48,12) = (/ & + &8.2522e+02_r8,8.2345e+02_r8,8.1455e+02_r8,8.0002e+02_r8,7.8135e+02_r8/) + kbo(:,49,12) = (/ & + &8.2404e+02_r8,8.2558e+02_r8,8.1941e+02_r8,8.0697e+02_r8,7.8982e+02_r8/) + kbo(:,50,12) = (/ & + &8.2131e+02_r8,8.2647e+02_r8,8.2301e+02_r8,8.1277e+02_r8,7.9722e+02_r8/) + kbo(:,51,12) = (/ & + &8.1699e+02_r8,8.2604e+02_r8,8.2550e+02_r8,8.1759e+02_r8,8.0380e+02_r8/) + kbo(:,52,12) = (/ & + &8.1118e+02_r8,8.2427e+02_r8,8.2691e+02_r8,8.2151e+02_r8,8.0969e+02_r8/) + kbo(:,53,12) = (/ & + &8.0369e+02_r8,8.2099e+02_r8,8.2725e+02_r8,8.2455e+02_r8,8.1493e+02_r8/) + kbo(:,54,12) = (/ & + &7.9519e+02_r8,8.1662e+02_r8,8.2647e+02_r8,8.2649e+02_r8,8.1904e+02_r8/) + kbo(:,55,12) = (/ & + &7.8525e+02_r8,8.1122e+02_r8,8.2466e+02_r8,8.2753e+02_r8,8.2231e+02_r8/) + kbo(:,56,12) = (/ & + &7.7348e+02_r8,8.0460e+02_r8,8.2163e+02_r8,8.2776e+02_r8,8.2487e+02_r8/) + kbo(:,57,12) = (/ & + &7.5991e+02_r8,7.9652e+02_r8,8.1752e+02_r8,8.2701e+02_r8,8.2675e+02_r8/) + kbo(:,58,12) = (/ & + &7.4511e+02_r8,7.8730e+02_r8,8.1251e+02_r8,8.2536e+02_r8,8.2776e+02_r8/) + kbo(:,59,12) = (/ & + &7.3866e+02_r8,7.8320e+02_r8,8.1026e+02_r8,8.2449e+02_r8,8.2800e+02_r8/) + kbo(:,13,13) = (/ & + &2.0724e+02_r8,2.0318e+02_r8,2.0003e+02_r8,1.9694e+02_r8,1.9365e+02_r8/) + kbo(:,14,13) = (/ & + &2.3785e+02_r8,2.3358e+02_r8,2.2976e+02_r8,2.2561e+02_r8,2.2123e+02_r8/) + kbo(:,15,13) = (/ & + &2.7371e+02_r8,2.6880e+02_r8,2.6365e+02_r8,2.5854e+02_r8,2.5349e+02_r8/) + kbo(:,16,13) = (/ & + &3.1341e+02_r8,3.0766e+02_r8,3.0218e+02_r8,2.9651e+02_r8,2.9050e+02_r8/) + kbo(:,17,13) = (/ & + &3.5823e+02_r8,3.5167e+02_r8,3.4512e+02_r8,3.3848e+02_r8,3.3144e+02_r8/) + kbo(:,18,13) = (/ & + &4.0795e+02_r8,4.0075e+02_r8,3.9354e+02_r8,3.8585e+02_r8,3.7775e+02_r8/) + kbo(:,19,13) = (/ & + &4.6454e+02_r8,4.5636e+02_r8,4.4761e+02_r8,4.3852e+02_r8,4.2883e+02_r8/) + kbo(:,20,13) = (/ & + &5.2670e+02_r8,5.1674e+02_r8,5.0627e+02_r8,4.9500e+02_r8,4.8317e+02_r8/) + kbo(:,21,13) = (/ & + &5.9234e+02_r8,5.8071e+02_r8,5.6797e+02_r8,5.5430e+02_r8,5.3997e+02_r8/) + kbo(:,22,13) = (/ & + &6.5952e+02_r8,6.4514e+02_r8,6.2980e+02_r8,6.1347e+02_r8,5.9629e+02_r8/) + kbo(:,23,13) = (/ & + &7.2668e+02_r8,7.0946e+02_r8,6.9096e+02_r8,6.7135e+02_r8,6.5090e+02_r8/) + kbo(:,24,13) = (/ & + &7.9179e+02_r8,7.7144e+02_r8,7.4939e+02_r8,7.2625e+02_r8,7.0273e+02_r8/) + kbo(:,25,13) = (/ & + &8.5340e+02_r8,8.2954e+02_r8,8.0385e+02_r8,7.7737e+02_r8,7.5044e+02_r8/) + kbo(:,26,13) = (/ & + &9.1011e+02_r8,8.8231e+02_r8,8.5326e+02_r8,8.2331e+02_r8,7.9319e+02_r8/) + kbo(:,27,13) = (/ & + &9.6106e+02_r8,9.2973e+02_r8,8.9712e+02_r8,8.6391e+02_r8,8.3062e+02_r8/) + kbo(:,28,13) = (/ & + &1.0059e+03_r8,9.7091e+02_r8,9.3507e+02_r8,8.9869e+02_r8,8.6233e+02_r8/) + kbo(:,29,13) = (/ & + &1.0437e+03_r8,1.0055e+03_r8,9.6641e+02_r8,9.2715e+02_r8,8.8802e+02_r8/) + kbo(:,30,13) = (/ & + &1.0747e+03_r8,1.0334e+03_r8,9.9156e+02_r8,9.4965e+02_r8,9.0810e+02_r8/) + kbo(:,31,13) = (/ & + &1.0990e+03_r8,1.0548e+03_r8,1.0106e+03_r8,9.6642e+02_r8,9.2291e+02_r8/) + kbo(:,32,13) = (/ & + &1.1170e+03_r8,1.0705e+03_r8,1.0242e+03_r8,9.7810e+02_r8,9.3290e+02_r8/) + kbo(:,33,13) = (/ & + &1.1295e+03_r8,1.0810e+03_r8,1.0329e+03_r8,9.8524e+02_r8,9.3872e+02_r8/) + kbo(:,34,13) = (/ & + &1.1390e+03_r8,1.0889e+03_r8,1.0392e+03_r8,9.9037e+02_r8,9.4276e+02_r8/) + kbo(:,35,13) = (/ & + &1.1495e+03_r8,1.0980e+03_r8,1.0471e+03_r8,9.9723e+02_r8,9.4859e+02_r8/) + kbo(:,36,13) = (/ & + &1.1627e+03_r8,1.1100e+03_r8,1.0580e+03_r8,1.0071e+03_r8,9.5754e+02_r8/) + kbo(:,37,13) = (/ & + &1.1817e+03_r8,1.1279e+03_r8,1.0749e+03_r8,1.0229e+03_r8,9.7232e+02_r8/) + kbo(:,38,13) = (/ & + &1.1995e+03_r8,1.1446e+03_r8,1.0907e+03_r8,1.0378e+03_r8,9.8626e+02_r8/) + kbo(:,39,13) = (/ & + &1.2156e+03_r8,1.1601e+03_r8,1.1053e+03_r8,1.0516e+03_r8,9.9926e+02_r8/) + kbo(:,40,13) = (/ & + &1.2364e+03_r8,1.1800e+03_r8,1.1244e+03_r8,1.0699e+03_r8,1.0167e+03_r8/) + kbo(:,41,13) = (/ & + &1.2568e+03_r8,1.1999e+03_r8,1.1435e+03_r8,1.0883e+03_r8,1.0343e+03_r8/) + kbo(:,42,13) = (/ & + &1.2764e+03_r8,1.2191e+03_r8,1.1621e+03_r8,1.1062e+03_r8,1.0515e+03_r8/) + kbo(:,43,13) = (/ & + &1.2983e+03_r8,1.2411e+03_r8,1.1834e+03_r8,1.1268e+03_r8,1.0715e+03_r8/) + kbo(:,44,13) = (/ & + &1.3210e+03_r8,1.2639e+03_r8,1.2059e+03_r8,1.1485e+03_r8,1.0925e+03_r8/) + kbo(:,45,13) = (/ & + &1.3430e+03_r8,1.2862e+03_r8,1.2280e+03_r8,1.1702e+03_r8,1.1134e+03_r8/) + kbo(:,46,13) = (/ & + &1.3658e+03_r8,1.3092e+03_r8,1.2511e+03_r8,1.1929e+03_r8,1.1355e+03_r8/) + kbo(:,47,13) = (/ & + &1.3902e+03_r8,1.3342e+03_r8,1.2766e+03_r8,1.2180e+03_r8,1.1600e+03_r8/) + kbo(:,48,13) = (/ & + &1.4137e+03_r8,1.3587e+03_r8,1.3015e+03_r8,1.2430e+03_r8,1.1845e+03_r8/) + kbo(:,49,13) = (/ & + &1.4360e+03_r8,1.3827e+03_r8,1.3260e+03_r8,1.2679e+03_r8,1.2090e+03_r8/) + kbo(:,50,13) = (/ & + &1.4561e+03_r8,1.4046e+03_r8,1.3487e+03_r8,1.2910e+03_r8,1.2321e+03_r8/) + kbo(:,51,13) = (/ & + &1.4745e+03_r8,1.4251e+03_r8,1.3704e+03_r8,1.3131e+03_r8,1.2546e+03_r8/) + kbo(:,52,13) = (/ & + &1.4914e+03_r8,1.4448e+03_r8,1.3917e+03_r8,1.3349e+03_r8,1.2767e+03_r8/) + kbo(:,53,13) = (/ & + &1.5066e+03_r8,1.4635e+03_r8,1.4124e+03_r8,1.3565e+03_r8,1.2987e+03_r8/) + kbo(:,54,13) = (/ & + &1.5189e+03_r8,1.4798e+03_r8,1.4307e+03_r8,1.3761e+03_r8,1.3187e+03_r8/) + kbo(:,55,13) = (/ & + &1.5296e+03_r8,1.4942e+03_r8,1.4476e+03_r8,1.3946e+03_r8,1.3376e+03_r8/) + kbo(:,56,13) = (/ & + &1.5385e+03_r8,1.5073e+03_r8,1.4637e+03_r8,1.4124e+03_r8,1.3564e+03_r8/) + kbo(:,57,13) = (/ & + &1.5454e+03_r8,1.5190e+03_r8,1.4793e+03_r8,1.4298e+03_r8,1.3750e+03_r8/) + kbo(:,58,13) = (/ & + &1.5501e+03_r8,1.5291e+03_r8,1.4929e+03_r8,1.4457e+03_r8,1.3924e+03_r8/) + kbo(:,59,13) = (/ & + &1.5515e+03_r8,1.5328e+03_r8,1.4982e+03_r8,1.4521e+03_r8,1.3993e+03_r8/) + kbo(:,13,14) = (/ & + &2.5226e+02_r8,2.4628e+02_r8,2.3949e+02_r8,2.3300e+02_r8,2.2711e+02_r8/) + kbo(:,14,14) = (/ & + &2.8391e+02_r8,2.7613e+02_r8,2.6825e+02_r8,2.6100e+02_r8,2.5461e+02_r8/) + kbo(:,15,14) = (/ & + &3.2054e+02_r8,3.1155e+02_r8,3.0330e+02_r8,2.9588e+02_r8,2.8901e+02_r8/) + kbo(:,16,14) = (/ & + &3.6563e+02_r8,3.5616e+02_r8,3.4734e+02_r8,3.3914e+02_r8,3.3106e+02_r8/) + kbo(:,17,14) = (/ & + &4.2096e+02_r8,4.1081e+02_r8,4.0125e+02_r8,3.9214e+02_r8,3.8323e+02_r8/) + kbo(:,18,14) = (/ & + &4.8740e+02_r8,4.7626e+02_r8,4.6528e+02_r8,4.5466e+02_r8,4.4412e+02_r8/) + kbo(:,19,14) = (/ & + &5.6419e+02_r8,5.5097e+02_r8,5.3827e+02_r8,5.2557e+02_r8,5.1276e+02_r8/) + kbo(:,20,14) = (/ & + &6.5011e+02_r8,6.3415e+02_r8,6.1868e+02_r8,6.0321e+02_r8,5.8733e+02_r8/) + kbo(:,21,14) = (/ & + &7.4435e+02_r8,7.2484e+02_r8,7.0550e+02_r8,6.8621e+02_r8,6.6643e+02_r8/) + kbo(:,22,14) = (/ & + &8.4421e+02_r8,8.2013e+02_r8,7.9603e+02_r8,7.7185e+02_r8,7.4730e+02_r8/) + kbo(:,23,14) = (/ & + &9.4857e+02_r8,9.1895e+02_r8,8.8918e+02_r8,8.5916e+02_r8,8.2913e+02_r8/) + kbo(:,24,14) = (/ & + &1.0549e+03_r8,1.0183e+03_r8,9.8186e+02_r8,9.4534e+02_r8,9.0882e+02_r8/) + kbo(:,25,14) = (/ & + &1.1590e+03_r8,1.1145e+03_r8,1.0708e+03_r8,1.0270e+03_r8,9.8371e+02_r8/) + kbo(:,26,14) = (/ & + &1.2562e+03_r8,1.2038e+03_r8,1.1521e+03_r8,1.1010e+03_r8,1.0508e+03_r8/) + kbo(:,27,14) = (/ & + &1.3447e+03_r8,1.2836e+03_r8,1.2238e+03_r8,1.1655e+03_r8,1.1088e+03_r8/) + kbo(:,28,14) = (/ & + &1.4217e+03_r8,1.3523e+03_r8,1.2847e+03_r8,1.2199e+03_r8,1.1573e+03_r8/) + kbo(:,29,14) = (/ & + &1.4859e+03_r8,1.4088e+03_r8,1.3346e+03_r8,1.2639e+03_r8,1.1961e+03_r8/) + kbo(:,30,14) = (/ & + &1.5380e+03_r8,1.4539e+03_r8,1.3740e+03_r8,1.2981e+03_r8,1.2259e+03_r8/) + kbo(:,31,14) = (/ & + &1.5776e+03_r8,1.4880e+03_r8,1.4031e+03_r8,1.3231e+03_r8,1.2472e+03_r8/) + kbo(:,32,14) = (/ & + &1.6062e+03_r8,1.5119e+03_r8,1.4231e+03_r8,1.3398e+03_r8,1.2610e+03_r8/) + kbo(:,33,14) = (/ & + &1.6248e+03_r8,1.5270e+03_r8,1.4353e+03_r8,1.3494e+03_r8,1.2686e+03_r8/) + kbo(:,34,14) = (/ & + &1.6386e+03_r8,1.5378e+03_r8,1.4439e+03_r8,1.3560e+03_r8,1.2737e+03_r8/) + kbo(:,35,14) = (/ & + &1.6557e+03_r8,1.5522e+03_r8,1.4559e+03_r8,1.3661e+03_r8,1.2821e+03_r8/) + kbo(:,36,14) = (/ & + &1.6790e+03_r8,1.5727e+03_r8,1.4740e+03_r8,1.3819e+03_r8,1.2962e+03_r8/) + kbo(:,37,14) = (/ & + &1.7154e+03_r8,1.6055e+03_r8,1.5035e+03_r8,1.4086e+03_r8,1.3204e+03_r8/) + kbo(:,38,14) = (/ & + &1.7499e+03_r8,1.6367e+03_r8,1.5316e+03_r8,1.4342e+03_r8,1.3436e+03_r8/) + kbo(:,39,14) = (/ & + &1.7821e+03_r8,1.6659e+03_r8,1.5579e+03_r8,1.4580e+03_r8,1.3653e+03_r8/) + kbo(:,40,14) = (/ & + &1.8250e+03_r8,1.7051e+03_r8,1.5937e+03_r8,1.4906e+03_r8,1.3951e+03_r8/) + kbo(:,41,14) = (/ & + &1.8687e+03_r8,1.7449e+03_r8,1.6302e+03_r8,1.5239e+03_r8,1.4257e+03_r8/) + kbo(:,42,14) = (/ & + &1.9118e+03_r8,1.7843e+03_r8,1.6662e+03_r8,1.5570e+03_r8,1.4560e+03_r8/) + kbo(:,43,14) = (/ & + &1.9625e+03_r8,1.8305e+03_r8,1.7087e+03_r8,1.5959e+03_r8,1.4917e+03_r8/) + kbo(:,44,14) = (/ & + &2.0169e+03_r8,1.8802e+03_r8,1.7544e+03_r8,1.6379e+03_r8,1.5302e+03_r8/) + kbo(:,45,14) = (/ & + &2.0719e+03_r8,1.9306e+03_r8,1.8005e+03_r8,1.6804e+03_r8,1.5693e+03_r8/) + kbo(:,46,14) = (/ & + &2.1310e+03_r8,1.9850e+03_r8,1.8502e+03_r8,1.7262e+03_r8,1.6114e+03_r8/) + kbo(:,47,14) = (/ & + &2.1977e+03_r8,2.0465e+03_r8,1.9066e+03_r8,1.7781e+03_r8,1.6592e+03_r8/) + kbo(:,48,14) = (/ & + &2.2663e+03_r8,2.1096e+03_r8,1.9646e+03_r8,1.8312e+03_r8,1.7082e+03_r8/) + kbo(:,49,14) = (/ & + &2.3369e+03_r8,2.1743e+03_r8,2.0243e+03_r8,1.8859e+03_r8,1.7586e+03_r8/) + kbo(:,50,14) = (/ & + &2.4050e+03_r8,2.2366e+03_r8,2.0818e+03_r8,1.9387e+03_r8,1.8071e+03_r8/) + kbo(:,51,14) = (/ & + &2.4725e+03_r8,2.2988e+03_r8,2.1390e+03_r8,1.9914e+03_r8,1.8554e+03_r8/) + kbo(:,52,14) = (/ & + &2.5415e+03_r8,2.3629e+03_r8,2.1974e+03_r8,2.0453e+03_r8,1.9050e+03_r8/) + kbo(:,53,14) = (/ & + &2.6121e+03_r8,2.4283e+03_r8,2.2576e+03_r8,2.1009e+03_r8,1.9561e+03_r8/) + kbo(:,54,14) = (/ & + &2.6782e+03_r8,2.4899e+03_r8,2.3146e+03_r8,2.1531e+03_r8,2.0043e+03_r8/) + kbo(:,55,14) = (/ & + &2.7428e+03_r8,2.5502e+03_r8,2.3706e+03_r8,2.2044e+03_r8,2.0516e+03_r8/) + kbo(:,56,14) = (/ & + &2.8087e+03_r8,2.6116e+03_r8,2.4275e+03_r8,2.2567e+03_r8,2.0999e+03_r8/) + kbo(:,57,14) = (/ & + &2.8759e+03_r8,2.6742e+03_r8,2.4859e+03_r8,2.3106e+03_r8,2.1494e+03_r8/) + kbo(:,58,14) = (/ & + &2.9406e+03_r8,2.7347e+03_r8,2.5423e+03_r8,2.3630e+03_r8,2.1974e+03_r8/) + kbo(:,59,14) = (/ & + &2.9672e+03_r8,2.7595e+03_r8,2.5656e+03_r8,2.3846e+03_r8,2.2171e+03_r8/) + kbo(:,13,15) = (/ & + &3.0519e+02_r8,3.0114e+02_r8,2.9666e+02_r8,2.9142e+02_r8,2.8521e+02_r8/) + kbo(:,14,15) = (/ & + &3.4479e+02_r8,3.4114e+02_r8,3.3631e+02_r8,3.3085e+02_r8,3.2433e+02_r8/) + kbo(:,15,15) = (/ & + &3.8993e+02_r8,3.8674e+02_r8,3.8200e+02_r8,3.7573e+02_r8,3.6825e+02_r8/) + kbo(:,16,15) = (/ & + &4.4412e+02_r8,4.3994e+02_r8,4.3428e+02_r8,4.2699e+02_r8,4.1897e+02_r8/) + kbo(:,17,15) = (/ & + &5.0918e+02_r8,5.0358e+02_r8,4.9594e+02_r8,4.8667e+02_r8,4.7654e+02_r8/) + kbo(:,18,15) = (/ & + &5.8800e+02_r8,5.7963e+02_r8,5.6899e+02_r8,5.5650e+02_r8,5.4319e+02_r8/) + kbo(:,19,15) = (/ & + &6.8137e+02_r8,6.6869e+02_r8,6.5385e+02_r8,6.3714e+02_r8,6.1975e+02_r8/) + kbo(:,20,15) = (/ & + &7.8942e+02_r8,7.7129e+02_r8,7.5076e+02_r8,7.2873e+02_r8,7.0666e+02_r8/) + kbo(:,21,15) = (/ & + &9.1222e+02_r8,8.8683e+02_r8,8.5955e+02_r8,8.3129e+02_r8,8.0321e+02_r8/) + kbo(:,22,15) = (/ & + &1.0462e+03_r8,1.0122e+03_r8,9.7665e+02_r8,9.4080e+02_r8,9.0511e+02_r8/) + kbo(:,23,15) = (/ & + &1.1896e+03_r8,1.1445e+03_r8,1.0990e+03_r8,1.0540e+03_r8,1.0094e+03_r8/) + kbo(:,24,15) = (/ & + &1.3365e+03_r8,1.2790e+03_r8,1.2222e+03_r8,1.1664e+03_r8,1.1117e+03_r8/) + kbo(:,25,15) = (/ & + &1.4807e+03_r8,1.4091e+03_r8,1.3391e+03_r8,1.2717e+03_r8,1.2073e+03_r8/) + kbo(:,26,15) = (/ & + &1.6156e+03_r8,1.5289e+03_r8,1.4461e+03_r8,1.3673e+03_r8,1.2929e+03_r8/) + kbo(:,27,15) = (/ & + &1.7387e+03_r8,1.6377e+03_r8,1.5427e+03_r8,1.4535e+03_r8,1.3699e+03_r8/) + kbo(:,28,15) = (/ & + &1.8481e+03_r8,1.7337e+03_r8,1.6274e+03_r8,1.5282e+03_r8,1.4358e+03_r8/) + kbo(:,29,15) = (/ & + &1.9406e+03_r8,1.8143e+03_r8,1.6975e+03_r8,1.5890e+03_r8,1.4891e+03_r8/) + kbo(:,30,15) = (/ & + &2.0157e+03_r8,1.8789e+03_r8,1.7529e+03_r8,1.6367e+03_r8,1.5303e+03_r8/) + kbo(:,31,15) = (/ & + &2.0726e+03_r8,1.9271e+03_r8,1.7935e+03_r8,1.6714e+03_r8,1.5596e+03_r8/) + kbo(:,32,15) = (/ & + &2.1128e+03_r8,1.9603e+03_r8,1.8210e+03_r8,1.6943e+03_r8,1.5785e+03_r8/) + kbo(:,33,15) = (/ & + &2.1379e+03_r8,1.9802e+03_r8,1.8368e+03_r8,1.7069e+03_r8,1.5884e+03_r8/) + kbo(:,34,15) = (/ & + &2.1559e+03_r8,1.9943e+03_r8,1.8478e+03_r8,1.7154e+03_r8,1.5948e+03_r8/) + kbo(:,35,15) = (/ & + &2.1801e+03_r8,2.0143e+03_r8,1.8645e+03_r8,1.7293e+03_r8,1.6063e+03_r8/) + kbo(:,36,15) = (/ & + &2.2153e+03_r8,2.0448e+03_r8,1.8906e+03_r8,1.7519e+03_r8,1.6260e+03_r8/) + kbo(:,37,15) = (/ & + &2.2726e+03_r8,2.0949e+03_r8,1.9348e+03_r8,1.7908e+03_r8,1.6606e+03_r8/) + kbo(:,38,15) = (/ & + &2.3276e+03_r8,2.1431e+03_r8,1.9773e+03_r8,1.8285e+03_r8,1.6940e+03_r8/) + kbo(:,39,15) = (/ & + &2.3794e+03_r8,2.1884e+03_r8,2.0174e+03_r8,1.8638e+03_r8,1.7255e+03_r8/) + kbo(:,40,15) = (/ & + &2.4500e+03_r8,2.2506e+03_r8,2.0727e+03_r8,1.9128e+03_r8,1.7693e+03_r8/) + kbo(:,41,15) = (/ & + &2.5230e+03_r8,2.3148e+03_r8,2.1296e+03_r8,1.9633e+03_r8,1.8145e+03_r8/) + kbo(:,42,15) = (/ & + &2.5961e+03_r8,2.3790e+03_r8,2.1863e+03_r8,2.0139e+03_r8,1.8595e+03_r8/) + kbo(:,43,15) = (/ & + &2.6832e+03_r8,2.4556e+03_r8,2.2539e+03_r8,2.0744e+03_r8,1.9133e+03_r8/) + kbo(:,44,15) = (/ & + &2.7787e+03_r8,2.5394e+03_r8,2.3280e+03_r8,2.1403e+03_r8,1.9719e+03_r8/) + kbo(:,45,15) = (/ & + &2.8773e+03_r8,2.6257e+03_r8,2.4039e+03_r8,2.2077e+03_r8,2.0320e+03_r8/) + kbo(:,46,15) = (/ & + &2.9856e+03_r8,2.7201e+03_r8,2.4871e+03_r8,2.2811e+03_r8,2.0978e+03_r8/) + kbo(:,47,15) = (/ & + &3.1115e+03_r8,2.8292e+03_r8,2.5830e+03_r8,2.3659e+03_r8,2.1733e+03_r8/) + kbo(:,48,15) = (/ & + &3.2432e+03_r8,2.9440e+03_r8,2.6832e+03_r8,2.4542e+03_r8,2.2517e+03_r8/) + kbo(:,49,15) = (/ & + &3.3819e+03_r8,3.0648e+03_r8,2.7882e+03_r8,2.5466e+03_r8,2.3333e+03_r8/) + kbo(:,50,15) = (/ & + &3.5188e+03_r8,3.1840e+03_r8,2.8918e+03_r8,2.6374e+03_r8,2.4134e+03_r8/) + kbo(:,51,15) = (/ & + &3.6589e+03_r8,3.3051e+03_r8,2.9974e+03_r8,2.7291e+03_r8,2.4943e+03_r8/) + kbo(:,52,15) = (/ & + &3.8062e+03_r8,3.4317e+03_r8,3.1077e+03_r8,2.8252e+03_r8,2.5787e+03_r8/) + kbo(:,53,15) = (/ & + &3.9623e+03_r8,3.5652e+03_r8,3.2237e+03_r8,2.9261e+03_r8,2.6671e+03_r8/) + kbo(:,54,15) = (/ & + &4.1133e+03_r8,3.6940e+03_r8,3.3349e+03_r8,3.0230e+03_r8,2.7515e+03_r8/) + kbo(:,55,15) = (/ & + &4.2651e+03_r8,3.8236e+03_r8,3.4464e+03_r8,3.1202e+03_r8,2.8359e+03_r8/) + kbo(:,56,15) = (/ & + &4.4246e+03_r8,3.9598e+03_r8,3.5625e+03_r8,3.2212e+03_r8,2.9236e+03_r8/) + kbo(:,57,15) = (/ & + &4.5926e+03_r8,4.1026e+03_r8,3.6846e+03_r8,3.3264e+03_r8,3.0154e+03_r8/) + kbo(:,58,15) = (/ & + &4.7612e+03_r8,4.2446e+03_r8,3.8056e+03_r8,3.4306e+03_r8,3.1063e+03_r8/) + kbo(:,59,15) = (/ & + &4.8322e+03_r8,4.3040e+03_r8,3.8565e+03_r8,3.4742e+03_r8,3.1440e+03_r8/) + kbo(:,13,16) = (/ & + &3.6471e+02_r8,3.5203e+02_r8,3.4366e+02_r8,3.3754e+02_r8,3.3391e+02_r8/) + kbo(:,14,16) = (/ & + &4.3205e+02_r8,4.1910e+02_r8,4.0949e+02_r8,4.0181e+02_r8,3.9611e+02_r8/) + kbo(:,15,16) = (/ & + &5.1076e+02_r8,4.9691e+02_r8,4.8535e+02_r8,4.7583e+02_r8,4.6772e+02_r8/) + kbo(:,16,16) = (/ & + &6.0124e+02_r8,5.8532e+02_r8,5.7134e+02_r8,5.5921e+02_r8,5.4786e+02_r8/) + kbo(:,17,16) = (/ & + &7.0293e+02_r8,6.8353e+02_r8,6.6658e+02_r8,6.5132e+02_r8,6.3843e+02_r8/) + kbo(:,18,16) = (/ & + &8.1350e+02_r8,7.9054e+02_r8,7.7108e+02_r8,7.5418e+02_r8,7.3825e+02_r8/) + kbo(:,19,16) = (/ & + &9.3232e+02_r8,9.0753e+02_r8,8.8580e+02_r8,8.6501e+02_r8,8.4456e+02_r8/) + kbo(:,20,16) = (/ & + &1.0608e+03_r8,1.0329e+03_r8,1.0063e+03_r8,9.8009e+02_r8,9.5395e+02_r8/) + kbo(:,21,16) = (/ & + &1.1958e+03_r8,1.1622e+03_r8,1.1292e+03_r8,1.0962e+03_r8,1.0633e+03_r8/) + kbo(:,22,16) = (/ & + &1.3311e+03_r8,1.2897e+03_r8,1.2482e+03_r8,1.2072e+03_r8,1.1676e+03_r8/) + kbo(:,23,16) = (/ & + &1.4683e+03_r8,1.4174e+03_r8,1.3670e+03_r8,1.3170e+03_r8,1.2708e+03_r8/) + kbo(:,24,16) = (/ & + &1.6081e+03_r8,1.5439e+03_r8,1.4829e+03_r8,1.4263e+03_r8,1.3726e+03_r8/) + kbo(:,25,16) = (/ & + &1.7506e+03_r8,1.6769e+03_r8,1.6089e+03_r8,1.5421e+03_r8,1.4771e+03_r8/) + kbo(:,26,16) = (/ & + &1.9057e+03_r8,1.8182e+03_r8,1.7345e+03_r8,1.6548e+03_r8,1.5773e+03_r8/) + kbo(:,27,16) = (/ & + &2.0569e+03_r8,1.9520e+03_r8,1.8523e+03_r8,1.7577e+03_r8,1.6669e+03_r8/) + kbo(:,28,16) = (/ & + &2.1937e+03_r8,2.0714e+03_r8,1.9558e+03_r8,1.8469e+03_r8,1.7437e+03_r8/) + kbo(:,29,16) = (/ & + &2.3109e+03_r8,2.1712e+03_r8,2.0410e+03_r8,1.9197e+03_r8,1.8067e+03_r8/) + kbo(:,30,16) = (/ & + &2.4059e+03_r8,2.2511e+03_r8,2.1086e+03_r8,1.9768e+03_r8,1.8554e+03_r8/) + kbo(:,31,16) = (/ & + &2.4785e+03_r8,2.3110e+03_r8,2.1586e+03_r8,2.0181e+03_r8,1.8908e+03_r8/) + kbo(:,32,16) = (/ & + &2.5298e+03_r8,2.3528e+03_r8,2.1923e+03_r8,2.0454e+03_r8,1.9136e+03_r8/) + kbo(:,33,16) = (/ & + &2.5622e+03_r8,2.3783e+03_r8,2.2119e+03_r8,2.0610e+03_r8,1.9258e+03_r8/) + kbo(:,34,16) = (/ & + &2.5858e+03_r8,2.3964e+03_r8,2.2256e+03_r8,2.0716e+03_r8,1.9341e+03_r8/) + kbo(:,35,16) = (/ & + &2.6161e+03_r8,2.4209e+03_r8,2.2454e+03_r8,2.0882e+03_r8,1.9479e+03_r8/) + kbo(:,36,16) = (/ & + &2.6591e+03_r8,2.4573e+03_r8,2.2765e+03_r8,2.1149e+03_r8,1.9709e+03_r8/) + kbo(:,37,16) = (/ & + &2.7282e+03_r8,2.5168e+03_r8,2.3287e+03_r8,2.1606e+03_r8,2.0108e+03_r8/) + kbo(:,38,16) = (/ & + &2.7948e+03_r8,2.5745e+03_r8,2.3791e+03_r8,2.2045e+03_r8,2.0494e+03_r8/) + kbo(:,39,16) = (/ & + &2.8577e+03_r8,2.6290e+03_r8,2.4266e+03_r8,2.2455e+03_r8,2.0858e+03_r8/) + kbo(:,40,16) = (/ & + &2.9439e+03_r8,2.7038e+03_r8,2.4920e+03_r8,2.3032e+03_r8,2.1363e+03_r8/) + kbo(:,41,16) = (/ & + &3.0330e+03_r8,2.7810e+03_r8,2.5596e+03_r8,2.3632e+03_r8,2.1888e+03_r8/) + kbo(:,42,16) = (/ & + &3.1221e+03_r8,2.8586e+03_r8,2.6274e+03_r8,2.4230e+03_r8,2.2411e+03_r8/) + kbo(:,43,16) = (/ & + &3.2294e+03_r8,2.9518e+03_r8,2.6848e+03_r8,2.4944e+03_r8,2.3041e+03_r8/) + kbo(:,44,16) = (/ & + &3.3475e+03_r8,3.0539e+03_r8,2.7976e+03_r8,2.5728e+03_r8,2.3737e+03_r8/) + kbo(:,45,16) = (/ & + &3.4703e+03_r8,3.1592e+03_r8,2.8896e+03_r8,2.6532e+03_r8,2.4448e+03_r8/) + kbo(:,46,16) = (/ & + &3.6062e+03_r8,3.2757e+03_r8,2.9905e+03_r8,2.7415e+03_r8,2.5226e+03_r8/) + kbo(:,47,16) = (/ & + &3.7659e+03_r8,3.4109e+03_r8,3.1077e+03_r8,2.8434e+03_r8,2.6124e+03_r8/) + kbo(:,48,16) = (/ & + &3.9357e+03_r8,3.5542e+03_r8,3.2307e+03_r8,2.9507e+03_r8,2.7060e+03_r8/) + kbo(:,49,16) = (/ & + &4.1183e+03_r8,3.7067e+03_r8,3.3602e+03_r8,3.0634e+03_r8,2.8046e+03_r8/) + kbo(:,50,16) = (/ & + &4.3018e+03_r8,3.8593e+03_r8,3.4893e+03_r8,3.1743e+03_r8,2.9010e+03_r8/) + kbo(:,51,16) = (/ & + &4.4921e+03_r8,4.0168e+03_r8,3.6208e+03_r8,3.2876e+03_r8,3.0000e+03_r8/) + kbo(:,52,16) = (/ & + &4.6953e+03_r8,4.1848e+03_r8,3.7620e+03_r8,3.4065e+03_r8,3.1029e+03_r8/) + kbo(:,53,16) = (/ & + &4.9149e+03_r8,4.3644e+03_r8,3.9107e+03_r8,3.5325e+03_r8,3.2110e+03_r8/) + kbo(:,54,16) = (/ & + &5.1330e+03_r8,4.5400e+03_r8,4.0560e+03_r8,3.6544e+03_r8,3.3151e+03_r8/) + kbo(:,55,16) = (/ & + &5.3615e+03_r8,4.7192e+03_r8,4.2041e+03_r8,3.7779e+03_r8,3.4198e+03_r8/) + kbo(:,56,16) = (/ & + &5.6061e+03_r8,4.9107e+03_r8,4.3608e+03_r8,3.9074e+03_r8,3.5296e+03_r8/) + kbo(:,57,16) = (/ & + &5.8683e+03_r8,5.1170e+03_r8,4.5267e+03_r8,4.0448e+03_r8,3.6452e+03_r8/) + kbo(:,58,16) = (/ & + &6.1353e+03_r8,5.3291e+03_r8,4.6942e+03_r8,4.1832e+03_r8,3.7603e+03_r8/) + kbo(:,59,16) = (/ & + &6.2495e+03_r8,5.4200e+03_r8,4.7647e+03_r8,4.2413e+03_r8,3.8086e+03_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mco2( 1, :, 1) = (/ & + & 7.38630e-06_r8, 8.97432e-06_r8, 1.09037e-05_r8, 1.32480e-05_r8, 1.60963e-05_r8, & + & 1.95569e-05_r8, 2.37615e-05_r8, 2.88701e-05_r8, 3.50770e-05_r8, 4.26184e-05_r8, & + & 5.17811e-05_r8, 6.29138e-05_r8, 7.64400e-05_r8, 9.28742e-05_r8, 1.12842e-04_r8, & + & 1.37102e-04_r8, 1.66578e-04_r8, 2.02392e-04_r8, 2.45905e-04_r8/) + kao_mco2( 2, :, 1) = (/ & + & 7.03916e-06_r8, 8.58785e-06_r8, 1.04773e-05_r8, 1.27824e-05_r8, 1.55947e-05_r8, & + & 1.90257e-05_r8, 2.32115e-05_r8, 2.83183e-05_r8, 3.45487e-05_r8, 4.21498e-05_r8, & + & 5.14233e-05_r8, 6.27370e-05_r8, 7.65398e-05_r8, 9.33794e-05_r8, 1.13924e-04_r8, & + & 1.38989e-04_r8, 1.69568e-04_r8, 2.06874e-04_r8, 2.52389e-04_r8/) + kao_mco2( 3, :, 1) = (/ & + & 7.80015e-06_r8, 9.48520e-06_r8, 1.15343e-05_r8, 1.40260e-05_r8, 1.70560e-05_r8, & + & 2.07405e-05_r8, 2.52211e-05_r8, 3.06695e-05_r8, 3.72950e-05_r8, 4.53517e-05_r8, & + & 5.51489e-05_r8, 6.70626e-05_r8, 8.15499e-05_r8, 9.91670e-05_r8, 1.20590e-04_r8, & + & 1.46640e-04_r8, 1.78319e-04_r8, 2.16841e-04_r8, 2.63684e-04_r8/) + kao_mco2( 4, :, 1) = (/ & + & 9.24267e-06_r8, 1.11747e-05_r8, 1.35105e-05_r8, 1.63346e-05_r8, 1.97490e-05_r8, & + & 2.38771e-05_r8, 2.88682e-05_r8, 3.49025e-05_r8, 4.21981e-05_r8, 5.10188e-05_r8, & + & 6.16832e-05_r8, 7.45768e-05_r8, 9.01656e-05_r8, 1.09013e-04_r8, 1.31800e-04_r8, & + & 1.59350e-04_r8, 1.92659e-04_r8, 2.32930e-04_r8, 2.81619e-04_r8/) + kao_mco2( 5, :, 1) = (/ & + & 1.59506e-05_r8, 1.90078e-05_r8, 2.26509e-05_r8, 2.69923e-05_r8, 3.21658e-05_r8, & + & 3.83309e-05_r8, 4.56777e-05_r8, 5.44325e-05_r8, 6.48654e-05_r8, 7.72978e-05_r8, & + & 9.21132e-05_r8, 1.09768e-04_r8, 1.30807e-04_r8, 1.55878e-04_r8, 1.85755e-04_r8, & + & 2.21357e-04_r8, 2.63784e-04_r8, 3.14342e-04_r8, 3.74591e-04_r8/) + kao_mco2( 6, :, 1) = (/ & + & 3.53189e-05_r8, 4.14789e-05_r8, 4.87131e-05_r8, 5.72092e-05_r8, 6.71870e-05_r8, & + & 7.89050e-05_r8, 9.26667e-05_r8, 1.08829e-04_r8, 1.27809e-04_r8, 1.50100e-04_r8, & + & 1.76279e-04_r8, 2.07024e-04_r8, 2.43131e-04_r8, 2.85535e-04_r8, 3.35335e-04_r8, & + & 3.93821e-04_r8, 4.62507e-04_r8, 5.43172e-04_r8, 6.37906e-04_r8/) + kao_mco2( 7, :, 1) = (/ & + & 6.63273e-05_r8, 7.76356e-05_r8, 9.08718e-05_r8, 1.06365e-04_r8, 1.24499e-04_r8, & + & 1.45725e-04_r8, 1.70570e-04_r8, 1.99651e-04_r8, 2.33689e-04_r8, 2.73531e-04_r8, & + & 3.20166e-04_r8, 3.74752e-04_r8, 4.38644e-04_r8, 5.13429e-04_r8, 6.00964e-04_r8, & + & 7.03424e-04_r8, 8.23352e-04_r8, 9.63726e-04_r8, 1.12803e-03_r8/) + kao_mco2( 8, :, 1) = (/ & + & 9.01134e-05_r8, 1.05517e-04_r8, 1.23553e-04_r8, 1.44673e-04_r8, 1.69402e-04_r8, & + & 1.98359e-04_r8, 2.32265e-04_r8, 2.71967e-04_r8, 3.18456e-04_r8, 3.72890e-04_r8, & + & 4.36630e-04_r8, 5.11265e-04_r8, 5.98657e-04_r8, 7.00989e-04_r8, 8.20811e-04_r8, & + & 9.61116e-04_r8, 1.12540e-03_r8, 1.31777e-03_r8, 1.54302e-03_r8/) + kao_mco2( 9, :, 1) = (/ & + & 1.14205e-05_r8, 1.36364e-05_r8, 1.62823e-05_r8, 1.94416e-05_r8, 2.32139e-05_r8, & + & 2.77181e-05_r8, 3.30963e-05_r8, 3.95181e-05_r8, 4.71858e-05_r8, 5.63414e-05_r8, & + & 6.72734e-05_r8, 8.03266e-05_r8, 9.59124e-05_r8, 1.14523e-04_r8, 1.36743e-04_r8, & + & 1.63276e-04_r8, 1.94957e-04_r8, 2.32784e-04_r8, 2.77952e-04_r8/) + kao_mco2( 1, :, 2) = (/ & + & 2.01754e-05_r8, 2.40506e-05_r8, 2.86701e-05_r8, 3.41769e-05_r8, 4.07414e-05_r8, & + & 4.85668e-05_r8, 5.78953e-05_r8, 6.90155e-05_r8, 8.22717e-05_r8, 9.80739e-05_r8, & + & 1.16912e-04_r8, 1.39367e-04_r8, 1.66136e-04_r8, 1.98047e-04_r8, 2.36087e-04_r8, & + & 2.81433e-04_r8, 3.35489e-04_r8, 3.99928e-04_r8, 4.76744e-04_r8/) + kao_mco2( 2, :, 2) = (/ & + & 2.08613e-05_r8, 2.48759e-05_r8, 2.96631e-05_r8, 3.53716e-05_r8, 4.21786e-05_r8, & + & 5.02955e-05_r8, 5.99746e-05_r8, 7.15163e-05_r8, 8.52791e-05_r8, 1.01690e-04_r8, & + & 1.21260e-04_r8, 1.44596e-04_r8, 1.72422e-04_r8, 2.05604e-04_r8, 2.45171e-04_r8, & + & 2.92352e-04_r8, 3.48613e-04_r8, 4.15702e-04_r8, 4.95700e-04_r8/) + kao_mco2( 3, :, 2) = (/ & + & 2.06879e-05_r8, 2.47009e-05_r8, 2.94924e-05_r8, 3.52133e-05_r8, 4.20439e-05_r8, & + & 5.01995e-05_r8, 5.99372e-05_r8, 7.15637e-05_r8, 8.54456e-05_r8, 1.02020e-04_r8, & + & 1.21810e-04_r8, 1.45439e-04_r8, 1.73651e-04_r8, 2.07335e-04_r8, 2.47554e-04_r8, & + & 2.95574e-04_r8, 3.52909e-04_r8, 4.21366e-04_r8, 5.03102e-04_r8/) + kao_mco2( 4, :, 2) = (/ & + & 2.12700e-05_r8, 2.54064e-05_r8, 3.03472e-05_r8, 3.62490e-05_r8, 4.32984e-05_r8, & + & 5.17188e-05_r8, 6.17767e-05_r8, 7.37906e-05_r8, 8.81410e-05_r8, 1.05282e-04_r8, & + & 1.25757e-04_r8, 1.50213e-04_r8, 1.79425e-04_r8, 2.14319e-04_r8, 2.55998e-04_r8, & + & 3.05782e-04_r8, 3.65249e-04_r8, 4.36280e-04_r8, 5.21125e-04_r8/) + kao_mco2( 5, :, 2) = (/ & + & 1.88144e-05_r8, 2.25220e-05_r8, 2.69602e-05_r8, 3.22730e-05_r8, 3.86328e-05_r8, & + & 4.62458e-05_r8, 5.53591e-05_r8, 6.62682e-05_r8, 7.93271e-05_r8, 9.49594e-05_r8, & + & 1.13672e-04_r8, 1.36073e-04_r8, 1.62887e-04_r8, 1.94986e-04_r8, 2.33410e-04_r8, & + & 2.79406e-04_r8, 3.34467e-04_r8, 4.00377e-04_r8, 4.79275e-04_r8/) + kao_mco2( 6, :, 2) = (/ & + & 1.20964e-05_r8, 1.46021e-05_r8, 1.76268e-05_r8, 2.12780e-05_r8, 2.56856e-05_r8, & + & 3.10062e-05_r8, 3.74289e-05_r8, 4.51820e-05_r8, 5.45411e-05_r8, 6.58388e-05_r8, & + & 7.94769e-05_r8, 9.59399e-05_r8, 1.15813e-04_r8, 1.39803e-04_r8, 1.68762e-04_r8, & + & 2.03720e-04_r8, 2.45919e-04_r8, 2.96859e-04_r8, 3.58350e-04_r8/) + kao_mco2( 7, :, 2) = (/ & + & 3.07117e-05_r8, 3.64441e-05_r8, 4.32465e-05_r8, 5.13186e-05_r8, 6.08974e-05_r8, & + & 7.22642e-05_r8, 8.57525e-05_r8, 1.01758e-04_r8, 1.20752e-04_r8, 1.43291e-04_r8, & + & 1.70037e-04_r8, 2.01775e-04_r8, 2.39436e-04_r8, 2.84128e-04_r8, 3.37161e-04_r8, & + & 4.00094e-04_r8, 4.74773e-04_r8, 5.63391e-04_r8, 6.68549e-04_r8/) + kao_mco2( 8, :, 2) = (/ & + & 9.34077e-05_r8, 1.10481e-04_r8, 1.30675e-04_r8, 1.54559e-04_r8, 1.82810e-04_r8, & + & 2.16224e-04_r8, 2.55745e-04_r8, 3.02491e-04_r8, 3.57780e-04_r8, 4.23175e-04_r8, & + & 5.00523e-04_r8, 5.92009e-04_r8, 7.00217e-04_r8, 8.28203e-04_r8, 9.79582e-04_r8, & + & 1.15863e-03_r8, 1.37041e-03_r8, 1.62089e-03_r8, 1.91716e-03_r8/) + kao_mco2( 9, :, 2) = (/ & + & 1.15325e-05_r8, 1.37935e-05_r8, 1.64978e-05_r8, 1.97322e-05_r8, 2.36007e-05_r8, & + & 2.82277e-05_r8, 3.37618e-05_r8, 4.03808e-05_r8, 4.82976e-05_r8, 5.77664e-05_r8, & + & 6.90916e-05_r8, 8.26372e-05_r8, 9.88384e-05_r8, 1.18216e-04_r8, 1.41392e-04_r8, & + & 1.69113e-04_r8, 2.02267e-04_r8, 2.41922e-04_r8, 2.89352e-04_r8/) + kao_mco2( 1, :, 3) = (/ & + & 2.56142e-05_r8, 3.05385e-05_r8, 3.64096e-05_r8, 4.34093e-05_r8, 5.17547e-05_r8, & + & 6.17045e-05_r8, 7.35672e-05_r8, 8.77104e-05_r8, 1.04573e-04_r8, 1.24677e-04_r8, & + & 1.48646e-04_r8, 1.77223e-04_r8, 2.11294e-04_r8, 2.51915e-04_r8, 3.00346e-04_r8, & + & 3.58087e-04_r8, 4.26929e-04_r8, 5.09006e-04_r8, 6.06862e-04_r8/) + kao_mco2( 2, :, 3) = (/ & + & 2.49802e-05_r8, 2.98040e-05_r8, 3.55593e-05_r8, 4.24259e-05_r8, 5.06186e-05_r8, & + & 6.03932e-05_r8, 7.20554e-05_r8, 8.59696e-05_r8, 1.02571e-04_r8, 1.22377e-04_r8, & + & 1.46009e-04_r8, 1.74204e-04_r8, 2.07844e-04_r8, 2.47979e-04_r8, 2.95865e-04_r8, & + & 3.52998e-04_r8, 4.21163e-04_r8, 5.02491e-04_r8, 5.99524e-04_r8/) + kao_mco2( 3, :, 3) = (/ & + & 2.54644e-05_r8, 3.03959e-05_r8, 3.62825e-05_r8, 4.33091e-05_r8, 5.16965e-05_r8, & + & 6.17083e-05_r8, 7.36589e-05_r8, 8.79240e-05_r8, 1.04952e-04_r8, 1.25277e-04_r8, & + & 1.49539e-04_r8, 1.78499e-04_r8, 2.13068e-04_r8, 2.54331e-04_r8, 3.03586e-04_r8, & + & 3.62380e-04_r8, 4.32560e-04_r8, 5.16331e-04_r8, 6.16326e-04_r8/) + kao_mco2( 4, :, 3) = (/ & + & 2.55054e-05_r8, 3.04699e-05_r8, 3.64007e-05_r8, 4.34859e-05_r8, 5.19501e-05_r8, & + & 6.20619e-05_r8, 7.41418e-05_r8, 8.85731e-05_r8, 1.05813e-04_r8, 1.26409e-04_r8, & + & 1.51014e-04_r8, 1.80408e-04_r8, 2.15523e-04_r8, 2.57474e-04_r8, 3.07589e-04_r8, & + & 3.67459e-04_r8, 4.38983e-04_r8, 5.24428e-04_r8, 6.26505e-04_r8/) + kao_mco2( 5, :, 3) = (/ & + & 2.48615e-05_r8, 2.97398e-05_r8, 3.55754e-05_r8, 4.25560e-05_r8, 5.09064e-05_r8, & + & 6.08952e-05_r8, 7.28441e-05_r8, 8.71375e-05_r8, 1.04236e-04_r8, 1.24689e-04_r8, & + & 1.49155e-04_r8, 1.78423e-04_r8, 2.13433e-04_r8, 2.55313e-04_r8, 3.05410e-04_r8, & + & 3.65338e-04_r8, 4.37024e-04_r8, 5.22777e-04_r8, 6.25356e-04_r8/) + kao_mco2( 6, :, 3) = (/ & + & 2.09074e-05_r8, 2.50891e-05_r8, 3.01072e-05_r8, 3.61290e-05_r8, 4.33553e-05_r8, & + & 5.20269e-05_r8, 6.24329e-05_r8, 7.49202e-05_r8, 8.99051e-05_r8, 1.07887e-04_r8, & + & 1.29466e-04_r8, 1.55361e-04_r8, 1.86435e-04_r8, 2.23724e-04_r8, 2.68471e-04_r8, & + & 3.22169e-04_r8, 3.86607e-04_r8, 4.63933e-04_r8, 5.56725e-04_r8/) + kao_mco2( 7, :, 3) = (/ & + & 1.25163e-05_r8, 1.51688e-05_r8, 1.83835e-05_r8, 2.22795e-05_r8, 2.70011e-05_r8, & + & 3.27234e-05_r8, 3.96583e-05_r8, 4.80630e-05_r8, 5.82488e-05_r8, 7.05933e-05_r8, & + & 8.55539e-05_r8, 1.03685e-04_r8, 1.25659e-04_r8, 1.52289e-04_r8, 1.84563e-04_r8, & + & 2.23677e-04_r8, 2.71081e-04_r8, 3.28530e-04_r8, 3.98154e-04_r8/) + kao_mco2( 8, :, 3) = (/ & + & 1.00408e-04_r8, 1.20081e-04_r8, 1.43608e-04_r8, 1.71745e-04_r8, 2.05395e-04_r8, & + & 2.45637e-04_r8, 2.93765e-04_r8, 3.51322e-04_r8, 4.20156e-04_r8, 5.02476e-04_r8, & + & 6.00926e-04_r8, 7.18665e-04_r8, 8.59472e-04_r8, 1.02787e-03_r8, 1.22926e-03_r8, & + & 1.47010e-03_r8, 1.75814e-03_r8, 2.10261e-03_r8, 2.51457e-03_r8/) + kao_mco2( 9, :, 3) = (/ & + & 8.50402e-06_r8, 1.02737e-05_r8, 1.24116e-05_r8, 1.49945e-05_r8, 1.81148e-05_r8, & + & 2.18844e-05_r8, 2.64385e-05_r8, 3.19403e-05_r8, 3.85871e-05_r8, 4.66169e-05_r8, & + & 5.63178e-05_r8, 6.80375e-05_r8, 8.21959e-05_r8, 9.93008e-05_r8, 1.19965e-04_r8, & + & 1.44930e-04_r8, 1.75089e-04_r8, 2.11525e-04_r8, 2.55543e-04_r8/) + kao_mco2( 1, :, 4) = (/ & + & 2.68659e-05_r8, 3.20986e-05_r8, 3.83506e-05_r8, 4.58203e-05_r8, 5.47450e-05_r8, & + & 6.54078e-05_r8, 7.81476e-05_r8, 9.33687e-05_r8, 1.11555e-04_r8, 1.33282e-04_r8, & + & 1.59242e-04_r8, 1.90259e-04_r8, 2.27316e-04_r8, 2.71592e-04_r8, 3.24490e-04_r8, & + & 3.87693e-04_r8, 4.63206e-04_r8, 5.53426e-04_r8, 6.61218e-04_r8/) + kao_mco2( 2, :, 4) = (/ & + & 2.74827e-05_r8, 3.28460e-05_r8, 3.92560e-05_r8, 4.69169e-05_r8, 5.60728e-05_r8, & + & 6.70155e-05_r8, 8.00937e-05_r8, 9.57241e-05_r8, 1.14405e-04_r8, 1.36731e-04_r8, & + & 1.63415e-04_r8, 1.95305e-04_r8, 2.33419e-04_r8, 2.78972e-04_r8, 3.33413e-04_r8, & + & 3.98480e-04_r8, 4.76244e-04_r8, 5.69184e-04_r8, 6.80261e-04_r8/) + kao_mco2( 3, :, 4) = (/ & + & 2.84702e-05_r8, 3.40189e-05_r8, 4.06490e-05_r8, 4.85713e-05_r8, 5.80375e-05_r8, & + & 6.93487e-05_r8, 8.28644e-05_r8, 9.90142e-05_r8, 1.18312e-04_r8, 1.41370e-04_r8, & + & 1.68922e-04_r8, 2.01844e-04_r8, 2.41182e-04_r8, 2.88188e-04_r8, 3.44354e-04_r8, & + & 4.11466e-04_r8, 4.91659e-04_r8, 5.87481e-04_r8, 7.01977e-04_r8/) + kao_mco2( 4, :, 4) = (/ & + & 2.92293e-05_r8, 3.49243e-05_r8, 4.17289e-05_r8, 4.98593e-05_r8, 5.95738e-05_r8, & + & 7.11810e-05_r8, 8.50498e-05_r8, 1.01621e-04_r8, 1.21420e-04_r8, 1.45078e-04_r8, & + & 1.73344e-04_r8, 2.07119e-04_r8, 2.47473e-04_r8, 2.95690e-04_r8, 3.53302e-04_r8, & + & 4.22139e-04_r8, 5.04388e-04_r8, 6.02662e-04_r8, 7.20083e-04_r8/) + kao_mco2( 5, :, 4) = (/ & + & 2.88531e-05_r8, 3.45646e-05_r8, 4.14067e-05_r8, 4.96033e-05_r8, 5.94224e-05_r8, & + & 7.11851e-05_r8, 8.52764e-05_r8, 1.02157e-04_r8, 1.22379e-04_r8, 1.46604e-04_r8, & + & 1.75625e-04_r8, 2.10391e-04_r8, 2.52038e-04_r8, 3.01929e-04_r8, 3.61697e-04_r8, & + & 4.33295e-04_r8, 5.19067e-04_r8, 6.21818e-04_r8, 7.44908e-04_r8/) + kao_mco2( 6, :, 4) = (/ & + & 2.79869e-05_r8, 3.36885e-05_r8, 4.05516e-05_r8, 4.88130e-05_r8, 5.87574e-05_r8, & + & 7.07278e-05_r8, 8.51368e-05_r8, 1.02481e-04_r8, 1.23359e-04_r8, 1.48490e-04_r8, & + & 1.78742e-04_r8, 2.15156e-04_r8, 2.58988e-04_r8, 3.11751e-04_r8, 3.75262e-04_r8, & + & 4.51712e-04_r8, 5.43737e-04_r8, 6.54510e-04_r8, 7.87849e-04_r8/) + kao_mco2( 7, :, 4) = (/ & + & 1.45797e-05_r8, 1.78204e-05_r8, 2.17815e-05_r8, 2.66230e-05_r8, 3.25407e-05_r8, & + & 3.97737e-05_r8, 4.86145e-05_r8, 5.94203e-05_r8, 7.26281e-05_r8, 8.87715e-05_r8, & + & 1.08503e-04_r8, 1.32621e-04_r8, 1.62100e-04_r8, 1.98130e-04_r8, 2.42170e-04_r8, & + & 2.95999e-04_r8, 3.61792e-04_r8, 4.42210e-04_r8, 5.40503e-04_r8/) + kao_mco2( 8, :, 4) = (/ & + & 6.32607e-05_r8, 7.63420e-05_r8, 9.21282e-05_r8, 1.11179e-04_r8, 1.34169e-04_r8, & + & 1.61913e-04_r8, 1.95393e-04_r8, 2.35797e-04_r8, 2.84557e-04_r8, 3.43398e-04_r8, & + & 4.14407e-04_r8, 5.00100e-04_r8, 6.03512e-04_r8, 7.28308e-04_r8, 8.78909e-04_r8, & + & 1.06065e-03_r8, 1.27998e-03_r8, 1.54466e-03_r8, 1.86407e-03_r8/) + kao_mco2( 9, :, 4) = (/ & + & 1.52296e-05_r8, 1.84301e-05_r8, 2.23032e-05_r8, 2.69902e-05_r8, 3.26622e-05_r8, & + & 3.95261e-05_r8, 4.78324e-05_r8, 5.78844e-05_r8, 7.00487e-05_r8, 8.47694e-05_r8, & + & 1.02584e-04_r8, 1.24142e-04_r8, 1.50230e-04_r8, 1.81800e-04_r8, 2.20005e-04_r8, & + & 2.66239e-04_r8, 3.22190e-04_r8, 3.89897e-04_r8, 4.71833e-04_r8/) + kao_mco2( 1, :, 5) = (/ & + & 3.43213e-05_r8, 4.11301e-05_r8, 4.92896e-05_r8, 5.90679e-05_r8, 7.07860e-05_r8, & + & 8.48288e-05_r8, 1.01657e-04_r8, 1.21825e-04_r8, 1.45993e-04_r8, 1.74955e-04_r8, & + & 2.09663e-04_r8, 2.51257e-04_r8, 3.01103e-04_r8, 3.60837e-04_r8, 4.32421e-04_r8, & + & 5.18206e-04_r8, 6.21010e-04_r8, 7.44208e-04_r8, 8.91846e-04_r8/) + kao_mco2( 2, :, 5) = (/ & + & 3.14792e-05_r8, 3.79075e-05_r8, 4.56485e-05_r8, 5.49703e-05_r8, 6.61956e-05_r8, & + & 7.97133e-05_r8, 9.59914e-05_r8, 1.15594e-04_r8, 1.39199e-04_r8, 1.67624e-04_r8, & + & 2.01854e-04_r8, 2.43075e-04_r8, 2.92712e-04_r8, 3.52487e-04_r8, 4.24467e-04_r8, & + & 5.11147e-04_r8, 6.15527e-04_r8, 7.41222e-04_r8, 8.92585e-04_r8/) + kao_mco2( 3, :, 5) = (/ & + & 3.21655e-05_r8, 3.87990e-05_r8, 4.68006e-05_r8, 5.64523e-05_r8, 6.80945e-05_r8, & + & 8.21377e-05_r8, 9.90770e-05_r8, 1.19510e-04_r8, 1.44156e-04_r8, 1.73886e-04_r8, & + & 2.09746e-04_r8, 2.53002e-04_r8, 3.05179e-04_r8, 3.68117e-04_r8, 4.44033e-04_r8, & + & 5.35607e-04_r8, 6.46066e-04_r8, 7.79304e-04_r8, 9.40020e-04_r8/) + kao_mco2( 4, :, 5) = (/ & + & 3.22870e-05_r8, 3.89864e-05_r8, 4.70759e-05_r8, 5.68439e-05_r8, 6.86388e-05_r8, & + & 8.28810e-05_r8, 1.00078e-04_r8, 1.20844e-04_r8, 1.45919e-04_r8, 1.76196e-04_r8, & + & 2.12756e-04_r8, 2.56902e-04_r8, 3.10207e-04_r8, 3.74574e-04_r8, 4.52296e-04_r8, & + & 5.46146e-04_r8, 6.59468e-04_r8, 7.96304e-04_r8, 9.61533e-04_r8/) + kao_mco2( 5, :, 5) = (/ & + & 3.31190e-05_r8, 3.99528e-05_r8, 4.81967e-05_r8, 5.81417e-05_r8, 7.01387e-05_r8, & + & 8.46111e-05_r8, 1.02070e-04_r8, 1.23131e-04_r8, 1.48538e-04_r8, 1.79187e-04_r8, & + & 2.16161e-04_r8, 2.60764e-04_r8, 3.14570e-04_r8, 3.79479e-04_r8, 4.57781e-04_r8, & + & 5.52240e-04_r8, 6.66190e-04_r8, 8.03652e-04_r8, 9.69477e-04_r8/) + kao_mco2( 6, :, 5) = (/ & + & 3.31287e-05_r8, 3.99772e-05_r8, 4.82413e-05_r8, 5.82139e-05_r8, 7.02480e-05_r8, & + & 8.47698e-05_r8, 1.02294e-04_r8, 1.23440e-04_r8, 1.48958e-04_r8, 1.79750e-04_r8, & + & 2.16909e-04_r8, 2.61749e-04_r8, 3.15858e-04_r8, 3.81153e-04_r8, 4.59945e-04_r8, & + & 5.55026e-04_r8, 6.69762e-04_r8, 8.08216e-04_r8, 9.75292e-04_r8/) + kao_mco2( 7, :, 5) = (/ & + & 3.35235e-05_r8, 4.02832e-05_r8, 4.84061e-05_r8, 5.81668e-05_r8, 6.98958e-05_r8, & + & 8.39898e-05_r8, 1.00926e-04_r8, 1.21277e-04_r8, 1.45731e-04_r8, 1.75117e-04_r8, & + & 2.10428e-04_r8, 2.52860e-04_r8, 3.03847e-04_r8, 3.65116e-04_r8, 4.38739e-04_r8, & + & 5.27208e-04_r8, 6.33516e-04_r8, 7.61260e-04_r8, 9.14762e-04_r8/) + kao_mco2( 8, :, 5) = (/ & + & 3.57666e-05_r8, 4.27511e-05_r8, 5.10995e-05_r8, 6.10783e-05_r8, 7.30057e-05_r8, & + & 8.72622e-05_r8, 1.04303e-04_r8, 1.24671e-04_r8, 1.49017e-04_r8, 1.78117e-04_r8, & + & 2.12900e-04_r8, 2.54475e-04_r8, 3.04169e-04_r8, 3.63567e-04_r8, 4.34565e-04_r8, & + & 5.19427e-04_r8, 6.20861e-04_r8, 7.42103e-04_r8, 8.87020e-04_r8/) + kao_mco2( 9, :, 5) = (/ & + & 2.96349e-05_r8, 3.55202e-05_r8, 4.25743e-05_r8, 5.10292e-05_r8, 6.11633e-05_r8, & + & 7.33099e-05_r8, 8.78687e-05_r8, 1.05319e-04_r8, 1.26234e-04_r8, 1.51304e-04_r8, & + & 1.81352e-04_r8, 2.17367e-04_r8, 2.60534e-04_r8, 3.12275e-04_r8, 3.74290e-04_r8, & + & 4.48622e-04_r8, 5.37715e-04_r8, 6.44502e-04_r8, 7.72495e-04_r8/) + kao_mco2( 1, :, 6) = (/ & + & 4.14659e-05_r8, 4.98693e-05_r8, 5.99757e-05_r8, 7.21302e-05_r8, 8.67479e-05_r8, & + & 1.04328e-04_r8, 1.25471e-04_r8, 1.50899e-04_r8, 1.81479e-04_r8, 2.18257e-04_r8, & + & 2.62489e-04_r8, 3.15685e-04_r8, 3.79660e-04_r8, 4.56601e-04_r8, 5.49135e-04_r8, & + & 6.60422e-04_r8, 7.94261e-04_r8, 9.55224e-04_r8, 1.14881e-03_r8/) + kao_mco2( 2, :, 6) = (/ & + & 4.25940e-05_r8, 5.11162e-05_r8, 6.13434e-05_r8, 7.36168e-05_r8, 8.83459e-05_r8, & + & 1.06022e-04_r8, 1.27235e-04_r8, 1.52691e-04_r8, 1.83241e-04_r8, 2.19904e-04_r8, & + & 2.63902e-04_r8, 3.16703e-04_r8, 3.80068e-04_r8, 4.56111e-04_r8, 5.47368e-04_r8, & + & 6.56885e-04_r8, 7.88313e-04_r8, 9.46036e-04_r8, 1.13532e-03_r8/) + kao_mco2( 3, :, 6) = (/ & + & 4.44940e-05_r8, 5.32922e-05_r8, 6.38303e-05_r8, 7.64522e-05_r8, 9.15700e-05_r8, & + & 1.09677e-04_r8, 1.31365e-04_r8, 1.57341e-04_r8, 1.88454e-04_r8, 2.25719e-04_r8, & + & 2.70353e-04_r8, 3.23813e-04_r8, 3.87844e-04_r8, 4.64537e-04_r8, 5.56395e-04_r8, & + & 6.66418e-04_r8, 7.98196e-04_r8, 9.56032e-04_r8, 1.14508e-03_r8/) + kao_mco2( 4, :, 6) = (/ & + & 4.83402e-05_r8, 5.78065e-05_r8, 6.91265e-05_r8, 8.26633e-05_r8, 9.88510e-05_r8, & + & 1.18209e-04_r8, 1.41357e-04_r8, 1.69038e-04_r8, 2.02140e-04_r8, 2.41725e-04_r8, & + & 2.89061e-04_r8, 3.45667e-04_r8, 4.13357e-04_r8, 4.94303e-04_r8, 5.91101e-04_r8, & + & 7.06854e-04_r8, 8.45275e-04_r8, 1.01080e-03_r8, 1.20874e-03_r8/) + kao_mco2( 5, :, 6) = (/ & + & 5.14797e-05_r8, 6.15328e-05_r8, 7.35491e-05_r8, 8.79120e-05_r8, 1.05080e-04_r8, & + & 1.25600e-04_r8, 1.50128e-04_r8, 1.79445e-04_r8, 2.14487e-04_r8, 2.56373e-04_r8, & + & 3.06438e-04_r8, 3.66281e-04_r8, 4.37809e-04_r8, 5.23305e-04_r8, 6.25498e-04_r8, & + & 7.47647e-04_r8, 8.93650e-04_r8, 1.06816e-03_r8, 1.27676e-03_r8/) + kao_mco2( 6, :, 6) = (/ & + & 5.71481e-05_r8, 6.83156e-05_r8, 8.16652e-05_r8, 9.76237e-05_r8, 1.16701e-04_r8, & + & 1.39505e-04_r8, 1.66766e-04_r8, 1.99354e-04_r8, 2.38311e-04_r8, 2.84879e-04_r8, & + & 3.40548e-04_r8, 4.07096e-04_r8, 4.86647e-04_r8, 5.81744e-04_r8, 6.95424e-04_r8, & + & 8.31318e-04_r8, 9.93769e-04_r8, 1.18796e-03_r8, 1.42010e-03_r8/) + kao_mco2( 7, :, 6) = (/ & + & 5.69513e-05_r8, 6.84420e-05_r8, 8.22512e-05_r8, 9.88466e-05_r8, 1.18790e-04_r8, & + & 1.42758e-04_r8, 1.71562e-04_r8, 2.06177e-04_r8, 2.47776e-04_r8, 2.97768e-04_r8, & + & 3.57848e-04_r8, 4.30049e-04_r8, 5.16817e-04_r8, 6.21093e-04_r8, 7.46407e-04_r8, & + & 8.97006e-04_r8, 1.07799e-03_r8, 1.29549e-03_r8, 1.55687e-03_r8/) + kao_mco2( 8, :, 6) = (/ & + & 4.39361e-06_r8, 5.50076e-06_r8, 6.88690e-06_r8, 8.62235e-06_r8, 1.07951e-05_r8, & + & 1.35154e-05_r8, 1.69212e-05_r8, 2.11851e-05_r8, 2.65236e-05_r8, 3.32074e-05_r8, & + & 4.15754e-05_r8, 5.20520e-05_r8, 6.51687e-05_r8, 8.15907e-05_r8, 1.02151e-04_r8, & + & 1.27892e-04_r8, 1.60120e-04_r8, 2.00469e-04_r8, 2.50985e-04_r8/) + kao_mco2( 9, :, 6) = (/ & + & 5.75515e-05_r8, 6.86850e-05_r8, 8.19722e-05_r8, 9.78298e-05_r8, 1.16755e-04_r8, & + & 1.39342e-04_r8, 1.66297e-04_r8, 1.98468e-04_r8, 2.36862e-04_r8, 2.82683e-04_r8, & + & 3.37369e-04_r8, 4.02633e-04_r8, 4.80523e-04_r8, 5.73481e-04_r8, 6.84422e-04_r8, & + & 8.16824e-04_r8, 9.74841e-04_r8, 1.16342e-03_r8, 1.38849e-03_r8/) + kao_mco2( 1, :, 7) = (/ & + & 6.84544e-05_r8, 8.16461e-05_r8, 9.73799e-05_r8, 1.16146e-04_r8, 1.38528e-04_r8, & + & 1.65223e-04_r8, 1.97063e-04_r8, 2.35039e-04_r8, 2.80333e-04_r8, 3.34355e-04_r8, & + & 3.98788e-04_r8, 4.75637e-04_r8, 5.67296e-04_r8, 6.76618e-04_r8, 8.07008e-04_r8, & + & 9.62525e-04_r8, 1.14801e-03_r8, 1.36924e-03_r8, 1.63310e-03_r8/) + kao_mco2( 2, :, 7) = (/ & + & 6.88332e-05_r8, 8.21719e-05_r8, 9.80955e-05_r8, 1.17105e-04_r8, 1.39798e-04_r8, & + & 1.66888e-04_r8, 1.99229e-04_r8, 2.37836e-04_r8, 2.83925e-04_r8, 3.38944e-04_r8, & + & 4.04627e-04_r8, 4.83037e-04_r8, 5.76641e-04_r8, 6.88385e-04_r8, 8.21782e-04_r8, & + & 9.81031e-04_r8, 1.17114e-03_r8, 1.39809e-03_r8, 1.66901e-03_r8/) + kao_mco2( 3, :, 7) = (/ & + & 7.49899e-05_r8, 8.94606e-05_r8, 1.06724e-04_r8, 1.27318e-04_r8, 1.51887e-04_r8, & + & 1.81196e-04_r8, 2.16161e-04_r8, 2.57873e-04_r8, 3.07635e-04_r8, 3.66999e-04_r8, & + & 4.37818e-04_r8, 5.22304e-04_r8, 6.23092e-04_r8, 7.43330e-04_r8, 8.86769e-04_r8, & + & 1.05789e-03_r8, 1.26203e-03_r8, 1.50556e-03_r8, 1.79608e-03_r8/) + kao_mco2( 4, :, 7) = (/ & + & 8.26801e-05_r8, 9.85802e-05_r8, 1.17538e-04_r8, 1.40141e-04_r8, 1.67092e-04_r8, & + & 1.99225e-04_r8, 2.37537e-04_r8, 2.83217e-04_r8, 3.37682e-04_r8, 4.02621e-04_r8, & + & 4.80048e-04_r8, 5.72365e-04_r8, 6.82435e-04_r8, 8.13673e-04_r8, 9.70148e-04_r8, & + & 1.15671e-03_r8, 1.37916e-03_r8, 1.64438e-03_r8, 1.96061e-03_r8/) + kao_mco2( 5, :, 7) = (/ & + & 9.29561e-05_r8, 1.10845e-04_r8, 1.32176e-04_r8, 1.57612e-04_r8, 1.87944e-04_r8, & + & 2.24112e-04_r8, 2.67241e-04_r8, 3.18669e-04_r8, 3.79995e-04_r8, 4.53121e-04_r8, & + & 5.40321e-04_r8, 6.44302e-04_r8, 7.68293e-04_r8, 9.16146e-04_r8, 1.09245e-03_r8, & + & 1.30268e-03_r8, 1.55338e-03_r8, 1.85231e-03_r8, 2.20877e-03_r8/) + kao_mco2( 6, :, 7) = (/ & + & 1.09700e-04_r8, 1.30879e-04_r8, 1.56148e-04_r8, 1.86294e-04_r8, 2.22261e-04_r8, & + & 2.65172e-04_r8, 3.16367e-04_r8, 3.77446e-04_r8, 4.50317e-04_r8, 5.37257e-04_r8, & + & 6.40983e-04_r8, 7.64734e-04_r8, 9.12376e-04_r8, 1.08852e-03_r8, 1.29868e-03_r8, & + & 1.54941e-03_r8, 1.84854e-03_r8, 2.20543e-03_r8, 2.63122e-03_r8/) + kao_mco2( 7, :, 7) = (/ & + & 1.43457e-04_r8, 1.71554e-04_r8, 2.05153e-04_r8, 2.45332e-04_r8, 2.93381e-04_r8, & + & 3.50840e-04_r8, 4.19552e-04_r8, 5.01722e-04_r8, 5.99985e-04_r8, 7.17492e-04_r8, & + & 8.58014e-04_r8, 1.02606e-03_r8, 1.22701e-03_r8, 1.46732e-03_r8, 1.75470e-03_r8, & + & 2.09836e-03_r8, 2.50933e-03_r8, 3.00078e-03_r8, 3.58849e-03_r8/) + kao_mco2( 8, :, 7) = (/ & + & 1.52152e-05_r8, 1.89421e-05_r8, 2.35819e-05_r8, 2.93582e-05_r8, 3.65494e-05_r8, & + & 4.55021e-05_r8, 5.66476e-05_r8, 7.05233e-05_r8, 8.77978e-05_r8, 1.09304e-04_r8, & + & 1.36077e-04_r8, 1.69409e-04_r8, 2.10905e-04_r8, 2.62565e-04_r8, 3.26880e-04_r8, & + & 4.06948e-04_r8, 5.06629e-04_r8, 6.30726e-04_r8, 7.85219e-04_r8/) + kao_mco2( 9, :, 7) = (/ & + & 1.15683e-04_r8, 1.37544e-04_r8, 1.63535e-04_r8, 1.94438e-04_r8, 2.31180e-04_r8, & + & 2.74866e-04_r8, 3.26807e-04_r8, 3.88563e-04_r8, 4.61989e-04_r8, 5.49289e-04_r8, & + & 6.53088e-04_r8, 7.76501e-04_r8, 9.23234e-04_r8, 1.09770e-03_r8, 1.30512e-03_r8, & + & 1.55175e-03_r8, 1.84498e-03_r8, 2.19362e-03_r8, 2.60815e-03_r8/) + kao_mco2( 1, :, 8) = (/ & + & 1.18154e-04_r8, 1.40516e-04_r8, 1.67111e-04_r8, 1.98739e-04_r8, 2.36353e-04_r8, & + & 2.81086e-04_r8, 3.34285e-04_r8, 3.97553e-04_r8, 4.72796e-04_r8, 5.62278e-04_r8, & + & 6.68697e-04_r8, 7.95257e-04_r8, 9.45770e-04_r8, 1.12477e-03_r8, 1.33765e-03_r8, & + & 1.59081e-03_r8, 1.89190e-03_r8, 2.24996e-03_r8, 2.67580e-03_r8/) + kao_mco2( 2, :, 8) = (/ & + & 1.40874e-04_r8, 1.67009e-04_r8, 1.97993e-04_r8, 2.34726e-04_r8, 2.78273e-04_r8, & + & 3.29899e-04_r8, 3.91102e-04_r8, 4.63661e-04_r8, 5.49680e-04_r8, 6.51659e-04_r8, & + & 7.72556e-04_r8, 9.15884e-04_r8, 1.08580e-03_r8, 1.28724e-03_r8, 1.52605e-03_r8, & + & 1.80917e-03_r8, 2.14482e-03_r8, 2.54273e-03_r8, 3.01446e-03_r8/) + kao_mco2( 3, :, 8) = (/ & + & 1.55092e-04_r8, 1.84132e-04_r8, 2.18609e-04_r8, 2.59542e-04_r8, 3.08140e-04_r8, & + & 3.65837e-04_r8, 4.34337e-04_r8, 5.15664e-04_r8, 6.12219e-04_r8, 7.26853e-04_r8, & + & 8.62952e-04_r8, 1.02453e-03_r8, 1.21637e-03_r8, 1.44413e-03_r8, 1.71453e-03_r8, & + & 2.03557e-03_r8, 2.41671e-03_r8, 2.86923e-03_r8, 3.40647e-03_r8/) + kao_mco2( 4, :, 8) = (/ & + & 1.80666e-04_r8, 2.14521e-04_r8, 2.54721e-04_r8, 3.02454e-04_r8, 3.59131e-04_r8, & + & 4.26429e-04_r8, 5.06339e-04_r8, 6.01223e-04_r8, 7.13887e-04_r8, 8.47663e-04_r8, & + & 1.00651e-03_r8, 1.19512e-03_r8, 1.41908e-03_r8, 1.68500e-03_r8, 2.00076e-03_r8, & + & 2.37568e-03_r8, 2.82087e-03_r8, 3.34947e-03_r8, 3.97714e-03_r8/) + kao_mco2( 5, :, 8) = (/ & + & 2.21554e-04_r8, 2.63265e-04_r8, 3.12829e-04_r8, 3.71724e-04_r8, 4.41707e-04_r8, & + & 5.24865e-04_r8, 6.23679e-04_r8, 7.41096e-04_r8, 8.80619e-04_r8, 1.04641e-03_r8, & + & 1.24341e-03_r8, 1.47750e-03_r8, 1.75567e-03_r8, 2.08620e-03_r8, 2.47896e-03_r8, & + & 2.94566e-03_r8, 3.50023e-03_r8, 4.15920e-03_r8, 4.94224e-03_r8/) + kao_mco2( 6, :, 8) = (/ & + & 2.78997e-04_r8, 3.32548e-04_r8, 3.96378e-04_r8, 4.72460e-04_r8, 5.63146e-04_r8, & + & 6.71238e-04_r8, 8.00077e-04_r8, 9.53647e-04_r8, 1.13669e-03_r8, 1.35487e-03_r8, & + & 1.61493e-03_r8, 1.92491e-03_r8, 2.29438e-03_r8, 2.73477e-03_r8, 3.25969e-03_r8, & + & 3.88537e-03_r8, 4.63114e-03_r8, 5.52005e-03_r8, 6.57958e-03_r8/) + kao_mco2( 7, :, 8) = (/ & + & 2.84939e-04_r8, 3.40606e-04_r8, 4.07149e-04_r8, 4.86691e-04_r8, 5.81774e-04_r8, & + & 6.95432e-04_r8, 8.31295e-04_r8, 9.93700e-04_r8, 1.18783e-03_r8, 1.41989e-03_r8, & + & 1.69729e-03_r8, 2.02888e-03_r8, 2.42526e-03_r8, 2.89907e-03_r8, 3.46544e-03_r8, & + & 4.14246e-03_r8, 4.95176e-03_r8, 5.91915e-03_r8, 7.07554e-03_r8/) + kao_mco2( 8, :, 8) = (/ & + & 5.30764e-05_r8, 6.47812e-05_r8, 7.90673e-05_r8, 9.65039e-05_r8, 1.17786e-04_r8, & + & 1.43761e-04_r8, 1.75464e-04_r8, 2.14159e-04_r8, 2.61387e-04_r8, 3.19030e-04_r8, & + & 3.89385e-04_r8, 4.75255e-04_r8, 5.80062e-04_r8, 7.07982e-04_r8, 8.64111e-04_r8, & + & 1.05467e-03_r8, 1.28726e-03_r8, 1.57113e-03_r8, 1.91761e-03_r8/) + kao_mco2( 9, :, 8) = (/ & + & 2.76806e-04_r8, 3.29639e-04_r8, 3.92556e-04_r8, 4.67481e-04_r8, 5.56708e-04_r8, & + & 6.62964e-04_r8, 7.89501e-04_r8, 9.40190e-04_r8, 1.11964e-03_r8, 1.33334e-03_r8, & + & 1.58783e-03_r8, 1.89089e-03_r8, 2.25180e-03_r8, 2.68159e-03_r8, 3.19341e-03_r8, & + & 3.80293e-03_r8, 4.52878e-03_r8, 5.39316e-03_r8, 6.42253e-03_r8/) + kao_mco2( 1, :, 9) = (/ & + & 3.30614e-04_r8, 3.93289e-04_r8, 4.67844e-04_r8, 5.56534e-04_r8, 6.62036e-04_r8, & + & 7.87539e-04_r8, 9.36833e-04_r8, 1.11443e-03_r8, 1.32569e-03_r8, 1.57700e-03_r8, & + & 1.87596e-03_r8, 2.23158e-03_r8, 2.65463e-03_r8, 3.15787e-03_r8, 3.75650e-03_r8, & + & 4.46862e-03_r8, 5.31575e-03_r8, 6.32345e-03_r8, 7.52219e-03_r8/) + kao_mco2( 2, :, 9) = (/ & + & 3.78453e-04_r8, 4.50735e-04_r8, 5.36824e-04_r8, 6.39355e-04_r8, 7.61469e-04_r8, & + & 9.06906e-04_r8, 1.08012e-03_r8, 1.28642e-03_r8, 1.53212e-03_r8, 1.82475e-03_r8, & + & 2.17326e-03_r8, 2.58835e-03_r8, 3.08271e-03_r8, 3.67149e-03_r8, 4.37273e-03_r8, & + & 5.20790e-03_r8, 6.20259e-03_r8, 7.38725e-03_r8, 8.79818e-03_r8/) + kao_mco2( 3, :, 9) = (/ & + & 4.57576e-04_r8, 5.45512e-04_r8, 6.50348e-04_r8, 7.75330e-04_r8, 9.24332e-04_r8, & + & 1.10197e-03_r8, 1.31374e-03_r8, 1.56621e-03_r8, 1.86721e-03_r8, 2.22604e-03_r8, & + & 2.65384e-03_r8, 3.16385e-03_r8, 3.77187e-03_r8, 4.49675e-03_r8, 5.36092e-03_r8, & + & 6.39117e-03_r8, 7.61942e-03_r8, 9.08370e-03_r8, 1.08294e-02_r8/) + kao_mco2( 4, :, 9) = (/ & + & 5.18277e-04_r8, 6.18764e-04_r8, 7.38735e-04_r8, 8.81967e-04_r8, 1.05297e-03_r8, & + & 1.25713e-03_r8, 1.50087e-03_r8, 1.79187e-03_r8, 2.13929e-03_r8, 2.55407e-03_r8, & + & 3.04928e-03_r8, 3.64050e-03_r8, 4.34635e-03_r8, 5.18905e-03_r8, 6.19514e-03_r8, & + & 7.39631e-03_r8, 8.83036e-03_r8, 1.05425e-02_r8, 1.25865e-02_r8/) + kao_mco2( 5, :, 9) = (/ & + & 4.45365e-04_r8, 5.32106e-04_r8, 6.35742e-04_r8, 7.59563e-04_r8, 9.07500e-04_r8, & + & 1.08425e-03_r8, 1.29542e-03_r8, 1.54773e-03_r8, 1.84917e-03_r8, 2.20933e-03_r8, & + & 2.63963e-03_r8, 3.15374e-03_r8, 3.76797e-03_r8, 4.50184e-03_r8, 5.37865e-03_r8, & + & 6.42622e-03_r8, 7.67783e-03_r8, 9.17320e-03_r8, 1.09598e-02_r8/) + kao_mco2( 6, :, 9) = (/ & + & 2.87301e-04_r8, 3.43009e-04_r8, 4.09519e-04_r8, 4.88926e-04_r8, 5.83730e-04_r8, & + & 6.96916e-04_r8, 8.32050e-04_r8, 9.93386e-04_r8, 1.18601e-03_r8, 1.41597e-03_r8, & + & 1.69053e-03_r8, 2.01833e-03_r8, 2.40969e-03_r8, 2.87693e-03_r8, 3.43478e-03_r8, & + & 4.10079e-03_r8, 4.89594e-03_r8, 5.84527e-03_r8, 6.97867e-03_r8/) + kao_mco2( 7, :, 9) = (/ & + & 1.10743e-04_r8, 1.32286e-04_r8, 1.58020e-04_r8, 1.88760e-04_r8, 2.25480e-04_r8, & + & 2.69342e-04_r8, 3.21738e-04_r8, 3.84326e-04_r8, 4.59090e-04_r8, 5.48397e-04_r8, & + & 6.55078e-04_r8, 7.82511e-04_r8, 9.34734e-04_r8, 1.11657e-03_r8, 1.33378e-03_r8, & + & 1.59324e-03_r8, 1.90318e-03_r8, 2.27340e-03_r8, 2.71565e-03_r8/) + kao_mco2( 8, :, 9) = (/ & + & 8.63177e-05_r8, 1.03067e-04_r8, 1.23066e-04_r8, 1.46946e-04_r8, 1.75459e-04_r8, & + & 2.09505e-04_r8, 2.50158e-04_r8, 2.98698e-04_r8, 3.56658e-04_r8, 4.25864e-04_r8, & + & 5.08498e-04_r8, 6.07168e-04_r8, 7.24982e-04_r8, 8.65658e-04_r8, 1.03363e-03_r8, & + & 1.23420e-03_r8, 1.47368e-03_r8, 1.75963e-03_r8, 2.10107e-03_r8/) + kao_mco2( 9, :, 9) = (/ & + & 4.52715e-04_r8, 5.41540e-04_r8, 6.47792e-04_r8, 7.74892e-04_r8, 9.26929e-04_r8, & + & 1.10880e-03_r8, 1.32635e-03_r8, 1.58658e-03_r8, 1.89787e-03_r8, 2.27024e-03_r8, & + & 2.71568e-03_r8, 3.24850e-03_r8, 3.88587e-03_r8, 4.64830e-03_r8, 5.56031e-03_r8, & + & 6.65127e-03_r8, 7.95627e-03_r8, 9.51732e-03_r8, 1.13847e-02_r8/) + kao_mco2( 1, :,10) = (/ & + & 9.10418e-04_r8, 1.08631e-03_r8, 1.29619e-03_r8, 1.54662e-03_r8, 1.84543e-03_r8, & + & 2.20198e-03_r8, 2.62741e-03_r8, 3.13503e-03_r8, 3.74073e-03_r8, 4.46344e-03_r8, & + & 5.32580e-03_r8, 6.35476e-03_r8, 7.58251e-03_r8, 9.04748e-03_r8, 1.07955e-02_r8, & + & 1.28812e-02_r8, 1.53699e-02_r8, 1.83394e-02_r8, 2.18826e-02_r8/) + kao_mco2( 2, :,10) = (/ & + & 9.06680e-04_r8, 1.08622e-03_r8, 1.30130e-03_r8, 1.55898e-03_r8, 1.86768e-03_r8, & + & 2.23750e-03_r8, 2.68056e-03_r8, 3.21135e-03_r8, 3.84724e-03_r8, 4.60905e-03_r8, & + & 5.52171e-03_r8, 6.61508e-03_r8, 7.92496e-03_r8, 9.49421e-03_r8, 1.13742e-02_r8, & + & 1.36265e-02_r8, 1.63247e-02_r8, 1.95572e-02_r8, 2.34298e-02_r8/) + kao_mco2( 3, :,10) = (/ & + & 8.17976e-04_r8, 9.79458e-04_r8, 1.17282e-03_r8, 1.40435e-03_r8, 1.68160e-03_r8, & + & 2.01357e-03_r8, 2.41108e-03_r8, 2.88707e-03_r8, 3.45703e-03_r8, 4.13950e-03_r8, & + & 4.95671e-03_r8, 5.93525e-03_r8, 7.10696e-03_r8, 8.51000e-03_r8, 1.01900e-02_r8, & + & 1.22017e-02_r8, 1.46105e-02_r8, 1.74949e-02_r8, 2.09486e-02_r8/) + kao_mco2( 4, :,10) = (/ & + & 3.70314e-04_r8, 4.41440e-04_r8, 5.26226e-04_r8, 6.27298e-04_r8, 7.47782e-04_r8, & + & 8.91407e-04_r8, 1.06262e-03_r8, 1.26671e-03_r8, 1.51001e-03_r8, 1.80003e-03_r8, & + & 2.14576e-03_r8, 2.55789e-03_r8, 3.04918e-03_r8, 3.63483e-03_r8, 4.33297e-03_r8, & + & 5.16520e-03_r8, 6.15727e-03_r8, 7.33988e-03_r8, 8.74963e-03_r8/) + kao_mco2( 5, :,10) = (/ & + & 1.00859e-04_r8, 1.19692e-04_r8, 1.42041e-04_r8, 1.68563e-04_r8, 2.00038e-04_r8, & + & 2.37389e-04_r8, 2.81715e-04_r8, 3.34318e-04_r8, 3.96742e-04_r8, 4.70823e-04_r8, & + & 5.58736e-04_r8, 6.63065e-04_r8, 7.86874e-04_r8, 9.33801e-04_r8, 1.10816e-03_r8, & + & 1.31508e-03_r8, 1.56064e-03_r8, 1.85204e-03_r8, 2.19786e-03_r8/) + kao_mco2( 6, :,10) = (/ & + & 9.24477e-05_r8, 1.09659e-04_r8, 1.30074e-04_r8, 1.54290e-04_r8, 1.83015e-04_r8, & + & 2.17087e-04_r8, 2.57503e-04_r8, 3.05442e-04_r8, 3.62307e-04_r8, 4.29759e-04_r8, & + & 5.09768e-04_r8, 6.04672e-04_r8, 7.17245e-04_r8, 8.50776e-04_r8, 1.00917e-03_r8, & + & 1.19704e-03_r8, 1.41990e-03_r8, 1.68425e-03_r8, 1.99780e-03_r8/) + kao_mco2( 7, :,10) = (/ & + & 8.42943e-05_r8, 1.00044e-04_r8, 1.18735e-04_r8, 1.40919e-04_r8, 1.67248e-04_r8, & + & 1.98496e-04_r8, 2.35582e-04_r8, 2.79597e-04_r8, 3.31836e-04_r8, 3.93835e-04_r8, & + & 4.67418e-04_r8, 5.54748e-04_r8, 6.58395e-04_r8, 7.81407e-04_r8, 9.27402e-04_r8, & + & 1.10067e-03_r8, 1.30632e-03_r8, 1.55039e-03_r8, 1.84005e-03_r8/) + kao_mco2( 8, :,10) = (/ & + & 6.86464e-05_r8, 8.18163e-05_r8, 9.75129e-05_r8, 1.16221e-04_r8, 1.38518e-04_r8, & + & 1.65093e-04_r8, 1.96767e-04_r8, 2.34517e-04_r8, 2.79509e-04_r8, 3.33133e-04_r8, & + & 3.97046e-04_r8, 4.73220e-04_r8, 5.64008e-04_r8, 6.72214e-04_r8, 8.01179e-04_r8, & + & 9.54887e-04_r8, 1.13808e-03_r8, 1.35643e-03_r8, 1.61666e-03_r8/) + kao_mco2( 9, :,10) = (/ & + & 1.03095e-04_r8, 1.21985e-04_r8, 1.44335e-04_r8, 1.70781e-04_r8, 2.02072e-04_r8, & + & 2.39096e-04_r8, 2.82904e-04_r8, 3.34739e-04_r8, 3.96070e-04_r8, 4.68639e-04_r8, & + & 5.54505e-04_r8, 6.56103e-04_r8, 7.76316e-04_r8, 9.18556e-04_r8, 1.08686e-03_r8, & + & 1.28599e-03_r8, 1.52162e-03_r8, 1.80041e-03_r8, 2.13029e-03_r8/) + kao_mco2( 1, :,11) = (/ & + & 1.01275e-03_r8, 1.21433e-03_r8, 1.45605e-03_r8, 1.74587e-03_r8, 2.09339e-03_r8, & + & 2.51007e-03_r8, 3.00970e-03_r8, 3.60878e-03_r8, 4.32711e-03_r8, 5.18842e-03_r8, & + & 6.22117e-03_r8, 7.45950e-03_r8, 8.94430e-03_r8, 1.07247e-02_r8, 1.28594e-02_r8, & + & 1.54191e-02_r8, 1.84882e-02_r8, 2.21683e-02_r8, 2.65809e-02_r8/) + kao_mco2( 2, :,11) = (/ & + & 1.06856e-03_r8, 1.27885e-03_r8, 1.53052e-03_r8, 1.83171e-03_r8, 2.19218e-03_r8, & + & 2.62359e-03_r8, 3.13990e-03_r8, 3.75781e-03_r8, 4.49732e-03_r8, 5.38236e-03_r8, & + & 6.44158e-03_r8, 7.70924e-03_r8, 9.22637e-03_r8, 1.10421e-02_r8, 1.32151e-02_r8, & + & 1.58157e-02_r8, 1.89281e-02_r8, 2.26531e-02_r8, 2.71110e-02_r8/) + kao_mco2( 3, :,11) = (/ & + & 7.34896e-04_r8, 8.77863e-04_r8, 1.04864e-03_r8, 1.25265e-03_r8, 1.49634e-03_r8, & + & 1.78744e-03_r8, 2.13516e-03_r8, 2.55054e-03_r8, 3.04672e-03_r8, 3.63943e-03_r8, & + & 4.34745e-03_r8, 5.19321e-03_r8, 6.20349e-03_r8, 7.41032e-03_r8, 8.85192e-03_r8, & + & 1.05740e-02_r8, 1.26311e-02_r8, 1.50883e-02_r8, 1.80236e-02_r8/) + kao_mco2( 4, :,11) = (/ & + & 5.89491e-05_r8, 7.12560e-05_r8, 8.61322e-05_r8, 1.04114e-04_r8, 1.25850e-04_r8, & + & 1.52124e-04_r8, 1.83883e-04_r8, 2.22272e-04_r8, 2.68676e-04_r8, 3.24768e-04_r8, & + & 3.92571e-04_r8, 4.74528e-04_r8, 5.73595e-04_r8, 6.93346e-04_r8, 8.38096e-04_r8, & + & 1.01307e-03_r8, 1.22457e-03_r8, 1.48022e-03_r8, 1.78924e-03_r8/) + kao_mco2( 5, :,11) = (/ & + & 5.32400e-05_r8, 6.45465e-05_r8, 7.82542e-05_r8, 9.48731e-05_r8, 1.15021e-04_r8, & + & 1.39448e-04_r8, 1.69063e-04_r8, 2.04966e-04_r8, 2.48495e-04_r8, 3.01268e-04_r8, & + & 3.65248e-04_r8, 4.42816e-04_r8, 5.36856e-04_r8, 6.50868e-04_r8, 7.89092e-04_r8, & + & 9.56672e-04_r8, 1.15984e-03_r8, 1.40615e-03_r8, 1.70478e-03_r8/) + kao_mco2( 6, :,11) = (/ & + & 5.31408e-05_r8, 6.42409e-05_r8, 7.76597e-05_r8, 9.38814e-05_r8, 1.13491e-04_r8, & + & 1.37198e-04_r8, 1.65856e-04_r8, 2.00500e-04_r8, 2.42381e-04_r8, 2.93010e-04_r8, & + & 3.54214e-04_r8, 4.28203e-04_r8, 5.17647e-04_r8, 6.25774e-04_r8, 7.56486e-04_r8, & + & 9.14503e-04_r8, 1.10553e-03_r8, 1.33645e-03_r8, 1.61561e-03_r8/) + kao_mco2( 7, :,11) = (/ & + & 5.24517e-05_r8, 6.32485e-05_r8, 7.62676e-05_r8, 9.19667e-05_r8, 1.10897e-04_r8, & + & 1.33725e-04_r8, 1.61251e-04_r8, 1.94443e-04_r8, 2.34467e-04_r8, 2.82730e-04_r8, & + & 3.40928e-04_r8, 4.11106e-04_r8, 4.95728e-04_r8, 5.97770e-04_r8, 7.20816e-04_r8, & + & 8.69190e-04_r8, 1.04811e-03_r8, 1.26385e-03_r8, 1.52400e-03_r8/) + kao_mco2( 8, :,11) = (/ & + & 5.01768e-05_r8, 6.02217e-05_r8, 7.22774e-05_r8, 8.67466e-05_r8, 1.04112e-04_r8, & + & 1.24955e-04_r8, 1.49969e-04_r8, 1.79991e-04_r8, 2.16024e-04_r8, 2.59270e-04_r8, & + & 3.11173e-04_r8, 3.73467e-04_r8, 4.48231e-04_r8, 5.37962e-04_r8, 6.45656e-04_r8, & + & 7.74910e-04_r8, 9.30039e-04_r8, 1.11622e-03_r8, 1.33968e-03_r8/) + kao_mco2( 9, :,11) = (/ & + & 5.46391e-05_r8, 6.58765e-05_r8, 7.94252e-05_r8, 9.57603e-05_r8, 1.15455e-04_r8, & + & 1.39200e-04_r8, 1.67829e-04_r8, 2.02346e-04_r8, 2.43962e-04_r8, 2.94137e-04_r8, & + & 3.54632e-04_r8, 4.27568e-04_r8, 5.15504e-04_r8, 6.21526e-04_r8, 7.49353e-04_r8, & + & 9.03471e-04_r8, 1.08929e-03_r8, 1.31331e-03_r8, 1.58342e-03_r8/) + kao_mco2( 1, :,12) = (/ & + & 1.18469e-03_r8, 1.41755e-03_r8, 1.69619e-03_r8, 2.02959e-03_r8, 2.42854e-03_r8, & + & 2.90589e-03_r8, 3.47708e-03_r8, 4.16055e-03_r8, 4.97836e-03_r8, 5.95691e-03_r8, & + & 7.12782e-03_r8, 8.52889e-03_r8, 1.02053e-02_r8, 1.22113e-02_r8, 1.46116e-02_r8, & + & 1.74837e-02_r8, 2.09204e-02_r8, 2.50325e-02_r8, 2.99530e-02_r8/) + kao_mco2( 2, :,12) = (/ & + & 1.09092e-03_r8, 1.30288e-03_r8, 1.55602e-03_r8, 1.85834e-03_r8, 2.21940e-03_r8, & + & 2.65061e-03_r8, 3.16560e-03_r8, 3.78064e-03_r8, 4.51519e-03_r8, 5.39245e-03_r8, & + & 6.44016e-03_r8, 7.69143e-03_r8, 9.18580e-03_r8, 1.09705e-02_r8, 1.31020e-02_r8, & + & 1.56476e-02_r8, 1.86878e-02_r8, 2.23187e-02_r8, 2.66550e-02_r8/) + kao_mco2( 3, :,12) = (/ & + & 3.97521e-04_r8, 4.74103e-04_r8, 5.65438e-04_r8, 6.74369e-04_r8, 8.04285e-04_r8, & + & 9.59228e-04_r8, 1.14402e-03_r8, 1.36442e-03_r8, 1.62727e-03_r8, 1.94076e-03_r8, & + & 2.31464e-03_r8, 2.76055e-03_r8, 3.29237e-03_r8, 3.92663e-03_r8, 4.68309e-03_r8, & + & 5.58528e-03_r8, 6.66128e-03_r8, 7.94456e-03_r8, 9.47505e-03_r8/) + kao_mco2( 4, :,12) = (/ & + & 7.18557e-05_r8, 8.56230e-05_r8, 1.02028e-04_r8, 1.21576e-04_r8, 1.44870e-04_r8, & + & 1.72626e-04_r8, 2.05701e-04_r8, 2.45112e-04_r8, 2.92075e-04_r8, 3.48035e-04_r8, & + & 4.14718e-04_r8, 4.94176e-04_r8, 5.88858e-04_r8, 7.01682e-04_r8, 8.36121e-04_r8, & + & 9.96319e-04_r8, 1.18721e-03_r8, 1.41467e-03_r8, 1.68572e-03_r8/) + kao_mco2( 5, :,12) = (/ & + & 7.33026e-05_r8, 8.69077e-05_r8, 1.03038e-04_r8, 1.22162e-04_r8, 1.44836e-04_r8, & + & 1.71717e-04_r8, 2.03588e-04_r8, 2.41375e-04_r8, 2.86175e-04_r8, 3.39289e-04_r8, & + & 4.02262e-04_r8, 4.76923e-04_r8, 5.65440e-04_r8, 6.70387e-04_r8, 7.94812e-04_r8, & + & 9.42331e-04_r8, 1.11723e-03_r8, 1.32459e-03_r8, 1.57044e-03_r8/) + kao_mco2( 6, :,12) = (/ & + & 7.44053e-05_r8, 8.82167e-05_r8, 1.04592e-04_r8, 1.24007e-04_r8, 1.47025e-04_r8, & + & 1.74317e-04_r8, 2.06674e-04_r8, 2.45038e-04_r8, 2.90523e-04_r8, 3.44451e-04_r8, & + & 4.08389e-04_r8, 4.84196e-04_r8, 5.74074e-04_r8, 6.80637e-04_r8, 8.06979e-04_r8, & + & 9.56774e-04_r8, 1.13437e-03_r8, 1.34494e-03_r8, 1.59459e-03_r8/) + kao_mco2( 7, :,12) = (/ & + & 7.68762e-05_r8, 9.11305e-05_r8, 1.08028e-04_r8, 1.28058e-04_r8, 1.51802e-04_r8, & + & 1.79949e-04_r8, 2.13315e-04_r8, 2.52868e-04_r8, 2.99754e-04_r8, 3.55334e-04_r8, & + & 4.21220e-04_r8, 4.99322e-04_r8, 5.91905e-04_r8, 7.01656e-04_r8, 8.31756e-04_r8, & + & 9.85979e-04_r8, 1.16880e-03_r8, 1.38551e-03_r8, 1.64241e-03_r8/) + kao_mco2( 8, :,12) = (/ & + & 8.45996e-05_r8, 1.00214e-04_r8, 1.18711e-04_r8, 1.40622e-04_r8, 1.66577e-04_r8, & + & 1.97323e-04_r8, 2.33743e-04_r8, 2.76885e-04_r8, 3.27991e-04_r8, 3.88529e-04_r8, & + & 4.60241e-04_r8, 5.45189e-04_r8, 6.45816e-04_r8, 7.65016e-04_r8, 9.06216e-04_r8, & + & 1.07348e-03_r8, 1.27161e-03_r8, 1.50632e-03_r8, 1.78434e-03_r8/) + kao_mco2( 9, :,12) = (/ & + & 7.73583e-05_r8, 9.16767e-05_r8, 1.08645e-04_r8, 1.28755e-04_r8, 1.52586e-04_r8, & + & 1.80829e-04_r8, 2.14299e-04_r8, 2.53964e-04_r8, 3.00970e-04_r8, 3.56678e-04_r8, & + & 4.22696e-04_r8, 5.00934e-04_r8, 5.93652e-04_r8, 7.03533e-04_r8, 8.33751e-04_r8, & + & 9.88072e-04_r8, 1.17096e-03_r8, 1.38769e-03_r8, 1.64454e-03_r8/) + kao_mco2( 1, :,13) = (/ & + & 1.20952e-03_r8, 1.44504e-03_r8, 1.72642e-03_r8, 2.06260e-03_r8, 2.46423e-03_r8, & + & 2.94407e-03_r8, 3.51735e-03_r8, 4.20226e-03_r8, 5.02053e-03_r8, 5.99814e-03_r8, & + & 7.16612e-03_r8, 8.56153e-03_r8, 1.02287e-02_r8, 1.22204e-02_r8, 1.46000e-02_r8, & + & 1.74430e-02_r8, 2.08395e-02_r8, 2.48974e-02_r8, 2.97455e-02_r8/) + kao_mco2( 2, :,13) = (/ & + & 8.47667e-04_r8, 1.01027e-03_r8, 1.20407e-03_r8, 1.43505e-03_r8, 1.71034e-03_r8, & + & 2.03843e-03_r8, 2.42946e-03_r8, 2.89550e-03_r8, 3.45094e-03_r8, 4.11293e-03_r8, & + & 4.90192e-03_r8, 5.84225e-03_r8, 6.96296e-03_r8, 8.29866e-03_r8, 9.89058e-03_r8, & + & 1.17879e-02_r8, 1.40492e-02_r8, 1.67442e-02_r8, 1.99562e-02_r8/) + kao_mco2( 3, :,13) = (/ & + & 1.45612e-04_r8, 1.71739e-04_r8, 2.02554e-04_r8, 2.38897e-04_r8, 2.81762e-04_r8, & + & 3.32318e-04_r8, 3.91945e-04_r8, 4.62271e-04_r8, 5.45215e-04_r8, 6.43041e-04_r8, & + & 7.58421e-04_r8, 8.94503e-04_r8, 1.05500e-03_r8, 1.24430e-03_r8, 1.46756e-03_r8, & + & 1.73088e-03_r8, 2.04145e-03_r8, 2.40774e-03_r8, 2.83975e-03_r8/) + kao_mco2( 4, :,13) = (/ & + & 1.40167e-04_r8, 1.65266e-04_r8, 1.94858e-04_r8, 2.29750e-04_r8, 2.70889e-04_r8, & + & 3.19394e-04_r8, 3.76585e-04_r8, 4.44016e-04_r8, 5.23522e-04_r8, 6.17264e-04_r8, & + & 7.27791e-04_r8, 8.58110e-04_r8, 1.01176e-03_r8, 1.19293e-03_r8, 1.40654e-03_r8, & + & 1.65839e-03_r8, 1.95534e-03_r8, 2.30547e-03_r8, 2.71828e-03_r8/) + kao_mco2( 5, :,13) = (/ & + & 1.37406e-04_r8, 1.61990e-04_r8, 1.90973e-04_r8, 2.25141e-04_r8, 2.65423e-04_r8, & + & 3.12911e-04_r8, 3.68896e-04_r8, 4.34898e-04_r8, 5.12709e-04_r8, 6.04442e-04_r8, & + & 7.12587e-04_r8, 8.40082e-04_r8, 9.90387e-04_r8, 1.16758e-03_r8, 1.37648e-03_r8, & + & 1.62276e-03_r8, 1.91310e-03_r8, 2.25539e-03_r8, 2.65892e-03_r8/) + kao_mco2( 6, :,13) = (/ & + & 1.35356e-04_r8, 1.59577e-04_r8, 1.88132e-04_r8, 2.21797e-04_r8, 2.61485e-04_r8, & + & 3.08276e-04_r8, 3.63440e-04_r8, 4.28475e-04_r8, 5.05147e-04_r8, 5.95539e-04_r8, & + & 7.02106e-04_r8, 8.27743e-04_r8, 9.75861e-04_r8, 1.15048e-03_r8, 1.35635e-03_r8, & + & 1.59906e-03_r8, 1.88520e-03_r8, 2.22255e-03_r8, 2.62025e-03_r8/) + kao_mco2( 7, :,13) = (/ & + & 1.33359e-04_r8, 1.57252e-04_r8, 1.85424e-04_r8, 2.18645e-04_r8, 2.57817e-04_r8, & + & 3.04007e-04_r8, 3.58472e-04_r8, 4.22695e-04_r8, 4.98425e-04_r8, 5.87722e-04_r8, & + & 6.93017e-04_r8, 8.17177e-04_r8, 9.63581e-04_r8, 1.13621e-03_r8, 1.33978e-03_r8, & + & 1.57981e-03_r8, 1.86284e-03_r8, 2.19659e-03_r8, 2.59012e-03_r8/) + kao_mco2( 8, :,13) = (/ & + & 1.29667e-04_r8, 1.53001e-04_r8, 1.80534e-04_r8, 2.13022e-04_r8, 2.51356e-04_r8, & + & 2.96589e-04_r8, 3.49961e-04_r8, 4.12938e-04_r8, 4.87249e-04_r8, 5.74931e-04_r8, & + & 6.78393e-04_r8, 8.00473e-04_r8, 9.44521e-04_r8, 1.11449e-03_r8, 1.31505e-03_r8, & + & 1.55170e-03_r8, 1.83094e-03_r8, 2.16042e-03_r8, 2.54920e-03_r8/) + kao_mco2( 9, :,13) = (/ & + & 1.37892e-04_r8, 1.62557e-04_r8, 1.91635e-04_r8, 2.25914e-04_r8, 2.66324e-04_r8, & + & 3.13963e-04_r8, 3.70124e-04_r8, 4.36330e-04_r8, 5.14379e-04_r8, 6.06389e-04_r8, & + & 7.14858e-04_r8, 8.42730e-04_r8, 9.93473e-04_r8, 1.17118e-03_r8, 1.38068e-03_r8, & + & 1.62765e-03_r8, 1.91880e-03_r8, 2.26202e-03_r8, 2.66665e-03_r8/) + kao_mco2( 1, :,14) = (/ & + & 1.28098e-03_r8, 1.52939e-03_r8, 1.82597e-03_r8, 2.18007e-03_r8, 2.60284e-03_r8, & + & 3.10759e-03_r8, 3.71022e-03_r8, 4.42972e-03_r8, 5.28874e-03_r8, 6.31435e-03_r8, & + & 7.53885e-03_r8, 9.00081e-03_r8, 1.07463e-02_r8, 1.28302e-02_r8, 1.53183e-02_r8, & + & 1.82889e-02_r8, 2.18355e-02_r8, 2.60699e-02_r8, 3.11255e-02_r8/) + kao_mco2( 2, :,14) = (/ & + & 1.27275e-04_r8, 1.48842e-04_r8, 1.74064e-04_r8, 2.03561e-04_r8, 2.38055e-04_r8, & + & 2.78395e-04_r8, 3.25570e-04_r8, 3.80740e-04_r8, 4.45259e-04_r8, 5.20710e-04_r8, & + & 6.08947e-04_r8, 7.12137e-04_r8, 8.32812e-04_r8, 9.73937e-04_r8, 1.13898e-03_r8, & + & 1.33198e-03_r8, 1.55769e-03_r8, 1.82165e-03_r8, 2.13034e-03_r8/) + kao_mco2( 3, :,14) = (/ & + & 1.27744e-04_r8, 1.49255e-04_r8, 1.74389e-04_r8, 2.03755e-04_r8, 2.38066e-04_r8, & + & 2.78155e-04_r8, 3.24995e-04_r8, 3.79722e-04_r8, 4.43666e-04_r8, 5.18376e-04_r8, & + & 6.05668e-04_r8, 7.07660e-04_r8, 8.26826e-04_r8, 9.66059e-04_r8, 1.12874e-03_r8, & + & 1.31881e-03_r8, 1.54089e-03_r8, 1.80037e-03_r8, 2.10354e-03_r8/) + kao_mco2( 4, :,14) = (/ & + & 1.28543e-04_r8, 1.50136e-04_r8, 1.75357e-04_r8, 2.04814e-04_r8, 2.39219e-04_r8, & + & 2.79404e-04_r8, 3.26339e-04_r8, 3.81159e-04_r8, 4.45188e-04_r8, 5.19972e-04_r8, & + & 6.07319e-04_r8, 7.09339e-04_r8, 8.28496e-04_r8, 9.67670e-04_r8, 1.13022e-03_r8, & + & 1.32008e-03_r8, 1.54184e-03_r8, 1.80084e-03_r8, 2.10335e-03_r8/) + kao_mco2( 5, :,14) = (/ & + & 1.29218e-04_r8, 1.50897e-04_r8, 1.76214e-04_r8, 2.05778e-04_r8, 2.40302e-04_r8, & + & 2.80618e-04_r8, 3.27698e-04_r8, 3.82678e-04_r8, 4.46881e-04_r8, 5.21855e-04_r8, & + & 6.09409e-04_r8, 7.11652e-04_r8, 8.31048e-04_r8, 9.70475e-04_r8, 1.13330e-03_r8, & + & 1.32343e-03_r8, 1.54547e-03_r8, 1.80476e-03_r8, 2.10755e-03_r8/) + kao_mco2( 6, :,14) = (/ & + & 1.30502e-04_r8, 1.52368e-04_r8, 1.77898e-04_r8, 2.07706e-04_r8, 2.42508e-04_r8, & + & 2.83141e-04_r8, 3.30583e-04_r8, 3.85974e-04_r8, 4.50646e-04_r8, 5.26153e-04_r8, & + & 6.14313e-04_r8, 7.17244e-04_r8, 8.37422e-04_r8, 9.77736e-04_r8, 1.14156e-03_r8, & + & 1.33283e-03_r8, 1.55616e-03_r8, 1.81690e-03_r8, 2.12133e-03_r8/) + kao_mco2( 7, :,14) = (/ & + & 1.32820e-04_r8, 1.55041e-04_r8, 1.80980e-04_r8, 2.11259e-04_r8, 2.46604e-04_r8, & + & 2.87862e-04_r8, 3.36022e-04_r8, 3.92240e-04_r8, 4.57864e-04_r8, 5.34467e-04_r8, & + & 6.23886e-04_r8, 7.28265e-04_r8, 8.50107e-04_r8, 9.92334e-04_r8, 1.15836e-03_r8, & + & 1.35215e-03_r8, 1.57838e-03_r8, 1.84244e-03_r8, 2.15069e-03_r8/) + kao_mco2( 8, :,14) = (/ & + & 1.40203e-04_r8, 1.63590e-04_r8, 1.90879e-04_r8, 2.22720e-04_r8, 2.59872e-04_r8, & + & 3.03221e-04_r8, 3.53801e-04_r8, 4.12819e-04_r8, 4.81681e-04_r8, 5.62031e-04_r8, & + & 6.55783e-04_r8, 7.65175e-04_r8, 8.92814e-04_r8, 1.04174e-03_r8, 1.21552e-03_r8, & + & 1.41828e-03_r8, 1.65486e-03_r8, 1.93091e-03_r8, 2.25301e-03_r8/) + kao_mco2( 9, :,14) = (/ & + & 1.30642e-04_r8, 1.52513e-04_r8, 1.78046e-04_r8, 2.07853e-04_r8, 2.42651e-04_r8, & + & 2.83275e-04_r8, 3.30699e-04_r8, 3.86063e-04_r8, 4.50696e-04_r8, 5.26149e-04_r8, & + & 6.14234e-04_r8, 7.17066e-04_r8, 8.37113e-04_r8, 9.77259e-04_r8, 1.14087e-03_r8, & + & 1.33186e-03_r8, 1.55484e-03_r8, 1.81514e-03_r8, 2.11902e-03_r8/) + kao_mco2( 1, :,15) = (/ & + & 1.37603e-03_r8, 1.64035e-03_r8, 1.95543e-03_r8, 2.33105e-03_r8, 2.77881e-03_r8, & + & 3.31257e-03_r8, 3.94887e-03_r8, 4.70739e-03_r8, 5.61162e-03_r8, 6.68952e-03_r8, & + & 7.97449e-03_r8, 9.50627e-03_r8, 1.13323e-02_r8, 1.35091e-02_r8, 1.61039e-02_r8, & + & 1.91973e-02_r8, 2.28848e-02_r8, 2.72806e-02_r8, 3.25208e-02_r8/) + kao_mco2( 2, :,15) = (/ & + & 1.67843e-04_r8, 1.93707e-04_r8, 2.23557e-04_r8, 2.58007e-04_r8, 2.97765e-04_r8, & + & 3.43650e-04_r8, 3.96606e-04_r8, 4.57722e-04_r8, 5.28256e-04_r8, 6.09659e-04_r8, & + & 7.03606e-04_r8, 8.12031e-04_r8, 9.37163e-04_r8, 1.08158e-03_r8, 1.24825e-03_r8, & + & 1.44060e-03_r8, 1.66259e-03_r8, 1.91880e-03_r8, 2.21448e-03_r8/) + kao_mco2( 3, :,15) = (/ & + & 1.67595e-04_r8, 1.93410e-04_r8, 2.23200e-04_r8, 2.57579e-04_r8, 2.97253e-04_r8, & + & 3.43039e-04_r8, 3.95876e-04_r8, 4.56852e-04_r8, 5.27220e-04_r8, 6.08426e-04_r8, & + & 7.02141e-04_r8, 8.10291e-04_r8, 9.35098e-04_r8, 1.07913e-03_r8, 1.24534e-03_r8, & + & 1.43716e-03_r8, 1.65853e-03_r8, 1.91398e-03_r8, 2.20879e-03_r8/) + kao_mco2( 4, :,15) = (/ & + & 1.67354e-04_r8, 1.93130e-04_r8, 2.22877e-04_r8, 2.57206e-04_r8, 2.96823e-04_r8, & + & 3.42541e-04_r8, 3.95301e-04_r8, 4.56187e-04_r8, 5.26452e-04_r8, 6.07539e-04_r8, & + & 7.01116e-04_r8, 8.09106e-04_r8, 9.33728e-04_r8, 1.07755e-03_r8, 1.24352e-03_r8, & + & 1.43505e-03_r8, 1.65608e-03_r8, 1.91116e-03_r8, 2.20553e-03_r8/) + kao_mco2( 5, :,15) = (/ & + & 1.67437e-04_r8, 1.93232e-04_r8, 2.23002e-04_r8, 2.57358e-04_r8, 2.97006e-04_r8, & + & 3.42763e-04_r8, 3.95570e-04_r8, 4.56511e-04_r8, 5.26842e-04_r8, 6.08007e-04_r8, & + & 7.01677e-04_r8, 8.09778e-04_r8, 9.34533e-04_r8, 1.07851e-03_r8, 1.24466e-03_r8, & + & 1.43642e-03_r8, 1.65771e-03_r8, 1.91310e-03_r8, 2.20783e-03_r8/) + kao_mco2( 6, :,15) = (/ & + & 1.67267e-04_r8, 1.93027e-04_r8, 2.22753e-04_r8, 2.57057e-04_r8, 2.96645e-04_r8, & + & 3.42328e-04_r8, 3.95047e-04_r8, 4.55885e-04_r8, 5.26092e-04_r8, 6.07110e-04_r8, & + & 7.00606e-04_r8, 8.08500e-04_r8, 9.33010e-04_r8, 1.07669e-03_r8, 1.24251e-03_r8, & + & 1.43385e-03_r8, 1.65467e-03_r8, 1.90949e-03_r8, 2.20355e-03_r8/) + kao_mco2( 7, :,15) = (/ & + & 1.67354e-04_r8, 1.93130e-04_r8, 2.22877e-04_r8, 2.57206e-04_r8, 2.96823e-04_r8, & + & 3.42541e-04_r8, 3.95301e-04_r8, 4.56187e-04_r8, 5.26452e-04_r8, 6.07539e-04_r8, & + & 7.01116e-04_r8, 8.09106e-04_r8, 9.33728e-04_r8, 1.07755e-03_r8, 1.24352e-03_r8, & + & 1.43505e-03_r8, 1.65608e-03_r8, 1.91116e-03_r8, 2.20553e-03_r8/) + kao_mco2( 8, :,15) = (/ & + & 1.67276e-04_r8, 1.93038e-04_r8, 2.22769e-04_r8, 2.57079e-04_r8, 2.96673e-04_r8, & + & 3.42365e-04_r8, 3.95094e-04_r8, 4.55944e-04_r8, 5.26166e-04_r8, 6.07203e-04_r8, & + & 7.00722e-04_r8, 8.08643e-04_r8, 9.33186e-04_r8, 1.07691e-03_r8, 1.24277e-03_r8, & + & 1.43417e-03_r8, 1.65506e-03_r8, 1.90996e-03_r8, 2.20412e-03_r8/) + kao_mco2( 9, :,15) = (/ & + & 1.67437e-04_r8, 1.93232e-04_r8, 2.23002e-04_r8, 2.57358e-04_r8, 2.97006e-04_r8, & + & 3.42763e-04_r8, 3.95570e-04_r8, 4.56511e-04_r8, 5.26842e-04_r8, 6.08007e-04_r8, & + & 7.01677e-04_r8, 8.09778e-04_r8, 9.34533e-04_r8, 1.07851e-03_r8, 1.24466e-03_r8, & + & 1.43642e-03_r8, 1.65771e-03_r8, 1.91310e-03_r8, 2.20783e-03_r8/) + kao_mco2( 1, :,16) = (/ & + & 1.42104e-03_r8, 1.69791e-03_r8, 2.02872e-03_r8, 2.42399e-03_r8, 2.89626e-03_r8, & + & 3.46055e-03_r8, 4.13478e-03_r8, 4.94038e-03_r8, 5.90294e-03_r8, 7.05303e-03_r8, & + & 8.42720e-03_r8, 1.00691e-02_r8, 1.20309e-02_r8, 1.43749e-02_r8, 1.71757e-02_r8, & + & 2.05221e-02_r8, 2.45205e-02_r8, 2.92979e-02_r8, 3.50061e-02_r8/) + kao_mco2( 2, :,16) = (/ & + & 1.63777e-04_r8, 1.88736e-04_r8, 2.17498e-04_r8, 2.50643e-04_r8, 2.88839e-04_r8, & + & 3.32857e-04_r8, 3.83582e-04_r8, 4.42037e-04_r8, 5.09401e-04_r8, 5.87030e-04_r8, & + & 6.76490e-04_r8, 7.79583e-04_r8, 8.98386e-04_r8, 1.03530e-03_r8, 1.19307e-03_r8, & + & 1.37488e-03_r8, 1.58441e-03_r8, 1.82586e-03_r8, 2.10411e-03_r8/) + kao_mco2( 3, :,16) = (/ & + & 1.63679e-04_r8, 1.88621e-04_r8, 2.17365e-04_r8, 2.50489e-04_r8, 2.88661e-04_r8, & + & 3.32650e-04_r8, 3.83342e-04_r8, 4.41759e-04_r8, 5.09079e-04_r8, 5.86657e-04_r8, & + & 6.76057e-04_r8, 7.79080e-04_r8, 8.97804e-04_r8, 1.03462e-03_r8, 1.19228e-03_r8, & + & 1.37397e-03_r8, 1.58335e-03_r8, 1.82464e-03_r8, 2.10269e-03_r8/) + kao_mco2( 4, :,16) = (/ & + & 1.63679e-04_r8, 1.88621e-04_r8, 2.17365e-04_r8, 2.50489e-04_r8, 2.88661e-04_r8, & + & 3.32650e-04_r8, 3.83342e-04_r8, 4.41759e-04_r8, 5.09079e-04_r8, 5.86657e-04_r8, & + & 6.76057e-04_r8, 7.79080e-04_r8, 8.97804e-04_r8, 1.03462e-03_r8, 1.19228e-03_r8, & + & 1.37397e-03_r8, 1.58335e-03_r8, 1.82464e-03_r8, 2.10269e-03_r8/) + kao_mco2( 5, :,16) = (/ & + & 1.63586e-04_r8, 1.88513e-04_r8, 2.17239e-04_r8, 2.50343e-04_r8, 2.88490e-04_r8, & + & 3.32451e-04_r8, 3.83111e-04_r8, 4.41490e-04_r8, 5.08766e-04_r8, 5.86292e-04_r8, & + & 6.75633e-04_r8, 7.78588e-04_r8, 8.97231e-04_r8, 1.03395e-03_r8, 1.19151e-03_r8, & + & 1.37307e-03_r8, 1.58231e-03_r8, 1.82342e-03_r8, 2.10128e-03_r8/) + kao_mco2( 6, :,16) = (/ & + & 1.63679e-04_r8, 1.88621e-04_r8, 2.17365e-04_r8, 2.50489e-04_r8, 2.88661e-04_r8, & + & 3.32650e-04_r8, 3.83342e-04_r8, 4.41759e-04_r8, 5.09079e-04_r8, 5.86657e-04_r8, & + & 6.76057e-04_r8, 7.79080e-04_r8, 8.97804e-04_r8, 1.03462e-03_r8, 1.19228e-03_r8, & + & 1.37397e-03_r8, 1.58335e-03_r8, 1.82464e-03_r8, 2.10269e-03_r8/) + kao_mco2( 7, :,16) = (/ & + & 1.63679e-04_r8, 1.88621e-04_r8, 2.17365e-04_r8, 2.50489e-04_r8, 2.88661e-04_r8, & + & 3.32650e-04_r8, 3.83342e-04_r8, 4.41759e-04_r8, 5.09079e-04_r8, 5.86657e-04_r8, & + & 6.76057e-04_r8, 7.79080e-04_r8, 8.97804e-04_r8, 1.03462e-03_r8, 1.19228e-03_r8, & + & 1.37397e-03_r8, 1.58335e-03_r8, 1.82464e-03_r8, 2.10269e-03_r8/) + kao_mco2( 8, :,16) = (/ & + & 1.63479e-04_r8, 1.88391e-04_r8, 2.17098e-04_r8, 2.50180e-04_r8, 2.88303e-04_r8, & + & 3.32236e-04_r8, 3.82863e-04_r8, 4.41205e-04_r8, 5.08437e-04_r8, 5.85914e-04_r8, & + & 6.75198e-04_r8, 7.78087e-04_r8, 8.96654e-04_r8, 1.03329e-03_r8, 1.19074e-03_r8, & + & 1.37219e-03_r8, 1.58129e-03_r8, 1.82226e-03_r8, 2.09994e-03_r8/) + kao_mco2( 9, :,16) = (/ & + & 1.63586e-04_r8, 1.88513e-04_r8, 2.17239e-04_r8, 2.50343e-04_r8, 2.88490e-04_r8, & + & 3.32451e-04_r8, 3.83111e-04_r8, 4.41490e-04_r8, 5.08766e-04_r8, 5.86292e-04_r8, & + & 6.75633e-04_r8, 7.78588e-04_r8, 8.97231e-04_r8, 1.03395e-03_r8, 1.19151e-03_r8, & + & 1.37307e-03_r8, 1.58231e-03_r8, 1.82342e-03_r8, 2.10128e-03_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kbo_mco2(:, 1) = (/ & + & 3.72069e-06_r8, 4.81866e-06_r8, 6.24064e-06_r8, 8.08226e-06_r8, 1.04673e-05_r8, & + & 1.35562e-05_r8, 1.75567e-05_r8, 2.27376e-05_r8, 2.94475e-05_r8, 3.81375e-05_r8, & + & 4.93918e-05_r8, 6.39674e-05_r8, 8.28441e-05_r8, 1.07291e-04_r8, 1.38953e-04_r8, & + & 1.79958e-04_r8, 2.33064e-04_r8, 3.01840e-04_r8, 3.90913e-04_r8/) + kbo_mco2(:, 2) = (/ & + & 8.14357e-06_r8, 1.06031e-05_r8, 1.38056e-05_r8, 1.79752e-05_r8, 2.34041e-05_r8, & + & 3.04728e-05_r8, 3.96763e-05_r8, 5.16596e-05_r8, 6.72622e-05_r8, 8.75770e-05_r8, & + & 1.14027e-04_r8, 1.48467e-04_r8, 1.93307e-04_r8, 2.51691e-04_r8, 3.27708e-04_r8, & + & 4.26685e-04_r8, 5.55555e-04_r8, 7.23346e-04_r8, 9.41814e-04_r8/) + kbo_mco2(:, 3) = (/ & + & 1.09367e-05_r8, 1.42063e-05_r8, 1.84533e-05_r8, 2.39701e-05_r8, 3.11362e-05_r8, & + & 4.04446e-05_r8, 5.25358e-05_r8, 6.82417e-05_r8, 8.86432e-05_r8, 1.15144e-04_r8, & + & 1.49567e-04_r8, 1.94281e-04_r8, 2.52363e-04_r8, 3.27809e-04_r8, 4.25810e-04_r8, & + & 5.53109e-04_r8, 7.18466e-04_r8, 9.33256e-04_r8, 1.21226e-03_r8/) + kbo_mco2(:, 4) = (/ & + & 1.76192e-05_r8, 2.27752e-05_r8, 2.94401e-05_r8, 3.80553e-05_r8, 4.91916e-05_r8, & + & 6.35867e-05_r8, 8.21944e-05_r8, 1.06247e-04_r8, 1.37339e-04_r8, 1.77529e-04_r8, & + & 2.29480e-04_r8, 2.96635e-04_r8, 3.83440e-04_r8, 4.95648e-04_r8, 6.40691e-04_r8, & + & 8.28180e-04_r8, 1.07054e-03_r8, 1.38381e-03_r8, 1.78876e-03_r8/) + kbo_mco2(:, 5) = (/ & + & 3.72142e-05_r8, 4.78603e-05_r8, 6.15520e-05_r8, 7.91605e-05_r8, 1.01806e-04_r8, & + & 1.30931e-04_r8, 1.68387e-04_r8, 2.16558e-04_r8, 2.78510e-04_r8, 3.58185e-04_r8, & + & 4.60653e-04_r8, 5.92435e-04_r8, 7.61915e-04_r8, 9.79881e-04_r8, 1.26020e-03_r8, & + & 1.62071e-03_r8, 2.08436e-03_r8, 2.68064e-03_r8, 3.44751e-03_r8/) + kbo_mco2(:, 6) = (/ & + & 7.74131e-05_r8, 9.98876e-05_r8, 1.28887e-04_r8, 1.66305e-04_r8, 2.14587e-04_r8, & + & 2.76886e-04_r8, 3.57272e-04_r8, 4.60994e-04_r8, 5.94831e-04_r8, 7.67521e-04_r8, & + & 9.90348e-04_r8, 1.27787e-03_r8, 1.64886e-03_r8, 2.12755e-03_r8, 2.74522e-03_r8, & + & 3.54221e-03_r8, 4.57059e-03_r8, 5.89752e-03_r8, 7.60968e-03_r8/) + kbo_mco2(:, 7) = (/ & + & 1.32294e-04_r8, 1.70977e-04_r8, 2.20973e-04_r8, 2.85587e-04_r8, 3.69095e-04_r8, & + & 4.77022e-04_r8, 6.16507e-04_r8, 7.96779e-04_r8, 1.02976e-03_r8, 1.33088e-03_r8, & + & 1.72004e-03_r8, 2.22299e-03_r8, 2.87301e-03_r8, 3.71310e-03_r8, 4.79884e-03_r8, & + & 6.20207e-03_r8, 8.01561e-03_r8, 1.03594e-02_r8, 1.33886e-02_r8/) + kbo_mco2(:, 8) = (/ & + & 3.59868e-05_r8, 4.63611e-05_r8, 5.97261e-05_r8, 7.69439e-05_r8, 9.91253e-05_r8, & + & 1.27701e-04_r8, 1.64515e-04_r8, 2.11941e-04_r8, 2.73040e-04_r8, 3.51752e-04_r8, & + & 4.53155e-04_r8, 5.83790e-04_r8, 7.52085e-04_r8, 9.68897e-04_r8, 1.24821e-03_r8, & + & 1.60804e-03_r8, 2.07161e-03_r8, 2.66882e-03_r8, 3.43818e-03_r8/) + kbo_mco2(:, 9) = (/ & + & 5.09543e-05_r8, 6.60510e-05_r8, 8.56205e-05_r8, 1.10988e-04_r8, 1.43872e-04_r8, & + & 1.86498e-04_r8, 2.41753e-04_r8, 3.13380e-04_r8, 4.06228e-04_r8, 5.26585e-04_r8, & + & 6.82601e-04_r8, 8.84842e-04_r8, 1.14700e-03_r8, 1.48684e-03_r8, 1.92735e-03_r8, & + & 2.49839e-03_r8, 3.23861e-03_r8, 4.19814e-03_r8, 5.44196e-03_r8/) + kbo_mco2(:,10) = (/ & + & 2.08253e-05_r8, 2.64900e-05_r8, 3.36954e-05_r8, 4.28609e-05_r8, 5.45194e-05_r8, & + & 6.93491e-05_r8, 8.82125e-05_r8, 1.12207e-04_r8, 1.42728e-04_r8, 1.81551e-04_r8, & + & 2.30935e-04_r8, 2.93751e-04_r8, 3.73653e-04_r8, 4.75290e-04_r8, 6.04572e-04_r8, & + & 7.69021e-04_r8, 9.78201e-04_r8, 1.24428e-03_r8, 1.58273e-03_r8/) + kbo_mco2(:,11) = (/ & + & 2.08953e-05_r8, 2.65543e-05_r8, 3.37459e-05_r8, 4.28852e-05_r8, 5.44996e-05_r8, & + & 6.92595e-05_r8, 8.80169e-05_r8, 1.11854e-04_r8, 1.42147e-04_r8, 1.80644e-04_r8, & + & 2.29568e-04_r8, 2.91741e-04_r8, 3.70752e-04_r8, 4.71161e-04_r8, 5.98764e-04_r8, & + & 7.60925e-04_r8, 9.67005e-04_r8, 1.22889e-03_r8, 1.56171e-03_r8/) + kbo_mco2(:,12) = (/ & + & 2.65295e-05_r8, 3.36318e-05_r8, 4.26356e-05_r8, 5.40498e-05_r8, 6.85198e-05_r8, & + & 8.68636e-05_r8, 1.10118e-04_r8, 1.39599e-04_r8, 1.76972e-04_r8, 2.24350e-04_r8, & + & 2.84412e-04_r8, 3.60553e-04_r8, 4.57079e-04_r8, 5.79446e-04_r8, 7.34572e-04_r8, & + & 9.31230e-04_r8, 1.18053e-03_r8, 1.49658e-03_r8, 1.89724e-03_r8/) + kbo_mco2(:,13) = (/ & + & 3.45358e-05_r8, 4.36743e-05_r8, 5.52309e-05_r8, 6.98455e-05_r8, 8.83273e-05_r8, & + & 1.11700e-04_r8, 1.41256e-04_r8, 1.78634e-04_r8, 2.25902e-04_r8, 2.85678e-04_r8, & + & 3.61271e-04_r8, 4.56867e-04_r8, 5.77758e-04_r8, 7.30639e-04_r8, 9.23973e-04_r8, & + & 1.16847e-03_r8, 1.47765e-03_r8, 1.86865e-03_r8, 2.36311e-03_r8/) + kbo_mco2(:,14) = (/ & + & 3.99721e-05_r8, 5.12343e-05_r8, 6.56698e-05_r8, 8.41725e-05_r8, 1.07888e-04_r8, & + & 1.38286e-04_r8, 1.77249e-04_r8, 2.27190e-04_r8, 2.91201e-04_r8, 3.73248e-04_r8, & + & 4.78412e-04_r8, 6.13207e-04_r8, 7.85980e-04_r8, 1.00743e-03_r8, 1.29128e-03_r8, & + & 1.65510e-03_r8, 2.12144e-03_r8, 2.71916e-03_r8, 3.48529e-03_r8/) + kbo_mco2(:,15) = (/ & + & 8.51533e-06_r8, 1.23021e-05_r8, 1.77730e-05_r8, 2.56767e-05_r8, 3.70953e-05_r8, & + & 5.35918e-05_r8, 7.74243e-05_r8, 1.11855e-04_r8, 1.61598e-04_r8, 2.33461e-04_r8, & + & 3.37283e-04_r8, 4.87275e-04_r8, 7.03968e-04_r8, 1.01703e-03_r8, 1.46930e-03_r8, & + & 2.12271e-03_r8, 3.06670e-03_r8, 4.43047e-03_r8, 6.40072e-03_r8/) + kbo_mco2(:,16) = (/ & + & 2.93050e-06_r8, 3.65298e-06_r8, 4.55358e-06_r8, 5.67622e-06_r8, 7.07564e-06_r8, & + & 8.82006e-06_r8, 1.09945e-05_r8, 1.37051e-05_r8, 1.70840e-05_r8, 2.12959e-05_r8, & + & 2.65461e-05_r8, 3.30908e-05_r8, 4.12490e-05_r8, 5.14185e-05_r8, 6.40952e-05_r8, & + & 7.98972e-05_r8, 9.95951e-05_r8, 1.24149e-04_r8, 1.54757e-04_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296_r8,260_r8,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &2.0677e-07_r8,2.0363e-07_r8,2.0583e-07_r8,2.0547e-07_r8,2.0267e-07_r8,2.0154e-07_r8, & + &2.0190e-07_r8,2.0103e-07_r8,1.9869e-07_r8,1.9663e-07_r8,1.9701e-07_r8,2.0103e-07_r8, & + &2.0527e-07_r8,2.0206e-07_r8,2.0364e-07_r8,2.0364e-07_r8/) + forrefo(2,:) = (/ & + &2.2427e-07_r8,2.1489e-07_r8,2.0453e-07_r8,1.9710e-07_r8,1.9650e-07_r8,1.9738e-07_r8, & + &1.9767e-07_r8,1.9769e-07_r8,1.9940e-07_r8,1.9846e-07_r8,1.9898e-07_r8,1.9853e-07_r8, & + &2.0000e-07_r8,2.0517e-07_r8,2.0482e-07_r8,2.0482e-07_r8/) + forrefo(3,:) = (/ & + &2.2672e-07_r8,2.1706e-07_r8,2.0571e-07_r8,1.9747e-07_r8,1.9706e-07_r8,1.9698e-07_r8, & + &1.9781e-07_r8,1.9774e-07_r8,1.9724e-07_r8,1.9714e-07_r8,1.9751e-07_r8,1.9758e-07_r8, & + &1.9840e-07_r8,1.9968e-07_r8,1.9931e-07_r8,1.9880e-07_r8/) + forrefo(4,:) = (/ & + &2.2191e-07_r8,2.0899e-07_r8,2.0265e-07_r8,2.0101e-07_r8,2.0034e-07_r8,2.0021e-07_r8, & + &1.9987e-07_r8,1.9978e-07_r8,1.9902e-07_r8,1.9742e-07_r8,1.9672e-07_r8,1.9615e-07_r8, & + &1.9576e-07_r8,1.9540e-07_r8,1.9588e-07_r8,1.9590e-07_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 5.18832e-02_r8, 4.28690e-02_r8, 3.54210e-02_r8, 2.92670e-02_r8, 2.41822e-02_r8, & + & 1.99808e-02_r8, 1.65093e-02_r8, 1.36410e-02_r8, 1.12710e-02_r8, 9.31280e-03_r8/) + selfrefo(:, 2) = (/ & + & 4.36030e-02_r8, 3.78379e-02_r8, 3.28350e-02_r8, 2.84936e-02_r8, 2.47262e-02_r8, & + & 2.14569e-02_r8, 1.86199e-02_r8, 1.61580e-02_r8, 1.40216e-02_r8, 1.21677e-02_r8/) + selfrefo(:, 3) = (/ & + & 4.26492e-02_r8, 3.71443e-02_r8, 3.23500e-02_r8, 2.81745e-02_r8, 2.45379e-02_r8, & + & 2.13707e-02_r8, 1.86124e-02_r8, 1.62100e-02_r8, 1.41177e-02_r8, 1.22955e-02_r8/) + selfrefo(:, 4) = (/ & + & 4.03591e-02_r8, 3.54614e-02_r8, 3.11580e-02_r8, 2.73769e-02_r8, 2.40546e-02_r8, & + & 2.11355e-02_r8, 1.85706e-02_r8, 1.63170e-02_r8, 1.43369e-02_r8, 1.25970e-02_r8/) + selfrefo(:, 5) = (/ & + & 3.94512e-02_r8, 3.46232e-02_r8, 3.03860e-02_r8, 2.66674e-02_r8, 2.34038e-02_r8, & + & 2.05397e-02_r8, 1.80260e-02_r8, 1.58200e-02_r8, 1.38839e-02_r8, 1.21848e-02_r8/) + selfrefo(:, 6) = (/ & + & 3.90567e-02_r8, 3.40694e-02_r8, 2.97190e-02_r8, 2.59241e-02_r8, 2.26138e-02_r8, & + & 1.97261e-02_r8, 1.72072e-02_r8, 1.50100e-02_r8, 1.30933e-02_r8, 1.14214e-02_r8/) + selfrefo(:, 7) = (/ & + & 3.85397e-02_r8, 3.36462e-02_r8, 2.93740e-02_r8, 2.56443e-02_r8, 2.23881e-02_r8, & + & 1.95454e-02_r8, 1.70636e-02_r8, 1.48970e-02_r8, 1.30055e-02_r8, 1.13541e-02_r8/) + selfrefo(:, 8) = (/ & + & 3.79692e-02_r8, 3.31360e-02_r8, 2.89180e-02_r8, 2.52369e-02_r8, 2.20245e-02_r8, & + & 1.92209e-02_r8, 1.67742e-02_r8, 1.46390e-02_r8, 1.27756e-02_r8, 1.11493e-02_r8/) + selfrefo(:, 9) = (/ & + & 3.68819e-02_r8, 3.22827e-02_r8, 2.82570e-02_r8, 2.47333e-02_r8, 2.16490e-02_r8, & + & 1.89494e-02_r8, 1.65863e-02_r8, 1.45180e-02_r8, 1.27076e-02_r8, 1.11229e-02_r8/) + selfrefo(:,10) = (/ & + & 3.65157e-02_r8, 3.20121e-02_r8, 2.80640e-02_r8, 2.46028e-02_r8, 2.15685e-02_r8, & + & 1.89084e-02_r8, 1.65764e-02_r8, 1.45320e-02_r8, 1.27397e-02_r8, 1.11685e-02_r8/) + selfrefo(:,11) = (/ & + & 3.59917e-02_r8, 3.16727e-02_r8, 2.78720e-02_r8, 2.45274e-02_r8, 2.15841e-02_r8, & + & 1.89940e-02_r8, 1.67148e-02_r8, 1.47090e-02_r8, 1.29439e-02_r8, 1.13907e-02_r8/) + selfrefo(:,12) = (/ & + & 3.66963e-02_r8, 3.20483e-02_r8, 2.79890e-02_r8, 2.44439e-02_r8, 2.13478e-02_r8, & + & 1.86438e-02_r8, 1.62824e-02_r8, 1.42200e-02_r8, 1.24189e-02_r8, 1.08459e-02_r8/) + selfrefo(:,13) = (/ & + & 3.66422e-02_r8, 3.19026e-02_r8, 2.77760e-02_r8, 2.41832e-02_r8, 2.10551e-02_r8, & + & 1.83317e-02_r8, 1.59605e-02_r8, 1.38960e-02_r8, 1.20986e-02_r8, 1.05336e-02_r8/) + selfrefo(:,14) = (/ & + & 3.81260e-02_r8, 3.29322e-02_r8, 2.84460e-02_r8, 2.45709e-02_r8, 2.12237e-02_r8, & + & 1.83325e-02_r8, 1.58352e-02_r8, 1.36780e-02_r8, 1.18147e-02_r8, 1.02052e-02_r8/) + selfrefo(:,15) = (/ & + & 3.51264e-02_r8, 3.05081e-02_r8, 2.64970e-02_r8, 2.30133e-02_r8, 1.99876e-02_r8, & + & 1.73597e-02_r8, 1.50773e-02_r8, 1.30950e-02_r8, 1.13733e-02_r8, 9.87800e-03_r8/) + selfrefo(:,16) = (/ & + & 3.51264e-02_r8, 3.05081e-02_r8, 2.64970e-02_r8, 2.30133e-02_r8, 1.99876e-02_r8, & + & 1.73597e-02_r8, 1.50773e-02_r8, 1.30950e-02_r8, 1.13733e-02_r8, 9.87800e-03_r8/) + + end subroutine lw_kgb07 + +! ************************************************************************** + subroutine lw_kgb08 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg08, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, & + kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, & + cfc12o, cfc22adjo + + implicit none + save + +! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K + fracrefao(:) = (/ & + 1.6004e-01_r8,1.5437e-01_r8,1.4502e-01_r8,1.3084e-01_r8,1.1523e-01_r8,9.7743e-02_r8, & + 8.0376e-02_r8,6.0261e-02_r8,4.1111e-02_r8,4.4772e-03_r8,3.6511e-03_r8,2.9154e-03_r8, & + 2.1184e-03_r8,1.3048e-03_r8,4.6637e-04_r8,6.5624e-05_r8/) + +! Planck fraction mapping level : P=95.5835 mb, T= 215.7 K + fracrefbo(:) = (/ & + 1.4987e-01_r8,1.4665e-01_r8,1.4154e-01_r8,1.3200e-01_r8,1.1902e-01_r8,1.0352e-01_r8, & + 8.4939e-02_r8,6.4105e-02_r8,4.3190e-02_r8,4.5129e-03_r8,3.7656e-03_r8,2.8733e-03_r8, & + 2.0947e-03_r8,1.3201e-03_r8,5.1832e-04_r8,7.7473e-05_r8/) + +! Minor gas mapping level: +! lower - co2, p = 1053.63 mb, t = 294.2 k +! lower - o3, p = 317.348 mb, t = 240.77 k +! lower - n2o, p = 706.2720 mb, t= 278.94 k +! lower - cfc12,cfc11 +! upper - co2, p = 35.1632 mb, t = 223.28 k +! upper - n2o, p = 8.716e-2 mb, t = 226.03 k + + cfc12o(:) = (/ & + 85.4027_r8, 89.4696_r8, 74.0959_r8, 67.7480_r8, & + 61.2444_r8, 59.9073_r8, 60.8296_r8, 63.0998_r8, & + 59.6110_r8, 64.0735_r8, 57.2622_r8, 58.9721_r8, & + 43.5505_r8, 26.1192_r8, 32.7023_r8, 32.8667_r8/) +! Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1 +! and 1290-1335 cm-1 bands. + cfc22adjo(:) = (/ & + 135.335_r8, 89.6642_r8, 76.2375_r8, 65.9748_r8, & + 63.1164_r8, 60.2935_r8, 64.0299_r8, 75.4264_r8, & + 51.3018_r8, 7.07911_r8, 5.86928_r8, 0.398693_r8, & + 2.82885_r8, 9.12751_r8, 6.28271_r8, 0._r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &1.4664e-05_r8,1.7114e-05_r8,1.8876e-05_r8,2.2301e-05_r8,2.6622e-05_r8/) + kao(:, 2, 1) = (/ & + &1.0571e-05_r8,1.1718e-05_r8,1.4060e-05_r8,1.7193e-05_r8,2.1557e-05_r8/) + kao(:, 3, 1) = (/ & + &6.6138e-06_r8,8.1523e-06_r8,1.0695e-05_r8,1.3782e-05_r8,1.7449e-05_r8/) + kao(:, 4, 1) = (/ & + &5.1390e-06_r8,7.0055e-06_r8,9.4447e-06_r8,1.2362e-05_r8,1.5431e-05_r8/) + kao(:, 5, 1) = (/ & + &4.7765e-06_r8,6.4140e-06_r8,8.4242e-06_r8,1.0772e-05_r8,1.3788e-05_r8/) + kao(:, 6, 1) = (/ & + &4.4818e-06_r8,6.1945e-06_r8,8.3186e-06_r8,1.0638e-05_r8,1.3072e-05_r8/) + kao(:, 7, 1) = (/ & + &4.1781e-06_r8,5.8651e-06_r8,8.2034e-06_r8,1.0966e-05_r8,1.3592e-05_r8/) + kao(:, 8, 1) = (/ & + &4.6559e-06_r8,6.5570e-06_r8,8.8606e-06_r8,1.1636e-05_r8,1.4449e-05_r8/) + kao(:, 9, 1) = (/ & + &6.3964e-06_r8,9.3461e-06_r8,1.3202e-05_r8,1.7140e-05_r8,2.2124e-05_r8/) + kao(:,10, 1) = (/ & + &1.0453e-05_r8,1.6266e-05_r8,2.2571e-05_r8,3.2675e-05_r8,4.3832e-05_r8/) + kao(:,11, 1) = (/ & + &1.9225e-05_r8,2.5219e-05_r8,3.3439e-05_r8,4.2567e-05_r8,5.0999e-05_r8/) + kao(:,12, 1) = (/ & + &1.8581e-05_r8,2.6464e-05_r8,3.4892e-05_r8,4.5782e-05_r8,5.8008e-05_r8/) + kao(:,13, 1) = (/ & + &2.3252e-05_r8,2.6601e-05_r8,3.1497e-05_r8,4.1728e-05_r8,5.3564e-05_r8/) + kao(:, 1, 2) = (/ & + &2.4622e-05_r8,2.2121e-05_r8,2.5151e-05_r8,3.1972e-05_r8,4.1114e-05_r8/) + kao(:, 2, 2) = (/ & + &1.5738e-05_r8,1.6913e-05_r8,2.0782e-05_r8,2.6880e-05_r8,3.4084e-05_r8/) + kao(:, 3, 2) = (/ & + &9.8655e-06_r8,1.2753e-05_r8,1.6558e-05_r8,2.1755e-05_r8,2.8126e-05_r8/) + kao(:, 4, 2) = (/ & + &7.9265e-06_r8,1.0229e-05_r8,1.3524e-05_r8,1.7603e-05_r8,2.3192e-05_r8/) + kao(:, 5, 2) = (/ & + &7.0537e-06_r8,9.6733e-06_r8,1.2570e-05_r8,1.6079e-05_r8,2.0384e-05_r8/) + kao(:, 6, 2) = (/ & + &6.5277e-06_r8,9.1084e-06_r8,1.2443e-05_r8,1.5914e-05_r8,2.0339e-05_r8/) + kao(:, 7, 2) = (/ & + &7.4442e-06_r8,1.0146e-05_r8,1.2791e-05_r8,1.6212e-05_r8,2.1044e-05_r8/) + kao(:, 8, 2) = (/ & + &7.4223e-06_r8,1.0854e-05_r8,1.4643e-05_r8,1.9376e-05_r8,2.5625e-05_r8/) + kao(:, 9, 2) = (/ & + &1.4157e-05_r8,1.8510e-05_r8,2.5064e-05_r8,3.4631e-05_r8,4.4655e-05_r8/) + kao(:,10, 2) = (/ & + &3.4785e-05_r8,4.4053e-05_r8,5.4155e-05_r8,6.0764e-05_r8,5.9887e-05_r8/) + kao(:,11, 2) = (/ & + &4.4199e-05_r8,5.6024e-05_r8,6.6252e-05_r8,8.3322e-05_r8,1.0437e-04_r8/) + kao(:,12, 2) = (/ & + &4.8012e-05_r8,6.2560e-05_r8,7.6674e-05_r8,8.6164e-05_r8,1.0081e-04_r8/) + kao(:,13, 2) = (/ & + &3.9220e-05_r8,5.8614e-05_r8,7.6090e-05_r8,8.9710e-05_r8,9.6705e-05_r8/) + kao(:, 1, 3) = (/ & + &2.7517e-05_r8,3.2252e-05_r8,4.5774e-05_r8,5.9187e-05_r8,7.3901e-05_r8/) + kao(:, 2, 3) = (/ & + &1.9414e-05_r8,2.5349e-05_r8,3.4494e-05_r8,4.4078e-05_r8,5.4475e-05_r8/) + kao(:, 3, 3) = (/ & + &1.4431e-05_r8,1.9862e-05_r8,2.6815e-05_r8,3.5045e-05_r8,4.4510e-05_r8/) + kao(:, 4, 3) = (/ & + &1.1163e-05_r8,1.5886e-05_r8,2.1047e-05_r8,2.7352e-05_r8,3.5151e-05_r8/) + kao(:, 5, 3) = (/ & + &1.0004e-05_r8,1.3946e-05_r8,1.9070e-05_r8,2.4940e-05_r8,3.2122e-05_r8/) + kao(:, 6, 3) = (/ & + &9.8796e-06_r8,1.2389e-05_r8,1.6574e-05_r8,2.2677e-05_r8,2.9114e-05_r8/) + kao(:, 7, 3) = (/ & + &9.6705e-06_r8,1.3203e-05_r8,1.8009e-05_r8,2.4248e-05_r8,2.9926e-05_r8/) + kao(:, 8, 3) = (/ & + &1.2684e-05_r8,1.5798e-05_r8,2.0751e-05_r8,2.7135e-05_r8,3.4302e-05_r8/) + kao(:, 9, 3) = (/ & + &2.3748e-05_r8,2.8117e-05_r8,3.3728e-05_r8,4.1366e-05_r8,5.3787e-05_r8/) + kao(:,10, 3) = (/ & + &4.9449e-05_r8,6.0387e-05_r8,8.1388e-05_r8,1.0134e-04_r8,1.3311e-04_r8/) + kao(:,11, 3) = (/ & + &6.5933e-05_r8,8.9755e-05_r8,1.2191e-04_r8,1.3795e-04_r8,1.5355e-04_r8/) + kao(:,12, 3) = (/ & + &6.2437e-05_r8,8.0247e-05_r8,1.0990e-04_r8,1.3683e-04_r8,1.6418e-04_r8/) + kao(:,13, 3) = (/ & + &5.9989e-05_r8,6.7831e-05_r8,9.4332e-05_r8,1.1542e-04_r8,1.5040e-04_r8/) + kao(:, 1, 4) = (/ & + &3.6489e-05_r8,5.9568e-05_r8,7.8043e-05_r8,9.8599e-05_r8,1.2261e-04_r8/) + kao(:, 2, 4) = (/ & + &3.0751e-05_r8,4.5700e-05_r8,5.9720e-05_r8,7.6230e-05_r8,9.5698e-05_r8/) + kao(:, 3, 4) = (/ & + &2.6862e-05_r8,3.6448e-05_r8,4.6703e-05_r8,5.7936e-05_r8,7.1216e-05_r8/) + kao(:, 4, 4) = (/ & + &2.0754e-05_r8,2.7900e-05_r8,3.6677e-05_r8,4.8008e-05_r8,6.1630e-05_r8/) + kao(:, 5, 4) = (/ & + &1.6362e-05_r8,2.1862e-05_r8,2.9666e-05_r8,3.8981e-05_r8,5.0305e-05_r8/) + kao(:, 6, 4) = (/ & + &1.4991e-05_r8,2.0957e-05_r8,2.6223e-05_r8,3.2254e-05_r8,4.2632e-05_r8/) + kao(:, 7, 4) = (/ & + &1.3833e-05_r8,1.9399e-05_r8,2.5656e-05_r8,3.2001e-05_r8,4.1685e-05_r8/) + kao(:, 8, 4) = (/ & + &1.6855e-05_r8,2.2852e-05_r8,3.0265e-05_r8,3.5778e-05_r8,4.6073e-05_r8/) + kao(:, 9, 4) = (/ & + &3.3370e-05_r8,4.7904e-05_r8,5.8243e-05_r8,6.4094e-05_r8,7.6700e-05_r8/) + kao(:,10, 4) = (/ & + &6.8238e-05_r8,1.0340e-04_r8,1.2739e-04_r8,1.5464e-04_r8,1.7523e-04_r8/) + kao(:,11, 4) = (/ & + &6.1230e-05_r8,9.6227e-05_r8,1.3743e-04_r8,1.9846e-04_r8,2.3838e-04_r8/) + kao(:,12, 4) = (/ & + &6.8823e-05_r8,1.0715e-04_r8,1.3058e-04_r8,1.9049e-04_r8,2.2996e-04_r8/) + kao(:,13, 4) = (/ & + &6.5444e-05_r8,1.1659e-04_r8,1.2685e-04_r8,1.7368e-04_r8,2.0128e-04_r8/) + kao(:, 1, 5) = (/ & + &7.8999e-05_r8,1.0665e-04_r8,1.3776e-04_r8,1.7432e-04_r8,2.1687e-04_r8/) + kao(:, 2, 5) = (/ & + &6.1797e-05_r8,8.3347e-05_r8,1.0862e-04_r8,1.3836e-04_r8,1.7490e-04_r8/) + kao(:, 3, 5) = (/ & + &4.7325e-05_r8,6.2800e-05_r8,8.1194e-05_r8,1.0315e-04_r8,1.3026e-04_r8/) + kao(:, 4, 5) = (/ & + &3.8433e-05_r8,5.0865e-05_r8,6.5549e-05_r8,8.2585e-05_r8,1.0247e-04_r8/) + kao(:, 5, 5) = (/ & + &3.0177e-05_r8,3.9082e-05_r8,4.9288e-05_r8,6.5674e-05_r8,8.5494e-05_r8/) + kao(:, 6, 5) = (/ & + &2.4712e-05_r8,3.2374e-05_r8,4.1224e-05_r8,5.5035e-05_r8,7.0157e-05_r8/) + kao(:, 7, 5) = (/ & + &2.2530e-05_r8,2.6200e-05_r8,3.5121e-05_r8,4.6306e-05_r8,5.9652e-05_r8/) + kao(:, 8, 5) = (/ & + &2.8297e-05_r8,3.6551e-05_r8,4.4329e-05_r8,5.9550e-05_r8,7.1792e-05_r8/) + kao(:, 9, 5) = (/ & + &5.6002e-05_r8,7.4631e-05_r8,8.8607e-05_r8,1.1720e-04_r8,1.2997e-04_r8/) + kao(:,10, 5) = (/ & + &8.1020e-05_r8,1.1580e-04_r8,1.6197e-04_r8,2.3825e-04_r8,2.8441e-04_r8/) + kao(:,11, 5) = (/ & + &9.6146e-05_r8,1.4644e-04_r8,1.7805e-04_r8,2.2438e-04_r8,3.1753e-04_r8/) + kao(:,12, 5) = (/ & + &9.5441e-05_r8,1.4982e-04_r8,2.4222e-04_r8,2.7134e-04_r8,3.3168e-04_r8/) + kao(:,13, 5) = (/ & + &9.5058e-05_r8,1.4349e-04_r8,2.4835e-04_r8,2.9526e-04_r8,3.7011e-04_r8/) + kao(:, 1, 6) = (/ & + &1.5625e-04_r8,2.0681e-04_r8,2.6299e-04_r8,3.2669e-04_r8,4.0038e-04_r8/) + kao(:, 2, 6) = (/ & + &1.1702e-04_r8,1.5581e-04_r8,2.0084e-04_r8,2.5419e-04_r8,3.1669e-04_r8/) + kao(:, 3, 6) = (/ & + &8.6159e-05_r8,1.1329e-04_r8,1.4769e-04_r8,1.9151e-04_r8,2.4537e-04_r8/) + kao(:, 4, 6) = (/ & + &7.1655e-05_r8,9.4348e-05_r8,1.2251e-04_r8,1.5312e-04_r8,1.8840e-04_r8/) + kao(:, 5, 6) = (/ & + &5.9776e-05_r8,8.0388e-05_r8,1.0504e-04_r8,1.3009e-04_r8,1.5686e-04_r8/) + kao(:, 6, 6) = (/ & + &4.1587e-05_r8,5.6800e-05_r8,7.7481e-05_r8,9.9930e-05_r8,1.3028e-04_r8/) + kao(:, 7, 6) = (/ & + &3.7625e-05_r8,5.2950e-05_r8,6.5572e-05_r8,8.3943e-05_r8,1.0947e-04_r8/) + kao(:, 8, 6) = (/ & + &4.0934e-05_r8,5.1706e-05_r8,6.6726e-05_r8,8.2858e-05_r8,1.0389e-04_r8/) + kao(:, 9, 6) = (/ & + &8.3177e-05_r8,1.0693e-04_r8,1.2771e-04_r8,1.5344e-04_r8,1.9338e-04_r8/) + kao(:,10, 6) = (/ & + &1.2590e-04_r8,1.6860e-04_r8,2.4332e-04_r8,2.8123e-04_r8,4.3002e-04_r8/) + kao(:,11, 6) = (/ & + &1.5778e-04_r8,2.1103e-04_r8,2.9773e-04_r8,4.5434e-04_r8,5.2006e-04_r8/) + kao(:,12, 6) = (/ & + &1.7734e-04_r8,2.3169e-04_r8,2.6921e-04_r8,4.5377e-04_r8,6.4453e-04_r8/) + kao(:,13, 6) = (/ & + &1.7874e-04_r8,2.2968e-04_r8,2.8292e-04_r8,4.5303e-04_r8,6.1897e-04_r8/) + kao(:, 1, 7) = (/ & + &3.7144e-04_r8,4.7830e-04_r8,6.0203e-04_r8,7.4238e-04_r8,8.9847e-04_r8/) + kao(:, 2, 7) = (/ & + &2.8002e-04_r8,3.6431e-04_r8,4.6140e-04_r8,5.7047e-04_r8,6.9195e-04_r8/) + kao(:, 3, 7) = (/ & + &1.8338e-04_r8,2.5018e-04_r8,3.2929e-04_r8,4.2096e-04_r8,5.2583e-04_r8/) + kao(:, 4, 7) = (/ & + &1.3365e-04_r8,1.7565e-04_r8,2.2370e-04_r8,2.9770e-04_r8,3.9171e-04_r8/) + kao(:, 5, 7) = (/ & + &1.1609e-04_r8,1.5410e-04_r8,1.9723e-04_r8,2.4620e-04_r8,3.0830e-04_r8/) + kao(:, 6, 7) = (/ & + &1.0480e-04_r8,1.3862e-04_r8,1.7991e-04_r8,2.2372e-04_r8,2.7406e-04_r8/) + kao(:, 7, 7) = (/ & + &8.7767e-05_r8,1.1689e-04_r8,1.5270e-04_r8,1.9631e-04_r8,2.3773e-04_r8/) + kao(:, 8, 7) = (/ & + &9.8366e-05_r8,1.1738e-04_r8,1.4725e-04_r8,1.8494e-04_r8,2.3601e-04_r8/) + kao(:, 9, 7) = (/ & + &1.5443e-04_r8,1.9009e-04_r8,2.4404e-04_r8,2.8078e-04_r8,3.3602e-04_r8/) + kao(:,10, 7) = (/ & + &1.5274e-04_r8,2.6878e-04_r8,3.7659e-04_r8,5.3377e-04_r8,5.6306e-04_r8/) + kao(:,11, 7) = (/ & + &2.0214e-04_r8,2.6794e-04_r8,4.2457e-04_r8,5.7376e-04_r8,8.8285e-04_r8/) + kao(:,12, 7) = (/ & + &2.5054e-04_r8,3.1232e-04_r8,4.4996e-04_r8,6.0765e-04_r8,8.8689e-04_r8/) + kao(:,13, 7) = (/ & + &2.7318e-04_r8,3.6929e-04_r8,4.5362e-04_r8,6.1364e-04_r8,9.2141e-04_r8/) + kao(:, 1, 8) = (/ & + &1.1751e-03_r8,1.5113e-03_r8,1.8892e-03_r8,2.3109e-03_r8,2.7776e-03_r8/) + kao(:, 2, 8) = (/ & + &8.9844e-04_r8,1.1675e-03_r8,1.4748e-03_r8,1.8223e-03_r8,2.2105e-03_r8/) + kao(:, 3, 8) = (/ & + &6.3916e-04_r8,8.4337e-04_r8,1.0777e-03_r8,1.3420e-03_r8,1.6361e-03_r8/) + kao(:, 4, 8) = (/ & + &3.9704e-04_r8,5.5491e-04_r8,7.4493e-04_r8,9.5633e-04_r8,1.1972e-03_r8/) + kao(:, 5, 8) = (/ & + &2.8104e-04_r8,3.5275e-04_r8,4.8572e-04_r8,6.7373e-04_r8,9.0464e-04_r8/) + kao(:, 6, 8) = (/ & + &2.6538e-04_r8,3.4221e-04_r8,4.3816e-04_r8,5.5889e-04_r8,6.9563e-04_r8/) + kao(:, 7, 8) = (/ & + &2.6802e-04_r8,3.3443e-04_r8,4.3228e-04_r8,5.4299e-04_r8,6.7937e-04_r8/) + kao(:, 8, 8) = (/ & + &2.6587e-04_r8,3.6538e-04_r8,4.4243e-04_r8,5.3612e-04_r8,6.5384e-04_r8/) + kao(:, 9, 8) = (/ & + &3.1669e-04_r8,4.3173e-04_r8,5.9018e-04_r8,7.8164e-04_r8,9.3453e-04_r8/) + kao(:,10, 8) = (/ & + &2.7923e-04_r8,3.5605e-04_r8,4.7230e-04_r8,7.5710e-04_r8,1.3303e-03_r8/) + kao(:,11, 8) = (/ & + &3.9189e-04_r8,4.5454e-04_r8,6.3718e-04_r8,5.9520e-04_r8,8.3511e-04_r8/) + kao(:,12, 8) = (/ & + &2.6981e-04_r8,5.3035e-04_r8,6.9787e-04_r8,8.5120e-04_r8,7.8888e-04_r8/) + kao(:,13, 8) = (/ & + &2.5533e-04_r8,5.3884e-04_r8,7.3128e-04_r8,1.0359e-03_r8,9.5286e-04_r8/) + kao(:, 1, 9) = (/ & + &4.1658e-03_r8,5.4654e-03_r8,6.9658e-03_r8,8.6722e-03_r8,1.0572e-02_r8/) + kao(:, 2, 9) = (/ & + &3.6223e-03_r8,4.7934e-03_r8,6.1539e-03_r8,7.6963e-03_r8,9.3961e-03_r8/) + kao(:, 3, 9) = (/ & + &2.8899e-03_r8,3.8874e-03_r8,5.0544e-03_r8,6.3815e-03_r8,7.8638e-03_r8/) + kao(:, 4, 9) = (/ & + &2.1989e-03_r8,3.0197e-03_r8,3.9971e-03_r8,5.1085e-03_r8,6.3356e-03_r8/) + kao(:, 5, 9) = (/ & + &1.5192e-03_r8,2.2278e-03_r8,3.0194e-03_r8,3.9009e-03_r8,4.8746e-03_r8/) + kao(:, 6, 9) = (/ & + &8.7921e-04_r8,1.3751e-03_r8,1.9853e-03_r8,2.7076e-03_r8,3.5697e-03_r8/) + kao(:, 7, 9) = (/ & + &8.1169e-04_r8,1.0620e-03_r8,1.3025e-03_r8,1.8213e-03_r8,2.5733e-03_r8/) + kao(:, 8, 9) = (/ & + &8.9592e-04_r8,1.1349e-03_r8,1.5068e-03_r8,1.9574e-03_r8,2.3526e-03_r8/) + kao(:, 9, 9) = (/ & + &6.4937e-04_r8,9.7395e-04_r8,1.5824e-03_r8,2.3319e-03_r8,3.1640e-03_r8/) + kao(:,10, 9) = (/ & + &5.2173e-04_r8,1.2542e-03_r8,1.3511e-03_r8,1.8295e-03_r8,2.2102e-03_r8/) + kao(:,11, 9) = (/ & + &3.8299e-05_r8,7.6837e-04_r8,1.6073e-03_r8,2.1707e-03_r8,2.6859e-03_r8/) + kao(:,12, 9) = (/ & + &5.7389e-05_r8,4.8395e-04_r8,1.3815e-03_r8,2.5956e-03_r8,2.8856e-03_r8/) + kao(:,13, 9) = (/ & + &6.6437e-05_r8,4.1020e-04_r8,1.3561e-03_r8,2.3769e-03_r8,2.6400e-03_r8/) + kao(:, 1,10) = (/ & + &8.5531e-03_r8,1.1311e-02_r8,1.4946e-02_r8,1.9199e-02_r8,2.4070e-02_r8/) + kao(:, 2,10) = (/ & + &7.9512e-03_r8,1.0579e-02_r8,1.3947e-02_r8,1.7937e-02_r8,2.2682e-02_r8/) + kao(:, 3,10) = (/ & + &6.8586e-03_r8,9.3196e-03_r8,1.2459e-02_r8,1.6108e-02_r8,2.0278e-02_r8/) + kao(:, 4,10) = (/ & + &5.7104e-03_r8,7.9133e-03_r8,1.0642e-02_r8,1.3936e-02_r8,1.7830e-02_r8/) + kao(:, 5,10) = (/ & + &4.5965e-03_r8,6.4891e-03_r8,8.9433e-03_r8,1.1923e-02_r8,1.5372e-02_r8/) + kao(:, 6,10) = (/ & + &3.5770e-03_r8,5.1433e-03_r8,7.2049e-03_r8,9.7750e-03_r8,1.2529e-02_r8/) + kao(:, 7,10) = (/ & + &1.4544e-03_r8,1.6129e-03_r8,4.3574e-03_r8,7.0808e-03_r8,9.3333e-03_r8/) + kao(:, 8,10) = (/ & + &1.6681e-03_r8,2.3313e-03_r8,2.9075e-03_r8,3.3382e-03_r8,4.3787e-03_r8/) + kao(:, 9,10) = (/ & + &8.5765e-04_r8,1.7252e-03_r8,1.7039e-03_r8,3.3311e-03_r8,4.8997e-03_r8/) + kao(:,10,10) = (/ & + &2.2034e-05_r8,3.2730e-05_r8,2.9477e-03_r8,2.5954e-03_r8,5.2191e-03_r8/) + kao(:,11,10) = (/ & + &1.5700e-05_r8,2.2697e-05_r8,3.1811e-05_r8,9.1022e-03_r8,5.0873e-03_r8/) + kao(:,12,10) = (/ & + &1.1747e-05_r8,1.7581e-05_r8,2.4222e-05_r8,3.4764e-05_r8,8.4666e-03_r8/) + kao(:,13,10) = (/ & + &8.0435e-06_r8,1.2386e-05_r8,1.8547e-05_r8,2.6164e-05_r8,8.2788e-03_r8/) + kao(:, 1,11) = (/ & + &1.1747e-02_r8,1.5703e-02_r8,2.0198e-02_r8,2.5614e-02_r8,3.2111e-02_r8/) + kao(:, 2,11) = (/ & + &1.0674e-02_r8,1.4371e-02_r8,1.8733e-02_r8,2.4132e-02_r8,3.0707e-02_r8/) + kao(:, 3,11) = (/ & + &9.1890e-03_r8,1.2390e-02_r8,1.6367e-02_r8,2.1591e-02_r8,2.7893e-02_r8/) + kao(:, 4,11) = (/ & + &7.8825e-03_r8,1.0755e-02_r8,1.4391e-02_r8,1.9071e-02_r8,2.4702e-02_r8/) + kao(:, 5,11) = (/ & + &6.5907e-03_r8,9.1636e-03_r8,1.2468e-02_r8,1.6782e-02_r8,2.1901e-02_r8/) + kao(:, 6,11) = (/ & + &5.2625e-03_r8,7.5549e-03_r8,1.0521e-02_r8,1.4321e-02_r8,1.8906e-02_r8/) + kao(:, 7,11) = (/ & + &1.3421e-03_r8,5.0016e-03_r8,8.2742e-03_r8,1.0825e-02_r8,1.4096e-02_r8/) + kao(:, 8,11) = (/ & + &1.1288e-03_r8,2.7904e-03_r8,2.9048e-03_r8,3.8915e-03_r8,1.0764e-02_r8/) + kao(:, 9,11) = (/ & + &1.1212e-03_r8,3.3992e-03_r8,2.3130e-03_r8,2.5518e-03_r8,6.4495e-03_r8/) + kao(:,10,11) = (/ & + &2.4789e-05_r8,3.8028e-05_r8,7.9034e-03_r8,4.9082e-03_r8,4.7487e-03_r8/) + kao(:,11,11) = (/ & + &1.5630e-05_r8,2.4780e-05_r8,3.4663e-05_r8,4.3353e-05_r8,1.1174e-02_r8/) + kao(:,12,11) = (/ & + &1.2516e-05_r8,1.8590e-05_r8,2.5768e-05_r8,3.2997e-05_r8,7.6429e-03_r8/) + kao(:,13,11) = (/ & + &9.1474e-06_r8,1.3280e-05_r8,1.7796e-05_r8,2.4600e-05_r8,8.5245e-03_r8/) + kao(:, 1,12) = (/ & + &1.9137e-02_r8,2.4205e-02_r8,3.0237e-02_r8,3.7229e-02_r8,4.5273e-02_r8/) + kao(:, 2,12) = (/ & + &1.6304e-02_r8,2.1414e-02_r8,2.7665e-02_r8,3.5151e-02_r8,4.3535e-02_r8/) + kao(:, 3,12) = (/ & + &1.3446e-02_r8,1.8468e-02_r8,2.4699e-02_r8,3.1802e-02_r8,4.0159e-02_r8/) + kao(:, 4,12) = (/ & + &1.0988e-02_r8,1.5565e-02_r8,2.1262e-02_r8,2.7914e-02_r8,3.5968e-02_r8/) + kao(:, 5,12) = (/ & + &9.1659e-03_r8,1.3233e-02_r8,1.8175e-02_r8,2.4059e-02_r8,3.1596e-02_r8/) + kao(:, 6,12) = (/ & + &7.6758e-03_r8,1.1199e-02_r8,1.5520e-02_r8,2.0906e-02_r8,2.7754e-02_r8/) + kao(:, 7,12) = (/ & + &5.4756e-03_r8,9.3901e-03_r8,1.3292e-02_r8,1.8129e-02_r8,2.3738e-02_r8/) + kao(:, 8,12) = (/ & + &8.4306e-04_r8,3.0332e-03_r8,3.5332e-03_r8,1.1602e-02_r8,1.7968e-02_r8/) + kao(:, 9,12) = (/ & + &1.4946e-03_r8,1.5749e-03_r8,3.2158e-03_r8,3.1867e-03_r8,3.5737e-03_r8/) + kao(:,10,12) = (/ & + &2.3105e-05_r8,3.7657e-05_r8,5.4692e-05_r8,1.0942e-02_r8,7.6646e-03_r8/) + kao(:,11,12) = (/ & + &1.6278e-05_r8,2.6849e-05_r8,3.8655e-05_r8,5.4498e-05_r8,7.7401e-03_r8/) + kao(:,12,12) = (/ & + &1.1713e-05_r8,1.9330e-05_r8,2.9159e-05_r8,3.9386e-05_r8,5.6995e-05_r8/) + kao(:,13,12) = (/ & + &9.2970e-06_r8,1.5197e-05_r8,2.2881e-05_r8,3.3051e-05_r8,4.6248e-05_r8/) + kao(:, 1,13) = (/ & + &3.6366e-02_r8,4.6887e-02_r8,5.8513e-02_r8,7.0986e-02_r8,8.4117e-02_r8/) + kao(:, 2,13) = (/ & + &3.3990e-02_r8,4.3857e-02_r8,5.4708e-02_r8,6.6354e-02_r8,7.9156e-02_r8/) + kao(:, 3,13) = (/ & + &2.8482e-02_r8,3.7147e-02_r8,4.6806e-02_r8,5.7889e-02_r8,7.0408e-02_r8/) + kao(:, 4,13) = (/ & + &2.2450e-02_r8,2.9975e-02_r8,3.8835e-02_r8,4.9297e-02_r8,6.1450e-02_r8/) + kao(:, 5,13) = (/ & + &1.7322e-02_r8,2.3874e-02_r8,3.2063e-02_r8,4.2032e-02_r8,5.3868e-02_r8/) + kao(:, 6,13) = (/ & + &1.3022e-02_r8,1.8695e-02_r8,2.6114e-02_r8,3.5380e-02_r8,4.6717e-02_r8/) + kao(:, 7,13) = (/ & + &9.9635e-03_r8,1.4798e-02_r8,2.1337e-02_r8,2.9901e-02_r8,4.0578e-02_r8/) + kao(:, 8,13) = (/ & + &9.7470e-04_r8,2.7616e-03_r8,1.5907e-02_r8,2.2415e-02_r8,2.7492e-02_r8/) + kao(:, 9,13) = (/ & + &1.9362e-03_r8,1.8145e-03_r8,4.1737e-03_r8,3.7651e-03_r8,6.5913e-03_r8/) + kao(:,10,13) = (/ & + &2.8915e-05_r8,4.8621e-05_r8,6.9201e-05_r8,8.4840e-03_r8,1.1790e-02_r8/) + kao(:,11,13) = (/ & + &2.3309e-05_r8,3.4553e-05_r8,5.2552e-05_r8,7.2505e-05_r8,8.3347e-05_r8/) + kao(:,12,13) = (/ & + &1.5870e-05_r8,2.3577e-05_r8,3.4029e-05_r8,5.3277e-05_r8,6.5207e-05_r8/) + kao(:,13,13) = (/ & + &1.1931e-05_r8,1.9929e-05_r8,2.7393e-05_r8,3.2822e-05_r8,4.4265e-05_r8/) + kao(:, 1,14) = (/ & + &6.9682e-02_r8,8.7076e-02_r8,1.0644e-01_r8,1.2772e-01_r8,1.5052e-01_r8/) + kao(:, 2,14) = (/ & + &6.7443e-02_r8,8.6048e-02_r8,1.0697e-01_r8,1.3011e-01_r8,1.5516e-01_r8/) + kao(:, 3,14) = (/ & + &6.1305e-02_r8,8.0158e-02_r8,1.0175e-01_r8,1.2582e-01_r8,1.5220e-01_r8/) + kao(:, 4,14) = (/ & + &5.3357e-02_r8,7.1652e-02_r8,9.2935e-02_r8,1.1706e-01_r8,1.4376e-01_r8/) + kao(:, 5,14) = (/ & + &4.5060e-02_r8,6.2229e-02_r8,8.2609e-02_r8,1.0608e-01_r8,1.3238e-01_r8/) + kao(:, 6,14) = (/ & + &3.6438e-02_r8,5.1966e-02_r8,7.0824e-02_r8,9.2958e-02_r8,1.1819e-01_r8/) + kao(:, 7,14) = (/ & + &2.8491e-02_r8,4.2112e-02_r8,5.9112e-02_r8,7.9508e-02_r8,1.0325e-01_r8/) + kao(:, 8,14) = (/ & + &1.8236e-02_r8,3.3304e-02_r8,4.8438e-02_r8,6.6896e-02_r8,8.8683e-02_r8/) + kao(:, 9,14) = (/ & + &2.4537e-03_r8,2.3453e-03_r8,8.8067e-03_r8,2.0762e-02_r8,4.5513e-02_r8/) + kao(:,10,14) = (/ & + &1.4330e-05_r8,1.7518e-05_r8,3.1868e-05_r8,4.9025e-05_r8,3.3153e-02_r8/) + kao(:,11,14) = (/ & + &1.4087e-05_r8,2.3580e-05_r8,3.6793e-05_r8,4.1734e-05_r8,4.2976e-05_r8/) + kao(:,12,14) = (/ & + &1.3087e-05_r8,2.2036e-05_r8,3.4770e-05_r8,3.7226e-05_r8,3.8663e-05_r8/) + kao(:,13,14) = (/ & + &6.3004e-06_r8,7.4647e-06_r8,1.3256e-05_r8,1.9422e-05_r8,2.7358e-05_r8/) + kao(:, 1,15) = (/ & + &1.0457e-01_r8,1.3337e-01_r8,1.6543e-01_r8,2.0044e-01_r8,2.3788e-01_r8/) + kao(:, 2,15) = (/ & + &1.1420e-01_r8,1.4734e-01_r8,1.8451e-01_r8,2.2524e-01_r8,2.6907e-01_r8/) + kao(:, 3,15) = (/ & + &1.1631e-01_r8,1.5291e-01_r8,1.9437e-01_r8,2.4033e-01_r8,2.9013e-01_r8/) + kao(:, 4,15) = (/ & + &1.1302e-01_r8,1.5183e-01_r8,1.9657e-01_r8,2.4665e-01_r8,3.0148e-01_r8/) + kao(:, 5,15) = (/ & + &1.0669e-01_r8,1.4681e-01_r8,1.9375e-01_r8,2.4698e-01_r8,3.0586e-01_r8/) + kao(:, 6,15) = (/ & + &9.6727e-02_r8,1.3681e-01_r8,1.8458e-01_r8,2.3961e-01_r8,3.0104e-01_r8/) + kao(:, 7,15) = (/ & + &8.4990e-02_r8,1.2388e-01_r8,1.7124e-01_r8,2.2660e-01_r8,2.8964e-01_r8/) + kao(:, 8,15) = (/ & + &7.2581e-02_r8,1.0932e-01_r8,1.5506e-01_r8,2.1052e-01_r8,2.7593e-01_r8/) + kao(:, 9,15) = (/ & + &2.1552e-02_r8,6.6962e-02_r8,1.2166e-01_r8,1.8985e-01_r8,2.2620e-01_r8/) + kao(:,10,15) = (/ & + &8.5757e-06_r8,7.9319e-06_r8,7.5384e-06_r8,5.2149e-06_r8,3.5776e-06_r8/) + kao(:,11,15) = (/ & + &7.3855e-06_r8,7.4681e-06_r8,7.1804e-06_r8,6.5771e-06_r8,3.3890e-06_r8/) + kao(:,12,15) = (/ & + &5.9318e-06_r8,6.7082e-06_r8,7.4828e-06_r8,6.0815e-06_r8,3.2500e-06_r8/) + kao(:,13,15) = (/ & + &7.9734e-06_r8,1.0467e-05_r8,1.8551e-05_r8,3.3018e-05_r8,1.4396e-05_r8/) + kao(:, 1,16) = (/ & + &1.0940e-01_r8,1.4000e-01_r8,1.7421e-01_r8,2.1173e-01_r8,2.5214e-01_r8/) + kao(:, 2,16) = (/ & + &1.2207e-01_r8,1.5824e-01_r8,1.9908e-01_r8,2.4418e-01_r8,2.9310e-01_r8/) + kao(:, 3,16) = (/ & + &1.2803e-01_r8,1.6941e-01_r8,2.1687e-01_r8,2.6992e-01_r8,3.2810e-01_r8/) + kao(:, 4,16) = (/ & + &1.2912e-01_r8,1.7512e-01_r8,2.2885e-01_r8,2.8989e-01_r8,3.5760e-01_r8/) + kao(:, 5,16) = (/ & + &1.2782e-01_r8,1.7809e-01_r8,2.3798e-01_r8,3.0717e-01_r8,3.8500e-01_r8/) + kao(:, 6,16) = (/ & + &1.2288e-01_r8,1.7665e-01_r8,2.4226e-01_r8,3.1945e-01_r8,4.0769e-01_r8/) + kao(:, 7,16) = (/ & + &1.1601e-01_r8,1.7265e-01_r8,2.4356e-01_r8,3.2874e-01_r8,4.2783e-01_r8/) + kao(:, 8,16) = (/ & + &1.0802e-01_r8,1.6690e-01_r8,2.4265e-01_r8,3.3582e-01_r8,4.4617e-01_r8/) + kao(:, 9,16) = (/ & + &9.8584e-02_r8,1.5878e-01_r8,2.3864e-01_r8,3.3924e-01_r8,4.6085e-01_r8/) + kao(:,10,16) = (/ & + &2.5370e-06_r8,3.6996e-06_r8,5.1180e-06_r8,9.0911e-06_r8,1.0521e-05_r8/) + kao(:,11,16) = (/ & + &2.1410e-06_r8,3.1393e-06_r8,2.7559e-06_r8,9.6933e-06_r8,1.1052e-05_r8/) + kao(:,12,16) = (/ & + &1.7911e-06_r8,2.0648e-06_r8,1.9476e-06_r8,1.0250e-05_r8,1.1569e-05_r8/) + kao(:,13,16) = (/ & + &6.8424e-07_r8,2.1307e-05_r8,3.0235e-05_r8,1.0419e-05_r8,1.1877e-05_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &2.1590e-02_r8,2.2747e-02_r8,2.3755e-02_r8,2.4762e-02_r8,2.5739e-02_r8/) + kbo(:,14, 1) = (/ & + &1.5891e-02_r8,1.6865e-02_r8,1.7785e-02_r8,1.8588e-02_r8,1.9375e-02_r8/) + kbo(:,15, 1) = (/ & + &1.2008e-02_r8,1.2891e-02_r8,1.3700e-02_r8,1.4369e-02_r8,1.4970e-02_r8/) + kbo(:,16, 1) = (/ & + &9.5594e-03_r8,1.0266e-02_r8,1.0893e-02_r8,1.1429e-02_r8,1.1863e-02_r8/) + kbo(:,17, 1) = (/ & + &7.6979e-03_r8,8.2617e-03_r8,8.7527e-03_r8,9.1620e-03_r8,9.5161e-03_r8/) + kbo(:,18, 1) = (/ & + &6.2689e-03_r8,6.7130e-03_r8,7.1029e-03_r8,7.4199e-03_r8,7.7032e-03_r8/) + kbo(:,19, 1) = (/ & + &5.1124e-03_r8,5.4669e-03_r8,5.7636e-03_r8,6.0175e-03_r8,6.2439e-03_r8/) + kbo(:,20, 1) = (/ & + &4.2074e-03_r8,4.4879e-03_r8,4.7226e-03_r8,4.9240e-03_r8,5.1066e-03_r8/) + kbo(:,21, 1) = (/ & + &3.4689e-03_r8,3.6905e-03_r8,3.8771e-03_r8,4.0402e-03_r8,4.1874e-03_r8/) + kbo(:,22, 1) = (/ & + &2.8675e-03_r8,3.0422e-03_r8,3.1923e-03_r8,3.3247e-03_r8,3.4419e-03_r8/) + kbo(:,23, 1) = (/ & + &2.3673e-03_r8,2.5068e-03_r8,2.6269e-03_r8,2.7338e-03_r8,2.8272e-03_r8/) + kbo(:,24, 1) = (/ & + &1.9512e-03_r8,2.0620e-03_r8,2.1580e-03_r8,2.2436e-03_r8,2.3178e-03_r8/) + kbo(:,25, 1) = (/ & + &1.6104e-03_r8,1.6991e-03_r8,1.7756e-03_r8,1.8445e-03_r8,1.9031e-03_r8/) + kbo(:,26, 1) = (/ & + &1.3324e-03_r8,1.4030e-03_r8,1.4641e-03_r8,1.5181e-03_r8,1.5647e-03_r8/) + kbo(:,27, 1) = (/ & + &1.1030e-03_r8,1.1588e-03_r8,1.2079e-03_r8,1.2506e-03_r8,1.2885e-03_r8/) + kbo(:,28, 1) = (/ & + &9.1277e-04_r8,9.5694e-04_r8,9.9621e-04_r8,1.0308e-03_r8,1.0603e-03_r8/) + kbo(:,29, 1) = (/ & + &7.5709e-04_r8,7.9257e-04_r8,8.2415e-04_r8,8.5205e-04_r8,8.7500e-04_r8/) + kbo(:,30, 1) = (/ & + &6.2805e-04_r8,6.5667e-04_r8,6.8205e-04_r8,7.0403e-04_r8,7.2224e-04_r8/) + kbo(:,31, 1) = (/ & + &5.2190e-04_r8,5.4469e-04_r8,5.6521e-04_r8,5.8274e-04_r8,5.9713e-04_r8/) + kbo(:,32, 1) = (/ & + &4.3349e-04_r8,4.5214e-04_r8,4.6842e-04_r8,4.8237e-04_r8,4.9367e-04_r8/) + kbo(:,33, 1) = (/ & + &3.5999e-04_r8,3.7522e-04_r8,3.8828e-04_r8,3.9917e-04_r8,4.0831e-04_r8/) + kbo(:,34, 1) = (/ & + &2.9885e-04_r8,3.1108e-04_r8,3.2123e-04_r8,3.3020e-04_r8,3.3735e-04_r8/) + kbo(:,35, 1) = (/ & + &2.4686e-04_r8,2.5649e-04_r8,2.6489e-04_r8,2.7217e-04_r8,2.7798e-04_r8/) + kbo(:,36, 1) = (/ & + &2.0249e-04_r8,2.1050e-04_r8,2.1752e-04_r8,2.2349e-04_r8,2.2845e-04_r8/) + kbo(:,37, 1) = (/ & + &1.6556e-04_r8,1.7221e-04_r8,1.7821e-04_r8,1.8323e-04_r8,1.8756e-04_r8/) + kbo(:,38, 1) = (/ & + &1.3530e-04_r8,1.4093e-04_r8,1.4599e-04_r8,1.5028e-04_r8,1.5406e-04_r8/) + kbo(:,39, 1) = (/ & + &1.1062e-04_r8,1.1539e-04_r8,1.1961e-04_r8,1.2331e-04_r8,1.2663e-04_r8/) + kbo(:,40, 1) = (/ & + &8.9884e-05_r8,9.3980e-05_r8,9.7546e-05_r8,1.0075e-04_r8,1.0361e-04_r8/) + kbo(:,41, 1) = (/ & + &7.2964e-05_r8,7.6433e-05_r8,7.9468e-05_r8,8.2219e-05_r8,8.4723e-05_r8/) + kbo(:,42, 1) = (/ & + &5.9182e-05_r8,6.2146e-05_r8,6.4721e-05_r8,6.7085e-05_r8,6.9267e-05_r8/) + kbo(:,43, 1) = (/ & + &4.7864e-05_r8,5.0382e-05_r8,5.2591e-05_r8,5.4634e-05_r8,5.6528e-05_r8/) + kbo(:,44, 1) = (/ & + &3.8628e-05_r8,4.0783e-05_r8,4.2701e-05_r8,4.4436e-05_r8,4.6114e-05_r8/) + kbo(:,45, 1) = (/ & + &3.1127e-05_r8,3.3002e-05_r8,3.4654e-05_r8,3.6151e-05_r8,3.7566e-05_r8/) + kbo(:,46, 1) = (/ & + &2.5026e-05_r8,2.6649e-05_r8,2.8068e-05_r8,2.9367e-05_r8,3.0563e-05_r8/) + kbo(:,47, 1) = (/ & + &2.0040e-05_r8,2.1423e-05_r8,2.2656e-05_r8,2.3781e-05_r8,2.4816e-05_r8/) + kbo(:,48, 1) = (/ & + &1.6036e-05_r8,1.7209e-05_r8,1.8283e-05_r8,1.9267e-05_r8,2.0138e-05_r8/) + kbo(:,49, 1) = (/ & + &1.2828e-05_r8,1.3830e-05_r8,1.4752e-05_r8,1.5602e-05_r8,1.6354e-05_r8/) + kbo(:,50, 1) = (/ & + &1.0257e-05_r8,1.1106e-05_r8,1.1884e-05_r8,1.2616e-05_r8,1.3265e-05_r8/) + kbo(:,51, 1) = (/ & + &8.1934e-06_r8,8.9110e-06_r8,9.5669e-06_r8,1.0186e-05_r8,1.0748e-05_r8/) + kbo(:,52, 1) = (/ & + &6.5467e-06_r8,7.1424e-06_r8,7.7065e-06_r8,8.2286e-06_r8,8.7123e-06_r8/) + kbo(:,53, 1) = (/ & + &5.2332e-06_r8,5.7328e-06_r8,6.2119e-06_r8,6.6510e-06_r8,7.0700e-06_r8/) + kbo(:,54, 1) = (/ & + &4.1577e-06_r8,4.5779e-06_r8,4.9804e-06_r8,5.3498e-06_r8,5.7020e-06_r8/) + kbo(:,55, 1) = (/ & + &3.2878e-06_r8,3.6403e-06_r8,3.9741e-06_r8,4.2805e-06_r8,4.5760e-06_r8/) + kbo(:,56, 1) = (/ & + &2.5965e-06_r8,2.8911e-06_r8,3.1663e-06_r8,3.4265e-06_r8,3.6666e-06_r8/) + kbo(:,57, 1) = (/ & + &2.0466e-06_r8,2.2908e-06_r8,2.5217e-06_r8,2.7403e-06_r8,2.9373e-06_r8/) + kbo(:,58, 1) = (/ & + &1.6093e-06_r8,1.8128e-06_r8,2.0059e-06_r8,2.1882e-06_r8,2.3529e-06_r8/) + kbo(:,59, 1) = (/ & + &1.2776e-06_r8,1.4459e-06_r8,1.6042e-06_r8,1.7524e-06_r8,1.8906e-06_r8/) + kbo(:,13, 2) = (/ & + &3.8014e-02_r8,3.9737e-02_r8,4.1825e-02_r8,4.3879e-02_r8,4.5802e-02_r8/) + kbo(:,14, 2) = (/ & + &3.0759e-02_r8,3.2195e-02_r8,3.3860e-02_r8,3.5735e-02_r8,3.7445e-02_r8/) + kbo(:,15, 2) = (/ & + &2.4737e-02_r8,2.6065e-02_r8,2.7499e-02_r8,2.8985e-02_r8,3.0345e-02_r8/) + kbo(:,16, 2) = (/ & + &2.0386e-02_r8,2.1604e-02_r8,2.2870e-02_r8,2.4062e-02_r8,2.5169e-02_r8/) + kbo(:,17, 2) = (/ & + &1.6973e-02_r8,1.8030e-02_r8,1.9046e-02_r8,1.9999e-02_r8,2.0836e-02_r8/) + kbo(:,18, 2) = (/ & + &1.4179e-02_r8,1.5045e-02_r8,1.5843e-02_r8,1.6598e-02_r8,1.7207e-02_r8/) + kbo(:,19, 2) = (/ & + &1.1784e-02_r8,1.2488e-02_r8,1.3131e-02_r8,1.3688e-02_r8,1.4139e-02_r8/) + kbo(:,20, 2) = (/ & + &9.8208e-03_r8,1.0377e-02_r8,1.0872e-02_r8,1.1296e-02_r8,1.1641e-02_r8/) + kbo(:,21, 2) = (/ & + &8.1632e-03_r8,8.5996e-03_r8,8.9808e-03_r8,9.3040e-03_r8,9.5696e-03_r8/) + kbo(:,22, 2) = (/ & + &6.7970e-03_r8,7.1290e-03_r8,7.4204e-03_r8,7.6665e-03_r8,7.8692e-03_r8/) + kbo(:,23, 2) = (/ & + &5.6384e-03_r8,5.8917e-03_r8,6.1228e-03_r8,6.3098e-03_r8,6.4698e-03_r8/) + kbo(:,24, 2) = (/ & + &4.6602e-03_r8,4.8595e-03_r8,5.0396e-03_r8,5.1884e-03_r8,5.3131e-03_r8/) + kbo(:,25, 2) = (/ & + &3.8492e-03_r8,4.0101e-03_r8,4.1507e-03_r8,4.2656e-03_r8,4.3666e-03_r8/) + kbo(:,26, 2) = (/ & + &3.1817e-03_r8,3.3089e-03_r8,3.4202e-03_r8,3.5130e-03_r8,3.5943e-03_r8/) + kbo(:,27, 2) = (/ & + &2.6312e-03_r8,2.7340e-03_r8,2.8215e-03_r8,2.8952e-03_r8,2.9585e-03_r8/) + kbo(:,28, 2) = (/ & + &2.1766e-03_r8,2.2592e-03_r8,2.3277e-03_r8,2.3874e-03_r8,2.4369e-03_r8/) + kbo(:,29, 2) = (/ & + &1.8050e-03_r8,1.8690e-03_r8,1.9243e-03_r8,1.9721e-03_r8,2.0134e-03_r8/) + kbo(:,30, 2) = (/ & + &1.4965e-03_r8,1.5474e-03_r8,1.5922e-03_r8,1.6307e-03_r8,1.6644e-03_r8/) + kbo(:,31, 2) = (/ & + &1.2416e-03_r8,1.2835e-03_r8,1.3200e-03_r8,1.3519e-03_r8,1.3783e-03_r8/) + kbo(:,32, 2) = (/ & + &1.0308e-03_r8,1.0652e-03_r8,1.0950e-03_r8,1.1207e-03_r8,1.1427e-03_r8/) + kbo(:,33, 2) = (/ & + &8.5698e-04_r8,8.8430e-04_r8,9.0863e-04_r8,9.2966e-04_r8,9.4803e-04_r8/) + kbo(:,34, 2) = (/ & + &7.1109e-04_r8,7.3332e-04_r8,7.5331e-04_r8,7.7074e-04_r8,7.8601e-04_r8/) + kbo(:,35, 2) = (/ & + &5.8729e-04_r8,6.0603e-04_r8,6.2268e-04_r8,6.3737e-04_r8,6.5045e-04_r8/) + kbo(:,36, 2) = (/ & + &4.8310e-04_r8,4.9861e-04_r8,5.1251e-04_r8,5.2508e-04_r8,5.3615e-04_r8/) + kbo(:,37, 2) = (/ & + &3.9625e-04_r8,4.0955e-04_r8,4.2151e-04_r8,4.3225e-04_r8,4.4172e-04_r8/) + kbo(:,38, 2) = (/ & + &3.2503e-04_r8,3.3643e-04_r8,3.4664e-04_r8,3.5587e-04_r8,3.6445e-04_r8/) + kbo(:,39, 2) = (/ & + &2.6664e-04_r8,2.7639e-04_r8,2.8514e-04_r8,2.9332e-04_r8,3.0098e-04_r8/) + kbo(:,40, 2) = (/ & + &2.1759e-04_r8,2.2608e-04_r8,2.3348e-04_r8,2.4050e-04_r8,2.4712e-04_r8/) + kbo(:,41, 2) = (/ & + &1.7739e-04_r8,1.8462e-04_r8,1.9097e-04_r8,1.9703e-04_r8,2.0268e-04_r8/) + kbo(:,42, 2) = (/ & + &1.4453e-04_r8,1.5070e-04_r8,1.5612e-04_r8,1.6130e-04_r8,1.6626e-04_r8/) + kbo(:,43, 2) = (/ & + &1.1750e-04_r8,1.2276e-04_r8,1.2736e-04_r8,1.3185e-04_r8,1.3616e-04_r8/) + kbo(:,44, 2) = (/ & + &9.5367e-05_r8,9.9857e-05_r8,1.0380e-04_r8,1.0768e-04_r8,1.1140e-04_r8/) + kbo(:,45, 2) = (/ & + &7.7428e-05_r8,8.1152e-05_r8,8.4582e-05_r8,8.7898e-05_r8,9.1175e-05_r8/) + kbo(:,46, 2) = (/ & + &6.2722e-05_r8,6.5854e-05_r8,6.8828e-05_r8,7.1656e-05_r8,7.4494e-05_r8/) + kbo(:,47, 2) = (/ & + &5.0620e-05_r8,5.3291e-05_r8,5.5834e-05_r8,5.8234e-05_r8,6.0703e-05_r8/) + kbo(:,48, 2) = (/ & + &4.0839e-05_r8,4.3112e-05_r8,4.5285e-05_r8,4.7326e-05_r8,4.9468e-05_r8/) + kbo(:,49, 2) = (/ & + &3.2956e-05_r8,3.4871e-05_r8,3.6734e-05_r8,3.8477e-05_r8,4.0339e-05_r8/) + kbo(:,50, 2) = (/ & + &2.6578e-05_r8,2.8186e-05_r8,2.9765e-05_r8,3.1246e-05_r8,3.2810e-05_r8/) + kbo(:,51, 2) = (/ & + &2.1419e-05_r8,2.2753e-05_r8,2.4086e-05_r8,2.5342e-05_r8,2.6653e-05_r8/) + kbo(:,52, 2) = (/ & + &1.7265e-05_r8,1.8376e-05_r8,1.9492e-05_r8,2.0556e-05_r8,2.1651e-05_r8/) + kbo(:,53, 2) = (/ & + &1.3928e-05_r8,1.4844e-05_r8,1.5782e-05_r8,1.6689e-05_r8,1.7614e-05_r8/) + kbo(:,54, 2) = (/ & + &1.1205e-05_r8,1.1963e-05_r8,1.2726e-05_r8,1.3478e-05_r8,1.4240e-05_r8/) + kbo(:,55, 2) = (/ & + &8.9889e-06_r8,9.6190e-06_r8,1.0235e-05_r8,1.0868e-05_r8,1.1479e-05_r8/) + kbo(:,56, 2) = (/ & + &7.2032e-06_r8,7.7304e-06_r8,8.2333e-06_r8,8.7486e-06_r8,9.2547e-06_r8/) + kbo(:,57, 2) = (/ & + &5.7621e-06_r8,6.2097e-06_r8,6.6195e-06_r8,7.0372e-06_r8,7.4615e-06_r8/) + kbo(:,58, 2) = (/ & + &4.6073e-06_r8,4.9865e-06_r8,5.3240e-06_r8,5.6615e-06_r8,6.0083e-06_r8/) + kbo(:,59, 2) = (/ & + &3.7094e-06_r8,4.0178e-06_r8,4.3021e-06_r8,4.5755e-06_r8,4.8477e-06_r8/) + kbo(:,13, 3) = (/ & + &6.3405e-02_r8,6.5846e-02_r8,6.7902e-02_r8,7.0344e-02_r8,7.3087e-02_r8/) + kbo(:,14, 3) = (/ & + &5.1252e-02_r8,5.3361e-02_r8,5.5658e-02_r8,5.8048e-02_r8,6.0738e-02_r8/) + kbo(:,15, 3) = (/ & + &4.2340e-02_r8,4.4418e-02_r8,4.6657e-02_r8,4.8923e-02_r8,5.1338e-02_r8/) + kbo(:,16, 3) = (/ & + &3.5507e-02_r8,3.7339e-02_r8,3.9465e-02_r8,4.1652e-02_r8,4.3669e-02_r8/) + kbo(:,17, 3) = (/ & + &2.9824e-02_r8,3.1523e-02_r8,3.3435e-02_r8,3.5273e-02_r8,3.6953e-02_r8/) + kbo(:,18, 3) = (/ & + &2.5125e-02_r8,2.6683e-02_r8,2.8323e-02_r8,2.9797e-02_r8,3.1126e-02_r8/) + kbo(:,19, 3) = (/ & + &2.1223e-02_r8,2.2544e-02_r8,2.3820e-02_r8,2.4985e-02_r8,2.5990e-02_r8/) + kbo(:,20, 3) = (/ & + &1.7915e-02_r8,1.8986e-02_r8,1.9994e-02_r8,2.0861e-02_r8,2.1602e-02_r8/) + kbo(:,21, 3) = (/ & + &1.5062e-02_r8,1.5916e-02_r8,1.6665e-02_r8,1.7312e-02_r8,1.7872e-02_r8/) + kbo(:,22, 3) = (/ & + &1.2635e-02_r8,1.3292e-02_r8,1.3846e-02_r8,1.4329e-02_r8,1.4769e-02_r8/) + kbo(:,23, 3) = (/ & + &1.0554e-02_r8,1.1051e-02_r8,1.1464e-02_r8,1.1841e-02_r8,1.2180e-02_r8/) + kbo(:,24, 3) = (/ & + &8.7770e-03_r8,9.1488e-03_r8,9.4668e-03_r8,9.7625e-03_r8,1.0031e-02_r8/) + kbo(:,25, 3) = (/ & + &7.2756e-03_r8,7.5544e-03_r8,7.8035e-03_r8,8.0431e-03_r8,8.2495e-03_r8/) + kbo(:,26, 3) = (/ & + &6.0226e-03_r8,6.2378e-03_r8,6.4382e-03_r8,6.6253e-03_r8,6.7857e-03_r8/) + kbo(:,27, 3) = (/ & + &4.9811e-03_r8,5.1501e-03_r8,5.3115e-03_r8,5.4587e-03_r8,5.5851e-03_r8/) + kbo(:,28, 3) = (/ & + &4.1172e-03_r8,4.2566e-03_r8,4.3852e-03_r8,4.4995e-03_r8,4.6022e-03_r8/) + kbo(:,29, 3) = (/ & + &3.4101e-03_r8,3.5232e-03_r8,3.6273e-03_r8,3.7181e-03_r8,3.8009e-03_r8/) + kbo(:,30, 3) = (/ & + &2.8248e-03_r8,2.9164e-03_r8,2.9992e-03_r8,3.0754e-03_r8,3.1419e-03_r8/) + kbo(:,31, 3) = (/ & + &2.3450e-03_r8,2.4195e-03_r8,2.4879e-03_r8,2.5493e-03_r8,2.6070e-03_r8/) + kbo(:,32, 3) = (/ & + &1.9491e-03_r8,2.0095e-03_r8,2.0670e-03_r8,2.1190e-03_r8,2.1683e-03_r8/) + kbo(:,33, 3) = (/ & + &1.6195e-03_r8,1.6713e-03_r8,1.7189e-03_r8,1.7649e-03_r8,1.8032e-03_r8/) + kbo(:,34, 3) = (/ & + &1.3454e-03_r8,1.3883e-03_r8,1.4290e-03_r8,1.4663e-03_r8,1.4976e-03_r8/) + kbo(:,35, 3) = (/ & + &1.1151e-03_r8,1.1504e-03_r8,1.1846e-03_r8,1.2147e-03_r8,1.2425e-03_r8/) + kbo(:,36, 3) = (/ & + &9.1872e-04_r8,9.4904e-04_r8,9.7800e-04_r8,1.0033e-03_r8,1.0278e-03_r8/) + kbo(:,37, 3) = (/ & + &7.5556e-04_r8,7.8161e-04_r8,8.0630e-04_r8,8.2845e-04_r8,8.4914e-04_r8/) + kbo(:,38, 3) = (/ & + &6.2192e-04_r8,6.4458e-04_r8,6.6572e-04_r8,6.8474e-04_r8,7.0313e-04_r8/) + kbo(:,39, 3) = (/ & + &5.1238e-04_r8,5.3172e-04_r8,5.4973e-04_r8,5.6636e-04_r8,5.8235e-04_r8/) + kbo(:,40, 3) = (/ & + &4.1982e-04_r8,4.3621e-04_r8,4.5139e-04_r8,4.6596e-04_r8,4.7961e-04_r8/) + kbo(:,41, 3) = (/ & + &3.4388e-04_r8,3.5746e-04_r8,3.7054e-04_r8,3.8291e-04_r8,3.9470e-04_r8/) + kbo(:,42, 3) = (/ & + &2.8144e-04_r8,2.9295e-04_r8,3.0424e-04_r8,3.1457e-04_r8,3.2459e-04_r8/) + kbo(:,43, 3) = (/ & + &2.2990e-04_r8,2.3955e-04_r8,2.4928e-04_r8,2.5827e-04_r8,2.6672e-04_r8/) + kbo(:,44, 3) = (/ & + &1.8744e-04_r8,1.9582e-04_r8,2.0413e-04_r8,2.1176e-04_r8,2.1912e-04_r8/) + kbo(:,45, 3) = (/ & + &1.5285e-04_r8,1.6000e-04_r8,1.6711e-04_r8,1.7363e-04_r8,1.7993e-04_r8/) + kbo(:,46, 3) = (/ & + &1.2448e-04_r8,1.3059e-04_r8,1.3656e-04_r8,1.4216e-04_r8,1.4758e-04_r8/) + kbo(:,47, 3) = (/ & + &1.0103e-04_r8,1.0628e-04_r8,1.1130e-04_r8,1.1611e-04_r8,1.2074e-04_r8/) + kbo(:,48, 3) = (/ & + &8.1983e-05_r8,8.6504e-05_r8,9.0728e-05_r8,9.4862e-05_r8,9.8826e-05_r8/) + kbo(:,49, 3) = (/ & + &6.6563e-05_r8,7.0429e-05_r8,7.4014e-05_r8,7.7542e-05_r8,8.0976e-05_r8/) + kbo(:,50, 3) = (/ & + &5.3952e-05_r8,5.7235e-05_r8,6.0247e-05_r8,6.3258e-05_r8,6.6182e-05_r8/) + kbo(:,51, 3) = (/ & + &4.3663e-05_r8,4.6470e-05_r8,4.9001e-05_r8,5.1519e-05_r8,5.4013e-05_r8/) + kbo(:,52, 3) = (/ & + &3.5323e-05_r8,3.7705e-05_r8,3.9846e-05_r8,4.1973e-05_r8,4.4086e-05_r8/) + kbo(:,53, 3) = (/ & + &2.8583e-05_r8,3.0614e-05_r8,3.2428e-05_r8,3.4214e-05_r8,3.6024e-05_r8/) + kbo(:,54, 3) = (/ & + &2.3052e-05_r8,2.4741e-05_r8,2.6291e-05_r8,2.7754e-05_r8,2.9233e-05_r8/) + kbo(:,55, 3) = (/ & + &1.8532e-05_r8,1.9924e-05_r8,2.1226e-05_r8,2.2443e-05_r8,2.3644e-05_r8/) + kbo(:,56, 3) = (/ & + &1.4892e-05_r8,1.6026e-05_r8,1.7132e-05_r8,1.8148e-05_r8,1.9127e-05_r8/) + kbo(:,57, 3) = (/ & + &1.1957e-05_r8,1.2880e-05_r8,1.3809e-05_r8,1.4669e-05_r8,1.5458e-05_r8/) + kbo(:,58, 3) = (/ & + &9.6000e-06_r8,1.0349e-05_r8,1.1127e-05_r8,1.1847e-05_r8,1.2497e-05_r8/) + kbo(:,59, 3) = (/ & + &7.7452e-06_r8,8.3627e-06_r8,8.9895e-06_r8,9.5703e-06_r8,1.0120e-05_r8/) + kbo(:,13, 4) = (/ & + &9.9915e-02_r8,1.0385e-01_r8,1.0749e-01_r8,1.1095e-01_r8,1.1480e-01_r8/) + kbo(:,14, 4) = (/ & + &8.4174e-02_r8,8.7314e-02_r8,9.0833e-02_r8,9.4040e-02_r8,9.7483e-02_r8/) + kbo(:,15, 4) = (/ & + &7.1798e-02_r8,7.3772e-02_r8,7.6218e-02_r8,7.9303e-02_r8,8.2911e-02_r8/) + kbo(:,16, 4) = (/ & + &6.0987e-02_r8,6.2861e-02_r8,6.5027e-02_r8,6.7869e-02_r8,7.1492e-02_r8/) + kbo(:,17, 4) = (/ & + &5.1988e-02_r8,5.3759e-02_r8,5.5853e-02_r8,5.8672e-02_r8,6.1980e-02_r8/) + kbo(:,18, 4) = (/ & + &4.4171e-02_r8,4.5935e-02_r8,4.8095e-02_r8,5.0759e-02_r8,5.3616e-02_r8/) + kbo(:,19, 4) = (/ & + &3.7411e-02_r8,3.9215e-02_r8,4.1337e-02_r8,4.3631e-02_r8,4.5910e-02_r8/) + kbo(:,20, 4) = (/ & + &3.1780e-02_r8,3.3510e-02_r8,3.5386e-02_r8,3.7312e-02_r8,3.9095e-02_r8/) + kbo(:,21, 4) = (/ & + &2.6954e-02_r8,2.8513e-02_r8,3.0099e-02_r8,3.1617e-02_r8,3.2915e-02_r8/) + kbo(:,22, 4) = (/ & + &2.2888e-02_r8,2.4194e-02_r8,2.5477e-02_r8,2.6596e-02_r8,2.7511e-02_r8/) + kbo(:,23, 4) = (/ & + &1.9346e-02_r8,2.0404e-02_r8,2.1382e-02_r8,2.2165e-02_r8,2.2830e-02_r8/) + kbo(:,24, 4) = (/ & + &1.6247e-02_r8,1.7083e-02_r8,1.7781e-02_r8,1.8353e-02_r8,1.8851e-02_r8/) + kbo(:,25, 4) = (/ & + &1.3597e-02_r8,1.4221e-02_r8,1.4742e-02_r8,1.5163e-02_r8,1.5551e-02_r8/) + kbo(:,26, 4) = (/ & + &1.1347e-02_r8,1.1808e-02_r8,1.2193e-02_r8,1.2519e-02_r8,1.2827e-02_r8/) + kbo(:,27, 4) = (/ & + &9.4352e-03_r8,9.7820e-03_r8,1.0071e-02_r8,1.0331e-02_r8,1.0583e-02_r8/) + kbo(:,28, 4) = (/ & + &7.8281e-03_r8,8.0857e-03_r8,8.3110e-03_r8,8.5276e-03_r8,8.7304e-03_r8/) + kbo(:,29, 4) = (/ & + &6.4877e-03_r8,6.6881e-03_r8,6.8753e-03_r8,7.0489e-03_r8,7.2105e-03_r8/) + kbo(:,30, 4) = (/ & + &5.3741e-03_r8,5.5372e-03_r8,5.6910e-03_r8,5.8358e-03_r8,5.9652e-03_r8/) + kbo(:,31, 4) = (/ & + &4.4624e-03_r8,4.5974e-03_r8,4.7269e-03_r8,4.8416e-03_r8,4.9477e-03_r8/) + kbo(:,32, 4) = (/ & + &3.7110e-03_r8,3.8251e-03_r8,3.9302e-03_r8,4.0264e-03_r8,4.1112e-03_r8/) + kbo(:,33, 4) = (/ & + &3.0918e-03_r8,3.1864e-03_r8,3.2713e-03_r8,3.3504e-03_r8,3.4219e-03_r8/) + kbo(:,34, 4) = (/ & + &2.5734e-03_r8,2.6501e-03_r8,2.7238e-03_r8,2.7897e-03_r8,2.8499e-03_r8/) + kbo(:,35, 4) = (/ & + &2.1361e-03_r8,2.2030e-03_r8,2.2659e-03_r8,2.3224e-03_r8,2.3696e-03_r8/) + kbo(:,36, 4) = (/ & + &1.7673e-03_r8,1.8262e-03_r8,1.8805e-03_r8,1.9284e-03_r8,1.9688e-03_r8/) + kbo(:,37, 4) = (/ & + &1.4584e-03_r8,1.5086e-03_r8,1.5546e-03_r8,1.5960e-03_r8,1.6338e-03_r8/) + kbo(:,38, 4) = (/ & + &1.2034e-03_r8,1.2453e-03_r8,1.2856e-03_r8,1.3227e-03_r8,1.3572e-03_r8/) + kbo(:,39, 4) = (/ & + &9.9454e-04_r8,1.0299e-03_r8,1.0651e-03_r8,1.0982e-03_r8,1.1293e-03_r8/) + kbo(:,40, 4) = (/ & + &8.1766e-04_r8,8.4814e-04_r8,8.7922e-04_r8,9.0780e-04_r8,9.3604e-04_r8/) + kbo(:,41, 4) = (/ & + &6.7161e-04_r8,6.9882e-04_r8,7.2604e-04_r8,7.5179e-04_r8,7.7573e-04_r8/) + kbo(:,42, 4) = (/ & + &5.5233e-04_r8,5.7642e-04_r8,5.9983e-04_r8,6.2278e-04_r8,6.4351e-04_r8/) + kbo(:,43, 4) = (/ & + &4.5350e-04_r8,4.7458e-04_r8,4.9522e-04_r8,5.1500e-04_r8,5.3326e-04_r8/) + kbo(:,44, 4) = (/ & + &3.7202e-04_r8,3.9025e-04_r8,4.0848e-04_r8,4.2568e-04_r8,4.4143e-04_r8/) + kbo(:,45, 4) = (/ & + &3.0534e-04_r8,3.2126e-04_r8,3.3706e-04_r8,3.5201e-04_r8,3.6606e-04_r8/) + kbo(:,46, 4) = (/ & + &2.5026e-04_r8,2.6416e-04_r8,2.7768e-04_r8,2.9081e-04_r8,3.0319e-04_r8/) + kbo(:,47, 4) = (/ & + &2.0428e-04_r8,2.1616e-04_r8,2.2794e-04_r8,2.3946e-04_r8,2.5046e-04_r8/) + kbo(:,48, 4) = (/ & + &1.6667e-04_r8,1.7701e-04_r8,1.8729e-04_r8,1.9740e-04_r8,2.0693e-04_r8/) + kbo(:,49, 4) = (/ & + &1.3611e-04_r8,1.4498e-04_r8,1.5402e-04_r8,1.6290e-04_r8,1.7121e-04_r8/) + kbo(:,50, 4) = (/ & + &1.1088e-04_r8,1.1847e-04_r8,1.2631e-04_r8,1.3390e-04_r8,1.4119e-04_r8/) + kbo(:,51, 4) = (/ & + &9.0216e-05_r8,9.6607e-05_r8,1.0331e-04_r8,1.0986e-04_r8,1.1615e-04_r8/) + kbo(:,52, 4) = (/ & + &7.3423e-05_r8,7.8834e-05_r8,8.4566e-05_r8,9.0143e-05_r8,9.5562e-05_r8/) + kbo(:,53, 4) = (/ & + &5.9754e-05_r8,6.4377e-05_r8,6.9227e-05_r8,7.4054e-05_r8,7.8692e-05_r8/) + kbo(:,54, 4) = (/ & + &4.8298e-05_r8,5.2166e-05_r8,5.6219e-05_r8,6.0246e-05_r8,6.4263e-05_r8/) + kbo(:,55, 4) = (/ & + &3.8831e-05_r8,4.2066e-05_r8,4.5431e-05_r8,4.8757e-05_r8,5.2064e-05_r8/) + kbo(:,56, 4) = (/ & + &3.1190e-05_r8,3.3925e-05_r8,3.6680e-05_r8,3.9437e-05_r8,4.2169e-05_r8/) + kbo(:,57, 4) = (/ & + &2.5026e-05_r8,2.7326e-05_r8,2.9588e-05_r8,3.1864e-05_r8,3.4154e-05_r8/) + kbo(:,58, 4) = (/ & + &2.0044e-05_r8,2.1985e-05_r8,2.3836e-05_r8,2.5731e-05_r8,2.7590e-05_r8/) + kbo(:,59, 4) = (/ & + &1.6187e-05_r8,1.7736e-05_r8,1.9214e-05_r8,2.0762e-05_r8,2.2244e-05_r8/) + kbo(:,13, 5) = (/ & + &1.6183e-01_r8,1.6388e-01_r8,1.6830e-01_r8,1.7476e-01_r8,1.8120e-01_r8/) + kbo(:,14, 5) = (/ & + &1.4136e-01_r8,1.4390e-01_r8,1.4614e-01_r8,1.5033e-01_r8,1.5561e-01_r8/) + kbo(:,15, 5) = (/ & + &1.2277e-01_r8,1.2594e-01_r8,1.2862e-01_r8,1.3140e-01_r8,1.3513e-01_r8/) + kbo(:,16, 5) = (/ & + &1.0716e-01_r8,1.1019e-01_r8,1.1295e-01_r8,1.1569e-01_r8,1.1878e-01_r8/) + kbo(:,17, 5) = (/ & + &9.2722e-02_r8,9.5517e-02_r8,9.8213e-02_r8,1.0105e-01_r8,1.0426e-01_r8/) + kbo(:,18, 5) = (/ & + &7.9838e-02_r8,8.2414e-02_r8,8.5010e-02_r8,8.8074e-02_r8,9.1598e-02_r8/) + kbo(:,19, 5) = (/ & + &6.8325e-02_r8,7.0740e-02_r8,7.3430e-02_r8,7.6659e-02_r8,8.0269e-02_r8/) + kbo(:,20, 5) = (/ & + &5.8275e-02_r8,6.0721e-02_r8,6.3630e-02_r8,6.6772e-02_r8,7.0098e-02_r8/) + kbo(:,21, 5) = (/ & + &4.9672e-02_r8,5.2190e-02_r8,5.4967e-02_r8,5.7853e-02_r8,6.0822e-02_r8/) + kbo(:,22, 5) = (/ & + &4.2534e-02_r8,4.4900e-02_r8,4.7398e-02_r8,4.9961e-02_r8,5.2416e-02_r8/) + kbo(:,23, 5) = (/ & + &3.6361e-02_r8,3.8477e-02_r8,4.0633e-02_r8,4.2770e-02_r8,4.4639e-02_r8/) + kbo(:,24, 5) = (/ & + &3.0984e-02_r8,3.2792e-02_r8,3.4594e-02_r8,3.6198e-02_r8,3.7541e-02_r8/) + kbo(:,25, 5) = (/ & + &2.6322e-02_r8,2.7818e-02_r8,2.9192e-02_r8,3.0375e-02_r8,3.1335e-02_r8/) + kbo(:,26, 5) = (/ & + &2.2285e-02_r8,2.3473e-02_r8,2.4485e-02_r8,2.5360e-02_r8,2.6084e-02_r8/) + kbo(:,27, 5) = (/ & + &1.8777e-02_r8,1.9670e-02_r8,2.0440e-02_r8,2.1104e-02_r8,2.1661e-02_r8/) + kbo(:,28, 5) = (/ & + &1.5739e-02_r8,1.6410e-02_r8,1.7009e-02_r8,1.7502e-02_r8,1.7957e-02_r8/) + kbo(:,29, 5) = (/ & + &1.3157e-02_r8,1.3689e-02_r8,1.4135e-02_r8,1.4550e-02_r8,1.4908e-02_r8/) + kbo(:,30, 5) = (/ & + &1.0985e-02_r8,1.1390e-02_r8,1.1749e-02_r8,1.2076e-02_r8,1.2372e-02_r8/) + kbo(:,31, 5) = (/ & + &9.1582e-03_r8,9.4742e-03_r8,9.7675e-03_r8,1.0044e-02_r8,1.0289e-02_r8/) + kbo(:,32, 5) = (/ & + &7.6339e-03_r8,7.8923e-03_r8,8.1271e-03_r8,8.3548e-03_r8,8.5695e-03_r8/) + kbo(:,33, 5) = (/ & + &6.3715e-03_r8,6.5845e-03_r8,6.7878e-03_r8,6.9736e-03_r8,7.1535e-03_r8/) + kbo(:,34, 5) = (/ & + &5.3224e-03_r8,5.5025e-03_r8,5.6652e-03_r8,5.8262e-03_r8,5.9749e-03_r8/) + kbo(:,35, 5) = (/ & + &4.4348e-03_r8,4.5841e-03_r8,4.7248e-03_r8,4.8589e-03_r8,4.9851e-03_r8/) + kbo(:,36, 5) = (/ & + &3.6880e-03_r8,3.8127e-03_r8,3.9338e-03_r8,4.0484e-03_r8,4.1576e-03_r8/) + kbo(:,37, 5) = (/ & + &3.0534e-03_r8,3.1615e-03_r8,3.2693e-03_r8,3.3693e-03_r8,3.4657e-03_r8/) + kbo(:,38, 5) = (/ & + &2.5332e-03_r8,2.6300e-03_r8,2.7225e-03_r8,2.8131e-03_r8,2.8939e-03_r8/) + kbo(:,39, 5) = (/ & + &2.1084e-03_r8,2.1961e-03_r8,2.2783e-03_r8,2.3583e-03_r8,2.4286e-03_r8/) + kbo(:,40, 5) = (/ & + &1.7458e-03_r8,1.8240e-03_r8,1.8981e-03_r8,1.9682e-03_r8,2.0283e-03_r8/) + kbo(:,41, 5) = (/ & + &1.4453e-03_r8,1.5145e-03_r8,1.5781e-03_r8,1.6391e-03_r8,1.6964e-03_r8/) + kbo(:,42, 5) = (/ & + &1.1954e-03_r8,1.2559e-03_r8,1.3113e-03_r8,1.3662e-03_r8,1.4193e-03_r8/) + kbo(:,43, 5) = (/ & + &9.8711e-04_r8,1.0388e-03_r8,1.0881e-03_r8,1.1376e-03_r8,1.1854e-03_r8/) + kbo(:,44, 5) = (/ & + &8.1670e-04_r8,8.6083e-04_r8,9.0273e-04_r8,9.4724e-04_r8,9.9183e-04_r8/) + kbo(:,45, 5) = (/ & + &6.7571e-04_r8,7.1462e-04_r8,7.5340e-04_r8,7.9241e-04_r8,8.3252e-04_r8/) + kbo(:,46, 5) = (/ & + &5.5868e-04_r8,5.9210e-04_r8,6.2784e-04_r8,6.6315e-04_r8,6.9901e-04_r8/) + kbo(:,47, 5) = (/ & + &4.6002e-04_r8,4.8924e-04_r8,5.2084e-04_r8,5.5250e-04_r8,5.8555e-04_r8/) + kbo(:,48, 5) = (/ & + &3.7900e-04_r8,4.0478e-04_r8,4.3312e-04_r8,4.6138e-04_r8,4.9219e-04_r8/) + kbo(:,49, 5) = (/ & + &3.1223e-04_r8,3.3515e-04_r8,3.6106e-04_r8,3.8737e-04_r8,4.1475e-04_r8/) + kbo(:,50, 5) = (/ & + &2.5631e-04_r8,2.7625e-04_r8,2.9941e-04_r8,3.2338e-04_r8,3.4759e-04_r8/) + kbo(:,51, 5) = (/ & + &2.0956e-04_r8,2.2726e-04_r8,2.4758e-04_r8,2.6894e-04_r8,2.9020e-04_r8/) + kbo(:,52, 5) = (/ & + &1.7113e-04_r8,1.8689e-04_r8,2.0470e-04_r8,2.2361e-04_r8,2.4260e-04_r8/) + kbo(:,53, 5) = (/ & + &1.3975e-04_r8,1.5381e-04_r8,1.6939e-04_r8,1.8611e-04_r8,2.0352e-04_r8/) + kbo(:,54, 5) = (/ & + &1.1323e-04_r8,1.2519e-04_r8,1.3824e-04_r8,1.5269e-04_r8,1.6768e-04_r8/) + kbo(:,55, 5) = (/ & + &9.1211e-05_r8,1.0111e-04_r8,1.1195e-04_r8,1.2407e-04_r8,1.3663e-04_r8/) + kbo(:,56, 5) = (/ & + &7.3375e-05_r8,8.1461e-05_r8,9.0533e-05_r8,1.0060e-04_r8,1.1119e-04_r8/) + kbo(:,57, 5) = (/ & + &5.8946e-05_r8,6.5535e-05_r8,7.3109e-05_r8,8.1511e-05_r8,9.0294e-05_r8/) + kbo(:,58, 5) = (/ & + &4.7323e-05_r8,5.2682e-05_r8,5.8966e-05_r8,6.5820e-05_r8,7.3137e-05_r8/) + kbo(:,59, 5) = (/ & + &3.8250e-05_r8,4.2565e-05_r8,4.7446e-05_r8,5.2866e-05_r8,5.8710e-05_r8/) + kbo(:,13, 6) = (/ & + &2.7197e-01_r8,2.7739e-01_r8,2.8096e-01_r8,2.8231e-01_r8,2.8660e-01_r8/) + kbo(:,14, 6) = (/ & + &2.4407e-01_r8,2.4904e-01_r8,2.5343e-01_r8,2.5569e-01_r8,2.5783e-01_r8/) + kbo(:,15, 6) = (/ & + &2.1616e-01_r8,2.2099e-01_r8,2.2537e-01_r8,2.2864e-01_r8,2.3140e-01_r8/) + kbo(:,16, 6) = (/ & + &1.9106e-01_r8,1.9585e-01_r8,1.9991e-01_r8,2.0367e-01_r8,2.0768e-01_r8/) + kbo(:,17, 6) = (/ & + &1.6891e-01_r8,1.7330e-01_r8,1.7742e-01_r8,1.8116e-01_r8,1.8548e-01_r8/) + kbo(:,18, 6) = (/ & + &1.4873e-01_r8,1.5292e-01_r8,1.5684e-01_r8,1.6048e-01_r8,1.6482e-01_r8/) + kbo(:,19, 6) = (/ & + &1.3023e-01_r8,1.3403e-01_r8,1.3773e-01_r8,1.4155e-01_r8,1.4625e-01_r8/) + kbo(:,20, 6) = (/ & + &1.1343e-01_r8,1.1684e-01_r8,1.2043e-01_r8,1.2478e-01_r8,1.2990e-01_r8/) + kbo(:,21, 6) = (/ & + &9.8160e-02_r8,1.0135e-01_r8,1.0525e-01_r8,1.1007e-01_r8,1.1526e-01_r8/) + kbo(:,22, 6) = (/ & + &8.4655e-02_r8,8.8120e-02_r8,9.2429e-02_r8,9.7184e-02_r8,1.0215e-01_r8/) + kbo(:,23, 6) = (/ & + &7.3019e-02_r8,7.6775e-02_r8,8.1076e-02_r8,8.5515e-02_r8,9.0104e-02_r8/) + kbo(:,24, 6) = (/ & + &6.3162e-02_r8,6.6861e-02_r8,7.0760e-02_r8,7.4872e-02_r8,7.8956e-02_r8/) + kbo(:,25, 6) = (/ & + &5.4670e-02_r8,5.8059e-02_r8,6.1565e-02_r8,6.5142e-02_r8,6.8514e-02_r8/) + kbo(:,26, 6) = (/ & + &4.7238e-02_r8,5.0243e-02_r8,5.3330e-02_r8,5.6237e-02_r8,5.8783e-02_r8/) + kbo(:,27, 6) = (/ & + &4.0718e-02_r8,4.3335e-02_r8,4.5897e-02_r8,4.8107e-02_r8,4.9970e-02_r8/) + kbo(:,28, 6) = (/ & + &3.4992e-02_r8,3.7210e-02_r8,3.9178e-02_r8,4.0837e-02_r8,4.2251e-02_r8/) + kbo(:,29, 6) = (/ & + &2.9986e-02_r8,3.1757e-02_r8,3.3246e-02_r8,3.4515e-02_r8,3.5697e-02_r8/) + kbo(:,30, 6) = (/ & + &2.5598e-02_r8,2.6947e-02_r8,2.8105e-02_r8,2.9142e-02_r8,3.0127e-02_r8/) + kbo(:,31, 6) = (/ & + &2.1742e-02_r8,2.2800e-02_r8,2.3733e-02_r8,2.4625e-02_r8,2.5488e-02_r8/) + kbo(:,32, 6) = (/ & + &1.8409e-02_r8,1.9261e-02_r8,2.0062e-02_r8,2.0837e-02_r8,2.1556e-02_r8/) + kbo(:,33, 6) = (/ & + &1.5564e-02_r8,1.6264e-02_r8,1.6973e-02_r8,1.7637e-02_r8,1.8281e-02_r8/) + kbo(:,34, 6) = (/ & + &1.3120e-02_r8,1.3750e-02_r8,1.4364e-02_r8,1.4950e-02_r8,1.5574e-02_r8/) + kbo(:,35, 6) = (/ & + &1.1037e-02_r8,1.1597e-02_r8,1.2120e-02_r8,1.2671e-02_r8,1.3247e-02_r8/) + kbo(:,36, 6) = (/ & + &9.2368e-03_r8,9.7140e-03_r8,1.0180e-02_r8,1.0677e-02_r8,1.1200e-02_r8/) + kbo(:,37, 6) = (/ & + &7.7240e-03_r8,8.1368e-03_r8,8.5470e-03_r8,8.9958e-03_r8,9.4504e-03_r8/) + kbo(:,38, 6) = (/ & + &6.4758e-03_r8,6.8295e-03_r8,7.1958e-03_r8,7.5972e-03_r8,8.0066e-03_r8/) + kbo(:,39, 6) = (/ & + &5.4501e-03_r8,5.7576e-03_r8,6.0862e-03_r8,6.4345e-03_r8,6.8065e-03_r8/) + kbo(:,40, 6) = (/ & + &4.5611e-03_r8,4.8311e-03_r8,5.1160e-03_r8,5.4160e-03_r8,5.7404e-03_r8/) + kbo(:,41, 6) = (/ & + &3.8156e-03_r8,4.0605e-03_r8,4.3157e-03_r8,4.5812e-03_r8,4.8631e-03_r8/) + kbo(:,42, 6) = (/ & + &3.1991e-03_r8,3.4174e-03_r8,3.6479e-03_r8,3.8959e-03_r8,4.1438e-03_r8/) + kbo(:,43, 6) = (/ & + &2.6778e-03_r8,2.8754e-03_r8,3.0830e-03_r8,3.3106e-03_r8,3.5418e-03_r8/) + kbo(:,44, 6) = (/ & + &2.2384e-03_r8,2.4221e-03_r8,2.6165e-03_r8,2.8279e-03_r8,3.0365e-03_r8/) + kbo(:,45, 6) = (/ & + &1.8762e-03_r8,2.0454e-03_r8,2.2217e-03_r8,2.4182e-03_r8,2.6139e-03_r8/) + kbo(:,46, 6) = (/ & + &1.5669e-03_r8,1.7239e-03_r8,1.8868e-03_r8,2.0694e-03_r8,2.2548e-03_r8/) + kbo(:,47, 6) = (/ & + &1.2965e-03_r8,1.4378e-03_r8,1.5876e-03_r8,1.7568e-03_r8,1.9326e-03_r8/) + kbo(:,48, 6) = (/ & + &1.0774e-03_r8,1.2001e-03_r8,1.3389e-03_r8,1.4948e-03_r8,1.6630e-03_r8/) + kbo(:,49, 6) = (/ & + &8.9852e-04_r8,1.0105e-03_r8,1.1309e-03_r8,1.2754e-03_r8,1.4391e-03_r8/) + kbo(:,50, 6) = (/ & + &7.4445e-04_r8,8.4643e-04_r8,9.5631e-04_r8,1.0809e-03_r8,1.2318e-03_r8/) + kbo(:,51, 6) = (/ & + &6.1558e-04_r8,7.0452e-04_r8,8.0429e-04_r8,9.1653e-04_r8,1.0518e-03_r8/) + kbo(:,52, 6) = (/ & + &5.0970e-04_r8,5.8893e-04_r8,6.7706e-04_r8,7.7959e-04_r8,9.0341e-04_r8/) + kbo(:,53, 6) = (/ & + &4.2152e-04_r8,4.9282e-04_r8,5.7291e-04_r8,6.6638e-04_r8,7.8149e-04_r8/) + kbo(:,54, 6) = (/ & + &3.4337e-04_r8,4.0415e-04_r8,4.7438e-04_r8,5.5660e-04_r8,6.5618e-04_r8/) + kbo(:,55, 6) = (/ & + &2.7643e-04_r8,3.2706e-04_r8,3.8585e-04_r8,4.5635e-04_r8,5.3989e-04_r8/) + kbo(:,56, 6) = (/ & + &2.2200e-04_r8,2.6388e-04_r8,3.1337e-04_r8,3.7328e-04_r8,4.4370e-04_r8/) + kbo(:,57, 6) = (/ & + &1.7748e-04_r8,2.1244e-04_r8,2.5395e-04_r8,3.0395e-04_r8,3.6371e-04_r8/) + kbo(:,58, 6) = (/ & + &1.4157e-04_r8,1.7062e-04_r8,2.0500e-04_r8,2.4610e-04_r8,2.9686e-04_r8/) + kbo(:,59, 6) = (/ & + &1.1414e-04_r8,1.3738e-04_r8,1.6469e-04_r8,1.9701e-04_r8,2.3735e-04_r8/) + kbo(:,13, 7) = (/ & + &4.6955e-01_r8,4.7919e-01_r8,4.8757e-01_r8,4.9335e-01_r8,4.9501e-01_r8/) + kbo(:,14, 7) = (/ & + &4.3446e-01_r8,4.4412e-01_r8,4.5217e-01_r8,4.5833e-01_r8,4.6211e-01_r8/) + kbo(:,15, 7) = (/ & + &3.9856e-01_r8,4.0695e-01_r8,4.1403e-01_r8,4.2050e-01_r8,4.2565e-01_r8/) + kbo(:,16, 7) = (/ & + &3.6468e-01_r8,3.7159e-01_r8,3.7817e-01_r8,3.8407e-01_r8,3.8859e-01_r8/) + kbo(:,17, 7) = (/ & + &3.3137e-01_r8,3.3763e-01_r8,3.4358e-01_r8,3.4927e-01_r8,3.5406e-01_r8/) + kbo(:,18, 7) = (/ & + &2.9961e-01_r8,3.0527e-01_r8,3.1117e-01_r8,3.1677e-01_r8,3.2160e-01_r8/) + kbo(:,19, 7) = (/ & + &2.6897e-01_r8,2.7470e-01_r8,2.8068e-01_r8,2.8609e-01_r8,2.9127e-01_r8/) + kbo(:,20, 7) = (/ & + &2.4079e-01_r8,2.4662e-01_r8,2.5228e-01_r8,2.5749e-01_r8,2.6294e-01_r8/) + kbo(:,21, 7) = (/ & + &2.1419e-01_r8,2.1985e-01_r8,2.2509e-01_r8,2.3029e-01_r8,2.3688e-01_r8/) + kbo(:,22, 7) = (/ & + &1.8948e-01_r8,1.9472e-01_r8,1.9983e-01_r8,2.0584e-01_r8,2.1394e-01_r8/) + kbo(:,23, 7) = (/ & + &1.6639e-01_r8,1.7145e-01_r8,1.7716e-01_r8,1.8457e-01_r8,1.9389e-01_r8/) + kbo(:,24, 7) = (/ & + &1.4538e-01_r8,1.5085e-01_r8,1.5765e-01_r8,1.6633e-01_r8,1.7588e-01_r8/) + kbo(:,25, 7) = (/ & + &1.2705e-01_r8,1.3331e-01_r8,1.4121e-01_r8,1.5025e-01_r8,1.5987e-01_r8/) + kbo(:,26, 7) = (/ & + &1.1163e-01_r8,1.1872e-01_r8,1.2704e-01_r8,1.3598e-01_r8,1.4549e-01_r8/) + kbo(:,27, 7) = (/ & + &9.8775e-02_r8,1.0620e-01_r8,1.1436e-01_r8,1.2321e-01_r8,1.3236e-01_r8/) + kbo(:,28, 7) = (/ & + &8.7819e-02_r8,9.5125e-02_r8,1.0304e-01_r8,1.1161e-01_r8,1.2007e-01_r8/) + kbo(:,29, 7) = (/ & + &7.8356e-02_r8,8.5376e-02_r8,9.3117e-02_r8,1.0101e-01_r8,1.0879e-01_r8/) + kbo(:,30, 7) = (/ & + &7.0020e-02_r8,7.6849e-02_r8,8.4078e-02_r8,9.1302e-02_r8,9.8416e-02_r8/) + kbo(:,31, 7) = (/ & + &6.2819e-02_r8,6.9270e-02_r8,7.5879e-02_r8,8.2483e-02_r8,8.8967e-02_r8/) + kbo(:,32, 7) = (/ & + &5.6483e-02_r8,6.2430e-02_r8,6.8481e-02_r8,7.4539e-02_r8,8.0648e-02_r8/) + kbo(:,33, 7) = (/ & + &5.0860e-02_r8,5.6316e-02_r8,6.1885e-02_r8,6.7612e-02_r8,7.3808e-02_r8/) + kbo(:,34, 7) = (/ & + &4.5682e-02_r8,5.0745e-02_r8,5.5935e-02_r8,6.1551e-02_r8,6.7601e-02_r8/) + kbo(:,35, 7) = (/ & + &4.0692e-02_r8,4.5316e-02_r8,5.0264e-02_r8,5.5834e-02_r8,6.1807e-02_r8/) + kbo(:,36, 7) = (/ & + &3.5794e-02_r8,4.0089e-02_r8,4.4914e-02_r8,5.0304e-02_r8,5.6176e-02_r8/) + kbo(:,37, 7) = (/ & + &3.0961e-02_r8,3.4978e-02_r8,3.9573e-02_r8,4.4775e-02_r8,5.0561e-02_r8/) + kbo(:,38, 7) = (/ & + &2.6776e-02_r8,3.0559e-02_r8,3.4968e-02_r8,3.9997e-02_r8,4.5685e-02_r8/) + kbo(:,39, 7) = (/ & + &2.3185e-02_r8,2.6765e-02_r8,3.1022e-02_r8,3.5959e-02_r8,4.1519e-02_r8/) + kbo(:,40, 7) = (/ & + &1.9763e-02_r8,2.3065e-02_r8,2.7085e-02_r8,3.1775e-02_r8,3.7215e-02_r8/) + kbo(:,41, 7) = (/ & + &1.6812e-02_r8,1.9830e-02_r8,2.3604e-02_r8,2.8085e-02_r8,3.3399e-02_r8/) + kbo(:,42, 7) = (/ & + &1.4318e-02_r8,1.7069e-02_r8,2.0605e-02_r8,2.4882e-02_r8,3.0046e-02_r8/) + kbo(:,43, 7) = (/ & + &1.2083e-02_r8,1.4567e-02_r8,1.7802e-02_r8,2.1853e-02_r8,2.6807e-02_r8/) + kbo(:,44, 7) = (/ & + &1.0170e-02_r8,1.2372e-02_r8,1.5314e-02_r8,1.9108e-02_r8,2.3821e-02_r8/) + kbo(:,45, 7) = (/ & + &8.6090e-03_r8,1.0534e-02_r8,1.3191e-02_r8,1.6726e-02_r8,2.1197e-02_r8/) + kbo(:,46, 7) = (/ & + &7.3022e-03_r8,8.9907e-03_r8,1.1353e-02_r8,1.4581e-02_r8,1.8771e-02_r8/) + kbo(:,47, 7) = (/ & + &6.1213e-03_r8,7.6431e-03_r8,9.7321e-03_r8,1.2583e-02_r8,1.6455e-02_r8/) + kbo(:,48, 7) = (/ & + &5.1186e-03_r8,6.5188e-03_r8,8.4138e-03_r8,1.0987e-02_r8,1.4502e-02_r8/) + kbo(:,49, 7) = (/ & + &4.2957e-03_r8,5.5597e-03_r8,7.3442e-03_r8,9.7283e-03_r8,1.2936e-02_r8/) + kbo(:,50, 7) = (/ & + &3.6145e-03_r8,4.7398e-03_r8,6.3555e-03_r8,8.6287e-03_r8,1.1590e-02_r8/) + kbo(:,51, 7) = (/ & + &3.0102e-03_r8,4.0430e-03_r8,5.4860e-03_r8,7.5896e-03_r8,1.0447e-02_r8/) + kbo(:,52, 7) = (/ & + &2.4958e-03_r8,3.4406e-03_r8,4.7896e-03_r8,6.7274e-03_r8,9.4519e-03_r8/) + kbo(:,53, 7) = (/ & + &2.0685e-03_r8,2.9229e-03_r8,4.2030e-03_r8,6.0566e-03_r8,8.6137e-03_r8/) + kbo(:,54, 7) = (/ & + &1.6899e-03_r8,2.4174e-03_r8,3.5607e-03_r8,5.2595e-03_r8,7.6384e-03_r8/) + kbo(:,55, 7) = (/ & + &1.3559e-03_r8,1.9570e-03_r8,2.9412e-03_r8,4.4253e-03_r8,6.5827e-03_r8/) + kbo(:,56, 7) = (/ & + &1.0806e-03_r8,1.5745e-03_r8,2.4094e-03_r8,3.7108e-03_r8,5.6277e-03_r8/) + kbo(:,57, 7) = (/ & + &8.5457e-04_r8,1.2632e-03_r8,1.9536e-03_r8,3.0874e-03_r8,4.7870e-03_r8/) + kbo(:,58, 7) = (/ & + &6.7302e-04_r8,1.0065e-03_r8,1.5736e-03_r8,2.5427e-03_r8,4.0334e-03_r8/) + kbo(:,59, 7) = (/ & + &5.4147e-04_r8,8.1396e-04_r8,1.2891e-03_r8,2.1042e-03_r8,3.3560e-03_r8/) + kbo(:,13, 8) = (/ & + &8.0034e-01_r8,8.1640e-01_r8,8.3288e-01_r8,8.4808e-01_r8,8.6148e-01_r8/) + kbo(:,14, 8) = (/ & + &7.8054e-01_r8,7.9433e-01_r8,8.0919e-01_r8,8.2411e-01_r8,8.3905e-01_r8/) + kbo(:,15, 8) = (/ & + &7.5909e-01_r8,7.7248e-01_r8,7.8592e-01_r8,7.9872e-01_r8,8.1170e-01_r8/) + kbo(:,16, 8) = (/ & + &7.3580e-01_r8,7.4804e-01_r8,7.6085e-01_r8,7.7248e-01_r8,7.8295e-01_r8/) + kbo(:,17, 8) = (/ & + &7.0630e-01_r8,7.1844e-01_r8,7.2965e-01_r8,7.3912e-01_r8,7.4743e-01_r8/) + kbo(:,18, 8) = (/ & + &6.7101e-01_r8,6.8279e-01_r8,6.9322e-01_r8,7.0102e-01_r8,7.0887e-01_r8/) + kbo(:,19, 8) = (/ & + &6.2981e-01_r8,6.4055e-01_r8,6.4979e-01_r8,6.5773e-01_r8,6.6515e-01_r8/) + kbo(:,20, 8) = (/ & + &5.8544e-01_r8,5.9608e-01_r8,6.0511e-01_r8,6.1342e-01_r8,6.2187e-01_r8/) + kbo(:,21, 8) = (/ & + &5.3944e-01_r8,5.5063e-01_r8,5.6005e-01_r8,5.6946e-01_r8,5.7856e-01_r8/) + kbo(:,22, 8) = (/ & + &4.9436e-01_r8,5.0585e-01_r8,5.1644e-01_r8,5.2703e-01_r8,5.3664e-01_r8/) + kbo(:,23, 8) = (/ & + &4.5102e-01_r8,4.6300e-01_r8,4.7455e-01_r8,4.8579e-01_r8,4.9663e-01_r8/) + kbo(:,24, 8) = (/ & + &4.0950e-01_r8,4.2198e-01_r8,4.3426e-01_r8,4.4606e-01_r8,4.5946e-01_r8/) + kbo(:,25, 8) = (/ & + &3.7091e-01_r8,3.8365e-01_r8,3.9643e-01_r8,4.1000e-01_r8,4.2576e-01_r8/) + kbo(:,26, 8) = (/ & + &3.3534e-01_r8,3.4839e-01_r8,3.6241e-01_r8,3.7838e-01_r8,3.9777e-01_r8/) + kbo(:,27, 8) = (/ & + &3.0274e-01_r8,3.1698e-01_r8,3.3298e-01_r8,3.5138e-01_r8,3.7450e-01_r8/) + kbo(:,28, 8) = (/ & + &2.7401e-01_r8,2.8968e-01_r8,3.0792e-01_r8,3.3011e-01_r8,3.5579e-01_r8/) + kbo(:,29, 8) = (/ & + &2.4984e-01_r8,2.6749e-01_r8,2.8805e-01_r8,3.1339e-01_r8,3.4148e-01_r8/) + kbo(:,30, 8) = (/ & + &2.2976e-01_r8,2.4923e-01_r8,2.7317e-01_r8,3.0058e-01_r8,3.3054e-01_r8/) + kbo(:,31, 8) = (/ & + &2.1378e-01_r8,2.3592e-01_r8,2.6234e-01_r8,2.9177e-01_r8,3.2355e-01_r8/) + kbo(:,32, 8) = (/ & + &2.0184e-01_r8,2.2666e-01_r8,2.5501e-01_r8,2.8631e-01_r8,3.1911e-01_r8/) + kbo(:,33, 8) = (/ & + &1.9381e-01_r8,2.2050e-01_r8,2.5091e-01_r8,2.8341e-01_r8,3.1739e-01_r8/) + kbo(:,34, 8) = (/ & + &1.8744e-01_r8,2.1594e-01_r8,2.4774e-01_r8,2.8137e-01_r8,3.1632e-01_r8/) + kbo(:,35, 8) = (/ & + &1.8056e-01_r8,2.1069e-01_r8,2.4353e-01_r8,2.7798e-01_r8,3.1405e-01_r8/) + kbo(:,36, 8) = (/ & + &1.7277e-01_r8,2.0381e-01_r8,2.3716e-01_r8,2.7253e-01_r8,3.0956e-01_r8/) + kbo(:,37, 8) = (/ & + &1.6168e-01_r8,1.9289e-01_r8,2.2650e-01_r8,2.6234e-01_r8,2.9987e-01_r8/) + kbo(:,38, 8) = (/ & + &1.5148e-01_r8,1.8272e-01_r8,2.1663e-01_r8,2.5277e-01_r8,2.9084e-01_r8/) + kbo(:,39, 8) = (/ & + &1.4247e-01_r8,1.7365e-01_r8,2.0770e-01_r8,2.4421e-01_r8,2.8306e-01_r8/) + kbo(:,40, 8) = (/ & + &1.3121e-01_r8,1.6190e-01_r8,1.9569e-01_r8,2.3227e-01_r8,2.7141e-01_r8/) + kbo(:,41, 8) = (/ & + &1.2044e-01_r8,1.5044e-01_r8,1.8388e-01_r8,2.2048e-01_r8,2.5951e-01_r8/) + kbo(:,42, 8) = (/ & + &1.1043e-01_r8,1.3967e-01_r8,1.7269e-01_r8,2.0919e-01_r8,2.4811e-01_r8/) + kbo(:,43, 8) = (/ & + &9.9679e-02_r8,1.2792e-01_r8,1.6034e-01_r8,1.9622e-01_r8,2.3472e-01_r8/) + kbo(:,44, 8) = (/ & + &8.9034e-02_r8,1.1631e-01_r8,1.4764e-01_r8,1.8285e-01_r8,2.2093e-01_r8/) + kbo(:,45, 8) = (/ & + &7.9054e-02_r8,1.0536e-01_r8,1.3566e-01_r8,1.6992e-01_r8,2.0745e-01_r8/) + kbo(:,46, 8) = (/ & + &6.9318e-02_r8,9.4501e-02_r8,1.2377e-01_r8,1.5667e-01_r8,1.9349e-01_r8/) + kbo(:,47, 8) = (/ & + &5.9551e-02_r8,8.3032e-02_r8,1.1103e-01_r8,1.4286e-01_r8,1.7816e-01_r8/) + kbo(:,48, 8) = (/ & + &5.0798e-02_r8,7.2525e-02_r8,9.9035e-02_r8,1.2969e-01_r8,1.6375e-01_r8/) + kbo(:,49, 8) = (/ & + &4.3152e-02_r8,6.3003e-02_r8,8.7833e-02_r8,1.1716e-01_r8,1.5024e-01_r8/) + kbo(:,50, 8) = (/ & + &3.6793e-02_r8,5.4813e-02_r8,7.7929e-02_r8,1.0576e-01_r8,1.3787e-01_r8/) + kbo(:,51, 8) = (/ & + &3.1426e-02_r8,4.7509e-02_r8,6.8953e-02_r8,9.5149e-02_r8,1.2582e-01_r8/) + kbo(:,52, 8) = (/ & + &2.6907e-02_r8,4.1306e-02_r8,6.0841e-02_r8,8.5477e-02_r8,1.1483e-01_r8/) + kbo(:,53, 8) = (/ & + &2.3168e-02_r8,3.6049e-02_r8,5.3816e-02_r8,7.6669e-02_r8,1.0462e-01_r8/) + kbo(:,54, 8) = (/ & + &1.9633e-02_r8,3.1217e-02_r8,4.7423e-02_r8,6.8592e-02_r8,9.4967e-02_r8/) + kbo(:,55, 8) = (/ & + &1.6386e-02_r8,2.6769e-02_r8,4.1346e-02_r8,6.0965e-02_r8,8.5476e-02_r8/) + kbo(:,56, 8) = (/ & + &1.3620e-02_r8,2.2714e-02_r8,3.5826e-02_r8,5.3847e-02_r8,7.6755e-02_r8/) + kbo(:,57, 8) = (/ & + &1.1197e-02_r8,1.9124e-02_r8,3.0904e-02_r8,4.7282e-02_r8,6.8602e-02_r8/) + kbo(:,58, 8) = (/ & + &9.1481e-03_r8,1.6046e-02_r8,2.6605e-02_r8,4.1371e-02_r8,6.1207e-02_r8/) + kbo(:,59, 8) = (/ & + &7.9051e-03_r8,1.4193e-02_r8,2.3774e-02_r8,3.7742e-02_r8,5.6658e-02_r8/) + kbo(:,13, 9) = (/ & + &1.3350e+00_r8,1.3653e+00_r8,1.3981e+00_r8,1.4396e+00_r8,1.4753e+00_r8/) + kbo(:,14, 9) = (/ & + &1.4178e+00_r8,1.4520e+00_r8,1.4843e+00_r8,1.5206e+00_r8,1.5583e+00_r8/) + kbo(:,15, 9) = (/ & + &1.4732e+00_r8,1.5083e+00_r8,1.5396e+00_r8,1.5755e+00_r8,1.6045e+00_r8/) + kbo(:,16, 9) = (/ & + &1.5430e+00_r8,1.5830e+00_r8,1.6160e+00_r8,1.6547e+00_r8,1.6902e+00_r8/) + kbo(:,17, 9) = (/ & + &1.6452e+00_r8,1.6845e+00_r8,1.7176e+00_r8,1.7564e+00_r8,1.7915e+00_r8/) + kbo(:,18, 9) = (/ & + &1.7229e+00_r8,1.7605e+00_r8,1.7922e+00_r8,1.8300e+00_r8,1.8621e+00_r8/) + kbo(:,19, 9) = (/ & + &1.7775e+00_r8,1.8140e+00_r8,1.8454e+00_r8,1.8798e+00_r8,1.9094e+00_r8/) + kbo(:,20, 9) = (/ & + &1.8038e+00_r8,1.8386e+00_r8,1.8699e+00_r8,1.9034e+00_r8,1.9311e+00_r8/) + kbo(:,21, 9) = (/ & + &1.8050e+00_r8,1.8386e+00_r8,1.8712e+00_r8,1.9046e+00_r8,1.9320e+00_r8/) + kbo(:,22, 9) = (/ & + &1.7869e+00_r8,1.8213e+00_r8,1.8557e+00_r8,1.8890e+00_r8,1.9178e+00_r8/) + kbo(:,23, 9) = (/ & + &1.7516e+00_r8,1.7874e+00_r8,1.8248e+00_r8,1.8592e+00_r8,1.8901e+00_r8/) + kbo(:,24, 9) = (/ & + &1.7051e+00_r8,1.7440e+00_r8,1.7841e+00_r8,1.8220e+00_r8,1.8561e+00_r8/) + kbo(:,25, 9) = (/ & + &1.6513e+00_r8,1.6948e+00_r8,1.7396e+00_r8,1.7805e+00_r8,1.8194e+00_r8/) + kbo(:,26, 9) = (/ & + &1.5955e+00_r8,1.6454e+00_r8,1.6945e+00_r8,1.7402e+00_r8,1.7819e+00_r8/) + kbo(:,27, 9) = (/ & + &1.5421e+00_r8,1.5985e+00_r8,1.6517e+00_r8,1.7028e+00_r8,1.7485e+00_r8/) + kbo(:,28, 9) = (/ & + &1.4940e+00_r8,1.5568e+00_r8,1.6151e+00_r8,1.6694e+00_r8,1.7213e+00_r8/) + kbo(:,29, 9) = (/ & + &1.4533e+00_r8,1.5206e+00_r8,1.5846e+00_r8,1.6444e+00_r8,1.7003e+00_r8/) + kbo(:,30, 9) = (/ & + &1.4208e+00_r8,1.4930e+00_r8,1.5618e+00_r8,1.6263e+00_r8,1.6869e+00_r8/) + kbo(:,31, 9) = (/ & + &1.3961e+00_r8,1.4744e+00_r8,1.5474e+00_r8,1.6161e+00_r8,1.6805e+00_r8/) + kbo(:,32, 9) = (/ & + &1.3821e+00_r8,1.4633e+00_r8,1.5401e+00_r8,1.6122e+00_r8,1.6817e+00_r8/) + kbo(:,33, 9) = (/ & + &1.3749e+00_r8,1.4598e+00_r8,1.5393e+00_r8,1.6160e+00_r8,1.6953e+00_r8/) + kbo(:,34, 9) = (/ & + &1.3713e+00_r8,1.4588e+00_r8,1.5429e+00_r8,1.6218e+00_r8,1.7156e+00_r8/) + kbo(:,35, 9) = (/ & + &1.3644e+00_r8,1.4561e+00_r8,1.5422e+00_r8,1.6338e+00_r8,1.7288e+00_r8/) + kbo(:,36, 9) = (/ & + &1.3516e+00_r8,1.4466e+00_r8,1.5348e+00_r8,1.6360e+00_r8,1.7340e+00_r8/) + kbo(:,37, 9) = (/ & + &1.3275e+00_r8,1.4250e+00_r8,1.5169e+00_r8,1.6237e+00_r8,1.7238e+00_r8/) + kbo(:,38, 9) = (/ & + &1.3040e+00_r8,1.4043e+00_r8,1.5021e+00_r8,1.6114e+00_r8,1.7135e+00_r8/) + kbo(:,39, 9) = (/ & + &1.2823e+00_r8,1.3849e+00_r8,1.4910e+00_r8,1.6008e+00_r8,1.7062e+00_r8/) + kbo(:,40, 9) = (/ & + &1.2494e+00_r8,1.3552e+00_r8,1.4636e+00_r8,1.5759e+00_r8,1.6836e+00_r8/) + kbo(:,41, 9) = (/ & + &1.2158e+00_r8,1.3244e+00_r8,1.4340e+00_r8,1.5489e+00_r8,1.6593e+00_r8/) + kbo(:,42, 9) = (/ & + &1.1826e+00_r8,1.2939e+00_r8,1.4045e+00_r8,1.5221e+00_r8,1.6360e+00_r8/) + kbo(:,43, 9) = (/ & + &1.1430e+00_r8,1.2570e+00_r8,1.3680e+00_r8,1.4889e+00_r8,1.6061e+00_r8/) + kbo(:,44, 9) = (/ & + &1.1001e+00_r8,1.2164e+00_r8,1.3282e+00_r8,1.4525e+00_r8,1.5734e+00_r8/) + kbo(:,45, 9) = (/ & + &1.0569e+00_r8,1.1761e+00_r8,1.2894e+00_r8,1.4161e+00_r8,1.5408e+00_r8/) + kbo(:,46, 9) = (/ & + &1.0113e+00_r8,1.1324e+00_r8,1.2480e+00_r8,1.3769e+00_r8,1.5047e+00_r8/) + kbo(:,47, 9) = (/ & + &9.5935e-01_r8,1.0831e+00_r8,1.2009e+00_r8,1.3301e+00_r8,1.4611e+00_r8/) + kbo(:,48, 9) = (/ & + &9.0670e-01_r8,1.0329e+00_r8,1.1535e+00_r8,1.2830e+00_r8,1.4185e+00_r8/) + kbo(:,49, 9) = (/ & + &8.5414e-01_r8,9.8225e-01_r8,1.1056e+00_r8,1.2370e+00_r8,1.3774e+00_r8/) + kbo(:,50, 9) = (/ & + &8.0339e-01_r8,9.3369e-01_r8,1.0592e+00_r8,1.1907e+00_r8,1.3340e+00_r8/) + kbo(:,51, 9) = (/ & + &7.5351e-01_r8,8.8571e-01_r8,1.0133e+00_r8,1.1450e+00_r8,1.2894e+00_r8/) + kbo(:,52, 9) = (/ & + &7.0363e-01_r8,8.3718e-01_r8,9.6715e-01_r8,1.0991e+00_r8,1.2446e+00_r8/) + kbo(:,53, 9) = (/ & + &6.5356e-01_r8,7.8813e-01_r8,9.1966e-01_r8,1.0529e+00_r8,1.2015e+00_r8/) + kbo(:,54, 9) = (/ & + &6.0842e-01_r8,7.4258e-01_r8,8.7513e-01_r8,1.0061e+00_r8,1.1543e+00_r8/) + kbo(:,55, 9) = (/ & + &5.6587e-01_r8,6.9834e-01_r8,8.3229e-01_r8,9.6266e-01_r8,1.1037e+00_r8/) + kbo(:,56, 9) = (/ & + &5.2358e-01_r8,6.5442e-01_r8,7.8939e-01_r8,9.2104e-01_r8,1.0541e+00_r8/) + kbo(:,57, 9) = (/ & + &4.8183e-01_r8,6.1174e-01_r8,7.4558e-01_r8,8.7862e-01_r8,1.0077e+00_r8/) + kbo(:,58, 9) = (/ & + &4.4300e-01_r8,5.7151e-01_r8,7.0375e-01_r8,8.3825e-01_r8,9.6862e-01_r8/) + kbo(:,59, 9) = (/ & + &4.2745e-01_r8,5.5483e-01_r8,6.8739e-01_r8,8.2045e-01_r8,9.5225e-01_r8/) + kbo(:,13,10) = (/ & + &1.9893e+00_r8,1.9563e+00_r8,1.9174e+00_r8,1.9426e+00_r8,2.0503e+00_r8/) + kbo(:,14,10) = (/ & + &1.9716e+00_r8,2.0101e+00_r8,2.0332e+00_r8,2.0825e+00_r8,2.0990e+00_r8/) + kbo(:,15,10) = (/ & + &2.2404e+00_r8,2.3114e+00_r8,2.3474e+00_r8,2.4414e+00_r8,2.5235e+00_r8/) + kbo(:,16,10) = (/ & + &2.6948e+00_r8,2.7693e+00_r8,2.8500e+00_r8,2.9277e+00_r8,3.0098e+00_r8/) + kbo(:,17,10) = (/ & + &2.9786e+00_r8,3.0578e+00_r8,3.1508e+00_r8,3.2081e+00_r8,3.2791e+00_r8/) + kbo(:,18,10) = (/ & + &3.2445e+00_r8,3.3300e+00_r8,3.4200e+00_r8,3.4641e+00_r8,3.5430e+00_r8/) + kbo(:,19,10) = (/ & + &3.4975e+00_r8,3.5857e+00_r8,3.6668e+00_r8,3.7210e+00_r8,3.8007e+00_r8/) + kbo(:,20,10) = (/ & + &3.7569e+00_r8,3.8465e+00_r8,3.9165e+00_r8,3.9790e+00_r8,4.0533e+00_r8/) + kbo(:,21,10) = (/ & + &4.0221e+00_r8,4.1092e+00_r8,4.1701e+00_r8,4.2261e+00_r8,4.2948e+00_r8/) + kbo(:,22,10) = (/ & + &4.2735e+00_r8,4.3579e+00_r8,4.4003e+00_r8,4.4698e+00_r8,4.5287e+00_r8/) + kbo(:,23,10) = (/ & + &4.4889e+00_r8,4.5713e+00_r8,4.6026e+00_r8,4.6888e+00_r8,4.7442e+00_r8/) + kbo(:,24,10) = (/ & + &4.6627e+00_r8,4.7429e+00_r8,4.7936e+00_r8,4.8738e+00_r8,4.9305e+00_r8/) + kbo(:,25,10) = (/ & + &4.8010e+00_r8,4.8792e+00_r8,4.9473e+00_r8,5.0350e+00_r8,5.0940e+00_r8/) + kbo(:,26,10) = (/ & + &4.9124e+00_r8,4.9871e+00_r8,5.0797e+00_r8,5.1628e+00_r8,5.2299e+00_r8/) + kbo(:,27,10) = (/ & + &4.9985e+00_r8,5.0753e+00_r8,5.2023e+00_r8,5.2822e+00_r8,5.3506e+00_r8/) + kbo(:,28,10) = (/ & + &5.0601e+00_r8,5.1633e+00_r8,5.2946e+00_r8,5.3826e+00_r8,5.4390e+00_r8/) + kbo(:,29,10) = (/ & + &5.1149e+00_r8,5.2551e+00_r8,5.3769e+00_r8,5.4560e+00_r8,5.5331e+00_r8/) + kbo(:,30,10) = (/ & + &5.1829e+00_r8,5.3405e+00_r8,5.4468e+00_r8,5.5366e+00_r8,5.6267e+00_r8/) + kbo(:,31,10) = (/ & + &5.2708e+00_r8,5.3990e+00_r8,5.5145e+00_r8,5.6271e+00_r8,5.7226e+00_r8/) + kbo(:,32,10) = (/ & + &5.3210e+00_r8,5.4615e+00_r8,5.6064e+00_r8,5.7149e+00_r8,5.7961e+00_r8/) + kbo(:,33,10) = (/ & + &5.3784e+00_r8,5.5514e+00_r8,5.6898e+00_r8,5.7825e+00_r8,5.7881e+00_r8/) + kbo(:,34,10) = (/ & + &5.4610e+00_r8,5.6264e+00_r8,5.7421e+00_r8,5.8351e+00_r8,5.7469e+00_r8/) + kbo(:,35,10) = (/ & + &5.5182e+00_r8,5.6646e+00_r8,5.7805e+00_r8,5.8049e+00_r8,5.8731e+00_r8/) + kbo(:,36,10) = (/ & + &5.5474e+00_r8,5.6825e+00_r8,5.8317e+00_r8,5.7746e+00_r8,5.9436e+00_r8/) + kbo(:,37,10) = (/ & + &5.5356e+00_r8,5.6848e+00_r8,5.8413e+00_r8,5.7830e+00_r8,5.9888e+00_r8/) + kbo(:,38,10) = (/ & + &5.5240e+00_r8,5.6924e+00_r8,5.8161e+00_r8,5.8447e+00_r8,6.0305e+00_r8/) + kbo(:,39,10) = (/ & + &5.5062e+00_r8,5.7035e+00_r8,5.7750e+00_r8,5.8907e+00_r8,6.0598e+00_r8/) + kbo(:,40,10) = (/ & + &5.4721e+00_r8,5.6790e+00_r8,5.7621e+00_r8,5.8808e+00_r8,6.0578e+00_r8/) + kbo(:,41,10) = (/ & + &5.4259e+00_r8,5.6462e+00_r8,5.7509e+00_r8,5.8640e+00_r8,6.0494e+00_r8/) + kbo(:,42,10) = (/ & + &5.3746e+00_r8,5.6111e+00_r8,5.7387e+00_r8,5.8493e+00_r8,6.0309e+00_r8/) + kbo(:,43,10) = (/ & + &5.3001e+00_r8,5.5493e+00_r8,5.7206e+00_r8,5.8145e+00_r8,6.0040e+00_r8/) + kbo(:,44,10) = (/ & + &5.2173e+00_r8,5.4929e+00_r8,5.6988e+00_r8,5.7584e+00_r8,5.9757e+00_r8/) + kbo(:,45,10) = (/ & + &5.1348e+00_r8,5.4235e+00_r8,5.6596e+00_r8,5.7148e+00_r8,5.9430e+00_r8/) + kbo(:,46,10) = (/ & + &5.0314e+00_r8,5.3386e+00_r8,5.5941e+00_r8,5.6594e+00_r8,5.8994e+00_r8/) + kbo(:,47,10) = (/ & + &4.9050e+00_r8,5.2288e+00_r8,5.5164e+00_r8,5.5882e+00_r8,5.8407e+00_r8/) + kbo(:,48,10) = (/ & + &4.7768e+00_r8,5.1235e+00_r8,5.4274e+00_r8,5.5412e+00_r8,5.7765e+00_r8/) + kbo(:,49,10) = (/ & + &4.6322e+00_r8,5.0058e+00_r8,5.3313e+00_r8,5.4722e+00_r8,5.7006e+00_r8/) + kbo(:,50,10) = (/ & + &4.4926e+00_r8,4.8780e+00_r8,5.2241e+00_r8,5.4133e+00_r8,5.6277e+00_r8/) + kbo(:,51,10) = (/ & + &4.3523e+00_r8,4.7488e+00_r8,5.1238e+00_r8,5.3514e+00_r8,5.5587e+00_r8/) + kbo(:,52,10) = (/ & + &4.2056e+00_r8,4.6099e+00_r8,5.0074e+00_r8,5.2732e+00_r8,5.4803e+00_r8/) + kbo(:,53,10) = (/ & + &4.0530e+00_r8,4.4698e+00_r8,4.8873e+00_r8,5.1842e+00_r8,5.3844e+00_r8/) + kbo(:,54,10) = (/ & + &3.8976e+00_r8,4.3362e+00_r8,4.7616e+00_r8,5.1168e+00_r8,5.2766e+00_r8/) + kbo(:,55,10) = (/ & + &3.7298e+00_r8,4.2020e+00_r8,4.6200e+00_r8,5.0133e+00_r8,5.2077e+00_r8/) + kbo(:,56,10) = (/ & + &3.5605e+00_r8,4.0625e+00_r8,4.4800e+00_r8,4.8943e+00_r8,5.1989e+00_r8/) + kbo(:,57,10) = (/ & + &3.3848e+00_r8,3.9107e+00_r8,4.3536e+00_r8,4.7626e+00_r8,5.1398e+00_r8/) + kbo(:,58,10) = (/ & + &3.2413e+00_r8,3.7494e+00_r8,4.2254e+00_r8,4.6312e+00_r8,5.0237e+00_r8/) + kbo(:,59,10) = (/ & + &3.1874e+00_r8,3.6712e+00_r8,4.1570e+00_r8,4.5764e+00_r8,4.9431e+00_r8/) + kbo(:,13,11) = (/ & + &2.0655e+00_r8,2.2522e+00_r8,2.3749e+00_r8,2.3793e+00_r8,2.3141e+00_r8/) + kbo(:,14,11) = (/ & + &2.3056e+00_r8,2.3392e+00_r8,2.3483e+00_r8,2.4161e+00_r8,2.4783e+00_r8/) + kbo(:,15,11) = (/ & + &2.5044e+00_r8,2.5910e+00_r8,2.7153e+00_r8,2.7838e+00_r8,2.9462e+00_r8/) + kbo(:,16,11) = (/ & + &3.2130e+00_r8,3.2960e+00_r8,3.3708e+00_r8,3.3957e+00_r8,3.4936e+00_r8/) + kbo(:,17,11) = (/ & + &3.5929e+00_r8,3.6854e+00_r8,3.7568e+00_r8,3.8084e+00_r8,3.9070e+00_r8/) + kbo(:,18,11) = (/ & + &3.9502e+00_r8,4.0564e+00_r8,4.1260e+00_r8,4.2219e+00_r8,4.3335e+00_r8/) + kbo(:,19,11) = (/ & + &4.3215e+00_r8,4.4423e+00_r8,4.5361e+00_r8,4.6179e+00_r8,4.7405e+00_r8/) + kbo(:,20,11) = (/ & + &4.7059e+00_r8,4.8304e+00_r8,4.9342e+00_r8,4.9958e+00_r8,5.1320e+00_r8/) + kbo(:,21,11) = (/ & + &5.0845e+00_r8,5.2089e+00_r8,5.3085e+00_r8,5.3635e+00_r8,5.4973e+00_r8/) + kbo(:,22,11) = (/ & + &5.4678e+00_r8,5.5866e+00_r8,5.6718e+00_r8,5.7157e+00_r8,5.8446e+00_r8/) + kbo(:,23,11) = (/ & + &5.8472e+00_r8,5.9542e+00_r8,6.0224e+00_r8,6.0657e+00_r8,6.1751e+00_r8/) + kbo(:,24,11) = (/ & + &6.2102e+00_r8,6.3055e+00_r8,6.3477e+00_r8,6.4025e+00_r8,6.4818e+00_r8/) + kbo(:,25,11) = (/ & + &6.5425e+00_r8,6.6276e+00_r8,6.6464e+00_r8,6.7138e+00_r8,6.7776e+00_r8/) + kbo(:,26,11) = (/ & + &6.8397e+00_r8,6.9134e+00_r8,6.9153e+00_r8,7.0099e+00_r8,7.0590e+00_r8/) + kbo(:,27,11) = (/ & + &7.1001e+00_r8,7.1597e+00_r8,7.1676e+00_r8,7.2592e+00_r8,7.2956e+00_r8/) + kbo(:,28,11) = (/ & + &7.3310e+00_r8,7.3578e+00_r8,7.4192e+00_r8,7.4714e+00_r8,7.5147e+00_r8/) + kbo(:,29,11) = (/ & + &7.5220e+00_r8,7.5568e+00_r8,7.6448e+00_r8,7.6786e+00_r8,7.7106e+00_r8/) + kbo(:,30,11) = (/ & + &7.6639e+00_r8,7.7470e+00_r8,7.8152e+00_r8,7.8571e+00_r8,7.8626e+00_r8/) + kbo(:,31,11) = (/ & + &7.8082e+00_r8,7.9292e+00_r8,7.9711e+00_r8,7.9864e+00_r8,7.9914e+00_r8/) + kbo(:,32,11) = (/ & + &7.9725e+00_r8,8.0661e+00_r8,8.0888e+00_r8,8.1052e+00_r8,8.1459e+00_r8/) + kbo(:,33,11) = (/ & + &8.1196e+00_r8,8.1648e+00_r8,8.2204e+00_r8,8.2561e+00_r8,8.2714e+00_r8/) + kbo(:,34,11) = (/ & + &8.1982e+00_r8,8.2822e+00_r8,8.3431e+00_r8,8.3695e+00_r8,8.3494e+00_r8/) + kbo(:,35,11) = (/ & + &8.2893e+00_r8,8.3914e+00_r8,8.4459e+00_r8,8.4367e+00_r8,8.2201e+00_r8/) + kbo(:,36,11) = (/ & + &8.3709e+00_r8,8.4754e+00_r8,8.5081e+00_r8,8.5002e+00_r8,8.2056e+00_r8/) + kbo(:,37,11) = (/ & + &8.4255e+00_r8,8.5299e+00_r8,8.5562e+00_r8,8.5457e+00_r8,8.3297e+00_r8/) + kbo(:,38,11) = (/ & + &8.4692e+00_r8,8.5729e+00_r8,8.6048e+00_r8,8.5329e+00_r8,8.4574e+00_r8/) + kbo(:,39,11) = (/ & + &8.5044e+00_r8,8.6011e+00_r8,8.6529e+00_r8,8.5036e+00_r8,8.5412e+00_r8/) + kbo(:,40,11) = (/ & + &8.5034e+00_r8,8.6122e+00_r8,8.6861e+00_r8,8.5500e+00_r8,8.5878e+00_r8/) + kbo(:,41,11) = (/ & + &8.4921e+00_r8,8.6152e+00_r8,8.7146e+00_r8,8.6037e+00_r8,8.6322e+00_r8/) + kbo(:,42,11) = (/ & + &8.4716e+00_r8,8.6012e+00_r8,8.7281e+00_r8,8.6344e+00_r8,8.6768e+00_r8/) + kbo(:,43,11) = (/ & + &8.4399e+00_r8,8.6022e+00_r8,8.7354e+00_r8,8.6857e+00_r8,8.7108e+00_r8/) + kbo(:,44,11) = (/ & + &8.4042e+00_r8,8.5707e+00_r8,8.7247e+00_r8,8.7306e+00_r8,8.7301e+00_r8/) + kbo(:,45,11) = (/ & + &8.3422e+00_r8,8.5367e+00_r8,8.7092e+00_r8,8.7655e+00_r8,8.7531e+00_r8/) + kbo(:,46,11) = (/ & + &8.2614e+00_r8,8.4925e+00_r8,8.6796e+00_r8,8.7911e+00_r8,8.7636e+00_r8/) + kbo(:,47,11) = (/ & + &8.1773e+00_r8,8.4296e+00_r8,8.6376e+00_r8,8.8172e+00_r8,8.7465e+00_r8/) + kbo(:,48,11) = (/ & + &8.0681e+00_r8,8.3512e+00_r8,8.5867e+00_r8,8.7946e+00_r8,8.7119e+00_r8/) + kbo(:,49,11) = (/ & + &7.9551e+00_r8,8.2607e+00_r8,8.5307e+00_r8,8.7608e+00_r8,8.6937e+00_r8/) + kbo(:,50,11) = (/ & + &7.8252e+00_r8,8.1751e+00_r8,8.4616e+00_r8,8.7182e+00_r8,8.6487e+00_r8/) + kbo(:,51,11) = (/ & + &7.6779e+00_r8,8.0748e+00_r8,8.3664e+00_r8,8.6630e+00_r8,8.6216e+00_r8/) + kbo(:,52,11) = (/ & + &7.5020e+00_r8,7.9591e+00_r8,8.2751e+00_r8,8.6024e+00_r8,8.6131e+00_r8/) + kbo(:,53,11) = (/ & + &7.3138e+00_r8,7.8339e+00_r8,8.1806e+00_r8,8.5263e+00_r8,8.5994e+00_r8/) + kbo(:,54,11) = (/ & + &7.1204e+00_r8,7.6772e+00_r8,8.0838e+00_r8,8.4459e+00_r8,8.6417e+00_r8/) + kbo(:,55,11) = (/ & + &6.9256e+00_r8,7.5251e+00_r8,7.9750e+00_r8,8.3203e+00_r8,8.6369e+00_r8/) + kbo(:,56,11) = (/ & + &6.7619e+00_r8,7.3247e+00_r8,7.8477e+00_r8,8.2055e+00_r8,8.5418e+00_r8/) + kbo(:,57,11) = (/ & + &6.5989e+00_r8,7.1193e+00_r8,7.6865e+00_r8,8.1073e+00_r8,8.4236e+00_r8/) + kbo(:,58,11) = (/ & + &6.3964e+00_r8,6.9666e+00_r8,7.5354e+00_r8,7.9999e+00_r8,8.3228e+00_r8/) + kbo(:,59,11) = (/ & + &6.3130e+00_r8,6.9330e+00_r8,7.4209e+00_r8,7.9087e+00_r8,8.2712e+00_r8/) + kbo(:,13,12) = (/ & + &2.2326e+00_r8,2.2492e+00_r8,2.2166e+00_r8,2.2179e+00_r8,2.3939e+00_r8/) + kbo(:,14,12) = (/ & + &2.6624e+00_r8,2.8068e+00_r8,2.8766e+00_r8,2.8509e+00_r8,2.8616e+00_r8/) + kbo(:,15,12) = (/ & + &3.7151e+00_r8,3.8338e+00_r8,3.8710e+00_r8,3.8938e+00_r8,4.0387e+00_r8/) + kbo(:,16,12) = (/ & + &4.1478e+00_r8,4.2453e+00_r8,4.2845e+00_r8,4.3058e+00_r8,4.4171e+00_r8/) + kbo(:,17,12) = (/ & + &4.4594e+00_r8,4.5666e+00_r8,4.6335e+00_r8,4.6600e+00_r8,4.7776e+00_r8/) + kbo(:,18,12) = (/ & + &4.8949e+00_r8,5.0141e+00_r8,5.1198e+00_r8,5.1461e+00_r8,5.2514e+00_r8/) + kbo(:,19,12) = (/ & + &5.4166e+00_r8,5.5448e+00_r8,5.6541e+00_r8,5.7098e+00_r8,5.7608e+00_r8/) + kbo(:,20,12) = (/ & + &5.9687e+00_r8,6.1117e+00_r8,6.2318e+00_r8,6.2991e+00_r8,6.3382e+00_r8/) + kbo(:,21,12) = (/ & + &6.5357e+00_r8,6.6891e+00_r8,6.8185e+00_r8,6.8922e+00_r8,6.9339e+00_r8/) + kbo(:,22,12) = (/ & + &7.1247e+00_r8,7.2763e+00_r8,7.4121e+00_r8,7.4770e+00_r8,7.5498e+00_r8/) + kbo(:,23,12) = (/ & + &7.7039e+00_r8,7.8572e+00_r8,7.9884e+00_r8,8.0284e+00_r8,8.1432e+00_r8/) + kbo(:,24,12) = (/ & + &8.2700e+00_r8,8.4098e+00_r8,8.5280e+00_r8,8.5448e+00_r8,8.6892e+00_r8/) + kbo(:,25,12) = (/ & + &8.8099e+00_r8,8.9417e+00_r8,9.0327e+00_r8,9.0480e+00_r8,9.1843e+00_r8/) + kbo(:,26,12) = (/ & + &9.3282e+00_r8,9.4425e+00_r8,9.5016e+00_r8,9.4918e+00_r8,9.6320e+00_r8/) + kbo(:,27,12) = (/ & + &9.8120e+00_r8,9.9020e+00_r8,9.8963e+00_r8,9.9235e+00_r8,1.0029e+01_r8/) + kbo(:,28,12) = (/ & + &1.0246e+01_r8,1.0311e+01_r8,1.0256e+01_r8,1.0345e+01_r8,1.0401e+01_r8/) + kbo(:,29,12) = (/ & + &1.0631e+01_r8,1.0621e+01_r8,1.0577e+01_r8,1.0691e+01_r8,1.0719e+01_r8/) + kbo(:,30,12) = (/ & + &1.0962e+01_r8,1.0883e+01_r8,1.0936e+01_r8,1.0968e+01_r8,1.0995e+01_r8/) + kbo(:,31,12) = (/ & + &1.1183e+01_r8,1.1144e+01_r8,1.1216e+01_r8,1.1241e+01_r8,1.1250e+01_r8/) + kbo(:,32,12) = (/ & + &1.1390e+01_r8,1.1439e+01_r8,1.1434e+01_r8,1.1471e+01_r8,1.1430e+01_r8/) + kbo(:,33,12) = (/ & + &1.1588e+01_r8,1.1624e+01_r8,1.1599e+01_r8,1.1614e+01_r8,1.1630e+01_r8/) + kbo(:,34,12) = (/ & + &1.1823e+01_r8,1.1780e+01_r8,1.1748e+01_r8,1.1805e+01_r8,1.1825e+01_r8/) + kbo(:,35,12) = (/ & + &1.1935e+01_r8,1.1885e+01_r8,1.1934e+01_r8,1.1981e+01_r8,1.2011e+01_r8/) + kbo(:,36,12) = (/ & + &1.2055e+01_r8,1.2055e+01_r8,1.2092e+01_r8,1.2129e+01_r8,1.2083e+01_r8/) + kbo(:,37,12) = (/ & + &1.2143e+01_r8,1.2189e+01_r8,1.2217e+01_r8,1.2211e+01_r8,1.2038e+01_r8/) + kbo(:,38,12) = (/ & + &1.2240e+01_r8,1.2287e+01_r8,1.2320e+01_r8,1.2293e+01_r8,1.1958e+01_r8/) + kbo(:,39,12) = (/ & + &1.2384e+01_r8,1.2401e+01_r8,1.2395e+01_r8,1.2388e+01_r8,1.1943e+01_r8/) + kbo(:,40,12) = (/ & + &1.2464e+01_r8,1.2479e+01_r8,1.2477e+01_r8,1.2446e+01_r8,1.2032e+01_r8/) + kbo(:,41,12) = (/ & + &1.2528e+01_r8,1.2533e+01_r8,1.2534e+01_r8,1.2503e+01_r8,1.2103e+01_r8/) + kbo(:,42,12) = (/ & + &1.2585e+01_r8,1.2609e+01_r8,1.2591e+01_r8,1.2562e+01_r8,1.2170e+01_r8/) + kbo(:,43,12) = (/ & + &1.2648e+01_r8,1.2666e+01_r8,1.2643e+01_r8,1.2594e+01_r8,1.2252e+01_r8/) + kbo(:,44,12) = (/ & + &1.2682e+01_r8,1.2728e+01_r8,1.2701e+01_r8,1.2655e+01_r8,1.2340e+01_r8/) + kbo(:,45,12) = (/ & + &1.2706e+01_r8,1.2763e+01_r8,1.2739e+01_r8,1.2702e+01_r8,1.2417e+01_r8/) + kbo(:,46,12) = (/ & + &1.2744e+01_r8,1.2798e+01_r8,1.2795e+01_r8,1.2773e+01_r8,1.2516e+01_r8/) + kbo(:,47,12) = (/ & + &1.2744e+01_r8,1.2852e+01_r8,1.2846e+01_r8,1.2816e+01_r8,1.2652e+01_r8/) + kbo(:,48,12) = (/ & + &1.2714e+01_r8,1.2860e+01_r8,1.2886e+01_r8,1.2860e+01_r8,1.2772e+01_r8/) + kbo(:,49,12) = (/ & + &1.2667e+01_r8,1.2862e+01_r8,1.2927e+01_r8,1.2926e+01_r8,1.2873e+01_r8/) + kbo(:,50,12) = (/ & + &1.2568e+01_r8,1.2858e+01_r8,1.2953e+01_r8,1.2955e+01_r8,1.2993e+01_r8/) + kbo(:,51,12) = (/ & + &1.2506e+01_r8,1.2803e+01_r8,1.2982e+01_r8,1.2983e+01_r8,1.3071e+01_r8/) + kbo(:,52,12) = (/ & + &1.2444e+01_r8,1.2786e+01_r8,1.2969e+01_r8,1.3005e+01_r8,1.3112e+01_r8/) + kbo(:,53,12) = (/ & + &1.2352e+01_r8,1.2737e+01_r8,1.2961e+01_r8,1.3024e+01_r8,1.3150e+01_r8/) + kbo(:,54,12) = (/ & + &1.2273e+01_r8,1.2640e+01_r8,1.2911e+01_r8,1.3015e+01_r8,1.3144e+01_r8/) + kbo(:,55,12) = (/ & + &1.2241e+01_r8,1.2456e+01_r8,1.2830e+01_r8,1.3015e+01_r8,1.3103e+01_r8/) + kbo(:,56,12) = (/ & + &1.2129e+01_r8,1.2403e+01_r8,1.2744e+01_r8,1.2955e+01_r8,1.3054e+01_r8/) + kbo(:,57,12) = (/ & + &1.1983e+01_r8,1.2327e+01_r8,1.2603e+01_r8,1.2910e+01_r8,1.3056e+01_r8/) + kbo(:,58,12) = (/ & + &1.1825e+01_r8,1.2269e+01_r8,1.2506e+01_r8,1.2817e+01_r8,1.3023e+01_r8/) + kbo(:,59,12) = (/ & + &1.1756e+01_r8,1.2243e+01_r8,1.2496e+01_r8,1.2736e+01_r8,1.2923e+01_r8/) + kbo(:,13,13) = (/ & + &2.4382e+00_r8,2.5269e+00_r8,2.6487e+00_r8,2.6115e+00_r8,2.6014e+00_r8/) + kbo(:,14,13) = (/ & + &3.1530e+00_r8,3.3624e+00_r8,3.5863e+00_r8,3.8586e+00_r8,4.4708e+00_r8/) + kbo(:,15,13) = (/ & + &5.2015e+00_r8,5.3405e+00_r8,5.5020e+00_r8,5.5114e+00_r8,5.5124e+00_r8/) + kbo(:,16,13) = (/ & + &5.7225e+00_r8,5.8966e+00_r8,6.0571e+00_r8,6.0559e+00_r8,6.0668e+00_r8/) + kbo(:,17,13) = (/ & + &6.2716e+00_r8,6.4422e+00_r8,6.5990e+00_r8,6.6435e+00_r8,6.5757e+00_r8/) + kbo(:,18,13) = (/ & + &6.7715e+00_r8,6.9371e+00_r8,7.0939e+00_r8,7.1586e+00_r8,7.0596e+00_r8/) + kbo(:,19,13) = (/ & + &7.2728e+00_r8,7.4403e+00_r8,7.6008e+00_r8,7.7026e+00_r8,7.6789e+00_r8/) + kbo(:,20,13) = (/ & + &7.8570e+00_r8,8.0286e+00_r8,8.1992e+00_r8,8.3169e+00_r8,8.3122e+00_r8/) + kbo(:,21,13) = (/ & + &8.5574e+00_r8,8.7300e+00_r8,8.9004e+00_r8,9.0231e+00_r8,9.0274e+00_r8/) + kbo(:,22,13) = (/ & + &9.3806e+00_r8,9.5518e+00_r8,9.7137e+00_r8,9.8169e+00_r8,9.7877e+00_r8/) + kbo(:,23,13) = (/ & + &1.0275e+01_r8,1.0446e+01_r8,1.0597e+01_r8,1.0672e+01_r8,1.0640e+01_r8/) + kbo(:,24,13) = (/ & + &1.1189e+01_r8,1.1360e+01_r8,1.1491e+01_r8,1.1535e+01_r8,1.1479e+01_r8/) + kbo(:,25,13) = (/ & + &1.2097e+01_r8,1.2245e+01_r8,1.2356e+01_r8,1.2332e+01_r8,1.2284e+01_r8/) + kbo(:,26,13) = (/ & + &1.2961e+01_r8,1.3082e+01_r8,1.3167e+01_r8,1.3081e+01_r8,1.3047e+01_r8/) + kbo(:,27,13) = (/ & + &1.3759e+01_r8,1.3850e+01_r8,1.3907e+01_r8,1.3774e+01_r8,1.3731e+01_r8/) + kbo(:,28,13) = (/ & + &1.4487e+01_r8,1.4544e+01_r8,1.4510e+01_r8,1.4345e+01_r8,1.4410e+01_r8/) + kbo(:,29,13) = (/ & + &1.5131e+01_r8,1.5152e+01_r8,1.4989e+01_r8,1.4893e+01_r8,1.4931e+01_r8/) + kbo(:,30,13) = (/ & + &1.5691e+01_r8,1.5628e+01_r8,1.5428e+01_r8,1.5458e+01_r8,1.5409e+01_r8/) + kbo(:,31,13) = (/ & + &1.6170e+01_r8,1.5957e+01_r8,1.5859e+01_r8,1.5855e+01_r8,1.5824e+01_r8/) + kbo(:,32,13) = (/ & + &1.6473e+01_r8,1.6259e+01_r8,1.6330e+01_r8,1.6208e+01_r8,1.6186e+01_r8/) + kbo(:,33,13) = (/ & + &1.6723e+01_r8,1.6704e+01_r8,1.6654e+01_r8,1.6563e+01_r8,1.6454e+01_r8/) + kbo(:,34,13) = (/ & + &1.6982e+01_r8,1.6991e+01_r8,1.6942e+01_r8,1.6797e+01_r8,1.6670e+01_r8/) + kbo(:,35,13) = (/ & + &1.7322e+01_r8,1.7270e+01_r8,1.7135e+01_r8,1.6953e+01_r8,1.6879e+01_r8/) + kbo(:,36,13) = (/ & + &1.7562e+01_r8,1.7451e+01_r8,1.7282e+01_r8,1.7228e+01_r8,1.7169e+01_r8/) + kbo(:,37,13) = (/ & + &1.7777e+01_r8,1.7615e+01_r8,1.7471e+01_r8,1.7494e+01_r8,1.7411e+01_r8/) + kbo(:,38,13) = (/ & + &1.7932e+01_r8,1.7773e+01_r8,1.7733e+01_r8,1.7665e+01_r8,1.7616e+01_r8/) + kbo(:,39,13) = (/ & + &1.7993e+01_r8,1.7881e+01_r8,1.7968e+01_r8,1.7898e+01_r8,1.7772e+01_r8/) + kbo(:,40,13) = (/ & + &1.8148e+01_r8,1.8027e+01_r8,1.8107e+01_r8,1.8066e+01_r8,1.7907e+01_r8/) + kbo(:,41,13) = (/ & + &1.8273e+01_r8,1.8183e+01_r8,1.8251e+01_r8,1.8205e+01_r8,1.8057e+01_r8/) + kbo(:,42,13) = (/ & + &1.8408e+01_r8,1.8324e+01_r8,1.8378e+01_r8,1.8322e+01_r8,1.8177e+01_r8/) + kbo(:,43,13) = (/ & + &1.8505e+01_r8,1.8424e+01_r8,1.8497e+01_r8,1.8450e+01_r8,1.8293e+01_r8/) + kbo(:,44,13) = (/ & + &1.8604e+01_r8,1.8490e+01_r8,1.8578e+01_r8,1.8585e+01_r8,1.8430e+01_r8/) + kbo(:,45,13) = (/ & + &1.8704e+01_r8,1.8600e+01_r8,1.8704e+01_r8,1.8731e+01_r8,1.8566e+01_r8/) + kbo(:,46,13) = (/ & + &1.8778e+01_r8,1.8729e+01_r8,1.8813e+01_r8,1.8830e+01_r8,1.8670e+01_r8/) + kbo(:,47,13) = (/ & + &1.8850e+01_r8,1.8781e+01_r8,1.8910e+01_r8,1.8941e+01_r8,1.8764e+01_r8/) + kbo(:,48,13) = (/ & + &1.8986e+01_r8,1.8857e+01_r8,1.8976e+01_r8,1.9005e+01_r8,1.8895e+01_r8/) + kbo(:,49,13) = (/ & + &1.9095e+01_r8,1.9011e+01_r8,1.9061e+01_r8,1.9086e+01_r8,1.9025e+01_r8/) + kbo(:,50,13) = (/ & + &1.9280e+01_r8,1.9083e+01_r8,1.9157e+01_r8,1.9191e+01_r8,1.9123e+01_r8/) + kbo(:,51,13) = (/ & + &1.9385e+01_r8,1.9151e+01_r8,1.9215e+01_r8,1.9259e+01_r8,1.9196e+01_r8/) + kbo(:,52,13) = (/ & + &1.9488e+01_r8,1.9188e+01_r8,1.9260e+01_r8,1.9328e+01_r8,1.9259e+01_r8/) + kbo(:,53,13) = (/ & + &1.9657e+01_r8,1.9231e+01_r8,1.9381e+01_r8,1.9391e+01_r8,1.9331e+01_r8/) + kbo(:,54,13) = (/ & + &1.9810e+01_r8,1.9362e+01_r8,1.9357e+01_r8,1.9443e+01_r8,1.9402e+01_r8/) + kbo(:,55,13) = (/ & + &1.9885e+01_r8,1.9515e+01_r8,1.9337e+01_r8,1.9415e+01_r8,1.9400e+01_r8/) + kbo(:,56,13) = (/ & + &1.9952e+01_r8,1.9629e+01_r8,1.9325e+01_r8,1.9383e+01_r8,1.9431e+01_r8/) + kbo(:,57,13) = (/ & + &2.0005e+01_r8,1.9822e+01_r8,1.9466e+01_r8,1.9235e+01_r8,1.9419e+01_r8/) + kbo(:,58,13) = (/ & + &2.0044e+01_r8,1.9891e+01_r8,1.9520e+01_r8,1.9352e+01_r8,1.9344e+01_r8/) + kbo(:,59,13) = (/ & + &2.0058e+01_r8,1.9920e+01_r8,1.9627e+01_r8,1.9319e+01_r8,1.9225e+01_r8/) + kbo(:,13,14) = (/ & + &3.1216e+00_r8,3.1914e+00_r8,3.0899e+00_r8,3.3224e+00_r8,4.2010e+00_r8/) + kbo(:,14,14) = (/ & + &7.0173e+00_r8,7.2031e+00_r8,7.3581e+00_r8,7.0289e+00_r8,6.9115e+00_r8/) + kbo(:,15,14) = (/ & + &7.9333e+00_r8,8.1347e+00_r8,8.2980e+00_r8,8.2914e+00_r8,7.9259e+00_r8/) + kbo(:,16,14) = (/ & + &8.8725e+00_r8,9.0683e+00_r8,9.2568e+00_r8,9.4307e+00_r8,9.0182e+00_r8/) + kbo(:,17,14) = (/ & + &9.8363e+00_r8,1.0075e+01_r8,1.0298e+01_r8,1.0509e+01_r8,1.0358e+01_r8/) + kbo(:,18,14) = (/ & + &1.0886e+01_r8,1.1174e+01_r8,1.1435e+01_r8,1.1674e+01_r8,1.1694e+01_r8/) + kbo(:,19,14) = (/ & + &1.2011e+01_r8,1.2333e+01_r8,1.2632e+01_r8,1.2897e+01_r8,1.3012e+01_r8/) + kbo(:,20,14) = (/ & + &1.3190e+01_r8,1.3540e+01_r8,1.3861e+01_r8,1.4163e+01_r8,1.4313e+01_r8/) + kbo(:,21,14) = (/ & + &1.4385e+01_r8,1.4764e+01_r8,1.5119e+01_r8,1.5437e+01_r8,1.5593e+01_r8/) + kbo(:,22,14) = (/ & + &1.5599e+01_r8,1.6013e+01_r8,1.6388e+01_r8,1.6714e+01_r8,1.6844e+01_r8/) + kbo(:,23,14) = (/ & + &1.6855e+01_r8,1.7274e+01_r8,1.7644e+01_r8,1.7957e+01_r8,1.7983e+01_r8/) + kbo(:,24,14) = (/ & + &1.8152e+01_r8,1.8541e+01_r8,1.8882e+01_r8,1.9172e+01_r8,1.9130e+01_r8/) + kbo(:,25,14) = (/ & + &1.9440e+01_r8,1.9782e+01_r8,2.0084e+01_r8,2.0333e+01_r8,2.0194e+01_r8/) + kbo(:,26,14) = (/ & + &2.0688e+01_r8,2.0983e+01_r8,2.1232e+01_r8,2.1433e+01_r8,2.1144e+01_r8/) + kbo(:,27,14) = (/ & + &2.1870e+01_r8,2.2106e+01_r8,2.2296e+01_r8,2.2344e+01_r8,2.1989e+01_r8/) + kbo(:,28,14) = (/ & + &2.2959e+01_r8,2.3128e+01_r8,2.3255e+01_r8,2.3127e+01_r8,2.2540e+01_r8/) + kbo(:,29,14) = (/ & + &2.3936e+01_r8,2.4040e+01_r8,2.4108e+01_r8,2.3686e+01_r8,2.3118e+01_r8/) + kbo(:,30,14) = (/ & + &2.4794e+01_r8,2.4831e+01_r8,2.4631e+01_r8,2.3967e+01_r8,2.3807e+01_r8/) + kbo(:,31,14) = (/ & + &2.5525e+01_r8,2.5458e+01_r8,2.4921e+01_r8,2.4395e+01_r8,2.4482e+01_r8/) + kbo(:,32,14) = (/ & + &2.6140e+01_r8,2.5757e+01_r8,2.4988e+01_r8,2.5111e+01_r8,2.5399e+01_r8/) + kbo(:,33,14) = (/ & + &2.6507e+01_r8,2.5703e+01_r8,2.5535e+01_r8,2.5869e+01_r8,2.6121e+01_r8/) + kbo(:,34,14) = (/ & + &2.6569e+01_r8,2.5953e+01_r8,2.6151e+01_r8,2.6361e+01_r8,2.6801e+01_r8/) + kbo(:,35,14) = (/ & + &2.6562e+01_r8,2.6504e+01_r8,2.6810e+01_r8,2.7029e+01_r8,2.7434e+01_r8/) + kbo(:,36,14) = (/ & + &2.6827e+01_r8,2.6824e+01_r8,2.7232e+01_r8,2.7537e+01_r8,2.7695e+01_r8/) + kbo(:,37,14) = (/ & + &2.7090e+01_r8,2.7286e+01_r8,2.7649e+01_r8,2.7765e+01_r8,2.8180e+01_r8/) + kbo(:,38,14) = (/ & + &2.7488e+01_r8,2.7623e+01_r8,2.7893e+01_r8,2.8192e+01_r8,2.8556e+01_r8/) + kbo(:,39,14) = (/ & + &2.7778e+01_r8,2.8122e+01_r8,2.8064e+01_r8,2.8480e+01_r8,2.8841e+01_r8/) + kbo(:,40,14) = (/ & + &2.8002e+01_r8,2.8307e+01_r8,2.8286e+01_r8,2.8653e+01_r8,2.9020e+01_r8/) + kbo(:,41,14) = (/ & + &2.8205e+01_r8,2.8457e+01_r8,2.8430e+01_r8,2.8865e+01_r8,2.9164e+01_r8/) + kbo(:,42,14) = (/ & + &2.8421e+01_r8,2.8563e+01_r8,2.8567e+01_r8,2.9033e+01_r8,2.9360e+01_r8/) + kbo(:,43,14) = (/ & + &2.8605e+01_r8,2.8649e+01_r8,2.8746e+01_r8,2.9195e+01_r8,2.9582e+01_r8/) + kbo(:,44,14) = (/ & + &2.8719e+01_r8,2.8847e+01_r8,2.8915e+01_r8,2.9326e+01_r8,2.9712e+01_r8/) + kbo(:,45,14) = (/ & + &2.9008e+01_r8,2.9000e+01_r8,2.9085e+01_r8,2.9440e+01_r8,2.9882e+01_r8/) + kbo(:,46,14) = (/ & + &2.9283e+01_r8,2.9066e+01_r8,2.9214e+01_r8,2.9505e+01_r8,3.0075e+01_r8/) + kbo(:,47,14) = (/ & + &2.9505e+01_r8,2.9215e+01_r8,2.9192e+01_r8,2.9549e+01_r8,3.0231e+01_r8/) + kbo(:,48,14) = (/ & + &2.9847e+01_r8,2.9465e+01_r8,2.9377e+01_r8,2.9796e+01_r8,3.0530e+01_r8/) + kbo(:,49,14) = (/ & + &3.0209e+01_r8,2.9590e+01_r8,2.9613e+01_r8,2.9947e+01_r8,3.0891e+01_r8/) + kbo(:,50,14) = (/ & + &3.0555e+01_r8,2.9682e+01_r8,2.9721e+01_r8,3.0034e+01_r8,3.0987e+01_r8/) + kbo(:,51,14) = (/ & + &3.0932e+01_r8,2.9941e+01_r8,2.9791e+01_r8,3.0042e+01_r8,3.0973e+01_r8/) + kbo(:,52,14) = (/ & + &3.1304e+01_r8,3.0128e+01_r8,2.9896e+01_r8,3.0085e+01_r8,3.1235e+01_r8/) + kbo(:,53,14) = (/ & + &3.1593e+01_r8,3.0463e+01_r8,3.0008e+01_r8,3.0297e+01_r8,3.1448e+01_r8/) + kbo(:,54,14) = (/ & + &3.1880e+01_r8,3.0666e+01_r8,3.0079e+01_r8,3.0245e+01_r8,3.1244e+01_r8/) + kbo(:,55,14) = (/ & + &3.2179e+01_r8,3.1215e+01_r8,3.0197e+01_r8,3.0244e+01_r8,3.0630e+01_r8/) + kbo(:,56,14) = (/ & + &3.2496e+01_r8,3.1618e+01_r8,3.0405e+01_r8,3.0157e+01_r8,3.0368e+01_r8/) + kbo(:,57,14) = (/ & + &3.2846e+01_r8,3.1885e+01_r8,3.0675e+01_r8,3.0336e+01_r8,3.0326e+01_r8/) + kbo(:,58,14) = (/ & + &3.3194e+01_r8,3.2160e+01_r8,3.1205e+01_r8,3.0229e+01_r8,3.0346e+01_r8/) + kbo(:,59,14) = (/ & + &3.3342e+01_r8,3.2279e+01_r8,3.1453e+01_r8,3.0328e+01_r8,3.0152e+01_r8/) + kbo(:,13,15) = (/ & + &4.0030e+00_r8,4.7414e+00_r8,5.8560e+00_r8,6.7438e+00_r8,3.2808e+00_r8/) + kbo(:,14,15) = (/ & + &9.0899e+00_r8,9.4664e+00_r8,9.7823e+00_r8,1.0059e+01_r8,8.9794e+00_r8/) + kbo(:,15,15) = (/ & + &1.0857e+01_r8,1.1261e+01_r8,1.1617e+01_r8,1.1923e+01_r8,1.1563e+01_r8/) + kbo(:,16,15) = (/ & + &1.2889e+01_r8,1.3334e+01_r8,1.3725e+01_r8,1.4064e+01_r8,1.4341e+01_r8/) + kbo(:,17,15) = (/ & + &1.5204e+01_r8,1.5687e+01_r8,1.6115e+01_r8,1.6474e+01_r8,1.6771e+01_r8/) + kbo(:,18,15) = (/ & + &1.7808e+01_r8,1.8322e+01_r8,1.8770e+01_r8,1.9149e+01_r8,1.9438e+01_r8/) + kbo(:,19,15) = (/ & + &2.0675e+01_r8,2.1216e+01_r8,2.1671e+01_r8,2.2040e+01_r8,2.2294e+01_r8/) + kbo(:,20,15) = (/ & + &2.3784e+01_r8,2.4335e+01_r8,2.4780e+01_r8,2.5092e+01_r8,2.5318e+01_r8/) + kbo(:,21,15) = (/ & + &2.7074e+01_r8,2.7616e+01_r8,2.7992e+01_r8,2.8260e+01_r8,2.8435e+01_r8/) + kbo(:,22,15) = (/ & + &3.0512e+01_r8,3.0967e+01_r8,3.1281e+01_r8,3.1482e+01_r8,3.1588e+01_r8/) + kbo(:,23,15) = (/ & + &3.3946e+01_r8,3.4307e+01_r8,3.4554e+01_r8,3.4683e+01_r8,3.4702e+01_r8/) + kbo(:,24,15) = (/ & + &3.7353e+01_r8,3.7642e+01_r8,3.7797e+01_r8,3.7830e+01_r8,3.7737e+01_r8/) + kbo(:,25,15) = (/ & + &4.0725e+01_r8,4.0910e+01_r8,4.0948e+01_r8,4.0847e+01_r8,4.0612e+01_r8/) + kbo(:,26,15) = (/ & + &4.3991e+01_r8,4.4018e+01_r8,4.3898e+01_r8,4.3642e+01_r8,4.3255e+01_r8/) + kbo(:,27,15) = (/ & + &4.7033e+01_r8,4.6887e+01_r8,4.6594e+01_r8,4.6165e+01_r8,4.5614e+01_r8/) + kbo(:,28,15) = (/ & + &4.9783e+01_r8,4.9454e+01_r8,4.8983e+01_r8,4.8387e+01_r8,4.7672e+01_r8/) + kbo(:,29,15) = (/ & + &5.2209e+01_r8,5.1689e+01_r8,5.1048e+01_r8,5.0282e+01_r8,4.9143e+01_r8/) + kbo(:,30,15) = (/ & + &5.4285e+01_r8,5.3590e+01_r8,5.2778e+01_r8,5.1862e+01_r8,4.9504e+01_r8/) + kbo(:,31,15) = (/ & + &5.6017e+01_r8,5.5158e+01_r8,5.4192e+01_r8,5.2520e+01_r8,4.8958e+01_r8/) + kbo(:,32,15) = (/ & + &5.7422e+01_r8,5.6414e+01_r8,5.5126e+01_r8,5.1643e+01_r8,4.7729e+01_r8/) + kbo(:,33,15) = (/ & + &5.8538e+01_r8,5.7396e+01_r8,5.4438e+01_r8,4.9797e+01_r8,4.8468e+01_r8/) + kbo(:,34,15) = (/ & + &5.9425e+01_r8,5.7428e+01_r8,5.3101e+01_r8,5.0744e+01_r8,5.0414e+01_r8/) + kbo(:,35,15) = (/ & + &6.0220e+01_r8,5.6550e+01_r8,5.2246e+01_r8,5.2031e+01_r8,5.2160e+01_r8/) + kbo(:,36,15) = (/ & + &6.0380e+01_r8,5.6323e+01_r8,5.3290e+01_r8,5.3091e+01_r8,5.1837e+01_r8/) + kbo(:,37,15) = (/ & + &6.1064e+01_r8,5.6288e+01_r8,5.3962e+01_r8,5.4330e+01_r8,5.1190e+01_r8/) + kbo(:,38,15) = (/ & + &6.1244e+01_r8,5.6422e+01_r8,5.4974e+01_r8,5.5783e+01_r8,5.0823e+01_r8/) + kbo(:,39,15) = (/ & + &6.1491e+01_r8,5.6521e+01_r8,5.6495e+01_r8,5.7139e+01_r8,5.0363e+01_r8/) + kbo(:,40,15) = (/ & + &6.2285e+01_r8,5.7310e+01_r8,5.7143e+01_r8,5.8068e+01_r8,5.1166e+01_r8/) + kbo(:,41,15) = (/ & + &6.3214e+01_r8,5.7786e+01_r8,5.7889e+01_r8,5.8807e+01_r8,5.2057e+01_r8/) + kbo(:,42,15) = (/ & + &6.3921e+01_r8,5.8540e+01_r8,5.8564e+01_r8,5.9508e+01_r8,5.2732e+01_r8/) + kbo(:,43,15) = (/ & + &6.4936e+01_r8,5.9750e+01_r8,5.9252e+01_r8,6.0188e+01_r8,5.3641e+01_r8/) + kbo(:,44,15) = (/ & + &6.6180e+01_r8,6.0810e+01_r8,5.9653e+01_r8,6.1132e+01_r8,5.4737e+01_r8/) + kbo(:,45,15) = (/ & + &6.6949e+01_r8,6.1798e+01_r8,5.9966e+01_r8,6.1660e+01_r8,5.5582e+01_r8/) + kbo(:,46,15) = (/ & + &6.7824e+01_r8,6.2979e+01_r8,6.0686e+01_r8,6.2546e+01_r8,5.6565e+01_r8/) + kbo(:,47,15) = (/ & + &6.9039e+01_r8,6.4342e+01_r8,6.1803e+01_r8,6.2906e+01_r8,5.8086e+01_r8/) + kbo(:,48,15) = (/ & + &6.9761e+01_r8,6.5409e+01_r8,6.2421e+01_r8,6.3565e+01_r8,5.8945e+01_r8/) + kbo(:,49,15) = (/ & + &7.0431e+01_r8,6.6423e+01_r8,6.3050e+01_r8,6.4501e+01_r8,5.9296e+01_r8/) + kbo(:,50,15) = (/ & + &7.1030e+01_r8,6.7738e+01_r8,6.3115e+01_r8,6.5100e+01_r8,6.0669e+01_r8/) + kbo(:,51,15) = (/ & + &7.1594e+01_r8,6.8849e+01_r8,6.3996e+01_r8,6.5429e+01_r8,6.2495e+01_r8/) + kbo(:,52,15) = (/ & + &7.2143e+01_r8,7.0005e+01_r8,6.4776e+01_r8,6.5575e+01_r8,6.3548e+01_r8/) + kbo(:,53,15) = (/ & + &7.2670e+01_r8,7.0732e+01_r8,6.5046e+01_r8,6.6263e+01_r8,6.4505e+01_r8/) + kbo(:,54,15) = (/ & + &7.3127e+01_r8,7.1823e+01_r8,6.6914e+01_r8,6.6275e+01_r8,6.7029e+01_r8/) + kbo(:,55,15) = (/ & + &7.3553e+01_r8,7.2289e+01_r8,6.8950e+01_r8,6.5529e+01_r8,6.7722e+01_r8/) + kbo(:,56,15) = (/ & + &7.3983e+01_r8,7.2738e+01_r8,7.0656e+01_r8,6.5646e+01_r8,6.6961e+01_r8/) + kbo(:,57,15) = (/ & + &7.4388e+01_r8,7.3166e+01_r8,7.1848e+01_r8,6.6976e+01_r8,6.6137e+01_r8/) + kbo(:,58,15) = (/ & + &7.4771e+01_r8,7.3567e+01_r8,7.2279e+01_r8,6.9020e+01_r8,6.5380e+01_r8/) + kbo(:,59,15) = (/ & + &7.4949e+01_r8,7.3730e+01_r8,7.2460e+01_r8,7.0691e+01_r8,6.5332e+01_r8/) + kbo(:,13,16) = (/ & + &5.0420e+00_r8,8.6337e+00_r8,8.8692e+00_r8,1.2195e+00_r8,9.3776e-01_r8/) + kbo(:,14,16) = (/ & + &1.0108e+01_r8,1.0449e+01_r8,1.0740e+01_r8,1.1004e+01_r8,9.1915e-01_r8/) + kbo(:,15,16) = (/ & + &1.2227e+01_r8,1.2648e+01_r8,1.3007e+01_r8,1.3327e+01_r8,1.3667e+01_r8/) + kbo(:,16,16) = (/ & + &1.4789e+01_r8,1.5299e+01_r8,1.5728e+01_r8,1.6109e+01_r8,1.6498e+01_r8/) + kbo(:,17,16) = (/ & + &1.7862e+01_r8,1.8466e+01_r8,1.8964e+01_r8,1.9401e+01_r8,1.9824e+01_r8/) + kbo(:,18,16) = (/ & + &2.1506e+01_r8,2.2192e+01_r8,2.2762e+01_r8,2.3238e+01_r8,2.3665e+01_r8/) + kbo(:,19,16) = (/ & + &2.5786e+01_r8,2.6523e+01_r8,2.7142e+01_r8,2.7627e+01_r8,2.8030e+01_r8/) + kbo(:,20,16) = (/ & + &3.0723e+01_r8,3.1489e+01_r8,3.2109e+01_r8,3.2556e+01_r8,3.2877e+01_r8/) + kbo(:,21,16) = (/ & + &3.6293e+01_r8,3.7031e+01_r8,3.7583e+01_r8,3.7941e+01_r8,3.8130e+01_r8/) + kbo(:,22,16) = (/ & + &4.2493e+01_r8,4.3104e+01_r8,4.3485e+01_r8,4.3668e+01_r8,4.3655e+01_r8/) + kbo(:,23,16) = (/ & + &4.9099e+01_r8,4.9493e+01_r8,4.9618e+01_r8,4.9538e+01_r8,4.9251e+01_r8/) + kbo(:,24,16) = (/ & + &5.5931e+01_r8,5.5983e+01_r8,5.5792e+01_r8,5.5378e+01_r8,5.4757e+01_r8/) + kbo(:,25,16) = (/ & + &6.2744e+01_r8,6.2387e+01_r8,6.1774e+01_r8,6.0982e+01_r8,5.9987e+01_r8/) + kbo(:,26,16) = (/ & + &6.9294e+01_r8,6.8455e+01_r8,6.7400e+01_r8,6.6158e+01_r8,6.4771e+01_r8/) + kbo(:,27,16) = (/ & + &7.5369e+01_r8,7.4018e+01_r8,7.2501e+01_r8,7.0820e+01_r8,6.9030e+01_r8/) + kbo(:,28,16) = (/ & + &8.0847e+01_r8,7.8971e+01_r8,7.6973e+01_r8,7.4879e+01_r8,7.2699e+01_r8/) + kbo(:,29,16) = (/ & + &8.5588e+01_r8,8.3223e+01_r8,8.0777e+01_r8,7.8292e+01_r8,7.5762e+01_r8/) + kbo(:,30,16) = (/ & + &8.9575e+01_r8,8.6758e+01_r8,8.3320e+01_r8,8.1073e+01_r8,7.8238e+01_r8/) + kbo(:,31,16) = (/ & + &9.2801e+01_r8,8.9596e+01_r8,8.6404e+01_r8,8.3251e+01_r8,8.0171e+01_r8/) + kbo(:,32,16) = (/ & + &9.5328e+01_r8,9.1774e+01_r8,8.8298e+01_r8,8.4902e+01_r8,7.6985e+01_r8/) + kbo(:,33,16) = (/ & + &9.7221e+01_r8,9.3383e+01_r8,8.9667e+01_r8,8.6065e+01_r8,5.8850e+01_r8/) + kbo(:,34,16) = (/ & + &9.8688e+01_r8,9.4629e+01_r8,9.0722e+01_r8,7.0430e+01_r8,3.0605e+01_r8/) + kbo(:,35,16) = (/ & + &1.0011e+02_r8,9.5862e+01_r8,8.7207e+01_r8,5.0589e+01_r8,4.4567e+00_r8/) + kbo(:,36,16) = (/ & + &1.0168e+02_r8,9.7257e+01_r8,7.6588e+01_r8,3.3945e+01_r8,3.3821e-01_r8/) + kbo(:,37,16) = (/ & + &1.0369e+02_r8,9.9078e+01_r8,7.2492e+01_r8,2.6526e+01_r8,3.3765e-01_r8/) + kbo(:,38,16) = (/ & + &1.0555e+02_r8,1.0077e+02_r8,6.5594e+01_r8,1.3779e+01_r8,3.3740e-01_r8/) + kbo(:,39,16) = (/ & + &1.0726e+02_r8,9.7866e+01_r8,5.5055e+01_r8,3.4196e-01_r8,3.3714e-01_r8/) + kbo(:,40,16) = (/ & + &1.0936e+02_r8,1.0037e+02_r8,5.6740e+01_r8,3.4227e-01_r8,3.3798e-01_r8/) + kbo(:,41,16) = (/ & + &1.1147e+02_r8,1.0552e+02_r8,5.9119e+01_r8,1.0312e+00_r8,3.3873e-01_r8/) + kbo(:,42,16) = (/ & + &1.1349e+02_r8,1.0806e+02_r8,6.1522e+01_r8,2.4025e+00_r8,3.3958e-01_r8/) + kbo(:,43,16) = (/ & + &1.1581e+02_r8,1.1021e+02_r8,6.4818e+01_r8,5.9686e+00_r8,3.4048e-01_r8/) + kbo(:,44,16) = (/ & + &1.1830e+02_r8,1.1248e+02_r8,7.1730e+01_r8,8.2150e+00_r8,3.4135e-01_r8/) + kbo(:,45,16) = (/ & + &1.2075e+02_r8,1.1473e+02_r8,7.7444e+01_r8,1.2041e+01_r8,3.1303e-01_r8/) + kbo(:,46,16) = (/ & + &1.2335e+02_r8,1.1716e+02_r8,8.1949e+01_r8,1.5245e+01_r8,3.1351e-01_r8/) + kbo(:,47,16) = (/ & + &1.2629e+02_r8,1.1987e+02_r8,8.8206e+01_r8,2.5272e+01_r8,3.1369e-01_r8/) + kbo(:,48,16) = (/ & + &1.2931e+02_r8,1.2262e+02_r8,9.4686e+01_r8,2.9706e+01_r8,3.1394e-01_r8/) + kbo(:,49,16) = (/ & + &1.3237e+02_r8,1.2544e+02_r8,9.8342e+01_r8,3.1959e+01_r8,3.1361e-01_r8/) + kbo(:,50,16) = (/ & + &1.3530e+02_r8,1.2816e+02_r8,1.0881e+02_r8,3.8226e+01_r8,3.1326e-01_r8/) + kbo(:,51,16) = (/ & + &1.3828e+02_r8,1.3089e+02_r8,1.1491e+02_r8,4.8666e+01_r8,3.1193e-01_r8/) + kbo(:,52,16) = (/ & + &1.4134e+02_r8,1.3361e+02_r8,1.2195e+02_r8,5.9393e+01_r8,3.1051e-01_r8/) + kbo(:,53,16) = (/ & + &1.4442e+02_r8,1.3646e+02_r8,1.2918e+02_r8,6.3097e+01_r8,3.0922e-01_r8/) + kbo(:,54,16) = (/ & + &1.4741e+02_r8,1.3916e+02_r8,1.3165e+02_r8,7.8318e+01_r8,3.0699e-01_r8/) + kbo(:,55,16) = (/ & + &1.5037e+02_r8,1.4182e+02_r8,1.3403e+02_r8,1.0259e+02_r8,2.6611e+01_r8/) + kbo(:,56,16) = (/ & + &1.5341e+02_r8,1.4449e+02_r8,1.3650e+02_r8,1.2291e+02_r8,5.4887e+01_r8/) + kbo(:,57,16) = (/ & + &1.5661e+02_r8,1.4731e+02_r8,1.3904e+02_r8,1.3152e+02_r8,7.9860e+01_r8/) + kbo(:,58,16) = (/ & + &1.5976e+02_r8,1.5007e+02_r8,1.4153e+02_r8,1.3378e+02_r8,1.0477e+02_r8/) + kbo(:,59,16) = (/ & + &1.6110e+02_r8,1.5124e+02_r8,1.4255e+02_r8,1.3470e+02_r8,1.2755e+02_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kao_mco2(:, 1) = (/ & + & 8.88964e-07_r8, 1.13087e-06_r8, 1.43861e-06_r8, 1.83010e-06_r8, 2.32811e-06_r8, & + & 2.96165e-06_r8, 3.76760e-06_r8, 4.79286e-06_r8, 6.09712e-06_r8, 7.75630e-06_r8, & + & 9.86699e-06_r8, 1.25521e-05_r8, 1.59678e-05_r8, 2.03130e-05_r8, 2.58407e-05_r8, & + & 3.28727e-05_r8, 4.18182e-05_r8, 5.31980e-05_r8, 6.76745e-05_r8/) + kao_mco2(:, 2) = (/ & + & 1.10492e-05_r8, 1.35003e-05_r8, 1.64952e-05_r8, 2.01545e-05_r8, 2.46256e-05_r8, & + & 3.00885e-05_r8, 3.67632e-05_r8, 4.49188e-05_r8, 5.48835e-05_r8, 6.70588e-05_r8, & + & 8.19351e-05_r8, 1.00111e-04_r8, 1.22320e-04_r8, 1.49455e-04_r8, 1.82610e-04_r8, & + & 2.23121e-04_r8, 2.72618e-04_r8, 3.33095e-04_r8, 4.06988e-04_r8/) + kao_mco2(:, 3) = (/ & + & 1.51034e-05_r8, 1.81249e-05_r8, 2.17508e-05_r8, 2.61020e-05_r8, 3.13238e-05_r8, & + & 3.75901e-05_r8, 4.51101e-05_r8, 5.41344e-05_r8, 6.49640e-05_r8, 7.79601e-05_r8, & + & 9.35562e-05_r8, 1.12272e-04_r8, 1.34732e-04_r8, 1.61686e-04_r8, 1.94031e-04_r8, & + & 2.32847e-04_r8, 2.79429e-04_r8, 3.35329e-04_r8, 4.02411e-04_r8/) + kao_mco2(:, 4) = (/ & + & 1.57088e-05_r8, 1.89537e-05_r8, 2.28688e-05_r8, 2.75928e-05_r8, 3.32924e-05_r8, & + & 4.01695e-05_r8, 4.84671e-05_r8, 5.84787e-05_r8, 7.05584e-05_r8, 8.51332e-05_r8, & + & 1.02719e-04_r8, 1.23937e-04_r8, 1.49538e-04_r8, 1.80427e-04_r8, 2.17697e-04_r8, & + & 2.62666e-04_r8, 3.16923e-04_r8, 3.82388e-04_r8, 4.61376e-04_r8/) + kao_mco2(:, 5) = (/ & + & 3.09299e-05_r8, 3.73196e-05_r8, 4.50294e-05_r8, 5.43320e-05_r8, 6.55563e-05_r8, & + & 7.90995e-05_r8, 9.54405e-05_r8, 1.15157e-04_r8, 1.38948e-04_r8, 1.67652e-04_r8, & + & 2.02288e-04_r8, 2.44078e-04_r8, 2.94501e-04_r8, 3.55342e-04_r8, 4.28751e-04_r8, & + & 5.17327e-04_r8, 6.24200e-04_r8, 7.53153e-04_r8, 9.08745e-04_r8/) + kao_mco2(:, 6) = (/ & + & 1.98653e-05_r8, 2.38878e-05_r8, 2.87248e-05_r8, 3.45413e-05_r8, 4.15355e-05_r8, & + & 4.99459e-05_r8, 6.00593e-05_r8, 7.22206e-05_r8, 8.68445e-05_r8, 1.04429e-04_r8, & + & 1.25575e-04_r8, 1.51003e-04_r8, 1.81579e-04_r8, 2.18346e-04_r8, 2.62559e-04_r8, & + & 3.15724e-04_r8, 3.79654e-04_r8, 4.56529e-04_r8, 5.48971e-04_r8/) + kao_mco2(:, 7) = (/ & + & 1.54276e-06_r8, 1.90144e-06_r8, 2.34351e-06_r8, 2.88836e-06_r8, 3.55989e-06_r8, & + & 4.38754e-06_r8, 5.40761e-06_r8, 6.66485e-06_r8, 8.21439e-06_r8, 1.01242e-05_r8, & + & 1.24780e-05_r8, 1.53790e-05_r8, 1.89546e-05_r8, 2.33614e-05_r8, 2.87928e-05_r8, & + & 3.54869e-05_r8, 4.37374e-05_r8, 5.39060e-05_r8, 6.64388e-05_r8/) + kao_mco2(:, 8) = (/ & + & 1.66907e-06_r8, 2.11106e-06_r8, 2.67008e-06_r8, 3.37714e-06_r8, 4.27143e-06_r8, & + & 5.40254e-06_r8, 6.83318e-06_r8, 8.64266e-06_r8, 1.09313e-05_r8, 1.38260e-05_r8, & + & 1.74872e-05_r8, 2.21180e-05_r8, 2.79750e-05_r8, 3.53830e-05_r8, 4.47527e-05_r8, & + & 5.66036e-05_r8, 7.15927e-05_r8, 9.05509e-05_r8, 1.14529e-04_r8/) + kao_mco2(:, 9) = (/ & + & 1.22817e-06_r8, 1.56416e-06_r8, 1.99206e-06_r8, 2.53703e-06_r8, 3.23108e-06_r8, & + & 4.11501e-06_r8, 5.24074e-06_r8, 6.67445e-06_r8, 8.50037e-06_r8, 1.08258e-05_r8, & + & 1.37874e-05_r8, 1.75592e-05_r8, 2.23629e-05_r8, 2.84807e-05_r8, 3.62721e-05_r8, & + & 4.61950e-05_r8, 5.88325e-05_r8, 7.49272e-05_r8, 9.54249e-05_r8/) + kao_mco2(:,10) = (/ & + & 3.45943e-08_r8, 3.84726e-08_r8, 4.27856e-08_r8, 4.75821e-08_r8, 5.29164e-08_r8, & + & 5.88487e-08_r8, 6.54460e-08_r8, 7.27829e-08_r8, 8.09423e-08_r8, 9.00164e-08_r8, & + & 1.00108e-07_r8, 1.11331e-07_r8, 1.23811e-07_r8, 1.37691e-07_r8, 1.53128e-07_r8, & + & 1.70294e-07_r8, 1.89385e-07_r8, 2.10616e-07_r8, 2.34228e-07_r8/) + kao_mco2(:,11) = (/ & + & 2.89971e-08_r8, 3.35110e-08_r8, 3.87275e-08_r8, 4.47561e-08_r8, 5.17230e-08_r8, & + & 5.97745e-08_r8, 6.90794e-08_r8, 7.98327e-08_r8, 9.22599e-08_r8, 1.06622e-07_r8, & + & 1.23219e-07_r8, 1.42400e-07_r8, 1.64567e-07_r8, 1.90184e-07_r8, 2.19789e-07_r8, & + & 2.54003e-07_r8, 2.93542e-07_r8, 3.39237e-07_r8, 3.92044e-07_r8/) + kao_mco2(:,12) = (/ & + & 2.51330e-08_r8, 2.96783e-08_r8, 3.50457e-08_r8, 4.13837e-08_r8, 4.88679e-08_r8, & + & 5.77056e-08_r8, 6.81416e-08_r8, 8.04650e-08_r8, 9.50171e-08_r8, 1.12201e-07_r8, & + & 1.32492e-07_r8, 1.56454e-07_r8, 1.84748e-07_r8, 2.18160e-07_r8, 2.57614e-07_r8, & + & 3.04203e-07_r8, 3.59218e-07_r8, 4.24182e-07_r8, 5.00895e-07_r8/) + kao_mco2(:,13) = (/ & + & 1.16966e-07_r8, 1.13960e-07_r8, 1.11032e-07_r8, 1.08179e-07_r8, 1.05400e-07_r8, & + & 1.02691e-07_r8, 1.00053e-07_r8, 9.74820e-08_r8, 9.49772e-08_r8, 9.25368e-08_r8, & + & 9.01591e-08_r8, 8.78425e-08_r8, 8.55854e-08_r8, 8.33863e-08_r8, 8.12437e-08_r8, & + & 7.91562e-08_r8, 7.71223e-08_r8, 7.51407e-08_r8, 7.32100e-08_r8/) + kao_mco2(:,14) = (/ & + & 9.17853e-08_r8, 8.94322e-08_r8, 8.71395e-08_r8, 8.49055e-08_r8, 8.27289e-08_r8, & + & 8.06080e-08_r8, 7.85415e-08_r8, 7.65279e-08_r8, 7.45660e-08_r8, 7.26544e-08_r8, & + & 7.07918e-08_r8, 6.89770e-08_r8, 6.72086e-08_r8, 6.54856e-08_r8, 6.38068e-08_r8, & + & 6.21710e-08_r8, 6.05772e-08_r8, 5.90242e-08_r8, 5.75110e-08_r8/) + kao_mco2(:,15) = (/ & + & 8.34607e-08_r8, 8.13236e-08_r8, 7.92413e-08_r8, 7.72122e-08_r8, 7.52351e-08_r8, & + & 7.33087e-08_r8, 7.14315e-08_r8, 6.96025e-08_r8, 6.78202e-08_r8, 6.60837e-08_r8, & + & 6.43915e-08_r8, 6.27427e-08_r8, 6.11361e-08_r8, 5.95707e-08_r8, 5.80453e-08_r8, & + & 5.65590e-08_r8, 5.51108e-08_r8, 5.36996e-08_r8, 5.23246e-08_r8/) + kao_mco2(:,16) = (/ & + & 8.34607e-08_r8, 8.13236e-08_r8, 7.92413e-08_r8, 7.72122e-08_r8, 7.52351e-08_r8, & + & 7.33087e-08_r8, 7.14315e-08_r8, 6.96025e-08_r8, 6.78202e-08_r8, 6.60837e-08_r8, & + & 6.43915e-08_r8, 6.27427e-08_r8, 6.11361e-08_r8, 5.95707e-08_r8, 5.80453e-08_r8, & + & 5.65590e-08_r8, 5.51108e-08_r8, 5.36996e-08_r8, 5.23246e-08_r8/) + kao_mo3(:, 1) = (/ & + & 1.18276e-01_r8, 1.18009e-01_r8, 1.17742e-01_r8, 1.17476e-01_r8, 1.17210e-01_r8, & + & 1.16945e-01_r8, 1.16681e-01_r8, 1.16417e-01_r8, 1.16153e-01_r8, 1.15891e-01_r8, & + & 1.15629e-01_r8, 1.15367e-01_r8, 1.15106e-01_r8, 1.14846e-01_r8, 1.14586e-01_r8, & + & 1.14327e-01_r8, 1.14069e-01_r8, 1.13811e-01_r8, 1.13553e-01_r8/) + kao_mo3(:, 2) = (/ & + & 1.83777e-01_r8, 1.84268e-01_r8, 1.84761e-01_r8, 1.85255e-01_r8, 1.85751e-01_r8, & + & 1.86248e-01_r8, 1.86746e-01_r8, 1.87245e-01_r8, 1.87746e-01_r8, 1.88248e-01_r8, & + & 1.88752e-01_r8, 1.89257e-01_r8, 1.89763e-01_r8, 1.90270e-01_r8, 1.90779e-01_r8, & + & 1.91290e-01_r8, 1.91801e-01_r8, 1.92314e-01_r8, 1.92829e-01_r8/) + kao_mo3(:, 3) = (/ & + & 2.33414e-01_r8, 2.34511e-01_r8, 2.35614e-01_r8, 2.36722e-01_r8, 2.37836e-01_r8, & + & 2.38954e-01_r8, 2.40078e-01_r8, 2.41207e-01_r8, 2.42342e-01_r8, 2.43481e-01_r8, & + & 2.44626e-01_r8, 2.45777e-01_r8, 2.46933e-01_r8, 2.48094e-01_r8, 2.49261e-01_r8, & + & 2.50433e-01_r8, 2.51611e-01_r8, 2.52794e-01_r8, 2.53983e-01_r8/) + kao_mo3(:, 4) = (/ & + & 2.84906e-01_r8, 2.87358e-01_r8, 2.89832e-01_r8, 2.92328e-01_r8, 2.94844e-01_r8, & + & 2.97383e-01_r8, 2.99943e-01_r8, 3.02525e-01_r8, 3.05130e-01_r8, 3.07757e-01_r8, & + & 3.10406e-01_r8, 3.13078e-01_r8, 3.15774e-01_r8, 3.18492e-01_r8, 3.21234e-01_r8, & + & 3.24000e-01_r8, 3.26789e-01_r8, 3.29603e-01_r8, 3.32440e-01_r8/) + kao_mo3(:, 5) = (/ & + & 3.40508e-01_r8, 3.44095e-01_r8, 3.47720e-01_r8, 3.51383e-01_r8, 3.55084e-01_r8, & + & 3.58824e-01_r8, 3.62604e-01_r8, 3.66424e-01_r8, 3.70284e-01_r8, 3.74184e-01_r8, & + & 3.78126e-01_r8, 3.82109e-01_r8, 3.86134e-01_r8, 3.90202e-01_r8, 3.94312e-01_r8, & + & 3.98466e-01_r8, 4.02663e-01_r8, 4.06905e-01_r8, 4.11191e-01_r8/) + kao_mo3(:, 6) = (/ & + & 3.78368e-01_r8, 3.83690e-01_r8, 3.89086e-01_r8, 3.94558e-01_r8, 4.00107e-01_r8, & + & 4.05735e-01_r8, 4.11441e-01_r8, 4.17227e-01_r8, 4.23095e-01_r8, 4.29046e-01_r8, & + & 4.35080e-01_r8, 4.41199e-01_r8, 4.47404e-01_r8, 4.53697e-01_r8, 4.60078e-01_r8, & + & 4.66548e-01_r8, 4.73110e-01_r8, 4.79764e-01_r8, 4.86511e-01_r8/) + kao_mo3(:, 7) = (/ & + & 4.51965e-01_r8, 4.58461e-01_r8, 4.65051e-01_r8, 4.71735e-01_r8, 4.78516e-01_r8, & + & 4.85394e-01_r8, 4.92371e-01_r8, 4.99448e-01_r8, 5.06627e-01_r8, 5.13909e-01_r8, & + & 5.21296e-01_r8, 5.28789e-01_r8, 5.36390e-01_r8, 5.44100e-01_r8, 5.51920e-01_r8, & + & 5.59854e-01_r8, 5.67901e-01_r8, 5.76064e-01_r8, 5.84344e-01_r8/) + kao_mo3(:, 8) = (/ & + & 3.00557e-01_r8, 3.03974e-01_r8, 3.07430e-01_r8, 3.10925e-01_r8, 3.14460e-01_r8, & + & 3.18035e-01_r8, 3.21651e-01_r8, 3.25307e-01_r8, 3.29006e-01_r8, 3.32746e-01_r8, & + & 3.36529e-01_r8, 3.40355e-01_r8, 3.44224e-01_r8, 3.48137e-01_r8, 3.52095e-01_r8, & + & 3.56098e-01_r8, 3.60146e-01_r8, 3.64241e-01_r8, 3.68381e-01_r8/) + kao_mo3(:, 9) = (/ & + & 2.10042e-01_r8, 2.12905e-01_r8, 2.15806e-01_r8, 2.18748e-01_r8, 2.21729e-01_r8, & + & 2.24751e-01_r8, 2.27814e-01_r8, 2.30919e-01_r8, 2.34066e-01_r8, 2.37256e-01_r8, & + & 2.40489e-01_r8, 2.43767e-01_r8, 2.47089e-01_r8, 2.50457e-01_r8, 2.53870e-01_r8, & + & 2.57330e-01_r8, 2.60837e-01_r8, 2.64392e-01_r8, 2.67996e-01_r8/) + kao_mo3(:,10) = (/ & + & 2.09288e-01_r8, 2.11759e-01_r8, 2.14259e-01_r8, 2.16789e-01_r8, 2.19349e-01_r8, & + & 2.21939e-01_r8, 2.24559e-01_r8, 2.27210e-01_r8, 2.29893e-01_r8, 2.32607e-01_r8, & + & 2.35354e-01_r8, 2.38133e-01_r8, 2.40944e-01_r8, 2.43789e-01_r8, 2.46667e-01_r8, & + & 2.49580e-01_r8, 2.52527e-01_r8, 2.55508e-01_r8, 2.58525e-01_r8/) + kao_mo3(:,11) = (/ & + & 2.28947e-01_r8, 2.30609e-01_r8, 2.32283e-01_r8, 2.33969e-01_r8, 2.35667e-01_r8, & + & 2.37378e-01_r8, 2.39101e-01_r8, 2.40836e-01_r8, 2.42584e-01_r8, 2.44345e-01_r8, & + & 2.46118e-01_r8, 2.47905e-01_r8, 2.49704e-01_r8, 2.51516e-01_r8, 2.53342e-01_r8, & + & 2.55181e-01_r8, 2.57033e-01_r8, 2.58899e-01_r8, 2.60778e-01_r8/) + kao_mo3(:,12) = (/ & + & 2.57263e-01_r8, 2.58272e-01_r8, 2.59285e-01_r8, 2.60302e-01_r8, 2.61323e-01_r8, & + & 2.62347e-01_r8, 2.63376e-01_r8, 2.64409e-01_r8, 2.65446e-01_r8, 2.66487e-01_r8, & + & 2.67532e-01_r8, 2.68581e-01_r8, 2.69635e-01_r8, 2.70692e-01_r8, 2.71753e-01_r8, & + & 2.72819e-01_r8, 2.73889e-01_r8, 2.74963e-01_r8, 2.76042e-01_r8/) + kao_mo3(:,13) = (/ & + & 2.43322e-01_r8, 2.45918e-01_r8, 2.48541e-01_r8, 2.51192e-01_r8, 2.53872e-01_r8, & + & 2.56580e-01_r8, 2.59317e-01_r8, 2.62083e-01_r8, 2.64879e-01_r8, 2.67704e-01_r8, & + & 2.70560e-01_r8, 2.73446e-01_r8, 2.76363e-01_r8, 2.79311e-01_r8, 2.82290e-01_r8, & + & 2.85302e-01_r8, 2.88345e-01_r8, 2.91421e-01_r8, 2.94529e-01_r8/) + kao_mo3(:,14) = (/ & + & 2.10568e-01_r8, 2.16529e-01_r8, 2.22660e-01_r8, 2.28964e-01_r8, 2.35446e-01_r8, & + & 2.42113e-01_r8, 2.48967e-01_r8, 2.56016e-01_r8, 2.63265e-01_r8, 2.70719e-01_r8, & + & 2.78383e-01_r8, 2.86265e-01_r8, 2.94370e-01_r8, 3.02704e-01_r8, 3.11275e-01_r8, & + & 3.20088e-01_r8, 3.29150e-01_r8, 3.38470e-01_r8, 3.48052e-01_r8/) + kao_mo3(:,15) = (/ & + & 2.60406e-02_r8, 2.78779e-02_r8, 2.98448e-02_r8, 3.19505e-02_r8, 3.42048e-02_r8, & + & 3.66181e-02_r8, 3.92017e-02_r8, 4.19675e-02_r8, 4.49285e-02_r8, 4.80985e-02_r8, & + & 5.14920e-02_r8, 5.51250e-02_r8, 5.90143e-02_r8, 6.31781e-02_r8, 6.76356e-02_r8, & + & 7.24076e-02_r8, 7.75163e-02_r8, 8.29854e-02_r8, 8.88404e-02_r8/) + kao_mo3(:,16) = (/ & + & 2.31483e-02_r8, 2.46840e-02_r8, 2.63217e-02_r8, 2.80681e-02_r8, 2.99302e-02_r8, & + & 3.19160e-02_r8, 3.40335e-02_r8, 3.62914e-02_r8, 3.86992e-02_r8, 4.12668e-02_r8, & + & 4.40046e-02_r8, 4.69242e-02_r8, 5.00374e-02_r8, 5.33571e-02_r8, 5.68971e-02_r8, & + & 6.06720e-02_r8, 6.46974e-02_r8, 6.89897e-02_r8, 7.35669e-02_r8/) + kao_mn2o(:, 1) = (/ & + & 3.02276e-02_r8, 3.10321e-02_r8, 3.18580e-02_r8, 3.27059e-02_r8, 3.35764e-02_r8, & + & 3.44700e-02_r8, 3.53875e-02_r8, 3.63293e-02_r8, 3.72962e-02_r8, 3.82889e-02_r8, & + & 3.93079e-02_r8, 4.03541e-02_r8, 4.14281e-02_r8, 4.25307e-02_r8, 4.36627e-02_r8, & + & 4.48248e-02_r8, 4.60178e-02_r8, 4.72425e-02_r8, 4.84999e-02_r8/) + kao_mn2o(:, 2) = (/ & + & 6.10132e-02_r8, 6.17435e-02_r8, 6.24825e-02_r8, 6.32304e-02_r8, 6.39872e-02_r8, & + & 6.47531e-02_r8, 6.55281e-02_r8, 6.63124e-02_r8, 6.71061e-02_r8, 6.79093e-02_r8, & + & 6.87221e-02_r8, 6.95446e-02_r8, 7.03770e-02_r8, 7.12194e-02_r8, 7.20718e-02_r8, & + & 7.29344e-02_r8, 7.38074e-02_r8, 7.46908e-02_r8, 7.55848e-02_r8/) + kao_mn2o(:, 3) = (/ & + & 1.04479e-01_r8, 1.05566e-01_r8, 1.06664e-01_r8, 1.07774e-01_r8, 1.08895e-01_r8, & + & 1.10028e-01_r8, 1.11173e-01_r8, 1.12329e-01_r8, 1.13498e-01_r8, 1.14679e-01_r8, & + & 1.15872e-01_r8, 1.17077e-01_r8, 1.18295e-01_r8, 1.19526e-01_r8, 1.20770e-01_r8, & + & 1.22026e-01_r8, 1.23296e-01_r8, 1.24578e-01_r8, 1.25875e-01_r8/) + kao_mn2o(:, 4) = (/ & + & 2.07260e-01_r8, 2.08126e-01_r8, 2.08996e-01_r8, 2.09869e-01_r8, 2.10746e-01_r8, & + & 2.11627e-01_r8, 2.12511e-01_r8, 2.13399e-01_r8, 2.14291e-01_r8, 2.15187e-01_r8, & + & 2.16086e-01_r8, 2.16989e-01_r8, 2.17896e-01_r8, 2.18807e-01_r8, 2.19721e-01_r8, & + & 2.20640e-01_r8, 2.21562e-01_r8, 2.22488e-01_r8, 2.23418e-01_r8/) + kao_mn2o(:, 5) = (/ & + & 3.71566e-01_r8, 3.71353e-01_r8, 3.71141e-01_r8, 3.70928e-01_r8, 3.70716e-01_r8, & + & 3.70504e-01_r8, 3.70292e-01_r8, 3.70080e-01_r8, 3.69869e-01_r8, 3.69657e-01_r8, & + & 3.69446e-01_r8, 3.69234e-01_r8, 3.69023e-01_r8, 3.68812e-01_r8, 3.68601e-01_r8, & + & 3.68390e-01_r8, 3.68179e-01_r8, 3.67969e-01_r8, 3.67758e-01_r8/) + kao_mn2o(:, 6) = (/ & + & 5.28092e-01_r8, 5.27262e-01_r8, 5.26433e-01_r8, 5.25605e-01_r8, 5.24779e-01_r8, & + & 5.23954e-01_r8, 5.23130e-01_r8, 5.22307e-01_r8, 5.21486e-01_r8, 5.20666e-01_r8, & + & 5.19847e-01_r8, 5.19030e-01_r8, 5.18214e-01_r8, 5.17399e-01_r8, 5.16586e-01_r8, & + & 5.15773e-01_r8, 5.14962e-01_r8, 5.14153e-01_r8, 5.13344e-01_r8/) + kao_mn2o(:, 7) = (/ & + & 3.88140e-01_r8, 3.87956e-01_r8, 3.87773e-01_r8, 3.87590e-01_r8, 3.87407e-01_r8, & + & 3.87224e-01_r8, 3.87041e-01_r8, 3.86858e-01_r8, 3.86675e-01_r8, 3.86492e-01_r8, & + & 3.86310e-01_r8, 3.86127e-01_r8, 3.85945e-01_r8, 3.85763e-01_r8, 3.85580e-01_r8, & + & 3.85398e-01_r8, 3.85216e-01_r8, 3.85034e-01_r8, 3.84852e-01_r8/) + kao_mn2o(:, 8) = (/ & + & 3.12991e-01_r8, 3.12246e-01_r8, 3.11504e-01_r8, 3.10763e-01_r8, 3.10024e-01_r8, & + & 3.09287e-01_r8, 3.08552e-01_r8, 3.07818e-01_r8, 3.07086e-01_r8, 3.06356e-01_r8, & + & 3.05628e-01_r8, 3.04901e-01_r8, 3.04176e-01_r8, 3.03453e-01_r8, 3.02732e-01_r8, & + & 3.02012e-01_r8, 3.01294e-01_r8, 3.00577e-01_r8, 2.99863e-01_r8/) + kao_mn2o(:, 9) = (/ & + & 4.11761e-01_r8, 4.11309e-01_r8, 4.10858e-01_r8, 4.10407e-01_r8, 4.09957e-01_r8, & + & 4.09507e-01_r8, 4.09057e-01_r8, 4.08608e-01_r8, 4.08160e-01_r8, 4.07712e-01_r8, & + & 4.07265e-01_r8, 4.06818e-01_r8, 4.06371e-01_r8, 4.05925e-01_r8, 4.05480e-01_r8, & + & 4.05035e-01_r8, 4.04590e-01_r8, 4.04146e-01_r8, 4.03703e-01_r8/) + kao_mn2o(:,10) = (/ & + & 2.84648e-01_r8, 2.87025e-01_r8, 2.89421e-01_r8, 2.91838e-01_r8, 2.94275e-01_r8, & + & 2.96732e-01_r8, 2.99210e-01_r8, 3.01708e-01_r8, 3.04227e-01_r8, 3.06768e-01_r8, & + & 3.09329e-01_r8, 3.11912e-01_r8, 3.14517e-01_r8, 3.17143e-01_r8, 3.19791e-01_r8, & + & 3.22461e-01_r8, 3.25154e-01_r8, 3.27869e-01_r8, 3.30606e-01_r8/) + kao_mn2o(:,11) = (/ & + & 2.75090e-01_r8, 2.79370e-01_r8, 2.83716e-01_r8, 2.88129e-01_r8, 2.92611e-01_r8, & + & 2.97163e-01_r8, 3.01786e-01_r8, 3.06480e-01_r8, 3.11248e-01_r8, 3.16090e-01_r8, & + & 3.21007e-01_r8, 3.26001e-01_r8, 3.31072e-01_r8, 3.36222e-01_r8, 3.41452e-01_r8, & + & 3.46764e-01_r8, 3.52158e-01_r8, 3.57636e-01_r8, 3.63200e-01_r8/) + kao_mn2o(:,12) = (/ & + & 1.67753e-01_r8, 1.71386e-01_r8, 1.75098e-01_r8, 1.78890e-01_r8, 1.82765e-01_r8, & + & 1.86723e-01_r8, 1.90767e-01_r8, 1.94899e-01_r8, 1.99120e-01_r8, 2.03433e-01_r8, & + & 2.07839e-01_r8, 2.12340e-01_r8, 2.16939e-01_r8, 2.21638e-01_r8, 2.26438e-01_r8, & + & 2.31342e-01_r8, 2.36353e-01_r8, 2.41472e-01_r8, 2.46701e-01_r8/) + kao_mn2o(:,13) = (/ & + & 1.40543e-01_r8, 1.42049e-01_r8, 1.43571e-01_r8, 1.45109e-01_r8, 1.46663e-01_r8, & + & 1.48234e-01_r8, 1.49822e-01_r8, 1.51427e-01_r8, 1.53049e-01_r8, 1.54689e-01_r8, & + & 1.56346e-01_r8, 1.58021e-01_r8, 1.59713e-01_r8, 1.61424e-01_r8, 1.63153e-01_r8, & + & 1.64901e-01_r8, 1.66668e-01_r8, 1.68453e-01_r8, 1.70258e-01_r8/) + kao_mn2o(:,14) = (/ & + & 1.51530e-01_r8, 1.50944e-01_r8, 1.50360e-01_r8, 1.49779e-01_r8, 1.49199e-01_r8, & + & 1.48622e-01_r8, 1.48047e-01_r8, 1.47474e-01_r8, 1.46903e-01_r8, 1.46335e-01_r8, & + & 1.45769e-01_r8, 1.45205e-01_r8, 1.44643e-01_r8, 1.44083e-01_r8, 1.43526e-01_r8, & + & 1.42971e-01_r8, 1.42418e-01_r8, 1.41867e-01_r8, 1.41318e-01_r8/) + kao_mn2o(:,15) = (/ & + & 2.20492e-01_r8, 2.16479e-01_r8, 2.12539e-01_r8, 2.08671e-01_r8, 2.04873e-01_r8, & + & 2.01145e-01_r8, 1.97484e-01_r8, 1.93890e-01_r8, 1.90361e-01_r8, 1.86897e-01_r8, & + & 1.83495e-01_r8, 1.80156e-01_r8, 1.76877e-01_r8, 1.73658e-01_r8, 1.70497e-01_r8, & + & 1.67394e-01_r8, 1.64348e-01_r8, 1.61356e-01_r8, 1.58420e-01_r8/) + kao_mn2o(:,16) = (/ & + & 2.19848e-01_r8, 2.15847e-01_r8, 2.11919e-01_r8, 2.08062e-01_r8, 2.04275e-01_r8, & + & 2.00558e-01_r8, 1.96908e-01_r8, 1.93324e-01_r8, 1.89806e-01_r8, 1.86351e-01_r8, & + & 1.82960e-01_r8, 1.79630e-01_r8, 1.76361e-01_r8, 1.73151e-01_r8, 1.70000e-01_r8, & + & 1.66906e-01_r8, 1.63868e-01_r8, 1.60886e-01_r8, 1.57958e-01_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kbo_mco2(:, 1) = (/ & + & 4.74280e-08_r8, 6.62724e-08_r8, 9.26042e-08_r8, 1.29398e-07_r8, 1.80812e-07_r8, & + & 2.52653e-07_r8, 3.53039e-07_r8, 4.93310e-07_r8, 6.89316e-07_r8, 9.63198e-07_r8, & + & 1.34590e-06_r8, 1.88067e-06_r8, 2.62790e-06_r8, 3.67204e-06_r8, 5.13104e-06_r8, & + & 7.16974e-06_r8, 1.00185e-05_r8, 1.39991e-05_r8, 1.95613e-05_r8/) + kbo_mco2(:, 2) = (/ & + & 1.14872e-07_r8, 1.63356e-07_r8, 2.32304e-07_r8, 3.30352e-07_r8, 4.69783e-07_r8, & + & 6.68064e-07_r8, 9.50033e-07_r8, 1.35101e-06_r8, 1.92123e-06_r8, 2.73213e-06_r8, & + & 3.88527e-06_r8, 5.52513e-06_r8, 7.85711e-06_r8, 1.11734e-05_r8, 1.58893e-05_r8, & + & 2.25957e-05_r8, 3.21326e-05_r8, 4.56948e-05_r8, 6.49811e-05_r8/) + kbo_mco2(:, 3) = (/ & + & 3.30676e-07_r8, 4.76313e-07_r8, 6.86094e-07_r8, 9.88267e-07_r8, 1.42353e-06_r8, & + & 2.05048e-06_r8, 2.95356e-06_r8, 4.25439e-06_r8, 6.12813e-06_r8, 8.82711e-06_r8, & + & 1.27148e-05_r8, 1.83147e-05_r8, 2.63810e-05_r8, 3.79998e-05_r8, 5.47359e-05_r8, & + & 7.88430e-05_r8, 1.13568e-04_r8, 1.63585e-04_r8, 2.35632e-04_r8/) + kbo_mco2(:, 4) = (/ & + & 6.58642e-07_r8, 9.52761e-07_r8, 1.37822e-06_r8, 1.99368e-06_r8, 2.88396e-06_r8, & + & 4.17181e-06_r8, 6.03475e-06_r8, 8.72960e-06_r8, 1.26279e-05_r8, 1.82669e-05_r8, & + & 2.64241e-05_r8, 3.82239e-05_r8, 5.52929e-05_r8, 7.99844e-05_r8, 1.15702e-04_r8, & + & 1.67369e-04_r8, 2.42109e-04_r8, 3.50223e-04_r8, 5.06617e-04_r8/) + kbo_mco2(:, 5) = (/ & + & 1.26418e-06_r8, 1.82095e-06_r8, 2.62292e-06_r8, 3.77810e-06_r8, 5.44204e-06_r8, & + & 7.83881e-06_r8, 1.12911e-05_r8, 1.62640e-05_r8, 2.34269e-05_r8, 3.37445e-05_r8, & + & 4.86061e-05_r8, 7.00131e-05_r8, 1.00848e-04_r8, 1.45263e-04_r8, 2.09239e-04_r8, & + & 3.01392e-04_r8, 4.34131e-04_r8, 6.25329e-04_r8, 9.00733e-04_r8/) + kbo_mco2(:, 6) = (/ & + & 2.38529e-06_r8, 3.43110e-06_r8, 4.93545e-06_r8, 7.09937e-06_r8, 1.02120e-05_r8, & + & 1.46895e-05_r8, 2.11300e-05_r8, 3.03943e-05_r8, 4.37205e-05_r8, 6.28894e-05_r8, & + & 9.04630e-05_r8, 1.30126e-04_r8, 1.87179e-04_r8, 2.69247e-04_r8, 3.87296e-04_r8, & + & 5.57104e-04_r8, 8.01364e-04_r8, 1.15272e-03_r8, 1.65812e-03_r8/) + kbo_mco2(:, 7) = (/ & + & 5.41398e-06_r8, 7.54295e-06_r8, 1.05091e-05_r8, 1.46417e-05_r8, 2.03993e-05_r8, & + & 2.84211e-05_r8, 3.95973e-05_r8, 5.51683e-05_r8, 7.68626e-05_r8, 1.07088e-04_r8, & + & 1.49199e-04_r8, 2.07869e-04_r8, 2.89610e-04_r8, 4.03496e-04_r8, 5.62165e-04_r8, & + & 7.83229e-04_r8, 1.09122e-03_r8, 1.52033e-03_r8, 2.11818e-03_r8/) + kbo_mco2(:, 8) = (/ & + & 1.09995e-05_r8, 1.54018e-05_r8, 2.15660e-05_r8, 3.01973e-05_r8, 4.22831e-05_r8, & + & 5.92059e-05_r8, 8.29017e-05_r8, 1.16081e-04_r8, 1.62540e-04_r8, 2.27592e-04_r8, & + & 3.18681e-04_r8, 4.46226e-04_r8, 6.24817e-04_r8, 8.74886e-04_r8, 1.22504e-03_r8, & + & 1.71533e-03_r8, 2.40185e-03_r8, 3.36313e-03_r8, 4.70915e-03_r8/) + kbo_mco2(:, 9) = (/ & + & 3.29051e-05_r8, 4.59996e-05_r8, 6.43050e-05_r8, 8.98950e-05_r8, 1.25668e-04_r8, & + & 1.75678e-04_r8, 2.45588e-04_r8, 3.43319e-04_r8, 4.79942e-04_r8, 6.70933e-04_r8, & + & 9.37930e-04_r8, 1.31118e-03_r8, 1.83295e-03_r8, 2.56237e-03_r8, 3.58206e-03_r8, & + & 5.00753e-03_r8, 7.00027e-03_r8, 9.78599e-03_r8, 1.36803e-02_r8/) + kbo_mco2(:,10) = (/ & + & 1.95126e-05_r8, 2.65944e-05_r8, 3.62463e-05_r8, 4.94013e-05_r8, 6.73305e-05_r8, & + & 9.17669e-05_r8, 1.25072e-04_r8, 1.70465e-04_r8, 2.32332e-04_r8, 3.16652e-04_r8, & + & 4.31575e-04_r8, 5.88208e-04_r8, 8.01687e-04_r8, 1.09264e-03_r8, 1.48920e-03_r8, & + & 2.02968e-03_r8, 2.76631e-03_r8, 3.77029e-03_r8, 5.13865e-03_r8/) + kbo_mco2(:,11) = (/ & + & 8.67271e-05_r8, 1.19228e-04_r8, 1.63908e-04_r8, 2.25332e-04_r8, 3.09774e-04_r8, & + & 4.25860e-04_r8, 5.85450e-04_r8, 8.04845e-04_r8, 1.10646e-03_r8, 1.52110e-03_r8, & + & 2.09112e-03_r8, 2.87476e-03_r8, 3.95207e-03_r8, 5.43309e-03_r8, 7.46911e-03_r8, & + & 1.02681e-02_r8, 1.41161e-02_r8, 1.94060e-02_r8, 2.66783e-02_r8/) + kbo_mco2(:,12) = (/ & + & 3.79194e-07_r8, 5.51419e-07_r8, 8.01866e-07_r8, 1.16606e-06_r8, 1.69567e-06_r8, & + & 2.46582e-06_r8, 3.58577e-06_r8, 5.21438e-06_r8, 7.58268e-06_r8, 1.10266e-05_r8, & + & 1.60348e-05_r8, 2.33176e-05_r8, 3.39081e-05_r8, 4.93087e-05_r8, 7.17040e-05_r8, & + & 1.04271e-04_r8, 1.51630e-04_r8, 2.20498e-04_r8, 3.20644e-04_r8/) + kbo_mco2(:,13) = (/ & + & 1.72555e-07_r8, 2.29952e-07_r8, 3.06441e-07_r8, 4.08373e-07_r8, 5.44209e-07_r8, & + & 7.25229e-07_r8, 9.66461e-07_r8, 1.28793e-06_r8, 1.71634e-06_r8, 2.28724e-06_r8, & + & 3.04805e-06_r8, 4.06192e-06_r8, 5.41303e-06_r8, 7.21356e-06_r8, 9.61299e-06_r8, & + & 1.28106e-05_r8, 1.70717e-05_r8, 2.27503e-05_r8, 3.03177e-05_r8/) + kbo_mco2(:,14) = (/ & + & 7.42245e-09_r8, 7.17780e-09_r8, 6.94122e-09_r8, 6.71243e-09_r8, 6.49118e-09_r8, & + & 6.27723e-09_r8, 6.07032e-09_r8, 5.87024e-09_r8, 5.67675e-09_r8, 5.48964e-09_r8, & + & 5.30870e-09_r8, 5.13372e-09_r8, 4.96451e-09_r8, 4.80087e-09_r8, 4.64263e-09_r8, & + & 4.48961e-09_r8, 4.34163e-09_r8, 4.19852e-09_r8, 4.06014e-09_r8/) + kbo_mco2(:,15) = (/ & + & 7.41847e-09_r8, 7.17332e-09_r8, 6.93627e-09_r8, 6.70705e-09_r8, 6.48541e-09_r8, & + & 6.27109e-09_r8, 6.06386e-09_r8, 5.86347e-09_r8, 5.66970e-09_r8, 5.48234e-09_r8, & + & 5.30117e-09_r8, 5.12599e-09_r8, 4.95659e-09_r8, 4.79280e-09_r8, 4.63441e-09_r8, & + & 4.48126e-09_r8, 4.33317e-09_r8, 4.18998e-09_r8, 4.05152e-09_r8/) + kbo_mco2(:,16) = (/ & + & 7.42855e-09_r8, 7.18278e-09_r8, 6.94513e-09_r8, 6.71535e-09_r8, 6.49317e-09_r8, & + & 6.27834e-09_r8, 6.07062e-09_r8, 5.86977e-09_r8, 5.67557e-09_r8, 5.48779e-09_r8, & + & 5.30622e-09_r8, 5.13066e-09_r8, 4.96091e-09_r8, 4.79678e-09_r8, 4.63808e-09_r8, & + & 4.48462e-09_r8, 4.33625e-09_r8, 4.19278e-09_r8, 4.05406e-09_r8/) + kbo_mn2o(:, 1) = (/ & + & 2.49055e-04_r8, 2.53574e-04_r8, 2.58175e-04_r8, 2.62860e-04_r8, 2.67629e-04_r8, & + & 2.72485e-04_r8, 2.77429e-04_r8, 2.82463e-04_r8, 2.87588e-04_r8, 2.92806e-04_r8, & + & 2.98119e-04_r8, 3.03528e-04_r8, 3.09036e-04_r8, 3.14643e-04_r8, 3.20352e-04_r8, & + & 3.26165e-04_r8, 3.32083e-04_r8, 3.38109e-04_r8, 3.44243e-04_r8/) + kbo_mn2o(:, 2) = (/ & + & 3.79251e-04_r8, 4.04353e-04_r8, 4.31117e-04_r8, 4.59652e-04_r8, 4.90075e-04_r8, & + & 5.22513e-04_r8, 5.57097e-04_r8, 5.93970e-04_r8, 6.33284e-04_r8, 6.75200e-04_r8, & + & 7.19890e-04_r8, 7.67539e-04_r8, 8.18340e-04_r8, 8.72505e-04_r8, 9.30255e-04_r8, & + & 9.91827e-04_r8, 1.05747e-03_r8, 1.12747e-03_r8, 1.20209e-03_r8/) + kbo_mn2o(:, 3) = (/ & + & 7.61140e-04_r8, 8.36483e-04_r8, 9.19284e-04_r8, 1.01028e-03_r8, 1.11029e-03_r8, & + & 1.22019e-03_r8, 1.34098e-03_r8, 1.47372e-03_r8, 1.61959e-03_r8, 1.77991e-03_r8, & + & 1.95610e-03_r8, 2.14973e-03_r8, 2.36253e-03_r8, 2.59639e-03_r8, 2.85340e-03_r8, & + & 3.13585e-03_r8, 3.44626e-03_r8, 3.78740e-03_r8, 4.16230e-03_r8/) + kbo_mn2o(:, 4) = (/ & + & 2.01074e-03_r8, 2.26915e-03_r8, 2.56077e-03_r8, 2.88987e-03_r8, 3.26126e-03_r8, & + & 3.68038e-03_r8, 4.15337e-03_r8, 4.68714e-03_r8, 5.28951e-03_r8, 5.96929e-03_r8, & + & 6.73643e-03_r8, 7.60217e-03_r8, 8.57916e-03_r8, 9.68172e-03_r8, 1.09260e-02_r8, & + & 1.23301e-02_r8, 1.39147e-02_r8, 1.57030e-02_r8, 1.77211e-02_r8/) + kbo_mn2o(:, 5) = (/ & + & 7.43302e-03_r8, 8.32582e-03_r8, 9.32585e-03_r8, 1.04460e-02_r8, 1.17007e-02_r8, & + & 1.31061e-02_r8, 1.46803e-02_r8, 1.64436e-02_r8, 1.84186e-02_r8, 2.06309e-02_r8, & + & 2.31090e-02_r8, 2.58846e-02_r8, 2.89937e-02_r8, 3.24762e-02_r8, 3.63769e-02_r8, & + & 4.07463e-02_r8, 4.56404e-02_r8, 5.11223e-02_r8, 5.72627e-02_r8/) + kbo_mn2o(:, 6) = (/ & + & 2.71911e-02_r8, 2.94258e-02_r8, 3.18441e-02_r8, 3.44612e-02_r8, 3.72933e-02_r8, & + & 4.03582e-02_r8, 4.36750e-02_r8, 4.72644e-02_r8, 5.11487e-02_r8, 5.53523e-02_r8, & + & 5.99014e-02_r8, 6.48243e-02_r8, 7.01518e-02_r8, 7.59172e-02_r8, 8.21563e-02_r8, & + & 8.89082e-02_r8, 9.62150e-02_r8, 1.04122e-01_r8, 1.12679e-01_r8/) + kbo_mn2o(:, 7) = (/ & + & 1.63331e-01_r8, 1.80469e-01_r8, 1.99406e-01_r8, 2.20330e-01_r8, 2.43449e-01_r8, & + & 2.68995e-01_r8, 2.97221e-01_r8, 3.28408e-01_r8, 3.62869e-01_r8, 4.00945e-01_r8, & + & 4.43017e-01_r8, 4.89503e-01_r8, 5.40867e-01_r8, 5.97621e-01_r8, 6.60330e-01_r8, & + & 7.29619e-01_r8, 8.06179e-01_r8, 8.90772e-01_r8, 9.84242e-01_r8/) + kbo_mn2o(:, 8) = (/ & + & 1.32648e+00_r8, 1.33515e+00_r8, 1.34387e+00_r8, 1.35265e+00_r8, 1.36149e+00_r8, & + & 1.37038e+00_r8, 1.37933e+00_r8, 1.38835e+00_r8, 1.39742e+00_r8, 1.40655e+00_r8, & + & 1.41574e+00_r8, 1.42499e+00_r8, 1.43429e+00_r8, 1.44367e+00_r8, 1.45310e+00_r8, & + & 1.46259e+00_r8, 1.47215e+00_r8, 1.48176e+00_r8, 1.49144e+00_r8/) + kbo_mn2o(:, 9) = (/ & + & 3.12620e+00_r8, 3.03118e+00_r8, 2.93905e+00_r8, 2.84972e+00_r8, 2.76310e+00_r8, & + & 2.67911e+00_r8, 2.59768e+00_r8, 2.51873e+00_r8, 2.44217e+00_r8, 2.36794e+00_r8, & + & 2.29596e+00_r8, 2.22618e+00_r8, 2.15851e+00_r8, 2.09290e+00_r8, 2.02929e+00_r8, & + & 1.96761e+00_r8, 1.90780e+00_r8, 1.84982e+00_r8, 1.79359e+00_r8/) + kbo_mn2o(:,10) = (/ & + & 1.60677e-02_r8, 1.82485e-02_r8, 2.07254e-02_r8, 2.35384e-02_r8, 2.67332e-02_r8, & + & 3.03617e-02_r8, 3.44827e-02_r8, 3.91629e-02_r8, 4.44785e-02_r8, 5.05154e-02_r8, & + & 5.73718e-02_r8, 6.51589e-02_r8, 7.40027e-02_r8, 8.40470e-02_r8, 9.54546e-02_r8, & + & 1.08411e-01_r8, 1.23125e-01_r8, 1.39836e-01_r8, 1.58816e-01_r8/) + kbo_mn2o(:,11) = (/ & + & 1.55287e-02_r8, 1.78265e-02_r8, 2.04642e-02_r8, 2.34922e-02_r8, 2.69683e-02_r8, & + & 3.09588e-02_r8, 3.55397e-02_r8, 4.07984e-02_r8, 4.68352e-02_r8, 5.37653e-02_r8, & + & 6.17208e-02_r8, 7.08535e-02_r8, 8.13375e-02_r8, 9.33728e-02_r8, 1.07189e-01_r8, & + & 1.23049e-01_r8, 1.41257e-01_r8, 1.62158e-01_r8, 1.86152e-01_r8/) + kbo_mn2o(:,12) = (/ & + & 7.13719e-03_r8, 8.18879e-03_r8, 9.39535e-03_r8, 1.07797e-02_r8, 1.23680e-02_r8, & + & 1.41903e-02_r8, 1.62811e-02_r8, 1.86800e-02_r8, 2.14324e-02_r8, 2.45902e-02_r8, & + & 2.82134e-02_r8, 3.23704e-02_r8, 3.71400e-02_r8, 4.26122e-02_r8, 4.88908e-02_r8, & + & 5.60945e-02_r8, 6.43596e-02_r8, 7.38424e-02_r8, 8.47224e-02_r8/) + kbo_mn2o(:,13) = (/ & + & 9.28813e-03_r8, 1.06108e-02_r8, 1.21218e-02_r8, 1.38480e-02_r8, 1.58199e-02_r8, & + & 1.80727e-02_r8, 2.06463e-02_r8, 2.35864e-02_r8, 2.69452e-02_r8, 3.07822e-02_r8, & + & 3.51657e-02_r8, 4.01734e-02_r8, 4.58941e-02_r8, 5.24296e-02_r8, 5.98956e-02_r8, & + & 6.84249e-02_r8, 7.81688e-02_r8, 8.93002e-02_r8, 1.02017e-01_r8/) + kbo_mn2o(:,14) = (/ & + & 2.17205e-02_r8, 2.51661e-02_r8, 2.91581e-02_r8, 3.37835e-02_r8, 3.91425e-02_r8, & + & 4.53517e-02_r8, 5.25458e-02_r8, 6.08811e-02_r8, 7.05387e-02_r8, 8.17282e-02_r8, & + & 9.46927e-02_r8, 1.09714e-01_r8, 1.27118e-01_r8, 1.47282e-01_r8, 1.70645e-01_r8, & + & 1.97715e-01_r8, 2.29078e-01_r8, 2.65417e-01_r8, 3.07520e-01_r8/) + kbo_mn2o(:,15) = (/ & + & 4.89156e-02_r8, 5.70504e-02_r8, 6.65379e-02_r8, 7.76033e-02_r8, 9.05089e-02_r8, & + & 1.05561e-01_r8, 1.23116e-01_r8, 1.43590e-01_r8, 1.67469e-01_r8, 1.95320e-01_r8, & + & 2.27802e-01_r8, 2.65686e-01_r8, 3.09869e-01_r8, 3.61401e-01_r8, 4.21503e-01_r8, & + & 4.91600e-01_r8, 5.73354e-01_r8, 6.68703e-01_r8, 7.79910e-01_r8/) + kbo_mn2o(:,16) = (/ & + & 1.13156e-02_r8, 1.46199e-02_r8, 1.88891e-02_r8, 2.44050e-02_r8, 3.15316e-02_r8, & + & 4.07393e-02_r8, 5.26358e-02_r8, 6.80061e-02_r8, 8.78649e-02_r8, 1.13523e-01_r8, & + & 1.46673e-01_r8, 1.89504e-01_r8, 2.44841e-01_r8, 3.16338e-01_r8, 4.08713e-01_r8, & + & 5.28064e-01_r8, 6.82266e-01_r8, 8.81496e-01_r8, 1.13891e+00_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &4.8166e-07_r8,3.7500e-07_r8,4.8978e-07_r8,5.9624e-07_r8,6.3742e-07_r8,7.5551e-07_r8, & + &7.7706e-07_r8,6.8681e-07_r8,7.5212e-07_r8,8.0956e-07_r8,7.8117e-07_r8,7.4835e-07_r8, & + &9.4118e-07_r8,1.2585e-06_r8,1.4976e-06_r8,1.4976e-06_r8/) + forrefo(2,:) = (/ & + &3.1320e-07_r8,4.0764e-07_r8,4.7468e-07_r8,5.9976e-07_r8,7.3324e-07_r8,8.1488e-07_r8, & + &7.6442e-07_r8,8.2007e-07_r8,7.7721e-07_r8,7.6377e-07_r8,8.0327e-07_r8,7.1881e-07_r8, & + &8.2148e-07_r8,1.0203e-06_r8,1.5033e-06_r8,1.5032e-06_r8/) + forrefo(3,:) = (/ & + &4.1831e-07_r8,5.5043e-07_r8,5.7783e-07_r8,6.1294e-07_r8,6.3396e-07_r8,6.2292e-07_r8, & + &6.1719e-07_r8,6.4183e-07_r8,7.6180e-07_r8,9.5477e-07_r8,9.5901e-07_r8,1.0207e-06_r8, & + &1.0387e-06_r8,1.1305e-06_r8,1.3602e-06_r8,1.5063e-06_r8/) + forrefo(4,:) = (/ & + &8.5878e-07_r8,6.0921e-07_r8,5.5773e-07_r8,5.3374e-07_r8,5.0495e-07_r8,4.9844e-07_r8, & + &5.1536e-07_r8,5.2908e-07_r8,4.7977e-07_r8,5.3177e-07_r8,4.9266e-07_r8,4.5403e-07_r8, & + &3.9695e-07_r8,3.4792e-07_r8,3.4912e-07_r8,3.4102e-07_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 3.16029e-02_r8, 2.74633e-02_r8, 2.38660e-02_r8, 2.07399e-02_r8, 1.80232e-02_r8, & + & 1.56624e-02_r8, 1.36108e-02_r8, 1.18280e-02_r8, 1.02787e-02_r8, 8.93231e-03_r8/) + selfrefo(:, 2) = (/ & + & 3.10422e-02_r8, 2.71312e-02_r8, 2.37130e-02_r8, 2.07254e-02_r8, 1.81142e-02_r8, & + & 1.58320e-02_r8, 1.38374e-02_r8, 1.20940e-02_r8, 1.05703e-02_r8, 9.23854e-03_r8/) + selfrefo(:, 3) = (/ & + & 3.08657e-02_r8, 2.69431e-02_r8, 2.35190e-02_r8, 2.05301e-02_r8, 1.79210e-02_r8, & + & 1.56435e-02_r8, 1.36554e-02_r8, 1.19200e-02_r8, 1.04051e-02_r8, 9.08279e-03_r8/) + selfrefo(:, 4) = (/ & + & 3.02668e-02_r8, 2.64686e-02_r8, 2.31470e-02_r8, 2.02422e-02_r8, 1.77020e-02_r8, & + & 1.54806e-02_r8, 1.35379e-02_r8, 1.18390e-02_r8, 1.03533e-02_r8, 9.05406e-03_r8/) + selfrefo(:, 5) = (/ & + & 2.98317e-02_r8, 2.61491e-02_r8, 2.29210e-02_r8, 2.00914e-02_r8, 1.76112e-02_r8, & + & 1.54371e-02_r8, 1.35314e-02_r8, 1.18610e-02_r8, 1.03968e-02_r8, 9.11332e-03_r8/) + selfrefo(:, 6) = (/ & + & 2.95545e-02_r8, 2.59083e-02_r8, 2.27120e-02_r8, 1.99100e-02_r8, 1.74537e-02_r8, & + & 1.53004e-02_r8, 1.34128e-02_r8, 1.17580e-02_r8, 1.03074e-02_r8, 9.03576e-03_r8/) + selfrefo(:, 7) = (/ & + & 2.97352e-02_r8, 2.60320e-02_r8, 2.27900e-02_r8, 1.99517e-02_r8, 1.74670e-02_r8, & + & 1.52916e-02_r8, 1.33872e-02_r8, 1.17200e-02_r8, 1.02604e-02_r8, 8.98258e-03_r8/) + selfrefo(:, 8) = (/ & + & 2.96543e-02_r8, 2.59760e-02_r8, 2.27540e-02_r8, 1.99316e-02_r8, 1.74593e-02_r8, & + & 1.52937e-02_r8, 1.33967e-02_r8, 1.17350e-02_r8, 1.02794e-02_r8, 9.00437e-03_r8/) + selfrefo(:, 9) = (/ & + & 2.97998e-02_r8, 2.60786e-02_r8, 2.28220e-02_r8, 1.99721e-02_r8, 1.74781e-02_r8, & + & 1.52955e-02_r8, 1.33855e-02_r8, 1.17140e-02_r8, 1.02512e-02_r8, 8.97110e-03_r8/) + selfrefo(:,10) = (/ & + & 2.98826e-02_r8, 2.61096e-02_r8, 2.28130e-02_r8, 1.99326e-02_r8, 1.74159e-02_r8, & + & 1.52170e-02_r8, 1.32957e-02_r8, 1.16170e-02_r8, 1.01502e-02_r8, 8.86867e-03_r8/) + selfrefo(:,11) = (/ & + & 2.94710e-02_r8, 2.58147e-02_r8, 2.26120e-02_r8, 1.98066e-02_r8, 1.73493e-02_r8, & + & 1.51969e-02_r8, 1.33115e-02_r8, 1.16600e-02_r8, 1.02134e-02_r8, 8.94628e-03_r8/) + selfrefo(:,12) = (/ & + & 2.96297e-02_r8, 2.59544e-02_r8, 2.27350e-02_r8, 1.99149e-02_r8, 1.74446e-02_r8, & + & 1.52808e-02_r8, 1.33853e-02_r8, 1.17250e-02_r8, 1.02706e-02_r8, 8.99663e-03_r8/) + selfrefo(:,13) = (/ & + & 2.96272e-02_r8, 2.59013e-02_r8, 2.26440e-02_r8, 1.97963e-02_r8, 1.73067e-02_r8, & + & 1.51302e-02_r8, 1.32275e-02_r8, 1.15640e-02_r8, 1.01097e-02_r8, 8.83833e-03_r8/) + selfrefo(:,14) = (/ & + & 2.89906e-02_r8, 2.53971e-02_r8, 2.22490e-02_r8, 1.94911e-02_r8, 1.70751e-02_r8, & + & 1.49585e-02_r8, 1.31044e-02_r8, 1.14800e-02_r8, 1.00570e-02_r8, 8.81038e-03_r8/) + selfrefo(:,15) = (/ & + & 2.80884e-02_r8, 2.46987e-02_r8, 2.17180e-02_r8, 1.90970e-02_r8, 1.67924e-02_r8, & + & 1.47659e-02_r8, 1.29839e-02_r8, 1.14170e-02_r8, 1.00392e-02_r8, 8.82765e-03_r8/) + selfrefo(:,16) = (/ & + & 2.80884e-02_r8, 2.46987e-02_r8, 2.17180e-02_r8, 1.90970e-02_r8, 1.67924e-02_r8, & + & 1.47659e-02_r8, 1.29839e-02_r8, 1.14170e-02_r8, 1.00392e-02_r8, 8.82765e-03_r8/) + + end subroutine lw_kgb08 + +! ************************************************************************** + subroutine lw_kgb09 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg09, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, & + kbo_mn2o, selfrefo, forrefo + + implicit none + save + +! Planck fractions mapping level : P=212.7250 mb, T = 223.06 K + fracrefao(:, 1) = (/ & + & 1.8129e-01_r8,1.6119e-01_r8,1.3308e-01_r8,1.2342e-01_r8,1.1259e-01_r8,9.7580e-02_r8, & + & 7.9176e-02_r8,5.8541e-02_r8,3.9084e-02_r8,4.2419e-03_r8,3.4314e-03_r8,2.6935e-03_r8, & + & 1.9404e-03_r8,1.2218e-03_r8,4.5263e-04_r8,6.0909e-05_r8/) + fracrefao(:, 2) = (/ & + & 1.9665e-01_r8,1.5640e-01_r8,1.3101e-01_r8,1.2153e-01_r8,1.1037e-01_r8,9.6043e-02_r8, & + & 7.7856e-02_r8,5.7547e-02_r8,3.8670e-02_r8,4.1955e-03_r8,3.4104e-03_r8,2.6781e-03_r8, & + & 1.9245e-03_r8,1.2093e-03_r8,4.4113e-04_r8,6.0913e-05_r8/) + fracrefao(:, 3) = (/ & + & 2.0273e-01_r8,1.5506e-01_r8,1.3044e-01_r8,1.2043e-01_r8,1.0952e-01_r8,9.5384e-02_r8, & + & 7.7157e-02_r8,5.7176e-02_r8,3.8379e-02_r8,4.1584e-03_r8,3.3836e-03_r8,2.6412e-03_r8, & + & 1.8865e-03_r8,1.1791e-03_r8,4.2094e-04_r8,4.7410e-05_r8/) + fracrefao(:, 4) = (/ & + & 2.0272e-01_r8,1.5963e-01_r8,1.2913e-01_r8,1.2060e-01_r8,1.0820e-01_r8,9.4685e-02_r8, & + & 7.6544e-02_r8,5.6851e-02_r8,3.8155e-02_r8,4.0913e-03_r8,3.3442e-03_r8,2.6054e-03_r8, & + & 1.8875e-03_r8,1.1263e-03_r8,3.7743e-04_r8,4.7410e-05_r8/) + fracrefao(:, 5) = (/ & + & 2.0280e-01_r8,1.6353e-01_r8,1.2910e-01_r8,1.1968e-01_r8,1.0725e-01_r8,9.4112e-02_r8, & + & 7.5828e-02_r8,5.6526e-02_r8,3.7972e-02_r8,4.0205e-03_r8,3.3063e-03_r8,2.5681e-03_r8, & + & 1.8386e-03_r8,1.0757e-03_r8,3.5301e-04_r8,4.7410e-05_r8/) + fracrefao(:, 6) = (/ & + & 2.0294e-01_r8,1.6840e-01_r8,1.2852e-01_r8,1.1813e-01_r8,1.0724e-01_r8,9.2946e-02_r8, & + & 7.5029e-02_r8,5.6158e-02_r8,3.7744e-02_r8,3.9632e-03_r8,3.2434e-03_r8,2.5275e-03_r8, & + & 1.7558e-03_r8,1.0080e-03_r8,3.5301e-04_r8,4.7410e-05_r8/) + fracrefao(:, 7) = (/ & + & 2.0313e-01_r8,1.7390e-01_r8,1.2864e-01_r8,1.1689e-01_r8,1.0601e-01_r8,9.1791e-02_r8, & + & 7.4224e-02_r8,5.5500e-02_r8,3.7374e-02_r8,3.9214e-03_r8,3.1984e-03_r8,2.4162e-03_r8, & + & 1.6394e-03_r8,9.7275e-04_r8,3.5299e-04_r8,4.7410e-05_r8/) + fracrefao(:, 8) = (/ & + & 2.0332e-01_r8,1.7800e-01_r8,1.3286e-01_r8,1.1555e-01_r8,1.0407e-01_r8,9.0475e-02_r8, & + & 7.2452e-02_r8,5.4566e-02_r8,3.6677e-02_r8,3.7889e-03_r8,3.0351e-03_r8,2.2587e-03_r8, & + & 1.5764e-03_r8,9.7270e-04_r8,3.5300e-04_r8,4.7410e-05_r8/) + fracrefao(:, 9) = (/ & + & 1.9624e-01_r8,1.6519e-01_r8,1.3663e-01_r8,1.1535e-01_r8,1.0719e-01_r8,9.4156e-02_r8, & + & 7.6745e-02_r8,5.6987e-02_r8,3.8135e-02_r8,4.1626e-03_r8,3.4243e-03_r8,2.7116e-03_r8, & + & 1.7095e-03_r8,9.7271e-04_r8,3.5299e-04_r8,4.7410e-05_r8/) + +! Planck fraction mapping level : p=3.20e-2 mb, t = 197.92 k + fracrefbo(:) = (/ & + & 2.0914e-01_r8,1.5077e-01_r8,1.2878e-01_r8,1.1856e-01_r8,1.0695e-01_r8,9.3048e-02_r8, & + & 7.7645e-02_r8,6.0785e-02_r8,4.0642e-02_r8,4.0499e-03_r8,3.3931e-03_r8,2.6363e-03_r8, & + & 1.9151e-03_r8,1.1963e-03_r8,4.3471e-04_r8,5.1421e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &2.1746e-06_r8,2.0220e-05_r8,3.5039e-05_r8,4.9564e-05_r8,6.4547e-05_r8,8.0645e-05_r8, & + &1.0050e-04_r8,1.3591e-04_r8,1.1422e-04_r8/) + kao(:, 2, 1, 1) = (/ & + &2.4567e-06_r8,2.4642e-05_r8,4.2577e-05_r8,6.0179e-05_r8,7.8156e-05_r8,9.7521e-05_r8, & + &1.2325e-04_r8,1.6438e-04_r8,1.3834e-04_r8/) + kao(:, 3, 1, 1) = (/ & + &2.7778e-06_r8,2.9755e-05_r8,5.1233e-05_r8,7.2538e-05_r8,9.4256e-05_r8,1.1716e-04_r8, & + &1.4583e-04_r8,1.9818e-04_r8,1.6722e-04_r8/) + kao(:, 4, 1, 1) = (/ & + &3.1364e-06_r8,3.5376e-05_r8,6.1122e-05_r8,8.6709e-05_r8,1.1261e-04_r8,1.4025e-04_r8, & + &1.7411e-04_r8,2.3326e-04_r8,2.0043e-04_r8/) + kao(:, 5, 1, 1) = (/ & + &3.4866e-06_r8,4.1773e-05_r8,7.2421e-05_r8,1.0284e-04_r8,1.3368e-04_r8,1.6658e-04_r8, & + &2.0645e-04_r8,2.7379e-04_r8,2.3933e-04_r8/) + kao(:, 1, 2, 1) = (/ & + &2.7658e-06_r8,1.8665e-05_r8,2.9579e-05_r8,4.0556e-05_r8,5.1475e-05_r8,6.3012e-05_r8, & + &7.6030e-05_r8,9.6554e-05_r8,8.6790e-05_r8/) + kao(:, 2, 2, 1) = (/ & + &3.1474e-06_r8,2.2675e-05_r8,3.6322e-05_r8,4.9569e-05_r8,6.2848e-05_r8,7.6725e-05_r8, & + &9.2975e-05_r8,1.1920e-04_r8,1.0628e-04_r8/) + kao(:, 3, 2, 1) = (/ & + &3.5619e-06_r8,2.7222e-05_r8,4.3763e-05_r8,5.9895e-05_r8,7.6025e-05_r8,9.2855e-05_r8, & + &1.1166e-04_r8,1.4410e-04_r8,1.2840e-04_r8/) + kao(:, 4, 2, 1) = (/ & + &4.0332e-06_r8,3.2194e-05_r8,5.2284e-05_r8,7.1664e-05_r8,9.1201e-05_r8,1.1132e-04_r8, & + &1.3395e-04_r8,1.6948e-04_r8,1.5482e-04_r8/) + kao(:, 5, 2, 1) = (/ & + &4.5426e-06_r8,3.7892e-05_r8,6.1930e-05_r8,8.5200e-05_r8,1.0845e-04_r8,1.3257e-04_r8, & + &1.5957e-04_r8,2.0150e-04_r8,1.8531e-04_r8/) + kao(:, 1, 3, 1) = (/ & + &4.6515e-06_r8,1.9518e-05_r8,2.8024e-05_r8,3.5437e-05_r8,4.2060e-05_r8,4.8949e-05_r8, & + &5.6458e-05_r8,6.6193e-05_r8,6.4702e-05_r8/) + kao(:, 2, 3, 1) = (/ & + &5.3085e-06_r8,2.3661e-05_r8,3.4250e-05_r8,4.3649e-05_r8,5.1882e-05_r8,6.0429e-05_r8, & + &6.9536e-05_r8,8.2456e-05_r8,7.9400e-05_r8/) + kao(:, 3, 3, 1) = (/ & + &6.0401e-06_r8,2.8338e-05_r8,4.1344e-05_r8,5.2675e-05_r8,6.2996e-05_r8,7.3527e-05_r8, & + &8.4697e-05_r8,9.9499e-05_r8,9.6161e-05_r8/) + kao(:, 4, 3, 1) = (/ & + &6.8636e-06_r8,3.3625e-05_r8,4.9393e-05_r8,6.2729e-05_r8,7.5705e-05_r8,8.8632e-05_r8, & + &1.0218e-04_r8,1.1965e-04_r8,1.1595e-04_r8/) + kao(:, 5, 3, 1) = (/ & + &7.7592e-06_r8,3.9481e-05_r8,5.8243e-05_r8,7.4429e-05_r8,9.0184e-05_r8,1.0593e-04_r8, & + &1.2226e-04_r8,1.4329e-04_r8,1.3957e-04_r8/) + kao(:, 1, 4, 1) = (/ & + &7.8254e-06_r8,2.2162e-05_r8,2.8768e-05_r8,3.4092e-05_r8,3.8273e-05_r8,4.1617e-05_r8, & + &4.4585e-05_r8,4.7843e-05_r8,5.0090e-05_r8/) + kao(:, 2, 4, 1) = (/ & + &9.0107e-06_r8,2.6852e-05_r8,3.5234e-05_r8,4.2063e-05_r8,4.7365e-05_r8,5.1787e-05_r8, & + &5.5276e-05_r8,5.9864e-05_r8,6.1930e-05_r8/) + kao(:, 3, 4, 1) = (/ & + &1.0349e-05_r8,3.2172e-05_r8,4.2565e-05_r8,5.1061e-05_r8,5.7654e-05_r8,6.3243e-05_r8, & + &6.7675e-05_r8,7.3397e-05_r8,7.5548e-05_r8/) + kao(:, 4, 4, 1) = (/ & + &1.1906e-05_r8,3.8190e-05_r8,5.0960e-05_r8,6.1161e-05_r8,6.9192e-05_r8,7.6085e-05_r8, & + &8.1960e-05_r8,8.9085e-05_r8,9.1511e-05_r8/) + kao(:, 5, 4, 1) = (/ & + &1.3610e-05_r8,4.4853e-05_r8,6.0373e-05_r8,7.2336e-05_r8,8.2116e-05_r8,9.0436e-05_r8, & + &9.8270e-05_r8,1.0717e-04_r8,1.0994e-04_r8/) + kao(:, 1, 5, 1) = (/ & + &1.2215e-05_r8,2.6429e-05_r8,3.0893e-05_r8,3.4176e-05_r8,3.6538e-05_r8,3.7893e-05_r8, & + &3.8292e-05_r8,3.7482e-05_r8,3.9876e-05_r8/) + kao(:, 2, 5, 1) = (/ & + &1.4086e-05_r8,3.1907e-05_r8,3.7874e-05_r8,4.2237e-05_r8,4.5377e-05_r8,4.7376e-05_r8, & + &4.7976e-05_r8,4.7239e-05_r8,4.9622e-05_r8/) + kao(:, 3, 5, 1) = (/ & + &1.6264e-05_r8,3.8161e-05_r8,4.5845e-05_r8,5.1471e-05_r8,5.5412e-05_r8,5.8145e-05_r8, & + &5.8993e-05_r8,5.8204e-05_r8,6.0963e-05_r8/) + kao(:, 4, 5, 1) = (/ & + &1.8858e-05_r8,4.5142e-05_r8,5.4763e-05_r8,6.1781e-05_r8,6.6831e-05_r8,7.0144e-05_r8, & + &7.1439e-05_r8,7.0642e-05_r8,7.3664e-05_r8/) + kao(:, 5, 5, 1) = (/ & + &2.1682e-05_r8,5.2995e-05_r8,6.4832e-05_r8,7.3555e-05_r8,7.9689e-05_r8,8.3689e-05_r8, & + &8.5451e-05_r8,8.5137e-05_r8,8.8330e-05_r8/) + kao(:, 1, 6, 1) = (/ & + &1.7737e-05_r8,3.1507e-05_r8,3.4689e-05_r8,3.5923e-05_r8,3.6042e-05_r8,3.5547e-05_r8, & + &3.3855e-05_r8,3.0889e-05_r8,3.3707e-05_r8/) + kao(:, 2, 6, 1) = (/ & + &2.0662e-05_r8,3.8270e-05_r8,4.2282e-05_r8,4.3931e-05_r8,4.4914e-05_r8,4.4463e-05_r8, & + &4.2744e-05_r8,3.9347e-05_r8,4.1797e-05_r8/) + kao(:, 3, 6, 1) = (/ & + &2.4128e-05_r8,4.5613e-05_r8,5.0898e-05_r8,5.3590e-05_r8,5.4968e-05_r8,5.4808e-05_r8, & + &5.3000e-05_r8,4.8943e-05_r8,5.1147e-05_r8/) + kao(:, 4, 6, 1) = (/ & + &2.7999e-05_r8,5.3907e-05_r8,6.0955e-05_r8,6.4423e-05_r8,6.6442e-05_r8,6.6605e-05_r8, & + &6.4604e-05_r8,5.9878e-05_r8,6.1516e-05_r8/) + kao(:, 5, 6, 1) = (/ & + &3.2152e-05_r8,6.3564e-05_r8,7.2012e-05_r8,7.6692e-05_r8,7.9463e-05_r8,7.9823e-05_r8, & + &7.7573e-05_r8,7.2281e-05_r8,7.4081e-05_r8/) + kao(:, 1, 7, 1) = (/ & + &2.6880e-05_r8,4.1451e-05_r8,4.2153e-05_r8,4.1795e-05_r8,4.0071e-05_r8,3.7010e-05_r8, & + &3.2935e-05_r8,2.7157e-05_r8,3.0165e-05_r8/) + kao(:, 2, 7, 1) = (/ & + &3.1867e-05_r8,5.0449e-05_r8,5.1950e-05_r8,5.1350e-05_r8,4.9502e-05_r8,4.6117e-05_r8, & + &4.1536e-05_r8,3.4782e-05_r8,3.7420e-05_r8/) + kao(:, 3, 7, 1) = (/ & + &3.7274e-05_r8,6.0537e-05_r8,6.2610e-05_r8,6.2280e-05_r8,6.0355e-05_r8,5.6848e-05_r8, & + &5.1457e-05_r8,4.3658e-05_r8,4.5586e-05_r8/) + kao(:, 4, 7, 1) = (/ & + &4.3315e-05_r8,7.1931e-05_r8,7.4511e-05_r8,7.5005e-05_r8,7.2731e-05_r8,6.8916e-05_r8, & + &6.2904e-05_r8,5.3755e-05_r8,5.5264e-05_r8/) + kao(:, 5, 7, 1) = (/ & + &4.9907e-05_r8,8.4683e-05_r8,8.8542e-05_r8,8.9292e-05_r8,8.6631e-05_r8,8.2549e-05_r8, & + &7.6077e-05_r8,6.5242e-05_r8,6.5892e-05_r8/) + kao(:, 1, 8, 1) = (/ & + &4.7627e-05_r8,6.4864e-05_r8,6.3521e-05_r8,5.9018e-05_r8,5.3108e-05_r8,4.6571e-05_r8, & + &3.8650e-05_r8,2.8473e-05_r8,2.9135e-05_r8/) + kao(:, 2, 8, 1) = (/ & + &5.7767e-05_r8,7.9036e-05_r8,7.7751e-05_r8,7.3012e-05_r8,6.6279e-05_r8,5.8148e-05_r8, & + &4.8459e-05_r8,3.6303e-05_r8,3.6552e-05_r8/) + kao(:, 3, 8, 1) = (/ & + &6.8331e-05_r8,9.5161e-05_r8,9.3980e-05_r8,8.8741e-05_r8,8.0901e-05_r8,7.1279e-05_r8, & + &5.9682e-05_r8,4.5314e-05_r8,4.4112e-05_r8/) + kao(:, 4, 8, 1) = (/ & + &7.9894e-05_r8,1.1320e-04_r8,1.1263e-04_r8,1.0646e-04_r8,9.7413e-05_r8,8.6626e-05_r8, & + &7.2540e-05_r8,5.5667e-05_r8,5.2996e-05_r8/) + kao(:, 5, 8, 1) = (/ & + &9.2972e-05_r8,1.3437e-04_r8,1.3320e-04_r8,1.2651e-04_r8,1.1648e-04_r8,1.0389e-04_r8, & + &8.7249e-05_r8,6.7590e-05_r8,6.3371e-05_r8/) + kao(:, 1, 9, 1) = (/ & + &1.5799e-04_r8,1.8833e-04_r8,1.7550e-04_r8,1.5612e-04_r8,1.3380e-04_r8,1.0918e-04_r8, & + &8.2063e-05_r8,5.1241e-05_r8,3.5341e-05_r8/) + kao(:, 2, 9, 1) = (/ & + &1.9443e-04_r8,2.2819e-04_r8,2.1471e-04_r8,1.9244e-04_r8,1.6566e-04_r8,1.3587e-04_r8, & + &1.0320e-04_r8,6.4536e-05_r8,4.5195e-05_r8/) + kao(:, 3, 9, 1) = (/ & + &2.3622e-04_r8,2.7685e-04_r8,2.6057e-04_r8,2.3445e-04_r8,2.0276e-04_r8,1.6671e-04_r8, & + &1.2651e-04_r8,7.9797e-05_r8,5.6882e-05_r8/) + kao(:, 4, 9, 1) = (/ & + &2.7828e-04_r8,3.3139e-04_r8,3.1210e-04_r8,2.8146e-04_r8,2.4413e-04_r8,2.0071e-04_r8, & + &1.5211e-04_r8,9.7273e-05_r8,6.9081e-05_r8/) + kao(:, 5, 9, 1) = (/ & + &3.2528e-04_r8,3.9307e-04_r8,3.6944e-04_r8,3.3441e-04_r8,2.9052e-04_r8,2.3944e-04_r8, & + &1.8220e-04_r8,1.1689e-04_r8,8.4202e-05_r8/) + kao(:, 1,10, 1) = (/ & + &5.9822e-04_r8,6.2372e-04_r8,5.8089e-04_r8,5.1261e-04_r8,4.3322e-04_r8,3.4273e-04_r8, & + &2.4200e-04_r8,1.3558e-04_r8,7.2135e-05_r8/) + kao(:, 2,10, 1) = (/ & + &7.4373e-04_r8,7.8308e-04_r8,7.2223e-04_r8,6.3443e-04_r8,5.3223e-04_r8,4.2429e-04_r8, & + &3.0242e-04_r8,1.7107e-04_r8,9.5831e-05_r8/) + kao(:, 3,10, 1) = (/ & + &9.1691e-04_r8,9.5621e-04_r8,8.7625e-04_r8,7.6950e-04_r8,6.5144e-04_r8,5.1701e-04_r8, & + &3.7121e-04_r8,2.1199e-04_r8,1.2423e-04_r8/) + kao(:, 4,10, 1) = (/ & + &1.1043e-03_r8,1.1414e-03_r8,1.0539e-03_r8,9.3161e-04_r8,7.8672e-04_r8,6.2626e-04_r8, & + &4.5160e-04_r8,2.5892e-04_r8,1.5666e-04_r8/) + kao(:, 5,10, 1) = (/ & + &1.3045e-03_r8,1.3552e-03_r8,1.2556e-03_r8,1.1172e-03_r8,9.4316e-04_r8,7.4718e-04_r8, & + &5.4008e-04_r8,3.1196e-04_r8,1.9599e-04_r8/) + kao(:, 1,11, 1) = (/ & + &8.7712e-04_r8,8.8837e-04_r8,8.1430e-04_r8,7.2064e-04_r8,6.0791e-04_r8,4.8638e-04_r8, & + &3.4855e-04_r8,1.8904e-04_r8,9.5086e-05_r8/) + kao(:, 2,11, 1) = (/ & + &1.1025e-03_r8,1.1220e-03_r8,1.0310e-03_r8,9.0820e-04_r8,7.5807e-04_r8,5.9864e-04_r8, & + &4.3064e-04_r8,2.3702e-04_r8,1.2669e-04_r8/) + kao(:, 3,11, 1) = (/ & + &1.3684e-03_r8,1.3746e-03_r8,1.2594e-03_r8,1.1058e-03_r8,9.3187e-04_r8,7.3748e-04_r8, & + &5.2465e-04_r8,2.9520e-04_r8,1.6181e-04_r8/) + kao(:, 4,11, 1) = (/ & + &1.6471e-03_r8,1.6623e-03_r8,1.5206e-03_r8,1.3382e-03_r8,1.1315e-03_r8,8.9471e-04_r8, & + &6.4214e-04_r8,3.6310e-04_r8,2.0489e-04_r8/) + kao(:, 5,11, 1) = (/ & + &1.9688e-03_r8,1.9772e-03_r8,1.8138e-03_r8,1.6028e-03_r8,1.3619e-03_r8,1.0826e-03_r8, & + &7.7699e-04_r8,4.3404e-04_r8,2.5459e-04_r8/) + kao(:, 1,12, 1) = (/ & + &9.4409e-04_r8,9.5030e-04_r8,8.6958e-04_r8,7.6723e-04_r8,6.4799e-04_r8,5.1804e-04_r8, & + &3.7162e-04_r8,2.0179e-04_r8,1.0181e-04_r8/) + kao(:, 2,12, 1) = (/ & + &1.2024e-03_r8,1.2024e-03_r8,1.1035e-03_r8,9.7105e-04_r8,8.1245e-04_r8,6.4379e-04_r8, & + &4.6123e-04_r8,2.5624e-04_r8,1.3746e-04_r8/) + kao(:, 3,12, 1) = (/ & + &1.5009e-03_r8,1.4895e-03_r8,1.3527e-03_r8,1.1889e-03_r8,1.0016e-03_r8,7.9376e-04_r8, & + &5.6671e-04_r8,3.1943e-04_r8,1.7568e-04_r8/) + kao(:, 4,12, 1) = (/ & + &1.8192e-03_r8,1.8117e-03_r8,1.6422e-03_r8,1.4410e-03_r8,1.2151e-03_r8,9.6812e-04_r8, & + &6.9546e-04_r8,3.9137e-04_r8,2.1782e-04_r8/) + kao(:, 5,12, 1) = (/ & + &2.1766e-03_r8,2.1635e-03_r8,1.9700e-03_r8,1.7314e-03_r8,1.4651e-03_r8,1.1736e-03_r8, & + &8.4593e-04_r8,4.7032e-04_r8,2.5768e-04_r8/) + kao(:, 1,13, 1) = (/ & + &8.2069e-04_r8,8.2445e-04_r8,7.5154e-04_r8,6.6188e-04_r8,5.6185e-04_r8,4.5083e-04_r8, & + &3.2275e-04_r8,1.7851e-04_r8,9.1099e-05_r8/) + kao(:, 2,13, 1) = (/ & + &1.0473e-03_r8,1.0502e-03_r8,9.5966e-04_r8,8.4257e-04_r8,7.0741e-04_r8,5.6233e-04_r8, & + &4.0370e-04_r8,2.2679e-04_r8,1.2172e-04_r8/) + kao(:, 3,13, 1) = (/ & + &1.3133e-03_r8,1.3024e-03_r8,1.1846e-03_r8,1.0375e-03_r8,8.7436e-04_r8,6.9645e-04_r8, & + &5.0292e-04_r8,2.8463e-04_r8,1.5549e-04_r8/) + kao(:, 4,13, 1) = (/ & + &1.6064e-03_r8,1.5873e-03_r8,1.4461e-03_r8,1.2677e-03_r8,1.0715e-03_r8,8.5901e-04_r8, & + &6.1842e-04_r8,3.4781e-04_r8,1.9357e-04_r8/) + kao(:, 5,13, 1) = (/ & + &1.9305e-03_r8,1.9051e-03_r8,1.7364e-03_r8,1.5314e-03_r8,1.2972e-03_r8,1.0440e-03_r8, & + &7.5312e-04_r8,4.2210e-04_r8,2.3145e-04_r8/) + kao(:, 1, 1, 2) = (/ & + &8.1346e-06_r8,1.0615e-04_r8,1.6451e-04_r8,2.1843e-04_r8,2.7217e-04_r8,3.3271e-04_r8, & + &4.0424e-04_r8,5.2737e-04_r8,4.6457e-04_r8/) + kao(:, 2, 1, 2) = (/ & + &9.5357e-06_r8,1.2245e-04_r8,1.9203e-04_r8,2.5686e-04_r8,3.2147e-04_r8,3.9091e-04_r8, & + &4.7632e-04_r8,6.1736e-04_r8,5.3890e-04_r8/) + kao(:, 3, 1, 2) = (/ & + &1.0894e-05_r8,1.4027e-04_r8,2.2328e-04_r8,3.0098e-04_r8,3.7740e-04_r8,4.5873e-04_r8, & + &5.6256e-04_r8,7.2836e-04_r8,6.2820e-04_r8/) + kao(:, 4, 1, 2) = (/ & + &1.2218e-05_r8,1.6125e-04_r8,2.5837e-04_r8,3.4988e-04_r8,4.3991e-04_r8,5.3396e-04_r8, & + &6.5212e-04_r8,8.5783e-04_r8,7.3258e-04_r8/) + kao(:, 5, 1, 2) = (/ & + &1.3559e-05_r8,1.8418e-04_r8,2.9709e-04_r8,4.0563e-04_r8,5.0913e-04_r8,6.2018e-04_r8, & + &7.5464e-04_r8,9.9267e-04_r8,8.5248e-04_r8/) + kao(:, 1, 2, 2) = (/ & + &1.0648e-05_r8,1.0205e-04_r8,1.5218e-04_r8,1.9460e-04_r8,2.3469e-04_r8,2.7445e-04_r8, & + &3.2374e-04_r8,3.9687e-04_r8,3.7021e-04_r8/) + kao(:, 2, 2, 2) = (/ & + &1.2479e-05_r8,1.1864e-04_r8,1.7693e-04_r8,2.2906e-04_r8,2.7817e-04_r8,3.2635e-04_r8, & + &3.8100e-04_r8,4.6812e-04_r8,4.2972e-04_r8/) + kao(:, 3, 2, 2) = (/ & + &1.4325e-05_r8,1.3615e-04_r8,2.0613e-04_r8,2.6822e-04_r8,3.2742e-04_r8,3.8532e-04_r8, & + &4.4992e-04_r8,5.5581e-04_r8,5.0382e-04_r8/) + kao(:, 4, 2, 2) = (/ & + &1.6131e-05_r8,1.5522e-04_r8,2.3823e-04_r8,3.1216e-04_r8,3.8163e-04_r8,4.4987e-04_r8, & + &5.2423e-04_r8,6.5095e-04_r8,5.8901e-04_r8/) + kao(:, 5, 2, 2) = (/ & + &1.7840e-05_r8,1.7738e-04_r8,2.7413e-04_r8,3.6145e-04_r8,4.4307e-04_r8,5.2217e-04_r8, & + &6.0968e-04_r8,7.4929e-04_r8,6.8588e-04_r8/) + kao(:, 1, 3, 2) = (/ & + &1.7975e-05_r8,1.1236e-04_r8,1.5383e-04_r8,1.8734e-04_r8,2.1612e-04_r8,2.4014e-04_r8, & + &2.6058e-04_r8,2.9343e-04_r8,2.9752e-04_r8/) + kao(:, 2, 3, 2) = (/ & + &2.1208e-05_r8,1.3084e-04_r8,1.8013e-04_r8,2.2080e-04_r8,2.5543e-04_r8,2.8432e-04_r8, & + &3.1199e-04_r8,3.4846e-04_r8,3.5196e-04_r8/) + kao(:, 3, 3, 2) = (/ & + &2.4558e-05_r8,1.5021e-04_r8,2.0878e-04_r8,2.5693e-04_r8,2.9945e-04_r8,3.3619e-04_r8, & + &3.7048e-04_r8,4.1334e-04_r8,4.1350e-04_r8/) + kao(:, 4, 3, 2) = (/ & + &2.7720e-05_r8,1.7111e-04_r8,2.4012e-04_r8,2.9904e-04_r8,3.4910e-04_r8,3.9367e-04_r8, & + &4.3560e-04_r8,4.8351e-04_r8,4.8248e-04_r8/) + kao(:, 5, 3, 2) = (/ & + &3.0839e-05_r8,1.9412e-04_r8,2.7570e-04_r8,3.4584e-04_r8,4.0483e-04_r8,4.5917e-04_r8, & + &5.0628e-04_r8,5.6356e-04_r8,5.6016e-04_r8/) + kao(:, 1, 4, 2) = (/ & + &3.0257e-05_r8,1.3348e-04_r8,1.6797e-04_r8,1.9240e-04_r8,2.0954e-04_r8,2.2222e-04_r8, & + &2.2898e-04_r8,2.3143e-04_r8,2.5081e-04_r8/) + kao(:, 2, 4, 2) = (/ & + &3.6110e-05_r8,1.5427e-04_r8,1.9683e-04_r8,2.2498e-04_r8,2.4900e-04_r8,2.6495e-04_r8, & + &2.7383e-04_r8,2.7831e-04_r8,3.0130e-04_r8/) + kao(:, 3, 4, 2) = (/ & + &4.2020e-05_r8,1.7731e-04_r8,2.2733e-04_r8,2.6268e-04_r8,2.9200e-04_r8,3.1270e-04_r8, & + &3.2430e-04_r8,3.3243e-04_r8,3.4977e-04_r8/) + kao(:, 4, 4, 2) = (/ & + &4.7704e-05_r8,2.0254e-04_r8,2.6080e-04_r8,3.0470e-04_r8,3.4066e-04_r8,3.6571e-04_r8, & + &3.8177e-04_r8,3.9329e-04_r8,4.0928e-04_r8/) + kao(:, 5, 4, 2) = (/ & + &5.3448e-05_r8,2.2883e-04_r8,2.9767e-04_r8,3.4976e-04_r8,3.9269e-04_r8,4.2565e-04_r8, & + &4.4636e-04_r8,4.5989e-04_r8,4.7277e-04_r8/) + kao(:, 1, 5, 2) = (/ & + &4.6988e-05_r8,1.6787e-04_r8,1.9191e-04_r8,2.0648e-04_r8,2.1525e-04_r8,2.1596e-04_r8, & + &2.0906e-04_r8,1.9576e-04_r8,2.0610e-04_r8/) + kao(:, 2, 5, 2) = (/ & + &5.6510e-05_r8,1.9317e-04_r8,2.2448e-04_r8,2.4373e-04_r8,2.5210e-04_r8,2.5521e-04_r8, & + &2.5032e-04_r8,2.3737e-04_r8,2.5015e-04_r8/) + kao(:, 3, 5, 2) = (/ & + &6.6097e-05_r8,2.2111e-04_r8,2.5901e-04_r8,2.8182e-04_r8,2.9480e-04_r8,2.9992e-04_r8, & + &2.9852e-04_r8,2.8340e-04_r8,3.0111e-04_r8/) + kao(:, 4, 5, 2) = (/ & + &7.5373e-05_r8,2.5095e-04_r8,2.9694e-04_r8,3.2434e-04_r8,3.4231e-04_r8,3.5125e-04_r8, & + &3.5172e-04_r8,3.3625e-04_r8,3.5720e-04_r8/) + kao(:, 5, 5, 2) = (/ & + &8.4653e-05_r8,2.8271e-04_r8,3.3633e-04_r8,3.7103e-04_r8,3.9540e-04_r8,4.0854e-04_r8, & + &4.1017e-04_r8,3.9523e-04_r8,4.0911e-04_r8/) + kao(:, 1, 6, 2) = (/ & + &6.8194e-05_r8,2.1119e-04_r8,2.2511e-04_r8,2.2905e-04_r8,2.2761e-04_r8,2.1982e-04_r8, & + &2.0183e-04_r8,1.7113e-04_r8,1.7129e-04_r8/) + kao(:, 2, 6, 2) = (/ & + &8.3032e-05_r8,2.4138e-04_r8,2.6267e-04_r8,2.7055e-04_r8,2.6995e-04_r8,2.6005e-04_r8, & + &2.3793e-04_r8,2.0771e-04_r8,2.1052e-04_r8/) + kao(:, 3, 6, 2) = (/ & + &9.7316e-05_r8,2.7435e-04_r8,3.0334e-04_r8,3.1415e-04_r8,3.1605e-04_r8,3.0269e-04_r8, & + &2.8123e-04_r8,2.4990e-04_r8,2.5531e-04_r8/) + kao(:, 4, 6, 2) = (/ & + &1.1184e-04_r8,3.0984e-04_r8,3.4680e-04_r8,3.6228e-04_r8,3.6303e-04_r8,3.5165e-04_r8, & + &3.2989e-04_r8,2.9654e-04_r8,3.0715e-04_r8/) + kao(:, 5, 6, 2) = (/ & + &1.2632e-04_r8,3.4683e-04_r8,3.9318e-04_r8,4.1205e-04_r8,4.1568e-04_r8,4.0572e-04_r8, & + &3.8584e-04_r8,3.4794e-04_r8,3.6334e-04_r8/) + kao(:, 1, 7, 2) = (/ & + &1.0382e-04_r8,2.6395e-04_r8,2.8989e-04_r8,2.8076e-04_r8,2.6344e-04_r8,2.4071e-04_r8, & + &2.1106e-04_r8,1.6791e-04_r8,1.4516e-04_r8/) + kao(:, 2, 7, 2) = (/ & + &1.2713e-04_r8,3.0635e-04_r8,3.3550e-04_r8,3.2897e-04_r8,3.1196e-04_r8,2.8824e-04_r8, & + &2.5288e-04_r8,2.0031e-04_r8,1.8143e-04_r8/) + kao(:, 3, 7, 2) = (/ & + &1.5126e-04_r8,3.5047e-04_r8,3.8510e-04_r8,3.8068e-04_r8,3.6466e-04_r8,3.3889e-04_r8, & + &2.9600e-04_r8,2.3790e-04_r8,2.2323e-04_r8/) + kao(:, 4, 7, 2) = (/ & + &1.7453e-04_r8,3.9749e-04_r8,4.3569e-04_r8,4.3708e-04_r8,4.2166e-04_r8,3.9085e-04_r8, & + &3.4474e-04_r8,2.8074e-04_r8,2.7137e-04_r8/) + kao(:, 5, 7, 2) = (/ & + &1.9815e-04_r8,4.4700e-04_r8,4.9020e-04_r8,4.9608e-04_r8,4.8316e-04_r8,4.4845e-04_r8, & + &4.0007e-04_r8,3.2811e-04_r8,3.2529e-04_r8/) + kao(:, 1, 8, 2) = (/ & + &1.8568e-04_r8,3.7522e-04_r8,4.0441e-04_r8,4.0400e-04_r8,3.7101e-04_r8,3.2090e-04_r8, & + &2.6014e-04_r8,1.8741e-04_r8,1.4093e-04_r8/) + kao(:, 2, 8, 2) = (/ & + &2.2706e-04_r8,4.4100e-04_r8,4.7331e-04_r8,4.6941e-04_r8,4.3330e-04_r8,3.7933e-04_r8, & + &3.1116e-04_r8,2.2753e-04_r8,1.7550e-04_r8/) + kao(:, 3, 8, 2) = (/ & + &2.7313e-04_r8,5.0681e-04_r8,5.4665e-04_r8,5.4041e-04_r8,5.0328e-04_r8,4.4299e-04_r8, & + &3.6626e-04_r8,2.6706e-04_r8,2.1512e-04_r8/) + kao(:, 4, 8, 2) = (/ & + &3.2050e-04_r8,5.7784e-04_r8,6.2469e-04_r8,6.1766e-04_r8,5.7799e-04_r8,5.1310e-04_r8, & + &4.2712e-04_r8,3.1237e-04_r8,2.5864e-04_r8/) + kao(:, 5, 8, 2) = (/ & + &3.6492e-04_r8,6.4972e-04_r8,7.0632e-04_r8,6.9926e-04_r8,6.5563e-04_r8,5.8535e-04_r8, & + &4.8972e-04_r8,3.6487e-04_r8,3.1085e-04_r8/) + kao(:, 1, 9, 2) = (/ & + &6.2599e-04_r8,8.6654e-04_r8,9.0634e-04_r8,8.8937e-04_r8,8.1140e-04_r8,7.1027e-04_r8, & + &5.7167e-04_r8,3.5735e-04_r8,2.0982e-04_r8/) + kao(:, 2, 9, 2) = (/ & + &7.7627e-04_r8,1.0704e-03_r8,1.1043e-03_r8,1.0586e-03_r8,9.6032e-04_r8,8.3995e-04_r8, & + &6.6547e-04_r8,4.2636e-04_r8,2.5832e-04_r8/) + kao(:, 3, 9, 2) = (/ & + &9.3794e-04_r8,1.2619e-03_r8,1.2949e-03_r8,1.2284e-03_r8,1.1156e-03_r8,9.7182e-04_r8, & + &7.6979e-04_r8,5.0109e-04_r8,3.1973e-04_r8/) + kao(:, 4, 9, 2) = (/ & + &1.1114e-03_r8,1.4537e-03_r8,1.4722e-03_r8,1.4030e-03_r8,1.2802e-03_r8,1.1177e-03_r8, & + &8.8445e-04_r8,5.8120e-04_r8,3.8922e-04_r8/) + kao(:, 5, 9, 2) = (/ & + &1.2779e-03_r8,1.6415e-03_r8,1.6560e-03_r8,1.5834e-03_r8,1.4519e-03_r8,1.2713e-03_r8, & + &1.0105e-03_r8,6.6729e-04_r8,4.6624e-04_r8/) + kao(:, 1,10, 2) = (/ & + &2.4553e-03_r8,2.6165e-03_r8,2.4993e-03_r8,2.2847e-03_r8,2.0267e-03_r8,1.7115e-03_r8, & + &1.3397e-03_r8,8.6368e-04_r8,3.6576e-04_r8/) + kao(:, 2,10, 2) = (/ & + &3.0620e-03_r8,3.2511e-03_r8,3.1049e-03_r8,2.8553e-03_r8,2.5348e-03_r8,2.1265e-03_r8, & + &1.6314e-03_r8,1.0269e-03_r8,4.5803e-04_r8/) + kao(:, 3,10, 2) = (/ & + &3.7364e-03_r8,3.9627e-03_r8,3.7660e-03_r8,3.4224e-03_r8,3.0121e-03_r8,2.5166e-03_r8, & + &1.9135e-03_r8,1.1990e-03_r8,5.6685e-04_r8/) + kao(:, 4,10, 2) = (/ & + &4.4530e-03_r8,4.6554e-03_r8,4.3836e-03_r8,3.9682e-03_r8,3.4829e-03_r8,2.8809e-03_r8, & + &2.1972e-03_r8,1.3815e-03_r8,6.9188e-04_r8/) + kao(:, 5,10, 2) = (/ & + &5.1575e-03_r8,5.3264e-03_r8,4.9909e-03_r8,4.5087e-03_r8,3.9257e-03_r8,3.2602e-03_r8, & + &2.4888e-03_r8,1.5715e-03_r8,8.2270e-04_r8/) + kao(:, 1,11, 2) = (/ & + &3.7833e-03_r8,3.8112e-03_r8,3.5566e-03_r8,3.1989e-03_r8,2.7686e-03_r8,2.2723e-03_r8, & + &1.7364e-03_r8,1.0753e-03_r8,4.0590e-04_r8/) + kao(:, 2,11, 2) = (/ & + &4.6966e-03_r8,4.7207e-03_r8,4.4156e-03_r8,3.9736e-03_r8,3.4554e-03_r8,2.8577e-03_r8, & + &2.1338e-03_r8,1.2945e-03_r8,5.0517e-04_r8/) + kao(:, 3,11, 2) = (/ & + &5.7189e-03_r8,5.7590e-03_r8,5.3345e-03_r8,4.7708e-03_r8,4.1084e-03_r8,3.3729e-03_r8, & + &2.5008e-03_r8,1.5078e-03_r8,6.3337e-04_r8/) + kao(:, 4,11, 2) = (/ & + &6.7827e-03_r8,6.7469e-03_r8,6.2278e-03_r8,5.5367e-03_r8,4.7380e-03_r8,3.8594e-03_r8, & + &2.8648e-03_r8,1.7294e-03_r8,7.7415e-04_r8/) + kao(:, 5,11, 2) = (/ & + &7.8200e-03_r8,7.7382e-03_r8,7.0901e-03_r8,6.2644e-03_r8,5.3533e-03_r8,4.3510e-03_r8, & + &3.2356e-03_r8,1.9722e-03_r8,9.3312e-04_r8/) + kao(:, 1,12, 2) = (/ & + &4.2783e-03_r8,4.2041e-03_r8,3.8742e-03_r8,3.4634e-03_r8,2.9720e-03_r8,2.4393e-03_r8, & + &1.8351e-03_r8,1.1175e-03_r8,3.9253e-04_r8/) + kao(:, 2,12, 2) = (/ & + &5.3337e-03_r8,5.2652e-03_r8,4.8301e-03_r8,4.3189e-03_r8,3.7223e-03_r8,3.0228e-03_r8, & + &2.2408e-03_r8,1.3443e-03_r8,4.8795e-04_r8/) + kao(:, 3,12, 2) = (/ & + &6.5143e-03_r8,6.3579e-03_r8,5.8237e-03_r8,5.1812e-03_r8,4.4118e-03_r8,3.5721e-03_r8, & + &2.6281e-03_r8,1.5684e-03_r8,6.0394e-04_r8/) + kao(:, 4,12, 2) = (/ & + &7.6468e-03_r8,7.4276e-03_r8,6.7625e-03_r8,6.0120e-03_r8,5.0805e-03_r8,4.0892e-03_r8, & + &3.0024e-03_r8,1.8032e-03_r8,7.4856e-04_r8/) + kao(:, 5,12, 2) = (/ & + &8.7322e-03_r8,8.4845e-03_r8,7.6878e-03_r8,6.7875e-03_r8,5.7064e-03_r8,4.6095e-03_r8, & + &3.4027e-03_r8,2.0497e-03_r8,9.3030e-04_r8/) + kao(:, 1,13, 2) = (/ & + &3.8383e-03_r8,3.7685e-03_r8,3.4781e-03_r8,3.1000e-03_r8,2.6661e-03_r8,2.1777e-03_r8, & + &1.6207e-03_r8,9.7395e-04_r8,3.4434e-04_r8/) + kao(:, 2,13, 2) = (/ & + &4.7991e-03_r8,4.7287e-03_r8,4.3604e-03_r8,3.8801e-03_r8,3.3054e-03_r8,2.6658e-03_r8, & + &1.9755e-03_r8,1.1692e-03_r8,4.3018e-04_r8/) + kao(:, 3,13, 2) = (/ & + &5.8240e-03_r8,5.6632e-03_r8,5.1895e-03_r8,4.6114e-03_r8,3.9052e-03_r8,3.1338e-03_r8, & + &2.3066e-03_r8,1.3724e-03_r8,5.3490e-04_r8/) + kao(:, 4,13, 2) = (/ & + &6.7942e-03_r8,6.6067e-03_r8,6.0062e-03_r8,5.2927e-03_r8,4.4607e-03_r8,3.5870e-03_r8, & + &2.6413e-03_r8,1.5766e-03_r8,6.6330e-04_r8/) + kao(:, 5,13, 2) = (/ & + &7.7135e-03_r8,7.4856e-03_r8,6.7623e-03_r8,5.9543e-03_r8,5.0216e-03_r8,4.0477e-03_r8, & + &2.9856e-03_r8,1.7918e-03_r8,8.1116e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &2.4793e-05_r8,3.0799e-04_r8,4.6290e-04_r8,5.9325e-04_r8,7.1737e-04_r8,8.2193e-04_r8, & + &9.4048e-04_r8,1.1399e-03_r8,1.0252e-03_r8/) + kao(:, 2, 1, 3) = (/ & + &2.6296e-05_r8,3.5350e-04_r8,5.3963e-04_r8,6.9573e-04_r8,8.4910e-04_r8,9.9005e-04_r8, & + &1.1353e-03_r8,1.3914e-03_r8,1.2872e-03_r8/) + kao(:, 3, 1, 3) = (/ & + &2.7819e-05_r8,4.0345e-04_r8,6.2337e-04_r8,8.1130e-04_r8,9.9260e-04_r8,1.1727e-03_r8, & + &1.3740e-03_r8,1.6958e-03_r8,1.5768e-03_r8/) + kao(:, 4, 1, 3) = (/ & + &2.9505e-05_r8,4.5829e-04_r8,7.1308e-04_r8,9.3786e-04_r8,1.1508e-03_r8,1.3827e-03_r8, & + &1.6466e-03_r8,2.0604e-03_r8,1.9074e-03_r8/) + kao(:, 5, 1, 3) = (/ & + &3.1281e-05_r8,5.1795e-04_r8,8.1473e-04_r8,1.0770e-03_r8,1.3366e-03_r8,1.6108e-03_r8, & + &1.9547e-03_r8,2.4904e-03_r8,2.2803e-03_r8/) + kao(:, 1, 2, 3) = (/ & + &3.2793e-05_r8,3.0694e-04_r8,4.5221e-04_r8,5.6459e-04_r8,6.5806e-04_r8,7.4456e-04_r8, & + &8.0925e-04_r8,9.1019e-04_r8,8.6945e-04_r8/) + kao(:, 2, 2, 3) = (/ & + &3.4666e-05_r8,3.5123e-04_r8,5.2466e-04_r8,6.5968e-04_r8,7.7040e-04_r8,8.8249e-04_r8, & + &9.7906e-04_r8,1.1056e-03_r8,1.0654e-03_r8/) + kao(:, 3, 2, 3) = (/ & + &3.6731e-05_r8,4.0004e-04_r8,6.0292e-04_r8,7.6491e-04_r8,9.0091e-04_r8,1.0289e-03_r8, & + &1.1668e-03_r8,1.3438e-03_r8,1.2804e-03_r8/) + kao(:, 4, 2, 3) = (/ & + &3.8918e-05_r8,4.5420e-04_r8,6.8900e-04_r8,8.8273e-04_r8,1.0463e-03_r8,1.2043e-03_r8, & + &1.3845e-03_r8,1.6322e-03_r8,1.5338e-03_r8/) + kao(:, 5, 2, 3) = (/ & + &4.1070e-05_r8,5.1139e-04_r8,7.8412e-04_r8,1.0082e-03_r8,1.2070e-03_r8,1.4003e-03_r8, & + &1.6106e-03_r8,1.9566e-03_r8,1.8338e-03_r8/) + kao(:, 1, 3, 3) = (/ & + &5.7419e-05_r8,3.4417e-04_r8,4.7657e-04_r8,5.8011e-04_r8,6.5776e-04_r8,7.1017e-04_r8, & + &7.4352e-04_r8,7.5165e-04_r8,7.1905e-04_r8/) + kao(:, 2, 3, 3) = (/ & + &6.1098e-05_r8,3.8894e-04_r8,5.5050e-04_r8,6.7283e-04_r8,7.6814e-04_r8,8.3562e-04_r8, & + &8.7563e-04_r8,9.0812e-04_r8,8.7884e-04_r8/) + kao(:, 3, 3, 3) = (/ & + &6.4950e-05_r8,4.3994e-04_r8,6.3159e-04_r8,7.7584e-04_r8,8.9433e-04_r8,9.7562e-04_r8, & + &1.0278e-03_r8,1.0860e-03_r8,1.0655e-03_r8/) + kao(:, 4, 3, 3) = (/ & + &6.9137e-05_r8,4.9606e-04_r8,7.1905e-04_r8,8.8979e-04_r8,1.0295e-03_r8,1.1315e-03_r8, & + &1.2033e-03_r8,1.2952e-03_r8,1.2839e-03_r8/) + kao(:, 5, 3, 3) = (/ & + &7.3375e-05_r8,5.5536e-04_r8,8.1436e-04_r8,1.0155e-03_r8,1.1795e-03_r8,1.3051e-03_r8, & + &1.4046e-03_r8,1.5168e-03_r8,1.5296e-03_r8/) + kao(:, 1, 4, 3) = (/ & + &1.0086e-04_r8,4.2454e-04_r8,5.2985e-04_r8,6.0848e-04_r8,6.7121e-04_r8,7.0723e-04_r8, & + &7.1237e-04_r8,6.8193e-04_r8,6.1640e-04_r8/) + kao(:, 2, 4, 3) = (/ & + &1.0794e-04_r8,4.6886e-04_r8,6.0099e-04_r8,7.0397e-04_r8,7.8290e-04_r8,8.2924e-04_r8, & + &8.4042e-04_r8,8.0656e-04_r8,7.3923e-04_r8/) + kao(:, 3, 4, 3) = (/ & + &1.1564e-04_r8,5.1937e-04_r8,6.8316e-04_r8,8.0764e-04_r8,9.0488e-04_r8,9.5975e-04_r8, & + &9.8680e-04_r8,9.5115e-04_r8,8.9690e-04_r8/) + kao(:, 4, 4, 3) = (/ & + &1.2339e-04_r8,5.7610e-04_r8,7.7301e-04_r8,9.2354e-04_r8,1.0350e-03_r8,1.1092e-03_r8, & + &1.1493e-03_r8,1.1169e-03_r8,1.0760e-03_r8/) + kao(:, 5, 4, 3) = (/ & + &1.3105e-04_r8,6.3905e-04_r8,8.6996e-04_r8,1.0475e-03_r8,1.1809e-03_r8,1.2763e-03_r8, & + &1.3289e-03_r8,1.3078e-03_r8,1.2869e-03_r8/) + kao(:, 1, 5, 3) = (/ & + &1.6100e-04_r8,5.0634e-04_r8,6.1668e-04_r8,6.6467e-04_r8,6.8745e-04_r8,6.9758e-04_r8, & + &6.8538e-04_r8,6.2098e-04_r8,6.1721e-04_r8/) + kao(:, 2, 5, 3) = (/ & + &1.7365e-04_r8,5.5505e-04_r8,6.8253e-04_r8,7.5603e-04_r8,7.9631e-04_r8,8.1600e-04_r8, & + &8.0888e-04_r8,7.3807e-04_r8,7.1431e-04_r8/) + kao(:, 3, 5, 3) = (/ & + &1.8648e-04_r8,6.0992e-04_r8,7.6141e-04_r8,8.5901e-04_r8,9.1428e-04_r8,9.4703e-04_r8, & + &9.4315e-04_r8,8.7432e-04_r8,8.2918e-04_r8/) + kao(:, 4, 5, 3) = (/ & + &1.9988e-04_r8,6.7074e-04_r8,8.4873e-04_r8,9.7496e-04_r8,1.0437e-03_r8,1.0922e-03_r8, & + &1.0916e-03_r8,1.0269e-03_r8,9.7489e-04_r8/) + kao(:, 5, 5, 3) = (/ & + &2.1403e-04_r8,7.3152e-04_r8,9.4776e-04_r8,1.0959e-03_r8,1.1876e-03_r8,1.2477e-03_r8, & + &1.2592e-03_r8,1.1994e-03_r8,1.1556e-03_r8/) + kao(:, 1, 6, 3) = (/ & + &2.3782e-04_r8,5.8473e-04_r8,7.0057e-04_r8,7.3727e-04_r8,7.3866e-04_r8,7.0622e-04_r8, & + &6.5578e-04_r8,5.7152e-04_r8,6.4834e-04_r8/) + kao(:, 2, 6, 3) = (/ & + &2.5744e-04_r8,6.5190e-04_r8,7.6744e-04_r8,8.2296e-04_r8,8.3569e-04_r8,8.1871e-04_r8, & + &7.7021e-04_r8,6.8232e-04_r8,7.1639e-04_r8/) + kao(:, 3, 6, 3) = (/ & + &2.7664e-04_r8,7.1488e-04_r8,8.5237e-04_r8,9.1762e-04_r8,9.4622e-04_r8,9.4392e-04_r8, & + &8.9795e-04_r8,8.0363e-04_r8,8.0674e-04_r8/) + kao(:, 4, 6, 3) = (/ & + &2.9757e-04_r8,7.7689e-04_r8,9.3669e-04_r8,1.0212e-03_r8,1.0750e-03_r8,1.0793e-03_r8, & + &1.0394e-03_r8,9.3920e-04_r8,9.2478e-04_r8/) + kao(:, 5, 6, 3) = (/ & + &3.2013e-04_r8,8.4833e-04_r8,1.0249e-03_r8,1.1443e-03_r8,1.2150e-03_r8,1.2313e-03_r8, & + &1.1962e-03_r8,1.0926e-03_r8,1.0558e-03_r8/) + kao(:, 1, 7, 3) = (/ & + &3.7226e-04_r8,7.2122e-04_r8,8.2273e-04_r8,8.7424e-04_r8,8.4905e-04_r8,7.9504e-04_r8, & + &6.8600e-04_r8,5.4748e-04_r8,6.4757e-04_r8/) + kao(:, 2, 7, 3) = (/ & + &4.0471e-04_r8,8.0580e-04_r8,9.2241e-04_r8,9.6290e-04_r8,9.4856e-04_r8,8.9436e-04_r8, & + &7.9088e-04_r8,6.5024e-04_r8,7.6906e-04_r8/) + kao(:, 3, 7, 3) = (/ & + &4.3485e-04_r8,8.8728e-04_r8,1.0201e-03_r8,1.0664e-03_r8,1.0598e-03_r8,1.0046e-03_r8, & + &9.1434e-04_r8,7.6471e-04_r8,8.8345e-04_r8/) + kao(:, 4, 7, 3) = (/ & + &4.6779e-04_r8,9.6940e-04_r8,1.1214e-03_r8,1.1802e-03_r8,1.1771e-03_r8,1.1317e-03_r8, & + &1.0506e-03_r8,8.9487e-04_r8,9.7870e-04_r8/) + kao(:, 5, 7, 3) = (/ & + &5.0564e-04_r8,1.0493e-03_r8,1.2285e-03_r8,1.2989e-03_r8,1.3103e-03_r8,1.2822e-03_r8, & + &1.2004e-03_r8,1.0399e-03_r8,1.0827e-03_r8/) + kao(:, 1, 8, 3) = (/ & + &6.8834e-04_r8,1.0497e-03_r8,1.1354e-03_r8,1.1403e-03_r8,1.1091e-03_r8,1.0282e-03_r8, & + &8.6922e-04_r8,6.2179e-04_r8,6.4394e-04_r8/) + kao(:, 2, 8, 3) = (/ & + &7.5262e-04_r8,1.1719e-03_r8,1.2711e-03_r8,1.2847e-03_r8,1.2498e-03_r8,1.1356e-03_r8, & + &9.7177e-04_r8,7.1700e-04_r8,7.5449e-04_r8/) + kao(:, 3, 8, 3) = (/ & + &8.1196e-04_r8,1.2925e-03_r8,1.4075e-03_r8,1.4221e-03_r8,1.3886e-03_r8,1.2652e-03_r8, & + &1.0898e-03_r8,8.2946e-04_r8,8.8164e-04_r8/) + kao(:, 4, 8, 3) = (/ & + &8.7357e-04_r8,1.4119e-03_r8,1.5462e-03_r8,1.5662e-03_r8,1.5234e-03_r8,1.4066e-03_r8, & + &1.2187e-03_r8,9.5583e-04_r8,1.0263e-03_r8/) + kao(:, 5, 8, 3) = (/ & + &9.4776e-04_r8,1.5351e-03_r8,1.6779e-03_r8,1.7191e-03_r8,1.6760e-03_r8,1.5541e-03_r8, & + &1.3711e-03_r8,1.0942e-03_r8,1.1866e-03_r8/) + kao(:, 1, 9, 3) = (/ & + &2.4030e-03_r8,2.8116e-03_r8,2.7490e-03_r8,2.5782e-03_r8,2.3739e-03_r8,2.0451e-03_r8, & + &1.6352e-03_r8,1.1525e-03_r8,7.8397e-04_r8/) + kao(:, 2, 9, 3) = (/ & + &2.6406e-03_r8,3.0780e-03_r8,3.0311e-03_r8,2.8880e-03_r8,2.6562e-03_r8,2.3012e-03_r8, & + &1.8579e-03_r8,1.2942e-03_r8,9.5305e-04_r8/) + kao(:, 3, 9, 3) = (/ & + &2.8588e-03_r8,3.3826e-03_r8,3.3331e-03_r8,3.2003e-03_r8,2.9491e-03_r8,2.5645e-03_r8, & + &2.0822e-03_r8,1.4320e-03_r8,1.1371e-03_r8/) + kao(:, 4, 9, 3) = (/ & + &3.0751e-03_r8,3.6837e-03_r8,3.6521e-03_r8,3.5172e-03_r8,3.2330e-03_r8,2.8266e-03_r8, & + &2.3022e-03_r8,1.5958e-03_r8,1.3270e-03_r8/) + kao(:, 5, 9, 3) = (/ & + &3.3401e-03_r8,4.0139e-03_r8,3.9712e-03_r8,3.8387e-03_r8,3.5273e-03_r8,3.0908e-03_r8, & + &2.5332e-03_r8,1.7734e-03_r8,1.5421e-03_r8/) + kao(:, 1,10, 3) = (/ & + &9.4661e-03_r8,9.3672e-03_r8,8.6815e-03_r8,7.7670e-03_r8,6.6533e-03_r8,5.4267e-03_r8, & + &4.0804e-03_r8,2.5558e-03_r8,1.0683e-03_r8/) + kao(:, 2,10, 3) = (/ & + &1.0403e-02_r8,1.0310e-02_r8,9.5215e-03_r8,8.5122e-03_r8,7.3124e-03_r8,5.9813e-03_r8, & + &4.5509e-03_r8,2.8739e-03_r8,1.2946e-03_r8/) + kao(:, 3,10, 3) = (/ & + &1.1289e-02_r8,1.1218e-02_r8,1.0349e-02_r8,9.3127e-03_r8,8.0182e-03_r8,6.6138e-03_r8, & + &5.0551e-03_r8,3.2072e-03_r8,1.5622e-03_r8/) + kao(:, 4,10, 3) = (/ & + &1.2130e-02_r8,1.2221e-02_r8,1.1320e-02_r8,1.0189e-02_r8,8.7979e-03_r8,7.2832e-03_r8, & + &5.5873e-03_r8,3.5427e-03_r8,1.8389e-03_r8/) + kao(:, 5,10, 3) = (/ & + &1.3100e-02_r8,1.3300e-02_r8,1.2340e-02_r8,1.1131e-02_r8,9.6189e-03_r8,7.9428e-03_r8, & + &6.1291e-03_r8,3.8793e-03_r8,2.1440e-03_r8/) + kao(:, 1,11, 3) = (/ & + &1.3487e-02_r8,1.2984e-02_r8,1.1782e-02_r8,1.0398e-02_r8,8.8336e-03_r8,7.1334e-03_r8, & + &5.2262e-03_r8,3.1590e-03_r8,1.1845e-03_r8/) + kao(:, 2,11, 3) = (/ & + &1.4804e-02_r8,1.4185e-02_r8,1.2823e-02_r8,1.1346e-02_r8,9.6530e-03_r8,7.7631e-03_r8, & + &5.7673e-03_r8,3.5383e-03_r8,1.4275e-03_r8/) + kao(:, 3,11, 3) = (/ & + &1.5980e-02_r8,1.5367e-02_r8,1.3971e-02_r8,1.2366e-02_r8,1.0542e-02_r8,8.5565e-03_r8, & + &6.3780e-03_r8,3.9351e-03_r8,1.7235e-03_r8/) + kao(:, 4,11, 3) = (/ & + &1.7219e-02_r8,1.6745e-02_r8,1.5253e-02_r8,1.3475e-02_r8,1.1557e-02_r8,9.4243e-03_r8, & + &6.9880e-03_r8,4.3338e-03_r8,2.0121e-03_r8/) + kao(:, 5,11, 3) = (/ & + &1.8659e-02_r8,1.8178e-02_r8,1.6582e-02_r8,1.4739e-02_r8,1.2667e-02_r8,1.0254e-02_r8, & + &7.6524e-03_r8,4.7481e-03_r8,2.3669e-03_r8/) + kao(:, 1,12, 3) = (/ & + &1.4430e-02_r8,1.3711e-02_r8,1.2344e-02_r8,1.0793e-02_r8,9.1312e-03_r8,7.2788e-03_r8, & + &5.2885e-03_r8,3.1556e-03_r8,1.1392e-03_r8/) + kao(:, 2,12, 3) = (/ & + &1.5757e-02_r8,1.4929e-02_r8,1.3431e-02_r8,1.1729e-02_r8,9.9240e-03_r8,7.9738e-03_r8, & + &5.8467e-03_r8,3.5123e-03_r8,1.3911e-03_r8/) + kao(:, 3,12, 3) = (/ & + &1.6948e-02_r8,1.6169e-02_r8,1.4634e-02_r8,1.2830e-02_r8,1.0856e-02_r8,8.7512e-03_r8, & + &6.4418e-03_r8,3.8765e-03_r8,1.6585e-03_r8/) + kao(:, 4,12, 3) = (/ & + &1.8340e-02_r8,1.7651e-02_r8,1.6013e-02_r8,1.4019e-02_r8,1.1962e-02_r8,9.6662e-03_r8, & + &7.0623e-03_r8,4.2621e-03_r8,1.9806e-03_r8/) + kao(:, 5,12, 3) = (/ & + &1.9917e-02_r8,1.9194e-02_r8,1.7450e-02_r8,1.5375e-02_r8,1.3136e-02_r8,1.0559e-02_r8, & + &7.7061e-03_r8,4.6735e-03_r8,2.2886e-03_r8/) + kao(:, 1,13, 3) = (/ & + &1.2378e-02_r8,1.1740e-02_r8,1.0520e-02_r8,9.1794e-03_r8,7.7313e-03_r8,6.1547e-03_r8, & + &4.4837e-03_r8,2.6655e-03_r8,9.8041e-04_r8/) + kao(:, 2,13, 3) = (/ & + &1.3400e-02_r8,1.2704e-02_r8,1.1442e-02_r8,9.9607e-03_r8,8.4166e-03_r8,6.7824e-03_r8, & + &4.9464e-03_r8,2.9635e-03_r8,1.2027e-03_r8/) + kao(:, 3,13, 3) = (/ & + &1.4376e-02_r8,1.3828e-02_r8,1.2497e-02_r8,1.0944e-02_r8,9.2894e-03_r8,7.4859e-03_r8, & + &5.4627e-03_r8,3.2639e-03_r8,1.4455e-03_r8/) + kao(:, 4,13, 3) = (/ & + &1.5663e-02_r8,1.5087e-02_r8,1.3675e-02_r8,1.2023e-02_r8,1.0248e-02_r8,8.2522e-03_r8, & + &5.9994e-03_r8,3.5980e-03_r8,1.7132e-03_r8/) + kao(:, 5,13, 3) = (/ & + &1.7084e-02_r8,1.6538e-02_r8,1.5027e-02_r8,1.3180e-02_r8,1.1220e-02_r8,9.0513e-03_r8, & + &6.5567e-03_r8,3.9396e-03_r8,2.0154e-03_r8/) + kao(:, 1, 1, 4) = (/ & + &4.5432e-05_r8,6.4085e-04_r8,1.0470e-03_r8,1.4404e-03_r8,1.8333e-03_r8,2.2857e-03_r8, & + &2.8540e-03_r8,3.7474e-03_r8,3.3078e-03_r8/) + kao(:, 2, 1, 4) = (/ & + &4.6775e-05_r8,7.3260e-04_r8,1.2196e-03_r8,1.6906e-03_r8,2.1700e-03_r8,2.7279e-03_r8, & + &3.3928e-03_r8,4.5435e-03_r8,4.0031e-03_r8/) + kao(:, 3, 1, 4) = (/ & + &4.7907e-05_r8,8.4030e-04_r8,1.4168e-03_r8,1.9771e-03_r8,2.5623e-03_r8,3.2199e-03_r8, & + &4.0380e-03_r8,5.3656e-03_r8,4.7474e-03_r8/) + kao(:, 4, 1, 4) = (/ & + &4.8733e-05_r8,9.6171e-04_r8,1.6416e-03_r8,2.3126e-03_r8,3.0275e-03_r8,3.7946e-03_r8, & + &4.7571e-03_r8,6.3684e-03_r8,5.6396e-03_r8/) + kao(:, 5, 1, 4) = (/ & + &4.9568e-05_r8,1.0960e-03_r8,1.8926e-03_r8,2.6893e-03_r8,3.5365e-03_r8,4.4677e-03_r8, & + &5.5986e-03_r8,7.4848e-03_r8,6.6760e-03_r8/) + kao(:, 1, 2, 4) = (/ & + &5.9644e-05_r8,6.5165e-04_r8,9.7095e-04_r8,1.2735e-03_r8,1.5693e-03_r8,1.8723e-03_r8, & + &2.2435e-03_r8,2.8303e-03_r8,2.5518e-03_r8/) + kao(:, 2, 2, 4) = (/ & + &6.1550e-05_r8,7.3433e-04_r8,1.1155e-03_r8,1.4862e-03_r8,1.8480e-03_r8,2.2144e-03_r8, & + &2.6782e-03_r8,3.3851e-03_r8,3.1028e-03_r8/) + kao(:, 3, 2, 4) = (/ & + &6.3424e-05_r8,8.2814e-04_r8,1.2862e-03_r8,1.7299e-03_r8,2.1667e-03_r8,2.6220e-03_r8, & + &3.1654e-03_r8,4.0290e-03_r8,3.7219e-03_r8/) + kao(:, 4, 2, 4) = (/ & + &6.4618e-05_r8,9.2770e-04_r8,1.4812e-03_r8,2.0000e-03_r8,2.5281e-03_r8,3.0889e-03_r8, & + &3.7301e-03_r8,4.7467e-03_r8,4.4551e-03_r8/) + kao(:, 5, 2, 4) = (/ & + &6.6495e-05_r8,1.0413e-03_r8,1.6912e-03_r8,2.3096e-03_r8,2.9324e-03_r8,3.6063e-03_r8, & + &4.3915e-03_r8,5.5831e-03_r8,5.2779e-03_r8/) + kao(:, 1, 3, 4) = (/ & + &1.0462e-04_r8,7.2939e-04_r8,1.0510e-03_r8,1.2708e-03_r8,1.4590e-03_r8,1.6268e-03_r8, & + &1.8071e-03_r8,2.0571e-03_r8,1.9983e-03_r8/) + kao(:, 2, 3, 4) = (/ & + &1.0853e-04_r8,8.1591e-04_r8,1.1915e-03_r8,1.4605e-03_r8,1.6878e-03_r8,1.9079e-03_r8, & + &2.1403e-03_r8,2.4652e-03_r8,2.3859e-03_r8/) + kao(:, 3, 3, 4) = (/ & + &1.1161e-04_r8,9.0807e-04_r8,1.3452e-03_r8,1.6696e-03_r8,1.9436e-03_r8,2.2298e-03_r8, & + &2.5245e-03_r8,2.9256e-03_r8,2.8236e-03_r8/) + kao(:, 4, 3, 4) = (/ & + &1.1463e-04_r8,1.0096e-03_r8,1.5126e-03_r8,1.9029e-03_r8,2.2460e-03_r8,2.5957e-03_r8, & + &2.9637e-03_r8,3.4539e-03_r8,3.3286e-03_r8/) + kao(:, 5, 3, 4) = (/ & + &1.1771e-04_r8,1.1227e-03_r8,1.6998e-03_r8,2.1624e-03_r8,2.5867e-03_r8,3.0031e-03_r8, & + &3.4507e-03_r8,4.0691e-03_r8,3.9216e-03_r8/) + kao(:, 1, 4, 4) = (/ & + &1.8980e-04_r8,8.1690e-04_r8,1.1496e-03_r8,1.3743e-03_r8,1.5174e-03_r8,1.5997e-03_r8, & + &1.6364e-03_r8,1.6486e-03_r8,1.6867e-03_r8/) + kao(:, 2, 4, 4) = (/ & + &1.9681e-04_r8,9.1682e-04_r8,1.2947e-03_r8,1.5538e-03_r8,1.7351e-03_r8,1.8526e-03_r8, & + &1.9065e-03_r8,1.9583e-03_r8,2.0215e-03_r8/) + kao(:, 3, 4, 4) = (/ & + &2.0208e-04_r8,1.0146e-03_r8,1.4514e-03_r8,1.7516e-03_r8,1.9841e-03_r8,2.1383e-03_r8, & + &2.2138e-03_r8,2.3082e-03_r8,2.3998e-03_r8/) + kao(:, 4, 4, 4) = (/ & + &2.0762e-04_r8,1.1226e-03_r8,1.6211e-03_r8,1.9728e-03_r8,2.2623e-03_r8,2.4506e-03_r8, & + &2.5563e-03_r8,2.7166e-03_r8,2.8343e-03_r8/) + kao(:, 5, 4, 4) = (/ & + &2.1385e-04_r8,1.2397e-03_r8,1.8026e-03_r8,2.2223e-03_r8,2.5659e-03_r8,2.7894e-03_r8, & + &2.9545e-03_r8,3.1771e-03_r8,3.3076e-03_r8/) + kao(:, 1, 5, 4) = (/ & + &3.1379e-04_r8,9.3426e-04_r8,1.2166e-03_r8,1.4285e-03_r8,1.5654e-03_r8,1.6404e-03_r8, & + &1.5965e-03_r8,1.4828e-03_r8,1.3604e-03_r8/) + kao(:, 2, 5, 4) = (/ & + &3.2699e-04_r8,1.0358e-03_r8,1.3783e-03_r8,1.6163e-03_r8,1.7786e-03_r8,1.8763e-03_r8, & + &1.8530e-03_r8,1.7399e-03_r8,1.6555e-03_r8/) + kao(:, 3, 5, 4) = (/ & + &3.3749e-04_r8,1.1387e-03_r8,1.5374e-03_r8,1.8184e-03_r8,2.0178e-03_r8,2.1215e-03_r8, & + &2.1453e-03_r8,2.0239e-03_r8,1.9794e-03_r8/) + kao(:, 4, 5, 4) = (/ & + &3.4807e-04_r8,1.2529e-03_r8,1.7131e-03_r8,2.0397e-03_r8,2.2808e-03_r8,2.4051e-03_r8, & + &2.4718e-03_r8,2.3502e-03_r8,2.3300e-03_r8/) + kao(:, 5, 5, 4) = (/ & + &3.5954e-04_r8,1.3777e-03_r8,1.8982e-03_r8,2.2796e-03_r8,2.5586e-03_r8,2.7323e-03_r8, & + &2.8236e-03_r8,2.7161e-03_r8,2.7237e-03_r8/) + kao(:, 1, 6, 4) = (/ & + &4.7800e-04_r8,1.0890e-03_r8,1.3133e-03_r8,1.4652e-03_r8,1.5696e-03_r8,1.6077e-03_r8, & + &1.5816e-03_r8,1.3782e-03_r8,1.1543e-03_r8/) + kao(:, 2, 6, 4) = (/ & + &5.0135e-04_r8,1.1692e-03_r8,1.4789e-03_r8,1.6725e-03_r8,1.7871e-03_r8,1.8348e-03_r8, & + &1.8106e-03_r8,1.6080e-03_r8,1.4185e-03_r8/) + kao(:, 3, 6, 4) = (/ & + &5.2250e-04_r8,1.2684e-03_r8,1.6447e-03_r8,1.8893e-03_r8,2.0173e-03_r8,2.0845e-03_r8, & + &2.0641e-03_r8,1.8764e-03_r8,1.6970e-03_r8/) + kao(:, 4, 6, 4) = (/ & + &5.4010e-04_r8,1.3890e-03_r8,1.8350e-03_r8,2.1143e-03_r8,2.2731e-03_r8,2.3591e-03_r8, & + &2.3476e-03_r8,2.1762e-03_r8,2.0061e-03_r8/) + kao(:, 5, 6, 4) = (/ & + &5.6086e-04_r8,1.5152e-03_r8,2.0323e-03_r8,2.3522e-03_r8,2.5434e-03_r8,2.6585e-03_r8, & + &2.6646e-03_r8,2.5043e-03_r8,2.3580e-03_r8/) + kao(:, 1, 7, 4) = (/ & + &7.6472e-04_r8,1.4103e-03_r8,1.5811e-03_r8,1.6521e-03_r8,1.6700e-03_r8,1.6355e-03_r8, & + &1.5716e-03_r8,1.3655e-03_r8,1.1953e-03_r8/) + kao(:, 2, 7, 4) = (/ & + &8.0405e-04_r8,1.4820e-03_r8,1.7182e-03_r8,1.8432e-03_r8,1.9040e-03_r8,1.8839e-03_r8, & + &1.8004e-03_r8,1.5836e-03_r8,1.3245e-03_r8/) + kao(:, 3, 7, 4) = (/ & + &8.3976e-04_r8,1.5925e-03_r8,1.8706e-03_r8,2.0547e-03_r8,2.1511e-03_r8,2.1580e-03_r8, & + &2.0497e-03_r8,1.8151e-03_r8,1.5136e-03_r8/) + kao(:, 4, 7, 4) = (/ & + &8.7606e-04_r8,1.7044e-03_r8,2.0552e-03_r8,2.2845e-03_r8,2.4212e-03_r8,2.4433e-03_r8, & + &2.3312e-03_r8,2.0671e-03_r8,1.7685e-03_r8/) + kao(:, 5, 7, 4) = (/ & + &9.1065e-04_r8,1.8368e-03_r8,2.2563e-03_r8,2.5472e-03_r8,2.7054e-03_r8,2.7384e-03_r8, & + &2.6284e-03_r8,2.3513e-03_r8,2.0612e-03_r8/) + kao(:, 1, 8, 4) = (/ & + &1.4362e-03_r8,2.1402e-03_r8,2.2733e-03_r8,2.2579e-03_r8,2.1547e-03_r8,1.9686e-03_r8, & + &1.7196e-03_r8,1.4177e-03_r8,1.4603e-03_r8/) + kao(:, 2, 8, 4) = (/ & + &1.5196e-03_r8,2.2635e-03_r8,2.4111e-03_r8,2.4495e-03_r8,2.3642e-03_r8,2.2258e-03_r8, & + &1.9891e-03_r8,1.6444e-03_r8,1.7173e-03_r8/) + kao(:, 3, 8, 4) = (/ & + &1.5863e-03_r8,2.3882e-03_r8,2.5869e-03_r8,2.6588e-03_r8,2.5952e-03_r8,2.5025e-03_r8, & + &2.2780e-03_r8,1.8819e-03_r8,1.8908e-03_r8/) + kao(:, 4, 8, 4) = (/ & + &1.6588e-03_r8,2.5177e-03_r8,2.7792e-03_r8,2.8954e-03_r8,2.8908e-03_r8,2.7990e-03_r8, & + &2.5915e-03_r8,2.1558e-03_r8,2.0333e-03_r8/) + kao(:, 5, 8, 4) = (/ & + &1.7367e-03_r8,2.6935e-03_r8,3.0017e-03_r8,3.1619e-03_r8,3.2065e-03_r8,3.1297e-03_r8, & + &2.9147e-03_r8,2.4525e-03_r8,2.1765e-03_r8/) + kao(:, 1, 9, 4) = (/ & + &5.1377e-03_r8,5.6879e-03_r8,5.6413e-03_r8,5.3776e-03_r8,4.8224e-03_r8,4.1689e-03_r8, & + &3.3325e-03_r8,2.2481e-03_r8,2.0122e-03_r8/) + kao(:, 2, 9, 4) = (/ & + &5.4511e-03_r8,6.1548e-03_r8,6.1332e-03_r8,5.7185e-03_r8,5.1593e-03_r8,4.4551e-03_r8, & + &3.6302e-03_r8,2.5234e-03_r8,2.3673e-03_r8/) + kao(:, 3, 9, 4) = (/ & + &5.7014e-03_r8,6.5729e-03_r8,6.5250e-03_r8,6.0830e-03_r8,5.4507e-03_r8,4.7941e-03_r8, & + &3.9451e-03_r8,2.8561e-03_r8,2.7249e-03_r8/) + kao(:, 4, 9, 4) = (/ & + &5.9876e-03_r8,6.9491e-03_r8,6.9266e-03_r8,6.3994e-03_r8,5.8665e-03_r8,5.2094e-03_r8, & + &4.3177e-03_r8,3.2100e-03_r8,3.0655e-03_r8/) + kao(:, 5, 9, 4) = (/ & + &6.2578e-03_r8,7.3161e-03_r8,7.3395e-03_r8,6.8572e-03_r8,6.3066e-03_r8,5.6391e-03_r8, & + &4.7410e-03_r8,3.6035e-03_r8,3.3864e-03_r8/) + kao(:, 1,10, 4) = (/ & + &2.0796e-02_r8,2.0019e-02_r8,1.8165e-02_r8,1.6068e-02_r8,1.3873e-02_r8,1.1404e-02_r8, & + &8.6779e-03_r8,5.2784e-03_r8,2.8413e-03_r8/) + kao(:, 2,10, 4) = (/ & + &2.2188e-02_r8,2.1487e-02_r8,1.9617e-02_r8,1.7448e-02_r8,1.5124e-02_r8,1.2499e-02_r8, & + &9.2630e-03_r8,5.6664e-03_r8,3.3963e-03_r8/) + kao(:, 3,10, 4) = (/ & + &2.3219e-02_r8,2.2843e-02_r8,2.1086e-02_r8,1.8777e-02_r8,1.6130e-02_r8,1.3209e-02_r8, & + &9.9059e-03_r8,6.0802e-03_r8,4.0019e-03_r8/) + kao(:, 4,10, 4) = (/ & + &2.4435e-02_r8,2.4082e-02_r8,2.2303e-02_r8,1.9851e-02_r8,1.7023e-02_r8,1.4121e-02_r8, & + &1.0410e-02_r8,6.5843e-03_r8,4.6477e-03_r8/) + kao(:, 5,10, 4) = (/ & + &2.5609e-02_r8,2.5343e-02_r8,2.3560e-02_r8,2.0930e-02_r8,1.8042e-02_r8,1.4937e-02_r8, & + &1.1163e-02_r8,7.1400e-03_r8,5.2598e-03_r8/) + kao(:, 1,11, 4) = (/ & + &3.0218e-02_r8,2.8464e-02_r8,2.5566e-02_r8,2.2189e-02_r8,1.8763e-02_r8,1.5165e-02_r8, & + &1.1286e-02_r8,6.7271e-03_r8,3.0443e-03_r8/) + kao(:, 2,11, 4) = (/ & + &3.2017e-02_r8,3.0288e-02_r8,2.7351e-02_r8,2.3960e-02_r8,2.0417e-02_r8,1.6571e-02_r8, & + &1.2201e-02_r8,7.2159e-03_r8,3.6072e-03_r8/) + kao(:, 3,11, 4) = (/ & + &3.3713e-02_r8,3.2141e-02_r8,2.9172e-02_r8,2.5698e-02_r8,2.1768e-02_r8,1.7546e-02_r8, & + &1.2989e-02_r8,7.6734e-03_r8,4.2021e-03_r8/) + kao(:, 4,11, 4) = (/ & + &3.5523e-02_r8,3.3941e-02_r8,3.0802e-02_r8,2.7264e-02_r8,2.3091e-02_r8,1.8512e-02_r8, & + &1.3848e-02_r8,8.2207e-03_r8,4.9261e-03_r8/) + kao(:, 5,11, 4) = (/ & + &3.7048e-02_r8,3.5659e-02_r8,3.2500e-02_r8,2.8766e-02_r8,2.4380e-02_r8,1.9724e-02_r8, & + &1.4735e-02_r8,8.8773e-03_r8,5.6292e-03_r8/) + kao(:, 1,12, 4) = (/ & + &3.2170e-02_r8,2.9965e-02_r8,2.6774e-02_r8,2.3265e-02_r8,1.9604e-02_r8,1.5767e-02_r8, & + &1.1665e-02_r8,6.8628e-03_r8,2.9693e-03_r8/) + kao(:, 2,12, 4) = (/ & + &3.3877e-02_r8,3.1857e-02_r8,2.8686e-02_r8,2.5070e-02_r8,2.1306e-02_r8,1.7043e-02_r8, & + &1.2460e-02_r8,7.3567e-03_r8,3.5157e-03_r8/) + kao(:, 3,12, 4) = (/ & + &3.5821e-02_r8,3.3840e-02_r8,3.0497e-02_r8,2.6646e-02_r8,2.2619e-02_r8,1.8108e-02_r8, & + &1.3276e-02_r8,7.8561e-03_r8,4.1559e-03_r8/) + kao(:, 4,12, 4) = (/ & + &3.7503e-02_r8,3.5506e-02_r8,3.2126e-02_r8,2.8288e-02_r8,2.3902e-02_r8,1.9181e-02_r8, & + &1.4142e-02_r8,8.3990e-03_r8,4.8088e-03_r8/) + kao(:, 5,12, 4) = (/ & + &3.9218e-02_r8,3.7289e-02_r8,3.3764e-02_r8,2.9747e-02_r8,2.5253e-02_r8,2.0345e-02_r8, & + &1.5175e-02_r8,9.0569e-03_r8,5.5254e-03_r8/) + kao(:, 1,13, 4) = (/ & + &2.7021e-02_r8,2.5240e-02_r8,2.2638e-02_r8,1.9764e-02_r8,1.6669e-02_r8,1.3389e-02_r8, & + &9.8031e-03_r8,5.7609e-03_r8,2.5391e-03_r8/) + kao(:, 2,13, 4) = (/ & + &2.8550e-02_r8,2.6888e-02_r8,2.4164e-02_r8,2.1146e-02_r8,1.7859e-02_r8,1.4211e-02_r8, & + &1.0456e-02_r8,6.1648e-03_r8,3.0359e-03_r8/) + kao(:, 3,13, 4) = (/ & + &3.0206e-02_r8,2.8336e-02_r8,2.5560e-02_r8,2.2362e-02_r8,1.8953e-02_r8,1.5151e-02_r8, & + &1.1086e-02_r8,6.5998e-03_r8,3.5704e-03_r8/) + kao(:, 4,13, 4) = (/ & + &3.1495e-02_r8,2.9878e-02_r8,2.6989e-02_r8,2.3626e-02_r8,1.9993e-02_r8,1.6052e-02_r8, & + &1.1891e-02_r8,7.0977e-03_r8,4.1349e-03_r8/) + kao(:, 5,13, 4) = (/ & + &3.2969e-02_r8,3.1259e-02_r8,2.8282e-02_r8,2.5005e-02_r8,2.1232e-02_r8,1.7061e-02_r8, & + &1.2808e-02_r8,7.6578e-03_r8,4.7180e-03_r8/) + kao(:, 1, 1, 5) = (/ & + &7.7208e-05_r8,1.2983e-03_r8,2.1990e-03_r8,3.0698e-03_r8,3.9335e-03_r8,4.8939e-03_r8, & + &6.0507e-03_r8,7.9864e-03_r8,7.3950e-03_r8/) + kao(:, 2, 1, 5) = (/ & + &7.7960e-05_r8,1.4953e-03_r8,2.5372e-03_r8,3.5852e-03_r8,4.6877e-03_r8,5.9141e-03_r8, & + &7.4453e-03_r8,9.6664e-03_r8,8.9362e-03_r8/) + kao(:, 3, 1, 5) = (/ & + &7.8616e-05_r8,1.7027e-03_r8,2.9428e-03_r8,4.1895e-03_r8,5.5241e-03_r8,7.0220e-03_r8, & + &8.8894e-03_r8,1.1837e-02_r8,1.0698e-02_r8/) + kao(:, 4, 1, 5) = (/ & + &7.9284e-05_r8,1.9233e-03_r8,3.3889e-03_r8,4.8861e-03_r8,6.4864e-03_r8,8.2886e-03_r8, & + &1.0489e-02_r8,1.4031e-02_r8,1.2687e-02_r8/) + kao(:, 5, 1, 5) = (/ & + &8.0311e-05_r8,2.1623e-03_r8,3.8730e-03_r8,5.6513e-03_r8,7.5603e-03_r8,9.7064e-03_r8, & + &1.2306e-02_r8,1.6419e-02_r8,1.4857e-02_r8/) + kao(:, 1, 2, 5) = (/ & + &1.0510e-04_r8,1.2010e-03_r8,1.9708e-03_r8,2.6863e-03_r8,3.3801e-03_r8,4.0401e-03_r8, & + &4.8065e-03_r8,5.9839e-03_r8,5.8720e-03_r8/) + kao(:, 2, 2, 5) = (/ & + &1.0618e-04_r8,1.3719e-03_r8,2.2892e-03_r8,3.1040e-03_r8,3.9264e-03_r8,4.7961e-03_r8, & + &5.8356e-03_r8,7.3351e-03_r8,7.0925e-03_r8/) + kao(:, 3, 2, 5) = (/ & + &1.0689e-04_r8,1.5661e-03_r8,2.6266e-03_r8,3.5943e-03_r8,4.5681e-03_r8,5.6180e-03_r8, & + &6.8759e-03_r8,8.8640e-03_r8,8.4509e-03_r8/) + kao(:, 4, 2, 5) = (/ & + &1.0861e-04_r8,1.7752e-03_r8,2.9853e-03_r8,4.1453e-03_r8,5.3192e-03_r8,6.5973e-03_r8, & + &8.1274e-03_r8,1.0456e-02_r8,1.0031e-02_r8/) + kao(:, 5, 2, 5) = (/ & + &1.1004e-04_r8,1.9945e-03_r8,3.3831e-03_r8,4.7368e-03_r8,6.1454e-03_r8,7.6846e-03_r8, & + &9.5320e-03_r8,1.2312e-02_r8,1.1757e-02_r8/) + kao(:, 1, 3, 5) = (/ & + &1.9166e-04_r8,1.3172e-03_r8,1.9278e-03_r8,2.4677e-03_r8,2.9707e-03_r8,3.4895e-03_r8, & + &3.9440e-03_r8,4.4484e-03_r8,4.3497e-03_r8/) + kao(:, 2, 3, 5) = (/ & + &1.9336e-04_r8,1.4888e-03_r8,2.1997e-03_r8,2.8500e-03_r8,3.4656e-03_r8,4.0405e-03_r8, & + &4.6494e-03_r8,5.3886e-03_r8,5.2876e-03_r8/) + kao(:, 3, 3, 5) = (/ & + &1.9552e-04_r8,1.6719e-03_r8,2.4978e-03_r8,3.2794e-03_r8,4.0171e-03_r8,4.6883e-03_r8, & + &5.3810e-03_r8,6.3663e-03_r8,6.3594e-03_r8/) + kao(:, 4, 3, 5) = (/ & + &1.9793e-04_r8,1.8618e-03_r8,2.8193e-03_r8,3.7421e-03_r8,4.6002e-03_r8,5.4246e-03_r8, & + &6.2790e-03_r8,7.4939e-03_r8,7.6260e-03_r8/) + kao(:, 5, 3, 5) = (/ & + &2.0202e-04_r8,2.0622e-03_r8,3.1772e-03_r8,4.2408e-03_r8,5.2345e-03_r8,6.2239e-03_r8, & + &7.2922e-03_r8,8.8196e-03_r8,9.0035e-03_r8/) + kao(:, 1, 4, 5) = (/ & + &3.5080e-04_r8,1.5106e-03_r8,2.1048e-03_r8,2.5530e-03_r8,2.8923e-03_r8,3.1426e-03_r8, & + &3.3832e-03_r8,3.6360e-03_r8,3.6099e-03_r8/) + kao(:, 2, 4, 5) = (/ & + &3.5494e-04_r8,1.6898e-03_r8,2.3828e-03_r8,2.9160e-03_r8,3.3056e-03_r8,3.6304e-03_r8, & + &3.9520e-03_r8,4.2994e-03_r8,4.2882e-03_r8/) + kao(:, 3, 4, 5) = (/ & + &3.5978e-04_r8,1.8836e-03_r8,2.6877e-03_r8,3.3008e-03_r8,3.7593e-03_r8,4.1815e-03_r8, & + &4.6053e-03_r8,4.9917e-03_r8,5.0514e-03_r8/) + kao(:, 4, 4, 5) = (/ & + &3.6746e-04_r8,2.0763e-03_r8,3.0082e-03_r8,3.7203e-03_r8,4.2549e-03_r8,4.7934e-03_r8, & + &5.3242e-03_r8,5.8169e-03_r8,5.8760e-03_r8/) + kao(:, 5, 4, 5) = (/ & + &3.7911e-04_r8,2.2831e-03_r8,3.3520e-03_r8,4.1619e-03_r8,4.7913e-03_r8,5.4605e-03_r8, & + &6.1003e-03_r8,6.7476e-03_r8,6.8032e-03_r8/) + kao(:, 1, 5, 5) = (/ & + &5.8701e-04_r8,1.7294e-03_r8,2.3007e-03_r8,2.6940e-03_r8,2.9671e-03_r8,3.1134e-03_r8, & + &3.1768e-03_r8,3.0490e-03_r8,3.1049e-03_r8/) + kao(:, 2, 5, 5) = (/ & + &5.9308e-04_r8,1.9111e-03_r8,2.5835e-03_r8,3.0407e-03_r8,3.3851e-03_r8,3.5845e-03_r8, & + &3.6445e-03_r8,3.5746e-03_r8,3.6940e-03_r8/) + kao(:, 3, 5, 5) = (/ & + &6.0356e-04_r8,2.1186e-03_r8,2.8868e-03_r8,3.4242e-03_r8,3.8486e-03_r8,4.1112e-03_r8, & + &4.1722e-03_r8,4.1940e-03_r8,4.3605e-03_r8/) + kao(:, 4, 5, 5) = (/ & + &6.1818e-04_r8,2.3278e-03_r8,3.1936e-03_r8,3.8321e-03_r8,4.3352e-03_r8,4.6666e-03_r8, & + &4.7552e-03_r8,4.8779e-03_r8,5.1110e-03_r8/) + kao(:, 5, 5, 5) = (/ & + &6.3535e-04_r8,2.5512e-03_r8,3.5322e-03_r8,4.2882e-03_r8,4.8679e-03_r8,5.2358e-03_r8, & + &5.3921e-03_r8,5.6199e-03_r8,5.9412e-03_r8/) + kao(:, 1, 6, 5) = (/ & + &9.2532e-04_r8,2.0015e-03_r8,2.5277e-03_r8,2.8421e-03_r8,3.0437e-03_r8,3.1018e-03_r8, & + &3.0296e-03_r8,2.8221e-03_r8,2.6040e-03_r8/) + kao(:, 2, 6, 5) = (/ & + &9.2928e-04_r8,2.2000e-03_r8,2.8005e-03_r8,3.1777e-03_r8,3.4468e-03_r8,3.5577e-03_r8, & + &3.5029e-03_r8,3.2686e-03_r8,3.0871e-03_r8/) + kao(:, 3, 6, 5) = (/ & + &9.4818e-04_r8,2.4342e-03_r8,3.0892e-03_r8,3.5513e-03_r8,3.8786e-03_r8,4.0485e-03_r8, & + &4.0367e-03_r8,3.7564e-03_r8,3.6084e-03_r8/) + kao(:, 4, 6, 5) = (/ & + &9.7245e-04_r8,2.6688e-03_r8,3.4060e-03_r8,3.9527e-03_r8,4.3416e-03_r8,4.5754e-03_r8, & + &4.6140e-03_r8,4.3161e-03_r8,4.2427e-03_r8/) + kao(:, 5, 6, 5) = (/ & + &9.9339e-04_r8,2.9158e-03_r8,3.7426e-03_r8,4.3630e-03_r8,4.8503e-03_r8,5.1436e-03_r8, & + &5.2166e-03_r8,4.9082e-03_r8,4.9378e-03_r8/) + kao(:, 1, 7, 5) = (/ & + &1.5302e-03_r8,2.5414e-03_r8,2.9540e-03_r8,3.1974e-03_r8,3.3103e-03_r8,3.2792e-03_r8, & + &3.0626e-03_r8,2.6477e-03_r8,2.2296e-03_r8/) + kao(:, 2, 7, 5) = (/ & + &1.5437e-03_r8,2.8069e-03_r8,3.2725e-03_r8,3.5730e-03_r8,3.6894e-03_r8,3.7000e-03_r8, & + &3.5141e-03_r8,3.0866e-03_r8,2.7517e-03_r8/) + kao(:, 3, 7, 5) = (/ & + &1.5828e-03_r8,3.0663e-03_r8,3.6143e-03_r8,3.9451e-03_r8,4.1195e-03_r8,4.1576e-03_r8, & + &4.0163e-03_r8,3.5822e-03_r8,3.3032e-03_r8/) + kao(:, 4, 7, 5) = (/ & + &1.6196e-03_r8,3.3257e-03_r8,3.9578e-03_r8,4.3834e-03_r8,4.5853e-03_r8,4.6606e-03_r8, & + &4.5385e-03_r8,4.1261e-03_r8,3.9000e-03_r8/) + kao(:, 5, 7, 5) = (/ & + &1.6660e-03_r8,3.6179e-03_r8,4.3451e-03_r8,4.8226e-03_r8,5.0668e-03_r8,5.1930e-03_r8, & + &5.1180e-03_r8,4.7030e-03_r8,4.5474e-03_r8/) + kao(:, 1, 8, 5) = (/ & + &2.9602e-03_r8,3.9304e-03_r8,4.1580e-03_r8,4.2228e-03_r8,4.1165e-03_r8,3.9147e-03_r8, & + &3.5216e-03_r8,2.8265e-03_r8,2.2242e-03_r8/) + kao(:, 2, 8, 5) = (/ & + &2.9996e-03_r8,4.2668e-03_r8,4.6028e-03_r8,4.6806e-03_r8,4.6212e-03_r8,4.3859e-03_r8, & + &3.9542e-03_r8,3.2447e-03_r8,2.5165e-03_r8/) + kao(:, 3, 8, 5) = (/ & + &3.0790e-03_r8,4.6440e-03_r8,5.0256e-03_r8,5.1447e-03_r8,5.1348e-03_r8,4.8892e-03_r8, & + &4.4430e-03_r8,3.7287e-03_r8,2.9386e-03_r8/) + kao(:, 4, 8, 5) = (/ & + &3.1467e-03_r8,5.0515e-03_r8,5.4655e-03_r8,5.6295e-03_r8,5.6440e-03_r8,5.4532e-03_r8, & + &4.9689e-03_r8,4.2347e-03_r8,3.5150e-03_r8/) + kao(:, 5, 8, 5) = (/ & + &3.2473e-03_r8,5.4319e-03_r8,5.9099e-03_r8,6.1513e-03_r8,6.2421e-03_r8,6.0606e-03_r8, & + &5.5483e-03_r8,4.7752e-03_r8,4.1476e-03_r8/) + kao(:, 1, 9, 5) = (/ & + &1.0715e-02_r8,1.1382e-02_r8,1.0899e-02_r8,1.0007e-02_r8,9.0437e-03_r8,7.6976e-03_r8, & + &6.2825e-03_r8,4.4971e-03_r8,3.7652e-03_r8/) + kao(:, 2, 9, 5) = (/ & + &1.0909e-02_r8,1.1862e-02_r8,1.1397e-02_r8,1.0777e-02_r8,9.8877e-03_r8,8.5937e-03_r8, & + &7.0755e-03_r8,5.0938e-03_r8,4.2507e-03_r8/) + kao(:, 3, 9, 5) = (/ & + &1.1246e-02_r8,1.2418e-02_r8,1.2293e-02_r8,1.1701e-02_r8,1.0880e-02_r8,9.4889e-03_r8, & + &7.8244e-03_r8,5.6718e-03_r8,4.5213e-03_r8/) + kao(:, 4, 9, 5) = (/ & + &1.1484e-02_r8,1.3245e-02_r8,1.3252e-02_r8,1.2816e-02_r8,1.1850e-02_r8,1.0328e-02_r8, & + &8.6168e-03_r8,6.3257e-03_r8,4.7999e-03_r8/) + kao(:, 5, 9, 5) = (/ & + &1.1883e-02_r8,1.4169e-02_r8,1.4256e-02_r8,1.3856e-02_r8,1.2835e-02_r8,1.1196e-02_r8, & + &9.4286e-03_r8,7.0084e-03_r8,5.1834e-03_r8/) + kao(:, 1,10, 5) = (/ & + &4.3348e-02_r8,4.0646e-02_r8,3.6539e-02_r8,3.2078e-02_r8,2.7151e-02_r8,2.1841e-02_r8, & + &1.6185e-02_r8,9.9201e-03_r8,6.7193e-03_r8/) + kao(:, 2,10, 5) = (/ & + &4.4149e-02_r8,4.2066e-02_r8,3.8091e-02_r8,3.3609e-02_r8,2.8552e-02_r8,2.2983e-02_r8, & + &1.7376e-02_r8,1.1009e-02_r8,7.5436e-03_r8/) + kao(:, 3,10, 5) = (/ & + &4.5674e-02_r8,4.3639e-02_r8,3.9624e-02_r8,3.4947e-02_r8,3.0188e-02_r8,2.4887e-02_r8, & + &1.8903e-02_r8,1.2177e-02_r8,8.3556e-03_r8/) + kao(:, 4,10, 5) = (/ & + &4.6947e-02_r8,4.5302e-02_r8,4.1477e-02_r8,3.7249e-02_r8,3.2588e-02_r8,2.6746e-02_r8, & + &2.0815e-02_r8,1.3320e-02_r8,9.0276e-03_r8/) + kao(:, 5,10, 5) = (/ & + &4.8633e-02_r8,4.7885e-02_r8,4.4096e-02_r8,3.9864e-02_r8,3.4957e-02_r8,2.9104e-02_r8, & + &2.2653e-02_r8,1.4428e-02_r8,9.7333e-03_r8/) + kao(:, 1,11, 5) = (/ & + &6.1692e-02_r8,5.6780e-02_r8,5.0232e-02_r8,4.3693e-02_r8,3.6664e-02_r8,2.9101e-02_r8, & + &2.1139e-02_r8,1.2500e-02_r8,7.3091e-03_r8/) + kao(:, 2,11, 5) = (/ & + &6.3633e-02_r8,5.9268e-02_r8,5.2865e-02_r8,4.5871e-02_r8,3.8419e-02_r8,3.0609e-02_r8, & + &2.2496e-02_r8,1.3660e-02_r8,8.2073e-03_r8/) + kao(:, 3,11, 5) = (/ & + &6.5598e-02_r8,6.1281e-02_r8,5.4828e-02_r8,4.7713e-02_r8,4.0401e-02_r8,3.2790e-02_r8, & + &2.4296e-02_r8,1.5126e-02_r8,8.8706e-03_r8/) + kao(:, 4,11, 5) = (/ & + &6.7575e-02_r8,6.3884e-02_r8,5.7739e-02_r8,5.0715e-02_r8,4.3385e-02_r8,3.5358e-02_r8, & + &2.6343e-02_r8,1.6652e-02_r8,9.5120e-03_r8/) + kao(:, 5,11, 5) = (/ & + &7.0953e-02_r8,6.7728e-02_r8,6.1195e-02_r8,5.3939e-02_r8,4.6283e-02_r8,3.8093e-02_r8, & + &2.8648e-02_r8,1.8051e-02_r8,1.0472e-02_r8/) + kao(:, 1,12, 5) = (/ & + &6.6289e-02_r8,6.0781e-02_r8,5.3636e-02_r8,4.6304e-02_r8,3.8429e-02_r8,3.0261e-02_r8, & + &2.1777e-02_r8,1.2752e-02_r8,6.7746e-03_r8/) + kao(:, 2,12, 5) = (/ & + &6.8551e-02_r8,6.3174e-02_r8,5.6063e-02_r8,4.8348e-02_r8,4.0059e-02_r8,3.1785e-02_r8, & + &2.3315e-02_r8,1.3856e-02_r8,7.6622e-03_r8/) + kao(:, 3,12, 5) = (/ & + &7.0441e-02_r8,6.5327e-02_r8,5.8258e-02_r8,5.0611e-02_r8,4.2587e-02_r8,3.4170e-02_r8, & + &2.5237e-02_r8,1.5295e-02_r8,8.3950e-03_r8/) + kao(:, 4,12, 5) = (/ & + &7.3259e-02_r8,6.8842e-02_r8,6.1685e-02_r8,5.3758e-02_r8,4.5436e-02_r8,3.6706e-02_r8, & + &2.7377e-02_r8,1.6771e-02_r8,8.9439e-03_r8/) + kao(:, 5,12, 5) = (/ & + &7.7467e-02_r8,7.3081e-02_r8,6.5449e-02_r8,5.7418e-02_r8,4.8677e-02_r8,3.9671e-02_r8, & + &2.9550e-02_r8,1.8202e-02_r8,9.6319e-03_r8/) + kao(:, 1,13, 5) = (/ & + &5.6671e-02_r8,5.1982e-02_r8,4.5878e-02_r8,3.9500e-02_r8,3.2807e-02_r8,2.5894e-02_r8, & + &1.8717e-02_r8,1.0942e-02_r8,5.7523e-03_r8/) + kao(:, 2,13, 5) = (/ & + &5.8577e-02_r8,5.4011e-02_r8,4.7896e-02_r8,4.1459e-02_r8,3.4661e-02_r8,2.7671e-02_r8, & + &2.0186e-02_r8,1.2025e-02_r8,6.4664e-03_r8/) + kao(:, 3,13, 5) = (/ & + &6.0296e-02_r8,5.6294e-02_r8,5.0261e-02_r8,4.3702e-02_r8,3.6751e-02_r8,2.9579e-02_r8, & + &2.1985e-02_r8,1.3253e-02_r8,7.0517e-03_r8/) + kao(:, 4,13, 5) = (/ & + &6.3403e-02_r8,5.9492e-02_r8,5.3202e-02_r8,4.6643e-02_r8,3.9435e-02_r8,3.1951e-02_r8, & + &2.3841e-02_r8,1.4493e-02_r8,7.4965e-03_r8/) + kao(:, 5,13, 5) = (/ & + &6.7016e-02_r8,6.3341e-02_r8,5.7105e-02_r8,5.0058e-02_r8,4.2357e-02_r8,3.4571e-02_r8, & + &2.5674e-02_r8,1.5753e-02_r8,8.1075e-03_r8/) + kao(:, 1, 1, 6) = (/ & + &1.5042e-04_r8,2.4198e-03_r8,4.3016e-03_r8,6.2979e-03_r8,8.5168e-03_r8,1.0968e-02_r8, & + &1.3929e-02_r8,1.8584e-02_r8,1.6834e-02_r8/) + kao(:, 2, 1, 6) = (/ & + &1.5402e-04_r8,2.7874e-03_r8,5.0906e-03_r8,7.5405e-03_r8,1.0172e-02_r8,1.3049e-02_r8, & + &1.6523e-02_r8,2.2172e-02_r8,2.0134e-02_r8/) + kao(:, 3, 1, 6) = (/ & + &1.5658e-04_r8,3.2116e-03_r8,5.9652e-03_r8,8.9274e-03_r8,1.2070e-02_r8,1.5491e-02_r8, & + &1.9553e-02_r8,2.6056e-02_r8,2.3919e-02_r8/) + kao(:, 4, 1, 6) = (/ & + &1.5960e-04_r8,3.6836e-03_r8,6.9617e-03_r8,1.0460e-02_r8,1.4154e-02_r8,1.8205e-02_r8, & + &2.3055e-02_r8,3.0555e-02_r8,2.8089e-02_r8/) + kao(:, 5, 1, 6) = (/ & + &1.6165e-04_r8,4.2037e-03_r8,8.0817e-03_r8,1.2177e-02_r8,1.6484e-02_r8,2.1191e-02_r8, & + &2.6875e-02_r8,3.5769e-02_r8,3.2739e-02_r8/) + kao(:, 1, 2, 6) = (/ & + &2.0998e-04_r8,2.2589e-03_r8,3.7899e-03_r8,5.2410e-03_r8,6.7744e-03_r8,8.5703e-03_r8, & + &1.0697e-02_r8,1.3881e-02_r8,1.3198e-02_r8/) + kao(:, 2, 2, 6) = (/ & + &2.1456e-04_r8,2.6007e-03_r8,4.3946e-03_r8,6.1987e-03_r8,8.1361e-03_r8,1.0272e-02_r8, & + &1.2733e-02_r8,1.6541e-02_r8,1.5875e-02_r8/) + kao(:, 3, 2, 6) = (/ & + &2.1842e-04_r8,2.9560e-03_r8,5.0887e-03_r8,7.2752e-03_r8,9.6552e-03_r8,1.2252e-02_r8, & + &1.5232e-02_r8,1.9582e-02_r8,1.8968e-02_r8/) + kao(:, 4, 2, 6) = (/ & + &2.2236e-04_r8,3.3459e-03_r8,5.8736e-03_r8,8.5067e-03_r8,1.1349e-02_r8,1.4414e-02_r8, & + &1.7964e-02_r8,2.3187e-02_r8,2.2355e-02_r8/) + kao(:, 5, 2, 6) = (/ & + &2.2547e-04_r8,3.7713e-03_r8,6.7501e-03_r8,9.9039e-03_r8,1.3264e-02_r8,1.6870e-02_r8, & + &2.1032e-02_r8,2.7154e-02_r8,2.6176e-02_r8/) + kao(:, 1, 3, 6) = (/ & + &3.8749e-04_r8,2.3567e-03_r8,3.5784e-03_r8,4.7302e-03_r8,5.7992e-03_r8,6.7584e-03_r8, & + &7.8929e-03_r8,9.6810e-03_r8,9.8950e-03_r8/) + kao(:, 2, 3, 6) = (/ & + &3.9603e-04_r8,2.6464e-03_r8,4.1366e-03_r8,5.5007e-03_r8,6.7822e-03_r8,8.0470e-03_r8, & + &9.4913e-03_r8,1.1619e-02_r8,1.2036e-02_r8/) + kao(:, 3, 3, 6) = (/ & + &4.0456e-04_r8,2.9559e-03_r8,4.7389e-03_r8,6.3508e-03_r8,7.8799e-03_r8,9.4907e-03_r8, & + &1.1392e-02_r8,1.3956e-02_r8,1.4457e-02_r8/) + kao(:, 4, 3, 6) = (/ & + &4.1360e-04_r8,3.3032e-03_r8,5.4024e-03_r8,7.2987e-03_r8,9.1447e-03_r8,1.1131e-02_r8, & + &1.3466e-02_r8,1.6568e-02_r8,1.7113e-02_r8/) + kao(:, 5, 3, 6) = (/ & + &4.1860e-04_r8,3.6941e-03_r8,6.1025e-03_r8,8.3274e-03_r8,1.0570e-02_r8,1.3013e-02_r8, & + &1.5813e-02_r8,1.9496e-02_r8,2.0111e-02_r8/) + kao(:, 1, 4, 6) = (/ & + &7.1991e-04_r8,2.8586e-03_r8,3.8493e-03_r8,4.6115e-03_r8,5.2750e-03_r8,5.9823e-03_r8, & + &6.5939e-03_r8,7.1204e-03_r8,6.9950e-03_r8/) + kao(:, 2, 4, 6) = (/ & + &7.3932e-04_r8,3.1546e-03_r8,4.3292e-03_r8,5.2487e-03_r8,6.1632e-03_r8,7.0322e-03_r8, & + &7.8025e-03_r8,8.5583e-03_r8,8.4949e-03_r8/) + kao(:, 3, 4, 6) = (/ & + &7.5829e-04_r8,3.4592e-03_r8,4.8355e-03_r8,5.9709e-03_r8,7.1395e-03_r8,8.1909e-03_r8, & + &9.1159e-03_r8,1.0292e-02_r8,1.0335e-02_r8/) + kao(:, 4, 4, 6) = (/ & + &7.6959e-04_r8,3.8025e-03_r8,5.3880e-03_r8,6.7853e-03_r8,8.1872e-03_r8,9.4673e-03_r8, & + &1.0631e-02_r8,1.2218e-02_r8,1.2516e-02_r8/) + kao(:, 5, 4, 6) = (/ & + &7.7964e-04_r8,4.1796e-03_r8,5.9947e-03_r8,7.6582e-03_r8,9.3446e-03_r8,1.0850e-02_r8, & + &1.2339e-02_r8,1.4388e-02_r8,1.5009e-02_r8/) + kao(:, 1, 5, 6) = (/ & + &1.2241e-03_r8,3.4685e-03_r8,4.4046e-03_r8,5.0844e-03_r8,5.4871e-03_r8,5.7179e-03_r8, & + &5.7620e-03_r8,5.9818e-03_r8,6.1472e-03_r8/) + kao(:, 2, 5, 6) = (/ & + &1.2601e-03_r8,3.8071e-03_r8,4.8995e-03_r8,5.7159e-03_r8,6.2114e-03_r8,6.5597e-03_r8, & + &6.8164e-03_r8,7.1370e-03_r8,7.3501e-03_r8/) + kao(:, 3, 5, 6) = (/ & + &1.2927e-03_r8,4.1224e-03_r8,5.4389e-03_r8,6.3889e-03_r8,6.9938e-03_r8,7.4901e-03_r8, & + &7.9768e-03_r8,8.3697e-03_r8,8.6918e-03_r8/) + kao(:, 4, 5, 6) = (/ & + &1.3168e-03_r8,4.4980e-03_r8,6.0112e-03_r8,7.1194e-03_r8,7.8654e-03_r8,8.4979e-03_r8, & + &9.2325e-03_r8,9.7616e-03_r8,1.0181e-02_r8/) + kao(:, 5, 5, 6) = (/ & + &1.3499e-03_r8,4.8864e-03_r8,6.6201e-03_r8,7.8699e-03_r8,8.7970e-03_r8,9.6632e-03_r8, & + &1.0606e-02_r8,1.1344e-02_r8,1.1812e-02_r8/) + kao(:, 1, 6, 6) = (/ & + &1.9359e-03_r8,4.1954e-03_r8,5.0050e-03_r8,5.5462e-03_r8,5.8539e-03_r8,5.9443e-03_r8, & + &5.7417e-03_r8,5.1473e-03_r8,5.2472e-03_r8/) + kao(:, 2, 6, 6) = (/ & + &2.0045e-03_r8,4.5957e-03_r8,5.5374e-03_r8,6.1876e-03_r8,6.5964e-03_r8,6.7501e-03_r8, & + &6.5907e-03_r8,6.0581e-03_r8,6.2872e-03_r8/) + kao(:, 3, 6, 6) = (/ & + &2.0656e-03_r8,4.9538e-03_r8,6.0748e-03_r8,6.8772e-03_r8,7.3778e-03_r8,7.6157e-03_r8, & + &7.5054e-03_r8,7.1291e-03_r8,7.4717e-03_r8/) + kao(:, 4, 6, 6) = (/ & + &2.1235e-03_r8,5.3117e-03_r8,6.6418e-03_r8,7.6042e-03_r8,8.2374e-03_r8,8.5589e-03_r8, & + &8.5173e-03_r8,8.3153e-03_r8,8.7345e-03_r8/) + kao(:, 5, 6, 6) = (/ & + &2.1708e-03_r8,5.7022e-03_r8,7.2758e-03_r8,8.4071e-03_r8,9.1623e-03_r8,9.5678e-03_r8, & + &9.5860e-03_r8,9.6197e-03_r8,1.0118e-02_r8/) + kao(:, 1, 7, 6) = (/ & + &3.2088e-03_r8,5.3976e-03_r8,6.1152e-03_r8,6.4273e-03_r8,6.5565e-03_r8,6.4169e-03_r8, & + &6.0483e-03_r8,5.1718e-03_r8,4.3840e-03_r8/) + kao(:, 2, 7, 6) = (/ & + &3.3329e-03_r8,5.8617e-03_r8,6.7065e-03_r8,7.1293e-03_r8,7.3332e-03_r8,7.2483e-03_r8, & + &6.8991e-03_r8,6.0070e-03_r8,5.1893e-03_r8/) + kao(:, 3, 7, 6) = (/ & + &3.4526e-03_r8,6.3215e-03_r8,7.2907e-03_r8,7.8484e-03_r8,8.1105e-03_r8,8.1244e-03_r8, & + &7.7961e-03_r8,6.9012e-03_r8,6.1115e-03_r8/) + kao(:, 4, 7, 6) = (/ & + &3.5398e-03_r8,6.7841e-03_r8,7.9069e-03_r8,8.5448e-03_r8,8.9613e-03_r8,9.0608e-03_r8, & + &8.7760e-03_r8,7.8768e-03_r8,7.1030e-03_r8/) + kao(:, 5, 7, 6) = (/ & + &3.6419e-03_r8,7.2100e-03_r8,8.5218e-03_r8,9.3036e-03_r8,9.8959e-03_r8,1.0073e-02_r8, & + &9.8505e-03_r8,8.9292e-03_r8,8.2308e-03_r8/) + kao(:, 1, 8, 6) = (/ & + &6.2734e-03_r8,8.1929e-03_r8,8.7347e-03_r8,8.8396e-03_r8,8.5498e-03_r8,7.9153e-03_r8, & + &7.0346e-03_r8,5.6808e-03_r8,4.1552e-03_r8/) + kao(:, 2, 8, 6) = (/ & + &6.5441e-03_r8,8.8580e-03_r8,9.5108e-03_r8,9.7024e-03_r8,9.3653e-03_r8,8.8364e-03_r8, & + &7.9480e-03_r8,6.5304e-03_r8,4.9813e-03_r8/) + kao(:, 3, 8, 6) = (/ & + &6.7938e-03_r8,9.5212e-03_r8,1.0312e-02_r8,1.0573e-02_r8,1.0260e-02_r8,9.7376e-03_r8, & + &8.8728e-03_r8,7.4306e-03_r8,5.9661e-03_r8/) + kao(:, 4, 8, 6) = (/ & + &6.9763e-03_r8,1.0160e-02_r8,1.1107e-02_r8,1.1420e-02_r8,1.1193e-02_r8,1.0684e-02_r8, & + &9.8581e-03_r8,8.3990e-03_r8,6.9644e-03_r8/) + kao(:, 5, 8, 6) = (/ & + &7.1912e-03_r8,1.0832e-02_r8,1.1979e-02_r8,1.2319e-02_r8,1.2084e-02_r8,1.1646e-02_r8, & + &1.0942e-02_r8,9.4605e-03_r8,8.0079e-03_r8/) + kao(:, 1, 9, 6) = (/ & + &2.3423e-02_r8,2.3874e-02_r8,2.2570e-02_r8,2.0907e-02_r8,1.8747e-02_r8,1.6279e-02_r8, & + &1.3268e-02_r8,9.1967e-03_r8,5.4472e-03_r8/) + kao(:, 2, 9, 6) = (/ & + &2.4372e-02_r8,2.5487e-02_r8,2.4526e-02_r8,2.2806e-02_r8,2.0430e-02_r8,1.7721e-02_r8, & + &1.4547e-02_r8,1.0257e-02_r8,5.8874e-03_r8/) + kao(:, 3, 9, 6) = (/ & + &2.5322e-02_r8,2.7228e-02_r8,2.6228e-02_r8,2.4576e-02_r8,2.2164e-02_r8,1.9365e-02_r8, & + &1.5921e-02_r8,1.1389e-02_r8,6.8168e-03_r8/) + kao(:, 4, 9, 6) = (/ & + &2.6144e-02_r8,2.8709e-02_r8,2.7958e-02_r8,2.6366e-02_r8,2.3791e-02_r8,2.0979e-02_r8, & + &1.7361e-02_r8,1.2542e-02_r8,7.8623e-03_r8/) + kao(:, 5, 9, 6) = (/ & + &2.7002e-02_r8,3.0246e-02_r8,2.9564e-02_r8,2.8028e-02_r8,2.5537e-02_r8,2.2731e-02_r8, & + &1.8860e-02_r8,1.3722e-02_r8,9.0318e-03_r8/) + kao(:, 1,10, 6) = (/ & + &9.6759e-02_r8,8.9920e-02_r8,8.0281e-02_r8,6.9298e-02_r8,5.8160e-02_r8,4.6685e-02_r8, & + &3.4489e-02_r8,2.1137e-02_r8,9.1317e-03_r8/) + kao(:, 2,10, 6) = (/ & + &1.0130e-01_r8,9.4928e-02_r8,8.5063e-02_r8,7.4190e-02_r8,6.2751e-02_r8,5.0819e-02_r8, & + &3.7815e-02_r8,2.3107e-02_r8,9.7753e-03_r8/) + kao(:, 3,10, 6) = (/ & + &1.0500e-01_r8,9.9899e-02_r8,9.0245e-02_r8,7.9682e-02_r8,6.7667e-02_r8,5.4638e-02_r8, & + &4.0873e-02_r8,2.5040e-02_r8,1.0330e-02_r8/) + kao(:, 4,10, 6) = (/ & + &1.0896e-01_r8,1.0463e-01_r8,9.5171e-02_r8,8.3946e-02_r8,7.1420e-02_r8,5.8144e-02_r8, & + &4.3799e-02_r8,2.7205e-02_r8,1.1084e-02_r8/) + kao(:, 5,10, 6) = (/ & + &1.1285e-01_r8,1.0942e-01_r8,9.9931e-02_r8,8.8439e-02_r8,7.5783e-02_r8,6.1708e-02_r8, & + &4.6484e-02_r8,2.9531e-02_r8,1.2060e-02_r8/) + kao(:, 1,11, 6) = (/ & + &1.4204e-01_r8,1.2997e-01_r8,1.1520e-01_r8,9.8769e-02_r8,8.1420e-02_r8,6.4217e-02_r8, & + &4.6399e-02_r8,2.7414e-02_r8,9.3511e-03_r8/) + kao(:, 2,11, 6) = (/ & + &1.4781e-01_r8,1.3669e-01_r8,1.2188e-01_r8,1.0492e-01_r8,8.7668e-02_r8,6.9566e-02_r8, & + &5.0549e-02_r8,3.0014e-02_r8,1.0330e-02_r8/) + kao(:, 3,11, 6) = (/ & + &1.5380e-01_r8,1.4353e-01_r8,1.2793e-01_r8,1.1113e-01_r8,9.3325e-02_r8,7.4108e-02_r8, & + &5.4029e-02_r8,3.2498e-02_r8,1.1533e-02_r8/) + kao(:, 4,11, 6) = (/ & + &1.6004e-01_r8,1.5059e-01_r8,1.3460e-01_r8,1.1704e-01_r8,9.8404e-02_r8,7.8709e-02_r8, & + &5.7847e-02_r8,3.4798e-02_r8,1.2510e-02_r8/) + kao(:, 5,11, 6) = (/ & + &1.6529e-01_r8,1.5606e-01_r8,1.4056e-01_r8,1.2310e-01_r8,1.0396e-01_r8,8.3240e-02_r8, & + &6.1355e-02_r8,3.7415e-02_r8,1.3283e-02_r8/) + kao(:, 1,12, 6) = (/ & + &1.5238e-01_r8,1.3897e-01_r8,1.2274e-01_r8,1.0509e-01_r8,8.6816e-02_r8,6.8213e-02_r8, & + &4.8813e-02_r8,2.8303e-02_r8,8.9094e-03_r8/) + kao(:, 2,12, 6) = (/ & + &1.5887e-01_r8,1.4598e-01_r8,1.2939e-01_r8,1.1123e-01_r8,9.2497e-02_r8,7.3141e-02_r8, & + &5.2574e-02_r8,3.0889e-02_r8,9.4910e-03_r8/) + kao(:, 3,12, 6) = (/ & + &1.6583e-01_r8,1.5402e-01_r8,1.3664e-01_r8,1.1788e-01_r8,9.8276e-02_r8,7.7826e-02_r8, & + &5.6134e-02_r8,3.3329e-02_r8,1.0354e-02_r8/) + kao(:, 4,12, 6) = (/ & + &1.7232e-01_r8,1.6056e-01_r8,1.4294e-01_r8,1.2398e-01_r8,1.0387e-01_r8,8.2524e-02_r8, & + &5.9981e-02_r8,3.5800e-02_r8,1.1471e-02_r8/) + kao(:, 5,12, 6) = (/ & + &1.7822e-01_r8,1.6713e-01_r8,1.4985e-01_r8,1.3045e-01_r8,1.0965e-01_r8,8.7208e-02_r8, & + &6.3531e-02_r8,3.8400e-02_r8,1.2648e-02_r8/) + kao(:, 1,13, 6) = (/ & + &1.2851e-01_r8,1.1760e-01_r8,1.0432e-01_r8,8.9471e-02_r8,7.3952e-02_r8,5.7965e-02_r8, & + &4.1571e-02_r8,2.4244e-02_r8,7.5271e-03_r8/) + kao(:, 2,13, 6) = (/ & + &1.3461e-01_r8,1.2431e-01_r8,1.1020e-01_r8,9.4715e-02_r8,7.8713e-02_r8,6.2191e-02_r8, & + &4.4720e-02_r8,2.6349e-02_r8,7.9374e-03_r8/) + kao(:, 3,13, 6) = (/ & + &1.4091e-01_r8,1.3079e-01_r8,1.1585e-01_r8,1.0015e-01_r8,8.3554e-02_r8,6.6181e-02_r8, & + &4.7816e-02_r8,2.8551e-02_r8,8.7113e-03_r8/) + kao(:, 4,13, 6) = (/ & + &1.4657e-01_r8,1.3673e-01_r8,1.2189e-01_r8,1.0573e-01_r8,8.8680e-02_r8,7.0418e-02_r8, & + &5.0990e-02_r8,3.0632e-02_r8,9.8158e-03_r8/) + kao(:, 5,13, 6) = (/ & + &1.5197e-01_r8,1.4281e-01_r8,1.2778e-01_r8,1.1111e-01_r8,9.3402e-02_r8,7.4099e-02_r8, & + &5.4192e-02_r8,3.2952e-02_r8,1.0865e-02_r8/) + kao(:, 1, 1, 7) = (/ & + &2.9775e-04_r8,4.9903e-03_r8,9.5966e-03_r8,1.4458e-02_r8,1.9550e-02_r8,2.5066e-02_r8, & + &3.1548e-02_r8,4.0907e-02_r8,3.8920e-02_r8/) + kao(:, 2, 1, 7) = (/ & + &2.9974e-04_r8,5.8708e-03_r8,1.1484e-02_r8,1.7340e-02_r8,2.3486e-02_r8,3.0156e-02_r8, & + &3.8022e-02_r8,4.9522e-02_r8,4.6798e-02_r8/) + kao(:, 3, 1, 7) = (/ & + &3.0249e-04_r8,6.8379e-03_r8,1.3523e-02_r8,2.0453e-02_r8,2.7734e-02_r8,3.5680e-02_r8, & + &4.5116e-02_r8,5.8960e-02_r8,5.5301e-02_r8/) + kao(:, 4, 1, 7) = (/ & + &3.0505e-04_r8,7.9161e-03_r8,1.5750e-02_r8,2.3843e-02_r8,3.2353e-02_r8,4.1634e-02_r8, & + &5.2683e-02_r8,6.9279e-02_r8,6.4544e-02_r8/) + kao(:, 5, 1, 7) = (/ & + &3.0784e-04_r8,9.1145e-03_r8,1.8178e-02_r8,2.7529e-02_r8,3.7353e-02_r8,4.8074e-02_r8, & + &6.0824e-02_r8,8.0052e-02_r8,7.4551e-02_r8/) + kao(:, 1, 2, 7) = (/ & + &4.4044e-04_r8,4.5745e-03_r8,7.9442e-03_r8,1.1658e-02_r8,1.5612e-02_r8,1.9809e-02_r8, & + &2.4586e-02_r8,3.1373e-02_r8,3.0910e-02_r8/) + kao(:, 2, 2, 7) = (/ & + &4.4502e-04_r8,5.2457e-03_r8,9.4321e-03_r8,1.4009e-02_r8,1.8804e-02_r8,2.3915e-02_r8, & + &2.9756e-02_r8,3.8088e-02_r8,3.7317e-02_r8/) + kao(:, 3, 2, 7) = (/ & + &4.4893e-04_r8,5.9898e-03_r8,1.1101e-02_r8,1.6604e-02_r8,2.2319e-02_r8,2.8413e-02_r8, & + &3.5386e-02_r8,4.5425e-02_r8,4.4358e-02_r8/) + kao(:, 4, 2, 7) = (/ & + &4.5303e-04_r8,6.8346e-03_r8,1.2966e-02_r8,1.9451e-02_r8,2.6168e-02_r8,3.3333e-02_r8, & + &4.1534e-02_r8,5.3372e-02_r8,5.2063e-02_r8/) + kao(:, 5, 2, 7) = (/ & + &4.5653e-04_r8,7.7989e-03_r8,1.5045e-02_r8,2.2592e-02_r8,3.0407e-02_r8,3.8717e-02_r8, & + &4.8217e-02_r8,6.1953e-02_r8,6.0541e-02_r8/) + kao(:, 1, 3, 7) = (/ & + &8.7011e-04_r8,4.7519e-03_r8,7.4191e-03_r8,9.7724e-03_r8,1.2242e-02_r8,1.5076e-02_r8, & + &1.8293e-02_r8,2.2402e-02_r8,2.3454e-02_r8/) + kao(:, 2, 3, 7) = (/ & + &8.7761e-04_r8,5.4004e-03_r8,8.5169e-03_r8,1.1449e-02_r8,1.4656e-02_r8,1.8245e-02_r8, & + &2.2203e-02_r8,2.7303e-02_r8,2.8468e-02_r8/) + kao(:, 3, 3, 7) = (/ & + &8.8555e-04_r8,6.0960e-03_r8,9.7399e-03_r8,1.3383e-02_r8,1.7420e-02_r8,2.1805e-02_r8, & + &2.6578e-02_r8,3.2747e-02_r8,3.4102e-02_r8/) + kao(:, 4, 3, 7) = (/ & + &8.8837e-04_r8,6.8303e-03_r8,1.1116e-02_r8,1.5598e-02_r8,2.0532e-02_r8,2.5757e-02_r8, & + &3.1445e-02_r8,3.8773e-02_r8,4.0387e-02_r8/) + kao(:, 5, 3, 7) = (/ & + &8.9568e-04_r8,7.6159e-03_r8,1.2685e-02_r8,1.8136e-02_r8,2.4011e-02_r8,3.0157e-02_r8, & + &3.6817e-02_r8,4.5383e-02_r8,4.7355e-02_r8/) + kao(:, 1, 4, 7) = (/ & + &1.7216e-03_r8,5.6014e-03_r8,7.5736e-03_r8,9.4674e-03_r8,1.1191e-02_r8,1.2535e-02_r8, & + &1.3987e-02_r8,1.6268e-02_r8,1.7296e-02_r8/) + kao(:, 2, 4, 7) = (/ & + &1.7298e-03_r8,6.1879e-03_r8,8.6832e-03_r8,1.0978e-02_r8,1.2974e-02_r8,1.4749e-02_r8, & + &1.6870e-02_r8,1.9909e-02_r8,2.1431e-02_r8/) + kao(:, 3, 4, 7) = (/ & + &1.7341e-03_r8,6.8367e-03_r8,9.8584e-03_r8,1.2616e-02_r8,1.4944e-02_r8,1.7324e-02_r8, & + &2.0237e-02_r8,2.4035e-02_r8,2.5998e-02_r8/) + kao(:, 4, 4, 7) = (/ & + &1.7534e-03_r8,7.5128e-03_r8,1.1127e-02_r8,1.4362e-02_r8,1.7213e-02_r8,2.0310e-02_r8, & + &2.4053e-02_r8,2.8665e-02_r8,3.1074e-02_r8/) + kao(:, 5, 4, 7) = (/ & + &1.7641e-03_r8,8.2760e-03_r8,1.2507e-02_r8,1.6268e-02_r8,1.9802e-02_r8,2.3773e-02_r8, & + &2.8361e-02_r8,3.3846e-02_r8,3.6727e-02_r8/) + kao(:, 1, 5, 7) = (/ & + &3.0539e-03_r8,7.3205e-03_r8,8.9564e-03_r8,9.9240e-03_r8,1.0675e-02_r8,1.1625e-02_r8, & + &1.2424e-02_r8,1.2649e-02_r8,1.2475e-02_r8/) + kao(:, 2, 5, 7) = (/ & + &3.0697e-03_r8,8.0642e-03_r8,9.9550e-03_r8,1.1166e-02_r8,1.2428e-02_r8,1.3587e-02_r8, & + &1.4545e-02_r8,1.5222e-02_r8,1.4936e-02_r8/) + kao(:, 3, 5, 7) = (/ & + &3.0978e-03_r8,8.8320e-03_r8,1.1001e-02_r8,1.2560e-02_r8,1.4306e-02_r8,1.5802e-02_r8, & + &1.6906e-02_r8,1.8302e-02_r8,1.7957e-02_r8/) + kao(:, 4, 5, 7) = (/ & + &3.1191e-03_r8,9.5288e-03_r8,1.2130e-02_r8,1.4148e-02_r8,1.6348e-02_r8,1.8245e-02_r8, & + &1.9668e-02_r8,2.1849e-02_r8,2.2010e-02_r8/) + kao(:, 5, 5, 7) = (/ & + &3.1173e-03_r8,1.0269e-02_r8,1.3281e-02_r8,1.5937e-02_r8,1.8604e-02_r8,2.0861e-02_r8, & + &2.2868e-02_r8,2.5903e-02_r8,2.6735e-02_r8/) + kao(:, 1, 6, 7) = (/ & + &4.9571e-03_r8,9.1596e-03_r8,1.0920e-02_r8,1.1683e-02_r8,1.1947e-02_r8,1.1808e-02_r8, & + &1.1212e-02_r8,1.1074e-02_r8,1.1113e-02_r8/) + kao(:, 2, 6, 7) = (/ & + &5.0027e-03_r8,9.9969e-03_r8,1.2157e-02_r8,1.3082e-02_r8,1.3449e-02_r8,1.3422e-02_r8, & + &1.3156e-02_r8,1.3134e-02_r8,1.3279e-02_r8/) + kao(:, 3, 6, 7) = (/ & + &5.0299e-03_r8,1.0940e-02_r8,1.3400e-02_r8,1.4481e-02_r8,1.5090e-02_r8,1.5137e-02_r8, & + &1.5334e-02_r8,1.5370e-02_r8,1.5787e-02_r8/) + kao(:, 4, 6, 7) = (/ & + &5.0401e-03_r8,1.1872e-02_r8,1.4616e-02_r8,1.5947e-02_r8,1.6778e-02_r8,1.7087e-02_r8, & + &1.7734e-02_r8,1.7868e-02_r8,1.8548e-02_r8/) + kao(:, 5, 6, 7) = (/ & + &5.0929e-03_r8,1.2799e-02_r8,1.5866e-02_r8,1.7551e-02_r8,1.8584e-02_r8,1.9414e-02_r8, & + &2.0410e-02_r8,2.0816e-02_r8,2.1713e-02_r8/) + kao(:, 1, 7, 7) = (/ & + &8.4314e-03_r8,1.2463e-02_r8,1.3843e-02_r8,1.4407e-02_r8,1.4329e-02_r8,1.3643e-02_r8, & + &1.2423e-02_r8,1.0398e-02_r8,1.0049e-02_r8/) + kao(:, 2, 7, 7) = (/ & + &8.4877e-03_r8,1.3426e-02_r8,1.5237e-02_r8,1.6099e-02_r8,1.6143e-02_r8,1.5465e-02_r8, & + &1.4143e-02_r8,1.1980e-02_r8,1.1912e-02_r8/) + kao(:, 3, 7, 7) = (/ & + &8.5061e-03_r8,1.4450e-02_r8,1.6739e-02_r8,1.7865e-02_r8,1.8006e-02_r8,1.7376e-02_r8, & + &1.5998e-02_r8,1.3868e-02_r8,1.3962e-02_r8/) + kao(:, 4, 7, 7) = (/ & + &8.5919e-03_r8,1.5490e-02_r8,1.8250e-02_r8,1.9632e-02_r8,1.9933e-02_r8,1.9343e-02_r8, & + &1.7978e-02_r8,1.6120e-02_r8,1.6346e-02_r8/) + kao(:, 5, 7, 7) = (/ & + &8.6244e-03_r8,1.6546e-02_r8,1.9762e-02_r8,2.1475e-02_r8,2.1907e-02_r8,2.1414e-02_r8, & + &2.0099e-02_r8,1.8617e-02_r8,1.9113e-02_r8/) + kao(:, 1, 8, 7) = (/ & + &1.6801e-02_r8,2.0166e-02_r8,2.0707e-02_r8,2.0359e-02_r8,1.9438e-02_r8,1.7889e-02_r8, & + &1.5556e-02_r8,1.2093e-02_r8,8.8687e-03_r8/) + kao(:, 2, 8, 7) = (/ & + &1.6841e-02_r8,2.1258e-02_r8,2.2460e-02_r8,2.2381e-02_r8,2.1605e-02_r8,2.0124e-02_r8, & + &1.7632e-02_r8,1.3928e-02_r8,1.0513e-02_r8/) + kao(:, 3, 8, 7) = (/ & + &1.6945e-02_r8,2.2389e-02_r8,2.4138e-02_r8,2.4525e-02_r8,2.3968e-02_r8,2.2498e-02_r8, & + &1.9836e-02_r8,1.5792e-02_r8,1.2224e-02_r8/) + kao(:, 4, 8, 7) = (/ & + &1.7081e-02_r8,2.3610e-02_r8,2.5903e-02_r8,2.6682e-02_r8,2.6351e-02_r8,2.4884e-02_r8, & + &2.2197e-02_r8,1.7790e-02_r8,1.4133e-02_r8/) + kao(:, 5, 8, 7) = (/ & + &1.7107e-02_r8,2.4831e-02_r8,2.7681e-02_r8,2.8814e-02_r8,2.8766e-02_r8,2.7453e-02_r8, & + &2.4610e-02_r8,1.9914e-02_r8,1.6383e-02_r8/) + kao(:, 1, 9, 7) = (/ & + &6.2717e-02_r8,6.2735e-02_r8,5.8603e-02_r8,5.2748e-02_r8,4.6263e-02_r8,3.9117e-02_r8, & + &3.0759e-02_r8,2.1087e-02_r8,9.9200e-03_r8/) + kao(:, 2, 9, 7) = (/ & + &6.3094e-02_r8,6.4670e-02_r8,6.0602e-02_r8,5.5392e-02_r8,4.9420e-02_r8,4.2558e-02_r8, & + &3.4002e-02_r8,2.3733e-02_r8,1.2138e-02_r8/) + kao(:, 3, 9, 7) = (/ & + &6.3563e-02_r8,6.6269e-02_r8,6.3058e-02_r8,5.8357e-02_r8,5.2632e-02_r8,4.5743e-02_r8, & + &3.7261e-02_r8,2.6594e-02_r8,1.4716e-02_r8/) + kao(:, 4, 9, 7) = (/ & + &6.4005e-02_r8,6.8005e-02_r8,6.5556e-02_r8,6.1466e-02_r8,5.6121e-02_r8,4.9302e-02_r8, & + &4.0642e-02_r8,2.9533e-02_r8,1.7598e-02_r8/) + kao(:, 5, 9, 7) = (/ & + &6.4303e-02_r8,6.9477e-02_r8,6.8109e-02_r8,6.4600e-02_r8,5.9691e-02_r8,5.2874e-02_r8, & + &4.4056e-02_r8,3.2670e-02_r8,2.0612e-02_r8/) + kao(:, 1,10, 7) = (/ & + &2.6283e-01_r8,2.3848e-01_r8,2.1237e-01_r8,1.8399e-01_r8,1.5364e-01_r8,1.2096e-01_r8, & + &8.6686e-02_r8,5.0921e-02_r8,1.2662e-02_r8/) + kao(:, 2,10, 7) = (/ & + &2.6495e-01_r8,2.4348e-01_r8,2.1796e-01_r8,1.8933e-01_r8,1.5813e-01_r8,1.2513e-01_r8, & + &9.1228e-02_r8,5.5191e-02_r8,1.6120e-02_r8/) + kao(:, 3,10, 7) = (/ & + &2.6701e-01_r8,2.4762e-01_r8,2.2286e-01_r8,1.9379e-01_r8,1.6250e-01_r8,1.3046e-01_r8, & + &9.6273e-02_r8,5.9643e-02_r8,2.0041e-02_r8/) + kao(:, 4,10, 7) = (/ & + &2.6827e-01_r8,2.5124e-01_r8,2.2683e-01_r8,1.9843e-01_r8,1.6799e-01_r8,1.3618e-01_r8, & + &1.0159e-01_r8,6.3939e-02_r8,2.4035e-02_r8/) + kao(:, 5,10, 7) = (/ & + &2.7234e-01_r8,2.5705e-01_r8,2.3264e-01_r8,2.0401e-01_r8,1.7374e-01_r8,1.4157e-01_r8, & + &1.0689e-01_r8,6.8300e-02_r8,2.8241e-02_r8/) + kao(:, 1,11, 7) = (/ & + &3.8435e-01_r8,3.4486e-01_r8,3.0408e-01_r8,2.6025e-01_r8,2.1577e-01_r8,1.6840e-01_r8, & + &1.1827e-01_r8,6.6862e-02_r8,1.4067e-02_r8/) + kao(:, 2,11, 7) = (/ & + &3.8808e-01_r8,3.5079e-01_r8,3.0947e-01_r8,2.6705e-01_r8,2.2115e-01_r8,1.7271e-01_r8, & + &1.2306e-01_r8,7.1102e-02_r8,1.7282e-02_r8/) + kao(:, 3,11, 7) = (/ & + &3.9133e-01_r8,3.5683e-01_r8,3.1692e-01_r8,2.7320e-01_r8,2.2652e-01_r8,1.7854e-01_r8, & + &1.2887e-01_r8,7.5471e-02_r8,2.0650e-02_r8/) + kao(:, 4,11, 7) = (/ & + &3.9688e-01_r8,3.6404e-01_r8,3.2547e-01_r8,2.8118e-01_r8,2.3421e-01_r8,1.8549e-01_r8, & + &1.3490e-01_r8,8.0175e-02_r8,2.4385e-02_r8/) + kao(:, 5,11, 7) = (/ & + &4.0366e-01_r8,3.7211e-01_r8,3.3310e-01_r8,2.8891e-01_r8,2.4168e-01_r8,1.9277e-01_r8, & + &1.4118e-01_r8,8.5255e-02_r8,2.8315e-02_r8/) + kao(:, 1,12, 7) = (/ & + &4.1788e-01_r8,3.7417e-01_r8,3.2848e-01_r8,2.8026e-01_r8,2.3093e-01_r8,1.7900e-01_r8, & + &1.2516e-01_r8,6.9829e-02_r8,1.3077e-02_r8/) + kao(:, 2,12, 7) = (/ & + &4.2346e-01_r8,3.8197e-01_r8,3.3568e-01_r8,2.8761e-01_r8,2.3734e-01_r8,1.8458e-01_r8, & + &1.3037e-01_r8,7.4069e-02_r8,1.6501e-02_r8/) + kao(:, 3,12, 7) = (/ & + &4.3061e-01_r8,3.9035e-01_r8,3.4485e-01_r8,2.9676e-01_r8,2.4502e-01_r8,1.9175e-01_r8, & + &1.3672e-01_r8,7.8434e-02_r8,1.9942e-02_r8/) + kao(:, 4,12, 7) = (/ & + &4.3991e-01_r8,4.0142e-01_r8,3.5621e-01_r8,3.0583e-01_r8,2.5354e-01_r8,1.9941e-01_r8, & + &1.4294e-01_r8,8.2867e-02_r8,2.3156e-02_r8/) + kao(:, 5,12, 7) = (/ & + &4.5018e-01_r8,4.1383e-01_r8,3.6847e-01_r8,3.1728e-01_r8,2.6385e-01_r8,2.0769e-01_r8, & + &1.4984e-01_r8,8.7550e-02_r8,2.5906e-02_r8/) + kao(:, 1,13, 7) = (/ & + &3.5954e-01_r8,3.2293e-01_r8,2.8290e-01_r8,2.4149e-01_r8,1.9855e-01_r8,1.5392e-01_r8, & + &1.0799e-01_r8,6.0538e-02_r8,1.1582e-02_r8/) + kao(:, 2,13, 7) = (/ & + &3.6620e-01_r8,3.3095e-01_r8,2.9118e-01_r8,2.4962e-01_r8,2.0579e-01_r8,1.6035e-01_r8, & + &1.1345e-01_r8,6.4561e-02_r8,1.4555e-02_r8/) + kao(:, 3,13, 7) = (/ & + &3.7497e-01_r8,3.4139e-01_r8,3.0205e-01_r8,2.5902e-01_r8,2.1397e-01_r8,1.6755e-01_r8, & + &1.1907e-01_r8,6.8274e-02_r8,1.7516e-02_r8/) + kao(:, 4,13, 7) = (/ & + &3.8491e-01_r8,3.5293e-01_r8,3.1344e-01_r8,2.6951e-01_r8,2.2338e-01_r8,1.7537e-01_r8, & + &1.2550e-01_r8,7.2213e-02_r8,1.9685e-02_r8/) + kao(:, 5,13, 7) = (/ & + &3.9456e-01_r8,3.6430e-01_r8,3.2370e-01_r8,2.7885e-01_r8,2.3209e-01_r8,1.8326e-01_r8, & + &1.3235e-01_r8,7.6929e-02_r8,2.1105e-02_r8/) + kao(:, 1, 1, 8) = (/ & + &6.2097e-04_r8,1.4117e-02_r8,2.8277e-02_r8,4.2775e-02_r8,5.7848e-02_r8,7.3960e-02_r8, & + &9.2407e-02_r8,1.1864e-01_r8,1.1554e-01_r8/) + kao(:, 2, 1, 8) = (/ & + &6.1974e-04_r8,1.6905e-02_r8,3.3889e-02_r8,5.1276e-02_r8,6.9348e-02_r8,8.8703e-02_r8, & + &1.1084e-01_r8,1.4177e-01_r8,1.3853e-01_r8/) + kao(:, 3, 1, 8) = (/ & + &6.1587e-04_r8,1.9900e-02_r8,3.9925e-02_r8,6.0422e-02_r8,8.1729e-02_r8,1.0451e-01_r8, & + &1.3061e-01_r8,1.6696e-01_r8,1.6328e-01_r8/) + kao(:, 4, 1, 8) = (/ & + &6.1184e-04_r8,2.3086e-02_r8,4.6344e-02_r8,7.0163e-02_r8,9.4901e-02_r8,1.2137e-01_r8, & + &1.5165e-01_r8,1.9370e-01_r8,1.8962e-01_r8/) + kao(:, 5, 1, 8) = (/ & + &6.0950e-04_r8,2.6468e-02_r8,5.3164e-02_r8,8.0478e-02_r8,1.0886e-01_r8,1.3922e-01_r8, & + &1.7398e-01_r8,2.2192e-01_r8,2.1753e-01_r8/) + kao(:, 1, 2, 8) = (/ & + &9.4214e-04_r8,1.1864e-02_r8,2.3368e-02_r8,3.5168e-02_r8,4.7308e-02_r8,6.0060e-02_r8, & + &7.4293e-02_r8,9.3548e-02_r8,9.4381e-02_r8/) + kao(:, 2, 2, 8) = (/ & + &9.3967e-04_r8,1.4205e-02_r8,2.8221e-02_r8,4.2491e-02_r8,5.7165e-02_r8,7.2616e-02_r8, & + &8.9835e-02_r8,1.1322e-01_r8,1.1408e-01_r8/) + kao(:, 3, 2, 8) = (/ & + &9.3666e-04_r8,1.6793e-02_r8,3.3453e-02_r8,5.0403e-02_r8,6.7823e-02_r8,8.6143e-02_r8, & + &1.0657e-01_r8,1.3437e-01_r8,1.3538e-01_r8/) + kao(:, 4, 2, 8) = (/ & + &9.3490e-04_r8,1.9589e-02_r8,3.9087e-02_r8,5.8901e-02_r8,7.9281e-02_r8,1.0068e-01_r8, & + &1.2458e-01_r8,1.5697e-01_r8,1.5829e-01_r8/) + kao(:, 5, 2, 8) = (/ & + &9.3255e-04_r8,2.2561e-02_r8,4.5087e-02_r8,6.7983e-02_r8,9.1508e-02_r8,1.1621e-01_r8, & + &1.4375e-01_r8,1.8108e-01_r8,1.8274e-01_r8/) + kao(:, 1, 3, 8) = (/ & + &1.9614e-03_r8,1.1299e-02_r8,1.9005e-02_r8,2.7782e-02_r8,3.7000e-02_r8,4.6522e-02_r8, & + &5.6657e-02_r8,6.9080e-02_r8,7.3508e-02_r8/) + kao(:, 2, 3, 8) = (/ & + &1.9548e-03_r8,1.2955e-02_r8,2.2891e-02_r8,3.3903e-02_r8,4.5254e-02_r8,5.6922e-02_r8, & + &6.9355e-02_r8,8.4555e-02_r8,9.0001e-02_r8/) + kao(:, 3, 3, 8) = (/ & + &1.9534e-03_r8,1.4833e-02_r8,2.7240e-02_r8,4.0599e-02_r8,5.4239e-02_r8,6.8264e-02_r8, & + &8.3194e-02_r8,1.0146e-01_r8,1.0796e-01_r8/) + kao(:, 4, 3, 8) = (/ & + &1.9479e-03_r8,1.6939e-02_r8,3.1981e-02_r8,4.7805e-02_r8,6.3918e-02_r8,8.0501e-02_r8, & + &9.8164e-02_r8,1.1980e-01_r8,1.2731e-01_r8/) + kao(:, 5, 3, 8) = (/ & + &1.9437e-03_r8,1.9215e-02_r8,3.7014e-02_r8,5.5432e-02_r8,7.4159e-02_r8,9.3422e-02_r8, & + &1.1404e-01_r8,1.3937e-01_r8,1.4780e-01_r8/) + kao(:, 1, 4, 8) = (/ & + &4.1141e-03_r8,1.2873e-02_r8,1.8872e-02_r8,2.3795e-02_r8,2.9310e-02_r8,3.5813e-02_r8, & + &4.3001e-02_r8,5.1220e-02_r8,5.6278e-02_r8/) + kao(:, 2, 4, 8) = (/ & + &4.1183e-03_r8,1.4575e-02_r8,2.1599e-02_r8,2.8253e-02_r8,3.5801e-02_r8,4.4309e-02_r8, & + &5.3363e-02_r8,6.3628e-02_r8,6.9867e-02_r8/) + kao(:, 3, 4, 8) = (/ & + &4.1349e-03_r8,1.6355e-02_r8,2.4672e-02_r8,3.3305e-02_r8,4.3074e-02_r8,5.3625e-02_r8, & + &6.4673e-02_r8,7.7228e-02_r8,8.4695e-02_r8/) + kao(:, 4, 4, 8) = (/ & + &4.1308e-03_r8,1.8173e-02_r8,2.8034e-02_r8,3.8865e-02_r8,5.0949e-02_r8,6.3606e-02_r8, & + &7.6798e-02_r8,9.1846e-02_r8,1.0056e-01_r8/) + kao(:, 5, 4, 8) = (/ & + &4.1264e-03_r8,1.9905e-02_r8,3.1676e-02_r8,4.4946e-02_r8,5.9333e-02_r8,7.4191e-02_r8, & + &8.9640e-02_r8,1.0735e-01_r8,1.1739e-01_r8/) + kao(:, 1, 5, 8) = (/ & + &7.8459e-03_r8,1.5273e-02_r8,2.0315e-02_r8,2.4490e-02_r8,2.7833e-02_r8,3.0201e-02_r8, & + &3.3378e-02_r8,3.8411e-02_r8,4.1001e-02_r8/) + kao(:, 2, 5, 8) = (/ & + &7.8747e-03_r8,1.6898e-02_r8,2.3176e-02_r8,2.8487e-02_r8,3.2405e-02_r8,3.6383e-02_r8, & + &4.1437e-02_r8,4.8316e-02_r8,5.2769e-02_r8/) + kao(:, 3, 5, 8) = (/ & + &7.8992e-03_r8,1.8661e-02_r8,2.6253e-02_r8,3.2541e-02_r8,3.7550e-02_r8,4.3266e-02_r8, & + &5.0422e-02_r8,5.9136e-02_r8,6.5527e-02_r8/) + kao(:, 4, 5, 8) = (/ & + &7.8989e-03_r8,2.0558e-02_r8,2.9408e-02_r8,3.6576e-02_r8,4.3219e-02_r8,5.0946e-02_r8, & + &6.0207e-02_r8,7.0821e-02_r8,7.8616e-02_r8/) + kao(:, 5, 5, 8) = (/ & + &7.9229e-03_r8,2.2512e-02_r8,3.2599e-02_r8,4.0913e-02_r8,4.9454e-02_r8,5.9390e-02_r8, & + &7.0729e-02_r8,8.3313e-02_r8,9.2573e-02_r8/) + kao(:, 1, 6, 8) = (/ & + &1.3755e-02_r8,2.1264e-02_r8,2.4103e-02_r8,2.5712e-02_r8,2.7798e-02_r8,2.9236e-02_r8, & + &2.9846e-02_r8,2.9593e-02_r8,2.7586e-02_r8/) + kao(:, 2, 6, 8) = (/ & + &1.3782e-02_r8,2.2999e-02_r8,2.6490e-02_r8,2.9514e-02_r8,3.2454e-02_r8,3.4496e-02_r8, & + &3.5566e-02_r8,3.7000e-02_r8,3.5132e-02_r8/) + kao(:, 3, 6, 8) = (/ & + &1.3863e-02_r8,2.4665e-02_r8,2.9042e-02_r8,3.3641e-02_r8,3.7254e-02_r8,4.0147e-02_r8, & + &4.1998e-02_r8,4.5403e-02_r8,4.4921e-02_r8/) + kao(:, 4, 6, 8) = (/ & + &1.3921e-02_r8,2.6309e-02_r8,3.1937e-02_r8,3.7874e-02_r8,4.2332e-02_r8,4.5980e-02_r8, & + &4.9161e-02_r8,5.4719e-02_r8,5.5713e-02_r8/) + kao(:, 5, 6, 8) = (/ & + &1.4010e-02_r8,2.7955e-02_r8,3.5119e-02_r8,4.2034e-02_r8,4.7545e-02_r8,5.2148e-02_r8, & + &5.7163e-02_r8,6.4833e-02_r8,6.7480e-02_r8/) + kao(:, 1, 7, 8) = (/ & + &2.4762e-02_r8,3.1775e-02_r8,3.3749e-02_r8,3.4176e-02_r8,3.3323e-02_r8,3.1060e-02_r8, & + &2.9254e-02_r8,2.6750e-02_r8,2.6287e-02_r8/) + kao(:, 2, 7, 8) = (/ & + &2.4951e-02_r8,3.3870e-02_r8,3.6729e-02_r8,3.7700e-02_r8,3.7125e-02_r8,3.5645e-02_r8, & + &3.4725e-02_r8,3.2382e-02_r8,3.2363e-02_r8/) + kao(:, 3, 7, 8) = (/ & + &2.5173e-02_r8,3.5837e-02_r8,3.9660e-02_r8,4.1206e-02_r8,4.1346e-02_r8,4.1029e-02_r8, & + &4.0471e-02_r8,3.8518e-02_r8,3.8913e-02_r8/) + kao(:, 4, 7, 8) = (/ & + &2.5363e-02_r8,3.7886e-02_r8,4.2599e-02_r8,4.5028e-02_r8,4.5616e-02_r8,4.6713e-02_r8, & + &4.6613e-02_r8,4.5204e-02_r8,4.5916e-02_r8/) + kao(:, 5, 7, 8) = (/ & + &2.5554e-02_r8,3.9913e-02_r8,4.5725e-02_r8,4.8757e-02_r8,5.0398e-02_r8,5.2532e-02_r8, & + &5.3118e-02_r8,5.2718e-02_r8,5.3341e-02_r8/) + kao(:, 1, 8, 8) = (/ & + &5.1772e-02_r8,5.6742e-02_r8,5.6311e-02_r8,5.3676e-02_r8,4.9761e-02_r8,4.4432e-02_r8, & + &3.7642e-02_r8,2.8159e-02_r8,2.5366e-02_r8/) + kao(:, 2, 8, 8) = (/ & + &5.2310e-02_r8,5.9935e-02_r8,6.0103e-02_r8,5.8243e-02_r8,5.4861e-02_r8,4.9530e-02_r8, & + &4.2560e-02_r8,3.2942e-02_r8,3.0796e-02_r8/) + kao(:, 3, 8, 8) = (/ & + &5.2803e-02_r8,6.3037e-02_r8,6.4134e-02_r8,6.2766e-02_r8,5.9645e-02_r8,5.4655e-02_r8, & + &4.7864e-02_r8,3.8688e-02_r8,3.7143e-02_r8/) + kao(:, 4, 8, 8) = (/ & + &5.3460e-02_r8,6.5918e-02_r8,6.8003e-02_r8,6.7271e-02_r8,6.4711e-02_r8,6.0132e-02_r8, & + &5.3215e-02_r8,4.4724e-02_r8,4.4005e-02_r8/) + kao(:, 5, 8, 8) = (/ & + &5.3710e-02_r8,6.8699e-02_r8,7.1633e-02_r8,7.2036e-02_r8,6.9887e-02_r8,6.5520e-02_r8, & + &5.8694e-02_r8,5.1143e-02_r8,5.1305e-02_r8/) + kao(:, 1, 9, 8) = (/ & + &2.0198e-01_r8,1.8901e-01_r8,1.7403e-01_r8,1.5566e-01_r8,1.3460e-01_r8,1.1050e-01_r8, & + &8.4423e-02_r8,5.5049e-02_r8,2.7409e-02_r8/) + kao(:, 2, 9, 8) = (/ & + &2.0495e-01_r8,1.9639e-01_r8,1.8291e-01_r8,1.6519e-01_r8,1.4305e-01_r8,1.1881e-01_r8, & + &9.2245e-02_r8,6.1787e-02_r8,3.3663e-02_r8/) + kao(:, 3, 9, 8) = (/ & + &2.0775e-01_r8,2.0359e-01_r8,1.9173e-01_r8,1.7370e-01_r8,1.5212e-01_r8,1.2752e-01_r8, & + &1.0028e-01_r8,6.8520e-02_r8,3.9556e-02_r8/) + kao(:, 4, 9, 8) = (/ & + &2.0971e-01_r8,2.1033e-01_r8,1.9959e-01_r8,1.8173e-01_r8,1.6052e-01_r8,1.3619e-01_r8, & + &1.0838e-01_r8,7.5430e-02_r8,4.6210e-02_r8/) + kao(:, 5, 9, 8) = (/ & + &2.1122e-01_r8,2.1661e-01_r8,2.0701e-01_r8,1.8977e-01_r8,1.6868e-01_r8,1.4451e-01_r8, & + &1.1695e-01_r8,8.2426e-02_r8,5.2611e-02_r8/) + kao(:, 1,10, 8) = (/ & + &8.7179e-01_r8,7.7305e-01_r8,6.7676e-01_r8,5.7800e-01_r8,4.7858e-01_r8,3.7509e-01_r8, & + &2.6780e-01_r8,1.5257e-01_r8,3.4825e-02_r8/) + kao(:, 2,10, 8) = (/ & + &8.8690e-01_r8,7.9154e-01_r8,6.9682e-01_r8,6.0089e-01_r8,5.0085e-01_r8,3.9677e-01_r8, & + &2.8510e-01_r8,1.6381e-01_r8,4.0840e-02_r8/) + kao(:, 3,10, 8) = (/ & + &8.9846e-01_r8,8.0873e-01_r8,7.1712e-01_r8,6.2211e-01_r8,5.2235e-01_r8,4.1529e-01_r8, & + &3.0033e-01_r8,1.7576e-01_r8,4.8253e-02_r8/) + kao(:, 4,10, 8) = (/ & + &9.1202e-01_r8,8.2713e-01_r8,7.3854e-01_r8,6.4399e-01_r8,5.4276e-01_r8,4.3255e-01_r8, & + &3.1463e-01_r8,1.8727e-01_r8,5.7567e-02_r8/) + kao(:, 5,10, 8) = (/ & + &9.1292e-01_r8,8.3520e-01_r8,7.5311e-01_r8,6.6058e-01_r8,5.5851e-01_r8,4.4868e-01_r8, & + &3.2919e-01_r8,1.9841e-01_r8,6.5659e-02_r8/) + kao(:, 1,11, 8) = (/ & + &1.3103e+00_r8,1.1565e+00_r8,1.0072e+00_r8,8.5492e-01_r8,7.0080e-01_r8,5.4405e-01_r8, & + &3.8288e-01_r8,2.1296e-01_r8,3.6932e-02_r8/) + kao(:, 2,11, 8) = (/ & + &1.3299e+00_r8,1.1796e+00_r8,1.0327e+00_r8,8.8125e-01_r8,7.2693e-01_r8,5.6857e-01_r8, & + &4.0335e-01_r8,2.2633e-01_r8,4.3190e-02_r8/) + kao(:, 3,11, 8) = (/ & + &1.3530e+00_r8,1.2064e+00_r8,1.0600e+00_r8,9.1131e-01_r8,7.5598e-01_r8,5.9411e-01_r8, & + &4.2265e-01_r8,2.3978e-01_r8,5.2762e-02_r8/) + kao(:, 4,11, 8) = (/ & + &1.3587e+00_r8,1.2195e+00_r8,1.0781e+00_r8,9.3079e-01_r8,7.7634e-01_r8,6.1327e-01_r8, & + &4.3892e-01_r8,2.5297e-01_r8,6.4865e-02_r8/) + kao(:, 5,11, 8) = (/ & + &1.3600e+00_r8,1.2284e+00_r8,1.0908e+00_r8,9.4457e-01_r8,7.9211e-01_r8,6.2699e-01_r8, & + &4.5262e-01_r8,2.6437e-01_r8,7.6848e-02_r8/) + kao(:, 1,12, 8) = (/ & + &1.4407e+00_r8,1.2713e+00_r8,1.1065e+00_r8,9.3835e-01_r8,7.6825e-01_r8,5.9432e-01_r8, & + &4.1638e-01_r8,2.2888e-01_r8,3.4685e-02_r8/) + kao(:, 2,12, 8) = (/ & + &1.4696e+00_r8,1.3029e+00_r8,1.1378e+00_r8,9.6981e-01_r8,7.9767e-01_r8,6.2103e-01_r8, & + &4.3779e-01_r8,2.4254e-01_r8,4.2654e-02_r8/) + kao(:, 3,12, 8) = (/ & + &1.4810e+00_r8,1.3211e+00_r8,1.1578e+00_r8,9.9148e-01_r8,8.2013e-01_r8,6.4181e-01_r8, & + &4.5466e-01_r8,2.5578e-01_r8,5.2496e-02_r8/) + kao(:, 4,12, 8) = (/ & + &1.4858e+00_r8,1.3306e+00_r8,1.1727e+00_r8,1.0074e+00_r8,8.3618e-01_r8,6.5672e-01_r8, & + &4.6743e-01_r8,2.6737e-01_r8,6.3361e-02_r8/) + kao(:, 5,12, 8) = (/ & + &1.4815e+00_r8,1.3335e+00_r8,1.1804e+00_r8,1.0190e+00_r8,8.4985e-01_r8,6.7121e-01_r8, & + &4.8121e-01_r8,2.7853e-01_r8,7.5291e-02_r8/) + kao(:, 1,13, 8) = (/ & + &1.2616e+00_r8,1.1163e+00_r8,9.7204e-01_r8,8.2547e-01_r8,6.7669e-01_r8,5.2391e-01_r8, & + &3.6673e-01_r8,2.0106e-01_r8,2.9782e-02_r8/) + kao(:, 2,13, 8) = (/ & + &1.2777e+00_r8,1.1375e+00_r8,9.9345e-01_r8,8.4804e-01_r8,6.9806e-01_r8,5.4388e-01_r8, & + &3.8298e-01_r8,2.1265e-01_r8,3.7539e-02_r8/) + kao(:, 3,13, 8) = (/ & + &1.2857e+00_r8,1.1501e+00_r8,1.0105e+00_r8,8.6538e-01_r8,7.1567e-01_r8,5.5928e-01_r8, & + &3.9596e-01_r8,2.2292e-01_r8,4.5370e-02_r8/) + kao(:, 4,13, 8) = (/ & + &1.2877e+00_r8,1.1566e+00_r8,1.0204e+00_r8,8.7739e-01_r8,7.2832e-01_r8,5.7170e-01_r8, & + &4.0727e-01_r8,2.3325e-01_r8,5.5134e-02_r8/) + kao(:, 5,13, 8) = (/ & + &1.2810e+00_r8,1.1580e+00_r8,1.0267e+00_r8,8.8778e-01_r8,7.3941e-01_r8,5.8252e-01_r8, & + &4.1760e-01_r8,2.4248e-01_r8,6.6222e-02_r8/) + kao(:, 1, 1, 9) = (/ & + &1.6209e-03_r8,5.7589e-02_r8,1.1558e-01_r8,1.7436e-01_r8,2.3438e-01_r8,2.9678e-01_r8, & + &3.6435e-01_r8,4.4557e-01_r8,4.6867e-01_r8/) + kao(:, 2, 1, 9) = (/ & + &1.6160e-03_r8,6.8254e-02_r8,1.3700e-01_r8,2.0665e-01_r8,2.7776e-01_r8,3.5160e-01_r8, & + &4.3147e-01_r8,5.2804e-01_r8,5.5543e-01_r8/) + kao(:, 3, 1, 9) = (/ & + &1.6156e-03_r8,7.9739e-02_r8,1.6004e-01_r8,2.4140e-01_r8,3.2446e-01_r8,4.1061e-01_r8, & + &5.0337e-01_r8,6.1528e-01_r8,6.4882e-01_r8/) + kao(:, 4, 1, 9) = (/ & + &1.6118e-03_r8,9.1878e-02_r8,1.8447e-01_r8,2.7828e-01_r8,3.7409e-01_r8,4.7339e-01_r8, & + &5.8011e-01_r8,7.0748e-01_r8,7.4809e-01_r8/) + kao(:, 5, 1, 9) = (/ & + &1.6027e-03_r8,1.0449e-01_r8,2.0983e-01_r8,3.1665e-01_r8,4.2579e-01_r8,5.3908e-01_r8, & + &6.6087e-01_r8,8.0485e-01_r8,8.5148e-01_r8/) + kao(:, 1, 2, 9) = (/ & + &2.5385e-03_r8,4.9947e-02_r8,1.0010e-01_r8,1.5075e-01_r8,2.0224e-01_r8,2.5529e-01_r8, & + &3.1202e-01_r8,3.8059e-01_r8,4.0436e-01_r8/) + kao(:, 2, 2, 9) = (/ & + &2.5420e-03_r8,5.9613e-02_r8,1.1949e-01_r8,1.7998e-01_r8,2.4152e-01_r8,3.0496e-01_r8, & + &3.7260e-01_r8,4.5413e-01_r8,4.8291e-01_r8/) + kao(:, 3, 2, 9) = (/ & + &2.5425e-03_r8,6.9977e-02_r8,1.4031e-01_r8,2.1138e-01_r8,2.8370e-01_r8,3.5840e-01_r8, & + &4.3825e-01_r8,5.3358e-01_r8,5.6726e-01_r8/) + kao(:, 4, 2, 9) = (/ & + &2.5349e-03_r8,8.0938e-02_r8,1.6229e-01_r8,2.4456e-01_r8,3.2834e-01_r8,4.1497e-01_r8, & + &5.0769e-01_r8,6.1900e-01_r8,6.5654e-01_r8/) + kao(:, 5, 2, 9) = (/ & + &2.5236e-03_r8,9.2377e-02_r8,1.8522e-01_r8,2.7915e-01_r8,3.7480e-01_r8,4.7381e-01_r8, & + &5.8018e-01_r8,7.0850e-01_r8,7.4944e-01_r8/) + kao(:, 1, 3, 9) = (/ & + &5.2884e-03_r8,4.1358e-02_r8,8.2480e-02_r8,1.2391e-01_r8,1.6574e-01_r8,2.0832e-01_r8, & + &2.5278e-01_r8,3.0394e-01_r8,3.3126e-01_r8/) + kao(:, 2, 3, 9) = (/ & + &5.3098e-03_r8,4.9746e-02_r8,9.9365e-02_r8,1.4928e-01_r8,1.9972e-01_r8,2.5111e-01_r8, & + &3.0480e-01_r8,3.6676e-01_r8,3.9919e-01_r8/) + kao(:, 3, 3, 9) = (/ & + &5.3133e-03_r8,5.8864e-02_r8,1.1765e-01_r8,1.7679e-01_r8,2.3653e-01_r8,2.9742e-01_r8, & + &3.6115e-01_r8,4.3493e-01_r8,4.7279e-01_r8/) + kao(:, 4, 3, 9) = (/ & + &5.3184e-03_r8,6.8570e-02_r8,1.3708e-01_r8,2.0601e-01_r8,2.7562e-01_r8,3.4665e-01_r8, & + &4.2100e-01_r8,5.0744e-01_r8,5.5094e-01_r8/) + kao(:, 5, 3, 9) = (/ & + &5.2937e-03_r8,7.8913e-02_r8,1.5776e-01_r8,2.3709e-01_r8,3.1721e-01_r8,3.9889e-01_r8, & + &4.8431e-01_r8,5.8366e-01_r8,6.3409e-01_r8/) + kao(:, 1, 4, 9) = (/ & + &1.1189e-02_r8,3.7631e-02_r8,6.6855e-02_r8,9.9420e-02_r8,1.3264e-01_r8,1.6622e-01_r8, & + &2.0064e-01_r8,2.3828e-01_r8,2.6479e-01_r8/) + kao(:, 2, 4, 9) = (/ & + &1.1235e-02_r8,4.3836e-02_r8,8.1298e-02_r8,1.2151e-01_r8,1.6212e-01_r8,2.0319e-01_r8, & + &2.4526e-01_r8,2.9131e-01_r8,3.2370e-01_r8/) + kao(:, 3, 4, 9) = (/ & + &1.1256e-02_r8,5.0846e-02_r8,9.7157e-02_r8,1.4551e-01_r8,1.9420e-01_r8,2.4340e-01_r8, & + &2.9384e-01_r8,3.4897e-01_r8,3.8783e-01_r8/) + kao(:, 4, 4, 9) = (/ & + &1.1233e-02_r8,5.8695e-02_r8,1.1439e-01_r8,1.7147e-01_r8,2.2883e-01_r8,2.8678e-01_r8, & + &3.4608e-01_r8,4.1077e-01_r8,4.5705e-01_r8/) + kao(:, 5, 4, 9) = (/ & + &1.1193e-02_r8,6.7408e-02_r8,1.3290e-01_r8,1.9926e-01_r8,2.6591e-01_r8,3.3325e-01_r8, & + &4.0214e-01_r8,4.7714e-01_r8,5.3115e-01_r8/) + kao(:, 1, 5, 9) = (/ & + &2.1456e-02_r8,4.5196e-02_r8,6.1958e-02_r8,8.2153e-02_r8,1.0545e-01_r8,1.3112e-01_r8, & + &1.5772e-01_r8,1.8584e-01_r8,2.0874e-01_r8/) + kao(:, 2, 5, 9) = (/ & + &2.1627e-02_r8,4.9543e-02_r8,7.2420e-02_r8,9.9628e-02_r8,1.3042e-01_r8,1.6274e-01_r8, & + &1.9580e-01_r8,2.3075e-01_r8,2.5926e-01_r8/) + kao(:, 3, 5, 9) = (/ & + &2.1648e-02_r8,5.4430e-02_r8,8.4381e-02_r8,1.1963e-01_r8,1.5816e-01_r8,1.9769e-01_r8, & + &2.3786e-01_r8,2.8024e-01_r8,3.1505e-01_r8/) + kao(:, 4, 5, 9) = (/ & + &2.1655e-02_r8,5.9909e-02_r8,9.8020e-02_r8,1.4216e-01_r8,1.8871e-01_r8,2.3596e-01_r8, & + &2.8391e-01_r8,3.3439e-01_r8,3.7619e-01_r8/) + kao(:, 5, 5, 9) = (/ & + &2.1575e-02_r8,6.6071e-02_r8,1.1341e-01_r8,1.6675e-01_r8,2.2186e-01_r8,2.7746e-01_r8, & + &3.3388e-01_r8,3.9317e-01_r8,4.4246e-01_r8/) + kao(:, 1, 6, 9) = (/ & + &3.8314e-02_r8,5.9481e-02_r8,7.1457e-02_r8,8.1684e-02_r8,9.1784e-02_r8,1.0487e-01_r8, & + &1.2171e-01_r8,1.4213e-01_r8,1.5860e-01_r8/) + kao(:, 2, 6, 9) = (/ & + &3.8611e-02_r8,6.4337e-02_r8,7.9461e-02_r8,9.3850e-02_r8,1.0993e-01_r8,1.2967e-01_r8, & + &1.5327e-01_r8,1.7946e-01_r8,2.0255e-01_r8/) + kao(:, 3, 6, 9) = (/ & + &3.8670e-02_r8,6.9241e-02_r8,8.8613e-02_r8,1.0808e-01_r8,1.3134e-01_r8,1.5836e-01_r8, & + &1.8890e-01_r8,2.2142e-01_r8,2.5002e-01_r8/) + kao(:, 4, 6, 9) = (/ & + &3.8675e-02_r8,7.4319e-02_r8,9.8760e-02_r8,1.2484e-01_r8,1.5591e-01_r8,1.9105e-01_r8, & + &2.2866e-01_r8,2.6805e-01_r8,3.0304e-01_r8/) + kao(:, 5, 6, 9) = (/ & + &3.8508e-02_r8,7.9526e-02_r8,1.0987e-01_r8,1.4404e-01_r8,1.8357e-01_r8,2.2696e-01_r8, & + &2.7218e-01_r8,3.1912e-01_r8,3.6102e-01_r8/) + kao(:, 1, 7, 9) = (/ & + &7.2084e-02_r8,8.8512e-02_r8,9.7172e-02_r8,1.0090e-01_r8,1.0168e-01_r8,1.0216e-01_r8, & + &1.0271e-01_r8,1.0842e-01_r8,1.0501e-01_r8/) + kao(:, 2, 7, 9) = (/ & + &7.2564e-02_r8,9.4711e-02_r8,1.0583e-01_r8,1.1196e-01_r8,1.1550e-01_r8,1.2008e-01_r8, & + &1.2583e-01_r8,1.3849e-01_r8,1.4021e-01_r8/) + kao(:, 3, 7, 9) = (/ & + &7.2730e-02_r8,1.0095e-01_r8,1.1490e-01_r8,1.2380e-01_r8,1.3141e-01_r8,1.4065e-01_r8, & + &1.5344e-01_r8,1.7335e-01_r8,1.8125e-01_r8/) + kao(:, 4, 7, 9) = (/ & + &7.2941e-02_r8,1.0706e-01_r8,1.2422e-01_r8,1.3654e-01_r8,1.5005e-01_r8,1.6497e-01_r8, & + &1.8541e-01_r8,2.1284e-01_r8,2.2809e-01_r8/) + kao(:, 5, 7, 9) = (/ & + &7.3026e-02_r8,1.1297e-01_r8,1.3379e-01_r8,1.5116e-01_r8,1.7068e-01_r8,1.9286e-01_r8, & + &2.2139e-01_r8,2.5637e-01_r8,2.7993e-01_r8/) + kao(:, 1, 8, 9) = (/ & + &1.6179e-01_r8,1.6443e-01_r8,1.6310e-01_r8,1.5765e-01_r8,1.4868e-01_r8,1.3533e-01_r8, & + &1.1770e-01_r8,9.8380e-02_r8,8.1836e-02_r8/) + kao(:, 2, 8, 9) = (/ & + &1.6423e-01_r8,1.7218e-01_r8,1.7516e-01_r8,1.7171e-01_r8,1.6374e-01_r8,1.5153e-01_r8, & + &1.3534e-01_r8,1.1999e-01_r8,1.0061e-01_r8/) + kao(:, 3, 8, 9) = (/ & + &1.6654e-01_r8,1.7965e-01_r8,1.8707e-01_r8,1.8587e-01_r8,1.7956e-01_r8,1.6926e-01_r8, & + &1.5537e-01_r8,1.4544e-01_r8,1.2284e-01_r8/) + kao(:, 4, 8, 9) = (/ & + &1.6762e-01_r8,1.8741e-01_r8,1.9894e-01_r8,2.0043e-01_r8,1.9638e-01_r8,1.8821e-01_r8, & + &1.7907e-01_r8,1.7570e-01_r8,1.5659e-01_r8/) + kao(:, 5, 8, 9) = (/ & + &1.6808e-01_r8,1.9570e-01_r8,2.1084e-01_r8,2.1493e-01_r8,2.1406e-01_r8,2.0908e-01_r8, & + &2.0616e-01_r8,2.1009e-01_r8,1.9730e-01_r8/) + kao(:, 1, 9, 9) = (/ & + &7.0428e-01_r8,6.3434e-01_r8,5.6644e-01_r8,4.9559e-01_r8,4.2070e-01_r8,3.4143e-01_r8, & + &2.6063e-01_r8,1.7246e-01_r8,1.1446e-01_r8/) + kao(:, 2, 9, 9) = (/ & + &7.1533e-01_r8,6.5148e-01_r8,5.8487e-01_r8,5.1694e-01_r8,4.4379e-01_r8,3.6693e-01_r8, & + &2.8562e-01_r8,1.9355e-01_r8,1.3717e-01_r8/) + kao(:, 3, 9, 9) = (/ & + &7.2105e-01_r8,6.6501e-01_r8,6.0595e-01_r8,5.4025e-01_r8,4.6705e-01_r8,3.9267e-01_r8, & + &3.1101e-01_r8,2.1648e-01_r8,1.6351e-01_r8/) + kao(:, 4, 9, 9) = (/ & + &7.2262e-01_r8,6.7430e-01_r8,6.2376e-01_r8,5.6249e-01_r8,4.9295e-01_r8,4.1839e-01_r8, & + &3.3764e-01_r8,2.4119e-01_r8,1.9114e-01_r8/) + kao(:, 5, 9, 9) = (/ & + &7.2252e-01_r8,6.8406e-01_r8,6.4078e-01_r8,5.8400e-01_r8,5.1738e-01_r8,4.4614e-01_r8, & + &3.6505e-01_r8,2.6763e-01_r8,2.2362e-01_r8/) + kao(:, 1,10, 9) = (/ & + &3.3754e+00_r8,2.9579e+00_r8,2.5567e+00_r8,2.1598e+00_r8,1.7623e+00_r8,1.3527e+00_r8, & + &9.4464e-01_r8,5.2414e-01_r8,1.6022e-01_r8/) + kao(:, 2,10, 9) = (/ & + &3.4121e+00_r8,2.9947e+00_r8,2.5993e+00_r8,2.2033e+00_r8,1.8038e+00_r8,1.3952e+00_r8, & + &9.8851e-01_r8,5.5797e-01_r8,1.9922e-01_r8/) + kao(:, 3,10, 9) = (/ & + &3.4354e+00_r8,3.0219e+00_r8,2.6345e+00_r8,2.2476e+00_r8,1.8449e+00_r8,1.4451e+00_r8, & + &1.0317e+00_r8,5.9234e-01_r8,2.4180e-01_r8/) + kao(:, 4,10, 9) = (/ & + &3.4369e+00_r8,3.0367e+00_r8,2.6577e+00_r8,2.2740e+00_r8,1.8821e+00_r8,1.4871e+00_r8, & + &1.0728e+00_r8,6.2615e-01_r8,2.8291e-01_r8/) + kao(:, 5,10, 9) = (/ & + &3.4461e+00_r8,3.0546e+00_r8,2.6839e+00_r8,2.3057e+00_r8,1.9262e+00_r8,1.5287e+00_r8, & + &1.1134e+00_r8,6.5955e-01_r8,3.3010e-01_r8/) + kao(:, 1,11, 9) = (/ & + &5.5731e+00_r8,4.8785e+00_r8,4.1979e+00_r8,3.5322e+00_r8,2.8619e+00_r8,2.1883e+00_r8, & + &1.5051e+00_r8,8.1479e-01_r8,1.7197e-01_r8/) + kao(:, 2,11, 9) = (/ & + &5.6124e+00_r8,4.9158e+00_r8,4.2449e+00_r8,3.5793e+00_r8,2.9170e+00_r8,2.2388e+00_r8, & + &1.5568e+00_r8,8.5687e-01_r8,2.2531e-01_r8/) + kao(:, 3,11, 9) = (/ & + &5.6253e+00_r8,4.9334e+00_r8,4.2755e+00_r8,3.6196e+00_r8,2.9577e+00_r8,2.2787e+00_r8, & + &1.6022e+00_r8,8.9680e-01_r8,2.6360e-01_r8/) + kao(:, 4,11, 9) = (/ & + &5.6351e+00_r8,4.9513e+00_r8,4.3021e+00_r8,3.6565e+00_r8,2.9923e+00_r8,2.3311e+00_r8, & + &1.6513e+00_r8,9.3728e-01_r8,3.0681e-01_r8/) + kao(:, 5,11, 9) = (/ & + &5.6511e+00_r8,4.9808e+00_r8,4.3475e+00_r8,3.7008e+00_r8,3.0483e+00_r8,2.3866e+00_r8, & + &1.7012e+00_r8,9.7887e-01_r8,3.4951e-01_r8/) + kao(:, 1,12, 9) = (/ & + &6.6833e+00_r8,5.8503e+00_r8,5.0320e+00_r8,4.2291e+00_r8,3.4220e+00_r8,2.6133e+00_r8, & + &1.7900e+00_r8,9.6260e-01_r8,1.7445e-01_r8/) + kao(:, 2,12, 9) = (/ & + &6.6977e+00_r8,5.8665e+00_r8,5.0629e+00_r8,4.2649e+00_r8,3.4722e+00_r8,2.6560e+00_r8, & + &1.8378e+00_r8,1.0034e+00_r8,2.1910e-01_r8/) + kao(:, 3,12, 9) = (/ & + &6.7112e+00_r8,5.8830e+00_r8,5.0943e+00_r8,4.3071e+00_r8,3.5122e+00_r8,2.7000e+00_r8, & + &1.8863e+00_r8,1.0455e+00_r8,2.5420e-01_r8/) + kao(:, 4,12, 9) = (/ & + &6.7306e+00_r8,5.9135e+00_r8,5.1333e+00_r8,4.3624e+00_r8,3.5635e+00_r8,2.7641e+00_r8, & + &1.9469e+00_r8,1.0906e+00_r8,2.9618e-01_r8/) + kao(:, 5,12, 9) = (/ & + &6.7198e+00_r8,5.9182e+00_r8,5.1572e+00_r8,4.3874e+00_r8,3.6068e+00_r8,2.8158e+00_r8, & + &1.9979e+00_r8,1.1364e+00_r8,3.4172e-01_r8/) + kao(:, 1,13, 9) = (/ & + &6.2228e+00_r8,5.4483e+00_r8,4.6948e+00_r8,3.9489e+00_r8,3.2053e+00_r8,2.4477e+00_r8, & + &1.6826e+00_r8,9.0899e-01_r8,1.6340e-01_r8/) + kao(:, 2,13, 9) = (/ & + &6.2479e+00_r8,5.4750e+00_r8,4.7365e+00_r8,3.9942e+00_r8,3.2532e+00_r8,2.4916e+00_r8, & + &1.7319e+00_r8,9.4656e-01_r8,1.9164e-01_r8/) + kao(:, 3,13, 9) = (/ & + &6.2720e+00_r8,5.5063e+00_r8,4.7748e+00_r8,4.0523e+00_r8,3.3026e+00_r8,2.5508e+00_r8, & + &1.7859e+00_r8,9.9108e-01_r8,2.3050e-01_r8/) + kao(:, 4,13, 9) = (/ & + &6.2663e+00_r8,5.5165e+00_r8,4.8016e+00_r8,4.0858e+00_r8,3.3448e+00_r8,2.6010e+00_r8, & + &1.8364e+00_r8,1.0337e+00_r8,2.6420e-01_r8/) + kao(:, 5,13, 9) = (/ & + &6.2869e+00_r8,5.5494e+00_r8,4.8492e+00_r8,4.1318e+00_r8,3.4036e+00_r8,2.6598e+00_r8, & + &1.8865e+00_r8,1.0759e+00_r8,2.9687e-01_r8/) + kao(:, 1, 1,10) = (/ & + &2.7731e-03_r8,1.5625e-01_r8,3.1254e-01_r8,4.6910e-01_r8,6.2583e-01_r8,7.8249e-01_r8, & + &9.3706e-01_r8,1.0845e+00_r8,1.2516e+00_r8/) + kao(:, 2, 1,10) = (/ & + &2.6994e-03_r8,1.8576e-01_r8,3.7148e-01_r8,5.5698e-01_r8,7.4226e-01_r8,9.2683e-01_r8, & + &1.1083e+00_r8,1.2874e+00_r8,1.4844e+00_r8/) + kao(:, 3, 1,10) = (/ & + &2.5977e-03_r8,2.1688e-01_r8,4.3344e-01_r8,6.4957e-01_r8,8.6528e-01_r8,1.0791e+00_r8, & + &1.2881e+00_r8,1.4959e+00_r8,1.7305e+00_r8/) + kao(:, 4, 1,10) = (/ & + &2.4994e-03_r8,2.5005e-01_r8,4.9954e-01_r8,7.4789e-01_r8,9.9444e-01_r8,1.2373e+00_r8, & + &1.4746e+00_r8,1.7076e+00_r8,1.9888e+00_r8/) + kao(:, 5, 1,10) = (/ & + &2.4443e-03_r8,2.8623e-01_r8,5.7132e-01_r8,8.5454e-01_r8,1.1344e+00_r8,1.4080e+00_r8, & + &1.6698e+00_r8,1.9238e+00_r8,2.2687e+00_r8/) + kao(:, 1, 2,10) = (/ & + &4.6033e-03_r8,1.4235e-01_r8,2.8494e-01_r8,4.2818e-01_r8,5.7234e-01_r8,7.1833e-01_r8, & + &8.6574e-01_r8,1.0139e+00_r8,1.1445e+00_r8/) + kao(:, 2, 2,10) = (/ & + &4.4279e-03_r8,1.7116e-01_r8,3.4236e-01_r8,5.1392e-01_r8,6.8612e-01_r8,8.5990e-01_r8, & + &1.0377e+00_r8,1.2137e+00_r8,1.3721e+00_r8/) + kao(:, 3, 2,10) = (/ & + &4.2606e-03_r8,2.0315e-01_r8,4.0616e-01_r8,6.0913e-01_r8,8.1201e-01_r8,1.0152e+00_r8, & + &1.2192e+00_r8,1.4256e+00_r8,1.6238e+00_r8/) + kao(:, 4, 2,10) = (/ & + &4.1205e-03_r8,2.3773e-01_r8,4.7526e-01_r8,7.1252e-01_r8,9.4929e-01_r8,1.1850e+00_r8, & + &1.4175e+00_r8,1.6433e+00_r8,1.8984e+00_r8/) + kao(:, 5, 2,10) = (/ & + &4.0494e-03_r8,2.7547e-01_r8,5.5055e-01_r8,8.2539e-01_r8,1.0993e+00_r8,1.3710e+00_r8, & + &1.6368e+00_r8,1.8772e+00_r8,2.1984e+00_r8/) + kao(:, 1, 3,10) = (/ & + &1.0161e-02_r8,1.2214e-01_r8,2.4424e-01_r8,3.6667e-01_r8,4.8955e-01_r8,6.1355e-01_r8, & + &7.4009e-01_r8,8.7555e-01_r8,9.7887e-01_r8/) + kao(:, 2, 3,10) = (/ & + &9.8188e-03_r8,1.5023e-01_r8,3.0029e-01_r8,4.5055e-01_r8,6.0115e-01_r8,7.5236e-01_r8, & + &9.0544e-01_r8,1.0662e+00_r8,1.2020e+00_r8/) + kao(:, 3, 3,10) = (/ & + &9.4977e-03_r8,1.8146e-01_r8,3.6272e-01_r8,5.4423e-01_r8,7.2598e-01_r8,9.0829e-01_r8, & + &1.0912e+00_r8,1.2774e+00_r8,1.4517e+00_r8/) + kao(:, 4, 3,10) = (/ & + &9.2658e-03_r8,2.1540e-01_r8,4.3072e-01_r8,6.4627e-01_r8,8.6225e-01_r8,1.0787e+00_r8, & + &1.2961e+00_r8,1.5118e+00_r8,1.7242e+00_r8/) + kao(:, 5, 3,10) = (/ & + &9.2390e-03_r8,2.5102e-01_r8,5.0193e-01_r8,7.5312e-01_r8,1.0052e+00_r8,1.2582e+00_r8, & + &1.5132e+00_r8,1.7682e+00_r8,2.0100e+00_r8/) + kao(:, 1, 4,10) = (/ & + &2.2805e-02_r8,1.0395e-01_r8,2.0752e-01_r8,3.1119e-01_r8,4.1502e-01_r8,5.1909e-01_r8, & + &6.2381e-01_r8,7.3100e-01_r8,8.2961e-01_r8/) + kao(:, 2, 4,10) = (/ & + &2.2222e-02_r8,1.2866e-01_r8,2.5687e-01_r8,3.8520e-01_r8,5.1380e-01_r8,6.4273e-01_r8, & + &7.7289e-01_r8,9.0648e-01_r8,1.0271e+00_r8/) + kao(:, 3, 4,10) = (/ & + &2.1664e-02_r8,1.5642e-01_r8,3.1238e-01_r8,4.6876e-01_r8,6.2523e-01_r8,7.8254e-01_r8, & + &9.4140e-01_r8,1.1052e+00_r8,1.2499e+00_r8/) + kao(:, 4, 4,10) = (/ & + &2.1586e-02_r8,1.8661e-01_r8,3.7283e-01_r8,5.5940e-01_r8,7.4664e-01_r8,9.3462e-01_r8, & + &1.1258e+00_r8,1.3254e+00_r8,1.4927e+00_r8/) + kao(:, 5, 4,10) = (/ & + &2.1462e-02_r8,2.1863e-01_r8,4.3680e-01_r8,6.5519e-01_r8,8.7456e-01_r8,1.0957e+00_r8, & + &1.3203e+00_r8,1.5569e+00_r8,1.7484e+00_r8/) + kao(:, 1, 5,10) = (/ & + &4.7130e-02_r8,9.3953e-02_r8,1.7393e-01_r8,2.6053e-01_r8,3.4731e-01_r8,4.3431e-01_r8, & + &5.2182e-01_r8,6.1134e-01_r8,6.9380e-01_r8/) + kao(:, 2, 5,10) = (/ & + &4.5557e-02_r8,1.1245e-01_r8,2.1773e-01_r8,3.2619e-01_r8,4.3487e-01_r8,5.4373e-01_r8, & + &6.5319e-01_r8,7.6497e-01_r8,8.6883e-01_r8/) + kao(:, 3, 5,10) = (/ & + &4.5179e-02_r8,1.3419e-01_r8,2.6606e-01_r8,3.9876e-01_r8,5.3167e-01_r8,6.6490e-01_r8, & + &7.9898e-01_r8,9.3637e-01_r8,1.0624e+00_r8/) + kao(:, 4, 5,10) = (/ & + &4.5058e-02_r8,1.5943e-01_r8,3.1786e-01_r8,4.7639e-01_r8,6.3534e-01_r8,7.9462e-01_r8, & + &9.5569e-01_r8,1.1218e+00_r8,1.2696e+00_r8/) + kao(:, 5, 5,10) = (/ & + &4.5124e-02_r8,1.8659e-01_r8,3.7199e-01_r8,5.5748e-01_r8,7.4317e-01_r8,9.2965e-01_r8, & + &1.1179e+00_r8,1.3144e+00_r8,1.4843e+00_r8/) + kao(:, 1, 6,10) = (/ & + &9.1822e-02_r8,1.2595e-01_r8,1.5650e-01_r8,2.1453e-01_r8,2.8383e-01_r8,3.5468e-01_r8, & + &4.2569e-01_r8,4.9790e-01_r8,5.6600e-01_r8/) + kao(:, 2, 6,10) = (/ & + &9.0834e-02_r8,1.3514e-01_r8,1.8905e-01_r8,2.7114e-01_r8,3.6116e-01_r8,4.5123e-01_r8, & + &5.4153e-01_r8,6.3330e-01_r8,7.2013e-01_r8/) + kao(:, 3, 6,10) = (/ & + &9.0336e-02_r8,1.4401e-01_r8,2.2730e-01_r8,3.3603e-01_r8,4.4738e-01_r8,5.5884e-01_r8, & + &6.7092e-01_r8,7.8481e-01_r8,8.9194e-01_r8/) + kao(:, 4, 6,10) = (/ & + &9.0439e-02_r8,1.5770e-01_r8,2.7084e-01_r8,4.0445e-01_r8,5.3847e-01_r8,6.7263e-01_r8, & + &8.0760e-01_r8,9.4541e-01_r8,1.0734e+00_r8/) + kao(:, 5, 6,10) = (/ & + &8.9534e-02_r8,1.7535e-01_r8,3.1878e-01_r8,4.7665e-01_r8,6.3445e-01_r8,7.9249e-01_r8, & + &9.5149e-01_r8,1.1135e+00_r8,1.2646e+00_r8/) + kao(:, 1, 7,10) = (/ & + &1.8704e-01_r8,2.0782e-01_r8,2.1870e-01_r8,2.2895e-01_r8,2.4473e-01_r8,2.8566e-01_r8, & + &3.3903e-01_r8,3.9559e-01_r8,4.4999e-01_r8/) + kao(:, 2, 7,10) = (/ & + &1.8532e-01_r8,2.1563e-01_r8,2.3939e-01_r8,2.5636e-01_r8,3.0272e-01_r8,3.6581e-01_r8, & + &4.3811e-01_r8,5.1140e-01_r8,5.8167e-01_r8/) + kao(:, 3, 7,10) = (/ & + &1.8680e-01_r8,2.2377e-01_r8,2.5927e-01_r8,2.9855e-01_r8,3.7097e-01_r8,4.5865e-01_r8, & + &5.4953e-01_r8,6.4162e-01_r8,7.2947e-01_r8/) + kao(:, 4, 7,10) = (/ & + &1.8310e-01_r8,2.3512e-01_r8,2.8042e-01_r8,3.5020e-01_r8,4.4840e-01_r8,5.5852e-01_r8, & + &6.6925e-01_r8,7.8169e-01_r8,8.8834e-01_r8/) + kao(:, 5, 7,10) = (/ & + &1.7882e-01_r8,2.4826e-01_r8,3.0849e-01_r8,4.0772e-01_r8,5.3530e-01_r8,6.6727e-01_r8, & + &7.9969e-01_r8,9.3357e-01_r8,1.0615e+00_r8/) + kao(:, 1, 8,10) = (/ & + &4.1112e-01_r8,4.0974e-01_r8,4.1065e-01_r8,3.9316e-01_r8,3.5874e-01_r8,3.2789e-01_r8, & + &2.9581e-01_r8,3.0764e-01_r8,1.9137e-01_r8/) + kao(:, 2, 8,10) = (/ & + &4.0366e-01_r8,4.2457e-01_r8,4.2635e-01_r8,4.1703e-01_r8,3.9720e-01_r8,3.6880e-01_r8, & + &3.6253e-01_r8,4.0327e-01_r8,3.4592e-01_r8/) + kao(:, 3, 8,10) = (/ & + &3.8607e-01_r8,4.4207e-01_r8,4.4571e-01_r8,4.4555e-01_r8,4.3797e-01_r8,4.1894e-01_r8, & + &4.4727e-01_r8,5.1245e-01_r8,5.5117e-01_r8/) + kao(:, 4, 8,10) = (/ & + &3.7227e-01_r8,4.5775e-01_r8,4.6855e-01_r8,4.7950e-01_r8,4.7625e-01_r8,4.8559e-01_r8, & + &5.4513e-01_r8,6.3288e-01_r8,7.1148e-01_r8/) + kao(:, 5, 8,10) = (/ & + &3.6637e-01_r8,4.6773e-01_r8,4.9188e-01_r8,5.1329e-01_r8,5.2260e-01_r8,5.7072e-01_r8, & + &6.6113e-01_r8,7.6991e-01_r8,8.6824e-01_r8/) + kao(:, 1, 9,10) = (/ & + &1.5096e+00_r8,1.3467e+00_r8,1.2191e+00_r8,1.0959e+00_r8,9.8221e-01_r8,8.6433e-01_r8, & + &6.8915e-01_r8,4.5155e-01_r8,2.5455e-01_r8/) + kao(:, 2, 9,10) = (/ & + &1.4729e+00_r8,1.3283e+00_r8,1.2484e+00_r8,1.1515e+00_r8,1.0570e+00_r8,9.2603e-01_r8, & + &7.4690e-01_r8,5.0470e-01_r8,3.4249e-01_r8/) + kao(:, 3, 9,10) = (/ & + &1.4533e+00_r8,1.3348e+00_r8,1.2453e+00_r8,1.1987e+00_r8,1.1351e+00_r8,9.9543e-01_r8, & + &8.1023e-01_r8,5.6196e-01_r8,4.0591e-01_r8/) + kao(:, 4, 9,10) = (/ & + &1.4744e+00_r8,1.3676e+00_r8,1.2850e+00_r8,1.2602e+00_r8,1.1957e+00_r8,1.0697e+00_r8, & + &8.6704e-01_r8,6.2711e-01_r8,4.8211e-01_r8/) + kao(:, 5, 9,10) = (/ & + &1.4999e+00_r8,1.4091e+00_r8,1.3355e+00_r8,1.3264e+00_r8,1.2721e+00_r8,1.1339e+00_r8, & + &9.2252e-01_r8,7.1025e-01_r8,5.3091e-01_r8/) + kao(:, 1,10,10) = (/ & + &7.2829e+00_r8,6.3687e+00_r8,5.4628e+00_r8,4.5827e+00_r8,3.6816e+00_r8,2.8784e+00_r8, & + &1.9461e+00_r8,1.1228e+00_r8,2.9615e-01_r8/) + kao(:, 2,10,10) = (/ & + &7.2567e+00_r8,6.3523e+00_r8,5.5013e+00_r8,4.6178e+00_r8,3.8060e+00_r8,2.8925e+00_r8, & + &1.9877e+00_r8,1.2045e+00_r8,5.0840e-01_r8/) + kao(:, 3,10,10) = (/ & + &7.3526e+00_r8,6.4384e+00_r8,5.5471e+00_r8,4.6686e+00_r8,3.8188e+00_r8,2.9106e+00_r8, & + &2.0584e+00_r8,1.3182e+00_r8,5.8969e-01_r8/) + kao(:, 4,10,10) = (/ & + &7.6517e+00_r8,6.6965e+00_r8,5.8098e+00_r8,4.9129e+00_r8,3.9609e+00_r8,3.0608e+00_r8, & + &2.1952e+00_r8,1.4642e+00_r8,7.2061e-01_r8/) + kao(:, 5,10,10) = (/ & + &7.6682e+00_r8,6.7495e+00_r8,5.8665e+00_r8,4.9992e+00_r8,4.0971e+00_r8,3.1895e+00_r8, & + &2.3244e+00_r8,1.6171e+00_r8,8.0277e-01_r8/) + kao(:, 1,11,10) = (/ & + &1.2863e+01_r8,1.1253e+01_r8,9.6455e+00_r8,8.0559e+00_r8,6.4984e+00_r8,4.9709e+00_r8, & + &3.3831e+00_r8,1.7991e+00_r8,3.6644e-01_r8/) + kao(:, 2,11,10) = (/ & + &1.3151e+01_r8,1.1511e+01_r8,9.8627e+00_r8,8.2765e+00_r8,6.6703e+00_r8,5.1195e+00_r8, & + &3.4235e+00_r8,1.8440e+00_r8,4.6729e-01_r8/) + kao(:, 3,11,10) = (/ & + &1.3385e+01_r8,1.1711e+01_r8,1.0081e+01_r8,8.4279e+00_r8,6.8536e+00_r8,5.2620e+00_r8, & + &3.6394e+00_r8,1.9452e+00_r8,7.7574e-01_r8/) + kao(:, 4,11,10) = (/ & + &1.3506e+01_r8,1.1818e+01_r8,1.0183e+01_r8,8.6029e+00_r8,7.0409e+00_r8,5.3665e+00_r8, & + &3.7651e+00_r8,2.0591e+00_r8,8.8231e-01_r8/) + kao(:, 5,11,10) = (/ & + &1.3392e+01_r8,1.1719e+01_r8,1.0115e+01_r8,8.6680e+00_r8,7.0525e+00_r8,5.5043e+00_r8, & + &3.9029e+00_r8,2.2010e+00_r8,9.9688e-01_r8/) + kao(:, 1,12,10) = (/ & + &1.6670e+01_r8,1.4588e+01_r8,1.2501e+01_r8,1.0421e+01_r8,8.3941e+00_r8,6.4270e+00_r8, & + &4.3660e+00_r8,2.2934e+00_r8,3.9405e-01_r8/) + kao(:, 2,12,10) = (/ & + &1.7105e+01_r8,1.4960e+01_r8,1.2826e+01_r8,1.0751e+01_r8,8.6199e+00_r8,6.6739e+00_r8, & + &4.5154e+00_r8,2.4126e+00_r8,5.4759e-01_r8/) + kao(:, 3,12,10) = (/ & + &1.7307e+01_r8,1.5147e+01_r8,1.3016e+01_r8,1.0902e+01_r8,8.9354e+00_r8,6.8220e+00_r8, & + &4.7181e+00_r8,2.5631e+00_r8,8.3787e-01_r8/) + kao(:, 4,12,10) = (/ & + &1.7279e+01_r8,1.5121e+01_r8,1.3042e+01_r8,1.0948e+01_r8,8.9655e+00_r8,6.8546e+00_r8, & + &4.7965e+00_r8,2.6658e+00_r8,9.5310e-01_r8/) + kao(:, 5,12,10) = (/ & + &1.7622e+01_r8,1.5423e+01_r8,1.3295e+01_r8,1.1391e+01_r8,9.1951e+00_r8,7.1021e+00_r8, & + &4.9630e+00_r8,2.7853e+00_r8,1.0381e+00_r8/) + kao(:, 1,13,10) = (/ & + &1.7285e+01_r8,1.5124e+01_r8,1.2963e+01_r8,1.0843e+01_r8,8.6958e+00_r8,6.7399e+00_r8, & + &4.5324e+00_r8,2.3893e+00_r8,3.8223e-01_r8/) + kao(:, 2,13,10) = (/ & + &1.7394e+01_r8,1.5220e+01_r8,1.3045e+01_r8,1.0933e+01_r8,8.8783e+00_r8,6.8319e+00_r8, & + &4.6535e+00_r8,2.5278e+00_r8,6.6322e-01_r8/) + kao(:, 3,13,10) = (/ & + &1.7534e+01_r8,1.5350e+01_r8,1.3222e+01_r8,1.1038e+01_r8,9.1270e+00_r8,6.8978e+00_r8, & + &4.7818e+00_r8,2.6214e+00_r8,7.3123e-01_r8/) + kao(:, 4,13,10) = (/ & + &1.7891e+01_r8,1.5660e+01_r8,1.3479e+01_r8,1.1400e+01_r8,9.3159e+00_r8,7.0998e+00_r8, & + &4.9577e+00_r8,2.7354e+00_r8,8.9654e-01_r8/) + kao(:, 5,13,10) = (/ & + &1.8019e+01_r8,1.5767e+01_r8,1.3610e+01_r8,1.1614e+01_r8,9.4166e+00_r8,7.3122e+00_r8, & + &5.1530e+00_r8,2.8785e+00_r8,1.0692e+00_r8/) + kao(:, 1, 1,11) = (/ & + &3.1711e-03_r8,2.2841e-01_r8,4.5620e-01_r8,6.8299e-01_r8,9.0802e-01_r8,1.1291e+00_r8, & + &1.3398e+00_r8,1.4993e+00_r8,1.8159e+00_r8/) + kao(:, 2, 1,11) = (/ & + &3.0704e-03_r8,2.7128e-01_r8,5.4234e-01_r8,8.1284e-01_r8,1.0822e+00_r8,1.3468e+00_r8, & + &1.5998e+00_r8,1.7945e+00_r8,2.1643e+00_r8/) + kao(:, 3, 1,11) = (/ & + &2.9866e-03_r8,3.1478e-01_r8,6.2947e-01_r8,9.4408e-01_r8,1.2581e+00_r8,1.5709e+00_r8, & + &1.8741e+00_r8,2.1028e+00_r8,2.5161e+00_r8/) + kao(:, 4, 1,11) = (/ & + &2.9163e-03_r8,3.5938e-01_r8,7.1835e-01_r8,1.0774e+00_r8,1.4362e+00_r8,1.7946e+00_r8, & + &2.1451e+00_r8,2.4217e+00_r8,2.8722e+00_r8/) + kao(:, 5, 1,11) = (/ & + &2.8034e-03_r8,4.0521e-01_r8,8.0970e-01_r8,1.2136e+00_r8,1.6171e+00_r8,2.0187e+00_r8, & + &2.4125e+00_r8,2.7343e+00_r8,3.2340e+00_r8/) + kao(:, 1, 2,11) = (/ & + &5.2383e-03_r8,2.1282e-01_r8,4.2542e-01_r8,6.3727e-01_r8,8.4863e-01_r8,1.0581e+00_r8, & + &1.2660e+00_r8,1.4631e+00_r8,1.6971e+00_r8/) + kao(:, 2, 2,11) = (/ & + &5.1027e-03_r8,2.5414e-01_r8,5.0811e-01_r8,7.6215e-01_r8,1.0157e+00_r8,1.2690e+00_r8, & + &1.5182e+00_r8,1.7540e+00_r8,2.0313e+00_r8/) + kao(:, 3, 2,11) = (/ & + &4.9821e-03_r8,2.9639e-01_r8,5.9276e-01_r8,8.8910e-01_r8,1.1857e+00_r8,1.4825e+00_r8, & + &1.7783e+00_r8,2.0622e+00_r8,2.3711e+00_r8/) + kao(:, 4, 2,11) = (/ & + &4.8330e-03_r8,3.4110e-01_r8,6.8181e-01_r8,1.0221e+00_r8,1.3622e+00_r8,1.7021e+00_r8, & + &2.0428e+00_r8,2.3773e+00_r8,2.7241e+00_r8/) + kao(:, 5, 2,11) = (/ & + &4.6466e-03_r8,3.8845e-01_r8,7.7604e-01_r8,1.1627e+00_r8,1.5479e+00_r8,1.9317e+00_r8, & + &2.3125e+00_r8,2.6917e+00_r8,3.0955e+00_r8/) + kao(:, 1, 3,11) = (/ & + &1.1968e-02_r8,1.8925e-01_r8,3.7814e-01_r8,5.6720e-01_r8,7.5640e-01_r8,9.4598e-01_r8, & + &1.1354e+00_r8,1.3192e+00_r8,1.5123e+00_r8/) + kao(:, 2, 3,11) = (/ & + &1.1738e-02_r8,2.2858e-01_r8,4.5676e-01_r8,6.8520e-01_r8,9.1426e-01_r8,1.1439e+00_r8, & + &1.3747e+00_r8,1.6035e+00_r8,1.8280e+00_r8/) + kao(:, 3, 3,11) = (/ & + &1.1441e-02_r8,2.7028e-01_r8,5.3999e-01_r8,8.0979e-01_r8,1.0799e+00_r8,1.3506e+00_r8, & + &1.6224e+00_r8,1.8949e+00_r8,2.1592e+00_r8/) + kao(:, 4, 3,11) = (/ & + &1.1066e-02_r8,3.1556e-01_r8,6.3024e-01_r8,9.4495e-01_r8,1.2595e+00_r8,1.5736e+00_r8, & + &1.8868e+00_r8,2.1970e+00_r8,2.5183e+00_r8/) + kao(:, 5, 3,11) = (/ & + &1.0627e-02_r8,3.6442e-01_r8,7.2807e-01_r8,1.0914e+00_r8,1.4538e+00_r8,1.8154e+00_r8, & + &2.1726e+00_r8,2.5191e+00_r8,2.9067e+00_r8/) + kao(:, 1, 4,11) = (/ & + &2.8048e-02_r8,1.6151e-01_r8,3.2202e-01_r8,4.8262e-01_r8,6.4375e-01_r8,8.0530e-01_r8, & + &9.6854e-01_r8,1.1364e+00_r8,1.2863e+00_r8/) + kao(:, 2, 4,11) = (/ & + &2.7460e-02_r8,1.9867e-01_r8,3.9620e-01_r8,5.9396e-01_r8,7.9208e-01_r8,9.9102e-01_r8, & + &1.1917e+00_r8,1.3983e+00_r8,1.5828e+00_r8/) + kao(:, 3, 4,11) = (/ & + &2.6672e-02_r8,2.3899e-01_r8,4.7658e-01_r8,7.1429e-01_r8,9.5231e-01_r8,1.1913e+00_r8, & + &1.4318e+00_r8,1.6791e+00_r8,1.9031e+00_r8/) + kao(:, 4, 4,11) = (/ & + &2.5665e-02_r8,2.8345e-01_r8,5.6525e-01_r8,8.4715e-01_r8,1.1294e+00_r8,1.4117e+00_r8, & + &1.6956e+00_r8,1.9833e+00_r8,2.2571e+00_r8/) + kao(:, 5, 4,11) = (/ & + &2.4958e-02_r8,3.3271e-01_r8,6.6383e-01_r8,9.9466e-01_r8,1.3259e+00_r8,1.6572e+00_r8, & + &1.9874e+00_r8,2.3183e+00_r8,2.6500e+00_r8/) + kao(:, 1, 5,11) = (/ & + &5.9740e-02_r8,1.3717e-01_r8,2.6992e-01_r8,4.0387e-01_r8,5.3789e-01_r8,6.7238e-01_r8, & + &8.0752e-01_r8,9.4549e-01_r8,1.0734e+00_r8/) + kao(:, 2, 5,11) = (/ & + &5.8323e-02_r8,1.6942e-01_r8,3.3625e-01_r8,5.0313e-01_r8,6.7036e-01_r8,8.3790e-01_r8, & + &1.0063e+00_r8,1.1790e+00_r8,1.3380e+00_r8/) + kao(:, 3, 5,11) = (/ & + &5.6700e-02_r8,2.0744e-01_r8,4.1183e-01_r8,6.1629e-01_r8,8.2117e-01_r8,1.0263e+00_r8, & + &1.2326e+00_r8,1.4427e+00_r8,1.6392e+00_r8/) + kao(:, 4, 5,11) = (/ & + &5.4845e-02_r8,2.5070e-01_r8,4.9802e-01_r8,7.4525e-01_r8,9.9296e-01_r8,1.2407e+00_r8, & + &1.4895e+00_r8,1.7409e+00_r8,1.9825e+00_r8/) + kao(:, 5, 5,11) = (/ & + &5.3384e-02_r8,2.9836e-01_r8,5.9305e-01_r8,8.8824e-01_r8,1.1834e+00_r8,1.4792e+00_r8, & + &1.7758e+00_r8,2.0754e+00_r8,2.3639e+00_r8/) + kao(:, 1, 6,11) = (/ & + &1.1443e-01_r8,1.5330e-01_r8,2.2814e-01_r8,3.3358e-01_r8,4.4343e-01_r8,5.5347e-01_r8, & + &6.6399e-01_r8,7.7608e-01_r8,8.8294e-01_r8/) + kao(:, 2, 6,11) = (/ & + &1.1139e-01_r8,1.6753e-01_r8,2.8410e-01_r8,4.2322e-01_r8,5.6271e-01_r8,7.0257e-01_r8, & + &8.4275e-01_r8,9.8447e-01_r8,1.1213e+00_r8/) + kao(:, 3, 6,11) = (/ & + &1.0816e-01_r8,1.9391e-01_r8,3.5154e-01_r8,5.2463e-01_r8,6.9799e-01_r8,8.7181e-01_r8, & + &1.0460e+00_r8,1.2220e+00_r8,1.3917e+00_r8/) + kao(:, 4, 6,11) = (/ & + &1.0514e-01_r8,2.2522e-01_r8,4.2775e-01_r8,6.3893e-01_r8,8.5037e-01_r8,1.0626e+00_r8, & + &1.2753e+00_r8,1.4901e+00_r8,1.6964e+00_r8/) + kao(:, 5, 6,11) = (/ & + &1.0414e-01_r8,2.6189e-01_r8,5.1110e-01_r8,7.6424e-01_r8,1.0178e+00_r8,1.2716e+00_r8, & + &1.5264e+00_r8,1.7854e+00_r8,2.0311e+00_r8/) + kao(:, 1, 7,11) = (/ & + &2.3680e-01_r8,2.5474e-01_r8,2.7467e-01_r8,2.9968e-01_r8,3.6549e-01_r8,4.4931e-01_r8, & + &5.3835e-01_r8,6.2811e-01_r8,7.1559e-01_r8/) + kao(:, 2, 7,11) = (/ & + &2.3126e-01_r8,2.6667e-01_r8,2.9742e-01_r8,3.6770e-01_r8,4.6828e-01_r8,5.8355e-01_r8, & + &6.9932e-01_r8,8.1593e-01_r8,9.2966e-01_r8/) + kao(:, 3, 7,11) = (/ & + &2.2333e-01_r8,2.8145e-01_r8,3.3561e-01_r8,4.4803e-01_r8,5.8828e-01_r8,7.3378e-01_r8, & + &8.7969e-01_r8,1.0266e+00_r8,1.1700e+00_r8/) + kao(:, 4, 7,11) = (/ & + &2.2006e-01_r8,2.9370e-01_r8,3.8943e-01_r8,5.4388e-01_r8,7.2193e-01_r8,9.0087e-01_r8, & + &1.0804e+00_r8,1.2609e+00_r8,1.4372e+00_r8/) + kao(:, 5, 7,11) = (/ & + &2.1836e-01_r8,3.0927e-01_r8,4.5013e-01_r8,6.5145e-01_r8,8.6638e-01_r8,1.0814e+00_r8, & + &1.2967e+00_r8,1.5147e+00_r8,1.7257e+00_r8/) + kao(:, 1, 8,11) = (/ & + &5.7508e-01_r8,5.5228e-01_r8,5.1832e-01_r8,4.8920e-01_r8,4.5962e-01_r8,4.2790e-01_r8, & + &4.4544e-01_r8,5.0496e-01_r8,5.4406e-01_r8/) + kao(:, 2, 8,11) = (/ & + &5.5570e-01_r8,5.5086e-01_r8,5.3954e-01_r8,5.2836e-01_r8,5.0571e-01_r8,5.1612e-01_r8, & + &5.7597e-01_r8,6.6763e-01_r8,7.6063e-01_r8/) + kao(:, 3, 8,11) = (/ & + &5.4644e-01_r8,5.5917e-01_r8,5.6849e-01_r8,5.6772e-01_r8,5.6845e-01_r8,6.3045e-01_r8, & + &7.3261e-01_r8,8.5320e-01_r8,9.7237e-01_r8/) + kao(:, 4, 8,11) = (/ & + &5.4298e-01_r8,5.6882e-01_r8,5.9693e-01_r8,6.1038e-01_r8,6.5823e-01_r8,7.6720e-01_r8, & + &9.1091e-01_r8,1.0615e+00_r8,1.2099e+00_r8/) + kao(:, 5, 8,11) = (/ & + &5.3663e-01_r8,5.8485e-01_r8,6.2913e-01_r8,6.6732e-01_r8,7.6736e-01_r8,9.2195e-01_r8, & + &1.1025e+00_r8,1.2850e+00_r8,1.4649e+00_r8/) + kao(:, 1, 9,11) = (/ & + &2.5279e+00_r8,2.2431e+00_r8,2.0106e+00_r8,1.7600e+00_r8,1.4790e+00_r8,1.2051e+00_r8, & + &8.9590e-01_r8,5.8517e-01_r8,3.0795e-01_r8/) + kao(:, 2, 9,11) = (/ & + &2.4601e+00_r8,2.1917e+00_r8,2.0103e+00_r8,1.7592e+00_r8,1.5280e+00_r8,1.2575e+00_r8, & + &9.5967e-01_r8,6.7082e-01_r8,3.9930e-01_r8/) + kao(:, 3, 9,11) = (/ & + &2.4168e+00_r8,2.1757e+00_r8,2.0177e+00_r8,1.7994e+00_r8,1.5699e+00_r8,1.3186e+00_r8, & + &1.0425e+00_r8,7.7727e-01_r8,5.2484e-01_r8/) + kao(:, 4, 9,11) = (/ & + &2.3770e+00_r8,2.1985e+00_r8,2.0410e+00_r8,1.8443e+00_r8,1.6274e+00_r8,1.3869e+00_r8, & + &1.1288e+00_r8,9.2337e-01_r8,5.9212e-01_r8/) + kao(:, 5, 9,11) = (/ & + &2.3400e+00_r8,2.1850e+00_r8,2.0960e+00_r8,1.9025e+00_r8,1.6878e+00_r8,1.4602e+00_r8, & + &1.2280e+00_r8,1.0954e+00_r8,7.2073e-01_r8/) + kao(:, 1,10,11) = (/ & + &1.1112e+01_r8,9.7248e+00_r8,8.3361e+00_r8,7.0270e+00_r8,5.7440e+00_r8,4.5096e+00_r8, & + &3.2779e+00_r8,1.8950e+00_r8,4.0940e-01_r8/) + kao(:, 2,10,11) = (/ & + &1.0924e+01_r8,9.5564e+00_r8,8.1917e+00_r8,6.9650e+00_r8,5.7085e+00_r8,4.6298e+00_r8, & + &3.3486e+00_r8,2.0156e+00_r8,4.6752e-01_r8/) + kao(:, 3,10,11) = (/ & + &1.0832e+01_r8,9.4781e+00_r8,8.2229e+00_r8,6.9872e+00_r8,5.8796e+00_r8,4.6954e+00_r8, & + &3.5108e+00_r8,2.1192e+00_r8,8.0168e-01_r8/) + kao(:, 4,10,11) = (/ & + &1.0490e+01_r8,9.1768e+00_r8,8.0065e+00_r8,6.9497e+00_r8,5.9506e+00_r8,4.7816e+00_r8, & + &3.6391e+00_r8,2.2227e+00_r8,9.3825e-01_r8/) + kao(:, 5,10,11) = (/ & + &1.0399e+01_r8,9.1010e+00_r8,8.0219e+00_r8,7.0325e+00_r8,5.9506e+00_r8,4.9243e+00_r8, & + &3.8048e+00_r8,2.3499e+00_r8,1.1716e+00_r8/) + kao(:, 1,11,11) = (/ & + &1.6964e+01_r8,1.4849e+01_r8,1.2726e+01_r8,1.0607e+01_r8,8.5722e+00_r8,6.5304e+00_r8, & + &4.5723e+00_r8,2.5353e+00_r8,5.7715e-01_r8/) + kao(:, 2,11,11) = (/ & + &1.6824e+01_r8,1.4725e+01_r8,1.2623e+01_r8,1.0586e+01_r8,8.5709e+00_r8,6.6756e+00_r8, & + &4.7183e+00_r8,2.7595e+00_r8,6.2192e-01_r8/) + kao(:, 3,11,11) = (/ & + &1.6755e+01_r8,1.4665e+01_r8,1.2572e+01_r8,1.0610e+01_r8,8.6759e+00_r8,6.8661e+00_r8, & + &4.7973e+00_r8,2.9494e+00_r8,7.1889e-01_r8/) + kao(:, 4,11,11) = (/ & + &1.6922e+01_r8,1.4802e+01_r8,1.2769e+01_r8,1.0738e+01_r8,8.9005e+00_r8,6.9130e+00_r8, & + &5.0022e+00_r8,3.1663e+00_r8,1.1906e+00_r8/) + kao(:, 5,11,11) = (/ & + &1.7198e+01_r8,1.5045e+01_r8,1.3001e+01_r8,1.1038e+01_r8,9.0834e+00_r8,7.0679e+00_r8, & + &5.2222e+00_r8,3.3529e+00_r8,1.3885e+00_r8/) + kao(:, 1,12,11) = (/ & + &2.1802e+01_r8,1.9077e+01_r8,1.6353e+01_r8,1.3626e+01_r8,1.0986e+01_r8,8.2719e+00_r8, & + &5.7215e+00_r8,2.9889e+00_r8,6.5084e-01_r8/) + kao(:, 2,12,11) = (/ & + &2.2052e+01_r8,1.9310e+01_r8,1.6546e+01_r8,1.3830e+01_r8,1.1139e+01_r8,8.5492e+00_r8, & + &5.8655e+00_r8,3.1860e+00_r8,7.2046e-01_r8/) + kao(:, 3,12,11) = (/ & + &2.2451e+01_r8,1.9654e+01_r8,1.6841e+01_r8,1.4123e+01_r8,1.1335e+01_r8,8.7814e+00_r8, & + &5.9237e+00_r8,3.3098e+00_r8,8.3218e-01_r8/) + kao(:, 4,12,11) = (/ & + &2.3090e+01_r8,2.0216e+01_r8,1.7353e+01_r8,1.4511e+01_r8,1.1935e+01_r8,9.0228e+00_r8, & + &6.2499e+00_r8,3.5354e+00_r8,1.3462e+00_r8/) + kao(:, 5,12,11) = (/ & + &2.3297e+01_r8,2.0383e+01_r8,1.7601e+01_r8,1.4664e+01_r8,1.2080e+01_r8,9.1910e+00_r8, & + &6.4263e+00_r8,3.7093e+00_r8,1.5753e+00_r8/) + kao(:, 1,13,11) = (/ & + &2.3137e+01_r8,2.0253e+01_r8,1.7360e+01_r8,1.4461e+01_r8,1.1660e+01_r8,8.7711e+00_r8, & + &6.0766e+00_r8,3.2004e+00_r8,6.2333e-01_r8/) + kao(:, 2,13,11) = (/ & + &2.3705e+01_r8,2.0739e+01_r8,1.7789e+01_r8,1.4919e+01_r8,1.1958e+01_r8,9.2720e+00_r8, & + &6.2579e+00_r8,3.3419e+00_r8,6.6494e-01_r8/) + kao(:, 3,13,11) = (/ & + &2.4274e+01_r8,2.1226e+01_r8,1.8190e+01_r8,1.5260e+01_r8,1.2326e+01_r8,9.5663e+00_r8, & + &6.4788e+00_r8,3.4909e+00_r8,1.1201e+00_r8/) + kao(:, 4,13,11) = (/ & + &2.4386e+01_r8,2.1333e+01_r8,1.8377e+01_r8,1.5357e+01_r8,1.2667e+01_r8,9.6781e+00_r8, & + &6.7508e+00_r8,3.6779e+00_r8,1.3420e+00_r8/) + kao(:, 5,13,11) = (/ & + &2.4394e+01_r8,2.1348e+01_r8,1.8396e+01_r8,1.5507e+01_r8,1.2756e+01_r8,9.7415e+00_r8, & + &6.8863e+00_r8,3.8176e+00_r8,1.6819e+00_r8/) + kao(:, 1, 1,12) = (/ & + &3.7292e-03_r8,3.2906e-01_r8,6.5580e-01_r8,9.7933e-01_r8,1.2975e+00_r8,1.6059e+00_r8, & + &1.8953e+00_r8,2.1342e+00_r8,2.5948e+00_r8/) + kao(:, 2, 1,12) = (/ & + &3.6338e-03_r8,3.9331e-01_r8,7.8289e-01_r8,1.1672e+00_r8,1.5430e+00_r8,1.9051e+00_r8, & + &2.2331e+00_r8,2.4741e+00_r8,3.0857e+00_r8/) + kao(:, 3, 1,12) = (/ & + &3.5564e-03_r8,4.6323e-01_r8,9.2190e-01_r8,1.3739e+00_r8,1.8144e+00_r8,2.2323e+00_r8, & + &2.6037e+00_r8,2.8683e+00_r8,3.6286e+00_r8/) + kao(:, 4, 1,12) = (/ & + &3.4829e-03_r8,5.3356e-01_r8,1.0626e+00_r8,1.5845e+00_r8,2.0933e+00_r8,2.5784e+00_r8, & + &3.0158e+00_r8,3.3179e+00_r8,4.1863e+00_r8/) + kao(:, 5, 1,12) = (/ & + &3.4329e-03_r8,6.0324e-01_r8,1.2029e+00_r8,1.7965e+00_r8,2.3794e+00_r8,2.9402e+00_r8, & + &3.4530e+00_r8,3.8265e+00_r8,4.7585e+00_r8/) + kao(:, 1, 2,12) = (/ & + &6.2080e-03_r8,3.1766e-01_r8,6.3367e-01_r8,9.4784e-01_r8,1.2588e+00_r8,1.5639e+00_r8, & + &1.8558e+00_r8,2.1035e+00_r8,2.5172e+00_r8/) + kao(:, 2, 2,12) = (/ & + &6.0635e-03_r8,3.8413e-01_r8,7.6634e-01_r8,1.1462e+00_r8,1.5215e+00_r8,1.8884e+00_r8, & + &2.2355e+00_r8,2.5176e+00_r8,3.0427e+00_r8/) + kao(:, 3, 2,12) = (/ & + &5.9382e-03_r8,4.5423e-01_r8,9.0644e-01_r8,1.3562e+00_r8,1.8011e+00_r8,2.2367e+00_r8, & + &2.6480e+00_r8,2.9724e+00_r8,3.6017e+00_r8/) + kao(:, 4, 2,12) = (/ & + &5.8323e-03_r8,5.2519e-01_r8,1.0487e+00_r8,1.5700e+00_r8,2.0875e+00_r8,2.5951e+00_r8, & + &3.0747e+00_r8,3.4387e+00_r8,4.1744e+00_r8/) + kao(:, 5, 2,12) = (/ & + &5.7338e-03_r8,5.9386e-01_r8,1.1863e+00_r8,1.7768e+00_r8,2.3632e+00_r8,2.9403e+00_r8, & + &3.4914e+00_r8,3.9302e+00_r8,4.7260e+00_r8/) + kao(:, 1, 3,12) = (/ & + &1.4176e-02_r8,2.8836e-01_r8,5.7586e-01_r8,8.6297e-01_r8,1.1493e+00_r8,1.4343e+00_r8, & + &1.7160e+00_r8,1.9825e+00_r8,2.2980e+00_r8/) + kao(:, 2, 3,12) = (/ & + &1.3806e-02_r8,3.5186e-01_r8,7.0276e-01_r8,1.0533e+00_r8,1.4030e+00_r8,1.7510e+00_r8, & + &2.0945e+00_r8,2.4186e+00_r8,2.8053e+00_r8/) + kao(:, 3, 3,12) = (/ & + &1.3514e-02_r8,4.1890e-01_r8,8.3697e-01_r8,1.2547e+00_r8,1.6718e+00_r8,2.0870e+00_r8, & + &2.4990e+00_r8,2.8908e+00_r8,3.3428e+00_r8/) + kao(:, 4, 3,12) = (/ & + &1.3249e-02_r8,4.8707e-01_r8,9.7331e-01_r8,1.4597e+00_r8,1.9459e+00_r8,2.4316e+00_r8, & + &2.9156e+00_r8,3.3828e+00_r8,3.8910e+00_r8/) + kao(:, 5, 3,12) = (/ & + &1.3015e-02_r8,5.5537e-01_r8,1.1100e+00_r8,1.6644e+00_r8,2.2195e+00_r8,2.7745e+00_r8, & + &3.3300e+00_r8,3.8734e+00_r8,4.4382e+00_r8/) + kao(:, 1, 4,12) = (/ & + &3.3184e-02_r8,2.5339e-01_r8,5.0565e-01_r8,7.5787e-01_r8,1.0100e+00_r8,1.2620e+00_r8, & + &1.5135e+00_r8,1.7634e+00_r8,2.0190e+00_r8/) + kao(:, 2, 4,12) = (/ & + &3.2427e-02_r8,3.1318e-01_r8,6.2514e-01_r8,9.3708e-01_r8,1.2489e+00_r8,1.5601e+00_r8, & + &1.8704e+00_r8,2.1781e+00_r8,2.4966e+00_r8/) + kao(:, 3, 4,12) = (/ & + &3.1776e-02_r8,3.7781e-01_r8,7.5434e-01_r8,1.1309e+00_r8,1.5072e+00_r8,1.8833e+00_r8, & + &2.2580e+00_r8,2.6266e+00_r8,3.0132e+00_r8/) + kao(:, 4, 4,12) = (/ & + &3.1130e-02_r8,4.4383e-01_r8,8.8640e-01_r8,1.3292e+00_r8,1.7718e+00_r8,2.2142e+00_r8, & + &2.6572e+00_r8,3.0981e+00_r8,3.5423e+00_r8/) + kao(:, 5, 4,12) = (/ & + &3.0303e-02_r8,5.1080e-01_r8,1.0203e+00_r8,1.5301e+00_r8,2.0399e+00_r8,2.5495e+00_r8, & + &3.0593e+00_r8,3.5718e+00_r8,4.0785e+00_r8/) + kao(:, 1, 5,12) = (/ & + &7.0197e-02_r8,2.2033e-01_r8,4.3908e-01_r8,6.5775e-01_r8,8.7643e-01_r8,1.0950e+00_r8, & + &1.3134e+00_r8,1.5311e+00_r8,1.7514e+00_r8/) + kao(:, 2, 5,12) = (/ & + &6.8848e-02_r8,2.7720e-01_r8,5.5265e-01_r8,8.2808e-01_r8,1.1036e+00_r8,1.3787e+00_r8, & + &1.6538e+00_r8,1.9275e+00_r8,2.2056e+00_r8/) + kao(:, 3, 5,12) = (/ & + &6.6971e-02_r8,3.3853e-01_r8,6.7513e-01_r8,1.0119e+00_r8,1.3485e+00_r8,1.6854e+00_r8, & + &2.0224e+00_r8,2.3592e+00_r8,2.6952e+00_r8/) + kao(:, 4, 5,12) = (/ & + &6.5365e-02_r8,4.0161e-01_r8,8.0132e-01_r8,1.2011e+00_r8,1.6012e+00_r8,2.0009e+00_r8, & + &2.4008e+00_r8,2.8038e+00_r8,3.2005e+00_r8/) + kao(:, 5, 5,12) = (/ & + &6.3431e-02_r8,4.6828e-01_r8,9.3456e-01_r8,1.4005e+00_r8,1.8671e+00_r8,2.3331e+00_r8, & + &2.7981e+00_r8,3.2640e+00_r8,3.7323e+00_r8/) + kao(:, 1, 6,12) = (/ & + &1.3973e-01_r8,2.0662e-01_r8,3.6962e-01_r8,5.5318e-01_r8,7.3681e-01_r8,9.2064e-01_r8, & + &1.1045e+00_r8,1.2891e+00_r8,1.4713e+00_r8/) + kao(:, 2, 6,12) = (/ & + &1.3671e-01_r8,2.4877e-01_r8,4.7403e-01_r8,7.0978e-01_r8,9.4572e-01_r8,1.1814e+00_r8, & + &1.4179e+00_r8,1.6551e+00_r8,1.8888e+00_r8/) + kao(:, 3, 6,12) = (/ & + &1.3368e-01_r8,2.9917e-01_r8,5.8968e-01_r8,8.8312e-01_r8,1.1767e+00_r8,1.4704e+00_r8, & + &1.7646e+00_r8,2.0602e+00_r8,2.3507e+00_r8/) + kao(:, 4, 6,12) = (/ & + &1.2994e-01_r8,3.5894e-01_r8,7.1459e-01_r8,1.0704e+00_r8,1.4263e+00_r8,1.7824e+00_r8, & + &2.1385e+00_r8,2.4959e+00_r8,2.8498e+00_r8/) + kao(:, 5, 6,12) = (/ & + &1.2525e-01_r8,4.2650e-01_r8,8.4975e-01_r8,1.2729e+00_r8,1.6963e+00_r8,2.1200e+00_r8, & + &2.5435e+00_r8,2.9674e+00_r8,3.3897e+00_r8/) + kao(:, 1, 7,12) = (/ & + &2.8974e-01_r8,3.1610e-01_r8,3.5823e-01_r8,4.6930e-01_r8,6.1329e-01_r8,7.6583e-01_r8, & + &9.1850e-01_r8,1.0715e+00_r8,1.2231e+00_r8/) + kao(:, 2, 7,12) = (/ & + &2.8480e-01_r8,3.2946e-01_r8,4.3038e-01_r8,6.0019e-01_r8,7.9796e-01_r8,9.9665e-01_r8, & + &1.1955e+00_r8,1.3949e+00_r8,1.5921e+00_r8/) + kao(:, 3, 7,12) = (/ & + &2.7871e-01_r8,3.5067e-01_r8,5.1857e-01_r8,7.5801e-01_r8,1.0094e+00_r8,1.2608e+00_r8, & + &1.5125e+00_r8,1.7653e+00_r8,2.0145e+00_r8/) + kao(:, 4, 7,12) = (/ & + &2.7300e-01_r8,3.8461e-01_r8,6.2621e-01_r8,9.3301e-01_r8,1.2423e+00_r8,1.5518e+00_r8, & + &1.8620e+00_r8,2.1734e+00_r8,2.4799e+00_r8/) + kao(:, 5, 7,12) = (/ & + &2.6591e-01_r8,4.2736e-01_r8,7.5270e-01_r8,1.1266e+00_r8,1.5003e+00_r8,1.8747e+00_r8, & + &2.2489e+00_r8,2.6247e+00_r8,2.9958e+00_r8/) + kao(:, 1, 8,12) = (/ & + &7.1395e-01_r8,6.8533e-01_r8,6.5866e-01_r8,6.2646e-01_r8,6.1056e-01_r8,6.5589e-01_r8, & + &7.5232e-01_r8,8.7691e-01_r8,1.0005e+00_r8/) + kao(:, 2, 8,12) = (/ & + &7.0494e-01_r8,6.9398e-01_r8,6.9094e-01_r8,6.7668e-01_r8,7.2746e-01_r8,8.4153e-01_r8, & + &1.0006e+00_r8,1.1668e+00_r8,1.3319e+00_r8/) + kao(:, 3, 8,12) = (/ & + &6.9397e-01_r8,7.0598e-01_r8,7.2266e-01_r8,7.6185e-01_r8,8.8476e-01_r8,1.0705e+00_r8, & + &1.2831e+00_r8,1.4961e+00_r8,1.7076e+00_r8/) + kao(:, 4, 8,12) = (/ & + &6.8087e-01_r8,7.2362e-01_r8,7.6721e-01_r8,8.7767e-01_r8,1.0787e+00_r8,1.3359e+00_r8, & + &1.6015e+00_r8,1.8678e+00_r8,2.1324e+00_r8/) + kao(:, 5, 8,12) = (/ & + &6.7139e-01_r8,7.3688e-01_r8,8.3187e-01_r8,1.0246e+00_r8,1.3106e+00_r8,1.6352e+00_r8, & + &1.9607e+00_r8,2.2865e+00_r8,2.6110e+00_r8/) + kao(:, 1, 9,12) = (/ & + &3.4095e+00_r8,2.9940e+00_r8,2.6084e+00_r8,2.2712e+00_r8,1.8987e+00_r8,1.5323e+00_r8, & + &1.1724e+00_r8,8.1780e-01_r8,4.0421e-01_r8/) + kao(:, 2, 9,12) = (/ & + &3.3693e+00_r8,2.9832e+00_r8,2.6354e+00_r8,2.2978e+00_r8,1.9462e+00_r8,1.6166e+00_r8, & + &1.2713e+00_r8,1.0128e+00_r8,5.1858e-01_r8/) + kao(:, 3, 9,12) = (/ & + &3.3273e+00_r8,2.9606e+00_r8,2.6476e+00_r8,2.3138e+00_r8,2.0240e+00_r8,1.7033e+00_r8, & + &1.3935e+00_r8,1.2814e+00_r8,6.1493e-01_r8/) + kao(:, 4, 9,12) = (/ & + &3.2577e+00_r8,2.9148e+00_r8,2.6437e+00_r8,2.3667e+00_r8,2.0968e+00_r8,1.8097e+00_r8, & + &1.5817e+00_r8,1.6061e+00_r8,8.7818e-01_r8/) + kao(:, 5, 9,12) = (/ & + &3.1999e+00_r8,2.9208e+00_r8,2.6366e+00_r8,2.4121e+00_r8,2.1879e+00_r8,1.9394e+00_r8, & + &1.8270e+00_r8,1.9776e+00_r8,1.4315e+00_r8/) + kao(:, 1,10,12) = (/ & + &1.8080e+01_r8,1.5820e+01_r8,1.3560e+01_r8,1.1300e+01_r8,9.1208e+00_r8,6.9174e+00_r8, & + &4.8050e+00_r8,2.5816e+00_r8,5.9225e-01_r8/) + kao(:, 2,10,12) = (/ & + &1.7863e+01_r8,1.5633e+01_r8,1.3401e+01_r8,1.1233e+01_r8,9.0719e+00_r8,6.9705e+00_r8, & + &4.8769e+00_r8,2.6813e+00_r8,6.3411e-01_r8/) + kao(:, 3,10,12) = (/ & + &1.7446e+01_r8,1.5265e+01_r8,1.3103e+01_r8,1.1057e+01_r8,9.0250e+00_r8,7.0448e+00_r8, & + &4.8922e+00_r8,2.7949e+00_r8,7.0806e-01_r8/) + kao(:, 4,10,12) = (/ & + &1.7175e+01_r8,1.5031e+01_r8,1.2961e+01_r8,1.0925e+01_r8,8.9744e+00_r8,7.0129e+00_r8, & + &4.9823e+00_r8,2.9347e+00_r8,1.2270e+00_r8/) + kao(:, 5,10,12) = (/ & + &1.6980e+01_r8,1.4865e+01_r8,1.2847e+01_r8,1.0927e+01_r8,9.0016e+00_r8,7.0557e+00_r8, & + &5.0460e+00_r8,3.0782e+00_r8,1.3161e+00_r8/) + kao(:, 1,11,12) = (/ & + &3.1621e+01_r8,2.7664e+01_r8,2.3716e+01_r8,1.9762e+01_r8,1.5836e+01_r8,1.2028e+01_r8, & + &8.3404e+00_r8,4.4951e+00_r8,7.7226e-01_r8/) + kao(:, 2,11,12) = (/ & + &3.1089e+01_r8,2.7197e+01_r8,2.3314e+01_r8,1.9432e+01_r8,1.5688e+01_r8,1.1946e+01_r8, & + &8.4568e+00_r8,4.5500e+00_r8,1.2396e+00_r8/) + kao(:, 3,11,12) = (/ & + &3.0576e+01_r8,2.6758e+01_r8,2.2933e+01_r8,1.9212e+01_r8,1.5533e+01_r8,1.1953e+01_r8, & + &8.4697e+00_r8,4.6829e+00_r8,1.0564e+00_r8/) + kao(:, 4,11,12) = (/ & + &3.0097e+01_r8,2.6346e+01_r8,2.2583e+01_r8,1.9026e+01_r8,1.5507e+01_r8,1.2181e+01_r8, & + &8.5232e+00_r8,4.7855e+00_r8,1.0613e+00_r8/) + kao(:, 5,11,12) = (/ & + &2.9719e+01_r8,2.6007e+01_r8,2.2377e+01_r8,1.8843e+01_r8,1.5650e+01_r8,1.2244e+01_r8, & + &8.6646e+00_r8,4.9270e+00_r8,1.7788e+00_r8/) + kao(:, 1,12,12) = (/ & + &3.8089e+01_r8,3.3321e+01_r8,2.8563e+01_r8,2.3805e+01_r8,1.9048e+01_r8,1.4479e+01_r8, & + &1.0042e+01_r8,5.5700e+00_r8,1.0139e+00_r8/) + kao(:, 2,12,12) = (/ & + &3.7254e+01_r8,3.2590e+01_r8,2.7941e+01_r8,2.3286e+01_r8,1.8814e+01_r8,1.4266e+01_r8, & + &1.0187e+01_r8,5.6505e+00_r8,1.3358e+00_r8/) + kao(:, 3,12,12) = (/ & + &3.6753e+01_r8,3.2149e+01_r8,2.7565e+01_r8,2.3058e+01_r8,1.8681e+01_r8,1.4515e+01_r8, & + &1.0441e+01_r8,5.8743e+00_r8,1.3962e+00_r8/) + kao(:, 4,12,12) = (/ & + &3.6095e+01_r8,3.1568e+01_r8,2.7073e+01_r8,2.2830e+01_r8,1.8483e+01_r8,1.4754e+01_r8, & + &1.0446e+01_r8,6.0858e+00_r8,1.2630e+00_r8/) + kao(:, 5,12,12) = (/ & + &3.5605e+01_r8,3.1165e+01_r8,2.6709e+01_r8,2.2579e+01_r8,1.8648e+01_r8,1.4780e+01_r8, & + &1.0721e+01_r8,6.3554e+00_r8,1.9400e+00_r8/) + kao(:, 1,13,12) = (/ & + &3.6373e+01_r8,3.1828e+01_r8,2.7282e+01_r8,2.2746e+01_r8,1.8235e+01_r8,1.3858e+01_r8, & + &9.7116e+00_r8,5.3620e+00_r8,1.4114e+00_r8/) + kao(:, 2,13,12) = (/ & + &3.6095e+01_r8,3.1587e+01_r8,2.7062e+01_r8,2.2560e+01_r8,1.8254e+01_r8,1.3864e+01_r8, & + &1.0010e+01_r8,5.5792e+00_r8,1.4567e+00_r8/) + kao(:, 3,13,12) = (/ & + &3.5583e+01_r8,3.1140e+01_r8,2.6700e+01_r8,2.2381e+01_r8,1.8087e+01_r8,1.4135e+01_r8, & + &1.0160e+01_r8,5.8997e+00_r8,1.1528e+00_r8/) + kao(:, 4,13,12) = (/ & + &3.5474e+01_r8,3.1045e+01_r8,2.6613e+01_r8,2.2429e+01_r8,1.8206e+01_r8,1.4545e+01_r8, & + &1.0311e+01_r8,6.1832e+00_r8,1.6292e+00_r8/) + kao(:, 5,13,12) = (/ & + &3.5565e+01_r8,3.1124e+01_r8,2.6773e+01_r8,2.2531e+01_r8,1.8670e+01_r8,1.4802e+01_r8, & + &1.0686e+01_r8,6.5577e+00_r8,2.3163e+00_r8/) + kao(:, 1, 1,13) = (/ & + &4.6813e-03_r8,5.0961e-01_r8,1.0176e+00_r8,1.5220e+00_r8,2.0224e+00_r8,2.5138e+00_r8, & + &2.9825e+00_r8,3.3723e+00_r8,4.0446e+00_r8/) + kao(:, 2, 1,13) = (/ & + &4.5378e-03_r8,5.9150e-01_r8,1.1812e+00_r8,1.7694e+00_r8,2.3540e+00_r8,2.9329e+00_r8, & + &3.4999e+00_r8,3.9983e+00_r8,4.7077e+00_r8/) + kao(:, 3, 1,13) = (/ & + &4.3993e-03_r8,6.8031e-01_r8,1.3585e+00_r8,2.0344e+00_r8,2.7071e+00_r8,3.3760e+00_r8, & + &4.0375e+00_r8,4.6330e+00_r8,5.4138e+00_r8/) + kao(:, 4, 1,13) = (/ & + &4.2648e-03_r8,7.8088e-01_r8,1.5583e+00_r8,2.3313e+00_r8,3.0997e+00_r8,3.8593e+00_r8, & + &4.5971e+00_r8,5.2655e+00_r8,6.1991e+00_r8/) + kao(:, 5, 1,13) = (/ & + &4.1347e-03_r8,8.9242e-01_r8,1.7790e+00_r8,2.6579e+00_r8,3.5250e+00_r8,4.3745e+00_r8, & + &5.1887e+00_r8,5.9002e+00_r8,7.0497e+00_r8/) + kao(:, 1, 2,13) = (/ & + &7.6228e-03_r8,4.9032e-01_r8,9.7924e-01_r8,1.4667e+00_r8,1.9517e+00_r8,2.4315e+00_r8, & + &2.8986e+00_r8,3.3149e+00_r8,3.9031e+00_r8/) + kao(:, 2, 2,13) = (/ & + &7.3845e-03_r8,5.7215e-01_r8,1.1423e+00_r8,1.7099e+00_r8,2.2735e+00_r8,2.8309e+00_r8, & + &3.3762e+00_r8,3.8853e+00_r8,4.5466e+00_r8/) + kao(:, 3, 2,13) = (/ & + &7.1668e-03_r8,6.6400e-01_r8,1.3252e+00_r8,1.9825e+00_r8,2.6343e+00_r8,3.2753e+00_r8, & + &3.8969e+00_r8,4.4792e+00_r8,5.2681e+00_r8/) + kao(:, 4, 2,13) = (/ & + &6.9674e-03_r8,7.6745e-01_r8,1.5306e+00_r8,2.2881e+00_r8,3.0362e+00_r8,3.7701e+00_r8, & + &4.4777e+00_r8,5.1450e+00_r8,6.0719e+00_r8/) + kao(:, 5, 2,13) = (/ & + &6.7870e-03_r8,8.8445e-01_r8,1.7639e+00_r8,2.6357e+00_r8,3.4964e+00_r8,4.3377e+00_r8, & + &5.1390e+00_r8,5.8595e+00_r8,6.9924e+00_r8/) + kao(:, 1, 3,13) = (/ & + &1.6838e-02_r8,4.6207e-01_r8,9.2280e-01_r8,1.3820e+00_r8,1.8387e+00_r8,2.2901e+00_r8, & + &2.7306e+00_r8,3.1427e+00_r8,3.6769e+00_r8/) + kao(:, 2, 3,13) = (/ & + &1.6384e-02_r8,5.4636e-01_r8,1.0908e+00_r8,1.6331e+00_r8,2.1721e+00_r8,2.7041e+00_r8, & + &3.2216e+00_r8,3.6963e+00_r8,4.3436e+00_r8/) + kao(:, 3, 3,13) = (/ & + &1.5944e-02_r8,6.4109e-01_r8,1.2798e+00_r8,1.9157e+00_r8,2.5468e+00_r8,3.1693e+00_r8, & + &3.7717e+00_r8,4.3145e+00_r8,5.0931e+00_r8/) + kao(:, 4, 3,13) = (/ & + &1.5558e-02_r8,7.4877e-01_r8,1.4944e+00_r8,2.2360e+00_r8,2.9707e+00_r8,3.6929e+00_r8, & + &4.3862e+00_r8,5.0013e+00_r8,5.9409e+00_r8/) + kao(:, 5, 3,13) = (/ & + &1.5161e-02_r8,8.6996e-01_r8,1.7361e+00_r8,2.5972e+00_r8,3.4498e+00_r8,4.2854e+00_r8, & + &5.0840e+00_r8,5.7719e+00_r8,6.8989e+00_r8/) + kao(:, 1, 4,13) = (/ & + &3.7812e-02_r8,4.2471e-01_r8,8.4847e-01_r8,1.2717e+00_r8,1.6944e+00_r8,2.1155e+00_r8, & + &2.5337e+00_r8,2.9379e+00_r8,3.3881e+00_r8/) + kao(:, 2, 4,13) = (/ & + &3.6812e-02_r8,5.1516e-01_r8,1.0290e+00_r8,1.5422e+00_r8,2.0538e+00_r8,2.5636e+00_r8, & + &3.0667e+00_r8,3.5462e+00_r8,4.1066e+00_r8/) + kao(:, 3, 4,13) = (/ & + &3.5849e-02_r8,6.1666e-01_r8,1.2316e+00_r8,1.8451e+00_r8,2.4569e+00_r8,3.0640e+00_r8, & + &3.6618e+00_r8,4.2232e+00_r8,4.9129e+00_r8/) + kao(:, 4, 4,13) = (/ & + &3.5079e-02_r8,7.3193e-01_r8,1.4618e+00_r8,2.1899e+00_r8,2.9146e+00_r8,3.6330e+00_r8, & + &4.3356e+00_r8,4.9789e+00_r8,5.8283e+00_r8/) + kao(:, 5, 4,13) = (/ & + &3.4393e-02_r8,8.5645e-01_r8,1.7103e+00_r8,2.5622e+00_r8,3.4100e+00_r8,4.2503e+00_r8, & + &5.0712e+00_r8,5.8174e+00_r8,6.8190e+00_r8/) + kao(:, 1, 5,13) = (/ & + &8.0627e-02_r8,3.8028e-01_r8,7.5923e-01_r8,1.1381e+00_r8,1.5165e+00_r8,1.8947e+00_r8, & + &2.2720e+00_r8,2.6453e+00_r8,3.0318e+00_r8/) + kao(:, 2, 5,13) = (/ & + &7.8562e-02_r8,4.7262e-01_r8,9.4356e-01_r8,1.4144e+00_r8,1.8847e+00_r8,2.3543e+00_r8, & + &2.8214e+00_r8,3.2802e+00_r8,3.7680e+00_r8/) + kao(:, 3, 5,13) = (/ & + &7.6982e-02_r8,5.7810e-01_r8,1.1544e+00_r8,1.7303e+00_r8,2.3053e+00_r8,2.8784e+00_r8, & + &3.4478e+00_r8,4.0008e+00_r8,4.6091e+00_r8/) + kao(:, 4, 5,13) = (/ & + &7.5657e-02_r8,6.9735e-01_r8,1.3928e+00_r8,2.0875e+00_r8,2.7814e+00_r8,3.4728e+00_r8, & + &4.1587e+00_r8,4.8230e+00_r8,5.5613e+00_r8/) + kao(:, 5, 5,13) = (/ & + &7.4333e-02_r8,8.2506e-01_r8,1.6482e+00_r8,2.4702e+00_r8,3.2916e+00_r8,4.1103e+00_r8, & + &4.9228e+00_r8,5.7104e+00_r8,6.5816e+00_r8/) + kao(:, 1, 6,13) = (/ & + &1.6425e-01_r8,3.3608e-01_r8,6.6609e-01_r8,9.9817e-01_r8,1.3302e+00_r8,1.6619e+00_r8, & + &1.9931e+00_r8,2.3215e+00_r8,2.6587e+00_r8/) + kao(:, 2, 6,13) = (/ & + &1.6074e-01_r8,4.2522e-01_r8,8.4831e-01_r8,1.2715e+00_r8,1.6941e+00_r8,2.1166e+00_r8, & + &2.5378e+00_r8,2.9543e+00_r8,3.3863e+00_r8/) + kao(:, 3, 6,13) = (/ & + &1.5834e-01_r8,5.2989e-01_r8,1.0574e+00_r8,1.5848e+00_r8,2.1117e+00_r8,2.6382e+00_r8, & + &3.1634e+00_r8,3.6820e+00_r8,4.2213e+00_r8/) + kao(:, 4, 6,13) = (/ & + &1.5607e-01_r8,6.4460e-01_r8,1.2868e+00_r8,1.9290e+00_r8,2.5707e+00_r8,3.2115e+00_r8, & + &3.8511e+00_r8,4.4833e+00_r8,5.1392e+00_r8/) + kao(:, 5, 6,13) = (/ & + &1.5296e-01_r8,7.6868e-01_r8,1.5350e+00_r8,2.3008e+00_r8,3.0663e+00_r8,3.8313e+00_r8, & + &4.5942e+00_r8,5.3490e+00_r8,6.1304e+00_r8/) + kao(:, 1, 7,13) = (/ & + &3.5667e-01_r8,3.9890e-01_r8,5.8897e-01_r8,8.6077e-01_r8,1.1469e+00_r8,1.4325e+00_r8, & + &1.7184e+00_r8,2.0036e+00_r8,2.2913e+00_r8/) + kao(:, 2, 7,13) = (/ & + &3.5161e-01_r8,4.4967e-01_r8,7.5040e-01_r8,1.1221e+00_r8,1.4950e+00_r8,1.8682e+00_r8, & + &2.2405e+00_r8,2.6119e+00_r8,2.9872e+00_r8/) + kao(:, 3, 7,13) = (/ & + &3.4606e-01_r8,5.1859e-01_r8,9.4635e-01_r8,1.4181e+00_r8,1.8897e+00_r8,2.3609e+00_r8, & + &2.8323e+00_r8,3.3018e+00_r8,3.7764e+00_r8/) + kao(:, 4, 7,13) = (/ & + &3.3825e-01_r8,6.0265e-01_r8,1.1668e+00_r8,1.7485e+00_r8,2.3304e+00_r8,2.9114e+00_r8, & + &3.4925e+00_r8,4.0716e+00_r8,4.6575e+00_r8/) + kao(:, 5, 7,13) = (/ & + &3.3043e-01_r8,7.1091e-01_r8,1.4088e+00_r8,2.1112e+00_r8,2.8136e+00_r8,3.5161e+00_r8, & + &4.2182e+00_r8,4.9170e+00_r8,5.6239e+00_r8/) + kao(:, 1, 8,13) = (/ & + &9.2067e-01_r8,8.6182e-01_r8,8.2952e-01_r8,8.7491e-01_r8,1.0086e+00_r8,1.2181e+00_r8, & + &1.4607e+00_r8,1.7034e+00_r8,1.9462e+00_r8/) + kao(:, 2, 8,13) = (/ & + &9.0671e-01_r8,8.7567e-01_r8,8.9610e-01_r8,1.0491e+00_r8,1.2996e+00_r8,1.6153e+00_r8, & + &1.9371e+00_r8,2.2592e+00_r8,2.5816e+00_r8/) + kao(:, 3, 8,13) = (/ & + &8.8973e-01_r8,8.8439e-01_r8,1.0044e+00_r8,1.2766e+00_r8,1.6623e+00_r8,2.0766e+00_r8, & + &2.4910e+00_r8,2.9049e+00_r8,3.3193e+00_r8/) + kao(:, 4, 8,13) = (/ & + &8.6846e-01_r8,9.1357e-01_r8,1.1469e+00_r8,1.5675e+00_r8,2.0797e+00_r8,2.5979e+00_r8, & + &3.1162e+00_r8,3.6352e+00_r8,4.1539e+00_r8/) + kao(:, 5, 8,13) = (/ & + &8.4664e-01_r8,9.6627e-01_r8,1.3262e+00_r8,1.9064e+00_r8,2.5399e+00_r8,3.1734e+00_r8, & + &3.8073e+00_r8,4.4405e+00_r8,5.0740e+00_r8/) + kao(:, 1, 9,13) = (/ & + &4.4067e+00_r8,3.8562e+00_r8,3.3799e+00_r8,2.9279e+00_r8,2.4898e+00_r8,2.0023e+00_r8, & + &1.6061e+00_r8,1.4556e+00_r8,5.3966e-01_r8/) + kao(:, 2, 9,13) = (/ & + &4.3584e+00_r8,3.8431e+00_r8,3.3719e+00_r8,2.9985e+00_r8,2.5395e+00_r8,2.1329e+00_r8, & + &1.8824e+00_r8,1.9290e+00_r8,1.2534e+00_r8/) + kao(:, 3, 9,13) = (/ & + &4.2715e+00_r8,3.7950e+00_r8,3.4185e+00_r8,3.0378e+00_r8,2.6388e+00_r8,2.3497e+00_r8, & + &2.2667e+00_r8,2.5092e+00_r8,2.3205e+00_r8/) + kao(:, 4, 9,13) = (/ & + &4.1934e+00_r8,3.7482e+00_r8,3.4519e+00_r8,3.0862e+00_r8,2.7969e+00_r8,2.6493e+00_r8, & + &2.7789e+00_r8,3.1851e+00_r8,3.5246e+00_r8/) + kao(:, 5, 9,13) = (/ & + &4.0917e+00_r8,3.7105e+00_r8,3.4634e+00_r8,3.1979e+00_r8,3.0093e+00_r8,3.0525e+00_r8, & + &3.4012e+00_r8,3.9555e+00_r8,4.5178e+00_r8/) + kao(:, 1,10,13) = (/ & + &2.3719e+01_r8,2.0753e+01_r8,1.7788e+01_r8,1.4825e+01_r8,1.1907e+01_r8,9.0621e+00_r8, & + &6.2541e+00_r8,3.4363e+00_r8,9.1814e-01_r8/) + kao(:, 2,10,13) = (/ & + &2.3432e+01_r8,2.0501e+01_r8,1.7571e+01_r8,1.4658e+01_r8,1.1890e+01_r8,9.0622e+00_r8, & + &6.4024e+00_r8,3.5910e+00_r8,1.1158e+00_r8/) + kao(:, 3,10,13) = (/ & + &2.3069e+01_r8,2.0187e+01_r8,1.7300e+01_r8,1.4541e+01_r8,1.1793e+01_r8,9.1570e+00_r8, & + &6.5099e+00_r8,3.8249e+00_r8,9.3188e-01_r8/) + kao(:, 4,10,13) = (/ & + &2.2641e+01_r8,1.9809e+01_r8,1.6998e+01_r8,1.4367e+01_r8,1.1776e+01_r8,9.2770e+00_r8, & + &6.6180e+00_r8,4.0885e+00_r8,9.9189e-01_r8/) + kao(:, 5,10,13) = (/ & + &2.2220e+01_r8,1.9436e+01_r8,1.6770e+01_r8,1.4187e+01_r8,1.1792e+01_r8,9.2910e+00_r8, & + &6.8771e+00_r8,4.4865e+00_r8,1.9399e+00_r8/) + kao(:, 1,11,13) = (/ & + &4.4319e+01_r8,3.8780e+01_r8,3.3240e+01_r8,2.7701e+01_r8,2.2160e+01_r8,1.6704e+01_r8, & + &1.1307e+01_r8,6.0563e+00_r8,5.8625e-01_r8/) + kao(:, 2,11,13) = (/ & + &4.3809e+01_r8,3.8330e+01_r8,3.2852e+01_r8,2.7376e+01_r8,2.1936e+01_r8,1.6626e+01_r8, & + &1.1378e+01_r8,6.1989e+00_r8,8.1730e-01_r8/) + kao(:, 3,11,13) = (/ & + &4.3202e+01_r8,3.7799e+01_r8,3.2400e+01_r8,2.7000e+01_r8,2.1788e+01_r8,1.6575e+01_r8, & + &1.1586e+01_r8,6.3577e+00_r8,1.8296e+00_r8/) + kao(:, 4,11,13) = (/ & + &4.2458e+01_r8,3.7147e+01_r8,3.1841e+01_r8,2.6621e+01_r8,2.1500e+01_r8,1.6577e+01_r8, & + &1.1663e+01_r8,6.6208e+00_r8,1.8735e+00_r8/) + kao(:, 5,11,13) = (/ & + &4.1634e+01_r8,3.6429e+01_r8,3.1221e+01_r8,2.6233e+01_r8,2.1246e+01_r8,1.6580e+01_r8, & + &1.1685e+01_r8,6.9092e+00_r8,1.7032e+00_r8/) + kao(:, 1,12,13) = (/ & + &6.1904e+01_r8,5.4167e+01_r8,4.6429e+01_r8,3.8690e+01_r8,3.0952e+01_r8,2.3248e+01_r8, & + &1.5661e+01_r8,8.2582e+00_r8,4.3930e-01_r8/) + kao(:, 2,12,13) = (/ & + &6.1270e+01_r8,5.3611e+01_r8,4.5953e+01_r8,3.8296e+01_r8,3.0637e+01_r8,2.3190e+01_r8, & + &1.5723e+01_r8,8.4338e+00_r8,1.2396e+00_r8/) + kao(:, 3,12,13) = (/ & + &6.0345e+01_r8,5.2802e+01_r8,4.5261e+01_r8,3.7714e+01_r8,3.0326e+01_r8,2.2898e+01_r8, & + &1.5824e+01_r8,8.5563e+00_r8,2.5106e+00_r8/) + kao(:, 4,12,13) = (/ & + &5.9306e+01_r8,5.1895e+01_r8,4.4474e+01_r8,3.7089e+01_r8,2.9895e+01_r8,2.2756e+01_r8, & + &1.5929e+01_r8,8.7873e+00_r8,2.2974e+00_r8/) + kao(:, 5,12,13) = (/ & + &5.8419e+01_r8,5.1111e+01_r8,4.3811e+01_r8,3.6683e+01_r8,2.9523e+01_r8,2.2821e+01_r8, & + &1.5911e+01_r8,9.0327e+00_r8,2.2973e+00_r8/) + kao(:, 1,13,13) = (/ & + &6.8544e+01_r8,5.9975e+01_r8,5.1408e+01_r8,4.2840e+01_r8,3.4272e+01_r8,2.5775e+01_r8, & + &1.7340e+01_r8,9.2235e+00_r8,4.0824e-01_r8/) + kao(:, 2,13,13) = (/ & + &6.7698e+01_r8,5.9233e+01_r8,5.0770e+01_r8,4.2312e+01_r8,3.3875e+01_r8,2.5602e+01_r8, & + &1.7402e+01_r8,9.3485e+00_r8,1.7747e+00_r8/) + kao(:, 3,13,13) = (/ & + &6.6803e+01_r8,5.8453e+01_r8,5.0103e+01_r8,4.1750e+01_r8,3.3601e+01_r8,2.5372e+01_r8, & + &1.7686e+01_r8,9.4660e+00_r8,2.9931e+00_r8/) + kao(:, 4,13,13) = (/ & + &6.5956e+01_r8,5.7706e+01_r8,4.9463e+01_r8,4.1288e+01_r8,3.3259e+01_r8,2.5336e+01_r8, & + &1.7750e+01_r8,9.7483e+00_r8,2.7732e+00_r8/) + kao(:, 5,13,13) = (/ & + &6.5110e+01_r8,5.6969e+01_r8,4.8829e+01_r8,4.0948e+01_r8,3.2989e+01_r8,2.5559e+01_r8, & + &1.7705e+01_r8,9.9706e+00_r8,2.2584e+00_r8/) + kao(:, 1, 1,14) = (/ & + &5.3617e-03_r8,8.8862e-01_r8,1.7657e+00_r8,2.6246e+00_r8,3.4547e+00_r8,4.2326e+00_r8, & + &4.9022e+00_r8,5.2848e+00_r8,6.9093e+00_r8/) + kao(:, 2, 1,14) = (/ & + &5.2510e-03_r8,1.0670e+00_r8,2.1191e+00_r8,3.1492e+00_r8,4.1423e+00_r8,5.0696e+00_r8, & + &5.8593e+00_r8,6.2778e+00_r8,8.2844e+00_r8/) + kao(:, 3, 1,14) = (/ & + &5.1410e-03_r8,1.2574e+00_r8,2.4970e+00_r8,3.7095e+00_r8,4.8778e+00_r8,5.9654e+00_r8, & + &6.8831e+00_r8,7.3419e+00_r8,9.7553e+00_r8/) + kao(:, 4, 1,14) = (/ & + &5.0266e-03_r8,1.4566e+00_r8,2.8932e+00_r8,4.2987e+00_r8,5.6515e+00_r8,6.9086e+00_r8, & + &7.9640e+00_r8,8.4651e+00_r8,1.1303e+01_r8/) + kao(:, 5, 1,14) = (/ & + &4.9104e-03_r8,1.6562e+00_r8,3.2920e+00_r8,4.8956e+00_r8,6.4440e+00_r8,7.8868e+00_r8, & + &9.0871e+00_r8,9.6375e+00_r8,1.2888e+01_r8/) + kao(:, 1, 2,14) = (/ & + &8.7449e-03_r8,9.0334e-01_r8,1.7988e+00_r8,2.6821e+00_r8,3.5450e+00_r8,4.3691e+00_r8, & + &5.1072e+00_r8,5.5794e+00_r8,7.0898e+00_r8/) + kao(:, 2, 2,14) = (/ & + &8.5771e-03_r8,1.0973e+00_r8,2.1846e+00_r8,3.2569e+00_r8,4.3031e+00_r8,5.3011e+00_r8, & + &6.1907e+00_r8,6.7403e+00_r8,8.6059e+00_r8/) + kao(:, 3, 2,14) = (/ & + &8.3757e-03_r8,1.3007e+00_r8,2.5910e+00_r8,3.8649e+00_r8,5.1100e+00_r8,6.3010e+00_r8, & + &7.3563e+00_r8,7.9915e+00_r8,1.0220e+01_r8/) + kao(:, 4, 2,14) = (/ & + &8.1726e-03_r8,1.5076e+00_r8,3.0039e+00_r8,4.4835e+00_r8,5.9326e+00_r8,7.3236e+00_r8, & + &8.5740e+00_r8,9.3177e+00_r8,1.1865e+01_r8/) + kao(:, 5, 2,14) = (/ & + &7.9706e-03_r8,1.7155e+00_r8,3.4194e+00_r8,5.1046e+00_r8,6.7592e+00_r8,8.3528e+00_r8, & + &9.7973e+00_r8,1.0700e+01_r8,1.3518e+01_r8/) + kao(:, 1, 3,14) = (/ & + &1.9310e-02_r8,8.7468e-01_r8,1.7453e+00_r8,2.6103e+00_r8,3.4663e+00_r8,4.3037e+00_r8, & + &5.0955e+00_r8,5.7297e+00_r8,6.9321e+00_r8/) + kao(:, 2, 3,14) = (/ & + &1.8969e-02_r8,1.0738e+00_r8,2.1432e+00_r8,3.2076e+00_r8,4.2608e+00_r8,5.2941e+00_r8, & + &6.2765e+00_r8,7.0620e+00_r8,8.5210e+00_r8/) + kao(:, 3, 3,14) = (/ & + &1.8605e-02_r8,1.2813e+00_r8,2.5582e+00_r8,3.8286e+00_r8,5.0883e+00_r8,6.3262e+00_r8, & + &7.5114e+00_r8,8.4846e+00_r8,1.0176e+01_r8/) + kao(:, 4, 3,14) = (/ & + &1.8213e-02_r8,1.4944e+00_r8,2.9835e+00_r8,4.4663e+00_r8,5.9372e+00_r8,7.3859e+00_r8, & + &8.7760e+00_r8,9.9435e+00_r8,1.1874e+01_r8/) + kao(:, 5, 3,14) = (/ & + &1.7876e-02_r8,1.7091e+00_r8,3.4131e+00_r8,5.1104e+00_r8,6.7954e+00_r8,8.4548e+00_r8, & + &1.0056e+01_r8,1.1421e+01_r8,1.3590e+01_r8/) + kao(:, 1, 4,14) = (/ & + &4.4344e-02_r8,8.3370e-01_r8,1.6650e+00_r8,2.4941e+00_r8,3.3185e+00_r8,4.1344e+00_r8, & + &4.9297e+00_r8,5.6430e+00_r8,6.6364e+00_r8/) + kao(:, 2, 4,14) = (/ & + &4.3566e-02_r8,1.0283e+00_r8,2.0545e+00_r8,3.0778e+00_r8,4.0971e+00_r8,5.1067e+00_r8, & + &6.0943e+00_r8,6.9950e+00_r8,8.1935e+00_r8/) + kao(:, 3, 4,14) = (/ & + &4.2932e-02_r8,1.2330e+00_r8,2.4636e+00_r8,3.6915e+00_r8,4.9148e+00_r8,6.1292e+00_r8, & + &7.3214e+00_r8,8.4254e+00_r8,9.8287e+00_r8/) + kao(:, 4, 4,14) = (/ & + &4.2251e-02_r8,1.4427e+00_r8,2.8831e+00_r8,4.3208e+00_r8,5.7549e+00_r8,7.1799e+00_r8, & + &8.5827e+00_r8,9.9037e+00_r8,1.1509e+01_r8/) + kao(:, 5, 4,14) = (/ & + &4.1551e-02_r8,1.6617e+00_r8,3.3208e+00_r8,4.9772e+00_r8,6.6290e+00_r8,8.2714e+00_r8, & + &9.8934e+00_r8,1.1428e+01_r8,1.3257e+01_r8/) + kao(:, 1, 5,14) = (/ & + &9.4754e-02_r8,7.8821e-01_r8,1.5748e+00_r8,2.3603e+00_r8,3.1437e+00_r8,3.9237e+00_r8, & + &4.6947e+00_r8,5.4302e+00_r8,6.2865e+00_r8/) + kao(:, 2, 5,14) = (/ & + &9.3575e-02_r8,9.7845e-01_r8,1.9550e+00_r8,2.9310e+00_r8,3.9047e+00_r8,4.8748e+00_r8, & + &5.8356e+00_r8,6.7595e+00_r8,7.8084e+00_r8/) + kao(:, 3, 5,14) = (/ & + &9.2188e-02_r8,1.1782e+00_r8,2.3547e+00_r8,3.5302e+00_r8,4.7038e+00_r8,5.8743e+00_r8, & + &7.0357e+00_r8,8.1610e+00_r8,9.4064e+00_r8/) + kao(:, 4, 5,14) = (/ & + &9.0816e-02_r8,1.3863e+00_r8,2.7710e+00_r8,4.1546e+00_r8,5.5362e+00_r8,6.9136e+00_r8, & + &8.2813e+00_r8,9.6122e+00_r8,1.1071e+01_r8/) + kao(:, 5, 5,14) = (/ & + &8.9641e-02_r8,1.6059e+00_r8,3.2095e+00_r8,4.8121e+00_r8,6.4122e+00_r8,8.0077e+00_r8, & + &9.5924e+00_r8,1.1136e+01_r8,1.2823e+01_r8/) + kao(:, 1, 6,14) = (/ & + &1.9317e-01_r8,7.2809e-01_r8,1.4547e+00_r8,2.1811e+00_r8,2.9065e+00_r8,3.6305e+00_r8, & + &4.3507e+00_r8,5.0577e+00_r8,5.8117e+00_r8/) + kao(:, 2, 6,14) = (/ & + &1.9031e-01_r8,9.0988e-01_r8,1.8182e+00_r8,2.7260e+00_r8,3.6329e+00_r8,4.5385e+00_r8, & + &5.4408e+00_r8,6.3293e+00_r8,7.2643e+00_r8/) + kao(:, 3, 6,14) = (/ & + &1.8758e-01_r8,1.1038e+00_r8,2.2061e+00_r8,3.3074e+00_r8,4.4083e+00_r8,5.5073e+00_r8, & + &6.6028e+00_r8,7.6822e+00_r8,8.8149e+00_r8/) + kao(:, 4, 6,14) = (/ & + &1.8516e-01_r8,1.3141e+00_r8,2.6258e+00_r8,3.9372e+00_r8,5.2485e+00_r8,6.5558e+00_r8, & + &7.8598e+00_r8,9.1449e+00_r8,1.0495e+01_r8/) + kao(:, 5, 6,14) = (/ & + &1.8433e-01_r8,1.5378e+00_r8,3.0732e+00_r8,4.6078e+00_r8,6.1419e+00_r8,7.6735e+00_r8, & + &9.1990e+00_r8,1.0701e+01_r8,1.2282e+01_r8/) + kao(:, 1, 7,14) = (/ & + &4.2545e-01_r8,7.0197e-01_r8,1.3229e+00_r8,1.9833e+00_r8,2.6434e+00_r8,3.3025e+00_r8, & + &3.9608e+00_r8,4.6133e+00_r8,5.2849e+00_r8/) + kao(:, 2, 7,14) = (/ & + &4.1807e-01_r8,8.4884e-01_r8,1.6721e+00_r8,2.5066e+00_r8,3.3410e+00_r8,4.1750e+00_r8, & + &5.0067e+00_r8,5.8326e+00_r8,6.6798e+00_r8/) + kao(:, 3, 7,14) = (/ & + &4.1332e-01_r8,1.0301e+00_r8,2.0577e+00_r8,3.0848e+00_r8,4.1118e+00_r8,5.1378e+00_r8, & + &6.1618e+00_r8,7.1777e+00_r8,8.2211e+00_r8/) + kao(:, 4, 7,14) = (/ & + &4.0936e-01_r8,1.2414e+00_r8,2.4798e+00_r8,3.7180e+00_r8,4.9556e+00_r8,6.1921e+00_r8, & + &7.4267e+00_r8,8.6520e+00_r8,9.9083e+00_r8/) + kao(:, 5, 7,14) = (/ & + &4.0685e-01_r8,1.4675e+00_r8,2.9318e+00_r8,4.3961e+00_r8,5.8593e+00_r8,7.3214e+00_r8, & + &8.7804e+00_r8,1.0230e+01_r8,1.1715e+01_r8/) + kao(:, 1, 8,14) = (/ & + &1.1195e+00_r8,1.0895e+00_r8,1.3598e+00_r8,1.7846e+00_r8,2.3466e+00_r8,2.9325e+00_r8, & + &3.5182e+00_r8,4.1012e+00_r8,4.6898e+00_r8/) + kao(:, 2, 8,14) = (/ & + &1.1037e+00_r8,1.1788e+00_r8,1.6176e+00_r8,2.2927e+00_r8,3.0553e+00_r8,3.8181e+00_r8, & + &4.5804e+00_r8,5.3406e+00_r8,6.1069e+00_r8/) + kao(:, 3, 8,14) = (/ & + &1.0884e+00_r8,1.2851e+00_r8,1.9342e+00_r8,2.8650e+00_r8,3.8186e+00_r8,4.7719e+00_r8, & + &5.7236e+00_r8,6.6739e+00_r8,7.6330e+00_r8/) + kao(:, 4, 8,14) = (/ & + &1.0777e+00_r8,1.3879e+00_r8,2.3316e+00_r8,3.4927e+00_r8,4.6551e+00_r8,5.8169e+00_r8, & + &6.9783e+00_r8,8.1364e+00_r8,9.3055e+00_r8/) + kao(:, 5, 8,14) = (/ & + &1.0697e+00_r8,1.5195e+00_r8,2.7843e+00_r8,4.1737e+00_r8,5.5632e+00_r8,6.9521e+00_r8, & + &8.3391e+00_r8,9.7222e+00_r8,1.1121e+01_r8/) + kao(:, 1, 9,14) = (/ & + &5.6190e+00_r8,4.9167e+00_r8,4.3250e+00_r8,3.7358e+00_r8,3.4047e+00_r8,3.1579e+00_r8, & + &3.1500e+00_r8,3.5459e+00_r8,3.9362e+00_r8/) + kao(:, 2, 9,14) = (/ & + &5.5255e+00_r8,4.8418e+00_r8,4.3146e+00_r8,3.9154e+00_r8,3.7623e+00_r8,3.7282e+00_r8, & + &4.0980e+00_r8,4.7612e+00_r8,5.4406e+00_r8/) + kao(:, 3, 9,14) = (/ & + &5.4430e+00_r8,4.8357e+00_r8,4.3573e+00_r8,4.2040e+00_r8,4.1594e+00_r8,4.5007e+00_r8, & + &5.2453e+00_r8,6.1166e+00_r8,6.9893e+00_r8/) + kao(:, 4, 9,14) = (/ & + &5.3842e+00_r8,4.8388e+00_r8,4.5334e+00_r8,4.4707e+00_r8,4.7073e+00_r8,5.4536e+00_r8, & + &6.5005e+00_r8,7.5810e+00_r8,8.6617e+00_r8/) + kao(:, 5, 9,14) = (/ & + &5.3385e+00_r8,4.8392e+00_r8,4.7032e+00_r8,4.7787e+00_r8,5.4197e+00_r8,6.5502e+00_r8, & + &7.8564e+00_r8,9.1615e+00_r8,1.0470e+01_r8/) + kao(:, 1,10,14) = (/ & + &3.1503e+01_r8,2.7564e+01_r8,2.3627e+01_r8,1.9689e+01_r8,1.5752e+01_r8,1.2029e+01_r8, & + &8.2850e+00_r8,5.0089e+00_r8,2.6421e-01_r8/) + kao(:, 2,10,14) = (/ & + &3.1041e+01_r8,2.7162e+01_r8,2.3282e+01_r8,1.9402e+01_r8,1.5696e+01_r8,1.2052e+01_r8, & + &8.5363e+00_r8,5.5767e+00_r8,1.2004e+00_r8/) + kao(:, 3,10,14) = (/ & + &3.0653e+01_r8,2.6822e+01_r8,2.2991e+01_r8,1.9210e+01_r8,1.5684e+01_r8,1.2101e+01_r8, & + &9.0343e+00_r8,6.3229e+00_r8,1.6811e+00_r8/) + kao(:, 4,10,14) = (/ & + &3.0330e+01_r8,2.6541e+01_r8,2.2749e+01_r8,1.9185e+01_r8,1.5678e+01_r8,1.2425e+01_r8, & + &9.5207e+00_r8,7.4497e+00_r8,1.5881e+00_r8/) + kao(:, 5,10,14) = (/ & + &2.9986e+01_r8,2.6238e+01_r8,2.2506e+01_r8,1.9078e+01_r8,1.5796e+01_r8,1.2833e+01_r8, & + &1.0036e+01_r8,8.8467e+00_r8,2.8996e+00_r8/) + kao(:, 1,11,14) = (/ & + &6.1029e+01_r8,5.3402e+01_r8,4.5771e+01_r8,3.8145e+01_r8,3.0515e+01_r8,2.2887e+01_r8, & + &1.5544e+01_r8,8.4710e+00_r8,5.1903e-01_r8/) + kao(:, 2,11,14) = (/ & + &6.0319e+01_r8,5.2777e+01_r8,4.5238e+01_r8,3.7700e+01_r8,3.0160e+01_r8,2.2857e+01_r8, & + &1.5622e+01_r8,8.8835e+00_r8,1.0450e+00_r8/) + kao(:, 3,11,14) = (/ & + &5.9632e+01_r8,5.2177e+01_r8,4.4723e+01_r8,3.7270e+01_r8,2.9909e+01_r8,2.2818e+01_r8, & + &1.5829e+01_r8,9.3768e+00_r8,1.3014e+00_r8/) + kao(:, 4,11,14) = (/ & + &5.9020e+01_r8,5.1642e+01_r8,4.4266e+01_r8,3.6888e+01_r8,2.9847e+01_r8,2.2764e+01_r8, & + &1.6262e+01_r8,9.9702e+00_r8,2.2647e+00_r8/) + kao(:, 5,11,14) = (/ & + &5.8283e+01_r8,5.0998e+01_r8,4.3714e+01_r8,3.6531e+01_r8,2.9620e+01_r8,2.3044e+01_r8, & + &1.6667e+01_r8,1.0858e+01_r8,2.1604e+00_r8/) + kao(:, 1,12,14) = (/ & + &8.6818e+01_r8,7.5961e+01_r8,6.5105e+01_r8,5.4264e+01_r8,4.3410e+01_r8,3.2557e+01_r8, & + &2.1958e+01_r8,1.1756e+01_r8,1.0818e+00_r8/) + kao(:, 2,12,14) = (/ & + &8.5898e+01_r8,7.5160e+01_r8,6.4423e+01_r8,5.3685e+01_r8,4.2947e+01_r8,3.2329e+01_r8, & + &2.1951e+01_r8,1.2183e+01_r8,6.2703e-01_r8/) + kao(:, 3,12,14) = (/ & + &8.4970e+01_r8,7.4354e+01_r8,6.3731e+01_r8,5.3109e+01_r8,4.2485e+01_r8,3.2310e+01_r8, & + &2.2149e+01_r8,1.2602e+01_r8,1.0531e+00_r8/) + kao(:, 4,12,14) = (/ & + &8.4043e+01_r8,7.3537e+01_r8,6.3034e+01_r8,5.2533e+01_r8,4.2288e+01_r8,3.2140e+01_r8, & + &2.2696e+01_r8,1.3012e+01_r8,4.3852e+00_r8/) + kao(:, 5,12,14) = (/ & + &8.3130e+01_r8,7.2745e+01_r8,6.2351e+01_r8,5.1964e+01_r8,4.2084e+01_r8,3.2159e+01_r8, & + &2.3067e+01_r8,1.3670e+01_r8,3.1697e+00_r8/) + kao(:, 1,13,14) = (/ & + &9.9062e+01_r8,8.6679e+01_r8,7.4295e+01_r8,6.1914e+01_r8,4.9531e+01_r8,3.7148e+01_r8, & + &2.5053e+01_r8,1.3336e+01_r8,1.0355e+00_r8/) + kao(:, 2,13,14) = (/ & + &9.8005e+01_r8,8.5755e+01_r8,7.3503e+01_r8,6.1254e+01_r8,4.9004e+01_r8,3.6913e+01_r8, & + &2.4991e+01_r8,1.3937e+01_r8,6.5467e-01_r8/) + kao(:, 3,13,14) = (/ & + &9.6910e+01_r8,8.4797e+01_r8,7.2683e+01_r8,6.0573e+01_r8,4.8483e+01_r8,3.6814e+01_r8, & + &2.5110e+01_r8,1.4339e+01_r8,1.8215e+00_r8/) + kao(:, 4,13,14) = (/ & + &9.5837e+01_r8,8.3857e+01_r8,7.1882e+01_r8,5.9896e+01_r8,4.8229e+01_r8,3.6584e+01_r8, & + &2.5752e+01_r8,1.4680e+01_r8,4.3881e+00_r8/) + kao(:, 5,13,14) = (/ & + &9.4386e+01_r8,8.2585e+01_r8,7.0788e+01_r8,5.9024e+01_r8,4.7765e+01_r8,3.6452e+01_r8, & + &2.6308e+01_r8,1.5330e+01_r8,4.3734e+00_r8/) + kao(:, 1, 1,15) = (/ & + &6.2662e-03_r8,2.0747e+00_r8,4.1170e+00_r8,6.1089e+00_r8,8.0146e+00_r8,9.7584e+00_r8, & + &1.1145e+01_r8,1.1422e+01_r8,1.6029e+01_r8/) + kao(:, 2, 1,15) = (/ & + &6.1351e-03_r8,2.4271e+00_r8,4.8178e+00_r8,7.1504e+00_r8,9.3877e+00_r8,1.1443e+01_r8, & + &1.3088e+01_r8,1.3461e+01_r8,1.8775e+01_r8/) + kao(:, 3, 1,15) = (/ & + &6.0097e-03_r8,2.7826e+00_r8,5.5248e+00_r8,8.2041e+00_r8,1.0775e+01_r8,1.3145e+01_r8, & + &1.5060e+01_r8,1.5543e+01_r8,2.1551e+01_r8/) + kao(:, 4, 1,15) = (/ & + &5.9020e-03_r8,3.1403e+00_r8,6.2337e+00_r8,9.2578e+00_r8,1.2161e+01_r8,1.4850e+01_r8, & + &1.7039e+01_r8,1.7642e+01_r8,2.4321e+01_r8/) + kao(:, 5, 1,15) = (/ & + &5.8030e-03_r8,3.5098e+00_r8,6.9636e+00_r8,1.0331e+01_r8,1.3560e+01_r8,1.6533e+01_r8, & + &1.8991e+01_r8,1.9724e+01_r8,2.7120e+01_r8/) + kao(:, 1, 2,15) = (/ & + &1.0266e-02_r8,2.1405e+00_r8,4.2622e+00_r8,6.3547e+00_r8,8.3970e+00_r8,1.0344e+01_r8, & + &1.2064e+01_r8,1.2985e+01_r8,1.6794e+01_r8/) + kao(:, 2, 2,15) = (/ & + &1.0014e-02_r8,2.5163e+00_r8,5.0119e+00_r8,7.4752e+00_r8,9.8815e+00_r8,1.2172e+01_r8, & + &1.4218e+01_r8,1.5356e+01_r8,1.9763e+01_r8/) + kao(:, 3, 2,15) = (/ & + &9.8638e-03_r8,2.9079e+00_r8,5.7890e+00_r8,8.6292e+00_r8,1.1401e+01_r8,1.4046e+01_r8, & + &1.6408e+01_r8,1.7772e+01_r8,2.2802e+01_r8/) + kao(:, 4, 2,15) = (/ & + &9.7234e-03_r8,3.3191e+00_r8,6.6057e+00_r8,9.8408e+00_r8,1.2995e+01_r8,1.5989e+01_r8, & + &1.8633e+01_r8,2.0195e+01_r8,2.5989e+01_r8/) + kao(:, 5, 2,15) = (/ & + &9.5893e-03_r8,3.7435e+00_r8,7.4476e+00_r8,1.1096e+01_r8,1.4644e+01_r8,1.8006e+01_r8, & + &2.0946e+01_r8,2.2600e+01_r8,2.9288e+01_r8/) + kao(:, 1, 3,15) = (/ & + &2.3937e-02_r8,2.0884e+00_r8,4.1689e+00_r8,6.2403e+00_r8,8.2897e+00_r8,1.0301e+01_r8, & + &1.2219e+01_r8,1.3769e+01_r8,1.6579e+01_r8/) + kao(:, 2, 3,15) = (/ & + &2.3289e-02_r8,2.4959e+00_r8,4.9798e+00_r8,7.4513e+00_r8,9.8967e+00_r8,1.2286e+01_r8, & + &1.4557e+01_r8,1.6412e+01_r8,1.9793e+01_r8/) + kao(:, 3, 3,15) = (/ & + &2.2745e-02_r8,2.9294e+00_r8,5.8465e+00_r8,8.7448e+00_r8,1.1610e+01_r8,1.4408e+01_r8, & + &1.7054e+01_r8,1.9158e+01_r8,2.3219e+01_r8/) + kao(:, 4, 3,15) = (/ & + &2.2330e-02_r8,3.3848e+00_r8,6.7550e+00_r8,1.0101e+01_r8,1.3409e+01_r8,1.6637e+01_r8, & + &1.9679e+01_r8,2.2057e+01_r8,2.6817e+01_r8/) + kao(:, 5, 3,15) = (/ & + &2.1962e-02_r8,3.8549e+00_r8,7.6925e+00_r8,1.1504e+01_r8,1.5265e+01_r8,1.8935e+01_r8, & + &2.2399e+01_r8,2.5067e+01_r8,3.0529e+01_r8/) + kao(:, 1, 4,15) = (/ & + &5.8511e-02_r8,1.9940e+00_r8,3.9844e+00_r8,5.9687e+00_r8,7.9437e+00_r8,9.9016e+00_r8, & + &1.1811e+01_r8,1.3553e+01_r8,1.5887e+01_r8/) + kao(:, 2, 4,15) = (/ & + &5.6982e-02_r8,2.4233e+00_r8,4.8420e+00_r8,7.2530e+00_r8,9.6512e+00_r8,1.2029e+01_r8, & + &1.4341e+01_r8,1.6438e+01_r8,1.9302e+01_r8/) + kao(:, 3, 4,15) = (/ & + &5.5673e-02_r8,2.8886e+00_r8,5.7711e+00_r8,8.6444e+00_r8,1.1501e+01_r8,1.4329e+01_r8, & + &1.7084e+01_r8,1.9562e+01_r8,2.3002e+01_r8/) + kao(:, 4, 4,15) = (/ & + &5.4580e-02_r8,3.3869e+00_r8,6.7661e+00_r8,1.0134e+01_r8,1.3482e+01_r8,1.6795e+01_r8, & + &2.0015e+01_r8,2.2895e+01_r8,2.6964e+01_r8/) + kao(:, 5, 4,15) = (/ & + &5.3615e-02_r8,3.9077e+00_r8,7.8058e+00_r8,1.1691e+01_r8,1.5555e+01_r8,1.9373e+01_r8, & + &2.3083e+01_r8,2.6384e+01_r8,3.1109e+01_r8/) + kao(:, 1, 5,15) = (/ & + &1.2989e-01_r8,1.8900e+00_r8,3.7783e+00_r8,5.6637e+00_r8,7.5463e+00_r8,9.4177e+00_r8, & + &1.1267e+01_r8,1.3028e+01_r8,1.5093e+01_r8/) + kao(:, 2, 5,15) = (/ & + &1.2665e-01_r8,2.3422e+00_r8,4.6829e+00_r8,7.0179e+00_r8,9.3476e+00_r8,1.1662e+01_r8, & + &1.3953e+01_r8,1.6125e+01_r8,1.8695e+01_r8/) + kao(:, 3, 5,15) = (/ & + &1.2397e-01_r8,2.8405e+00_r8,5.6772e+00_r8,8.5098e+00_r8,1.1334e+01_r8,1.4142e+01_r8, & + &1.6912e+01_r8,1.9527e+01_r8,2.2668e+01_r8/) + kao(:, 4, 5,15) = (/ & + &1.2164e-01_r8,3.3767e+00_r8,6.7490e+00_r8,1.0116e+01_r8,1.3472e+01_r8,1.6807e+01_r8, & + &2.0097e+01_r8,2.3197e+01_r8,2.6943e+01_r8/) + kao(:, 5, 5,15) = (/ & + &1.1945e-01_r8,3.9432e+00_r8,7.8814e+00_r8,1.1812e+01_r8,1.5732e+01_r8,1.9624e+01_r8, & + &2.3463e+01_r8,2.7077e+01_r8,3.1463e+01_r8/) + kao(:, 1, 6,15) = (/ & + &2.7269e-01_r8,1.7592e+00_r8,3.5166e+00_r8,5.2733e+00_r8,7.0272e+00_r8,8.7771e+00_r8, & + &1.0515e+01_r8,1.2209e+01_r8,1.4054e+01_r8/) + kao(:, 2, 6,15) = (/ & + &2.6586e-01_r8,2.2331e+00_r8,4.4644e+00_r8,6.6948e+00_r8,8.9210e+00_r8,1.1141e+01_r8, & + &1.3343e+01_r8,1.5486e+01_r8,1.7841e+01_r8/) + kao(:, 3, 6,15) = (/ & + &2.5987e-01_r8,2.7625e+00_r8,5.5224e+00_r8,8.2799e+00_r8,1.1033e+01_r8,1.3778e+01_r8, & + &1.6504e+01_r8,1.9146e+01_r8,2.2064e+01_r8/) + kao(:, 4, 6,15) = (/ & + &2.5470e-01_r8,3.3380e+00_r8,6.6713e+00_r8,1.0004e+01_r8,1.3331e+01_r8,1.6646e+01_r8, & + &1.9934e+01_r8,2.3121e+01_r8,2.6661e+01_r8/) + kao(:, 5, 6,15) = (/ & + &2.4980e-01_r8,3.9509e+00_r8,7.8982e+00_r8,1.1841e+01_r8,1.5778e+01_r8,1.9702e+01_r8, & + &2.3595e+01_r8,2.7362e+01_r8,3.1554e+01_r8/) + kao(:, 1, 7,15) = (/ & + &6.0751e-01_r8,1.6155e+00_r8,3.2295e+00_r8,4.8433e+00_r8,6.4556e+00_r8,8.0666e+00_r8, & + &9.6721e+00_r8,1.1255e+01_r8,1.2910e+01_r8/) + kao(:, 2, 7,15) = (/ & + &5.9214e-01_r8,2.1056e+00_r8,4.2107e+00_r8,6.3119e+00_r8,8.4131e+00_r8,1.0511e+01_r8, & + &1.2602e+01_r8,1.4667e+01_r8,1.6825e+01_r8/) + kao(:, 3, 7,15) = (/ & + &5.7904e-01_r8,2.6613e+00_r8,5.3198e+00_r8,7.9772e+00_r8,1.0632e+01_r8,1.3285e+01_r8, & + &1.5925e+01_r8,1.8528e+01_r8,2.1262e+01_r8/) + kao(:, 4, 7,15) = (/ & + &5.6819e-01_r8,3.2710e+00_r8,6.5412e+00_r8,9.8097e+00_r8,1.3074e+01_r8,1.6330e+01_r8, & + &1.9581e+01_r8,2.2775e+01_r8,2.6146e+01_r8/) + kao(:, 5, 7,15) = (/ & + &5.5940e-01_r8,3.9287e+00_r8,7.8537e+00_r8,1.1777e+01_r8,1.5697e+01_r8,1.9610e+01_r8, & + &2.3510e+01_r8,2.7346e+01_r8,3.1392e+01_r8/) + kao(:, 1, 8,15) = (/ & + &1.5944e+00_r8,1.8253e+00_r8,2.9741e+00_r8,4.4602e+00_r8,5.9464e+00_r8,7.4314e+00_r8, & + &8.9145e+00_r8,1.0387e+01_r8,1.1892e+01_r8/) + kao(:, 2, 8,15) = (/ & + &1.5557e+00_r8,2.1022e+00_r8,3.9278e+00_r8,5.8889e+00_r8,7.8512e+00_r8,9.8106e+00_r8, & + &1.1770e+01_r8,1.3716e+01_r8,1.5700e+01_r8/) + kao(:, 3, 8,15) = (/ & + &1.5271e+00_r8,2.5583e+00_r8,5.0719e+00_r8,7.6057e+00_r8,1.0139e+01_r8,1.2670e+01_r8, & + &1.5200e+01_r8,1.7713e+01_r8,2.0275e+01_r8/) + kao(:, 4, 8,15) = (/ & + &1.5040e+00_r8,3.1773e+00_r8,6.3513e+00_r8,9.5214e+00_r8,1.2692e+01_r8,1.5861e+01_r8, & + &1.9025e+01_r8,2.2168e+01_r8,2.5379e+01_r8/) + kao(:, 5, 8,15) = (/ & + &1.4829e+00_r8,3.8723e+00_r8,7.7385e+00_r8,1.1605e+01_r8,1.5469e+01_r8,1.9331e+01_r8, & + &2.3189e+01_r8,2.7019e+01_r8,3.0932e+01_r8/) + kao(:, 1, 9,15) = (/ & + &7.9603e+00_r8,6.9650e+00_r8,6.1670e+00_r8,5.9409e+00_r8,5.9163e+00_r8,6.8445e+00_r8, & + &8.2104e+00_r8,9.5758e+00_r8,1.0949e+01_r8/) + kao(:, 2, 9,15) = (/ & + &7.7491e+00_r8,6.7807e+00_r8,6.5143e+00_r8,6.5222e+00_r8,7.4209e+00_r8,9.1698e+00_r8, & + &1.1001e+01_r8,1.2830e+01_r8,1.4668e+01_r8/) + kao(:, 3, 9,15) = (/ & + &7.6260e+00_r8,6.7058e+00_r8,6.8127e+00_r8,7.5772e+00_r8,9.5702e+00_r8,1.1961e+01_r8, & + &1.4350e+01_r8,1.6735e+01_r8,1.9129e+01_r8/) + kao(:, 4, 9,15) = (/ & + &7.5222e+00_r8,6.8189e+00_r8,7.2464e+00_r8,9.2266e+00_r8,1.2156e+01_r8,1.5192e+01_r8, & + &1.8221e+01_r8,2.1251e+01_r8,2.4297e+01_r8/) + kao(:, 5, 9,15) = (/ & + &7.4213e+00_r8,6.9850e+00_r8,8.1141e+00_r8,1.1288e+01_r8,1.5041e+01_r8,1.8797e+01_r8, & + &2.2550e+01_r8,2.6298e+01_r8,3.0063e+01_r8/) + kao(:, 1,10,15) = (/ & + &4.4970e+01_r8,3.9351e+01_r8,3.3728e+01_r8,2.8106e+01_r8,2.2484e+01_r8,1.7001e+01_r8, & + &1.2662e+01_r8,9.3833e+00_r8,3.0844e+00_r8/) + kao(:, 2,10,15) = (/ & + &4.3703e+01_r8,3.8241e+01_r8,3.2779e+01_r8,2.7313e+01_r8,2.1862e+01_r8,1.7553e+01_r8, & + &1.3621e+01_r8,1.2273e+01_r8,6.8989e+00_r8/) + kao(:, 3,10,15) = (/ & + &4.2828e+01_r8,3.7472e+01_r8,3.2122e+01_r8,2.6765e+01_r8,2.2087e+01_r8,1.8341e+01_r8, & + &1.5372e+01_r8,1.6156e+01_r8,1.4584e+01_r8/) + kao(:, 4,10,15) = (/ & + &4.2192e+01_r8,3.6921e+01_r8,3.1646e+01_r8,2.6524e+01_r8,2.2776e+01_r8,1.9260e+01_r8, & + &1.8346e+01_r8,2.0694e+01_r8,2.3643e+01_r8/) + kao(:, 5,10,15) = (/ & + &4.1609e+01_r8,3.6411e+01_r8,3.1210e+01_r8,2.6835e+01_r8,2.3359e+01_r8,2.1143e+01_r8, & + &2.2256e+01_r8,2.5773e+01_r8,2.9447e+01_r8/) + kao(:, 1,11,15) = (/ & + &8.7878e+01_r8,7.6892e+01_r8,6.5913e+01_r8,5.4929e+01_r8,4.3942e+01_r8,3.2958e+01_r8, & + &2.2278e+01_r8,1.3146e+01_r8,1.2934e+00_r8/) + kao(:, 2,11,15) = (/ & + &8.5528e+01_r8,7.4837e+01_r8,6.4148e+01_r8,5.3454e+01_r8,4.2765e+01_r8,3.2087e+01_r8, & + &2.2860e+01_r8,1.5064e+01_r8,9.2095e-01_r8/) + kao(:, 3,11,15) = (/ & + &8.3842e+01_r8,7.3371e+01_r8,6.2884e+01_r8,5.2405e+01_r8,4.1923e+01_r8,3.2241e+01_r8, & + &2.3615e+01_r8,1.8250e+01_r8,5.0549e+00_r8/) + kao(:, 4,11,15) = (/ & + &8.2422e+01_r8,7.2123e+01_r8,6.1819e+01_r8,5.1515e+01_r8,4.1404e+01_r8,3.2935e+01_r8, & + &2.5033e+01_r8,2.2612e+01_r8,1.1342e+01_r8/) + kao(:, 5,11,15) = (/ & + &8.1155e+01_r8,7.1009e+01_r8,6.0866e+01_r8,5.0722e+01_r8,4.1664e+01_r8,3.3361e+01_r8, & + &2.7672e+01_r8,2.7836e+01_r8,2.1588e+01_r8/) + kao(:, 1,12,15) = (/ & + &1.2764e+02_r8,1.1168e+02_r8,9.5717e+01_r8,7.9766e+01_r8,6.3821e+01_r8,4.7862e+01_r8, & + &3.1927e+01_r8,1.7517e+01_r8,5.0733e-04_r8/) + kao(:, 2,12,15) = (/ & + &1.2458e+02_r8,1.0901e+02_r8,9.3437e+01_r8,7.7867e+01_r8,6.2287e+01_r8,4.6718e+01_r8, & + &3.2041e+01_r8,1.8889e+01_r8,1.2295e+00_r8/) + kao(:, 3,12,15) = (/ & + &1.2214e+02_r8,1.0687e+02_r8,9.1606e+01_r8,7.6332e+01_r8,6.1069e+01_r8,4.6041e+01_r8, & + &3.2605e+01_r8,2.1597e+01_r8,1.0764e+00_r8/) + kao(:, 4,12,15) = (/ & + &1.1993e+02_r8,1.0494e+02_r8,8.9942e+01_r8,7.4954e+01_r8,5.9961e+01_r8,4.6289e+01_r8, & + &3.3082e+01_r8,2.5581e+01_r8,1.5268e+00_r8/) + kao(:, 5,12,15) = (/ & + &1.1793e+02_r8,1.0318e+02_r8,8.8443e+01_r8,7.3700e+01_r8,5.9323e+01_r8,4.6666e+01_r8, & + &3.5017e+01_r8,3.0597e+01_r8,1.3997e+01_r8/) + kao(:, 1,13,15) = (/ & + &1.4863e+02_r8,1.3005e+02_r8,1.1147e+02_r8,9.2892e+01_r8,7.4315e+01_r8,5.5737e+01_r8, & + &3.7199e+01_r8,2.0080e+01_r8,6.4806e-01_r8/) + kao(:, 2,13,15) = (/ & + &1.4520e+02_r8,1.2704e+02_r8,1.0889e+02_r8,9.0753e+01_r8,7.2597e+01_r8,5.4452e+01_r8, & + &3.7281e+01_r8,2.1314e+01_r8,1.2348e+00_r8/) + kao(:, 3,13,15) = (/ & + &1.4229e+02_r8,1.2450e+02_r8,1.0672e+02_r8,8.8931e+01_r8,7.1150e+01_r8,5.3675e+01_r8, & + &3.7660e+01_r8,2.4186e+01_r8,1.1194e+00_r8/) + kao(:, 4,13,15) = (/ & + &1.3965e+02_r8,1.2219e+02_r8,1.0474e+02_r8,8.7285e+01_r8,6.9825e+01_r8,5.3800e+01_r8, & + &3.7958e+01_r8,2.8295e+01_r8,2.6393e+00_r8/) + kao(:, 5,13,15) = (/ & + &1.3732e+02_r8,1.2017e+02_r8,1.0299e+02_r8,8.5829e+01_r8,6.9074e+01_r8,5.3874e+01_r8, & + &3.9693e+01_r8,3.3322e+01_r8,1.2822e+01_r8/) + kao(:, 1, 1,16) = (/ & + &6.7483e-03_r8,2.7477e+00_r8,5.4216e+00_r8,7.9838e+00_r8,1.0362e+01_r8,1.2414e+01_r8, & + &1.3792e+01_r8,1.3364e+01_r8,2.0724e+01_r8/) + kao(:, 2, 1,16) = (/ & + &6.6276e-03_r8,3.2705e+00_r8,6.4539e+00_r8,9.5049e+00_r8,1.2338e+01_r8,1.4784e+01_r8, & + &1.6428e+01_r8,1.5929e+01_r8,2.4675e+01_r8/) + kao(:, 3, 1,16) = (/ & + &6.5036e-03_r8,3.8140e+00_r8,7.5283e+00_r8,1.1085e+01_r8,1.4395e+01_r8,1.7249e+01_r8, & + &1.9172e+01_r8,1.8603e+01_r8,2.8790e+01_r8/) + kao(:, 4, 1,16) = (/ & + &6.3721e-03_r8,4.3730e+00_r8,8.6292e+00_r8,1.2711e+01_r8,1.6503e+01_r8,1.9784e+01_r8, & + &2.1993e+01_r8,2.1351e+01_r8,3.3006e+01_r8/) + kao(:, 5, 1,16) = (/ & + &6.2363e-03_r8,4.9396e+00_r8,9.7465e+00_r8,1.4357e+01_r8,1.8648e+01_r8,2.2353e+01_r8, & + &2.4860e+01_r8,2.4146e+01_r8,3.7295e+01_r8/) + kao(:, 1, 2,16) = (/ & + &1.1399e-02_r8,3.0700e+00_r8,6.0865e+00_r8,9.0222e+00_r8,1.1819e+01_r8,1.4357e+01_r8, & + &1.6335e+01_r8,1.6615e+01_r8,2.3637e+01_r8/) + kao(:, 2, 2,16) = (/ & + &1.1191e-02_r8,3.6855e+00_r8,7.3071e+00_r8,1.0831e+01_r8,1.4189e+01_r8,1.7243e+01_r8, & + &1.9624e+01_r8,1.9971e+01_r8,2.8378e+01_r8/) + kao(:, 3, 2,16) = (/ & + &1.0967e-02_r8,4.3287e+00_r8,8.5840e+00_r8,1.2722e+01_r8,1.6670e+01_r8,2.0258e+01_r8, & + &2.3062e+01_r8,2.3488e+01_r8,3.3340e+01_r8/) + kao(:, 4, 2,16) = (/ & + &1.0738e-02_r8,4.9902e+00_r8,9.8948e+00_r8,1.4671e+01_r8,1.9224e+01_r8,2.3370e+01_r8, & + &2.6613e+01_r8,2.7035e+01_r8,3.8446e+01_r8/) + kao(:, 5, 2,16) = (/ & + &1.0463e-02_r8,5.6638e+00_r8,1.1230e+01_r8,1.6648e+01_r8,2.1823e+01_r8,2.6530e+01_r8, & + &3.0222e+01_r8,3.0819e+01_r8,4.3644e+01_r8/) + kao(:, 1, 3,16) = (/ & + &2.6306e-02_r8,3.2694e+00_r8,6.5125e+00_r8,9.7138e+00_r8,1.2840e+01_r8,1.5828e+01_r8, & + &1.8484e+01_r8,2.0009e+01_r8,2.5680e+01_r8/) + kao(:, 2, 3,16) = (/ & + &2.5884e-02_r8,3.9785e+00_r8,7.9277e+00_r8,1.1819e+01_r8,1.5631e+01_r8,1.9201e+01_r8, & + &2.2505e+01_r8,2.4372e+01_r8,3.1262e+01_r8/) + kao(:, 3, 3,16) = (/ & + &2.5346e-02_r8,4.7273e+00_r8,9.4145e+00_r8,1.4042e+01_r8,1.8571e+01_r8,2.2894e+01_r8, & + &2.6751e+01_r8,2.8974e+01_r8,3.7022e+01_r8/) + kao(:, 4, 3,16) = (/ & + &2.4784e-02_r8,5.5013e+00_r8,1.0958e+01_r8,1.6345e+01_r8,2.1611e+01_r8,2.6651e+01_r8, & + &3.1147e+01_r8,3.3763e+01_r8,4.3221e+01_r8/) + kao(:, 5, 3,16) = (/ & + &2.4200e-02_r8,6.2942e+00_r8,1.2535e+01_r8,1.8701e+01_r8,2.4733e+01_r8,3.0502e+01_r8, & + &3.5641e+01_r8,3.8658e+01_r8,4.9465e+01_r8/) + kao(:, 1, 4,16) = (/ & + &6.3011e-02_r8,3.3909e+00_r8,6.7686e+00_r8,1.0126e+01_r8,1.3449e+01_r8,1.6701e+01_r8, & + &1.9789e+01_r8,2.2242e+01_r8,2.6898e+01_r8/) + kao(:, 2, 4,16) = (/ & + &6.1738e-02_r8,4.1953e+00_r8,8.3750e+00_r8,1.2529e+01_r8,1.6640e+01_r8,2.0669e+01_r8, & + &2.4483e+01_r8,2.7534e+01_r8,3.3280e+01_r8/) + kao(:, 3, 4,16) = (/ & + &6.0385e-02_r8,5.0522e+00_r8,1.0085e+01_r8,1.5088e+01_r8,2.0041e+01_r8,2.4891e+01_r8, & + &2.9498e+01_r8,3.3182e+01_r8,4.0082e+01_r8/) + kao(:, 4, 4,16) = (/ & + &5.8960e-02_r8,5.9475e+00_r8,1.1873e+01_r8,1.7764e+01_r8,2.3588e+01_r8,2.9299e+01_r8, & + &3.4723e+01_r8,3.9079e+01_r8,4.7175e+01_r8/) + kao(:, 5, 4,16) = (/ & + &5.7513e-02_r8,6.8674e+00_r8,1.3704e+01_r8,2.0508e+01_r8,2.7243e+01_r8,3.3832e+01_r8, & + &4.0104e+01_r8,4.5142e+01_r8,5.4486e+01_r8/) + kao(:, 1, 5,16) = (/ & + &1.5311e-01_r8,3.4647e+00_r8,6.9218e+00_r8,1.0370e+01_r8,1.3799e+01_r8,1.7194e+01_r8, & + &2.0501e+01_r8,2.3473e+01_r8,2.7599e+01_r8/) + kao(:, 2, 5,16) = (/ & + &1.4808e-01_r8,4.3642e+00_r8,8.7211e+00_r8,1.3066e+01_r8,1.7386e+01_r8,2.1656e+01_r8, & + &2.5836e+01_r8,2.9576e+01_r8,3.4772e+01_r8/) + kao(:, 3, 5,16) = (/ & + &1.4324e-01_r8,5.3326e+00_r8,1.0656e+01_r8,1.5962e+01_r8,2.1244e+01_r8,2.6472e+01_r8, & + &3.1566e+01_r8,3.6158e+01_r8,4.2487e+01_r8/) + kao(:, 4, 5,16) = (/ & + &1.3867e-01_r8,6.3343e+00_r8,1.2694e+01_r8,1.9018e+01_r8,2.5310e+01_r8,3.1544e+01_r8, & + &3.7609e+01_r8,4.3076e+01_r8,5.0619e+01_r8/) + kao(:, 5, 5,16) = (/ & + &1.3442e-01_r8,7.4110e+00_r8,1.4809e+01_r8,2.2187e+01_r8,2.9523e+01_r8,3.6788e+01_r8, & + &4.3874e+01_r8,5.0262e+01_r8,5.9046e+01_r8/) + kao(:, 1, 6,16) = (/ & + &3.3965e-01_r8,3.4550e+00_r8,6.9058e+00_r8,1.0352e+01_r8,1.3789e+01_r8,1.7206e+01_r8, & + &2.0578e+01_r8,2.3766e+01_r8,2.7578e+01_r8/) + kao(:, 2, 6,16) = (/ & + &3.2990e-01_r8,4.4451e+00_r8,8.8565e+00_r8,1.3318e+01_r8,1.7740e+01_r8,2.2139e+01_r8, & + &2.6477e+01_r8,3.0582e+01_r8,3.5479e+01_r8/) + kao(:, 3, 6,16) = (/ & + &3.2021e-01_r8,5.5240e+00_r8,1.1042e+01_r8,1.6554e+01_r8,2.2048e+01_r8,2.7511e+01_r8, & + &3.2908e+01_r8,3.8025e+01_r8,4.4095e+01_r8/) + kao(:, 4, 6,16) = (/ & + &3.1092e-01_r8,6.6752e+00_r8,1.3341e+01_r8,2.0002e+01_r8,2.6641e+01_r8,3.3245e+01_r8, & + &3.9761e+01_r8,4.5941e+01_r8,5.3282e+01_r8/) + kao(:, 5, 6,16) = (/ & + &3.0227e-01_r8,7.8771e+00_r8,1.5743e+01_r8,2.3602e+01_r8,3.1434e+01_r8,3.9236e+01_r8, & + &4.6923e+01_r8,5.4228e+01_r8,6.2865e+01_r8/) + kao(:, 1, 7,16) = (/ & + &7.9672e-01_r8,3.3862e+00_r8,6.7703e+00_r8,1.0151e+01_r8,1.3528e+01_r8,1.6895e+01_r8, & + &2.0243e+01_r8,2.3498e+01_r8,2.7056e+01_r8/) + kao(:, 2, 7,16) = (/ & + &7.7399e-01_r8,4.4592e+00_r8,8.9171e+00_r8,1.3369e+01_r8,1.7816e+01_r8,2.2252e+01_r8, & + &2.6655e+01_r8,3.0954e+01_r8,3.5514e+01_r8/) + kao(:, 3, 7,16) = (/ & + &7.5170e-01_r8,5.6480e+00_r8,1.1293e+01_r8,1.6933e+01_r8,2.2566e+01_r8,2.8186e+01_r8, & + &3.3769e+01_r8,3.9205e+01_r8,4.5131e+01_r8/) + kao(:, 4, 7,16) = (/ & + &7.3106e-01_r8,6.9294e+00_r8,1.3857e+01_r8,2.0779e+01_r8,2.7691e+01_r8,3.4583e+01_r8, & + &4.1435e+01_r8,4.8102e+01_r8,5.5380e+01_r8/) + kao(:, 5, 7,16) = (/ & + &7.1147e-01_r8,8.2841e+00_r8,1.6563e+01_r8,2.4830e+01_r8,3.3089e+01_r8,4.1334e+01_r8, & + &4.9522e+01_r8,5.7496e+01_r8,6.6175e+01_r8/) + kao(:, 1, 8,16) = (/ & + &2.2037e+00_r8,3.2722e+00_r8,6.5418e+00_r8,9.8122e+00_r8,1.3082e+01_r8,1.6344e+01_r8, & + &1.9599e+01_r8,2.2817e+01_r8,2.6163e+01_r8/) + kao(:, 2, 8,16) = (/ & + &2.1416e+00_r8,4.4204e+00_r8,8.8385e+00_r8,1.3255e+01_r8,1.7675e+01_r8,2.2079e+01_r8, & + &2.6477e+01_r8,3.0833e+01_r8,3.5348e+01_r8/) + kao(:, 3, 8,16) = (/ & + &2.0842e+00_r8,5.7151e+00_r8,1.1428e+01_r8,1.7137e+01_r8,2.2842e+01_r8,2.8548e+01_r8, & + &3.4230e+01_r8,3.9856e+01_r8,4.5681e+01_r8/) + kao(:, 4, 8,16) = (/ & + &2.0305e+00_r8,7.1274e+00_r8,1.4255e+01_r8,2.1373e+01_r8,2.8489e+01_r8,3.5598e+01_r8, & + &4.2693e+01_r8,4.9704e+01_r8,5.6975e+01_r8/) + kao(:, 5, 8,16) = (/ & + &1.9781e+00_r8,8.6369e+00_r8,1.7269e+01_r8,2.5895e+01_r8,3.4524e+01_r8,4.3140e+01_r8, & + &5.1725e+01_r8,6.0225e+01_r8,6.9043e+01_r8/) + kao(:, 1, 9,16) = (/ & + &1.1509e+01_r8,1.0070e+01_r8,8.6316e+00_r8,9.3146e+00_r8,1.2418e+01_r8,1.5525e+01_r8, & + &1.8622e+01_r8,2.1717e+01_r8,2.4834e+01_r8/) + kao(:, 2, 9,16) = (/ & + &1.1216e+01_r8,9.8124e+00_r8,8.9628e+00_r8,1.2947e+01_r8,1.7258e+01_r8,2.1566e+01_r8, & + &2.5882e+01_r8,3.0171e+01_r8,3.4512e+01_r8/) + kao(:, 3, 9,16) = (/ & + &1.0936e+01_r8,9.5703e+00_r8,1.1414e+01_r8,1.7115e+01_r8,2.2811e+01_r8,2.8515e+01_r8, & + &3.4212e+01_r8,3.9896e+01_r8,4.5613e+01_r8/) + kao(:, 4, 9,16) = (/ & + &1.0665e+01_r8,9.3327e+00_r8,1.4497e+01_r8,2.1741e+01_r8,2.8981e+01_r8,3.6218e+01_r8, & + &4.3300e+01_r8,5.0677e+01_r8,5.7950e+01_r8/) + kao(:, 5, 9,16) = (/ & + &1.0398e+01_r8,9.5016e+00_r8,1.7820e+01_r8,2.6724e+01_r8,3.5623e+01_r8,4.4518e+01_r8, & + &5.3410e+01_r8,6.2271e+01_r8,7.1226e+01_r8/) + kao(:, 1,10,16) = (/ & + &6.7305e+01_r8,5.8689e+01_r8,5.0477e+01_r8,4.2062e+01_r8,3.3650e+01_r8,2.5240e+01_r8, & + &1.8527e+01_r8,2.0871e+01_r8,2.3854e+01_r8/) + kao(:, 2,10,16) = (/ & + &6.5751e+01_r8,5.7530e+01_r8,4.9313e+01_r8,4.1093e+01_r8,3.2876e+01_r8,2.4802e+01_r8, & + &2.5524e+01_r8,2.9774e+01_r8,3.4038e+01_r8/) + kao(:, 3,10,16) = (/ & + &6.4198e+01_r8,5.6172e+01_r8,4.8149e+01_r8,4.0130e+01_r8,3.2100e+01_r8,2.8998e+01_r8, & + &3.4448e+01_r8,4.0179e+01_r8,4.5916e+01_r8/) + kao(:, 4,10,16) = (/ & + &6.2664e+01_r8,5.4833e+01_r8,4.6832e+01_r8,3.9166e+01_r8,3.2607e+01_r8,3.7058e+01_r8, & + &4.4476e+01_r8,5.1875e+01_r8,5.9284e+01_r8/) + kao(:, 5,10,16) = (/ & + &6.1101e+01_r8,5.3467e+01_r8,4.5664e+01_r8,3.8190e+01_r8,3.7365e+01_r8,4.6149e+01_r8, & + &5.5367e+01_r8,6.4570e+01_r8,7.3787e+01_r8/) + kao(:, 1,11,16) = (/ & + &1.3576e+02_r8,1.1879e+02_r8,1.0182e+02_r8,8.4849e+01_r8,6.7875e+01_r8,5.0907e+01_r8, & + &3.3938e+01_r8,2.3799e+01_r8,9.0162e+00_r8/) + kao(:, 2,11,16) = (/ & + &1.3280e+02_r8,1.1619e+02_r8,9.9587e+01_r8,8.3000e+01_r8,6.6392e+01_r8,4.9800e+01_r8, & + &3.3906e+01_r8,3.3859e+01_r8,3.7265e+01_r8/) + kao(:, 3,11,16) = (/ & + &1.2969e+02_r8,1.1350e+02_r8,9.7289e+01_r8,8.1076e+01_r8,6.4844e+01_r8,4.8642e+01_r8, & + &3.9970e+01_r8,4.5587e+01_r8,5.2094e+01_r8/) + kao(:, 4,11,16) = (/ & + &1.2653e+02_r8,1.1071e+02_r8,9.4885e+01_r8,7.9077e+01_r8,6.3265e+01_r8,4.8850e+01_r8, & + &5.0310e+01_r8,5.8678e+01_r8,6.7071e+01_r8/) + kao(:, 5,11,16) = (/ & + &1.2325e+02_r8,1.0784e+02_r8,9.2433e+01_r8,7.7029e+01_r8,6.1622e+01_r8,5.4553e+01_r8, & + &6.2511e+01_r8,7.2895e+01_r8,8.3291e+01_r8/) + kao(:, 1,12,16) = (/ & + &2.0298e+02_r8,1.7762e+02_r8,1.5224e+02_r8,1.2687e+02_r8,1.0147e+02_r8,7.6126e+01_r8, & + &5.0748e+01_r8,2.9045e+01_r8,9.6314e-05_r8/) + kao(:, 2,12,16) = (/ & + &1.9850e+02_r8,1.7368e+02_r8,1.4888e+02_r8,1.2405e+02_r8,9.9250e+01_r8,7.4435e+01_r8, & + &4.9625e+01_r8,3.8234e+01_r8,2.3705e+01_r8/) + kao(:, 3,12,16) = (/ & + &1.9369e+02_r8,1.6949e+02_r8,1.4528e+02_r8,1.2103e+02_r8,9.6845e+01_r8,7.2640e+01_r8, & + &5.1319e+01_r8,5.1242e+01_r8,5.0529e+01_r8/) + kao(:, 4,12,16) = (/ & + &1.8865e+02_r8,1.6508e+02_r8,1.4148e+02_r8,1.1791e+02_r8,9.4323e+01_r8,7.0746e+01_r8, & + &5.9155e+01_r8,6.5776e+01_r8,7.5148e+01_r8/) + kao(:, 5,12,16) = (/ & + &1.8345e+02_r8,1.6051e+02_r8,1.3757e+02_r8,1.1465e+02_r8,9.1715e+01_r8,7.1673e+01_r8, & + &7.0340e+01_r8,8.1440e+01_r8,9.3046e+01_r8/) + kao(:, 1,13,16) = (/ & + &2.4179e+02_r8,2.1156e+02_r8,1.8133e+02_r8,1.5111e+02_r8,1.2089e+02_r8,9.0670e+01_r8, & + &6.0447e+01_r8,3.4181e+01_r8,7.5740e-05_r8/) + kao(:, 2,13,16) = (/ & + &2.3602e+02_r8,2.0653e+02_r8,1.7702e+02_r8,1.4755e+02_r8,1.1802e+02_r8,8.8512e+01_r8, & + &5.9018e+01_r8,4.3484e+01_r8,2.5520e+01_r8/) + kao(:, 3,13,16) = (/ & + &2.2984e+02_r8,2.0112e+02_r8,1.7238e+02_r8,1.4366e+02_r8,1.1493e+02_r8,8.6216e+01_r8, & + &6.0956e+01_r8,5.6909e+01_r8,5.1259e+01_r8/) + kao(:, 4,13,16) = (/ & + &2.2335e+02_r8,1.9547e+02_r8,1.6749e+02_r8,1.3960e+02_r8,1.1169e+02_r8,8.3756e+01_r8, & + &6.8596e+01_r8,7.2790e+01_r8,7.7355e+01_r8/) + kao(:, 5,13,16) = (/ & + &2.1661e+02_r8,1.8954e+02_r8,1.6247e+02_r8,1.3539e+02_r8,1.0832e+02_r8,8.5058e+01_r8, & + &7.9741e+01_r8,8.9915e+01_r8,1.0226e+02_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &2.3382e-03_r8,2.8918e-03_r8,3.5228e-03_r8,4.2513e-03_r8,5.0992e-03_r8/) + kbo(:,14, 1) = (/ & + &2.0993e-03_r8,2.6087e-03_r8,3.2027e-03_r8,3.9155e-03_r8,4.7075e-03_r8/) + kbo(:,15, 1) = (/ & + &1.9068e-03_r8,2.4224e-03_r8,2.9993e-03_r8,3.6366e-03_r8,4.4490e-03_r8/) + kbo(:,16, 1) = (/ & + &1.7630e-03_r8,2.2267e-03_r8,2.7514e-03_r8,3.4114e-03_r8,4.1614e-03_r8/) + kbo(:,17, 1) = (/ & + &1.6519e-03_r8,2.0886e-03_r8,2.6010e-03_r8,3.2457e-03_r8,3.9066e-03_r8/) + kbo(:,18, 1) = (/ & + &1.5561e-03_r8,1.9733e-03_r8,2.5429e-03_r8,3.1325e-03_r8,3.6764e-03_r8/) + kbo(:,19, 1) = (/ & + &1.4778e-03_r8,1.9477e-03_r8,2.4734e-03_r8,2.9725e-03_r8,3.4413e-03_r8/) + kbo(:,20, 1) = (/ & + &1.3764e-03_r8,1.8206e-03_r8,2.2794e-03_r8,2.6918e-03_r8,3.0807e-03_r8/) + kbo(:,21, 1) = (/ & + &1.2547e-03_r8,1.6614e-03_r8,2.0387e-03_r8,2.3912e-03_r8,2.7222e-03_r8/) + kbo(:,22, 1) = (/ & + &1.1692e-03_r8,1.5034e-03_r8,1.8117e-03_r8,2.1136e-03_r8,2.3959e-03_r8/) + kbo(:,23, 1) = (/ & + &1.0852e-03_r8,1.3578e-03_r8,1.6152e-03_r8,1.8580e-03_r8,2.0983e-03_r8/) + kbo(:,24, 1) = (/ & + &9.9196e-04_r8,1.2216e-03_r8,1.4332e-03_r8,1.6336e-03_r8,1.8396e-03_r8/) + kbo(:,25, 1) = (/ & + &9.0621e-04_r8,1.0934e-03_r8,1.2579e-03_r8,1.4326e-03_r8,1.5972e-03_r8/) + kbo(:,26, 1) = (/ & + &8.1196e-04_r8,9.6544e-04_r8,1.0989e-03_r8,1.2439e-03_r8,1.3772e-03_r8/) + kbo(:,27, 1) = (/ & + &7.2402e-04_r8,8.4382e-04_r8,9.5455e-04_r8,1.0692e-03_r8,1.1790e-03_r8/) + kbo(:,28, 1) = (/ & + &6.3816e-04_r8,7.3173e-04_r8,8.2333e-04_r8,9.1530e-04_r8,1.0008e-03_r8/) + kbo(:,29, 1) = (/ & + &5.5611e-04_r8,6.2561e-04_r8,7.0457e-04_r8,7.7239e-04_r8,8.4074e-04_r8/) + kbo(:,30, 1) = (/ & + &4.7758e-04_r8,5.3585e-04_r8,5.9602e-04_r8,6.4848e-04_r8,7.0299e-04_r8/) + kbo(:,31, 1) = (/ & + &4.0233e-04_r8,4.5494e-04_r8,5.0095e-04_r8,5.4165e-04_r8,5.8359e-04_r8/) + kbo(:,32, 1) = (/ & + &3.4147e-04_r8,3.8327e-04_r8,4.2049e-04_r8,4.5512e-04_r8,4.8721e-04_r8/) + kbo(:,33, 1) = (/ & + &2.9210e-04_r8,3.2465e-04_r8,3.5276e-04_r8,3.8153e-04_r8,4.1121e-04_r8/) + kbo(:,34, 1) = (/ & + &2.4930e-04_r8,2.7584e-04_r8,2.9920e-04_r8,3.2247e-04_r8,3.4759e-04_r8/) + kbo(:,35, 1) = (/ & + &2.1208e-04_r8,2.3419e-04_r8,2.5253e-04_r8,2.7252e-04_r8,2.9279e-04_r8/) + kbo(:,36, 1) = (/ & + &1.7811e-04_r8,1.9459e-04_r8,2.1195e-04_r8,2.2908e-04_r8,2.4619e-04_r8/) + kbo(:,37, 1) = (/ & + &1.4252e-04_r8,1.5802e-04_r8,1.7124e-04_r8,1.8557e-04_r8,1.9967e-04_r8/) + kbo(:,38, 1) = (/ & + &1.1316e-04_r8,1.2691e-04_r8,1.3875e-04_r8,1.4940e-04_r8,1.6149e-04_r8/) + kbo(:,39, 1) = (/ & + &8.9734e-05_r8,1.0111e-04_r8,1.1110e-04_r8,1.2104e-04_r8,1.3018e-04_r8/) + kbo(:,40, 1) = (/ & + &6.9862e-05_r8,7.9338e-05_r8,8.7351e-05_r8,9.5361e-05_r8,1.0350e-04_r8/) + kbo(:,41, 1) = (/ & + &5.3903e-05_r8,6.1377e-05_r8,6.8596e-05_r8,7.4910e-05_r8,8.1525e-05_r8/) + kbo(:,42, 1) = (/ & + &4.1353e-05_r8,4.7327e-05_r8,5.3464e-05_r8,5.8873e-05_r8,6.3813e-05_r8/) + kbo(:,43, 1) = (/ & + &3.1177e-05_r8,3.6021e-05_r8,4.0748e-05_r8,4.5236e-05_r8,4.9388e-05_r8/) + kbo(:,44, 1) = (/ & + &2.3155e-05_r8,2.7105e-05_r8,3.0750e-05_r8,3.4487e-05_r8,3.7902e-05_r8/) + kbo(:,45, 1) = (/ & + &1.6939e-05_r8,2.0019e-05_r8,2.3152e-05_r8,2.6034e-05_r8,2.8825e-05_r8/) + kbo(:,46, 1) = (/ & + &1.2188e-05_r8,1.4774e-05_r8,1.7220e-05_r8,1.9590e-05_r8,2.1820e-05_r8/) + kbo(:,47, 1) = (/ & + &8.5598e-06_r8,1.0765e-05_r8,1.2719e-05_r8,1.4628e-05_r8,1.6428e-05_r8/) + kbo(:,48, 1) = (/ & + &5.9262e-06_r8,7.6349e-06_r8,9.2601e-06_r8,1.0811e-05_r8,1.2306e-05_r8/) + kbo(:,49, 1) = (/ & + &3.9332e-06_r8,5.2612e-06_r8,6.6345e-06_r8,7.8390e-06_r8,9.0160e-06_r8/) + kbo(:,50, 1) = (/ & + &2.6915e-06_r8,3.7062e-06_r8,4.7528e-06_r8,5.7591e-06_r8,6.6828e-06_r8/) + kbo(:,51, 1) = (/ & + &1.9031e-06_r8,2.5633e-06_r8,3.3817e-06_r8,4.2212e-06_r8,4.9973e-06_r8/) + kbo(:,52, 1) = (/ & + &1.3022e-06_r8,1.7876e-06_r8,2.4129e-06_r8,3.0582e-06_r8,3.6770e-06_r8/) + kbo(:,53, 1) = (/ & + &8.8514e-07_r8,1.2531e-06_r8,1.6651e-06_r8,2.1701e-06_r8,2.6821e-06_r8/) + kbo(:,54, 1) = (/ & + &6.3174e-07_r8,9.0490e-07_r8,1.2164e-06_r8,1.6231e-06_r8,2.0201e-06_r8/) + kbo(:,55, 1) = (/ & + &4.6092e-07_r8,6.6386e-07_r8,9.1477e-07_r8,1.2278e-06_r8,1.5504e-06_r8/) + kbo(:,56, 1) = (/ & + &3.3312e-07_r8,4.8579e-07_r8,6.8774e-07_r8,9.1495e-07_r8,1.1856e-06_r8/) + kbo(:,57, 1) = (/ & + &2.4004e-07_r8,3.5567e-07_r8,5.1418e-07_r8,6.8280e-07_r8,9.0960e-07_r8/) + kbo(:,58, 1) = (/ & + &1.7424e-07_r8,2.6290e-07_r8,3.8304e-07_r8,5.1880e-07_r8,6.9948e-07_r8/) + kbo(:,59, 1) = (/ & + &1.4545e-07_r8,2.2249e-07_r8,3.3056e-07_r8,4.4487e-07_r8,6.0780e-07_r8/) + kbo(:,13, 2) = (/ & + &1.0289e-02_r8,1.3009e-02_r8,1.5474e-02_r8,1.7839e-02_r8,2.0097e-02_r8/) + kbo(:,14, 2) = (/ & + &9.5725e-03_r8,1.1818e-02_r8,1.3904e-02_r8,1.5918e-02_r8,1.7958e-02_r8/) + kbo(:,15, 2) = (/ & + &8.9675e-03_r8,1.0842e-02_r8,1.2642e-02_r8,1.4399e-02_r8,1.6048e-02_r8/) + kbo(:,16, 2) = (/ & + &8.1677e-03_r8,9.7202e-03_r8,1.1280e-02_r8,1.2681e-02_r8,1.4168e-02_r8/) + kbo(:,17, 2) = (/ & + &7.4338e-03_r8,8.8205e-03_r8,1.0076e-02_r8,1.1262e-02_r8,1.2428e-02_r8/) + kbo(:,18, 2) = (/ & + &6.8634e-03_r8,8.0133e-03_r8,8.9513e-03_r8,9.9366e-03_r8,1.1014e-02_r8/) + kbo(:,19, 2) = (/ & + &6.3552e-03_r8,7.2047e-03_r8,8.0129e-03_r8,8.8966e-03_r8,9.8381e-03_r8/) + kbo(:,20, 2) = (/ & + &5.6397e-03_r8,6.2755e-03_r8,6.9887e-03_r8,7.7846e-03_r8,8.5391e-03_r8/) + kbo(:,21, 2) = (/ & + &4.8925e-03_r8,5.4088e-03_r8,6.0399e-03_r8,6.7004e-03_r8,7.3289e-03_r8/) + kbo(:,22, 2) = (/ & + &4.2004e-03_r8,4.6864e-03_r8,5.2247e-03_r8,5.7527e-03_r8,6.2510e-03_r8/) + kbo(:,23, 2) = (/ & + &3.5982e-03_r8,4.0432e-03_r8,4.4892e-03_r8,4.9192e-03_r8,5.3260e-03_r8/) + kbo(:,24, 2) = (/ & + &3.1341e-03_r8,3.4942e-03_r8,3.8506e-03_r8,4.1837e-03_r8,4.5083e-03_r8/) + kbo(:,25, 2) = (/ & + &2.7078e-03_r8,2.9853e-03_r8,3.2644e-03_r8,3.5527e-03_r8,3.8354e-03_r8/) + kbo(:,26, 2) = (/ & + &2.3166e-03_r8,2.5349e-03_r8,2.7760e-03_r8,3.0099e-03_r8,3.2441e-03_r8/) + kbo(:,27, 2) = (/ & + &1.9581e-03_r8,2.1476e-03_r8,2.3442e-03_r8,2.5333e-03_r8,2.7284e-03_r8/) + kbo(:,28, 2) = (/ & + &1.6566e-03_r8,1.8064e-03_r8,1.9708e-03_r8,2.1221e-03_r8,2.2915e-03_r8/) + kbo(:,29, 2) = (/ & + &1.3865e-03_r8,1.5225e-03_r8,1.6510e-03_r8,1.7817e-03_r8,1.9308e-03_r8/) + kbo(:,30, 2) = (/ & + &1.1671e-03_r8,1.2777e-03_r8,1.3825e-03_r8,1.4960e-03_r8,1.6203e-03_r8/) + kbo(:,31, 2) = (/ & + &9.8586e-04_r8,1.0724e-03_r8,1.1604e-03_r8,1.2563e-03_r8,1.3588e-03_r8/) + kbo(:,32, 2) = (/ & + &8.3378e-04_r8,9.0396e-04_r8,9.7429e-04_r8,1.0568e-03_r8,1.1470e-03_r8/) + kbo(:,33, 2) = (/ & + &7.0369e-04_r8,7.5618e-04_r8,8.2196e-04_r8,8.9196e-04_r8,9.6493e-04_r8/) + kbo(:,34, 2) = (/ & + &5.9334e-04_r8,6.3847e-04_r8,6.9888e-04_r8,7.5675e-04_r8,8.1741e-04_r8/) + kbo(:,35, 2) = (/ & + &4.9419e-04_r8,5.3430e-04_r8,5.8625e-04_r8,6.3690e-04_r8,6.8685e-04_r8/) + kbo(:,36, 2) = (/ & + &4.1196e-04_r8,4.5151e-04_r8,4.9203e-04_r8,5.3162e-04_r8,5.7140e-04_r8/) + kbo(:,37, 2) = (/ & + &3.3813e-04_r8,3.6860e-04_r8,4.0277e-04_r8,4.3459e-04_r8,4.6722e-04_r8/) + kbo(:,38, 2) = (/ & + &2.7817e-04_r8,3.0151e-04_r8,3.2943e-04_r8,3.5593e-04_r8,3.8227e-04_r8/) + kbo(:,39, 2) = (/ & + &2.2867e-04_r8,2.4762e-04_r8,2.6968e-04_r8,2.9008e-04_r8,3.1209e-04_r8/) + kbo(:,40, 2) = (/ & + &1.8342e-04_r8,1.9773e-04_r8,2.1631e-04_r8,2.3254e-04_r8,2.4976e-04_r8/) + kbo(:,41, 2) = (/ & + &1.4676e-04_r8,1.5810e-04_r8,1.7216e-04_r8,1.8594e-04_r8,1.9960e-04_r8/) + kbo(:,42, 2) = (/ & + &1.1746e-04_r8,1.2665e-04_r8,1.3672e-04_r8,1.4836e-04_r8,1.5881e-04_r8/) + kbo(:,43, 2) = (/ & + &9.3086e-05_r8,1.0013e-04_r8,1.0780e-04_r8,1.1711e-04_r8,1.2583e-04_r8/) + kbo(:,44, 2) = (/ & + &7.3232e-05_r8,7.8805e-05_r8,8.4882e-05_r8,9.2011e-05_r8,9.9424e-05_r8/) + kbo(:,45, 2) = (/ & + &5.7257e-05_r8,6.2283e-05_r8,6.6827e-05_r8,7.2104e-05_r8,7.8039e-05_r8/) + kbo(:,46, 2) = (/ & + &4.5024e-05_r8,4.8935e-05_r8,5.2600e-05_r8,5.6600e-05_r8,6.1280e-05_r8/) + kbo(:,47, 2) = (/ & + &3.5357e-05_r8,3.8098e-05_r8,4.1339e-05_r8,4.4405e-05_r8,4.7940e-05_r8/) + kbo(:,48, 2) = (/ & + &2.7815e-05_r8,2.9967e-05_r8,3.2437e-05_r8,3.4873e-05_r8,3.7402e-05_r8/) + kbo(:,49, 2) = (/ & + &2.1939e-05_r8,2.3492e-05_r8,2.5305e-05_r8,2.7332e-05_r8,2.9323e-05_r8/) + kbo(:,50, 2) = (/ & + &1.7237e-05_r8,1.8528e-05_r8,1.9953e-05_r8,2.1525e-05_r8,2.3159e-05_r8/) + kbo(:,51, 2) = (/ & + &1.3436e-05_r8,1.4671e-05_r8,1.5802e-05_r8,1.6957e-05_r8,1.8296e-05_r8/) + kbo(:,52, 2) = (/ & + &1.0450e-05_r8,1.1538e-05_r8,1.2438e-05_r8,1.3421e-05_r8,1.4433e-05_r8/) + kbo(:,53, 2) = (/ & + &8.1106e-06_r8,9.0282e-06_r8,9.8120e-06_r8,1.0593e-05_r8,1.1339e-05_r8/) + kbo(:,54, 2) = (/ & + &6.3166e-06_r8,7.0785e-06_r8,7.7924e-06_r8,8.4016e-06_r8,8.9926e-06_r8/) + kbo(:,55, 2) = (/ & + &4.9361e-06_r8,5.5830e-06_r8,6.1858e-06_r8,6.7021e-06_r8,7.1744e-06_r8/) + kbo(:,56, 2) = (/ & + &3.8472e-06_r8,4.3596e-06_r8,4.8727e-06_r8,5.3362e-06_r8,5.7261e-06_r8/) + kbo(:,57, 2) = (/ & + &2.9833e-06_r8,3.4045e-06_r8,3.8019e-06_r8,4.2184e-06_r8,4.5533e-06_r8/) + kbo(:,58, 2) = (/ & + &2.2932e-06_r8,2.6742e-06_r8,3.0024e-06_r8,3.3291e-06_r8,3.6047e-06_r8/) + kbo(:,59, 2) = (/ & + &1.8323e-06_r8,2.1714e-06_r8,2.4292e-06_r8,2.6999e-06_r8,2.9218e-06_r8/) + kbo(:,13, 3) = (/ & + &3.0891e-02_r8,3.3118e-02_r8,3.6308e-02_r8,3.9588e-02_r8,4.3089e-02_r8/) + kbo(:,14, 3) = (/ & + &2.6329e-02_r8,2.8653e-02_r8,3.1325e-02_r8,3.4211e-02_r8,3.7000e-02_r8/) + kbo(:,15, 3) = (/ & + &2.2620e-02_r8,2.4702e-02_r8,2.7101e-02_r8,2.9342e-02_r8,3.1645e-02_r8/) + kbo(:,16, 3) = (/ & + &1.9521e-02_r8,2.1493e-02_r8,2.3534e-02_r8,2.5338e-02_r8,2.7120e-02_r8/) + kbo(:,17, 3) = (/ & + &1.7199e-02_r8,1.8861e-02_r8,2.0377e-02_r8,2.1918e-02_r8,2.3545e-02_r8/) + kbo(:,18, 3) = (/ & + &1.5181e-02_r8,1.6445e-02_r8,1.7796e-02_r8,1.9171e-02_r8,2.0759e-02_r8/) + kbo(:,19, 3) = (/ & + &1.3401e-02_r8,1.4529e-02_r8,1.5713e-02_r8,1.7031e-02_r8,1.8531e-02_r8/) + kbo(:,20, 3) = (/ & + &1.1566e-02_r8,1.2595e-02_r8,1.3616e-02_r8,1.4797e-02_r8,1.6195e-02_r8/) + kbo(:,21, 3) = (/ & + &9.9790e-03_r8,1.0856e-02_r8,1.1739e-02_r8,1.2840e-02_r8,1.4039e-02_r8/) + kbo(:,22, 3) = (/ & + &8.5571e-03_r8,9.3189e-03_r8,1.0148e-02_r8,1.1149e-02_r8,1.2271e-02_r8/) + kbo(:,23, 3) = (/ & + &7.3578e-03_r8,7.9960e-03_r8,8.8066e-03_r8,9.6774e-03_r8,1.0719e-02_r8/) + kbo(:,24, 3) = (/ & + &6.2710e-03_r8,6.8510e-03_r8,7.5829e-03_r8,8.4285e-03_r8,9.3410e-03_r8/) + kbo(:,25, 3) = (/ & + &5.3189e-03_r8,5.9223e-03_r8,6.5735e-03_r8,7.3163e-03_r8,8.1167e-03_r8/) + kbo(:,26, 3) = (/ & + &4.5763e-03_r8,5.1227e-03_r8,5.7207e-03_r8,6.3561e-03_r8,7.0425e-03_r8/) + kbo(:,27, 3) = (/ & + &3.9329e-03_r8,4.4226e-03_r8,4.9281e-03_r8,5.4554e-03_r8,6.0474e-03_r8/) + kbo(:,28, 3) = (/ & + &3.3818e-03_r8,3.7926e-03_r8,4.2066e-03_r8,4.6531e-03_r8,5.1585e-03_r8/) + kbo(:,29, 3) = (/ & + &2.9035e-03_r8,3.2271e-03_r8,3.5855e-03_r8,3.9705e-03_r8,4.3799e-03_r8/) + kbo(:,30, 3) = (/ & + &2.4837e-03_r8,2.7647e-03_r8,3.0488e-03_r8,3.3703e-03_r8,3.7029e-03_r8/) + kbo(:,31, 3) = (/ & + &2.0927e-03_r8,2.3283e-03_r8,2.5712e-03_r8,2.8545e-03_r8,3.1157e-03_r8/) + kbo(:,32, 3) = (/ & + &1.7660e-03_r8,1.9568e-03_r8,2.1676e-03_r8,2.3923e-03_r8,2.6159e-03_r8/) + kbo(:,33, 3) = (/ & + &1.4871e-03_r8,1.6499e-03_r8,1.8213e-03_r8,2.0066e-03_r8,2.1979e-03_r8/) + kbo(:,34, 3) = (/ & + &1.2670e-03_r8,1.4012e-03_r8,1.5485e-03_r8,1.7073e-03_r8,1.8735e-03_r8/) + kbo(:,35, 3) = (/ & + &1.0672e-03_r8,1.1813e-03_r8,1.3131e-03_r8,1.4449e-03_r8,1.5924e-03_r8/) + kbo(:,36, 3) = (/ & + &8.9185e-04_r8,9.8733e-04_r8,1.0955e-03_r8,1.2168e-03_r8,1.3441e-03_r8/) + kbo(:,37, 3) = (/ & + &7.2820e-04_r8,8.0537e-04_r8,8.9528e-04_r8,9.9910e-04_r8,1.1050e-03_r8/) + kbo(:,38, 3) = (/ & + &5.9186e-04_r8,6.5591e-04_r8,7.2922e-04_r8,8.1759e-04_r8,9.0441e-04_r8/) + kbo(:,39, 3) = (/ & + &4.8327e-04_r8,5.3477e-04_r8,5.9527e-04_r8,6.6884e-04_r8,7.4026e-04_r8/) + kbo(:,40, 3) = (/ & + &3.8671e-04_r8,4.2869e-04_r8,4.7628e-04_r8,5.3686e-04_r8,5.9502e-04_r8/) + kbo(:,41, 3) = (/ & + &3.0862e-04_r8,3.4166e-04_r8,3.8000e-04_r8,4.2745e-04_r8,4.7580e-04_r8/) + kbo(:,42, 3) = (/ & + &2.4577e-04_r8,2.7168e-04_r8,3.0221e-04_r8,3.3942e-04_r8,3.8025e-04_r8/) + kbo(:,43, 3) = (/ & + &1.9416e-04_r8,2.1479e-04_r8,2.3878e-04_r8,2.6702e-04_r8,3.0069e-04_r8/) + kbo(:,44, 3) = (/ & + &1.5374e-04_r8,1.6929e-04_r8,1.8776e-04_r8,2.0950e-04_r8,2.3556e-04_r8/) + kbo(:,45, 3) = (/ & + &1.2163e-04_r8,1.3301e-04_r8,1.4695e-04_r8,1.6433e-04_r8,1.8435e-04_r8/) + kbo(:,46, 3) = (/ & + &9.4928e-05_r8,1.0426e-04_r8,1.1546e-04_r8,1.2841e-04_r8,1.4410e-04_r8/) + kbo(:,47, 3) = (/ & + &7.3995e-05_r8,8.2130e-05_r8,9.0212e-05_r8,1.0006e-04_r8,1.1186e-04_r8/) + kbo(:,48, 3) = (/ & + &5.7893e-05_r8,6.3962e-05_r8,7.0352e-05_r8,7.8032e-05_r8,8.7072e-05_r8/) + kbo(:,49, 3) = (/ & + &4.5051e-05_r8,4.9908e-05_r8,5.5306e-05_r8,6.0837e-05_r8,6.7927e-05_r8/) + kbo(:,50, 3) = (/ & + &3.5303e-05_r8,3.9326e-05_r8,4.3324e-05_r8,4.7812e-05_r8,5.3164e-05_r8/) + kbo(:,51, 3) = (/ & + &2.7771e-05_r8,3.0856e-05_r8,3.4054e-05_r8,3.7804e-05_r8,4.1758e-05_r8/) + kbo(:,52, 3) = (/ & + &2.1938e-05_r8,2.4227e-05_r8,2.6919e-05_r8,2.9733e-05_r8,3.2981e-05_r8/) + kbo(:,53, 3) = (/ & + &1.7187e-05_r8,1.9050e-05_r8,2.1224e-05_r8,2.3374e-05_r8,2.5986e-05_r8/) + kbo(:,54, 3) = (/ & + &1.3551e-05_r8,1.5084e-05_r8,1.6671e-05_r8,1.8493e-05_r8,2.0639e-05_r8/) + kbo(:,55, 3) = (/ & + &1.0736e-05_r8,1.1998e-05_r8,1.3230e-05_r8,1.4714e-05_r8,1.6387e-05_r8/) + kbo(:,56, 3) = (/ & + &8.4780e-06_r8,9.5613e-06_r8,1.0535e-05_r8,1.1722e-05_r8,1.2981e-05_r8/) + kbo(:,57, 3) = (/ & + &6.6892e-06_r8,7.5486e-06_r8,8.3874e-06_r8,9.3040e-06_r8,1.0324e-05_r8/) + kbo(:,58, 3) = (/ & + &5.3282e-06_r8,5.9530e-06_r8,6.6841e-06_r8,7.4078e-06_r8,8.2298e-06_r8/) + kbo(:,59, 3) = (/ & + &4.3459e-06_r8,4.8321e-06_r8,5.4567e-06_r8,6.0369e-06_r8,6.7261e-06_r8/) + kbo(:,13, 4) = (/ & + &6.7009e-02_r8,7.0746e-02_r8,7.4150e-02_r8,7.7569e-02_r8,8.1680e-02_r8/) + kbo(:,14, 4) = (/ & + &5.5943e-02_r8,5.8697e-02_r8,6.1678e-02_r8,6.4914e-02_r8,6.9379e-02_r8/) + kbo(:,15, 4) = (/ & + &4.6843e-02_r8,4.9217e-02_r8,5.1833e-02_r8,5.5783e-02_r8,5.9767e-02_r8/) + kbo(:,16, 4) = (/ & + &3.9239e-02_r8,4.1262e-02_r8,4.4032e-02_r8,4.7642e-02_r8,5.1925e-02_r8/) + kbo(:,17, 4) = (/ & + &3.3107e-02_r8,3.5295e-02_r8,3.8541e-02_r8,4.2220e-02_r8,4.6357e-02_r8/) + kbo(:,18, 4) = (/ & + &2.8797e-02_r8,3.1620e-02_r8,3.4631e-02_r8,3.8034e-02_r8,4.1725e-02_r8/) + kbo(:,19, 4) = (/ & + &2.5628e-02_r8,2.8281e-02_r8,3.1139e-02_r8,3.4358e-02_r8,3.7925e-02_r8/) + kbo(:,20, 4) = (/ & + &2.2579e-02_r8,2.4906e-02_r8,2.7554e-02_r8,3.0345e-02_r8,3.3488e-02_r8/) + kbo(:,21, 4) = (/ & + &1.9528e-02_r8,2.1738e-02_r8,2.4107e-02_r8,2.6707e-02_r8,2.9475e-02_r8/) + kbo(:,22, 4) = (/ & + &1.7101e-02_r8,1.8986e-02_r8,2.1039e-02_r8,2.3296e-02_r8,2.5855e-02_r8/) + kbo(:,23, 4) = (/ & + &1.4866e-02_r8,1.6502e-02_r8,1.8337e-02_r8,2.0414e-02_r8,2.2548e-02_r8/) + kbo(:,24, 4) = (/ & + &1.2821e-02_r8,1.4288e-02_r8,1.5941e-02_r8,1.7747e-02_r8,1.9679e-02_r8/) + kbo(:,25, 4) = (/ & + &1.1061e-02_r8,1.2369e-02_r8,1.3872e-02_r8,1.5379e-02_r8,1.7059e-02_r8/) + kbo(:,26, 4) = (/ & + &9.5354e-03_r8,1.0723e-02_r8,1.2012e-02_r8,1.3430e-02_r8,1.4839e-02_r8/) + kbo(:,27, 4) = (/ & + &8.1975e-03_r8,9.2673e-03_r8,1.0387e-02_r8,1.1650e-02_r8,1.2827e-02_r8/) + kbo(:,28, 4) = (/ & + &7.0231e-03_r8,7.9702e-03_r8,8.9828e-03_r8,1.0032e-02_r8,1.1053e-02_r8/) + kbo(:,29, 4) = (/ & + &6.0200e-03_r8,6.8421e-03_r8,7.7670e-03_r8,8.6094e-03_r8,9.5249e-03_r8/) + kbo(:,30, 4) = (/ & + &5.1558e-03_r8,5.8823e-03_r8,6.6735e-03_r8,7.4143e-03_r8,8.2222e-03_r8/) + kbo(:,31, 4) = (/ & + &4.4508e-03_r8,5.1031e-03_r8,5.7395e-03_r8,6.3990e-03_r8,7.0930e-03_r8/) + kbo(:,32, 4) = (/ & + &3.8687e-03_r8,4.4226e-03_r8,4.9634e-03_r8,5.5499e-03_r8,6.1447e-03_r8/) + kbo(:,33, 4) = (/ & + &3.3860e-03_r8,3.8414e-03_r8,4.3170e-03_r8,4.8129e-03_r8,5.3113e-03_r8/) + kbo(:,34, 4) = (/ & + &2.9667e-03_r8,3.3572e-03_r8,3.7642e-03_r8,4.1882e-03_r8,4.5973e-03_r8/) + kbo(:,35, 4) = (/ & + &2.5854e-03_r8,2.9160e-03_r8,3.2542e-03_r8,3.6120e-03_r8,3.9574e-03_r8/) + kbo(:,36, 4) = (/ & + &2.2132e-03_r8,2.5004e-03_r8,2.7859e-03_r8,3.0722e-03_r8,3.3673e-03_r8/) + kbo(:,37, 4) = (/ & + &1.8397e-03_r8,2.0798e-03_r8,2.3185e-03_r8,2.5525e-03_r8,2.8046e-03_r8/) + kbo(:,38, 4) = (/ & + &1.5241e-03_r8,1.7240e-03_r8,1.9250e-03_r8,2.1190e-03_r8,2.3334e-03_r8/) + kbo(:,39, 4) = (/ & + &1.2578e-03_r8,1.4258e-03_r8,1.5974e-03_r8,1.7602e-03_r8,1.9414e-03_r8/) + kbo(:,40, 4) = (/ & + &1.0136e-03_r8,1.1511e-03_r8,1.2925e-03_r8,1.4274e-03_r8,1.5799e-03_r8/) + kbo(:,41, 4) = (/ & + &8.1255e-04_r8,9.2485e-04_r8,1.0421e-03_r8,1.1560e-03_r8,1.2823e-03_r8/) + kbo(:,42, 4) = (/ & + &6.5076e-04_r8,7.4076e-04_r8,8.3891e-04_r8,9.3536e-04_r8,1.0398e-03_r8/) + kbo(:,43, 4) = (/ & + &5.1457e-04_r8,5.8675e-04_r8,6.6625e-04_r8,7.5025e-04_r8,8.3332e-04_r8/) + kbo(:,44, 4) = (/ & + &4.0130e-04_r8,4.6112e-04_r8,5.2500e-04_r8,5.9353e-04_r8,6.6396e-04_r8/) + kbo(:,45, 4) = (/ & + &3.1174e-04_r8,3.6176e-04_r8,4.1281e-04_r8,4.6943e-04_r8,5.2749e-04_r8/) + kbo(:,46, 4) = (/ & + &2.4198e-04_r8,2.8347e-04_r8,3.2327e-04_r8,3.6940e-04_r8,4.1847e-04_r8/) + kbo(:,47, 4) = (/ & + &1.8653e-04_r8,2.1946e-04_r8,2.5297e-04_r8,2.9033e-04_r8,3.3117e-04_r8/) + kbo(:,48, 4) = (/ & + &1.4273e-04_r8,1.6990e-04_r8,1.9780e-04_r8,2.2703e-04_r8,2.6076e-04_r8/) + kbo(:,49, 4) = (/ & + &1.1020e-04_r8,1.3076e-04_r8,1.5369e-04_r8,1.7736e-04_r8,2.0453e-04_r8/) + kbo(:,50, 4) = (/ & + &8.5840e-05_r8,1.0098e-04_r8,1.2003e-04_r8,1.3937e-04_r8,1.6133e-04_r8/) + kbo(:,51, 4) = (/ & + &6.7375e-05_r8,7.8667e-05_r8,9.3691e-05_r8,1.0967e-04_r8,1.2714e-04_r8/) + kbo(:,52, 4) = (/ & + &5.2333e-05_r8,6.1321e-05_r8,7.2765e-05_r8,8.6008e-05_r8,9.9915e-05_r8/) + kbo(:,53, 4) = (/ & + &4.0658e-05_r8,4.7664e-05_r8,5.6514e-05_r8,6.7300e-05_r8,7.8701e-05_r8/) + kbo(:,54, 4) = (/ & + &3.1857e-05_r8,3.7478e-05_r8,4.4306e-05_r8,5.3025e-05_r8,6.2299e-05_r8/) + kbo(:,55, 4) = (/ & + &2.4955e-05_r8,2.9435e-05_r8,3.4823e-05_r8,4.1578e-05_r8,4.9419e-05_r8/) + kbo(:,56, 4) = (/ & + &1.9655e-05_r8,2.3009e-05_r8,2.7169e-05_r8,3.2570e-05_r8,3.9005e-05_r8/) + kbo(:,57, 4) = (/ & + &1.5476e-05_r8,1.8100e-05_r8,2.1340e-05_r8,2.5521e-05_r8,3.0667e-05_r8/) + kbo(:,58, 4) = (/ & + &1.2154e-05_r8,1.4292e-05_r8,1.6827e-05_r8,2.0050e-05_r8,2.4167e-05_r8/) + kbo(:,59, 4) = (/ & + &9.8901e-06_r8,1.1647e-05_r8,1.3760e-05_r8,1.6454e-05_r8,1.9831e-05_r8/) + kbo(:,13, 5) = (/ & + &1.3634e-01_r8,1.4252e-01_r8,1.5001e-01_r8,1.6028e-01_r8,1.7134e-01_r8/) + kbo(:,14, 5) = (/ & + &1.1274e-01_r8,1.1839e-01_r8,1.2582e-01_r8,1.3453e-01_r8,1.4378e-01_r8/) + kbo(:,15, 5) = (/ & + &9.3550e-02_r8,9.9682e-02_r8,1.0681e-01_r8,1.1432e-01_r8,1.2335e-01_r8/) + kbo(:,16, 5) = (/ & + &7.9704e-02_r8,8.5926e-02_r8,9.2006e-02_r8,9.9216e-02_r8,1.0669e-01_r8/) + kbo(:,17, 5) = (/ & + &6.9562e-02_r8,7.4399e-02_r8,8.0031e-02_r8,8.6090e-02_r8,9.3210e-02_r8/) + kbo(:,18, 5) = (/ & + &6.1028e-02_r8,6.5373e-02_r8,7.1097e-02_r8,7.7143e-02_r8,8.4153e-02_r8/) + kbo(:,19, 5) = (/ & + &5.4138e-02_r8,5.9145e-02_r8,6.4366e-02_r8,7.0461e-02_r8,7.6822e-02_r8/) + kbo(:,20, 5) = (/ & + &4.7698e-02_r8,5.2419e-02_r8,5.7657e-02_r8,6.3398e-02_r8,6.9523e-02_r8/) + kbo(:,21, 5) = (/ & + &4.2126e-02_r8,4.6323e-02_r8,5.1164e-02_r8,5.6007e-02_r8,6.1597e-02_r8/) + kbo(:,22, 5) = (/ & + &3.6873e-02_r8,4.0763e-02_r8,4.4958e-02_r8,4.9556e-02_r8,5.4204e-02_r8/) + kbo(:,23, 5) = (/ & + &3.2201e-02_r8,3.5761e-02_r8,3.9530e-02_r8,4.3670e-02_r8,4.7920e-02_r8/) + kbo(:,24, 5) = (/ & + &2.8239e-02_r8,3.1305e-02_r8,3.4844e-02_r8,3.8415e-02_r8,4.2157e-02_r8/) + kbo(:,25, 5) = (/ & + &2.4669e-02_r8,2.7511e-02_r8,3.0568e-02_r8,3.3769e-02_r8,3.6890e-02_r8/) + kbo(:,26, 5) = (/ & + &2.1582e-02_r8,2.4173e-02_r8,2.6811e-02_r8,2.9496e-02_r8,3.2330e-02_r8/) + kbo(:,27, 5) = (/ & + &1.8849e-02_r8,2.1094e-02_r8,2.3446e-02_r8,2.5755e-02_r8,2.8374e-02_r8/) + kbo(:,28, 5) = (/ & + &1.6379e-02_r8,1.8330e-02_r8,2.0367e-02_r8,2.2542e-02_r8,2.4931e-02_r8/) + kbo(:,29, 5) = (/ & + &1.4280e-02_r8,1.5993e-02_r8,1.7723e-02_r8,1.9736e-02_r8,2.1895e-02_r8/) + kbo(:,30, 5) = (/ & + &1.2451e-02_r8,1.3902e-02_r8,1.5477e-02_r8,1.7322e-02_r8,1.9234e-02_r8/) + kbo(:,31, 5) = (/ & + &1.0840e-02_r8,1.2122e-02_r8,1.3593e-02_r8,1.5159e-02_r8,1.6921e-02_r8/) + kbo(:,32, 5) = (/ & + &9.4753e-03_r8,1.0651e-02_r8,1.1992e-02_r8,1.3397e-02_r8,1.4887e-02_r8/) + kbo(:,33, 5) = (/ & + &8.3358e-03_r8,9.4249e-03_r8,1.0592e-02_r8,1.1871e-02_r8,1.3208e-02_r8/) + kbo(:,34, 5) = (/ & + &7.3799e-03_r8,8.3765e-03_r8,9.4456e-03_r8,1.0582e-02_r8,1.1863e-02_r8/) + kbo(:,35, 5) = (/ & + &6.4631e-03_r8,7.3628e-03_r8,8.3364e-03_r8,9.3419e-03_r8,1.0526e-02_r8/) + kbo(:,36, 5) = (/ & + &5.5926e-03_r8,6.3888e-03_r8,7.2585e-03_r8,8.2192e-03_r8,9.2462e-03_r8/) + kbo(:,37, 5) = (/ & + &4.7015e-03_r8,5.3951e-03_r8,6.1680e-03_r8,7.0229e-03_r8,7.9329e-03_r8/) + kbo(:,38, 5) = (/ & + &3.9517e-03_r8,4.5644e-03_r8,5.2429e-03_r8,6.0141e-03_r8,6.8184e-03_r8/) + kbo(:,39, 5) = (/ & + &3.3266e-03_r8,3.8629e-03_r8,4.4575e-03_r8,5.1473e-03_r8,5.8646e-03_r8/) + kbo(:,40, 5) = (/ & + &2.7281e-03_r8,3.1818e-03_r8,3.6932e-03_r8,4.2742e-03_r8,4.8976e-03_r8/) + kbo(:,41, 5) = (/ & + &2.2270e-03_r8,2.6113e-03_r8,3.0386e-03_r8,3.5308e-03_r8,4.0601e-03_r8/) + kbo(:,42, 5) = (/ & + &1.8093e-03_r8,2.1403e-03_r8,2.4947e-03_r8,2.9136e-03_r8,3.3566e-03_r8/) + kbo(:,43, 5) = (/ & + &1.4510e-03_r8,1.7247e-03_r8,2.0294e-03_r8,2.3716e-03_r8,2.7407e-03_r8/) + kbo(:,44, 5) = (/ & + &1.1565e-03_r8,1.3809e-03_r8,1.6356e-03_r8,1.9170e-03_r8,2.2199e-03_r8/) + kbo(:,45, 5) = (/ & + &9.2074e-04_r8,1.1011e-03_r8,1.3110e-03_r8,1.5432e-03_r8,1.7974e-03_r8/) + kbo(:,46, 5) = (/ & + &7.2799e-04_r8,8.7147e-04_r8,1.0468e-03_r8,1.2375e-03_r8,1.4475e-03_r8/) + kbo(:,47, 5) = (/ & + &5.6825e-04_r8,6.8576e-04_r8,8.2827e-04_r8,9.8300e-04_r8,1.1595e-03_r8/) + kbo(:,48, 5) = (/ & + &4.4362e-04_r8,5.3785e-04_r8,6.5132e-04_r8,7.7947e-04_r8,9.2729e-04_r8/) + kbo(:,49, 5) = (/ & + &3.4360e-04_r8,4.2004e-04_r8,5.1060e-04_r8,6.1673e-04_r8,7.3913e-04_r8/) + kbo(:,50, 5) = (/ & + &2.6639e-04_r8,3.2974e-04_r8,4.0310e-04_r8,4.8991e-04_r8,5.9182e-04_r8/) + kbo(:,51, 5) = (/ & + &2.0705e-04_r8,2.5803e-04_r8,3.1790e-04_r8,3.8886e-04_r8,4.7401e-04_r8/) + kbo(:,52, 5) = (/ & + &1.6104e-04_r8,2.0156e-04_r8,2.4998e-04_r8,3.0713e-04_r8,3.7759e-04_r8/) + kbo(:,53, 5) = (/ & + &1.2422e-04_r8,1.5670e-04_r8,1.9587e-04_r8,2.4211e-04_r8,2.9925e-04_r8/) + kbo(:,54, 5) = (/ & + &9.6443e-05_r8,1.2239e-04_r8,1.5459e-04_r8,1.9203e-04_r8,2.3866e-04_r8/) + kbo(:,55, 5) = (/ & + &7.5345e-05_r8,9.6163e-05_r8,1.2185e-04_r8,1.5278e-04_r8,1.9092e-04_r8/) + kbo(:,56, 5) = (/ & + &5.8479e-05_r8,7.5388e-05_r8,9.6163e-05_r8,1.2109e-04_r8,1.5224e-04_r8/) + kbo(:,57, 5) = (/ & + &4.5173e-05_r8,5.8728e-05_r8,7.5432e-05_r8,9.5735e-05_r8,1.2084e-04_r8/) + kbo(:,58, 5) = (/ & + &3.5110e-05_r8,4.5659e-05_r8,5.9108e-05_r8,7.5684e-05_r8,9.5780e-05_r8/) + kbo(:,59, 5) = (/ & + &2.8669e-05_r8,3.7452e-05_r8,4.8577e-05_r8,6.2553e-05_r8,7.9913e-05_r8/) + kbo(:,13, 6) = (/ & + &3.1943e-01_r8,3.3627e-01_r8,3.5152e-01_r8,3.6856e-01_r8,3.8489e-01_r8/) + kbo(:,14, 6) = (/ & + &2.6955e-01_r8,2.8315e-01_r8,2.9631e-01_r8,3.1035e-01_r8,3.2480e-01_r8/) + kbo(:,15, 6) = (/ & + &2.2744e-01_r8,2.3792e-01_r8,2.4935e-01_r8,2.6127e-01_r8,2.7359e-01_r8/) + kbo(:,16, 6) = (/ & + &1.9190e-01_r8,2.0128e-01_r8,2.1209e-01_r8,2.2354e-01_r8,2.3634e-01_r8/) + kbo(:,17, 6) = (/ & + &1.6550e-01_r8,1.7572e-01_r8,1.8575e-01_r8,1.9639e-01_r8,2.0864e-01_r8/) + kbo(:,18, 6) = (/ & + &1.4664e-01_r8,1.5533e-01_r8,1.6464e-01_r8,1.7496e-01_r8,1.8532e-01_r8/) + kbo(:,19, 6) = (/ & + &1.3086e-01_r8,1.3857e-01_r8,1.4754e-01_r8,1.5676e-01_r8,1.6804e-01_r8/) + kbo(:,20, 6) = (/ & + &1.1476e-01_r8,1.2256e-01_r8,1.3048e-01_r8,1.3999e-01_r8,1.5052e-01_r8/) + kbo(:,21, 6) = (/ & + &1.0042e-01_r8,1.0755e-01_r8,1.1552e-01_r8,1.2457e-01_r8,1.3541e-01_r8/) + kbo(:,22, 6) = (/ & + &8.7811e-02_r8,9.4376e-02_r8,1.0240e-01_r8,1.1139e-01_r8,1.2190e-01_r8/) + kbo(:,23, 6) = (/ & + &7.6746e-02_r8,8.3440e-02_r8,9.0958e-02_r8,9.9436e-02_r8,1.0837e-01_r8/) + kbo(:,24, 6) = (/ & + &6.7020e-02_r8,7.3597e-02_r8,8.0186e-02_r8,8.7655e-02_r8,9.5847e-02_r8/) + kbo(:,25, 6) = (/ & + &5.8852e-02_r8,6.4342e-02_r8,7.0651e-02_r8,7.7553e-02_r8,8.5595e-02_r8/) + kbo(:,26, 6) = (/ & + &5.1501e-02_r8,5.6677e-02_r8,6.2671e-02_r8,6.9309e-02_r8,7.6862e-02_r8/) + kbo(:,27, 6) = (/ & + &4.5068e-02_r8,5.0089e-02_r8,5.5571e-02_r8,6.2056e-02_r8,6.8532e-02_r8/) + kbo(:,28, 6) = (/ & + &3.9606e-02_r8,4.4193e-02_r8,4.9408e-02_r8,5.5057e-02_r8,6.0956e-02_r8/) + kbo(:,29, 6) = (/ & + &3.4989e-02_r8,3.9176e-02_r8,4.4032e-02_r8,4.9174e-02_r8,5.4655e-02_r8/) + kbo(:,30, 6) = (/ & + &3.0943e-02_r8,3.4971e-02_r8,3.9398e-02_r8,4.4027e-02_r8,4.9163e-02_r8/) + kbo(:,31, 6) = (/ & + &2.7553e-02_r8,3.1287e-02_r8,3.5351e-02_r8,3.9782e-02_r8,4.4558e-02_r8/) + kbo(:,32, 6) = (/ & + &2.4710e-02_r8,2.8155e-02_r8,3.1869e-02_r8,3.6099e-02_r8,4.0666e-02_r8/) + kbo(:,33, 6) = (/ & + &2.2173e-02_r8,2.5362e-02_r8,2.8990e-02_r8,3.2965e-02_r8,3.7297e-02_r8/) + kbo(:,34, 6) = (/ & + &2.0107e-02_r8,2.3109e-02_r8,2.6574e-02_r8,3.0332e-02_r8,3.4357e-02_r8/) + kbo(:,35, 6) = (/ & + &1.8022e-02_r8,2.0877e-02_r8,2.4132e-02_r8,2.7710e-02_r8,3.1520e-02_r8/) + kbo(:,36, 6) = (/ & + &1.5963e-02_r8,1.8659e-02_r8,2.1660e-02_r8,2.4929e-02_r8,2.8560e-02_r8/) + kbo(:,37, 6) = (/ & + &1.3764e-02_r8,1.6188e-02_r8,1.8916e-02_r8,2.1932e-02_r8,2.5294e-02_r8/) + kbo(:,38, 6) = (/ & + &1.1849e-02_r8,1.4028e-02_r8,1.6494e-02_r8,1.9269e-02_r8,2.2340e-02_r8/) + kbo(:,39, 6) = (/ & + &1.0207e-02_r8,1.2194e-02_r8,1.4401e-02_r8,1.6941e-02_r8,1.9796e-02_r8/) + kbo(:,40, 6) = (/ & + &8.5573e-03_r8,1.0315e-02_r8,1.2260e-02_r8,1.4559e-02_r8,1.7141e-02_r8/) + kbo(:,41, 6) = (/ & + &7.1290e-03_r8,8.6738e-03_r8,1.0403e-02_r8,1.2445e-02_r8,1.4801e-02_r8/) + kbo(:,42, 6) = (/ & + &5.9179e-03_r8,7.2709e-03_r8,8.8122e-03_r8,1.0627e-02_r8,1.2787e-02_r8/) + kbo(:,43, 6) = (/ & + &4.8318e-03_r8,5.9892e-03_r8,7.3334e-03_r8,8.9514e-03_r8,1.0874e-02_r8/) + kbo(:,44, 6) = (/ & + &3.8999e-03_r8,4.8767e-03_r8,6.0501e-03_r8,7.4816e-03_r8,9.1794e-03_r8/) + kbo(:,45, 6) = (/ & + &3.1360e-03_r8,3.9601e-03_r8,4.9837e-03_r8,6.2240e-03_r8,7.7311e-03_r8/) + kbo(:,46, 6) = (/ & + &2.5027e-03_r8,3.1827e-03_r8,4.0540e-03_r8,5.1329e-03_r8,6.4480e-03_r8/) + kbo(:,47, 6) = (/ & + &1.9756e-03_r8,2.5273e-03_r8,3.2610e-03_r8,4.1749e-03_r8,5.3122e-03_r8/) + kbo(:,48, 6) = (/ & + &1.5473e-03_r8,1.9960e-03_r8,2.6043e-03_r8,3.3772e-03_r8,4.3437e-03_r8/) + kbo(:,49, 6) = (/ & + &1.2068e-03_r8,1.5706e-03_r8,2.0674e-03_r8,2.7091e-03_r8,3.5307e-03_r8/) + kbo(:,50, 6) = (/ & + &9.4521e-04_r8,1.2396e-03_r8,1.6445e-03_r8,2.1801e-03_r8,2.8792e-03_r8/) + kbo(:,51, 6) = (/ & + &7.3804e-04_r8,9.7746e-04_r8,1.3076e-03_r8,1.7542e-03_r8,2.3409e-03_r8/) + kbo(:,52, 6) = (/ & + &5.7206e-04_r8,7.6763e-04_r8,1.0338e-03_r8,1.4015e-03_r8,1.8909e-03_r8/) + kbo(:,53, 6) = (/ & + &4.4225e-04_r8,5.9805e-04_r8,8.1248e-04_r8,1.1113e-03_r8,1.5170e-03_r8/) + kbo(:,54, 6) = (/ & + &3.4467e-04_r8,4.7010e-04_r8,6.4272e-04_r8,8.8848e-04_r8,1.2276e-03_r8/) + kbo(:,55, 6) = (/ & + &2.6885e-04_r8,3.6925e-04_r8,5.1051e-04_r8,7.1238e-04_r8,9.9424e-04_r8/) + kbo(:,56, 6) = (/ & + &2.0891e-04_r8,2.8866e-04_r8,4.0323e-04_r8,5.6854e-04_r8,8.0318e-04_r8/) + kbo(:,57, 6) = (/ & + &1.6206e-04_r8,2.2457e-04_r8,3.1663e-04_r8,4.5154e-04_r8,6.4436e-04_r8/) + kbo(:,58, 6) = (/ & + &1.2565e-04_r8,1.7534e-04_r8,2.4919e-04_r8,3.5849e-04_r8,5.1835e-04_r8/) + kbo(:,59, 6) = (/ & + &1.0370e-04_r8,1.4590e-04_r8,2.0972e-04_r8,3.0572e-04_r8,4.4824e-04_r8/) + kbo(:,13, 7) = (/ & + &8.6885e-01_r8,8.9426e-01_r8,9.2071e-01_r8,9.5081e-01_r8,9.7593e-01_r8/) + kbo(:,14, 7) = (/ & + &7.3422e-01_r8,7.5692e-01_r8,7.8528e-01_r8,8.1141e-01_r8,8.3349e-01_r8/) + kbo(:,15, 7) = (/ & + &6.1192e-01_r8,6.3447e-01_r8,6.5837e-01_r8,6.7854e-01_r8,7.0269e-01_r8/) + kbo(:,16, 7) = (/ & + &5.0884e-01_r8,5.2842e-01_r8,5.4670e-01_r8,5.6627e-01_r8,5.8867e-01_r8/) + kbo(:,17, 7) = (/ & + &4.3640e-01_r8,4.5419e-01_r8,4.7288e-01_r8,4.9197e-01_r8,5.1336e-01_r8/) + kbo(:,18, 7) = (/ & + &3.8407e-01_r8,4.0203e-01_r8,4.1993e-01_r8,4.4018e-01_r8,4.6362e-01_r8/) + kbo(:,19, 7) = (/ & + &3.4228e-01_r8,3.5912e-01_r8,3.7740e-01_r8,3.9888e-01_r8,4.2103e-01_r8/) + kbo(:,20, 7) = (/ & + &3.0199e-01_r8,3.1730e-01_r8,3.3484e-01_r8,3.5351e-01_r8,3.7675e-01_r8/) + kbo(:,21, 7) = (/ & + &2.6553e-01_r8,2.8042e-01_r8,2.9603e-01_r8,3.1609e-01_r8,3.3882e-01_r8/) + kbo(:,22, 7) = (/ & + &2.3320e-01_r8,2.4726e-01_r8,2.6434e-01_r8,2.8368e-01_r8,3.0736e-01_r8/) + kbo(:,23, 7) = (/ & + &2.0578e-01_r8,2.1941e-01_r8,2.3579e-01_r8,2.5629e-01_r8,2.8224e-01_r8/) + kbo(:,24, 7) = (/ & + &1.8045e-01_r8,1.9362e-01_r8,2.1135e-01_r8,2.3376e-01_r8,2.5793e-01_r8/) + kbo(:,25, 7) = (/ & + &1.5885e-01_r8,1.7311e-01_r8,1.9174e-01_r8,2.1249e-01_r8,2.3261e-01_r8/) + kbo(:,26, 7) = (/ & + &1.4101e-01_r8,1.5639e-01_r8,1.7418e-01_r8,1.9114e-01_r8,2.1048e-01_r8/) + kbo(:,27, 7) = (/ & + &1.2599e-01_r8,1.4076e-01_r8,1.5557e-01_r8,1.7183e-01_r8,1.9023e-01_r8/) + kbo(:,28, 7) = (/ & + &1.1218e-01_r8,1.2546e-01_r8,1.3903e-01_r8,1.5482e-01_r8,1.7215e-01_r8/) + kbo(:,29, 7) = (/ & + &1.0072e-01_r8,1.1254e-01_r8,1.2583e-01_r8,1.4062e-01_r8,1.5650e-01_r8/) + kbo(:,30, 7) = (/ & + &9.0713e-02_r8,1.0192e-01_r8,1.1464e-01_r8,1.2854e-01_r8,1.4398e-01_r8/) + kbo(:,31, 7) = (/ & + &8.2277e-02_r8,9.3097e-02_r8,1.0524e-01_r8,1.1856e-01_r8,1.3355e-01_r8/) + kbo(:,32, 7) = (/ & + &7.5303e-02_r8,8.5763e-02_r8,9.7401e-02_r8,1.1054e-01_r8,1.2526e-01_r8/) + kbo(:,33, 7) = (/ & + &6.9506e-02_r8,7.9549e-02_r8,9.0902e-02_r8,1.0398e-01_r8,1.1862e-01_r8/) + kbo(:,34, 7) = (/ & + &6.4727e-02_r8,7.4554e-02_r8,8.5918e-02_r8,9.8930e-02_r8,1.1374e-01_r8/) + kbo(:,35, 7) = (/ & + &5.9573e-02_r8,6.9480e-02_r8,8.0602e-02_r8,9.3549e-02_r8,1.0847e-01_r8/) + kbo(:,36, 7) = (/ & + &5.4200e-02_r8,6.3825e-02_r8,7.4842e-02_r8,8.7689e-02_r8,1.0224e-01_r8/) + kbo(:,37, 7) = (/ & + &4.7941e-02_r8,5.7083e-02_r8,6.7560e-02_r8,8.0041e-02_r8,9.3919e-02_r8/) + kbo(:,38, 7) = (/ & + &4.2423e-02_r8,5.1057e-02_r8,6.0983e-02_r8,7.2873e-02_r8,8.6484e-02_r8/) + kbo(:,39, 7) = (/ & + &3.7589e-02_r8,4.5606e-02_r8,5.5155e-02_r8,6.6511e-02_r8,7.9703e-02_r8/) + kbo(:,40, 7) = (/ & + &3.2287e-02_r8,3.9605e-02_r8,4.8489e-02_r8,5.9153e-02_r8,7.1379e-02_r8/) + kbo(:,41, 7) = (/ & + &2.7611e-02_r8,3.4241e-02_r8,4.2425e-02_r8,5.2312e-02_r8,6.3597e-02_r8/) + kbo(:,42, 7) = (/ & + &2.3526e-02_r8,2.9544e-02_r8,3.7050e-02_r8,4.6066e-02_r8,5.6624e-02_r8/) + kbo(:,43, 7) = (/ & + &1.9724e-02_r8,2.5077e-02_r8,3.1787e-02_r8,3.9922e-02_r8,4.9656e-02_r8/) + kbo(:,44, 7) = (/ & + &1.6360e-02_r8,2.1054e-02_r8,2.6994e-02_r8,3.4254e-02_r8,4.3106e-02_r8/) + kbo(:,45, 7) = (/ & + &1.3479e-02_r8,1.7563e-02_r8,2.2810e-02_r8,2.9308e-02_r8,3.7331e-02_r8/) + kbo(:,46, 7) = (/ & + &1.0982e-02_r8,1.4524e-02_r8,1.9109e-02_r8,2.4872e-02_r8,3.2032e-02_r8/) + kbo(:,47, 7) = (/ & + &8.8182e-03_r8,1.1815e-02_r8,1.5755e-02_r8,2.0785e-02_r8,2.7117e-02_r8/) + kbo(:,48, 7) = (/ & + &7.0297e-03_r8,9.5228e-03_r8,1.2883e-02_r8,1.7248e-02_r8,2.2808e-02_r8/) + kbo(:,49, 7) = (/ & + &5.5570e-03_r8,7.6141e-03_r8,1.0446e-02_r8,1.4193e-02_r8,1.9030e-02_r8/) + kbo(:,50, 7) = (/ & + &4.4018e-03_r8,6.0988e-03_r8,8.5078e-03_r8,1.1727e-02_r8,1.5958e-02_r8/) + kbo(:,51, 7) = (/ & + &3.4813e-03_r8,4.8790e-03_r8,6.9087e-03_r8,9.6740e-03_r8,1.3370e-02_r8/) + kbo(:,52, 7) = (/ & + &2.7259e-03_r8,3.8645e-03_r8,5.5503e-03_r8,7.9313e-03_r8,1.1133e-02_r8/) + kbo(:,53, 7) = (/ & + &2.1153e-03_r8,3.0336e-03_r8,4.4195e-03_r8,6.4300e-03_r8,9.1714e-03_r8/) + kbo(:,54, 7) = (/ & + &1.6649e-03_r8,2.4099e-03_r8,3.5602e-03_r8,5.2651e-03_r8,7.6558e-03_r8/) + kbo(:,55, 7) = (/ & + &1.3120e-03_r8,1.9223e-03_r8,2.8746e-03_r8,4.3204e-03_r8,6.4144e-03_r8/) + kbo(:,56, 7) = (/ & + &1.0280e-03_r8,1.5213e-03_r8,2.3034e-03_r8,3.5254e-03_r8,5.3355e-03_r8/) + kbo(:,57, 7) = (/ & + &8.0119e-04_r8,1.1961e-03_r8,1.8353e-03_r8,2.8565e-03_r8,4.4054e-03_r8/) + kbo(:,58, 7) = (/ & + &6.2596e-04_r8,9.4223e-04_r8,1.4648e-03_r8,2.3194e-03_r8,3.6416e-03_r8/) + kbo(:,59, 7) = (/ & + &5.2923e-04_r8,8.1079e-04_r8,1.2847e-03_r8,2.0681e-03_r8,3.3065e-03_r8/) + kbo(:,13, 8) = (/ & + &3.0137e+00_r8,3.0721e+00_r8,3.1135e+00_r8,3.1353e+00_r8,3.1526e+00_r8/) + kbo(:,14, 8) = (/ & + &2.5881e+00_r8,2.6331e+00_r8,2.6669e+00_r8,2.6887e+00_r8,2.7106e+00_r8/) + kbo(:,15, 8) = (/ & + &2.2017e+00_r8,2.2477e+00_r8,2.2747e+00_r8,2.3022e+00_r8,2.3199e+00_r8/) + kbo(:,16, 8) = (/ & + &1.8745e+00_r8,1.9119e+00_r8,1.9407e+00_r8,1.9650e+00_r8,1.9910e+00_r8/) + kbo(:,17, 8) = (/ & + &1.5865e+00_r8,1.6181e+00_r8,1.6438e+00_r8,1.6744e+00_r8,1.7044e+00_r8/) + kbo(:,18, 8) = (/ & + &1.3469e+00_r8,1.3737e+00_r8,1.4061e+00_r8,1.4422e+00_r8,1.4784e+00_r8/) + kbo(:,19, 8) = (/ & + &1.1589e+00_r8,1.1936e+00_r8,1.2348e+00_r8,1.2728e+00_r8,1.3146e+00_r8/) + kbo(:,20, 8) = (/ & + &1.0242e+00_r8,1.0660e+00_r8,1.1056e+00_r8,1.1466e+00_r8,1.1869e+00_r8/) + kbo(:,21, 8) = (/ & + &9.1121e-01_r8,9.5273e-01_r8,9.9427e-01_r8,1.0332e+00_r8,1.0710e+00_r8/) + kbo(:,22, 8) = (/ & + &8.0647e-01_r8,8.4440e-01_r8,8.8114e-01_r8,9.1866e-01_r8,9.5785e-01_r8/) + kbo(:,23, 8) = (/ & + &7.0834e-01_r8,7.4542e-01_r8,7.7998e-01_r8,8.1759e-01_r8,8.5850e-01_r8/) + kbo(:,24, 8) = (/ & + &6.2177e-01_r8,6.5425e-01_r8,6.8799e-01_r8,7.2751e-01_r8,7.7799e-01_r8/) + kbo(:,25, 8) = (/ & + &5.4589e-01_r8,5.7729e-01_r8,6.1309e-01_r8,6.5804e-01_r8,7.1412e-01_r8/) + kbo(:,26, 8) = (/ & + &4.8128e-01_r8,5.1418e-01_r8,5.5324e-01_r8,6.0347e-01_r8,6.6308e-01_r8/) + kbo(:,27, 8) = (/ & + &4.2682e-01_r8,4.6055e-01_r8,5.0524e-01_r8,5.5765e-01_r8,6.2135e-01_r8/) + kbo(:,28, 8) = (/ & + &3.8006e-01_r8,4.1721e-01_r8,4.6337e-01_r8,5.1919e-01_r8,5.8322e-01_r8/) + kbo(:,29, 8) = (/ & + &3.4196e-01_r8,3.8125e-01_r8,4.2943e-01_r8,4.8588e-01_r8,5.5221e-01_r8/) + kbo(:,30, 8) = (/ & + &3.1093e-01_r8,3.5114e-01_r8,4.0038e-01_r8,4.5863e-01_r8,5.2276e-01_r8/) + kbo(:,31, 8) = (/ & + &2.8616e-01_r8,3.2668e-01_r8,3.7633e-01_r8,4.3472e-01_r8,4.9941e-01_r8/) + kbo(:,32, 8) = (/ & + &2.6688e-01_r8,3.0820e-01_r8,3.5883e-01_r8,4.1523e-01_r8,4.8206e-01_r8/) + kbo(:,33, 8) = (/ & + &2.5149e-01_r8,2.9538e-01_r8,3.4473e-01_r8,4.0327e-01_r8,4.6953e-01_r8/) + kbo(:,34, 8) = (/ & + &2.4069e-01_r8,2.8516e-01_r8,3.3563e-01_r8,3.9421e-01_r8,4.6040e-01_r8/) + kbo(:,35, 8) = (/ & + &2.2923e-01_r8,2.7328e-01_r8,3.2510e-01_r8,3.8300e-01_r8,4.4899e-01_r8/) + kbo(:,36, 8) = (/ & + &2.1677e-01_r8,2.6037e-01_r8,3.1183e-01_r8,3.6883e-01_r8,4.3509e-01_r8/) + kbo(:,37, 8) = (/ & + &1.9848e-01_r8,2.3986e-01_r8,2.8965e-01_r8,3.4421e-01_r8,4.0854e-01_r8/) + kbo(:,38, 8) = (/ & + &1.8143e-01_r8,2.2127e-01_r8,2.6901e-01_r8,3.2212e-01_r8,3.8468e-01_r8/) + kbo(:,39, 8) = (/ & + &1.6606e-01_r8,2.0455e-01_r8,2.5024e-01_r8,3.0203e-01_r8,3.6363e-01_r8/) + kbo(:,40, 8) = (/ & + &1.4741e-01_r8,1.8322e-01_r8,2.2603e-01_r8,2.7520e-01_r8,3.3417e-01_r8/) + kbo(:,41, 8) = (/ & + &1.3011e-01_r8,1.6308e-01_r8,2.0319e-01_r8,2.4965e-01_r8,3.0588e-01_r8/) + kbo(:,42, 8) = (/ & + &1.1484e-01_r8,1.4491e-01_r8,1.8233e-01_r8,2.2638e-01_r8,2.7964e-01_r8/) + kbo(:,43, 8) = (/ & + &9.9279e-02_r8,1.2633e-01_r8,1.6039e-01_r8,2.0179e-01_r8,2.5143e-01_r8/) + kbo(:,44, 8) = (/ & + &8.4904e-02_r8,1.0929e-01_r8,1.3953e-01_r8,1.7766e-01_r8,2.2379e-01_r8/) + kbo(:,45, 8) = (/ & + &7.2367e-02_r8,9.4015e-02_r8,1.2097e-01_r8,1.5526e-01_r8,1.9786e-01_r8/) + kbo(:,46, 8) = (/ & + &6.1012e-02_r8,8.0269e-02_r8,1.0419e-01_r8,1.3470e-01_r8,1.7331e-01_r8/) + kbo(:,47, 8) = (/ & + &5.0418e-02_r8,6.7581e-02_r8,8.8667e-02_r8,1.1556e-01_r8,1.5023e-01_r8/) + kbo(:,48, 8) = (/ & + &4.1555e-02_r8,5.6345e-02_r8,7.4999e-02_r8,9.8811e-02_r8,1.2934e-01_r8/) + kbo(:,49, 8) = (/ & + &3.3904e-02_r8,4.6392e-02_r8,6.2939e-02_r8,8.3873e-02_r8,1.1077e-01_r8/) + kbo(:,50, 8) = (/ & + &2.7924e-02_r8,3.8644e-02_r8,5.3103e-02_r8,7.1817e-02_r8,9.5860e-02_r8/) + kbo(:,51, 8) = (/ & + &2.3027e-02_r8,3.2254e-02_r8,4.4770e-02_r8,6.1630e-02_r8,8.3189e-02_r8/) + kbo(:,52, 8) = (/ & + &1.8860e-02_r8,2.6783e-02_r8,3.7563e-02_r8,5.2481e-02_r8,7.1941e-02_r8/) + kbo(:,53, 8) = (/ & + &1.5315e-02_r8,2.2045e-02_r8,3.1363e-02_r8,4.4231e-02_r8,6.1710e-02_r8/) + kbo(:,54, 8) = (/ & + &1.2583e-02_r8,1.8403e-02_r8,2.6586e-02_r8,3.7901e-02_r8,5.3727e-02_r8/) + kbo(:,55, 8) = (/ & + &1.0382e-02_r8,1.5404e-02_r8,2.2584e-02_r8,3.2684e-02_r8,4.7053e-02_r8/) + kbo(:,56, 8) = (/ & + &8.4944e-03_r8,1.2799e-02_r8,1.9133e-02_r8,2.8106e-02_r8,4.1010e-02_r8/) + kbo(:,57, 8) = (/ & + &6.8852e-03_r8,1.0598e-02_r8,1.6081e-02_r8,2.3991e-02_r8,3.5498e-02_r8/) + kbo(:,58, 8) = (/ & + &5.5895e-03_r8,8.7768e-03_r8,1.3535e-02_r8,2.0567e-02_r8,3.0872e-02_r8/) + kbo(:,59, 8) = (/ & + &4.9705e-03_r8,7.9600e-03_r8,1.2473e-02_r8,1.9319e-02_r8,2.9463e-02_r8/) + kbo(:,13, 9) = (/ & + &1.4590e+01_r8,1.4670e+01_r8,1.4841e+01_r8,1.4854e+01_r8,1.4880e+01_r8/) + kbo(:,14, 9) = (/ & + &1.3239e+01_r8,1.3368e+01_r8,1.3423e+01_r8,1.3479e+01_r8,1.3588e+01_r8/) + kbo(:,15, 9) = (/ & + &1.1801e+01_r8,1.1873e+01_r8,1.1983e+01_r8,1.2092e+01_r8,1.2194e+01_r8/) + kbo(:,16, 9) = (/ & + &1.0397e+01_r8,1.0519e+01_r8,1.0636e+01_r8,1.0761e+01_r8,1.0910e+01_r8/) + kbo(:,17, 9) = (/ & + &9.1941e+00_r8,9.3273e+00_r8,9.4699e+00_r8,9.6116e+00_r8,9.7497e+00_r8/) + kbo(:,18, 9) = (/ & + &8.2105e+00_r8,8.3532e+00_r8,8.4897e+00_r8,8.6223e+00_r8,8.7373e+00_r8/) + kbo(:,19, 9) = (/ & + &7.2827e+00_r8,7.4240e+00_r8,7.5562e+00_r8,7.6727e+00_r8,7.7914e+00_r8/) + kbo(:,20, 9) = (/ & + &6.3721e+00_r8,6.4943e+00_r8,6.6028e+00_r8,6.7186e+00_r8,6.8391e+00_r8/) + kbo(:,21, 9) = (/ & + &5.5515e+00_r8,5.6468e+00_r8,5.7503e+00_r8,5.8563e+00_r8,5.9656e+00_r8/) + kbo(:,22, 9) = (/ & + &4.8000e+00_r8,4.8972e+00_r8,4.9944e+00_r8,5.1084e+00_r8,5.2408e+00_r8/) + kbo(:,23, 9) = (/ & + &4.1624e+00_r8,4.2656e+00_r8,4.3811e+00_r8,4.5085e+00_r8,4.6380e+00_r8/) + kbo(:,24, 9) = (/ & + &3.6468e+00_r8,3.7664e+00_r8,3.9092e+00_r8,4.0407e+00_r8,4.1687e+00_r8/) + kbo(:,25, 9) = (/ & + &3.2292e+00_r8,3.3800e+00_r8,3.5189e+00_r8,3.6529e+00_r8,3.8087e+00_r8/) + kbo(:,26, 9) = (/ & + &2.9129e+00_r8,3.0593e+00_r8,3.1926e+00_r8,3.3487e+00_r8,3.5171e+00_r8/) + kbo(:,27, 9) = (/ & + &2.6651e+00_r8,2.7860e+00_r8,2.9417e+00_r8,3.1050e+00_r8,3.2838e+00_r8/) + kbo(:,28, 9) = (/ & + &2.4547e+00_r8,2.5852e+00_r8,2.7243e+00_r8,2.8973e+00_r8,3.0879e+00_r8/) + kbo(:,29, 9) = (/ & + &2.2775e+00_r8,2.4144e+00_r8,2.5520e+00_r8,2.7166e+00_r8,2.9171e+00_r8/) + kbo(:,30, 9) = (/ & + &2.1281e+00_r8,2.2766e+00_r8,2.4266e+00_r8,2.5792e+00_r8,2.7778e+00_r8/) + kbo(:,31, 9) = (/ & + &1.9982e+00_r8,2.1596e+00_r8,2.3215e+00_r8,2.4758e+00_r8,2.6690e+00_r8/) + kbo(:,32, 9) = (/ & + &1.8974e+00_r8,2.0696e+00_r8,2.2391e+00_r8,2.4103e+00_r8,2.6183e+00_r8/) + kbo(:,33, 9) = (/ & + &1.8191e+00_r8,1.9994e+00_r8,2.1809e+00_r8,2.3775e+00_r8,2.6019e+00_r8/) + kbo(:,34, 9) = (/ & + &1.7674e+00_r8,1.9617e+00_r8,2.1590e+00_r8,2.3767e+00_r8,2.6194e+00_r8/) + kbo(:,35, 9) = (/ & + &1.7160e+00_r8,1.9253e+00_r8,2.1379e+00_r8,2.3725e+00_r8,2.6356e+00_r8/) + kbo(:,36, 9) = (/ & + &1.6660e+00_r8,1.8913e+00_r8,2.1169e+00_r8,2.3615e+00_r8,2.6378e+00_r8/) + kbo(:,37, 9) = (/ & + &1.5784e+00_r8,1.8090e+00_r8,2.0343e+00_r8,2.2860e+00_r8,2.5707e+00_r8/) + kbo(:,38, 9) = (/ & + &1.4967e+00_r8,1.7299e+00_r8,1.9619e+00_r8,2.2122e+00_r8,2.4970e+00_r8/) + kbo(:,39, 9) = (/ & + &1.4275e+00_r8,1.6566e+00_r8,1.8885e+00_r8,2.1422e+00_r8,2.4238e+00_r8/) + kbo(:,40, 9) = (/ & + &1.3319e+00_r8,1.5527e+00_r8,1.7867e+00_r8,2.0342e+00_r8,2.3084e+00_r8/) + kbo(:,41, 9) = (/ & + &1.2324e+00_r8,1.4488e+00_r8,1.6798e+00_r8,1.9260e+00_r8,2.1920e+00_r8/) + kbo(:,42, 9) = (/ & + &1.1393e+00_r8,1.3560e+00_r8,1.5786e+00_r8,1.8237e+00_r8,2.0822e+00_r8/) + kbo(:,43, 9) = (/ & + &1.0393e+00_r8,1.2480e+00_r8,1.4586e+00_r8,1.7011e+00_r8,1.9564e+00_r8/) + kbo(:,44, 9) = (/ & + &9.4004e-01_r8,1.1318e+00_r8,1.3401e+00_r8,1.5753e+00_r8,1.8301e+00_r8/) + kbo(:,45, 9) = (/ & + &8.4677e-01_r8,1.0287e+00_r8,1.2277e+00_r8,1.4538e+00_r8,1.7017e+00_r8/) + kbo(:,46, 9) = (/ & + &7.5668e-01_r8,9.2772e-01_r8,1.1175e+00_r8,1.3351e+00_r8,1.5740e+00_r8/) + kbo(:,47, 9) = (/ & + &6.6952e-01_r8,8.3230e-01_r8,1.0096e+00_r8,1.2100e+00_r8,1.4418e+00_r8/) + kbo(:,48, 9) = (/ & + &5.9179e-01_r8,7.4047e-01_r8,9.0922e-01_r8,1.0966e+00_r8,1.3183e+00_r8/) + kbo(:,49, 9) = (/ & + &5.2110e-01_r8,6.5712e-01_r8,8.1623e-01_r8,9.9075e-01_r8,1.1944e+00_r8/) + kbo(:,50, 9) = (/ & + &4.6158e-01_r8,5.8589e-01_r8,7.3680e-01_r8,8.9883e-01_r8,1.0896e+00_r8/) + kbo(:,51, 9) = (/ & + &4.0970e-01_r8,5.2471e-01_r8,6.6511e-01_r8,8.1893e-01_r8,1.0001e+00_r8/) + kbo(:,52, 9) = (/ & + &3.6376e-01_r8,4.6797e-01_r8,5.9787e-01_r8,7.4696e-01_r8,9.1589e-01_r8/) + kbo(:,53, 9) = (/ & + &3.2051e-01_r8,4.1628e-01_r8,5.3506e-01_r8,6.7993e-01_r8,8.3743e-01_r8/) + kbo(:,54, 9) = (/ & + &2.8466e-01_r8,3.7491e-01_r8,4.8412e-01_r8,6.2077e-01_r8,7.6925e-01_r8/) + kbo(:,55, 9) = (/ & + &2.5367e-01_r8,3.3870e-01_r8,4.3869e-01_r8,5.6524e-01_r8,7.0875e-01_r8/) + kbo(:,56, 9) = (/ & + &2.2562e-01_r8,3.0476e-01_r8,3.9766e-01_r8,5.1473e-01_r8,6.5170e-01_r8/) + kbo(:,57, 9) = (/ & + &1.9827e-01_r8,2.7217e-01_r8,3.6127e-01_r8,4.6695e-01_r8,5.9679e-01_r8/) + kbo(:,58, 9) = (/ & + &1.7439e-01_r8,2.4383e-01_r8,3.2816e-01_r8,4.2523e-01_r8,5.4584e-01_r8/) + kbo(:,59, 9) = (/ & + &1.6511e-01_r8,2.3377e-01_r8,3.1581e-01_r8,4.1157e-01_r8,5.2975e-01_r8/) + kbo(:,13,10) = (/ & + &4.0695e+01_r8,4.0469e+01_r8,4.0155e+01_r8,4.1544e+01_r8,4.2682e+01_r8/) + kbo(:,14,10) = (/ & + &3.9304e+01_r8,3.9060e+01_r8,4.0807e+01_r8,4.1587e+01_r8,4.0953e+01_r8/) + kbo(:,15,10) = (/ & + &3.7657e+01_r8,3.9117e+01_r8,3.9307e+01_r8,3.8957e+01_r8,3.9710e+01_r8/) + kbo(:,16,10) = (/ & + &3.6278e+01_r8,3.6420e+01_r8,3.6566e+01_r8,3.7322e+01_r8,3.7268e+01_r8/) + kbo(:,17,10) = (/ & + &3.3662e+01_r8,3.3973e+01_r8,3.4667e+01_r8,3.4884e+01_r8,3.5251e+01_r8/) + kbo(:,18,10) = (/ & + &3.1195e+01_r8,3.1946e+01_r8,3.2272e+01_r8,3.2818e+01_r8,3.3898e+01_r8/) + kbo(:,19,10) = (/ & + &2.9346e+01_r8,2.9678e+01_r8,3.0231e+01_r8,3.1581e+01_r8,3.2542e+01_r8/) + kbo(:,20,10) = (/ & + &2.6569e+01_r8,2.7189e+01_r8,2.8571e+01_r8,2.9702e+01_r8,3.0461e+01_r8/) + kbo(:,21,10) = (/ & + &2.3800e+01_r8,2.5133e+01_r8,2.6296e+01_r8,2.7333e+01_r8,2.8348e+01_r8/) + kbo(:,22,10) = (/ & + &2.1748e+01_r8,2.2899e+01_r8,2.3947e+01_r8,2.5006e+01_r8,2.6299e+01_r8/) + kbo(:,23,10) = (/ & + &1.9685e+01_r8,2.0476e+01_r8,2.1391e+01_r8,2.2690e+01_r8,2.3900e+01_r8/) + kbo(:,24,10) = (/ & + &1.7032e+01_r8,1.7826e+01_r8,1.8674e+01_r8,1.9703e+01_r8,2.1087e+01_r8/) + kbo(:,25,10) = (/ & + &1.4880e+01_r8,1.5564e+01_r8,1.6390e+01_r8,1.7502e+01_r8,1.8671e+01_r8/) + kbo(:,26,10) = (/ & + &1.3363e+01_r8,1.4020e+01_r8,1.5087e+01_r8,1.6178e+01_r8,1.7289e+01_r8/) + kbo(:,27,10) = (/ & + &1.1727e+01_r8,1.2959e+01_r8,1.3942e+01_r8,1.5094e+01_r8,1.6463e+01_r8/) + kbo(:,28,10) = (/ & + &1.0659e+01_r8,1.1764e+01_r8,1.3018e+01_r8,1.4300e+01_r8,1.5936e+01_r8/) + kbo(:,29,10) = (/ & + &9.6581e+00_r8,1.0907e+01_r8,1.2325e+01_r8,1.4028e+01_r8,1.5807e+01_r8/) + kbo(:,30,10) = (/ & + &8.9612e+00_r8,1.0145e+01_r8,1.1747e+01_r8,1.3771e+01_r8,1.5726e+01_r8/) + kbo(:,31,10) = (/ & + &8.6124e+00_r8,9.7350e+00_r8,1.1421e+01_r8,1.3475e+01_r8,1.5366e+01_r8/) + kbo(:,32,10) = (/ & + &8.5911e+00_r8,9.4800e+00_r8,1.1115e+01_r8,1.3010e+01_r8,1.4984e+01_r8/) + kbo(:,33,10) = (/ & + &8.6709e+00_r8,9.3343e+00_r8,1.0809e+01_r8,1.2622e+01_r8,1.4676e+01_r8/) + kbo(:,34,10) = (/ & + &8.8793e+00_r8,9.5541e+00_r8,1.0639e+01_r8,1.2461e+01_r8,1.4700e+01_r8/) + kbo(:,35,10) = (/ & + &9.1036e+00_r8,9.7617e+00_r8,1.0550e+01_r8,1.2303e+01_r8,1.4597e+01_r8/) + kbo(:,36,10) = (/ & + &9.1500e+00_r8,9.8472e+00_r8,1.0675e+01_r8,1.1920e+01_r8,1.4033e+01_r8/) + kbo(:,37,10) = (/ & + &8.9913e+00_r8,9.7513e+00_r8,1.0626e+01_r8,1.1848e+01_r8,1.3311e+01_r8/) + kbo(:,38,10) = (/ & + &8.8541e+00_r8,9.6133e+00_r8,1.0479e+01_r8,1.1805e+01_r8,1.2978e+01_r8/) + kbo(:,39,10) = (/ & + &8.6355e+00_r8,9.4791e+00_r8,1.0441e+01_r8,1.1774e+01_r8,1.2974e+01_r8/) + kbo(:,40,10) = (/ & + &8.2572e+00_r8,9.1900e+00_r8,1.0103e+01_r8,1.1340e+01_r8,1.2612e+01_r8/) + kbo(:,41,10) = (/ & + &7.9700e+00_r8,8.8564e+00_r8,9.7227e+00_r8,1.0892e+01_r8,1.2191e+01_r8/) + kbo(:,42,10) = (/ & + &7.7269e+00_r8,8.5147e+00_r8,9.3572e+00_r8,1.0449e+01_r8,1.1769e+01_r8/) + kbo(:,43,10) = (/ & + &7.3457e+00_r8,8.1022e+00_r8,8.9870e+00_r8,9.9755e+00_r8,1.1267e+01_r8/) + kbo(:,44,10) = (/ & + &6.8559e+00_r8,7.7825e+00_r8,8.6085e+00_r8,9.5618e+00_r8,1.0705e+01_r8/) + kbo(:,45,10) = (/ & + &6.3680e+00_r8,7.3808e+00_r8,8.2404e+00_r8,9.1444e+00_r8,1.0228e+01_r8/) + kbo(:,46,10) = (/ & + &5.9178e+00_r8,6.9688e+00_r8,7.8931e+00_r8,8.8310e+00_r8,9.8114e+00_r8/) + kbo(:,47,10) = (/ & + &5.4530e+00_r8,6.4924e+00_r8,7.5375e+00_r8,8.5314e+00_r8,9.4745e+00_r8/) + kbo(:,48,10) = (/ & + &4.9630e+00_r8,6.0598e+00_r8,7.0862e+00_r8,8.1895e+00_r8,9.1462e+00_r8/) + kbo(:,49,10) = (/ & + &4.4814e+00_r8,5.6082e+00_r8,6.6461e+00_r8,7.8385e+00_r8,8.8792e+00_r8/) + kbo(:,50,10) = (/ & + &4.0666e+00_r8,5.1497e+00_r8,6.2742e+00_r8,7.4367e+00_r8,8.5539e+00_r8/) + kbo(:,51,10) = (/ & + &3.6813e+00_r8,4.7093e+00_r8,5.9040e+00_r8,7.0217e+00_r8,8.2062e+00_r8/) + kbo(:,52,10) = (/ & + &3.3213e+00_r8,4.2985e+00_r8,5.4430e+00_r8,6.5658e+00_r8,7.7730e+00_r8/) + kbo(:,53,10) = (/ & + &2.9730e+00_r8,3.8940e+00_r8,5.0012e+00_r8,6.1367e+00_r8,7.2957e+00_r8/) + kbo(:,54,10) = (/ & + &2.6494e+00_r8,3.5088e+00_r8,4.5590e+00_r8,5.7479e+00_r8,6.8609e+00_r8/) + kbo(:,55,10) = (/ & + &2.3517e+00_r8,3.1542e+00_r8,4.1525e+00_r8,5.3587e+00_r8,6.4637e+00_r8/) + kbo(:,56,10) = (/ & + &2.0870e+00_r8,2.8232e+00_r8,3.7684e+00_r8,4.9288e+00_r8,6.0659e+00_r8/) + kbo(:,57,10) = (/ & + &1.8716e+00_r8,2.5211e+00_r8,3.3862e+00_r8,4.4963e+00_r8,5.6364e+00_r8/) + kbo(:,58,10) = (/ & + &1.6996e+00_r8,2.2494e+00_r8,3.0457e+00_r8,4.0946e+00_r8,5.2813e+00_r8/) + kbo(:,59,10) = (/ & + &1.6125e+00_r8,2.1057e+00_r8,2.8675e+00_r8,3.8607e+00_r8,5.0173e+00_r8/) + kbo(:,13,11) = (/ & + &5.4280e+01_r8,5.5937e+01_r8,5.6472e+01_r8,5.6083e+01_r8,5.6645e+01_r8/) + kbo(:,14,11) = (/ & + &5.6104e+01_r8,5.7569e+01_r8,5.6325e+01_r8,5.6970e+01_r8,5.8322e+01_r8/) + kbo(:,15,11) = (/ & + &5.6157e+01_r8,5.5505e+01_r8,5.6534e+01_r8,5.8680e+01_r8,5.8495e+01_r8/) + kbo(:,16,11) = (/ & + &5.4215e+01_r8,5.5590e+01_r8,5.7381e+01_r8,5.6844e+01_r8,5.6502e+01_r8/) + kbo(:,17,11) = (/ & + &5.3917e+01_r8,5.5209e+01_r8,5.4751e+01_r8,5.5176e+01_r8,5.5535e+01_r8/) + kbo(:,18,11) = (/ & + &5.2925e+01_r8,5.3017e+01_r8,5.3849e+01_r8,5.4671e+01_r8,5.5470e+01_r8/) + kbo(:,19,11) = (/ & + &5.0412e+01_r8,5.1474e+01_r8,5.2761e+01_r8,5.3623e+01_r8,5.4522e+01_r8/) + kbo(:,20,11) = (/ & + &4.7799e+01_r8,4.9437e+01_r8,5.0594e+01_r8,5.1515e+01_r8,5.3379e+01_r8/) + kbo(:,21,11) = (/ & + &4.5510e+01_r8,4.6838e+01_r8,4.7923e+01_r8,4.9803e+01_r8,5.2087e+01_r8/) + kbo(:,22,11) = (/ & + &4.2197e+01_r8,4.3528e+01_r8,4.5703e+01_r8,4.8296e+01_r8,5.0603e+01_r8/) + kbo(:,23,11) = (/ & + &3.8776e+01_r8,4.1167e+01_r8,4.4015e+01_r8,4.6341e+01_r8,4.9195e+01_r8/) + kbo(:,24,11) = (/ & + &3.6077e+01_r8,3.8799e+01_r8,4.1478e+01_r8,4.4468e+01_r8,4.7105e+01_r8/) + kbo(:,25,11) = (/ & + &3.3423e+01_r8,3.6288e+01_r8,3.9007e+01_r8,4.1836e+01_r8,4.5174e+01_r8/) + kbo(:,26,11) = (/ & + &3.0575e+01_r8,3.3241e+01_r8,3.5927e+01_r8,3.9133e+01_r8,4.2785e+01_r8/) + kbo(:,27,11) = (/ & + &2.7764e+01_r8,3.0312e+01_r8,3.3054e+01_r8,3.6826e+01_r8,4.0509e+01_r8/) + kbo(:,28,11) = (/ & + &2.5413e+01_r8,2.8045e+01_r8,3.1419e+01_r8,3.5118e+01_r8,3.8747e+01_r8/) + kbo(:,29,11) = (/ & + &2.4096e+01_r8,2.6980e+01_r8,3.0700e+01_r8,3.4243e+01_r8,3.7699e+01_r8/) + kbo(:,30,11) = (/ & + &2.3140e+01_r8,2.6541e+01_r8,2.9953e+01_r8,3.3565e+01_r8,3.7298e+01_r8/) + kbo(:,31,11) = (/ & + &2.2574e+01_r8,2.6228e+01_r8,2.9925e+01_r8,3.3653e+01_r8,3.8032e+01_r8/) + kbo(:,32,11) = (/ & + &2.2078e+01_r8,2.6231e+01_r8,3.0164e+01_r8,3.4342e+01_r8,3.9067e+01_r8/) + kbo(:,33,11) = (/ & + &2.1802e+01_r8,2.6392e+01_r8,3.0637e+01_r8,3.5356e+01_r8,4.0173e+01_r8/) + kbo(:,34,11) = (/ & + &2.1886e+01_r8,2.6523e+01_r8,3.1557e+01_r8,3.6504e+01_r8,4.1183e+01_r8/) + kbo(:,35,11) = (/ & + &2.1287e+01_r8,2.6137e+01_r8,3.1875e+01_r8,3.7051e+01_r8,4.1397e+01_r8/) + kbo(:,36,11) = (/ & + &2.0396e+01_r8,2.5293e+01_r8,3.0920e+01_r8,3.6387e+01_r8,4.1546e+01_r8/) + kbo(:,37,11) = (/ & + &1.9398e+01_r8,2.4195e+01_r8,2.9734e+01_r8,3.5138e+01_r8,4.1598e+01_r8/) + kbo(:,38,11) = (/ & + &1.8580e+01_r8,2.3161e+01_r8,2.8626e+01_r8,3.3912e+01_r8,4.1158e+01_r8/) + kbo(:,39,11) = (/ & + &1.8482e+01_r8,2.2205e+01_r8,2.7504e+01_r8,3.3104e+01_r8,4.0527e+01_r8/) + kbo(:,40,11) = (/ & + &1.7984e+01_r8,2.0750e+01_r8,2.5770e+01_r8,3.1669e+01_r8,3.8818e+01_r8/) + kbo(:,41,11) = (/ & + &1.7355e+01_r8,1.9936e+01_r8,2.4013e+01_r8,3.0152e+01_r8,3.7102e+01_r8/) + kbo(:,42,11) = (/ & + &1.6681e+01_r8,1.9220e+01_r8,2.2251e+01_r8,2.8625e+01_r8,3.5420e+01_r8/) + kbo(:,43,11) = (/ & + &1.5870e+01_r8,1.8435e+01_r8,2.1070e+01_r8,2.6668e+01_r8,3.3375e+01_r8/) + kbo(:,44,11) = (/ & + &1.5165e+01_r8,1.7568e+01_r8,2.0082e+01_r8,2.4204e+01_r8,3.1050e+01_r8/) + kbo(:,45,11) = (/ & + &1.4453e+01_r8,1.6684e+01_r8,1.9148e+01_r8,2.2404e+01_r8,2.8741e+01_r8/) + kbo(:,46,11) = (/ & + &1.3674e+01_r8,1.5793e+01_r8,1.8236e+01_r8,2.1064e+01_r8,2.6017e+01_r8/) + kbo(:,47,11) = (/ & + &1.2730e+01_r8,1.4847e+01_r8,1.7129e+01_r8,1.9769e+01_r8,2.3301e+01_r8/) + kbo(:,48,11) = (/ & + &1.1966e+01_r8,1.3921e+01_r8,1.6062e+01_r8,1.8570e+01_r8,2.1519e+01_r8/) + kbo(:,49,11) = (/ & + &1.1256e+01_r8,1.2947e+01_r8,1.5051e+01_r8,1.7441e+01_r8,2.0164e+01_r8/) + kbo(:,50,11) = (/ & + &1.0630e+01_r8,1.2231e+01_r8,1.4125e+01_r8,1.6384e+01_r8,1.9019e+01_r8/) + kbo(:,51,11) = (/ & + &9.8987e+00_r8,1.1569e+01_r8,1.3215e+01_r8,1.5489e+01_r8,1.7851e+01_r8/) + kbo(:,52,11) = (/ & + &9.1901e+00_r8,1.0969e+01_r8,1.2500e+01_r8,1.4560e+01_r8,1.6807e+01_r8/) + kbo(:,53,11) = (/ & + &8.5518e+00_r8,1.0279e+01_r8,1.1856e+01_r8,1.3672e+01_r8,1.5980e+01_r8/) + kbo(:,54,11) = (/ & + &7.8898e+00_r8,9.6237e+00_r8,1.1322e+01_r8,1.2850e+01_r8,1.5109e+01_r8/) + kbo(:,55,11) = (/ & + &7.2910e+00_r8,9.0794e+00_r8,1.0802e+01_r8,1.2222e+01_r8,1.4316e+01_r8/) + kbo(:,56,11) = (/ & + &6.6231e+00_r8,8.4503e+00_r8,1.0147e+01_r8,1.1641e+01_r8,1.3475e+01_r8/) + kbo(:,57,11) = (/ & + &5.9797e+00_r8,7.8956e+00_r8,9.5656e+00_r8,1.1172e+01_r8,1.2770e+01_r8/) + kbo(:,58,11) = (/ & + &5.3792e+00_r8,7.3070e+00_r8,9.0406e+00_r8,1.0661e+01_r8,1.2099e+01_r8/) + kbo(:,59,11) = (/ & + &5.1187e+00_r8,7.0446e+00_r8,8.7908e+00_r8,1.0434e+01_r8,1.1861e+01_r8/) + kbo(:,13,12) = (/ & + &8.5594e+01_r8,8.5081e+01_r8,8.4548e+01_r8,8.3781e+01_r8,8.2265e+01_r8/) + kbo(:,14,12) = (/ & + &8.5160e+01_r8,8.5106e+01_r8,8.5561e+01_r8,8.4404e+01_r8,8.6474e+01_r8/) + kbo(:,15,12) = (/ & + &8.6225e+01_r8,8.6934e+01_r8,8.6406e+01_r8,8.7005e+01_r8,8.9359e+01_r8/) + kbo(:,16,12) = (/ & + &8.5430e+01_r8,8.5513e+01_r8,8.6639e+01_r8,9.0490e+01_r8,9.3290e+01_r8/) + kbo(:,17,12) = (/ & + &8.2443e+01_r8,8.4907e+01_r8,8.8384e+01_r8,9.0076e+01_r8,9.1263e+01_r8/) + kbo(:,18,12) = (/ & + &8.5149e+01_r8,8.7540e+01_r8,8.9291e+01_r8,9.0823e+01_r8,9.2775e+01_r8/) + kbo(:,19,12) = (/ & + &8.8628e+01_r8,9.0598e+01_r8,9.2322e+01_r8,9.4441e+01_r8,9.6854e+01_r8/) + kbo(:,20,12) = (/ & + &8.9356e+01_r8,9.1085e+01_r8,9.4127e+01_r8,9.6914e+01_r8,9.9051e+01_r8/) + kbo(:,21,12) = (/ & + &8.7608e+01_r8,9.1521e+01_r8,9.5537e+01_r8,9.7630e+01_r8,9.9135e+01_r8/) + kbo(:,22,12) = (/ & + &8.6703e+01_r8,9.1359e+01_r8,9.3725e+01_r8,9.6097e+01_r8,9.8620e+01_r8/) + kbo(:,23,12) = (/ & + &8.4986e+01_r8,8.8658e+01_r8,9.1547e+01_r8,9.4897e+01_r8,9.8884e+01_r8/) + kbo(:,24,12) = (/ & + &8.1861e+01_r8,8.5495e+01_r8,8.9569e+01_r8,9.4335e+01_r8,9.9177e+01_r8/) + kbo(:,25,12) = (/ & + &7.8144e+01_r8,8.2621e+01_r8,8.8221e+01_r8,9.4555e+01_r8,9.9082e+01_r8/) + kbo(:,26,12) = (/ & + &7.5558e+01_r8,8.1550e+01_r8,8.8515e+01_r8,9.4800e+01_r8,1.0018e+02_r8/) + kbo(:,27,12) = (/ & + &7.4385e+01_r8,8.1401e+01_r8,8.8755e+01_r8,9.4867e+01_r8,9.9863e+01_r8/) + kbo(:,28,12) = (/ & + &7.2786e+01_r8,8.0630e+01_r8,8.7375e+01_r8,9.3177e+01_r8,9.7577e+01_r8/) + kbo(:,29,12) = (/ & + &7.2494e+01_r8,7.9832e+01_r8,8.6004e+01_r8,9.1472e+01_r8,9.7317e+01_r8/) + kbo(:,30,12) = (/ & + &7.1849e+01_r8,7.8701e+01_r8,8.4991e+01_r8,9.0891e+01_r8,9.7338e+01_r8/) + kbo(:,31,12) = (/ & + &7.1241e+01_r8,7.7805e+01_r8,8.4010e+01_r8,9.1171e+01_r8,1.0059e+02_r8/) + kbo(:,32,12) = (/ & + &7.0698e+01_r8,7.7293e+01_r8,8.4547e+01_r8,9.6001e+01_r8,1.0686e+02_r8/) + kbo(:,33,12) = (/ & + &7.0154e+01_r8,7.8613e+01_r8,9.0857e+01_r8,1.0245e+02_r8,1.1312e+02_r8/) + kbo(:,34,12) = (/ & + &7.1031e+01_r8,8.3561e+01_r8,9.6187e+01_r8,1.0815e+02_r8,1.1901e+02_r8/) + kbo(:,35,12) = (/ & + &7.5071e+01_r8,8.8162e+01_r8,1.0114e+02_r8,1.1296e+02_r8,1.2569e+02_r8/) + kbo(:,36,12) = (/ & + &7.8029e+01_r8,9.1692e+01_r8,1.0504e+02_r8,1.1849e+02_r8,1.3079e+02_r8/) + kbo(:,37,12) = (/ & + &7.7450e+01_r8,9.1080e+01_r8,1.0499e+02_r8,1.1872e+02_r8,1.3083e+02_r8/) + kbo(:,38,12) = (/ & + &7.6390e+01_r8,9.0295e+01_r8,1.0451e+02_r8,1.1896e+02_r8,1.3094e+02_r8/) + kbo(:,39,12) = (/ & + &7.4846e+01_r8,8.9967e+01_r8,1.0468e+02_r8,1.1884e+02_r8,1.3087e+02_r8/) + kbo(:,40,12) = (/ & + &7.0636e+01_r8,8.6765e+01_r8,1.0145e+02_r8,1.1588e+02_r8,1.2805e+02_r8/) + kbo(:,41,12) = (/ & + &6.6305e+01_r8,8.2647e+01_r8,9.8224e+01_r8,1.1219e+02_r8,1.2504e+02_r8/) + kbo(:,42,12) = (/ & + &6.2198e+01_r8,7.8258e+01_r8,9.4811e+01_r8,1.0862e+02_r8,1.2155e+02_r8/) + kbo(:,43,12) = (/ & + &5.7303e+01_r8,7.2832e+01_r8,8.9604e+01_r8,1.0357e+02_r8,1.1674e+02_r8/) + kbo(:,44,12) = (/ & + &5.2689e+01_r8,6.6907e+01_r8,8.3558e+01_r8,9.8406e+01_r8,1.1125e+02_r8/) + kbo(:,45,12) = (/ & + &4.8182e+01_r8,6.1264e+01_r8,7.7478e+01_r8,9.3228e+01_r8,1.0590e+02_r8/) + kbo(:,46,12) = (/ & + &4.3386e+01_r8,5.6258e+01_r8,7.0871e+01_r8,8.6833e+01_r8,1.0102e+02_r8/) + kbo(:,47,12) = (/ & + &3.8704e+01_r8,5.0818e+01_r8,6.4039e+01_r8,7.9666e+01_r8,9.5229e+01_r8/) + kbo(:,48,12) = (/ & + &3.3968e+01_r8,4.5364e+01_r8,5.8393e+01_r8,7.2512e+01_r8,8.8396e+01_r8/) + kbo(:,49,12) = (/ & + &2.9879e+01_r8,4.0583e+01_r8,5.2774e+01_r8,6.5752e+01_r8,8.1056e+01_r8/) + kbo(:,50,12) = (/ & + &2.7602e+01_r8,3.6039e+01_r8,4.7664e+01_r8,6.0460e+01_r8,7.4304e+01_r8/) + kbo(:,51,12) = (/ & + &2.6051e+01_r8,3.1889e+01_r8,4.2974e+01_r8,5.5102e+01_r8,6.8169e+01_r8/) + kbo(:,52,12) = (/ & + &2.4438e+01_r8,2.8876e+01_r8,3.8469e+01_r8,5.0102e+01_r8,6.2912e+01_r8/) + kbo(:,53,12) = (/ & + &2.2776e+01_r8,2.7295e+01_r8,3.4271e+01_r8,4.5285e+01_r8,5.7384e+01_r8/) + kbo(:,54,12) = (/ & + &2.1249e+01_r8,2.5821e+01_r8,3.0686e+01_r8,4.1216e+01_r8,5.2669e+01_r8/) + kbo(:,55,12) = (/ & + &2.0155e+01_r8,2.4296e+01_r8,2.8676e+01_r8,3.7338e+01_r8,4.8393e+01_r8/) + kbo(:,56,12) = (/ & + &1.8949e+01_r8,2.2808e+01_r8,2.7284e+01_r8,3.3732e+01_r8,4.4387e+01_r8/) + kbo(:,57,12) = (/ & + &1.7651e+01_r8,2.1401e+01_r8,2.5896e+01_r8,3.0538e+01_r8,4.0399e+01_r8/) + kbo(:,58,12) = (/ & + &1.6454e+01_r8,2.0257e+01_r8,2.4400e+01_r8,2.8791e+01_r8,3.6888e+01_r8/) + kbo(:,59,12) = (/ & + &1.6078e+01_r8,1.9650e+01_r8,2.3686e+01_r8,2.8130e+01_r8,3.5337e+01_r8/) + kbo(:,13,13) = (/ & + &1.6179e+02_r8,1.5851e+02_r8,1.5620e+02_r8,1.5532e+02_r8,1.5316e+02_r8/) + kbo(:,14,13) = (/ & + &1.7476e+02_r8,1.7156e+02_r8,1.7068e+02_r8,1.6952e+02_r8,1.6413e+02_r8/) + kbo(:,15,13) = (/ & + &1.8520e+02_r8,1.8372e+02_r8,1.8384e+02_r8,1.8019e+02_r8,1.7522e+02_r8/) + kbo(:,16,13) = (/ & + &1.9454e+02_r8,1.9542e+02_r8,1.9248e+02_r8,1.8773e+02_r8,1.8813e+02_r8/) + kbo(:,17,13) = (/ & + &2.0028e+02_r8,1.9793e+02_r8,1.9596e+02_r8,1.9785e+02_r8,2.0205e+02_r8/) + kbo(:,18,13) = (/ & + &1.9037e+02_r8,1.9170e+02_r8,1.9555e+02_r8,2.0164e+02_r8,2.0309e+02_r8/) + kbo(:,19,13) = (/ & + &1.7958e+02_r8,1.8623e+02_r8,1.9196e+02_r8,1.9543e+02_r8,1.9670e+02_r8/) + kbo(:,20,13) = (/ & + &1.7423e+02_r8,1.8217e+02_r8,1.8721e+02_r8,1.9064e+02_r8,1.9763e+02_r8/) + kbo(:,21,13) = (/ & + &1.7205e+02_r8,1.7751e+02_r8,1.8259e+02_r8,1.9102e+02_r8,1.9985e+02_r8/) + kbo(:,22,13) = (/ & + &1.7310e+02_r8,1.7837e+02_r8,1.8681e+02_r8,1.9582e+02_r8,2.0409e+02_r8/) + kbo(:,23,13) = (/ & + &1.7691e+02_r8,1.8432e+02_r8,1.9387e+02_r8,2.0103e+02_r8,2.1026e+02_r8/) + kbo(:,24,13) = (/ & + &1.8088e+02_r8,1.8942e+02_r8,1.9891e+02_r8,2.0699e+02_r8,2.1646e+02_r8/) + kbo(:,25,13) = (/ & + &1.8492e+02_r8,1.9434e+02_r8,2.0408e+02_r8,2.1437e+02_r8,2.2277e+02_r8/) + kbo(:,26,13) = (/ & + &1.8625e+02_r8,1.9837e+02_r8,2.0945e+02_r8,2.1941e+02_r8,2.3087e+02_r8/) + kbo(:,27,13) = (/ & + &1.9010e+02_r8,2.0364e+02_r8,2.1615e+02_r8,2.2715e+02_r8,2.4079e+02_r8/) + kbo(:,28,13) = (/ & + &1.9712e+02_r8,2.1090e+02_r8,2.2463e+02_r8,2.3844e+02_r8,2.5439e+02_r8/) + kbo(:,29,13) = (/ & + &2.0453e+02_r8,2.1990e+02_r8,2.3570e+02_r8,2.5241e+02_r8,2.6509e+02_r8/) + kbo(:,30,13) = (/ & + &2.1308e+02_r8,2.3113e+02_r8,2.4908e+02_r8,2.6461e+02_r8,2.7735e+02_r8/) + kbo(:,31,13) = (/ & + &2.2395e+02_r8,2.4239e+02_r8,2.6296e+02_r8,2.7710e+02_r8,2.8754e+02_r8/) + kbo(:,32,13) = (/ & + &2.3649e+02_r8,2.5891e+02_r8,2.7696e+02_r8,2.8809e+02_r8,2.9409e+02_r8/) + kbo(:,33,13) = (/ & + &2.5295e+02_r8,2.7352e+02_r8,2.8553e+02_r8,2.9364e+02_r8,3.0036e+02_r8/) + kbo(:,34,13) = (/ & + &2.6621e+02_r8,2.8028e+02_r8,2.9209e+02_r8,2.9925e+02_r8,3.0905e+02_r8/) + kbo(:,35,13) = (/ & + &2.7274e+02_r8,2.8720e+02_r8,2.9678e+02_r8,3.0598e+02_r8,3.1573e+02_r8/) + kbo(:,36,13) = (/ & + &2.7668e+02_r8,2.9126e+02_r8,3.0131e+02_r8,3.1293e+02_r8,3.2456e+02_r8/) + kbo(:,37,13) = (/ & + &2.7566e+02_r8,2.9125e+02_r8,3.0241e+02_r8,3.1513e+02_r8,3.2636e+02_r8/) + kbo(:,38,13) = (/ & + &2.7524e+02_r8,2.9197e+02_r8,3.0411e+02_r8,3.1688e+02_r8,3.2854e+02_r8/) + kbo(:,39,13) = (/ & + &2.7502e+02_r8,2.9241e+02_r8,3.0488e+02_r8,3.1825e+02_r8,3.3122e+02_r8/) + kbo(:,40,13) = (/ & + &2.7103e+02_r8,2.8939e+02_r8,3.0276e+02_r8,3.1510e+02_r8,3.2909e+02_r8/) + kbo(:,41,13) = (/ & + &2.6612e+02_r8,2.8502e+02_r8,2.9924e+02_r8,3.1164e+02_r8,3.2628e+02_r8/) + kbo(:,42,13) = (/ & + &2.6020e+02_r8,2.7999e+02_r8,2.9554e+02_r8,3.0769e+02_r8,3.2142e+02_r8/) + kbo(:,43,13) = (/ & + &2.5242e+02_r8,2.7289e+02_r8,2.9079e+02_r8,3.0394e+02_r8,3.1657e+02_r8/) + kbo(:,44,13) = (/ & + &2.4141e+02_r8,2.6492e+02_r8,2.8389e+02_r8,2.9851e+02_r8,3.1003e+02_r8/) + kbo(:,45,13) = (/ & + &2.3199e+02_r8,2.5697e+02_r8,2.7534e+02_r8,2.9238e+02_r8,3.0488e+02_r8/) + kbo(:,46,13) = (/ & + &2.2099e+02_r8,2.4628e+02_r8,2.6862e+02_r8,2.8625e+02_r8,2.9891e+02_r8/) + kbo(:,47,13) = (/ & + &2.0813e+02_r8,2.3515e+02_r8,2.5936e+02_r8,2.7698e+02_r8,2.9245e+02_r8/) + kbo(:,48,13) = (/ & + &1.9611e+02_r8,2.2305e+02_r8,2.4767e+02_r8,2.6948e+02_r8,2.8622e+02_r8/) + kbo(:,49,13) = (/ & + &1.8313e+02_r8,2.1047e+02_r8,2.3654e+02_r8,2.6025e+02_r8,2.7775e+02_r8/) + kbo(:,50,13) = (/ & + &1.6903e+02_r8,1.9938e+02_r8,2.2519e+02_r8,2.4907e+02_r8,2.7015e+02_r8/) + kbo(:,51,13) = (/ & + &1.5421e+02_r8,1.8800e+02_r8,2.1428e+02_r8,2.3876e+02_r8,2.6215e+02_r8/) + kbo(:,52,13) = (/ & + &1.4056e+02_r8,1.7488e+02_r8,2.0358e+02_r8,2.2873e+02_r8,2.5153e+02_r8/) + kbo(:,53,13) = (/ & + &1.2774e+02_r8,1.6089e+02_r8,1.9159e+02_r8,2.1758e+02_r8,2.4063e+02_r8/) + kbo(:,54,13) = (/ & + &1.1505e+02_r8,1.4830e+02_r8,1.8148e+02_r8,2.0706e+02_r8,2.3185e+02_r8/) + kbo(:,55,13) = (/ & + &1.0455e+02_r8,1.3680e+02_r8,1.7009e+02_r8,1.9749e+02_r8,2.2149e+02_r8/) + kbo(:,56,13) = (/ & + &9.5380e+01_r8,1.2458e+02_r8,1.5763e+02_r8,1.8850e+02_r8,2.1165e+02_r8/) + kbo(:,57,13) = (/ & + &8.6328e+01_r8,1.1370e+02_r8,1.4580e+02_r8,1.7843e+02_r8,2.0341e+02_r8/) + kbo(:,58,13) = (/ & + &7.7503e+01_r8,1.0463e+02_r8,1.3405e+02_r8,1.6684e+02_r8,1.9463e+02_r8/) + kbo(:,59,13) = (/ & + &7.3613e+01_r8,1.0087e+02_r8,1.2946e+02_r8,1.6169e+02_r8,1.9043e+02_r8/) + kbo(:,13,14) = (/ & + &2.3384e+02_r8,2.3134e+02_r8,2.2678e+02_r8,2.2105e+02_r8,2.2130e+02_r8/) + kbo(:,14,14) = (/ & + &2.6370e+02_r8,2.6091e+02_r8,2.5467e+02_r8,2.5118e+02_r8,2.4954e+02_r8/) + kbo(:,15,14) = (/ & + &2.9591e+02_r8,2.9159e+02_r8,2.8464e+02_r8,2.8328e+02_r8,2.7984e+02_r8/) + kbo(:,16,14) = (/ & + &3.2944e+02_r8,3.2156e+02_r8,3.1816e+02_r8,3.1521e+02_r8,3.0449e+02_r8/) + kbo(:,17,14) = (/ & + &3.5907e+02_r8,3.5209e+02_r8,3.5084e+02_r8,3.4076e+02_r8,3.2553e+02_r8/) + kbo(:,18,14) = (/ & + &3.8932e+02_r8,3.8700e+02_r8,3.7610e+02_r8,3.6121e+02_r8,3.5570e+02_r8/) + kbo(:,19,14) = (/ & + &4.2093e+02_r8,4.0885e+02_r8,3.9722e+02_r8,3.9095e+02_r8,3.9197e+02_r8/) + kbo(:,20,14) = (/ & + &4.4653e+02_r8,4.3247e+02_r8,4.2391e+02_r8,4.2574e+02_r8,4.2089e+02_r8/) + kbo(:,21,14) = (/ & + &4.6745e+02_r8,4.5974e+02_r8,4.5782e+02_r8,4.5591e+02_r8,4.4616e+02_r8/) + kbo(:,22,14) = (/ & + &4.8396e+02_r8,4.8410e+02_r8,4.8532e+02_r8,4.7987e+02_r8,4.6662e+02_r8/) + kbo(:,23,14) = (/ & + &5.0568e+02_r8,5.0696e+02_r8,5.0168e+02_r8,4.9917e+02_r8,4.8477e+02_r8/) + kbo(:,24,14) = (/ & + &5.2372e+02_r8,5.2925e+02_r8,5.2568e+02_r8,5.1576e+02_r8,5.0916e+02_r8/) + kbo(:,25,14) = (/ & + &5.4773e+02_r8,5.4681e+02_r8,5.4261e+02_r8,5.3467e+02_r8,5.2926e+02_r8/) + kbo(:,26,14) = (/ & + &5.6992e+02_r8,5.6525e+02_r8,5.5986e+02_r8,5.5383e+02_r8,5.4189e+02_r8/) + kbo(:,27,14) = (/ & + &5.8413e+02_r8,5.7753e+02_r8,5.7399e+02_r8,5.6915e+02_r8,5.5630e+02_r8/) + kbo(:,28,14) = (/ & + &5.9410e+02_r8,5.9489e+02_r8,5.8870e+02_r8,5.8276e+02_r8,5.7225e+02_r8/) + kbo(:,29,14) = (/ & + &6.0586e+02_r8,6.0400e+02_r8,6.0319e+02_r8,5.9066e+02_r8,5.8348e+02_r8/) + kbo(:,30,14) = (/ & + &6.2023e+02_r8,6.2112e+02_r8,6.1269e+02_r8,6.0507e+02_r8,5.8831e+02_r8/) + kbo(:,31,14) = (/ & + &6.3249e+02_r8,6.3678e+02_r8,6.2186e+02_r8,6.1145e+02_r8,5.9841e+02_r8/) + kbo(:,32,14) = (/ & + &6.5129e+02_r8,6.4085e+02_r8,6.3065e+02_r8,6.1664e+02_r8,6.0677e+02_r8/) + kbo(:,33,14) = (/ & + &6.5648e+02_r8,6.4719e+02_r8,6.3483e+02_r8,6.2799e+02_r8,6.1689e+02_r8/) + kbo(:,34,14) = (/ & + &6.6261e+02_r8,6.5214e+02_r8,6.4542e+02_r8,6.3852e+02_r8,6.1993e+02_r8/) + kbo(:,35,14) = (/ & + &6.7078e+02_r8,6.6309e+02_r8,6.5953e+02_r8,6.4635e+02_r8,6.1863e+02_r8/) + kbo(:,36,14) = (/ & + &6.8510e+02_r8,6.7944e+02_r8,6.7467e+02_r8,6.5682e+02_r8,6.1696e+02_r8/) + kbo(:,37,14) = (/ & + &6.9465e+02_r8,6.8814e+02_r8,6.8342e+02_r8,6.6410e+02_r8,6.2485e+02_r8/) + kbo(:,38,14) = (/ & + &7.0151e+02_r8,6.9441e+02_r8,6.9017e+02_r8,6.7086e+02_r8,6.3205e+02_r8/) + kbo(:,39,14) = (/ & + &7.0868e+02_r8,7.0183e+02_r8,6.9685e+02_r8,6.7866e+02_r8,6.3921e+02_r8/) + kbo(:,40,14) = (/ & + &7.1075e+02_r8,7.0438e+02_r8,7.0305e+02_r8,6.8866e+02_r8,6.5105e+02_r8/) + kbo(:,41,14) = (/ & + &7.0971e+02_r8,7.0837e+02_r8,7.0822e+02_r8,6.9421e+02_r8,6.5990e+02_r8/) + kbo(:,42,14) = (/ & + &7.1142e+02_r8,7.1113e+02_r8,7.1018e+02_r8,6.9720e+02_r8,6.7342e+02_r8/) + kbo(:,43,14) = (/ & + &7.1363e+02_r8,7.1120e+02_r8,7.0210e+02_r8,7.0055e+02_r8,6.8488e+02_r8/) + kbo(:,44,14) = (/ & + &7.1148e+02_r8,7.0646e+02_r8,7.0565e+02_r8,7.0398e+02_r8,6.8877e+02_r8/) + kbo(:,45,14) = (/ & + &7.0895e+02_r8,7.0958e+02_r8,7.0605e+02_r8,6.9798e+02_r8,6.9240e+02_r8/) + kbo(:,46,14) = (/ & + &6.9950e+02_r8,7.0866e+02_r8,7.0226e+02_r8,6.9819e+02_r8,6.9658e+02_r8/) + kbo(:,47,14) = (/ & + &6.8721e+02_r8,7.0244e+02_r8,7.0188e+02_r8,6.9806e+02_r8,6.9161e+02_r8/) + kbo(:,48,14) = (/ & + &6.8035e+02_r8,6.9565e+02_r8,6.9976e+02_r8,6.9387e+02_r8,6.8913e+02_r8/) + kbo(:,49,14) = (/ & + &6.6852e+02_r8,6.8533e+02_r8,6.9809e+02_r8,6.9470e+02_r8,6.8647e+02_r8/) + kbo(:,50,14) = (/ & + &6.5815e+02_r8,6.7824e+02_r8,6.9156e+02_r8,6.9473e+02_r8,6.8677e+02_r8/) + kbo(:,51,14) = (/ & + &6.5633e+02_r8,6.6741e+02_r8,6.8334e+02_r8,6.9427e+02_r8,6.8718e+02_r8/) + kbo(:,52,14) = (/ & + &6.4799e+02_r8,6.6007e+02_r8,6.7742e+02_r8,6.8641e+02_r8,6.8886e+02_r8/) + kbo(:,53,14) = (/ & + &6.3478e+02_r8,6.5848e+02_r8,6.6595e+02_r8,6.8004e+02_r8,6.8977e+02_r8/) + kbo(:,54,14) = (/ & + &6.3075e+02_r8,6.5140e+02_r8,6.6048e+02_r8,6.7510e+02_r8,6.7898e+02_r8/) + kbo(:,55,14) = (/ & + &6.2053e+02_r8,6.3982e+02_r8,6.5909e+02_r8,6.6252e+02_r8,6.7620e+02_r8/) + kbo(:,56,14) = (/ & + &6.0488e+02_r8,6.3692e+02_r8,6.5472e+02_r8,6.5961e+02_r8,6.7144e+02_r8/) + kbo(:,57,14) = (/ & + &5.9240e+02_r8,6.2947e+02_r8,6.4320e+02_r8,6.5881e+02_r8,6.5824e+02_r8/) + kbo(:,58,14) = (/ & + &5.7619e+02_r8,6.1537e+02_r8,6.4199e+02_r8,6.5527e+02_r8,6.5777e+02_r8/) + kbo(:,59,14) = (/ & + &5.7161e+02_r8,6.1151e+02_r8,6.3977e+02_r8,6.4718e+02_r8,6.5762e+02_r8/) + kbo(:,13,15) = (/ & + &3.5083e+02_r8,3.4274e+02_r8,3.3588e+02_r8,3.2964e+02_r8,3.0980e+02_r8/) + kbo(:,14,15) = (/ & + &4.0382e+02_r8,3.9443e+02_r8,3.8616e+02_r8,3.7379e+02_r8,3.5621e+02_r8/) + kbo(:,15,15) = (/ & + &4.6271e+02_r8,4.5170e+02_r8,4.4204e+02_r8,4.2053e+02_r8,4.0520e+02_r8/) + kbo(:,16,15) = (/ & + &5.2768e+02_r8,5.1495e+02_r8,4.9504e+02_r8,4.7377e+02_r8,4.6833e+02_r8/) + kbo(:,17,15) = (/ & + &5.9879e+02_r8,5.8378e+02_r8,5.5161e+02_r8,5.3753e+02_r8,5.3799e+02_r8/) + kbo(:,18,15) = (/ & + &6.7489e+02_r8,6.3850e+02_r8,6.1688e+02_r8,6.0987e+02_r8,5.7677e+02_r8/) + kbo(:,19,15) = (/ & + &7.3779e+02_r8,7.0513e+02_r8,6.9510e+02_r8,6.5830e+02_r8,6.0487e+02_r8/) + kbo(:,20,15) = (/ & + &8.1079e+02_r8,7.9490e+02_r8,7.5998e+02_r8,6.9897e+02_r8,6.4843e+02_r8/) + kbo(:,21,15) = (/ & + &8.8426e+02_r8,8.6003e+02_r8,8.0304e+02_r8,7.3384e+02_r8,6.9837e+02_r8/) + kbo(:,22,15) = (/ & + &9.6812e+02_r8,9.1088e+02_r8,8.3391e+02_r8,7.8330e+02_r8,7.5669e+02_r8/) + kbo(:,23,15) = (/ & + &1.0128e+03_r8,9.4218e+02_r8,8.8720e+02_r8,8.2530e+02_r8,7.8833e+02_r8/) + kbo(:,24,15) = (/ & + &1.0622e+03_r8,9.7878e+02_r8,9.1791e+02_r8,8.7765e+02_r8,7.9731e+02_r8/) + kbo(:,25,15) = (/ & + &1.0853e+03_r8,1.0245e+03_r8,9.5328e+02_r8,8.9340e+02_r8,8.1721e+02_r8/) + kbo(:,26,15) = (/ & + &1.1200e+03_r8,1.0458e+03_r8,9.9235e+02_r8,9.0775e+02_r8,8.4493e+02_r8/) + kbo(:,27,15) = (/ & + &1.1556e+03_r8,1.0812e+03_r8,1.0090e+03_r8,9.2343e+02_r8,8.1758e+02_r8/) + kbo(:,28,15) = (/ & + &1.1865e+03_r8,1.1049e+03_r8,1.0073e+03_r8,9.1620e+02_r8,7.7173e+02_r8/) + kbo(:,29,15) = (/ & + &1.1906e+03_r8,1.1065e+03_r8,1.0028e+03_r8,8.7527e+02_r8,7.2650e+02_r8/) + kbo(:,30,15) = (/ & + &1.1992e+03_r8,1.0831e+03_r8,9.6830e+02_r8,8.1150e+02_r8,6.8040e+02_r8/) + kbo(:,31,15) = (/ & + &1.1794e+03_r8,1.0618e+03_r8,9.0601e+02_r8,7.5400e+02_r8,6.0274e+02_r8/) + kbo(:,32,15) = (/ & + &1.1491e+03_r8,9.9644e+02_r8,8.3044e+02_r8,6.7287e+02_r8,5.1890e+02_r8/) + kbo(:,33,15) = (/ & + &1.0978e+03_r8,9.1760e+02_r8,7.5228e+02_r8,5.8187e+02_r8,4.2649e+02_r8/) + kbo(:,34,15) = (/ & + &1.0237e+03_r8,8.4870e+02_r8,6.6311e+02_r8,4.9111e+02_r8,3.3958e+02_r8/) + kbo(:,35,15) = (/ & + &9.6010e+02_r8,7.7009e+02_r8,5.7949e+02_r8,4.1414e+02_r8,2.7668e+02_r8/) + kbo(:,36,15) = (/ & + &9.0171e+02_r8,7.0086e+02_r8,5.0886e+02_r8,3.3823e+02_r8,2.2240e+02_r8/) + kbo(:,37,15) = (/ & + &9.0464e+02_r8,7.0259e+02_r8,5.0334e+02_r8,3.3120e+02_r8,2.1250e+02_r8/) + kbo(:,38,15) = (/ & + &9.1272e+02_r8,7.0777e+02_r8,5.0236e+02_r8,3.2627e+02_r8,2.0281e+02_r8/) + kbo(:,39,15) = (/ & + &9.1592e+02_r8,7.0699e+02_r8,5.0029e+02_r8,3.1832e+02_r8,1.8984e+02_r8/) + kbo(:,40,15) = (/ & + &9.7111e+02_r8,7.5888e+02_r8,5.4218e+02_r8,3.5289e+02_r8,2.1710e+02_r8/) + kbo(:,41,15) = (/ & + &1.0392e+03_r8,8.1334e+02_r8,5.9329e+02_r8,4.0507e+02_r8,2.5679e+02_r8/) + kbo(:,42,15) = (/ & + &1.1018e+03_r8,8.7332e+02_r8,6.5360e+02_r8,4.6461e+02_r8,2.9410e+02_r8/) + kbo(:,43,15) = (/ & + &1.1780e+03_r8,9.5750e+02_r8,7.5295e+02_r8,5.3640e+02_r8,3.4968e+02_r8/) + kbo(:,44,15) = (/ & + &1.2774e+03_r8,1.0610e+03_r8,8.3382e+02_r8,6.1903e+02_r8,4.3881e+02_r8/) + kbo(:,45,15) = (/ & + &1.3696e+03_r8,1.1411e+03_r8,9.2825e+02_r8,7.2390e+02_r8,5.2087e+02_r8/) + kbo(:,46,15) = (/ & + &1.4458e+03_r8,1.2392e+03_r8,1.0284e+03_r8,8.1462e+02_r8,6.0446e+02_r8/) + kbo(:,47,15) = (/ & + &1.5185e+03_r8,1.3558e+03_r8,1.1323e+03_r8,9.2353e+02_r8,7.1923e+02_r8/) + kbo(:,48,15) = (/ & + &1.5480e+03_r8,1.4278e+03_r8,1.2433e+03_r8,1.0338e+03_r8,8.2416e+02_r8/) + kbo(:,49,15) = (/ & + &1.6321e+03_r8,1.4959e+03_r8,1.3391e+03_r8,1.1340e+03_r8,9.3754e+02_r8/) + kbo(:,50,15) = (/ & + &1.7049e+03_r8,1.5268e+03_r8,1.4037e+03_r8,1.2337e+03_r8,1.0324e+03_r8/) + kbo(:,51,15) = (/ & + &1.7473e+03_r8,1.6024e+03_r8,1.4662e+03_r8,1.3130e+03_r8,1.1235e+03_r8/) + kbo(:,52,15) = (/ & + &1.7742e+03_r8,1.6697e+03_r8,1.4942e+03_r8,1.3753e+03_r8,1.2160e+03_r8/) + kbo(:,53,15) = (/ & + &1.8257e+03_r8,1.7098e+03_r8,1.5772e+03_r8,1.4297e+03_r8,1.2866e+03_r8/) + kbo(:,54,15) = (/ & + &1.8238e+03_r8,1.7301e+03_r8,1.6290e+03_r8,1.4640e+03_r8,1.3508e+03_r8/) + kbo(:,55,15) = (/ & + &1.8598e+03_r8,1.7789e+03_r8,1.6666e+03_r8,1.5389e+03_r8,1.3930e+03_r8/) + kbo(:,56,15) = (/ & + &1.9305e+03_r8,1.7834e+03_r8,1.6800e+03_r8,1.5831e+03_r8,1.4252e+03_r8/) + kbo(:,57,15) = (/ & + &1.9902e+03_r8,1.8099e+03_r8,1.7296e+03_r8,1.6197e+03_r8,1.4994e+03_r8/) + kbo(:,58,15) = (/ & + &2.0569e+03_r8,1.8785e+03_r8,1.7252e+03_r8,1.6299e+03_r8,1.5366e+03_r8/) + kbo(:,59,15) = (/ & + &2.0792e+03_r8,1.9024e+03_r8,1.7290e+03_r8,1.6559e+03_r8,1.5493e+03_r8/) + kbo(:,13,16) = (/ & + &5.7074e+02_r8,5.5713e+02_r8,5.4253e+02_r8,5.2721e+02_r8,5.1131e+02_r8/) + kbo(:,14,16) = (/ & + &6.6774e+02_r8,6.5027e+02_r8,6.3161e+02_r8,6.1261e+02_r8,5.9377e+02_r8/) + kbo(:,15,16) = (/ & + &7.7763e+02_r8,7.5535e+02_r8,7.3247e+02_r8,7.0914e+02_r8,6.8554e+02_r8/) + kbo(:,16,16) = (/ & + &9.0056e+02_r8,8.7306e+02_r8,8.4456e+02_r8,8.1516e+02_r8,7.0895e+02_r8/) + kbo(:,17,16) = (/ & + &1.0366e+03_r8,1.0015e+03_r8,9.6519e+02_r8,8.8128e+02_r8,7.1380e+02_r8/) + kbo(:,18,16) = (/ & + &1.1817e+03_r8,1.1369e+03_r8,1.0597e+03_r8,8.5644e+02_r8,7.3707e+02_r8/) + kbo(:,19,16) = (/ & + &1.3316e+03_r8,1.2750e+03_r8,1.0321e+03_r8,8.8674e+02_r8,7.7129e+02_r8/) + kbo(:,20,16) = (/ & + &1.4803e+03_r8,1.2710e+03_r8,1.0855e+03_r8,9.4408e+02_r8,7.2356e+02_r8/) + kbo(:,21,16) = (/ & + &1.6247e+03_r8,1.3272e+03_r8,1.1530e+03_r8,9.8338e+02_r8,6.9198e+02_r8/) + kbo(:,22,16) = (/ & + &1.6008e+03_r8,1.3778e+03_r8,1.2081e+03_r8,9.0370e+02_r8,5.5641e+02_r8/) + kbo(:,23,16) = (/ & + &1.6342e+03_r8,1.4243e+03_r8,1.1304e+03_r8,8.5528e+02_r8,4.9240e+02_r8/) + kbo(:,24,16) = (/ & + &1.6690e+03_r8,1.4128e+03_r8,1.0773e+03_r8,6.8055e+02_r8,4.3204e+02_r8/) + kbo(:,25,16) = (/ & + &1.6932e+03_r8,1.3171e+03_r8,9.9569e+02_r8,5.6924e+02_r8,2.7405e+02_r8/) + kbo(:,26,16) = (/ & + &1.5997e+03_r8,1.2565e+03_r8,7.2147e+02_r8,4.1508e+02_r8,1.6363e+00_r8/) + kbo(:,27,16) = (/ & + &1.4709e+03_r8,1.0620e+03_r8,5.5367e+02_r8,1.6801e+02_r8,1.7711e+00_r8/) + kbo(:,28,16) = (/ & + &1.2868e+03_r8,7.4225e+02_r8,4.1091e+02_r8,1.3979e+00_r8,1.9138e+00_r8/) + kbo(:,29,16) = (/ & + &1.1046e+03_r8,5.7327e+02_r8,1.1435e+02_r8,1.5227e+00_r8,2.0690e+00_r8/) + kbo(:,30,16) = (/ & + &7.5951e+02_r8,3.1070e+02_r8,1.1800e+00_r8,1.6572e+00_r8,2.2234e+00_r8/) + kbo(:,31,16) = (/ & + &5.2269e+02_r8,8.9357e-01_r8,1.2993e+00_r8,1.7936e+00_r8,2.3615e+00_r8/) + kbo(:,32,16) = (/ & + &1.3504e+02_r8,9.8754e-01_r8,1.4263e+00_r8,1.9479e+00_r8,2.5792e+00_r8/) + kbo(:,33,16) = (/ & + &7.3408e-01_r8,1.0937e+00_r8,1.5601e+00_r8,2.1018e+00_r8,2.7689e+00_r8/) + kbo(:,34,16) = (/ & + &8.0973e-01_r8,1.1916e+00_r8,1.6719e+00_r8,2.2462e+00_r8,2.9376e+00_r8/) + kbo(:,35,16) = (/ & + &8.5624e-01_r8,1.2515e+00_r8,1.7457e+00_r8,2.3340e+00_r8,3.0393e+00_r8/) + kbo(:,36,16) = (/ & + &8.6582e-01_r8,1.2640e+00_r8,1.7620e+00_r8,2.3537e+00_r8,3.0624e+00_r8/) + kbo(:,37,16) = (/ & + &8.2392e-01_r8,1.2109e+00_r8,1.6970e+00_r8,2.2619e+00_r8,2.9651e+00_r8/) + kbo(:,38,16) = (/ & + &7.7820e-01_r8,1.1515e+00_r8,1.6284e+00_r8,2.1818e+00_r8,2.8537e+00_r8/) + kbo(:,39,16) = (/ & + &7.3137e-01_r8,1.0905e+00_r8,1.5568e+00_r8,2.1026e+00_r8,2.7617e+00_r8/) + kbo(:,40,16) = (/ & + &6.6113e-01_r8,9.9827e-01_r8,1.4324e+00_r8,1.9599e+00_r8,2.5782e+00_r8/) + kbo(:,41,16) = (/ & + &5.8979e-01_r8,9.0432e-01_r8,1.3165e+00_r8,1.8211e+00_r8,2.4166e+00_r8/) + kbo(:,42,16) = (/ & + &5.2189e-01_r8,8.1262e-01_r8,1.2033e+00_r8,1.6872e+00_r8,2.2584e+00_r8/) + kbo(:,43,16) = (/ & + &4.5012e-01_r8,7.1522e-01_r8,1.0693e+00_r8,1.5212e+00_r8,2.0670e+00_r8/) + kbo(:,44,16) = (/ & + &3.7946e-01_r8,6.1667e-01_r8,9.4312e-01_r8,1.3624e+00_r8,1.8770e+00_r8/) + kbo(:,45,16) = (/ & + &3.1558e-01_r8,5.2623e-01_r8,8.0787e-01_r8,1.2032e+00_r8,1.6863e+00_r8/) + kbo(:,46,16) = (/ & + &2.9590e+02_r8,4.4343e-01_r8,7.0619e-01_r8,1.0578e+00_r8,1.5068e+00_r8/) + kbo(:,47,16) = (/ & + &7.2659e+02_r8,3.5873e-01_r8,5.9101e-01_r8,9.0599e-01_r8,1.3156e+00_r8/) + kbo(:,48,16) = (/ & + &1.3181e+03_r8,3.4672e+02_r8,4.8767e-01_r8,7.6683e-01_r8,1.1370e+00_r8/) + kbo(:,49,16) = (/ & + &1.6047e+03_r8,7.6641e+02_r8,7.0071e+01_r8,6.4471e-01_r8,9.8037e-01_r8/) + kbo(:,50,16) = (/ & + &1.8848e+03_r8,1.3103e+03_r8,4.1613e+02_r8,5.4100e-01_r8,8.3899e-01_r8/) + kbo(:,51,16) = (/ & + &2.2044e+03_r8,1.5848e+03_r8,7.6808e+02_r8,1.1316e+02_r8,7.2276e-01_r8/) + kbo(:,52,16) = (/ & + &2.7162e+03_r8,1.8452e+03_r8,1.2957e+03_r8,4.5829e+02_r8,6.1559e-01_r8/) + kbo(:,53,16) = (/ & + &3.1107e+03_r8,2.1559e+03_r8,1.5529e+03_r8,8.4689e+02_r8,1.7464e+02_r8/) + kbo(:,54,16) = (/ & + &3.6955e+03_r8,2.6522e+03_r8,1.8196e+03_r8,1.2866e+03_r8,5.0615e+02_r8/) + kbo(:,55,16) = (/ & + &4.0343e+03_r8,2.9873e+03_r8,2.0751e+03_r8,1.5293e+03_r8,8.5669e+02_r8/) + kbo(:,56,16) = (/ & + &4.1921e+03_r8,3.4914e+03_r8,2.5653e+03_r8,1.7745e+03_r8,1.2881e+03_r8/) + kbo(:,57,16) = (/ & + &4.3609e+03_r8,3.8712e+03_r8,2.9041e+03_r8,2.0379e+03_r8,1.5211e+03_r8/) + kbo(:,58,16) = (/ & + &4.5313e+03_r8,4.0098e+03_r8,3.4243e+03_r8,2.5213e+03_r8,1.7627e+03_r8/) + kbo(:,59,16) = (/ & + &4.6034e+03_r8,4.0679e+03_r8,3.6299e+03_r8,2.7016e+03_r8,1.9029e+03_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mn2o( 1, :, 1) = (/ & + & 5.41078e-02_r8, 5.59051e-02_r8, 5.77620e-02_r8, 5.96805e-02_r8, 6.16628e-02_r8, & + & 6.37110e-02_r8, 6.58272e-02_r8, 6.80137e-02_r8, 7.02728e-02_r8, 7.26069e-02_r8, & + & 7.50185e-02_r8, 7.75103e-02_r8, 8.00848e-02_r8, 8.27449e-02_r8, 8.54933e-02_r8, & + & 8.83330e-02_r8, 9.12670e-02_r8, 9.42984e-02_r8, 9.74306e-02_r8/) + kao_mn2o( 2, :, 1) = (/ & + & 1.19602e-01_r8, 1.22963e-01_r8, 1.26417e-01_r8, 1.29969e-01_r8, 1.33621e-01_r8, & + & 1.37375e-01_r8, 1.41235e-01_r8, 1.45203e-01_r8, 1.49283e-01_r8, 1.53477e-01_r8, & + & 1.57789e-01_r8, 1.62223e-01_r8, 1.66780e-01_r8, 1.71466e-01_r8, 1.76284e-01_r8, & + & 1.81237e-01_r8, 1.86329e-01_r8, 1.91564e-01_r8, 1.96946e-01_r8/) + kao_mn2o( 3, :, 1) = (/ & + & 1.49614e-01_r8, 1.53427e-01_r8, 1.57337e-01_r8, 1.61346e-01_r8, 1.65457e-01_r8, & + & 1.69674e-01_r8, 1.73997e-01_r8, 1.78431e-01_r8, 1.82978e-01_r8, 1.87641e-01_r8, & + & 1.92422e-01_r8, 1.97325e-01_r8, 2.02354e-01_r8, 2.07510e-01_r8, 2.12798e-01_r8, & + & 2.18221e-01_r8, 2.23781e-01_r8, 2.29484e-01_r8, 2.35331e-01_r8/) + kao_mn2o( 4, :, 1) = (/ & + & 1.80029e-01_r8, 1.84202e-01_r8, 1.88472e-01_r8, 1.92841e-01_r8, 1.97311e-01_r8, & + & 2.01884e-01_r8, 2.06564e-01_r8, 2.11352e-01_r8, 2.16252e-01_r8, 2.21264e-01_r8, & + & 2.26393e-01_r8, 2.31641e-01_r8, 2.37010e-01_r8, 2.42504e-01_r8, 2.48126e-01_r8, & + & 2.53877e-01_r8, 2.59762e-01_r8, 2.65783e-01_r8, 2.71944e-01_r8/) + kao_mn2o( 5, :, 1) = (/ & + & 2.08279e-01_r8, 2.13029e-01_r8, 2.17888e-01_r8, 2.22858e-01_r8, 2.27941e-01_r8, & + & 2.33140e-01_r8, 2.38458e-01_r8, 2.43897e-01_r8, 2.49460e-01_r8, 2.55150e-01_r8, & + & 2.60969e-01_r8, 2.66922e-01_r8, 2.73010e-01_r8, 2.79237e-01_r8, 2.85606e-01_r8, & + & 2.92120e-01_r8, 2.98783e-01_r8, 3.05598e-01_r8, 3.12568e-01_r8/) + kao_mn2o( 6, :, 1) = (/ & + & 2.17336e-01_r8, 2.22571e-01_r8, 2.27931e-01_r8, 2.33421e-01_r8, 2.39043e-01_r8, & + & 2.44801e-01_r8, 2.50697e-01_r8, 2.56735e-01_r8, 2.62918e-01_r8, 2.69251e-01_r8, & + & 2.75735e-01_r8, 2.82377e-01_r8, 2.89178e-01_r8, 2.96142e-01_r8, 3.03275e-01_r8, & + & 3.10579e-01_r8, 3.18060e-01_r8, 3.25720e-01_r8, 3.33565e-01_r8/) + kao_mn2o( 7, :, 1) = (/ & + & 2.23903e-01_r8, 2.29349e-01_r8, 2.34926e-01_r8, 2.40640e-01_r8, 2.46493e-01_r8, & + & 2.52488e-01_r8, 2.58628e-01_r8, 2.64918e-01_r8, 2.71361e-01_r8, 2.77961e-01_r8, & + & 2.84721e-01_r8, 2.91646e-01_r8, 2.98739e-01_r8, 3.06005e-01_r8, 3.13447e-01_r8, & + & 3.21070e-01_r8, 3.28879e-01_r8, 3.36877e-01_r8, 3.45071e-01_r8/) + kao_mn2o( 8, :, 1) = (/ & + & 2.23400e-01_r8, 2.28843e-01_r8, 2.34418e-01_r8, 2.40130e-01_r8, 2.45980e-01_r8, & + & 2.51973e-01_r8, 2.58112e-01_r8, 2.64401e-01_r8, 2.70843e-01_r8, 2.77442e-01_r8, & + & 2.84202e-01_r8, 2.91126e-01_r8, 2.98219e-01_r8, 3.05485e-01_r8, 3.12928e-01_r8, & + & 3.20552e-01_r8, 3.28362e-01_r8, 3.36362e-01_r8, 3.44557e-01_r8/) + kao_mn2o( 9, :, 1) = (/ & + & 1.89279e-01_r8, 1.94423e-01_r8, 1.99707e-01_r8, 2.05135e-01_r8, 2.10710e-01_r8, & + & 2.16437e-01_r8, 2.22319e-01_r8, 2.28361e-01_r8, 2.34568e-01_r8, 2.40943e-01_r8, & + & 2.47492e-01_r8, 2.54218e-01_r8, 2.61127e-01_r8, 2.68224e-01_r8, 2.75514e-01_r8, & + & 2.83002e-01_r8, 2.90694e-01_r8, 2.98594e-01_r8, 3.06709e-01_r8/) + kao_mn2o( 1, :, 2) = (/ & + & 9.46669e-02_r8, 9.77137e-02_r8, 1.00858e-01_r8, 1.04104e-01_r8, 1.07455e-01_r8, & + & 1.10913e-01_r8, 1.14483e-01_r8, 1.18167e-01_r8, 1.21971e-01_r8, 1.25896e-01_r8, & + & 1.29948e-01_r8, 1.34130e-01_r8, 1.38447e-01_r8, 1.42903e-01_r8, 1.47502e-01_r8, & + & 1.52249e-01_r8, 1.57149e-01_r8, 1.62207e-01_r8, 1.67427e-01_r8/) + kao_mn2o( 2, :, 2) = (/ & + & 5.11901e-01_r8, 5.24950e-01_r8, 5.38331e-01_r8, 5.52053e-01_r8, 5.66125e-01_r8, & + & 5.80556e-01_r8, 5.95354e-01_r8, 6.10530e-01_r8, 6.26093e-01_r8, 6.42052e-01_r8, & + & 6.58418e-01_r8, 6.75202e-01_r8, 6.92413e-01_r8, 7.10062e-01_r8, 7.28162e-01_r8, & + & 7.46723e-01_r8, 7.65758e-01_r8, 7.85277e-01_r8, 8.05294e-01_r8/) + kao_mn2o( 3, :, 2) = (/ & + & 8.32946e-01_r8, 8.45780e-01_r8, 8.58813e-01_r8, 8.72046e-01_r8, 8.85482e-01_r8, & + & 8.99126e-01_r8, 9.12980e-01_r8, 9.27048e-01_r8, 9.41332e-01_r8, 9.55837e-01_r8, & + & 9.70565e-01_r8, 9.85520e-01_r8, 1.00070e+00_r8, 1.01612e+00_r8, 1.03178e+00_r8, & + & 1.04768e+00_r8, 1.06382e+00_r8, 1.08021e+00_r8, 1.09686e+00_r8/) + kao_mn2o( 4, :, 2) = (/ & + & 1.04032e+00_r8, 1.05475e+00_r8, 1.06937e+00_r8, 1.08419e+00_r8, 1.09922e+00_r8, & + & 1.11446e+00_r8, 1.12991e+00_r8, 1.14557e+00_r8, 1.16145e+00_r8, 1.17755e+00_r8, & + & 1.19387e+00_r8, 1.21042e+00_r8, 1.22720e+00_r8, 1.24421e+00_r8, 1.26146e+00_r8, & + & 1.27895e+00_r8, 1.29668e+00_r8, 1.31465e+00_r8, 1.33287e+00_r8/) + kao_mn2o( 5, :, 2) = (/ & + & 1.22685e+00_r8, 1.24267e+00_r8, 1.25870e+00_r8, 1.27493e+00_r8, 1.29137e+00_r8, & + & 1.30803e+00_r8, 1.32490e+00_r8, 1.34199e+00_r8, 1.35930e+00_r8, 1.37683e+00_r8, & + & 1.39459e+00_r8, 1.41257e+00_r8, 1.43079e+00_r8, 1.44925e+00_r8, 1.46794e+00_r8, & + & 1.48687e+00_r8, 1.50605e+00_r8, 1.52547e+00_r8, 1.54515e+00_r8/) + kao_mn2o( 6, :, 2) = (/ & + & 1.53781e+00_r8, 1.55206e+00_r8, 1.56645e+00_r8, 1.58097e+00_r8, 1.59563e+00_r8, & + & 1.61042e+00_r8, 1.62535e+00_r8, 1.64042e+00_r8, 1.65562e+00_r8, 1.67097e+00_r8, & + & 1.68646e+00_r8, 1.70210e+00_r8, 1.71788e+00_r8, 1.73380e+00_r8, 1.74987e+00_r8, & + & 1.76610e+00_r8, 1.78247e+00_r8, 1.79899e+00_r8, 1.81567e+00_r8/) + kao_mn2o( 7, :, 2) = (/ & + & 1.90476e+00_r8, 1.91858e+00_r8, 1.93251e+00_r8, 1.94653e+00_r8, 1.96065e+00_r8, & + & 1.97488e+00_r8, 1.98921e+00_r8, 2.00365e+00_r8, 2.01819e+00_r8, 2.03283e+00_r8, & + & 2.04758e+00_r8, 2.06244e+00_r8, 2.07741e+00_r8, 2.09248e+00_r8, 2.10767e+00_r8, & + & 2.12296e+00_r8, 2.13837e+00_r8, 2.15388e+00_r8, 2.16951e+00_r8/) + kao_mn2o( 8, :, 2) = (/ & + & 2.38211e+00_r8, 2.39819e+00_r8, 2.41438e+00_r8, 2.43068e+00_r8, 2.44709e+00_r8, & + & 2.46361e+00_r8, 2.48024e+00_r8, 2.49699e+00_r8, 2.51384e+00_r8, 2.53082e+00_r8, & + & 2.54790e+00_r8, 2.56510e+00_r8, 2.58242e+00_r8, 2.59985e+00_r8, 2.61741e+00_r8, & + & 2.63508e+00_r8, 2.65287e+00_r8, 2.67078e+00_r8, 2.68881e+00_r8/) + kao_mn2o( 9, :, 2) = (/ & + & 1.26464e+00_r8, 1.28107e+00_r8, 1.29772e+00_r8, 1.31458e+00_r8, 1.33166e+00_r8, & + & 1.34896e+00_r8, 1.36649e+00_r8, 1.38424e+00_r8, 1.40223e+00_r8, 1.42044e+00_r8, & + & 1.43890e+00_r8, 1.45759e+00_r8, 1.47653e+00_r8, 1.49572e+00_r8, 1.51515e+00_r8, & + & 1.53483e+00_r8, 1.55478e+00_r8, 1.57498e+00_r8, 1.59544e+00_r8/) + kao_mn2o( 1, :, 3) = (/ & + & 1.50082e-01_r8, 1.59095e-01_r8, 1.68650e-01_r8, 1.78779e-01_r8, 1.89516e-01_r8, & + & 2.00898e-01_r8, 2.12963e-01_r8, 2.25753e-01_r8, 2.39311e-01_r8, 2.53683e-01_r8, & + & 2.68919e-01_r8, 2.85069e-01_r8, 3.02190e-01_r8, 3.20339e-01_r8, 3.39577e-01_r8, & + & 3.59971e-01_r8, 3.81590e-01_r8, 4.04507e-01_r8, 4.28801e-01_r8/) + kao_mn2o( 2, :, 3) = (/ & + & 3.09551e+00_r8, 3.09780e+00_r8, 3.10008e+00_r8, 3.10237e+00_r8, 3.10466e+00_r8, & + & 3.10695e+00_r8, 3.10925e+00_r8, 3.11154e+00_r8, 3.11384e+00_r8, 3.11614e+00_r8, & + & 3.11844e+00_r8, 3.12074e+00_r8, 3.12305e+00_r8, 3.12535e+00_r8, 3.12766e+00_r8, & + & 3.12997e+00_r8, 3.13228e+00_r8, 3.13459e+00_r8, 3.13691e+00_r8/) + kao_mn2o( 3, :, 3) = (/ & + & 4.42661e+00_r8, 4.40858e+00_r8, 4.39062e+00_r8, 4.37274e+00_r8, 4.35493e+00_r8, & + & 4.33719e+00_r8, 4.31953e+00_r8, 4.30193e+00_r8, 4.28441e+00_r8, 4.26696e+00_r8, & + & 4.24958e+00_r8, 4.23227e+00_r8, 4.21503e+00_r8, 4.19787e+00_r8, 4.18077e+00_r8, & + & 4.16374e+00_r8, 4.14678e+00_r8, 4.12989e+00_r8, 4.11307e+00_r8/) + kao_mn2o( 4, :, 3) = (/ & + & 5.77864e+00_r8, 5.74085e+00_r8, 5.70331e+00_r8, 5.66602e+00_r8, 5.62897e+00_r8, & + & 5.59216e+00_r8, 5.55559e+00_r8, 5.51926e+00_r8, 5.48317e+00_r8, 5.44731e+00_r8, & + & 5.41169e+00_r8, 5.37631e+00_r8, 5.34115e+00_r8, 5.30622e+00_r8, 5.27152e+00_r8, & + & 5.23705e+00_r8, 5.20281e+00_r8, 5.16879e+00_r8, 5.13499e+00_r8/) + kao_mn2o( 5, :, 3) = (/ & + & 7.17294e+00_r8, 7.10890e+00_r8, 7.04542e+00_r8, 6.98251e+00_r8, 6.92017e+00_r8, & + & 6.85838e+00_r8, 6.79714e+00_r8, 6.73645e+00_r8, 6.67630e+00_r8, 6.61669e+00_r8, & + & 6.55761e+00_r8, 6.49905e+00_r8, 6.44102e+00_r8, 6.38351e+00_r8, 6.32651e+00_r8, & + & 6.27003e+00_r8, 6.21404e+00_r8, 6.15856e+00_r8, 6.10357e+00_r8/) + kao_mn2o( 6, :, 3) = (/ & + & 9.05082e+00_r8, 8.96132e+00_r8, 8.87271e+00_r8, 8.78498e+00_r8, 8.69811e+00_r8, & + & 8.61210e+00_r8, 8.52694e+00_r8, 8.44262e+00_r8, 8.35914e+00_r8, 8.27648e+00_r8, & + & 8.19464e+00_r8, 8.11361e+00_r8, 8.03338e+00_r8, 7.95394e+00_r8, 7.87529e+00_r8, & + & 7.79742e+00_r8, 7.72032e+00_r8, 7.64398e+00_r8, 7.56839e+00_r8/) + kao_mn2o( 7, :, 3) = (/ & + & 1.18749e+01_r8, 1.17648e+01_r8, 1.16556e+01_r8, 1.15475e+01_r8, 1.14403e+01_r8, & + & 1.13342e+01_r8, 1.12290e+01_r8, 1.11248e+01_r8, 1.10216e+01_r8, 1.09194e+01_r8, & + & 1.08180e+01_r8, 1.07177e+01_r8, 1.06182e+01_r8, 1.05197e+01_r8, 1.04221e+01_r8, & + & 1.03254e+01_r8, 1.02296e+01_r8, 1.01347e+01_r8, 1.00407e+01_r8/) + kao_mn2o( 8, :, 3) = (/ & + & 1.41428e+01_r8, 1.40323e+01_r8, 1.39227e+01_r8, 1.38139e+01_r8, 1.37060e+01_r8, & + & 1.35989e+01_r8, 1.34927e+01_r8, 1.33873e+01_r8, 1.32827e+01_r8, 1.31790e+01_r8, & + & 1.30760e+01_r8, 1.29738e+01_r8, 1.28725e+01_r8, 1.27719e+01_r8, 1.26722e+01_r8, & + & 1.25732e+01_r8, 1.24750e+01_r8, 1.23775e+01_r8, 1.22808e+01_r8/) + kao_mn2o( 9, :, 3) = (/ & + & 7.34993e+00_r8, 7.29335e+00_r8, 7.23720e+00_r8, 7.18149e+00_r8, 7.12620e+00_r8, & + & 7.07134e+00_r8, 7.01690e+00_r8, 6.96288e+00_r8, 6.90928e+00_r8, 6.85609e+00_r8, & + & 6.80331e+00_r8, 6.75094e+00_r8, 6.69897e+00_r8, 6.64739e+00_r8, 6.59622e+00_r8, & + & 6.54544e+00_r8, 6.49505e+00_r8, 6.44505e+00_r8, 6.39543e+00_r8/) + kao_mn2o( 1, :, 4) = (/ & + & 6.11248e-01_r8, 6.37225e-01_r8, 6.64306e-01_r8, 6.92538e-01_r8, 7.21970e-01_r8, & + & 7.52653e-01_r8, 7.84639e-01_r8, 8.17985e-01_r8, 8.52749e-01_r8, 8.88989e-01_r8, & + & 9.26770e-01_r8, 9.66157e-01_r8, 1.00722e+00_r8, 1.05002e+00_r8, 1.09465e+00_r8, & + & 1.14117e+00_r8, 1.18967e+00_r8, 1.24022e+00_r8, 1.29293e+00_r8/) + kao_mn2o( 2, :, 4) = (/ & + & 5.07253e+00_r8, 5.05299e+00_r8, 5.03353e+00_r8, 5.01414e+00_r8, 4.99483e+00_r8, & + & 4.97559e+00_r8, 4.95642e+00_r8, 4.93733e+00_r8, 4.91831e+00_r8, 4.89937e+00_r8, & + & 4.88050e+00_r8, 4.86170e+00_r8, 4.84297e+00_r8, 4.82432e+00_r8, 4.80573e+00_r8, & + & 4.78722e+00_r8, 4.76878e+00_r8, 4.75042e+00_r8, 4.73212e+00_r8/) + kao_mn2o( 3, :, 4) = (/ & + & 7.45829e+00_r8, 7.42266e+00_r8, 7.38719e+00_r8, 7.35190e+00_r8, 7.31677e+00_r8, & + & 7.28181e+00_r8, 7.24702e+00_r8, 7.21240e+00_r8, 7.17794e+00_r8, 7.14364e+00_r8, & + & 7.10951e+00_r8, 7.07554e+00_r8, 7.04173e+00_r8, 7.00809e+00_r8, 6.97461e+00_r8, & + & 6.94128e+00_r8, 6.90812e+00_r8, 6.87511e+00_r8, 6.84226e+00_r8/) + kao_mn2o( 4, :, 4) = (/ & + & 9.58893e+00_r8, 9.54796e+00_r8, 9.50716e+00_r8, 9.46654e+00_r8, 9.42609e+00_r8, & + & 9.38581e+00_r8, 9.34571e+00_r8, 9.30578e+00_r8, 9.26602e+00_r8, 9.22642e+00_r8, & + & 9.18700e+00_r8, 9.14775e+00_r8, 9.10866e+00_r8, 9.06974e+00_r8, 9.03099e+00_r8, & + & 8.99240e+00_r8, 8.95398e+00_r8, 8.91572e+00_r8, 8.87762e+00_r8/) + kao_mn2o( 5, :, 4) = (/ & + & 1.16344e+01_r8, 1.16012e+01_r8, 1.15681e+01_r8, 1.15351e+01_r8, 1.15022e+01_r8, & + & 1.14694e+01_r8, 1.14366e+01_r8, 1.14040e+01_r8, 1.13715e+01_r8, 1.13390e+01_r8, & + & 1.13067e+01_r8, 1.12744e+01_r8, 1.12422e+01_r8, 1.12102e+01_r8, 1.11782e+01_r8, & + & 1.11463e+01_r8, 1.11145e+01_r8, 1.10828e+01_r8, 1.10511e+01_r8/) + kao_mn2o( 6, :, 4) = (/ & + & 1.12460e+01_r8, 1.12402e+01_r8, 1.12344e+01_r8, 1.12286e+01_r8, 1.12228e+01_r8, & + & 1.12170e+01_r8, 1.12112e+01_r8, 1.12055e+01_r8, 1.11997e+01_r8, 1.11939e+01_r8, & + & 1.11882e+01_r8, 1.11824e+01_r8, 1.11766e+01_r8, 1.11709e+01_r8, 1.11651e+01_r8, & + & 1.11594e+01_r8, 1.11536e+01_r8, 1.11479e+01_r8, 1.11421e+01_r8/) + kao_mn2o( 7, :, 4) = (/ & + & 8.89265e+00_r8, 8.91419e+00_r8, 8.93578e+00_r8, 8.95743e+00_r8, 8.97913e+00_r8, & + & 9.00088e+00_r8, 9.02268e+00_r8, 9.04454e+00_r8, 9.06645e+00_r8, 9.08841e+00_r8, & + & 9.11043e+00_r8, 9.13250e+00_r8, 9.15462e+00_r8, 9.17680e+00_r8, 9.19903e+00_r8, & + & 9.22131e+00_r8, 9.24365e+00_r8, 9.26604e+00_r8, 9.28849e+00_r8/) + kao_mn2o( 8, :, 4) = (/ & + & 6.83933e+00_r8, 6.86688e+00_r8, 6.89453e+00_r8, 6.92230e+00_r8, 6.95018e+00_r8, & + & 6.97817e+00_r8, 7.00627e+00_r8, 7.03449e+00_r8, 7.06282e+00_r8, 7.09126e+00_r8, & + & 7.11982e+00_r8, 7.14850e+00_r8, 7.17729e+00_r8, 7.20619e+00_r8, 7.23521e+00_r8, & + & 7.26435e+00_r8, 7.29361e+00_r8, 7.32298e+00_r8, 7.35248e+00_r8/) + kao_mn2o( 9, :, 4) = (/ & + & 1.10637e+01_r8, 1.10232e+01_r8, 1.09829e+01_r8, 1.09427e+01_r8, 1.09026e+01_r8, & + & 1.08627e+01_r8, 1.08230e+01_r8, 1.07833e+01_r8, 1.07439e+01_r8, 1.07046e+01_r8, & + & 1.06654e+01_r8, 1.06263e+01_r8, 1.05875e+01_r8, 1.05487e+01_r8, 1.05101e+01_r8, & + & 1.04716e+01_r8, 1.04333e+01_r8, 1.03951e+01_r8, 1.03571e+01_r8/) + kao_mn2o( 1, :, 5) = (/ & + & 2.53460e+00_r8, 2.56050e+00_r8, 2.58667e+00_r8, 2.61310e+00_r8, 2.63980e+00_r8, & + & 2.66678e+00_r8, 2.69403e+00_r8, 2.72156e+00_r8, 2.74937e+00_r8, 2.77746e+00_r8, & + & 2.80585e+00_r8, 2.83452e+00_r8, 2.86348e+00_r8, 2.89275e+00_r8, 2.92231e+00_r8, & + & 2.95217e+00_r8, 2.98234e+00_r8, 3.01281e+00_r8, 3.04360e+00_r8/) + kao_mn2o( 2, :, 5) = (/ & + & 7.45650e+00_r8, 7.44283e+00_r8, 7.42919e+00_r8, 7.41557e+00_r8, 7.40198e+00_r8, & + & 7.38841e+00_r8, 7.37487e+00_r8, 7.36135e+00_r8, 7.34786e+00_r8, 7.33439e+00_r8, & + & 7.32095e+00_r8, 7.30753e+00_r8, 7.29413e+00_r8, 7.28076e+00_r8, 7.26742e+00_r8, & + & 7.25410e+00_r8, 7.24080e+00_r8, 7.22753e+00_r8, 7.21428e+00_r8/) + kao_mn2o( 3, :, 5) = (/ & + & 1.06311e+01_r8, 1.06110e+01_r8, 1.05909e+01_r8, 1.05709e+01_r8, 1.05509e+01_r8, & + & 1.05310e+01_r8, 1.05111e+01_r8, 1.04912e+01_r8, 1.04713e+01_r8, 1.04516e+01_r8, & + & 1.04318e+01_r8, 1.04121e+01_r8, 1.03924e+01_r8, 1.03727e+01_r8, 1.03531e+01_r8, & + & 1.03336e+01_r8, 1.03140e+01_r8, 1.02945e+01_r8, 1.02751e+01_r8/) + kao_mn2o( 4, :, 5) = (/ & + & 1.03924e+01_r8, 1.03895e+01_r8, 1.03867e+01_r8, 1.03838e+01_r8, 1.03809e+01_r8, & + & 1.03780e+01_r8, 1.03751e+01_r8, 1.03722e+01_r8, 1.03693e+01_r8, 1.03665e+01_r8, & + & 1.03636e+01_r8, 1.03607e+01_r8, 1.03578e+01_r8, 1.03549e+01_r8, 1.03521e+01_r8, & + & 1.03492e+01_r8, 1.03463e+01_r8, 1.03434e+01_r8, 1.03406e+01_r8/) + kao_mn2o( 5, :, 5) = (/ & + & 7.82277e+00_r8, 7.83872e+00_r8, 7.85471e+00_r8, 7.87073e+00_r8, 7.88678e+00_r8, & + & 7.90287e+00_r8, 7.91899e+00_r8, 7.93514e+00_r8, 7.95132e+00_r8, 7.96754e+00_r8, & + & 7.98379e+00_r8, 8.00008e+00_r8, 8.01639e+00_r8, 8.03274e+00_r8, 8.04913e+00_r8, & + & 8.06555e+00_r8, 8.08200e+00_r8, 8.09848e+00_r8, 8.11500e+00_r8/) + kao_mn2o( 6, :, 5) = (/ & + & 6.05225e+00_r8, 6.06883e+00_r8, 6.08545e+00_r8, 6.10212e+00_r8, 6.11883e+00_r8, & + & 6.13559e+00_r8, 6.15240e+00_r8, 6.16925e+00_r8, 6.18615e+00_r8, 6.20309e+00_r8, & + & 6.22008e+00_r8, 6.23712e+00_r8, 6.25420e+00_r8, 6.27133e+00_r8, 6.28851e+00_r8, & + & 6.30574e+00_r8, 6.32301e+00_r8, 6.34033e+00_r8, 6.35769e+00_r8/) + kao_mn2o( 7, :, 5) = (/ & + & 5.24135e+00_r8, 5.25696e+00_r8, 5.27261e+00_r8, 5.28831e+00_r8, 5.30405e+00_r8, & + & 5.31984e+00_r8, 5.33568e+00_r8, 5.35157e+00_r8, 5.36750e+00_r8, 5.38348e+00_r8, & + & 5.39951e+00_r8, 5.41558e+00_r8, 5.43171e+00_r8, 5.44788e+00_r8, 5.46410e+00_r8, & + & 5.48037e+00_r8, 5.49668e+00_r8, 5.51305e+00_r8, 5.52946e+00_r8/) + kao_mn2o( 8, :, 5) = (/ & + & 4.40240e+00_r8, 4.40915e+00_r8, 4.41591e+00_r8, 4.42268e+00_r8, 4.42946e+00_r8, & + & 4.43625e+00_r8, 4.44305e+00_r8, 4.44986e+00_r8, 4.45668e+00_r8, 4.46351e+00_r8, & + & 4.47035e+00_r8, 4.47720e+00_r8, 4.48407e+00_r8, 4.49094e+00_r8, 4.49782e+00_r8, & + & 4.50472e+00_r8, 4.51162e+00_r8, 4.51854e+00_r8, 4.52547e+00_r8/) + kao_mn2o( 9, :, 5) = (/ & + & 8.56554e+00_r8, 8.59185e+00_r8, 8.61824e+00_r8, 8.64470e+00_r8, 8.67125e+00_r8, & + & 8.69788e+00_r8, 8.72460e+00_r8, 8.75139e+00_r8, 8.77827e+00_r8, 8.80523e+00_r8, & + & 8.83227e+00_r8, 8.85939e+00_r8, 8.88660e+00_r8, 8.91389e+00_r8, 8.94127e+00_r8, & + & 8.96873e+00_r8, 8.99627e+00_r8, 9.02390e+00_r8, 9.05161e+00_r8/) + kao_mn2o( 1, :, 6) = (/ & + & 5.78695e+00_r8, 5.78939e+00_r8, 5.79182e+00_r8, 5.79426e+00_r8, 5.79670e+00_r8, & + & 5.79914e+00_r8, 5.80158e+00_r8, 5.80403e+00_r8, 5.80647e+00_r8, 5.80892e+00_r8, & + & 5.81136e+00_r8, 5.81381e+00_r8, 5.81626e+00_r8, 5.81870e+00_r8, 5.82115e+00_r8, & + & 5.82361e+00_r8, 5.82606e+00_r8, 5.82851e+00_r8, 5.83096e+00_r8/) + kao_mn2o( 2, :, 6) = (/ & + & 1.22893e+01_r8, 1.22556e+01_r8, 1.22221e+01_r8, 1.21886e+01_r8, 1.21552e+01_r8, & + & 1.21220e+01_r8, 1.20888e+01_r8, 1.20557e+01_r8, 1.20227e+01_r8, 1.19898e+01_r8, & + & 1.19569e+01_r8, 1.19242e+01_r8, 1.18915e+01_r8, 1.18590e+01_r8, 1.18265e+01_r8, & + & 1.17941e+01_r8, 1.17618e+01_r8, 1.17296e+01_r8, 1.16975e+01_r8/) + kao_mn2o( 3, :, 6) = (/ & + & 7.93118e+00_r8, 7.94590e+00_r8, 7.96065e+00_r8, 7.97542e+00_r8, 7.99022e+00_r8, & + & 8.00505e+00_r8, 8.01990e+00_r8, 8.03478e+00_r8, 8.04970e+00_r8, 8.06463e+00_r8, & + & 8.07960e+00_r8, 8.09459e+00_r8, 8.10961e+00_r8, 8.12466e+00_r8, 8.13974e+00_r8, & + & 8.15485e+00_r8, 8.16998e+00_r8, 8.18514e+00_r8, 8.20033e+00_r8/) + kao_mn2o( 4, :, 6) = (/ & + & 4.08899e+00_r8, 4.11435e+00_r8, 4.13988e+00_r8, 4.16556e+00_r8, 4.19140e+00_r8, & + & 4.21740e+00_r8, 4.24357e+00_r8, 4.26989e+00_r8, 4.29638e+00_r8, 4.32304e+00_r8, & + & 4.34985e+00_r8, 4.37684e+00_r8, 4.40399e+00_r8, 4.43131e+00_r8, 4.45880e+00_r8, & + & 4.48646e+00_r8, 4.51430e+00_r8, 4.54230e+00_r8, 4.57048e+00_r8/) + kao_mn2o( 5, :, 6) = (/ & + & 2.61358e+00_r8, 2.64029e+00_r8, 2.66728e+00_r8, 2.69454e+00_r8, 2.72209e+00_r8, & + & 2.74991e+00_r8, 2.77802e+00_r8, 2.80641e+00_r8, 2.83510e+00_r8, 2.86408e+00_r8, & + & 2.89335e+00_r8, 2.92293e+00_r8, 2.95280e+00_r8, 2.98299e+00_r8, 3.01348e+00_r8, & + & 3.04428e+00_r8, 3.07540e+00_r8, 3.10683e+00_r8, 3.13859e+00_r8/) + kao_mn2o( 6, :, 6) = (/ & + & 2.40720e+00_r8, 2.43430e+00_r8, 2.46169e+00_r8, 2.48940e+00_r8, 2.51741e+00_r8, & + & 2.54575e+00_r8, 2.57440e+00_r8, 2.60337e+00_r8, 2.63267e+00_r8, 2.66230e+00_r8, & + & 2.69226e+00_r8, 2.72256e+00_r8, 2.75320e+00_r8, 2.78419e+00_r8, 2.81552e+00_r8, & + & 2.84721e+00_r8, 2.87925e+00_r8, 2.91166e+00_r8, 2.94443e+00_r8/) + kao_mn2o( 7, :, 6) = (/ & + & 1.99607e+00_r8, 2.01725e+00_r8, 2.03865e+00_r8, 2.06028e+00_r8, 2.08214e+00_r8, & + & 2.10423e+00_r8, 2.12655e+00_r8, 2.14912e+00_r8, 2.17192e+00_r8, 2.19496e+00_r8, & + & 2.21825e+00_r8, 2.24179e+00_r8, 2.26557e+00_r8, 2.28961e+00_r8, 2.31390e+00_r8, & + & 2.33845e+00_r8, 2.36326e+00_r8, 2.38834e+00_r8, 2.41368e+00_r8/) + kao_mn2o( 8, :, 6) = (/ & + & 1.94150e+00_r8, 1.96398e+00_r8, 1.98671e+00_r8, 2.00971e+00_r8, 2.03298e+00_r8, & + & 2.05651e+00_r8, 2.08032e+00_r8, 2.10440e+00_r8, 2.12876e+00_r8, 2.15341e+00_r8, & + & 2.17834e+00_r8, 2.20355e+00_r8, 2.22906e+00_r8, 2.25487e+00_r8, 2.28097e+00_r8, & + & 2.30738e+00_r8, 2.33409e+00_r8, 2.36111e+00_r8, 2.38844e+00_r8/) + kao_mn2o( 9, :, 6) = (/ & + & 2.47259e+00_r8, 2.48950e+00_r8, 2.50653e+00_r8, 2.52367e+00_r8, 2.54093e+00_r8, & + & 2.55831e+00_r8, 2.57581e+00_r8, 2.59343e+00_r8, 2.61117e+00_r8, 2.62903e+00_r8, & + & 2.64701e+00_r8, 2.66511e+00_r8, 2.68334e+00_r8, 2.70169e+00_r8, 2.72017e+00_r8, & + & 2.73878e+00_r8, 2.75751e+00_r8, 2.77637e+00_r8, 2.79536e+00_r8/) + kao_mn2o( 1, :, 7) = (/ & + & 1.23417e+01_r8, 1.22618e+01_r8, 1.21823e+01_r8, 1.21034e+01_r8, 1.20250e+01_r8, & + & 1.19471e+01_r8, 1.18697e+01_r8, 1.17928e+01_r8, 1.17164e+01_r8, 1.16405e+01_r8, & + & 1.15651e+01_r8, 1.14901e+01_r8, 1.14157e+01_r8, 1.13417e+01_r8, 1.12683e+01_r8, & + & 1.11952e+01_r8, 1.11227e+01_r8, 1.10507e+01_r8, 1.09791e+01_r8/) + kao_mn2o( 2, :, 7) = (/ & + & 9.30957e+00_r8, 9.32775e+00_r8, 9.34597e+00_r8, 9.36421e+00_r8, 9.38250e+00_r8, & + & 9.40082e+00_r8, 9.41918e+00_r8, 9.43757e+00_r8, 9.45600e+00_r8, 9.47446e+00_r8, & + & 9.49296e+00_r8, 9.51150e+00_r8, 9.53007e+00_r8, 9.54868e+00_r8, 9.56732e+00_r8, & + & 9.58601e+00_r8, 9.60472e+00_r8, 9.62348e+00_r8, 9.64227e+00_r8/) + kao_mn2o( 3, :, 7) = (/ & + & 4.15867e+00_r8, 4.19254e+00_r8, 4.22668e+00_r8, 4.26110e+00_r8, 4.29581e+00_r8, & + & 4.33079e+00_r8, 4.36606e+00_r8, 4.40162e+00_r8, 4.43747e+00_r8, 4.47360e+00_r8, & + & 4.51004e+00_r8, 4.54677e+00_r8, 4.58380e+00_r8, 4.62113e+00_r8, 4.65876e+00_r8, & + & 4.69670e+00_r8, 4.73495e+00_r8, 4.77351e+00_r8, 4.81239e+00_r8/) + kao_mn2o( 4, :, 7) = (/ & + & 3.55634e+00_r8, 3.59382e+00_r8, 3.63169e+00_r8, 3.66996e+00_r8, 3.70863e+00_r8, & + & 3.74771e+00_r8, 3.78720e+00_r8, 3.82711e+00_r8, 3.86744e+00_r8, 3.90820e+00_r8, & + & 3.94938e+00_r8, 3.99100e+00_r8, 4.03305e+00_r8, 4.07555e+00_r8, 4.11850e+00_r8, & + & 4.16190e+00_r8, 4.20576e+00_r8, 4.25008e+00_r8, 4.29486e+00_r8/) + kao_mn2o( 5, :, 7) = (/ & + & 3.09468e+00_r8, 3.12655e+00_r8, 3.15876e+00_r8, 3.19129e+00_r8, 3.22416e+00_r8, & + & 3.25737e+00_r8, 3.29092e+00_r8, 3.32482e+00_r8, 3.35907e+00_r8, 3.39366e+00_r8, & + & 3.42862e+00_r8, 3.46393e+00_r8, 3.49961e+00_r8, 3.53566e+00_r8, 3.57208e+00_r8, & + & 3.60887e+00_r8, 3.64604e+00_r8, 3.68360e+00_r8, 3.72154e+00_r8/) + kao_mn2o( 6, :, 7) = (/ & + & 2.75473e+00_r8, 2.78356e+00_r8, 2.81268e+00_r8, 2.84211e+00_r8, 2.87185e+00_r8, & + & 2.90190e+00_r8, 2.93227e+00_r8, 2.96295e+00_r8, 2.99395e+00_r8, 3.02528e+00_r8, & + & 3.05694e+00_r8, 3.08892e+00_r8, 3.12125e+00_r8, 3.15391e+00_r8, 3.18691e+00_r8, & + & 3.22025e+00_r8, 3.25395e+00_r8, 3.28800e+00_r8, 3.32240e+00_r8/) + kao_mn2o( 7, :, 7) = (/ & + & 2.68587e+00_r8, 2.71431e+00_r8, 2.74306e+00_r8, 2.77211e+00_r8, 2.80146e+00_r8, & + & 2.83113e+00_r8, 2.86111e+00_r8, 2.89141e+00_r8, 2.92203e+00_r8, 2.95298e+00_r8, & + & 2.98425e+00_r8, 3.01585e+00_r8, 3.04779e+00_r8, 3.08006e+00_r8, 3.11268e+00_r8, & + & 3.14564e+00_r8, 3.17896e+00_r8, 3.21262e+00_r8, 3.24664e+00_r8/) + kao_mn2o( 8, :, 7) = (/ & + & 2.54778e+00_r8, 2.57461e+00_r8, 2.60173e+00_r8, 2.62914e+00_r8, 2.65683e+00_r8, & + & 2.68482e+00_r8, 2.71310e+00_r8, 2.74168e+00_r8, 2.77056e+00_r8, 2.79974e+00_r8, & + & 2.82923e+00_r8, 2.85903e+00_r8, 2.88915e+00_r8, 2.91958e+00_r8, 2.95033e+00_r8, & + & 2.98141e+00_r8, 3.01282e+00_r8, 3.04455e+00_r8, 3.07662e+00_r8/) + kao_mn2o( 9, :, 7) = (/ & + & 2.78137e+00_r8, 2.80957e+00_r8, 2.83805e+00_r8, 2.86682e+00_r8, 2.89589e+00_r8, & + & 2.92525e+00_r8, 2.95491e+00_r8, 2.98486e+00_r8, 3.01512e+00_r8, 3.04569e+00_r8, & + & 3.07657e+00_r8, 3.10776e+00_r8, 3.13927e+00_r8, 3.17110e+00_r8, 3.20324e+00_r8, & + & 3.23572e+00_r8, 3.26852e+00_r8, 3.30166e+00_r8, 3.33513e+00_r8/) + kao_mn2o( 1, :, 8) = (/ & + & 2.28384e+01_r8, 2.27450e+01_r8, 2.26519e+01_r8, 2.25593e+01_r8, 2.24670e+01_r8, & + & 2.23751e+01_r8, 2.22835e+01_r8, 2.21924e+01_r8, 2.21016e+01_r8, 2.20112e+01_r8, & + & 2.19211e+01_r8, 2.18314e+01_r8, 2.17421e+01_r8, 2.16532e+01_r8, 2.15646e+01_r8, & + & 2.14764e+01_r8, 2.13885e+01_r8, 2.13010e+01_r8, 2.12139e+01_r8/) + kao_mn2o( 2, :, 8) = (/ & + & 4.48608e+00_r8, 4.52259e+00_r8, 4.55939e+00_r8, 4.59649e+00_r8, 4.63389e+00_r8, & + & 4.67160e+00_r8, 4.70961e+00_r8, 4.74793e+00_r8, 4.78656e+00_r8, 4.82551e+00_r8, & + & 4.86478e+00_r8, 4.90436e+00_r8, 4.94427e+00_r8, 4.98450e+00_r8, 5.02506e+00_r8, & + & 5.06595e+00_r8, 5.10717e+00_r8, 5.14873e+00_r8, 5.19062e+00_r8/) + kao_mn2o( 3, :, 8) = (/ & + & 3.69928e+00_r8, 3.72584e+00_r8, 3.75259e+00_r8, 3.77953e+00_r8, 3.80666e+00_r8, & + & 3.83399e+00_r8, 3.86152e+00_r8, 3.88924e+00_r8, 3.91717e+00_r8, 3.94529e+00_r8, & + & 3.97361e+00_r8, 4.00214e+00_r8, 4.03088e+00_r8, 4.05982e+00_r8, 4.08896e+00_r8, & + & 4.11832e+00_r8, 4.14789e+00_r8, 4.17767e+00_r8, 4.20766e+00_r8/) + kao_mn2o( 4, :, 8) = (/ & + & 3.17856e+00_r8, 3.19596e+00_r8, 3.21345e+00_r8, 3.23104e+00_r8, 3.24872e+00_r8, & + & 3.26650e+00_r8, 3.28437e+00_r8, 3.30235e+00_r8, 3.32042e+00_r8, 3.33859e+00_r8, & + & 3.35686e+00_r8, 3.37523e+00_r8, 3.39370e+00_r8, 3.41227e+00_r8, 3.43095e+00_r8, & + & 3.44972e+00_r8, 3.46860e+00_r8, 3.48758e+00_r8, 3.50667e+00_r8/) + kao_mn2o( 5, :, 8) = (/ & + & 3.16549e+00_r8, 3.18288e+00_r8, 3.20037e+00_r8, 3.21795e+00_r8, 3.23563e+00_r8, & + & 3.25340e+00_r8, 3.27128e+00_r8, 3.28925e+00_r8, 3.30732e+00_r8, 3.32549e+00_r8, & + & 3.34376e+00_r8, 3.36213e+00_r8, 3.38060e+00_r8, 3.39917e+00_r8, 3.41785e+00_r8, & + & 3.43662e+00_r8, 3.45551e+00_r8, 3.47449e+00_r8, 3.49358e+00_r8/) + kao_mn2o( 6, :, 8) = (/ & + & 3.16612e+00_r8, 3.18355e+00_r8, 3.20108e+00_r8, 3.21870e+00_r8, 3.23643e+00_r8, & + & 3.25425e+00_r8, 3.27217e+00_r8, 3.29018e+00_r8, 3.30830e+00_r8, 3.32652e+00_r8, & + & 3.34483e+00_r8, 3.36325e+00_r8, 3.38177e+00_r8, 3.40039e+00_r8, 3.41911e+00_r8, & + & 3.43794e+00_r8, 3.45687e+00_r8, 3.47591e+00_r8, 3.49505e+00_r8/) + kao_mn2o( 7, :, 8) = (/ & + & 3.19644e+00_r8, 3.21419e+00_r8, 3.23203e+00_r8, 3.24996e+00_r8, 3.26800e+00_r8, & + & 3.28614e+00_r8, 3.30438e+00_r8, 3.32272e+00_r8, 3.34116e+00_r8, 3.35970e+00_r8, & + & 3.37835e+00_r8, 3.39710e+00_r8, 3.41596e+00_r8, 3.43492e+00_r8, 3.45398e+00_r8, & + & 3.47315e+00_r8, 3.49243e+00_r8, 3.51181e+00_r8, 3.53130e+00_r8/) + kao_mn2o( 8, :, 8) = (/ & + & 3.35759e+00_r8, 3.37775e+00_r8, 3.39804e+00_r8, 3.41845e+00_r8, 3.43899e+00_r8, & + & 3.45964e+00_r8, 3.48042e+00_r8, 3.50133e+00_r8, 3.52236e+00_r8, 3.54351e+00_r8, & + & 3.56480e+00_r8, 3.58621e+00_r8, 3.60775e+00_r8, 3.62942e+00_r8, 3.65122e+00_r8, & + & 3.67315e+00_r8, 3.69521e+00_r8, 3.71741e+00_r8, 3.73974e+00_r8/) + kao_mn2o( 9, :, 8) = (/ & + & 3.17378e+00_r8, 3.19135e+00_r8, 3.20901e+00_r8, 3.22677e+00_r8, 3.24462e+00_r8, & + & 3.26258e+00_r8, 3.28063e+00_r8, 3.29879e+00_r8, 3.31704e+00_r8, 3.33540e+00_r8, & + & 3.35386e+00_r8, 3.37242e+00_r8, 3.39108e+00_r8, 3.40984e+00_r8, 3.42871e+00_r8, & + & 3.44769e+00_r8, 3.46677e+00_r8, 3.48595e+00_r8, 3.50524e+00_r8/) + kao_mn2o( 1, :, 9) = (/ & + & 2.09106e+01_r8, 2.08779e+01_r8, 2.08452e+01_r8, 2.08126e+01_r8, 2.07800e+01_r8, & + & 2.07475e+01_r8, 2.07150e+01_r8, 2.06826e+01_r8, 2.06502e+01_r8, 2.06179e+01_r8, & + & 2.05856e+01_r8, 2.05534e+01_r8, 2.05213e+01_r8, 2.04891e+01_r8, 2.04571e+01_r8, & + & 2.04251e+01_r8, 2.03931e+01_r8, 2.03612e+01_r8, 2.03293e+01_r8/) + kao_mn2o( 2, :, 9) = (/ & + & 2.60494e+00_r8, 2.62757e+00_r8, 2.65040e+00_r8, 2.67343e+00_r8, 2.69665e+00_r8, & + & 2.72008e+00_r8, 2.74372e+00_r8, 2.76756e+00_r8, 2.79160e+00_r8, 2.81586e+00_r8, & + & 2.84032e+00_r8, 2.86500e+00_r8, 2.88989e+00_r8, 2.91500e+00_r8, 2.94033e+00_r8, & + & 2.96588e+00_r8, 2.99164e+00_r8, 3.01764e+00_r8, 3.04386e+00_r8/) + kao_mn2o( 3, :, 9) = (/ & + & 2.42238e+00_r8, 2.44514e+00_r8, 2.46811e+00_r8, 2.49130e+00_r8, 2.51471e+00_r8, & + & 2.53834e+00_r8, 2.56219e+00_r8, 2.58626e+00_r8, 2.61056e+00_r8, 2.63509e+00_r8, & + & 2.65985e+00_r8, 2.68484e+00_r8, 2.71007e+00_r8, 2.73554e+00_r8, 2.76124e+00_r8, & + & 2.78718e+00_r8, 2.81337e+00_r8, 2.83981e+00_r8, 2.86649e+00_r8/) + kao_mn2o( 4, :, 9) = (/ & + & 2.33681e+00_r8, 2.35961e+00_r8, 2.38263e+00_r8, 2.40588e+00_r8, 2.42935e+00_r8, & + & 2.45305e+00_r8, 2.47699e+00_r8, 2.50115e+00_r8, 2.52556e+00_r8, 2.55020e+00_r8, & + & 2.57508e+00_r8, 2.60021e+00_r8, 2.62558e+00_r8, 2.65119e+00_r8, 2.67706e+00_r8, & + & 2.70318e+00_r8, 2.72955e+00_r8, 2.75619e+00_r8, 2.78308e+00_r8/) + kao_mn2o( 5, :, 9) = (/ & + & 2.26420e+00_r8, 2.28696e+00_r8, 2.30996e+00_r8, 2.33319e+00_r8, 2.35665e+00_r8, & + & 2.38035e+00_r8, 2.40429e+00_r8, 2.42846e+00_r8, 2.45288e+00_r8, 2.47755e+00_r8, & + & 2.50246e+00_r8, 2.52763e+00_r8, 2.55304e+00_r8, 2.57871e+00_r8, 2.60465e+00_r8, & + & 2.63084e+00_r8, 2.65729e+00_r8, 2.68401e+00_r8, 2.71100e+00_r8/) + kao_mn2o( 6, :, 9) = (/ & + & 2.19628e+00_r8, 2.21902e+00_r8, 2.24199e+00_r8, 2.26520e+00_r8, 2.28865e+00_r8, & + & 2.31234e+00_r8, 2.33628e+00_r8, 2.36047e+00_r8, 2.38491e+00_r8, 2.40959e+00_r8, & + & 2.43454e+00_r8, 2.45974e+00_r8, 2.48521e+00_r8, 2.51094e+00_r8, 2.53693e+00_r8, & + & 2.56319e+00_r8, 2.58973e+00_r8, 2.61654e+00_r8, 2.64363e+00_r8/) + kao_mn2o( 7, :, 9) = (/ & + & 2.07829e+00_r8, 2.10090e+00_r8, 2.12375e+00_r8, 2.14685e+00_r8, 2.17021e+00_r8, & + & 2.19381e+00_r8, 2.21767e+00_r8, 2.24180e+00_r8, 2.26618e+00_r8, 2.29083e+00_r8, & + & 2.31575e+00_r8, 2.34094e+00_r8, 2.36640e+00_r8, 2.39214e+00_r8, 2.41816e+00_r8, & + & 2.44446e+00_r8, 2.47105e+00_r8, 2.49793e+00_r8, 2.52510e+00_r8/) + kao_mn2o( 8, :, 9) = (/ & + & 1.68230e+00_r8, 1.70305e+00_r8, 1.72404e+00_r8, 1.74530e+00_r8, 1.76681e+00_r8, & + & 1.78860e+00_r8, 1.81065e+00_r8, 1.83297e+00_r8, 1.85557e+00_r8, 1.87845e+00_r8, & + & 1.90161e+00_r8, 1.92505e+00_r8, 1.94878e+00_r8, 1.97281e+00_r8, 1.99713e+00_r8, & + & 2.02176e+00_r8, 2.04668e+00_r8, 2.07191e+00_r8, 2.09746e+00_r8/) + kao_mn2o( 9, :, 9) = (/ & + & 2.23224e+00_r8, 2.25486e+00_r8, 2.27771e+00_r8, 2.30079e+00_r8, 2.32411e+00_r8, & + & 2.34766e+00_r8, 2.37145e+00_r8, 2.39548e+00_r8, 2.41975e+00_r8, 2.44427e+00_r8, & + & 2.46904e+00_r8, 2.49406e+00_r8, 2.51933e+00_r8, 2.54486e+00_r8, 2.57065e+00_r8, & + & 2.59670e+00_r8, 2.62301e+00_r8, 2.64959e+00_r8, 2.67644e+00_r8/) + kao_mn2o( 1, :,10) = (/ & + & 1.30711e+01_r8, 1.31853e+01_r8, 1.33004e+01_r8, 1.34166e+01_r8, 1.35339e+01_r8, & + & 1.36521e+01_r8, 1.37714e+01_r8, 1.38917e+01_r8, 1.40130e+01_r8, 1.41355e+01_r8, & + & 1.42590e+01_r8, 1.43835e+01_r8, 1.45092e+01_r8, 1.46360e+01_r8, 1.47638e+01_r8, & + & 1.48928e+01_r8, 1.50229e+01_r8, 1.51542e+01_r8, 1.52866e+01_r8/) + kao_mn2o( 2, :,10) = (/ & + & 2.71206e-01_r8, 2.90148e-01_r8, 3.10413e-01_r8, 3.32093e-01_r8, 3.55287e-01_r8, & + & 3.80102e-01_r8, 4.06649e-01_r8, 4.35051e-01_r8, 4.65436e-01_r8, 4.97943e-01_r8, & + & 5.32721e-01_r8, 5.69928e-01_r8, 6.09733e-01_r8, 6.52319e-01_r8, 6.97879e-01_r8, & + & 7.46621e-01_r8, 7.98767e-01_r8, 8.54555e-01_r8, 9.14239e-01_r8/) + kao_mn2o( 3, :,10) = (/ & + & 2.65609e-01_r8, 2.84236e-01_r8, 3.04170e-01_r8, 3.25501e-01_r8, 3.48329e-01_r8, & + & 3.72758e-01_r8, 3.98900e-01_r8, 4.26875e-01_r8, 4.56812e-01_r8, 4.88849e-01_r8, & + & 5.23132e-01_r8, 5.59820e-01_r8, 5.99080e-01_r8, 6.41095e-01_r8, 6.86055e-01_r8, & + & 7.34169e-01_r8, 7.85657e-01_r8, 8.40756e-01_r8, 8.99718e-01_r8/) + kao_mn2o( 4, :,10) = (/ & + & 2.55277e-01_r8, 2.73370e-01_r8, 2.92745e-01_r8, 3.13494e-01_r8, 3.35714e-01_r8, & + & 3.59508e-01_r8, 3.84989e-01_r8, 4.12275e-01_r8, 4.41496e-01_r8, 4.72788e-01_r8, & + & 5.06298e-01_r8, 5.42183e-01_r8, 5.80611e-01_r8, 6.21763e-01_r8, 6.65831e-01_r8, & + & 7.13023e-01_r8, 7.63560e-01_r8, 8.17678e-01_r8, 8.75633e-01_r8/) + kao_mn2o( 5, :,10) = (/ & + & 2.41481e-01_r8, 2.58840e-01_r8, 2.77446e-01_r8, 2.97390e-01_r8, 3.18768e-01_r8, & + & 3.41682e-01_r8, 3.66244e-01_r8, 3.92571e-01_r8, 4.20791e-01_r8, 4.51039e-01_r8, & + & 4.83461e-01_r8, 5.18215e-01_r8, 5.55466e-01_r8, 5.95396e-01_r8, 6.38195e-01_r8, & + & 6.84071e-01_r8, 7.33245e-01_r8, 7.85954e-01_r8, 8.42452e-01_r8/) + kao_mn2o( 6, :,10) = (/ & + & 2.37173e-01_r8, 2.54360e-01_r8, 2.72792e-01_r8, 2.92559e-01_r8, 3.13759e-01_r8, & + & 3.36495e-01_r8, 3.60878e-01_r8, 3.87029e-01_r8, 4.15074e-01_r8, 4.45152e-01_r8, & + & 4.77409e-01_r8, 5.12004e-01_r8, 5.49105e-01_r8, 5.88895e-01_r8, 6.31569e-01_r8, & + & 6.77334e-01_r8, 7.26416e-01_r8, 7.79055e-01_r8, 8.35508e-01_r8/) + kao_mn2o( 7, :,10) = (/ & + & 2.27414e-01_r8, 2.44231e-01_r8, 2.62292e-01_r8, 2.81689e-01_r8, 3.02520e-01_r8, & + & 3.24891e-01_r8, 3.48917e-01_r8, 3.74720e-01_r8, 4.02430e-01_r8, 4.32190e-01_r8, & + & 4.64151e-01_r8, 4.98475e-01_r8, 5.35337e-01_r8, 5.74926e-01_r8, 6.17442e-01_r8, & + & 6.63102e-01_r8, 7.12138e-01_r8, 7.64801e-01_r8, 8.21358e-01_r8/) + kao_mn2o( 8, :,10) = (/ & + & 1.77234e-01_r8, 1.92029e-01_r8, 2.08060e-01_r8, 2.25429e-01_r8, 2.44248e-01_r8, & + & 2.64638e-01_r8, 2.86730e-01_r8, 3.10667e-01_r8, 3.36601e-01_r8, 3.64701e-01_r8, & + & 3.95147e-01_r8, 4.28134e-01_r8, 4.63875e-01_r8, 5.02600e-01_r8, 5.44557e-01_r8, & + & 5.90017e-01_r8, 6.39272e-01_r8, 6.92639e-01_r8, 7.50461e-01_r8/) + kao_mn2o( 9, :,10) = (/ & + & 2.41727e-01_r8, 2.59094e-01_r8, 2.77710e-01_r8, 2.97662e-01_r8, 3.19049e-01_r8, & + & 3.41972e-01_r8, 3.66541e-01_r8, 3.92877e-01_r8, 4.21104e-01_r8, 4.51359e-01_r8, & + & 4.83788e-01_r8, 5.18547e-01_r8, 5.55804e-01_r8, 5.95737e-01_r8, 6.38539e-01_r8, & + & 6.84417e-01_r8, 7.33590e-01_r8, 7.86297e-01_r8, 8.42790e-01_r8/) + kao_mn2o( 1, :,11) = (/ & + & 6.65287e+00_r8, 6.69137e+00_r8, 6.73008e+00_r8, 6.76903e+00_r8, 6.80820e+00_r8, & + & 6.84759e+00_r8, 6.88721e+00_r8, 6.92707e+00_r8, 6.96715e+00_r8, 7.00746e+00_r8, & + & 7.04801e+00_r8, 7.08879e+00_r8, 7.12981e+00_r8, 7.17107e+00_r8, 7.21256e+00_r8, & + & 7.25430e+00_r8, 7.29628e+00_r8, 7.33850e+00_r8, 7.38096e+00_r8/) + kao_mn2o( 2, :,11) = (/ & + & 2.06252e-01_r8, 2.27731e-01_r8, 2.51447e-01_r8, 2.77633e-01_r8, 3.06546e-01_r8, & + & 3.38470e-01_r8, 3.73719e-01_r8, 4.12638e-01_r8, 4.55611e-01_r8, 5.03058e-01_r8, & + & 5.55447e-01_r8, 6.13292e-01_r8, 6.77160e-01_r8, 7.47680e-01_r8, 8.25544e-01_r8, & + & 9.11517e-01_r8, 1.00644e+00_r8, 1.11125e+00_r8, 1.22698e+00_r8/) + kao_mn2o( 3, :,11) = (/ & + & 2.05840e-01_r8, 2.27279e-01_r8, 2.50952e-01_r8, 2.77090e-01_r8, 3.05950e-01_r8, & + & 3.37816e-01_r8, 3.73002e-01_r8, 4.11852e-01_r8, 4.54748e-01_r8, 5.02113e-01_r8, & + & 5.54411e-01_r8, 6.12155e-01_r8, 6.75915e-01_r8, 7.46315e-01_r8, 8.24047e-01_r8, & + & 9.09876e-01_r8, 1.00465e+00_r8, 1.10928e+00_r8, 1.22482e+00_r8/) + kao_mn2o( 4, :,11) = (/ & + & 2.04702e-01_r8, 2.26031e-01_r8, 2.49582e-01_r8, 2.75587e-01_r8, 3.04301e-01_r8, & + & 3.36008e-01_r8, 3.71018e-01_r8, 4.09675e-01_r8, 4.52361e-01_r8, 4.99495e-01_r8, & + & 5.51539e-01_r8, 6.09007e-01_r8, 6.72461e-01_r8, 7.42528e-01_r8, 8.19895e-01_r8, & + & 9.05323e-01_r8, 9.99653e-01_r8, 1.10381e+00_r8, 1.21882e+00_r8/) + kao_mn2o( 5, :,11) = (/ & + & 2.03481e-01_r8, 2.24689e-01_r8, 2.48108e-01_r8, 2.73967e-01_r8, 3.02522e-01_r8, & + & 3.34053e-01_r8, 3.68871e-01_r8, 4.07317e-01_r8, 4.49771e-01_r8, 4.96649e-01_r8, & + & 5.48414e-01_r8, 6.05574e-01_r8, 6.68691e-01_r8, 7.38387e-01_r8, 8.15347e-01_r8, & + & 9.00329e-01_r8, 9.94168e-01_r8, 1.09779e+00_r8, 1.21221e+00_r8/) + kao_mn2o( 6, :,11) = (/ & + & 2.01513e-01_r8, 2.22529e-01_r8, 2.45738e-01_r8, 2.71367e-01_r8, 2.99670e-01_r8, & + & 3.30924e-01_r8, 3.65437e-01_r8, 4.03550e-01_r8, 4.45639e-01_r8, 4.92117e-01_r8, & + & 5.43442e-01_r8, 6.00120e-01_r8, 6.62710e-01_r8, 7.31827e-01_r8, 8.08153e-01_r8, & + & 8.92439e-01_r8, 9.85516e-01_r8, 1.08830e+00_r8, 1.20180e+00_r8/) + kao_mn2o( 7, :,11) = (/ & + & 1.97136e-01_r8, 2.17723e-01_r8, 2.40459e-01_r8, 2.65570e-01_r8, 2.93304e-01_r8, & + & 3.23933e-01_r8, 3.57762e-01_r8, 3.95122e-01_r8, 4.36385e-01_r8, 4.81956e-01_r8, & + & 5.32287e-01_r8, 5.87873e-01_r8, 6.49264e-01_r8, 7.17067e-01_r8, 7.91950e-01_r8, & + & 8.74653e-01_r8, 9.65992e-01_r8, 1.06687e+00_r8, 1.17828e+00_r8/) + kao_mn2o( 8, :,11) = (/ & + & 1.79518e-01_r8, 1.98371e-01_r8, 2.19204e-01_r8, 2.42224e-01_r8, 2.67662e-01_r8, & + & 2.95772e-01_r8, 3.26833e-01_r8, 3.61157e-01_r8, 3.99085e-01_r8, 4.40996e-01_r8, & + & 4.87309e-01_r8, 5.38486e-01_r8, 5.95037e-01_r8, 6.57526e-01_r8, 7.26579e-01_r8, & + & 8.02883e-01_r8, 8.87201e-01_r8, 9.80373e-01_r8, 1.08333e+00_r8/) + kao_mn2o( 9, :,11) = (/ & + & 2.03481e-01_r8, 2.24689e-01_r8, 2.48108e-01_r8, 2.73967e-01_r8, 3.02522e-01_r8, & + & 3.34053e-01_r8, 3.68871e-01_r8, 4.07317e-01_r8, 4.49771e-01_r8, 4.96649e-01_r8, & + & 5.48414e-01_r8, 6.05574e-01_r8, 6.68691e-01_r8, 7.38387e-01_r8, 8.15347e-01_r8, & + & 9.00329e-01_r8, 9.94168e-01_r8, 1.09779e+00_r8, 1.21221e+00_r8/) + kao_mn2o( 1, :,12) = (/ & + & 5.89636e+00_r8, 5.95081e+00_r8, 6.00576e+00_r8, 6.06121e+00_r8, 6.11718e+00_r8, & + & 6.17366e+00_r8, 6.23067e+00_r8, 6.28820e+00_r8, 6.34627e+00_r8, 6.40487e+00_r8, & + & 6.46401e+00_r8, 6.52369e+00_r8, 6.58393e+00_r8, 6.64472e+00_r8, 6.70608e+00_r8, & + & 6.76800e+00_r8, 6.83050e+00_r8, 6.89357e+00_r8, 6.95722e+00_r8/) + kao_mn2o( 2, :,12) = (/ & + & 7.18699e-05_r8, 9.48140e-05_r8, 1.25083e-04_r8, 1.65015e-04_r8, 2.17695e-04_r8, & + & 2.87193e-04_r8, 3.78877e-04_r8, 4.99831e-04_r8, 6.59400e-04_r8, 8.69909e-04_r8, & + & 1.14762e-03_r8, 1.51400e-03_r8, 1.99733e-03_r8, 2.63497e-03_r8, 3.47616e-03_r8, & + & 4.58591e-03_r8, 6.04993e-03_r8, 7.98133e-03_r8, 1.05293e-02_r8/) + kao_mn2o( 3, :,12) = (/ & + & 7.20868e-05_r8, 9.50993e-05_r8, 1.25458e-04_r8, 1.65508e-04_r8, 2.18344e-04_r8, & + & 2.88046e-04_r8, 3.80000e-04_r8, 5.01307e-04_r8, 6.61341e-04_r8, 8.72462e-04_r8, & + & 1.15098e-03_r8, 1.51841e-03_r8, 2.00313e-03_r8, 2.64260e-03_r8, 3.48620e-03_r8, & + & 4.59911e-03_r8, 6.06729e-03_r8, 8.00416e-03_r8, 1.05593e-02_r8/) + kao_mn2o( 4, :,12) = (/ & + & 7.21734e-05_r8, 9.52161e-05_r8, 1.25616e-04_r8, 1.65721e-04_r8, 2.18630e-04_r8, & + & 2.88432e-04_r8, 3.80519e-04_r8, 5.02007e-04_r8, 6.62282e-04_r8, 8.73727e-04_r8, & + & 1.15268e-03_r8, 1.52070e-03_r8, 2.00621e-03_r8, 2.64673e-03_r8, 3.49174e-03_r8, & + & 4.60655e-03_r8, 6.07727e-03_r8, 8.01755e-03_r8, 1.05773e-02_r8/) + kao_mn2o( 5, :,12) = (/ & + & 7.22599e-05_r8, 9.53329e-05_r8, 1.25773e-04_r8, 1.65933e-04_r8, 2.18916e-04_r8, & + & 2.88818e-04_r8, 3.81038e-04_r8, 5.02706e-04_r8, 6.63223e-04_r8, 8.74992e-04_r8, & + & 1.15438e-03_r8, 1.52298e-03_r8, 2.00928e-03_r8, 2.65085e-03_r8, 3.49728e-03_r8, & + & 4.61398e-03_r8, 6.08725e-03_r8, 8.03094e-03_r8, 1.05952e-02_r8/) + kao_mn2o( 6, :,12) = (/ & + & 7.29962e-05_r8, 9.63091e-05_r8, 1.27067e-04_r8, 1.67649e-04_r8, 2.21191e-04_r8, & + & 2.91833e-04_r8, 3.85036e-04_r8, 5.08005e-04_r8, 6.70247e-04_r8, 8.84304e-04_r8, & + & 1.16672e-03_r8, 1.53934e-03_r8, 2.03096e-03_r8, 2.67959e-03_r8, 3.53537e-03_r8, & + & 4.66447e-03_r8, 6.15417e-03_r8, 8.11962e-03_r8, 1.07128e-02_r8/) + kao_mn2o( 7, :,12) = (/ & + & 7.47398e-05_r8, 9.86139e-05_r8, 1.30114e-04_r8, 1.71677e-04_r8, 2.26516e-04_r8, & + & 2.98872e-04_r8, 3.94340e-04_r8, 5.20305e-04_r8, 6.86506e-04_r8, 9.05797e-04_r8, & + & 1.19514e-03_r8, 1.57690e-03_r8, 2.08061e-03_r8, 2.74522e-03_r8, 3.62213e-03_r8, & + & 4.77915e-03_r8, 6.30576e-03_r8, 8.32001e-03_r8, 1.09777e-02_r8/) + kao_mn2o( 8, :,12) = (/ & + & 7.57487e-05_r8, 9.99802e-05_r8, 1.31963e-04_r8, 1.74177e-04_r8, 2.29896e-04_r8, & + & 3.03438e-04_r8, 4.00506e-04_r8, 5.28625e-04_r8, 6.97729e-04_r8, 9.20927e-04_r8, & + & 1.21553e-03_r8, 1.60437e-03_r8, 2.11759e-03_r8, 2.79499e-03_r8, 3.68909e-03_r8, & + & 4.86921e-03_r8, 6.42684e-03_r8, 8.48274e-03_r8, 1.11963e-02_r8/) + kao_mn2o( 9, :,12) = (/ & + & 7.22467e-05_r8, 9.53177e-05_r8, 1.25756e-04_r8, 1.65915e-04_r8, 2.18898e-04_r8, & + & 2.88800e-04_r8, 3.81024e-04_r8, 5.02700e-04_r8, 6.63231e-04_r8, 8.75024e-04_r8, & + & 1.15445e-03_r8, 1.52311e-03_r8, 2.00950e-03_r8, 2.65121e-03_r8, 3.49784e-03_r8, & + & 4.61483e-03_r8, 6.08852e-03_r8, 8.03280e-03_r8, 1.05980e-02_r8/) + kao_mn2o( 1, :,13) = (/ & + & 1.14265e+01_r8, 1.16380e+01_r8, 1.18534e+01_r8, 1.20728e+01_r8, 1.22962e+01_r8, & + & 1.25238e+01_r8, 1.27556e+01_r8, 1.29917e+01_r8, 1.32322e+01_r8, 1.34771e+01_r8, & + & 1.37265e+01_r8, 1.39806e+01_r8, 1.42394e+01_r8, 1.45029e+01_r8, 1.47714e+01_r8, & + & 1.50448e+01_r8, 1.53232e+01_r8, 1.56068e+01_r8, 1.58957e+01_r8/) + kao_mn2o( 2, :,13) = (/ & + & 7.97796e-05_r8, 1.05659e-04_r8, 1.39932e-04_r8, 1.85324e-04_r8, 2.45439e-04_r8, & + & 3.25054e-04_r8, 4.30496e-04_r8, 5.70140e-04_r8, 7.55082e-04_r8, 1.00002e-03_r8, & + & 1.32440e-03_r8, 1.75401e-03_r8, 2.32298e-03_r8, 3.07651e-03_r8, 4.07447e-03_r8, & + & 5.39614e-03_r8, 7.14655e-03_r8, 9.46475e-03_r8, 1.25349e-02_r8/) + kao_mn2o( 3, :,13) = (/ & + & 7.95035e-05_r8, 1.05293e-04_r8, 1.39449e-04_r8, 1.84684e-04_r8, 2.44592e-04_r8, & + & 3.23934e-04_r8, 4.29013e-04_r8, 5.68178e-04_r8, 7.52486e-04_r8, 9.96580e-04_r8, & + & 1.31985e-03_r8, 1.74800e-03_r8, 2.31502e-03_r8, 3.06597e-03_r8, 4.06052e-03_r8, & + & 5.37770e-03_r8, 7.12214e-03_r8, 9.43244e-03_r8, 1.24922e-02_r8/) + kao_mn2o( 4, :,13) = (/ & + & 7.92339e-05_r8, 1.04938e-04_r8, 1.38980e-04_r8, 1.84065e-04_r8, 2.43776e-04_r8, & + & 3.22857e-04_r8, 4.27593e-04_r8, 5.66305e-04_r8, 7.50016e-04_r8, 9.93322e-04_r8, & + & 1.31556e-03_r8, 1.74233e-03_r8, 2.30754e-03_r8, 3.05612e-03_r8, 4.04752e-03_r8, & + & 5.36055e-03_r8, 7.09953e-03_r8, 9.40262e-03_r8, 1.24528e-02_r8/) + kao_mn2o( 5, :,13) = (/ & + & 7.90000e-05_r8, 1.04627e-04_r8, 1.38566e-04_r8, 1.83516e-04_r8, 2.43046e-04_r8, & + & 3.21887e-04_r8, 4.26303e-04_r8, 5.64591e-04_r8, 7.47738e-04_r8, 9.90295e-04_r8, & + & 1.31154e-03_r8, 1.73698e-03_r8, 2.30044e-03_r8, 3.04667e-03_r8, 4.03498e-03_r8, & + & 5.34388e-03_r8, 7.07737e-03_r8, 9.37318e-03_r8, 1.24137e-02_r8/) + kao_mn2o( 6, :,13) = (/ & + & 7.76004e-05_r8, 1.02776e-04_r8, 1.36118e-04_r8, 1.80278e-04_r8, 2.38764e-04_r8, & + & 3.16224e-04_r8, 4.18814e-04_r8, 5.54686e-04_r8, 7.34638e-04_r8, 9.72970e-04_r8, & + & 1.28862e-03_r8, 1.70668e-03_r8, 2.26036e-03_r8, 2.99367e-03_r8, 3.96488e-03_r8, & + & 5.25118e-03_r8, 6.95477e-03_r8, 9.21105e-03_r8, 1.21993e-02_r8/) + kao_mn2o( 7, :,13) = (/ & + & 7.52813e-05_r8, 9.97094e-05_r8, 1.32064e-04_r8, 1.74918e-04_r8, 2.31677e-04_r8, & + & 3.06854e-04_r8, 4.06426e-04_r8, 5.38308e-04_r8, 7.12984e-04_r8, 9.44341e-04_r8, & + & 1.25077e-03_r8, 1.65664e-03_r8, 2.19420e-03_r8, 2.90620e-03_r8, 3.84923e-03_r8, & + & 5.09828e-03_r8, 6.75263e-03_r8, 8.94379e-03_r8, 1.18460e-02_r8/) + kao_mn2o( 8, :,13) = (/ & + & 6.87436e-05_r8, 9.10605e-05_r8, 1.20622e-04_r8, 1.59781e-04_r8, 2.11653e-04_r8, & + & 2.80364e-04_r8, 3.71381e-04_r8, 4.91946e-04_r8, 6.51651e-04_r8, 8.63203e-04_r8, & + & 1.14343e-03_r8, 1.51464e-03_r8, 2.00635e-03_r8, 2.65769e-03_r8, 3.52048e-03_r8, & + & 4.66337e-03_r8, 6.17729e-03_r8, 8.18269e-03_r8, 1.08391e-02_r8/) + kao_mn2o( 9, :,13) = (/ & + & 7.90357e-05_r8, 1.04671e-04_r8, 1.38622e-04_r8, 1.83585e-04_r8, 2.43132e-04_r8, & + & 3.21994e-04_r8, 4.26434e-04_r8, 5.64750e-04_r8, 7.47931e-04_r8, 9.90526e-04_r8, & + & 1.31181e-03_r8, 1.73730e-03_r8, 2.30081e-03_r8, 3.04709e-03_r8, 4.03543e-03_r8, & + & 5.34435e-03_r8, 7.07782e-03_r8, 9.37355e-03_r8, 1.24139e-02_r8/) + kao_mn2o( 1, :,14) = (/ & + & 1.61373e+01_r8, 1.64784e+01_r8, 1.68266e+01_r8, 1.71822e+01_r8, 1.75454e+01_r8, & + & 1.79162e+01_r8, 1.82948e+01_r8, 1.86814e+01_r8, 1.90762e+01_r8, 1.94794e+01_r8, & + & 1.98911e+01_r8, 2.03114e+01_r8, 2.07407e+01_r8, 2.11790e+01_r8, 2.16266e+01_r8, & + & 2.20836e+01_r8, 2.25504e+01_r8, 2.30269e+01_r8, 2.35136e+01_r8/) + kao_mn2o( 2, :,14) = (/ & + & 6.92866e-10_r8, 9.24655e-10_r8, 1.23398e-09_r8, 1.64680e-09_r8, 2.19771e-09_r8, & + & 2.93292e-09_r8, 3.91409e-09_r8, 5.22349e-09_r8, 6.97093e-09_r8, 9.30295e-09_r8, & + & 1.24151e-08_r8, 1.65684e-08_r8, 2.21111e-08_r8, 2.95081e-08_r8, 3.93796e-08_r8, & + & 5.25535e-08_r8, 7.01346e-08_r8, 9.35970e-08_r8, 1.24908e-07_r8/) + kao_mn2o( 3, :,14) = (/ & + & 6.94564e-10_r8, 9.26928e-10_r8, 1.23703e-09_r8, 1.65088e-09_r8, 2.20317e-09_r8, & + & 2.94024e-09_r8, 3.92389e-09_r8, 5.23661e-09_r8, 6.98851e-09_r8, 9.32650e-09_r8, & + & 1.24467e-08_r8, 1.66107e-08_r8, 2.21677e-08_r8, 2.95839e-08_r8, 3.94811e-08_r8, & + & 5.26894e-08_r8, 7.03165e-08_r8, 9.38407e-08_r8, 1.25235e-07_r8/) + kao_mn2o( 4, :,14) = (/ & + & 6.98644e-10_r8, 9.32310e-10_r8, 1.24413e-09_r8, 1.66023e-09_r8, 2.21551e-09_r8, & + & 2.95649e-09_r8, 3.94531e-09_r8, 5.26484e-09_r8, 7.02570e-09_r8, 9.37548e-09_r8, & + & 1.25112e-08_r8, 1.66956e-08_r8, 2.22795e-08_r8, 2.97311e-08_r8, 3.96748e-08_r8, & + & 5.29443e-08_r8, 7.06518e-08_r8, 9.42817e-08_r8, 1.25815e-07_r8/) + kao_mn2o( 5, :,14) = (/ & + & 7.03261e-10_r8, 9.38472e-10_r8, 1.25235e-09_r8, 1.67121e-09_r8, 2.23016e-09_r8, & + & 2.97605e-09_r8, 3.97141e-09_r8, 5.29968e-09_r8, 7.07220e-09_r8, 9.43754e-09_r8, & + & 1.25940e-08_r8, 1.68062e-08_r8, 2.24271e-08_r8, 2.99280e-08_r8, 3.99376e-08_r8, & + & 5.32951e-08_r8, 7.11200e-08_r8, 9.49066e-08_r8, 1.26649e-07_r8/) + kao_mn2o( 6, :,14) = (/ & + & 7.12478e-10_r8, 9.50674e-10_r8, 1.26850e-09_r8, 1.69259e-09_r8, 2.25845e-09_r8, & + & 3.01350e-09_r8, 4.02096e-09_r8, 5.36525e-09_r8, 7.15896e-09_r8, 9.55233e-09_r8, & + & 1.27459e-08_r8, 1.70071e-08_r8, 2.26928e-08_r8, 3.02795e-08_r8, 4.04025e-08_r8, & + & 5.39099e-08_r8, 7.19330e-08_r8, 9.59815e-08_r8, 1.28070e-07_r8/) + kao_mn2o( 7, :,14) = (/ & + & 7.28994e-10_r8, 9.72644e-10_r8, 1.29773e-09_r8, 1.73147e-09_r8, 2.31017e-09_r8, & + & 3.08230e-09_r8, 4.11249e-09_r8, 5.48700e-09_r8, 7.32092e-09_r8, 9.76777e-09_r8, & + & 1.30324e-08_r8, 1.73883e-08_r8, 2.31999e-08_r8, 3.09540e-08_r8, 4.12996e-08_r8, & + & 5.51032e-08_r8, 7.35203e-08_r8, 9.80928e-08_r8, 1.30878e-07_r8/) + kao_mn2o( 8, :,14) = (/ & + & 7.87604e-10_r8, 1.05043e-09_r8, 1.40097e-09_r8, 1.86848e-09_r8, 2.49201e-09_r8, & + & 3.32360e-09_r8, 4.43271e-09_r8, 5.91194e-09_r8, 7.88479e-09_r8, 1.05160e-08_r8, & + & 1.40253e-08_r8, 1.87056e-08_r8, 2.49478e-08_r8, 3.32730e-08_r8, 4.43764e-08_r8, & + & 5.91851e-08_r8, 7.89356e-08_r8, 1.05277e-07_r8, 1.40408e-07_r8/) + kao_mn2o( 9, :,14) = (/ & + & 7.03261e-10_r8, 9.38472e-10_r8, 1.25235e-09_r8, 1.67121e-09_r8, 2.23016e-09_r8, & + & 2.97605e-09_r8, 3.97141e-09_r8, 5.29968e-09_r8, 7.07220e-09_r8, 9.43754e-09_r8, & + & 1.25940e-08_r8, 1.68062e-08_r8, 2.24271e-08_r8, 2.99280e-08_r8, 3.99376e-08_r8, & + & 5.32951e-08_r8, 7.11200e-08_r8, 9.49066e-08_r8, 1.26649e-07_r8/) + kao_mn2o( 1, :,15) = (/ & + & 2.14029e+01_r8, 2.16782e+01_r8, 2.19571e+01_r8, 2.22396e+01_r8, 2.25257e+01_r8, & + & 2.28155e+01_r8, 2.31090e+01_r8, 2.34063e+01_r8, 2.37074e+01_r8, 2.40124e+01_r8, & + & 2.43213e+01_r8, 2.46342e+01_r8, 2.49511e+01_r8, 2.52721e+01_r8, 2.55972e+01_r8, & + & 2.59265e+01_r8, 2.62600e+01_r8, 2.65979e+01_r8, 2.69400e+01_r8/) + kao_mn2o( 2, :,15) = (/ & + & 5.68659e-10_r8, 7.55629e-10_r8, 1.00407e-09_r8, 1.33421e-09_r8, 1.77288e-09_r8, & + & 2.35579e-09_r8, 3.13036e-09_r8, 4.15960e-09_r8, 5.52724e-09_r8, 7.34455e-09_r8, & + & 9.75939e-09_r8, 1.29682e-08_r8, 1.72320e-08_r8, 2.28978e-08_r8, 3.04264e-08_r8, & + & 4.04304e-08_r8, 5.37236e-08_r8, 7.13875e-08_r8, 9.48591e-08_r8/) + kao_mn2o( 3, :,15) = (/ & + & 5.59573e-10_r8, 7.43558e-10_r8, 9.88035e-10_r8, 1.31290e-09_r8, 1.74457e-09_r8, & + & 2.31817e-09_r8, 3.08037e-09_r8, 4.09318e-09_r8, 5.43900e-09_r8, 7.22730e-09_r8, & + & 9.60360e-09_r8, 1.27612e-08_r8, 1.69570e-08_r8, 2.25324e-08_r8, 2.99409e-08_r8, & + & 3.97853e-08_r8, 5.28665e-08_r8, 7.02486e-08_r8, 9.33459e-08_r8/) + kao_mn2o( 4, :,15) = (/ & + & 5.50488e-10_r8, 7.31486e-10_r8, 9.71996e-10_r8, 1.29158e-09_r8, 1.71625e-09_r8, & + & 2.28055e-09_r8, 3.03039e-09_r8, 4.02676e-09_r8, 5.35075e-09_r8, 7.11005e-09_r8, & + & 9.44781e-09_r8, 1.25542e-08_r8, 1.66820e-08_r8, 2.21670e-08_r8, 2.94554e-08_r8, & + & 3.91402e-08_r8, 5.20093e-08_r8, 6.91098e-08_r8, 9.18327e-08_r8/) + kao_mn2o( 5, :,15) = (/ & + & 5.34010e-10_r8, 7.09574e-10_r8, 9.42858e-10_r8, 1.25284e-09_r8, 1.66473e-09_r8, & + & 2.21203e-09_r8, 2.93927e-09_r8, 3.90560e-09_r8, 5.18963e-09_r8, 6.89580e-09_r8, & + & 9.16290e-09_r8, 1.21754e-08_r8, 1.61782e-08_r8, 2.14970e-08_r8, 2.85645e-08_r8, & + & 3.79555e-08_r8, 5.04340e-08_r8, 6.70149e-08_r8, 8.90470e-08_r8/) + kao_mn2o( 6, :,15) = (/ & + & 5.08144e-10_r8, 6.75221e-10_r8, 8.97231e-10_r8, 1.19224e-09_r8, 1.58424e-09_r8, & + & 2.10513e-09_r8, 2.79729e-09_r8, 3.71703e-09_r8, 4.93919e-09_r8, 6.56317e-09_r8, & + & 8.72112e-09_r8, 1.15886e-08_r8, 1.53989e-08_r8, 2.04620e-08_r8, 2.71898e-08_r8, & + & 3.61297e-08_r8, 4.80091e-08_r8, 6.37943e-08_r8, 8.47696e-08_r8/) + kao_mn2o( 7, :,15) = (/ & + & 4.56716e-10_r8, 6.06884e-10_r8, 8.06427e-10_r8, 1.07158e-09_r8, 1.42391e-09_r8, & + & 1.89210e-09_r8, 2.51422e-09_r8, 3.34089e-09_r8, 4.43938e-09_r8, 5.89904e-09_r8, & + & 7.83864e-09_r8, 1.04160e-08_r8, 1.38408e-08_r8, 1.83916e-08_r8, 2.44387e-08_r8, & + & 3.24742e-08_r8, 4.31517e-08_r8, 5.73399e-08_r8, 7.61932e-08_r8/) + kao_mn2o( 8, :,15) = (/ & + & 2.78366e-10_r8, 3.69881e-10_r8, 4.91482e-10_r8, 6.53061e-10_r8, 8.67760e-10_r8, & + & 1.15304e-09_r8, 1.53211e-09_r8, 2.03581e-09_r8, 2.70510e-09_r8, 3.59441e-09_r8, & + & 4.77611e-09_r8, 6.34629e-09_r8, 8.43268e-09_r8, 1.12050e-08_r8, 1.48887e-08_r8, & + & 1.97835e-08_r8, 2.62875e-08_r8, 3.49296e-08_r8, 4.64130e-08_r8/) + kao_mn2o( 9, :,15) = (/ & + & 5.34010e-10_r8, 7.09574e-10_r8, 9.42858e-10_r8, 1.25284e-09_r8, 1.66473e-09_r8, & + & 2.21203e-09_r8, 2.93927e-09_r8, 3.90560e-09_r8, 5.18963e-09_r8, 6.89580e-09_r8, & + & 9.16290e-09_r8, 1.21754e-08_r8, 1.61782e-08_r8, 2.14970e-08_r8, 2.85645e-08_r8, & + & 3.79555e-08_r8, 5.04340e-08_r8, 6.70149e-08_r8, 8.90470e-08_r8/) + kao_mn2o( 1, :,16) = (/ & + & 2.90784e+01_r8, 2.93787e+01_r8, 2.96820e+01_r8, 2.99885e+01_r8, 3.02982e+01_r8, & + & 3.06110e+01_r8, 3.09271e+01_r8, 3.12464e+01_r8, 3.15690e+01_r8, 3.18950e+01_r8, & + & 3.22243e+01_r8, 3.25571e+01_r8, 3.28932e+01_r8, 3.32329e+01_r8, 3.35760e+01_r8, & + & 3.39227e+01_r8, 3.42730e+01_r8, 3.46269e+01_r8, 3.49844e+01_r8/) + kao_mn2o( 2, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 3, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 4, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 5, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 6, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 7, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 8, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + kao_mn2o( 9, :,16) = (/ & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, & + & 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8, 0.00000e+00_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kbo_mn2o(:, 1) = (/ & + & 8.42688e-03_r8, 8.96787e-03_r8, 9.54358e-03_r8, 1.01563e-02_r8, 1.08083e-02_r8, & + & 1.15021e-02_r8, 1.22405e-02_r8, 1.30263e-02_r8, 1.38626e-02_r8, 1.47525e-02_r8, & + & 1.56996e-02_r8, 1.67075e-02_r8, 1.77800e-02_r8, 1.89215e-02_r8, 2.01362e-02_r8, & + & 2.14289e-02_r8, 2.28045e-02_r8, 2.42685e-02_r8, 2.58265e-02_r8/) + kbo_mn2o(:, 2) = (/ & + & 2.24976e-02_r8, 2.38935e-02_r8, 2.53762e-02_r8, 2.69508e-02_r8, 2.86231e-02_r8, & + & 3.03991e-02_r8, 3.22854e-02_r8, 3.42887e-02_r8, 3.64163e-02_r8, 3.86760e-02_r8, & + & 4.10759e-02_r8, 4.36246e-02_r8, 4.63315e-02_r8, 4.92064e-02_r8, 5.22597e-02_r8, & + & 5.55024e-02_r8, 5.89464e-02_r8, 6.26040e-02_r8, 6.64886e-02_r8/) + kbo_mn2o(:, 3) = (/ & + & 5.93542e-02_r8, 6.37312e-02_r8, 6.84310e-02_r8, 7.34774e-02_r8, 7.88960e-02_r8, & + & 8.47141e-02_r8, 9.09613e-02_r8, 9.76692e-02_r8, 1.04872e-01_r8, 1.12605e-01_r8, & + & 1.20910e-01_r8, 1.29826e-01_r8, 1.39400e-01_r8, 1.49680e-01_r8, 1.60718e-01_r8, & + & 1.72570e-01_r8, 1.85296e-01_r8, 1.98961e-01_r8, 2.13633e-01_r8/) + kbo_mn2o(:, 4) = (/ & + & 1.98022e-01_r8, 2.05895e-01_r8, 2.14082e-01_r8, 2.22594e-01_r8, 2.31445e-01_r8, & + & 2.40647e-01_r8, 2.50216e-01_r8, 2.60164e-01_r8, 2.70509e-01_r8, 2.81265e-01_r8, & + & 2.92448e-01_r8, 3.04076e-01_r8, 3.16167e-01_r8, 3.28738e-01_r8, 3.41809e-01_r8, & + & 3.55400e-01_r8, 3.69531e-01_r8, 3.84224e-01_r8, 3.99501e-01_r8/) + kbo_mn2o(:, 5) = (/ & + & 6.41413e-01_r8, 6.46239e-01_r8, 6.51101e-01_r8, 6.56000e-01_r8, 6.60936e-01_r8, & + & 6.65910e-01_r8, 6.70920e-01_r8, 6.75968e-01_r8, 6.81054e-01_r8, 6.86179e-01_r8, & + & 6.91342e-01_r8, 6.96544e-01_r8, 7.01785e-01_r8, 7.07065e-01_r8, 7.12385e-01_r8, & + & 7.17746e-01_r8, 7.23146e-01_r8, 7.28587e-01_r8, 7.34070e-01_r8/) + kbo_mn2o(:, 6) = (/ & + & 1.47906e+00_r8, 1.48768e+00_r8, 1.49635e+00_r8, 1.50507e+00_r8, 1.51384e+00_r8, & + & 1.52267e+00_r8, 1.53154e+00_r8, 1.54047e+00_r8, 1.54944e+00_r8, 1.55847e+00_r8, & + & 1.56755e+00_r8, 1.57669e+00_r8, 1.58588e+00_r8, 1.59512e+00_r8, 1.60442e+00_r8, & + & 1.61377e+00_r8, 1.62317e+00_r8, 1.63263e+00_r8, 1.64215e+00_r8/) + kbo_mn2o(:, 7) = (/ & + & 3.53152e+00_r8, 3.55492e+00_r8, 3.57848e+00_r8, 3.60219e+00_r8, 3.62606e+00_r8, & + & 3.65008e+00_r8, 3.67427e+00_r8, 3.69862e+00_r8, 3.72313e+00_r8, 3.74780e+00_r8, & + & 3.77263e+00_r8, 3.79763e+00_r8, 3.82279e+00_r8, 3.84812e+00_r8, 3.87362e+00_r8, & + & 3.89929e+00_r8, 3.92513e+00_r8, 3.95114e+00_r8, 3.97732e+00_r8/) + kbo_mn2o(:, 8) = (/ & + & 9.06783e+00_r8, 9.04597e+00_r8, 9.02415e+00_r8, 9.00239e+00_r8, 8.98069e+00_r8, & + & 8.95903e+00_r8, 8.93743e+00_r8, 8.91588e+00_r8, 8.89438e+00_r8, 8.87293e+00_r8, & + & 8.85154e+00_r8, 8.83020e+00_r8, 8.80890e+00_r8, 8.78766e+00_r8, 8.76647e+00_r8, & + & 8.74533e+00_r8, 8.72425e+00_r8, 8.70321e+00_r8, 8.68223e+00_r8/) + kbo_mn2o(:, 9) = (/ & + & 3.88220e+01_r8, 3.85805e+01_r8, 3.83405e+01_r8, 3.81019e+01_r8, 3.78649e+01_r8, & + & 3.76293e+01_r8, 3.73952e+01_r8, 3.71625e+01_r8, 3.69313e+01_r8, 3.67016e+01_r8, & + & 3.64732e+01_r8, 3.62463e+01_r8, 3.60208e+01_r8, 3.57967e+01_r8, 3.55740e+01_r8, & + & 3.53527e+01_r8, 3.51327e+01_r8, 3.49142e+01_r8, 3.46970e+01_r8/) + kbo_mn2o(:, 10) = (/ & + & 1.14211e+02_r8, 1.13955e+02_r8, 1.13700e+02_r8, 1.13445e+02_r8, 1.13191e+02_r8, & + & 1.12938e+02_r8, 1.12685e+02_r8, 1.12433e+02_r8, 1.12181e+02_r8, 1.11930e+02_r8, & + & 1.11679e+02_r8, 1.11429e+02_r8, 1.11180e+02_r8, 1.10931e+02_r8, 1.10682e+02_r8, & + & 1.10434e+02_r8, 1.10187e+02_r8, 1.09940e+02_r8, 1.09694e+02_r8/) + kbo_mn2o(:, 11) = (/ & + & 1.60513e+02_r8, 1.60857e+02_r8, 1.61201e+02_r8, 1.61547e+02_r8, 1.61893e+02_r8, & + & 1.62240e+02_r8, 1.62587e+02_r8, 1.62936e+02_r8, 1.63285e+02_r8, 1.63635e+02_r8, & + & 1.63985e+02_r8, 1.64337e+02_r8, 1.64689e+02_r8, 1.65041e+02_r8, 1.65395e+02_r8, & + & 1.65749e+02_r8, 1.66105e+02_r8, 1.66460e+02_r8, 1.66817e+02_r8/) + kbo_mn2o(:, 12) = (/ & + & 1.71473e+02_r8, 1.72766e+02_r8, 1.74068e+02_r8, 1.75381e+02_r8, 1.76703e+02_r8, & + & 1.78035e+02_r8, 1.79377e+02_r8, 1.80729e+02_r8, 1.82091e+02_r8, 1.83464e+02_r8, & + & 1.84847e+02_r8, 1.86240e+02_r8, 1.87644e+02_r8, 1.89059e+02_r8, 1.90484e+02_r8, & + & 1.91920e+02_r8, 1.93367e+02_r8, 1.94824e+02_r8, 1.96293e+02_r8/) + kbo_mn2o(:, 13) = (/ & + & 2.71287e+01_r8, 2.75538e+01_r8, 2.79856e+01_r8, 2.84241e+01_r8, 2.88695e+01_r8, & + & 2.93219e+01_r8, 2.97814e+01_r8, 3.02480e+01_r8, 3.07220e+01_r8, 3.12035e+01_r8, & + & 3.16924e+01_r8, 3.21890e+01_r8, 3.26934e+01_r8, 3.32058e+01_r8, 3.37261e+01_r8, & + & 3.42546e+01_r8, 3.47914e+01_r8, 3.53365e+01_r8, 3.58903e+01_r8/) + kbo_mn2o(:, 14) = (/ & + & 1.70389e+01_r8, 1.70899e+01_r8, 1.71411e+01_r8, 1.71924e+01_r8, 1.72439e+01_r8, & + & 1.72955e+01_r8, 1.73473e+01_r8, 1.73992e+01_r8, 1.74513e+01_r8, 1.75035e+01_r8, & + & 1.75559e+01_r8, 1.76085e+01_r8, 1.76612e+01_r8, 1.77141e+01_r8, 1.77671e+01_r8, & + & 1.78203e+01_r8, 1.78736e+01_r8, 1.79271e+01_r8, 1.79808e+01_r8/) + kbo_mn2o(:, 15) = (/ & + & 2.49725e+00_r8, 2.66861e+00_r8, 2.85174e+00_r8, 3.04743e+00_r8, 3.25655e+00_r8, & + & 3.48003e+00_r8, 3.71883e+00_r8, 3.97403e+00_r8, 4.24673e+00_r8, 4.53815e+00_r8, & + & 4.84957e+00_r8, 5.18236e+00_r8, 5.53798e+00_r8, 5.91801e+00_r8, 6.32412e+00_r8, & + & 6.75809e+00_r8, 7.22185e+00_r8, 7.71742e+00_r8, 8.24701e+00_r8/) + kbo_mn2o(:, 16) = (/ & + & 1.82935e-03_r8, 2.58912e-03_r8, 3.66444e-03_r8, 5.18637e-03_r8, 7.34039e-03_r8, & + & 1.03890e-02_r8, 1.47038e-02_r8, 2.08106e-02_r8, 2.94538e-02_r8, 4.16865e-02_r8, & + & 5.89999e-02_r8, 8.35040e-02_r8, 1.18185e-01_r8, 1.67270e-01_r8, 2.36741e-01_r8, & + & 3.35065e-01_r8, 4.74225e-01_r8, 6.71180e-01_r8, 9.49936e-01_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &7.5352e-06_r8,2.9812e-05_r8,1.4497e-04_r8,4.4006e-04_r8,1.0492e-03_r8,1.9676e-03_r8, & + &1.9989e-03_r8,1.9099e-03_r8,2.2121e-03_r8,2.4491e-03_r8,2.9573e-03_r8,2.6344e-03_r8, & + &3.0629e-03_r8,3.3547e-03_r8,5.0643e-03_r8,5.0642e-03_r8/) + forrefo(2,:) = (/ & + &6.6070e-06_r8,4.8618e-05_r8,3.1112e-04_r8,8.4235e-04_r8,1.4179e-03_r8,1.4315e-03_r8, & + &1.4685e-03_r8,1.6554e-03_r8,2.1171e-03_r8,2.3545e-03_r8,2.5165e-03_r8,2.7680e-03_r8, & + &2.6985e-03_r8,3.5345e-03_r8,4.2924e-03_r8,5.0712e-03_r8/) + forrefo(3,:) = (/ & + &6.5962e-06_r8,7.2595e-04_r8,1.3429e-03_r8,1.1675e-03_r8,9.8384e-04_r8,8.8787e-04_r8, & + &8.7557e-04_r8,8.0589e-04_r8,7.7024e-04_r8,8.7518e-04_r8,9.5213e-04_r8,9.0849e-04_r8, & + &1.2596e-03_r8,2.5106e-03_r8,3.9471e-03_r8,5.0742e-03_r8/) + forrefo(4,:) = (/ & + &3.6217e-04_r8,1.0709e-03_r8,1.0628e-03_r8,8.5640e-04_r8,8.9332e-04_r8,8.3372e-04_r8, & + &7.8539e-04_r8,8.2828e-04_r8,8.3329e-04_r8,8.5118e-04_r8,8.2878e-04_r8,6.8570e-04_r8, & + &6.3815e-04_r8,8.0648e-04_r8,2.3236e-03_r8,4.0321e-03_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 2.83453e-02_r8, 2.51439e-02_r8, 2.23040e-02_r8, 1.97849e-02_r8, 1.75503e-02_r8, & + & 1.55681e-02_r8, 1.38097e-02_r8, 1.22500e-02_r8, 1.08664e-02_r8, 9.63912e-03_r8/) + selfrefo(:, 2) = (/ & + & 3.05185e-02_r8, 2.72374e-02_r8, 2.43090e-02_r8, 2.16955e-02_r8, 1.93629e-02_r8, & + & 1.72811e-02_r8, 1.54232e-02_r8, 1.37650e-02_r8, 1.22851e-02_r8, 1.09643e-02_r8/) + selfrefo(:, 3) = (/ & + & 4.23833e-02_r8, 3.76250e-02_r8, 3.34010e-02_r8, 2.96512e-02_r8, 2.63223e-02_r8, & + & 2.33672e-02_r8, 2.07439e-02_r8, 1.84150e-02_r8, 1.63476e-02_r8, 1.45123e-02_r8/) + selfrefo(:, 4) = (/ & + & 5.76481e-02_r8, 5.13686e-02_r8, 4.57730e-02_r8, 4.07870e-02_r8, 3.63441e-02_r8, & + & 3.23851e-02_r8, 2.88574e-02_r8, 2.57140e-02_r8, 2.29130e-02_r8, 2.04171e-02_r8/) + selfrefo(:, 5) = (/ & + & 6.92255e-02_r8, 6.33521e-02_r8, 5.79770e-02_r8, 5.30580e-02_r8, 4.85563e-02_r8, & + & 4.44365e-02_r8, 4.06663e-02_r8, 3.72160e-02_r8, 3.40584e-02_r8, 3.11687e-02_r8/) + selfrefo(:, 6) = (/ & + & 6.07694e-02_r8, 5.94182e-02_r8, 5.80970e-02_r8, 5.68052e-02_r8, 5.55422e-02_r8, & + & 5.43072e-02_r8, 5.30997e-02_r8, 5.19190e-02_r8, 5.07646e-02_r8, 4.96358e-02_r8/) + selfrefo(:, 7) = (/ & + & 6.23749e-02_r8, 6.07744e-02_r8, 5.92150e-02_r8, 5.76956e-02_r8, 5.62152e-02_r8, & + & 5.47728e-02_r8, 5.33674e-02_r8, 5.19980e-02_r8, 5.06638e-02_r8, 4.93638e-02_r8/) + selfrefo(:, 8) = (/ & + & 6.90744e-02_r8, 6.61811e-02_r8, 6.34090e-02_r8, 6.07530e-02_r8, 5.82083e-02_r8, & + & 5.57702e-02_r8, 5.34342e-02_r8, 5.11960e-02_r8, 4.90516e-02_r8, 4.69970e-02_r8/) + selfrefo(:, 9) = (/ & + & 8.08992e-02_r8, 7.68876e-02_r8, 7.30750e-02_r8, 6.94514e-02_r8, 6.60075e-02_r8, & + & 6.27344e-02_r8, 5.96236e-02_r8, 5.66670e-02_r8, 5.38570e-02_r8, 5.11864e-02_r8/) + selfrefo(:,10) = (/ & + & 8.70197e-02_r8, 8.27485e-02_r8, 7.86870e-02_r8, 7.48248e-02_r8, 7.11522e-02_r8, & + & 6.76599e-02_r8, 6.43389e-02_r8, 6.11810e-02_r8, 5.81781e-02_r8, 5.53225e-02_r8/) + selfrefo(:,11) = (/ & + & 8.84776e-02_r8, 8.54262e-02_r8, 8.24800e-02_r8, 7.96354e-02_r8, 7.68890e-02_r8, & + & 7.42373e-02_r8, 7.16770e-02_r8, 6.92050e-02_r8, 6.68183e-02_r8, 6.45139e-02_r8/) + selfrefo(:,12) = (/ & + & 9.82552e-02_r8, 9.25696e-02_r8, 8.72130e-02_r8, 8.21664e-02_r8, 7.74118e-02_r8, & + & 7.29323e-02_r8, 6.87121e-02_r8, 6.47360e-02_r8, 6.09900e-02_r8, 5.74608e-02_r8/) + selfrefo(:,13) = (/ & + & 9.32447e-02_r8, 8.96818e-02_r8, 8.62550e-02_r8, 8.29592e-02_r8, 7.97893e-02_r8, & + & 7.67405e-02_r8, 7.38082e-02_r8, 7.09880e-02_r8, 6.82755e-02_r8, 6.56667e-02_r8/) + selfrefo(:,14) = (/ & + & 1.15363e-01_r8, 1.08593e-01_r8, 1.02220e-01_r8, 9.62210e-02_r8, 9.05741e-02_r8, & + & 8.52585e-02_r8, 8.02549e-02_r8, 7.55450e-02_r8, 7.11115e-02_r8, 6.69382e-02_r8/) + selfrefo(:,15) = (/ & + & 1.23179e-01_r8, 1.19247e-01_r8, 1.15440e-01_r8, 1.11755e-01_r8, 1.08187e-01_r8, & + & 1.04734e-01_r8, 1.01391e-01_r8, 9.81540e-02_r8, 9.50207e-02_r8, 9.19875e-02_r8/) + selfrefo(:,16) = (/ & + & 1.44104e-01_r8, 1.36412e-01_r8, 1.29130e-01_r8, 1.22237e-01_r8, 1.15712e-01_r8, & + & 1.09535e-01_r8, 1.03688e-01_r8, 9.81530e-02_r8, 9.29135e-02_r8, 8.79537e-02_r8/) + + end subroutine lw_kgb09 + +! ************************************************************************** + subroutine lw_kgb10 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg10, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 212.7250, T = 223.06 K + fracrefao(:) = (/ & + & 1.6909e-01_r8, 1.5419e-01_r8, 1.3999e-01_r8, 1.2637e-01_r8, & + & 1.1429e-01_r8, 9.9676e-02_r8, 8.0093e-02_r8, 6.0283e-02_r8, & + & 4.1077e-02_r8, 4.4857e-03_r8, 3.6545e-03_r8, 2.9243e-03_r8, & + & 2.0407e-03_r8, 1.2891e-03_r8, 4.8767e-04_r8, 6.7748e-05_r8/) + +! Planck fraction mapping level : P = 95.58350 mb, T = 215.70 K + fracrefbo(:) = (/ & + & 1.7391e-01_r8, 1.5680e-01_r8, 1.4419e-01_r8, 1.2672e-01_r8, & + & 1.0708e-01_r8, 9.7034e-02_r8, 7.8545e-02_r8, 5.9784e-02_r8, & + & 4.0879e-02_r8, 4.4704e-03_r8, 3.7150e-03_r8, 2.9038e-03_r8, & + & 2.1454e-03_r8, 1.2802e-03_r8, 4.8328e-04_r8, 6.7378e-05_r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &2.7213e-02_r8,2.9029e-02_r8,3.0838e-02_r8,3.2767e-02_r8,3.4630e-02_r8/) + kao(:, 2, 1) = (/ & + &2.1383e-02_r8,2.2832e-02_r8,2.4365e-02_r8,2.5925e-02_r8,2.7376e-02_r8/) + kao(:, 3, 1) = (/ & + &1.6478e-02_r8,1.7675e-02_r8,1.8942e-02_r8,2.0177e-02_r8,2.1374e-02_r8/) + kao(:, 4, 1) = (/ & + &1.2848e-02_r8,1.3809e-02_r8,1.4825e-02_r8,1.5852e-02_r8,1.6799e-02_r8/) + kao(:, 5, 1) = (/ & + &1.0029e-02_r8,1.0847e-02_r8,1.1686e-02_r8,1.2512e-02_r8,1.3297e-02_r8/) + kao(:, 6, 1) = (/ & + &7.8313e-03_r8,8.5460e-03_r8,9.2025e-03_r8,9.9079e-03_r8,1.0554e-02_r8/) + kao(:, 7, 1) = (/ & + &6.1234e-03_r8,6.6846e-03_r8,7.2818e-03_r8,7.8451e-03_r8,8.4144e-03_r8/) + kao(:, 8, 1) = (/ & + &4.8747e-03_r8,5.2881e-03_r8,5.7474e-03_r8,6.2355e-03_r8,6.7085e-03_r8/) + kao(:, 9, 1) = (/ & + &4.1059e-03_r8,4.5848e-03_r8,4.9152e-03_r8,5.2401e-03_r8,5.5908e-03_r8/) + kao(:,10, 1) = (/ & + &3.5412e-03_r8,4.0565e-03_r8,4.5689e-03_r8,5.1092e-03_r8,5.6716e-03_r8/) + kao(:,11, 1) = (/ & + &3.0492e-03_r8,3.6436e-03_r8,4.0799e-03_r8,4.5260e-03_r8,4.9802e-03_r8/) + kao(:,12, 1) = (/ & + &2.5821e-03_r8,3.0995e-03_r8,3.5069e-03_r8,3.8699e-03_r8,4.2575e-03_r8/) + kao(:,13, 1) = (/ & + &2.1558e-03_r8,2.5890e-03_r8,2.9127e-03_r8,3.2139e-03_r8,3.5455e-03_r8/) + kao(:, 1, 2) = (/ & + &5.2889e-02_r8,5.6315e-02_r8,5.9927e-02_r8,6.3408e-02_r8,6.6329e-02_r8/) + kao(:, 2, 2) = (/ & + &4.1932e-02_r8,4.4934e-02_r8,4.8030e-02_r8,5.0855e-02_r8,5.3372e-02_r8/) + kao(:, 3, 2) = (/ & + &3.2754e-02_r8,3.5198e-02_r8,3.7786e-02_r8,4.0294e-02_r8,4.2438e-02_r8/) + kao(:, 4, 2) = (/ & + &2.5838e-02_r8,2.7680e-02_r8,2.9873e-02_r8,3.1963e-02_r8,3.3931e-02_r8/) + kao(:, 5, 2) = (/ & + &2.0528e-02_r8,2.2079e-02_r8,2.3740e-02_r8,2.5501e-02_r8,2.7219e-02_r8/) + kao(:, 6, 2) = (/ & + &1.6350e-02_r8,1.7491e-02_r8,1.8902e-02_r8,2.0280e-02_r8,2.1774e-02_r8/) + kao(:, 7, 2) = (/ & + &1.2732e-02_r8,1.3953e-02_r8,1.5005e-02_r8,1.6145e-02_r8,1.7323e-02_r8/) + kao(:, 8, 2) = (/ & + &9.7464e-03_r8,1.1159e-02_r8,1.2150e-02_r8,1.2940e-02_r8,1.3856e-02_r8/) + kao(:, 9, 2) = (/ & + &7.5337e-03_r8,8.5370e-03_r8,9.6841e-03_r8,1.0825e-02_r8,1.1894e-02_r8/) + kao(:,10, 2) = (/ & + &7.1476e-03_r8,7.8468e-03_r8,8.6104e-03_r8,9.4234e-03_r8,1.0165e-02_r8/) + kao(:,11, 2) = (/ & + &7.4726e-03_r8,7.8619e-03_r8,8.4110e-03_r8,8.8097e-03_r8,9.3621e-03_r8/) + kao(:,12, 2) = (/ & + &6.8212e-03_r8,7.3104e-03_r8,7.6521e-03_r8,8.0570e-03_r8,8.3782e-03_r8/) + kao(:,13, 2) = (/ & + &5.7626e-03_r8,6.1115e-03_r8,6.3578e-03_r8,6.6833e-03_r8,6.9834e-03_r8/) + kao(:, 1, 3) = (/ & + &9.2909e-02_r8,9.6713e-02_r8,9.9436e-02_r8,1.0242e-01_r8,1.0613e-01_r8/) + kao(:, 2, 3) = (/ & + &7.4548e-02_r8,7.7785e-02_r8,8.0363e-02_r8,8.2840e-02_r8,8.6028e-02_r8/) + kao(:, 3, 3) = (/ & + &5.8714e-02_r8,6.1823e-02_r8,6.4284e-02_r8,6.6702e-02_r8,6.9231e-02_r8/) + kao(:, 4, 3) = (/ & + &4.6349e-02_r8,4.9440e-02_r8,5.1743e-02_r8,5.3890e-02_r8,5.5994e-02_r8/) + kao(:, 5, 3) = (/ & + &3.6507e-02_r8,3.9309e-02_r8,4.1637e-02_r8,4.3586e-02_r8,4.5365e-02_r8/) + kao(:, 6, 3) = (/ & + &2.8427e-02_r8,3.1177e-02_r8,3.3328e-02_r8,3.5180e-02_r8,3.6733e-02_r8/) + kao(:, 7, 3) = (/ & + &2.2397e-02_r8,2.4640e-02_r8,2.6638e-02_r8,2.8311e-02_r8,2.9747e-02_r8/) + kao(:, 8, 3) = (/ & + &1.7861e-02_r8,1.9252e-02_r8,2.1033e-02_r8,2.2648e-02_r8,2.3985e-02_r8/) + kao(:, 9, 3) = (/ & + &1.4398e-02_r8,1.5884e-02_r8,1.6962e-02_r8,1.7935e-02_r8,1.8840e-02_r8/) + kao(:,10, 3) = (/ & + &1.3336e-02_r8,1.5085e-02_r8,1.6848e-02_r8,1.8578e-02_r8,1.9024e-02_r8/) + kao(:,11, 3) = (/ & + &1.0996e-02_r8,1.2680e-02_r8,1.4233e-02_r8,1.6184e-02_r8,1.7835e-02_r8/) + kao(:,12, 3) = (/ & + &9.6066e-03_r8,1.0608e-02_r8,1.2101e-02_r8,1.3713e-02_r8,1.5338e-02_r8/) + kao(:,13, 3) = (/ & + &8.0007e-03_r8,8.9344e-03_r8,1.0260e-02_r8,1.1651e-02_r8,1.2914e-02_r8/) + kao(:, 1, 4) = (/ & + &1.4098e-01_r8,1.4735e-01_r8,1.5390e-01_r8,1.6007e-01_r8,1.6623e-01_r8/) + kao(:, 2, 4) = (/ & + &1.1373e-01_r8,1.1930e-01_r8,1.2491e-01_r8,1.3057e-01_r8,1.3593e-01_r8/) + kao(:, 3, 4) = (/ & + &9.0856e-02_r8,9.5503e-02_r8,1.0012e-01_r8,1.0479e-01_r8,1.0971e-01_r8/) + kao(:, 4, 4) = (/ & + &7.2695e-02_r8,7.6746e-02_r8,8.0662e-02_r8,8.4622e-02_r8,8.8881e-02_r8/) + kao(:, 5, 4) = (/ & + &5.8402e-02_r8,6.1962e-02_r8,6.5265e-02_r8,6.8694e-02_r8,7.2371e-02_r8/) + kao(:, 6, 4) = (/ & + &4.7100e-02_r8,5.0100e-02_r8,5.2955e-02_r8,5.5897e-02_r8,5.9012e-02_r8/) + kao(:, 7, 4) = (/ & + &3.7714e-02_r8,4.0303e-02_r8,4.2858e-02_r8,4.5396e-02_r8,4.8032e-02_r8/) + kao(:, 8, 4) = (/ & + &2.9938e-02_r8,3.2418e-02_r8,3.4599e-02_r8,3.6801e-02_r8,3.9055e-02_r8/) + kao(:, 9, 4) = (/ & + &2.3570e-02_r8,2.5475e-02_r8,2.7580e-02_r8,2.9598e-02_r8,3.1549e-02_r8/) + kao(:,10, 4) = (/ & + &2.3291e-02_r8,2.1658e-02_r8,2.1418e-02_r8,2.1490e-02_r8,2.3536e-02_r8/) + kao(:,11, 4) = (/ & + &2.1808e-02_r8,2.2150e-02_r8,2.2833e-02_r8,2.0354e-02_r8,1.9688e-02_r8/) + kao(:,12, 4) = (/ & + &1.9246e-02_r8,1.9438e-02_r8,1.9839e-02_r8,2.0164e-02_r8,1.7716e-02_r8/) + kao(:,13, 4) = (/ & + &1.6236e-02_r8,1.6164e-02_r8,1.6551e-02_r8,1.6579e-02_r8,1.4849e-02_r8/) + kao(:, 1, 5) = (/ & + &2.5886e-01_r8,2.7100e-01_r8,2.8220e-01_r8,2.9245e-01_r8,3.0214e-01_r8/) + kao(:, 2, 5) = (/ & + &2.0909e-01_r8,2.1918e-01_r8,2.2861e-01_r8,2.3740e-01_r8,2.4610e-01_r8/) + kao(:, 3, 5) = (/ & + &1.6622e-01_r8,1.7497e-01_r8,1.8311e-01_r8,1.9088e-01_r8,1.9860e-01_r8/) + kao(:, 4, 5) = (/ & + &1.3301e-01_r8,1.4069e-01_r8,1.4792e-01_r8,1.5478e-01_r8,1.6132e-01_r8/) + kao(:, 5, 5) = (/ & + &1.0688e-01_r8,1.1355e-01_r8,1.1989e-01_r8,1.2584e-01_r8,1.3154e-01_r8/) + kao(:, 6, 5) = (/ & + &8.5419e-02_r8,9.1274e-02_r8,9.6848e-02_r8,1.0202e-01_r8,1.0704e-01_r8/) + kao(:, 7, 5) = (/ & + &6.8100e-02_r8,7.3262e-02_r8,7.8047e-02_r8,8.2594e-02_r8,8.7027e-02_r8/) + kao(:, 8, 5) = (/ & + &5.4252e-02_r8,5.8815e-02_r8,6.2989e-02_r8,6.6937e-02_r8,7.0783e-02_r8/) + kao(:, 9, 5) = (/ & + &4.3117e-02_r8,4.7224e-02_r8,5.0916e-02_r8,5.4328e-02_r8,5.7817e-02_r8/) + kao(:,10, 5) = (/ & + &2.9151e-02_r8,3.5667e-02_r8,4.0092e-02_r8,4.3888e-02_r8,4.6870e-02_r8/) + kao(:,11, 5) = (/ & + &2.3941e-02_r8,2.7450e-02_r8,2.9750e-02_r8,3.5348e-02_r8,3.9440e-02_r8/) + kao(:,12, 5) = (/ & + &2.0570e-02_r8,2.3238e-02_r8,2.5236e-02_r8,2.7327e-02_r8,3.2816e-02_r8/) + kao(:,13, 5) = (/ & + &1.7253e-02_r8,1.9755e-02_r8,2.1401e-02_r8,2.3591e-02_r8,2.8114e-02_r8/) + kao(:, 1, 6) = (/ & + &5.6993e-01_r8,6.0360e-01_r8,6.3489e-01_r8,6.6230e-01_r8,6.8659e-01_r8/) + kao(:, 2, 6) = (/ & + &4.6502e-01_r8,4.9401e-01_r8,5.2007e-01_r8,5.4304e-01_r8,5.6306e-01_r8/) + kao(:, 3, 6) = (/ & + &3.7271e-01_r8,3.9757e-01_r8,4.1967e-01_r8,4.3927e-01_r8,4.5631e-01_r8/) + kao(:, 4, 6) = (/ & + &2.9874e-01_r8,3.1990e-01_r8,3.3890e-01_r8,3.5594e-01_r8,3.7139e-01_r8/) + kao(:, 5, 6) = (/ & + &2.3859e-01_r8,2.5711e-01_r8,2.7375e-01_r8,2.8893e-01_r8,3.0280e-01_r8/) + kao(:, 6, 6) = (/ & + &1.8917e-01_r8,2.0549e-01_r8,2.2017e-01_r8,2.3369e-01_r8,2.4611e-01_r8/) + kao(:, 7, 6) = (/ & + &1.4938e-01_r8,1.6367e-01_r8,1.7681e-01_r8,1.8887e-01_r8,1.9989e-01_r8/) + kao(:, 8, 6) = (/ & + &1.1758e-01_r8,1.3011e-01_r8,1.4157e-01_r8,1.5226e-01_r8,1.6197e-01_r8/) + kao(:, 9, 6) = (/ & + &9.1609e-02_r8,1.0230e-01_r8,1.1226e-01_r8,1.2154e-01_r8,1.2990e-01_r8/) + kao(:,10, 6) = (/ & + &7.2629e-02_r8,8.2527e-02_r8,9.1786e-02_r8,1.0065e-01_r8,1.0832e-01_r8/) + kao(:,11, 6) = (/ & + &6.0173e-02_r8,6.9095e-02_r8,7.8339e-02_r8,8.6340e-02_r8,9.2996e-02_r8/) + kao(:,12, 6) = (/ & + &5.1074e-02_r8,5.9514e-02_r8,6.6969e-02_r8,7.3447e-02_r8,7.9277e-02_r8/) + kao(:,13, 6) = (/ & + &4.3826e-02_r8,5.0848e-02_r8,5.7125e-02_r8,6.2916e-02_r8,6.7915e-02_r8/) + kao(:, 1, 7) = (/ & + &1.4129e+00_r8,1.4750e+00_r8,1.5277e+00_r8,1.5727e+00_r8,1.6117e+00_r8/) + kao(:, 2, 7) = (/ & + &1.1749e+00_r8,1.2287e+00_r8,1.2750e+00_r8,1.3159e+00_r8,1.3523e+00_r8/) + kao(:, 3, 7) = (/ & + &9.5348e-01_r8,1.0008e+00_r8,1.0433e+00_r8,1.0822e+00_r8,1.1168e+00_r8/) + kao(:, 4, 7) = (/ & + &7.6995e-01_r8,8.1381e-01_r8,8.5421e-01_r8,8.9012e-01_r8,9.2111e-01_r8/) + kao(:, 5, 7) = (/ & + &6.2211e-01_r8,6.6255e-01_r8,6.9934e-01_r8,7.3149e-01_r8,7.5879e-01_r8/) + kao(:, 6, 7) = (/ & + &5.0056e-01_r8,5.3742e-01_r8,5.7038e-01_r8,5.9882e-01_r8,6.2305e-01_r8/) + kao(:, 7, 7) = (/ & + &4.0115e-01_r8,4.3352e-01_r8,4.6244e-01_r8,4.8765e-01_r8,5.0920e-01_r8/) + kao(:, 8, 7) = (/ & + &3.1902e-01_r8,3.4754e-01_r8,3.7305e-01_r8,3.9544e-01_r8,4.1482e-01_r8/) + kao(:, 9, 7) = (/ & + &2.5207e-01_r8,2.7718e-01_r8,2.9962e-01_r8,3.1933e-01_r8,3.3666e-01_r8/) + kao(:,10, 7) = (/ & + &1.9498e-01_r8,2.1588e-01_r8,2.3464e-01_r8,2.5127e-01_r8,2.6668e-01_r8/) + kao(:,11, 7) = (/ & + &1.6583e-01_r8,1.8332e-01_r8,1.9835e-01_r8,2.1191e-01_r8,2.2523e-01_r8/) + kao(:,12, 7) = (/ & + &1.3827e-01_r8,1.5202e-01_r8,1.6547e-01_r8,1.7854e-01_r8,1.8991e-01_r8/) + kao(:,13, 7) = (/ & + &1.1534e-01_r8,1.2733e-01_r8,1.3962e-01_r8,1.4987e-01_r8,1.6008e-01_r8/) + kao(:, 1, 8) = (/ & + &3.5920e+00_r8,3.7800e+00_r8,3.9524e+00_r8,4.1109e+00_r8,4.2529e+00_r8/) + kao(:, 2, 8) = (/ & + &3.2111e+00_r8,3.3886e+00_r8,3.5521e+00_r8,3.6948e+00_r8,3.8225e+00_r8/) + kao(:, 3, 8) = (/ & + &2.7787e+00_r8,2.9477e+00_r8,3.0955e+00_r8,3.2271e+00_r8,3.3442e+00_r8/) + kao(:, 4, 8) = (/ & + &2.3588e+00_r8,2.5119e+00_r8,2.6472e+00_r8,2.7686e+00_r8,2.8775e+00_r8/) + kao(:, 5, 8) = (/ & + &1.9705e+00_r8,2.1082e+00_r8,2.2326e+00_r8,2.3452e+00_r8,2.4470e+00_r8/) + kao(:, 6, 8) = (/ & + &1.6168e+00_r8,1.7418e+00_r8,1.8565e+00_r8,1.9616e+00_r8,2.0551e+00_r8/) + kao(:, 7, 8) = (/ & + &1.3089e+00_r8,1.4235e+00_r8,1.5288e+00_r8,1.6233e+00_r8,1.7079e+00_r8/) + kao(:, 8, 8) = (/ & + &1.0505e+00_r8,1.1539e+00_r8,1.2478e+00_r8,1.3319e+00_r8,1.4095e+00_r8/) + kao(:, 9, 8) = (/ & + &8.3583e-01_r8,9.2738e-01_r8,1.0101e+00_r8,1.0861e+00_r8,1.1567e+00_r8/) + kao(:,10, 8) = (/ & + &6.6552e-01_r8,7.4516e-01_r8,8.1795e-01_r8,8.8505e-01_r8,9.4596e-01_r8/) + kao(:,11, 8) = (/ & + &5.5048e-01_r8,6.1499e-01_r8,6.7571e-01_r8,7.3145e-01_r8,7.8064e-01_r8/) + kao(:,12, 8) = (/ & + &4.5804e-01_r8,5.1260e-01_r8,5.6222e-01_r8,6.0624e-01_r8,6.4709e-01_r8/) + kao(:,13, 8) = (/ & + &3.8513e-01_r8,4.3049e-01_r8,4.7109e-01_r8,5.0795e-01_r8,5.3980e-01_r8/) + kao(:, 1, 9) = (/ & + &1.0443e+01_r8,1.1048e+01_r8,1.1589e+01_r8,1.2078e+01_r8,1.2523e+01_r8/) + kao(:, 2, 9) = (/ & + &1.0305e+01_r8,1.0938e+01_r8,1.1513e+01_r8,1.2045e+01_r8,1.2531e+01_r8/) + kao(:, 3, 9) = (/ & + &9.8576e+00_r8,1.0529e+01_r8,1.1150e+01_r8,1.1712e+01_r8,1.2221e+01_r8/) + kao(:, 4, 9) = (/ & + &9.2371e+00_r8,9.9233e+00_r8,1.0551e+01_r8,1.1124e+01_r8,1.1647e+01_r8/) + kao(:, 5, 9) = (/ & + &8.4700e+00_r8,9.1602e+00_r8,9.7951e+00_r8,1.0380e+01_r8,1.0911e+01_r8/) + kao(:, 6, 9) = (/ & + &7.5880e+00_r8,8.2763e+00_r8,8.9154e+00_r8,9.5007e+00_r8,1.0024e+01_r8/) + kao(:, 7, 9) = (/ & + &6.6790e+00_r8,7.3503e+00_r8,7.9748e+00_r8,8.5357e+00_r8,9.0412e+00_r8/) + kao(:, 8, 9) = (/ & + &5.7712e+00_r8,6.4120e+00_r8,7.0009e+00_r8,7.5325e+00_r8,8.0088e+00_r8/) + kao(:, 9, 9) = (/ & + &4.8989e+00_r8,5.4909e+00_r8,6.0328e+00_r8,6.5241e+00_r8,6.9680e+00_r8/) + kao(:,10, 9) = (/ & + &4.1164e+00_r8,4.6491e+00_r8,5.1402e+00_r8,5.5886e+00_r8,6.0036e+00_r8/) + kao(:,11, 9) = (/ & + &3.6151e+00_r8,4.0753e+00_r8,4.5022e+00_r8,4.8994e+00_r8,5.2546e+00_r8/) + kao(:,12, 9) = (/ & + &3.1350e+00_r8,3.5329e+00_r8,3.9073e+00_r8,4.2435e+00_r8,4.5415e+00_r8/) + kao(:,13, 9) = (/ & + &2.6929e+00_r8,3.0365e+00_r8,3.3480e+00_r8,3.6295e+00_r8,3.8842e+00_r8/) + kao(:, 1,10) = (/ & + &1.9924e+01_r8,2.0919e+01_r8,2.2000e+01_r8,2.2972e+01_r8,2.3773e+01_r8/) + kao(:, 2,10) = (/ & + &2.0689e+01_r8,2.1909e+01_r8,2.3034e+01_r8,2.3987e+01_r8,2.4788e+01_r8/) + kao(:, 3,10) = (/ & + &2.0776e+01_r8,2.2053e+01_r8,2.3211e+01_r8,2.4276e+01_r8,2.5292e+01_r8/) + kao(:, 4,10) = (/ & + &2.0236e+01_r8,2.1839e+01_r8,2.3315e+01_r8,2.4662e+01_r8,2.5879e+01_r8/) + kao(:, 5,10) = (/ & + &1.9987e+01_r8,2.1808e+01_r8,2.3390e+01_r8,2.4727e+01_r8,2.5958e+01_r8/) + kao(:, 6,10) = (/ & + &1.9523e+01_r8,2.1285e+01_r8,2.2798e+01_r8,2.4193e+01_r8,2.5643e+01_r8/) + kao(:, 7,10) = (/ & + &1.8326e+01_r8,2.0057e+01_r8,2.1638e+01_r8,2.3310e+01_r8,2.4996e+01_r8/) + kao(:, 8,10) = (/ & + &1.6812e+01_r8,1.8592e+01_r8,2.0423e+01_r8,2.2320e+01_r8,2.4092e+01_r8/) + kao(:, 9,10) = (/ & + &1.5126e+01_r8,1.7059e+01_r8,1.9069e+01_r8,2.1023e+01_r8,2.2713e+01_r8/) + kao(:,10,10) = (/ & + &1.3603e+01_r8,1.5643e+01_r8,1.7659e+01_r8,1.9476e+01_r8,2.1017e+01_r8/) + kao(:,11,10) = (/ & + &1.3136e+01_r8,1.5065e+01_r8,1.6788e+01_r8,1.8298e+01_r8,1.9745e+01_r8/) + kao(:,12,10) = (/ & + &1.2291e+01_r8,1.3925e+01_r8,1.5389e+01_r8,1.6819e+01_r8,1.8254e+01_r8/) + kao(:,13,10) = (/ & + &1.1103e+01_r8,1.2502e+01_r8,1.3897e+01_r8,1.5277e+01_r8,1.6528e+01_r8/) + kao(:, 1,11) = (/ & + &2.4296e+01_r8,2.5293e+01_r8,2.6167e+01_r8,2.7129e+01_r8,2.8181e+01_r8/) + kao(:, 2,11) = (/ & + &2.5960e+01_r8,2.7094e+01_r8,2.8248e+01_r8,2.9459e+01_r8,3.0485e+01_r8/) + kao(:, 3,11) = (/ & + &2.6865e+01_r8,2.8307e+01_r8,2.9751e+01_r8,3.1102e+01_r8,3.2279e+01_r8/) + kao(:, 4,11) = (/ & + &2.7354e+01_r8,2.8995e+01_r8,3.0628e+01_r8,3.2100e+01_r8,3.3421e+01_r8/) + kao(:, 5,11) = (/ & + &2.6969e+01_r8,2.8892e+01_r8,3.0767e+01_r8,3.2621e+01_r8,3.4273e+01_r8/) + kao(:, 6,11) = (/ & + &2.6094e+01_r8,2.8469e+01_r8,3.0801e+01_r8,3.2980e+01_r8,3.4919e+01_r8/) + kao(:, 7,11) = (/ & + &2.5366e+01_r8,2.8149e+01_r8,3.0864e+01_r8,3.3154e+01_r8,3.5069e+01_r8/) + kao(:, 8,11) = (/ & + &2.4570e+01_r8,2.7568e+01_r8,3.0172e+01_r8,3.2348e+01_r8,3.4412e+01_r8/) + kao(:, 9,11) = (/ & + &2.3141e+01_r8,2.6027e+01_r8,2.8564e+01_r8,3.0892e+01_r8,3.3292e+01_r8/) + kao(:,10,11) = (/ & + &2.1375e+01_r8,2.4163e+01_r8,2.6748e+01_r8,2.9381e+01_r8,3.2113e+01_r8/) + kao(:,11,11) = (/ & + &2.0563e+01_r8,2.3343e+01_r8,2.6200e+01_r8,2.9082e+01_r8,3.1737e+01_r8/) + kao(:,12,11) = (/ & + &1.9759e+01_r8,2.2669e+01_r8,2.5592e+01_r8,2.8225e+01_r8,3.0484e+01_r8/) + kao(:,13,11) = (/ & + &1.9005e+01_r8,2.1823e+01_r8,2.4335e+01_r8,2.6560e+01_r8,2.8649e+01_r8/) + kao(:, 1,12) = (/ & + &2.8554e+01_r8,3.0109e+01_r8,3.1534e+01_r8,3.2820e+01_r8,3.3912e+01_r8/) + kao(:, 2,12) = (/ & + &3.1883e+01_r8,3.3547e+01_r8,3.5069e+01_r8,3.6425e+01_r8,3.7803e+01_r8/) + kao(:, 3,12) = (/ & + &3.5025e+01_r8,3.6824e+01_r8,3.8424e+01_r8,3.9924e+01_r8,4.1396e+01_r8/) + kao(:, 4,12) = (/ & + &3.7112e+01_r8,3.9231e+01_r8,4.1147e+01_r8,4.2932e+01_r8,4.4646e+01_r8/) + kao(:, 5,12) = (/ & + &3.8447e+01_r8,4.0861e+01_r8,4.3125e+01_r8,4.5199e+01_r8,4.7297e+01_r8/) + kao(:, 6,12) = (/ & + &3.8994e+01_r8,4.1741e+01_r8,4.4237e+01_r8,4.6637e+01_r8,4.8930e+01_r8/) + kao(:, 7,12) = (/ & + &3.8693e+01_r8,4.1674e+01_r8,4.4392e+01_r8,4.7287e+01_r8,5.0041e+01_r8/) + kao(:, 8,12) = (/ & + &3.7231e+01_r8,4.0534e+01_r8,4.3968e+01_r8,4.7486e+01_r8,5.0745e+01_r8/) + kao(:, 9,12) = (/ & + &3.5314e+01_r8,3.9308e+01_r8,4.3458e+01_r8,4.7418e+01_r8,5.1164e+01_r8/) + kao(:,10,12) = (/ & + &3.3674e+01_r8,3.8340e+01_r8,4.2937e+01_r8,4.7301e+01_r8,5.1085e+01_r8/) + kao(:,11,12) = (/ & + &3.4306e+01_r8,3.9228e+01_r8,4.3781e+01_r8,4.7771e+01_r8,5.1424e+01_r8/) + kao(:,12,12) = (/ & + &3.4432e+01_r8,3.9064e+01_r8,4.3274e+01_r8,4.7292e+01_r8,5.1289e+01_r8/) + kao(:,13,12) = (/ & + &3.3504e+01_r8,3.7950e+01_r8,4.2337e+01_r8,4.6726e+01_r8,5.1022e+01_r8/) + kao(:, 1,13) = (/ & + &3.3083e+01_r8,3.5231e+01_r8,3.7169e+01_r8,3.8902e+01_r8,4.0496e+01_r8/) + kao(:, 2,13) = (/ & + &3.7816e+01_r8,4.0283e+01_r8,4.2419e+01_r8,4.4328e+01_r8,4.6116e+01_r8/) + kao(:, 3,13) = (/ & + &4.2916e+01_r8,4.5668e+01_r8,4.8087e+01_r8,5.0367e+01_r8,5.2460e+01_r8/) + kao(:, 4,13) = (/ & + &4.7941e+01_r8,5.0937e+01_r8,5.3613e+01_r8,5.6174e+01_r8,5.8534e+01_r8/) + kao(:, 5,13) = (/ & + &5.2708e+01_r8,5.6040e+01_r8,5.9163e+01_r8,6.2033e+01_r8,6.4593e+01_r8/) + kao(:, 6,13) = (/ & + &5.6670e+01_r8,6.0546e+01_r8,6.4072e+01_r8,6.7245e+01_r8,7.0176e+01_r8/) + kao(:, 7,13) = (/ & + &5.9263e+01_r8,6.3946e+01_r8,6.8113e+01_r8,7.1753e+01_r8,7.5271e+01_r8/) + kao(:, 8,13) = (/ & + &6.0990e+01_r8,6.6317e+01_r8,7.1009e+01_r8,7.5310e+01_r8,7.9458e+01_r8/) + kao(:, 9,13) = (/ & + &6.1500e+01_r8,6.7310e+01_r8,7.2473e+01_r8,7.7444e+01_r8,8.1955e+01_r8/) + kao(:,10,13) = (/ & + &6.1095e+01_r8,6.7188e+01_r8,7.2950e+01_r8,7.8366e+01_r8,8.3528e+01_r8/) + kao(:,11,13) = (/ & + &6.2204e+01_r8,6.8688e+01_r8,7.5122e+01_r8,8.1365e+01_r8,8.7577e+01_r8/) + kao(:,12,13) = (/ & + &6.2610e+01_r8,7.0078e+01_r8,7.7313e+01_r8,8.4495e+01_r8,9.1274e+01_r8/) + kao(:,13,13) = (/ & + &6.3252e+01_r8,7.1343e+01_r8,7.9418e+01_r8,8.6956e+01_r8,9.3893e+01_r8/) + kao(:, 1,14) = (/ & + &4.3344e+01_r8,4.5304e+01_r8,4.7200e+01_r8,4.8977e+01_r8,5.0634e+01_r8/) + kao(:, 2,14) = (/ & + &4.8672e+01_r8,5.1219e+01_r8,5.3748e+01_r8,5.6207e+01_r8,5.8584e+01_r8/) + kao(:, 3,14) = (/ & + &5.3835e+01_r8,5.7385e+01_r8,6.0811e+01_r8,6.4094e+01_r8,6.7183e+01_r8/) + kao(:, 4,14) = (/ & + &5.9051e+01_r8,6.3463e+01_r8,6.7847e+01_r8,7.2047e+01_r8,7.6005e+01_r8/) + kao(:, 5,14) = (/ & + &6.4910e+01_r8,7.0372e+01_r8,7.5734e+01_r8,8.0867e+01_r8,8.5466e+01_r8/) + kao(:, 6,14) = (/ & + &7.1177e+01_r8,7.7830e+01_r8,8.4454e+01_r8,9.0502e+01_r8,9.5851e+01_r8/) + kao(:, 7,14) = (/ & + &7.8645e+01_r8,8.6401e+01_r8,9.3877e+01_r8,1.0067e+02_r8,1.0680e+02_r8/) + kao(:, 8,14) = (/ & + &8.6837e+01_r8,9.5972e+01_r8,1.0455e+02_r8,1.1218e+02_r8,1.1889e+02_r8/) + kao(:, 9,14) = (/ & + &9.4588e+01_r8,1.0523e+02_r8,1.1528e+02_r8,1.2405e+02_r8,1.3172e+02_r8/) + kao(:,10,14) = (/ & + &1.0185e+02_r8,1.1428e+02_r8,1.2585e+02_r8,1.3577e+02_r8,1.4474e+02_r8/) + kao(:,11,14) = (/ & + &1.1416e+02_r8,1.2817e+02_r8,1.4064e+02_r8,1.5135e+02_r8,1.6079e+02_r8/) + kao(:,12,14) = (/ & + &1.2658e+02_r8,1.4157e+02_r8,1.5496e+02_r8,1.6630e+02_r8,1.7621e+02_r8/) + kao(:,13,14) = (/ & + &1.3763e+02_r8,1.5352e+02_r8,1.6709e+02_r8,1.7925e+02_r8,1.9013e+02_r8/) + kao(:, 1,15) = (/ & + &5.4748e+01_r8,5.6924e+01_r8,5.8795e+01_r8,6.0375e+01_r8,6.1716e+01_r8/) + kao(:, 2,15) = (/ & + &6.5566e+01_r8,6.8287e+01_r8,7.0585e+01_r8,7.2551e+01_r8,7.4160e+01_r8/) + kao(:, 3,15) = (/ & + &7.7583e+01_r8,8.1027e+01_r8,8.3928e+01_r8,8.6358e+01_r8,8.8397e+01_r8/) + kao(:, 4,15) = (/ & + &8.9871e+01_r8,9.4173e+01_r8,9.7817e+01_r8,1.0084e+02_r8,1.0339e+02_r8/) + kao(:, 5,15) = (/ & + &1.0246e+02_r8,1.0776e+02_r8,1.1220e+02_r8,1.1592e+02_r8,1.1961e+02_r8/) + kao(:, 6,15) = (/ & + &1.1487e+02_r8,1.2133e+02_r8,1.2665e+02_r8,1.3188e+02_r8,1.3707e+02_r8/) + kao(:, 7,15) = (/ & + &1.2683e+02_r8,1.3446e+02_r8,1.4160e+02_r8,1.4872e+02_r8,1.5558e+02_r8/) + kao(:, 8,15) = (/ & + &1.3795e+02_r8,1.4756e+02_r8,1.5674e+02_r8,1.6606e+02_r8,1.7523e+02_r8/) + kao(:, 9,15) = (/ & + &1.4965e+02_r8,1.6170e+02_r8,1.7284e+02_r8,1.8422e+02_r8,1.9597e+02_r8/) + kao(:,10,15) = (/ & + &1.6376e+02_r8,1.7796e+02_r8,1.9116e+02_r8,2.0528e+02_r8,2.1939e+02_r8/) + kao(:,11,15) = (/ & + &1.8752e+02_r8,2.0335e+02_r8,2.1913e+02_r8,2.3662e+02_r8,2.5359e+02_r8/) + kao(:,12,15) = (/ & + &2.1430e+02_r8,2.3299e+02_r8,2.5241e+02_r8,2.7277e+02_r8,2.9286e+02_r8/) + kao(:,13,15) = (/ & + &2.4469e+02_r8,2.6735e+02_r8,2.9101e+02_r8,3.1438e+02_r8,3.3674e+02_r8/) + kao(:, 1,16) = (/ & + &5.6182e+01_r8,5.8534e+01_r8,6.0580e+01_r8,6.2336e+01_r8,6.3846e+01_r8/) + kao(:, 2,16) = (/ & + &6.7714e+01_r8,7.1253e+01_r8,7.3886e+01_r8,7.6167e+01_r8,7.8129e+01_r8/) + kao(:, 3,16) = (/ & + &8.2239e+01_r8,8.6274e+01_r8,8.9810e+01_r8,9.2865e+01_r8,9.5500e+01_r8/) + kao(:, 4,16) = (/ & + &9.7623e+01_r8,1.0299e+02_r8,1.0769e+02_r8,1.1178e+02_r8,1.1532e+02_r8/) + kao(:, 5,16) = (/ & + &1.1485e+02_r8,1.2193e+02_r8,1.2815e+02_r8,1.3359e+02_r8,1.3829e+02_r8/) + kao(:, 6,16) = (/ & + &1.3405e+02_r8,1.4336e+02_r8,1.5157e+02_r8,1.5875e+02_r8,1.6501e+02_r8/) + kao(:, 7,16) = (/ & + &1.5562e+02_r8,1.6780e+02_r8,1.7860e+02_r8,1.8805e+02_r8,1.9632e+02_r8/) + kao(:, 8,16) = (/ & + &1.7987e+02_r8,1.9571e+02_r8,2.0979e+02_r8,2.2214e+02_r8,2.3298e+02_r8/) + kao(:, 9,16) = (/ & + &2.0674e+02_r8,2.2717e+02_r8,2.4538e+02_r8,2.6145e+02_r8,2.7552e+02_r8/) + kao(:,10,16) = (/ & + &2.3822e+02_r8,2.6423e+02_r8,2.8739e+02_r8,3.0794e+02_r8,3.2592e+02_r8/) + kao(:,11,16) = (/ & + &2.8871e+02_r8,3.1996e+02_r8,3.4774e+02_r8,3.7226e+02_r8,3.9354e+02_r8/) + kao(:,12,16) = (/ & + &3.4916e+02_r8,3.8637e+02_r8,4.1932e+02_r8,4.4825e+02_r8,4.7321e+02_r8/) + kao(:,13,16) = (/ & + &4.2045e+02_r8,4.6429e+02_r8,5.0303e+02_r8,5.3671e+02_r8,5.6546e+02_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &2.1558e-03_r8,2.5890e-03_r8,2.9127e-03_r8,3.2139e-03_r8,3.5455e-03_r8/) + kbo(:,14, 1) = (/ & + &1.8304e-03_r8,2.1809e-03_r8,2.4298e-03_r8,2.6878e-03_r8,2.9625e-03_r8/) + kbo(:,15, 1) = (/ & + &1.5486e-03_r8,1.7962e-03_r8,2.0058e-03_r8,2.2286e-03_r8,2.4705e-03_r8/) + kbo(:,16, 1) = (/ & + &1.3025e-03_r8,1.4833e-03_r8,1.6606e-03_r8,1.8503e-03_r8,2.0485e-03_r8/) + kbo(:,17, 1) = (/ & + &1.0810e-03_r8,1.2227e-03_r8,1.3725e-03_r8,1.5304e-03_r8,1.6938e-03_r8/) + kbo(:,18, 1) = (/ & + &8.7942e-04_r8,1.0015e-03_r8,1.1266e-03_r8,1.2596e-03_r8,1.3951e-03_r8/) + kbo(:,19, 1) = (/ & + &7.2280e-04_r8,8.2373e-04_r8,9.2739e-04_r8,1.0381e-03_r8,1.1467e-03_r8/) + kbo(:,20, 1) = (/ & + &6.0184e-04_r8,6.8491e-04_r8,7.6954e-04_r8,8.5989e-04_r8,9.4913e-04_r8/) + kbo(:,21, 1) = (/ & + &5.0117e-04_r8,5.6823e-04_r8,6.3855e-04_r8,7.1320e-04_r8,7.8654e-04_r8/) + kbo(:,22, 1) = (/ & + &4.1938e-04_r8,4.7543e-04_r8,5.3375e-04_r8,5.9543e-04_r8,6.5571e-04_r8/) + kbo(:,23, 1) = (/ & + &3.5199e-04_r8,3.9855e-04_r8,4.4679e-04_r8,4.9714e-04_r8,5.4750e-04_r8/) + kbo(:,24, 1) = (/ & + &2.9639e-04_r8,3.3452e-04_r8,3.7432e-04_r8,4.1615e-04_r8,4.5706e-04_r8/) + kbo(:,25, 1) = (/ & + &2.4906e-04_r8,2.8117e-04_r8,3.1412e-04_r8,3.4839e-04_r8,3.7317e-04_r8/) + kbo(:,26, 1) = (/ & + &2.1029e-04_r8,2.3678e-04_r8,2.6421e-04_r8,2.9238e-04_r8,3.0575e-04_r8/) + kbo(:,27, 1) = (/ & + &1.7727e-04_r8,1.9942e-04_r8,2.2208e-04_r8,2.4556e-04_r8,2.5262e-04_r8/) + kbo(:,28, 1) = (/ & + &1.4969e-04_r8,1.6790e-04_r8,1.8692e-04_r8,2.0183e-04_r8,2.0915e-04_r8/) + kbo(:,29, 1) = (/ & + &1.2629e-04_r8,1.4151e-04_r8,1.5706e-04_r8,1.6548e-04_r8,1.7223e-04_r8/) + kbo(:,30, 1) = (/ & + &1.0651e-04_r8,1.1909e-04_r8,1.3186e-04_r8,1.3639e-04_r8,1.4198e-04_r8/) + kbo(:,31, 1) = (/ & + &8.9698e-05_r8,1.0002e-04_r8,1.0798e-04_r8,1.1271e-04_r8,1.1661e-04_r8/) + kbo(:,32, 1) = (/ & + &7.5536e-05_r8,8.4037e-05_r8,8.8553e-05_r8,9.2337e-05_r8,9.5468e-05_r8/) + kbo(:,33, 1) = (/ & + &6.3563e-05_r8,7.0507e-05_r8,7.3023e-05_r8,7.6153e-05_r8,7.8142e-05_r8/) + kbo(:,34, 1) = (/ & + &5.3365e-05_r8,5.7820e-05_r8,6.0490e-05_r8,6.2653e-05_r8,6.4307e-05_r8/) + kbo(:,35, 1) = (/ & + &4.4295e-05_r8,4.7505e-05_r8,4.9568e-05_r8,5.1436e-05_r8,5.2756e-05_r8/) + kbo(:,36, 1) = (/ & + &3.6359e-05_r8,3.8955e-05_r8,4.0612e-05_r8,4.2071e-05_r8,4.3157e-05_r8/) + kbo(:,37, 1) = (/ & + &2.9443e-05_r8,3.1950e-05_r8,3.3272e-05_r8,3.4376e-05_r8,3.5259e-05_r8/) + kbo(:,38, 1) = (/ & + &2.3815e-05_r8,2.6274e-05_r8,2.7165e-05_r8,2.8049e-05_r8,2.8811e-05_r8/) + kbo(:,39, 1) = (/ & + &1.9245e-05_r8,2.1354e-05_r8,2.2111e-05_r8,2.2930e-05_r8,2.3532e-05_r8/) + kbo(:,40, 1) = (/ & + &1.5405e-05_r8,1.7147e-05_r8,1.8049e-05_r8,1.8756e-05_r8,1.9282e-05_r8/) + kbo(:,41, 1) = (/ & + &1.2319e-05_r8,1.3748e-05_r8,1.4753e-05_r8,1.5289e-05_r8,1.5770e-05_r8/) + kbo(:,42, 1) = (/ & + &9.8357e-06_r8,1.1012e-05_r8,1.2183e-05_r8,1.2499e-05_r8,1.2877e-05_r8/) + kbo(:,43, 1) = (/ & + &7.7892e-06_r8,8.7858e-06_r8,9.7457e-06_r8,1.0234e-05_r8,1.0599e-05_r8/) + kbo(:,44, 1) = (/ & + &6.1605e-06_r8,6.9805e-06_r8,7.7675e-06_r8,8.4197e-06_r8,8.6950e-06_r8/) + kbo(:,45, 1) = (/ & + &4.8809e-06_r8,5.5274e-06_r8,6.1865e-06_r8,6.8268e-06_r8,7.0906e-06_r8/) + kbo(:,46, 1) = (/ & + &3.8470e-06_r8,4.3665e-06_r8,4.9029e-06_r8,5.4349e-06_r8,5.8089e-06_r8/) + kbo(:,47, 1) = (/ & + &3.0311e-06_r8,3.4294e-06_r8,3.8630e-06_r8,4.3044e-06_r8,4.7453e-06_r8/) + kbo(:,48, 1) = (/ & + &2.3694e-06_r8,2.7049e-06_r8,3.0473e-06_r8,3.4008e-06_r8,3.7674e-06_r8/) + kbo(:,49, 1) = (/ & + &1.8467e-06_r8,2.1296e-06_r8,2.4020e-06_r8,2.6917e-06_r8,2.9837e-06_r8/) + kbo(:,50, 1) = (/ & + &1.4542e-06_r8,1.6765e-06_r8,1.8996e-06_r8,2.1320e-06_r8,2.3692e-06_r8/) + kbo(:,51, 1) = (/ & + &1.1539e-06_r8,1.3178e-06_r8,1.5055e-06_r8,1.6911e-06_r8,1.8864e-06_r8/) + kbo(:,52, 1) = (/ & + &8.7493e-07_r8,1.0411e-06_r8,1.1898e-06_r8,1.3435e-06_r8,1.4983e-06_r8/) + kbo(:,53, 1) = (/ & + &6.6072e-07_r8,8.3282e-07_r8,9.4298e-07_r8,1.0653e-06_r8,1.1935e-06_r8/) + kbo(:,54, 1) = (/ & + &5.0251e-07_r8,6.4316e-07_r8,7.5237e-07_r8,8.5108e-07_r8,9.5630e-07_r8/) + kbo(:,55, 1) = (/ & + &3.8195e-07_r8,4.9281e-07_r8,6.0554e-07_r8,6.8279e-07_r8,7.6458e-07_r8/) + kbo(:,56, 1) = (/ & + &2.8943e-07_r8,3.7779e-07_r8,4.8048e-07_r8,5.4688e-07_r8,6.1650e-07_r8/) + kbo(:,57, 1) = (/ & + &2.1868e-07_r8,2.8870e-07_r8,3.7076e-07_r8,4.4677e-07_r8,4.9616e-07_r8/) + kbo(:,58, 1) = (/ & + &1.6598e-07_r8,2.2133e-07_r8,2.8693e-07_r8,3.5995e-07_r8,4.0195e-07_r8/) + kbo(:,59, 1) = (/ & + &1.3312e-07_r8,1.7804e-07_r8,2.3134e-07_r8,2.9072e-07_r8,3.3304e-07_r8/) + kbo(:,13, 2) = (/ & + &5.7626e-03_r8,6.1115e-03_r8,6.3578e-03_r8,6.6833e-03_r8,6.9834e-03_r8/) + kbo(:,14, 2) = (/ & + &4.7365e-03_r8,4.9915e-03_r8,5.2669e-03_r8,5.5245e-03_r8,5.7996e-03_r8/) + kbo(:,15, 2) = (/ & + &3.8570e-03_r8,4.0469e-03_r8,4.3101e-03_r8,4.5195e-03_r8,4.7607e-03_r8/) + kbo(:,16, 2) = (/ & + &3.0836e-03_r8,3.2692e-03_r8,3.4748e-03_r8,3.6812e-03_r8,3.8941e-03_r8/) + kbo(:,17, 2) = (/ & + &2.4665e-03_r8,2.6482e-03_r8,2.8018e-03_r8,2.9854e-03_r8,3.1785e-03_r8/) + kbo(:,18, 2) = (/ & + &1.9741e-03_r8,2.1245e-03_r8,2.2564e-03_r8,2.4081e-03_r8,2.5780e-03_r8/) + kbo(:,19, 2) = (/ & + &1.5958e-03_r8,1.7126e-03_r8,1.8351e-03_r8,1.9560e-03_r8,2.0570e-03_r8/) + kbo(:,20, 2) = (/ & + &1.3038e-03_r8,1.3978e-03_r8,1.5013e-03_r8,1.6102e-03_r8,1.6734e-03_r8/) + kbo(:,21, 2) = (/ & + &1.0706e-03_r8,1.1492e-03_r8,1.2352e-03_r8,1.3269e-03_r8,1.3755e-03_r8/) + kbo(:,22, 2) = (/ & + &8.8260e-04_r8,9.4987e-04_r8,1.0209e-03_r8,1.0834e-03_r8,1.1278e-03_r8/) + kbo(:,23, 2) = (/ & + &7.2583e-04_r8,7.8218e-04_r8,8.4637e-04_r8,8.8814e-04_r8,9.2896e-04_r8/) + kbo(:,24, 2) = (/ & + &6.0040e-04_r8,6.4872e-04_r8,7.0437e-04_r8,7.3258e-04_r8,7.6936e-04_r8/) + kbo(:,25, 2) = (/ & + &4.9798e-04_r8,5.3936e-04_r8,5.8024e-04_r8,6.0451e-04_r8,6.4613e-04_r8/) + kbo(:,26, 2) = (/ & + &4.1436e-04_r8,4.5078e-04_r8,4.7645e-04_r8,5.0082e-04_r8,5.4367e-04_r8/) + kbo(:,27, 2) = (/ & + &3.4567e-04_r8,3.7682e-04_r8,3.9546e-04_r8,4.1621e-04_r8,4.5625e-04_r8/) + kbo(:,28, 2) = (/ & + &2.8902e-04_r8,3.1546e-04_r8,3.2798e-04_r8,3.5075e-04_r8,3.8306e-04_r8/) + kbo(:,29, 2) = (/ & + &2.4193e-04_r8,2.5865e-04_r8,2.7208e-04_r8,2.9507e-04_r8,3.2156e-04_r8/) + kbo(:,30, 2) = (/ & + &2.0282e-04_r8,2.1375e-04_r8,2.2606e-04_r8,2.4794e-04_r8,2.6904e-04_r8/) + kbo(:,31, 2) = (/ & + &1.6986e-04_r8,1.7726e-04_r8,1.9036e-04_r8,2.0754e-04_r8,2.2529e-04_r8/) + kbo(:,32, 2) = (/ & + &1.3922e-04_r8,1.4692e-04_r8,1.5999e-04_r8,1.7445e-04_r8,1.8931e-04_r8/) + kbo(:,33, 2) = (/ & + &1.1520e-04_r8,1.2220e-04_r8,1.3453e-04_r8,1.4590e-04_r8,1.5875e-04_r8/) + kbo(:,34, 2) = (/ & + &9.5764e-05_r8,1.0295e-04_r8,1.1231e-04_r8,1.2221e-04_r8,1.3235e-04_r8/) + kbo(:,35, 2) = (/ & + &7.8951e-05_r8,8.5467e-05_r8,9.3381e-05_r8,1.0154e-04_r8,1.0962e-04_r8/) + kbo(:,36, 2) = (/ & + &6.4805e-05_r8,7.0212e-05_r8,7.6766e-05_r8,8.3544e-05_r8,9.0139e-05_r8/) + kbo(:,37, 2) = (/ & + &5.2918e-05_r8,5.7064e-05_r8,6.2426e-05_r8,6.8102e-05_r8,7.3562e-05_r8/) + kbo(:,38, 2) = (/ & + &4.3224e-05_r8,4.6216e-05_r8,5.0772e-05_r8,5.5504e-05_r8,6.0016e-05_r8/) + kbo(:,39, 2) = (/ & + &3.5291e-05_r8,3.7592e-05_r8,4.1355e-05_r8,4.5145e-05_r8,4.8932e-05_r8/) + kbo(:,40, 2) = (/ & + &2.8761e-05_r8,3.0515e-05_r8,3.3449e-05_r8,3.6463e-05_r8,3.9654e-05_r8/) + kbo(:,41, 2) = (/ & + &2.3487e-05_r8,2.4801e-05_r8,2.6922e-05_r8,2.9459e-05_r8,3.2147e-05_r8/) + kbo(:,42, 2) = (/ & + &1.9314e-05_r8,2.0243e-05_r8,2.1564e-05_r8,2.3753e-05_r8,2.5964e-05_r8/) + kbo(:,43, 2) = (/ & + &1.5553e-05_r8,1.6470e-05_r8,1.7479e-05_r8,1.9035e-05_r8,2.0784e-05_r8/) + kbo(:,44, 2) = (/ & + &1.2457e-05_r8,1.3468e-05_r8,1.4190e-05_r8,1.5199e-05_r8,1.6632e-05_r8/) + kbo(:,45, 2) = (/ & + &9.9734e-06_r8,1.1008e-05_r8,1.1581e-05_r8,1.2254e-05_r8,1.3346e-05_r8/) + kbo(:,46, 2) = (/ & + &7.9698e-06_r8,8.8088e-06_r8,9.4445e-06_r8,9.9340e-06_r8,1.0690e-05_r8/) + kbo(:,47, 2) = (/ & + &6.3565e-06_r8,7.0249e-06_r8,7.7396e-06_r8,8.1033e-06_r8,8.5527e-06_r8/) + kbo(:,48, 2) = (/ & + &5.1256e-06_r8,5.5929e-06_r8,6.1735e-06_r8,6.6021e-06_r8,6.9371e-06_r8/) + kbo(:,49, 2) = (/ & + &4.0784e-06_r8,4.4718e-06_r8,4.9212e-06_r8,5.4190e-06_r8,5.6740e-06_r8/) + kbo(:,50, 2) = (/ & + &3.3297e-06_r8,3.6155e-06_r8,3.9436e-06_r8,4.3292e-06_r8,4.6291e-06_r8/) + kbo(:,51, 2) = (/ & + &2.7486e-06_r8,2.9107e-06_r8,3.1698e-06_r8,3.4767e-06_r8,3.8139e-06_r8/) + kbo(:,52, 2) = (/ & + &2.2530e-06_r8,2.4006e-06_r8,2.5759e-06_r8,2.7925e-06_r8,3.0627e-06_r8/) + kbo(:,53, 2) = (/ & + &1.8678e-06_r8,1.9765e-06_r8,2.1052e-06_r8,2.2503e-06_r8,2.4591e-06_r8/) + kbo(:,54, 2) = (/ & + &1.5340e-06_r8,1.6385e-06_r8,1.7450e-06_r8,1.8671e-06_r8,1.9805e-06_r8/) + kbo(:,55, 2) = (/ & + &1.2873e-06_r8,1.3532e-06_r8,1.4432e-06_r8,1.5328e-06_r8,1.6236e-06_r8/) + kbo(:,56, 2) = (/ & + &1.0668e-06_r8,1.1355e-06_r8,1.1865e-06_r8,1.2884e-06_r8,1.3667e-06_r8/) + kbo(:,57, 2) = (/ & + &8.4592e-07_r8,9.6149e-07_r8,9.8845e-07_r8,1.0536e-06_r8,1.1286e-06_r8/) + kbo(:,58, 2) = (/ & + &6.5721e-07_r8,8.0847e-07_r8,8.4916e-07_r8,8.7196e-07_r8,9.4267e-07_r8/) + kbo(:,59, 2) = (/ & + &5.2809e-07_r8,6.6890e-07_r8,7.2431e-07_r8,7.4028e-07_r8,7.8416e-07_r8/) + kbo(:,13, 3) = (/ & + &8.0007e-03_r8,8.9344e-03_r8,1.0260e-02_r8,1.1651e-02_r8,1.2914e-02_r8/) + kbo(:,14, 3) = (/ & + &6.8039e-03_r8,7.6829e-03_r8,8.7921e-03_r8,9.9141e-03_r8,1.0757e-02_r8/) + kbo(:,15, 3) = (/ & + &5.7029e-03_r8,6.5489e-03_r8,7.4475e-03_r8,8.3471e-03_r8,8.8091e-03_r8/) + kbo(:,16, 3) = (/ & + &4.8074e-03_r8,5.5085e-03_r8,6.2455e-03_r8,6.9353e-03_r8,7.1997e-03_r8/) + kbo(:,17, 3) = (/ & + &4.0213e-03_r8,4.6076e-03_r8,5.2117e-03_r8,5.6731e-03_r8,5.8805e-03_r8/) + kbo(:,18, 3) = (/ & + &3.3461e-03_r8,3.8362e-03_r8,4.3242e-03_r8,4.6154e-03_r8,4.7757e-03_r8/) + kbo(:,19, 3) = (/ & + &2.7996e-03_r8,3.2075e-03_r8,3.5883e-03_r8,3.7732e-03_r8,3.8872e-03_r8/) + kbo(:,20, 3) = (/ & + &2.3589e-03_r8,2.6931e-03_r8,2.9843e-03_r8,3.1004e-03_r8,3.1743e-03_r8/) + kbo(:,21, 3) = (/ & + &1.9734e-03_r8,2.2564e-03_r8,2.4531e-03_r8,2.5572e-03_r8,2.5979e-03_r8/) + kbo(:,22, 3) = (/ & + &1.6777e-03_r8,1.9014e-03_r8,2.0201e-03_r8,2.0877e-03_r8,2.1290e-03_r8/) + kbo(:,23, 3) = (/ & + &1.4255e-03_r8,1.6043e-03_r8,1.6675e-03_r8,1.7121e-03_r8,1.7219e-03_r8/) + kbo(:,24, 3) = (/ & + &1.2066e-03_r8,1.3233e-03_r8,1.3782e-03_r8,1.4109e-03_r8,1.3842e-03_r8/) + kbo(:,25, 3) = (/ & + &1.0218e-03_r8,1.0936e-03_r8,1.1313e-03_r8,1.1590e-03_r8,1.1132e-03_r8/) + kbo(:,26, 3) = (/ & + &8.6686e-04_r8,9.0770e-04_r8,9.3474e-04_r8,9.3738e-04_r8,9.0394e-04_r8/) + kbo(:,27, 3) = (/ & + &7.2332e-04_r8,7.5480e-04_r8,7.7347e-04_r8,7.5530e-04_r8,7.3995e-04_r8/) + kbo(:,28, 3) = (/ & + &5.9945e-04_r8,6.1747e-04_r8,6.3797e-04_r8,6.1191e-04_r8,6.1018e-04_r8/) + kbo(:,29, 3) = (/ & + &4.9636e-04_r8,5.1141e-04_r8,5.1979e-04_r8,4.9718e-04_r8,5.0501e-04_r8/) + kbo(:,30, 3) = (/ & + &4.1287e-04_r8,4.2400e-04_r8,4.1392e-04_r8,4.0737e-04_r8,4.1659e-04_r8/) + kbo(:,31, 3) = (/ & + &3.3517e-04_r8,3.4906e-04_r8,3.3288e-04_r8,3.3660e-04_r8,3.4335e-04_r8/) + kbo(:,32, 3) = (/ & + &2.7784e-04_r8,2.7984e-04_r8,2.7143e-04_r8,2.7785e-04_r8,2.8417e-04_r8/) + kbo(:,33, 3) = (/ & + &2.3052e-04_r8,2.2367e-04_r8,2.2307e-04_r8,2.2883e-04_r8,2.3495e-04_r8/) + kbo(:,34, 3) = (/ & + &1.9073e-04_r8,1.8192e-04_r8,1.8515e-04_r8,1.8942e-04_r8,1.9507e-04_r8/) + kbo(:,35, 3) = (/ & + &1.5683e-04_r8,1.4914e-04_r8,1.5288e-04_r8,1.5663e-04_r8,1.6156e-04_r8/) + kbo(:,36, 3) = (/ & + &1.2835e-04_r8,1.2262e-04_r8,1.2564e-04_r8,1.2896e-04_r8,1.3319e-04_r8/) + kbo(:,37, 3) = (/ & + &1.0651e-04_r8,1.0086e-04_r8,1.0335e-04_r8,1.0615e-04_r8,1.0970e-04_r8/) + kbo(:,38, 3) = (/ & + &8.7372e-05_r8,8.2916e-05_r8,8.4948e-05_r8,8.7192e-05_r8,9.0174e-05_r8/) + kbo(:,39, 3) = (/ & + &7.1580e-05_r8,6.8441e-05_r8,6.9733e-05_r8,7.1507e-05_r8,7.4030e-05_r8/) + kbo(:,40, 3) = (/ & + &5.8422e-05_r8,5.7750e-05_r8,5.6983e-05_r8,5.8663e-05_r8,6.0682e-05_r8/) + kbo(:,41, 3) = (/ & + &4.7623e-05_r8,4.8587e-05_r8,4.6749e-05_r8,4.8145e-05_r8,4.9685e-05_r8/) + kbo(:,42, 3) = (/ & + &3.8729e-05_r8,4.0813e-05_r8,3.8776e-05_r8,3.9518e-05_r8,4.0826e-05_r8/) + kbo(:,43, 3) = (/ & + &3.2019e-05_r8,3.3273e-05_r8,3.2653e-05_r8,3.2753e-05_r8,3.3527e-05_r8/) + kbo(:,44, 3) = (/ & + &2.6412e-05_r8,2.7141e-05_r8,2.7698e-05_r8,2.6940e-05_r8,2.7582e-05_r8/) + kbo(:,45, 3) = (/ & + &2.1266e-05_r8,2.2156e-05_r8,2.3306e-05_r8,2.2397e-05_r8,2.2801e-05_r8/) + kbo(:,46, 3) = (/ & + &1.7333e-05_r8,1.8301e-05_r8,1.8885e-05_r8,1.9036e-05_r8,1.8747e-05_r8/) + kbo(:,47, 3) = (/ & + &1.4070e-05_r8,1.4972e-05_r8,1.5353e-05_r8,1.6172e-05_r8,1.5451e-05_r8/) + kbo(:,48, 3) = (/ & + &1.0908e-05_r8,1.2143e-05_r8,1.2701e-05_r8,1.3131e-05_r8,1.3135e-05_r8/) + kbo(:,49, 3) = (/ & + &8.5257e-06_r8,9.9029e-06_r8,1.0615e-05_r8,1.0623e-05_r8,1.1229e-05_r8/) + kbo(:,50, 3) = (/ & + &6.5831e-06_r8,7.8068e-06_r8,8.5689e-06_r8,8.8823e-06_r8,9.1397e-06_r8/) + kbo(:,51, 3) = (/ & + &5.0124e-06_r8,6.1123e-06_r8,6.9735e-06_r8,7.5152e-06_r8,7.4209e-06_r8/) + kbo(:,52, 3) = (/ & + &3.8557e-06_r8,4.7153e-06_r8,5.6513e-06_r8,6.0740e-06_r8,6.2588e-06_r8/) + kbo(:,53, 3) = (/ & + &2.9713e-06_r8,3.6139e-06_r8,4.3749e-06_r8,4.9165e-06_r8,5.3050e-06_r8/) + kbo(:,54, 3) = (/ & + &2.2856e-06_r8,2.7967e-06_r8,3.4018e-06_r8,4.0149e-06_r8,4.3280e-06_r8/) + kbo(:,55, 3) = (/ & + &1.7432e-06_r8,2.1952e-06_r8,2.6416e-06_r8,3.2063e-06_r8,3.5207e-06_r8/) + kbo(:,56, 3) = (/ & + &1.3460e-06_r8,1.6981e-06_r8,2.0681e-06_r8,2.4690e-06_r8,2.8558e-06_r8/) + kbo(:,57, 3) = (/ & + &1.0794e-06_r8,1.2900e-06_r8,1.6260e-06_r8,1.9447e-06_r8,2.3391e-06_r8/) + kbo(:,58, 3) = (/ & + &9.2042e-07_r8,9.9682e-07_r8,1.2594e-06_r8,1.5341e-06_r8,1.8245e-06_r8/) + kbo(:,59, 3) = (/ & + &7.5487e-07_r8,8.2111e-07_r8,1.0075e-06_r8,1.2341e-06_r8,1.4799e-06_r8/) + kbo(:,13, 4) = (/ & + &1.6236e-02_r8,1.6164e-02_r8,1.6551e-02_r8,1.6579e-02_r8,1.4849e-02_r8/) + kbo(:,14, 4) = (/ & + &1.3333e-02_r8,1.3358e-02_r8,1.3723e-02_r8,1.3164e-02_r8,1.2310e-02_r8/) + kbo(:,15, 4) = (/ & + &1.0791e-02_r8,1.1005e-02_r8,1.1347e-02_r8,1.0262e-02_r8,1.0198e-02_r8/) + kbo(:,16, 4) = (/ & + &8.7740e-03_r8,9.0551e-03_r8,8.8988e-03_r8,8.1326e-03_r8,8.4246e-03_r8/) + kbo(:,17, 4) = (/ & + &7.1855e-03_r8,7.4271e-03_r8,6.8507e-03_r8,6.6124e-03_r8,6.9447e-03_r8/) + kbo(:,18, 4) = (/ & + &5.8832e-03_r8,5.8794e-03_r8,5.3061e-03_r8,5.4156e-03_r8,5.7271e-03_r8/) + kbo(:,19, 4) = (/ & + &4.7612e-03_r8,4.5173e-03_r8,4.2495e-03_r8,4.4758e-03_r8,4.7797e-03_r8/) + kbo(:,20, 4) = (/ & + &3.8929e-03_r8,3.5371e-03_r8,3.4837e-03_r8,3.7081e-03_r8,4.0335e-03_r8/) + kbo(:,21, 4) = (/ & + &3.1210e-03_r8,2.8158e-03_r8,2.9040e-03_r8,3.0717e-03_r8,3.3855e-03_r8/) + kbo(:,22, 4) = (/ & + &2.4122e-03_r8,2.2915e-03_r8,2.4348e-03_r8,2.6102e-03_r8,2.8568e-03_r8/) + kbo(:,23, 4) = (/ & + &1.8931e-03_r8,1.8847e-03_r8,2.0226e-03_r8,2.2045e-03_r8,2.4293e-03_r8/) + kbo(:,24, 4) = (/ & + &1.5231e-03_r8,1.5878e-03_r8,1.6899e-03_r8,1.8552e-03_r8,2.0775e-03_r8/) + kbo(:,25, 4) = (/ & + &1.2458e-03_r8,1.3309e-03_r8,1.4317e-03_r8,1.5678e-03_r8,1.7779e-03_r8/) + kbo(:,26, 4) = (/ & + &1.0318e-03_r8,1.1118e-03_r8,1.2146e-03_r8,1.3449e-03_r8,1.5065e-03_r8/) + kbo(:,27, 4) = (/ & + &8.6665e-04_r8,9.3057e-04_r8,1.0235e-03_r8,1.1557e-03_r8,1.2745e-03_r8/) + kbo(:,28, 4) = (/ & + &7.2935e-04_r8,7.9123e-04_r8,8.6656e-04_r8,9.8388e-04_r8,1.0757e-03_r8/) + kbo(:,29, 4) = (/ & + &6.1286e-04_r8,6.7240e-04_r8,7.4124e-04_r8,8.3872e-04_r8,9.0911e-04_r8/) + kbo(:,30, 4) = (/ & + &5.1400e-04_r8,5.6684e-04_r8,6.4255e-04_r8,7.1220e-04_r8,7.7258e-04_r8/) + kbo(:,31, 4) = (/ & + &4.4005e-04_r8,4.8076e-04_r8,5.5017e-04_r8,6.0255e-04_r8,6.5647e-04_r8/) + kbo(:,32, 4) = (/ & + &3.7263e-04_r8,4.1679e-04_r8,4.6901e-04_r8,5.1118e-04_r8,5.5709e-04_r8/) + kbo(:,33, 4) = (/ & + &3.1452e-04_r8,3.5853e-04_r8,3.9810e-04_r8,4.3526e-04_r8,4.7464e-04_r8/) + kbo(:,34, 4) = (/ & + &2.6538e-04_r8,3.0537e-04_r8,3.3607e-04_r8,3.6889e-04_r8,4.0236e-04_r8/) + kbo(:,35, 4) = (/ & + &2.2314e-04_r8,2.5674e-04_r8,2.8212e-04_r8,3.1017e-04_r8,3.3804e-04_r8/) + kbo(:,36, 4) = (/ & + &1.8558e-04_r8,2.1307e-04_r8,2.3484e-04_r8,2.5807e-04_r8,2.8146e-04_r8/) + kbo(:,37, 4) = (/ & + &1.5092e-04_r8,1.7515e-04_r8,1.9371e-04_r8,2.1363e-04_r8,2.3312e-04_r8/) + kbo(:,38, 4) = (/ & + &1.2396e-04_r8,1.4379e-04_r8,1.5969e-04_r8,1.7662e-04_r8,1.9284e-04_r8/) + kbo(:,39, 4) = (/ & + &1.0157e-04_r8,1.1773e-04_r8,1.3175e-04_r8,1.4587e-04_r8,1.5934e-04_r8/) + kbo(:,40, 4) = (/ & + &8.2605e-05_r8,9.4273e-05_r8,1.0813e-04_r8,1.1977e-04_r8,1.3107e-04_r8/) + kbo(:,41, 4) = (/ & + &6.6939e-05_r8,7.5416e-05_r8,8.8332e-05_r8,9.8121e-05_r8,1.0774e-04_r8/) + kbo(:,42, 4) = (/ & + &5.4049e-05_r8,6.0030e-05_r8,7.1511e-05_r8,8.0199e-05_r8,8.8261e-05_r8/) + kbo(:,43, 4) = (/ & + &4.3092e-05_r8,4.8470e-05_r8,5.6902e-05_r8,6.4800e-05_r8,7.1905e-05_r8/) + kbo(:,44, 4) = (/ & + &3.4303e-05_r8,3.8888e-05_r8,4.4709e-05_r8,5.2317e-05_r8,5.8294e-05_r8/) + kbo(:,45, 4) = (/ & + &2.7706e-05_r8,3.1192e-05_r8,3.5138e-05_r8,4.1880e-05_r8,4.7037e-05_r8/) + kbo(:,46, 4) = (/ & + &2.2020e-05_r8,2.4816e-05_r8,2.8235e-05_r8,3.2847e-05_r8,3.7855e-05_r8/) + kbo(:,47, 4) = (/ & + &1.7397e-05_r8,1.9571e-05_r8,2.2339e-05_r8,2.5403e-05_r8,3.0154e-05_r8/) + kbo(:,48, 4) = (/ & + &1.4464e-05_r8,1.5535e-05_r8,1.7628e-05_r8,2.0160e-05_r8,2.3523e-05_r8/) + kbo(:,49, 4) = (/ & + &1.2203e-05_r8,1.2334e-05_r8,1.3809e-05_r8,1.5955e-05_r8,1.8189e-05_r8/) + kbo(:,50, 4) = (/ & + &1.0868e-05_r8,1.0166e-05_r8,1.1038e-05_r8,1.2542e-05_r8,1.4482e-05_r8/) + kbo(:,51, 4) = (/ & + &9.5445e-06_r8,8.4914e-06_r8,8.8728e-06_r8,9.7788e-06_r8,1.1531e-05_r8/) + kbo(:,52, 4) = (/ & + &7.6675e-06_r8,7.5593e-06_r8,7.1200e-06_r8,7.9511e-06_r8,9.0030e-06_r8/) + kbo(:,53, 4) = (/ & + &6.1578e-06_r8,6.8621e-06_r8,5.9549e-06_r8,6.4007e-06_r8,7.0103e-06_r8/) + kbo(:,54, 4) = (/ & + &4.9970e-06_r8,5.5372e-06_r8,5.2950e-06_r8,5.1133e-06_r8,5.6754e-06_r8/) + kbo(:,55, 4) = (/ & + &4.1058e-06_r8,4.4463e-06_r8,4.8381e-06_r8,4.2110e-06_r8,4.6398e-06_r8/) + kbo(:,56, 4) = (/ & + &3.3825e-06_r8,3.6285e-06_r8,4.0286e-06_r8,3.7391e-06_r8,3.7193e-06_r8/) + kbo(:,57, 4) = (/ & + &2.7087e-06_r8,2.9631e-06_r8,3.2500e-06_r8,3.4185e-06_r8,3.0256e-06_r8/) + kbo(:,58, 4) = (/ & + &2.0759e-06_r8,2.4918e-06_r8,2.6378e-06_r8,2.9253e-06_r8,2.6729e-06_r8/) + kbo(:,59, 4) = (/ & + &1.6942e-06_r8,2.0927e-06_r8,2.1992e-06_r8,2.4373e-06_r8,2.3395e-06_r8/) + kbo(:,13, 5) = (/ & + &1.7253e-02_r8,1.9755e-02_r8,2.1401e-02_r8,2.3591e-02_r8,2.8114e-02_r8/) + kbo(:,14, 5) = (/ & + &1.4836e-02_r8,1.6934e-02_r8,1.8341e-02_r8,2.1005e-02_r8,2.4456e-02_r8/) + kbo(:,15, 5) = (/ & + &1.2786e-02_r8,1.4254e-02_r8,1.5589e-02_r8,1.8700e-02_r8,2.1272e-02_r8/) + kbo(:,16, 5) = (/ & + &1.0892e-02_r8,1.2056e-02_r8,1.3761e-02_r8,1.6336e-02_r8,1.8224e-02_r8/) + kbo(:,17, 5) = (/ & + &9.1405e-03_r8,1.0167e-02_r8,1.2171e-02_r8,1.4009e-02_r8,1.5426e-02_r8/) + kbo(:,18, 5) = (/ & + &7.6420e-03_r8,8.7762e-03_r8,1.0582e-02_r8,1.1875e-02_r8,1.2969e-02_r8/) + kbo(:,19, 5) = (/ & + &6.4312e-03_r8,7.6685e-03_r8,8.9635e-03_r8,9.9226e-03_r8,1.0844e-02_r8/) + kbo(:,20, 5) = (/ & + &5.4039e-03_r8,6.6521e-03_r8,7.5702e-03_r8,8.3653e-03_r8,9.0934e-03_r8/) + kbo(:,21, 5) = (/ & + &4.6584e-03_r8,5.7137e-03_r8,6.4063e-03_r8,7.0462e-03_r8,7.6384e-03_r8/) + kbo(:,22, 5) = (/ & + &4.1485e-03_r8,4.9033e-03_r8,5.4200e-03_r8,5.9610e-03_r8,6.4648e-03_r8/) + kbo(:,23, 5) = (/ & + &3.6403e-03_r8,4.1705e-03_r8,4.6055e-03_r8,5.0423e-03_r8,5.4667e-03_r8/) + kbo(:,24, 5) = (/ & + &3.1466e-03_r8,3.5285e-03_r8,3.8988e-03_r8,4.2642e-03_r8,4.6134e-03_r8/) + kbo(:,25, 5) = (/ & + &2.6968e-03_r8,2.9919e-03_r8,3.3029e-03_r8,3.6014e-03_r8,3.8905e-03_r8/) + kbo(:,26, 5) = (/ & + &2.2919e-03_r8,2.5427e-03_r8,2.7966e-03_r8,3.0460e-03_r8,3.3030e-03_r8/) + kbo(:,27, 5) = (/ & + &1.9487e-03_r8,2.1617e-03_r8,2.3708e-03_r8,2.5760e-03_r8,2.8001e-03_r8/) + kbo(:,28, 5) = (/ & + &1.6604e-03_r8,1.8339e-03_r8,2.0064e-03_r8,2.1858e-03_r8,2.3683e-03_r8/) + kbo(:,29, 5) = (/ & + &1.4167e-03_r8,1.5573e-03_r8,1.7005e-03_r8,1.8546e-03_r8,2.0015e-03_r8/) + kbo(:,30, 5) = (/ & + &1.2043e-03_r8,1.3228e-03_r8,1.4435e-03_r8,1.5699e-03_r8,1.6896e-03_r8/) + kbo(:,31, 5) = (/ & + &1.0225e-03_r8,1.1229e-03_r8,1.2273e-03_r8,1.3283e-03_r8,1.4296e-03_r8/) + kbo(:,32, 5) = (/ & + &8.6992e-04_r8,9.5293e-04_r8,1.0416e-03_r8,1.1243e-03_r8,1.2104e-03_r8/) + kbo(:,33, 5) = (/ & + &7.3968e-04_r8,8.1278e-04_r8,8.8420e-04_r8,9.5333e-04_r8,1.0276e-03_r8/) + kbo(:,34, 5) = (/ & + &6.2724e-04_r8,6.8945e-04_r8,7.4802e-04_r8,8.0740e-04_r8,8.7396e-04_r8/) + kbo(:,35, 5) = (/ & + &5.2729e-04_r8,5.7995e-04_r8,6.2910e-04_r8,6.7983e-04_r8,7.3853e-04_r8/) + kbo(:,36, 5) = (/ & + &4.3895e-04_r8,4.8339e-04_r8,5.2479e-04_r8,5.6936e-04_r8,6.1891e-04_r8/) + kbo(:,37, 5) = (/ & + &3.6323e-04_r8,4.0071e-04_r8,4.3613e-04_r8,4.7458e-04_r8,5.1673e-04_r8/) + kbo(:,38, 5) = (/ & + &3.0001e-04_r8,3.3215e-04_r8,3.6263e-04_r8,3.9587e-04_r8,4.3165e-04_r8/) + kbo(:,39, 5) = (/ & + &2.4808e-04_r8,2.7543e-04_r8,3.0133e-04_r8,3.3050e-04_r8,3.6200e-04_r8/) + kbo(:,40, 5) = (/ & + &2.0392e-04_r8,2.2766e-04_r8,2.5038e-04_r8,2.7569e-04_r8,3.0329e-04_r8/) + kbo(:,41, 5) = (/ & + &1.6718e-04_r8,1.8754e-04_r8,2.0771e-04_r8,2.3036e-04_r8,2.5452e-04_r8/) + kbo(:,42, 5) = (/ & + &1.3676e-04_r8,1.5432e-04_r8,1.7210e-04_r8,1.9216e-04_r8,2.1391e-04_r8/) + kbo(:,43, 5) = (/ & + &1.1103e-04_r8,1.2612e-04_r8,1.4186e-04_r8,1.5938e-04_r8,1.7898e-04_r8/) + kbo(:,44, 5) = (/ & + &8.9549e-05_r8,1.0259e-04_r8,1.1643e-04_r8,1.3169e-04_r8,1.4912e-04_r8/) + kbo(:,45, 5) = (/ & + &7.2088e-05_r8,8.3098e-05_r8,9.5307e-05_r8,1.0860e-04_r8,1.2373e-04_r8/) + kbo(:,46, 5) = (/ & + &5.7589e-05_r8,6.6833e-05_r8,7.7497e-05_r8,8.9096e-05_r8,1.0212e-04_r8/) + kbo(:,47, 5) = (/ & + &4.5404e-05_r8,5.3366e-05_r8,6.2424e-05_r8,7.2413e-05_r8,8.3476e-05_r8/) + kbo(:,48, 5) = (/ & + &3.5296e-05_r8,4.2388e-05_r8,4.9972e-05_r8,5.8618e-05_r8,6.7991e-05_r8/) + kbo(:,49, 5) = (/ & + &2.7057e-05_r8,3.3322e-05_r8,3.9733e-05_r8,4.7217e-05_r8,5.5093e-05_r8/) + kbo(:,50, 5) = (/ & + &2.0028e-05_r8,2.6063e-05_r8,3.1674e-05_r8,3.7934e-05_r8,4.4693e-05_r8/) + kbo(:,51, 5) = (/ & + &1.4762e-05_r8,2.0261e-05_r8,2.5067e-05_r8,3.0345e-05_r8,3.6144e-05_r8/) + kbo(:,52, 5) = (/ & + &1.1471e-05_r8,1.5106e-05_r8,1.9721e-05_r8,2.4107e-05_r8,2.9127e-05_r8/) + kbo(:,53, 5) = (/ & + &8.8078e-06_r8,1.0927e-05_r8,1.5370e-05_r8,1.9101e-05_r8,2.3328e-05_r8/) + kbo(:,54, 5) = (/ & + &6.7922e-06_r8,8.5333e-06_r8,1.1608e-05_r8,1.5114e-05_r8,1.8676e-05_r8/) + kbo(:,55, 5) = (/ & + &5.2087e-06_r8,6.6736e-06_r8,8.5401e-06_r8,1.1909e-05_r8,1.4884e-05_r8/) + kbo(:,56, 5) = (/ & + &3.9778e-06_r8,5.1458e-06_r8,6.5614e-06_r8,9.1281e-06_r8,1.1849e-05_r8/) + kbo(:,57, 5) = (/ & + &3.4293e-06_r8,3.9957e-06_r8,5.1202e-06_r8,6.7753e-06_r8,9.3431e-06_r8/) + kbo(:,58, 5) = (/ & + &3.0812e-06_r8,3.0418e-06_r8,3.9938e-06_r8,5.1720e-06_r8,7.2446e-06_r8/) + kbo(:,59, 5) = (/ & + &2.6710e-06_r8,2.4462e-06_r8,3.2530e-06_r8,4.2384e-06_r8,5.8592e-06_r8/) + kbo(:,13, 6) = (/ & + &4.3826e-02_r8,5.0848e-02_r8,5.7125e-02_r8,6.2916e-02_r8,6.7915e-02_r8/) + kbo(:,14, 6) = (/ & + &3.8242e-02_r8,4.3851e-02_r8,4.9242e-02_r8,5.3907e-02_r8,5.8385e-02_r8/) + kbo(:,15, 6) = (/ & + &3.3170e-02_r8,3.7873e-02_r8,4.2212e-02_r8,4.6203e-02_r8,5.0021e-02_r8/) + kbo(:,16, 6) = (/ & + &2.8430e-02_r8,3.2381e-02_r8,3.6071e-02_r8,3.9408e-02_r8,4.2554e-02_r8/) + kbo(:,17, 6) = (/ & + &2.4252e-02_r8,2.7453e-02_r8,3.0545e-02_r8,3.3265e-02_r8,3.5923e-02_r8/) + kbo(:,18, 6) = (/ & + &2.0461e-02_r8,2.3166e-02_r8,2.5616e-02_r8,2.7856e-02_r8,3.0048e-02_r8/) + kbo(:,19, 6) = (/ & + &1.7273e-02_r8,1.9462e-02_r8,2.1473e-02_r8,2.3367e-02_r8,2.5163e-02_r8/) + kbo(:,20, 6) = (/ & + &1.4713e-02_r8,1.6450e-02_r8,1.8126e-02_r8,1.9702e-02_r8,2.1262e-02_r8/) + kbo(:,21, 6) = (/ & + &1.2468e-02_r8,1.3887e-02_r8,1.5268e-02_r8,1.6611e-02_r8,1.7949e-02_r8/) + kbo(:,22, 6) = (/ & + &1.0608e-02_r8,1.1782e-02_r8,1.2961e-02_r8,1.4100e-02_r8,1.5205e-02_r8/) + kbo(:,23, 6) = (/ & + &8.9996e-03_r8,9.9872e-03_r8,1.1001e-02_r8,1.1992e-02_r8,1.2875e-02_r8/) + kbo(:,24, 6) = (/ & + &7.6639e-03_r8,8.5225e-03_r8,9.3703e-03_r8,1.0166e-02_r8,1.0905e-02_r8/) + kbo(:,25, 6) = (/ & + &6.5402e-03_r8,7.2570e-03_r8,7.9762e-03_r8,8.6328e-03_r8,9.2482e-03_r8/) + kbo(:,26, 6) = (/ & + &5.5998e-03_r8,6.2109e-03_r8,6.7992e-03_r8,7.3298e-03_r8,7.8244e-03_r8/) + kbo(:,27, 6) = (/ & + &4.7932e-03_r8,5.3061e-03_r8,5.7794e-03_r8,6.2257e-03_r8,6.6438e-03_r8/) + kbo(:,28, 6) = (/ & + &4.0951e-03_r8,4.5312e-03_r8,4.9233e-03_r8,5.2892e-03_r8,5.6437e-03_r8/) + kbo(:,29, 6) = (/ & + &3.5062e-03_r8,3.8638e-03_r8,4.1941e-03_r8,4.4995e-03_r8,4.7944e-03_r8/) + kbo(:,30, 6) = (/ & + &2.9997e-03_r8,3.2915e-03_r8,3.5642e-03_r8,3.8238e-03_r8,4.0827e-03_r8/) + kbo(:,31, 6) = (/ & + &2.5609e-03_r8,2.8021e-03_r8,3.0278e-03_r8,3.2471e-03_r8,3.4700e-03_r8/) + kbo(:,32, 6) = (/ & + &2.1838e-03_r8,2.3823e-03_r8,2.5746e-03_r8,2.7615e-03_r8,2.9515e-03_r8/) + kbo(:,33, 6) = (/ & + &1.8610e-03_r8,2.0261e-03_r8,2.1868e-03_r8,2.3490e-03_r8,2.5125e-03_r8/) + kbo(:,34, 6) = (/ & + &1.5812e-03_r8,1.7190e-03_r8,1.8561e-03_r8,1.9953e-03_r8,2.1347e-03_r8/) + kbo(:,35, 6) = (/ & + &1.3323e-03_r8,1.4487e-03_r8,1.5664e-03_r8,1.6864e-03_r8,1.8025e-03_r8/) + kbo(:,36, 6) = (/ & + &1.1120e-03_r8,1.2101e-03_r8,1.3111e-03_r8,1.4134e-03_r8,1.5124e-03_r8/) + kbo(:,37, 6) = (/ & + &9.2067e-04_r8,1.0045e-03_r8,1.0903e-03_r8,1.1790e-03_r8,1.2650e-03_r8/) + kbo(:,38, 6) = (/ & + &7.6186e-04_r8,8.3301e-04_r8,9.0690e-04_r8,9.8204e-04_r8,1.0582e-03_r8/) + kbo(:,39, 6) = (/ & + &6.3121e-04_r8,6.9074e-04_r8,7.5442e-04_r8,8.1836e-04_r8,8.8377e-04_r8/) + kbo(:,40, 6) = (/ & + &5.2096e-04_r8,5.7198e-04_r8,6.2426e-04_r8,6.7904e-04_r8,7.3548e-04_r8/) + kbo(:,41, 6) = (/ & + &4.2992e-04_r8,4.7365e-04_r8,5.1846e-04_r8,5.6371e-04_r8,6.1228e-04_r8/) + kbo(:,42, 6) = (/ & + &3.5500e-04_r8,3.9262e-04_r8,4.3159e-04_r8,4.7009e-04_r8,5.1120e-04_r8/) + kbo(:,43, 6) = (/ & + &2.9285e-04_r8,3.2562e-04_r8,3.5900e-04_r8,3.9210e-04_r8,4.2694e-04_r8/) + kbo(:,44, 6) = (/ & + &2.4061e-04_r8,2.6923e-04_r8,2.9805e-04_r8,3.2732e-04_r8,3.5760e-04_r8/) + kbo(:,45, 6) = (/ & + &1.9754e-04_r8,2.2270e-04_r8,2.4799e-04_r8,2.7345e-04_r8,3.0033e-04_r8/) + kbo(:,46, 6) = (/ & + &1.6118e-04_r8,1.8331e-04_r8,2.0573e-04_r8,2.2834e-04_r8,2.5255e-04_r8/) + kbo(:,47, 6) = (/ & + &1.3001e-04_r8,1.4919e-04_r8,1.6905e-04_r8,1.8953e-04_r8,2.1172e-04_r8/) + kbo(:,48, 6) = (/ & + &1.0430e-04_r8,1.2103e-04_r8,1.3853e-04_r8,1.5665e-04_r8,1.7689e-04_r8/) + kbo(:,49, 6) = (/ & + &8.3158e-05_r8,9.7679e-05_r8,1.1288e-04_r8,1.2898e-04_r8,1.4689e-04_r8/) + kbo(:,50, 6) = (/ & + &6.6182e-05_r8,7.8799e-05_r8,9.1873e-05_r8,1.0601e-04_r8,1.2184e-04_r8/) + kbo(:,51, 6) = (/ & + &5.2460e-05_r8,6.3349e-05_r8,7.4559e-05_r8,8.7033e-05_r8,1.0081e-04_r8/) + kbo(:,52, 6) = (/ & + &4.1391e-05_r8,5.0671e-05_r8,6.0237e-05_r8,7.1015e-05_r8,8.3290e-05_r8/) + kbo(:,53, 6) = (/ & + &3.2451e-05_r8,4.0299e-05_r8,4.8474e-05_r8,5.7732e-05_r8,6.8499e-05_r8/) + kbo(:,54, 6) = (/ & + &2.5414e-05_r8,3.2075e-05_r8,3.9061e-05_r8,4.7059e-05_r8,5.6458e-05_r8/) + kbo(:,55, 6) = (/ & + &1.9791e-05_r8,2.5430e-05_r8,3.1447e-05_r8,3.8320e-05_r8,4.6433e-05_r8/) + kbo(:,56, 6) = (/ & + &1.5282e-05_r8,2.0059e-05_r8,2.5203e-05_r8,3.1033e-05_r8,3.8063e-05_r8/) + kbo(:,57, 6) = (/ & + &1.1377e-05_r8,1.5690e-05_r8,2.0076e-05_r8,2.5035e-05_r8,3.1091e-05_r8/) + kbo(:,58, 6) = (/ & + &8.3098e-06_r8,1.2203e-05_r8,1.5952e-05_r8,2.0176e-05_r8,2.5366e-05_r8/) + kbo(:,59, 6) = (/ & + &6.5651e-06_r8,9.9766e-06_r8,1.3186e-05_r8,1.6915e-05_r8,2.1496e-05_r8/) + kbo(:,13, 7) = (/ & + &1.1534e-01_r8,1.2733e-01_r8,1.3962e-01_r8,1.4987e-01_r8,1.6008e-01_r8/) + kbo(:,14, 7) = (/ & + &9.8557e-02_r8,1.0921e-01_r8,1.1846e-01_r8,1.2756e-01_r8,1.3545e-01_r8/) + kbo(:,15, 7) = (/ & + &8.4816e-02_r8,9.3361e-02_r8,1.0130e-01_r8,1.0828e-01_r8,1.1452e-01_r8/) + kbo(:,16, 7) = (/ & + &7.2792e-02_r8,7.9992e-02_r8,8.6025e-02_r8,9.1745e-02_r8,9.7220e-02_r8/) + kbo(:,17, 7) = (/ & + &6.2250e-02_r8,6.8145e-02_r8,7.3215e-02_r8,7.8161e-02_r8,8.2912e-02_r8/) + kbo(:,18, 7) = (/ & + &5.2897e-02_r8,5.7617e-02_r8,6.2131e-02_r8,6.6296e-02_r8,7.0468e-02_r8/) + kbo(:,19, 7) = (/ & + &4.4630e-02_r8,4.8620e-02_r8,5.2395e-02_r8,5.5983e-02_r8,5.9561e-02_r8/) + kbo(:,20, 7) = (/ & + &3.7638e-02_r8,4.1018e-02_r8,4.4192e-02_r8,4.7348e-02_r8,5.0426e-02_r8/) + kbo(:,21, 7) = (/ & + &3.1712e-02_r8,3.4570e-02_r8,3.7337e-02_r8,4.0055e-02_r8,4.2699e-02_r8/) + kbo(:,22, 7) = (/ & + &2.6951e-02_r8,2.9361e-02_r8,3.1724e-02_r8,3.4058e-02_r8,3.6337e-02_r8/) + kbo(:,23, 7) = (/ & + &2.2985e-02_r8,2.5005e-02_r8,2.7002e-02_r8,2.8884e-02_r8,3.0844e-02_r8/) + kbo(:,24, 7) = (/ & + &1.9564e-02_r8,2.1275e-02_r8,2.2950e-02_r8,2.4579e-02_r8,2.6269e-02_r8/) + kbo(:,25, 7) = (/ & + &1.6678e-02_r8,1.8134e-02_r8,1.9557e-02_r8,2.0984e-02_r8,2.2448e-02_r8/) + kbo(:,26, 7) = (/ & + &1.4215e-02_r8,1.5478e-02_r8,1.6731e-02_r8,1.8053e-02_r8,1.9409e-02_r8/) + kbo(:,27, 7) = (/ & + &1.2146e-02_r8,1.3259e-02_r8,1.4401e-02_r8,1.5542e-02_r8,1.6732e-02_r8/) + kbo(:,28, 7) = (/ & + &1.0451e-02_r8,1.1387e-02_r8,1.2366e-02_r8,1.3378e-02_r8,1.4403e-02_r8/) + kbo(:,29, 7) = (/ & + &8.9638e-03_r8,9.7824e-03_r8,1.0625e-02_r8,1.1522e-02_r8,1.2402e-02_r8/) + kbo(:,30, 7) = (/ & + &7.7059e-03_r8,8.4110e-03_r8,9.1535e-03_r8,9.9173e-03_r8,1.0684e-02_r8/) + kbo(:,31, 7) = (/ & + &6.6159e-03_r8,7.2344e-03_r8,7.8777e-03_r8,8.5358e-03_r8,9.2030e-03_r8/) + kbo(:,32, 7) = (/ & + &5.6925e-03_r8,6.2370e-03_r8,6.7880e-03_r8,7.3601e-03_r8,7.9298e-03_r8/) + kbo(:,33, 7) = (/ & + &4.9047e-03_r8,5.3755e-03_r8,5.8574e-03_r8,6.3478e-03_r8,6.8444e-03_r8/) + kbo(:,34, 7) = (/ & + &4.2261e-03_r8,4.6310e-03_r8,5.0504e-03_r8,5.4765e-03_r8,5.9065e-03_r8/) + kbo(:,35, 7) = (/ & + &3.6014e-03_r8,3.9541e-03_r8,4.3177e-03_r8,4.6806e-03_r8,5.0649e-03_r8/) + kbo(:,36, 7) = (/ & + &3.0405e-03_r8,3.3438e-03_r8,3.6573e-03_r8,3.9714e-03_r8,4.3136e-03_r8/) + kbo(:,37, 7) = (/ & + &2.5476e-03_r8,2.8157e-03_r8,3.0872e-03_r8,3.3632e-03_r8,3.6681e-03_r8/) + kbo(:,38, 7) = (/ & + &2.1334e-03_r8,2.3678e-03_r8,2.6052e-03_r8,2.8532e-03_r8,3.1134e-03_r8/) + kbo(:,39, 7) = (/ & + &1.7845e-03_r8,1.9869e-03_r8,2.1996e-03_r8,2.4178e-03_r8,2.6484e-03_r8/) + kbo(:,40, 7) = (/ & + &1.4840e-03_r8,1.6609e-03_r8,1.8504e-03_r8,2.0474e-03_r8,2.2560e-03_r8/) + kbo(:,41, 7) = (/ & + &1.2344e-03_r8,1.3898e-03_r8,1.5559e-03_r8,1.7345e-03_r8,1.9234e-03_r8/) + kbo(:,42, 7) = (/ & + &1.0314e-03_r8,1.1653e-03_r8,1.3107e-03_r8,1.4669e-03_r8,1.6353e-03_r8/) + kbo(:,43, 7) = (/ & + &8.5631e-04_r8,9.7409e-04_r8,1.1003e-03_r8,1.2355e-03_r8,1.3860e-03_r8/) + kbo(:,44, 7) = (/ & + &7.0883e-04_r8,8.1303e-04_r8,9.2536e-04_r8,1.0435e-03_r8,1.1739e-03_r8/) + kbo(:,45, 7) = (/ & + &5.8732e-04_r8,6.7556e-04_r8,7.7384e-04_r8,8.8025e-04_r8,9.9590e-04_r8/) + kbo(:,46, 7) = (/ & + &4.8484e-04_r8,5.6171e-04_r8,6.4432e-04_r8,7.3847e-04_r8,8.4169e-04_r8/) + kbo(:,47, 7) = (/ & + &3.9752e-04_r8,4.6412e-04_r8,5.3807e-04_r8,6.1858e-04_r8,7.0821e-04_r8/) + kbo(:,48, 7) = (/ & + &3.2593e-04_r8,3.8380e-04_r8,4.4885e-04_r8,5.1997e-04_r8,5.9487e-04_r8/) + kbo(:,49, 7) = (/ & + &2.6581e-04_r8,3.1620e-04_r8,3.7509e-04_r8,4.3658e-04_r8,5.0219e-04_r8/) + kbo(:,50, 7) = (/ & + &2.1682e-04_r8,2.6203e-04_r8,3.1361e-04_r8,3.6786e-04_r8,4.2524e-04_r8/) + kbo(:,51, 7) = (/ & + &1.7696e-04_r8,2.1726e-04_r8,2.6292e-04_r8,3.1080e-04_r8,3.6141e-04_r8/) + kbo(:,52, 7) = (/ & + &1.4350e-04_r8,1.8000e-04_r8,2.2008e-04_r8,2.6275e-04_r8,3.0811e-04_r8/) + kbo(:,53, 7) = (/ & + &1.1566e-04_r8,1.4775e-04_r8,1.8326e-04_r8,2.2179e-04_r8,2.6354e-04_r8/) + kbo(:,54, 7) = (/ & + &9.3174e-05_r8,1.2130e-04_r8,1.5287e-04_r8,1.8794e-04_r8,2.2723e-04_r8/) + kbo(:,55, 7) = (/ & + &7.4812e-05_r8,9.9351e-05_r8,1.2721e-04_r8,1.5976e-04_r8,1.9539e-04_r8/) + kbo(:,56, 7) = (/ & + &5.9751e-05_r8,8.0907e-05_r8,1.0532e-04_r8,1.3503e-04_r8,1.6719e-04_r8/) + kbo(:,57, 7) = (/ & + &4.7338e-05_r8,6.5345e-05_r8,8.6815e-05_r8,1.1307e-04_r8,1.4234e-04_r8/) + kbo(:,58, 7) = (/ & + &3.7388e-05_r8,5.2674e-05_r8,7.1720e-05_r8,9.4757e-05_r8,1.2118e-04_r8/) + kbo(:,59, 7) = (/ & + &3.1368e-05_r8,4.4899e-05_r8,6.2069e-05_r8,8.2754e-05_r8,1.0682e-04_r8/) + kbo(:,13, 8) = (/ & + &3.8513e-01_r8,4.3049e-01_r8,4.7109e-01_r8,5.0795e-01_r8,5.3980e-01_r8/) + kbo(:,14, 8) = (/ & + &3.2769e-01_r8,3.6398e-01_r8,3.9786e-01_r8,4.2776e-01_r8,4.5444e-01_r8/) + kbo(:,15, 8) = (/ & + &2.7898e-01_r8,3.0981e-01_r8,3.3796e-01_r8,3.6334e-01_r8,3.8812e-01_r8/) + kbo(:,16, 8) = (/ & + &2.3683e-01_r8,2.6231e-01_r8,2.8577e-01_r8,3.0755e-01_r8,3.2800e-01_r8/) + kbo(:,17, 8) = (/ & + &2.0036e-01_r8,2.2125e-01_r8,2.4047e-01_r8,2.5907e-01_r8,2.7604e-01_r8/) + kbo(:,18, 8) = (/ & + &1.7015e-01_r8,1.8726e-01_r8,2.0338e-01_r8,2.1873e-01_r8,2.3341e-01_r8/) + kbo(:,19, 8) = (/ & + &1.4494e-01_r8,1.5899e-01_r8,1.7245e-01_r8,1.8542e-01_r8,1.9788e-01_r8/) + kbo(:,20, 8) = (/ & + &1.2385e-01_r8,1.3588e-01_r8,1.4742e-01_r8,1.5823e-01_r8,1.6882e-01_r8/) + kbo(:,21, 8) = (/ & + &1.0654e-01_r8,1.1655e-01_r8,1.2609e-01_r8,1.3545e-01_r8,1.4408e-01_r8/) + kbo(:,22, 8) = (/ & + &9.1991e-02_r8,1.0041e-01_r8,1.0849e-01_r8,1.1626e-01_r8,1.2371e-01_r8/) + kbo(:,23, 8) = (/ & + &7.9046e-02_r8,8.6400e-02_r8,9.3327e-02_r8,9.9889e-02_r8,1.0642e-01_r8/) + kbo(:,24, 8) = (/ & + &6.8021e-02_r8,7.4328e-02_r8,8.0300e-02_r8,8.6084e-02_r8,9.1544e-02_r8/) + kbo(:,25, 8) = (/ & + &5.8516e-02_r8,6.3854e-02_r8,6.9101e-02_r8,7.4075e-02_r8,7.8861e-02_r8/) + kbo(:,26, 8) = (/ & + &5.0443e-02_r8,5.5091e-02_r8,5.9525e-02_r8,6.3760e-02_r8,6.7833e-02_r8/) + kbo(:,27, 8) = (/ & + &4.3538e-02_r8,4.7477e-02_r8,5.1180e-02_r8,5.4850e-02_r8,5.8530e-02_r8/) + kbo(:,28, 8) = (/ & + &3.7617e-02_r8,4.0916e-02_r8,4.4139e-02_r8,4.7301e-02_r8,5.0513e-02_r8/) + kbo(:,29, 8) = (/ & + &3.2546e-02_r8,3.5342e-02_r8,3.8069e-02_r8,4.0845e-02_r8,4.3756e-02_r8/) + kbo(:,30, 8) = (/ & + &2.8067e-02_r8,3.0536e-02_r8,3.2922e-02_r8,3.5388e-02_r8,3.8072e-02_r8/) + kbo(:,31, 8) = (/ & + &2.4245e-02_r8,2.6387e-02_r8,2.8550e-02_r8,3.0769e-02_r8,3.3007e-02_r8/) + kbo(:,32, 8) = (/ & + &2.1010e-02_r8,2.2870e-02_r8,2.4839e-02_r8,2.6760e-02_r8,2.8725e-02_r8/) + kbo(:,33, 8) = (/ & + &1.8247e-02_r8,1.9921e-02_r8,2.1633e-02_r8,2.3376e-02_r8,2.5089e-02_r8/) + kbo(:,34, 8) = (/ & + &1.5899e-02_r8,1.7453e-02_r8,1.8953e-02_r8,2.0489e-02_r8,2.2006e-02_r8/) + kbo(:,35, 8) = (/ & + &1.3799e-02_r8,1.5171e-02_r8,1.6500e-02_r8,1.7816e-02_r8,1.9222e-02_r8/) + kbo(:,36, 8) = (/ & + &1.1856e-02_r8,1.3040e-02_r8,1.4223e-02_r8,1.5409e-02_r8,1.6675e-02_r8/) + kbo(:,37, 8) = (/ & + &1.0122e-02_r8,1.1172e-02_r8,1.2227e-02_r8,1.3320e-02_r8,1.4426e-02_r8/) + kbo(:,38, 8) = (/ & + &8.6297e-03_r8,9.5720e-03_r8,1.0548e-02_r8,1.1499e-02_r8,1.2504e-02_r8/) + kbo(:,39, 8) = (/ & + &7.3583e-03_r8,8.2086e-03_r8,9.0807e-03_r8,9.9445e-03_r8,1.0852e-02_r8/) + kbo(:,40, 8) = (/ & + &6.2575e-03_r8,7.0294e-03_r8,7.8131e-03_r8,8.5974e-03_r8,9.4311e-03_r8/) + kbo(:,41, 8) = (/ & + &5.3221e-03_r8,6.0117e-03_r8,6.7242e-03_r8,7.4367e-03_r8,8.2130e-03_r8/) + kbo(:,42, 8) = (/ & + &4.5217e-03_r8,5.1291e-03_r8,5.7774e-03_r8,6.4411e-03_r8,7.1607e-03_r8/) + kbo(:,43, 8) = (/ & + &3.8118e-03_r8,4.3626e-03_r8,4.9535e-03_r8,5.5702e-03_r8,6.2186e-03_r8/) + kbo(:,44, 8) = (/ & + &3.1928e-03_r8,3.7055e-03_r8,4.2384e-03_r8,4.7956e-03_r8,5.3949e-03_r8/) + kbo(:,45, 8) = (/ & + &2.6724e-03_r8,3.1345e-03_r8,3.6292e-03_r8,4.1408e-03_r8,4.6835e-03_r8/) + kbo(:,46, 8) = (/ & + &2.2327e-03_r8,2.6446e-03_r8,3.0956e-03_r8,3.5684e-03_r8,4.0653e-03_r8/) + kbo(:,47, 8) = (/ & + &1.8490e-03_r8,2.2161e-03_r8,2.6105e-03_r8,3.0391e-03_r8,3.5058e-03_r8/) + kbo(:,48, 8) = (/ & + &1.5271e-03_r8,1.8513e-03_r8,2.2029e-03_r8,2.5798e-03_r8,3.0175e-03_r8/) + kbo(:,49, 8) = (/ & + &1.2568e-03_r8,1.5444e-03_r8,1.8551e-03_r8,2.1969e-03_r8,2.5931e-03_r8/) + kbo(:,50, 8) = (/ & + &1.0411e-03_r8,1.2920e-03_r8,1.5680e-03_r8,1.8789e-03_r8,2.2434e-03_r8/) + kbo(:,51, 8) = (/ & + &8.6157e-04_r8,1.0792e-03_r8,1.3252e-03_r8,1.6044e-03_r8,1.9374e-03_r8/) + kbo(:,52, 8) = (/ & + &7.1345e-04_r8,8.9803e-04_r8,1.1146e-03_r8,1.3696e-03_r8,1.6714e-03_r8/) + kbo(:,53, 8) = (/ & + &5.9120e-04_r8,7.4871e-04_r8,9.4040e-04_r8,1.1662e-03_r8,1.4395e-03_r8/) + kbo(:,54, 8) = (/ & + &4.9248e-04_r8,6.3323e-04_r8,7.9771e-04_r8,9.9957e-04_r8,1.2405e-03_r8/) + kbo(:,55, 8) = (/ & + &4.1065e-04_r8,5.3488e-04_r8,6.8225e-04_r8,8.6108e-04_r8,1.0736e-03_r8/) + kbo(:,56, 8) = (/ & + &3.4182e-04_r8,4.5283e-04_r8,5.8716e-04_r8,7.4149e-04_r8,9.3761e-04_r8/) + kbo(:,57, 8) = (/ & + &2.8276e-04_r8,3.8428e-04_r8,5.0468e-04_r8,6.4575e-04_r8,8.2300e-04_r8/) + kbo(:,58, 8) = (/ & + &2.3443e-04_r8,3.2611e-04_r8,4.3528e-04_r8,5.6896e-04_r8,7.2980e-04_r8/) + kbo(:,59, 8) = (/ & + &2.0666e-04_r8,2.9266e-04_r8,3.9707e-04_r8,5.2680e-04_r8,6.7824e-04_r8/) + kbo(:,13, 9) = (/ & + &2.6929e+00_r8,3.0365e+00_r8,3.3480e+00_r8,3.6295e+00_r8,3.8842e+00_r8/) + kbo(:,14, 9) = (/ & + &2.3218e+00_r8,2.6065e+00_r8,2.8670e+00_r8,3.1040e+00_r8,3.3162e+00_r8/) + kbo(:,15, 9) = (/ & + &1.9883e+00_r8,2.2252e+00_r8,2.4424e+00_r8,2.6373e+00_r8,2.8081e+00_r8/) + kbo(:,16, 9) = (/ & + &1.6988e+00_r8,1.8964e+00_r8,2.0747e+00_r8,2.2343e+00_r8,2.3791e+00_r8/) + kbo(:,17, 9) = (/ & + &1.4495e+00_r8,1.6116e+00_r8,1.7595e+00_r8,1.8933e+00_r8,2.0138e+00_r8/) + kbo(:,18, 9) = (/ & + &1.2318e+00_r8,1.3662e+00_r8,1.4893e+00_r8,1.6003e+00_r8,1.6980e+00_r8/) + kbo(:,19, 9) = (/ & + &1.0432e+00_r8,1.1554e+00_r8,1.2571e+00_r8,1.3476e+00_r8,1.4284e+00_r8/) + kbo(:,20, 9) = (/ & + &8.8399e-01_r8,9.7584e-01_r8,1.0583e+00_r8,1.1327e+00_r8,1.2000e+00_r8/) + kbo(:,21, 9) = (/ & + &7.4719e-01_r8,8.2246e-01_r8,8.9025e-01_r8,9.5182e-01_r8,1.0085e+00_r8/) + kbo(:,22, 9) = (/ & + &6.3607e-01_r8,6.9712e-01_r8,7.5292e-01_r8,8.0394e-01_r8,8.5135e-01_r8/) + kbo(:,23, 9) = (/ & + &5.4262e-01_r8,5.9143e-01_r8,6.3738e-01_r8,6.8008e-01_r8,7.1995e-01_r8/) + kbo(:,24, 9) = (/ & + &4.6285e-01_r8,5.0331e-01_r8,5.4067e-01_r8,5.7573e-01_r8,6.1046e-01_r8/) + kbo(:,25, 9) = (/ & + &3.9562e-01_r8,4.2919e-01_r8,4.6040e-01_r8,4.9042e-01_r8,5.1991e-01_r8/) + kbo(:,26, 9) = (/ & + &3.4017e-01_r8,3.6788e-01_r8,3.9442e-01_r8,4.2037e-01_r8,4.4731e-01_r8/) + kbo(:,27, 9) = (/ & + &2.9399e-01_r8,3.1651e-01_r8,3.3903e-01_r8,3.6222e-01_r8,3.8618e-01_r8/) + kbo(:,28, 9) = (/ & + &2.5435e-01_r8,2.7396e-01_r8,2.9328e-01_r8,3.1366e-01_r8,3.3524e-01_r8/) + kbo(:,29, 9) = (/ & + &2.2098e-01_r8,2.3815e-01_r8,2.5600e-01_r8,2.7395e-01_r8,2.9332e-01_r8/) + kbo(:,30, 9) = (/ & + &1.9332e-01_r8,2.0838e-01_r8,2.2416e-01_r8,2.4057e-01_r8,2.5735e-01_r8/) + kbo(:,31, 9) = (/ & + &1.6991e-01_r8,1.8327e-01_r8,1.9737e-01_r8,2.1207e-01_r8,2.2734e-01_r8/) + kbo(:,32, 9) = (/ & + &1.4986e-01_r8,1.6194e-01_r8,1.7445e-01_r8,1.8782e-01_r8,2.0152e-01_r8/) + kbo(:,33, 9) = (/ & + &1.3279e-01_r8,1.4378e-01_r8,1.5504e-01_r8,1.6697e-01_r8,1.7955e-01_r8/) + kbo(:,34, 9) = (/ & + &1.1789e-01_r8,1.2771e-01_r8,1.3816e-01_r8,1.4885e-01_r8,1.6033e-01_r8/) + kbo(:,35, 9) = (/ & + &1.0423e-01_r8,1.1314e-01_r8,1.2268e-01_r8,1.3249e-01_r8,1.4303e-01_r8/) + kbo(:,36, 9) = (/ & + &9.1569e-02_r8,9.9843e-02_r8,1.0848e-01_r8,1.1752e-01_r8,1.2715e-01_r8/) + kbo(:,37, 9) = (/ & + &7.9654e-02_r8,8.7324e-02_r8,9.5396e-02_r8,1.0365e-01_r8,1.1217e-01_r8/) + kbo(:,38, 9) = (/ & + &6.9582e-02_r8,7.6500e-02_r8,8.3939e-02_r8,9.1706e-02_r8,9.9308e-02_r8/) + kbo(:,39, 9) = (/ & + &6.0817e-02_r8,6.7147e-02_r8,7.4089e-02_r8,8.1389e-02_r8,8.8469e-02_r8/) + kbo(:,40, 9) = (/ & + &5.2895e-02_r8,5.8816e-02_r8,6.5088e-02_r8,7.1837e-02_r8,7.8761e-02_r8/) + kbo(:,41, 9) = (/ & + &4.5994e-02_r8,5.1507e-02_r8,5.7306e-02_r8,6.3493e-02_r8,7.0017e-02_r8/) + kbo(:,42, 9) = (/ & + &3.9933e-02_r8,4.5126e-02_r8,5.0659e-02_r8,5.6440e-02_r8,6.2355e-02_r8/) + kbo(:,43, 9) = (/ & + &3.4407e-02_r8,3.9333e-02_r8,4.4505e-02_r8,5.0025e-02_r8,5.5477e-02_r8/) + kbo(:,44, 9) = (/ & + &2.9641e-02_r8,3.4179e-02_r8,3.9085e-02_r8,4.4243e-02_r8,4.9585e-02_r8/) + kbo(:,45, 9) = (/ & + &2.5534e-02_r8,2.9717e-02_r8,3.4321e-02_r8,3.9331e-02_r8,4.4385e-02_r8/) + kbo(:,46, 9) = (/ & + &2.1943e-02_r8,2.5772e-02_r8,3.0011e-02_r8,3.4665e-02_r8,3.9677e-02_r8/) + kbo(:,47, 9) = (/ & + &1.8799e-02_r8,2.2299e-02_r8,2.6155e-02_r8,3.0452e-02_r8,3.5108e-02_r8/) + kbo(:,48, 9) = (/ & + &1.6134e-02_r8,1.9292e-02_r8,2.2898e-02_r8,2.6798e-02_r8,3.1152e-02_r8/) + kbo(:,49, 9) = (/ & + &1.3799e-02_r8,1.6693e-02_r8,1.9932e-02_r8,2.3629e-02_r8,2.7686e-02_r8/) + kbo(:,50, 9) = (/ & + &1.1807e-02_r8,1.4439e-02_r8,1.7455e-02_r8,2.0914e-02_r8,2.4717e-02_r8/) + kbo(:,51, 9) = (/ & + &1.0105e-02_r8,1.2520e-02_r8,1.5304e-02_r8,1.8588e-02_r8,2.2129e-02_r8/) + kbo(:,52, 9) = (/ & + &8.6629e-03_r8,1.0849e-02_r8,1.3445e-02_r8,1.6444e-02_r8,1.9913e-02_r8/) + kbo(:,53, 9) = (/ & + &7.4874e-03_r8,9.4257e-03_r8,1.1801e-02_r8,1.4610e-02_r8,1.7870e-02_r8/) + kbo(:,54, 9) = (/ & + &6.4970e-03_r8,8.2758e-03_r8,1.0456e-02_r8,1.3093e-02_r8,1.6122e-02_r8/) + kbo(:,55, 9) = (/ & + &5.6140e-03_r8,7.3217e-03_r8,9.3276e-03_r8,1.1747e-02_r8,1.4696e-02_r8/) + kbo(:,56, 9) = (/ & + &4.8349e-03_r8,6.4792e-03_r8,8.3317e-03_r8,1.0602e-02_r8,1.3343e-02_r8/) + kbo(:,57, 9) = (/ & + &4.1640e-03_r8,5.6963e-03_r8,7.4736e-03_r8,9.6066e-03_r8,1.2192e-02_r8/) + kbo(:,58, 9) = (/ & + &3.5901e-03_r8,5.0045e-03_r8,6.7274e-03_r8,8.7656e-03_r8,1.1231e-02_r8/) + kbo(:,59, 9) = (/ & + &3.3029e-03_r8,4.6798e-03_r8,6.3469e-03_r8,8.3368e-03_r8,1.0817e-02_r8/) + kbo(:,13,10) = (/ & + &1.1103e+01_r8,1.2502e+01_r8,1.3897e+01_r8,1.5277e+01_r8,1.6528e+01_r8/) + kbo(:,14,10) = (/ & + &9.9415e+00_r8,1.1260e+01_r8,1.2546e+01_r8,1.3697e+01_r8,1.4756e+01_r8/) + kbo(:,15,10) = (/ & + &8.8808e+00_r8,1.0035e+01_r8,1.1086e+01_r8,1.2088e+01_r8,1.3034e+01_r8/) + kbo(:,16,10) = (/ & + &7.8211e+00_r8,8.7752e+00_r8,9.7015e+00_r8,1.0578e+01_r8,1.1354e+01_r8/) + kbo(:,17,10) = (/ & + &6.7833e+00_r8,7.6204e+00_r8,8.4176e+00_r8,9.1234e+00_r8,9.7674e+00_r8/) + kbo(:,18,10) = (/ & + &5.8703e+00_r8,6.5862e+00_r8,7.2317e+00_r8,7.8324e+00_r8,8.4128e+00_r8/) + kbo(:,19,10) = (/ & + &5.0772e+00_r8,5.6603e+00_r8,6.2160e+00_r8,6.7517e+00_r8,7.2522e+00_r8/) + kbo(:,20,10) = (/ & + &4.3641e+00_r8,4.8646e+00_r8,5.3518e+00_r8,5.8113e+00_r8,6.2183e+00_r8/) + kbo(:,21,10) = (/ & + &3.7436e+00_r8,4.1787e+00_r8,4.5968e+00_r8,4.9653e+00_r8,5.2958e+00_r8/) + kbo(:,22,10) = (/ & + &3.2384e+00_r8,3.6097e+00_r8,3.9430e+00_r8,4.2432e+00_r8,4.5244e+00_r8/) + kbo(:,23,10) = (/ & + &2.7953e+00_r8,3.1049e+00_r8,3.3758e+00_r8,3.6302e+00_r8,3.8688e+00_r8/) + kbo(:,24,10) = (/ & + &2.4111e+00_r8,2.6600e+00_r8,2.8956e+00_r8,3.1175e+00_r8,3.3165e+00_r8/) + kbo(:,25,10) = (/ & + &2.0794e+00_r8,2.2877e+00_r8,2.4858e+00_r8,2.6707e+00_r8,2.8419e+00_r8/) + kbo(:,26,10) = (/ & + &1.7863e+00_r8,1.9622e+00_r8,2.1280e+00_r8,2.2830e+00_r8,2.4241e+00_r8/) + kbo(:,27,10) = (/ & + &1.5261e+00_r8,1.6805e+00_r8,1.8222e+00_r8,1.9507e+00_r8,2.0763e+00_r8/) + kbo(:,28,10) = (/ & + &1.3094e+00_r8,1.4366e+00_r8,1.5593e+00_r8,1.6738e+00_r8,1.7905e+00_r8/) + kbo(:,29,10) = (/ & + &1.1331e+00_r8,1.2336e+00_r8,1.3334e+00_r8,1.4402e+00_r8,1.5544e+00_r8/) + kbo(:,30,10) = (/ & + &9.7850e-01_r8,1.0622e+00_r8,1.1514e+00_r8,1.2513e+00_r8,1.3634e+00_r8/) + kbo(:,31,10) = (/ & + &8.4902e-01_r8,9.2389e-01_r8,1.0050e+00_r8,1.1001e+00_r8,1.2086e+00_r8/) + kbo(:,32,10) = (/ & + &7.4130e-01_r8,8.0932e-01_r8,8.8870e-01_r8,9.7905e-01_r8,1.0856e+00_r8/) + kbo(:,33,10) = (/ & + &6.5296e-01_r8,7.1655e-01_r8,7.9236e-01_r8,8.8248e-01_r8,9.8250e-01_r8/) + kbo(:,34,10) = (/ & + &5.7962e-01_r8,6.3885e-01_r8,7.0985e-01_r8,7.9650e-01_r8,8.9263e-01_r8/) + kbo(:,35,10) = (/ & + &5.1372e-01_r8,5.6904e-01_r8,6.3621e-01_r8,7.1633e-01_r8,8.0771e-01_r8/) + kbo(:,36,10) = (/ & + &4.5469e-01_r8,5.0394e-01_r8,5.6668e-01_r8,6.4061e-01_r8,7.2625e-01_r8/) + kbo(:,37,10) = (/ & + &3.9957e-01_r8,4.4312e-01_r8,4.9317e-01_r8,5.6045e-01_r8,6.4131e-01_r8/) + kbo(:,38,10) = (/ & + &3.5188e-01_r8,3.9249e-01_r8,4.3332e-01_r8,4.9135e-01_r8,5.6831e-01_r8/) + kbo(:,39,10) = (/ & + &3.1275e-01_r8,3.5014e-01_r8,3.8817e-01_r8,4.3541e-01_r8,5.0377e-01_r8/) + kbo(:,40,10) = (/ & + &2.7524e-01_r8,3.0717e-01_r8,3.4405e-01_r8,3.8385e-01_r8,4.3866e-01_r8/) + kbo(:,41,10) = (/ & + &2.4392e-01_r8,2.7163e-01_r8,3.0427e-01_r8,3.4320e-01_r8,3.8763e-01_r8/) + kbo(:,42,10) = (/ & + &2.1672e-01_r8,2.4359e-01_r8,2.7030e-01_r8,3.0489e-01_r8,3.4816e-01_r8/) + kbo(:,43,10) = (/ & + &1.9366e-01_r8,2.1755e-01_r8,2.4331e-01_r8,2.6943e-01_r8,3.1064e-01_r8/) + kbo(:,44,10) = (/ & + &1.7412e-01_r8,1.9505e-01_r8,2.1790e-01_r8,2.4485e-01_r8,2.7503e-01_r8/) + kbo(:,45,10) = (/ & + &1.5640e-01_r8,1.7593e-01_r8,1.9695e-01_r8,2.2100e-01_r8,2.4918e-01_r8/) + kbo(:,46,10) = (/ & + &1.3989e-01_r8,1.5897e-01_r8,1.7897e-01_r8,2.0081e-01_r8,2.2644e-01_r8/) + kbo(:,47,10) = (/ & + &1.2271e-01_r8,1.4204e-01_r8,1.6295e-01_r8,1.8322e-01_r8,2.0661e-01_r8/) + kbo(:,48,10) = (/ & + &1.0686e-01_r8,1.2583e-01_r8,1.4636e-01_r8,1.6777e-01_r8,1.9011e-01_r8/) + kbo(:,49,10) = (/ & + &9.3685e-02_r8,1.1078e-01_r8,1.3130e-01_r8,1.5261e-01_r8,1.7455e-01_r8/) + kbo(:,50,10) = (/ & + &8.2656e-02_r8,9.8591e-02_r8,1.1744e-01_r8,1.3916e-01_r8,1.6129e-01_r8/) + kbo(:,51,10) = (/ & + &7.2693e-02_r8,8.8183e-02_r8,1.0575e-01_r8,1.2537e-01_r8,1.4856e-01_r8/) + kbo(:,52,10) = (/ & + &6.4048e-02_r8,7.9108e-02_r8,9.5503e-02_r8,1.1470e-01_r8,1.3627e-01_r8/) + kbo(:,53,10) = (/ & + &5.5496e-02_r8,7.0682e-02_r8,8.5938e-02_r8,1.0406e-01_r8,1.2637e-01_r8/) + kbo(:,54,10) = (/ & + &4.9035e-02_r8,6.2876e-02_r8,7.7887e-02_r8,9.5399e-02_r8,1.1721e-01_r8/) + kbo(:,55,10) = (/ & + &4.3446e-02_r8,5.6855e-02_r8,7.1213e-02_r8,8.8342e-02_r8,1.0826e-01_r8/) + kbo(:,56,10) = (/ & + &3.8859e-02_r8,5.1445e-02_r8,6.5981e-02_r8,8.2010e-02_r8,1.0158e-01_r8/) + kbo(:,57,10) = (/ & + &3.5022e-02_r8,4.6988e-02_r8,6.1022e-02_r8,7.6424e-02_r8,9.5735e-02_r8/) + kbo(:,58,10) = (/ & + &3.1909e-02_r8,4.3092e-02_r8,5.6695e-02_r8,7.2335e-02_r8,9.0564e-02_r8/) + kbo(:,59,10) = (/ & + &3.0556e-02_r8,4.1959e-02_r8,5.5206e-02_r8,7.1568e-02_r8,9.0259e-02_r8/) + kbo(:,13,11) = (/ & + &1.9005e+01_r8,2.1823e+01_r8,2.4335e+01_r8,2.6560e+01_r8,2.8649e+01_r8/) + kbo(:,14,11) = (/ & + &1.8043e+01_r8,2.0403e+01_r8,2.2563e+01_r8,2.4639e+01_r8,2.6669e+01_r8/) + kbo(:,15,11) = (/ & + &1.6503e+01_r8,1.8586e+01_r8,2.0593e+01_r8,2.2552e+01_r8,2.4342e+01_r8/) + kbo(:,16,11) = (/ & + &1.4859e+01_r8,1.6766e+01_r8,1.8612e+01_r8,2.0317e+01_r8,2.1884e+01_r8/) + kbo(:,17,11) = (/ & + &1.3269e+01_r8,1.4973e+01_r8,1.6543e+01_r8,1.8024e+01_r8,1.9429e+01_r8/) + kbo(:,18,11) = (/ & + &1.1718e+01_r8,1.3157e+01_r8,1.4545e+01_r8,1.5849e+01_r8,1.7039e+01_r8/) + kbo(:,19,11) = (/ & + &1.0207e+01_r8,1.1484e+01_r8,1.2680e+01_r8,1.3769e+01_r8,1.4775e+01_r8/) + kbo(:,20,11) = (/ & + &8.8979e+00_r8,9.9836e+00_r8,1.0976e+01_r8,1.1897e+01_r8,1.2806e+01_r8/) + kbo(:,21,11) = (/ & + &7.7345e+00_r8,8.6287e+00_r8,9.4674e+00_r8,1.0308e+01_r8,1.1126e+01_r8/) + kbo(:,22,11) = (/ & + &6.7360e+00_r8,7.4922e+00_r8,8.2529e+00_r8,8.9982e+00_r8,9.7172e+00_r8/) + kbo(:,23,11) = (/ & + &5.8386e+00_r8,6.5155e+00_r8,7.1951e+00_r8,7.8490e+00_r8,8.4500e+00_r8/) + kbo(:,24,11) = (/ & + &5.0807e+00_r8,5.6843e+00_r8,6.2699e+00_r8,6.8121e+00_r8,7.3100e+00_r8/) + kbo(:,25,11) = (/ & + &4.4422e+00_r8,4.9643e+00_r8,5.4499e+00_r8,5.8998e+00_r8,6.3372e+00_r8/) + kbo(:,26,11) = (/ & + &3.9004e+00_r8,4.3334e+00_r8,4.7344e+00_r8,5.1243e+00_r8,5.5060e+00_r8/) + kbo(:,27,11) = (/ & + &3.4204e+00_r8,3.7816e+00_r8,4.1294e+00_r8,4.4714e+00_r8,4.7992e+00_r8/) + kbo(:,28,11) = (/ & + &2.9981e+00_r8,3.3076e+00_r8,3.6130e+00_r8,3.9107e+00_r8,4.1979e+00_r8/) + kbo(:,29,11) = (/ & + &2.6272e+00_r8,2.9045e+00_r8,3.1705e+00_r8,3.4300e+00_r8,3.6761e+00_r8/) + kbo(:,30,11) = (/ & + &2.3072e+00_r8,2.5571e+00_r8,2.7905e+00_r8,3.0127e+00_r8,3.2425e+00_r8/) + kbo(:,31,11) = (/ & + &2.0315e+00_r8,2.2496e+00_r8,2.4602e+00_r8,2.6655e+00_r8,2.8882e+00_r8/) + kbo(:,32,11) = (/ & + &1.7947e+00_r8,1.9859e+00_r8,2.1751e+00_r8,2.3754e+00_r8,2.5995e+00_r8/) + kbo(:,33,11) = (/ & + &1.5917e+00_r8,1.7608e+00_r8,1.9393e+00_r8,2.1339e+00_r8,2.3696e+00_r8/) + kbo(:,34,11) = (/ & + &1.4106e+00_r8,1.5681e+00_r8,1.7384e+00_r8,1.9365e+00_r8,2.1773e+00_r8/) + kbo(:,35,11) = (/ & + &1.2470e+00_r8,1.3941e+00_r8,1.5593e+00_r8,1.7605e+00_r8,1.9959e+00_r8/) + kbo(:,36,11) = (/ & + &1.0975e+00_r8,1.2350e+00_r8,1.3953e+00_r8,1.5917e+00_r8,1.8213e+00_r8/) + kbo(:,37,11) = (/ & + &9.5256e-01_r8,1.0776e+00_r8,1.2351e+00_r8,1.4193e+00_r8,1.6407e+00_r8/) + kbo(:,38,11) = (/ & + &8.3116e-01_r8,9.4539e-01_r8,1.0963e+00_r8,1.2721e+00_r8,1.4845e+00_r8/) + kbo(:,39,11) = (/ & + &7.2978e-01_r8,8.3514e-01_r8,9.7338e-01_r8,1.1448e+00_r8,1.3526e+00_r8/) + kbo(:,40,11) = (/ & + &6.3508e-01_r8,7.2958e-01_r8,8.5453e-01_r8,1.0153e+00_r8,1.2157e+00_r8/) + kbo(:,41,11) = (/ & + &5.5559e-01_r8,6.3933e-01_r8,7.5266e-01_r8,8.9822e-01_r8,1.0902e+00_r8/) + kbo(:,42,11) = (/ & + &4.9132e-01_r8,5.6247e-01_r8,6.6545e-01_r8,8.0063e-01_r8,9.7700e-01_r8/) + kbo(:,43,11) = (/ & + &4.3434e-01_r8,4.9358e-01_r8,5.8232e-01_r8,7.0818e-01_r8,8.6923e-01_r8/) + kbo(:,44,11) = (/ & + &3.8638e-01_r8,4.3517e-01_r8,5.1097e-01_r8,6.1891e-01_r8,7.7146e-01_r8/) + kbo(:,45,11) = (/ & + &3.4515e-01_r8,3.9086e-01_r8,4.5155e-01_r8,5.4453e-01_r8,6.8039e-01_r8/) + kbo(:,46,11) = (/ & + &3.1047e-01_r8,3.4972e-01_r8,4.0476e-01_r8,4.8078e-01_r8,5.9879e-01_r8/) + kbo(:,47,11) = (/ & + &2.8096e-01_r8,3.1543e-01_r8,3.6034e-01_r8,4.2515e-01_r8,5.2456e-01_r8/) + kbo(:,48,11) = (/ & + &2.5443e-01_r8,2.8861e-01_r8,3.2488e-01_r8,3.8074e-01_r8,4.6176e-01_r8/) + kbo(:,49,11) = (/ & + &2.3075e-01_r8,2.6370e-01_r8,2.9745e-01_r8,3.4508e-01_r8,4.1364e-01_r8/) + kbo(:,50,11) = (/ & + &2.0955e-01_r8,2.4450e-01_r8,2.7626e-01_r8,3.1515e-01_r8,3.7610e-01_r8/) + kbo(:,51,11) = (/ & + &1.9162e-01_r8,2.2508e-01_r8,2.5888e-01_r8,2.9434e-01_r8,3.4519e-01_r8/) + kbo(:,52,11) = (/ & + &1.7326e-01_r8,2.0725e-01_r8,2.4087e-01_r8,2.7521e-01_r8,3.1976e-01_r8/) + kbo(:,53,11) = (/ & + &1.5761e-01_r8,1.9120e-01_r8,2.2695e-01_r8,2.6019e-01_r8,2.9822e-01_r8/) + kbo(:,54,11) = (/ & + &1.4365e-01_r8,1.7736e-01_r8,2.1379e-01_r8,2.4744e-01_r8,2.8175e-01_r8/) + kbo(:,55,11) = (/ & + &1.3037e-01_r8,1.6532e-01_r8,2.0060e-01_r8,2.3640e-01_r8,2.6972e-01_r8/) + kbo(:,56,11) = (/ & + &1.1768e-01_r8,1.5347e-01_r8,1.8925e-01_r8,2.2636e-01_r8,2.6180e-01_r8/) + kbo(:,57,11) = (/ & + &1.0584e-01_r8,1.4146e-01_r8,1.7843e-01_r8,2.1611e-01_r8,2.5112e-01_r8/) + kbo(:,58,11) = (/ & + &9.5443e-02_r8,1.3188e-01_r8,1.6746e-01_r8,2.0707e-01_r8,2.4328e-01_r8/) + kbo(:,59,11) = (/ & + &9.0897e-02_r8,1.2729e-01_r8,1.6511e-01_r8,2.0322e-01_r8,2.4119e-01_r8/) + kbo(:,13,12) = (/ & + &3.3504e+01_r8,3.7950e+01_r8,4.2337e+01_r8,4.6726e+01_r8,5.1022e+01_r8/) + kbo(:,14,12) = (/ & + &3.2726e+01_r8,3.7291e+01_r8,4.1814e+01_r8,4.6223e+01_r8,5.0163e+01_r8/) + kbo(:,15,12) = (/ & + &3.1900e+01_r8,3.6439e+01_r8,4.0782e+01_r8,4.4671e+01_r8,4.8184e+01_r8/) + kbo(:,16,12) = (/ & + &3.0776e+01_r8,3.4900e+01_r8,3.8620e+01_r8,4.2065e+01_r8,4.5353e+01_r8/) + kbo(:,17,12) = (/ & + &2.8746e+01_r8,3.2300e+01_r8,3.5697e+01_r8,3.8925e+01_r8,4.2020e+01_r8/) + kbo(:,18,12) = (/ & + &2.6146e+01_r8,2.9399e+01_r8,3.2494e+01_r8,3.5494e+01_r8,3.8316e+01_r8/) + kbo(:,19,12) = (/ & + &2.3524e+01_r8,2.6429e+01_r8,2.9272e+01_r8,3.2000e+01_r8,3.4621e+01_r8/) + kbo(:,20,12) = (/ & + &2.1002e+01_r8,2.3641e+01_r8,2.6168e+01_r8,2.8626e+01_r8,3.0966e+01_r8/) + kbo(:,21,12) = (/ & + &1.8638e+01_r8,2.0929e+01_r8,2.3211e+01_r8,2.5404e+01_r8,2.7506e+01_r8/) + kbo(:,22,12) = (/ & + &1.6511e+01_r8,1.8592e+01_r8,2.0614e+01_r8,2.2575e+01_r8,2.4466e+01_r8/) + kbo(:,23,12) = (/ & + &1.4666e+01_r8,1.6512e+01_r8,1.8295e+01_r8,2.0007e+01_r8,2.1707e+01_r8/) + kbo(:,24,12) = (/ & + &1.3045e+01_r8,1.4646e+01_r8,1.6188e+01_r8,1.7728e+01_r8,1.9330e+01_r8/) + kbo(:,25,12) = (/ & + &1.1583e+01_r8,1.2959e+01_r8,1.4347e+01_r8,1.5799e+01_r8,1.7308e+01_r8/) + kbo(:,26,12) = (/ & + &1.0289e+01_r8,1.1524e+01_r8,1.2828e+01_r8,1.4195e+01_r8,1.5608e+01_r8/) + kbo(:,27,12) = (/ & + &9.1629e+00_r8,1.0320e+01_r8,1.1545e+01_r8,1.2818e+01_r8,1.4160e+01_r8/) + kbo(:,28,12) = (/ & + &8.1951e+00_r8,9.2900e+00_r8,1.0435e+01_r8,1.1638e+01_r8,1.2904e+01_r8/) + kbo(:,29,12) = (/ & + &7.3862e+00_r8,8.4074e+00_r8,9.4905e+00_r8,1.0629e+01_r8,1.1848e+01_r8/) + kbo(:,30,12) = (/ & + &6.7112e+00_r8,7.6605e+00_r8,8.6762e+00_r8,9.7816e+00_r8,1.0954e+01_r8/) + kbo(:,31,12) = (/ & + &6.1419e+00_r8,7.0283e+00_r8,8.0036e+00_r8,9.0662e+00_r8,1.0224e+01_r8/) + kbo(:,32,12) = (/ & + &5.6561e+00_r8,6.5080e+00_r8,7.4459e+00_r8,8.4904e+00_r8,9.6547e+00_r8/) + kbo(:,33,12) = (/ & + &5.2496e+00_r8,6.0774e+00_r8,7.0019e+00_r8,8.0523e+00_r8,9.2390e+00_r8/) + kbo(:,34,12) = (/ & + &4.8878e+00_r8,5.7010e+00_r8,6.6301e+00_r8,7.6985e+00_r8,8.9231e+00_r8/) + kbo(:,35,12) = (/ & + &4.5253e+00_r8,5.3274e+00_r8,6.2605e+00_r8,7.3465e+00_r8,8.6116e+00_r8/) + kbo(:,36,12) = (/ & + &4.1488e+00_r8,4.9390e+00_r8,5.8698e+00_r8,6.9625e+00_r8,8.2516e+00_r8/) + kbo(:,37,12) = (/ & + &3.7312e+00_r8,4.4908e+00_r8,5.4013e+00_r8,6.4804e+00_r8,7.7554e+00_r8/) + kbo(:,38,12) = (/ & + &3.3680e+00_r8,4.1012e+00_r8,4.9908e+00_r8,6.0547e+00_r8,7.3121e+00_r8/) + kbo(:,39,12) = (/ & + &3.0586e+00_r8,3.7669e+00_r8,4.6363e+00_r8,5.6845e+00_r8,6.9229e+00_r8/) + kbo(:,40,12) = (/ & + &2.7296e+00_r8,3.4041e+00_r8,4.2320e+00_r8,5.2462e+00_r8,6.4437e+00_r8/) + kbo(:,41,12) = (/ & + &2.4362e+00_r8,3.0740e+00_r8,3.8624e+00_r8,4.8348e+00_r8,5.9904e+00_r8/) + kbo(:,42,12) = (/ & + &2.1809e+00_r8,2.7810e+00_r8,3.5324e+00_r8,4.4598e+00_r8,5.5747e+00_r8/) + kbo(:,43,12) = (/ & + &1.9255e+00_r8,2.4860e+00_r8,3.1917e+00_r8,4.0645e+00_r8,5.1258e+00_r8/) + kbo(:,44,12) = (/ & + &1.6844e+00_r8,2.2090e+00_r8,2.8652e+00_r8,3.6821e+00_r8,4.6820e+00_r8/) + kbo(:,45,12) = (/ & + &1.4745e+00_r8,1.9569e+00_r8,2.5696e+00_r8,3.3333e+00_r8,4.2717e+00_r8/) + kbo(:,46,12) = (/ & + &1.2799e+00_r8,1.7238e+00_r8,2.2842e+00_r8,2.9993e+00_r8,3.8727e+00_r8/) + kbo(:,47,12) = (/ & + &1.0954e+00_r8,1.4926e+00_r8,2.0054e+00_r8,2.6579e+00_r8,3.4668e+00_r8/) + kbo(:,48,12) = (/ & + &9.3943e-01_r8,1.2870e+00_r8,1.7558e+00_r8,2.3470e+00_r8,3.0956e+00_r8/) + kbo(:,49,12) = (/ & + &8.0789e-01_r8,1.1100e+00_r8,1.5297e+00_r8,2.0665e+00_r8,2.7506e+00_r8/) + kbo(:,50,12) = (/ & + &7.0633e-01_r8,9.6173e-01_r8,1.3381e+00_r8,1.8318e+00_r8,2.4528e+00_r8/) + kbo(:,51,12) = (/ & + &6.2380e-01_r8,8.4012e-01_r8,1.1696e+00_r8,1.6208e+00_r8,2.1914e+00_r8/) + kbo(:,52,12) = (/ & + &5.6356e-01_r8,7.3733e-01_r8,1.0234e+00_r8,1.4290e+00_r8,1.9532e+00_r8/) + kbo(:,53,12) = (/ & + &5.0909e-01_r8,6.5068e-01_r8,8.9219e-01_r8,1.2539e+00_r8,1.7345e+00_r8/) + kbo(:,54,12) = (/ & + &4.6136e-01_r8,5.8883e-01_r8,7.8810e-01_r8,1.1078e+00_r8,1.5488e+00_r8/) + kbo(:,55,12) = (/ & + &4.1950e-01_r8,5.3756e-01_r8,7.0213e-01_r8,9.8100e-01_r8,1.3825e+00_r8/) + kbo(:,56,12) = (/ & + &3.8410e-01_r8,4.8996e-01_r8,6.3016e-01_r8,8.6652e-01_r8,1.2252e+00_r8/) + kbo(:,57,12) = (/ & + &3.5624e-01_r8,4.4831e-01_r8,5.7215e-01_r8,7.6572e-01_r8,1.0848e+00_r8/) + kbo(:,58,12) = (/ & + &3.2868e-01_r8,4.1829e-01_r8,5.2553e-01_r8,6.8368e-01_r8,9.6165e-01_r8/) + kbo(:,59,12) = (/ & + &3.1733e-01_r8,4.0674e-01_r8,5.0354e-01_r8,6.5575e-01_r8,9.0743e-01_r8/) + kbo(:,13,13) = (/ & + &6.3252e+01_r8,7.1343e+01_r8,7.9418e+01_r8,8.6956e+01_r8,9.3893e+01_r8/) + kbo(:,14,13) = (/ & + &6.4432e+01_r8,7.3277e+01_r8,8.1636e+01_r8,8.9410e+01_r8,9.6695e+01_r8/) + kbo(:,15,13) = (/ & + &6.5832e+01_r8,7.4648e+01_r8,8.2893e+01_r8,9.0741e+01_r8,9.8138e+01_r8/) + kbo(:,16,13) = (/ & + &6.5929e+01_r8,7.4500e+01_r8,8.2870e+01_r8,9.0803e+01_r8,9.8296e+01_r8/) + kbo(:,17,13) = (/ & + &6.5097e+01_r8,7.3774e+01_r8,8.2069e+01_r8,9.0039e+01_r8,9.7697e+01_r8/) + kbo(:,18,13) = (/ & + &6.3876e+01_r8,7.2341e+01_r8,8.0612e+01_r8,8.8540e+01_r8,9.6103e+01_r8/) + kbo(:,19,13) = (/ & + &6.1808e+01_r8,7.0129e+01_r8,7.8103e+01_r8,8.5721e+01_r8,9.2920e+01_r8/) + kbo(:,20,13) = (/ & + &5.9337e+01_r8,6.7178e+01_r8,7.4740e+01_r8,8.1921e+01_r8,8.8860e+01_r8/) + kbo(:,21,13) = (/ & + &5.6051e+01_r8,6.3423e+01_r8,7.0500e+01_r8,7.7416e+01_r8,8.4103e+01_r8/) + kbo(:,22,13) = (/ & + &5.2578e+01_r8,5.9410e+01_r8,6.6220e+01_r8,7.2967e+01_r8,7.9639e+01_r8/) + kbo(:,23,13) = (/ & + &4.8800e+01_r8,5.5307e+01_r8,6.1937e+01_r8,6.8633e+01_r8,7.5406e+01_r8/) + kbo(:,24,13) = (/ & + &4.5172e+01_r8,5.1522e+01_r8,5.8057e+01_r8,6.4742e+01_r8,7.1436e+01_r8/) + kbo(:,25,13) = (/ & + &4.2002e+01_r8,4.8199e+01_r8,5.4646e+01_r8,6.1219e+01_r8,6.7880e+01_r8/) + kbo(:,26,13) = (/ & + &3.9325e+01_r8,4.5395e+01_r8,5.1713e+01_r8,5.8235e+01_r8,6.4961e+01_r8/) + kbo(:,27,13) = (/ & + &3.7049e+01_r8,4.2989e+01_r8,4.9236e+01_r8,5.5807e+01_r8,6.2667e+01_r8/) + kbo(:,28,13) = (/ & + &3.5161e+01_r8,4.0996e+01_r8,4.7272e+01_r8,5.3955e+01_r8,6.1012e+01_r8/) + kbo(:,29,13) = (/ & + &3.3638e+01_r8,3.9504e+01_r8,4.5884e+01_r8,5.2759e+01_r8,6.0034e+01_r8/) + kbo(:,30,13) = (/ & + &3.2492e+01_r8,3.8479e+01_r8,4.5047e+01_r8,5.2111e+01_r8,5.9617e+01_r8/) + kbo(:,31,13) = (/ & + &3.1781e+01_r8,3.7957e+01_r8,4.4719e+01_r8,5.2013e+01_r8,5.9720e+01_r8/) + kbo(:,32,13) = (/ & + &3.1516e+01_r8,3.7888e+01_r8,4.4882e+01_r8,5.2382e+01_r8,6.0245e+01_r8/) + kbo(:,33,13) = (/ & + &3.1641e+01_r8,3.8231e+01_r8,4.5439e+01_r8,5.3118e+01_r8,6.1113e+01_r8/) + kbo(:,34,13) = (/ & + &3.1881e+01_r8,3.8668e+01_r8,4.6052e+01_r8,5.3873e+01_r8,6.1967e+01_r8/) + kbo(:,35,13) = (/ & + &3.1765e+01_r8,3.8677e+01_r8,4.6167e+01_r8,5.4068e+01_r8,6.2237e+01_r8/) + kbo(:,36,13) = (/ & + &3.1127e+01_r8,3.8083e+01_r8,4.5619e+01_r8,5.3554e+01_r8,6.1754e+01_r8/) + kbo(:,37,13) = (/ & + &2.9631e+01_r8,3.6533e+01_r8,4.4019e+01_r8,5.1934e+01_r8,6.0138e+01_r8/) + kbo(:,38,13) = (/ & + &2.8216e+01_r8,3.5039e+01_r8,4.2468e+01_r8,5.0350e+01_r8,5.8547e+01_r8/) + kbo(:,39,13) = (/ & + &2.6913e+01_r8,3.3654e+01_r8,4.1024e+01_r8,4.8851e+01_r8,5.7030e+01_r8/) + kbo(:,40,13) = (/ & + &2.5061e+01_r8,3.1637e+01_r8,3.8879e+01_r8,4.6620e+01_r8,5.4739e+01_r8/) + kbo(:,41,13) = (/ & + &2.3239e+01_r8,2.9632e+01_r8,3.6721e+01_r8,4.4349e+01_r8,5.2395e+01_r8/) + kbo(:,42,13) = (/ & + &2.1518e+01_r8,2.7714e+01_r8,3.4638e+01_r8,4.2154e+01_r8,5.0111e+01_r8/) + kbo(:,43,13) = (/ & + &1.9578e+01_r8,2.5525e+01_r8,3.2232e+01_r8,3.9588e+01_r8,4.7417e+01_r8/) + kbo(:,44,13) = (/ & + &1.7631e+01_r8,2.3285e+01_r8,2.9750e+01_r8,3.6914e+01_r8,4.4596e+01_r8/) + kbo(:,45,13) = (/ & + &1.5817e+01_r8,2.1168e+01_r8,2.7372e+01_r8,3.4312e+01_r8,4.1842e+01_r8/) + kbo(:,46,13) = (/ & + &1.4031e+01_r8,1.9049e+01_r8,2.4960e+01_r8,3.1648e+01_r8,3.8993e+01_r8/) + kbo(:,47,13) = (/ & + &1.2204e+01_r8,1.6850e+01_r8,2.2409e+01_r8,2.8797e+01_r8,3.5899e+01_r8/) + kbo(:,48,13) = (/ & + &1.0543e+01_r8,1.4813e+01_r8,2.0005e+01_r8,2.6074e+01_r8,3.2906e+01_r8/) + kbo(:,49,13) = (/ & + &9.0410e+00_r8,1.2940e+01_r8,1.7763e+01_r8,2.3491e+01_r8,3.0027e+01_r8/) + kbo(:,50,13) = (/ & + &7.7723e+00_r8,1.1328e+01_r8,1.5799e+01_r8,2.1188e+01_r8,2.7436e+01_r8/) + kbo(:,51,13) = (/ & + &6.6603e+00_r8,9.8956e+00_r8,1.4031e+01_r8,1.9082e+01_r8,2.5030e+01_r8/) + kbo(:,52,13) = (/ & + &5.6483e+00_r8,8.5936e+00_r8,1.2389e+01_r8,1.7108e+01_r8,2.2735e+01_r8/) + kbo(:,53,13) = (/ & + &4.7548e+00_r8,7.4145e+00_r8,1.0879e+01_r8,1.5253e+01_r8,2.0556e+01_r8/) + kbo(:,54,13) = (/ & + &4.0362e+00_r8,6.4182e+00_r8,9.6047e+00_r8,1.3672e+01_r8,1.8664e+01_r8/) + kbo(:,55,13) = (/ & + &3.4328e+00_r8,5.5491e+00_r8,8.4816e+00_r8,1.2254e+01_r8,1.6947e+01_r8/) + kbo(:,56,13) = (/ & + &2.9068e+00_r8,4.7740e+00_r8,7.4485e+00_r8,1.0936e+01_r8,1.5335e+01_r8/) + kbo(:,57,13) = (/ & + &2.4469e+00_r8,4.0838e+00_r8,6.4921e+00_r8,9.7157e+00_r8,1.3818e+01_r8/) + kbo(:,58,13) = (/ & + &2.0735e+00_r8,3.4925e+00_r8,5.6637e+00_r8,8.6413e+00_r8,1.2467e+01_r8/) + kbo(:,59,13) = (/ & + &1.9355e+00_r8,3.2709e+00_r8,5.3499e+00_r8,8.2221e+00_r8,1.1950e+01_r8/) + kbo(:,13,14) = (/ & + &1.3763e+02_r8,1.5352e+02_r8,1.6709e+02_r8,1.7925e+02_r8,1.9013e+02_r8/) + kbo(:,14,14) = (/ & + &1.4836e+02_r8,1.6388e+02_r8,1.7793e+02_r8,1.9078e+02_r8,2.0291e+02_r8/) + kbo(:,15,14) = (/ & + &1.5609e+02_r8,1.7227e+02_r8,1.8754e+02_r8,2.0210e+02_r8,2.1605e+02_r8/) + kbo(:,16,14) = (/ & + &1.6287e+02_r8,1.8058e+02_r8,1.9742e+02_r8,2.1358e+02_r8,2.2879e+02_r8/) + kbo(:,17,14) = (/ & + &1.6936e+02_r8,1.8829e+02_r8,2.0654e+02_r8,2.2380e+02_r8,2.3943e+02_r8/) + kbo(:,18,14) = (/ & + &1.7409e+02_r8,1.9426e+02_r8,2.1359e+02_r8,2.3157e+02_r8,2.4840e+02_r8/) + kbo(:,19,14) = (/ & + &1.7751e+02_r8,1.9877e+02_r8,2.1900e+02_r8,2.3829e+02_r8,2.5666e+02_r8/) + kbo(:,20,14) = (/ & + &1.8029e+02_r8,2.0255e+02_r8,2.2414e+02_r8,2.4492e+02_r8,2.6421e+02_r8/) + kbo(:,21,14) = (/ & + &1.8288e+02_r8,2.0645e+02_r8,2.2930e+02_r8,2.5080e+02_r8,2.7109e+02_r8/) + kbo(:,22,14) = (/ & + &1.8758e+02_r8,2.1208e+02_r8,2.3543e+02_r8,2.5750e+02_r8,2.7832e+02_r8/) + kbo(:,23,14) = (/ & + &1.9239e+02_r8,2.1719e+02_r8,2.4091e+02_r8,2.6350e+02_r8,2.8469e+02_r8/) + kbo(:,24,14) = (/ & + &1.9651e+02_r8,2.2173e+02_r8,2.4591e+02_r8,2.6890e+02_r8,2.9066e+02_r8/) + kbo(:,25,14) = (/ & + &2.0022e+02_r8,2.2597e+02_r8,2.5071e+02_r8,2.7426e+02_r8,2.9648e+02_r8/) + kbo(:,26,14) = (/ & + &2.0417e+02_r8,2.3049e+02_r8,2.5589e+02_r8,2.7996e+02_r8,3.0257e+02_r8/) + kbo(:,27,14) = (/ & + &2.0832e+02_r8,2.3518e+02_r8,2.6110e+02_r8,2.8565e+02_r8,3.0854e+02_r8/) + kbo(:,28,14) = (/ & + &2.1279e+02_r8,2.4021e+02_r8,2.6653e+02_r8,2.9138e+02_r8,3.1446e+02_r8/) + kbo(:,29,14) = (/ & + &2.1796e+02_r8,2.4575e+02_r8,2.7237e+02_r8,2.9736e+02_r8,3.2050e+02_r8/) + kbo(:,30,14) = (/ & + &2.2364e+02_r8,2.5171e+02_r8,2.7842e+02_r8,3.0343e+02_r8,3.2655e+02_r8/) + kbo(:,31,14) = (/ & + &2.2986e+02_r8,2.5803e+02_r8,2.8476e+02_r8,3.0967e+02_r8,3.3263e+02_r8/) + kbo(:,32,14) = (/ & + &2.3644e+02_r8,2.6463e+02_r8,2.9123e+02_r8,3.1599e+02_r8,3.3870e+02_r8/) + kbo(:,33,14) = (/ & + &2.4330e+02_r8,2.7142e+02_r8,2.9784e+02_r8,3.2234e+02_r8,3.4468e+02_r8/) + kbo(:,34,14) = (/ & + &2.4932e+02_r8,2.7733e+02_r8,3.0352e+02_r8,3.2779e+02_r8,3.4977e+02_r8/) + kbo(:,35,14) = (/ & + &2.5266e+02_r8,2.8063e+02_r8,3.0678e+02_r8,3.3096e+02_r8,3.5278e+02_r8/) + kbo(:,36,14) = (/ & + &2.5297e+02_r8,2.8101e+02_r8,3.0732e+02_r8,3.3158e+02_r8,3.5352e+02_r8/) + kbo(:,37,14) = (/ & + &2.4886e+02_r8,2.7734e+02_r8,3.0396e+02_r8,3.2863e+02_r8,3.5100e+02_r8/) + kbo(:,38,14) = (/ & + &2.4449e+02_r8,2.7331e+02_r8,3.0032e+02_r8,3.2535e+02_r8,3.4818e+02_r8/) + kbo(:,39,14) = (/ & + &2.4014e+02_r8,2.6925e+02_r8,2.9663e+02_r8,3.2206e+02_r8,3.4524e+02_r8/) + kbo(:,40,14) = (/ & + &2.3269e+02_r8,2.6223e+02_r8,2.9013e+02_r8,3.1615e+02_r8,3.3997e+02_r8/) + kbo(:,41,14) = (/ & + &2.2477e+02_r8,2.5475e+02_r8,2.8316e+02_r8,3.0972e+02_r8,3.3417e+02_r8/) + kbo(:,42,14) = (/ & + &2.1674e+02_r8,2.4709e+02_r8,2.7597e+02_r8,3.0309e+02_r8,3.2816e+02_r8/) + kbo(:,43,14) = (/ & + &2.0690e+02_r8,2.3764e+02_r8,2.6708e+02_r8,2.9483e+02_r8,3.2058e+02_r8/) + kbo(:,44,14) = (/ & + &1.9620e+02_r8,2.2728e+02_r8,2.5727e+02_r8,2.8565e+02_r8,3.1213e+02_r8/) + kbo(:,45,14) = (/ & + &1.8544e+02_r8,2.1679e+02_r8,2.4722e+02_r8,2.7624e+02_r8,3.0339e+02_r8/) + kbo(:,46,14) = (/ & + &1.7394e+02_r8,2.0555e+02_r8,2.3639e+02_r8,2.6594e+02_r8,2.9386e+02_r8/) + kbo(:,47,14) = (/ & + &1.6112e+02_r8,1.9279e+02_r8,2.2405e+02_r8,2.5421e+02_r8,2.8283e+02_r8/) + kbo(:,48,14) = (/ & + &1.4837e+02_r8,1.8000e+02_r8,2.1155e+02_r8,2.4220e+02_r8,2.7155e+02_r8/) + kbo(:,49,14) = (/ & + &1.3570e+02_r8,1.6720e+02_r8,1.9889e+02_r8,2.3000e+02_r8,2.5992e+02_r8/) + kbo(:,50,14) = (/ & + &1.2401e+02_r8,1.5522e+02_r8,1.8690e+02_r8,2.1834e+02_r8,2.4877e+02_r8/) + kbo(:,51,14) = (/ & + &1.1285e+02_r8,1.4368e+02_r8,1.7528e+02_r8,2.0692e+02_r8,2.3777e+02_r8/) + kbo(:,52,14) = (/ & + &1.0205e+02_r8,1.3225e+02_r8,1.6371e+02_r8,1.9541e+02_r8,2.2663e+02_r8/) + kbo(:,53,14) = (/ & + &9.1561e+01_r8,1.2094e+02_r8,1.5208e+02_r8,1.8381e+02_r8,2.1529e+02_r8/) + kbo(:,54,14) = (/ & + &8.2288e+01_r8,1.1082e+02_r8,1.4154e+02_r8,1.7313e+02_r8,2.0480e+02_r8/) + kbo(:,55,14) = (/ & + &7.3729e+01_r8,1.0135e+02_r8,1.3152e+02_r8,1.6297e+02_r8,1.9471e+02_r8/) + kbo(:,56,14) = (/ & + &6.5504e+01_r8,9.2170e+01_r8,1.2164e+02_r8,1.5283e+02_r8,1.8453e+02_r8/) + kbo(:,57,14) = (/ & + &5.7661e+01_r8,8.3295e+01_r8,1.1195e+02_r8,1.4273e+02_r8,1.7435e+02_r8/) + kbo(:,58,14) = (/ & + &5.0636e+01_r8,7.5168e+01_r8,1.0296e+02_r8,1.3321e+02_r8,1.6472e+02_r8/) + kbo(:,59,14) = (/ & + &4.7932e+01_r8,7.1971e+01_r8,9.9421e+01_r8,1.2944e+02_r8,1.6088e+02_r8/) + kbo(:,13,15) = (/ & + &2.4469e+02_r8,2.6735e+02_r8,2.9101e+02_r8,3.1438e+02_r8,3.3674e+02_r8/) + kbo(:,14,15) = (/ & + &2.8094e+02_r8,3.0921e+02_r8,3.3701e+02_r8,3.6348e+02_r8,3.8824e+02_r8/) + kbo(:,15,15) = (/ & + &3.2313e+02_r8,3.5640e+02_r8,3.8804e+02_r8,4.1754e+02_r8,4.4448e+02_r8/) + kbo(:,16,15) = (/ & + &3.6992e+02_r8,4.0761e+02_r8,4.4269e+02_r8,4.7470e+02_r8,5.0364e+02_r8/) + kbo(:,17,15) = (/ & + &4.1926e+02_r8,4.6079e+02_r8,4.9879e+02_r8,5.3327e+02_r8,5.6513e+02_r8/) + kbo(:,18,15) = (/ & + &4.7156e+02_r8,5.1653e+02_r8,5.5718e+02_r8,5.9454e+02_r8,6.2828e+02_r8/) + kbo(:,19,15) = (/ & + &5.2525e+02_r8,5.7308e+02_r8,6.1700e+02_r8,6.5663e+02_r8,6.9127e+02_r8/) + kbo(:,20,15) = (/ & + &5.7876e+02_r8,6.2973e+02_r8,6.7595e+02_r8,7.1709e+02_r8,7.5345e+02_r8/) + kbo(:,21,15) = (/ & + &6.2988e+02_r8,6.8342e+02_r8,7.3148e+02_r8,7.7494e+02_r8,8.1239e+02_r8/) + kbo(:,22,15) = (/ & + &6.8118e+02_r8,7.3681e+02_r8,7.8702e+02_r8,8.3157e+02_r8,8.6949e+02_r8/) + kbo(:,23,15) = (/ & + &7.2944e+02_r8,7.8796e+02_r8,8.3973e+02_r8,8.8478e+02_r8,9.2278e+02_r8/) + kbo(:,24,15) = (/ & + &7.7652e+02_r8,8.3661e+02_r8,8.8931e+02_r8,9.3457e+02_r8,9.7211e+02_r8/) + kbo(:,25,15) = (/ & + &8.2208e+02_r8,8.8322e+02_r8,9.3559e+02_r8,9.8038e+02_r8,1.0170e+03_r8/) + kbo(:,26,15) = (/ & + &8.6654e+02_r8,9.2755e+02_r8,9.7898e+02_r8,1.0223e+03_r8,1.0574e+03_r8/) + kbo(:,27,15) = (/ & + &9.0828e+02_r8,9.6846e+02_r8,1.0184e+03_r8,1.0599e+03_r8,1.0932e+03_r8/) + kbo(:,28,15) = (/ & + &9.4716e+02_r8,1.0058e+03_r8,1.0539e+03_r8,1.0933e+03_r8,1.1247e+03_r8/) + kbo(:,29,15) = (/ & + &9.8313e+02_r8,1.0399e+03_r8,1.0858e+03_r8,1.1230e+03_r8,1.1519e+03_r8/) + kbo(:,30,15) = (/ & + &1.0160e+03_r8,1.0704e+03_r8,1.1141e+03_r8,1.1489e+03_r8,1.1756e+03_r8/) + kbo(:,31,15) = (/ & + &1.0460e+03_r8,1.0956e+03_r8,1.1391e+03_r8,1.1716e+03_r8,1.1960e+03_r8/) + kbo(:,32,15) = (/ & + &1.0732e+03_r8,1.1224e+03_r8,1.1612e+03_r8,1.1912e+03_r8,1.2136e+03_r8/) + kbo(:,33,15) = (/ & + &1.0978e+03_r8,1.1441e+03_r8,1.1805e+03_r8,1.2081e+03_r8,1.2287e+03_r8/) + kbo(:,34,15) = (/ & + &1.1183e+03_r8,1.1622e+03_r8,1.1963e+03_r8,1.2219e+03_r8,1.2409e+03_r8/) + kbo(:,35,15) = (/ & + &1.1319e+03_r8,1.1747e+03_r8,1.2074e+03_r8,1.2320e+03_r8,1.2497e+03_r8/) + kbo(:,36,15) = (/ & + &1.1393e+03_r8,1.1815e+03_r8,1.2141e+03_r8,1.2383e+03_r8,1.2557e+03_r8/) + kbo(:,37,15) = (/ & + &1.1379e+03_r8,1.1816e+03_r8,1.2154e+03_r8,1.2404e+03_r8,1.2585e+03_r8/) + kbo(:,38,15) = (/ & + &1.1350e+03_r8,1.1805e+03_r8,1.2153e+03_r8,1.2413e+03_r8,1.2601e+03_r8/) + kbo(:,39,15) = (/ & + &1.1312e+03_r8,1.1782e+03_r8,1.2145e+03_r8,1.2415e+03_r8,1.2613e+03_r8/) + kbo(:,40,15) = (/ & + &1.1209e+03_r8,1.1709e+03_r8,1.2094e+03_r8,1.2385e+03_r8,1.2597e+03_r8/) + kbo(:,41,15) = (/ & + &1.1085e+03_r8,1.1615e+03_r8,1.2028e+03_r8,1.2343e+03_r8,1.2572e+03_r8/) + kbo(:,42,15) = (/ & + &1.0950e+03_r8,1.1510e+03_r8,1.1953e+03_r8,1.2290e+03_r8,1.2540e+03_r8/) + kbo(:,43,15) = (/ & + &1.0762e+03_r8,1.1364e+03_r8,1.1842e+03_r8,1.2211e+03_r8,1.2485e+03_r8/) + kbo(:,44,15) = (/ & + &1.0545e+03_r8,1.1188e+03_r8,1.1706e+03_r8,1.2111e+03_r8,1.2414e+03_r8/) + kbo(:,45,15) = (/ & + &1.0306e+03_r8,1.0995e+03_r8,1.1556e+03_r8,1.1997e+03_r8,1.2332e+03_r8/) + kbo(:,46,15) = (/ & + &1.0035e+03_r8,1.0771e+03_r8,1.1376e+03_r8,1.1860e+03_r8,1.2231e+03_r8/) + kbo(:,47,15) = (/ & + &9.7068e+02_r8,1.0499e+03_r8,1.1155e+03_r8,1.1686e+03_r8,1.2101e+03_r8/) + kbo(:,48,15) = (/ & + &9.3560e+02_r8,1.0200e+03_r8,1.0913e+03_r8,1.1493e+03_r8,1.1954e+03_r8/) + kbo(:,49,15) = (/ & + &8.9859e+02_r8,9.8816e+02_r8,1.0648e+03_r8,1.1280e+03_r8,1.1788e+03_r8/) + kbo(:,50,15) = (/ & + &8.6187e+02_r8,9.5626e+02_r8,1.0379e+03_r8,1.1061e+03_r8,1.1615e+03_r8/) + kbo(:,51,15) = (/ & + &8.2436e+02_r8,9.2347e+02_r8,1.0097e+03_r8,1.0831e+03_r8,1.1429e+03_r8/) + kbo(:,52,15) = (/ & + &7.8552e+02_r8,8.8919e+02_r8,9.8012e+02_r8,1.0582e+03_r8,1.1227e+03_r8/) + kbo(:,53,15) = (/ & + &7.4472e+02_r8,8.5281e+02_r8,9.4852e+02_r8,1.0314e+03_r8,1.1008e+03_r8/) + kbo(:,54,15) = (/ & + &7.0603e+02_r8,8.1807e+02_r8,9.1796e+02_r8,1.0053e+03_r8,1.0792e+03_r8/) + kbo(:,55,15) = (/ & + &6.6818e+02_r8,7.8362e+02_r8,8.8753e+02_r8,9.7880e+02_r8,1.0572e+03_r8/) + kbo(:,56,15) = (/ & + &6.2949e+02_r8,7.4771e+02_r8,8.5573e+02_r8,9.5104e+02_r8,1.0336e+03_r8/) + kbo(:,57,15) = (/ & + &5.9013e+02_r8,7.1102e+02_r8,8.2256e+02_r8,9.2198e+02_r8,1.0088e+03_r8/) + kbo(:,58,15) = (/ & + &5.5222e+02_r8,6.7509e+02_r8,7.8994e+02_r8,8.9322e+02_r8,9.8385e+02_r8/) + kbo(:,59,15) = (/ & + &5.3696e+02_r8,6.6055e+02_r8,7.7661e+02_r8,8.8142e+02_r8,9.7364e+02_r8/) + kbo(:,13,16) = (/ & + &4.2045e+02_r8,4.6429e+02_r8,5.0303e+02_r8,5.3671e+02_r8,5.6546e+02_r8/) + kbo(:,14,16) = (/ & + &5.0808e+02_r8,5.5889e+02_r8,6.0315e+02_r8,6.4104e+02_r8,6.7319e+02_r8/) + kbo(:,15,16) = (/ & + &6.0971e+02_r8,6.6729e+02_r8,7.1666e+02_r8,7.5857e+02_r8,7.9337e+02_r8/) + kbo(:,16,16) = (/ & + &7.2443e+02_r8,7.8825e+02_r8,8.4219e+02_r8,8.8727e+02_r8,9.2382e+02_r8/) + kbo(:,17,16) = (/ & + &8.5000e+02_r8,9.1908e+02_r8,9.7683e+02_r8,1.0239e+03_r8,1.0613e+03_r8/) + kbo(:,18,16) = (/ & + &9.8305e+02_r8,1.0566e+03_r8,1.1167e+03_r8,1.1645e+03_r8,1.2017e+03_r8/) + kbo(:,19,16) = (/ & + &1.1204e+03_r8,1.1968e+03_r8,1.2579e+03_r8,1.3058e+03_r8,1.3449e+03_r8/) + kbo(:,20,16) = (/ & + &1.2624e+03_r8,1.3419e+03_r8,1.4045e+03_r8,1.4519e+03_r8,1.4914e+03_r8/) + kbo(:,21,16) = (/ & + &1.4128e+03_r8,1.4938e+03_r8,1.5557e+03_r8,1.6009e+03_r8,1.6375e+03_r8/) + kbo(:,22,16) = (/ & + &1.5738e+03_r8,1.6513e+03_r8,1.7095e+03_r8,1.7503e+03_r8,1.7825e+03_r8/) + kbo(:,23,16) = (/ & + &1.7348e+03_r8,1.8057e+03_r8,1.8583e+03_r8,1.8939e+03_r8,1.9201e+03_r8/) + kbo(:,24,16) = (/ & + &1.8918e+03_r8,1.9538e+03_r8,1.9990e+03_r8,2.0285e+03_r8,2.0481e+03_r8/) + kbo(:,25,16) = (/ & + &2.0394e+03_r8,2.0915e+03_r8,2.1288e+03_r8,2.1514e+03_r8,2.1633e+03_r8/) + kbo(:,26,16) = (/ & + &2.1757e+03_r8,2.2166e+03_r8,2.2458e+03_r8,2.2605e+03_r8,2.2652e+03_r8/) + kbo(:,27,16) = (/ & + &2.2965e+03_r8,2.3277e+03_r8,2.3485e+03_r8,2.3546e+03_r8,2.3529e+03_r8/) + kbo(:,28,16) = (/ & + &2.4019e+03_r8,2.4242e+03_r8,2.4364e+03_r8,2.4355e+03_r8,2.4262e+03_r8/) + kbo(:,29,16) = (/ & + &2.4918e+03_r8,2.5053e+03_r8,2.5101e+03_r8,2.5025e+03_r8,2.4871e+03_r8/) + kbo(:,30,16) = (/ & + &2.5673e+03_r8,2.5738e+03_r8,2.5706e+03_r8,2.5574e+03_r8,2.5361e+03_r8/) + kbo(:,31,16) = (/ & + &2.6301e+03_r8,2.6241e+03_r8,2.6201e+03_r8,2.6003e+03_r8,2.5741e+03_r8/) + kbo(:,32,16) = (/ & + &2.6807e+03_r8,2.6744e+03_r8,2.6583e+03_r8,2.6342e+03_r8,2.6035e+03_r8/) + kbo(:,33,16) = (/ & + &2.7216e+03_r8,2.7096e+03_r8,2.6883e+03_r8,2.6595e+03_r8,2.6244e+03_r8/) + kbo(:,34,16) = (/ & + &2.7530e+03_r8,2.7368e+03_r8,2.7115e+03_r8,2.6793e+03_r8,2.6415e+03_r8/) + kbo(:,35,16) = (/ & + &2.7800e+03_r8,2.7599e+03_r8,2.7318e+03_r8,2.6972e+03_r8,2.6568e+03_r8/) + kbo(:,36,16) = (/ & + &2.8032e+03_r8,2.7809e+03_r8,2.7511e+03_r8,2.7149e+03_r8,2.6728e+03_r8/) + kbo(:,37,16) = (/ & + &2.8255e+03_r8,2.8022e+03_r8,2.7720e+03_r8,2.7352e+03_r8,2.6929e+03_r8/) + kbo(:,38,16) = (/ & + &2.8447e+03_r8,2.8207e+03_r8,2.7907e+03_r8,2.7534e+03_r8,2.7108e+03_r8/) + kbo(:,39,16) = (/ & + &2.8614e+03_r8,2.8371e+03_r8,2.8072e+03_r8,2.7697e+03_r8,2.7272e+03_r8/) + kbo(:,40,16) = (/ & + &2.8775e+03_r8,2.8542e+03_r8,2.8246e+03_r8,2.7882e+03_r8,2.7463e+03_r8/) + kbo(:,41,16) = (/ & + &2.8919e+03_r8,2.8698e+03_r8,2.8410e+03_r8,2.8060e+03_r8,2.7644e+03_r8/) + kbo(:,42,16) = (/ & + &2.9035e+03_r8,2.8842e+03_r8,2.8555e+03_r8,2.8221e+03_r8,2.7810e+03_r8/) + kbo(:,43,16) = (/ & + &2.9142e+03_r8,2.8974e+03_r8,2.8713e+03_r8,2.8381e+03_r8,2.7994e+03_r8/) + kbo(:,44,16) = (/ & + &2.9225e+03_r8,2.9100e+03_r8,2.8852e+03_r8,2.8542e+03_r8,2.8174e+03_r8/) + kbo(:,45,16) = (/ & + &2.9284e+03_r8,2.9199e+03_r8,2.8988e+03_r8,2.8699e+03_r8,2.8343e+03_r8/) + kbo(:,46,16) = (/ & + &2.9312e+03_r8,2.9287e+03_r8,2.9114e+03_r8,2.8839e+03_r8,2.8514e+03_r8/) + kbo(:,47,16) = (/ & + &2.9278e+03_r8,2.9353e+03_r8,2.9229e+03_r8,2.8988e+03_r8,2.8673e+03_r8/) + kbo(:,48,16) = (/ & + &2.9198e+03_r8,2.9382e+03_r8,2.9322e+03_r8,2.9123e+03_r8,2.8825e+03_r8/) + kbo(:,49,16) = (/ & + &2.9055e+03_r8,2.9369e+03_r8,2.9391e+03_r8,2.9238e+03_r8,2.8967e+03_r8/) + kbo(:,50,16) = (/ & + &2.8866e+03_r8,2.9312e+03_r8,2.9427e+03_r8,2.9328e+03_r8,2.9100e+03_r8/) + kbo(:,51,16) = (/ & + &2.8621e+03_r8,2.9209e+03_r8,2.9426e+03_r8,2.9399e+03_r8,2.9204e+03_r8/) + kbo(:,52,16) = (/ & + &2.8313e+03_r8,2.9062e+03_r8,2.9403e+03_r8,2.9447e+03_r8,2.9298e+03_r8/) + kbo(:,53,16) = (/ & + &2.7937e+03_r8,2.8849e+03_r8,2.9330e+03_r8,2.9466e+03_r8,2.9378e+03_r8/) + kbo(:,54,16) = (/ & + &2.7518e+03_r8,2.8608e+03_r8,2.9213e+03_r8,2.9463e+03_r8,2.9434e+03_r8/) + kbo(:,55,16) = (/ & + &2.7066e+03_r8,2.8327e+03_r8,2.9070e+03_r8,2.9427e+03_r8,2.9473e+03_r8/) + kbo(:,56,16) = (/ & + &2.6539e+03_r8,2.7985e+03_r8,2.8885e+03_r8,2.9351e+03_r8,2.9485e+03_r8/) + kbo(:,57,16) = (/ & + &2.5953e+03_r8,2.7598e+03_r8,2.8651e+03_r8,2.9247e+03_r8,2.9481e+03_r8/) + kbo(:,58,16) = (/ & + &2.5319e+03_r8,2.7165e+03_r8,2.8391e+03_r8,2.9117e+03_r8,2.9450e+03_r8/) + kbo(:,59,16) = (/ & + &2.5058e+03_r8,2.6981e+03_r8,2.8277e+03_r8,2.9062e+03_r8,2.9427e+03_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &1.0515e-02_r8,1.4860e-02_r8,1.7181e-02_r8,1.6642e-02_r8,1.6644e-02_r8,1.5649e-02_r8, & + &1.7734e-02_r8,1.7521e-02_r8,1.7868e-02_r8,1.8400e-02_r8,1.9361e-02_r8,2.1487e-02_r8, & + &2.0192e-02_r8,1.6545e-02_r8,2.0922e-02_r8,2.0922e-02_r8/) + forrefo(2,:) = (/ & + &1.0423e-02_r8,1.4593e-02_r8,1.6329e-02_r8,1.7071e-02_r8,1.7252e-02_r8,1.6188e-02_r8, & + &1.7752e-02_r8,1.7913e-02_r8,1.7551e-02_r8,1.8203e-02_r8,1.7946e-02_r8,1.9828e-02_r8, & + &2.1566e-02_r8,1.9707e-02_r8,2.0944e-02_r8,2.0944e-02_r8/) + forrefo(3,:) = (/ & + &9.2770e-03_r8,1.2818e-02_r8,1.7181e-02_r8,1.7858e-02_r8,1.7888e-02_r8,1.7121e-02_r8, & + &1.8116e-02_r8,1.8230e-02_r8,1.7719e-02_r8,1.7833e-02_r8,1.8438e-02_r8,1.7995e-02_r8, & + &2.0895e-02_r8,2.1525e-02_r8,2.0517e-02_r8,2.0954e-02_r8/) + forrefo(4,:) = (/ & + &8.3290e-03_r8,1.3483e-02_r8,1.5432e-02_r8,2.0793e-02_r8,1.8404e-02_r8,1.7470e-02_r8, & + &1.7253e-02_r8,1.7132e-02_r8,1.7119e-02_r8,1.7376e-02_r8,1.7030e-02_r8,1.6847e-02_r8, & + &1.5562e-02_r8,1.6836e-02_r8,1.8746e-02_r8,2.1233e-02_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 2.41120e-01_r8, 2.27071e-01_r8, 2.13840e-01_r8, 2.01380e-01_r8, 1.89646e-01_r8, & + & 1.78596e-01_r8, 1.68190e-01_r8, 1.58390e-01_r8, 1.49161e-01_r8, 1.40470e-01_r8/) + selfrefo(:, 2) = (/ & + & 3.11156e-01_r8, 2.92249e-01_r8, 2.74490e-01_r8, 2.57810e-01_r8, 2.42144e-01_r8, & + & 2.27430e-01_r8, 2.13610e-01_r8, 2.00630e-01_r8, 1.88439e-01_r8, 1.76988e-01_r8/) + selfrefo(:, 3) = (/ & + & 3.37148e-01_r8, 3.17767e-01_r8, 2.99500e-01_r8, 2.82283e-01_r8, 2.66056e-01_r8, & + & 2.50762e-01_r8, 2.36347e-01_r8, 2.22760e-01_r8, 2.09955e-01_r8, 1.97885e-01_r8/) + selfrefo(:, 4) = (/ & + & 3.57139e-01_r8, 3.32763e-01_r8, 3.10050e-01_r8, 2.88888e-01_r8, 2.69170e-01_r8, & + & 2.50798e-01_r8, 2.33680e-01_r8, 2.17730e-01_r8, 2.02869e-01_r8, 1.89022e-01_r8/) + selfrefo(:, 5) = (/ & + & 3.60626e-01_r8, 3.35433e-01_r8, 3.12000e-01_r8, 2.90204e-01_r8, 2.69931e-01_r8, & + & 2.51074e-01_r8, 2.33534e-01_r8, 2.17220e-01_r8, 2.02045e-01_r8, 1.87931e-01_r8/) + selfrefo(:, 6) = (/ & + & 3.42420e-01_r8, 3.18795e-01_r8, 2.96800e-01_r8, 2.76323e-01_r8, 2.57258e-01_r8, & + & 2.39509e-01_r8, 2.22985e-01_r8, 2.07600e-01_r8, 1.93277e-01_r8, 1.79942e-01_r8/) + selfrefo(:, 7) = (/ & + & 3.65491e-01_r8, 3.41599e-01_r8, 3.19270e-01_r8, 2.98400e-01_r8, 2.78895e-01_r8, & + & 2.60664e-01_r8, 2.43625e-01_r8, 2.27700e-01_r8, 2.12816e-01_r8, 1.98905e-01_r8/) + selfrefo(:, 8) = (/ & + & 3.70354e-01_r8, 3.45005e-01_r8, 3.21390e-01_r8, 2.99392e-01_r8, 2.78899e-01_r8, & + & 2.59809e-01_r8, 2.42026e-01_r8, 2.25460e-01_r8, 2.10028e-01_r8, 1.95652e-01_r8/) + selfrefo(:, 9) = (/ & + & 3.60483e-01_r8, 3.37846e-01_r8, 3.16630e-01_r8, 2.96747e-01_r8, 2.78112e-01_r8, & + & 2.60648e-01_r8, 2.44280e-01_r8, 2.28940e-01_r8, 2.14563e-01_r8, 2.01090e-01_r8/) + selfrefo(:,10) = (/ & + & 3.71845e-01_r8, 3.48164e-01_r8, 3.25990e-01_r8, 3.05229e-01_r8, 2.85790e-01_r8, & + & 2.67588e-01_r8, 2.50547e-01_r8, 2.34590e-01_r8, 2.19650e-01_r8, 2.05661e-01_r8/) + selfrefo(:,11) = (/ & + & 3.60606e-01_r8, 3.40789e-01_r8, 3.22060e-01_r8, 3.04361e-01_r8, 2.87634e-01_r8, & + & 2.71826e-01_r8, 2.56888e-01_r8, 2.42770e-01_r8, 2.29428e-01_r8, 2.16819e-01_r8/) + selfrefo(:,12) = (/ & + & 3.90046e-01_r8, 3.68879e-01_r8, 3.48860e-01_r8, 3.29928e-01_r8, 3.12023e-01_r8, & + & 2.95089e-01_r8, 2.79075e-01_r8, 2.63930e-01_r8, 2.49607e-01_r8, 2.36061e-01_r8/) + selfrefo(:,13) = (/ & + & 4.38542e-01_r8, 4.05139e-01_r8, 3.74280e-01_r8, 3.45771e-01_r8, 3.19434e-01_r8, & + & 2.95103e-01_r8, 2.72626e-01_r8, 2.51860e-01_r8, 2.32676e-01_r8, 2.14953e-01_r8/) + selfrefo(:,14) = (/ & + & 4.19448e-01_r8, 3.81920e-01_r8, 3.47750e-01_r8, 3.16637e-01_r8, 2.88307e-01_r8, & + & 2.62513e-01_r8, 2.39026e-01_r8, 2.17640e-01_r8, 1.98168e-01_r8, 1.80438e-01_r8/) + selfrefo(:,15) = (/ & + & 4.20276e-01_r8, 3.92281e-01_r8, 3.66150e-01_r8, 3.41760e-01_r8, 3.18995e-01_r8, & + & 2.97746e-01_r8, 2.77912e-01_r8, 2.59400e-01_r8, 2.42121e-01_r8, 2.25993e-01_r8/) + selfrefo(:,16) = (/ & + & 4.20276e-01_r8, 3.92281e-01_r8, 3.66150e-01_r8, 3.41760e-01_r8, 3.18995e-01_r8, & + & 2.97746e-01_r8, 2.77912e-01_r8, 2.59400e-01_r8, 2.42121e-01_r8, 2.25993e-01_r8/) + + end subroutine lw_kgb10 + +! ************************************************************************** + subroutine lw_kgb11 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg11, only : fracrefao, fracrefbo, kao, kbo, kao_mo2, & + kbo_mo2, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P=1053.63 mb, T= 294.2 K + fracrefao(:) = (/ & + & 1.4601e-01_r8,1.3824e-01_r8,1.4240e-01_r8,1.3463e-01_r8,1.1948e-01_r8,1.0440e-01_r8, & + & 8.8667e-02_r8,6.5792e-02_r8,4.3893e-02_r8,4.7941e-03_r8,4.0760e-03_r8,3.3207e-03_r8, & + & 2.4087e-03_r8,1.3912e-03_r8,4.3482e-04_r8,6.0932e-05_r8/) + +! Planck fraction mapping level : P=0.353 mb, T = 262.11 K + fracrefbo(:) = (/ & + & 7.2928e-02_r8,1.4900e-01_r8,1.6156e-01_r8,1.5603e-01_r8,1.3934e-01_r8,1.1394e-01_r8, & + & 8.8783e-02_r8,6.2411e-02_r8,4.0191e-02_r8,4.4587e-03_r8,3.9533e-03_r8,3.0847e-03_r8, & + & 2.2317e-03_r8,1.4410e-03_r8,5.6722e-04_r8,7.7933e-05_r8/) + +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels > ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which +! g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &4.9423e-02_r8,4.8938e-02_r8,4.8236e-02_r8,4.7630e-02_r8,4.7027e-02_r8/) + kao(:, 2, 1) = (/ & + &4.0264e-02_r8,3.9991e-02_r8,3.9414e-02_r8,3.8921e-02_r8,3.8455e-02_r8/) + kao(:, 3, 1) = (/ & + &3.2762e-02_r8,3.2612e-02_r8,3.2225e-02_r8,3.1842e-02_r8,3.1448e-02_r8/) + kao(:, 4, 1) = (/ & + &2.6929e-02_r8,2.6828e-02_r8,2.6636e-02_r8,2.6311e-02_r8,2.5979e-02_r8/) + kao(:, 5, 1) = (/ & + &2.2254e-02_r8,2.2190e-02_r8,2.2139e-02_r8,2.1844e-02_r8,2.1606e-02_r8/) + kao(:, 6, 1) = (/ & + &1.8428e-02_r8,1.8406e-02_r8,1.8346e-02_r8,1.8223e-02_r8,1.7986e-02_r8/) + kao(:, 7, 1) = (/ & + &1.5302e-02_r8,1.5279e-02_r8,1.5227e-02_r8,1.5173e-02_r8,1.5001e-02_r8/) + kao(:, 8, 1) = (/ & + &1.2917e-02_r8,1.2821e-02_r8,1.2762e-02_r8,1.2673e-02_r8,1.2614e-02_r8/) + kao(:, 9, 1) = (/ & + &1.4361e-02_r8,1.3355e-02_r8,1.2836e-02_r8,1.2424e-02_r8,1.2069e-02_r8/) + kao(:,10, 1) = (/ & + &1.9078e-02_r8,1.9077e-02_r8,1.9301e-02_r8,1.9494e-02_r8,1.9600e-02_r8/) + kao(:,11, 1) = (/ & + &1.6651e-02_r8,1.7279e-02_r8,1.7762e-02_r8,1.8212e-02_r8,1.8508e-02_r8/) + kao(:,12, 1) = (/ & + &1.4359e-02_r8,1.4912e-02_r8,1.5370e-02_r8,1.5766e-02_r8,1.6068e-02_r8/) + kao(:,13, 1) = (/ & + &1.2190e-02_r8,1.2693e-02_r8,1.3086e-02_r8,1.3355e-02_r8,1.3602e-02_r8/) + kao(:, 1, 2) = (/ & + &1.3874e-01_r8,1.3507e-01_r8,1.3188e-01_r8,1.2875e-01_r8,1.2573e-01_r8/) + kao(:, 2, 2) = (/ & + &1.1449e-01_r8,1.1143e-01_r8,1.0880e-01_r8,1.0626e-01_r8,1.0384e-01_r8/) + kao(:, 3, 2) = (/ & + &9.4610e-02_r8,9.2157e-02_r8,8.9899e-02_r8,8.7836e-02_r8,8.5813e-02_r8/) + kao(:, 4, 2) = (/ & + &7.8921e-02_r8,7.6917e-02_r8,7.5042e-02_r8,7.3283e-02_r8,7.1619e-02_r8/) + kao(:, 5, 2) = (/ & + &6.6025e-02_r8,6.4395e-02_r8,6.2788e-02_r8,6.1406e-02_r8,5.9938e-02_r8/) + kao(:, 6, 2) = (/ & + &5.5198e-02_r8,5.3979e-02_r8,5.2652e-02_r8,5.1421e-02_r8,5.0291e-02_r8/) + kao(:, 7, 2) = (/ & + &4.5982e-02_r8,4.5142e-02_r8,4.4142e-02_r8,4.3045e-02_r8,4.2121e-02_r8/) + kao(:, 8, 2) = (/ & + &3.8128e-02_r8,3.7632e-02_r8,3.6913e-02_r8,3.6127e-02_r8,3.5207e-02_r8/) + kao(:, 9, 2) = (/ & + &2.9988e-02_r8,3.0199e-02_r8,2.9924e-02_r8,2.9588e-02_r8,2.9106e-02_r8/) + kao(:,10, 2) = (/ & + &4.8557e-02_r8,4.4974e-02_r8,3.7588e-02_r8,3.1508e-02_r8,2.7381e-02_r8/) + kao(:,11, 2) = (/ & + &4.6113e-02_r8,4.4271e-02_r8,4.2375e-02_r8,4.0024e-02_r8,3.7665e-02_r8/) + kao(:,12, 2) = (/ & + &4.0305e-02_r8,3.9408e-02_r8,3.7504e-02_r8,3.5981e-02_r8,3.4390e-02_r8/) + kao(:,13, 2) = (/ & + &3.3779e-02_r8,3.2735e-02_r8,3.1178e-02_r8,2.9814e-02_r8,2.8271e-02_r8/) + kao(:, 1, 3) = (/ & + &2.4150e-01_r8,2.3616e-01_r8,2.3111e-01_r8,2.2673e-01_r8,2.2290e-01_r8/) + kao(:, 2, 3) = (/ & + &2.0007e-01_r8,1.9568e-01_r8,1.9176e-01_r8,1.8825e-01_r8,1.8518e-01_r8/) + kao(:, 3, 3) = (/ & + &1.6573e-01_r8,1.6221e-01_r8,1.5908e-01_r8,1.5616e-01_r8,1.5376e-01_r8/) + kao(:, 4, 3) = (/ & + &1.3876e-01_r8,1.3573e-01_r8,1.3298e-01_r8,1.3059e-01_r8,1.2856e-01_r8/) + kao(:, 5, 3) = (/ & + &1.1663e-01_r8,1.1399e-01_r8,1.1156e-01_r8,1.0951e-01_r8,1.0785e-01_r8/) + kao(:, 6, 3) = (/ & + &9.8259e-02_r8,9.5861e-02_r8,9.3802e-02_r8,9.1948e-02_r8,9.0492e-02_r8/) + kao(:, 7, 3) = (/ & + &8.2887e-02_r8,8.0616e-02_r8,7.8766e-02_r8,7.7206e-02_r8,7.5856e-02_r8/) + kao(:, 8, 3) = (/ & + &6.9730e-02_r8,6.7730e-02_r8,6.5964e-02_r8,6.4565e-02_r8,6.3437e-02_r8/) + kao(:, 9, 3) = (/ & + &5.8101e-02_r8,5.6452e-02_r8,5.5028e-02_r8,5.3674e-02_r8,5.2557e-02_r8/) + kao(:,10, 3) = (/ & + &3.7373e-02_r8,3.5041e-02_r8,3.8621e-02_r8,4.1558e-02_r8,4.3012e-02_r8/) + kao(:,11, 3) = (/ & + &5.3584e-02_r8,4.0890e-02_r8,3.3882e-02_r8,2.9034e-02_r8,2.6383e-02_r8/) + kao(:,12, 3) = (/ & + &5.8428e-02_r8,4.4689e-02_r8,3.5111e-02_r8,2.9172e-02_r8,2.4695e-02_r8/) + kao(:,13, 3) = (/ & + &4.7904e-02_r8,3.6965e-02_r8,2.8601e-02_r8,2.3919e-02_r8,2.0680e-02_r8/) + kao(:, 1, 4) = (/ & + &4.2548e-01_r8,4.1807e-01_r8,4.1094e-01_r8,4.0423e-01_r8,3.9806e-01_r8/) + kao(:, 2, 4) = (/ & + &3.5494e-01_r8,3.4863e-01_r8,3.4235e-01_r8,3.3657e-01_r8,3.3155e-01_r8/) + kao(:, 3, 4) = (/ & + &2.9648e-01_r8,2.9099e-01_r8,2.8545e-01_r8,2.8071e-01_r8,2.7648e-01_r8/) + kao(:, 4, 4) = (/ & + &2.4939e-01_r8,2.4483e-01_r8,2.4021e-01_r8,2.3626e-01_r8,2.3256e-01_r8/) + kao(:, 5, 4) = (/ & + &2.1025e-01_r8,2.0654e-01_r8,2.0285e-01_r8,1.9937e-01_r8,1.9615e-01_r8/) + kao(:, 6, 4) = (/ & + &1.7714e-01_r8,1.7417e-01_r8,1.7124e-01_r8,1.6826e-01_r8,1.6547e-01_r8/) + kao(:, 7, 4) = (/ & + &1.4884e-01_r8,1.4658e-01_r8,1.4422e-01_r8,1.4179e-01_r8,1.3940e-01_r8/) + kao(:, 8, 4) = (/ & + &1.2471e-01_r8,1.2286e-01_r8,1.2117e-01_r8,1.1917e-01_r8,1.1721e-01_r8/) + kao(:, 9, 4) = (/ & + &1.0337e-01_r8,1.0218e-01_r8,1.0077e-01_r8,9.9333e-02_r8,9.7869e-02_r8/) + kao(:,10, 4) = (/ & + &8.5198e-02_r8,8.3413e-02_r8,8.1099e-02_r8,7.8395e-02_r8,7.6293e-02_r8/) + kao(:,11, 4) = (/ & + &6.0820e-02_r8,6.7915e-02_r8,6.7626e-02_r8,6.6844e-02_r8,6.6371e-02_r8/) + kao(:,12, 4) = (/ & + &4.0000e-02_r8,4.8190e-02_r8,5.3574e-02_r8,5.5575e-02_r8,5.5151e-02_r8/) + kao(:,13, 4) = (/ & + &3.3587e-02_r8,4.0386e-02_r8,4.5135e-02_r8,4.6401e-02_r8,4.5805e-02_r8/) + kao(:, 1, 5) = (/ & + &7.7524e-01_r8,7.6536e-01_r8,7.5522e-01_r8,7.4431e-01_r8,7.3311e-01_r8/) + kao(:, 2, 5) = (/ & + &6.5185e-01_r8,6.4405e-01_r8,6.3568e-01_r8,6.2684e-01_r8,6.1765e-01_r8/) + kao(:, 3, 5) = (/ & + &5.4580e-01_r8,5.3942e-01_r8,5.3289e-01_r8,5.2546e-01_r8,5.1768e-01_r8/) + kao(:, 4, 5) = (/ & + &4.5945e-01_r8,4.5416e-01_r8,4.4868e-01_r8,4.4229e-01_r8,4.3592e-01_r8/) + kao(:, 5, 5) = (/ & + &3.8777e-01_r8,3.8350e-01_r8,3.7876e-01_r8,3.7352e-01_r8,3.6853e-01_r8/) + kao(:, 6, 5) = (/ & + &3.2750e-01_r8,3.2403e-01_r8,3.2009e-01_r8,3.1598e-01_r8,3.1216e-01_r8/) + kao(:, 7, 5) = (/ & + &2.7610e-01_r8,2.7333e-01_r8,2.7016e-01_r8,2.6699e-01_r8,2.6402e-01_r8/) + kao(:, 8, 5) = (/ & + &2.3237e-01_r8,2.3021e-01_r8,2.2764e-01_r8,2.2511e-01_r8,2.2263e-01_r8/) + kao(:, 9, 5) = (/ & + &1.9461e-01_r8,1.9312e-01_r8,1.9116e-01_r8,1.8911e-01_r8,1.8708e-01_r8/) + kao(:,10, 5) = (/ & + &1.4772e-01_r8,1.4997e-01_r8,1.5067e-01_r8,1.5164e-01_r8,1.5169e-01_r8/) + kao(:,11, 5) = (/ & + &1.1317e-01_r8,1.1322e-01_r8,1.1552e-01_r8,1.1824e-01_r8,1.1886e-01_r8/) + kao(:,12, 5) = (/ & + &9.7948e-02_r8,9.4310e-02_r8,9.3527e-02_r8,9.3094e-02_r8,9.5273e-02_r8/) + kao(:,13, 5) = (/ & + &8.1443e-02_r8,7.8686e-02_r8,7.8076e-02_r8,7.8298e-02_r8,8.0221e-02_r8/) + kao(:, 1, 6) = (/ & + &1.5697e+00_r8,1.5485e+00_r8,1.5270e+00_r8,1.5062e+00_r8,1.4845e+00_r8/) + kao(:, 2, 6) = (/ & + &1.3465e+00_r8,1.3286e+00_r8,1.3101e+00_r8,1.2912e+00_r8,1.2719e+00_r8/) + kao(:, 3, 6) = (/ & + &1.1474e+00_r8,1.1322e+00_r8,1.1161e+00_r8,1.0997e+00_r8,1.0837e+00_r8/) + kao(:, 4, 6) = (/ & + &9.7861e-01_r8,9.6591e-01_r8,9.5236e-01_r8,9.3871e-01_r8,9.2522e-01_r8/) + kao(:, 5, 6) = (/ & + &8.3345e-01_r8,8.2282e-01_r8,8.1147e-01_r8,8.0015e-01_r8,7.8882e-01_r8/) + kao(:, 6, 6) = (/ & + &7.0768e-01_r8,6.9919e-01_r8,6.8975e-01_r8,6.8018e-01_r8,6.7024e-01_r8/) + kao(:, 7, 6) = (/ & + &5.9916e-01_r8,5.9240e-01_r8,5.8444e-01_r8,5.7632e-01_r8,5.6762e-01_r8/) + kao(:, 8, 6) = (/ & + &5.0612e-01_r8,5.0051e-01_r8,4.9423e-01_r8,4.8731e-01_r8,4.7989e-01_r8/) + kao(:, 9, 6) = (/ & + &4.2622e-01_r8,4.2196e-01_r8,4.1690e-01_r8,4.1124e-01_r8,4.0525e-01_r8/) + kao(:,10, 6) = (/ & + &3.5041e-01_r8,3.4937e-01_r8,3.4686e-01_r8,3.4326e-01_r8,3.3900e-01_r8/) + kao(:,11, 6) = (/ & + &2.8138e-01_r8,2.8270e-01_r8,2.8314e-01_r8,2.8109e-01_r8,2.7863e-01_r8/) + kao(:,12, 6) = (/ & + &2.2569e-01_r8,2.3115e-01_r8,2.3249e-01_r8,2.3233e-01_r8,2.3100e-01_r8/) + kao(:,13, 6) = (/ & + &1.8817e-01_r8,1.9206e-01_r8,1.9341e-01_r8,1.9316e-01_r8,1.9216e-01_r8/) + kao(:, 1, 7) = (/ & + &3.4196e+00_r8,3.3801e+00_r8,3.3399e+00_r8,3.2946e+00_r8,3.2477e+00_r8/) + kao(:, 2, 7) = (/ & + &3.0295e+00_r8,2.9903e+00_r8,2.9469e+00_r8,2.9032e+00_r8,2.8599e+00_r8/) + kao(:, 3, 7) = (/ & + &2.6483e+00_r8,2.6096e+00_r8,2.5696e+00_r8,2.5316e+00_r8,2.4936e+00_r8/) + kao(:, 4, 7) = (/ & + &2.3044e+00_r8,2.2705e+00_r8,2.2374e+00_r8,2.2055e+00_r8,2.1724e+00_r8/) + kao(:, 5, 7) = (/ & + &1.9970e+00_r8,1.9688e+00_r8,1.9416e+00_r8,1.9143e+00_r8,1.8852e+00_r8/) + kao(:, 6, 7) = (/ & + &1.7224e+00_r8,1.6992e+00_r8,1.6760e+00_r8,1.6526e+00_r8,1.6276e+00_r8/) + kao(:, 7, 7) = (/ & + &1.4770e+00_r8,1.4579e+00_r8,1.4384e+00_r8,1.4185e+00_r8,1.3976e+00_r8/) + kao(:, 8, 7) = (/ & + &1.2593e+00_r8,1.2433e+00_r8,1.2274e+00_r8,1.2112e+00_r8,1.1939e+00_r8/) + kao(:, 9, 7) = (/ & + &1.0697e+00_r8,1.0563e+00_r8,1.0434e+00_r8,1.0295e+00_r8,1.0150e+00_r8/) + kao(:,10, 7) = (/ & + &9.0213e-01_r8,8.9139e-01_r8,8.8119e-01_r8,8.6954e-01_r8,8.5716e-01_r8/) + kao(:,11, 7) = (/ & + &7.5061e-01_r8,7.4446e-01_r8,7.3597e-01_r8,7.2638e-01_r8,7.1615e-01_r8/) + kao(:,12, 7) = (/ & + &6.2457e-01_r8,6.1924e-01_r8,6.1219e-01_r8,6.0465e-01_r8,5.9633e-01_r8/) + kao(:,13, 7) = (/ & + &5.2204e-01_r8,5.1758e-01_r8,5.1182e-01_r8,5.0530e-01_r8,4.9787e-01_r8/) + kao(:, 1, 8) = (/ & + &7.9795e+00_r8,7.8457e+00_r8,7.7132e+00_r8,7.5890e+00_r8,7.4645e+00_r8/) + kao(:, 2, 8) = (/ & + &7.5076e+00_r8,7.3733e+00_r8,7.2519e+00_r8,7.1316e+00_r8,7.0099e+00_r8/) + kao(:, 3, 8) = (/ & + &6.9340e+00_r8,6.8148e+00_r8,6.7036e+00_r8,6.5875e+00_r8,6.4766e+00_r8/) + kao(:, 4, 8) = (/ & + &6.3414e+00_r8,6.2366e+00_r8,6.1298e+00_r8,6.0215e+00_r8,5.9183e+00_r8/) + kao(:, 5, 8) = (/ & + &5.7373e+00_r8,5.6423e+00_r8,5.5412e+00_r8,5.4426e+00_r8,5.3434e+00_r8/) + kao(:, 6, 8) = (/ & + &5.1373e+00_r8,5.0482e+00_r8,4.9577e+00_r8,4.8621e+00_r8,4.7659e+00_r8/) + kao(:, 7, 8) = (/ & + &4.5492e+00_r8,4.4684e+00_r8,4.3821e+00_r8,4.2928e+00_r8,4.2067e+00_r8/) + kao(:, 8, 8) = (/ & + &3.9884e+00_r8,3.9140e+00_r8,3.8349e+00_r8,3.7563e+00_r8,3.6821e+00_r8/) + kao(:, 9, 8) = (/ & + &3.4656e+00_r8,3.3995e+00_r8,3.3300e+00_r8,3.2636e+00_r8,3.2010e+00_r8/) + kao(:,10, 8) = (/ & + &2.9841e+00_r8,2.9267e+00_r8,2.8680e+00_r8,2.8124e+00_r8,2.7592e+00_r8/) + kao(:,11, 8) = (/ & + &2.5294e+00_r8,2.4795e+00_r8,2.4321e+00_r8,2.3862e+00_r8,2.3418e+00_r8/) + kao(:,12, 8) = (/ & + &2.1315e+00_r8,2.0918e+00_r8,2.0527e+00_r8,2.0146e+00_r8,1.9776e+00_r8/) + kao(:,13, 8) = (/ & + &1.7932e+00_r8,1.7598e+00_r8,1.7272e+00_r8,1.6957e+00_r8,1.6643e+00_r8/) + kao(:, 1, 9) = (/ & + &1.8965e+01_r8,1.8711e+01_r8,1.8469e+01_r8,1.8242e+01_r8,1.8035e+01_r8/) + kao(:, 2, 9) = (/ & + &1.9621e+01_r8,1.9373e+01_r8,1.9124e+01_r8,1.8882e+01_r8,1.8648e+01_r8/) + kao(:, 3, 9) = (/ & + &2.0111e+01_r8,1.9849e+01_r8,1.9576e+01_r8,1.9310e+01_r8,1.9047e+01_r8/) + kao(:, 4, 9) = (/ & + &2.0303e+01_r8,2.0017e+01_r8,1.9726e+01_r8,1.9447e+01_r8,1.9174e+01_r8/) + kao(:, 5, 9) = (/ & + &2.0176e+01_r8,1.9882e+01_r8,1.9591e+01_r8,1.9312e+01_r8,1.9035e+01_r8/) + kao(:, 6, 9) = (/ & + &1.9747e+01_r8,1.9457e+01_r8,1.9166e+01_r8,1.8888e+01_r8,1.8606e+01_r8/) + kao(:, 7, 9) = (/ & + &1.9018e+01_r8,1.8727e+01_r8,1.8446e+01_r8,1.8173e+01_r8,1.7878e+01_r8/) + kao(:, 8, 9) = (/ & + &1.8015e+01_r8,1.7734e+01_r8,1.7466e+01_r8,1.7191e+01_r8,1.6898e+01_r8/) + kao(:, 9, 9) = (/ & + &1.6785e+01_r8,1.6527e+01_r8,1.6264e+01_r8,1.5992e+01_r8,1.5711e+01_r8/) + kao(:,10, 9) = (/ & + &1.5379e+01_r8,1.5144e+01_r8,1.4899e+01_r8,1.4648e+01_r8,1.4396e+01_r8/) + kao(:,11, 9) = (/ & + &1.3809e+01_r8,1.3588e+01_r8,1.3370e+01_r8,1.3146e+01_r8,1.2927e+01_r8/) + kao(:,12, 9) = (/ & + &1.2243e+01_r8,1.2056e+01_r8,1.1862e+01_r8,1.1669e+01_r8,1.1464e+01_r8/) + kao(:,13, 9) = (/ & + &1.0743e+01_r8,1.0581e+01_r8,1.0416e+01_r8,1.0238e+01_r8,1.0057e+01_r8/) + kao(:, 1,10) = (/ & + &3.4918e+01_r8,3.4410e+01_r8,3.3938e+01_r8,3.3384e+01_r8,3.2811e+01_r8/) + kao(:, 2,10) = (/ & + &3.7421e+01_r8,3.6860e+01_r8,3.6321e+01_r8,3.5822e+01_r8,3.5445e+01_r8/) + kao(:, 3,10) = (/ & + &4.0412e+01_r8,3.9722e+01_r8,3.9217e+01_r8,3.8832e+01_r8,3.8460e+01_r8/) + kao(:, 4,10) = (/ & + &4.3162e+01_r8,4.2539e+01_r8,4.2112e+01_r8,4.1640e+01_r8,4.1120e+01_r8/) + kao(:, 5,10) = (/ & + &4.5609e+01_r8,4.5045e+01_r8,4.4552e+01_r8,4.3899e+01_r8,4.3271e+01_r8/) + kao(:, 6,10) = (/ & + &4.7877e+01_r8,4.7338e+01_r8,4.6747e+01_r8,4.6031e+01_r8,4.5492e+01_r8/) + kao(:, 7,10) = (/ & + &4.9831e+01_r8,4.9324e+01_r8,4.8717e+01_r8,4.8005e+01_r8,4.7611e+01_r8/) + kao(:, 8,10) = (/ & + &5.1031e+01_r8,5.0574e+01_r8,4.9915e+01_r8,4.9244e+01_r8,4.8761e+01_r8/) + kao(:, 9,10) = (/ & + &5.1465e+01_r8,5.0984e+01_r8,5.0270e+01_r8,4.9612e+01_r8,4.9032e+01_r8/) + kao(:,10,10) = (/ & + &5.0911e+01_r8,5.0267e+01_r8,4.9512e+01_r8,4.8818e+01_r8,4.8092e+01_r8/) + kao(:,11,10) = (/ & + &4.8719e+01_r8,4.7980e+01_r8,4.7190e+01_r8,4.6412e+01_r8,4.5593e+01_r8/) + kao(:,12,10) = (/ & + &4.5566e+01_r8,4.4779e+01_r8,4.4020e+01_r8,4.3287e+01_r8,4.2695e+01_r8/) + kao(:,13,10) = (/ & + &4.1842e+01_r8,4.1126e+01_r8,4.0474e+01_r8,3.9934e+01_r8,3.9455e+01_r8/) + kao(:, 1,11) = (/ & + &4.3485e+01_r8,4.3086e+01_r8,4.2575e+01_r8,4.2046e+01_r8,4.1574e+01_r8/) + kao(:, 2,11) = (/ & + &4.8017e+01_r8,4.7410e+01_r8,4.6743e+01_r8,4.6112e+01_r8,4.5460e+01_r8/) + kao(:, 3,11) = (/ & + &5.1964e+01_r8,5.1351e+01_r8,5.0628e+01_r8,4.9892e+01_r8,4.9112e+01_r8/) + kao(:, 4,11) = (/ & + &5.5970e+01_r8,5.5232e+01_r8,5.4425e+01_r8,5.3658e+01_r8,5.2964e+01_r8/) + kao(:, 5,11) = (/ & + &6.0234e+01_r8,5.9398e+01_r8,5.8467e+01_r8,5.7720e+01_r8,5.7104e+01_r8/) + kao(:, 6,11) = (/ & + &6.4036e+01_r8,6.3174e+01_r8,6.2265e+01_r8,6.1623e+01_r8,6.0928e+01_r8/) + kao(:, 7,11) = (/ & + &6.7087e+01_r8,6.6347e+01_r8,6.5603e+01_r8,6.4996e+01_r8,6.4192e+01_r8/) + kao(:, 8,11) = (/ & + &6.9922e+01_r8,6.9386e+01_r8,6.8783e+01_r8,6.8159e+01_r8,6.7317e+01_r8/) + kao(:, 9,11) = (/ & + &7.2326e+01_r8,7.1863e+01_r8,7.1404e+01_r8,7.0792e+01_r8,6.9972e+01_r8/) + kao(:,10,11) = (/ & + &7.3782e+01_r8,7.3486e+01_r8,7.3017e+01_r8,7.2321e+01_r8,7.1486e+01_r8/) + kao(:,11,11) = (/ & + &7.4137e+01_r8,7.3779e+01_r8,7.3113e+01_r8,7.2218e+01_r8,7.1354e+01_r8/) + kao(:,12,11) = (/ & + &7.3214e+01_r8,7.2506e+01_r8,7.1526e+01_r8,7.0521e+01_r8,6.9446e+01_r8/) + kao(:,13,11) = (/ & + &7.0360e+01_r8,6.9342e+01_r8,6.8249e+01_r8,6.7098e+01_r8,6.5980e+01_r8/) + kao(:, 1,12) = (/ & + &5.1887e+01_r8,5.1393e+01_r8,5.0969e+01_r8,5.0675e+01_r8,5.0203e+01_r8/) + kao(:, 2,12) = (/ & + &5.9704e+01_r8,5.9201e+01_r8,5.8829e+01_r8,5.8469e+01_r8,5.7899e+01_r8/) + kao(:, 3,12) = (/ & + &6.7858e+01_r8,6.7238e+01_r8,6.6756e+01_r8,6.6195e+01_r8,6.5626e+01_r8/) + kao(:, 4,12) = (/ & + &7.5062e+01_r8,7.4258e+01_r8,7.3522e+01_r8,7.2807e+01_r8,7.2094e+01_r8/) + kao(:, 5,12) = (/ & + &8.1152e+01_r8,8.0143e+01_r8,7.9393e+01_r8,7.8647e+01_r8,7.7881e+01_r8/) + kao(:, 6,12) = (/ & + &8.7340e+01_r8,8.6150e+01_r8,8.5372e+01_r8,8.4516e+01_r8,8.3657e+01_r8/) + kao(:, 7,12) = (/ & + &9.4121e+01_r8,9.2665e+01_r8,9.1695e+01_r8,9.0706e+01_r8,8.9764e+01_r8/) + kao(:, 8,12) = (/ & + &1.0086e+02_r8,9.9171e+01_r8,9.7989e+01_r8,9.6851e+01_r8,9.5921e+01_r8/) + kao(:, 9,12) = (/ & + &1.0671e+02_r8,1.0483e+02_r8,1.0352e+02_r8,1.0233e+02_r8,1.0145e+02_r8/) + kao(:,10,12) = (/ & + &1.1135e+02_r8,1.0957e+02_r8,1.0846e+02_r8,1.0742e+02_r8,1.0652e+02_r8/) + kao(:,11,12) = (/ & + &1.1430e+02_r8,1.1336e+02_r8,1.1254e+02_r8,1.1170e+02_r8,1.1063e+02_r8/) + kao(:,12,12) = (/ & + &1.1681e+02_r8,1.1638e+02_r8,1.1571e+02_r8,1.1469e+02_r8,1.1347e+02_r8/) + kao(:,13,12) = (/ & + &1.1832e+02_r8,1.1787e+02_r8,1.1696e+02_r8,1.1585e+02_r8,1.1448e+02_r8/) + kao(:, 1,13) = (/ & + &6.2138e+01_r8,6.1536e+01_r8,6.0957e+01_r8,6.0185e+01_r8,5.9644e+01_r8/) + kao(:, 2,13) = (/ & + &7.3104e+01_r8,7.2436e+01_r8,7.1604e+01_r8,7.0616e+01_r8,6.9923e+01_r8/) + kao(:, 3,13) = (/ & + &8.5575e+01_r8,8.4690e+01_r8,8.3633e+01_r8,8.2595e+01_r8,8.1733e+01_r8/) + kao(:, 4,13) = (/ & + &9.8880e+01_r8,9.7932e+01_r8,9.6845e+01_r8,9.5711e+01_r8,9.4631e+01_r8/) + kao(:, 5,13) = (/ & + &1.1273e+02_r8,1.1168e+02_r8,1.1051e+02_r8,1.0912e+02_r8,1.0775e+02_r8/) + kao(:, 6,13) = (/ & + &1.2651e+02_r8,1.2538e+02_r8,1.2389e+02_r8,1.2226e+02_r8,1.2074e+02_r8/) + kao(:, 7,13) = (/ & + &1.4003e+02_r8,1.3861e+02_r8,1.3671e+02_r8,1.3477e+02_r8,1.3302e+02_r8/) + kao(:, 8,13) = (/ & + &1.5267e+02_r8,1.5069e+02_r8,1.4845e+02_r8,1.4633e+02_r8,1.4433e+02_r8/) + kao(:, 9,13) = (/ & + &1.6510e+02_r8,1.6280e+02_r8,1.6039e+02_r8,1.5803e+02_r8,1.5572e+02_r8/) + kao(:,10,13) = (/ & + &1.7758e+02_r8,1.7506e+02_r8,1.7227e+02_r8,1.6951e+02_r8,1.6718e+02_r8/) + kao(:,11,13) = (/ & + &1.8910e+02_r8,1.8565e+02_r8,1.8227e+02_r8,1.7970e+02_r8,1.7779e+02_r8/) + kao(:,12,13) = (/ & + &1.9894e+02_r8,1.9500e+02_r8,1.9204e+02_r8,1.8987e+02_r8,1.8782e+02_r8/) + kao(:,13,13) = (/ & + &2.0665e+02_r8,2.0326e+02_r8,2.0074e+02_r8,1.9867e+02_r8,1.9680e+02_r8/) + kao(:, 1,14) = (/ & + &7.2473e+01_r8,7.1368e+01_r8,7.0428e+01_r8,6.9932e+01_r8,6.9604e+01_r8/) + kao(:, 2,14) = (/ & + &8.7789e+01_r8,8.6447e+01_r8,8.5315e+01_r8,8.4536e+01_r8,8.3865e+01_r8/) + kao(:, 3,14) = (/ & + &1.0616e+02_r8,1.0473e+02_r8,1.0338e+02_r8,1.0236e+02_r8,1.0132e+02_r8/) + kao(:, 4,14) = (/ & + &1.2669e+02_r8,1.2502e+02_r8,1.2342e+02_r8,1.2210e+02_r8,1.2081e+02_r8/) + kao(:, 5,14) = (/ & + &1.4951e+02_r8,1.4761e+02_r8,1.4568e+02_r8,1.4409e+02_r8,1.4262e+02_r8/) + kao(:, 6,14) = (/ & + &1.7487e+02_r8,1.7259e+02_r8,1.7054e+02_r8,1.6873e+02_r8,1.6691e+02_r8/) + kao(:, 7,14) = (/ & + &2.0246e+02_r8,2.0010e+02_r8,1.9793e+02_r8,1.9585e+02_r8,1.9382e+02_r8/) + kao(:, 8,14) = (/ & + &2.3272e+02_r8,2.3034e+02_r8,2.2811e+02_r8,2.2588e+02_r8,2.2363e+02_r8/) + kao(:, 9,14) = (/ & + &2.6521e+02_r8,2.6298e+02_r8,2.6062e+02_r8,2.5802e+02_r8,2.5525e+02_r8/) + kao(:,10,14) = (/ & + &2.9843e+02_r8,2.9609e+02_r8,2.9357e+02_r8,2.9069e+02_r8,2.8721e+02_r8/) + kao(:,11,14) = (/ & + &3.3019e+02_r8,3.2789e+02_r8,3.2506e+02_r8,3.2111e+02_r8,3.1667e+02_r8/) + kao(:,12,14) = (/ & + &3.6200e+02_r8,3.5928e+02_r8,3.5512e+02_r8,3.5030e+02_r8,3.4598e+02_r8/) + kao(:,13,14) = (/ & + &3.9453e+02_r8,3.9054e+02_r8,3.8556e+02_r8,3.8029e+02_r8,3.7518e+02_r8/) + kao(:, 1,15) = (/ & + &8.4296e+01_r8,8.4294e+01_r8,8.4592e+01_r8,8.4817e+01_r8,8.4944e+01_r8/) + kao(:, 2,15) = (/ & + &1.0316e+02_r8,1.0286e+02_r8,1.0304e+02_r8,1.0333e+02_r8,1.0370e+02_r8/) + kao(:, 3,15) = (/ & + &1.2648e+02_r8,1.2563e+02_r8,1.2552e+02_r8,1.2542e+02_r8,1.2564e+02_r8/) + kao(:, 4,15) = (/ & + &1.5355e+02_r8,1.5194e+02_r8,1.5117e+02_r8,1.5062e+02_r8,1.5044e+02_r8/) + kao(:, 5,15) = (/ & + &1.8607e+02_r8,1.8324e+02_r8,1.8143e+02_r8,1.8019e+02_r8,1.7911e+02_r8/) + kao(:, 6,15) = (/ & + &2.2538e+02_r8,2.2140e+02_r8,2.1806e+02_r8,2.1567e+02_r8,2.1369e+02_r8/) + kao(:, 7,15) = (/ & + &2.7204e+02_r8,2.6705e+02_r8,2.6220e+02_r8,2.5861e+02_r8,2.5549e+02_r8/) + kao(:, 8,15) = (/ & + &3.2681e+02_r8,3.2069e+02_r8,3.1478e+02_r8,3.0961e+02_r8,3.0517e+02_r8/) + kao(:, 9,15) = (/ & + &3.9109e+02_r8,3.8311e+02_r8,3.7570e+02_r8,3.6941e+02_r8,3.6369e+02_r8/) + kao(:,10,15) = (/ & + &4.6558e+02_r8,4.5519e+02_r8,4.4566e+02_r8,4.3786e+02_r8,4.3114e+02_r8/) + kao(:,11,15) = (/ & + &5.4422e+02_r8,5.3170e+02_r8,5.2160e+02_r8,5.1300e+02_r8,5.0502e+02_r8/) + kao(:,12,15) = (/ & + &6.3083e+02_r8,6.1809e+02_r8,6.0782e+02_r8,5.9755e+02_r8,5.8778e+02_r8/) + kao(:,13,15) = (/ & + &7.2633e+02_r8,7.1401e+02_r8,7.0254e+02_r8,6.9098e+02_r8,6.8020e+02_r8/) + kao(:, 1,16) = (/ & + &9.0293e+01_r8,9.1524e+01_r8,9.2499e+01_r8,9.3157e+01_r8,9.3569e+01_r8/) + kao(:, 2,16) = (/ & + &1.1228e+02_r8,1.1346e+02_r8,1.1477e+02_r8,1.1575e+02_r8,1.1638e+02_r8/) + kao(:, 3,16) = (/ & + &1.3962e+02_r8,1.4080e+02_r8,1.4217e+02_r8,1.4343e+02_r8,1.4444e+02_r8/) + kao(:, 4,16) = (/ & + &1.7141e+02_r8,1.7272e+02_r8,1.7425e+02_r8,1.7564e+02_r8,1.7671e+02_r8/) + kao(:, 5,16) = (/ & + &2.0680e+02_r8,2.1031e+02_r8,2.1221e+02_r8,2.1383e+02_r8,2.1512e+02_r8/) + kao(:, 6,16) = (/ & + &2.5314e+02_r8,2.5478e+02_r8,2.5735e+02_r8,2.5955e+02_r8,2.6116e+02_r8/) + kao(:, 7,16) = (/ & + &3.0938e+02_r8,3.0774e+02_r8,3.1113e+02_r8,3.1414e+02_r8,3.1633e+02_r8/) + kao(:, 8,16) = (/ & + &3.7909e+02_r8,3.7514e+02_r8,3.7476e+02_r8,3.7901e+02_r8,3.8212e+02_r8/) + kao(:, 9,16) = (/ & + &4.6433e+02_r8,4.5795e+02_r8,4.5378e+02_r8,4.5558e+02_r8,4.5979e+02_r8/) + kao(:,10,16) = (/ & + &5.6730e+02_r8,5.5767e+02_r8,5.5088e+02_r8,5.4957e+02_r8,5.5150e+02_r8/) + kao(:,11,16) = (/ & + &6.8668e+02_r8,6.7309e+02_r8,6.6516e+02_r8,6.6333e+02_r8,6.6322e+02_r8/) + kao(:,12,16) = (/ & + &8.3053e+02_r8,8.1176e+02_r8,8.0043e+02_r8,7.9744e+02_r8,7.9485e+02_r8/) + kao(:,13,16) = (/ & + &1.0026e+03_r8,9.7775e+02_r8,9.6058e+02_r8,9.5314e+02_r8,9.4719e+02_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &1.2190e-02_r8,1.2693e-02_r8,1.3086e-02_r8,1.3355e-02_r8,1.3602e-02_r8/) + kbo(:,14, 1) = (/ & + &1.0639e-02_r8,1.0991e-02_r8,1.1315e-02_r8,1.1564e-02_r8,1.1518e-02_r8/) + kbo(:,15, 1) = (/ & + &9.4343e-03_r8,9.6676e-03_r8,9.5938e-03_r8,9.5530e-03_r8,9.4890e-03_r8/) + kbo(:,16, 1) = (/ & + &7.9681e-03_r8,7.8419e-03_r8,7.8162e-03_r8,7.7492e-03_r8,7.7652e-03_r8/) + kbo(:,17, 1) = (/ & + &6.4068e-03_r8,6.3539e-03_r8,6.3265e-03_r8,6.3294e-03_r8,6.2292e-03_r8/) + kbo(:,18, 1) = (/ & + &5.1420e-03_r8,5.1335e-03_r8,5.0780e-03_r8,5.0408e-03_r8,5.0223e-03_r8/) + kbo(:,19, 1) = (/ & + &4.1739e-03_r8,4.1404e-03_r8,4.1032e-03_r8,4.0908e-03_r8,4.0562e-03_r8/) + kbo(:,20, 1) = (/ & + &3.3887e-03_r8,3.3668e-03_r8,3.3481e-03_r8,3.3359e-03_r8,3.2948e-03_r8/) + kbo(:,21, 1) = (/ & + &2.7580e-03_r8,2.7551e-03_r8,2.7356e-03_r8,2.7092e-03_r8,2.6841e-03_r8/) + kbo(:,22, 1) = (/ & + &2.2558e-03_r8,2.2435e-03_r8,2.2235e-03_r8,2.2041e-03_r8,2.1870e-03_r8/) + kbo(:,23, 1) = (/ & + &1.8426e-03_r8,1.8324e-03_r8,1.8088e-03_r8,1.7975e-03_r8,1.7882e-03_r8/) + kbo(:,24, 1) = (/ & + &1.5091e-03_r8,1.4914e-03_r8,1.4770e-03_r8,1.4698e-03_r8,1.4675e-03_r8/) + kbo(:,25, 1) = (/ & + &1.2361e-03_r8,1.2170e-03_r8,1.2068e-03_r8,1.2059e-03_r8,1.2054e-03_r8/) + kbo(:,26, 1) = (/ & + &1.0050e-03_r8,9.9424e-04_r8,9.8921e-04_r8,9.8950e-04_r8,9.9102e-04_r8/) + kbo(:,27, 1) = (/ & + &8.1924e-04_r8,8.1181e-04_r8,8.1111e-04_r8,8.1148e-04_r8,8.1057e-04_r8/) + kbo(:,28, 1) = (/ & + &6.6881e-04_r8,6.6398e-04_r8,6.6473e-04_r8,6.6536e-04_r8,6.6057e-04_r8/) + kbo(:,29, 1) = (/ & + &5.4452e-04_r8,5.4181e-04_r8,5.4254e-04_r8,5.4342e-04_r8,5.3551e-04_r8/) + kbo(:,30, 1) = (/ & + &4.4259e-04_r8,4.4140e-04_r8,4.4207e-04_r8,4.4326e-04_r8,4.2874e-04_r8/) + kbo(:,31, 1) = (/ & + &3.5899e-04_r8,3.5826e-04_r8,3.5911e-04_r8,3.5984e-04_r8,3.4298e-04_r8/) + kbo(:,32, 1) = (/ & + &2.9138e-04_r8,2.9104e-04_r8,2.9178e-04_r8,2.9237e-04_r8,2.7522e-04_r8/) + kbo(:,33, 1) = (/ & + &2.3674e-04_r8,2.3667e-04_r8,2.3708e-04_r8,2.3749e-04_r8,2.2116e-04_r8/) + kbo(:,34, 1) = (/ & + &1.9293e-04_r8,1.9295e-04_r8,1.9307e-04_r8,1.9353e-04_r8,1.7944e-04_r8/) + kbo(:,35, 1) = (/ & + &1.5741e-04_r8,1.5737e-04_r8,1.5735e-04_r8,1.5778e-04_r8,1.4713e-04_r8/) + kbo(:,36, 1) = (/ & + &1.2872e-04_r8,1.2833e-04_r8,1.2856e-04_r8,1.2886e-04_r8,1.2147e-04_r8/) + kbo(:,37, 1) = (/ & + &1.0573e-04_r8,1.0521e-04_r8,1.0532e-04_r8,1.0552e-04_r8,1.0153e-04_r8/) + kbo(:,38, 1) = (/ & + &8.6912e-05_r8,8.6294e-05_r8,8.6278e-05_r8,8.6393e-05_r8,8.5663e-05_r8/) + kbo(:,39, 1) = (/ & + &7.1476e-05_r8,7.0797e-05_r8,7.0693e-05_r8,7.0706e-05_r8,7.0752e-05_r8/) + kbo(:,40, 1) = (/ & + &5.8778e-05_r8,5.8375e-05_r8,5.8149e-05_r8,5.8120e-05_r8,5.8038e-05_r8/) + kbo(:,41, 1) = (/ & + &4.8208e-05_r8,4.8291e-05_r8,4.7939e-05_r8,4.7839e-05_r8,4.7717e-05_r8/) + kbo(:,42, 1) = (/ & + &3.9735e-05_r8,3.9794e-05_r8,3.9588e-05_r8,3.9414e-05_r8,3.9275e-05_r8/) + kbo(:,43, 1) = (/ & + &3.3069e-05_r8,3.2750e-05_r8,3.2898e-05_r8,3.2646e-05_r8,3.2434e-05_r8/) + kbo(:,44, 1) = (/ & + &2.7160e-05_r8,2.7263e-05_r8,2.7120e-05_r8,2.7165e-05_r8,2.6874e-05_r8/) + kbo(:,45, 1) = (/ & + &2.2285e-05_r8,2.2565e-05_r8,2.2508e-05_r8,2.2456e-05_r8,2.2357e-05_r8/) + kbo(:,46, 1) = (/ & + &1.8468e-05_r8,1.8529e-05_r8,1.8744e-05_r8,1.8640e-05_r8,1.8584e-05_r8/) + kbo(:,47, 1) = (/ & + &1.5267e-05_r8,1.5373e-05_r8,1.5389e-05_r8,1.5590e-05_r8,1.5417e-05_r8/) + kbo(:,48, 1) = (/ & + &1.2576e-05_r8,1.2765e-05_r8,1.2771e-05_r8,1.2828e-05_r8,1.2953e-05_r8/) + kbo(:,49, 1) = (/ & + &1.0526e-05_r8,1.0503e-05_r8,1.0641e-05_r8,1.0645e-05_r8,1.0671e-05_r8/) + kbo(:,50, 1) = (/ & + &8.5146e-06_r8,8.8286e-06_r8,8.7879e-06_r8,8.8870e-06_r8,8.8515e-06_r8/) + kbo(:,51, 1) = (/ & + &6.8551e-06_r8,7.1714e-06_r8,7.4262e-06_r8,7.3568e-06_r8,7.4039e-06_r8/) + kbo(:,52, 1) = (/ & + &5.5111e-06_r8,5.7854e-06_r8,6.0431e-06_r8,6.2230e-06_r8,6.1473e-06_r8/) + kbo(:,53, 1) = (/ & + &4.4382e-06_r8,4.6559e-06_r8,4.8718e-06_r8,5.0815e-06_r8,5.1941e-06_r8/) + kbo(:,54, 1) = (/ & + &3.6177e-06_r8,3.7935e-06_r8,3.9613e-06_r8,4.1342e-06_r8,4.2936e-06_r8/) + kbo(:,55, 1) = (/ & + &2.9336e-06_r8,3.1004e-06_r8,3.2420e-06_r8,3.3846e-06_r8,3.5194e-06_r8/) + kbo(:,56, 1) = (/ & + &2.3777e-06_r8,2.5393e-06_r8,2.6559e-06_r8,2.7737e-06_r8,2.8819e-06_r8/) + kbo(:,57, 1) = (/ & + &1.9258e-06_r8,2.0635e-06_r8,2.1875e-06_r8,2.2772e-06_r8,2.3684e-06_r8/) + kbo(:,58, 1) = (/ & + &1.5658e-06_r8,1.6813e-06_r8,1.7910e-06_r8,1.8800e-06_r8,1.9530e-06_r8/) + kbo(:,59, 1) = (/ & + &1.3188e-06_r8,1.4141e-06_r8,1.4979e-06_r8,1.5764e-06_r8,1.6384e-06_r8/) + kbo(:,13, 2) = (/ & + &3.3779e-02_r8,3.2735e-02_r8,3.1178e-02_r8,2.9814e-02_r8,2.8271e-02_r8/) + kbo(:,14, 2) = (/ & + &2.7945e-02_r8,2.6846e-02_r8,2.5419e-02_r8,2.4157e-02_r8,2.2814e-02_r8/) + kbo(:,15, 2) = (/ & + &2.2748e-02_r8,2.1521e-02_r8,2.0571e-02_r8,1.9559e-02_r8,1.8047e-02_r8/) + kbo(:,16, 2) = (/ & + &1.8337e-02_r8,1.7587e-02_r8,1.6750e-02_r8,1.5705e-02_r8,1.3259e-02_r8/) + kbo(:,17, 2) = (/ & + &1.5034e-02_r8,1.4343e-02_r8,1.3736e-02_r8,1.1541e-02_r8,9.7400e-03_r8/) + kbo(:,18, 2) = (/ & + &1.2164e-02_r8,1.1828e-02_r8,9.9998e-03_r8,8.2911e-03_r8,6.9774e-03_r8/) + kbo(:,19, 2) = (/ & + &1.0053e-02_r8,8.7760e-03_r8,7.2944e-03_r8,6.0291e-03_r8,5.2188e-03_r8/) + kbo(:,20, 2) = (/ & + &8.0996e-03_r8,6.6628e-03_r8,5.4744e-03_r8,4.5474e-03_r8,4.0343e-03_r8/) + kbo(:,21, 2) = (/ & + &6.1685e-03_r8,5.0455e-03_r8,4.1278e-03_r8,3.5537e-03_r8,3.1461e-03_r8/) + kbo(:,22, 2) = (/ & + &4.6680e-03_r8,3.7894e-03_r8,3.1347e-03_r8,2.7602e-03_r8,2.4538e-03_r8/) + kbo(:,23, 2) = (/ & + &3.5105e-03_r8,2.8430e-03_r8,2.4311e-03_r8,2.1442e-03_r8,1.9116e-03_r8/) + kbo(:,24, 2) = (/ & + &2.6394e-03_r8,2.1852e-03_r8,1.8960e-03_r8,1.6702e-03_r8,1.4993e-03_r8/) + kbo(:,25, 2) = (/ & + &2.0041e-03_r8,1.6920e-03_r8,1.4784e-03_r8,1.3107e-03_r8,1.1883e-03_r8/) + kbo(:,26, 2) = (/ & + &1.5414e-03_r8,1.3189e-03_r8,1.1564e-03_r8,1.0333e-03_r8,9.4710e-04_r8/) + kbo(:,27, 2) = (/ & + &1.2025e-03_r8,1.0381e-03_r8,9.1423e-04_r8,8.1996e-04_r8,7.6323e-04_r8/) + kbo(:,28, 2) = (/ & + &9.4481e-04_r8,8.2314e-04_r8,7.2601e-04_r8,6.5680e-04_r8,6.2105e-04_r8/) + kbo(:,29, 2) = (/ & + &7.4291e-04_r8,6.5138e-04_r8,5.7968e-04_r8,5.2914e-04_r8,5.0508e-04_r8/) + kbo(:,30, 2) = (/ & + &5.8796e-04_r8,5.1841e-04_r8,4.6161e-04_r8,4.2521e-04_r8,4.1671e-04_r8/) + kbo(:,31, 2) = (/ & + &4.6334e-04_r8,4.1198e-04_r8,3.6828e-04_r8,3.4267e-04_r8,3.4322e-04_r8/) + kbo(:,32, 2) = (/ & + &3.6683e-04_r8,3.2718e-04_r8,2.9598e-04_r8,2.7743e-04_r8,2.8106e-04_r8/) + kbo(:,33, 2) = (/ & + &2.9220e-04_r8,2.6104e-04_r8,2.3912e-04_r8,2.2529e-04_r8,2.3032e-04_r8/) + kbo(:,34, 2) = (/ & + &2.3494e-04_r8,2.1114e-04_r8,1.9458e-04_r8,1.8336e-04_r8,1.8849e-04_r8/) + kbo(:,35, 2) = (/ & + &1.9117e-04_r8,1.7220e-04_r8,1.5969e-04_r8,1.5013e-04_r8,1.5359e-04_r8/) + kbo(:,36, 2) = (/ & + &1.5747e-04_r8,1.4221e-04_r8,1.3171e-04_r8,1.2370e-04_r8,1.2459e-04_r8/) + kbo(:,37, 2) = (/ & + &1.3250e-04_r8,1.1910e-04_r8,1.0968e-04_r8,1.0296e-04_r8,1.0130e-04_r8/) + kbo(:,38, 2) = (/ & + &1.1160e-04_r8,9.9715e-05_r8,9.1665e-05_r8,8.5730e-05_r8,8.1933e-05_r8/) + kbo(:,39, 2) = (/ & + &9.4135e-05_r8,8.3974e-05_r8,7.6783e-05_r8,7.1718e-05_r8,6.7517e-05_r8/) + kbo(:,40, 2) = (/ & + &8.0997e-05_r8,7.2288e-05_r8,6.5235e-05_r8,6.0491e-05_r8,5.6970e-05_r8/) + kbo(:,41, 2) = (/ & + &7.0436e-05_r8,6.2097e-05_r8,5.5431e-05_r8,5.1123e-05_r8,4.8054e-05_r8/) + kbo(:,42, 2) = (/ & + &6.1655e-05_r8,5.3367e-05_r8,4.7548e-05_r8,4.3416e-05_r8,4.0552e-05_r8/) + kbo(:,43, 2) = (/ & + &5.5272e-05_r8,4.6832e-05_r8,4.1549e-05_r8,3.7143e-05_r8,3.4563e-05_r8/) + kbo(:,44, 2) = (/ & + &5.0350e-05_r8,4.1911e-05_r8,3.6573e-05_r8,3.2553e-05_r8,2.9621e-05_r8/) + kbo(:,45, 2) = (/ & + &4.6680e-05_r8,3.8062e-05_r8,3.2149e-05_r8,2.8703e-05_r8,2.5694e-05_r8/) + kbo(:,46, 2) = (/ & + &4.2769e-05_r8,3.5698e-05_r8,2.9139e-05_r8,2.5199e-05_r8,2.2638e-05_r8/) + kbo(:,47, 2) = (/ & + &3.6477e-05_r8,3.2822e-05_r8,2.7467e-05_r8,2.2730e-05_r8,2.0075e-05_r8/) + kbo(:,48, 2) = (/ & + &3.0609e-05_r8,2.9832e-05_r8,2.5641e-05_r8,2.1246e-05_r8,1.7927e-05_r8/) + kbo(:,49, 2) = (/ & + &2.5892e-05_r8,2.4976e-05_r8,2.3819e-05_r8,2.0178e-05_r8,1.6719e-05_r8/) + kbo(:,50, 2) = (/ & + &2.2068e-05_r8,2.0897e-05_r8,2.0445e-05_r8,1.8401e-05_r8,1.5648e-05_r8/) + kbo(:,51, 2) = (/ & + &1.8894e-05_r8,1.8060e-05_r8,1.7047e-05_r8,1.6809e-05_r8,1.4426e-05_r8/) + kbo(:,52, 2) = (/ & + &1.6131e-05_r8,1.5345e-05_r8,1.4613e-05_r8,1.3961e-05_r8,1.3398e-05_r8/) + kbo(:,53, 2) = (/ & + &1.3727e-05_r8,1.3222e-05_r8,1.2619e-05_r8,1.1906e-05_r8,1.1467e-05_r8/) + kbo(:,54, 2) = (/ & + &1.1644e-05_r8,1.1203e-05_r8,1.0779e-05_r8,1.0373e-05_r8,9.7090e-06_r8/) + kbo(:,55, 2) = (/ & + &9.9606e-06_r8,9.5440e-06_r8,9.2216e-06_r8,8.7822e-06_r8,8.3198e-06_r8/) + kbo(:,56, 2) = (/ & + &8.4517e-06_r8,8.1696e-06_r8,7.8373e-06_r8,7.5094e-06_r8,7.2266e-06_r8/) + kbo(:,57, 2) = (/ & + &7.1634e-06_r8,7.0985e-06_r8,6.7296e-06_r8,6.4794e-06_r8,6.1647e-06_r8/) + kbo(:,58, 2) = (/ & + &6.2286e-06_r8,5.9713e-06_r8,5.8323e-06_r8,5.5370e-06_r8,5.3465e-06_r8/) + kbo(:,59, 2) = (/ & + &5.3307e-06_r8,5.0367e-06_r8,4.9690e-06_r8,4.6758e-06_r8,4.5062e-06_r8/) + kbo(:,13, 3) = (/ & + &4.7904e-02_r8,3.6965e-02_r8,2.8601e-02_r8,2.3919e-02_r8,2.0680e-02_r8/) + kbo(:,14, 3) = (/ & + &3.6570e-02_r8,2.7810e-02_r8,2.1848e-02_r8,1.8508e-02_r8,1.6582e-02_r8/) + kbo(:,15, 3) = (/ & + &2.6097e-02_r8,1.9628e-02_r8,1.6268e-02_r8,1.4252e-02_r8,1.3801e-02_r8/) + kbo(:,16, 3) = (/ & + &1.8293e-02_r8,1.4393e-02_r8,1.2369e-02_r8,1.1568e-02_r8,1.2855e-02_r8/) + kbo(:,17, 3) = (/ & + &1.3004e-02_r8,1.0838e-02_r8,9.6882e-03_r8,1.0818e-02_r8,1.1950e-02_r8/) + kbo(:,18, 3) = (/ & + &9.6007e-03_r8,8.2004e-03_r8,9.1048e-03_r8,1.0148e-02_r8,1.0662e-02_r8/) + kbo(:,19, 3) = (/ & + &7.2730e-03_r8,7.5847e-03_r8,8.4339e-03_r8,9.0734e-03_r8,9.2118e-03_r8/) + kbo(:,20, 3) = (/ & + &5.9400e-03_r8,6.7100e-03_r8,7.4249e-03_r8,7.7409e-03_r8,7.7182e-03_r8/) + kbo(:,21, 3) = (/ & + &5.2740e-03_r8,5.8871e-03_r8,6.3746e-03_r8,6.4908e-03_r8,6.3895e-03_r8/) + kbo(:,22, 3) = (/ & + &4.5973e-03_r8,5.1329e-03_r8,5.3865e-03_r8,5.3473e-03_r8,5.2488e-03_r8/) + kbo(:,23, 3) = (/ & + &4.0216e-03_r8,4.3958e-03_r8,4.5011e-03_r8,4.3919e-03_r8,4.3384e-03_r8/) + kbo(:,24, 3) = (/ & + &3.5050e-03_r8,3.6950e-03_r8,3.6848e-03_r8,3.6232e-03_r8,3.5889e-03_r8/) + kbo(:,25, 3) = (/ & + &3.0079e-03_r8,3.0947e-03_r8,3.0321e-03_r8,2.9863e-03_r8,2.9569e-03_r8/) + kbo(:,26, 3) = (/ & + &2.5223e-03_r8,2.5389e-03_r8,2.4899e-03_r8,2.4616e-03_r8,2.4119e-03_r8/) + kbo(:,27, 3) = (/ & + &2.0904e-03_r8,2.0720e-03_r8,2.0405e-03_r8,2.0263e-03_r8,1.9704e-03_r8/) + kbo(:,28, 3) = (/ & + &1.7240e-03_r8,1.6892e-03_r8,1.6695e-03_r8,1.6561e-03_r8,1.6055e-03_r8/) + kbo(:,29, 3) = (/ & + &1.4068e-03_r8,1.3720e-03_r8,1.3607e-03_r8,1.3422e-03_r8,1.3070e-03_r8/) + kbo(:,30, 3) = (/ & + &1.1328e-03_r8,1.1145e-03_r8,1.1117e-03_r8,1.0886e-03_r8,1.0628e-03_r8/) + kbo(:,31, 3) = (/ & + &9.1589e-04_r8,9.0415e-04_r8,9.0310e-04_r8,8.8069e-04_r8,8.6082e-04_r8/) + kbo(:,32, 3) = (/ & + &7.4268e-04_r8,7.3425e-04_r8,7.3091e-04_r8,7.1193e-04_r8,7.0016e-04_r8/) + kbo(:,33, 3) = (/ & + &5.9881e-04_r8,5.9536e-04_r8,5.8909e-04_r8,5.7513e-04_r8,5.6984e-04_r8/) + kbo(:,34, 3) = (/ & + &4.8522e-04_r8,4.8326e-04_r8,4.7702e-04_r8,4.6806e-04_r8,4.6482e-04_r8/) + kbo(:,35, 3) = (/ & + &3.9408e-04_r8,3.9282e-04_r8,3.8758e-04_r8,3.8191e-04_r8,3.7951e-04_r8/) + kbo(:,36, 3) = (/ & + &3.2090e-04_r8,3.1998e-04_r8,3.1651e-04_r8,3.1185e-04_r8,3.1064e-04_r8/) + kbo(:,37, 3) = (/ & + &2.6225e-04_r8,2.6215e-04_r8,2.6078e-04_r8,2.5651e-04_r8,2.5549e-04_r8/) + kbo(:,38, 3) = (/ & + &2.1480e-04_r8,2.1472e-04_r8,2.1476e-04_r8,2.1116e-04_r8,2.0969e-04_r8/) + kbo(:,39, 3) = (/ & + &1.7555e-04_r8,1.7537e-04_r8,1.7598e-04_r8,1.7350e-04_r8,1.7249e-04_r8/) + kbo(:,40, 3) = (/ & + &1.4506e-04_r8,1.4338e-04_r8,1.4427e-04_r8,1.4359e-04_r8,1.4195e-04_r8/) + kbo(:,41, 3) = (/ & + &1.1753e-04_r8,1.1789e-04_r8,1.1842e-04_r8,1.1899e-04_r8,1.1706e-04_r8/) + kbo(:,42, 3) = (/ & + &9.4811e-05_r8,9.6651e-05_r8,9.6909e-05_r8,9.7780e-05_r8,9.6573e-05_r8/) + kbo(:,43, 3) = (/ & + &7.5161e-05_r8,7.9489e-05_r8,7.9256e-05_r8,8.0096e-05_r8,8.0065e-05_r8/) + kbo(:,44, 3) = (/ & + &5.8204e-05_r8,6.3635e-05_r8,6.5251e-05_r8,6.5174e-05_r8,6.6162e-05_r8/) + kbo(:,45, 3) = (/ & + &4.3809e-05_r8,5.0393e-05_r8,5.3351e-05_r8,5.3552e-05_r8,5.3892e-05_r8/) + kbo(:,46, 3) = (/ & + &3.2980e-05_r8,3.7988e-05_r8,4.2459e-05_r8,4.3951e-05_r8,4.3847e-05_r8/) + kbo(:,47, 3) = (/ & + &2.7646e-05_r8,2.8723e-05_r8,3.2811e-05_r8,3.5391e-05_r8,3.6137e-05_r8/) + kbo(:,48, 3) = (/ & + &2.4543e-05_r8,2.1924e-05_r8,2.4598e-05_r8,2.7741e-05_r8,2.9339e-05_r8/) + kbo(:,49, 3) = (/ & + &2.2466e-05_r8,1.9218e-05_r8,1.8251e-05_r8,2.0876e-05_r8,2.3032e-05_r8/) + kbo(:,50, 3) = (/ & + &2.1181e-05_r8,1.7247e-05_r8,1.5253e-05_r8,1.5927e-05_r8,1.7960e-05_r8/) + kbo(:,51, 3) = (/ & + &2.0829e-05_r8,1.5682e-05_r8,1.3335e-05_r8,1.2152e-05_r8,1.3683e-05_r8/) + kbo(:,52, 3) = (/ & + &2.0195e-05_r8,1.5008e-05_r8,1.2032e-05_r8,1.0543e-05_r8,1.0211e-05_r8/) + kbo(:,53, 3) = (/ & + &1.9323e-05_r8,1.4642e-05_r8,1.1065e-05_r8,9.3359e-06_r8,8.4701e-06_r8/) + kbo(:,54, 3) = (/ & + &1.7666e-05_r8,1.4231e-05_r8,1.0596e-05_r8,8.3241e-06_r8,7.3928e-06_r8/) + kbo(:,55, 3) = (/ & + &1.5462e-05_r8,1.3265e-05_r8,1.0248e-05_r8,7.8075e-06_r8,6.5230e-06_r8/) + kbo(:,56, 3) = (/ & + &1.3370e-05_r8,1.2106e-05_r8,9.7995e-06_r8,7.4236e-06_r8,5.8878e-06_r8/) + kbo(:,57, 3) = (/ & + &1.1515e-05_r8,1.0653e-05_r8,9.2073e-06_r8,7.1981e-06_r8,5.4819e-06_r8/) + kbo(:,58, 3) = (/ & + &1.0034e-05_r8,9.2814e-06_r8,8.4358e-06_r8,6.8772e-06_r8,5.2130e-06_r8/) + kbo(:,59, 3) = (/ & + &8.4460e-06_r8,7.8198e-06_r8,7.3452e-06_r8,6.2331e-06_r8,4.7237e-06_r8/) + kbo(:,13, 4) = (/ & + &3.3587e-02_r8,4.0386e-02_r8,4.5135e-02_r8,4.6401e-02_r8,4.5805e-02_r8/) + kbo(:,14, 4) = (/ & + &3.1030e-02_r8,3.6513e-02_r8,3.9636e-02_r8,3.9291e-02_r8,3.8805e-02_r8/) + kbo(:,15, 4) = (/ & + &2.9952e-02_r8,3.3504e-02_r8,3.3526e-02_r8,3.3527e-02_r8,3.2785e-02_r8/) + kbo(:,16, 4) = (/ & + &2.7625e-02_r8,2.8337e-02_r8,2.8532e-02_r8,2.8121e-02_r8,2.7038e-02_r8/) + kbo(:,17, 4) = (/ & + &2.3797e-02_r8,2.4231e-02_r8,2.3927e-02_r8,2.3137e-02_r8,2.2675e-02_r8/) + kbo(:,18, 4) = (/ & + &2.0364e-02_r8,2.0218e-02_r8,1.9689e-02_r8,1.9353e-02_r8,1.9321e-02_r8/) + kbo(:,19, 4) = (/ & + &1.7135e-02_r8,1.6671e-02_r8,1.6414e-02_r8,1.6325e-02_r8,1.6362e-02_r8/) + kbo(:,20, 4) = (/ & + &1.4048e-02_r8,1.3836e-02_r8,1.3650e-02_r8,1.3725e-02_r8,1.3743e-02_r8/) + kbo(:,21, 4) = (/ & + &1.1598e-02_r8,1.1451e-02_r8,1.1386e-02_r8,1.1434e-02_r8,1.1536e-02_r8/) + kbo(:,22, 4) = (/ & + &9.5671e-03_r8,9.4431e-03_r8,9.4962e-03_r8,9.5565e-03_r8,9.6638e-03_r8/) + kbo(:,23, 4) = (/ & + &7.8733e-03_r8,7.8272e-03_r8,7.8608e-03_r8,8.0045e-03_r8,8.0429e-03_r8/) + kbo(:,24, 4) = (/ & + &6.4854e-03_r8,6.5239e-03_r8,6.5932e-03_r8,6.6847e-03_r8,6.6897e-03_r8/) + kbo(:,25, 4) = (/ & + &5.3475e-03_r8,5.3959e-03_r8,5.5055e-03_r8,5.5513e-03_r8,5.5516e-03_r8/) + kbo(:,26, 4) = (/ & + &4.4370e-03_r8,4.4984e-03_r8,4.5821e-03_r8,4.5978e-03_r8,4.6194e-03_r8/) + kbo(:,27, 4) = (/ & + &3.6654e-03_r8,3.7378e-03_r8,3.7830e-03_r8,3.7897e-03_r8,3.8209e-03_r8/) + kbo(:,28, 4) = (/ & + &3.0135e-03_r8,3.0852e-03_r8,3.1155e-03_r8,3.1198e-03_r8,3.1538e-03_r8/) + kbo(:,29, 4) = (/ & + &2.4690e-03_r8,2.5299e-03_r8,2.5457e-03_r8,2.5581e-03_r8,2.5884e-03_r8/) + kbo(:,30, 4) = (/ & + &2.0282e-03_r8,2.0645e-03_r8,2.0716e-03_r8,2.0943e-03_r8,2.1183e-03_r8/) + kbo(:,31, 4) = (/ & + &1.6532e-03_r8,1.6753e-03_r8,1.6810e-03_r8,1.7064e-03_r8,1.7271e-03_r8/) + kbo(:,32, 4) = (/ & + &1.3440e-03_r8,1.3610e-03_r8,1.3688e-03_r8,1.3929e-03_r8,1.4080e-03_r8/) + kbo(:,33, 4) = (/ & + &1.0937e-03_r8,1.1058e-03_r8,1.1183e-03_r8,1.1384e-03_r8,1.1495e-03_r8/) + kbo(:,34, 4) = (/ & + &8.9328e-04_r8,9.0340e-04_r8,9.1730e-04_r8,9.3209e-04_r8,9.4284e-04_r8/) + kbo(:,35, 4) = (/ & + &7.2895e-04_r8,7.3894e-04_r8,7.5120e-04_r8,7.6322e-04_r8,7.7389e-04_r8/) + kbo(:,36, 4) = (/ & + &5.9465e-04_r8,6.0388e-04_r8,6.1360e-04_r8,6.2477e-04_r8,6.3446e-04_r8/) + kbo(:,37, 4) = (/ & + &4.8509e-04_r8,4.9426e-04_r8,5.0234e-04_r8,5.1316e-04_r8,5.2248e-04_r8/) + kbo(:,38, 4) = (/ & + &3.9518e-04_r8,4.0486e-04_r8,4.1118e-04_r8,4.2126e-04_r8,4.3035e-04_r8/) + kbo(:,39, 4) = (/ & + &3.2206e-04_r8,3.3126e-04_r8,3.3692e-04_r8,3.4570e-04_r8,3.5386e-04_r8/) + kbo(:,40, 4) = (/ & + &2.6189e-04_r8,2.7140e-04_r8,2.7744e-04_r8,2.8454e-04_r8,2.9309e-04_r8/) + kbo(:,41, 4) = (/ & + &2.1513e-04_r8,2.2151e-04_r8,2.2843e-04_r8,2.3405e-04_r8,2.4235e-04_r8/) + kbo(:,42, 4) = (/ & + &1.7598e-04_r8,1.8130e-04_r8,1.8775e-04_r8,1.9283e-04_r8,2.0002e-04_r8/) + kbo(:,43, 4) = (/ & + &1.4391e-04_r8,1.4742e-04_r8,1.5366e-04_r8,1.5883e-04_r8,1.6416e-04_r8/) + kbo(:,44, 4) = (/ & + &1.1869e-04_r8,1.2058e-04_r8,1.2494e-04_r8,1.3042e-04_r8,1.3475e-04_r8/) + kbo(:,45, 4) = (/ & + &9.8053e-05_r8,9.8247e-05_r8,1.0155e-04_r8,1.0624e-04_r8,1.1079e-04_r8/) + kbo(:,46, 4) = (/ & + &8.0733e-05_r8,8.0988e-05_r8,8.2961e-05_r8,8.6570e-05_r8,9.0733e-05_r8/) + kbo(:,47, 4) = (/ & + &6.6646e-05_r8,6.6793e-05_r8,6.7614e-05_r8,7.0248e-05_r8,7.3658e-05_r8/) + kbo(:,48, 4) = (/ & + &5.5124e-05_r8,5.5074e-05_r8,5.5667e-05_r8,5.7150e-05_r8,5.9800e-05_r8/) + kbo(:,49, 4) = (/ & + &4.4694e-05_r8,4.5221e-05_r8,4.5769e-05_r8,4.6677e-05_r8,4.8625e-05_r8/) + kbo(:,50, 4) = (/ & + &3.5617e-05_r8,3.7343e-05_r8,3.7522e-05_r8,3.8384e-05_r8,3.9484e-05_r8/) + kbo(:,51, 4) = (/ & + &2.7917e-05_r8,3.0153e-05_r8,3.0833e-05_r8,3.1535e-05_r8,3.2403e-05_r8/) + kbo(:,52, 4) = (/ & + &2.1904e-05_r8,2.3837e-05_r8,2.5410e-05_r8,2.5925e-05_r8,2.6605e-05_r8/) + kbo(:,53, 4) = (/ & + &1.6636e-05_r8,1.9086e-05_r8,2.0539e-05_r8,2.1236e-05_r8,2.1831e-05_r8/) + kbo(:,54, 4) = (/ & + &1.2490e-05_r8,1.4743e-05_r8,1.6336e-05_r8,1.7546e-05_r8,1.7865e-05_r8/) + kbo(:,55, 4) = (/ & + &1.0189e-05_r8,1.1568e-05_r8,1.3196e-05_r8,1.4286e-05_r8,1.4740e-05_r8/) + kbo(:,56, 4) = (/ & + &9.0688e-06_r8,8.6690e-06_r8,1.0255e-05_r8,1.1493e-05_r8,1.2371e-05_r8/) + kbo(:,57, 4) = (/ & + &8.8593e-06_r8,6.9758e-06_r8,8.0033e-06_r8,9.3145e-06_r8,1.0058e-05_r8/) + kbo(:,58, 4) = (/ & + &8.9813e-06_r8,6.2718e-06_r8,5.9506e-06_r8,7.1169e-06_r8,8.0866e-06_r8/) + kbo(:,59, 4) = (/ & + &8.3077e-06_r8,5.6478e-06_r8,4.7582e-06_r8,5.5908e-06_r8,6.6051e-06_r8/) + kbo(:,13, 5) = (/ & + &8.1443e-02_r8,7.8686e-02_r8,7.8076e-02_r8,7.8298e-02_r8,8.0221e-02_r8/) + kbo(:,14, 5) = (/ & + &6.8138e-02_r8,6.7426e-02_r8,6.7266e-02_r8,6.8778e-02_r8,7.0029e-02_r8/) + kbo(:,15, 5) = (/ & + &5.7566e-02_r8,5.8181e-02_r8,6.0037e-02_r8,6.1077e-02_r8,6.2170e-02_r8/) + kbo(:,16, 5) = (/ & + &4.9602e-02_r8,5.1862e-02_r8,5.2830e-02_r8,5.3796e-02_r8,5.4837e-02_r8/) + kbo(:,17, 5) = (/ & + &4.4316e-02_r8,4.5504e-02_r8,4.6554e-02_r8,4.7427e-02_r8,4.7730e-02_r8/) + kbo(:,18, 5) = (/ & + &3.9127e-02_r8,4.0270e-02_r8,4.1019e-02_r8,4.1264e-02_r8,4.1372e-02_r8/) + kbo(:,19, 5) = (/ & + &3.4464e-02_r8,3.5381e-02_r8,3.5731e-02_r8,3.5860e-02_r8,3.6031e-02_r8/) + kbo(:,20, 5) = (/ & + &2.9866e-02_r8,3.0433e-02_r8,3.0697e-02_r8,3.0719e-02_r8,3.0767e-02_r8/) + kbo(:,21, 5) = (/ & + &2.5526e-02_r8,2.5898e-02_r8,2.6044e-02_r8,2.5989e-02_r8,2.5913e-02_r8/) + kbo(:,22, 5) = (/ & + &2.1617e-02_r8,2.1821e-02_r8,2.1825e-02_r8,2.1764e-02_r8,2.1636e-02_r8/) + kbo(:,23, 5) = (/ & + &1.8178e-02_r8,1.8256e-02_r8,1.8221e-02_r8,1.8126e-02_r8,1.8025e-02_r8/) + kbo(:,24, 5) = (/ & + &1.5221e-02_r8,1.5229e-02_r8,1.5185e-02_r8,1.5079e-02_r8,1.4988e-02_r8/) + kbo(:,25, 5) = (/ & + &1.2672e-02_r8,1.2670e-02_r8,1.2609e-02_r8,1.2518e-02_r8,1.2439e-02_r8/) + kbo(:,26, 5) = (/ & + &1.0521e-02_r8,1.0503e-02_r8,1.0444e-02_r8,1.0375e-02_r8,1.0305e-02_r8/) + kbo(:,27, 5) = (/ & + &8.6769e-03_r8,8.6518e-03_r8,8.6102e-03_r8,8.5574e-03_r8,8.4970e-03_r8/) + kbo(:,28, 5) = (/ & + &7.1348e-03_r8,7.1122e-03_r8,7.0812e-03_r8,7.0380e-03_r8,6.9899e-03_r8/) + kbo(:,29, 5) = (/ & + &5.8206e-03_r8,5.8023e-03_r8,5.7788e-03_r8,5.7535e-03_r8,5.7174e-03_r8/) + kbo(:,30, 5) = (/ & + &4.7381e-03_r8,4.7263e-03_r8,4.7093e-03_r8,4.6856e-03_r8,4.6651e-03_r8/) + kbo(:,31, 5) = (/ & + &3.8310e-03_r8,3.8249e-03_r8,3.8179e-03_r8,3.8007e-03_r8,3.7880e-03_r8/) + kbo(:,32, 5) = (/ & + &3.1058e-03_r8,3.1004e-03_r8,3.0969e-03_r8,3.0876e-03_r8,3.0842e-03_r8/) + kbo(:,33, 5) = (/ & + &2.5170e-03_r8,2.5165e-03_r8,2.5146e-03_r8,2.5120e-03_r8,2.5162e-03_r8/) + kbo(:,34, 5) = (/ & + &2.0509e-03_r8,2.0525e-03_r8,2.0528e-03_r8,2.0549e-03_r8,2.0638e-03_r8/) + kbo(:,35, 5) = (/ & + &1.6738e-03_r8,1.6767e-03_r8,1.6787e-03_r8,1.6855e-03_r8,1.6962e-03_r8/) + kbo(:,36, 5) = (/ & + &1.3688e-03_r8,1.3726e-03_r8,1.3769e-03_r8,1.3854e-03_r8,1.3974e-03_r8/) + kbo(:,37, 5) = (/ & + &1.1244e-03_r8,1.1287e-03_r8,1.1344e-03_r8,1.1436e-03_r8,1.1555e-03_r8/) + kbo(:,38, 5) = (/ & + &9.2354e-04_r8,9.2789e-04_r8,9.3393e-04_r8,9.4440e-04_r8,9.5553e-04_r8/) + kbo(:,39, 5) = (/ & + &7.5825e-04_r8,7.6213e-04_r8,7.6943e-04_r8,7.7957e-04_r8,7.9082e-04_r8/) + kbo(:,40, 5) = (/ & + &6.2483e-04_r8,6.2933e-04_r8,6.3674e-04_r8,6.4631e-04_r8,6.5698e-04_r8/) + kbo(:,41, 5) = (/ & + &5.1520e-04_r8,5.2035e-04_r8,5.2751e-04_r8,5.3662e-04_r8,5.4646e-04_r8/) + kbo(:,42, 5) = (/ & + &4.2480e-04_r8,4.3031e-04_r8,4.3691e-04_r8,4.4575e-04_r8,4.5526e-04_r8/) + kbo(:,43, 5) = (/ & + &3.5001e-04_r8,3.5557e-04_r8,3.6220e-04_r8,3.7053e-04_r8,3.7981e-04_r8/) + kbo(:,44, 5) = (/ & + &2.8750e-04_r8,2.9363e-04_r8,3.0042e-04_r8,3.0784e-04_r8,3.1671e-04_r8/) + kbo(:,45, 5) = (/ & + &2.3558e-04_r8,2.4233e-04_r8,2.4882e-04_r8,2.5588e-04_r8,2.6409e-04_r8/) + kbo(:,46, 5) = (/ & + &1.9252e-04_r8,1.9920e-04_r8,2.0547e-04_r8,2.1209e-04_r8,2.1984e-04_r8/) + kbo(:,47, 5) = (/ & + &1.5646e-04_r8,1.6321e-04_r8,1.6931e-04_r8,1.7555e-04_r8,1.8250e-04_r8/) + kbo(:,48, 5) = (/ & + &1.2570e-04_r8,1.3295e-04_r8,1.3900e-04_r8,1.4479e-04_r8,1.5118e-04_r8/) + kbo(:,49, 5) = (/ & + &1.0046e-04_r8,1.0778e-04_r8,1.1356e-04_r8,1.1908e-04_r8,1.2499e-04_r8/) + kbo(:,50, 5) = (/ & + &8.0435e-05_r8,8.6489e-05_r8,9.2769e-05_r8,9.7911e-05_r8,1.0325e-04_r8/) + kbo(:,51, 5) = (/ & + &6.3458e-05_r8,6.9460e-05_r8,7.5498e-05_r8,8.0303e-05_r8,8.5194e-05_r8/) + kbo(:,52, 5) = (/ & + &4.9865e-05_r8,5.5730e-05_r8,6.0501e-05_r8,6.5586e-05_r8,7.0113e-05_r8/) + kbo(:,53, 5) = (/ & + &3.9952e-05_r8,4.3532e-05_r8,4.8481e-05_r8,5.3147e-05_r8,5.7399e-05_r8/) + kbo(:,54, 5) = (/ & + &3.2880e-05_r8,3.4587e-05_r8,3.8794e-05_r8,4.2722e-05_r8,4.7074e-05_r8/) + kbo(:,55, 5) = (/ & + &2.7120e-05_r8,2.7717e-05_r8,3.0553e-05_r8,3.4428e-05_r8,3.8350e-05_r8/) + kbo(:,56, 5) = (/ & + &2.2127e-05_r8,2.2850e-05_r8,2.4431e-05_r8,2.7545e-05_r8,3.0669e-05_r8/) + kbo(:,57, 5) = (/ & + &1.8252e-05_r8,1.8866e-05_r8,1.9461e-05_r8,2.1577e-05_r8,2.4721e-05_r8/) + kbo(:,58, 5) = (/ & + &1.4337e-05_r8,1.5384e-05_r8,1.6084e-05_r8,1.7424e-05_r8,1.9750e-05_r8/) + kbo(:,59, 5) = (/ & + &1.1278e-05_r8,1.2651e-05_r8,1.3368e-05_r8,1.4398e-05_r8,1.6235e-05_r8/) + kbo(:,13, 6) = (/ & + &1.8817e-01_r8,1.9206e-01_r8,1.9341e-01_r8,1.9316e-01_r8,1.9216e-01_r8/) + kbo(:,14, 6) = (/ & + &1.5839e-01_r8,1.6013e-01_r8,1.6098e-01_r8,1.6083e-01_r8,1.6026e-01_r8/) + kbo(:,15, 6) = (/ & + &1.3908e-01_r8,1.4022e-01_r8,1.4029e-01_r8,1.3949e-01_r8,1.3862e-01_r8/) + kbo(:,16, 6) = (/ & + &1.2016e-01_r8,1.2041e-01_r8,1.1995e-01_r8,1.1931e-01_r8,1.1861e-01_r8/) + kbo(:,17, 6) = (/ & + &1.0302e-01_r8,1.0297e-01_r8,1.0263e-01_r8,1.0230e-01_r8,1.0181e-01_r8/) + kbo(:,18, 6) = (/ & + &8.8231e-02_r8,8.8161e-02_r8,8.7913e-02_r8,8.7602e-02_r8,8.7188e-02_r8/) + kbo(:,19, 6) = (/ & + &7.6358e-02_r8,7.6259e-02_r8,7.5975e-02_r8,7.5746e-02_r8,7.5236e-02_r8/) + kbo(:,20, 6) = (/ & + &6.5716e-02_r8,6.5541e-02_r8,6.5322e-02_r8,6.5232e-02_r8,6.4993e-02_r8/) + kbo(:,21, 6) = (/ & + &5.5986e-02_r8,5.5897e-02_r8,5.5927e-02_r8,5.6065e-02_r8,5.6062e-02_r8/) + kbo(:,22, 6) = (/ & + &4.7367e-02_r8,4.7462e-02_r8,4.7736e-02_r8,4.7820e-02_r8,4.7753e-02_r8/) + kbo(:,23, 6) = (/ & + &4.0099e-02_r8,4.0361e-02_r8,4.0481e-02_r8,4.0442e-02_r8,4.0254e-02_r8/) + kbo(:,24, 6) = (/ & + &3.3998e-02_r8,3.4135e-02_r8,3.4123e-02_r8,3.4025e-02_r8,3.3829e-02_r8/) + kbo(:,25, 6) = (/ & + &2.8658e-02_r8,2.8658e-02_r8,2.8582e-02_r8,2.8475e-02_r8,2.8305e-02_r8/) + kbo(:,26, 6) = (/ & + &2.3955e-02_r8,2.3909e-02_r8,2.3836e-02_r8,2.3748e-02_r8,2.3606e-02_r8/) + kbo(:,27, 6) = (/ & + &1.9889e-02_r8,1.9852e-02_r8,1.9780e-02_r8,1.9709e-02_r8,1.9615e-02_r8/) + kbo(:,28, 6) = (/ & + &1.6444e-02_r8,1.6406e-02_r8,1.6372e-02_r8,1.6318e-02_r8,1.6245e-02_r8/) + kbo(:,29, 6) = (/ & + &1.3491e-02_r8,1.3473e-02_r8,1.3456e-02_r8,1.3404e-02_r8,1.3356e-02_r8/) + kbo(:,30, 6) = (/ & + &1.1049e-02_r8,1.1039e-02_r8,1.1036e-02_r8,1.1011e-02_r8,1.0973e-02_r8/) + kbo(:,31, 6) = (/ & + &9.0143e-03_r8,9.0192e-03_r8,9.0194e-03_r8,9.0134e-03_r8,9.0031e-03_r8/) + kbo(:,32, 6) = (/ & + &7.3665e-03_r8,7.3853e-03_r8,7.3885e-03_r8,7.3955e-03_r8,7.4067e-03_r8/) + kbo(:,33, 6) = (/ & + &6.0271e-03_r8,6.0462e-03_r8,6.0622e-03_r8,6.0836e-03_r8,6.1045e-03_r8/) + kbo(:,34, 6) = (/ & + &4.9546e-03_r8,4.9811e-03_r8,5.0047e-03_r8,5.0339e-03_r8,5.0627e-03_r8/) + kbo(:,35, 6) = (/ & + &4.0822e-03_r8,4.1121e-03_r8,4.1424e-03_r8,4.1730e-03_r8,4.2061e-03_r8/) + kbo(:,36, 6) = (/ & + &3.3681e-03_r8,3.3993e-03_r8,3.4334e-03_r8,3.4635e-03_r8,3.4987e-03_r8/) + kbo(:,37, 6) = (/ & + &2.7875e-03_r8,2.8195e-03_r8,2.8505e-03_r8,2.8836e-03_r8,2.9180e-03_r8/) + kbo(:,38, 6) = (/ & + &2.3080e-03_r8,2.3382e-03_r8,2.3688e-03_r8,2.3992e-03_r8,2.4337e-03_r8/) + kbo(:,39, 6) = (/ & + &1.9086e-03_r8,1.9391e-03_r8,1.9678e-03_r8,1.9967e-03_r8,2.0294e-03_r8/) + kbo(:,40, 6) = (/ & + &1.5841e-03_r8,1.6128e-03_r8,1.6390e-03_r8,1.6667e-03_r8,1.6980e-03_r8/) + kbo(:,41, 6) = (/ & + &1.3139e-03_r8,1.3408e-03_r8,1.3651e-03_r8,1.3913e-03_r8,1.4213e-03_r8/) + kbo(:,42, 6) = (/ & + &1.0897e-03_r8,1.1135e-03_r8,1.1369e-03_r8,1.1616e-03_r8,1.1887e-03_r8/) + kbo(:,43, 6) = (/ & + &9.0311e-04_r8,9.2481e-04_r8,9.4572e-04_r8,9.6914e-04_r8,9.9399e-04_r8/) + kbo(:,44, 6) = (/ & + &7.4776e-04_r8,7.6718e-04_r8,7.8637e-04_r8,8.0787e-04_r8,8.3044e-04_r8/) + kbo(:,45, 6) = (/ & + &6.1863e-04_r8,6.3626e-04_r8,6.5392e-04_r8,6.7285e-04_r8,6.9425e-04_r8/) + kbo(:,46, 6) = (/ & + &5.1188e-04_r8,5.2759e-04_r8,5.4354e-04_r8,5.6054e-04_r8,5.8050e-04_r8/) + kbo(:,47, 6) = (/ & + &4.2255e-04_r8,4.3715e-04_r8,4.5173e-04_r8,4.6695e-04_r8,4.8462e-04_r8/) + kbo(:,48, 6) = (/ & + &3.4819e-04_r8,3.6156e-04_r8,3.7458e-04_r8,3.8864e-04_r8,4.0475e-04_r8/) + kbo(:,49, 6) = (/ & + &2.8602e-04_r8,2.9814e-04_r8,3.1015e-04_r8,3.2283e-04_r8,3.3769e-04_r8/) + kbo(:,50, 6) = (/ & + &2.3475e-04_r8,2.4603e-04_r8,2.5676e-04_r8,2.6851e-04_r8,2.8207e-04_r8/) + kbo(:,51, 6) = (/ & + &1.9267e-04_r8,2.0293e-04_r8,2.1257e-04_r8,2.2327e-04_r8,2.3584e-04_r8/) + kbo(:,52, 6) = (/ & + &1.5736e-04_r8,1.6664e-04_r8,1.7558e-04_r8,1.8519e-04_r8,1.9650e-04_r8/) + kbo(:,53, 6) = (/ & + &1.2741e-04_r8,1.3627e-04_r8,1.4450e-04_r8,1.5309e-04_r8,1.6331e-04_r8/) + kbo(:,54, 6) = (/ & + &1.0368e-04_r8,1.1186e-04_r8,1.1942e-04_r8,1.2720e-04_r8,1.3642e-04_r8/) + kbo(:,55, 6) = (/ & + &8.4018e-05_r8,9.1900e-05_r8,9.8814e-05_r8,1.0595e-04_r8,1.1419e-04_r8/) + kbo(:,56, 6) = (/ & + &6.7644e-05_r8,7.5107e-05_r8,8.1537e-05_r8,8.8130e-05_r8,9.5553e-05_r8/) + kbo(:,57, 6) = (/ & + &5.3052e-05_r8,6.0800e-05_r8,6.7049e-05_r8,7.3153e-05_r8,7.9865e-05_r8/) + kbo(:,58, 6) = (/ & + &4.1297e-05_r8,4.9020e-05_r8,5.4922e-05_r8,6.0589e-05_r8,6.6753e-05_r8/) + kbo(:,59, 6) = (/ & + &3.4006e-05_r8,4.0647e-05_r8,4.6127e-05_r8,5.1418e-05_r8,5.7293e-05_r8/) + kbo(:,13, 7) = (/ & + &5.2204e-01_r8,5.1758e-01_r8,5.1182e-01_r8,5.0530e-01_r8,4.9787e-01_r8/) + kbo(:,14, 7) = (/ & + &4.3225e-01_r8,4.2797e-01_r8,4.2283e-01_r8,4.1695e-01_r8,4.1054e-01_r8/) + kbo(:,15, 7) = (/ & + &3.5438e-01_r8,3.5034e-01_r8,3.4544e-01_r8,3.4060e-01_r8,3.3555e-01_r8/) + kbo(:,16, 7) = (/ & + &3.0255e-01_r8,2.9825e-01_r8,2.9421e-01_r8,2.8975e-01_r8,2.8561e-01_r8/) + kbo(:,17, 7) = (/ & + &2.5944e-01_r8,2.5596e-01_r8,2.5201e-01_r8,2.4828e-01_r8,2.4466e-01_r8/) + kbo(:,18, 7) = (/ & + &2.2110e-01_r8,2.1760e-01_r8,2.1435e-01_r8,2.1143e-01_r8,2.0904e-01_r8/) + kbo(:,19, 7) = (/ & + &1.8864e-01_r8,1.8589e-01_r8,1.8343e-01_r8,1.8143e-01_r8,1.7990e-01_r8/) + kbo(:,20, 7) = (/ & + &1.6121e-01_r8,1.5932e-01_r8,1.5784e-01_r8,1.5634e-01_r8,1.5506e-01_r8/) + kbo(:,21, 7) = (/ & + &1.3878e-01_r8,1.3751e-01_r8,1.3632e-01_r8,1.3482e-01_r8,1.3362e-01_r8/) + kbo(:,22, 7) = (/ & + &1.1962e-01_r8,1.1845e-01_r8,1.1744e-01_r8,1.1632e-01_r8,1.1539e-01_r8/) + kbo(:,23, 7) = (/ & + &1.0245e-01_r8,1.0173e-01_r8,1.0097e-01_r8,1.0038e-01_r8,9.9933e-02_r8/) + kbo(:,24, 7) = (/ & + &8.7666e-02_r8,8.7158e-02_r8,8.6968e-02_r8,8.6971e-02_r8,8.7255e-02_r8/) + kbo(:,25, 7) = (/ & + &7.4640e-02_r8,7.4734e-02_r8,7.5053e-02_r8,7.5269e-02_r8,7.5390e-02_r8/) + kbo(:,26, 7) = (/ & + &6.3735e-02_r8,6.4061e-02_r8,6.4333e-02_r8,6.4421e-02_r8,6.4368e-02_r8/) + kbo(:,27, 7) = (/ & + &5.4126e-02_r8,5.4429e-02_r8,5.4564e-02_r8,5.4521e-02_r8,5.4525e-02_r8/) + kbo(:,28, 7) = (/ & + &4.5724e-02_r8,4.5897e-02_r8,4.5948e-02_r8,4.5981e-02_r8,4.6016e-02_r8/) + kbo(:,29, 7) = (/ & + &3.8172e-02_r8,3.8308e-02_r8,3.8382e-02_r8,3.8489e-02_r8,3.8585e-02_r8/) + kbo(:,30, 7) = (/ & + &3.1718e-02_r8,3.1883e-02_r8,3.2020e-02_r8,3.2173e-02_r8,3.2316e-02_r8/) + kbo(:,31, 7) = (/ & + &2.6252e-02_r8,2.6436e-02_r8,2.6597e-02_r8,2.6780e-02_r8,2.6950e-02_r8/) + kbo(:,32, 7) = (/ & + &2.1754e-02_r8,2.1941e-02_r8,2.2153e-02_r8,2.2326e-02_r8,2.2517e-02_r8/) + kbo(:,33, 7) = (/ & + &1.8085e-02_r8,1.8277e-02_r8,1.8461e-02_r8,1.8652e-02_r8,1.8849e-02_r8/) + kbo(:,34, 7) = (/ & + &1.5122e-02_r8,1.5298e-02_r8,1.5478e-02_r8,1.5652e-02_r8,1.5844e-02_r8/) + kbo(:,35, 7) = (/ & + &1.2625e-02_r8,1.2802e-02_r8,1.2974e-02_r8,1.3152e-02_r8,1.3333e-02_r8/) + kbo(:,36, 7) = (/ & + &1.0557e-02_r8,1.0724e-02_r8,1.0878e-02_r8,1.1051e-02_r8,1.1225e-02_r8/) + kbo(:,37, 7) = (/ & + &8.8496e-03_r8,9.0081e-03_r8,9.1627e-03_r8,9.3269e-03_r8,9.4871e-03_r8/) + kbo(:,38, 7) = (/ & + &7.4071e-03_r8,7.5543e-03_r8,7.6993e-03_r8,7.8541e-03_r8,8.0170e-03_r8/) + kbo(:,39, 7) = (/ & + &6.1854e-03_r8,6.3247e-03_r8,6.4677e-03_r8,6.6094e-03_r8,6.7526e-03_r8/) + kbo(:,40, 7) = (/ & + &5.1922e-03_r8,5.3234e-03_r8,5.4554e-03_r8,5.5916e-03_r8,5.7266e-03_r8/) + kbo(:,41, 7) = (/ & + &4.3585e-03_r8,4.4819e-03_r8,4.6086e-03_r8,4.7343e-03_r8,4.8561e-03_r8/) + kbo(:,42, 7) = (/ & + &3.6533e-03_r8,3.7711e-03_r8,3.8861e-03_r8,3.9990e-03_r8,4.1168e-03_r8/) + kbo(:,43, 7) = (/ & + &3.0584e-03_r8,3.1667e-03_r8,3.2727e-03_r8,3.3777e-03_r8,3.4881e-03_r8/) + kbo(:,44, 7) = (/ & + &2.5534e-03_r8,2.6526e-03_r8,2.7492e-03_r8,2.8491e-03_r8,2.9548e-03_r8/) + kbo(:,45, 7) = (/ & + &2.1284e-03_r8,2.2160e-03_r8,2.3074e-03_r8,2.3986e-03_r8,2.4950e-03_r8/) + kbo(:,46, 7) = (/ & + &1.7695e-03_r8,1.8482e-03_r8,1.9316e-03_r8,2.0146e-03_r8,2.1010e-03_r8/) + kbo(:,47, 7) = (/ & + &1.4673e-03_r8,1.5398e-03_r8,1.6138e-03_r8,1.6894e-03_r8,1.7692e-03_r8/) + kbo(:,48, 7) = (/ & + &1.2142e-03_r8,1.2798e-03_r8,1.3450e-03_r8,1.4129e-03_r8,1.4833e-03_r8/) + kbo(:,49, 7) = (/ & + &1.0007e-03_r8,1.0578e-03_r8,1.1143e-03_r8,1.1757e-03_r8,1.2387e-03_r8/) + kbo(:,50, 7) = (/ & + &8.2795e-04_r8,8.7794e-04_r8,9.2798e-04_r8,9.8346e-04_r8,1.0399e-03_r8/) + kbo(:,51, 7) = (/ & + &6.8604e-04_r8,7.3011e-04_r8,7.7427e-04_r8,8.2321e-04_r8,8.7374e-04_r8/) + kbo(:,52, 7) = (/ & + &5.6660e-04_r8,6.0603e-04_r8,6.4555e-04_r8,6.8763e-04_r8,7.3282e-04_r8/) + kbo(:,53, 7) = (/ & + &4.6575e-04_r8,5.0073e-04_r8,5.3612e-04_r8,5.7296e-04_r8,6.1258e-04_r8/) + kbo(:,54, 7) = (/ & + &3.8679e-04_r8,4.1843e-04_r8,4.5022e-04_r8,4.8415e-04_r8,5.2013e-04_r8/) + kbo(:,55, 7) = (/ & + &3.2310e-04_r8,3.5117e-04_r8,3.8038e-04_r8,4.1226e-04_r8,4.4542e-04_r8/) + kbo(:,56, 7) = (/ & + &2.6895e-04_r8,2.9441e-04_r8,3.2135e-04_r8,3.5045e-04_r8,3.8084e-04_r8/) + kbo(:,57, 7) = (/ & + &2.2346e-04_r8,2.4644e-04_r8,2.7077e-04_r8,2.9691e-04_r8,3.2529e-04_r8/) + kbo(:,58, 7) = (/ & + &1.8566e-04_r8,2.0641e-04_r8,2.2834e-04_r8,2.5256e-04_r8,2.7894e-04_r8/) + kbo(:,59, 7) = (/ & + &1.5949e-04_r8,1.7859e-04_r8,1.9903e-04_r8,2.2176e-04_r8,2.4718e-04_r8/) + kbo(:,13, 8) = (/ & + &1.7932e+00_r8,1.7598e+00_r8,1.7272e+00_r8,1.6957e+00_r8,1.6643e+00_r8/) + kbo(:,14, 8) = (/ & + &1.5024e+00_r8,1.4748e+00_r8,1.4482e+00_r8,1.4213e+00_r8,1.3943e+00_r8/) + kbo(:,15, 8) = (/ & + &1.2493e+00_r8,1.2269e+00_r8,1.2042e+00_r8,1.1821e+00_r8,1.1593e+00_r8/) + kbo(:,16, 8) = (/ & + &1.0236e+00_r8,1.0050e+00_r8,9.8683e-01_r8,9.6754e-01_r8,9.4805e-01_r8/) + kbo(:,17, 8) = (/ & + &8.3764e-01_r8,8.2167e-01_r8,8.0558e-01_r8,7.8848e-01_r8,7.7231e-01_r8/) + kbo(:,18, 8) = (/ & + &7.0049e-01_r8,6.8715e-01_r8,6.7310e-01_r8,6.5885e-01_r8,6.4482e-01_r8/) + kbo(:,19, 8) = (/ & + &6.0067e-01_r8,5.8909e-01_r8,5.7714e-01_r8,5.6481e-01_r8,5.5329e-01_r8/) + kbo(:,20, 8) = (/ & + &5.1436e-01_r8,5.0417e-01_r8,4.9351e-01_r8,4.8348e-01_r8,4.7495e-01_r8/) + kbo(:,21, 8) = (/ & + &4.3696e-01_r8,4.2847e-01_r8,4.2014e-01_r8,4.1292e-01_r8,4.0709e-01_r8/) + kbo(:,22, 8) = (/ & + &3.7052e-01_r8,3.6397e-01_r8,3.5765e-01_r8,3.5323e-01_r8,3.4919e-01_r8/) + kbo(:,23, 8) = (/ & + &3.1534e-01_r8,3.1049e-01_r8,3.0630e-01_r8,3.0316e-01_r8,3.0035e-01_r8/) + kbo(:,24, 8) = (/ & + &2.7112e-01_r8,2.6740e-01_r8,2.6459e-01_r8,2.6223e-01_r8,2.5988e-01_r8/) + kbo(:,25, 8) = (/ & + &2.3380e-01_r8,2.3133e-01_r8,2.2943e-01_r8,2.2772e-01_r8,2.2653e-01_r8/) + kbo(:,26, 8) = (/ & + &2.0236e-01_r8,2.0088e-01_r8,1.9954e-01_r8,1.9878e-01_r8,1.9870e-01_r8/) + kbo(:,27, 8) = (/ & + &1.7470e-01_r8,1.7394e-01_r8,1.7356e-01_r8,1.7393e-01_r8,1.7411e-01_r8/) + kbo(:,28, 8) = (/ & + &1.5024e-01_r8,1.5047e-01_r8,1.5098e-01_r8,1.5164e-01_r8,1.5243e-01_r8/) + kbo(:,29, 8) = (/ & + &1.2816e-01_r8,1.2887e-01_r8,1.2996e-01_r8,1.3066e-01_r8,1.3197e-01_r8/) + kbo(:,30, 8) = (/ & + &1.0887e-01_r8,1.0998e-01_r8,1.1099e-01_r8,1.1227e-01_r8,1.1365e-01_r8/) + kbo(:,31, 8) = (/ & + &9.1656e-02_r8,9.2754e-02_r8,9.3840e-02_r8,9.5163e-02_r8,9.6499e-02_r8/) + kbo(:,32, 8) = (/ & + &7.7165e-02_r8,7.8228e-02_r8,7.9327e-02_r8,8.0584e-02_r8,8.1883e-02_r8/) + kbo(:,33, 8) = (/ & + &6.4796e-02_r8,6.5863e-02_r8,6.6915e-02_r8,6.7986e-02_r8,6.9105e-02_r8/) + kbo(:,34, 8) = (/ & + &5.4901e-02_r8,5.5964e-02_r8,5.6945e-02_r8,5.8000e-02_r8,5.9045e-02_r8/) + kbo(:,35, 8) = (/ & + &4.6607e-02_r8,4.7594e-02_r8,4.8499e-02_r8,4.9452e-02_r8,5.0386e-02_r8/) + kbo(:,36, 8) = (/ & + &3.9577e-02_r8,4.0492e-02_r8,4.1341e-02_r8,4.2242e-02_r8,4.3090e-02_r8/) + kbo(:,37, 8) = (/ & + &3.3790e-02_r8,3.4662e-02_r8,3.5486e-02_r8,3.6314e-02_r8,3.7168e-02_r8/) + kbo(:,38, 8) = (/ & + &2.8754e-02_r8,2.9559e-02_r8,3.0387e-02_r8,3.1137e-02_r8,3.1929e-02_r8/) + kbo(:,39, 8) = (/ & + &2.4394e-02_r8,2.5115e-02_r8,2.5838e-02_r8,2.6544e-02_r8,2.7274e-02_r8/) + kbo(:,40, 8) = (/ & + &2.0920e-02_r8,2.1659e-02_r8,2.2398e-02_r8,2.3092e-02_r8,2.3784e-02_r8/) + kbo(:,41, 8) = (/ & + &1.7960e-02_r8,1.8686e-02_r8,1.9408e-02_r8,2.0118e-02_r8,2.0798e-02_r8/) + kbo(:,42, 8) = (/ & + &1.5382e-02_r8,1.6080e-02_r8,1.6764e-02_r8,1.7451e-02_r8,1.8100e-02_r8/) + kbo(:,43, 8) = (/ & + &1.3156e-02_r8,1.3822e-02_r8,1.4465e-02_r8,1.5132e-02_r8,1.5767e-02_r8/) + kbo(:,44, 8) = (/ & + &1.1236e-02_r8,1.1847e-02_r8,1.2471e-02_r8,1.3074e-02_r8,1.3675e-02_r8/) + kbo(:,45, 8) = (/ & + &9.5475e-03_r8,1.0122e-02_r8,1.0686e-02_r8,1.1243e-02_r8,1.1794e-02_r8/) + kbo(:,46, 8) = (/ & + &8.0771e-03_r8,8.6018e-03_r8,9.1254e-03_r8,9.6411e-03_r8,1.0156e-02_r8/) + kbo(:,47, 8) = (/ & + &6.8185e-03_r8,7.3016e-03_r8,7.7913e-03_r8,8.2730e-03_r8,8.7590e-03_r8/) + kbo(:,48, 8) = (/ & + &5.7132e-03_r8,6.1559e-03_r8,6.5990e-03_r8,7.0467e-03_r8,7.5035e-03_r8/) + kbo(:,49, 8) = (/ & + &4.7309e-03_r8,5.1282e-03_r8,5.5334e-03_r8,5.9379e-03_r8,6.3413e-03_r8/) + kbo(:,50, 8) = (/ & + &3.9545e-03_r8,4.3092e-03_r8,4.6836e-03_r8,5.0555e-03_r8,5.4339e-03_r8/) + kbo(:,51, 8) = (/ & + &3.3094e-03_r8,3.6354e-03_r8,3.9810e-03_r8,4.3245e-03_r8,4.6768e-03_r8/) + kbo(:,52, 8) = (/ & + &2.7556e-03_r8,3.0488e-03_r8,3.3581e-03_r8,3.6757e-03_r8,3.9978e-03_r8/) + kbo(:,53, 8) = (/ & + &2.2741e-03_r8,2.5328e-03_r8,2.8070e-03_r8,3.0901e-03_r8,3.3837e-03_r8/) + kbo(:,54, 8) = (/ & + &1.9244e-03_r8,2.1630e-03_r8,2.4199e-03_r8,2.6919e-03_r8,2.9670e-03_r8/) + kbo(:,55, 8) = (/ & + &1.6527e-03_r8,1.8750e-03_r8,2.1244e-03_r8,2.3895e-03_r8,2.6621e-03_r8/) + kbo(:,56, 8) = (/ & + &1.4187e-03_r8,1.6262e-03_r8,1.8617e-03_r8,2.1120e-03_r8,2.3834e-03_r8/) + kbo(:,57, 8) = (/ & + &1.2123e-03_r8,1.4102e-03_r8,1.6308e-03_r8,1.8701e-03_r8,2.1361e-03_r8/) + kbo(:,58, 8) = (/ & + &1.0428e-03_r8,1.2269e-03_r8,1.4357e-03_r8,1.6692e-03_r8,1.9342e-03_r8/) + kbo(:,59, 8) = (/ & + &9.5774e-04_r8,1.1485e-03_r8,1.3717e-03_r8,1.6313e-03_r8,1.9270e-03_r8/) + kbo(:,13, 9) = (/ & + &1.0743e+01_r8,1.0581e+01_r8,1.0416e+01_r8,1.0238e+01_r8,1.0057e+01_r8/) + kbo(:,14, 9) = (/ & + &9.3266e+00_r8,9.1890e+00_r8,9.0401e+00_r8,8.8785e+00_r8,8.7093e+00_r8/) + kbo(:,15, 9) = (/ & + &8.0329e+00_r8,7.9105e+00_r8,7.7721e+00_r8,7.6225e+00_r8,7.4769e+00_r8/) + kbo(:,16, 9) = (/ & + &6.8686e+00_r8,6.7530e+00_r8,6.6275e+00_r8,6.5036e+00_r8,6.3858e+00_r8/) + kbo(:,17, 9) = (/ & + &5.8249e+00_r8,5.7232e+00_r8,5.6209e+00_r8,5.5225e+00_r8,5.4281e+00_r8/) + kbo(:,18, 9) = (/ & + &4.8929e+00_r8,4.8094e+00_r8,4.7279e+00_r8,4.6483e+00_r8,4.5724e+00_r8/) + kbo(:,19, 9) = (/ & + &4.0706e+00_r8,4.0042e+00_r8,3.9380e+00_r8,3.8751e+00_r8,3.8145e+00_r8/) + kbo(:,20, 9) = (/ & + &3.3806e+00_r8,3.3267e+00_r8,3.2749e+00_r8,3.2247e+00_r8,3.1746e+00_r8/) + kbo(:,21, 9) = (/ & + &2.8074e+00_r8,2.7644e+00_r8,2.7235e+00_r8,2.6821e+00_r8,2.6407e+00_r8/) + kbo(:,22, 9) = (/ & + &2.3283e+00_r8,2.2955e+00_r8,2.2616e+00_r8,2.2266e+00_r8,2.1957e+00_r8/) + kbo(:,23, 9) = (/ & + &1.9321e+00_r8,1.9042e+00_r8,1.8758e+00_r8,1.8494e+00_r8,1.8261e+00_r8/) + kbo(:,24, 9) = (/ & + &1.6234e+00_r8,1.5933e+00_r8,1.5660e+00_r8,1.5420e+00_r8,1.5232e+00_r8/) + kbo(:,25, 9) = (/ & + &1.3980e+00_r8,1.3704e+00_r8,1.3436e+00_r8,1.3210e+00_r8,1.3008e+00_r8/) + kbo(:,26, 9) = (/ & + &1.2106e+00_r8,1.1883e+00_r8,1.1672e+00_r8,1.1488e+00_r8,1.1330e+00_r8/) + kbo(:,27, 9) = (/ & + &1.0466e+00_r8,1.0297e+00_r8,1.0139e+00_r8,1.0016e+00_r8,9.9022e-01_r8/) + kbo(:,28, 9) = (/ & + &9.0567e-01_r8,8.9244e-01_r8,8.8275e-01_r8,8.7361e-01_r8,8.6722e-01_r8/) + kbo(:,29, 9) = (/ & + &7.7743e-01_r8,7.6923e-01_r8,7.6234e-01_r8,7.5840e-01_r8,7.5702e-01_r8/) + kbo(:,30, 9) = (/ & + &6.6693e-01_r8,6.6196e-01_r8,6.5810e-01_r8,6.5663e-01_r8,6.5785e-01_r8/) + kbo(:,31, 9) = (/ & + &5.6777e-01_r8,5.6527e-01_r8,5.6420e-01_r8,5.6593e-01_r8,5.6662e-01_r8/) + kbo(:,32, 9) = (/ & + &4.8384e-01_r8,4.8324e-01_r8,4.8562e-01_r8,4.8803e-01_r8,4.8996e-01_r8/) + kbo(:,33, 9) = (/ & + &4.1137e-01_r8,4.1406e-01_r8,4.1751e-01_r8,4.2081e-01_r8,4.2550e-01_r8/) + kbo(:,34, 9) = (/ & + &3.5416e-01_r8,3.5806e-01_r8,3.6166e-01_r8,3.6664e-01_r8,3.7277e-01_r8/) + kbo(:,35, 9) = (/ & + &3.0554e-01_r8,3.0948e-01_r8,3.1424e-01_r8,3.1976e-01_r8,3.2676e-01_r8/) + kbo(:,36, 9) = (/ & + &2.6418e-01_r8,2.6871e-01_r8,2.7383e-01_r8,2.8027e-01_r8,2.8707e-01_r8/) + kbo(:,37, 9) = (/ & + &2.2969e-01_r8,2.3421e-01_r8,2.3975e-01_r8,2.4624e-01_r8,2.5310e-01_r8/) + kbo(:,38, 9) = (/ & + &1.9950e-01_r8,2.0421e-01_r8,2.0978e-01_r8,2.1651e-01_r8,2.2302e-01_r8/) + kbo(:,39, 9) = (/ & + &1.7282e-01_r8,1.7783e-01_r8,1.8337e-01_r8,1.9005e-01_r8,1.9644e-01_r8/) + kbo(:,40, 9) = (/ & + &1.5139e-01_r8,1.5623e-01_r8,1.6190e-01_r8,1.6820e-01_r8,1.7447e-01_r8/) + kbo(:,41, 9) = (/ & + &1.3264e-01_r8,1.3745e-01_r8,1.4301e-01_r8,1.4932e-01_r8,1.5546e-01_r8/) + kbo(:,42, 9) = (/ & + &1.1607e-01_r8,1.2085e-01_r8,1.2625e-01_r8,1.3247e-01_r8,1.3847e-01_r8/) + kbo(:,43, 9) = (/ & + &1.0129e-01_r8,1.0600e-01_r8,1.1131e-01_r8,1.1735e-01_r8,1.2314e-01_r8/) + kbo(:,44, 9) = (/ & + &8.8076e-02_r8,9.2672e-02_r8,9.7764e-02_r8,1.0358e-01_r8,1.0942e-01_r8/) + kbo(:,45, 9) = (/ & + &7.6267e-02_r8,8.0788e-02_r8,8.5604e-02_r8,9.1124e-02_r8,9.6796e-02_r8/) + kbo(:,46, 9) = (/ & + &6.5896e-02_r8,7.0073e-02_r8,7.4628e-02_r8,7.9860e-02_r8,8.5349e-02_r8/) + kbo(:,47, 9) = (/ & + &5.6947e-02_r8,6.0912e-02_r8,6.5102e-02_r8,6.9953e-02_r8,7.5324e-02_r8/) + kbo(:,48, 9) = (/ & + &4.8993e-02_r8,5.2552e-02_r8,5.6622e-02_r8,6.1050e-02_r8,6.6050e-02_r8/) + kbo(:,49, 9) = (/ & + &4.1828e-02_r8,4.5103e-02_r8,4.8726e-02_r8,5.2827e-02_r8,5.7536e-02_r8/) + kbo(:,50, 9) = (/ & + &3.6237e-02_r8,3.9173e-02_r8,4.2523e-02_r8,4.6248e-02_r8,5.0679e-02_r8/) + kbo(:,51, 9) = (/ & + &3.1483e-02_r8,3.4194e-02_r8,3.7317e-02_r8,4.0792e-02_r8,4.4937e-02_r8/) + kbo(:,52, 9) = (/ & + &2.7288e-02_r8,2.9720e-02_r8,3.2635e-02_r8,3.5833e-02_r8,3.9605e-02_r8/) + kbo(:,53, 9) = (/ & + &2.3553e-02_r8,2.5752e-02_r8,2.8298e-02_r8,3.1273e-02_r8,3.4805e-02_r8/) + kbo(:,54, 9) = (/ & + &2.0927e-02_r8,2.2955e-02_r8,2.5436e-02_r8,2.8294e-02_r8,3.1547e-02_r8/) + kbo(:,55, 9) = (/ & + &1.8850e-02_r8,2.0892e-02_r8,2.3245e-02_r8,2.6068e-02_r8,2.9259e-02_r8/) + kbo(:,56, 9) = (/ & + &1.7133e-02_r8,1.9134e-02_r8,2.1378e-02_r8,2.4152e-02_r8,2.7278e-02_r8/) + kbo(:,57, 9) = (/ & + &1.5614e-02_r8,1.7616e-02_r8,1.9861e-02_r8,2.2450e-02_r8,2.5658e-02_r8/) + kbo(:,58, 9) = (/ & + &1.4386e-02_r8,1.6367e-02_r8,1.8612e-02_r8,2.1235e-02_r8,2.4366e-02_r8/) + kbo(:,59, 9) = (/ & + &1.4750e-02_r8,1.6838e-02_r8,1.9250e-02_r8,2.2069e-02_r8,2.5653e-02_r8/) + kbo(:,13,10) = (/ & + &4.1842e+01_r8,4.1126e+01_r8,4.0474e+01_r8,3.9934e+01_r8,3.9455e+01_r8/) + kbo(:,14,10) = (/ & + &3.7817e+01_r8,3.7244e+01_r8,3.6754e+01_r8,3.6387e+01_r8,3.5986e+01_r8/) + kbo(:,15,10) = (/ & + &3.3775e+01_r8,3.3359e+01_r8,3.3057e+01_r8,3.2734e+01_r8,3.2346e+01_r8/) + kbo(:,16,10) = (/ & + &2.9866e+01_r8,2.9628e+01_r8,2.9352e+01_r8,2.8982e+01_r8,2.8500e+01_r8/) + kbo(:,17,10) = (/ & + &2.6256e+01_r8,2.6026e+01_r8,2.5674e+01_r8,2.5248e+01_r8,2.4813e+01_r8/) + kbo(:,18,10) = (/ & + &2.2845e+01_r8,2.2539e+01_r8,2.2184e+01_r8,2.1830e+01_r8,2.1506e+01_r8/) + kbo(:,19,10) = (/ & + &1.9624e+01_r8,1.9336e+01_r8,1.9054e+01_r8,1.8789e+01_r8,1.8555e+01_r8/) + kbo(:,20,10) = (/ & + &1.6714e+01_r8,1.6495e+01_r8,1.6283e+01_r8,1.6088e+01_r8,1.5920e+01_r8/) + kbo(:,21,10) = (/ & + &1.4184e+01_r8,1.4023e+01_r8,1.3853e+01_r8,1.3722e+01_r8,1.3615e+01_r8/) + kbo(:,22,10) = (/ & + &1.2010e+01_r8,1.1876e+01_r8,1.1769e+01_r8,1.1693e+01_r8,1.1608e+01_r8/) + kbo(:,23,10) = (/ & + &1.0140e+01_r8,1.0060e+01_r8,1.0004e+01_r8,9.9480e+00_r8,9.8828e+00_r8/) + kbo(:,24,10) = (/ & + &8.3529e+00_r8,8.3955e+00_r8,8.4004e+00_r8,8.3887e+00_r8,8.3750e+00_r8/) + kbo(:,25,10) = (/ & + &6.5990e+00_r8,6.6692e+00_r8,6.7250e+00_r8,6.7763e+00_r8,6.8513e+00_r8/) + kbo(:,26,10) = (/ & + &5.2218e+00_r8,5.2429e+00_r8,5.2934e+00_r8,5.3672e+00_r8,5.4447e+00_r8/) + kbo(:,27,10) = (/ & + &4.4199e+00_r8,4.3564e+00_r8,4.3290e+00_r8,4.3162e+00_r8,4.3878e+00_r8/) + kbo(:,28,10) = (/ & + &3.8059e+00_r8,3.7536e+00_r8,3.6821e+00_r8,3.6546e+00_r8,3.6556e+00_r8/) + kbo(:,29,10) = (/ & + &3.2943e+00_r8,3.2284e+00_r8,3.1752e+00_r8,3.1401e+00_r8,3.1165e+00_r8/) + kbo(:,30,10) = (/ & + &2.8426e+00_r8,2.7881e+00_r8,2.7489e+00_r8,2.7185e+00_r8,2.7182e+00_r8/) + kbo(:,31,10) = (/ & + &2.4366e+00_r8,2.4010e+00_r8,2.3877e+00_r8,2.3684e+00_r8,2.4040e+00_r8/) + kbo(:,32,10) = (/ & + &2.1031e+00_r8,2.0888e+00_r8,2.0634e+00_r8,2.0885e+00_r8,2.1581e+00_r8/) + kbo(:,33,10) = (/ & + &1.8304e+00_r8,1.8104e+00_r8,1.8138e+00_r8,1.8703e+00_r8,1.9665e+00_r8/) + kbo(:,34,10) = (/ & + &1.5963e+00_r8,1.5877e+00_r8,1.6209e+00_r8,1.6809e+00_r8,1.8060e+00_r8/) + kbo(:,35,10) = (/ & + &1.3950e+00_r8,1.4093e+00_r8,1.4535e+00_r8,1.5372e+00_r8,1.6748e+00_r8/) + kbo(:,36,10) = (/ & + &1.2291e+00_r8,1.2517e+00_r8,1.3081e+00_r8,1.4001e+00_r8,1.5466e+00_r8/) + kbo(:,37,10) = (/ & + &1.0841e+00_r8,1.1159e+00_r8,1.1678e+00_r8,1.2585e+00_r8,1.4003e+00_r8/) + kbo(:,38,10) = (/ & + &9.5502e-01_r8,9.9217e-01_r8,1.0459e+00_r8,1.1387e+00_r8,1.2834e+00_r8/) + kbo(:,39,10) = (/ & + &8.4320e-01_r8,8.8008e-01_r8,9.3921e-01_r8,1.0432e+00_r8,1.1899e+00_r8/) + kbo(:,40,10) = (/ & + &7.4742e-01_r8,7.8308e-01_r8,8.3378e-01_r8,9.2859e-01_r8,1.0715e+00_r8/) + kbo(:,41,10) = (/ & + &6.6607e-01_r8,6.9838e-01_r8,7.4378e-01_r8,8.2580e-01_r8,9.6253e-01_r8/) + kbo(:,42,10) = (/ & + &5.9399e-01_r8,6.2402e-01_r8,6.6818e-01_r8,7.3908e-01_r8,8.7040e-01_r8/) + kbo(:,43,10) = (/ & + &5.3134e-01_r8,5.5822e-01_r8,5.9679e-01_r8,6.5834e-01_r8,7.8163e-01_r8/) + kbo(:,44,10) = (/ & + &4.7483e-01_r8,4.9813e-01_r8,5.3656e-01_r8,5.8775e-01_r8,7.0057e-01_r8/) + kbo(:,45,10) = (/ & + &4.2242e-01_r8,4.4383e-01_r8,4.8053e-01_r8,5.2923e-01_r8,6.3377e-01_r8/) + kbo(:,46,10) = (/ & + &3.7426e-01_r8,3.9626e-01_r8,4.2998e-01_r8,4.7693e-01_r8,5.7307e-01_r8/) + kbo(:,47,10) = (/ & + &3.3305e-01_r8,3.5232e-01_r8,3.8380e-01_r8,4.2680e-01_r8,5.1056e-01_r8/) + kbo(:,48,10) = (/ & + &2.9118e-01_r8,3.1195e-01_r8,3.3996e-01_r8,3.8124e-01_r8,4.5847e-01_r8/) + kbo(:,49,10) = (/ & + &2.5186e-01_r8,2.7185e-01_r8,2.9957e-01_r8,3.4007e-01_r8,4.1454e-01_r8/) + kbo(:,50,10) = (/ & + &2.1978e-01_r8,2.4030e-01_r8,2.6478e-01_r8,3.0486e-01_r8,3.7227e-01_r8/) + kbo(:,51,10) = (/ & + &1.9384e-01_r8,2.1260e-01_r8,2.3536e-01_r8,2.7096e-01_r8,3.3311e-01_r8/) + kbo(:,52,10) = (/ & + &1.6918e-01_r8,1.8784e-01_r8,2.0901e-01_r8,2.4060e-01_r8,2.9976e-01_r8/) + kbo(:,53,10) = (/ & + &1.4644e-01_r8,1.6376e-01_r8,1.8425e-01_r8,2.1431e-01_r8,2.7054e-01_r8/) + kbo(:,54,10) = (/ & + &1.3139e-01_r8,1.4808e-01_r8,1.6611e-01_r8,1.9208e-01_r8,2.4005e-01_r8/) + kbo(:,55,10) = (/ & + &1.2172e-01_r8,1.3644e-01_r8,1.5558e-01_r8,1.7831e-01_r8,2.1286e-01_r8/) + kbo(:,56,10) = (/ & + &1.1074e-01_r8,1.2717e-01_r8,1.4642e-01_r8,1.6603e-01_r8,1.9730e-01_r8/) + kbo(:,57,10) = (/ & + &1.0195e-01_r8,1.1787e-01_r8,1.3707e-01_r8,1.5838e-01_r8,1.8439e-01_r8/) + kbo(:,58,10) = (/ & + &9.6243e-02_r8,1.1076e-01_r8,1.2956e-01_r8,1.5169e-01_r8,1.7652e-01_r8/) + kbo(:,59,10) = (/ & + &9.7302e-02_r8,1.1627e-01_r8,1.3740e-01_r8,1.6328e-01_r8,1.9053e-01_r8/) + kbo(:,13,11) = (/ & + &7.0360e+01_r8,6.9342e+01_r8,6.8249e+01_r8,6.7098e+01_r8,6.5980e+01_r8/) + kbo(:,14,11) = (/ & + &6.5791e+01_r8,6.4723e+01_r8,6.3625e+01_r8,6.2598e+01_r8,6.1783e+01_r8/) + kbo(:,15,11) = (/ & + &6.0426e+01_r8,5.9395e+01_r8,5.8516e+01_r8,5.7828e+01_r8,5.7219e+01_r8/) + kbo(:,16,11) = (/ & + &5.4683e+01_r8,5.3915e+01_r8,5.3328e+01_r8,5.2878e+01_r8,5.2385e+01_r8/) + kbo(:,17,11) = (/ & + &4.8953e+01_r8,4.8487e+01_r8,4.8177e+01_r8,4.7782e+01_r8,4.7308e+01_r8/) + kbo(:,18,11) = (/ & + &4.3480e+01_r8,4.3274e+01_r8,4.2982e+01_r8,4.2563e+01_r8,4.2021e+01_r8/) + kbo(:,19,11) = (/ & + &3.8401e+01_r8,3.8213e+01_r8,3.7862e+01_r8,3.7391e+01_r8,3.6879e+01_r8/) + kbo(:,20,11) = (/ & + &3.3602e+01_r8,3.3341e+01_r8,3.2960e+01_r8,3.2565e+01_r8,3.2185e+01_r8/) + kbo(:,21,11) = (/ & + &2.9094e+01_r8,2.8806e+01_r8,2.8524e+01_r8,2.8243e+01_r8,2.8023e+01_r8/) + kbo(:,22,11) = (/ & + &2.4954e+01_r8,2.4758e+01_r8,2.4575e+01_r8,2.4433e+01_r8,2.4352e+01_r8/) + kbo(:,23,11) = (/ & + &2.1326e+01_r8,2.1219e+01_r8,2.1148e+01_r8,2.1108e+01_r8,2.1117e+01_r8/) + kbo(:,24,11) = (/ & + &1.8212e+01_r8,1.8167e+01_r8,1.8172e+01_r8,1.8221e+01_r8,1.8288e+01_r8/) + kbo(:,25,11) = (/ & + &1.5541e+01_r8,1.5569e+01_r8,1.5649e+01_r8,1.5756e+01_r8,1.5867e+01_r8/) + kbo(:,26,11) = (/ & + &1.3185e+01_r8,1.3326e+01_r8,1.3479e+01_r8,1.3624e+01_r8,1.3786e+01_r8/) + kbo(:,27,11) = (/ & + &1.0920e+01_r8,1.1211e+01_r8,1.1487e+01_r8,1.1743e+01_r8,1.1957e+01_r8/) + kbo(:,28,11) = (/ & + &9.0678e+00_r8,9.3710e+00_r8,9.6834e+00_r8,9.9920e+00_r8,1.0324e+01_r8/) + kbo(:,29,11) = (/ & + &7.6881e+00_r8,7.9879e+00_r8,8.2968e+00_r8,8.6379e+00_r8,9.0061e+00_r8/) + kbo(:,30,11) = (/ & + &6.6033e+00_r8,6.8954e+00_r8,7.2204e+00_r8,7.5787e+00_r8,7.9480e+00_r8/) + kbo(:,31,11) = (/ & + &5.8224e+00_r8,6.1213e+00_r8,6.4394e+00_r8,6.7947e+00_r8,7.1839e+00_r8/) + kbo(:,32,11) = (/ & + &5.1825e+00_r8,5.4854e+00_r8,5.8203e+00_r8,6.1672e+00_r8,6.5644e+00_r8/) + kbo(:,33,11) = (/ & + &4.6793e+00_r8,4.9853e+00_r8,5.3218e+00_r8,5.6796e+00_r8,6.0723e+00_r8/) + kbo(:,34,11) = (/ & + &4.2112e+00_r8,4.5240e+00_r8,4.8672e+00_r8,5.2510e+00_r8,5.6439e+00_r8/) + kbo(:,35,11) = (/ & + &3.8061e+00_r8,4.1193e+00_r8,4.4694e+00_r8,4.8571e+00_r8,5.2645e+00_r8/) + kbo(:,36,11) = (/ & + &3.4331e+00_r8,3.7452e+00_r8,4.0978e+00_r8,4.4887e+00_r8,4.9173e+00_r8/) + kbo(:,37,11) = (/ & + &3.0586e+00_r8,3.3607e+00_r8,3.7172e+00_r8,4.1153e+00_r8,4.5572e+00_r8/) + kbo(:,38,11) = (/ & + &2.7517e+00_r8,3.0453e+00_r8,3.3976e+00_r8,3.7947e+00_r8,4.2441e+00_r8/) + kbo(:,39,11) = (/ & + &2.5013e+00_r8,2.7908e+00_r8,3.1383e+00_r8,3.5236e+00_r8,3.9765e+00_r8/) + kbo(:,40,11) = (/ & + &2.2268e+00_r8,2.5094e+00_r8,2.8534e+00_r8,3.2426e+00_r8,3.6921e+00_r8/) + kbo(:,41,11) = (/ & + &1.9832e+00_r8,2.2609e+00_r8,2.6000e+00_r8,2.9899e+00_r8,3.4337e+00_r8/) + kbo(:,42,11) = (/ & + &1.7785e+00_r8,2.0479e+00_r8,2.3793e+00_r8,2.7692e+00_r8,3.2048e+00_r8/) + kbo(:,43,11) = (/ & + &1.5856e+00_r8,1.8448e+00_r8,2.1667e+00_r8,2.5496e+00_r8,2.9735e+00_r8/) + kbo(:,44,11) = (/ & + &1.4123e+00_r8,1.6629e+00_r8,1.9679e+00_r8,2.3444e+00_r8,2.7547e+00_r8/) + kbo(:,45,11) = (/ & + &1.2640e+00_r8,1.5067e+00_r8,1.7987e+00_r8,2.1603e+00_r8,2.5558e+00_r8/) + kbo(:,46,11) = (/ & + &1.1290e+00_r8,1.3620e+00_r8,1.6422e+00_r8,1.9855e+00_r8,2.3652e+00_r8/) + kbo(:,47,11) = (/ & + &9.9161e-01_r8,1.2154e+00_r8,1.4836e+00_r8,1.8087e+00_r8,2.1736e+00_r8/) + kbo(:,48,11) = (/ & + &8.7615e-01_r8,1.0875e+00_r8,1.3440e+00_r8,1.6515e+00_r8,1.9976e+00_r8/) + kbo(:,49,11) = (/ & + &7.7782e-01_r8,9.7773e-01_r8,1.2220e+00_r8,1.5130e+00_r8,1.8356e+00_r8/) + kbo(:,50,11) = (/ & + &6.8345e-01_r8,8.7089e-01_r8,1.1065e+00_r8,1.3830e+00_r8,1.6924e+00_r8/) + kbo(:,51,11) = (/ & + &5.9562e-01_r8,7.7251e-01_r8,9.9776e-01_r8,1.2648e+00_r8,1.5621e+00_r8/) + kbo(:,52,11) = (/ & + &5.1948e-01_r8,6.8509e-01_r8,8.9806e-01_r8,1.1564e+00_r8,1.4407e+00_r8/) + kbo(:,53,11) = (/ & + &4.5430e-01_r8,6.0810e-01_r8,8.0999e-01_r8,1.0551e+00_r8,1.3256e+00_r8/) + kbo(:,54,11) = (/ & + &3.8584e-01_r8,5.2960e-01_r8,7.1926e-01_r8,9.5469e-01_r8,1.2208e+00_r8/) + kbo(:,55,11) = (/ & + &3.2585e-01_r8,4.5415e-01_r8,6.2813e-01_r8,8.5255e-01_r8,1.1189e+00_r8/) + kbo(:,56,11) = (/ & + &2.9347e-01_r8,3.8309e-01_r8,5.4571e-01_r8,7.5695e-01_r8,1.0111e+00_r8/) + kbo(:,57,11) = (/ & + &2.6872e-01_r8,3.3263e-01_r8,4.6996e-01_r8,6.6376e-01_r8,9.0688e-01_r8/) + kbo(:,58,11) = (/ & + &2.4960e-01_r8,3.0758e-01_r8,4.0207e-01_r8,5.8213e-01_r8,8.0803e-01_r8/) + kbo(:,59,11) = (/ & + &2.6183e-01_r8,3.2106e-01_r8,3.9760e-01_r8,5.1091e-01_r8,7.1717e-01_r8/) + kbo(:,13,12) = (/ & + &1.1832e+02_r8,1.1787e+02_r8,1.1696e+02_r8,1.1585e+02_r8,1.1448e+02_r8/) + kbo(:,14,12) = (/ & + &1.1787e+02_r8,1.1706e+02_r8,1.1585e+02_r8,1.1435e+02_r8,1.1282e+02_r8/) + kbo(:,15,12) = (/ & + &1.1482e+02_r8,1.1352e+02_r8,1.1198e+02_r8,1.1040e+02_r8,1.0880e+02_r8/) + kbo(:,16,12) = (/ & + &1.0896e+02_r8,1.0749e+02_r8,1.0590e+02_r8,1.0433e+02_r8,1.0304e+02_r8/) + kbo(:,17,12) = (/ & + &1.0128e+02_r8,9.9814e+01_r8,9.8422e+01_r8,9.7349e+01_r8,9.6504e+01_r8/) + kbo(:,18,12) = (/ & + &9.2677e+01_r8,9.1506e+01_r8,9.0639e+01_r8,9.0100e+01_r8,8.9682e+01_r8/) + kbo(:,19,12) = (/ & + &8.3897e+01_r8,8.3222e+01_r8,8.2911e+01_r8,8.2751e+01_r8,8.2502e+01_r8/) + kbo(:,20,12) = (/ & + &7.5342e+01_r8,7.5217e+01_r8,7.5315e+01_r8,7.5254e+01_r8,7.5130e+01_r8/) + kbo(:,21,12) = (/ & + &6.7351e+01_r8,6.7622e+01_r8,6.7745e+01_r8,6.7796e+01_r8,6.7734e+01_r8/) + kbo(:,22,12) = (/ & + &5.9964e+01_r8,6.0293e+01_r8,6.0504e+01_r8,6.0565e+01_r8,6.0581e+01_r8/) + kbo(:,23,12) = (/ & + &5.3111e+01_r8,5.3464e+01_r8,5.3681e+01_r8,5.3837e+01_r8,5.4061e+01_r8/) + kbo(:,24,12) = (/ & + &4.6795e+01_r8,4.7144e+01_r8,4.7460e+01_r8,4.7828e+01_r8,4.8279e+01_r8/) + kbo(:,25,12) = (/ & + &4.1060e+01_r8,4.1497e+01_r8,4.1989e+01_r8,4.2550e+01_r8,4.3265e+01_r8/) + kbo(:,26,12) = (/ & + &3.6007e+01_r8,3.6594e+01_r8,3.7261e+01_r8,3.8060e+01_r8,3.9005e+01_r8/) + kbo(:,27,12) = (/ & + &3.1657e+01_r8,3.2380e+01_r8,3.3234e+01_r8,3.4259e+01_r8,3.5455e+01_r8/) + kbo(:,28,12) = (/ & + &2.7936e+01_r8,2.8816e+01_r8,2.9878e+01_r8,3.1120e+01_r8,3.2499e+01_r8/) + kbo(:,29,12) = (/ & + &2.4811e+01_r8,2.5887e+01_r8,2.7138e+01_r8,2.8541e+01_r8,3.0069e+01_r8/) + kbo(:,30,12) = (/ & + &2.2271e+01_r8,2.3484e+01_r8,2.4883e+01_r8,2.6431e+01_r8,2.8119e+01_r8/) + kbo(:,31,12) = (/ & + &2.0203e+01_r8,2.1534e+01_r8,2.3058e+01_r8,2.4751e+01_r8,2.6602e+01_r8/) + kbo(:,32,12) = (/ & + &1.8534e+01_r8,1.9980e+01_r8,2.1635e+01_r8,2.3479e+01_r8,2.5477e+01_r8/) + kbo(:,33,12) = (/ & + &1.7225e+01_r8,1.8794e+01_r8,2.0572e+01_r8,2.2559e+01_r8,2.4699e+01_r8/) + kbo(:,34,12) = (/ & + &1.6174e+01_r8,1.7857e+01_r8,1.9770e+01_r8,2.1880e+01_r8,2.4147e+01_r8/) + kbo(:,35,12) = (/ & + &1.5236e+01_r8,1.7017e+01_r8,1.9034e+01_r8,2.1242e+01_r8,2.3610e+01_r8/) + kbo(:,36,12) = (/ & + &1.4322e+01_r8,1.6183e+01_r8,1.8272e+01_r8,2.0552e+01_r8,2.2984e+01_r8/) + kbo(:,37,12) = (/ & + &1.3315e+01_r8,1.5210e+01_r8,1.7331e+01_r8,1.9645e+01_r8,2.2115e+01_r8/) + kbo(:,38,12) = (/ & + &1.2427e+01_r8,1.4349e+01_r8,1.6493e+01_r8,1.8831e+01_r8,2.1326e+01_r8/) + kbo(:,39,12) = (/ & + &1.1655e+01_r8,1.3594e+01_r8,1.5756e+01_r8,1.8111e+01_r8,2.0619e+01_r8/) + kbo(:,40,12) = (/ & + &1.0800e+01_r8,1.2718e+01_r8,1.4870e+01_r8,1.7214e+01_r8,1.9711e+01_r8/) + kbo(:,41,12) = (/ & + &1.0009e+01_r8,1.1890e+01_r8,1.4023e+01_r8,1.6343e+01_r8,1.8829e+01_r8/) + kbo(:,42,12) = (/ & + &9.2911e+00_r8,1.1131e+01_r8,1.3230e+01_r8,1.5526e+01_r8,1.7990e+01_r8/) + kbo(:,43,12) = (/ & + &8.5453e+00_r8,1.0322e+01_r8,1.2366e+01_r8,1.4622e+01_r8,1.7049e+01_r8/) + kbo(:,44,12) = (/ & + &7.8249e+00_r8,9.5233e+00_r8,1.1499e+01_r8,1.3704e+01_r8,1.6085e+01_r8/) + kbo(:,45,12) = (/ & + &7.1656e+00_r8,8.7847e+00_r8,1.0682e+01_r8,1.2826e+01_r8,1.5159e+01_r8/) + kbo(:,46,12) = (/ & + &6.5222e+00_r8,8.0621e+00_r8,9.8691e+00_r8,1.1939e+01_r8,1.4215e+01_r8/) + kbo(:,47,12) = (/ & + &5.8688e+00_r8,7.3253e+00_r8,9.0292e+00_r8,1.1003e+01_r8,1.3207e+01_r8/) + kbo(:,48,12) = (/ & + &5.2686e+00_r8,6.6401e+00_r8,8.2460e+00_r8,1.0116e+01_r8,1.2240e+01_r8/) + kbo(:,49,12) = (/ & + &4.7119e+00_r8,6.0011e+00_r8,7.5181e+00_r8,9.2810e+00_r8,1.1309e+01_r8/) + kbo(:,50,12) = (/ & + &4.2243e+00_r8,5.4409e+00_r8,6.8771e+00_r8,8.5451e+00_r8,1.0476e+01_r8/) + kbo(:,51,12) = (/ & + &3.7894e+00_r8,4.9333e+00_r8,6.2908e+00_r8,7.8717e+00_r8,9.7058e+00_r8/) + kbo(:,52,12) = (/ & + &3.3915e+00_r8,4.4569e+00_r8,5.7416e+00_r8,7.2423e+00_r8,8.9799e+00_r8/) + kbo(:,53,12) = (/ & + &3.0222e+00_r8,4.0130e+00_r8,5.2245e+00_r8,6.6473e+00_r8,8.2931e+00_r8/) + kbo(:,54,12) = (/ & + &2.7077e+00_r8,3.6347e+00_r8,4.7766e+00_r8,6.1280e+00_r8,7.6968e+00_r8/) + kbo(:,55,12) = (/ & + &2.4210e+00_r8,3.2970e+00_r8,4.3697e+00_r8,5.6562e+00_r8,7.1563e+00_r8/) + kbo(:,56,12) = (/ & + &2.1307e+00_r8,2.9831e+00_r8,3.9864e+00_r8,5.2103e+00_r8,6.6404e+00_r8/) + kbo(:,57,12) = (/ & + &1.8552e+00_r8,2.6736e+00_r8,3.6295e+00_r8,4.7868e+00_r8,6.1491e+00_r8/) + kbo(:,58,12) = (/ & + &1.6050e+00_r8,2.3734e+00_r8,3.3136e+00_r8,4.4004e+00_r8,5.7055e+00_r8/) + kbo(:,59,12) = (/ & + &1.4434e+00_r8,2.1814e+00_r8,3.1118e+00_r8,4.2418e+00_r8,5.5300e+00_r8/) + kbo(:,13,13) = (/ & + &2.0665e+02_r8,2.0326e+02_r8,2.0074e+02_r8,1.9867e+02_r8,1.9680e+02_r8/) + kbo(:,14,13) = (/ & + &2.1250e+02_r8,2.0998e+02_r8,2.0827e+02_r8,2.0659e+02_r8,2.0468e+02_r8/) + kbo(:,15,13) = (/ & + &2.1695e+02_r8,2.1587e+02_r8,2.1446e+02_r8,2.1260e+02_r8,2.1056e+02_r8/) + kbo(:,16,13) = (/ & + &2.2062e+02_r8,2.1972e+02_r8,2.1811e+02_r8,2.1619e+02_r8,2.1401e+02_r8/) + kbo(:,17,13) = (/ & + &2.2121e+02_r8,2.1996e+02_r8,2.1823e+02_r8,2.1618e+02_r8,2.1385e+02_r8/) + kbo(:,18,13) = (/ & + &2.1775e+02_r8,2.1636e+02_r8,2.1445e+02_r8,2.1229e+02_r8,2.1021e+02_r8/) + kbo(:,19,13) = (/ & + &2.1064e+02_r8,2.0900e+02_r8,2.0712e+02_r8,2.0551e+02_r8,2.0407e+02_r8/) + kbo(:,20,13) = (/ & + &2.0008e+02_r8,1.9874e+02_r8,1.9769e+02_r8,1.9686e+02_r8,1.9621e+02_r8/) + kbo(:,21,13) = (/ & + &1.8747e+02_r8,1.8700e+02_r8,1.8691e+02_r8,1.8703e+02_r8,1.8742e+02_r8/) + kbo(:,22,13) = (/ & + &1.7415e+02_r8,1.7476e+02_r8,1.7572e+02_r8,1.7701e+02_r8,1.7852e+02_r8/) + kbo(:,23,13) = (/ & + &1.6113e+02_r8,1.6295e+02_r8,1.6510e+02_r8,1.6752e+02_r8,1.7009e+02_r8/) + kbo(:,24,13) = (/ & + &1.4912e+02_r8,1.5211e+02_r8,1.5536e+02_r8,1.5887e+02_r8,1.6232e+02_r8/) + kbo(:,25,13) = (/ & + &1.3846e+02_r8,1.4246e+02_r8,1.4677e+02_r8,1.5111e+02_r8,1.5523e+02_r8/) + kbo(:,26,13) = (/ & + &1.2926e+02_r8,1.3422e+02_r8,1.3933e+02_r8,1.4432e+02_r8,1.4910e+02_r8/) + kbo(:,27,13) = (/ & + &1.2138e+02_r8,1.2724e+02_r8,1.3302e+02_r8,1.3864e+02_r8,1.4402e+02_r8/) + kbo(:,28,13) = (/ & + &1.1492e+02_r8,1.2144e+02_r8,1.2785e+02_r8,1.3411e+02_r8,1.4008e+02_r8/) + kbo(:,29,13) = (/ & + &1.0978e+02_r8,1.1690e+02_r8,1.2395e+02_r8,1.3076e+02_r8,1.3730e+02_r8/) + kbo(:,30,13) = (/ & + &1.0580e+02_r8,1.1355e+02_r8,1.2118e+02_r8,1.2849e+02_r8,1.3548e+02_r8/) + kbo(:,31,13) = (/ & + &1.0304e+02_r8,1.1137e+02_r8,1.1944e+02_r8,1.2716e+02_r8,1.3451e+02_r8/) + kbo(:,32,13) = (/ & + &1.0136e+02_r8,1.1014e+02_r8,1.1859e+02_r8,1.2663e+02_r8,1.3416e+02_r8/) + kbo(:,33,13) = (/ & + &1.0056e+02_r8,1.0971e+02_r8,1.1845e+02_r8,1.2667e+02_r8,1.3431e+02_r8/) + kbo(:,34,13) = (/ & + &1.0020e+02_r8,1.0961e+02_r8,1.1855e+02_r8,1.2688e+02_r8,1.3458e+02_r8/) + kbo(:,35,13) = (/ & + &9.9483e+01_r8,1.0912e+02_r8,1.1821e+02_r8,1.2667e+02_r8,1.3443e+02_r8/) + kbo(:,36,13) = (/ & + &9.8103e+01_r8,1.0792e+02_r8,1.1721e+02_r8,1.2581e+02_r8,1.3368e+02_r8/) + kbo(:,37,13) = (/ & + &9.5455e+01_r8,1.0552e+02_r8,1.1504e+02_r8,1.2386e+02_r8,1.3193e+02_r8/) + kbo(:,38,13) = (/ & + &9.2912e+01_r8,1.0319e+02_r8,1.1292e+02_r8,1.2195e+02_r8,1.3022e+02_r8/) + kbo(:,39,13) = (/ & + &9.0538e+01_r8,1.0100e+02_r8,1.1091e+02_r8,1.2014e+02_r8,1.2859e+02_r8/) + kbo(:,40,13) = (/ & + &8.7195e+01_r8,9.7854e+01_r8,1.0799e+02_r8,1.1748e+02_r8,1.2618e+02_r8/) + kbo(:,41,13) = (/ & + &8.3785e+01_r8,9.4631e+01_r8,1.0497e+02_r8,1.1470e+02_r8,1.2366e+02_r8/) + kbo(:,42,13) = (/ & + &8.0430e+01_r8,9.1433e+01_r8,1.0197e+02_r8,1.1192e+02_r8,1.2113e+02_r8/) + kbo(:,43,13) = (/ & + &7.6477e+01_r8,8.7634e+01_r8,9.8384e+01_r8,1.0856e+02_r8,1.1808e+02_r8/) + kbo(:,44,13) = (/ & + &7.2299e+01_r8,8.3562e+01_r8,9.4524e+01_r8,1.0494e+02_r8,1.1474e+02_r8/) + kbo(:,45,13) = (/ & + &6.8166e+01_r8,7.9496e+01_r8,9.0629e+01_r8,1.0127e+02_r8,1.1130e+02_r8/) + kbo(:,46,13) = (/ & + &6.3834e+01_r8,7.5188e+01_r8,8.6450e+01_r8,9.7312e+01_r8,1.0760e+02_r8/) + kbo(:,47,13) = (/ & + &5.9081e+01_r8,7.0413e+01_r8,8.1772e+01_r8,9.2852e+01_r8,1.0340e+02_r8/) + kbo(:,48,13) = (/ & + &5.4396e+01_r8,6.5661e+01_r8,7.7060e+01_r8,8.8317e+01_r8,9.9114e+01_r8/) + kbo(:,49,13) = (/ & + &4.9801e+01_r8,6.0961e+01_r8,7.2354e+01_r8,8.3709e+01_r8,9.4725e+01_r8/) + kbo(:,50,13) = (/ & + &4.5581e+01_r8,5.6585e+01_r8,6.7933e+01_r8,7.9345e+01_r8,9.0545e+01_r8/) + kbo(:,51,13) = (/ & + &4.1581e+01_r8,5.2405e+01_r8,6.3662e+01_r8,7.5096e+01_r8,8.6425e+01_r8/) + kbo(:,52,13) = (/ & + &3.7719e+01_r8,4.8309e+01_r8,5.9448e+01_r8,7.0850e+01_r8,8.2254e+01_r8/) + kbo(:,53,13) = (/ & + &3.4012e+01_r8,4.4282e+01_r8,5.5265e+01_r8,6.6609e+01_r8,7.8050e+01_r8/) + kbo(:,54,13) = (/ & + &3.0756e+01_r8,4.0675e+01_r8,5.1476e+01_r8,6.2735e+01_r8,7.4183e+01_r8/) + kbo(:,55,13) = (/ & + &2.7771e+01_r8,3.7316e+01_r8,4.7906e+01_r8,5.9042e+01_r8,7.0461e+01_r8/) + kbo(:,56,13) = (/ & + &2.4943e+01_r8,3.4093e+01_r8,4.4398e+01_r8,5.5401e+01_r8,6.6760e+01_r8/) + kbo(:,57,13) = (/ & + &2.2280e+01_r8,3.0993e+01_r8,4.0957e+01_r8,5.1794e+01_r8,6.3073e+01_r8/) + kbo(:,58,13) = (/ & + &1.9914e+01_r8,2.8171e+01_r8,3.7788e+01_r8,4.8428e+01_r8,5.9596e+01_r8/) + kbo(:,59,13) = (/ & + &1.9003e+01_r8,2.7062e+01_r8,3.6534e+01_r8,4.7084e+01_r8,5.8201e+01_r8/) + kbo(:,13,14) = (/ & + &3.9453e+02_r8,3.9054e+02_r8,3.8556e+02_r8,3.8029e+02_r8,3.7518e+02_r8/) + kbo(:,14,14) = (/ & + &4.2588e+02_r8,4.2023e+02_r8,4.1375e+02_r8,4.0776e+02_r8,4.0199e+02_r8/) + kbo(:,15,14) = (/ & + &4.5408e+02_r8,4.4627e+02_r8,4.3917e+02_r8,4.3301e+02_r8,4.2714e+02_r8/) + kbo(:,16,14) = (/ & + &4.7789e+02_r8,4.6976e+02_r8,4.6328e+02_r8,4.5698e+02_r8,4.5114e+02_r8/) + kbo(:,17,14) = (/ & + &5.0033e+02_r8,4.9329e+02_r8,4.8659e+02_r8,4.8030e+02_r8,4.7472e+02_r8/) + kbo(:,18,14) = (/ & + &5.2160e+02_r8,5.1479e+02_r8,5.0850e+02_r8,5.0281e+02_r8,4.9755e+02_r8/) + kbo(:,19,14) = (/ & + &5.3975e+02_r8,5.3405e+02_r8,5.2880e+02_r8,5.2359e+02_r8,5.1826e+02_r8/) + kbo(:,20,14) = (/ & + &5.5471e+02_r8,5.5025e+02_r8,5.4544e+02_r8,5.4054e+02_r8,5.3559e+02_r8/) + kbo(:,21,14) = (/ & + &5.6616e+02_r8,5.6246e+02_r8,5.5854e+02_r8,5.5439e+02_r8,5.5012e+02_r8/) + kbo(:,22,14) = (/ & + &5.7373e+02_r8,5.7143e+02_r8,5.6842e+02_r8,5.6526e+02_r8,5.6165e+02_r8/) + kbo(:,23,14) = (/ & + &5.7822e+02_r8,5.7745e+02_r8,5.7602e+02_r8,5.7378e+02_r8,5.7033e+02_r8/) + kbo(:,24,14) = (/ & + &5.8038e+02_r8,5.8144e+02_r8,5.8147e+02_r8,5.7978e+02_r8,5.7697e+02_r8/) + kbo(:,25,14) = (/ & + &5.8144e+02_r8,5.8416e+02_r8,5.8500e+02_r8,5.8436e+02_r8,5.8236e+02_r8/) + kbo(:,26,14) = (/ & + &5.8189e+02_r8,5.8575e+02_r8,5.8780e+02_r8,5.8818e+02_r8,5.8686e+02_r8/) + kbo(:,27,14) = (/ & + &5.8218e+02_r8,5.8719e+02_r8,5.9038e+02_r8,5.9148e+02_r8,5.9059e+02_r8/) + kbo(:,28,14) = (/ & + &5.8262e+02_r8,5.8871e+02_r8,5.9261e+02_r8,5.9417e+02_r8,5.9365e+02_r8/) + kbo(:,29,14) = (/ & + &5.8351e+02_r8,5.9046e+02_r8,5.9468e+02_r8,5.9643e+02_r8,5.9604e+02_r8/) + kbo(:,30,14) = (/ & + &5.8500e+02_r8,5.9236e+02_r8,5.9667e+02_r8,5.9846e+02_r8,5.9808e+02_r8/) + kbo(:,31,14) = (/ & + &5.8683e+02_r8,5.9418e+02_r8,5.9850e+02_r8,6.0020e+02_r8,5.9975e+02_r8/) + kbo(:,32,14) = (/ & + &5.8889e+02_r8,5.9602e+02_r8,6.0013e+02_r8,6.0165e+02_r8,6.0111e+02_r8/) + kbo(:,33,14) = (/ & + &5.9113e+02_r8,5.9792e+02_r8,6.0167e+02_r8,6.0289e+02_r8,6.0219e+02_r8/) + kbo(:,34,14) = (/ & + &5.9309e+02_r8,5.9954e+02_r8,6.0296e+02_r8,6.0390e+02_r8,6.0309e+02_r8/) + kbo(:,35,14) = (/ & + &5.9425e+02_r8,6.0057e+02_r8,6.0391e+02_r8,6.0481e+02_r8,6.0395e+02_r8/) + kbo(:,36,14) = (/ & + &5.9453e+02_r8,6.0102e+02_r8,6.0449e+02_r8,6.0555e+02_r8,6.0478e+02_r8/) + kbo(:,37,14) = (/ & + &5.9344e+02_r8,6.0064e+02_r8,6.0466e+02_r8,6.0613e+02_r8,6.0565e+02_r8/) + kbo(:,38,14) = (/ & + &5.9210e+02_r8,6.0005e+02_r8,6.0460e+02_r8,6.0657e+02_r8,6.0636e+02_r8/) + kbo(:,39,14) = (/ & + &5.9062e+02_r8,5.9933e+02_r8,6.0439e+02_r8,6.0685e+02_r8,6.0693e+02_r8/) + kbo(:,40,14) = (/ & + &5.8781e+02_r8,5.9770e+02_r8,6.0363e+02_r8,6.0675e+02_r8,6.0742e+02_r8/) + kbo(:,41,14) = (/ & + &5.8441e+02_r8,5.9563e+02_r8,6.0254e+02_r8,6.0641e+02_r8,6.0773e+02_r8/) + kbo(:,42,14) = (/ & + &5.8066e+02_r8,5.9320e+02_r8,6.0125e+02_r8,6.0582e+02_r8,6.0784e+02_r8/) + kbo(:,43,14) = (/ & + &5.7546e+02_r8,5.8975e+02_r8,5.9921e+02_r8,6.0478e+02_r8,6.0764e+02_r8/) + kbo(:,44,14) = (/ & + &5.6919e+02_r8,5.8551e+02_r8,5.9655e+02_r8,6.0334e+02_r8,6.0709e+02_r8/) + kbo(:,45,14) = (/ & + &5.6228e+02_r8,5.8057e+02_r8,5.9328e+02_r8,6.0149e+02_r8,6.0621e+02_r8/) + kbo(:,46,14) = (/ & + &5.5416e+02_r8,5.7453e+02_r8,5.8925e+02_r8,5.9904e+02_r8,6.0487e+02_r8/) + kbo(:,47,14) = (/ & + &5.4413e+02_r8,5.6695e+02_r8,5.8396e+02_r8,5.9568e+02_r8,6.0296e+02_r8/) + kbo(:,48,14) = (/ & + &5.3289e+02_r8,5.5838e+02_r8,5.7778e+02_r8,5.9151e+02_r8,6.0055e+02_r8/) + kbo(:,49,14) = (/ & + &5.2046e+02_r8,5.4886e+02_r8,5.7056e+02_r8,5.8661e+02_r8,5.9745e+02_r8/) + kbo(:,50,14) = (/ & + &5.0763e+02_r8,5.3890e+02_r8,5.6309e+02_r8,5.8123e+02_r8,5.9389e+02_r8/) + kbo(:,51,14) = (/ & + &4.9397e+02_r8,5.2829e+02_r8,5.5490e+02_r8,5.7522e+02_r8,5.8985e+02_r8/) + kbo(:,52,14) = (/ & + &4.7917e+02_r8,5.1663e+02_r8,5.4597e+02_r8,5.6843e+02_r8,5.8514e+02_r8/) + kbo(:,53,14) = (/ & + &4.6310e+02_r8,5.0389e+02_r8,5.3606e+02_r8,5.6086e+02_r8,5.7969e+02_r8/) + kbo(:,54,14) = (/ & + &4.4738e+02_r8,4.9113e+02_r8,5.2610e+02_r8,5.5325e+02_r8,5.7401e+02_r8/) + kbo(:,55,14) = (/ & + &4.3145e+02_r8,4.7800e+02_r8,5.1576e+02_r8,5.4530e+02_r8,5.6795e+02_r8/) + kbo(:,56,14) = (/ & + &4.1442e+02_r8,4.6397e+02_r8,5.0460e+02_r8,5.3665e+02_r8,5.6135e+02_r8/) + kbo(:,57,14) = (/ & + &3.9638e+02_r8,4.4904e+02_r8,4.9255e+02_r8,5.2719e+02_r8,5.5411e+02_r8/) + kbo(:,58,14) = (/ & + &3.7836e+02_r8,4.3410e+02_r8,4.8026e+02_r8,5.1754e+02_r8,5.4672e+02_r8/) + kbo(:,59,14) = (/ & + &3.7094e+02_r8,4.2781e+02_r8,4.7507e+02_r8,5.1348e+02_r8,5.4351e+02_r8/) + kbo(:,13,15) = (/ & + &7.2633e+02_r8,7.1401e+02_r8,7.0254e+02_r8,6.9098e+02_r8,6.8020e+02_r8/) + kbo(:,14,15) = (/ & + &8.3011e+02_r8,8.1776e+02_r8,8.0585e+02_r8,7.9323e+02_r8,7.8158e+02_r8/) + kbo(:,15,15) = (/ & + &9.4371e+02_r8,9.3141e+02_r8,9.1779e+02_r8,9.0358e+02_r8,8.9021e+02_r8/) + kbo(:,16,15) = (/ & + &1.0657e+03_r8,1.0512e+03_r8,1.0343e+03_r8,1.0183e+03_r8,1.0024e+03_r8/) + kbo(:,17,15) = (/ & + &1.1900e+03_r8,1.1715e+03_r8,1.1530e+03_r8,1.1344e+03_r8,1.1149e+03_r8/) + kbo(:,18,15) = (/ & + &1.3144e+03_r8,1.2934e+03_r8,1.2719e+03_r8,1.2491e+03_r8,1.2254e+03_r8/) + kbo(:,19,15) = (/ & + &1.4395e+03_r8,1.4148e+03_r8,1.3884e+03_r8,1.3607e+03_r8,1.3337e+03_r8/) + kbo(:,20,15) = (/ & + &1.5639e+03_r8,1.5338e+03_r8,1.5021e+03_r8,1.4707e+03_r8,1.4392e+03_r8/) + kbo(:,21,15) = (/ & + &1.6839e+03_r8,1.6488e+03_r8,1.6126e+03_r8,1.5763e+03_r8,1.5389e+03_r8/) + kbo(:,22,15) = (/ & + &1.7952e+03_r8,1.7545e+03_r8,1.7135e+03_r8,1.6710e+03_r8,1.6285e+03_r8/) + kbo(:,23,15) = (/ & + &1.8976e+03_r8,1.8509e+03_r8,1.8033e+03_r8,1.7556e+03_r8,1.7089e+03_r8/) + kbo(:,24,15) = (/ & + &1.9890e+03_r8,1.9360e+03_r8,1.8826e+03_r8,1.8303e+03_r8,1.7792e+03_r8/) + kbo(:,25,15) = (/ & + &2.0674e+03_r8,2.0090e+03_r8,1.9512e+03_r8,1.8940e+03_r8,1.8389e+03_r8/) + kbo(:,26,15) = (/ & + &2.1327e+03_r8,2.0701e+03_r8,2.0075e+03_r8,1.9460e+03_r8,1.8872e+03_r8/) + kbo(:,27,15) = (/ & + &2.1871e+03_r8,2.1199e+03_r8,2.0526e+03_r8,1.9878e+03_r8,1.9258e+03_r8/) + kbo(:,28,15) = (/ & + &2.2305e+03_r8,2.1590e+03_r8,2.0884e+03_r8,2.0207e+03_r8,1.9559e+03_r8/) + kbo(:,29,15) = (/ & + &2.2640e+03_r8,2.1881e+03_r8,2.1149e+03_r8,2.0446e+03_r8,1.9773e+03_r8/) + kbo(:,30,15) = (/ & + &2.2867e+03_r8,2.2086e+03_r8,2.1332e+03_r8,2.0610e+03_r8,1.9920e+03_r8/) + kbo(:,31,15) = (/ & + &2.3021e+03_r8,2.2217e+03_r8,2.1448e+03_r8,2.0709e+03_r8,2.0000e+03_r8/) + kbo(:,32,15) = (/ & + &2.3102e+03_r8,2.2286e+03_r8,2.1502e+03_r8,2.0751e+03_r8,2.0031e+03_r8/) + kbo(:,33,15) = (/ & + &2.3126e+03_r8,2.2299e+03_r8,2.1503e+03_r8,2.0747e+03_r8,2.0018e+03_r8/) + kbo(:,34,15) = (/ & + &2.3131e+03_r8,2.2295e+03_r8,2.1494e+03_r8,2.0730e+03_r8,1.9993e+03_r8/) + kbo(:,35,15) = (/ & + &2.3181e+03_r8,2.2337e+03_r8,2.1530e+03_r8,2.0757e+03_r8,2.0015e+03_r8/) + kbo(:,36,15) = (/ & + &2.3296e+03_r8,2.2444e+03_r8,2.1625e+03_r8,2.0844e+03_r8,2.0094e+03_r8/) + kbo(:,37,15) = (/ & + &2.3524e+03_r8,2.2655e+03_r8,2.1822e+03_r8,2.1029e+03_r8,2.0270e+03_r8/) + kbo(:,38,15) = (/ & + &2.3744e+03_r8,2.2859e+03_r8,2.2015e+03_r8,2.1208e+03_r8,2.0440e+03_r8/) + kbo(:,39,15) = (/ & + &2.3947e+03_r8,2.3050e+03_r8,2.2197e+03_r8,2.1376e+03_r8,2.0600e+03_r8/) + kbo(:,40,15) = (/ & + &2.4238e+03_r8,2.3323e+03_r8,2.2455e+03_r8,2.1621e+03_r8,2.0831e+03_r8/) + kbo(:,41,15) = (/ & + &2.4535e+03_r8,2.3601e+03_r8,2.2718e+03_r8,2.1873e+03_r8,2.1067e+03_r8/) + kbo(:,42,15) = (/ & + &2.4827e+03_r8,2.3879e+03_r8,2.2978e+03_r8,2.2120e+03_r8,2.1299e+03_r8/) + kbo(:,43,15) = (/ & + &2.5170e+03_r8,2.4207e+03_r8,2.3287e+03_r8,2.2417e+03_r8,2.1580e+03_r8/) + kbo(:,44,15) = (/ & + &2.5535e+03_r8,2.4558e+03_r8,2.3619e+03_r8,2.2731e+03_r8,2.1881e+03_r8/) + kbo(:,45,15) = (/ & + &2.5895e+03_r8,2.4909e+03_r8,2.3955e+03_r8,2.3046e+03_r8,2.2183e+03_r8/) + kbo(:,46,15) = (/ & + &2.6275e+03_r8,2.5286e+03_r8,2.4314e+03_r8,2.3383e+03_r8,2.2507e+03_r8/) + kbo(:,47,15) = (/ & + &2.6692e+03_r8,2.5702e+03_r8,2.4716e+03_r8,2.3766e+03_r8,2.2868e+03_r8/) + kbo(:,48,15) = (/ & + &2.7104e+03_r8,2.6117e+03_r8,2.5124e+03_r8,2.4158e+03_r8,2.3235e+03_r8/) + kbo(:,49,15) = (/ & + &2.7515e+03_r8,2.6527e+03_r8,2.5535e+03_r8,2.4553e+03_r8,2.3608e+03_r8/) + kbo(:,50,15) = (/ & + &2.7894e+03_r8,2.6912e+03_r8,2.5919e+03_r8,2.4928e+03_r8,2.3968e+03_r8/) + kbo(:,51,15) = (/ & + &2.8258e+03_r8,2.7283e+03_r8,2.6293e+03_r8,2.5297e+03_r8,2.4319e+03_r8/) + kbo(:,52,15) = (/ & + &2.8615e+03_r8,2.7650e+03_r8,2.6661e+03_r8,2.5667e+03_r8,2.4680e+03_r8/) + kbo(:,53,15) = (/ & + &2.8958e+03_r8,2.8012e+03_r8,2.7030e+03_r8,2.6033e+03_r8,2.5041e+03_r8/) + kbo(:,54,15) = (/ & + &2.9257e+03_r8,2.8343e+03_r8,2.7368e+03_r8,2.6377e+03_r8,2.5378e+03_r8/) + kbo(:,55,15) = (/ & + &2.9533e+03_r8,2.8653e+03_r8,2.7685e+03_r8,2.6697e+03_r8,2.5700e+03_r8/) + kbo(:,56,15) = (/ & + &2.9793e+03_r8,2.8948e+03_r8,2.8002e+03_r8,2.7018e+03_r8,2.6024e+03_r8/) + kbo(:,57,15) = (/ & + &3.0042e+03_r8,2.9237e+03_r8,2.8317e+03_r8,2.7340e+03_r8,2.6347e+03_r8/) + kbo(:,58,15) = (/ & + &3.0257e+03_r8,2.9495e+03_r8,2.8610e+03_r8,2.7641e+03_r8,2.6651e+03_r8/) + kbo(:,59,15) = (/ & + &3.0338e+03_r8,2.9597e+03_r8,2.8725e+03_r8,2.7761e+03_r8,2.6773e+03_r8/) + kbo(:,13,16) = (/ & + &1.0026e+03_r8,9.7775e+02_r8,9.6058e+02_r8,9.5314e+02_r8,9.4719e+02_r8/) + kbo(:,14,16) = (/ & + &1.2035e+03_r8,1.1711e+03_r8,1.1486e+03_r8,1.1339e+03_r8,1.1211e+03_r8/) + kbo(:,15,16) = (/ & + &1.4371e+03_r8,1.3952e+03_r8,1.3661e+03_r8,1.3423e+03_r8,1.3197e+03_r8/) + kbo(:,16,16) = (/ & + &1.7031e+03_r8,1.6520e+03_r8,1.6127e+03_r8,1.5775e+03_r8,1.5442e+03_r8/) + kbo(:,17,16) = (/ & + &2.0034e+03_r8,1.9408e+03_r8,1.8881e+03_r8,1.8394e+03_r8,1.7917e+03_r8/) + kbo(:,18,16) = (/ & + &2.3372e+03_r8,2.2594e+03_r8,2.1891e+03_r8,2.1223e+03_r8,2.0585e+03_r8/) + kbo(:,19,16) = (/ & + &2.7003e+03_r8,2.6007e+03_r8,2.5092e+03_r8,2.4222e+03_r8,2.3387e+03_r8/) + kbo(:,20,16) = (/ & + &3.0827e+03_r8,2.9575e+03_r8,2.8405e+03_r8,2.7290e+03_r8,2.6233e+03_r8/) + kbo(:,21,16) = (/ & + &3.4765e+03_r8,3.3200e+03_r8,3.1728e+03_r8,3.0348e+03_r8,2.9062e+03_r8/) + kbo(:,22,16) = (/ & + &3.8557e+03_r8,3.6642e+03_r8,3.4867e+03_r8,3.3227e+03_r8,3.1685e+03_r8/) + kbo(:,23,16) = (/ & + &4.2141e+03_r8,3.9881e+03_r8,3.7808e+03_r8,3.5882e+03_r8,3.4103e+03_r8/) + kbo(:,24,16) = (/ & + &4.5433e+03_r8,4.2837e+03_r8,4.0442e+03_r8,3.8246e+03_r8,3.6242e+03_r8/) + kbo(:,25,16) = (/ & + &4.8340e+03_r8,4.5405e+03_r8,4.2717e+03_r8,4.0284e+03_r8,3.8059e+03_r8/) + kbo(:,26,16) = (/ & + &5.0756e+03_r8,4.7511e+03_r8,4.4591e+03_r8,4.1940e+03_r8,3.9524e+03_r8/) + kbo(:,27,16) = (/ & + &5.2698e+03_r8,4.9206e+03_r8,4.6082e+03_r8,4.3247e+03_r8,4.0667e+03_r8/) + kbo(:,28,16) = (/ & + &5.4203e+03_r8,5.0514e+03_r8,4.7208e+03_r8,4.4225e+03_r8,4.1519e+03_r8/) + kbo(:,29,16) = (/ & + &5.5225e+03_r8,5.1430e+03_r8,4.7990e+03_r8,4.4889e+03_r8,4.2086e+03_r8/) + kbo(:,30,16) = (/ & + &5.5968e+03_r8,5.2018e+03_r8,4.8479e+03_r8,4.5299e+03_r8,4.2431e+03_r8/) + kbo(:,31,16) = (/ & + &5.6319e+03_r8,5.2297e+03_r8,4.8692e+03_r8,4.5471e+03_r8,4.2577e+03_r8/) + kbo(:,32,16) = (/ & + &5.6393e+03_r8,5.2323e+03_r8,4.8693e+03_r8,4.5451e+03_r8,4.2544e+03_r8/) + kbo(:,33,16) = (/ & + &5.6219e+03_r8,5.2153e+03_r8,4.8522e+03_r8,4.5281e+03_r8,4.2389e+03_r8/) + kbo(:,34,16) = (/ & + &5.6014e+03_r8,5.1950e+03_r8,4.8333e+03_r8,4.5105e+03_r8,4.2225e+03_r8/) + kbo(:,35,16) = (/ & + &5.6085e+03_r8,5.1993e+03_r8,4.8360e+03_r8,4.5120e+03_r8,4.2238e+03_r8/) + kbo(:,36,16) = (/ & + &5.6508e+03_r8,5.2362e+03_r8,4.8672e+03_r8,4.5401e+03_r8,4.2477e+03_r8/) + kbo(:,37,16) = (/ & + &5.7523e+03_r8,5.3259e+03_r8,4.9464e+03_r8,4.6095e+03_r8,4.3092e+03_r8/) + kbo(:,38,16) = (/ & + &5.8536e+03_r8,5.4145e+03_r8,5.0247e+03_r8,4.6788e+03_r8,4.3703e+03_r8/) + kbo(:,39,16) = (/ & + &5.9499e+03_r8,5.4442e+03_r8,5.0495e+03_r8,4.7451e+03_r8,4.4289e+03_r8/) + kbo(:,40,16) = (/ & + &6.0943e+03_r8,5.6261e+03_r8,5.2115e+03_r8,4.8437e+03_r8,4.5174e+03_r8/) + kbo(:,41,16) = (/ & + &6.2466e+03_r8,5.7599e+03_r8,5.3292e+03_r8,4.9481e+03_r8,4.6100e+03_r8/) + kbo(:,42,16) = (/ & + &6.4016e+03_r8,5.8949e+03_r8,5.4490e+03_r8,5.0540e+03_r8,4.7039e+03_r8/) + kbo(:,43,16) = (/ & + &6.5921e+03_r8,6.0603e+03_r8,5.5952e+03_r8,5.1830e+03_r8,4.8181e+03_r8/) + kbo(:,44,16) = (/ & + &6.8054e+03_r8,6.2437e+03_r8,5.7562e+03_r8,5.3258e+03_r8,4.9439e+03_r8/) + kbo(:,45,16) = (/ & + &7.0283e+03_r8,6.4351e+03_r8,5.9235e+03_r8,5.4736e+03_r8,5.0747e+03_r8/) + kbo(:,46,16) = (/ & + &7.2775e+03_r8,6.6473e+03_r8,6.1076e+03_r8,5.6361e+03_r8,5.2188e+03_r8/) + kbo(:,47,16) = (/ & + &7.5694e+03_r8,6.8970e+03_r8,6.3223e+03_r8,5.8241e+03_r8,5.3852e+03_r8/) + kbo(:,48,16) = (/ & + &7.8805e+03_r8,7.1623e+03_r8,6.5487e+03_r8,6.0220e+03_r8,5.5600e+03_r8/) + kbo(:,49,16) = (/ & + &8.2112e+03_r8,7.4430e+03_r8,6.7899e+03_r8,6.2293e+03_r8,5.7432e+03_r8/) + kbo(:,50,16) = (/ & + &8.5417e+03_r8,7.7234e+03_r8,7.0279e+03_r8,6.4340e+03_r8,5.9223e+03_r8/) + kbo(:,51,16) = (/ & + &8.8820e+03_r8,8.0126e+03_r8,7.2736e+03_r8,6.6439e+03_r8,6.1042e+03_r8/) + kbo(:,52,16) = (/ & + &9.2420e+03_r8,8.3170e+03_r8,7.5326e+03_r8,6.8651e+03_r8,6.2940e+03_r8/) + kbo(:,53,16) = (/ & + &9.6269e+03_r8,8.6414e+03_r8,7.8081e+03_r8,7.0991e+03_r8,6.4953e+03_r8/) + kbo(:,54,16) = (/ & + &1.0002e+04_r8,8.9556e+03_r8,8.0739e+03_r8,7.3265e+03_r8,6.6894e+03_r8/) + kbo(:,55,16) = (/ & + &1.0382e+04_r8,9.2723e+03_r8,8.3431e+03_r8,7.5548e+03_r8,6.8840e+03_r8/) + kbo(:,56,16) = (/ & + &1.0780e+04_r8,9.6091e+03_r8,8.6265e+03_r8,7.7944e+03_r8,7.0899e+03_r8/) + kbo(:,57,16) = (/ & + &1.1201e+04_r8,9.9648e+03_r8,8.9241e+03_r8,8.0480e+03_r8,7.3039e+03_r8/) + kbo(:,58,16) = (/ & + &1.1621e+04_r8,1.0321e+04_r8,9.2223e+03_r8,8.3005e+03_r8,7.5182e+03_r8/) + kbo(:,59,16) = (/ & + &1.1796e+04_r8,1.0468e+04_r8,9.3476e+03_r8,8.4058e+03_r8,7.6078e+03_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kao_mo2(:, 1) = (/ & + & 2.31723e-06_r8, 2.28697e-06_r8, 2.25710e-06_r8, 2.22762e-06_r8, 2.19852e-06_r8, & + & 2.16981e-06_r8, 2.14147e-06_r8, 2.11350e-06_r8, 2.08590e-06_r8, 2.05865e-06_r8, & + & 2.03176e-06_r8, 2.00523e-06_r8, 1.97904e-06_r8, 1.95319e-06_r8, 1.92768e-06_r8, & + & 1.90250e-06_r8, 1.87765e-06_r8, 1.85313e-06_r8, 1.82893e-06_r8/) + kao_mo2(:, 2) = (/ & + & 1.81980e-06_r8, 1.81352e-06_r8, 1.80726e-06_r8, 1.80101e-06_r8, 1.79479e-06_r8, & + & 1.78860e-06_r8, 1.78242e-06_r8, 1.77626e-06_r8, 1.77013e-06_r8, 1.76402e-06_r8, & + & 1.75792e-06_r8, 1.75185e-06_r8, 1.74580e-06_r8, 1.73977e-06_r8, 1.73377e-06_r8, & + & 1.72778e-06_r8, 1.72181e-06_r8, 1.71587e-06_r8, 1.70994e-06_r8/) + kao_mo2(:, 3) = (/ & + & 2.26922e-06_r8, 2.25413e-06_r8, 2.23914e-06_r8, 2.22425e-06_r8, 2.20945e-06_r8, & + & 2.19476e-06_r8, 2.18016e-06_r8, 2.16566e-06_r8, 2.15126e-06_r8, 2.13695e-06_r8, & + & 2.12274e-06_r8, 2.10862e-06_r8, 2.09459e-06_r8, 2.08066e-06_r8, 2.06683e-06_r8, & + & 2.05308e-06_r8, 2.03942e-06_r8, 2.02586e-06_r8, 2.01239e-06_r8/) + kao_mo2(:, 4) = (/ & + & 2.15555e-06_r8, 2.14539e-06_r8, 2.13527e-06_r8, 2.12520e-06_r8, 2.11517e-06_r8, & + & 2.10520e-06_r8, 2.09527e-06_r8, 2.08538e-06_r8, 2.07555e-06_r8, 2.06576e-06_r8, & + & 2.05601e-06_r8, 2.04631e-06_r8, 2.03666e-06_r8, 2.02706e-06_r8, 2.01749e-06_r8, & + & 2.00798e-06_r8, 1.99851e-06_r8, 1.98908e-06_r8, 1.97970e-06_r8/) + kao_mo2(:, 5) = (/ & + & 2.05821e-06_r8, 2.04914e-06_r8, 2.04011e-06_r8, 2.03111e-06_r8, 2.02216e-06_r8, & + & 2.01324e-06_r8, 2.00437e-06_r8, 1.99553e-06_r8, 1.98673e-06_r8, 1.97798e-06_r8, & + & 1.96926e-06_r8, 1.96057e-06_r8, 1.95193e-06_r8, 1.94333e-06_r8, 1.93476e-06_r8, & + & 1.92623e-06_r8, 1.91774e-06_r8, 1.90928e-06_r8, 1.90087e-06_r8/) + kao_mo2(:, 6) = (/ & + & 2.20148e-06_r8, 2.18998e-06_r8, 2.17854e-06_r8, 2.16717e-06_r8, 2.15585e-06_r8, & + & 2.14459e-06_r8, 2.13339e-06_r8, 2.12225e-06_r8, 2.11117e-06_r8, 2.10014e-06_r8, & + & 2.08918e-06_r8, 2.07827e-06_r8, 2.06741e-06_r8, 2.05662e-06_r8, 2.04588e-06_r8, & + & 2.03519e-06_r8, 2.02457e-06_r8, 2.01399e-06_r8, 2.00348e-06_r8/) + kao_mo2(:, 7) = (/ & + & 2.28960e-06_r8, 2.27651e-06_r8, 2.26349e-06_r8, 2.25054e-06_r8, 2.23767e-06_r8, & + & 2.22487e-06_r8, 2.21215e-06_r8, 2.19950e-06_r8, 2.18692e-06_r8, 2.17441e-06_r8, & + & 2.16198e-06_r8, 2.14961e-06_r8, 2.13732e-06_r8, 2.12509e-06_r8, 2.11294e-06_r8, & + & 2.10085e-06_r8, 2.08884e-06_r8, 2.07689e-06_r8, 2.06501e-06_r8/) + kao_mo2(:, 8) = (/ & + & 2.28564e-06_r8, 2.27363e-06_r8, 2.26168e-06_r8, 2.24980e-06_r8, 2.23798e-06_r8, & + & 2.22622e-06_r8, 2.21452e-06_r8, 2.20288e-06_r8, 2.19131e-06_r8, 2.17980e-06_r8, & + & 2.16834e-06_r8, 2.15695e-06_r8, 2.14562e-06_r8, 2.13434e-06_r8, 2.12313e-06_r8, & + & 2.11197e-06_r8, 2.10087e-06_r8, 2.08984e-06_r8, 2.07886e-06_r8/) + kao_mo2(:, 9) = (/ & + & 2.28505e-06_r8, 2.27395e-06_r8, 2.26291e-06_r8, 2.25192e-06_r8, 2.24099e-06_r8, & + & 2.23011e-06_r8, 2.21928e-06_r8, 2.20850e-06_r8, 2.19778e-06_r8, 2.18711e-06_r8, & + & 2.17649e-06_r8, 2.16592e-06_r8, 2.15540e-06_r8, 2.14494e-06_r8, 2.13452e-06_r8, & + & 2.12416e-06_r8, 2.11385e-06_r8, 2.10358e-06_r8, 2.09337e-06_r8/) + kao_mo2(:,10) = (/ & + & 2.25915e-06_r8, 2.24938e-06_r8, 2.23965e-06_r8, 2.22997e-06_r8, 2.22032e-06_r8, & + & 2.21072e-06_r8, 2.20116e-06_r8, 2.19164e-06_r8, 2.18216e-06_r8, 2.17272e-06_r8, & + & 2.16333e-06_r8, 2.15397e-06_r8, 2.14465e-06_r8, 2.13538e-06_r8, 2.12614e-06_r8, & + & 2.11695e-06_r8, 2.10779e-06_r8, 2.09868e-06_r8, 2.08960e-06_r8/) + kao_mo2(:,11) = (/ & + & 2.52025e-06_r8, 2.50423e-06_r8, 2.48831e-06_r8, 2.47249e-06_r8, 2.45677e-06_r8, & + & 2.44115e-06_r8, 2.42563e-06_r8, 2.41021e-06_r8, 2.39489e-06_r8, 2.37967e-06_r8, & + & 2.36454e-06_r8, 2.34951e-06_r8, 2.33457e-06_r8, 2.31973e-06_r8, 2.30498e-06_r8, & + & 2.29033e-06_r8, 2.27577e-06_r8, 2.26130e-06_r8, 2.24692e-06_r8/) + kao_mo2(:,12) = (/ & + & 2.52634e-06_r8, 2.51180e-06_r8, 2.49735e-06_r8, 2.48299e-06_r8, 2.46871e-06_r8, & + & 2.45451e-06_r8, 2.44039e-06_r8, 2.42635e-06_r8, 2.41239e-06_r8, 2.39851e-06_r8, & + & 2.38472e-06_r8, 2.37100e-06_r8, 2.35736e-06_r8, 2.34380e-06_r8, 2.33032e-06_r8, & + & 2.31691e-06_r8, 2.30358e-06_r8, 2.29033e-06_r8, 2.27716e-06_r8/) + kao_mo2(:,13) = (/ & + & 2.66614e-06_r8, 2.64897e-06_r8, 2.63191e-06_r8, 2.61496e-06_r8, 2.59812e-06_r8, & + & 2.58138e-06_r8, 2.56476e-06_r8, 2.54824e-06_r8, 2.53183e-06_r8, 2.51552e-06_r8, & + & 2.49932e-06_r8, 2.48322e-06_r8, 2.46723e-06_r8, 2.45134e-06_r8, 2.43555e-06_r8, & + & 2.41987e-06_r8, 2.40428e-06_r8, 2.38880e-06_r8, 2.37341e-06_r8/) + kao_mo2(:,14) = (/ & + & 2.96755e-06_r8, 2.94803e-06_r8, 2.92864e-06_r8, 2.90937e-06_r8, 2.89023e-06_r8, & + & 2.87122e-06_r8, 2.85233e-06_r8, 2.83357e-06_r8, 2.81493e-06_r8, 2.79641e-06_r8, & + & 2.77802e-06_r8, 2.75974e-06_r8, 2.74159e-06_r8, 2.72355e-06_r8, 2.70563e-06_r8, & + & 2.68784e-06_r8, 2.67015e-06_r8, 2.65259e-06_r8, 2.63514e-06_r8/) + kao_mo2(:,15) = (/ & + & 1.30668e-06_r8, 1.31378e-06_r8, 1.32091e-06_r8, 1.32808e-06_r8, 1.33530e-06_r8, & + & 1.34255e-06_r8, 1.34984e-06_r8, 1.35717e-06_r8, 1.36454e-06_r8, 1.37195e-06_r8, & + & 1.37941e-06_r8, 1.38690e-06_r8, 1.39443e-06_r8, 1.40200e-06_r8, 1.40962e-06_r8, & + & 1.41727e-06_r8, 1.42497e-06_r8, 1.43271e-06_r8, 1.44049e-06_r8/) + kao_mo2(:,16) = (/ & + & 5.99001e-07_r8, 6.16844e-07_r8, 6.35219e-07_r8, 6.54141e-07_r8, 6.73626e-07_r8, & + & 6.93692e-07_r8, 7.14356e-07_r8, 7.35635e-07_r8, 7.57548e-07_r8, 7.80114e-07_r8, & + & 8.03352e-07_r8, 8.27282e-07_r8, 8.51925e-07_r8, 8.77302e-07_r8, 9.03435e-07_r8, & + & 9.30347e-07_r8, 9.58060e-07_r8, 9.86599e-07_r8, 1.01599e-06_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kbo_mo2(:, 1) = (/ & + & 4.97626e-07_r8, 5.05955e-07_r8, 5.14424e-07_r8, 5.23034e-07_r8, 5.31789e-07_r8, & + & 5.40690e-07_r8, 5.49739e-07_r8, 5.58941e-07_r8, 5.68296e-07_r8, 5.77808e-07_r8, & + & 5.87479e-07_r8, 5.97312e-07_r8, 6.07310e-07_r8, 6.17475e-07_r8, 6.27810e-07_r8, & + & 6.38318e-07_r8, 6.49002e-07_r8, 6.59865e-07_r8, 6.70910e-07_r8/) + kbo_mo2(:, 2) = (/ & + & 3.10232e-06_r8, 3.06339e-06_r8, 3.02496e-06_r8, 2.98700e-06_r8, 2.94952e-06_r8, & + & 2.91252e-06_r8, 2.87597e-06_r8, 2.83989e-06_r8, 2.80426e-06_r8, 2.76907e-06_r8, & + & 2.73433e-06_r8, 2.70002e-06_r8, 2.66614e-06_r8, 2.63269e-06_r8, 2.59966e-06_r8, & + & 2.56704e-06_r8, 2.53483e-06_r8, 2.50303e-06_r8, 2.47162e-06_r8/) + kbo_mo2(:, 3) = (/ & + & 2.91635e-06_r8, 2.88637e-06_r8, 2.85669e-06_r8, 2.82733e-06_r8, 2.79826e-06_r8, & + & 2.76949e-06_r8, 2.74102e-06_r8, 2.71284e-06_r8, 2.68495e-06_r8, 2.65735e-06_r8, & + & 2.63003e-06_r8, 2.60299e-06_r8, 2.57623e-06_r8, 2.54975e-06_r8, 2.52353e-06_r8, & + & 2.49759e-06_r8, 2.47191e-06_r8, 2.44650e-06_r8, 2.42135e-06_r8/) + kbo_mo2(:, 4) = (/ & + & 3.15584e-06_r8, 3.11986e-06_r8, 3.08430e-06_r8, 3.04914e-06_r8, 3.01438e-06_r8, & + & 2.98002e-06_r8, 2.94605e-06_r8, 2.91247e-06_r8, 2.87927e-06_r8, 2.84645e-06_r8, & + & 2.81400e-06_r8, 2.78192e-06_r8, 2.75021e-06_r8, 2.71886e-06_r8, 2.68787e-06_r8, & + & 2.65723e-06_r8, 2.62694e-06_r8, 2.59699e-06_r8, 2.56739e-06_r8/) + kbo_mo2(:, 5) = (/ & + & 2.52067e-06_r8, 2.50127e-06_r8, 2.48202e-06_r8, 2.46291e-06_r8, 2.44396e-06_r8, & + & 2.42515e-06_r8, 2.40648e-06_r8, 2.38796e-06_r8, 2.36958e-06_r8, 2.35134e-06_r8, & + & 2.33324e-06_r8, 2.31529e-06_r8, 2.29747e-06_r8, 2.27978e-06_r8, 2.26224e-06_r8, & + & 2.24482e-06_r8, 2.22755e-06_r8, 2.21040e-06_r8, 2.19339e-06_r8/) + kbo_mo2(:, 6) = (/ & + & 2.37304e-06_r8, 2.36340e-06_r8, 2.35380e-06_r8, 2.34423e-06_r8, 2.33471e-06_r8, & + & 2.32522e-06_r8, 2.31578e-06_r8, 2.30637e-06_r8, 2.29700e-06_r8, 2.28766e-06_r8, & + & 2.27837e-06_r8, 2.26911e-06_r8, 2.25989e-06_r8, 2.25071e-06_r8, 2.24157e-06_r8, & + & 2.23246e-06_r8, 2.22339e-06_r8, 2.21436e-06_r8, 2.20536e-06_r8/) + kbo_mo2(:, 7) = (/ & + & 2.56366e-06_r8, 2.56395e-06_r8, 2.56424e-06_r8, 2.56453e-06_r8, 2.56482e-06_r8, & + & 2.56510e-06_r8, 2.56539e-06_r8, 2.56568e-06_r8, 2.56597e-06_r8, 2.56625e-06_r8, & + & 2.56654e-06_r8, 2.56683e-06_r8, 2.56712e-06_r8, 2.56741e-06_r8, 2.56769e-06_r8, & + & 2.56798e-06_r8, 2.56827e-06_r8, 2.56856e-06_r8, 2.56885e-06_r8/) + kbo_mo2(:, 8) = (/ & + & 2.54502e-06_r8, 2.55393e-06_r8, 2.56287e-06_r8, 2.57185e-06_r8, 2.58085e-06_r8, & + & 2.58989e-06_r8, 2.59896e-06_r8, 2.60806e-06_r8, 2.61719e-06_r8, 2.62636e-06_r8, & + & 2.63555e-06_r8, 2.64478e-06_r8, 2.65404e-06_r8, 2.66334e-06_r8, 2.67266e-06_r8, & + & 2.68202e-06_r8, 2.69141e-06_r8, 2.70084e-06_r8, 2.71030e-06_r8/) + kbo_mo2(:, 9) = (/ & + & 1.84106e-06_r8, 1.83922e-06_r8, 1.83737e-06_r8, 1.83553e-06_r8, 1.83369e-06_r8, & + & 1.83186e-06_r8, 1.83002e-06_r8, 1.82819e-06_r8, 1.82636e-06_r8, 1.82453e-06_r8, & + & 1.82270e-06_r8, 1.82087e-06_r8, 1.81905e-06_r8, 1.81723e-06_r8, 1.81541e-06_r8, & + & 1.81359e-06_r8, 1.81177e-06_r8, 1.80996e-06_r8, 1.80814e-06_r8/) + kbo_mo2(:,10) = (/ & + & 1.83886e-06_r8, 1.83632e-06_r8, 1.83379e-06_r8, 1.83126e-06_r8, 1.82874e-06_r8, & + & 1.82622e-06_r8, 1.82370e-06_r8, 1.82119e-06_r8, 1.81868e-06_r8, 1.81617e-06_r8, & + & 1.81367e-06_r8, 1.81117e-06_r8, 1.80867e-06_r8, 1.80618e-06_r8, 1.80369e-06_r8, & + & 1.80120e-06_r8, 1.79872e-06_r8, 1.79624e-06_r8, 1.79377e-06_r8/) + kbo_mo2(:,11) = (/ & + & 2.30390e-06_r8, 2.30269e-06_r8, 2.30148e-06_r8, 2.30028e-06_r8, 2.29907e-06_r8, & + & 2.29787e-06_r8, 2.29667e-06_r8, 2.29546e-06_r8, 2.29426e-06_r8, 2.29306e-06_r8, & + & 2.29186e-06_r8, 2.29066e-06_r8, 2.28946e-06_r8, 2.28826e-06_r8, 2.28706e-06_r8, & + & 2.28586e-06_r8, 2.28466e-06_r8, 2.28347e-06_r8, 2.28227e-06_r8/) + kbo_mo2(:,12) = (/ & + & 2.38201e-06_r8, 2.36536e-06_r8, 2.34882e-06_r8, 2.33240e-06_r8, 2.31609e-06_r8, & + & 2.29990e-06_r8, 2.28382e-06_r8, 2.26785e-06_r8, 2.25199e-06_r8, 2.23625e-06_r8, & + & 2.22061e-06_r8, 2.20508e-06_r8, 2.18967e-06_r8, 2.17436e-06_r8, 2.15915e-06_r8, & + & 2.14406e-06_r8, 2.12907e-06_r8, 2.11418e-06_r8, 2.09940e-06_r8/) + kbo_mo2(:,13) = (/ & + & 2.33326e-06_r8, 2.32549e-06_r8, 2.31775e-06_r8, 2.31003e-06_r8, 2.30234e-06_r8, & + & 2.29467e-06_r8, 2.28703e-06_r8, 2.27941e-06_r8, 2.27182e-06_r8, 2.26426e-06_r8, & + & 2.25672e-06_r8, 2.24920e-06_r8, 2.24171e-06_r8, 2.23424e-06_r8, 2.22680e-06_r8, & + & 2.21939e-06_r8, 2.21200e-06_r8, 2.20463e-06_r8, 2.19729e-06_r8/) + kbo_mo2(:,14) = (/ & + & 2.75292e-06_r8, 2.75210e-06_r8, 2.75129e-06_r8, 2.75047e-06_r8, 2.74965e-06_r8, & + & 2.74883e-06_r8, 2.74801e-06_r8, 2.74720e-06_r8, 2.74638e-06_r8, 2.74556e-06_r8, & + & 2.74475e-06_r8, 2.74393e-06_r8, 2.74311e-06_r8, 2.74230e-06_r8, 2.74148e-06_r8, & + & 2.74067e-06_r8, 2.73985e-06_r8, 2.73904e-06_r8, 2.73822e-06_r8/) + kbo_mo2(:,15) = (/ & + & 2.55262e-06_r8, 2.53364e-06_r8, 2.51480e-06_r8, 2.49611e-06_r8, 2.47755e-06_r8, & + & 2.45913e-06_r8, 2.44084e-06_r8, 2.42269e-06_r8, 2.40468e-06_r8, 2.38680e-06_r8, & + & 2.36906e-06_r8, 2.35144e-06_r8, 2.33396e-06_r8, 2.31660e-06_r8, 2.29938e-06_r8, & + & 2.28228e-06_r8, 2.26531e-06_r8, 2.24847e-06_r8, 2.23175e-06_r8/) + kbo_mo2(:,16) = (/ & + & 3.11382e-06_r8, 3.08751e-06_r8, 3.06141e-06_r8, 3.03554e-06_r8, 3.00989e-06_r8, & + & 2.98445e-06_r8, 2.95923e-06_r8, 2.93422e-06_r8, 2.90942e-06_r8, 2.88483e-06_r8, & + & 2.86045e-06_r8, 2.83628e-06_r8, 2.81231e-06_r8, 2.78854e-06_r8, 2.76498e-06_r8, & + & 2.74161e-06_r8, 2.71844e-06_r8, 2.69547e-06_r8, 2.67269e-06_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &2.8858e-02_r8,3.6879e-02_r8,4.0746e-02_r8,4.2561e-02_r8,4.2740e-02_r8,4.2707e-02_r8, & + &4.4109e-02_r8,4.4540e-02_r8,4.5206e-02_r8,4.4679e-02_r8,4.5034e-02_r8,4.5364e-02_r8, & + &4.6790e-02_r8,4.7857e-02_r8,4.8328e-02_r8,4.8084e-02_r8/) + forrefo(2,:) = (/ & + &2.7887e-02_r8,3.7376e-02_r8,4.0980e-02_r8,4.2986e-02_r8,4.3054e-02_r8,4.2975e-02_r8, & + &4.3754e-02_r8,4.4352e-02_r8,4.4723e-02_r8,4.6236e-02_r8,4.5273e-02_r8,4.5360e-02_r8, & + &4.5332e-02_r8,4.7587e-02_r8,4.7035e-02_r8,5.0267e-02_r8/) + forrefo(3,:) = (/ & + &2.5846e-02_r8,3.6753e-02_r8,4.2334e-02_r8,4.3806e-02_r8,4.3848e-02_r8,4.3215e-02_r8, & + &4.3838e-02_r8,4.4278e-02_r8,4.4658e-02_r8,4.5403e-02_r8,4.5255e-02_r8,4.6347e-02_r8, & + &4.4722e-02_r8,4.6612e-02_r8,4.6836e-02_r8,4.8720e-02_r8/) + forrefo(4,:) = (/ & + &2.8955e-02_r8,3.7608e-02_r8,4.1989e-02_r8,4.4919e-02_r8,4.2803e-02_r8,4.2842e-02_r8, & + &4.2632e-02_r8,4.1056e-02_r8,4.0086e-02_r8,4.1401e-02_r8,4.2746e-02_r8,4.2142e-02_r8, & + &4.1871e-02_r8,4.3917e-02_r8,4.5462e-02_r8,4.8359e-02_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 5.96496e-01_r8, 5.49171e-01_r8, 5.05600e-01_r8, 4.65486e-01_r8, 4.28555e-01_r8, & + & 3.94554e-01_r8, 3.63250e-01_r8, 3.34430e-01_r8, 3.07897e-01_r8, 2.83468e-01_r8/) + selfrefo(:, 2) = (/ & + & 7.46455e-01_r8, 6.82459e-01_r8, 6.23950e-01_r8, 5.70457e-01_r8, 5.21550e-01_r8, & + & 4.76836e-01_r8, 4.35956e-01_r8, 3.98580e-01_r8, 3.64409e-01_r8, 3.33167e-01_r8/) + selfrefo(:, 3) = (/ & + & 7.86805e-01_r8, 7.21186e-01_r8, 6.61040e-01_r8, 6.05910e-01_r8, 5.55378e-01_r8, & + & 5.09059e-01_r8, 4.66605e-01_r8, 4.27690e-01_r8, 3.92021e-01_r8, 3.59327e-01_r8/) + selfrefo(:, 4) = (/ & + & 8.11740e-01_r8, 7.44359e-01_r8, 6.82570e-01_r8, 6.25910e-01_r8, 5.73954e-01_r8, & + & 5.26311e-01_r8, 4.82622e-01_r8, 4.42560e-01_r8, 4.05823e-01_r8, 3.72136e-01_r8/) + selfrefo(:, 5) = (/ & + & 8.14870e-01_r8, 7.47200e-01_r8, 6.85150e-01_r8, 6.28253e-01_r8, 5.76081e-01_r8, & + & 5.28241e-01_r8, 4.84374e-01_r8, 4.44150e-01_r8, 4.07266e-01_r8, 3.73446e-01_r8/) + selfrefo(:, 6) = (/ & + & 8.10104e-01_r8, 7.43259e-01_r8, 6.81930e-01_r8, 6.25661e-01_r8, 5.74035e-01_r8, & + & 5.26669e-01_r8, 4.83212e-01_r8, 4.43340e-01_r8, 4.06758e-01_r8, 3.73195e-01_r8/) + selfrefo(:, 7) = (/ & + & 8.13119e-01_r8, 7.48127e-01_r8, 6.88330e-01_r8, 6.33312e-01_r8, 5.82692e-01_r8, & + & 5.36118e-01_r8, 4.93267e-01_r8, 4.53840e-01_r8, 4.17565e-01_r8, 3.84189e-01_r8/) + selfrefo(:, 8) = (/ & + & 8.26137e-01_r8, 7.58984e-01_r8, 6.97290e-01_r8, 6.40611e-01_r8, 5.88539e-01_r8, & + & 5.40699e-01_r8, 4.96748e-01_r8, 4.56370e-01_r8, 4.19274e-01_r8, 3.85193e-01_r8/) + selfrefo(:, 9) = (/ & + & 8.30566e-01_r8, 7.63984e-01_r8, 7.02740e-01_r8, 6.46405e-01_r8, 5.94587e-01_r8, & + & 5.46922e-01_r8, 5.03079e-01_r8, 4.62750e-01_r8, 4.25654e-01_r8, 3.91532e-01_r8/) + selfrefo(:,10) = (/ & + & 8.67471e-01_r8, 7.91575e-01_r8, 7.22320e-01_r8, 6.59124e-01_r8, 6.01457e-01_r8, & + & 5.48835e-01_r8, 5.00817e-01_r8, 4.57000e-01_r8, 4.17017e-01_r8, 3.80532e-01_r8/) + selfrefo(:,11) = (/ & + & 8.51029e-01_r8, 7.79373e-01_r8, 7.13750e-01_r8, 6.53652e-01_r8, 5.98615e-01_r8, & + & 5.48212e-01_r8, 5.02053e-01_r8, 4.59780e-01_r8, 4.21067e-01_r8, 3.85613e-01_r8/) + selfrefo(:,12) = (/ & + & 8.36772e-01_r8, 7.68751e-01_r8, 7.06260e-01_r8, 6.48848e-01_r8, 5.96104e-01_r8, & + & 5.47647e-01_r8, 5.03129e-01_r8, 4.62230e-01_r8, 4.24655e-01_r8, 3.90136e-01_r8/) + selfrefo(:,13) = (/ & + & 8.36551e-01_r8, 7.71089e-01_r8, 7.10750e-01_r8, 6.55133e-01_r8, 6.03867e-01_r8, & + & 5.56614e-01_r8, 5.13058e-01_r8, 4.72910e-01_r8, 4.35904e-01_r8, 4.01794e-01_r8/) + selfrefo(:,14) = (/ & + & 8.84307e-01_r8, 8.11175e-01_r8, 7.44090e-01_r8, 6.82553e-01_r8, 6.26106e-01_r8, & + & 5.74326e-01_r8, 5.26829e-01_r8, 4.83260e-01_r8, 4.43294e-01_r8, 4.06633e-01_r8/) + selfrefo(:,15) = (/ & + & 8.90356e-01_r8, 8.19830e-01_r8, 7.54890e-01_r8, 6.95094e-01_r8, 6.40035e-01_r8, & + & 5.89337e-01_r8, 5.42655e-01_r8, 4.99670e-01_r8, 4.60090e-01_r8, 4.23646e-01_r8/) + selfrefo(:,16) = (/ & + & 9.67549e-01_r8, 8.79393e-01_r8, 7.99270e-01_r8, 7.26447e-01_r8, 6.60259e-01_r8, & + & 6.00101e-01_r8, 5.45425e-01_r8, 4.95730e-01_r8, 4.50563e-01_r8, 4.09511e-01_r8/) + + end subroutine lw_kgb11 + +! ************************************************************************** + subroutine lw_kgb12 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg12, only : fracrefao, kao, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 174.1640 mbar, T= 215.78 K + fracrefao(:, 1) = (/ & + & 1.3984e-01_r8,1.6809e-01_r8,1.8072e-01_r8,1.5400e-01_r8,1.2613e-01_r8,9.6959e-02_r8, & + & 5.9713e-02_r8,3.8631e-02_r8,2.6937e-02_r8,3.1711e-03_r8,2.3458e-03_r8,1.4653e-03_r8, & + & 1.0567e-03_r8,6.6504e-04_r8,2.4957e-04_r8,3.5172e-05_r8/) + fracrefao(:, 2) = (/ & + & 1.2745e-01_r8,1.6107e-01_r8,1.6568e-01_r8,1.5436e-01_r8,1.3183e-01_r8,1.0166e-01_r8, & + & 6.4506e-02_r8,4.7756e-02_r8,3.4472e-02_r8,3.7189e-03_r8,2.9349e-03_r8,2.1469e-03_r8, & + & 1.3746e-03_r8,7.1691e-04_r8,2.8057e-04_r8,5.6242e-05_r8/) + fracrefao(:, 3) = (/ & + & 1.2181e-01_r8,1.5404e-01_r8,1.6540e-01_r8,1.5255e-01_r8,1.3736e-01_r8,9.8856e-02_r8, & + & 6.8927e-02_r8,5.1385e-02_r8,3.7046e-02_r8,4.0302e-03_r8,3.0949e-03_r8,2.3772e-03_r8, & + & 1.6538e-03_r8,8.9641e-04_r8,4.6991e-04_r8,1.1251e-04_r8/) + fracrefao(:, 4) = (/ & + & 1.1794e-01_r8,1.4864e-01_r8,1.6316e-01_r8,1.5341e-01_r8,1.3986e-01_r8,9.6656e-02_r8, & + & 7.2478e-02_r8,5.5061e-02_r8,3.8886e-02_r8,4.3398e-03_r8,3.3576e-03_r8,2.4891e-03_r8, & + & 1.7674e-03_r8,1.0764e-03_r8,7.7689e-04_r8,1.1251e-04_r8/) + fracrefao(:, 5) = (/ & + & 1.1635e-01_r8,1.4342e-01_r8,1.5924e-01_r8,1.5670e-01_r8,1.3740e-01_r8,9.7087e-02_r8, & + & 7.6250e-02_r8,5.7802e-02_r8,4.0808e-02_r8,4.4113e-03_r8,3.6035e-03_r8,2.6269e-03_r8, & + & 1.7586e-03_r8,1.6498e-03_r8,7.7689e-04_r8,1.1251e-04_r8/) + fracrefao(:, 6) = (/ & + & 1.1497e-01_r8,1.3751e-01_r8,1.5587e-01_r8,1.5904e-01_r8,1.3140e-01_r8,1.0159e-01_r8, & + & 7.9729e-02_r8,6.1475e-02_r8,4.2382e-02_r8,4.5291e-03_r8,3.8161e-03_r8,2.7683e-03_r8, & + & 1.9899e-03_r8,2.0395e-03_r8,7.7720e-04_r8,1.1251e-04_r8/) + fracrefao(:, 7) = (/ & + & 1.1331e-01_r8,1.3015e-01_r8,1.5574e-01_r8,1.5489e-01_r8,1.2697e-01_r8,1.0746e-01_r8, & + & 8.4777e-02_r8,6.5145e-02_r8,4.4293e-02_r8,4.7426e-03_r8,3.8383e-03_r8,2.9065e-03_r8, & + & 2.8430e-03_r8,2.0401e-03_r8,7.7689e-04_r8,1.1251e-04_r8/) + fracrefao(:, 8) = (/ & + & 1.0993e-01_r8,1.2320e-01_r8,1.4893e-01_r8,1.4573e-01_r8,1.3174e-01_r8,1.1149e-01_r8, & + & 9.3326e-02_r8,6.9942e-02_r8,4.6762e-02_r8,4.9309e-03_r8,3.8583e-03_r8,4.1889e-03_r8, & + & 3.0415e-03_r8,2.0406e-03_r8,7.7720e-04_r8,1.1251e-04_r8/) + fracrefao(:, 9) = (/ & + & 1.2028e-01_r8,1.2091e-01_r8,1.3098e-01_r8,1.3442e-01_r8,1.3574e-01_r8,1.1739e-01_r8, & + & 9.5343e-02_r8,7.0224e-02_r8,5.3456e-02_r8,6.0206e-03_r8,5.0758e-03_r8,4.1906e-03_r8, & + & 3.0431e-03_r8,2.0400e-03_r8,7.7689e-04_r8,1.1251e-04_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &1.7511e-07_r8,6.8135e-05_r8,1.1804e-04_r8,1.6931e-04_r8,2.2006e-04_r8,2.8275e-04_r8, & + &3.5722e-04_r8,4.9530e-04_r8,3.5719e-04_r8/) + kao(:, 2, 1, 1) = (/ & + &1.9831e-07_r8,7.7459e-05_r8,1.3459e-04_r8,1.9095e-04_r8,2.5338e-04_r8,3.1724e-04_r8, & + &4.1347e-04_r8,5.5823e-04_r8,4.1876e-04_r8/) + kao(:, 3, 1, 1) = (/ & + &2.2440e-07_r8,8.7653e-05_r8,1.5288e-04_r8,2.1636e-04_r8,2.8321e-04_r8,3.6387e-04_r8, & + &4.5547e-04_r8,6.4036e-04_r8,4.9001e-04_r8/) + kao(:, 4, 1, 1) = (/ & + &2.4907e-07_r8,9.8921e-05_r8,1.7279e-04_r8,2.4495e-04_r8,3.1911e-04_r8,4.0317e-04_r8, & + &5.1922e-04_r8,7.1060e-04_r8,5.5803e-04_r8/) + kao(:, 5, 1, 1) = (/ & + &2.7577e-07_r8,1.1088e-04_r8,1.9448e-04_r8,2.7670e-04_r8,3.6112e-04_r8,4.5291e-04_r8, & + &5.7232e-04_r8,7.9647e-04_r8,6.3718e-04_r8/) + kao(:, 1, 2, 1) = (/ & + &2.1743e-07_r8,5.9697e-05_r8,1.0011e-04_r8,1.3856e-04_r8,1.7837e-04_r8,2.1937e-04_r8, & + &2.7665e-04_r8,3.5934e-04_r8,2.6865e-04_r8/) + kao(:, 2, 2, 1) = (/ & + &2.4689e-07_r8,6.8199e-05_r8,1.1473e-04_r8,1.5826e-04_r8,2.0299e-04_r8,2.5265e-04_r8, & + &3.0999e-04_r8,4.0941e-04_r8,3.2103e-04_r8/) + kao(:, 3, 2, 1) = (/ & + &2.7759e-07_r8,7.7428e-05_r8,1.3086e-04_r8,1.8044e-04_r8,2.2946e-04_r8,2.8434e-04_r8, & + &3.5412e-04_r8,4.7313e-04_r8,3.7455e-04_r8/) + kao(:, 4, 2, 1) = (/ & + &3.1162e-07_r8,8.7312e-05_r8,1.4837e-04_r8,2.0486e-04_r8,2.6086e-04_r8,3.2026e-04_r8, & + &3.9490e-04_r8,5.1882e-04_r8,4.3142e-04_r8/) + kao(:, 5, 2, 1) = (/ & + &3.4483e-07_r8,9.7902e-05_r8,1.6760e-04_r8,2.3163e-04_r8,2.9600e-04_r8,3.6332e-04_r8, & + &4.4224e-04_r8,5.8485e-04_r8,4.9654e-04_r8/) + kao(:, 1, 3, 1) = (/ & + &3.5522e-07_r8,5.4633e-05_r8,8.9953e-05_r8,1.1946e-04_r8,1.4735e-04_r8,1.7547e-04_r8, & + &2.0438e-04_r8,2.5064e-04_r8,1.9532e-04_r8/) + kao(:, 2, 3, 1) = (/ & + &4.0312e-07_r8,6.2965e-05_r8,1.0335e-04_r8,1.3746e-04_r8,1.6817e-04_r8,1.9939e-04_r8, & + &2.3562e-04_r8,2.9335e-04_r8,2.3482e-04_r8/) + kao(:, 3, 3, 1) = (/ & + &4.5344e-07_r8,7.1817e-05_r8,1.1822e-04_r8,1.5709e-04_r8,1.9287e-04_r8,2.2736e-04_r8, & + &2.6619e-04_r8,3.2521e-04_r8,2.7722e-04_r8/) + kao(:, 4, 3, 1) = (/ & + &5.1341e-07_r8,8.1197e-05_r8,1.3399e-04_r8,1.7909e-04_r8,2.2021e-04_r8,2.5936e-04_r8, & + &3.0089e-04_r8,3.7007e-04_r8,3.2243e-04_r8/) + kao(:, 5, 3, 1) = (/ & + &5.7093e-07_r8,9.0935e-05_r8,1.5129e-04_r8,2.0303e-04_r8,2.4981e-04_r8,2.9482e-04_r8, & + &3.4243e-04_r8,4.0910e-04_r8,3.7408e-04_r8/) + kao(:, 1, 4, 1) = (/ & + &5.9029e-07_r8,4.8269e-05_r8,8.1661e-05_r8,1.0687e-04_r8,1.2826e-04_r8,1.4610e-04_r8, & + &1.6333e-04_r8,1.8670e-04_r8,1.4151e-04_r8/) + kao(:, 2, 4, 1) = (/ & + &6.7060e-07_r8,5.6349e-05_r8,9.4916e-05_r8,1.2365e-04_r8,1.4803e-04_r8,1.6776e-04_r8, & + &1.8719e-04_r8,2.1036e-04_r8,1.7196e-04_r8/) + kao(:, 3, 4, 1) = (/ & + &7.5759e-07_r8,6.4869e-05_r8,1.0916e-04_r8,1.4206e-04_r8,1.6962e-04_r8,1.9348e-04_r8, & + &2.1325e-04_r8,2.4238e-04_r8,2.0611e-04_r8/) + kao(:, 4, 4, 1) = (/ & + &8.5937e-07_r8,7.4063e-05_r8,1.2416e-04_r8,1.6207e-04_r8,1.9412e-04_r8,2.2126e-04_r8, & + &2.4479e-04_r8,2.7146e-04_r8,2.4157e-04_r8/) + kao(:, 5, 4, 1) = (/ & + &9.5897e-07_r8,8.3687e-05_r8,1.3973e-04_r8,1.8364e-04_r8,2.2051e-04_r8,2.5234e-04_r8, & + &2.7911e-04_r8,3.0928e-04_r8,2.8248e-04_r8/) + kao(:, 1, 5, 1) = (/ & + &9.1759e-07_r8,4.1947e-05_r8,7.0794e-05_r8,9.4885e-05_r8,1.1243e-04_r8,1.2599e-04_r8, & + &1.3683e-04_r8,1.4293e-04_r8,1.0336e-04_r8/) + kao(:, 2, 5, 1) = (/ & + &1.0425e-06_r8,4.9113e-05_r8,8.3728e-05_r8,1.1140e-04_r8,1.3168e-04_r8,1.4605e-04_r8, & + &1.5650e-04_r8,1.6563e-04_r8,1.2713e-04_r8/) + kao(:, 3, 5, 1) = (/ & + &1.1835e-06_r8,5.7263e-05_r8,9.7394e-05_r8,1.2924e-04_r8,1.5190e-04_r8,1.6881e-04_r8, & + &1.8096e-04_r8,1.8906e-04_r8,1.5436e-04_r8/) + kao(:, 4, 5, 1) = (/ & + &1.3393e-06_r8,6.6178e-05_r8,1.1132e-04_r8,1.4759e-04_r8,1.7411e-04_r8,1.9396e-04_r8, & + &2.0764e-04_r8,2.1628e-04_r8,1.8190e-04_r8/) + kao(:, 5, 5, 1) = (/ & + &1.4988e-06_r8,7.5103e-05_r8,1.2617e-04_r8,1.6721e-04_r8,1.9778e-04_r8,2.2104e-04_r8, & + &2.3789e-04_r8,2.4796e-04_r8,2.1416e-04_r8/) + kao(:, 1, 6, 1) = (/ & + &1.3509e-06_r8,3.6190e-05_r8,6.0186e-05_r8,8.0089e-05_r8,9.7447e-05_r8,1.0817e-04_r8, & + &1.1477e-04_r8,1.1459e-04_r8,7.5216e-05_r8/) + kao(:, 2, 6, 1) = (/ & + &1.5379e-06_r8,4.3048e-05_r8,7.1223e-05_r8,9.5429e-05_r8,1.1555e-04_r8,1.2778e-04_r8, & + &1.3385e-04_r8,1.3550e-04_r8,9.3747e-05_r8/) + kao(:, 3, 6, 1) = (/ & + &1.7505e-06_r8,5.0649e-05_r8,8.3443e-05_r8,1.1225e-04_r8,1.3468e-04_r8,1.4925e-04_r8, & + &1.5516e-04_r8,1.5522e-04_r8,1.1566e-04_r8/) + kao(:, 4, 6, 1) = (/ & + &1.9769e-06_r8,5.8613e-05_r8,9.7176e-05_r8,1.2952e-04_r8,1.5512e-04_r8,1.7221e-04_r8, & + &1.7952e-04_r8,1.7884e-04_r8,1.3754e-04_r8/) + kao(:, 5, 6, 1) = (/ & + &2.2201e-06_r8,6.7356e-05_r8,1.1202e-04_r8,1.4825e-04_r8,1.7722e-04_r8,1.9650e-04_r8, & + &2.0554e-04_r8,2.0495e-04_r8,1.6355e-04_r8/) + kao(:, 1, 7, 1) = (/ & + &2.1304e-06_r8,3.3089e-05_r8,5.1849e-05_r8,6.8730e-05_r8,8.2305e-05_r8,9.3472e-05_r8, & + &9.9164e-05_r8,9.8631e-05_r8,5.9418e-05_r8/) + kao(:, 2, 7, 1) = (/ & + &2.4308e-06_r8,3.9636e-05_r8,6.2051e-05_r8,8.1968e-05_r8,9.8909e-05_r8,1.1256e-04_r8, & + &1.1810e-04_r8,1.1396e-04_r8,7.5269e-05_r8/) + kao(:, 3, 7, 1) = (/ & + &2.7537e-06_r8,4.6821e-05_r8,7.3795e-05_r8,9.6812e-05_r8,1.1738e-04_r8,1.3274e-04_r8, & + &1.3903e-04_r8,1.3282e-04_r8,9.2641e-05_r8/) + kao(:, 4, 7, 1) = (/ & + &3.1212e-06_r8,5.4439e-05_r8,8.6765e-05_r8,1.1374e-04_r8,1.3694e-04_r8,1.5474e-04_r8, & + &1.6192e-04_r8,1.5375e-04_r8,1.1184e-04_r8/) + kao(:, 5, 7, 1) = (/ & + &3.5210e-06_r8,6.2611e-05_r8,9.9782e-05_r8,1.3214e-04_r8,1.5850e-04_r8,1.7752e-04_r8, & + &1.8622e-04_r8,1.7734e-04_r8,1.3357e-04_r8/) + kao(:, 1, 8, 1) = (/ & + &4.1180e-06_r8,3.5356e-05_r8,4.9875e-05_r8,6.2112e-05_r8,7.3272e-05_r8,8.1665e-05_r8, & + &8.7559e-05_r8,8.6370e-05_r8,4.9881e-05_r8/) + kao(:, 2, 8, 1) = (/ & + &4.6880e-06_r8,4.2308e-05_r8,6.0139e-05_r8,7.5108e-05_r8,8.8001e-05_r8,9.9269e-05_r8, & + &1.0597e-04_r8,1.0409e-04_r8,6.3232e-05_r8/) + kao(:, 3, 8, 1) = (/ & + &5.2893e-06_r8,4.9705e-05_r8,7.1733e-05_r8,8.9997e-05_r8,1.0540e-04_r8,1.1807e-04_r8, & + &1.2729e-04_r8,1.2367e-04_r8,7.9488e-05_r8/) + kao(:, 4, 8, 1) = (/ & + &5.9934e-06_r8,5.7629e-05_r8,8.3852e-05_r8,1.0617e-04_r8,1.2505e-04_r8,1.3960e-04_r8, & + &1.5001e-04_r8,1.4519e-04_r8,9.7332e-05_r8/) + kao(:, 5, 8, 1) = (/ & + &6.8016e-06_r8,6.6193e-05_r8,9.7237e-05_r8,1.2349e-04_r8,1.4561e-04_r8,1.6359e-04_r8, & + &1.7405e-04_r8,1.6782e-04_r8,1.1691e-04_r8/) + kao(:, 1, 9, 1) = (/ & + &1.5173e-05_r8,6.0073e-05_r8,7.5522e-05_r8,8.4608e-05_r8,8.9391e-05_r8,9.1045e-05_r8, & + &9.0015e-05_r8,8.5089e-05_r8,6.2916e-05_r8/) + kao(:, 2, 9, 1) = (/ & + &1.7118e-05_r8,7.2165e-05_r8,9.0975e-05_r8,1.0209e-04_r8,1.0823e-04_r8,1.1031e-04_r8, & + &1.0910e-04_r8,1.0450e-04_r8,8.0378e-05_r8/) + kao(:, 3, 9, 1) = (/ & + &1.9333e-05_r8,8.4779e-05_r8,1.0715e-04_r8,1.2042e-04_r8,1.2865e-04_r8,1.3251e-04_r8, & + &1.3198e-04_r8,1.2575e-04_r8,1.0185e-04_r8/) + kao(:, 4, 9, 1) = (/ & + &2.2020e-05_r8,9.7885e-05_r8,1.2402e-04_r8,1.4031e-04_r8,1.5091e-04_r8,1.5615e-04_r8, & + &1.5775e-04_r8,1.5010e-04_r8,1.2495e-04_r8/) + kao(:, 5, 9, 1) = (/ & + &2.4990e-05_r8,1.1102e-04_r8,1.4167e-04_r8,1.6181e-04_r8,1.7511e-04_r8,1.8231e-04_r8, & + &1.8406e-04_r8,1.7738e-04_r8,1.4891e-04_r8/) + kao(:, 1,10, 1) = (/ & + &6.3843e-05_r8,1.3785e-04_r8,1.5635e-04_r8,1.6287e-04_r8,1.6037e-04_r8,1.5248e-04_r8, & + &1.3606e-04_r8,1.0761e-04_r8,1.0144e-04_r8/) + kao(:, 2,10, 1) = (/ & + &7.2156e-05_r8,1.6111e-04_r8,1.8530e-04_r8,1.9419e-04_r8,1.9482e-04_r8,1.8548e-04_r8, & + &1.6571e-04_r8,1.3139e-04_r8,1.2609e-04_r8/) + kao(:, 3,10, 1) = (/ & + &8.1633e-05_r8,1.8623e-04_r8,2.1467e-04_r8,2.2993e-04_r8,2.3146e-04_r8,2.2096e-04_r8, & + &1.9656e-04_r8,1.5757e-04_r8,1.5350e-04_r8/) + kao(:, 4,10, 1) = (/ & + &9.2413e-05_r8,2.1393e-04_r8,2.4898e-04_r8,2.6688e-04_r8,2.6838e-04_r8,2.5715e-04_r8, & + &2.2901e-04_r8,1.8640e-04_r8,1.8257e-04_r8/) + kao(:, 5,10, 1) = (/ & + &1.0426e-04_r8,2.4538e-04_r8,2.8330e-04_r8,3.0298e-04_r8,3.0752e-04_r8,2.9416e-04_r8, & + &2.6511e-04_r8,2.1835e-04_r8,2.1288e-04_r8/) + kao(:, 1,11, 1) = (/ & + &9.9914e-05_r8,1.8204e-04_r8,1.9923e-04_r8,2.0432e-04_r8,1.9733e-04_r8,1.8201e-04_r8, & + &1.5904e-04_r8,1.2299e-04_r8,1.0910e-04_r8/) + kao(:, 2,11, 1) = (/ & + &1.1199e-04_r8,2.1265e-04_r8,2.3389e-04_r8,2.4089e-04_r8,2.3442e-04_r8,2.2069e-04_r8, & + &1.9371e-04_r8,1.4882e-04_r8,1.3411e-04_r8/) + kao(:, 3,11, 1) = (/ & + &1.2687e-04_r8,2.4499e-04_r8,2.7026e-04_r8,2.7909e-04_r8,2.7675e-04_r8,2.6044e-04_r8, & + &2.2915e-04_r8,1.7718e-04_r8,1.6026e-04_r8/) + kao(:, 4,11, 1) = (/ & + &1.4261e-04_r8,2.8101e-04_r8,3.1141e-04_r8,3.2255e-04_r8,3.1948e-04_r8,3.0150e-04_r8, & + &2.6612e-04_r8,2.0752e-04_r8,1.8601e-04_r8/) + kao(:, 5,11, 1) = (/ & + &1.5789e-04_r8,3.1929e-04_r8,3.5513e-04_r8,3.6602e-04_r8,3.6282e-04_r8,3.4410e-04_r8, & + &3.0577e-04_r8,2.4097e-04_r8,2.1352e-04_r8/) + kao(:, 1,12, 1) = (/ & + &1.1122e-04_r8,1.9022e-04_r8,2.0568e-04_r8,2.0798e-04_r8,2.0013e-04_r8,1.8369e-04_r8, & + &1.5756e-04_r8,1.2037e-04_r8,1.0098e-04_r8/) + kao(:, 2,12, 1) = (/ & + &1.2500e-04_r8,2.2156e-04_r8,2.4046e-04_r8,2.4347e-04_r8,2.3764e-04_r8,2.2116e-04_r8, & + &1.9272e-04_r8,1.4643e-04_r8,1.2390e-04_r8/) + kao(:, 3,12, 1) = (/ & + &1.4056e-04_r8,2.5489e-04_r8,2.7764e-04_r8,2.8122e-04_r8,2.7905e-04_r8,2.5886e-04_r8, & + &2.2636e-04_r8,1.7352e-04_r8,1.4664e-04_r8/) + kao(:, 4,12, 1) = (/ & + &1.5858e-04_r8,2.9021e-04_r8,3.1841e-04_r8,3.2551e-04_r8,3.1903e-04_r8,2.9848e-04_r8, & + &2.6254e-04_r8,2.0265e-04_r8,1.7061e-04_r8/) + kao(:, 5,12, 1) = (/ & + &1.7398e-04_r8,3.2750e-04_r8,3.6207e-04_r8,3.6880e-04_r8,3.6058e-04_r8,3.3907e-04_r8, & + &2.9970e-04_r8,2.3401e-04_r8,1.9575e-04_r8/) + kao(:, 1,13, 1) = (/ & + &9.9982e-05_r8,1.6786e-04_r8,1.8157e-04_r8,1.8311e-04_r8,1.7732e-04_r8,1.6257e-04_r8, & + &1.4107e-04_r8,1.0684e-04_r8,8.8282e-05_r8/) + kao(:, 2,13, 1) = (/ & + &1.1208e-04_r8,1.9489e-04_r8,2.1207e-04_r8,2.1420e-04_r8,2.0856e-04_r8,1.9501e-04_r8, & + &1.6942e-04_r8,1.2896e-04_r8,1.0706e-04_r8/) + kao(:, 3,13, 1) = (/ & + &1.2580e-04_r8,2.2390e-04_r8,2.4368e-04_r8,2.4899e-04_r8,2.4426e-04_r8,2.2695e-04_r8, & + &1.9796e-04_r8,1.5273e-04_r8,1.2657e-04_r8/) + kao(:, 4,13, 1) = (/ & + &1.4115e-04_r8,2.5382e-04_r8,2.8079e-04_r8,2.8499e-04_r8,2.7843e-04_r8,2.6072e-04_r8, & + &2.2903e-04_r8,1.7905e-04_r8,1.4711e-04_r8/) + kao(:, 5,13, 1) = (/ & + &1.5465e-04_r8,2.8798e-04_r8,3.1774e-04_r8,3.2258e-04_r8,3.1431e-04_r8,2.9430e-04_r8, & + &2.6133e-04_r8,2.0499e-04_r8,1.6802e-04_r8/) + kao(:, 1, 1, 2) = (/ & + &3.7683e-07_r8,1.9808e-04_r8,3.6685e-04_r8,5.3916e-04_r8,7.1167e-04_r8,8.9309e-04_r8, & + &1.1251e-03_r8,1.6060e-03_r8,1.3216e-03_r8/) + kao(:, 2, 1, 2) = (/ & + &4.2181e-07_r8,2.2081e-04_r8,4.0843e-04_r8,6.0005e-04_r8,7.9854e-04_r8,1.0235e-03_r8, & + &1.2747e-03_r8,1.7730e-03_r8,1.5072e-03_r8/) + kao(:, 3, 1, 2) = (/ & + &4.6205e-07_r8,2.4503e-04_r8,4.5395e-04_r8,6.6471e-04_r8,8.8503e-04_r8,1.1345e-03_r8, & + &1.4567e-03_r8,1.9804e-03_r8,1.6670e-03_r8/) + kao(:, 4, 1, 2) = (/ & + &5.1491e-07_r8,2.7069e-04_r8,5.0378e-04_r8,7.3699e-04_r8,9.7626e-04_r8,1.2446e-03_r8, & + &1.5952e-03_r8,2.2188e-03_r8,1.8463e-03_r8/) + kao(:, 5, 1, 2) = (/ & + &5.5977e-07_r8,2.9608e-04_r8,5.5719e-04_r8,8.1557e-04_r8,1.0806e-03_r8,1.3738e-03_r8, & + &1.7497e-03_r8,2.4313e-03_r8,2.0562e-03_r8/) + kao(:, 1, 2, 2) = (/ & + &4.7123e-07_r8,1.6943e-04_r8,3.0287e-04_r8,4.3680e-04_r8,5.7665e-04_r8,7.0994e-04_r8, & + &8.5911e-04_r8,1.1308e-03_r8,1.0172e-03_r8/) + kao(:, 2, 2, 2) = (/ & + &5.2931e-07_r8,1.8961e-04_r8,3.3976e-04_r8,4.8868e-04_r8,6.4337e-04_r8,8.0862e-04_r8, & + &9.8935e-04_r8,1.2742e-03_r8,1.1602e-03_r8/) + kao(:, 3, 2, 2) = (/ & + &5.8844e-07_r8,2.1120e-04_r8,3.7935e-04_r8,5.4606e-04_r8,7.1722e-04_r8,8.9758e-04_r8, & + &1.1168e-03_r8,1.4348e-03_r8,1.3002e-03_r8/) + kao(:, 4, 2, 2) = (/ & + &6.4390e-07_r8,2.3336e-04_r8,4.2266e-04_r8,6.0899e-04_r8,7.9911e-04_r8,9.9511e-04_r8, & + &1.2304e-03_r8,1.6357e-03_r8,1.4539e-03_r8/) + kao(:, 5, 2, 2) = (/ & + &7.0717e-07_r8,2.5573e-04_r8,4.6939e-04_r8,6.7801e-04_r8,8.8876e-04_r8,1.1052e-03_r8, & + &1.3595e-03_r8,1.7810e-03_r8,1.6268e-03_r8/) + kao(:, 1, 3, 2) = (/ & + &7.7382e-07_r8,1.5592e-04_r8,2.6004e-04_r8,3.5917e-04_r8,4.5597e-04_r8,5.6221e-04_r8, & + &6.6191e-04_r8,7.8092e-04_r8,7.5320e-04_r8/) + kao(:, 2, 3, 2) = (/ & + &8.7904e-07_r8,1.7462e-04_r8,2.9301e-04_r8,4.0553e-04_r8,5.1639e-04_r8,6.3236e-04_r8, & + &7.5999e-04_r8,8.9592e-04_r8,8.6804e-04_r8/) + kao(:, 3, 3, 2) = (/ & + &9.8281e-07_r8,1.9263e-04_r8,3.2870e-04_r8,4.5631e-04_r8,5.8039e-04_r8,7.0848e-04_r8, & + &8.4867e-04_r8,1.0369e-03_r8,9.8463e-04_r8/) + kao(:, 4, 3, 2) = (/ & + &1.0791e-06_r8,2.1196e-04_r8,3.6740e-04_r8,5.1125e-04_r8,6.5128e-04_r8,7.9536e-04_r8, & + &9.4873e-04_r8,1.1498e-03_r8,1.1137e-03_r8/) + kao(:, 5, 3, 2) = (/ & + &1.1811e-06_r8,2.3314e-04_r8,4.0444e-04_r8,5.7096e-04_r8,7.2953e-04_r8,8.9019e-04_r8, & + &1.0598e-03_r8,1.2765e-03_r8,1.2563e-03_r8/) + kao(:, 1, 4, 2) = (/ & + &1.2931e-06_r8,1.5459e-04_r8,2.3712e-04_r8,3.1151e-04_r8,3.8051e-04_r8,4.4732e-04_r8, & + &5.1939e-04_r8,5.8139e-04_r8,5.5932e-04_r8/) + kao(:, 2, 4, 2) = (/ & + &1.4961e-06_r8,1.6924e-04_r8,2.6743e-04_r8,3.5309e-04_r8,4.3277e-04_r8,5.1005e-04_r8, & + &5.8720e-04_r8,6.8557e-04_r8,6.5449e-04_r8/) + kao(:, 3, 4, 2) = (/ & + &1.6687e-06_r8,1.8668e-04_r8,2.9946e-04_r8,3.9815e-04_r8,4.8978e-04_r8,5.7712e-04_r8, & + &6.6568e-04_r8,7.7293e-04_r8,7.4803e-04_r8/) + kao(:, 4, 4, 2) = (/ & + &1.8491e-06_r8,2.0517e-04_r8,3.2982e-04_r8,4.4741e-04_r8,5.5202e-04_r8,6.5205e-04_r8, & + &7.5198e-04_r8,8.7064e-04_r8,8.5540e-04_r8/) + kao(:, 5, 4, 2) = (/ & + &2.0324e-06_r8,2.2162e-04_r8,3.6469e-04_r8,4.9544e-04_r8,6.1968e-04_r8,7.3378e-04_r8, & + &8.4769e-04_r8,9.7614e-04_r8,9.7197e-04_r8/) + kao(:, 1, 5, 2) = (/ & + &2.0065e-06_r8,1.5150e-04_r8,2.2968e-04_r8,2.8386e-04_r8,3.3168e-04_r8,3.7581e-04_r8, & + &4.1489e-04_r8,4.5675e-04_r8,4.1358e-04_r8/) + kao(:, 2, 5, 2) = (/ & + &2.3252e-06_r8,1.6854e-04_r8,2.5480e-04_r8,3.2081e-04_r8,3.7754e-04_r8,4.3026e-04_r8, & + &4.7606e-04_r8,5.2820e-04_r8,4.9368e-04_r8/) + kao(:, 3, 5, 2) = (/ & + &2.6085e-06_r8,1.8331e-04_r8,2.8033e-04_r8,3.6056e-04_r8,4.2825e-04_r8,4.8928e-04_r8, & + &5.4309e-04_r8,5.9807e-04_r8,5.6993e-04_r8/) + kao(:, 4, 5, 2) = (/ & + &2.9132e-06_r8,1.9761e-04_r8,3.1015e-04_r8,3.9882e-04_r8,4.8412e-04_r8,5.5460e-04_r8, & + &6.1782e-04_r8,6.7980e-04_r8,6.5837e-04_r8/) + kao(:, 5, 5, 2) = (/ & + &3.2361e-06_r8,2.1434e-04_r8,3.4118e-04_r8,4.4180e-04_r8,5.3752e-04_r8,6.2588e-04_r8, & + &6.9930e-04_r8,7.7113e-04_r8,7.5327e-04_r8/) + kao(:, 1, 6, 2) = (/ & + &2.9230e-06_r8,1.3806e-04_r8,2.1835e-04_r8,2.7095e-04_r8,3.0194e-04_r8,3.2758e-04_r8, & + &3.4587e-04_r8,3.6408e-04_r8,3.0468e-04_r8/) + kao(:, 2, 6, 2) = (/ & + &3.4021e-06_r8,1.5365e-04_r8,2.4578e-04_r8,3.0400e-04_r8,3.4286e-04_r8,3.7318e-04_r8, & + &3.9861e-04_r8,4.1438e-04_r8,3.7021e-04_r8/) + kao(:, 3, 6, 2) = (/ & + &3.8620e-06_r8,1.7051e-04_r8,2.7334e-04_r8,3.3438e-04_r8,3.8715e-04_r8,4.2432e-04_r8, & + &4.5662e-04_r8,4.7772e-04_r8,4.3260e-04_r8/) + kao(:, 4, 6, 2) = (/ & + &4.2870e-06_r8,1.8887e-04_r8,2.9668e-04_r8,3.7137e-04_r8,4.2886e-04_r8,4.8133e-04_r8, & + &5.2053e-04_r8,5.4689e-04_r8,5.0258e-04_r8/) + kao(:, 5, 6, 2) = (/ & + &4.8423e-06_r8,2.0662e-04_r8,3.1977e-04_r8,4.1089e-04_r8,4.7609e-04_r8,5.3742e-04_r8, & + &5.9126e-04_r8,6.2337e-04_r8,5.7823e-04_r8/) + kao(:, 1, 7, 2) = (/ & + &4.5404e-06_r8,1.3143e-04_r8,2.0727e-04_r8,2.6052e-04_r8,2.9635e-04_r8,3.0743e-04_r8, & + &3.0825e-04_r8,2.9703e-04_r8,2.2197e-04_r8/) + kao(:, 2, 7, 2) = (/ & + &5.2640e-06_r8,1.4772e-04_r8,2.3068e-04_r8,2.9687e-04_r8,3.3184e-04_r8,3.4986e-04_r8, & + &3.5249e-04_r8,3.4543e-04_r8,2.7330e-04_r8/) + kao(:, 3, 7, 2) = (/ & + &6.0466e-06_r8,1.6470e-04_r8,2.5696e-04_r8,3.3234e-04_r8,3.6914e-04_r8,3.9626e-04_r8, & + &4.0246e-04_r8,3.9902e-04_r8,3.2329e-04_r8/) + kao(:, 4, 7, 2) = (/ & + &6.7565e-06_r8,1.8107e-04_r8,2.8421e-04_r8,3.6286e-04_r8,4.1183e-04_r8,4.3876e-04_r8, & + &4.5748e-04_r8,4.5835e-04_r8,3.7913e-04_r8/) + kao(:, 5, 7, 2) = (/ & + &7.6474e-06_r8,1.9867e-04_r8,3.1475e-04_r8,3.9310e-04_r8,4.5438e-04_r8,4.8957e-04_r8, & + &5.1385e-04_r8,5.2320e-04_r8,4.4016e-04_r8/) + kao(:, 1, 8, 2) = (/ & + &8.6520e-06_r8,1.4110e-04_r8,2.0496e-04_r8,2.5993e-04_r8,2.9742e-04_r8,3.1821e-04_r8, & + &3.1456e-04_r8,2.7649e-04_r8,1.8485e-04_r8/) + kao(:, 2, 8, 2) = (/ & + &1.0009e-05_r8,1.5517e-04_r8,2.3206e-04_r8,2.9171e-04_r8,3.4405e-04_r8,3.6414e-04_r8, & + &3.5939e-04_r8,3.1713e-04_r8,2.2424e-04_r8/) + kao(:, 3, 8, 2) = (/ & + &1.1509e-05_r8,1.7205e-04_r8,2.6018e-04_r8,3.2636e-04_r8,3.8244e-04_r8,4.1241e-04_r8, & + &4.0304e-04_r8,3.6377e-04_r8,2.6821e-04_r8/) + kao(:, 4, 8, 2) = (/ & + &1.3117e-05_r8,1.8959e-04_r8,2.8945e-04_r8,3.6544e-04_r8,4.2147e-04_r8,4.5788e-04_r8, & + &4.4922e-04_r8,4.1527e-04_r8,3.1806e-04_r8/) + kao(:, 5, 8, 2) = (/ & + &1.4790e-05_r8,2.0902e-04_r8,3.1840e-04_r8,4.0603e-04_r8,4.6521e-04_r8,4.9945e-04_r8, & + &5.0220e-04_r8,4.7045e-04_r8,3.7190e-04_r8/) + kao(:, 1, 9, 2) = (/ & + &3.0998e-05_r8,2.0637e-04_r8,2.7947e-04_r8,3.3530e-04_r8,3.6480e-04_r8,3.8205e-04_r8, & + &3.8653e-04_r8,3.4762e-04_r8,1.8242e-04_r8/) + kao(:, 2, 9, 2) = (/ & + &3.6096e-05_r8,2.3076e-04_r8,3.1240e-04_r8,3.7284e-04_r8,4.1471e-04_r8,4.3432e-04_r8, & + &4.4125e-04_r8,4.0372e-04_r8,2.2363e-04_r8/) + kao(:, 3, 9, 2) = (/ & + &4.2035e-05_r8,2.5734e-04_r8,3.4822e-04_r8,4.1425e-04_r8,4.6570e-04_r8,4.9153e-04_r8, & + &4.9534e-04_r8,4.6243e-04_r8,2.6686e-04_r8/) + kao(:, 4, 9, 2) = (/ & + &4.8029e-05_r8,2.8335e-04_r8,3.8624e-04_r8,4.5968e-04_r8,5.1473e-04_r8,5.5196e-04_r8, & + &5.5517e-04_r8,5.1807e-04_r8,3.1577e-04_r8/) + kao(:, 5, 9, 2) = (/ & + &5.5331e-05_r8,3.0966e-04_r8,4.2837e-04_r8,5.0793e-04_r8,5.6875e-04_r8,6.0971e-04_r8, & + &6.2368e-04_r8,5.6511e-04_r8,3.7171e-04_r8/) + kao(:, 1,10, 2) = (/ & + &1.2964e-04_r8,4.0632e-04_r8,5.1358e-04_r8,5.5581e-04_r8,5.6980e-04_r8,5.6112e-04_r8, & + &5.2892e-04_r8,4.3728e-04_r8,2.8865e-04_r8/) + kao(:, 2,10, 2) = (/ & + &1.5095e-04_r8,4.5953e-04_r8,5.7199e-04_r8,6.2596e-04_r8,6.3988e-04_r8,6.3023e-04_r8, & + &5.9124e-04_r8,5.0100e-04_r8,3.5610e-04_r8/) + kao(:, 3,10, 2) = (/ & + &1.7573e-04_r8,5.1815e-04_r8,6.3409e-04_r8,6.9698e-04_r8,7.1541e-04_r8,7.0519e-04_r8, & + &6.6061e-04_r8,5.7112e-04_r8,4.2862e-04_r8/) + kao(:, 4,10, 2) = (/ & + &2.0254e-04_r8,5.7408e-04_r8,7.0140e-04_r8,7.6485e-04_r8,7.9509e-04_r8,7.8487e-04_r8, & + &7.3767e-04_r8,6.4340e-04_r8,5.0196e-04_r8/) + kao(:, 5,10, 2) = (/ & + &2.3735e-04_r8,6.3435e-04_r8,7.7477e-04_r8,8.4107e-04_r8,8.7369e-04_r8,8.7290e-04_r8, & + &8.2035e-04_r8,7.1353e-04_r8,5.7378e-04_r8/) + kao(:, 1,11, 2) = (/ & + &2.0611e-04_r8,5.0579e-04_r8,6.0906e-04_r8,6.6598e-04_r8,6.7463e-04_r8,6.4325e-04_r8, & + &5.7358e-04_r8,4.6594e-04_r8,3.7105e-04_r8/) + kao(:, 2,11, 2) = (/ & + &2.4168e-04_r8,5.7457e-04_r8,6.8930e-04_r8,7.4695e-04_r8,7.5788e-04_r8,7.2324e-04_r8, & + &6.4676e-04_r8,5.2943e-04_r8,4.4283e-04_r8/) + kao(:, 3,11, 2) = (/ & + &2.7855e-04_r8,6.5109e-04_r8,7.7336e-04_r8,8.3624e-04_r8,8.3721e-04_r8,8.0652e-04_r8, & + &7.2648e-04_r8,5.9132e-04_r8,5.1523e-04_r8/) + kao(:, 4,11, 2) = (/ & + &3.2934e-04_r8,7.2843e-04_r8,8.5922e-04_r8,9.2211e-04_r8,9.2829e-04_r8,8.9207e-04_r8, & + &8.1359e-04_r8,6.5969e-04_r8,5.9146e-04_r8/) + kao(:, 5,11, 2) = (/ & + &3.7624e-04_r8,8.0764e-04_r8,9.4816e-04_r8,1.0176e-03_r8,1.0267e-03_r8,9.8589e-04_r8, & + &9.0003e-04_r8,7.3360e-04_r8,6.6373e-04_r8/) + kao(:, 1,12, 2) = (/ & + &2.3690e-04_r8,5.2345e-04_r8,6.1583e-04_r8,6.6206e-04_r8,6.7308e-04_r8,6.4411e-04_r8, & + &5.7108e-04_r8,4.4594e-04_r8,3.6966e-04_r8/) + kao(:, 2,12, 2) = (/ & + &2.7636e-04_r8,5.9693e-04_r8,6.9824e-04_r8,7.5086e-04_r8,7.5372e-04_r8,7.2129e-04_r8, & + &6.4015e-04_r8,5.0417e-04_r8,4.3519e-04_r8/) + kao(:, 3,12, 2) = (/ & + &3.2475e-04_r8,6.7274e-04_r8,7.7976e-04_r8,8.4185e-04_r8,8.4051e-04_r8,8.0110e-04_r8, & + &7.2036e-04_r8,5.6771e-04_r8,5.0173e-04_r8/) + kao(:, 4,12, 2) = (/ & + &3.7742e-04_r8,7.5354e-04_r8,8.6958e-04_r8,9.2971e-04_r8,9.3567e-04_r8,8.9034e-04_r8, & + &7.9942e-04_r8,6.3511e-04_r8,5.6743e-04_r8/) + kao(:, 5,12, 2) = (/ & + &4.2656e-04_r8,8.3460e-04_r8,9.6197e-04_r8,1.0276e-03_r8,1.0348e-03_r8,9.8795e-04_r8, & + &8.8414e-04_r8,7.0917e-04_r8,6.3181e-04_r8/) + kao(:, 1,13, 2) = (/ & + &2.1559e-04_r8,4.7034e-04_r8,5.5318e-04_r8,5.8764e-04_r8,5.9246e-04_r8,5.7342e-04_r8, & + &5.0467e-04_r8,3.9184e-04_r8,3.4198e-04_r8/) + kao(:, 2,13, 2) = (/ & + &2.5152e-04_r8,5.3422e-04_r8,6.2195e-04_r8,6.6659e-04_r8,6.7272e-04_r8,6.3853e-04_r8, & + &5.7068e-04_r8,4.4436e-04_r8,3.9456e-04_r8/) + kao(:, 3,13, 2) = (/ & + &3.0302e-04_r8,6.0127e-04_r8,6.9437e-04_r8,7.4686e-04_r8,7.5249e-04_r8,7.1183e-04_r8, & + &6.4004e-04_r8,5.0162e-04_r8,4.4714e-04_r8/) + kao(:, 4,13, 2) = (/ & + &3.4242e-04_r8,6.7081e-04_r8,7.7273e-04_r8,8.2774e-04_r8,8.3533e-04_r8,7.9499e-04_r8, & + &7.1004e-04_r8,5.6394e-04_r8,5.0105e-04_r8/) + kao(:, 5,13, 2) = (/ & + &3.8220e-04_r8,7.4575e-04_r8,8.5383e-04_r8,9.1037e-04_r8,9.2303e-04_r8,8.8587e-04_r8, & + &7.8559e-04_r8,6.3207e-04_r8,5.5475e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &5.3797e-07_r8,4.8188e-04_r8,8.9729e-04_r8,1.3200e-03_r8,1.7770e-03_r8,2.3291e-03_r8, & + &3.1122e-03_r8,4.4511e-03_r8,3.5150e-03_r8/) + kao(:, 2, 1, 3) = (/ & + &6.1262e-07_r8,5.2615e-04_r8,9.8845e-04_r8,1.4517e-03_r8,1.9408e-03_r8,2.5148e-03_r8, & + &3.2963e-03_r8,4.8584e-03_r8,3.8321e-03_r8/) + kao(:, 3, 1, 3) = (/ & + &7.0635e-07_r8,5.6647e-04_r8,1.0753e-03_r8,1.5925e-03_r8,2.1392e-03_r8,2.7441e-03_r8, & + &3.5300e-03_r8,5.0419e-03_r8,4.2299e-03_r8/) + kao(:, 4, 1, 3) = (/ & + &7.6766e-07_r8,6.0727e-04_r8,1.1623e-03_r8,1.7247e-03_r8,2.3255e-03_r8,3.0054e-03_r8, & + &3.8553e-03_r8,5.3163e-03_r8,4.6081e-03_r8/) + kao(:, 5, 1, 3) = (/ & + &8.3851e-07_r8,6.4796e-04_r8,1.2484e-03_r8,1.8617e-03_r8,2.5127e-03_r8,3.2521e-03_r8, & + &4.1787e-03_r8,5.7407e-03_r8,4.9828e-03_r8/) + kao(:, 1, 2, 3) = (/ & + &6.9858e-07_r8,4.1220e-04_r8,7.5871e-04_r8,1.0893e-03_r8,1.4250e-03_r8,1.8069e-03_r8, & + &2.3218e-03_r8,3.2208e-03_r8,2.7451e-03_r8/) + kao(:, 2, 2, 3) = (/ & + &8.1006e-07_r8,4.4690e-04_r8,8.3751e-04_r8,1.2083e-03_r8,1.5781e-03_r8,1.9758e-03_r8, & + &2.4966e-03_r8,3.4638e-03_r8,3.0268e-03_r8/) + kao(:, 3, 2, 3) = (/ & + &9.0719e-07_r8,4.8245e-04_r8,9.0580e-04_r8,1.3167e-03_r8,1.7362e-03_r8,2.1788e-03_r8, & + &2.7148e-03_r8,3.6613e-03_r8,3.3476e-03_r8/) + kao(:, 4, 2, 3) = (/ & + &9.9070e-07_r8,5.1202e-04_r8,9.7859e-04_r8,1.4272e-03_r8,1.8822e-03_r8,2.3784e-03_r8, & + &2.9761e-03_r8,3.9189e-03_r8,3.6534e-03_r8/) + kao(:, 5, 2, 3) = (/ & + &1.0800e-06_r8,5.4986e-04_r8,1.0443e-03_r8,1.5370e-03_r8,2.0346e-03_r8,2.5754e-03_r8, & + &3.2289e-03_r8,4.2581e-03_r8,3.9665e-03_r8/) + kao(:, 1, 3, 3) = (/ & + &1.1956e-06_r8,3.6533e-04_r8,6.4857e-04_r8,9.1797e-04_r8,1.1753e-03_r8,1.4236e-03_r8, & + &1.7165e-03_r8,2.2362e-03_r8,2.0894e-03_r8/) + kao(:, 2, 3, 3) = (/ & + &1.3685e-06_r8,3.9659e-04_r8,7.1084e-04_r8,1.0164e-03_r8,1.3082e-03_r8,1.5859e-03_r8, & + &1.8841e-03_r8,2.3586e-03_r8,2.3274e-03_r8/) + kao(:, 3, 3, 3) = (/ & + &1.5093e-06_r8,4.2397e-04_r8,7.7009e-04_r8,1.1048e-03_r8,1.4344e-03_r8,1.7565e-03_r8, & + &2.0870e-03_r8,2.5514e-03_r8,2.5907e-03_r8/) + kao(:, 4, 3, 3) = (/ & + &1.6732e-06_r8,4.5580e-04_r8,8.2534e-04_r8,1.1953e-03_r8,1.5533e-03_r8,1.9057e-03_r8, & + &2.2804e-03_r8,2.8031e-03_r8,2.8387e-03_r8/) + kao(:, 5, 3, 3) = (/ & + &1.8304e-06_r8,4.8851e-04_r8,8.8340e-04_r8,1.2735e-03_r8,1.6704e-03_r8,2.0642e-03_r8, & + &2.4727e-03_r8,3.0561e-03_r8,3.0939e-03_r8/) + kao(:, 1, 4, 3) = (/ & + &2.0440e-06_r8,3.4190e-04_r8,5.7528e-04_r8,7.8555e-04_r8,9.8576e-04_r8,1.1789e-03_r8, & + &1.3557e-03_r8,1.6128e-03_r8,1.5891e-03_r8/) + kao(:, 2, 4, 3) = (/ & + &2.2803e-06_r8,3.6626e-04_r8,6.2613e-04_r8,8.6621e-04_r8,1.0945e-03_r8,1.3150e-03_r8, & + &1.5191e-03_r8,1.7412e-03_r8,1.7827e-03_r8/) + kao(:, 3, 4, 3) = (/ & + &2.5344e-06_r8,3.9307e-04_r8,6.7511e-04_r8,9.4372e-04_r8,1.1954e-03_r8,1.4474e-03_r8, & + &1.6882e-03_r8,1.9262e-03_r8,2.0030e-03_r8/) + kao(:, 4, 4, 3) = (/ & + &2.8636e-06_r8,4.1974e-04_r8,7.2769e-04_r8,1.0153e-03_r8,1.2977e-03_r8,1.5716e-03_r8, & + &1.8427e-03_r8,2.1315e-03_r8,2.2084e-03_r8/) + kao(:, 5, 4, 3) = (/ & + &3.0668e-06_r8,4.5207e-04_r8,7.8267e-04_r8,1.0885e-03_r8,1.3854e-03_r8,1.6897e-03_r8, & + &1.9964e-03_r8,2.3147e-03_r8,2.4195e-03_r8/) + kao(:, 1, 5, 3) = (/ & + &3.1319e-06_r8,3.2418e-04_r8,5.2433e-04_r8,6.9885e-04_r8,8.4707e-04_r8,9.8232e-04_r8, & + &1.1112e-03_r8,1.2410e-03_r8,1.2226e-03_r8/) + kao(:, 2, 5, 3) = (/ & + &3.5295e-06_r8,3.4929e-04_r8,5.6868e-04_r8,7.6274e-04_r8,9.3852e-04_r8,1.0972e-03_r8, & + &1.2472e-03_r8,1.3812e-03_r8,1.3798e-03_r8/) + kao(:, 3, 5, 3) = (/ & + &3.9745e-06_r8,3.7641e-04_r8,6.1261e-04_r8,8.2611e-04_r8,1.0255e-03_r8,1.2065e-03_r8, & + &1.3836e-03_r8,1.5454e-03_r8,1.5563e-03_r8/) + kao(:, 4, 5, 3) = (/ & + &4.4389e-06_r8,4.0602e-04_r8,6.5760e-04_r8,8.9247e-04_r8,1.1052e-03_r8,1.3151e-03_r8, & + &1.5074e-03_r8,1.7081e-03_r8,1.7334e-03_r8/) + kao(:, 5, 5, 3) = (/ & + &4.7663e-06_r8,4.3568e-04_r8,7.0547e-04_r8,9.6253e-04_r8,1.1901e-03_r8,1.4105e-03_r8, & + &1.6319e-03_r8,1.8559e-03_r8,1.9044e-03_r8/) + kao(:, 1, 6, 3) = (/ & + &4.5500e-06_r8,3.2085e-04_r8,4.8959e-04_r8,6.2597e-04_r8,7.4855e-04_r8,8.4386e-04_r8, & + &9.2463e-04_r8,9.8196e-04_r8,9.3322e-04_r8/) + kao(:, 2, 6, 3) = (/ & + &5.1832e-06_r8,3.4894e-04_r8,5.2646e-04_r8,6.8892e-04_r8,8.2642e-04_r8,9.4419e-04_r8, & + &1.0344e-03_r8,1.1120e-03_r8,1.0567e-03_r8/) + kao(:, 3, 6, 3) = (/ & + &5.7454e-06_r8,3.7624e-04_r8,5.6596e-04_r8,7.4193e-04_r8,8.9866e-04_r8,1.0339e-03_r8, & + &1.1478e-03_r8,1.2434e-03_r8,1.1989e-03_r8/) + kao(:, 4, 6, 3) = (/ & + &6.4183e-06_r8,4.0049e-04_r8,6.1119e-04_r8,7.9917e-04_r8,9.7241e-04_r8,1.1206e-03_r8, & + &1.2562e-03_r8,1.3721e-03_r8,1.3554e-03_r8/) + kao(:, 5, 6, 3) = (/ & + &6.9324e-06_r8,4.2668e-04_r8,6.6038e-04_r8,8.5368e-04_r8,1.0486e-03_r8,1.2116e-03_r8, & + &1.3599e-03_r8,1.5001e-03_r8,1.5043e-03_r8/) + kao(:, 1, 7, 3) = (/ & + &7.2797e-06_r8,3.0677e-04_r8,4.8071e-04_r8,5.9971e-04_r8,6.8742e-04_r8,7.5672e-04_r8, & + &8.0124e-04_r8,8.1058e-04_r8,7.0953e-04_r8/) + kao(:, 2, 7, 3) = (/ & + &8.1177e-06_r8,3.3920e-04_r8,5.2455e-04_r8,6.4489e-04_r8,7.6436e-04_r8,8.4338e-04_r8, & + &9.0408e-04_r8,9.2147e-04_r8,8.0482e-04_r8/) + kao(:, 3, 7, 3) = (/ & + &8.9509e-06_r8,3.6425e-04_r8,5.6797e-04_r8,6.9667e-04_r8,8.2046e-04_r8,9.2590e-04_r8, & + &9.9874e-04_r8,1.0317e-03_r8,9.2280e-04_r8/) + kao(:, 4, 7, 3) = (/ & + &9.9962e-06_r8,3.8975e-04_r8,6.1216e-04_r8,7.5517e-04_r8,8.8215e-04_r8,1.0000e-03_r8, & + &1.0895e-03_r8,1.1382e-03_r8,1.0492e-03_r8/) + kao(:, 5, 7, 3) = (/ & + &1.0669e-05_r8,4.1752e-04_r8,6.5205e-04_r8,8.1765e-04_r8,9.5018e-04_r8,1.0745e-03_r8, & + &1.1767e-03_r8,1.2498e-03_r8,1.1757e-03_r8/) + kao(:, 1, 8, 3) = (/ & + &1.3269e-05_r8,3.0208e-04_r8,4.8542e-04_r8,6.1720e-04_r8,7.0751e-04_r8,7.5832e-04_r8, & + &7.5956e-04_r8,7.2658e-04_r8,5.2753e-04_r8/) + kao(:, 2, 8, 3) = (/ & + &1.5282e-05_r8,3.2807e-04_r8,5.3968e-04_r8,6.8467e-04_r8,7.6733e-04_r8,8.2175e-04_r8, & + &8.4708e-04_r8,8.2655e-04_r8,6.1209e-04_r8/) + kao(:, 3, 8, 3) = (/ & + &1.6919e-05_r8,3.5455e-04_r8,5.8673e-04_r8,7.5006e-04_r8,8.3417e-04_r8,8.8820e-04_r8, & + &9.3120e-04_r8,9.2583e-04_r8,7.0621e-04_r8/) + kao(:, 4, 8, 3) = (/ & + &1.8616e-05_r8,3.8664e-04_r8,6.2653e-04_r8,8.0927e-04_r8,9.0712e-04_r8,9.6236e-04_r8, & + &1.0056e-03_r8,1.0184e-03_r8,8.0931e-04_r8/) + kao(:, 5, 8, 3) = (/ & + &2.0327e-05_r8,4.2321e-04_r8,6.7354e-04_r8,8.6755e-04_r8,9.7906e-04_r8,1.0424e-03_r8, & + &1.0862e-03_r8,1.0982e-03_r8,9.1316e-04_r8/) + kao(:, 1, 9, 3) = (/ & + &5.0114e-05_r8,4.1653e-04_r8,5.9063e-04_r8,7.3539e-04_r8,8.5123e-04_r8,9.2178e-04_r8, & + &9.4309e-04_r8,8.5391e-04_r8,5.1499e-04_r8/) + kao(:, 2, 9, 3) = (/ & + &5.7273e-05_r8,4.5656e-04_r8,6.4069e-04_r8,7.9699e-04_r8,9.4296e-04_r8,1.0365e-03_r8, & + &1.0446e-03_r8,9.3220e-04_r8,6.0883e-04_r8/) + kao(:, 3, 9, 3) = (/ & + &6.4035e-05_r8,4.9861e-04_r8,7.0653e-04_r8,8.6985e-04_r8,1.0116e-03_r8,1.1468e-03_r8, & + &1.1543e-03_r8,1.0092e-03_r8,7.0553e-04_r8/) + kao(:, 4, 9, 3) = (/ & + &7.2188e-05_r8,5.4617e-04_r8,7.8095e-04_r8,9.4772e-04_r8,1.1003e-03_r8,1.2322e-03_r8, & + &1.2562e-03_r8,1.0988e-03_r8,7.9526e-04_r8/) + kao(:, 5, 9, 3) = (/ & + &7.9550e-05_r8,6.0184e-04_r8,8.5464e-04_r8,1.0416e-03_r8,1.1956e-03_r8,1.3190e-03_r8, & + &1.3528e-03_r8,1.1984e-03_r8,8.7997e-04_r8/) + kao(:, 1,10, 3) = (/ & + &2.3306e-04_r8,7.9772e-04_r8,9.8566e-04_r8,1.1183e-03_r8,1.1737e-03_r8,1.1902e-03_r8, & + &1.1793e-03_r8,1.0698e-03_r8,6.6407e-04_r8/) + kao(:, 2,10, 3) = (/ & + &2.6771e-04_r8,8.8993e-04_r8,1.0956e-03_r8,1.2259e-03_r8,1.2971e-03_r8,1.3020e-03_r8, & + &1.2785e-03_r8,1.2036e-03_r8,7.5718e-04_r8/) + kao(:, 3,10, 3) = (/ & + &3.0294e-04_r8,9.8041e-04_r8,1.2123e-03_r8,1.3475e-03_r8,1.4168e-03_r8,1.4273e-03_r8, & + &1.4006e-03_r8,1.3282e-03_r8,8.5838e-04_r8/) + kao(:, 4,10, 3) = (/ & + &3.4186e-04_r8,1.0838e-03_r8,1.3329e-03_r8,1.4855e-03_r8,1.5514e-03_r8,1.5775e-03_r8, & + &1.5302e-03_r8,1.4297e-03_r8,9.7732e-04_r8/) + kao(:, 5,10, 3) = (/ & + &3.7940e-04_r8,1.2006e-03_r8,1.4657e-03_r8,1.6333e-03_r8,1.7070e-03_r8,1.7269e-03_r8, & + &1.6832e-03_r8,1.5552e-03_r8,1.1108e-03_r8/) + kao(:, 1,11, 3) = (/ & + &4.1370e-04_r8,1.0481e-03_r8,1.2382e-03_r8,1.3193e-03_r8,1.3405e-03_r8,1.3128e-03_r8, & + &1.2136e-03_r8,1.0530e-03_r8,7.9947e-04_r8/) + kao(:, 2,11, 3) = (/ & + &4.6551e-04_r8,1.1702e-03_r8,1.3813e-03_r8,1.4636e-03_r8,1.4831e-03_r8,1.4472e-03_r8, & + &1.3317e-03_r8,1.1447e-03_r8,9.1716e-04_r8/) + kao(:, 3,11, 3) = (/ & + &5.2337e-04_r8,1.3114e-03_r8,1.5380e-03_r8,1.6111e-03_r8,1.6417e-03_r8,1.5910e-03_r8, & + &1.4641e-03_r8,1.2585e-03_r8,1.0575e-03_r8/) + kao(:, 4,11, 3) = (/ & + &5.8236e-04_r8,1.4612e-03_r8,1.6981e-03_r8,1.7829e-03_r8,1.8015e-03_r8,1.7452e-03_r8, & + &1.6069e-03_r8,1.3761e-03_r8,1.2010e-03_r8/) + kao(:, 5,11, 3) = (/ & + &6.7131e-04_r8,1.6254e-03_r8,1.8811e-03_r8,1.9666e-03_r8,1.9744e-03_r8,1.9137e-03_r8, & + &1.7677e-03_r8,1.5105e-03_r8,1.3428e-03_r8/) + kao(:, 1,12, 3) = (/ & + &5.0548e-04_r8,1.1217e-03_r8,1.2964e-03_r8,1.3785e-03_r8,1.3692e-03_r8,1.2935e-03_r8, & + &1.1705e-03_r8,9.6704e-04_r8,8.2680e-04_r8/) + kao(:, 2,12, 3) = (/ & + &5.7320e-04_r8,1.2560e-03_r8,1.4612e-03_r8,1.5290e-03_r8,1.5133e-03_r8,1.4345e-03_r8, & + &1.2992e-03_r8,1.0595e-03_r8,9.5961e-04_r8/) + kao(:, 3,12, 3) = (/ & + &6.3853e-04_r8,1.4125e-03_r8,1.6378e-03_r8,1.6918e-03_r8,1.6663e-03_r8,1.5909e-03_r8, & + &1.4283e-03_r8,1.1648e-03_r8,1.0789e-03_r8/) + kao(:, 4,12, 3) = (/ & + &7.1367e-04_r8,1.5888e-03_r8,1.8194e-03_r8,1.8745e-03_r8,1.8358e-03_r8,1.7471e-03_r8, & + &1.5691e-03_r8,1.2862e-03_r8,1.2039e-03_r8/) + kao(:, 5,12, 3) = (/ & + &8.2207e-04_r8,1.7742e-03_r8,2.0103e-03_r8,2.0603e-03_r8,2.0193e-03_r8,1.9194e-03_r8, & + &1.7244e-03_r8,1.4199e-03_r8,1.3514e-03_r8/) + kao(:, 1,13, 3) = (/ & + &5.0420e-04_r8,1.0317e-03_r8,1.1965e-03_r8,1.2627e-03_r8,1.2425e-03_r8,1.1623e-03_r8, & + &1.0397e-03_r8,8.4556e-04_r8,7.6156e-04_r8/) + kao(:, 2,13, 3) = (/ & + &5.6808e-04_r8,1.1670e-03_r8,1.3463e-03_r8,1.4009e-03_r8,1.3701e-03_r8,1.2956e-03_r8, & + &1.1567e-03_r8,9.3024e-04_r8,8.8050e-04_r8/) + kao(:, 3,13, 3) = (/ & + &6.1838e-04_r8,1.3214e-03_r8,1.5180e-03_r8,1.5502e-03_r8,1.5020e-03_r8,1.4361e-03_r8, & + &1.2780e-03_r8,1.0272e-03_r8,9.9967e-04_r8/) + kao(:, 4,13, 3) = (/ & + &7.0527e-04_r8,1.4908e-03_r8,1.6794e-03_r8,1.7102e-03_r8,1.6621e-03_r8,1.5793e-03_r8, & + &1.4142e-03_r8,1.1355e-03_r8,1.1267e-03_r8/) + kao(:, 5,13, 3) = (/ & + &8.1247e-04_r8,1.6340e-03_r8,1.8549e-03_r8,1.8870e-03_r8,1.8374e-03_r8,1.7298e-03_r8, & + &1.5606e-03_r8,1.2534e-03_r8,1.2510e-03_r8/) + kao(:, 1, 1, 4) = (/ & + &7.9349e-07_r8,1.0718e-03_r8,2.1076e-03_r8,3.1773e-03_r8,4.3493e-03_r8,5.6505e-03_r8, & + &7.2449e-03_r8,1.0124e-02_r8,8.6807e-03_r8/) + kao(:, 2, 1, 4) = (/ & + &7.9171e-07_r8,1.1405e-03_r8,2.2617e-03_r8,3.4209e-03_r8,4.6727e-03_r8,6.0666e-03_r8, & + &7.8396e-03_r8,1.0702e-02_r8,9.3285e-03_r8/) + kao(:, 3, 1, 4) = (/ & + &8.3534e-07_r8,1.2022e-03_r8,2.3697e-03_r8,3.6079e-03_r8,4.9651e-03_r8,6.4864e-03_r8, & + &8.3654e-03_r8,1.1513e-02_r8,9.9193e-03_r8/) + kao(:, 4, 1, 4) = (/ & + &9.5267e-07_r8,1.2723e-03_r8,2.4978e-03_r8,3.7943e-03_r8,5.1994e-03_r8,6.8025e-03_r8, & + &8.8715e-03_r8,1.2190e-02_r8,1.0375e-02_r8/) + kao(:, 5, 1, 4) = (/ & + &1.1458e-06_r8,1.3554e-03_r8,2.6484e-03_r8,4.0109e-03_r8,5.4856e-03_r8,7.1578e-03_r8, & + &9.2726e-03_r8,1.2904e-02_r8,1.0954e-02_r8/) + kao(:, 1, 2, 4) = (/ & + &9.1454e-07_r8,9.0539e-04_r8,1.7315e-03_r8,2.5817e-03_r8,3.4611e-03_r8,4.4469e-03_r8, & + &5.5705e-03_r8,7.4448e-03_r8,6.8782e-03_r8/) + kao(:, 2, 2, 4) = (/ & + &9.5187e-07_r8,9.6041e-04_r8,1.8588e-03_r8,2.7755e-03_r8,3.7306e-03_r8,4.7775e-03_r8, & + &6.0319e-03_r8,7.9894e-03_r8,7.4238e-03_r8/) + kao(:, 3, 2, 4) = (/ & + &1.1150e-06_r8,1.0164e-03_r8,1.9573e-03_r8,2.9264e-03_r8,3.9480e-03_r8,5.1214e-03_r8, & + &6.4611e-03_r8,8.5702e-03_r8,7.8654e-03_r8/) + kao(:, 4, 2, 4) = (/ & + &1.3385e-06_r8,1.0876e-03_r8,2.0659e-03_r8,3.0814e-03_r8,4.1574e-03_r8,5.3507e-03_r8, & + &6.8052e-03_r8,9.1287e-03_r8,8.2842e-03_r8/) + kao(:, 5, 2, 4) = (/ & + &1.6022e-06_r8,1.1568e-03_r8,2.2052e-03_r8,3.2703e-03_r8,4.4002e-03_r8,5.6510e-03_r8, & + &7.1684e-03_r8,9.6207e-03_r8,8.7667e-03_r8/) + kao(:, 1, 3, 4) = (/ & + &1.5574e-06_r8,7.6371e-04_r8,1.4483e-03_r8,2.1006e-03_r8,2.7598e-03_r8,3.4620e-03_r8, & + &4.1959e-03_r8,5.2056e-03_r8,5.3344e-03_r8/) + kao(:, 2, 3, 4) = (/ & + &1.7591e-06_r8,8.1114e-04_r8,1.5471e-03_r8,2.2761e-03_r8,2.9860e-03_r8,3.7307e-03_r8, & + &4.5489e-03_r8,5.7315e-03_r8,5.7929e-03_r8/) + kao(:, 3, 3, 4) = (/ & + &2.0958e-06_r8,8.7335e-04_r8,1.6413e-03_r8,2.3988e-03_r8,3.1565e-03_r8,3.9689e-03_r8, & + &4.8920e-03_r8,6.1466e-03_r8,6.1501e-03_r8/) + kao(:, 4, 3, 4) = (/ & + &2.4948e-06_r8,9.3193e-04_r8,1.7550e-03_r8,2.5427e-03_r8,3.3388e-03_r8,4.1838e-03_r8, & + &5.1384e-03_r8,6.5670e-03_r8,6.5006e-03_r8/) + kao(:, 5, 3, 4) = (/ & + &2.9808e-06_r8,9.8734e-04_r8,1.8752e-03_r8,2.7256e-03_r8,3.5562e-03_r8,4.4297e-03_r8, & + &5.4345e-03_r8,6.8804e-03_r8,6.9100e-03_r8/) + kao(:, 1, 4, 4) = (/ & + &2.8339e-06_r8,6.5550e-04_r8,1.2204e-03_r8,1.7505e-03_r8,2.2569e-03_r8,2.7626e-03_r8, & + &3.2755e-03_r8,3.8524e-03_r8,4.1315e-03_r8/) + kao(:, 2, 4, 4) = (/ & + &3.2988e-06_r8,7.0845e-04_r8,1.2966e-03_r8,1.8754e-03_r8,2.4581e-03_r8,3.0020e-03_r8, & + &3.5639e-03_r8,4.2448e-03_r8,4.5130e-03_r8/) + kao(:, 3, 4, 4) = (/ & + &3.9491e-06_r8,7.6198e-04_r8,1.3871e-03_r8,1.9942e-03_r8,2.6023e-03_r8,3.1978e-03_r8, & + &3.8488e-03_r8,4.5802e-03_r8,4.8443e-03_r8/) + kao(:, 4, 4, 4) = (/ & + &4.6425e-06_r8,8.1982e-04_r8,1.4902e-03_r8,2.1380e-03_r8,2.7710e-03_r8,3.3974e-03_r8, & + &4.0487e-03_r8,4.8659e-03_r8,5.1413e-03_r8/) + kao(:, 5, 4, 4) = (/ & + &5.6265e-06_r8,8.8017e-04_r8,1.5882e-03_r8,2.2893e-03_r8,2.9763e-03_r8,3.6352e-03_r8, & + &4.2916e-03_r8,5.1439e-03_r8,5.4622e-03_r8/) + kao(:, 1, 5, 4) = (/ & + &4.8447e-06_r8,5.8594e-04_r8,1.0296e-03_r8,1.4656e-03_r8,1.8696e-03_r8,2.2619e-03_r8, & + &2.6388e-03_r8,3.0084e-03_r8,3.1950e-03_r8/) + kao(:, 2, 5, 4) = (/ & + &5.5680e-06_r8,6.3350e-04_r8,1.1054e-03_r8,1.5640e-03_r8,2.0148e-03_r8,2.4702e-03_r8, & + &2.8772e-03_r8,3.3130e-03_r8,3.5193e-03_r8/) + kao(:, 3, 5, 4) = (/ & + &6.5723e-06_r8,6.8615e-04_r8,1.1977e-03_r8,1.6753e-03_r8,2.1497e-03_r8,2.6254e-03_r8, & + &3.0969e-03_r8,3.5912e-03_r8,3.8422e-03_r8/) + kao(:, 4, 5, 4) = (/ & + &7.8530e-06_r8,7.4277e-04_r8,1.2884e-03_r8,1.8101e-03_r8,2.3101e-03_r8,2.7992e-03_r8, & + &3.2952e-03_r8,3.8151e-03_r8,4.0689e-03_r8/) + kao(:, 5, 5, 4) = (/ & + &9.4527e-06_r8,8.0105e-04_r8,1.3871e-03_r8,1.9371e-03_r8,2.4908e-03_r8,3.0121e-03_r8, & + &3.5288e-03_r8,4.0532e-03_r8,4.3486e-03_r8/) + kao(:, 1, 6, 4) = (/ & + &7.9687e-06_r8,5.4507e-04_r8,8.9513e-04_r8,1.2382e-03_r8,1.5589e-03_r8,1.8510e-03_r8, & + &2.1398e-03_r8,2.3860e-03_r8,2.4635e-03_r8/) + kao(:, 2, 6, 4) = (/ & + &8.8712e-06_r8,5.9098e-04_r8,9.7039e-04_r8,1.3235e-03_r8,1.6755e-03_r8,2.0285e-03_r8, & + &2.3501e-03_r8,2.6411e-03_r8,2.7555e-03_r8/) + kao(:, 3, 6, 4) = (/ & + &1.0300e-05_r8,6.3947e-04_r8,1.0497e-03_r8,1.4366e-03_r8,1.7944e-03_r8,2.1608e-03_r8, & + &2.5184e-03_r8,2.8809e-03_r8,3.0211e-03_r8/) + kao(:, 4, 6, 4) = (/ & + &1.2171e-05_r8,6.9277e-04_r8,1.1370e-03_r8,1.5510e-03_r8,1.9450e-03_r8,2.3217e-03_r8, & + &2.6890e-03_r8,3.0692e-03_r8,3.2284e-03_r8/) + kao(:, 5, 6, 4) = (/ & + &1.4564e-05_r8,7.4600e-04_r8,1.2318e-03_r8,1.6801e-03_r8,2.0948e-03_r8,2.5115e-03_r8, & + &2.8923e-03_r8,3.2756e-03_r8,3.4483e-03_r8/) + kao(:, 1, 7, 4) = (/ & + &1.3302e-05_r8,5.5386e-04_r8,8.3382e-04_r8,1.0993e-03_r8,1.3564e-03_r8,1.5663e-03_r8, & + &1.7522e-03_r8,1.9212e-03_r8,1.8928e-03_r8/) + kao(:, 2, 7, 4) = (/ & + &1.5137e-05_r8,6.0362e-04_r8,9.0303e-04_r8,1.1816e-03_r8,1.4350e-03_r8,1.6949e-03_r8, & + &1.9391e-03_r8,2.1345e-03_r8,2.1400e-03_r8/) + kao(:, 3, 7, 4) = (/ & + &1.7393e-05_r8,6.5556e-04_r8,9.7760e-04_r8,1.2752e-03_r8,1.5638e-03_r8,1.8142e-03_r8, & + &2.0760e-03_r8,2.3419e-03_r8,2.3618e-03_r8/) + kao(:, 4, 7, 4) = (/ & + &2.0190e-05_r8,7.0877e-04_r8,1.0583e-03_r8,1.3832e-03_r8,1.6934e-03_r8,1.9720e-03_r8, & + &2.2273e-03_r8,2.4896e-03_r8,2.5682e-03_r8/) + kao(:, 5, 7, 4) = (/ & + &2.3865e-05_r8,7.6246e-04_r8,1.1476e-03_r8,1.5003e-03_r8,1.8325e-03_r8,2.1363e-03_r8, & + &2.4216e-03_r8,2.6647e-03_r8,2.7377e-03_r8/) + kao(:, 1, 8, 4) = (/ & + &2.8723e-05_r8,5.8785e-04_r8,8.8654e-04_r8,1.0769e-03_r8,1.2579e-03_r8,1.4310e-03_r8, & + &1.5394e-03_r8,1.5987e-03_r8,1.4479e-03_r8/) + kao(:, 2, 8, 4) = (/ & + &3.1951e-05_r8,6.5934e-04_r8,9.7493e-04_r8,1.1672e-03_r8,1.3594e-03_r8,1.5243e-03_r8, & + &1.6749e-03_r8,1.7779e-03_r8,1.6535e-03_r8/) + kao(:, 3, 8, 4) = (/ & + &3.6028e-05_r8,7.3349e-04_r8,1.0597e-03_r8,1.2704e-03_r8,1.4675e-03_r8,1.6499e-03_r8, & + &1.7965e-03_r8,1.9280e-03_r8,1.8443e-03_r8/) + kao(:, 4, 8, 4) = (/ & + &4.1972e-05_r8,7.9901e-04_r8,1.1534e-03_r8,1.3845e-03_r8,1.5898e-03_r8,1.7819e-03_r8, & + &1.9610e-03_r8,2.0652e-03_r8,2.0278e-03_r8/) + kao(:, 5, 8, 4) = (/ & + &4.8818e-05_r8,8.6068e-04_r8,1.2469e-03_r8,1.5029e-03_r8,1.7252e-03_r8,1.9359e-03_r8, & + &2.1153e-03_r8,2.2493e-03_r8,2.1613e-03_r8/) + kao(:, 1, 9, 4) = (/ & + &1.2151e-04_r8,7.9394e-04_r8,1.1551e-03_r8,1.4165e-03_r8,1.6142e-03_r8,1.6912e-03_r8, & + &1.6602e-03_r8,1.6194e-03_r8,1.1991e-03_r8/) + kao(:, 2, 9, 4) = (/ & + &1.3408e-04_r8,8.8305e-04_r8,1.2970e-03_r8,1.6023e-03_r8,1.7938e-03_r8,1.8665e-03_r8, & + &1.8031e-03_r8,1.7264e-03_r8,1.3714e-03_r8/) + kao(:, 3, 9, 4) = (/ & + &1.5040e-04_r8,9.7901e-04_r8,1.4287e-03_r8,1.7867e-03_r8,2.0033e-03_r8,2.0339e-03_r8, & + &1.9620e-03_r8,1.8611e-03_r8,1.5284e-03_r8/) + kao(:, 4, 9, 4) = (/ & + &1.6901e-04_r8,1.0844e-03_r8,1.5638e-03_r8,1.9651e-03_r8,2.1812e-03_r8,2.2146e-03_r8, & + &2.1459e-03_r8,2.0086e-03_r8,1.6589e-03_r8/) + kao(:, 5, 9, 4) = (/ & + &1.9165e-04_r8,1.1941e-03_r8,1.7106e-03_r8,2.1260e-03_r8,2.3624e-03_r8,2.4142e-03_r8, & + &2.3405e-03_r8,2.1792e-03_r8,1.8085e-03_r8/) + kao(:, 1,10, 4) = (/ & + &5.9868e-04_r8,1.5993e-03_r8,1.9364e-03_r8,2.1129e-03_r8,2.2524e-03_r8,2.3246e-03_r8, & + &2.2594e-03_r8,2.0146e-03_r8,1.3568e-03_r8/) + kao(:, 2,10, 4) = (/ & + &6.6752e-04_r8,1.7567e-03_r8,2.1277e-03_r8,2.3435e-03_r8,2.4977e-03_r8,2.6109e-03_r8, & + &2.5681e-03_r8,2.2608e-03_r8,1.5177e-03_r8/) + kao(:, 3,10, 4) = (/ & + &7.4901e-04_r8,1.9228e-03_r8,2.3324e-03_r8,2.5957e-03_r8,2.7706e-03_r8,2.8949e-03_r8, & + &2.8715e-03_r8,2.4740e-03_r8,1.6681e-03_r8/) + kao(:, 4,10, 4) = (/ & + &8.4268e-04_r8,2.1035e-03_r8,2.5651e-03_r8,2.8675e-03_r8,3.0553e-03_r8,3.1760e-03_r8, & + &3.1745e-03_r8,2.7207e-03_r8,1.8575e-03_r8/) + kao(:, 5,10, 4) = (/ & + &9.4245e-04_r8,2.2879e-03_r8,2.8080e-03_r8,3.1494e-03_r8,3.3540e-03_r8,3.4813e-03_r8, & + &3.4487e-03_r8,2.9536e-03_r8,2.0691e-03_r8/) + kao(:, 1,11, 4) = (/ & + &1.0805e-03_r8,2.1148e-03_r8,2.4220e-03_r8,2.5310e-03_r8,2.5389e-03_r8,2.4625e-03_r8, & + &2.3509e-03_r8,2.0401e-03_r8,1.4417e-03_r8/) + kao(:, 2,11, 4) = (/ & + &1.2248e-03_r8,2.3043e-03_r8,2.6421e-03_r8,2.7805e-03_r8,2.8051e-03_r8,2.7290e-03_r8, & + &2.6298e-03_r8,2.3094e-03_r8,1.6718e-03_r8/) + kao(:, 3,11, 4) = (/ & + &1.3919e-03_r8,2.5018e-03_r8,2.8694e-03_r8,3.0522e-03_r8,3.0921e-03_r8,3.0140e-03_r8, & + &2.9024e-03_r8,2.5763e-03_r8,1.8644e-03_r8/) + kao(:, 4,11, 4) = (/ & + &1.5591e-03_r8,2.7193e-03_r8,3.1319e-03_r8,3.3417e-03_r8,3.3992e-03_r8,3.3292e-03_r8, & + &3.1865e-03_r8,2.8388e-03_r8,2.0955e-03_r8/) + kao(:, 5,11, 4) = (/ & + &1.7150e-03_r8,2.9473e-03_r8,3.3980e-03_r8,3.6551e-03_r8,3.7158e-03_r8,3.6708e-03_r8, & + &3.4907e-03_r8,3.0872e-03_r8,2.3494e-03_r8/) + kao(:, 1,12, 4) = (/ & + &1.3897e-03_r8,2.3284e-03_r8,2.5562e-03_r8,2.6114e-03_r8,2.5756e-03_r8,2.4579e-03_r8, & + &2.2328e-03_r8,1.8907e-03_r8,1.4460e-03_r8/) + kao(:, 2,12, 4) = (/ & + &1.5697e-03_r8,2.5462e-03_r8,2.7773e-03_r8,2.8739e-03_r8,2.8515e-03_r8,2.7127e-03_r8, & + &2.4702e-03_r8,2.1317e-03_r8,1.6710e-03_r8/) + kao(:, 3,12, 4) = (/ & + &1.7564e-03_r8,2.7736e-03_r8,3.0368e-03_r8,3.1575e-03_r8,3.1336e-03_r8,2.9932e-03_r8, & + &2.7316e-03_r8,2.3689e-03_r8,1.9165e-03_r8/) + kao(:, 4,12, 4) = (/ & + &1.9373e-03_r8,3.0028e-03_r8,3.3026e-03_r8,3.4473e-03_r8,3.4197e-03_r8,3.2885e-03_r8, & + &3.0105e-03_r8,2.5975e-03_r8,2.1734e-03_r8/) + kao(:, 5,12, 4) = (/ & + &2.1103e-03_r8,3.2861e-03_r8,3.6126e-03_r8,3.7579e-03_r8,3.7472e-03_r8,3.5983e-03_r8, & + &3.3137e-03_r8,2.8243e-03_r8,2.4241e-03_r8/) + kao(:, 1,13, 4) = (/ & + &1.4034e-03_r8,2.2073e-03_r8,2.3423e-03_r8,2.3940e-03_r8,2.3352e-03_r8,2.2289e-03_r8, & + &1.9861e-03_r8,1.6453e-03_r8,1.3641e-03_r8/) + kao(:, 2,13, 4) = (/ & + &1.5468e-03_r8,2.3993e-03_r8,2.5715e-03_r8,2.6353e-03_r8,2.5905e-03_r8,2.4689e-03_r8, & + &2.2035e-03_r8,1.8516e-03_r8,1.5595e-03_r8/) + kao(:, 3,13, 4) = (/ & + &1.7054e-03_r8,2.6002e-03_r8,2.8041e-03_r8,2.9001e-03_r8,2.8726e-03_r8,2.7020e-03_r8, & + &2.4437e-03_r8,2.0505e-03_r8,1.7798e-03_r8/) + kao(:, 4,13, 4) = (/ & + &1.8746e-03_r8,2.8344e-03_r8,3.0758e-03_r8,3.1886e-03_r8,3.1543e-03_r8,2.9591e-03_r8, & + &2.7010e-03_r8,2.2473e-03_r8,2.0185e-03_r8/) + kao(:, 5,13, 4) = (/ & + &2.0493e-03_r8,3.1290e-03_r8,3.3711e-03_r8,3.5047e-03_r8,3.4626e-03_r8,3.2529e-03_r8, & + &2.9617e-03_r8,2.4466e-03_r8,2.2855e-03_r8/) + kao(:, 1, 1, 5) = (/ & + &2.7288e-06_r8,2.0772e-03_r8,4.1339e-03_r8,6.3040e-03_r8,8.6169e-03_r8,1.1216e-02_r8, & + &1.4425e-02_r8,1.9774e-02_r8,1.7219e-02_r8/) + kao(:, 2, 1, 5) = (/ & + &3.1343e-06_r8,2.2547e-03_r8,4.4747e-03_r8,6.8269e-03_r8,9.3305e-03_r8,1.2134e-02_r8, & + &1.5662e-02_r8,2.1511e-02_r8,1.8646e-02_r8/) + kao(:, 3, 1, 5) = (/ & + &3.5230e-06_r8,2.4421e-03_r8,4.8659e-03_r8,7.3919e-03_r8,1.0064e-02_r8,1.3080e-02_r8, & + &1.6864e-02_r8,2.3200e-02_r8,2.0105e-02_r8/) + kao(:, 4, 1, 5) = (/ & + &3.8970e-06_r8,2.6162e-03_r8,5.2335e-03_r8,7.9722e-03_r8,1.0895e-02_r8,1.4129e-02_r8, & + &1.8093e-02_r8,2.4994e-02_r8,2.1780e-02_r8/) + kao(:, 5, 1, 5) = (/ & + &4.2153e-06_r8,2.7842e-03_r8,5.5880e-03_r8,8.5221e-03_r8,1.1648e-02_r8,1.5136e-02_r8, & + &1.9474e-02_r8,2.6742e-02_r8,2.3280e-02_r8/) + kao(:, 1, 2, 5) = (/ & + &3.8170e-06_r8,1.7299e-03_r8,3.3770e-03_r8,5.0561e-03_r8,6.8488e-03_r8,8.8137e-03_r8, & + &1.1142e-02_r8,1.4709e-02_r8,1.3674e-02_r8/) + kao(:, 2, 2, 5) = (/ & + &4.3252e-06_r8,1.8890e-03_r8,3.6509e-03_r8,5.4769e-03_r8,7.4269e-03_r8,9.5439e-03_r8, & + &1.2081e-02_r8,1.6033e-02_r8,1.4831e-02_r8/) + kao(:, 3, 2, 5) = (/ & + &4.7646e-06_r8,2.0435e-03_r8,3.9774e-03_r8,5.9664e-03_r8,8.0622e-03_r8,1.0295e-02_r8, & + &1.3026e-02_r8,1.7373e-02_r8,1.6093e-02_r8/) + kao(:, 4, 2, 5) = (/ & + &5.2162e-06_r8,2.1898e-03_r8,4.2814e-03_r8,6.4462e-03_r8,8.7251e-03_r8,1.1197e-02_r8, & + &1.4093e-02_r8,1.8642e-02_r8,1.7418e-02_r8/) + kao(:, 5, 2, 5) = (/ & + &5.6571e-06_r8,2.3346e-03_r8,4.5674e-03_r8,6.8936e-03_r8,9.3452e-03_r8,1.2004e-02_r8, & + &1.5146e-02_r8,2.0072e-02_r8,1.8662e-02_r8/) + kao(:, 1, 3, 5) = (/ & + &6.7841e-06_r8,1.4874e-03_r8,2.7805e-03_r8,4.0760e-03_r8,5.3909e-03_r8,6.7517e-03_r8, & + &8.3542e-03_r8,1.0487e-02_r8,1.0633e-02_r8/) + kao(:, 2, 3, 5) = (/ & + &7.5652e-06_r8,1.6242e-03_r8,3.0372e-03_r8,4.4125e-03_r8,5.8428e-03_r8,7.3572e-03_r8, & + &9.0599e-03_r8,1.1418e-02_r8,1.1564e-02_r8/) + kao(:, 3, 3, 5) = (/ & + &8.3338e-06_r8,1.7491e-03_r8,3.3027e-03_r8,4.8269e-03_r8,6.3750e-03_r8,7.9902e-03_r8, & + &9.8070e-03_r8,1.2345e-02_r8,1.2611e-02_r8/) + kao(:, 4, 3, 5) = (/ & + &9.1322e-06_r8,1.8750e-03_r8,3.5479e-03_r8,5.2057e-03_r8,6.8969e-03_r8,8.6842e-03_r8, & + &1.0693e-02_r8,1.3305e-02_r8,1.3678e-02_r8/) + kao(:, 5, 3, 5) = (/ & + &9.9531e-06_r8,2.0097e-03_r8,3.7981e-03_r8,5.5735e-03_r8,7.4004e-03_r8,9.3447e-03_r8, & + &1.1509e-02_r8,1.4423e-02_r8,1.4706e-02_r8/) + kao(:, 1, 4, 5) = (/ & + &1.2103e-05_r8,1.3043e-03_r8,2.3537e-03_r8,3.3772e-03_r8,4.3942e-03_r8,5.3862e-03_r8, & + &6.4402e-03_r8,7.7504e-03_r8,8.3034e-03_r8/) + kao(:, 2, 4, 5) = (/ & + &1.3453e-05_r8,1.4203e-03_r8,2.5925e-03_r8,3.7016e-03_r8,4.7682e-03_r8,5.8654e-03_r8, & + &7.0102e-03_r8,8.4347e-03_r8,9.0709e-03_r8/) + kao(:, 3, 4, 5) = (/ & + &1.4828e-05_r8,1.5367e-03_r8,2.8071e-03_r8,4.0356e-03_r8,5.2345e-03_r8,6.4096e-03_r8, & + &7.5937e-03_r8,9.1611e-03_r8,9.8978e-03_r8/) + kao(:, 4, 4, 5) = (/ & + &1.6265e-05_r8,1.6502e-03_r8,3.0181e-03_r8,4.3485e-03_r8,5.6510e-03_r8,6.9455e-03_r8, & + &8.2885e-03_r8,9.9540e-03_r8,1.0767e-02_r8/) + kao(:, 5, 4, 5) = (/ & + &1.7755e-05_r8,1.7615e-03_r8,3.2390e-03_r8,4.6692e-03_r8,6.0695e-03_r8,7.4667e-03_r8, & + &8.9542e-03_r8,1.0781e-02_r8,1.1635e-02_r8/) + kao(:, 1, 5, 5) = (/ & + &2.0332e-05_r8,1.1698e-03_r8,2.0394e-03_r8,2.8422e-03_r8,3.6398e-03_r8,4.4106e-03_r8, & + &5.1682e-03_r8,5.9629e-03_r8,6.5029e-03_r8/) + kao(:, 2, 5, 5) = (/ & + &2.2530e-05_r8,1.2736e-03_r8,2.2339e-03_r8,3.1431e-03_r8,3.9975e-03_r8,4.8072e-03_r8, & + &5.6451e-03_r8,6.5119e-03_r8,7.1285e-03_r8/) + kao(:, 3, 5, 5) = (/ & + &2.4796e-05_r8,1.3790e-03_r8,2.4265e-03_r8,3.4174e-03_r8,4.3749e-03_r8,5.2936e-03_r8, & + &6.1677e-03_r8,7.0807e-03_r8,7.7613e-03_r8/) + kao(:, 4, 5, 5) = (/ & + &2.7075e-05_r8,1.4796e-03_r8,2.6222e-03_r8,3.6840e-03_r8,4.7300e-03_r8,5.7397e-03_r8, & + &6.7237e-03_r8,7.7301e-03_r8,8.5090e-03_r8/) + kao(:, 5, 5, 5) = (/ & + &2.9544e-05_r8,1.5786e-03_r8,2.8146e-03_r8,3.9658e-03_r8,5.0797e-03_r8,6.1834e-03_r8, & + &7.2517e-03_r8,8.3791e-03_r8,9.2155e-03_r8/) + kao(:, 1, 6, 5) = (/ & + &3.1599e-05_r8,1.0623e-03_r8,1.7784e-03_r8,2.4227e-03_r8,3.0276e-03_r8,3.6296e-03_r8, & + &4.1838e-03_r8,4.7343e-03_r8,5.0477e-03_r8/) + kao(:, 2, 6, 5) = (/ & + &3.5232e-05_r8,1.1598e-03_r8,1.9531e-03_r8,2.6761e-03_r8,3.3625e-03_r8,3.9768e-03_r8, & + &4.5866e-03_r8,5.2016e-03_r8,5.5671e-03_r8/) + kao(:, 3, 6, 5) = (/ & + &3.8902e-05_r8,1.2546e-03_r8,2.1314e-03_r8,2.9272e-03_r8,3.6836e-03_r8,4.3880e-03_r8, & + &5.0585e-03_r8,5.6644e-03_r8,6.0941e-03_r8/) + kao(:, 4, 6, 5) = (/ & + &4.2647e-05_r8,1.3467e-03_r8,2.3051e-03_r8,3.1735e-03_r8,3.9922e-03_r8,4.7680e-03_r8, & + &5.5151e-03_r8,6.2191e-03_r8,6.7036e-03_r8/) + kao(:, 5, 6, 5) = (/ & + &4.6653e-05_r8,1.4422e-03_r8,2.4729e-03_r8,3.4216e-03_r8,4.3101e-03_r8,5.1401e-03_r8, & + &5.9675e-03_r8,6.7430e-03_r8,7.2989e-03_r8/) + kao(:, 1, 7, 5) = (/ & + &5.0846e-05_r8,1.0315e-03_r8,1.6111e-03_r8,2.1236e-03_r8,2.5799e-03_r8,3.0310e-03_r8, & + &3.4624e-03_r8,3.8172e-03_r8,3.8938e-03_r8/) + kao(:, 2, 7, 5) = (/ & + &5.6601e-05_r8,1.1149e-03_r8,1.7798e-03_r8,2.3658e-03_r8,2.8898e-03_r8,3.3716e-03_r8, & + &3.7952e-03_r8,4.1967e-03_r8,4.3621e-03_r8/) + kao(:, 3, 7, 5) = (/ & + &6.2823e-05_r8,1.2046e-03_r8,1.9431e-03_r8,2.5998e-03_r8,3.1765e-03_r8,3.7177e-03_r8, & + &4.2137e-03_r8,4.5955e-03_r8,4.7978e-03_r8/) + kao(:, 4, 7, 5) = (/ & + &6.9611e-05_r8,1.2957e-03_r8,2.0957e-03_r8,2.8201e-03_r8,3.4636e-03_r8,4.0605e-03_r8, & + &4.6007e-03_r8,5.0741e-03_r8,5.2639e-03_r8/) + kao(:, 5, 7, 5) = (/ & + &7.6939e-05_r8,1.3859e-03_r8,2.2478e-03_r8,3.0375e-03_r8,3.7523e-03_r8,4.4027e-03_r8, & + &4.9784e-03_r8,5.5148e-03_r8,5.7724e-03_r8/) + kao(:, 1, 8, 5) = (/ & + &9.6301e-05_r8,1.1719e-03_r8,1.6543e-03_r8,2.0770e-03_r8,2.3972e-03_r8,2.6733e-03_r8, & + &2.9412e-03_r8,3.1694e-03_r8,3.0111e-03_r8/) + kao(:, 2, 8, 5) = (/ & + &1.0686e-04_r8,1.2764e-03_r8,1.7930e-03_r8,2.2808e-03_r8,2.6778e-03_r8,3.0239e-03_r8, & + &3.3001e-03_r8,3.5015e-03_r8,3.3999e-03_r8/) + kao(:, 3, 8, 5) = (/ & + &1.1947e-04_r8,1.3739e-03_r8,1.9473e-03_r8,2.4712e-03_r8,2.9582e-03_r8,3.3516e-03_r8, & + &3.6623e-03_r8,3.8834e-03_r8,3.7468e-03_r8/) + kao(:, 4, 8, 5) = (/ & + &1.3232e-04_r8,1.4765e-03_r8,2.1012e-03_r8,2.6685e-03_r8,3.2209e-03_r8,3.6672e-03_r8, & + &4.0113e-03_r8,4.2720e-03_r8,4.1080e-03_r8/) + kao(:, 5, 8, 5) = (/ & + &1.4706e-04_r8,1.5789e-03_r8,2.2554e-03_r8,2.8711e-03_r8,3.4655e-03_r8,3.9725e-03_r8, & + &4.3795e-03_r8,4.6534e-03_r8,4.5441e-03_r8/) + kao(:, 1, 9, 5) = (/ & + &3.5361e-04_r8,1.7799e-03_r8,2.5051e-03_r8,2.9026e-03_r8,3.0684e-03_r8,3.1720e-03_r8, & + &3.1736e-03_r8,2.9481e-03_r8,2.3479e-03_r8/) + kao(:, 2, 9, 5) = (/ & + &3.8911e-04_r8,1.9917e-03_r8,2.7818e-03_r8,3.1870e-03_r8,3.3554e-03_r8,3.4634e-03_r8, & + &3.5258e-03_r8,3.3674e-03_r8,2.6687e-03_r8/) + kao(:, 3, 9, 5) = (/ & + &4.2895e-04_r8,2.2031e-03_r8,3.0511e-03_r8,3.4571e-03_r8,3.6423e-03_r8,3.7656e-03_r8, & + &3.8544e-03_r8,3.7669e-03_r8,2.9800e-03_r8/) + kao(:, 4, 9, 5) = (/ & + &4.7521e-04_r8,2.4131e-03_r8,3.3032e-03_r8,3.7275e-03_r8,3.9589e-03_r8,4.0895e-03_r8, & + &4.1693e-03_r8,4.1455e-03_r8,3.3334e-03_r8/) + kao(:, 5, 9, 5) = (/ & + &5.2696e-04_r8,2.6212e-03_r8,3.5469e-03_r8,4.0100e-03_r8,4.2674e-03_r8,4.4062e-03_r8, & + &4.4862e-03_r8,4.5098e-03_r8,3.6774e-03_r8/) + kao(:, 1,10, 5) = (/ & + &1.5564e-03_r8,3.2260e-03_r8,4.0223e-03_r8,4.5990e-03_r8,4.8864e-03_r8,4.9553e-03_r8, & + &4.6372e-03_r8,3.8115e-03_r8,2.4163e-03_r8/) + kao(:, 2,10, 5) = (/ & + &1.6655e-03_r8,3.5530e-03_r8,4.4984e-03_r8,5.1615e-03_r8,5.5140e-03_r8,5.5636e-03_r8, & + &5.1458e-03_r8,4.1627e-03_r8,2.8169e-03_r8/) + kao(:, 3,10, 5) = (/ & + &1.7970e-03_r8,3.9283e-03_r8,4.9975e-03_r8,5.7194e-03_r8,6.1431e-03_r8,6.1500e-03_r8, & + &5.6336e-03_r8,4.5688e-03_r8,3.2157e-03_r8/) + kao(:, 4,10, 5) = (/ & + &1.9389e-03_r8,4.3419e-03_r8,5.5082e-03_r8,6.3036e-03_r8,6.7602e-03_r8,6.7061e-03_r8, & + &6.1219e-03_r8,4.9831e-03_r8,3.5478e-03_r8/) + kao(:, 5,10, 5) = (/ & + &2.1200e-03_r8,4.8101e-03_r8,6.0597e-03_r8,6.9046e-03_r8,7.3538e-03_r8,7.2522e-03_r8, & + &6.6229e-03_r8,5.4082e-03_r8,3.8617e-03_r8/) + kao(:, 1,11, 5) = (/ & + &2.5844e-03_r8,4.2072e-03_r8,4.7201e-03_r8,5.1141e-03_r8,5.3078e-03_r8,5.2931e-03_r8, & + &4.9397e-03_r8,3.9983e-03_r8,2.6464e-03_r8/) + kao(:, 2,11, 5) = (/ & + &2.7239e-03_r8,4.5852e-03_r8,5.1921e-03_r8,5.6631e-03_r8,5.9270e-03_r8,5.9381e-03_r8, & + &5.5459e-03_r8,4.4351e-03_r8,2.9283e-03_r8/) + kao(:, 3,11, 5) = (/ & + &2.8937e-03_r8,4.9994e-03_r8,5.7378e-03_r8,6.2452e-03_r8,6.5647e-03_r8,6.5969e-03_r8, & + &6.1297e-03_r8,4.8694e-03_r8,3.2879e-03_r8/) + kao(:, 4,11, 5) = (/ & + &3.0973e-03_r8,5.4803e-03_r8,6.2977e-03_r8,6.8750e-03_r8,7.2241e-03_r8,7.2627e-03_r8, & + &6.7036e-03_r8,5.3184e-03_r8,3.6746e-03_r8/) + kao(:, 5,11, 5) = (/ & + &3.3444e-03_r8,6.0139e-03_r8,6.9682e-03_r8,7.5496e-03_r8,7.9438e-03_r8,7.9183e-03_r8, & + &7.2786e-03_r8,5.7800e-03_r8,4.1120e-03_r8/) + kao(:, 1,12, 5) = (/ & + &3.1142e-03_r8,4.6509e-03_r8,5.0639e-03_r8,5.2099e-03_r8,5.2596e-03_r8,5.1306e-03_r8, & + &4.7167e-03_r8,3.8189e-03_r8,2.7150e-03_r8/) + kao(:, 2,12, 5) = (/ & + &3.2756e-03_r8,5.0359e-03_r8,5.5390e-03_r8,5.7321e-03_r8,5.8154e-03_r8,5.7214e-03_r8, & + &5.2745e-03_r8,4.2400e-03_r8,3.0513e-03_r8/) + kao(:, 3,12, 5) = (/ & + &3.4985e-03_r8,5.4685e-03_r8,6.0590e-03_r8,6.2917e-03_r8,6.4404e-03_r8,6.3170e-03_r8, & + &5.8354e-03_r8,4.6512e-03_r8,3.3763e-03_r8/) + kao(:, 4,12, 5) = (/ & + &3.7766e-03_r8,5.9630e-03_r8,6.6546e-03_r8,6.9419e-03_r8,7.0961e-03_r8,6.9336e-03_r8, & + &6.4037e-03_r8,5.0749e-03_r8,3.7160e-03_r8/) + kao(:, 5,12, 5) = (/ & + &4.1085e-03_r8,6.5232e-03_r8,7.2797e-03_r8,7.6482e-03_r8,7.7587e-03_r8,7.5770e-03_r8, & + &6.9583e-03_r8,5.5150e-03_r8,4.0847e-03_r8/) + kao(:, 1,13, 5) = (/ & + &2.9969e-03_r8,4.3888e-03_r8,4.7684e-03_r8,4.8307e-03_r8,4.7938e-03_r8,4.5847e-03_r8, & + &4.1916e-03_r8,3.3359e-03_r8,2.6072e-03_r8/) + kao(:, 2,13, 5) = (/ & + &3.2153e-03_r8,4.7897e-03_r8,5.2331e-03_r8,5.3333e-03_r8,5.2913e-03_r8,5.1054e-03_r8, & + &4.6633e-03_r8,3.6830e-03_r8,2.9306e-03_r8/) + kao(:, 3,13, 5) = (/ & + &3.4754e-03_r8,5.2096e-03_r8,5.7373e-03_r8,5.8606e-03_r8,5.8296e-03_r8,5.6492e-03_r8, & + &5.1331e-03_r8,4.0274e-03_r8,3.2891e-03_r8/) + kao(:, 4,13, 5) = (/ & + &3.7596e-03_r8,5.6812e-03_r8,6.2772e-03_r8,6.4413e-03_r8,6.4105e-03_r8,6.2095e-03_r8, & + &5.6055e-03_r8,4.3924e-03_r8,3.6856e-03_r8/) + kao(:, 5,13, 5) = (/ & + &4.1250e-03_r8,6.2069e-03_r8,6.8482e-03_r8,7.0531e-03_r8,7.0243e-03_r8,6.7656e-03_r8, & + &6.0849e-03_r8,4.7766e-03_r8,4.1519e-03_r8/) + kao(:, 1, 1, 6) = (/ & + &8.6000e-06_r8,4.4651e-03_r8,9.0097e-03_r8,1.3704e-02_r8,1.8645e-02_r8,2.4046e-02_r8, & + &3.0633e-02_r8,4.1152e-02_r8,3.7281e-02_r8/) + kao(:, 2, 1, 6) = (/ & + &9.1677e-06_r8,4.8343e-03_r8,9.7595e-03_r8,1.4853e-02_r8,2.0235e-02_r8,2.6158e-02_r8, & + &3.3249e-02_r8,4.4739e-02_r8,4.0461e-02_r8/) + kao(:, 3, 1, 6) = (/ & + &9.7617e-06_r8,5.2064e-03_r8,1.0520e-02_r8,1.6024e-02_r8,2.1831e-02_r8,2.8229e-02_r8, & + &3.6006e-02_r8,4.8415e-02_r8,4.3651e-02_r8/) + kao(:, 4, 1, 6) = (/ & + &1.0395e-05_r8,5.5866e-03_r8,1.1290e-02_r8,1.7191e-02_r8,2.3426e-02_r8,3.0307e-02_r8, & + &3.8717e-02_r8,5.2240e-02_r8,4.6842e-02_r8/) + kao(:, 5, 1, 6) = (/ & + &1.1075e-05_r8,5.9593e-03_r8,1.2050e-02_r8,1.8360e-02_r8,2.5043e-02_r8,3.2426e-02_r8, & + &4.1434e-02_r8,5.5912e-02_r8,5.0074e-02_r8/) + kao(:, 1, 2, 6) = (/ & + &1.1648e-05_r8,3.7355e-03_r8,7.3892e-03_r8,1.1190e-02_r8,1.5132e-02_r8,1.9317e-02_r8, & + &2.4213e-02_r8,3.1544e-02_r8,3.0250e-02_r8/) + kao(:, 2, 2, 6) = (/ & + &1.2445e-05_r8,4.0410e-03_r8,8.0302e-03_r8,1.2160e-02_r8,1.6448e-02_r8,2.1055e-02_r8, & + &2.6369e-02_r8,3.4311e-02_r8,3.2880e-02_r8/) + kao(:, 3, 2, 6) = (/ & + &1.3310e-05_r8,4.3542e-03_r8,8.6703e-03_r8,1.3133e-02_r8,1.7778e-02_r8,2.2773e-02_r8, & + &2.8564e-02_r8,3.7228e-02_r8,3.5538e-02_r8/) + kao(:, 4, 2, 6) = (/ & + &1.4232e-05_r8,4.6616e-03_r8,9.3074e-03_r8,1.4103e-02_r8,1.9095e-02_r8,2.4467e-02_r8, & + &3.0730e-02_r8,4.0202e-02_r8,3.8172e-02_r8/) + kao(:, 5, 2, 6) = (/ & + &1.5231e-05_r8,4.9691e-03_r8,9.9386e-03_r8,1.5066e-02_r8,2.0413e-02_r8,2.6167e-02_r8, & + &3.2915e-02_r8,4.3077e-02_r8,4.0807e-02_r8/) + kao(:, 1, 3, 6) = (/ & + &2.0796e-05_r8,3.1636e-03_r8,6.0427e-03_r8,8.9479e-03_r8,1.1951e-02_r8,1.5111e-02_r8, & + &1.8532e-02_r8,2.3072e-02_r8,2.3870e-02_r8/) + kao(:, 2, 3, 6) = (/ & + &2.2285e-05_r8,3.4357e-03_r8,6.5684e-03_r8,9.7449e-03_r8,1.3046e-02_r8,1.6505e-02_r8, & + &2.0281e-02_r8,2.5200e-02_r8,2.6059e-02_r8/) + kao(:, 3, 3, 6) = (/ & + &2.3921e-05_r8,3.7148e-03_r8,7.1066e-03_r8,1.0556e-02_r8,1.4151e-02_r8,1.7911e-02_r8, & + &2.2018e-02_r8,2.7457e-02_r8,2.8268e-02_r8/) + kao(:, 4, 3, 6) = (/ & + &2.5678e-05_r8,3.9815e-03_r8,7.6234e-03_r8,1.1355e-02_r8,1.5233e-02_r8,1.9276e-02_r8, & + &2.3703e-02_r8,2.9635e-02_r8,3.0431e-02_r8/) + kao(:, 5, 3, 6) = (/ & + &2.7604e-05_r8,4.2441e-03_r8,8.1373e-03_r8,1.2146e-02_r8,1.6312e-02_r8,2.0656e-02_r8, & + &2.5417e-02_r8,3.1780e-02_r8,3.2590e-02_r8/) + kao(:, 1, 4, 6) = (/ & + &3.7548e-05_r8,2.7525e-03_r8,5.0829e-03_r8,7.3519e-03_r8,9.5921e-03_r8,1.1880e-02_r8, & + &1.4330e-02_r8,1.7270e-02_r8,1.8770e-02_r8/) + kao(:, 2, 4, 6) = (/ & + &4.0479e-05_r8,3.0018e-03_r8,5.5477e-03_r8,8.0335e-03_r8,1.0500e-02_r8,1.3017e-02_r8, & + &1.5741e-02_r8,1.8989e-02_r8,2.0592e-02_r8/) + kao(:, 3, 4, 6) = (/ & + &4.3632e-05_r8,3.2358e-03_r8,6.0288e-03_r8,8.7218e-03_r8,1.1388e-02_r8,1.4152e-02_r8, & + &1.7154e-02_r8,2.0724e-02_r8,2.2417e-02_r8/) + kao(:, 4, 4, 6) = (/ & + &4.6956e-05_r8,3.4641e-03_r8,6.4839e-03_r8,9.3953e-03_r8,1.2286e-02_r8,1.5294e-02_r8, & + &1.8543e-02_r8,2.2416e-02_r8,2.4245e-02_r8/) + kao(:, 5, 4, 6) = (/ & + &5.0658e-05_r8,3.6946e-03_r8,6.9352e-03_r8,1.0060e-02_r8,1.3165e-02_r8,1.6424e-02_r8, & + &1.9935e-02_r8,2.4115e-02_r8,2.6056e-02_r8/) + kao(:, 1, 5, 6) = (/ & + &6.1528e-05_r8,2.4644e-03_r8,4.3512e-03_r8,6.1626e-03_r8,7.9327e-03_r8,9.6496e-03_r8, & + &1.1347e-02_r8,1.3264e-02_r8,1.4745e-02_r8/) + kao(:, 2, 5, 6) = (/ & + &6.6793e-05_r8,2.6844e-03_r8,4.7746e-03_r8,6.7632e-03_r8,8.7202e-03_r8,1.0626e-02_r8, & + &1.2508e-02_r8,1.4649e-02_r8,1.6279e-02_r8/) + kao(:, 3, 5, 6) = (/ & + &7.2459e-05_r8,2.8961e-03_r8,5.1774e-03_r8,7.3853e-03_r8,9.5105e-03_r8,1.1570e-02_r8, & + &1.3632e-02_r8,1.6051e-02_r8,1.7802e-02_r8/) + kao(:, 4, 5, 6) = (/ & + &7.8727e-05_r8,3.1045e-03_r8,5.5659e-03_r8,7.9693e-03_r8,1.0288e-02_r8,1.2541e-02_r8, & + &1.4785e-02_r8,1.7438e-02_r8,1.9338e-02_r8/) + kao(:, 5, 5, 6) = (/ & + &8.5530e-05_r8,3.3182e-03_r8,5.9543e-03_r8,8.5528e-03_r8,1.1059e-02_r8,1.3485e-02_r8, & + &1.5922e-02_r8,1.8829e-02_r8,2.0873e-02_r8/) + kao(:, 1, 6, 6) = (/ & + &9.4265e-05_r8,2.2301e-03_r8,3.8046e-03_r8,5.2488e-03_r8,6.6170e-03_r8,7.9289e-03_r8, & + &9.1950e-03_r8,1.0423e-02_r8,1.1518e-02_r8/) + kao(:, 2, 6, 6) = (/ & + &1.0266e-04_r8,2.4246e-03_r8,4.1792e-03_r8,5.7800e-03_r8,7.2894e-03_r8,8.7747e-03_r8, & + &1.0200e-02_r8,1.1548e-02_r8,1.2780e-02_r8/) + kao(:, 3, 6, 6) = (/ & + &1.1200e-04_r8,2.6239e-03_r8,4.5381e-03_r8,6.2992e-03_r8,7.9916e-03_r8,9.6188e-03_r8, & + &1.1174e-02_r8,1.2683e-02_r8,1.4059e-02_r8/) + kao(:, 4, 6, 6) = (/ & + &1.2224e-04_r8,2.8287e-03_r8,4.8898e-03_r8,6.8010e-03_r8,8.6582e-03_r8,1.0462e-02_r8, & + &1.2176e-02_r8,1.3803e-02_r8,1.5334e-02_r8/) + kao(:, 5, 6, 6) = (/ & + &1.3337e-04_r8,3.0366e-03_r8,5.2437e-03_r8,7.3027e-03_r8,9.3153e-03_r8,1.1279e-02_r8, & + &1.3144e-02_r8,1.4949e-02_r8,1.6628e-02_r8/) + kao(:, 1, 7, 6) = (/ & + &1.5263e-04_r8,2.1146e-03_r8,3.4378e-03_r8,4.6052e-03_r8,5.6815e-03_r8,6.6787e-03_r8, & + &7.5592e-03_r8,8.3902e-03_r8,8.9861e-03_r8/) + kao(:, 2, 7, 6) = (/ & + &1.6683e-04_r8,2.3125e-03_r8,3.7648e-03_r8,5.0866e-03_r8,6.2982e-03_r8,7.4001e-03_r8, & + &8.4314e-03_r8,9.3717e-03_r8,1.0001e-02_r8/) + kao(:, 3, 7, 6) = (/ & + &1.8246e-04_r8,2.5152e-03_r8,4.0947e-03_r8,5.5502e-03_r8,6.9009e-03_r8,8.1426e-03_r8, & + &9.2748e-03_r8,1.0344e-02_r8,1.1085e-02_r8/) + kao(:, 4, 7, 6) = (/ & + &1.9965e-04_r8,2.7190e-03_r8,4.4394e-03_r8,6.0162e-03_r8,7.4822e-03_r8,8.8463e-03_r8, & + &1.0151e-02_r8,1.1321e-02_r8,1.2163e-02_r8/) + kao(:, 5, 7, 6) = (/ & + &2.1839e-04_r8,2.9201e-03_r8,4.7890e-03_r8,6.4854e-03_r8,8.0589e-03_r8,9.5473e-03_r8, & + &1.0985e-02_r8,1.2296e-02_r8,1.3266e-02_r8/) + kao(:, 1, 8, 6) = (/ & + &2.9912e-04_r8,2.3311e-03_r8,3.4065e-03_r8,4.3529e-03_r8,5.1991e-03_r8,5.9115e-03_r8, & + &6.5345e-03_r8,6.9536e-03_r8,6.9673e-03_r8/) + kao(:, 2, 8, 6) = (/ & + &3.2667e-04_r8,2.5198e-03_r8,3.7444e-03_r8,4.8113e-03_r8,5.7475e-03_r8,6.5852e-03_r8, & + &7.2722e-03_r8,7.8027e-03_r8,7.8100e-03_r8/) + kao(:, 3, 8, 6) = (/ & + &3.5783e-04_r8,2.7045e-03_r8,4.0852e-03_r8,5.2736e-03_r8,6.2947e-03_r8,7.2359e-03_r8, & + &8.0488e-03_r8,8.6314e-03_r8,8.7294e-03_r8/) + kao(:, 4, 8, 6) = (/ & + &3.9253e-04_r8,2.8930e-03_r8,4.4286e-03_r8,5.7246e-03_r8,6.8467e-03_r8,7.8891e-03_r8, & + &8.7826e-03_r8,9.4970e-03_r8,9.6421e-03_r8/) + kao(:, 5, 8, 6) = (/ & + &4.3012e-04_r8,3.0887e-03_r8,4.7690e-03_r8,6.1815e-03_r8,7.4286e-03_r8,8.5468e-03_r8, & + &9.5146e-03_r8,1.0319e-02_r8,1.0565e-02_r8/) + kao(:, 1, 9, 6) = (/ & + &1.0976e-03_r8,4.1506e-03_r8,5.1147e-03_r8,5.7794e-03_r8,6.2915e-03_r8,6.5755e-03_r8, & + &6.7173e-03_r8,6.5721e-03_r8,5.2619e-03_r8/) + kao(:, 2, 9, 6) = (/ & + &1.2019e-03_r8,4.4814e-03_r8,5.5166e-03_r8,6.2823e-03_r8,6.8818e-03_r8,7.2627e-03_r8, & + &7.4725e-03_r8,7.3662e-03_r8,5.9464e-03_r8/) + kao(:, 3, 9, 6) = (/ & + &1.3207e-03_r8,4.7927e-03_r8,5.9242e-03_r8,6.7576e-03_r8,7.4599e-03_r8,7.9614e-03_r8, & + &8.2442e-03_r8,8.1477e-03_r8,6.6764e-03_r8/) + kao(:, 4, 9, 6) = (/ & + &1.4520e-03_r8,5.0989e-03_r8,6.3402e-03_r8,7.2519e-03_r8,8.0196e-03_r8,8.6608e-03_r8, & + &9.0083e-03_r8,8.9373e-03_r8,7.4095e-03_r8/) + kao(:, 5, 9, 6) = (/ & + &1.5966e-03_r8,5.4241e-03_r8,6.7693e-03_r8,7.7581e-03_r8,8.6262e-03_r8,9.3645e-03_r8, & + &9.7704e-03_r8,9.7289e-03_r8,8.1550e-03_r8/) + kao(:, 1,10, 6) = (/ & + &4.4394e-03_r8,9.1190e-03_r8,1.0725e-02_r8,1.1220e-02_r8,1.1152e-02_r8,1.0508e-02_r8, & + &9.4386e-03_r8,7.8107e-03_r8,4.9143e-03_r8/) + kao(:, 2,10, 6) = (/ & + &4.8803e-03_r8,1.0187e-02_r8,1.1809e-02_r8,1.2265e-02_r8,1.2072e-02_r8,1.1380e-02_r8, & + &1.0318e-02_r8,8.6414e-03_r8,5.6112e-03_r8/) + kao(:, 3,10, 6) = (/ & + &5.3784e-03_r8,1.1243e-02_r8,1.2866e-02_r8,1.3294e-02_r8,1.2988e-02_r8,1.2282e-02_r8, & + &1.1181e-02_r8,9.4518e-03_r8,6.2671e-03_r8/) + kao(:, 4,10, 6) = (/ & + &5.9406e-03_r8,1.2247e-02_r8,1.3888e-02_r8,1.4276e-02_r8,1.3911e-02_r8,1.3225e-02_r8, & + &1.2026e-02_r8,1.0238e-02_r8,6.9421e-03_r8/) + kao(:, 5,10, 6) = (/ & + &6.5660e-03_r8,1.3194e-02_r8,1.4891e-02_r8,1.5253e-02_r8,1.4902e-02_r8,1.4176e-02_r8, & + &1.2864e-02_r8,1.1066e-02_r8,7.6281e-03_r8/) + kao(:, 1,11, 6) = (/ & + &6.6711e-03_r8,1.1267e-02_r8,1.2748e-02_r8,1.3242e-02_r8,1.2977e-02_r8,1.2030e-02_r8, & + &1.0523e-02_r8,8.3002e-03_r8,5.3202e-03_r8/) + kao(:, 2,11, 6) = (/ & + &7.3092e-03_r8,1.2565e-02_r8,1.4207e-02_r8,1.4653e-02_r8,1.4245e-02_r8,1.3138e-02_r8, & + &1.1437e-02_r8,9.1124e-03_r8,6.0956e-03_r8/) + kao(:, 3,11, 6) = (/ & + &8.0261e-03_r8,1.3900e-02_r8,1.5599e-02_r8,1.6022e-02_r8,1.5510e-02_r8,1.4232e-02_r8, & + &1.2399e-02_r8,9.8954e-03_r8,6.7920e-03_r8/) + kao(:, 4,11, 6) = (/ & + &8.8835e-03_r8,1.5218e-02_r8,1.7018e-02_r8,1.7348e-02_r8,1.6755e-02_r8,1.5328e-02_r8, & + &1.3427e-02_r8,1.0676e-02_r8,7.4156e-03_r8/) + kao(:, 5,11, 6) = (/ & + &9.8592e-03_r8,1.6591e-02_r8,1.8382e-02_r8,1.8693e-02_r8,1.7995e-02_r8,1.6489e-02_r8, & + &1.4464e-02_r8,1.1488e-02_r8,8.0687e-03_r8/) + kao(:, 1,12, 6) = (/ & + &7.8286e-03_r8,1.1844e-02_r8,1.2951e-02_r8,1.3269e-02_r8,1.2819e-02_r8,1.1719e-02_r8, & + &1.0146e-02_r8,7.7901e-03_r8,5.3706e-03_r8/) + kao(:, 2,12, 6) = (/ & + &8.5205e-03_r8,1.3089e-02_r8,1.4355e-02_r8,1.4624e-02_r8,1.4116e-02_r8,1.2895e-02_r8, & + &1.1103e-02_r8,8.5730e-03_r8,5.9882e-03_r8/) + kao(:, 3,12, 6) = (/ & + &9.3309e-03_r8,1.4405e-02_r8,1.5746e-02_r8,1.6010e-02_r8,1.5387e-02_r8,1.4067e-02_r8, & + &1.2065e-02_r8,9.3726e-03_r8,6.6686e-03_r8/) + kao(:, 4,12, 6) = (/ & + &1.0285e-02_r8,1.5780e-02_r8,1.7147e-02_r8,1.7368e-02_r8,1.6677e-02_r8,1.5224e-02_r8, & + &1.3058e-02_r8,1.0197e-02_r8,7.3827e-03_r8/) + kao(:, 5,12, 6) = (/ & + &1.1378e-02_r8,1.7192e-02_r8,1.8621e-02_r8,1.8778e-02_r8,1.8045e-02_r8,1.6433e-02_r8, & + &1.4105e-02_r8,1.1017e-02_r8,8.1428e-03_r8/) + kao(:, 1,13, 6) = (/ & + &7.7075e-03_r8,1.1053e-02_r8,1.1788e-02_r8,1.1798e-02_r8,1.1282e-02_r8,1.0218e-02_r8, & + &8.7608e-03_r8,6.6974e-03_r8,4.9774e-03_r8/) + kao(:, 2,13, 6) = (/ & + &8.3931e-03_r8,1.2074e-02_r8,1.2868e-02_r8,1.2866e-02_r8,1.2320e-02_r8,1.1165e-02_r8, & + &9.5984e-03_r8,7.4025e-03_r8,5.6029e-03_r8/) + kao(:, 3,13, 6) = (/ & + &9.1257e-03_r8,1.3198e-02_r8,1.3994e-02_r8,1.3989e-02_r8,1.3400e-02_r8,1.2194e-02_r8, & + &1.0455e-02_r8,8.1317e-03_r8,6.2279e-03_r8/) + kao(:, 4,13, 6) = (/ & + &9.9594e-03_r8,1.4337e-02_r8,1.5200e-02_r8,1.5161e-02_r8,1.4494e-02_r8,1.3263e-02_r8, & + &1.1356e-02_r8,8.8525e-03_r8,6.8478e-03_r8/) + kao(:, 5,13, 6) = (/ & + &1.0855e-02_r8,1.5527e-02_r8,1.6501e-02_r8,1.6412e-02_r8,1.5661e-02_r8,1.4395e-02_r8, & + &1.2355e-02_r8,9.5887e-03_r8,7.3951e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &2.8482e-05_r8,1.1072e-02_r8,2.2376e-02_r8,3.4052e-02_r8,4.6363e-02_r8,5.9888e-02_r8, & + &7.6137e-02_r8,1.0147e-01_r8,9.2714e-02_r8/) + kao(:, 2, 1, 7) = (/ & + &2.9459e-05_r8,1.1920e-02_r8,2.4092e-02_r8,3.6662e-02_r8,4.9933e-02_r8,6.4531e-02_r8, & + &8.2136e-02_r8,1.0950e-01_r8,9.9856e-02_r8/) + kao(:, 3, 1, 7) = (/ & + &3.0378e-05_r8,1.2748e-02_r8,2.5776e-02_r8,3.9242e-02_r8,5.3450e-02_r8,6.9069e-02_r8, & + &8.7941e-02_r8,1.1741e-01_r8,1.0689e-01_r8/) + kao(:, 4, 1, 7) = (/ & + &3.1242e-05_r8,1.3565e-02_r8,2.7429e-02_r8,4.1762e-02_r8,5.6896e-02_r8,7.3556e-02_r8, & + &9.3626e-02_r8,1.2500e-01_r8,1.1378e-01_r8/) + kao(:, 5, 1, 7) = (/ & + &3.2096e-05_r8,1.4368e-02_r8,2.9038e-02_r8,4.4226e-02_r8,6.0256e-02_r8,7.7920e-02_r8, & + &9.9246e-02_r8,1.3270e-01_r8,1.2050e-01_r8/) + kao(:, 1, 2, 7) = (/ & + &3.8108e-05_r8,9.1980e-03_r8,1.8505e-02_r8,2.8037e-02_r8,3.7923e-02_r8,4.8524e-02_r8, & + &6.0800e-02_r8,7.8866e-02_r8,7.5829e-02_r8/) + kao(:, 2, 2, 7) = (/ & + &3.9453e-05_r8,9.9404e-03_r8,2.0012e-02_r8,3.0307e-02_r8,4.0999e-02_r8,5.2467e-02_r8, & + &6.5752e-02_r8,8.5496e-02_r8,8.1980e-02_r8/) + kao(:, 3, 2, 7) = (/ & + &4.0728e-05_r8,1.0645e-02_r8,2.1444e-02_r8,3.2483e-02_r8,4.3962e-02_r8,5.6282e-02_r8, & + &7.0607e-02_r8,9.1834e-02_r8,8.7906e-02_r8/) + kao(:, 4, 2, 7) = (/ & + &4.1960e-05_r8,1.1349e-02_r8,2.2852e-02_r8,3.4627e-02_r8,4.6872e-02_r8,6.0009e-02_r8, & + &7.5320e-02_r8,9.8100e-02_r8,9.3725e-02_r8/) + kao(:, 5, 2, 7) = (/ & + &4.3152e-05_r8,1.2042e-02_r8,2.4257e-02_r8,3.6759e-02_r8,4.9754e-02_r8,6.3714e-02_r8, & + &7.9963e-02_r8,1.0426e-01_r8,9.9487e-02_r8/) + kao(:, 1, 3, 7) = (/ & + &6.8682e-05_r8,7.6817e-03_r8,1.5032e-02_r8,2.2610e-02_r8,3.0354e-02_r8,3.8397e-02_r8, & + &4.7144e-02_r8,5.8545e-02_r8,6.0680e-02_r8/) + kao(:, 2, 3, 7) = (/ & + &7.1048e-05_r8,8.3077e-03_r8,1.6309e-02_r8,2.4554e-02_r8,3.2973e-02_r8,4.1716e-02_r8, & + &5.1249e-02_r8,6.3726e-02_r8,6.5916e-02_r8/) + kao(:, 3, 3, 7) = (/ & + &7.3516e-05_r8,8.8904e-03_r8,1.7519e-02_r8,2.6389e-02_r8,3.5446e-02_r8,4.4862e-02_r8, & + &5.5125e-02_r8,6.8637e-02_r8,7.0859e-02_r8/) + kao(:, 4, 3, 7) = (/ & + &7.5927e-05_r8,9.4787e-03_r8,1.8742e-02_r8,2.8235e-02_r8,3.7922e-02_r8,4.7994e-02_r8, & + &5.8964e-02_r8,7.3444e-02_r8,7.5806e-02_r8/) + kao(:, 5, 3, 7) = (/ & + &7.8228e-05_r8,1.0059e-02_r8,1.9946e-02_r8,3.0057e-02_r8,4.0372e-02_r8,5.1096e-02_r8, & + &6.2816e-02_r8,7.8277e-02_r8,8.0701e-02_r8/) + kao(:, 1, 4, 7) = (/ & + &1.2728e-04_r8,6.6847e-03_r8,1.2528e-02_r8,1.8338e-02_r8,2.4310e-02_r8,3.0521e-02_r8, & + &3.7034e-02_r8,4.4629e-02_r8,4.8506e-02_r8/) + kao(:, 2, 4, 7) = (/ & + &1.3229e-04_r8,7.2462e-03_r8,1.3606e-02_r8,1.9949e-02_r8,2.6505e-02_r8,3.3306e-02_r8, & + &4.0432e-02_r8,4.8804e-02_r8,5.2931e-02_r8/) + kao(:, 3, 4, 7) = (/ & + &1.3690e-04_r8,7.7950e-03_r8,1.4636e-02_r8,2.1498e-02_r8,2.8618e-02_r8,3.5967e-02_r8, & + &4.3669e-02_r8,5.2720e-02_r8,5.7159e-02_r8/) + kao(:, 4, 4, 7) = (/ & + &1.4141e-04_r8,8.3363e-03_r8,1.5650e-02_r8,2.3036e-02_r8,3.0707e-02_r8,3.8607e-02_r8, & + &4.6880e-02_r8,5.6623e-02_r8,6.1327e-02_r8/) + kao(:, 5, 4, 7) = (/ & + &1.4572e-04_r8,8.8720e-03_r8,1.6649e-02_r8,2.4570e-02_r8,3.2799e-02_r8,4.1227e-02_r8, & + &5.0069e-02_r8,6.0500e-02_r8,6.5502e-02_r8/) + kao(:, 1, 5, 7) = (/ & + &2.1573e-04_r8,5.8827e-03_r8,1.0779e-02_r8,1.5450e-02_r8,1.9971e-02_r8,2.4513e-02_r8, & + &2.9346e-02_r8,3.4831e-02_r8,3.8718e-02_r8/) + kao(:, 2, 5, 7) = (/ & + &2.2440e-04_r8,6.4009e-03_r8,1.1752e-02_r8,1.6862e-02_r8,2.1813e-02_r8,2.6822e-02_r8, & + &3.2187e-02_r8,3.8239e-02_r8,4.2467e-02_r8/) + kao(:, 3, 5, 7) = (/ & + &2.3312e-04_r8,6.9022e-03_r8,1.2696e-02_r8,1.8213e-02_r8,2.3573e-02_r8,2.9063e-02_r8, & + &3.4955e-02_r8,4.1525e-02_r8,4.6111e-02_r8/) + kao(:, 4, 5, 7) = (/ & + &2.4120e-04_r8,7.3983e-03_r8,1.3629e-02_r8,1.9546e-02_r8,2.5293e-02_r8,3.1249e-02_r8, & + &3.7630e-02_r8,4.4709e-02_r8,4.9634e-02_r8/) + kao(:, 5, 5, 7) = (/ & + &2.4900e-04_r8,7.8813e-03_r8,1.4548e-02_r8,2.0857e-02_r8,2.7012e-02_r8,3.3451e-02_r8, & + &4.0320e-02_r8,4.7915e-02_r8,5.3175e-02_r8/) + kao(:, 1, 6, 7) = (/ & + &3.4036e-04_r8,5.3231e-03_r8,9.2729e-03_r8,1.3061e-02_r8,1.6728e-02_r8,2.0215e-02_r8, & + &2.3560e-02_r8,2.7195e-02_r8,3.0556e-02_r8/) + kao(:, 2, 6, 7) = (/ & + &3.5502e-04_r8,5.8134e-03_r8,1.0151e-02_r8,1.4345e-02_r8,1.8389e-02_r8,2.2227e-02_r8, & + &2.5905e-02_r8,3.0036e-02_r8,3.3756e-02_r8/) + kao(:, 3, 6, 7) = (/ & + &3.6934e-04_r8,6.2790e-03_r8,1.1006e-02_r8,1.5584e-02_r8,1.9972e-02_r8,2.4157e-02_r8, & + &2.8189e-02_r8,3.2811e-02_r8,3.6865e-02_r8/) + kao(:, 4, 6, 7) = (/ & + &3.8386e-04_r8,6.7401e-03_r8,1.1853e-02_r8,1.6807e-02_r8,2.1541e-02_r8,2.6034e-02_r8, & + &3.0406e-02_r8,3.5498e-02_r8,3.9873e-02_r8/) + kao(:, 5, 6, 7) = (/ & + &3.9798e-04_r8,7.1899e-03_r8,1.2680e-02_r8,1.7996e-02_r8,2.3081e-02_r8,2.7888e-02_r8, & + &3.2622e-02_r8,3.8170e-02_r8,4.2864e-02_r8/) + kao(:, 1, 7, 7) = (/ & + &5.6321e-04_r8,5.0131e-03_r8,8.3197e-03_r8,1.1342e-02_r8,1.4164e-02_r8,1.6877e-02_r8, & + &1.9447e-02_r8,2.1713e-02_r8,2.3905e-02_r8/) + kao(:, 2, 7, 7) = (/ & + &5.9016e-04_r8,5.4925e-03_r8,9.1570e-03_r8,1.2482e-02_r8,1.5641e-02_r8,1.8693e-02_r8, & + &2.1556e-02_r8,2.4086e-02_r8,2.6629e-02_r8/) + kao(:, 3, 7, 7) = (/ & + &6.1706e-04_r8,5.9641e-03_r8,9.9615e-03_r8,1.3605e-02_r8,1.7087e-02_r8,2.0445e-02_r8, & + &2.3593e-02_r8,2.6361e-02_r8,2.9262e-02_r8/) + kao(:, 4, 7, 7) = (/ & + &6.4250e-04_r8,6.4355e-03_r8,1.0740e-02_r8,1.4689e-02_r8,1.8507e-02_r8,2.2162e-02_r8, & + &2.5558e-02_r8,2.8565e-02_r8,3.1822e-02_r8/) + kao(:, 5, 7, 7) = (/ & + &6.6706e-04_r8,6.9143e-03_r8,1.1505e-02_r8,1.5753e-02_r8,1.9886e-02_r8,2.3836e-02_r8, & + &2.7497e-02_r8,3.0749e-02_r8,3.4313e-02_r8/) + kao(:, 1, 8, 7) = (/ & + &1.1137e-03_r8,5.2798e-03_r8,8.0960e-03_r8,1.0553e-02_r8,1.2781e-02_r8,1.4788e-02_r8, & + &1.6508e-02_r8,1.7972e-02_r8,1.8634e-02_r8/) + kao(:, 2, 8, 7) = (/ & + &1.1746e-03_r8,5.8110e-03_r8,8.9215e-03_r8,1.1680e-02_r8,1.4167e-02_r8,1.6394e-02_r8, & + &1.8389e-02_r8,2.0091e-02_r8,2.0946e-02_r8/) + kao(:, 3, 8, 7) = (/ & + &1.2333e-03_r8,6.3510e-03_r8,9.7459e-03_r8,1.2786e-02_r8,1.5523e-02_r8,1.7978e-02_r8, & + &2.0210e-02_r8,2.2150e-02_r8,2.3198e-02_r8/) + kao(:, 4, 8, 7) = (/ & + &1.2923e-03_r8,6.8806e-03_r8,1.0573e-02_r8,1.3874e-02_r8,1.6833e-02_r8,1.9520e-02_r8, & + &2.2008e-02_r8,2.4130e-02_r8,2.5397e-02_r8/) + kao(:, 5, 8, 7) = (/ & + &1.3493e-03_r8,7.4001e-03_r8,1.1421e-02_r8,1.4955e-02_r8,1.8119e-02_r8,2.1028e-02_r8, & + &2.3751e-02_r8,2.6082e-02_r8,2.7521e-02_r8/) + kao(:, 1, 9, 7) = (/ & + &4.1652e-03_r8,9.1226e-03_r8,1.1391e-02_r8,1.3127e-02_r8,1.4574e-02_r8,1.5712e-02_r8, & + &1.6412e-02_r8,1.6590e-02_r8,1.4324e-02_r8/) + kao(:, 2, 9, 7) = (/ & + &4.4077e-03_r8,9.7658e-03_r8,1.2393e-02_r8,1.4489e-02_r8,1.6135e-02_r8,1.7441e-02_r8, & + &1.8307e-02_r8,1.8536e-02_r8,1.6186e-02_r8/) + kao(:, 3, 9, 7) = (/ & + &4.6510e-03_r8,1.0425e-02_r8,1.3450e-02_r8,1.5897e-02_r8,1.7759e-02_r8,1.9177e-02_r8, & + &2.0163e-02_r8,2.0445e-02_r8,1.8103e-02_r8/) + kao(:, 4, 9, 7) = (/ & + &4.8932e-03_r8,1.1096e-02_r8,1.4490e-02_r8,1.7265e-02_r8,1.9404e-02_r8,2.0920e-02_r8, & + &2.2008e-02_r8,2.2308e-02_r8,1.9978e-02_r8/) + kao(:, 5, 9, 7) = (/ & + &5.1319e-03_r8,1.1758e-02_r8,1.5541e-02_r8,1.8602e-02_r8,2.0988e-02_r8,2.2688e-02_r8, & + &2.3851e-02_r8,2.4156e-02_r8,2.1799e-02_r8/) + kao(:, 1,10, 7) = (/ & + &1.7349e-02_r8,2.4277e-02_r8,2.5467e-02_r8,2.5566e-02_r8,2.4825e-02_r8,2.3373e-02_r8, & + &2.1223e-02_r8,1.8524e-02_r8,1.1809e-02_r8/) + kao(:, 2,10, 7) = (/ & + &1.8441e-02_r8,2.5550e-02_r8,2.7079e-02_r8,2.7402e-02_r8,2.6767e-02_r8,2.5495e-02_r8, & + &2.3503e-02_r8,2.0675e-02_r8,1.3556e-02_r8/) + kao(:, 3,10, 7) = (/ & + &1.9634e-02_r8,2.6955e-02_r8,2.8784e-02_r8,2.9151e-02_r8,2.8790e-02_r8,2.7521e-02_r8, & + &2.5774e-02_r8,2.2876e-02_r8,1.5334e-02_r8/) + kao(:, 4,10, 7) = (/ & + &2.0834e-02_r8,2.8474e-02_r8,3.0492e-02_r8,3.0988e-02_r8,3.0837e-02_r8,2.9673e-02_r8, & + &2.8036e-02_r8,2.5100e-02_r8,1.7072e-02_r8/) + kao(:, 5,10, 7) = (/ & + &2.2004e-02_r8,3.0118e-02_r8,3.2233e-02_r8,3.2923e-02_r8,3.2760e-02_r8,3.1852e-02_r8, & + &3.0321e-02_r8,2.7280e-02_r8,1.8710e-02_r8/) + kao(:, 1,11, 7) = (/ & + &2.5621e-02_r8,3.2655e-02_r8,3.3386e-02_r8,3.2478e-02_r8,3.0535e-02_r8,2.7796e-02_r8, & + &2.3855e-02_r8,1.8680e-02_r8,1.0565e-02_r8/) + kao(:, 2,11, 7) = (/ & + &2.7487e-02_r8,3.4718e-02_r8,3.5449e-02_r8,3.4659e-02_r8,3.2784e-02_r8,2.9958e-02_r8, & + &2.6042e-02_r8,2.0737e-02_r8,1.2143e-02_r8/) + kao(:, 3,11, 7) = (/ & + &2.9493e-02_r8,3.6885e-02_r8,3.7684e-02_r8,3.6984e-02_r8,3.4999e-02_r8,3.2138e-02_r8, & + &2.8186e-02_r8,2.2834e-02_r8,1.3640e-02_r8/) + kao(:, 4,11, 7) = (/ & + &3.1405e-02_r8,3.9361e-02_r8,4.0123e-02_r8,3.9393e-02_r8,3.7354e-02_r8,3.4345e-02_r8, & + &3.0182e-02_r8,2.4896e-02_r8,1.5233e-02_r8/) + kao(:, 5,11, 7) = (/ & + &3.3372e-02_r8,4.1804e-02_r8,4.2639e-02_r8,4.1888e-02_r8,3.9776e-02_r8,3.6559e-02_r8, & + &3.2377e-02_r8,2.6934e-02_r8,1.6905e-02_r8/) + kao(:, 1,12, 7) = (/ & + &2.8107e-02_r8,3.4513e-02_r8,3.4691e-02_r8,3.3440e-02_r8,3.1149e-02_r8,2.8092e-02_r8, & + &2.3835e-02_r8,1.7987e-02_r8,9.8223e-03_r8/) + kao(:, 2,12, 7) = (/ & + &3.0318e-02_r8,3.7007e-02_r8,3.7165e-02_r8,3.5894e-02_r8,3.3524e-02_r8,3.0240e-02_r8, & + &2.5840e-02_r8,1.9792e-02_r8,1.1332e-02_r8/) + kao(:, 3,12, 7) = (/ & + &3.2580e-02_r8,3.9682e-02_r8,3.9790e-02_r8,3.8457e-02_r8,3.5971e-02_r8,3.2486e-02_r8, & + &2.7883e-02_r8,2.1561e-02_r8,1.2728e-02_r8/) + kao(:, 4,12, 7) = (/ & + &3.4838e-02_r8,4.2408e-02_r8,4.2616e-02_r8,4.1228e-02_r8,3.8571e-02_r8,3.4918e-02_r8, & + &2.9920e-02_r8,2.3363e-02_r8,1.4318e-02_r8/) + kao(:, 5,12, 7) = (/ & + &3.7163e-02_r8,4.5231e-02_r8,4.5400e-02_r8,4.4006e-02_r8,4.1203e-02_r8,3.7331e-02_r8, & + &3.2004e-02_r8,2.5209e-02_r8,1.5927e-02_r8/) + kao(:, 1,13, 7) = (/ & + &2.5217e-02_r8,3.0486e-02_r8,3.0548e-02_r8,2.9385e-02_r8,2.7336e-02_r8,2.4524e-02_r8, & + &2.0890e-02_r8,1.5756e-02_r8,9.4392e-03_r8/) + kao(:, 2,13, 7) = (/ & + &2.7202e-02_r8,3.2841e-02_r8,3.2933e-02_r8,3.1772e-02_r8,2.9593e-02_r8,2.6611e-02_r8, & + &2.2741e-02_r8,1.7329e-02_r8,1.0602e-02_r8/) + kao(:, 3,13, 7) = (/ & + &2.9280e-02_r8,3.5351e-02_r8,3.5444e-02_r8,3.4289e-02_r8,3.1993e-02_r8,2.8821e-02_r8, & + &2.4603e-02_r8,1.8828e-02_r8,1.1938e-02_r8/) + kao(:, 4,13, 7) = (/ & + &3.1331e-02_r8,3.7956e-02_r8,3.7975e-02_r8,3.6801e-02_r8,3.4445e-02_r8,3.1086e-02_r8, & + &2.6513e-02_r8,2.0428e-02_r8,1.3267e-02_r8/) + kao(:, 5,13, 7) = (/ & + &3.3613e-02_r8,4.0685e-02_r8,4.0655e-02_r8,3.9388e-02_r8,3.6935e-02_r8,3.3268e-02_r8, & + &2.8459e-02_r8,2.2050e-02_r8,1.4574e-02_r8/) + kao(:, 1, 1, 8) = (/ & + &7.0857e-05_r8,3.1247e-02_r8,6.3050e-02_r8,9.5741e-02_r8,1.2991e-01_r8,1.6688e-01_r8, & + &2.1008e-01_r8,2.7194e-01_r8,2.5981e-01_r8/) + kao(:, 2, 1, 8) = (/ & + &7.3061e-05_r8,3.3759e-02_r8,6.8122e-02_r8,1.0346e-01_r8,1.4038e-01_r8,1.8030e-01_r8, & + &2.2703e-01_r8,2.9445e-01_r8,2.8076e-01_r8/) + kao(:, 3, 1, 8) = (/ & + &7.5439e-05_r8,3.6248e-02_r8,7.3153e-02_r8,1.1109e-01_r8,1.5077e-01_r8,1.9367e-01_r8, & + &2.4381e-01_r8,3.1652e-01_r8,3.0153e-01_r8/) + kao(:, 4, 1, 8) = (/ & + &7.7957e-05_r8,3.8675e-02_r8,7.8063e-02_r8,1.1859e-01_r8,1.6099e-01_r8,2.0691e-01_r8, & + &2.6053e-01_r8,3.3811e-01_r8,3.2197e-01_r8/) + kao(:, 5, 1, 8) = (/ & + &8.0722e-05_r8,4.1119e-02_r8,8.2986e-02_r8,1.2604e-01_r8,1.7112e-01_r8,2.1995e-01_r8, & + &2.7714e-01_r8,3.5946e-01_r8,3.4222e-01_r8/) + kao(:, 1, 2, 8) = (/ & + &9.7224e-05_r8,2.6558e-02_r8,5.3452e-02_r8,8.0855e-02_r8,1.0918e-01_r8,1.3924e-01_r8, & + &1.7330e-01_r8,2.2109e-01_r8,2.1834e-01_r8/) + kao(:, 2, 2, 8) = (/ & + &1.0058e-04_r8,2.8759e-02_r8,5.7870e-02_r8,8.7575e-02_r8,1.1827e-01_r8,1.5089e-01_r8, & + &1.8793e-01_r8,2.3994e-01_r8,2.3652e-01_r8/) + kao(:, 3, 2, 8) = (/ & + &1.0421e-04_r8,3.0964e-02_r8,6.2308e-02_r8,9.4299e-02_r8,1.2733e-01_r8,1.6243e-01_r8, & + &2.0230e-01_r8,2.5862e-01_r8,2.5463e-01_r8/) + kao(:, 4, 2, 8) = (/ & + &1.0798e-04_r8,3.3179e-02_r8,6.6764e-02_r8,1.0101e-01_r8,1.3640e-01_r8,1.7400e-01_r8, & + &2.1675e-01_r8,2.7715e-01_r8,2.7277e-01_r8/) + kao(:, 5, 2, 8) = (/ & + &1.1188e-04_r8,3.5361e-02_r8,7.1160e-02_r8,1.0767e-01_r8,1.4545e-01_r8,1.8554e-01_r8, & + &2.3113e-01_r8,2.9555e-01_r8,2.9088e-01_r8/) + kao(:, 1, 3, 8) = (/ & + &1.7704e-04_r8,2.1958e-02_r8,4.4006e-02_r8,6.6294e-02_r8,8.8988e-02_r8,1.1245e-01_r8, & + &1.3781e-01_r8,1.7014e-01_r8,1.7794e-01_r8/) + kao(:, 2, 3, 8) = (/ & + &1.8401e-04_r8,2.3898e-02_r8,4.7908e-02_r8,7.2164e-02_r8,9.6867e-02_r8,1.2239e-01_r8, & + &1.4998e-01_r8,1.8528e-01_r8,1.9370e-01_r8/) + kao(:, 3, 3, 8) = (/ & + &1.9123e-04_r8,2.5882e-02_r8,5.1886e-02_r8,7.8168e-02_r8,1.0491e-01_r8,1.3257e-01_r8, & + &1.6241e-01_r8,2.0047e-01_r8,2.0978e-01_r8/) + kao(:, 4, 3, 8) = (/ & + &1.9826e-04_r8,2.7841e-02_r8,5.5828e-02_r8,8.4093e-02_r8,1.1289e-01_r8,1.4266e-01_r8, & + &1.7485e-01_r8,2.1582e-01_r8,2.2574e-01_r8/) + kao(:, 5, 3, 8) = (/ & + &2.0558e-04_r8,2.9781e-02_r8,5.9723e-02_r8,8.9997e-02_r8,1.2076e-01_r8,1.5262e-01_r8, & + &1.8706e-01_r8,2.3095e-01_r8,2.4148e-01_r8/) + kao(:, 1, 4, 8) = (/ & + &3.2677e-04_r8,1.8554e-02_r8,3.5926e-02_r8,5.3829e-02_r8,7.1995e-02_r8,9.0469e-02_r8, & + &1.0973e-01_r8,1.3198e-01_r8,1.4393e-01_r8/) + kao(:, 2, 4, 8) = (/ & + &3.3998e-04_r8,2.0214e-02_r8,3.9351e-02_r8,5.9051e-02_r8,7.8970e-02_r8,9.9220e-02_r8, & + &1.2030e-01_r8,1.4461e-01_r8,1.5787e-01_r8/) + kao(:, 3, 4, 8) = (/ & + &3.5423e-04_r8,2.1886e-02_r8,4.2819e-02_r8,6.4313e-02_r8,8.6016e-02_r8,1.0809e-01_r8, & + &1.3108e-01_r8,1.5763e-01_r8,1.7196e-01_r8/) + kao(:, 4, 4, 8) = (/ & + &3.6836e-04_r8,2.3526e-02_r8,4.6236e-02_r8,6.9481e-02_r8,9.2916e-02_r8,1.1677e-01_r8, & + &1.4164e-01_r8,1.7039e-01_r8,1.8576e-01_r8/) + kao(:, 5, 4, 8) = (/ & + &3.8269e-04_r8,2.5159e-02_r8,4.9646e-02_r8,7.4614e-02_r8,9.9776e-02_r8,1.2541e-01_r8, & + &1.5213e-01_r8,1.8307e-01_r8,1.9947e-01_r8/) + kao(:, 1, 5, 8) = (/ & + &5.5618e-04_r8,1.6693e-02_r8,3.0352e-02_r8,4.4004e-02_r8,5.8213e-02_r8,7.2865e-02_r8, & + &8.7904e-02_r8,1.0425e-01_r8,1.1619e-01_r8/) + kao(:, 2, 5, 8) = (/ & + &5.8090e-04_r8,1.8251e-02_r8,3.3255e-02_r8,4.8452e-02_r8,6.4257e-02_r8,8.0492e-02_r8, & + &9.7115e-02_r8,1.1513e-01_r8,1.2836e-01_r8/) + kao(:, 3, 5, 8) = (/ & + &6.0567e-04_r8,1.9782e-02_r8,3.6119e-02_r8,5.2854e-02_r8,7.0252e-02_r8,8.8045e-02_r8, & + &1.0624e-01_r8,1.2602e-01_r8,1.4037e-01_r8/) + kao(:, 4, 5, 8) = (/ & + &6.3036e-04_r8,2.1279e-02_r8,3.8977e-02_r8,5.7257e-02_r8,7.6243e-02_r8,9.5550e-02_r8, & + &1.1529e-01_r8,1.3680e-01_r8,1.5235e-01_r8/) + kao(:, 5, 5, 8) = (/ & + &6.5503e-04_r8,2.2767e-02_r8,4.1832e-02_r8,6.1655e-02_r8,8.2195e-02_r8,1.0302e-01_r8, & + &1.2434e-01_r8,1.4756e-01_r8,1.6424e-01_r8/) + kao(:, 1, 6, 8) = (/ & + &8.8779e-04_r8,1.5219e-02_r8,2.6847e-02_r8,3.7621e-02_r8,4.8063e-02_r8,5.8817e-02_r8, & + &7.0265e-02_r8,8.2696e-02_r8,9.3190e-02_r8/) + kao(:, 2, 6, 8) = (/ & + &9.2874e-04_r8,1.6673e-02_r8,2.9554e-02_r8,4.1458e-02_r8,5.3049e-02_r8,6.5160e-02_r8, & + &7.8074e-02_r8,9.1921e-02_r8,1.0355e-01_r8/) + kao(:, 3, 6, 8) = (/ & + &9.6950e-04_r8,1.8111e-02_r8,3.2190e-02_r8,4.5211e-02_r8,5.8015e-02_r8,7.1500e-02_r8, & + &8.5838e-02_r8,1.0107e-01_r8,1.1382e-01_r8/) + kao(:, 4, 6, 8) = (/ & + &1.0101e-03_r8,1.9522e-02_r8,3.4803e-02_r8,4.8905e-02_r8,6.3015e-02_r8,7.7875e-02_r8, & + &9.3602e-02_r8,1.1021e-01_r8,1.2414e-01_r8/) + kao(:, 5, 6, 8) = (/ & + &1.0515e-03_r8,2.0916e-02_r8,3.7389e-02_r8,5.2547e-02_r8,6.7966e-02_r8,8.4205e-02_r8, & + &1.0130e-01_r8,1.1932e-01_r8,1.3433e-01_r8/) + kao(:, 1, 7, 8) = (/ & + &1.4977e-03_r8,1.4733e-02_r8,2.4381e-02_r8,3.3428e-02_r8,4.1931e-02_r8,4.9753e-02_r8, & + &5.7173e-02_r8,6.5580e-02_r8,7.4312e-02_r8/) + kao(:, 2, 7, 8) = (/ & + &1.5637e-03_r8,1.6075e-02_r8,2.6857e-02_r8,3.6980e-02_r8,4.6449e-02_r8,5.5152e-02_r8, & + &6.3551e-02_r8,7.3261e-02_r8,8.3066e-02_r8/) + kao(:, 3, 7, 8) = (/ & + &1.6297e-03_r8,1.7399e-02_r8,2.9305e-02_r8,4.0484e-02_r8,5.0904e-02_r8,6.0470e-02_r8, & + &6.9956e-02_r8,8.1009e-02_r8,9.1840e-02_r8/) + kao(:, 4, 7, 8) = (/ & + &1.7004e-03_r8,1.8688e-02_r8,3.1747e-02_r8,4.3982e-02_r8,5.5347e-02_r8,6.5760e-02_r8, & + &7.6435e-02_r8,8.8798e-02_r8,1.0066e-01_r8/) + kao(:, 5, 7, 8) = (/ & + &1.7747e-03_r8,1.9942e-02_r8,3.4156e-02_r8,4.7424e-02_r8,5.9706e-02_r8,7.0996e-02_r8, & + &8.2872e-02_r8,9.6510e-02_r8,1.0938e-01_r8/) + kao(:, 1, 8, 8) = (/ & + &3.0289e-03_r8,1.6187e-02_r8,2.4623e-02_r8,3.1800e-02_r8,3.8382e-02_r8,4.4473e-02_r8, & + &4.9956e-02_r8,5.4111e-02_r8,5.8932e-02_r8/) + kao(:, 2, 8, 8) = (/ & + &3.1588e-03_r8,1.7601e-02_r8,2.6972e-02_r8,3.5067e-02_r8,4.2580e-02_r8,4.9539e-02_r8, & + &5.5733e-02_r8,6.0374e-02_r8,6.6309e-02_r8/) + kao(:, 3, 8, 8) = (/ & + &3.2918e-03_r8,1.8992e-02_r8,2.9294e-02_r8,3.8315e-02_r8,4.6735e-02_r8,5.4548e-02_r8, & + &6.1452e-02_r8,6.6677e-02_r8,7.3699e-02_r8/) + kao(:, 4, 8, 8) = (/ & + &3.4281e-03_r8,2.0362e-02_r8,3.1558e-02_r8,4.1571e-02_r8,5.0908e-02_r8,5.9537e-02_r8, & + &6.7138e-02_r8,7.3015e-02_r8,8.1106e-02_r8/) + kao(:, 5, 8, 8) = (/ & + &3.5753e-03_r8,2.1737e-02_r8,3.3774e-02_r8,4.4733e-02_r8,5.4993e-02_r8,6.4441e-02_r8, & + &7.2719e-02_r8,7.9338e-02_r8,8.8474e-02_r8/) + kao(:, 1, 9, 8) = (/ & + &1.1613e-02_r8,2.6600e-02_r8,3.4830e-02_r8,4.1045e-02_r8,4.5758e-02_r8,4.9187e-02_r8, & + &5.0957e-02_r8,5.0881e-02_r8,4.6332e-02_r8/) + kao(:, 2, 9, 8) = (/ & + &1.2035e-02_r8,2.8837e-02_r8,3.7970e-02_r8,4.4834e-02_r8,5.0301e-02_r8,5.4274e-02_r8, & + &5.6564e-02_r8,5.6979e-02_r8,5.2710e-02_r8/) + kao(:, 3, 9, 8) = (/ & + &1.2460e-02_r8,3.1118e-02_r8,4.1014e-02_r8,4.8606e-02_r8,5.4716e-02_r8,5.9241e-02_r8, & + &6.2128e-02_r8,6.3036e-02_r8,5.8975e-02_r8/) + kao(:, 4, 9, 8) = (/ & + &1.2980e-02_r8,3.3463e-02_r8,4.4127e-02_r8,5.2378e-02_r8,5.9008e-02_r8,6.4138e-02_r8, & + &6.7667e-02_r8,6.9075e-02_r8,6.5274e-02_r8/) + kao(:, 5, 9, 8) = (/ & + &1.3559e-02_r8,3.5809e-02_r8,4.7263e-02_r8,5.6212e-02_r8,6.3302e-02_r8,6.8912e-02_r8, & + &7.3069e-02_r8,7.5010e-02_r8,7.1590e-02_r8/) + kao(:, 1,10, 8) = (/ & + &4.9669e-02_r8,6.5649e-02_r8,7.1116e-02_r8,7.3534e-02_r8,7.3825e-02_r8,7.2083e-02_r8, & + &6.7844e-02_r8,5.9498e-02_r8,3.3788e-02_r8/) + kao(:, 2,10, 8) = (/ & + &5.1505e-02_r8,7.0624e-02_r8,7.6814e-02_r8,7.9826e-02_r8,8.0618e-02_r8,7.8892e-02_r8, & + &7.4439e-02_r8,6.5949e-02_r8,3.8529e-02_r8/) + kao(:, 3,10, 8) = (/ & + &5.3297e-02_r8,7.5384e-02_r8,8.2789e-02_r8,8.6542e-02_r8,8.7369e-02_r8,8.5820e-02_r8, & + &8.1089e-02_r8,7.2258e-02_r8,4.3360e-02_r8/) + kao(:, 4,10, 8) = (/ & + &5.5068e-02_r8,8.0008e-02_r8,8.8749e-02_r8,9.3221e-02_r8,9.4169e-02_r8,9.2692e-02_r8, & + &8.7784e-02_r8,7.8437e-02_r8,4.8014e-02_r8/) + kao(:, 5,10, 8) = (/ & + &5.7734e-02_r8,8.4667e-02_r8,9.4556e-02_r8,9.9634e-02_r8,1.0118e-01_r8,9.9703e-02_r8, & + &9.4571e-02_r8,8.4495e-02_r8,5.2667e-02_r8/) + kao(:, 1,11, 8) = (/ & + &7.6448e-02_r8,9.0381e-02_r8,9.1555e-02_r8,9.0047e-02_r8,8.6717e-02_r8,8.1217e-02_r8, & + &7.3241e-02_r8,6.1179e-02_r8,3.1726e-02_r8/) + kao(:, 2,11, 8) = (/ & + &7.9612e-02_r8,9.5621e-02_r8,9.8574e-02_r8,9.7505e-02_r8,9.4314e-02_r8,8.8768e-02_r8, & + &8.0204e-02_r8,6.7360e-02_r8,3.6181e-02_r8/) + kao(:, 3,11, 8) = (/ & + &8.2652e-02_r8,1.0183e-01_r8,1.0547e-01_r8,1.0483e-01_r8,1.0201e-01_r8,9.6508e-02_r8, & + &8.7273e-02_r8,7.3474e-02_r8,4.0817e-02_r8/) + kao(:, 4,11, 8) = (/ & + &8.5862e-02_r8,1.0806e-01_r8,1.1212e-01_r8,1.1216e-01_r8,1.0950e-01_r8,1.0402e-01_r8, & + &9.4626e-02_r8,7.9735e-02_r8,4.5328e-02_r8/) + kao(:, 5,11, 8) = (/ & + &8.9572e-02_r8,1.1434e-01_r8,1.1896e-01_r8,1.1939e-01_r8,1.1678e-01_r8,1.1141e-01_r8, & + &1.0160e-01_r8,8.6030e-02_r8,4.9522e-02_r8/) + kao(:, 1,12, 8) = (/ & + &8.7861e-02_r8,9.9993e-02_r8,9.9171e-02_r8,9.4628e-02_r8,8.8704e-02_r8,8.0579e-02_r8, & + &7.0917e-02_r8,5.7333e-02_r8,2.8393e-02_r8/) + kao(:, 2,12, 8) = (/ & + &9.1432e-02_r8,1.0608e-01_r8,1.0583e-01_r8,1.0218e-01_r8,9.6300e-02_r8,8.8064e-02_r8, & + &7.7816e-02_r8,6.3024e-02_r8,3.2578e-02_r8/) + kao(:, 3,12, 8) = (/ & + &9.5110e-02_r8,1.1196e-01_r8,1.1325e-01_r8,1.0996e-01_r8,1.0369e-01_r8,9.5361e-02_r8, & + &8.4644e-02_r8,6.8902e-02_r8,3.7335e-02_r8/) + kao(:, 4,12, 8) = (/ & + &9.9318e-02_r8,1.1859e-01_r8,1.2042e-01_r8,1.1748e-01_r8,1.1108e-01_r8,1.0241e-01_r8, & + &9.1344e-02_r8,7.4779e-02_r8,4.1207e-02_r8/) + kao(:, 5,12, 8) = (/ & + &1.0395e-01_r8,1.2551e-01_r8,1.2774e-01_r8,1.2502e-01_r8,1.1865e-01_r8,1.0948e-01_r8, & + &9.7810e-02_r8,8.0483e-02_r8,4.4886e-02_r8/) + kao(:, 1,13, 8) = (/ & + &7.9847e-02_r8,9.1714e-02_r8,9.0958e-02_r8,8.6422e-02_r8,8.0456e-02_r8,7.2533e-02_r8, & + &6.2189e-02_r8,4.9649e-02_r8,2.4638e-02_r8/) + kao(:, 2,13, 8) = (/ & + &8.3442e-02_r8,9.7407e-02_r8,9.6872e-02_r8,9.3129e-02_r8,8.7376e-02_r8,7.8985e-02_r8, & + &6.8360e-02_r8,5.4702e-02_r8,2.8608e-02_r8/) + kao(:, 3,13, 8) = (/ & + &8.7437e-02_r8,1.0293e-01_r8,1.0345e-01_r8,9.9852e-02_r8,9.3864e-02_r8,8.5454e-02_r8, & + &7.4382e-02_r8,5.9885e-02_r8,3.2171e-02_r8/) + kao(:, 4,13, 8) = (/ & + &9.2235e-02_r8,1.0932e-01_r8,1.1033e-01_r8,1.0673e-01_r8,1.0043e-01_r8,9.1575e-02_r8, & + &8.0229e-02_r8,6.4806e-02_r8,3.5846e-02_r8/) + kao(:, 5,13, 8) = (/ & + &9.7358e-02_r8,1.1603e-01_r8,1.1725e-01_r8,1.1373e-01_r8,1.0722e-01_r8,9.7942e-02_r8, & + &8.5906e-02_r8,6.9573e-02_r8,3.9453e-02_r8/) + kao(:, 1, 1, 9) = (/ & + &2.3734e-04_r8,1.2635e-01_r8,2.5378e-01_r8,3.8280e-01_r8,5.1449e-01_r8,6.5095e-01_r8, & + &7.9709e-01_r8,9.7059e-01_r8,1.0290e+00_r8/) + kao(:, 2, 1, 9) = (/ & + &2.4162e-04_r8,1.3562e-01_r8,2.7235e-01_r8,4.1078e-01_r8,5.5198e-01_r8,6.9838e-01_r8, & + &8.5534e-01_r8,1.0400e+00_r8,1.1040e+00_r8/) + kao(:, 3, 1, 9) = (/ & + &2.4599e-04_r8,1.4459e-01_r8,2.9042e-01_r8,4.3810e-01_r8,5.8884e-01_r8,7.4499e-01_r8, & + &9.1233e-01_r8,1.1085e+00_r8,1.1777e+00_r8/) + kao(:, 4, 1, 9) = (/ & + &2.5041e-04_r8,1.5330e-01_r8,3.0793e-01_r8,4.6450e-01_r8,6.2431e-01_r8,7.9002e-01_r8, & + &9.6789e-01_r8,1.1761e+00_r8,1.2486e+00_r8/) + kao(:, 5, 1, 9) = (/ & + &2.5474e-04_r8,1.6182e-01_r8,3.2498e-01_r8,4.9034e-01_r8,6.5899e-01_r8,8.3368e-01_r8, & + &1.0214e+00_r8,1.2421e+00_r8,1.3180e+00_r8/) + kao(:, 1, 2, 9) = (/ & + &3.4870e-04_r8,1.1450e-01_r8,2.2975e-01_r8,3.4621e-01_r8,4.6468e-01_r8,5.8691e-01_r8, & + &7.1765e-01_r8,8.7423e-01_r8,9.2933e-01_r8/) + kao(:, 2, 2, 9) = (/ & + &3.5536e-04_r8,1.2334e-01_r8,2.4755e-01_r8,3.7300e-01_r8,5.0064e-01_r8,6.3232e-01_r8, & + &7.7280e-01_r8,9.4059e-01_r8,1.0013e+00_r8/) + kao(:, 3, 2, 9) = (/ & + &3.6217e-04_r8,1.3183e-01_r8,2.6460e-01_r8,3.9876e-01_r8,5.3531e-01_r8,6.7635e-01_r8, & + &8.2730e-01_r8,1.0064e+00_r8,1.0706e+00_r8/) + kao(:, 4, 2, 9) = (/ & + &3.6933e-04_r8,1.4017e-01_r8,2.8129e-01_r8,4.2395e-01_r8,5.6909e-01_r8,7.1898e-01_r8, & + &8.7939e-01_r8,1.0712e+00_r8,1.1382e+00_r8/) + kao(:, 5, 2, 9) = (/ & + &3.7836e-04_r8,1.4828e-01_r8,2.9766e-01_r8,4.4860e-01_r8,6.0234e-01_r8,7.6096e-01_r8, & + &9.3060e-01_r8,1.1332e+00_r8,1.2047e+00_r8/) + kao(:, 1, 3, 9) = (/ & + &6.8597e-04_r8,1.0077e-01_r8,2.0189e-01_r8,3.0366e-01_r8,4.0641e-01_r8,5.1122e-01_r8, & + &6.2085e-01_r8,7.4738e-01_r8,8.1281e-01_r8/) + kao(:, 2, 3, 9) = (/ & + &6.9976e-04_r8,1.0900e-01_r8,2.1840e-01_r8,3.2848e-01_r8,4.3972e-01_r8,5.5316e-01_r8, & + &6.7192e-01_r8,8.0915e-01_r8,8.7943e-01_r8/) + kao(:, 3, 3, 9) = (/ & + &7.1420e-04_r8,1.1699e-01_r8,2.3444e-01_r8,3.5259e-01_r8,4.7192e-01_r8,5.9381e-01_r8, & + &7.2140e-01_r8,8.6946e-01_r8,9.4382e-01_r8/) + kao(:, 4, 3, 9) = (/ & + &7.3229e-04_r8,1.2483e-01_r8,2.5014e-01_r8,3.7620e-01_r8,5.0367e-01_r8,6.3374e-01_r8, & + &7.7001e-01_r8,9.2785e-01_r8,1.0073e+00_r8/) + kao(:, 5, 3, 9) = (/ & + &7.5049e-04_r8,1.3237e-01_r8,2.6526e-01_r8,3.9901e-01_r8,5.3417e-01_r8,6.7225e-01_r8, & + &8.1699e-01_r8,9.8549e-01_r8,1.0683e+00_r8/) + kao(:, 1, 4, 9) = (/ & + &1.3742e-03_r8,8.7179e-02_r8,1.7451e-01_r8,2.6209e-01_r8,3.5019e-01_r8,4.3920e-01_r8, & + &5.3064e-01_r8,6.3091e-01_r8,7.0034e-01_r8/) + kao(:, 2, 4, 9) = (/ & + &1.4034e-03_r8,9.4872e-02_r8,1.8987e-01_r8,2.8522e-01_r8,3.8105e-01_r8,4.7796e-01_r8, & + &5.7741e-01_r8,6.8650e-01_r8,7.6206e-01_r8/) + kao(:, 3, 4, 9) = (/ & + &1.4371e-03_r8,1.0231e-01_r8,2.0478e-01_r8,3.0758e-01_r8,4.1096e-01_r8,5.1550e-01_r8, & + &6.2287e-01_r8,7.4083e-01_r8,8.2187e-01_r8/) + kao(:, 4, 4, 9) = (/ & + &1.4753e-03_r8,1.0953e-01_r8,2.1924e-01_r8,3.2932e-01_r8,4.4000e-01_r8,5.5196e-01_r8, & + &6.6692e-01_r8,7.9351e-01_r8,8.7995e-01_r8/) + kao(:, 5, 4, 9) = (/ & + &1.5185e-03_r8,1.1661e-01_r8,2.3342e-01_r8,3.5060e-01_r8,4.6845e-01_r8,5.8764e-01_r8, & + &7.1008e-01_r8,8.4502e-01_r8,9.3684e-01_r8/) + kao(:, 1, 5, 9) = (/ & + &2.5355e-03_r8,7.5685e-02_r8,1.4908e-01_r8,2.2375e-01_r8,2.9863e-01_r8,3.7400e-01_r8, & + &4.5045e-01_r8,5.3139e-01_r8,5.9720e-01_r8/) + kao(:, 2, 5, 9) = (/ & + &2.5953e-03_r8,8.2577e-02_r8,1.6333e-01_r8,2.4515e-01_r8,3.2721e-01_r8,4.0982e-01_r8, & + &4.9365e-01_r8,5.8247e-01_r8,6.5435e-01_r8/) + kao(:, 3, 5, 9) = (/ & + &2.6636e-03_r8,8.9208e-02_r8,1.7705e-01_r8,2.6573e-01_r8,3.5473e-01_r8,4.4427e-01_r8, & + &5.3522e-01_r8,6.3160e-01_r8,7.0937e-01_r8/) + kao(:, 4, 5, 9) = (/ & + &2.7420e-03_r8,9.5746e-02_r8,1.9046e-01_r8,2.8588e-01_r8,3.8160e-01_r8,4.7792e-01_r8, & + &5.7573e-01_r8,6.7936e-01_r8,7.6310e-01_r8/) + kao(:, 5, 5, 9) = (/ & + &2.8238e-03_r8,1.0214e-01_r8,2.0360e-01_r8,3.0562e-01_r8,4.0796e-01_r8,5.1095e-01_r8, & + &6.1550e-01_r8,7.2630e-01_r8,8.1581e-01_r8/) + kao(:, 1, 6, 9) = (/ & + &4.3605e-03_r8,6.9106e-02_r8,1.2775e-01_r8,1.8881e-01_r8,2.5131e-01_r8,3.1447e-01_r8, & + &3.7819e-01_r8,4.4408e-01_r8,5.0252e-01_r8/) + kao(:, 2, 6, 9) = (/ & + &4.4677e-03_r8,7.5202e-02_r8,1.4031e-01_r8,2.0810e-01_r8,2.7735e-01_r8,3.4706e-01_r8, & + &4.1739e-01_r8,4.9016e-01_r8,5.5457e-01_r8/) + kao(:, 3, 6, 9) = (/ & + &4.5887e-03_r8,8.1094e-02_r8,1.5254e-01_r8,2.2684e-01_r8,3.0254e-01_r8,3.7858e-01_r8, & + &4.5531e-01_r8,5.3473e-01_r8,6.0493e-01_r8/) + kao(:, 4, 6, 9) = (/ & + &4.7247e-03_r8,8.6870e-02_r8,1.6450e-01_r8,2.4527e-01_r8,3.2719e-01_r8,4.0945e-01_r8, & + &4.9240e-01_r8,5.7834e-01_r8,6.5421e-01_r8/) + kao(:, 5, 6, 9) = (/ & + &4.8692e-03_r8,9.2597e-02_r8,1.7638e-01_r8,2.6357e-01_r8,3.5163e-01_r8,4.4001e-01_r8, & + &5.2913e-01_r8,6.2153e-01_r8,7.0308e-01_r8/) + kao(:, 1, 7, 9) = (/ & + &7.8126e-03_r8,6.9794e-02_r8,1.1632e-01_r8,1.6292e-01_r8,2.1140e-01_r8,2.6176e-01_r8, & + &3.1398e-01_r8,3.6765e-01_r8,4.1782e-01_r8/) + kao(:, 2, 7, 9) = (/ & + &8.0155e-03_r8,7.6059e-02_r8,1.2742e-01_r8,1.7989e-01_r8,2.3439e-01_r8,2.9098e-01_r8, & + &3.4941e-01_r8,4.0917e-01_r8,4.6495e-01_r8/) + kao(:, 3, 7, 9) = (/ & + &8.2416e-03_r8,8.1970e-02_r8,1.3813e-01_r8,1.9625e-01_r8,2.5659e-01_r8,3.1926e-01_r8, & + &3.8354e-01_r8,4.4917e-01_r8,5.1030e-01_r8/) + kao(:, 4, 7, 9) = (/ & + &8.4921e-03_r8,8.7603e-02_r8,1.4873e-01_r8,2.1252e-01_r8,2.7865e-01_r8,3.4736e-01_r8, & + &4.1730e-01_r8,4.8866e-01_r8,5.5524e-01_r8/) + kao(:, 5, 7, 9) = (/ & + &8.7515e-03_r8,9.3044e-02_r8,1.5925e-01_r8,2.2867e-01_r8,3.0064e-01_r8,3.7532e-01_r8, & + &4.5091e-01_r8,5.2808e-01_r8,5.9993e-01_r8/) + kao(:, 1, 8, 9) = (/ & + &1.6603e-02_r8,7.8794e-02_r8,1.2181e-01_r8,1.5872e-01_r8,1.9167e-01_r8,2.2528e-01_r8, & + &2.6122e-01_r8,3.0128e-01_r8,3.4340e-01_r8/) + kao(:, 2, 8, 9) = (/ & + &1.7055e-02_r8,8.5849e-02_r8,1.3372e-01_r8,1.7446e-01_r8,2.1153e-01_r8,2.5044e-01_r8, & + &2.9195e-01_r8,3.3805e-01_r8,3.8527e-01_r8/) + kao(:, 3, 8, 9) = (/ & + &1.7594e-02_r8,9.2738e-02_r8,1.4493e-01_r8,1.8895e-01_r8,2.3080e-01_r8,2.7486e-01_r8, & + &3.2173e-01_r8,3.7362e-01_r8,4.2584e-01_r8/) + kao(:, 4, 8, 9) = (/ & + &1.8162e-02_r8,9.9290e-02_r8,1.5571e-01_r8,2.0324e-01_r8,2.5013e-01_r8,2.9946e-01_r8, & + &3.5175e-01_r8,4.0935e-01_r8,4.6655e-01_r8/) + kao(:, 5, 8, 9) = (/ & + &1.8749e-02_r8,1.0557e-01_r8,1.6622e-01_r8,2.1745e-01_r8,2.6934e-01_r8,3.2386e-01_r8, & + &3.8166e-01_r8,4.4484e-01_r8,5.0696e-01_r8/) + kao(:, 1, 9, 9) = (/ & + &6.5840e-02_r8,1.3860e-01_r8,1.7838e-01_r8,2.0998e-01_r8,2.3508e-01_r8,2.5392e-01_r8, & + &2.6499e-01_r8,2.6488e-01_r8,2.7801e-01_r8/) + kao(:, 2, 9, 9) = (/ & + &6.7872e-02_r8,1.4849e-01_r8,1.9371e-01_r8,2.2975e-01_r8,2.5869e-01_r8,2.8072e-01_r8, & + &2.9363e-01_r8,2.9601e-01_r8,3.1493e-01_r8/) + kao(:, 3, 9, 9) = (/ & + &7.0225e-02_r8,1.5836e-01_r8,2.0886e-01_r8,2.4918e-01_r8,2.8159e-01_r8,3.0644e-01_r8, & + &3.2072e-01_r8,3.2657e-01_r8,3.5112e-01_r8/) + kao(:, 4, 9, 9) = (/ & + &7.2560e-02_r8,1.6804e-01_r8,2.2356e-01_r8,2.6776e-01_r8,3.0359e-01_r8,3.3128e-01_r8, & + &3.4695e-01_r8,3.5732e-01_r8,3.8745e-01_r8/) + kao(:, 5, 9, 9) = (/ & + &7.5125e-02_r8,1.7750e-01_r8,2.3755e-01_r8,2.8560e-01_r8,3.2501e-01_r8,3.5553e-01_r8, & + &3.7247e-01_r8,3.8768e-01_r8,4.2319e-01_r8/) + kao(:, 1,10, 9) = (/ & + &2.8983e-01_r8,3.6990e-01_r8,4.0037e-01_r8,4.0949e-01_r8,4.0589e-01_r8,3.9081e-01_r8, & + &3.6404e-01_r8,3.1914e-01_r8,2.2264e-01_r8/) + kao(:, 2,10, 9) = (/ & + &2.9917e-01_r8,3.8833e-01_r8,4.2499e-01_r8,4.3869e-01_r8,4.3868e-01_r8,4.2555e-01_r8, & + &3.9991e-01_r8,3.5416e-01_r8,2.5485e-01_r8/) + kao(:, 3,10, 9) = (/ & + &3.0939e-01_r8,4.0713e-01_r8,4.4875e-01_r8,4.6776e-01_r8,4.7103e-01_r8,4.6014e-01_r8, & + &4.3525e-01_r8,3.8827e-01_r8,2.8738e-01_r8/) + kao(:, 4,10, 9) = (/ & + &3.2110e-01_r8,4.2672e-01_r8,4.7284e-01_r8,4.9667e-01_r8,5.0290e-01_r8,4.9348e-01_r8, & + &4.6953e-01_r8,4.2184e-01_r8,3.1974e-01_r8/) + kao(:, 5,10, 9) = (/ & + &3.3272e-01_r8,4.4730e-01_r8,4.9768e-01_r8,5.2532e-01_r8,5.3384e-01_r8,5.2588e-01_r8, & + &5.0287e-01_r8,4.5423e-01_r8,3.5166e-01_r8/) + kao(:, 1,11, 9) = (/ & + &4.4524e-01_r8,5.1679e-01_r8,5.3684e-01_r8,5.3332e-01_r8,5.1092e-01_r8,4.7255e-01_r8, & + &4.1877e-01_r8,3.4229e-01_r8,1.8048e-01_r8/) + kao(:, 2,11, 9) = (/ & + &4.5963e-01_r8,5.4202e-01_r8,5.6658e-01_r8,5.6626e-01_r8,5.4700e-01_r8,5.0983e-01_r8, & + &4.5605e-01_r8,3.7725e-01_r8,2.0742e-01_r8/) + kao(:, 3,11, 9) = (/ & + &4.7588e-01_r8,5.6665e-01_r8,5.9649e-01_r8,5.9968e-01_r8,5.8254e-01_r8,5.4674e-01_r8, & + &4.9265e-01_r8,4.1176e-01_r8,2.3443e-01_r8/) + kao(:, 4,11, 9) = (/ & + &4.9478e-01_r8,5.9201e-01_r8,6.2710e-01_r8,6.3330e-01_r8,6.1823e-01_r8,5.8344e-01_r8, & + &5.2842e-01_r8,4.4573e-01_r8,2.6065e-01_r8/) + kao(:, 5,11, 9) = (/ & + &5.1485e-01_r8,6.2017e-01_r8,6.5811e-01_r8,6.6709e-01_r8,6.5355e-01_r8,6.1972e-01_r8, & + &5.6393e-01_r8,4.7838e-01_r8,2.8720e-01_r8/) + kao(:, 1,12, 9) = (/ & + &5.0543e-01_r8,5.6903e-01_r8,5.8050e-01_r8,5.7018e-01_r8,5.4105e-01_r8,4.9466e-01_r8, & + &4.2828e-01_r8,3.3843e-01_r8,1.4652e-01_r8/) + kao(:, 2,12, 9) = (/ & + &5.2298e-01_r8,5.9603e-01_r8,6.1306e-01_r8,6.0448e-01_r8,5.7710e-01_r8,5.3128e-01_r8, & + &4.6400e-01_r8,3.7149e-01_r8,1.6865e-01_r8/) + kao(:, 3,12, 9) = (/ & + &5.4270e-01_r8,6.2472e-01_r8,6.4493e-01_r8,6.3902e-01_r8,6.1334e-01_r8,5.6783e-01_r8, & + &4.9936e-01_r8,4.0428e-01_r8,1.8993e-01_r8/) + kao(:, 4,12, 9) = (/ & + &5.6576e-01_r8,6.5409e-01_r8,6.7814e-01_r8,6.7406e-01_r8,6.4973e-01_r8,6.0390e-01_r8, & + &5.3494e-01_r8,4.3628e-01_r8,2.1164e-01_r8/) + kao(:, 5,12, 9) = (/ & + &5.9076e-01_r8,6.8665e-01_r8,7.1248e-01_r8,7.0991e-01_r8,6.8560e-01_r8,6.4007e-01_r8, & + &5.7053e-01_r8,4.6743e-01_r8,2.3320e-01_r8/) + kao(:, 1,13, 9) = (/ & + &4.5979e-01_r8,5.1890e-01_r8,5.2855e-01_r8,5.1825e-01_r8,4.9146e-01_r8,4.4960e-01_r8, & + &3.8971e-01_r8,3.0598e-01_r8,1.2566e-01_r8/) + kao(:, 2,13, 9) = (/ & + &4.7640e-01_r8,5.4480e-01_r8,5.5925e-01_r8,5.5059e-01_r8,5.2436e-01_r8,4.8283e-01_r8, & + &4.2163e-01_r8,3.3565e-01_r8,1.4550e-01_r8/) + kao(:, 3,13, 9) = (/ & + &4.9565e-01_r8,5.7250e-01_r8,5.8989e-01_r8,5.8311e-01_r8,5.5799e-01_r8,5.1559e-01_r8, & + &4.5382e-01_r8,3.6511e-01_r8,1.6523e-01_r8/) + kao(:, 4,13, 9) = (/ & + &5.1794e-01_r8,6.0150e-01_r8,6.2192e-01_r8,6.1629e-01_r8,5.9157e-01_r8,5.4908e-01_r8, & + &4.8624e-01_r8,3.9414e-01_r8,1.8408e-01_r8/) + kao(:, 5,13, 9) = (/ & + &5.4127e-01_r8,6.3348e-01_r8,6.5477e-01_r8,6.5028e-01_r8,6.2556e-01_r8,5.8254e-01_r8, & + &5.1808e-01_r8,4.2264e-01_r8,2.0283e-01_r8/) + kao(:, 1, 1,10) = (/ & + &6.5918e-04_r8,3.4888e-01_r8,6.9848e-01_r8,1.0485e+00_r8,1.4002e+00_r8,1.7549e+00_r8, & + &2.1190e+00_r8,2.5078e+00_r8,2.8004e+00_r8/) + kao(:, 2, 1,10) = (/ & + &6.7280e-04_r8,3.7184e-01_r8,7.4416e-01_r8,1.1175e+00_r8,1.4925e+00_r8,1.8689e+00_r8, & + &2.2475e+00_r8,2.6390e+00_r8,2.9850e+00_r8/) + kao(:, 3, 1,10) = (/ & + &6.8523e-04_r8,3.9709e-01_r8,7.9353e-01_r8,1.1893e+00_r8,1.5844e+00_r8,1.9796e+00_r8, & + &2.3755e+00_r8,2.7728e+00_r8,3.1689e+00_r8/) + kao(:, 4, 1,10) = (/ & + &6.9619e-04_r8,4.2236e-01_r8,8.4460e-01_r8,1.2663e+00_r8,1.6869e+00_r8,2.1024e+00_r8, & + &2.5075e+00_r8,2.8990e+00_r8,3.3737e+00_r8/) + kao(:, 5, 1,10) = (/ & + &7.0541e-04_r8,4.4505e-01_r8,8.9002e-01_r8,1.3353e+00_r8,1.7799e+00_r8,2.2235e+00_r8, & + &2.6534e+00_r8,3.0275e+00_r8,3.5598e+00_r8/) + kao(:, 1, 2,10) = (/ & + &1.0168e-03_r8,3.3520e-01_r8,6.7064e-01_r8,1.0063e+00_r8,1.3424e+00_r8,1.6793e+00_r8, & + &2.0199e+00_r8,2.3746e+00_r8,2.6847e+00_r8/) + kao(:, 2, 2,10) = (/ & + &1.0383e-03_r8,3.6090e-01_r8,7.2200e-01_r8,1.0832e+00_r8,1.4445e+00_r8,1.8057e+00_r8, & + &2.1681e+00_r8,2.5457e+00_r8,2.8891e+00_r8/) + kao(:, 3, 2,10) = (/ & + &1.0584e-03_r8,3.8758e-01_r8,7.7508e-01_r8,1.1623e+00_r8,1.5490e+00_r8,1.9350e+00_r8, & + &2.3176e+00_r8,2.7064e+00_r8,3.0980e+00_r8/) + kao(:, 4, 2,10) = (/ & + &1.0746e-03_r8,4.1292e-01_r8,8.2598e-01_r8,1.2389e+00_r8,1.6519e+00_r8,2.0646e+00_r8, & + &2.4744e+00_r8,2.8678e+00_r8,3.3037e+00_r8/) + kao(:, 5, 2,10) = (/ & + &1.0744e-03_r8,4.3717e-01_r8,8.7417e-01_r8,1.3107e+00_r8,1.7471e+00_r8,2.1834e+00_r8, & + &2.6192e+00_r8,3.0444e+00_r8,3.4941e+00_r8/) + kao(:, 1, 3,10) = (/ & + &2.0748e-03_r8,3.1600e-01_r8,6.3217e-01_r8,9.4857e-01_r8,1.2657e+00_r8,1.5838e+00_r8, & + &1.9039e+00_r8,2.2287e+00_r8,2.5314e+00_r8/) + kao(:, 2, 3,10) = (/ & + &2.1217e-03_r8,3.4261e-01_r8,6.8545e-01_r8,1.0284e+00_r8,1.3716e+00_r8,1.7154e+00_r8, & + &2.0606e+00_r8,2.4138e+00_r8,2.7432e+00_r8/) + kao(:, 3, 3,10) = (/ & + &2.1619e-03_r8,3.6999e-01_r8,7.4010e-01_r8,1.1107e+00_r8,1.4817e+00_r8,1.8526e+00_r8, & + &2.2240e+00_r8,2.5942e+00_r8,2.9634e+00_r8/) + kao(:, 4, 3,10) = (/ & + &2.1755e-03_r8,3.9596e-01_r8,7.9208e-01_r8,1.1885e+00_r8,1.5854e+00_r8,1.9831e+00_r8, & + &2.3825e+00_r8,2.7842e+00_r8,3.1709e+00_r8/) + kao(:, 5, 3,10) = (/ & + &2.1880e-03_r8,4.2191e-01_r8,8.4399e-01_r8,1.2664e+00_r8,1.6893e+00_r8,2.1130e+00_r8, & + &2.5373e+00_r8,2.9615e+00_r8,3.3787e+00_r8/) + kao(:, 1, 4,10) = (/ & + &4.2494e-03_r8,2.8992e-01_r8,5.8012e-01_r8,8.7071e-01_r8,1.1620e+00_r8,1.4546e+00_r8, & + &1.7505e+00_r8,2.0568e+00_r8,2.3239e+00_r8/) + kao(:, 2, 4,10) = (/ & + &4.3512e-03_r8,3.1537e-01_r8,6.3099e-01_r8,9.4695e-01_r8,1.2638e+00_r8,1.5819e+00_r8, & + &1.9039e+00_r8,2.2390e+00_r8,2.5276e+00_r8/) + kao(:, 3, 4,10) = (/ & + &4.4136e-03_r8,3.4243e-01_r8,6.8516e-01_r8,1.0282e+00_r8,1.3719e+00_r8,1.7170e+00_r8, & + &2.0650e+00_r8,2.4245e+00_r8,2.7438e+00_r8/) + kao(:, 4, 4,10) = (/ & + &4.4541e-03_r8,3.6913e-01_r8,7.3845e-01_r8,1.1085e+00_r8,1.4792e+00_r8,1.8513e+00_r8, & + &2.2276e+00_r8,2.6166e+00_r8,2.9583e+00_r8/) + kao(:, 5, 4,10) = (/ & + &4.4637e-03_r8,3.9522e-01_r8,7.9055e-01_r8,1.1865e+00_r8,1.5830e+00_r8,1.9815e+00_r8, & + &2.3838e+00_r8,2.7994e+00_r8,3.1659e+00_r8/) + kao(:, 1, 5,10) = (/ & + &7.8944e-03_r8,2.6027e-01_r8,5.2060e-01_r8,7.8129e-01_r8,1.0423e+00_r8,1.3045e+00_r8, & + &1.5691e+00_r8,1.8427e+00_r8,2.0845e+00_r8/) + kao(:, 2, 5,10) = (/ & + &8.0572e-03_r8,2.8413e-01_r8,5.6833e-01_r8,8.5287e-01_r8,1.1378e+00_r8,1.4238e+00_r8, & + &1.7119e+00_r8,2.0096e+00_r8,2.2754e+00_r8/) + kao(:, 3, 5,10) = (/ & + &8.1742e-03_r8,3.1030e-01_r8,6.2054e-01_r8,9.3122e-01_r8,1.2421e+00_r8,1.5541e+00_r8, & + &1.8685e+00_r8,2.1911e+00_r8,2.4841e+00_r8/) + kao(:, 4, 5,10) = (/ & + &8.2414e-03_r8,3.3618e-01_r8,6.7234e-01_r8,1.0088e+00_r8,1.3458e+00_r8,1.6840e+00_r8, & + &2.0247e+00_r8,2.3758e+00_r8,2.6915e+00_r8/) + kao(:, 5, 5,10) = (/ & + &8.3003e-03_r8,3.6135e-01_r8,7.2289e-01_r8,1.0847e+00_r8,1.4472e+00_r8,1.8109e+00_r8, & + &2.1782e+00_r8,2.5572e+00_r8,2.8943e+00_r8/) + kao(:, 1, 6,10) = (/ & + &1.3769e-02_r8,2.2868e-01_r8,4.5729e-01_r8,6.8615e-01_r8,9.1532e-01_r8,1.1447e+00_r8, & + &1.3758e+00_r8,1.6126e+00_r8,1.8305e+00_r8/) + kao(:, 2, 6,10) = (/ & + &1.4077e-02_r8,2.5186e-01_r8,5.0368e-01_r8,7.5558e-01_r8,1.0079e+00_r8,1.2605e+00_r8, & + &1.5146e+00_r8,1.7737e+00_r8,2.0155e+00_r8/) + kao(:, 3, 6,10) = (/ & + &1.4339e-02_r8,2.7680e-01_r8,5.5350e-01_r8,8.3033e-01_r8,1.1075e+00_r8,1.3852e+00_r8, & + &1.6642e+00_r8,1.9484e+00_r8,2.2148e+00_r8/) + kao(:, 4, 6,10) = (/ & + &1.4519e-02_r8,3.0142e-01_r8,6.0270e-01_r8,9.0418e-01_r8,1.2061e+00_r8,1.5083e+00_r8, & + &1.8129e+00_r8,2.1232e+00_r8,2.4121e+00_r8/) + kao(:, 5, 6,10) = (/ & + &1.4692e-02_r8,3.2398e-01_r8,6.4788e-01_r8,9.7210e-01_r8,1.2967e+00_r8,1.6219e+00_r8, & + &1.9490e+00_r8,2.2841e+00_r8,2.5932e+00_r8/) + kao(:, 1, 7,10) = (/ & + &2.5736e-02_r8,2.1730e-01_r8,3.9499e-01_r8,5.9240e-01_r8,7.9003e-01_r8,9.8783e-01_r8, & + &1.1864e+00_r8,1.3877e+00_r8,1.5798e+00_r8/) + kao(:, 2, 7,10) = (/ & + &2.6391e-02_r8,2.3410e-01_r8,4.4100e-01_r8,6.6147e-01_r8,8.8204e-01_r8,1.1029e+00_r8, & + &1.3242e+00_r8,1.5482e+00_r8,1.7637e+00_r8/) + kao(:, 3, 7,10) = (/ & + &2.6951e-02_r8,2.5201e-01_r8,4.8957e-01_r8,7.3433e-01_r8,9.7905e-01_r8,1.2243e+00_r8, & + &1.4699e+00_r8,1.7185e+00_r8,1.9578e+00_r8/) + kao(:, 4, 7,10) = (/ & + &2.7390e-02_r8,2.7020e-01_r8,5.3407e-01_r8,8.0106e-01_r8,1.0682e+00_r8,1.3359e+00_r8, & + &1.6042e+00_r8,1.8761e+00_r8,2.1361e+00_r8/) + kao(:, 5, 7,10) = (/ & + &2.8064e-02_r8,2.8861e-01_r8,5.7611e-01_r8,8.6397e-01_r8,1.1521e+00_r8,1.4408e+00_r8, & + &1.7300e+00_r8,2.0229e+00_r8,2.3040e+00_r8/) + kao(:, 1, 8,10) = (/ & + &5.8578e-02_r8,2.6880e-01_r8,4.0001e-01_r8,5.2061e-01_r8,6.7938e-01_r8,8.4922e-01_r8, & + &1.0194e+00_r8,1.1905e+00_r8,1.3581e+00_r8/) + kao(:, 2, 8,10) = (/ & + &6.0087e-02_r8,2.9139e-01_r8,4.3501e-01_r8,5.7583e-01_r8,7.6491e-01_r8,9.5619e-01_r8, & + &1.1477e+00_r8,1.3402e+00_r8,1.5292e+00_r8/) + kao(:, 3, 8,10) = (/ & + &6.1083e-02_r8,3.1400e-01_r8,4.7010e-01_r8,6.4266e-01_r8,8.5685e-01_r8,1.0710e+00_r8, & + &1.2856e+00_r8,1.5014e+00_r8,1.7131e+00_r8/) + kao(:, 4, 8,10) = (/ & + &6.2072e-02_r8,3.3715e-01_r8,5.0004e-01_r8,7.0498e-01_r8,9.3980e-01_r8,1.1748e+00_r8, & + &1.4102e+00_r8,1.6468e+00_r8,1.8789e+00_r8/) + kao(:, 5, 8,10) = (/ & + &6.3481e-02_r8,3.5691e-01_r8,5.2888e-01_r8,7.6432e-01_r8,1.0191e+00_r8,1.2740e+00_r8, & + &1.5290e+00_r8,1.7860e+00_r8,2.0375e+00_r8/) + kao(:, 1, 9,10) = (/ & + &2.5051e-01_r8,4.8216e-01_r8,6.3956e-01_r8,7.5081e-01_r8,8.3417e-01_r8,8.8639e-01_r8, & + &9.0389e-01_r8,1.0106e+00_r8,1.1541e+00_r8/) + kao(:, 2, 9,10) = (/ & + &2.5603e-01_r8,5.1856e-01_r8,6.9227e-01_r8,8.2007e-01_r8,9.1537e-01_r8,9.7189e-01_r8, & + &9.9778e-01_r8,1.1454e+00_r8,1.3083e+00_r8/) + kao(:, 3, 9,10) = (/ & + &2.6013e-01_r8,5.5198e-01_r8,7.4416e-01_r8,8.8806e-01_r8,9.9547e-01_r8,1.0583e+00_r8, & + &1.1091e+00_r8,1.2896e+00_r8,1.4729e+00_r8/) + kao(:, 4, 9,10) = (/ & + &2.6455e-01_r8,5.8224e-01_r8,7.9653e-01_r8,9.5696e-01_r8,1.0752e+00_r8,1.1310e+00_r8, & + &1.2203e+00_r8,1.4235e+00_r8,1.6258e+00_r8/) + kao(:, 5, 9,10) = (/ & + &2.6779e-01_r8,6.1167e-01_r8,8.4854e-01_r8,1.0208e+00_r8,1.1434e+00_r8,1.1964e+00_r8, & + &1.3330e+00_r8,1.5553e+00_r8,1.7761e+00_r8/) + kao(:, 1,10,10) = (/ & + &1.1877e+00_r8,1.3423e+00_r8,1.4114e+00_r8,1.4638e+00_r8,1.4747e+00_r8,1.4384e+00_r8, & + &1.3561e+00_r8,1.1884e+00_r8,9.6724e-01_r8/) + kao(:, 2,10,10) = (/ & + &1.2130e+00_r8,1.4001e+00_r8,1.4986e+00_r8,1.5677e+00_r8,1.5910e+00_r8,1.5689e+00_r8, & + &1.4918e+00_r8,1.3127e+00_r8,1.1039e+00_r8/) + kao(:, 3,10,10) = (/ & + &1.2346e+00_r8,1.4593e+00_r8,1.5877e+00_r8,1.6627e+00_r8,1.7012e+00_r8,1.6974e+00_r8, & + &1.6231e+00_r8,1.4376e+00_r8,1.2384e+00_r8/) + kao(:, 4,10,10) = (/ & + &1.2516e+00_r8,1.5151e+00_r8,1.6747e+00_r8,1.7501e+00_r8,1.8076e+00_r8,1.8250e+00_r8, & + &1.7537e+00_r8,1.5512e+00_r8,1.3735e+00_r8/) + kao(:, 5,10,10) = (/ & + &1.2661e+00_r8,1.5638e+00_r8,1.7522e+00_r8,1.8374e+00_r8,1.9121e+00_r8,1.9420e+00_r8, & + &1.8736e+00_r8,1.6582e+00_r8,1.5128e+00_r8/) + kao(:, 1,11,10) = (/ & + &1.9480e+00_r8,2.0492e+00_r8,2.0295e+00_r8,1.9735e+00_r8,1.8970e+00_r8,1.7736e+00_r8, & + &1.5866e+00_r8,1.3339e+00_r8,8.4829e-01_r8/) + kao(:, 2,11,10) = (/ & + &1.9908e+00_r8,2.1211e+00_r8,2.1260e+00_r8,2.0949e+00_r8,2.0240e+00_r8,1.9060e+00_r8, & + &1.7325e+00_r8,1.4683e+00_r8,9.6828e-01_r8/) + kao(:, 3,11,10) = (/ & + &2.0285e+00_r8,2.1879e+00_r8,2.2239e+00_r8,2.2116e+00_r8,2.1470e+00_r8,2.0366e+00_r8, & + &1.8735e+00_r8,1.6014e+00_r8,1.0930e+00_r8/) + kao(:, 4,11,10) = (/ & + &2.0556e+00_r8,2.2562e+00_r8,2.3222e+00_r8,2.3233e+00_r8,2.2648e+00_r8,2.1592e+00_r8, & + &2.0072e+00_r8,1.7228e+00_r8,1.2296e+00_r8/) + kao(:, 5,11,10) = (/ & + &2.0825e+00_r8,2.3069e+00_r8,2.4192e+00_r8,2.4269e+00_r8,2.3834e+00_r8,2.2768e+00_r8, & + &2.1248e+00_r8,1.8445e+00_r8,1.3568e+00_r8/) + kao(:, 1,12,10) = (/ & + &2.3362e+00_r8,2.4153e+00_r8,2.3669e+00_r8,2.2577e+00_r8,2.1055e+00_r8,1.9147e+00_r8, & + &1.6820e+00_r8,1.3486e+00_r8,7.4407e-01_r8/) + kao(:, 2,12,10) = (/ & + &2.3893e+00_r8,2.4937e+00_r8,2.4670e+00_r8,2.3773e+00_r8,2.2296e+00_r8,2.0482e+00_r8, & + &1.8201e+00_r8,1.4800e+00_r8,8.5242e-01_r8/) + kao(:, 3,12,10) = (/ & + &2.4357e+00_r8,2.5702e+00_r8,2.5666e+00_r8,2.4887e+00_r8,2.3537e+00_r8,2.1812e+00_r8, & + &1.9511e+00_r8,1.6049e+00_r8,9.6662e-01_r8/) + kao(:, 4,12,10) = (/ & + &2.4652e+00_r8,2.6456e+00_r8,2.6664e+00_r8,2.5981e+00_r8,2.4742e+00_r8,2.3104e+00_r8, & + &2.0695e+00_r8,1.7245e+00_r8,1.0828e+00_r8/) + kao(:, 5,12,10) = (/ & + &2.4945e+00_r8,2.7001e+00_r8,2.7645e+00_r8,2.7014e+00_r8,2.5936e+00_r8,2.4312e+00_r8, & + &2.1779e+00_r8,1.8427e+00_r8,1.2015e+00_r8/) + kao(:, 1,13,10) = (/ & + &2.2054e+00_r8,2.3120e+00_r8,2.2775e+00_r8,2.1807e+00_r8,2.0276e+00_r8,1.8297e+00_r8, & + &1.5931e+00_r8,1.2531e+00_r8,5.9202e-01_r8/) + kao(:, 2,13,10) = (/ & + &2.2559e+00_r8,2.3878e+00_r8,2.3725e+00_r8,2.2888e+00_r8,2.1438e+00_r8,1.9536e+00_r8, & + &1.7172e+00_r8,1.3694e+00_r8,6.7488e-01_r8/) + kao(:, 3,13,10) = (/ & + &2.2951e+00_r8,2.4612e+00_r8,2.4689e+00_r8,2.3923e+00_r8,2.2596e+00_r8,2.0732e+00_r8, & + &1.8332e+00_r8,1.4777e+00_r8,7.6019e-01_r8/) + kao(:, 4,13,10) = (/ & + &2.3235e+00_r8,2.5286e+00_r8,2.5591e+00_r8,2.4947e+00_r8,2.3722e+00_r8,2.1862e+00_r8, & + &1.9383e+00_r8,1.5857e+00_r8,8.5248e-01_r8/) + kao(:, 5,13,10) = (/ & + &2.3616e+00_r8,2.5838e+00_r8,2.6490e+00_r8,2.5951e+00_r8,2.4760e+00_r8,2.2908e+00_r8, & + &2.0454e+00_r8,1.6895e+00_r8,9.4490e-01_r8/) + kao(:, 1, 1,11) = (/ & + &9.3294e-04_r8,5.3309e-01_r8,1.0647e+00_r8,1.5932e+00_r8,2.1160e+00_r8,2.6255e+00_r8, & + &3.0986e+00_r8,3.3968e+00_r8,4.2319e+00_r8/) + kao(:, 2, 1,11) = (/ & + &9.5345e-04_r8,5.6455e-01_r8,1.1277e+00_r8,1.6875e+00_r8,2.2413e+00_r8,2.7825e+00_r8, & + &3.2884e+00_r8,3.6383e+00_r8,4.4826e+00_r8/) + kao(:, 3, 1,11) = (/ & + &9.7241e-04_r8,5.9098e-01_r8,1.1810e+00_r8,1.7692e+00_r8,2.3540e+00_r8,2.9286e+00_r8, & + &3.4675e+00_r8,3.8516e+00_r8,4.7080e+00_r8/) + kao(:, 4, 1,11) = (/ & + &9.8984e-04_r8,6.1800e-01_r8,1.2338e+00_r8,1.8462e+00_r8,2.4536e+00_r8,3.0526e+00_r8, & + &3.6266e+00_r8,4.0600e+00_r8,4.9071e+00_r8/) + kao(:, 5, 1,11) = (/ & + &1.0059e-03_r8,6.4816e-01_r8,1.2933e+00_r8,1.9339e+00_r8,2.5658e+00_r8,3.1822e+00_r8, & + &3.7668e+00_r8,4.2510e+00_r8,5.1316e+00_r8/) + kao(:, 1, 2,11) = (/ & + &1.5074e-03_r8,5.1913e-01_r8,1.0387e+00_r8,1.5585e+00_r8,2.0790e+00_r8,2.5998e+00_r8, & + &3.1169e+00_r8,3.5984e+00_r8,4.1578e+00_r8/) + kao(:, 2, 2,11) = (/ & + &1.5417e-03_r8,5.5254e-01_r8,1.1053e+00_r8,1.6578e+00_r8,2.2101e+00_r8,2.7629e+00_r8, & + &3.3129e+00_r8,3.8170e+00_r8,4.4201e+00_r8/) + kao(:, 3, 2,11) = (/ & + &1.5713e-03_r8,5.8438e-01_r8,1.1685e+00_r8,1.7524e+00_r8,2.3358e+00_r8,2.9174e+00_r8, & + &3.4950e+00_r8,4.0242e+00_r8,4.6716e+00_r8/) + kao(:, 4, 2,11) = (/ & + &1.5983e-03_r8,6.1743e-01_r8,1.2340e+00_r8,1.8490e+00_r8,2.4617e+00_r8,3.0691e+00_r8, & + &3.6659e+00_r8,4.2202e+00_r8,4.9233e+00_r8/) + kao(:, 5, 2,11) = (/ & + &1.6216e-03_r8,6.5216e-01_r8,1.3030e+00_r8,1.9521e+00_r8,2.5969e+00_r8,3.2326e+00_r8, & + &3.8472e+00_r8,4.4004e+00_r8,5.1936e+00_r8/) + kao(:, 1, 3,11) = (/ & + &3.2100e-03_r8,4.8846e-01_r8,9.7712e-01_r8,1.4663e+00_r8,1.9565e+00_r8,2.4483e+00_r8, & + &2.9445e+00_r8,3.4602e+00_r8,3.9130e+00_r8/) + kao(:, 2, 3,11) = (/ & + &3.2832e-03_r8,5.2715e-01_r8,1.0544e+00_r8,1.5820e+00_r8,2.1102e+00_r8,2.6392e+00_r8, & + &3.1691e+00_r8,3.7028e+00_r8,4.2204e+00_r8/) + kao(:, 3, 3,11) = (/ & + &3.3509e-03_r8,5.6319e-01_r8,1.1265e+00_r8,1.6900e+00_r8,2.2533e+00_r8,2.8179e+00_r8, & + &3.3838e+00_r8,3.9526e+00_r8,4.5066e+00_r8/) + kao(:, 4, 3,11) = (/ & + &3.4122e-03_r8,6.0075e-01_r8,1.2012e+00_r8,1.8012e+00_r8,2.4005e+00_r8,2.9988e+00_r8, & + &3.5947e+00_r8,4.1839e+00_r8,4.8011e+00_r8/) + kao(:, 5, 3,11) = (/ & + &3.4694e-03_r8,6.3990e-01_r8,1.2794e+00_r8,1.9184e+00_r8,2.5559e+00_r8,3.1911e+00_r8, & + &3.8197e+00_r8,4.4273e+00_r8,5.1119e+00_r8/) + kao(:, 1, 4,11) = (/ & + &6.8944e-03_r8,4.5524e-01_r8,9.1034e-01_r8,1.3656e+00_r8,1.8210e+00_r8,2.2768e+00_r8, & + &2.7339e+00_r8,3.1966e+00_r8,3.6419e+00_r8/) + kao(:, 2, 4,11) = (/ & + &7.0719e-03_r8,4.9844e-01_r8,9.9694e-01_r8,1.4955e+00_r8,1.9943e+00_r8,2.4932e+00_r8, & + &2.9929e+00_r8,3.4921e+00_r8,3.9886e+00_r8/) + kao(:, 3, 4,11) = (/ & + &7.2326e-03_r8,5.3850e-01_r8,1.0768e+00_r8,1.6152e+00_r8,2.1534e+00_r8,2.6917e+00_r8, & + &3.2302e+00_r8,3.7700e+00_r8,4.3067e+00_r8/) + kao(:, 4, 4,11) = (/ & + &7.3806e-03_r8,5.7980e-01_r8,1.1594e+00_r8,1.7389e+00_r8,2.3180e+00_r8,2.8967e+00_r8, & + &3.4739e+00_r8,4.0439e+00_r8,4.6359e+00_r8/) + kao(:, 5, 4,11) = (/ & + &7.4998e-03_r8,6.1978e-01_r8,1.2395e+00_r8,1.8590e+00_r8,2.4785e+00_r8,3.0979e+00_r8, & + &3.7146e+00_r8,4.3244e+00_r8,4.9568e+00_r8/) + kao(:, 1, 5,11) = (/ & + &1.3442e-02_r8,4.2037e-01_r8,8.4065e-01_r8,1.2612e+00_r8,1.6819e+00_r8,2.1029e+00_r8, & + &2.5255e+00_r8,2.9520e+00_r8,3.3637e+00_r8/) + kao(:, 2, 5,11) = (/ & + &1.3797e-02_r8,4.6626e-01_r8,9.3234e-01_r8,1.3987e+00_r8,1.8650e+00_r8,2.3319e+00_r8, & + &2.7996e+00_r8,3.2699e+00_r8,3.7300e+00_r8/) + kao(:, 3, 5,11) = (/ & + &1.4112e-02_r8,5.0925e-01_r8,1.0185e+00_r8,1.5280e+00_r8,2.0375e+00_r8,2.5478e+00_r8, & + &3.0591e+00_r8,3.5748e+00_r8,4.0749e+00_r8/) + kao(:, 4, 5,11) = (/ & + &1.4385e-02_r8,5.5077e-01_r8,1.1015e+00_r8,1.6526e+00_r8,2.2034e+00_r8,2.7548e+00_r8, & + &3.3072e+00_r8,3.8625e+00_r8,4.4066e+00_r8/) + kao(:, 5, 5,11) = (/ & + &1.4645e-02_r8,5.9271e-01_r8,1.1855e+00_r8,1.7781e+00_r8,2.3710e+00_r8,2.9641e+00_r8, & + &3.5574e+00_r8,4.1512e+00_r8,4.7419e+00_r8/) + kao(:, 1, 6,11) = (/ & + &2.4122e-02_r8,3.8084e-01_r8,7.6147e-01_r8,1.1422e+00_r8,1.5231e+00_r8,1.9045e+00_r8, & + &2.2870e+00_r8,2.6730e+00_r8,3.0460e+00_r8/) + kao(:, 2, 6,11) = (/ & + &2.4797e-02_r8,4.2571e-01_r8,8.5136e-01_r8,1.2771e+00_r8,1.7031e+00_r8,2.1298e+00_r8, & + &2.5578e+00_r8,2.9908e+00_r8,3.4060e+00_r8/) + kao(:, 3, 6,11) = (/ & + &2.5418e-02_r8,4.6778e-01_r8,9.3545e-01_r8,1.4036e+00_r8,1.8720e+00_r8,2.3409e+00_r8, & + &2.8115e+00_r8,3.2888e+00_r8,3.7438e+00_r8/) + kao(:, 4, 6,11) = (/ & + &2.5988e-02_r8,5.1023e-01_r8,1.0205e+00_r8,1.5308e+00_r8,2.0415e+00_r8,2.5527e+00_r8, & + &3.0658e+00_r8,3.5842e+00_r8,4.0828e+00_r8/) + kao(:, 5, 6,11) = (/ & + &2.6439e-02_r8,5.5329e-01_r8,1.1066e+00_r8,1.6600e+00_r8,2.2137e+00_r8,2.7680e+00_r8, & + &3.3240e+00_r8,3.8852e+00_r8,4.4272e+00_r8/) + kao(:, 1, 7,11) = (/ & + &4.4902e-02_r8,3.4110e-01_r8,6.7879e-01_r8,1.0183e+00_r8,1.3577e+00_r8,1.6974e+00_r8, & + &2.0380e+00_r8,2.3811e+00_r8,2.7150e+00_r8/) + kao(:, 2, 7,11) = (/ & + &4.6257e-02_r8,3.7900e-01_r8,7.5783e-01_r8,1.1366e+00_r8,1.5157e+00_r8,1.8951e+00_r8, & + &2.2756e+00_r8,2.6593e+00_r8,3.0311e+00_r8/) + kao(:, 3, 7,11) = (/ & + &4.7417e-02_r8,4.1838e-01_r8,8.3644e-01_r8,1.2549e+00_r8,1.6732e+00_r8,2.0920e+00_r8, & + &2.5119e+00_r8,2.9363e+00_r8,3.3461e+00_r8/) + kao(:, 4, 7,11) = (/ & + &4.8439e-02_r8,4.5979e-01_r8,9.1922e-01_r8,1.3788e+00_r8,1.8387e+00_r8,2.2989e+00_r8, & + &2.7602e+00_r8,3.2261e+00_r8,3.6771e+00_r8/) + kao(:, 5, 7,11) = (/ & + &4.9115e-02_r8,5.0257e-01_r8,1.0048e+00_r8,1.5073e+00_r8,2.0099e+00_r8,2.5129e+00_r8, & + &3.0174e+00_r8,3.5268e+00_r8,4.0195e+00_r8/) + kao(:, 1, 8,11) = (/ & + &9.9346e-02_r8,4.0741e-01_r8,6.1474e-01_r8,8.8954e-01_r8,1.1859e+00_r8,1.4823e+00_r8, & + &1.7793e+00_r8,2.0775e+00_r8,2.3709e+00_r8/) + kao(:, 2, 8,11) = (/ & + &1.0236e-01_r8,4.4079e-01_r8,6.7253e-01_r8,9.9766e-01_r8,1.3301e+00_r8,1.6626e+00_r8, & + &1.9955e+00_r8,2.3301e+00_r8,2.6593e+00_r8/) + kao(:, 3, 8,11) = (/ & + &1.0516e-01_r8,4.6951e-01_r8,7.3794e-01_r8,1.1060e+00_r8,1.4745e+00_r8,1.8432e+00_r8, & + &2.2125e+00_r8,2.5835e+00_r8,2.9480e+00_r8/) + kao(:, 4, 8,11) = (/ & + &1.0772e-01_r8,4.9500e-01_r8,8.1532e-01_r8,1.2227e+00_r8,1.6302e+00_r8,2.0375e+00_r8, & + &2.4456e+00_r8,2.8562e+00_r8,3.2595e+00_r8/) + kao(:, 5, 8,11) = (/ & + &1.0947e-01_r8,5.2130e-01_r8,8.9659e-01_r8,1.3445e+00_r8,1.7925e+00_r8,2.2406e+00_r8, & + &2.6897e+00_r8,3.1404e+00_r8,3.5840e+00_r8/) + kao(:, 1, 9,11) = (/ & + &4.1823e-01_r8,7.9567e-01_r8,1.0382e+00_r8,1.1972e+00_r8,1.2989e+00_r8,1.3526e+00_r8, & + &1.5261e+00_r8,1.7800e+00_r8,2.0331e+00_r8/) + kao(:, 2, 9,11) = (/ & + &4.3170e-01_r8,8.4637e-01_r8,1.1195e+00_r8,1.3007e+00_r8,1.4025e+00_r8,1.4821e+00_r8, & + &1.7319e+00_r8,2.0202e+00_r8,2.3074e+00_r8/) + kao(:, 3, 9,11) = (/ & + &4.4387e-01_r8,8.9320e-01_r8,1.1954e+00_r8,1.3918e+00_r8,1.4965e+00_r8,1.6263e+00_r8, & + &1.9385e+00_r8,2.2615e+00_r8,2.5830e+00_r8/) + kao(:, 4, 9,11) = (/ & + &4.5501e-01_r8,9.4246e-01_r8,1.2607e+00_r8,1.4727e+00_r8,1.5878e+00_r8,1.7989e+00_r8, & + &2.1575e+00_r8,2.5169e+00_r8,2.8754e+00_r8/) + kao(:, 5, 9,11) = (/ & + &4.6515e-01_r8,9.9000e-01_r8,1.3196e+00_r8,1.5528e+00_r8,1.6906e+00_r8,1.9810e+00_r8, & + &2.3767e+00_r8,2.7728e+00_r8,3.1676e+00_r8/) + kao(:, 1,10,11) = (/ & + &1.9805e+00_r8,2.2049e+00_r8,2.3763e+00_r8,2.4479e+00_r8,2.4732e+00_r8,2.4264e+00_r8, & + &2.2604e+00_r8,1.8802e+00_r8,1.7493e+00_r8/) + kao(:, 2,10,11) = (/ & + &2.0472e+00_r8,2.3153e+00_r8,2.5048e+00_r8,2.6141e+00_r8,2.6517e+00_r8,2.6235e+00_r8, & + &2.4547e+00_r8,2.0470e+00_r8,2.0043e+00_r8/) + kao(:, 3,10,11) = (/ & + &2.1094e+00_r8,2.4143e+00_r8,2.6357e+00_r8,2.7700e+00_r8,2.8309e+00_r8,2.7965e+00_r8, & + &2.6317e+00_r8,2.2035e+00_r8,2.2660e+00_r8/) + kao(:, 4,10,11) = (/ & + &2.1647e+00_r8,2.5051e+00_r8,2.7487e+00_r8,2.9276e+00_r8,2.9982e+00_r8,2.9552e+00_r8, & + &2.7953e+00_r8,2.3731e+00_r8,2.5329e+00_r8/) + kao(:, 5,10,11) = (/ & + &2.2155e+00_r8,2.5942e+00_r8,2.8618e+00_r8,3.0775e+00_r8,3.1500e+00_r8,3.1109e+00_r8, & + &2.9560e+00_r8,2.5540e+00_r8,2.7905e+00_r8/) + kao(:, 1,11,11) = (/ & + &3.3272e+00_r8,3.3391e+00_r8,3.4265e+00_r8,3.3299e+00_r8,3.1864e+00_r8,3.0000e+00_r8, & + &2.7382e+00_r8,2.2548e+00_r8,1.5937e+00_r8/) + kao(:, 2,11,11) = (/ & + &3.4245e+00_r8,3.4923e+00_r8,3.5888e+00_r8,3.5207e+00_r8,3.3952e+00_r8,3.2270e+00_r8, & + &2.9458e+00_r8,2.4552e+00_r8,1.8248e+00_r8/) + kao(:, 3,11,11) = (/ & + &3.5147e+00_r8,3.6350e+00_r8,3.7493e+00_r8,3.6979e+00_r8,3.6003e+00_r8,3.4366e+00_r8, & + &3.1408e+00_r8,2.6446e+00_r8,2.0543e+00_r8/) + kao(:, 4,11,11) = (/ & + &3.5973e+00_r8,3.7611e+00_r8,3.8955e+00_r8,3.8697e+00_r8,3.7999e+00_r8,3.6320e+00_r8, & + &3.3291e+00_r8,2.8219e+00_r8,2.2769e+00_r8/) + kao(:, 5,11,11) = (/ & + &3.6658e+00_r8,3.8812e+00_r8,4.0226e+00_r8,4.0479e+00_r8,3.9815e+00_r8,3.8145e+00_r8, & + &3.5185e+00_r8,2.9782e+00_r8,2.4861e+00_r8/) + kao(:, 1,12,11) = (/ & + &4.1187e+00_r8,4.0374e+00_r8,4.0352e+00_r8,3.8356e+00_r8,3.5772e+00_r8,3.2668e+00_r8, & + &2.8837e+00_r8,2.3539e+00_r8,1.4349e+00_r8/) + kao(:, 2,12,11) = (/ & + &4.2212e+00_r8,4.1986e+00_r8,4.2178e+00_r8,4.0426e+00_r8,3.8006e+00_r8,3.4932e+00_r8, & + &3.0942e+00_r8,2.5554e+00_r8,1.6369e+00_r8/) + kao(:, 3,12,11) = (/ & + &4.3153e+00_r8,4.3421e+00_r8,4.3917e+00_r8,4.2429e+00_r8,4.0161e+00_r8,3.6975e+00_r8, & + &3.3039e+00_r8,2.7454e+00_r8,1.8396e+00_r8/) + kao(:, 4,12,11) = (/ & + &4.3996e+00_r8,4.4753e+00_r8,4.5481e+00_r8,4.4345e+00_r8,4.2153e+00_r8,3.8944e+00_r8, & + &3.5079e+00_r8,2.9264e+00_r8,2.0403e+00_r8/) + kao(:, 5,12,11) = (/ & + &4.4754e+00_r8,4.5978e+00_r8,4.6899e+00_r8,4.6220e+00_r8,4.4006e+00_r8,4.0838e+00_r8, & + &3.7036e+00_r8,3.0926e+00_r8,2.2349e+00_r8/) + kao(:, 1,13,11) = (/ & + &4.0592e+00_r8,4.0332e+00_r8,3.9681e+00_r8,3.7590e+00_r8,3.4963e+00_r8,3.1626e+00_r8, & + &2.7397e+00_r8,2.2238e+00_r8,1.2732e+00_r8/) + kao(:, 2,13,11) = (/ & + &4.1472e+00_r8,4.1742e+00_r8,4.1368e+00_r8,3.9606e+00_r8,3.7120e+00_r8,3.3731e+00_r8, & + &2.9427e+00_r8,2.4115e+00_r8,1.4537e+00_r8/) + kao(:, 3,13,11) = (/ & + &4.2292e+00_r8,4.3011e+00_r8,4.2979e+00_r8,4.1507e+00_r8,3.9119e+00_r8,3.5700e+00_r8, & + &3.1423e+00_r8,2.5914e+00_r8,1.6282e+00_r8/) + kao(:, 4,13,11) = (/ & + &4.3001e+00_r8,4.4170e+00_r8,4.4457e+00_r8,4.3341e+00_r8,4.0986e+00_r8,3.7637e+00_r8, & + &3.3341e+00_r8,2.7592e+00_r8,1.8128e+00_r8/) + kao(:, 5,13,11) = (/ & + &4.3627e+00_r8,4.5278e+00_r8,4.5856e+00_r8,4.5011e+00_r8,4.2740e+00_r8,3.9472e+00_r8, & + &3.5112e+00_r8,2.9185e+00_r8,1.9901e+00_r8/) + kao(:, 1, 1,12) = (/ & + &1.2832e-03_r8,7.6911e-01_r8,1.5308e+00_r8,2.2815e+00_r8,3.0131e+00_r8,3.7102e+00_r8, & + &4.3339e+00_r8,4.8156e+00_r8,6.0262e+00_r8/) + kao(:, 2, 1,12) = (/ & + &1.3165e-03_r8,8.3137e-01_r8,1.6545e+00_r8,2.4655e+00_r8,3.2561e+00_r8,4.0092e+00_r8, & + &4.6800e+00_r8,5.1382e+00_r8,6.5123e+00_r8/) + kao(:, 3, 1,12) = (/ & + &1.3465e-03_r8,8.9467e-01_r8,1.7805e+00_r8,2.6534e+00_r8,3.5040e+00_r8,4.3130e+00_r8, & + &5.0270e+00_r8,5.5081e+00_r8,7.0080e+00_r8/) + kao(:, 4, 1,12) = (/ & + &1.3733e-03_r8,9.5420e-01_r8,1.9011e+00_r8,2.8343e+00_r8,3.7449e+00_r8,4.6125e+00_r8, & + &5.3804e+00_r8,5.8655e+00_r8,7.4899e+00_r8/) + kao(:, 5, 1,12) = (/ & + &1.3973e-03_r8,1.0065e+00_r8,2.0056e+00_r8,2.9931e+00_r8,3.9616e+00_r8,4.8908e+00_r8, & + &5.7173e+00_r8,6.2206e+00_r8,7.9232e+00_r8/) + kao(:, 1, 2,12) = (/ & + &2.1567e-03_r8,7.9503e-01_r8,1.5851e+00_r8,2.3675e+00_r8,3.1367e+00_r8,3.8805e+00_r8, & + &4.5651e+00_r8,5.0566e+00_r8,6.2733e+00_r8/) + kao(:, 2, 2,12) = (/ & + &2.2096e-03_r8,8.5765e-01_r8,1.7102e+00_r8,2.5549e+00_r8,3.3862e+00_r8,4.1922e+00_r8, & + &4.9361e+00_r8,5.4818e+00_r8,6.7723e+00_r8/) + kao(:, 3, 2,12) = (/ & + &2.2593e-03_r8,9.2132e-01_r8,1.8371e+00_r8,2.7441e+00_r8,3.6360e+00_r8,4.5001e+00_r8, & + &5.3023e+00_r8,5.9092e+00_r8,7.2719e+00_r8/) + kao(:, 4, 2,12) = (/ & + &2.3029e-03_r8,9.7961e-01_r8,1.9547e+00_r8,2.9227e+00_r8,3.8771e+00_r8,4.8047e+00_r8, & + &5.6684e+00_r8,6.3211e+00_r8,7.7542e+00_r8/) + kao(:, 5, 2,12) = (/ & + &2.3432e-03_r8,1.0294e+00_r8,2.0551e+00_r8,3.0745e+00_r8,4.0831e+00_r8,5.0720e+00_r8, & + &6.0082e+00_r8,6.7230e+00_r8,8.1662e+00_r8/) + kao(:, 1, 3,12) = (/ & + &4.8280e-03_r8,7.9900e-01_r8,1.5962e+00_r8,2.3906e+00_r8,3.1803e+00_r8,3.9604e+00_r8, & + &4.7157e+00_r8,5.3732e+00_r8,6.3605e+00_r8/) + kao(:, 2, 3,12) = (/ & + &4.9522e-03_r8,8.6159e-01_r8,1.7217e+00_r8,2.5790e+00_r8,3.4316e+00_r8,4.2766e+00_r8, & + &5.0979e+00_r8,5.8264e+00_r8,6.8633e+00_r8/) + kao(:, 3, 3,12) = (/ & + &5.0521e-03_r8,9.2450e-01_r8,1.8472e+00_r8,2.7674e+00_r8,3.6829e+00_r8,4.5888e+00_r8, & + &5.4724e+00_r8,6.2581e+00_r8,7.3659e+00_r8/) + kao(:, 4, 3,12) = (/ & + &5.1417e-03_r8,9.8492e-01_r8,1.9684e+00_r8,2.9494e+00_r8,3.9267e+00_r8,4.8950e+00_r8, & + &5.8398e+00_r8,6.6855e+00_r8,7.8533e+00_r8/) + kao(:, 5, 3,12) = (/ & + &5.2128e-03_r8,1.0351e+00_r8,2.0685e+00_r8,3.1013e+00_r8,4.1304e+00_r8,5.1536e+00_r8, & + &6.1563e+00_r8,7.0696e+00_r8,8.2608e+00_r8/) + kao(:, 1, 4,12) = (/ & + &1.0891e-02_r8,7.7727e-01_r8,1.5543e+00_r8,2.3309e+00_r8,3.1067e+00_r8,3.8812e+00_r8, & + &4.6512e+00_r8,5.4004e+00_r8,6.2133e+00_r8/) + kao(:, 2, 4,12) = (/ & + &1.1146e-02_r8,8.4013e-01_r8,1.6801e+00_r8,2.5195e+00_r8,3.3588e+00_r8,4.1965e+00_r8, & + &5.0315e+00_r8,5.8522e+00_r8,6.7175e+00_r8/) + kao(:, 3, 4,12) = (/ & + &1.1369e-02_r8,9.0347e-01_r8,1.8066e+00_r8,2.7094e+00_r8,3.6116e+00_r8,4.5128e+00_r8, & + &5.4097e+00_r8,6.2868e+00_r8,7.2231e+00_r8/) + kao(:, 4, 4,12) = (/ & + &1.1543e-02_r8,9.6345e-01_r8,1.9267e+00_r8,2.8898e+00_r8,3.8526e+00_r8,4.8146e+00_r8, & + &5.7741e+00_r8,6.7146e+00_r8,7.7051e+00_r8/) + kao(:, 5, 4,12) = (/ & + &1.1696e-02_r8,1.0158e+00_r8,2.0314e+00_r8,3.0468e+00_r8,4.0618e+00_r8,5.0772e+00_r8, & + &6.0909e+00_r8,7.0982e+00_r8,8.1235e+00_r8/) + kao(:, 1, 5,12) = (/ & + &2.2302e-02_r8,7.3490e-01_r8,1.4696e+00_r8,2.2046e+00_r8,2.9394e+00_r8,3.6745e+00_r8, & + &4.4097e+00_r8,5.1450e+00_r8,5.8787e+00_r8/) + kao(:, 2, 5,12) = (/ & + &2.2823e-02_r8,7.9768e-01_r8,1.5952e+00_r8,2.3932e+00_r8,3.1913e+00_r8,3.9900e+00_r8, & + &4.7899e+00_r8,5.5934e+00_r8,6.3823e+00_r8/) + kao(:, 3, 5,12) = (/ & + &2.3280e-02_r8,8.5775e-01_r8,1.7153e+00_r8,2.5734e+00_r8,3.4313e+00_r8,4.2902e+00_r8, & + &5.1502e+00_r8,6.0153e+00_r8,6.8623e+00_r8/) + kao(:, 4, 5,12) = (/ & + &2.3683e-02_r8,9.1895e-01_r8,1.8383e+00_r8,2.7574e+00_r8,3.6772e+00_r8,4.5980e+00_r8, & + &5.5202e+00_r8,6.4486e+00_r8,7.3542e+00_r8/) + kao(:, 5, 5,12) = (/ & + &2.3999e-02_r8,9.7537e-01_r8,1.9505e+00_r8,2.9260e+00_r8,3.9018e+00_r8,4.8784e+00_r8, & + &5.8576e+00_r8,6.8447e+00_r8,7.8034e+00_r8/) + kao(:, 1, 6,12) = (/ & + &4.2265e-02_r8,6.7923e-01_r8,1.3583e+00_r8,2.0372e+00_r8,2.7164e+00_r8,3.3965e+00_r8, & + &4.0771e+00_r8,4.7611e+00_r8,5.4325e+00_r8/) + kao(:, 2, 6,12) = (/ & + &4.3312e-02_r8,7.4027e-01_r8,1.4802e+00_r8,2.2203e+00_r8,2.9606e+00_r8,3.7016e+00_r8, & + &4.4440e+00_r8,5.1934e+00_r8,5.9209e+00_r8/) + kao(:, 3, 6,12) = (/ & + &4.4154e-02_r8,8.0193e-01_r8,1.6036e+00_r8,2.4053e+00_r8,3.2071e+00_r8,4.0091e+00_r8, & + &4.8130e+00_r8,5.6200e+00_r8,6.4137e+00_r8/) + kao(:, 4, 6,12) = (/ & + &4.4818e-02_r8,8.6447e-01_r8,1.7287e+00_r8,2.5931e+00_r8,3.4580e+00_r8,4.3234e+00_r8, & + &5.1892e+00_r8,6.0606e+00_r8,6.9157e+00_r8/) + kao(:, 5, 6,12) = (/ & + &4.5427e-02_r8,9.2353e-01_r8,1.8468e+00_r8,2.7701e+00_r8,3.6940e+00_r8,4.6182e+00_r8, & + &5.5436e+00_r8,6.4744e+00_r8,7.3877e+00_r8/) + kao(:, 1, 7,12) = (/ & + &8.2851e-02_r8,6.1813e-01_r8,1.2353e+00_r8,1.8525e+00_r8,2.4701e+00_r8,3.0880e+00_r8, & + &3.7064e+00_r8,4.3285e+00_r8,4.9392e+00_r8/) + kao(:, 2, 7,12) = (/ & + &8.4778e-02_r8,6.8174e-01_r8,1.3624e+00_r8,2.0434e+00_r8,2.7245e+00_r8,3.4060e+00_r8, & + &4.0883e+00_r8,4.7735e+00_r8,5.4481e+00_r8/) + kao(:, 3, 7,12) = (/ & + &8.6620e-02_r8,7.4569e-01_r8,1.4908e+00_r8,2.2359e+00_r8,2.9814e+00_r8,3.7272e+00_r8, & + &4.4733e+00_r8,5.2220e+00_r8,5.9623e+00_r8/) + kao(:, 4, 7,12) = (/ & + &8.8221e-02_r8,8.0972e-01_r8,1.6191e+00_r8,2.4284e+00_r8,3.2380e+00_r8,4.0476e+00_r8, & + &4.8581e+00_r8,5.6715e+00_r8,6.4756e+00_r8/) + kao(:, 5, 7,12) = (/ & + &8.9388e-02_r8,8.6929e-01_r8,1.7383e+00_r8,2.6072e+00_r8,3.4769e+00_r8,4.3464e+00_r8, & + &5.2172e+00_r8,6.0912e+00_r8,6.9533e+00_r8/) + kao(:, 1, 8,12) = (/ & + &1.9209e-01_r8,6.2527e-01_r8,1.1133e+00_r8,1.6689e+00_r8,2.2244e+00_r8,2.7803e+00_r8, & + &3.3362e+00_r8,3.8938e+00_r8,4.4464e+00_r8/) + kao(:, 2, 8,12) = (/ & + &1.9727e-01_r8,6.6108e-01_r8,1.2430e+00_r8,1.8635e+00_r8,2.4844e+00_r8,3.1054e+00_r8, & + &3.7267e+00_r8,4.3504e+00_r8,4.9671e+00_r8/) + kao(:, 3, 8,12) = (/ & + &2.0144e-01_r8,7.0485e-01_r8,1.3718e+00_r8,2.0572e+00_r8,2.7423e+00_r8,3.4280e+00_r8, & + &4.1141e+00_r8,4.8012e+00_r8,5.4833e+00_r8/) + kao(:, 4, 8,12) = (/ & + &2.0484e-01_r8,7.5576e-01_r8,1.4986e+00_r8,2.2473e+00_r8,2.9964e+00_r8,3.7450e+00_r8, & + &4.4951e+00_r8,5.2469e+00_r8,5.9915e+00_r8/) + kao(:, 5, 8,12) = (/ & + &2.0777e-01_r8,8.0793e-01_r8,1.6132e+00_r8,2.4193e+00_r8,3.2252e+00_r8,4.0323e+00_r8, & + &4.8391e+00_r8,5.6481e+00_r8,6.4494e+00_r8/) + kao(:, 1, 9,12) = (/ & + &8.2620e-01_r8,1.3515e+00_r8,1.6396e+00_r8,1.8633e+00_r8,2.0617e+00_r8,2.4827e+00_r8, & + &2.9771e+00_r8,3.4729e+00_r8,3.9666e+00_r8/) + kao(:, 2, 9,12) = (/ & + &8.4850e-01_r8,1.4155e+00_r8,1.7443e+00_r8,1.9664e+00_r8,2.2558e+00_r8,2.7862e+00_r8, & + &3.3424e+00_r8,3.8990e+00_r8,4.4541e+00_r8/) + kao(:, 3, 9,12) = (/ & + &8.6743e-01_r8,1.4840e+00_r8,1.8355e+00_r8,2.0729e+00_r8,2.4805e+00_r8,3.0958e+00_r8, & + &3.7138e+00_r8,4.3325e+00_r8,4.9497e+00_r8/) + kao(:, 4, 9,12) = (/ & + &8.8373e-01_r8,1.5402e+00_r8,1.9288e+00_r8,2.1892e+00_r8,2.7106e+00_r8,3.3871e+00_r8, & + &4.0635e+00_r8,4.7407e+00_r8,5.4157e+00_r8/) + kao(:, 5, 9,12) = (/ & + &8.9622e-01_r8,1.5897e+00_r8,2.0124e+00_r8,2.3107e+00_r8,2.9348e+00_r8,3.6673e+00_r8, & + &4.4005e+00_r8,5.1335e+00_r8,5.8643e+00_r8/) + kao(:, 1,10,12) = (/ & + &3.9173e+00_r8,3.9928e+00_r8,4.3366e+00_r8,4.4280e+00_r8,4.2663e+00_r8,3.9998e+00_r8, & + &3.6166e+00_r8,3.1308e+00_r8,3.5126e+00_r8/) + kao(:, 2,10,12) = (/ & + &4.0212e+00_r8,4.1687e+00_r8,4.5593e+00_r8,4.6368e+00_r8,4.5220e+00_r8,4.2834e+00_r8, & + &3.8634e+00_r8,3.4894e+00_r8,3.9713e+00_r8/) + kao(:, 3,10,12) = (/ & + &4.1147e+00_r8,4.3230e+00_r8,4.7454e+00_r8,4.8522e+00_r8,4.7749e+00_r8,4.5433e+00_r8, & + &4.0957e+00_r8,3.8708e+00_r8,4.4196e+00_r8/) + kao(:, 4,10,12) = (/ & + &4.1890e+00_r8,4.4586e+00_r8,4.9236e+00_r8,5.0494e+00_r8,4.9988e+00_r8,4.8016e+00_r8, & + &4.3028e+00_r8,4.2486e+00_r8,4.8508e+00_r8/) + kao(:, 5,10,12) = (/ & + &4.2486e+00_r8,4.5669e+00_r8,5.0902e+00_r8,5.2222e+00_r8,5.2265e+00_r8,5.0216e+00_r8, & + &4.5057e+00_r8,4.6204e+00_r8,5.2753e+00_r8/) + kao(:, 1,11,12) = (/ & + &6.5008e+00_r8,6.1849e+00_r8,6.2789e+00_r8,6.2685e+00_r8,5.9393e+00_r8,5.4109e+00_r8, & + &4.7099e+00_r8,3.7046e+00_r8,3.2687e+00_r8/) + kao(:, 2,11,12) = (/ & + &6.6711e+00_r8,6.4071e+00_r8,6.5745e+00_r8,6.5690e+00_r8,6.2447e+00_r8,5.7486e+00_r8, & + &5.0466e+00_r8,3.9652e+00_r8,3.6849e+00_r8/) + kao(:, 3,11,12) = (/ & + &6.8141e+00_r8,6.5961e+00_r8,6.8266e+00_r8,6.8425e+00_r8,6.5425e+00_r8,6.0645e+00_r8, & + &5.3679e+00_r8,4.1951e+00_r8,4.0848e+00_r8/) + kao(:, 4,11,12) = (/ & + &6.9309e+00_r8,6.7641e+00_r8,7.0497e+00_r8,7.0951e+00_r8,6.8173e+00_r8,6.3688e+00_r8, & + &5.6628e+00_r8,4.4427e+00_r8,4.4838e+00_r8/) + kao(:, 5,11,12) = (/ & + &7.0334e+00_r8,6.9031e+00_r8,7.2676e+00_r8,7.3125e+00_r8,7.0679e+00_r8,6.6762e+00_r8, & + &5.9144e+00_r8,4.7231e+00_r8,4.9084e+00_r8/) + kao(:, 1,12,12) = (/ & + &8.0356e+00_r8,7.5209e+00_r8,7.4229e+00_r8,7.2434e+00_r8,6.7979e+00_r8,6.1202e+00_r8, & + &5.2895e+00_r8,4.1070e+00_r8,2.9936e+00_r8/) + kao(:, 2,12,12) = (/ & + &8.2347e+00_r8,7.7748e+00_r8,7.7310e+00_r8,7.5713e+00_r8,7.1351e+00_r8,6.4951e+00_r8, & + &5.6590e+00_r8,4.4043e+00_r8,3.3743e+00_r8/) + kao(:, 3,12,12) = (/ & + &8.4084e+00_r8,7.9908e+00_r8,8.0012e+00_r8,7.8714e+00_r8,7.4600e+00_r8,6.8499e+00_r8, & + &6.0055e+00_r8,4.6706e+00_r8,3.7574e+00_r8/) + kao(:, 4,12,12) = (/ & + &8.5546e+00_r8,8.1702e+00_r8,8.2474e+00_r8,8.1496e+00_r8,7.7631e+00_r8,7.1869e+00_r8, & + &6.3250e+00_r8,4.9362e+00_r8,4.1426e+00_r8/) + kao(:, 5,12,12) = (/ & + &8.6676e+00_r8,8.3299e+00_r8,8.4723e+00_r8,8.3950e+00_r8,8.0405e+00_r8,7.5149e+00_r8, & + &6.6159e+00_r8,5.2129e+00_r8,4.5254e+00_r8/) + kao(:, 1,13,12) = (/ & + &7.9759e+00_r8,7.5343e+00_r8,7.4503e+00_r8,7.1563e+00_r8,6.6524e+00_r8,6.0033e+00_r8, & + &5.2080e+00_r8,4.0643e+00_r8,2.7278e+00_r8/) + kao(:, 2,13,12) = (/ & + &8.1794e+00_r8,7.7874e+00_r8,7.7473e+00_r8,7.4642e+00_r8,6.9912e+00_r8,6.3834e+00_r8, & + &5.5711e+00_r8,4.3572e+00_r8,3.0821e+00_r8/) + kao(:, 3,13,12) = (/ & + &8.3457e+00_r8,8.0091e+00_r8,8.0057e+00_r8,7.7578e+00_r8,7.3258e+00_r8,6.7364e+00_r8, & + &5.9096e+00_r8,4.6439e+00_r8,3.4477e+00_r8/) + kao(:, 4,13,12) = (/ & + &8.4812e+00_r8,8.2074e+00_r8,8.2395e+00_r8,8.0326e+00_r8,7.6295e+00_r8,7.0667e+00_r8, & + &6.2213e+00_r8,4.9334e+00_r8,3.7948e+00_r8/) + kao(:, 5,13,12) = (/ & + &8.5914e+00_r8,8.3651e+00_r8,8.4655e+00_r8,8.2768e+00_r8,7.9296e+00_r8,7.3785e+00_r8, & + &6.5133e+00_r8,5.2165e+00_r8,4.1485e+00_r8/) + kao(:, 1, 1,13) = (/ & + &1.8376e-03_r8,1.2493e+00_r8,2.4869e+00_r8,3.7066e+00_r8,4.8962e+00_r8,6.0283e+00_r8, & + &7.0325e+00_r8,7.5732e+00_r8,9.7924e+00_r8/) + kao(:, 2, 1,13) = (/ & + &1.8435e-03_r8,1.3137e+00_r8,2.6151e+00_r8,3.8978e+00_r8,5.1474e+00_r8,6.3345e+00_r8, & + &7.3693e+00_r8,7.9436e+00_r8,1.0295e+01_r8/) + kao(:, 3, 1,13) = (/ & + &1.8457e-03_r8,1.3823e+00_r8,2.7512e+00_r8,4.0980e+00_r8,5.4060e+00_r8,6.6439e+00_r8, & + &7.7282e+00_r8,8.2817e+00_r8,1.0812e+01_r8/) + kao(:, 4, 1,13) = (/ & + &1.8458e-03_r8,1.4480e+00_r8,2.8814e+00_r8,4.2920e+00_r8,5.6663e+00_r8,6.9707e+00_r8, & + &8.1084e+00_r8,8.6593e+00_r8,1.1333e+01_r8/) + kao(:, 5, 1,13) = (/ & + &1.8581e-03_r8,1.5191e+00_r8,3.0214e+00_r8,4.4961e+00_r8,5.9276e+00_r8,7.2804e+00_r8, & + &8.4721e+00_r8,9.0750e+00_r8,1.1855e+01_r8/) + kao(:, 1, 2,13) = (/ & + &3.0081e-03_r8,1.2887e+00_r8,2.5721e+00_r8,3.8463e+00_r8,5.1064e+00_r8,6.3378e+00_r8, & + &7.4987e+00_r8,8.3933e+00_r8,1.0213e+01_r8/) + kao(:, 2, 2,13) = (/ & + &3.0389e-03_r8,1.3599e+00_r8,2.7131e+00_r8,4.0552e+00_r8,5.3783e+00_r8,6.6678e+00_r8, & + &7.8772e+00_r8,8.7981e+00_r8,1.0756e+01_r8/) + kao(:, 3, 2,13) = (/ & + &3.0623e-03_r8,1.4308e+00_r8,2.8555e+00_r8,4.2711e+00_r8,5.6674e+00_r8,7.0255e+00_r8, & + &8.2810e+00_r8,9.2099e+00_r8,1.1335e+01_r8/) + kao(:, 4, 2,13) = (/ & + &3.1073e-03_r8,1.4998e+00_r8,2.9927e+00_r8,4.4738e+00_r8,5.9361e+00_r8,7.3612e+00_r8, & + &8.6975e+00_r8,9.6506e+00_r8,1.1872e+01_r8/) + kao(:, 5, 2,13) = (/ & + &3.1371e-03_r8,1.5763e+00_r8,3.1432e+00_r8,4.6958e+00_r8,6.2242e+00_r8,7.7091e+00_r8, & + &9.0917e+00_r8,1.0108e+01_r8,1.2448e+01_r8/) + kao(:, 1, 3,13) = (/ & + &6.7566e-03_r8,1.3010e+00_r8,2.6001e+00_r8,3.8967e+00_r8,5.1878e+00_r8,6.4676e+00_r8, & + &7.7183e+00_r8,8.8575e+00_r8,1.0376e+01_r8/) + kao(:, 2, 3,13) = (/ & + &6.8655e-03_r8,1.3725e+00_r8,2.7424e+00_r8,4.1083e+00_r8,5.4679e+00_r8,6.8133e+00_r8, & + &8.1286e+00_r8,9.3210e+00_r8,1.0936e+01_r8/) + kao(:, 3, 3,13) = (/ & + &7.0162e-03_r8,1.4463e+00_r8,2.8900e+00_r8,4.3294e+00_r8,5.7613e+00_r8,7.1793e+00_r8, & + &8.5582e+00_r8,9.7979e+00_r8,1.1523e+01_r8/) + kao(:, 4, 3,13) = (/ & + &7.1355e-03_r8,1.5186e+00_r8,3.0341e+00_r8,4.5447e+00_r8,6.0464e+00_r8,7.5309e+00_r8, & + &8.9783e+00_r8,1.0290e+01_r8,1.2093e+01_r8/) + kao(:, 5, 3,13) = (/ & + &7.2326e-03_r8,1.6009e+00_r8,3.1979e+00_r8,4.7883e+00_r8,6.3681e+00_r8,7.9274e+00_r8, & + &9.4396e+00_r8,1.0789e+01_r8,1.2736e+01_r8/) + kao(:, 1, 4,13) = (/ & + &1.5770e-02_r8,1.2974e+00_r8,2.5940e+00_r8,3.8891e+00_r8,5.1823e+00_r8,6.4711e+00_r8, & + &7.7497e+00_r8,8.9872e+00_r8,1.0364e+01_r8/) + kao(:, 2, 4,13) = (/ & + &1.6102e-02_r8,1.3725e+00_r8,2.7438e+00_r8,4.1133e+00_r8,5.4792e+00_r8,6.8384e+00_r8, & + &8.1824e+00_r8,9.4681e+00_r8,1.0958e+01_r8/) + kao(:, 3, 4,13) = (/ & + &1.6461e-02_r8,1.4529e+00_r8,2.9044e+00_r8,4.3540e+00_r8,5.7994e+00_r8,7.2375e+00_r8, & + &8.6575e+00_r8,1.0008e+01_r8,1.1599e+01_r8/) + kao(:, 4, 4,13) = (/ & + &1.6764e-02_r8,1.5336e+00_r8,3.0659e+00_r8,4.5952e+00_r8,6.1201e+00_r8,7.6366e+00_r8, & + &9.1307e+00_r8,1.0552e+01_r8,1.2240e+01_r8/) + kao(:, 5, 4,13) = (/ & + &1.6983e-02_r8,1.6203e+00_r8,3.2389e+00_r8,4.8548e+00_r8,6.4661e+00_r8,8.0668e+00_r8, & + &9.6455e+00_r8,1.1132e+01_r8,1.2932e+01_r8/) + kao(:, 1, 5,13) = (/ & + &3.3958e-02_r8,1.2926e+00_r8,2.5850e+00_r8,3.8765e+00_r8,5.1671e+00_r8,6.4548e+00_r8, & + &7.7382e+00_r8,9.0001e+00_r8,1.0334e+01_r8/) + kao(:, 2, 5,13) = (/ & + &3.4722e-02_r8,1.3756e+00_r8,2.7505e+00_r8,4.1243e+00_r8,5.4969e+00_r8,6.8654e+00_r8, & + &8.2252e+00_r8,9.5545e+00_r8,1.0994e+01_r8/) + kao(:, 3, 5,13) = (/ & + &3.5363e-02_r8,1.4648e+00_r8,2.9290e+00_r8,4.3919e+00_r8,5.8529e+00_r8,7.3099e+00_r8, & + &8.7568e+00_r8,1.0164e+01_r8,1.1706e+01_r8/) + kao(:, 4, 5,13) = (/ & + &3.6012e-02_r8,1.5505e+00_r8,3.1003e+00_r8,4.6491e+00_r8,6.1954e+00_r8,7.7382e+00_r8, & + &9.2690e+00_r8,1.0761e+01_r8,1.2391e+01_r8/) + kao(:, 5, 5,13) = (/ & + &3.6453e-02_r8,1.6361e+00_r8,3.2714e+00_r8,4.9053e+00_r8,6.5374e+00_r8,8.1645e+00_r8, & + &9.7803e+00_r8,1.1352e+01_r8,1.3075e+01_r8/) + kao(:, 1, 6,13) = (/ & + &6.7837e-02_r8,1.2756e+00_r8,2.5511e+00_r8,3.8262e+00_r8,5.1016e+00_r8,6.3755e+00_r8, & + &7.6486e+00_r8,8.9147e+00_r8,1.0203e+01_r8/) + kao(:, 2, 6,13) = (/ & + &6.9368e-02_r8,1.3655e+00_r8,2.7307e+00_r8,4.0953e+00_r8,5.4595e+00_r8,6.8218e+00_r8, & + &8.1822e+00_r8,9.5288e+00_r8,1.0919e+01_r8/) + kao(:, 3, 6,13) = (/ & + &7.0610e-02_r8,1.4598e+00_r8,2.9193e+00_r8,4.3789e+00_r8,5.8375e+00_r8,7.2946e+00_r8, & + &8.7480e+00_r8,1.0185e+01_r8,1.1675e+01_r8/) + kao(:, 4, 6,13) = (/ & + &7.1895e-02_r8,1.5499e+00_r8,3.0992e+00_r8,4.6481e+00_r8,6.1963e+00_r8,7.7431e+00_r8, & + &9.2863e+00_r8,1.0814e+01_r8,1.2392e+01_r8/) + kao(:, 5, 6,13) = (/ & + &7.2713e-02_r8,1.6401e+00_r8,3.2796e+00_r8,4.9184e+00_r8,6.5572e+00_r8,8.1927e+00_r8, & + &9.8252e+00_r8,1.1440e+01_r8,1.3114e+01_r8/) + kao(:, 1, 7,13) = (/ & + &1.4148e-01_r8,1.2306e+00_r8,2.4611e+00_r8,3.6917e+00_r8,4.9218e+00_r8,6.1530e+00_r8, & + &7.3843e+00_r8,8.6153e+00_r8,9.8436e+00_r8/) + kao(:, 2, 7,13) = (/ & + &1.4468e-01_r8,1.3267e+00_r8,2.6534e+00_r8,3.9799e+00_r8,5.3067e+00_r8,6.6328e+00_r8, & + &7.9589e+00_r8,9.2835e+00_r8,1.0613e+01_r8/) + kao(:, 3, 7,13) = (/ & + &1.4723e-01_r8,1.4271e+00_r8,2.8538e+00_r8,4.2801e+00_r8,5.7062e+00_r8,7.1323e+00_r8, & + &8.5577e+00_r8,9.9797e+00_r8,1.1412e+01_r8/) + kao(:, 4, 7,13) = (/ & + &1.4959e-01_r8,1.5234e+00_r8,3.0460e+00_r8,4.5687e+00_r8,6.0905e+00_r8,7.6133e+00_r8, & + &9.1342e+00_r8,1.0653e+01_r8,1.2180e+01_r8/) + kao(:, 5, 7,13) = (/ & + &1.5109e-01_r8,1.6156e+00_r8,3.2301e+00_r8,4.8444e+00_r8,6.4594e+00_r8,8.0732e+00_r8, & + &9.6859e+00_r8,1.1294e+01_r8,1.2918e+01_r8/) + kao(:, 1, 8,13) = (/ & + &3.4983e-01_r8,1.1544e+00_r8,2.3087e+00_r8,3.4632e+00_r8,4.6176e+00_r8,5.7728e+00_r8, & + &6.9283e+00_r8,8.0852e+00_r8,9.2350e+00_r8/) + kao(:, 2, 8,13) = (/ & + &3.5757e-01_r8,1.2554e+00_r8,2.5092e+00_r8,3.7633e+00_r8,5.0176e+00_r8,6.2716e+00_r8, & + &7.5265e+00_r8,8.7822e+00_r8,1.0034e+01_r8/) + kao(:, 3, 8,13) = (/ & + &3.6359e-01_r8,1.3606e+00_r8,2.7192e+00_r8,4.0780e+00_r8,5.4366e+00_r8,6.7958e+00_r8, & + &8.1543e+00_r8,9.5151e+00_r8,1.0871e+01_r8/) + kao(:, 4, 8,13) = (/ & + &3.6947e-01_r8,1.4619e+00_r8,2.9219e+00_r8,4.3820e+00_r8,5.8417e+00_r8,7.3019e+00_r8, & + &8.7622e+00_r8,1.0223e+01_r8,1.1681e+01_r8/) + kao(:, 5, 8,13) = (/ & + &3.7269e-01_r8,1.5629e+00_r8,3.1234e+00_r8,4.6839e+00_r8,6.2445e+00_r8,7.8052e+00_r8, & + &9.3661e+00_r8,1.0928e+01_r8,1.2487e+01_r8/) + kao(:, 1, 9,13) = (/ & + &1.6120e+00_r8,2.1579e+00_r8,2.5856e+00_r8,3.2058e+00_r8,4.2226e+00_r8,5.2767e+00_r8, & + &6.3317e+00_r8,7.3871e+00_r8,8.4404e+00_r8/) + kao(:, 2, 9,13) = (/ & + &1.6481e+00_r8,2.2537e+00_r8,2.6687e+00_r8,3.4901e+00_r8,4.6465e+00_r8,5.8062e+00_r8, & + &6.9659e+00_r8,8.1266e+00_r8,9.2849e+00_r8/) + kao(:, 3, 9,13) = (/ & + &1.6791e+00_r8,2.3216e+00_r8,2.7898e+00_r8,3.8113e+00_r8,5.0781e+00_r8,6.3453e+00_r8, & + &7.6127e+00_r8,8.8803e+00_r8,1.0146e+01_r8/) + kao(:, 4, 9,13) = (/ & + &1.7002e+00_r8,2.3849e+00_r8,2.9226e+00_r8,4.1389e+00_r8,5.5144e+00_r8,6.8902e+00_r8, & + &8.2665e+00_r8,9.6440e+00_r8,1.1018e+01_r8/) + kao(:, 5, 9,13) = (/ & + &1.7139e+00_r8,2.4356e+00_r8,3.0744e+00_r8,4.4589e+00_r8,5.9418e+00_r8,7.4246e+00_r8, & + &8.9078e+00_r8,1.0391e+01_r8,1.1873e+01_r8/) + kao(:, 1,10,13) = (/ & + &8.1900e+00_r8,7.5735e+00_r8,7.5164e+00_r8,7.4868e+00_r8,7.2490e+00_r8,6.5441e+00_r8, & + &6.0001e+00_r8,6.6902e+00_r8,7.6402e+00_r8/) + kao(:, 2,10,13) = (/ & + &8.3686e+00_r8,7.7990e+00_r8,7.8449e+00_r8,7.8651e+00_r8,7.5310e+00_r8,6.7442e+00_r8, & + &6.5109e+00_r8,7.4533e+00_r8,8.5097e+00_r8/) + kao(:, 3,10,13) = (/ & + &8.5094e+00_r8,8.0068e+00_r8,8.1129e+00_r8,8.1601e+00_r8,7.7387e+00_r8,7.0241e+00_r8, & + &7.1098e+00_r8,8.2483e+00_r8,9.4190e+00_r8/) + kao(:, 4,10,13) = (/ & + &8.6083e+00_r8,8.1729e+00_r8,8.3302e+00_r8,8.3900e+00_r8,7.9589e+00_r8,7.3305e+00_r8, & + &7.7681e+00_r8,9.0471e+00_r8,1.0331e+01_r8/) + kao(:, 5,10,13) = (/ & + &8.6642e+00_r8,8.2947e+00_r8,8.5084e+00_r8,8.6017e+00_r8,8.1354e+00_r8,7.7044e+00_r8, & + &8.4486e+00_r8,9.8464e+00_r8,1.1244e+01_r8/) + kao(:, 1,11,13) = (/ & + &1.4422e+01_r8,1.2923e+01_r8,1.2146e+01_r8,1.1467e+01_r8,1.0797e+01_r8,9.7043e+00_r8, & + &7.9341e+00_r8,6.4523e+00_r8,7.2283e+00_r8/) + kao(:, 2,11,13) = (/ & + &1.4693e+01_r8,1.3224e+01_r8,1.2546e+01_r8,1.1961e+01_r8,1.1284e+01_r8,1.0051e+01_r8, & + &8.2717e+00_r8,7.1710e+00_r8,8.1411e+00_r8/) + kao(:, 3,11,13) = (/ & + &1.4865e+01_r8,1.3437e+01_r8,1.2872e+01_r8,1.2352e+01_r8,1.1673e+01_r8,1.0373e+01_r8, & + &8.6477e+00_r8,7.9776e+00_r8,9.0911e+00_r8/) + kao(:, 4,11,13) = (/ & + &1.4985e+01_r8,1.3594e+01_r8,1.3136e+01_r8,1.2689e+01_r8,1.2000e+01_r8,1.0700e+01_r8, & + &9.0501e+00_r8,8.7877e+00_r8,1.0028e+01_r8/) + kao(:, 5,11,13) = (/ & + &1.5049e+01_r8,1.3704e+01_r8,1.3344e+01_r8,1.2975e+01_r8,1.2311e+01_r8,1.0977e+01_r8, & + &9.5392e+00_r8,9.6092e+00_r8,1.0970e+01_r8/) + kao(:, 1,12,13) = (/ & + &1.8498e+01_r8,1.6493e+01_r8,1.5330e+01_r8,1.4296e+01_r8,1.3227e+01_r8,1.1776e+01_r8, & + &9.6093e+00_r8,6.9105e+00_r8,6.8698e+00_r8/) + kao(:, 2,12,13) = (/ & + &1.8757e+01_r8,1.6799e+01_r8,1.5767e+01_r8,1.4839e+01_r8,1.3780e+01_r8,1.2237e+01_r8, & + &1.0031e+01_r8,7.5179e+00_r8,7.8121e+00_r8/) + kao(:, 3,12,13) = (/ & + &1.8947e+01_r8,1.7036e+01_r8,1.6095e+01_r8,1.5249e+01_r8,1.4223e+01_r8,1.2650e+01_r8, & + &1.0480e+01_r8,8.1785e+00_r8,8.7273e+00_r8/) + kao(:, 4,12,13) = (/ & + &1.9063e+01_r8,1.7202e+01_r8,1.6365e+01_r8,1.5574e+01_r8,1.4614e+01_r8,1.3047e+01_r8, & + &1.0927e+01_r8,8.8781e+00_r8,9.6514e+00_r8/) + kao(:, 5,12,13) = (/ & + &1.9121e+01_r8,1.7309e+01_r8,1.6592e+01_r8,1.5868e+01_r8,1.4993e+01_r8,1.3399e+01_r8, & + &1.1411e+01_r8,9.6204e+00_r8,1.0609e+01_r8/) + kao(:, 1,13,13) = (/ & + &1.8681e+01_r8,1.6791e+01_r8,1.5759e+01_r8,1.4851e+01_r8,1.3770e+01_r8,1.2167e+01_r8, & + &1.0009e+01_r8,7.2580e+00_r8,6.5238e+00_r8/) + kao(:, 2,13,13) = (/ & + &1.8892e+01_r8,1.7070e+01_r8,1.6163e+01_r8,1.5373e+01_r8,1.4290e+01_r8,1.2645e+01_r8, & + &1.0505e+01_r8,7.8149e+00_r8,7.3987e+00_r8/) + kao(:, 3,13,13) = (/ & + &1.9028e+01_r8,1.7273e+01_r8,1.6517e+01_r8,1.5784e+01_r8,1.4702e+01_r8,1.3114e+01_r8, & + &1.1026e+01_r8,8.4153e+00_r8,8.2894e+00_r8/) + kao(:, 4,13,13) = (/ & + &1.9122e+01_r8,1.7418e+01_r8,1.6814e+01_r8,1.6131e+01_r8,1.5108e+01_r8,1.3570e+01_r8, & + &1.1549e+01_r8,9.0457e+00_r8,9.1940e+00_r8/) + kao(:, 5,13,13) = (/ & + &1.9151e+01_r8,1.7520e+01_r8,1.7041e+01_r8,1.6440e+01_r8,1.5494e+01_r8,1.4010e+01_r8, & + &1.2106e+01_r8,9.7104e+00_r8,1.0102e+01_r8/) + kao(:, 1, 1,14) = (/ & + &3.3087e-03_r8,1.8715e+00_r8,3.7152e+00_r8,5.5155e+00_r8,7.2487e+00_r8,8.8573e+00_r8, & + &1.0201e+01_r8,1.0807e+01_r8,1.4497e+01_r8/) + kao(:, 2, 1,14) = (/ & + &3.2220e-03_r8,1.9525e+00_r8,3.8750e+00_r8,5.7533e+00_r8,7.5552e+00_r8,9.2212e+00_r8, & + &1.0608e+01_r8,1.1197e+01_r8,1.5110e+01_r8/) + kao(:, 3, 1,14) = (/ & + &3.1339e-03_r8,2.0260e+00_r8,4.0195e+00_r8,5.9653e+00_r8,7.8344e+00_r8,9.5608e+00_r8, & + &1.0981e+01_r8,1.1562e+01_r8,1.5669e+01_r8/) + kao(:, 4, 1,14) = (/ & + &3.0455e-03_r8,2.1060e+00_r8,4.1769e+00_r8,6.1939e+00_r8,8.1222e+00_r8,9.8877e+00_r8, & + &1.1323e+01_r8,1.1897e+01_r8,1.6244e+01_r8/) + kao(:, 5, 1,14) = (/ & + &2.9339e-03_r8,2.1869e+00_r8,4.3369e+00_r8,6.4318e+00_r8,8.4325e+00_r8,1.0262e+01_r8, & + &1.1718e+01_r8,1.2199e+01_r8,1.6865e+01_r8/) + kao(:, 1, 2,14) = (/ & + &5.2878e-03_r8,2.0475e+00_r8,4.0760e+00_r8,6.0751e+00_r8,8.0240e+00_r8,9.8767e+00_r8, & + &1.1510e+01_r8,1.2463e+01_r8,1.6048e+01_r8/) + kao(:, 2, 2,14) = (/ & + &5.1473e-03_r8,2.1393e+00_r8,4.2595e+00_r8,6.3491e+00_r8,8.3874e+00_r8,1.0326e+01_r8, & + &1.2039e+01_r8,1.3009e+01_r8,1.6775e+01_r8/) + kao(:, 3, 2,14) = (/ & + &5.0049e-03_r8,2.2262e+00_r8,4.4297e+00_r8,6.5989e+00_r8,8.7109e+00_r8,1.0721e+01_r8, & + &1.2503e+01_r8,1.3517e+01_r8,1.7422e+01_r8/) + kao(:, 4, 2,14) = (/ & + &4.8227e-03_r8,2.3172e+00_r8,4.6099e+00_r8,6.8638e+00_r8,9.0568e+00_r8,1.1128e+01_r8, & + &1.2937e+01_r8,1.3964e+01_r8,1.8113e+01_r8/) + kao(:, 5, 2,14) = (/ & + &4.6542e-03_r8,2.4084e+00_r8,4.7911e+00_r8,7.1333e+00_r8,9.4086e+00_r8,1.1557e+01_r8, & + &1.3418e+01_r8,1.4407e+01_r8,1.8817e+01_r8/) + kao(:, 1, 3,14) = (/ & + &1.1438e-02_r8,2.1889e+00_r8,4.3692e+00_r8,6.5353e+00_r8,8.6778e+00_r8,1.0773e+01_r8, & + &1.2758e+01_r8,1.4346e+01_r8,1.7356e+01_r8/) + kao(:, 2, 3,14) = (/ & + &1.1139e-02_r8,2.3041e+00_r8,4.5995e+00_r8,6.8793e+00_r8,9.1316e+00_r8,1.1334e+01_r8, & + &1.3411e+01_r8,1.5052e+01_r8,1.8263e+01_r8/) + kao(:, 3, 3,14) = (/ & + &1.0770e-02_r8,2.4104e+00_r8,4.8103e+00_r8,7.1935e+00_r8,9.5485e+00_r8,1.1847e+01_r8, & + &1.4017e+01_r8,1.5716e+01_r8,1.9097e+01_r8/) + kao(:, 4, 3,14) = (/ & + &1.0423e-02_r8,2.5146e+00_r8,5.0181e+00_r8,7.5021e+00_r8,9.9570e+00_r8,1.2351e+01_r8, & + &1.4597e+01_r8,1.6319e+01_r8,1.9914e+01_r8/) + kao(:, 5, 3,14) = (/ & + &1.0104e-02_r8,2.6169e+00_r8,5.2203e+00_r8,7.8059e+00_r8,1.0356e+01_r8,1.2839e+01_r8, & + &1.5169e+01_r8,1.6937e+01_r8,2.0712e+01_r8/) + kao(:, 1, 4,14) = (/ & + &2.5365e-02_r8,2.3050e+00_r8,4.6063e+00_r8,6.9017e+00_r8,9.1853e+00_r8,1.1448e+01_r8, & + &1.3656e+01_r8,1.5659e+01_r8,1.8370e+01_r8/) + kao(:, 2, 4,14) = (/ & + &2.4778e-02_r8,2.4401e+00_r8,4.8764e+00_r8,7.3060e+00_r8,9.7240e+00_r8,1.2119e+01_r8, & + &1.4458e+01_r8,1.6580e+01_r8,1.9448e+01_r8/) + kao(:, 3, 4,14) = (/ & + &2.4097e-02_r8,2.5614e+00_r8,5.1183e+00_r8,7.6688e+00_r8,1.0206e+01_r8,1.2719e+01_r8, & + &1.5172e+01_r8,1.7403e+01_r8,2.0411e+01_r8/) + kao(:, 4, 4,14) = (/ & + &2.3478e-02_r8,2.6774e+00_r8,5.3500e+00_r8,8.0159e+00_r8,1.0665e+01_r8,1.3289e+01_r8, & + &1.5848e+01_r8,1.8161e+01_r8,2.1330e+01_r8/) + kao(:, 5, 4,14) = (/ & + &2.2944e-02_r8,2.7978e+00_r8,5.5896e+00_r8,8.3727e+00_r8,1.1139e+01_r8,1.3876e+01_r8, & + &1.6535e+01_r8,1.8911e+01_r8,2.2278e+01_r8/) + kao(:, 1, 5,14) = (/ & + &5.2400e-02_r8,2.3882e+00_r8,4.7744e+00_r8,7.1579e+00_r8,9.5370e+00_r8,1.1906e+01_r8, & + &1.4251e+01_r8,1.6502e+01_r8,1.9074e+01_r8/) + kao(:, 2, 5,14) = (/ & + &5.1529e-02_r8,2.5417e+00_r8,5.0820e+00_r8,7.6184e+00_r8,1.0150e+01_r8,1.2670e+01_r8, & + &1.5165e+01_r8,1.7564e+01_r8,2.0300e+01_r8/) + kao(:, 3, 5,14) = (/ & + &5.0713e-02_r8,2.6834e+00_r8,5.3644e+00_r8,8.0415e+00_r8,1.0713e+01_r8,1.3375e+01_r8, & + &1.6005e+01_r8,1.8525e+01_r8,2.1426e+01_r8/) + kao(:, 4, 5,14) = (/ & + &4.9736e-02_r8,2.8194e+00_r8,5.6359e+00_r8,8.4488e+00_r8,1.1255e+01_r8,1.4048e+01_r8, & + &1.6805e+01_r8,1.9440e+01_r8,2.2511e+01_r8/) + kao(:, 5, 5,14) = (/ & + &4.8999e-02_r8,2.9595e+00_r8,5.9157e+00_r8,8.8682e+00_r8,1.1813e+01_r8,1.4742e+01_r8, & + &1.7634e+01_r8,2.0380e+01_r8,2.3625e+01_r8/) + kao(:, 1, 6,14) = (/ & + &1.0351e-01_r8,2.4306e+00_r8,4.8601e+00_r8,7.2890e+00_r8,9.7147e+00_r8,1.2135e+01_r8, & + &1.4543e+01_r8,1.6905e+01_r8,1.9429e+01_r8/) + kao(:, 2, 6,14) = (/ & + &1.0255e-01_r8,2.6140e+00_r8,5.2274e+00_r8,7.8383e+00_r8,1.0448e+01_r8,1.3051e+01_r8, & + &1.5640e+01_r8,1.8174e+01_r8,2.0896e+01_r8/) + kao(:, 3, 6,14) = (/ & + &1.0183e-01_r8,2.7755e+00_r8,5.5503e+00_r8,8.3234e+00_r8,1.1093e+01_r8,1.3857e+01_r8, & + &1.6607e+01_r8,1.9300e+01_r8,2.2186e+01_r8/) + kao(:, 4, 6,14) = (/ & + &1.0081e-01_r8,2.9307e+00_r8,5.8597e+00_r8,8.7876e+00_r8,1.1711e+01_r8,1.4627e+01_r8, & + &1.7527e+01_r8,2.0360e+01_r8,2.3422e+01_r8/) + kao(:, 5, 6,14) = (/ & + &1.0025e-01_r8,3.0883e+00_r8,6.1762e+00_r8,9.2605e+00_r8,1.2342e+01_r8,1.5414e+01_r8, & + &1.8466e+01_r8,2.1444e+01_r8,2.4683e+01_r8/) + kao(:, 1, 7,14) = (/ & + &2.1803e-01_r8,2.4631e+00_r8,4.9259e+00_r8,7.3877e+00_r8,9.8477e+00_r8,1.2306e+01_r8, & + &1.4757e+01_r8,1.7182e+01_r8,1.9695e+01_r8/) + kao(:, 2, 7,14) = (/ & + &2.1806e-01_r8,2.6703e+00_r8,5.3400e+00_r8,8.0091e+00_r8,1.0677e+01_r8,1.3341e+01_r8, & + &1.6000e+01_r8,1.8630e+01_r8,2.1354e+01_r8/) + kao(:, 3, 7,14) = (/ & + &2.1815e-01_r8,2.8507e+00_r8,5.7004e+00_r8,8.5504e+00_r8,1.1399e+01_r8,1.4242e+01_r8, & + &1.7080e+01_r8,1.9888e+01_r8,2.2798e+01_r8/) + kao(:, 4, 7,14) = (/ & + &2.1765e-01_r8,3.0257e+00_r8,6.0505e+00_r8,9.0745e+00_r8,1.2096e+01_r8,1.5115e+01_r8, & + &1.8125e+01_r8,2.1099e+01_r8,2.4193e+01_r8/) + kao(:, 5, 7,14) = (/ & + &2.1725e-01_r8,3.2088e+00_r8,6.4163e+00_r8,9.6232e+00_r8,1.2829e+01_r8,1.6028e+01_r8, & + &1.9219e+01_r8,2.2369e+01_r8,2.5657e+01_r8/) + kao(:, 1, 8,14) = (/ & + &5.5719e-01_r8,2.4793e+00_r8,4.9583e+00_r8,7.4367e+00_r8,9.9152e+00_r8,1.2393e+01_r8, & + &1.4868e+01_r8,1.7332e+01_r8,1.9830e+01_r8/) + kao(:, 2, 8,14) = (/ & + &5.6059e-01_r8,2.7128e+00_r8,5.4248e+00_r8,8.1366e+00_r8,1.0849e+01_r8,1.3560e+01_r8, & + &1.6268e+01_r8,1.8965e+01_r8,2.1697e+01_r8/) + kao(:, 3, 8,14) = (/ & + &5.6435e-01_r8,2.9177e+00_r8,5.8349e+00_r8,8.7514e+00_r8,1.1668e+01_r8,1.4583e+01_r8, & + &1.7497e+01_r8,2.0397e+01_r8,2.3335e+01_r8/) + kao(:, 4, 8,14) = (/ & + &5.6354e-01_r8,3.1161e+00_r8,6.2315e+00_r8,9.3470e+00_r8,1.2462e+01_r8,1.5576e+01_r8, & + &1.8684e+01_r8,2.1779e+01_r8,2.4923e+01_r8/) + kao(:, 5, 8,14) = (/ & + &5.6160e-01_r8,3.3171e+00_r8,6.6335e+00_r8,9.9496e+00_r8,1.3266e+01_r8,1.6580e+01_r8, & + &1.9888e+01_r8,2.3183e+01_r8,2.6532e+01_r8/) + kao(:, 1, 9,14) = (/ & + &2.7023e+00_r8,3.1133e+00_r8,4.9392e+00_r8,7.4089e+00_r8,9.8776e+00_r8,1.2348e+01_r8, & + &1.4816e+01_r8,1.7282e+01_r8,1.9755e+01_r8/) + kao(:, 2, 9,14) = (/ & + &2.7329e+00_r8,3.1899e+00_r8,5.4498e+00_r8,8.1745e+00_r8,1.0899e+01_r8,1.3624e+01_r8, & + &1.6348e+01_r8,1.9070e+01_r8,2.1798e+01_r8/) + kao(:, 3, 9,14) = (/ & + &2.7414e+00_r8,3.2928e+00_r8,5.9087e+00_r8,8.8629e+00_r8,1.1816e+01_r8,1.4770e+01_r8, & + &1.7722e+01_r8,2.0675e+01_r8,2.3632e+01_r8/) + kao(:, 4, 9,14) = (/ & + &2.7386e+00_r8,3.4095e+00_r8,6.3408e+00_r8,9.5112e+00_r8,1.2680e+01_r8,1.5850e+01_r8, & + &1.9019e+01_r8,2.2186e+01_r8,2.5359e+01_r8/) + kao(:, 5, 9,14) = (/ & + &2.7253e+00_r8,3.5556e+00_r8,6.7742e+00_r8,1.0160e+01_r8,1.3547e+01_r8,1.6934e+01_r8, & + &2.0319e+01_r8,2.3701e+01_r8,2.7094e+01_r8/) + kao(:, 1,10,14) = (/ & + &1.4620e+01_r8,1.3012e+01_r8,1.2093e+01_r8,1.1252e+01_r8,1.0888e+01_r8,1.2263e+01_r8, & + &1.4693e+01_r8,1.7142e+01_r8,1.9590e+01_r8/) + kao(:, 2,10,14) = (/ & + &1.4753e+01_r8,1.3186e+01_r8,1.2290e+01_r8,1.1490e+01_r8,1.1589e+01_r8,1.3604e+01_r8, & + &1.6324e+01_r8,1.9044e+01_r8,2.1765e+01_r8/) + kao(:, 3,10,14) = (/ & + &1.4775e+01_r8,1.3219e+01_r8,1.2416e+01_r8,1.1687e+01_r8,1.2328e+01_r8,1.4817e+01_r8, & + &1.7779e+01_r8,2.0743e+01_r8,2.3705e+01_r8/) + kao(:, 4,10,14) = (/ & + &1.4749e+01_r8,1.3203e+01_r8,1.2546e+01_r8,1.1974e+01_r8,1.3088e+01_r8,1.5981e+01_r8, & + &1.9178e+01_r8,2.2373e+01_r8,2.5570e+01_r8/) + kao(:, 5,10,14) = (/ & + &1.4700e+01_r8,1.3186e+01_r8,1.2659e+01_r8,1.2331e+01_r8,1.3931e+01_r8,1.7138e+01_r8, & + &2.0565e+01_r8,2.3991e+01_r8,2.7418e+01_r8/) + kao(:, 1,11,14) = (/ & + &2.7410e+01_r8,2.3992e+01_r8,2.1335e+01_r8,1.9158e+01_r8,1.6847e+01_r8,1.4928e+01_r8, & + &1.5265e+01_r8,1.7677e+01_r8,2.0202e+01_r8/) + kao(:, 2,11,14) = (/ & + &2.7494e+01_r8,2.4097e+01_r8,2.1553e+01_r8,1.9434e+01_r8,1.7307e+01_r8,1.5809e+01_r8, & + &1.6793e+01_r8,1.9551e+01_r8,2.2343e+01_r8/) + kao(:, 3,11,14) = (/ & + &2.7540e+01_r8,2.4181e+01_r8,2.1730e+01_r8,1.9742e+01_r8,1.7701e+01_r8,1.6732e+01_r8, & + &1.8269e+01_r8,2.1306e+01_r8,2.4350e+01_r8/) + kao(:, 4,11,14) = (/ & + &2.7514e+01_r8,2.4204e+01_r8,2.1897e+01_r8,2.0034e+01_r8,1.8171e+01_r8,1.7696e+01_r8, & + &1.9766e+01_r8,2.3053e+01_r8,2.6341e+01_r8/) + kao(:, 5,11,14) = (/ & + &2.7458e+01_r8,2.4204e+01_r8,2.2040e+01_r8,2.0324e+01_r8,1.8730e+01_r8,1.8750e+01_r8, & + &2.1236e+01_r8,2.4764e+01_r8,2.8296e+01_r8/) + kao(:, 1,12,14) = (/ & + &3.7739e+01_r8,3.3022e+01_r8,2.9081e+01_r8,2.5731e+01_r8,2.2384e+01_r8,1.9192e+01_r8, & + &1.6882e+01_r8,1.7924e+01_r8,2.0483e+01_r8/) + kao(:, 2,12,14) = (/ & + &3.7888e+01_r8,3.3157e+01_r8,2.9316e+01_r8,2.6118e+01_r8,2.2987e+01_r8,1.9918e+01_r8, & + &1.8210e+01_r8,1.9805e+01_r8,2.2631e+01_r8/) + kao(:, 3,12,14) = (/ & + &3.7945e+01_r8,3.3236e+01_r8,2.9563e+01_r8,2.6509e+01_r8,2.3567e+01_r8,2.0714e+01_r8, & + &1.9521e+01_r8,2.1672e+01_r8,2.4760e+01_r8/) + kao(:, 4,12,14) = (/ & + &3.7956e+01_r8,3.3289e+01_r8,2.9765e+01_r8,2.6932e+01_r8,2.4108e+01_r8,2.1541e+01_r8, & + &2.0877e+01_r8,2.3478e+01_r8,2.6821e+01_r8/) + kao(:, 5,12,14) = (/ & + &3.7967e+01_r8,3.3331e+01_r8,2.9953e+01_r8,2.7347e+01_r8,2.4651e+01_r8,2.2457e+01_r8, & + &2.2265e+01_r8,2.5248e+01_r8,2.8840e+01_r8/) + kao(:, 1,13,14) = (/ & + &4.1396e+01_r8,3.6239e+01_r8,3.2059e+01_r8,2.8493e+01_r8,2.4944e+01_r8,2.1585e+01_r8, & + &1.8204e+01_r8,1.7791e+01_r8,2.0316e+01_r8/) + kao(:, 2,13,14) = (/ & + &4.1543e+01_r8,3.6421e+01_r8,3.2427e+01_r8,2.9033e+01_r8,2.5736e+01_r8,2.2468e+01_r8, & + &1.9493e+01_r8,1.9781e+01_r8,2.2598e+01_r8/) + kao(:, 3,13,14) = (/ & + &4.1678e+01_r8,3.6592e+01_r8,3.2739e+01_r8,2.9584e+01_r8,2.6500e+01_r8,2.3336e+01_r8, & + &2.0749e+01_r8,2.1701e+01_r8,2.4790e+01_r8/) + kao(:, 4,13,14) = (/ & + &4.1767e+01_r8,3.6719e+01_r8,3.3041e+01_r8,3.0106e+01_r8,2.7204e+01_r8,2.4205e+01_r8, & + &2.2086e+01_r8,2.3604e+01_r8,2.6962e+01_r8/) + kao(:, 5,13,14) = (/ & + &4.1856e+01_r8,3.6841e+01_r8,3.3340e+01_r8,3.0667e+01_r8,2.7878e+01_r8,2.5159e+01_r8, & + &2.3471e+01_r8,2.5553e+01_r8,2.9188e+01_r8/) + kao(:, 1, 1,15) = (/ & + &4.1661e-03_r8,3.0613e+00_r8,6.0764e+00_r8,9.0246e+00_r8,1.1861e+01_r8,1.4480e+01_r8, & + &1.6622e+01_r8,1.7284e+01_r8,2.3722e+01_r8/) + kao(:, 2, 1,15) = (/ & + &4.0148e-03_r8,3.1418e+00_r8,6.2320e+00_r8,9.2486e+00_r8,1.2140e+01_r8,1.4819e+01_r8, & + &1.7035e+01_r8,1.7764e+01_r8,2.4279e+01_r8/) + kao(:, 3, 1,15) = (/ & + &3.8658e-03_r8,3.2144e+00_r8,6.3745e+00_r8,9.4527e+00_r8,1.2398e+01_r8,1.5111e+01_r8, & + &1.7346e+01_r8,1.8143e+01_r8,2.4796e+01_r8/) + kao(:, 4, 1,15) = (/ & + &3.7196e-03_r8,3.2826e+00_r8,6.5071e+00_r8,9.6422e+00_r8,1.2633e+01_r8,1.5374e+01_r8, & + &1.7599e+01_r8,1.8433e+01_r8,2.5267e+01_r8/) + kao(:, 5, 1,15) = (/ & + &3.5761e-03_r8,3.3515e+00_r8,6.6395e+00_r8,9.8324e+00_r8,1.2873e+01_r8,1.5639e+01_r8, & + &1.7844e+01_r8,1.8646e+01_r8,2.5747e+01_r8/) + kao(:, 1, 2,15) = (/ & + &6.8577e-03_r8,3.3744e+00_r8,6.7125e+00_r8,9.9952e+00_r8,1.3184e+01_r8,1.6201e+01_r8, & + &1.8839e+01_r8,2.0375e+01_r8,2.6368e+01_r8/) + kao(:, 2, 2,15) = (/ & + &6.5948e-03_r8,3.4888e+00_r8,6.9393e+00_r8,1.0331e+01_r8,1.3623e+01_r8,1.6730e+01_r8, & + &1.9423e+01_r8,2.0902e+01_r8,2.7246e+01_r8/) + kao(:, 3, 2,15) = (/ & + &6.3372e-03_r8,3.5940e+00_r8,7.1483e+00_r8,1.0636e+01_r8,1.4019e+01_r8,1.7199e+01_r8, & + &1.9946e+01_r8,2.1371e+01_r8,2.8038e+01_r8/) + kao(:, 4, 2,15) = (/ & + &6.0860e-03_r8,3.6975e+00_r8,7.3505e+00_r8,1.0936e+01_r8,1.4402e+01_r8,1.7655e+01_r8, & + &2.0430e+01_r8,2.1802e+01_r8,2.8803e+01_r8/) + kao(:, 5, 2,15) = (/ & + &5.8418e-03_r8,3.7949e+00_r8,7.5419e+00_r8,1.1217e+01_r8,1.4770e+01_r8,1.8090e+01_r8, & + &2.0913e+01_r8,2.2203e+01_r8,2.9539e+01_r8/) + kao(:, 1, 3,15) = (/ & + &1.5312e-02_r8,3.7161e+00_r8,7.4117e+00_r8,1.1074e+01_r8,1.4677e+01_r8,1.8180e+01_r8, & + &2.1427e+01_r8,2.3812e+01_r8,2.9355e+01_r8/) + kao(:, 2, 3,15) = (/ & + &1.4697e-02_r8,3.8703e+00_r8,7.7181e+00_r8,1.1532e+01_r8,1.5288e+01_r8,1.8926e+01_r8, & + &2.2293e+01_r8,2.4742e+01_r8,3.0575e+01_r8/) + kao(:, 3, 3,15) = (/ & + &1.4095e-02_r8,4.0069e+00_r8,7.9901e+00_r8,1.1939e+01_r8,1.5823e+01_r8,1.9587e+01_r8, & + &2.3063e+01_r8,2.5568e+01_r8,3.1646e+01_r8/) + kao(:, 4, 3,15) = (/ & + &1.3512e-02_r8,4.1402e+00_r8,8.2563e+00_r8,1.2333e+01_r8,1.6342e+01_r8,2.0226e+01_r8, & + &2.3806e+01_r8,2.6351e+01_r8,3.2684e+01_r8/) + kao(:, 5, 3,15) = (/ & + &1.2949e-02_r8,4.2659e+00_r8,8.5058e+00_r8,1.2707e+01_r8,1.6836e+01_r8,2.0833e+01_r8, & + &2.4517e+01_r8,2.7109e+01_r8,3.3673e+01_r8/) + kao(:, 1, 4,15) = (/ & + &3.5017e-02_r8,4.0833e+00_r8,8.1553e+00_r8,1.2211e+01_r8,1.6236e+01_r8,2.0204e+01_r8, & + &2.4024e+01_r8,2.7316e+01_r8,3.2472e+01_r8/) + kao(:, 2, 4,15) = (/ & + &3.3537e-02_r8,4.2828e+00_r8,8.5541e+00_r8,1.2808e+01_r8,1.7029e+01_r8,2.1189e+01_r8, & + &2.5196e+01_r8,2.8637e+01_r8,3.4057e+01_r8/) + kao(:, 3, 4,15) = (/ & + &3.2113e-02_r8,4.4600e+00_r8,8.9081e+00_r8,1.3336e+01_r8,1.7733e+01_r8,2.2059e+01_r8, & + &2.6228e+01_r8,2.9796e+01_r8,3.5465e+01_r8/) + kao(:, 4, 4,15) = (/ & + &3.0746e-02_r8,4.6307e+00_r8,9.2473e+00_r8,1.3839e+01_r8,1.8403e+01_r8,2.2892e+01_r8, & + &2.7214e+01_r8,3.0894e+01_r8,3.6805e+01_r8/) + kao(:, 5, 4,15) = (/ & + &2.9433e-02_r8,4.7874e+00_r8,9.5611e+00_r8,1.4314e+01_r8,1.9029e+01_r8,2.3669e+01_r8, & + &2.8132e+01_r8,3.1929e+01_r8,3.8057e+01_r8/) + kao(:, 1, 5,15) = (/ & + &7.3896e-02_r8,4.4639e+00_r8,8.9220e+00_r8,1.3370e+01_r8,1.7804e+01_r8,2.2204e+01_r8, & + &2.6523e+01_r8,3.0537e+01_r8,3.5608e+01_r8/) + kao(:, 2, 5,15) = (/ & + &7.0692e-02_r8,4.7138e+00_r8,9.4187e+00_r8,1.4116e+01_r8,1.8797e+01_r8,2.3443e+01_r8, & + &2.8005e+01_r8,3.2244e+01_r8,3.7595e+01_r8/) + kao(:, 3, 5,15) = (/ & + &6.7622e-02_r8,4.9383e+00_r8,9.8707e+00_r8,1.4791e+01_r8,1.9696e+01_r8,2.4560e+01_r8, & + &2.9335e+01_r8,3.3760e+01_r8,3.9391e+01_r8/) + kao(:, 4, 5,15) = (/ & + &6.4677e-02_r8,5.1515e+00_r8,1.0296e+01_r8,1.5428e+01_r8,2.0542e+01_r8,2.5616e+01_r8, & + &3.0597e+01_r8,3.5203e+01_r8,4.1084e+01_r8/) + kao(:, 5, 5,15) = (/ & + &6.1858e-02_r8,5.3461e+00_r8,1.0685e+01_r8,1.6012e+01_r8,2.1318e+01_r8,2.6583e+01_r8, & + &3.1750e+01_r8,3.6527e+01_r8,4.2635e+01_r8/) + kao(:, 1, 6,15) = (/ & + &1.4684e-01_r8,4.8264e+00_r8,9.6500e+00_r8,1.4468e+01_r8,1.9279e+01_r8,2.4068e+01_r8, & + &2.8816e+01_r8,3.3389e+01_r8,3.8558e+01_r8/) + kao(:, 2, 6,15) = (/ & + &1.4028e-01_r8,5.1303e+00_r8,1.0258e+01_r8,1.5380e+01_r8,2.0490e+01_r8,2.5585e+01_r8, & + &3.0631e+01_r8,3.5492e+01_r8,4.0980e+01_r8/) + kao(:, 3, 6,15) = (/ & + &1.3401e-01_r8,5.4150e+00_r8,1.0825e+01_r8,1.6231e+01_r8,2.1624e+01_r8,2.7001e+01_r8, & + &3.2322e+01_r8,3.7445e+01_r8,4.3249e+01_r8/) + kao(:, 4, 6,15) = (/ & + &1.2806e-01_r8,5.6771e+00_r8,1.1351e+01_r8,1.7018e+01_r8,2.2674e+01_r8,2.8310e+01_r8, & + &3.3887e+01_r8,3.9255e+01_r8,4.5348e+01_r8/) + kao(:, 5, 6,15) = (/ & + &1.2235e-01_r8,5.9138e+00_r8,1.1824e+01_r8,1.7725e+01_r8,2.3617e+01_r8,2.9485e+01_r8, & + &3.5301e+01_r8,4.0890e+01_r8,4.7234e+01_r8/) + kao(:, 1, 7,15) = (/ & + &3.0725e-01_r8,5.1535e+00_r8,1.0306e+01_r8,1.5454e+01_r8,2.0602e+01_r8,2.5736e+01_r8, & + &3.0848e+01_r8,3.5878e+01_r8,4.1204e+01_r8/) + kao(:, 2, 7,15) = (/ & + &2.9321e-01_r8,5.5259e+00_r8,1.1050e+01_r8,1.6570e+01_r8,2.2088e+01_r8,2.7592e+01_r8, & + &3.3073e+01_r8,3.8464e+01_r8,4.4176e+01_r8/) + kao(:, 3, 7,15) = (/ & + &2.7993e-01_r8,5.8735e+00_r8,1.1744e+01_r8,1.7612e+01_r8,2.3476e+01_r8,2.9329e+01_r8, & + &3.5155e+01_r8,4.0875e+01_r8,4.6953e+01_r8/) + kao(:, 4, 7,15) = (/ & + &2.6791e-01_r8,6.1876e+00_r8,1.2373e+01_r8,1.8557e+01_r8,2.4734e+01_r8,3.0898e+01_r8, & + &3.7039e+01_r8,4.3070e+01_r8,4.9468e+01_r8/) + kao(:, 5, 7,15) = (/ & + &2.5886e-01_r8,6.4685e+00_r8,1.2934e+01_r8,1.9398e+01_r8,2.5854e+01_r8,3.2302e+01_r8, & + &3.8716e+01_r8,4.5022e+01_r8,5.1708e+01_r8/) + kao(:, 1, 8,15) = (/ & + &7.7279e-01_r8,5.4596e+00_r8,1.0918e+01_r8,1.6376e+01_r8,2.1832e+01_r8,2.7286e+01_r8, & + &3.2729e+01_r8,3.8130e+01_r8,4.3663e+01_r8/) + kao(:, 2, 8,15) = (/ & + &7.3823e-01_r8,5.9033e+00_r8,1.1807e+01_r8,1.7707e+01_r8,2.3607e+01_r8,2.9503e+01_r8, & + &3.5387e+01_r8,4.1229e+01_r8,4.7214e+01_r8/) + kao(:, 3, 8,15) = (/ & + &7.0825e-01_r8,6.3158e+00_r8,1.2632e+01_r8,1.8945e+01_r8,2.5259e+01_r8,3.1562e+01_r8, & + &3.7862e+01_r8,4.4105e+01_r8,5.0517e+01_r8/) + kao(:, 4, 8,15) = (/ & + &6.8827e-01_r8,6.6883e+00_r8,1.3376e+01_r8,2.0062e+01_r8,2.6743e+01_r8,3.3422e+01_r8, & + &4.0088e+01_r8,4.6704e+01_r8,5.3485e+01_r8/) + kao(:, 5, 8,15) = (/ & + &6.7674e-01_r8,7.0269e+00_r8,1.4054e+01_r8,2.1077e+01_r8,2.8099e+01_r8,3.5115e+01_r8, & + &4.2117e+01_r8,4.9067e+01_r8,5.6197e+01_r8/) + kao(:, 1, 9,15) = (/ & + &3.6929e+00_r8,5.7245e+00_r8,1.1448e+01_r8,1.7170e+01_r8,2.2894e+01_r8,2.8616e+01_r8, & + &3.4335e+01_r8,4.0048e+01_r8,4.5789e+01_r8/) + kao(:, 2, 9,15) = (/ & + &3.5483e+00_r8,6.2547e+00_r8,1.2509e+01_r8,1.8761e+01_r8,2.5016e+01_r8,3.1268e+01_r8, & + &3.7517e+01_r8,4.3757e+01_r8,5.0032e+01_r8/) + kao(:, 3, 9,15) = (/ & + &3.4652e+00_r8,6.7430e+00_r8,1.3484e+01_r8,2.0224e+01_r8,2.6965e+01_r8,3.3705e+01_r8, & + &4.0443e+01_r8,4.7167e+01_r8,5.3930e+01_r8/) + kao(:, 4, 9,15) = (/ & + &3.4260e+00_r8,7.1974e+00_r8,1.4393e+01_r8,2.1588e+01_r8,2.8784e+01_r8,3.5977e+01_r8, & + &4.3167e+01_r8,5.0348e+01_r8,5.7567e+01_r8/) + kao(:, 5, 9,15) = (/ & + &3.4123e+00_r8,7.6134e+00_r8,1.5225e+01_r8,2.2838e+01_r8,3.0451e+01_r8,3.8059e+01_r8, & + &4.5665e+01_r8,5.3256e+01_r8,6.0901e+01_r8/) + kao(:, 1,10,15) = (/ & + &1.9879e+01_r8,1.7395e+01_r8,1.5929e+01_r8,1.8251e+01_r8,2.3917e+01_r8,2.9895e+01_r8, & + &3.5873e+01_r8,4.1851e+01_r8,4.7831e+01_r8/) + kao(:, 2,10,15) = (/ & + &1.9461e+01_r8,1.7089e+01_r8,1.6077e+01_r8,1.9823e+01_r8,2.6409e+01_r8,3.3015e+01_r8, & + &3.9616e+01_r8,4.6210e+01_r8,5.2815e+01_r8/) + kao(:, 3,10,15) = (/ & + &1.9336e+01_r8,1.7101e+01_r8,1.6570e+01_r8,2.1574e+01_r8,2.8765e+01_r8,3.5957e+01_r8, & + &4.3144e+01_r8,5.0330e+01_r8,5.7526e+01_r8/) + kao(:, 4,10,15) = (/ & + &1.9333e+01_r8,1.7178e+01_r8,1.7183e+01_r8,2.3203e+01_r8,3.0928e+01_r8,3.8662e+01_r8, & + &4.6389e+01_r8,5.4117e+01_r8,6.1850e+01_r8/) + kao(:, 5,10,15) = (/ & + &1.9454e+01_r8,1.7376e+01_r8,1.7879e+01_r8,2.4671e+01_r8,3.2892e+01_r8,4.1116e+01_r8, & + &4.9334e+01_r8,5.7555e+01_r8,6.5778e+01_r8/) + kao(:, 1,11,15) = (/ & + &3.7918e+01_r8,3.3177e+01_r8,2.9050e+01_r8,2.5728e+01_r8,2.6964e+01_r8,3.2638e+01_r8, & + &3.9160e+01_r8,4.5686e+01_r8,5.2215e+01_r8/) + kao(:, 2,11,15) = (/ & + &3.7982e+01_r8,3.3235e+01_r8,2.9190e+01_r8,2.6661e+01_r8,2.9222e+01_r8,3.6220e+01_r8, & + &4.3460e+01_r8,5.0704e+01_r8,5.7949e+01_r8/) + kao(:, 3,11,15) = (/ & + &3.8191e+01_r8,3.3419e+01_r8,2.9491e+01_r8,2.7784e+01_r8,3.1731e+01_r8,3.9527e+01_r8, & + &4.7423e+01_r8,5.5330e+01_r8,6.3238e+01_r8/) + kao(:, 4,11,15) = (/ & + &3.8572e+01_r8,3.3751e+01_r8,2.9960e+01_r8,2.8966e+01_r8,3.4093e+01_r8,4.2514e+01_r8, & + &5.1014e+01_r8,5.9516e+01_r8,6.8017e+01_r8/) + kao(:, 5,11,15) = (/ & + &3.9093e+01_r8,3.4206e+01_r8,3.0547e+01_r8,3.0263e+01_r8,3.6228e+01_r8,4.5245e+01_r8, & + &5.4290e+01_r8,6.3320e+01_r8,7.2371e+01_r8/) + kao(:, 1,12,15) = (/ & + &5.5475e+01_r8,4.8541e+01_r8,4.2038e+01_r8,3.6129e+01_r8,3.3332e+01_r8,3.5714e+01_r8, & + &4.2669e+01_r8,4.9771e+01_r8,5.6891e+01_r8/) + kao(:, 2,12,15) = (/ & + &5.6059e+01_r8,4.9052e+01_r8,4.2754e+01_r8,3.7078e+01_r8,3.5375e+01_r8,3.9558e+01_r8, & + &4.7442e+01_r8,5.5347e+01_r8,6.3258e+01_r8/) + kao(:, 3,12,15) = (/ & + &5.6760e+01_r8,4.9664e+01_r8,4.3494e+01_r8,3.8346e+01_r8,3.7575e+01_r8,4.3186e+01_r8, & + &5.1821e+01_r8,6.0453e+01_r8,6.9095e+01_r8/) + kao(:, 4,12,15) = (/ & + &5.7648e+01_r8,5.0443e+01_r8,4.4349e+01_r8,3.9649e+01_r8,3.9898e+01_r8,4.6561e+01_r8, & + &5.5869e+01_r8,6.5177e+01_r8,7.4491e+01_r8/) + kao(:, 5,12,15) = (/ & + &5.8564e+01_r8,5.1244e+01_r8,4.5202e+01_r8,4.0926e+01_r8,4.2120e+01_r8,4.9601e+01_r8, & + &5.9519e+01_r8,6.9433e+01_r8,7.9355e+01_r8/) + kao(:, 1,13,15) = (/ & + &6.5843e+01_r8,5.7608e+01_r8,4.9977e+01_r8,4.3124e+01_r8,3.8891e+01_r8,3.9628e+01_r8, & + &4.6579e+01_r8,5.4339e+01_r8,6.2102e+01_r8/) + kao(:, 2,13,15) = (/ & + &6.6934e+01_r8,5.8564e+01_r8,5.1105e+01_r8,4.4471e+01_r8,4.1117e+01_r8,4.3582e+01_r8, & + &5.1721e+01_r8,6.0334e+01_r8,6.8958e+01_r8/) + kao(:, 3,13,15) = (/ & + &6.8030e+01_r8,5.9532e+01_r8,5.2179e+01_r8,4.5978e+01_r8,4.3480e+01_r8,4.7374e+01_r8, & + &5.6498e+01_r8,6.5896e+01_r8,7.5328e+01_r8/) + kao(:, 4,13,15) = (/ & + &6.9202e+01_r8,6.0551e+01_r8,5.3246e+01_r8,4.7483e+01_r8,4.5884e+01_r8,5.0923e+01_r8, & + &6.0842e+01_r8,7.0980e+01_r8,8.1125e+01_r8/) + kao(:, 5,13,15) = (/ & + &7.0366e+01_r8,6.1567e+01_r8,5.4251e+01_r8,4.8884e+01_r8,4.8138e+01_r8,5.4098e+01_r8, & + &6.4681e+01_r8,7.5454e+01_r8,8.6236e+01_r8/) + kao(:, 1, 1,16) = (/ & + &4.2680e-03_r8,4.0094e+00_r8,7.9109e+00_r8,1.1649e+01_r8,1.5123e+01_r8,1.8131e+01_r8, & + &2.0185e+01_r8,1.9759e+01_r8,3.0246e+01_r8/) + kao(:, 2, 1,16) = (/ & + &4.1096e-03_r8,4.1769e+00_r8,8.2411e+00_r8,1.2134e+01_r8,1.5754e+01_r8,1.8883e+01_r8, & + &2.1013e+01_r8,2.0555e+01_r8,3.1509e+01_r8/) + kao(:, 3, 1,16) = (/ & + &3.9552e-03_r8,4.3246e+00_r8,8.5324e+00_r8,1.2562e+01_r8,1.6307e+01_r8,1.9544e+01_r8, & + &2.1743e+01_r8,2.1252e+01_r8,3.2613e+01_r8/) + kao(:, 4, 1,16) = (/ & + &3.8024e-03_r8,4.4537e+00_r8,8.7866e+00_r8,1.2936e+01_r8,1.6790e+01_r8,2.0122e+01_r8, & + &2.2380e+01_r8,2.1858e+01_r8,3.3579e+01_r8/) + kao(:, 5, 1,16) = (/ & + &3.6530e-03_r8,4.5661e+00_r8,9.0077e+00_r8,1.3262e+01_r8,1.7211e+01_r8,2.0624e+01_r8, & + &2.2936e+01_r8,2.2383e+01_r8,3.4420e+01_r8/) + kao(:, 1, 2,16) = (/ & + &7.0518e-03_r8,4.7486e+00_r8,9.4112e+00_r8,1.3945e+01_r8,1.8257e+01_r8,2.2167e+01_r8, & + &2.5197e+01_r8,2.5646e+01_r8,3.6513e+01_r8/) + kao(:, 2, 2,16) = (/ & + &6.7731e-03_r8,4.9653e+00_r8,9.8411e+00_r8,1.4578e+01_r8,1.9087e+01_r8,2.3173e+01_r8, & + &2.6338e+01_r8,2.6795e+01_r8,3.8174e+01_r8/) + kao(:, 3, 2,16) = (/ & + &6.4989e-03_r8,5.1561e+00_r8,1.0219e+01_r8,1.5138e+01_r8,1.9822e+01_r8,2.4059e+01_r8, & + &2.7344e+01_r8,2.7802e+01_r8,3.9644e+01_r8/) + kao(:, 4, 2,16) = (/ & + &6.2358e-03_r8,5.3229e+00_r8,1.0548e+01_r8,1.5628e+01_r8,2.0461e+01_r8,2.4836e+01_r8, & + &2.8225e+01_r8,2.8690e+01_r8,4.0921e+01_r8/) + kao(:, 5, 2,16) = (/ & + &5.9777e-03_r8,5.4686e+00_r8,1.0838e+01_r8,1.6055e+01_r8,2.1017e+01_r8,2.5512e+01_r8, & + &2.8989e+01_r8,2.9460e+01_r8,4.2034e+01_r8/) + kao(:, 1, 3,16) = (/ & + &1.5841e-02_r8,5.5685e+00_r8,1.1089e+01_r8,1.6529e+01_r8,2.1842e+01_r8,2.6900e+01_r8, & + &3.1365e+01_r8,3.3823e+01_r8,4.3684e+01_r8/) + kao(:, 2, 3,16) = (/ & + &1.5180e-02_r8,5.8535e+00_r8,1.1654e+01_r8,1.7376e+01_r8,2.2954e+01_r8,2.8269e+01_r8, & + &3.2966e+01_r8,3.5548e+01_r8,4.5909e+01_r8/) + kao(:, 3, 3,16) = (/ & + &1.4542e-02_r8,6.1037e+00_r8,1.2154e+01_r8,1.8119e+01_r8,2.3939e+01_r8,2.9482e+01_r8, & + &3.4375e+01_r8,3.7061e+01_r8,4.7877e+01_r8/) + kao(:, 4, 3,16) = (/ & + &1.3926e-02_r8,6.3236e+00_r8,1.2592e+01_r8,1.8771e+01_r8,2.4803e+01_r8,3.0545e+01_r8, & + &3.5612e+01_r8,3.8393e+01_r8,4.9606e+01_r8/) + kao(:, 5, 3,16) = (/ & + &1.3332e-02_r8,6.5149e+00_r8,1.2971e+01_r8,1.9341e+01_r8,2.5553e+01_r8,3.1470e+01_r8, & + &3.6691e+01_r8,3.9549e+01_r8,5.1106e+01_r8/) + kao(:, 1, 4,16) = (/ & + &3.6504e-02_r8,6.4847e+00_r8,1.2941e+01_r8,1.9357e+01_r8,2.5697e+01_r8,3.1893e+01_r8, & + &3.7735e+01_r8,4.2276e+01_r8,5.1393e+01_r8/) + kao(:, 2, 4,16) = (/ & + &3.4931e-02_r8,6.8562e+00_r8,1.3684e+01_r8,2.0466e+01_r8,2.7170e+01_r8,3.3719e+01_r8, & + &3.9896e+01_r8,4.4696e+01_r8,5.4340e+01_r8/) + kao(:, 3, 4,16) = (/ & + &3.3404e-02_r8,7.1832e+00_r8,1.4337e+01_r8,2.1441e+01_r8,2.8465e+01_r8,3.5334e+01_r8, & + &4.1803e+01_r8,4.6838e+01_r8,5.6929e+01_r8/) + kao(:, 4, 4,16) = (/ & + &3.1940e-02_r8,7.4729e+00_r8,1.4911e+01_r8,2.2302e+01_r8,2.9607e+01_r8,3.6753e+01_r8, & + &4.3482e+01_r8,4.8710e+01_r8,5.9213e+01_r8/) + kao(:, 5, 4,16) = (/ & + &3.0537e-02_r8,7.7225e+00_r8,1.5413e+01_r8,2.3052e+01_r8,3.0605e+01_r8,3.7982e+01_r8, & + &4.4943e+01_r8,5.0367e+01_r8,6.1209e+01_r8/) + kao(:, 1, 5,16) = (/ & + &7.7459e-02_r8,7.5153e+00_r8,1.5015e+01_r8,2.2490e+01_r8,2.9920e+01_r8,3.7263e+01_r8, & + &4.4388e+01_r8,5.0697e+01_r8,5.9839e+01_r8/) + kao(:, 2, 5,16) = (/ & + &7.3973e-02_r8,7.9956e+00_r8,1.5974e+01_r8,2.3926e+01_r8,3.1831e+01_r8,3.9653e+01_r8, & + &4.7235e+01_r8,5.3936e+01_r8,6.3661e+01_r8/) + kao(:, 3, 5,16) = (/ & + &7.0652e-02_r8,8.4194e+00_r8,1.6824e+01_r8,2.5198e+01_r8,3.3521e+01_r8,4.1754e+01_r8, & + &4.9742e+01_r8,5.6808e+01_r8,6.7041e+01_r8/) + kao(:, 4, 5,16) = (/ & + &6.7486e-02_r8,8.7920e+00_r8,1.7565e+01_r8,2.6310e+01_r8,3.5003e+01_r8,4.3595e+01_r8, & + &5.1933e+01_r8,5.9317e+01_r8,7.0006e+01_r8/) + kao(:, 5, 5,16) = (/ & + &6.4478e-02_r8,9.1159e+00_r8,1.8215e+01_r8,2.7284e+01_r8,3.6299e+01_r8,4.5208e+01_r8, & + &5.3851e+01_r8,6.1525e+01_r8,7.2598e+01_r8/) + kao(:, 1, 6,16) = (/ & + &1.5475e-01_r8,8.6422e+00_r8,1.7275e+01_r8,2.5892e+01_r8,3.4482e+01_r8,4.3028e+01_r8, & + &5.1423e+01_r8,5.9299e+01_r8,6.8964e+01_r8/) + kao(:, 2, 6,16) = (/ & + &1.4760e-01_r8,9.2603e+00_r8,1.8510e+01_r8,2.7740e+01_r8,3.6952e+01_r8,4.6093e+01_r8, & + &5.5105e+01_r8,6.3549e+01_r8,7.3905e+01_r8/) + kao(:, 3, 6,16) = (/ & + &1.4090e-01_r8,9.8052e+00_r8,1.9599e+01_r8,2.9376e+01_r8,3.9123e+01_r8,4.8807e+01_r8, & + &5.8340e+01_r8,6.7288e+01_r8,7.8246e+01_r8/) + kao(:, 4, 6,16) = (/ & + &1.3455e-01_r8,1.0284e+01_r8,2.0553e+01_r8,3.0809e+01_r8,4.1029e+01_r8,5.1188e+01_r8, & + &6.1191e+01_r8,7.0573e+01_r8,8.2057e+01_r8/) + kao(:, 5, 6,16) = (/ & + &1.2855e-01_r8,1.0696e+01_r8,2.1381e+01_r8,3.2059e+01_r8,4.2695e+01_r8,5.3257e+01_r8, & + &6.3651e+01_r8,7.3440e+01_r8,8.5390e+01_r8/) + kao(:, 1, 7,16) = (/ & + &3.2765e-01_r8,9.8708e+00_r8,1.9738e+01_r8,2.9598e+01_r8,3.9436e+01_r8,4.9244e+01_r8, & + &5.8981e+01_r8,6.8395e+01_r8,7.8872e+01_r8/) + kao(:, 2, 7,16) = (/ & + &3.1237e-01_r8,1.0655e+01_r8,2.1308e+01_r8,3.1948e+01_r8,4.2573e+01_r8,5.3154e+01_r8, & + &6.3663e+01_r8,7.3848e+01_r8,8.5146e+01_r8/) + kao(:, 3, 7,16) = (/ & + &2.9817e-01_r8,1.1348e+01_r8,2.2690e+01_r8,3.4027e+01_r8,4.5330e+01_r8,5.6613e+01_r8, & + &6.7816e+01_r8,7.8654e+01_r8,9.0660e+01_r8/) + kao(:, 4, 7,16) = (/ & + &2.8488e-01_r8,1.1956e+01_r8,2.3907e+01_r8,3.5845e+01_r8,4.7755e+01_r8,5.9649e+01_r8, & + &7.1415e+01_r8,8.2866e+01_r8,9.5510e+01_r8/) + kao(:, 5, 7,16) = (/ & + &2.7283e-01_r8,1.2480e+01_r8,2.4950e+01_r8,3.7415e+01_r8,4.9097e+01_r8,6.2266e+01_r8, & + &7.4578e+01_r8,8.6491e+01_r8,9.9702e+01_r8/) + kao(:, 1, 8,16) = (/ & + &8.3606e-01_r8,1.1195e+01_r8,2.2388e+01_r8,3.3574e+01_r8,4.4755e+01_r8,5.5920e+01_r8, & + &6.7048e+01_r8,7.8029e+01_r8,8.9508e+01_r8/) + kao(:, 2, 8,16) = (/ & + &7.9798e-01_r8,1.2177e+01_r8,2.4351e+01_r8,3.6522e+01_r8,4.8685e+01_r8,6.0830e+01_r8, & + &7.2963e+01_r8,8.4892e+01_r8,9.7369e+01_r8/) + kao(:, 3, 8,16) = (/ & + &7.6304e-01_r8,1.3047e+01_r8,2.6090e+01_r8,3.9130e+01_r8,5.2156e+01_r8,6.5163e+01_r8, & + &7.8140e+01_r8,9.0945e+01_r8,1.0431e+02_r8/) + kao(:, 4, 8,16) = (/ & + &7.3296e-01_r8,1.3800e+01_r8,2.7601e+01_r8,4.1393e+01_r8,5.5174e+01_r8,6.8947e+01_r8, & + &8.2670e+01_r8,9.6216e+01_r8,1.1035e+02_r8/) + kao(:, 5, 8,16) = (/ & + &7.2250e-01_r8,1.4453e+01_r8,2.8899e+01_r8,4.3348e+01_r8,5.7784e+01_r8,7.2193e+01_r8, & + &8.6582e+01_r8,1.0076e+02_r8,1.1557e+02_r8/) + kao(:, 1, 9,16) = (/ & + &4.0611e+00_r8,1.2573e+01_r8,2.5149e+01_r8,3.7721e+01_r8,5.0293e+01_r8,6.2854e+01_r8, & + &7.5422e+01_r8,8.7942e+01_r8,1.0059e+02_r8/) + kao(:, 2, 9,16) = (/ & + &3.8919e+00_r8,1.3793e+01_r8,2.7583e+01_r8,4.1373e+01_r8,5.5157e+01_r8,6.8943e+01_r8, & + &8.2722e+01_r8,9.6458e+01_r8,1.1031e+02_r8/) + kao(:, 3, 9,16) = (/ & + &3.7505e+00_r8,1.4863e+01_r8,2.9722e+01_r8,4.4587e+01_r8,5.9447e+01_r8,7.4303e+01_r8, & + &8.9145e+01_r8,1.0395e+02_r8,1.1889e+02_r8/) + kao(:, 4, 9,16) = (/ & + &3.6915e+00_r8,1.5793e+01_r8,3.1587e+01_r8,4.7379e+01_r8,6.3167e+01_r8,7.8955e+01_r8, & + &9.4727e+01_r8,1.1046e+02_r8,1.2634e+02_r8/) + kao(:, 5, 9,16) = (/ & + &3.8118e+00_r8,1.6590e+01_r8,3.3180e+01_r8,4.9767e+01_r8,6.6364e+01_r8,8.2935e+01_r8, & + &9.9506e+01_r8,1.1603e+02_r8,1.3273e+02_r8/) + kao(:, 1,10,16) = (/ & + &2.2252e+01_r8,1.9469e+01_r8,2.8181e+01_r8,4.2271e+01_r8,5.6359e+01_r8,7.0451e+01_r8, & + &8.4538e+01_r8,9.8612e+01_r8,1.1272e+02_r8/) + kao(:, 2,10,16) = (/ & + &2.1525e+01_r8,1.8834e+01_r8,3.1126e+01_r8,4.6690e+01_r8,6.2252e+01_r8,7.7813e+01_r8, & + &9.3373e+01_r8,1.0893e+02_r8,1.2450e+02_r8/) + kao(:, 3,10,16) = (/ & + &2.1146e+01_r8,1.8632e+01_r8,3.3699e+01_r8,5.0550e+01_r8,6.7413e+01_r8,8.4265e+01_r8, & + &1.0112e+02_r8,1.1795e+02_r8,1.3483e+02_r8/) + kao(:, 4,10,16) = (/ & + &2.1709e+01_r8,1.9529e+01_r8,3.5926e+01_r8,5.3893e+01_r8,7.1851e+01_r8,8.9812e+01_r8, & + &1.0777e+02_r8,1.2572e+02_r8,1.4370e+02_r8/) + kao(:, 5,10,16) = (/ & + &2.2565e+01_r8,2.0486e+01_r8,3.7826e+01_r8,5.6738e+01_r8,7.5652e+01_r8,9.4560e+01_r8, & + &1.1347e+02_r8,1.3237e+02_r8,1.5131e+02_r8/) + kao(:, 1,11,16) = (/ & + &4.2772e+01_r8,3.7423e+01_r8,3.4479e+01_r8,4.9359e+01_r8,6.5807e+01_r8,8.2260e+01_r8, & + &9.8714e+01_r8,1.1516e+02_r8,1.3161e+02_r8/) + kao(:, 2,11,16) = (/ & + &4.2480e+01_r8,3.7168e+01_r8,3.6886e+01_r8,5.4309e+01_r8,7.2413e+01_r8,9.0516e+01_r8, & + &1.0859e+02_r8,1.2671e+02_r8,1.4483e+02_r8/) + kao(:, 3,11,16) = (/ & + &4.3695e+01_r8,3.8234e+01_r8,3.9646e+01_r8,5.8582e+01_r8,7.8105e+01_r8,9.7632e+01_r8, & + &1.1715e+02_r8,1.3667e+02_r8,1.5621e+02_r8/) + kao(:, 4,11,16) = (/ & + &4.5497e+01_r8,3.9810e+01_r8,4.2112e+01_r8,6.2236e+01_r8,8.2974e+01_r8,1.0371e+02_r8, & + &1.2447e+02_r8,1.4520e+02_r8,1.6595e+02_r8/) + kao(:, 5,11,16) = (/ & + &4.7319e+01_r8,4.1402e+01_r8,4.4245e+01_r8,6.5288e+01_r8,8.7037e+01_r8,1.0880e+02_r8, & + &1.3053e+02_r8,1.5228e+02_r8,1.7407e+02_r8/) + kao(:, 1,12,16) = (/ & + &6.3760e+01_r8,5.5793e+01_r8,4.7823e+01_r8,5.6928e+01_r8,7.5904e+01_r8,9.4850e+01_r8, & + &1.1385e+02_r8,1.3279e+02_r8,1.5181e+02_r8/) + kao(:, 2,12,16) = (/ & + &6.5427e+01_r8,5.7247e+01_r8,4.9649e+01_r8,6.2349e+01_r8,8.3126e+01_r8,1.0392e+02_r8, & + &1.2469e+02_r8,1.4546e+02_r8,1.6625e+02_r8/) + kao(:, 3,12,16) = (/ & + &6.8202e+01_r8,5.9674e+01_r8,5.2535e+01_r8,6.6975e+01_r8,8.9301e+01_r8,1.1163e+02_r8, & + &1.3393e+02_r8,1.5627e+02_r8,1.7860e+02_r8/) + kao(:, 4,12,16) = (/ & + &7.0922e+01_r8,6.2055e+01_r8,5.5321e+01_r8,7.0905e+01_r8,9.4539e+01_r8,1.1818e+02_r8, & + &1.4181e+02_r8,1.6544e+02_r8,1.8908e+02_r8/) + kao(:, 5,12,16) = (/ & + &7.3649e+01_r8,6.4442e+01_r8,5.7813e+01_r8,7.4307e+01_r8,9.9092e+01_r8,1.2384e+02_r8, & + &1.4863e+02_r8,1.7339e+02_r8,1.9818e+02_r8/) + kao(:, 1,13,16) = (/ & + &7.8782e+01_r8,6.8941e+01_r8,5.9088e+01_r8,6.5861e+01_r8,8.6369e+01_r8,1.0796e+02_r8, & + &1.2954e+02_r8,1.5113e+02_r8,1.7274e+02_r8/) + kao(:, 2,13,16) = (/ & + &8.1731e+01_r8,7.1509e+01_r8,6.1634e+01_r8,7.1635e+01_r8,9.4482e+01_r8,1.1810e+02_r8, & + &1.4170e+02_r8,1.6534e+02_r8,1.8896e+02_r8/) + kao(:, 3,13,16) = (/ & + &8.5240e+01_r8,7.4588e+01_r8,6.4915e+01_r8,7.6648e+01_r8,1.0154e+02_r8,1.2693e+02_r8, & + &1.5232e+02_r8,1.7766e+02_r8,2.0308e+02_r8/) + kao(:, 4,13,16) = (/ & + &8.8622e+01_r8,7.7543e+01_r8,6.7967e+01_r8,8.0867e+01_r8,1.0759e+02_r8,1.3449e+02_r8, & + &1.6139e+02_r8,1.8828e+02_r8,2.1519e+02_r8/) + kao(:, 5,13,16) = (/ & + &9.1737e+01_r8,8.0288e+01_r8,7.0891e+01_r8,8.4742e+01_r8,1.1298e+02_r8,1.4117e+02_r8, & + &1.6939e+02_r8,1.9762e+02_r8,2.2595e+02_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &1.4739e-04_r8,3.1686e-04_r8,8.5973e-04_r8,1.9039e-03_r8,3.1820e-03_r8,3.6596e-03_r8, & + &3.8724e-03_r8,3.6785e-03_r8,3.7141e-03_r8,3.7646e-03_r8,4.2955e-03_r8,4.6343e-03_r8, & + &5.0612e-03_r8,4.0227e-03_r8,4.2966e-03_r8,4.6622e-03_r8/) + forrefo(2,:) = (/ & + &1.9397e-04_r8,3.6322e-04_r8,8.9797e-04_r8,2.1001e-03_r8,3.0307e-03_r8,3.5563e-03_r8, & + &3.8498e-03_r8,3.5741e-03_r8,3.5914e-03_r8,3.7658e-03_r8,3.8895e-03_r8,4.4072e-03_r8, & + &4.7112e-03_r8,4.2230e-03_r8,4.2666e-03_r8,4.6634e-03_r8/) + forrefo(3,:) = (/ & + &3.1506e-04_r8,7.3687e-04_r8,1.9678e-03_r8,2.5531e-03_r8,2.8345e-03_r8,2.7809e-03_r8, & + &2.9124e-03_r8,2.7125e-03_r8,2.6644e-03_r8,2.4907e-03_r8,2.7032e-03_r8,4.0967e-03_r8, & + &4.1971e-03_r8,4.4507e-03_r8,4.2293e-03_r8,4.6633e-03_r8/) + forrefo(4,:) = (/ & + &8.8196e-04_r8,2.1125e-03_r8,2.8042e-03_r8,2.8891e-03_r8,2.4362e-03_r8,1.8733e-03_r8, & + &1.4078e-03_r8,1.1987e-03_r8,1.2808e-03_r8,8.9050e-04_r8,9.4375e-04_r8,7.8351e-04_r8, & + &1.0756e-03_r8,1.6586e-03_r8,1.7511e-03_r8,4.7803e-03_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 2.37879e-02_r8, 2.10719e-02_r8, 1.86660e-02_r8, 1.65348e-02_r8, 1.46469e-02_r8, & + & 1.29746e-02_r8, 1.14932e-02_r8, 1.01810e-02_r8, 9.01858e-03_r8, 7.98888e-03_r8/) + selfrefo(:, 2) = (/ & + & 3.10625e-02_r8, 2.82664e-02_r8, 2.57220e-02_r8, 2.34066e-02_r8, 2.12997e-02_r8, & + & 1.93824e-02_r8, 1.76377e-02_r8, 1.60500e-02_r8, 1.46053e-02_r8, 1.32906e-02_r8/) + selfrefo(:, 3) = (/ & + & 5.19103e-02_r8, 4.80004e-02_r8, 4.43850e-02_r8, 4.10419e-02_r8, 3.79506e-02_r8, & + & 3.50922e-02_r8, 3.24491e-02_r8, 3.00050e-02_r8, 2.77450e-02_r8, 2.56553e-02_r8/) + selfrefo(:, 4) = (/ & + & 9.12444e-02_r8, 8.38675e-02_r8, 7.70870e-02_r8, 7.08547e-02_r8, 6.51263e-02_r8, & + & 5.98610e-02_r8, 5.50214e-02_r8, 5.05730e-02_r8, 4.64843e-02_r8, 4.27262e-02_r8/) + selfrefo(:, 5) = (/ & + & 1.11323e-01_r8, 1.04217e-01_r8, 9.75650e-02_r8, 9.13376e-02_r8, 8.55076e-02_r8, & + & 8.00498e-02_r8, 7.49403e-02_r8, 7.01570e-02_r8, 6.56790e-02_r8, 6.14868e-02_r8/) + selfrefo(:, 6) = (/ & + & 1.25301e-01_r8, 1.16877e-01_r8, 1.09020e-01_r8, 1.01691e-01_r8, 9.48543e-02_r8, & + & 8.84774e-02_r8, 8.25293e-02_r8, 7.69810e-02_r8, 7.18057e-02_r8, 6.69784e-02_r8/) + selfrefo(:, 7) = (/ & + & 1.34063e-01_r8, 1.24662e-01_r8, 1.15920e-01_r8, 1.07791e-01_r8, 1.00232e-01_r8, & + & 9.32035e-02_r8, 8.66676e-02_r8, 8.05900e-02_r8, 7.49386e-02_r8, 6.96836e-02_r8/) + selfrefo(:, 8) = (/ & + & 1.26997e-01_r8, 1.18306e-01_r8, 1.10210e-01_r8, 1.02668e-01_r8, 9.56417e-02_r8, & + & 8.90964e-02_r8, 8.29991e-02_r8, 7.73190e-02_r8, 7.20276e-02_r8, 6.70984e-02_r8/) + selfrefo(:, 9) = (/ & + & 1.28823e-01_r8, 1.20235e-01_r8, 1.12220e-01_r8, 1.04739e-01_r8, 9.77569e-02_r8, & + & 9.12402e-02_r8, 8.51579e-02_r8, 7.94810e-02_r8, 7.41826e-02_r8, 6.92374e-02_r8/) + selfrefo(:,10) = (/ & + & 1.35802e-01_r8, 1.25981e-01_r8, 1.16870e-01_r8, 1.08418e-01_r8, 1.00577e-01_r8, & + & 9.33034e-02_r8, 8.65557e-02_r8, 8.02960e-02_r8, 7.44890e-02_r8, 6.91020e-02_r8/) + selfrefo(:,11) = (/ & + & 1.35475e-01_r8, 1.27572e-01_r8, 1.20130e-01_r8, 1.13122e-01_r8, 1.06523e-01_r8, & + & 1.00309e-01_r8, 9.44573e-02_r8, 8.89470e-02_r8, 8.37582e-02_r8, 7.88721e-02_r8/) + selfrefo(:,12) = (/ & + & 1.51195e-01_r8, 1.41159e-01_r8, 1.31790e-01_r8, 1.23043e-01_r8, 1.14876e-01_r8, & + & 1.07251e-01_r8, 1.00132e-01_r8, 9.34860e-02_r8, 8.72809e-02_r8, 8.14877e-02_r8/) + selfrefo(:,13) = (/ & + & 1.57538e-01_r8, 1.47974e-01_r8, 1.38990e-01_r8, 1.30552e-01_r8, 1.22626e-01_r8, & + & 1.15181e-01_r8, 1.08188e-01_r8, 1.01620e-01_r8, 9.54505e-02_r8, 8.96556e-02_r8/) + selfrefo(:,14) = (/ & + & 1.53567e-01_r8, 1.41564e-01_r8, 1.30500e-01_r8, 1.20300e-01_r8, 1.10898e-01_r8, & + & 1.02231e-01_r8, 9.42406e-02_r8, 8.68750e-02_r8, 8.00851e-02_r8, 7.38259e-02_r8/) + selfrefo(:,15) = (/ & + & 1.53687e-01_r8, 1.42981e-01_r8, 1.33020e-01_r8, 1.23753e-01_r8, 1.15132e-01_r8, & + & 1.07112e-01_r8, 9.96500e-02_r8, 9.27080e-02_r8, 8.62496e-02_r8, 8.02412e-02_r8/) + selfrefo(:,16) = (/ & + & 1.65129e-01_r8, 1.53285e-01_r8, 1.42290e-01_r8, 1.32084e-01_r8, 1.22610e-01_r8, & + & 1.13815e-01_r8, 1.05651e-01_r8, 9.80730e-02_r8, 9.10384e-02_r8, 8.45083e-02_r8/) + + end subroutine lw_kgb12 + +! ************************************************************************** + subroutine lw_kgb13 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg13, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mco, & + kbo_mo3, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K + fracrefao(:, 1) = (/ & + & 1.7534e-01_r8,1.7394e-01_r8,1.6089e-01_r8,1.3782e-01_r8,1.0696e-01_r8,8.5853e-02_r8, & + & 6.6548e-02_r8,4.9053e-02_r8,3.2064e-02_r8,3.4820e-03_r8,2.8763e-03_r8,2.2204e-03_r8, & + & 1.5612e-03_r8,9.8572e-04_r8,3.6853e-04_r8,5.1612e-05_r8/) + fracrefao(:, 2) = (/ & + & 1.7489e-01_r8,1.7309e-01_r8,1.5981e-01_r8,1.3782e-01_r8,1.0797e-01_r8,8.6367e-02_r8, & + & 6.7042e-02_r8,4.9257e-02_r8,3.2207e-02_r8,3.4820e-03_r8,2.8767e-03_r8,2.2203e-03_r8, & + & 1.5613e-03_r8,9.8571e-04_r8,3.6853e-04_r8,5.1612e-05_r8/) + fracrefao(:, 3) = (/ & + & 1.7459e-01_r8,1.7259e-01_r8,1.5948e-01_r8,1.3694e-01_r8,1.0815e-01_r8,8.7376e-02_r8, & + & 6.7339e-02_r8,4.9541e-02_r8,3.2333e-02_r8,3.5019e-03_r8,2.8958e-03_r8,2.2527e-03_r8, & + & 1.6099e-03_r8,9.8574e-04_r8,3.6853e-04_r8,5.1612e-05_r8/) + fracrefao(:, 4) = (/ & + & 1.7391e-01_r8,1.7244e-01_r8,1.5921e-01_r8,1.3644e-01_r8,1.0787e-01_r8,8.7776e-02_r8, & + & 6.8361e-02_r8,4.9628e-02_r8,3.2578e-02_r8,3.5117e-03_r8,2.9064e-03_r8,2.2571e-03_r8, & + & 1.6887e-03_r8,1.0045e-03_r8,3.6853e-04_r8,5.1612e-05_r8/) + fracrefao(:, 5) = (/ & + & 1.7338e-01_r8,1.7157e-01_r8,1.5957e-01_r8,1.3571e-01_r8,1.0773e-01_r8,8.7966e-02_r8, & + & 6.9000e-02_r8,5.0300e-02_r8,3.2813e-02_r8,3.5470e-03_r8,2.9425e-03_r8,2.2552e-03_r8, & + & 1.7038e-03_r8,1.1025e-03_r8,3.6853e-04_r8,5.1612e-05_r8/) + fracrefao(:, 6) = (/ & + & 1.7230e-01_r8,1.7082e-01_r8,1.5917e-01_r8,1.3562e-01_r8,1.0806e-01_r8,8.7635e-02_r8, & + & 6.9815e-02_r8,5.1155e-02_r8,3.3139e-02_r8,3.6264e-03_r8,2.9436e-03_r8,2.3417e-03_r8, & + & 1.7731e-03_r8,1.1156e-03_r8,4.4533e-04_r8,5.1612e-05_r8/) + fracrefao(:, 7) = (/ & + & 1.7073e-01_r8,1.6961e-01_r8,1.5844e-01_r8,1.3594e-01_r8,1.0821e-01_r8,8.7791e-02_r8, & + & 7.0502e-02_r8,5.1904e-02_r8,3.4107e-02_r8,3.5888e-03_r8,2.9574e-03_r8,2.5851e-03_r8, & + & 1.9127e-03_r8,1.1537e-03_r8,4.7789e-04_r8,1.0016e-04_r8/) + fracrefao(:, 8) = (/ & + & 1.6700e-01_r8,1.6848e-01_r8,1.5628e-01_r8,1.3448e-01_r8,1.1011e-01_r8,8.9016e-02_r8, & + & 7.1973e-02_r8,5.2798e-02_r8,3.5650e-02_r8,3.8534e-03_r8,3.4142e-03_r8,2.7799e-03_r8, & + & 2.1288e-03_r8,1.3043e-03_r8,6.2858e-04_r8,1.0016e-04_r8/) + fracrefao(:, 9) = (/ & + & 1.6338e-01_r8,1.5565e-01_r8,1.4470e-01_r8,1.3500e-01_r8,1.1909e-01_r8,9.8312e-02_r8, & + & 7.9023e-02_r8,5.5728e-02_r8,3.6831e-02_r8,3.6569e-03_r8,3.0552e-03_r8,2.3431e-03_r8, & + & 1.7088e-03_r8,1.1082e-03_r8,3.6829e-04_r8,5.1612e-05_r8/) + +! Planck fraction mapping level : P=4.758820 mb, T = 250.85 K + fracrefbo(:) = (/ & + & 1.5411e-01_r8,1.3573e-01_r8,1.2527e-01_r8,1.2698e-01_r8,1.2394e-01_r8,1.0876e-01_r8, & + & 8.9906e-02_r8,6.9551e-02_r8,4.8240e-02_r8,5.2434e-03_r8,4.3630e-03_r8,3.4262e-03_r8, & + & 2.5124e-03_r8,1.5479e-03_r8,3.7294e-04_r8,5.1050e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &6.4065e-07_r8,1.0419e-05_r8,1.7041e-05_r8,2.3341e-05_r8,2.9288e-05_r8,3.6860e-05_r8, & + &5.2289e-05_r8,7.6369e-05_r8,2.2034e-05_r8/) + kao(:, 2, 1, 1) = (/ & + &7.4425e-07_r8,1.2994e-05_r8,2.1634e-05_r8,2.9437e-05_r8,3.6128e-05_r8,4.4577e-05_r8, & + &5.5507e-05_r8,7.3010e-05_r8,3.0368e-05_r8/) + kao(:, 3, 1, 1) = (/ & + &9.1477e-07_r8,1.6195e-05_r8,2.7037e-05_r8,3.6851e-05_r8,4.4956e-05_r8,5.3696e-05_r8, & + &6.5423e-05_r8,7.7959e-05_r8,3.9940e-05_r8/) + kao(:, 4, 1, 1) = (/ & + &1.0920e-06_r8,2.0021e-05_r8,3.3475e-05_r8,4.5528e-05_r8,5.5351e-05_r8,6.4790e-05_r8, & + &7.8460e-05_r8,9.0393e-05_r8,5.1295e-05_r8/) + kao(:, 5, 1, 1) = (/ & + &1.3489e-06_r8,2.4363e-05_r8,4.1025e-05_r8,5.5638e-05_r8,6.7646e-05_r8,7.8828e-05_r8, & + &9.2175e-05_r8,1.0262e-04_r8,6.4740e-05_r8/) + kao(:, 1, 2, 1) = (/ & + &9.4474e-07_r8,9.5739e-06_r8,1.4537e-05_r8,1.9319e-05_r8,2.3955e-05_r8,2.8125e-05_r8, & + &3.4867e-05_r8,5.4010e-05_r8,1.9403e-05_r8/) + kao(:, 2, 2, 1) = (/ & + &1.1323e-06_r8,1.1739e-05_r8,1.8325e-05_r8,2.4542e-05_r8,3.0201e-05_r8,3.5031e-05_r8, & + &4.2528e-05_r8,5.9167e-05_r8,2.5395e-05_r8/) + kao(:, 3, 2, 1) = (/ & + &1.3451e-06_r8,1.4450e-05_r8,2.3075e-05_r8,3.0847e-05_r8,3.7507e-05_r8,4.3224e-05_r8, & + &5.0526e-05_r8,6.6079e-05_r8,3.2769e-05_r8/) + kao(:, 4, 2, 1) = (/ & + &1.6171e-06_r8,1.7819e-05_r8,2.8678e-05_r8,3.8333e-05_r8,4.6715e-05_r8,5.3613e-05_r8, & + &6.0668e-05_r8,7.1518e-05_r8,4.1642e-05_r8/) + kao(:, 5, 2, 1) = (/ & + &1.9441e-06_r8,2.1692e-05_r8,3.5243e-05_r8,4.7173e-05_r8,5.7398e-05_r8,6.5939e-05_r8, & + &7.3567e-05_r8,8.2891e-05_r8,5.2140e-05_r8/) + kao(:, 1, 3, 1) = (/ & + &1.9997e-06_r8,1.0333e-05_r8,1.4351e-05_r8,1.7071e-05_r8,1.9818e-05_r8,2.2671e-05_r8, & + &2.5587e-05_r8,3.3080e-05_r8,2.1440e-05_r8/) + kao(:, 2, 3, 1) = (/ & + &2.2813e-06_r8,1.2534e-05_r8,1.7541e-05_r8,2.1448e-05_r8,2.5145e-05_r8,2.8879e-05_r8, & + &3.1889e-05_r8,3.7831e-05_r8,2.6738e-05_r8/) + kao(:, 3, 3, 1) = (/ & + &2.7401e-06_r8,1.5206e-05_r8,2.1444e-05_r8,2.7039e-05_r8,3.1929e-05_r8,3.6455e-05_r8, & + &3.9620e-05_r8,4.6057e-05_r8,3.1366e-05_r8/) + kao(:, 4, 3, 1) = (/ & + &3.2871e-06_r8,1.8031e-05_r8,2.6416e-05_r8,3.3815e-05_r8,3.9999e-05_r8,4.5410e-05_r8, & + &4.9342e-05_r8,5.4203e-05_r8,3.7064e-05_r8/) + kao(:, 5, 3, 1) = (/ & + &3.8869e-06_r8,2.1455e-05_r8,3.2368e-05_r8,4.1756e-05_r8,4.9581e-05_r8,5.6093e-05_r8, & + &6.1027e-05_r8,6.5117e-05_r8,4.4920e-05_r8/) + kao(:, 1, 4, 1) = (/ & + &4.3610e-06_r8,1.3316e-05_r8,1.6242e-05_r8,1.8257e-05_r8,1.9350e-05_r8,2.0037e-05_r8, & + &2.0833e-05_r8,2.3040e-05_r8,2.2366e-05_r8/) + kao(:, 2, 4, 1) = (/ & + &5.0348e-06_r8,1.5693e-05_r8,1.9649e-05_r8,2.2560e-05_r8,2.3970e-05_r8,2.5222e-05_r8, & + &2.6081e-05_r8,2.7399e-05_r8,2.7623e-05_r8/) + kao(:, 3, 4, 1) = (/ & + &5.7893e-06_r8,1.8717e-05_r8,2.3542e-05_r8,2.7248e-05_r8,2.9677e-05_r8,3.1779e-05_r8, & + &3.2973e-05_r8,3.3876e-05_r8,3.4347e-05_r8/) + kao(:, 4, 4, 1) = (/ & + &6.7700e-06_r8,2.2355e-05_r8,2.8015e-05_r8,3.2751e-05_r8,3.6706e-05_r8,3.9566e-05_r8, & + &4.1488e-05_r8,4.1986e-05_r8,4.0984e-05_r8/) + kao(:, 5, 4, 1) = (/ & + &8.0207e-06_r8,2.6505e-05_r8,3.3421e-05_r8,3.9357e-05_r8,4.5121e-05_r8,4.9003e-05_r8, & + &5.1776e-05_r8,5.2148e-05_r8,4.7085e-05_r8/) + kao(:, 1, 5, 1) = (/ & + &8.6602e-06_r8,1.8553e-05_r8,2.0839e-05_r8,2.1788e-05_r8,2.1544e-05_r8,2.1077e-05_r8, & + &1.9473e-05_r8,1.8495e-05_r8,2.3671e-05_r8/) + kao(:, 2, 5, 1) = (/ & + &9.9810e-06_r8,2.2031e-05_r8,2.4930e-05_r8,2.6247e-05_r8,2.6462e-05_r8,2.6137e-05_r8, & + &2.4415e-05_r8,2.2553e-05_r8,2.8177e-05_r8/) + kao(:, 3, 5, 1) = (/ & + &1.1619e-05_r8,2.6356e-05_r8,2.9247e-05_r8,3.1562e-05_r8,3.1911e-05_r8,3.1801e-05_r8, & + &3.0166e-05_r8,2.7978e-05_r8,3.2481e-05_r8/) + kao(:, 4, 5, 1) = (/ & + &1.3216e-05_r8,3.1104e-05_r8,3.4868e-05_r8,3.7332e-05_r8,3.8497e-05_r8,3.8279e-05_r8, & + &3.7615e-05_r8,3.4834e-05_r8,3.8514e-05_r8/) + kao(:, 5, 5, 1) = (/ & + &1.5414e-05_r8,3.5706e-05_r8,4.1155e-05_r8,4.4051e-05_r8,4.6023e-05_r8,4.6762e-05_r8, & + &4.6430e-05_r8,4.3490e-05_r8,4.6117e-05_r8/) + kao(:, 1, 6, 1) = (/ & + &1.6458e-05_r8,2.5684e-05_r8,2.8012e-05_r8,2.7844e-05_r8,2.6244e-05_r8,2.4237e-05_r8, & + &2.0656e-05_r8,1.6798e-05_r8,2.3796e-05_r8/) + kao(:, 2, 6, 1) = (/ & + &1.8595e-05_r8,3.0385e-05_r8,3.3443e-05_r8,3.3768e-05_r8,3.2056e-05_r8,2.9483e-05_r8, & + &2.5851e-05_r8,2.0866e-05_r8,2.8662e-05_r8/) + kao(:, 3, 6, 1) = (/ & + &2.1348e-05_r8,3.6540e-05_r8,3.9601e-05_r8,3.9640e-05_r8,3.8210e-05_r8,3.5898e-05_r8, & + &3.1968e-05_r8,2.5765e-05_r8,3.3968e-05_r8/) + kao(:, 4, 6, 1) = (/ & + &2.4741e-05_r8,4.2510e-05_r8,4.6979e-05_r8,4.6425e-05_r8,4.6165e-05_r8,4.2824e-05_r8, & + &3.8814e-05_r8,3.1863e-05_r8,3.8072e-05_r8/) + kao(:, 5, 6, 1) = (/ & + &2.8527e-05_r8,5.0183e-05_r8,5.5064e-05_r8,5.5234e-05_r8,5.4182e-05_r8,5.0966e-05_r8, & + &4.6758e-05_r8,3.9447e-05_r8,4.4935e-05_r8/) + kao(:, 1, 7, 1) = (/ & + &3.2476e-05_r8,3.8679e-05_r8,3.9032e-05_r8,3.7741e-05_r8,3.4552e-05_r8,2.9807e-05_r8, & + &2.4164e-05_r8,1.7294e-05_r8,2.4102e-05_r8/) + kao(:, 2, 7, 1) = (/ & + &3.6570e-05_r8,4.6320e-05_r8,4.7537e-05_r8,4.6067e-05_r8,4.2268e-05_r8,3.6503e-05_r8, & + &3.0476e-05_r8,2.2134e-05_r8,2.9448e-05_r8/) + kao(:, 3, 7, 1) = (/ & + &4.1124e-05_r8,5.4270e-05_r8,5.7210e-05_r8,5.5312e-05_r8,5.2106e-05_r8,4.5231e-05_r8, & + &3.7737e-05_r8,2.7811e-05_r8,3.4668e-05_r8/) + kao(:, 4, 7, 1) = (/ & + &4.8133e-05_r8,6.4794e-05_r8,6.7628e-05_r8,6.6254e-05_r8,6.2299e-05_r8,5.4379e-05_r8, & + &4.5931e-05_r8,3.4327e-05_r8,4.1743e-05_r8/) + kao(:, 5, 7, 1) = (/ & + &5.5532e-05_r8,7.7694e-05_r8,8.0423e-05_r8,7.9418e-05_r8,7.2354e-05_r8,6.4221e-05_r8, & + &5.4806e-05_r8,4.1684e-05_r8,4.8759e-05_r8/) + kao(:, 1, 8, 1) = (/ & + &7.4902e-05_r8,7.7106e-05_r8,7.0826e-05_r8,6.4010e-05_r8,5.5968e-05_r8,4.6986e-05_r8, & + &3.6409e-05_r8,2.2524e-05_r8,2.8079e-05_r8/) + kao(:, 2, 8, 1) = (/ & + &8.5067e-05_r8,8.8842e-05_r8,8.3769e-05_r8,7.6787e-05_r8,6.8134e-05_r8,5.7821e-05_r8, & + &4.4557e-05_r8,2.8824e-05_r8,3.6133e-05_r8/) + kao(:, 3, 8, 1) = (/ & + &9.7879e-05_r8,1.0460e-04_r8,9.9884e-05_r8,9.2458e-05_r8,8.3229e-05_r8,7.0097e-05_r8, & + &5.5355e-05_r8,3.6496e-05_r8,4.1979e-05_r8/) + kao(:, 4, 8, 1) = (/ & + &1.1321e-04_r8,1.2375e-04_r8,1.2003e-04_r8,1.1241e-04_r8,1.0088e-04_r8,8.6080e-05_r8, & + &6.8531e-05_r8,4.5034e-05_r8,5.0526e-05_r8/) + kao(:, 5, 8, 1) = (/ & + &1.3142e-04_r8,1.5020e-04_r8,1.4626e-04_r8,1.3653e-04_r8,1.2235e-04_r8,1.0518e-04_r8, & + &8.2469e-05_r8,5.5412e-05_r8,6.0484e-05_r8/) + kao(:, 1, 9, 1) = (/ & + &3.0190e-04_r8,2.8195e-04_r8,2.5208e-04_r8,2.1662e-04_r8,1.7929e-04_r8,1.4025e-04_r8, & + &1.0049e-04_r8,5.8291e-05_r8,3.9381e-05_r8/) + kao(:, 2, 9, 1) = (/ & + &3.5007e-04_r8,3.2966e-04_r8,2.9418e-04_r8,2.5482e-04_r8,2.1206e-04_r8,1.6775e-04_r8, & + &1.2208e-04_r8,7.2618e-05_r8,5.1006e-05_r8/) + kao(:, 3, 9, 1) = (/ & + &4.1355e-04_r8,3.9069e-04_r8,3.5043e-04_r8,3.0530e-04_r8,2.5611e-04_r8,2.0488e-04_r8, & + &1.4964e-04_r8,8.8870e-05_r8,6.5960e-05_r8/) + kao(:, 4, 9, 1) = (/ & + &4.9093e-04_r8,4.6398e-04_r8,4.1726e-04_r8,3.6373e-04_r8,3.0710e-04_r8,2.4775e-04_r8, & + &1.8258e-04_r8,1.0881e-04_r8,8.2307e-05_r8/) + kao(:, 5, 9, 1) = (/ & + &5.8022e-04_r8,5.5027e-04_r8,5.0137e-04_r8,4.3986e-04_r8,3.7225e-04_r8,2.9865e-04_r8, & + &2.2079e-04_r8,1.3406e-04_r8,9.5285e-05_r8/) + kao(:, 1,10, 1) = (/ & + &1.2883e-03_r8,1.1451e-03_r8,9.9720e-04_r8,8.4603e-04_r8,6.8855e-04_r8,5.2856e-04_r8, & + &3.6226e-04_r8,1.9198e-04_r8,7.4637e-05_r8/) + kao(:, 2,10, 1) = (/ & + &1.5104e-03_r8,1.3471e-03_r8,1.1771e-03_r8,9.9916e-04_r8,8.1528e-04_r8,6.2425e-04_r8, & + &4.3021e-04_r8,2.3018e-04_r8,8.8724e-05_r8/) + kao(:, 3,10, 1) = (/ & + &1.8167e-03_r8,1.6260e-03_r8,1.4233e-03_r8,1.2086e-03_r8,9.8644e-04_r8,7.6173e-04_r8, & + &5.2737e-04_r8,2.8610e-04_r8,1.0717e-04_r8/) + kao(:, 4,10, 1) = (/ & + &2.2177e-03_r8,1.9922e-03_r8,1.7424e-03_r8,1.4817e-03_r8,1.2127e-03_r8,9.3691e-04_r8, & + &6.5292e-04_r8,3.5708e-04_r8,1.2411e-04_r8/) + kao(:, 5,10, 1) = (/ & + &2.7210e-03_r8,2.4399e-03_r8,2.1395e-03_r8,1.8137e-03_r8,1.4859e-03_r8,1.1551e-03_r8, & + &8.0975e-04_r8,4.4504e-04_r8,1.4851e-04_r8/) + kao(:, 1,11, 1) = (/ & + &1.9516e-03_r8,1.7255e-03_r8,1.4956e-03_r8,1.2644e-03_r8,1.0251e-03_r8,7.8257e-04_r8, & + &5.3359e-04_r8,2.7877e-04_r8,7.8095e-05_r8/) + kao(:, 2,11, 1) = (/ & + &2.3604e-03_r8,2.0924e-03_r8,1.8171e-03_r8,1.5363e-03_r8,1.2459e-03_r8,9.5100e-04_r8, & + &6.5089e-04_r8,3.4345e-04_r8,9.5842e-05_r8/) + kao(:, 3,11, 1) = (/ & + &2.8804e-03_r8,2.5577e-03_r8,2.2239e-03_r8,1.8797e-03_r8,1.5233e-03_r8,1.1642e-03_r8, & + &8.0020e-04_r8,4.2543e-04_r8,1.1860e-04_r8/) + kao(:, 4,11, 1) = (/ & + &3.5705e-03_r8,3.1731e-03_r8,2.7557e-03_r8,2.3268e-03_r8,1.8893e-03_r8,1.4468e-03_r8, & + &9.9612e-04_r8,5.3416e-04_r8,1.4487e-04_r8/) + kao(:, 5,11, 1) = (/ & + &4.4488e-03_r8,3.9532e-03_r8,3.4428e-03_r8,2.9093e-03_r8,2.3658e-03_r8,1.8156e-03_r8, & + &1.2567e-03_r8,6.7979e-04_r8,1.7247e-04_r8/) + kao(:, 1,12, 1) = (/ & + &2.1650e-03_r8,1.9116e-03_r8,1.6550e-03_r8,1.3963e-03_r8,1.1297e-03_r8,8.5899e-04_r8, & + &5.8509e-04_r8,3.0490e-04_r8,7.1706e-05_r8/) + kao(:, 2,12, 1) = (/ & + &2.6267e-03_r8,2.3248e-03_r8,2.0167e-03_r8,1.7021e-03_r8,1.3758e-03_r8,1.0485e-03_r8, & + &7.1504e-04_r8,3.7456e-04_r8,8.9235e-05_r8/) + kao(:, 3,12, 1) = (/ & + &3.2534e-03_r8,2.8836e-03_r8,2.5027e-03_r8,2.1051e-03_r8,1.7048e-03_r8,1.2988e-03_r8, & + &8.8817e-04_r8,4.6846e-04_r8,1.1111e-04_r8/) + kao(:, 4,12, 1) = (/ & + &4.0663e-03_r8,3.6075e-03_r8,3.1250e-03_r8,2.6309e-03_r8,2.1307e-03_r8,1.6269e-03_r8, & + &1.1159e-03_r8,5.9423e-04_r8,1.3807e-04_r8/) + kao(:, 5,12, 1) = (/ & + &5.1489e-03_r8,4.5663e-03_r8,3.9639e-03_r8,3.3363e-03_r8,2.7011e-03_r8,2.0639e-03_r8, & + &1.4193e-03_r8,7.5878e-04_r8,1.6511e-04_r8/) + kao(:, 1,13, 1) = (/ & + &1.8892e-03_r8,1.6706e-03_r8,1.4468e-03_r8,1.2178e-03_r8,9.8369e-04_r8,7.4837e-04_r8, & + &5.0829e-04_r8,2.6445e-04_r8,6.0347e-05_r8/) + kao(:, 2,13, 1) = (/ & + &2.3493e-03_r8,2.0800e-03_r8,1.8039e-03_r8,1.5176e-03_r8,1.2269e-03_r8,9.3478e-04_r8, & + &6.3614e-04_r8,3.3311e-04_r8,7.4952e-05_r8/) + kao(:, 3,13, 1) = (/ & + &2.9367e-03_r8,2.6050e-03_r8,2.2571e-03_r8,1.8958e-03_r8,1.5337e-03_r8,1.1694e-03_r8, & + &7.9916e-04_r8,4.2184e-04_r8,9.2442e-05_r8/) + kao(:, 4,13, 1) = (/ & + &3.6657e-03_r8,3.2513e-03_r8,2.8158e-03_r8,2.3704e-03_r8,1.9186e-03_r8,1.4653e-03_r8, & + &1.0024e-03_r8,5.3341e-04_r8,1.1484e-04_r8/) + kao(:, 5,13, 1) = (/ & + &4.6760e-03_r8,4.1516e-03_r8,3.5983e-03_r8,3.0289e-03_r8,2.4503e-03_r8,1.8734e-03_r8, & + &1.2888e-03_r8,6.8680e-04_r8,1.3777e-04_r8/) + kao(:, 1, 1, 2) = (/ & + &1.8748e-06_r8,2.5986e-05_r8,3.9140e-05_r8,5.0515e-05_r8,6.0453e-05_r8,7.0222e-05_r8, & + &9.2153e-05_r8,1.1527e-04_r8,4.9863e-05_r8/) + kao(:, 2, 1, 2) = (/ & + &2.2195e-06_r8,3.2877e-05_r8,5.0201e-05_r8,6.4757e-05_r8,7.7459e-05_r8,8.9731e-05_r8, & + &1.0523e-04_r8,1.3275e-04_r8,6.4946e-05_r8/) + kao(:, 3, 1, 2) = (/ & + &2.6699e-06_r8,4.0948e-05_r8,6.3539e-05_r8,8.1241e-05_r8,9.7151e-05_r8,1.1092e-04_r8, & + &1.1761e-04_r8,1.3825e-04_r8,8.4658e-05_r8/) + kao(:, 4, 1, 2) = (/ & + &3.1333e-06_r8,5.0568e-05_r8,7.8106e-05_r8,9.9691e-05_r8,1.1981e-04_r8,1.3549e-04_r8, & + &1.3924e-04_r8,1.5344e-04_r8,1.0884e-04_r8/) + kao(:, 5, 1, 2) = (/ & + &3.7302e-06_r8,6.1696e-05_r8,9.4521e-05_r8,1.2091e-04_r8,1.4534e-04_r8,1.6166e-04_r8, & + &1.6745e-04_r8,1.7689e-04_r8,1.3808e-04_r8/) + kao(:, 1, 2, 2) = (/ & + &2.7303e-06_r8,2.4541e-05_r8,3.5763e-05_r8,4.4104e-05_r8,5.1595e-05_r8,5.8966e-05_r8, & + &6.8130e-05_r8,1.0200e-04_r8,3.9223e-05_r8/) + kao(:, 2, 2, 2) = (/ & + &3.2091e-06_r8,3.1379e-05_r8,4.5745e-05_r8,5.7229e-05_r8,6.6576e-05_r8,7.4659e-05_r8, & + &8.1615e-05_r8,9.9977e-05_r8,5.3367e-05_r8/) + kao(:, 3, 2, 2) = (/ & + &3.8233e-06_r8,3.9294e-05_r8,5.7741e-05_r8,7.2569e-05_r8,8.4616e-05_r8,9.4873e-05_r8, & + &1.0240e-04_r8,1.1173e-04_r8,6.9904e-05_r8/) + kao(:, 4, 2, 2) = (/ & + &4.4247e-06_r8,4.8330e-05_r8,7.1550e-05_r8,9.0142e-05_r8,1.0471e-04_r8,1.1736e-04_r8, & + &1.2542e-04_r8,1.2602e-04_r8,8.9761e-05_r8/) + kao(:, 5, 2, 2) = (/ & + &5.2245e-06_r8,5.9597e-05_r8,8.7482e-05_r8,1.0983e-04_r8,1.2772e-04_r8,1.4263e-04_r8, & + &1.4957e-04_r8,1.4619e-04_r8,1.1276e-04_r8/) + kao(:, 1, 3, 2) = (/ & + &5.2515e-06_r8,2.5764e-05_r8,3.5421e-05_r8,4.2053e-05_r8,4.7449e-05_r8,5.0608e-05_r8, & + &5.3790e-05_r8,6.3623e-05_r8,3.2707e-05_r8/) + kao(:, 2, 3, 2) = (/ & + &6.1812e-06_r8,3.3267e-05_r8,4.5617e-05_r8,5.4363e-05_r8,6.1462e-05_r8,6.5644e-05_r8, & + &6.8603e-05_r8,7.2538e-05_r8,4.2974e-05_r8/) + kao(:, 3, 3, 2) = (/ & + &7.0789e-06_r8,4.1750e-05_r8,5.7967e-05_r8,6.9149e-05_r8,7.8026e-05_r8,8.4324e-05_r8, & + &8.7723e-05_r8,8.7036e-05_r8,5.7402e-05_r8/) + kao(:, 4, 3, 2) = (/ & + &8.1019e-06_r8,5.2243e-05_r8,7.2254e-05_r8,8.6560e-05_r8,9.8380e-05_r8,1.0586e-04_r8, & + &1.1006e-04_r8,1.0834e-04_r8,7.4594e-05_r8/) + kao(:, 5, 3, 2) = (/ & + &9.5928e-06_r8,6.4752e-05_r8,8.9095e-05_r8,1.0726e-04_r8,1.2114e-04_r8,1.3016e-04_r8, & + &1.3551e-04_r8,1.3048e-04_r8,9.3901e-05_r8/) + kao(:, 1, 4, 2) = (/ & + &1.1020e-05_r8,2.8494e-05_r8,3.6932e-05_r8,4.2975e-05_r8,4.6074e-05_r8,4.6953e-05_r8, & + &4.6313e-05_r8,4.4542e-05_r8,3.2970e-05_r8/) + kao(:, 2, 4, 2) = (/ & + &1.2562e-05_r8,3.7065e-05_r8,4.7812e-05_r8,5.4915e-05_r8,5.9599e-05_r8,6.1605e-05_r8, & + &6.1355e-05_r8,5.8223e-05_r8,3.9379e-05_r8/) + kao(:, 3, 4, 2) = (/ & + &1.4576e-05_r8,4.7351e-05_r8,6.1614e-05_r8,7.0211e-05_r8,7.6184e-05_r8,7.9246e-05_r8, & + &7.8840e-05_r8,7.4646e-05_r8,4.5622e-05_r8/) + kao(:, 4, 4, 2) = (/ & + &1.6280e-05_r8,5.8550e-05_r8,7.7244e-05_r8,8.9750e-05_r8,9.5812e-05_r8,1.0028e-04_r8, & + &1.0042e-04_r8,9.4563e-05_r8,5.6157e-05_r8/) + kao(:, 5, 4, 2) = (/ & + &1.8452e-05_r8,7.1720e-05_r8,9.6110e-05_r8,1.1183e-04_r8,1.1944e-04_r8,1.2546e-04_r8, & + &1.2521e-04_r8,1.1758e-04_r8,7.2313e-05_r8/) + kao(:, 1, 5, 2) = (/ & + &2.1312e-05_r8,3.6806e-05_r8,4.2862e-05_r8,4.6599e-05_r8,4.7270e-05_r8,4.6274e-05_r8, & + &4.2916e-05_r8,3.6817e-05_r8,3.2593e-05_r8/) + kao(:, 2, 5, 2) = (/ & + &2.5202e-05_r8,4.5358e-05_r8,5.3413e-05_r8,5.8866e-05_r8,6.0628e-05_r8,5.9617e-05_r8, & + &5.6530e-05_r8,4.9579e-05_r8,3.9610e-05_r8/) + kao(:, 3, 5, 2) = (/ & + &2.8699e-05_r8,5.5778e-05_r8,6.8120e-05_r8,7.4417e-05_r8,7.7573e-05_r8,7.6799e-05_r8, & + &7.3323e-05_r8,6.4915e-05_r8,4.8072e-05_r8/) + kao(:, 4, 5, 2) = (/ & + &3.2753e-05_r8,6.7844e-05_r8,8.5625e-05_r8,9.3879e-05_r8,9.7934e-05_r8,9.8316e-05_r8, & + &9.3375e-05_r8,8.3569e-05_r8,5.7445e-05_r8/) + kao(:, 5, 5, 2) = (/ & + &3.6908e-05_r8,8.3612e-05_r8,1.0490e-04_r8,1.1632e-04_r8,1.2275e-04_r8,1.2328e-04_r8, & + &1.1667e-04_r8,1.0539e-04_r8,6.6570e-05_r8/) + kao(:, 1, 6, 2) = (/ & + &4.3241e-05_r8,5.7363e-05_r8,5.9383e-05_r8,5.9083e-05_r8,5.6687e-05_r8,5.1929e-05_r8, & + &4.4854e-05_r8,3.4134e-05_r8,3.3554e-05_r8/) + kao(:, 2, 6, 2) = (/ & + &4.8160e-05_r8,6.6362e-05_r8,7.1460e-05_r8,7.1908e-05_r8,6.9540e-05_r8,6.3380e-05_r8, & + &5.6957e-05_r8,4.4490e-05_r8,3.9435e-05_r8/) + kao(:, 3, 6, 2) = (/ & + &5.5150e-05_r8,7.8279e-05_r8,8.5897e-05_r8,8.6929e-05_r8,8.6216e-05_r8,7.9912e-05_r8, & + &7.1634e-05_r8,5.7727e-05_r8,4.6871e-05_r8/) + kao(:, 4, 6, 2) = (/ & + &6.2702e-05_r8,9.3878e-05_r8,1.0189e-04_r8,1.0755e-04_r8,1.0575e-04_r8,1.0053e-04_r8, & + &8.9365e-05_r8,7.5152e-05_r8,5.7874e-05_r8/) + kao(:, 5, 6, 2) = (/ & + &7.1646e-05_r8,1.0994e-04_r8,1.2283e-04_r8,1.3142e-04_r8,1.3048e-04_r8,1.2339e-04_r8, & + &1.1339e-04_r8,9.4667e-05_r8,6.9560e-05_r8/) + kao(:, 1, 7, 2) = (/ & + &9.4217e-05_r8,1.0625e-04_r8,1.0297e-04_r8,9.4341e-05_r8,8.4820e-05_r8,7.4540e-05_r8, & + &5.9573e-05_r8,4.0162e-05_r8,3.4032e-05_r8/) + kao(:, 2, 7, 2) = (/ & + &1.0328e-04_r8,1.1698e-04_r8,1.1273e-04_r8,1.0730e-04_r8,9.8854e-05_r8,8.8068e-05_r8, & + &7.1680e-05_r8,5.0363e-05_r8,4.1780e-05_r8/) + kao(:, 3, 7, 2) = (/ & + &1.1436e-04_r8,1.3466e-04_r8,1.3293e-04_r8,1.2807e-04_r8,1.1742e-04_r8,1.0440e-04_r8, & + &8.7142e-05_r8,6.2911e-05_r8,5.1346e-05_r8/) + kao(:, 4, 7, 2) = (/ & + &1.2805e-04_r8,1.5498e-04_r8,1.5579e-04_r8,1.5032e-04_r8,1.3953e-04_r8,1.2638e-04_r8, & + &1.0638e-04_r8,7.6925e-05_r8,6.1784e-05_r8/) + kao(:, 5, 7, 2) = (/ & + &1.4510e-04_r8,1.7937e-04_r8,1.8186e-04_r8,1.7514e-04_r8,1.6579e-04_r8,1.5232e-04_r8, & + &1.2822e-04_r8,9.5671e-05_r8,7.0048e-05_r8/) + kao(:, 1, 8, 2) = (/ & + &2.4926e-04_r8,2.4392e-04_r8,2.2297e-04_r8,1.9521e-04_r8,1.6651e-04_r8,1.3349e-04_r8, & + &9.8669e-05_r8,6.3201e-05_r8,3.1807e-05_r8/) + kao(:, 2, 8, 2) = (/ & + &2.7454e-04_r8,2.7755e-04_r8,2.5558e-04_r8,2.2780e-04_r8,1.9618e-04_r8,1.5908e-04_r8, & + &1.2121e-04_r8,7.6667e-05_r8,4.0012e-05_r8/) + kao(:, 3, 8, 2) = (/ & + &2.9508e-04_r8,3.0091e-04_r8,2.7929e-04_r8,2.5223e-04_r8,2.1930e-04_r8,1.8562e-04_r8, & + &1.4312e-04_r8,9.2529e-05_r8,5.6355e-05_r8/) + kao(:, 4, 8, 2) = (/ & + &3.2350e-04_r8,3.3697e-04_r8,3.1656e-04_r8,2.8676e-04_r8,2.5417e-04_r8,2.1233e-04_r8, & + &1.6702e-04_r8,1.1113e-04_r8,6.5692e-05_r8/) + kao(:, 5, 8, 2) = (/ & + &3.5413e-04_r8,3.7149e-04_r8,3.5724e-04_r8,3.2794e-04_r8,2.8883e-04_r8,2.4521e-04_r8, & + &1.9502e-04_r8,1.3265e-04_r8,7.4636e-05_r8/) + kao(:, 1, 9, 2) = (/ & + &1.1370e-03_r8,1.0245e-03_r8,9.0233e-04_r8,7.7373e-04_r8,6.3596e-04_r8,4.9782e-04_r8, & + &3.4706e-04_r8,1.8813e-04_r8,5.4967e-05_r8/) + kao(:, 2, 9, 2) = (/ & + &1.2549e-03_r8,1.1327e-03_r8,1.0081e-03_r8,8.6174e-04_r8,7.1233e-04_r8,5.5663e-04_r8, & + &3.9054e-04_r8,2.1740e-04_r8,6.5863e-05_r8/) + kao(:, 3, 9, 2) = (/ & + &1.4193e-03_r8,1.2929e-03_r8,1.1501e-03_r8,9.8954e-04_r8,8.1834e-04_r8,6.4034e-04_r8, & + &4.5590e-04_r8,2.5841e-04_r8,7.6782e-05_r8/) + kao(:, 4, 9, 2) = (/ & + &1.5730e-03_r8,1.4525e-03_r8,1.2939e-03_r8,1.1191e-03_r8,9.2869e-04_r8,7.2912e-04_r8, & + &5.2003e-04_r8,2.9928e-04_r8,9.3109e-05_r8/) + kao(:, 5, 9, 2) = (/ & + &1.7020e-03_r8,1.5888e-03_r8,1.4187e-03_r8,1.2315e-03_r8,1.0334e-03_r8,8.2293e-04_r8, & + &5.9761e-04_r8,3.4411e-04_r8,1.1836e-04_r8/) + kao(:, 1,10, 2) = (/ & + &6.1528e-03_r8,5.4056e-03_r8,4.6635e-03_r8,3.9185e-03_r8,3.1663e-03_r8,2.4050e-03_r8, & + &1.6372e-03_r8,8.5009e-04_r8,8.0054e-05_r8/) + kao(:, 2,10, 2) = (/ & + &6.8550e-03_r8,6.0391e-03_r8,5.2246e-03_r8,4.3821e-03_r8,3.5514e-03_r8,2.7172e-03_r8, & + &1.8529e-03_r8,9.7224e-04_r8,1.0130e-04_r8/) + kao(:, 3,10, 2) = (/ & + &7.6163e-03_r8,6.7254e-03_r8,5.8028e-03_r8,4.8844e-03_r8,3.9710e-03_r8,3.0268e-03_r8, & + &2.0640e-03_r8,1.0804e-03_r8,1.3327e-04_r8/) + kao(:, 4,10, 2) = (/ & + &8.4017e-03_r8,7.4385e-03_r8,6.4324e-03_r8,5.4278e-03_r8,4.4132e-03_r8,3.3677e-03_r8, & + &2.3075e-03_r8,1.2226e-03_r8,1.6598e-04_r8/) + kao(:, 5,10, 2) = (/ & + &9.3911e-03_r8,8.3333e-03_r8,7.2272e-03_r8,6.1232e-03_r8,4.9837e-03_r8,3.8167e-03_r8, & + &2.6213e-03_r8,1.4063e-03_r8,2.0638e-04_r8/) + kao(:, 1,11, 2) = (/ & + &1.1762e-02_r8,1.0306e-02_r8,8.8593e-03_r8,7.4127e-03_r8,5.9627e-03_r8,4.5045e-03_r8, & + &3.0511e-03_r8,1.5666e-03_r8,8.2025e-05_r8/) + kao(:, 2,11, 2) = (/ & + &1.3012e-02_r8,1.1426e-02_r8,9.8347e-03_r8,8.2336e-03_r8,6.6323e-03_r8,5.0275e-03_r8, & + &3.4043e-03_r8,1.7550e-03_r8,1.0611e-04_r8/) + kao(:, 3,11, 2) = (/ & + &1.4612e-02_r8,1.2845e-02_r8,1.1070e-02_r8,9.2725e-03_r8,7.4822e-03_r8,5.6847e-03_r8, & + &3.8534e-03_r8,1.9989e-03_r8,1.3346e-04_r8/) + kao(:, 4,11, 2) = (/ & + &1.6251e-02_r8,1.4313e-02_r8,1.2347e-02_r8,1.0360e-02_r8,8.3777e-03_r8,6.3716e-03_r8, & + &4.3250e-03_r8,2.2445e-03_r8,1.6083e-04_r8/) + kao(:, 5,11, 2) = (/ & + &1.8150e-02_r8,1.6016e-02_r8,1.3813e-02_r8,1.1608e-02_r8,9.3833e-03_r8,7.1360e-03_r8, & + &4.8421e-03_r8,2.5233e-03_r8,2.0030e-04_r8/) + kao(:, 1,12, 2) = (/ & + &1.5059e-02_r8,1.3197e-02_r8,1.1332e-02_r8,9.4687e-03_r8,7.6107e-03_r8,5.7434e-03_r8, & + &3.8799e-03_r8,1.9799e-03_r8,8.0330e-05_r8/) + kao(:, 2,12, 2) = (/ & + &1.6512e-02_r8,1.4476e-02_r8,1.2442e-02_r8,1.0410e-02_r8,8.3743e-03_r8,6.3355e-03_r8, & + &4.2771e-03_r8,2.1952e-03_r8,9.9323e-05_r8/) + kao(:, 3,12, 2) = (/ & + &1.8685e-02_r8,1.6400e-02_r8,1.4116e-02_r8,1.1818e-02_r8,9.5219e-03_r8,7.2188e-03_r8, & + &4.8730e-03_r8,2.5083e-03_r8,1.2343e-04_r8/) + kao(:, 4,12, 2) = (/ & + &2.1153e-02_r8,1.8588e-02_r8,1.6002e-02_r8,1.3413e-02_r8,1.0821e-02_r8,8.2029e-03_r8, & + &5.5391e-03_r8,2.8500e-03_r8,1.4931e-04_r8/) + kao(:, 5,12, 2) = (/ & + &2.3737e-02_r8,2.0901e-02_r8,1.7991e-02_r8,1.5090e-02_r8,1.2172e-02_r8,9.2290e-03_r8, & + &6.2485e-03_r8,3.2234e-03_r8,1.9022e-04_r8/) + kao(:, 1,13, 2) = (/ & + &1.4847e-02_r8,1.3010e-02_r8,1.1175e-02_r8,9.3417e-03_r8,7.5039e-03_r8,5.6608e-03_r8, & + &3.8195e-03_r8,1.9483e-03_r8,7.0259e-05_r8/) + kao(:, 2,13, 2) = (/ & + &1.6739e-02_r8,1.4679e-02_r8,1.2619e-02_r8,1.0555e-02_r8,8.4903e-03_r8,6.4217e-03_r8, & + &4.3269e-03_r8,2.2129e-03_r8,8.5490e-05_r8/) + kao(:, 3,13, 2) = (/ & + &1.8825e-02_r8,1.6518e-02_r8,1.4211e-02_r8,1.1898e-02_r8,9.5859e-03_r8,7.2507e-03_r8, & + &4.8896e-03_r8,2.5047e-03_r8,1.1226e-04_r8/) + kao(:, 4,13, 2) = (/ & + &2.1292e-02_r8,1.8712e-02_r8,1.6107e-02_r8,1.3496e-02_r8,1.0877e-02_r8,8.2331e-03_r8, & + &5.5639e-03_r8,2.8510e-03_r8,1.4031e-04_r8/) + kao(:, 5,13, 2) = (/ & + &2.4158e-02_r8,2.1241e-02_r8,1.8299e-02_r8,1.5344e-02_r8,1.2375e-02_r8,9.3646e-03_r8, & + &6.3197e-03_r8,3.2533e-03_r8,1.7265e-04_r8/) + kao(:, 1, 1, 3) = (/ & + &1.0410e-05_r8,6.1962e-05_r8,8.9498e-05_r8,1.0661e-04_r8,1.2164e-04_r8,1.3377e-04_r8, & + &1.2941e-04_r8,1.4521e-04_r8,8.1226e-05_r8/) + kao(:, 2, 1, 3) = (/ & + &1.1876e-05_r8,7.8368e-05_r8,1.1198e-04_r8,1.3409e-04_r8,1.5187e-04_r8,1.6090e-04_r8, & + &1.6481e-04_r8,1.6441e-04_r8,1.1141e-04_r8/) + kao(:, 3, 1, 3) = (/ & + &1.3686e-05_r8,9.7536e-05_r8,1.3724e-04_r8,1.6641e-04_r8,1.8557e-04_r8,1.9386e-04_r8, & + &1.9539e-04_r8,1.8991e-04_r8,1.4967e-04_r8/) + kao(:, 4, 1, 3) = (/ & + &1.5807e-05_r8,1.1754e-04_r8,1.6722e-04_r8,2.0238e-04_r8,2.2277e-04_r8,2.3084e-04_r8, & + &2.3103e-04_r8,2.1679e-04_r8,1.9490e-04_r8/) + kao(:, 5, 1, 3) = (/ & + &1.8430e-05_r8,1.4041e-04_r8,2.0063e-04_r8,2.4077e-04_r8,2.6088e-04_r8,2.7081e-04_r8, & + &2.7088e-04_r8,2.6451e-04_r8,2.4633e-04_r8/) + kao(:, 1, 2, 3) = (/ & + &1.4574e-05_r8,6.1181e-05_r8,8.5219e-05_r8,1.0233e-04_r8,1.1097e-04_r8,1.1864e-04_r8, & + &1.2443e-04_r8,1.2339e-04_r8,6.7714e-05_r8/) + kao(:, 2, 2, 3) = (/ & + &1.6727e-05_r8,7.7358e-05_r8,1.0881e-04_r8,1.2844e-04_r8,1.4104e-04_r8,1.5016e-04_r8, & + &1.5142e-04_r8,1.4164e-04_r8,9.0996e-05_r8/) + kao(:, 3, 2, 3) = (/ & + &1.9092e-05_r8,9.6319e-05_r8,1.3467e-04_r8,1.5937e-04_r8,1.7543e-04_r8,1.8362e-04_r8, & + &1.8038e-04_r8,1.5924e-04_r8,1.2122e-04_r8/) + kao(:, 4, 2, 3) = (/ & + &2.2128e-05_r8,1.1862e-04_r8,1.6445e-04_r8,1.9397e-04_r8,2.1438e-04_r8,2.2054e-04_r8, & + &2.1448e-04_r8,2.0102e-04_r8,1.5787e-04_r8/) + kao(:, 5, 2, 3) = (/ & + &2.5953e-05_r8,1.4141e-04_r8,1.9710e-04_r8,2.3342e-04_r8,2.5581e-04_r8,2.5978e-04_r8, & + &2.5390e-04_r8,2.3627e-04_r8,2.0062e-04_r8/) + kao(:, 1, 3, 3) = (/ & + &2.6011e-05_r8,6.9300e-05_r8,8.8885e-05_r8,1.0316e-04_r8,1.1255e-04_r8,1.1444e-04_r8, & + &1.1119e-04_r8,1.0838e-04_r8,5.7064e-05_r8/) + kao(:, 2, 3, 3) = (/ & + &2.9960e-05_r8,8.6707e-05_r8,1.1415e-04_r8,1.3351e-04_r8,1.4420e-04_r8,1.4685e-04_r8, & + &1.4419e-04_r8,1.3258e-04_r8,7.5649e-05_r8/) + kao(:, 3, 3, 3) = (/ & + &3.4740e-05_r8,1.0851e-04_r8,1.4450e-04_r8,1.6834e-04_r8,1.8054e-04_r8,1.8416e-04_r8, & + &1.8038e-04_r8,1.5855e-04_r8,9.9657e-05_r8/) + kao(:, 4, 3, 3) = (/ & + &4.0367e-05_r8,1.3338e-04_r8,1.7889e-04_r8,2.0752e-04_r8,2.2266e-04_r8,2.2792e-04_r8, & + &2.1975e-04_r8,1.8879e-04_r8,1.2950e-04_r8/) + kao(:, 5, 3, 3) = (/ & + &4.7325e-05_r8,1.6087e-04_r8,2.1635e-04_r8,2.5031e-04_r8,2.7116e-04_r8,2.7639e-04_r8, & + &2.6032e-04_r8,2.2480e-04_r8,1.6585e-04_r8/) + kao(:, 1, 4, 3) = (/ & + &4.6629e-05_r8,8.8856e-05_r8,1.0307e-04_r8,1.1034e-04_r8,1.1324e-04_r8,1.1518e-04_r8, & + &1.0941e-04_r8,9.2447e-05_r8,4.9807e-05_r8/) + kao(:, 2, 4, 3) = (/ & + &5.3813e-05_r8,1.0914e-04_r8,1.2953e-04_r8,1.4280e-04_r8,1.4973e-04_r8,1.5074e-04_r8, & + &1.4150e-04_r8,1.2111e-04_r8,6.6358e-05_r8/) + kao(:, 3, 4, 3) = (/ & + &6.3364e-05_r8,1.3307e-04_r8,1.6255e-04_r8,1.8292e-04_r8,1.9276e-04_r8,1.9285e-04_r8, & + &1.8002e-04_r8,1.5407e-04_r8,8.8052e-05_r8/) + kao(:, 4, 4, 3) = (/ & + &7.4529e-05_r8,1.6123e-04_r8,2.0145e-04_r8,2.2832e-04_r8,2.4093e-04_r8,2.3982e-04_r8, & + &2.2562e-04_r8,1.8990e-04_r8,1.1560e-04_r8/) + kao(:, 5, 4, 3) = (/ & + &8.8134e-05_r8,1.9717e-04_r8,2.4798e-04_r8,2.7909e-04_r8,2.9532e-04_r8,2.9441e-04_r8, & + &2.7564e-04_r8,2.2733e-04_r8,1.4686e-04_r8/) + kao(:, 1, 5, 3) = (/ & + &7.7279e-05_r8,1.1122e-04_r8,1.2109e-04_r8,1.2443e-04_r8,1.2189e-04_r8,1.1617e-04_r8, & + &1.0613e-04_r8,8.7521e-05_r8,4.7012e-05_r8/) + kao(:, 2, 5, 3) = (/ & + &8.9473e-05_r8,1.3546e-04_r8,1.5195e-04_r8,1.5794e-04_r8,1.5786e-04_r8,1.5329e-04_r8, & + &1.4127e-04_r8,1.1487e-04_r8,6.0204e-05_r8/) + kao(:, 3, 5, 3) = (/ & + &1.0328e-04_r8,1.6610e-04_r8,1.8961e-04_r8,1.9990e-04_r8,2.0229e-04_r8,2.0006e-04_r8, & + &1.8432e-04_r8,1.4896e-04_r8,7.6087e-05_r8/) + kao(:, 4, 5, 3) = (/ & + &1.2119e-04_r8,2.0367e-04_r8,2.3155e-04_r8,2.4851e-04_r8,2.5658e-04_r8,2.5211e-04_r8, & + &2.3296e-04_r8,1.8864e-04_r8,9.8744e-05_r8/) + kao(:, 5, 5, 3) = (/ & + &1.4337e-04_r8,2.4554e-04_r8,2.8278e-04_r8,3.0781e-04_r8,3.1834e-04_r8,3.1139e-04_r8, & + &2.8860e-04_r8,2.3262e-04_r8,1.2920e-04_r8/) + kao(:, 1, 6, 3) = (/ & + &1.1761e-04_r8,1.4538e-04_r8,1.4284e-04_r8,1.3740e-04_r8,1.2980e-04_r8,1.1847e-04_r8, & + &1.0232e-04_r8,8.1254e-05_r8,4.1748e-05_r8/) + kao(:, 2, 6, 3) = (/ & + &1.3703e-04_r8,1.7162e-04_r8,1.7382e-04_r8,1.7289e-04_r8,1.6644e-04_r8,1.5514e-04_r8, & + &1.3666e-04_r8,1.0938e-04_r8,5.6033e-05_r8/) + kao(:, 3, 6, 3) = (/ & + &1.5744e-04_r8,2.0479e-04_r8,2.1458e-04_r8,2.1922e-04_r8,2.1487e-04_r8,2.0072e-04_r8, & + &1.7976e-04_r8,1.4480e-04_r8,7.3663e-05_r8/) + kao(:, 4, 6, 3) = (/ & + &1.7947e-04_r8,2.4802e-04_r8,2.6658e-04_r8,2.7311e-04_r8,2.6613e-04_r8,2.5639e-04_r8, & + &2.3337e-04_r8,1.8491e-04_r8,9.1670e-05_r8/) + kao(:, 5, 6, 3) = (/ & + &2.1213e-04_r8,2.9698e-04_r8,3.2800e-04_r8,3.3255e-04_r8,3.3379e-04_r8,3.2227e-04_r8, & + &2.9213e-04_r8,2.3295e-04_r8,1.1053e-04_r8/) + kao(:, 1, 7, 3) = (/ & + &2.1717e-04_r8,2.2955e-04_r8,2.1661e-04_r8,1.9608e-04_r8,1.6989e-04_r8,1.4299e-04_r8, & + &1.1566e-04_r8,8.2895e-05_r8,3.7387e-05_r8/) + kao(:, 2, 7, 3) = (/ & + &2.4414e-04_r8,2.6643e-04_r8,2.5638e-04_r8,2.3114e-04_r8,2.0334e-04_r8,1.7738e-04_r8, & + &1.4895e-04_r8,1.0764e-04_r8,5.2222e-05_r8/) + kao(:, 3, 7, 3) = (/ & + &2.7286e-04_r8,3.0487e-04_r8,2.9526e-04_r8,2.7261e-04_r8,2.5126e-04_r8,2.2507e-04_r8, & + &1.8734e-04_r8,1.4022e-04_r8,6.8628e-05_r8/) + kao(:, 4, 7, 3) = (/ & + &3.1153e-04_r8,3.5338e-04_r8,3.4554e-04_r8,3.2591e-04_r8,3.0719e-04_r8,2.7679e-04_r8, & + &2.3565e-04_r8,1.8522e-04_r8,8.6360e-05_r8/) + kao(:, 5, 7, 3) = (/ & + &3.5307e-04_r8,4.0595e-04_r8,4.0654e-04_r8,3.9853e-04_r8,3.7853e-04_r8,3.4348e-04_r8, & + &3.0049e-04_r8,2.3594e-04_r8,1.1315e-04_r8/) + kao(:, 1, 8, 3) = (/ & + &5.5525e-04_r8,5.3290e-04_r8,4.9219e-04_r8,4.3834e-04_r8,3.7060e-04_r8,2.9620e-04_r8, & + &2.1670e-04_r8,1.3044e-04_r8,4.3913e-05_r8/) + kao(:, 2, 8, 3) = (/ & + &6.1273e-04_r8,5.9169e-04_r8,5.4415e-04_r8,4.8432e-04_r8,4.1256e-04_r8,3.3431e-04_r8, & + &2.4554e-04_r8,1.5735e-04_r8,5.6222e-05_r8/) + kao(:, 3, 8, 3) = (/ & + &6.6697e-04_r8,6.5930e-04_r8,6.1229e-04_r8,5.4542e-04_r8,4.6824e-04_r8,3.7897e-04_r8, & + &2.8714e-04_r8,1.8945e-04_r8,7.2182e-05_r8/) + kao(:, 4, 8, 3) = (/ & + &7.3789e-04_r8,7.3274e-04_r8,6.8030e-04_r8,6.0993e-04_r8,5.2803e-04_r8,4.3826e-04_r8, & + &3.4177e-04_r8,2.2879e-04_r8,9.7984e-05_r8/) + kao(:, 5, 8, 3) = (/ & + &8.2418e-04_r8,8.2930e-04_r8,7.7540e-04_r8,7.0471e-04_r8,6.2407e-04_r8,5.2518e-04_r8, & + &4.1114e-04_r8,2.7739e-04_r8,1.2917e-04_r8/) + kao(:, 1, 9, 3) = (/ & + &2.9866e-03_r8,2.6446e-03_r8,2.3122e-03_r8,1.9743e-03_r8,1.6235e-03_r8,1.2497e-03_r8, & + &8.7401e-04_r8,4.7254e-04_r8,6.5815e-05_r8/) + kao(:, 2, 9, 3) = (/ & + &3.1867e-03_r8,2.8548e-03_r8,2.5070e-03_r8,2.1512e-03_r8,1.7728e-03_r8,1.3804e-03_r8, & + &9.6416e-04_r8,5.2342e-04_r8,8.4426e-05_r8/) + kao(:, 3, 9, 3) = (/ & + &3.3577e-03_r8,3.0331e-03_r8,2.6681e-03_r8,2.2844e-03_r8,1.8894e-03_r8,1.4824e-03_r8, & + &1.0437e-03_r8,5.7926e-04_r8,1.1456e-04_r8/) + kao(:, 4, 9, 3) = (/ & + &3.5955e-03_r8,3.2669e-03_r8,2.8865e-03_r8,2.4786e-03_r8,2.0664e-03_r8,1.6261e-03_r8, & + &1.1591e-03_r8,6.6253e-04_r8,1.4708e-04_r8/) + kao(:, 5, 9, 3) = (/ & + &3.9554e-03_r8,3.6156e-03_r8,3.2186e-03_r8,2.7765e-03_r8,2.3055e-03_r8,1.8177e-03_r8, & + &1.3061e-03_r8,7.6692e-04_r8,1.9062e-04_r8/) + kao(:, 1,10, 3) = (/ & + &1.6695e-02_r8,1.4628e-02_r8,1.2561e-02_r8,1.0499e-02_r8,8.4474e-03_r8,6.4042e-03_r8, & + &4.3459e-03_r8,2.2571e-03_r8,5.1038e-05_r8/) + kao(:, 2,10, 3) = (/ & + &1.8223e-02_r8,1.5977e-02_r8,1.3728e-02_r8,1.1517e-02_r8,9.2932e-03_r8,7.0542e-03_r8, & + &4.8075e-03_r8,2.4890e-03_r8,1.1555e-04_r8/) + kao(:, 3,10, 3) = (/ & + &2.0043e-02_r8,1.7593e-02_r8,1.5175e-02_r8,1.2748e-02_r8,1.0288e-02_r8,7.8318e-03_r8, & + &5.3279e-03_r8,2.7782e-03_r8,1.4398e-04_r8/) + kao(:, 4,10, 3) = (/ & + &2.1904e-02_r8,1.9249e-02_r8,1.6643e-02_r8,1.3989e-02_r8,1.1315e-02_r8,8.6138e-03_r8, & + &5.8652e-03_r8,3.0632e-03_r8,1.9715e-04_r8/) + kao(:, 5,10, 3) = (/ & + &2.3159e-02_r8,2.0410e-02_r8,1.7664e-02_r8,1.4873e-02_r8,1.2019e-02_r8,9.1728e-03_r8, & + &6.2874e-03_r8,3.3158e-03_r8,2.7195e-04_r8/) + kao(:, 1,11, 3) = (/ & + &3.2603e-02_r8,2.8559e-02_r8,2.4510e-02_r8,2.0449e-02_r8,1.6397e-02_r8,1.2361e-02_r8, & + &8.3115e-03_r8,4.2614e-03_r8,4.3561e-05_r8/) + kao(:, 2,11, 3) = (/ & + &3.5490e-02_r8,3.1085e-02_r8,2.6692e-02_r8,2.2303e-02_r8,1.7919e-02_r8,1.3525e-02_r8, & + &9.1241e-03_r8,4.6814e-03_r8,1.0680e-04_r8/) + kao(:, 3,11, 3) = (/ & + &3.8854e-02_r8,3.4035e-02_r8,2.9244e-02_r8,2.4483e-02_r8,1.9700e-02_r8,1.4916e-02_r8, & + &1.0095e-02_r8,5.1808e-03_r8,1.8562e-04_r8/) + kao(:, 4,11, 3) = (/ & + &4.2305e-02_r8,3.7086e-02_r8,3.1904e-02_r8,2.6732e-02_r8,2.1504e-02_r8,1.6276e-02_r8, & + &1.1000e-02_r8,5.6671e-03_r8,2.4195e-04_r8/) + kao(:, 5,11, 3) = (/ & + &4.6003e-02_r8,4.0358e-02_r8,3.4797e-02_r8,2.9165e-02_r8,2.3531e-02_r8,1.7850e-02_r8, & + &1.2113e-02_r8,6.2729e-03_r8,3.2815e-04_r8/) + kao(:, 1,12, 3) = (/ & + &4.2717e-02_r8,3.7390e-02_r8,3.2076e-02_r8,2.6766e-02_r8,2.1453e-02_r8,1.6148e-02_r8, & + &1.0833e-02_r8,5.5285e-03_r8,5.3162e-05_r8/) + kao(:, 2,12, 3) = (/ & + &4.7716e-02_r8,4.1793e-02_r8,3.5854e-02_r8,2.9930e-02_r8,2.4020e-02_r8,1.8099e-02_r8, & + &1.2166e-02_r8,6.2010e-03_r8,1.2199e-04_r8/) + kao(:, 3,12, 3) = (/ & + &5.2485e-02_r8,4.5967e-02_r8,3.9456e-02_r8,3.2983e-02_r8,2.6496e-02_r8,1.9981e-02_r8, & + &1.3462e-02_r8,6.8646e-03_r8,1.9551e-04_r8/) + kao(:, 4,12, 3) = (/ & + &5.6971e-02_r8,4.9905e-02_r8,4.2910e-02_r8,3.5876e-02_r8,2.8829e-02_r8,2.1772e-02_r8, & + &1.4678e-02_r8,7.4885e-03_r8,2.4038e-04_r8/) + kao(:, 5,12, 3) = (/ & + &6.1845e-02_r8,5.4216e-02_r8,4.6694e-02_r8,3.9065e-02_r8,3.1428e-02_r8,2.3760e-02_r8, & + &1.6034e-02_r8,8.2201e-03_r8,3.2330e-04_r8/) + kao(:, 1,13, 3) = (/ & + &4.4159e-02_r8,3.8661e-02_r8,3.3159e-02_r8,2.7655e-02_r8,2.2159e-02_r8,1.6679e-02_r8, & + &1.1182e-02_r8,5.6866e-03_r8,7.0844e-05_r8/) + kao(:, 2,13, 3) = (/ & + &4.9543e-02_r8,4.3376e-02_r8,3.7217e-02_r8,3.1073e-02_r8,2.4939e-02_r8,1.8777e-02_r8, & + &1.2622e-02_r8,6.4095e-03_r8,1.2350e-04_r8/) + kao(:, 3,13, 3) = (/ & + &5.4720e-02_r8,4.7942e-02_r8,4.1156e-02_r8,3.4403e-02_r8,2.7607e-02_r8,2.0806e-02_r8, & + &1.3984e-02_r8,7.1021e-03_r8,1.5128e-04_r8/) + kao(:, 4,13, 3) = (/ & + &5.9716e-02_r8,5.2321e-02_r8,4.4977e-02_r8,3.7585e-02_r8,3.0190e-02_r8,2.2781e-02_r8, & + &1.5325e-02_r8,7.8087e-03_r8,2.1269e-04_r8/) + kao(:, 5,13, 3) = (/ & + &6.4624e-02_r8,5.6664e-02_r8,4.8723e-02_r8,4.0765e-02_r8,3.2763e-02_r8,2.4744e-02_r8, & + &1.6652e-02_r8,8.4913e-03_r8,3.0727e-04_r8/) + kao(:, 1, 1, 4) = (/ & + &5.7873e-05_r8,1.6488e-04_r8,2.0580e-04_r8,2.2960e-04_r8,2.3556e-04_r8,2.2261e-04_r8, & + &2.0972e-04_r8,1.9322e-04_r8,1.3088e-04_r8/) + kao(:, 2, 1, 4) = (/ & + &6.6249e-05_r8,1.9462e-04_r8,2.4549e-04_r8,2.7463e-04_r8,2.7934e-04_r8,2.6538e-04_r8, & + &2.3743e-04_r8,2.0925e-04_r8,1.7715e-04_r8/) + kao(:, 3, 1, 4) = (/ & + &7.5658e-05_r8,2.2561e-04_r8,2.8843e-04_r8,3.1940e-04_r8,3.2388e-04_r8,3.1216e-04_r8, & + &2.9036e-04_r8,2.7653e-04_r8,2.3143e-04_r8/) + kao(:, 4, 1, 4) = (/ & + &8.5832e-05_r8,2.6205e-04_r8,3.3188e-04_r8,3.6495e-04_r8,3.7173e-04_r8,3.6401e-04_r8, & + &3.4696e-04_r8,3.4171e-04_r8,2.9590e-04_r8/) + kao(:, 5, 1, 4) = (/ & + &9.6691e-05_r8,2.9985e-04_r8,3.7678e-04_r8,4.1538e-04_r8,4.2689e-04_r8,4.2505e-04_r8, & + &4.1168e-04_r8,4.0784e-04_r8,3.7540e-04_r8/) + kao(:, 1, 2, 4) = (/ & + &8.0001e-05_r8,1.7863e-04_r8,2.1664e-04_r8,2.3517e-04_r8,2.4432e-04_r8,2.3529e-04_r8, & + &2.0358e-04_r8,1.5402e-04_r8,1.1156e-04_r8/) + kao(:, 2, 2, 4) = (/ & + &9.2299e-05_r8,2.0953e-04_r8,2.5648e-04_r8,2.8347e-04_r8,2.9289e-04_r8,2.8063e-04_r8, & + &2.4649e-04_r8,1.9992e-04_r8,1.5181e-04_r8/) + kao(:, 3, 2, 4) = (/ & + &1.0437e-04_r8,2.4399e-04_r8,3.0364e-04_r8,3.3466e-04_r8,3.4277e-04_r8,3.2781e-04_r8, & + &2.9451e-04_r8,2.4303e-04_r8,2.0131e-04_r8/) + kao(:, 4, 2, 4) = (/ & + &1.1814e-04_r8,2.8134e-04_r8,3.5342e-04_r8,3.8732e-04_r8,3.9443e-04_r8,3.8031e-04_r8, & + &3.4829e-04_r8,2.8801e-04_r8,2.6066e-04_r8/) + kao(:, 5, 2, 4) = (/ & + &1.3198e-04_r8,3.2404e-04_r8,4.0415e-04_r8,4.4181e-04_r8,4.5121e-04_r8,4.4037e-04_r8, & + &4.0877e-04_r8,3.5353e-04_r8,3.3227e-04_r8/) + kao(:, 1, 3, 4) = (/ & + &1.4443e-04_r8,2.3826e-04_r8,2.7329e-04_r8,2.8523e-04_r8,2.8239e-04_r8,2.6871e-04_r8, & + &2.4140e-04_r8,1.7625e-04_r8,9.1057e-05_r8/) + kao(:, 2, 3, 4) = (/ & + &1.6500e-04_r8,2.7899e-04_r8,3.2197e-04_r8,3.3661e-04_r8,3.4010e-04_r8,3.2744e-04_r8, & + &2.9069e-04_r8,2.1583e-04_r8,1.2870e-04_r8/) + kao(:, 3, 3, 4) = (/ & + &1.8759e-04_r8,3.2667e-04_r8,3.7258e-04_r8,3.9759e-04_r8,4.0496e-04_r8,3.8750e-04_r8, & + &3.4189e-04_r8,2.6207e-04_r8,1.7564e-04_r8/) + kao(:, 4, 3, 4) = (/ & + &2.1411e-04_r8,3.7810e-04_r8,4.3373e-04_r8,4.6557e-04_r8,4.7150e-04_r8,4.5014e-04_r8, & + &3.9858e-04_r8,3.1356e-04_r8,2.3208e-04_r8/) + kao(:, 5, 3, 4) = (/ & + &2.3870e-04_r8,4.2957e-04_r8,5.0123e-04_r8,5.3924e-04_r8,5.3944e-04_r8,5.1553e-04_r8, & + &4.6343e-04_r8,3.7106e-04_r8,2.9980e-04_r8/) + kao(:, 1, 4, 4) = (/ & + &2.6076e-04_r8,3.4439e-04_r8,3.6366e-04_r8,3.6515e-04_r8,3.5256e-04_r8,3.2080e-04_r8, & + &2.7636e-04_r8,2.0889e-04_r8,8.2321e-05_r8/) + kao(:, 2, 4, 4) = (/ & + &2.9760e-04_r8,4.0373e-04_r8,4.3154e-04_r8,4.3412e-04_r8,4.1663e-04_r8,3.8448e-04_r8, & + &3.3798e-04_r8,2.5481e-04_r8,1.1139e-04_r8/) + kao(:, 3, 4, 4) = (/ & + &3.4031e-04_r8,4.7084e-04_r8,5.0815e-04_r8,5.1064e-04_r8,4.9099e-04_r8,4.5954e-04_r8, & + &4.0644e-04_r8,3.0187e-04_r8,1.5330e-04_r8/) + kao(:, 4, 4, 4) = (/ & + &3.8682e-04_r8,5.4745e-04_r8,5.9070e-04_r8,5.9370e-04_r8,5.7774e-04_r8,5.4347e-04_r8, & + &4.7190e-04_r8,3.5452e-04_r8,2.0604e-04_r8/) + kao(:, 5, 4, 4) = (/ & + &4.3959e-04_r8,6.2729e-04_r8,6.7728e-04_r8,6.8652e-04_r8,6.7377e-04_r8,6.2625e-04_r8, & + &5.4307e-04_r8,4.1535e-04_r8,2.7101e-04_r8/) + kao(:, 1, 5, 4) = (/ & + &4.3137e-04_r8,4.9354e-04_r8,4.9901e-04_r8,4.7432e-04_r8,4.3778e-04_r8,3.8485e-04_r8, & + &3.1938e-04_r8,2.2709e-04_r8,7.3559e-05_r8/) + kao(:, 2, 5, 4) = (/ & + &4.9217e-04_r8,5.7735e-04_r8,5.8525e-04_r8,5.6095e-04_r8,5.2221e-04_r8,4.6398e-04_r8, & + &3.8313e-04_r8,2.8160e-04_r8,1.0296e-04_r8/) + kao(:, 3, 5, 4) = (/ & + &5.6924e-04_r8,6.7555e-04_r8,6.8298e-04_r8,6.6362e-04_r8,6.1781e-04_r8,5.4692e-04_r8, & + &4.5981e-04_r8,3.4088e-04_r8,1.4005e-04_r8/) + kao(:, 4, 5, 4) = (/ & + &6.5162e-04_r8,7.8635e-04_r8,7.9830e-04_r8,7.7682e-04_r8,7.2322e-04_r8,6.4526e-04_r8, & + &5.4580e-04_r8,4.0061e-04_r8,1.8482e-04_r8/) + kao(:, 5, 5, 4) = (/ & + &7.5040e-04_r8,9.0883e-04_r8,9.2599e-04_r8,8.9925e-04_r8,8.3896e-04_r8,7.5567e-04_r8, & + &6.3867e-04_r8,4.6416e-04_r8,2.4367e-04_r8/) + kao(:, 1, 6, 4) = (/ & + &6.5259e-04_r8,6.7358e-04_r8,6.6023e-04_r8,6.1431e-04_r8,5.5026e-04_r8,4.6572e-04_r8, & + &3.6933e-04_r8,2.4724e-04_r8,6.3454e-05_r8/) + kao(:, 2, 6, 4) = (/ & + &7.5346e-04_r8,7.9866e-04_r8,7.7727e-04_r8,7.2579e-04_r8,6.4756e-04_r8,5.5655e-04_r8, & + &4.4395e-04_r8,3.0264e-04_r8,8.7333e-05_r8/) + kao(:, 3, 6, 4) = (/ & + &8.8029e-04_r8,9.4301e-04_r8,9.1678e-04_r8,8.5383e-04_r8,7.6672e-04_r8,6.6157e-04_r8, & + &5.3248e-04_r8,3.6645e-04_r8,1.2006e-04_r8/) + kao(:, 4, 6, 4) = (/ & + &1.0324e-03_r8,1.1112e-03_r8,1.0784e-03_r8,1.0064e-03_r8,9.0982e-04_r8,7.8126e-04_r8, & + &6.2832e-04_r8,4.4008e-04_r8,1.6674e-04_r8/) + kao(:, 5, 6, 4) = (/ & + &1.1873e-03_r8,1.2942e-03_r8,1.2623e-03_r8,1.1793e-03_r8,1.0646e-03_r8,9.2296e-04_r8, & + &7.3952e-04_r8,5.1891e-04_r8,2.2335e-04_r8/) + kao(:, 1, 7, 4) = (/ & + &1.0039e-03_r8,9.6265e-04_r8,8.9986e-04_r8,8.1533e-04_r8,7.1416e-04_r8,5.9439e-04_r8, & + &4.5276e-04_r8,2.8651e-04_r8,6.5221e-05_r8/) + kao(:, 2, 7, 4) = (/ & + &1.1698e-03_r8,1.1414e-03_r8,1.0686e-03_r8,9.8012e-04_r8,8.6148e-04_r8,7.1658e-04_r8, & + &5.4576e-04_r8,3.5076e-04_r8,8.8064e-05_r8/) + kao(:, 3, 7, 4) = (/ & + &1.3785e-03_r8,1.3654e-03_r8,1.2898e-03_r8,1.1834e-03_r8,1.0346e-03_r8,8.5792e-04_r8, & + &6.6115e-04_r8,4.2986e-04_r8,1.2055e-04_r8/) + kao(:, 4, 7, 4) = (/ & + &1.6296e-03_r8,1.6337e-03_r8,1.5460e-03_r8,1.4118e-03_r8,1.2372e-03_r8,1.0278e-03_r8, & + &7.9671e-04_r8,5.1331e-04_r8,1.5903e-04_r8/) + kao(:, 5, 7, 4) = (/ & + &1.9001e-03_r8,1.9217e-03_r8,1.8220e-03_r8,1.6571e-03_r8,1.4527e-03_r8,1.2164e-03_r8, & + &9.4433e-04_r8,6.1289e-04_r8,2.0363e-04_r8/) + kao(:, 1, 8, 4) = (/ & + &1.8226e-03_r8,1.6514e-03_r8,1.4839e-03_r8,1.2932e-03_r8,1.0982e-03_r8,8.8723e-04_r8, & + &6.5582e-04_r8,3.8869e-04_r8,7.0418e-05_r8/) + kao(:, 2, 8, 4) = (/ & + &2.1183e-03_r8,1.9484e-03_r8,1.7717e-03_r8,1.5557e-03_r8,1.3178e-03_r8,1.0649e-03_r8, & + &7.9415e-04_r8,4.7222e-04_r8,9.8173e-05_r8/) + kao(:, 3, 8, 4) = (/ & + &2.5295e-03_r8,2.3395e-03_r8,2.1347e-03_r8,1.8817e-03_r8,1.6058e-03_r8,1.3046e-03_r8, & + &9.6185e-04_r8,5.7415e-04_r8,1.2861e-04_r8/) + kao(:, 4, 8, 4) = (/ & + &3.0151e-03_r8,2.8208e-03_r8,2.5722e-03_r8,2.2683e-03_r8,1.9222e-03_r8,1.5620e-03_r8, & + &1.1535e-03_r8,7.0406e-04_r8,1.7432e-04_r8/) + kao(:, 5, 8, 4) = (/ & + &3.5096e-03_r8,3.3177e-03_r8,3.0150e-03_r8,2.6542e-03_r8,2.2606e-03_r8,1.8422e-03_r8, & + &1.3738e-03_r8,8.5046e-04_r8,2.3260e-04_r8/) + kao(:, 1, 9, 4) = (/ & + &7.9941e-03_r8,7.0328e-03_r8,6.0711e-03_r8,5.1105e-03_r8,4.1565e-03_r8,3.2070e-03_r8, & + &2.2152e-03_r8,1.1971e-03_r8,7.9032e-05_r8/) + kao(:, 2, 9, 4) = (/ & + &8.9783e-03_r8,7.9063e-03_r8,6.8488e-03_r8,5.7943e-03_r8,4.7410e-03_r8,3.6528e-03_r8, & + &2.5467e-03_r8,1.3852e-03_r8,1.1999e-04_r8/) + kao(:, 3, 9, 4) = (/ & + &1.0198e-02_r8,9.0183e-03_r8,7.8510e-03_r8,6.6811e-03_r8,5.4839e-03_r8,4.2200e-03_r8, & + &2.9428e-03_r8,1.6034e-03_r8,1.6821e-04_r8/) + kao(:, 4, 9, 4) = (/ & + &1.1749e-02_r8,1.0423e-02_r8,9.0948e-03_r8,7.7411e-03_r8,6.3357e-03_r8,4.8731e-03_r8, & + &3.3881e-03_r8,1.8608e-03_r8,2.4632e-04_r8/) + kao(:, 5, 9, 4) = (/ & + &1.3350e-02_r8,1.1910e-02_r8,1.0410e-02_r8,8.8879e-03_r8,7.2904e-03_r8,5.6383e-03_r8, & + &3.9275e-03_r8,2.1612e-03_r8,3.3903e-04_r8/) + kao(:, 1,10, 4) = (/ & + &4.5801e-02_r8,4.0109e-02_r8,3.4395e-02_r8,2.8682e-02_r8,2.2984e-02_r8,1.7267e-02_r8, & + &1.1579e-02_r8,5.9235e-03_r8,6.3484e-05_r8/) + kao(:, 2,10, 4) = (/ & + &4.9659e-02_r8,4.3500e-02_r8,3.7321e-02_r8,3.1127e-02_r8,2.4948e-02_r8,1.8778e-02_r8, & + &1.2636e-02_r8,6.5101e-03_r8,9.5466e-05_r8/) + kao(:, 3,10, 4) = (/ & + &5.4357e-02_r8,4.7634e-02_r8,4.0874e-02_r8,3.4140e-02_r8,2.7418e-02_r8,2.0676e-02_r8, & + &1.3967e-02_r8,7.2134e-03_r8,2.1246e-04_r8/) + kao(:, 4,10, 4) = (/ & + &6.0291e-02_r8,5.2843e-02_r8,4.5373e-02_r8,3.7958e-02_r8,3.0510e-02_r8,2.3082e-02_r8, & + &1.5672e-02_r8,8.0960e-03_r8,3.5404e-04_r8/) + kao(:, 5,10, 4) = (/ & + &6.7661e-02_r8,5.9365e-02_r8,5.1042e-02_r8,4.2745e-02_r8,3.4451e-02_r8,2.6105e-02_r8, & + &1.7693e-02_r8,9.1211e-03_r8,4.7192e-04_r8/) + kao(:, 1,11, 4) = (/ & + &9.0702e-02_r8,7.9394e-02_r8,6.8068e-02_r8,5.6747e-02_r8,4.5417e-02_r8,3.4107e-02_r8, & + &2.2797e-02_r8,1.1511e-02_r8,7.5853e-05_r8/) + kao(:, 2,11, 4) = (/ & + &9.9244e-02_r8,8.6879e-02_r8,7.4483e-02_r8,6.2100e-02_r8,4.9720e-02_r8,3.7362e-02_r8, & + &2.5008e-02_r8,1.2672e-02_r8,1.0256e-04_r8/) + kao(:, 3,11, 4) = (/ & + &1.0852e-01_r8,9.5023e-02_r8,8.1487e-02_r8,6.7960e-02_r8,5.4445e-02_r8,4.0919e-02_r8, & + &2.7423e-02_r8,1.3982e-02_r8,1.6509e-04_r8/) + kao(:, 4,11, 4) = (/ & + &1.1956e-01_r8,1.0470e-01_r8,8.9828e-02_r8,7.4940e-02_r8,6.0117e-02_r8,4.5252e-02_r8, & + &3.0437e-02_r8,1.5543e-02_r8,3.1661e-04_r8/) + kao(:, 5,11, 4) = (/ & + &1.3039e-01_r8,1.1429e-01_r8,9.8079e-02_r8,8.1967e-02_r8,6.5782e-02_r8,4.9565e-02_r8, & + &3.3397e-02_r8,1.7070e-02_r8,5.0645e-04_r8/) + kao(:, 1,12, 4) = (/ & + &1.2021e-01_r8,1.0519e-01_r8,9.0195e-02_r8,7.5171e-02_r8,6.0154e-02_r8,4.5148e-02_r8, & + &3.0151e-02_r8,1.5167e-02_r8,6.7632e-05_r8/) + kao(:, 2,12, 4) = (/ & + &1.3016e-01_r8,1.1394e-01_r8,9.7701e-02_r8,8.1469e-02_r8,6.5222e-02_r8,4.8981e-02_r8, & + &3.2777e-02_r8,1.6564e-02_r8,9.6691e-05_r8/) + kao(:, 3,12, 4) = (/ & + &1.4257e-01_r8,1.2479e-01_r8,1.0706e-01_r8,8.9271e-02_r8,7.1459e-02_r8,5.3715e-02_r8, & + &3.5967e-02_r8,1.8266e-02_r8,1.8650e-04_r8/) + kao(:, 4,12, 4) = (/ & + &1.5648e-01_r8,1.3701e-01_r8,1.1748e-01_r8,9.8018e-02_r8,7.8554e-02_r8,5.9075e-02_r8, & + &3.9673e-02_r8,2.0186e-02_r8,3.5387e-04_r8/) + kao(:, 5,12, 4) = (/ & + &1.6740e-01_r8,1.4658e-01_r8,1.2570e-01_r8,1.0496e-01_r8,8.4156e-02_r8,6.3336e-02_r8, & + &4.2553e-02_r8,2.1604e-02_r8,5.3320e-04_r8/) + kao(:, 1,13, 4) = (/ & + &1.2573e-01_r8,1.1000e-01_r8,9.4314e-02_r8,7.8615e-02_r8,6.2929e-02_r8,4.7219e-02_r8, & + &3.1536e-02_r8,1.5865e-02_r8,5.0474e-05_r8/) + kao(:, 2,13, 4) = (/ & + &1.3569e-01_r8,1.1873e-01_r8,1.0180e-01_r8,8.4863e-02_r8,6.7917e-02_r8,5.1000e-02_r8, & + &3.4100e-02_r8,1.7211e-02_r8,1.0366e-04_r8/) + kao(:, 3,13, 4) = (/ & + &1.4578e-01_r8,1.2755e-01_r8,1.0936e-01_r8,9.1174e-02_r8,7.3030e-02_r8,5.4868e-02_r8, & + &3.6725e-02_r8,1.8584e-02_r8,2.4417e-04_r8/) + kao(:, 4,13, 4) = (/ & + &1.5300e-01_r8,1.3393e-01_r8,1.1485e-01_r8,9.5797e-02_r8,7.6755e-02_r8,5.7691e-02_r8, & + &3.8700e-02_r8,1.9588e-02_r8,3.9463e-04_r8/) + kao(:, 5,13, 4) = (/ & + &1.5948e-01_r8,1.3959e-01_r8,1.1975e-01_r8,9.9939e-02_r8,8.0103e-02_r8,6.0267e-02_r8, & + &4.0442e-02_r8,2.0476e-02_r8,5.2489e-04_r8/) + kao(:, 1, 1, 5) = (/ & + &3.0730e-04_r8,4.0869e-04_r8,4.2558e-04_r8,4.1836e-04_r8,3.9519e-04_r8,3.6372e-04_r8, & + &2.8694e-04_r8,2.6584e-04_r8,2.1801e-04_r8/) + kao(:, 2, 1, 5) = (/ & + &3.2538e-04_r8,4.3862e-04_r8,4.6062e-04_r8,4.5800e-04_r8,4.4348e-04_r8,4.2125e-04_r8, & + &3.6505e-04_r8,3.2613e-04_r8,2.9396e-04_r8/) + kao(:, 3, 1, 5) = (/ & + &3.3965e-04_r8,4.6778e-04_r8,5.0124e-04_r8,5.0588e-04_r8,5.0627e-04_r8,4.8837e-04_r8, & + &4.4591e-04_r8,3.9091e-04_r8,3.8601e-04_r8/) + kao(:, 4, 1, 5) = (/ & + &3.5305e-04_r8,5.0005e-04_r8,5.4810e-04_r8,5.6545e-04_r8,5.7634e-04_r8,5.6350e-04_r8, & + &5.3398e-04_r8,4.9322e-04_r8,4.9703e-04_r8/) + kao(:, 5, 1, 5) = (/ & + &3.6843e-04_r8,5.3559e-04_r8,6.0074e-04_r8,6.3388e-04_r8,6.5476e-04_r8,6.5121e-04_r8, & + &6.3615e-04_r8,6.1596e-04_r8,6.2900e-04_r8/) + kao(:, 1, 2, 5) = (/ & + &4.2086e-04_r8,5.1417e-04_r8,5.1972e-04_r8,4.9790e-04_r8,4.6126e-04_r8,4.1005e-04_r8, & + &3.3841e-04_r8,2.3086e-04_r8,1.8396e-04_r8/) + kao(:, 2, 2, 5) = (/ & + &4.4142e-04_r8,5.4838e-04_r8,5.5918e-04_r8,5.4271e-04_r8,5.1015e-04_r8,4.6371e-04_r8, & + &3.9686e-04_r8,2.8420e-04_r8,2.4486e-04_r8/) + kao(:, 3, 2, 5) = (/ & + &4.6438e-04_r8,5.8432e-04_r8,6.0102e-04_r8,5.9651e-04_r8,5.6920e-04_r8,5.3041e-04_r8, & + &4.5976e-04_r8,3.7342e-04_r8,3.2265e-04_r8/) + kao(:, 4, 2, 5) = (/ & + &4.8279e-04_r8,6.2418e-04_r8,6.4960e-04_r8,6.5695e-04_r8,6.3988e-04_r8,6.0274e-04_r8, & + &5.3017e-04_r8,4.6801e-04_r8,4.1702e-04_r8/) + kao(:, 5, 2, 5) = (/ & + &4.9938e-04_r8,6.6314e-04_r8,7.0911e-04_r8,7.2552e-04_r8,7.1847e-04_r8,6.8356e-04_r8, & + &6.1801e-04_r8,5.7242e-04_r8,5.3937e-04_r8/) + kao(:, 1, 3, 5) = (/ & + &7.5073e-04_r8,8.1743e-04_r8,7.9414e-04_r8,7.4039e-04_r8,6.6425e-04_r8,5.6902e-04_r8, & + &4.5211e-04_r8,2.9071e-04_r8,1.7629e-04_r8/) + kao(:, 2, 3, 5) = (/ & + &7.9242e-04_r8,8.7156e-04_r8,8.5005e-04_r8,8.0165e-04_r8,7.1947e-04_r8,6.2467e-04_r8, & + &5.0816e-04_r8,3.5038e-04_r8,2.3642e-04_r8/) + kao(:, 3, 3, 5) = (/ & + &8.3043e-04_r8,9.2555e-04_r8,9.1453e-04_r8,8.6093e-04_r8,7.8464e-04_r8,6.9275e-04_r8, & + &5.7807e-04_r8,4.1288e-04_r8,3.0691e-04_r8/) + kao(:, 4, 3, 5) = (/ & + &8.6053e-04_r8,9.7674e-04_r8,9.7765e-04_r8,9.2813e-04_r8,8.5853e-04_r8,7.7377e-04_r8, & + &6.5702e-04_r8,4.8317e-04_r8,3.9911e-04_r8/) + kao(:, 5, 3, 5) = (/ & + &8.9084e-04_r8,1.0351e-03_r8,1.0435e-03_r8,1.0049e-03_r8,9.4814e-04_r8,8.6574e-04_r8, & + &7.4637e-04_r8,5.6491e-04_r8,5.0649e-04_r8/) + kao(:, 1, 4, 5) = (/ & + &1.3691e-03_r8,1.3420e-03_r8,1.2789e-03_r8,1.1571e-03_r8,1.0054e-03_r8,8.3457e-04_r8, & + &6.3859e-04_r8,4.0761e-04_r8,1.5090e-04_r8/) + kao(:, 2, 4, 5) = (/ & + &1.4497e-03_r8,1.4458e-03_r8,1.3693e-03_r8,1.2399e-03_r8,1.0886e-03_r8,9.0944e-04_r8, & + &6.9922e-04_r8,4.5891e-04_r8,2.1864e-04_r8/) + kao(:, 3, 4, 5) = (/ & + &1.5092e-03_r8,1.5288e-03_r8,1.4492e-03_r8,1.3231e-03_r8,1.1702e-03_r8,9.8222e-04_r8, & + &7.7013e-04_r8,5.2474e-04_r8,3.0407e-04_r8/) + kao(:, 4, 4, 5) = (/ & + &1.5602e-03_r8,1.6068e-03_r8,1.5312e-03_r8,1.4087e-03_r8,1.2594e-03_r8,1.0655e-03_r8, & + &8.5735e-04_r8,5.9578e-04_r8,3.9268e-04_r8/) + kao(:, 5, 4, 5) = (/ & + &1.6108e-03_r8,1.6853e-03_r8,1.6164e-03_r8,1.5057e-03_r8,1.3492e-03_r8,1.1682e-03_r8, & + &9.6058e-04_r8,6.7959e-04_r8,4.9525e-04_r8/) + kao(:, 1, 5, 5) = (/ & + &2.3434e-03_r8,2.1631e-03_r8,1.9859e-03_r8,1.7683e-03_r8,1.5141e-03_r8,1.2226e-03_r8, & + &8.9923e-04_r8,5.4477e-04_r8,1.2575e-04_r8/) + kao(:, 2, 5, 5) = (/ & + &2.4752e-03_r8,2.3171e-03_r8,2.1360e-03_r8,1.9016e-03_r8,1.6214e-03_r8,1.3108e-03_r8, & + &9.7831e-04_r8,5.9705e-04_r8,1.8419e-04_r8/) + kao(:, 3, 5, 5) = (/ & + &2.5685e-03_r8,2.4387e-03_r8,2.2507e-03_r8,2.0028e-03_r8,1.7171e-03_r8,1.4030e-03_r8, & + &1.0542e-03_r8,6.5942e-04_r8,2.6114e-04_r8/) + kao(:, 4, 5, 5) = (/ & + &2.6469e-03_r8,2.5385e-03_r8,2.3599e-03_r8,2.1047e-03_r8,1.8139e-03_r8,1.4974e-03_r8, & + &1.1404e-03_r8,7.3650e-04_r8,3.6173e-04_r8/) + kao(:, 5, 5, 5) = (/ & + &2.7111e-03_r8,2.6448e-03_r8,2.4645e-03_r8,2.2107e-03_r8,1.9222e-03_r8,1.6048e-03_r8, & + &1.2367e-03_r8,8.2822e-04_r8,4.7124e-04_r8/) + kao(:, 1, 6, 5) = (/ & + &3.6870e-03_r8,3.3081e-03_r8,2.9535e-03_r8,2.5781e-03_r8,2.1710e-03_r8,1.7353e-03_r8, & + &1.2527e-03_r8,7.1995e-04_r8,1.0649e-04_r8/) + kao(:, 2, 6, 5) = (/ & + &3.8867e-03_r8,3.5260e-03_r8,3.1721e-03_r8,2.7718e-03_r8,2.3392e-03_r8,1.8682e-03_r8, & + &1.3468e-03_r8,7.8719e-04_r8,1.5668e-04_r8/) + kao(:, 3, 6, 5) = (/ & + &4.0284e-03_r8,3.6872e-03_r8,3.3334e-03_r8,2.9169e-03_r8,2.4661e-03_r8,1.9733e-03_r8, & + &1.4372e-03_r8,8.5750e-04_r8,2.1580e-04_r8/) + kao(:, 4, 6, 5) = (/ & + &4.1355e-03_r8,3.8269e-03_r8,3.4723e-03_r8,3.0564e-03_r8,2.5962e-03_r8,2.0858e-03_r8, & + &1.5388e-03_r8,9.2919e-04_r8,2.8921e-04_r8/) + kao(:, 5, 6, 5) = (/ & + &4.2530e-03_r8,3.9771e-03_r8,3.6076e-03_r8,3.1973e-03_r8,2.7175e-03_r8,2.1980e-03_r8, & + &1.6503e-03_r8,1.0123e-03_r8,3.9933e-04_r8/) + kao(:, 1, 7, 5) = (/ & + &5.9303e-03_r8,5.2537e-03_r8,4.6038e-03_r8,3.9568e-03_r8,3.2763e-03_r8,2.5699e-03_r8, & + &1.8266e-03_r8,1.0238e-03_r8,9.0759e-05_r8/) + kao(:, 2, 7, 5) = (/ & + &6.2719e-03_r8,5.5854e-03_r8,4.9264e-03_r8,4.2403e-03_r8,3.5196e-03_r8,2.7643e-03_r8, & + &1.9714e-03_r8,1.1058e-03_r8,1.3173e-04_r8/) + kao(:, 3, 7, 5) = (/ & + &6.5193e-03_r8,5.8407e-03_r8,5.1576e-03_r8,4.4431e-03_r8,3.6909e-03_r8,2.9114e-03_r8, & + &2.0825e-03_r8,1.1806e-03_r8,1.8536e-04_r8/) + kao(:, 4, 7, 5) = (/ & + &6.6989e-03_r8,6.0314e-03_r8,5.3552e-03_r8,4.6281e-03_r8,3.8605e-03_r8,3.0624e-03_r8, & + &2.1992e-03_r8,1.2697e-03_r8,2.6787e-04_r8/) + kao(:, 5, 7, 5) = (/ & + &6.9450e-03_r8,6.3008e-03_r8,5.6152e-03_r8,4.8622e-03_r8,4.0675e-03_r8,3.2291e-03_r8, & + &2.3204e-03_r8,1.3675e-03_r8,3.5672e-04_r8/) + kao(:, 1, 8, 5) = (/ & + &1.1078e-02_r8,9.7294e-03_r8,8.3981e-03_r8,7.0957e-03_r8,5.7917e-03_r8,4.4718e-03_r8, & + &3.1091e-03_r8,1.6886e-03_r8,1.1294e-04_r8/) + kao(:, 2, 8, 5) = (/ & + &1.1717e-02_r8,1.0310e-02_r8,8.9257e-03_r8,7.5752e-03_r8,6.2113e-03_r8,4.8050e-03_r8, & + &3.3497e-03_r8,1.8274e-03_r8,1.4724e-04_r8/) + kao(:, 3, 8, 5) = (/ & + &1.2207e-02_r8,1.0778e-02_r8,9.3683e-03_r8,7.9668e-03_r8,6.5278e-03_r8,5.0484e-03_r8, & + &3.5310e-03_r8,1.9391e-03_r8,2.0653e-04_r8/) + kao(:, 4, 8, 5) = (/ & + &1.2674e-02_r8,1.1230e-02_r8,9.8021e-03_r8,8.3609e-03_r8,6.8807e-03_r8,5.3359e-03_r8, & + &3.7364e-03_r8,2.0615e-03_r8,2.8343e-04_r8/) + kao(:, 5, 8, 5) = (/ & + &1.3265e-02_r8,1.1790e-02_r8,1.0322e-02_r8,8.8148e-03_r8,7.2381e-03_r8,5.6108e-03_r8, & + &3.9433e-03_r8,2.1912e-03_r8,3.7254e-04_r8/) + kao(:, 1, 9, 5) = (/ & + &3.7052e-02_r8,3.2437e-02_r8,2.7835e-02_r8,2.3250e-02_r8,1.8658e-02_r8,1.4080e-02_r8, & + &9.5558e-03_r8,4.9966e-03_r8,1.9423e-04_r8/) + kao(:, 2, 9, 5) = (/ & + &3.9539e-02_r8,3.4640e-02_r8,2.9744e-02_r8,2.4857e-02_r8,1.9981e-02_r8,1.5146e-02_r8, & + &1.0322e-02_r8,5.4117e-03_r8,2.4661e-04_r8/) + kao(:, 3, 9, 5) = (/ & + &4.1918e-02_r8,3.6737e-02_r8,3.1561e-02_r8,2.6402e-02_r8,2.1269e-02_r8,1.6195e-02_r8, & + &1.1056e-02_r8,5.7963e-03_r8,3.2011e-04_r8/) + kao(:, 4, 9, 5) = (/ & + &4.4100e-02_r8,3.8673e-02_r8,3.3273e-02_r8,2.7895e-02_r8,2.2554e-02_r8,1.7214e-02_r8, & + &1.1779e-02_r8,6.1756e-03_r8,4.1260e-04_r8/) + kao(:, 5, 9, 5) = (/ & + &4.6405e-02_r8,4.0709e-02_r8,3.5073e-02_r8,2.9453e-02_r8,2.3852e-02_r8,1.8195e-02_r8, & + &1.2445e-02_r8,6.5667e-03_r8,5.2938e-04_r8/) + kao(:, 1,10, 5) = (/ & + &1.5260e-01_r8,1.3356e-01_r8,1.1452e-01_r8,9.5486e-02_r8,7.6440e-02_r8,5.7459e-02_r8, & + &3.8411e-02_r8,1.9334e-02_r8,1.8781e-04_r8/) + kao(:, 2,10, 5) = (/ & + &1.6192e-01_r8,1.4171e-01_r8,1.2154e-01_r8,1.0139e-01_r8,8.1225e-02_r8,6.1032e-02_r8, & + &4.0817e-02_r8,2.0639e-02_r8,3.0020e-04_r8/) + kao(:, 3,10, 5) = (/ & + &1.6952e-01_r8,1.4839e-01_r8,1.2731e-01_r8,1.0623e-01_r8,8.5090e-02_r8,6.3990e-02_r8, & + &4.2882e-02_r8,2.1810e-02_r8,3.7223e-04_r8/) + kao(:, 4,10, 5) = (/ & + &1.7675e-01_r8,1.5478e-01_r8,1.3285e-01_r8,1.1085e-01_r8,8.8843e-02_r8,6.6852e-02_r8, & + &4.4829e-02_r8,2.2833e-02_r8,4.6711e-04_r8/) + kao(:, 5,10, 5) = (/ & + &1.8239e-01_r8,1.5968e-01_r8,1.3704e-01_r8,1.1434e-01_r8,9.1701e-02_r8,6.9058e-02_r8, & + &4.6429e-02_r8,2.3733e-02_r8,6.6086e-04_r8/) + kao(:, 1,11, 5) = (/ & + &2.7058e-01_r8,2.3683e-01_r8,2.0302e-01_r8,1.6928e-01_r8,1.3552e-01_r8,1.0170e-01_r8, & + &6.7859e-02_r8,3.4017e-02_r8,1.5001e-04_r8/) + kao(:, 2,11, 5) = (/ & + &2.7834e-01_r8,2.4359e-01_r8,2.0889e-01_r8,1.7416e-01_r8,1.3942e-01_r8,1.0462e-01_r8, & + &6.9857e-02_r8,3.5072e-02_r8,2.9190e-04_r8/) + kao(:, 3,11, 5) = (/ & + &2.8582e-01_r8,2.5022e-01_r8,2.1462e-01_r8,1.7895e-01_r8,1.4327e-01_r8,1.0754e-01_r8, & + &7.1838e-02_r8,3.6157e-02_r8,3.9721e-04_r8/) + kao(:, 4,11, 5) = (/ & + &2.8898e-01_r8,2.5301e-01_r8,2.1700e-01_r8,1.8097e-01_r8,1.4487e-01_r8,1.0884e-01_r8, & + &7.2766e-02_r8,3.6699e-02_r8,5.3597e-04_r8/) + kao(:, 5,11, 5) = (/ & + &2.9536e-01_r8,2.5857e-01_r8,2.2177e-01_r8,1.8491e-01_r8,1.4809e-01_r8,1.1136e-01_r8, & + &7.4481e-02_r8,3.7679e-02_r8,7.1552e-04_r8/) + kao(:, 1,12, 5) = (/ & + &3.2683e-01_r8,2.8605e-01_r8,2.4525e-01_r8,2.0441e-01_r8,1.6361e-01_r8,1.2282e-01_r8, & + &8.1893e-02_r8,4.1016e-02_r8,1.4076e-04_r8/) + kao(:, 2,12, 5) = (/ & + &3.3106e-01_r8,2.8971e-01_r8,2.4839e-01_r8,2.0704e-01_r8,1.6570e-01_r8,1.2434e-01_r8, & + &8.2938e-02_r8,4.1600e-02_r8,2.8033e-04_r8/) + kao(:, 3,12, 5) = (/ & + &3.3746e-01_r8,2.9539e-01_r8,2.5326e-01_r8,2.1111e-01_r8,1.6904e-01_r8,1.2682e-01_r8, & + &8.4697e-02_r8,4.2481e-02_r8,3.8254e-04_r8/) + kao(:, 4,12, 5) = (/ & + &3.4047e-01_r8,2.9813e-01_r8,2.5560e-01_r8,2.1310e-01_r8,1.7062e-01_r8,1.2812e-01_r8, & + &8.5526e-02_r8,4.3047e-02_r8,5.1612e-04_r8/) + kao(:, 5,12, 5) = (/ & + &3.4523e-01_r8,3.0226e-01_r8,2.5919e-01_r8,2.1613e-01_r8,1.7310e-01_r8,1.3003e-01_r8, & + &8.6933e-02_r8,4.3928e-02_r8,7.3625e-04_r8/) + kao(:, 1,13, 5) = (/ & + &2.9792e-01_r8,2.6068e-01_r8,2.2349e-01_r8,1.8628e-01_r8,1.4905e-01_r8,1.1181e-01_r8, & + &7.4561e-02_r8,3.7329e-02_r8,1.5388e-04_r8/) + kao(:, 2,13, 5) = (/ & + &3.0081e-01_r8,2.6326e-01_r8,2.2566e-01_r8,1.8811e-01_r8,1.5050e-01_r8,1.1291e-01_r8, & + &7.5310e-02_r8,3.7768e-02_r8,2.8934e-04_r8/) + kao(:, 3,13, 5) = (/ & + &3.0121e-01_r8,2.6362e-01_r8,2.2602e-01_r8,1.8840e-01_r8,1.5077e-01_r8,1.1318e-01_r8, & + &7.5585e-02_r8,3.7991e-02_r8,3.3166e-04_r8/) + kao(:, 4,13, 5) = (/ & + &3.0495e-01_r8,2.6698e-01_r8,2.2888e-01_r8,1.9082e-01_r8,1.5277e-01_r8,1.1476e-01_r8, & + &7.6636e-02_r8,3.8673e-02_r8,4.6400e-04_r8/) + kao(:, 5,13, 5) = (/ & + &3.1093e-01_r8,2.7226e-01_r8,2.3342e-01_r8,1.9467e-01_r8,1.5596e-01_r8,1.1716e-01_r8, & + &7.8384e-02_r8,3.9602e-02_r8,6.9078e-04_r8/) + kao(:, 1, 1, 6) = (/ & + &6.7719e-04_r8,7.1472e-04_r8,7.1797e-04_r8,6.8628e-04_r8,6.3509e-04_r8,5.7059e-04_r8, & + &5.0987e-04_r8,3.4938e-04_r8,4.0895e-04_r8/) + kao(:, 2, 1, 6) = (/ & + &6.7482e-04_r8,7.4520e-04_r8,7.5758e-04_r8,7.4570e-04_r8,7.0620e-04_r8,6.5805e-04_r8, & + &6.1645e-04_r8,4.7281e-04_r8,5.4801e-04_r8/) + kao(:, 3, 1, 6) = (/ & + &6.7924e-04_r8,7.8313e-04_r8,8.0713e-04_r8,8.1739e-04_r8,7.9231e-04_r8,7.6723e-04_r8, & + &7.3523e-04_r8,6.1861e-04_r8,7.0683e-04_r8/) + kao(:, 4, 1, 6) = (/ & + &6.8649e-04_r8,8.2657e-04_r8,8.7129e-04_r8,9.0685e-04_r8,8.9681e-04_r8,8.9801e-04_r8, & + &8.6860e-04_r8,7.7360e-04_r8,8.9309e-04_r8/) + kao(:, 5, 1, 6) = (/ & + &6.9142e-04_r8,8.7359e-04_r8,9.5301e-04_r8,1.0075e-03_r8,1.0203e-03_r8,1.0461e-03_r8, & + &1.0218e-03_r8,9.5114e-04_r8,1.0965e-03_r8/) + kao(:, 1, 2, 6) = (/ & + &9.6029e-04_r8,9.5330e-04_r8,9.1502e-04_r8,8.4442e-04_r8,7.4240e-04_r8,6.3131e-04_r8, & + &5.2007e-04_r8,3.7829e-04_r8,3.5691e-04_r8/) + kao(:, 2, 2, 6) = (/ & + &9.5985e-04_r8,9.8942e-04_r8,9.6445e-04_r8,8.9433e-04_r8,8.0300e-04_r8,7.0134e-04_r8, & + &6.1315e-04_r8,5.0159e-04_r8,4.8663e-04_r8/) + kao(:, 3, 2, 6) = (/ & + &9.6320e-04_r8,1.0310e-03_r8,1.0191e-03_r8,9.5205e-04_r8,8.7761e-04_r8,7.9453e-04_r8, & + &7.3253e-04_r8,6.2365e-04_r8,6.4547e-04_r8/) + kao(:, 4, 2, 6) = (/ & + &9.7399e-04_r8,1.0755e-03_r8,1.0817e-03_r8,1.0333e-03_r8,9.7218e-04_r8,9.1068e-04_r8, & + &8.7686e-04_r8,7.5862e-04_r8,8.3212e-04_r8/) + kao(:, 5, 2, 6) = (/ & + &9.8138e-04_r8,1.1324e-03_r8,1.1507e-03_r8,1.1333e-03_r8,1.0937e-03_r8,1.0509e-03_r8, & + &1.0310e-03_r8,9.0559e-04_r8,1.0246e-03_r8/) + kao(:, 1, 3, 6) = (/ & + &1.8119e-03_r8,1.6817e-03_r8,1.5499e-03_r8,1.3740e-03_r8,1.1743e-03_r8,9.5554e-04_r8, & + &7.1656e-04_r8,4.7034e-04_r8,2.9777e-04_r8/) + kao(:, 2, 3, 6) = (/ & + &1.8107e-03_r8,1.7310e-03_r8,1.6189e-03_r8,1.4391e-03_r8,1.2510e-03_r8,1.0204e-03_r8, & + &7.8709e-04_r8,5.5271e-04_r8,4.0666e-04_r8/) + kao(:, 3, 3, 6) = (/ & + &1.8217e-03_r8,1.7823e-03_r8,1.6795e-03_r8,1.5235e-03_r8,1.3331e-03_r8,1.1033e-03_r8, & + &8.7727e-04_r8,6.6343e-04_r8,5.5347e-04_r8/) + kao(:, 4, 3, 6) = (/ & + &1.8325e-03_r8,1.8451e-03_r8,1.7507e-03_r8,1.6178e-03_r8,1.4289e-03_r8,1.2102e-03_r8, & + &9.9121e-04_r8,7.9875e-04_r8,7.2923e-04_r8/) + kao(:, 5, 3, 6) = (/ & + &1.8499e-03_r8,1.9065e-03_r8,1.8500e-03_r8,1.7218e-03_r8,1.5483e-03_r8,1.3411e-03_r8, & + &1.1326e-03_r8,9.4539e-04_r8,9.3725e-04_r8/) + kao(:, 1, 4, 6) = (/ & + &3.4114e-03_r8,3.0491e-03_r8,2.7140e-03_r8,2.3662e-03_r8,1.9783e-03_r8,1.5658e-03_r8, & + &1.1300e-03_r8,6.5946e-04_r8,2.6201e-04_r8/) + kao(:, 2, 4, 6) = (/ & + &3.4376e-03_r8,3.0989e-03_r8,2.7962e-03_r8,2.4537e-03_r8,2.0666e-03_r8,1.6491e-03_r8, & + &1.2098e-03_r8,7.2995e-04_r8,3.5441e-04_r8/) + kao(:, 3, 4, 6) = (/ & + &3.4485e-03_r8,3.1733e-03_r8,2.8848e-03_r8,2.5421e-03_r8,2.1715e-03_r8,1.7580e-03_r8, & + &1.3056e-03_r8,8.1745e-04_r8,4.7057e-04_r8/) + kao(:, 4, 4, 6) = (/ & + &3.4770e-03_r8,3.2632e-03_r8,3.0027e-03_r8,2.6508e-03_r8,2.2906e-03_r8,1.8839e-03_r8, & + &1.4242e-03_r8,9.3156e-04_r8,6.1906e-04_r8/) + kao(:, 5, 4, 6) = (/ & + &3.5195e-03_r8,3.3661e-03_r8,3.1261e-03_r8,2.7792e-03_r8,2.4277e-03_r8,2.0261e-03_r8, & + &1.5634e-03_r8,1.0703e-03_r8,8.1465e-04_r8/) + kao(:, 1, 5, 6) = (/ & + &5.7502e-03_r8,5.0807e-03_r8,4.4217e-03_r8,3.7897e-03_r8,3.1287e-03_r8,2.4547e-03_r8, & + &1.7341e-03_r8,9.6239e-04_r8,2.4204e-04_r8/) + kao(:, 2, 5, 6) = (/ & + &5.7894e-03_r8,5.1466e-03_r8,4.5231e-03_r8,3.9026e-03_r8,3.2431e-03_r8,2.5561e-03_r8, & + &1.8209e-03_r8,1.0387e-03_r8,3.3073e-04_r8/) + kao(:, 3, 5, 6) = (/ & + &5.8510e-03_r8,5.2408e-03_r8,4.6666e-03_r8,4.0479e-03_r8,3.3863e-03_r8,2.6690e-03_r8, & + &1.9231e-03_r8,1.1318e-03_r8,4.4023e-04_r8/) + kao(:, 4, 5, 6) = (/ & + &5.9488e-03_r8,5.3756e-03_r8,4.8127e-03_r8,4.2175e-03_r8,3.5437e-03_r8,2.8108e-03_r8, & + &2.0541e-03_r8,1.2413e-03_r8,5.7017e-04_r8/) + kao(:, 5, 5, 6) = (/ & + &6.0632e-03_r8,5.5286e-03_r8,4.9850e-03_r8,4.3894e-03_r8,3.7125e-03_r8,2.9737e-03_r8, & + &2.2202e-03_r8,1.3784e-03_r8,7.3804e-04_r8/) + kao(:, 1, 6, 6) = (/ & + &9.0144e-03_r8,7.9241e-03_r8,6.8389e-03_r8,5.7807e-03_r8,4.7224e-03_r8,3.6386e-03_r8, & + &2.5487e-03_r8,1.3755e-03_r8,2.0268e-04_r8/) + kao(:, 2, 6, 6) = (/ & + &9.0405e-03_r8,7.9650e-03_r8,6.9105e-03_r8,5.8762e-03_r8,4.8286e-03_r8,3.7488e-03_r8, & + &2.6372e-03_r8,1.4443e-03_r8,2.8152e-04_r8/) + kao(:, 3, 6, 6) = (/ & + &9.2000e-03_r8,8.1570e-03_r8,7.1089e-03_r8,6.0851e-03_r8,5.0081e-03_r8,3.9064e-03_r8, & + &2.7603e-03_r8,1.5330e-03_r8,3.9833e-04_r8/) + kao(:, 4, 6, 6) = (/ & + &9.3676e-03_r8,8.3397e-03_r8,7.3293e-03_r8,6.2884e-03_r8,5.2172e-03_r8,4.0838e-03_r8, & + &2.8967e-03_r8,1.6576e-03_r8,5.5504e-04_r8/) + kao(:, 5, 6, 6) = (/ & + &9.5404e-03_r8,8.5459e-03_r8,7.5717e-03_r8,6.5076e-03_r8,5.4312e-03_r8,4.2828e-03_r8, & + &3.0616e-03_r8,1.8170e-03_r8,7.2861e-04_r8/) + kao(:, 1, 7, 6) = (/ & + &1.4907e-02_r8,1.3059e-02_r8,1.1219e-02_r8,9.3912e-03_r8,7.6074e-03_r8,5.8006e-03_r8, & + &3.9637e-03_r8,2.0976e-03_r8,1.8870e-04_r8/) + kao(:, 2, 7, 6) = (/ & + &1.4960e-02_r8,1.3123e-02_r8,1.1304e-02_r8,9.5034e-03_r8,7.7189e-03_r8,5.9029e-03_r8, & + &4.0714e-03_r8,2.1752e-03_r8,2.5278e-04_r8/) + kao(:, 3, 7, 6) = (/ & + &1.5077e-02_r8,1.3255e-02_r8,1.1479e-02_r8,9.6943e-03_r8,7.9204e-03_r8,6.0871e-03_r8, & + &4.2229e-03_r8,2.2784e-03_r8,3.4866e-04_r8/) + kao(:, 4, 7, 6) = (/ & + &1.5413e-02_r8,1.3606e-02_r8,1.1805e-02_r8,1.0016e-02_r8,8.1764e-03_r8,6.3063e-03_r8, & + &4.3884e-03_r8,2.3906e-03_r8,4.7884e-04_r8/) + kao(:, 5, 7, 6) = (/ & + &1.5640e-02_r8,1.3874e-02_r8,1.2089e-02_r8,1.0323e-02_r8,8.4660e-03_r8,6.5392e-03_r8, & + &4.5932e-03_r8,2.5421e-03_r8,6.8588e-04_r8/) + kao(:, 1, 8, 6) = (/ & + &2.8559e-02_r8,2.4997e-02_r8,2.1448e-02_r8,1.7898e-02_r8,1.4352e-02_r8,1.0840e-02_r8, & + &7.3538e-03_r8,3.7976e-03_r8,1.9487e-04_r8/) + kao(:, 2, 8, 6) = (/ & + &2.8738e-02_r8,2.5172e-02_r8,2.1609e-02_r8,1.8050e-02_r8,1.4521e-02_r8,1.1028e-02_r8, & + &7.4791e-03_r8,3.8937e-03_r8,2.5597e-04_r8/) + kao(:, 3, 8, 6) = (/ & + &2.9088e-02_r8,2.5505e-02_r8,2.1920e-02_r8,1.8369e-02_r8,1.4844e-02_r8,1.1305e-02_r8, & + &7.7085e-03_r8,4.0334e-03_r8,3.3647e-04_r8/) + kao(:, 4, 8, 6) = (/ & + &2.9471e-02_r8,2.5866e-02_r8,2.2282e-02_r8,1.8723e-02_r8,1.5191e-02_r8,1.1604e-02_r8, & + &7.9478e-03_r8,4.2092e-03_r8,4.5107e-04_r8/) + kao(:, 5, 8, 6) = (/ & + &2.9965e-02_r8,2.6334e-02_r8,2.2760e-02_r8,1.9185e-02_r8,1.5605e-02_r8,1.1940e-02_r8, & + &8.2260e-03_r8,4.4031e-03_r8,6.3668e-04_r8/) + kao(:, 1, 9, 6) = (/ & + &1.0333e-01_r8,9.0409e-02_r8,7.7506e-02_r8,6.4597e-02_r8,5.1717e-02_r8,3.8817e-02_r8, & + &2.5905e-02_r8,1.3064e-02_r8,2.4712e-04_r8/) + kao(:, 2, 9, 6) = (/ & + &1.0373e-01_r8,9.0771e-02_r8,7.7825e-02_r8,6.4896e-02_r8,5.1961e-02_r8,3.9016e-02_r8, & + &2.6085e-02_r8,1.3262e-02_r8,3.3832e-04_r8/) + kao(:, 3, 9, 6) = (/ & + &1.0493e-01_r8,9.1818e-02_r8,7.8786e-02_r8,6.5718e-02_r8,5.2648e-02_r8,3.9574e-02_r8, & + &2.6569e-02_r8,1.3576e-02_r8,4.4601e-04_r8/) + kao(:, 4, 9, 6) = (/ & + &1.0587e-01_r8,9.2691e-02_r8,7.9566e-02_r8,6.6407e-02_r8,5.3246e-02_r8,4.0117e-02_r8, & + &2.7043e-02_r8,1.3891e-02_r8,5.4826e-04_r8/) + kao(:, 5, 9, 6) = (/ & + &1.0759e-01_r8,9.4255e-02_r8,8.0925e-02_r8,6.7610e-02_r8,5.4300e-02_r8,4.1036e-02_r8, & + &2.7792e-02_r8,1.4265e-02_r8,6.4886e-04_r8/) + kao(:, 1,10, 6) = (/ & + &3.9062e-01_r8,3.4177e-01_r8,2.9293e-01_r8,2.4412e-01_r8,1.9530e-01_r8,1.4643e-01_r8, & + &9.7639e-02_r8,4.8848e-02_r8,1.4547e-04_r8/) + kao(:, 2,10, 6) = (/ & + &3.9313e-01_r8,3.4397e-01_r8,2.9486e-01_r8,2.4569e-01_r8,1.9653e-01_r8,1.4745e-01_r8, & + &9.8352e-02_r8,4.9236e-02_r8,2.6944e-04_r8/) + kao(:, 3,10, 6) = (/ & + &3.9636e-01_r8,3.4679e-01_r8,2.9726e-01_r8,2.4770e-01_r8,1.9822e-01_r8,1.4872e-01_r8, & + &9.9231e-02_r8,4.9728e-02_r8,4.9543e-04_r8/) + kao(:, 4,10, 6) = (/ & + &4.0190e-01_r8,3.5169e-01_r8,3.0137e-01_r8,2.5124e-01_r8,2.0112e-01_r8,1.5095e-01_r8, & + &1.0079e-01_r8,5.0721e-02_r8,7.4715e-04_r8/) + kao(:, 5,10, 6) = (/ & + &4.1118e-01_r8,3.5981e-01_r8,3.0844e-01_r8,2.5722e-01_r8,2.0591e-01_r8,1.5462e-01_r8, & + &1.0334e-01_r8,5.2226e-02_r8,1.0737e-03_r8/) + kao(:, 1,11, 6) = (/ & + &5.2843e-01_r8,4.6229e-01_r8,3.9627e-01_r8,3.3017e-01_r8,2.6411e-01_r8,1.9813e-01_r8, & + &1.3214e-01_r8,6.6158e-02_r8,1.5345e-04_r8/) + kao(:, 2,11, 6) = (/ & + &5.2350e-01_r8,4.5807e-01_r8,3.9260e-01_r8,3.2718e-01_r8,2.6177e-01_r8,1.9641e-01_r8, & + &1.3106e-01_r8,6.5668e-02_r8,2.3814e-04_r8/) + kao(:, 3,11, 6) = (/ & + &5.2048e-01_r8,4.5536e-01_r8,3.9029e-01_r8,3.2525e-01_r8,2.6032e-01_r8,1.9539e-01_r8, & + &1.3041e-01_r8,6.5403e-02_r8,4.8642e-04_r8/) + kao(:, 4,11, 6) = (/ & + &5.2442e-01_r8,4.5878e-01_r8,3.9329e-01_r8,3.2791e-01_r8,2.6245e-01_r8,1.9699e-01_r8, & + &1.3158e-01_r8,6.6140e-02_r8,7.7713e-04_r8/) + kao(:, 5,11, 6) = (/ & + &5.3645e-01_r8,4.6936e-01_r8,4.0243e-01_r8,3.3557e-01_r8,2.6862e-01_r8,2.0159e-01_r8, & + &1.3470e-01_r8,6.7828e-02_r8,1.0827e-03_r8/) + kao(:, 1,12, 6) = (/ & + &5.9047e-01_r8,5.1664e-01_r8,4.4278e-01_r8,3.6903e-01_r8,2.9521e-01_r8,2.2135e-01_r8, & + &1.4776e-01_r8,7.3993e-02_r8,1.4236e-04_r8/) + kao(:, 2,12, 6) = (/ & + &5.8585e-01_r8,5.1270e-01_r8,4.3944e-01_r8,3.6623e-01_r8,2.9300e-01_r8,2.1996e-01_r8, & + &1.4676e-01_r8,7.3476e-02_r8,2.2023e-04_r8/) + kao(:, 3,12, 6) = (/ & + &5.7367e-01_r8,5.0194e-01_r8,4.3031e-01_r8,3.5876e-01_r8,2.8718e-01_r8,2.1559e-01_r8, & + &1.4380e-01_r8,7.2153e-02_r8,4.4743e-04_r8/) + kao(:, 4,12, 6) = (/ & + &5.7511e-01_r8,5.0312e-01_r8,4.3146e-01_r8,3.5985e-01_r8,2.8795e-01_r8,2.1609e-01_r8, & + &1.4436e-01_r8,7.2515e-02_r8,8.0036e-04_r8/) + kao(:, 5,12, 6) = (/ & + &5.8792e-01_r8,5.1441e-01_r8,4.4120e-01_r8,3.6789e-01_r8,2.9440e-01_r8,2.2104e-01_r8, & + &1.4769e-01_r8,7.4288e-02_r8,1.0818e-03_r8/) + kao(:, 1,13, 6) = (/ & + &5.2587e-01_r8,4.6012e-01_r8,3.9434e-01_r8,3.2864e-01_r8,2.6295e-01_r8,1.9729e-01_r8, & + &1.3161e-01_r8,6.5880e-02_r8,1.1855e-04_r8/) + kao(:, 2,13, 6) = (/ & + &5.1655e-01_r8,4.5203e-01_r8,3.8739e-01_r8,3.2291e-01_r8,2.5848e-01_r8,1.9395e-01_r8, & + &1.2940e-01_r8,6.4811e-02_r8,1.8738e-04_r8/) + kao(:, 3,13, 6) = (/ & + &5.1454e-01_r8,4.5033e-01_r8,3.8607e-01_r8,3.2190e-01_r8,2.5767e-01_r8,1.9330e-01_r8, & + &1.2903e-01_r8,6.4719e-02_r8,4.6442e-04_r8/) + kao(:, 4,13, 6) = (/ & + &5.2306e-01_r8,4.5763e-01_r8,3.9250e-01_r8,3.2722e-01_r8,2.6190e-01_r8,1.9661e-01_r8, & + &1.3127e-01_r8,6.5873e-02_r8,7.3146e-04_r8/) + kao(:, 5,13, 6) = (/ & + &5.3732e-01_r8,4.7035e-01_r8,4.0337e-01_r8,3.3620e-01_r8,2.6904e-01_r8,2.0206e-01_r8, & + &1.3501e-01_r8,6.8074e-02_r8,1.0136e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &1.2103e-03_r8,1.2175e-03_r8,1.1935e-03_r8,1.1549e-03_r8,1.0791e-03_r8,9.5598e-04_r8, & + &8.1255e-04_r8,6.1193e-04_r8,6.2180e-04_r8/) + kao(:, 2, 1, 7) = (/ & + &1.2178e-03_r8,1.2781e-03_r8,1.2880e-03_r8,1.2578e-03_r8,1.2013e-03_r8,1.0898e-03_r8, & + &9.4696e-04_r8,8.3333e-04_r8,8.1545e-04_r8/) + kao(:, 3, 1, 7) = (/ & + &1.2282e-03_r8,1.3405e-03_r8,1.3881e-03_r8,1.3716e-03_r8,1.3394e-03_r8,1.2381e-03_r8, & + &1.1125e-03_r8,1.0711e-03_r8,1.0876e-03_r8/) + kao(:, 4, 1, 7) = (/ & + &1.2403e-03_r8,1.4084e-03_r8,1.4922e-03_r8,1.5029e-03_r8,1.4913e-03_r8,1.4226e-03_r8, & + &1.3116e-03_r8,1.3637e-03_r8,1.4095e-03_r8/) + kao(:, 5, 1, 7) = (/ & + &1.2587e-03_r8,1.4782e-03_r8,1.5894e-03_r8,1.6533e-03_r8,1.6739e-03_r8,1.6196e-03_r8, & + &1.5433e-03_r8,1.7053e-03_r8,1.8020e-03_r8/) + kao(:, 1, 2, 7) = (/ & + &1.5958e-03_r8,1.5396e-03_r8,1.4781e-03_r8,1.3976e-03_r8,1.2942e-03_r8,1.1273e-03_r8, & + &9.3307e-04_r8,7.0021e-04_r8,6.0904e-04_r8/) + kao(:, 2, 2, 7) = (/ & + &1.6176e-03_r8,1.6176e-03_r8,1.5750e-03_r8,1.5193e-03_r8,1.4296e-03_r8,1.2725e-03_r8, & + &1.0674e-03_r8,8.4851e-04_r8,7.7411e-04_r8/) + kao(:, 3, 2, 7) = (/ & + &1.6471e-03_r8,1.6851e-03_r8,1.6807e-03_r8,1.6583e-03_r8,1.5791e-03_r8,1.4314e-03_r8, & + &1.2293e-03_r8,1.0317e-03_r8,9.9584e-04_r8/) + kao(:, 4, 2, 7) = (/ & + &1.6650e-03_r8,1.7627e-03_r8,1.7970e-03_r8,1.8046e-03_r8,1.7334e-03_r8,1.6113e-03_r8, & + &1.4228e-03_r8,1.2451e-03_r8,1.2394e-03_r8/) + kao(:, 5, 2, 7) = (/ & + &1.7122e-03_r8,1.8558e-03_r8,1.9287e-03_r8,1.9533e-03_r8,1.9037e-03_r8,1.8293e-03_r8, & + &1.6473e-03_r8,1.5087e-03_r8,1.5795e-03_r8/) + kao(:, 1, 3, 7) = (/ & + &2.9351e-03_r8,2.6534e-03_r8,2.4324e-03_r8,2.1954e-03_r8,1.9158e-03_r8,1.6076e-03_r8, & + &1.2520e-03_r8,8.5789e-04_r8,6.1375e-04_r8/) + kao(:, 2, 3, 7) = (/ & + &2.9633e-03_r8,2.7281e-03_r8,2.5348e-03_r8,2.3132e-03_r8,2.0567e-03_r8,1.7614e-03_r8, & + &1.4143e-03_r8,9.9890e-04_r8,7.9742e-04_r8/) + kao(:, 3, 3, 7) = (/ & + &3.0018e-03_r8,2.8266e-03_r8,2.6658e-03_r8,2.4521e-03_r8,2.2182e-03_r8,1.9505e-03_r8, & + &1.5883e-03_r8,1.1664e-03_r8,9.9661e-04_r8/) + kao(:, 4, 3, 7) = (/ & + &3.0730e-03_r8,2.9520e-03_r8,2.8043e-03_r8,2.6204e-03_r8,2.4182e-03_r8,2.1521e-03_r8, & + &1.7967e-03_r8,1.3650e-03_r8,1.2315e-03_r8/) + kao(:, 5, 3, 7) = (/ & + &3.1816e-03_r8,3.1107e-03_r8,2.9552e-03_r8,2.8080e-03_r8,2.6346e-03_r8,2.3544e-03_r8, & + &2.0373e-03_r8,1.6039e-03_r8,1.5090e-03_r8/) + kao(:, 1, 4, 7) = (/ & + &5.7269e-03_r8,5.0918e-03_r8,4.4466e-03_r8,3.8641e-03_r8,3.2580e-03_r8,2.6083e-03_r8, & + &1.8965e-03_r8,1.1416e-03_r8,5.7204e-04_r8/) + kao(:, 2, 4, 7) = (/ & + &5.7492e-03_r8,5.1587e-03_r8,4.5741e-03_r8,4.0239e-03_r8,3.4230e-03_r8,2.7638e-03_r8, & + &2.0485e-03_r8,1.2804e-03_r8,7.6092e-04_r8/) + kao(:, 3, 4, 7) = (/ & + &5.8525e-03_r8,5.2748e-03_r8,4.7562e-03_r8,4.2073e-03_r8,3.6092e-03_r8,2.9384e-03_r8, & + &2.2265e-03_r8,1.4580e-03_r8,9.9771e-04_r8/) + kao(:, 4, 4, 7) = (/ & + &5.9797e-03_r8,5.4326e-03_r8,4.9495e-03_r8,4.4248e-03_r8,3.8014e-03_r8,3.1433e-03_r8, & + &2.4307e-03_r8,1.6612e-03_r8,1.3149e-03_r8/) + kao(:, 5, 4, 7) = (/ & + &6.1647e-03_r8,5.6540e-03_r8,5.1948e-03_r8,4.6848e-03_r8,4.0444e-03_r8,3.3860e-03_r8, & + &2.6695e-03_r8,1.9106e-03_r8,1.6620e-03_r8/) + kao(:, 1, 5, 7) = (/ & + &1.0220e-02_r8,9.0008e-03_r8,7.7868e-03_r8,6.5817e-03_r8,5.4248e-03_r8,4.2290e-03_r8, & + &3.0009e-03_r8,1.6787e-03_r8,5.3957e-04_r8/) + kao(:, 2, 5, 7) = (/ & + &1.0367e-02_r8,9.1668e-03_r8,7.9693e-03_r8,6.7850e-03_r8,5.6408e-03_r8,4.4280e-03_r8, & + &3.1863e-03_r8,1.8183e-03_r8,7.0339e-04_r8/) + kao(:, 3, 5, 7) = (/ & + &1.0581e-02_r8,9.4102e-03_r8,8.2049e-03_r8,7.0786e-03_r8,5.9001e-03_r8,4.6839e-03_r8, & + &3.3914e-03_r8,1.9878e-03_r8,9.2591e-04_r8/) + kao(:, 4, 5, 7) = (/ & + &1.0809e-02_r8,9.6775e-03_r8,8.5132e-03_r8,7.3701e-03_r8,6.2042e-03_r8,4.9938e-03_r8, & + &3.6238e-03_r8,2.1871e-03_r8,1.1943e-03_r8/) + kao(:, 5, 5, 7) = (/ & + &1.1112e-02_r8,1.0026e-02_r8,8.9250e-03_r8,7.7808e-03_r8,6.5932e-03_r8,5.3151e-03_r8, & + &3.9019e-03_r8,2.4156e-03_r8,1.5529e-03_r8/) + kao(:, 1, 6, 7) = (/ & + &1.6720e-02_r8,1.4665e-02_r8,1.2615e-02_r8,1.0575e-02_r8,8.5627e-03_r8,6.5744e-03_r8, & + &4.5286e-03_r8,2.4830e-03_r8,5.6458e-04_r8/) + kao(:, 2, 6, 7) = (/ & + &1.7104e-02_r8,1.5034e-02_r8,1.2975e-02_r8,1.0925e-02_r8,8.9009e-03_r8,6.8822e-03_r8, & + &4.7999e-03_r8,2.6619e-03_r8,7.2679e-04_r8/) + kao(:, 3, 6, 7) = (/ & + &1.7534e-02_r8,1.5438e-02_r8,1.3395e-02_r8,1.1323e-02_r8,9.3166e-03_r8,7.2349e-03_r8, & + &5.0972e-03_r8,2.8734e-03_r8,9.0147e-04_r8/) + kao(:, 4, 6, 7) = (/ & + &1.8091e-02_r8,1.6011e-02_r8,1.3940e-02_r8,1.1869e-02_r8,9.7728e-03_r8,7.6440e-03_r8, & + &5.4515e-03_r8,3.0818e-03_r8,1.1288e-03_r8/) + kao(:, 5, 6, 7) = (/ & + &1.8583e-02_r8,1.6530e-02_r8,1.4432e-02_r8,1.2438e-02_r8,1.0309e-02_r8,8.1409e-03_r8, & + &5.8462e-03_r8,3.3346e-03_r8,1.4293e-03_r8/) + kao(:, 1, 7, 7) = (/ & + &2.7982e-02_r8,2.4501e-02_r8,2.1043e-02_r8,1.7577e-02_r8,1.4110e-02_r8,1.0697e-02_r8, & + &7.3114e-03_r8,3.8393e-03_r8,5.1721e-04_r8/) + kao(:, 2, 7, 7) = (/ & + &2.8730e-02_r8,2.5189e-02_r8,2.1653e-02_r8,1.8120e-02_r8,1.4619e-02_r8,1.1160e-02_r8, & + &7.6475e-03_r8,4.0900e-03_r8,6.8268e-04_r8/) + kao(:, 3, 7, 7) = (/ & + &2.9602e-02_r8,2.5984e-02_r8,2.2367e-02_r8,1.8790e-02_r8,1.5226e-02_r8,1.1688e-02_r8, & + &8.0684e-03_r8,4.3672e-03_r8,8.7865e-04_r8/) + kao(:, 4, 7, 7) = (/ & + &3.0383e-02_r8,2.6722e-02_r8,2.3100e-02_r8,1.9474e-02_r8,1.5890e-02_r8,1.2270e-02_r8, & + &8.5486e-03_r8,4.6828e-03_r8,1.1058e-03_r8/) + kao(:, 5, 7, 7) = (/ & + &3.1027e-02_r8,2.7319e-02_r8,2.3722e-02_r8,2.0052e-02_r8,1.6464e-02_r8,1.2803e-02_r8, & + &9.0257e-03_r8,5.0413e-03_r8,1.3701e-03_r8/) + kao(:, 1, 8, 7) = (/ & + &5.4825e-02_r8,4.7970e-02_r8,4.1147e-02_r8,3.4322e-02_r8,2.7487e-02_r8,2.0656e-02_r8, & + &1.3854e-02_r8,7.1281e-03_r8,4.3340e-04_r8/) + kao(:, 2, 8, 7) = (/ & + &5.6231e-02_r8,4.9217e-02_r8,4.2253e-02_r8,3.5263e-02_r8,2.8269e-02_r8,2.1292e-02_r8, & + &1.4434e-02_r8,7.4660e-03_r8,6.0870e-04_r8/) + kao(:, 3, 8, 7) = (/ & + &5.7926e-02_r8,5.0738e-02_r8,4.3579e-02_r8,3.6411e-02_r8,2.9254e-02_r8,2.2161e-02_r8, & + &1.5102e-02_r8,7.9134e-03_r8,8.5563e-04_r8/) + kao(:, 4, 8, 7) = (/ & + &5.9329e-02_r8,5.2017e-02_r8,4.4709e-02_r8,3.7445e-02_r8,3.0174e-02_r8,2.2939e-02_r8, & + &1.5732e-02_r8,8.3409e-03_r8,1.1069e-03_r8/) + kao(:, 5, 8, 7) = (/ & + &6.0706e-02_r8,5.3284e-02_r8,4.5885e-02_r8,3.8526e-02_r8,3.1172e-02_r8,2.3870e-02_r8, & + &1.6429e-02_r8,8.7694e-03_r8,1.3835e-03_r8/) + kao(:, 1, 9, 7) = (/ & + &2.0429e-01_r8,1.7875e-01_r8,1.5322e-01_r8,1.2768e-01_r8,1.0216e-01_r8,7.6684e-02_r8, & + &5.1143e-02_r8,2.5629e-02_r8,2.9263e-04_r8/) + kao(:, 2, 9, 7) = (/ & + &2.0990e-01_r8,1.8367e-01_r8,1.5743e-01_r8,1.3122e-01_r8,1.0506e-01_r8,7.8849e-02_r8, & + &5.2652e-02_r8,2.6459e-02_r8,5.6921e-04_r8/) + kao(:, 3, 9, 7) = (/ & + &2.1338e-01_r8,1.8672e-01_r8,1.6006e-01_r8,1.3349e-01_r8,1.0689e-01_r8,8.0285e-02_r8, & + &5.3664e-02_r8,2.7200e-02_r8,9.3758e-04_r8/) + kao(:, 4, 9, 7) = (/ & + &2.2002e-01_r8,1.9252e-01_r8,1.6512e-01_r8,1.3776e-01_r8,1.1035e-01_r8,8.2930e-02_r8, & + &5.5562e-02_r8,2.8342e-02_r8,1.3055e-03_r8/) + kao(:, 5, 9, 7) = (/ & + &2.2506e-01_r8,1.9692e-01_r8,1.6901e-01_r8,1.4099e-01_r8,1.1303e-01_r8,8.5078e-02_r8, & + &5.7190e-02_r8,2.9461e-02_r8,1.8874e-03_r8/) + kao(:, 1,10, 7) = (/ & + &8.3776e-01_r8,7.3310e-01_r8,6.2841e-01_r8,5.2361e-01_r8,4.1890e-01_r8,3.1415e-01_r8, & + &2.0945e-01_r8,1.0479e-01_r8,1.9258e-04_r8/) + kao(:, 2,10, 7) = (/ & + &8.5667e-01_r8,7.4964e-01_r8,6.4250e-01_r8,5.3547e-01_r8,4.2837e-01_r8,3.2129e-01_r8, & + &2.1421e-01_r8,1.0723e-01_r8,3.0052e-04_r8/) + kao(:, 3,10, 7) = (/ & + &8.7378e-01_r8,7.6452e-01_r8,6.5535e-01_r8,5.4608e-01_r8,4.3691e-01_r8,3.2776e-01_r8, & + &2.1870e-01_r8,1.0952e-01_r8,5.4766e-04_r8/) + kao(:, 4,10, 7) = (/ & + &8.9911e-01_r8,7.8666e-01_r8,6.7423e-01_r8,5.6186e-01_r8,4.4961e-01_r8,3.3744e-01_r8, & + &2.2515e-01_r8,1.1291e-01_r8,1.0571e-03_r8/) + kao(:, 5,10, 7) = (/ & + &9.2543e-01_r8,8.0983e-01_r8,6.9418e-01_r8,5.7864e-01_r8,4.6314e-01_r8,3.4767e-01_r8, & + &2.3212e-01_r8,1.1658e-01_r8,1.4779e-03_r8/) + kao(:, 1,11, 7) = (/ & + &1.1170e+00_r8,9.7735e-01_r8,8.3780e-01_r8,6.9827e-01_r8,5.5860e-01_r8,4.1894e-01_r8, & + &2.7927e-01_r8,1.3969e-01_r8,1.8784e-04_r8/) + kao(:, 2,11, 7) = (/ & + &1.1469e+00_r8,1.0035e+00_r8,8.6021e-01_r8,7.1681e-01_r8,5.7347e-01_r8,4.3009e-01_r8, & + &2.8675e-01_r8,1.4352e-01_r8,2.9142e-04_r8/) + kao(:, 3,11, 7) = (/ & + &1.1926e+00_r8,1.0436e+00_r8,8.9439e-01_r8,7.4544e-01_r8,5.9622e-01_r8,4.4725e-01_r8, & + &2.9836e-01_r8,1.4934e-01_r8,4.5203e-04_r8/) + kao(:, 4,11, 7) = (/ & + &1.2362e+00_r8,1.0816e+00_r8,9.2703e-01_r8,7.7246e-01_r8,6.1814e-01_r8,4.6378e-01_r8, & + &3.0936e-01_r8,1.5503e-01_r8,7.8924e-04_r8/) + kao(:, 5,11, 7) = (/ & + &1.2847e+00_r8,1.1241e+00_r8,9.6352e-01_r8,8.0300e-01_r8,6.4259e-01_r8,4.8242e-01_r8, & + &3.2196e-01_r8,1.6156e-01_r8,1.3839e-03_r8/) + kao(:, 1,12, 7) = (/ & + &1.0784e+00_r8,9.4374e-01_r8,8.0896e-01_r8,6.7399e-01_r8,5.3931e-01_r8,4.0450e-01_r8, & + &2.6958e-01_r8,1.3485e-01_r8,1.8250e-04_r8/) + kao(:, 2,12, 7) = (/ & + &1.1016e+00_r8,9.6383e-01_r8,8.2624e-01_r8,6.8848e-01_r8,5.5081e-01_r8,4.1305e-01_r8, & + &2.7543e-01_r8,1.3793e-01_r8,2.7118e-04_r8/) + kao(:, 3,12, 7) = (/ & + &1.1494e+00_r8,1.0057e+00_r8,8.6213e-01_r8,7.1839e-01_r8,5.7458e-01_r8,4.3099e-01_r8, & + &2.8756e-01_r8,1.4395e-01_r8,4.0903e-04_r8/) + kao(:, 4,12, 7) = (/ & + &1.1966e+00_r8,1.0468e+00_r8,8.9727e-01_r8,7.4760e-01_r8,5.9830e-01_r8,4.4892e-01_r8, & + &2.9949e-01_r8,1.5008e-01_r8,6.0710e-04_r8/) + kao(:, 5,12, 7) = (/ & + &1.2391e+00_r8,1.0842e+00_r8,9.2930e-01_r8,7.7450e-01_r8,6.1988e-01_r8,4.6531e-01_r8, & + &3.1051e-01_r8,1.5585e-01_r8,1.1075e-03_r8/) + kao(:, 1,13, 7) = (/ & + &9.1609e-01_r8,8.0170e-01_r8,6.8730e-01_r8,5.7285e-01_r8,4.5825e-01_r8,3.4365e-01_r8, & + &2.2921e-01_r8,1.1478e-01_r8,1.8534e-04_r8/) + kao(:, 2,13, 7) = (/ & + &9.2338e-01_r8,8.0782e-01_r8,6.9263e-01_r8,5.7718e-01_r8,4.6175e-01_r8,3.4635e-01_r8, & + &2.3110e-01_r8,1.1575e-01_r8,2.6985e-04_r8/) + kao(:, 3,13, 7) = (/ & + &9.4678e-01_r8,8.2823e-01_r8,7.0984e-01_r8,5.9160e-01_r8,4.7336e-01_r8,3.5526e-01_r8, & + &2.3691e-01_r8,1.1874e-01_r8,3.9189e-04_r8/) + kao(:, 4,13, 7) = (/ & + &9.5798e-01_r8,8.3839e-01_r8,7.1856e-01_r8,5.9888e-01_r8,4.7933e-01_r8,3.5969e-01_r8, & + &2.4009e-01_r8,1.2046e-01_r8,6.8070e-04_r8/) + kao(:, 5,13, 7) = (/ & + &9.7420e-01_r8,8.5221e-01_r8,7.3072e-01_r8,6.0920e-01_r8,4.8778e-01_r8,3.6616e-01_r8, & + &2.4455e-01_r8,1.2274e-01_r8,1.2004e-03_r8/) + kao(:, 1, 1, 8) = (/ & + &2.2086e-03_r8,2.0999e-03_r8,2.0159e-03_r8,1.8719e-03_r8,1.7233e-03_r8,1.5637e-03_r8, & + &1.3735e-03_r8,1.3147e-03_r8,1.3769e-03_r8/) + kao(:, 2, 1, 8) = (/ & + &2.2485e-03_r8,2.2158e-03_r8,2.1547e-03_r8,2.0369e-03_r8,1.8898e-03_r8,1.7374e-03_r8, & + &1.6006e-03_r8,1.7014e-03_r8,1.7807e-03_r8/) + kao(:, 3, 1, 8) = (/ & + &2.2803e-03_r8,2.3414e-03_r8,2.2949e-03_r8,2.2265e-03_r8,2.0601e-03_r8,1.9356e-03_r8, & + &1.8992e-03_r8,2.1518e-03_r8,2.2509e-03_r8/) + kao(:, 4, 1, 8) = (/ & + &2.3178e-03_r8,2.4462e-03_r8,2.4702e-03_r8,2.4013e-03_r8,2.2630e-03_r8,2.1680e-03_r8, & + &2.2995e-03_r8,2.6824e-03_r8,2.8243e-03_r8/) + kao(:, 5, 1, 8) = (/ & + &2.3355e-03_r8,2.5902e-03_r8,2.6514e-03_r8,2.5825e-03_r8,2.4802e-03_r8,2.5028e-03_r8, & + &2.7971e-03_r8,3.2930e-03_r8,3.4957e-03_r8/) + kao(:, 1, 2, 8) = (/ & + &3.2554e-03_r8,3.0029e-03_r8,2.8238e-03_r8,2.5475e-03_r8,2.2552e-03_r8,1.9853e-03_r8, & + &1.6584e-03_r8,1.2784e-03_r8,1.0936e-03_r8/) + kao(:, 2, 2, 8) = (/ & + &3.3021e-03_r8,3.1146e-03_r8,2.9858e-03_r8,2.7302e-03_r8,2.4455e-03_r8,2.1856e-03_r8, & + &1.8782e-03_r8,1.5376e-03_r8,1.5050e-03_r8/) + kao(:, 3, 2, 8) = (/ & + &3.3434e-03_r8,3.2633e-03_r8,3.1581e-03_r8,2.9235e-03_r8,2.6724e-03_r8,2.4236e-03_r8, & + &2.1164e-03_r8,1.8700e-03_r8,1.9615e-03_r8/) + kao(:, 4, 2, 8) = (/ & + &3.3924e-03_r8,3.4464e-03_r8,3.3467e-03_r8,3.1420e-03_r8,2.9417e-03_r8,2.6854e-03_r8, & + &2.3908e-03_r8,2.2943e-03_r8,2.5456e-03_r8/) + kao(:, 5, 2, 8) = (/ & + &3.4124e-03_r8,3.5941e-03_r8,3.5577e-03_r8,3.4139e-03_r8,3.2366e-03_r8,2.9618e-03_r8, & + &2.7452e-03_r8,2.8336e-03_r8,3.1731e-03_r8/) + kao(:, 1, 3, 8) = (/ & + &6.2310e-03_r8,5.6159e-03_r8,4.9769e-03_r8,4.4245e-03_r8,3.8289e-03_r8,3.1465e-03_r8, & + &2.4651e-03_r8,1.6762e-03_r8,1.0171e-03_r8/) + kao(:, 2, 3, 8) = (/ & + &6.3558e-03_r8,5.7885e-03_r8,5.2143e-03_r8,4.7067e-03_r8,4.0833e-03_r8,3.4041e-03_r8, & + &2.6899e-03_r8,1.9219e-03_r8,1.2943e-03_r8/) + kao(:, 3, 3, 8) = (/ & + &6.4584e-03_r8,5.9604e-03_r8,5.4819e-03_r8,4.9958e-03_r8,4.3577e-03_r8,3.6662e-03_r8, & + &2.9872e-03_r8,2.1872e-03_r8,1.6861e-03_r8/) + kao(:, 4, 3, 8) = (/ & + &6.6103e-03_r8,6.1684e-03_r8,5.8142e-03_r8,5.2903e-03_r8,4.6437e-03_r8,3.9929e-03_r8, & + &3.3051e-03_r8,2.4974e-03_r8,2.2070e-03_r8/) + kao(:, 5, 3, 8) = (/ & + &6.6588e-03_r8,6.3708e-03_r8,6.1123e-03_r8,5.6154e-03_r8,4.9949e-03_r8,4.3617e-03_r8, & + &3.6895e-03_r8,2.8582e-03_r8,2.8798e-03_r8/) + kao(:, 1, 4, 8) = (/ & + &1.1807e-02_r8,1.0450e-02_r8,9.1344e-03_r8,7.7844e-03_r8,6.5100e-03_r8,5.2593e-03_r8, & + &3.9218e-03_r8,2.4635e-03_r8,1.1324e-03_r8/) + kao(:, 2, 4, 8) = (/ & + &1.2088e-02_r8,1.0775e-02_r8,9.4615e-03_r8,8.1147e-03_r8,6.9001e-03_r8,5.6187e-03_r8, & + &4.2536e-03_r8,2.7131e-03_r8,1.3848e-03_r8/) + kao(:, 3, 4, 8) = (/ & + &1.2276e-02_r8,1.1057e-02_r8,9.7542e-03_r8,8.5429e-03_r8,7.3199e-03_r8,6.0294e-03_r8, & + &4.5931e-03_r8,3.0093e-03_r8,1.7357e-03_r8/) + kao(:, 4, 4, 8) = (/ & + &1.2505e-02_r8,1.1360e-02_r8,1.0130e-02_r8,9.0368e-03_r8,7.7990e-03_r8,6.4476e-03_r8, & + &5.0000e-03_r8,3.3597e-03_r8,2.0753e-03_r8/) + kao(:, 5, 4, 8) = (/ & + &1.2694e-02_r8,1.1662e-02_r8,1.0517e-02_r8,9.4548e-03_r8,8.2827e-03_r8,6.9233e-03_r8, & + &5.4172e-03_r8,3.7628e-03_r8,2.5678e-03_r8/) + kao(:, 1, 5, 8) = (/ & + &2.0656e-02_r8,1.8160e-02_r8,1.5700e-02_r8,1.3242e-02_r8,1.0772e-02_r8,8.3779e-03_r8, & + &6.0246e-03_r8,3.5524e-03_r8,1.1630e-03_r8/) + kao(:, 2, 5, 8) = (/ & + &2.0910e-02_r8,1.8437e-02_r8,1.6005e-02_r8,1.3585e-02_r8,1.1145e-02_r8,8.8221e-03_r8, & + &6.4062e-03_r8,3.8753e-03_r8,1.4990e-03_r8/) + kao(:, 3, 5, 8) = (/ & + &2.1222e-02_r8,1.8787e-02_r8,1.6416e-02_r8,1.3970e-02_r8,1.1606e-02_r8,9.3057e-03_r8, & + &6.8725e-03_r8,4.2169e-03_r8,1.9100e-03_r8/) + kao(:, 4, 5, 8) = (/ & + &2.1675e-02_r8,1.9271e-02_r8,1.6942e-02_r8,1.4504e-02_r8,1.2206e-02_r8,9.8161e-03_r8, & + &7.3695e-03_r8,4.6216e-03_r8,2.4296e-03_r8/) + kao(:, 5, 5, 8) = (/ & + &2.2102e-02_r8,1.9781e-02_r8,1.7441e-02_r8,1.5076e-02_r8,1.2804e-02_r8,1.0400e-02_r8, & + &7.9027e-03_r8,5.0748e-03_r8,2.9846e-03_r8/) + kao(:, 1, 6, 8) = (/ & + &3.4516e-02_r8,3.0236e-02_r8,2.6032e-02_r8,2.1800e-02_r8,1.7574e-02_r8,1.3389e-02_r8, & + &9.2847e-03_r8,5.1122e-03_r8,1.0508e-03_r8/) + kao(:, 2, 6, 8) = (/ & + &3.4800e-02_r8,3.0544e-02_r8,2.6323e-02_r8,2.2117e-02_r8,1.7921e-02_r8,1.3756e-02_r8, & + &9.6631e-03_r8,5.4342e-03_r8,1.4451e-03_r8/) + kao(:, 3, 6, 8) = (/ & + &3.5127e-02_r8,3.0902e-02_r8,2.6702e-02_r8,2.2553e-02_r8,1.8369e-02_r8,1.4212e-02_r8, & + &1.0118e-02_r8,5.8263e-03_r8,1.8818e-03_r8/) + kao(:, 4, 6, 8) = (/ & + &3.5628e-02_r8,3.1400e-02_r8,2.7233e-02_r8,2.3087e-02_r8,1.8895e-02_r8,1.4840e-02_r8, & + &1.0658e-02_r8,6.2966e-03_r8,2.4028e-03_r8/) + kao(:, 5, 6, 8) = (/ & + &3.6414e-02_r8,3.2167e-02_r8,2.8039e-02_r8,2.3770e-02_r8,1.9619e-02_r8,1.5526e-02_r8, & + &1.1248e-02_r8,6.8040e-03_r8,2.9828e-03_r8/) + kao(:, 1, 7, 8) = (/ & + &6.0465e-02_r8,5.2915e-02_r8,4.5423e-02_r8,3.7947e-02_r8,3.0446e-02_r8,2.2948e-02_r8, & + &1.5515e-02_r8,8.2239e-03_r8,1.0379e-03_r8/) + kao(:, 2, 7, 8) = (/ & + &6.0755e-02_r8,5.3175e-02_r8,4.5748e-02_r8,3.8231e-02_r8,3.0723e-02_r8,2.3271e-02_r8, & + &1.5903e-02_r8,8.5285e-03_r8,1.3797e-03_r8/) + kao(:, 3, 7, 8) = (/ & + &6.1398e-02_r8,5.3805e-02_r8,4.6318e-02_r8,3.8793e-02_r8,3.1274e-02_r8,2.3804e-02_r8, & + &1.6410e-02_r8,8.9355e-03_r8,1.8226e-03_r8/) + kao(:, 4, 7, 8) = (/ & + &6.2566e-02_r8,5.4915e-02_r8,4.7291e-02_r8,3.9712e-02_r8,3.2135e-02_r8,2.4531e-02_r8, & + &1.7075e-02_r8,9.4211e-03_r8,2.3895e-03_r8/) + kao(:, 5, 7, 8) = (/ & + &6.4353e-02_r8,5.6526e-02_r8,4.8732e-02_r8,4.1035e-02_r8,3.3303e-02_r8,2.5613e-02_r8, & + &1.7950e-02_r8,9.9840e-03_r8,2.9275e-03_r8/) + kao(:, 1, 8, 8) = (/ & + &1.2368e-01_r8,1.0822e-01_r8,9.2766e-02_r8,7.7347e-02_r8,6.2005e-02_r8,4.6603e-02_r8, & + &3.1194e-02_r8,1.5883e-02_r8,8.5274e-04_r8/) + kao(:, 2, 8, 8) = (/ & + &1.2468e-01_r8,1.0911e-01_r8,9.3546e-02_r8,7.8108e-02_r8,6.2629e-02_r8,4.7130e-02_r8, & + &3.1595e-02_r8,1.6348e-02_r8,1.3444e-03_r8/) + kao(:, 3, 8, 8) = (/ & + &1.2638e-01_r8,1.1058e-01_r8,9.4937e-02_r8,7.9293e-02_r8,6.3607e-02_r8,4.7918e-02_r8, & + &3.2304e-02_r8,1.6902e-02_r8,1.7616e-03_r8/) + kao(:, 4, 8, 8) = (/ & + &1.2969e-01_r8,1.1353e-01_r8,9.7623e-02_r8,8.1508e-02_r8,6.5432e-02_r8,4.9461e-02_r8, & + &3.3527e-02_r8,1.7620e-02_r8,2.4617e-03_r8/) + kao(:, 5, 8, 8) = (/ & + &1.3392e-01_r8,1.1729e-01_r8,1.0082e-01_r8,8.4317e-02_r8,6.7894e-02_r8,5.1430e-02_r8, & + &3.4991e-02_r8,1.8580e-02_r8,3.1642e-03_r8/) + kao(:, 1, 9, 8) = (/ & + &4.6846e-01_r8,4.0990e-01_r8,3.5136e-01_r8,2.9284e-01_r8,2.3423e-01_r8,1.7564e-01_r8, & + &1.1723e-01_r8,5.8786e-02_r8,4.0030e-04_r8/) + kao(:, 2, 9, 8) = (/ & + &4.7406e-01_r8,4.1475e-01_r8,3.5556e-01_r8,2.9624e-01_r8,2.3703e-01_r8,1.7789e-01_r8, & + &1.1882e-01_r8,5.9622e-02_r8,6.8004e-04_r8/) + kao(:, 3, 9, 8) = (/ & + &4.8684e-01_r8,4.2603e-01_r8,3.6514e-01_r8,3.0430e-01_r8,2.4358e-01_r8,1.8292e-01_r8, & + &1.2220e-01_r8,6.1402e-02_r8,1.0402e-03_r8/) + kao(:, 4, 9, 8) = (/ & + &5.0043e-01_r8,4.3778e-01_r8,3.7520e-01_r8,3.1290e-01_r8,2.5060e-01_r8,1.8834e-01_r8, & + &1.2594e-01_r8,6.3564e-02_r8,1.7944e-03_r8/) + kao(:, 5, 9, 8) = (/ & + &5.2090e-01_r8,4.5588e-01_r8,3.9070e-01_r8,3.2594e-01_r8,2.6129e-01_r8,1.9629e-01_r8, & + &1.3136e-01_r8,6.6645e-02_r8,2.5620e-03_r8/) + kao(:, 1,10, 8) = (/ & + &1.9599e+00_r8,1.7147e+00_r8,1.4700e+00_r8,1.2249e+00_r8,9.7999e-01_r8,7.3502e-01_r8, & + &4.8995e-01_r8,2.4496e-01_r8,4.5019e-04_r8/) + kao(:, 2,10, 8) = (/ & + &2.0004e+00_r8,1.7503e+00_r8,1.5003e+00_r8,1.2502e+00_r8,1.0002e+00_r8,7.5004e-01_r8, & + &5.0013e-01_r8,2.5017e-01_r8,7.7160e-04_r8/) + kao(:, 3,10, 8) = (/ & + &2.0706e+00_r8,1.8118e+00_r8,1.5527e+00_r8,1.2941e+00_r8,1.0353e+00_r8,7.7648e-01_r8, & + &5.1774e-01_r8,2.5926e-01_r8,1.2278e-03_r8/) + kao(:, 4,10, 8) = (/ & + &2.1488e+00_r8,1.8803e+00_r8,1.6119e+00_r8,1.3430e+00_r8,1.0744e+00_r8,8.0582e-01_r8, & + &5.3747e-01_r8,2.6934e-01_r8,1.1252e-03_r8/) + kao(:, 5,10, 8) = (/ & + &2.2415e+00_r8,1.9614e+00_r8,1.6811e+00_r8,1.4008e+00_r8,1.1207e+00_r8,8.4068e-01_r8, & + &5.6107e-01_r8,2.8130e-01_r8,1.6850e-03_r8/) + kao(:, 1,11, 8) = (/ & + &2.8911e+00_r8,2.5300e+00_r8,2.1683e+00_r8,1.8069e+00_r8,1.4455e+00_r8,1.0841e+00_r8, & + &7.2274e-01_r8,3.6133e-01_r8,4.4874e-04_r8/) + kao(:, 2,11, 8) = (/ & + &2.9950e+00_r8,2.6205e+00_r8,2.2462e+00_r8,1.8718e+00_r8,1.4974e+00_r8,1.1232e+00_r8, & + &7.4873e-01_r8,3.7448e-01_r8,7.8243e-04_r8/) + kao(:, 3,11, 8) = (/ & + &3.1150e+00_r8,2.7257e+00_r8,2.3363e+00_r8,1.9467e+00_r8,1.5577e+00_r8,1.1681e+00_r8, & + &7.7884e-01_r8,3.8967e-01_r8,1.2703e-03_r8/) + kao(:, 4,11, 8) = (/ & + &3.2669e+00_r8,2.8585e+00_r8,2.4505e+00_r8,2.0417e+00_r8,1.6337e+00_r8,1.2254e+00_r8, & + &8.1715e-01_r8,4.0914e-01_r8,1.7634e-03_r8/) + kao(:, 5,11, 8) = (/ & + &3.4234e+00_r8,2.9957e+00_r8,2.5672e+00_r8,2.1393e+00_r8,1.7114e+00_r8,1.2836e+00_r8, & + &8.5639e-01_r8,4.2894e-01_r8,1.6787e-03_r8/) + kao(:, 1,12, 8) = (/ & + &3.0768e+00_r8,2.6917e+00_r8,2.3070e+00_r8,1.9231e+00_r8,1.5383e+00_r8,1.1537e+00_r8, & + &7.6915e-01_r8,3.8462e-01_r8,4.7094e-04_r8/) + kao(:, 2,12, 8) = (/ & + &3.2435e+00_r8,2.8382e+00_r8,2.4330e+00_r8,2.0274e+00_r8,1.6219e+00_r8,1.2164e+00_r8, & + &8.1089e-01_r8,4.0548e-01_r8,8.2872e-04_r8/) + kao(:, 3,12, 8) = (/ & + &3.4231e+00_r8,2.9954e+00_r8,2.5672e+00_r8,2.1393e+00_r8,1.7115e+00_r8,1.2835e+00_r8, & + &8.5578e-01_r8,4.2826e-01_r8,1.3467e-03_r8/) + kao(:, 4,12, 8) = (/ & + &3.5915e+00_r8,3.1425e+00_r8,2.6940e+00_r8,2.2448e+00_r8,1.7959e+00_r8,1.3469e+00_r8, & + &8.9804e-01_r8,4.4980e-01_r8,2.0869e-03_r8/) + kao(:, 5,12, 8) = (/ & + &3.8078e+00_r8,3.3318e+00_r8,2.8557e+00_r8,2.3795e+00_r8,1.9039e+00_r8,1.4280e+00_r8, & + &9.5252e-01_r8,4.7712e-01_r8,1.8673e-03_r8/) + kao(:, 1,13, 8) = (/ & + &2.3608e+00_r8,2.0656e+00_r8,1.7703e+00_r8,1.4752e+00_r8,1.1801e+00_r8,8.8512e-01_r8, & + &5.9005e-01_r8,2.9502e-01_r8,4.6667e-04_r8/) + kao(:, 2,13, 8) = (/ & + &2.5500e+00_r8,2.2311e+00_r8,1.9119e+00_r8,1.5932e+00_r8,1.2746e+00_r8,9.5617e-01_r8, & + &6.3722e-01_r8,3.1884e-01_r8,8.1387e-04_r8/) + kao(:, 3,13, 8) = (/ & + &2.7068e+00_r8,2.3688e+00_r8,2.0306e+00_r8,1.6919e+00_r8,1.3534e+00_r8,1.0151e+00_r8, & + &6.7709e-01_r8,3.3887e-01_r8,1.3055e-03_r8/) + kao(:, 4,13, 8) = (/ & + &2.8840e+00_r8,2.5234e+00_r8,2.1627e+00_r8,1.8025e+00_r8,1.4417e+00_r8,1.0815e+00_r8, & + &7.2137e-01_r8,3.6139e-01_r8,1.9116e-03_r8/) + kao(:, 5,13, 8) = (/ & + &3.0939e+00_r8,2.7071e+00_r8,2.3203e+00_r8,1.9334e+00_r8,1.5471e+00_r8,1.1606e+00_r8, & + &7.7438e-01_r8,3.8815e-01_r8,1.4651e-03_r8/) + kao(:, 1, 1, 9) = (/ & + &3.8342e-03_r8,3.6037e-03_r8,3.3390e-03_r8,3.1415e-03_r8,3.0062e-03_r8,3.0639e-03_r8, & + &3.3790e-03_r8,3.9710e-03_r8,4.6693e-03_r8/) + kao(:, 2, 1, 9) = (/ & + &3.8099e-03_r8,3.5245e-03_r8,3.4236e-03_r8,3.3696e-03_r8,3.4435e-03_r8,3.7521e-03_r8, & + &4.3079e-03_r8,5.1949e-03_r8,5.9521e-03_r8/) + kao(:, 3, 1, 9) = (/ & + &3.6846e-03_r8,3.4976e-03_r8,3.5740e-03_r8,3.6729e-03_r8,4.0680e-03_r8,4.6302e-03_r8, & + &5.4360e-03_r8,6.6553e-03_r8,7.4735e-03_r8/) + kao(:, 4, 1, 9) = (/ & + &3.5274e-03_r8,3.5376e-03_r8,3.7030e-03_r8,4.1336e-03_r8,4.8513e-03_r8,5.7165e-03_r8, & + &6.7340e-03_r8,8.3554e-03_r8,9.2181e-03_r8/) + kao(:, 5, 1, 9) = (/ & + &3.3692e-03_r8,3.5348e-03_r8,3.9656e-03_r8,4.7179e-03_r8,5.7827e-03_r8,6.9797e-03_r8, & + &8.2404e-03_r8,1.0337e-02_r8,1.1151e-02_r8/) + kao(:, 1, 2, 9) = (/ & + &6.4244e-03_r8,5.9003e-03_r8,5.2917e-03_r8,4.8738e-03_r8,4.2886e-03_r8,3.6979e-03_r8, & + &3.3432e-03_r8,3.4356e-03_r8,4.2740e-03_r8/) + kao(:, 2, 2, 9) = (/ & + &6.4294e-03_r8,5.9365e-03_r8,5.4378e-03_r8,5.0910e-03_r8,4.5359e-03_r8,4.1466e-03_r8, & + &4.0476e-03_r8,4.4354e-03_r8,5.4215e-03_r8/) + kao(:, 3, 2, 9) = (/ & + &6.3847e-03_r8,6.0135e-03_r8,5.5846e-03_r8,5.2573e-03_r8,4.8954e-03_r8,4.7657e-03_r8, & + &4.9765e-03_r8,5.6368e-03_r8,6.8419e-03_r8/) + kao(:, 4, 2, 9) = (/ & + &6.3412e-03_r8,5.9177e-03_r8,5.7222e-03_r8,5.4979e-03_r8,5.4021e-03_r8,5.5794e-03_r8, & + &6.1113e-03_r8,7.0879e-03_r8,8.4995e-03_r8/) + kao(:, 5, 2, 9) = (/ & + &6.1488e-03_r8,5.8853e-03_r8,5.8235e-03_r8,5.8427e-03_r8,6.0130e-03_r8,6.6088e-03_r8, & + &7.4819e-03_r8,8.8092e-03_r8,1.0289e-02_r8/) + kao(:, 1, 3, 9) = (/ & + &1.4195e-02_r8,1.2643e-02_r8,1.1125e-02_r8,9.5338e-03_r8,8.0743e-03_r8,6.7413e-03_r8, & + &5.1394e-03_r8,3.4808e-03_r8,3.6417e-03_r8/) + kao(:, 2, 3, 9) = (/ & + &1.4156e-02_r8,1.2714e-02_r8,1.1322e-02_r8,9.8573e-03_r8,8.5639e-03_r8,7.1930e-03_r8, & + &5.4628e-03_r8,4.1430e-03_r8,4.8796e-03_r8/) + kao(:, 3, 3, 9) = (/ & + &1.4281e-02_r8,1.3014e-02_r8,1.1636e-02_r8,1.0282e-02_r8,9.0638e-03_r8,7.5306e-03_r8, & + &5.9490e-03_r8,5.0136e-03_r8,6.2613e-03_r8/) + kao(:, 4, 3, 9) = (/ & + &1.4318e-02_r8,1.3194e-02_r8,1.1832e-02_r8,1.0698e-02_r8,9.4111e-03_r8,7.9426e-03_r8, & + &6.6489e-03_r8,6.1359e-03_r8,7.8675e-03_r8/) + kao(:, 5, 3, 9) = (/ & + &1.4241e-02_r8,1.3300e-02_r8,1.2028e-02_r8,1.0934e-02_r8,9.7284e-03_r8,8.5621e-03_r8, & + &7.5356e-03_r8,7.5232e-03_r8,9.7190e-03_r8/) + kao(:, 1, 4, 9) = (/ & + &3.1371e-02_r8,2.7594e-02_r8,2.3918e-02_r8,2.0236e-02_r8,1.6538e-02_r8,1.2862e-02_r8, & + &9.3415e-03_r8,5.6206e-03_r8,3.0136e-03_r8/) + kao(:, 2, 4, 9) = (/ & + &3.1367e-02_r8,2.7706e-02_r8,2.4150e-02_r8,2.0624e-02_r8,1.6974e-02_r8,1.3427e-02_r8, & + &9.9709e-03_r8,6.1282e-03_r8,4.2995e-03_r8/) + kao(:, 3, 4, 9) = (/ & + &3.1583e-02_r8,2.8007e-02_r8,2.4625e-02_r8,2.1088e-02_r8,1.7481e-02_r8,1.4076e-02_r8, & + &1.0648e-02_r8,6.6037e-03_r8,5.6873e-03_r8/) + kao(:, 4, 4, 9) = (/ & + &3.1875e-02_r8,2.8446e-02_r8,2.5140e-02_r8,2.1570e-02_r8,1.8204e-02_r8,1.5013e-02_r8, & + &1.1353e-02_r8,7.2455e-03_r8,7.5289e-03_r8/) + kao(:, 5, 4, 9) = (/ & + &3.2159e-02_r8,2.8870e-02_r8,2.5760e-02_r8,2.2306e-02_r8,1.9019e-02_r8,1.5749e-02_r8, & + &1.1959e-02_r8,8.0455e-03_r8,9.2604e-03_r8/) + kao(:, 1, 5, 9) = (/ & + &6.1996e-02_r8,5.4276e-02_r8,4.6766e-02_r8,3.9233e-02_r8,3.1722e-02_r8,2.4192e-02_r8, & + &1.6676e-02_r8,9.3526e-03_r8,2.3723e-03_r8/) + kao(:, 2, 5, 9) = (/ & + &6.2786e-02_r8,5.5036e-02_r8,4.7544e-02_r8,4.0014e-02_r8,3.2500e-02_r8,2.4919e-02_r8, & + &1.7414e-02_r8,9.9958e-03_r8,3.1775e-03_r8/) + kao(:, 3, 5, 9) = (/ & + &6.3408e-02_r8,5.5719e-02_r8,4.8263e-02_r8,4.0805e-02_r8,3.3340e-02_r8,2.5705e-02_r8, & + &1.8217e-02_r8,1.0807e-02_r8,4.4457e-03_r8/) + kao(:, 4, 5, 9) = (/ & + &6.3958e-02_r8,5.6455e-02_r8,4.8967e-02_r8,4.1701e-02_r8,3.4289e-02_r8,2.6801e-02_r8, & + &1.9500e-02_r8,1.1614e-02_r8,6.0592e-03_r8/) + kao(:, 5, 5, 9) = (/ & + &6.4544e-02_r8,5.7091e-02_r8,4.9896e-02_r8,4.2837e-02_r8,3.5365e-02_r8,2.7903e-02_r8, & + &2.0589e-02_r8,1.2558e-02_r8,7.7840e-03_r8/) + kao(:, 1, 6, 9) = (/ & + &1.1420e-01_r8,9.9928e-02_r8,8.5730e-02_r8,7.1669e-02_r8,5.7641e-02_r8,4.3533e-02_r8, & + &2.9463e-02_r8,1.5596e-02_r8,1.8870e-03_r8/) + kao(:, 2, 6, 9) = (/ & + &1.1463e-01_r8,1.0031e-01_r8,8.6249e-02_r8,7.2249e-02_r8,5.8195e-02_r8,4.4132e-02_r8, & + &3.0125e-02_r8,1.6255e-02_r8,2.7185e-03_r8/) + kao(:, 3, 6, 9) = (/ & + &1.1505e-01_r8,1.0074e-01_r8,8.6836e-02_r8,7.2850e-02_r8,5.8886e-02_r8,4.5056e-02_r8, & + &3.1103e-02_r8,1.7221e-02_r8,3.7627e-03_r8/) + kao(:, 4, 6, 9) = (/ & + &1.1693e-01_r8,1.0252e-01_r8,8.8568e-02_r8,7.4567e-02_r8,6.0606e-02_r8,4.6540e-02_r8, & + &3.2424e-02_r8,1.8275e-02_r8,5.0267e-03_r8/) + kao(:, 5, 6, 9) = (/ & + &1.1806e-01_r8,1.0371e-01_r8,8.9817e-02_r8,7.5865e-02_r8,6.1963e-02_r8,4.7866e-02_r8, & + &3.3695e-02_r8,1.9500e-02_r8,6.8317e-03_r8/) + kao(:, 1, 7, 9) = (/ & + &2.1427e-01_r8,1.8749e-01_r8,1.6070e-01_r8,1.3399e-01_r8,1.0738e-01_r8,8.0867e-02_r8, & + &5.4264e-02_r8,2.7682e-02_r8,1.2395e-03_r8/) + kao(:, 2, 7, 9) = (/ & + &2.1459e-01_r8,1.8775e-01_r8,1.6094e-01_r8,1.3438e-01_r8,1.0794e-01_r8,8.1406e-02_r8, & + &5.4844e-02_r8,2.8427e-02_r8,2.0965e-03_r8/) + kao(:, 3, 7, 9) = (/ & + &2.1615e-01_r8,1.8914e-01_r8,1.6231e-01_r8,1.3573e-01_r8,1.0921e-01_r8,8.2571e-02_r8, & + &5.5952e-02_r8,2.9582e-02_r8,3.1925e-03_r8/) + kao(:, 4, 7, 9) = (/ & + &2.1891e-01_r8,1.9155e-01_r8,1.6470e-01_r8,1.3802e-01_r8,1.1113e-01_r8,8.4390e-02_r8, & + &5.7587e-02_r8,3.0908e-02_r8,4.5715e-03_r8/) + kao(:, 5, 7, 9) = (/ & + &2.2155e-01_r8,1.9400e-01_r8,1.6713e-01_r8,1.4027e-01_r8,1.1333e-01_r8,8.6454e-02_r8, & + &5.9526e-02_r8,3.2445e-02_r8,6.5617e-03_r8/) + kao(:, 1, 8, 9) = (/ & + &4.6547e-01_r8,4.0732e-01_r8,3.4911e-01_r8,2.9100e-01_r8,2.3277e-01_r8,1.7470e-01_r8, & + &1.1672e-01_r8,5.8764e-02_r8,8.5250e-04_r8/) + kao(:, 2, 8, 9) = (/ & + &4.6469e-01_r8,4.0659e-01_r8,3.4854e-01_r8,2.9045e-01_r8,2.3244e-01_r8,1.7466e-01_r8, & + &1.1705e-01_r8,5.9152e-02_r8,1.3360e-03_r8/) + kao(:, 3, 8, 9) = (/ & + &4.6927e-01_r8,4.1062e-01_r8,3.5196e-01_r8,2.9346e-01_r8,2.3515e-01_r8,1.7702e-01_r8, & + &1.1874e-01_r8,6.0462e-02_r8,2.4435e-03_r8/) + kao(:, 4, 8, 9) = (/ & + &4.7393e-01_r8,4.1463e-01_r8,3.5541e-01_r8,2.9668e-01_r8,2.3809e-01_r8,1.7953e-01_r8, & + &1.2082e-01_r8,6.2242e-02_r8,3.3995e-03_r8/) + kao(:, 5, 8, 9) = (/ & + &4.8023e-01_r8,4.2020e-01_r8,3.6048e-01_r8,3.0117e-01_r8,2.4212e-01_r8,1.8271e-01_r8, & + &1.2350e-01_r8,6.4451e-02_r8,5.1655e-03_r8/) + kao(:, 1, 9, 9) = (/ & + &1.9039e+00_r8,1.6660e+00_r8,1.4281e+00_r8,1.1899e+00_r8,9.5193e-01_r8,7.1405e-01_r8, & + &4.7606e-01_r8,2.3807e-01_r8,5.1784e-04_r8/) + kao(:, 2, 9, 9) = (/ & + &1.8960e+00_r8,1.6589e+00_r8,1.4220e+00_r8,1.1850e+00_r8,9.4792e-01_r8,7.1098e-01_r8, & + &4.7399e-01_r8,2.3745e-01_r8,1.0379e-03_r8/) + kao(:, 3, 9, 9) = (/ & + &1.8985e+00_r8,1.6610e+00_r8,1.4239e+00_r8,1.1866e+00_r8,9.4922e-01_r8,7.1187e-01_r8, & + &4.7501e-01_r8,2.3850e-01_r8,1.9956e-03_r8/) + kao(:, 4, 9, 9) = (/ & + &1.9331e+00_r8,1.6922e+00_r8,1.4503e+00_r8,1.2084e+00_r8,9.6666e-01_r8,7.2514e-01_r8, & + &4.8432e-01_r8,2.4379e-01_r8,3.3200e-03_r8/) + kao(:, 5, 9, 9) = (/ & + &1.9563e+00_r8,1.7116e+00_r8,1.4675e+00_r8,1.2227e+00_r8,9.7814e-01_r8,7.3426e-01_r8, & + &4.9112e-01_r8,2.4753e-01_r8,5.3379e-03_r8/) + kao(:, 1,10, 9) = (/ & + &8.5901e+00_r8,7.5167e+00_r8,6.4427e+00_r8,5.3701e+00_r8,4.2955e+00_r8,3.2213e+00_r8, & + &2.1478e+00_r8,1.0738e+00_r8,2.8232e-05_r8/) + kao(:, 2,10, 9) = (/ & + &8.5325e+00_r8,7.4671e+00_r8,6.4018e+00_r8,5.3343e+00_r8,4.2664e+00_r8,3.2001e+00_r8, & + &2.1333e+00_r8,1.0667e+00_r8,3.4266e-05_r8/) + kao(:, 3,10, 9) = (/ & + &8.5180e+00_r8,7.4539e+00_r8,6.3892e+00_r8,5.3241e+00_r8,4.2587e+00_r8,3.1944e+00_r8, & + &2.1293e+00_r8,1.0648e+00_r8,4.9015e-05_r8/) + kao(:, 4,10, 9) = (/ & + &8.6373e+00_r8,7.5561e+00_r8,6.4798e+00_r8,5.3988e+00_r8,4.3190e+00_r8,3.2393e+00_r8, & + &2.1596e+00_r8,1.0801e+00_r8,1.1052e-03_r8/) + kao(:, 5,10, 9) = (/ & + &8.7651e+00_r8,7.6691e+00_r8,6.5729e+00_r8,5.4773e+00_r8,4.3830e+00_r8,3.2869e+00_r8, & + &2.1915e+00_r8,1.0965e+00_r8,2.0612e-03_r8/) + kao(:, 1,11, 9) = (/ & + &1.3293e+01_r8,1.1631e+01_r8,9.9694e+00_r8,8.3080e+00_r8,6.6463e+00_r8,4.9848e+00_r8, & + &3.3235e+00_r8,1.6616e+00_r8,8.6041e-05_r8/) + kao(:, 2,11, 9) = (/ & + &1.3175e+01_r8,1.1527e+01_r8,9.8819e+00_r8,8.2359e+00_r8,6.5871e+00_r8,4.9407e+00_r8, & + &3.2935e+00_r8,1.6469e+00_r8,8.8405e-05_r8/) + kao(:, 3,11, 9) = (/ & + &1.3260e+01_r8,1.1601e+01_r8,9.9453e+00_r8,8.2878e+00_r8,6.6300e+00_r8,4.9725e+00_r8, & + &3.3155e+00_r8,1.6576e+00_r8,7.6661e-05_r8/) + kao(:, 4,11, 9) = (/ & + &1.3414e+01_r8,1.1737e+01_r8,1.0061e+01_r8,8.3841e+00_r8,6.7068e+00_r8,5.0294e+00_r8, & + &3.3528e+00_r8,1.6766e+00_r8,3.1506e-04_r8/) + kao(:, 5,11, 9) = (/ & + &1.3624e+01_r8,1.1922e+01_r8,1.0219e+01_r8,8.5160e+00_r8,6.8128e+00_r8,5.1095e+00_r8, & + &3.4058e+00_r8,1.7038e+00_r8,1.6944e-03_r8/) + kao(:, 1,12, 9) = (/ & + &1.4782e+01_r8,1.2935e+01_r8,1.1089e+01_r8,9.2388e+00_r8,7.3920e+00_r8,5.5445e+00_r8, & + &3.6962e+00_r8,1.8480e+00_r8,1.3867e-04_r8/) + kao(:, 2,12, 9) = (/ & + &1.4730e+01_r8,1.2889e+01_r8,1.1047e+01_r8,9.2076e+00_r8,7.3659e+00_r8,5.5246e+00_r8, & + &3.6830e+00_r8,1.8415e+00_r8,1.5061e-04_r8/) + kao(:, 3,12, 9) = (/ & + &1.4865e+01_r8,1.3005e+01_r8,1.1148e+01_r8,9.2913e+00_r8,7.4319e+00_r8,5.5733e+00_r8, & + &3.7153e+00_r8,1.8580e+00_r8,1.4666e-04_r8/) + kao(:, 4,12, 9) = (/ & + &1.5163e+01_r8,1.3269e+01_r8,1.1374e+01_r8,9.4785e+00_r8,7.5816e+00_r8,5.6866e+00_r8, & + &3.7915e+00_r8,1.8957e+00_r8,1.4926e-04_r8/) + kao(:, 5,12, 9) = (/ & + &1.5423e+01_r8,1.3495e+01_r8,1.1567e+01_r8,9.6394e+00_r8,7.7115e+00_r8,5.7838e+00_r8, & + &3.8558e+00_r8,1.9287e+00_r8,1.8983e-03_r8/) + kao(:, 1,13, 9) = (/ & + &1.2526e+01_r8,1.0960e+01_r8,9.3953e+00_r8,7.8295e+00_r8,6.2636e+00_r8,4.6971e+00_r8, & + &3.1319e+00_r8,1.5656e+00_r8,2.2960e-04_r8/) + kao(:, 2,13, 9) = (/ & + &1.2594e+01_r8,1.1020e+01_r8,9.4466e+00_r8,7.8734e+00_r8,6.2977e+00_r8,4.7229e+00_r8, & + &3.1489e+00_r8,1.5743e+00_r8,3.0250e-04_r8/) + kao(:, 3,13, 9) = (/ & + &1.2808e+01_r8,1.1205e+01_r8,9.6060e+00_r8,8.0068e+00_r8,6.4043e+00_r8,4.8030e+00_r8, & + &3.2030e+00_r8,1.6008e+00_r8,4.1712e-04_r8/) + kao(:, 4,13, 9) = (/ & + &1.3107e+01_r8,1.1466e+01_r8,9.8274e+00_r8,8.1873e+00_r8,6.5536e+00_r8,4.9140e+00_r8, & + &3.2751e+00_r8,1.6381e+00_r8,6.5679e-04_r8/) + kao(:, 5,13, 9) = (/ & + &1.3444e+01_r8,1.1761e+01_r8,1.0081e+01_r8,8.4011e+00_r8,6.7204e+00_r8,5.0404e+00_r8, & + &3.3592e+00_r8,1.6815e+00_r8,2.8416e-03_r8/) + kao(:, 1, 1,10) = (/ & + &4.6973e-03_r8,3.3679e-03_r8,3.0810e-03_r8,4.4179e-03_r8,5.3922e-03_r8,6.8127e-03_r8, & + &7.5300e-03_r8,9.6520e-03_r8,1.0742e-02_r8/) + kao(:, 2, 1,10) = (/ & + &3.3940e-03_r8,3.6347e-03_r8,3.8181e-03_r8,5.7069e-03_r8,7.1993e-03_r8,9.1516e-03_r8, & + &1.0242e-02_r8,1.2914e-02_r8,1.4284e-02_r8/) + kao(:, 3, 1,10) = (/ & + &2.9328e-03_r8,3.5249e-03_r8,5.0061e-03_r8,7.3569e-03_r8,8.9474e-03_r8,1.1546e-02_r8, & + &1.2963e-02_r8,1.7115e-02_r8,1.7551e-02_r8/) + kao(:, 4, 1,10) = (/ & + &2.4964e-03_r8,3.6551e-03_r8,6.6228e-03_r8,8.9461e-03_r8,1.0774e-02_r8,1.3965e-02_r8, & + &1.7435e-02_r8,2.2332e-02_r8,2.1398e-02_r8/) + kao(:, 5, 1,10) = (/ & + &2.1304e-03_r8,4.5161e-03_r8,8.4664e-03_r8,1.0811e-02_r8,1.3640e-02_r8,1.7099e-02_r8, & + &2.2735e-02_r8,2.8461e-02_r8,2.7259e-02_r8/) + kao(:, 1, 2,10) = (/ & + &9.4205e-03_r8,8.2881e-03_r8,6.8055e-03_r8,5.1998e-03_r8,6.0003e-03_r8,6.4194e-03_r8, & + &7.3653e-03_r8,8.1269e-03_r8,1.1868e-02_r8/) + kao(:, 2, 2,10) = (/ & + &8.5761e-03_r8,7.3303e-03_r8,5.6742e-03_r8,5.4200e-03_r8,7.5061e-03_r8,8.7164e-03_r8, & + &9.8614e-03_r8,1.1132e-02_r8,1.4929e-02_r8/) + kao(:, 3, 2,10) = (/ & + &7.2342e-03_r8,5.9377e-03_r8,5.5335e-03_r8,7.0973e-03_r8,9.3181e-03_r8,1.1104e-02_r8, & + &1.2752e-02_r8,1.5333e-02_r8,1.8200e-02_r8/) + kao(:, 4, 2,10) = (/ & + &5.3015e-03_r8,5.6105e-03_r8,6.0212e-03_r8,9.3735e-03_r8,1.1344e-02_r8,1.3845e-02_r8, & + &1.6350e-02_r8,2.0205e-02_r8,2.2040e-02_r8/) + kao(:, 5, 2,10) = (/ & + &4.6868e-03_r8,5.1363e-03_r8,7.4969e-03_r8,1.0079e-02_r8,1.4155e-02_r8,1.6850e-02_r8, & + &1.9756e-02_r8,2.5412e-02_r8,2.7831e-02_r8/) + kao(:, 1, 3,10) = (/ & + &2.2659e-02_r8,2.0083e-02_r8,1.7749e-02_r8,1.5132e-02_r8,1.2304e-02_r8,9.8131e-03_r8, & + &6.5475e-03_r8,7.6061e-03_r8,9.2024e-03_r8/) + kao(:, 2, 3,10) = (/ & + &2.3012e-02_r8,2.0379e-02_r8,1.7548e-02_r8,1.4904e-02_r8,1.1694e-02_r8,9.3796e-03_r8, & + &9.2412e-03_r8,1.0030e-02_r8,1.2744e-02_r8/) + kao(:, 3, 3,10) = (/ & + &2.1396e-02_r8,1.8727e-02_r8,1.6107e-02_r8,1.2456e-02_r8,1.0255e-02_r8,1.0536e-02_r8, & + &1.1966e-02_r8,1.3095e-02_r8,1.7259e-02_r8/) + kao(:, 4, 3,10) = (/ & + &1.9331e-02_r8,1.6488e-02_r8,1.2963e-02_r8,1.0270e-02_r8,1.1515e-02_r8,1.2315e-02_r8, & + &1.5198e-02_r8,1.6672e-02_r8,2.2500e-02_r8/) + kao(:, 5, 3,10) = (/ & + &1.6551e-02_r8,1.3344e-02_r8,1.1001e-02_r8,1.0385e-02_r8,1.2450e-02_r8,1.4894e-02_r8, & + &1.8912e-02_r8,2.0849e-02_r8,2.4782e-02_r8/) + kao(:, 1, 4,10) = (/ & + &5.3443e-02_r8,4.6752e-02_r8,4.0212e-02_r8,3.3727e-02_r8,2.6764e-02_r8,2.0366e-02_r8, & + &1.4100e-02_r8,8.5626e-03_r8,5.0179e-03_r8/) + kao(:, 2, 4,10) = (/ & + &5.5520e-02_r8,4.8788e-02_r8,4.2227e-02_r8,3.5776e-02_r8,2.9164e-02_r8,2.2326e-02_r8, & + &1.5452e-02_r8,9.1701e-03_r8,6.6031e-03_r8/) + kao(:, 3, 4,10) = (/ & + &5.3841e-02_r8,4.7471e-02_r8,4.1338e-02_r8,3.5633e-02_r8,2.9297e-02_r8,2.2785e-02_r8, & + &1.5793e-02_r8,1.1481e-02_r8,9.9885e-03_r8/) + kao(:, 4, 4,10) = (/ & + &5.4923e-02_r8,4.8665e-02_r8,4.2046e-02_r8,3.5458e-02_r8,2.8786e-02_r8,2.1135e-02_r8, & + &1.3946e-02_r8,1.4729e-02_r8,1.3190e-02_r8/) + kao(:, 5, 4,10) = (/ & + &5.1650e-02_r8,4.6045e-02_r8,4.0319e-02_r8,3.3252e-02_r8,2.5245e-02_r8,1.9132e-02_r8, & + &1.5667e-02_r8,1.8634e-02_r8,1.9277e-02_r8/) + kao(:, 1, 5,10) = (/ & + &1.1780e-01_r8,1.0308e-01_r8,8.8391e-02_r8,7.4152e-02_r8,5.9704e-02_r8,4.5204e-02_r8, & + &3.0807e-02_r8,1.6385e-02_r8,4.0089e-03_r8/) + kao(:, 2, 5,10) = (/ & + &1.1261e-01_r8,9.8543e-02_r8,8.5059e-02_r8,7.1216e-02_r8,5.7505e-02_r8,4.3649e-02_r8, & + &3.0528e-02_r8,1.7529e-02_r8,9.3093e-03_r8/) + kao(:, 3, 5,10) = (/ & + &1.1400e-01_r8,9.9742e-02_r8,8.6449e-02_r8,7.3042e-02_r8,5.9615e-02_r8,4.6638e-02_r8, & + &3.2532e-02_r8,1.8567e-02_r8,1.1184e-02_r8/) + kao(:, 4, 5,10) = (/ & + &1.1613e-01_r8,1.0163e-01_r8,8.9121e-02_r8,7.4876e-02_r8,6.0453e-02_r8,4.6196e-02_r8, & + &3.1216e-02_r8,1.9048e-02_r8,1.2339e-02_r8/) + kao(:, 5, 5,10) = (/ & + &1.2016e-01_r8,1.0608e-01_r8,9.2375e-02_r8,7.6465e-02_r8,6.2248e-02_r8,4.8476e-02_r8, & + &3.3522e-02_r8,1.7446e-02_r8,1.7040e-02_r8/) + kao(:, 1, 6,10) = (/ & + &2.3387e-01_r8,2.0464e-01_r8,1.7541e-01_r8,1.4624e-01_r8,1.1769e-01_r8,8.8692e-02_r8, & + &5.9747e-02_r8,3.0756e-02_r8,2.5605e-03_r8/) + kao(:, 2, 6,10) = (/ & + &2.3730e-01_r8,2.0756e-01_r8,1.7772e-01_r8,1.4892e-01_r8,1.1985e-01_r8,9.0758e-02_r8, & + &6.1778e-02_r8,3.2933e-02_r8,4.6893e-03_r8/) + kao(:, 3, 6,10) = (/ & + &2.4203e-01_r8,2.1158e-01_r8,1.8155e-01_r8,1.5250e-01_r8,1.2284e-01_r8,9.2705e-02_r8, & + &6.3067e-02_r8,3.2776e-02_r8,9.7345e-03_r8/) + kao(:, 4, 6,10) = (/ & + &2.3049e-01_r8,2.0160e-01_r8,1.7416e-01_r8,1.4569e-01_r8,1.1768e-01_r8,8.9784e-02_r8, & + &6.1642e-02_r8,3.4682e-02_r8,1.6936e-02_r8/) + kao(:, 5, 6,10) = (/ & + &2.3636e-01_r8,2.0679e-01_r8,1.7932e-01_r8,1.5154e-01_r8,1.2337e-01_r8,9.4475e-02_r8, & + &6.5584e-02_r8,3.6305e-02_r8,2.2069e-02_r8/) + kao(:, 1, 7,10) = (/ & + &4.9443e-01_r8,4.3211e-01_r8,3.7050e-01_r8,3.0887e-01_r8,2.4699e-01_r8,1.8540e-01_r8, & + &1.2438e-01_r8,6.2986e-02_r8,2.0096e-03_r8/) + kao(:, 2, 7,10) = (/ & + &4.9639e-01_r8,4.3473e-01_r8,3.7266e-01_r8,3.1039e-01_r8,2.4852e-01_r8,1.8749e-01_r8, & + &1.2568e-01_r8,6.4131e-02_r8,3.0764e-03_r8/) + kao(:, 3, 7,10) = (/ & + &4.9265e-01_r8,4.3128e-01_r8,3.6987e-01_r8,3.0823e-01_r8,2.4792e-01_r8,1.8671e-01_r8, & + &1.2562e-01_r8,6.4213e-02_r8,5.4655e-03_r8/) + kao(:, 4, 7,10) = (/ & + &4.7703e-01_r8,4.1742e-01_r8,3.5749e-01_r8,2.9850e-01_r8,2.4081e-01_r8,1.8239e-01_r8, & + &1.2380e-01_r8,6.5802e-02_r8,1.0925e-02_r8/) + kao(:, 5, 7,10) = (/ & + &4.8180e-01_r8,4.2216e-01_r8,3.6195e-01_r8,3.0277e-01_r8,2.4364e-01_r8,1.8402e-01_r8, & + &1.2523e-01_r8,6.7909e-02_r8,1.4296e-02_r8/) + kao(:, 1, 8,10) = (/ & + &1.1962e+00_r8,1.0464e+00_r8,8.9717e-01_r8,7.4708e-01_r8,5.9764e-01_r8,4.4825e-01_r8, & + &2.9884e-01_r8,1.5061e-01_r8,3.8986e-03_r8/) + kao(:, 2, 8,10) = (/ & + &1.2041e+00_r8,1.0536e+00_r8,9.0306e-01_r8,7.5220e-01_r8,6.0244e-01_r8,4.5171e-01_r8, & + &3.0103e-01_r8,1.5197e-01_r8,3.3573e-03_r8/) + kao(:, 3, 8,10) = (/ & + &1.1525e+00_r8,1.0084e+00_r8,8.6433e-01_r8,7.2027e-01_r8,5.7631e-01_r8,4.3217e-01_r8, & + &2.8996e-01_r8,1.4673e-01_r8,3.4045e-03_r8/) + kao(:, 4, 8,10) = (/ & + &1.1627e+00_r8,1.0178e+00_r8,8.7243e-01_r8,7.2665e-01_r8,5.8167e-01_r8,4.3823e-01_r8, & + &2.9244e-01_r8,1.4815e-01_r8,8.5595e-03_r8/) + kao(:, 5, 8,10) = (/ & + &1.1683e+00_r8,1.0228e+00_r8,8.7612e-01_r8,7.3014e-01_r8,5.8445e-01_r8,4.4237e-01_r8, & + &2.9748e-01_r8,1.5239e-01_r8,1.0748e-02_r8/) + kao(:, 1, 9,10) = (/ & + &5.3473e+00_r8,4.6810e+00_r8,4.0088e+00_r8,3.3420e+00_r8,2.6745e+00_r8,2.0052e+00_r8, & + &1.3357e+00_r8,6.6899e-01_r8,9.0646e-06_r8/) + kao(:, 2, 9,10) = (/ & + &5.3849e+00_r8,4.7131e+00_r8,4.0386e+00_r8,3.3668e+00_r8,2.6936e+00_r8,2.0203e+00_r8, & + &1.3467e+00_r8,6.7337e-01_r8,1.6160e-05_r8/) + kao(:, 3, 9,10) = (/ & + &5.2604e+00_r8,4.6046e+00_r8,3.9456e+00_r8,3.2881e+00_r8,2.6303e+00_r8,1.9734e+00_r8, & + &1.3151e+00_r8,6.5758e-01_r8,2.7795e-05_r8/) + kao(:, 4, 9,10) = (/ & + &4.9950e+00_r8,4.3651e+00_r8,3.7432e+00_r8,3.1211e+00_r8,2.4979e+00_r8,1.8723e+00_r8, & + &1.2477e+00_r8,6.2561e-01_r8,4.1978e-05_r8/) + kao(:, 5, 9,10) = (/ & + &5.1108e+00_r8,4.4671e+00_r8,3.8297e+00_r8,3.1913e+00_r8,2.5537e+00_r8,1.9170e+00_r8, & + &1.2756e+00_r8,6.4540e-01_r8,6.6209e-05_r8/) + kao(:, 1,10,10) = (/ & + &2.6042e+01_r8,2.2785e+01_r8,1.9540e+01_r8,1.6264e+01_r8,1.3016e+01_r8,9.7654e+00_r8, & + &6.5078e+00_r8,3.2552e+00_r8,5.7707e-06_r8/) + kao(:, 2,10,10) = (/ & + &2.6479e+01_r8,2.3167e+01_r8,1.9837e+01_r8,1.6530e+01_r8,1.3239e+01_r8,9.9265e+00_r8, & + &6.6195e+00_r8,3.3086e+00_r8,1.0081e-05_r8/) + kao(:, 3,10,10) = (/ & + &2.6009e+01_r8,2.2746e+01_r8,1.9506e+01_r8,1.6255e+01_r8,1.3009e+01_r8,9.7479e+00_r8, & + &6.5045e+00_r8,3.2511e+00_r8,1.6976e-05_r8/) + kao(:, 4,10,10) = (/ & + &2.4905e+01_r8,2.1818e+01_r8,1.8660e+01_r8,1.5572e+01_r8,1.2451e+01_r8,9.3433e+00_r8, & + &6.2220e+00_r8,3.1125e+00_r8,2.8117e-05_r8/) + kao(:, 5,10,10) = (/ & + &2.5169e+01_r8,2.2024e+01_r8,1.8885e+01_r8,1.5746e+01_r8,1.2587e+01_r8,9.4388e+00_r8, & + &6.2934e+00_r8,3.1427e+00_r8,4.4861e-05_r8/) + kao(:, 1,11,10) = (/ & + &4.3366e+01_r8,3.7949e+01_r8,3.2540e+01_r8,2.7105e+01_r8,2.1683e+01_r8,1.6263e+01_r8, & + &1.0837e+01_r8,5.4210e+00_r8,4.9323e-06_r8/) + kao(:, 2,11,10) = (/ & + &4.4481e+01_r8,3.8935e+01_r8,3.3362e+01_r8,2.7791e+01_r8,2.2247e+01_r8,1.6680e+01_r8, & + &1.1125e+01_r8,5.5599e+00_r8,8.9387e-06_r8/) + kao(:, 3,11,10) = (/ & + &4.2759e+01_r8,3.7428e+01_r8,3.2070e+01_r8,2.6725e+01_r8,2.1369e+01_r8,1.6026e+01_r8, & + &1.0686e+01_r8,5.3424e+00_r8,1.3904e-05_r8/) + kao(:, 4,11,10) = (/ & + &4.2776e+01_r8,3.7387e+01_r8,3.2051e+01_r8,2.6735e+01_r8,2.1399e+01_r8,1.6039e+01_r8, & + &1.0699e+01_r8,5.3492e+00_r8,2.3732e-05_r8/) + kao(:, 5,11,10) = (/ & + &4.2881e+01_r8,3.7499e+01_r8,3.2160e+01_r8,2.6814e+01_r8,2.1427e+01_r8,1.6080e+01_r8, & + &1.0724e+01_r8,5.3602e+00_r8,3.9053e-05_r8/) + kao(:, 1,12,10) = (/ & + &5.2035e+01_r8,4.5530e+01_r8,3.8991e+01_r8,3.2521e+01_r8,2.6007e+01_r8,1.9502e+01_r8, & + &1.3003e+01_r8,6.5017e+00_r8,4.1086e-06_r8/) + kao(:, 2,12,10) = (/ & + &5.2620e+01_r8,4.6040e+01_r8,3.9465e+01_r8,3.2876e+01_r8,2.6300e+01_r8,1.9726e+01_r8, & + &1.3150e+01_r8,6.5751e+00_r8,7.6006e-06_r8/) + kao(:, 3,12,10) = (/ & + &5.1699e+01_r8,4.5233e+01_r8,3.8772e+01_r8,3.2297e+01_r8,2.5847e+01_r8,1.9404e+01_r8, & + &1.2928e+01_r8,6.4618e+00_r8,1.3155e-05_r8/) + kao(:, 4,12,10) = (/ & + &5.1530e+01_r8,4.5092e+01_r8,3.8615e+01_r8,3.2196e+01_r8,2.5751e+01_r8,1.9320e+01_r8, & + &1.2877e+01_r8,6.4388e+00_r8,2.2125e-05_r8/) + kao(:, 5,12,10) = (/ & + &5.2358e+01_r8,4.5788e+01_r8,3.9246e+01_r8,3.2725e+01_r8,2.6162e+01_r8,1.9634e+01_r8, & + &1.3083e+01_r8,6.5448e+00_r8,3.4034e-05_r8/) + kao(:, 1,13,10) = (/ & + &4.8070e+01_r8,4.2058e+01_r8,3.6028e+01_r8,3.0041e+01_r8,2.4032e+01_r8,1.8020e+01_r8, & + &1.2016e+01_r8,6.0067e+00_r8,1.1683e-05_r8/) + kao(:, 2,13,10) = (/ & + &4.7586e+01_r8,4.1613e+01_r8,3.5689e+01_r8,2.9748e+01_r8,2.3780e+01_r8,1.7835e+01_r8, & + &1.1890e+01_r8,5.9450e+00_r8,6.6906e-06_r8/) + kao(:, 3,13,10) = (/ & + &4.7760e+01_r8,4.1804e+01_r8,3.5818e+01_r8,2.9821e+01_r8,2.3863e+01_r8,1.7898e+01_r8, & + &1.1923e+01_r8,5.9715e+00_r8,1.1688e-05_r8/) + kao(:, 4,13,10) = (/ & + &4.7976e+01_r8,4.1998e+01_r8,3.6011e+01_r8,3.0021e+01_r8,2.3989e+01_r8,1.7987e+01_r8, & + &1.2008e+01_r8,6.0018e+00_r8,2.0801e-05_r8/) + kao(:, 5,13,10) = (/ & + &4.8185e+01_r8,4.2179e+01_r8,3.6131e+01_r8,3.0110e+01_r8,2.4087e+01_r8,1.8066e+01_r8, & + &1.2054e+01_r8,6.0193e+00_r8,3.3629e-05_r8/) + kao(:, 1, 1,11) = (/ & + &2.3144e-03_r8,3.0235e-03_r8,4.2030e-03_r8,4.5486e-03_r8,6.9673e-03_r8,8.5656e-03_r8, & + &1.0150e-02_r8,1.3548e-02_r8,1.3475e-02_r8/) + kao(:, 2, 1,11) = (/ & + &2.0416e-03_r8,3.1999e-03_r8,4.6569e-03_r8,6.4031e-03_r8,9.8267e-03_r8,1.1395e-02_r8, & + &1.5022e-02_r8,1.8877e-02_r8,1.8904e-02_r8/) + kao(:, 3, 1,11) = (/ & + &1.8509e-03_r8,4.2185e-03_r8,5.5775e-03_r8,9.1095e-03_r8,1.2979e-02_r8,1.4639e-02_r8, & + &2.1829e-02_r8,2.5577e-02_r8,2.5272e-02_r8/) + kao(:, 4, 1,11) = (/ & + &1.7995e-03_r8,5.2396e-03_r8,7.4739e-03_r8,1.1646e-02_r8,1.7153e-02_r8,1.9747e-02_r8, & + &2.8712e-02_r8,3.3739e-02_r8,3.3147e-02_r8/) + kao(:, 5, 1,11) = (/ & + &1.8412e-03_r8,6.1417e-03_r8,9.5119e-03_r8,1.5457e-02_r8,2.1034e-02_r8,2.5800e-02_r8, & + &3.6795e-02_r8,4.3339e-02_r8,4.2100e-02_r8/) + kao(:, 1, 2,11) = (/ & + &7.4427e-03_r8,5.5490e-03_r8,4.6664e-03_r8,4.6380e-03_r8,5.2610e-03_r8,8.4068e-03_r8, & + &1.0505e-02_r8,1.1967e-02_r8,1.0119e-02_r8/) + kao(:, 2, 2,11) = (/ & + &5.3180e-03_r8,5.4523e-03_r8,5.6480e-03_r8,5.7960e-03_r8,8.0504e-03_r8,1.1015e-02_r8, & + &1.3308e-02_r8,1.6901e-02_r8,1.5834e-02_r8/) + kao(:, 3, 2,11) = (/ & + &4.1509e-03_r8,5.0420e-03_r8,5.9494e-03_r8,7.8778e-03_r8,1.1077e-02_r8,1.4709e-02_r8, & + &1.7403e-02_r8,2.2592e-02_r8,2.1710e-02_r8/) + kao(:, 4, 2,11) = (/ & + &3.7251e-03_r8,5.8604e-03_r8,7.1881e-03_r8,1.0249e-02_r8,1.4831e-02_r8,1.9015e-02_r8, & + &2.1299e-02_r8,2.9770e-02_r8,2.9198e-02_r8/) + kao(:, 5, 2,11) = (/ & + &3.3170e-03_r8,7.3759e-03_r8,9.2312e-03_r8,1.4285e-02_r8,1.9035e-02_r8,2.3096e-02_r8, & + &2.6856e-02_r8,3.8325e-02_r8,3.7190e-02_r8/) + kao(:, 1, 3,11) = (/ & + &2.3930e-02_r8,2.1175e-02_r8,1.8068e-02_r8,1.3752e-02_r8,9.3232e-03_r8,6.3033e-03_r8, & + &9.0890e-03_r8,1.0309e-02_r8,9.2920e-03_r8/) + kao(:, 2, 3,11) = (/ & + &2.1364e-02_r8,1.8346e-02_r8,1.4408e-02_r8,1.0567e-02_r8,7.3487e-03_r8,8.3255e-03_r8, & + &1.2320e-02_r8,1.3559e-02_r8,1.1942e-02_r8/) + kao(:, 3, 3,11) = (/ & + &1.6897e-02_r8,1.4069e-02_r8,1.1090e-02_r8,9.4072e-03_r8,9.0158e-03_r8,1.2182e-02_r8, & + &1.6529e-02_r8,1.8032e-02_r8,1.6702e-02_r8/) + kao(:, 4, 3,11) = (/ & + &1.1735e-02_r8,1.1062e-02_r8,1.1919e-02_r8,1.0177e-02_r8,1.1885e-02_r8,1.6740e-02_r8, & + &2.0422e-02_r8,2.2761e-02_r8,2.2381e-02_r8/) + kao(:, 5, 3,11) = (/ & + &9.3268e-03_r8,1.0886e-02_r8,1.2245e-02_r8,1.2355e-02_r8,1.5695e-02_r8,2.1667e-02_r8, & + &2.4460e-02_r8,2.7729e-02_r8,3.0274e-02_r8/) + kao(:, 1, 4,11) = (/ & + &5.8030e-02_r8,5.0790e-02_r8,4.4332e-02_r8,3.7503e-02_r8,3.1337e-02_r8,2.3862e-02_r8, & + &1.5919e-02_r8,8.9924e-03_r8,1.0517e-02_r8/) + kao(:, 2, 4,11) = (/ & + &5.8203e-02_r8,5.1238e-02_r8,4.3852e-02_r8,3.6687e-02_r8,2.8842e-02_r8,2.1050e-02_r8, & + &1.3525e-02_r8,1.1884e-02_r8,1.5506e-02_r8/) + kao(:, 3, 4,11) = (/ & + &6.0219e-02_r8,5.3113e-02_r8,4.5845e-02_r8,3.6288e-02_r8,2.6852e-02_r8,1.6648e-02_r8, & + &1.3537e-02_r8,1.6277e-02_r8,1.8129e-02_r8/) + kao(:, 4, 4,11) = (/ & + &4.9871e-02_r8,4.2283e-02_r8,3.5849e-02_r8,2.8922e-02_r8,1.9343e-02_r8,1.4341e-02_r8, & + &1.8188e-02_r8,2.0990e-02_r8,2.0822e-02_r8/) + kao(:, 5, 4,11) = (/ & + &3.8385e-02_r8,3.4058e-02_r8,2.7365e-02_r8,2.1994e-02_r8,1.7140e-02_r8,1.6164e-02_r8, & + &2.3472e-02_r8,2.6305e-02_r8,2.6373e-02_r8/) + kao(:, 1, 5,11) = (/ & + &1.3556e-01_r8,1.1844e-01_r8,1.0158e-01_r8,8.5252e-02_r8,6.8440e-02_r8,5.1875e-02_r8, & + &3.5448e-02_r8,1.8978e-02_r8,8.8762e-03_r8/) + kao(:, 2, 5,11) = (/ & + &1.3807e-01_r8,1.2082e-01_r8,1.0421e-01_r8,8.7432e-02_r8,7.0858e-02_r8,5.4903e-02_r8, & + &3.7824e-02_r8,2.0068e-02_r8,1.1692e-02_r8/) + kao(:, 3, 5,11) = (/ & + &1.3721e-01_r8,1.2013e-01_r8,1.0360e-01_r8,8.7259e-02_r8,7.0575e-02_r8,5.3560e-02_r8, & + &3.5670e-02_r8,1.8870e-02_r8,1.8216e-02_r8/) + kao(:, 4, 5,11) = (/ & + &1.2962e-01_r8,1.1333e-01_r8,9.6679e-02_r8,8.1723e-02_r8,6.6334e-02_r8,5.1939e-02_r8, & + &3.3737e-02_r8,2.0192e-02_r8,2.7154e-02_r8/) + kao(:, 5, 5,11) = (/ & + &1.2340e-01_r8,1.0852e-01_r8,9.2540e-02_r8,7.8313e-02_r8,6.2622e-02_r8,4.1413e-02_r8, & + &2.5923e-02_r8,2.4326e-02_r8,3.4052e-02_r8/) + kao(:, 1, 6,11) = (/ & + &2.8825e-01_r8,2.5222e-01_r8,2.1620e-01_r8,1.8017e-01_r8,1.4417e-01_r8,1.0893e-01_r8, & + &7.3359e-02_r8,3.7509e-02_r8,5.6670e-03_r8/) + kao(:, 2, 6,11) = (/ & + &2.8768e-01_r8,2.5188e-01_r8,2.1600e-01_r8,1.7993e-01_r8,1.4497e-01_r8,1.0976e-01_r8, & + &7.3838e-02_r8,3.8599e-02_r8,8.8428e-03_r8/) + kao(:, 3, 6,11) = (/ & + &2.8241e-01_r8,2.4722e-01_r8,2.1181e-01_r8,1.7724e-01_r8,1.4248e-01_r8,1.0766e-01_r8, & + &7.3624e-02_r8,3.9950e-02_r8,1.3973e-02_r8/) + kao(:, 4, 6,11) = (/ & + &2.8627e-01_r8,2.5067e-01_r8,2.1487e-01_r8,1.8056e-01_r8,1.4619e-01_r8,1.1172e-01_r8, & + &7.8306e-02_r8,4.0986e-02_r8,2.0403e-02_r8/) + kao(:, 5, 6,11) = (/ & + &2.7874e-01_r8,2.4399e-01_r8,2.0989e-01_r8,1.7645e-01_r8,1.4231e-01_r8,1.0969e-01_r8, & + &7.6704e-02_r8,4.0995e-02_r8,2.4450e-02_r8/) + kao(:, 1, 7,11) = (/ & + &6.1169e-01_r8,5.3575e-01_r8,4.5923e-01_r8,3.8252e-01_r8,3.0616e-01_r8,2.2929e-01_r8, & + &1.5383e-01_r8,7.7531e-02_r8,2.8956e-03_r8/) + kao(:, 2, 7,11) = (/ & + &6.1159e-01_r8,5.3511e-01_r8,4.5848e-01_r8,3.8242e-01_r8,3.0567e-01_r8,2.3004e-01_r8, & + &1.5345e-01_r8,7.7731e-02_r8,6.2629e-03_r8/) + kao(:, 3, 7,11) = (/ & + &6.0642e-01_r8,5.3036e-01_r8,4.5410e-01_r8,3.7880e-01_r8,3.0308e-01_r8,2.2893e-01_r8, & + &1.5450e-01_r8,7.9546e-02_r8,1.1879e-02_r8/) + kao(:, 4, 7,11) = (/ & + &6.2322e-01_r8,5.4531e-01_r8,4.6718e-01_r8,3.8974e-01_r8,3.1356e-01_r8,2.3563e-01_r8, & + &1.5873e-01_r8,8.1521e-02_r8,1.3030e-02_r8/) + kao(:, 5, 7,11) = (/ & + &6.1773e-01_r8,5.4019e-01_r8,4.6283e-01_r8,3.8859e-01_r8,3.1161e-01_r8,2.3601e-01_r8, & + &1.5998e-01_r8,8.3125e-02_r8,1.9458e-02_r8/) + kao(:, 1, 8,11) = (/ & + &1.4932e+00_r8,1.3065e+00_r8,1.1199e+00_r8,9.3315e-01_r8,7.4665e-01_r8,5.5991e-01_r8, & + &3.7327e-01_r8,1.8697e-01_r8,1.1999e-05_r8/) + kao(:, 2, 8,11) = (/ & + &1.5196e+00_r8,1.3312e+00_r8,1.1397e+00_r8,9.5010e-01_r8,7.6026e-01_r8,5.7020e-01_r8, & + &3.8013e-01_r8,1.9174e-01_r8,7.7042e-03_r8/) + kao(:, 3, 8,11) = (/ & + &1.5505e+00_r8,1.3567e+00_r8,1.1629e+00_r8,9.6902e-01_r8,7.7525e-01_r8,5.8146e-01_r8, & + &3.8981e-01_r8,1.9691e-01_r8,1.2006e-02_r8/) + kao(:, 4, 8,11) = (/ & + &1.4878e+00_r8,1.3018e+00_r8,1.1160e+00_r8,9.2984e-01_r8,7.4341e-01_r8,5.5771e-01_r8, & + &3.7622e-01_r8,1.9146e-01_r8,1.2696e-02_r8/) + kao(:, 5, 8,11) = (/ & + &1.4729e+00_r8,1.2883e+00_r8,1.1049e+00_r8,9.2129e-01_r8,7.3618e-01_r8,5.5599e-01_r8, & + &3.7163e-01_r8,1.8805e-01_r8,1.8722e-02_r8/) + kao(:, 1, 9,11) = (/ & + &6.8904e+00_r8,6.0266e+00_r8,5.1680e+00_r8,4.3068e+00_r8,3.4452e+00_r8,2.5839e+00_r8, & + &1.7234e+00_r8,8.6092e-01_r8,6.7224e-06_r8/) + kao(:, 2, 9,11) = (/ & + &7.0980e+00_r8,6.2107e+00_r8,5.3294e+00_r8,4.4415e+00_r8,3.5510e+00_r8,2.6633e+00_r8, & + &1.7755e+00_r8,8.8723e-01_r8,1.2025e-05_r8/) + kao(:, 3, 9,11) = (/ & + &7.2688e+00_r8,6.3564e+00_r8,5.4482e+00_r8,4.5401e+00_r8,3.6343e+00_r8,2.7243e+00_r8, & + &1.8161e+00_r8,9.0754e-01_r8,1.9985e-05_r8/) + kao(:, 4, 9,11) = (/ & + &7.1740e+00_r8,6.2782e+00_r8,5.3807e+00_r8,4.4818e+00_r8,3.5855e+00_r8,2.6901e+00_r8, & + &1.7938e+00_r8,8.9646e-01_r8,3.0947e-05_r8/) + kao(:, 5, 9,11) = (/ & + &6.7468e+00_r8,5.9097e+00_r8,5.0601e+00_r8,4.2188e+00_r8,3.3754e+00_r8,2.5313e+00_r8, & + &1.6873e+00_r8,8.4597e-01_r8,4.6476e-05_r8/) + kao(:, 1,10,11) = (/ & + &3.5457e+01_r8,3.1027e+01_r8,2.6582e+01_r8,2.2175e+01_r8,1.7740e+01_r8,1.3297e+01_r8, & + &8.8648e+00_r8,4.4349e+00_r8,3.8551e-06_r8/) + kao(:, 2,10,11) = (/ & + &3.5857e+01_r8,3.1366e+01_r8,2.6891e+01_r8,2.2421e+01_r8,1.7929e+01_r8,1.3446e+01_r8, & + &8.9645e+00_r8,4.4822e+00_r8,7.1785e-06_r8/) + kao(:, 3,10,11) = (/ & + &3.7065e+01_r8,3.2447e+01_r8,2.7799e+01_r8,2.3166e+01_r8,1.8532e+01_r8,1.3906e+01_r8, & + &9.2664e+00_r8,4.6331e+00_r8,1.2630e-05_r8/) + kao(:, 4,10,11) = (/ & + &3.6718e+01_r8,3.2113e+01_r8,2.7539e+01_r8,2.2938e+01_r8,1.8366e+01_r8,1.3764e+01_r8, & + &9.1841e+00_r8,4.5916e+00_r8,2.1179e-05_r8/) + kao(:, 5,10,11) = (/ & + &3.5010e+01_r8,3.0613e+01_r8,2.6257e+01_r8,2.1870e+01_r8,1.7497e+01_r8,1.3129e+01_r8, & + &8.7481e+00_r8,4.3808e+00_r8,3.3504e-05_r8/) + kao(:, 1,11,11) = (/ & + &6.2218e+01_r8,5.4427e+01_r8,4.6646e+01_r8,3.8874e+01_r8,3.1110e+01_r8,2.3334e+01_r8, & + &1.5561e+01_r8,7.7776e+00_r8,3.5875e-06_r8/) + kao(:, 2,11,11) = (/ & + &6.2105e+01_r8,5.4407e+01_r8,4.6579e+01_r8,3.8839e+01_r8,3.1033e+01_r8,2.3318e+01_r8, & + &1.5536e+01_r8,7.7679e+00_r8,5.9066e-06_r8/) + kao(:, 3,11,11) = (/ & + &6.4816e+01_r8,5.6715e+01_r8,4.8615e+01_r8,4.0513e+01_r8,3.2442e+01_r8,2.4317e+01_r8, & + &1.6205e+01_r8,8.1056e+00_r8,1.0776e-05_r8/) + kao(:, 4,11,11) = (/ & + &6.2787e+01_r8,5.4987e+01_r8,4.7112e+01_r8,3.9241e+01_r8,3.1378e+01_r8,2.3555e+01_r8, & + &1.5697e+01_r8,7.8485e+00_r8,1.7304e-05_r8/) + kao(:, 5,11,11) = (/ & + &6.1876e+01_r8,5.4130e+01_r8,4.6407e+01_r8,3.8627e+01_r8,3.0933e+01_r8,2.3204e+01_r8, & + &1.5469e+01_r8,7.7346e+00_r8,2.7512e-05_r8/) + kao(:, 1,12,11) = (/ & + &8.0103e+01_r8,7.0095e+01_r8,6.0103e+01_r8,5.0066e+01_r8,4.0052e+01_r8,3.0040e+01_r8, & + &2.0026e+01_r8,1.0013e+01_r8,3.2505e-06_r8/) + kao(:, 2,12,11) = (/ & + &7.9090e+01_r8,6.9204e+01_r8,5.9318e+01_r8,4.9432e+01_r8,3.9544e+01_r8,2.9659e+01_r8, & + &1.9773e+01_r8,9.8860e+00_r8,5.5034e-06_r8/) + kao(:, 3,12,11) = (/ & + &7.9848e+01_r8,6.9859e+01_r8,5.9882e+01_r8,4.9902e+01_r8,3.9894e+01_r8,2.9946e+01_r8, & + &1.9960e+01_r8,9.9805e+00_r8,8.6063e-06_r8/) + kao(:, 4,12,11) = (/ & + &7.8661e+01_r8,6.8779e+01_r8,5.8977e+01_r8,4.9159e+01_r8,3.9293e+01_r8,2.9497e+01_r8, & + &1.9663e+01_r8,9.8183e+00_r8,1.4131e-05_r8/) + kao(:, 5,12,11) = (/ & + &7.8792e+01_r8,6.8975e+01_r8,5.9124e+01_r8,4.9246e+01_r8,3.9445e+01_r8,2.9569e+01_r8, & + &1.9707e+01_r8,9.8563e+00_r8,2.3305e-05_r8/) + kao(:, 1,13,11) = (/ & + &7.5314e+01_r8,6.5898e+01_r8,5.6507e+01_r8,4.7072e+01_r8,3.7657e+01_r8,2.8254e+01_r8, & + &1.8828e+01_r8,9.4159e+00_r8,2.7819e-06_r8/) + kao(:, 2,13,11) = (/ & + &7.4029e+01_r8,6.4852e+01_r8,5.5523e+01_r8,4.6247e+01_r8,3.7031e+01_r8,2.7774e+01_r8, & + &1.8528e+01_r8,9.2576e+00_r8,5.0908e-06_r8/) + kao(:, 3,13,11) = (/ & + &7.3797e+01_r8,6.4573e+01_r8,5.5347e+01_r8,4.6143e+01_r8,3.6917e+01_r8,2.7689e+01_r8, & + &1.8458e+01_r8,9.2250e+00_r8,8.2936e-06_r8/) + kao(:, 4,13,11) = (/ & + &7.5507e+01_r8,6.6112e+01_r8,5.6628e+01_r8,4.7225e+01_r8,3.7779e+01_r8,2.8348e+01_r8, & + &1.8877e+01_r8,9.4449e+00_r8,1.2487e-05_r8/) + kao(:, 5,13,11) = (/ & + &7.6962e+01_r8,6.7290e+01_r8,5.7729e+01_r8,4.8107e+01_r8,3.8486e+01_r8,2.8863e+01_r8, & + &1.9221e+01_r8,9.6284e+00_r8,1.8751e-05_r8/) + kao(:, 1, 1,12) = (/ & + &1.1046e-03_r8,3.3707e-03_r8,5.0558e-03_r8,8.2647e-03_r8,9.1015e-03_r8,1.0694e-02_r8, & + &1.8807e-02_r8,2.2647e-02_r8,1.8110e-02_r8/) + kao(:, 2, 1,12) = (/ & + &1.0969e-03_r8,4.7708e-03_r8,7.6740e-03_r8,1.0546e-02_r8,1.0900e-02_r8,1.6801e-02_r8, & + &2.5799e-02_r8,3.1294e-02_r8,2.2312e-02_r8/) + kao(:, 3, 1,12) = (/ & + &1.0873e-03_r8,6.1594e-03_r8,1.0535e-02_r8,1.2275e-02_r8,1.5399e-02_r8,2.5780e-02_r8, & + &3.4278e-02_r8,4.1551e-02_r8,3.1702e-02_r8/) + kao(:, 4, 1,12) = (/ & + &1.0681e-03_r8,6.7407e-03_r8,1.3124e-02_r8,1.6579e-02_r8,1.9835e-02_r8,3.5596e-02_r8, & + &4.4369e-02_r8,5.3472e-02_r8,4.1109e-02_r8/) + kao(:, 5, 1,12) = (/ & + &1.0270e-03_r8,8.1418e-03_r8,1.5112e-02_r8,2.0848e-02_r8,2.8658e-02_r8,4.6490e-02_r8, & + &5.6118e-02_r8,6.7233e-02_r8,5.7448e-02_r8/) + kao(:, 1, 2,12) = (/ & + &1.5646e-03_r8,3.6954e-03_r8,5.8279e-03_r8,7.1796e-03_r8,9.8217e-03_r8,9.7524e-03_r8, & + &1.1081e-02_r8,1.8489e-02_r8,1.8167e-02_r8/) + kao(:, 2, 2,12) = (/ & + &1.5547e-03_r8,3.8903e-03_r8,7.0691e-03_r8,1.0316e-02_r8,1.1952e-02_r8,1.3642e-02_r8, & + &1.6631e-02_r8,2.5775e-02_r8,2.2105e-02_r8/) + kao(:, 3, 2,12) = (/ & + &1.5005e-03_r8,5.8120e-03_r8,1.0164e-02_r8,1.2828e-02_r8,1.5616e-02_r8,1.8084e-02_r8, & + &2.4815e-02_r8,3.4836e-02_r8,2.8922e-02_r8/) + kao(:, 4, 2,12) = (/ & + &1.4224e-03_r8,7.6958e-03_r8,1.3586e-02_r8,1.5505e-02_r8,1.9916e-02_r8,2.3661e-02_r8, & + &3.6496e-02_r8,4.5732e-02_r8,3.8152e-02_r8/) + kao(:, 5, 2,12) = (/ & + &1.3736e-03_r8,9.1086e-03_r8,1.6016e-02_r8,2.0127e-02_r8,2.5470e-02_r8,3.1020e-02_r8, & + &5.0141e-02_r8,5.8654e-02_r8,5.1074e-02_r8/) + kao(:, 1, 3,12) = (/ & + &1.0482e-02_r8,8.9646e-03_r8,6.8350e-03_r8,8.2815e-03_r8,8.8992e-03_r8,1.0605e-02_r8, & + &1.0328e-02_r8,1.1583e-02_r8,1.6044e-02_r8/) + kao(:, 2, 3,12) = (/ & + &5.7078e-03_r8,6.1160e-03_r8,7.6830e-03_r8,9.7377e-03_r8,1.2964e-02_r8,1.2587e-02_r8, & + &1.4124e-02_r8,1.6978e-02_r8,2.4120e-02_r8/) + kao(:, 3, 3,12) = (/ & + &3.9502e-03_r8,6.0459e-03_r8,1.0569e-02_r8,1.4120e-02_r8,1.6811e-02_r8,1.6440e-02_r8, & + &1.9141e-02_r8,2.2713e-02_r8,3.1566e-02_r8/) + kao(:, 4, 3,12) = (/ & + &3.2701e-03_r8,7.5815e-03_r8,1.2592e-02_r8,1.9220e-02_r8,1.9128e-02_r8,2.1966e-02_r8, & + &2.6084e-02_r8,3.3096e-02_r8,3.6118e-02_r8/) + kao(:, 5, 3,12) = (/ & + &2.7401e-03_r8,7.8080e-03_r8,1.5492e-02_r8,2.3290e-02_r8,2.4892e-02_r8,2.8848e-02_r8, & + &3.4321e-02_r8,4.6873e-02_r8,4.7340e-02_r8/) + kao(:, 1, 4,12) = (/ & + &6.0672e-02_r8,5.3090e-02_r8,4.4556e-02_r8,3.6202e-02_r8,2.6483e-02_r8,1.8181e-02_r8, & + &1.2199e-02_r8,1.0993e-02_r8,1.4969e-02_r8/) + kao(:, 2, 4,12) = (/ & + &4.3589e-02_r8,3.8144e-02_r8,3.0755e-02_r8,2.3593e-02_r8,1.9730e-02_r8,1.5624e-02_r8, & + &1.3490e-02_r8,1.5542e-02_r8,2.0057e-02_r8/) + kao(:, 3, 4,12) = (/ & + &2.4695e-02_r8,2.2865e-02_r8,1.7074e-02_r8,1.5816e-02_r8,1.6661e-02_r8,2.0463e-02_r8, & + &1.7348e-02_r8,2.1210e-02_r8,2.8829e-02_r8/) + kao(:, 4, 4,12) = (/ & + &1.4306e-02_r8,1.8283e-02_r8,1.4453e-02_r8,1.9081e-02_r8,2.2731e-02_r8,2.4085e-02_r8, & + &2.3223e-02_r8,2.7809e-02_r8,4.1362e-02_r8/) + kao(:, 5, 4,12) = (/ & + &1.0713e-02_r8,1.1979e-02_r8,1.4158e-02_r8,2.2119e-02_r8,2.9428e-02_r8,2.9426e-02_r8, & + &3.0795e-02_r8,3.5958e-02_r8,5.4444e-02_r8/) + kao(:, 1, 5,12) = (/ & + &1.5652e-01_r8,1.3723e-01_r8,1.1755e-01_r8,9.8247e-02_r8,7.8467e-02_r8,5.9349e-02_r8, & + &3.9820e-02_r8,1.8398e-02_r8,1.1394e-02_r8/) + kao(:, 2, 5,12) = (/ & + &1.5350e-01_r8,1.3431e-01_r8,1.1514e-01_r8,9.6381e-02_r8,7.7667e-02_r8,5.6368e-02_r8, & + &3.3743e-02_r8,1.4780e-02_r8,1.5913e-02_r8/) + kao(:, 3, 5,12) = (/ & + &1.3349e-01_r8,1.1672e-01_r8,9.9565e-02_r8,8.1852e-02_r8,6.1169e-02_r8,4.3464e-02_r8, & + &2.9522e-02_r8,1.7569e-02_r8,2.3571e-02_r8/) + kao(:, 4, 5,12) = (/ & + &1.0423e-01_r8,9.1271e-02_r8,7.7253e-02_r8,6.0811e-02_r8,4.8046e-02_r8,3.4464e-02_r8, & + &2.5349e-02_r8,2.3626e-02_r8,3.4271e-02_r8/) + kao(:, 5, 5,12) = (/ & + &6.1168e-02_r8,5.3666e-02_r8,4.5385e-02_r8,3.6131e-02_r8,3.2187e-02_r8,3.6873e-02_r8, & + &3.0883e-02_r8,3.2443e-02_r8,4.3030e-02_r8/) + kao(:, 1, 6,12) = (/ & + &3.3296e-01_r8,2.9114e-01_r8,2.4975e-01_r8,2.0812e-01_r8,1.6650e-01_r8,1.2577e-01_r8, & + &8.4465e-02_r8,4.3210e-02_r8,7.5744e-03_r8/) + kao(:, 2, 6,12) = (/ & + &3.2661e-01_r8,2.8604e-01_r8,2.4502e-01_r8,2.0429e-01_r8,1.6474e-01_r8,1.2400e-01_r8, & + &8.4046e-02_r8,4.3324e-02_r8,1.2737e-02_r8/) + kao(:, 3, 6,12) = (/ & + &3.3274e-01_r8,2.9155e-01_r8,2.4958e-01_r8,2.1022e-01_r8,1.6841e-01_r8,1.2817e-01_r8, & + &8.5832e-02_r8,4.1156e-02_r8,1.9272e-02_r8/) + kao(:, 4, 6,12) = (/ & + &3.2428e-01_r8,2.8378e-01_r8,2.4307e-01_r8,2.0420e-01_r8,1.6451e-01_r8,1.2138e-01_r8, & + &7.6212e-02_r8,3.3602e-02_r8,2.1893e-02_r8/) + kao(:, 5, 6,12) = (/ & + &2.8830e-01_r8,2.5208e-01_r8,2.1788e-01_r8,1.7562e-01_r8,1.3634e-01_r8,9.6797e-02_r8, & + &6.1659e-02_r8,2.8996e-02_r8,3.3943e-02_r8/) + kao(:, 1, 7,12) = (/ & + &7.1633e-01_r8,6.2687e-01_r8,5.3652e-01_r8,4.4712e-01_r8,3.5797e-01_r8,2.6845e-01_r8, & + &1.7938e-01_r8,9.0924e-02_r8,9.7506e-03_r8/) + kao(:, 2, 7,12) = (/ & + &7.4602e-01_r8,6.5233e-01_r8,5.5949e-01_r8,4.6595e-01_r8,3.7278e-01_r8,2.7940e-01_r8, & + &1.8898e-01_r8,9.6146e-02_r8,1.9089e-02_r8/) + kao(:, 3, 7,12) = (/ & + &7.5756e-01_r8,6.6287e-01_r8,5.6888e-01_r8,4.7384e-01_r8,3.7881e-01_r8,2.8626e-01_r8, & + &1.9222e-01_r8,9.8080e-02_r8,1.5850e-02_r8/) + kao(:, 4, 7,12) = (/ & + &7.2210e-01_r8,6.3187e-01_r8,5.4195e-01_r8,4.5134e-01_r8,3.6428e-01_r8,2.7503e-01_r8, & + &1.8532e-01_r8,9.5998e-02_r8,2.2744e-02_r8/) + kao(:, 5, 7,12) = (/ & + &7.1833e-01_r8,6.2908e-01_r8,5.3886e-01_r8,4.4907e-01_r8,3.6079e-01_r8,2.7147e-01_r8, & + &1.8148e-01_r8,9.1961e-02_r8,3.2788e-02_r8/) + kao(:, 1, 8,12) = (/ & + &1.8651e+00_r8,1.6319e+00_r8,1.3988e+00_r8,1.1656e+00_r8,9.3248e-01_r8,6.9936e-01_r8, & + &4.6627e-01_r8,2.3315e-01_r8,7.1174e-06_r8/) + kao(:, 2, 8,12) = (/ & + &1.9142e+00_r8,1.6730e+00_r8,1.4347e+00_r8,1.1964e+00_r8,9.5588e-01_r8,7.1697e-01_r8, & + &4.7797e-01_r8,2.4089e-01_r8,1.3089e-05_r8/) + kao(:, 3, 8,12) = (/ & + &1.9338e+00_r8,1.6922e+00_r8,1.4504e+00_r8,1.2080e+00_r8,9.6694e-01_r8,7.2522e-01_r8, & + &4.8350e-01_r8,2.4403e-01_r8,6.4382e-03_r8/) + kao(:, 4, 8,12) = (/ & + &1.9257e+00_r8,1.6851e+00_r8,1.4444e+00_r8,1.2027e+00_r8,9.6352e-01_r8,7.2222e-01_r8, & + &4.8580e-01_r8,2.4642e-01_r8,2.0202e-02_r8/) + kao(:, 5, 8,12) = (/ & + &1.8578e+00_r8,1.6228e+00_r8,1.3921e+00_r8,1.1585e+00_r8,9.2745e-01_r8,6.9620e-01_r8, & + &4.7147e-01_r8,2.4294e-01_r8,3.5578e-02_r8/) + kao(:, 1, 9,12) = (/ & + &8.9732e+00_r8,7.8574e+00_r8,6.7348e+00_r8,5.6085e+00_r8,4.4901e+00_r8,3.3675e+00_r8, & + &2.2449e+00_r8,1.1217e+00_r8,5.5128e-06_r8/) + kao(:, 2, 9,12) = (/ & + &9.0176e+00_r8,7.8899e+00_r8,6.7555e+00_r8,5.6293e+00_r8,4.5061e+00_r8,3.3798e+00_r8, & + &2.2531e+00_r8,1.1272e+00_r8,1.0749e-05_r8/) + kao(:, 3, 9,12) = (/ & + &9.1462e+00_r8,8.0080e+00_r8,6.8640e+00_r8,5.7226e+00_r8,4.5733e+00_r8,3.4343e+00_r8, & + &2.2880e+00_r8,1.1452e+00_r8,1.7030e-05_r8/) + kao(:, 4, 9,12) = (/ & + &9.3997e+00_r8,8.2308e+00_r8,7.0500e+00_r8,5.8749e+00_r8,4.7035e+00_r8,3.5295e+00_r8, & + &2.3500e+00_r8,1.1750e+00_r8,2.7289e-05_r8/) + kao(:, 5, 9,12) = (/ & + &9.4496e+00_r8,8.2622e+00_r8,7.0818e+00_r8,5.9018e+00_r8,4.7215e+00_r8,3.5410e+00_r8, & + &2.3622e+00_r8,1.1804e+00_r8,4.0208e-05_r8/) + kao(:, 1,10,12) = (/ & + &4.7340e+01_r8,4.1390e+01_r8,3.5503e+01_r8,2.9570e+01_r8,2.3638e+01_r8,1.7753e+01_r8, & + &1.1835e+01_r8,5.9140e+00_r8,4.0857e-06_r8/) + kao(:, 2,10,12) = (/ & + &4.7468e+01_r8,4.1532e+01_r8,3.5600e+01_r8,2.9666e+01_r8,2.3733e+01_r8,1.7801e+01_r8, & + &1.1867e+01_r8,5.9335e+00_r8,7.3318e-06_r8/) + kao(:, 3,10,12) = (/ & + &4.7779e+01_r8,4.1808e+01_r8,3.5836e+01_r8,2.9862e+01_r8,2.3890e+01_r8,1.7931e+01_r8, & + &1.1954e+01_r8,5.9724e+00_r8,1.2287e-05_r8/) + kao(:, 4,10,12) = (/ & + &5.0181e+01_r8,4.3911e+01_r8,3.7609e+01_r8,3.1364e+01_r8,2.5077e+01_r8,1.8819e+01_r8, & + &1.2546e+01_r8,6.2708e+00_r8,2.0136e-05_r8/) + kao(:, 5,10,12) = (/ & + &5.0358e+01_r8,4.4054e+01_r8,3.7768e+01_r8,3.1474e+01_r8,2.5199e+01_r8,1.8885e+01_r8, & + &1.2590e+01_r8,6.2949e+00_r8,3.0786e-05_r8/) + kao(:, 1,11,12) = (/ & + &8.8012e+01_r8,7.7091e+01_r8,6.6061e+01_r8,5.5064e+01_r8,4.4041e+01_r8,3.3007e+01_r8, & + &2.2019e+01_r8,1.1017e+01_r8,3.6494e-06_r8/) + kao(:, 2,11,12) = (/ & + &8.9290e+01_r8,7.8045e+01_r8,6.6917e+01_r8,5.5778e+01_r8,4.4669e+01_r8,3.3448e+01_r8, & + &2.2295e+01_r8,1.1156e+01_r8,6.7273e-06_r8/) + kao(:, 3,11,12) = (/ & + &8.6982e+01_r8,7.6115e+01_r8,6.5187e+01_r8,5.4368e+01_r8,4.3469e+01_r8,3.2619e+01_r8, & + &2.1748e+01_r8,1.0873e+01_r8,1.1236e-05_r8/) + kao(:, 4,11,12) = (/ & + &8.9808e+01_r8,7.8580e+01_r8,6.7351e+01_r8,5.6127e+01_r8,4.4937e+01_r8,3.3677e+01_r8, & + &2.2469e+01_r8,1.1226e+01_r8,1.9240e-05_r8/) + kao(:, 5,11,12) = (/ & + &9.0868e+01_r8,7.9552e+01_r8,6.8146e+01_r8,5.6871e+01_r8,4.5498e+01_r8,3.4074e+01_r8, & + &2.2716e+01_r8,1.1367e+01_r8,2.9192e-05_r8/) + kao(:, 1,12,12) = (/ & + &1.1586e+02_r8,1.0129e+02_r8,8.6824e+01_r8,7.2354e+01_r8,5.7931e+01_r8,4.3416e+01_r8, & + &2.8943e+01_r8,1.4471e+01_r8,2.9778e-06_r8/) + kao(:, 2,12,12) = (/ & + &1.1852e+02_r8,1.0370e+02_r8,8.8887e+01_r8,7.4073e+01_r8,5.9259e+01_r8,4.4444e+01_r8, & + &2.9629e+01_r8,1.4815e+01_r8,6.0415e-06_r8/) + kao(:, 3,12,12) = (/ & + &1.1782e+02_r8,1.0310e+02_r8,8.8376e+01_r8,7.3644e+01_r8,5.8951e+01_r8,4.4160e+01_r8, & + &2.9459e+01_r8,1.4728e+01_r8,1.0435e-05_r8/) + kao(:, 4,12,12) = (/ & + &1.1710e+02_r8,1.0244e+02_r8,8.7885e+01_r8,7.3194e+01_r8,5.8621e+01_r8,4.3876e+01_r8, & + &2.9251e+01_r8,1.4654e+01_r8,1.8188e-05_r8/) + kao(:, 5,12,12) = (/ & + &1.1577e+02_r8,1.0131e+02_r8,8.6825e+01_r8,7.2359e+01_r8,5.7901e+01_r8,4.3424e+01_r8, & + &2.8943e+01_r8,1.4462e+01_r8,2.8178e-05_r8/) + kao(:, 1,13,12) = (/ & + &1.1625e+02_r8,1.0180e+02_r8,8.7251e+01_r8,7.2708e+01_r8,5.8118e+01_r8,4.3593e+01_r8, & + &2.9061e+01_r8,1.4533e+01_r8,2.6097e-06_r8/) + kao(:, 2,13,12) = (/ & + &1.1986e+02_r8,1.0483e+02_r8,8.9927e+01_r8,7.4912e+01_r8,5.9931e+01_r8,4.4948e+01_r8, & + &2.9950e+01_r8,1.4982e+01_r8,4.5705e-06_r8/) + kao(:, 3,13,12) = (/ & + &1.1859e+02_r8,1.0377e+02_r8,8.8940e+01_r8,7.4121e+01_r8,5.9293e+01_r8,4.4471e+01_r8, & + &2.9646e+01_r8,1.4823e+01_r8,9.6333e-06_r8/) + kao(:, 4,13,12) = (/ & + &1.1553e+02_r8,1.0103e+02_r8,8.6643e+01_r8,7.2158e+01_r8,5.7729e+01_r8,4.3335e+01_r8, & + &2.8881e+01_r8,1.4445e+01_r8,1.6615e-05_r8/) + kao(:, 5,13,12) = (/ & + &1.1521e+02_r8,1.0087e+02_r8,8.6350e+01_r8,7.1959e+01_r8,5.7620e+01_r8,4.3214e+01_r8, & + &2.8812e+01_r8,1.4383e+01_r8,2.5689e-05_r8/) + kao(:, 1, 1,13) = (/ & + &1.2352e-03_r8,5.0775e-03_r8,9.0568e-03_r8,9.6608e-03_r8,1.7051e-02_r8,2.9171e-02_r8, & + &3.4997e-02_r8,4.0847e-02_r8,3.4367e-02_r8/) + kao(:, 2, 1,13) = (/ & + &1.2435e-03_r8,6.8803e-03_r8,1.1829e-02_r8,1.3668e-02_r8,2.8015e-02_r8,4.0318e-02_r8, & + &4.8254e-02_r8,5.5929e-02_r8,5.6166e-02_r8/) + kao(:, 3, 1,13) = (/ & + &1.2378e-03_r8,7.6901e-03_r8,1.3370e-02_r8,2.0872e-02_r8,4.0011e-02_r8,5.3853e-02_r8, & + &6.4341e-02_r8,7.4163e-02_r8,8.0135e-02_r8/) + kao(:, 4, 1,13) = (/ & + &1.2280e-03_r8,1.0734e-02_r8,1.6343e-02_r8,3.0629e-02_r8,5.6049e-02_r8,6.9850e-02_r8, & + &8.3340e-02_r8,9.5619e-02_r8,1.1209e-01_r8/) + kao(:, 5, 1,13) = (/ & + &1.2088e-03_r8,1.3761e-02_r8,2.1254e-02_r8,4.2402e-02_r8,7.0900e-02_r8,8.8313e-02_r8, & + &1.0523e-01_r8,1.2032e-01_r8,1.4179e-01_r8/) + kao(:, 1, 2,13) = (/ & + &1.7062e-03_r8,5.0744e-03_r8,8.6767e-03_r8,1.3080e-02_r8,1.1607e-02_r8,1.7056e-02_r8, & + &2.8742e-02_r8,3.5357e-02_r8,2.3747e-02_r8/) + kao(:, 2, 2,13) = (/ & + &1.7222e-03_r8,6.7515e-03_r8,1.2374e-02_r8,1.5331e-02_r8,1.8393e-02_r8,2.7370e-02_r8, & + &4.2648e-02_r8,4.9678e-02_r8,3.7912e-02_r8/) + kao(:, 3, 2,13) = (/ & + &1.7299e-03_r8,8.6001e-03_r8,1.6797e-02_r8,2.0526e-02_r8,2.6294e-02_r8,4.1034e-02_r8, & + &5.7948e-02_r8,6.7295e-02_r8,5.4721e-02_r8/) + kao(:, 4, 2,13) = (/ & + &1.7668e-03_r8,1.0879e-02_r8,2.0064e-02_r8,2.7385e-02_r8,3.4476e-02_r8,5.8386e-02_r8, & + &7.6246e-02_r8,8.8358e-02_r8,7.0573e-02_r8/) + kao(:, 5, 2,13) = (/ & + &1.7596e-03_r8,1.1860e-02_r8,2.3664e-02_r8,3.3939e-02_r8,4.8492e-02_r8,7.9884e-02_r8, & + &9.7519e-02_r8,1.1290e-01_r8,9.7083e-02_r8/) + kao(:, 1, 3,13) = (/ & + &3.1651e-03_r8,5.2961e-03_r8,8.5469e-03_r8,1.1513e-02_r8,1.5558e-02_r8,1.4881e-02_r8, & + &1.6424e-02_r8,2.5024e-02_r8,2.8147e-02_r8/) + kao(:, 2, 3,13) = (/ & + &3.3189e-03_r8,8.3809e-03_r8,1.1489e-02_r8,1.6299e-02_r8,2.2221e-02_r8,2.2841e-02_r8, & + &2.5024e-02_r8,3.8200e-02_r8,3.8233e-02_r8/) + kao(:, 3, 3,13) = (/ & + &3.3701e-03_r8,1.1923e-02_r8,1.5036e-02_r8,2.2373e-02_r8,2.6383e-02_r8,3.1900e-02_r8, & + &3.2997e-02_r8,5.6522e-02_r8,4.6578e-02_r8/) + kao(:, 4, 3,13) = (/ & + &3.3871e-03_r8,1.2781e-02_r8,1.7799e-02_r8,2.9758e-02_r8,3.5615e-02_r8,4.1357e-02_r8, & + &4.8578e-02_r8,7.5987e-02_r8,6.6261e-02_r8/) + kao(:, 5, 3,13) = (/ & + &3.3797e-03_r8,1.4220e-02_r8,2.3964e-02_r8,3.5644e-02_r8,4.5626e-02_r8,4.9180e-02_r8, & + &6.9386e-02_r8,9.9109e-02_r8,8.8310e-02_r8/) + kao(:, 1, 4,13) = (/ & + &1.0343e-02_r8,9.0620e-03_r8,1.2015e-02_r8,1.1324e-02_r8,1.3382e-02_r8,1.5654e-02_r8, & + &1.8625e-02_r8,1.7070e-02_r8,2.1331e-02_r8/) + kao(:, 2, 4,13) = (/ & + &6.4226e-03_r8,5.6266e-03_r8,1.6045e-02_r8,1.6336e-02_r8,1.7909e-02_r8,2.2857e-02_r8, & + &2.5406e-02_r8,2.4740e-02_r8,3.1419e-02_r8/) + kao(:, 3, 4,13) = (/ & + &6.5549e-03_r8,5.7385e-03_r8,1.8741e-02_r8,2.0901e-02_r8,2.5444e-02_r8,3.1318e-02_r8, & + &3.5488e-02_r8,3.2476e-02_r8,4.5848e-02_r8/) + kao(:, 4, 4,13) = (/ & + &6.6407e-03_r8,5.8164e-03_r8,2.0962e-02_r8,2.6844e-02_r8,3.4892e-02_r8,4.1403e-02_r8, & + &4.7653e-02_r8,4.2426e-02_r8,6.5116e-02_r8/) + kao(:, 5, 4,13) = (/ & + &6.8300e-03_r8,1.2571e-02_r8,2.5118e-02_r8,3.2793e-02_r8,4.7122e-02_r8,5.5638e-02_r8, & + &5.7712e-02_r8,6.2270e-02_r8,8.9700e-02_r8/) + kao(:, 1, 5,13) = (/ & + &9.0149e-02_r8,7.8756e-02_r8,6.7503e-02_r8,5.7299e-02_r8,4.6607e-02_r8,3.2042e-02_r8, & + &2.0392e-02_r8,1.6128e-02_r8,1.9894e-02_r8/) + kao(:, 2, 5,13) = (/ & + &4.8191e-02_r8,4.2297e-02_r8,3.6135e-02_r8,3.5890e-02_r8,2.5466e-02_r8,2.2998e-02_r8, & + &2.3063e-02_r8,2.5066e-02_r8,2.8493e-02_r8/) + kao(:, 3, 5,13) = (/ & + &2.0878e-02_r8,1.8444e-02_r8,2.0162e-02_r8,2.6175e-02_r8,2.5330e-02_r8,2.8034e-02_r8, & + &3.3888e-02_r8,3.5693e-02_r8,3.9583e-02_r8/) + kao(:, 4, 5,13) = (/ & + &1.2467e-02_r8,1.0910e-02_r8,2.2261e-02_r8,3.0489e-02_r8,3.2389e-02_r8,3.6918e-02_r8, & + &4.6126e-02_r8,4.7452e-02_r8,5.4222e-02_r8/) + kao(:, 5, 5,13) = (/ & + &1.2730e-02_r8,1.1204e-02_r8,2.9691e-02_r8,3.6357e-02_r8,4.1593e-02_r8,4.9722e-02_r8, & + &6.1593e-02_r8,5.8372e-02_r8,7.2216e-02_r8/) + kao(:, 1, 6,13) = (/ & + &3.3772e-01_r8,2.9577e-01_r8,2.5329e-01_r8,2.1108e-01_r8,1.6887e-01_r8,1.2604e-01_r8, & + &7.8045e-02_r8,3.5455e-02_r8,1.6952e-02_r8/) + kao(:, 2, 6,13) = (/ & + &2.6913e-01_r8,2.3492e-01_r8,2.0161e-01_r8,1.6802e-01_r8,1.3597e-01_r8,9.6507e-02_r8, & + &6.1842e-02_r8,3.0282e-02_r8,3.2161e-02_r8/) + kao(:, 3, 6,13) = (/ & + &1.8198e-01_r8,1.5897e-01_r8,1.3649e-01_r8,1.1355e-01_r8,1.0014e-01_r8,6.6575e-02_r8, & + &4.2969e-02_r8,3.1778e-02_r8,5.1438e-02_r8/) + kao(:, 4, 6,13) = (/ & + &9.5916e-02_r8,8.3628e-02_r8,7.1947e-02_r8,6.5931e-02_r8,5.4714e-02_r8,4.3955e-02_r8, & + &3.9042e-02_r8,4.5021e-02_r8,5.3865e-02_r8/) + kao(:, 5, 6,13) = (/ & + &3.8338e-02_r8,3.3822e-02_r8,2.8989e-02_r8,4.7523e-02_r8,4.4391e-02_r8,4.9375e-02_r8, & + &5.3458e-02_r8,6.4090e-02_r8,6.5458e-02_r8/) + kao(:, 1, 7,13) = (/ & + &8.4065e-01_r8,7.3491e-01_r8,6.3155e-01_r8,5.2581e-01_r8,4.2110e-01_r8,3.1579e-01_r8, & + &2.1053e-01_r8,1.0597e-01_r8,2.9312e-06_r8/) + kao(:, 2, 7,13) = (/ & + &8.3906e-01_r8,7.3475e-01_r8,6.2926e-01_r8,5.2485e-01_r8,4.1990e-01_r8,3.1520e-01_r8, & + &2.1013e-01_r8,9.8180e-02_r8,5.1556e-06_r8/) + kao(:, 3, 7,13) = (/ & + &7.1003e-01_r8,6.2128e-01_r8,5.3203e-01_r8,4.4338e-01_r8,3.5504e-01_r8,2.6905e-01_r8, & + &1.6926e-01_r8,7.8231e-02_r8,2.0966e-02_r8/) + kao(:, 4, 7,13) = (/ & + &5.6430e-01_r8,4.9377e-01_r8,4.2325e-01_r8,3.5272e-01_r8,2.8217e-01_r8,2.1549e-01_r8, & + &1.3644e-01_r8,6.7355e-02_r8,4.1095e-02_r8/) + kao(:, 5, 7,13) = (/ & + &3.6362e-01_r8,3.1751e-01_r8,2.7269e-01_r8,2.2725e-01_r8,1.9431e-01_r8,1.4468e-01_r8, & + &9.9409e-02_r8,6.2076e-02_r8,6.3795e-02_r8/) + kao(:, 1, 8,13) = (/ & + &2.2236e+00_r8,1.9437e+00_r8,1.6676e+00_r8,1.3884e+00_r8,1.1107e+00_r8,8.3381e-01_r8, & + &5.5588e-01_r8,2.7795e-01_r8,1.5745e-06_r8/) + kao(:, 2, 8,13) = (/ & + &2.2078e+00_r8,1.9318e+00_r8,1.6572e+00_r8,1.3798e+00_r8,1.1048e+00_r8,8.2853e-01_r8, & + &5.5239e-01_r8,2.7779e-01_r8,2.9445e-06_r8/) + kao(:, 3, 8,13) = (/ & + &2.2271e+00_r8,1.9469e+00_r8,1.6686e+00_r8,1.3901e+00_r8,1.1125e+00_r8,8.3518e-01_r8, & + &5.5623e-01_r8,2.8153e-01_r8,5.1096e-06_r8/) + kao(:, 4, 8,13) = (/ & + &2.1637e+00_r8,1.8932e+00_r8,1.6227e+00_r8,1.3534e+00_r8,1.0818e+00_r8,8.1139e-01_r8, & + &5.4287e-01_r8,2.5697e-01_r8,9.9333e-06_r8/) + kao(:, 5, 8,13) = (/ & + &1.8021e+00_r8,1.5805e+00_r8,1.3532e+00_r8,1.1288e+00_r8,9.0270e-01_r8,6.7733e-01_r8, & + &4.5729e-01_r8,2.1399e-01_r8,3.0555e-05_r8/) + kao(:, 1, 9,13) = (/ & + &1.0795e+01_r8,9.4461e+00_r8,8.0967e+00_r8,6.7526e+00_r8,5.3928e+00_r8,4.0485e+00_r8, & + &2.6990e+00_r8,1.3503e+00_r8,8.4365e-07_r8/) + kao(:, 2, 9,13) = (/ & + &1.1064e+01_r8,9.6811e+00_r8,8.2980e+00_r8,6.9149e+00_r8,5.5320e+00_r8,4.1492e+00_r8, & + &2.7660e+00_r8,1.3844e+00_r8,1.6130e-06_r8/) + kao(:, 3, 9,13) = (/ & + &1.1399e+01_r8,9.9733e+00_r8,8.5488e+00_r8,7.1204e+00_r8,5.6991e+00_r8,4.2710e+00_r8, & + &2.8497e+00_r8,1.4241e+00_r8,6.0805e-06_r8/) + kao(:, 4, 9,13) = (/ & + &1.1508e+01_r8,1.0061e+01_r8,8.6395e+00_r8,7.1995e+00_r8,5.7491e+00_r8,4.3120e+00_r8, & + &2.8800e+00_r8,1.4386e+00_r8,1.4128e-05_r8/) + kao(:, 5, 9,13) = (/ & + &1.1400e+01_r8,9.9831e+00_r8,8.5576e+00_r8,7.1312e+00_r8,5.7049e+00_r8,4.2787e+00_r8, & + &2.8526e+00_r8,1.4263e+00_r8,2.6902e-05_r8/) + kao(:, 1,10,13) = (/ & + &6.0229e+01_r8,5.2742e+01_r8,4.5172e+01_r8,3.7644e+01_r8,3.0138e+01_r8,2.2585e+01_r8, & + &1.5057e+01_r8,7.5286e+00_r8,7.1488e-07_r8/) + kao(:, 2,10,13) = (/ & + &6.2236e+01_r8,5.4452e+01_r8,4.6675e+01_r8,3.8896e+01_r8,3.1118e+01_r8,2.3338e+01_r8, & + &1.5559e+01_r8,7.7794e+00_r8,2.2353e-06_r8/) + kao(:, 3,10,13) = (/ & + &6.3127e+01_r8,5.5205e+01_r8,4.7321e+01_r8,3.9431e+01_r8,3.1516e+01_r8,2.3656e+01_r8, & + &1.5745e+01_r8,7.8865e+00_r8,5.3891e-06_r8/) + kao(:, 4,10,13) = (/ & + &6.1110e+01_r8,5.3475e+01_r8,4.5823e+01_r8,3.8155e+01_r8,3.0566e+01_r8,2.2893e+01_r8, & + &1.5262e+01_r8,7.6312e+00_r8,1.1169e-05_r8/) + kao(:, 5,10,13) = (/ & + &6.4796e+01_r8,5.6740e+01_r8,4.8597e+01_r8,4.0457e+01_r8,3.2404e+01_r8,2.4299e+01_r8, & + &1.6199e+01_r8,8.1078e+00_r8,2.0550e-05_r8/) + kao(:, 1,11,13) = (/ & + &1.1504e+02_r8,1.0058e+02_r8,8.6129e+01_r8,7.1842e+01_r8,5.7476e+01_r8,4.3140e+01_r8, & + &2.8738e+01_r8,1.4357e+01_r8,9.3132e-07_r8/) + kao(:, 2,11,13) = (/ & + &1.1792e+02_r8,1.0317e+02_r8,8.8507e+01_r8,7.3697e+01_r8,5.8960e+01_r8,4.4221e+01_r8, & + &2.9502e+01_r8,1.4740e+01_r8,2.4724e-06_r8/) + kao(:, 3,11,13) = (/ & + &1.2218e+02_r8,1.0691e+02_r8,9.1705e+01_r8,7.6362e+01_r8,6.1091e+01_r8,4.5817e+01_r8, & + &3.0544e+01_r8,1.5272e+01_r8,5.4659e-06_r8/) + kao(:, 4,11,13) = (/ & + &1.2095e+02_r8,1.0583e+02_r8,9.0715e+01_r8,7.5596e+01_r8,6.0430e+01_r8,4.5404e+01_r8, & + &3.0213e+01_r8,1.5120e+01_r8,1.0930e-05_r8/) + kao(:, 5,11,13) = (/ & + &1.1751e+02_r8,1.0271e+02_r8,8.8136e+01_r8,7.3302e+01_r8,5.8706e+01_r8,4.4021e+01_r8, & + &2.9378e+01_r8,1.4677e+01_r8,1.9680e-05_r8/) + kao(:, 1,12,13) = (/ & + &1.6045e+02_r8,1.4037e+02_r8,1.2031e+02_r8,1.0025e+02_r8,8.0142e+01_r8,6.0153e+01_r8, & + &4.0104e+01_r8,2.0052e+01_r8,1.7476e-06_r8/) + kao(:, 2,12,13) = (/ & + &1.6342e+02_r8,1.4301e+02_r8,1.2246e+02_r8,1.0215e+02_r8,8.1640e+01_r8,6.1227e+01_r8, & + &4.0821e+01_r8,2.0431e+01_r8,2.4757e-06_r8/) + kao(:, 3,12,13) = (/ & + &1.6723e+02_r8,1.4633e+02_r8,1.2542e+02_r8,1.0452e+02_r8,8.3616e+01_r8,6.2709e+01_r8, & + &4.1810e+01_r8,2.0904e+01_r8,5.2593e-06_r8/) + kao(:, 4,12,13) = (/ & + &1.7014e+02_r8,1.4884e+02_r8,1.2747e+02_r8,1.0623e+02_r8,8.4980e+01_r8,6.3783e+01_r8, & + &4.2524e+01_r8,2.1245e+01_r8,9.8363e-06_r8/) + kao(:, 5,12,13) = (/ & + &1.6634e+02_r8,1.4563e+02_r8,1.2476e+02_r8,1.0397e+02_r8,8.3150e+01_r8,6.2327e+01_r8, & + &4.1610e+01_r8,2.0792e+01_r8,1.5825e-05_r8/) + kao(:, 1,13,13) = (/ & + &1.7420e+02_r8,1.5232e+02_r8,1.3056e+02_r8,1.0880e+02_r8,8.7095e+01_r8,6.5324e+01_r8, & + &4.3550e+01_r8,2.1773e+01_r8,2.0359e-06_r8/) + kao(:, 2,13,13) = (/ & + &1.7505e+02_r8,1.5318e+02_r8,1.3125e+02_r8,1.0942e+02_r8,8.7528e+01_r8,6.5649e+01_r8, & + &4.3765e+01_r8,2.1882e+01_r8,3.6885e-06_r8/) + kao(:, 3,13,13) = (/ & + &1.7705e+02_r8,1.5491e+02_r8,1.3279e+02_r8,1.1065e+02_r8,8.8524e+01_r8,6.6391e+01_r8, & + &4.4262e+01_r8,2.2130e+01_r8,4.3611e-06_r8/) + kao(:, 4,13,13) = (/ & + &1.7817e+02_r8,1.5590e+02_r8,1.3363e+02_r8,1.1135e+02_r8,8.9083e+01_r8,6.6758e+01_r8, & + &4.4540e+01_r8,2.2253e+01_r8,7.0150e-06_r8/) + kao(:, 5,13,13) = (/ & + &1.7584e+02_r8,1.5385e+02_r8,1.3199e+02_r8,1.0999e+02_r8,8.7917e+01_r8,6.5939e+01_r8, & + &4.3996e+01_r8,2.1972e+01_r8,1.1356e-05_r8/) + kao(:, 1, 1,14) = (/ & + &1.3576e-03_r8,5.9355e-03_r8,1.2070e-02_r8,3.4616e-02_r8,5.3142e-02_r8,6.5578e-02_r8, & + &7.6852e-02_r8,8.4718e-02_r8,1.0628e-01_r8/) + kao(:, 2, 1,14) = (/ & + &1.4884e-03_r8,6.6850e-03_r8,2.0385e-02_r8,5.2397e-02_r8,7.2846e-02_r8,8.9954e-02_r8, & + &1.0527e-01_r8,1.1545e-01_r8,1.4569e-01_r8/) + kao(:, 3, 1,14) = (/ & + &1.6038e-03_r8,1.0153e-02_r8,3.3679e-02_r8,7.2611e-02_r8,9.6223e-02_r8,1.1901e-01_r8, & + &1.3945e-01_r8,1.5228e-01_r8,1.9245e-01_r8/) + kao(:, 4, 1,14) = (/ & + &1.7044e-03_r8,1.3918e-02_r8,4.9229e-02_r8,9.2925e-02_r8,1.2323e-01_r8,1.5253e-01_r8, & + &1.7914e-01_r8,1.9539e-01_r8,2.4647e-01_r8/) + kao(:, 5, 1,14) = (/ & + &1.8000e-03_r8,1.6377e-02_r8,6.7350e-02_r8,1.1593e-01_r8,1.5369e-01_r8,1.9039e-01_r8, & + &2.2401e-01_r8,2.4471e-01_r8,3.0739e-01_r8/) + kao(:, 1, 2,14) = (/ & + &2.3036e-03_r8,8.1410e-03_r8,1.1112e-02_r8,1.5744e-02_r8,3.9389e-02_r8,5.9885e-02_r8, & + &7.1149e-02_r8,8.0027e-02_r8,7.8847e-02_r8/) + kao(:, 2, 2,14) = (/ & + &2.5134e-03_r8,1.3270e-02_r8,1.6290e-02_r8,2.9767e-02_r8,5.8863e-02_r8,8.3096e-02_r8, & + &9.8866e-02_r8,1.1160e-01_r8,1.1776e-01_r8/) + kao(:, 3, 2,14) = (/ & + &2.6930e-03_r8,1.4292e-02_r8,1.9903e-02_r8,4.6191e-02_r8,8.3472e-02_r8,1.1096e-01_r8, & + &1.3216e-01_r8,1.4974e-01_r8,1.6719e-01_r8/) + kao(:, 4, 2,14) = (/ & + &2.7875e-03_r8,1.4114e-02_r8,2.4277e-02_r8,6.6428e-02_r8,1.1553e-01_r8,1.4377e-01_r8, & + &1.7103e-01_r8,1.9428e-01_r8,2.3106e-01_r8/) + kao(:, 5, 2,14) = (/ & + &2.8719e-03_r8,1.9476e-02_r8,3.5900e-02_r8,9.2156e-02_r8,1.4592e-01_r8,1.8154e-01_r8, & + &2.1576e-01_r8,2.4502e-01_r8,2.9183e-01_r8/) + kao(:, 1, 3,14) = (/ & + &5.1130e-03_r8,4.4754e-03_r8,1.7095e-02_r8,1.4542e-02_r8,2.0610e-02_r8,2.6947e-02_r8, & + &5.0520e-02_r8,6.8277e-02_r8,4.1188e-02_r8/) + kao(:, 2, 3,14) = (/ & + &5.4209e-03_r8,4.7463e-03_r8,2.5747e-02_r8,2.2058e-02_r8,2.5589e-02_r8,4.5664e-02_r8, & + &7.6140e-02_r8,9.7102e-02_r8,5.5959e-02_r8/) + kao(:, 3, 3,14) = (/ & + &5.7296e-03_r8,5.0218e-03_r8,2.3801e-02_r8,3.0343e-02_r8,3.8012e-02_r8,6.9885e-02_r8, & + &1.1346e-01_r8,1.3263e-01_r8,8.0840e-02_r8/) + kao(:, 4, 3,14) = (/ & + &5.9993e-03_r8,9.9078e-03_r8,3.1169e-02_r8,3.4849e-02_r8,5.4434e-02_r8,1.0180e-01_r8, & + &1.5168e-01_r8,1.7523e-01_r8,1.1385e-01_r8/) + kao(:, 5, 3,14) = (/ & + &6.2420e-03_r8,1.8221e-02_r8,3.8314e-02_r8,4.8056e-02_r8,8.0195e-02_r8,1.4525e-01_r8, & + &1.9539e-01_r8,2.2499e-01_r8,1.6255e-01_r8/) + kao(:, 1, 4,14) = (/ & + &1.0992e-02_r8,9.6146e-03_r8,8.2555e-03_r8,1.9598e-02_r8,2.6210e-02_r8,2.3069e-02_r8, & + &2.4334e-02_r8,4.0918e-02_r8,4.3847e-02_r8/) + kao(:, 2, 4,14) = (/ & + &1.1861e-02_r8,1.0380e-02_r8,8.8997e-03_r8,3.1372e-02_r8,3.1071e-02_r8,3.3427e-02_r8, & + &3.7533e-02_r8,6.6384e-02_r8,5.4303e-02_r8/) + kao(:, 3, 4,14) = (/ & + &1.2630e-02_r8,1.1058e-02_r8,1.5158e-02_r8,4.6362e-02_r8,4.1015e-02_r8,4.0980e-02_r8, & + &5.2909e-02_r8,1.0322e-01_r8,7.5185e-02_r8/) + kao(:, 4, 4,14) = (/ & + &1.3324e-02_r8,1.1665e-02_r8,2.8664e-02_r8,4.2673e-02_r8,5.2993e-02_r8,5.8606e-02_r8, & + &7.8441e-02_r8,1.5172e-01_r8,9.8036e-02_r8/) + kao(:, 5, 4,14) = (/ & + &1.3148e-02_r8,1.1477e-02_r8,4.1837e-02_r8,5.5479e-02_r8,6.7238e-02_r8,7.8671e-02_r8, & + &1.1999e-01_r8,1.9993e-01_r8,1.2716e-01_r8/) + kao(:, 1, 5,14) = (/ & + &2.2062e-02_r8,1.9303e-02_r8,1.6547e-02_r8,1.3790e-02_r8,1.9210e-02_r8,3.4370e-02_r8, & + &2.6360e-02_r8,2.4628e-02_r8,2.1281e-02_r8/) + kao(:, 2, 5,14) = (/ & + &2.4016e-02_r8,2.1018e-02_r8,1.8036e-02_r8,1.5017e-02_r8,3.4207e-02_r8,3.8549e-02_r8, & + &3.6828e-02_r8,3.7924e-02_r8,4.8887e-02_r8/) + kao(:, 3, 5,14) = (/ & + &2.4307e-02_r8,2.1199e-02_r8,1.8170e-02_r8,2.0814e-02_r8,5.1440e-02_r8,4.8654e-02_r8, & + &5.0226e-02_r8,5.5730e-02_r8,8.3554e-02_r8/) + kao(:, 4, 5,14) = (/ & + &2.3589e-02_r8,2.0645e-02_r8,1.7700e-02_r8,3.6957e-02_r8,7.2673e-02_r8,6.2587e-02_r8, & + &6.6284e-02_r8,7.5553e-02_r8,1.2501e-01_r8/) + kao(:, 5, 5,14) = (/ & + &2.3359e-02_r8,2.0344e-02_r8,1.7524e-02_r8,5.3828e-02_r8,7.8003e-02_r8,7.9260e-02_r8, & + &8.5892e-02_r8,1.2047e-01_r8,1.2633e-01_r8/) + kao(:, 1, 6,14) = (/ & + &4.0073e-02_r8,3.4956e-02_r8,2.9962e-02_r8,2.4964e-02_r8,1.9975e-02_r8,1.9358e-02_r8, & + &3.3916e-02_r8,2.3741e-02_r8,4.4372e-06_r8/) + kao(:, 2, 6,14) = (/ & + &4.0377e-02_r8,3.5184e-02_r8,3.0162e-02_r8,2.5240e-02_r8,2.0191e-02_r8,3.6273e-02_r8, & + &4.6417e-02_r8,3.4541e-02_r8,7.2649e-06_r8/) + kao(:, 3, 6,14) = (/ & + &4.0665e-02_r8,3.5540e-02_r8,3.0502e-02_r8,2.5425e-02_r8,2.0338e-02_r8,5.3239e-02_r8, & + &5.4545e-02_r8,5.0382e-02_r8,1.1617e-05_r8/) + kao(:, 4, 6,14) = (/ & + &4.0830e-02_r8,3.5726e-02_r8,3.0620e-02_r8,2.5522e-02_r8,4.1685e-02_r8,7.6060e-02_r8, & + &6.8633e-02_r8,6.7501e-02_r8,4.8322e-02_r8/) + kao(:, 5, 6,14) = (/ & + &4.0974e-02_r8,3.5852e-02_r8,3.0742e-02_r8,2.5614e-02_r8,6.3799e-02_r8,1.0670e-01_r8, & + &8.5712e-02_r8,8.9786e-02_r8,9.4019e-02_r8/) + kao(:, 1, 7,14) = (/ & + &3.5883e-01_r8,3.1506e-01_r8,2.6911e-01_r8,2.2518e-01_r8,1.7880e-01_r8,1.3456e-01_r8, & + &8.9710e-02_r8,5.4606e-02_r8,2.4375e-06_r8/) + kao(:, 2, 7,14) = (/ & + &1.1133e-01_r8,9.7402e-02_r8,8.3516e-02_r8,6.9576e-02_r8,5.5665e-02_r8,4.1750e-02_r8, & + &3.4893e-02_r8,3.9977e-02_r8,4.2861e-06_r8/) + kao(:, 3, 7,14) = (/ & + &7.4556e-02_r8,6.5240e-02_r8,5.5921e-02_r8,4.6603e-02_r8,3.7275e-02_r8,2.7967e-02_r8, & + &5.4564e-02_r8,5.0979e-02_r8,7.1669e-06_r8/) + kao(:, 4, 7,14) = (/ & + &7.6453e-02_r8,6.6897e-02_r8,5.7506e-02_r8,4.7791e-02_r8,3.8237e-02_r8,4.2981e-02_r8, & + &7.9842e-02_r8,6.6791e-02_r8,1.1410e-05_r8/) + kao(:, 5, 7,14) = (/ & + &7.6151e-02_r8,6.6633e-02_r8,5.7121e-02_r8,4.7606e-02_r8,3.8095e-02_r8,6.8563e-02_r8, & + &1.1205e-01_r8,9.1020e-02_r8,1.8778e-05_r8/) + kao(:, 1, 8,14) = (/ & + &1.6212e+00_r8,1.4215e+00_r8,1.2160e+00_r8,1.0153e+00_r8,8.1222e-01_r8,6.0796e-01_r8, & + &4.0531e-01_r8,2.0267e-01_r8,1.3659e-06_r8/) + kao(:, 2, 8,14) = (/ & + &1.0949e+00_r8,9.5809e-01_r8,8.2118e-01_r8,6.8434e-01_r8,5.4744e-01_r8,4.1058e-01_r8, & + &2.7374e-01_r8,1.3687e-01_r8,2.5240e-06_r8/) + kao(:, 3, 8,14) = (/ & + &5.4276e-01_r8,4.7782e-01_r8,4.0969e-01_r8,3.4354e-01_r8,2.7305e-01_r8,2.0349e-01_r8, & + &1.3658e-01_r8,8.0855e-02_r8,4.4900e-06_r8/) + kao(:, 4, 8,14) = (/ & + &1.6665e-01_r8,1.4583e-01_r8,1.2498e-01_r8,1.0416e-01_r8,8.3314e-02_r8,6.2486e-02_r8, & + &4.1670e-02_r8,8.3057e-02_r8,7.7801e-06_r8/) + kao(:, 5, 8,14) = (/ & + &1.6956e-01_r8,1.4835e-01_r8,1.2718e-01_r8,1.0598e-01_r8,8.5407e-02_r8,6.3592e-02_r8, & + &5.5348e-02_r8,1.2090e-01_r8,1.2725e-05_r8/) + kao(:, 1, 9,14) = (/ & + &1.1544e+01_r8,1.0088e+01_r8,8.6483e+00_r8,7.2069e+00_r8,5.7730e+00_r8,4.3233e+00_r8, & + &2.8823e+00_r8,1.4419e+00_r8,7.6692e-07_r8/) + kao(:, 2, 9,14) = (/ & + &9.0308e+00_r8,7.9019e+00_r8,6.7729e+00_r8,5.6441e+00_r8,4.5156e+00_r8,3.3865e+00_r8, & + &2.2577e+00_r8,1.1268e+00_r8,1.4786e-06_r8/) + kao(:, 3, 9,14) = (/ & + &6.2830e+00_r8,5.4975e+00_r8,4.7120e+00_r8,3.9269e+00_r8,3.1414e+00_r8,2.3561e+00_r8, & + &1.5707e+00_r8,7.8536e-01_r8,2.7689e-06_r8/) + kao(:, 4, 9,14) = (/ & + &3.6304e+00_r8,3.1764e+00_r8,2.7089e+00_r8,2.2550e+00_r8,1.8152e+00_r8,1.3614e+00_r8, & + &9.0300e-01_r8,4.5381e-01_r8,4.9167e-06_r8/) + kao(:, 5, 9,14) = (/ & + &1.4890e+00_r8,1.3035e+00_r8,1.1168e+00_r8,9.3072e-01_r8,7.4457e-01_r8,5.5869e-01_r8, & + &3.7227e-01_r8,1.8616e-01_r8,8.2396e-06_r8/) + kao(:, 1,10,14) = (/ & + &7.2198e+01_r8,6.3175e+01_r8,5.4150e+01_r8,4.5125e+01_r8,3.6100e+01_r8,2.7075e+01_r8, & + &1.8050e+01_r8,9.0251e+00_r8,4.5184e-07_r8/) + kao(:, 2,10,14) = (/ & + &6.4999e+01_r8,5.6876e+01_r8,4.8750e+01_r8,4.0625e+01_r8,3.2499e+01_r8,2.4375e+01_r8, & + &1.6250e+01_r8,8.1250e+00_r8,9.0060e-07_r8/) + kao(:, 3,10,14) = (/ & + &5.3041e+01_r8,4.6463e+01_r8,3.9827e+01_r8,3.3188e+01_r8,2.6599e+01_r8,1.9891e+01_r8, & + &1.3300e+01_r8,6.6377e+00_r8,1.7393e-06_r8/) + kao(:, 4,10,14) = (/ & + &4.2448e+01_r8,3.7144e+01_r8,3.1913e+01_r8,2.6594e+01_r8,2.1225e+01_r8,1.5957e+01_r8, & + &1.0638e+01_r8,5.3187e+00_r8,3.1449e-06_r8/) + kao(:, 5,10,14) = (/ & + &2.5727e+01_r8,2.2511e+01_r8,1.9295e+01_r8,1.6144e+01_r8,1.2810e+01_r8,9.6477e+00_r8, & + &6.4321e+00_r8,3.2028e+00_r8,5.3500e-06_r8/) + kao(:, 1,11,14) = (/ & + &1.4503e+02_r8,1.2691e+02_r8,1.0890e+02_r8,9.0641e+01_r8,7.2517e+01_r8,5.4390e+01_r8, & + &3.6259e+01_r8,1.8129e+01_r8,3.6866e-07_r8/) + kao(:, 2,11,14) = (/ & + &1.4340e+02_r8,1.2547e+02_r8,1.0755e+02_r8,8.9629e+01_r8,7.1700e+01_r8,5.3764e+01_r8, & + &3.5851e+01_r8,1.7926e+01_r8,7.4257e-07_r8/) + kao(:, 3,11,14) = (/ & + &1.2279e+02_r8,1.0744e+02_r8,9.2097e+01_r8,7.6747e+01_r8,6.1397e+01_r8,4.6046e+01_r8, & + &3.0699e+01_r8,1.5350e+01_r8,1.4132e-06_r8/) + kao(:, 4,11,14) = (/ & + &1.0332e+02_r8,9.0407e+01_r8,7.7495e+01_r8,6.4577e+01_r8,5.1661e+01_r8,3.8673e+01_r8, & + &2.5832e+01_r8,1.2916e+01_r8,2.5660e-06_r8/) + kao(:, 5,11,14) = (/ & + &8.4752e+01_r8,7.4338e+01_r8,6.3562e+01_r8,5.3097e+01_r8,4.2377e+01_r8,3.1859e+01_r8, & + &2.1189e+01_r8,1.0594e+01_r8,4.3954e-06_r8/) + kao(:, 1,12,14) = (/ & + &2.1206e+02_r8,1.8578e+02_r8,1.5923e+02_r8,1.3269e+02_r8,1.0615e+02_r8,7.9613e+01_r8, & + &5.3076e+01_r8,2.6538e+01_r8,2.9519e-07_r8/) + kao(:, 2,12,14) = (/ & + &2.1371e+02_r8,1.8696e+02_r8,1.6019e+02_r8,1.3354e+02_r8,1.0696e+02_r8,8.0220e+01_r8, & + &5.3478e+01_r8,2.6706e+01_r8,5.9412e-07_r8/) + kao(:, 3,12,14) = (/ & + &1.9963e+02_r8,1.7467e+02_r8,1.4971e+02_r8,1.2476e+02_r8,9.9809e+01_r8,7.4861e+01_r8, & + &4.9906e+01_r8,2.4953e+01_r8,1.1512e-06_r8/) + kao(:, 4,12,14) = (/ & + &1.7291e+02_r8,1.5155e+02_r8,1.2989e+02_r8,1.0824e+02_r8,8.6596e+01_r8,6.4945e+01_r8, & + &4.3297e+01_r8,2.1649e+01_r8,2.0935e-06_r8/) + kao(:, 5,12,14) = (/ & + &1.4993e+02_r8,1.3106e+02_r8,1.1245e+02_r8,9.3704e+01_r8,7.4891e+01_r8,5.6224e+01_r8, & + &3.7445e+01_r8,1.8742e+01_r8,5.3426e-06_r8/) + kao(:, 1,13,14) = (/ & + &2.3337e+02_r8,2.0357e+02_r8,1.7476e+02_r8,1.4563e+02_r8,1.1651e+02_r8,8.7377e+01_r8, & + &5.8250e+01_r8,2.9126e+01_r8,2.3044e-07_r8/) + kao(:, 2,13,14) = (/ & + &2.3770e+02_r8,2.0799e+02_r8,1.7827e+02_r8,1.4856e+02_r8,1.1885e+02_r8,8.9136e+01_r8, & + &5.9426e+01_r8,2.9711e+01_r8,4.7533e-07_r8/) + kao(:, 3,13,14) = (/ & + &2.3937e+02_r8,2.0945e+02_r8,1.7953e+02_r8,1.4961e+02_r8,1.1968e+02_r8,8.9763e+01_r8, & + &5.9841e+01_r8,2.9920e+01_r8,1.2740e-06_r8/) + kao(:, 4,13,14) = (/ & + &2.1343e+02_r8,1.8675e+02_r8,1.6007e+02_r8,1.3339e+02_r8,1.0671e+02_r8,8.0033e+01_r8, & + &5.3356e+01_r8,2.6677e+01_r8,3.7441e-06_r8/) + kao(:, 5,13,14) = (/ & + &1.8434e+02_r8,1.6130e+02_r8,1.3825e+02_r8,1.1521e+02_r8,9.2167e+01_r8,6.9126e+01_r8, & + &4.6084e+01_r8,2.3083e+01_r8,8.0408e-06_r8/) + kao(:, 1, 1,15) = (/ & + &4.3757e-04_r8,1.7661e-02_r8,6.5219e-02_r8,9.6736e-02_r8,1.2696e-01_r8,1.5472e-01_r8, & + &1.7677e-01_r8,1.8124e-01_r8,2.5391e-01_r8/) + kao(:, 2, 1,15) = (/ & + &4.7244e-04_r8,2.2315e-02_r8,8.7744e-02_r8,1.3008e-01_r8,1.7055e-01_r8,2.0764e-01_r8, & + &2.3757e-01_r8,2.4446e-01_r8,3.4110e-01_r8/) + kao(:, 3, 1,15) = (/ & + &4.9936e-04_r8,3.5467e-02_r8,1.1452e-01_r8,1.6964e-01_r8,2.2220e-01_r8,2.7019e-01_r8, & + &3.0873e-01_r8,3.1867e-01_r8,4.4441e-01_r8/) + kao(:, 4, 1,15) = (/ & + &5.2088e-04_r8,5.0547e-02_r8,1.4538e-01_r8,2.1535e-01_r8,2.8212e-01_r8,3.4264e-01_r8, & + &3.9053e-01_r8,4.0360e-01_r8,5.6424e-01_r8/) + kao(:, 5, 1,15) = (/ & + &5.3484e-04_r8,7.2405e-02_r8,1.8030e-01_r8,2.6712e-01_r8,3.4967e-01_r8,4.2472e-01_r8, & + &4.8331e-01_r8,4.9868e-01_r8,6.9933e-01_r8/) + kao(:, 1, 2,15) = (/ & + &5.8930e-04_r8,5.2056e-04_r8,3.8823e-02_r8,9.4547e-02_r8,1.2473e-01_r8,1.5329e-01_r8, & + &1.7814e-01_r8,1.9186e-01_r8,2.4946e-01_r8/) + kao(:, 2, 2,15) = (/ & + &6.3170e-04_r8,5.6011e-04_r8,6.0488e-02_r8,1.2953e-01_r8,1.7093e-01_r8,2.0982e-01_r8, & + &2.4359e-01_r8,2.6142e-01_r8,3.4185e-01_r8/) + kao(:, 3, 2,15) = (/ & + &6.6396e-04_r8,1.3947e-02_r8,9.3321e-02_r8,1.7148e-01_r8,2.2617e-01_r8,2.7768e-01_r8, & + &3.2205e-01_r8,3.4444e-01_r8,4.5233e-01_r8/) + kao(:, 4, 2,15) = (/ & + &6.8779e-04_r8,3.2900e-02_r8,1.4029e-01_r8,2.2027e-01_r8,2.9047e-01_r8,3.5662e-01_r8, & + &4.1356e-01_r8,4.4128e-01_r8,5.8094e-01_r8/) + kao(:, 5, 2,15) = (/ & + &7.0403e-04_r8,3.1909e-02_r8,1.8526e-01_r8,2.7582e-01_r8,3.6375e-01_r8,4.4666e-01_r8, & + &5.1781e-01_r8,5.5205e-01_r8,7.2748e-01_r8/) + kao(:, 1, 3,15) = (/ & + &1.0314e-03_r8,9.3537e-04_r8,7.8009e-04_r8,3.5190e-02_r8,7.8660e-02_r8,1.3993e-01_r8, & + &1.6539e-01_r8,1.8481e-01_r8,1.5700e-01_r8/) + kao(:, 2, 3,15) = (/ & + &1.1044e-03_r8,9.7099e-04_r8,3.0472e-03_r8,6.2470e-02_r8,1.3066e-01_r8,1.9656e-01_r8, & + &2.3229e-01_r8,2.5938e-01_r8,2.6190e-01_r8/) + kao(:, 3, 3,15) = (/ & + &1.1610e-03_r8,1.0227e-03_r8,3.8685e-02_r8,9.5707e-02_r8,2.0189e-01_r8,2.6560e-01_r8, & + &3.1379e-01_r8,3.5039e-01_r8,4.0559e-01_r8/) + kao(:, 4, 3,15) = (/ & + &1.1999e-03_r8,1.0620e-03_r8,6.9192e-02_r8,1.4962e-01_r8,2.7976e-01_r8,3.4701e-01_r8, & + &4.1016e-01_r8,4.5806e-01_r8,5.5953e-01_r8/) + kao(:, 5, 3,15) = (/ & + &1.2331e-03_r8,1.0899e-03_r8,6.4034e-02_r8,2.1379e-01_r8,3.5531e-01_r8,4.4075e-01_r8, & + &5.2094e-01_r8,5.8205e-01_r8,7.1061e-01_r8/) + kao(:, 1, 4,15) = (/ & + &1.8101e-03_r8,1.5857e-03_r8,1.3614e-03_r8,1.1362e-03_r8,2.5114e-02_r8,5.7242e-02_r8, & + &1.1151e-01_r8,1.6445e-01_r8,5.0940e-02_r8/) + kao(:, 2, 4,15) = (/ & + &1.9417e-03_r8,1.7009e-03_r8,1.4618e-03_r8,1.2222e-03_r8,6.6639e-02_r8,9.6622e-02_r8, & + &1.8463e-01_r8,2.3787e-01_r8,1.3472e-01_r8/) + kao(:, 3, 4,15) = (/ & + &2.0504e-03_r8,1.7934e-03_r8,1.5465e-03_r8,1.2907e-03_r8,6.6457e-02_r8,1.6526e-01_r8, & + &2.8062e-01_r8,3.2903e-01_r8,1.3147e-01_r8/) + kao(:, 4, 4,15) = (/ & + &2.1280e-03_r8,1.8660e-03_r8,1.6076e-03_r8,5.7880e-02_r8,1.0798e-01_r8,2.4822e-01_r8, & + &3.8266e-01_r8,4.3856e-01_r8,2.1657e-01_r8/) + kao(:, 5, 4,15) = (/ & + &3.4223e-03_r8,3.1028e-03_r8,2.6690e-03_r8,1.0905e-01_r8,1.5760e-01_r8,3.4585e-01_r8, & + &4.9399e-01_r8,5.6645e-01_r8,3.1389e-01_r8/) + kao(:, 1, 5,15) = (/ & + &2.8907e-03_r8,2.5398e-03_r8,2.1780e-03_r8,1.8164e-03_r8,1.4541e-03_r8,1.0940e-03_r8, & + &7.0483e-02_r8,1.0515e-01_r8,9.1867e-06_r8/) + kao(:, 2, 5,15) = (/ & + &3.1254e-03_r8,2.7393e-03_r8,2.3477e-03_r8,1.9606e-03_r8,1.5698e-03_r8,3.9518e-02_r8, & + &7.4031e-02_r8,1.7523e-01_r8,1.5406e-05_r8/) + kao(:, 3, 5,15) = (/ & + &6.7235e-03_r8,5.8882e-03_r8,5.0497e-03_r8,4.2126e-03_r8,3.3747e-03_r8,9.4974e-02_r8, & + &1.2240e-01_r8,2.6835e-01_r8,2.4302e-05_r8/) + kao(:, 4, 5,15) = (/ & + &1.0699e-02_r8,9.3645e-03_r8,8.0383e-03_r8,6.6993e-03_r8,5.3674e-03_r8,1.6163e-01_r8, & + &2.1236e-01_r8,3.9941e-01_r8,3.6217e-05_r8/) + kao(:, 5, 5,15) = (/ & + &1.3717e-02_r8,1.2003e-02_r8,1.0303e-02_r8,8.5901e-03_r8,7.6360e-02_r8,1.2908e-01_r8, & + &3.1926e-01_r8,5.2644e-01_r8,1.7649e-01_r8/) + kao(:, 1, 6,15) = (/ & + &8.1592e-03_r8,7.4369e-03_r8,6.3758e-03_r8,5.3146e-03_r8,4.2520e-03_r8,3.1909e-03_r8, & + &2.1298e-03_r8,5.0122e-02_r8,5.2510e-06_r8/) + kao(:, 2, 6,15) = (/ & + &1.6119e-02_r8,1.4482e-02_r8,1.2421e-02_r8,1.0082e-02_r8,8.0668e-03_r8,6.0513e-03_r8, & + &2.1472e-02_r8,7.5343e-02_r8,9.3553e-06_r8/) + kao(:, 3, 6,15) = (/ & + &2.2594e-02_r8,1.9767e-02_r8,1.6948e-02_r8,1.4132e-02_r8,1.1307e-02_r8,8.4832e-03_r8, & + &8.7408e-02_r8,1.3678e-01_r8,1.5081e-05_r8/) + kao(:, 4, 6,15) = (/ & + &2.8287e-02_r8,2.4765e-02_r8,2.1227e-02_r8,1.7693e-02_r8,1.4154e-02_r8,1.0619e-02_r8, & + &1.5774e-01_r8,2.2631e-01_r8,2.2824e-05_r8/) + kao(:, 5, 6,15) = (/ & + &3.3007e-02_r8,2.8867e-02_r8,2.4778e-02_r8,2.0634e-02_r8,1.6523e-02_r8,1.2392e-02_r8, & + &2.0991e-01_r8,3.3594e-01_r8,3.3161e-05_r8/) + kao(:, 1, 7,15) = (/ & + &3.2923e-02_r8,2.8801e-02_r8,2.4671e-02_r8,2.0232e-02_r8,1.6462e-02_r8,1.2339e-02_r8, & + &8.2302e-03_r8,4.1175e-03_r8,2.9069e-06_r8/) + kao(:, 2, 7,15) = (/ & + &4.4354e-02_r8,3.8819e-02_r8,3.3267e-02_r8,2.7723e-02_r8,2.2187e-02_r8,1.6641e-02_r8, & + &1.1094e-02_r8,4.4470e-02_r8,5.3667e-06_r8/) + kao(:, 3, 7,15) = (/ & + &5.4986e-02_r8,4.8115e-02_r8,4.1243e-02_r8,3.4364e-02_r8,2.7498e-02_r8,2.0642e-02_r8, & + &1.3901e-02_r8,1.0510e-01_r8,9.1519e-06_r8/) + kao(:, 4, 7,15) = (/ & + &6.4798e-02_r8,5.6696e-02_r8,4.8186e-02_r8,4.0508e-02_r8,3.2405e-02_r8,2.4095e-02_r8, & + &1.6208e-02_r8,1.7836e-01_r8,1.4620e-05_r8/) + kao(:, 5, 7,15) = (/ & + &7.2855e-02_r8,6.3755e-02_r8,5.4641e-02_r8,4.5546e-02_r8,3.6442e-02_r8,2.7544e-02_r8, & + &1.8370e-02_r8,1.8524e-01_r8,2.2125e-05_r8/) + kao(:, 1, 8,15) = (/ & + &9.4104e-02_r8,8.2337e-02_r8,7.0574e-02_r8,5.8796e-02_r8,4.7043e-02_r8,3.5284e-02_r8, & + &2.3531e-02_r8,1.1762e-02_r8,1.5730e-06_r8/) + kao(:, 2, 8,15) = (/ & + &1.1684e-01_r8,1.0226e-01_r8,8.7581e-02_r8,7.3021e-02_r8,5.8384e-02_r8,4.3796e-02_r8, & + &2.9205e-02_r8,1.4602e-02_r8,3.1057e-06_r8/) + kao(:, 3, 8,15) = (/ & + &1.3899e-01_r8,1.2165e-01_r8,1.0424e-01_r8,8.6874e-02_r8,6.9512e-02_r8,5.2129e-02_r8, & + &3.4755e-02_r8,1.7377e-02_r8,5.5778e-06_r8/) + kao(:, 4, 8,15) = (/ & + &1.6026e-01_r8,1.4023e-01_r8,1.2021e-01_r8,1.0019e-01_r8,8.0158e-02_r8,6.0094e-02_r8, & + &4.0057e-02_r8,2.0043e-02_r8,9.3711e-06_r8/) + kao(:, 5, 8,15) = (/ & + &1.7464e-01_r8,1.5283e-01_r8,1.3102e-01_r8,1.0918e-01_r8,8.7353e-02_r8,6.5505e-02_r8, & + &4.3670e-02_r8,2.1848e-02_r8,1.4780e-05_r8/) + kao(:, 1, 9,15) = (/ & + &4.3914e-01_r8,3.8426e-01_r8,3.2523e-01_r8,2.7101e-01_r8,2.1679e-01_r8,1.6466e-01_r8, & + &1.0980e-01_r8,5.4190e-02_r8,8.3394e-07_r8/) + kao(:, 2, 9,15) = (/ & + &5.3157e-01_r8,4.6496e-01_r8,3.9866e-01_r8,3.3222e-01_r8,2.6580e-01_r8,1.9932e-01_r8, & + &1.3289e-01_r8,6.6437e-02_r8,1.7793e-06_r8/) + kao(:, 3, 9,15) = (/ & + &6.2792e-01_r8,5.4930e-01_r8,4.7092e-01_r8,3.9242e-01_r8,3.1384e-01_r8,2.3543e-01_r8, & + &1.5698e-01_r8,7.8487e-02_r8,3.4095e-06_r8/) + kao(:, 4, 9,15) = (/ & + &6.9612e-01_r8,6.0916e-01_r8,5.2207e-01_r8,4.4160e-01_r8,3.4808e-01_r8,2.6107e-01_r8, & + &1.7405e-01_r8,8.7030e-02_r8,6.0449e-06_r8/) + kao(:, 5, 9,15) = (/ & + &7.1518e-01_r8,6.2568e-01_r8,5.3633e-01_r8,4.4688e-01_r8,3.5754e-01_r8,2.6806e-01_r8, & + &1.7876e-01_r8,8.9378e-02_r8,9.9175e-06_r8/) + kao(:, 1,10,15) = (/ & + &1.3796e+01_r8,1.2071e+01_r8,1.0346e+01_r8,8.6223e+00_r8,6.8983e+00_r8,5.1733e+00_r8, & + &3.4490e+00_r8,1.7245e+00_r8,4.7027e-07_r8/) + kao(:, 2,10,15) = (/ & + &2.6233e+00_r8,2.2954e+00_r8,1.9673e+00_r8,1.6395e+00_r8,1.3116e+00_r8,9.8356e-01_r8, & + &6.5573e-01_r8,3.2783e-01_r8,1.0735e-06_r8/) + kao(:, 3,10,15) = (/ & + &2.9028e+00_r8,2.5398e+00_r8,2.1774e+00_r8,1.8145e+00_r8,1.4515e+00_r8,1.0885e+00_r8, & + &7.2570e-01_r8,3.6294e-01_r8,2.1946e-06_r8/) + kao(:, 4,10,15) = (/ & + &2.9628e+00_r8,2.5919e+00_r8,2.2220e+00_r8,1.8518e+00_r8,1.4813e+00_r8,1.1109e+00_r8, & + &7.4065e-01_r8,3.7038e-01_r8,4.0439e-06_r8/) + kao(:, 5,10,15) = (/ & + &3.0421e+00_r8,2.6615e+00_r8,2.2818e+00_r8,1.9012e+00_r8,1.5210e+00_r8,1.1408e+00_r8, & + &7.6043e-01_r8,3.8023e-01_r8,6.8742e-06_r8/) + kao(:, 1,11,15) = (/ & + &5.1563e+01_r8,4.5117e+01_r8,3.8674e+01_r8,3.2227e+01_r8,2.5782e+01_r8,1.9336e+01_r8, & + &1.2891e+01_r8,6.4453e+00_r8,4.0707e-07_r8/) + kao(:, 2,11,15) = (/ & + &4.0297e+00_r8,3.5262e+00_r8,3.0227e+00_r8,2.5187e+00_r8,2.0150e+00_r8,1.5474e+00_r8, & + &1.0073e+00_r8,5.0377e-01_r8,9.5505e-07_r8/) + kao(:, 3,11,15) = (/ & + &4.2638e+00_r8,3.7317e+00_r8,3.1981e+00_r8,2.6654e+00_r8,2.1321e+00_r8,1.5993e+00_r8, & + &1.0662e+00_r8,5.3312e-01_r8,1.9370e-06_r8/) + kao(:, 4,11,15) = (/ & + &4.5225e+00_r8,3.9566e+00_r8,3.3892e+00_r8,2.8266e+00_r8,2.2603e+00_r8,1.6955e+00_r8, & + &1.1303e+00_r8,5.6504e-01_r8,3.5823e-06_r8/) + kao(:, 5,11,15) = (/ & + &4.7336e+00_r8,4.1418e+00_r8,3.5502e+00_r8,2.9582e+00_r8,2.3669e+00_r8,1.7755e+00_r8, & + &1.1834e+00_r8,5.9176e-01_r8,6.1298e-06_r8/) + kao(:, 1,12,15) = (/ & + &1.0350e+02_r8,9.0564e+01_r8,7.7625e+01_r8,6.4688e+01_r8,5.1750e+01_r8,3.8814e+01_r8, & + &2.5874e+01_r8,1.2937e+01_r8,3.8485e-07_r8/) + kao(:, 2,12,15) = (/ & + &3.5400e+01_r8,3.0974e+01_r8,2.7218e+01_r8,2.2126e+01_r8,1.7700e+01_r8,1.3275e+01_r8, & + &8.8500e+00_r8,4.4247e+00_r8,8.6295e-07_r8/) + kao(:, 3,12,15) = (/ & + &4.7917e+00_r8,4.1902e+00_r8,3.5927e+00_r8,2.9945e+00_r8,2.3939e+00_r8,1.7963e+00_r8, & + &1.1970e+00_r8,5.9908e-01_r8,1.7414e-06_r8/) + kao(:, 4,12,15) = (/ & + &4.7749e+00_r8,4.1779e+00_r8,3.5811e+00_r8,2.9844e+00_r8,2.3876e+00_r8,1.7905e+00_r8, & + &1.1938e+00_r8,5.9689e-01_r8,3.1576e-06_r8/) + kao(:, 5,12,15) = (/ & + &4.7755e+00_r8,4.1774e+00_r8,3.5815e+00_r8,2.9845e+00_r8,2.3876e+00_r8,1.7910e+00_r8, & + &1.1938e+00_r8,5.9711e-01_r8,5.4455e-06_r8/) + kao(:, 1,13,15) = (/ & + &1.3564e+02_r8,1.2035e+02_r8,1.0244e+02_r8,8.5373e+01_r8,6.8293e+01_r8,5.1221e+01_r8, & + &3.4147e+01_r8,1.7074e+01_r8,3.5301e-07_r8/) + kao(:, 2,13,15) = (/ & + &6.6923e+01_r8,5.8556e+01_r8,5.0190e+01_r8,4.1824e+01_r8,3.3458e+01_r8,2.5094e+01_r8, & + &1.6730e+01_r8,8.3652e+00_r8,7.8175e-07_r8/) + kao(:, 3,13,15) = (/ & + &3.7003e+00_r8,3.2381e+00_r8,2.7755e+00_r8,2.3126e+00_r8,1.8500e+00_r8,1.3876e+00_r8, & + &9.2513e-01_r8,4.6258e-01_r8,1.5659e-06_r8/) + kao(:, 4,13,15) = (/ & + &3.7328e+00_r8,3.2655e+00_r8,2.7985e+00_r8,2.3334e+00_r8,1.8661e+00_r8,1.3995e+00_r8, & + &9.3310e-01_r8,4.6647e-01_r8,2.9454e-06_r8/) + kao(:, 5,13,15) = (/ & + &3.7209e+00_r8,3.2581e+00_r8,2.7929e+00_r8,2.3278e+00_r8,1.8618e+00_r8,1.3966e+00_r8, & + &9.3071e-01_r8,4.6580e-01_r8,5.0591e-06_r8/) + kao(:, 1, 1,16) = (/ & + &3.4803e-04_r8,3.1375e-04_r8,9.0029e-02_r8,1.3230e-01_r8,1.7123e-01_r8,2.0432e-01_r8, & + &2.2540e-01_r8,2.1561e-01_r8,3.4246e-01_r8/) + kao(:, 2, 1,16) = (/ & + &3.6711e-04_r8,6.2185e-02_r8,1.2251e-01_r8,1.8007e-01_r8,2.3310e-01_r8,2.7812e-01_r8, & + &3.0698e-01_r8,2.9374e-01_r8,4.6619e-01_r8/) + kao(:, 3, 1,16) = (/ & + &3.8231e-04_r8,8.1789e-02_r8,1.6116e-01_r8,2.3685e-01_r8,3.0661e-01_r8,3.6587e-01_r8, & + &4.0384e-01_r8,3.8690e-01_r8,6.1322e-01_r8/) + kao(:, 4, 1,16) = (/ & + &3.9398e-04_r8,1.0451e-01_r8,2.0587e-01_r8,3.0259e-01_r8,3.9179e-01_r8,4.6767e-01_r8, & + &5.1634e-01_r8,4.9462e-01_r8,7.8358e-01_r8/) + kao(:, 5, 1,16) = (/ & + &4.0251e-04_r8,1.3022e-01_r8,2.5663e-01_r8,3.7711e-01_r8,4.8832e-01_r8,5.8296e-01_r8, & + &6.4377e-01_r8,6.1717e-01_r8,9.7664e-01_r8/) + kao(:, 1, 2,16) = (/ & + &4.4386e-04_r8,3.9528e-04_r8,9.5606e-02_r8,1.4144e-01_r8,1.8490e-01_r8,2.2388e-01_r8, & + &2.5317e-01_r8,2.5424e-01_r8,3.6979e-01_r8/) + kao(:, 2, 2,16) = (/ & + &4.6963e-04_r8,4.2143e-04_r8,1.3208e-01_r8,1.9543e-01_r8,2.5549e-01_r8,3.0939e-01_r8, & + &3.5000e-01_r8,3.5157e-01_r8,5.1097e-01_r8/) + kao(:, 3, 2,16) = (/ & + &4.9052e-04_r8,4.4450e-04_r8,1.7597e-01_r8,2.6040e-01_r8,3.4044e-01_r8,4.1226e-01_r8, & + &4.6651e-01_r8,4.6873e-01_r8,6.8087e-01_r8/) + kao(:, 4, 2,16) = (/ & + &5.0548e-04_r8,4.6448e-04_r8,2.2723e-01_r8,3.3632e-01_r8,4.3972e-01_r8,5.3255e-01_r8, & + &6.0266e-01_r8,6.0594e-01_r8,8.7943e-01_r8/) + kao(:, 5, 2,16) = (/ & + &5.1704e-04_r8,1.4434e-01_r8,2.8579e-01_r8,4.2309e-01_r8,5.5324e-01_r8,6.7011e-01_r8, & + &7.5842e-01_r8,7.6291e-01_r8,1.1065e+00_r8/) + kao(:, 1, 3,16) = (/ & + &7.4514e-04_r8,6.5703e-04_r8,5.6805e-04_r8,1.3986e-01_r8,1.8472e-01_r8,2.2721e-01_r8, & + &2.6439e-01_r8,2.8334e-01_r8,3.6943e-01_r8/) + kao(:, 2, 3,16) = (/ & + &7.9344e-04_r8,7.0163e-04_r8,6.1002e-04_r8,1.9810e-01_r8,2.6159e-01_r8,3.2183e-01_r8, & + &3.7436e-01_r8,4.0145e-01_r8,5.2319e-01_r8/) + kao(:, 3, 3,16) = (/ & + &8.3288e-04_r8,7.4056e-04_r8,6.4608e-04_r8,2.6931e-01_r8,3.5570e-01_r8,4.3753e-01_r8, & + &5.0928e-01_r8,5.4624e-01_r8,7.1140e-01_r8/) + kao(:, 4, 3,16) = (/ & + &8.6418e-04_r8,7.7079e-04_r8,1.2130e-02_r8,3.5401e-01_r8,4.6743e-01_r8,5.7518e-01_r8, & + &6.6923e-01_r8,7.1819e-01_r8,9.3487e-01_r8/) + kao(:, 5, 3,16) = (/ & + &8.8628e-04_r8,7.9797e-04_r8,3.0313e-01_r8,4.5187e-01_r8,5.9661e-01_r8,7.3417e-01_r8, & + &8.5463e-01_r8,9.1729e-01_r8,1.1932e+00_r8/) + kao(:, 1, 4,16) = (/ & + &1.2636e-03_r8,1.1057e-03_r8,9.5136e-04_r8,7.9620e-04_r8,6.4188e-04_r8,2.1791e-01_r8, & + &2.5758e-01_r8,2.8791e-01_r8,2.3364e-05_r8/) + kao(:, 2, 4,16) = (/ & + &1.3610e-03_r8,1.1957e-03_r8,1.0270e-03_r8,8.6413e-04_r8,7.0025e-04_r8,3.1776e-01_r8, & + &3.7570e-01_r8,4.1991e-01_r8,3.8771e-05_r8/) + kao(:, 3, 4,16) = (/ & + &1.4417e-03_r8,1.2662e-03_r8,1.0946e-03_r8,9.2411e-04_r8,3.5694e-01_r8,4.4267e-01_r8, & + &5.2346e-01_r8,5.8520e-01_r8,7.1388e-01_r8/) + kao(:, 4, 4,16) = (/ & + &1.5012e-03_r8,1.3268e-03_r8,1.1484e-03_r8,9.7089e-04_r8,4.7866e-01_r8,5.9391e-01_r8, & + &7.0229e-01_r8,7.8545e-01_r8,9.5731e-01_r8/) + kao(:, 5, 4,16) = (/ & + &1.5493e-03_r8,1.3712e-03_r8,1.1941e-03_r8,1.0165e-03_r8,6.2163e-01_r8,7.7110e-01_r8, & + &9.1212e-01_r8,1.0202e+00_r8,1.2432e+00_r8/) + kao(:, 1, 5,16) = (/ & + &1.9563e-03_r8,1.7130e-03_r8,1.4716e-03_r8,1.2286e-03_r8,9.8449e-04_r8,7.4210e-04_r8, & + &5.0011e-04_r8,2.7578e-01_r8,1.4521e-05_r8/) + kao(:, 2, 5,16) = (/ & + &2.1251e-03_r8,1.8616e-03_r8,1.5991e-03_r8,1.3382e-03_r8,1.0747e-03_r8,8.1191e-04_r8, & + &3.6392e-01_r8,4.1523e-01_r8,2.5317e-05_r8/) + kao(:, 3, 5,16) = (/ & + &2.2685e-03_r8,1.9902e-03_r8,1.7118e-03_r8,1.4319e-03_r8,1.1550e-03_r8,8.7607e-04_r8, & + &5.2057e-01_r8,5.9412e-01_r8,4.1189e-05_r8/) + kao(:, 4, 5,16) = (/ & + &2.3834e-03_r8,2.0939e-03_r8,1.8039e-03_r8,1.5145e-03_r8,1.2237e-03_r8,9.3428e-04_r8, & + &7.1378e-01_r8,8.1462e-01_r8,6.3394e-05_r8/) + kao(:, 5, 5,16) = (/ & + &2.4764e-03_r8,2.1786e-03_r8,1.8819e-03_r8,1.5832e-03_r8,1.2860e-03_r8,7.9256e-01_r8, & + &9.4410e-01_r8,1.0778e+00_r8,9.2980e-05_r8/) + kao(:, 1, 6,16) = (/ & + &2.8061e-03_r8,2.4583e-03_r8,2.1085e-03_r8,1.7622e-03_r8,1.4067e-03_r8,1.0576e-03_r8, & + &7.0829e-04_r8,1.6992e-01_r8,8.6758e-06_r8/) + kao(:, 2, 6,16) = (/ & + &3.0921e-03_r8,2.7056e-03_r8,2.3212e-03_r8,1.9356e-03_r8,1.5529e-03_r8,1.1677e-03_r8, & + &7.8418e-04_r8,3.9086e-01_r8,1.5977e-05_r8/) + kao(:, 3, 6,16) = (/ & + &3.3322e-03_r8,2.9180e-03_r8,2.5057e-03_r8,2.0938e-03_r8,1.6795e-03_r8,1.2657e-03_r8, & + &8.5374e-04_r8,5.7620e-01_r8,2.7234e-05_r8/) + kao(:, 4, 6,16) = (/ & + &3.5394e-03_r8,3.0979e-03_r8,2.6608e-03_r8,2.2263e-03_r8,1.7897e-03_r8,1.3517e-03_r8, & + &9.1571e-04_r8,8.0997e-01_r8,4.3592e-05_r8/) + kao(:, 5, 6,16) = (/ & + &3.6973e-03_r8,3.2450e-03_r8,2.7879e-03_r8,2.3342e-03_r8,1.8813e-03_r8,1.4280e-03_r8, & + &2.3591e-01_r8,1.0936e+00_r8,6.6108e-05_r8/) + kao(:, 1, 7,16) = (/ & + &4.1566e-03_r8,3.6382e-03_r8,3.1187e-03_r8,2.5984e-03_r8,2.0809e-03_r8,1.5620e-03_r8, & + &1.0430e-03_r8,5.2415e-04_r8,5.0515e-06_r8/) + kao(:, 2, 7,16) = (/ & + &4.6397e-03_r8,4.0602e-03_r8,3.4821e-03_r8,2.9026e-03_r8,2.3244e-03_r8,1.7452e-03_r8, & + &1.1674e-03_r8,5.8830e-04_r8,9.8982e-06_r8/) + kao(:, 3, 7,16) = (/ & + &5.0641e-03_r8,4.4282e-03_r8,3.8004e-03_r8,3.1687e-03_r8,2.5412e-03_r8,1.9080e-03_r8, & + &1.2777e-03_r8,6.4842e-04_r8,1.7758e-05_r8/) + kao(:, 4, 7,16) = (/ & + &5.4224e-03_r8,4.7462e-03_r8,4.0771e-03_r8,3.3992e-03_r8,2.7272e-03_r8,2.0505e-03_r8, & + &1.3779e-03_r8,7.0354e-04_r8,2.9670e-05_r8/) + kao(:, 5, 7,16) = (/ & + &5.7229e-03_r8,5.0101e-03_r8,4.3011e-03_r8,3.5983e-03_r8,2.8833e-03_r8,2.1757e-03_r8, & + &1.4658e-03_r8,6.1847e-01_r8,4.6639e-05_r8/) + kao(:, 1, 8,16) = (/ & + &7.1654e-03_r8,6.2688e-03_r8,5.3745e-03_r8,4.4778e-03_r8,3.5800e-03_r8,2.6883e-03_r8, & + &1.7931e-03_r8,8.9706e-04_r8,2.8888e-06_r8/) + kao(:, 2, 8,16) = (/ & + &8.1399e-03_r8,7.1118e-03_r8,6.0997e-03_r8,5.0831e-03_r8,4.0665e-03_r8,3.0517e-03_r8, & + &2.0386e-03_r8,1.0214e-03_r8,6.0412e-06_r8/) + kao(:, 3, 8,16) = (/ & + &8.9800e-03_r8,7.8609e-03_r8,6.7393e-03_r8,5.6216e-03_r8,4.4978e-03_r8,3.3745e-03_r8, & + &2.2551e-03_r8,1.1328e-03_r8,1.1454e-05_r8/) + kao(:, 4, 8,16) = (/ & + &9.7139e-03_r8,8.5067e-03_r8,7.2942e-03_r8,6.0777e-03_r8,4.8682e-03_r8,3.6593e-03_r8, & + &2.4437e-03_r8,1.2326e-03_r8,2.0029e-05_r8/) + kao(:, 5, 8,16) = (/ & + &1.0337e-02_r8,9.0473e-03_r8,7.7560e-03_r8,6.4703e-03_r8,5.1860e-03_r8,3.8948e-03_r8, & + &2.6072e-03_r8,1.3207e-03_r8,3.2759e-05_r8/) + kao(:, 1, 9,16) = (/ & + &2.3247e-02_r8,2.0336e-02_r8,1.7429e-02_r8,1.4524e-02_r8,1.1625e-02_r8,8.7188e-03_r8, & + &5.8147e-03_r8,2.9059e-03_r8,1.6015e-06_r8/) + kao(:, 2, 9,16) = (/ & + &2.6840e-02_r8,2.3482e-02_r8,2.0132e-02_r8,1.6770e-02_r8,1.3422e-02_r8,1.0063e-02_r8, & + &6.7117e-03_r8,3.3577e-03_r8,3.6050e-06_r8/) + kao(:, 3, 9,16) = (/ & + &3.0078e-02_r8,2.6329e-02_r8,2.2553e-02_r8,1.8793e-02_r8,1.5044e-02_r8,1.1280e-02_r8, & + &7.5240e-03_r8,3.7656e-03_r8,7.2546e-06_r8/) + kao(:, 4, 9,16) = (/ & + &3.2925e-02_r8,2.8810e-02_r8,2.4697e-02_r8,2.0586e-02_r8,3.0583e-02_r8,1.2361e-02_r8, & + &8.2421e-03_r8,4.1354e-03_r8,1.3329e-05_r8/) + kao(:, 5, 9,16) = (/ & + &3.5342e-02_r8,3.0934e-02_r8,2.6503e-02_r8,2.2104e-02_r8,1.7684e-02_r8,1.3262e-02_r8, & + &8.8536e-03_r8,4.4397e-03_r8,2.2693e-05_r8/) + kao(:, 1,10,16) = (/ & + &8.4703e-02_r8,7.4117e-02_r8,6.3535e-02_r8,5.2927e-02_r8,4.2343e-02_r8,3.1773e-02_r8, & + &2.1175e-02_r8,1.0588e-02_r8,9.2688e-07_r8/) + kao(:, 2,10,16) = (/ & + &9.9410e-02_r8,8.7009e-02_r8,7.4556e-02_r8,6.2160e-02_r8,4.9698e-02_r8,3.7265e-02_r8, & + &2.4850e-02_r8,1.2429e-02_r8,2.2335e-06_r8/) + kao(:, 3,10,16) = (/ & + &1.1291e-01_r8,9.8729e-02_r8,8.4692e-02_r8,7.0598e-02_r8,5.6422e-02_r8,4.2355e-02_r8, & + &2.8232e-02_r8,1.4106e-02_r8,4.7476e-06_r8/) + kao(:, 4,10,16) = (/ & + &1.2498e-01_r8,1.0930e-01_r8,9.3695e-02_r8,7.8057e-02_r8,6.2479e-02_r8,4.6859e-02_r8, & + &3.1244e-02_r8,1.5627e-02_r8,9.1259e-06_r8/) + kao(:, 5,10,16) = (/ & + &1.3523e-01_r8,1.1838e-01_r8,1.0149e-01_r8,8.4512e-02_r8,6.7619e-02_r8,5.0737e-02_r8, & + &3.3842e-02_r8,1.6917e-02_r8,1.6155e-05_r8/) + kao(:, 1,11,16) = (/ & + &1.1702e-01_r8,1.0242e-01_r8,8.7781e-02_r8,7.3100e-02_r8,5.8528e-02_r8,4.3847e-02_r8, & + &2.9250e-02_r8,1.4631e-02_r8,8.3202e-07_r8/) + kao(:, 2,11,16) = (/ & + &1.3733e-01_r8,1.2017e-01_r8,1.0300e-01_r8,8.5853e-02_r8,6.8653e-02_r8,5.1492e-02_r8, & + &3.4322e-02_r8,1.7153e-02_r8,2.0128e-06_r8/) + kao(:, 3,11,16) = (/ & + &1.5584e-01_r8,1.3638e-01_r8,1.1685e-01_r8,9.7461e-02_r8,7.7843e-02_r8,5.8372e-02_r8, & + &3.8976e-02_r8,1.9510e-02_r8,4.3129e-06_r8/) + kao(:, 4,11,16) = (/ & + &1.7239e-01_r8,1.5086e-01_r8,1.2928e-01_r8,1.0779e-01_r8,8.6176e-02_r8,6.4725e-02_r8, & + &4.3097e-02_r8,2.1516e-02_r8,8.3117e-06_r8/) + kao(:, 5,11,16) = (/ & + &1.8654e-01_r8,1.6325e-01_r8,1.3989e-01_r8,1.1667e-01_r8,9.3408e-02_r8,7.0060e-02_r8, & + &4.6775e-02_r8,2.3342e-02_r8,1.4729e-05_r8/) + kao(:, 1,12,16) = (/ & + &1.1854e-01_r8,1.0376e-01_r8,8.8946e-02_r8,7.4074e-02_r8,5.9255e-02_r8,4.4504e-02_r8, & + &2.9679e-02_r8,1.4800e-02_r8,7.4749e-07_r8/) + kao(:, 2,12,16) = (/ & + &1.3943e-01_r8,1.2204e-01_r8,1.0463e-01_r8,8.7342e-02_r8,6.9856e-02_r8,5.2356e-02_r8, & + &3.4894e-02_r8,1.7410e-02_r8,1.8161e-06_r8/) + kao(:, 3,12,16) = (/ & + &1.5836e-01_r8,1.3868e-01_r8,1.1885e-01_r8,9.9001e-02_r8,7.9338e-02_r8,5.9413e-02_r8, & + &3.9707e-02_r8,1.9806e-02_r8,3.8901e-06_r8/) + kao(:, 4,12,16) = (/ & + &1.7966e-01_r8,1.5728e-01_r8,1.3478e-01_r8,1.1217e-01_r8,8.9784e-02_r8,6.7270e-02_r8, & + &4.4900e-02_r8,2.2432e-02_r8,7.2752e-06_r8/) + kao(:, 5,12,16) = (/ & + &2.0635e-01_r8,1.8060e-01_r8,1.5479e-01_r8,1.2891e-01_r8,1.0321e-01_r8,7.7324e-02_r8, & + &5.1591e-02_r8,2.5791e-02_r8,1.2040e-05_r8/) + kao(:, 1,13,16) = (/ & + &2.1930e-01_r8,8.1271e-02_r8,6.9650e-02_r8,5.7973e-02_r8,4.6358e-02_r8,3.4782e-02_r8, & + &2.3204e-02_r8,1.1588e-02_r8,6.6806e-07_r8/) + kao(:, 2,13,16) = (/ & + &1.1205e-01_r8,9.8083e-02_r8,8.4056e-02_r8,7.0107e-02_r8,5.6050e-02_r8,4.2050e-02_r8, & + &2.7998e-02_r8,1.4011e-02_r8,1.5755e-06_r8/) + kao(:, 3,13,16) = (/ & + &1.3646e-01_r8,1.1932e-01_r8,1.0236e-01_r8,8.5263e-02_r8,6.8236e-02_r8,5.1131e-02_r8, & + &3.4091e-02_r8,1.7065e-02_r8,3.1454e-06_r8/) + kao(:, 4,13,16) = (/ & + &1.5976e-01_r8,1.3979e-01_r8,1.1981e-01_r8,9.9935e-02_r8,7.9931e-02_r8,5.9857e-02_r8, & + &3.9898e-02_r8,1.9961e-02_r8,5.5256e-06_r8/) + kao(:, 5,13,16) = (/ & + &1.7769e-01_r8,1.5548e-01_r8,1.3326e-01_r8,1.1109e-01_r8,8.8840e-02_r8,6.6629e-02_r8, & + &4.4447e-02_r8,2.2232e-02_r8,9.1943e-06_r8/) + +! The array KAO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mco2( 1, :, 1) = (/ & + & 1.09539e-04_r8, 1.17067e-04_r8, 1.25113e-04_r8, 1.33712e-04_r8, 1.42902e-04_r8, & + & 1.52724e-04_r8, 1.63221e-04_r8, 1.74439e-04_r8, 1.86428e-04_r8, 1.99241e-04_r8, & + & 2.12934e-04_r8, 2.27569e-04_r8, 2.43210e-04_r8, 2.59926e-04_r8, 2.77790e-04_r8, & + & 2.96883e-04_r8, 3.17287e-04_r8, 3.39094e-04_r8, 3.62400e-04_r8/) + kao_mco2( 2, :, 1) = (/ & + & 1.25202e-04_r8, 1.34718e-04_r8, 1.44957e-04_r8, 1.55974e-04_r8, 1.67829e-04_r8, & + & 1.80585e-04_r8, 1.94311e-04_r8, 2.09079e-04_r8, 2.24971e-04_r8, 2.42069e-04_r8, & + & 2.60468e-04_r8, 2.80265e-04_r8, 3.01567e-04_r8, 3.24488e-04_r8, 3.49150e-04_r8, & + & 3.75688e-04_r8, 4.04242e-04_r8, 4.34966e-04_r8, 4.68026e-04_r8/) + kao_mco2( 3, :, 1) = (/ & + & 1.12112e-04_r8, 1.21090e-04_r8, 1.30786e-04_r8, 1.41259e-04_r8, 1.52571e-04_r8, & + & 1.64788e-04_r8, 1.77984e-04_r8, 1.92237e-04_r8, 2.07631e-04_r8, 2.24257e-04_r8, & + & 2.42215e-04_r8, 2.61611e-04_r8, 2.82560e-04_r8, 3.05187e-04_r8, 3.29625e-04_r8, & + & 3.56021e-04_r8, 3.84530e-04_r8, 4.15322e-04_r8, 4.48580e-04_r8/) + kao_mco2( 4, :, 1) = (/ & + & 9.74130e-05_r8, 1.05372e-04_r8, 1.13982e-04_r8, 1.23295e-04_r8, 1.33369e-04_r8, & + & 1.44265e-04_r8, 1.56053e-04_r8, 1.68803e-04_r8, 1.82595e-04_r8, 1.97514e-04_r8, & + & 2.13652e-04_r8, 2.31109e-04_r8, 2.49992e-04_r8, 2.70418e-04_r8, 2.92512e-04_r8, & + & 3.16412e-04_r8, 3.42265e-04_r8, 3.70230e-04_r8, 4.00479e-04_r8/) + kao_mco2( 5, :, 1) = (/ & + & 8.71018e-05_r8, 9.40759e-05_r8, 1.01608e-04_r8, 1.09744e-04_r8, 1.18531e-04_r8, & + & 1.28022e-04_r8, 1.38272e-04_r8, 1.49343e-04_r8, 1.61301e-04_r8, 1.74216e-04_r8, & + & 1.88166e-04_r8, 2.03232e-04_r8, 2.19504e-04_r8, 2.37079e-04_r8, 2.56062e-04_r8, & + & 2.76565e-04_r8, 2.98709e-04_r8, 3.22626e-04_r8, 3.48458e-04_r8/) + kao_mco2( 6, :, 1) = (/ & + & 7.55256e-05_r8, 8.17414e-05_r8, 8.84688e-05_r8, 9.57500e-05_r8, 1.03630e-04_r8, & + & 1.12159e-04_r8, 1.21390e-04_r8, 1.31381e-04_r8, 1.42193e-04_r8, 1.53896e-04_r8, & + & 1.66562e-04_r8, 1.80270e-04_r8, 1.95107e-04_r8, 2.11164e-04_r8, 2.28543e-04_r8, & + & 2.47353e-04_r8, 2.67710e-04_r8, 2.89743e-04_r8, 3.13589e-04_r8/) + kao_mco2( 7, :, 1) = (/ & + & 5.31515e-05_r8, 6.06869e-05_r8, 6.92907e-05_r8, 7.91143e-05_r8, 9.03306e-05_r8, & + & 1.03137e-04_r8, 1.17759e-04_r8, 1.34454e-04_r8, 1.53516e-04_r8, 1.75281e-04_r8, & + & 2.00131e-04_r8, 2.28504e-04_r8, 2.60900e-04_r8, 2.97888e-04_r8, 3.40121e-04_r8, & + & 3.88341e-04_r8, 4.43397e-04_r8, 5.06259e-04_r8, 5.78033e-04_r8/) + kao_mco2( 8, :, 1) = (/ & + & 2.52471e-04_r8, 2.96005e-04_r8, 3.47045e-04_r8, 4.06886e-04_r8, 4.77045e-04_r8, & + & 5.59302e-04_r8, 6.55742e-04_r8, 7.68811e-04_r8, 9.01377e-04_r8, 1.05680e-03_r8, & + & 1.23902e-03_r8, 1.45267e-03_r8, 1.70315e-03_r8, 1.99683e-03_r8, 2.34114e-03_r8, & + & 2.74482e-03_r8, 3.21811e-03_r8, 3.77300e-03_r8, 4.42358e-03_r8/) + kao_mco2( 9, :, 1) = (/ & + & 4.06711e-05_r8, 4.53161e-05_r8, 5.04917e-05_r8, 5.62583e-05_r8, 6.26836e-05_r8, & + & 6.98427e-05_r8, 7.78194e-05_r8, 8.67071e-05_r8, 9.66100e-05_r8, 1.07644e-04_r8, & + & 1.19938e-04_r8, 1.33636e-04_r8, 1.48898e-04_r8, 1.65904e-04_r8, 1.84852e-04_r8, & + & 2.05964e-04_r8, 2.29487e-04_r8, 2.55697e-04_r8, 2.84900e-04_r8/) + kao_mco2( 1, :, 2) = (/ & + & 2.01759e-04_r8, 2.15641e-04_r8, 2.30478e-04_r8, 2.46336e-04_r8, 2.63285e-04_r8, & + & 2.81400e-04_r8, 3.00761e-04_r8, 3.21455e-04_r8, 3.43573e-04_r8, 3.67212e-04_r8, & + & 3.92477e-04_r8, 4.19482e-04_r8, 4.48344e-04_r8, 4.79192e-04_r8, 5.12162e-04_r8, & + & 5.47401e-04_r8, 5.85064e-04_r8, 6.25319e-04_r8, 6.68343e-04_r8/) + kao_mco2( 2, :, 2) = (/ & + & 2.53461e-04_r8, 2.70916e-04_r8, 2.89574e-04_r8, 3.09516e-04_r8, 3.30832e-04_r8, & + & 3.53616e-04_r8, 3.77969e-04_r8, 4.03999e-04_r8, 4.31822e-04_r8, 4.61561e-04_r8, & + & 4.93348e-04_r8, 5.27324e-04_r8, 5.63640e-04_r8, 6.02457e-04_r8, 6.43948e-04_r8, & + & 6.88295e-04_r8, 7.35697e-04_r8, 7.86364e-04_r8, 8.40519e-04_r8/) + kao_mco2( 3, :, 2) = (/ & + & 2.58821e-04_r8, 2.76943e-04_r8, 2.96334e-04_r8, 3.17082e-04_r8, 3.39283e-04_r8, & + & 3.63038e-04_r8, 3.88457e-04_r8, 4.15655e-04_r8, 4.44758e-04_r8, 4.75899e-04_r8, & + & 5.09220e-04_r8, 5.44874e-04_r8, 5.83024e-04_r8, 6.23845e-04_r8, 6.67525e-04_r8, & + & 7.14263e-04_r8, 7.64273e-04_r8, 8.17785e-04_r8, 8.75043e-04_r8/) + kao_mco2( 4, :, 2) = (/ & + & 2.46588e-04_r8, 2.64630e-04_r8, 2.83993e-04_r8, 3.04771e-04_r8, 3.27071e-04_r8, & + & 3.51001e-04_r8, 3.76683e-04_r8, 4.04244e-04_r8, 4.33821e-04_r8, 4.65563e-04_r8, & + & 4.99627e-04_r8, 5.36183e-04_r8, 5.75414e-04_r8, 6.17515e-04_r8, 6.62697e-04_r8, & + & 7.11185e-04_r8, 7.63220e-04_r8, 8.19063e-04_r8, 8.78991e-04_r8/) + kao_mco2( 5, :, 2) = (/ & + & 2.19140e-04_r8, 2.36464e-04_r8, 2.55158e-04_r8, 2.75330e-04_r8, 2.97097e-04_r8, & + & 3.20585e-04_r8, 3.45929e-04_r8, 3.73277e-04_r8, 4.02787e-04_r8, 4.34630e-04_r8, & + & 4.68991e-04_r8, 5.06068e-04_r8, 5.46076e-04_r8, 5.89247e-04_r8, 6.35831e-04_r8, & + & 6.86097e-04_r8, 7.40338e-04_r8, 7.98867e-04_r8, 8.62022e-04_r8/) + kao_mco2( 6, :, 2) = (/ & + & 1.74073e-04_r8, 1.92221e-04_r8, 2.12260e-04_r8, 2.34388e-04_r8, 2.58824e-04_r8, & + & 2.85807e-04_r8, 3.15603e-04_r8, 3.48505e-04_r8, 3.84837e-04_r8, 4.24957e-04_r8, & + & 4.69260e-04_r8, 5.18181e-04_r8, 5.72202e-04_r8, 6.31855e-04_r8, 6.97727e-04_r8, & + & 7.70466e-04_r8, 8.50789e-04_r8, 9.39485e-04_r8, 1.03743e-03_r8/) + kao_mco2( 7, :, 2) = (/ & + & 1.74359e-04_r8, 1.99276e-04_r8, 2.27753e-04_r8, 2.60299e-04_r8, 2.97497e-04_r8, & + & 3.40010e-04_r8, 3.88599e-04_r8, 4.44130e-04_r8, 5.07598e-04_r8, 5.80135e-04_r8, & + & 6.63039e-04_r8, 7.57789e-04_r8, 8.66079e-04_r8, 9.89845e-04_r8, 1.13130e-03_r8, & + & 1.29296e-03_r8, 1.47773e-03_r8, 1.68890e-03_r8, 1.93025e-03_r8/) + kao_mco2( 8, :, 2) = (/ & + & 1.08215e-03_r8, 1.20760e-03_r8, 1.34759e-03_r8, 1.50382e-03_r8, 1.67815e-03_r8, & + & 1.87270e-03_r8, 2.08980e-03_r8, 2.33206e-03_r8, 2.60242e-03_r8, 2.90411e-03_r8, & + & 3.24078e-03_r8, 3.61648e-03_r8, 4.03573e-03_r8, 4.50359e-03_r8, 5.02568e-03_r8, & + & 5.60830e-03_r8, 6.25846e-03_r8, 6.98399e-03_r8, 7.79363e-03_r8/) + kao_mco2( 9, :, 2) = (/ & + & 1.04969e-04_r8, 1.20766e-04_r8, 1.38939e-04_r8, 1.59848e-04_r8, 1.83903e-04_r8, & + & 2.11578e-04_r8, 2.43418e-04_r8, 2.80049e-04_r8, 3.22193e-04_r8, 3.70678e-04_r8, & + & 4.26461e-04_r8, 4.90638e-04_r8, 5.64472e-04_r8, 6.49418e-04_r8, 7.47147e-04_r8, & + & 8.59583e-04_r8, 9.88940e-04_r8, 1.13776e-03_r8, 1.30898e-03_r8/) + kao_mco2( 1, :, 3) = (/ & + & 3.72106e-04_r8, 3.96252e-04_r8, 4.21966e-04_r8, 4.49347e-04_r8, 4.78506e-04_r8, & + & 5.09557e-04_r8, 5.42623e-04_r8, 5.77834e-04_r8, 6.15330e-04_r8, 6.55260e-04_r8, & + & 6.97781e-04_r8, 7.43060e-04_r8, 7.91278e-04_r8, 8.42626e-04_r8, 8.97304e-04_r8, & + & 9.55532e-04_r8, 1.01754e-03_r8, 1.08357e-03_r8, 1.15388e-03_r8/) + kao_mco2( 2, :, 3) = (/ & + & 4.20563e-04_r8, 4.46162e-04_r8, 4.73319e-04_r8, 5.02130e-04_r8, 5.32693e-04_r8, & + & 5.65118e-04_r8, 5.99516e-04_r8, 6.36007e-04_r8, 6.74720e-04_r8, 7.15789e-04_r8, & + & 7.59358e-04_r8, 8.05579e-04_r8, 8.54613e-04_r8, 9.06632e-04_r8, 9.61817e-04_r8, & + & 1.02036e-03_r8, 1.08247e-03_r8, 1.14836e-03_r8, 1.21826e-03_r8/) + kao_mco2( 3, :, 3) = (/ & + & 4.89664e-04_r8, 5.18321e-04_r8, 5.48654e-04_r8, 5.80764e-04_r8, 6.14752e-04_r8, & + & 6.50729e-04_r8, 6.88812e-04_r8, 7.29124e-04_r8, 7.71795e-04_r8, 8.16963e-04_r8, & + & 8.64774e-04_r8, 9.15384e-04_r8, 9.68955e-04_r8, 1.02566e-03_r8, 1.08569e-03_r8, & + & 1.14922e-03_r8, 1.21648e-03_r8, 1.28767e-03_r8, 1.36303e-03_r8/) + kao_mco2( 4, :, 3) = (/ & + & 4.61143e-04_r8, 4.92198e-04_r8, 5.25343e-04_r8, 5.60720e-04_r8, 5.98480e-04_r8, & + & 6.38783e-04_r8, 6.81799e-04_r8, 7.27713e-04_r8, 7.76718e-04_r8, 8.29023e-04_r8, & + & 8.84851e-04_r8, 9.44438e-04_r8, 1.00804e-03_r8, 1.07592e-03_r8, 1.14837e-03_r8, & + & 1.22571e-03_r8, 1.30825e-03_r8, 1.39635e-03_r8, 1.49038e-03_r8/) + kao_mco2( 5, :, 3) = (/ & + & 4.01988e-04_r8, 4.36672e-04_r8, 4.74349e-04_r8, 5.15278e-04_r8, 5.59737e-04_r8, & + & 6.08032e-04_r8, 6.60495e-04_r8, 7.17484e-04_r8, 7.79390e-04_r8, 8.46638e-04_r8, & + & 9.19688e-04_r8, 9.99041e-04_r8, 1.08524e-03_r8, 1.17888e-03_r8, 1.28059e-03_r8, & + & 1.39109e-03_r8, 1.51111e-03_r8, 1.64149e-03_r8, 1.78313e-03_r8/) + kao_mco2( 6, :, 3) = (/ & + & 3.35536e-04_r8, 3.74371e-04_r8, 4.17700e-04_r8, 4.66045e-04_r8, 5.19985e-04_r8, & + & 5.80169e-04_r8, 6.47318e-04_r8, 7.22238e-04_r8, 8.05831e-04_r8, 8.99098e-04_r8, & + & 1.00316e-03_r8, 1.11927e-03_r8, 1.24881e-03_r8, 1.39335e-03_r8, 1.55461e-03_r8, & + & 1.73455e-03_r8, 1.93530e-03_r8, 2.15930e-03_r8, 2.40921e-03_r8/) + kao_mco2( 7, :, 3) = (/ & + & 3.24677e-04_r8, 3.75160e-04_r8, 4.33491e-04_r8, 5.00893e-04_r8, 5.78774e-04_r8, & + & 6.68765e-04_r8, 7.72749e-04_r8, 8.92900e-04_r8, 1.03173e-03_r8, 1.19215e-03_r8, & + & 1.37751e-03_r8, 1.59170e-03_r8, 1.83918e-03_r8, 2.12515e-03_r8, 2.45558e-03_r8, & + & 2.83738e-03_r8, 3.27856e-03_r8, 3.78832e-03_r8, 4.37735e-03_r8/) + kao_mco2( 8, :, 3) = (/ & + & 2.24656e-03_r8, 2.45550e-03_r8, 2.68386e-03_r8, 2.93347e-03_r8, 3.20629e-03_r8, & + & 3.50448e-03_r8, 3.83041e-03_r8, 4.18665e-03_r8, 4.57602e-03_r8, 5.00160e-03_r8, & + & 5.46677e-03_r8, 5.97519e-03_r8, 6.53090e-03_r8, 7.13829e-03_r8, 7.80217e-03_r8, & + & 8.52780e-03_r8, 9.32091e-03_r8, 1.01878e-02_r8, 1.11353e-02_r8/) + kao_mco2( 9, :, 3) = (/ & + & 2.07746e-04_r8, 2.38909e-04_r8, 2.74746e-04_r8, 3.15959e-04_r8, 3.63355e-04_r8, & + & 4.17860e-04_r8, 4.80541e-04_r8, 5.52625e-04_r8, 6.35521e-04_r8, 7.30852e-04_r8, & + & 8.40484e-04_r8, 9.66561e-04_r8, 1.11155e-03_r8, 1.27829e-03_r8, 1.47004e-03_r8, & + & 1.69055e-03_r8, 1.94414e-03_r8, 2.23577e-03_r8, 2.57115e-03_r8/) + kao_mco2( 1, :, 4) = (/ & + & 7.26052e-04_r8, 7.62476e-04_r8, 8.00726e-04_r8, 8.40896e-04_r8, 8.83081e-04_r8, & + & 9.27382e-04_r8, 9.73905e-04_r8, 1.02276e-03_r8, 1.07407e-03_r8, 1.12795e-03_r8, & + & 1.18454e-03_r8, 1.24396e-03_r8, 1.30637e-03_r8, 1.37190e-03_r8, 1.44073e-03_r8, & + & 1.51300e-03_r8, 1.58890e-03_r8, 1.66861e-03_r8, 1.75232e-03_r8/) + kao_mco2( 2, :, 4) = (/ & + & 4.65815e-04_r8, 5.01167e-04_r8, 5.39203e-04_r8, 5.80126e-04_r8, 6.24154e-04_r8, & + & 6.71524e-04_r8, 7.22489e-04_r8, 7.77322e-04_r8, 8.36316e-04_r8, 8.99788e-04_r8, & + & 9.68077e-04_r8, 1.04155e-03_r8, 1.12060e-03_r8, 1.20564e-03_r8, 1.29714e-03_r8, & + & 1.39559e-03_r8, 1.50151e-03_r8, 1.61546e-03_r8, 1.73807e-03_r8/) + kao_mco2( 3, :, 4) = (/ & + & 3.56225e-04_r8, 3.93073e-04_r8, 4.33732e-04_r8, 4.78598e-04_r8, 5.28105e-04_r8, & + & 5.82732e-04_r8, 6.43010e-04_r8, 7.09524e-04_r8, 7.82918e-04_r8, 8.63903e-04_r8, & + & 9.53266e-04_r8, 1.05187e-03_r8, 1.16068e-03_r8, 1.28074e-03_r8, 1.41322e-03_r8, & + & 1.55941e-03_r8, 1.72071e-03_r8, 1.89870e-03_r8, 2.09511e-03_r8/) + kao_mco2( 4, :, 4) = (/ & + & 3.37845e-04_r8, 3.79675e-04_r8, 4.26684e-04_r8, 4.79514e-04_r8, 5.38884e-04_r8, & + & 6.05606e-04_r8, 6.80589e-04_r8, 7.64855e-04_r8, 8.59555e-04_r8, 9.65980e-04_r8, & + & 1.08558e-03_r8, 1.21999e-03_r8, 1.37105e-03_r8, 1.54080e-03_r8, 1.73157e-03_r8, & + & 1.94597e-03_r8, 2.18691e-03_r8, 2.45767e-03_r8, 2.76197e-03_r8/) + kao_mco2( 5, :, 4) = (/ & + & 3.52456e-04_r8, 4.02782e-04_r8, 4.60294e-04_r8, 5.26017e-04_r8, 6.01126e-04_r8, & + & 6.86958e-04_r8, 7.85046e-04_r8, 8.97140e-04_r8, 1.02524e-03_r8, 1.17163e-03_r8, & + & 1.33892e-03_r8, 1.53010e-03_r8, 1.74858e-03_r8, 1.99825e-03_r8, 2.28358e-03_r8, & + & 2.60964e-03_r8, 2.98226e-03_r8, 3.40809e-03_r8, 3.89471e-03_r8/) + kao_mco2( 6, :, 4) = (/ & + & 4.42884e-04_r8, 5.08187e-04_r8, 5.83119e-04_r8, 6.69100e-04_r8, 7.67758e-04_r8, & + & 8.80963e-04_r8, 1.01086e-03_r8, 1.15991e-03_r8, 1.33094e-03_r8, 1.52718e-03_r8, & + & 1.75237e-03_r8, 2.01075e-03_r8, 2.30724e-03_r8, 2.64744e-03_r8, 3.03780e-03_r8, & + & 3.48572e-03_r8, 3.99969e-03_r8, 4.58944e-03_r8, 5.26614e-03_r8/) + kao_mco2( 7, :, 4) = (/ & + & 8.09850e-04_r8, 9.09940e-04_r8, 1.02240e-03_r8, 1.14876e-03_r8, 1.29074e-03_r8, & + & 1.45026e-03_r8, 1.62950e-03_r8, 1.83089e-03_r8, 2.05718e-03_r8, 2.31143e-03_r8, & + & 2.59710e-03_r8, 2.91808e-03_r8, 3.27873e-03_r8, 3.68395e-03_r8, 4.13926e-03_r8, & + & 4.65083e-03_r8, 5.22564e-03_r8, 5.87148e-03_r8, 6.59715e-03_r8/) + kao_mco2( 8, :, 4) = (/ & + & 3.13265e-03_r8, 3.42454e-03_r8, 3.74362e-03_r8, 4.09243e-03_r8, 4.47375e-03_r8, & + & 4.89059e-03_r8, 5.34627e-03_r8, 5.84441e-03_r8, 6.38897e-03_r8, 6.98426e-03_r8, & + & 7.63502e-03_r8, 8.34642e-03_r8, 9.12409e-03_r8, 9.97423e-03_r8, 1.09036e-02_r8, & + & 1.19195e-02_r8, 1.30301e-02_r8, 1.42442e-02_r8, 1.55714e-02_r8/) + kao_mco2( 9, :, 4) = (/ & + & 5.71287e-04_r8, 6.51252e-04_r8, 7.42411e-04_r8, 8.46330e-04_r8, 9.64794e-04_r8, & + & 1.09984e-03_r8, 1.25379e-03_r8, 1.42929e-03_r8, 1.62935e-03_r8, 1.85742e-03_r8, & + & 2.11741e-03_r8, 2.41380e-03_r8, 2.75167e-03_r8, 3.13683e-03_r8, 3.57591e-03_r8, & + & 4.07645e-03_r8, 4.64705e-03_r8, 5.29751e-03_r8, 6.03903e-03_r8/) + kao_mco2( 1, :, 5) = (/ & + & 2.92395e-04_r8, 3.32719e-04_r8, 3.78604e-04_r8, 4.30818e-04_r8, 4.90232e-04_r8, & + & 5.57839e-04_r8, 6.34771e-04_r8, 7.22312e-04_r8, 8.21927e-04_r8, 9.35278e-04_r8, & + & 1.06426e-03_r8, 1.21104e-03_r8, 1.37805e-03_r8, 1.56810e-03_r8, 1.78435e-03_r8, & + & 2.03043e-03_r8, 2.31045e-03_r8, 2.62908e-03_r8, 2.99166e-03_r8/) + kao_mco2( 2, :, 5) = (/ & + & 3.13069e-04_r8, 3.61343e-04_r8, 4.17061e-04_r8, 4.81371e-04_r8, 5.55597e-04_r8, & + & 6.41269e-04_r8, 7.40151e-04_r8, 8.54280e-04_r8, 9.86008e-04_r8, 1.13805e-03_r8, & + & 1.31353e-03_r8, 1.51608e-03_r8, 1.74985e-03_r8, 2.01967e-03_r8, 2.33110e-03_r8, & + & 2.69055e-03_r8, 3.10543e-03_r8, 3.58427e-03_r8, 4.13696e-03_r8/) + kao_mco2( 3, :, 5) = (/ & + & 3.06937e-04_r8, 3.57841e-04_r8, 4.17187e-04_r8, 4.86375e-04_r8, 5.67038e-04_r8, & + & 6.61078e-04_r8, 7.70714e-04_r8, 8.98532e-04_r8, 1.04755e-03_r8, 1.22128e-03_r8, & + & 1.42382e-03_r8, 1.65996e-03_r8, 1.93525e-03_r8, 2.25620e-03_r8, 2.63038e-03_r8, & + & 3.06661e-03_r8, 3.57519e-03_r8, 4.16812e-03_r8, 4.85937e-03_r8/) + kao_mco2( 4, :, 5) = (/ & + & 4.06428e-04_r8, 4.72379e-04_r8, 5.49033e-04_r8, 6.38125e-04_r8, 7.41674e-04_r8, & + & 8.62026e-04_r8, 1.00191e-03_r8, 1.16449e-03_r8, 1.35345e-03_r8, 1.57308e-03_r8, & + & 1.82834e-03_r8, 2.12503e-03_r8, 2.46986e-03_r8, 2.87064e-03_r8, 3.33647e-03_r8, & + & 3.87788e-03_r8, 4.50715e-03_r8, 5.23852e-03_r8, 6.08858e-03_r8/) + kao_mco2( 5, :, 5) = (/ & + & 6.01967e-04_r8, 6.90414e-04_r8, 7.91856e-04_r8, 9.08204e-04_r8, 1.04165e-03_r8, & + & 1.19470e-03_r8, 1.37023e-03_r8, 1.57156e-03_r8, 1.80247e-03_r8, 2.06731e-03_r8, & + & 2.37106e-03_r8, 2.71944e-03_r8, 3.11901e-03_r8, 3.57729e-03_r8, 4.10290e-03_r8, & + & 4.70574e-03_r8, 5.39716e-03_r8, 6.19017e-03_r8, 7.09969e-03_r8/) + kao_mco2( 6, :, 5) = (/ & + & 1.11622e-03_r8, 1.25799e-03_r8, 1.41776e-03_r8, 1.59783e-03_r8, 1.80077e-03_r8, & + & 2.02947e-03_r8, 2.28723e-03_r8, 2.57773e-03_r8, 2.90512e-03_r8, 3.27408e-03_r8, & + & 3.68992e-03_r8, 4.15856e-03_r8, 4.68673e-03_r8, 5.28197e-03_r8, 5.95282e-03_r8, & + & 6.70887e-03_r8, 7.56094e-03_r8, 8.52123e-03_r8, 9.60348e-03_r8/) + kao_mco2( 7, :, 5) = (/ & + & 3.63860e-03_r8, 3.96164e-03_r8, 4.31337e-03_r8, 4.69632e-03_r8, 5.11327e-03_r8, & + & 5.56724e-03_r8, 6.06151e-03_r8, 6.59967e-03_r8, 7.18561e-03_r8, 7.82356e-03_r8, & + & 8.51816e-03_r8, 9.27443e-03_r8, 1.00978e-02_r8, 1.09943e-02_r8, 1.19705e-02_r8, & + & 1.30332e-02_r8, 1.41904e-02_r8, 1.54502e-02_r8, 1.68219e-02_r8/) + kao_mco2( 8, :, 5) = (/ & + & 5.96957e-03_r8, 6.53049e-03_r8, 7.14412e-03_r8, 7.81541e-03_r8, 8.54977e-03_r8, & + & 9.35314e-03_r8, 1.02320e-02_r8, 1.11934e-02_r8, 1.22452e-02_r8, 1.33958e-02_r8, & + & 1.46545e-02_r8, 1.60315e-02_r8, 1.75379e-02_r8, 1.91858e-02_r8, 2.09886e-02_r8, & + & 2.29608e-02_r8, 2.51182e-02_r8, 2.74784e-02_r8, 3.00604e-02_r8/) + kao_mco2( 9, :, 5) = (/ & + & 1.19381e-03_r8, 1.33882e-03_r8, 1.50143e-03_r8, 1.68379e-03_r8, 1.88831e-03_r8, & + & 2.11767e-03_r8, 2.37488e-03_r8, 2.66333e-03_r8, 2.98683e-03_r8, 3.34961e-03_r8, & + & 3.75646e-03_r8, 4.21272e-03_r8, 4.72440e-03_r8, 5.29823e-03_r8, 5.94176e-03_r8, & + & 6.66345e-03_r8, 7.47280e-03_r8, 8.38045e-03_r8, 9.39835e-03_r8/) + kao_mco2( 1, :, 6) = (/ & + & 4.12429e-04_r8, 4.84830e-04_r8, 5.69942e-04_r8, 6.69995e-04_r8, 7.87613e-04_r8, & + & 9.25878e-04_r8, 1.08842e-03_r8, 1.27949e-03_r8, 1.50410e-03_r8, 1.76814e-03_r8, & + & 2.07854e-03_r8, 2.44343e-03_r8, 2.87237e-03_r8, 3.37662e-03_r8, 3.96938e-03_r8, & + & 4.66621e-03_r8, 5.48536e-03_r8, 6.44831e-03_r8, 7.58031e-03_r8/) + kao_mco2( 2, :, 6) = (/ & + & 6.43498e-04_r8, 7.46132e-04_r8, 8.65134e-04_r8, 1.00312e-03_r8, 1.16311e-03_r8, & + & 1.34861e-03_r8, 1.56371e-03_r8, 1.81310e-03_r8, 2.10228e-03_r8, 2.43758e-03_r8, & + & 2.82635e-03_r8, 3.27714e-03_r8, 3.79981e-03_r8, 4.40586e-03_r8, 5.10855e-03_r8, & + & 5.92333e-03_r8, 6.86806e-03_r8, 7.96346e-03_r8, 9.23357e-03_r8/) + kao_mco2( 3, :, 6) = (/ & + & 1.11336e-03_r8, 1.26910e-03_r8, 1.44662e-03_r8, 1.64897e-03_r8, 1.87962e-03_r8, & + & 2.14254e-03_r8, 2.44224e-03_r8, 2.78385e-03_r8, 3.17325e-03_r8, 3.61712e-03_r8, & + & 4.12308e-03_r8, 4.69981e-03_r8, 5.35720e-03_r8, 6.10656e-03_r8, 6.96073e-03_r8, & + & 7.93439e-03_r8, 9.04424e-03_r8, 1.03093e-02_r8, 1.17514e-02_r8/) + kao_mco2( 4, :, 6) = (/ & + & 1.87991e-03_r8, 2.10276e-03_r8, 2.35202e-03_r8, 2.63082e-03_r8, 2.94268e-03_r8, & + & 3.29150e-03_r8, 3.68168e-03_r8, 4.11810e-03_r8, 4.60626e-03_r8, 5.15228e-03_r8, & + & 5.76303e-03_r8, 6.44617e-03_r8, 7.21030e-03_r8, 8.06500e-03_r8, 9.02102e-03_r8, & + & 1.00904e-02_r8, 1.12865e-02_r8, 1.26244e-02_r8, 1.41208e-02_r8/) + kao_mco2( 5, :, 6) = (/ & + & 3.65848e-03_r8, 4.01372e-03_r8, 4.40346e-03_r8, 4.83104e-03_r8, 5.30015e-03_r8, & + & 5.81480e-03_r8, 6.37943e-03_r8, 6.99888e-03_r8, 7.67849e-03_r8, 8.42408e-03_r8, & + & 9.24208e-03_r8, 1.01395e-02_r8, 1.11241e-02_r8, 1.22042e-02_r8, 1.33893e-02_r8, & + & 1.46894e-02_r8, 1.61158e-02_r8, 1.76806e-02_r8, 1.93975e-02_r8/) + kao_mco2( 6, :, 6) = (/ & + & 5.38476e-03_r8, 5.85088e-03_r8, 6.35735e-03_r8, 6.90765e-03_r8, 7.50560e-03_r8, & + & 8.15530e-03_r8, 8.86124e-03_r8, 9.62829e-03_r8, 1.04617e-02_r8, 1.13673e-02_r8, & + & 1.23513e-02_r8, 1.34205e-02_r8, 1.45822e-02_r8, 1.58445e-02_r8, 1.72160e-02_r8, & + & 1.87062e-02_r8, 2.03255e-02_r8, 2.20849e-02_r8, 2.39966e-02_r8/) + kao_mco2( 7, :, 6) = (/ & + & 6.27017e-03_r8, 6.84772e-03_r8, 7.47846e-03_r8, 8.16731e-03_r8, 8.91960e-03_r8, & + & 9.74118e-03_r8, 1.06384e-02_r8, 1.16183e-02_r8, 1.26885e-02_r8, 1.38573e-02_r8, & + & 1.51336e-02_r8, 1.65276e-02_r8, 1.80500e-02_r8, 1.97125e-02_r8, 2.15283e-02_r8, & + & 2.35112e-02_r8, 2.56769e-02_r8, 2.80420e-02_r8, 3.06249e-02_r8/) + kao_mco2( 8, :, 6) = (/ & + & 9.61932e-03_r8, 1.04802e-02_r8, 1.14182e-02_r8, 1.24401e-02_r8, 1.35534e-02_r8, & + & 1.47664e-02_r8, 1.60880e-02_r8, 1.75278e-02_r8, 1.90965e-02_r8, 2.08056e-02_r8, & + & 2.26677e-02_r8, 2.46964e-02_r8, 2.69066e-02_r8, 2.93147e-02_r8, 3.19383e-02_r8, & + & 3.47967e-02_r8, 3.79110e-02_r8, 4.13039e-02_r8, 4.50005e-02_r8/) + kao_mco2( 9, :, 6) = (/ & + & 2.37921e-03_r8, 2.64556e-03_r8, 2.94173e-03_r8, 3.27105e-03_r8, 3.63724e-03_r8, & + & 4.04442e-03_r8, 4.49718e-03_r8, 5.00064e-03_r8, 5.56045e-03_r8, 6.18293e-03_r8, & + & 6.87510e-03_r8, 7.64475e-03_r8, 8.50057e-03_r8, 9.45219e-03_r8, 1.05103e-02_r8, & + & 1.16870e-02_r8, 1.29953e-02_r8, 1.44501e-02_r8, 1.60677e-02_r8/) + kao_mco2( 1, :, 7) = (/ & + & 4.64970e-03_r8, 5.13188e-03_r8, 5.66406e-03_r8, 6.25144e-03_r8, 6.89972e-03_r8, & + & 7.61523e-03_r8, 8.40493e-03_r8, 9.27654e-03_r8, 1.02385e-02_r8, 1.13003e-02_r8, & + & 1.24721e-02_r8, 1.37655e-02_r8, 1.51930e-02_r8, 1.67685e-02_r8, 1.85075e-02_r8, & + & 2.04267e-02_r8, 2.25450e-02_r8, 2.48829e-02_r8, 2.74633e-02_r8/) + kao_mco2( 2, :, 7) = (/ & + & 6.37148e-03_r8, 6.96805e-03_r8, 7.62046e-03_r8, 8.33397e-03_r8, 9.11428e-03_r8, & + & 9.96765e-03_r8, 1.09009e-02_r8, 1.19216e-02_r8, 1.30378e-02_r8, 1.42585e-02_r8, & + & 1.55935e-02_r8, 1.70536e-02_r8, 1.86503e-02_r8, 2.03965e-02_r8, 2.23062e-02_r8, & + & 2.43948e-02_r8, 2.66789e-02_r8, 2.91768e-02_r8, 3.19086e-02_r8/) + kao_mco2( 3, :, 7) = (/ & + & 7.79364e-03_r8, 8.48097e-03_r8, 9.22892e-03_r8, 1.00428e-02_r8, 1.09285e-02_r8, & + & 1.18923e-02_r8, 1.29411e-02_r8, 1.40825e-02_r8, 1.53244e-02_r8, 1.66759e-02_r8, & + & 1.81466e-02_r8, 1.97470e-02_r8, 2.14885e-02_r8, 2.33836e-02_r8, 2.54458e-02_r8, & + & 2.76899e-02_r8, 3.01320e-02_r8, 3.27893e-02_r8, 3.56811e-02_r8/) + kao_mco2( 4, :, 7) = (/ & + & 8.70586e-03_r8, 9.48737e-03_r8, 1.03390e-02_r8, 1.12672e-02_r8, 1.22786e-02_r8, & + & 1.33808e-02_r8, 1.45820e-02_r8, 1.58910e-02_r8, 1.73175e-02_r8, 1.88721e-02_r8, & + & 2.05662e-02_r8, 2.24124e-02_r8, 2.44243e-02_r8, 2.66169e-02_r8, 2.90062e-02_r8, & + & 3.16101e-02_r8, 3.44477e-02_r8, 3.75400e-02_r8, 4.09099e-02_r8/) + kao_mco2( 5, :, 7) = (/ & + & 9.24510e-03_r8, 1.00865e-02_r8, 1.10045e-02_r8, 1.20061e-02_r8, 1.30988e-02_r8, & + & 1.42910e-02_r8, 1.55916e-02_r8, 1.70106e-02_r8, 1.85588e-02_r8, 2.02479e-02_r8, & + & 2.20908e-02_r8, 2.41013e-02_r8, 2.62948e-02_r8, 2.86880e-02_r8, 3.12990e-02_r8, & + & 3.41476e-02_r8, 3.72555e-02_r8, 4.06462e-02_r8, 4.43455e-02_r8/) + kao_mco2( 6, :, 7) = (/ & + & 1.09559e-02_r8, 1.19933e-02_r8, 1.31290e-02_r8, 1.43722e-02_r8, 1.57331e-02_r8, & + & 1.72229e-02_r8, 1.88537e-02_r8, 2.06390e-02_r8, 2.25933e-02_r8, 2.47327e-02_r8, & + & 2.70747e-02_r8, 2.96384e-02_r8, 3.24449e-02_r8, 3.55171e-02_r8, 3.88802e-02_r8, & + & 4.25619e-02_r8, 4.65921e-02_r8, 5.10039e-02_r8, 5.58335e-02_r8/) + kao_mco2( 7, :, 7) = (/ & + & 1.36116e-02_r8, 1.48659e-02_r8, 1.62357e-02_r8, 1.77318e-02_r8, 1.93657e-02_r8, & + & 2.11502e-02_r8, 2.30991e-02_r8, 2.52276e-02_r8, 2.75522e-02_r8, 3.00910e-02_r8, & + & 3.28638e-02_r8, 3.58921e-02_r8, 3.91995e-02_r8, 4.28116e-02_r8, 4.67565e-02_r8, & + & 5.10650e-02_r8, 5.57704e-02_r8, 6.09095e-02_r8, 6.65221e-02_r8/) + kao_mco2( 8, :, 7) = (/ & + & 1.51783e-02_r8, 1.64551e-02_r8, 1.78392e-02_r8, 1.93399e-02_r8, 2.09667e-02_r8, & + & 2.27304e-02_r8, 2.46424e-02_r8, 2.67153e-02_r8, 2.89626e-02_r8, 3.13988e-02_r8, & + & 3.40401e-02_r8, 3.69035e-02_r8, 4.00077e-02_r8, 4.33731e-02_r8, 4.70216e-02_r8, & + & 5.09770e-02_r8, 5.52651e-02_r8, 5.99139e-02_r8, 6.49538e-02_r8/) + kao_mco2( 9, :, 7) = (/ & + & 1.00072e-02_r8, 1.08638e-02_r8, 1.17937e-02_r8, 1.28032e-02_r8, 1.38991e-02_r8, & + & 1.50888e-02_r8, 1.63803e-02_r8, 1.77824e-02_r8, 1.93045e-02_r8, 2.09568e-02_r8, & + & 2.27507e-02_r8, 2.46980e-02_r8, 2.68120e-02_r8, 2.91070e-02_r8, 3.15984e-02_r8, & + & 3.43031e-02_r8, 3.72393e-02_r8, 4.04268e-02_r8, 4.38872e-02_r8/) + kao_mco2( 1, :, 8) = (/ & + & 1.59610e-02_r8, 1.74387e-02_r8, 1.90532e-02_r8, 2.08171e-02_r8, 2.27444e-02_r8, & + & 2.48501e-02_r8, 2.71508e-02_r8, 2.96645e-02_r8, 3.24109e-02_r8, 3.54115e-02_r8, & + & 3.86900e-02_r8, 4.22720e-02_r8, 4.61856e-02_r8, 5.04616e-02_r8, 5.51334e-02_r8, & + & 6.02378e-02_r8, 6.58147e-02_r8, 7.19079e-02_r8, 7.85653e-02_r8/) + kao_mco2( 2, :, 8) = (/ & + & 1.61961e-02_r8, 1.76986e-02_r8, 1.93405e-02_r8, 2.11348e-02_r8, 2.30955e-02_r8, & + & 2.52381e-02_r8, 2.75794e-02_r8, 3.01380e-02_r8, 3.29340e-02_r8, 3.59893e-02_r8, & + & 3.93280e-02_r8, 4.29766e-02_r8, 4.69636e-02_r8, 5.13204e-02_r8, 5.60815e-02_r8, & + & 6.12843e-02_r8, 6.69697e-02_r8, 7.31826e-02_r8, 7.99718e-02_r8/) + kao_mco2( 3, :, 8) = (/ & + & 1.72034e-02_r8, 1.88241e-02_r8, 2.05974e-02_r8, 2.25377e-02_r8, 2.46609e-02_r8, & + & 2.69841e-02_r8, 2.95261e-02_r8, 3.23076e-02_r8, 3.53511e-02_r8, 3.86813e-02_r8, & + & 4.23253e-02_r8, 4.63126e-02_r8, 5.06754e-02_r8, 5.54493e-02_r8, 6.06728e-02_r8, & + & 6.63885e-02_r8, 7.26426e-02_r8, 7.94859e-02_r8, 8.69738e-02_r8/) + kao_mco2( 4, :, 8) = (/ & + & 1.79777e-02_r8, 1.96517e-02_r8, 2.14815e-02_r8, 2.34817e-02_r8, 2.56682e-02_r8, & + & 2.80583e-02_r8, 3.06709e-02_r8, 3.35268e-02_r8, 3.66486e-02_r8, 4.00611e-02_r8, & + & 4.37914e-02_r8, 4.78690e-02_r8, 5.23262e-02_r8, 5.71985e-02_r8, 6.25245e-02_r8, & + & 6.83464e-02_r8, 7.47104e-02_r8, 8.16670e-02_r8, 8.92713e-02_r8/) + kao_mco2( 5, :, 8) = (/ & + & 2.02540e-02_r8, 2.21214e-02_r8, 2.41610e-02_r8, 2.63887e-02_r8, 2.88218e-02_r8, & + & 3.14792e-02_r8, 3.43816e-02_r8, 3.75516e-02_r8, 4.10139e-02_r8, 4.47954e-02_r8, & + & 4.89256e-02_r8, 5.34366e-02_r8, 5.83635e-02_r8, 6.37447e-02_r8, 6.96220e-02_r8, & + & 7.60413e-02_r8, 8.30523e-02_r8, 9.07098e-02_r8, 9.90734e-02_r8/) + kao_mco2( 6, :, 8) = (/ & + & 2.19009e-02_r8, 2.38517e-02_r8, 2.59762e-02_r8, 2.82899e-02_r8, 3.08097e-02_r8, & + & 3.35540e-02_r8, 3.65427e-02_r8, 3.97976e-02_r8, 4.33424e-02_r8, 4.72030e-02_r8, & + & 5.14074e-02_r8, 5.59863e-02_r8, 6.09731e-02_r8, 6.64040e-02_r8, 7.23187e-02_r8, & + & 7.87603e-02_r8, 8.57755e-02_r8, 9.34157e-02_r8, 1.01736e-01_r8/) + kao_mco2( 7, :, 8) = (/ & + & 2.52383e-02_r8, 2.73978e-02_r8, 2.97421e-02_r8, 3.22869e-02_r8, 3.50496e-02_r8, & + & 3.80486e-02_r8, 4.13042e-02_r8, 4.48383e-02_r8, 4.86749e-02_r8, 5.28397e-02_r8, & + & 5.73610e-02_r8, 6.22690e-02_r8, 6.75970e-02_r8, 7.33810e-02_r8, 7.96598e-02_r8, & + & 8.64758e-02_r8, 9.38751e-02_r8, 1.01907e-01_r8, 1.10627e-01_r8/) + kao_mco2( 8, :, 8) = (/ & + & 3.36506e-02_r8, 3.59288e-02_r8, 3.83613e-02_r8, 4.09584e-02_r8, 4.37313e-02_r8, & + & 4.66920e-02_r8, 4.98531e-02_r8, 5.32283e-02_r8, 5.68319e-02_r8, 6.06795e-02_r8, & + & 6.47876e-02_r8, 6.91739e-02_r8, 7.38570e-02_r8, 7.88573e-02_r8, 8.41960e-02_r8, & + & 8.98962e-02_r8, 9.59824e-02_r8, 1.02481e-01_r8, 1.09419e-01_r8/) + kao_mco2( 9, :, 8) = (/ & + & 2.15151e-02_r8, 2.34420e-02_r8, 2.55415e-02_r8, 2.78291e-02_r8, 3.03215e-02_r8, & + & 3.30372e-02_r8, 3.59961e-02_r8, 3.92200e-02_r8, 4.27326e-02_r8, 4.65598e-02_r8, & + & 5.07299e-02_r8, 5.52734e-02_r8, 6.02238e-02_r8, 6.56176e-02_r8, 7.14944e-02_r8, & + & 7.78977e-02_r8, 8.48744e-02_r8, 9.24759e-02_r8, 1.00758e-01_r8/) + kao_mco2( 1, :, 9) = (/ & + & 3.34296e-02_r8, 3.64437e-02_r8, 3.97294e-02_r8, 4.33114e-02_r8, 4.72164e-02_r8, & + & 5.14734e-02_r8, 5.61143e-02_r8, 6.11735e-02_r8, 6.66890e-02_r8, 7.27016e-02_r8, & + & 7.92564e-02_r8, 8.64022e-02_r8, 9.41922e-02_r8, 1.02685e-01_r8, 1.11943e-01_r8, & + & 1.22035e-01_r8, 1.33038e-01_r8, 1.45033e-01_r8, 1.58109e-01_r8/) + kao_mco2( 2, :, 9) = (/ & + & 3.73946e-02_r8, 4.07543e-02_r8, 4.44160e-02_r8, 4.84066e-02_r8, 5.27558e-02_r8, & + & 5.74958e-02_r8, 6.26616e-02_r8, 6.82915e-02_r8, 7.44273e-02_r8, 8.11144e-02_r8, & + & 8.84023e-02_r8, 9.63449e-02_r8, 1.05001e-01_r8, 1.14435e-01_r8, 1.24717e-01_r8, & + & 1.35922e-01_r8, 1.48135e-01_r8, 1.61444e-01_r8, 1.75949e-01_r8/) + kao_mco2( 3, :, 9) = (/ & + & 4.24539e-02_r8, 4.61192e-02_r8, 5.01010e-02_r8, 5.44265e-02_r8, 5.91255e-02_r8, & + & 6.42302e-02_r8, 6.97756e-02_r8, 7.57998e-02_r8, 8.23442e-02_r8, 8.94535e-02_r8, & + & 9.71766e-02_r8, 1.05566e-01_r8, 1.14681e-01_r8, 1.24582e-01_r8, 1.35338e-01_r8, & + & 1.47022e-01_r8, 1.59716e-01_r8, 1.73505e-01_r8, 1.88485e-01_r8/) + kao_mco2( 4, :, 9) = (/ & + & 5.30296e-02_r8, 5.73416e-02_r8, 6.20043e-02_r8, 6.70462e-02_r8, 7.24980e-02_r8, & + & 7.83931e-02_r8, 8.47676e-02_r8, 9.16604e-02_r8, 9.91137e-02_r8, 1.07173e-01_r8, & + & 1.15888e-01_r8, 1.25311e-01_r8, 1.35501e-01_r8, 1.46519e-01_r8, 1.58433e-01_r8, & + & 1.71316e-01_r8, 1.85246e-01_r8, 2.00309e-01_r8, 2.16597e-01_r8/) + kao_mco2( 5, :, 9) = (/ & + & 6.26111e-02_r8, 6.74018e-02_r8, 7.25591e-02_r8, 7.81111e-02_r8, 8.40878e-02_r8, & + & 9.05218e-02_r8, 9.74482e-02_r8, 1.04904e-01_r8, 1.12931e-01_r8, 1.21572e-01_r8, & + & 1.30875e-01_r8, 1.40889e-01_r8, 1.51669e-01_r8, 1.63274e-01_r8, 1.75767e-01_r8, & + & 1.89216e-01_r8, 2.03694e-01_r8, 2.19279e-01_r8, 2.36058e-01_r8/) + kao_mco2( 6, :, 9) = (/ & + & 7.59080e-02_r8, 8.13446e-02_r8, 8.71706e-02_r8, 9.34139e-02_r8, 1.00104e-01_r8, & + & 1.07274e-01_r8, 1.14957e-01_r8, 1.23190e-01_r8, 1.32013e-01_r8, 1.41468e-01_r8, & + & 1.51600e-01_r8, 1.62458e-01_r8, 1.74094e-01_r8, 1.86562e-01_r8, 1.99924e-01_r8, & + & 2.14243e-01_r8, 2.29587e-01_r8, 2.46031e-01_r8, 2.63652e-01_r8/) + kao_mco2( 7, :, 9) = (/ & + & 8.81942e-02_r8, 9.39942e-02_r8, 1.00176e-01_r8, 1.06763e-01_r8, 1.13784e-01_r8, & + & 1.21267e-01_r8, 1.29242e-01_r8, 1.37742e-01_r8, 1.46800e-01_r8, 1.56454e-01_r8, & + & 1.66743e-01_r8, 1.77708e-01_r8, 1.89395e-01_r8, 2.01850e-01_r8, 2.15124e-01_r8, & + & 2.29272e-01_r8, 2.44349e-01_r8, 2.60418e-01_r8, 2.77544e-01_r8/) + kao_mco2( 8, :, 9) = (/ & + & 6.28535e-02_r8, 6.69314e-02_r8, 7.12740e-02_r8, 7.58982e-02_r8, 8.08225e-02_r8, & + & 8.60662e-02_r8, 9.16502e-02_r8, 9.75965e-02_r8, 1.03929e-01_r8, 1.10671e-01_r8, & + & 1.17852e-01_r8, 1.25498e-01_r8, 1.33640e-01_r8, 1.42311e-01_r8, 1.51544e-01_r8, & + & 1.61376e-01_r8, 1.71846e-01_r8, 1.82996e-01_r8, 1.94868e-01_r8/) + kao_mco2( 9, :, 9) = (/ & + & 6.39196e-02_r8, 6.86702e-02_r8, 7.37738e-02_r8, 7.92568e-02_r8, 8.51473e-02_r8, & + & 9.14756e-02_r8, 9.82742e-02_r8, 1.05578e-01_r8, 1.13425e-01_r8, 1.21855e-01_r8, & + & 1.30911e-01_r8, 1.40641e-01_r8, 1.51093e-01_r8, 1.62323e-01_r8, 1.74387e-01_r8, & + & 1.87348e-01_r8, 2.01272e-01_r8, 2.16231e-01_r8, 2.32301e-01_r8/) + kao_mco2( 1, :,10) = (/ & + & 9.44086e-02_r8, 1.02788e-01_r8, 1.11911e-01_r8, 1.21844e-01_r8, 1.32659e-01_r8, & + & 1.44434e-01_r8, 1.57253e-01_r8, 1.71211e-01_r8, 1.86407e-01_r8, 2.02952e-01_r8, & + & 2.20966e-01_r8, 2.40578e-01_r8, 2.61932e-01_r8, 2.85180e-01_r8, 3.10492e-01_r8, & + & 3.38051e-01_r8, 3.68056e-01_r8, 4.00723e-01_r8, 4.36291e-01_r8/) + kao_mco2( 2, :,10) = (/ & + & 1.29528e-01_r8, 1.39646e-01_r8, 1.50554e-01_r8, 1.62315e-01_r8, 1.74994e-01_r8, & + & 1.88664e-01_r8, 2.03401e-01_r8, 2.19290e-01_r8, 2.36419e-01_r8, 2.54887e-01_r8, & + & 2.74798e-01_r8, 2.96263e-01_r8, 3.19406e-01_r8, 3.44356e-01_r8, 3.71255e-01_r8, & + & 4.00256e-01_r8, 4.31522e-01_r8, 4.65230e-01_r8, 5.01571e-01_r8/) + kao_mco2( 3, :,10) = (/ & + & 1.52325e-01_r8, 1.62991e-01_r8, 1.74404e-01_r8, 1.86616e-01_r8, 1.99684e-01_r8, & + & 2.13666e-01_r8, 2.28628e-01_r8, 2.44637e-01_r8, 2.61767e-01_r8, 2.80096e-01_r8, & + & 2.99710e-01_r8, 3.20696e-01_r8, 3.43152e-01_r8, 3.67181e-01_r8, 3.92892e-01_r8, & + & 4.20403e-01_r8, 4.49841e-01_r8, 4.81340e-01_r8, 5.15045e-01_r8/) + kao_mco2( 4, :,10) = (/ & + & 1.59763e-01_r8, 1.70378e-01_r8, 1.81698e-01_r8, 1.93770e-01_r8, 2.06644e-01_r8, & + & 2.20373e-01_r8, 2.35015e-01_r8, 2.50629e-01_r8, 2.67281e-01_r8, 2.85039e-01_r8, & + & 3.03977e-01_r8, 3.24174e-01_r8, 3.45712e-01_r8, 3.68681e-01_r8, 3.93176e-01_r8, & + & 4.19299e-01_r8, 4.47157e-01_r8, 4.76866e-01_r8, 5.08549e-01_r8/) + kao_mco2( 5, :,10) = (/ & + & 1.79202e-01_r8, 1.91125e-01_r8, 2.03840e-01_r8, 2.17402e-01_r8, 2.31866e-01_r8, & + & 2.47292e-01_r8, 2.63744e-01_r8, 2.81291e-01_r8, 3.00005e-01_r8, 3.19964e-01_r8, & + & 3.41251e-01_r8, 3.63955e-01_r8, 3.88169e-01_r8, 4.13994e-01_r8, 4.41537e-01_r8, & + & 4.70912e-01_r8, 5.02242e-01_r8, 5.35656e-01_r8, 5.71293e-01_r8/) + kao_mco2( 6, :,10) = (/ & + & 1.66628e-01_r8, 1.76984e-01_r8, 1.87984e-01_r8, 1.99668e-01_r8, 2.12078e-01_r8, & + & 2.25259e-01_r8, 2.39259e-01_r8, 2.54129e-01_r8, 2.69924e-01_r8, 2.86700e-01_r8, & + & 3.04519e-01_r8, 3.23446e-01_r8, 3.43549e-01_r8, 3.64901e-01_r8, 3.87580e-01_r8, & + & 4.11669e-01_r8, 4.37255e-01_r8, 4.64431e-01_r8, 4.93297e-01_r8/) + kao_mco2( 7, :,10) = (/ & + & 2.03980e-01_r8, 2.17141e-01_r8, 2.31152e-01_r8, 2.46067e-01_r8, 2.61945e-01_r8, & + & 2.78847e-01_r8, 2.96839e-01_r8, 3.15993e-01_r8, 3.36382e-01_r8, 3.58087e-01_r8, & + & 3.81193e-01_r8, 4.05789e-01_r8, 4.31972e-01_r8, 4.59845e-01_r8, 4.89517e-01_r8, & + & 5.21103e-01_r8, 5.54727e-01_r8, 5.90520e-01_r8, 6.28623e-01_r8/) + kao_mco2( 8, :,10) = (/ & + & 1.96161e-04_r8, 2.07177e-04_r8, 2.18812e-04_r8, 2.31101e-04_r8, 2.44079e-04_r8, & + & 2.57787e-04_r8, 2.72264e-04_r8, 2.87554e-04_r8, 3.03703e-04_r8, 3.20758e-04_r8, & + & 3.38772e-04_r8, 3.57797e-04_r8, 3.77891e-04_r8, 3.99113e-04_r8, 4.21527e-04_r8, & + & 4.45200e-04_r8, 4.70202e-04_r8, 4.96608e-04_r8, 5.24498e-04_r8/) + kao_mco2( 9, :,10) = (/ & + & 1.76275e-01_r8, 1.88091e-01_r8, 2.00699e-01_r8, 2.14152e-01_r8, 2.28507e-01_r8, & + & 2.43824e-01_r8, 2.60168e-01_r8, 2.77607e-01_r8, 2.96216e-01_r8, 3.16071e-01_r8, & + & 3.37258e-01_r8, 3.59865e-01_r8, 3.83987e-01_r8, 4.09726e-01_r8, 4.37190e-01_r8, & + & 4.66495e-01_r8, 4.97765e-01_r8, 5.31131e-01_r8, 5.66733e-01_r8/) + kao_mco2( 1, :,11) = (/ & + & 1.99797e-01_r8, 2.14154e-01_r8, 2.29543e-01_r8, 2.46038e-01_r8, 2.63718e-01_r8, & + & 2.82669e-01_r8, 3.02981e-01_r8, 3.24753e-01_r8, 3.48090e-01_r8, 3.73104e-01_r8, & + & 3.99915e-01_r8, 4.28652e-01_r8, 4.59455e-01_r8, 4.92471e-01_r8, 5.27859e-01_r8, & + & 5.65791e-01_r8, 6.06448e-01_r8, 6.50027e-01_r8, 6.96738e-01_r8/) + kao_mco2( 2, :,11) = (/ & + & 2.20638e-01_r8, 2.35685e-01_r8, 2.51759e-01_r8, 2.68929e-01_r8, 2.87271e-01_r8, & + & 3.06863e-01_r8, 3.27791e-01_r8, 3.50146e-01_r8, 3.74026e-01_r8, 3.99535e-01_r8, & + & 4.26784e-01_r8, 4.55891e-01_r8, 4.86983e-01_r8, 5.20195e-01_r8, 5.55673e-01_r8, & + & 5.93570e-01_r8, 6.34052e-01_r8, 6.77294e-01_r8, 7.23486e-01_r8/) + kao_mco2( 3, :,11) = (/ & + & 2.62988e-01_r8, 2.80924e-01_r8, 3.00085e-01_r8, 3.20552e-01_r8, 3.42414e-01_r8, & + & 3.65768e-01_r8, 3.90715e-01_r8, 4.17363e-01_r8, 4.45829e-01_r8, 4.76237e-01_r8, & + & 5.08718e-01_r8, 5.43414e-01_r8, 5.80477e-01_r8, 6.20068e-01_r8, 6.62359e-01_r8, & + & 7.07535e-01_r8, 7.55791e-01_r8, 8.07339e-01_r8, 8.62403e-01_r8/) + kao_mco2( 4, :,11) = (/ & + & 2.43674e-01_r8, 2.59946e-01_r8, 2.77304e-01_r8, 2.95821e-01_r8, 3.15575e-01_r8, & + & 3.36647e-01_r8, 3.59127e-01_r8, 3.83108e-01_r8, 4.08691e-01_r8, 4.35981e-01_r8, & + & 4.65094e-01_r8, 4.96152e-01_r8, 5.29282e-01_r8, 5.64626e-01_r8, 6.02329e-01_r8, & + & 6.42550e-01_r8, 6.85457e-01_r8, 7.31229e-01_r8, 7.80057e-01_r8/) + kao_mco2( 5, :,11) = (/ & + & 2.23323e-01_r8, 2.37553e-01_r8, 2.52689e-01_r8, 2.68791e-01_r8, 2.85918e-01_r8, & + & 3.04136e-01_r8, 3.23515e-01_r8, 3.44129e-01_r8, 3.66057e-01_r8, 3.89381e-01_r8, & + & 4.14192e-01_r8, 4.40584e-01_r8, 4.68657e-01_r8, 4.98520e-01_r8, 5.30285e-01_r8, & + & 5.64074e-01_r8, 6.00016e-01_r8, 6.38248e-01_r8, 6.78917e-01_r8/) + kao_mco2( 6, :,11) = (/ & + & 2.83716e-01_r8, 3.02622e-01_r8, 3.22788e-01_r8, 3.44298e-01_r8, 3.67241e-01_r8, & + & 3.91713e-01_r8, 4.17816e-01_r8, 4.45658e-01_r8, 4.75356e-01_r8, 5.07033e-01_r8, & + & 5.40820e-01_r8, 5.76859e-01_r8, 6.15300e-01_r8, 6.56302e-01_r8, 7.00037e-01_r8, & + & 7.46686e-01_r8, 7.96443e-01_r8, 8.49516e-01_r8, 9.06126e-01_r8/) + kao_mco2( 7, :,11) = (/ & + & 1.00497e-03_r8, 1.06500e-03_r8, 1.12863e-03_r8, 1.19606e-03_r8, 1.26751e-03_r8, & + & 1.34323e-03_r8, 1.42348e-03_r8, 1.50852e-03_r8, 1.59864e-03_r8, 1.69414e-03_r8, & + & 1.79535e-03_r8, 1.90261e-03_r8, 2.01628e-03_r8, 2.13673e-03_r8, 2.26438e-03_r8, & + & 2.39966e-03_r8, 2.54302e-03_r8, 2.69494e-03_r8, 2.85594e-03_r8/) + kao_mco2( 8, :,11) = (/ & + & 3.22623e-04_r8, 3.39937e-04_r8, 3.58181e-04_r8, 3.77404e-04_r8, 3.97658e-04_r8, & + & 4.19000e-04_r8, 4.41487e-04_r8, 4.65180e-04_r8, 4.90146e-04_r8, 5.16451e-04_r8, & + & 5.44167e-04_r8, 5.73372e-04_r8, 6.04143e-04_r8, 6.36567e-04_r8, 6.70730e-04_r8, & + & 7.06726e-04_r8, 7.44655e-04_r8, 7.84619e-04_r8, 8.26727e-04_r8/) + kao_mco2( 9, :,11) = (/ & + & 2.23872e-01_r8, 2.38360e-01_r8, 2.53786e-01_r8, 2.70210e-01_r8, 2.87697e-01_r8, & + & 3.06316e-01_r8, 3.26140e-01_r8, 3.47247e-01_r8, 3.69720e-01_r8, 3.93647e-01_r8, & + & 4.19122e-01_r8, 4.46246e-01_r8, 4.75126e-01_r8, 5.05874e-01_r8, 5.38613e-01_r8, & + & 5.73470e-01_r8, 6.10583e-01_r8, 6.50098e-01_r8, 6.92170e-01_r8/) + kao_mco2( 1, :,12) = (/ & + & 3.52418e-01_r8, 3.76085e-01_r8, 4.01341e-01_r8, 4.28293e-01_r8, 4.57055e-01_r8, & + & 4.87749e-01_r8, 5.20504e-01_r8, 5.55458e-01_r8, 5.92760e-01_r8, 6.32567e-01_r8, & + & 6.75047e-01_r8, 7.20380e-01_r8, 7.68757e-01_r8, 8.20383e-01_r8, 8.75476e-01_r8, & + & 9.34268e-01_r8, 9.97009e-01_r8, 1.06396e+00_r8, 1.13541e+00_r8/) + kao_mco2( 2, :,12) = (/ & + & 3.38812e-01_r8, 3.61001e-01_r8, 3.84645e-01_r8, 4.09836e-01_r8, 4.36678e-01_r8, & + & 4.65278e-01_r8, 4.95750e-01_r8, 5.28219e-01_r8, 5.62814e-01_r8, 5.99674e-01_r8, & + & 6.38949e-01_r8, 6.80796e-01_r8, 7.25384e-01_r8, 7.72892e-01_r8, 8.23511e-01_r8, & + & 8.77446e-01_r8, 9.34913e-01_r8, 9.96144e-01_r8, 1.06138e+00_r8/) + kao_mco2( 3, :,12) = (/ & + & 3.44644e-01_r8, 3.66671e-01_r8, 3.90105e-01_r8, 4.15038e-01_r8, 4.41564e-01_r8, & + & 4.69785e-01_r8, 4.99810e-01_r8, 5.31754e-01_r8, 5.65740e-01_r8, 6.01897e-01_r8, & + & 6.40366e-01_r8, 6.81293e-01_r8, 7.24836e-01_r8, 7.71162e-01_r8, 8.20448e-01_r8, & + & 8.72885e-01_r8, 9.28673e-01_r8, 9.88027e-01_r8, 1.05117e+00_r8/) + kao_mco2( 4, :,12) = (/ & + & 4.20358e-01_r8, 4.47809e-01_r8, 4.77053e-01_r8, 5.08207e-01_r8, 5.41395e-01_r8, & + & 5.76750e-01_r8, 6.14414e-01_r8, 6.54538e-01_r8, 6.97282e-01_r8, 7.42818e-01_r8, & + & 7.91327e-01_r8, 8.43004e-01_r8, 8.98056e-01_r8, 9.56703e-01_r8, 1.01918e+00_r8, & + & 1.08574e+00_r8, 1.15664e+00_r8, 1.23217e+00_r8, 1.31264e+00_r8/) + kao_mco2( 5, :,12) = (/ & + & 4.42756e-01_r8, 4.72000e-01_r8, 5.03174e-01_r8, 5.36408e-01_r8, 5.71837e-01_r8, & + & 6.09606e-01_r8, 6.49870e-01_r8, 6.92793e-01_r8, 7.38551e-01_r8, 7.87331e-01_r8, & + & 8.39333e-01_r8, 8.94770e-01_r8, 9.53868e-01_r8, 1.01687e+00_r8, 1.08403e+00_r8, & + & 1.15563e+00_r8, 1.23196e+00_r8, 1.31333e+00_r8, 1.40007e+00_r8/) + kao_mco2( 6, :,12) = (/ & + & 1.53662e-01_r8, 1.63104e-01_r8, 1.73126e-01_r8, 1.83764e-01_r8, 1.95055e-01_r8, & + & 2.07040e-01_r8, 2.19762e-01_r8, 2.33265e-01_r8, 2.47598e-01_r8, 2.62811e-01_r8, & + & 2.78960e-01_r8, 2.96100e-01_r8, 3.14294e-01_r8, 3.33606e-01_r8, 3.54104e-01_r8, & + & 3.75862e-01_r8, 3.98956e-01_r8, 4.23470e-01_r8, 4.49490e-01_r8/) + kao_mco2( 7, :,12) = (/ & + & 5.41472e-04_r8, 5.65116e-04_r8, 5.89793e-04_r8, 6.15547e-04_r8, 6.42426e-04_r8, & + & 6.70479e-04_r8, 6.99757e-04_r8, 7.30313e-04_r8, 7.62203e-04_r8, 7.95486e-04_r8, & + & 8.30223e-04_r8, 8.66476e-04_r8, 9.04312e-04_r8, 9.43801e-04_r8, 9.85013e-04_r8, & + & 1.02803e-03_r8, 1.07292e-03_r8, 1.11977e-03_r8, 1.16866e-03_r8/) + kao_mco2( 8, :,12) = (/ & + & 5.94251e-04_r8, 6.17650e-04_r8, 6.41969e-04_r8, 6.67246e-04_r8, 6.93518e-04_r8, & + & 7.20824e-04_r8, 7.49206e-04_r8, 7.78705e-04_r8, 8.09366e-04_r8, 8.41234e-04_r8, & + & 8.74356e-04_r8, 9.08783e-04_r8, 9.44566e-04_r8, 9.81757e-04_r8, 1.02041e-03_r8, & + & 1.06059e-03_r8, 1.10235e-03_r8, 1.14575e-03_r8, 1.19087e-03_r8/) + kao_mco2( 9, :,12) = (/ & + & 4.21683e-01_r8, 4.49025e-01_r8, 4.78140e-01_r8, 5.09142e-01_r8, 5.42155e-01_r8, & + & 5.77309e-01_r8, 6.14741e-01_r8, 6.54601e-01_r8, 6.97046e-01_r8, 7.42242e-01_r8, & + & 7.90369e-01_r8, 8.41617e-01_r8, 8.96188e-01_r8, 9.54297e-01_r8, 1.01617e+00_r8, & + & 1.08206e+00_r8, 1.15222e+00_r8, 1.22693e+00_r8, 1.30649e+00_r8/) + kao_mco2( 1, :,13) = (/ & + & 5.61805e-01_r8, 5.98988e-01_r8, 6.38631e-01_r8, 6.80898e-01_r8, 7.25962e-01_r8, & + & 7.74009e-01_r8, 8.25236e-01_r8, 8.79853e-01_r8, 9.38085e-01_r8, 1.00017e+00_r8, & + & 1.06637e+00_r8, 1.13694e+00_r8, 1.21219e+00_r8, 1.29242e+00_r8, 1.37795e+00_r8, & + & 1.46915e+00_r8, 1.56638e+00_r8, 1.67005e+00_r8, 1.78058e+00_r8/) + kao_mco2( 2, :,13) = (/ & + & 5.55938e-01_r8, 5.91800e-01_r8, 6.29976e-01_r8, 6.70615e-01_r8, 7.13876e-01_r8, & + & 7.59927e-01_r8, 8.08949e-01_r8, 8.61133e-01_r8, 9.16683e-01_r8, 9.75817e-01_r8, & + & 1.03877e+00_r8, 1.10577e+00_r8, 1.17711e+00_r8, 1.25304e+00_r8, 1.33387e+00_r8, & + & 1.41992e+00_r8, 1.51152e+00_r8, 1.60902e+00_r8, 1.71282e+00_r8/) + kao_mco2( 3, :,13) = (/ & + & 5.94615e-01_r8, 6.33277e-01_r8, 6.74453e-01_r8, 7.18307e-01_r8, 7.65012e-01_r8, & + & 8.14753e-01_r8, 8.67729e-01_r8, 9.24149e-01_r8, 9.84238e-01_r8, 1.04823e+00_r8, & + & 1.11639e+00_r8, 1.18898e+00_r8, 1.26629e+00_r8, 1.34862e+00_r8, 1.43631e+00_r8, & + & 1.52970e+00_r8, 1.62916e+00_r8, 1.73509e+00_r8, 1.84791e+00_r8/) + kao_mco2( 4, :,13) = (/ & + & 5.48973e-01_r8, 5.84145e-01_r8, 6.21570e-01_r8, 6.61394e-01_r8, 7.03768e-01_r8, & + & 7.48858e-01_r8, 7.96836e-01_r8, 8.47889e-01_r8, 9.02212e-01_r8, 9.60015e-01_r8, & + & 1.02152e+00_r8, 1.08697e+00_r8, 1.15661e+00_r8, 1.23071e+00_r8, 1.30956e+00_r8, & + & 1.39347e+00_r8, 1.48274e+00_r8, 1.57774e+00_r8, 1.67883e+00_r8/) + kao_mco2( 5, :,13) = (/ & + & 1.49742e-01_r8, 1.59049e-01_r8, 1.68934e-01_r8, 1.79434e-01_r8, 1.90586e-01_r8, & + & 2.02432e-01_r8, 2.15013e-01_r8, 2.28377e-01_r8, 2.42571e-01_r8, 2.57648e-01_r8, & + & 2.73661e-01_r8, 2.90670e-01_r8, 3.08736e-01_r8, 3.27925e-01_r8, 3.48307e-01_r8, & + & 3.69955e-01_r8, 3.92949e-01_r8, 4.17372e-01_r8, 4.43312e-01_r8/) + kao_mco2( 6, :,13) = (/ & + & 8.81777e-04_r8, 9.16690e-04_r8, 9.52985e-04_r8, 9.90718e-04_r8, 1.02994e-03_r8, & + & 1.07072e-03_r8, 1.11312e-03_r8, 1.15719e-03_r8, 1.20301e-03_r8, 1.25064e-03_r8, & + & 1.30016e-03_r8, 1.35163e-03_r8, 1.40515e-03_r8, 1.46079e-03_r8, 1.51862e-03_r8, & + & 1.57875e-03_r8, 1.64126e-03_r8, 1.70624e-03_r8, 1.77380e-03_r8/) + kao_mco2( 7, :,13) = (/ & + & 8.84366e-04_r8, 9.20446e-04_r8, 9.57999e-04_r8, 9.97083e-04_r8, 1.03776e-03_r8, & + & 1.08010e-03_r8, 1.12417e-03_r8, 1.17003e-03_r8, 1.21777e-03_r8, 1.26745e-03_r8, & + & 1.31916e-03_r8, 1.37298e-03_r8, 1.42899e-03_r8, 1.48729e-03_r8, 1.54797e-03_r8, & + & 1.61113e-03_r8, 1.67686e-03_r8, 1.74527e-03_r8, 1.81647e-03_r8/) + kao_mco2( 8, :,13) = (/ & + & 8.92597e-04_r8, 9.33069e-04_r8, 9.75377e-04_r8, 1.01960e-03_r8, 1.06583e-03_r8, & + & 1.11416e-03_r8, 1.16468e-03_r8, 1.21749e-03_r8, 1.27269e-03_r8, 1.33040e-03_r8, & + & 1.39073e-03_r8, 1.45378e-03_r8, 1.51970e-03_r8, 1.58861e-03_r8, 1.66064e-03_r8, & + & 1.73594e-03_r8, 1.81465e-03_r8, 1.89693e-03_r8, 1.98294e-03_r8/) + kao_mco2( 9, :,13) = (/ & + & 1.46280e-01_r8, 1.55378e-01_r8, 1.65043e-01_r8, 1.75308e-01_r8, 1.86212e-01_r8, & + & 1.97794e-01_r8, 2.10097e-01_r8, 2.23164e-01_r8, 2.37045e-01_r8, 2.51788e-01_r8, & + & 2.67449e-01_r8, 2.84084e-01_r8, 3.01754e-01_r8, 3.20522e-01_r8, 3.40458e-01_r8, & + & 3.61634e-01_r8, 3.84127e-01_r8, 4.08020e-01_r8, 4.33398e-01_r8/) + kao_mco2( 1, :,14) = (/ & + & 9.20236e-01_r8, 9.80010e-01_r8, 1.04367e+00_r8, 1.11146e+00_r8, 1.18366e+00_r8, & + & 1.26054e+00_r8, 1.34242e+00_r8, 1.42962e+00_r8, 1.52248e+00_r8, 1.62137e+00_r8, & + & 1.72669e+00_r8, 1.83885e+00_r8, 1.95829e+00_r8, 2.08549e+00_r8, 2.22096e+00_r8, & + & 2.36522e+00_r8, 2.51886e+00_r8, 2.68247e+00_r8, 2.85671e+00_r8/) + kao_mco2( 2, :,14) = (/ & + & 8.39823e-01_r8, 8.95471e-01_r8, 9.54806e-01_r8, 1.01807e+00_r8, 1.08553e+00_r8, & + & 1.15746e+00_r8, 1.23416e+00_r8, 1.31593e+00_r8, 1.40313e+00_r8, 1.49610e+00_r8, & + & 1.59523e+00_r8, 1.70094e+00_r8, 1.81364e+00_r8, 1.93382e+00_r8, 2.06195e+00_r8, & + & 2.19858e+00_r8, 2.34426e+00_r8, 2.49960e+00_r8, 2.66522e+00_r8/) + kao_mco2( 3, :,14) = (/ & + & 5.39252e-01_r8, 5.73971e-01_r8, 6.10925e-01_r8, 6.50259e-01_r8, 6.92125e-01_r8, & + & 7.36686e-01_r8, 7.84117e-01_r8, 8.34601e-01_r8, 8.88336e-01_r8, 9.45530e-01_r8, & + & 1.00641e+00_r8, 1.07120e+00_r8, 1.14017e+00_r8, 1.21358e+00_r8, 1.29171e+00_r8, & + & 1.37488e+00_r8, 1.46340e+00_r8, 1.55762e+00_r8, 1.65790e+00_r8/) + kao_mco2( 4, :,14) = (/ & + & 1.14837e-03_r8, 1.19701e-03_r8, 1.24770e-03_r8, 1.30055e-03_r8, 1.35563e-03_r8, & + & 1.41305e-03_r8, 1.47289e-03_r8, 1.53528e-03_r8, 1.60030e-03_r8, 1.66808e-03_r8, & + & 1.73873e-03_r8, 1.81237e-03_r8, 1.88913e-03_r8, 1.96914e-03_r8, 2.05254e-03_r8, & + & 2.13947e-03_r8, 2.23009e-03_r8, 2.32454e-03_r8, 2.42299e-03_r8/) + kao_mco2( 5, :,14) = (/ & + & 1.14611e-03_r8, 1.19424e-03_r8, 1.24440e-03_r8, 1.29666e-03_r8, 1.35111e-03_r8, & + & 1.40786e-03_r8, 1.46698e-03_r8, 1.52859e-03_r8, 1.59279e-03_r8, 1.65968e-03_r8, & + & 1.72938e-03_r8, 1.80201e-03_r8, 1.87769e-03_r8, 1.95655e-03_r8, 2.03872e-03_r8, & + & 2.12434e-03_r8, 2.21355e-03_r8, 2.30651e-03_r8, 2.40338e-03_r8/) + kao_mco2( 6, :,14) = (/ & + & 1.14203e-03_r8, 1.18930e-03_r8, 1.23852e-03_r8, 1.28979e-03_r8, 1.34317e-03_r8, & + & 1.39877e-03_r8, 1.45666e-03_r8, 1.51695e-03_r8, 1.57974e-03_r8, 1.64513e-03_r8, & + & 1.71322e-03_r8, 1.78413e-03_r8, 1.85798e-03_r8, 1.93488e-03_r8, 2.01497e-03_r8, & + & 2.09837e-03_r8, 2.18522e-03_r8, 2.27567e-03_r8, 2.36986e-03_r8/) + kao_mco2( 7, :,14) = (/ & + & 1.11217e-03_r8, 1.15727e-03_r8, 1.20421e-03_r8, 1.25305e-03_r8, 1.30386e-03_r8, & + & 1.35674e-03_r8, 1.41177e-03_r8, 1.46902e-03_r8, 1.52860e-03_r8, 1.59059e-03_r8, & + & 1.65510e-03_r8, 1.72222e-03_r8, 1.79207e-03_r8, 1.86475e-03_r8, 1.94037e-03_r8, & + & 2.01907e-03_r8, 2.10095e-03_r8, 2.18616e-03_r8, 2.27482e-03_r8/) + kao_mco2( 8, :,14) = (/ & + & 1.21596e-03_r8, 1.25817e-03_r8, 1.30183e-03_r8, 1.34702e-03_r8, 1.39377e-03_r8, & + & 1.44214e-03_r8, 1.49219e-03_r8, 1.54398e-03_r8, 1.59757e-03_r8, 1.65302e-03_r8, & + & 1.71039e-03_r8, 1.76975e-03_r8, 1.83117e-03_r8, 1.89473e-03_r8, 1.96049e-03_r8, & + & 2.02853e-03_r8, 2.09893e-03_r8, 2.17178e-03_r8, 2.24716e-03_r8/) + kao_mco2( 9, :,14) = (/ & + & 1.14611e-03_r8, 1.19424e-03_r8, 1.24440e-03_r8, 1.29666e-03_r8, 1.35111e-03_r8, & + & 1.40786e-03_r8, 1.46698e-03_r8, 1.52859e-03_r8, 1.59279e-03_r8, 1.65968e-03_r8, & + & 1.72938e-03_r8, 1.80201e-03_r8, 1.87769e-03_r8, 1.95655e-03_r8, 2.03872e-03_r8, & + & 2.12434e-03_r8, 2.21355e-03_r8, 2.30651e-03_r8, 2.40338e-03_r8/) + kao_mco2( 1, :,15) = (/ & + & 1.29470e+00_r8, 1.37848e+00_r8, 1.46768e+00_r8, 1.56266e+00_r8, 1.66378e+00_r8, & + & 1.77145e+00_r8, 1.88609e+00_r8, 2.00814e+00_r8, 2.13809e+00_r8, 2.27645e+00_r8, & + & 2.42376e+00_r8, 2.58061e+00_r8, 2.74761e+00_r8, 2.92541e+00_r8, 3.11472e+00_r8, & + & 3.31628e+00_r8, 3.53088e+00_r8, 3.75938e+00_r8, 4.00265e+00_r8/) + kao_mco2( 2, :,15) = (/ & + & 7.23701e-01_r8, 7.68508e-01_r8, 8.16089e-01_r8, 8.66616e-01_r8, 9.20272e-01_r8, & + & 9.77250e-01_r8, 1.03775e+00_r8, 1.10201e+00_r8, 1.17024e+00_r8, 1.24269e+00_r8, & + & 1.31963e+00_r8, 1.40133e+00_r8, 1.48809e+00_r8, 1.58023e+00_r8, 1.67807e+00_r8, & + & 1.78196e+00_r8, 1.89229e+00_r8, 2.00945e+00_r8, 2.13386e+00_r8/) + kao_mco2( 3, :,15) = (/ & + & 1.81684e-03_r8, 1.85424e-03_r8, 1.89241e-03_r8, 1.93137e-03_r8, 1.97114e-03_r8, & + & 2.01172e-03_r8, 2.05313e-03_r8, 2.09540e-03_r8, 2.13854e-03_r8, 2.18257e-03_r8, & + & 2.22750e-03_r8, 2.27336e-03_r8, 2.32016e-03_r8, 2.36793e-03_r8, 2.41668e-03_r8, & + & 2.46643e-03_r8, 2.51721e-03_r8, 2.56903e-03_r8, 2.62192e-03_r8/) + kao_mco2( 4, :,15) = (/ & + & 1.84644e-03_r8, 1.88437e-03_r8, 1.92309e-03_r8, 1.96260e-03_r8, 2.00293e-03_r8, & + & 2.04408e-03_r8, 2.08608e-03_r8, 2.12894e-03_r8, 2.17268e-03_r8, 2.21732e-03_r8, & + & 2.26288e-03_r8, 2.30938e-03_r8, 2.35683e-03_r8, 2.40525e-03_r8, 2.45467e-03_r8, & + & 2.50510e-03_r8, 2.55658e-03_r8, 2.60910e-03_r8, 2.66271e-03_r8/) + kao_mco2( 5, :,15) = (/ & + & 1.88579e-03_r8, 1.92454e-03_r8, 1.96408e-03_r8, 2.00443e-03_r8, 2.04561e-03_r8, & + & 2.08764e-03_r8, 2.13054e-03_r8, 2.17431e-03_r8, 2.21898e-03_r8, 2.26457e-03_r8, & + & 2.31110e-03_r8, 2.35858e-03_r8, 2.40704e-03_r8, 2.45650e-03_r8, 2.50697e-03_r8, & + & 2.55848e-03_r8, 2.61104e-03_r8, 2.66469e-03_r8, 2.71943e-03_r8/) + kao_mco2( 6, :,15) = (/ & + & 1.95322e-03_r8, 1.99316e-03_r8, 2.03391e-03_r8, 2.07549e-03_r8, 2.11793e-03_r8, & + & 2.16123e-03_r8, 2.20542e-03_r8, 2.25051e-03_r8, 2.29652e-03_r8, 2.34347e-03_r8, & + & 2.39139e-03_r8, 2.44028e-03_r8, 2.49017e-03_r8, 2.54109e-03_r8, 2.59304e-03_r8, & + & 2.64605e-03_r8, 2.70015e-03_r8, 2.75536e-03_r8, 2.81169e-03_r8/) + kao_mco2( 7, :,15) = (/ & + & 2.13640e-03_r8, 2.17976e-03_r8, 2.22400e-03_r8, 2.26914e-03_r8, 2.31520e-03_r8, & + & 2.36219e-03_r8, 2.41013e-03_r8, 2.45905e-03_r8, 2.50896e-03_r8, 2.55988e-03_r8, & + & 2.61184e-03_r8, 2.66485e-03_r8, 2.71893e-03_r8, 2.77412e-03_r8, 2.83042e-03_r8, & + & 2.88787e-03_r8, 2.94648e-03_r8, 3.00629e-03_r8, 3.06730e-03_r8/) + kao_mco2( 8, :,15) = (/ & + & 2.17014e-03_r8, 2.21411e-03_r8, 2.25897e-03_r8, 2.30474e-03_r8, 2.35143e-03_r8, & + & 2.39908e-03_r8, 2.44769e-03_r8, 2.49728e-03_r8, 2.54788e-03_r8, 2.59950e-03_r8, & + & 2.65217e-03_r8, 2.70591e-03_r8, 2.76073e-03_r8, 2.81667e-03_r8, 2.87374e-03_r8, & + & 2.93197e-03_r8, 2.99137e-03_r8, 3.05198e-03_r8, 3.11382e-03_r8/) + kao_mco2( 9, :,15) = (/ & + & 1.88579e-03_r8, 1.92454e-03_r8, 1.96408e-03_r8, 2.00443e-03_r8, 2.04561e-03_r8, & + & 2.08764e-03_r8, 2.13054e-03_r8, 2.17431e-03_r8, 2.21898e-03_r8, 2.26457e-03_r8, & + & 2.31110e-03_r8, 2.35858e-03_r8, 2.40704e-03_r8, 2.45650e-03_r8, 2.50697e-03_r8, & + & 2.55848e-03_r8, 2.61104e-03_r8, 2.66469e-03_r8, 2.71943e-03_r8/) + kao_mco2( 1, :,16) = (/ & + & 1.48989e+00_r8, 1.58377e+00_r8, 1.68356e+00_r8, 1.78964e+00_r8, 1.90241e+00_r8, & + & 2.02228e+00_r8, 2.14971e+00_r8, 2.28516e+00_r8, 2.42915e+00_r8, 2.58221e+00_r8, & + & 2.74492e+00_r8, 2.91788e+00_r8, 3.10174e+00_r8, 3.29718e+00_r8, 3.50494e+00_r8, & + & 3.72578e+00_r8, 3.96055e+00_r8, 4.21010e+00_r8, 4.47538e+00_r8/) + kao_mco2( 2, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + kao_mco2( 3, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + kao_mco2( 4, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + kao_mco2( 5, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + kao_mco2( 6, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + kao_mco2( 7, :,16) = (/ & + & 2.09970e-03_r8, 2.14101e-03_r8, 2.18312e-03_r8, 2.22606e-03_r8, 2.26985e-03_r8, & + & 2.31450e-03_r8, 2.36003e-03_r8, 2.40645e-03_r8, 2.45379e-03_r8, 2.50205e-03_r8, & + & 2.55127e-03_r8, 2.60146e-03_r8, 2.65263e-03_r8, 2.70481e-03_r8, 2.75801e-03_r8, & + & 2.81226e-03_r8, 2.86758e-03_r8, 2.92399e-03_r8, 2.98150e-03_r8/) + kao_mco2( 8, :,16) = (/ & + & 2.09970e-03_r8, 2.14101e-03_r8, 2.18312e-03_r8, 2.22606e-03_r8, 2.26985e-03_r8, & + & 2.31450e-03_r8, 2.36003e-03_r8, 2.40645e-03_r8, 2.45379e-03_r8, 2.50205e-03_r8, & + & 2.55127e-03_r8, 2.60146e-03_r8, 2.65263e-03_r8, 2.70481e-03_r8, 2.75801e-03_r8, & + & 2.81226e-03_r8, 2.86758e-03_r8, 2.92399e-03_r8, 2.98150e-03_r8/) + kao_mco2( 9, :,16) = (/ & + & 2.10609e-03_r8, 2.14759e-03_r8, 2.18992e-03_r8, 2.23307e-03_r8, 2.27708e-03_r8, & + & 2.32196e-03_r8, 2.36771e-03_r8, 2.41438e-03_r8, 2.46196e-03_r8, 2.51047e-03_r8, & + & 2.55995e-03_r8, 2.61040e-03_r8, 2.66184e-03_r8, 2.71430e-03_r8, 2.76779e-03_r8, & + & 2.82234e-03_r8, 2.87796e-03_r8, 2.93467e-03_r8, 2.99251e-03_r8/) + + kao_mco( 1, :, 1) = (/ & + & 4.58355e-01_r8, 4.47074e-01_r8, 4.36070e-01_r8, 4.25337e-01_r8, 4.14868e-01_r8, & + & 4.04657e-01_r8, 3.94697e-01_r8, 3.84982e-01_r8, 3.75506e-01_r8, 3.66264e-01_r8, & + & 3.57249e-01_r8, 3.48456e-01_r8, 3.39879e-01_r8, 3.31514e-01_r8, 3.23354e-01_r8, & + & 3.15395e-01_r8, 3.07632e-01_r8, 3.00061e-01_r8, 2.92675e-01_r8/) + kao_mco( 2, :, 1) = (/ & + & 7.03080e-01_r8, 6.84132e-01_r8, 6.65696e-01_r8, 6.47756e-01_r8, 6.30300e-01_r8, & + & 6.13314e-01_r8, 5.96786e-01_r8, 5.80703e-01_r8, 5.65053e-01_r8, 5.49826e-01_r8, & + & 5.35009e-01_r8, 5.20591e-01_r8, 5.06561e-01_r8, 4.92910e-01_r8, 4.79627e-01_r8, & + & 4.66701e-01_r8, 4.54124e-01_r8, 4.41886e-01_r8, 4.29978e-01_r8/) + kao_mco( 3, :, 1) = (/ & + & 8.53018e-01_r8, 8.29537e-01_r8, 8.06703e-01_r8, 7.84497e-01_r8, 7.62903e-01_r8, & + & 7.41903e-01_r8, 7.21481e-01_r8, 7.01621e-01_r8, 6.82307e-01_r8, 6.63526e-01_r8, & + & 6.45261e-01_r8, 6.27499e-01_r8, 6.10226e-01_r8, 5.93429e-01_r8, 5.77094e-01_r8, & + & 5.61208e-01_r8, 5.45760e-01_r8, 5.30737e-01_r8, 5.16128e-01_r8/) + kao_mco( 4, :, 1) = (/ & + & 9.58866e-01_r8, 9.31881e-01_r8, 9.05654e-01_r8, 8.80166e-01_r8, 8.55395e-01_r8, & + & 8.31321e-01_r8, 8.07925e-01_r8, 7.85187e-01_r8, 7.63089e-01_r8, 7.41613e-01_r8, & + & 7.20742e-01_r8, 7.00457e-01_r8, 6.80744e-01_r8, 6.61586e-01_r8, 6.42966e-01_r8, & + & 6.24871e-01_r8, 6.07285e-01_r8, 5.90194e-01_r8, 5.73584e-01_r8/) + kao_mco( 5, :, 1) = (/ & + & 1.07140e+00_r8, 1.04056e+00_r8, 1.01061e+00_r8, 9.81521e-01_r8, 9.53269e-01_r8, & + & 9.25829e-01_r8, 8.99180e-01_r8, 8.73297e-01_r8, 8.48160e-01_r8, 8.23746e-01_r8, & + & 8.00035e-01_r8, 7.77006e-01_r8, 7.54641e-01_r8, 7.32919e-01_r8, 7.11822e-01_r8, & + & 6.91333e-01_r8, 6.71433e-01_r8, 6.52106e-01_r8, 6.33336e-01_r8/) + kao_mco( 6, :, 1) = (/ & + & 1.21046e+00_r8, 1.17478e+00_r8, 1.14015e+00_r8, 1.10655e+00_r8, 1.07393e+00_r8, & + & 1.04228e+00_r8, 1.01156e+00_r8, 9.81740e-01_r8, 9.52803e-01_r8, 9.24720e-01_r8, & + & 8.97463e-01_r8, 8.71011e-01_r8, 8.45338e-01_r8, 8.20422e-01_r8, 7.96240e-01_r8, & + & 7.72771e-01_r8, 7.49993e-01_r8, 7.27887e-01_r8, 7.06433e-01_r8/) + kao_mco( 7, :, 1) = (/ & + & 1.57730e+00_r8, 1.52919e+00_r8, 1.48255e+00_r8, 1.43733e+00_r8, 1.39349e+00_r8, & + & 1.35099e+00_r8, 1.30978e+00_r8, 1.26983e+00_r8, 1.23110e+00_r8, 1.19355e+00_r8, & + & 1.15715e+00_r8, 1.12186e+00_r8, 1.08764e+00_r8, 1.05446e+00_r8, 1.02230e+00_r8, & + & 9.91121e-01_r8, 9.60890e-01_r8, 9.31583e-01_r8, 9.03169e-01_r8/) + kao_mco( 8, :, 1) = (/ & + & 2.43678e+00_r8, 2.36595e+00_r8, 2.29719e+00_r8, 2.23042e+00_r8, 2.16560e+00_r8, & + & 2.10266e+00_r8, 2.04154e+00_r8, 1.98221e+00_r8, 1.92460e+00_r8, 1.86866e+00_r8, & + & 1.81435e+00_r8, 1.76162e+00_r8, 1.71042e+00_r8, 1.66070e+00_r8, 1.61244e+00_r8, & + & 1.56557e+00_r8, 1.52007e+00_r8, 1.47589e+00_r8, 1.43300e+00_r8/) + kao_mco( 9, :, 1) = (/ & + & 9.66296e-01_r8, 9.39903e-01_r8, 9.14232e-01_r8, 8.89262e-01_r8, 8.64973e-01_r8, & + & 8.41348e-01_r8, 8.18369e-01_r8, 7.96017e-01_r8, 7.74275e-01_r8, 7.53128e-01_r8, & + & 7.32558e-01_r8, 7.12549e-01_r8, 6.93088e-01_r8, 6.74157e-01_r8, 6.55744e-01_r8, & + & 6.37834e-01_r8, 6.20413e-01_r8, 6.03468e-01_r8, 5.86985e-01_r8/) + kao_mco( 1, :, 2) = (/ & + & 1.15047e+00_r8, 1.12127e+00_r8, 1.09281e+00_r8, 1.06507e+00_r8, 1.03804e+00_r8, & + & 1.01169e+00_r8, 9.86010e-01_r8, 9.60983e-01_r8, 9.36591e-01_r8, 9.12818e-01_r8, & + & 8.89649e-01_r8, 8.67067e-01_r8, 8.45059e-01_r8, 8.23610e-01_r8, 8.02705e-01_r8, & + & 7.82330e-01_r8, 7.62473e-01_r8, 7.43119e-01_r8, 7.24257e-01_r8/) + kao_mco( 2, :, 2) = (/ & + & 1.43243e+00_r8, 1.39430e+00_r8, 1.35719e+00_r8, 1.32106e+00_r8, 1.28590e+00_r8, & + & 1.25167e+00_r8, 1.21836e+00_r8, 1.18593e+00_r8, 1.15436e+00_r8, 1.12364e+00_r8, & + & 1.09373e+00_r8, 1.06462e+00_r8, 1.03628e+00_r8, 1.00870e+00_r8, 9.81848e-01_r8, & + & 9.55714e-01_r8, 9.30275e-01_r8, 9.05514e-01_r8, 8.81412e-01_r8/) + kao_mco( 3, :, 2) = (/ & + & 1.61389e+00_r8, 1.56911e+00_r8, 1.52556e+00_r8, 1.48323e+00_r8, 1.44207e+00_r8, & + & 1.40205e+00_r8, 1.36314e+00_r8, 1.32531e+00_r8, 1.28854e+00_r8, 1.25278e+00_r8, & + & 1.21801e+00_r8, 1.18421e+00_r8, 1.15135e+00_r8, 1.11940e+00_r8, 1.08834e+00_r8, & + & 1.05814e+00_r8, 1.02877e+00_r8, 1.00022e+00_r8, 9.72466e-01_r8/) + kao_mco( 4, :, 2) = (/ & + & 1.78458e+00_r8, 1.73440e+00_r8, 1.68564e+00_r8, 1.63825e+00_r8, 1.59219e+00_r8, & + & 1.54742e+00_r8, 1.50391e+00_r8, 1.46163e+00_r8, 1.42053e+00_r8, 1.38059e+00_r8, & + & 1.34178e+00_r8, 1.30405e+00_r8, 1.26739e+00_r8, 1.23175e+00_r8, 1.19712e+00_r8, & + & 1.16346e+00_r8, 1.13075e+00_r8, 1.09896e+00_r8, 1.06806e+00_r8/) + kao_mco( 5, :, 2) = (/ & + & 1.92622e+00_r8, 1.87172e+00_r8, 1.81876e+00_r8, 1.76730e+00_r8, 1.71730e+00_r8, & + & 1.66871e+00_r8, 1.62150e+00_r8, 1.57562e+00_r8, 1.53104e+00_r8, 1.48772e+00_r8, & + & 1.44563e+00_r8, 1.40473e+00_r8, 1.36498e+00_r8, 1.32636e+00_r8, 1.28883e+00_r8, & + & 1.25237e+00_r8, 1.21693e+00_r8, 1.18250e+00_r8, 1.14905e+00_r8/) + kao_mco( 6, :, 2) = (/ & + & 2.23194e+00_r8, 2.16782e+00_r8, 2.10554e+00_r8, 2.04505e+00_r8, 1.98630e+00_r8, & + & 1.92924e+00_r8, 1.87381e+00_r8, 1.81998e+00_r8, 1.76770e+00_r8, 1.71691e+00_r8, & + & 1.66759e+00_r8, 1.61968e+00_r8, 1.57315e+00_r8, 1.52796e+00_r8, 1.48406e+00_r8, & + & 1.44143e+00_r8, 1.40002e+00_r8, 1.35980e+00_r8, 1.32073e+00_r8/) + kao_mco( 7, :, 2) = (/ & + & 2.64692e+00_r8, 2.57290e+00_r8, 2.50096e+00_r8, 2.43103e+00_r8, 2.36305e+00_r8, & + & 2.29697e+00_r8, 2.23275e+00_r8, 2.17031e+00_r8, 2.10963e+00_r8, 2.05064e+00_r8, & + & 1.99330e+00_r8, 1.93756e+00_r8, 1.88338e+00_r8, 1.83072e+00_r8, 1.77953e+00_r8, & + & 1.72977e+00_r8, 1.68140e+00_r8, 1.63438e+00_r8, 1.58868e+00_r8/) + kao_mco( 8, :, 2) = (/ & + & 2.86812e+00_r8, 2.80121e+00_r8, 2.73586e+00_r8, 2.67204e+00_r8, 2.60970e+00_r8, & + & 2.54882e+00_r8, 2.48936e+00_r8, 2.43129e+00_r8, 2.37457e+00_r8, 2.31917e+00_r8, & + & 2.26507e+00_r8, 2.21223e+00_r8, 2.16062e+00_r8, 2.11022e+00_r8, 2.06099e+00_r8, & + & 2.01291e+00_r8, 1.96595e+00_r8, 1.92009e+00_r8, 1.87529e+00_r8/) + kao_mco( 9, :, 2) = (/ & + & 1.25243e+00_r8, 1.22790e+00_r8, 1.20385e+00_r8, 1.18027e+00_r8, 1.15716e+00_r8, & + & 1.13449e+00_r8, 1.11227e+00_r8, 1.09049e+00_r8, 1.06913e+00_r8, 1.04819e+00_r8, & + & 1.02766e+00_r8, 1.00754e+00_r8, 9.87804e-01_r8, 9.68457e-01_r8, 9.49490e-01_r8, & + & 9.30894e-01_r8, 9.12662e-01_r8, 8.94787e-01_r8, 8.77263e-01_r8/) + kao_mco( 1, :, 3) = (/ & + & 2.55598e+00_r8, 2.48729e+00_r8, 2.42045e+00_r8, 2.35541e+00_r8, 2.29211e+00_r8, & + & 2.23052e+00_r8, 2.17058e+00_r8, 2.11225e+00_r8, 2.05549e+00_r8, 2.00025e+00_r8, & + & 1.94650e+00_r8, 1.89419e+00_r8, 1.84329e+00_r8, 1.79376e+00_r8, 1.74555e+00_r8, & + & 1.69865e+00_r8, 1.65300e+00_r8, 1.60858e+00_r8, 1.56535e+00_r8/) + kao_mco( 2, :, 3) = (/ & + & 2.93113e+00_r8, 2.85257e+00_r8, 2.77612e+00_r8, 2.70172e+00_r8, 2.62932e+00_r8, & + & 2.55885e+00_r8, 2.49028e+00_r8, 2.42354e+00_r8, 2.35859e+00_r8, 2.29538e+00_r8, & + & 2.23386e+00_r8, 2.17400e+00_r8, 2.11573e+00_r8, 2.05903e+00_r8, 2.00385e+00_r8, & + & 1.95015e+00_r8, 1.89788e+00_r8, 1.84702e+00_r8, 1.79752e+00_r8/) + kao_mco( 3, :, 3) = (/ & + & 3.26626e+00_r8, 3.18025e+00_r8, 3.09651e+00_r8, 3.01497e+00_r8, 2.93558e+00_r8, & + & 2.85828e+00_r8, 2.78302e+00_r8, 2.70973e+00_r8, 2.63838e+00_r8, 2.56891e+00_r8, & + & 2.50126e+00_r8, 2.43540e+00_r8, 2.37127e+00_r8, 2.30883e+00_r8, 2.24803e+00_r8, & + & 2.18883e+00_r8, 2.13120e+00_r8, 2.07508e+00_r8, 2.02044e+00_r8/) + kao_mco( 4, :, 3) = (/ & + & 3.65895e+00_r8, 3.56418e+00_r8, 3.47187e+00_r8, 3.38194e+00_r8, 3.29435e+00_r8, & + & 3.20903e+00_r8, 3.12591e+00_r8, 3.04495e+00_r8, 2.96608e+00_r8, 2.88926e+00_r8, & + & 2.81443e+00_r8, 2.74153e+00_r8, 2.67053e+00_r8, 2.60136e+00_r8, 2.53398e+00_r8, & + & 2.46835e+00_r8, 2.40442e+00_r8, 2.34214e+00_r8, 2.28148e+00_r8/) + kao_mco( 5, :, 3) = (/ & + & 4.13692e+00_r8, 4.03459e+00_r8, 3.93479e+00_r8, 3.83746e+00_r8, 3.74254e+00_r8, & + & 3.64997e+00_r8, 3.55968e+00_r8, 3.47163e+00_r8, 3.38576e+00_r8, 3.30201e+00_r8, & + & 3.22034e+00_r8, 3.14068e+00_r8, 3.06299e+00_r8, 2.98723e+00_r8, 2.91334e+00_r8, & + & 2.84128e+00_r8, 2.77100e+00_r8, 2.70246e+00_r8, 2.63561e+00_r8/) + kao_mco( 6, :, 3) = (/ & + & 4.42856e+00_r8, 4.32480e+00_r8, 4.22348e+00_r8, 4.12453e+00_r8, 4.02790e+00_r8, & + & 3.93353e+00_r8, 3.84137e+00_r8, 3.75137e+00_r8, 3.66348e+00_r8, 3.57765e+00_r8, & + & 3.49383e+00_r8, 3.41198e+00_r8, 3.33204e+00_r8, 3.25397e+00_r8, 3.17774e+00_r8, & + & 3.10329e+00_r8, 3.03058e+00_r8, 2.95958e+00_r8, 2.89024e+00_r8/) + kao_mco( 7, :, 3) = (/ & + & 4.31306e+00_r8, 4.21750e+00_r8, 4.12406e+00_r8, 4.03268e+00_r8, 3.94333e+00_r8, & + & 3.85596e+00_r8, 3.77053e+00_r8, 3.68699e+00_r8, 3.60530e+00_r8, 3.52542e+00_r8, & + & 3.44731e+00_r8, 3.37093e+00_r8, 3.29624e+00_r8, 3.22321e+00_r8, 3.15179e+00_r8, & + & 3.08196e+00_r8, 3.01368e+00_r8, 2.94691e+00_r8, 2.88161e+00_r8/) + kao_mco( 8, :, 3) = (/ & + & 4.38922e+00_r8, 4.32180e+00_r8, 4.25543e+00_r8, 4.19007e+00_r8, 4.12571e+00_r8, & + & 4.06234e+00_r8, 3.99995e+00_r8, 3.93851e+00_r8, 3.87802e+00_r8, 3.81846e+00_r8, & + & 3.75981e+00_r8, 3.70206e+00_r8, 3.64520e+00_r8, 3.58922e+00_r8, 3.53409e+00_r8, & + & 3.47981e+00_r8, 3.42636e+00_r8, 3.37374e+00_r8, 3.32192e+00_r8/) + kao_mco( 9, :, 3) = (/ & + & 1.56810e+00_r8, 1.54211e+00_r8, 1.51654e+00_r8, 1.49139e+00_r8, 1.46667e+00_r8, & + & 1.44235e+00_r8, 1.41844e+00_r8, 1.39492e+00_r8, 1.37179e+00_r8, 1.34905e+00_r8, & + & 1.32668e+00_r8, 1.30469e+00_r8, 1.28306e+00_r8, 1.26178e+00_r8, 1.24086e+00_r8, & + & 1.22029e+00_r8, 1.20006e+00_r8, 1.18016e+00_r8, 1.16059e+00_r8/) + kao_mco( 1, :, 4) = (/ & + & 6.58275e+00_r8, 6.43026e+00_r8, 6.28130e+00_r8, 6.13579e+00_r8, 5.99365e+00_r8, & + & 5.85481e+00_r8, 5.71918e+00_r8, 5.58669e+00_r8, 5.45727e+00_r8, 5.33085e+00_r8, & + & 5.20736e+00_r8, 5.08673e+00_r8, 4.96889e+00_r8, 4.85379e+00_r8, 4.74135e+00_r8, & + & 4.63151e+00_r8, 4.52422e+00_r8, 4.41942e+00_r8, 4.31704e+00_r8/) + kao_mco( 2, :, 4) = (/ & + & 6.59883e+00_r8, 6.45139e+00_r8, 6.30725e+00_r8, 6.16633e+00_r8, 6.02855e+00_r8, & + & 5.89386e+00_r8, 5.76217e+00_r8, 5.63342e+00_r8, 5.50756e+00_r8, 5.38450e+00_r8, & + & 5.26419e+00_r8, 5.14657e+00_r8, 5.03158e+00_r8, 4.91916e+00_r8, 4.80925e+00_r8, & + & 4.70180e+00_r8, 4.59675e+00_r8, 4.49404e+00_r8, 4.39363e+00_r8/) + kao_mco( 3, :, 4) = (/ & + & 6.58521e+00_r8, 6.44452e+00_r8, 6.30683e+00_r8, 6.17209e+00_r8, 6.04023e+00_r8, & + & 5.91118e+00_r8, 5.78489e+00_r8, 5.66130e+00_r8, 5.54034e+00_r8, 5.42198e+00_r8, & + & 5.30614e+00_r8, 5.19277e+00_r8, 5.08183e+00_r8, 4.97326e+00_r8, 4.86701e+00_r8, & + & 4.76303e+00_r8, 4.66127e+00_r8, 4.56168e+00_r8, 4.46422e+00_r8/) + kao_mco( 4, :, 4) = (/ & + & 6.33742e+00_r8, 6.20870e+00_r8, 6.08260e+00_r8, 5.95905e+00_r8, 5.83802e+00_r8, & + & 5.71945e+00_r8, 5.60328e+00_r8, 5.48947e+00_r8, 5.37798e+00_r8, 5.26875e+00_r8, & + & 5.16174e+00_r8, 5.05690e+00_r8, 4.95419e+00_r8, 4.85357e+00_r8, 4.75499e+00_r8, & + & 4.65841e+00_r8, 4.56379e+00_r8, 4.47110e+00_r8, 4.38029e+00_r8/) + kao_mco( 5, :, 4) = (/ & + & 5.99732e+00_r8, 5.88459e+00_r8, 5.77398e+00_r8, 5.66545e+00_r8, 5.55896e+00_r8, & + & 5.45447e+00_r8, 5.35194e+00_r8, 5.25134e+00_r8, 5.15263e+00_r8, 5.05578e+00_r8, & + & 4.96075e+00_r8, 4.86750e+00_r8, 4.77601e+00_r8, 4.68623e+00_r8, 4.59815e+00_r8, & + & 4.51171e+00_r8, 4.42691e+00_r8, 4.34370e+00_r8, 4.26205e+00_r8/) + kao_mco( 6, :, 4) = (/ & + & 5.74529e+00_r8, 5.65249e+00_r8, 5.56119e+00_r8, 5.47136e+00_r8, 5.38299e+00_r8, & + & 5.29604e+00_r8, 5.21049e+00_r8, 5.12633e+00_r8, 5.04353e+00_r8, 4.96206e+00_r8, & + & 4.88191e+00_r8, 4.80306e+00_r8, 4.72547e+00_r8, 4.64915e+00_r8, 4.57405e+00_r8, & + & 4.50017e+00_r8, 4.42748e+00_r8, 4.35596e+00_r8, 4.28560e+00_r8/) + kao_mco( 7, :, 4) = (/ & + & 5.87251e+00_r8, 5.79956e+00_r8, 5.72753e+00_r8, 5.65638e+00_r8, 5.58613e+00_r8, & + & 5.51674e+00_r8, 5.44822e+00_r8, 5.38054e+00_r8, 5.31371e+00_r8, 5.24771e+00_r8, & + & 5.18253e+00_r8, 5.11815e+00_r8, 5.05458e+00_r8, 4.99180e+00_r8, 4.92979e+00_r8, & + & 4.86856e+00_r8, 4.80809e+00_r8, 4.74837e+00_r8, 4.68939e+00_r8/) + kao_mco( 8, :, 4) = (/ & + & 5.68503e+00_r8, 5.62827e+00_r8, 5.57207e+00_r8, 5.51644e+00_r8, 5.46136e+00_r8, & + & 5.40684e+00_r8, 5.35285e+00_r8, 5.29941e+00_r8, 5.24650e+00_r8, 5.19412e+00_r8, & + & 5.14226e+00_r8, 5.09092e+00_r8, 5.04009e+00_r8, 4.98977e+00_r8, 4.93995e+00_r8, & + & 4.89063e+00_r8, 4.84180e+00_r8, 4.79346e+00_r8, 4.74560e+00_r8/) + kao_mco( 9, :, 4) = (/ & + & 2.69278e+00_r8, 2.65058e+00_r8, 2.60903e+00_r8, 2.56814e+00_r8, 2.52789e+00_r8, & + & 2.48827e+00_r8, 2.44927e+00_r8, 2.41088e+00_r8, 2.37310e+00_r8, 2.33590e+00_r8, & + & 2.29929e+00_r8, 2.26325e+00_r8, 2.22778e+00_r8, 2.19286e+00_r8, 2.15849e+00_r8, & + & 2.12466e+00_r8, 2.09136e+00_r8, 2.05859e+00_r8, 2.02632e+00_r8/) + kao_mco( 1, :, 5) = (/ & + & 9.12231e+00_r8, 9.00052e+00_r8, 8.88036e+00_r8, 8.76180e+00_r8, 8.64482e+00_r8, & + & 8.52941e+00_r8, 8.41553e+00_r8, 8.30318e+00_r8, 8.19233e+00_r8, 8.08295e+00_r8, & + & 7.97504e+00_r8, 7.86857e+00_r8, 7.76352e+00_r8, 7.65987e+00_r8, 7.55760e+00_r8, & + & 7.45671e+00_r8, 7.35715e+00_r8, 7.25893e+00_r8, 7.16202e+00_r8/) + kao_mco( 2, :, 5) = (/ & + & 8.37315e+00_r8, 8.27808e+00_r8, 8.18410e+00_r8, 8.09118e+00_r8, 7.99931e+00_r8, & + & 7.90849e+00_r8, 7.81871e+00_r8, 7.72994e+00_r8, 7.64217e+00_r8, 7.55541e+00_r8, & + & 7.46963e+00_r8, 7.38482e+00_r8, 7.30098e+00_r8, 7.21809e+00_r8, 7.13614e+00_r8, & + & 7.05512e+00_r8, 6.97502e+00_r8, 6.89582e+00_r8, 6.81753e+00_r8/) + kao_mco( 3, :, 5) = (/ & + & 8.14557e+00_r8, 8.06533e+00_r8, 7.98587e+00_r8, 7.90720e+00_r8, 7.82930e+00_r8, & + & 7.75217e+00_r8, 7.67580e+00_r8, 7.60018e+00_r8, 7.52530e+00_r8, 7.45117e+00_r8, & + & 7.37776e+00_r8, 7.30508e+00_r8, 7.23311e+00_r8, 7.16186e+00_r8, 7.09130e+00_r8, & + & 7.02144e+00_r8, 6.95227e+00_r8, 6.88378e+00_r8, 6.81596e+00_r8/) + kao_mco( 4, :, 5) = (/ & + & 8.18046e+00_r8, 8.11056e+00_r8, 8.04126e+00_r8, 7.97256e+00_r8, 7.90444e+00_r8, & + & 7.83690e+00_r8, 7.76994e+00_r8, 7.70355e+00_r8, 7.63773e+00_r8, 7.57247e+00_r8, & + & 7.50777e+00_r8, 7.44362e+00_r8, 7.38002e+00_r8, 7.31697e+00_r8, 7.25445e+00_r8, & + & 7.19247e+00_r8, 7.13101e+00_r8, 7.07008e+00_r8, 7.00968e+00_r8/) + kao_mco( 5, :, 5) = (/ & + & 8.30092e+00_r8, 8.23529e+00_r8, 8.17019e+00_r8, 8.10559e+00_r8, 8.04151e+00_r8, & + & 7.97794e+00_r8, 7.91487e+00_r8, 7.85230e+00_r8, 7.79022e+00_r8, 7.72863e+00_r8, & + & 7.66753e+00_r8, 7.60691e+00_r8, 7.54678e+00_r8, 7.48711e+00_r8, 7.42792e+00_r8, & + & 7.36920e+00_r8, 7.31094e+00_r8, 7.25314e+00_r8, 7.19580e+00_r8/) + kao_mco( 6, :, 5) = (/ & + & 8.30014e+00_r8, 8.24466e+00_r8, 8.18955e+00_r8, 8.13481e+00_r8, 8.08044e+00_r8, & + & 8.02642e+00_r8, 7.97277e+00_r8, 7.91948e+00_r8, 7.86655e+00_r8, 7.81396e+00_r8, & + & 7.76173e+00_r8, 7.70985e+00_r8, 7.65832e+00_r8, 7.60713e+00_r8, 7.55628e+00_r8, & + & 7.50577e+00_r8, 7.45560e+00_r8, 7.40577e+00_r8, 7.35627e+00_r8/) + kao_mco( 7, :, 5) = (/ & + & 7.95931e+00_r8, 7.93958e+00_r8, 7.91989e+00_r8, 7.90025e+00_r8, 7.88066e+00_r8, & + & 7.86112e+00_r8, 7.84163e+00_r8, 7.82219e+00_r8, 7.80279e+00_r8, 7.78344e+00_r8, & + & 7.76414e+00_r8, 7.74489e+00_r8, 7.72568e+00_r8, 7.70653e+00_r8, 7.68742e+00_r8, & + & 7.66836e+00_r8, 7.64934e+00_r8, 7.63038e+00_r8, 7.61146e+00_r8/) + kao_mco( 8, :, 5) = (/ & + & 9.32576e+00_r8, 9.31747e+00_r8, 9.30919e+00_r8, 9.30092e+00_r8, 9.29265e+00_r8, & + & 9.28439e+00_r8, 9.27613e+00_r8, 9.26789e+00_r8, 9.25965e+00_r8, 9.25142e+00_r8, & + & 9.24320e+00_r8, 9.23498e+00_r8, 9.22677e+00_r8, 9.21857e+00_r8, 9.21038e+00_r8, & + & 9.20219e+00_r8, 9.19401e+00_r8, 9.18584e+00_r8, 9.17767e+00_r8/) + kao_mco( 9, :, 5) = (/ & + & 4.13116e+00_r8, 4.08426e+00_r8, 4.03788e+00_r8, 3.99204e+00_r8, 3.94671e+00_r8, & + & 3.90190e+00_r8, 3.85760e+00_r8, 3.81380e+00_r8, 3.77049e+00_r8, 3.72768e+00_r8, & + & 3.68536e+00_r8, 3.64351e+00_r8, 3.60214e+00_r8, 3.56124e+00_r8, 3.52081e+00_r8, & + & 3.48083e+00_r8, 3.44131e+00_r8, 3.40224e+00_r8, 3.36361e+00_r8/) + kao_mco( 1, :, 6) = (/ & + & 1.21200e+01_r8, 1.21580e+01_r8, 1.21961e+01_r8, 1.22344e+01_r8, 1.22728e+01_r8, & + & 1.23113e+01_r8, 1.23499e+01_r8, 1.23886e+01_r8, 1.24275e+01_r8, 1.24664e+01_r8, & + & 1.25056e+01_r8, 1.25448e+01_r8, 1.25841e+01_r8, 1.26236e+01_r8, 1.26632e+01_r8, & + & 1.27029e+01_r8, 1.27428e+01_r8, 1.27827e+01_r8, 1.28228e+01_r8/) + kao_mco( 2, :, 6) = (/ & + & 1.25231e+01_r8, 1.25625e+01_r8, 1.26020e+01_r8, 1.26417e+01_r8, 1.26815e+01_r8, & + & 1.27214e+01_r8, 1.27614e+01_r8, 1.28015e+01_r8, 1.28418e+01_r8, 1.28822e+01_r8, & + & 1.29228e+01_r8, 1.29634e+01_r8, 1.30042e+01_r8, 1.30451e+01_r8, 1.30862e+01_r8, & + & 1.31274e+01_r8, 1.31687e+01_r8, 1.32101e+01_r8, 1.32517e+01_r8/) + kao_mco( 3, :, 6) = (/ & + & 1.27566e+01_r8, 1.27983e+01_r8, 1.28401e+01_r8, 1.28820e+01_r8, 1.29241e+01_r8, & + & 1.29663e+01_r8, 1.30087e+01_r8, 1.30512e+01_r8, 1.30938e+01_r8, 1.31366e+01_r8, & + & 1.31795e+01_r8, 1.32225e+01_r8, 1.32657e+01_r8, 1.33090e+01_r8, 1.33525e+01_r8, & + & 1.33961e+01_r8, 1.34399e+01_r8, 1.34838e+01_r8, 1.35278e+01_r8/) + kao_mco( 4, :, 6) = (/ & + & 1.27132e+01_r8, 1.27454e+01_r8, 1.27777e+01_r8, 1.28101e+01_r8, 1.28425e+01_r8, & + & 1.28750e+01_r8, 1.29077e+01_r8, 1.29403e+01_r8, 1.29731e+01_r8, 1.30060e+01_r8, & + & 1.30389e+01_r8, 1.30720e+01_r8, 1.31051e+01_r8, 1.31383e+01_r8, 1.31716e+01_r8, & + & 1.32049e+01_r8, 1.32384e+01_r8, 1.32719e+01_r8, 1.33055e+01_r8/) + kao_mco( 5, :, 6) = (/ & + & 1.33151e+01_r8, 1.33523e+01_r8, 1.33896e+01_r8, 1.34271e+01_r8, 1.34646e+01_r8, & + & 1.35022e+01_r8, 1.35400e+01_r8, 1.35779e+01_r8, 1.36158e+01_r8, 1.36539e+01_r8, & + & 1.36921e+01_r8, 1.37303e+01_r8, 1.37687e+01_r8, 1.38072e+01_r8, 1.38458e+01_r8, & + & 1.38846e+01_r8, 1.39234e+01_r8, 1.39623e+01_r8, 1.40013e+01_r8/) + kao_mco( 6, :, 6) = (/ & + & 1.41448e+01_r8, 1.41902e+01_r8, 1.42357e+01_r8, 1.42814e+01_r8, 1.43272e+01_r8, & + & 1.43732e+01_r8, 1.44194e+01_r8, 1.44656e+01_r8, 1.45121e+01_r8, 1.45586e+01_r8, & + & 1.46054e+01_r8, 1.46522e+01_r8, 1.46993e+01_r8, 1.47464e+01_r8, 1.47938e+01_r8, & + & 1.48413e+01_r8, 1.48889e+01_r8, 1.49367e+01_r8, 1.49846e+01_r8/) + kao_mco( 7, :, 6) = (/ & + & 1.56578e+01_r8, 1.56938e+01_r8, 1.57299e+01_r8, 1.57661e+01_r8, 1.58024e+01_r8, & + & 1.58388e+01_r8, 1.58752e+01_r8, 1.59117e+01_r8, 1.59484e+01_r8, 1.59851e+01_r8, & + & 1.60218e+01_r8, 1.60587e+01_r8, 1.60957e+01_r8, 1.61327e+01_r8, 1.61698e+01_r8, & + & 1.62070e+01_r8, 1.62443e+01_r8, 1.62817e+01_r8, 1.63192e+01_r8/) + kao_mco( 8, :, 6) = (/ & + & 1.73627e+01_r8, 1.74761e+01_r8, 1.75903e+01_r8, 1.77052e+01_r8, 1.78208e+01_r8, & + & 1.79373e+01_r8, 1.80544e+01_r8, 1.81724e+01_r8, 1.82911e+01_r8, 1.84106e+01_r8, & + & 1.85309e+01_r8, 1.86519e+01_r8, 1.87738e+01_r8, 1.88964e+01_r8, 1.90198e+01_r8, & + & 1.91441e+01_r8, 1.92692e+01_r8, 1.93950e+01_r8, 1.95217e+01_r8/) + kao_mco( 9, :, 6) = (/ & + & 7.16326e+00_r8, 7.12921e+00_r8, 7.09531e+00_r8, 7.06158e+00_r8, 7.02800e+00_r8, & + & 6.99459e+00_r8, 6.96133e+00_r8, 6.92824e+00_r8, 6.89530e+00_r8, 6.86252e+00_r8, & + & 6.82989e+00_r8, 6.79742e+00_r8, 6.76510e+00_r8, 6.73293e+00_r8, 6.70092e+00_r8, & + & 6.66906e+00_r8, 6.63736e+00_r8, 6.60580e+00_r8, 6.57439e+00_r8/) + kao_mco( 1, :, 7) = (/ & + & 2.09288e+01_r8, 2.10487e+01_r8, 2.11692e+01_r8, 2.12904e+01_r8, 2.14124e+01_r8, & + & 2.15350e+01_r8, 2.16583e+01_r8, 2.17823e+01_r8, 2.19070e+01_r8, 2.20325e+01_r8, & + & 2.21587e+01_r8, 2.22855e+01_r8, 2.24132e+01_r8, 2.25415e+01_r8, 2.26706e+01_r8, & + & 2.28004e+01_r8, 2.29310e+01_r8, 2.30623e+01_r8, 2.31943e+01_r8/) + kao_mco( 2, :, 7) = (/ & + & 2.08159e+01_r8, 2.09509e+01_r8, 2.10867e+01_r8, 2.12234e+01_r8, 2.13610e+01_r8, & + & 2.14994e+01_r8, 2.16388e+01_r8, 2.17791e+01_r8, 2.19202e+01_r8, 2.20623e+01_r8, & + & 2.22053e+01_r8, 2.23493e+01_r8, 2.24942e+01_r8, 2.26400e+01_r8, 2.27867e+01_r8, & + & 2.29345e+01_r8, 2.30831e+01_r8, 2.32328e+01_r8, 2.33834e+01_r8/) + kao_mco( 3, :, 7) = (/ & + & 2.10827e+01_r8, 2.12409e+01_r8, 2.14002e+01_r8, 2.15608e+01_r8, 2.17225e+01_r8, & + & 2.18855e+01_r8, 2.20497e+01_r8, 2.22151e+01_r8, 2.23818e+01_r8, 2.25497e+01_r8, & + & 2.27189e+01_r8, 2.28893e+01_r8, 2.30611e+01_r8, 2.32341e+01_r8, 2.34084e+01_r8, & + & 2.35840e+01_r8, 2.37609e+01_r8, 2.39392e+01_r8, 2.41188e+01_r8/) + kao_mco( 4, :, 7) = (/ & + & 2.13866e+01_r8, 2.15772e+01_r8, 2.17694e+01_r8, 2.19634e+01_r8, 2.21590e+01_r8, & + & 2.23565e+01_r8, 2.25556e+01_r8, 2.27566e+01_r8, 2.29594e+01_r8, 2.31639e+01_r8, & + & 2.33703e+01_r8, 2.35785e+01_r8, 2.37886e+01_r8, 2.40005e+01_r8, 2.42144e+01_r8, & + & 2.44301e+01_r8, 2.46477e+01_r8, 2.48673e+01_r8, 2.50889e+01_r8/) + kao_mco( 5, :, 7) = (/ & + & 1.93714e+01_r8, 1.95595e+01_r8, 1.97493e+01_r8, 1.99410e+01_r8, 2.01345e+01_r8, & + & 2.03300e+01_r8, 2.05273e+01_r8, 2.07265e+01_r8, 2.09277e+01_r8, 2.11308e+01_r8, & + & 2.13359e+01_r8, 2.15430e+01_r8, 2.17521e+01_r8, 2.19632e+01_r8, 2.21764e+01_r8, & + & 2.23917e+01_r8, 2.26090e+01_r8, 2.28284e+01_r8, 2.30500e+01_r8/) + kao_mco( 6, :, 7) = (/ & + & 1.70418e+01_r8, 1.72109e+01_r8, 1.73817e+01_r8, 1.75541e+01_r8, 1.77283e+01_r8, & + & 1.79041e+01_r8, 1.80818e+01_r8, 1.82612e+01_r8, 1.84423e+01_r8, 1.86253e+01_r8, & + & 1.88101e+01_r8, 1.89967e+01_r8, 1.91852e+01_r8, 1.93755e+01_r8, 1.95678e+01_r8, & + & 1.97619e+01_r8, 1.99580e+01_r8, 2.01560e+01_r8, 2.03560e+01_r8/) + kao_mco( 7, :, 7) = (/ & + & 1.31735e+01_r8, 1.32921e+01_r8, 1.34118e+01_r8, 1.35326e+01_r8, 1.36545e+01_r8, & + & 1.37775e+01_r8, 1.39015e+01_r8, 1.40267e+01_r8, 1.41531e+01_r8, 1.42805e+01_r8, & + & 1.44091e+01_r8, 1.45389e+01_r8, 1.46698e+01_r8, 1.48019e+01_r8, 1.49353e+01_r8, & + & 1.50698e+01_r8, 1.52055e+01_r8, 1.53424e+01_r8, 1.54806e+01_r8/) + kao_mco( 8, :, 7) = (/ & + & 4.97361e+00_r8, 4.96550e+00_r8, 4.95740e+00_r8, 4.94931e+00_r8, 4.94124e+00_r8, & + & 4.93318e+00_r8, 4.92513e+00_r8, 4.91709e+00_r8, 4.90907e+00_r8, 4.90106e+00_r8, & + & 4.89307e+00_r8, 4.88509e+00_r8, 4.87712e+00_r8, 4.86916e+00_r8, 4.86122e+00_r8, & + & 4.85329e+00_r8, 4.84537e+00_r8, 4.83747e+00_r8, 4.82958e+00_r8/) + kao_mco( 9, :, 7) = (/ & + & 1.76121e+01_r8, 1.75887e+01_r8, 1.75653e+01_r8, 1.75420e+01_r8, 1.75187e+01_r8, & + & 1.74955e+01_r8, 1.74722e+01_r8, 1.74490e+01_r8, 1.74259e+01_r8, 1.74027e+01_r8, & + & 1.73796e+01_r8, 1.73566e+01_r8, 1.73335e+01_r8, 1.73105e+01_r8, 1.72875e+01_r8, & + & 1.72646e+01_r8, 1.72416e+01_r8, 1.72188e+01_r8, 1.71959e+01_r8/) + kao_mco( 1, :, 8) = (/ & + & 5.99126e+00_r8, 6.08386e+00_r8, 6.17790e+00_r8, 6.27339e+00_r8, 6.37035e+00_r8, & + & 6.46881e+00_r8, 6.56880e+00_r8, 6.67033e+00_r8, 6.77343e+00_r8, 6.87812e+00_r8, & + & 6.98443e+00_r8, 7.09238e+00_r8, 7.20201e+00_r8, 7.31332e+00_r8, 7.42636e+00_r8, & + & 7.54115e+00_r8, 7.65771e+00_r8, 7.77607e+00_r8, 7.89626e+00_r8/) + kao_mco( 2, :, 8) = (/ & + & 4.71621e+00_r8, 4.78830e+00_r8, 4.86149e+00_r8, 4.93580e+00_r8, 5.01124e+00_r8, & + & 5.08784e+00_r8, 5.16561e+00_r8, 5.24456e+00_r8, 5.32473e+00_r8, 5.40612e+00_r8, & + & 5.48875e+00_r8, 5.57264e+00_r8, 5.65782e+00_r8, 5.74430e+00_r8, 5.83211e+00_r8, & + & 5.92125e+00_r8, 6.01176e+00_r8, 6.10365e+00_r8, 6.19694e+00_r8/) + kao_mco( 3, :, 8) = (/ & + & 2.77067e+00_r8, 2.81437e+00_r8, 2.85876e+00_r8, 2.90385e+00_r8, 2.94965e+00_r8, & + & 2.99617e+00_r8, 3.04343e+00_r8, 3.09143e+00_r8, 3.14019e+00_r8, 3.18972e+00_r8, & + & 3.24003e+00_r8, 3.29114e+00_r8, 3.34305e+00_r8, 3.39578e+00_r8, 3.44934e+00_r8, & + & 3.50374e+00_r8, 3.55901e+00_r8, 3.61514e+00_r8, 3.67216e+00_r8/) + kao_mco( 4, :, 8) = (/ & + & 1.22388e+00_r8, 1.24248e+00_r8, 1.26136e+00_r8, 1.28053e+00_r8, 1.29999e+00_r8, & + & 1.31974e+00_r8, 1.33979e+00_r8, 1.36015e+00_r8, 1.38082e+00_r8, 1.40181e+00_r8, & + & 1.42311e+00_r8, 1.44473e+00_r8, 1.46669e+00_r8, 1.48897e+00_r8, 1.51160e+00_r8, & + & 1.53457e+00_r8, 1.55789e+00_r8, 1.58156e+00_r8, 1.60559e+00_r8/) + kao_mco( 5, :, 8) = (/ & + & 1.41479e+00_r8, 1.43540e+00_r8, 1.45631e+00_r8, 1.47752e+00_r8, 1.49904e+00_r8, & + & 1.52088e+00_r8, 1.54303e+00_r8, 1.56550e+00_r8, 1.58831e+00_r8, 1.61144e+00_r8, & + & 1.63491e+00_r8, 1.65872e+00_r8, 1.68288e+00_r8, 1.70740e+00_r8, 1.73227e+00_r8, & + & 1.75750e+00_r8, 1.78310e+00_r8, 1.80907e+00_r8, 1.83542e+00_r8/) + kao_mco( 6, :, 8) = (/ & + & 1.43154e+00_r8, 1.46074e+00_r8, 1.49053e+00_r8, 1.52093e+00_r8, 1.55196e+00_r8, & + & 1.58361e+00_r8, 1.61591e+00_r8, 1.64887e+00_r8, 1.68250e+00_r8, 1.71682e+00_r8, & + & 1.75184e+00_r8, 1.78757e+00_r8, 1.82403e+00_r8, 1.86123e+00_r8, 1.89920e+00_r8, & + & 1.93793e+00_r8, 1.97746e+00_r8, 2.01779e+00_r8, 2.05895e+00_r8/) + kao_mco( 7, :, 8) = (/ & + & 2.49358e+00_r8, 2.56028e+00_r8, 2.62875e+00_r8, 2.69906e+00_r8, 2.77124e+00_r8, & + & 2.84536e+00_r8, 2.92146e+00_r8, 2.99960e+00_r8, 3.07982e+00_r8, 3.16219e+00_r8, & + & 3.24677e+00_r8, 3.33360e+00_r8, 3.42276e+00_r8, 3.51430e+00_r8, 3.60829e+00_r8, & + & 3.70480e+00_r8, 3.80388e+00_r8, 3.90562e+00_r8, 4.01007e+00_r8/) + kao_mco( 8, :, 8) = (/ & + & 4.32513e+00_r8, 4.39903e+00_r8, 4.47420e+00_r8, 4.55065e+00_r8, 4.62841e+00_r8, & + & 4.70750e+00_r8, 4.78794e+00_r8, 4.86975e+00_r8, 4.95296e+00_r8, 5.03759e+00_r8, & + & 5.12367e+00_r8, 5.21122e+00_r8, 5.30027e+00_r8, 5.39084e+00_r8, 5.48295e+00_r8, & + & 5.57664e+00_r8, 5.67193e+00_r8, 5.76885e+00_r8, 5.86743e+00_r8/) + kao_mco( 9, :, 8) = (/ & + & 3.35160e+01_r8, 3.36789e+01_r8, 3.38425e+01_r8, 3.40069e+01_r8, 3.41722e+01_r8, & + & 3.43382e+01_r8, 3.45050e+01_r8, 3.46727e+01_r8, 3.48412e+01_r8, 3.50105e+01_r8, & + & 3.51806e+01_r8, 3.53515e+01_r8, 3.55233e+01_r8, 3.56959e+01_r8, 3.58693e+01_r8, & + & 3.60436e+01_r8, 3.62187e+01_r8, 3.63947e+01_r8, 3.65715e+01_r8/) + kao_mco( 1, :, 9) = (/ & + & 8.68159e-01_r8, 9.13680e-01_r8, 9.61587e-01_r8, 1.01201e+00_r8, 1.06507e+00_r8, & + & 1.12091e+00_r8, 1.17969e+00_r8, 1.24154e+00_r8, 1.30664e+00_r8, 1.37515e+00_r8, & + & 1.44726e+00_r8, 1.52314e+00_r8, 1.60300e+00_r8, 1.68705e+00_r8, 1.77551e+00_r8, & + & 1.86861e+00_r8, 1.96658e+00_r8, 2.06970e+00_r8, 2.17822e+00_r8/) + kao_mco( 2, :, 9) = (/ & + & 9.04391e-01_r8, 9.49669e-01_r8, 9.97214e-01_r8, 1.04714e+00_r8, 1.09956e+00_r8, & + & 1.15461e+00_r8, 1.21242e+00_r8, 1.27312e+00_r8, 1.33685e+00_r8, 1.40378e+00_r8, & + & 1.47406e+00_r8, 1.54786e+00_r8, 1.62535e+00_r8, 1.70673e+00_r8, 1.79217e+00_r8, & + & 1.88190e+00_r8, 1.97611e+00_r8, 2.07505e+00_r8, 2.17893e+00_r8/) + kao_mco( 3, :, 9) = (/ & + & 9.67479e-01_r8, 1.01312e+00_r8, 1.06092e+00_r8, 1.11098e+00_r8, 1.16339e+00_r8, & + & 1.21828e+00_r8, 1.27576e+00_r8, 1.33595e+00_r8, 1.39898e+00_r8, 1.46499e+00_r8, & + & 1.53411e+00_r8, 1.60649e+00_r8, 1.68228e+00_r8, 1.76165e+00_r8, 1.84476e+00_r8, & + & 1.93180e+00_r8, 2.02294e+00_r8, 2.11839e+00_r8, 2.21833e+00_r8/) + kao_mco( 4, :, 9) = (/ & + & 1.05240e+00_r8, 1.09817e+00_r8, 1.14592e+00_r8, 1.19576e+00_r8, 1.24776e+00_r8, & + & 1.30202e+00_r8, 1.35864e+00_r8, 1.41772e+00_r8, 1.47937e+00_r8, 1.54371e+00_r8, & + & 1.61084e+00_r8, 1.68089e+00_r8, 1.75398e+00_r8, 1.83026e+00_r8, 1.90985e+00_r8, & + & 1.99290e+00_r8, 2.07957e+00_r8, 2.17000e+00_r8, 2.26437e+00_r8/) + kao_mco( 5, :, 9) = (/ & + & 1.25800e+00_r8, 1.30557e+00_r8, 1.35494e+00_r8, 1.40618e+00_r8, 1.45935e+00_r8, & + & 1.51454e+00_r8, 1.57181e+00_r8, 1.63125e+00_r8, 1.69293e+00_r8, 1.75695e+00_r8, & + & 1.82339e+00_r8, 1.89234e+00_r8, 1.96389e+00_r8, 2.03816e+00_r8, 2.11523e+00_r8, & + & 2.19522e+00_r8, 2.27823e+00_r8, 2.36438e+00_r8, 2.45378e+00_r8/) + kao_mco( 6, :, 9) = (/ & + & 1.76509e+00_r8, 1.80550e+00_r8, 1.84683e+00_r8, 1.88911e+00_r8, 1.93235e+00_r8, & + & 1.97658e+00_r8, 2.02183e+00_r8, 2.06811e+00_r8, 2.11546e+00_r8, 2.16388e+00_r8, & + & 2.21342e+00_r8, 2.26408e+00_r8, 2.31591e+00_r8, 2.36893e+00_r8, 2.42315e+00_r8, & + & 2.47862e+00_r8, 2.53536e+00_r8, 2.59340e+00_r8, 2.65277e+00_r8/) + kao_mco( 7, :, 9) = (/ & + & 2.03543e+00_r8, 2.05285e+00_r8, 2.07042e+00_r8, 2.08815e+00_r8, 2.10602e+00_r8, & + & 2.12405e+00_r8, 2.14223e+00_r8, 2.16057e+00_r8, 2.17907e+00_r8, 2.19772e+00_r8, & + & 2.21654e+00_r8, 2.23551e+00_r8, 2.25465e+00_r8, 2.27395e+00_r8, 2.29342e+00_r8, & + & 2.31305e+00_r8, 2.33285e+00_r8, 2.35282e+00_r8, 2.37296e+00_r8/) + kao_mco( 8, :, 9) = (/ & + & 3.18883e+00_r8, 3.20538e+00_r8, 3.22200e+00_r8, 3.23872e+00_r8, 3.25552e+00_r8, & + & 3.27241e+00_r8, 3.28939e+00_r8, 3.30645e+00_r8, 3.32360e+00_r8, 3.34085e+00_r8, & + & 3.35818e+00_r8, 3.37560e+00_r8, 3.39311e+00_r8, 3.41071e+00_r8, 3.42841e+00_r8, & + & 3.44619e+00_r8, 3.46407e+00_r8, 3.48204e+00_r8, 3.50011e+00_r8/) + kao_mco( 9, :, 9) = (/ & + & 3.97585e+00_r8, 3.96333e+00_r8, 3.95084e+00_r8, 3.93839e+00_r8, 3.92598e+00_r8, & + & 3.91361e+00_r8, 3.90128e+00_r8, 3.88899e+00_r8, 3.87674e+00_r8, 3.86452e+00_r8, & + & 3.85235e+00_r8, 3.84021e+00_r8, 3.82811e+00_r8, 3.81605e+00_r8, 3.80402e+00_r8, & + & 3.79204e+00_r8, 3.78009e+00_r8, 3.76818e+00_r8, 3.75631e+00_r8/) + kao_mco( 1, :,10) = (/ & + & 8.62646e-01_r8, 9.35164e-01_r8, 1.01378e+00_r8, 1.09900e+00_r8, 1.19139e+00_r8, & + & 1.29154e+00_r8, 1.40011e+00_r8, 1.51781e+00_r8, 1.64541e+00_r8, 1.78373e+00_r8, & + & 1.93367e+00_r8, 2.09623e+00_r8, 2.27245e+00_r8, 2.46348e+00_r8, 2.67057e+00_r8, & + & 2.89507e+00_r8, 3.13844e+00_r8, 3.40227e+00_r8, 3.68828e+00_r8/) + kao_mco( 2, :,10) = (/ & + & 8.04693e-01_r8, 8.72167e-01_r8, 9.45298e-01_r8, 1.02456e+00_r8, 1.11047e+00_r8, & + & 1.20358e+00_r8, 1.30450e+00_r8, 1.41389e+00_r8, 1.53244e+00_r8, 1.66094e+00_r8, & + & 1.80021e+00_r8, 1.95115e+00_r8, 2.11476e+00_r8, 2.29208e+00_r8, 2.48427e+00_r8, & + & 2.69258e+00_r8, 2.91835e+00_r8, 3.16305e+00_r8, 3.42827e+00_r8/) + kao_mco( 3, :,10) = (/ & + & 7.66566e-01_r8, 8.24651e-01_r8, 8.87137e-01_r8, 9.54358e-01_r8, 1.02667e+00_r8, & + & 1.10447e+00_r8, 1.18815e+00_r8, 1.27818e+00_r8, 1.37503e+00_r8, 1.47922e+00_r8, & + & 1.59131e+00_r8, 1.71189e+00_r8, 1.84160e+00_r8, 1.98114e+00_r8, 2.13126e+00_r8, & + & 2.29275e+00_r8, 2.46648e+00_r8, 2.65337e+00_r8, 2.85442e+00_r8/) + kao_mco( 4, :,10) = (/ & + & 5.40305e-01_r8, 5.77106e-01_r8, 6.16414e-01_r8, 6.58400e-01_r8, 7.03245e-01_r8, & + & 7.51145e-01_r8, 8.02307e-01_r8, 8.56954e-01_r8, 9.15323e-01_r8, 9.77668e-01_r8, & + & 1.04426e+00_r8, 1.11539e+00_r8, 1.19136e+00_r8, 1.27250e+00_r8, 1.35918e+00_r8, & + & 1.45175e+00_r8, 1.55064e+00_r8, 1.65625e+00_r8, 1.76906e+00_r8/) + kao_mco( 5, :,10) = (/ & + & 8.22474e-01_r8, 8.02911e-01_r8, 7.83814e-01_r8, 7.65171e-01_r8, 7.46971e-01_r8, & + & 7.29204e-01_r8, 7.11860e-01_r8, 6.94928e-01_r8, 6.78399e-01_r8, 6.62263e-01_r8, & + & 6.46511e-01_r8, 6.31133e-01_r8, 6.16122e-01_r8, 6.01467e-01_r8, 5.87161e-01_r8, & + & 5.73195e-01_r8, 5.59562e-01_r8, 5.46252e-01_r8, 5.33260e-01_r8/) + kao_mco( 6, :,10) = (/ & + & 1.28162e+00_r8, 1.25110e+00_r8, 1.22131e+00_r8, 1.19223e+00_r8, 1.16384e+00_r8, & + & 1.13613e+00_r8, 1.10908e+00_r8, 1.08267e+00_r8, 1.05689e+00_r8, 1.03173e+00_r8, & + & 1.00716e+00_r8, 9.83184e-01_r8, 9.59774e-01_r8, 9.36921e-01_r8, 9.14613e-01_r8, & + & 8.92836e-01_r8, 8.71577e-01_r8, 8.50825e-01_r8, 8.30567e-01_r8/) + kao_mco( 7, :,10) = (/ & + & 1.92679e+00_r8, 1.90551e+00_r8, 1.88446e+00_r8, 1.86365e+00_r8, 1.84307e+00_r8, & + & 1.82271e+00_r8, 1.80258e+00_r8, 1.78267e+00_r8, 1.76298e+00_r8, 1.74351e+00_r8, & + & 1.72425e+00_r8, 1.70520e+00_r8, 1.68637e+00_r8, 1.66774e+00_r8, 1.64932e+00_r8, & + & 1.63111e+00_r8, 1.61309e+00_r8, 1.59527e+00_r8, 1.57765e+00_r8/) + kao_mco( 8, :,10) = (/ & + & 4.66485e+00_r8, 4.60869e+00_r8, 4.55320e+00_r8, 4.49838e+00_r8, 4.44423e+00_r8, & + & 4.39072e+00_r8, 4.33786e+00_r8, 4.28563e+00_r8, 4.23404e+00_r8, 4.18306e+00_r8, & + & 4.13270e+00_r8, 4.08295e+00_r8, 4.03379e+00_r8, 3.98523e+00_r8, 3.93725e+00_r8, & + & 3.88985e+00_r8, 3.84301e+00_r8, 3.79675e+00_r8, 3.75104e+00_r8/) + kao_mco( 9, :,10) = (/ & + & 1.41505e+00_r8, 1.37820e+00_r8, 1.34232e+00_r8, 1.30736e+00_r8, 1.27332e+00_r8, & + & 1.24016e+00_r8, 1.20786e+00_r8, 1.17641e+00_r8, 1.14578e+00_r8, 1.11594e+00_r8, & + & 1.08688e+00_r8, 1.05858e+00_r8, 1.03101e+00_r8, 1.00416e+00_r8, 9.78015e-01_r8, & + & 9.52547e-01_r8, 9.27742e-01_r8, 9.03583e-01_r8, 8.80053e-01_r8/) + kao_mco( 1, :,11) = (/ & + & 3.40468e-03_r8, 4.05994e-03_r8, 4.84130e-03_r8, 5.77305e-03_r8, 6.88412e-03_r8, & + & 8.20902e-03_r8, 9.78890e-03_r8, 1.16728e-02_r8, 1.39194e-02_r8, 1.65983e-02_r8, & + & 1.97927e-02_r8, 2.36020e-02_r8, 2.81444e-02_r8, 3.35610e-02_r8, 4.00200e-02_r8, & + & 4.77222e-02_r8, 5.69067e-02_r8, 6.78588e-02_r8, 8.09187e-02_r8/) + kao_mco( 2, :,11) = (/ & + & 3.85021e-02_r8, 4.02208e-02_r8, 4.20162e-02_r8, 4.38918e-02_r8, 4.58512e-02_r8, & + & 4.78980e-02_r8, 5.00361e-02_r8, 5.22697e-02_r8, 5.46031e-02_r8, 5.70405e-02_r8, & + & 5.95868e-02_r8, 6.22468e-02_r8, 6.50254e-02_r8, 6.79282e-02_r8, 7.09605e-02_r8, & + & 7.41282e-02_r8, 7.74372e-02_r8, 8.08940e-02_r8, 8.45051e-02_r8/) + kao_mco( 3, :,11) = (/ & + & 5.24852e-01_r8, 5.10480e-01_r8, 4.96501e-01_r8, 4.82905e-01_r8, 4.69681e-01_r8, & + & 4.56820e-01_r8, 4.44310e-01_r8, 4.32143e-01_r8, 4.20310e-01_r8, 4.08800e-01_r8, & + & 3.97606e-01_r8, 3.86718e-01_r8, 3.76128e-01_r8, 3.65828e-01_r8, 3.55810e-01_r8, & + & 3.46067e-01_r8, 3.36590e-01_r8, 3.27373e-01_r8, 3.18409e-01_r8/) + kao_mco( 4, :,11) = (/ & + & 5.86290e-01_r8, 5.70241e-01_r8, 5.54632e-01_r8, 5.39450e-01_r8, 5.24683e-01_r8, & + & 5.10321e-01_r8, 4.96352e-01_r8, 4.82765e-01_r8, 4.69550e-01_r8, 4.56697e-01_r8, & + & 4.44196e-01_r8, 4.32036e-01_r8, 4.20210e-01_r8, 4.08708e-01_r8, 3.97520e-01_r8, & + & 3.86638e-01_r8, 3.76055e-01_r8, 3.65761e-01_r8, 3.55749e-01_r8/) + kao_mco( 5, :,11) = (/ & + & 1.66977e+00_r8, 1.61807e+00_r8, 1.56798e+00_r8, 1.51943e+00_r8, 1.47239e+00_r8, & + & 1.42681e+00_r8, 1.38264e+00_r8, 1.33983e+00_r8, 1.29835e+00_r8, 1.25815e+00_r8, & + & 1.21920e+00_r8, 1.18146e+00_r8, 1.14488e+00_r8, 1.10943e+00_r8, 1.07509e+00_r8, & + & 1.04180e+00_r8, 1.00955e+00_r8, 9.78295e-01_r8, 9.48008e-01_r8/) + kao_mco( 6, :,11) = (/ & + & 1.96627e+00_r8, 1.90948e+00_r8, 1.85432e+00_r8, 1.80076e+00_r8, 1.74875e+00_r8, & + & 1.69823e+00_r8, 1.64918e+00_r8, 1.60155e+00_r8, 1.55529e+00_r8, 1.51036e+00_r8, & + & 1.46674e+00_r8, 1.42437e+00_r8, 1.38323e+00_r8, 1.34328e+00_r8, 1.30448e+00_r8, & + & 1.26680e+00_r8, 1.23021e+00_r8, 1.19467e+00_r8, 1.16016e+00_r8/) + kao_mco( 7, :,11) = (/ & + & 1.67574e+00_r8, 1.63510e+00_r8, 1.59544e+00_r8, 1.55674e+00_r8, 1.51898e+00_r8, & + & 1.48213e+00_r8, 1.44618e+00_r8, 1.41111e+00_r8, 1.37688e+00_r8, 1.34348e+00_r8, & + & 1.31090e+00_r8, 1.27910e+00_r8, 1.24808e+00_r8, 1.21780e+00_r8, 1.18826e+00_r8, & + & 1.15944e+00_r8, 1.13132e+00_r8, 1.10388e+00_r8, 1.07710e+00_r8/) + kao_mco( 8, :,11) = (/ & + & 2.00764e+00_r8, 1.96233e+00_r8, 1.91803e+00_r8, 1.87474e+00_r8, 1.83242e+00_r8, & + & 1.79106e+00_r8, 1.75063e+00_r8, 1.71111e+00_r8, 1.67249e+00_r8, 1.63474e+00_r8, & + & 1.59784e+00_r8, 1.56177e+00_r8, 1.52652e+00_r8, 1.49206e+00_r8, 1.45838e+00_r8, & + & 1.42546e+00_r8, 1.39329e+00_r8, 1.36184e+00_r8, 1.33110e+00_r8/) + kao_mco( 9, :,11) = (/ & + & 1.83026e+00_r8, 1.77349e+00_r8, 1.71849e+00_r8, 1.66519e+00_r8, 1.61355e+00_r8, & + & 1.56350e+00_r8, 1.51501e+00_r8, 1.46803e+00_r8, 1.42250e+00_r8, 1.37838e+00_r8, & + & 1.33563e+00_r8, 1.29421e+00_r8, 1.25407e+00_r8, 1.21517e+00_r8, 1.17749e+00_r8, & + & 1.14097e+00_r8, 1.10558e+00_r8, 1.07129e+00_r8, 1.03807e+00_r8/) + kao_mco( 1, :,12) = (/ & + & 3.90309e-04_r8, 4.81310e-04_r8, 5.93528e-04_r8, 7.31909e-04_r8, 9.02554e-04_r8, & + & 1.11299e-03_r8, 1.37248e-03_r8, 1.69247e-03_r8, 2.08708e-03_r8, 2.57368e-03_r8, & + & 3.17374e-03_r8, 3.91370e-03_r8, 4.82617e-03_r8, 5.95140e-03_r8, 7.33897e-03_r8, & + & 9.05007e-03_r8, 1.11601e-02_r8, 1.37621e-02_r8, 1.69707e-02_r8/) + kao_mco( 2, :,12) = (/ & + & 9.80585e-02_r8, 9.77457e-02_r8, 9.74339e-02_r8, 9.71231e-02_r8, 9.68132e-02_r8, & + & 9.65044e-02_r8, 9.61965e-02_r8, 9.58897e-02_r8, 9.55838e-02_r8, 9.52789e-02_r8, & + & 9.49749e-02_r8, 9.46719e-02_r8, 9.43699e-02_r8, 9.40689e-02_r8, 9.37688e-02_r8, & + & 9.34697e-02_r8, 9.31715e-02_r8, 9.28743e-02_r8, 9.25780e-02_r8/) + kao_mco( 3, :,12) = (/ & + & 3.15258e-01_r8, 3.09936e-01_r8, 3.04704e-01_r8, 2.99560e-01_r8, 2.94503e-01_r8, & + & 2.89532e-01_r8, 2.84645e-01_r8, 2.79840e-01_r8, 2.75116e-01_r8, 2.70472e-01_r8, & + & 2.65906e-01_r8, 2.61417e-01_r8, 2.57004e-01_r8, 2.52666e-01_r8, 2.48401e-01_r8, & + & 2.44207e-01_r8, 2.40085e-01_r8, 2.36032e-01_r8, 2.32048e-01_r8/) + kao_mco( 4, :,12) = (/ & + & 9.74407e-01_r8, 9.46900e-01_r8, 9.20170e-01_r8, 8.94195e-01_r8, 8.68952e-01_r8, & + & 8.44422e-01_r8, 8.20585e-01_r8, 7.97421e-01_r8, 7.74910e-01_r8, 7.53035e-01_r8, & + & 7.31777e-01_r8, 7.11120e-01_r8, 6.91046e-01_r8, 6.71538e-01_r8, 6.52581e-01_r8, & + & 6.34159e-01_r8, 6.16257e-01_r8, 5.98861e-01_r8, 5.81956e-01_r8/) + kao_mco( 5, :,12) = (/ & + & 1.04234e+00_r8, 1.01364e+00_r8, 9.85726e-01_r8, 9.58581e-01_r8, 9.32184e-01_r8, & + & 9.06514e-01_r8, 8.81551e-01_r8, 8.57275e-01_r8, 8.33668e-01_r8, 8.10710e-01_r8, & + & 7.88385e-01_r8, 7.66675e-01_r8, 7.45563e-01_r8, 7.25032e-01_r8, 7.05066e-01_r8, & + & 6.85650e-01_r8, 6.66769e-01_r8, 6.48408e-01_r8, 6.30552e-01_r8/) + kao_mco( 6, :,12) = (/ & + & 1.79052e+00_r8, 1.73725e+00_r8, 1.68557e+00_r8, 1.63543e+00_r8, 1.58678e+00_r8, & + & 1.53957e+00_r8, 1.49377e+00_r8, 1.44933e+00_r8, 1.40622e+00_r8, 1.36439e+00_r8, & + & 1.32380e+00_r8, 1.28442e+00_r8, 1.24621e+00_r8, 1.20913e+00_r8, 1.17316e+00_r8, & + & 1.13826e+00_r8, 1.10440e+00_r8, 1.07155e+00_r8, 1.03967e+00_r8/) + kao_mco( 7, :,12) = (/ & + & 2.99551e+00_r8, 2.90366e+00_r8, 2.81462e+00_r8, 2.72831e+00_r8, 2.64464e+00_r8, & + & 2.56355e+00_r8, 2.48494e+00_r8, 2.40874e+00_r8, 2.33487e+00_r8, 2.26328e+00_r8, & + & 2.19387e+00_r8, 2.12660e+00_r8, 2.06139e+00_r8, 1.99818e+00_r8, 1.93690e+00_r8, & + & 1.87751e+00_r8, 1.81993e+00_r8, 1.76413e+00_r8, 1.71003e+00_r8/) + kao_mco( 8, :,12) = (/ & + & 2.89665e+00_r8, 2.81184e+00_r8, 2.72951e+00_r8, 2.64960e+00_r8, 2.57202e+00_r8, & + & 2.49672e+00_r8, 2.42362e+00_r8, 2.35266e+00_r8, 2.28378e+00_r8, 2.21692e+00_r8, & + & 2.15201e+00_r8, 2.08900e+00_r8, 2.02784e+00_r8, 1.96847e+00_r8, 1.91084e+00_r8, & + & 1.85489e+00_r8, 1.80059e+00_r8, 1.74787e+00_r8, 1.69669e+00_r8/) + kao_mco( 9, :,12) = (/ & + & 1.03145e+00_r8, 1.00335e+00_r8, 9.76014e-01_r8, 9.49426e-01_r8, 9.23561e-01_r8, & + & 8.98402e-01_r8, 8.73927e-01_r8, 8.50120e-01_r8, 8.26961e-01_r8, 8.04433e-01_r8, & + & 7.82518e-01_r8, 7.61201e-01_r8, 7.40464e-01_r8, 7.20293e-01_r8, 7.00670e-01_r8, & + & 6.81583e-01_r8, 6.63015e-01_r8, 6.44953e-01_r8, 6.27383e-01_r8/) + kao_mco( 1, :,13) = (/ & + & 5.27769e-04_r8, 6.65449e-04_r8, 8.39047e-04_r8, 1.05793e-03_r8, 1.33392e-03_r8, & + & 1.68190e-03_r8, 2.12066e-03_r8, 2.67388e-03_r8, 3.37143e-03_r8, 4.25094e-03_r8, & + & 5.35990e-03_r8, 6.75816e-03_r8, 8.52117e-03_r8, 1.07441e-02_r8, 1.35470e-02_r8, & + & 1.70810e-02_r8, 2.15370e-02_r8, 2.71554e-02_r8, 3.42395e-02_r8/) + kao_mco( 2, :,13) = (/ & + & 1.08329e-01_r8, 1.10179e-01_r8, 1.12060e-01_r8, 1.13974e-01_r8, 1.15920e-01_r8, & + & 1.17899e-01_r8, 1.19913e-01_r8, 1.21960e-01_r8, 1.24043e-01_r8, 1.26161e-01_r8, & + & 1.28316e-01_r8, 1.30507e-01_r8, 1.32735e-01_r8, 1.35002e-01_r8, 1.37307e-01_r8, & + & 1.39652e-01_r8, 1.42037e-01_r8, 1.44462e-01_r8, 1.46929e-01_r8/) + kao_mco( 3, :,13) = (/ & + & 1.95992e-01_r8, 1.94515e-01_r8, 1.93049e-01_r8, 1.91594e-01_r8, 1.90150e-01_r8, & + & 1.88717e-01_r8, 1.87294e-01_r8, 1.85882e-01_r8, 1.84481e-01_r8, 1.83091e-01_r8, & + & 1.81711e-01_r8, 1.80341e-01_r8, 1.78982e-01_r8, 1.77633e-01_r8, 1.76294e-01_r8, & + & 1.74965e-01_r8, 1.73646e-01_r8, 1.72337e-01_r8, 1.71038e-01_r8/) + kao_mco( 4, :,13) = (/ & + & 4.49766e-01_r8, 4.42749e-01_r8, 4.35841e-01_r8, 4.29042e-01_r8, 4.22348e-01_r8, & + & 4.15759e-01_r8, 4.09272e-01_r8, 4.02887e-01_r8, 3.96601e-01_r8, 3.90414e-01_r8, & + & 3.84323e-01_r8, 3.78327e-01_r8, 3.72424e-01_r8, 3.66614e-01_r8, 3.60894e-01_r8, & + & 3.55264e-01_r8, 3.49721e-01_r8, 3.44265e-01_r8, 3.38894e-01_r8/) + kao_mco( 5, :,13) = (/ & + & 1.07498e+00_r8, 1.04736e+00_r8, 1.02045e+00_r8, 9.94232e-01_r8, 9.68686e-01_r8, & + & 9.43797e-01_r8, 9.19547e-01_r8, 8.95920e-01_r8, 8.72900e-01_r8, 8.50471e-01_r8, & + & 8.28619e-01_r8, 8.07329e-01_r8, 7.86585e-01_r8, 7.66374e-01_r8, 7.46683e-01_r8, & + & 7.27498e-01_r8, 7.08805e-01_r8, 6.90593e-01_r8, 6.72849e-01_r8/) + kao_mco( 6, :,13) = (/ & + & 1.66569e+00_r8, 1.61740e+00_r8, 1.57052e+00_r8, 1.52500e+00_r8, 1.48080e+00_r8, & + & 1.43787e+00_r8, 1.39620e+00_r8, 1.35573e+00_r8, 1.31643e+00_r8, 1.27827e+00_r8, & + & 1.24122e+00_r8, 1.20524e+00_r8, 1.17031e+00_r8, 1.13638e+00_r8, 1.10344e+00_r8, & + & 1.07146e+00_r8, 1.04040e+00_r8, 1.01025e+00_r8, 9.80963e-01_r8/) + kao_mco( 7, :,13) = (/ & + & 1.52948e+00_r8, 1.48763e+00_r8, 1.44693e+00_r8, 1.40735e+00_r8, 1.36884e+00_r8, & + & 1.33139e+00_r8, 1.29497e+00_r8, 1.25954e+00_r8, 1.22508e+00_r8, 1.19156e+00_r8, & + & 1.15896e+00_r8, 1.12725e+00_r8, 1.09641e+00_r8, 1.06641e+00_r8, 1.03724e+00_r8, & + & 1.00886e+00_r8, 9.81259e-01_r8, 9.54412e-01_r8, 9.28301e-01_r8/) + kao_mco( 8, :,13) = (/ & + & 3.81027e+00_r8, 3.69422e+00_r8, 3.58170e+00_r8, 3.47261e+00_r8, 3.36684e+00_r8, & + & 3.26429e+00_r8, 3.16486e+00_r8, 3.06847e+00_r8, 2.97501e+00_r8, 2.88439e+00_r8, & + & 2.79654e+00_r8, 2.71136e+00_r8, 2.62878e+00_r8, 2.54871e+00_r8, 2.47108e+00_r8, & + & 2.39581e+00_r8, 2.32284e+00_r8, 2.25209e+00_r8, 2.18350e+00_r8/) + kao_mco( 9, :,13) = (/ & + & 1.12516e+00_r8, 1.09531e+00_r8, 1.06625e+00_r8, 1.03796e+00_r8, 1.01042e+00_r8, & + & 9.83616e-01_r8, 9.57520e-01_r8, 9.32117e-01_r8, 9.07387e-01_r8, 8.83314e-01_r8, & + & 8.59880e-01_r8, 8.37067e-01_r8, 8.14859e-01_r8, 7.93241e-01_r8, 7.72196e-01_r8, & + & 7.51709e-01_r8, 7.31766e-01_r8, 7.12352e-01_r8, 6.93454e-01_r8/) + kao_mco( 1, :,14) = (/ & + & 4.79165e-04_r8, 6.26966e-04_r8, 8.20356e-04_r8, 1.07340e-03_r8, 1.40450e-03_r8, & + & 1.83772e-03_r8, 2.40457e-03_r8, 3.14628e-03_r8, 4.11676e-03_r8, 5.38660e-03_r8, & + & 7.04813e-03_r8, 9.22216e-03_r8, 1.20668e-02_r8, 1.57889e-02_r8, 2.06590e-02_r8, & + & 2.70314e-02_r8, 3.53694e-02_r8, 4.62792e-02_r8, 6.05542e-02_r8/) + kao_mco( 2, :,14) = (/ & + & 4.75367e-04_r8, 6.21987e-04_r8, 8.13830e-04_r8, 1.06484e-03_r8, 1.39328e-03_r8, & + & 1.82302e-03_r8, 2.38530e-03_r8, 3.12101e-03_r8, 4.08365e-03_r8, 5.34318e-03_r8, & + & 6.99121e-03_r8, 9.14756e-03_r8, 1.19690e-02_r8, 1.56607e-02_r8, 2.04909e-02_r8, & + & 2.68111e-02_r8, 3.50806e-02_r8, 4.59007e-02_r8, 6.00580e-02_r8/) + kao_mco( 3, :,14) = (/ & + & 1.39594e-01_r8, 1.42407e-01_r8, 1.45276e-01_r8, 1.48202e-01_r8, 1.51188e-01_r8, & + & 1.54234e-01_r8, 1.57342e-01_r8, 1.60512e-01_r8, 1.63745e-01_r8, 1.67044e-01_r8, & + & 1.70410e-01_r8, 1.73843e-01_r8, 1.77345e-01_r8, 1.80918e-01_r8, 1.84563e-01_r8, & + & 1.88282e-01_r8, 1.92075e-01_r8, 1.95945e-01_r8, 1.99892e-01_r8/) + kao_mco( 4, :,14) = (/ & + & 2.73418e-01_r8, 2.71322e-01_r8, 2.69242e-01_r8, 2.67177e-01_r8, 2.65129e-01_r8, & + & 2.63096e-01_r8, 2.61079e-01_r8, 2.59077e-01_r8, 2.57091e-01_r8, 2.55120e-01_r8, & + & 2.53164e-01_r8, 2.51223e-01_r8, 2.49297e-01_r8, 2.47386e-01_r8, 2.45489e-01_r8, & + & 2.43607e-01_r8, 2.41739e-01_r8, 2.39886e-01_r8, 2.38047e-01_r8/) + kao_mco( 5, :,14) = (/ & + & 5.01880e-01_r8, 4.95066e-01_r8, 4.88344e-01_r8, 4.81713e-01_r8, 4.75173e-01_r8, & + & 4.68721e-01_r8, 4.62357e-01_r8, 4.56079e-01_r8, 4.49887e-01_r8, 4.43778e-01_r8, & + & 4.37753e-01_r8, 4.31809e-01_r8, 4.25946e-01_r8, 4.20163e-01_r8, 4.14458e-01_r8, & + & 4.08830e-01_r8, 4.03279e-01_r8, 3.97804e-01_r8, 3.92403e-01_r8/) + kao_mco( 6, :,14) = (/ & + & 9.46125e-01_r8, 9.29642e-01_r8, 9.13447e-01_r8, 8.97533e-01_r8, 8.81897e-01_r8, & + & 8.66533e-01_r8, 8.51437e-01_r8, 8.36603e-01_r8, 8.22029e-01_r8, 8.07708e-01_r8, & + & 7.93636e-01_r8, 7.79810e-01_r8, 7.66225e-01_r8, 7.52876e-01_r8, 7.39760e-01_r8, & + & 7.26872e-01_r8, 7.14209e-01_r8, 7.01766e-01_r8, 6.89540e-01_r8/) + kao_mco( 7, :,14) = (/ & + & 2.47697e+00_r8, 2.41183e+00_r8, 2.34840e+00_r8, 2.28664e+00_r8, 2.22650e+00_r8, & + & 2.16795e+00_r8, 2.11093e+00_r8, 2.05541e+00_r8, 2.00136e+00_r8, 1.94872e+00_r8, & + & 1.89747e+00_r8, 1.84757e+00_r8, 1.79898e+00_r8, 1.75167e+00_r8, 1.70560e+00_r8, & + & 1.66074e+00_r8, 1.61707e+00_r8, 1.57454e+00_r8, 1.53313e+00_r8/) + kao_mco( 8, :,14) = (/ & + & 2.19323e+00_r8, 2.13926e+00_r8, 2.08662e+00_r8, 2.03528e+00_r8, 1.98519e+00_r8, & + & 1.93635e+00_r8, 1.88870e+00_r8, 1.84222e+00_r8, 1.79689e+00_r8, 1.75268e+00_r8, & + & 1.70955e+00_r8, 1.66748e+00_r8, 1.62645e+00_r8, 1.58643e+00_r8, 1.54739e+00_r8, & + & 1.50932e+00_r8, 1.47218e+00_r8, 1.43595e+00_r8, 1.40062e+00_r8/) + kao_mco( 9, :,14) = (/ & + & 5.68351e-01_r8, 5.60360e-01_r8, 5.52481e-01_r8, 5.44712e-01_r8, 5.37053e-01_r8, & + & 5.29502e-01_r8, 5.22057e-01_r8, 5.14716e-01_r8, 5.07479e-01_r8, 5.00343e-01_r8, & + & 4.93308e-01_r8, 4.86372e-01_r8, 4.79533e-01_r8, 4.72790e-01_r8, 4.66142e-01_r8, & + & 4.59588e-01_r8, 4.53126e-01_r8, 4.46754e-01_r8, 4.40473e-01_r8/) + kao_mco( 1, :,15) = (/ & + & 7.87937e-04_r8, 1.01733e-03_r8, 1.31351e-03_r8, 1.69591e-03_r8, 2.18964e-03_r8, & + & 2.82712e-03_r8, 3.65018e-03_r8, 4.71286e-03_r8, 6.08493e-03_r8, 7.85644e-03_r8, & + & 1.01437e-02_r8, 1.30969e-02_r8, 1.69098e-02_r8, 2.18327e-02_r8, 2.81889e-02_r8, & + & 3.63956e-02_r8, 4.69915e-02_r8, 6.06722e-02_r8, 7.83357e-02_r8/) + kao_mco( 2, :,15) = (/ & + & 7.87937e-04_r8, 1.01733e-03_r8, 1.31351e-03_r8, 1.69591e-03_r8, 2.18964e-03_r8, & + & 2.82712e-03_r8, 3.65018e-03_r8, 4.71286e-03_r8, 6.08493e-03_r8, 7.85644e-03_r8, & + & 1.01437e-02_r8, 1.30969e-02_r8, 1.69098e-02_r8, 2.18327e-02_r8, 2.81889e-02_r8, & + & 3.63956e-02_r8, 4.69915e-02_r8, 6.06722e-02_r8, 7.83357e-02_r8/) + kao_mco( 3, :,15) = (/ & + & 1.97281e-01_r8, 2.00714e-01_r8, 2.04206e-01_r8, 2.07760e-01_r8, 2.11375e-01_r8, & + & 2.15053e-01_r8, 2.18795e-01_r8, 2.22603e-01_r8, 2.26476e-01_r8, 2.30417e-01_r8, & + & 2.34426e-01_r8, 2.38506e-01_r8, 2.42656e-01_r8, 2.46878e-01_r8, 2.51174e-01_r8, & + & 2.55545e-01_r8, 2.59992e-01_r8, 2.64516e-01_r8, 2.69119e-01_r8/) + kao_mco( 4, :,15) = (/ & + & 4.47509e-01_r8, 4.52222e-01_r8, 4.56985e-01_r8, 4.61799e-01_r8, 4.66663e-01_r8, & + & 4.71578e-01_r8, 4.76545e-01_r8, 4.81565e-01_r8, 4.86637e-01_r8, 4.91763e-01_r8, & + & 4.96942e-01_r8, 5.02177e-01_r8, 5.07466e-01_r8, 5.12811e-01_r8, 5.18213e-01_r8, & + & 5.23671e-01_r8, 5.29187e-01_r8, 5.34761e-01_r8, 5.40393e-01_r8/) + kao_mco( 5, :,15) = (/ & + & 1.02732e+00_r8, 1.02091e+00_r8, 1.01453e+00_r8, 1.00820e+00_r8, 1.00191e+00_r8, & + & 9.95660e-01_r8, 9.89447e-01_r8, 9.83273e-01_r8, 9.77137e-01_r8, 9.71039e-01_r8, & + & 9.64980e-01_r8, 9.58958e-01_r8, 9.52974e-01_r8, 9.47027e-01_r8, 9.41118e-01_r8, & + & 9.35245e-01_r8, 9.29409e-01_r8, 9.23609e-01_r8, 9.17846e-01_r8/) + kao_mco( 6, :,15) = (/ & + & 1.13766e+00_r8, 1.12944e+00_r8, 1.12128e+00_r8, 1.11318e+00_r8, 1.10514e+00_r8, & + & 1.09715e+00_r8, 1.08923e+00_r8, 1.08136e+00_r8, 1.07355e+00_r8, 1.06579e+00_r8, & + & 1.05809e+00_r8, 1.05045e+00_r8, 1.04286e+00_r8, 1.03532e+00_r8, 1.02784e+00_r8, & + & 1.02042e+00_r8, 1.01305e+00_r8, 1.00573e+00_r8, 9.98462e-01_r8/) + kao_mco( 7, :,15) = (/ & + & 1.13268e+00_r8, 1.12496e+00_r8, 1.11730e+00_r8, 1.10969e+00_r8, 1.10213e+00_r8, & + & 1.09462e+00_r8, 1.08717e+00_r8, 1.07976e+00_r8, 1.07241e+00_r8, 1.06510e+00_r8, & + & 1.05785e+00_r8, 1.05064e+00_r8, 1.04349e+00_r8, 1.03638e+00_r8, 1.02932e+00_r8, & + & 1.02231e+00_r8, 1.01535e+00_r8, 1.00843e+00_r8, 1.00156e+00_r8/) + kao_mco( 8, :,15) = (/ & + & 1.11982e+00_r8, 1.11343e+00_r8, 1.10707e+00_r8, 1.10075e+00_r8, 1.09447e+00_r8, & + & 1.08822e+00_r8, 1.08201e+00_r8, 1.07583e+00_r8, 1.06969e+00_r8, 1.06358e+00_r8, & + & 1.05751e+00_r8, 1.05147e+00_r8, 1.04547e+00_r8, 1.03950e+00_r8, 1.03356e+00_r8, & + & 1.02766e+00_r8, 1.02180e+00_r8, 1.01596e+00_r8, 1.01016e+00_r8/) + kao_mco( 9, :,15) = (/ & + & 1.03561e+00_r8, 1.02902e+00_r8, 1.02246e+00_r8, 1.01595e+00_r8, 1.00948e+00_r8, & + & 1.00305e+00_r8, 9.96667e-01_r8, 9.90320e-01_r8, 9.84013e-01_r8, 9.77747e-01_r8, & + & 9.71520e-01_r8, 9.65334e-01_r8, 9.59186e-01_r8, 9.53078e-01_r8, 9.47008e-01_r8, & + & 9.40978e-01_r8, 9.34985e-01_r8, 9.29031e-01_r8, 9.23115e-01_r8/) + kao_mco( 1, :,16) = (/ & + & 1.22217e-03_r8, 1.56836e-03_r8, 2.01261e-03_r8, 2.58271e-03_r8, 3.31429e-03_r8, & + & 4.25310e-03_r8, 5.45784e-03_r8, 7.00383e-03_r8, 8.98775e-03_r8, 1.15336e-02_r8, & + & 1.48007e-02_r8, 1.89931e-02_r8, 2.43731e-02_r8, 3.12771e-02_r8, 4.01367e-02_r8, & + & 5.15059e-02_r8, 6.60956e-02_r8, 8.48179e-02_r8, 1.08843e-01_r8/) + kao_mco( 2, :,16) = (/ & + & 1.22217e-03_r8, 1.56836e-03_r8, 2.01261e-03_r8, 2.58271e-03_r8, 3.31429e-03_r8, & + & 4.25310e-03_r8, 5.45784e-03_r8, 7.00383e-03_r8, 8.98775e-03_r8, 1.15336e-02_r8, & + & 1.48007e-02_r8, 1.89931e-02_r8, 2.43731e-02_r8, 3.12771e-02_r8, 4.01367e-02_r8, & + & 5.15059e-02_r8, 6.60956e-02_r8, 8.48179e-02_r8, 1.08843e-01_r8/) + kao_mco( 3, :,16) = (/ & + & 1.22217e-03_r8, 1.56836e-03_r8, 2.01261e-03_r8, 2.58271e-03_r8, 3.31429e-03_r8, & + & 4.25310e-03_r8, 5.45784e-03_r8, 7.00383e-03_r8, 8.98775e-03_r8, 1.15336e-02_r8, & + & 1.48007e-02_r8, 1.89931e-02_r8, 2.43731e-02_r8, 3.12771e-02_r8, 4.01367e-02_r8, & + & 5.15059e-02_r8, 6.60956e-02_r8, 8.48179e-02_r8, 1.08843e-01_r8/) + kao_mco( 4, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + kao_mco( 5, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + kao_mco( 6, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + kao_mco( 7, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + kao_mco( 8, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + kao_mco( 9, :,16) = (/ & + & 1.01221e+00_r8, 1.01660e+00_r8, 1.02101e+00_r8, 1.02544e+00_r8, 1.02989e+00_r8, & + & 1.03436e+00_r8, 1.03884e+00_r8, 1.04335e+00_r8, 1.04788e+00_r8, 1.05243e+00_r8, & + & 1.05699e+00_r8, 1.06158e+00_r8, 1.06619e+00_r8, 1.07081e+00_r8, 1.07546e+00_r8, & + & 1.08012e+00_r8, 1.08481e+00_r8, 1.08952e+00_r8, 1.09425e+00_r8/) + +! The array KBO_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! runs over the g-channel (1 to 16). + + kbo_mo3(:, 1) = (/ & + & 1.07596e-02_r8, 1.12146e-02_r8, 1.16887e-02_r8, 1.21830e-02_r8, 1.26981e-02_r8, & + & 1.32350e-02_r8, 1.37946e-02_r8, 1.43779e-02_r8, 1.49858e-02_r8, 1.56194e-02_r8, & + & 1.62799e-02_r8, 1.69682e-02_r8, 1.76857e-02_r8, 1.84334e-02_r8, 1.92129e-02_r8, & + & 2.00252e-02_r8, 2.08719e-02_r8, 2.17544e-02_r8, 2.26743e-02_r8/) + kbo_mo3(:, 2) = (/ & + & 9.48276e-02_r8, 9.66591e-02_r8, 9.85260e-02_r8, 1.00429e-01_r8, 1.02369e-01_r8, & + & 1.04346e-01_r8, 1.06361e-01_r8, 1.08416e-01_r8, 1.10510e-01_r8, 1.12644e-01_r8, & + & 1.14820e-01_r8, 1.17037e-01_r8, 1.19298e-01_r8, 1.21602e-01_r8, 1.23951e-01_r8, & + & 1.26345e-01_r8, 1.28785e-01_r8, 1.31273e-01_r8, 1.33808e-01_r8/) + kbo_mo3(:, 3) = (/ & + & 3.54721e-01_r8, 3.55779e-01_r8, 3.56841e-01_r8, 3.57906e-01_r8, 3.58973e-01_r8, & + & 3.60044e-01_r8, 3.61119e-01_r8, 3.62196e-01_r8, 3.63277e-01_r8, 3.64360e-01_r8, & + & 3.65448e-01_r8, 3.66538e-01_r8, 3.67631e-01_r8, 3.68728e-01_r8, 3.69828e-01_r8, & + & 3.70932e-01_r8, 3.72038e-01_r8, 3.73148e-01_r8, 3.74262e-01_r8/) + kbo_mo3(:, 4) = (/ & + & 6.46454e-01_r8, 6.43823e-01_r8, 6.41202e-01_r8, 6.38593e-01_r8, 6.35994e-01_r8, & + & 6.33405e-01_r8, 6.30827e-01_r8, 6.28260e-01_r8, 6.25703e-01_r8, 6.23156e-01_r8, & + & 6.20620e-01_r8, 6.18094e-01_r8, 6.15578e-01_r8, 6.13073e-01_r8, 6.10578e-01_r8, & + & 6.08093e-01_r8, 6.05618e-01_r8, 6.03153e-01_r8, 6.00698e-01_r8/) + kbo_mo3(:, 5) = (/ & + & 9.29832e-01_r8, 9.22877e-01_r8, 9.15975e-01_r8, 9.09124e-01_r8, 9.02324e-01_r8, & + & 8.95576e-01_r8, 8.88877e-01_r8, 8.82229e-01_r8, 8.75631e-01_r8, 8.69082e-01_r8, & + & 8.62582e-01_r8, 8.56130e-01_r8, 8.49727e-01_r8, 8.43372e-01_r8, 8.37064e-01_r8, & + & 8.30803e-01_r8, 8.24589e-01_r8, 8.18422e-01_r8, 8.12301e-01_r8/) + kbo_mo3(:, 6) = (/ & + & 1.43531e+00_r8, 1.42616e+00_r8, 1.41706e+00_r8, 1.40802e+00_r8, 1.39903e+00_r8, & + & 1.39010e+00_r8, 1.38124e+00_r8, 1.37242e+00_r8, 1.36367e+00_r8, 1.35496e+00_r8, & + & 1.34632e+00_r8, 1.33773e+00_r8, 1.32919e+00_r8, 1.32071e+00_r8, 1.31229e+00_r8, & + & 1.30391e+00_r8, 1.29559e+00_r8, 1.28733e+00_r8, 1.27911e+00_r8/) + kbo_mo3(:, 7) = (/ & + & 2.68664e+00_r8, 2.67196e+00_r8, 2.65736e+00_r8, 2.64284e+00_r8, 2.62840e+00_r8, & + & 2.61404e+00_r8, 2.59975e+00_r8, 2.58555e+00_r8, 2.57142e+00_r8, 2.55737e+00_r8, & + & 2.54340e+00_r8, 2.52950e+00_r8, 2.51568e+00_r8, 2.50193e+00_r8, 2.48826e+00_r8, & + & 2.47466e+00_r8, 2.46114e+00_r8, 2.44769e+00_r8, 2.43432e+00_r8/) + kbo_mo3(:, 8) = (/ & + & 2.45343e+00_r8, 2.43442e+00_r8, 2.41556e+00_r8, 2.39684e+00_r8, 2.37827e+00_r8, & + & 2.35984e+00_r8, 2.34156e+00_r8, 2.32342e+00_r8, 2.30541e+00_r8, 2.28755e+00_r8, & + & 2.26983e+00_r8, 2.25224e+00_r8, 2.23479e+00_r8, 2.21747e+00_r8, 2.20029e+00_r8, & + & 2.18324e+00_r8, 2.16633e+00_r8, 2.14954e+00_r8, 2.13289e+00_r8/) + kbo_mo3(:, 9) = (/ & + & 1.55879e-01_r8, 1.55998e-01_r8, 1.56118e-01_r8, 1.56238e-01_r8, 1.56358e-01_r8, & + & 1.56478e-01_r8, 1.56599e-01_r8, 1.56719e-01_r8, 1.56840e-01_r8, 1.56960e-01_r8, & + & 1.57081e-01_r8, 1.57201e-01_r8, 1.57322e-01_r8, 1.57443e-01_r8, 1.57564e-01_r8, & + & 1.57685e-01_r8, 1.57806e-01_r8, 1.57928e-01_r8, 1.58049e-01_r8/) + kbo_mo3(:,10) = (/ & + & 8.75149e-03_r8, 8.88794e-03_r8, 9.02651e-03_r8, 9.16725e-03_r8, 9.31018e-03_r8, & + & 9.45534e-03_r8, 9.60276e-03_r8, 9.75248e-03_r8, 9.90454e-03_r8, 1.00590e-02_r8, & + & 1.02158e-02_r8, 1.03751e-02_r8, 1.05368e-02_r8, 1.07011e-02_r8, 1.08680e-02_r8, & + & 1.10374e-02_r8, 1.12095e-02_r8, 1.13843e-02_r8, 1.15618e-02_r8/) + kbo_mo3(:,11) = (/ & + & 8.83874e-03_r8, 8.97926e-03_r8, 9.12201e-03_r8, 9.26703e-03_r8, 9.41436e-03_r8, & + & 9.56403e-03_r8, 9.71608e-03_r8, 9.87055e-03_r8, 1.00275e-02_r8, 1.01869e-02_r8, & + & 1.03488e-02_r8, 1.05134e-02_r8, 1.06805e-02_r8, 1.08503e-02_r8, 1.10228e-02_r8, & + & 1.11980e-02_r8, 1.13761e-02_r8, 1.15569e-02_r8, 1.17407e-02_r8/) + kbo_mo3(:,12) = (/ & + & 9.59461e-03_r8, 9.70417e-03_r8, 9.81498e-03_r8, 9.92705e-03_r8, 1.00404e-02_r8, & + & 1.01550e-02_r8, 1.02710e-02_r8, 1.03883e-02_r8, 1.05069e-02_r8, 1.06269e-02_r8, & + & 1.07482e-02_r8, 1.08709e-02_r8, 1.09951e-02_r8, 1.11206e-02_r8, 1.12476e-02_r8, & + & 1.13760e-02_r8, 1.15059e-02_r8, 1.16373e-02_r8, 1.17702e-02_r8/) + kbo_mo3(:,13) = (/ & + & 1.13077e-02_r8, 1.14079e-02_r8, 1.15089e-02_r8, 1.16109e-02_r8, 1.17138e-02_r8, & + & 1.18176e-02_r8, 1.19223e-02_r8, 1.20279e-02_r8, 1.21344e-02_r8, 1.22419e-02_r8, & + & 1.23504e-02_r8, 1.24598e-02_r8, 1.25702e-02_r8, 1.26816e-02_r8, 1.27939e-02_r8, & + & 1.29073e-02_r8, 1.30216e-02_r8, 1.31370e-02_r8, 1.32534e-02_r8/) + kbo_mo3(:,14) = (/ & + & 6.74844e-03_r8, 6.82637e-03_r8, 6.90519e-03_r8, 6.98493e-03_r8, 7.06558e-03_r8, & + & 7.14717e-03_r8, 7.22970e-03_r8, 7.31318e-03_r8, 7.39762e-03_r8, 7.48304e-03_r8, & + & 7.56945e-03_r8, 7.65686e-03_r8, 7.74527e-03_r8, 7.83470e-03_r8, 7.92517e-03_r8, & + & 8.01668e-03_r8, 8.10925e-03_r8, 8.20289e-03_r8, 8.29761e-03_r8/) + kbo_mo3(:,15) = (/ & + & 7.94595e-03_r8, 8.00015e-03_r8, 8.05472e-03_r8, 8.10966e-03_r8, 8.16497e-03_r8, & + & 8.22067e-03_r8, 8.27674e-03_r8, 8.33320e-03_r8, 8.39004e-03_r8, 8.44727e-03_r8, & + & 8.50489e-03_r8, 8.56290e-03_r8, 8.62130e-03_r8, 8.68011e-03_r8, 8.73932e-03_r8, & + & 8.79893e-03_r8, 8.85895e-03_r8, 8.91937e-03_r8, 8.98021e-03_r8/) + kbo_mo3(:,16) = (/ & + & 1.85967e-03_r8, 1.86082e-03_r8, 1.86197e-03_r8, 1.86312e-03_r8, 1.86428e-03_r8, & + & 1.86543e-03_r8, 1.86658e-03_r8, 1.86774e-03_r8, 1.86889e-03_r8, 1.87005e-03_r8, & + & 1.87121e-03_r8, 1.87236e-03_r8, 1.87352e-03_r8, 1.87468e-03_r8, 1.87584e-03_r8, & + & 1.87700e-03_r8, 1.87816e-03_r8, 1.87932e-03_r8, 1.88049e-03_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &1.6586e-05_r8,1.9995e-05_r8,1.8582e-05_r8,1.3988e-05_r8,1.3650e-05_r8,1.1079e-05_r8, & + &9.5855e-06_r8,8.4062e-06_r8,1.3558e-05_r8,1.8620e-05_r8,2.2652e-05_r8,1.7883e-05_r8, & + &2.6241e-05_r8,3.1171e-05_r8,3.9386e-05_r8,4.4415e-05_r8/) + forrefo(2,:) = (/ & + &2.0730e-05_r8,2.3258e-05_r8,2.1543e-05_r8,1.5660e-05_r8,9.7872e-06_r8,8.1078e-06_r8, & + &7.0246e-06_r8,6.0428e-06_r8,4.8793e-06_r8,4.4937e-06_r8,4.7078e-06_r8,4.6898e-06_r8, & + &6.9481e-06_r8,8.6269e-06_r8,3.1761e-06_r8,3.1440e-06_r8/) + forrefo(3,:) = (/ & + &1.5737e-05_r8,2.2501e-05_r8,2.3520e-05_r8,2.0288e-05_r8,1.2083e-05_r8,6.8256e-06_r8, & + &6.0637e-06_r8,5.5434e-06_r8,4.3888e-06_r8,3.8435e-06_r8,3.8477e-06_r8,3.8314e-06_r8, & + &3.8251e-06_r8,3.3637e-06_r8,3.1950e-06_r8,3.1440e-06_r8/) + forrefo(4,:) = (/ & + &1.1400e-05_r8,7.9751e-06_r8,8.8659e-06_r8,1.5884e-05_r8,1.9118e-05_r8,1.9429e-05_r8, & + &2.0532e-05_r8,2.2155e-05_r8,2.3894e-05_r8,2.2984e-05_r8,2.3731e-05_r8,2.4538e-05_r8, & + &2.6697e-05_r8,1.9329e-05_r8,3.3306e-06_r8,3.2018e-06_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 9.62275e-03_r8, 8.29909e-03_r8, 7.15750e-03_r8, 6.17294e-03_r8, 5.32382e-03_r8, & + & 4.59150e-03_r8, 3.95991e-03_r8, 3.41520e-03_r8, 2.94542e-03_r8, 2.54026e-03_r8/) + selfrefo(:, 2) = (/ & + & 9.76664e-03_r8, 8.47783e-03_r8, 7.35910e-03_r8, 6.38799e-03_r8, 5.54504e-03_r8, & + & 4.81331e-03_r8, 4.17815e-03_r8, 3.62680e-03_r8, 3.14821e-03_r8, 2.73277e-03_r8/) + selfrefo(:, 3) = (/ & + & 9.53856e-03_r8, 8.23750e-03_r8, 7.11390e-03_r8, 6.14356e-03_r8, 5.30558e-03_r8, & + & 4.58190e-03_r8, 3.95693e-03_r8, 3.41720e-03_r8, 2.95109e-03_r8, 2.54856e-03_r8/) + selfrefo(:, 4) = (/ & + & 8.47621e-03_r8, 7.29518e-03_r8, 6.27870e-03_r8, 5.40385e-03_r8, 4.65091e-03_r8, & + & 4.00287e-03_r8, 3.44513e-03_r8, 2.96510e-03_r8, 2.55196e-03_r8, 2.19638e-03_r8/) + selfrefo(:, 5) = (/ & + & 6.71258e-03_r8, 5.95346e-03_r8, 5.28020e-03_r8, 4.68307e-03_r8, 4.15348e-03_r8, & + & 3.68377e-03_r8, 3.26718e-03_r8, 2.89770e-03_r8, 2.57000e-03_r8, 2.27937e-03_r8/) + selfrefo(:, 6) = (/ & + & 6.29140e-03_r8, 5.55557e-03_r8, 4.90580e-03_r8, 4.33203e-03_r8, 3.82536e-03_r8, & + & 3.37795e-03_r8, 2.98287e-03_r8, 2.63400e-03_r8, 2.32593e-03_r8, 2.05389e-03_r8/) + selfrefo(:, 7) = (/ & + & 6.00229e-03_r8, 5.28180e-03_r8, 4.64780e-03_r8, 4.08990e-03_r8, 3.59897e-03_r8, & + & 3.16696e-03_r8, 2.78682e-03_r8, 2.45230e-03_r8, 2.15794e-03_r8, 1.89891e-03_r8/) + selfrefo(:, 8) = (/ & + & 5.78892e-03_r8, 5.07191e-03_r8, 4.44370e-03_r8, 3.89330e-03_r8, 3.41108e-03_r8, & + & 2.98858e-03_r8, 2.61842e-03_r8, 2.29410e-03_r8, 2.00995e-03_r8, 1.76100e-03_r8/) + selfrefo(:, 9) = (/ & + & 4.96186e-03_r8, 4.56767e-03_r8, 4.20480e-03_r8, 3.87076e-03_r8, 3.56325e-03_r8, & + & 3.28017e-03_r8, 3.01959e-03_r8, 2.77970e-03_r8, 2.55887e-03_r8, 2.35559e-03_r8/) + selfrefo(:,10) = (/ & + & 4.56849e-03_r8, 4.35527e-03_r8, 4.15200e-03_r8, 3.95822e-03_r8, 3.77348e-03_r8, & + & 3.59736e-03_r8, 3.42946e-03_r8, 3.26940e-03_r8, 3.11681e-03_r8, 2.97134e-03_r8/) + selfrefo(:,11) = (/ & + & 4.47310e-03_r8, 4.32453e-03_r8, 4.18090e-03_r8, 4.04204e-03_r8, 3.90779e-03_r8, & + & 3.77799e-03_r8, 3.65251e-03_r8, 3.53120e-03_r8, 3.41392e-03_r8, 3.30053e-03_r8/) + selfrefo(:,12) = (/ & + & 4.46459e-03_r8, 4.24031e-03_r8, 4.02730e-03_r8, 3.82499e-03_r8, 3.63284e-03_r8, & + & 3.45035e-03_r8, 3.27702e-03_r8, 3.11240e-03_r8, 2.95605e-03_r8, 2.80755e-03_r8/) + selfrefo(:,13) = (/ & + & 4.43961e-03_r8, 4.35658e-03_r8, 4.27510e-03_r8, 4.19514e-03_r8, 4.11669e-03_r8, & + & 4.03969e-03_r8, 3.96414e-03_r8, 3.89000e-03_r8, 3.81725e-03_r8, 3.74585e-03_r8/) + selfrefo(:,14) = (/ & + & 4.40512e-03_r8, 4.41515e-03_r8, 4.42520e-03_r8, 4.43527e-03_r8, 4.44537e-03_r8, & + & 4.45549e-03_r8, 4.46563e-03_r8, 4.47580e-03_r8, 4.48599e-03_r8, 4.49620e-03_r8/) + selfrefo(:,15) = (/ & + & 3.21965e-03_r8, 3.42479e-03_r8, 3.64300e-03_r8, 3.87512e-03_r8, 4.12202e-03_r8, & + & 4.38466e-03_r8, 4.66403e-03_r8, 4.96120e-03_r8, 5.27731e-03_r8, 5.61355e-03_r8/) + selfrefo(:,16) = (/ & + & 3.11402e-03_r8, 3.35870e-03_r8, 3.62260e-03_r8, 3.90724e-03_r8, 4.21424e-03_r8, & + & 4.54536e-03_r8, 4.90250e-03_r8, 5.28770e-03_r8, 5.70317e-03_r8, 6.15128e-03_r8/) + + end subroutine lw_kgb13 + +! ************************************************************************** + subroutine lw_kgb14 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg14, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 142.5940 mb, T = 215.70 K + fracrefao(:) = (/ & + & 1.9360e-01_r8, 1.7276e-01_r8, 1.4811e-01_r8, 1.2238e-01_r8, & + & 1.0242e-01_r8, 8.6830e-02_r8, 7.1890e-02_r8, 5.4030e-02_r8, & + & 3.5075e-02_r8, 3.8052e-03_r8, 3.1458e-03_r8, 2.4873e-03_r8, & + & 1.8182e-03_r8, 1.1563e-03_r8, 4.3251e-04_r8, 5.7744e-05_r8/) + +! Planck fraction mapping level : P = 4.758820mb, T = 250.85 K + fracrefbo(:) = (/ & + & 1.8599e-01_r8, 1.6646e-01_r8, 1.4264e-01_r8, 1.2231e-01_r8, & + & 1.0603e-01_r8, 9.2014e-02_r8, 7.5287e-02_r8, 5.6758e-02_r8, & + & 3.8386e-02_r8, 4.2139e-03_r8, 3.5399e-03_r8, 2.7381e-03_r8, & + & 1.9202e-03_r8, 1.2083e-03_r8, 4.5395e-04_r8, 6.2699e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1) = (/ & + &3.5183e-01_r8,3.7165e-01_r8,3.9536e-01_r8,4.2364e-01_r8,4.5645e-01_r8/) + kao(:, 2, 1) = (/ & + &2.9958e-01_r8,3.1568e-01_r8,3.3580e-01_r8,3.6030e-01_r8,3.8890e-01_r8/) + kao(:, 3, 1) = (/ & + &2.5105e-01_r8,2.6327e-01_r8,2.7913e-01_r8,2.9918e-01_r8,3.2278e-01_r8/) + kao(:, 4, 1) = (/ & + &2.0894e-01_r8,2.1786e-01_r8,2.3000e-01_r8,2.4588e-01_r8,2.6517e-01_r8/) + kao(:, 5, 1) = (/ & + &1.7343e-01_r8,1.7993e-01_r8,1.8907e-01_r8,2.0143e-01_r8,2.1685e-01_r8/) + kao(:, 6, 1) = (/ & + &1.4374e-01_r8,1.4829e-01_r8,1.5503e-01_r8,1.6436e-01_r8,1.7642e-01_r8/) + kao(:, 7, 1) = (/ & + &1.1916e-01_r8,1.2232e-01_r8,1.2721e-01_r8,1.3426e-01_r8,1.4361e-01_r8/) + kao(:, 8, 1) = (/ & + &9.8898e-02_r8,1.0120e-01_r8,1.0467e-01_r8,1.0982e-01_r8,1.1705e-01_r8/) + kao(:, 9, 1) = (/ & + &8.2212e-02_r8,8.3740e-02_r8,8.6244e-02_r8,9.0121e-02_r8,9.5602e-02_r8/) + kao(:,10, 1) = (/ & + &6.8330e-02_r8,6.9351e-02_r8,7.1210e-02_r8,7.4137e-02_r8,7.8349e-02_r8/) + kao(:,11, 1) = (/ & + &5.6910e-02_r8,5.7856e-02_r8,5.9557e-02_r8,6.2211e-02_r8,6.6055e-02_r8/) + kao(:,12, 1) = (/ & + &4.7279e-02_r8,4.8187e-02_r8,4.9716e-02_r8,5.2169e-02_r8,5.5693e-02_r8/) + kao(:,13, 1) = (/ & + &3.9228e-02_r8,4.0055e-02_r8,4.1480e-02_r8,4.3734e-02_r8,4.6826e-02_r8/) + kao(:, 1, 2) = (/ & + &1.2827e+00_r8,1.3853e+00_r8,1.5108e+00_r8,1.6643e+00_r8,1.8505e+00_r8/) + kao(:, 2, 2) = (/ & + &1.1042e+00_r8,1.1988e+00_r8,1.3140e+00_r8,1.4542e+00_r8,1.6229e+00_r8/) + kao(:, 3, 2) = (/ & + &9.2790e-01_r8,1.0121e+00_r8,1.1133e+00_r8,1.2349e+00_r8,1.3807e+00_r8/) + kao(:, 4, 2) = (/ & + &7.7001e-01_r8,8.4339e-01_r8,9.3172e-01_r8,1.0366e+00_r8,1.1604e+00_r8/) + kao(:, 5, 2) = (/ & + &6.3550e-01_r8,6.9915e-01_r8,7.7552e-01_r8,8.6518e-01_r8,9.7050e-01_r8/) + kao(:, 6, 2) = (/ & + &5.2058e-01_r8,5.7460e-01_r8,6.3982e-01_r8,7.1578e-01_r8,8.0435e-01_r8/) + kao(:, 7, 2) = (/ & + &4.2451e-01_r8,4.7028e-01_r8,5.2464e-01_r8,5.8830e-01_r8,6.6179e-01_r8/) + kao(:, 8, 2) = (/ & + &3.4539e-01_r8,3.8222e-01_r8,4.2607e-01_r8,4.7789e-01_r8,5.3786e-01_r8/) + kao(:, 9, 2) = (/ & + &2.7941e-01_r8,3.0849e-01_r8,3.4320e-01_r8,3.8420e-01_r8,4.3240e-01_r8/) + kao(:,10, 2) = (/ & + &2.2666e-01_r8,2.5024e-01_r8,2.7777e-01_r8,3.1051e-01_r8,3.4934e-01_r8/) + kao(:,11, 2) = (/ & + &1.9193e-01_r8,2.1218e-01_r8,2.3589e-01_r8,2.6422e-01_r8,2.9804e-01_r8/) + kao(:,12, 2) = (/ & + &1.6216e-01_r8,1.7954e-01_r8,2.0015e-01_r8,2.2464e-01_r8,2.5376e-01_r8/) + kao(:,13, 2) = (/ & + &1.3654e-01_r8,1.5163e-01_r8,1.6956e-01_r8,1.9071e-01_r8,2.1617e-01_r8/) + kao(:, 1, 3) = (/ & + &5.3312e+00_r8,5.9534e+00_r8,6.6227e+00_r8,7.3398e+00_r8,8.1099e+00_r8/) + kao(:, 2, 3) = (/ & + &4.6807e+00_r8,5.2433e+00_r8,5.8458e+00_r8,6.4988e+00_r8,7.1971e+00_r8/) + kao(:, 3, 3) = (/ & + &3.9284e+00_r8,4.4200e+00_r8,4.9505e+00_r8,5.5235e+00_r8,6.1336e+00_r8/) + kao(:, 4, 3) = (/ & + &3.2160e+00_r8,3.6333e+00_r8,4.0896e+00_r8,4.5842e+00_r8,5.1138e+00_r8/) + kao(:, 5, 3) = (/ & + &2.5935e+00_r8,2.9443e+00_r8,3.3309e+00_r8,3.7529e+00_r8,4.2079e+00_r8/) + kao(:, 6, 3) = (/ & + &2.0555e+00_r8,2.3468e+00_r8,2.6695e+00_r8,3.0246e+00_r8,3.4114e+00_r8/) + kao(:, 7, 3) = (/ & + &1.6122e+00_r8,1.8522e+00_r8,2.1211e+00_r8,2.4178e+00_r8,2.7436e+00_r8/) + kao(:, 8, 3) = (/ & + &1.2572e+00_r8,1.4549e+00_r8,1.6787e+00_r8,1.9278e+00_r8,2.2011e+00_r8/) + kao(:, 9, 3) = (/ & + &9.7554e-01_r8,1.1374e+00_r8,1.3224e+00_r8,1.5307e+00_r8,1.7599e+00_r8/) + kao(:,10, 3) = (/ & + &7.6412e-01_r8,8.9744e-01_r8,1.0509e+00_r8,1.2253e+00_r8,1.4183e+00_r8/) + kao(:,11, 3) = (/ & + &6.4606e-01_r8,7.6360e-01_r8,8.9925e-01_r8,1.0524e+00_r8,1.2194e+00_r8/) + kao(:,12, 3) = (/ & + &5.4819e-01_r8,6.5159e-01_r8,7.6939e-01_r8,8.9987e-01_r8,1.0405e+00_r8/) + kao(:,13, 3) = (/ & + &4.6584e-01_r8,5.5439e-01_r8,6.5378e-01_r8,7.6270e-01_r8,8.8077e-01_r8/) + kao(:, 1, 4) = (/ & + &1.6140e+01_r8,1.7514e+01_r8,1.8771e+01_r8,1.9886e+01_r8,2.0829e+01_r8/) + kao(:, 2, 4) = (/ & + &1.4035e+01_r8,1.5167e+01_r8,1.6185e+01_r8,1.7079e+01_r8,1.7864e+01_r8/) + kao(:, 3, 4) = (/ & + &1.2090e+01_r8,1.3039e+01_r8,1.3889e+01_r8,1.4653e+01_r8,1.5339e+01_r8/) + kao(:, 4, 4) = (/ & + &1.0243e+01_r8,1.1063e+01_r8,1.1803e+01_r8,1.2472e+01_r8,1.3075e+01_r8/) + kao(:, 5, 4) = (/ & + &8.5658e+00_r8,9.2747e+00_r8,9.9250e+00_r8,1.0511e+01_r8,1.1040e+01_r8/) + kao(:, 6, 4) = (/ & + &7.0689e+00_r8,7.6839e+00_r8,8.2525e+00_r8,8.7702e+00_r8,9.2411e+00_r8/) + kao(:, 7, 4) = (/ & + &5.7728e+00_r8,6.3036e+00_r8,6.7993e+00_r8,7.2580e+00_r8,7.6760e+00_r8/) + kao(:, 8, 4) = (/ & + &4.6719e+00_r8,5.1262e+00_r8,5.5542e+00_r8,5.9566e+00_r8,6.3304e+00_r8/) + kao(:, 9, 4) = (/ & + &3.7449e+00_r8,4.1314e+00_r8,4.4992e+00_r8,4.8512e+00_r8,5.1834e+00_r8/) + kao(:,10, 4) = (/ & + &2.9983e+00_r8,3.3274e+00_r8,3.6424e+00_r8,3.9480e+00_r8,4.2418e+00_r8/) + kao(:,11, 4) = (/ & + &2.5136e+00_r8,2.7891e+00_r8,3.0545e+00_r8,3.3182e+00_r8,3.5747e+00_r8/) + kao(:,12, 4) = (/ & + &2.1004e+00_r8,2.3314e+00_r8,2.5605e+00_r8,2.7929e+00_r8,3.0174e+00_r8/) + kao(:,13, 4) = (/ & + &1.7524e+00_r8,1.9492e+00_r8,2.1512e+00_r8,2.3564e+00_r8,2.5478e+00_r8/) + kao(:, 1, 5) = (/ & + &3.4724e+01_r8,3.5203e+01_r8,3.5615e+01_r8,3.5967e+01_r8,3.6300e+01_r8/) + kao(:, 2, 5) = (/ & + &2.9704e+01_r8,3.0154e+01_r8,3.0541e+01_r8,3.0880e+01_r8,3.1155e+01_r8/) + kao(:, 3, 5) = (/ & + &2.5203e+01_r8,2.5623e+01_r8,2.5990e+01_r8,2.6275e+01_r8,2.6504e+01_r8/) + kao(:, 4, 5) = (/ & + &2.1552e+01_r8,2.1924e+01_r8,2.2232e+01_r8,2.2450e+01_r8,2.2639e+01_r8/) + kao(:, 5, 5) = (/ & + &1.8513e+01_r8,1.8836e+01_r8,1.9081e+01_r8,1.9246e+01_r8,1.9410e+01_r8/) + kao(:, 6, 5) = (/ & + &1.5765e+01_r8,1.6046e+01_r8,1.6242e+01_r8,1.6370e+01_r8,1.6509e+01_r8/) + kao(:, 7, 5) = (/ & + &1.3333e+01_r8,1.3583e+01_r8,1.3745e+01_r8,1.3853e+01_r8,1.3971e+01_r8/) + kao(:, 8, 5) = (/ & + &1.1230e+01_r8,1.1452e+01_r8,1.1589e+01_r8,1.1683e+01_r8,1.1782e+01_r8/) + kao(:, 9, 5) = (/ & + &9.4196e+00_r8,9.6109e+00_r8,9.7356e+00_r8,9.8175e+00_r8,9.8960e+00_r8/) + kao(:,10, 5) = (/ & + &7.8743e+00_r8,8.0366e+00_r8,8.1439e+00_r8,8.2124e+00_r8,8.2768e+00_r8/) + kao(:,11, 5) = (/ & + &6.6265e+00_r8,6.7386e+00_r8,6.8161e+00_r8,6.8681e+00_r8,6.9329e+00_r8/) + kao(:,12, 5) = (/ & + &5.5390e+00_r8,5.6241e+00_r8,5.6817e+00_r8,5.7305e+00_r8,5.8031e+00_r8/) + kao(:,13, 5) = (/ & + &4.6094e+00_r8,4.6772e+00_r8,4.7246e+00_r8,4.7737e+00_r8,4.8549e+00_r8/) + kao(:, 1, 6) = (/ & + &5.5082e+01_r8,5.5287e+01_r8,5.5714e+01_r8,5.6227e+01_r8,5.6768e+01_r8/) + kao(:, 2, 6) = (/ & + &4.8272e+01_r8,4.8698e+01_r8,4.9143e+01_r8,4.9607e+01_r8,5.0132e+01_r8/) + kao(:, 3, 6) = (/ & + &4.2021e+01_r8,4.2370e+01_r8,4.2729e+01_r8,4.3163e+01_r8,4.3674e+01_r8/) + kao(:, 4, 6) = (/ & + &3.6214e+01_r8,3.6443e+01_r8,3.6742e+01_r8,3.7158e+01_r8,3.7640e+01_r8/) + kao(:, 5, 6) = (/ & + &3.1082e+01_r8,3.1249e+01_r8,3.1507e+01_r8,3.1893e+01_r8,3.2320e+01_r8/) + kao(:, 6, 6) = (/ & + &2.6864e+01_r8,2.6986e+01_r8,2.7204e+01_r8,2.7526e+01_r8,2.7858e+01_r8/) + kao(:, 7, 6) = (/ & + &2.3146e+01_r8,2.3231e+01_r8,2.3407e+01_r8,2.3654e+01_r8,2.3926e+01_r8/) + kao(:, 8, 6) = (/ & + &1.9819e+01_r8,1.9868e+01_r8,1.9994e+01_r8,2.0178e+01_r8,2.0400e+01_r8/) + kao(:, 9, 6) = (/ & + &1.6892e+01_r8,1.6913e+01_r8,1.7001e+01_r8,1.7132e+01_r8,1.7310e+01_r8/) + kao(:,10, 6) = (/ & + &1.4365e+01_r8,1.4367e+01_r8,1.4429e+01_r8,1.4521e+01_r8,1.4660e+01_r8/) + kao(:,11, 6) = (/ & + &1.2162e+01_r8,1.2177e+01_r8,1.2223e+01_r8,1.2309e+01_r8,1.2439e+01_r8/) + kao(:,12, 6) = (/ & + &1.0257e+01_r8,1.0260e+01_r8,1.0295e+01_r8,1.0375e+01_r8,1.0502e+01_r8/) + kao(:,13, 6) = (/ & + &8.6109e+00_r8,8.6045e+00_r8,8.6391e+00_r8,8.7159e+00_r8,8.8472e+00_r8/) + kao(:, 1, 7) = (/ & + &9.6537e+01_r8,9.5488e+01_r8,9.4812e+01_r8,9.4687e+01_r8,9.5057e+01_r8/) + kao(:, 2, 7) = (/ & + &8.5306e+01_r8,8.4772e+01_r8,8.4928e+01_r8,8.5670e+01_r8,8.6805e+01_r8/) + kao(:, 3, 7) = (/ & + &7.4847e+01_r8,7.4994e+01_r8,7.5806e+01_r8,7.7131e+01_r8,7.8782e+01_r8/) + kao(:, 4, 7) = (/ & + &6.5341e+01_r8,6.6016e+01_r8,6.7305e+01_r8,6.9026e+01_r8,7.0761e+01_r8/) + kao(:, 5, 7) = (/ & + &5.6784e+01_r8,5.7825e+01_r8,5.9429e+01_r8,6.1058e+01_r8,6.2599e+01_r8/) + kao(:, 6, 7) = (/ & + &4.9097e+01_r8,5.0352e+01_r8,5.1865e+01_r8,5.3258e+01_r8,5.4642e+01_r8/) + kao(:, 7, 7) = (/ & + &4.2608e+01_r8,4.3857e+01_r8,4.5074e+01_r8,4.6282e+01_r8,4.7459e+01_r8/) + kao(:, 8, 7) = (/ & + &3.7209e+01_r8,3.8259e+01_r8,3.9241e+01_r8,4.0246e+01_r8,4.1244e+01_r8/) + kao(:, 9, 7) = (/ & + &3.2353e+01_r8,3.3212e+01_r8,3.4023e+01_r8,3.4877e+01_r8,3.5739e+01_r8/) + kao(:,10, 7) = (/ & + &2.7960e+01_r8,2.8627e+01_r8,2.9290e+01_r8,3.0022e+01_r8,3.0747e+01_r8/) + kao(:,11, 7) = (/ & + &2.4264e+01_r8,2.4777e+01_r8,2.5355e+01_r8,2.5965e+01_r8,2.6544e+01_r8/) + kao(:,12, 7) = (/ & + &2.0930e+01_r8,2.1372e+01_r8,2.1863e+01_r8,2.2353e+01_r8,2.2822e+01_r8/) + kao(:,13, 7) = (/ & + &1.7993e+01_r8,1.8373e+01_r8,1.8772e+01_r8,1.9157e+01_r8,1.9544e+01_r8/) + kao(:, 1, 8) = (/ & + &2.1856e+02_r8,2.1566e+02_r8,2.1284e+02_r8,2.0997e+02_r8,2.0718e+02_r8/) + kao(:, 2, 8) = (/ & + &2.0300e+02_r8,2.0022e+02_r8,1.9750e+02_r8,1.9481e+02_r8,1.9235e+02_r8/) + kao(:, 3, 8) = (/ & + &1.8584e+02_r8,1.8317e+02_r8,1.8063e+02_r8,1.7831e+02_r8,1.7621e+02_r8/) + kao(:, 4, 8) = (/ & + &1.6761e+02_r8,1.6519e+02_r8,1.6298e+02_r8,1.6101e+02_r8,1.5981e+02_r8/) + kao(:, 5, 8) = (/ & + &1.4928e+02_r8,1.4711e+02_r8,1.4522e+02_r8,1.4425e+02_r8,1.4420e+02_r8/) + kao(:, 6, 8) = (/ & + &1.3122e+02_r8,1.2933e+02_r8,1.2822e+02_r8,1.2825e+02_r8,1.2918e+02_r8/) + kao(:, 7, 8) = (/ & + &1.1410e+02_r8,1.1264e+02_r8,1.1239e+02_r8,1.1324e+02_r8,1.1505e+02_r8/) + kao(:, 8, 8) = (/ & + &9.8348e+01_r8,9.7493e+01_r8,9.7940e+01_r8,9.9442e+01_r8,1.0191e+02_r8/) + kao(:, 9, 8) = (/ & + &8.4647e+01_r8,8.4268e+01_r8,8.5204e+01_r8,8.7179e+01_r8,9.0023e+01_r8/) + kao(:,10, 8) = (/ & + &7.3021e+01_r8,7.3118e+01_r8,7.4447e+01_r8,7.6754e+01_r8,7.9414e+01_r8/) + kao(:,11, 8) = (/ & + &6.3300e+01_r8,6.4312e+01_r8,6.6319e+01_r8,6.8546e+01_r8,7.0686e+01_r8/) + kao(:,12, 8) = (/ & + &5.5501e+01_r8,5.7093e+01_r8,5.8983e+01_r8,6.0787e+01_r8,6.2564e+01_r8/) + kao(:,13, 8) = (/ & + &4.8706e+01_r8,5.0287e+01_r8,5.1813e+01_r8,5.3328e+01_r8,5.4791e+01_r8/) + kao(:, 1, 9) = (/ & + &5.5934e+02_r8,5.5574e+02_r8,5.5144e+02_r8,5.4673e+02_r8,5.4155e+02_r8/) + kao(:, 2, 9) = (/ & + &5.7946e+02_r8,5.7510e+02_r8,5.7015e+02_r8,5.6485e+02_r8,5.5885e+02_r8/) + kao(:, 3, 9) = (/ & + &5.9076e+02_r8,5.8577e+02_r8,5.8036e+02_r8,5.7428e+02_r8,5.6790e+02_r8/) + kao(:, 4, 9) = (/ & + &5.9122e+02_r8,5.8578e+02_r8,5.7964e+02_r8,5.7332e+02_r8,5.6635e+02_r8/) + kao(:, 5, 9) = (/ & + &5.8028e+02_r8,5.7411e+02_r8,5.6769e+02_r8,5.6068e+02_r8,5.5353e+02_r8/) + kao(:, 6, 9) = (/ & + &5.5962e+02_r8,5.5294e+02_r8,5.4600e+02_r8,5.3888e+02_r8,5.3142e+02_r8/) + kao(:, 7, 9) = (/ & + &5.2985e+02_r8,5.2302e+02_r8,5.1578e+02_r8,5.0845e+02_r8,5.0105e+02_r8/) + kao(:, 8, 9) = (/ & + &4.9277e+02_r8,4.8554e+02_r8,4.7838e+02_r8,4.7112e+02_r8,4.6381e+02_r8/) + kao(:, 9, 9) = (/ & + &4.5092e+02_r8,4.4373e+02_r8,4.3650e+02_r8,4.2952e+02_r8,4.2278e+02_r8/) + kao(:,10, 9) = (/ & + &4.0542e+02_r8,3.9841e+02_r8,3.9162e+02_r8,3.8505e+02_r8,3.7968e+02_r8/) + kao(:,11, 9) = (/ & + &3.5669e+02_r8,3.5010e+02_r8,3.4395e+02_r8,3.3923e+02_r8,3.3643e+02_r8/) + kao(:,12, 9) = (/ & + &3.0992e+02_r8,3.0411e+02_r8,2.9975e+02_r8,2.9742e+02_r8,2.9692e+02_r8/) + kao(:,13, 9) = (/ & + &2.6703e+02_r8,2.6279e+02_r8,2.6062e+02_r8,2.6039e+02_r8,2.6194e+02_r8/) + kao(:, 1,10) = (/ & + &9.5667e+02_r8,9.5651e+02_r8,9.5375e+02_r8,9.4993e+02_r8,9.4458e+02_r8/) + kao(:, 2,10) = (/ & + &1.0737e+03_r8,1.0712e+03_r8,1.0675e+03_r8,1.0621e+03_r8,1.0554e+03_r8/) + kao(:, 3,10) = (/ & + &1.1862e+03_r8,1.1837e+03_r8,1.1793e+03_r8,1.1732e+03_r8,1.1657e+03_r8/) + kao(:, 4,10) = (/ & + &1.2923e+03_r8,1.2885e+03_r8,1.2837e+03_r8,1.2762e+03_r8,1.2683e+03_r8/) + kao(:, 5,10) = (/ & + &1.3860e+03_r8,1.3831e+03_r8,1.3760e+03_r8,1.3692e+03_r8,1.3583e+03_r8/) + kao(:, 6,10) = (/ & + &1.4574e+03_r8,1.4515e+03_r8,1.4451e+03_r8,1.4344e+03_r8,1.4246e+03_r8/) + kao(:, 7,10) = (/ & + &1.5032e+03_r8,1.4948e+03_r8,1.4847e+03_r8,1.4737e+03_r8,1.4593e+03_r8/) + kao(:, 8,10) = (/ & + &1.5178e+03_r8,1.5093e+03_r8,1.4967e+03_r8,1.4828e+03_r8,1.4689e+03_r8/) + kao(:, 9,10) = (/ & + &1.5009e+03_r8,1.4874e+03_r8,1.4751e+03_r8,1.4596e+03_r8,1.4422e+03_r8/) + kao(:,10,10) = (/ & + &1.4526e+03_r8,1.4382e+03_r8,1.4207e+03_r8,1.4042e+03_r8,1.3871e+03_r8/) + kao(:,11,10) = (/ & + &1.3669e+03_r8,1.3492e+03_r8,1.3313e+03_r8,1.3144e+03_r8,1.2952e+03_r8/) + kao(:,12,10) = (/ & + &1.2561e+03_r8,1.2377e+03_r8,1.2201e+03_r8,1.2021e+03_r8,1.1826e+03_r8/) + kao(:,13,10) = (/ & + &1.1367e+03_r8,1.1187e+03_r8,1.1007e+03_r8,1.0822e+03_r8,1.0635e+03_r8/) + kao(:, 1,11) = (/ & + &1.0788e+03_r8,1.0784e+03_r8,1.0786e+03_r8,1.0769e+03_r8,1.0720e+03_r8/) + kao(:, 2,11) = (/ & + &1.2360e+03_r8,1.2387e+03_r8,1.2382e+03_r8,1.2346e+03_r8,1.2287e+03_r8/) + kao(:, 3,11) = (/ & + &1.4028e+03_r8,1.4050e+03_r8,1.4041e+03_r8,1.4005e+03_r8,1.3939e+03_r8/) + kao(:, 4,11) = (/ & + &1.5761e+03_r8,1.5770e+03_r8,1.5755e+03_r8,1.5691e+03_r8,1.5622e+03_r8/) + kao(:, 5,11) = (/ & + &1.7429e+03_r8,1.7443e+03_r8,1.7409e+03_r8,1.7348e+03_r8,1.7262e+03_r8/) + kao(:, 6,11) = (/ & + &1.9004e+03_r8,1.9007e+03_r8,1.8945e+03_r8,1.8893e+03_r8,1.8776e+03_r8/) + kao(:, 7,11) = (/ & + &2.0382e+03_r8,2.0344e+03_r8,2.0314e+03_r8,2.0213e+03_r8,2.0121e+03_r8/) + kao(:, 8,11) = (/ & + &2.1442e+03_r8,2.1390e+03_r8,2.1319e+03_r8,2.1222e+03_r8,2.1076e+03_r8/) + kao(:, 9,11) = (/ & + &2.2113e+03_r8,2.2063e+03_r8,2.1931e+03_r8,2.1796e+03_r8,2.1631e+03_r8/) + kao(:,10,11) = (/ & + &2.2360e+03_r8,2.2231e+03_r8,2.2114e+03_r8,2.1930e+03_r8,2.1737e+03_r8/) + kao(:,11,11) = (/ & + &2.2031e+03_r8,2.1887e+03_r8,2.1696e+03_r8,2.1476e+03_r8,2.1259e+03_r8/) + kao(:,12,11) = (/ & + &2.1236e+03_r8,2.1030e+03_r8,2.0791e+03_r8,2.0554e+03_r8,2.0303e+03_r8/) + kao(:,13,11) = (/ & + &1.9976e+03_r8,1.9732e+03_r8,1.9489e+03_r8,1.9244e+03_r8,1.8976e+03_r8/) + kao(:, 1,12) = (/ & + &1.1934e+03_r8,1.1955e+03_r8,1.1958e+03_r8,1.1936e+03_r8,1.1920e+03_r8/) + kao(:, 2,12) = (/ & + &1.3945e+03_r8,1.3970e+03_r8,1.3984e+03_r8,1.3987e+03_r8,1.3979e+03_r8/) + kao(:, 3,12) = (/ & + &1.6215e+03_r8,1.6249e+03_r8,1.6252e+03_r8,1.6264e+03_r8,1.6242e+03_r8/) + kao(:, 4,12) = (/ & + &1.8681e+03_r8,1.8729e+03_r8,1.8755e+03_r8,1.8766e+03_r8,1.8729e+03_r8/) + kao(:, 5,12) = (/ & + &2.1302e+03_r8,2.1346e+03_r8,2.1412e+03_r8,2.1410e+03_r8,2.1383e+03_r8/) + kao(:, 6,12) = (/ & + &2.4029e+03_r8,2.4115e+03_r8,2.4156e+03_r8,2.4143e+03_r8,2.4101e+03_r8/) + kao(:, 7,12) = (/ & + &2.6748e+03_r8,2.6869e+03_r8,2.6879e+03_r8,2.6884e+03_r8,2.6793e+03_r8/) + kao(:, 8,12) = (/ & + &2.9380e+03_r8,2.9477e+03_r8,2.9496e+03_r8,2.9469e+03_r8,2.9380e+03_r8/) + kao(:, 9,12) = (/ & + &3.1781e+03_r8,3.1822e+03_r8,3.1866e+03_r8,3.1790e+03_r8,3.1694e+03_r8/) + kao(:,10,12) = (/ & + &3.3770e+03_r8,3.3808e+03_r8,3.3765e+03_r8,3.3686e+03_r8,3.3530e+03_r8/) + kao(:,11,12) = (/ & + &3.5189e+03_r8,3.5130e+03_r8,3.5038e+03_r8,3.4874e+03_r8,3.4673e+03_r8/) + kao(:,12,12) = (/ & + &3.5908e+03_r8,3.5789e+03_r8,3.5609e+03_r8,3.5388e+03_r8,3.5103e+03_r8/) + kao(:,13,12) = (/ & + &3.5806e+03_r8,3.5582e+03_r8,3.5338e+03_r8,3.5034e+03_r8,3.4725e+03_r8/) + kao(:, 1,13) = (/ & + &1.2919e+03_r8,1.2953e+03_r8,1.2979e+03_r8,1.2980e+03_r8,1.2956e+03_r8/) + kao(:, 2,13) = (/ & + &1.5383e+03_r8,1.5420e+03_r8,1.5447e+03_r8,1.5440e+03_r8,1.5420e+03_r8/) + kao(:, 3,13) = (/ & + &1.8220e+03_r8,1.8287e+03_r8,1.8322e+03_r8,1.8325e+03_r8,1.8308e+03_r8/) + kao(:, 4,13) = (/ & + &2.1443e+03_r8,2.1550e+03_r8,2.1609e+03_r8,2.1623e+03_r8,2.1617e+03_r8/) + kao(:, 5,13) = (/ & + &2.5123e+03_r8,2.5251e+03_r8,2.5330e+03_r8,2.5368e+03_r8,2.5365e+03_r8/) + kao(:, 6,13) = (/ & + &2.9214e+03_r8,2.9360e+03_r8,2.9475e+03_r8,2.9537e+03_r8,2.9558e+03_r8/) + kao(:, 7,13) = (/ & + &3.3684e+03_r8,3.3871e+03_r8,3.4024e+03_r8,3.4082e+03_r8,3.4125e+03_r8/) + kao(:, 8,13) = (/ & + &3.8472e+03_r8,3.8701e+03_r8,3.8882e+03_r8,3.8980e+03_r8,3.9031e+03_r8/) + kao(:, 9,13) = (/ & + &4.3463e+03_r8,4.3744e+03_r8,4.3907e+03_r8,4.4045e+03_r8,4.4088e+03_r8/) + kao(:,10,13) = (/ & + &4.8548e+03_r8,4.8861e+03_r8,4.9050e+03_r8,4.9166e+03_r8,4.9195e+03_r8/) + kao(:,11,13) = (/ & + &5.3685e+03_r8,5.3944e+03_r8,5.4093e+03_r8,5.4165e+03_r8,5.4085e+03_r8/) + kao(:,12,13) = (/ & + &5.8390e+03_r8,5.8545e+03_r8,5.8642e+03_r8,5.8596e+03_r8,5.8502e+03_r8/) + kao(:,13,13) = (/ & + &6.2371e+03_r8,6.2518e+03_r8,6.2489e+03_r8,6.2389e+03_r8,6.2163e+03_r8/) + kao(:, 1,14) = (/ & + &1.3744e+03_r8,1.3784e+03_r8,1.3801e+03_r8,1.3822e+03_r8,1.3833e+03_r8/) + kao(:, 2,14) = (/ & + &1.6525e+03_r8,1.6579e+03_r8,1.6603e+03_r8,1.6628e+03_r8,1.6635e+03_r8/) + kao(:, 3,14) = (/ & + &1.9810e+03_r8,1.9908e+03_r8,1.9968e+03_r8,2.0006e+03_r8,2.0007e+03_r8/) + kao(:, 4,14) = (/ & + &2.3728e+03_r8,2.3844e+03_r8,2.3938e+03_r8,2.4019e+03_r8,2.4042e+03_r8/) + kao(:, 5,14) = (/ & + &2.8373e+03_r8,2.8532e+03_r8,2.8650e+03_r8,2.8745e+03_r8,2.8783e+03_r8/) + kao(:, 6,14) = (/ & + &3.3748e+03_r8,3.3991e+03_r8,3.4179e+03_r8,3.4320e+03_r8,3.4378e+03_r8/) + kao(:, 7,14) = (/ & + &3.9998e+03_r8,4.0298e+03_r8,4.0539e+03_r8,4.0746e+03_r8,4.0866e+03_r8/) + kao(:, 8,14) = (/ & + &4.7196e+03_r8,4.7615e+03_r8,4.7914e+03_r8,4.8146e+03_r8,4.8273e+03_r8/) + kao(:, 9,14) = (/ & + &5.5304e+03_r8,5.5847e+03_r8,5.6275e+03_r8,5.6623e+03_r8,5.6782e+03_r8/) + kao(:,10,14) = (/ & + &6.4513e+03_r8,6.5110e+03_r8,6.5637e+03_r8,6.6030e+03_r8,6.6279e+03_r8/) + kao(:,11,14) = (/ & + &7.5126e+03_r8,7.5759e+03_r8,7.6236e+03_r8,7.6577e+03_r8,7.6817e+03_r8/) + kao(:,12,14) = (/ & + &8.6584e+03_r8,8.7304e+03_r8,8.7796e+03_r8,8.8102e+03_r8,8.8235e+03_r8/) + kao(:,13,14) = (/ & + &9.8812e+03_r8,9.9499e+03_r8,9.9974e+03_r8,1.0022e+04_r8,1.0029e+04_r8/) + kao(:, 1,15) = (/ & + &1.4528e+03_r8,1.4581e+03_r8,1.4601e+03_r8,1.4582e+03_r8,1.4558e+03_r8/) + kao(:, 2,15) = (/ & + &1.7546e+03_r8,1.7631e+03_r8,1.7666e+03_r8,1.7671e+03_r8,1.7653e+03_r8/) + kao(:, 3,15) = (/ & + &2.1167e+03_r8,2.1275e+03_r8,2.1344e+03_r8,2.1393e+03_r8,2.1396e+03_r8/) + kao(:, 4,15) = (/ & + &2.5536e+03_r8,2.5679e+03_r8,2.5752e+03_r8,2.5829e+03_r8,2.5878e+03_r8/) + kao(:, 5,15) = (/ & + &3.0751e+03_r8,3.0964e+03_r8,3.1097e+03_r8,3.1178e+03_r8,3.1252e+03_r8/) + kao(:, 6,15) = (/ & + &3.6981e+03_r8,3.7293e+03_r8,3.7501e+03_r8,3.7620e+03_r8,3.7738e+03_r8/) + kao(:, 7,15) = (/ & + &4.4451e+03_r8,4.4852e+03_r8,4.5165e+03_r8,4.5355e+03_r8,4.5519e+03_r8/) + kao(:, 8,15) = (/ & + &5.3398e+03_r8,5.3890e+03_r8,5.4280e+03_r8,5.4575e+03_r8,5.4832e+03_r8/) + kao(:, 9,15) = (/ & + &6.4016e+03_r8,6.4666e+03_r8,6.5191e+03_r8,6.5509e+03_r8,6.5855e+03_r8/) + kao(:,10,15) = (/ & + &7.6539e+03_r8,7.7451e+03_r8,7.8138e+03_r8,7.8602e+03_r8,7.8961e+03_r8/) + kao(:,11,15) = (/ & + &9.1780e+03_r8,9.2834e+03_r8,9.3652e+03_r8,9.4242e+03_r8,9.4602e+03_r8/) + kao(:,12,15) = (/ & + &1.0986e+04_r8,1.1091e+04_r8,1.1175e+04_r8,1.1241e+04_r8,1.1280e+04_r8/) + kao(:,13,15) = (/ & + &1.3095e+04_r8,1.3203e+04_r8,1.3280e+04_r8,1.3335e+04_r8,1.3364e+04_r8/) + kao(:, 1,16) = (/ & + &1.4758e+03_r8,1.4811e+03_r8,1.4822e+03_r8,1.4873e+03_r8,1.4919e+03_r8/) + kao(:, 2,16) = (/ & + &1.7931e+03_r8,1.7988e+03_r8,1.8023e+03_r8,1.8054e+03_r8,1.8115e+03_r8/) + kao(:, 3,16) = (/ & + &2.1801e+03_r8,2.1858e+03_r8,2.1915e+03_r8,2.1950e+03_r8,2.1996e+03_r8/) + kao(:, 4,16) = (/ & + &2.6497e+03_r8,2.6575e+03_r8,2.6648e+03_r8,2.6696e+03_r8,2.6752e+03_r8/) + kao(:, 5,16) = (/ & + &3.2162e+03_r8,3.2298e+03_r8,3.2415e+03_r8,3.2482e+03_r8,3.2542e+03_r8/) + kao(:, 6,16) = (/ & + &3.8965e+03_r8,3.9207e+03_r8,3.9398e+03_r8,3.9520e+03_r8,3.9556e+03_r8/) + kao(:, 7,16) = (/ & + &4.7145e+03_r8,4.7502e+03_r8,4.7821e+03_r8,4.8036e+03_r8,4.8122e+03_r8/) + kao(:, 8,16) = (/ & + &5.7091e+03_r8,5.7519e+03_r8,5.7946e+03_r8,5.8300e+03_r8,5.8477e+03_r8/) + kao(:, 9,16) = (/ & + &6.9081e+03_r8,6.9691e+03_r8,7.0079e+03_r8,7.0618e+03_r8,7.0936e+03_r8/) + kao(:,10,16) = (/ & + &8.3531e+03_r8,8.4377e+03_r8,8.4862e+03_r8,8.5388e+03_r8,8.5857e+03_r8/) + kao(:,11,16) = (/ & + &1.0140e+04_r8,1.0233e+04_r8,1.0291e+04_r8,1.0344e+04_r8,1.0381e+04_r8/) + kao(:,12,16) = (/ & + &1.2278e+04_r8,1.2376e+04_r8,1.2452e+04_r8,1.2503e+04_r8,1.2519e+04_r8/) + kao(:,13,16) = (/ & + &1.4816e+04_r8,1.4930e+04_r8,1.5014e+04_r8,1.5052e+04_r8,1.5044e+04_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &3.9228e-02_r8,4.0055e-02_r8,4.1480e-02_r8,4.3734e-02_r8,4.6826e-02_r8/) + kbo(:,14, 1) = (/ & + &3.2541e-02_r8,3.3340e-02_r8,3.4715e-02_r8,3.6769e-02_r8,3.9564e-02_r8/) + kbo(:,15, 1) = (/ & + &2.6969e-02_r8,2.7753e-02_r8,2.9038e-02_r8,3.0896e-02_r8,3.3356e-02_r8/) + kbo(:,16, 1) = (/ & + &2.2342e-02_r8,2.3099e-02_r8,2.4270e-02_r8,2.5925e-02_r8,2.8078e-02_r8/) + kbo(:,17, 1) = (/ & + &1.8513e-02_r8,1.9222e-02_r8,2.0267e-02_r8,2.1721e-02_r8,2.3597e-02_r8/) + kbo(:,18, 1) = (/ & + &1.5353e-02_r8,1.5989e-02_r8,1.6916e-02_r8,1.8172e-02_r8,1.9812e-02_r8/) + kbo(:,19, 1) = (/ & + &1.2730e-02_r8,1.3292e-02_r8,1.4104e-02_r8,1.5198e-02_r8,1.6633e-02_r8/) + kbo(:,20, 1) = (/ & + &1.0558e-02_r8,1.1059e-02_r8,1.1764e-02_r8,1.2725e-02_r8,1.3995e-02_r8/) + kbo(:,21, 1) = (/ & + &8.7555e-03_r8,9.1943e-03_r8,9.8141e-03_r8,1.0663e-02_r8,1.1783e-02_r8/) + kbo(:,22, 1) = (/ & + &7.2788e-03_r8,7.6721e-03_r8,8.2312e-03_r8,8.9953e-03_r8,1.0002e-02_r8/) + kbo(:,23, 1) = (/ & + &6.0534e-03_r8,6.4084e-03_r8,6.9154e-03_r8,7.6052e-03_r8,8.5112e-03_r8/) + kbo(:,24, 1) = (/ & + &5.0381e-03_r8,5.3630e-03_r8,5.8249e-03_r8,6.4486e-03_r8,7.2625e-03_r8/) + kbo(:,25, 1) = (/ & + &4.2012e-03_r8,4.4994e-03_r8,4.9231e-03_r8,5.4862e-03_r8,6.2185e-03_r8/) + kbo(:,26, 1) = (/ & + &3.5140e-03_r8,3.7917e-03_r8,4.1803e-03_r8,4.6907e-03_r8,5.3531e-03_r8/) + kbo(:,27, 1) = (/ & + &2.9461e-03_r8,3.2058e-03_r8,3.5595e-03_r8,4.0238e-03_r8,4.6243e-03_r8/) + kbo(:,28, 1) = (/ & + &2.4782e-03_r8,2.7200e-03_r8,3.0408e-03_r8,3.4639e-03_r8,4.0087e-03_r8/) + kbo(:,29, 1) = (/ & + &2.0935e-03_r8,2.3161e-03_r8,2.6092e-03_r8,2.9949e-03_r8,3.4943e-03_r8/) + kbo(:,30, 1) = (/ & + &1.7747e-03_r8,1.9777e-03_r8,2.2475e-03_r8,2.5999e-03_r8,3.0591e-03_r8/) + kbo(:,31, 1) = (/ & + &1.5106e-03_r8,1.6973e-03_r8,1.9445e-03_r8,2.2691e-03_r8,2.6924e-03_r8/) + kbo(:,32, 1) = (/ & + &1.2905e-03_r8,1.4629e-03_r8,1.6903e-03_r8,1.9914e-03_r8,2.3817e-03_r8/) + kbo(:,33, 1) = (/ & + &1.1070e-03_r8,1.2664e-03_r8,1.4773e-03_r8,1.7562e-03_r8,2.1183e-03_r8/) + kbo(:,34, 1) = (/ & + &9.4969e-04_r8,1.0951e-03_r8,1.2897e-03_r8,1.5465e-03_r8,1.8794e-03_r8/) + kbo(:,35, 1) = (/ & + &8.0650e-04_r8,9.3657e-04_r8,1.1113e-03_r8,1.3423e-03_r8,1.6411e-03_r8/) + kbo(:,36, 1) = (/ & + &6.7527e-04_r8,7.8828e-04_r8,9.4082e-04_r8,1.1424e-03_r8,1.4040e-03_r8/) + kbo(:,37, 1) = (/ & + &5.5374e-04_r8,6.4781e-04_r8,7.7522e-04_r8,9.4463e-04_r8,1.1654e-03_r8/) + kbo(:,38, 1) = (/ & + &4.5356e-04_r8,5.3144e-04_r8,6.3765e-04_r8,7.7978e-04_r8,9.6558e-04_r8/) + kbo(:,39, 1) = (/ & + &3.7155e-04_r8,4.3614e-04_r8,5.2472e-04_r8,6.4387e-04_r8,8.0047e-04_r8/) + kbo(:,40, 1) = (/ & + &2.9980e-04_r8,3.5165e-04_r8,4.2320e-04_r8,5.2024e-04_r8,6.4874e-04_r8/) + kbo(:,41, 1) = (/ & + &2.4145e-04_r8,2.8281e-04_r8,3.4028e-04_r8,4.1898e-04_r8,5.2376e-04_r8/) + kbo(:,42, 1) = (/ & + &1.9444e-04_r8,2.2740e-04_r8,2.7348e-04_r8,3.3721e-04_r8,4.2264e-04_r8/) + kbo(:,43, 1) = (/ & + &1.5533e-04_r8,1.8108e-04_r8,2.1726e-04_r8,2.6787e-04_r8,3.3649e-04_r8/) + kbo(:,44, 1) = (/ & + &1.2372e-04_r8,1.4362e-04_r8,1.7176e-04_r8,2.1151e-04_r8,2.6597e-04_r8/) + kbo(:,45, 1) = (/ & + &9.8615e-05_r8,1.1395e-04_r8,1.3575e-04_r8,1.6686e-04_r8,2.0989e-04_r8/) + kbo(:,46, 1) = (/ & + &7.8410e-05_r8,9.0146e-05_r8,1.0684e-04_r8,1.3092e-04_r8,1.6455e-04_r8/) + kbo(:,47, 1) = (/ & + &6.2111e-05_r8,7.0925e-05_r8,8.3491e-05_r8,1.0171e-04_r8,1.2752e-04_r8/) + kbo(:,48, 1) = (/ & + &4.9292e-05_r8,5.5878e-05_r8,6.5308e-05_r8,7.9022e-05_r8,9.8758e-05_r8/) + kbo(:,49, 1) = (/ & + &3.9189e-05_r8,4.4083e-05_r8,5.1134e-05_r8,6.1433e-05_r8,7.6433e-05_r8/) + kbo(:,50, 1) = (/ & + &3.1297e-05_r8,3.4944e-05_r8,4.0262e-05_r8,4.8024e-05_r8,5.9468e-05_r8/) + kbo(:,51, 1) = (/ & + &2.5040e-05_r8,2.7793e-05_r8,3.1794e-05_r8,3.7665e-05_r8,4.6363e-05_r8/) + kbo(:,52, 1) = (/ & + &2.0024e-05_r8,2.2137e-05_r8,2.5151e-05_r8,2.9572e-05_r8,3.6157e-05_r8/) + kbo(:,53, 1) = (/ & + &1.5989e-05_r8,1.7662e-05_r8,1.9908e-05_r8,2.3247e-05_r8,2.8202e-05_r8/) + kbo(:,54, 1) = (/ & + &1.2802e-05_r8,1.4140e-05_r8,1.5857e-05_r8,1.8384e-05_r8,2.2160e-05_r8/) + kbo(:,55, 1) = (/ & + &1.0251e-05_r8,1.1335e-05_r8,1.2664e-05_r8,1.4589e-05_r8,1.7471e-05_r8/) + kbo(:,56, 1) = (/ & + &8.1863e-06_r8,9.0810e-06_r8,1.0125e-05_r8,1.1592e-05_r8,1.3791e-05_r8/) + kbo(:,57, 1) = (/ & + &6.5183e-06_r8,7.2717e-06_r8,8.0938e-06_r8,9.2169e-06_r8,1.0895e-05_r8/) + kbo(:,58, 1) = (/ & + &5.1879e-06_r8,5.8228e-06_r8,6.4835e-06_r8,7.3485e-06_r8,8.6418e-06_r8/) + kbo(:,59, 1) = (/ & + &4.2168e-06_r8,4.7498e-06_r8,5.3015e-06_r8,6.0144e-06_r8,7.0853e-06_r8/) + kbo(:,13, 2) = (/ & + &1.3654e-01_r8,1.5163e-01_r8,1.6956e-01_r8,1.9071e-01_r8,2.1617e-01_r8/) + kbo(:,14, 2) = (/ & + &1.1559e-01_r8,1.2885e-01_r8,1.4454e-01_r8,1.6328e-01_r8,1.8606e-01_r8/) + kbo(:,15, 2) = (/ & + &9.7693e-02_r8,1.0924e-01_r8,1.2296e-01_r8,1.3968e-01_r8,1.6004e-01_r8/) + kbo(:,16, 2) = (/ & + &8.2470e-02_r8,9.2497e-02_r8,1.0461e-01_r8,1.1951e-01_r8,1.3759e-01_r8/) + kbo(:,17, 2) = (/ & + &6.9485e-02_r8,7.8236e-02_r8,8.9019e-02_r8,1.0217e-01_r8,1.1819e-01_r8/) + kbo(:,18, 2) = (/ & + &5.8434e-02_r8,6.6177e-02_r8,7.5740e-02_r8,8.7380e-02_r8,1.0143e-01_r8/) + kbo(:,19, 2) = (/ & + &4.9105e-02_r8,5.5950e-02_r8,6.4367e-02_r8,7.4577e-02_r8,8.6834e-02_r8/) + kbo(:,20, 2) = (/ & + &4.1358e-02_r8,4.7392e-02_r8,5.4755e-02_r8,6.3671e-02_r8,7.4385e-02_r8/) + kbo(:,21, 2) = (/ & + &3.4862e-02_r8,4.0138e-02_r8,4.6538e-02_r8,5.4275e-02_r8,6.3577e-02_r8/) + kbo(:,22, 2) = (/ & + &2.9678e-02_r8,3.4317e-02_r8,3.9913e-02_r8,4.6700e-02_r8,5.4863e-02_r8/) + kbo(:,23, 2) = (/ & + &2.5302e-02_r8,2.9357e-02_r8,3.4270e-02_r8,4.0209e-02_r8,4.7364e-02_r8/) + kbo(:,24, 2) = (/ & + &2.1615e-02_r8,2.5159e-02_r8,2.9473e-02_r8,3.4693e-02_r8,4.0992e-02_r8/) + kbo(:,25, 2) = (/ & + &1.8506e-02_r8,2.1620e-02_r8,2.5407e-02_r8,3.0032e-02_r8,3.5645e-02_r8/) + kbo(:,26, 2) = (/ & + &1.5911e-02_r8,1.8663e-02_r8,2.2016e-02_r8,2.6153e-02_r8,3.1176e-02_r8/) + kbo(:,27, 2) = (/ & + &1.3710e-02_r8,1.6139e-02_r8,1.9144e-02_r8,2.2842e-02_r8,2.7378e-02_r8/) + kbo(:,28, 2) = (/ & + &1.1834e-02_r8,1.3997e-02_r8,1.6695e-02_r8,2.0027e-02_r8,2.4111e-02_r8/) + kbo(:,29, 2) = (/ & + &1.0249e-02_r8,1.2190e-02_r8,1.4630e-02_r8,1.7647e-02_r8,2.1313e-02_r8/) + kbo(:,30, 2) = (/ & + &8.9036e-03_r8,1.0661e-02_r8,1.2868e-02_r8,1.5600e-02_r8,1.8888e-02_r8/) + kbo(:,31, 2) = (/ & + &7.7687e-03_r8,9.3699e-03_r8,1.1378e-02_r8,1.3839e-02_r8,1.6787e-02_r8/) + kbo(:,32, 2) = (/ & + &6.8140e-03_r8,8.2759e-03_r8,1.0101e-02_r8,1.2319e-02_r8,1.4958e-02_r8/) + kbo(:,33, 2) = (/ & + &6.0058e-03_r8,7.3417e-03_r8,8.9915e-03_r8,1.0990e-02_r8,1.3357e-02_r8/) + kbo(:,34, 2) = (/ & + &5.2812e-03_r8,6.4864e-03_r8,7.9715e-03_r8,9.7608e-03_r8,1.1880e-02_r8/) + kbo(:,35, 2) = (/ & + &4.5664e-03_r8,5.6316e-03_r8,6.9402e-03_r8,8.5171e-03_r8,1.0395e-02_r8/) + kbo(:,36, 2) = (/ & + &3.8650e-03_r8,4.7853e-03_r8,5.9182e-03_r8,7.2844e-03_r8,8.9146e-03_r8/) + kbo(:,37, 2) = (/ & + &3.1698e-03_r8,3.9391e-03_r8,4.8941e-03_r8,6.0480e-03_r8,7.4275e-03_r8/) + kbo(:,38, 2) = (/ & + &2.5939e-03_r8,3.2378e-03_r8,4.0393e-03_r8,5.0137e-03_r8,6.1786e-03_r8/) + kbo(:,39, 2) = (/ & + &2.1228e-03_r8,2.6601e-03_r8,3.3343e-03_r8,4.1558e-03_r8,5.1416e-03_r8/) + kbo(:,40, 2) = (/ & + &1.6967e-03_r8,2.1355e-03_r8,2.6888e-03_r8,3.3677e-03_r8,4.1883e-03_r8/) + kbo(:,41, 2) = (/ & + &1.3505e-03_r8,1.7067e-03_r8,2.1592e-03_r8,2.7184e-03_r8,3.3988e-03_r8/) + kbo(:,42, 2) = (/ & + &1.0736e-03_r8,1.3626e-03_r8,1.7319e-03_r8,2.1915e-03_r8,2.7553e-03_r8/) + kbo(:,43, 2) = (/ & + &8.4090e-04_r8,1.0714e-03_r8,1.3684e-03_r8,1.7414e-03_r8,2.2023e-03_r8/) + kbo(:,44, 2) = (/ & + &6.5390e-04_r8,8.3586e-04_r8,1.0728e-03_r8,1.3727e-03_r8,1.7466e-03_r8/) + kbo(:,45, 2) = (/ & + &5.0782e-04_r8,6.5105e-04_r8,8.3889e-04_r8,1.0793e-03_r8,1.3823e-03_r8/) + kbo(:,46, 2) = (/ & + &3.9179e-04_r8,5.0302e-04_r8,6.5132e-04_r8,8.4212e-04_r8,1.0854e-03_r8/) + kbo(:,47, 2) = (/ & + &2.9882e-04_r8,3.8363e-04_r8,4.9873e-04_r8,6.4829e-04_r8,8.4103e-04_r8/) + kbo(:,48, 2) = (/ & + &2.2778e-04_r8,2.9209e-04_r8,3.8081e-04_r8,4.9759e-04_r8,6.4942e-04_r8/) + kbo(:,49, 2) = (/ & + &1.7348e-04_r8,2.2201e-04_r8,2.8994e-04_r8,3.8059e-04_r8,4.9968e-04_r8/) + kbo(:,50, 2) = (/ & + &1.3291e-04_r8,1.6970e-04_r8,2.2169e-04_r8,2.9250e-04_r8,3.8590e-04_r8/) + kbo(:,51, 2) = (/ & + &1.0207e-04_r8,1.2991e-04_r8,1.6972e-04_r8,2.2476e-04_r8,2.9809e-04_r8/) + kbo(:,52, 2) = (/ & + &7.8428e-05_r8,9.9370e-05_r8,1.2969e-04_r8,1.7236e-04_r8,2.2955e-04_r8/) + kbo(:,53, 2) = (/ & + &6.0320e-05_r8,7.5906e-05_r8,9.8948e-05_r8,1.3170e-04_r8,1.7631e-04_r8/) + kbo(:,54, 2) = (/ & + &4.6701e-05_r8,5.8457e-05_r8,7.5987e-05_r8,1.0130e-04_r8,1.3626e-04_r8/) + kbo(:,55, 2) = (/ & + &3.6311e-05_r8,4.5177e-05_r8,5.8536e-05_r8,7.8091e-05_r8,1.0548e-04_r8/) + kbo(:,56, 2) = (/ & + &2.8265e-05_r8,3.4933e-05_r8,4.5042e-05_r8,6.0092e-05_r8,8.1465e-05_r8/) + kbo(:,57, 2) = (/ & + &2.2041e-05_r8,2.7013e-05_r8,3.4636e-05_r8,4.6160e-05_r8,6.2788e-05_r8/) + kbo(:,58, 2) = (/ & + &1.7267e-05_r8,2.0998e-05_r8,2.6754e-05_r8,3.5587e-05_r8,4.8495e-05_r8/) + kbo(:,59, 2) = (/ & + &1.3975e-05_r8,1.7004e-05_r8,2.1693e-05_r8,2.8956e-05_r8,3.9630e-05_r8/) + kbo(:,13, 3) = (/ & + &4.6584e-01_r8,5.5439e-01_r8,6.5378e-01_r8,7.6270e-01_r8,8.8077e-01_r8/) + kbo(:,14, 3) = (/ & + &4.0124e-01_r8,4.7657e-01_r8,5.6034e-01_r8,6.5177e-01_r8,7.5174e-01_r8/) + kbo(:,15, 3) = (/ & + &3.4513e-01_r8,4.0912e-01_r8,4.7944e-01_r8,5.5671e-01_r8,6.4124e-01_r8/) + kbo(:,16, 3) = (/ & + &2.9666e-01_r8,3.5062e-01_r8,4.0982e-01_r8,4.7509e-01_r8,5.4644e-01_r8/) + kbo(:,17, 3) = (/ & + &2.5400e-01_r8,2.9955e-01_r8,3.4952e-01_r8,4.0464e-01_r8,4.6504e-01_r8/) + kbo(:,18, 3) = (/ & + &2.1648e-01_r8,2.5489e-01_r8,2.9720e-01_r8,3.4406e-01_r8,3.9550e-01_r8/) + kbo(:,19, 3) = (/ & + &1.8385e-01_r8,2.1623e-01_r8,2.5204e-01_r8,2.9205e-01_r8,3.3599e-01_r8/) + kbo(:,20, 3) = (/ & + &1.5627e-01_r8,1.8359e-01_r8,2.1416e-01_r8,2.4849e-01_r8,2.8606e-01_r8/) + kbo(:,21, 3) = (/ & + &1.3276e-01_r8,1.5592e-01_r8,1.8216e-01_r8,2.1168e-01_r8,2.4388e-01_r8/) + kbo(:,22, 3) = (/ & + &1.1395e-01_r8,1.3395e-01_r8,1.5675e-01_r8,1.8217e-01_r8,2.0967e-01_r8/) + kbo(:,23, 3) = (/ & + &9.7815e-02_r8,1.1526e-01_r8,1.3514e-01_r8,1.5691e-01_r8,1.8033e-01_r8/) + kbo(:,24, 3) = (/ & + &8.4102e-02_r8,9.9408e-02_r8,1.1660e-01_r8,1.3523e-01_r8,1.5511e-01_r8/) + kbo(:,25, 3) = (/ & + &7.2584e-02_r8,8.5921e-02_r8,1.0065e-01_r8,1.1653e-01_r8,1.3347e-01_r8/) + kbo(:,26, 3) = (/ & + &6.2935e-02_r8,7.4476e-02_r8,8.7054e-02_r8,1.0059e-01_r8,1.1498e-01_r8/) + kbo(:,27, 3) = (/ & + &5.4628e-02_r8,6.4547e-02_r8,7.5255e-02_r8,8.6846e-02_r8,9.9043e-02_r8/) + kbo(:,28, 3) = (/ & + &4.7438e-02_r8,5.5913e-02_r8,6.5081e-02_r8,7.4969e-02_r8,8.5391e-02_r8/) + kbo(:,29, 3) = (/ & + &4.1247e-02_r8,4.8483e-02_r8,5.6377e-02_r8,6.4788e-02_r8,7.3775e-02_r8/) + kbo(:,30, 3) = (/ & + &3.5874e-02_r8,4.2080e-02_r8,4.8862e-02_r8,5.6085e-02_r8,6.3787e-02_r8/) + kbo(:,31, 3) = (/ & + &3.1224e-02_r8,3.6582e-02_r8,4.2396e-02_r8,4.8680e-02_r8,5.5240e-02_r8/) + kbo(:,32, 3) = (/ & + &2.7211e-02_r8,3.1854e-02_r8,3.6880e-02_r8,4.2315e-02_r8,4.7892e-02_r8/) + kbo(:,33, 3) = (/ & + &2.3744e-02_r8,2.7755e-02_r8,3.2147e-02_r8,3.6823e-02_r8,4.1518e-02_r8/) + kbo(:,34, 3) = (/ & + &2.0626e-02_r8,2.4111e-02_r8,2.7927e-02_r8,3.1884e-02_r8,3.5825e-02_r8/) + kbo(:,35, 3) = (/ & + &1.7661e-02_r8,2.0671e-02_r8,2.3952e-02_r8,2.7283e-02_r8,3.0580e-02_r8/) + kbo(:,36, 3) = (/ & + &1.4872e-02_r8,1.7453e-02_r8,2.0237e-02_r8,2.3045e-02_r8,2.5826e-02_r8/) + kbo(:,37, 3) = (/ & + &1.2231e-02_r8,1.4407e-02_r8,1.6754e-02_r8,1.9119e-02_r8,2.1470e-02_r8/) + kbo(:,38, 3) = (/ & + &1.0046e-02_r8,1.1883e-02_r8,1.3859e-02_r8,1.5852e-02_r8,1.7844e-02_r8/) + kbo(:,39, 3) = (/ & + &8.2562e-03_r8,9.8067e-03_r8,1.1470e-02_r8,1.3152e-02_r8,1.4841e-02_r8/) + kbo(:,40, 3) = (/ & + &6.6596e-03_r8,7.9555e-03_r8,9.3542e-03_r8,1.0774e-02_r8,1.2201e-02_r8/) + kbo(:,41, 3) = (/ & + &5.3569e-03_r8,6.4354e-03_r8,7.6095e-03_r8,8.8054e-03_r8,1.0012e-02_r8/) + kbo(:,42, 3) = (/ & + &4.3009e-03_r8,5.1973e-03_r8,6.1851e-03_r8,7.1918e-03_r8,8.2134e-03_r8/) + kbo(:,43, 3) = (/ & + &3.4093e-03_r8,4.1490e-03_r8,4.9732e-03_r8,5.8239e-03_r8,6.6848e-03_r8/) + kbo(:,44, 3) = (/ & + &2.6823e-03_r8,3.2897e-03_r8,3.9739e-03_r8,4.6907e-03_r8,5.4167e-03_r8/) + kbo(:,45, 3) = (/ & + &2.1046e-03_r8,2.6003e-03_r8,3.1662e-03_r8,3.7704e-03_r8,4.3820e-03_r8/) + kbo(:,46, 3) = (/ & + &1.6388e-03_r8,2.0403e-03_r8,2.5048e-03_r8,3.0127e-03_r8,3.5286e-03_r8/) + kbo(:,47, 3) = (/ & + &1.2595e-03_r8,1.5807e-03_r8,1.9580e-03_r8,2.3819e-03_r8,2.8168e-03_r8/) + kbo(:,48, 3) = (/ & + &9.6423e-04_r8,1.2197e-03_r8,1.5249e-03_r8,1.8746e-03_r8,2.2418e-03_r8/) + kbo(:,49, 3) = (/ & + &7.3527e-04_r8,9.3718e-04_r8,1.1821e-03_r8,1.4684e-03_r8,1.7777e-03_r8/) + kbo(:,50, 3) = (/ & + &5.6217e-04_r8,7.2217e-04_r8,9.1835e-04_r8,1.1512e-03_r8,1.4112e-03_r8/) + kbo(:,51, 3) = (/ & + &4.2967e-04_r8,5.5583e-04_r8,7.1300e-04_r8,9.0190e-04_r8,1.1184e-03_r8/) + kbo(:,52, 3) = (/ & + &3.2742e-04_r8,4.2631e-04_r8,5.5137e-04_r8,7.0406e-04_r8,8.8313e-04_r8/) + kbo(:,53, 3) = (/ & + &2.4868e-04_r8,3.2582e-04_r8,4.2465e-04_r8,5.4760e-04_r8,6.9409e-04_r8/) + kbo(:,54, 3) = (/ & + &1.8974e-04_r8,2.5027e-04_r8,3.2861e-04_r8,4.2756e-04_r8,5.4716e-04_r8/) + kbo(:,55, 3) = (/ & + &1.4494e-04_r8,1.9239e-04_r8,2.5442e-04_r8,3.3395e-04_r8,4.3136e-04_r8/) + kbo(:,56, 3) = (/ & + &1.1043e-04_r8,1.4756e-04_r8,1.9639e-04_r8,2.5993e-04_r8,3.3900e-04_r8/) + kbo(:,57, 3) = (/ & + &8.3928e-05_r8,1.1287e-04_r8,1.5113e-04_r8,2.0155e-04_r8,2.6555e-04_r8/) + kbo(:,58, 3) = (/ & + &6.4018e-05_r8,8.6477e-05_r8,1.1648e-04_r8,1.5666e-04_r8,2.0830e-04_r8/) + kbo(:,59, 3) = (/ & + &5.1497e-05_r8,6.9896e-05_r8,9.4663e-05_r8,1.2810e-04_r8,1.7150e-04_r8/) + kbo(:,13, 4) = (/ & + &1.7524e+00_r8,1.9492e+00_r8,2.1512e+00_r8,2.3564e+00_r8,2.5478e+00_r8/) + kbo(:,14, 4) = (/ & + &1.4772e+00_r8,1.6494e+00_r8,1.8280e+00_r8,2.0044e+00_r8,2.1600e+00_r8/) + kbo(:,15, 4) = (/ & + &1.2495e+00_r8,1.4008e+00_r8,1.5559e+00_r8,1.6974e+00_r8,1.8203e+00_r8/) + kbo(:,16, 4) = (/ & + &1.0605e+00_r8,1.1902e+00_r8,1.3172e+00_r8,1.4293e+00_r8,1.5280e+00_r8/) + kbo(:,17, 4) = (/ & + &8.9958e-01_r8,1.0068e+00_r8,1.1092e+00_r8,1.1993e+00_r8,1.2798e+00_r8/) + kbo(:,18, 4) = (/ & + &7.6135e-01_r8,8.4970e-01_r8,9.3198e-01_r8,1.0052e+00_r8,1.0709e+00_r8/) + kbo(:,19, 4) = (/ & + &6.4340e-01_r8,7.1592e-01_r8,7.8258e-01_r8,8.4177e-01_r8,8.9530e-01_r8/) + kbo(:,20, 4) = (/ & + &5.4418e-01_r8,6.0357e-01_r8,6.5718e-01_r8,7.0498e-01_r8,7.4918e-01_r8/) + kbo(:,21, 4) = (/ & + &4.5911e-01_r8,5.0742e-01_r8,5.5063e-01_r8,5.8988e-01_r8,6.2662e-01_r8/) + kbo(:,22, 4) = (/ & + &3.8906e-01_r8,4.2787e-01_r8,4.6285e-01_r8,4.9521e-01_r8,5.2615e-01_r8/) + kbo(:,23, 4) = (/ & + &3.2912e-01_r8,3.6040e-01_r8,3.8895e-01_r8,4.1593e-01_r8,4.4229e-01_r8/) + kbo(:,24, 4) = (/ & + &2.7830e-01_r8,3.0371e-01_r8,3.2729e-01_r8,3.5001e-01_r8,3.7213e-01_r8/) + kbo(:,25, 4) = (/ & + &2.3534e-01_r8,2.5620e-01_r8,2.7595e-01_r8,2.9506e-01_r8,3.1323e-01_r8/) + kbo(:,26, 4) = (/ & + &1.9937e-01_r8,2.1667e-01_r8,2.3330e-01_r8,2.4915e-01_r8,2.6395e-01_r8/) + kbo(:,27, 4) = (/ & + &1.6896e-01_r8,1.8346e-01_r8,1.9732e-01_r8,2.1038e-01_r8,2.2245e-01_r8/) + kbo(:,28, 4) = (/ & + &1.4324e-01_r8,1.5539e-01_r8,1.6686e-01_r8,1.7760e-01_r8,1.8754e-01_r8/) + kbo(:,29, 4) = (/ & + &1.2158e-01_r8,1.3162e-01_r8,1.4109e-01_r8,1.4990e-01_r8,1.5824e-01_r8/) + kbo(:,30, 4) = (/ & + &1.0319e-01_r8,1.1149e-01_r8,1.1927e-01_r8,1.2651e-01_r8,1.3374e-01_r8/) + kbo(:,31, 4) = (/ & + &8.7596e-02_r8,9.4445e-02_r8,1.0083e-01_r8,1.0683e-01_r8,1.1324e-01_r8/) + kbo(:,32, 4) = (/ & + &7.4371e-02_r8,7.9986e-02_r8,8.5218e-02_r8,9.0404e-02_r8,9.6151e-02_r8/) + kbo(:,33, 4) = (/ & + &6.3127e-02_r8,6.7754e-02_r8,7.2100e-02_r8,7.6670e-02_r8,8.1947e-02_r8/) + kbo(:,34, 4) = (/ & + &5.3448e-02_r8,5.7257e-02_r8,6.0976e-02_r8,6.5117e-02_r8,6.9920e-02_r8/) + kbo(:,35, 4) = (/ & + &4.4958e-02_r8,4.8132e-02_r8,5.1386e-02_r8,5.5110e-02_r8,5.9396e-02_r8/) + kbo(:,36, 4) = (/ & + &3.7535e-02_r8,4.0225e-02_r8,4.3084e-02_r8,4.6370e-02_r8,5.0142e-02_r8/) + kbo(:,37, 4) = (/ & + &3.1000e-02_r8,3.3296e-02_r8,3.5751e-02_r8,3.8593e-02_r8,4.1835e-02_r8/) + kbo(:,38, 4) = (/ & + &2.5584e-02_r8,2.7542e-02_r8,2.9661e-02_r8,3.2102e-02_r8,3.4896e-02_r8/) + kbo(:,39, 4) = (/ & + &2.1117e-02_r8,2.2790e-02_r8,2.4613e-02_r8,2.6708e-02_r8,2.9115e-02_r8/) + kbo(:,40, 4) = (/ & + &1.7285e-02_r8,1.8708e-02_r8,2.0253e-02_r8,2.2025e-02_r8,2.4072e-02_r8/) + kbo(:,41, 4) = (/ & + &1.4124e-02_r8,1.5332e-02_r8,1.6640e-02_r8,1.8138e-02_r8,1.9869e-02_r8/) + kbo(:,42, 4) = (/ & + &1.1535e-02_r8,1.2562e-02_r8,1.3665e-02_r8,1.4929e-02_r8,1.6393e-02_r8/) + kbo(:,43, 4) = (/ & + &9.3628e-03_r8,1.0238e-02_r8,1.1164e-02_r8,1.2221e-02_r8,1.3452e-02_r8/) + kbo(:,44, 4) = (/ & + &7.5734e-03_r8,8.3195e-03_r8,9.0965e-03_r8,9.9764e-03_r8,1.1001e-02_r8/) + kbo(:,45, 4) = (/ & + &6.1205e-03_r8,6.7536e-03_r8,7.4083e-03_r8,8.1381e-03_r8,8.9936e-03_r8/) + kbo(:,46, 4) = (/ & + &4.9262e-03_r8,5.4662e-03_r8,6.0165e-03_r8,6.6206e-03_r8,7.3272e-03_r8/) + kbo(:,47, 4) = (/ & + &3.9391e-03_r8,4.3970e-03_r8,4.8610e-03_r8,5.3580e-03_r8,5.9369e-03_r8/) + kbo(:,48, 4) = (/ & + &3.1403e-03_r8,3.5287e-03_r8,3.9210e-03_r8,4.3323e-03_r8,4.8039e-03_r8/) + kbo(:,49, 4) = (/ & + &2.4956e-03_r8,2.8254e-03_r8,3.1568e-03_r8,3.4981e-03_r8,3.8839e-03_r8/) + kbo(:,50, 4) = (/ & + &1.9828e-03_r8,2.2636e-03_r8,2.5424e-03_r8,2.8288e-03_r8,3.1441e-03_r8/) + kbo(:,51, 4) = (/ & + &1.5714e-03_r8,1.8113e-03_r8,2.0459e-03_r8,2.2868e-03_r8,2.5462e-03_r8/) + kbo(:,52, 4) = (/ & + &1.2395e-03_r8,1.4453e-03_r8,1.6428e-03_r8,1.8457e-03_r8,2.0598e-03_r8/) + kbo(:,53, 4) = (/ & + &9.7290e-04_r8,1.1497e-03_r8,1.3161e-03_r8,1.4871e-03_r8,1.6649e-03_r8/) + kbo(:,54, 4) = (/ & + &7.6445e-04_r8,9.1516e-04_r8,1.0560e-03_r8,1.2000e-03_r8,1.3484e-03_r8/) + kbo(:,55, 4) = (/ & + &5.9991e-04_r8,7.2766e-04_r8,8.4765e-04_r8,9.6806e-04_r8,1.0927e-03_r8/) + kbo(:,56, 4) = (/ & + &4.6862e-04_r8,5.7638e-04_r8,6.7857e-04_r8,7.7940e-04_r8,8.8453e-04_r8/) + kbo(:,57, 4) = (/ & + &3.6453e-04_r8,4.5447e-04_r8,5.4199e-04_r8,6.2645e-04_r8,7.1474e-04_r8/) + kbo(:,58, 4) = (/ & + &2.8389e-04_r8,3.5818e-04_r8,4.3272e-04_r8,5.0377e-04_r8,5.7789e-04_r8/) + kbo(:,59, 4) = (/ & + &2.3060e-04_r8,2.9282e-04_r8,3.5542e-04_r8,4.1534e-04_r8,4.7810e-04_r8/) + kbo(:,13, 5) = (/ & + &4.6094e+00_r8,4.6772e+00_r8,4.7246e+00_r8,4.7737e+00_r8,4.8549e+00_r8/) + kbo(:,14, 5) = (/ & + &3.8278e+00_r8,3.8806e+00_r8,3.9251e+00_r8,3.9810e+00_r8,4.0718e+00_r8/) + kbo(:,15, 5) = (/ & + &3.1722e+00_r8,3.2168e+00_r8,3.2634e+00_r8,3.3308e+00_r8,3.4210e+00_r8/) + kbo(:,16, 5) = (/ & + &2.6249e+00_r8,2.6705e+00_r8,2.7237e+00_r8,2.7913e+00_r8,2.8656e+00_r8/) + kbo(:,17, 5) = (/ & + &2.1764e+00_r8,2.2249e+00_r8,2.2741e+00_r8,2.3304e+00_r8,2.3919e+00_r8/) + kbo(:,18, 5) = (/ & + &1.8098e+00_r8,1.8520e+00_r8,1.8935e+00_r8,1.9392e+00_r8,1.9922e+00_r8/) + kbo(:,19, 5) = (/ & + &1.5044e+00_r8,1.5380e+00_r8,1.5723e+00_r8,1.6122e+00_r8,1.6588e+00_r8/) + kbo(:,20, 5) = (/ & + &1.2493e+00_r8,1.2764e+00_r8,1.3059e+00_r8,1.3405e+00_r8,1.3817e+00_r8/) + kbo(:,21, 5) = (/ & + &1.0373e+00_r8,1.0597e+00_r8,1.0855e+00_r8,1.1148e+00_r8,1.1513e+00_r8/) + kbo(:,22, 5) = (/ & + &8.6282e-01_r8,8.8188e-01_r8,9.0343e-01_r8,9.2979e-01_r8,9.6231e-01_r8/) + kbo(:,23, 5) = (/ & + &7.1704e-01_r8,7.3333e-01_r8,7.5232e-01_r8,7.7633e-01_r8,8.0551e-01_r8/) + kbo(:,24, 5) = (/ & + &5.9518e-01_r8,6.0940e-01_r8,6.2643e-01_r8,6.4862e-01_r8,6.7508e-01_r8/) + kbo(:,25, 5) = (/ & + &4.9422e-01_r8,5.0656e-01_r8,5.2248e-01_r8,5.4283e-01_r8,5.6739e-01_r8/) + kbo(:,26, 5) = (/ & + &4.1037e-01_r8,4.2180e-01_r8,4.3687e-01_r8,4.5588e-01_r8,4.7822e-01_r8/) + kbo(:,27, 5) = (/ & + &3.4124e-01_r8,3.5223e-01_r8,3.6648e-01_r8,3.8368e-01_r8,4.0379e-01_r8/) + kbo(:,28, 5) = (/ & + &2.8464e-01_r8,2.9501e-01_r8,3.0821e-01_r8,3.2362e-01_r8,3.4157e-01_r8/) + kbo(:,29, 5) = (/ & + &2.3808e-01_r8,2.4801e-01_r8,2.5984e-01_r8,2.7366e-01_r8,2.8965e-01_r8/) + kbo(:,30, 5) = (/ & + &1.9967e-01_r8,2.0890e-01_r8,2.1955e-01_r8,2.3198e-01_r8,2.4657e-01_r8/) + kbo(:,31, 5) = (/ & + &1.6792e-01_r8,1.7624e-01_r8,1.8593e-01_r8,1.9729e-01_r8,2.1071e-01_r8/) + kbo(:,32, 5) = (/ & + &1.4147e-01_r8,1.4902e-01_r8,1.5786e-01_r8,1.6833e-01_r8,1.8092e-01_r8/) + kbo(:,33, 5) = (/ & + &1.1942e-01_r8,1.2630e-01_r8,1.3442e-01_r8,1.4414e-01_r8,1.5600e-01_r8/) + kbo(:,34, 5) = (/ & + &1.0087e-01_r8,1.0707e-01_r8,1.1451e-01_r8,1.2366e-01_r8,1.3474e-01_r8/) + kbo(:,35, 5) = (/ & + &8.4860e-02_r8,9.0419e-02_r8,9.7193e-02_r8,1.0562e-01_r8,1.1587e-01_r8/) + kbo(:,36, 5) = (/ & + &7.0999e-02_r8,7.5907e-02_r8,8.1988e-02_r8,8.9567e-02_r8,9.8842e-02_r8/) + kbo(:,37, 5) = (/ & + &5.8886e-02_r8,6.3102e-02_r8,6.8391e-02_r8,7.5008e-02_r8,8.3160e-02_r8/) + kbo(:,38, 5) = (/ & + &4.8832e-02_r8,5.2452e-02_r8,5.7040e-02_r8,6.2826e-02_r8,7.0009e-02_r8/) + kbo(:,39, 5) = (/ & + &4.0501e-02_r8,4.3616e-02_r8,4.7608e-02_r8,5.2697e-02_r8,5.9016e-02_r8/) + kbo(:,40, 5) = (/ & + &3.3361e-02_r8,3.5983e-02_r8,3.9374e-02_r8,4.3750e-02_r8,4.9196e-02_r8/) + kbo(:,41, 5) = (/ & + &2.7445e-02_r8,2.9649e-02_r8,3.2516e-02_r8,3.6256e-02_r8,4.0930e-02_r8/) + kbo(:,42, 5) = (/ & + &2.2572e-02_r8,2.4412e-02_r8,2.6829e-02_r8,3.0022e-02_r8,3.4040e-02_r8/) + kbo(:,43, 5) = (/ & + &1.8476e-02_r8,1.9991e-02_r8,2.1997e-02_r8,2.4673e-02_r8,2.8080e-02_r8/) + kbo(:,44, 5) = (/ & + &1.5092e-02_r8,1.6330e-02_r8,1.7973e-02_r8,2.0194e-02_r8,2.3058e-02_r8/) + kbo(:,45, 5) = (/ & + &1.2321e-02_r8,1.3334e-02_r8,1.4674e-02_r8,1.6507e-02_r8,1.8911e-02_r8/) + kbo(:,46, 5) = (/ & + &1.0036e-02_r8,1.0861e-02_r8,1.1940e-02_r8,1.3440e-02_r8,1.5434e-02_r8/) + kbo(:,47, 5) = (/ & + &8.1439e-03_r8,8.8117e-03_r8,9.6681e-03_r8,1.0871e-02_r8,1.2500e-02_r8/) + kbo(:,48, 5) = (/ & + &6.6059e-03_r8,7.1462e-03_r8,7.8259e-03_r8,8.7835e-03_r8,1.0106e-02_r8/) + kbo(:,49, 5) = (/ & + &5.3548e-03_r8,5.7913e-03_r8,6.3343e-03_r8,7.0935e-03_r8,8.1581e-03_r8/) + kbo(:,50, 5) = (/ & + &4.3482e-03_r8,4.7014e-03_r8,5.1411e-03_r8,5.7429e-03_r8,6.6034e-03_r8/) + kbo(:,51, 5) = (/ & + &3.5331e-03_r8,3.8185e-03_r8,4.1765e-03_r8,4.6543e-03_r8,5.3466e-03_r8/) + kbo(:,52, 5) = (/ & + &2.8695e-03_r8,3.1007e-03_r8,3.3920e-03_r8,3.7708e-03_r8,4.3257e-03_r8/) + kbo(:,53, 5) = (/ & + &2.3291e-03_r8,2.5165e-03_r8,2.7524e-03_r8,3.0532e-03_r8,3.4935e-03_r8/) + kbo(:,54, 5) = (/ & + &1.8925e-03_r8,2.0468e-03_r8,2.2382e-03_r8,2.4801e-03_r8,2.8323e-03_r8/) + kbo(:,55, 5) = (/ & + &1.5385e-03_r8,1.6657e-03_r8,1.8210e-03_r8,2.0171e-03_r8,2.2988e-03_r8/) + kbo(:,56, 5) = (/ & + &1.2499e-03_r8,1.3548e-03_r8,1.4808e-03_r8,1.6398e-03_r8,1.8634e-03_r8/) + kbo(:,57, 5) = (/ & + &1.0138e-03_r8,1.1010e-03_r8,1.2032e-03_r8,1.3320e-03_r8,1.5093e-03_r8/) + kbo(:,58, 5) = (/ & + &8.2159e-04_r8,8.9516e-04_r8,9.7844e-04_r8,1.0832e-03_r8,1.2245e-03_r8/) + kbo(:,59, 5) = (/ & + &6.7629e-04_r8,7.3875e-04_r8,8.0921e-04_r8,8.9812e-04_r8,1.0190e-03_r8/) + kbo(:,13, 6) = (/ & + &8.6109e+00_r8,8.6045e+00_r8,8.6391e+00_r8,8.7159e+00_r8,8.8472e+00_r8/) + kbo(:,14, 6) = (/ & + &7.2012e+00_r8,7.1992e+00_r8,7.2347e+00_r8,7.3193e+00_r8,7.4652e+00_r8/) + kbo(:,15, 6) = (/ & + &6.0036e+00_r8,6.0084e+00_r8,6.0525e+00_r8,6.1531e+00_r8,6.3134e+00_r8/) + kbo(:,16, 6) = (/ & + &4.9860e+00_r8,4.9990e+00_r8,5.0571e+00_r8,5.1776e+00_r8,5.3476e+00_r8/) + kbo(:,17, 6) = (/ & + &4.1286e+00_r8,4.1532e+00_r8,4.2350e+00_r8,4.3671e+00_r8,4.5277e+00_r8/) + kbo(:,18, 6) = (/ & + &3.4143e+00_r8,3.4596e+00_r8,3.5560e+00_r8,3.6799e+00_r8,3.8169e+00_r8/) + kbo(:,19, 6) = (/ & + &2.8306e+00_r8,2.8919e+00_r8,2.9820e+00_r8,3.0877e+00_r8,3.2050e+00_r8/) + kbo(:,20, 6) = (/ & + &2.3552e+00_r8,2.4158e+00_r8,2.4951e+00_r8,2.5846e+00_r8,2.6876e+00_r8/) + kbo(:,21, 6) = (/ & + &1.9600e+00_r8,2.0149e+00_r8,2.0826e+00_r8,2.1623e+00_r8,2.2526e+00_r8/) + kbo(:,22, 6) = (/ & + &1.6326e+00_r8,1.6825e+00_r8,1.7432e+00_r8,1.8140e+00_r8,1.8956e+00_r8/) + kbo(:,23, 6) = (/ & + &1.3616e+00_r8,1.4065e+00_r8,1.4611e+00_r8,1.5245e+00_r8,1.5974e+00_r8/) + kbo(:,24, 6) = (/ & + &1.1379e+00_r8,1.1784e+00_r8,1.2266e+00_r8,1.2828e+00_r8,1.3489e+00_r8/) + kbo(:,25, 6) = (/ & + &9.5263e-01_r8,9.8858e-01_r8,1.0309e+00_r8,1.0818e+00_r8,1.1428e+00_r8/) + kbo(:,26, 6) = (/ & + &7.9793e-01_r8,8.2975e-01_r8,8.6871e-01_r8,9.1620e-01_r8,9.7213e-01_r8/) + kbo(:,27, 6) = (/ & + &6.6853e-01_r8,6.9732e-01_r8,7.3341e-01_r8,7.7799e-01_r8,8.3032e-01_r8/) + kbo(:,28, 6) = (/ & + &5.6032e-01_r8,5.8734e-01_r8,6.2174e-01_r8,6.6339e-01_r8,7.1179e-01_r8/) + kbo(:,29, 6) = (/ & + &4.7080e-01_r8,4.9684e-01_r8,5.2958e-01_r8,5.6837e-01_r8,6.1280e-01_r8/) + kbo(:,30, 6) = (/ & + &3.9732e-01_r8,4.2229e-01_r8,4.5298e-01_r8,4.8884e-01_r8,5.2914e-01_r8/) + kbo(:,31, 6) = (/ & + &3.3719e-01_r8,3.6099e-01_r8,3.8930e-01_r8,4.2211e-01_r8,4.5851e-01_r8/) + kbo(:,32, 6) = (/ & + &2.8780e-01_r8,3.1000e-01_r8,3.3607e-01_r8,3.6581e-01_r8,3.9865e-01_r8/) + kbo(:,33, 6) = (/ & + &2.4698e-01_r8,2.6737e-01_r8,2.9124e-01_r8,3.1811e-01_r8,3.4839e-01_r8/) + kbo(:,34, 6) = (/ & + &2.1208e-01_r8,2.3079e-01_r8,2.5250e-01_r8,2.7695e-01_r8,3.0517e-01_r8/) + kbo(:,35, 6) = (/ & + &1.8116e-01_r8,1.9828e-01_r8,2.1775e-01_r8,2.3997e-01_r8,2.6607e-01_r8/) + kbo(:,36, 6) = (/ & + &1.5361e-01_r8,1.6893e-01_r8,1.8633e-01_r8,2.0647e-01_r8,2.3023e-01_r8/) + kbo(:,37, 6) = (/ & + &1.2853e-01_r8,1.4194e-01_r8,1.5730e-01_r8,1.7520e-01_r8,1.9644e-01_r8/) + kbo(:,38, 6) = (/ & + &1.0750e-01_r8,1.1924e-01_r8,1.3275e-01_r8,1.4862e-01_r8,1.6766e-01_r8/) + kbo(:,39, 6) = (/ & + &8.9946e-02_r8,1.0018e-01_r8,1.1208e-01_r8,1.2616e-01_r8,1.4325e-01_r8/) + kbo(:,40, 6) = (/ & + &7.4468e-02_r8,8.3253e-02_r8,9.3534e-02_r8,1.0578e-01_r8,1.2083e-01_r8/) + kbo(:,41, 6) = (/ & + &6.1560e-02_r8,6.9060e-02_r8,7.7885e-02_r8,8.8512e-02_r8,1.0168e-01_r8/) + kbo(:,42, 6) = (/ & + &5.0884e-02_r8,5.7270e-02_r8,6.4836e-02_r8,7.4017e-02_r8,8.5530e-02_r8/) + kbo(:,43, 6) = (/ & + &4.1741e-02_r8,4.7136e-02_r8,5.3555e-02_r8,6.1413e-02_r8,7.1280e-02_r8/) + kbo(:,44, 6) = (/ & + &3.4114e-02_r8,3.8637e-02_r8,4.4075e-02_r8,5.0720e-02_r8,5.9134e-02_r8/) + kbo(:,45, 6) = (/ & + &2.7843e-02_r8,3.1631e-02_r8,3.6225e-02_r8,4.1848e-02_r8,4.9013e-02_r8/) + kbo(:,46, 6) = (/ & + &2.2624e-02_r8,2.5773e-02_r8,2.9633e-02_r8,3.4369e-02_r8,4.0405e-02_r8/) + kbo(:,47, 6) = (/ & + &1.8260e-02_r8,2.0843e-02_r8,2.4043e-02_r8,2.7985e-02_r8,3.3023e-02_r8/) + kbo(:,48, 6) = (/ & + &1.4711e-02_r8,1.6820e-02_r8,1.9466e-02_r8,2.2727e-02_r8,2.6914e-02_r8/) + kbo(:,49, 6) = (/ & + &1.1827e-02_r8,1.3542e-02_r8,1.5709e-02_r8,1.8410e-02_r8,2.1875e-02_r8/) + kbo(:,50, 6) = (/ & + &9.5219e-03_r8,1.0923e-02_r8,1.2699e-02_r8,1.4938e-02_r8,1.7808e-02_r8/) + kbo(:,51, 6) = (/ & + &7.6687e-03_r8,8.8049e-03_r8,1.0259e-02_r8,1.2113e-02_r8,1.4495e-02_r8/) + kbo(:,52, 6) = (/ & + &6.1732e-03_r8,7.0853e-03_r8,8.2719e-03_r8,9.7966e-03_r8,1.1770e-02_r8/) + kbo(:,53, 6) = (/ & + &4.9698e-03_r8,5.6903e-03_r8,6.6530e-03_r8,7.9081e-03_r8,9.5294e-03_r8/) + kbo(:,54, 6) = (/ & + &4.0149e-03_r8,4.5833e-03_r8,5.3685e-03_r8,6.4021e-03_r8,7.7450e-03_r8/) + kbo(:,55, 6) = (/ & + &3.2497e-03_r8,3.6951e-03_r8,4.3359e-03_r8,5.1870e-03_r8,6.3011e-03_r8/) + kbo(:,56, 6) = (/ & + &2.6325e-03_r8,2.9773e-03_r8,3.4964e-03_r8,4.1937e-03_r8,5.1170e-03_r8/) + kbo(:,57, 6) = (/ & + &2.1354e-03_r8,2.3977e-03_r8,2.8151e-03_r8,3.3845e-03_r8,4.1468e-03_r8/) + kbo(:,58, 6) = (/ & + &1.7364e-03_r8,1.9358e-03_r8,2.2698e-03_r8,2.7348e-03_r8,3.3639e-03_r8/) + kbo(:,59, 6) = (/ & + &1.4324e-03_r8,1.6023e-03_r8,1.8879e-03_r8,2.2888e-03_r8,2.8370e-03_r8/) + kbo(:,13, 7) = (/ & + &1.7993e+01_r8,1.8373e+01_r8,1.8772e+01_r8,1.9157e+01_r8,1.9544e+01_r8/) + kbo(:,14, 7) = (/ & + &1.5395e+01_r8,1.5713e+01_r8,1.6031e+01_r8,1.6348e+01_r8,1.6675e+01_r8/) + kbo(:,15, 7) = (/ & + &1.3087e+01_r8,1.3328e+01_r8,1.3586e+01_r8,1.3851e+01_r8,1.4166e+01_r8/) + kbo(:,16, 7) = (/ & + &1.1053e+01_r8,1.1254e+01_r8,1.1469e+01_r8,1.1711e+01_r8,1.2037e+01_r8/) + kbo(:,17, 7) = (/ & + &9.3076e+00_r8,9.4744e+00_r8,9.6627e+00_r8,9.9088e+00_r8,1.0257e+01_r8/) + kbo(:,18, 7) = (/ & + &7.8193e+00_r8,7.9665e+00_r8,8.1534e+00_r8,8.4211e+00_r8,8.7715e+00_r8/) + kbo(:,19, 7) = (/ & + &6.5448e+00_r8,6.6861e+00_r8,6.8916e+00_r8,7.1741e+00_r8,7.4962e+00_r8/) + kbo(:,20, 7) = (/ & + &5.4651e+00_r8,5.6202e+00_r8,5.8422e+00_r8,6.1124e+00_r8,6.3952e+00_r8/) + kbo(:,21, 7) = (/ & + &4.5716e+00_r8,4.7392e+00_r8,4.9589e+00_r8,5.1951e+00_r8,5.4343e+00_r8/) + kbo(:,22, 7) = (/ & + &3.8421e+00_r8,4.0181e+00_r8,4.2111e+00_r8,4.4111e+00_r8,4.6135e+00_r8/) + kbo(:,23, 7) = (/ & + &3.2420e+00_r8,3.4014e+00_r8,3.5676e+00_r8,3.7366e+00_r8,3.9163e+00_r8/) + kbo(:,24, 7) = (/ & + &2.7372e+00_r8,2.8745e+00_r8,3.0185e+00_r8,3.1680e+00_r8,3.3279e+00_r8/) + kbo(:,25, 7) = (/ & + &2.3109e+00_r8,2.4310e+00_r8,2.5564e+00_r8,2.6909e+00_r8,2.8371e+00_r8/) + kbo(:,26, 7) = (/ & + &1.9553e+00_r8,2.0603e+00_r8,2.1726e+00_r8,2.2928e+00_r8,2.4305e+00_r8/) + kbo(:,27, 7) = (/ & + &1.6578e+00_r8,1.7514e+00_r8,1.8510e+00_r8,1.9617e+00_r8,2.0943e+00_r8/) + kbo(:,28, 7) = (/ & + &1.4096e+00_r8,1.4926e+00_r8,1.5811e+00_r8,1.6863e+00_r8,1.8139e+00_r8/) + kbo(:,29, 7) = (/ & + &1.2014e+00_r8,1.2743e+00_r8,1.3570e+00_r8,1.4576e+00_r8,1.5798e+00_r8/) + kbo(:,30, 7) = (/ & + &1.0255e+00_r8,1.0913e+00_r8,1.1701e+00_r8,1.2677e+00_r8,1.3837e+00_r8/) + kbo(:,31, 7) = (/ & + &8.7693e-01_r8,9.3909e-01_r8,1.0166e+00_r8,1.1099e+00_r8,1.2195e+00_r8/) + kbo(:,32, 7) = (/ & + &7.5259e-01_r8,8.1353e-01_r8,8.8887e-01_r8,9.7843e-01_r8,1.0818e+00_r8/) + kbo(:,33, 7) = (/ & + &6.4947e-01_r8,7.0941e-01_r8,7.8262e-01_r8,8.6809e-01_r8,9.6577e-01_r8/) + kbo(:,34, 7) = (/ & + &5.6287e-01_r8,6.2118e-01_r8,6.9115e-01_r8,7.7236e-01_r8,8.6471e-01_r8/) + kbo(:,35, 7) = (/ & + &4.8662e-01_r8,5.4191e-01_r8,6.0756e-01_r8,6.8389e-01_r8,7.7035e-01_r8/) + kbo(:,36, 7) = (/ & + &4.1799e-01_r8,4.6899e-01_r8,5.2971e-01_r8,6.0005e-01_r8,6.8040e-01_r8/) + kbo(:,37, 7) = (/ & + &3.5425e-01_r8,3.9998e-01_r8,4.5446e-01_r8,5.1797e-01_r8,5.9123e-01_r8/) + kbo(:,38, 7) = (/ & + &3.0041e-01_r8,3.4120e-01_r8,3.9013e-01_r8,4.4734e-01_r8,5.1414e-01_r8/) + kbo(:,39, 7) = (/ & + &2.5510e-01_r8,2.9152e-01_r8,3.3528e-01_r8,3.8698e-01_r8,4.4801e-01_r8/) + kbo(:,40, 7) = (/ & + &2.1385e-01_r8,2.4566e-01_r8,2.8431e-01_r8,3.3018e-01_r8,3.8482e-01_r8/) + kbo(:,41, 7) = (/ & + &1.7890e-01_r8,2.0671e-01_r8,2.4058e-01_r8,2.8118e-01_r8,3.2987e-01_r8/) + kbo(:,42, 7) = (/ & + &1.4939e-01_r8,1.7381e-01_r8,2.0357e-01_r8,2.3938e-01_r8,2.8282e-01_r8/) + kbo(:,43, 7) = (/ & + &1.2354e-01_r8,1.4458e-01_r8,1.7057e-01_r8,2.0193e-01_r8,2.4014e-01_r8/) + kbo(:,44, 7) = (/ & + &1.0153e-01_r8,1.1950e-01_r8,1.4202e-01_r8,1.6945e-01_r8,2.0287e-01_r8/) + kbo(:,45, 7) = (/ & + &8.3299e-02_r8,9.8554e-02_r8,1.1794e-01_r8,1.4189e-01_r8,1.7119e-01_r8/) + kbo(:,46, 7) = (/ & + &6.7950e-02_r8,8.0732e-02_r8,9.7254e-02_r8,1.1796e-01_r8,1.4359e-01_r8/) + kbo(:,47, 7) = (/ & + &5.4969e-02_r8,6.5444e-02_r8,7.9285e-02_r8,9.6924e-02_r8,1.1901e-01_r8/) + kbo(:,48, 7) = (/ & + &4.4384e-02_r8,5.2919e-02_r8,6.4422e-02_r8,7.9306e-02_r8,9.8242e-02_r8/) + kbo(:,49, 7) = (/ & + &3.5781e-02_r8,4.2676e-02_r8,5.2185e-02_r8,6.4673e-02_r8,8.0797e-02_r8/) + kbo(:,50, 7) = (/ & + &2.8901e-02_r8,3.4506e-02_r8,4.2382e-02_r8,5.2852e-02_r8,6.6579e-02_r8/) + kbo(:,51, 7) = (/ & + &2.3369e-02_r8,2.7878e-02_r8,3.4389e-02_r8,4.3175e-02_r8,5.4833e-02_r8/) + kbo(:,52, 7) = (/ & + &1.8862e-02_r8,2.2473e-02_r8,2.7804e-02_r8,3.5169e-02_r8,4.5009e-02_r8/) + kbo(:,53, 7) = (/ & + &1.5202e-02_r8,1.8063e-02_r8,2.2412e-02_r8,2.8532e-02_r8,3.6823e-02_r8/) + kbo(:,54, 7) = (/ & + &1.2294e-02_r8,1.4584e-02_r8,1.8116e-02_r8,2.3236e-02_r8,3.0266e-02_r8/) + kbo(:,55, 7) = (/ & + &9.9456e-03_r8,1.1792e-02_r8,1.4659e-02_r8,1.8922e-02_r8,2.4874e-02_r8/) + kbo(:,56, 7) = (/ & + &8.0324e-03_r8,9.5190e-03_r8,1.1834e-02_r8,1.5356e-02_r8,2.0377e-02_r8/) + kbo(:,57, 7) = (/ & + &6.4764e-03_r8,7.6756e-03_r8,9.5255e-03_r8,1.2420e-02_r8,1.6628e-02_r8/) + kbo(:,58, 7) = (/ & + &5.2278e-03_r8,6.1981e-03_r8,7.6844e-03_r8,1.0060e-02_r8,1.3591e-02_r8/) + kbo(:,59, 7) = (/ & + &4.3384e-03_r8,5.1762e-03_r8,6.4759e-03_r8,8.5723e-03_r8,1.1730e-02_r8/) + kbo(:,13, 8) = (/ & + &4.8706e+01_r8,5.0287e+01_r8,5.1813e+01_r8,5.3328e+01_r8,5.4791e+01_r8/) + kbo(:,14, 8) = (/ & + &4.2745e+01_r8,4.3995e+01_r8,4.5243e+01_r8,4.6475e+01_r8,4.7668e+01_r8/) + kbo(:,15, 8) = (/ & + &3.7251e+01_r8,3.8260e+01_r8,3.9278e+01_r8,4.0277e+01_r8,4.1241e+01_r8/) + kbo(:,16, 8) = (/ & + &3.2307e+01_r8,3.3121e+01_r8,3.3949e+01_r8,3.4768e+01_r8,3.5567e+01_r8/) + kbo(:,17, 8) = (/ & + &2.7892e+01_r8,2.8569e+01_r8,2.9248e+01_r8,2.9919e+01_r8,3.0586e+01_r8/) + kbo(:,18, 8) = (/ & + &2.3896e+01_r8,2.4456e+01_r8,2.5013e+01_r8,2.5581e+01_r8,2.6214e+01_r8/) + kbo(:,19, 8) = (/ & + &2.0345e+01_r8,2.0796e+01_r8,2.1262e+01_r8,2.1777e+01_r8,2.2440e+01_r8/) + kbo(:,20, 8) = (/ & + &1.7240e+01_r8,1.7611e+01_r8,1.8026e+01_r8,1.8548e+01_r8,1.9267e+01_r8/) + kbo(:,21, 8) = (/ & + &1.4559e+01_r8,1.4881e+01_r8,1.5281e+01_r8,1.5850e+01_r8,1.6627e+01_r8/) + kbo(:,22, 8) = (/ & + &1.2297e+01_r8,1.2604e+01_r8,1.3048e+01_r8,1.3680e+01_r8,1.4474e+01_r8/) + kbo(:,23, 8) = (/ & + &1.0392e+01_r8,1.0731e+01_r8,1.1231e+01_r8,1.1887e+01_r8,1.2635e+01_r8/) + kbo(:,24, 8) = (/ & + &8.8024e+00_r8,9.1906e+00_r8,9.7265e+00_r8,1.0368e+01_r8,1.1047e+01_r8/) + kbo(:,25, 8) = (/ & + &7.4985e+00_r8,7.9218e+00_r8,8.4606e+00_r8,9.0520e+00_r8,9.6698e+00_r8/) + kbo(:,26, 8) = (/ & + &6.4322e+00_r8,6.8736e+00_r8,7.3794e+00_r8,7.9154e+00_r8,8.4712e+00_r8/) + kbo(:,27, 8) = (/ & + &5.5575e+00_r8,5.9810e+00_r8,6.4388e+00_r8,6.9229e+00_r8,7.4216e+00_r8/) + kbo(:,28, 8) = (/ & + &4.8206e+00_r8,5.2066e+00_r8,5.6224e+00_r8,6.0597e+00_r8,6.5182e+00_r8/) + kbo(:,29, 8) = (/ & + &4.1909e+00_r8,4.5439e+00_r8,4.9224e+00_r8,5.3216e+00_r8,5.7541e+00_r8/) + kbo(:,30, 8) = (/ & + &3.6537e+00_r8,3.9765e+00_r8,4.3215e+00_r8,4.6952e+00_r8,5.1087e+00_r8/) + kbo(:,31, 8) = (/ & + &3.1984e+00_r8,3.4930e+00_r8,3.8129e+00_r8,4.1678e+00_r8,4.5716e+00_r8/) + kbo(:,32, 8) = (/ & + &2.8116e+00_r8,3.0829e+00_r8,3.3853e+00_r8,3.7289e+00_r8,4.1280e+00_r8/) + kbo(:,33, 8) = (/ & + &2.4834e+00_r8,2.7385e+00_r8,3.0281e+00_r8,3.3657e+00_r8,3.7662e+00_r8/) + kbo(:,34, 8) = (/ & + &2.1985e+00_r8,2.4407e+00_r8,2.7219e+00_r8,3.0561e+00_r8,3.4576e+00_r8/) + kbo(:,35, 8) = (/ & + &1.9383e+00_r8,2.1683e+00_r8,2.4400e+00_r8,2.7681e+00_r8,3.1668e+00_r8/) + kbo(:,36, 8) = (/ & + &1.6974e+00_r8,1.9136e+00_r8,2.1729e+00_r8,2.4903e+00_r8,2.8775e+00_r8/) + kbo(:,37, 8) = (/ & + &1.4652e+00_r8,1.6633e+00_r8,1.9048e+00_r8,2.2035e+00_r8,2.5698e+00_r8/) + kbo(:,38, 8) = (/ & + &1.2656e+00_r8,1.4474e+00_r8,1.6717e+00_r8,1.9523e+00_r8,2.2987e+00_r8/) + kbo(:,39, 8) = (/ & + &1.0950e+00_r8,1.2617e+00_r8,1.4708e+00_r8,1.7354e+00_r8,2.0626e+00_r8/) + kbo(:,40, 8) = (/ & + &9.3521e-01_r8,1.0851e+00_r8,1.2754e+00_r8,1.5183e+00_r8,1.8212e+00_r8/) + kbo(:,41, 8) = (/ & + &7.9768e-01_r8,9.3182e-01_r8,1.1039e+00_r8,1.3257e+00_r8,1.6049e+00_r8/) + kbo(:,42, 8) = (/ & + &6.8000e-01_r8,8.0060e-01_r8,9.5561e-01_r8,1.1575e+00_r8,1.4146e+00_r8/) + kbo(:,43, 8) = (/ & + &5.7402e-01_r8,6.8098e-01_r8,8.1874e-01_r8,9.9948e-01_r8,1.2325e+00_r8/) + kbo(:,44, 8) = (/ & + &4.8186e-01_r8,5.7592e-01_r8,6.9798e-01_r8,8.5786e-01_r8,1.0670e+00_r8/) + kbo(:,45, 8) = (/ & + &4.0392e-01_r8,4.8633e-01_r8,5.9393e-01_r8,7.3592e-01_r8,9.2240e-01_r8/) + kbo(:,46, 8) = (/ & + &3.3669e-01_r8,4.0818e-01_r8,5.0211e-01_r8,6.2723e-01_r8,7.9252e-01_r8/) + kbo(:,47, 8) = (/ & + &2.7781e-01_r8,3.3888e-01_r8,4.1961e-01_r8,5.2781e-01_r8,6.7290e-01_r8/) + kbo(:,48, 8) = (/ & + &2.2877e-01_r8,2.8059e-01_r8,3.4952e-01_r8,4.4268e-01_r8,5.6946e-01_r8/) + kbo(:,49, 8) = (/ & + &1.8802e-01_r8,2.3180e-01_r8,2.9026e-01_r8,3.7003e-01_r8,4.7989e-01_r8/) + kbo(:,50, 8) = (/ & + &1.5486e-01_r8,1.9224e-01_r8,2.4194e-01_r8,3.1045e-01_r8,4.0570e-01_r8/) + kbo(:,51, 8) = (/ & + &1.2726e-01_r8,1.5950e-01_r8,2.0189e-01_r8,2.6070e-01_r8,3.4311e-01_r8/) + kbo(:,52, 8) = (/ & + &1.0409e-01_r8,1.3185e-01_r8,1.6823e-01_r8,2.1834e-01_r8,2.8934e-01_r8/) + kbo(:,53, 8) = (/ & + &8.4711e-02_r8,1.0844e-01_r8,1.3980e-01_r8,1.8253e-01_r8,2.4332e-01_r8/) + kbo(:,54, 8) = (/ & + &6.9167e-02_r8,8.9444e-02_r8,1.1665e-01_r8,1.5372e-01_r8,2.0609e-01_r8/) + kbo(:,55, 8) = (/ & + &5.6448e-02_r8,7.3743e-02_r8,9.7299e-02_r8,1.2965e-01_r8,1.7511e-01_r8/) + kbo(:,56, 8) = (/ & + &4.5936e-02_r8,6.0554e-02_r8,8.0824e-02_r8,1.0896e-01_r8,1.4860e-01_r8/) + kbo(:,57, 8) = (/ & + &3.7232e-02_r8,4.9532e-02_r8,6.6834e-02_r8,9.1174e-02_r8,1.2579e-01_r8/) + kbo(:,58, 8) = (/ & + &3.0170e-02_r8,4.0563e-02_r8,5.5307e-02_r8,7.6347e-02_r8,1.0664e-01_r8/) + kbo(:,59, 8) = (/ & + &2.5677e-02_r8,3.5025e-02_r8,4.8385e-02_r8,6.7734e-02_r8,9.6011e-02_r8/) + kbo(:,13, 9) = (/ & + &2.6703e+02_r8,2.6279e+02_r8,2.6062e+02_r8,2.6039e+02_r8,2.6194e+02_r8/) + kbo(:,14, 9) = (/ & + &2.2898e+02_r8,2.2692e+02_r8,2.2683e+02_r8,2.2864e+02_r8,2.3216e+02_r8/) + kbo(:,15, 9) = (/ & + &1.9675e+02_r8,1.9661e+02_r8,1.9840e+02_r8,2.0200e+02_r8,2.0726e+02_r8/) + kbo(:,16, 9) = (/ & + &1.6984e+02_r8,1.7136e+02_r8,1.7476e+02_r8,1.7992e+02_r8,1.8656e+02_r8/) + kbo(:,17, 9) = (/ & + &1.4758e+02_r8,1.5050e+02_r8,1.5527e+02_r8,1.6140e+02_r8,1.6749e+02_r8/) + kbo(:,18, 9) = (/ & + &1.2946e+02_r8,1.3358e+02_r8,1.3896e+02_r8,1.4424e+02_r8,1.4936e+02_r8/) + kbo(:,19, 9) = (/ & + &1.1448e+02_r8,1.1916e+02_r8,1.2382e+02_r8,1.2832e+02_r8,1.3257e+02_r8/) + kbo(:,20, 9) = (/ & + &1.0147e+02_r8,1.0559e+02_r8,1.0961e+02_r8,1.1348e+02_r8,1.1720e+02_r8/) + kbo(:,21, 9) = (/ & + &8.9412e+01_r8,9.2958e+01_r8,9.6430e+01_r8,9.9808e+01_r8,1.0309e+02_r8/) + kbo(:,22, 9) = (/ & + &7.8582e+01_r8,8.1638e+01_r8,8.4651e+01_r8,8.7620e+01_r8,9.0634e+01_r8/) + kbo(:,23, 9) = (/ & + &6.8855e+01_r8,7.1486e+01_r8,7.4134e+01_r8,7.6820e+01_r8,7.9730e+01_r8/) + kbo(:,24, 9) = (/ & + &6.0268e+01_r8,6.2580e+01_r8,6.4940e+01_r8,6.7498e+01_r8,7.0383e+01_r8/) + kbo(:,25, 9) = (/ & + &5.2817e+01_r8,5.4857e+01_r8,5.7070e+01_r8,5.9583e+01_r8,6.2456e+01_r8/) + kbo(:,26, 9) = (/ & + &4.6400e+01_r8,4.8304e+01_r8,5.0443e+01_r8,5.2928e+01_r8,5.5843e+01_r8/) + kbo(:,27, 9) = (/ & + &4.0882e+01_r8,4.2740e+01_r8,4.4869e+01_r8,4.7387e+01_r8,5.0354e+01_r8/) + kbo(:,28, 9) = (/ & + &3.6127e+01_r8,3.8035e+01_r8,4.0229e+01_r8,4.2798e+01_r8,4.5828e+01_r8/) + kbo(:,29, 9) = (/ & + &3.2099e+01_r8,3.4067e+01_r8,3.6357e+01_r8,3.9031e+01_r8,4.2139e+01_r8/) + kbo(:,30, 9) = (/ & + &2.8701e+01_r8,3.0741e+01_r8,3.3127e+01_r8,3.5914e+01_r8,3.9160e+01_r8/) + kbo(:,31, 9) = (/ & + &2.5860e+01_r8,2.7970e+01_r8,3.0458e+01_r8,3.3377e+01_r8,3.6776e+01_r8/) + kbo(:,32, 9) = (/ & + &2.3508e+01_r8,2.5694e+01_r8,2.8287e+01_r8,3.1347e+01_r8,3.4892e+01_r8/) + kbo(:,33, 9) = (/ & + &2.1570e+01_r8,2.3849e+01_r8,2.6553e+01_r8,2.9752e+01_r8,3.3419e+01_r8/) + kbo(:,34, 9) = (/ & + &1.9918e+01_r8,2.2276e+01_r8,2.5098e+01_r8,2.8399e+01_r8,3.2162e+01_r8/) + kbo(:,35, 9) = (/ & + &1.8364e+01_r8,2.0767e+01_r8,2.3651e+01_r8,2.7001e+01_r8,3.0813e+01_r8/) + kbo(:,36, 9) = (/ & + &1.6826e+01_r8,1.9227e+01_r8,2.2113e+01_r8,2.5466e+01_r8,2.9284e+01_r8/) + kbo(:,37, 9) = (/ & + &1.5183e+01_r8,1.7515e+01_r8,2.0322e+01_r8,2.3610e+01_r8,2.7381e+01_r8/) + kbo(:,38, 9) = (/ & + &1.3727e+01_r8,1.5985e+01_r8,1.8713e+01_r8,2.1934e+01_r8,2.5649e+01_r8/) + kbo(:,39, 9) = (/ & + &1.2450e+01_r8,1.4635e+01_r8,1.7282e+01_r8,2.0444e+01_r8,2.4108e+01_r8/) + kbo(:,40, 9) = (/ & + &1.1136e+01_r8,1.3200e+01_r8,1.5726e+01_r8,1.8770e+01_r8,2.2337e+01_r8/) + kbo(:,41, 9) = (/ & + &9.9523e+00_r8,1.1888e+01_r8,1.4289e+01_r8,1.7214e+01_r8,2.0673e+01_r8/) + kbo(:,42, 9) = (/ & + &8.8997e+00_r8,1.0713e+01_r8,1.2995e+01_r8,1.5799e+01_r8,1.9151e+01_r8/) + kbo(:,43, 9) = (/ & + &7.8779e+00_r8,9.5542e+00_r8,1.1690e+01_r8,1.4348e+01_r8,1.7554e+01_r8/) + kbo(:,44, 9) = (/ & + &6.9290e+00_r8,8.4792e+00_r8,1.0459e+01_r8,1.2952e+01_r8,1.5997e+01_r8/) + kbo(:,45, 9) = (/ & + &6.0796e+00_r8,7.5168e+00_r8,9.3520e+00_r8,1.1681e+01_r8,1.4566e+01_r8/) + kbo(:,46, 9) = (/ & + &5.2960e+00_r8,6.6184e+00_r8,8.3160e+00_r8,1.0473e+01_r8,1.3177e+01_r8/) + kbo(:,47, 9) = (/ & + &4.5500e+00_r8,5.7498e+00_r8,7.3069e+00_r8,9.2819e+00_r8,1.1781e+01_r8/) + kbo(:,48, 9) = (/ & + &3.8931e+00_r8,4.9768e+00_r8,6.3975e+00_r8,8.2101e+00_r8,1.0505e+01_r8/) + kbo(:,49, 9) = (/ & + &3.3134e+00_r8,4.2874e+00_r8,5.5792e+00_r8,7.2463e+00_r8,9.3480e+00_r8/) + kbo(:,50, 9) = (/ & + &2.8246e+00_r8,3.7000e+00_r8,4.8781e+00_r8,6.4148e+00_r8,8.3545e+00_r8/) + kbo(:,51, 9) = (/ & + &2.4042e+00_r8,3.1908e+00_r8,4.2622e+00_r8,5.6755e+00_r8,7.4755e+00_r8/) + kbo(:,52, 9) = (/ & + &2.0363e+00_r8,2.7388e+00_r8,3.7098e+00_r8,5.0044e+00_r8,6.6735e+00_r8/) + kbo(:,53, 9) = (/ & + &1.7163e+00_r8,2.3398e+00_r8,3.2134e+00_r8,4.3950e+00_r8,5.9331e+00_r8/) + kbo(:,54, 9) = (/ & + &1.4526e+00_r8,2.0075e+00_r8,2.7999e+00_r8,3.8816e+00_r8,5.3040e+00_r8/) + kbo(:,55, 9) = (/ & + &1.2300e+00_r8,1.7228e+00_r8,2.4419e+00_r8,3.4323e+00_r8,4.7483e+00_r8/) + kbo(:,56, 9) = (/ & + &1.0375e+00_r8,1.4731e+00_r8,2.1205e+00_r8,3.0254e+00_r8,4.2381e+00_r8/) + kbo(:,57, 9) = (/ & + &8.7139e-01_r8,1.2530e+00_r8,1.8332e+00_r8,2.6576e+00_r8,3.7724e+00_r8/) + kbo(:,58, 9) = (/ & + &7.3413e-01_r8,1.0690e+00_r8,1.5879e+00_r8,2.3382e+00_r8,3.3642e+00_r8/) + kbo(:,59, 9) = (/ & + &6.5989e-01_r8,9.7719e-01_r8,1.4752e+00_r8,2.2003e+00_r8,3.1955e+00_r8/) + kbo(:,13,10) = (/ & + &1.1367e+03_r8,1.1187e+03_r8,1.1007e+03_r8,1.0822e+03_r8,1.0635e+03_r8/) + kbo(:,14,10) = (/ & + &1.0074e+03_r8,9.9018e+02_r8,9.7308e+02_r8,9.5574e+02_r8,9.3889e+02_r8/) + kbo(:,15,10) = (/ & + &8.7706e+02_r8,8.6124e+02_r8,8.4557e+02_r8,8.3018e+02_r8,8.1545e+02_r8/) + kbo(:,16,10) = (/ & + &7.5406e+02_r8,7.4004e+02_r8,7.2614e+02_r8,7.1298e+02_r8,7.0106e+02_r8/) + kbo(:,17,10) = (/ & + &6.4217e+02_r8,6.3016e+02_r8,6.1851e+02_r8,6.1057e+02_r8,6.1770e+02_r8/) + kbo(:,18,10) = (/ & + &5.4317e+02_r8,5.3308e+02_r8,5.2858e+02_r8,5.4063e+02_r8,5.6728e+02_r8/) + kbo(:,19,10) = (/ & + &4.6024e+02_r8,4.5629e+02_r8,4.6936e+02_r8,4.9569e+02_r8,5.2404e+02_r8/) + kbo(:,20,10) = (/ & + &3.9833e+02_r8,4.0962e+02_r8,4.3282e+02_r8,4.5686e+02_r8,4.8096e+02_r8/) + kbo(:,21,10) = (/ & + &3.5836e+02_r8,3.7926e+02_r8,4.0031e+02_r8,4.2094e+02_r8,4.4134e+02_r8/) + kbo(:,22,10) = (/ & + &3.2968e+02_r8,3.4978e+02_r8,3.6939e+02_r8,3.8833e+02_r8,4.0603e+02_r8/) + kbo(:,23,10) = (/ & + &3.0114e+02_r8,3.1980e+02_r8,3.3812e+02_r8,3.5559e+02_r8,3.7182e+02_r8/) + kbo(:,24,10) = (/ & + &2.7330e+02_r8,2.9068e+02_r8,3.0752e+02_r8,3.2347e+02_r8,3.3875e+02_r8/) + kbo(:,25,10) = (/ & + &2.4688e+02_r8,2.6295e+02_r8,2.7833e+02_r8,2.9325e+02_r8,3.0804e+02_r8/) + kbo(:,26,10) = (/ & + &2.2243e+02_r8,2.3718e+02_r8,2.5149e+02_r8,2.6591e+02_r8,2.8021e+02_r8/) + kbo(:,27,10) = (/ & + &2.0056e+02_r8,2.1372e+02_r8,2.2739e+02_r8,2.4128e+02_r8,2.5540e+02_r8/) + kbo(:,28,10) = (/ & + &1.8160e+02_r8,1.9338e+02_r8,2.0609e+02_r8,2.1959e+02_r8,2.3363e+02_r8/) + kbo(:,29,10) = (/ & + &1.6537e+02_r8,1.7620e+02_r8,1.8800e+02_r8,2.0075e+02_r8,2.1484e+02_r8/) + kbo(:,30,10) = (/ & + &1.5182e+02_r8,1.6163e+02_r8,1.7256e+02_r8,1.8487e+02_r8,1.9853e+02_r8/) + kbo(:,31,10) = (/ & + &1.4022e+02_r8,1.4937e+02_r8,1.5973e+02_r8,1.7160e+02_r8,1.8530e+02_r8/) + kbo(:,32,10) = (/ & + &1.3043e+02_r8,1.3908e+02_r8,1.4919e+02_r8,1.6089e+02_r8,1.7519e+02_r8/) + kbo(:,33,10) = (/ & + &1.2206e+02_r8,1.3058e+02_r8,1.4055e+02_r8,1.5267e+02_r8,1.6777e+02_r8/) + kbo(:,34,10) = (/ & + &1.1470e+02_r8,1.2330e+02_r8,1.3342e+02_r8,1.4627e+02_r8,1.6240e+02_r8/) + kbo(:,35,10) = (/ & + &1.0771e+02_r8,1.1657e+02_r8,1.2696e+02_r8,1.4044e+02_r8,1.5769e+02_r8/) + kbo(:,36,10) = (/ & + &1.0083e+02_r8,1.1016e+02_r8,1.2074e+02_r8,1.3465e+02_r8,1.5261e+02_r8/) + kbo(:,37,10) = (/ & + &9.3496e+01_r8,1.0322e+02_r8,1.1406e+02_r8,1.2781e+02_r8,1.4573e+02_r8/) + kbo(:,38,10) = (/ & + &8.6889e+01_r8,9.7016e+01_r8,1.0824e+02_r8,1.2185e+02_r8,1.3969e+02_r8/) + kbo(:,39,10) = (/ & + &8.1021e+01_r8,9.1487e+01_r8,1.0329e+02_r8,1.1682e+02_r8,1.3445e+02_r8/) + kbo(:,40,10) = (/ & + &7.4776e+01_r8,8.5570e+01_r8,9.7630e+01_r8,1.1098e+02_r8,1.2786e+02_r8/) + kbo(:,41,10) = (/ & + &6.8905e+01_r8,7.9963e+01_r8,9.2277e+01_r8,1.0563e+02_r8,1.2163e+02_r8/) + kbo(:,42,10) = (/ & + &6.3556e+01_r8,7.4784e+01_r8,8.7205e+01_r8,1.0072e+02_r8,1.1596e+02_r8/) + kbo(:,43,10) = (/ & + &5.8129e+01_r8,6.9316e+01_r8,8.1730e+01_r8,9.5263e+01_r8,1.0987e+02_r8/) + kbo(:,44,10) = (/ & + &5.2913e+01_r8,6.3890e+01_r8,7.6248e+01_r8,8.9686e+01_r8,1.0397e+02_r8/) + kbo(:,45,10) = (/ & + &4.8208e+01_r8,5.8780e+01_r8,7.0988e+01_r8,8.4262e+01_r8,9.8407e+01_r8/) + kbo(:,46,10) = (/ & + &4.3761e+01_r8,5.3798e+01_r8,6.5649e+01_r8,7.8725e+01_r8,9.2702e+01_r8/) + kbo(:,47,10) = (/ & + &3.9326e+01_r8,4.8763e+01_r8,6.0030e+01_r8,7.2829e+01_r8,8.6540e+01_r8/) + kbo(:,48,10) = (/ & + &3.5364e+01_r8,4.4166e+01_r8,5.4802e+01_r8,6.7118e+01_r8,8.0555e+01_r8/) + kbo(:,49,10) = (/ & + &3.1766e+01_r8,3.9895e+01_r8,4.9874e+01_r8,6.1599e+01_r8,7.4720e+01_r8/) + kbo(:,50,10) = (/ & + &2.8694e+01_r8,3.6225e+01_r8,4.5586e+01_r8,5.6696e+01_r8,6.9417e+01_r8/) + kbo(:,51,10) = (/ & + &2.5920e+01_r8,3.2954e+01_r8,4.1705e+01_r8,5.2192e+01_r8,6.4368e+01_r8/) + kbo(:,52,10) = (/ & + &2.3265e+01_r8,2.9945e+01_r8,3.8066e+01_r8,4.7953e+01_r8,5.9548e+01_r8/) + kbo(:,53,10) = (/ & + &2.0700e+01_r8,2.7205e+01_r8,3.4731e+01_r8,4.4004e+01_r8,5.4983e+01_r8/) + kbo(:,54,10) = (/ & + &1.8407e+01_r8,2.4804e+01_r8,3.1883e+01_r8,4.0571e+01_r8,5.0997e+01_r8/) + kbo(:,55,10) = (/ & + &1.6304e+01_r8,2.2551e+01_r8,2.9350e+01_r8,3.7469e+01_r8,4.7350e+01_r8/) + kbo(:,56,10) = (/ & + &1.4323e+01_r8,2.0360e+01_r8,2.7019e+01_r8,3.4608e+01_r8,4.3950e+01_r8/) + kbo(:,57,10) = (/ & + &1.2463e+01_r8,1.8241e+01_r8,2.4765e+01_r8,3.1934e+01_r8,4.0687e+01_r8/) + kbo(:,58,10) = (/ & + &1.0795e+01_r8,1.6294e+01_r8,2.2666e+01_r8,2.9555e+01_r8,3.7776e+01_r8/) + kbo(:,59,10) = (/ & + &1.0106e+01_r8,1.5507e+01_r8,2.1812e+01_r8,2.8629e+01_r8,3.6645e+01_r8/) + kbo(:,13,11) = (/ & + &1.9976e+03_r8,1.9732e+03_r8,1.9489e+03_r8,1.9244e+03_r8,1.8976e+03_r8/) + kbo(:,14,11) = (/ & + &1.8361e+03_r8,1.8109e+03_r8,1.7859e+03_r8,1.7607e+03_r8,1.7342e+03_r8/) + kbo(:,15,11) = (/ & + &1.6588e+03_r8,1.6335e+03_r8,1.6090e+03_r8,1.5838e+03_r8,1.5592e+03_r8/) + kbo(:,16,11) = (/ & + &1.4709e+03_r8,1.4475e+03_r8,1.4246e+03_r8,1.4016e+03_r8,1.3798e+03_r8/) + kbo(:,17,11) = (/ & + &1.2816e+03_r8,1.2604e+03_r8,1.2396e+03_r8,1.2204e+03_r8,1.2023e+03_r8/) + kbo(:,18,11) = (/ & + &1.1028e+03_r8,1.0839e+03_r8,1.0668e+03_r8,1.0513e+03_r8,1.0382e+03_r8/) + kbo(:,19,11) = (/ & + &9.4023e+02_r8,9.2525e+02_r8,9.1156e+02_r8,9.0352e+02_r8,9.1240e+02_r8/) + kbo(:,20,11) = (/ & + &7.9708e+02_r8,7.8540e+02_r8,7.8133e+02_r8,7.9678e+02_r8,8.2988e+02_r8/) + kbo(:,21,11) = (/ & + &6.7587e+02_r8,6.7233e+02_r8,6.8973e+02_r8,7.2606e+02_r8,7.7277e+02_r8/) + kbo(:,22,11) = (/ & + &5.8284e+02_r8,5.9841e+02_r8,6.3319e+02_r8,6.7525e+02_r8,7.1925e+02_r8/) + kbo(:,23,11) = (/ & + &5.2309e+02_r8,5.5425e+02_r8,5.9038e+02_r8,6.2826e+02_r8,6.6879e+02_r8/) + kbo(:,24,11) = (/ & + &4.8568e+02_r8,5.1820e+02_r8,5.5078e+02_r8,5.8566e+02_r8,6.2252e+02_r8/) + kbo(:,25,11) = (/ & + &4.5215e+02_r8,4.8337e+02_r8,5.1498e+02_r8,5.4697e+02_r8,5.8166e+02_r8/) + kbo(:,26,11) = (/ & + &4.2013e+02_r8,4.5049e+02_r8,4.8168e+02_r8,5.1282e+02_r8,5.4620e+02_r8/) + kbo(:,27,11) = (/ & + &3.8959e+02_r8,4.1991e+02_r8,4.5056e+02_r8,4.8229e+02_r8,5.1534e+02_r8/) + kbo(:,28,11) = (/ & + &3.6165e+02_r8,3.9145e+02_r8,4.2248e+02_r8,4.5510e+02_r8,4.8890e+02_r8/) + kbo(:,29,11) = (/ & + &3.3655e+02_r8,3.6613e+02_r8,3.9802e+02_r8,4.3186e+02_r8,4.6748e+02_r8/) + kbo(:,30,11) = (/ & + &3.1395e+02_r8,3.4455e+02_r8,3.7776e+02_r8,4.1303e+02_r8,4.5043e+02_r8/) + kbo(:,31,11) = (/ & + &2.9496e+02_r8,3.2692e+02_r8,3.6155e+02_r8,3.9895e+02_r8,4.3848e+02_r8/) + kbo(:,32,11) = (/ & + &2.7981e+02_r8,3.1316e+02_r8,3.4973e+02_r8,3.8935e+02_r8,4.3105e+02_r8/) + kbo(:,33,11) = (/ & + &2.6816e+02_r8,3.0318e+02_r8,3.4211e+02_r8,3.8404e+02_r8,4.2836e+02_r8/) + kbo(:,34,11) = (/ & + &2.5884e+02_r8,2.9576e+02_r8,3.3707e+02_r8,3.8116e+02_r8,4.2770e+02_r8/) + kbo(:,35,11) = (/ & + &2.4952e+02_r8,2.8807e+02_r8,3.3125e+02_r8,3.7732e+02_r8,4.2524e+02_r8/) + kbo(:,36,11) = (/ & + &2.3943e+02_r8,2.7867e+02_r8,3.2325e+02_r8,3.7058e+02_r8,4.1944e+02_r8/) + kbo(:,37,11) = (/ & + &2.2613e+02_r8,2.6501e+02_r8,3.0984e+02_r8,3.5803e+02_r8,4.0758e+02_r8/) + kbo(:,38,11) = (/ & + &2.1436e+02_r8,2.5281e+02_r8,2.9747e+02_r8,3.4610e+02_r8,3.9628e+02_r8/) + kbo(:,39,11) = (/ & + &2.0421e+02_r8,2.4224e+02_r8,2.8638e+02_r8,3.3523e+02_r8,3.8565e+02_r8/) + kbo(:,40,11) = (/ & + &1.9196e+02_r8,2.2865e+02_r8,2.7155e+02_r8,3.1991e+02_r8,3.7045e+02_r8/) + kbo(:,41,11) = (/ & + &1.8048e+02_r8,2.1574e+02_r8,2.5717e+02_r8,3.0447e+02_r8,3.5504e+02_r8/) + kbo(:,42,11) = (/ & + &1.7002e+02_r8,2.0375e+02_r8,2.4381e+02_r8,2.8960e+02_r8,3.3999e+02_r8/) + kbo(:,43,11) = (/ & + &1.5882e+02_r8,1.9068e+02_r8,2.2888e+02_r8,2.7297e+02_r8,3.2243e+02_r8/) + kbo(:,44,11) = (/ & + &1.4807e+02_r8,1.7774e+02_r8,2.1381e+02_r8,2.5595e+02_r8,3.0384e+02_r8/) + kbo(:,45,11) = (/ & + &1.3832e+02_r8,1.6584e+02_r8,1.9975e+02_r8,2.3997e+02_r8,2.8600e+02_r8/) + kbo(:,46,11) = (/ & + &1.2854e+02_r8,1.5423e+02_r8,1.8595e+02_r8,2.2400e+02_r8,2.6785e+02_r8/) + kbo(:,47,11) = (/ & + &1.1798e+02_r8,1.4267e+02_r8,1.7172e+02_r8,2.0717e+02_r8,2.4874e+02_r8/) + kbo(:,48,11) = (/ & + &1.0754e+02_r8,1.3197e+02_r8,1.5865e+02_r8,1.9157e+02_r8,2.3076e+02_r8/) + kbo(:,49,11) = (/ & + &9.7426e+01_r8,1.2165e+02_r8,1.4680e+02_r8,1.7709e+02_r8,2.1383e+02_r8/) + kbo(:,50,11) = (/ & + &8.8058e+01_r8,1.1199e+02_r8,1.3670e+02_r8,1.6456e+02_r8,1.9880e+02_r8/) + kbo(:,51,11) = (/ & + &7.9382e+01_r8,1.0270e+02_r8,1.2731e+02_r8,1.5331e+02_r8,1.8527e+02_r8/) + kbo(:,52,11) = (/ & + &7.1270e+01_r8,9.3720e+01_r8,1.1802e+02_r8,1.4309e+02_r8,1.7263e+02_r8/) + kbo(:,53,11) = (/ & + &6.3724e+01_r8,8.4883e+01_r8,1.0881e+02_r8,1.3358e+02_r8,1.6088e+02_r8/) + kbo(:,54,11) = (/ & + &5.7330e+01_r8,7.7159e+01_r8,1.0045e+02_r8,1.2510e+02_r8,1.5088e+02_r8/) + kbo(:,55,11) = (/ & + &5.1611e+01_r8,7.0208e+01_r8,9.2617e+01_r8,1.1701e+02_r8,1.4209e+02_r8/) + kbo(:,56,11) = (/ & + &4.6383e+01_r8,6.3679e+01_r8,8.4927e+01_r8,1.0898e+02_r8,1.3380e+02_r8/) + kbo(:,57,11) = (/ & + &4.1604e+01_r8,5.7613e+01_r8,7.7613e+01_r8,1.0100e+02_r8,1.2575e+02_r8/) + kbo(:,58,11) = (/ & + &3.7495e+01_r8,5.2208e+01_r8,7.1056e+01_r8,9.3655e+01_r8,1.1815e+02_r8/) + kbo(:,59,11) = (/ & + &3.5885e+01_r8,5.0106e+01_r8,6.8487e+01_r8,9.0651e+01_r8,1.1506e+02_r8/) + kbo(:,13,12) = (/ & + &3.5806e+03_r8,3.5582e+03_r8,3.5338e+03_r8,3.5034e+03_r8,3.4725e+03_r8/) + kbo(:,14,12) = (/ & + &3.4862e+03_r8,3.4597e+03_r8,3.4292e+03_r8,3.3949e+03_r8,3.3614e+03_r8/) + kbo(:,15,12) = (/ & + &3.3163e+03_r8,3.2855e+03_r8,3.2498e+03_r8,3.2159e+03_r8,3.1795e+03_r8/) + kbo(:,16,12) = (/ & + &3.0905e+03_r8,3.0565e+03_r8,3.0217e+03_r8,2.9883e+03_r8,2.9514e+03_r8/) + kbo(:,17,12) = (/ & + &2.8252e+03_r8,2.7909e+03_r8,2.7597e+03_r8,2.7275e+03_r8,2.6935e+03_r8/) + kbo(:,18,12) = (/ & + &2.5391e+03_r8,2.5095e+03_r8,2.4810e+03_r8,2.4508e+03_r8,2.4233e+03_r8/) + kbo(:,19,12) = (/ & + &2.2475e+03_r8,2.2231e+03_r8,2.1980e+03_r8,2.1744e+03_r8,2.1532e+03_r8/) + kbo(:,20,12) = (/ & + &1.9592e+03_r8,1.9385e+03_r8,1.9191e+03_r8,1.9031e+03_r8,1.8880e+03_r8/) + kbo(:,21,12) = (/ & + &1.6882e+03_r8,1.6730e+03_r8,1.6603e+03_r8,1.6503e+03_r8,1.6513e+03_r8/) + kbo(:,22,12) = (/ & + &1.4424e+03_r8,1.4327e+03_r8,1.4274e+03_r8,1.4386e+03_r8,1.4720e+03_r8/) + kbo(:,23,12) = (/ & + &1.2274e+03_r8,1.2245e+03_r8,1.2417e+03_r8,1.2835e+03_r8,1.3444e+03_r8/) + kbo(:,24,12) = (/ & + &1.0462e+03_r8,1.0639e+03_r8,1.1088e+03_r8,1.1752e+03_r8,1.2597e+03_r8/) + kbo(:,25,12) = (/ & + &9.1114e+02_r8,9.5200e+02_r8,1.0177e+03_r8,1.1057e+03_r8,1.2094e+03_r8/) + kbo(:,26,12) = (/ & + &8.2003e+02_r8,8.7985e+02_r8,9.6324e+02_r8,1.0645e+03_r8,1.1739e+03_r8/) + kbo(:,27,12) = (/ & + &7.6267e+02_r8,8.3792e+02_r8,9.2956e+02_r8,1.0323e+03_r8,1.1455e+03_r8/) + kbo(:,28,12) = (/ & + &7.2963e+02_r8,8.0994e+02_r8,9.0250e+02_r8,1.0075e+03_r8,1.1258e+03_r8/) + kbo(:,29,12) = (/ & + &7.0594e+02_r8,7.8863e+02_r8,8.8342e+02_r8,9.9282e+02_r8,1.1166e+03_r8/) + kbo(:,30,12) = (/ & + &6.8865e+02_r8,7.7319e+02_r8,8.7237e+02_r8,9.8744e+02_r8,1.1171e+03_r8/) + kbo(:,31,12) = (/ & + &6.7685e+02_r8,7.6521e+02_r8,8.7052e+02_r8,9.9144e+02_r8,1.1267e+03_r8/) + kbo(:,32,12) = (/ & + &6.7111e+02_r8,7.6562e+02_r8,8.7695e+02_r8,1.0037e+03_r8,1.1434e+03_r8/) + kbo(:,33,12) = (/ & + &6.7259e+02_r8,7.7346e+02_r8,8.9020e+02_r8,1.0220e+03_r8,1.1658e+03_r8/) + kbo(:,34,12) = (/ & + &6.7713e+02_r8,7.8296e+02_r8,9.0470e+02_r8,1.0405e+03_r8,1.1875e+03_r8/) + kbo(:,35,12) = (/ & + &6.7665e+02_r8,7.8599e+02_r8,9.1053e+02_r8,1.0483e+03_r8,1.1976e+03_r8/) + kbo(:,36,12) = (/ & + &6.6854e+02_r8,7.7898e+02_r8,9.0439e+02_r8,1.0428e+03_r8,1.1928e+03_r8/) + kbo(:,37,12) = (/ & + &6.4709e+02_r8,7.5625e+02_r8,8.8001e+02_r8,1.0171e+03_r8,1.1660e+03_r8/) + kbo(:,38,12) = (/ & + &6.2682e+02_r8,7.3409e+02_r8,8.5611e+02_r8,9.9182e+02_r8,1.1392e+03_r8/) + kbo(:,39,12) = (/ & + &6.0784e+02_r8,7.1328e+02_r8,8.3356e+02_r8,9.6784e+02_r8,1.1136e+03_r8/) + kbo(:,40,12) = (/ & + &5.7971e+02_r8,6.8247e+02_r8,7.9953e+02_r8,9.3053e+02_r8,1.0739e+03_r8/) + kbo(:,41,12) = (/ & + &5.5088e+02_r8,6.5173e+02_r8,7.6511e+02_r8,8.9294e+02_r8,1.0334e+03_r8/) + kbo(:,42,12) = (/ & + &5.2250e+02_r8,6.2258e+02_r8,7.3222e+02_r8,8.5651e+02_r8,9.9385e+02_r8/) + kbo(:,43,12) = (/ & + &4.8933e+02_r8,5.8876e+02_r8,6.9433e+02_r8,8.1420e+02_r8,9.4769e+02_r8/) + kbo(:,44,12) = (/ & + &4.5428e+02_r8,5.5295e+02_r8,6.5546e+02_r8,7.7054e+02_r8,8.9971e+02_r8/) + kbo(:,45,12) = (/ & + &4.2007e+02_r8,5.1771e+02_r8,6.1870e+02_r8,7.2869e+02_r8,8.5325e+02_r8/) + kbo(:,46,12) = (/ & + &3.8522e+02_r8,4.8086e+02_r8,5.8089e+02_r8,6.8626e+02_r8,8.0577e+02_r8/) + kbo(:,47,12) = (/ & + &3.4877e+02_r8,4.4033e+02_r8,5.3933e+02_r8,6.4157e+02_r8,7.5519e+02_r8/) + kbo(:,48,12) = (/ & + &3.1493e+02_r8,4.0108e+02_r8,4.9823e+02_r8,5.9910e+02_r8,7.0691e+02_r8/) + kbo(:,49,12) = (/ & + &2.8364e+02_r8,3.6388e+02_r8,4.5779e+02_r8,5.5756e+02_r8,6.6121e+02_r8/) + kbo(:,50,12) = (/ & + &2.5678e+02_r8,3.3121e+02_r8,4.2060e+02_r8,5.1905e+02_r8,6.2075e+02_r8/) + kbo(:,51,12) = (/ & + &2.3307e+02_r8,3.0175e+02_r8,3.8585e+02_r8,4.8220e+02_r8,5.8283e+02_r8/) + kbo(:,52,12) = (/ & + &2.1162e+02_r8,2.7441e+02_r8,3.5299e+02_r8,4.4577e+02_r8,5.4547e+02_r8/) + kbo(:,53,12) = (/ & + &1.9234e+02_r8,2.4923e+02_r8,3.2216e+02_r8,4.1019e+02_r8,5.0837e+02_r8/) + kbo(:,54,12) = (/ & + &1.7628e+02_r8,2.2813e+02_r8,2.9582e+02_r8,3.7887e+02_r8,4.7480e+02_r8/) + kbo(:,55,12) = (/ & + &1.6140e+02_r8,2.0966e+02_r8,2.7210e+02_r8,3.5029e+02_r8,4.4296e+02_r8/) + kbo(:,56,12) = (/ & + &1.4678e+02_r8,1.9288e+02_r8,2.5016e+02_r8,3.2346e+02_r8,4.1177e+02_r8/) + kbo(:,57,12) = (/ & + &1.3255e+02_r8,1.7758e+02_r8,2.2997e+02_r8,2.9828e+02_r8,3.8188e+02_r8/) + kbo(:,58,12) = (/ & + &1.1943e+02_r8,1.6353e+02_r8,2.1228e+02_r8,2.7566e+02_r8,3.5477e+02_r8/) + kbo(:,59,12) = (/ & + &1.1423e+02_r8,1.5792e+02_r8,2.0564e+02_r8,2.6702e+02_r8,3.4426e+02_r8/) + kbo(:,13,13) = (/ & + &6.2371e+03_r8,6.2518e+03_r8,6.2489e+03_r8,6.2389e+03_r8,6.2163e+03_r8/) + kbo(:,14,13) = (/ & + &6.5479e+03_r8,6.5460e+03_r8,6.5322e+03_r8,6.5131e+03_r8,6.4799e+03_r8/) + kbo(:,15,13) = (/ & + &6.7275e+03_r8,6.7134e+03_r8,6.6981e+03_r8,6.6679e+03_r8,6.6340e+03_r8/) + kbo(:,16,13) = (/ & + &6.7706e+03_r8,6.7549e+03_r8,6.7279e+03_r8,6.6968e+03_r8,6.6585e+03_r8/) + kbo(:,17,13) = (/ & + &6.6836e+03_r8,6.6601e+03_r8,6.6362e+03_r8,6.6043e+03_r8,6.5760e+03_r8/) + kbo(:,18,13) = (/ & + &6.4651e+03_r8,6.4504e+03_r8,6.4295e+03_r8,6.4100e+03_r8,6.3855e+03_r8/) + kbo(:,19,13) = (/ & + &6.1476e+03_r8,6.1374e+03_r8,6.1314e+03_r8,6.1247e+03_r8,6.1206e+03_r8/) + kbo(:,20,13) = (/ & + &5.7657e+03_r8,5.7701e+03_r8,5.7793e+03_r8,5.7885e+03_r8,5.8038e+03_r8/) + kbo(:,21,13) = (/ & + &5.3372e+03_r8,5.3657e+03_r8,5.3946e+03_r8,5.4291e+03_r8,5.4659e+03_r8/) + kbo(:,22,13) = (/ & + &4.8964e+03_r8,4.9428e+03_r8,4.9998e+03_r8,5.0621e+03_r8,5.1258e+03_r8/) + kbo(:,23,13) = (/ & + &4.4608e+03_r8,4.5344e+03_r8,4.6177e+03_r8,4.7044e+03_r8,4.8008e+03_r8/) + kbo(:,24,13) = (/ & + &4.0572e+03_r8,4.1535e+03_r8,4.2613e+03_r8,4.3798e+03_r8,4.5026e+03_r8/) + kbo(:,25,13) = (/ & + &3.6891e+03_r8,3.8125e+03_r8,3.9482e+03_r8,4.0905e+03_r8,4.2411e+03_r8/) + kbo(:,26,13) = (/ & + &3.3690e+03_r8,3.5206e+03_r8,3.6781e+03_r8,3.8529e+03_r8,4.0416e+03_r8/) + kbo(:,27,13) = (/ & + &3.0960e+03_r8,3.2709e+03_r8,3.4667e+03_r8,3.6805e+03_r8,3.9027e+03_r8/) + kbo(:,28,13) = (/ & + &2.8685e+03_r8,3.0838e+03_r8,3.3203e+03_r8,3.5644e+03_r8,3.8131e+03_r8/) + kbo(:,29,13) = (/ & + &2.7079e+03_r8,2.9620e+03_r8,3.2275e+03_r8,3.4951e+03_r8,3.7635e+03_r8/) + kbo(:,30,13) = (/ & + &2.6061e+03_r8,2.8858e+03_r8,3.1752e+03_r8,3.4611e+03_r8,3.7451e+03_r8/) + kbo(:,31,13) = (/ & + &2.5477e+03_r8,2.8507e+03_r8,3.1575e+03_r8,3.4577e+03_r8,3.7506e+03_r8/) + kbo(:,32,13) = (/ & + &2.5270e+03_r8,2.8474e+03_r8,3.1664e+03_r8,3.4757e+03_r8,3.7742e+03_r8/) + kbo(:,33,13) = (/ & + &2.5348e+03_r8,2.8669e+03_r8,3.1934e+03_r8,3.5095e+03_r8,3.8093e+03_r8/) + kbo(:,34,13) = (/ & + &2.5519e+03_r8,2.8931e+03_r8,3.2251e+03_r8,3.5432e+03_r8,3.8451e+03_r8/) + kbo(:,35,13) = (/ & + &2.5512e+03_r8,2.8985e+03_r8,3.2338e+03_r8,3.5558e+03_r8,3.8584e+03_r8/) + kbo(:,36,13) = (/ & + &2.5221e+03_r8,2.8745e+03_r8,3.2143e+03_r8,3.5395e+03_r8,3.8450e+03_r8/) + kbo(:,37,13) = (/ & + &2.4460e+03_r8,2.8025e+03_r8,3.1490e+03_r8,3.4791e+03_r8,3.7899e+03_r8/) + kbo(:,38,13) = (/ & + &2.3708e+03_r8,2.7313e+03_r8,3.0831e+03_r8,3.4179e+03_r8,3.7342e+03_r8/) + kbo(:,39,13) = (/ & + &2.3003e+03_r8,2.6642e+03_r8,3.0201e+03_r8,3.3586e+03_r8,3.6803e+03_r8/) + kbo(:,40,13) = (/ & + &2.1969e+03_r8,2.5616e+03_r8,2.9219e+03_r8,3.2671e+03_r8,3.5954e+03_r8/) + kbo(:,41,13) = (/ & + &2.0924e+03_r8,2.4560e+03_r8,2.8204e+03_r8,3.1716e+03_r8,3.5055e+03_r8/) + kbo(:,42,13) = (/ & + &1.9915e+03_r8,2.3511e+03_r8,2.7188e+03_r8,3.0759e+03_r8,3.4151e+03_r8/) + kbo(:,43,13) = (/ & + &1.8747e+03_r8,2.2279e+03_r8,2.5969e+03_r8,2.9589e+03_r8,3.3053e+03_r8/) + kbo(:,44,13) = (/ & + &1.7544e+03_r8,2.0986e+03_r8,2.4653e+03_r8,2.8326e+03_r8,3.1860e+03_r8/) + kbo(:,45,13) = (/ & + &1.6386e+03_r8,1.9731e+03_r8,2.3348e+03_r8,2.7048e+03_r8,3.0644e+03_r8/) + kbo(:,46,13) = (/ & + &1.5205e+03_r8,1.8444e+03_r8,2.1974e+03_r8,2.5688e+03_r8,2.9332e+03_r8/) + kbo(:,47,13) = (/ & + &1.3958e+03_r8,1.7058e+03_r8,2.0486e+03_r8,2.4160e+03_r8,2.7851e+03_r8/) + kbo(:,48,13) = (/ & + &1.2783e+03_r8,1.5734e+03_r8,1.9036e+03_r8,2.2627e+03_r8,2.6347e+03_r8/) + kbo(:,49,13) = (/ & + &1.1678e+03_r8,1.4470e+03_r8,1.7643e+03_r8,2.1130e+03_r8,2.4832e+03_r8/) + kbo(:,50,13) = (/ & + &1.0712e+03_r8,1.3344e+03_r8,1.6384e+03_r8,1.9762e+03_r8,2.3408e+03_r8/) + kbo(:,51,13) = (/ & + &9.8353e+02_r8,1.2311e+03_r8,1.5209e+03_r8,1.8472e+03_r8,2.2032e+03_r8/) + kbo(:,52,13) = (/ & + &9.0254e+02_r8,1.1339e+03_r8,1.4093e+03_r8,1.7232e+03_r8,2.0693e+03_r8/) + kbo(:,53,13) = (/ & + &8.2760e+02_r8,1.0429e+03_r8,1.3025e+03_r8,1.6032e+03_r8,1.9381e+03_r8/) + kbo(:,54,13) = (/ & + &7.6424e+02_r8,9.6451e+02_r8,1.2096e+03_r8,1.4971e+03_r8,1.8216e+03_r8/) + kbo(:,55,13) = (/ & + &7.1080e+02_r8,8.9446e+02_r8,1.1253e+03_r8,1.4000e+03_r8,1.7133e+03_r8/) + kbo(:,56,13) = (/ & + &6.6381e+02_r8,8.2901e+02_r8,1.0458e+03_r8,1.3069e+03_r8,1.6083e+03_r8/) + kbo(:,57,13) = (/ & + &6.2290e+02_r8,7.6867e+02_r8,9.7122e+02_r8,1.2178e+03_r8,1.5070e+03_r8/) + kbo(:,58,13) = (/ & + &5.8709e+02_r8,7.1760e+02_r8,9.0453e+02_r8,1.1378e+03_r8,1.4149e+03_r8/) + kbo(:,59,13) = (/ & + &5.7268e+02_r8,6.9849e+02_r8,8.7854e+02_r8,1.1067e+03_r8,1.3783e+03_r8/) + kbo(:,13,14) = (/ & + &9.8812e+03_r8,9.9499e+03_r8,9.9974e+03_r8,1.0022e+04_r8,1.0029e+04_r8/) + kbo(:,14,14) = (/ & + &1.1156e+04_r8,1.1216e+04_r8,1.1254e+04_r8,1.1270e+04_r8,1.1265e+04_r8/) + kbo(:,15,14) = (/ & + &1.2449e+04_r8,1.2496e+04_r8,1.2517e+04_r8,1.2519e+04_r8,1.2490e+04_r8/) + kbo(:,16,14) = (/ & + &1.3700e+04_r8,1.3729e+04_r8,1.3741e+04_r8,1.3718e+04_r8,1.3680e+04_r8/) + kbo(:,17,14) = (/ & + &1.4861e+04_r8,1.4895e+04_r8,1.4882e+04_r8,1.4853e+04_r8,1.4786e+04_r8/) + kbo(:,18,14) = (/ & + &1.5910e+04_r8,1.5917e+04_r8,1.5910e+04_r8,1.5867e+04_r8,1.5794e+04_r8/) + kbo(:,19,14) = (/ & + &1.6801e+04_r8,1.6817e+04_r8,1.6802e+04_r8,1.6758e+04_r8,1.6676e+04_r8/) + kbo(:,20,14) = (/ & + &1.7524e+04_r8,1.7556e+04_r8,1.7546e+04_r8,1.7509e+04_r8,1.7437e+04_r8/) + kbo(:,21,14) = (/ & + &1.8096e+04_r8,1.8141e+04_r8,1.8145e+04_r8,1.8122e+04_r8,1.8064e+04_r8/) + kbo(:,22,14) = (/ & + &1.8520e+04_r8,1.8595e+04_r8,1.8633e+04_r8,1.8624e+04_r8,1.8566e+04_r8/) + kbo(:,23,14) = (/ & + &1.8825e+04_r8,1.8946e+04_r8,1.9018e+04_r8,1.9030e+04_r8,1.8984e+04_r8/) + kbo(:,24,14) = (/ & + &1.9042e+04_r8,1.9220e+04_r8,1.9316e+04_r8,1.9349e+04_r8,1.9324e+04_r8/) + kbo(:,25,14) = (/ & + &1.9210e+04_r8,1.9418e+04_r8,1.9542e+04_r8,1.9606e+04_r8,1.9602e+04_r8/) + kbo(:,26,14) = (/ & + &1.9338e+04_r8,1.9577e+04_r8,1.9740e+04_r8,1.9821e+04_r8,1.9828e+04_r8/) + kbo(:,27,14) = (/ & + &1.9451e+04_r8,1.9723e+04_r8,1.9903e+04_r8,2.0002e+04_r8,2.0015e+04_r8/) + kbo(:,28,14) = (/ & + &1.9563e+04_r8,1.9853e+04_r8,2.0047e+04_r8,2.0156e+04_r8,2.0162e+04_r8/) + kbo(:,29,14) = (/ & + &1.9675e+04_r8,1.9975e+04_r8,2.0176e+04_r8,2.0280e+04_r8,2.0284e+04_r8/) + kbo(:,30,14) = (/ & + &1.9781e+04_r8,2.0092e+04_r8,2.0291e+04_r8,2.0384e+04_r8,2.0380e+04_r8/) + kbo(:,31,14) = (/ & + &1.9898e+04_r8,2.0205e+04_r8,2.0389e+04_r8,2.0467e+04_r8,2.0456e+04_r8/) + kbo(:,32,14) = (/ & + &2.0014e+04_r8,2.0306e+04_r8,2.0476e+04_r8,2.0543e+04_r8,2.0514e+04_r8/) + kbo(:,33,14) = (/ & + &2.0125e+04_r8,2.0400e+04_r8,2.0544e+04_r8,2.0600e+04_r8,2.0558e+04_r8/) + kbo(:,34,14) = (/ & + &2.0217e+04_r8,2.0476e+04_r8,2.0611e+04_r8,2.0645e+04_r8,2.0591e+04_r8/) + kbo(:,35,14) = (/ & + &2.0276e+04_r8,2.0526e+04_r8,2.0654e+04_r8,2.0682e+04_r8,2.0620e+04_r8/) + kbo(:,36,14) = (/ & + &2.0294e+04_r8,2.0553e+04_r8,2.0682e+04_r8,2.0712e+04_r8,2.0656e+04_r8/) + kbo(:,37,14) = (/ & + &2.0260e+04_r8,2.0540e+04_r8,2.0692e+04_r8,2.0741e+04_r8,2.0704e+04_r8/) + kbo(:,38,14) = (/ & + &2.0217e+04_r8,2.0522e+04_r8,2.0695e+04_r8,2.0763e+04_r8,2.0734e+04_r8/) + kbo(:,39,14) = (/ & + &2.0167e+04_r8,2.0500e+04_r8,2.0691e+04_r8,2.0777e+04_r8,2.0762e+04_r8/) + kbo(:,40,14) = (/ & + &2.0068e+04_r8,2.0438e+04_r8,2.0666e+04_r8,2.0778e+04_r8,2.0786e+04_r8/) + kbo(:,41,14) = (/ & + &1.9949e+04_r8,2.0361e+04_r8,2.0631e+04_r8,2.0768e+04_r8,2.0804e+04_r8/) + kbo(:,42,14) = (/ & + &1.9819e+04_r8,2.0274e+04_r8,2.0579e+04_r8,2.0750e+04_r8,2.0814e+04_r8/) + kbo(:,43,14) = (/ & + &1.9645e+04_r8,2.0149e+04_r8,2.0503e+04_r8,2.0721e+04_r8,2.0814e+04_r8/) + kbo(:,44,14) = (/ & + &1.9429e+04_r8,1.9994e+04_r8,2.0396e+04_r8,2.0663e+04_r8,2.0798e+04_r8/) + kbo(:,45,14) = (/ & + &1.9189e+04_r8,1.9824e+04_r8,2.0285e+04_r8,2.0595e+04_r8,2.0770e+04_r8/) + kbo(:,46,14) = (/ & + &1.8912e+04_r8,1.9621e+04_r8,2.0139e+04_r8,2.0501e+04_r8,2.0722e+04_r8/) + kbo(:,47,14) = (/ & + &1.8574e+04_r8,1.9355e+04_r8,1.9947e+04_r8,2.0373e+04_r8,2.0652e+04_r8/) + kbo(:,48,14) = (/ & + &1.8199e+04_r8,1.9060e+04_r8,1.9733e+04_r8,2.0223e+04_r8,2.0560e+04_r8/) + kbo(:,49,14) = (/ & + &1.7788e+04_r8,1.8737e+04_r8,1.9487e+04_r8,2.0042e+04_r8,2.0440e+04_r8/) + kbo(:,50,14) = (/ & + &1.7372e+04_r8,1.8402e+04_r8,1.9222e+04_r8,1.9853e+04_r8,2.0312e+04_r8/) + kbo(:,51,14) = (/ & + &1.6932e+04_r8,1.8048e+04_r8,1.8944e+04_r8,1.9653e+04_r8,2.0163e+04_r8/) + kbo(:,52,14) = (/ & + &1.6460e+04_r8,1.7668e+04_r8,1.8640e+04_r8,1.9416e+04_r8,1.9992e+04_r8/) + kbo(:,53,14) = (/ & + &1.5959e+04_r8,1.7252e+04_r8,1.8310e+04_r8,1.9147e+04_r8,1.9806e+04_r8/) + kbo(:,54,14) = (/ & + &1.5461e+04_r8,1.6846e+04_r8,1.7980e+04_r8,1.8888e+04_r8,1.9606e+04_r8/) + kbo(:,55,14) = (/ & + &1.4966e+04_r8,1.6424e+04_r8,1.7640e+04_r8,1.8623e+04_r8,1.9399e+04_r8/) + kbo(:,56,14) = (/ & + &1.4452e+04_r8,1.5984e+04_r8,1.7276e+04_r8,1.8327e+04_r8,1.9166e+04_r8/) + kbo(:,57,14) = (/ & + &1.3910e+04_r8,1.5518e+04_r8,1.6891e+04_r8,1.8015e+04_r8,1.8917e+04_r8/) + kbo(:,58,14) = (/ & + &1.3384e+04_r8,1.5053e+04_r8,1.6496e+04_r8,1.7699e+04_r8,1.8667e+04_r8/) + kbo(:,59,14) = (/ & + &1.3166e+04_r8,1.4859e+04_r8,1.6332e+04_r8,1.7567e+04_r8,1.8563e+04_r8/) + kbo(:,13,15) = (/ & + &1.3095e+04_r8,1.3203e+04_r8,1.3280e+04_r8,1.3335e+04_r8,1.3364e+04_r8/) + kbo(:,14,15) = (/ & + &1.5533e+04_r8,1.5637e+04_r8,1.5702e+04_r8,1.5732e+04_r8,1.5730e+04_r8/) + kbo(:,15,15) = (/ & + &1.8283e+04_r8,1.8379e+04_r8,1.8421e+04_r8,1.8416e+04_r8,1.8371e+04_r8/) + kbo(:,16,15) = (/ & + &2.1357e+04_r8,2.1409e+04_r8,2.1406e+04_r8,2.1356e+04_r8,2.1240e+04_r8/) + kbo(:,17,15) = (/ & + &2.4722e+04_r8,2.4699e+04_r8,2.4632e+04_r8,2.4482e+04_r8,2.4282e+04_r8/) + kbo(:,18,15) = (/ & + &2.8315e+04_r8,2.8214e+04_r8,2.8019e+04_r8,2.7755e+04_r8,2.7441e+04_r8/) + kbo(:,19,15) = (/ & + &3.2071e+04_r8,3.1837e+04_r8,3.1501e+04_r8,3.1092e+04_r8,3.0622e+04_r8/) + kbo(:,20,15) = (/ & + &3.5875e+04_r8,3.5466e+04_r8,3.4981e+04_r8,3.4394e+04_r8,3.3745e+04_r8/) + kbo(:,21,15) = (/ & + &3.9627e+04_r8,3.9030e+04_r8,3.8357e+04_r8,3.7580e+04_r8,3.6746e+04_r8/) + kbo(:,22,15) = (/ & + &4.3205e+04_r8,4.2400e+04_r8,4.1478e+04_r8,4.0494e+04_r8,3.9468e+04_r8/) + kbo(:,23,15) = (/ & + &4.6532e+04_r8,4.5460e+04_r8,4.4309e+04_r8,4.3126e+04_r8,4.1899e+04_r8/) + kbo(:,24,15) = (/ & + &4.9513e+04_r8,4.8176e+04_r8,4.6831e+04_r8,4.5435e+04_r8,4.4005e+04_r8/) + kbo(:,25,15) = (/ & + &5.2106e+04_r8,5.0560e+04_r8,4.9001e+04_r8,4.7400e+04_r8,4.5767e+04_r8/) + kbo(:,26,15) = (/ & + &5.4289e+04_r8,5.2537e+04_r8,5.0767e+04_r8,4.8979e+04_r8,4.7180e+04_r8/) + kbo(:,27,15) = (/ & + &5.6074e+04_r8,5.4129e+04_r8,5.2176e+04_r8,5.0219e+04_r8,4.8292e+04_r8/) + kbo(:,28,15) = (/ & + &5.7491e+04_r8,5.5358e+04_r8,5.3246e+04_r8,5.1171e+04_r8,4.9128e+04_r8/) + kbo(:,29,15) = (/ & + &5.8538e+04_r8,5.6261e+04_r8,5.4015e+04_r8,5.1836e+04_r8,4.9710e+04_r8/) + kbo(:,30,15) = (/ & + &5.9277e+04_r8,5.6882e+04_r8,5.4538e+04_r8,5.2280e+04_r8,5.0075e+04_r8/) + kbo(:,31,15) = (/ & + &5.9738e+04_r8,5.7244e+04_r8,5.4845e+04_r8,5.2509e+04_r8,5.0252e+04_r8/) + kbo(:,32,15) = (/ & + &5.9975e+04_r8,5.7405e+04_r8,5.4958e+04_r8,5.2573e+04_r8,5.0275e+04_r8/) + kbo(:,33,15) = (/ & + &6.0007e+04_r8,5.7410e+04_r8,5.4914e+04_r8,5.2499e+04_r8,5.0167e+04_r8/) + kbo(:,34,15) = (/ & + &5.9998e+04_r8,5.7359e+04_r8,5.4840e+04_r8,5.2398e+04_r8,5.0041e+04_r8/) + kbo(:,35,15) = (/ & + &6.0132e+04_r8,5.7462e+04_r8,5.4907e+04_r8,5.2438e+04_r8,5.0062e+04_r8/) + kbo(:,36,15) = (/ & + &6.0467e+04_r8,5.7764e+04_r8,5.5174e+04_r8,5.2679e+04_r8,5.0279e+04_r8/) + kbo(:,37,15) = (/ & + &6.1171e+04_r8,5.8407e+04_r8,5.5781e+04_r8,5.3245e+04_r8,5.0803e+04_r8/) + kbo(:,38,15) = (/ & + &6.1845e+04_r8,5.9045e+04_r8,5.6369e+04_r8,5.3796e+04_r8,5.1321e+04_r8/) + kbo(:,39,15) = (/ & + &6.2474e+04_r8,5.9622e+04_r8,5.6925e+04_r8,5.4319e+04_r8,5.1811e+04_r8/) + kbo(:,40,15) = (/ & + &6.3380e+04_r8,6.0485e+04_r8,5.7724e+04_r8,5.5082e+04_r8,5.2540e+04_r8/) + kbo(:,41,15) = (/ & + &6.4308e+04_r8,6.1360e+04_r8,5.8546e+04_r8,5.5868e+04_r8,5.3286e+04_r8/) + kbo(:,42,15) = (/ & + &6.5214e+04_r8,6.2221e+04_r8,5.9366e+04_r8,5.6643e+04_r8,5.4029e+04_r8/) + kbo(:,43,15) = (/ & + &6.6280e+04_r8,6.3259e+04_r8,6.0335e+04_r8,5.7567e+04_r8,5.4915e+04_r8/) + kbo(:,44,15) = (/ & + &6.7443e+04_r8,6.4360e+04_r8,6.1383e+04_r8,5.8557e+04_r8,5.5857e+04_r8/) + kbo(:,45,15) = (/ & + &6.8616e+04_r8,6.5461e+04_r8,6.2445e+04_r8,5.9557e+04_r8,5.6818e+04_r8/) + kbo(:,46,15) = (/ & + &6.9855e+04_r8,6.6628e+04_r8,6.3578e+04_r8,6.0631e+04_r8,5.7835e+04_r8/) + kbo(:,47,15) = (/ & + &7.1240e+04_r8,6.7969e+04_r8,6.4839e+04_r8,6.1843e+04_r8,5.8987e+04_r8/) + kbo(:,48,15) = (/ & + &7.2637e+04_r8,6.9326e+04_r8,6.6121e+04_r8,6.3073e+04_r8,6.0145e+04_r8/) + kbo(:,49,15) = (/ & + &7.4017e+04_r8,7.0688e+04_r8,6.7429e+04_r8,6.4324e+04_r8,6.1340e+04_r8/) + kbo(:,50,15) = (/ & + &7.5349e+04_r8,7.1972e+04_r8,6.8674e+04_r8,6.5502e+04_r8,6.2467e+04_r8/) + kbo(:,51,15) = (/ & + &7.6637e+04_r8,7.3219e+04_r8,6.9913e+04_r8,6.6663e+04_r8,6.3587e+04_r8/) + kbo(:,52,15) = (/ & + &7.7955e+04_r8,7.4483e+04_r8,7.1122e+04_r8,6.7846e+04_r8,6.4721e+04_r8/) + kbo(:,53,15) = (/ & + &7.9280e+04_r8,7.5753e+04_r8,7.2364e+04_r8,6.9053e+04_r8,6.5858e+04_r8/) + kbo(:,54,15) = (/ & + &8.0495e+04_r8,7.6933e+04_r8,7.3504e+04_r8,7.0171e+04_r8,6.6914e+04_r8/) + kbo(:,55,15) = (/ & + &8.1662e+04_r8,7.8089e+04_r8,7.4612e+04_r8,7.1233e+04_r8,6.7959e+04_r8/) + kbo(:,56,15) = (/ & + &8.2843e+04_r8,7.9230e+04_r8,7.5715e+04_r8,7.2316e+04_r8,6.9008e+04_r8/) + kbo(:,57,15) = (/ & + &8.4005e+04_r8,8.0398e+04_r8,7.6842e+04_r8,7.3404e+04_r8,7.0077e+04_r8/) + kbo(:,58,15) = (/ & + &8.5078e+04_r8,8.1502e+04_r8,7.7919e+04_r8,7.4439e+04_r8,7.1083e+04_r8/) + kbo(:,59,15) = (/ & + &8.5505e+04_r8,8.1958e+04_r8,7.8361e+04_r8,7.4870e+04_r8,7.1482e+04_r8/) + kbo(:,13,16) = (/ & + &1.4816e+04_r8,1.4930e+04_r8,1.5014e+04_r8,1.5052e+04_r8,1.5044e+04_r8/) + kbo(:,14,16) = (/ & + &1.7836e+04_r8,1.7951e+04_r8,1.8019e+04_r8,1.8017e+04_r8,1.7984e+04_r8/) + kbo(:,15,16) = (/ & + &2.1381e+04_r8,2.1462e+04_r8,2.1481e+04_r8,2.1430e+04_r8,2.1342e+04_r8/) + kbo(:,16,16) = (/ & + &2.5477e+04_r8,2.5475e+04_r8,2.5403e+04_r8,2.5275e+04_r8,2.5089e+04_r8/) + kbo(:,17,16) = (/ & + &3.0124e+04_r8,3.0002e+04_r8,2.9773e+04_r8,2.9519e+04_r8,2.9186e+04_r8/) + kbo(:,18,16) = (/ & + &3.5286e+04_r8,3.4965e+04_r8,3.4530e+04_r8,3.4092e+04_r8,3.3540e+04_r8/) + kbo(:,19,16) = (/ & + &4.0852e+04_r8,4.0241e+04_r8,3.9575e+04_r8,3.8871e+04_r8,3.8057e+04_r8/) + kbo(:,20,16) = (/ & + &4.6699e+04_r8,4.5739e+04_r8,4.4741e+04_r8,4.3700e+04_r8,4.2576e+04_r8/) + kbo(:,21,16) = (/ & + &5.2654e+04_r8,5.1275e+04_r8,4.9864e+04_r8,4.8428e+04_r8,4.6961e+04_r8/) + kbo(:,22,16) = (/ & + &5.8403e+04_r8,5.6551e+04_r8,5.4684e+04_r8,5.2822e+04_r8,5.0976e+04_r8/) + kbo(:,23,16) = (/ & + &6.3816e+04_r8,6.1463e+04_r8,5.9121e+04_r8,5.6821e+04_r8,5.4590e+04_r8/) + kbo(:,24,16) = (/ & + &6.8713e+04_r8,6.5863e+04_r8,6.3058e+04_r8,6.0345e+04_r8,5.7751e+04_r8/) + kbo(:,25,16) = (/ & + &7.2989e+04_r8,6.9656e+04_r8,6.6424e+04_r8,6.3329e+04_r8,6.0404e+04_r8/) + kbo(:,26,16) = (/ & + &7.6570e+04_r8,7.2775e+04_r8,6.9149e+04_r8,6.5716e+04_r8,6.2522e+04_r8/) + kbo(:,27,16) = (/ & + &7.9459e+04_r8,7.5274e+04_r8,7.1313e+04_r8,6.7589e+04_r8,6.4169e+04_r8/) + kbo(:,28,16) = (/ & + &8.1683e+04_r8,7.7174e+04_r8,7.2947e+04_r8,6.8995e+04_r8,6.5376e+04_r8/) + kbo(:,29,16) = (/ & + &8.3285e+04_r8,7.8510e+04_r8,7.4071e+04_r8,6.9957e+04_r8,6.6188e+04_r8/) + kbo(:,30,16) = (/ & + &8.4346e+04_r8,7.9371e+04_r8,7.4777e+04_r8,7.0557e+04_r8,6.6673e+04_r8/) + kbo(:,31,16) = (/ & + &8.4928e+04_r8,7.9835e+04_r8,7.5096e+04_r8,7.0806e+04_r8,6.6861e+04_r8/) + kbo(:,32,16) = (/ & + &8.5101e+04_r8,7.9916e+04_r8,7.5117e+04_r8,7.0792e+04_r8,6.6791e+04_r8/) + kbo(:,33,16) = (/ & + &8.4949e+04_r8,7.9717e+04_r8,7.4898e+04_r8,7.0557e+04_r8,6.6529e+04_r8/) + kbo(:,34,16) = (/ & + &8.4743e+04_r8,7.9470e+04_r8,7.4656e+04_r8,7.0309e+04_r8,6.6256e+04_r8/) + kbo(:,35,16) = (/ & + &8.4858e+04_r8,7.9542e+04_r8,7.4709e+04_r8,7.0325e+04_r8,6.6240e+04_r8/) + kbo(:,36,16) = (/ & + &8.5440e+04_r8,8.0039e+04_r8,7.5130e+04_r8,7.0697e+04_r8,6.6564e+04_r8/) + kbo(:,37,16) = (/ & + &8.6760e+04_r8,8.1217e+04_r8,7.6179e+04_r8,7.1644e+04_r8,6.7431e+04_r8/) + kbo(:,38,16) = (/ & + &8.8049e+04_r8,8.2388e+04_r8,7.7214e+04_r8,7.2579e+04_r8,6.8294e+04_r8/) + kbo(:,39,16) = (/ & + &8.9280e+04_r8,8.3525e+04_r8,7.8218e+04_r8,7.3474e+04_r8,6.9111e+04_r8/) + kbo(:,40,16) = (/ & + &9.1121e+04_r8,8.5172e+04_r8,7.9710e+04_r8,7.4807e+04_r8,7.0344e+04_r8/) + kbo(:,41,16) = (/ & + &9.3033e+04_r8,8.6893e+04_r8,8.1281e+04_r8,7.6203e+04_r8,7.1626e+04_r8/) + kbo(:,42,16) = (/ & + &9.4965e+04_r8,8.8622e+04_r8,8.0415e+04_r8,7.7606e+04_r8,7.2910e+04_r8/) + kbo(:,43,16) = (/ & + &9.7303e+04_r8,9.0720e+04_r8,8.4775e+04_r8,7.9330e+04_r8,7.4454e+04_r8/) + kbo(:,44,16) = (/ & + &9.9859e+04_r8,9.3029e+04_r8,8.6867e+04_r8,8.1230e+04_r8,7.6153e+04_r8/) + kbo(:,45,16) = (/ & + &1.0249e+05_r8,9.5410e+04_r8,8.8999e+04_r8,8.3177e+04_r8,7.7890e+04_r8/) + kbo(:,46,16) = (/ & + &1.0536e+05_r8,9.7993e+04_r8,9.1330e+04_r8,8.5316e+04_r8,7.9796e+04_r8/) + kbo(:,47,16) = (/ & + &1.0871e+05_r8,1.0095e+05_r8,9.4014e+04_r8,8.7743e+04_r8,8.2024e+04_r8/) + kbo(:,48,16) = (/ & + &1.1228e+05_r8,1.0405e+05_r8,9.6823e+04_r8,9.0264e+04_r8,8.4322e+04_r8/) + kbo(:,49,16) = (/ & + &1.1602e+05_r8,1.0727e+05_r8,9.9709e+04_r8,9.2873e+04_r8,8.6711e+04_r8/) + kbo(:,50,16) = (/ & + &1.1975e+05_r8,1.1051e+05_r8,1.0253e+05_r8,9.5425e+04_r8,8.8999e+04_r8/) + kbo(:,51,16) = (/ & + &1.2354e+05_r8,1.1380e+05_r8,1.0536e+05_r8,9.7987e+04_r8,9.1299e+04_r8/) + kbo(:,52,16) = (/ & + &1.2745e+05_r8,1.1723e+05_r8,1.0833e+05_r8,1.0062e+05_r8,9.3694e+04_r8/) + kbo(:,53,16) = (/ & + &1.3160e+05_r8,1.2088e+05_r8,1.1148e+05_r8,1.0337e+05_r8,9.6183e+04_r8/) + kbo(:,54,16) = (/ & + &1.3555e+05_r8,1.2436e+05_r8,1.1452e+05_r8,1.0598e+05_r8,9.8537e+04_r8/) + kbo(:,55,16) = (/ & + &1.3946e+05_r8,1.2781e+05_r8,1.1754e+05_r8,1.0859e+05_r8,1.0085e+05_r8/) + kbo(:,56,16) = (/ & + &1.4362e+05_r8,1.3143e+05_r8,1.2072e+05_r8,1.1136e+05_r8,1.0326e+05_r8/) + kbo(:,57,16) = (/ & + &1.4797e+05_r8,1.3519e+05_r8,1.2403e+05_r8,1.1423e+05_r8,1.0573e+05_r8/) + kbo(:,58,16) = (/ & + &1.5241e+05_r8,1.3886e+05_r8,1.2729e+05_r8,1.1707e+05_r8,1.0818e+05_r8/) + kbo(:,59,16) = (/ & + &1.5431e+05_r8,1.4041e+05_r8,1.2862e+05_r8,1.1825e+05_r8,1.0919e+05_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &2.7075e-06_r8,2.2609e-06_r8,1.5633e-06_r8,8.7484e-07_r8,5.5470e-07_r8,4.8456e-07_r8, & + &4.7463e-07_r8,4.6154e-07_r8,4.4425e-07_r8,4.2960e-07_r8,4.2626e-07_r8,4.1715e-07_r8, & + &4.2607e-07_r8,3.6616e-07_r8,2.6366e-07_r8,2.6029e-07_r8/) + forrefo(2,:) = (/ & + &2.6759e-06_r8,2.2237e-06_r8,1.4466e-06_r8,9.3032e-07_r8,6.4927e-07_r8,5.4809e-07_r8, & + &4.9504e-07_r8,4.6305e-07_r8,4.4873e-07_r8,4.2146e-07_r8,4.2176e-07_r8,4.2812e-07_r8, & + &4.0529e-07_r8,4.0969e-07_r8,2.9442e-07_r8,2.6821e-07_r8/) + forrefo(3,:) = (/ & + &2.6608e-06_r8,2.1140e-06_r8,1.4838e-06_r8,9.2083e-07_r8,6.3350e-07_r8,5.7195e-07_r8, & + &6.2253e-07_r8,5.1783e-07_r8,4.4749e-07_r8,4.3261e-07_r8,4.2553e-07_r8,4.2175e-07_r8, & + &4.1085e-07_r8,4.0358e-07_r8,3.5340e-07_r8,2.7191e-07_r8/) + forrefo(4,:) = (/ & + &2.6412e-06_r8,1.9814e-06_r8,1.2672e-06_r8,8.1129e-07_r8,7.1447e-07_r8,7.5026e-07_r8, & + &7.4386e-07_r8,7.2759e-07_r8,7.3583e-07_r8,7.6493e-07_r8,8.8959e-07_r8,7.5534e-07_r8, & + &5.3734e-07_r8,4.5572e-07_r8,4.1676e-07_r8,3.6198e-07_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 4.67262e-03_r8, 3.95211e-03_r8, 3.34270e-03_r8, 2.82726e-03_r8, 2.39130e-03_r8, & + & 2.02256e-03_r8, 1.71069e-03_r8, 1.44690e-03_r8, 1.22379e-03_r8, 1.03508e-03_r8/) + selfrefo(:, 2) = (/ & + & 4.42593e-03_r8, 3.73338e-03_r8, 3.14920e-03_r8, 2.65643e-03_r8, 2.24076e-03_r8, & + & 1.89014e-03_r8, 1.59438e-03_r8, 1.34490e-03_r8, 1.13446e-03_r8, 9.56943e-04_r8/) + selfrefo(:, 3) = (/ & + & 3.96072e-03_r8, 3.33789e-03_r8, 2.81300e-03_r8, 2.37065e-03_r8, 1.99786e-03_r8, & + & 1.68369e-03_r8, 1.41893e-03_r8, 1.19580e-03_r8, 1.00776e-03_r8, 8.49286e-04_r8/) + selfrefo(:, 4) = (/ & + & 3.71833e-03_r8, 3.10030e-03_r8, 2.58500e-03_r8, 2.15535e-03_r8, 1.79711e-03_r8, & + & 1.49841e-03_r8, 1.24936e-03_r8, 1.04170e-03_r8, 8.68558e-04_r8, 7.24195e-04_r8/) + selfrefo(:, 5) = (/ & + & 3.55755e-03_r8, 2.95355e-03_r8, 2.45210e-03_r8, 2.03578e-03_r8, 1.69015e-03_r8, & + & 1.40320e-03_r8, 1.16497e-03_r8, 9.67180e-04_r8, 8.02973e-04_r8, 6.66646e-04_r8/) + selfrefo(:, 6) = (/ & + & 3.47601e-03_r8, 2.88628e-03_r8, 2.39660e-03_r8, 1.99000e-03_r8, 1.65238e-03_r8, & + & 1.37204e-03_r8, 1.13927e-03_r8, 9.45980e-04_r8, 7.85487e-04_r8, 6.52224e-04_r8/) + selfrefo(:, 7) = (/ & + & 3.44479e-03_r8, 2.86224e-03_r8, 2.37820e-03_r8, 1.97602e-03_r8, 1.64185e-03_r8, & + & 1.36420e-03_r8, 1.13350e-03_r8, 9.41810e-04_r8, 7.82539e-04_r8, 6.50204e-04_r8/) + selfrefo(:, 8) = (/ & + & 3.40154e-03_r8, 2.82953e-03_r8, 2.35370e-03_r8, 1.95789e-03_r8, 1.62864e-03_r8, & + & 1.35476e-03_r8, 1.12694e-03_r8, 9.37430e-04_r8, 7.79788e-04_r8, 6.48655e-04_r8/) + selfrefo(:, 9) = (/ & + & 3.39380e-03_r8, 2.82288e-03_r8, 2.34800e-03_r8, 1.95301e-03_r8, 1.62446e-03_r8, & + & 1.35119e-03_r8, 1.12389e-03_r8, 9.34820e-04_r8, 7.77560e-04_r8, 6.46755e-04_r8/) + selfrefo(:,10) = (/ & + & 3.37185e-03_r8, 2.80654e-03_r8, 2.33600e-03_r8, 1.94435e-03_r8, 1.61837e-03_r8, & + & 1.34704e-03_r8, 1.12120e-03_r8, 9.33220e-04_r8, 7.76759e-04_r8, 6.46530e-04_r8/) + selfrefo(:,11) = (/ & + & 3.37924e-03_r8, 2.81172e-03_r8, 2.33950e-03_r8, 1.94659e-03_r8, 1.61967e-03_r8, & + & 1.34765e-03_r8, 1.12132e-03_r8, 9.33000e-04_r8, 7.76306e-04_r8, 6.45930e-04_r8/) + selfrefo(:,12) = (/ & + & 3.39658e-03_r8, 2.82289e-03_r8, 2.34610e-03_r8, 1.94984e-03_r8, 1.62051e-03_r8, & + & 1.34680e-03_r8, 1.11933e-03_r8, 9.30270e-04_r8, 7.73146e-04_r8, 6.42561e-04_r8/) + selfrefo(:,13) = (/ & + & 3.36070e-03_r8, 2.79913e-03_r8, 2.33140e-03_r8, 1.94183e-03_r8, 1.61735e-03_r8, & + & 1.34709e-03_r8, 1.12199e-03_r8, 9.34510e-04_r8, 7.78354e-04_r8, 6.48292e-04_r8/) + selfrefo(:,14) = (/ & + & 3.40428e-03_r8, 2.81994e-03_r8, 2.33590e-03_r8, 1.93495e-03_r8, 1.60282e-03_r8, & + & 1.32770e-03_r8, 1.09980e-03_r8, 9.11020e-04_r8, 7.54645e-04_r8, 6.25111e-04_r8/) + selfrefo(:,15) = (/ & + & 3.27075e-03_r8, 2.70783e-03_r8, 2.24180e-03_r8, 1.85597e-03_r8, 1.53655e-03_r8, & + & 1.27210e-03_r8, 1.05317e-03_r8, 8.71910e-04_r8, 7.21849e-04_r8, 5.97615e-04_r8/) + selfrefo(:,16) = (/ & + & 3.23123e-03_r8, 2.67891e-03_r8, 2.22100e-03_r8, 1.84136e-03_r8, 1.52661e-03_r8, & + & 1.26567e-03_r8, 1.04932e-03_r8, 8.69960e-04_r8, 7.21256e-04_r8, 5.97970e-04_r8/) + + end subroutine lw_kgb14 + +! ************************************************************************** + subroutine lw_kgb15 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg15, only : fracrefao, kao, kao_mn2, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level : P = 1053. mb, T = 294.2 K + fracrefao(:, 1) = (/ & + & 1.0689e-01_r8,1.1563e-01_r8,1.2447e-01_r8,1.2921e-01_r8,1.2840e-01_r8,1.2113e-01_r8, & + & 1.0643e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 2) = (/ & + & 1.0782e-01_r8,1.1637e-01_r8,1.2290e-01_r8,1.2911e-01_r8,1.2841e-01_r8,1.2113e-01_r8, & + & 1.0643e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 3) = (/ & + & 1.0858e-01_r8,1.1860e-01_r8,1.2237e-01_r8,1.2665e-01_r8,1.2841e-01_r8,1.2111e-01_r8, & + & 1.0642e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 4) = (/ & + & 1.1022e-01_r8,1.1965e-01_r8,1.2334e-01_r8,1.2383e-01_r8,1.2761e-01_r8,1.2109e-01_r8, & + & 1.0642e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 5) = (/ & + & 1.1342e-01_r8,1.2069e-01_r8,1.2360e-01_r8,1.2447e-01_r8,1.2340e-01_r8,1.2020e-01_r8, & + & 1.0639e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 6) = (/ & + & 1.1771e-01_r8,1.2280e-01_r8,1.2177e-01_r8,1.2672e-01_r8,1.2398e-01_r8,1.1787e-01_r8, & + & 1.0131e-01_r8,8.4987e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 7) = (/ & + & 1.2320e-01_r8,1.2491e-01_r8,1.2001e-01_r8,1.2936e-01_r8,1.2653e-01_r8,1.1929e-01_r8, & + & 9.8955e-02_r8,7.4887e-02_r8,6.0142e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 8) = (/ & + & 1.3105e-01_r8,1.2563e-01_r8,1.3055e-01_r8,1.2854e-01_r8,1.3402e-01_r8,1.1571e-01_r8, & + & 9.4876e-02_r8,6.0459e-02_r8,5.6457e-02_r8,6.6798e-03_r8,5.5293e-03_r8,4.3700e-03_r8, & + & 3.2061e-03_r8,2.0476e-03_r8,7.7366e-04_r8,1.0897e-04_r8/) + fracrefao(:, 9) = (/ & + & 1.1375e-01_r8,1.2090e-01_r8,1.2348e-01_r8,1.2458e-01_r8,1.2406e-01_r8,1.1921e-01_r8, & + & 1.0802e-01_r8,8.6613e-02_r8,5.8125e-02_r8,6.2984e-03_r8,5.2359e-03_r8,4.0641e-03_r8, & + & 2.9379e-03_r8,1.9001e-03_r8,7.2646e-04_r8,1.0553e-04_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &3.4242e-02_r8,1.7071e-01_r8,2.6138e-01_r8,3.1721e-01_r8,3.2432e-01_r8,2.6831e-01_r8, & + &2.0528e-01_r8,1.1088e-01_r8,5.8968e-01_r8/) + kao(:, 2, 1, 1) = (/ & + &3.3652e-02_r8,1.6779e-01_r8,2.5725e-01_r8,3.0829e-01_r8,3.1520e-01_r8,2.6815e-01_r8, & + &2.0103e-01_r8,1.1213e-01_r8,5.6496e-01_r8/) + kao(:, 3, 1, 1) = (/ & + &3.2936e-02_r8,1.6580e-01_r8,2.5340e-01_r8,3.0468e-01_r8,3.0583e-01_r8,2.6658e-01_r8, & + &1.9781e-01_r8,1.1388e-01_r8,5.5053e-01_r8/) + kao(:, 4, 1, 1) = (/ & + &3.2004e-02_r8,1.6475e-01_r8,2.5029e-01_r8,3.0171e-01_r8,3.0308e-01_r8,2.6842e-01_r8, & + &1.9857e-01_r8,1.1861e-01_r8,5.4961e-01_r8/) + kao(:, 5, 1, 1) = (/ & + &3.0990e-02_r8,1.6410e-01_r8,2.4670e-01_r8,2.9476e-01_r8,3.0044e-01_r8,2.7387e-01_r8, & + &1.9493e-01_r8,1.2451e-01_r8,5.3996e-01_r8/) + kao(:, 1, 2, 1) = (/ & + &3.0564e-02_r8,1.4940e-01_r8,2.2694e-01_r8,2.6721e-01_r8,2.6456e-01_r8,2.1891e-01_r8, & + &1.6459e-01_r8,9.1113e-02_r8,4.6587e-01_r8/) + kao(:, 2, 2, 1) = (/ & + &2.9826e-02_r8,1.4880e-01_r8,2.2345e-01_r8,2.6474e-01_r8,2.5889e-01_r8,2.2136e-01_r8, & + &1.6243e-01_r8,9.1934e-02_r8,4.6056e-01_r8/) + kao(:, 3, 2, 1) = (/ & + &2.9292e-02_r8,1.4800e-01_r8,2.2058e-01_r8,2.6235e-01_r8,2.5684e-01_r8,2.2295e-01_r8, & + &1.6276e-01_r8,9.5842e-02_r8,4.5687e-01_r8/) + kao(:, 4, 2, 1) = (/ & + &2.8631e-02_r8,1.4795e-01_r8,2.1809e-01_r8,2.5690e-01_r8,2.5387e-01_r8,2.2588e-01_r8, & + &1.6201e-01_r8,9.9403e-02_r8,4.5029e-01_r8/) + kao(:, 5, 2, 1) = (/ & + &2.7916e-02_r8,1.4649e-01_r8,2.1539e-01_r8,2.5025e-01_r8,2.5060e-01_r8,2.2852e-01_r8, & + &1.6118e-01_r8,1.0330e-01_r8,4.4510e-01_r8/) + kao(:, 1, 3, 1) = (/ & + &2.7060e-02_r8,1.3249e-01_r8,1.9563e-01_r8,2.2645e-01_r8,2.1616e-01_r8,1.7969e-01_r8, & + &1.3284e-01_r8,7.4965e-02_r8,3.7244e-01_r8/) + kao(:, 2, 3, 1) = (/ & + &2.6723e-02_r8,1.3208e-01_r8,1.9386e-01_r8,2.2490e-01_r8,2.1534e-01_r8,1.8332e-01_r8, & + &1.3372e-01_r8,7.6721e-02_r8,3.7364e-01_r8/) + kao(:, 3, 3, 1) = (/ & + &2.6384e-02_r8,1.3168e-01_r8,1.9203e-01_r8,2.2240e-01_r8,2.1507e-01_r8,1.8752e-01_r8, & + &1.3386e-01_r8,7.9482e-02_r8,3.7891e-01_r8/) + kao(:, 4, 3, 1) = (/ & + &2.5689e-02_r8,1.3020e-01_r8,1.8980e-01_r8,2.1868e-01_r8,2.1152e-01_r8,1.8912e-01_r8, & + &1.3349e-01_r8,8.2411e-02_r8,3.7480e-01_r8/) + kao(:, 5, 3, 1) = (/ & + &2.4939e-02_r8,1.2901e-01_r8,1.8570e-01_r8,2.1295e-01_r8,2.0942e-01_r8,1.8777e-01_r8, & + &1.3349e-01_r8,8.5566e-02_r8,3.6973e-01_r8/) + kao(:, 1, 4, 1) = (/ & + &2.4242e-02_r8,1.1699e-01_r8,1.6835e-01_r8,1.9257e-01_r8,1.7909e-01_r8,1.4906e-01_r8, & + &1.0978e-01_r8,6.3298e-02_r8,3.0317e-01_r8/) + kao(:, 2, 4, 1) = (/ & + &2.3651e-02_r8,1.1679e-01_r8,1.6721e-01_r8,1.9147e-01_r8,1.7987e-01_r8,1.5405e-01_r8, & + &1.1069e-01_r8,6.4435e-02_r8,3.0873e-01_r8/) + kao(:, 3, 4, 1) = (/ & + &2.2665e-02_r8,1.1583e-01_r8,1.6543e-01_r8,1.8831e-01_r8,1.8066e-01_r8,1.5730e-01_r8, & + &1.1107e-01_r8,6.6643e-02_r8,3.1154e-01_r8/) + kao(:, 4, 4, 1) = (/ & + &2.1814e-02_r8,1.1462e-01_r8,1.6249e-01_r8,1.8491e-01_r8,1.7772e-01_r8,1.5750e-01_r8, & + &1.1124e-01_r8,6.9078e-02_r8,3.1214e-01_r8/) + kao(:, 5, 4, 1) = (/ & + &2.1129e-02_r8,1.1306e-01_r8,1.5907e-01_r8,1.7919e-01_r8,1.7465e-01_r8,1.5650e-01_r8, & + &1.1133e-01_r8,7.1551e-02_r8,3.0812e-01_r8/) + kao(:, 1, 5, 1) = (/ & + &2.0560e-02_r8,1.0249e-01_r8,1.4447e-01_r8,1.6390e-01_r8,1.4827e-01_r8,1.2487e-01_r8, & + &9.0642e-02_r8,5.3488e-02_r8,2.4754e-01_r8/) + kao(:, 2, 5, 1) = (/ & + &1.9799e-02_r8,1.0201e-01_r8,1.4357e-01_r8,1.6295e-01_r8,1.5070e-01_r8,1.2910e-01_r8, & + &9.1763e-02_r8,5.4394e-02_r8,2.5641e-01_r8/) + kao(:, 3, 5, 1) = (/ & + &1.9183e-02_r8,1.0090e-01_r8,1.4151e-01_r8,1.5954e-01_r8,1.5069e-01_r8,1.3095e-01_r8, & + &9.2718e-02_r8,5.6321e-02_r8,2.5912e-01_r8/) + kao(:, 4, 5, 1) = (/ & + &1.8512e-02_r8,9.9552e-02_r8,1.3834e-01_r8,1.5497e-01_r8,1.4881e-01_r8,1.3077e-01_r8, & + &9.3091e-02_r8,5.8675e-02_r8,2.5974e-01_r8/) + kao(:, 5, 5, 1) = (/ & + &1.7786e-02_r8,9.7242e-02_r8,1.3532e-01_r8,1.5076e-01_r8,1.4713e-01_r8,1.3062e-01_r8, & + &9.3284e-02_r8,6.0479e-02_r8,2.5760e-01_r8/) + kao(:, 1, 6, 1) = (/ & + &1.7311e-02_r8,8.8922e-02_r8,1.2346e-01_r8,1.3907e-01_r8,1.2282e-01_r8,1.0362e-01_r8, & + &7.4353e-02_r8,4.4575e-02_r8,2.0465e-01_r8/) + kao(:, 2, 6, 1) = (/ & + &1.6759e-02_r8,8.7881e-02_r8,1.2272e-01_r8,1.3747e-01_r8,1.2636e-01_r8,1.0747e-01_r8, & + &7.5966e-02_r8,4.6065e-02_r8,2.1117e-01_r8/) + kao(:, 3, 6, 1) = (/ & + &1.6118e-02_r8,8.6674e-02_r8,1.1960e-01_r8,1.3378e-01_r8,1.2578e-01_r8,1.0890e-01_r8, & + &7.7032e-02_r8,4.7370e-02_r8,2.1535e-01_r8/) + kao(:, 4, 6, 1) = (/ & + &1.5604e-02_r8,8.5004e-02_r8,1.1715e-01_r8,1.3060e-01_r8,1.2464e-01_r8,1.0936e-01_r8, & + &7.8068e-02_r8,4.9979e-02_r8,2.1513e-01_r8/) + kao(:, 5, 6, 1) = (/ & + &1.5010e-02_r8,8.2612e-02_r8,1.1457e-01_r8,1.2694e-01_r8,1.2379e-01_r8,1.0886e-01_r8, & + &7.8577e-02_r8,5.1634e-02_r8,2.1475e-01_r8/) + kao(:, 1, 7, 1) = (/ & + &1.4769e-02_r8,7.6038e-02_r8,1.0565e-01_r8,1.1761e-01_r8,1.0346e-01_r8,8.6214e-02_r8, & + &6.1132e-02_r8,3.6999e-02_r8,1.7055e-01_r8/) + kao(:, 2, 7, 1) = (/ & + &1.4212e-02_r8,7.5191e-02_r8,1.0412e-01_r8,1.1565e-01_r8,1.0591e-01_r8,8.9750e-02_r8, & + &6.2857e-02_r8,3.8703e-02_r8,1.7619e-01_r8/) + kao(:, 3, 7, 1) = (/ & + &1.3756e-02_r8,7.4145e-02_r8,1.0177e-01_r8,1.1260e-01_r8,1.0586e-01_r8,9.1675e-02_r8, & + &6.4846e-02_r8,4.0069e-02_r8,1.8020e-01_r8/) + kao(:, 4, 7, 1) = (/ & + &1.3258e-02_r8,7.2484e-02_r8,9.9439e-02_r8,1.0966e-01_r8,1.0522e-01_r8,9.2290e-02_r8, & + &6.5394e-02_r8,4.2345e-02_r8,1.8038e-01_r8/) + kao(:, 5, 7, 1) = (/ & + &1.2766e-02_r8,7.0689e-02_r8,9.6896e-02_r8,1.0710e-01_r8,1.0411e-01_r8,9.1721e-02_r8, & + &6.6375e-02_r8,4.4166e-02_r8,1.8031e-01_r8/) + kao(:, 1, 8, 1) = (/ & + &1.2774e-02_r8,6.5331e-02_r8,9.0505e-02_r8,1.0027e-01_r8,8.8579e-02_r8,7.2873e-02_r8, & + &5.1439e-02_r8,3.0866e-02_r8,1.4484e-01_r8/) + kao(:, 2, 8, 1) = (/ & + &1.2386e-02_r8,6.4820e-02_r8,8.9216e-02_r8,9.8573e-02_r8,9.0271e-02_r8,7.6134e-02_r8, & + &5.3003e-02_r8,3.2488e-02_r8,1.4948e-01_r8/) + kao(:, 3, 8, 1) = (/ & + &1.1934e-02_r8,6.3787e-02_r8,8.6950e-02_r8,9.5946e-02_r8,9.0138e-02_r8,7.8085e-02_r8, & + &5.5347e-02_r8,3.4134e-02_r8,1.5219e-01_r8/) + kao(:, 4, 8, 1) = (/ & + &1.1544e-02_r8,6.2588e-02_r8,8.5063e-02_r8,9.3318e-02_r8,8.9759e-02_r8,7.8769e-02_r8, & + &5.5958e-02_r8,3.6086e-02_r8,1.5324e-01_r8/) + kao(:, 5, 8, 1) = (/ & + &1.1084e-02_r8,6.0720e-02_r8,8.2631e-02_r8,9.1723e-02_r8,8.9027e-02_r8,7.8819e-02_r8, & + &5.6823e-02_r8,3.7768e-02_r8,1.5367e-01_r8/) + kao(:, 1, 9, 1) = (/ & + &1.1061e-02_r8,5.5946e-02_r8,7.7372e-02_r8,8.4825e-02_r8,7.4671e-02_r8,6.0881e-02_r8, & + &4.3320e-02_r8,2.5693e-02_r8,1.2149e-01_r8/) + kao(:, 2, 9, 1) = (/ & + &1.0663e-02_r8,5.5517e-02_r8,7.6169e-02_r8,8.3555e-02_r8,7.6380e-02_r8,6.3832e-02_r8, & + &4.4653e-02_r8,2.7044e-02_r8,1.2592e-01_r8/) + kao(:, 3, 9, 1) = (/ & + &1.0298e-02_r8,5.4609e-02_r8,7.4061e-02_r8,8.1380e-02_r8,7.6283e-02_r8,6.5805e-02_r8, & + &4.6544e-02_r8,2.8652e-02_r8,1.2784e-01_r8/) + kao(:, 4, 9, 1) = (/ & + &9.9642e-03_r8,5.3590e-02_r8,7.2457e-02_r8,7.9291e-02_r8,7.6297e-02_r8,6.6701e-02_r8, & + &4.7215e-02_r8,3.0429e-02_r8,1.2985e-01_r8/) + kao(:, 5, 9, 1) = (/ & + &9.5838e-03_r8,5.1774e-02_r8,7.0525e-02_r8,7.7952e-02_r8,7.5761e-02_r8,6.7035e-02_r8, & + &4.8099e-02_r8,3.1771e-02_r8,1.2981e-01_r8/) + kao(:, 1,10, 1) = (/ & + &9.5065e-03_r8,4.7743e-02_r8,6.5906e-02_r8,7.1569e-02_r8,6.3088e-02_r8,5.1008e-02_r8, & + &3.6270e-02_r8,2.1647e-02_r8,1.0151e-01_r8/) + kao(:, 2,10, 1) = (/ & + &9.1696e-03_r8,4.7417e-02_r8,6.4599e-02_r8,7.0371e-02_r8,6.4348e-02_r8,5.3431e-02_r8, & + &3.7744e-02_r8,2.2620e-02_r8,1.0603e-01_r8/) + kao(:, 3,10, 1) = (/ & + &8.8668e-03_r8,4.6740e-02_r8,6.2818e-02_r8,6.8749e-02_r8,6.4307e-02_r8,5.5442e-02_r8, & + &3.9323e-02_r8,2.3889e-02_r8,1.0716e-01_r8/) + kao(:, 4,10, 1) = (/ & + &8.5593e-03_r8,4.5273e-02_r8,6.1475e-02_r8,6.7236e-02_r8,6.4539e-02_r8,5.6295e-02_r8, & + &4.0023e-02_r8,2.5561e-02_r8,1.0908e-01_r8/) + kao(:, 5,10, 1) = (/ & + &8.2765e-03_r8,4.3918e-02_r8,5.9902e-02_r8,6.5936e-02_r8,6.4146e-02_r8,5.6753e-02_r8, & + &4.0609e-02_r8,2.6739e-02_r8,1.0938e-01_r8/) + kao(:, 1,11, 1) = (/ & + &8.0135e-03_r8,4.0574e-02_r8,5.5523e-02_r8,5.9842e-02_r8,5.3590e-02_r8,4.3205e-02_r8, & + &3.0578e-02_r8,1.8553e-02_r8,8.6419e-02_r8/) + kao(:, 2,11, 1) = (/ & + &7.7438e-03_r8,4.0051e-02_r8,5.3954e-02_r8,5.8561e-02_r8,5.4366e-02_r8,4.5533e-02_r8, & + &3.1980e-02_r8,1.9368e-02_r8,8.9461e-02_r8/) + kao(:, 3,11, 1) = (/ & + &7.4839e-03_r8,3.9067e-02_r8,5.2580e-02_r8,5.7160e-02_r8,5.4156e-02_r8,4.6927e-02_r8, & + &3.3356e-02_r8,2.0535e-02_r8,9.0297e-02_r8/) + kao(:, 4,11, 1) = (/ & + &7.2468e-03_r8,3.7809e-02_r8,5.1257e-02_r8,5.6080e-02_r8,5.4294e-02_r8,4.7574e-02_r8, & + &3.3980e-02_r8,2.1720e-02_r8,9.1828e-02_r8/) + kao(:, 5,11, 1) = (/ & + &6.9859e-03_r8,3.6737e-02_r8,5.0287e-02_r8,5.5092e-02_r8,5.3946e-02_r8,4.8082e-02_r8, & + &3.4738e-02_r8,2.2682e-02_r8,9.1913e-02_r8/) + kao(:, 1,12, 1) = (/ & + &6.8723e-03_r8,3.4461e-02_r8,4.6618e-02_r8,5.0325e-02_r8,4.5843e-02_r8,3.7154e-02_r8, & + &2.6350e-02_r8,1.5945e-02_r8,7.4796e-02_r8/) + kao(:, 2,12, 1) = (/ & + &6.6342e-03_r8,3.3814e-02_r8,4.5285e-02_r8,4.9258e-02_r8,4.6140e-02_r8,3.8916e-02_r8, & + &2.7614e-02_r8,1.6684e-02_r8,7.6431e-02_r8/) + kao(:, 3,12, 1) = (/ & + &6.4256e-03_r8,3.2718e-02_r8,4.4302e-02_r8,4.8163e-02_r8,4.5963e-02_r8,4.0038e-02_r8, & + &2.8672e-02_r8,1.7798e-02_r8,7.6864e-02_r8/) + kao(:, 4,12, 1) = (/ & + &6.1980e-03_r8,3.1806e-02_r8,4.3232e-02_r8,4.7321e-02_r8,4.6023e-02_r8,4.0771e-02_r8, & + &2.9167e-02_r8,1.8567e-02_r8,7.7874e-02_r8/) + kao(:, 5,12, 1) = (/ & + &5.9663e-03_r8,3.0964e-02_r8,4.2379e-02_r8,4.6375e-02_r8,4.5692e-02_r8,4.1306e-02_r8, & + &2.9920e-02_r8,1.9375e-02_r8,7.7903e-02_r8/) + kao(:, 1,13, 1) = (/ & + &6.1312e-03_r8,2.9682e-02_r8,3.9975e-02_r8,4.3642e-02_r8,4.0252e-02_r8,3.3035e-02_r8, & + &2.3558e-02_r8,1.4050e-02_r8,6.6647e-02_r8/) + kao(:, 2,13, 1) = (/ & + &5.9440e-03_r8,2.8920e-02_r8,3.8788e-02_r8,4.2829e-02_r8,4.0420e-02_r8,3.4105e-02_r8, & + &2.4570e-02_r8,1.4699e-02_r8,6.7206e-02_r8/) + kao(:, 3,13, 1) = (/ & + &5.7437e-03_r8,2.7994e-02_r8,3.7951e-02_r8,4.1862e-02_r8,4.0303e-02_r8,3.5364e-02_r8, & + &2.5449e-02_r8,1.5507e-02_r8,6.7644e-02_r8/) + kao(:, 4,13, 1) = (/ & + &5.5406e-03_r8,2.7263e-02_r8,3.7056e-02_r8,4.0900e-02_r8,3.9818e-02_r8,3.6193e-02_r8, & + &2.6077e-02_r8,1.6255e-02_r8,6.7402e-02_r8/) + kao(:, 5,13, 1) = (/ & + &5.3457e-03_r8,2.6652e-02_r8,3.6336e-02_r8,3.9995e-02_r8,3.9467e-02_r8,3.6352e-02_r8, & + &2.6575e-02_r8,1.6998e-02_r8,6.7304e-02_r8/) + kao(:, 1, 1, 2) = (/ & + &4.1184e-02_r8,2.7179e-01_r8,3.3427e-01_r8,3.7214e-01_r8,4.0092e-01_r8,3.9640e-01_r8, & + &3.3752e-01_r8,3.1662e-01_r8,7.0395e-01_r8/) + kao(:, 2, 1, 2) = (/ & + &3.9613e-02_r8,2.5448e-01_r8,3.1529e-01_r8,3.6420e-01_r8,3.9285e-01_r8,3.8292e-01_r8, & + &3.4622e-01_r8,3.3570e-01_r8,7.0351e-01_r8/) + kao(:, 3, 1, 2) = (/ & + &3.8482e-02_r8,2.4018e-01_r8,3.0435e-01_r8,3.6080e-01_r8,3.8815e-01_r8,3.7286e-01_r8, & + &3.5535e-01_r8,3.5400e-01_r8,6.9477e-01_r8/) + kao(:, 4, 1, 2) = (/ & + &3.7848e-02_r8,2.2963e-01_r8,2.9537e-01_r8,3.6193e-01_r8,3.8220e-01_r8,3.7308e-01_r8, & + &3.6939e-01_r8,3.6570e-01_r8,6.8368e-01_r8/) + kao(:, 5, 1, 2) = (/ & + &3.7774e-02_r8,2.2394e-01_r8,2.9359e-01_r8,3.5744e-01_r8,3.7874e-01_r8,3.6962e-01_r8, & + &3.8607e-01_r8,3.7579e-01_r8,6.9280e-01_r8/) + kao(:, 1, 2, 2) = (/ & + &3.5631e-02_r8,2.2069e-01_r8,2.7258e-01_r8,3.1550e-01_r8,3.3342e-01_r8,3.2657e-01_r8, & + &2.8024e-01_r8,2.7588e-01_r8,5.9197e-01_r8/) + kao(:, 2, 2, 2) = (/ & + &3.4562e-02_r8,2.0891e-01_r8,2.6384e-01_r8,3.1412e-01_r8,3.2954e-01_r8,3.2211e-01_r8, & + &2.9490e-01_r8,2.9533e-01_r8,5.8323e-01_r8/) + kao(:, 3, 2, 2) = (/ & + &3.3571e-02_r8,1.9802e-01_r8,2.5784e-01_r8,3.1122e-01_r8,3.2677e-01_r8,3.1912e-01_r8, & + &3.0590e-01_r8,3.0715e-01_r8,5.7853e-01_r8/) + kao(:, 4, 2, 2) = (/ & + &3.2736e-02_r8,1.9123e-01_r8,2.5333e-01_r8,3.0890e-01_r8,3.2624e-01_r8,3.1676e-01_r8, & + &3.1863e-01_r8,3.1850e-01_r8,5.8754e-01_r8/) + kao(:, 5, 2, 2) = (/ & + &3.2264e-02_r8,1.8835e-01_r8,2.5452e-01_r8,3.0891e-01_r8,3.2749e-01_r8,3.1271e-01_r8, & + &3.2651e-01_r8,3.2839e-01_r8,5.9068e-01_r8/) + kao(:, 1, 3, 2) = (/ & + &3.1584e-02_r8,1.8152e-01_r8,2.2653e-01_r8,2.6984e-01_r8,2.8266e-01_r8,2.7419e-01_r8, & + &2.3718e-01_r8,2.3355e-01_r8,4.9551e-01_r8/) + kao(:, 2, 3, 2) = (/ & + &3.0265e-02_r8,1.7457e-01_r8,2.2109e-01_r8,2.6703e-01_r8,2.7958e-01_r8,2.7087e-01_r8, & + &2.4754e-01_r8,2.5014e-01_r8,4.9470e-01_r8/) + kao(:, 3, 3, 2) = (/ & + &2.9150e-02_r8,1.6735e-01_r8,2.1902e-01_r8,2.6391e-01_r8,2.7849e-01_r8,2.6534e-01_r8, & + &2.5781e-01_r8,2.6293e-01_r8,4.9430e-01_r8/) + kao(:, 4, 3, 2) = (/ & + &2.8592e-02_r8,1.6364e-01_r8,2.1995e-01_r8,2.6189e-01_r8,2.7866e-01_r8,2.6352e-01_r8, & + &2.7044e-01_r8,2.7363e-01_r8,4.9527e-01_r8/) + kao(:, 5, 3, 2) = (/ & + &2.8231e-02_r8,1.6046e-01_r8,2.1887e-01_r8,2.6443e-01_r8,2.7635e-01_r8,2.6884e-01_r8, & + &2.7778e-01_r8,2.8066e-01_r8,4.9153e-01_r8/) + kao(:, 1, 4, 2) = (/ & + &2.7586e-02_r8,1.5275e-01_r8,1.9293e-01_r8,2.2899e-01_r8,2.4107e-01_r8,2.3244e-01_r8, & + &2.0047e-01_r8,1.9534e-01_r8,4.2244e-01_r8/) + kao(:, 2, 4, 2) = (/ & + &2.6887e-02_r8,1.4829e-01_r8,1.9195e-01_r8,2.2560e-01_r8,2.3907e-01_r8,2.2550e-01_r8, & + &2.1032e-01_r8,2.1041e-01_r8,4.2198e-01_r8/) + kao(:, 3, 4, 2) = (/ & + &2.6805e-02_r8,1.4416e-01_r8,1.9016e-01_r8,2.2531e-01_r8,2.3789e-01_r8,2.2485e-01_r8, & + &2.1879e-01_r8,2.2259e-01_r8,4.1901e-01_r8/) + kao(:, 4, 4, 2) = (/ & + &2.6734e-02_r8,1.4087e-01_r8,1.9109e-01_r8,2.2675e-01_r8,2.3622e-01_r8,2.2628e-01_r8, & + &2.2901e-01_r8,2.3158e-01_r8,4.1030e-01_r8/) + kao(:, 5, 4, 2) = (/ & + &2.6617e-02_r8,1.3796e-01_r8,1.9377e-01_r8,2.2557e-01_r8,2.3342e-01_r8,2.2649e-01_r8, & + &2.3523e-01_r8,2.3617e-01_r8,4.1160e-01_r8/) + kao(:, 1, 5, 2) = (/ & + &2.5332e-02_r8,1.2963e-01_r8,1.6655e-01_r8,1.9042e-01_r8,2.0895e-01_r8,1.9510e-01_r8, & + &1.6916e-01_r8,1.6222e-01_r8,3.6316e-01_r8/) + kao(:, 2, 5, 2) = (/ & + &2.5181e-02_r8,1.2537e-01_r8,1.6592e-01_r8,1.8998e-01_r8,2.0621e-01_r8,1.9136e-01_r8, & + &1.7764e-01_r8,1.7625e-01_r8,3.5695e-01_r8/) + kao(:, 3, 5, 2) = (/ & + &2.4972e-02_r8,1.2219e-01_r8,1.6618e-01_r8,1.9129e-01_r8,2.0217e-01_r8,1.9130e-01_r8, & + &1.8535e-01_r8,1.8719e-01_r8,3.4788e-01_r8/) + kao(:, 4, 5, 2) = (/ & + &2.4749e-02_r8,1.2096e-01_r8,1.6848e-01_r8,1.9087e-01_r8,1.9911e-01_r8,1.9130e-01_r8, & + &1.9341e-01_r8,1.9372e-01_r8,3.4412e-01_r8/) + kao(:, 5, 5, 2) = (/ & + &2.4660e-02_r8,1.2126e-01_r8,1.7164e-01_r8,1.8946e-01_r8,1.9462e-01_r8,1.9216e-01_r8, & + &1.9926e-01_r8,1.9935e-01_r8,3.3902e-01_r8/) + kao(:, 1, 6, 2) = (/ & + &2.3422e-02_r8,1.0907e-01_r8,1.4314e-01_r8,1.6055e-01_r8,1.7919e-01_r8,1.6497e-01_r8, & + &1.4423e-01_r8,1.3518e-01_r8,3.0537e-01_r8/) + kao(:, 2, 6, 2) = (/ & + &2.3193e-02_r8,1.0714e-01_r8,1.4280e-01_r8,1.6151e-01_r8,1.7408e-01_r8,1.6236e-01_r8, & + &1.4991e-01_r8,1.4676e-01_r8,2.9795e-01_r8/) + kao(:, 3, 6, 2) = (/ & + &2.2992e-02_r8,1.0582e-01_r8,1.4541e-01_r8,1.6228e-01_r8,1.7059e-01_r8,1.6204e-01_r8, & + &1.5617e-01_r8,1.5704e-01_r8,2.9013e-01_r8/) + kao(:, 4, 6, 2) = (/ & + &2.2904e-02_r8,1.0595e-01_r8,1.4661e-01_r8,1.6015e-01_r8,1.6718e-01_r8,1.6268e-01_r8, & + &1.6254e-01_r8,1.6133e-01_r8,2.8558e-01_r8/) + kao(:, 5, 6, 2) = (/ & + &2.3037e-02_r8,1.0659e-01_r8,1.4720e-01_r8,1.5884e-01_r8,1.6394e-01_r8,1.6537e-01_r8, & + &1.6790e-01_r8,1.6640e-01_r8,2.8291e-01_r8/) + kao(:, 1, 7, 2) = (/ & + &2.1778e-02_r8,9.4871e-02_r8,1.2415e-01_r8,1.3737e-01_r8,1.5258e-01_r8,1.4160e-01_r8, & + &1.2347e-01_r8,1.1302e-01_r8,2.5408e-01_r8/) + kao(:, 2, 7, 2) = (/ & + &2.1522e-02_r8,9.3423e-02_r8,1.2417e-01_r8,1.3839e-01_r8,1.4741e-01_r8,1.4006e-01_r8, & + &1.2799e-01_r8,1.2268e-01_r8,2.4943e-01_r8/) + kao(:, 3, 7, 2) = (/ & + &2.1257e-02_r8,9.3282e-02_r8,1.2533e-01_r8,1.3843e-01_r8,1.4474e-01_r8,1.3911e-01_r8, & + &1.3239e-01_r8,1.3095e-01_r8,2.4208e-01_r8/) + kao(:, 4, 7, 2) = (/ & + &2.0841e-02_r8,9.3161e-02_r8,1.2672e-01_r8,1.3698e-01_r8,1.4106e-01_r8,1.4019e-01_r8, & + &1.3855e-01_r8,1.3550e-01_r8,2.3874e-01_r8/) + kao(:, 5, 7, 2) = (/ & + &2.0486e-02_r8,9.4079e-02_r8,1.2713e-01_r8,1.3508e-01_r8,1.3852e-01_r8,1.4171e-01_r8, & + &1.4291e-01_r8,1.3980e-01_r8,2.3641e-01_r8/) + kao(:, 1, 8, 2) = (/ & + &2.0219e-02_r8,8.3245e-02_r8,1.0821e-01_r8,1.1854e-01_r8,1.3123e-01_r8,1.2323e-01_r8, & + &1.0617e-01_r8,9.4794e-02_r8,2.1425e-01_r8/) + kao(:, 2, 8, 2) = (/ & + &1.9540e-02_r8,8.2217e-02_r8,1.0811e-01_r8,1.1985e-01_r8,1.2621e-01_r8,1.2208e-01_r8, & + &1.0997e-01_r8,1.0316e-01_r8,2.0956e-01_r8/) + kao(:, 3, 8, 2) = (/ & + &1.9115e-02_r8,8.1811e-02_r8,1.0961e-01_r8,1.1959e-01_r8,1.2388e-01_r8,1.2129e-01_r8, & + &1.1337e-01_r8,1.1053e-01_r8,2.0624e-01_r8/) + kao(:, 4, 8, 2) = (/ & + &1.8733e-02_r8,8.1851e-02_r8,1.1044e-01_r8,1.1828e-01_r8,1.2090e-01_r8,1.2160e-01_r8, & + &1.1850e-01_r8,1.1463e-01_r8,2.0160e-01_r8/) + kao(:, 5, 8, 2) = (/ & + &1.8489e-02_r8,8.3310e-02_r8,1.0940e-01_r8,1.1607e-01_r8,1.1923e-01_r8,1.2205e-01_r8, & + &1.2223e-01_r8,1.1845e-01_r8,2.0014e-01_r8/) + kao(:, 1, 9, 2) = (/ & + &1.7934e-02_r8,7.2499e-02_r8,9.3347e-02_r8,1.0259e-01_r8,1.1263e-01_r8,1.0693e-01_r8, & + &9.0284e-02_r8,7.9546e-02_r8,1.8180e-01_r8/) + kao(:, 2, 9, 2) = (/ & + &1.7445e-02_r8,7.1879e-02_r8,9.3312e-02_r8,1.0334e-01_r8,1.0867e-01_r8,1.0654e-01_r8, & + &9.3871e-02_r8,8.7011e-02_r8,1.7650e-01_r8/) + kao(:, 3, 9, 2) = (/ & + &1.7054e-02_r8,7.1164e-02_r8,9.4558e-02_r8,1.0223e-01_r8,1.0632e-01_r8,1.0559e-01_r8, & + &9.7124e-02_r8,9.3354e-02_r8,1.7444e-01_r8/) + kao(:, 4, 9, 2) = (/ & + &1.6642e-02_r8,7.2006e-02_r8,9.4764e-02_r8,1.0087e-01_r8,1.0340e-01_r8,1.0507e-01_r8, & + &1.0155e-01_r8,9.7191e-02_r8,1.7012e-01_r8/) + kao(:, 5, 9, 2) = (/ & + &1.6243e-02_r8,7.2866e-02_r8,9.2285e-02_r8,9.9097e-02_r8,1.0185e-01_r8,1.0516e-01_r8, & + &1.0490e-01_r8,1.0097e-01_r8,1.7041e-01_r8/) + kao(:, 1,10, 2) = (/ & + &1.5979e-02_r8,6.3035e-02_r8,8.0318e-02_r8,8.8320e-02_r8,9.6214e-02_r8,9.2269e-02_r8, & + &7.7109e-02_r8,6.7263e-02_r8,1.5451e-01_r8/) + kao(:, 2,10, 2) = (/ & + &1.5470e-02_r8,6.2313e-02_r8,8.0559e-02_r8,8.8699e-02_r8,9.3120e-02_r8,9.2382e-02_r8, & + &7.9788e-02_r8,7.3810e-02_r8,1.5001e-01_r8/) + kao(:, 3,10, 2) = (/ & + &1.4968e-02_r8,6.2321e-02_r8,8.1515e-02_r8,8.7265e-02_r8,9.0898e-02_r8,9.1273e-02_r8, & + &8.3098e-02_r8,7.9462e-02_r8,1.4837e-01_r8/) + kao(:, 4,10, 2) = (/ & + &1.4648e-02_r8,6.3201e-02_r8,8.0459e-02_r8,8.6353e-02_r8,8.8769e-02_r8,9.0582e-02_r8, & + &8.6861e-02_r8,8.2886e-02_r8,1.4494e-01_r8/) + kao(:, 5,10, 2) = (/ & + &1.4327e-02_r8,6.4058e-02_r8,7.8092e-02_r8,8.4556e-02_r8,8.7537e-02_r8,9.0662e-02_r8, & + &8.9892e-02_r8,8.5887e-02_r8,1.4505e-01_r8/) + kao(:, 1,11, 2) = (/ & + &1.3861e-02_r8,5.4196e-02_r8,6.8747e-02_r8,7.5984e-02_r8,8.0767e-02_r8,7.9801e-02_r8, & + &6.6830e-02_r8,5.9302e-02_r8,1.2963e-01_r8/) + kao(:, 2,11, 2) = (/ & + &1.3347e-02_r8,5.4113e-02_r8,6.9722e-02_r8,7.5263e-02_r8,7.8466e-02_r8,7.8575e-02_r8, & + &6.9140e-02_r8,6.4556e-02_r8,1.2675e-01_r8/) + kao(:, 3,11, 2) = (/ & + &1.3016e-02_r8,5.4555e-02_r8,6.9179e-02_r8,7.4613e-02_r8,7.7291e-02_r8,7.7531e-02_r8, & + &7.2200e-02_r8,6.9022e-02_r8,1.2482e-01_r8/) + kao(:, 4,11, 2) = (/ & + &1.2671e-02_r8,5.5408e-02_r8,6.7230e-02_r8,7.3198e-02_r8,7.5526e-02_r8,7.7122e-02_r8, & + &7.5177e-02_r8,7.1296e-02_r8,1.2336e-01_r8/) + kao(:, 5,11, 2) = (/ & + &1.2351e-02_r8,5.6031e-02_r8,6.5093e-02_r8,7.1581e-02_r8,7.4883e-02_r8,7.6822e-02_r8, & + &7.7284e-02_r8,7.3771e-02_r8,1.2246e-01_r8/) + kao(:, 1,12, 2) = (/ & + &1.2126e-02_r8,4.7285e-02_r8,5.9933e-02_r8,6.5129e-02_r8,6.8290e-02_r8,6.7884e-02_r8, & + &5.7878e-02_r8,5.1782e-02_r8,1.0839e-01_r8/) + kao(:, 2,12, 2) = (/ & + &1.1745e-02_r8,4.7398e-02_r8,5.9988e-02_r8,6.4477e-02_r8,6.6821e-02_r8,6.6892e-02_r8, & + &6.0270e-02_r8,5.6137e-02_r8,1.0621e-01_r8/) + kao(:, 3,12, 2) = (/ & + &1.1385e-02_r8,4.8238e-02_r8,5.8218e-02_r8,6.3614e-02_r8,6.5819e-02_r8,6.5904e-02_r8, & + &6.2567e-02_r8,5.9036e-02_r8,1.0557e-01_r8/) + kao(:, 4,12, 2) = (/ & + &1.1087e-02_r8,4.8582e-02_r8,5.6782e-02_r8,6.2244e-02_r8,6.4582e-02_r8,6.5133e-02_r8, & + &6.4669e-02_r8,6.1446e-02_r8,1.0435e-01_r8/) + kao(:, 5,12, 2) = (/ & + &1.0909e-02_r8,4.7898e-02_r8,5.5031e-02_r8,6.0882e-02_r8,6.4057e-02_r8,6.5202e-02_r8, & + &6.6350e-02_r8,6.3114e-02_r8,1.0415e-01_r8/) + kao(:, 1,13, 2) = (/ & + &1.1050e-02_r8,4.2216e-02_r8,5.3216e-02_r8,5.6607e-02_r8,5.8614e-02_r8,5.8762e-02_r8, & + &5.1111e-02_r8,4.5278e-02_r8,9.1112e-02_r8/) + kao(:, 2,13, 2) = (/ & + &1.0650e-02_r8,4.2640e-02_r8,5.2374e-02_r8,5.5676e-02_r8,5.7428e-02_r8,5.7903e-02_r8, & + &5.3022e-02_r8,4.8756e-02_r8,9.0299e-02_r8/) + kao(:, 3,13, 2) = (/ & + &1.0375e-02_r8,4.2997e-02_r8,5.0849e-02_r8,5.4963e-02_r8,5.6516e-02_r8,5.6613e-02_r8, & + &5.4398e-02_r8,5.1351e-02_r8,8.9757e-02_r8/) + kao(:, 4,13, 2) = (/ & + &1.0186e-02_r8,4.2550e-02_r8,4.9650e-02_r8,5.4126e-02_r8,5.6087e-02_r8,5.6100e-02_r8, & + &5.5740e-02_r8,5.3111e-02_r8,8.9898e-02_r8/) + kao(:, 5,13, 2) = (/ & + &9.9803e-03_r8,4.1596e-02_r8,4.8435e-02_r8,5.3214e-02_r8,5.5733e-02_r8,5.6166e-02_r8, & + &5.6820e-02_r8,5.4773e-02_r8,8.9718e-02_r8/) + kao(:, 1, 1, 3) = (/ & + &1.0349e-01_r8,2.2333e-01_r8,4.3448e-01_r8,4.7188e-01_r8,4.9049e-01_r8,5.6379e-01_r8, & + &6.8188e-01_r8,5.5213e-01_r8,8.7331e-01_r8/) + kao(:, 2, 1, 3) = (/ & + &9.8776e-02_r8,2.3587e-01_r8,4.2090e-01_r8,4.7099e-01_r8,4.8532e-01_r8,5.6756e-01_r8, & + &6.8304e-01_r8,5.3972e-01_r8,8.6585e-01_r8/) + kao(:, 3, 1, 3) = (/ & + &9.4379e-02_r8,2.4459e-01_r8,4.0703e-01_r8,4.4771e-01_r8,4.8054e-01_r8,5.8051e-01_r8, & + &6.8126e-01_r8,5.2715e-01_r8,8.6189e-01_r8/) + kao(:, 4, 1, 3) = (/ & + &8.9966e-02_r8,2.4911e-01_r8,4.0891e-01_r8,4.3132e-01_r8,4.8073e-01_r8,5.8214e-01_r8, & + &6.7058e-01_r8,5.2176e-01_r8,8.6463e-01_r8/) + kao(:, 5, 1, 3) = (/ & + &8.6080e-02_r8,2.4561e-01_r8,4.0823e-01_r8,4.3495e-01_r8,4.8341e-01_r8,5.8583e-01_r8, & + &6.6494e-01_r8,5.1295e-01_r8,8.6781e-01_r8/) + kao(:, 1, 2, 3) = (/ & + &9.1121e-02_r8,2.7597e-01_r8,3.6090e-01_r8,3.8864e-01_r8,4.2468e-01_r8,5.0778e-01_r8, & + &6.0614e-01_r8,4.7263e-01_r8,7.5147e-01_r8/) + kao(:, 2, 2, 3) = (/ & + &8.6968e-02_r8,2.8112e-01_r8,3.5384e-01_r8,3.7604e-01_r8,4.2522e-01_r8,5.1397e-01_r8, & + &5.9893e-01_r8,4.6387e-01_r8,7.5402e-01_r8/) + kao(:, 3, 2, 3) = (/ & + &8.3177e-02_r8,2.8458e-01_r8,3.4657e-01_r8,3.6832e-01_r8,4.2349e-01_r8,5.1886e-01_r8, & + &5.9537e-01_r8,4.5576e-01_r8,7.6481e-01_r8/) + kao(:, 4, 2, 3) = (/ & + &7.9593e-02_r8,2.8362e-01_r8,3.4405e-01_r8,3.6602e-01_r8,4.2737e-01_r8,5.2263e-01_r8, & + &5.9169e-01_r8,4.4715e-01_r8,7.7154e-01_r8/) + kao(:, 5, 2, 3) = (/ & + &7.6305e-02_r8,2.7901e-01_r8,3.3923e-01_r8,3.6563e-01_r8,4.2905e-01_r8,5.2631e-01_r8, & + &5.9188e-01_r8,4.4184e-01_r8,7.8075e-01_r8/) + kao(:, 1, 3, 3) = (/ & + &8.1532e-02_r8,2.6557e-01_r8,3.0691e-01_r8,3.2639e-01_r8,3.6998e-01_r8,4.4624e-01_r8, & + &5.2995e-01_r8,4.1015e-01_r8,6.5448e-01_r8/) + kao(:, 2, 3, 3) = (/ & + &7.8061e-02_r8,2.5705e-01_r8,3.0144e-01_r8,3.1922e-01_r8,3.7157e-01_r8,4.5007e-01_r8, & + &5.2671e-01_r8,4.0238e-01_r8,6.6049e-01_r8/) + kao(:, 3, 3, 3) = (/ & + &7.4871e-02_r8,2.4964e-01_r8,2.9703e-01_r8,3.1658e-01_r8,3.7272e-01_r8,4.5628e-01_r8, & + &5.2424e-01_r8,3.9540e-01_r8,6.6589e-01_r8/) + kao(:, 4, 3, 3) = (/ & + &7.1934e-02_r8,2.4252e-01_r8,2.8855e-01_r8,3.1667e-01_r8,3.7723e-01_r8,4.6275e-01_r8, & + &5.1485e-01_r8,3.8931e-01_r8,6.7492e-01_r8/) + kao(:, 5, 3, 3) = (/ & + &6.9067e-02_r8,2.3451e-01_r8,2.8461e-01_r8,3.1625e-01_r8,3.8425e-01_r8,4.6414e-01_r8, & + &5.0872e-01_r8,3.8671e-01_r8,6.9966e-01_r8/) + kao(:, 1, 4, 3) = (/ & + &7.4166e-02_r8,2.1898e-01_r8,2.6310e-01_r8,2.7673e-01_r8,3.2117e-01_r8,3.8906e-01_r8, & + &4.5677e-01_r8,3.5535e-01_r8,5.6605e-01_r8/) + kao(:, 2, 4, 3) = (/ & + &7.1027e-02_r8,2.1158e-01_r8,2.5634e-01_r8,2.7577e-01_r8,3.2463e-01_r8,3.9708e-01_r8, & + &4.5460e-01_r8,3.5060e-01_r8,5.7431e-01_r8/) + kao(:, 3, 4, 3) = (/ & + &6.8100e-02_r8,2.0832e-01_r8,2.5127e-01_r8,2.7640e-01_r8,3.2722e-01_r8,4.0091e-01_r8, & + &4.5112e-01_r8,3.4506e-01_r8,5.8564e-01_r8/) + kao(:, 4, 4, 3) = (/ & + &6.5366e-02_r8,2.0407e-01_r8,2.4599e-01_r8,2.7530e-01_r8,3.3554e-01_r8,4.0555e-01_r8, & + &4.3614e-01_r8,3.4106e-01_r8,6.0722e-01_r8/) + kao(:, 5, 4, 3) = (/ & + &6.2828e-02_r8,2.0183e-01_r8,2.4016e-01_r8,2.8032e-01_r8,3.4415e-01_r8,4.1256e-01_r8, & + &4.2811e-01_r8,3.3888e-01_r8,6.2274e-01_r8/) + kao(:, 1, 5, 3) = (/ & + &6.8085e-02_r8,1.8443e-01_r8,2.2193e-01_r8,2.4125e-01_r8,2.7858e-01_r8,3.3878e-01_r8, & + &3.9224e-01_r8,3.0775e-01_r8,4.8825e-01_r8/) + kao(:, 2, 5, 3) = (/ & + &6.5024e-02_r8,1.8062e-01_r8,2.1594e-01_r8,2.3959e-01_r8,2.8255e-01_r8,3.4709e-01_r8, & + &3.8693e-01_r8,3.0387e-01_r8,4.9773e-01_r8/) + kao(:, 3, 5, 3) = (/ & + &6.2309e-02_r8,1.7709e-01_r8,2.1233e-01_r8,2.4099e-01_r8,2.9052e-01_r8,3.5084e-01_r8, & + &3.7550e-01_r8,2.9937e-01_r8,5.1983e-01_r8/) + kao(:, 4, 5, 3) = (/ & + &6.0049e-02_r8,1.7340e-01_r8,2.0891e-01_r8,2.4567e-01_r8,2.9963e-01_r8,3.5573e-01_r8, & + &3.6423e-01_r8,2.9642e-01_r8,5.3792e-01_r8/) + kao(:, 5, 5, 3) = (/ & + &5.7860e-02_r8,1.7101e-01_r8,2.0517e-01_r8,2.5155e-01_r8,3.0986e-01_r8,3.5542e-01_r8, & + &3.5482e-01_r8,2.9214e-01_r8,5.5424e-01_r8/) + kao(:, 1, 6, 3) = (/ & + &6.1553e-02_r8,1.6486e-01_r8,1.8851e-01_r8,2.1013e-01_r8,2.4069e-01_r8,2.9423e-01_r8, & + &3.2998e-01_r8,2.6499e-01_r8,4.1520e-01_r8/) + kao(:, 2, 6, 3) = (/ & + &5.8962e-02_r8,1.6161e-01_r8,1.8469e-01_r8,2.1043e-01_r8,2.4572e-01_r8,3.0023e-01_r8, & + &3.2384e-01_r8,2.6279e-01_r8,4.2954e-01_r8/) + kao(:, 3, 6, 3) = (/ & + &5.6865e-02_r8,1.5845e-01_r8,1.8137e-01_r8,2.1320e-01_r8,2.5567e-01_r8,3.0422e-01_r8, & + &3.1399e-01_r8,2.5823e-01_r8,4.4811e-01_r8/) + kao(:, 4, 6, 3) = (/ & + &5.4727e-02_r8,1.5470e-01_r8,1.8033e-01_r8,2.2018e-01_r8,2.6466e-01_r8,3.0350e-01_r8, & + &3.0450e-01_r8,2.5479e-01_r8,4.6359e-01_r8/) + kao(:, 5, 6, 3) = (/ & + &5.2654e-02_r8,1.5114e-01_r8,1.8009e-01_r8,2.2727e-01_r8,2.7074e-01_r8,3.0288e-01_r8, & + &2.9697e-01_r8,2.5146e-01_r8,4.7630e-01_r8/) + kao(:, 1, 7, 3) = (/ & + &5.4386e-02_r8,1.4374e-01_r8,1.6223e-01_r8,1.8219e-01_r8,2.0984e-01_r8,2.5288e-01_r8, & + &2.7777e-01_r8,2.2929e-01_r8,3.5662e-01_r8/) + kao(:, 2, 7, 3) = (/ & + &5.2357e-02_r8,1.4042e-01_r8,1.5995e-01_r8,1.8335e-01_r8,2.1810e-01_r8,2.5710e-01_r8, & + &2.7180e-01_r8,2.2723e-01_r8,3.7033e-01_r8/) + kao(:, 3, 7, 3) = (/ & + &5.0433e-02_r8,1.3664e-01_r8,1.5916e-01_r8,1.8872e-01_r8,2.2495e-01_r8,2.5913e-01_r8, & + &2.6518e-01_r8,2.2296e-01_r8,3.8796e-01_r8/) + kao(:, 4, 7, 3) = (/ & + &4.8970e-02_r8,1.3435e-01_r8,1.5882e-01_r8,1.9514e-01_r8,2.3146e-01_r8,2.5861e-01_r8, & + &2.5643e-01_r8,2.1963e-01_r8,4.0045e-01_r8/) + kao(:, 5, 7, 3) = (/ & + &4.7677e-02_r8,1.3141e-01_r8,1.5996e-01_r8,2.0198e-01_r8,2.3377e-01_r8,2.5698e-01_r8, & + &2.5063e-01_r8,2.1548e-01_r8,4.0471e-01_r8/) + kao(:, 1, 8, 3) = (/ & + &4.9561e-02_r8,1.2585e-01_r8,1.4205e-01_r8,1.6041e-01_r8,1.8455e-01_r8,2.1813e-01_r8, & + &2.3719e-01_r8,1.9955e-01_r8,3.0456e-01_r8/) + kao(:, 2, 8, 3) = (/ & + &4.7879e-02_r8,1.2232e-01_r8,1.4089e-01_r8,1.6222e-01_r8,1.9194e-01_r8,2.2092e-01_r8, & + &2.3163e-01_r8,1.9730e-01_r8,3.1885e-01_r8/) + kao(:, 3, 8, 3) = (/ & + &4.6426e-02_r8,1.1957e-01_r8,1.4043e-01_r8,1.6717e-01_r8,1.9752e-01_r8,2.2121e-01_r8, & + &2.2638e-01_r8,1.9261e-01_r8,3.3187e-01_r8/) + kao(:, 4, 8, 3) = (/ & + &4.5268e-02_r8,1.1738e-01_r8,1.4149e-01_r8,1.7294e-01_r8,2.0208e-01_r8,2.2061e-01_r8, & + &2.1864e-01_r8,1.8926e-01_r8,3.4074e-01_r8/) + kao(:, 5, 8, 3) = (/ & + &4.3956e-02_r8,1.1566e-01_r8,1.4446e-01_r8,1.7951e-01_r8,2.0361e-01_r8,2.1938e-01_r8, & + &2.1462e-01_r8,1.8542e-01_r8,3.4583e-01_r8/) + kao(:, 1, 9, 3) = (/ & + &4.5250e-02_r8,1.0911e-01_r8,1.2308e-01_r8,1.4028e-01_r8,1.6172e-01_r8,1.8816e-01_r8, & + &2.0368e-01_r8,1.7299e-01_r8,2.5859e-01_r8/) + kao(:, 2, 9, 3) = (/ & + &4.3924e-02_r8,1.0618e-01_r8,1.2262e-01_r8,1.4258e-01_r8,1.6714e-01_r8,1.8918e-01_r8, & + &1.9807e-01_r8,1.7073e-01_r8,2.7235e-01_r8/) + kao(:, 3, 9, 3) = (/ & + &4.2608e-02_r8,1.0467e-01_r8,1.2300e-01_r8,1.4745e-01_r8,1.7253e-01_r8,1.8886e-01_r8, & + &1.9316e-01_r8,1.6589e-01_r8,2.8262e-01_r8/) + kao(:, 4, 9, 3) = (/ & + &4.1423e-02_r8,1.0229e-01_r8,1.2419e-01_r8,1.5295e-01_r8,1.7546e-01_r8,1.8853e-01_r8, & + &1.8673e-01_r8,1.6267e-01_r8,2.8816e-01_r8/) + kao(:, 5, 9, 3) = (/ & + &4.0021e-02_r8,1.0144e-01_r8,1.2853e-01_r8,1.5736e-01_r8,1.7632e-01_r8,1.8748e-01_r8, & + &1.8330e-01_r8,1.5887e-01_r8,2.9011e-01_r8/) + kao(:, 1,10, 3) = (/ & + &4.1171e-02_r8,9.3658e-02_r8,1.0622e-01_r8,1.2188e-01_r8,1.4076e-01_r8,1.6261e-01_r8, & + &1.7423e-01_r8,1.4922e-01_r8,2.1862e-01_r8/) + kao(:, 2,10, 3) = (/ & + &3.9662e-02_r8,9.1742e-02_r8,1.0641e-01_r8,1.2434e-01_r8,1.4583e-01_r8,1.6228e-01_r8, & + &1.6976e-01_r8,1.4678e-01_r8,2.3073e-01_r8/) + kao(:, 3,10, 3) = (/ & + &3.8151e-02_r8,8.9581e-02_r8,1.0765e-01_r8,1.2937e-01_r8,1.4971e-01_r8,1.6177e-01_r8, & + &1.6479e-01_r8,1.4256e-01_r8,2.3771e-01_r8/) + kao(:, 4,10, 3) = (/ & + &3.6829e-02_r8,8.8190e-02_r8,1.0980e-01_r8,1.3385e-01_r8,1.5088e-01_r8,1.6121e-01_r8, & + &1.5970e-01_r8,1.3919e-01_r8,2.4389e-01_r8/) + kao(:, 5,10, 3) = (/ & + &3.5799e-02_r8,8.7081e-02_r8,1.1397e-01_r8,1.3613e-01_r8,1.5068e-01_r8,1.6032e-01_r8, & + &1.5668e-01_r8,1.3612e-01_r8,2.4347e-01_r8/) + kao(:, 1,11, 3) = (/ & + &3.5950e-02_r8,7.9375e-02_r8,9.2025e-02_r8,1.0686e-01_r8,1.2416e-01_r8,1.3928e-01_r8, & + &1.4761e-01_r8,1.2730e-01_r8,1.9139e-01_r8/) + kao(:, 2,11, 3) = (/ & + &3.4807e-02_r8,7.7447e-02_r8,9.2655e-02_r8,1.1006e-01_r8,1.2736e-01_r8,1.3892e-01_r8, & + &1.4381e-01_r8,1.2426e-01_r8,1.9723e-01_r8/) + kao(:, 3,11, 3) = (/ & + &3.3668e-02_r8,7.6215e-02_r8,9.4748e-02_r8,1.1430e-01_r8,1.2842e-01_r8,1.3852e-01_r8, & + &1.3892e-01_r8,1.2007e-01_r8,2.0316e-01_r8/) + kao(:, 4,11, 3) = (/ & + &3.2675e-02_r8,7.5405e-02_r8,9.7335e-02_r8,1.1502e-01_r8,1.2820e-01_r8,1.3796e-01_r8, & + &1.3569e-01_r8,1.1793e-01_r8,2.0391e-01_r8/) + kao(:, 5,11, 3) = (/ & + &3.1803e-02_r8,7.5385e-02_r8,1.0078e-01_r8,1.1505e-01_r8,1.2792e-01_r8,1.3782e-01_r8, & + &1.3291e-01_r8,1.1573e-01_r8,2.0592e-01_r8/) + kao(:, 1,12, 3) = (/ & + &3.2107e-02_r8,6.7817e-02_r8,8.0190e-02_r8,9.4418e-02_r8,1.0883e-01_r8,1.2016e-01_r8, & + &1.2478e-01_r8,1.0916e-01_r8,1.6437e-01_r8/) + kao(:, 2,12, 3) = (/ & + &3.0865e-02_r8,6.6495e-02_r8,8.1339e-02_r8,9.7570e-02_r8,1.0958e-01_r8,1.1971e-01_r8, & + &1.2159e-01_r8,1.0575e-01_r8,1.6979e-01_r8/) + kao(:, 3,12, 3) = (/ & + &2.9814e-02_r8,6.5982e-02_r8,8.4322e-02_r8,9.8160e-02_r8,1.0983e-01_r8,1.1899e-01_r8, & + &1.1775e-01_r8,1.0260e-01_r8,1.7251e-01_r8/) + kao(:, 4,12, 3) = (/ & + &2.8719e-02_r8,6.6210e-02_r8,8.5962e-02_r8,9.8372e-02_r8,1.0963e-01_r8,1.1883e-01_r8, & + &1.1590e-01_r8,1.0037e-01_r8,1.7377e-01_r8/) + kao(:, 5,12, 3) = (/ & + &2.7641e-02_r8,6.7001e-02_r8,8.6676e-02_r8,9.9268e-02_r8,1.1059e-01_r8,1.1880e-01_r8, & + &1.1301e-01_r8,9.8900e-02_r8,1.7602e-01_r8/) + kao(:, 1,13, 3) = (/ & + &2.9283e-02_r8,6.0178e-02_r8,7.1238e-02_r8,8.4877e-02_r8,9.5368e-02_r8,1.0416e-01_r8, & + &1.0619e-01_r8,9.4038e-02_r8,1.4273e-01_r8/) + kao(:, 2,13, 3) = (/ & + &2.8137e-02_r8,5.9367e-02_r8,7.3469e-02_r8,8.5617e-02_r8,9.5728e-02_r8,1.0364e-01_r8, & + &1.0343e-01_r8,9.0972e-02_r8,1.4741e-01_r8/) + kao(:, 3,13, 3) = (/ & + &2.7056e-02_r8,5.9346e-02_r8,7.4992e-02_r8,8.5630e-02_r8,9.5820e-02_r8,1.0325e-01_r8, & + &1.0105e-01_r8,8.7823e-02_r8,1.4877e-01_r8/) + kao(:, 4,13, 3) = (/ & + &2.6017e-02_r8,6.0117e-02_r8,7.5313e-02_r8,8.5867e-02_r8,9.6184e-02_r8,1.0321e-01_r8, & + &9.9567e-02_r8,8.6122e-02_r8,1.5028e-01_r8/) + kao(:, 5,13, 3) = (/ & + &2.5188e-02_r8,6.1586e-02_r8,7.5405e-02_r8,8.7449e-02_r8,9.7275e-02_r8,1.0347e-01_r8, & + &9.7619e-02_r8,8.4749e-02_r8,1.5271e-01_r8/) + kao(:, 1, 1, 4) = (/ & + &2.0140e-01_r8,2.2296e-01_r8,3.8441e-01_r8,7.9237e-01_r8,8.6626e-01_r8,8.2263e-01_r8, & + &7.4305e-01_r8,7.5768e-01_r8,1.5145e+00_r8/) + kao(:, 2, 1, 4) = (/ & + &1.9181e-01_r8,2.1723e-01_r8,4.1174e-01_r8,7.7988e-01_r8,8.4188e-01_r8,7.8979e-01_r8, & + &7.0362e-01_r8,7.1757e-01_r8,1.4753e+00_r8/) + kao(:, 3, 1, 4) = (/ & + &1.8358e-01_r8,2.1296e-01_r8,4.3167e-01_r8,7.6375e-01_r8,8.2127e-01_r8,7.5942e-01_r8, & + &6.7535e-01_r8,6.8460e-01_r8,1.4372e+00_r8/) + kao(:, 4, 1, 4) = (/ & + &1.7731e-01_r8,2.0956e-01_r8,4.3260e-01_r8,7.5378e-01_r8,8.0524e-01_r8,7.2961e-01_r8, & + &6.5477e-01_r8,6.4648e-01_r8,1.3999e+00_r8/) + kao(:, 5, 1, 4) = (/ & + &1.7164e-01_r8,2.1055e-01_r8,4.2755e-01_r8,7.3334e-01_r8,7.8436e-01_r8,7.1000e-01_r8, & + &6.4297e-01_r8,6.0884e-01_r8,1.3521e+00_r8/) + kao(:, 1, 2, 4) = (/ & + &1.7302e-01_r8,2.0244e-01_r8,5.3076e-01_r8,6.9942e-01_r8,7.3274e-01_r8,6.9098e-01_r8, & + &6.5285e-01_r8,6.3638e-01_r8,1.2559e+00_r8/) + kao(:, 2, 2, 4) = (/ & + &1.6489e-01_r8,1.9797e-01_r8,5.4053e-01_r8,6.8204e-01_r8,7.0789e-01_r8,6.6109e-01_r8, & + &6.3152e-01_r8,6.0382e-01_r8,1.2010e+00_r8/) + kao(:, 3, 2, 4) = (/ & + &1.5760e-01_r8,1.9570e-01_r8,5.4478e-01_r8,6.6415e-01_r8,6.8272e-01_r8,6.3617e-01_r8, & + &6.0950e-01_r8,5.7193e-01_r8,1.1640e+00_r8/) + kao(:, 4, 2, 4) = (/ & + &1.5184e-01_r8,1.9435e-01_r8,5.4381e-01_r8,6.4780e-01_r8,6.6147e-01_r8,6.1692e-01_r8, & + &5.8732e-01_r8,5.4197e-01_r8,1.1223e+00_r8/) + kao(:, 5, 2, 4) = (/ & + &1.4698e-01_r8,1.9520e-01_r8,5.4107e-01_r8,6.3896e-01_r8,6.4395e-01_r8,6.0782e-01_r8, & + &5.7401e-01_r8,5.1623e-01_r8,1.0839e+00_r8/) + kao(:, 1, 3, 4) = (/ & + &1.5095e-01_r8,2.3961e-01_r8,5.3891e-01_r8,5.9274e-01_r8,6.0360e-01_r8,5.9975e-01_r8, & + &5.7583e-01_r8,5.3639e-01_r8,1.0254e+00_r8/) + kao(:, 2, 3, 4) = (/ & + &1.4378e-01_r8,2.4579e-01_r8,5.2840e-01_r8,5.8072e-01_r8,5.8574e-01_r8,5.7325e-01_r8, & + &5.5457e-01_r8,5.1150e-01_r8,9.9368e-01_r8/) + kao(:, 3, 3, 4) = (/ & + &1.3744e-01_r8,2.5218e-01_r8,5.1071e-01_r8,5.6679e-01_r8,5.6782e-01_r8,5.5647e-01_r8, & + &5.3781e-01_r8,4.7984e-01_r8,9.5622e-01_r8/) + kao(:, 4, 3, 4) = (/ & + &1.3182e-01_r8,2.5642e-01_r8,4.9891e-01_r8,5.5373e-01_r8,5.5212e-01_r8,5.4201e-01_r8, & + &5.2720e-01_r8,4.5497e-01_r8,9.3692e-01_r8/) + kao(:, 5, 3, 4) = (/ & + &1.2736e-01_r8,2.6156e-01_r8,4.9042e-01_r8,5.4609e-01_r8,5.4094e-01_r8,5.2788e-01_r8, & + &5.2063e-01_r8,4.2896e-01_r8,9.1393e-01_r8/) + kao(:, 1, 4, 4) = (/ & + &1.3296e-01_r8,3.0808e-01_r8,4.5560e-01_r8,5.0161e-01_r8,5.1973e-01_r8,5.1660e-01_r8, & + &5.1162e-01_r8,4.5889e-01_r8,8.7778e-01_r8/) + kao(:, 2, 4, 4) = (/ & + &1.2659e-01_r8,3.1156e-01_r8,4.4164e-01_r8,4.8779e-01_r8,5.0041e-01_r8,4.9812e-01_r8, & + &4.9015e-01_r8,4.3243e-01_r8,8.4542e-01_r8/) + kao(:, 3, 4, 4) = (/ & + &1.2094e-01_r8,3.1188e-01_r8,4.3105e-01_r8,4.7578e-01_r8,4.8617e-01_r8,4.8333e-01_r8, & + &4.7842e-01_r8,4.0299e-01_r8,8.1678e-01_r8/) + kao(:, 4, 4, 4) = (/ & + &1.1593e-01_r8,3.1351e-01_r8,4.2237e-01_r8,4.6451e-01_r8,4.7350e-01_r8,4.7079e-01_r8, & + &4.7610e-01_r8,3.7858e-01_r8,7.9667e-01_r8/) + kao(:, 5, 4, 4) = (/ & + &1.1150e-01_r8,3.1306e-01_r8,4.1390e-01_r8,4.5362e-01_r8,4.6429e-01_r8,4.6167e-01_r8, & + &4.7081e-01_r8,3.5772e-01_r8,7.7552e-01_r8/) + kao(:, 1, 5, 4) = (/ & + &1.1755e-01_r8,3.2807e-01_r8,3.8548e-01_r8,4.2521e-01_r8,4.4554e-01_r8,4.5203e-01_r8, & + &4.4500e-01_r8,3.9225e-01_r8,7.4478e-01_r8/) + kao(:, 2, 5, 4) = (/ & + &1.1209e-01_r8,3.1909e-01_r8,3.7705e-01_r8,4.1235e-01_r8,4.2996e-01_r8,4.3302e-01_r8, & + &4.3279e-01_r8,3.6494e-01_r8,7.1780e-01_r8/) + kao(:, 3, 5, 4) = (/ & + &1.0716e-01_r8,3.1181e-01_r8,3.6570e-01_r8,3.9834e-01_r8,4.1575e-01_r8,4.2162e-01_r8, & + &4.2981e-01_r8,3.4051e-01_r8,6.9974e-01_r8/) + kao(:, 4, 5, 4) = (/ & + &1.0275e-01_r8,3.0301e-01_r8,3.5750e-01_r8,3.8990e-01_r8,4.0553e-01_r8,4.1539e-01_r8, & + &4.2536e-01_r8,3.1843e-01_r8,6.8036e-01_r8/) + kao(:, 5, 5, 4) = (/ & + &9.8998e-02_r8,2.9446e-01_r8,3.5111e-01_r8,3.8417e-01_r8,3.9923e-01_r8,4.1474e-01_r8, & + &4.2083e-01_r8,3.0243e-01_r8,6.6644e-01_r8/) + kao(:, 1, 6, 4) = (/ & + &1.0705e-01_r8,2.7318e-01_r8,3.3208e-01_r8,3.6143e-01_r8,3.8591e-01_r8,3.9313e-01_r8, & + &3.9284e-01_r8,3.3741e-01_r8,6.4786e-01_r8/) + kao(:, 2, 6, 4) = (/ & + &1.0199e-01_r8,2.6545e-01_r8,3.2251e-01_r8,3.5040e-01_r8,3.7450e-01_r8,3.7890e-01_r8, & + &3.8585e-01_r8,3.0993e-01_r8,6.2347e-01_r8/) + kao(:, 3, 6, 4) = (/ & + &9.7437e-02_r8,2.5576e-01_r8,3.1499e-01_r8,3.4107e-01_r8,3.6300e-01_r8,3.7247e-01_r8, & + &3.8009e-01_r8,2.8815e-01_r8,6.0580e-01_r8/) + kao(:, 4, 6, 4) = (/ & + &9.3482e-02_r8,2.4922e-01_r8,3.0800e-01_r8,3.3313e-01_r8,3.5414e-01_r8,3.7096e-01_r8, & + &3.7706e-01_r8,2.7157e-01_r8,5.9892e-01_r8/) + kao(:, 5, 6, 4) = (/ & + &9.0031e-02_r8,2.4481e-01_r8,3.0199e-01_r8,3.2745e-01_r8,3.5204e-01_r8,3.7018e-01_r8, & + &3.6552e-01_r8,2.5507e-01_r8,5.9364e-01_r8/) + kao(:, 1, 7, 4) = (/ & + &1.0201e-01_r8,2.3487e-01_r8,2.8528e-01_r8,3.1378e-01_r8,3.3635e-01_r8,3.4598e-01_r8, & + &3.4770e-01_r8,2.9069e-01_r8,5.6026e-01_r8/) + kao(:, 2, 7, 4) = (/ & + &9.7333e-02_r8,2.2730e-01_r8,2.7830e-01_r8,3.0507e-01_r8,3.2187e-01_r8,3.3481e-01_r8, & + &3.4172e-01_r8,2.6797e-01_r8,5.4227e-01_r8/) + kao(:, 3, 7, 4) = (/ & + &9.3243e-02_r8,2.2136e-01_r8,2.6944e-01_r8,2.9618e-01_r8,3.1454e-01_r8,3.2973e-01_r8, & + &3.3451e-01_r8,2.4821e-01_r8,5.2884e-01_r8/) + kao(:, 4, 7, 4) = (/ & + &8.9660e-02_r8,2.1638e-01_r8,2.6334e-01_r8,2.9056e-01_r8,3.1245e-01_r8,3.2791e-01_r8, & + &3.2519e-01_r8,2.3192e-01_r8,5.2407e-01_r8/) + kao(:, 5, 7, 4) = (/ & + &8.6492e-02_r8,2.1156e-01_r8,2.5984e-01_r8,2.8528e-01_r8,3.1573e-01_r8,3.2789e-01_r8, & + &3.1681e-01_r8,2.1806e-01_r8,5.2688e-01_r8/) + kao(:, 1, 8, 4) = (/ & + &1.0039e-01_r8,2.1049e-01_r8,2.5117e-01_r8,2.7733e-01_r8,2.9294e-01_r8,3.0451e-01_r8, & + &3.0671e-01_r8,2.5418e-01_r8,4.9108e-01_r8/) + kao(:, 2, 8, 4) = (/ & + &9.6148e-02_r8,2.0539e-01_r8,2.4350e-01_r8,2.6931e-01_r8,2.8451e-01_r8,2.9582e-01_r8, & + &3.0170e-01_r8,2.3605e-01_r8,4.7511e-01_r8/) + kao(:, 3, 8, 4) = (/ & + &9.2145e-02_r8,2.0009e-01_r8,2.3646e-01_r8,2.6177e-01_r8,2.7896e-01_r8,2.9276e-01_r8, & + &2.9264e-01_r8,2.1892e-01_r8,4.6537e-01_r8/) + kao(:, 4, 8, 4) = (/ & + &8.8569e-02_r8,1.9568e-01_r8,2.3097e-01_r8,2.5688e-01_r8,2.7814e-01_r8,2.9214e-01_r8, & + &2.8481e-01_r8,2.0263e-01_r8,4.6603e-01_r8/) + kao(:, 5, 8, 4) = (/ & + &8.5629e-02_r8,1.9094e-01_r8,2.2714e-01_r8,2.5259e-01_r8,2.7953e-01_r8,2.8904e-01_r8, & + &2.7433e-01_r8,1.9066e-01_r8,4.6777e-01_r8/) + kao(:, 1, 9, 4) = (/ & + &9.8021e-02_r8,1.9151e-01_r8,2.2309e-01_r8,2.4564e-01_r8,2.5865e-01_r8,2.6783e-01_r8, & + &2.6894e-01_r8,2.2292e-01_r8,4.2854e-01_r8/) + kao(:, 2, 9, 4) = (/ & + &9.3022e-02_r8,1.8527e-01_r8,2.1592e-01_r8,2.3651e-01_r8,2.5064e-01_r8,2.6055e-01_r8, & + &2.6499e-01_r8,2.0617e-01_r8,4.1580e-01_r8/) + kao(:, 3, 9, 4) = (/ & + &8.8595e-02_r8,1.8097e-01_r8,2.1073e-01_r8,2.3156e-01_r8,2.4703e-01_r8,2.5851e-01_r8, & + &2.5441e-01_r8,1.9146e-01_r8,4.1005e-01_r8/) + kao(:, 4, 9, 4) = (/ & + &8.4486e-02_r8,1.7670e-01_r8,2.0686e-01_r8,2.2734e-01_r8,2.4622e-01_r8,2.5730e-01_r8, & + &2.4711e-01_r8,1.7700e-01_r8,4.1054e-01_r8/) + kao(:, 5, 9, 4) = (/ & + &8.1546e-02_r8,1.7284e-01_r8,2.0523e-01_r8,2.2674e-01_r8,2.4921e-01_r8,2.5266e-01_r8, & + &2.3614e-01_r8,1.6619e-01_r8,4.1551e-01_r8/) + kao(:, 1,10, 4) = (/ & + &9.1049e-02_r8,1.7362e-01_r8,1.9833e-01_r8,2.1764e-01_r8,2.2798e-01_r8,2.3471e-01_r8, & + &2.3646e-01_r8,1.9422e-01_r8,3.7343e-01_r8/) + kao(:, 2,10, 4) = (/ & + &8.6996e-02_r8,1.6791e-01_r8,1.9240e-01_r8,2.1075e-01_r8,2.2237e-01_r8,2.2936e-01_r8, & + &2.3178e-01_r8,1.7985e-01_r8,3.6356e-01_r8/) + kao(:, 3,10, 4) = (/ & + &8.2800e-02_r8,1.6395e-01_r8,1.8777e-01_r8,2.0552e-01_r8,2.1940e-01_r8,2.2862e-01_r8, & + &2.2169e-01_r8,1.6614e-01_r8,3.6046e-01_r8/) + kao(:, 4,10, 4) = (/ & + &7.8811e-02_r8,1.5975e-01_r8,1.8561e-01_r8,2.0375e-01_r8,2.1988e-01_r8,2.2450e-01_r8, & + &2.1345e-01_r8,1.5492e-01_r8,3.6096e-01_r8/) + kao(:, 5,10, 4) = (/ & + &7.5529e-02_r8,1.5650e-01_r8,1.8353e-01_r8,2.0505e-01_r8,2.1950e-01_r8,2.1739e-01_r8, & + &2.0454e-01_r8,1.4507e-01_r8,3.6055e-01_r8/) + kao(:, 1,11, 4) = (/ & + &7.7672e-02_r8,1.5145e-01_r8,1.7382e-01_r8,1.8990e-01_r8,1.9990e-01_r8,2.0432e-01_r8, & + &2.0547e-01_r8,1.6386e-01_r8,3.1843e-01_r8/) + kao(:, 2,11, 4) = (/ & + &7.3723e-02_r8,1.4611e-01_r8,1.6807e-01_r8,1.8489e-01_r8,1.9610e-01_r8,2.0254e-01_r8, & + &1.9720e-01_r8,1.5217e-01_r8,3.1488e-01_r8/) + kao(:, 3,11, 4) = (/ & + &7.0457e-02_r8,1.4249e-01_r8,1.6412e-01_r8,1.8266e-01_r8,1.9585e-01_r8,1.9778e-01_r8, & + &1.8906e-01_r8,1.4085e-01_r8,3.1421e-01_r8/) + kao(:, 4,11, 4) = (/ & + &6.7094e-02_r8,1.3863e-01_r8,1.6386e-01_r8,1.8321e-01_r8,1.9415e-01_r8,1.9186e-01_r8, & + &1.8023e-01_r8,1.3105e-01_r8,3.1088e-01_r8/) + kao(:, 5,11, 4) = (/ & + &6.4100e-02_r8,1.3524e-01_r8,1.6357e-01_r8,1.8497e-01_r8,1.9137e-01_r8,1.8498e-01_r8, & + &1.7319e-01_r8,1.2321e-01_r8,3.0324e-01_r8/) + kao(:, 1,12, 4) = (/ & + &6.6765e-02_r8,1.2994e-01_r8,1.4944e-01_r8,1.6445e-01_r8,1.7587e-01_r8,1.8101e-01_r8, & + &1.7769e-01_r8,1.3984e-01_r8,2.7673e-01_r8/) + kao(:, 2,12, 4) = (/ & + &6.3023e-02_r8,1.2593e-01_r8,1.4588e-01_r8,1.6162e-01_r8,1.7387e-01_r8,1.7653e-01_r8, & + &1.6990e-01_r8,1.2980e-01_r8,2.7397e-01_r8/) + kao(:, 3,12, 4) = (/ & + &6.0078e-02_r8,1.2173e-01_r8,1.4433e-01_r8,1.6136e-01_r8,1.7141e-01_r8,1.7100e-01_r8, & + &1.6190e-01_r8,1.2017e-01_r8,2.6912e-01_r8/) + kao(:, 4,12, 4) = (/ & + &5.7591e-02_r8,1.1797e-01_r8,1.4432e-01_r8,1.6200e-01_r8,1.6903e-01_r8,1.6549e-01_r8, & + &1.5510e-01_r8,1.1177e-01_r8,2.6329e-01_r8/) + kao(:, 5,12, 4) = (/ & + &5.5506e-02_r8,1.1583e-01_r8,1.4556e-01_r8,1.5779e-01_r8,1.6302e-01_r8,1.5857e-01_r8, & + &1.4926e-01_r8,1.0509e-01_r8,2.5258e-01_r8/) + kao(:, 1,13, 4) = (/ & + &5.9522e-02_r8,1.1440e-01_r8,1.3268e-01_r8,1.4518e-01_r8,1.5668e-01_r8,1.6016e-01_r8, & + &1.5672e-01_r8,1.2200e-01_r8,2.4269e-01_r8/) + kao(:, 2,13, 4) = (/ & + &5.6603e-02_r8,1.1049e-01_r8,1.3023e-01_r8,1.4451e-01_r8,1.5437e-01_r8,1.5452e-01_r8, & + &1.4924e-01_r8,1.1346e-01_r8,2.3750e-01_r8/) + kao(:, 3,13, 4) = (/ & + &5.4101e-02_r8,1.0639e-01_r8,1.2967e-01_r8,1.4482e-01_r8,1.5052e-01_r8,1.4869e-01_r8, & + &1.4191e-01_r8,1.0569e-01_r8,2.3366e-01_r8/) + kao(:, 4,13, 4) = (/ & + &5.1959e-02_r8,1.0421e-01_r8,1.3053e-01_r8,1.4062e-01_r8,1.4577e-01_r8,1.4358e-01_r8, & + &1.3605e-01_r8,9.8273e-02_r8,2.2442e-01_r8/) + kao(:, 5,13, 4) = (/ & + &4.9821e-02_r8,1.0307e-01_r8,1.3162e-01_r8,1.3605e-01_r8,1.4048e-01_r8,1.3772e-01_r8, & + &1.3142e-01_r8,9.2354e-02_r8,2.1552e-01_r8/) + kao(:, 1, 1, 5) = (/ & + &4.4662e-01_r8,4.5491e-01_r8,4.6518e-01_r8,4.8073e-01_r8,9.6301e-01_r8,1.0662e+00_r8, & + &9.6837e-01_r8,6.1516e-01_r8,1.5492e+00_r8/) + kao(:, 2, 1, 5) = (/ & + &4.3070e-01_r8,4.3901e-01_r8,4.4894e-01_r8,4.8843e-01_r8,9.7366e-01_r8,1.0185e+00_r8, & + &9.1919e-01_r8,5.9289e-01_r8,1.4372e+00_r8/) + kao(:, 3, 1, 5) = (/ & + &4.1920e-01_r8,4.2623e-01_r8,4.3584e-01_r8,5.1853e-01_r8,9.4077e-01_r8,9.6967e-01_r8, & + &8.7962e-01_r8,5.7716e-01_r8,1.3511e+00_r8/) + kao(:, 4, 1, 5) = (/ & + &4.1320e-01_r8,4.1951e-01_r8,4.2768e-01_r8,5.3113e-01_r8,8.9548e-01_r8,9.3086e-01_r8, & + &8.2656e-01_r8,5.7871e-01_r8,1.2540e+00_r8/) + kao(:, 5, 1, 5) = (/ & + &4.1049e-01_r8,4.1583e-01_r8,4.2551e-01_r8,5.4820e-01_r8,8.6249e-01_r8,8.9543e-01_r8, & + &7.7827e-01_r8,5.9312e-01_r8,1.1774e+00_r8/) + kao(:, 1, 2, 5) = (/ & + &3.7419e-01_r8,3.9315e-01_r8,4.1387e-01_r8,7.3684e-01_r8,9.3729e-01_r8,9.5798e-01_r8, & + &8.1977e-01_r8,5.4534e-01_r8,1.3830e+00_r8/) + kao(:, 2, 2, 5) = (/ & + &3.6046e-01_r8,3.7870e-01_r8,3.9949e-01_r8,7.5022e-01_r8,8.9119e-01_r8,9.0575e-01_r8, & + &7.6682e-01_r8,5.2408e-01_r8,1.3014e+00_r8/) + kao(:, 3, 2, 5) = (/ & + &3.5058e-01_r8,3.6732e-01_r8,3.9129e-01_r8,7.6077e-01_r8,8.5537e-01_r8,8.6853e-01_r8, & + &7.2131e-01_r8,5.2368e-01_r8,1.1992e+00_r8/) + kao(:, 4, 2, 5) = (/ & + &3.4363e-01_r8,3.5974e-01_r8,3.8593e-01_r8,7.6592e-01_r8,8.1963e-01_r8,8.3241e-01_r8, & + &6.8939e-01_r8,5.2630e-01_r8,1.1280e+00_r8/) + kao(:, 5, 2, 5) = (/ & + &3.4117e-01_r8,3.5633e-01_r8,3.8040e-01_r8,7.4257e-01_r8,7.9365e-01_r8,7.8846e-01_r8, & + &6.5921e-01_r8,5.2675e-01_r8,1.0716e+00_r8/) + kao(:, 1, 3, 5) = (/ & + &3.1617e-01_r8,3.4533e-01_r8,4.9004e-01_r8,8.0662e-01_r8,8.6490e-01_r8,8.2831e-01_r8, & + &6.9369e-01_r8,4.9053e-01_r8,1.2685e+00_r8/) + kao(:, 2, 3, 5) = (/ & + &3.0386e-01_r8,3.3185e-01_r8,4.9271e-01_r8,7.6499e-01_r8,8.1967e-01_r8,7.8960e-01_r8, & + &6.4565e-01_r8,4.7244e-01_r8,1.1699e+00_r8/) + kao(:, 3, 3, 5) = (/ & + &2.9464e-01_r8,3.2055e-01_r8,5.0043e-01_r8,7.2785e-01_r8,7.8235e-01_r8,7.5123e-01_r8, & + &6.1372e-01_r8,4.7097e-01_r8,1.0909e+00_r8/) + kao(:, 4, 3, 5) = (/ & + &2.8765e-01_r8,3.1339e-01_r8,5.0754e-01_r8,6.9697e-01_r8,7.5208e-01_r8,7.1843e-01_r8, & + &5.8571e-01_r8,4.6400e-01_r8,1.0036e+00_r8/) + kao(:, 5, 3, 5) = (/ & + &2.8344e-01_r8,3.0751e-01_r8,5.1242e-01_r8,6.6855e-01_r8,7.1995e-01_r8,6.9218e-01_r8, & + &5.7184e-01_r8,4.7451e-01_r8,9.2127e-01_r8/) + kao(:, 1, 4, 5) = (/ & + &2.6775e-01_r8,3.0604e-01_r8,6.4660e-01_r8,7.3076e-01_r8,7.6521e-01_r8,7.2923e-01_r8, & + &5.8618e-01_r8,4.3353e-01_r8,1.1015e+00_r8/) + kao(:, 2, 4, 5) = (/ & + &2.5632e-01_r8,2.9306e-01_r8,6.2522e-01_r8,6.9215e-01_r8,7.2674e-01_r8,6.8433e-01_r8, & + &5.5230e-01_r8,4.1918e-01_r8,1.0081e+00_r8/) + kao(:, 3, 4, 5) = (/ & + &2.4780e-01_r8,2.8292e-01_r8,5.9390e-01_r8,6.5413e-01_r8,6.8773e-01_r8,6.5028e-01_r8, & + &5.2160e-01_r8,4.1724e-01_r8,9.3062e-01_r8/) + kao(:, 4, 4, 5) = (/ & + &2.4100e-01_r8,2.7551e-01_r8,5.7041e-01_r8,6.2793e-01_r8,6.5534e-01_r8,6.2452e-01_r8, & + &5.0866e-01_r8,4.1719e-01_r8,8.4917e-01_r8/) + kao(:, 5, 4, 5) = (/ & + &2.3658e-01_r8,2.6967e-01_r8,5.4813e-01_r8,6.0747e-01_r8,6.2636e-01_r8,5.9897e-01_r8, & + &4.9899e-01_r8,4.2737e-01_r8,7.8635e-01_r8/) + kao(:, 1, 5, 5) = (/ & + &2.2714e-01_r8,3.0892e-01_r8,5.8868e-01_r8,6.5760e-01_r8,6.7083e-01_r8,6.2555e-01_r8, & + &5.1259e-01_r8,3.8131e-01_r8,9.5049e-01_r8/) + kao(:, 2, 5, 5) = (/ & + &2.1666e-01_r8,3.0798e-01_r8,5.5062e-01_r8,6.2165e-01_r8,6.2939e-01_r8,5.9031e-01_r8, & + &4.8040e-01_r8,3.7074e-01_r8,8.6898e-01_r8/) + kao(:, 3, 5, 5) = (/ & + &2.0871e-01_r8,3.0702e-01_r8,5.2691e-01_r8,5.8794e-01_r8,5.9599e-01_r8,5.6236e-01_r8, & + &4.6150e-01_r8,3.6395e-01_r8,7.8288e-01_r8/) + kao(:, 4, 5, 5) = (/ & + &2.0276e-01_r8,3.0943e-01_r8,5.0433e-01_r8,5.5988e-01_r8,5.6518e-01_r8,5.3494e-01_r8, & + &4.4833e-01_r8,3.6773e-01_r8,7.2419e-01_r8/) + kao(:, 5, 5, 5) = (/ & + &1.9892e-01_r8,3.1215e-01_r8,4.8278e-01_r8,5.3676e-01_r8,5.4170e-01_r8,5.0924e-01_r8, & + &4.4109e-01_r8,3.7855e-01_r8,6.8358e-01_r8/) + kao(:, 1, 6, 5) = (/ & + &1.9298e-01_r8,3.8310e-01_r8,5.2601e-01_r8,5.8117e-01_r8,5.8505e-01_r8,5.4459e-01_r8, & + &4.4513e-01_r8,3.3639e-01_r8,8.1804e-01_r8/) + kao(:, 2, 6, 5) = (/ & + &1.8380e-01_r8,3.7978e-01_r8,4.9784e-01_r8,5.4325e-01_r8,5.4503e-01_r8,5.1006e-01_r8, & + &4.1750e-01_r8,3.2606e-01_r8,7.4136e-01_r8/) + kao(:, 3, 6, 5) = (/ & + &1.7694e-01_r8,3.8180e-01_r8,4.7027e-01_r8,5.1699e-01_r8,5.1079e-01_r8,4.8235e-01_r8, & + &4.0208e-01_r8,3.2052e-01_r8,6.7777e-01_r8/) + kao(:, 4, 6, 5) = (/ & + &1.7133e-01_r8,3.7179e-01_r8,4.4558e-01_r8,4.8630e-01_r8,4.9002e-01_r8,4.5737e-01_r8, & + &3.9155e-01_r8,3.2262e-01_r8,6.2593e-01_r8/) + kao(:, 5, 6, 5) = (/ & + &1.6754e-01_r8,3.5443e-01_r8,4.2444e-01_r8,4.6383e-01_r8,4.6954e-01_r8,4.4064e-01_r8, & + &3.8904e-01_r8,3.3286e-01_r8,5.7664e-01_r8/) + kao(:, 1, 7, 5) = (/ & + &1.6680e-01_r8,3.8673e-01_r8,4.6977e-01_r8,5.0982e-01_r8,5.0645e-01_r8,4.7419e-01_r8, & + &3.9067e-01_r8,2.9795e-01_r8,7.1500e-01_r8/) + kao(:, 2, 7, 5) = (/ & + &1.5848e-01_r8,3.6483e-01_r8,4.3657e-01_r8,4.7719e-01_r8,4.7339e-01_r8,4.4276e-01_r8, & + &3.6591e-01_r8,2.8456e-01_r8,6.4266e-01_r8/) + kao(:, 3, 7, 5) = (/ & + &1.5206e-01_r8,3.4607e-01_r8,4.1294e-01_r8,4.4755e-01_r8,4.4747e-01_r8,4.1880e-01_r8, & + &3.5274e-01_r8,2.8027e-01_r8,5.8922e-01_r8/) + kao(:, 4, 7, 5) = (/ & + &1.4707e-01_r8,3.2827e-01_r8,3.9251e-01_r8,4.2303e-01_r8,4.2524e-01_r8,3.9890e-01_r8, & + &3.4920e-01_r8,2.8325e-01_r8,5.4340e-01_r8/) + kao(:, 5, 7, 5) = (/ & + &1.4361e-01_r8,3.1545e-01_r8,3.7348e-01_r8,4.0710e-01_r8,4.0646e-01_r8,3.8591e-01_r8, & + &3.3880e-01_r8,2.9285e-01_r8,5.0986e-01_r8/) + kao(:, 1, 8, 5) = (/ & + &1.4820e-01_r8,3.5091e-01_r8,4.2013e-01_r8,4.5147e-01_r8,4.5056e-01_r8,4.1729e-01_r8, & + &3.4786e-01_r8,2.6599e-01_r8,6.3121e-01_r8/) + kao(:, 2, 8, 5) = (/ & + &1.4070e-01_r8,3.2895e-01_r8,3.9148e-01_r8,4.1739e-01_r8,4.1786e-01_r8,3.8937e-01_r8, & + &3.2642e-01_r8,2.5048e-01_r8,5.6833e-01_r8/) + kao(:, 3, 8, 5) = (/ & + &1.3491e-01_r8,3.1064e-01_r8,3.6928e-01_r8,3.9231e-01_r8,3.9615e-01_r8,3.7023e-01_r8, & + &3.1619e-01_r8,2.4413e-01_r8,5.2283e-01_r8/) + kao(:, 4, 8, 5) = (/ & + &1.3040e-01_r8,2.9486e-01_r8,3.4865e-01_r8,3.7267e-01_r8,3.7585e-01_r8,3.5308e-01_r8, & + &3.1289e-01_r8,2.4763e-01_r8,4.8158e-01_r8/) + kao(:, 5, 8, 5) = (/ & + &1.2713e-01_r8,2.8372e-01_r8,3.3299e-01_r8,3.5768e-01_r8,3.6293e-01_r8,3.4468e-01_r8, & + &2.9924e-01_r8,2.5414e-01_r8,4.5058e-01_r8/) + kao(:, 1, 9, 5) = (/ & + &1.3333e-01_r8,3.1732e-01_r8,3.7806e-01_r8,3.9822e-01_r8,3.9576e-01_r8,3.6830e-01_r8, & + &3.0959e-01_r8,2.3751e-01_r8,5.5734e-01_r8/) + kao(:, 2, 9, 5) = (/ & + &1.2728e-01_r8,2.9745e-01_r8,3.4973e-01_r8,3.7018e-01_r8,3.6774e-01_r8,3.4366e-01_r8, & + &2.8994e-01_r8,2.2165e-01_r8,5.0172e-01_r8/) + kao(:, 3, 9, 5) = (/ & + &1.2260e-01_r8,2.7734e-01_r8,3.2656e-01_r8,3.4735e-01_r8,3.4508e-01_r8,3.2798e-01_r8, & + &2.8353e-01_r8,2.1398e-01_r8,4.5989e-01_r8/) + kao(:, 4, 9, 5) = (/ & + &1.1943e-01_r8,2.6308e-01_r8,3.0660e-01_r8,3.2980e-01_r8,3.3173e-01_r8,3.1278e-01_r8, & + &2.7390e-01_r8,2.1485e-01_r8,4.2942e-01_r8/) + kao(:, 5, 9, 5) = (/ & + &1.1701e-01_r8,2.4928e-01_r8,2.9183e-01_r8,3.1474e-01_r8,3.2039e-01_r8,3.0863e-01_r8, & + &2.6433e-01_r8,2.1871e-01_r8,3.9836e-01_r8/) + kao(:, 1,10, 5) = (/ & + &1.2488e-01_r8,2.8649e-01_r8,3.3436e-01_r8,3.5060e-01_r8,3.4715e-01_r8,3.2381e-01_r8, & + &2.7352e-01_r8,2.0897e-01_r8,4.9029e-01_r8/) + kao(:, 2,10, 5) = (/ & + &1.1908e-01_r8,2.6494e-01_r8,3.0883e-01_r8,3.2464e-01_r8,3.2171e-01_r8,3.0303e-01_r8, & + &2.5647e-01_r8,1.9520e-01_r8,4.4008e-01_r8/) + kao(:, 3,10, 5) = (/ & + &1.1556e-01_r8,2.4763e-01_r8,2.8674e-01_r8,3.0514e-01_r8,3.0302e-01_r8,2.8868e-01_r8, & + &2.5222e-01_r8,1.8782e-01_r8,4.0842e-01_r8/) + kao(:, 4,10, 5) = (/ & + &1.1322e-01_r8,2.3334e-01_r8,2.7126e-01_r8,2.8846e-01_r8,2.9340e-01_r8,2.7863e-01_r8, & + &2.4033e-01_r8,1.8521e-01_r8,3.8163e-01_r8/) + kao(:, 5,10, 5) = (/ & + &1.1126e-01_r8,2.2285e-01_r8,2.5915e-01_r8,2.7811e-01_r8,2.8680e-01_r8,2.7376e-01_r8, & + &2.3030e-01_r8,1.8823e-01_r8,3.5861e-01_r8/) + kao(:, 1,11, 5) = (/ & + &1.2133e-01_r8,2.4900e-01_r8,2.8640e-01_r8,2.9703e-01_r8,2.9301e-01_r8,2.7475e-01_r8, & + &2.3250e-01_r8,1.7899e-01_r8,4.0785e-01_r8/) + kao(:, 2,11, 5) = (/ & + &1.1707e-01_r8,2.3382e-01_r8,2.6584e-01_r8,2.7776e-01_r8,2.7455e-01_r8,2.6096e-01_r8, & + &2.2631e-01_r8,1.6847e-01_r8,3.7573e-01_r8/) + kao(:, 3,11, 5) = (/ & + &1.1375e-01_r8,2.1845e-01_r8,2.5115e-01_r8,2.6117e-01_r8,2.6335e-01_r8,2.5113e-01_r8, & + &2.1653e-01_r8,1.6132e-01_r8,3.4922e-01_r8/) + kao(:, 4,11, 5) = (/ & + &1.1166e-01_r8,2.0864e-01_r8,2.3761e-01_r8,2.5163e-01_r8,2.5840e-01_r8,2.4419e-01_r8, & + &2.0592e-01_r8,1.6130e-01_r8,3.3156e-01_r8/) + kao(:, 5,11, 5) = (/ & + &1.1026e-01_r8,2.0025e-01_r8,2.2827e-01_r8,2.4711e-01_r8,2.5459e-01_r8,2.3449e-01_r8, & + &1.9737e-01_r8,1.6301e-01_r8,3.1155e-01_r8/) + kao(:, 1,12, 5) = (/ & + &1.2068e-01_r8,2.2498e-01_r8,2.5241e-01_r8,2.6093e-01_r8,2.5316e-01_r8,2.3830e-01_r8, & + &2.0580e-01_r8,1.5434e-01_r8,3.4650e-01_r8/) + kao(:, 2,12, 5) = (/ & + &1.1732e-01_r8,2.1063e-01_r8,2.3754e-01_r8,2.4422e-01_r8,2.4130e-01_r8,2.2913e-01_r8, & + &1.9581e-01_r8,1.4538e-01_r8,3.2419e-01_r8/) + kao(:, 3,12, 5) = (/ & + &1.1291e-01_r8,2.0050e-01_r8,2.2356e-01_r8,2.3528e-01_r8,2.3734e-01_r8,2.2099e-01_r8, & + &1.8732e-01_r8,1.4169e-01_r8,3.0809e-01_r8/) + kao(:, 4,12, 5) = (/ & + &1.0801e-01_r8,1.9213e-01_r8,2.1514e-01_r8,2.2964e-01_r8,2.3229e-01_r8,2.1151e-01_r8, & + &1.7615e-01_r8,1.4140e-01_r8,2.8807e-01_r8/) + kao(:, 5,12, 5) = (/ & + &1.0409e-01_r8,1.8478e-01_r8,2.0856e-01_r8,2.2937e-01_r8,2.2388e-01_r8,2.0038e-01_r8, & + &1.7052e-01_r8,1.4327e-01_r8,2.6150e-01_r8/) + kao(:, 1,13, 5) = (/ & + &1.1514e-01_r8,2.0822e-01_r8,2.3178e-01_r8,2.3757e-01_r8,2.2988e-01_r8,2.1559e-01_r8, & + &1.8505e-01_r8,1.3755e-01_r8,3.0255e-01_r8/) + kao(:, 2,13, 5) = (/ & + &1.0856e-01_r8,1.9378e-01_r8,2.1572e-01_r8,2.2466e-01_r8,2.2140e-01_r8,2.1071e-01_r8, & + &1.7476e-01_r8,1.2903e-01_r8,2.8912e-01_r8/) + kao(:, 3,13, 5) = (/ & + &1.0257e-01_r8,1.8315e-01_r8,2.0306e-01_r8,2.1501e-01_r8,2.1837e-01_r8,1.9973e-01_r8, & + &1.6546e-01_r8,1.2594e-01_r8,2.7440e-01_r8/) + kao(:, 4,13, 5) = (/ & + &9.7502e-02_r8,1.7382e-01_r8,1.9450e-01_r8,2.1448e-01_r8,2.0917e-01_r8,1.8735e-01_r8, & + &1.5671e-01_r8,1.2605e-01_r8,2.4875e-01_r8/) + kao(:, 5,13, 5) = (/ & + &9.4048e-02_r8,1.6507e-01_r8,1.8951e-01_r8,2.1087e-01_r8,1.9884e-01_r8,1.7732e-01_r8, & + &1.5188e-01_r8,1.2757e-01_r8,2.1998e-01_r8/) + kao(:, 1, 1, 6) = (/ & + &1.2242e+00_r8,1.1159e+00_r8,1.0120e+00_r8,9.1389e-01_r8,8.1856e-01_r8,1.1483e+00_r8, & + &9.8709e-01_r8,9.2159e-01_r8,4.7502e-01_r8/) + kao(:, 2, 1, 6) = (/ & + &1.1928e+00_r8,1.0903e+00_r8,9.9311e-01_r8,9.0065e-01_r8,8.3223e-01_r8,1.1145e+00_r8, & + &9.5738e-01_r8,9.2153e-01_r8,6.9449e-01_r8/) + kao(:, 3, 1, 6) = (/ & + &1.1808e+00_r8,1.0824e+00_r8,9.8824e-01_r8,8.9828e-01_r8,8.9586e-01_r8,1.0864e+00_r8, & + &9.3281e-01_r8,9.2795e-01_r8,8.4213e-01_r8/) + kao(:, 4, 1, 6) = (/ & + &1.1721e+00_r8,1.0760e+00_r8,9.8481e-01_r8,8.9679e-01_r8,9.5583e-01_r8,1.0646e+00_r8, & + &9.4941e-01_r8,9.2047e-01_r8,8.5863e-01_r8/) + kao(:, 5, 1, 6) = (/ & + &1.1790e+00_r8,1.0814e+00_r8,9.8996e-01_r8,8.9927e-01_r8,1.0035e+00_r8,1.0346e+00_r8, & + &9.5167e-01_r8,9.2657e-01_r8,7.2509e-01_r8/) + kao(:, 1, 2, 6) = (/ & + &1.0264e+00_r8,9.4284e-01_r8,8.6709e-01_r8,7.9559e-01_r8,1.1080e+00_r8,1.0254e+00_r8, & + &9.2224e-01_r8,8.7122e-01_r8,1.0512e+00_r8/) + kao(:, 2, 2, 6) = (/ & + &1.0018e+00_r8,9.2359e-01_r8,8.5299e-01_r8,7.8672e-01_r8,1.0674e+00_r8,9.8417e-01_r8, & + &8.9700e-01_r8,8.6779e-01_r8,9.4293e-01_r8/) + kao(:, 3, 2, 6) = (/ & + &9.8988e-01_r8,9.1596e-01_r8,8.4833e-01_r8,7.8816e-01_r8,1.0499e+00_r8,9.5536e-01_r8, & + &8.7579e-01_r8,8.5648e-01_r8,8.1445e-01_r8/) + kao(:, 4, 2, 6) = (/ & + &9.8822e-01_r8,9.1536e-01_r8,8.4663e-01_r8,7.9377e-01_r8,1.0292e+00_r8,9.3843e-01_r8, & + &8.7227e-01_r8,8.6174e-01_r8,7.0730e-01_r8/) + kao(:, 5, 2, 6) = (/ & + &9.8800e-01_r8,9.1393e-01_r8,8.4855e-01_r8,8.2484e-01_r8,1.0072e+00_r8,9.4807e-01_r8, & + &8.8827e-01_r8,8.7216e-01_r8,5.9331e-01_r8/) + kao(:, 1, 3, 6) = (/ & + &8.6794e-01_r8,8.0430e-01_r8,7.5031e-01_r8,8.9541e-01_r8,1.0214e+00_r8,9.4865e-01_r8, & + &8.5821e-01_r8,7.9700e-01_r8,8.7719e-01_r8/) + kao(:, 2, 3, 6) = (/ & + &8.4313e-01_r8,7.8532e-01_r8,7.3608e-01_r8,9.3906e-01_r8,9.7060e-01_r8,9.0816e-01_r8, & + &8.3425e-01_r8,7.9621e-01_r8,7.6329e-01_r8/) + kao(:, 3, 3, 6) = (/ & + &8.3157e-01_r8,7.7858e-01_r8,7.3266e-01_r8,9.5972e-01_r8,9.4116e-01_r8,8.8096e-01_r8, & + &8.0848e-01_r8,7.9477e-01_r8,6.5966e-01_r8/) + kao(:, 4, 3, 6) = (/ & + &8.2987e-01_r8,7.7678e-01_r8,7.3040e-01_r8,9.3971e-01_r8,9.0923e-01_r8,8.7002e-01_r8, & + &8.0556e-01_r8,8.1217e-01_r8,6.0022e-01_r8/) + kao(:, 5, 3, 6) = (/ & + &8.2093e-01_r8,7.6968e-01_r8,7.2610e-01_r8,9.2404e-01_r8,8.9670e-01_r8,8.5391e-01_r8, & + &7.9373e-01_r8,8.1610e-01_r8,5.3117e-01_r8/) + kao(:, 1, 4, 6) = (/ & + &7.3504e-01_r8,6.8896e-01_r8,6.5474e-01_r8,9.5125e-01_r8,9.3510e-01_r8,8.8191e-01_r8, & + &7.8339e-01_r8,7.2709e-01_r8,7.9136e-01_r8/) + kao(:, 2, 4, 6) = (/ & + &7.1205e-01_r8,6.7167e-01_r8,6.7088e-01_r8,9.0689e-01_r8,8.7886e-01_r8,8.4133e-01_r8, & + &7.6196e-01_r8,7.2232e-01_r8,6.9067e-01_r8/) + kao(:, 3, 4, 6) = (/ & + &7.0055e-01_r8,6.6424e-01_r8,7.0492e-01_r8,8.8094e-01_r8,8.5026e-01_r8,8.0832e-01_r8, & + &7.4494e-01_r8,7.3074e-01_r8,6.1263e-01_r8/) + kao(:, 4, 4, 6) = (/ & + &6.9588e-01_r8,6.6015e-01_r8,7.3043e-01_r8,8.5040e-01_r8,8.2745e-01_r8,7.8458e-01_r8, & + &7.3728e-01_r8,7.3901e-01_r8,5.3700e-01_r8/) + kao(:, 5, 4, 6) = (/ & + &6.8558e-01_r8,6.5206e-01_r8,7.5371e-01_r8,8.2365e-01_r8,8.2063e-01_r8,7.6670e-01_r8, & + &7.3328e-01_r8,7.4717e-01_r8,4.4797e-01_r8/) + kao(:, 1, 5, 6) = (/ & + &6.2240e-01_r8,5.9202e-01_r8,7.9818e-01_r8,8.6221e-01_r8,8.4556e-01_r8,7.9840e-01_r8, & + &7.0353e-01_r8,6.4834e-01_r8,7.3196e-01_r8/) + kao(:, 2, 5, 6) = (/ & + &6.0152e-01_r8,5.7633e-01_r8,8.0789e-01_r8,8.1513e-01_r8,8.0789e-01_r8,7.5099e-01_r8, & + &6.7710e-01_r8,6.4945e-01_r8,6.3067e-01_r8/) + kao(:, 3, 5, 6) = (/ & + &5.8999e-01_r8,5.6942e-01_r8,7.6969e-01_r8,7.8647e-01_r8,7.7674e-01_r8,7.1468e-01_r8, & + &6.6534e-01_r8,6.5860e-01_r8,5.4173e-01_r8/) + kao(:, 4, 5, 6) = (/ & + &5.8241e-01_r8,5.6326e-01_r8,7.5015e-01_r8,7.6096e-01_r8,7.5392e-01_r8,6.9429e-01_r8, & + &6.6094e-01_r8,6.6621e-01_r8,4.4433e-01_r8/) + kao(:, 5, 5, 6) = (/ & + &5.7098e-01_r8,5.5310e-01_r8,7.2743e-01_r8,7.3939e-01_r8,7.3730e-01_r8,6.8982e-01_r8, & + &6.6680e-01_r8,6.6632e-01_r8,3.5896e-01_r8/) + kao(:, 1, 6, 6) = (/ & + &5.2885e-01_r8,5.1244e-01_r8,7.5494e-01_r8,7.8724e-01_r8,7.7080e-01_r8,7.0256e-01_r8, & + &6.2568e-01_r8,5.6883e-01_r8,6.4732e-01_r8/) + kao(:, 2, 6, 6) = (/ & + &5.0860e-01_r8,4.9747e-01_r8,7.1101e-01_r8,7.4294e-01_r8,7.2488e-01_r8,6.6139e-01_r8, & + &6.0894e-01_r8,5.7630e-01_r8,5.5132e-01_r8/) + kao(:, 3, 6, 6) = (/ & + &4.9680e-01_r8,4.8858e-01_r8,6.8601e-01_r8,7.0262e-01_r8,6.9083e-01_r8,6.2832e-01_r8, & + &5.9581e-01_r8,5.8177e-01_r8,4.5843e-01_r8/) + kao(:, 4, 6, 6) = (/ & + &4.8828e-01_r8,4.9338e-01_r8,6.6185e-01_r8,6.8834e-01_r8,6.6433e-01_r8,6.1518e-01_r8, & + &5.9405e-01_r8,5.8713e-01_r8,3.7286e-01_r8/) + kao(:, 5, 6, 6) = (/ & + &4.7758e-01_r8,5.0393e-01_r8,6.4306e-01_r8,6.6695e-01_r8,6.4365e-01_r8,6.0629e-01_r8, & + &5.9623e-01_r8,5.8994e-01_r8,3.0878e-01_r8/) + kao(:, 1, 7, 6) = (/ & + &4.5544e-01_r8,5.1675e-01_r8,6.9040e-01_r8,7.2442e-01_r8,6.9583e-01_r8,6.2374e-01_r8, & + &5.5330e-01_r8,4.9819e-01_r8,5.7066e-01_r8/) + kao(:, 2, 7, 6) = (/ & + &4.3526e-01_r8,5.2433e-01_r8,6.5887e-01_r8,6.7132e-01_r8,6.4888e-01_r8,5.8229e-01_r8, & + &5.3592e-01_r8,5.0387e-01_r8,4.7263e-01_r8/) + kao(:, 3, 7, 6) = (/ & + &4.2386e-01_r8,5.3503e-01_r8,6.2067e-01_r8,6.3646e-01_r8,6.0983e-01_r8,5.5722e-01_r8, & + &5.2827e-01_r8,5.1003e-01_r8,3.8891e-01_r8/) + kao(:, 4, 7, 6) = (/ & + &4.1478e-01_r8,5.3714e-01_r8,5.9921e-01_r8,6.0957e-01_r8,5.8334e-01_r8,5.4159e-01_r8, & + &5.2418e-01_r8,5.1278e-01_r8,3.1885e-01_r8/) + kao(:, 5, 7, 6) = (/ & + &4.0467e-01_r8,5.2009e-01_r8,5.7701e-01_r8,5.8575e-01_r8,5.6859e-01_r8,5.4155e-01_r8, & + &5.3930e-01_r8,5.1710e-01_r8,2.6235e-01_r8/) + kao(:, 1, 8, 6) = (/ & + &4.0091e-01_r8,5.6115e-01_r8,6.4335e-01_r8,6.5229e-01_r8,6.2013e-01_r8,5.5832e-01_r8, & + &4.9333e-01_r8,4.3362e-01_r8,5.1143e-01_r8/) + kao(:, 2, 8, 6) = (/ & + &3.8169e-01_r8,5.2953e-01_r8,5.9829e-01_r8,6.0811e-01_r8,5.7734e-01_r8,5.1950e-01_r8, & + &4.7393e-01_r8,4.3986e-01_r8,4.2322e-01_r8/) + kao(:, 3, 8, 6) = (/ & + &3.7078e-01_r8,5.0436e-01_r8,5.6958e-01_r8,5.7197e-01_r8,5.3831e-01_r8,4.9299e-01_r8, & + &4.6737e-01_r8,4.4557e-01_r8,3.4628e-01_r8/) + kao(:, 4, 8, 6) = (/ & + &3.6161e-01_r8,4.8989e-01_r8,5.4426e-01_r8,5.4657e-01_r8,5.1938e-01_r8,4.8189e-01_r8, & + &4.6346e-01_r8,4.4852e-01_r8,2.8491e-01_r8/) + kao(:, 5, 8, 6) = (/ & + &3.5235e-01_r8,4.6785e-01_r8,5.2499e-01_r8,5.2434e-01_r8,5.0210e-01_r8,4.7954e-01_r8, & + &4.8680e-01_r8,4.5258e-01_r8,2.3809e-01_r8/) + kao(:, 1, 9, 6) = (/ & + &3.5188e-01_r8,5.0784e-01_r8,5.8680e-01_r8,5.8599e-01_r8,5.5453e-01_r8,4.9355e-01_r8, & + &4.3434e-01_r8,3.7345e-01_r8,4.5760e-01_r8/) + kao(:, 2, 9, 6) = (/ & + &3.3384e-01_r8,4.7725e-01_r8,5.4527e-01_r8,5.4039e-01_r8,5.1277e-01_r8,4.6053e-01_r8, & + &4.1752e-01_r8,3.8054e-01_r8,3.7664e-01_r8/) + kao(:, 3, 9, 6) = (/ & + &3.2337e-01_r8,4.6079e-01_r8,5.0889e-01_r8,5.0540e-01_r8,4.8167e-01_r8,4.3259e-01_r8, & + &4.1005e-01_r8,3.8447e-01_r8,3.0502e-01_r8/) + kao(:, 4, 9, 6) = (/ & + &3.1489e-01_r8,4.4224e-01_r8,4.8906e-01_r8,4.8098e-01_r8,4.5962e-01_r8,4.2889e-01_r8, & + &4.1407e-01_r8,3.8891e-01_r8,2.4901e-01_r8/) + kao(:, 5, 9, 6) = (/ & + &3.0731e-01_r8,4.2604e-01_r8,4.6542e-01_r8,4.6457e-01_r8,4.4425e-01_r8,4.2325e-01_r8, & + &4.3000e-01_r8,3.9500e-01_r8,2.1365e-01_r8/) + kao(:, 1,10, 6) = (/ & + &3.0872e-01_r8,4.6438e-01_r8,5.2605e-01_r8,5.1940e-01_r8,4.8758e-01_r8,4.3435e-01_r8, & + &3.8048e-01_r8,3.2415e-01_r8,4.0329e-01_r8/) + kao(:, 2,10, 6) = (/ & + &2.9295e-01_r8,4.4115e-01_r8,4.8348e-01_r8,4.7740e-01_r8,4.4909e-01_r8,4.0221e-01_r8, & + &3.6624e-01_r8,3.2721e-01_r8,3.3011e-01_r8/) + kao(:, 3,10, 6) = (/ & + &2.8328e-01_r8,4.1772e-01_r8,4.5515e-01_r8,4.4741e-01_r8,4.2330e-01_r8,3.8012e-01_r8, & + &3.5851e-01_r8,3.3085e-01_r8,2.6425e-01_r8/) + kao(:, 4,10, 6) = (/ & + &2.7562e-01_r8,4.0009e-01_r8,4.2827e-01_r8,4.2695e-01_r8,4.0250e-01_r8,3.7844e-01_r8, & + &3.6844e-01_r8,3.3695e-01_r8,2.1886e-01_r8/) + kao(:, 5,10, 6) = (/ & + &2.6849e-01_r8,3.8403e-01_r8,4.1066e-01_r8,4.0861e-01_r8,3.9231e-01_r8,3.7926e-01_r8, & + &3.7696e-01_r8,3.4332e-01_r8,1.9262e-01_r8/) + kao(:, 1,11, 6) = (/ & + &2.6466e-01_r8,4.1355e-01_r8,4.4454e-01_r8,4.4042e-01_r8,4.1233e-01_r8,3.6752e-01_r8, & + &3.2678e-01_r8,2.7894e-01_r8,3.2749e-01_r8/) + kao(:, 2,11, 6) = (/ & + &2.5291e-01_r8,3.8781e-01_r8,4.1430e-01_r8,4.0659e-01_r8,3.8277e-01_r8,3.4153e-01_r8, & + &3.1495e-01_r8,2.7988e-01_r8,2.6257e-01_r8/) + kao(:, 3,11, 6) = (/ & + &2.4541e-01_r8,3.7100e-01_r8,3.8849e-01_r8,3.8315e-01_r8,3.6055e-01_r8,3.3569e-01_r8, & + &3.1896e-01_r8,2.8851e-01_r8,2.1720e-01_r8/) + kao(:, 4,11, 6) = (/ & + &2.3761e-01_r8,3.4992e-01_r8,3.7138e-01_r8,3.6645e-01_r8,3.4895e-01_r8,3.3415e-01_r8, & + &3.2576e-01_r8,2.9375e-01_r8,1.9101e-01_r8/) + kao(:, 5,11, 6) = (/ & + &2.3136e-01_r8,3.3422e-01_r8,3.5550e-01_r8,3.5462e-01_r8,3.4596e-01_r8,3.4410e-01_r8, & + &3.3336e-01_r8,3.0010e-01_r8,1.7683e-01_r8/) + kao(:, 1,12, 6) = (/ & + &2.3099e-01_r8,3.6467e-01_r8,3.8654e-01_r8,3.7740e-01_r8,3.5454e-01_r8,3.1341e-01_r8, & + &2.8207e-01_r8,2.4141e-01_r8,2.7098e-01_r8/) + kao(:, 2,12, 6) = (/ & + &2.2244e-01_r8,3.4190e-01_r8,3.5753e-01_r8,3.5048e-01_r8,3.3109e-01_r8,2.9786e-01_r8, & + &2.7909e-01_r8,2.4469e-01_r8,2.1730e-01_r8/) + kao(:, 3,12, 6) = (/ & + &2.1694e-01_r8,3.2183e-01_r8,3.3982e-01_r8,3.3193e-01_r8,3.1521e-01_r8,2.9823e-01_r8, & + &2.8101e-01_r8,2.4988e-01_r8,1.8539e-01_r8/) + kao(:, 4,12, 6) = (/ & + &2.1365e-01_r8,3.0582e-01_r8,3.2214e-01_r8,3.1915e-01_r8,3.0963e-01_r8,3.0101e-01_r8, & + &2.9010e-01_r8,2.5511e-01_r8,1.7246e-01_r8/) + kao(:, 5,12, 6) = (/ & + &2.1126e-01_r8,2.9440e-01_r8,3.1065e-01_r8,3.1395e-01_r8,3.1604e-01_r8,3.0993e-01_r8, & + &2.9537e-01_r8,2.6162e-01_r8,1.5291e-01_r8/) + kao(:, 1,13, 6) = (/ & + &2.2386e-01_r8,3.3097e-01_r8,3.4162e-01_r8,3.3327e-01_r8,3.1314e-01_r8,2.7728e-01_r8, & + &2.5014e-01_r8,2.1154e-01_r8,2.3428e-01_r8/) + kao(:, 2,13, 6) = (/ & + &2.2040e-01_r8,3.1261e-01_r8,3.2237e-01_r8,3.1373e-01_r8,2.9682e-01_r8,2.6651e-01_r8, & + &2.5032e-01_r8,2.1702e-01_r8,1.9039e-01_r8/) + kao(:, 3,13, 6) = (/ & + &2.1610e-01_r8,2.9730e-01_r8,3.0955e-01_r8,3.0133e-01_r8,2.8651e-01_r8,2.7201e-01_r8, & + &2.5430e-01_r8,2.2027e-01_r8,1.6665e-01_r8/) + kao(:, 4,13, 6) = (/ & + &2.1312e-01_r8,2.8629e-01_r8,2.9748e-01_r8,2.9400e-01_r8,2.8967e-01_r8,2.7599e-01_r8, & + &2.5853e-01_r8,2.2523e-01_r8,1.5373e-01_r8/) + kao(:, 5,13, 6) = (/ & + &2.0806e-01_r8,2.7757e-01_r8,2.8967e-01_r8,2.9354e-01_r8,2.9376e-01_r8,2.8253e-01_r8, & + &2.6218e-01_r8,2.3101e-01_r8,1.3574e-01_r8/) + kao(:, 1, 1, 7) = (/ & + &3.5613e+00_r8,3.1188e+00_r8,2.6764e+00_r8,2.2340e+00_r8,1.7917e+00_r8,1.6352e+00_r8, & + &1.8092e+00_r8,1.6379e+00_r8,2.7539e-02_r8/) + kao(:, 2, 1, 7) = (/ & + &3.4002e+00_r8,2.9785e+00_r8,2.5569e+00_r8,2.1349e+00_r8,1.7133e+00_r8,1.7200e+00_r8, & + &1.7738e+00_r8,1.6325e+00_r8,3.6313e-02_r8/) + kao(:, 3, 1, 7) = (/ & + &3.2557e+00_r8,2.8529e+00_r8,2.4503e+00_r8,2.0478e+00_r8,1.6479e+00_r8,1.7947e+00_r8, & + &1.7613e+00_r8,1.6123e+00_r8,7.9598e-02_r8/) + kao(:, 4, 1, 7) = (/ & + &3.1418e+00_r8,2.7541e+00_r8,2.3673e+00_r8,1.9817e+00_r8,1.6011e+00_r8,1.8327e+00_r8, & + &1.7198e+00_r8,1.6148e+00_r8,2.1944e-01_r8/) + kao(:, 5, 1, 7) = (/ & + &3.1204e+00_r8,2.7380e+00_r8,2.3562e+00_r8,1.9785e+00_r8,1.6099e+00_r8,1.8773e+00_r8, & + &1.7180e+00_r8,1.6127e+00_r8,2.9776e-01_r8/) + kao(:, 1, 2, 7) = (/ & + &2.9874e+00_r8,2.6163e+00_r8,2.2453e+00_r8,1.8746e+00_r8,1.5312e+00_r8,1.8525e+00_r8, & + &1.7071e+00_r8,1.5893e+00_r8,5.1776e-01_r8/) + kao(:, 2, 2, 7) = (/ & + &2.8505e+00_r8,2.4972e+00_r8,2.1440e+00_r8,1.7909e+00_r8,1.5966e+00_r8,1.8306e+00_r8, & + &1.6863e+00_r8,1.5842e+00_r8,4.3879e-01_r8/) + kao(:, 3, 2, 7) = (/ & + &2.7350e+00_r8,2.3969e+00_r8,2.0589e+00_r8,1.7214e+00_r8,1.6370e+00_r8,1.7877e+00_r8, & + &1.6805e+00_r8,1.5918e+00_r8,4.1523e-01_r8/) + kao(:, 4, 2, 7) = (/ & + &2.6409e+00_r8,2.3156e+00_r8,1.9935e+00_r8,1.6727e+00_r8,1.6830e+00_r8,1.7575e+00_r8, & + &1.6634e+00_r8,1.5980e+00_r8,2.9373e-01_r8/) + kao(:, 5, 2, 7) = (/ & + &2.5886e+00_r8,2.2740e+00_r8,1.9607e+00_r8,1.6497e+00_r8,1.7391e+00_r8,1.7232e+00_r8, & + &1.6344e+00_r8,1.6105e+00_r8,1.8509e-01_r8/) + kao(:, 1, 3, 7) = (/ & + &2.5285e+00_r8,2.2147e+00_r8,1.9010e+00_r8,1.5874e+00_r8,1.8079e+00_r8,1.7347e+00_r8, & + &1.6267e+00_r8,1.5173e+00_r8,4.9543e-01_r8/) + kao(:, 2, 3, 7) = (/ & + &2.4109e+00_r8,2.1124e+00_r8,1.8139e+00_r8,1.5156e+00_r8,1.7831e+00_r8,1.7011e+00_r8, & + &1.6143e+00_r8,1.5141e+00_r8,4.4268e-01_r8/) + kao(:, 3, 3, 7) = (/ & + &2.3122e+00_r8,2.0266e+00_r8,1.7413e+00_r8,1.4891e+00_r8,1.7442e+00_r8,1.6741e+00_r8, & + &1.6075e+00_r8,1.5297e+00_r8,3.4522e-01_r8/) + kao(:, 4, 3, 7) = (/ & + &2.2338e+00_r8,1.9602e+00_r8,1.6889e+00_r8,1.5208e+00_r8,1.7228e+00_r8,1.6317e+00_r8, & + &1.5933e+00_r8,1.5434e+00_r8,2.1394e-01_r8/) + kao(:, 5, 3, 7) = (/ & + &2.1901e+00_r8,1.9250e+00_r8,1.6600e+00_r8,1.5510e+00_r8,1.6972e+00_r8,1.6258e+00_r8, & + &1.5808e+00_r8,1.5686e+00_r8,1.5097e-01_r8/) + kao(:, 1, 4, 7) = (/ & + &2.1490e+00_r8,1.8824e+00_r8,1.6159e+00_r8,1.5783e+00_r8,1.6916e+00_r8,1.6097e+00_r8, & + &1.5676e+00_r8,1.4069e+00_r8,5.0896e-01_r8/) + kao(:, 2, 4, 7) = (/ & + &2.0429e+00_r8,1.7900e+00_r8,1.5373e+00_r8,1.6130e+00_r8,1.6613e+00_r8,1.5828e+00_r8, & + &1.5388e+00_r8,1.4176e+00_r8,3.7374e-01_r8/) + kao(:, 3, 4, 7) = (/ & + &1.9560e+00_r8,1.7146e+00_r8,1.4748e+00_r8,1.6326e+00_r8,1.6129e+00_r8,1.5608e+00_r8, & + &1.5146e+00_r8,1.4336e+00_r8,2.6187e-01_r8/) + kao(:, 4, 4, 7) = (/ & + &1.8914e+00_r8,1.6603e+00_r8,1.4322e+00_r8,1.6118e+00_r8,1.5843e+00_r8,1.5418e+00_r8, & + &1.4880e+00_r8,1.4608e+00_r8,1.8007e-01_r8/) + kao(:, 5, 4, 7) = (/ & + &1.8569e+00_r8,1.6328e+00_r8,1.4097e+00_r8,1.6022e+00_r8,1.5587e+00_r8,1.5446e+00_r8, & + &1.4805e+00_r8,1.4912e+00_r8,1.1749e-01_r8/) + kao(:, 1, 5, 7) = (/ & + &1.8276e+00_r8,1.6010e+00_r8,1.3745e+00_r8,1.6030e+00_r8,1.5630e+00_r8,1.5166e+00_r8, & + &1.4457e+00_r8,1.2855e+00_r8,4.3144e-01_r8/) + kao(:, 2, 5, 7) = (/ & + &1.7325e+00_r8,1.5182e+00_r8,1.3289e+00_r8,1.5483e+00_r8,1.5172e+00_r8,1.4962e+00_r8, & + &1.4204e+00_r8,1.2974e+00_r8,3.2532e-01_r8/) + kao(:, 3, 5, 7) = (/ & + &1.6556e+00_r8,1.4514e+00_r8,1.3491e+00_r8,1.5022e+00_r8,1.4839e+00_r8,1.4801e+00_r8, & + &1.3899e+00_r8,1.3214e+00_r8,2.2874e-01_r8/) + kao(:, 4, 5, 7) = (/ & + &1.6008e+00_r8,1.4058e+00_r8,1.3614e+00_r8,1.4817e+00_r8,1.4667e+00_r8,1.4542e+00_r8, & + &1.3728e+00_r8,1.3543e+00_r8,1.4774e-01_r8/) + kao(:, 5, 5, 7) = (/ & + &1.5722e+00_r8,1.3835e+00_r8,1.3910e+00_r8,1.4609e+00_r8,1.4510e+00_r8,1.4341e+00_r8, & + &1.3580e+00_r8,1.3940e+00_r8,9.9947e-02_r8/) + kao(:, 1, 6, 7) = (/ & + &1.5600e+00_r8,1.3665e+00_r8,1.3891e+00_r8,1.4520e+00_r8,1.4361e+00_r8,1.4207e+00_r8, & + &1.3105e+00_r8,1.1513e+00_r8,3.8692e-01_r8/) + kao(:, 2, 6, 7) = (/ & + &1.4739e+00_r8,1.2917e+00_r8,1.3972e+00_r8,1.4114e+00_r8,1.4085e+00_r8,1.3840e+00_r8, & + &1.2763e+00_r8,1.1653e+00_r8,2.7607e-01_r8/) + kao(:, 3, 6, 7) = (/ & + &1.4042e+00_r8,1.2317e+00_r8,1.3535e+00_r8,1.3731e+00_r8,1.3834e+00_r8,1.3540e+00_r8, & + &1.2537e+00_r8,1.1954e+00_r8,1.8549e-01_r8/) + kao(:, 4, 6, 7) = (/ & + &1.3553e+00_r8,1.1909e+00_r8,1.3235e+00_r8,1.3411e+00_r8,1.3606e+00_r8,1.3282e+00_r8, & + &1.2356e+00_r8,1.2339e+00_r8,1.3113e-01_r8/) + kao(:, 5, 6, 7) = (/ & + &1.3290e+00_r8,1.1708e+00_r8,1.3052e+00_r8,1.3291e+00_r8,1.3435e+00_r8,1.3084e+00_r8, & + &1.2394e+00_r8,1.2789e+00_r8,8.5104e-02_r8/) + kao(:, 1, 7, 7) = (/ & + &1.3486e+00_r8,1.1821e+00_r8,1.3320e+00_r8,1.3296e+00_r8,1.3530e+00_r8,1.2921e+00_r8, & + &1.1792e+00_r8,1.0146e+00_r8,3.3967e-01_r8/) + kao(:, 2, 7, 7) = (/ & + &1.2698e+00_r8,1.1140e+00_r8,1.2658e+00_r8,1.2934e+00_r8,1.3084e+00_r8,1.2591e+00_r8, & + &1.1496e+00_r8,1.0323e+00_r8,2.4089e-01_r8/) + kao(:, 3, 7, 7) = (/ & + &1.2066e+00_r8,1.0597e+00_r8,1.2265e+00_r8,1.2606e+00_r8,1.2717e+00_r8,1.2202e+00_r8, & + &1.1236e+00_r8,1.0630e+00_r8,1.6653e-01_r8/) + kao(:, 4, 7, 7) = (/ & + &1.1624e+00_r8,1.0337e+00_r8,1.1938e+00_r8,1.2388e+00_r8,1.2436e+00_r8,1.1958e+00_r8, & + &1.1143e+00_r8,1.1071e+00_r8,1.1640e-01_r8/) + kao(:, 5, 7, 7) = (/ & + &1.1373e+00_r8,1.0419e+00_r8,1.1824e+00_r8,1.2289e+00_r8,1.2206e+00_r8,1.1715e+00_r8, & + &1.1114e+00_r8,1.1517e+00_r8,7.1520e-02_r8/) + kao(:, 1, 8, 7) = (/ & + &1.1959e+00_r8,1.0587e+00_r8,1.2168e+00_r8,1.2562e+00_r8,1.2533e+00_r8,1.1755e+00_r8, & + &1.0535e+00_r8,8.9257e-01_r8,2.9562e-01_r8/) + kao(:, 2, 8, 7) = (/ & + &1.1212e+00_r8,1.0393e+00_r8,1.1676e+00_r8,1.2170e+00_r8,1.2001e+00_r8,1.1361e+00_r8, & + &1.0253e+00_r8,9.0430e-01_r8,2.1449e-01_r8/) + kao(:, 3, 8, 7) = (/ & + &1.0601e+00_r8,1.0297e+00_r8,1.1266e+00_r8,1.1809e+00_r8,1.1623e+00_r8,1.1020e+00_r8, & + &1.0023e+00_r8,9.3591e-01_r8,1.5382e-01_r8/) + kao(:, 4, 8, 7) = (/ & + &1.0187e+00_r8,1.0227e+00_r8,1.0991e+00_r8,1.1460e+00_r8,1.1243e+00_r8,1.0751e+00_r8, & + &9.9421e-01_r8,9.7855e-01_r8,1.0944e-01_r8/) + kao(:, 5, 8, 7) = (/ & + &9.9531e-01_r8,1.0219e+00_r8,1.0832e+00_r8,1.1243e+00_r8,1.1050e+00_r8,1.0609e+00_r8, & + &9.9136e-01_r8,1.0252e+00_r8,7.0614e-02_r8/) + kao(:, 1, 9, 7) = (/ & + &1.0539e+00_r8,1.0559e+00_r8,1.1142e+00_r8,1.1729e+00_r8,1.1295e+00_r8,1.0580e+00_r8, & + &9.3382e-01_r8,7.7194e-01_r8,2.7489e-01_r8/) + kao(:, 2, 9, 7) = (/ & + &9.8392e-01_r8,1.0263e+00_r8,1.0713e+00_r8,1.1148e+00_r8,1.0796e+00_r8,1.0137e+00_r8, & + &9.0260e-01_r8,7.8234e-01_r8,1.9796e-01_r8/) + kao(:, 3, 9, 7) = (/ & + &9.2807e-01_r8,9.7104e-01_r8,1.0401e+00_r8,1.0698e+00_r8,1.0381e+00_r8,9.8279e-01_r8, & + &8.8087e-01_r8,8.1424e-01_r8,1.4396e-01_r8/) + kao(:, 4, 9, 7) = (/ & + &8.9022e-01_r8,9.3422e-01_r8,1.0109e+00_r8,1.0366e+00_r8,1.0048e+00_r8,9.5511e-01_r8, & + &8.7539e-01_r8,8.5432e-01_r8,1.0430e-01_r8/) + kao(:, 5, 9, 7) = (/ & + &8.6877e-01_r8,9.2050e-01_r8,1.0000e+00_r8,1.0116e+00_r8,9.8826e-01_r8,9.4009e-01_r8, & + &8.7922e-01_r8,9.0156e-01_r8,6.8077e-02_r8/) + kao(:, 1,10, 7) = (/ & + &9.2527e-01_r8,9.7705e-01_r8,1.0325e+00_r8,1.0578e+00_r8,1.0149e+00_r8,9.3478e-01_r8, & + &8.1724e-01_r8,6.6415e-01_r8,2.3891e-01_r8/) + kao(:, 2,10, 7) = (/ & + &8.6097e-01_r8,9.1106e-01_r8,9.9506e-01_r8,1.0007e+00_r8,9.6610e-01_r8,8.9639e-01_r8, & + &7.8861e-01_r8,6.7596e-01_r8,1.7815e-01_r8/) + kao(:, 3,10, 7) = (/ & + &8.1181e-01_r8,8.7070e-01_r8,9.5033e-01_r8,9.5476e-01_r8,9.2168e-01_r8,8.6431e-01_r8, & + &7.7032e-01_r8,7.0318e-01_r8,1.3199e-01_r8/) + kao(:, 4,10, 7) = (/ & + &7.7887e-01_r8,8.4520e-01_r8,9.2163e-01_r8,9.1956e-01_r8,8.9130e-01_r8,8.3659e-01_r8, & + &7.6501e-01_r8,7.4145e-01_r8,9.1831e-02_r8/) + kao(:, 5,10, 7) = (/ & + &7.5933e-01_r8,8.3227e-01_r8,9.0273e-01_r8,9.0188e-01_r8,8.7623e-01_r8,8.2773e-01_r8, & + &7.7824e-01_r8,7.8260e-01_r8,6.3171e-02_r8/) + kao(:, 1,11, 7) = (/ & + &7.8226e-01_r8,8.4719e-01_r8,9.2612e-01_r8,9.1570e-01_r8,8.7421e-01_r8,8.0479e-01_r8, & + &6.9799e-01_r8,5.7039e-01_r8,1.8643e-01_r8/) + kao(:, 2,11, 7) = (/ & + &7.3229e-01_r8,8.0376e-01_r8,8.7472e-01_r8,8.6879e-01_r8,8.2958e-01_r8,7.6891e-01_r8, & + &6.7602e-01_r8,5.8714e-01_r8,1.4000e-01_r8/) + kao(:, 3,11, 7) = (/ & + &6.9599e-01_r8,7.7478e-01_r8,8.4133e-01_r8,8.3314e-01_r8,7.9919e-01_r8,7.4119e-01_r8, & + &6.6696e-01_r8,6.1671e-01_r8,1.0181e-01_r8/) + kao(:, 4,11, 7) = (/ & + &6.7489e-01_r8,7.6185e-01_r8,8.1367e-01_r8,8.1128e-01_r8,7.7952e-01_r8,7.3228e-01_r8, & + &6.7358e-01_r8,6.5125e-01_r8,7.0225e-02_r8/) + kao(:, 5,11, 7) = (/ & + &6.5905e-01_r8,7.5391e-01_r8,7.9725e-01_r8,7.9623e-01_r8,7.7236e-01_r8,7.3477e-01_r8, & + &6.9321e-01_r8,6.9245e-01_r8,4.7555e-02_r8/) + kao(:, 1,12, 7) = (/ & + &6.7862e-01_r8,7.6075e-01_r8,8.1212e-01_r8,7.9974e-01_r8,7.5616e-01_r8,6.9320e-01_r8, & + &5.9851e-01_r8,4.9309e-01_r8,1.4949e-01_r8/) + kao(:, 2,12, 7) = (/ & + &6.3807e-01_r8,7.3022e-01_r8,7.7190e-01_r8,7.6245e-01_r8,7.2390e-01_r8,6.6782e-01_r8, & + &5.8563e-01_r8,5.1153e-01_r8,1.1607e-01_r8/) + kao(:, 3,12, 7) = (/ & + &6.1294e-01_r8,7.1220e-01_r8,7.4125e-01_r8,7.3342e-01_r8,6.9810e-01_r8,6.4969e-01_r8, & + &5.8866e-01_r8,5.3877e-01_r8,8.5989e-02_r8/) + kao(:, 4,12, 7) = (/ & + &5.9734e-01_r8,7.0046e-01_r8,7.2548e-01_r8,7.1635e-01_r8,6.8868e-01_r8,6.5109e-01_r8, & + &5.9747e-01_r8,5.7263e-01_r8,5.7849e-02_r8/) + kao(:, 5,12, 7) = (/ & + &5.8148e-01_r8,6.8644e-01_r8,7.1487e-01_r8,7.0660e-01_r8,6.8790e-01_r8,6.6368e-01_r8, & + &6.1903e-01_r8,6.0994e-01_r8,3.8734e-02_r8/) + kao(:, 1,13, 7) = (/ & + &6.1552e-01_r8,7.1356e-01_r8,7.3721e-01_r8,7.1646e-01_r8,6.7473e-01_r8,6.1507e-01_r8, & + &5.2767e-01_r8,4.3311e-01_r8,1.2482e-01_r8/) + kao(:, 2,13, 7) = (/ & + &5.8292e-01_r8,6.8409e-01_r8,7.0235e-01_r8,6.8503e-01_r8,6.4503e-01_r8,5.9514e-01_r8, & + &5.2204e-01_r8,4.4742e-01_r8,9.8236e-02_r8/) + kao(:, 3,13, 7) = (/ & + &5.6436e-01_r8,6.6497e-01_r8,6.8075e-01_r8,6.6573e-01_r8,6.3039e-01_r8,5.8718e-01_r8, & + &5.2651e-01_r8,4.7434e-01_r8,7.2297e-02_r8/) + kao(:, 4,13, 7) = (/ & + &5.4811e-01_r8,6.4832e-01_r8,6.6742e-01_r8,6.5348e-01_r8,6.2977e-01_r8,5.9747e-01_r8, & + &5.3863e-01_r8,5.0502e-01_r8,5.7494e-02_r8/) + kao(:, 5,13, 7) = (/ & + &5.3739e-01_r8,6.3448e-01_r8,6.5434e-01_r8,6.4659e-01_r8,6.3825e-01_r8,6.0640e-01_r8, & + &5.6100e-01_r8,5.4046e-01_r8,3.2048e-02_r8/) + kao(:, 1, 1, 8) = (/ & + &1.1660e+01_r8,1.0203e+01_r8,8.7459e+00_r8,7.2889e+00_r8,5.8318e+00_r8,4.3748e+00_r8, & + &3.7766e+00_r8,3.7739e+00_r8,2.3608e-03_r8/) + kao(:, 2, 1, 8) = (/ & + &1.1346e+01_r8,9.9282e+00_r8,8.5104e+00_r8,7.0926e+00_r8,5.6748e+00_r8,4.2570e+00_r8, & + &3.8721e+00_r8,3.9057e+00_r8,3.1824e-03_r8/) + kao(:, 3, 1, 8) = (/ & + &1.1194e+01_r8,9.7951e+00_r8,8.3963e+00_r8,6.9976e+00_r8,5.5988e+00_r8,4.2000e+00_r8, & + &3.9469e+00_r8,4.0712e+00_r8,4.2520e-03_r8/) + kao(:, 4, 1, 8) = (/ & + &1.1228e+01_r8,9.8250e+00_r8,8.4220e+00_r8,7.0189e+00_r8,5.6159e+00_r8,4.2457e+00_r8, & + &4.0615e+00_r8,4.2140e+00_r8,1.1766e-02_r8/) + kao(:, 5, 1, 8) = (/ & + &1.1405e+01_r8,9.9798e+00_r8,8.5545e+00_r8,7.1289e+00_r8,5.7036e+00_r8,4.3747e+00_r8, & + &4.1857e+00_r8,4.3557e+00_r8,1.5766e-01_r8/) + kao(:, 1, 2, 8) = (/ & + &9.6985e+00_r8,8.4867e+00_r8,7.2748e+00_r8,6.0630e+00_r8,4.8511e+00_r8,3.9524e+00_r8, & + &3.9347e+00_r8,3.7679e+00_r8,7.6708e-02_r8/) + kao(:, 2, 2, 8) = (/ & + &9.4032e+00_r8,8.2283e+00_r8,7.0533e+00_r8,5.8784e+00_r8,4.7035e+00_r8,3.9843e+00_r8, & + &4.0089e+00_r8,3.9489e+00_r8,9.1596e-02_r8/) + kao(:, 3, 2, 8) = (/ & + &9.2359e+00_r8,8.0819e+00_r8,6.9278e+00_r8,5.7738e+00_r8,4.6198e+00_r8,4.0563e+00_r8, & + &4.1174e+00_r8,4.1185e+00_r8,7.3144e-02_r8/) + kao(:, 4, 2, 8) = (/ & + &9.2178e+00_r8,8.0660e+00_r8,6.9143e+00_r8,5.7625e+00_r8,4.6107e+00_r8,4.1515e+00_r8, & + &4.2394e+00_r8,4.2904e+00_r8,1.1674e-01_r8/) + kao(:, 5, 2, 8) = (/ & + &9.3781e+00_r8,8.2055e+00_r8,7.0329e+00_r8,5.8605e+00_r8,4.6883e+00_r8,4.2988e+00_r8, & + &4.3503e+00_r8,4.4505e+00_r8,1.2134e-01_r8/) + kao(:, 1, 3, 8) = (/ & + &8.1381e+00_r8,7.1213e+00_r8,6.1045e+00_r8,5.0877e+00_r8,4.0880e+00_r8,4.0519e+00_r8, & + &3.8139e+00_r8,3.6880e+00_r8,8.7204e-02_r8/) + kao(:, 2, 3, 8) = (/ & + &7.8478e+00_r8,6.8673e+00_r8,5.8868e+00_r8,4.9063e+00_r8,4.0625e+00_r8,4.0788e+00_r8, & + &3.9290e+00_r8,3.8689e+00_r8,6.5887e-02_r8/) + kao(:, 3, 3, 8) = (/ & + &7.6555e+00_r8,6.6990e+00_r8,5.7426e+00_r8,4.7861e+00_r8,4.0779e+00_r8,4.1101e+00_r8, & + &4.0765e+00_r8,4.0574e+00_r8,7.1216e-02_r8/) + kao(:, 4, 3, 8) = (/ & + &7.5783e+00_r8,6.6314e+00_r8,5.6846e+00_r8,4.7378e+00_r8,4.1353e+00_r8,4.1781e+00_r8, & + &4.2207e+00_r8,4.2405e+00_r8,8.4339e-02_r8/) + kao(:, 5, 3, 8) = (/ & + &7.6543e+00_r8,6.6980e+00_r8,5.7416e+00_r8,4.7853e+00_r8,4.2544e+00_r8,4.2669e+00_r8, & + &4.4018e+00_r8,4.4237e+00_r8,7.8612e-02_r8/) + kao(:, 1, 4, 8) = (/ & + &6.8589e+00_r8,6.0020e+00_r8,5.1451e+00_r8,4.2882e+00_r8,3.9706e+00_r8,3.8613e+00_r8, & + &3.5947e+00_r8,3.5300e+00_r8,6.1710e-02_r8/) + kao(:, 2, 4, 8) = (/ & + &6.5794e+00_r8,5.7574e+00_r8,4.9355e+00_r8,4.1135e+00_r8,3.9575e+00_r8,3.8878e+00_r8, & + &3.7477e+00_r8,3.7212e+00_r8,6.0817e-02_r8/) + kao(:, 3, 4, 8) = (/ & + &6.3760e+00_r8,5.5795e+00_r8,4.7829e+00_r8,3.9985e+00_r8,3.9783e+00_r8,3.9606e+00_r8, & + &3.9214e+00_r8,3.9164e+00_r8,6.3574e-02_r8/) + kao(:, 4, 4, 8) = (/ & + &6.2600e+00_r8,5.4779e+00_r8,4.6959e+00_r8,4.0045e+00_r8,4.0114e+00_r8,4.0769e+00_r8, & + &4.1164e+00_r8,4.1060e+00_r8,7.8132e-02_r8/) + kao(:, 5, 4, 8) = (/ & + &6.2608e+00_r8,5.4787e+00_r8,4.6966e+00_r8,4.0716e+00_r8,4.0797e+00_r8,4.1992e+00_r8, & + &4.3140e+00_r8,4.3043e+00_r8,7.5353e-02_r8/) + kao(:, 1, 5, 8) = (/ & + &5.7927e+00_r8,5.0691e+00_r8,4.3455e+00_r8,3.8105e+00_r8,3.8237e+00_r8,3.5526e+00_r8, & + &3.3728e+00_r8,3.3373e+00_r8,4.9756e-02_r8/) + kao(:, 2, 5, 8) = (/ & + &5.5277e+00_r8,4.8372e+00_r8,4.1467e+00_r8,3.7691e+00_r8,3.7793e+00_r8,3.6108e+00_r8, & + &3.5410e+00_r8,3.5220e+00_r8,4.2289e-02_r8/) + kao(:, 3, 5, 8) = (/ & + &5.3258e+00_r8,4.6606e+00_r8,3.9953e+00_r8,3.7485e+00_r8,3.7814e+00_r8,3.7044e+00_r8, & + &3.7302e+00_r8,3.7158e+00_r8,4.7217e-02_r8/) + kao(:, 4, 5, 8) = (/ & + &5.1933e+00_r8,4.5445e+00_r8,3.8958e+00_r8,3.7349e+00_r8,3.8276e+00_r8,3.8482e+00_r8, & + &3.9315e+00_r8,3.9070e+00_r8,5.2805e-02_r8/) + kao(:, 5, 5, 8) = (/ & + &5.1489e+00_r8,4.5057e+00_r8,3.8627e+00_r8,3.7753e+00_r8,3.9160e+00_r8,4.0236e+00_r8, & + &4.1558e+00_r8,4.1173e+00_r8,7.3119e-02_r8/) + kao(:, 1, 6, 8) = (/ & + &4.9153e+00_r8,4.3014e+00_r8,3.6874e+00_r8,3.6742e+00_r8,3.4664e+00_r8,3.2352e+00_r8, & + &3.1382e+00_r8,3.1290e+00_r8,5.3656e-02_r8/) + kao(:, 2, 6, 8) = (/ & + &4.6666e+00_r8,4.0837e+00_r8,3.5075e+00_r8,3.5947e+00_r8,3.4390e+00_r8,3.3186e+00_r8, & + &3.2995e+00_r8,3.2957e+00_r8,3.0716e-02_r8/) + kao(:, 3, 6, 8) = (/ & + &4.4714e+00_r8,3.9130e+00_r8,3.4299e+00_r8,3.5379e+00_r8,3.4620e+00_r8,3.4453e+00_r8, & + &3.4927e+00_r8,3.4789e+00_r8,2.2748e-02_r8/) + kao(:, 4, 6, 8) = (/ & + &4.3327e+00_r8,3.7916e+00_r8,3.3931e+00_r8,3.5287e+00_r8,3.5342e+00_r8,3.5995e+00_r8, & + &3.6934e+00_r8,3.6650e+00_r8,4.0419e-02_r8/) + kao(:, 5, 6, 8) = (/ & + &4.2621e+00_r8,3.7298e+00_r8,3.3976e+00_r8,3.5656e+00_r8,3.6513e+00_r8,3.7826e+00_r8, & + &3.9184e+00_r8,3.8666e+00_r8,1.0762e-01_r8/) + kao(:, 1, 7, 8) = (/ & + &4.2315e+00_r8,3.7030e+00_r8,3.3451e+00_r8,3.3493e+00_r8,3.1177e+00_r8,2.9742e+00_r8, & + &2.9072e+00_r8,2.9068e+00_r8,5.8460e-02_r8/) + kao(:, 2, 7, 8) = (/ & + &3.9985e+00_r8,3.4984e+00_r8,3.2669e+00_r8,3.2554e+00_r8,3.1149e+00_r8,3.0526e+00_r8, & + &3.0595e+00_r8,3.0700e+00_r8,2.7402e-02_r8/) + kao(:, 3, 7, 8) = (/ & + &3.8099e+00_r8,3.3338e+00_r8,3.2097e+00_r8,3.2104e+00_r8,3.1587e+00_r8,3.1808e+00_r8, & + &3.2348e+00_r8,3.2401e+00_r8,1.9004e-02_r8/) + kao(:, 4, 7, 8) = (/ & + &3.6700e+00_r8,3.2116e+00_r8,3.1648e+00_r8,3.2052e+00_r8,3.2433e+00_r8,3.3349e+00_r8, & + &3.4286e+00_r8,3.4160e+00_r8,4.2481e-02_r8/) + kao(:, 5, 7, 8) = (/ & + &3.5860e+00_r8,3.1383e+00_r8,3.1473e+00_r8,3.2492e+00_r8,3.3786e+00_r8,3.5157e+00_r8, & + &3.6429e+00_r8,3.6020e+00_r8,1.5676e-01_r8/) + kao(:, 1, 8, 8) = (/ & + &3.7309e+00_r8,3.2652e+00_r8,3.2085e+00_r8,3.0458e+00_r8,2.8667e+00_r8,2.7650e+00_r8, & + &2.6802e+00_r8,2.6374e+00_r8,6.7482e-02_r8/) + kao(:, 2, 8, 8) = (/ & + &3.5088e+00_r8,3.0710e+00_r8,3.0883e+00_r8,2.9531e+00_r8,2.8706e+00_r8,2.8363e+00_r8, & + &2.8330e+00_r8,2.8092e+00_r8,3.1671e-02_r8/) + kao(:, 3, 8, 8) = (/ & + &3.3283e+00_r8,2.9131e+00_r8,2.9801e+00_r8,2.9151e+00_r8,2.9077e+00_r8,2.9395e+00_r8, & + &2.9913e+00_r8,2.9792e+00_r8,1.9457e-02_r8/) + kao(:, 4, 8, 8) = (/ & + &3.1890e+00_r8,2.7912e+00_r8,2.9223e+00_r8,2.9235e+00_r8,2.9935e+00_r8,3.0761e+00_r8, & + &3.1767e+00_r8,3.1591e+00_r8,4.5502e-02_r8/) + kao(:, 5, 8, 8) = (/ & + &3.0966e+00_r8,2.7276e+00_r8,2.9000e+00_r8,2.9842e+00_r8,3.1139e+00_r8,3.2433e+00_r8, & + &3.3703e+00_r8,3.3444e+00_r8,1.7959e-01_r8/) + kao(:, 1, 9, 8) = (/ & + &3.2795e+00_r8,2.8728e+00_r8,2.9171e+00_r8,2.7516e+00_r8,2.6513e+00_r8,2.5188e+00_r8, & + &2.4080e+00_r8,2.3392e+00_r8,6.9869e-02_r8/) + kao(:, 2, 9, 8) = (/ & + &3.0734e+00_r8,2.7076e+00_r8,2.7821e+00_r8,2.6844e+00_r8,2.6368e+00_r8,2.5852e+00_r8, & + &2.5517e+00_r8,2.5045e+00_r8,4.1359e-02_r8/) + kao(:, 3, 9, 8) = (/ & + &2.9006e+00_r8,2.6099e+00_r8,2.6833e+00_r8,2.6568e+00_r8,2.6662e+00_r8,2.6837e+00_r8, & + &2.7125e+00_r8,2.6712e+00_r8,2.1538e-02_r8/) + kao(:, 4, 9, 8) = (/ & + &2.7639e+00_r8,2.5377e+00_r8,2.6242e+00_r8,2.6595e+00_r8,2.7323e+00_r8,2.8096e+00_r8, & + &2.8901e+00_r8,2.8466e+00_r8,5.4396e-02_r8/) + kao(:, 5, 9, 8) = (/ & + &2.6669e+00_r8,2.4856e+00_r8,2.6031e+00_r8,2.7098e+00_r8,2.8344e+00_r8,2.9696e+00_r8, & + &3.0834e+00_r8,3.0331e+00_r8,2.0077e-01_r8/) + kao(:, 1,10, 8) = (/ & + &2.8722e+00_r8,2.6105e+00_r8,2.6085e+00_r8,2.5091e+00_r8,2.4056e+00_r8,2.2547e+00_r8, & + &2.1348e+00_r8,2.0413e+00_r8,7.1950e-02_r8/) + kao(:, 2,10, 8) = (/ & + &2.6764e+00_r8,2.5038e+00_r8,2.4795e+00_r8,2.4482e+00_r8,2.3806e+00_r8,2.3128e+00_r8, & + &2.2556e+00_r8,2.1912e+00_r8,3.7979e-02_r8/) + kao(:, 3,10, 8) = (/ & + &2.5139e+00_r8,2.4083e+00_r8,2.3949e+00_r8,2.4105e+00_r8,2.4135e+00_r8,2.4077e+00_r8, & + &2.4119e+00_r8,2.3558e+00_r8,2.2438e-02_r8/) + kao(:, 4,10, 8) = (/ & + &2.3840e+00_r8,2.3185e+00_r8,2.3481e+00_r8,2.4127e+00_r8,2.4770e+00_r8,2.5357e+00_r8, & + &2.5771e+00_r8,2.5231e+00_r8,7.0033e-02_r8/) + kao(:, 5,10, 8) = (/ & + &2.2922e+00_r8,2.2525e+00_r8,2.3358e+00_r8,2.4514e+00_r8,2.5719e+00_r8,2.6836e+00_r8, & + &2.7691e+00_r8,2.7055e+00_r8,2.1431e-01_r8/) + kao(:, 1,11, 8) = (/ & + &2.4203e+00_r8,2.3366e+00_r8,2.2726e+00_r8,2.2388e+00_r8,2.1243e+00_r8,2.0012e+00_r8, & + &1.8959e+00_r8,1.8076e+00_r8,5.5769e-02_r8/) + kao(:, 2,11, 8) = (/ & + &2.2551e+00_r8,2.2021e+00_r8,2.1879e+00_r8,2.1841e+00_r8,2.1218e+00_r8,2.0691e+00_r8, & + &2.0223e+00_r8,1.9543e+00_r8,2.8668e-02_r8/) + kao(:, 3,11, 8) = (/ & + &2.1166e+00_r8,2.0926e+00_r8,2.1229e+00_r8,2.1590e+00_r8,2.1592e+00_r8,2.1682e+00_r8, & + &2.1642e+00_r8,2.1075e+00_r8,3.1850e-02_r8/) + kao(:, 4,11, 8) = (/ & + &2.0122e+00_r8,2.0159e+00_r8,2.0901e+00_r8,2.1693e+00_r8,2.2337e+00_r8,2.2891e+00_r8, & + &2.3331e+00_r8,2.2748e+00_r8,1.4071e-01_r8/) + kao(:, 5,11, 8) = (/ & + &1.9514e+00_r8,1.9763e+00_r8,2.0989e+00_r8,2.2225e+00_r8,2.3388e+00_r8,2.4447e+00_r8, & + &2.5215e+00_r8,2.4588e+00_r8,2.8723e-01_r8/) + kao(:, 1,12, 8) = (/ & + &2.0683e+00_r8,2.0370e+00_r8,2.0375e+00_r8,1.9798e+00_r8,1.8792e+00_r8,1.7675e+00_r8, & + &1.6700e+00_r8,1.5868e+00_r8,4.4568e-02_r8/) + kao(:, 2,12, 8) = (/ & + &1.9287e+00_r8,1.9214e+00_r8,1.9599e+00_r8,1.9353e+00_r8,1.8869e+00_r8,1.8278e+00_r8, & + &1.7894e+00_r8,1.7244e+00_r8,2.3573e-02_r8/) + kao(:, 3,12, 8) = (/ & + &1.8200e+00_r8,1.8347e+00_r8,1.9076e+00_r8,1.9217e+00_r8,1.9295e+00_r8,1.9250e+00_r8, & + &1.9263e+00_r8,1.8738e+00_r8,5.2475e-02_r8/) + kao(:, 4,12, 8) = (/ & + &1.7432e+00_r8,1.7845e+00_r8,1.8845e+00_r8,1.9488e+00_r8,2.0009e+00_r8,2.0498e+00_r8, & + &2.0942e+00_r8,2.0382e+00_r8,1.8765e-01_r8/) + kao(:, 5,12, 8) = (/ & + &1.7053e+00_r8,1.7760e+00_r8,1.9065e+00_r8,2.0215e+00_r8,2.1153e+00_r8,2.2054e+00_r8, & + &2.2781e+00_r8,2.2210e+00_r8,3.6587e-01_r8/) + kao(:, 1,13, 8) = (/ & + &1.8562e+00_r8,1.8459e+00_r8,1.8637e+00_r8,1.7957e+00_r8,1.6878e+00_r8,1.5797e+00_r8, & + &1.4757e+00_r8,1.3906e+00_r8,3.6132e-02_r8/) + kao(:, 2,13, 8) = (/ & + &1.7399e+00_r8,1.7611e+00_r8,1.7971e+00_r8,1.7529e+00_r8,1.6955e+00_r8,1.6354e+00_r8, & + &1.5829e+00_r8,1.5250e+00_r8,2.1418e-02_r8/) + kao(:, 3,13, 8) = (/ & + &1.6467e+00_r8,1.6945e+00_r8,1.7550e+00_r8,1.7487e+00_r8,1.7380e+00_r8,1.7251e+00_r8, & + &1.7178e+00_r8,1.6689e+00_r8,6.4309e-02_r8/) + kao(:, 4,13, 8) = (/ & + &1.5930e+00_r8,1.6654e+00_r8,1.7520e+00_r8,1.7797e+00_r8,1.8113e+00_r8,1.8460e+00_r8, & + &1.8831e+00_r8,1.8288e+00_r8,2.0946e-01_r8/) + kao(:, 5,13, 8) = (/ & + &1.5695e+00_r8,1.6755e+00_r8,1.7906e+00_r8,1.8612e+00_r8,1.9314e+00_r8,2.0101e+00_r8, & + &2.0671e+00_r8,2.0074e+00_r8,3.8278e-01_r8/) + kao(:, 1, 1, 9) = (/ & + &4.3448e+02_r8,3.8017e+02_r8,3.2586e+02_r8,2.7155e+02_r8,2.1724e+02_r8,1.6293e+02_r8, & + &1.0862e+02_r8,5.5107e+01_r8,2.7465e-03_r8/) + kao(:, 2, 1, 9) = (/ & + &5.8321e+02_r8,5.1031e+02_r8,4.3741e+02_r8,3.6451e+02_r8,2.9161e+02_r8,2.1870e+02_r8, & + &1.4580e+02_r8,7.3550e+01_r8,3.5822e-03_r8/) + kao(:, 3, 1, 9) = (/ & + &7.6101e+02_r8,6.6588e+02_r8,5.7076e+02_r8,4.7563e+02_r8,3.8051e+02_r8,2.8538e+02_r8, & + &1.9025e+02_r8,9.5593e+01_r8,5.6366e-03_r8/) + kao(:, 4, 1, 9) = (/ & + &9.6683e+02_r8,8.4598e+02_r8,7.2512e+02_r8,6.0427e+02_r8,4.8342e+02_r8,3.6256e+02_r8, & + &2.4171e+02_r8,1.2116e+02_r8,6.3697e-02_r8/) + kao(:, 5, 1, 9) = (/ & + &1.1977e+03_r8,1.0480e+03_r8,8.9827e+02_r8,7.4856e+02_r8,5.9885e+02_r8,4.4914e+02_r8, & + &2.9942e+02_r8,1.4986e+02_r8,2.8050e-01_r8/) + kao(:, 1, 2, 9) = (/ & + &3.3233e+02_r8,2.9079e+02_r8,2.4925e+02_r8,2.0770e+02_r8,1.6616e+02_r8,1.2462e+02_r8, & + &8.3297e+01_r8,4.3020e+01_r8,1.2769e-02_r8/) + kao(:, 2, 2, 9) = (/ & + &4.5139e+02_r8,3.9497e+02_r8,3.3854e+02_r8,2.8212e+02_r8,2.2570e+02_r8,1.6927e+02_r8, & + &1.1303e+02_r8,5.7664e+01_r8,6.8183e-02_r8/) + kao(:, 3, 2, 9) = (/ & + &5.9515e+02_r8,5.2076e+02_r8,4.4637e+02_r8,3.7197e+02_r8,2.9758e+02_r8,2.2318e+02_r8, & + &1.4890e+02_r8,7.5394e+01_r8,1.7070e-01_r8/) + kao(:, 4, 2, 9) = (/ & + &7.6179e+02_r8,6.6657e+02_r8,5.7134e+02_r8,4.7612e+02_r8,3.8090e+02_r8,2.8567e+02_r8, & + &1.9048e+02_r8,9.5968e+01_r8,4.9948e-01_r8/) + kao(:, 5, 2, 9) = (/ & + &9.5206e+02_r8,8.3305e+02_r8,7.1404e+02_r8,5.9504e+02_r8,4.7603e+02_r8,3.5702e+02_r8, & + &2.3802e+02_r8,1.1952e+02_r8,1.1527e+00_r8/) + kao(:, 1, 3, 9) = (/ & + &2.3507e+02_r8,2.0568e+02_r8,1.7630e+02_r8,1.4692e+02_r8,1.1753e+02_r8,8.8151e+01_r8, & + &5.9624e+01_r8,3.1706e+01_r8,5.0754e-02_r8/) + kao(:, 2, 3, 9) = (/ & + &3.2531e+02_r8,2.8465e+02_r8,2.4398e+02_r8,2.0332e+02_r8,1.6266e+02_r8,1.2199e+02_r8, & + &8.2067e+01_r8,4.2715e+01_r8,9.9945e-02_r8/) + kao(:, 3, 3, 9) = (/ & + &4.3545e+02_r8,3.8102e+02_r8,3.2659e+02_r8,2.7216e+02_r8,2.1773e+02_r8,1.6330e+02_r8, & + &1.0943e+02_r8,5.6175e+01_r8,4.3033e-01_r8/) + kao(:, 4, 3, 9) = (/ & + &5.6623e+02_r8,4.9545e+02_r8,4.2468e+02_r8,3.5390e+02_r8,2.8312e+02_r8,2.1234e+02_r8, & + &1.4196e+02_r8,7.2208e+01_r8,1.0055e+00_r8/) + kao(:, 5, 3, 9) = (/ & + &7.1637e+02_r8,6.2682e+02_r8,5.3728e+02_r8,4.4773e+02_r8,3.5819e+02_r8,2.6864e+02_r8, & + &1.7932e+02_r8,9.0659e+01_r8,1.5764e+00_r8/) + kao(:, 1, 4, 9) = (/ & + &1.6080e+02_r8,1.4070e+02_r8,1.2060e+02_r8,1.0050e+02_r8,8.0399e+01_r8,6.0779e+01_r8, & + &4.1842e+01_r8,2.3410e+01_r8,9.5747e-02_r8/) + kao(:, 2, 4, 9) = (/ & + &2.2661e+02_r8,1.9829e+02_r8,1.6996e+02_r8,1.4163e+02_r8,1.1331e+02_r8,8.5452e+01_r8, & + &5.8120e+01_r8,3.1330e+01_r8,8.2203e-01_r8/) + kao(:, 3, 4, 9) = (/ & + &3.0940e+02_r8,2.7072e+02_r8,2.3205e+02_r8,1.9338e+02_r8,1.5470e+02_r8,1.1642e+02_r8, & + &7.8610e+01_r8,4.1331e+01_r8,1.4967e+00_r8/) + kao(:, 4, 4, 9) = (/ & + &4.0889e+02_r8,3.5778e+02_r8,3.0667e+02_r8,2.5556e+02_r8,2.0445e+02_r8,1.5361e+02_r8, & + &1.0323e+02_r8,5.3416e+01_r8,2.0722e+00_r8/) + kao(:, 5, 4, 9) = (/ & + &5.2581e+02_r8,4.6008e+02_r8,3.9436e+02_r8,3.2863e+02_r8,2.6291e+02_r8,1.9734e+02_r8, & + &1.3221e+02_r8,6.7657e+01_r8,2.6260e+00_r8/) + kao(:, 1, 5, 9) = (/ & + &1.0850e+02_r8,9.4934e+01_r8,8.1372e+01_r8,6.7810e+01_r8,5.4459e+01_r8,4.1884e+01_r8, & + &2.9671e+01_r8,1.7923e+01_r8,1.1913e+00_r8/) + kao(:, 2, 5, 9) = (/ & + &1.5572e+02_r8,1.3625e+02_r8,1.1679e+02_r8,9.7324e+01_r8,7.8121e+01_r8,5.9526e+01_r8, & + &4.1277e+01_r8,2.3510e+01_r8,1.9137e+00_r8/) + kao(:, 3, 5, 9) = (/ & + &2.1676e+02_r8,1.8967e+02_r8,1.6257e+02_r8,1.3548e+02_r8,1.0864e+02_r8,8.2293e+01_r8, & + &5.6282e+01_r8,3.0781e+01_r8,2.5565e+00_r8/) + kao(:, 4, 5, 9) = (/ & + &2.9183e+02_r8,2.5535e+02_r8,2.1887e+02_r8,1.8239e+02_r8,1.4612e+02_r8,1.1027e+02_r8, & + &7.4761e+01_r8,3.9788e+01_r8,3.1260e+00_r8/) + kao(:, 5, 5, 9) = (/ & + &3.8115e+02_r8,3.3351e+02_r8,2.8587e+02_r8,2.3822e+02_r8,1.9070e+02_r8,1.4356e+02_r8, & + &9.6772e+01_r8,5.0545e+01_r8,3.5402e+00_r8/) + kao(:, 1, 6, 9) = (/ & + &7.1661e+01_r8,6.2704e+01_r8,5.3746e+01_r8,4.4797e+01_r8,3.6644e+01_r8,2.8875e+01_r8, & + &2.1420e+01_r8,1.4378e+01_r8,2.0773e+00_r8/) + kao(:, 2, 6, 9) = (/ & + &1.0465e+02_r8,9.1565e+01_r8,7.8484e+01_r8,6.5455e+01_r8,5.3153e+01_r8,4.1163e+01_r8, & + &2.9464e+01_r8,1.8199e+01_r8,2.7911e+00_r8/) + kao(:, 3, 6, 9) = (/ & + &1.4858e+02_r8,1.3001e+02_r8,1.1144e+02_r8,9.2961e+01_r8,7.5079e+01_r8,5.7480e+01_r8, & + &4.0178e+01_r8,2.3340e+01_r8,3.3860e+00_r8/) + kao(:, 4, 6, 9) = (/ & + &2.0400e+02_r8,1.7850e+02_r8,1.5300e+02_r8,1.2759e+02_r8,1.0268e+02_r8,7.8054e+01_r8, & + &5.3729e+01_r8,2.9889e+01_r8,3.8146e+00_r8/) + kao(:, 5, 6, 9) = (/ & + &2.7127e+02_r8,2.3736e+02_r8,2.0345e+02_r8,1.6959e+02_r8,1.3617e+02_r8,1.0303e+02_r8, & + &7.0191e+01_r8,3.7883e+01_r8,4.1027e+00_r8/) + kao(:, 1, 7, 9) = (/ & + &4.7664e+01_r8,4.1706e+01_r8,3.5748e+01_r8,3.0192e+01_r8,2.5283e+01_r8,2.0687e+01_r8, & + &1.6356e+01_r8,1.2414e+01_r8,2.7141e+00_r8/) + kao(:, 2, 7, 9) = (/ & + &7.0406e+01_r8,6.1605e+01_r8,5.2805e+01_r8,4.4485e+01_r8,3.6675e+01_r8,2.9135e+01_r8, & + &2.1846e+01_r8,1.4960e+01_r8,3.3740e+00_r8/) + kao(:, 3, 7, 9) = (/ & + &1.0189e+02_r8,8.9150e+01_r8,7.6414e+01_r8,6.4182e+01_r8,5.2360e+01_r8,4.0780e+01_r8, & + &2.9464e+01_r8,1.8559e+01_r8,3.8705e+00_r8/) + kao(:, 4, 7, 9) = (/ & + &1.4268e+02_r8,1.2484e+02_r8,1.0701e+02_r8,8.9652e+01_r8,7.2635e+01_r8,5.5858e+01_r8, & + &3.9357e+01_r8,2.3287e+01_r8,4.2268e+00_r8/) + kao(:, 5, 7, 9) = (/ & + &1.9337e+02_r8,1.6920e+02_r8,1.4503e+02_r8,1.2126e+02_r8,9.7796e+01_r8,7.4601e+01_r8, & + &5.1680e+01_r8,2.9228e+01_r8,4.3853e+00_r8/) + kao(:, 1, 8, 9) = (/ & + &3.2619e+01_r8,2.8542e+01_r8,2.4489e+01_r8,2.1251e+01_r8,1.8391e+01_r8,1.5792e+01_r8, & + &1.3493e+01_r8,1.1316e+01_r8,3.0747e+00_r8/) + kao(:, 2, 8, 9) = (/ & + &4.8375e+01_r8,4.2328e+01_r8,3.6375e+01_r8,3.1177e+01_r8,2.6286e+01_r8,2.1635e+01_r8, & + &1.7234e+01_r8,1.3233e+01_r8,3.6551e+00_r8/) + kao(:, 3, 8, 9) = (/ & + &7.1088e+01_r8,6.2202e+01_r8,5.3468e+01_r8,4.5389e+01_r8,3.7595e+01_r8,3.0015e+01_r8, & + &2.2675e+01_r8,1.5741e+01_r8,4.0898e+00_r8/) + kao(:, 4, 8, 9) = (/ & + &1.0151e+02_r8,8.8821e+01_r8,7.6303e+01_r8,6.4370e+01_r8,5.2682e+01_r8,4.1218e+01_r8, & + &2.9982e+01_r8,1.9170e+01_r8,4.3948e+00_r8/) + kao(:, 5, 8, 9) = (/ & + &1.4013e+02_r8,1.2261e+02_r8,1.0526e+02_r8,8.8413e+01_r8,7.1810e+01_r8,5.5432e+01_r8, & + &3.9307e+01_r8,2.3602e+01_r8,4.4795e+00_r8/) + kao(:, 1, 9, 9) = (/ & + &2.2374e+01_r8,1.9574e+01_r8,1.7087e+01_r8,1.5322e+01_r8,1.3873e+01_r8,1.2730e+01_r8, & + &1.1784e+01_r8,1.0057e+01_r8,3.2920e+00_r8/) + kao(:, 2, 9, 9) = (/ & + &3.3006e+01_r8,2.8880e+01_r8,2.5155e+01_r8,2.2057e+01_r8,1.9232e+01_r8,1.6658e+01_r8, & + &1.4329e+01_r8,1.1850e+01_r8,3.8043e+00_r8/) + kao(:, 3, 9, 9) = (/ & + &4.8965e+01_r8,4.2845e+01_r8,3.7181e+01_r8,3.2051e+01_r8,2.7172e+01_r8,2.2508e+01_r8, & + &1.8078e+01_r8,1.3961e+01_r8,4.2059e+00_r8/) + kao(:, 4, 9, 9) = (/ & + &7.1218e+01_r8,6.2316e+01_r8,5.3886e+01_r8,4.5928e+01_r8,3.8193e+01_r8,3.0649e+01_r8, & + &2.3347e+01_r8,1.6446e+01_r8,4.4539e+00_r8/) + kao(:, 5, 9, 9) = (/ & + &1.0013e+02_r8,8.7618e+01_r8,7.5558e+01_r8,6.3912e+01_r8,5.2481e+01_r8,4.1239e+01_r8, & + &3.0241e+01_r8,1.9662e+01_r8,4.4837e+00_r8/) + kao(:, 1,10, 9) = (/ & + &1.6016e+01_r8,1.4014e+01_r8,1.2654e+01_r8,1.1832e+01_r8,1.1333e+01_r8,1.1079e+01_r8, & + &1.0430e+01_r8,8.9198e+00_r8,3.4165e+00_r8/) + kao(:, 2,10, 9) = (/ & + &2.3316e+01_r8,2.0402e+01_r8,1.8216e+01_r8,1.6474e+01_r8,1.5033e+01_r8,1.3817e+01_r8, & + &1.2667e+01_r8,1.0521e+01_r8,3.8593e+00_r8/) + kao(:, 3,10, 9) = (/ & + &3.4676e+01_r8,3.0345e+01_r8,2.6796e+01_r8,2.3607e+01_r8,2.0669e+01_r8,1.7940e+01_r8, & + &1.5414e+01_r8,1.2426e+01_r8,4.1980e+00_r8/) + kao(:, 4,10, 9) = (/ & + &5.1075e+01_r8,4.4715e+01_r8,3.9109e+01_r8,3.3826e+01_r8,2.8757e+01_r8,2.3883e+01_r8, & + &1.9235e+01_r8,1.4676e+01_r8,4.3830e+00_r8/) + kao(:, 5,10, 9) = (/ & + &7.2971e+01_r8,6.3894e+01_r8,5.5508e+01_r8,4.7426e+01_r8,3.9536e+01_r8,3.1844e+01_r8, & + &2.4374e+01_r8,1.7279e+01_r8,4.3810e+00_r8/) + kao(:, 1,11, 9) = (/ & + &1.3577e+01_r8,1.1946e+01_r8,1.1209e+01_r8,1.0837e+01_r8,1.0794e+01_r8,1.0607e+01_r8, & + &9.9046e+00_r8,8.4158e+00_r8,3.5771e+00_r8/) + kao(:, 2,11, 9) = (/ & + &1.9792e+01_r8,1.7445e+01_r8,1.5940e+01_r8,1.4785e+01_r8,1.3920e+01_r8,1.3199e+01_r8, & + &1.2097e+01_r8,9.9522e+00_r8,3.9185e+00_r8/) + kao(:, 3,11, 9) = (/ & + &2.9476e+01_r8,2.5957e+01_r8,2.3237e+01_r8,2.0843e+01_r8,1.8688e+01_r8,1.6684e+01_r8, & + &1.4791e+01_r8,1.1766e+01_r8,4.1553e+00_r8/) + kao(:, 4,11, 9) = (/ & + &4.3413e+01_r8,3.8176e+01_r8,3.3695e+01_r8,2.9502e+01_r8,2.5515e+01_r8,2.1698e+01_r8, & + &1.8077e+01_r8,1.3908e+01_r8,4.1942e+00_r8/) + kao(:, 5,11, 9) = (/ & + &6.2007e+01_r8,5.4458e+01_r8,4.7606e+01_r8,4.1020e+01_r8,3.4622e+01_r8,2.8398e+01_r8, & + &2.2392e+01_r8,1.6392e+01_r8,4.1692e+00_r8/) + kao(:, 1,12, 9) = (/ & + &1.1680e+01_r8,1.0479e+01_r8,1.0122e+01_r8,1.0167e+01_r8,1.0289e+01_r8,1.0072e+01_r8, & + &9.3417e+00_r8,7.9079e+00_r8,3.5200e+00_r8/) + kao(:, 2,12, 9) = (/ & + &1.7053e+01_r8,1.5231e+01_r8,1.4215e+01_r8,1.3566e+01_r8,1.3123e+01_r8,1.2618e+01_r8, & + &1.1431e+01_r8,9.3416e+00_r8,3.7828e+00_r8/) + kao(:, 3,12, 9) = (/ & + &2.5404e+01_r8,2.2573e+01_r8,2.0511e+01_r8,1.8777e+01_r8,1.7216e+01_r8,1.5812e+01_r8, & + &1.4031e+01_r8,1.1064e+01_r8,3.9374e+00_r8/) + kao(:, 4,12, 9) = (/ & + &3.7431e+01_r8,3.3112e+01_r8,2.9529e+01_r8,2.6224e+01_r8,2.3088e+01_r8,2.0100e+01_r8, & + &1.7184e+01_r8,1.3093e+01_r8,3.9253e+00_r8/) + kao(:, 5,12, 9) = (/ & + &5.3474e+01_r8,4.7145e+01_r8,4.1510e+01_r8,3.6119e+01_r8,3.0908e+01_r8,2.5843e+01_r8, & + &2.0970e+01_r8,1.5444e+01_r8,3.9004e+00_r8/) + kao(:, 1,13, 9) = (/ & + &1.0438e+01_r8,9.5597e+00_r8,9.5087e+00_r8,9.7911e+00_r8,9.8820e+00_r8,9.5875e+00_r8, & + &8.8692e+00_r8,7.4811e+00_r8,3.3069e+00_r8/) + kao(:, 2,13, 9) = (/ & + &1.5260e+01_r8,1.3818e+01_r8,1.3178e+01_r8,1.2874e+01_r8,1.2679e+01_r8,1.2091e+01_r8, & + &1.0875e+01_r8,8.8312e+00_r8,3.5228e+00_r8/) + kao(:, 3,13, 9) = (/ & + &2.2789e+01_r8,2.0434e+01_r8,1.8837e+01_r8,1.7547e+01_r8,1.6403e+01_r8,1.5263e+01_r8, & + &1.3389e+01_r8,1.0463e+01_r8,3.6351e+00_r8/) + kao(:, 4,13, 9) = (/ & + &3.3586e+01_r8,2.9891e+01_r8,2.6912e+01_r8,2.4218e+01_r8,2.1653e+01_r8,1.9218e+01_r8, & + &1.6457e+01_r8,1.2402e+01_r8,3.6180e+00_r8/) + kao(:, 5,13, 9) = (/ & + &4.7989e+01_r8,4.2477e+01_r8,3.7650e+01_r8,3.3082e+01_r8,2.8647e+01_r8,2.4351e+01_r8, & + &2.0129e+01_r8,1.4659e+01_r8,3.6174e+00_r8/) + kao(:, 1, 1,10) = (/ & + &2.6405e+03_r8,2.3104e+03_r8,1.9803e+03_r8,1.6503e+03_r8,1.3202e+03_r8,9.9017e+02_r8, & + &6.6011e+02_r8,3.3006e+02_r8,2.0071e-03_r8/) + kao(:, 2, 1,10) = (/ & + &3.3430e+03_r8,2.9251e+03_r8,2.5072e+03_r8,2.0894e+03_r8,1.6715e+03_r8,1.2536e+03_r8, & + &8.3575e+02_r8,4.1787e+02_r8,3.1756e-03_r8/) + kao(:, 3, 1,10) = (/ & + &4.1007e+03_r8,3.5881e+03_r8,3.0756e+03_r8,2.5630e+03_r8,2.0504e+03_r8,1.5378e+03_r8, & + &1.0252e+03_r8,5.1259e+02_r8,1.5257e-02_r8/) + kao(:, 4, 1,10) = (/ & + &4.9110e+03_r8,4.2972e+03_r8,3.6833e+03_r8,3.0694e+03_r8,2.4555e+03_r8,1.8416e+03_r8, & + &1.2278e+03_r8,6.1388e+02_r8,1.9623e-01_r8/) + kao(:, 5, 1,10) = (/ & + &5.7642e+03_r8,5.0437e+03_r8,4.3232e+03_r8,3.6026e+03_r8,2.8821e+03_r8,2.1616e+03_r8, & + &1.4411e+03_r8,7.2053e+02_r8,3.1630e-01_r8/) + kao(:, 1, 2,10) = (/ & + &2.0643e+03_r8,1.8062e+03_r8,1.5482e+03_r8,1.2902e+03_r8,1.0321e+03_r8,7.7410e+02_r8, & + &5.1607e+02_r8,2.5804e+02_r8,7.9610e-02_r8/) + kao(:, 2, 2,10) = (/ & + &2.6419e+03_r8,2.3117e+03_r8,1.9815e+03_r8,1.6512e+03_r8,1.3210e+03_r8,9.9073e+02_r8, & + &6.6049e+02_r8,3.3024e+02_r8,3.1756e-01_r8/) + kao(:, 3, 2,10) = (/ & + &3.2679e+03_r8,2.8594e+03_r8,2.4509e+03_r8,2.0424e+03_r8,1.6340e+03_r8,1.2255e+03_r8, & + &8.1698e+02_r8,4.0849e+02_r8,1.6019e+00_r8/) + kao(:, 4, 2,10) = (/ & + &3.9535e+03_r8,3.4593e+03_r8,2.9652e+03_r8,2.4710e+03_r8,1.9768e+03_r8,1.4826e+03_r8, & + &9.8838e+02_r8,4.9419e+02_r8,2.9545e+00_r8/) + kao(:, 5, 2,10) = (/ & + &4.6801e+03_r8,4.0951e+03_r8,3.5101e+03_r8,2.9251e+03_r8,2.3401e+03_r8,1.7551e+03_r8, & + &1.1700e+03_r8,5.8502e+02_r8,4.1449e+00_r8/) + kao(:, 1, 3,10) = (/ & + &1.5076e+03_r8,1.3191e+03_r8,1.1307e+03_r8,9.4224e+02_r8,7.5379e+02_r8,5.6534e+02_r8, & + &3.7689e+02_r8,1.8845e+02_r8,5.0945e-01_r8/) + kao(:, 2, 3,10) = (/ & + &1.9623e+03_r8,1.7170e+03_r8,1.4718e+03_r8,1.2265e+03_r8,9.8117e+02_r8,7.3588e+02_r8, & + &4.9059e+02_r8,2.4529e+02_r8,2.4679e+00_r8/) + kao(:, 3, 3,10) = (/ & + &2.4731e+03_r8,2.1640e+03_r8,1.8549e+03_r8,1.5457e+03_r8,1.2366e+03_r8,9.2743e+02_r8, & + &6.1829e+02_r8,3.0914e+02_r8,5.8082e+00_r8/) + kao(:, 4, 3,10) = (/ & + &3.0330e+03_r8,2.6538e+03_r8,2.2747e+03_r8,1.8956e+03_r8,1.5165e+03_r8,1.1374e+03_r8, & + &7.5824e+02_r8,3.7912e+02_r8,6.6677e+00_r8/) + kao(:, 5, 3,10) = (/ & + &3.6345e+03_r8,3.1802e+03_r8,2.7259e+03_r8,2.2715e+03_r8,1.8172e+03_r8,1.3629e+03_r8, & + &9.0862e+02_r8,4.5431e+02_r8,6.6949e+00_r8/) + kao(:, 1, 4,10) = (/ & + &1.0627e+03_r8,9.2986e+02_r8,7.9702e+02_r8,6.6419e+02_r8,5.3135e+02_r8,3.9851e+02_r8, & + &2.6568e+02_r8,1.3284e+02_r8,8.6599e+00_r8/) + kao(:, 2, 4,10) = (/ & + &1.4166e+03_r8,1.2395e+03_r8,1.0624e+03_r8,8.8537e+02_r8,7.0829e+02_r8,5.3122e+02_r8, & + &3.5415e+02_r8,1.7707e+02_r8,9.4746e+00_r8/) + kao(:, 3, 4,10) = (/ & + &1.8198e+03_r8,1.5923e+03_r8,1.3648e+03_r8,1.1374e+03_r8,9.0989e+02_r8,6.8241e+02_r8, & + &4.5494e+02_r8,2.2747e+02_r8,9.4272e+00_r8/) + kao(:, 4, 4,10) = (/ & + &2.2704e+03_r8,1.9866e+03_r8,1.7028e+03_r8,1.4190e+03_r8,1.1352e+03_r8,8.5140e+02_r8, & + &5.6760e+02_r8,2.8380e+02_r8,9.3833e+00_r8/) + kao(:, 5, 4,10) = (/ & + &2.7615e+03_r8,2.4164e+03_r8,2.0712e+03_r8,1.7260e+03_r8,1.3808e+03_r8,1.0356e+03_r8, & + &6.9039e+02_r8,3.4519e+02_r8,9.3214e+00_r8/) + kao(:, 1, 5,10) = (/ & + &7.3556e+02_r8,6.4362e+02_r8,5.5167e+02_r8,4.5973e+02_r8,3.6778e+02_r8,2.7584e+02_r8, & + &1.8389e+02_r8,9.1946e+01_r8,1.0345e+01_r8/) + kao(:, 2, 5,10) = (/ & + &1.0082e+03_r8,8.8219e+02_r8,7.5616e+02_r8,6.3013e+02_r8,5.0411e+02_r8,3.7808e+02_r8, & + &2.5205e+02_r8,1.2603e+02_r8,1.0318e+01_r8/) + kao(:, 3, 5,10) = (/ & + &1.3203e+03_r8,1.1552e+03_r8,9.9020e+02_r8,8.2516e+02_r8,6.6013e+02_r8,4.9510e+02_r8, & + &3.3007e+02_r8,1.6503e+02_r8,1.0269e+01_r8/) + kao(:, 4, 5,10) = (/ & + &1.6790e+03_r8,1.4691e+03_r8,1.2593e+03_r8,1.0494e+03_r8,8.3951e+02_r8,6.2963e+02_r8, & + &4.1976e+02_r8,2.0988e+02_r8,1.0211e+01_r8/) + kao(:, 5, 5,10) = (/ & + &2.0720e+03_r8,1.8130e+03_r8,1.5540e+03_r8,1.2950e+03_r8,1.0360e+03_r8,7.7699e+02_r8, & + &5.1799e+02_r8,2.5900e+02_r8,1.0128e+01_r8/) + kao(:, 1, 6,10) = (/ & + &4.9443e+02_r8,4.3263e+02_r8,3.7082e+02_r8,3.0902e+02_r8,2.4721e+02_r8,1.8541e+02_r8, & + &1.2361e+02_r8,6.1804e+01_r8,1.1088e+01_r8/) + kao(:, 2, 6,10) = (/ & + &6.9842e+02_r8,6.1111e+02_r8,5.2381e+02_r8,4.3651e+02_r8,3.4921e+02_r8,2.6191e+02_r8, & + &1.7460e+02_r8,8.7302e+01_r8,1.1041e+01_r8/) + kao(:, 3, 6,10) = (/ & + &9.3821e+02_r8,8.2094e+02_r8,7.0366e+02_r8,5.8638e+02_r8,4.6911e+02_r8,3.5183e+02_r8, & + &2.3455e+02_r8,1.1728e+02_r8,1.0988e+01_r8/) + kao(:, 4, 6,10) = (/ & + &1.2155e+03_r8,1.0636e+03_r8,9.1165e+02_r8,7.5971e+02_r8,6.0777e+02_r8,4.5582e+02_r8, & + &3.0388e+02_r8,1.5194e+02_r8,1.0913e+01_r8/) + kao(:, 5, 6,10) = (/ & + &1.5286e+03_r8,1.3375e+03_r8,1.1464e+03_r8,9.5536e+02_r8,7.6429e+02_r8,5.7321e+02_r8, & + &3.8214e+02_r8,1.9107e+02_r8,1.0808e+01_r8/) + kao(:, 1, 7,10) = (/ & + &3.2977e+02_r8,2.8854e+02_r8,2.4732e+02_r8,2.0610e+02_r8,1.6488e+02_r8,1.2366e+02_r8, & + &8.2441e+01_r8,4.1221e+01_r8,1.1566e+01_r8/) + kao(:, 2, 7,10) = (/ & + &4.8209e+02_r8,4.2183e+02_r8,3.6157e+02_r8,3.0131e+02_r8,2.4104e+02_r8,1.8078e+02_r8, & + &1.2052e+02_r8,6.0261e+01_r8,1.1564e+01_r8/) + kao(:, 3, 7,10) = (/ & + &6.6530e+02_r8,5.8214e+02_r8,4.9898e+02_r8,4.1581e+02_r8,3.3265e+02_r8,2.4949e+02_r8, & + &1.6632e+02_r8,8.3163e+01_r8,1.1535e+01_r8/) + kao(:, 4, 7,10) = (/ & + &8.8049e+02_r8,7.7043e+02_r8,6.6036e+02_r8,5.5030e+02_r8,4.4024e+02_r8,3.3018e+02_r8, & + &2.2012e+02_r8,1.1006e+02_r8,1.1437e+01_r8/) + kao(:, 5, 7,10) = (/ & + &1.1278e+03_r8,9.8684e+02_r8,8.4586e+02_r8,7.0488e+02_r8,5.6391e+02_r8,4.2293e+02_r8, & + &2.8195e+02_r8,1.4098e+02_r8,1.1316e+01_r8/) + kao(:, 1, 8,10) = (/ & + &2.2204e+02_r8,1.9428e+02_r8,1.6653e+02_r8,1.3877e+02_r8,1.1102e+02_r8,8.3264e+01_r8, & + &5.5510e+01_r8,3.0059e+01_r8,1.1861e+01_r8/) + kao(:, 2, 8,10) = (/ & + &3.3638e+02_r8,2.9433e+02_r8,2.5228e+02_r8,2.1024e+02_r8,1.6819e+02_r8,1.2614e+02_r8, & + &8.4095e+01_r8,4.2076e+01_r8,1.1785e+01_r8/) + kao(:, 3, 8,10) = (/ & + &4.7771e+02_r8,4.1800e+02_r8,3.5828e+02_r8,2.9857e+02_r8,2.3886e+02_r8,1.7914e+02_r8, & + &1.1943e+02_r8,5.9714e+01_r8,1.1693e+01_r8/) + kao(:, 4, 8,10) = (/ & + &6.4744e+02_r8,5.6651e+02_r8,4.8558e+02_r8,4.0465e+02_r8,3.2372e+02_r8,2.4279e+02_r8, & + &1.6186e+02_r8,8.0931e+01_r8,1.1572e+01_r8/) + kao(:, 5, 8,10) = (/ & + &8.4463e+02_r8,7.3905e+02_r8,6.3347e+02_r8,5.2789e+02_r8,4.2232e+02_r8,3.1674e+02_r8, & + &2.1116e+02_r8,1.0558e+02_r8,1.1447e+01_r8/) + kao(:, 1, 9,10) = (/ & + &1.4633e+02_r8,1.2804e+02_r8,1.0975e+02_r8,9.1455e+01_r8,7.3164e+01_r8,5.4873e+01_r8, & + &3.7228e+01_r8,2.6999e+01_r8,1.1829e+01_r8/) + kao(:, 2, 9,10) = (/ & + &2.2961e+02_r8,2.0091e+02_r8,1.7220e+02_r8,1.4350e+02_r8,1.1480e+02_r8,8.6102e+01_r8, & + &5.7402e+01_r8,3.3291e+01_r8,1.1753e+01_r8/) + kao(:, 3, 9,10) = (/ & + &3.3705e+02_r8,2.9492e+02_r8,2.5279e+02_r8,2.1066e+02_r8,1.6852e+02_r8,1.2639e+02_r8, & + &8.4263e+01_r8,4.2726e+01_r8,1.1656e+01_r8/) + kao(:, 4, 9,10) = (/ & + &4.6791e+02_r8,4.0942e+02_r8,3.5094e+02_r8,2.9245e+02_r8,2.3396e+02_r8,1.7547e+02_r8, & + &1.1698e+02_r8,5.8490e+01_r8,1.1546e+01_r8/) + kao(:, 5, 9,10) = (/ & + &6.2380e+02_r8,5.4582e+02_r8,4.6785e+02_r8,3.8987e+02_r8,3.1190e+02_r8,2.3392e+02_r8, & + &1.5595e+02_r8,7.7975e+01_r8,1.1440e+01_r8/) + kao(:, 1,10,10) = (/ & + &9.9121e+01_r8,8.6731e+01_r8,7.4340e+01_r8,6.1950e+01_r8,4.9560e+01_r8,3.7719e+01_r8, & + &3.0913e+01_r8,2.3571e+01_r8,1.2025e+01_r8/) + kao(:, 2,10,10) = (/ & + &1.5969e+02_r8,1.3973e+02_r8,1.1977e+02_r8,9.9804e+01_r8,7.9844e+01_r8,5.9883e+01_r8, & + &4.1267e+01_r8,2.9611e+01_r8,1.1959e+01_r8/) + kao(:, 3,10,10) = (/ & + &2.4182e+02_r8,2.1160e+02_r8,1.8137e+02_r8,1.5114e+02_r8,1.2091e+02_r8,9.0684e+01_r8, & + &6.0456e+01_r8,3.6780e+01_r8,1.1864e+01_r8/) + kao(:, 4,10,10) = (/ & + &3.4325e+02_r8,3.0034e+02_r8,2.5744e+02_r8,2.1453e+02_r8,1.7163e+02_r8,1.2872e+02_r8, & + &8.5813e+01_r8,4.5301e+01_r8,1.1768e+01_r8/) + kao(:, 5,10,10) = (/ & + &4.6649e+02_r8,4.0818e+02_r8,3.4987e+02_r8,2.9156e+02_r8,2.3325e+02_r8,1.7493e+02_r8, & + &1.1662e+02_r8,5.8448e+01_r8,1.1666e+01_r8/) + kao(:, 1,11,10) = (/ & + &8.4453e+01_r8,7.3896e+01_r8,6.3339e+01_r8,5.2783e+01_r8,4.2282e+01_r8,3.5008e+01_r8, & + &3.0468e+01_r8,2.2795e+01_r8,1.2480e+01_r8/) + kao(:, 2,11,10) = (/ & + &1.3606e+02_r8,1.1905e+02_r8,1.0204e+02_r8,8.5035e+01_r8,6.8028e+01_r8,5.1171e+01_r8, & + &3.9405e+01_r8,2.8346e+01_r8,1.2418e+01_r8/) + kao(:, 3,11,10) = (/ & + &2.0562e+02_r8,1.7991e+02_r8,1.5421e+02_r8,1.2851e+02_r8,1.0281e+02_r8,7.7106e+01_r8, & + &5.2236e+01_r8,3.5283e+01_r8,1.2333e+01_r8/) + kao(:, 4,11,10) = (/ & + &2.9197e+02_r8,2.5547e+02_r8,2.1898e+02_r8,1.8248e+02_r8,1.4598e+02_r8,1.0949e+02_r8, & + &7.2992e+01_r8,4.3383e+01_r8,1.2243e+01_r8/) + kao(:, 5,11,10) = (/ & + &3.9645e+02_r8,3.4690e+02_r8,2.9734e+02_r8,2.4778e+02_r8,1.9823e+02_r8,1.4867e+02_r8, & + &9.9113e+01_r8,5.2639e+01_r8,1.2132e+01_r8/) + kao(:, 1,12,10) = (/ & + &7.3008e+01_r8,6.3882e+01_r8,5.4756e+01_r8,4.5630e+01_r8,3.8097e+01_r8,3.4292e+01_r8, & + &2.9157e+01_r8,2.1820e+01_r8,1.2784e+01_r8/) + kao(:, 2,12,10) = (/ & + &1.1777e+02_r8,1.0304e+02_r8,8.8324e+01_r8,7.3604e+01_r8,5.8883e+01_r8,4.6283e+01_r8, & + &3.8218e+01_r8,2.7110e+01_r8,1.2693e+01_r8/) + kao(:, 3,12,10) = (/ & + &1.7754e+02_r8,1.5535e+02_r8,1.3316e+02_r8,1.1096e+02_r8,8.8771e+01_r8,6.6578e+01_r8, & + &4.9180e+01_r8,3.3603e+01_r8,1.2566e+01_r8/) + kao(:, 4,12,10) = (/ & + &2.5172e+02_r8,2.2026e+02_r8,1.8879e+02_r8,1.5733e+02_r8,1.2586e+02_r8,9.4396e+01_r8, & + &6.3855e+01_r8,4.1285e+01_r8,1.2431e+01_r8/) + kao(:, 5,12,10) = (/ & + &3.4203e+02_r8,2.9928e+02_r8,2.5652e+02_r8,2.1377e+02_r8,1.7102e+02_r8,1.2826e+02_r8, & + &8.5508e+01_r8,5.0087e+01_r8,1.2252e+01_r8/) + kao(:, 1,13,10) = (/ & + &6.5744e+01_r8,5.7526e+01_r8,4.9308e+01_r8,4.1412e+01_r8,3.7107e+01_r8,3.3686e+01_r8, & + &2.7959e+01_r8,2.0954e+01_r8,1.2543e+01_r8/) + kao(:, 2,13,10) = (/ & + &1.0592e+02_r8,9.2679e+01_r8,7.9440e+01_r8,6.6200e+01_r8,5.3492e+01_r8,4.5296e+01_r8, & + &3.7012e+01_r8,2.6073e+01_r8,1.2385e+01_r8/) + kao(:, 3,13,10) = (/ & + &1.5952e+02_r8,1.3958e+02_r8,1.1964e+02_r8,9.9699e+01_r8,7.9759e+01_r8,6.0961e+01_r8, & + &4.7985e+01_r8,3.2430e+01_r8,1.2250e+01_r8/) + kao(:, 4,13,10) = (/ & + &2.2626e+02_r8,1.9798e+02_r8,1.6969e+02_r8,1.4141e+02_r8,1.1313e+02_r8,8.4848e+01_r8, & + &6.0965e+01_r8,3.9929e+01_r8,1.2100e+01_r8/) + kao(:, 5,13,10) = (/ & + &3.0736e+02_r8,2.6894e+02_r8,2.3052e+02_r8,1.9210e+02_r8,1.5368e+02_r8,1.1526e+02_r8, & + &7.7678e+01_r8,4.8494e+01_r8,1.1980e+01_r8/) + kao(:, 1, 1,11) = (/ & + &3.9010e+03_r8,3.4134e+03_r8,2.9257e+03_r8,2.4381e+03_r8,1.9505e+03_r8,1.4629e+03_r8, & + &9.7525e+02_r8,4.8762e+02_r8,2.5641e-03_r8/) + kao(:, 2, 1,11) = (/ & + &4.8941e+03_r8,4.2823e+03_r8,3.6706e+03_r8,3.0588e+03_r8,2.4471e+03_r8,1.8353e+03_r8, & + &1.2235e+03_r8,6.1176e+02_r8,4.7147e-03_r8/) + kao(:, 3, 1,11) = (/ & + &6.0244e+03_r8,5.2713e+03_r8,4.5183e+03_r8,3.7652e+03_r8,3.0122e+03_r8,2.2591e+03_r8, & + &1.5061e+03_r8,7.5305e+02_r8,1.8229e-02_r8/) + kao(:, 4, 1,11) = (/ & + &7.2726e+03_r8,6.3635e+03_r8,5.4544e+03_r8,4.5454e+03_r8,3.6363e+03_r8,2.7272e+03_r8, & + &1.8181e+03_r8,9.0907e+02_r8,4.1403e-02_r8/) + kao(:, 5, 1,11) = (/ & + &8.6200e+03_r8,7.5425e+03_r8,6.4650e+03_r8,5.3875e+03_r8,4.3100e+03_r8,3.2325e+03_r8, & + &2.1550e+03_r8,1.0775e+03_r8,7.0391e-01_r8/) + kao(:, 1, 2,11) = (/ & + &3.0926e+03_r8,2.7060e+03_r8,2.3194e+03_r8,1.9329e+03_r8,1.5463e+03_r8,1.1597e+03_r8, & + &7.7315e+02_r8,3.8657e+02_r8,1.4758e-01_r8/) + kao(:, 2, 2,11) = (/ & + &3.9512e+03_r8,3.4573e+03_r8,2.9634e+03_r8,2.4695e+03_r8,1.9756e+03_r8,1.4817e+03_r8, & + &9.8779e+02_r8,4.9390e+02_r8,7.5464e-01_r8/) + kao(:, 3, 2,11) = (/ & + &4.9225e+03_r8,4.3072e+03_r8,3.6919e+03_r8,3.0766e+03_r8,2.4613e+03_r8,1.8460e+03_r8, & + &1.2306e+03_r8,6.1532e+02_r8,2.2469e+00_r8/) + kao(:, 4, 2,11) = (/ & + &6.0042e+03_r8,5.2537e+03_r8,4.5032e+03_r8,3.7526e+03_r8,3.0021e+03_r8,2.2516e+03_r8, & + &1.5011e+03_r8,7.5053e+02_r8,4.5134e+00_r8/) + kao(:, 5, 2,11) = (/ & + &7.1983e+03_r8,6.2985e+03_r8,5.3987e+03_r8,4.4989e+03_r8,3.5991e+03_r8,2.6994e+03_r8, & + &1.7996e+03_r8,8.9979e+02_r8,5.4294e+00_r8/) + kao(:, 1, 3,11) = (/ & + &2.3009e+03_r8,2.0133e+03_r8,1.7257e+03_r8,1.4381e+03_r8,1.1505e+03_r8,8.6285e+02_r8, & + &5.7523e+02_r8,2.8762e+02_r8,4.0343e+00_r8/) + kao(:, 2, 3,11) = (/ & + &2.9916e+03_r8,2.6177e+03_r8,2.2437e+03_r8,1.8698e+03_r8,1.4958e+03_r8,1.1219e+03_r8, & + &7.4790e+02_r8,3.7395e+02_r8,9.4960e+00_r8/) + kao(:, 3, 3,11) = (/ & + &3.7957e+03_r8,3.3213e+03_r8,2.8468e+03_r8,2.3723e+03_r8,1.8979e+03_r8,1.4234e+03_r8, & + &9.4893e+02_r8,4.7447e+02_r8,9.8961e+00_r8/) + kao(:, 4, 3,11) = (/ & + &4.7090e+03_r8,4.1204e+03_r8,3.5318e+03_r8,2.9432e+03_r8,2.3545e+03_r8,1.7659e+03_r8, & + &1.1773e+03_r8,5.8863e+02_r8,9.8448e+00_r8/) + kao(:, 5, 3,11) = (/ & + &5.7119e+03_r8,4.9979e+03_r8,4.2839e+03_r8,3.5699e+03_r8,2.8560e+03_r8,2.1420e+03_r8, & + &1.4280e+03_r8,7.1399e+02_r8,9.5434e+00_r8/) + kao(:, 1, 4,11) = (/ & + &1.6459e+03_r8,1.4402e+03_r8,1.2345e+03_r8,1.0287e+03_r8,8.2297e+02_r8,6.1723e+02_r8, & + &4.1148e+02_r8,2.0574e+02_r8,1.1261e+01_r8/) + kao(:, 2, 4,11) = (/ & + &2.1944e+03_r8,1.9201e+03_r8,1.6458e+03_r8,1.3715e+03_r8,1.0972e+03_r8,8.2292e+02_r8, & + &5.4861e+02_r8,2.7431e+02_r8,1.1246e+01_r8/) + kao(:, 3, 4,11) = (/ & + &2.8415e+03_r8,2.4863e+03_r8,2.1311e+03_r8,1.7759e+03_r8,1.4207e+03_r8,1.0656e+03_r8, & + &7.1037e+02_r8,3.5519e+02_r8,1.1203e+01_r8/) + kao(:, 4, 4,11) = (/ & + &3.5819e+03_r8,3.1342e+03_r8,2.6865e+03_r8,2.2387e+03_r8,1.7910e+03_r8,1.3432e+03_r8, & + &8.9549e+02_r8,4.4774e+02_r8,1.1137e+01_r8/) + kao(:, 5, 4,11) = (/ & + &4.4164e+03_r8,3.8643e+03_r8,3.3123e+03_r8,2.7602e+03_r8,2.2082e+03_r8,1.6561e+03_r8, & + &1.1041e+03_r8,5.5205e+02_r8,1.1062e+01_r8/) + kao(:, 1, 5,11) = (/ & + &1.1573e+03_r8,1.0126e+03_r8,8.6797e+02_r8,7.2331e+02_r8,5.7865e+02_r8,4.3399e+02_r8, & + &2.8932e+02_r8,1.4466e+02_r8,1.2627e+01_r8/) + kao(:, 2, 5,11) = (/ & + &1.5804e+03_r8,1.3829e+03_r8,1.1853e+03_r8,9.8775e+02_r8,7.9020e+02_r8,5.9265e+02_r8, & + &3.9510e+02_r8,1.9755e+02_r8,1.2599e+01_r8/) + kao(:, 3, 5,11) = (/ & + &2.0873e+03_r8,1.8264e+03_r8,1.5655e+03_r8,1.3046e+03_r8,1.0437e+03_r8,7.8274e+02_r8, & + &5.2183e+02_r8,2.6092e+02_r8,1.2536e+01_r8/) + kao(:, 4, 5,11) = (/ & + &2.6827e+03_r8,2.3473e+03_r8,2.0120e+03_r8,1.6767e+03_r8,1.3413e+03_r8,1.0060e+03_r8, & + &6.7067e+02_r8,3.3534e+02_r8,1.2467e+01_r8/) + kao(:, 5, 5,11) = (/ & + &3.3592e+03_r8,2.9393e+03_r8,2.5194e+03_r8,2.0995e+03_r8,1.6796e+03_r8,1.2597e+03_r8, & + &8.3980e+02_r8,4.1990e+02_r8,1.2393e+01_r8/) + kao(:, 1, 6,11) = (/ & + &7.9180e+02_r8,6.9282e+02_r8,5.9385e+02_r8,4.9487e+02_r8,3.9590e+02_r8,2.9692e+02_r8, & + &1.9795e+02_r8,9.8975e+01_r8,1.3948e+01_r8/) + kao(:, 2, 6,11) = (/ & + &1.1067e+03_r8,9.6838e+02_r8,8.3004e+02_r8,6.9170e+02_r8,5.5336e+02_r8,4.1502e+02_r8, & + &2.7668e+02_r8,1.3834e+02_r8,1.3917e+01_r8/) + kao(:, 3, 6,11) = (/ & + &1.4976e+03_r8,1.3104e+03_r8,1.1232e+03_r8,9.3600e+02_r8,7.4880e+02_r8,5.6160e+02_r8, & + &3.7440e+02_r8,1.8720e+02_r8,1.3860e+01_r8/) + kao(:, 4, 6,11) = (/ & + &1.9619e+03_r8,1.7167e+03_r8,1.4715e+03_r8,1.2262e+03_r8,9.8097e+02_r8,7.3573e+02_r8, & + &4.9049e+02_r8,2.4524e+02_r8,1.3785e+01_r8/) + kao(:, 5, 6,11) = (/ & + &2.4991e+03_r8,2.1867e+03_r8,1.8743e+03_r8,1.5619e+03_r8,1.2496e+03_r8,9.3716e+02_r8, & + &6.2477e+02_r8,3.1239e+02_r8,1.3707e+01_r8/) + kao(:, 1, 7,11) = (/ & + &5.3794e+02_r8,4.7070e+02_r8,4.0346e+02_r8,3.3621e+02_r8,2.6897e+02_r8,2.0173e+02_r8, & + &1.3449e+02_r8,6.7243e+01_r8,1.5200e+01_r8/) + kao(:, 2, 7,11) = (/ & + &7.7168e+02_r8,6.7522e+02_r8,5.7876e+02_r8,4.8230e+02_r8,3.8584e+02_r8,2.8938e+02_r8, & + &1.9292e+02_r8,9.6460e+01_r8,1.5161e+01_r8/) + kao(:, 3, 7,11) = (/ & + &1.0690e+03_r8,9.3537e+02_r8,8.0174e+02_r8,6.6812e+02_r8,5.3449e+02_r8,4.0087e+02_r8, & + &2.6725e+02_r8,1.3362e+02_r8,1.5097e+01_r8/) + kao(:, 4, 7,11) = (/ & + &1.4303e+03_r8,1.2515e+03_r8,1.0727e+03_r8,8.9396e+02_r8,7.1516e+02_r8,5.3637e+02_r8, & + &3.5758e+02_r8,1.7879e+02_r8,1.5017e+01_r8/) + kao(:, 5, 7,11) = (/ & + &1.8576e+03_r8,1.6254e+03_r8,1.3932e+03_r8,1.1610e+03_r8,9.2880e+02_r8,6.9660e+02_r8, & + &4.6440e+02_r8,2.3220e+02_r8,1.4920e+01_r8/) + kao(:, 1, 8,11) = (/ & + &3.6857e+02_r8,3.2250e+02_r8,2.7643e+02_r8,2.3036e+02_r8,1.8428e+02_r8,1.3821e+02_r8, & + &9.2143e+01_r8,4.6072e+01_r8,1.6297e+01_r8/) + kao(:, 2, 8,11) = (/ & + &5.4427e+02_r8,4.7624e+02_r8,4.0820e+02_r8,3.4017e+02_r8,2.7214e+02_r8,2.0410e+02_r8, & + &1.3607e+02_r8,6.8035e+01_r8,1.6238e+01_r8/) + kao(:, 3, 8,11) = (/ & + &7.7191e+02_r8,6.7542e+02_r8,5.7893e+02_r8,4.8244e+02_r8,3.8595e+02_r8,2.8947e+02_r8, & + &1.9298e+02_r8,9.6489e+01_r8,1.6155e+01_r8/) + kao(:, 4, 8,11) = (/ & + &1.0564e+03_r8,9.2435e+02_r8,7.9230e+02_r8,6.6025e+02_r8,5.2820e+02_r8,3.9615e+02_r8, & + &2.6410e+02_r8,1.3205e+02_r8,1.6062e+01_r8/) + kao(:, 5, 8,11) = (/ & + &1.3972e+03_r8,1.2225e+03_r8,1.0479e+03_r8,8.7322e+02_r8,6.9858e+02_r8,5.2393e+02_r8, & + &3.4929e+02_r8,1.7465e+02_r8,1.5943e+01_r8/) + kao(:, 1, 9,11) = (/ & + &2.4734e+02_r8,2.1642e+02_r8,1.8550e+02_r8,1.5459e+02_r8,1.2367e+02_r8,9.2751e+01_r8, & + &6.1834e+01_r8,3.4329e+01_r8,1.7139e+01_r8/) + kao(:, 2, 9,11) = (/ & + &3.7646e+02_r8,3.2941e+02_r8,2.8235e+02_r8,2.3529e+02_r8,1.8823e+02_r8,1.4117e+02_r8, & + &9.4116e+01_r8,4.7119e+01_r8,1.7064e+01_r8/) + kao(:, 3, 9,11) = (/ & + &5.4702e+02_r8,4.7864e+02_r8,4.1027e+02_r8,3.4189e+02_r8,2.7351e+02_r8,2.0513e+02_r8, & + &1.3676e+02_r8,6.8378e+01_r8,1.6972e+01_r8/) + kao(:, 4, 9,11) = (/ & + &7.6564e+02_r8,6.6994e+02_r8,5.7423e+02_r8,4.7853e+02_r8,3.8282e+02_r8,2.8712e+02_r8, & + &1.9141e+02_r8,9.5706e+01_r8,1.6856e+01_r8/) + kao(:, 5, 9,11) = (/ & + &1.0333e+03_r8,9.0412e+02_r8,7.7496e+02_r8,6.4580e+02_r8,5.1664e+02_r8,3.8748e+02_r8, & + &2.5832e+02_r8,1.2916e+02_r8,1.6713e+01_r8/) + kao(:, 1,10,11) = (/ & + &1.6975e+02_r8,1.4853e+02_r8,1.2731e+02_r8,1.0609e+02_r8,8.4874e+01_r8,6.3656e+01_r8, & + &4.3000e+01_r8,3.1831e+01_r8,1.7572e+01_r8/) + kao(:, 2,10,11) = (/ & + &2.6544e+02_r8,2.3226e+02_r8,1.9908e+02_r8,1.6590e+02_r8,1.3272e+02_r8,9.9541e+01_r8, & + &6.6361e+01_r8,3.9122e+01_r8,1.7485e+01_r8/) + kao(:, 3,10,11) = (/ & + &3.9471e+02_r8,3.4537e+02_r8,2.9603e+02_r8,2.4669e+02_r8,1.9735e+02_r8,1.4801e+02_r8, & + &9.8676e+01_r8,5.0382e+01_r8,1.7381e+01_r8/) + kao(:, 4,10,11) = (/ & + &5.6315e+02_r8,4.9275e+02_r8,4.2236e+02_r8,3.5197e+02_r8,2.8157e+02_r8,2.1118e+02_r8, & + &1.4079e+02_r8,7.0394e+01_r8,1.7247e+01_r8/) + kao(:, 5,10,11) = (/ & + &7.7410e+02_r8,6.7734e+02_r8,5.8057e+02_r8,4.8381e+02_r8,3.8705e+02_r8,2.9029e+02_r8, & + &1.9352e+02_r8,9.6763e+01_r8,1.7092e+01_r8/) + kao(:, 1,11,11) = (/ & + &1.4476e+02_r8,1.2667e+02_r8,1.0857e+02_r8,9.0475e+01_r8,7.2380e+01_r8,5.4285e+01_r8, & + &4.0590e+01_r8,3.2171e+01_r8,1.7597e+01_r8/) + kao(:, 2,11,11) = (/ & + &2.2628e+02_r8,1.9800e+02_r8,1.6971e+02_r8,1.4143e+02_r8,1.1314e+02_r8,8.4856e+01_r8, & + &5.6719e+01_r8,3.9479e+01_r8,1.7480e+01_r8/) + kao(:, 3,11,11) = (/ & + &3.3682e+02_r8,2.9472e+02_r8,2.5262e+02_r8,2.1051e+02_r8,1.6841e+02_r8,1.2631e+02_r8, & + &8.4204e+01_r8,4.8355e+01_r8,1.7349e+01_r8/) + kao(:, 4,11,11) = (/ & + &4.8164e+02_r8,4.2144e+02_r8,3.6123e+02_r8,3.0103e+02_r8,2.4082e+02_r8,1.8062e+02_r8, & + &1.2041e+02_r8,6.1572e+01_r8,1.7186e+01_r8/) + kao(:, 5,11,11) = (/ & + &6.6267e+02_r8,5.7984e+02_r8,4.9701e+02_r8,4.1417e+02_r8,3.3134e+02_r8,2.4850e+02_r8, & + &1.6567e+02_r8,8.2835e+01_r8,1.7015e+01_r8/) + kao(:, 1,12,11) = (/ & + &1.2510e+02_r8,1.0946e+02_r8,9.3823e+01_r8,7.8186e+01_r8,6.2549e+01_r8,4.8100e+01_r8, & + &4.0318e+01_r8,3.2221e+01_r8,1.7708e+01_r8/) + kao(:, 2,12,11) = (/ & + &1.9563e+02_r8,1.7117e+02_r8,1.4672e+02_r8,1.2227e+02_r8,9.7813e+01_r8,7.3360e+01_r8, & + &5.2529e+01_r8,3.9562e+01_r8,1.7612e+01_r8/) + kao(:, 3,12,11) = (/ & + &2.9201e+02_r8,2.5551e+02_r8,2.1901e+02_r8,1.8251e+02_r8,1.4600e+02_r8,1.0950e+02_r8, & + &7.3154e+01_r8,4.8447e+01_r8,1.7481e+01_r8/) + kao(:, 4,12,11) = (/ & + &4.1774e+02_r8,3.6552e+02_r8,3.1331e+02_r8,2.6109e+02_r8,2.0887e+02_r8,1.5665e+02_r8, & + &1.0444e+02_r8,5.8915e+01_r8,1.7339e+01_r8/) + kao(:, 5,12,11) = (/ & + &5.7504e+02_r8,5.0316e+02_r8,4.3128e+02_r8,3.5940e+02_r8,2.8752e+02_r8,2.1564e+02_r8, & + &1.4376e+02_r8,7.3682e+01_r8,1.7186e+01_r8/) + kao(:, 1,13,11) = (/ & + &1.1264e+02_r8,9.8561e+01_r8,8.4481e+01_r8,7.0401e+01_r8,5.6432e+01_r8,4.7061e+01_r8, & + &4.0409e+01_r8,3.2253e+01_r8,1.8302e+01_r8/) + kao(:, 2,13,11) = (/ & + &1.7621e+02_r8,1.5419e+02_r8,1.3216e+02_r8,1.1013e+02_r8,8.8108e+01_r8,6.6456e+01_r8, & + &5.2592e+01_r8,3.9667e+01_r8,1.8194e+01_r8/) + kao(:, 3,13,11) = (/ & + &2.6303e+02_r8,2.3015e+02_r8,1.9727e+02_r8,1.6440e+02_r8,1.3152e+02_r8,9.8638e+01_r8, & + &6.8547e+01_r8,4.8772e+01_r8,1.8071e+01_r8/) + kao(:, 4,13,11) = (/ & + &3.7673e+02_r8,3.2964e+02_r8,2.8255e+02_r8,2.3546e+02_r8,1.8837e+02_r8,1.4128e+02_r8, & + &9.4251e+01_r8,5.9423e+01_r8,1.7926e+01_r8/) + kao(:, 5,13,11) = (/ & + &5.1904e+02_r8,4.5416e+02_r8,3.8928e+02_r8,3.2440e+02_r8,2.5952e+02_r8,1.9464e+02_r8, & + &1.2976e+02_r8,7.1698e+01_r8,1.7708e+01_r8/) + kao(:, 1, 1,12) = (/ & + &6.1566e+03_r8,5.3871e+03_r8,4.6175e+03_r8,3.8479e+03_r8,3.0783e+03_r8,2.3087e+03_r8, & + &1.5392e+03_r8,7.6958e+02_r8,3.6622e-03_r8/) + kao(:, 2, 1,12) = (/ & + &7.8640e+03_r8,6.8810e+03_r8,5.8980e+03_r8,4.9150e+03_r8,3.9320e+03_r8,2.9490e+03_r8, & + &1.9660e+03_r8,9.8301e+02_r8,3.6025e-03_r8/) + kao(:, 3, 1,12) = (/ & + &9.7949e+03_r8,8.5705e+03_r8,7.3462e+03_r8,6.1218e+03_r8,4.8974e+03_r8,3.6731e+03_r8, & + &2.4487e+03_r8,1.2244e+03_r8,3.3010e-02_r8/) + kao(:, 4, 1,12) = (/ & + &1.1959e+04_r8,1.0464e+04_r8,8.9695e+03_r8,7.4746e+03_r8,5.9797e+03_r8,4.4847e+03_r8, & + &2.9898e+03_r8,1.4949e+03_r8,6.0612e-02_r8/) + kao(:, 5, 1,12) = (/ & + &1.4386e+04_r8,1.2588e+04_r8,1.0790e+04_r8,8.9913e+03_r8,7.1931e+03_r8,5.3948e+03_r8, & + &3.5965e+03_r8,1.7983e+03_r8,7.6915e-02_r8/) + kao(:, 1, 2,12) = (/ & + &5.0811e+03_r8,4.4460e+03_r8,3.8109e+03_r8,3.1757e+03_r8,2.5406e+03_r8,1.9054e+03_r8, & + &1.2703e+03_r8,6.3514e+02_r8,2.7963e-01_r8/) + kao(:, 2, 2,12) = (/ & + &6.5891e+03_r8,5.7655e+03_r8,4.9418e+03_r8,4.1182e+03_r8,3.2946e+03_r8,2.4709e+03_r8, & + &1.6473e+03_r8,8.2364e+02_r8,2.3002e+00_r8/) + kao(:, 3, 2,12) = (/ & + &8.3666e+03_r8,7.3208e+03_r8,6.2750e+03_r8,5.2291e+03_r8,4.1833e+03_r8,3.1375e+03_r8, & + &2.0917e+03_r8,1.0458e+03_r8,4.9790e+00_r8/) + kao(:, 4, 2,12) = (/ & + &1.0356e+04_r8,9.0616e+03_r8,7.7671e+03_r8,6.4726e+03_r8,5.1781e+03_r8,3.8836e+03_r8, & + &2.5890e+03_r8,1.2945e+03_r8,6.0169e+00_r8/) + kao(:, 5, 2,12) = (/ & + &1.2531e+04_r8,1.0965e+04_r8,9.3984e+03_r8,7.8320e+03_r8,6.2656e+03_r8,4.6992e+03_r8, & + &3.1328e+03_r8,1.5664e+03_r8,6.8160e+00_r8/) + kao(:, 1, 3,12) = (/ & + &3.8913e+03_r8,3.4049e+03_r8,2.9185e+03_r8,2.4321e+03_r8,1.9457e+03_r8,1.4593e+03_r8, & + &9.7284e+02_r8,4.8642e+02_r8,1.1253e+01_r8/) + kao(:, 2, 3,12) = (/ & + &5.1870e+03_r8,4.5386e+03_r8,3.8902e+03_r8,3.2418e+03_r8,2.5935e+03_r8,1.9451e+03_r8, & + &1.2967e+03_r8,6.4837e+02_r8,1.1246e+01_r8/) + kao(:, 3, 3,12) = (/ & + &6.6906e+03_r8,5.8543e+03_r8,5.0180e+03_r8,4.1816e+03_r8,3.3453e+03_r8,2.5090e+03_r8, & + &1.6727e+03_r8,8.3633e+02_r8,1.1235e+01_r8/) + kao(:, 4, 3,12) = (/ & + &8.4124e+03_r8,7.3608e+03_r8,6.3093e+03_r8,5.2577e+03_r8,4.2062e+03_r8,3.1546e+03_r8, & + &2.1031e+03_r8,1.0515e+03_r8,1.1206e+01_r8/) + kao(:, 5, 3,12) = (/ & + &1.0381e+04_r8,9.0837e+03_r8,7.7860e+03_r8,6.4883e+03_r8,5.1907e+03_r8,3.8930e+03_r8, & + &2.5953e+03_r8,1.2977e+03_r8,1.1154e+01_r8/) + kao(:, 1, 4,12) = (/ & + &2.8697e+03_r8,2.5110e+03_r8,2.1523e+03_r8,1.7936e+03_r8,1.4349e+03_r8,1.0761e+03_r8, & + &7.1743e+02_r8,3.5872e+02_r8,1.3022e+01_r8/) + kao(:, 2, 4,12) = (/ & + &3.9101e+03_r8,3.4213e+03_r8,2.9326e+03_r8,2.4438e+03_r8,1.9551e+03_r8,1.4663e+03_r8, & + &9.7753e+02_r8,4.8877e+02_r8,1.3025e+01_r8/) + kao(:, 3, 4,12) = (/ & + &5.1573e+03_r8,4.5126e+03_r8,3.8680e+03_r8,3.2233e+03_r8,2.5786e+03_r8,1.9340e+03_r8, & + &1.2893e+03_r8,6.4466e+02_r8,1.3008e+01_r8/) + kao(:, 4, 4,12) = (/ & + &6.6403e+03_r8,5.8103e+03_r8,4.9802e+03_r8,4.1502e+03_r8,3.3201e+03_r8,2.4901e+03_r8, & + &1.6601e+03_r8,8.3004e+02_r8,1.2981e+01_r8/) + kao(:, 5, 4,12) = (/ & + &8.3023e+03_r8,7.2645e+03_r8,6.2267e+03_r8,5.1889e+03_r8,4.1511e+03_r8,3.1134e+03_r8, & + &2.0756e+03_r8,1.0378e+03_r8,1.2927e+01_r8/) + kao(:, 1, 5,12) = (/ & + &2.0574e+03_r8,1.8002e+03_r8,1.5431e+03_r8,1.2859e+03_r8,1.0287e+03_r8,7.7153e+02_r8, & + &5.1435e+02_r8,2.5718e+02_r8,1.4941e+01_r8/) + kao(:, 2, 5,12) = (/ & + &2.8796e+03_r8,2.5197e+03_r8,2.1597e+03_r8,1.7998e+03_r8,1.4398e+03_r8,1.0799e+03_r8, & + &7.1991e+02_r8,3.5996e+02_r8,1.4958e+01_r8/) + kao(:, 3, 5,12) = (/ & + &3.9044e+03_r8,3.4163e+03_r8,2.9283e+03_r8,2.4402e+03_r8,1.9522e+03_r8,1.4641e+03_r8, & + &9.7610e+02_r8,4.8805e+02_r8,1.4965e+01_r8/) + kao(:, 4, 5,12) = (/ & + &5.1045e+03_r8,4.4665e+03_r8,3.8284e+03_r8,3.1903e+03_r8,2.5523e+03_r8,1.9142e+03_r8, & + &1.2761e+03_r8,6.3807e+02_r8,1.4927e+01_r8/) + kao(:, 5, 5,12) = (/ & + &6.5127e+03_r8,5.6986e+03_r8,4.8846e+03_r8,4.0705e+03_r8,3.2564e+03_r8,2.4423e+03_r8, & + &1.6282e+03_r8,8.1409e+02_r8,1.4857e+01_r8/) + kao(:, 1, 6,12) = (/ & + &1.4218e+03_r8,1.2441e+03_r8,1.0663e+03_r8,8.8861e+02_r8,7.1089e+02_r8,5.3316e+02_r8, & + &3.5544e+02_r8,1.7772e+02_r8,1.7034e+01_r8/) + kao(:, 2, 6,12) = (/ & + &2.0585e+03_r8,1.8012e+03_r8,1.5439e+03_r8,1.2865e+03_r8,1.0292e+03_r8,7.7193e+02_r8, & + &5.1462e+02_r8,2.5731e+02_r8,1.7052e+01_r8/) + kao(:, 3, 6,12) = (/ & + &2.8529e+03_r8,2.4963e+03_r8,2.1397e+03_r8,1.7831e+03_r8,1.4265e+03_r8,1.0699e+03_r8, & + &7.1324e+02_r8,3.5662e+02_r8,1.7043e+01_r8/) + kao(:, 4, 6,12) = (/ & + &3.8237e+03_r8,3.3458e+03_r8,2.8678e+03_r8,2.3898e+03_r8,1.9119e+03_r8,1.4339e+03_r8, & + &9.5593e+02_r8,4.7797e+02_r8,1.6999e+01_r8/) + kao(:, 5, 6,12) = (/ & + &4.9757e+03_r8,4.3537e+03_r8,3.7318e+03_r8,3.1098e+03_r8,2.4878e+03_r8,1.8659e+03_r8, & + &1.2439e+03_r8,6.2196e+02_r8,1.6923e+01_r8/) + kao(:, 1, 7,12) = (/ & + &9.7219e+02_r8,8.5066e+02_r8,7.2914e+02_r8,6.0761e+02_r8,4.8609e+02_r8,3.6457e+02_r8, & + &2.4305e+02_r8,1.2152e+02_r8,1.9204e+01_r8/) + kao(:, 2, 7,12) = (/ & + &1.4501e+03_r8,1.2688e+03_r8,1.0876e+03_r8,9.0631e+02_r8,7.2505e+02_r8,5.4378e+02_r8, & + &3.6252e+02_r8,1.8126e+02_r8,1.9225e+01_r8/) + kao(:, 3, 7,12) = (/ & + &2.0671e+03_r8,1.8087e+03_r8,1.5503e+03_r8,1.2919e+03_r8,1.0335e+03_r8,7.7515e+02_r8, & + &5.1676e+02_r8,2.5838e+02_r8,1.9209e+01_r8/) + kao(:, 4, 7,12) = (/ & + &2.8414e+03_r8,2.4862e+03_r8,2.1311e+03_r8,1.7759e+03_r8,1.4207e+03_r8,1.0655e+03_r8, & + &7.1035e+02_r8,3.5518e+02_r8,1.9156e+01_r8/) + kao(:, 5, 7,12) = (/ & + &3.7638e+03_r8,3.2933e+03_r8,2.8228e+03_r8,2.3524e+03_r8,1.8819e+03_r8,1.4114e+03_r8, & + &9.4094e+02_r8,4.7047e+02_r8,1.9066e+01_r8/) + kao(:, 1, 8,12) = (/ & + &6.6611e+02_r8,5.8284e+02_r8,4.9958e+02_r8,4.1632e+02_r8,3.3305e+02_r8,2.4979e+02_r8, & + &1.6653e+02_r8,8.3265e+01_r8,2.1374e+01_r8/) + kao(:, 2, 8,12) = (/ & + &1.0262e+03_r8,8.9794e+02_r8,7.6966e+02_r8,6.4139e+02_r8,5.1311e+02_r8,3.8483e+02_r8, & + &2.5656e+02_r8,1.2828e+02_r8,2.1403e+01_r8/) + kao(:, 3, 8,12) = (/ & + &1.5100e+03_r8,1.3213e+03_r8,1.1325e+03_r8,9.4376e+02_r8,7.5501e+02_r8,5.6626e+02_r8, & + &3.7751e+02_r8,1.8875e+02_r8,2.1385e+01_r8/) + kao(:, 4, 8,12) = (/ & + &2.1206e+03_r8,1.8555e+03_r8,1.5904e+03_r8,1.3254e+03_r8,1.0603e+03_r8,7.9522e+02_r8, & + &5.3015e+02_r8,2.6507e+02_r8,2.1320e+01_r8/) + kao(:, 5, 8,12) = (/ & + &2.8794e+03_r8,2.5195e+03_r8,2.1596e+03_r8,1.7996e+03_r8,1.4397e+03_r8,1.0798e+03_r8, & + &7.1985e+02_r8,3.5993e+02_r8,2.1216e+01_r8/) + kao(:, 1, 9,12) = (/ & + &4.4380e+02_r8,3.8832e+02_r8,3.3285e+02_r8,2.7737e+02_r8,2.2190e+02_r8,1.6642e+02_r8, & + &1.1095e+02_r8,5.5475e+01_r8,2.3490e+01_r8/) + kao(:, 2, 9,12) = (/ & + &7.0869e+02_r8,6.2011e+02_r8,5.3152e+02_r8,4.4293e+02_r8,3.5435e+02_r8,2.6576e+02_r8, & + &1.7717e+02_r8,8.8587e+01_r8,2.3505e+01_r8/) + kao(:, 3, 9,12) = (/ & + &1.0731e+03_r8,9.3894e+02_r8,8.0481e+02_r8,6.7067e+02_r8,5.3654e+02_r8,4.0240e+02_r8, & + &2.6827e+02_r8,1.3414e+02_r8,2.3465e+01_r8/) + kao(:, 4, 9,12) = (/ & + &1.5496e+03_r8,1.3559e+03_r8,1.1622e+03_r8,9.6851e+02_r8,7.7481e+02_r8,5.8111e+02_r8, & + &3.8741e+02_r8,1.9370e+02_r8,2.3379e+01_r8/) + kao(:, 5, 9,12) = (/ & + &2.1497e+03_r8,1.8810e+03_r8,1.6123e+03_r8,1.3436e+03_r8,1.0749e+03_r8,8.0615e+02_r8, & + &5.3743e+02_r8,2.6872e+02_r8,2.3258e+01_r8/) + kao(:, 1,10,12) = (/ & + &3.0213e+02_r8,2.6436e+02_r8,2.2659e+02_r8,1.8883e+02_r8,1.5106e+02_r8,1.1330e+02_r8, & + &7.5532e+01_r8,4.3106e+01_r8,2.5395e+01_r8/) + kao(:, 2,10,12) = (/ & + &4.9804e+02_r8,4.3578e+02_r8,3.7353e+02_r8,3.1127e+02_r8,2.4902e+02_r8,1.8676e+02_r8, & + &1.2451e+02_r8,6.2505e+01_r8,2.5385e+01_r8/) + kao(:, 3,10,12) = (/ & + &7.7418e+02_r8,6.7741e+02_r8,5.8063e+02_r8,4.8386e+02_r8,3.8709e+02_r8,2.9032e+02_r8, & + &1.9354e+02_r8,9.6773e+01_r8,2.5325e+01_r8/) + kao(:, 4,10,12) = (/ & + &1.1469e+03_r8,1.0035e+03_r8,8.6015e+02_r8,7.1679e+02_r8,5.7343e+02_r8,4.3007e+02_r8, & + &2.8671e+02_r8,1.4336e+02_r8,2.5217e+01_r8/) + kao(:, 5,10,12) = (/ & + &1.6217e+03_r8,1.4190e+03_r8,1.2162e+03_r8,1.0135e+03_r8,8.1083e+02_r8,6.0812e+02_r8, & + &4.0541e+02_r8,2.0271e+02_r8,2.5082e+01_r8/) + kao(:, 1,11,12) = (/ & + &2.6097e+02_r8,2.2835e+02_r8,1.9573e+02_r8,1.6311e+02_r8,1.3048e+02_r8,9.7863e+01_r8, & + &6.5361e+01_r8,4.5364e+01_r8,2.6989e+01_r8/) + kao(:, 2,11,12) = (/ & + &4.3087e+02_r8,3.7701e+02_r8,3.2315e+02_r8,2.6929e+02_r8,2.1543e+02_r8,1.6158e+02_r8, & + &1.0772e+02_r8,5.7754e+01_r8,2.6926e+01_r8/) + kao(:, 3,11,12) = (/ & + &6.7272e+02_r8,5.8863e+02_r8,5.0454e+02_r8,4.2045e+02_r8,3.3636e+02_r8,2.5227e+02_r8, & + &1.6818e+02_r8,8.4156e+01_r8,2.6813e+01_r8/) + kao(:, 4,11,12) = (/ & + &9.9607e+02_r8,8.7156e+02_r8,7.4705e+02_r8,6.2254e+02_r8,4.9803e+02_r8,3.7353e+02_r8, & + &2.4902e+02_r8,1.2451e+02_r8,2.6666e+01_r8/) + kao(:, 5,11,12) = (/ & + &1.4127e+03_r8,1.2361e+03_r8,1.0595e+03_r8,8.8291e+02_r8,7.0633e+02_r8,5.2975e+02_r8, & + &3.5316e+02_r8,1.7658e+02_r8,2.6473e+01_r8/) + kao(:, 1,12,12) = (/ & + &2.2830e+02_r8,1.9976e+02_r8,1.7123e+02_r8,1.4269e+02_r8,1.1415e+02_r8,8.5613e+01_r8, & + &6.0099e+01_r8,4.8249e+01_r8,2.8107e+01_r8/) + kao(:, 2,12,12) = (/ & + &3.7815e+02_r8,3.3089e+02_r8,2.8362e+02_r8,2.3635e+02_r8,1.8908e+02_r8,1.4181e+02_r8, & + &9.4540e+01_r8,5.8332e+01_r8,2.7966e+01_r8/) + kao(:, 3,12,12) = (/ & + &5.9040e+02_r8,5.1660e+02_r8,4.4280e+02_r8,3.6900e+02_r8,2.9520e+02_r8,2.2140e+02_r8, & + &1.4760e+02_r8,7.6746e+01_r8,2.7793e+01_r8/) + kao(:, 4,12,12) = (/ & + &8.7660e+02_r8,7.6702e+02_r8,6.5745e+02_r8,5.4787e+02_r8,4.3830e+02_r8,3.2873e+02_r8, & + &2.1915e+02_r8,1.0959e+02_r8,2.7580e+01_r8/) + kao(:, 5,12,12) = (/ & + &1.2432e+03_r8,1.0878e+03_r8,9.3242e+02_r8,7.7702e+02_r8,6.2161e+02_r8,4.6621e+02_r8, & + &3.1081e+02_r8,1.5540e+02_r8,2.7330e+01_r8/) + kao(:, 1,13,12) = (/ & + &2.0770e+02_r8,1.8173e+02_r8,1.5577e+02_r8,1.2981e+02_r8,1.0385e+02_r8,7.8129e+01_r8, & + &6.0586e+01_r8,5.1072e+01_r8,2.8383e+01_r8/) + kao(:, 2,13,12) = (/ & + &3.4420e+02_r8,3.0118e+02_r8,2.5815e+02_r8,2.1513e+02_r8,1.7210e+02_r8,1.2908e+02_r8, & + &8.7185e+01_r8,6.1802e+01_r8,2.8222e+01_r8/) + kao(:, 3,13,12) = (/ & + &5.3871e+02_r8,4.7137e+02_r8,4.0403e+02_r8,3.3670e+02_r8,2.6936e+02_r8,2.0202e+02_r8, & + &1.3468e+02_r8,7.6219e+01_r8,2.8010e+01_r8/) + kao(:, 4,13,12) = (/ & + &7.9982e+02_r8,6.9985e+02_r8,5.9987e+02_r8,4.9989e+02_r8,3.9991e+02_r8,2.9994e+02_r8, & + &1.9996e+02_r8,1.0196e+02_r8,2.7782e+01_r8/) + kao(:, 5,13,12) = (/ & + &1.1353e+03_r8,9.9341e+02_r8,8.5150e+02_r8,7.0958e+02_r8,5.6767e+02_r8,4.2575e+02_r8, & + &2.8384e+02_r8,1.4192e+02_r8,2.7521e+01_r8/) + kao(:, 1, 1,13) = (/ & + &1.0877e+04_r8,9.5175e+03_r8,8.1579e+03_r8,6.7982e+03_r8,5.4386e+03_r8,4.0789e+03_r8, & + &2.7193e+03_r8,1.3596e+03_r8,2.7375e-03_r8/) + kao(:, 2, 1,13) = (/ & + &1.4140e+04_r8,1.2372e+04_r8,1.0605e+04_r8,8.8373e+03_r8,7.0699e+03_r8,5.3024e+03_r8, & + &3.5349e+03_r8,1.7675e+03_r8,2.6515e-03_r8/) + kao(:, 3, 1,13) = (/ & + &1.7904e+04_r8,1.5666e+04_r8,1.3428e+04_r8,1.1190e+04_r8,8.9519e+03_r8,6.7139e+03_r8, & + &4.4759e+03_r8,2.2380e+03_r8,3.8993e-02_r8/) + kao(:, 4, 1,13) = (/ & + &2.2059e+04_r8,1.9302e+04_r8,1.6544e+04_r8,1.3787e+04_r8,1.1029e+04_r8,8.2721e+03_r8, & + &5.5147e+03_r8,2.7574e+03_r8,9.2576e-02_r8/) + kao(:, 5, 1,13) = (/ & + &2.6544e+04_r8,2.3226e+04_r8,1.9908e+04_r8,1.6590e+04_r8,1.3272e+04_r8,9.9541e+03_r8, & + &6.6361e+03_r8,3.3180e+03_r8,1.0695e-01_r8/) + kao(:, 1, 2,13) = (/ & + &9.6500e+03_r8,8.4437e+03_r8,7.2375e+03_r8,6.0312e+03_r8,4.8250e+03_r8,3.6187e+03_r8, & + &2.4125e+03_r8,1.2062e+03_r8,3.2200e-01_r8/) + kao(:, 2, 2,13) = (/ & + &1.2735e+04_r8,1.1143e+04_r8,9.5512e+03_r8,7.9593e+03_r8,6.3674e+03_r8,4.7756e+03_r8, & + &3.1837e+03_r8,1.5919e+03_r8,5.1280e+00_r8/) + kao(:, 3, 2,13) = (/ & + &1.6244e+04_r8,1.4213e+04_r8,1.2183e+04_r8,1.0152e+04_r8,8.1218e+03_r8,6.0913e+03_r8, & + &4.0609e+03_r8,2.0304e+03_r8,7.4252e+00_r8/) + kao(:, 4, 2,13) = (/ & + &2.0224e+04_r8,1.7696e+04_r8,1.5168e+04_r8,1.2640e+04_r8,1.0112e+04_r8,7.5839e+03_r8, & + &5.0559e+03_r8,2.5280e+03_r8,7.7282e+00_r8/) + kao(:, 5, 2,13) = (/ & + &2.4645e+04_r8,2.1565e+04_r8,1.8484e+04_r8,1.5403e+04_r8,1.2323e+04_r8,9.2420e+03_r8, & + &6.1614e+03_r8,3.0807e+03_r8,7.1576e+00_r8/) + kao(:, 1, 3,13) = (/ & + &7.8601e+03_r8,6.8776e+03_r8,5.8951e+03_r8,4.9126e+03_r8,3.9300e+03_r8,2.9475e+03_r8, & + &1.9650e+03_r8,9.8251e+02_r8,1.2409e+01_r8/) + kao(:, 2, 3,13) = (/ & + &1.0573e+04_r8,9.2512e+03_r8,7.9296e+03_r8,6.6080e+03_r8,5.2864e+03_r8,3.9648e+03_r8, & + &2.6432e+03_r8,1.3216e+03_r8,1.2422e+01_r8/) + kao(:, 3, 3,13) = (/ & + &1.3794e+04_r8,1.2070e+04_r8,1.0346e+04_r8,8.6214e+03_r8,6.8971e+03_r8,5.1729e+03_r8, & + &3.4486e+03_r8,1.7243e+03_r8,1.2413e+01_r8/) + kao(:, 4, 3,13) = (/ & + &1.7502e+04_r8,1.5315e+04_r8,1.3127e+04_r8,1.0939e+04_r8,8.7512e+03_r8,6.5634e+03_r8, & + &4.3756e+03_r8,2.1878e+03_r8,1.2394e+01_r8/) + kao(:, 5, 3,13) = (/ & + &2.1662e+04_r8,1.8954e+04_r8,1.6247e+04_r8,1.3539e+04_r8,1.0831e+04_r8,8.1233e+03_r8, & + &5.4155e+03_r8,2.7078e+03_r8,1.2358e+01_r8/) + kao(:, 1, 4,13) = (/ & + &6.0906e+03_r8,5.3293e+03_r8,4.5680e+03_r8,3.8067e+03_r8,3.0453e+03_r8,2.2840e+03_r8, & + &1.5227e+03_r8,7.6133e+02_r8,1.4627e+01_r8/) + kao(:, 2, 4,13) = (/ & + &8.4475e+03_r8,7.3915e+03_r8,6.3356e+03_r8,5.2797e+03_r8,4.2237e+03_r8,3.1678e+03_r8, & + &2.1119e+03_r8,1.0559e+03_r8,1.4656e+01_r8/) + kao(:, 3, 4,13) = (/ & + &1.1299e+04_r8,9.8868e+03_r8,8.4744e+03_r8,7.0620e+03_r8,5.6496e+03_r8,4.2372e+03_r8, & + &2.8248e+03_r8,1.4124e+03_r8,1.4666e+01_r8/) + kao(:, 4, 4,13) = (/ & + &1.4605e+04_r8,1.2779e+04_r8,1.0954e+04_r8,9.1282e+03_r8,7.3025e+03_r8,5.4769e+03_r8, & + &3.6513e+03_r8,1.8256e+03_r8,1.4645e+01_r8/) + kao(:, 5, 4,13) = (/ & + &1.8360e+04_r8,1.6065e+04_r8,1.3770e+04_r8,1.1475e+04_r8,9.1801e+03_r8,6.8851e+03_r8, & + &4.5900e+03_r8,2.2950e+03_r8,1.4604e+01_r8/) + kao(:, 1, 5,13) = (/ & + &4.6024e+03_r8,4.0271e+03_r8,3.4518e+03_r8,2.8765e+03_r8,2.3012e+03_r8,1.7259e+03_r8, & + &1.1506e+03_r8,5.7529e+02_r8,1.7191e+01_r8/) + kao(:, 2, 5,13) = (/ & + &6.5855e+03_r8,5.7623e+03_r8,4.9391e+03_r8,4.1159e+03_r8,3.2927e+03_r8,2.4695e+03_r8, & + &1.6464e+03_r8,8.2318e+02_r8,1.7235e+01_r8/) + kao(:, 3, 5,13) = (/ & + &8.9962e+03_r8,7.8717e+03_r8,6.7471e+03_r8,5.6226e+03_r8,4.4981e+03_r8,3.3736e+03_r8, & + &2.2490e+03_r8,1.1245e+03_r8,1.7249e+01_r8/) + kao(:, 4, 5,13) = (/ & + &1.1873e+04_r8,1.0388e+04_r8,8.9044e+03_r8,7.4203e+03_r8,5.9363e+03_r8,4.4522e+03_r8, & + &2.9681e+03_r8,1.4841e+03_r8,1.7236e+01_r8/) + kao(:, 5, 5,13) = (/ & + &1.5203e+04_r8,1.3303e+04_r8,1.1402e+04_r8,9.5020e+03_r8,7.6016e+03_r8,5.7012e+03_r8, & + &3.8008e+03_r8,1.9004e+03_r8,1.7202e+01_r8/) + kao(:, 1, 6,13) = (/ & + &3.3402e+03_r8,2.9227e+03_r8,2.5052e+03_r8,2.0876e+03_r8,1.6701e+03_r8,1.2526e+03_r8, & + &8.3506e+02_r8,4.1753e+02_r8,2.0086e+01_r8/) + kao(:, 2, 6,13) = (/ & + &4.9170e+03_r8,4.3024e+03_r8,3.6877e+03_r8,3.0731e+03_r8,2.4585e+03_r8,1.8439e+03_r8, & + &1.2292e+03_r8,6.1462e+02_r8,2.0160e+01_r8/) + kao(:, 3, 6,13) = (/ & + &6.9136e+03_r8,6.0494e+03_r8,5.1852e+03_r8,4.3210e+03_r8,3.4568e+03_r8,2.5926e+03_r8, & + &1.7284e+03_r8,8.6420e+02_r8,2.0194e+01_r8/) + kao(:, 4, 6,13) = (/ & + &9.3499e+03_r8,8.1811e+03_r8,7.0124e+03_r8,5.8437e+03_r8,4.6749e+03_r8,3.5062e+03_r8, & + &2.3375e+03_r8,1.1687e+03_r8,2.0186e+01_r8/) + kao(:, 5, 6,13) = (/ & + &1.2234e+04_r8,1.0705e+04_r8,9.1755e+03_r8,7.6462e+03_r8,6.1170e+03_r8,4.5877e+03_r8, & + &3.0585e+03_r8,1.5292e+03_r8,2.0149e+01_r8/) + kao(:, 1, 7,13) = (/ & + &2.3634e+03_r8,2.0680e+03_r8,1.7726e+03_r8,1.4771e+03_r8,1.1817e+03_r8,8.8628e+02_r8, & + &5.9086e+02_r8,2.9543e+02_r8,2.3318e+01_r8/) + kao(:, 2, 7,13) = (/ & + &3.6109e+03_r8,3.1596e+03_r8,2.7082e+03_r8,2.2568e+03_r8,1.8055e+03_r8,1.3541e+03_r8, & + &9.0273e+02_r8,4.5136e+02_r8,2.3426e+01_r8/) + kao(:, 3, 7,13) = (/ & + &5.2430e+03_r8,4.5876e+03_r8,3.9322e+03_r8,3.2769e+03_r8,2.6215e+03_r8,1.9661e+03_r8, & + &1.3107e+03_r8,6.5537e+02_r8,2.3476e+01_r8/) + kao(:, 4, 7,13) = (/ & + &7.2754e+03_r8,6.3660e+03_r8,5.4565e+03_r8,4.5471e+03_r8,3.6377e+03_r8,2.7283e+03_r8, & + &1.8188e+03_r8,9.0942e+02_r8,2.3476e+01_r8/) + kao(:, 5, 7,13) = (/ & + &9.7107e+03_r8,8.4968e+03_r8,7.2830e+03_r8,6.0691e+03_r8,4.8553e+03_r8,3.6415e+03_r8, & + &2.4276e+03_r8,1.2138e+03_r8,2.3445e+01_r8/) + kao(:, 1, 8,13) = (/ & + &1.6675e+03_r8,1.4591e+03_r8,1.2506e+03_r8,1.0422e+03_r8,8.3375e+02_r8,6.2531e+02_r8, & + &4.1687e+02_r8,2.0844e+02_r8,2.6870e+01_r8/) + kao(:, 2, 8,13) = (/ & + &2.6544e+03_r8,2.3226e+03_r8,1.9908e+03_r8,1.6590e+03_r8,1.3272e+03_r8,9.9538e+02_r8, & + &6.6359e+02_r8,3.3179e+02_r8,2.6998e+01_r8/) + kao(:, 3, 8,13) = (/ & + &3.9767e+03_r8,3.4797e+03_r8,2.9826e+03_r8,2.4855e+03_r8,1.9884e+03_r8,1.4913e+03_r8, & + &9.9419e+02_r8,4.9709e+02_r8,2.7066e+01_r8/) + kao(:, 4, 8,13) = (/ & + &5.6620e+03_r8,4.9542e+03_r8,4.2465e+03_r8,3.5387e+03_r8,2.8310e+03_r8,2.1232e+03_r8, & + &1.4155e+03_r8,7.0775e+02_r8,2.7083e+01_r8/) + kao(:, 5, 8,13) = (/ & + &7.7334e+03_r8,6.7667e+03_r8,5.8000e+03_r8,4.8334e+03_r8,3.8667e+03_r8,2.9000e+03_r8, & + &1.9333e+03_r8,9.6667e+02_r8,2.7049e+01_r8/) + kao(:, 1, 9,13) = (/ & + &1.1358e+03_r8,9.9378e+02_r8,8.5181e+02_r8,7.0984e+02_r8,5.6787e+02_r8,4.2591e+02_r8, & + &2.8394e+02_r8,1.4197e+02_r8,3.0678e+01_r8/) + kao(:, 2, 9,13) = (/ & + &1.8861e+03_r8,1.6503e+03_r8,1.4146e+03_r8,1.1788e+03_r8,9.4305e+02_r8,7.0729e+02_r8, & + &4.7153e+02_r8,2.3576e+02_r8,3.0840e+01_r8/) + kao(:, 3, 9,13) = (/ & + &2.9209e+03_r8,2.5558e+03_r8,2.1907e+03_r8,1.8256e+03_r8,1.4605e+03_r8,1.0953e+03_r8, & + &7.3023e+02_r8,3.6511e+02_r8,3.0929e+01_r8/) + kao(:, 4, 9,13) = (/ & + &4.2847e+03_r8,3.7491e+03_r8,3.2135e+03_r8,2.6779e+03_r8,2.1424e+03_r8,1.6068e+03_r8, & + &1.0712e+03_r8,5.3559e+02_r8,3.0953e+01_r8/) + kao(:, 5, 9,13) = (/ & + &6.0053e+03_r8,5.2546e+03_r8,4.5040e+03_r8,3.7533e+03_r8,3.0026e+03_r8,2.2520e+03_r8, & + &1.5013e+03_r8,7.5066e+02_r8,3.0913e+01_r8/) + kao(:, 1,10,13) = (/ & + &7.8733e+02_r8,6.8892e+02_r8,5.9050e+02_r8,4.9208e+02_r8,3.9366e+02_r8,2.9525e+02_r8, & + &1.9683e+02_r8,9.8416e+01_r8,3.4699e+01_r8/) + kao(:, 2,10,13) = (/ & + &1.3543e+03_r8,1.1850e+03_r8,1.0157e+03_r8,8.4641e+02_r8,6.7713e+02_r8,5.0785e+02_r8, & + &3.3856e+02_r8,1.6928e+02_r8,3.4872e+01_r8/) + kao(:, 3,10,13) = (/ & + &2.1695e+03_r8,1.8983e+03_r8,1.6271e+03_r8,1.3559e+03_r8,1.0848e+03_r8,8.1356e+02_r8, & + &5.4238e+02_r8,2.7119e+02_r8,3.4962e+01_r8/) + kao(:, 4,10,13) = (/ & + &3.2703e+03_r8,2.8615e+03_r8,2.4527e+03_r8,2.0439e+03_r8,1.6351e+03_r8,1.2263e+03_r8, & + &8.1756e+02_r8,4.0878e+02_r8,3.4974e+01_r8/) + kao(:, 5,10,13) = (/ & + &4.6791e+03_r8,4.0942e+03_r8,3.5093e+03_r8,2.9244e+03_r8,2.3395e+03_r8,1.7546e+03_r8, & + &1.1698e+03_r8,5.8488e+02_r8,3.4915e+01_r8/) + kao(:, 1,11,13) = (/ & + &7.0254e+02_r8,6.1472e+02_r8,5.2690e+02_r8,4.3908e+02_r8,3.5127e+02_r8,2.6345e+02_r8, & + &1.7563e+02_r8,8.8441e+01_r8,3.8867e+01_r8/) + kao(:, 2,11,13) = (/ & + &1.2148e+03_r8,1.0630e+03_r8,9.1111e+02_r8,7.5926e+02_r8,6.0740e+02_r8,4.5555e+02_r8, & + &3.0370e+02_r8,1.5185e+02_r8,3.8999e+01_r8/) + kao(:, 3,11,13) = (/ & + &1.9474e+03_r8,1.7040e+03_r8,1.4606e+03_r8,1.2171e+03_r8,9.7371e+02_r8,7.3028e+02_r8, & + &4.8685e+02_r8,2.4343e+02_r8,3.9046e+01_r8/) + kao(:, 4,11,13) = (/ & + &2.9354e+03_r8,2.5684e+03_r8,2.2015e+03_r8,1.8346e+03_r8,1.4677e+03_r8,1.1008e+03_r8, & + &7.3384e+02_r8,3.6692e+02_r8,3.9009e+01_r8/) + kao(:, 5,11,13) = (/ & + &4.2118e+03_r8,3.6853e+03_r8,3.1589e+03_r8,2.6324e+03_r8,2.1059e+03_r8,1.5794e+03_r8, & + &1.0529e+03_r8,5.2647e+02_r8,3.8898e+01_r8/) + kao(:, 1,12,13) = (/ & + &6.3490e+02_r8,5.5553e+02_r8,4.7617e+02_r8,3.9681e+02_r8,3.1745e+02_r8,2.3809e+02_r8, & + &1.5872e+02_r8,8.3817e+01_r8,4.2920e+01_r8/) + kao(:, 2,12,13) = (/ & + &1.0964e+03_r8,9.5936e+02_r8,8.2231e+02_r8,6.8526e+02_r8,5.4821e+02_r8,4.1116e+02_r8, & + &2.7410e+02_r8,1.3705e+02_r8,4.3006e+01_r8/) + kao(:, 3,12,13) = (/ & + &1.7602e+03_r8,1.5402e+03_r8,1.3202e+03_r8,1.1001e+03_r8,8.8010e+02_r8,6.6008e+02_r8, & + &4.4005e+02_r8,2.2003e+02_r8,4.2996e+01_r8/) + kao(:, 4,12,13) = (/ & + &2.6586e+03_r8,2.3263e+03_r8,1.9940e+03_r8,1.6616e+03_r8,1.3293e+03_r8,9.9698e+02_r8, & + &6.6465e+02_r8,3.3233e+02_r8,4.2901e+01_r8/) + kao(:, 5,12,13) = (/ & + &3.8091e+03_r8,3.3329e+03_r8,2.8568e+03_r8,2.3807e+03_r8,1.9045e+03_r8,1.4284e+03_r8, & + &9.5227e+02_r8,4.7613e+02_r8,4.2723e+01_r8/) + kao(:, 1,13,13) = (/ & + &5.9158e+02_r8,5.1763e+02_r8,4.4368e+02_r8,3.6974e+02_r8,2.9579e+02_r8,2.2184e+02_r8, & + &1.4790e+02_r8,8.4889e+01_r8,4.6678e+01_r8/) + kao(:, 2,13,13) = (/ & + &1.0244e+03_r8,8.9631e+02_r8,7.6827e+02_r8,6.4022e+02_r8,5.1218e+02_r8,3.8414e+02_r8, & + &2.5609e+02_r8,1.2940e+02_r8,4.6683e+01_r8/) + kao(:, 3,13,13) = (/ & + &1.6452e+03_r8,1.4395e+03_r8,1.2339e+03_r8,1.0282e+03_r8,8.2259e+02_r8,6.1694e+02_r8, & + &4.1130e+02_r8,2.0565e+02_r8,4.6592e+01_r8/) + kao(:, 4,13,13) = (/ & + &2.4841e+03_r8,2.1736e+03_r8,1.8631e+03_r8,1.5526e+03_r8,1.2421e+03_r8,9.3154e+02_r8, & + &6.2103e+02_r8,3.1052e+02_r8,4.6412e+01_r8/) + kao(:, 5,13,13) = (/ & + &3.5669e+03_r8,3.1210e+03_r8,2.6752e+03_r8,2.2293e+03_r8,1.7834e+03_r8,1.3376e+03_r8, & + &8.9172e+02_r8,4.4586e+02_r8,4.6169e+01_r8/) + kao(:, 1, 1,14) = (/ & + &2.0814e+04_r8,1.8212e+04_r8,1.5610e+04_r8,1.3008e+04_r8,1.0407e+04_r8,7.8051e+03_r8, & + &5.2034e+03_r8,2.6017e+03_r8,4.7014e-03_r8/) + kao(:, 2, 1,14) = (/ & + &2.6951e+04_r8,2.3582e+04_r8,2.0213e+04_r8,1.6844e+04_r8,1.3475e+04_r8,1.0107e+04_r8, & + &6.7377e+03_r8,3.3688e+03_r8,6.0711e-03_r8/) + kao(:, 3, 1,14) = (/ & + &3.3875e+04_r8,2.9641e+04_r8,2.5406e+04_r8,2.1172e+04_r8,1.6938e+04_r8,1.2703e+04_r8, & + &8.4688e+03_r8,4.2344e+03_r8,2.5176e-02_r8/) + kao(:, 4, 1,14) = (/ & + &4.1606e+04_r8,3.6405e+04_r8,3.1205e+04_r8,2.6004e+04_r8,2.0803e+04_r8,1.5602e+04_r8, & + &1.0402e+04_r8,5.2008e+03_r8,1.0468e-01_r8/) + kao(:, 5, 1,14) = (/ & + &5.0069e+04_r8,4.3810e+04_r8,3.7551e+04_r8,3.1293e+04_r8,2.5034e+04_r8,1.8776e+04_r8, & + &1.2517e+04_r8,6.2586e+03_r8,1.0717e-01_r8/) + kao(:, 1, 2,14) = (/ & + &1.9736e+04_r8,1.7269e+04_r8,1.4802e+04_r8,1.2335e+04_r8,9.8681e+03_r8,7.4011e+03_r8, & + &4.9341e+03_r8,2.4670e+03_r8,1.4424e-01_r8/) + kao(:, 2, 2,14) = (/ & + &2.5938e+04_r8,2.2696e+04_r8,1.9454e+04_r8,1.6211e+04_r8,1.2969e+04_r8,9.7268e+03_r8, & + &6.4845e+03_r8,3.2423e+03_r8,5.4893e+00_r8/) + kao(:, 3, 2,14) = (/ & + &3.3117e+04_r8,2.8978e+04_r8,2.4838e+04_r8,2.0698e+04_r8,1.6559e+04_r8,1.2419e+04_r8, & + &8.2793e+03_r8,4.1397e+03_r8,6.5583e+00_r8/) + kao(:, 4, 2,14) = (/ & + &4.1192e+04_r8,3.6043e+04_r8,3.0894e+04_r8,2.5745e+04_r8,2.0596e+04_r8,1.5447e+04_r8, & + &1.0298e+04_r8,5.1490e+03_r8,7.2955e+00_r8/) + kao(:, 5, 2,14) = (/ & + &5.0084e+04_r8,4.3824e+04_r8,3.7563e+04_r8,3.1303e+04_r8,2.5042e+04_r8,1.8782e+04_r8, & + &1.2521e+04_r8,6.2605e+03_r8,4.5976e+00_r8/) + kao(:, 1, 3,14) = (/ & + &1.7352e+04_r8,1.5183e+04_r8,1.3014e+04_r8,1.0845e+04_r8,8.6759e+03_r8,6.5069e+03_r8, & + &4.3379e+03_r8,2.1690e+03_r8,1.3353e+01_r8/) + kao(:, 2, 3,14) = (/ & + &2.3378e+04_r8,2.0456e+04_r8,1.7533e+04_r8,1.4611e+04_r8,1.1689e+04_r8,8.7667e+03_r8, & + &5.8445e+03_r8,2.9222e+03_r8,1.3389e+01_r8/) + kao(:, 3, 3,14) = (/ & + &3.0448e+04_r8,2.6642e+04_r8,2.2836e+04_r8,1.9030e+04_r8,1.5224e+04_r8,1.1418e+04_r8, & + &7.6119e+03_r8,3.8060e+03_r8,1.3397e+01_r8/) + kao(:, 4, 3,14) = (/ & + &3.8507e+04_r8,3.3693e+04_r8,2.8880e+04_r8,2.4067e+04_r8,1.9253e+04_r8,1.4440e+04_r8, & + &9.6266e+03_r8,4.8133e+03_r8,1.3385e+01_r8/) + kao(:, 5, 3,14) = (/ & + &4.7469e+04_r8,4.1535e+04_r8,3.5602e+04_r8,2.9668e+04_r8,2.3734e+04_r8,1.7801e+04_r8, & + &1.1867e+04_r8,5.9336e+03_r8,1.3346e+01_r8/) + kao(:, 1, 4,14) = (/ & + &1.4631e+04_r8,1.2802e+04_r8,1.0973e+04_r8,9.1445e+03_r8,7.3156e+03_r8,5.4867e+03_r8, & + &3.6578e+03_r8,1.8289e+03_r8,1.5943e+01_r8/) + kao(:, 2, 4,14) = (/ & + &2.0262e+04_r8,1.7729e+04_r8,1.5197e+04_r8,1.2664e+04_r8,1.0131e+04_r8,7.5983e+03_r8, & + &5.0655e+03_r8,2.5328e+03_r8,1.6007e+01_r8/) + kao(:, 3, 4,14) = (/ & + &2.6988e+04_r8,2.3615e+04_r8,2.0241e+04_r8,1.6868e+04_r8,1.3494e+04_r8,1.0121e+04_r8, & + &6.7470e+03_r8,3.3735e+03_r8,1.6031e+01_r8/) + kao(:, 4, 4,14) = (/ & + &3.4853e+04_r8,3.0497e+04_r8,2.6140e+04_r8,2.1783e+04_r8,1.7427e+04_r8,1.3070e+04_r8, & + &8.7133e+03_r8,4.3567e+03_r8,1.6028e+01_r8/) + kao(:, 5, 4,14) = (/ & + &4.3821e+04_r8,3.8343e+04_r8,3.2866e+04_r8,2.7388e+04_r8,2.1910e+04_r8,1.6433e+04_r8, & + &1.0955e+04_r8,5.4776e+03_r8,1.6009e+01_r8/) + kao(:, 1, 5,14) = (/ & + &1.2010e+04_r8,1.0509e+04_r8,9.0077e+03_r8,7.5064e+03_r8,6.0051e+03_r8,4.5038e+03_r8, & + &3.0026e+03_r8,1.5013e+03_r8,1.9009e+01_r8/) + kao(:, 2, 5,14) = (/ & + &1.7127e+04_r8,1.4986e+04_r8,1.2846e+04_r8,1.0705e+04_r8,8.5637e+03_r8,6.4228e+03_r8, & + &4.2818e+03_r8,2.1409e+03_r8,1.9111e+01_r8/) + kao(:, 3, 5,14) = (/ & + &2.3449e+04_r8,2.0517e+04_r8,1.7586e+04_r8,1.4655e+04_r8,1.1724e+04_r8,8.7932e+03_r8, & + &5.8621e+03_r8,2.9311e+03_r8,1.9171e+01_r8/) + kao(:, 4, 5,14) = (/ & + &3.0924e+04_r8,2.7059e+04_r8,2.3193e+04_r8,1.9328e+04_r8,1.5462e+04_r8,1.1597e+04_r8, & + &7.7310e+03_r8,3.8655e+03_r8,1.9184e+01_r8/) + kao(:, 5, 5,14) = (/ & + &3.9495e+04_r8,3.4558e+04_r8,2.9621e+04_r8,2.4684e+04_r8,1.9748e+04_r8,1.4811e+04_r8, & + &9.8738e+03_r8,4.9369e+03_r8,1.9172e+01_r8/) + kao(:, 1, 6,14) = (/ & + &9.4628e+03_r8,8.2800e+03_r8,7.0971e+03_r8,5.9142e+03_r8,4.7314e+03_r8,3.5485e+03_r8, & + &2.3657e+03_r8,1.1828e+03_r8,2.2644e+01_r8/) + kao(:, 2, 6,14) = (/ & + &1.3981e+04_r8,1.2233e+04_r8,1.0486e+04_r8,8.7381e+03_r8,6.9905e+03_r8,5.2429e+03_r8, & + &3.4952e+03_r8,1.7476e+03_r8,2.2781e+01_r8/) + kao(:, 3, 6,14) = (/ & + &1.9648e+04_r8,1.7192e+04_r8,1.4736e+04_r8,1.2280e+04_r8,9.8239e+03_r8,7.3679e+03_r8, & + &4.9119e+03_r8,2.4560e+03_r8,2.2869e+01_r8/) + kao(:, 4, 6,14) = (/ & + &2.6483e+04_r8,2.3173e+04_r8,1.9862e+04_r8,1.6552e+04_r8,1.3242e+04_r8,9.9312e+03_r8, & + &6.6208e+03_r8,3.3104e+03_r8,2.2915e+01_r8/) + kao(:, 5, 6,14) = (/ & + &3.4470e+04_r8,3.0161e+04_r8,2.5853e+04_r8,2.1544e+04_r8,1.7235e+04_r8,1.2926e+04_r8, & + &8.6175e+03_r8,4.3088e+03_r8,2.2923e+01_r8/) + kao(:, 1, 7,14) = (/ & + &7.3078e+03_r8,6.3943e+03_r8,5.4808e+03_r8,4.5673e+03_r8,3.6539e+03_r8,2.7404e+03_r8, & + &1.8269e+03_r8,9.1346e+02_r8,2.6896e+01_r8/) + kao(:, 2, 7,14) = (/ & + &1.1178e+04_r8,9.7811e+03_r8,8.3838e+03_r8,6.9865e+03_r8,5.5892e+03_r8,4.1919e+03_r8, & + &2.7946e+03_r8,1.3973e+03_r8,2.7090e+01_r8/) + kao(:, 3, 7,14) = (/ & + &1.6168e+04_r8,1.4147e+04_r8,1.2126e+04_r8,1.0105e+04_r8,8.0839e+03_r8,6.0629e+03_r8, & + &4.0420e+03_r8,2.0210e+03_r8,2.7221e+01_r8/) + kao(:, 4, 7,14) = (/ & + &2.2360e+04_r8,1.9565e+04_r8,1.6770e+04_r8,1.3975e+04_r8,1.1180e+04_r8,8.3848e+03_r8, & + &5.5899e+03_r8,2.7949e+03_r8,2.7298e+01_r8/) + kao(:, 5, 7,14) = (/ & + &2.9827e+04_r8,2.6099e+04_r8,2.2370e+04_r8,1.8642e+04_r8,1.4913e+04_r8,1.1185e+04_r8, & + &7.4567e+03_r8,3.7283e+03_r8,2.7315e+01_r8/) + kao(:, 1, 8,14) = (/ & + &5.5945e+03_r8,4.8952e+03_r8,4.1959e+03_r8,3.4966e+03_r8,2.7972e+03_r8,2.0979e+03_r8, & + &1.3986e+03_r8,6.9931e+02_r8,3.1842e+01_r8/) + kao(:, 2, 8,14) = (/ & + &8.8907e+03_r8,7.7794e+03_r8,6.6680e+03_r8,5.5567e+03_r8,4.4454e+03_r8,3.3340e+03_r8, & + &2.2227e+03_r8,1.1113e+03_r8,3.2101e+01_r8/) + kao(:, 3, 8,14) = (/ & + &1.3296e+04_r8,1.1634e+04_r8,9.9724e+03_r8,8.3103e+03_r8,6.6483e+03_r8,4.9862e+03_r8, & + &3.3241e+03_r8,1.6621e+03_r8,3.2282e+01_r8/) + kao(:, 4, 8,14) = (/ & + &1.8955e+04_r8,1.6586e+04_r8,1.4216e+04_r8,1.1847e+04_r8,9.4776e+03_r8,7.1082e+03_r8, & + &4.7388e+03_r8,2.3694e+03_r8,3.2388e+01_r8/) + kao(:, 5, 8,14) = (/ & + &2.5906e+04_r8,2.2668e+04_r8,1.9430e+04_r8,1.6191e+04_r8,1.2953e+04_r8,9.7149e+03_r8, & + &6.4766e+03_r8,3.2383e+03_r8,3.2425e+01_r8/) + kao(:, 1, 9,14) = (/ & + &4.1067e+03_r8,3.5934e+03_r8,3.0800e+03_r8,2.5667e+03_r8,2.0533e+03_r8,1.5400e+03_r8, & + &1.0267e+03_r8,5.1334e+02_r8,3.7521e+01_r8/) + kao(:, 2, 9,14) = (/ & + &6.8230e+03_r8,5.9701e+03_r8,5.1172e+03_r8,4.2644e+03_r8,3.4115e+03_r8,2.5586e+03_r8, & + &1.7057e+03_r8,8.5287e+02_r8,3.7865e+01_r8/) + kao(:, 3, 9,14) = (/ & + &1.0614e+04_r8,9.2875e+03_r8,7.9607e+03_r8,6.6339e+03_r8,5.3071e+03_r8,3.9804e+03_r8, & + &2.6536e+03_r8,1.3268e+03_r8,3.8104e+01_r8/) + kao(:, 4, 9,14) = (/ & + &1.5585e+04_r8,1.3637e+04_r8,1.1689e+04_r8,9.7408e+03_r8,7.7926e+03_r8,5.8445e+03_r8, & + &3.8963e+03_r8,1.9481e+03_r8,3.8251e+01_r8/) + kao(:, 5, 9,14) = (/ & + &2.1772e+04_r8,1.9051e+04_r8,1.6329e+04_r8,1.3608e+04_r8,1.0886e+04_r8,8.1646e+03_r8, & + &5.4430e+03_r8,2.7215e+03_r8,3.8308e+01_r8/) + kao(:, 1,10,14) = (/ & + &3.0498e+03_r8,2.6686e+03_r8,2.2874e+03_r8,1.9061e+03_r8,1.5249e+03_r8,1.1437e+03_r8, & + &7.6245e+02_r8,3.8122e+02_r8,4.4006e+01_r8/) + kao(:, 2,10,14) = (/ & + &5.3046e+03_r8,4.6415e+03_r8,3.9785e+03_r8,3.3154e+03_r8,2.6523e+03_r8,1.9892e+03_r8, & + &1.3261e+03_r8,6.6307e+02_r8,4.4440e+01_r8/) + kao(:, 3,10,14) = (/ & + &8.5201e+03_r8,7.4551e+03_r8,6.3901e+03_r8,5.3250e+03_r8,4.2600e+03_r8,3.1950e+03_r8, & + &2.1300e+03_r8,1.0650e+03_r8,4.4746e+01_r8/) + kao(:, 4,10,14) = (/ & + &1.2818e+04_r8,1.1216e+04_r8,9.6138e+03_r8,8.0115e+03_r8,6.4092e+03_r8,4.8069e+03_r8, & + &3.2046e+03_r8,1.6023e+03_r8,4.4928e+01_r8/) + kao(:, 5,10,14) = (/ & + &1.8340e+04_r8,1.6048e+04_r8,1.3755e+04_r8,1.1463e+04_r8,9.1701e+03_r8,6.8776e+03_r8, & + &4.5851e+03_r8,2.2925e+03_r8,4.5005e+01_r8/) + kao(:, 1,11,14) = (/ & + &2.9434e+03_r8,2.5755e+03_r8,2.2076e+03_r8,1.8396e+03_r8,1.4717e+03_r8,1.1038e+03_r8, & + &7.3585e+02_r8,3.6793e+02_r8,5.1570e+01_r8/) + kao(:, 2,11,14) = (/ & + &5.1056e+03_r8,4.4674e+03_r8,3.8292e+03_r8,3.1910e+03_r8,2.5528e+03_r8,1.9146e+03_r8, & + &1.2764e+03_r8,6.3819e+02_r8,5.2012e+01_r8/) + kao(:, 3,11,14) = (/ & + &8.1976e+03_r8,7.1728e+03_r8,6.1481e+03_r8,5.1234e+03_r8,4.0987e+03_r8,3.0741e+03_r8, & + &2.0494e+03_r8,1.0247e+03_r8,5.2312e+01_r8/) + kao(:, 4,11,14) = (/ & + &1.2377e+04_r8,1.0830e+04_r8,9.2826e+03_r8,7.7355e+03_r8,6.1884e+03_r8,4.6413e+03_r8, & + &3.0942e+03_r8,1.5471e+03_r8,5.2478e+01_r8/) + kao(:, 5,11,14) = (/ & + &1.7764e+04_r8,1.5544e+04_r8,1.3323e+04_r8,1.1103e+04_r8,8.8820e+03_r8,6.6616e+03_r8, & + &4.4410e+03_r8,2.2205e+03_r8,5.2507e+01_r8/) + kao(:, 1,12,14) = (/ & + &2.8315e+03_r8,2.4776e+03_r8,2.1237e+03_r8,1.7697e+03_r8,1.4158e+03_r8,1.0618e+03_r8, & + &7.0789e+02_r8,3.5394e+02_r8,5.9960e+01_r8/) + kao(:, 2,12,14) = (/ & + &4.9224e+03_r8,4.3071e+03_r8,3.6918e+03_r8,3.0765e+03_r8,2.4612e+03_r8,1.8459e+03_r8, & + &1.2306e+03_r8,6.1530e+02_r8,6.0405e+01_r8/) + kao(:, 3,12,14) = (/ & + &7.9376e+03_r8,6.9454e+03_r8,5.9532e+03_r8,4.9610e+03_r8,3.9688e+03_r8,2.9766e+03_r8, & + &1.9844e+03_r8,9.9220e+02_r8,6.0667e+01_r8/) + kao(:, 4,12,14) = (/ & + &1.2004e+04_r8,1.0504e+04_r8,9.0032e+03_r8,7.5027e+03_r8,6.0021e+03_r8,4.5016e+03_r8, & + &3.0011e+03_r8,1.5005e+03_r8,6.0769e+01_r8/) + kao(:, 5,12,14) = (/ & + &1.7211e+04_r8,1.5059e+04_r8,1.2908e+04_r8,1.0757e+04_r8,8.6054e+03_r8,6.4541e+03_r8, & + &4.3027e+03_r8,2.1514e+03_r8,6.0741e+01_r8/) + kao(:, 1,13,14) = (/ & + &2.8060e+03_r8,2.4552e+03_r8,2.1045e+03_r8,1.7537e+03_r8,1.4030e+03_r8,1.0522e+03_r8, & + &7.0149e+02_r8,3.5075e+02_r8,6.9076e+01_r8/) + kao(:, 2,13,14) = (/ & + &4.9007e+03_r8,4.2881e+03_r8,3.6756e+03_r8,3.0630e+03_r8,2.4504e+03_r8,1.8378e+03_r8, & + &1.2252e+03_r8,6.1260e+02_r8,6.9478e+01_r8/) + kao(:, 3,13,14) = (/ & + &7.8921e+03_r8,6.9056e+03_r8,5.9191e+03_r8,4.9326e+03_r8,3.9460e+03_r8,2.9595e+03_r8, & + &1.9730e+03_r8,9.8652e+02_r8,6.9694e+01_r8/) + kao(:, 4,13,14) = (/ & + &1.1933e+04_r8,1.0441e+04_r8,8.9495e+03_r8,7.4579e+03_r8,5.9663e+03_r8,4.4748e+03_r8, & + &2.9832e+03_r8,1.4916e+03_r8,6.9728e+01_r8/) + kao(:, 5,13,14) = (/ & + &1.7152e+04_r8,1.5008e+04_r8,1.2864e+04_r8,1.0720e+04_r8,8.5759e+03_r8,6.4320e+03_r8, & + &4.2880e+03_r8,2.1440e+03_r8,6.9601e+01_r8/) + kao(:, 1, 1,15) = (/ & + &3.5423e+04_r8,3.0995e+04_r8,2.6567e+04_r8,2.2139e+04_r8,1.7712e+04_r8,1.3284e+04_r8, & + &8.8558e+03_r8,4.4279e+03_r8,7.1610e-03_r8/) + kao(:, 2, 1,15) = (/ & + &4.5820e+04_r8,4.0093e+04_r8,3.4365e+04_r8,2.8638e+04_r8,2.2910e+04_r8,1.7183e+04_r8, & + &1.1455e+04_r8,5.7276e+03_r8,7.1091e-03_r8/) + kao(:, 3, 1,15) = (/ & + &5.7623e+04_r8,5.0421e+04_r8,4.3218e+04_r8,3.6015e+04_r8,2.8812e+04_r8,2.1609e+04_r8, & + &1.4406e+04_r8,7.2029e+03_r8,7.8150e-03_r8/) + kao(:, 4, 1,15) = (/ & + &7.0726e+04_r8,6.1885e+04_r8,5.3044e+04_r8,4.4204e+04_r8,3.5363e+04_r8,2.6522e+04_r8, & + &1.7681e+04_r8,8.8407e+03_r8,4.0966e-02_r8/) + kao(:, 5, 1,15) = (/ & + &8.4947e+04_r8,7.4329e+04_r8,6.3711e+04_r8,5.3092e+04_r8,4.2474e+04_r8,3.1855e+04_r8, & + &2.1237e+04_r8,1.0618e+04_r8,1.7079e-01_r8/) + kao(:, 1, 2,15) = (/ & + &3.6296e+04_r8,3.1759e+04_r8,2.7222e+04_r8,2.2685e+04_r8,1.8148e+04_r8,1.3611e+04_r8, & + &9.0740e+03_r8,4.5370e+03_r8,7.6264e-03_r8/) + kao(:, 2, 2,15) = (/ & + &4.7676e+04_r8,4.1717e+04_r8,3.5757e+04_r8,2.9798e+04_r8,2.3838e+04_r8,1.7879e+04_r8, & + &1.1919e+04_r8,5.9595e+03_r8,7.8530e+00_r8/) + kao(:, 3, 2,15) = (/ & + &6.0722e+04_r8,5.3132e+04_r8,4.5542e+04_r8,3.7951e+04_r8,3.0361e+04_r8,2.2771e+04_r8, & + &1.5181e+04_r8,7.5903e+03_r8,1.1682e+01_r8/) + kao(:, 4, 2,15) = (/ & + &7.5305e+04_r8,6.5892e+04_r8,5.6479e+04_r8,4.7065e+04_r8,3.7652e+04_r8,2.8239e+04_r8, & + &1.8826e+04_r8,9.4131e+03_r8,7.5532e+00_r8/) + kao(:, 5, 2,15) = (/ & + &9.1241e+04_r8,7.9835e+04_r8,6.8430e+04_r8,5.7025e+04_r8,4.5620e+04_r8,3.4215e+04_r8, & + &2.2810e+04_r8,1.1405e+04_r8,1.0957e+00_r8/) + kao(:, 1, 3,15) = (/ & + &3.4715e+04_r8,3.0376e+04_r8,2.6036e+04_r8,2.1697e+04_r8,1.7358e+04_r8,1.3018e+04_r8, & + &8.6788e+03_r8,4.3394e+03_r8,1.4232e+01_r8/) + kao(:, 2, 3,15) = (/ & + &4.6613e+04_r8,4.0787e+04_r8,3.4960e+04_r8,2.9133e+04_r8,2.3307e+04_r8,1.7480e+04_r8, & + &1.1653e+04_r8,5.8267e+03_r8,1.4235e+01_r8/) + kao(:, 3, 3,15) = (/ & + &6.0451e+04_r8,5.2894e+04_r8,4.5338e+04_r8,3.7782e+04_r8,3.0225e+04_r8,2.2669e+04_r8, & + &1.5113e+04_r8,7.5563e+03_r8,1.4209e+01_r8/) + kao(:, 4, 3,15) = (/ & + &7.6104e+04_r8,6.6591e+04_r8,5.7078e+04_r8,4.7565e+04_r8,3.8052e+04_r8,2.8539e+04_r8, & + &1.9026e+04_r8,9.5130e+03_r8,1.4121e+01_r8/) + kao(:, 5, 3,15) = (/ & + &9.3385e+04_r8,8.1712e+04_r8,7.0039e+04_r8,5.8365e+04_r8,4.6692e+04_r8,3.5019e+04_r8, & + &2.3346e+04_r8,1.1673e+04_r8,1.4063e+01_r8/) + kao(:, 1, 4,15) = (/ & + &3.1974e+04_r8,2.7977e+04_r8,2.3981e+04_r8,1.9984e+04_r8,1.5987e+04_r8,1.1990e+04_r8, & + &7.9936e+03_r8,3.9968e+03_r8,1.7130e+01_r8/) + kao(:, 2, 4,15) = (/ & + &4.4033e+04_r8,3.8529e+04_r8,3.3025e+04_r8,2.7521e+04_r8,2.2017e+04_r8,1.6512e+04_r8, & + &1.1008e+04_r8,5.5042e+03_r8,1.7154e+01_r8/) + kao(:, 3, 4,15) = (/ & + &5.8299e+04_r8,5.1012e+04_r8,4.3725e+04_r8,3.6437e+04_r8,2.9150e+04_r8,2.1862e+04_r8, & + &1.4575e+04_r8,7.2874e+03_r8,1.7147e+01_r8/) + kao(:, 4, 4,15) = (/ & + &7.4658e+04_r8,6.5325e+04_r8,5.5993e+04_r8,4.6661e+04_r8,3.7329e+04_r8,2.7997e+04_r8, & + &1.8664e+04_r8,9.3322e+03_r8,1.7125e+01_r8/) + kao(:, 5, 4,15) = (/ & + &9.3061e+04_r8,8.1428e+04_r8,6.9796e+04_r8,5.8163e+04_r8,4.6530e+04_r8,3.4898e+04_r8, & + &2.3265e+04_r8,1.1633e+04_r8,1.7053e+01_r8/) + kao(:, 1, 5,15) = (/ & + &2.8780e+04_r8,2.5183e+04_r8,2.1585e+04_r8,1.7988e+04_r8,1.4390e+04_r8,1.0793e+04_r8, & + &7.1950e+03_r8,3.5975e+03_r8,2.0610e+01_r8/) + kao(:, 2, 5,15) = (/ & + &4.0696e+04_r8,3.5609e+04_r8,3.0522e+04_r8,2.5435e+04_r8,2.0348e+04_r8,1.5261e+04_r8, & + &1.0174e+04_r8,5.0871e+03_r8,2.0673e+01_r8/) + kao(:, 3, 5,15) = (/ & + &5.5132e+04_r8,4.8240e+04_r8,4.1349e+04_r8,3.4457e+04_r8,2.7566e+04_r8,2.0674e+04_r8, & + &1.3783e+04_r8,6.8915e+03_r8,2.0688e+01_r8/) + kao(:, 4, 5,15) = (/ & + &7.2202e+04_r8,6.3177e+04_r8,5.4152e+04_r8,4.5126e+04_r8,3.6101e+04_r8,2.7076e+04_r8, & + &1.8051e+04_r8,9.0253e+03_r8,2.0678e+01_r8/) + kao(:, 5, 5,15) = (/ & + &9.1794e+04_r8,8.0320e+04_r8,6.8846e+04_r8,5.7371e+04_r8,4.5897e+04_r8,3.4423e+04_r8, & + &2.2949e+04_r8,1.1474e+04_r8,2.0627e+01_r8/) + kao(:, 1, 6,15) = (/ & + &2.4928e+04_r8,2.1812e+04_r8,1.8696e+04_r8,1.5580e+04_r8,1.2464e+04_r8,9.3479e+03_r8, & + &6.2319e+03_r8,3.1160e+03_r8,2.4743e+01_r8/) + kao(:, 2, 6,15) = (/ & + &3.6459e+04_r8,3.1902e+04_r8,2.7344e+04_r8,2.2787e+04_r8,1.8230e+04_r8,1.3672e+04_r8, & + &9.1148e+03_r8,4.5574e+03_r8,2.4868e+01_r8/) + kao(:, 3, 6,15) = (/ & + &5.0921e+04_r8,4.4556e+04_r8,3.8191e+04_r8,3.1826e+04_r8,2.5461e+04_r8,1.9095e+04_r8, & + &1.2730e+04_r8,6.3651e+03_r8,2.4935e+01_r8/) + kao(:, 4, 6,15) = (/ & + &6.8337e+04_r8,5.9795e+04_r8,5.1253e+04_r8,4.2711e+04_r8,3.4168e+04_r8,2.5626e+04_r8, & + &1.7084e+04_r8,8.5421e+03_r8,2.4952e+01_r8/) + kao(:, 5, 6,15) = (/ & + &8.8665e+04_r8,7.7582e+04_r8,6.6499e+04_r8,5.5416e+04_r8,4.4333e+04_r8,3.3249e+04_r8, & + &2.2166e+04_r8,1.1083e+04_r8,2.4917e+01_r8/) + kao(:, 1, 7,15) = (/ & + &2.1322e+04_r8,1.8657e+04_r8,1.5992e+04_r8,1.3326e+04_r8,1.0661e+04_r8,7.9957e+03_r8, & + &5.3305e+03_r8,2.6652e+03_r8,2.9665e+01_r8/) + kao(:, 2, 7,15) = (/ & + &3.2413e+04_r8,2.8361e+04_r8,2.4310e+04_r8,2.0258e+04_r8,1.6206e+04_r8,1.2155e+04_r8, & + &8.1031e+03_r8,4.0516e+03_r8,2.9861e+01_r8/) + kao(:, 3, 7,15) = (/ & + &4.6696e+04_r8,4.0859e+04_r8,3.5022e+04_r8,2.9185e+04_r8,2.3348e+04_r8,1.7511e+04_r8, & + &1.1674e+04_r8,5.8369e+03_r8,3.0001e+01_r8/) + kao(:, 4, 7,15) = (/ & + &6.4261e+04_r8,5.6228e+04_r8,4.8195e+04_r8,4.0163e+04_r8,3.2130e+04_r8,2.4098e+04_r8, & + &1.6065e+04_r8,8.0325e+03_r8,3.0074e+01_r8/) + kao(:, 5, 7,15) = (/ & + &8.5103e+04_r8,7.4465e+04_r8,6.3827e+04_r8,5.3189e+04_r8,4.2551e+04_r8,3.1914e+04_r8, & + &2.1276e+04_r8,1.0638e+04_r8,3.0077e+01_r8/) + kao(:, 1, 8,15) = (/ & + &1.8276e+04_r8,1.5991e+04_r8,1.3707e+04_r8,1.1422e+04_r8,9.1380e+03_r8,6.8535e+03_r8, & + &4.5690e+03_r8,2.2845e+03_r8,3.5525e+01_r8/) + kao(:, 2, 8,15) = (/ & + &2.8919e+04_r8,2.5304e+04_r8,2.1689e+04_r8,1.8074e+04_r8,1.4459e+04_r8,1.0845e+04_r8, & + &7.2298e+03_r8,3.6149e+03_r8,3.5844e+01_r8/) + kao(:, 3, 8,15) = (/ & + &4.2999e+04_r8,3.7624e+04_r8,3.2249e+04_r8,2.6874e+04_r8,2.1500e+04_r8,1.6125e+04_r8, & + &1.0750e+04_r8,5.3749e+03_r8,3.6058e+01_r8/) + kao(:, 4, 8,15) = (/ & + &6.0712e+04_r8,5.3123e+04_r8,4.5534e+04_r8,3.7945e+04_r8,3.0356e+04_r8,2.2767e+04_r8, & + &1.5178e+04_r8,7.5890e+03_r8,3.6184e+01_r8/) + kao(:, 5, 8,15) = (/ & + &8.2146e+04_r8,7.1878e+04_r8,6.1610e+04_r8,5.1341e+04_r8,4.1073e+04_r8,3.0805e+04_r8, & + &2.0537e+04_r8,1.0268e+04_r8,3.6243e+01_r8/) + kao(:, 1, 9,15) = (/ & + &1.5122e+04_r8,1.3232e+04_r8,1.1341e+04_r8,9.4512e+03_r8,7.5610e+03_r8,5.6707e+03_r8, & + &3.7805e+03_r8,1.8902e+03_r8,4.2513e+01_r8/) + kao(:, 2, 9,15) = (/ & + &2.4972e+04_r8,2.1851e+04_r8,1.8729e+04_r8,1.5608e+04_r8,1.2486e+04_r8,9.3646e+03_r8, & + &6.2431e+03_r8,3.1215e+03_r8,4.2950e+01_r8/) + kao(:, 3, 9,15) = (/ & + &3.8412e+04_r8,3.3611e+04_r8,2.8809e+04_r8,2.4007e+04_r8,1.9206e+04_r8,1.4404e+04_r8, & + &9.6030e+03_r8,4.8015e+03_r8,4.3278e+01_r8/) + kao(:, 4, 9,15) = (/ & + &5.5843e+04_r8,4.8863e+04_r8,4.1882e+04_r8,3.4902e+04_r8,2.7921e+04_r8,2.0941e+04_r8, & + &1.3961e+04_r8,6.9804e+03_r8,4.3480e+01_r8/) + kao(:, 5, 9,15) = (/ & + &7.7611e+04_r8,6.7910e+04_r8,5.8208e+04_r8,4.8507e+04_r8,3.8805e+04_r8,2.9104e+04_r8, & + &1.9403e+04_r8,9.7013e+03_r8,4.3587e+01_r8/) + kao(:, 1,10,15) = (/ & + &1.2684e+04_r8,1.1099e+04_r8,9.5132e+03_r8,7.9276e+03_r8,6.3421e+03_r8,4.7566e+03_r8, & + &3.1710e+03_r8,1.5855e+03_r8,5.0840e+01_r8/) + kao(:, 2,10,15) = (/ & + &2.1787e+04_r8,1.9064e+04_r8,1.6340e+04_r8,1.3617e+04_r8,1.0893e+04_r8,8.1700e+03_r8, & + &5.4467e+03_r8,2.7233e+03_r8,5.1430e+01_r8/) + kao(:, 3,10,15) = (/ & + &3.4684e+04_r8,3.0349e+04_r8,2.6013e+04_r8,2.1678e+04_r8,1.7342e+04_r8,1.3007e+04_r8, & + &8.6710e+03_r8,4.3355e+03_r8,5.1863e+01_r8/) + kao(:, 4,10,15) = (/ & + &5.1947e+04_r8,4.5454e+04_r8,3.8960e+04_r8,3.2467e+04_r8,2.5974e+04_r8,1.9480e+04_r8, & + &1.2987e+04_r8,6.4934e+03_r8,5.2160e+01_r8/) + kao(:, 5,10,15) = (/ & + &7.3912e+04_r8,6.4673e+04_r8,5.5434e+04_r8,4.6195e+04_r8,3.6956e+04_r8,2.7717e+04_r8, & + &1.8478e+04_r8,9.2389e+03_r8,5.2321e+01_r8/) + kao(:, 1,11,15) = (/ & + &1.3711e+04_r8,1.1997e+04_r8,1.0283e+04_r8,8.5694e+03_r8,6.8555e+03_r8,5.1416e+03_r8, & + &3.4277e+03_r8,1.7139e+03_r8,6.1054e+01_r8/) + kao(:, 2,11,15) = (/ & + &2.3669e+04_r8,2.0711e+04_r8,1.7752e+04_r8,1.4793e+04_r8,1.1835e+04_r8,8.8760e+03_r8, & + &5.9173e+03_r8,2.9586e+03_r8,6.1742e+01_r8/) + kao(:, 3,11,15) = (/ & + &3.7832e+04_r8,3.3103e+04_r8,2.8374e+04_r8,2.3645e+04_r8,1.8916e+04_r8,1.4187e+04_r8, & + &9.4579e+03_r8,4.7289e+03_r8,6.2215e+01_r8/) + kao(:, 4,11,15) = (/ & + &5.6757e+04_r8,4.9662e+04_r8,4.2568e+04_r8,3.5473e+04_r8,2.8378e+04_r8,2.1284e+04_r8, & + &1.4189e+04_r8,7.0945e+03_r8,6.2524e+01_r8/) + kao(:, 5,11,15) = (/ & + &8.0798e+04_r8,7.0698e+04_r8,6.0598e+04_r8,5.0499e+04_r8,4.0399e+04_r8,3.0299e+04_r8, & + &2.0199e+04_r8,1.0100e+04_r8,6.2689e+01_r8/) + kao(:, 1,12,15) = (/ & + &1.4989e+04_r8,1.3115e+04_r8,1.1241e+04_r8,9.3679e+03_r8,7.4943e+03_r8,5.6207e+03_r8, & + &3.7471e+03_r8,1.8736e+03_r8,7.3162e+01_r8/) + kao(:, 2,12,15) = (/ & + &2.5949e+04_r8,2.2705e+04_r8,1.9461e+04_r8,1.6218e+04_r8,1.2974e+04_r8,9.7307e+03_r8, & + &6.4871e+03_r8,3.2436e+03_r8,7.3885e+01_r8/) + kao(:, 3,12,15) = (/ & + &4.1513e+04_r8,3.6324e+04_r8,3.1134e+04_r8,2.5945e+04_r8,2.0756e+04_r8,1.5567e+04_r8, & + &1.0378e+04_r8,5.1891e+03_r8,7.4405e+01_r8/) + kao(:, 4,12,15) = (/ & + &6.2315e+04_r8,5.4526e+04_r8,4.6737e+04_r8,3.8947e+04_r8,3.1158e+04_r8,2.3368e+04_r8, & + &1.5579e+04_r8,7.7894e+03_r8,7.4701e+01_r8/) + kao(:, 5,12,15) = (/ & + &8.8861e+04_r8,7.7754e+04_r8,6.6646e+04_r8,5.5538e+04_r8,4.4431e+04_r8,3.3323e+04_r8, & + &2.2215e+04_r8,1.1108e+04_r8,7.4795e+01_r8/) + kao(:, 1,13,15) = (/ & + &1.6915e+04_r8,1.4801e+04_r8,1.2687e+04_r8,1.0572e+04_r8,8.4577e+03_r8,6.3433e+03_r8, & + &4.2289e+03_r8,2.1144e+03_r8,8.7334e+01_r8/) + kao(:, 2,13,15) = (/ & + &2.9284e+04_r8,2.5624e+04_r8,2.1963e+04_r8,1.8303e+04_r8,1.4642e+04_r8,1.0982e+04_r8, & + &7.3211e+03_r8,3.6605e+03_r8,8.8104e+01_r8/) + kao(:, 3,13,15) = (/ & + &4.6892e+04_r8,4.1031e+04_r8,3.5169e+04_r8,2.9308e+04_r8,2.3446e+04_r8,1.7585e+04_r8, & + &1.1723e+04_r8,5.8616e+03_r8,8.8585e+01_r8/) + kao(:, 4,13,15) = (/ & + &7.0448e+04_r8,6.1642e+04_r8,5.2836e+04_r8,4.4030e+04_r8,3.5224e+04_r8,2.6418e+04_r8, & + &1.7612e+04_r8,8.8061e+03_r8,8.8802e+01_r8/) + kao(:, 5,13,15) = (/ & + &1.0039e+05_r8,8.7843e+04_r8,7.5294e+04_r8,6.2745e+04_r8,5.0196e+04_r8,3.7647e+04_r8, & + &2.5098e+04_r8,1.2549e+04_r8,8.8791e+01_r8/) + kao(:, 1, 1,16) = (/ & + &4.3683e+04_r8,3.8223e+04_r8,3.2762e+04_r8,2.7302e+04_r8,2.1842e+04_r8,1.6381e+04_r8, & + &1.0921e+04_r8,5.4604e+03_r8,7.6073e-03_r8/) + kao(:, 2, 1,16) = (/ & + &5.6813e+04_r8,4.9712e+04_r8,4.2610e+04_r8,3.5508e+04_r8,2.8407e+04_r8,2.1305e+04_r8, & + &1.4203e+04_r8,7.1017e+03_r8,7.6403e-03_r8/) + kao(:, 3, 1,16) = (/ & + &7.1746e+04_r8,6.2777e+04_r8,5.3809e+04_r8,4.4841e+04_r8,3.5873e+04_r8,2.6905e+04_r8, & + &1.7936e+04_r8,8.9682e+03_r8,3.7278e-03_r8/) + kao(:, 4, 1,16) = (/ & + &8.8334e+04_r8,7.7292e+04_r8,6.6250e+04_r8,5.5209e+04_r8,4.4167e+04_r8,3.3125e+04_r8, & + &2.2083e+04_r8,1.1042e+04_r8,3.7292e-03_r8/) + kao(:, 5, 1,16) = (/ & + &1.0639e+05_r8,9.3091e+04_r8,7.9793e+04_r8,6.6494e+04_r8,5.3195e+04_r8,3.9896e+04_r8, & + &2.6598e+04_r8,1.3299e+04_r8,7.8826e-01_r8/) + kao(:, 1, 2,16) = (/ & + &4.6897e+04_r8,4.1035e+04_r8,3.5173e+04_r8,2.9311e+04_r8,2.3449e+04_r8,1.7586e+04_r8, & + &1.1724e+04_r8,5.8622e+03_r8,8.2408e-03_r8/) + kao(:, 2, 2,16) = (/ & + &6.1887e+04_r8,5.4151e+04_r8,4.6415e+04_r8,3.8679e+04_r8,3.0943e+04_r8,2.3208e+04_r8, & + &1.5472e+04_r8,7.7359e+03_r8,1.2063e+01_r8/) + kao(:, 3, 2,16) = (/ & + &7.9108e+04_r8,6.9219e+04_r8,5.9331e+04_r8,4.9442e+04_r8,3.9554e+04_r8,2.9666e+04_r8, & + &1.9777e+04_r8,9.8885e+03_r8,1.1743e+01_r8/) + kao(:, 4, 2,16) = (/ & + &9.8415e+04_r8,8.6113e+04_r8,7.3811e+04_r8,6.1509e+04_r8,4.9207e+04_r8,3.6906e+04_r8, & + &2.4604e+04_r8,1.2302e+04_r8,3.5693e-03_r8/) + kao(:, 5, 2,16) = (/ & + &1.1961e+05_r8,1.0466e+05_r8,8.9707e+04_r8,7.4755e+04_r8,5.9804e+04_r8,4.4853e+04_r8, & + &2.9902e+04_r8,1.4951e+04_r8,5.8824e-01_r8/) + kao(:, 1, 3,16) = (/ & + &4.7187e+04_r8,4.1289e+04_r8,3.5390e+04_r8,2.9492e+04_r8,2.3594e+04_r8,1.7695e+04_r8, & + &1.1797e+04_r8,5.8984e+03_r8,1.4554e+01_r8/) + kao(:, 2, 3,16) = (/ & + &6.3662e+04_r8,5.5704e+04_r8,4.7746e+04_r8,3.9789e+04_r8,3.1831e+04_r8,2.3873e+04_r8, & + &1.5915e+04_r8,7.9577e+03_r8,1.4573e+01_r8/) + kao(:, 3, 3,16) = (/ & + &8.2931e+04_r8,7.2565e+04_r8,6.2198e+04_r8,5.1832e+04_r8,4.1465e+04_r8,3.1099e+04_r8, & + &2.0733e+04_r8,1.0366e+04_r8,1.4578e+01_r8/) + kao(:, 4, 3,16) = (/ & + &1.0484e+05_r8,9.1735e+04_r8,7.8630e+04_r8,6.5525e+04_r8,5.2420e+04_r8,3.9315e+04_r8, & + &2.6210e+04_r8,1.3105e+04_r8,1.4538e+01_r8/) + kao(:, 5, 3,16) = (/ & + &1.2920e+05_r8,1.1305e+05_r8,9.6898e+04_r8,8.0748e+04_r8,6.4599e+04_r8,4.8449e+04_r8, & + &3.2299e+04_r8,1.6150e+04_r8,1.4475e+01_r8/) + kao(:, 1, 4,16) = (/ & + &4.6077e+04_r8,4.0317e+04_r8,3.4558e+04_r8,2.8798e+04_r8,2.3038e+04_r8,1.7279e+04_r8, & + &1.1519e+04_r8,5.7596e+03_r8,1.7584e+01_r8/) + kao(:, 2, 4,16) = (/ & + &6.3824e+04_r8,5.5846e+04_r8,4.7868e+04_r8,3.9890e+04_r8,3.1912e+04_r8,2.3934e+04_r8, & + &1.5956e+04_r8,7.9779e+03_r8,1.7639e+01_r8/) + kao(:, 3, 4,16) = (/ & + &8.4999e+04_r8,7.4374e+04_r8,6.3749e+04_r8,5.3124e+04_r8,4.2499e+04_r8,3.1874e+04_r8, & + &2.1250e+04_r8,1.0625e+04_r8,1.7665e+01_r8/) + kao(:, 4, 4,16) = (/ & + &1.0949e+05_r8,9.5804e+04_r8,8.2118e+04_r8,6.8432e+04_r8,5.4745e+04_r8,4.1059e+04_r8, & + &2.7373e+04_r8,1.3686e+04_r8,1.7655e+01_r8/) + kao(:, 5, 4,16) = (/ & + &1.3706e+05_r8,1.1993e+05_r8,1.0280e+05_r8,8.5665e+04_r8,6.8532e+04_r8,5.1399e+04_r8, & + &3.4266e+04_r8,1.7133e+04_r8,1.7601e+01_r8/) + kao(:, 1, 5,16) = (/ & + &4.4408e+04_r8,3.8857e+04_r8,3.3306e+04_r8,2.7755e+04_r8,2.2204e+04_r8,1.6653e+04_r8, & + &1.1102e+04_r8,5.5509e+03_r8,2.1257e+01_r8/) + kao(:, 2, 5,16) = (/ & + &6.3274e+04_r8,5.5364e+04_r8,4.7455e+04_r8,3.9546e+04_r8,3.1637e+04_r8,2.3728e+04_r8, & + &1.5818e+04_r8,7.9092e+03_r8,2.1367e+01_r8/) + kao(:, 3, 5,16) = (/ & + &8.6266e+04_r8,7.5483e+04_r8,6.4700e+04_r8,5.3916e+04_r8,4.3133e+04_r8,3.2350e+04_r8, & + &2.1567e+04_r8,1.0783e+04_r8,2.1428e+01_r8/) + kao(:, 4, 5,16) = (/ & + &1.1336e+05_r8,9.9194e+04_r8,8.5023e+04_r8,7.0853e+04_r8,5.6682e+04_r8,4.2512e+04_r8, & + &2.8341e+04_r8,1.4171e+04_r8,2.1442e+01_r8/) + kao(:, 5, 5,16) = (/ & + &1.4437e+05_r8,1.2632e+05_r8,1.0827e+05_r8,9.0229e+04_r8,7.2183e+04_r8,5.4137e+04_r8, & + &3.6091e+04_r8,1.8046e+04_r8,2.1411e+01_r8/) + kao(:, 1, 6,16) = (/ & + &4.1622e+04_r8,3.6419e+04_r8,3.1217e+04_r8,2.6014e+04_r8,2.0811e+04_r8,1.5608e+04_r8, & + &1.0406e+04_r8,5.2028e+03_r8,2.5704e+01_r8/) + kao(:, 2, 6,16) = (/ & + &6.1272e+04_r8,5.3613e+04_r8,4.5954e+04_r8,3.8295e+04_r8,3.0636e+04_r8,2.2977e+04_r8, & + &1.5318e+04_r8,7.6590e+03_r8,2.5880e+01_r8/) + kao(:, 3, 6,16) = (/ & + &8.5823e+04_r8,7.5095e+04_r8,6.4367e+04_r8,5.3639e+04_r8,4.2911e+04_r8,3.2183e+04_r8, & + &2.1456e+04_r8,1.0728e+04_r8,2.5988e+01_r8/) + kao(:, 4, 6,16) = (/ & + &1.1534e+05_r8,1.0092e+05_r8,8.6501e+04_r8,7.2084e+04_r8,5.7667e+04_r8,4.3251e+04_r8, & + &2.8834e+04_r8,1.4417e+04_r8,2.6050e+01_r8/) + kao(:, 5, 6,16) = (/ & + &1.4970e+05_r8,1.3098e+05_r8,1.1227e+05_r8,9.3560e+04_r8,7.4848e+04_r8,5.6136e+04_r8, & + &3.7424e+04_r8,1.8712e+04_r8,2.6033e+01_r8/) + kao(:, 1, 7,16) = (/ & + &3.8762e+04_r8,3.3917e+04_r8,2.9071e+04_r8,2.4226e+04_r8,1.9381e+04_r8,1.4536e+04_r8, & + &9.6904e+03_r8,4.8452e+03_r8,3.1098e+01_r8/) + kao(:, 2, 7,16) = (/ & + &5.9114e+04_r8,5.1725e+04_r8,4.4335e+04_r8,3.6946e+04_r8,2.9557e+04_r8,2.2168e+04_r8, & + &1.4778e+04_r8,7.3892e+03_r8,3.1343e+01_r8/) + kao(:, 3, 7,16) = (/ & + &8.5273e+04_r8,7.4614e+04_r8,6.3955e+04_r8,5.3296e+04_r8,4.2636e+04_r8,3.1977e+04_r8, & + &2.1318e+04_r8,1.0659e+04_r8,3.1509e+01_r8/) + kao(:, 4, 7,16) = (/ & + &1.1738e+05_r8,1.0271e+05_r8,8.8034e+04_r8,7.3362e+04_r8,5.8689e+04_r8,4.4017e+04_r8, & + &2.9345e+04_r8,1.4672e+04_r8,3.1622e+01_r8/) + kao(:, 5, 7,16) = (/ & + &1.5542e+05_r8,1.3599e+05_r8,1.1657e+05_r8,9.7138e+04_r8,7.7710e+04_r8,5.8283e+04_r8, & + &3.8855e+04_r8,1.9427e+04_r8,3.1655e+01_r8/) + kao(:, 1, 8,16) = (/ & + &3.6377e+04_r8,3.1830e+04_r8,2.7279e+04_r8,2.2736e+04_r8,1.8189e+04_r8,1.3641e+04_r8, & + &9.0943e+03_r8,4.5472e+03_r8,3.7610e+01_r8/) + kao(:, 2, 8,16) = (/ & + &5.7649e+04_r8,5.0443e+04_r8,4.3237e+04_r8,3.6031e+04_r8,2.8825e+04_r8,2.1619e+04_r8, & + &1.4412e+04_r8,7.2062e+03_r8,3.7934e+01_r8/) + kao(:, 3, 8,16) = (/ & + &8.5747e+04_r8,7.5029e+04_r8,6.4311e+04_r8,5.3592e+04_r8,4.2874e+04_r8,3.2155e+04_r8, & + &2.1437e+04_r8,1.0718e+04_r8,3.8193e+01_r8/) + kao(:, 4, 8,16) = (/ & + &1.2106e+05_r8,1.0593e+05_r8,9.0796e+04_r8,7.5663e+04_r8,6.0531e+04_r8,4.5398e+04_r8, & + &3.0265e+04_r8,1.5133e+04_r8,3.8356e+01_r8/) + kao(:, 5, 8,16) = (/ & + &1.6369e+05_r8,1.4323e+05_r8,1.2277e+05_r8,1.0231e+05_r8,8.1844e+04_r8,6.1383e+04_r8, & + &4.0922e+04_r8,2.0461e+04_r8,3.8437e+01_r8/) + kao(:, 1, 9,16) = (/ & + &3.3210e+04_r8,2.9058e+04_r8,2.4907e+04_r8,2.0756e+04_r8,1.6605e+04_r8,1.2454e+04_r8, & + &8.3024e+03_r8,4.1512e+03_r8,4.5425e+01_r8/) + kao(:, 2, 9,16) = (/ & + &5.4859e+04_r8,4.8001e+04_r8,4.1144e+04_r8,3.4287e+04_r8,2.7429e+04_r8,2.0572e+04_r8, & + &1.3715e+04_r8,6.8573e+03_r8,4.5889e+01_r8/) + kao(:, 3, 9,16) = (/ & + &8.4365e+04_r8,7.3820e+04_r8,6.3274e+04_r8,5.2728e+04_r8,4.2183e+04_r8,3.1637e+04_r8, & + &2.1091e+04_r8,1.0546e+04_r8,4.6246e+01_r8/) + kao(:, 4, 9,16) = (/ & + &1.2241e+05_r8,1.0711e+05_r8,9.1805e+04_r8,7.6504e+04_r8,6.1203e+04_r8,4.5902e+04_r8, & + &3.0602e+04_r8,1.5301e+04_r8,4.6486e+01_r8/) + kao(:, 5, 9,16) = (/ & + &1.6922e+05_r8,1.4806e+05_r8,1.2691e+05_r8,1.0576e+05_r8,8.4608e+04_r8,6.3456e+04_r8, & + &4.2304e+04_r8,2.1152e+04_r8,4.6625e+01_r8/) + kao(:, 1,10,16) = (/ & + &3.0979e+04_r8,2.7106e+04_r8,2.3234e+04_r8,1.9362e+04_r8,1.5489e+04_r8,1.1617e+04_r8, & + &7.7447e+03_r8,3.8723e+03_r8,5.4886e+01_r8/) + kao(:, 2,10,16) = (/ & + &5.3196e+04_r8,4.6547e+04_r8,3.9897e+04_r8,3.3248e+04_r8,2.6598e+04_r8,1.9948e+04_r8, & + &1.3299e+04_r8,6.6495e+03_r8,5.5476e+01_r8/) + kao(:, 3,10,16) = (/ & + &8.4341e+04_r8,7.3798e+04_r8,6.3256e+04_r8,5.2713e+04_r8,4.2170e+04_r8,3.1628e+04_r8, & + &2.1085e+04_r8,1.0332e+04_r8,5.5974e+01_r8/) + kao(:, 4,10,16) = (/ & + &1.2535e+05_r8,1.0968e+05_r8,9.4014e+04_r8,7.8345e+04_r8,6.2676e+04_r8,4.7007e+04_r8, & + &3.1338e+04_r8,1.5669e+04_r8,5.6279e+01_r8/) + kao(:, 5,10,16) = (/ & + &1.7674e+05_r8,1.5464e+05_r8,1.3255e+05_r8,1.1046e+05_r8,8.8368e+04_r8,6.6276e+04_r8, & + &4.4184e+04_r8,2.2092e+04_r8,5.6482e+01_r8/) + kao(:, 1,11,16) = (/ & + &3.7488e+04_r8,3.2802e+04_r8,2.8116e+04_r8,2.3430e+04_r8,1.8744e+04_r8,1.4058e+04_r8, & + &9.3718e+03_r8,4.6859e+03_r8,6.6623e+01_r8/) + kao(:, 2,11,16) = (/ & + &6.4180e+04_r8,5.6158e+04_r8,4.8135e+04_r8,4.0112e+04_r8,3.2090e+04_r8,2.4067e+04_r8, & + &1.6045e+04_r8,8.0224e+03_r8,6.7308e+01_r8/) + kao(:, 3,11,16) = (/ & + &1.0143e+05_r8,8.8753e+04_r8,7.6074e+04_r8,6.3395e+04_r8,5.0716e+04_r8,3.8037e+04_r8, & + &2.5358e+04_r8,1.2679e+04_r8,6.7849e+01_r8/) + kao(:, 4,11,16) = (/ & + &1.5034e+05_r8,1.3155e+05_r8,1.1275e+05_r8,9.3961e+04_r8,7.5169e+04_r8,5.6376e+04_r8, & + &3.7584e+04_r8,1.8792e+04_r8,6.8179e+01_r8/) + kao(:, 5,11,16) = (/ & + &2.1140e+05_r8,1.8498e+05_r8,1.5855e+05_r8,1.3213e+05_r8,1.0570e+05_r8,7.9275e+04_r8, & + &5.2850e+04_r8,2.6425e+04_r8,6.8333e+01_r8/) + kao(:, 1,12,16) = (/ & + &4.5641e+04_r8,3.9936e+04_r8,3.4231e+04_r8,2.8526e+04_r8,2.2821e+04_r8,1.7116e+04_r8, & + &1.1410e+04_r8,5.7052e+03_r8,8.0729e+01_r8/) + kao(:, 2,12,16) = (/ & + &7.7843e+04_r8,6.8113e+04_r8,5.8382e+04_r8,4.8652e+04_r8,3.8922e+04_r8,2.9191e+04_r8, & + &1.9461e+04_r8,9.7304e+03_r8,8.1511e+01_r8/) + kao(:, 3,12,16) = (/ & + &1.2264e+05_r8,1.0731e+05_r8,9.1979e+04_r8,7.6649e+04_r8,6.1320e+04_r8,4.5990e+04_r8, & + &3.0660e+04_r8,1.5330e+04_r8,8.2042e+01_r8/) + kao(:, 4,12,16) = (/ & + &1.8173e+05_r8,1.5901e+05_r8,1.3629e+05_r8,1.1358e+05_r8,9.0863e+04_r8,6.8147e+04_r8, & + &4.5431e+04_r8,2.2716e+04_r8,8.2374e+01_r8/) + kao(:, 5,12,16) = (/ & + &2.5615e+05_r8,2.2413e+05_r8,1.9211e+05_r8,1.6009e+05_r8,1.2807e+05_r8,9.6056e+04_r8, & + &6.4037e+04_r8,3.2019e+04_r8,8.2428e+01_r8/) + kao(:, 1,13,16) = (/ & + &5.7163e+04_r8,5.0018e+04_r8,4.2872e+04_r8,3.5727e+04_r8,2.8582e+04_r8,2.1436e+04_r8, & + &1.4291e+04_r8,7.1455e+03_r8,9.7539e+01_r8/) + kao(:, 2,13,16) = (/ & + &9.7458e+04_r8,8.5276e+04_r8,7.3094e+04_r8,6.0911e+04_r8,4.8729e+04_r8,3.6547e+04_r8, & + &2.4365e+04_r8,1.2182e+04_r8,9.8425e+01_r8/) + kao(:, 3,13,16) = (/ & + &1.5404e+05_r8,1.3479e+05_r8,1.1553e+05_r8,9.6277e+04_r8,7.7021e+04_r8,5.7766e+04_r8, & + &3.8511e+04_r8,1.9255e+04_r8,9.8903e+01_r8/) + kao(:, 4,13,16) = (/ & + &2.2887e+05_r8,2.0026e+05_r8,1.7165e+05_r8,1.4304e+05_r8,1.1444e+05_r8,8.5827e+04_r8, & + &5.7218e+04_r8,2.8609e+04_r8,9.9135e+01_r8/) + kao(:, 5,13,16) = (/ & + &3.2310e+05_r8,2.8271e+05_r8,2.4232e+05_r8,2.0194e+05_r8,1.6155e+05_r8,1.2116e+05_r8, & + &8.0775e+04_r8,4.0387e+04_r8,9.9042e+01_r8/) + +! The array KA_Mxx contains the absorption coefficient for +! a minor species at the 16 chosen g-values for a reference pressure +! level below 100~ mb. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! runs over the g-channel (1 to 16). + + kao_mn2( 1, :, 1) = (/ & + & 3.24352e-08_r8, 3.39625e-08_r8, 3.55618e-08_r8, 3.72364e-08_r8, 3.89899e-08_r8, & + & 4.08259e-08_r8, 4.27484e-08_r8, 4.47614e-08_r8, 4.68692e-08_r8, 4.90763e-08_r8, & + & 5.13873e-08_r8, 5.38071e-08_r8, 5.63409e-08_r8, 5.89940e-08_r8, 6.17720e-08_r8, & + & 6.46808e-08_r8, 6.77266e-08_r8, 7.09158e-08_r8, 7.42553e-08_r8/) + kao_mn2( 2, :, 1) = (/ & + & 3.44203e-08_r8, 3.60254e-08_r8, 3.77053e-08_r8, 3.94636e-08_r8, 4.13038e-08_r8, & + & 4.32299e-08_r8, 4.52458e-08_r8, 4.73557e-08_r8, 4.95640e-08_r8, 5.18753e-08_r8, & + & 5.42943e-08_r8, 5.68262e-08_r8, 5.94761e-08_r8, 6.22496e-08_r8, 6.51524e-08_r8, & + & 6.81906e-08_r8, 7.13704e-08_r8, 7.46986e-08_r8, 7.81819e-08_r8/) + kao_mn2( 3, :, 1) = (/ & + & 3.44344e-08_r8, 3.61485e-08_r8, 3.79480e-08_r8, 3.98370e-08_r8, 4.18201e-08_r8, & + & 4.39019e-08_r8, 4.60873e-08_r8, 4.83815e-08_r8, 5.07899e-08_r8, 5.33182e-08_r8, & + & 5.59723e-08_r8, 5.87586e-08_r8, 6.16836e-08_r8, 6.47541e-08_r8, 6.79776e-08_r8, & + & 7.13614e-08_r8, 7.49138e-08_r8, 7.86429e-08_r8, 8.25577e-08_r8/) + kao_mn2( 4, :, 1) = (/ & + & 4.21102e-08_r8, 4.38921e-08_r8, 4.57493e-08_r8, 4.76852e-08_r8, 4.97029e-08_r8, & + & 5.18061e-08_r8, 5.39982e-08_r8, 5.62831e-08_r8, 5.86647e-08_r8, 6.11470e-08_r8, & + & 6.37344e-08_r8, 6.64313e-08_r8, 6.92422e-08_r8, 7.21722e-08_r8, 7.52261e-08_r8, & + & 7.84092e-08_r8, 8.17270e-08_r8, 8.51852e-08_r8, 8.87897e-08_r8/) + kao_mn2( 5, :, 1) = (/ & + & 4.78813e-08_r8, 5.01015e-08_r8, 5.24246e-08_r8, 5.48554e-08_r8, 5.73989e-08_r8, & + & 6.00603e-08_r8, 6.28452e-08_r8, 6.57592e-08_r8, 6.88083e-08_r8, 7.19987e-08_r8, & + & 7.53371e-08_r8, 7.88304e-08_r8, 8.24855e-08_r8, 8.63102e-08_r8, 9.03122e-08_r8, & + & 9.44997e-08_r8, 9.88815e-08_r8, 1.03466e-07_r8, 1.08264e-07_r8/) + kao_mn2( 6, :, 1) = (/ & + & 7.03115e-08_r8, 7.27877e-08_r8, 7.53511e-08_r8, 7.80048e-08_r8, 8.07519e-08_r8, & + & 8.35958e-08_r8, 8.65398e-08_r8, 8.95875e-08_r8, 9.27426e-08_r8, 9.60087e-08_r8, & + & 9.93899e-08_r8, 1.02890e-07_r8, 1.06514e-07_r8, 1.10265e-07_r8, 1.14148e-07_r8, & + & 1.18168e-07_r8, 1.22330e-07_r8, 1.26638e-07_r8, 1.31098e-07_r8/) + kao_mn2( 7, :, 1) = (/ & + & 8.86454e-08_r8, 9.20065e-08_r8, 9.54951e-08_r8, 9.91159e-08_r8, 1.02874e-07_r8, & + & 1.06775e-07_r8, 1.10823e-07_r8, 1.15025e-07_r8, 1.19387e-07_r8, 1.23913e-07_r8, & + & 1.28612e-07_r8, 1.33488e-07_r8, 1.38550e-07_r8, 1.43803e-07_r8, 1.49255e-07_r8, & + & 1.54915e-07_r8, 1.60788e-07_r8, 1.66885e-07_r8, 1.73213e-07_r8/) + kao_mn2( 8, :, 1) = (/ & + & 1.34118e-07_r8, 1.38267e-07_r8, 1.42545e-07_r8, 1.46955e-07_r8, 1.51502e-07_r8, & + & 1.56189e-07_r8, 1.61022e-07_r8, 1.66004e-07_r8, 1.71140e-07_r8, 1.76435e-07_r8, & + & 1.81893e-07_r8, 1.87521e-07_r8, 1.93323e-07_r8, 1.99304e-07_r8, 2.05470e-07_r8, & + & 2.11827e-07_r8, 2.18381e-07_r8, 2.25138e-07_r8, 2.32103e-07_r8/) + kao_mn2( 9, :, 1) = (/ & + & 5.08256e-08_r8, 5.30384e-08_r8, 5.53476e-08_r8, 5.77573e-08_r8, 6.02718e-08_r8, & + & 6.28959e-08_r8, 6.56342e-08_r8, 6.84917e-08_r8, 7.14737e-08_r8, 7.45854e-08_r8, & + & 7.78327e-08_r8, 8.12213e-08_r8, 8.47574e-08_r8, 8.84475e-08_r8, 9.22983e-08_r8, & + & 9.63167e-08_r8, 1.00510e-07_r8, 1.04886e-07_r8, 1.09452e-07_r8/) + kao_mn2( 1, :, 2) = (/ & + & 8.23958e-08_r8, 8.39092e-08_r8, 8.54504e-08_r8, 8.70200e-08_r8, 8.86183e-08_r8, & + & 9.02460e-08_r8, 9.19036e-08_r8, 9.35917e-08_r8, 9.53107e-08_r8, 9.70614e-08_r8, & + & 9.88442e-08_r8, 1.00660e-07_r8, 1.02509e-07_r8, 1.04391e-07_r8, 1.06309e-07_r8, & + & 1.08261e-07_r8, 1.10250e-07_r8, 1.12275e-07_r8, 1.14337e-07_r8/) + kao_mn2( 2, :, 2) = (/ & + & 8.52335e-08_r8, 8.69254e-08_r8, 8.86509e-08_r8, 9.04107e-08_r8, 9.22054e-08_r8, & + & 9.40357e-08_r8, 9.59024e-08_r8, 9.78061e-08_r8, 9.97476e-08_r8, 1.01728e-07_r8, & + & 1.03747e-07_r8, 1.05806e-07_r8, 1.07907e-07_r8, 1.10049e-07_r8, 1.12233e-07_r8, & + & 1.14461e-07_r8, 1.16733e-07_r8, 1.19050e-07_r8, 1.21414e-07_r8/) + kao_mn2( 3, :, 2) = (/ & + & 1.04608e-07_r8, 1.06067e-07_r8, 1.07546e-07_r8, 1.09046e-07_r8, 1.10567e-07_r8, & + & 1.12110e-07_r8, 1.13673e-07_r8, 1.15259e-07_r8, 1.16866e-07_r8, 1.18496e-07_r8, & + & 1.20149e-07_r8, 1.21825e-07_r8, 1.23524e-07_r8, 1.25247e-07_r8, 1.26994e-07_r8, & + & 1.28765e-07_r8, 1.30561e-07_r8, 1.32382e-07_r8, 1.34229e-07_r8/) + kao_mn2( 4, :, 2) = (/ & + & 1.17504e-07_r8, 1.18763e-07_r8, 1.20036e-07_r8, 1.21322e-07_r8, 1.22622e-07_r8, & + & 1.23936e-07_r8, 1.25265e-07_r8, 1.26607e-07_r8, 1.27964e-07_r8, 1.29335e-07_r8, & + & 1.30721e-07_r8, 1.32122e-07_r8, 1.33538e-07_r8, 1.34969e-07_r8, 1.36415e-07_r8, & + & 1.37877e-07_r8, 1.39354e-07_r8, 1.40848e-07_r8, 1.42357e-07_r8/) + kao_mn2( 5, :, 2) = (/ & + & 1.23552e-07_r8, 1.25200e-07_r8, 1.26870e-07_r8, 1.28562e-07_r8, 1.30277e-07_r8, & + & 1.32015e-07_r8, 1.33776e-07_r8, 1.35560e-07_r8, 1.37368e-07_r8, 1.39200e-07_r8, & + & 1.41057e-07_r8, 1.42938e-07_r8, 1.44845e-07_r8, 1.46777e-07_r8, 1.48735e-07_r8, & + & 1.50718e-07_r8, 1.52729e-07_r8, 1.54766e-07_r8, 1.56830e-07_r8/) + kao_mn2( 6, :, 2) = (/ & + & 1.29682e-07_r8, 1.32226e-07_r8, 1.34820e-07_r8, 1.37464e-07_r8, 1.40161e-07_r8, & + & 1.42910e-07_r8, 1.45713e-07_r8, 1.48571e-07_r8, 1.51486e-07_r8, 1.54457e-07_r8, & + & 1.57487e-07_r8, 1.60576e-07_r8, 1.63726e-07_r8, 1.66937e-07_r8, 1.70212e-07_r8, & + & 1.73551e-07_r8, 1.76955e-07_r8, 1.80426e-07_r8, 1.83965e-07_r8/) + kao_mn2( 7, :, 2) = (/ & + & 1.77416e-07_r8, 1.78627e-07_r8, 1.79846e-07_r8, 1.81073e-07_r8, 1.82309e-07_r8, & + & 1.83554e-07_r8, 1.84806e-07_r8, 1.86068e-07_r8, 1.87338e-07_r8, 1.88616e-07_r8, & + & 1.89904e-07_r8, 1.91200e-07_r8, 1.92505e-07_r8, 1.93819e-07_r8, 1.95142e-07_r8, & + & 1.96474e-07_r8, 1.97815e-07_r8, 1.99165e-07_r8, 2.00524e-07_r8/) + kao_mn2( 8, :, 2) = (/ & + & 2.20695e-07_r8, 2.20451e-07_r8, 2.20208e-07_r8, 2.19965e-07_r8, 2.19722e-07_r8, & + & 2.19480e-07_r8, 2.19238e-07_r8, 2.18996e-07_r8, 2.18754e-07_r8, 2.18513e-07_r8, & + & 2.18272e-07_r8, 2.18031e-07_r8, 2.17790e-07_r8, 2.17550e-07_r8, 2.17310e-07_r8, & + & 2.17070e-07_r8, 2.16831e-07_r8, 2.16591e-07_r8, 2.16352e-07_r8/) + kao_mn2( 9, :, 2) = (/ & + & 1.23015e-07_r8, 1.24808e-07_r8, 1.26626e-07_r8, 1.28471e-07_r8, 1.30343e-07_r8, & + & 1.32242e-07_r8, 1.34168e-07_r8, 1.36123e-07_r8, 1.38106e-07_r8, 1.40118e-07_r8, & + & 1.42160e-07_r8, 1.44231e-07_r8, 1.46332e-07_r8, 1.48464e-07_r8, 1.50627e-07_r8, & + & 1.52822e-07_r8, 1.55048e-07_r8, 1.57307e-07_r8, 1.59599e-07_r8/) + kao_mn2( 1, :, 3) = (/ & + & 1.87585e-07_r8, 1.89503e-07_r8, 1.91440e-07_r8, 1.93398e-07_r8, 1.95375e-07_r8, & + & 1.97372e-07_r8, 1.99390e-07_r8, 2.01429e-07_r8, 2.03488e-07_r8, 2.05568e-07_r8, & + & 2.07670e-07_r8, 2.09793e-07_r8, 2.11938e-07_r8, 2.14105e-07_r8, 2.16294e-07_r8, & + & 2.18505e-07_r8, 2.20739e-07_r8, 2.22996e-07_r8, 2.25275e-07_r8/) + kao_mn2( 2, :, 3) = (/ & + & 1.82585e-07_r8, 1.84249e-07_r8, 1.85929e-07_r8, 1.87624e-07_r8, 1.89335e-07_r8, & + & 1.91061e-07_r8, 1.92803e-07_r8, 1.94561e-07_r8, 1.96335e-07_r8, 1.98125e-07_r8, & + & 1.99932e-07_r8, 2.01755e-07_r8, 2.03594e-07_r8, 2.05451e-07_r8, 2.07324e-07_r8, & + & 2.09214e-07_r8, 2.11122e-07_r8, 2.13047e-07_r8, 2.14989e-07_r8/) + kao_mn2( 3, :, 3) = (/ & + & 1.64711e-07_r8, 1.67539e-07_r8, 1.70417e-07_r8, 1.73343e-07_r8, 1.76321e-07_r8, & + & 1.79349e-07_r8, 1.82429e-07_r8, 1.85562e-07_r8, 1.88749e-07_r8, 1.91990e-07_r8, & + & 1.95288e-07_r8, 1.98642e-07_r8, 2.02053e-07_r8, 2.05523e-07_r8, 2.09053e-07_r8, & + & 2.12643e-07_r8, 2.16295e-07_r8, 2.20010e-07_r8, 2.23788e-07_r8/) + kao_mn2( 4, :, 3) = (/ & + & 1.67494e-07_r8, 1.71011e-07_r8, 1.74601e-07_r8, 1.78267e-07_r8, 1.82009e-07_r8, & + & 1.85831e-07_r8, 1.89732e-07_r8, 1.93715e-07_r8, 1.97782e-07_r8, 2.01935e-07_r8, & + & 2.06174e-07_r8, 2.10503e-07_r8, 2.14922e-07_r8, 2.19434e-07_r8, 2.24041e-07_r8, & + & 2.28745e-07_r8, 2.33548e-07_r8, 2.38451e-07_r8, 2.43457e-07_r8/) + kao_mn2( 5, :, 3) = (/ & + & 1.97399e-07_r8, 2.00092e-07_r8, 2.02821e-07_r8, 2.05588e-07_r8, 2.08393e-07_r8, & + & 2.11236e-07_r8, 2.14118e-07_r8, 2.17039e-07_r8, 2.20000e-07_r8, 2.23001e-07_r8, & + & 2.26043e-07_r8, 2.29127e-07_r8, 2.32252e-07_r8, 2.35421e-07_r8, 2.38633e-07_r8, & + & 2.41888e-07_r8, 2.45188e-07_r8, 2.48533e-07_r8, 2.51923e-07_r8/) + kao_mn2( 6, :, 3) = (/ & + & 2.24021e-07_r8, 2.24970e-07_r8, 2.25923e-07_r8, 2.26880e-07_r8, 2.27840e-07_r8, & + & 2.28805e-07_r8, 2.29774e-07_r8, 2.30747e-07_r8, 2.31725e-07_r8, 2.32706e-07_r8, & + & 2.33692e-07_r8, 2.34681e-07_r8, 2.35675e-07_r8, 2.36673e-07_r8, 2.37675e-07_r8, & + & 2.38682e-07_r8, 2.39693e-07_r8, 2.40708e-07_r8, 2.41727e-07_r8/) + kao_mn2( 7, :, 3) = (/ & + & 1.98178e-07_r8, 2.00676e-07_r8, 2.03205e-07_r8, 2.05766e-07_r8, 2.08359e-07_r8, & + & 2.10986e-07_r8, 2.13645e-07_r8, 2.16337e-07_r8, 2.19064e-07_r8, 2.21825e-07_r8, & + & 2.24621e-07_r8, 2.27452e-07_r8, 2.30319e-07_r8, 2.33222e-07_r8, 2.36161e-07_r8, & + & 2.39138e-07_r8, 2.42152e-07_r8, 2.45204e-07_r8, 2.48294e-07_r8/) + kao_mn2( 8, :, 3) = (/ & + & 2.83042e-07_r8, 2.89941e-07_r8, 2.97009e-07_r8, 3.04250e-07_r8, 3.11666e-07_r8, & + & 3.19264e-07_r8, 3.27047e-07_r8, 3.35019e-07_r8, 3.43186e-07_r8, 3.51552e-07_r8, & + & 3.60122e-07_r8, 3.68901e-07_r8, 3.77893e-07_r8, 3.87105e-07_r8, 3.96542e-07_r8, & + & 4.06208e-07_r8, 4.16111e-07_r8, 4.26254e-07_r8, 4.36645e-07_r8/) + kao_mn2( 9, :, 3) = (/ & + & 1.98963e-07_r8, 2.01576e-07_r8, 2.04224e-07_r8, 2.06907e-07_r8, 2.09626e-07_r8, & + & 2.12379e-07_r8, 2.15169e-07_r8, 2.17996e-07_r8, 2.20860e-07_r8, 2.23761e-07_r8, & + & 2.26701e-07_r8, 2.29679e-07_r8, 2.32696e-07_r8, 2.35753e-07_r8, 2.38851e-07_r8, & + & 2.41988e-07_r8, 2.45167e-07_r8, 2.48388e-07_r8, 2.51651e-07_r8/) + kao_mn2( 1, :, 4) = (/ & + & 3.75434e-07_r8, 3.79581e-07_r8, 3.83775e-07_r8, 3.88014e-07_r8, 3.92301e-07_r8, & + & 3.96634e-07_r8, 4.01016e-07_r8, 4.05446e-07_r8, 4.09925e-07_r8, 4.14453e-07_r8, & + & 4.19032e-07_r8, 4.23661e-07_r8, 4.28341e-07_r8, 4.33073e-07_r8, 4.37857e-07_r8, & + & 4.42694e-07_r8, 4.47585e-07_r8, 4.52529e-07_r8, 4.57528e-07_r8/) + kao_mn2( 2, :, 4) = (/ & + & 3.76756e-07_r8, 3.80760e-07_r8, 3.84805e-07_r8, 3.88894e-07_r8, 3.93027e-07_r8, & + & 3.97203e-07_r8, 4.01423e-07_r8, 4.05689e-07_r8, 4.10000e-07_r8, 4.14356e-07_r8, & + & 4.18759e-07_r8, 4.23209e-07_r8, 4.27706e-07_r8, 4.32250e-07_r8, 4.36843e-07_r8, & + & 4.41485e-07_r8, 4.46176e-07_r8, 4.50917e-07_r8, 4.55708e-07_r8/) + kao_mn2( 3, :, 4) = (/ & + & 3.76258e-07_r8, 3.78929e-07_r8, 3.81619e-07_r8, 3.84329e-07_r8, 3.87057e-07_r8, & + & 3.89805e-07_r8, 3.92572e-07_r8, 3.95359e-07_r8, 3.98166e-07_r8, 4.00993e-07_r8, & + & 4.03839e-07_r8, 4.06706e-07_r8, 4.09594e-07_r8, 4.12502e-07_r8, 4.15430e-07_r8, & + & 4.18379e-07_r8, 4.21349e-07_r8, 4.24341e-07_r8, 4.27353e-07_r8/) + kao_mn2( 4, :, 4) = (/ & + & 3.17796e-07_r8, 3.22447e-07_r8, 3.27166e-07_r8, 3.31954e-07_r8, 3.36812e-07_r8, & + & 3.41742e-07_r8, 3.46743e-07_r8, 3.51818e-07_r8, 3.56967e-07_r8, 3.62191e-07_r8, & + & 3.67492e-07_r8, 3.72870e-07_r8, 3.78328e-07_r8, 3.83865e-07_r8, 3.89483e-07_r8, & + & 3.95183e-07_r8, 4.00967e-07_r8, 4.06835e-07_r8, 4.12789e-07_r8/) + kao_mn2( 5, :, 4) = (/ & + & 3.33793e-07_r8, 3.38941e-07_r8, 3.44169e-07_r8, 3.49478e-07_r8, 3.54868e-07_r8, & + & 3.60342e-07_r8, 3.65900e-07_r8, 3.71544e-07_r8, 3.77275e-07_r8, 3.83094e-07_r8, & + & 3.89003e-07_r8, 3.95003e-07_r8, 4.01096e-07_r8, 4.07283e-07_r8, 4.13565e-07_r8, & + & 4.19944e-07_r8, 4.26421e-07_r8, 4.32999e-07_r8, 4.39677e-07_r8/) + kao_mn2( 6, :, 4) = (/ & + & 3.60052e-07_r8, 3.66686e-07_r8, 3.73442e-07_r8, 3.80323e-07_r8, 3.87330e-07_r8, & + & 3.94466e-07_r8, 4.01734e-07_r8, 4.09136e-07_r8, 4.16674e-07_r8, 4.24351e-07_r8, & + & 4.32169e-07_r8, 4.40132e-07_r8, 4.48241e-07_r8, 4.56500e-07_r8, 4.64910e-07_r8, & + & 4.73476e-07_r8, 4.82200e-07_r8, 4.91084e-07_r8, 5.00132e-07_r8/) + kao_mn2( 7, :, 4) = (/ & + & 4.14713e-07_r8, 4.21885e-07_r8, 4.29181e-07_r8, 4.36603e-07_r8, 4.44153e-07_r8, & + & 4.51834e-07_r8, 4.59648e-07_r8, 4.67598e-07_r8, 4.75684e-07_r8, 4.83910e-07_r8, & + & 4.92279e-07_r8, 5.00793e-07_r8, 5.09453e-07_r8, 5.18264e-07_r8, 5.27226e-07_r8, & + & 5.36344e-07_r8, 5.45620e-07_r8, 5.55055e-07_r8, 5.64654e-07_r8/) + kao_mn2( 8, :, 4) = (/ & + & 4.15352e-07_r8, 4.24386e-07_r8, 4.33617e-07_r8, 4.43049e-07_r8, 4.52685e-07_r8, & + & 4.62532e-07_r8, 4.72592e-07_r8, 4.82872e-07_r8, 4.93374e-07_r8, 5.04106e-07_r8, & + & 5.15071e-07_r8, 5.26274e-07_r8, 5.37721e-07_r8, 5.49417e-07_r8, 5.61367e-07_r8, & + & 5.73577e-07_r8, 5.86053e-07_r8, 5.98800e-07_r8, 6.11825e-07_r8/) + kao_mn2( 9, :, 4) = (/ & + & 3.33820e-07_r8, 3.39144e-07_r8, 3.44553e-07_r8, 3.50048e-07_r8, 3.55631e-07_r8, & + & 3.61302e-07_r8, 3.67065e-07_r8, 3.72919e-07_r8, 3.78866e-07_r8, 3.84908e-07_r8, & + & 3.91047e-07_r8, 3.97284e-07_r8, 4.03620e-07_r8, 4.10057e-07_r8, 4.16597e-07_r8, & + & 4.23241e-07_r8, 4.29991e-07_r8, 4.36849e-07_r8, 4.43816e-07_r8/) + kao_mn2( 1, :, 5) = (/ & + & 6.99819e-07_r8, 7.04629e-07_r8, 7.09472e-07_r8, 7.14349e-07_r8, 7.19258e-07_r8, & + & 7.24202e-07_r8, 7.29180e-07_r8, 7.34192e-07_r8, 7.39238e-07_r8, 7.44319e-07_r8, & + & 7.49435e-07_r8, 7.54586e-07_r8, 7.59773e-07_r8, 7.64995e-07_r8, 7.70253e-07_r8, & + & 7.75547e-07_r8, 7.80877e-07_r8, 7.86245e-07_r8, 7.91649e-07_r8/) + kao_mn2( 2, :, 5) = (/ & + & 6.98257e-07_r8, 7.03182e-07_r8, 7.08143e-07_r8, 7.13138e-07_r8, 7.18169e-07_r8, & + & 7.23235e-07_r8, 7.28336e-07_r8, 7.33474e-07_r8, 7.38648e-07_r8, 7.43858e-07_r8, & + & 7.49106e-07_r8, 7.54390e-07_r8, 7.59711e-07_r8, 7.65071e-07_r8, 7.70467e-07_r8, & + & 7.75902e-07_r8, 7.81376e-07_r8, 7.86887e-07_r8, 7.92438e-07_r8/) + kao_mn2( 3, :, 5) = (/ & + & 6.98531e-07_r8, 7.03429e-07_r8, 7.08361e-07_r8, 7.13328e-07_r8, 7.18329e-07_r8, & + & 7.23365e-07_r8, 7.28437e-07_r8, 7.33545e-07_r8, 7.38688e-07_r8, 7.43867e-07_r8, & + & 7.49082e-07_r8, 7.54335e-07_r8, 7.59623e-07_r8, 7.64950e-07_r8, 7.70313e-07_r8, & + & 7.75714e-07_r8, 7.81153e-07_r8, 7.86630e-07_r8, 7.92145e-07_r8/) + kao_mn2( 4, :, 5) = (/ & + & 7.37210e-07_r8, 7.38869e-07_r8, 7.40532e-07_r8, 7.42198e-07_r8, 7.43868e-07_r8, & + & 7.45542e-07_r8, 7.47219e-07_r8, 7.48901e-07_r8, 7.50586e-07_r8, 7.52275e-07_r8, & + & 7.53967e-07_r8, 7.55664e-07_r8, 7.57364e-07_r8, 7.59068e-07_r8, 7.60777e-07_r8, & + & 7.62488e-07_r8, 7.64204e-07_r8, 7.65924e-07_r8, 7.67647e-07_r8/) + kao_mn2( 5, :, 5) = (/ & + & 6.07063e-07_r8, 6.12893e-07_r8, 6.18779e-07_r8, 6.24722e-07_r8, 6.30721e-07_r8, & + & 6.36778e-07_r8, 6.42893e-07_r8, 6.49067e-07_r8, 6.55301e-07_r8, 6.61594e-07_r8, & + & 6.67947e-07_r8, 6.74362e-07_r8, 6.80838e-07_r8, 6.87376e-07_r8, 6.93978e-07_r8, & + & 7.00642e-07_r8, 7.07371e-07_r8, 7.14164e-07_r8, 7.21022e-07_r8/) + kao_mn2( 6, :, 5) = (/ & + & 6.13354e-07_r8, 6.20147e-07_r8, 6.27016e-07_r8, 6.33961e-07_r8, 6.40983e-07_r8, & + & 6.48082e-07_r8, 6.55260e-07_r8, 6.62518e-07_r8, 6.69856e-07_r8, 6.77276e-07_r8, & + & 6.84777e-07_r8, 6.92362e-07_r8, 7.00030e-07_r8, 7.07784e-07_r8, 7.15624e-07_r8, & + & 7.23550e-07_r8, 7.31564e-07_r8, 7.39667e-07_r8, 7.47859e-07_r8/) + kao_mn2( 7, :, 5) = (/ & + & 6.86666e-07_r8, 6.92902e-07_r8, 6.99195e-07_r8, 7.05545e-07_r8, 7.11952e-07_r8, & + & 7.18418e-07_r8, 7.24943e-07_r8, 7.31526e-07_r8, 7.38170e-07_r8, 7.44874e-07_r8, & + & 7.51639e-07_r8, 7.58465e-07_r8, 7.65353e-07_r8, 7.72304e-07_r8, 7.79318e-07_r8, & + & 7.86395e-07_r8, 7.93537e-07_r8, 8.00744e-07_r8, 8.08016e-07_r8/) + kao_mn2( 8, :, 5) = (/ & + & 9.39664e-07_r8, 9.39765e-07_r8, 9.39866e-07_r8, 9.39966e-07_r8, 9.40067e-07_r8, & + & 9.40168e-07_r8, 9.40268e-07_r8, 9.40369e-07_r8, 9.40470e-07_r8, 9.40571e-07_r8, & + & 9.40671e-07_r8, 9.40772e-07_r8, 9.40873e-07_r8, 9.40974e-07_r8, 9.41074e-07_r8, & + & 9.41175e-07_r8, 9.41276e-07_r8, 9.41377e-07_r8, 9.41478e-07_r8/) + kao_mn2( 9, :, 5) = (/ & + & 6.02847e-07_r8, 6.09726e-07_r8, 6.16684e-07_r8, 6.23722e-07_r8, 6.30839e-07_r8, & + & 6.38038e-07_r8, 6.45320e-07_r8, 6.52684e-07_r8, 6.60132e-07_r8, 6.67665e-07_r8, & + & 6.75284e-07_r8, 6.82991e-07_r8, 6.90785e-07_r8, 6.98668e-07_r8, 7.06641e-07_r8, & + & 7.14705e-07_r8, 7.22861e-07_r8, 7.31110e-07_r8, 7.39453e-07_r8/) + kao_mn2( 1, :, 6) = (/ & + & 1.13692e-06_r8, 1.13231e-06_r8, 1.12772e-06_r8, 1.12315e-06_r8, 1.11859e-06_r8, & + & 1.11406e-06_r8, 1.10954e-06_r8, 1.10505e-06_r8, 1.10057e-06_r8, 1.09610e-06_r8, & + & 1.09166e-06_r8, 1.08724e-06_r8, 1.08283e-06_r8, 1.07844e-06_r8, 1.07407e-06_r8, & + & 1.06971e-06_r8, 1.06538e-06_r8, 1.06106e-06_r8, 1.05676e-06_r8/) + kao_mn2( 2, :, 6) = (/ & + & 1.13682e-06_r8, 1.13221e-06_r8, 1.12762e-06_r8, 1.12305e-06_r8, 1.11849e-06_r8, & + & 1.11396e-06_r8, 1.10944e-06_r8, 1.10495e-06_r8, 1.10047e-06_r8, 1.09600e-06_r8, & + & 1.09156e-06_r8, 1.08714e-06_r8, 1.08273e-06_r8, 1.07834e-06_r8, 1.07397e-06_r8, & + & 1.06961e-06_r8, 1.06528e-06_r8, 1.06096e-06_r8, 1.05666e-06_r8/) + kao_mn2( 3, :, 6) = (/ & + & 1.13642e-06_r8, 1.13181e-06_r8, 1.12722e-06_r8, 1.12265e-06_r8, 1.11809e-06_r8, & + & 1.11356e-06_r8, 1.10904e-06_r8, 1.10455e-06_r8, 1.10007e-06_r8, 1.09560e-06_r8, & + & 1.09116e-06_r8, 1.08674e-06_r8, 1.08233e-06_r8, 1.07794e-06_r8, 1.07357e-06_r8, & + & 1.06921e-06_r8, 1.06488e-06_r8, 1.06056e-06_r8, 1.05626e-06_r8/) + kao_mn2( 4, :, 6) = (/ & + & 1.13626e-06_r8, 1.13160e-06_r8, 1.12696e-06_r8, 1.12233e-06_r8, 1.11773e-06_r8, & + & 1.11314e-06_r8, 1.10858e-06_r8, 1.10403e-06_r8, 1.09950e-06_r8, 1.09498e-06_r8, & + & 1.09049e-06_r8, 1.08602e-06_r8, 1.08156e-06_r8, 1.07712e-06_r8, 1.07270e-06_r8, & + & 1.06830e-06_r8, 1.06392e-06_r8, 1.05955e-06_r8, 1.05520e-06_r8/) + kao_mn2( 5, :, 6) = (/ & + & 1.22429e-06_r8, 1.21163e-06_r8, 1.19909e-06_r8, 1.18669e-06_r8, 1.17441e-06_r8, & + & 1.16226e-06_r8, 1.15024e-06_r8, 1.13834e-06_r8, 1.12656e-06_r8, 1.11491e-06_r8, & + & 1.10338e-06_r8, 1.09196e-06_r8, 1.08067e-06_r8, 1.06949e-06_r8, 1.05842e-06_r8, & + & 1.04747e-06_r8, 1.03664e-06_r8, 1.02591e-06_r8, 1.01530e-06_r8/) + kao_mn2( 6, :, 6) = (/ & + & 1.02400e-06_r8, 1.02238e-06_r8, 1.02077e-06_r8, 1.01916e-06_r8, 1.01755e-06_r8, & + & 1.01594e-06_r8, 1.01433e-06_r8, 1.01273e-06_r8, 1.01113e-06_r8, 1.00953e-06_r8, & + & 1.00794e-06_r8, 1.00635e-06_r8, 1.00476e-06_r8, 1.00317e-06_r8, 1.00159e-06_r8, & + & 1.00000e-06_r8, 9.98425e-07_r8, 9.96848e-07_r8, 9.95273e-07_r8/) + kao_mn2( 7, :, 6) = (/ & + & 1.08594e-06_r8, 1.08185e-06_r8, 1.07778e-06_r8, 1.07373e-06_r8, 1.06969e-06_r8, & + & 1.06566e-06_r8, 1.06165e-06_r8, 1.05766e-06_r8, 1.05368e-06_r8, 1.04971e-06_r8, & + & 1.04576e-06_r8, 1.04183e-06_r8, 1.03791e-06_r8, 1.03400e-06_r8, 1.03011e-06_r8, & + & 1.02623e-06_r8, 1.02237e-06_r8, 1.01852e-06_r8, 1.01469e-06_r8/) + kao_mn2( 8, :, 6) = (/ & + & 1.25029e-06_r8, 1.22508e-06_r8, 1.20038e-06_r8, 1.17618e-06_r8, 1.15247e-06_r8, & + & 1.12924e-06_r8, 1.10647e-06_r8, 1.08416e-06_r8, 1.06231e-06_r8, 1.04089e-06_r8, & + & 1.01990e-06_r8, 9.99343e-07_r8, 9.79196e-07_r8, 9.59454e-07_r8, 9.40111e-07_r8, & + & 9.21158e-07_r8, 9.02587e-07_r8, 8.84390e-07_r8, 8.66560e-07_r8/) + kao_mn2( 9, :, 6) = (/ & + & 1.21299e-06_r8, 1.19953e-06_r8, 1.18622e-06_r8, 1.17305e-06_r8, 1.16003e-06_r8, & + & 1.14716e-06_r8, 1.13443e-06_r8, 1.12184e-06_r8, 1.10939e-06_r8, 1.09708e-06_r8, & + & 1.08491e-06_r8, 1.07287e-06_r8, 1.06096e-06_r8, 1.04919e-06_r8, 1.03755e-06_r8, & + & 1.02603e-06_r8, 1.01465e-06_r8, 1.00339e-06_r8, 9.92253e-07_r8/) + kao_mn2( 1, :, 7) = (/ & + & 1.53893e-06_r8, 1.51743e-06_r8, 1.49623e-06_r8, 1.47532e-06_r8, 1.45471e-06_r8, & + & 1.43438e-06_r8, 1.41434e-06_r8, 1.39458e-06_r8, 1.37509e-06_r8, 1.35588e-06_r8, & + & 1.33694e-06_r8, 1.31826e-06_r8, 1.29984e-06_r8, 1.28167e-06_r8, 1.26377e-06_r8, & + & 1.24611e-06_r8, 1.22870e-06_r8, 1.21153e-06_r8, 1.19460e-06_r8/) + kao_mn2( 2, :, 7) = (/ & + & 1.53809e-06_r8, 1.51665e-06_r8, 1.49552e-06_r8, 1.47467e-06_r8, 1.45412e-06_r8, & + & 1.43386e-06_r8, 1.41388e-06_r8, 1.39418e-06_r8, 1.37475e-06_r8, 1.35559e-06_r8, & + & 1.33670e-06_r8, 1.31807e-06_r8, 1.29970e-06_r8, 1.28159e-06_r8, 1.26373e-06_r8, & + & 1.24612e-06_r8, 1.22875e-06_r8, 1.21163e-06_r8, 1.19475e-06_r8/) + kao_mn2( 3, :, 7) = (/ & + & 1.53883e-06_r8, 1.51733e-06_r8, 1.49613e-06_r8, 1.47522e-06_r8, 1.45461e-06_r8, & + & 1.43428e-06_r8, 1.41424e-06_r8, 1.39448e-06_r8, 1.37499e-06_r8, 1.35578e-06_r8, & + & 1.33684e-06_r8, 1.31816e-06_r8, 1.29974e-06_r8, 1.28157e-06_r8, 1.26367e-06_r8, & + & 1.24601e-06_r8, 1.22860e-06_r8, 1.21143e-06_r8, 1.19450e-06_r8/) + kao_mn2( 4, :, 7) = (/ & + & 1.53789e-06_r8, 1.51645e-06_r8, 1.49532e-06_r8, 1.47448e-06_r8, 1.45393e-06_r8, & + & 1.43366e-06_r8, 1.41368e-06_r8, 1.39398e-06_r8, 1.37455e-06_r8, 1.35539e-06_r8, & + & 1.33650e-06_r8, 1.31787e-06_r8, 1.29950e-06_r8, 1.28139e-06_r8, 1.26353e-06_r8, & + & 1.24592e-06_r8, 1.22856e-06_r8, 1.21143e-06_r8, 1.19455e-06_r8/) + kao_mn2( 5, :, 7) = (/ & + & 1.54059e-06_r8, 1.51888e-06_r8, 1.49747e-06_r8, 1.47637e-06_r8, 1.45557e-06_r8, & + & 1.43505e-06_r8, 1.41483e-06_r8, 1.39489e-06_r8, 1.37523e-06_r8, 1.35585e-06_r8, & + & 1.33675e-06_r8, 1.31791e-06_r8, 1.29934e-06_r8, 1.28103e-06_r8, 1.26297e-06_r8, & + & 1.24517e-06_r8, 1.22763e-06_r8, 1.21033e-06_r8, 1.19327e-06_r8/) + kao_mn2( 6, :, 7) = (/ & + & 1.70605e-06_r8, 1.65759e-06_r8, 1.61052e-06_r8, 1.56478e-06_r8, 1.52034e-06_r8, & + & 1.47716e-06_r8, 1.43521e-06_r8, 1.39445e-06_r8, 1.35485e-06_r8, 1.31637e-06_r8, & + & 1.27898e-06_r8, 1.24266e-06_r8, 1.20737e-06_r8, 1.17308e-06_r8, 1.13976e-06_r8, & + & 1.10739e-06_r8, 1.07594e-06_r8, 1.04539e-06_r8, 1.01570e-06_r8/) + kao_mn2( 7, :, 7) = (/ & + & 1.39128e-06_r8, 1.36388e-06_r8, 1.33702e-06_r8, 1.31068e-06_r8, 1.28487e-06_r8, & + & 1.25956e-06_r8, 1.23475e-06_r8, 1.21044e-06_r8, 1.18659e-06_r8, 1.16322e-06_r8, & + & 1.14031e-06_r8, 1.11785e-06_r8, 1.09584e-06_r8, 1.07425e-06_r8, 1.05309e-06_r8, & + & 1.03235e-06_r8, 1.01202e-06_r8, 9.92088e-07_r8, 9.72548e-07_r8/) + kao_mn2( 8, :, 7) = (/ & + & 1.15676e-06_r8, 1.13709e-06_r8, 1.11775e-06_r8, 1.09874e-06_r8, 1.08005e-06_r8, & + & 1.06168e-06_r8, 1.04362e-06_r8, 1.02587e-06_r8, 1.00842e-06_r8, 9.91271e-07_r8, & + & 9.74411e-07_r8, 9.57838e-07_r8, 9.41547e-07_r8, 9.25532e-07_r8, 9.09791e-07_r8, & + & 8.94316e-07_r8, 8.79105e-07_r8, 8.64153e-07_r8, 8.49455e-07_r8/) + kao_mn2( 9, :, 7) = (/ & + & 1.53483e-06_r8, 1.51352e-06_r8, 1.49252e-06_r8, 1.47180e-06_r8, 1.45138e-06_r8, & + & 1.43123e-06_r8, 1.41137e-06_r8, 1.39178e-06_r8, 1.37246e-06_r8, 1.35341e-06_r8, & + & 1.33463e-06_r8, 1.31610e-06_r8, 1.29784e-06_r8, 1.27982e-06_r8, 1.26206e-06_r8, & + & 1.24454e-06_r8, 1.22727e-06_r8, 1.21024e-06_r8, 1.19344e-06_r8/) + kao_mn2( 1, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 2, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 3, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 4, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 5, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 6, :, 8) = (/ & + & 1.70380e-06_r8, 1.67470e-06_r8, 1.64609e-06_r8, 1.61796e-06_r8, 1.59032e-06_r8, & + & 1.56315e-06_r8, 1.53645e-06_r8, 1.51020e-06_r8, 1.48440e-06_r8, 1.45904e-06_r8, & + & 1.43411e-06_r8, 1.40961e-06_r8, 1.38553e-06_r8, 1.36186e-06_r8, 1.33859e-06_r8, & + & 1.31572e-06_r8, 1.29324e-06_r8, 1.27115e-06_r8, 1.24943e-06_r8/) + kao_mn2( 7, :, 8) = (/ & + & 1.71827e-06_r8, 1.65481e-06_r8, 1.59370e-06_r8, 1.53484e-06_r8, 1.47816e-06_r8, & + & 1.42357e-06_r8, 1.37099e-06_r8, 1.32036e-06_r8, 1.27160e-06_r8, 1.22464e-06_r8, & + & 1.17941e-06_r8, 1.13585e-06_r8, 1.09390e-06_r8, 1.05350e-06_r8, 1.01459e-06_r8, & + & 9.77124e-07_r8, 9.41037e-07_r8, 9.06284e-07_r8, 8.72813e-07_r8/) + kao_mn2( 8, :, 8) = (/ & + & 1.77169e-06_r8, 1.62858e-06_r8, 1.49703e-06_r8, 1.37610e-06_r8, 1.26494e-06_r8, & + & 1.16276e-06_r8, 1.06883e-06_r8, 9.82495e-07_r8, 9.03131e-07_r8, 8.30177e-07_r8, & + & 7.63117e-07_r8, 7.01473e-07_r8, 6.44810e-07_r8, 5.92723e-07_r8, 5.44844e-07_r8, & + & 5.00832e-07_r8, 4.60376e-07_r8, 4.23187e-07_r8, 3.89003e-07_r8/) + kao_mn2( 9, :, 8) = (/ & + & 1.70025e-06_r8, 1.67042e-06_r8, 1.64110e-06_r8, 1.61231e-06_r8, 1.58401e-06_r8, & + & 1.55622e-06_r8, 1.52891e-06_r8, 1.50208e-06_r8, 1.47572e-06_r8, 1.44982e-06_r8, & + & 1.42438e-06_r8, 1.39939e-06_r8, 1.37483e-06_r8, 1.35071e-06_r8, 1.32700e-06_r8, & + & 1.30372e-06_r8, 1.28084e-06_r8, 1.25836e-06_r8, 1.23628e-06_r8/) + kao_mn2( 1, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 2, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 3, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 4, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 5, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 6, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 7, :, 9) = (/ & + & 1.74004e-06_r8, 1.70661e-06_r8, 1.67383e-06_r8, 1.64167e-06_r8, 1.61014e-06_r8, & + & 1.57921e-06_r8, 1.54887e-06_r8, 1.51912e-06_r8, 1.48994e-06_r8, 1.46132e-06_r8, & + & 1.43325e-06_r8, 1.40572e-06_r8, 1.37871e-06_r8, 1.35223e-06_r8, 1.32625e-06_r8, & + & 1.30078e-06_r8, 1.27579e-06_r8, 1.25128e-06_r8, 1.22725e-06_r8/) + kao_mn2( 8, :, 9) = (/ & + & 1.08654e-06_r8, 1.09039e-06_r8, 1.09425e-06_r8, 1.09812e-06_r8, 1.10201e-06_r8, & + & 1.10592e-06_r8, 1.10983e-06_r8, 1.11376e-06_r8, 1.11771e-06_r8, 1.12167e-06_r8, & + & 1.12564e-06_r8, 1.12962e-06_r8, 1.13363e-06_r8, 1.13764e-06_r8, 1.14167e-06_r8, & + & 1.14571e-06_r8, 1.14977e-06_r8, 1.15384e-06_r8, 1.15793e-06_r8/) + kao_mn2( 9, :, 9) = (/ & + & 1.74382e-06_r8, 1.71092e-06_r8, 1.67864e-06_r8, 1.64697e-06_r8, 1.61589e-06_r8, & + & 1.58541e-06_r8, 1.55549e-06_r8, 1.52615e-06_r8, 1.49735e-06_r8, 1.46910e-06_r8, & + & 1.44138e-06_r8, 1.41419e-06_r8, 1.38751e-06_r8, 1.36133e-06_r8, 1.33564e-06_r8, & + & 1.31045e-06_r8, 1.28572e-06_r8, 1.26146e-06_r8, 1.23766e-06_r8/) + kao_mn2( 1, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 2, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 3, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 4, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 5, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 6, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 7, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 8, :,10) = (/ & + & 1.73703e-06_r8, 1.70249e-06_r8, 1.66863e-06_r8, 1.63544e-06_r8, 1.60292e-06_r8, & + & 1.57104e-06_r8, 1.53980e-06_r8, 1.50917e-06_r8, 1.47916e-06_r8, 1.44974e-06_r8, & + & 1.42091e-06_r8, 1.39265e-06_r8, 1.36496e-06_r8, 1.33781e-06_r8, 1.31121e-06_r8, & + & 1.28513e-06_r8, 1.25957e-06_r8, 1.23452e-06_r8, 1.20997e-06_r8/) + kao_mn2( 9, :,10) = (/ & + & 1.82903e-06_r8, 1.78673e-06_r8, 1.74541e-06_r8, 1.70505e-06_r8, 1.66562e-06_r8, & + & 1.62710e-06_r8, 1.58947e-06_r8, 1.55271e-06_r8, 1.51680e-06_r8, 1.48172e-06_r8, & + & 1.44745e-06_r8, 1.41398e-06_r8, 1.38128e-06_r8, 1.34933e-06_r8, 1.31813e-06_r8, & + & 1.28765e-06_r8, 1.25787e-06_r8, 1.22878e-06_r8, 1.20036e-06_r8/) + kao_mn2( 1, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 2, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 3, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 4, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 5, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 6, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 7, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 8, :,11) = (/ & + & 1.73118e-06_r8, 1.69710e-06_r8, 1.66370e-06_r8, 1.63095e-06_r8, 1.59885e-06_r8, & + & 1.56737e-06_r8, 1.53652e-06_r8, 1.50628e-06_r8, 1.47663e-06_r8, 1.44756e-06_r8, & + & 1.41907e-06_r8, 1.39114e-06_r8, 1.36376e-06_r8, 1.33691e-06_r8, 1.31060e-06_r8, & + & 1.28480e-06_r8, 1.25951e-06_r8, 1.23472e-06_r8, 1.21041e-06_r8/) + kao_mn2( 9, :,11) = (/ & + & 1.81037e-06_r8, 1.76948e-06_r8, 1.72952e-06_r8, 1.69045e-06_r8, 1.65228e-06_r8, & + & 1.61496e-06_r8, 1.57848e-06_r8, 1.54283e-06_r8, 1.50799e-06_r8, 1.47393e-06_r8, & + & 1.44064e-06_r8, 1.40810e-06_r8, 1.37630e-06_r8, 1.34522e-06_r8, 1.31484e-06_r8, & + & 1.28514e-06_r8, 1.25611e-06_r8, 1.22774e-06_r8, 1.20002e-06_r8/) + kao_mn2( 1, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 2, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 3, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 4, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 5, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 6, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 7, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 8, :,12) = (/ & + & 1.73338e-06_r8, 1.69915e-06_r8, 1.66560e-06_r8, 1.63271e-06_r8, 1.60046e-06_r8, & + & 1.56886e-06_r8, 1.53788e-06_r8, 1.50751e-06_r8, 1.47774e-06_r8, 1.44856e-06_r8, & + & 1.41995e-06_r8, 1.39191e-06_r8, 1.36442e-06_r8, 1.33748e-06_r8, 1.31107e-06_r8, & + & 1.28518e-06_r8, 1.25980e-06_r8, 1.23492e-06_r8, 1.21053e-06_r8/) + kao_mn2( 9, :,12) = (/ & + & 2.04857e-06_r8, 1.98353e-06_r8, 1.92055e-06_r8, 1.85957e-06_r8, 1.80053e-06_r8, & + & 1.74336e-06_r8, 1.68800e-06_r8, 1.63441e-06_r8, 1.58251e-06_r8, 1.53227e-06_r8, & + & 1.48362e-06_r8, 1.43651e-06_r8, 1.39090e-06_r8, 1.34674e-06_r8, 1.30398e-06_r8, & + & 1.26257e-06_r8, 1.22249e-06_r8, 1.18367e-06_r8, 1.14609e-06_r8/) + kao_mn2( 1, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 2, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 3, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 4, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 5, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 6, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 7, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 8, :,13) = (/ & + & 1.73511e-06_r8, 1.70072e-06_r8, 1.66702e-06_r8, 1.63398e-06_r8, 1.60159e-06_r8, & + & 1.56985e-06_r8, 1.53874e-06_r8, 1.50824e-06_r8, 1.47835e-06_r8, 1.44905e-06_r8, & + & 1.42033e-06_r8, 1.39218e-06_r8, 1.36459e-06_r8, 1.33755e-06_r8, 1.31104e-06_r8, & + & 1.28505e-06_r8, 1.25958e-06_r8, 1.23462e-06_r8, 1.21015e-06_r8/) + kao_mn2( 9, :,13) = (/ & + & 2.13403e-06_r8, 2.05906e-06_r8, 1.98673e-06_r8, 1.91694e-06_r8, 1.84961e-06_r8, & + & 1.78463e-06_r8, 1.72194e-06_r8, 1.66145e-06_r8, 1.60309e-06_r8, 1.54678e-06_r8, & + & 1.49244e-06_r8, 1.44002e-06_r8, 1.38943e-06_r8, 1.34062e-06_r8, 1.29353e-06_r8, & + & 1.24809e-06_r8, 1.20425e-06_r8, 1.16195e-06_r8, 1.12113e-06_r8/) + kao_mn2( 1, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 2, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 3, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 4, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 5, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 6, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 7, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 8, :,14) = (/ & + & 1.73398e-06_r8, 1.69941e-06_r8, 1.66553e-06_r8, 1.63233e-06_r8, 1.59979e-06_r8, & + & 1.56790e-06_r8, 1.53664e-06_r8, 1.50601e-06_r8, 1.47598e-06_r8, 1.44656e-06_r8, & + & 1.41772e-06_r8, 1.38946e-06_r8, 1.36176e-06_r8, 1.33461e-06_r8, 1.30801e-06_r8, & + & 1.28193e-06_r8, 1.25637e-06_r8, 1.23133e-06_r8, 1.20678e-06_r8/) + kao_mn2( 9, :,14) = (/ & + & 1.83423e-06_r8, 1.79123e-06_r8, 1.74923e-06_r8, 1.70821e-06_r8, 1.66816e-06_r8, & + & 1.62904e-06_r8, 1.59085e-06_r8, 1.55354e-06_r8, 1.51712e-06_r8, 1.48154e-06_r8, & + & 1.44681e-06_r8, 1.41288e-06_r8, 1.37975e-06_r8, 1.34740e-06_r8, 1.31581e-06_r8, & + & 1.28496e-06_r8, 1.25483e-06_r8, 1.22540e-06_r8, 1.19667e-06_r8/) + kao_mn2( 1, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 2, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 3, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 4, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 5, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 6, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 7, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 8, :,15) = (/ & + & 1.73231e-06_r8, 1.69765e-06_r8, 1.66368e-06_r8, 1.63039e-06_r8, 1.59776e-06_r8, & + & 1.56579e-06_r8, 1.53445e-06_r8, 1.50375e-06_r8, 1.47366e-06_r8, 1.44417e-06_r8, & + & 1.41527e-06_r8, 1.38695e-06_r8, 1.35919e-06_r8, 1.33199e-06_r8, 1.30534e-06_r8, & + & 1.27922e-06_r8, 1.25362e-06_r8, 1.22853e-06_r8, 1.20395e-06_r8/) + kao_mn2( 9, :,15) = (/ & + & 1.71602e-06_r8, 1.68499e-06_r8, 1.65452e-06_r8, 1.62461e-06_r8, 1.59523e-06_r8, & + & 1.56639e-06_r8, 1.53807e-06_r8, 1.51026e-06_r8, 1.48295e-06_r8, 1.45614e-06_r8, & + & 1.42981e-06_r8, 1.40395e-06_r8, 1.37857e-06_r8, 1.35364e-06_r8, 1.32917e-06_r8, & + & 1.30513e-06_r8, 1.28153e-06_r8, 1.25836e-06_r8, 1.23561e-06_r8/) + kao_mn2( 1, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 2, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 3, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 4, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 5, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 6, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 7, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 8, :,16) = (/ & + & 1.73310e-06_r8, 1.69826e-06_r8, 1.66413e-06_r8, 1.63069e-06_r8, 1.59791e-06_r8, & + & 1.56580e-06_r8, 1.53433e-06_r8, 1.50349e-06_r8, 1.47328e-06_r8, 1.44367e-06_r8, & + & 1.41465e-06_r8, 1.38622e-06_r8, 1.35836e-06_r8, 1.33106e-06_r8, 1.30431e-06_r8, & + & 1.27810e-06_r8, 1.25241e-06_r8, 1.22724e-06_r8, 1.20257e-06_r8/) + kao_mn2( 9, :,16) = (/ & + & 1.79375e-06_r8, 1.75599e-06_r8, 1.71903e-06_r8, 1.68284e-06_r8, 1.64741e-06_r8, & + & 1.61273e-06_r8, 1.57878e-06_r8, 1.54554e-06_r8, 1.51301e-06_r8, 1.48116e-06_r8, & + & 1.44998e-06_r8, 1.41945e-06_r8, 1.38957e-06_r8, 1.36032e-06_r8, 1.33168e-06_r8, & + & 1.30365e-06_r8, 1.27620e-06_r8, 1.24934e-06_r8, 1.22304e-06_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &1.1755e-06_r8,6.5398e-07_r8,4.3915e-07_r8,3.0753e-07_r8,1.9677e-07_r8,1.4362e-07_r8, & + &9.4598e-08_r8,1.1848e-07_r8,1.4280e-07_r8,1.5821e-07_r8,1.5816e-07_r8,1.5769e-07_r8, & + &1.5844e-07_r8,1.6016e-07_r8,1.6232e-07_r8,1.6320e-07_r8/) + forrefo(2,:) = (/ & + &1.0703e-06_r8,6.2783e-07_r8,4.7122e-07_r8,2.6300e-07_r8,1.8538e-07_r8,1.5076e-07_r8, & + &1.9474e-07_r8,2.9543e-07_r8,2.0093e-07_r8,1.5819e-07_r8,1.5826e-07_r8,1.5737e-07_r8, & + &1.5751e-07_r8,1.5910e-07_r8,1.6181e-07_r8,1.6320e-07_r8/) + forrefo(3,:) = (/ & + &1.0470e-06_r8,5.8184e-07_r8,4.8218e-07_r8,2.7771e-07_r8,1.9036e-07_r8,1.5737e-07_r8, & + &1.8633e-07_r8,2.5754e-07_r8,4.0647e-07_r8,1.5839e-07_r8,1.5914e-07_r8,1.5788e-07_r8, & + &1.5731e-07_r8,1.5836e-07_r8,1.6103e-07_r8,1.6320e-07_r8/) + forrefo(4,:) = (/ & + &1.3891e-06_r8,5.4901e-07_r8,2.8850e-07_r8,1.9176e-07_r8,1.4549e-07_r8,1.3603e-07_r8, & + &1.7472e-07_r8,2.9796e-07_r8,3.2452e-07_r8,2.5231e-07_r8,2.8195e-07_r8,1.5527e-07_r8, & + &1.5507e-07_r8,1.5442e-07_r8,1.5275e-07_r8,1.6057e-07_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 1.73980e-03_r8, 1.41928e-03_r8, 1.15780e-03_r8, 9.44496e-04_r8, 7.70490e-04_r8, & + & 6.28541e-04_r8, 5.12744e-04_r8, 4.18280e-04_r8, 3.41219e-04_r8, 2.78356e-04_r8/) + selfrefo(:, 2) = (/ & + & 1.84082e-03_r8, 1.50228e-03_r8, 1.22600e-03_r8, 1.00053e-03_r8, 8.16525e-04_r8, & + & 6.66359e-04_r8, 5.43811e-04_r8, 4.43800e-04_r8, 3.62182e-04_r8, 2.95574e-04_r8/) + selfrefo(:, 3) = (/ & + & 1.92957e-03_r8, 1.57727e-03_r8, 1.28930e-03_r8, 1.05390e-03_r8, 8.61484e-04_r8, & + & 7.04197e-04_r8, 5.75627e-04_r8, 4.70530e-04_r8, 3.84622e-04_r8, 3.14399e-04_r8/) + selfrefo(:, 4) = (/ & + & 2.12958e-03_r8, 1.73572e-03_r8, 1.41470e-03_r8, 1.15305e-03_r8, 9.39798e-04_r8, & + & 7.65984e-04_r8, 6.24317e-04_r8, 5.08850e-04_r8, 4.14739e-04_r8, 3.38034e-04_r8/) + selfrefo(:, 5) = (/ & + & 2.30636e-03_r8, 1.88401e-03_r8, 1.53900e-03_r8, 1.25717e-03_r8, 1.02695e-03_r8, & + & 8.38891e-04_r8, 6.85270e-04_r8, 5.59780e-04_r8, 4.57270e-04_r8, 3.73533e-04_r8/) + selfrefo(:, 6) = (/ & + & 2.47824e-03_r8, 2.03278e-03_r8, 1.66740e-03_r8, 1.36769e-03_r8, 1.12185e-03_r8, & + & 9.20206e-04_r8, 7.54803e-04_r8, 6.19130e-04_r8, 5.07844e-04_r8, 4.16561e-04_r8/) + selfrefo(:, 7) = (/ & + & 2.54196e-03_r8, 2.10768e-03_r8, 1.74760e-03_r8, 1.44904e-03_r8, 1.20148e-03_r8, & + & 9.96215e-04_r8, 8.26019e-04_r8, 6.84900e-04_r8, 5.67890e-04_r8, 4.70870e-04_r8/) + selfrefo(:, 8) = (/ & + & 2.52650e-03_r8, 2.11773e-03_r8, 1.77510e-03_r8, 1.48790e-03_r8, 1.24717e-03_r8, & + & 1.04539e-03_r8, 8.76251e-04_r8, 7.34480e-04_r8, 6.15646e-04_r8, 5.16039e-04_r8/) + selfrefo(:, 9) = (/ & + & 2.82351e-03_r8, 2.34652e-03_r8, 1.95010e-03_r8, 1.62065e-03_r8, 1.34686e-03_r8, & + & 1.11933e-03_r8, 9.30232e-04_r8, 7.73080e-04_r8, 6.42477e-04_r8, 5.33939e-04_r8/) + selfrefo(:,10) = (/ & + & 2.98189e-03_r8, 2.46741e-03_r8, 2.04170e-03_r8, 1.68944e-03_r8, 1.39795e-03_r8, & + & 1.15676e-03_r8, 9.57176e-04_r8, 7.92030e-04_r8, 6.55377e-04_r8, 5.42302e-04_r8/) + selfrefo(:,11) = (/ & + & 2.98239e-03_r8, 2.46774e-03_r8, 2.04190e-03_r8, 1.68954e-03_r8, 1.39799e-03_r8, & + & 1.15675e-03_r8, 9.57137e-04_r8, 7.91970e-04_r8, 6.55305e-04_r8, 5.42224e-04_r8/) + selfrefo(:,12) = (/ & + & 2.97833e-03_r8, 2.46461e-03_r8, 2.03950e-03_r8, 1.68772e-03_r8, 1.39661e-03_r8, & + & 1.15571e-03_r8, 9.56370e-04_r8, 7.91410e-04_r8, 6.54903e-04_r8, 5.41942e-04_r8/) + selfrefo(:,13) = (/ & + & 2.97779e-03_r8, 2.46463e-03_r8, 2.03990e-03_r8, 1.68836e-03_r8, 1.39741e-03_r8, & + & 1.15659e-03_r8, 9.57278e-04_r8, 7.92310e-04_r8, 6.55771e-04_r8, 5.42762e-04_r8/) + selfrefo(:,14) = (/ & + & 2.98326e-03_r8, 2.46943e-03_r8, 2.04410e-03_r8, 1.69203e-03_r8, 1.40060e-03_r8, & + & 1.15936e-03_r8, 9.59673e-04_r8, 7.94380e-04_r8, 6.57557e-04_r8, 5.44301e-04_r8/) + selfrefo(:,15) = (/ & + & 2.99407e-03_r8, 2.47825e-03_r8, 2.05130e-03_r8, 1.69790e-03_r8, 1.40539e-03_r8, & + & 1.16327e-03_r8, 9.62862e-04_r8, 7.96980e-04_r8, 6.59676e-04_r8, 5.46028e-04_r8/) + selfrefo(:,16) = (/ & + & 3.00005e-03_r8, 2.48296e-03_r8, 2.05500e-03_r8, 1.70080e-03_r8, 1.40765e-03_r8, & + & 1.16503e-03_r8, 9.64224e-04_r8, 7.98030e-04_r8, 6.60481e-04_r8, 5.46641e-04_r8/) + + end subroutine lw_kgb15 + +! ************************************************************************** + subroutine lw_kgb16 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrlw_kg16, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo + + implicit none + save + +! Planck fraction mapping level: P = 387.6100 mbar, T = 250.17 K + fracrefao(:, 1) = (/ & + & 1.1593e-01_r8,2.3390e-01_r8,1.9120e-01_r8,1.3121e-01_r8,1.0590e-01_r8,8.4852e-02_r8, & + & 6.4168e-02_r8,4.2537e-02_r8,2.3220e-02_r8,2.1767e-03_r8,1.8203e-03_r8,1.3724e-03_r8, & + & 9.5452e-04_r8,5.5015e-04_r8,1.9348e-04_r8,2.7344e-05_r8/) + fracrefao(:, 2) = (/ & + & 2.8101e-01_r8,1.9773e-01_r8,1.4749e-01_r8,1.1399e-01_r8,8.8190e-02_r8,7.0531e-02_r8, & + & 4.6356e-02_r8,3.0774e-02_r8,1.7332e-02_r8,2.0054e-03_r8,1.5950e-03_r8,1.2760e-03_r8, & + & 9.5034e-04_r8,5.4992e-04_r8,1.9349e-04_r8,2.7309e-05_r8/) + fracrefao(:, 3) = (/ & + & 2.9054e-01_r8,2.1263e-01_r8,1.4133e-01_r8,1.1083e-01_r8,8.5107e-02_r8,6.5247e-02_r8, & + & 4.4542e-02_r8,2.7205e-02_r8,1.6495e-02_r8,1.8453e-03_r8,1.5222e-03_r8,1.1884e-03_r8, & + & 8.1094e-04_r8,4.9173e-04_r8,1.9344e-04_r8,2.7286e-05_r8/) + fracrefao(:, 4) = (/ & + & 2.9641e-01_r8,2.1738e-01_r8,1.4228e-01_r8,1.0830e-01_r8,8.2837e-02_r8,6.1359e-02_r8, & + & 4.4683e-02_r8,2.5027e-02_r8,1.6057e-02_r8,1.7558e-03_r8,1.4193e-03_r8,1.0970e-03_r8, & + & 7.8281e-04_r8,4.3260e-04_r8,1.4837e-04_r8,2.2958e-05_r8/) + fracrefao(:, 5) = (/ & + & 2.9553e-01_r8,2.2139e-01_r8,1.4816e-01_r8,1.0601e-01_r8,8.0048e-02_r8,6.0082e-02_r8, & + & 4.3952e-02_r8,2.3788e-02_r8,1.5734e-02_r8,1.6586e-03_r8,1.3434e-03_r8,1.0281e-03_r8, & + & 7.0256e-04_r8,4.2577e-04_r8,1.2803e-04_r8,1.3315e-05_r8/) + fracrefao(:, 6) = (/ & + & 2.9313e-01_r8,2.2476e-01_r8,1.5470e-01_r8,1.0322e-01_r8,7.8904e-02_r8,5.8175e-02_r8, & + & 4.3097e-02_r8,2.3618e-02_r8,1.5385e-02_r8,1.5942e-03_r8,1.2702e-03_r8,9.5566e-04_r8, & + & 6.5421e-04_r8,4.0165e-04_r8,1.2805e-04_r8,1.3355e-05_r8/) + fracrefao(:, 7) = (/ & + & 2.9069e-01_r8,2.2823e-01_r8,1.5995e-01_r8,1.0170e-01_r8,7.7287e-02_r8,5.6780e-02_r8, & + & 4.1752e-02_r8,2.3899e-02_r8,1.4937e-02_r8,1.4916e-03_r8,1.1909e-03_r8,9.1307e-04_r8, & + & 6.3518e-04_r8,3.9866e-04_r8,1.2805e-04_r8,1.3298e-05_r8/) + fracrefao(:, 8) = (/ & + & 2.8446e-01_r8,2.2651e-01_r8,1.7133e-01_r8,1.0299e-01_r8,7.4231e-02_r8,5.6031e-02_r8, & + & 4.1368e-02_r8,2.4318e-02_r8,1.4135e-02_r8,1.4216e-03_r8,1.1465e-03_r8,8.9800e-04_r8, & + & 6.3553e-04_r8,3.9536e-04_r8,1.2749e-04_r8,1.3298e-05_r8/) + fracrefao(:, 9) = (/ & + & 2.0568e-01_r8,2.5049e-01_r8,2.0568e-01_r8,1.1781e-01_r8,7.5579e-02_r8,5.8136e-02_r8, & + & 4.2397e-02_r8,2.6544e-02_r8,1.3067e-02_r8,1.4061e-03_r8,1.1455e-03_r8,8.9408e-04_r8, & + & 6.3652e-04_r8,3.9450e-04_r8,1.2841e-04_r8,1.3315e-05_r8/) + +! Planck fraction mapping level : P=95.58350 mb, T = 215.70 K + fracrefbo(:) = (/ & + & 1.8111e-01_r8,2.2612e-01_r8,1.6226e-01_r8,1.1872e-01_r8,9.9048e-02_r8,8.0390e-02_r8, & + & 6.1648e-02_r8,4.1704e-02_r8,2.2976e-02_r8,1.9263e-03_r8,1.4694e-03_r8,1.1498e-03_r8, & + & 7.9906e-04_r8,4.8310e-04_r8,1.6188e-04_r8,2.2651e-05_r8/) + +! The array KAO contains absorption coefs for each of the 16 g-intervals +! for a range of pressure levels > ~100mb, temperatures, and ratios +! of water vapor to CO2. The first index in the array, JS, runs +! from 1 to 10, and corresponds to different gas column amount ratios, +! as expressed through the binary species parameter eta, defined as +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature +! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the reference pressure level (e.g. JP = 1 is for a +! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kao(:, 1, 1, 1) = (/ & + &2.6621e-07_r8,6.0791e-06_r8,9.3282e-06_r8,1.2208e-05_r8,1.4897e-05_r8,1.7596e-05_r8, & + &2.0729e-05_r8,2.6390e-05_r8,2.1078e-05_r8/) + kao(:, 2, 1, 1) = (/ & + &2.8927e-07_r8,6.1043e-06_r8,9.4020e-06_r8,1.2345e-05_r8,1.5126e-05_r8,1.7938e-05_r8, & + &2.1210e-05_r8,2.6769e-05_r8,2.1943e-05_r8/) + kao(:, 3, 1, 1) = (/ & + &3.1534e-07_r8,6.1325e-06_r8,9.4674e-06_r8,1.2459e-05_r8,1.5335e-05_r8,1.8250e-05_r8, & + &2.1635e-05_r8,2.7290e-05_r8,2.2718e-05_r8/) + kao(:, 4, 1, 1) = (/ & + &3.3330e-07_r8,6.1474e-06_r8,9.4677e-06_r8,1.2509e-05_r8,1.5444e-05_r8,1.8455e-05_r8, & + &2.1960e-05_r8,2.7695e-05_r8,2.3390e-05_r8/) + kao(:, 5, 1, 1) = (/ & + &3.5345e-07_r8,6.1735e-06_r8,9.4652e-06_r8,1.2538e-05_r8,1.5529e-05_r8,1.8608e-05_r8, & + &2.2197e-05_r8,2.8038e-05_r8,2.3906e-05_r8/) + kao(:, 1, 2, 1) = (/ & + &3.4774e-07_r8,6.3116e-06_r8,9.2039e-06_r8,1.1662e-05_r8,1.3842e-05_r8,1.5878e-05_r8, & + &1.7925e-05_r8,2.1213e-05_r8,1.7372e-05_r8/) + kao(:, 2, 2, 1) = (/ & + &3.7649e-07_r8,6.3618e-06_r8,9.2771e-06_r8,1.1777e-05_r8,1.4038e-05_r8,1.6170e-05_r8, & + &1.8345e-05_r8,2.1716e-05_r8,1.8135e-05_r8/) + kao(:, 3, 2, 1) = (/ & + &4.1206e-07_r8,6.4231e-06_r8,9.3322e-06_r8,1.1891e-05_r8,1.4202e-05_r8,1.6428e-05_r8, & + &1.8750e-05_r8,2.2212e-05_r8,1.8847e-05_r8/) + kao(:, 4, 2, 1) = (/ & + &4.4004e-07_r8,6.4581e-06_r8,9.3579e-06_r8,1.1962e-05_r8,1.4316e-05_r8,1.6601e-05_r8, & + &1.9025e-05_r8,2.2633e-05_r8,1.9458e-05_r8/) + kao(:, 5, 2, 1) = (/ & + &4.6078e-07_r8,6.4755e-06_r8,9.3704e-06_r8,1.1973e-05_r8,1.4371e-05_r8,1.6702e-05_r8, & + &1.9215e-05_r8,2.2953e-05_r8,1.9948e-05_r8/) + kao(:, 1, 3, 1) = (/ & + &5.9817e-07_r8,7.8428e-06_r8,1.0496e-05_r8,1.2549e-05_r8,1.4230e-05_r8,1.5565e-05_r8, & + &1.6588e-05_r8,1.7671e-05_r8,1.4245e-05_r8/) + kao(:, 2, 3, 1) = (/ & + &6.5182e-07_r8,7.9343e-06_r8,1.0585e-05_r8,1.2668e-05_r8,1.4392e-05_r8,1.5789e-05_r8, & + &1.6949e-05_r8,1.8125e-05_r8,1.4996e-05_r8/) + kao(:, 3, 3, 1) = (/ & + &7.0221e-07_r8,8.0226e-06_r8,1.0677e-05_r8,1.2755e-05_r8,1.4518e-05_r8,1.5973e-05_r8, & + &1.7236e-05_r8,1.8551e-05_r8,1.5656e-05_r8/) + kao(:, 4, 3, 1) = (/ & + &7.6366e-07_r8,8.1339e-06_r8,1.0778e-05_r8,1.2848e-05_r8,1.4645e-05_r8,1.6156e-05_r8, & + &1.7457e-05_r8,1.8931e-05_r8,1.6271e-05_r8/) + kao(:, 5, 3, 1) = (/ & + &7.9889e-07_r8,8.1643e-06_r8,1.0808e-05_r8,1.2886e-05_r8,1.4686e-05_r8,1.6241e-05_r8, & + &1.7601e-05_r8,1.9193e-05_r8,1.6837e-05_r8/) + kao(:, 1, 4, 1) = (/ & + &1.0320e-06_r8,1.0378e-05_r8,1.2935e-05_r8,1.4632e-05_r8,1.5802e-05_r8,1.6452e-05_r8, & + &1.6586e-05_r8,1.6155e-05_r8,1.2287e-05_r8/) + kao(:, 2, 4, 1) = (/ & + &1.1305e-06_r8,1.0573e-05_r8,1.3130e-05_r8,1.4798e-05_r8,1.5980e-05_r8,1.6653e-05_r8, & + &1.6853e-05_r8,1.6526e-05_r8,1.3070e-05_r8/) + kao(:, 3, 4, 1) = (/ & + &1.2198e-06_r8,1.0772e-05_r8,1.3274e-05_r8,1.4971e-05_r8,1.6111e-05_r8,1.6834e-05_r8, & + &1.7084e-05_r8,1.6873e-05_r8,1.3795e-05_r8/) + kao(:, 4, 4, 1) = (/ & + &1.3096e-06_r8,1.0937e-05_r8,1.3422e-05_r8,1.5096e-05_r8,1.6233e-05_r8,1.6971e-05_r8, & + &1.7284e-05_r8,1.7149e-05_r8,1.4420e-05_r8/) + kao(:, 5, 4, 1) = (/ & + &1.4155e-06_r8,1.1094e-05_r8,1.3596e-05_r8,1.5273e-05_r8,1.6388e-05_r8,1.7112e-05_r8, & + &1.7471e-05_r8,1.7381e-05_r8,1.4960e-05_r8/) + kao(:, 1, 5, 1) = (/ & + &1.6279e-06_r8,1.3142e-05_r8,1.6056e-05_r8,1.7394e-05_r8,1.8017e-05_r8,1.8011e-05_r8, & + &1.7308e-05_r8,1.5625e-05_r8,1.1008e-05_r8/) + kao(:, 2, 5, 1) = (/ & + &1.7835e-06_r8,1.3457e-05_r8,1.6348e-05_r8,1.7668e-05_r8,1.8277e-05_r8,1.8261e-05_r8, & + &1.7567e-05_r8,1.5970e-05_r8,1.1698e-05_r8/) + kao(:, 3, 5, 1) = (/ & + &1.9402e-06_r8,1.3791e-05_r8,1.6620e-05_r8,1.7922e-05_r8,1.8515e-05_r8,1.8474e-05_r8, & + &1.7802e-05_r8,1.6252e-05_r8,1.2372e-05_r8/) + kao(:, 4, 5, 1) = (/ & + &2.0835e-06_r8,1.4086e-05_r8,1.6875e-05_r8,1.8160e-05_r8,1.8703e-05_r8,1.8665e-05_r8, & + &1.7992e-05_r8,1.6486e-05_r8,1.3071e-05_r8/) + kao(:, 5, 5, 1) = (/ & + &2.2582e-06_r8,1.4511e-05_r8,1.7205e-05_r8,1.8422e-05_r8,1.8984e-05_r8,1.8898e-05_r8, & + &1.8217e-05_r8,1.6724e-05_r8,1.3787e-05_r8/) + kao(:, 1, 6, 1) = (/ & + &2.4034e-06_r8,1.6823e-05_r8,1.9391e-05_r8,2.0723e-05_r8,2.0772e-05_r8,2.0043e-05_r8, & + &1.8498e-05_r8,1.5704e-05_r8,9.8836e-06_r8/) + kao(:, 2, 6, 1) = (/ & + &2.6386e-06_r8,1.7226e-05_r8,1.9692e-05_r8,2.1124e-05_r8,2.1126e-05_r8,2.0392e-05_r8, & + &1.8810e-05_r8,1.6034e-05_r8,1.0751e-05_r8/) + kao(:, 3, 6, 1) = (/ & + &2.8660e-06_r8,1.7674e-05_r8,2.0029e-05_r8,2.1524e-05_r8,2.1484e-05_r8,2.0719e-05_r8, & + &1.9071e-05_r8,1.6298e-05_r8,1.1450e-05_r8/) + kao(:, 4, 6, 1) = (/ & + &3.0844e-06_r8,1.8072e-05_r8,2.0407e-05_r8,2.1899e-05_r8,2.1788e-05_r8,2.0987e-05_r8, & + &1.9304e-05_r8,1.6540e-05_r8,1.2182e-05_r8/) + kao(:, 5, 6, 1) = (/ & + &3.2920e-06_r8,1.8533e-05_r8,2.0800e-05_r8,2.2106e-05_r8,2.2044e-05_r8,2.1223e-05_r8, & + &1.9506e-05_r8,1.6741e-05_r8,1.2836e-05_r8/) + kao(:, 1, 7, 1) = (/ & + &3.8221e-06_r8,2.2204e-05_r8,2.4808e-05_r8,2.5531e-05_r8,2.5616e-05_r8,2.3917e-05_r8, & + &2.1120e-05_r8,1.6870e-05_r8,8.7171e-06_r8/) + kao(:, 2, 7, 1) = (/ & + &4.1828e-06_r8,2.2870e-05_r8,2.5558e-05_r8,2.5953e-05_r8,2.6151e-05_r8,2.4347e-05_r8, & + &2.1524e-05_r8,1.7202e-05_r8,9.2028e-06_r8/) + kao(:, 3, 7, 1) = (/ & + &4.5497e-06_r8,2.3564e-05_r8,2.6164e-05_r8,2.6493e-05_r8,2.6591e-05_r8,2.4767e-05_r8, & + &2.1899e-05_r8,1.7498e-05_r8,9.7937e-06_r8/) + kao(:, 4, 7, 1) = (/ & + &4.8742e-06_r8,2.4270e-05_r8,2.6708e-05_r8,2.7099e-05_r8,2.6759e-05_r8,2.5177e-05_r8, & + &2.2242e-05_r8,1.7759e-05_r8,1.0449e-05_r8/) + kao(:, 5, 7, 1) = (/ & + &5.1866e-06_r8,2.4962e-05_r8,2.7348e-05_r8,2.7664e-05_r8,2.7129e-05_r8,2.5537e-05_r8, & + &2.2515e-05_r8,1.7998e-05_r8,1.1128e-05_r8/) + kao(:, 1, 8, 1) = (/ & + &7.4211e-06_r8,3.2998e-05_r8,3.6610e-05_r8,3.7073e-05_r8,3.4983e-05_r8,3.2511e-05_r8, & + &2.7821e-05_r8,2.0603e-05_r8,7.1809e-06_r8/) + kao(:, 2, 8, 1) = (/ & + &8.1099e-06_r8,3.4342e-05_r8,3.7801e-05_r8,3.7976e-05_r8,3.5797e-05_r8,3.2823e-05_r8, & + &2.8347e-05_r8,2.1030e-05_r8,7.7735e-06_r8/) + kao(:, 3, 8, 1) = (/ & + &8.7992e-06_r8,3.5880e-05_r8,3.8837e-05_r8,3.8975e-05_r8,3.6756e-05_r8,3.3300e-05_r8, & + &2.8882e-05_r8,2.1428e-05_r8,8.4180e-06_r8/) + kao(:, 4, 8, 1) = (/ & + &9.4486e-06_r8,3.7431e-05_r8,3.9883e-05_r8,3.9775e-05_r8,3.7762e-05_r8,3.3901e-05_r8, & + &2.9403e-05_r8,2.1792e-05_r8,9.1057e-06_r8/) + kao(:, 5, 8, 1) = (/ & + &1.0041e-05_r8,3.9014e-05_r8,4.1019e-05_r8,4.0539e-05_r8,3.8447e-05_r8,3.4543e-05_r8, & + &2.9823e-05_r8,2.2110e-05_r8,9.8280e-06_r8/) + kao(:, 1, 9, 1) = (/ & + &2.6945e-05_r8,8.1804e-05_r8,8.6984e-05_r8,8.4462e-05_r8,7.8660e-05_r8,6.9398e-05_r8, & + &5.6216e-05_r8,3.9134e-05_r8,6.0831e-06_r8/) + kao(:, 2, 9, 1) = (/ & + &2.9562e-05_r8,8.5456e-05_r8,9.1284e-05_r8,8.7620e-05_r8,8.1311e-05_r8,7.1570e-05_r8, & + &5.7999e-05_r8,3.9483e-05_r8,6.6855e-06_r8/) + kao(:, 3, 9, 1) = (/ & + &3.2110e-05_r8,8.8183e-05_r8,9.6256e-05_r8,9.1033e-05_r8,8.3882e-05_r8,7.3603e-05_r8, & + &5.9334e-05_r8,4.0067e-05_r8,7.3573e-06_r8/) + kao(:, 4, 9, 1) = (/ & + &3.4494e-05_r8,9.0981e-05_r8,1.0082e-04_r8,9.4837e-05_r8,8.6631e-05_r8,7.5471e-05_r8, & + &6.0778e-05_r8,4.0870e-05_r8,8.0874e-06_r8/) + kao(:, 5, 9, 1) = (/ & + &3.6729e-05_r8,9.3406e-05_r8,1.0411e-04_r8,9.8963e-05_r8,8.9287e-05_r8,7.7185e-05_r8, & + &6.1987e-05_r8,4.1723e-05_r8,8.8598e-06_r8/) + kao(:, 1,10, 1) = (/ & + &1.1063e-04_r8,2.0470e-04_r8,2.2594e-04_r8,2.2784e-04_r8,2.0878e-04_r8,1.7781e-04_r8, & + &1.3876e-04_r8,9.0190e-05_r8,6.6238e-06_r8/) + kao(:, 2,10, 1) = (/ & + &1.2128e-04_r8,2.1612e-04_r8,2.3657e-04_r8,2.3782e-04_r8,2.2024e-04_r8,1.8545e-04_r8, & + &1.4406e-04_r8,9.3147e-05_r8,7.2888e-06_r8/) + kao(:, 3,10, 1) = (/ & + &1.3155e-04_r8,2.2685e-04_r8,2.4613e-04_r8,2.4648e-04_r8,2.3100e-04_r8,1.9523e-04_r8, & + &1.4909e-04_r8,9.5827e-05_r8,7.7784e-06_r8/) + kao(:, 4,10, 1) = (/ & + &1.4108e-04_r8,2.3656e-04_r8,2.5475e-04_r8,2.5395e-04_r8,2.3879e-04_r8,2.0427e-04_r8, & + &1.5511e-04_r8,9.8368e-05_r8,8.3069e-06_r8/) + kao(:, 5,10, 1) = (/ & + &1.4988e-04_r8,2.4526e-04_r8,2.6296e-04_r8,2.6141e-04_r8,2.4593e-04_r8,2.1313e-04_r8, & + &1.6065e-04_r8,1.0083e-04_r8,8.9709e-06_r8/) + kao(:, 1,11, 1) = (/ & + &1.6397e-04_r8,2.6056e-04_r8,2.8031e-04_r8,2.7866e-04_r8,2.6081e-04_r8,2.2383e-04_r8, & + &1.7351e-04_r8,1.0962e-04_r8,6.8264e-06_r8/) + kao(:, 2,11, 1) = (/ & + &1.7933e-04_r8,2.7580e-04_r8,2.9343e-04_r8,2.9042e-04_r8,2.7290e-04_r8,2.3596e-04_r8, & + &1.8069e-04_r8,1.1353e-04_r8,7.5502e-06_r8/) + kao(:, 3,11, 1) = (/ & + &1.9324e-04_r8,2.9031e-04_r8,3.0629e-04_r8,3.0108e-04_r8,2.8182e-04_r8,2.4730e-04_r8, & + &1.8878e-04_r8,1.1713e-04_r8,7.9027e-06_r8/) + kao(:, 4,11, 1) = (/ & + &2.0654e-04_r8,3.0384e-04_r8,3.1739e-04_r8,3.1103e-04_r8,2.9049e-04_r8,2.5555e-04_r8, & + &1.9705e-04_r8,1.2084e-04_r8,8.5383e-06_r8/) + kao(:, 5,11, 1) = (/ & + &2.1856e-04_r8,3.1574e-04_r8,3.2801e-04_r8,3.2141e-04_r8,2.9895e-04_r8,2.6285e-04_r8, & + &2.0518e-04_r8,1.2441e-04_r8,9.1615e-06_r8/) + kao(:, 1,12, 1) = (/ & + &1.7554e-04_r8,2.6383e-04_r8,2.7930e-04_r8,2.7562e-04_r8,2.5860e-04_r8,2.2333e-04_r8, & + &1.7363e-04_r8,1.0883e-04_r8,5.7385e-06_r8/) + kao(:, 2,12, 1) = (/ & + &1.9241e-04_r8,2.8007e-04_r8,2.9311e-04_r8,2.8776e-04_r8,2.6852e-04_r8,2.3492e-04_r8, & + &1.8150e-04_r8,1.1266e-04_r8,6.8723e-06_r8/) + kao(:, 3,12, 1) = (/ & + &2.0743e-04_r8,2.9497e-04_r8,3.0602e-04_r8,2.9878e-04_r8,2.7794e-04_r8,2.4424e-04_r8, & + &1.8850e-04_r8,1.1619e-04_r8,7.4728e-06_r8/) + kao(:, 4,12, 1) = (/ & + &2.2033e-04_r8,3.0884e-04_r8,3.1746e-04_r8,3.0874e-04_r8,2.8629e-04_r8,2.5127e-04_r8, & + &1.9681e-04_r8,1.2004e-04_r8,7.8331e-06_r8/) + kao(:, 5,12, 1) = (/ & + &2.3385e-04_r8,3.2096e-04_r8,3.2817e-04_r8,3.1852e-04_r8,2.9492e-04_r8,2.5838e-04_r8, & + &2.0541e-04_r8,1.2394e-04_r8,8.4107e-06_r8/) + kao(:, 1,13, 1) = (/ & + &1.4984e-04_r8,2.2462e-04_r8,2.3735e-04_r8,2.3350e-04_r8,2.1852e-04_r8,1.8858e-04_r8, & + &1.4655e-04_r8,9.1919e-05_r8,4.7944e-06_r8/) + kao(:, 2,13, 1) = (/ & + &1.6431e-04_r8,2.3822e-04_r8,2.4852e-04_r8,2.4374e-04_r8,2.2685e-04_r8,1.9798e-04_r8, & + &1.5298e-04_r8,9.5139e-05_r8,5.7512e-06_r8/) + kao(:, 3,13, 1) = (/ & + &1.7714e-04_r8,2.5149e-04_r8,2.5950e-04_r8,2.5249e-04_r8,2.3438e-04_r8,2.0591e-04_r8, & + &1.5891e-04_r8,9.8151e-05_r8,6.2816e-06_r8/) + kao(:, 4,13, 1) = (/ & + &1.8918e-04_r8,2.6227e-04_r8,2.6867e-04_r8,2.6081e-04_r8,2.4142e-04_r8,2.1149e-04_r8, & + &1.6602e-04_r8,1.0121e-04_r8,6.5742e-06_r8/) + kao(:, 5,13, 1) = (/ & + &1.9984e-04_r8,2.7202e-04_r8,2.7776e-04_r8,2.6884e-04_r8,2.4875e-04_r8,2.1766e-04_r8, & + &1.7300e-04_r8,1.0449e-04_r8,7.0482e-06_r8/) + kao(:, 1, 1, 2) = (/ & + &1.6519e-06_r8,1.6500e-05_r8,2.5026e-05_r8,3.2759e-05_r8,4.0208e-05_r8,4.7995e-05_r8, & + &5.7218e-05_r8,7.0450e-05_r8,6.2071e-05_r8/) + kao(:, 2, 1, 2) = (/ & + &1.7427e-06_r8,1.6766e-05_r8,2.5514e-05_r8,3.3509e-05_r8,4.1226e-05_r8,4.9256e-05_r8, & + &5.8782e-05_r8,7.2775e-05_r8,6.4227e-05_r8/) + kao(:, 3, 1, 2) = (/ & + &1.8342e-06_r8,1.7039e-05_r8,2.6012e-05_r8,3.4217e-05_r8,4.2214e-05_r8,5.0504e-05_r8, & + &6.0325e-05_r8,7.4727e-05_r8,6.6376e-05_r8/) + kao(:, 4, 1, 2) = (/ & + &1.9060e-06_r8,1.7243e-05_r8,2.6493e-05_r8,3.4981e-05_r8,4.3216e-05_r8,5.1749e-05_r8, & + &6.1747e-05_r8,7.6716e-05_r8,6.8482e-05_r8/) + kao(:, 5, 1, 2) = (/ & + &1.9873e-06_r8,1.7462e-05_r8,2.6980e-05_r8,3.5686e-05_r8,4.4149e-05_r8,5.2919e-05_r8, & + &6.3181e-05_r8,7.8643e-05_r8,7.0600e-05_r8/) + kao(:, 1, 2, 2) = (/ & + &2.1537e-06_r8,1.7686e-05_r8,2.5477e-05_r8,3.2084e-05_r8,3.8037e-05_r8,4.3791e-05_r8, & + &5.0118e-05_r8,5.9749e-05_r8,5.2659e-05_r8/) + kao(:, 2, 2, 2) = (/ & + &2.2967e-06_r8,1.7950e-05_r8,2.5979e-05_r8,3.2808e-05_r8,3.8966e-05_r8,4.4991e-05_r8, & + &5.1587e-05_r8,6.1578e-05_r8,5.4559e-05_r8/) + kao(:, 3, 2, 2) = (/ & + &2.4223e-06_r8,1.8241e-05_r8,2.6472e-05_r8,3.3476e-05_r8,3.9818e-05_r8,4.6056e-05_r8, & + &5.2876e-05_r8,6.3201e-05_r8,5.6392e-05_r8/) + kao(:, 4, 2, 2) = (/ & + &2.5452e-06_r8,1.8478e-05_r8,2.6920e-05_r8,3.4112e-05_r8,4.0714e-05_r8,4.7174e-05_r8, & + &5.4253e-05_r8,6.4831e-05_r8,5.8337e-05_r8/) + kao(:, 5, 2, 2) = (/ & + &2.6442e-06_r8,1.8696e-05_r8,2.7330e-05_r8,3.4790e-05_r8,4.1641e-05_r8,4.8326e-05_r8, & + &5.5567e-05_r8,6.6400e-05_r8,6.0213e-05_r8/) + kao(:, 1, 3, 2) = (/ & + &3.6781e-06_r8,2.1946e-05_r8,2.9916e-05_r8,3.5559e-05_r8,4.0089e-05_r8,4.3735e-05_r8, & + &4.6884e-05_r8,5.0541e-05_r8,4.3984e-05_r8/) + kao(:, 2, 3, 2) = (/ & + &3.9348e-06_r8,2.2135e-05_r8,3.0461e-05_r8,3.6306e-05_r8,4.1005e-05_r8,4.4863e-05_r8, & + &4.8174e-05_r8,5.2207e-05_r8,4.5557e-05_r8/) + kao(:, 3, 3, 2) = (/ & + &4.1798e-06_r8,2.2403e-05_r8,3.0963e-05_r8,3.7011e-05_r8,4.1865e-05_r8,4.5861e-05_r8, & + &4.9330e-05_r8,5.3612e-05_r8,4.7151e-05_r8/) + kao(:, 4, 3, 2) = (/ & + &4.4176e-06_r8,2.2879e-05_r8,3.1514e-05_r8,3.7717e-05_r8,4.2706e-05_r8,4.6836e-05_r8, & + &5.0501e-05_r8,5.4941e-05_r8,4.8733e-05_r8/) + kao(:, 5, 3, 2) = (/ & + &4.5930e-06_r8,2.3205e-05_r8,3.1822e-05_r8,3.8274e-05_r8,4.3472e-05_r8,4.7803e-05_r8, & + &5.1670e-05_r8,5.6326e-05_r8,5.0305e-05_r8/) + kao(:, 1, 4, 2) = (/ & + &6.4358e-06_r8,2.9282e-05_r8,3.6943e-05_r8,4.2596e-05_r8,4.5632e-05_r8,4.7319e-05_r8, & + &4.7633e-05_r8,4.6727e-05_r8,3.6481e-05_r8/) + kao(:, 2, 4, 2) = (/ & + &6.8669e-06_r8,2.9817e-05_r8,3.7275e-05_r8,4.3436e-05_r8,4.6592e-05_r8,4.8428e-05_r8, & + &4.8930e-05_r8,4.8153e-05_r8,3.7877e-05_r8/) + kao(:, 3, 4, 2) = (/ & + &7.3364e-06_r8,3.0199e-05_r8,3.7809e-05_r8,4.3827e-05_r8,4.7553e-05_r8,4.9496e-05_r8, & + &5.0112e-05_r8,4.9423e-05_r8,3.9242e-05_r8/) + kao(:, 4, 4, 2) = (/ & + &7.7623e-06_r8,3.0806e-05_r8,3.8513e-05_r8,4.4137e-05_r8,4.8467e-05_r8,5.0544e-05_r8, & + &5.1178e-05_r8,5.0627e-05_r8,4.0689e-05_r8/) + kao(:, 5, 4, 2) = (/ & + &8.2042e-06_r8,3.1502e-05_r8,3.9409e-05_r8,4.4849e-05_r8,4.9430e-05_r8,5.1580e-05_r8, & + &5.2292e-05_r8,5.1835e-05_r8,4.2152e-05_r8/) + kao(:, 1, 5, 2) = (/ & + &1.0402e-05_r8,3.8540e-05_r8,4.6318e-05_r8,5.0020e-05_r8,5.3672e-05_r8,5.3150e-05_r8, & + &5.0796e-05_r8,4.5989e-05_r8,3.1155e-05_r8/) + kao(:, 2, 5, 2) = (/ & + &1.1085e-05_r8,3.9241e-05_r8,4.7238e-05_r8,5.0920e-05_r8,5.3596e-05_r8,5.4294e-05_r8, & + &5.2010e-05_r8,4.7261e-05_r8,3.2691e-05_r8/) + kao(:, 3, 5, 2) = (/ & + &1.1793e-05_r8,3.9912e-05_r8,4.8110e-05_r8,5.1979e-05_r8,5.4361e-05_r8,5.5470e-05_r8, & + &5.3221e-05_r8,4.8498e-05_r8,3.4229e-05_r8/) + kao(:, 4, 5, 2) = (/ & + &1.2505e-05_r8,4.0706e-05_r8,4.8865e-05_r8,5.3127e-05_r8,5.5321e-05_r8,5.6646e-05_r8, & + &5.4402e-05_r8,4.9696e-05_r8,3.5620e-05_r8/) + kao(:, 5, 5, 2) = (/ & + &1.3238e-05_r8,4.1575e-05_r8,5.0157e-05_r8,5.4552e-05_r8,5.6339e-05_r8,5.7036e-05_r8, & + &5.5608e-05_r8,5.0863e-05_r8,3.6859e-05_r8/) + kao(:, 1, 6, 2) = (/ & + &1.5685e-05_r8,4.8160e-05_r8,5.7576e-05_r8,6.0816e-05_r8,6.0795e-05_r8,5.9888e-05_r8, & + &5.5641e-05_r8,4.7076e-05_r8,2.7125e-05_r8/) + kao(:, 2, 6, 2) = (/ & + &1.6746e-05_r8,4.9438e-05_r8,5.8728e-05_r8,6.2091e-05_r8,6.2171e-05_r8,6.0759e-05_r8, & + &5.6976e-05_r8,4.8239e-05_r8,2.8411e-05_r8/) + kao(:, 3, 6, 2) = (/ & + &1.7756e-05_r8,5.0622e-05_r8,5.9836e-05_r8,6.3203e-05_r8,6.3569e-05_r8,6.1458e-05_r8, & + &5.8288e-05_r8,4.9429e-05_r8,2.9823e-05_r8/) + kao(:, 4, 6, 2) = (/ & + &1.8829e-05_r8,5.1859e-05_r8,6.0806e-05_r8,6.4509e-05_r8,6.5119e-05_r8,6.2540e-05_r8, & + &5.8809e-05_r8,5.0652e-05_r8,3.1085e-05_r8/) + kao(:, 5, 6, 2) = (/ & + &1.9856e-05_r8,5.2975e-05_r8,6.2034e-05_r8,6.5989e-05_r8,6.6522e-05_r8,6.3894e-05_r8, & + &5.9538e-05_r8,5.1853e-05_r8,3.2453e-05_r8/) + kao(:, 1, 7, 2) = (/ & + &2.4856e-05_r8,6.4218e-05_r8,7.4055e-05_r8,7.7980e-05_r8,7.5911e-05_r8,7.1057e-05_r8, & + &6.3849e-05_r8,5.1579e-05_r8,2.5153e-05_r8/) + kao(:, 2, 7, 2) = (/ & + &2.6608e-05_r8,6.6305e-05_r8,7.5730e-05_r8,7.9533e-05_r8,7.7616e-05_r8,7.2887e-05_r8, & + &6.4610e-05_r8,5.2907e-05_r8,2.6881e-05_r8/) + kao(:, 3, 7, 2) = (/ & + &2.8288e-05_r8,6.8291e-05_r8,7.7618e-05_r8,8.1185e-05_r8,7.9322e-05_r8,7.4738e-05_r8, & + &6.5685e-05_r8,5.4242e-05_r8,2.8455e-05_r8/) + kao(:, 4, 7, 2) = (/ & + &3.0045e-05_r8,7.0265e-05_r8,7.9536e-05_r8,8.2799e-05_r8,8.1209e-05_r8,7.6305e-05_r8, & + &6.7186e-05_r8,5.5601e-05_r8,2.9886e-05_r8/) + kao(:, 5, 7, 2) = (/ & + &3.1755e-05_r8,7.2003e-05_r8,8.1183e-05_r8,8.4367e-05_r8,8.2925e-05_r8,7.7935e-05_r8, & + &6.8892e-05_r8,5.5914e-05_r8,3.1298e-05_r8/) + kao(:, 1, 8, 2) = (/ & + &4.6308e-05_r8,9.7055e-05_r8,1.0843e-04_r8,1.0990e-04_r8,1.0798e-04_r8,9.8279e-05_r8, & + &8.2910e-05_r8,6.2908e-05_r8,2.6615e-05_r8/) + kao(:, 2, 8, 2) = (/ & + &4.9990e-05_r8,1.0048e-04_r8,1.1189e-04_r8,1.1329e-04_r8,1.1038e-04_r8,1.0108e-04_r8, & + &8.5246e-05_r8,6.3800e-05_r8,2.8720e-05_r8/) + kao(:, 3, 8, 2) = (/ & + &5.3406e-05_r8,1.0353e-04_r8,1.1536e-04_r8,1.1646e-04_r8,1.1270e-04_r8,1.0316e-04_r8, & + &8.7419e-05_r8,6.5105e-05_r8,3.1055e-05_r8/) + kao(:, 4, 8, 2) = (/ & + &5.6634e-05_r8,1.0658e-04_r8,1.1884e-04_r8,1.1968e-04_r8,1.1489e-04_r8,1.0536e-04_r8, & + &8.9223e-05_r8,6.6739e-05_r8,3.2877e-05_r8/) + kao(:, 5, 8, 2) = (/ & + &5.9979e-05_r8,1.0942e-04_r8,1.2217e-04_r8,1.2302e-04_r8,1.1760e-04_r8,1.0763e-04_r8, & + &9.1750e-05_r8,6.8524e-05_r8,3.4517e-05_r8/) + kao(:, 1, 9, 2) = (/ & + &1.6574e-04_r8,2.3675e-04_r8,2.5425e-04_r8,2.5367e-04_r8,2.3792e-04_r8,2.1003e-04_r8, & + &1.7177e-04_r8,1.1936e-04_r8,3.2512e-05_r8/) + kao(:, 2, 9, 2) = (/ & + &1.7873e-04_r8,2.4657e-04_r8,2.6302e-04_r8,2.6299e-04_r8,2.4679e-04_r8,2.1704e-04_r8, & + &1.7629e-04_r8,1.2297e-04_r8,3.4956e-05_r8/) + kao(:, 3, 9, 2) = (/ & + &1.9203e-04_r8,2.5827e-04_r8,2.7104e-04_r8,2.7133e-04_r8,2.5463e-04_r8,2.2408e-04_r8, & + &1.8102e-04_r8,1.2579e-04_r8,3.6986e-05_r8/) + kao(:, 4, 9, 2) = (/ & + &2.0457e-04_r8,2.7047e-04_r8,2.8009e-04_r8,2.7979e-04_r8,2.6236e-04_r8,2.3082e-04_r8, & + &1.8610e-04_r8,1.2867e-04_r8,3.9201e-05_r8/) + kao(:, 5, 9, 2) = (/ & + &2.1654e-04_r8,2.8311e-04_r8,2.9060e-04_r8,2.8789e-04_r8,2.7019e-04_r8,2.3757e-04_r8, & + &1.9128e-04_r8,1.3157e-04_r8,4.1162e-05_r8/) + kao(:, 1,10, 2) = (/ & + &6.9835e-04_r8,7.7425e-04_r8,7.4212e-04_r8,6.8606e-04_r8,6.1917e-04_r8,5.3712e-04_r8, & + &4.2860e-04_r8,2.7889e-04_r8,3.4936e-05_r8/) + kao(:, 2,10, 2) = (/ & + &7.4976e-04_r8,8.1587e-04_r8,7.7895e-04_r8,7.1764e-04_r8,6.4311e-04_r8,5.5763e-04_r8, & + &4.4404e-04_r8,2.8872e-04_r8,3.8434e-05_r8/) + kao(:, 3,10, 2) = (/ & + &8.0421e-04_r8,8.6133e-04_r8,8.1873e-04_r8,7.5123e-04_r8,6.6805e-04_r8,5.7460e-04_r8, & + &4.5895e-04_r8,2.9845e-04_r8,4.2197e-05_r8/) + kao(:, 4,10, 2) = (/ & + &8.5541e-04_r8,9.0651e-04_r8,8.6169e-04_r8,7.8842e-04_r8,6.9649e-04_r8,5.9375e-04_r8, & + &4.7283e-04_r8,3.0790e-04_r8,4.6109e-05_r8/) + kao(:, 5,10, 2) = (/ & + &9.0554e-04_r8,9.5112e-04_r8,9.0374e-04_r8,8.2600e-04_r8,7.2587e-04_r8,6.1366e-04_r8, & + &4.8709e-04_r8,3.1697e-04_r8,4.9839e-05_r8/) + kao(:, 1,11, 2) = (/ & + &1.0573e-03_r8,1.1046e-03_r8,1.0331e-03_r8,9.3641e-04_r8,8.2149e-04_r8,6.9220e-04_r8, & + &5.4269e-04_r8,3.5137e-04_r8,3.2311e-05_r8/) + kao(:, 2,11, 2) = (/ & + &1.1354e-03_r8,1.1699e-03_r8,1.0957e-03_r8,9.8791e-04_r8,8.6081e-04_r8,7.2123e-04_r8, & + &5.6428e-04_r8,3.6441e-04_r8,3.5797e-05_r8/) + kao(:, 3,11, 2) = (/ & + &1.2157e-03_r8,1.2370e-03_r8,1.1565e-03_r8,1.0415e-03_r8,9.0546e-04_r8,7.4993e-04_r8, & + &5.8345e-04_r8,3.7768e-04_r8,3.9564e-05_r8/) + kao(:, 4,11, 2) = (/ & + &1.2894e-03_r8,1.3041e-03_r8,1.2183e-03_r8,1.0951e-03_r8,9.4833e-04_r8,7.8292e-04_r8, & + &6.0424e-04_r8,3.8988e-04_r8,4.3105e-05_r8/) + kao(:, 5,11, 2) = (/ & + &1.3602e-03_r8,1.3714e-03_r8,1.2775e-03_r8,1.1464e-03_r8,9.9122e-04_r8,8.1361e-04_r8, & + &6.2375e-04_r8,4.0138e-04_r8,4.6502e-05_r8/) + kao(:, 1,12, 2) = (/ & + &1.1559e-03_r8,1.1821e-03_r8,1.1002e-03_r8,9.8760e-04_r8,8.5869e-04_r8,7.1597e-04_r8, & + &5.5368e-04_r8,3.5629e-04_r8,2.8926e-05_r8/) + kao(:, 2,12, 2) = (/ & + &1.2387e-03_r8,1.2530e-03_r8,1.1642e-03_r8,1.0435e-03_r8,9.0422e-04_r8,7.4802e-04_r8, & + &5.7617e-04_r8,3.7052e-04_r8,3.1589e-05_r8/) + kao(:, 3,12, 2) = (/ & + &1.3216e-03_r8,1.3229e-03_r8,1.2283e-03_r8,1.1015e-03_r8,9.5193e-04_r8,7.8187e-04_r8, & + &5.9954e-04_r8,3.8460e-04_r8,3.4577e-05_r8/) + kao(:, 4,12, 2) = (/ & + &1.3983e-03_r8,1.3942e-03_r8,1.2931e-03_r8,1.1587e-03_r8,9.9709e-04_r8,8.1633e-04_r8, & + &6.2085e-04_r8,3.9719e-04_r8,3.7982e-05_r8/) + kao(:, 5,12, 2) = (/ & + &1.4751e-03_r8,1.4634e-03_r8,1.3557e-03_r8,1.2116e-03_r8,1.0389e-03_r8,8.4961e-04_r8, & + &6.4030e-04_r8,4.0878e-04_r8,4.0969e-05_r8/) + kao(:, 1,13, 2) = (/ & + &1.0038e-03_r8,1.0239e-03_r8,9.5244e-04_r8,8.5524e-04_r8,7.4348e-04_r8,6.2001e-04_r8, & + &4.7929e-04_r8,3.0767e-04_r8,2.4695e-05_r8/) + kao(:, 2,13, 2) = (/ & + &1.0734e-03_r8,1.0865e-03_r8,1.0094e-03_r8,9.0484e-04_r8,7.8346e-04_r8,6.4723e-04_r8, & + &4.9815e-04_r8,3.1985e-04_r8,2.6858e-05_r8/) + kao(:, 3,13, 2) = (/ & + &1.1391e-03_r8,1.1434e-03_r8,1.0621e-03_r8,9.5239e-04_r8,8.2130e-04_r8,6.7579e-04_r8, & + &5.1796e-04_r8,3.3140e-04_r8,2.9385e-05_r8/) + kao(:, 4,13, 2) = (/ & + &1.2032e-03_r8,1.2025e-03_r8,1.1163e-03_r8,9.9786e-04_r8,8.5960e-04_r8,7.0590e-04_r8, & + &5.3619e-04_r8,3.4228e-04_r8,3.2189e-05_r8/) + kao(:, 5,13, 2) = (/ & + &1.2690e-03_r8,1.2617e-03_r8,1.1676e-03_r8,1.0418e-03_r8,8.9504e-04_r8,7.3293e-04_r8, & + &5.5106e-04_r8,3.5176e-04_r8,3.4791e-05_r8/) + kao(:, 1, 1, 3) = (/ & + &3.4054e-06_r8,3.6169e-05_r8,5.7781e-05_r8,7.9702e-05_r8,9.9450e-05_r8,1.1908e-04_r8, & + &1.4021e-04_r8,1.6904e-04_r8,1.5965e-04_r8/) + kao(:, 2, 1, 3) = (/ & + &3.5406e-06_r8,3.7213e-05_r8,5.9148e-05_r8,7.9930e-05_r8,1.0281e-04_r8,1.2326e-04_r8, & + &1.4516e-04_r8,1.7473e-04_r8,1.6518e-04_r8/) + kao(:, 3, 1, 3) = (/ & + &3.6962e-06_r8,3.8392e-05_r8,6.0628e-05_r8,8.1614e-05_r8,1.0332e-04_r8,1.2805e-04_r8, & + &1.5083e-04_r8,1.8127e-04_r8,1.7179e-04_r8/) + kao(:, 4, 1, 3) = (/ & + &3.8150e-06_r8,3.9649e-05_r8,6.2587e-05_r8,8.4276e-05_r8,1.0580e-04_r8,1.2950e-04_r8, & + &1.5730e-04_r8,1.8884e-04_r8,1.7648e-04_r8/) + kao(:, 5, 1, 3) = (/ & + &3.9425e-06_r8,4.0895e-05_r8,6.4628e-05_r8,8.7067e-05_r8,1.0971e-04_r8,1.3287e-04_r8, & + &1.5979e-04_r8,1.9707e-04_r8,1.8056e-04_r8/) + kao(:, 1, 2, 3) = (/ & + &4.7659e-06_r8,3.7672e-05_r8,5.6772e-05_r8,7.4964e-05_r8,9.3354e-05_r8,1.1163e-04_r8, & + &1.2805e-04_r8,1.4897e-04_r8,1.4118e-04_r8/) + kao(:, 2, 2, 3) = (/ & + &4.9285e-06_r8,3.8459e-05_r8,5.8331e-05_r8,7.6310e-05_r8,9.3490e-05_r8,1.1292e-04_r8, & + &1.3218e-04_r8,1.5402e-04_r8,1.4609e-04_r8/) + kao(:, 3, 2, 3) = (/ & + &5.1241e-06_r8,3.9569e-05_r8,6.0060e-05_r8,7.8269e-05_r8,9.6361e-05_r8,1.1403e-04_r8, & + &1.3730e-04_r8,1.5986e-04_r8,1.4966e-04_r8/) + kao(:, 4, 2, 3) = (/ & + &5.2863e-06_r8,4.0536e-05_r8,6.2133e-05_r8,8.0760e-05_r8,9.8821e-05_r8,1.1724e-04_r8, & + &1.3737e-04_r8,1.6656e-04_r8,1.5208e-04_r8/) + kao(:, 5, 2, 3) = (/ & + &5.4310e-06_r8,4.1540e-05_r8,6.3967e-05_r8,8.3433e-05_r8,1.0178e-04_r8,1.2080e-04_r8, & + &1.4142e-04_r8,1.7063e-04_r8,1.5631e-04_r8/) + kao(:, 1, 3, 3) = (/ & + &8.9186e-06_r8,4.5407e-05_r8,6.3526e-05_r8,7.8550e-05_r8,9.1618e-05_r8,1.0496e-04_r8, & + &1.2158e-04_r8,1.3284e-04_r8,1.2340e-04_r8/) + kao(:, 2, 3, 3) = (/ & + &9.2443e-06_r8,4.6508e-05_r8,6.4784e-05_r8,8.0506e-05_r8,9.3613e-05_r8,1.0642e-04_r8, & + &1.2005e-04_r8,1.3711e-04_r8,1.2632e-04_r8/) + kao(:, 3, 3, 3) = (/ & + &9.5550e-06_r8,4.7677e-05_r8,6.6548e-05_r8,8.2736e-05_r8,9.6188e-05_r8,1.0877e-04_r8, & + &1.2156e-04_r8,1.4196e-04_r8,1.2696e-04_r8/) + kao(:, 4, 3, 3) = (/ & + &9.9051e-06_r8,4.8778e-05_r8,6.8112e-05_r8,8.4988e-05_r8,9.9246e-05_r8,1.1223e-04_r8, & + &1.2463e-04_r8,1.4159e-04_r8,1.2947e-04_r8/) + kao(:, 5, 3, 3) = (/ & + &1.0162e-05_r8,4.9942e-05_r8,6.9999e-05_r8,8.7421e-05_r8,1.0238e-04_r8,1.1576e-04_r8, & + &1.2839e-04_r8,1.4461e-04_r8,1.3351e-04_r8/) + kao(:, 1, 4, 3) = (/ & + &1.6753e-05_r8,5.8237e-05_r8,7.6272e-05_r8,8.8204e-05_r8,9.8762e-05_r8,1.0698e-04_r8, & + &1.1349e-04_r8,1.2379e-04_r8,1.0697e-04_r8/) + kao(:, 2, 4, 3) = (/ & + &1.7441e-05_r8,5.9610e-05_r8,7.7972e-05_r8,9.0358e-05_r8,1.0097e-04_r8,1.0919e-04_r8, & + &1.1491e-04_r8,1.2294e-04_r8,1.0628e-04_r8/) + kao(:, 3, 4, 3) = (/ & + &1.8082e-05_r8,6.1175e-05_r8,7.9988e-05_r8,9.2267e-05_r8,1.0332e-04_r8,1.1211e-04_r8, & + &1.1776e-04_r8,1.2346e-04_r8,1.0729e-04_r8/) + kao(:, 4, 4, 3) = (/ & + &1.8658e-05_r8,6.2685e-05_r8,8.1816e-05_r8,9.5481e-05_r8,1.0615e-04_r8,1.1496e-04_r8, & + &1.2097e-04_r8,1.2608e-04_r8,1.1024e-04_r8/) + kao(:, 5, 4, 3) = (/ & + &1.9340e-05_r8,6.4673e-05_r8,8.3970e-05_r8,9.8481e-05_r8,1.0873e-04_r8,1.1832e-04_r8, & + &1.2499e-04_r8,1.2979e-04_r8,1.1362e-04_r8/) + kao(:, 1, 5, 3) = (/ & + &2.8523e-05_r8,7.5471e-05_r8,9.2112e-05_r8,1.0383e-04_r8,1.0948e-04_r8,1.1290e-04_r8, & + &1.1403e-04_r8,1.1277e-04_r8,8.7972e-05_r8/) + kao(:, 2, 5, 3) = (/ & + &2.9775e-05_r8,7.7638e-05_r8,9.4306e-05_r8,1.0580e-04_r8,1.1226e-04_r8,1.1540e-04_r8, & + &1.1664e-04_r8,1.1378e-04_r8,8.7781e-05_r8/) + kao(:, 3, 5, 3) = (/ & + &3.1032e-05_r8,7.9995e-05_r8,9.6878e-05_r8,1.0807e-04_r8,1.1530e-04_r8,1.1833e-04_r8, & + &1.1968e-04_r8,1.1643e-04_r8,8.9738e-05_r8/) + kao(:, 4, 5, 3) = (/ & + &3.2122e-05_r8,8.2389e-05_r8,9.9387e-05_r8,1.1070e-04_r8,1.1849e-04_r8,1.2073e-04_r8, & + &1.2266e-04_r8,1.1931e-04_r8,9.1761e-05_r8/) + kao(:, 5, 5, 3) = (/ & + &3.3412e-05_r8,8.5294e-05_r8,1.0214e-04_r8,1.1395e-04_r8,1.2220e-04_r8,1.2513e-04_r8, & + &1.2589e-04_r8,1.2317e-04_r8,9.4332e-05_r8/) + kao(:, 1, 6, 3) = (/ & + &4.4933e-05_r8,9.9737e-05_r8,1.1255e-04_r8,1.2118e-04_r8,1.2554e-04_r8,1.2364e-04_r8, & + &1.1791e-04_r8,1.0852e-04_r8,7.4135e-05_r8/) + kao(:, 2, 6, 3) = (/ & + &4.7071e-05_r8,1.0236e-04_r8,1.1567e-04_r8,1.2397e-04_r8,1.2766e-04_r8,1.2658e-04_r8, & + &1.2060e-04_r8,1.1056e-04_r8,7.5435e-05_r8/) + kao(:, 3, 6, 3) = (/ & + &4.9151e-05_r8,1.0514e-04_r8,1.1921e-04_r8,1.2711e-04_r8,1.3040e-04_r8,1.2992e-04_r8, & + &1.2331e-04_r8,1.1371e-04_r8,7.6849e-05_r8/) + kao(:, 4, 6, 3) = (/ & + &5.1024e-05_r8,1.0807e-04_r8,1.2306e-04_r8,1.3034e-04_r8,1.3370e-04_r8,1.3344e-04_r8, & + &1.2682e-04_r8,1.1612e-04_r8,7.8630e-05_r8/) + kao(:, 5, 6, 3) = (/ & + &5.2854e-05_r8,1.1144e-04_r8,1.2670e-04_r8,1.3361e-04_r8,1.3751e-04_r8,1.3677e-04_r8, & + &1.3113e-04_r8,1.1903e-04_r8,8.1063e-05_r8/) + kao(:, 1, 7, 3) = (/ & + &7.4131e-05_r8,1.3771e-04_r8,1.5135e-04_r8,1.5339e-04_r8,1.5199e-04_r8,1.4542e-04_r8, & + &1.3212e-04_r8,1.1157e-04_r8,6.3305e-05_r8/) + kao(:, 2, 7, 3) = (/ & + &7.8122e-05_r8,1.4080e-04_r8,1.5542e-04_r8,1.5789e-04_r8,1.5525e-04_r8,1.4808e-04_r8, & + &1.3571e-04_r8,1.1400e-04_r8,6.4305e-05_r8/) + kao(:, 3, 7, 3) = (/ & + &8.1792e-05_r8,1.4429e-04_r8,1.5980e-04_r8,1.6259e-04_r8,1.5930e-04_r8,1.5173e-04_r8, & + &1.3906e-04_r8,1.1682e-04_r8,6.5778e-05_r8/) + kao(:, 4, 7, 3) = (/ & + &8.5102e-05_r8,1.4854e-04_r8,1.6447e-04_r8,1.6719e-04_r8,1.6365e-04_r8,1.5623e-04_r8, & + &1.4249e-04_r8,1.1910e-04_r8,6.8216e-05_r8/) + kao(:, 5, 7, 3) = (/ & + &8.8343e-05_r8,1.5302e-04_r8,1.6961e-04_r8,1.7246e-04_r8,1.6859e-04_r8,1.6045e-04_r8, & + &1.4567e-04_r8,1.2333e-04_r8,7.0812e-05_r8/) + kao(:, 1, 8, 3) = (/ & + &1.4407e-04_r8,2.1929e-04_r8,2.3408e-04_r8,2.3175e-04_r8,2.1747e-04_r8,1.9684e-04_r8, & + &1.7181e-04_r8,1.3227e-04_r8,5.5189e-05_r8/) + kao(:, 2, 8, 3) = (/ & + &1.5218e-04_r8,2.2535e-04_r8,2.3947e-04_r8,2.3742e-04_r8,2.2354e-04_r8,2.0175e-04_r8, & + &1.7481e-04_r8,1.3567e-04_r8,5.7508e-05_r8/) + kao(:, 3, 8, 3) = (/ & + &1.5981e-04_r8,2.3168e-04_r8,2.4529e-04_r8,2.4373e-04_r8,2.2990e-04_r8,2.0756e-04_r8, & + &1.7860e-04_r8,1.3869e-04_r8,5.9914e-05_r8/) + kao(:, 4, 8, 3) = (/ & + &1.6710e-04_r8,2.3880e-04_r8,2.5211e-04_r8,2.5020e-04_r8,2.3684e-04_r8,2.1373e-04_r8, & + &1.8326e-04_r8,1.4183e-04_r8,6.3164e-05_r8/) + kao(:, 5, 8, 3) = (/ & + &1.7380e-04_r8,2.4599e-04_r8,2.5929e-04_r8,2.5766e-04_r8,2.4400e-04_r8,2.1994e-04_r8, & + &1.8763e-04_r8,1.4519e-04_r8,6.6105e-05_r8/) + kao(:, 1, 9, 3) = (/ & + &5.2627e-04_r8,6.1534e-04_r8,6.0941e-04_r8,5.7646e-04_r8,5.2415e-04_r8,4.5407e-04_r8, & + &3.6135e-04_r8,2.4279e-04_r8,6.7993e-05_r8/) + kao(:, 2, 9, 3) = (/ & + &5.5864e-04_r8,6.4193e-04_r8,6.3124e-04_r8,5.9396e-04_r8,5.3793e-04_r8,4.6535e-04_r8, & + &3.7115e-04_r8,2.4862e-04_r8,7.5217e-05_r8/) + kao(:, 3, 9, 3) = (/ & + &5.8842e-04_r8,6.6676e-04_r8,6.5277e-04_r8,6.1271e-04_r8,5.5239e-04_r8,4.7636e-04_r8, & + &3.8150e-04_r8,2.5543e-04_r8,8.1799e-05_r8/) + kao(:, 4, 9, 3) = (/ & + &6.1785e-04_r8,6.9166e-04_r8,6.7437e-04_r8,6.3091e-04_r8,5.6815e-04_r8,4.8941e-04_r8, & + &3.9213e-04_r8,2.6284e-04_r8,8.7598e-05_r8/) + kao(:, 5, 9, 3) = (/ & + &6.4520e-04_r8,7.1602e-04_r8,6.9663e-04_r8,6.4913e-04_r8,5.8418e-04_r8,5.0317e-04_r8, & + &4.0334e-04_r8,2.7060e-04_r8,9.2801e-05_r8/) + kao(:, 1,10, 3) = (/ & + &2.1645e-03_r8,2.1618e-03_r8,2.0014e-03_r8,1.7923e-03_r8,1.5495e-03_r8,1.2769e-03_r8, & + &9.6609e-04_r8,6.0453e-04_r8,1.0410e-04_r8/) + kao(:, 2,10, 3) = (/ & + &2.3095e-03_r8,2.2836e-03_r8,2.1017e-03_r8,1.8749e-03_r8,1.6151e-03_r8,1.3240e-03_r8, & + &9.9711e-04_r8,6.2160e-04_r8,1.1408e-04_r8/) + kao(:, 3,10, 3) = (/ & + &2.4464e-03_r8,2.3906e-03_r8,2.1944e-03_r8,1.9559e-03_r8,1.6773e-03_r8,1.3715e-03_r8, & + &1.0290e-03_r8,6.3832e-04_r8,1.2224e-04_r8/) + kao(:, 4,10, 3) = (/ & + &2.5757e-03_r8,2.5009e-03_r8,2.2880e-03_r8,2.0317e-03_r8,1.7417e-03_r8,1.4189e-03_r8, & + &1.0630e-03_r8,6.5627e-04_r8,1.3004e-04_r8/) + kao(:, 5,10, 3) = (/ & + &2.6938e-03_r8,2.6117e-03_r8,2.3825e-03_r8,2.1099e-03_r8,1.8067e-03_r8,1.4685e-03_r8, & + &1.0955e-03_r8,6.7426e-04_r8,1.3892e-04_r8/) + kao(:, 1,11, 3) = (/ & + &3.2925e-03_r8,3.1585e-03_r8,2.8624e-03_r8,2.5152e-03_r8,2.1339e-03_r8,1.7245e-03_r8, & + &1.2749e-03_r8,7.7353e-04_r8,1.1570e-04_r8/) + kao(:, 2,11, 3) = (/ & + &3.4939e-03_r8,3.3275e-03_r8,2.9995e-03_r8,2.6330e-03_r8,2.2285e-03_r8,1.7928e-03_r8, & + &1.3221e-03_r8,7.9717e-04_r8,1.2609e-04_r8/) + kao(:, 3,11, 3) = (/ & + &3.6814e-03_r8,3.4852e-03_r8,3.1333e-03_r8,2.7438e-03_r8,2.3219e-03_r8,1.8667e-03_r8, & + &1.3711e-03_r8,8.2069e-04_r8,1.3849e-04_r8/) + kao(:, 4,11, 3) = (/ & + &3.8717e-03_r8,3.6472e-03_r8,3.2720e-03_r8,2.8608e-03_r8,2.4167e-03_r8,1.9357e-03_r8, & + &1.4194e-03_r8,8.4717e-04_r8,1.4796e-04_r8/) + kao(:, 5,11, 3) = (/ & + &4.0507e-03_r8,3.8076e-03_r8,3.4109e-03_r8,2.9754e-03_r8,2.5103e-03_r8,2.0111e-03_r8, & + &1.4691e-03_r8,8.7324e-04_r8,1.5498e-04_r8/) + kao(:, 1,12, 3) = (/ & + &3.6937e-03_r8,3.5033e-03_r8,3.1460e-03_r8,2.7421e-03_r8,2.3088e-03_r8,1.8436e-03_r8, & + &1.3493e-03_r8,8.0094e-04_r8,1.1298e-04_r8/) + kao(:, 2,12, 3) = (/ & + &3.9154e-03_r8,3.6887e-03_r8,3.2999e-03_r8,2.8717e-03_r8,2.4149e-03_r8,1.9245e-03_r8, & + &1.4017e-03_r8,8.2771e-04_r8,1.2419e-04_r8/) + kao(:, 3,12, 3) = (/ & + &4.1285e-03_r8,3.8698e-03_r8,3.4585e-03_r8,3.0012e-03_r8,2.5199e-03_r8,2.0022e-03_r8, & + &1.4553e-03_r8,8.5423e-04_r8,1.3225e-04_r8/) + kao(:, 4,12, 3) = (/ & + &4.3384e-03_r8,4.0509e-03_r8,3.6103e-03_r8,3.1297e-03_r8,2.6243e-03_r8,2.0861e-03_r8, & + &1.5110e-03_r8,8.8306e-04_r8,1.4212e-04_r8/) + kao(:, 5,12, 3) = (/ & + &4.5406e-03_r8,4.2341e-03_r8,3.7730e-03_r8,3.2693e-03_r8,2.7384e-03_r8,2.1705e-03_r8, & + &1.5683e-03_r8,9.1255e-04_r8,1.5213e-04_r8/) + kao(:, 1,13, 3) = (/ & + &3.2602e-03_r8,3.0914e-03_r8,2.7797e-03_r8,2.4220e-03_r8,2.0389e-03_r8,1.6288e-03_r8, & + &1.1889e-03_r8,7.0223e-04_r8,9.9450e-05_r8/) + kao(:, 2,13, 3) = (/ & + &3.4542e-03_r8,3.2567e-03_r8,2.9218e-03_r8,2.5424e-03_r8,2.1356e-03_r8,1.7009e-03_r8, & + &1.2356e-03_r8,7.2786e-04_r8,1.0781e-04_r8/) + kao(:, 3,13, 3) = (/ & + &3.6454e-03_r8,3.4269e-03_r8,3.0649e-03_r8,2.6592e-03_r8,2.2314e-03_r8,1.7744e-03_r8, & + &1.2855e-03_r8,7.5225e-04_r8,1.1667e-04_r8/) + kao(:, 4,13, 3) = (/ & + &3.8341e-03_r8,3.5875e-03_r8,3.2022e-03_r8,2.7784e-03_r8,2.3283e-03_r8,1.8470e-03_r8, & + &1.3345e-03_r8,7.7860e-04_r8,1.2556e-04_r8/) + kao(:, 5,13, 3) = (/ & + &4.0097e-03_r8,3.7448e-03_r8,3.3397e-03_r8,2.8965e-03_r8,2.4238e-03_r8,1.9205e-03_r8, & + &1.3873e-03_r8,8.0728e-04_r8,1.3156e-04_r8/) + kao(:, 1, 1, 4) = (/ & + &7.6190e-06_r8,7.2707e-05_r8,1.2159e-04_r8,1.6797e-04_r8,2.1749e-04_r8,2.7232e-04_r8, & + &3.3756e-04_r8,4.5000e-04_r8,3.7863e-04_r8/) + kao(:, 2, 1, 4) = (/ & + &7.7938e-06_r8,7.4481e-05_r8,1.2500e-04_r8,1.7416e-04_r8,2.2412e-04_r8,2.7984e-04_r8, & + &3.4630e-04_r8,4.4903e-04_r8,3.8823e-04_r8/) + kao(:, 3, 1, 4) = (/ & + &8.0028e-06_r8,7.6115e-05_r8,1.2829e-04_r8,1.8057e-04_r8,2.3237e-04_r8,2.8607e-04_r8, & + &3.5506e-04_r8,4.5741e-04_r8,3.9983e-04_r8/) + kao(:, 4, 1, 4) = (/ & + &8.1270e-06_r8,7.7997e-05_r8,1.3160e-04_r8,1.8544e-04_r8,2.4027e-04_r8,2.9656e-04_r8, & + &3.6016e-04_r8,4.6576e-04_r8,4.1176e-04_r8/) + kao(:, 5, 1, 4) = (/ & + &8.2916e-06_r8,8.0436e-05_r8,1.3585e-04_r8,1.9127e-04_r8,2.4691e-04_r8,3.0708e-04_r8, & + &3.7489e-04_r8,4.7422e-04_r8,4.3091e-04_r8/) + kao(:, 1, 2, 4) = (/ & + &1.0434e-05_r8,7.3238e-05_r8,1.1625e-04_r8,1.5526e-04_r8,1.9383e-04_r8,2.3419e-04_r8, & + &2.8405e-04_r8,3.6155e-04_r8,3.1532e-04_r8/) + kao(:, 2, 2, 4) = (/ & + &1.0681e-05_r8,7.5036e-05_r8,1.1854e-04_r8,1.5997e-04_r8,2.0074e-04_r8,2.4144e-04_r8, & + &2.9129e-04_r8,3.7038e-04_r8,3.2501e-04_r8/) + kao(:, 3, 2, 4) = (/ & + &1.0988e-05_r8,7.7182e-05_r8,1.2126e-04_r8,1.6374e-04_r8,2.0655e-04_r8,2.5052e-04_r8, & + &2.9566e-04_r8,3.7520e-04_r8,3.3554e-04_r8/) + kao(:, 4, 2, 4) = (/ & + &1.1243e-05_r8,7.9396e-05_r8,1.2452e-04_r8,1.6827e-04_r8,2.1213e-04_r8,2.5807e-04_r8, & + &3.0951e-04_r8,3.7973e-04_r8,3.4985e-04_r8/) + kao(:, 5, 2, 4) = (/ & + &1.1433e-05_r8,8.1733e-05_r8,1.2847e-04_r8,1.7400e-04_r8,2.1976e-04_r8,2.6675e-04_r8, & + &3.1873e-04_r8,3.9060e-04_r8,3.6531e-04_r8/) + kao(:, 1, 3, 4) = (/ & + &1.9121e-05_r8,8.5930e-05_r8,1.2401e-04_r8,1.5771e-04_r8,1.8803e-04_r8,2.1587e-04_r8, & + &2.4191e-04_r8,2.8659e-04_r8,2.6000e-04_r8/) + kao(:, 2, 3, 4) = (/ & + &1.9555e-05_r8,8.7968e-05_r8,1.2724e-04_r8,1.6033e-04_r8,1.9279e-04_r8,2.2305e-04_r8, & + &2.5217e-04_r8,2.9281e-04_r8,2.6982e-04_r8/) + kao(:, 3, 3, 4) = (/ & + &2.0014e-05_r8,9.0319e-05_r8,1.3030e-04_r8,1.6432e-04_r8,1.9658e-04_r8,2.2814e-04_r8, & + &2.6130e-04_r8,2.9767e-04_r8,2.8111e-04_r8/) + kao(:, 4, 3, 4) = (/ & + &2.0629e-05_r8,9.3145e-05_r8,1.3414e-04_r8,1.6939e-04_r8,2.0212e-04_r8,2.3402e-04_r8, & + &2.6796e-04_r8,3.0992e-04_r8,2.9328e-04_r8/) + kao(:, 5, 3, 4) = (/ & + &2.0980e-05_r8,9.5719e-05_r8,1.3796e-04_r8,1.7464e-04_r8,2.0857e-04_r8,2.4205e-04_r8, & + &2.7670e-04_r8,3.1994e-04_r8,3.0523e-04_r8/) + kao(:, 1, 4, 4) = (/ & + &3.5480e-05_r8,1.1130e-04_r8,1.4459e-04_r8,1.7323e-04_r8,1.9468e-04_r8,2.1444e-04_r8, & + &2.2966e-04_r8,2.4128e-04_r8,2.1617e-04_r8/) + kao(:, 2, 4, 4) = (/ & + &3.6323e-05_r8,1.1358e-04_r8,1.4824e-04_r8,1.7664e-04_r8,1.9952e-04_r8,2.1840e-04_r8, & + &2.3716e-04_r8,2.5075e-04_r8,2.2864e-04_r8/) + kao(:, 3, 4, 4) = (/ & + &3.7216e-05_r8,1.1624e-04_r8,1.5219e-04_r8,1.8108e-04_r8,2.0484e-04_r8,2.2378e-04_r8, & + &2.4107e-04_r8,2.5972e-04_r8,2.3687e-04_r8/) + kao(:, 4, 4, 4) = (/ & + &3.8132e-05_r8,1.1926e-04_r8,1.5631e-04_r8,1.8514e-04_r8,2.0992e-04_r8,2.3030e-04_r8, & + &2.4787e-04_r8,2.6623e-04_r8,2.4575e-04_r8/) + kao(:, 5, 4, 4) = (/ & + &3.9332e-05_r8,1.2292e-04_r8,1.6148e-04_r8,1.9104e-04_r8,2.1696e-04_r8,2.3764e-04_r8, & + &2.5623e-04_r8,2.7468e-04_r8,2.5520e-04_r8/) + kao(:, 1, 5, 4) = (/ & + &6.0558e-05_r8,1.4537e-04_r8,1.7679e-04_r8,1.9677e-04_r8,2.1242e-04_r8,2.2290e-04_r8, & + &2.2712e-04_r8,2.2468e-04_r8,1.8402e-04_r8/) + kao(:, 2, 5, 4) = (/ & + &6.2024e-05_r8,1.4763e-04_r8,1.8049e-04_r8,2.0169e-04_r8,2.1740e-04_r8,2.2816e-04_r8, & + &2.3141e-04_r8,2.3210e-04_r8,1.9363e-04_r8/) + kao(:, 3, 5, 4) = (/ & + &6.3560e-05_r8,1.5048e-04_r8,1.8446e-04_r8,2.0674e-04_r8,2.2245e-04_r8,2.3297e-04_r8, & + &2.3732e-04_r8,2.3625e-04_r8,1.9953e-04_r8/) + kao(:, 4, 5, 4) = (/ & + &6.5197e-05_r8,1.5389e-04_r8,1.8956e-04_r8,2.1242e-04_r8,2.2805e-04_r8,2.3893e-04_r8, & + &2.4394e-04_r8,2.4242e-04_r8,2.0731e-04_r8/) + kao(:, 5, 5, 4) = (/ & + &6.7408e-05_r8,1.5860e-04_r8,1.9588e-04_r8,2.1916e-04_r8,2.3481e-04_r8,2.4604e-04_r8, & + &2.5157e-04_r8,2.5058e-04_r8,2.1479e-04_r8/) + kao(:, 1, 6, 4) = (/ & + &9.6086e-05_r8,1.8511e-04_r8,2.1787e-04_r8,2.3286e-04_r8,2.3898e-04_r8,2.3907e-04_r8, & + &2.3360e-04_r8,2.1667e-04_r8,1.5583e-04_r8/) + kao(:, 2, 6, 4) = (/ & + &9.8537e-05_r8,1.8825e-04_r8,2.2157e-04_r8,2.3776e-04_r8,2.4456e-04_r8,2.4422e-04_r8, & + &2.3850e-04_r8,2.2088e-04_r8,1.6156e-04_r8/) + kao(:, 3, 6, 4) = (/ & + &1.0106e-04_r8,1.9192e-04_r8,2.2599e-04_r8,2.4309e-04_r8,2.5072e-04_r8,2.5018e-04_r8, & + &2.4346e-04_r8,2.2608e-04_r8,1.6736e-04_r8/) + kao(:, 4, 6, 4) = (/ & + &1.0368e-04_r8,1.9610e-04_r8,2.3144e-04_r8,2.4948e-04_r8,2.5710e-04_r8,2.5653e-04_r8, & + &2.4933e-04_r8,2.3314e-04_r8,1.7404e-04_r8/) + kao(:, 5, 6, 4) = (/ & + &1.0646e-04_r8,2.0089e-04_r8,2.3770e-04_r8,2.5701e-04_r8,2.6421e-04_r8,2.6433e-04_r8, & + &2.5582e-04_r8,2.4028e-04_r8,1.7876e-04_r8/) + kao(:, 1, 7, 4) = (/ & + &1.6042e-04_r8,2.5585e-04_r8,2.8519e-04_r8,2.9642e-04_r8,2.9350e-04_r8,2.7913e-04_r8, & + &2.5601e-04_r8,2.2211e-04_r8,1.3626e-04_r8/) + kao(:, 2, 7, 4) = (/ & + &1.6465e-04_r8,2.6056e-04_r8,2.8988e-04_r8,3.0133e-04_r8,2.9907e-04_r8,2.8588e-04_r8, & + &2.6187e-04_r8,2.2729e-04_r8,1.4135e-04_r8/) + kao(:, 3, 7, 4) = (/ & + &1.6901e-04_r8,2.6578e-04_r8,2.9572e-04_r8,3.0741e-04_r8,3.0551e-04_r8,2.9184e-04_r8, & + &2.6817e-04_r8,2.3205e-04_r8,1.4656e-04_r8/) + kao(:, 4, 7, 4) = (/ & + &1.7367e-04_r8,2.7110e-04_r8,3.0239e-04_r8,3.1497e-04_r8,3.1315e-04_r8,2.9895e-04_r8, & + &2.7506e-04_r8,2.3781e-04_r8,1.5059e-04_r8/) + kao(:, 5, 7, 4) = (/ & + &1.7865e-04_r8,2.7756e-04_r8,3.1008e-04_r8,3.2315e-04_r8,3.2186e-04_r8,3.0753e-04_r8, & + &2.8375e-04_r8,2.4404e-04_r8,1.5550e-04_r8/) + kao(:, 1, 8, 4) = (/ & + &3.1654e-04_r8,4.1629e-04_r8,4.3839e-04_r8,4.3773e-04_r8,4.1826e-04_r8,3.8213e-04_r8, & + &3.2793e-04_r8,2.5576e-04_r8,1.2647e-04_r8/) + kao(:, 2, 8, 4) = (/ & + &3.2537e-04_r8,4.2537e-04_r8,4.4661e-04_r8,4.4494e-04_r8,4.2500e-04_r8,3.8879e-04_r8, & + &3.3490e-04_r8,2.6206e-04_r8,1.2938e-04_r8/) + kao(:, 3, 8, 4) = (/ & + &3.3408e-04_r8,4.3504e-04_r8,4.5626e-04_r8,4.5382e-04_r8,4.3360e-04_r8,3.9751e-04_r8, & + &3.4272e-04_r8,2.6854e-04_r8,1.3239e-04_r8/) + kao(:, 4, 8, 4) = (/ & + &3.4318e-04_r8,4.4480e-04_r8,4.6645e-04_r8,4.6411e-04_r8,4.4358e-04_r8,4.0695e-04_r8, & + &3.5185e-04_r8,2.7598e-04_r8,1.3521e-04_r8/) + kao(:, 5, 8, 4) = (/ & + &3.5364e-04_r8,4.5591e-04_r8,4.7748e-04_r8,4.7551e-04_r8,4.5523e-04_r8,4.1803e-04_r8, & + &3.6238e-04_r8,2.8454e-04_r8,1.3901e-04_r8/) + kao(:, 1, 9, 4) = (/ & + &1.1778e-03_r8,1.2542e-03_r8,1.1993e-03_r8,1.1088e-03_r8,9.9621e-04_r8,8.5814e-04_r8, & + &6.9027e-04_r8,4.7338e-04_r8,1.4222e-04_r8/) + kao(:, 2, 9, 4) = (/ & + &1.2148e-03_r8,1.2865e-03_r8,1.2285e-03_r8,1.1318e-03_r8,1.0140e-03_r8,8.7230e-04_r8, & + &7.0194e-04_r8,4.8264e-04_r8,1.4691e-04_r8/) + kao(:, 3, 9, 4) = (/ & + &1.2493e-03_r8,1.3197e-03_r8,1.2603e-03_r8,1.1590e-03_r8,1.0363e-03_r8,8.9016e-04_r8, & + &7.1481e-04_r8,4.9330e-04_r8,1.5194e-04_r8/) + kao(:, 4, 9, 4) = (/ & + &1.2842e-03_r8,1.3516e-03_r8,1.2898e-03_r8,1.1881e-03_r8,1.0607e-03_r8,9.1030e-04_r8, & + &7.3056e-04_r8,5.0488e-04_r8,1.5874e-04_r8/) + kao(:, 5, 9, 4) = (/ & + &1.3233e-03_r8,1.3878e-03_r8,1.3225e-03_r8,1.2203e-03_r8,1.0882e-03_r8,9.3354e-04_r8, & + &7.4949e-04_r8,5.1819e-04_r8,1.6715e-04_r8/) + kao(:, 1,10, 4) = (/ & + &4.9223e-03_r8,4.6924e-03_r8,4.2372e-03_r8,3.7210e-03_r8,3.1598e-03_r8,2.5466e-03_r8, & + &1.8894e-03_r8,1.1610e-03_r8,2.5902e-04_r8/) + kao(:, 2,10, 4) = (/ & + &5.1019e-03_r8,4.8420e-03_r8,4.3700e-03_r8,3.8242e-03_r8,3.2382e-03_r8,2.6075e-03_r8, & + &1.9274e-03_r8,1.1773e-03_r8,2.7993e-04_r8/) + kao(:, 3,10, 4) = (/ & + &5.2624e-03_r8,4.9912e-03_r8,4.4976e-03_r8,3.9326e-03_r8,3.3295e-03_r8,2.6789e-03_r8, & + &1.9739e-03_r8,1.2013e-03_r8,2.9275e-04_r8/) + kao(:, 4,10, 4) = (/ & + &5.4202e-03_r8,5.1325e-03_r8,4.6211e-03_r8,4.0415e-03_r8,3.4179e-03_r8,2.7474e-03_r8, & + &2.0231e-03_r8,1.2303e-03_r8,3.0514e-04_r8/) + kao(:, 5,10, 4) = (/ & + &5.5922e-03_r8,5.2716e-03_r8,4.7430e-03_r8,4.1489e-03_r8,3.5047e-03_r8,2.8180e-03_r8, & + &2.0794e-03_r8,1.2643e-03_r8,3.1858e-04_r8/) + kao(:, 1,11, 4) = (/ & + &7.2623e-03_r8,6.7979e-03_r8,6.0744e-03_r8,5.2843e-03_r8,4.4298e-03_r8,3.5303e-03_r8, & + &2.5670e-03_r8,1.5127e-03_r8,3.1480e-04_r8/) + kao(:, 2,11, 4) = (/ & + &7.5607e-03_r8,7.0506e-03_r8,6.2894e-03_r8,5.4629e-03_r8,4.5682e-03_r8,3.6306e-03_r8, & + &2.6328e-03_r8,1.5436e-03_r8,3.2537e-04_r8/) + kao(:, 3,11, 4) = (/ & + &7.8471e-03_r8,7.2956e-03_r8,6.4988e-03_r8,5.6385e-03_r8,4.7125e-03_r8,3.7379e-03_r8, & + &2.7029e-03_r8,1.5776e-03_r8,3.3231e-04_r8/) + kao(:, 4,11, 4) = (/ & + &8.1128e-03_r8,7.5290e-03_r8,6.7020e-03_r8,5.8093e-03_r8,4.8535e-03_r8,3.8422e-03_r8, & + &2.7753e-03_r8,1.6189e-03_r8,3.4203e-04_r8/) + kao(:, 5,11, 4) = (/ & + &8.3759e-03_r8,7.7545e-03_r8,6.8899e-03_r8,5.9710e-03_r8,4.9875e-03_r8,3.9509e-03_r8, & + &2.8575e-03_r8,1.6684e-03_r8,3.5725e-04_r8/) + kao(:, 1,12, 4) = (/ & + &8.0096e-03_r8,7.4190e-03_r8,6.5933e-03_r8,5.7152e-03_r8,4.7757e-03_r8,3.7806e-03_r8, & + &2.7237e-03_r8,1.5850e-03_r8,3.0906e-04_r8/) + kao(:, 2,12, 4) = (/ & + &8.3245e-03_r8,7.6924e-03_r8,6.8377e-03_r8,5.9147e-03_r8,4.9319e-03_r8,3.8997e-03_r8, & + &2.8053e-03_r8,1.6213e-03_r8,3.1505e-04_r8/) + kao(:, 3,12, 4) = (/ & + &8.6504e-03_r8,7.9748e-03_r8,7.0681e-03_r8,6.1123e-03_r8,5.0902e-03_r8,4.0202e-03_r8, & + &2.8850e-03_r8,1.6649e-03_r8,3.2236e-04_r8/) + kao(:, 4,12, 4) = (/ & + &8.9354e-03_r8,8.2303e-03_r8,7.2913e-03_r8,6.2946e-03_r8,5.2436e-03_r8,4.1358e-03_r8, & + &2.9697e-03_r8,1.7144e-03_r8,3.2906e-04_r8/) + kao(:, 5,12, 4) = (/ & + &9.2169e-03_r8,8.4842e-03_r8,7.5093e-03_r8,6.4790e-03_r8,5.3967e-03_r8,4.2618e-03_r8, & + &3.0601e-03_r8,1.7687e-03_r8,3.3757e-04_r8/) + kao(:, 1,13, 4) = (/ & + &7.1631e-03_r8,6.6319e-03_r8,5.8920e-03_r8,5.0960e-03_r8,4.2500e-03_r8,3.3594e-03_r8, & + &2.4169e-03_r8,1.3985e-03_r8,2.7237e-04_r8/) + kao(:, 2,13, 4) = (/ & + &7.4650e-03_r8,6.8721e-03_r8,6.1020e-03_r8,5.2700e-03_r8,4.3954e-03_r8,3.4698e-03_r8, & + &2.4897e-03_r8,1.4341e-03_r8,2.7736e-04_r8/) + kao(:, 3,13, 4) = (/ & + &7.7609e-03_r8,7.1282e-03_r8,6.3106e-03_r8,5.4462e-03_r8,4.5330e-03_r8,3.5736e-03_r8, & + &2.5636e-03_r8,1.4770e-03_r8,2.8124e-04_r8/) + kao(:, 4,13, 4) = (/ & + &8.0101e-03_r8,7.3618e-03_r8,6.5123e-03_r8,5.6158e-03_r8,4.6733e-03_r8,3.6861e-03_r8, & + &2.6445e-03_r8,1.5233e-03_r8,2.8716e-04_r8/) + kao(:, 5,13, 4) = (/ & + &8.2606e-03_r8,7.6008e-03_r8,6.7314e-03_r8,5.7990e-03_r8,4.8288e-03_r8,3.8083e-03_r8, & + &2.7261e-03_r8,1.5712e-03_r8,2.9686e-04_r8/) + kao(:, 1, 1, 5) = (/ & + &1.3739e-05_r8,1.5137e-04_r8,2.5878e-04_r8,3.6225e-04_r8,4.6522e-04_r8,5.7109e-04_r8, & + &6.9199e-04_r8,8.4168e-04_r8,8.0480e-04_r8/) + kao(:, 2, 1, 5) = (/ & + &1.3888e-05_r8,1.5627e-04_r8,2.6885e-04_r8,3.7698e-04_r8,4.8125e-04_r8,5.9114e-04_r8, & + &7.1164e-04_r8,8.7936e-04_r8,8.3421e-04_r8/) + kao(:, 3, 1, 5) = (/ & + &1.4142e-05_r8,1.6264e-04_r8,2.8096e-04_r8,3.9281e-04_r8,5.0319e-04_r8,6.1580e-04_r8, & + &7.3800e-04_r8,9.1340e-04_r8,8.6788e-04_r8/) + kao(:, 4, 1, 5) = (/ & + &1.4278e-05_r8,1.6909e-04_r8,2.9347e-04_r8,4.1125e-04_r8,5.2641e-04_r8,6.4515e-04_r8, & + &7.7492e-04_r8,9.4989e-04_r8,9.0996e-04_r8/) + kao(:, 5, 1, 5) = (/ & + &1.4494e-05_r8,1.7605e-04_r8,3.0657e-04_r8,4.3067e-04_r8,5.5274e-04_r8,6.7670e-04_r8, & + &8.1211e-04_r8,9.9682e-04_r8,9.5292e-04_r8/) + kao(:, 1, 2, 5) = (/ & + &1.8692e-05_r8,1.5213e-04_r8,2.4704e-04_r8,3.3748e-04_r8,4.2434e-04_r8,5.1189e-04_r8, & + &6.0610e-04_r8,7.3668e-04_r8,6.9411e-04_r8/) + kao(:, 2, 2, 5) = (/ & + &1.8918e-05_r8,1.5679e-04_r8,2.5663e-04_r8,3.5044e-04_r8,4.4175e-04_r8,5.3243e-04_r8, & + &6.2710e-04_r8,7.5567e-04_r8,7.2022e-04_r8/) + kao(:, 3, 2, 5) = (/ & + &1.9322e-05_r8,1.6205e-04_r8,2.6764e-04_r8,3.6642e-04_r8,4.6108e-04_r8,5.5570e-04_r8, & + &6.5662e-04_r8,7.8535e-04_r8,7.5176e-04_r8/) + kao(:, 4, 2, 5) = (/ & + &1.9585e-05_r8,1.6765e-04_r8,2.7850e-04_r8,3.8286e-04_r8,4.8359e-04_r8,5.8272e-04_r8, & + &6.8652e-04_r8,8.2260e-04_r8,7.8717e-04_r8/) + kao(:, 5, 2, 5) = (/ & + &1.9818e-05_r8,1.7339e-04_r8,2.8992e-04_r8,3.9889e-04_r8,5.0485e-04_r8,6.1010e-04_r8, & + &7.2141e-04_r8,8.6363e-04_r8,8.2436e-04_r8/) + kao(:, 1, 3, 5) = (/ & + &3.4262e-05_r8,1.7533e-04_r8,2.6113e-04_r8,3.3571e-04_r8,4.0540e-04_r8,4.7229e-04_r8, & + &5.3818e-04_r8,6.1661e-04_r8,5.8845e-04_r8/) + kao(:, 2, 3, 5) = (/ & + &3.4716e-05_r8,1.7923e-04_r8,2.6899e-04_r8,3.4836e-04_r8,4.2096e-04_r8,4.9023e-04_r8, & + &5.6025e-04_r8,6.3703e-04_r8,6.0869e-04_r8/) + kao(:, 3, 3, 5) = (/ & + &3.5292e-05_r8,1.8347e-04_r8,2.7811e-04_r8,3.6147e-04_r8,4.3915e-04_r8,5.1242e-04_r8, & + &5.8378e-04_r8,6.6557e-04_r8,6.3564e-04_r8/) + kao(:, 4, 3, 5) = (/ & + &3.6120e-05_r8,1.8884e-04_r8,2.8797e-04_r8,3.7545e-04_r8,4.5740e-04_r8,5.3560e-04_r8, & + &6.1221e-04_r8,6.9822e-04_r8,6.6452e-04_r8/) + kao(:, 5, 3, 5) = (/ & + &3.6636e-05_r8,1.9428e-04_r8,2.9738e-04_r8,3.9013e-04_r8,4.7606e-04_r8,5.5790e-04_r8, & + &6.3990e-04_r8,7.3219e-04_r8,6.9591e-04_r8/) + kao(:, 1, 4, 5) = (/ & + &6.3937e-05_r8,2.1416e-04_r8,2.9895e-04_r8,3.6305e-04_r8,4.1697e-04_r8,4.6136e-04_r8, & + &4.9950e-04_r8,5.3752e-04_r8,4.9755e-04_r8/) + kao(:, 2, 4, 5) = (/ & + &6.4891e-05_r8,2.1788e-04_r8,3.0564e-04_r8,3.7373e-04_r8,4.2957e-04_r8,4.7819e-04_r8, & + &5.1730e-04_r8,5.5769e-04_r8,5.1340e-04_r8/) + kao(:, 3, 4, 5) = (/ & + &6.5931e-05_r8,2.2256e-04_r8,3.1273e-04_r8,3.8551e-04_r8,4.4411e-04_r8,4.9569e-04_r8, & + &5.4027e-04_r8,5.8134e-04_r8,5.3558e-04_r8/) + kao(:, 4, 4, 5) = (/ & + &6.7204e-05_r8,2.2716e-04_r8,3.2137e-04_r8,3.9776e-04_r8,4.6059e-04_r8,5.1431e-04_r8, & + &5.6246e-04_r8,6.0834e-04_r8,5.5897e-04_r8/) + kao(:, 5, 4, 5) = (/ & + &6.9088e-05_r8,2.3323e-04_r8,3.3076e-04_r8,4.1010e-04_r8,4.7742e-04_r8,5.3504e-04_r8, & + &5.8525e-04_r8,6.3600e-04_r8,5.8418e-04_r8/) + kao(:, 1, 5, 5) = (/ & + &1.0861e-04_r8,2.6518e-04_r8,3.4675e-04_r8,4.0531e-04_r8,4.4642e-04_r8,4.7448e-04_r8, & + &4.8963e-04_r8,4.9041e-04_r8,4.2330e-04_r8/) + kao(:, 2, 5, 5) = (/ & + &1.1058e-04_r8,2.6952e-04_r8,3.5268e-04_r8,4.1375e-04_r8,4.5888e-04_r8,4.8791e-04_r8, & + &5.0614e-04_r8,5.0767e-04_r8,4.3569e-04_r8/) + kao(:, 3, 5, 5) = (/ & + &1.1255e-04_r8,2.7465e-04_r8,3.6022e-04_r8,4.2322e-04_r8,4.7137e-04_r8,5.0379e-04_r8, & + &5.2287e-04_r8,5.2860e-04_r8,4.5259e-04_r8/) + kao(:, 4, 5, 5) = (/ & + &1.1490e-04_r8,2.8064e-04_r8,3.6839e-04_r8,4.3377e-04_r8,4.8454e-04_r8,5.2116e-04_r8, & + &5.4180e-04_r8,5.5017e-04_r8,4.7054e-04_r8/) + kao(:, 5, 5, 5) = (/ & + &1.1845e-04_r8,2.8778e-04_r8,3.7745e-04_r8,4.4611e-04_r8,4.9985e-04_r8,5.3937e-04_r8, & + &5.6277e-04_r8,5.7154e-04_r8,4.9105e-04_r8/) + kao(:, 1, 6, 5) = (/ & + &1.7235e-04_r8,3.3181e-04_r8,4.0736e-04_r8,4.5766e-04_r8,4.8926e-04_r8,5.0113e-04_r8, & + &4.9597e-04_r8,4.6976e-04_r8,3.5862e-04_r8/) + kao(:, 2, 6, 5) = (/ & + &1.7547e-04_r8,3.3667e-04_r8,4.1414e-04_r8,4.6509e-04_r8,4.9861e-04_r8,5.1384e-04_r8, & + &5.0976e-04_r8,4.8537e-04_r8,3.6976e-04_r8/) + kao(:, 3, 6, 5) = (/ & + &1.7903e-04_r8,3.4304e-04_r8,4.2198e-04_r8,4.7494e-04_r8,5.0792e-04_r8,5.2713e-04_r8, & + &5.2630e-04_r8,5.0120e-04_r8,3.8272e-04_r8/) + kao(:, 4, 6, 5) = (/ & + &1.8326e-04_r8,3.5076e-04_r8,4.3097e-04_r8,4.8545e-04_r8,5.2030e-04_r8,5.4158e-04_r8, & + &5.4362e-04_r8,5.1767e-04_r8,3.9660e-04_r8/) + kao(:, 5, 6, 5) = (/ & + &1.8798e-04_r8,3.5938e-04_r8,4.4150e-04_r8,4.9742e-04_r8,5.3429e-04_r8,5.5639e-04_r8, & + &5.6101e-04_r8,5.3674e-04_r8,4.1415e-04_r8/) + kao(:, 1, 7, 5) = (/ & + &2.9155e-04_r8,4.4941e-04_r8,5.1334e-04_r8,5.5160e-04_r8,5.6796e-04_r8,5.6534e-04_r8, & + &5.3624e-04_r8,4.7508e-04_r8,3.0367e-04_r8/) + kao(:, 2, 7, 5) = (/ & + &2.9728e-04_r8,4.5662e-04_r8,5.2104e-04_r8,5.6062e-04_r8,5.7827e-04_r8,5.7448e-04_r8, & + &5.4737e-04_r8,4.8748e-04_r8,3.1275e-04_r8/) + kao(:, 3, 7, 5) = (/ & + &3.0362e-04_r8,4.6646e-04_r8,5.3089e-04_r8,5.7148e-04_r8,5.9016e-04_r8,5.8669e-04_r8, & + &5.6081e-04_r8,5.0270e-04_r8,3.2221e-04_r8/) + kao(:, 4, 7, 5) = (/ & + &3.1074e-04_r8,4.7852e-04_r8,5.4299e-04_r8,5.8375e-04_r8,6.0313e-04_r8,6.0067e-04_r8, & + &5.7534e-04_r8,5.1934e-04_r8,3.3373e-04_r8/) + kao(:, 5, 7, 5) = (/ & + &3.1895e-04_r8,4.9180e-04_r8,5.5670e-04_r8,5.9847e-04_r8,6.1763e-04_r8,6.1617e-04_r8, & + &5.9045e-04_r8,5.3590e-04_r8,3.4594e-04_r8/) + kao(:, 1, 8, 5) = (/ & + &5.8477e-04_r8,7.4431e-04_r8,7.7278e-04_r8,7.7426e-04_r8,7.5736e-04_r8,7.1816e-04_r8, & + &6.5106e-04_r8,5.3737e-04_r8,2.7725e-04_r8/) + kao(:, 2, 8, 5) = (/ & + &5.9470e-04_r8,7.5491e-04_r8,7.8490e-04_r8,7.8595e-04_r8,7.6803e-04_r8,7.3022e-04_r8, & + &6.6291e-04_r8,5.4897e-04_r8,2.8497e-04_r8/) + kao(:, 3, 8, 5) = (/ & + &6.0851e-04_r8,7.7097e-04_r8,8.0204e-04_r8,8.0136e-04_r8,7.8218e-04_r8,7.4418e-04_r8, & + &6.7668e-04_r8,5.6182e-04_r8,2.9265e-04_r8/) + kao(:, 4, 8, 5) = (/ & + &6.2426e-04_r8,7.9122e-04_r8,8.2299e-04_r8,8.2167e-04_r8,7.9967e-04_r8,7.6040e-04_r8, & + &6.9192e-04_r8,5.7414e-04_r8,3.0175e-04_r8/) + kao(:, 5, 8, 5) = (/ & + &6.4049e-04_r8,8.1349e-04_r8,8.4675e-04_r8,8.4414e-04_r8,8.2107e-04_r8,7.7949e-04_r8, & + &7.0895e-04_r8,5.8878e-04_r8,3.1239e-04_r8/) + kao(:, 1, 9, 5) = (/ & + &2.2196e-03_r8,2.3078e-03_r8,2.1925e-03_r8,2.0227e-03_r8,1.7963e-03_r8,1.5336e-03_r8, & + &1.2354e-03_r8,8.8457e-04_r8,3.2582e-04_r8/) + kao(:, 2, 9, 5) = (/ & + &2.2570e-03_r8,2.3473e-03_r8,2.2277e-03_r8,2.0540e-03_r8,1.8274e-03_r8,1.5588e-03_r8, & + &1.2524e-03_r8,8.9724e-04_r8,3.2676e-04_r8/) + kao(:, 3, 9, 5) = (/ & + &2.3089e-03_r8,2.3978e-03_r8,2.2707e-03_r8,2.0928e-03_r8,1.8651e-03_r8,1.5919e-03_r8, & + &1.2779e-03_r8,9.1370e-04_r8,3.3500e-04_r8/) + kao(:, 4, 9, 5) = (/ & + &2.3733e-03_r8,2.4602e-03_r8,2.3315e-03_r8,2.1419e-03_r8,1.9119e-03_r8,1.6319e-03_r8, & + &1.3090e-03_r8,9.3384e-04_r8,3.3899e-04_r8/) + kao(:, 5, 9, 5) = (/ & + &2.4406e-03_r8,2.5271e-03_r8,2.3986e-03_r8,2.2033e-03_r8,1.9655e-03_r8,1.6770e-03_r8, & + &1.3445e-03_r8,9.5837e-04_r8,3.4762e-04_r8/) + kao(:, 1,10, 5) = (/ & + &9.4839e-03_r8,8.9137e-03_r8,7.9871e-03_r8,6.9719e-03_r8,5.8780e-03_r8,4.7134e-03_r8, & + &3.4759e-03_r8,2.1070e-03_r8,4.8830e-04_r8/) + kao(:, 2,10, 5) = (/ & + &9.6557e-03_r8,9.0801e-03_r8,8.1340e-03_r8,7.0972e-03_r8,5.9780e-03_r8,4.7945e-03_r8, & + &3.5398e-03_r8,2.1454e-03_r8,4.8857e-04_r8/) + kao(:, 3,10, 5) = (/ & + &9.8746e-03_r8,9.2754e-03_r8,8.2985e-03_r8,7.2339e-03_r8,6.1011e-03_r8,4.8911e-03_r8, & + &3.6103e-03_r8,2.1918e-03_r8,5.0136e-04_r8/) + kao(:, 4,10, 5) = (/ & + &1.0155e-02_r8,9.5179e-03_r8,8.5070e-03_r8,7.4122e-03_r8,6.2501e-03_r8,5.0174e-03_r8, & + &3.7003e-03_r8,2.2452e-03_r8,5.1609e-04_r8/) + kao(:, 5,10, 5) = (/ & + &1.0472e-02_r8,9.8032e-03_r8,8.7668e-03_r8,7.6331e-03_r8,6.4389e-03_r8,5.1659e-03_r8, & + &3.8012e-03_r8,2.3067e-03_r8,5.2606e-04_r8/) + kao(:, 1,11, 5) = (/ & + &1.4268e-02_r8,1.3170e-02_r8,1.1684e-02_r8,1.0078e-02_r8,8.4022e-03_r8,6.6241e-03_r8, & + &4.7723e-03_r8,2.7954e-03_r8,5.2361e-04_r8/) + kao(:, 2,11, 5) = (/ & + &1.4540e-02_r8,1.3417e-02_r8,1.1900e-02_r8,1.0250e-02_r8,8.5500e-03_r8,6.7539e-03_r8, & + &4.8654e-03_r8,2.8533e-03_r8,5.3348e-04_r8/) + kao(:, 3,11, 5) = (/ & + &1.4880e-02_r8,1.3732e-02_r8,1.2163e-02_r8,1.0481e-02_r8,8.7324e-03_r8,6.9009e-03_r8, & + &4.9833e-03_r8,2.9218e-03_r8,5.5883e-04_r8/) + kao(:, 4,11, 5) = (/ & + &1.5319e-02_r8,1.4123e-02_r8,1.2507e-02_r8,1.0772e-02_r8,8.9669e-03_r8,7.0955e-03_r8, & + &5.1189e-03_r8,2.9943e-03_r8,5.8850e-04_r8/) + kao(:, 5,11, 5) = (/ & + &1.5835e-02_r8,1.4577e-02_r8,1.2919e-02_r8,1.1125e-02_r8,9.2533e-03_r8,7.3128e-03_r8, & + &5.2667e-03_r8,3.0792e-03_r8,6.1073e-04_r8/) + kao(:, 1,12, 5) = (/ & + &1.5802e-02_r8,1.4518e-02_r8,1.2819e-02_r8,1.1003e-02_r8,9.1252e-03_r8,7.1742e-03_r8, & + &5.1262e-03_r8,2.9592e-03_r8,5.0816e-04_r8/) + kao(:, 2,12, 5) = (/ & + &1.6146e-02_r8,1.4810e-02_r8,1.3074e-02_r8,1.1225e-02_r8,9.3090e-03_r8,7.3135e-03_r8, & + &5.2412e-03_r8,3.0249e-03_r8,5.3398e-04_r8/) + kao(:, 3,12, 5) = (/ & + &1.6565e-02_r8,1.5205e-02_r8,1.3415e-02_r8,1.1514e-02_r8,9.5432e-03_r8,7.5058e-03_r8, & + &5.3826e-03_r8,3.1020e-03_r8,5.6164e-04_r8/) + kao(:, 4,12, 5) = (/ & + &1.7128e-02_r8,1.5682e-02_r8,1.3836e-02_r8,1.1883e-02_r8,9.8516e-03_r8,7.7437e-03_r8, & + &5.5313e-03_r8,3.1868e-03_r8,5.8823e-04_r8/) + kao(:, 5,12, 5) = (/ & + &1.7790e-02_r8,1.6267e-02_r8,1.4348e-02_r8,1.2311e-02_r8,1.0183e-02_r8,7.9904e-03_r8, & + &5.7100e-03_r8,3.2821e-03_r8,6.0779e-04_r8/) + kao(:, 1,13, 5) = (/ & + &1.4021e-02_r8,1.2885e-02_r8,1.1370e-02_r8,9.7666e-03_r8,8.0956e-03_r8,6.3531e-03_r8, & + &4.5485e-03_r8,2.6326e-03_r8,4.6002e-04_r8/) + kao(:, 2,13, 5) = (/ & + &1.4373e-02_r8,1.3207e-02_r8,1.1632e-02_r8,9.9865e-03_r8,8.2754e-03_r8,6.5087e-03_r8, & + &4.6669e-03_r8,2.6967e-03_r8,4.8163e-04_r8/) + kao(:, 3,13, 5) = (/ & + &1.4774e-02_r8,1.3588e-02_r8,1.1994e-02_r8,1.0306e-02_r8,8.5450e-03_r8,6.7168e-03_r8, & + &4.8089e-03_r8,2.7710e-03_r8,4.9996e-04_r8/) + kao(:, 4,13, 5) = (/ & + &1.5343e-02_r8,1.4084e-02_r8,1.2424e-02_r8,1.0664e-02_r8,8.8287e-03_r8,6.9355e-03_r8, & + &4.9590e-03_r8,2.8556e-03_r8,5.2093e-04_r8/) + kao(:, 5,13, 5) = (/ & + &1.5979e-02_r8,1.4619e-02_r8,1.2888e-02_r8,1.1066e-02_r8,9.1632e-03_r8,7.1872e-03_r8, & + &5.1400e-03_r8,2.9489e-03_r8,5.4238e-04_r8/) + kao(:, 1, 1, 6) = (/ & + &2.4381e-05_r8,3.5965e-04_r8,6.3963e-04_r8,9.0999e-04_r8,1.1781e-03_r8,1.4492e-03_r8, & + &1.7469e-03_r8,2.1949e-03_r8,2.0167e-03_r8/) + kao(:, 2, 1, 6) = (/ & + &2.4551e-05_r8,3.6820e-04_r8,6.5359e-04_r8,9.2911e-04_r8,1.2030e-03_r8,1.4796e-03_r8, & + &1.7884e-03_r8,2.2546e-03_r8,2.0633e-03_r8/) + kao(:, 3, 1, 6) = (/ & + &2.4844e-05_r8,3.7777e-04_r8,6.7015e-04_r8,9.5166e-04_r8,1.2316e-03_r8,1.5153e-03_r8, & + &1.8326e-03_r8,2.3125e-03_r8,2.1171e-03_r8/) + kao(:, 4, 1, 6) = (/ & + &2.5013e-05_r8,3.8840e-04_r8,6.8929e-04_r8,9.7743e-04_r8,1.2638e-03_r8,1.5559e-03_r8, & + &1.8833e-03_r8,2.3873e-03_r8,2.1814e-03_r8/) + kao(:, 5, 1, 6) = (/ & + &2.5349e-05_r8,4.0094e-04_r8,7.1137e-04_r8,1.0079e-03_r8,1.3021e-03_r8,1.6023e-03_r8, & + &1.9431e-03_r8,2.4704e-03_r8,2.2554e-03_r8/) + kao(:, 1, 2, 6) = (/ & + &3.3532e-05_r8,3.4195e-04_r8,5.9227e-04_r8,8.3115e-04_r8,1.0659e-03_r8,1.2984e-03_r8, & + &1.5375e-03_r8,1.8307e-03_r8,1.7555e-03_r8/) + kao(:, 2, 2, 6) = (/ & + &3.3884e-05_r8,3.4950e-04_r8,6.0496e-04_r8,8.4827e-04_r8,1.0865e-03_r8,1.3240e-03_r8, & + &1.5683e-03_r8,1.8747e-03_r8,1.7936e-03_r8/) + kao(:, 3, 2, 6) = (/ & + &3.4432e-05_r8,3.5837e-04_r8,6.1975e-04_r8,8.6913e-04_r8,1.1113e-03_r8,1.3536e-03_r8, & + &1.6021e-03_r8,1.9222e-03_r8,1.8373e-03_r8/) + kao(:, 4, 2, 6) = (/ & + &3.4886e-05_r8,3.6829e-04_r8,6.3662e-04_r8,8.9220e-04_r8,1.1391e-03_r8,1.3857e-03_r8, & + &1.6406e-03_r8,1.9755e-03_r8,1.8873e-03_r8/) + kao(:, 5, 2, 6) = (/ & + &3.5279e-05_r8,3.7968e-04_r8,6.5599e-04_r8,9.1909e-04_r8,1.1730e-03_r8,1.4257e-03_r8, & + &1.6862e-03_r8,2.0365e-03_r8,1.9484e-03_r8/) + kao(:, 1, 3, 6) = (/ & + &6.2269e-05_r8,3.6578e-04_r8,5.8707e-04_r8,7.9355e-04_r8,9.9285e-04_r8,1.1848e-03_r8, & + &1.3757e-03_r8,1.5822e-03_r8,1.5104e-03_r8/) + kao(:, 2, 3, 6) = (/ & + &6.2987e-05_r8,3.7248e-04_r8,5.9883e-04_r8,8.1016e-04_r8,1.0136e-03_r8,1.2090e-03_r8, & + &1.4023e-03_r8,1.6140e-03_r8,1.5440e-03_r8/) + kao(:, 3, 3, 6) = (/ & + &6.3830e-05_r8,3.8077e-04_r8,6.1238e-04_r8,8.2947e-04_r8,1.0380e-03_r8,1.2373e-03_r8, & + &1.4338e-03_r8,1.6476e-03_r8,1.5800e-03_r8/) + kao(:, 4, 3, 6) = (/ & + &6.5057e-05_r8,3.9038e-04_r8,6.2908e-04_r8,8.5186e-04_r8,1.0655e-03_r8,1.2690e-03_r8, & + &1.4686e-03_r8,1.6847e-03_r8,1.6204e-03_r8/) + kao(:, 5, 3, 6) = (/ & + &6.5891e-05_r8,4.0010e-04_r8,6.4778e-04_r8,8.7680e-04_r8,1.0962e-03_r8,1.3060e-03_r8, & + &1.5104e-03_r8,1.7307e-03_r8,1.6697e-03_r8/) + kao(:, 1, 4, 6) = (/ & + &1.1763e-04_r8,4.2852e-04_r8,6.2857e-04_r8,8.0251e-04_r8,9.6160e-04_r8,1.1103e-03_r8, & + &1.2549e-03_r8,1.3952e-03_r8,1.2948e-03_r8/) + kao(:, 2, 4, 6) = (/ & + &1.1903e-04_r8,4.3548e-04_r8,6.3935e-04_r8,8.1698e-04_r8,9.8074e-04_r8,1.1338e-03_r8, & + &1.2810e-03_r8,1.4231e-03_r8,1.3227e-03_r8/) + kao(:, 3, 4, 6) = (/ & + &1.2084e-04_r8,4.4304e-04_r8,6.5330e-04_r8,8.3469e-04_r8,1.0028e-03_r8,1.1604e-03_r8, & + &1.3104e-03_r8,1.4544e-03_r8,1.3535e-03_r8/) + kao(:, 4, 4, 6) = (/ & + &1.2295e-04_r8,4.5274e-04_r8,6.6888e-04_r8,8.5565e-04_r8,1.0277e-03_r8,1.1905e-03_r8, & + &1.3437e-03_r8,1.4894e-03_r8,1.3881e-03_r8/) + kao(:, 5, 4, 6) = (/ & + &1.2576e-04_r8,4.6369e-04_r8,6.8705e-04_r8,8.8171e-04_r8,1.0587e-03_r8,1.2251e-03_r8, & + &1.3822e-03_r8,1.5303e-03_r8,1.4309e-03_r8/) + kao(:, 1, 5, 6) = (/ & + &2.0248e-04_r8,5.1976e-04_r8,7.0294e-04_r8,8.5252e-04_r8,9.7761e-04_r8,1.0816e-03_r8, & + &1.1680e-03_r8,1.2476e-03_r8,1.1044e-03_r8/) + kao(:, 2, 5, 6) = (/ & + &2.0493e-04_r8,5.2640e-04_r8,7.1432e-04_r8,8.6690e-04_r8,9.9395e-04_r8,1.1019e-03_r8, & + &1.1914e-03_r8,1.2719e-03_r8,1.1285e-03_r8/) + kao(:, 3, 5, 6) = (/ & + &2.0806e-04_r8,5.3477e-04_r8,7.2739e-04_r8,8.8542e-04_r8,1.0148e-03_r8,1.1250e-03_r8, & + &1.2182e-03_r8,1.3005e-03_r8,1.1542e-03_r8/) + kao(:, 4, 5, 6) = (/ & + &2.1205e-04_r8,5.4496e-04_r8,7.4280e-04_r8,9.0607e-04_r8,1.0399e-03_r8,1.1525e-03_r8, & + &1.2484e-03_r8,1.3331e-03_r8,1.1843e-03_r8/) + kao(:, 5, 5, 6) = (/ & + &2.1768e-04_r8,5.5787e-04_r8,7.6255e-04_r8,9.3016e-04_r8,1.0697e-03_r8,1.1863e-03_r8, & + &1.2845e-03_r8,1.3711e-03_r8,1.2208e-03_r8/) + kao(:, 1, 6, 6) = (/ & + &3.2402e-04_r8,6.5065e-04_r8,8.1276e-04_r8,9.3175e-04_r8,1.0254e-03_r8,1.0960e-03_r8, & + &1.1336e-03_r8,1.1359e-03_r8,9.3926e-04_r8/) + kao(:, 2, 6, 6) = (/ & + &3.2839e-04_r8,6.5803e-04_r8,8.2121e-04_r8,9.4691e-04_r8,1.0426e-03_r8,1.1132e-03_r8, & + &1.1537e-03_r8,1.1594e-03_r8,9.5631e-04_r8/) + kao(:, 3, 6, 6) = (/ & + &3.3397e-04_r8,6.6749e-04_r8,8.3425e-04_r8,9.6403e-04_r8,1.0654e-03_r8,1.1356e-03_r8, & + &1.1768e-03_r8,1.1847e-03_r8,9.7614e-04_r8/) + kao(:, 4, 6, 6) = (/ & + &3.4074e-04_r8,6.7873e-04_r8,8.5077e-04_r8,9.8417e-04_r8,1.0893e-03_r8,1.1622e-03_r8, & + &1.2041e-03_r8,1.2139e-03_r8,1.0001e-03_r8/) + kao(:, 5, 6, 6) = (/ & + &3.4865e-04_r8,6.9287e-04_r8,8.6902e-04_r8,1.0071e-03_r8,1.1162e-03_r8,1.1933e-03_r8, & + &1.2370e-03_r8,1.2465e-03_r8,1.0295e-03_r8/) + kao(:, 1, 7, 6) = (/ & + &5.4679e-04_r8,8.8419e-04_r8,1.0272e-03_r8,1.1131e-03_r8,1.1586e-03_r8,1.1796e-03_r8, & + &1.1677e-03_r8,1.1006e-03_r8,7.9375e-04_r8/) + kao(:, 2, 7, 6) = (/ & + &5.5453e-04_r8,8.9535e-04_r8,1.0406e-03_r8,1.1278e-03_r8,1.1758e-03_r8,1.1986e-03_r8, & + &1.1860e-03_r8,1.1193e-03_r8,8.0863e-04_r8/) + kao(:, 3, 7, 6) = (/ & + &5.6482e-04_r8,9.0803e-04_r8,1.0560e-03_r8,1.1451e-03_r8,1.1955e-03_r8,1.2220e-03_r8, & + &1.2089e-03_r8,1.1408e-03_r8,8.2565e-04_r8/) + kao(:, 4, 7, 6) = (/ & + &5.7672e-04_r8,9.2334e-04_r8,1.0748e-03_r8,1.1654e-03_r8,1.2195e-03_r8,1.2479e-03_r8, & + &1.2361e-03_r8,1.1655e-03_r8,8.4564e-04_r8/) + kao(:, 5, 7, 6) = (/ & + &5.9187e-04_r8,9.4280e-04_r8,1.0968e-03_r8,1.1862e-03_r8,1.2479e-03_r8,1.2773e-03_r8, & + &1.2677e-03_r8,1.1958e-03_r8,8.6975e-04_r8/) + kao(:, 1, 8, 6) = (/ & + &1.0890e-03_r8,1.4212e-03_r8,1.5274e-03_r8,1.5635e-03_r8,1.5408e-03_r8,1.4729e-03_r8, & + &1.3514e-03_r8,1.1730e-03_r8,6.7724e-04_r8/) + kao(:, 2, 8, 6) = (/ & + &1.1074e-03_r8,1.4404e-03_r8,1.5493e-03_r8,1.5864e-03_r8,1.5647e-03_r8,1.4941e-03_r8, & + &1.3720e-03_r8,1.1894e-03_r8,6.8838e-04_r8/) + kao(:, 3, 8, 6) = (/ & + &1.1299e-03_r8,1.4626e-03_r8,1.5727e-03_r8,1.6115e-03_r8,1.5892e-03_r8,1.5170e-03_r8, & + &1.3954e-03_r8,1.2114e-03_r8,7.0024e-04_r8/) + kao(:, 4, 8, 6) = (/ & + &1.1562e-03_r8,1.4908e-03_r8,1.6005e-03_r8,1.6404e-03_r8,1.6196e-03_r8,1.5467e-03_r8, & + &1.4229e-03_r8,1.2388e-03_r8,7.1485e-04_r8/) + kao(:, 5, 8, 6) = (/ & + &1.1885e-03_r8,1.5267e-03_r8,1.6357e-03_r8,1.6752e-03_r8,1.6528e-03_r8,1.5764e-03_r8, & + &1.4553e-03_r8,1.2696e-03_r8,7.3183e-04_r8/) + kao(:, 1, 9, 6) = (/ & + &4.1665e-03_r8,4.3468e-03_r8,4.1293e-03_r8,3.8165e-03_r8,3.4449e-03_r8,3.0107e-03_r8, & + &2.4884e-03_r8,1.8186e-03_r8,7.0770e-04_r8/) + kao(:, 2, 9, 6) = (/ & + &4.2379e-03_r8,4.4019e-03_r8,4.1804e-03_r8,3.8702e-03_r8,3.4962e-03_r8,3.0618e-03_r8, & + &2.5301e-03_r8,1.8480e-03_r8,7.1084e-04_r8/) + kao(:, 3, 9, 6) = (/ & + &4.3206e-03_r8,4.4730e-03_r8,4.2494e-03_r8,3.9358e-03_r8,3.5562e-03_r8,3.1108e-03_r8, & + &2.5726e-03_r8,1.8787e-03_r8,7.1447e-04_r8/) + kao(:, 4, 9, 6) = (/ & + &4.4148e-03_r8,4.5672e-03_r8,4.3360e-03_r8,4.0233e-03_r8,3.6279e-03_r8,3.1667e-03_r8, & + &2.6211e-03_r8,1.9152e-03_r8,7.2547e-04_r8/) + kao(:, 5, 9, 6) = (/ & + &4.5366e-03_r8,4.6880e-03_r8,4.4475e-03_r8,4.1247e-03_r8,3.7148e-03_r8,3.2357e-03_r8, & + &2.6777e-03_r8,1.9564e-03_r8,7.3351e-04_r8/) + kao(:, 1,10, 6) = (/ & + &1.8255e-02_r8,1.7198e-02_r8,1.5391e-02_r8,1.3391e-02_r8,1.1273e-02_r8,9.0394e-03_r8, & + &6.6601e-03_r8,4.0944e-03_r8,9.8389e-04_r8/) + kao(:, 2,10, 6) = (/ & + &1.8579e-02_r8,1.7439e-02_r8,1.5601e-02_r8,1.3577e-02_r8,1.1427e-02_r8,9.1759e-03_r8, & + &6.7580e-03_r8,4.1605e-03_r8,9.8485e-04_r8/) + kao(:, 3,10, 6) = (/ & + &1.8934e-02_r8,1.7772e-02_r8,1.5898e-02_r8,1.3821e-02_r8,1.1616e-02_r8,9.3279e-03_r8, & + &6.8809e-03_r8,4.2287e-03_r8,9.8296e-04_r8/) + kao(:, 4,10, 6) = (/ & + &1.9364e-02_r8,1.8152e-02_r8,1.6246e-02_r8,1.4125e-02_r8,1.1868e-02_r8,9.5176e-03_r8, & + &7.0263e-03_r8,4.3137e-03_r8,9.8595e-04_r8/) + kao(:, 5,10, 6) = (/ & + &1.9876e-02_r8,1.8605e-02_r8,1.6643e-02_r8,1.4478e-02_r8,1.2165e-02_r8,9.7573e-03_r8, & + &7.2015e-03_r8,4.4138e-03_r8,9.9549e-04_r8/) + kao(:, 1,11, 6) = (/ & + &2.7906e-02_r8,2.5779e-02_r8,2.2845e-02_r8,1.9689e-02_r8,1.6356e-02_r8,1.2926e-02_r8, & + &9.3112e-03_r8,5.4266e-03_r8,1.1493e-03_r8/) + kao(:, 2,11, 6) = (/ & + &2.8474e-02_r8,2.6276e-02_r8,2.3282e-02_r8,2.0063e-02_r8,1.6649e-02_r8,1.3118e-02_r8, & + &9.4591e-03_r8,5.5176e-03_r8,1.1605e-03_r8/) + kao(:, 3,11, 6) = (/ & + &2.9161e-02_r8,2.6826e-02_r8,2.3755e-02_r8,2.0435e-02_r8,1.6944e-02_r8,1.3356e-02_r8, & + &9.6281e-03_r8,5.6370e-03_r8,1.1658e-03_r8/) + kao(:, 4,11, 6) = (/ & + &2.9864e-02_r8,2.7446e-02_r8,2.4305e-02_r8,2.0907e-02_r8,1.7344e-02_r8,1.3665e-02_r8, & + &9.8501e-03_r8,5.7787e-03_r8,1.1679e-03_r8/) + kao(:, 5,11, 6) = (/ & + &3.0716e-02_r8,2.8218e-02_r8,2.4989e-02_r8,2.1484e-02_r8,1.7837e-02_r8,1.4047e-02_r8, & + &1.0137e-02_r8,5.9391e-03_r8,1.1749e-03_r8/) + kao(:, 1,12, 6) = (/ & + &3.1456e-02_r8,2.8840e-02_r8,2.5490e-02_r8,2.1901e-02_r8,1.8104e-02_r8,1.4184e-02_r8, & + &1.0144e-02_r8,5.8131e-03_r8,1.1656e-03_r8/) + kao(:, 2,12, 6) = (/ & + &3.2212e-02_r8,2.9507e-02_r8,2.6048e-02_r8,2.2347e-02_r8,1.8450e-02_r8,1.4457e-02_r8, & + &1.0325e-02_r8,5.9330e-03_r8,1.1607e-03_r8/) + kao(:, 3,12, 6) = (/ & + &3.2965e-02_r8,3.0133e-02_r8,2.6613e-02_r8,2.2834e-02_r8,1.8888e-02_r8,1.4793e-02_r8, & + &1.0553e-02_r8,6.0675e-03_r8,1.1612e-03_r8/) + kao(:, 4,12, 6) = (/ & + &3.3903e-02_r8,3.0999e-02_r8,2.7365e-02_r8,2.3453e-02_r8,1.9368e-02_r8,1.5160e-02_r8, & + &1.0832e-02_r8,6.2310e-03_r8,1.1792e-03_r8/) + kao(:, 5,12, 6) = (/ & + &3.4986e-02_r8,3.1940e-02_r8,2.8176e-02_r8,2.4131e-02_r8,1.9947e-02_r8,1.5618e-02_r8, & + &1.1156e-02_r8,6.4247e-03_r8,1.2061e-03_r8/) + kao(:, 1,13, 6) = (/ & + &2.8494e-02_r8,2.6140e-02_r8,2.3086e-02_r8,1.9829e-02_r8,1.6410e-02_r8,1.2869e-02_r8, & + &9.1750e-03_r8,5.2477e-03_r8,1.0839e-03_r8/) + kao(:, 2,13, 6) = (/ & + &2.9204e-02_r8,2.6786e-02_r8,2.3660e-02_r8,2.0312e-02_r8,1.6791e-02_r8,1.3151e-02_r8, & + &9.3741e-03_r8,5.3670e-03_r8,1.0879e-03_r8/) + kao(:, 3,13, 6) = (/ & + &3.0028e-02_r8,2.7500e-02_r8,2.4267e-02_r8,2.0802e-02_r8,1.7182e-02_r8,1.3458e-02_r8, & + &9.5924e-03_r8,5.5018e-03_r8,1.1043e-03_r8/) + kao(:, 4,13, 6) = (/ & + &3.0958e-02_r8,2.8295e-02_r8,2.4961e-02_r8,2.1395e-02_r8,1.7690e-02_r8,1.3840e-02_r8, & + &9.8578e-03_r8,5.6588e-03_r8,1.1197e-03_r8/) + kao(:, 5,13, 6) = (/ & + &3.2042e-02_r8,2.9250e-02_r8,2.5779e-02_r8,2.2082e-02_r8,1.8250e-02_r8,1.4290e-02_r8, & + &1.0177e-02_r8,5.8420e-03_r8,1.1367e-03_r8/) + kao(:, 1, 1, 7) = (/ & + &4.8330e-05_r8,9.1748e-04_r8,1.6343e-03_r8,2.3037e-03_r8,2.9566e-03_r8,3.6315e-03_r8, & + &4.4475e-03_r8,5.8406e-03_r8,5.3151e-03_r8/) + kao(:, 2, 1, 7) = (/ & + &4.8596e-05_r8,9.3271e-04_r8,1.6606e-03_r8,2.3393e-03_r8,3.0027e-03_r8,3.6916e-03_r8, & + &4.5243e-03_r8,5.9244e-03_r8,5.4196e-03_r8/) + kao(:, 3, 1, 7) = (/ & + &4.9220e-05_r8,9.5049e-04_r8,1.6928e-03_r8,2.3820e-03_r8,3.0582e-03_r8,3.7632e-03_r8, & + &4.6161e-03_r8,6.0368e-03_r8,5.5387e-03_r8/) + kao(:, 4, 1, 7) = (/ & + &4.9714e-05_r8,9.7063e-04_r8,1.7276e-03_r8,2.4311e-03_r8,3.1220e-03_r8,3.8430e-03_r8, & + &4.7205e-03_r8,6.1613e-03_r8,5.6708e-03_r8/) + kao(:, 5, 1, 7) = (/ & + &5.0550e-05_r8,9.9274e-04_r8,1.7651e-03_r8,2.4850e-03_r8,3.1923e-03_r8,3.9328e-03_r8, & + &4.8316e-03_r8,6.3027e-03_r8,5.8156e-03_r8/) + kao(:, 1, 2, 7) = (/ & + &6.7697e-05_r8,8.5995e-04_r8,1.5004e-03_r8,2.0933e-03_r8,2.6519e-03_r8,3.1963e-03_r8, & + &3.7792e-03_r8,4.6863e-03_r8,4.4711e-03_r8/) + kao(:, 2, 2, 7) = (/ & + &6.8123e-05_r8,8.7528e-04_r8,1.5266e-03_r8,2.1301e-03_r8,2.6961e-03_r8,3.2484e-03_r8, & + &3.8450e-03_r8,4.7682e-03_r8,4.5579e-03_r8/) + kao(:, 3, 2, 7) = (/ & + &6.9098e-05_r8,8.9351e-04_r8,1.5568e-03_r8,2.1723e-03_r8,2.7472e-03_r8,3.3096e-03_r8, & + &3.9205e-03_r8,4.8697e-03_r8,4.6570e-03_r8/) + kao(:, 4, 2, 7) = (/ & + &7.0075e-05_r8,9.1426e-04_r8,1.5908e-03_r8,2.2183e-03_r8,2.8071e-03_r8,3.3815e-03_r8, & + &4.0084e-03_r8,4.9811e-03_r8,4.7715e-03_r8/) + kao(:, 5, 2, 7) = (/ & + &7.1192e-05_r8,9.3706e-04_r8,1.6283e-03_r8,2.2693e-03_r8,2.8718e-03_r8,3.4625e-03_r8, & + &4.1070e-03_r8,5.1037e-03_r8,4.8979e-03_r8/) + kao(:, 1, 3, 7) = (/ & + &1.2733e-04_r8,8.7624e-04_r8,1.4506e-03_r8,1.9805e-03_r8,2.4757e-03_r8,2.9317e-03_r8, & + &3.3558e-03_r8,3.8170e-03_r8,3.7686e-03_r8/) + kao(:, 2, 3, 7) = (/ & + &1.2826e-04_r8,8.9276e-04_r8,1.4769e-03_r8,2.0153e-03_r8,2.5174e-03_r8,2.9784e-03_r8, & + &3.4075e-03_r8,3.8801e-03_r8,3.8344e-03_r8/) + kao(:, 3, 3, 7) = (/ & + &1.2973e-04_r8,9.1170e-04_r8,1.5076e-03_r8,2.0539e-03_r8,2.5651e-03_r8,3.0352e-03_r8, & + &3.4680e-03_r8,3.9525e-03_r8,3.9125e-03_r8/) + kao(:, 4, 3, 7) = (/ & + &1.3225e-04_r8,9.3418e-04_r8,1.5436e-03_r8,2.1000e-03_r8,2.6202e-03_r8,3.1002e-03_r8, & + &3.5421e-03_r8,4.0383e-03_r8,4.0057e-03_r8/) + kao(:, 5, 3, 7) = (/ & + &1.3440e-04_r8,9.5794e-04_r8,1.5825e-03_r8,2.1509e-03_r8,2.6822e-03_r8,3.1720e-03_r8, & + &3.6252e-03_r8,4.1370e-03_r8,4.1108e-03_r8/) + kao(:, 1, 4, 7) = (/ & + &2.4414e-04_r8,9.8791e-04_r8,1.4797e-03_r8,1.9337e-03_r8,2.3609e-03_r8,2.7541e-03_r8, & + &3.0988e-03_r8,3.3862e-03_r8,3.2303e-03_r8/) + kao(:, 2, 4, 7) = (/ & + &2.4513e-04_r8,1.0039e-03_r8,1.5070e-03_r8,1.9692e-03_r8,2.4021e-03_r8,2.7995e-03_r8, & + &3.1468e-03_r8,3.4333e-03_r8,3.2790e-03_r8/) + kao(:, 3, 4, 7) = (/ & + &2.4808e-04_r8,1.0229e-03_r8,1.5373e-03_r8,2.0098e-03_r8,2.4481e-03_r8,2.8491e-03_r8, & + &3.2030e-03_r8,3.4903e-03_r8,3.3384e-03_r8/) + kao(:, 4, 4, 7) = (/ & + &2.5202e-04_r8,1.0447e-03_r8,1.5721e-03_r8,2.0572e-03_r8,2.5035e-03_r8,2.9093e-03_r8, & + &3.2672e-03_r8,3.5611e-03_r8,3.4115e-03_r8/) + kao(:, 5, 4, 7) = (/ & + &2.5833e-04_r8,1.0719e-03_r8,1.6144e-03_r8,2.1102e-03_r8,2.5658e-03_r8,2.9793e-03_r8, & + &3.3418e-03_r8,3.6423e-03_r8,3.4938e-03_r8/) + kao(:, 1, 5, 7) = (/ & + &4.2770e-04_r8,1.1830e-03_r8,1.6220e-03_r8,1.9840e-03_r8,2.3123e-03_r8,2.6214e-03_r8, & + &2.8956e-03_r8,3.0934e-03_r8,2.7805e-03_r8/) + kao(:, 2, 5, 7) = (/ & + &4.3162e-04_r8,1.2016e-03_r8,1.6476e-03_r8,2.0183e-03_r8,2.3523e-03_r8,2.6652e-03_r8, & + &2.9419e-03_r8,3.1389e-03_r8,2.8192e-03_r8/) + kao(:, 3, 5, 7) = (/ & + &4.3693e-04_r8,1.2232e-03_r8,1.6764e-03_r8,2.0550e-03_r8,2.3985e-03_r8,2.7158e-03_r8, & + &2.9926e-03_r8,3.1918e-03_r8,2.8694e-03_r8/) + kao(:, 4, 5, 7) = (/ & + &4.4235e-04_r8,1.2462e-03_r8,1.7099e-03_r8,2.0981e-03_r8,2.4518e-03_r8,2.7746e-03_r8, & + &3.0533e-03_r8,3.2519e-03_r8,2.9306e-03_r8/) + kao(:, 5, 5, 7) = (/ & + &4.5257e-04_r8,1.2739e-03_r8,1.7526e-03_r8,2.1524e-03_r8,2.5133e-03_r8,2.8432e-03_r8, & + &3.1246e-03_r8,3.3219e-03_r8,2.9994e-03_r8/) + kao(:, 1, 6, 7) = (/ & + &6.9917e-04_r8,1.4510e-03_r8,1.8508e-03_r8,2.1612e-03_r8,2.3969e-03_r8,2.5820e-03_r8, & + &2.7369e-03_r8,2.8411e-03_r8,2.3809e-03_r8/) + kao(:, 2, 6, 7) = (/ & + &7.0685e-04_r8,1.4737e-03_r8,1.8819e-03_r8,2.1948e-03_r8,2.4365e-03_r8,2.6262e-03_r8, & + &2.7822e-03_r8,2.8845e-03_r8,2.4163e-03_r8/) + kao(:, 3, 6, 7) = (/ & + &7.1685e-04_r8,1.4992e-03_r8,1.9139e-03_r8,2.2300e-03_r8,2.4777e-03_r8,2.6750e-03_r8, & + &2.8324e-03_r8,2.9331e-03_r8,2.4594e-03_r8/) + kao(:, 4, 6, 7) = (/ & + &7.2831e-04_r8,1.5276e-03_r8,1.9491e-03_r8,2.2715e-03_r8,2.5262e-03_r8,2.7293e-03_r8, & + &2.8927e-03_r8,2.9913e-03_r8,2.5109e-03_r8/) + kao(:, 5, 6, 7) = (/ & + &7.4174e-04_r8,1.5586e-03_r8,1.9900e-03_r8,2.3214e-03_r8,2.5825e-03_r8,2.7929e-03_r8, & + &2.9629e-03_r8,3.0587e-03_r8,2.5688e-03_r8/) + kao(:, 1, 7, 7) = (/ & + &1.2039e-03_r8,1.9587e-03_r8,2.2962e-03_r8,2.5331e-03_r8,2.6974e-03_r8,2.7733e-03_r8, & + &2.7634e-03_r8,2.6777e-03_r8,2.0245e-03_r8/) + kao(:, 2, 7, 7) = (/ & + &1.2204e-03_r8,1.9874e-03_r8,2.3314e-03_r8,2.5722e-03_r8,2.7404e-03_r8,2.8207e-03_r8, & + &2.8122e-03_r8,2.7221e-03_r8,2.0503e-03_r8/) + kao(:, 3, 7, 7) = (/ & + &1.2400e-03_r8,2.0184e-03_r8,2.3716e-03_r8,2.6156e-03_r8,2.7851e-03_r8,2.8685e-03_r8, & + &2.8623e-03_r8,2.7709e-03_r8,2.0844e-03_r8/) + kao(:, 4, 7, 7) = (/ & + &1.2633e-03_r8,2.0537e-03_r8,2.4164e-03_r8,2.6645e-03_r8,2.8368e-03_r8,2.9213e-03_r8, & + &2.9184e-03_r8,2.8302e-03_r8,2.1246e-03_r8/) + kao(:, 5, 7, 7) = (/ & + &1.2880e-03_r8,2.0946e-03_r8,2.4660e-03_r8,2.7241e-03_r8,2.8956e-03_r8,2.9852e-03_r8, & + &2.9850e-03_r8,2.8977e-03_r8,2.1717e-03_r8/) + kao(:, 1, 8, 7) = (/ & + &2.4360e-03_r8,3.2317e-03_r8,3.4336e-03_r8,3.4928e-03_r8,3.4872e-03_r8,3.3872e-03_r8, & + &3.1811e-03_r8,2.7989e-03_r8,1.6994e-03_r8/) + kao(:, 2, 8, 7) = (/ & + &2.4784e-03_r8,3.2772e-03_r8,3.4707e-03_r8,3.5477e-03_r8,3.5429e-03_r8,3.4442e-03_r8, & + &3.2393e-03_r8,2.8503e-03_r8,1.7216e-03_r8/) + kao(:, 3, 8, 7) = (/ & + &2.5215e-03_r8,3.3205e-03_r8,3.5181e-03_r8,3.6097e-03_r8,3.6079e-03_r8,3.5043e-03_r8, & + &3.2957e-03_r8,2.9015e-03_r8,1.7516e-03_r8/) + kao(:, 4, 8, 7) = (/ & + &2.5734e-03_r8,3.3690e-03_r8,3.5815e-03_r8,3.6774e-03_r8,3.6742e-03_r8,3.5696e-03_r8, & + &3.3583e-03_r8,2.9597e-03_r8,1.7852e-03_r8/) + kao(:, 5, 8, 7) = (/ & + &2.6287e-03_r8,3.4209e-03_r8,3.6564e-03_r8,3.7526e-03_r8,3.7488e-03_r8,3.6496e-03_r8, & + &3.4322e-03_r8,3.0257e-03_r8,1.8234e-03_r8/) + kao(:, 1, 9, 7) = (/ & + &9.2016e-03_r8,9.7823e-03_r8,9.4145e-03_r8,8.7411e-03_r8,7.8879e-03_r8,6.8736e-03_r8, & + &5.6569e-03_r8,4.2025e-03_r8,1.5538e-03_r8/) + kao(:, 2, 9, 7) = (/ & + &9.3962e-03_r8,9.9769e-03_r8,9.5905e-03_r8,8.8876e-03_r8,8.0147e-03_r8,6.9737e-03_r8, & + &5.7408e-03_r8,4.2797e-03_r8,1.5748e-03_r8/) + kao(:, 3, 9, 7) = (/ & + &9.5905e-03_r8,1.0169e-02_r8,9.7567e-03_r8,9.0284e-03_r8,8.1348e-03_r8,7.0770e-03_r8, & + &5.8473e-03_r8,4.3619e-03_r8,1.5893e-03_r8/) + kao(:, 4, 9, 7) = (/ & + &9.8163e-03_r8,1.0370e-02_r8,9.9309e-03_r8,9.1820e-03_r8,8.2703e-03_r8,7.1825e-03_r8, & + &5.9588e-03_r8,4.4477e-03_r8,1.6087e-03_r8/) + kao(:, 5, 9, 7) = (/ & + &1.0054e-02_r8,1.0584e-02_r8,1.0131e-02_r8,9.3626e-03_r8,8.4298e-03_r8,7.3350e-03_r8, & + &6.0835e-03_r8,4.5437e-03_r8,1.6313e-03_r8/) + kao(:, 1,10, 7) = (/ & + &3.9276e-02_r8,3.6749e-02_r8,3.3301e-02_r8,2.9241e-02_r8,2.4794e-02_r8,2.0028e-02_r8, & + &1.4912e-02_r8,9.3013e-03_r8,2.0443e-03_r8/) + kao(:, 2,10, 7) = (/ & + &4.0105e-02_r8,3.7556e-02_r8,3.4005e-02_r8,2.9863e-02_r8,2.5353e-02_r8,2.0438e-02_r8, & + &1.5180e-02_r8,9.4819e-03_r8,2.0242e-03_r8/) + kao(:, 3,10, 7) = (/ & + &4.0916e-02_r8,3.8307e-02_r8,3.4681e-02_r8,3.0487e-02_r8,2.5876e-02_r8,2.0814e-02_r8, & + &1.5451e-02_r8,9.6638e-03_r8,2.0047e-03_r8/) + kao(:, 4,10, 7) = (/ & + &4.1894e-02_r8,3.9199e-02_r8,3.5443e-02_r8,3.1118e-02_r8,2.6390e-02_r8,2.1233e-02_r8, & + &1.5746e-02_r8,9.8447e-03_r8,2.0155e-03_r8/) + kao(:, 5,10, 7) = (/ & + &4.2954e-02_r8,4.0161e-02_r8,3.6290e-02_r8,3.1839e-02_r8,2.6971e-02_r8,2.1693e-02_r8, & + &1.6115e-02_r8,1.0055e-02_r8,2.0394e-03_r8/) + kao(:, 1,11, 7) = (/ & + &6.0955e-02_r8,5.5737e-02_r8,4.9723e-02_r8,4.3019e-02_r8,3.5876e-02_r8,2.8379e-02_r8, & + &2.0432e-02_r8,1.2085e-02_r8,2.3716e-03_r8/) + kao(:, 2,11, 7) = (/ & + &6.2198e-02_r8,5.6869e-02_r8,5.0662e-02_r8,4.3787e-02_r8,3.6565e-02_r8,2.8915e-02_r8, & + &2.0814e-02_r8,1.2323e-02_r8,2.3542e-03_r8/) + kao(:, 3,11, 7) = (/ & + &6.3419e-02_r8,5.8024e-02_r8,5.1697e-02_r8,4.4702e-02_r8,3.7324e-02_r8,2.9465e-02_r8, & + &2.1204e-02_r8,1.2555e-02_r8,2.3313e-03_r8/) + kao(:, 4,11, 7) = (/ & + &6.4926e-02_r8,5.9386e-02_r8,5.2869e-02_r8,4.5680e-02_r8,3.8119e-02_r8,3.0075e-02_r8, & + &2.1667e-02_r8,1.2812e-02_r8,2.3155e-03_r8/) + kao(:, 5,11, 7) = (/ & + &6.6635e-02_r8,6.0864e-02_r8,5.4124e-02_r8,4.6774e-02_r8,3.9011e-02_r8,3.0829e-02_r8, & + &2.2206e-02_r8,1.3119e-02_r8,2.3251e-03_r8/) + kao(:, 1,12, 7) = (/ & + &6.9869e-02_r8,6.3637e-02_r8,5.6420e-02_r8,4.8546e-02_r8,4.0307e-02_r8,3.1740e-02_r8, & + &2.2682e-02_r8,1.3139e-02_r8,2.4428e-03_r8/) + kao(:, 2,12, 7) = (/ & + &7.1577e-02_r8,6.5133e-02_r8,5.7685e-02_r8,4.9634e-02_r8,4.1244e-02_r8,3.2466e-02_r8, & + &2.3165e-02_r8,1.3402e-02_r8,2.4417e-03_r8/) + kao(:, 3,12, 7) = (/ & + &7.3435e-02_r8,6.6765e-02_r8,5.9111e-02_r8,5.0782e-02_r8,4.2090e-02_r8,3.3070e-02_r8, & + &2.3631e-02_r8,1.3663e-02_r8,2.4312e-03_r8/) + kao(:, 4,12, 7) = (/ & + &7.5274e-02_r8,6.8406e-02_r8,6.0539e-02_r8,5.2024e-02_r8,4.3158e-02_r8,3.3897e-02_r8, & + &2.4213e-02_r8,1.3961e-02_r8,2.4213e-03_r8/) + kao(:, 5,12, 7) = (/ & + &7.7518e-02_r8,7.0447e-02_r8,6.2339e-02_r8,5.3608e-02_r8,4.4457e-02_r8,3.4884e-02_r8, & + &2.4882e-02_r8,1.4302e-02_r8,2.4144e-03_r8/) + kao(:, 1,13, 7) = (/ & + &6.3971e-02_r8,5.8270e-02_r8,5.1535e-02_r8,4.4263e-02_r8,3.6709e-02_r8,2.8872e-02_r8, & + &2.0629e-02_r8,1.1917e-02_r8,2.3953e-03_r8/) + kao(:, 2,13, 7) = (/ & + &6.5643e-02_r8,5.9813e-02_r8,5.2890e-02_r8,4.5419e-02_r8,3.7684e-02_r8,2.9600e-02_r8, & + &2.1119e-02_r8,1.2188e-02_r8,2.4046e-03_r8/) + kao(:, 3,13, 7) = (/ & + &6.7472e-02_r8,6.1457e-02_r8,5.4341e-02_r8,4.6654e-02_r8,3.8721e-02_r8,3.0402e-02_r8, & + &2.1696e-02_r8,1.2486e-02_r8,2.3922e-03_r8/) + kao(:, 4,13, 7) = (/ & + &6.9579e-02_r8,6.3365e-02_r8,5.6023e-02_r8,4.8132e-02_r8,3.9923e-02_r8,3.1337e-02_r8, & + &2.2348e-02_r8,1.2806e-02_r8,2.3768e-03_r8/) + kao(:, 5,13, 7) = (/ & + &7.1993e-02_r8,6.5596e-02_r8,5.7974e-02_r8,4.9776e-02_r8,4.1204e-02_r8,3.2317e-02_r8, & + &2.3035e-02_r8,1.3183e-02_r8,2.3765e-03_r8/) + kao(:, 1, 1, 8) = (/ & + &1.3552e-04_r8,2.4322e-03_r8,4.1951e-03_r8,5.8754e-03_r8,7.6297e-03_r8,9.6149e-03_r8, & + &1.1994e-02_r8,1.5380e-02_r8,1.4856e-02_r8/) + kao(:, 2, 1, 8) = (/ & + &1.3805e-04_r8,2.4459e-03_r8,4.2175e-03_r8,5.9121e-03_r8,7.6823e-03_r8,9.6825e-03_r8, & + &1.2072e-02_r8,1.5469e-02_r8,1.4971e-02_r8/) + kao(:, 3, 1, 8) = (/ & + &1.4131e-04_r8,2.4661e-03_r8,4.2478e-03_r8,5.9602e-03_r8,7.7525e-03_r8,9.7747e-03_r8, & + &1.2179e-02_r8,1.5577e-02_r8,1.5128e-02_r8/) + kao(:, 4, 1, 8) = (/ & + &1.4377e-04_r8,2.4912e-03_r8,4.2859e-03_r8,6.0170e-03_r8,7.8373e-03_r8,9.8887e-03_r8, & + &1.2314e-02_r8,1.5728e-02_r8,1.5316e-02_r8/) + kao(:, 5, 1, 8) = (/ & + &1.4692e-04_r8,2.5205e-03_r8,4.3310e-03_r8,6.0836e-03_r8,7.9343e-03_r8,1.0019e-02_r8, & + &1.2473e-02_r8,1.5904e-02_r8,1.5528e-02_r8/) + kao(:, 1, 2, 8) = (/ & + &1.8928e-04_r8,2.4121e-03_r8,4.0623e-03_r8,5.5541e-03_r8,6.9898e-03_r8,8.5008e-03_r8, & + &1.0323e-02_r8,1.3028e-02_r8,1.2924e-02_r8/) + kao(:, 2, 2, 8) = (/ & + &1.9267e-04_r8,2.4360e-03_r8,4.0898e-03_r8,5.5901e-03_r8,7.0384e-03_r8,8.5652e-03_r8, & + &1.0405e-02_r8,1.3116e-02_r8,1.3041e-02_r8/) + kao(:, 3, 2, 8) = (/ & + &1.9724e-04_r8,2.4656e-03_r8,4.1277e-03_r8,5.6355e-03_r8,7.0999e-03_r8,8.6497e-03_r8, & + &1.0515e-02_r8,1.3234e-02_r8,1.3193e-02_r8/) + kao(:, 4, 2, 8) = (/ & + &2.0128e-04_r8,2.4981e-03_r8,4.1715e-03_r8,5.6919e-03_r8,7.1715e-03_r8,8.7477e-03_r8, & + &1.0645e-02_r8,1.3388e-02_r8,1.3368e-02_r8/) + kao(:, 5, 2, 8) = (/ & + &2.0477e-04_r8,2.5328e-03_r8,4.2216e-03_r8,5.7557e-03_r8,7.2538e-03_r8,8.8556e-03_r8, & + &1.0788e-02_r8,1.3565e-02_r8,1.3563e-02_r8/) + kao(:, 1, 3, 8) = (/ & + &3.5927e-04_r8,2.5910e-03_r8,4.2037e-03_r8,5.6032e-03_r8,6.8389e-03_r8,7.9673e-03_r8, & + &9.0787e-03_r8,1.0659e-02_r8,1.1075e-02_r8/) + kao(:, 2, 3, 8) = (/ & + &3.6570e-04_r8,2.6231e-03_r8,4.2518e-03_r8,5.6510e-03_r8,6.8860e-03_r8,8.0235e-03_r8, & + &9.1475e-03_r8,1.0746e-02_r8,1.1185e-02_r8/) + kao(:, 3, 3, 8) = (/ & + &3.7255e-04_r8,2.6596e-03_r8,4.3088e-03_r8,5.7121e-03_r8,6.9479e-03_r8,8.0889e-03_r8, & + &9.2308e-03_r8,1.0860e-02_r8,1.1321e-02_r8/) + kao(:, 4, 3, 8) = (/ & + &3.8155e-04_r8,2.7037e-03_r8,4.3688e-03_r8,5.7837e-03_r8,7.0219e-03_r8,8.1712e-03_r8, & + &9.3303e-03_r8,1.0993e-02_r8,1.1473e-02_r8/) + kao(:, 5, 3, 8) = (/ & + &3.8777e-04_r8,2.7514e-03_r8,4.4348e-03_r8,5.8612e-03_r8,7.1061e-03_r8,8.2670e-03_r8, & + &9.4452e-03_r8,1.1141e-02_r8,1.1658e-02_r8/) + kao(:, 1, 4, 8) = (/ & + &6.9620e-04_r8,2.9029e-03_r8,4.4649e-03_r8,5.7896e-03_r8,6.9152e-03_r8,7.8788e-03_r8, & + &8.6335e-03_r8,9.2668e-03_r8,9.4651e-03_r8/) + kao(:, 2, 4, 8) = (/ & + &7.1019e-04_r8,2.9517e-03_r8,4.5263e-03_r8,5.8664e-03_r8,6.9912e-03_r8,7.9468e-03_r8, & + &8.6984e-03_r8,9.3401e-03_r8,9.5623e-03_r8/) + kao(:, 3, 4, 8) = (/ & + &7.2359e-04_r8,3.0044e-03_r8,4.5979e-03_r8,5.9489e-03_r8,7.0830e-03_r8,8.0315e-03_r8, & + &8.7768e-03_r8,9.4291e-03_r8,9.6859e-03_r8/) + kao(:, 4, 4, 8) = (/ & + &7.3828e-04_r8,3.0619e-03_r8,4.6789e-03_r8,6.0379e-03_r8,7.1842e-03_r8,8.1322e-03_r8, & + &8.8743e-03_r8,9.5317e-03_r8,9.8248e-03_r8/) + kao(:, 5, 4, 8) = (/ & + &7.5535e-04_r8,3.1266e-03_r8,4.7671e-03_r8,6.1369e-03_r8,7.2972e-03_r8,8.2469e-03_r8, & + &8.9884e-03_r8,9.6595e-03_r8,9.9955e-03_r8/) + kao(:, 1, 5, 8) = (/ & + &1.2367e-03_r8,3.3787e-03_r8,4.7869e-03_r8,5.9863e-03_r8,7.0094e-03_r8,7.8065e-03_r8, & + &8.3893e-03_r8,8.6393e-03_r8,8.1050e-03_r8/) + kao(:, 2, 5, 8) = (/ & + &1.2606e-03_r8,3.4408e-03_r8,4.8727e-03_r8,6.0829e-03_r8,7.1090e-03_r8,7.9083e-03_r8, & + &8.4736e-03_r8,8.7084e-03_r8,8.1896e-03_r8/) + kao(:, 3, 5, 8) = (/ & + &1.2858e-03_r8,3.5058e-03_r8,4.9695e-03_r8,6.1896e-03_r8,7.2184e-03_r8,8.0235e-03_r8, & + &8.5795e-03_r8,8.7948e-03_r8,8.2945e-03_r8/) + kao(:, 4, 5, 8) = (/ & + &1.3144e-03_r8,3.5781e-03_r8,5.0734e-03_r8,6.3066e-03_r8,7.3381e-03_r8,8.1502e-03_r8, & + &8.7050e-03_r8,8.8972e-03_r8,8.4098e-03_r8/) + kao(:, 5, 5, 8) = (/ & + &1.3469e-03_r8,3.6641e-03_r8,5.1833e-03_r8,6.4362e-03_r8,7.4701e-03_r8,8.2878e-03_r8, & + &8.8414e-03_r8,9.0166e-03_r8,8.5483e-03_r8/) + kao(:, 1, 6, 8) = (/ & + &2.0401e-03_r8,4.1601e-03_r8,5.3408e-03_r8,6.2948e-03_r8,7.1082e-03_r8,7.7648e-03_r8, & + &8.1607e-03_r8,8.2016e-03_r8,6.9653e-03_r8/) + kao(:, 2, 6, 8) = (/ & + &2.0844e-03_r8,4.2423e-03_r8,5.4455e-03_r8,6.4160e-03_r8,7.2313e-03_r8,7.8855e-03_r8, & + &8.2759e-03_r8,8.2810e-03_r8,7.0331e-03_r8/) + kao(:, 3, 6, 8) = (/ & + &2.1282e-03_r8,4.3237e-03_r8,5.5575e-03_r8,6.5512e-03_r8,7.3708e-03_r8,8.0202e-03_r8, & + &8.4033e-03_r8,8.3806e-03_r8,7.1162e-03_r8/) + kao(:, 4, 6, 8) = (/ & + &2.1756e-03_r8,4.4109e-03_r8,5.6792e-03_r8,6.6960e-03_r8,7.5224e-03_r8,8.1665e-03_r8, & + &8.5397e-03_r8,8.4981e-03_r8,7.2093e-03_r8/) + kao(:, 5, 6, 8) = (/ & + &2.2255e-03_r8,4.5091e-03_r8,5.8068e-03_r8,6.8485e-03_r8,7.6856e-03_r8,8.3228e-03_r8, & + &8.6864e-03_r8,8.6279e-03_r8,7.3203e-03_r8/) + kao(:, 1, 7, 8) = (/ & + &3.5433e-03_r8,5.7288e-03_r8,6.6788e-03_r8,7.3197e-03_r8,7.7679e-03_r8,8.0638e-03_r8, & + &8.2036e-03_r8,7.9558e-03_r8,6.0055e-03_r8/) + kao(:, 2, 7, 8) = (/ & + &3.6269e-03_r8,5.8458e-03_r8,6.8139e-03_r8,7.4674e-03_r8,7.9220e-03_r8,8.2152e-03_r8, & + &8.3417e-03_r8,8.0664e-03_r8,6.0619e-03_r8/) + kao(:, 3, 7, 8) = (/ & + &3.7095e-03_r8,5.9702e-03_r8,6.9487e-03_r8,7.6264e-03_r8,8.0952e-03_r8,8.3842e-03_r8, & + &8.4920e-03_r8,8.1889e-03_r8,6.1273e-03_r8/) + kao(:, 4, 7, 8) = (/ & + &3.7971e-03_r8,6.0972e-03_r8,7.0950e-03_r8,7.7981e-03_r8,8.2789e-03_r8,8.5668e-03_r8, & + &8.6571e-03_r8,8.3173e-03_r8,6.2019e-03_r8/) + kao(:, 5, 7, 8) = (/ & + &3.8894e-03_r8,6.2311e-03_r8,7.2602e-03_r8,7.9756e-03_r8,8.4749e-03_r8,8.7608e-03_r8, & + &8.8292e-03_r8,8.4586e-03_r8,6.2926e-03_r8/) + kao(:, 1, 8, 8) = (/ & + &7.2384e-03_r8,9.3960e-03_r8,1.0099e-02_r8,1.0331e-02_r8,1.0208e-02_r8,9.8199e-03_r8, & + &9.1852e-03_r8,8.2577e-03_r8,5.1301e-03_r8/) + kao(:, 2, 8, 8) = (/ & + &7.4182e-03_r8,9.6243e-03_r8,1.0349e-02_r8,1.0556e-02_r8,1.0419e-02_r8,1.0021e-02_r8, & + &9.3680e-03_r8,8.3968e-03_r8,5.1752e-03_r8/) + kao(:, 3, 8, 8) = (/ & + &7.6043e-03_r8,9.8546e-03_r8,1.0598e-02_r8,1.0777e-02_r8,1.0633e-02_r8,1.0249e-02_r8, & + &9.5676e-03_r8,8.5508e-03_r8,5.2269e-03_r8/) + kao(:, 4, 8, 8) = (/ & + &7.7980e-03_r8,1.0094e-02_r8,1.0836e-02_r8,1.1012e-02_r8,1.0870e-02_r8,1.0482e-02_r8, & + &9.7866e-03_r8,8.7162e-03_r8,5.2872e-03_r8/) + kao(:, 5, 8, 8) = (/ & + &8.0005e-03_r8,1.0352e-02_r8,1.1093e-02_r8,1.1272e-02_r8,1.1127e-02_r8,1.0726e-02_r8, & + &1.0012e-02_r8,8.8875e-03_r8,5.3638e-03_r8/) + kao(:, 1, 9, 8) = (/ & + &2.7897e-02_r8,2.8473e-02_r8,2.7594e-02_r8,2.5806e-02_r8,2.3354e-02_r8,2.0346e-02_r8, & + &1.6782e-02_r8,1.2341e-02_r8,4.1787e-03_r8/) + kao(:, 2, 9, 8) = (/ & + &2.8638e-02_r8,2.9187e-02_r8,2.8303e-02_r8,2.6475e-02_r8,2.3949e-02_r8,2.0857e-02_r8, & + &1.7181e-02_r8,1.2602e-02_r8,4.2128e-03_r8/) + kao(:, 3, 9, 8) = (/ & + &2.9413e-02_r8,2.9901e-02_r8,2.8994e-02_r8,2.7143e-02_r8,2.4571e-02_r8,2.1381e-02_r8, & + &1.7560e-02_r8,1.2888e-02_r8,4.2655e-03_r8/) + kao(:, 4, 9, 8) = (/ & + &3.0228e-02_r8,3.0665e-02_r8,2.9734e-02_r8,2.7828e-02_r8,2.5188e-02_r8,2.1923e-02_r8, & + &1.7970e-02_r8,1.3183e-02_r8,4.3190e-03_r8/) + kao(:, 5, 9, 8) = (/ & + &3.1084e-02_r8,3.1463e-02_r8,3.0494e-02_r8,2.8550e-02_r8,2.5844e-02_r8,2.2478e-02_r8, & + &1.8412e-02_r8,1.3496e-02_r8,4.3806e-03_r8/) + kao(:, 1,10, 8) = (/ & + &1.1962e-01_r8,1.0878e-01_r8,9.8349e-02_r8,8.6745e-02_r8,7.3912e-02_r8,5.9973e-02_r8, & + &4.4839e-02_r8,2.7943e-02_r8,4.7543e-03_r8/) + kao(:, 2,10, 8) = (/ & + &1.2315e-01_r8,1.1182e-01_r8,1.0110e-01_r8,8.9175e-02_r8,7.5937e-02_r8,6.1630e-02_r8, & + &4.6110e-02_r8,2.8679e-02_r8,4.8196e-03_r8/) + kao(:, 3,10, 8) = (/ & + &1.2693e-01_r8,1.1500e-01_r8,1.0391e-01_r8,9.1586e-02_r8,7.7974e-02_r8,6.3317e-02_r8, & + &4.7374e-02_r8,2.9424e-02_r8,4.8761e-03_r8/) + kao(:, 4,10, 8) = (/ & + &1.3084e-01_r8,1.1837e-01_r8,1.0689e-01_r8,9.4192e-02_r8,8.0184e-02_r8,6.5076e-02_r8, & + &4.8672e-02_r8,3.0173e-02_r8,4.8766e-03_r8/) + kao(:, 5,10, 8) = (/ & + &1.3499e-01_r8,1.2195e-01_r8,1.1004e-01_r8,9.6906e-02_r8,8.2479e-02_r8,6.6930e-02_r8, & + &4.9998e-02_r8,3.0984e-02_r8,4.9096e-03_r8/) + kao(:, 1,11, 8) = (/ & + &1.7854e-01_r8,1.6015e-01_r8,1.4269e-01_r8,1.2418e-01_r8,1.0441e-01_r8,8.3289e-02_r8, & + &6.0955e-02_r8,3.6472e-02_r8,5.4769e-03_r8/) + kao(:, 2,11, 8) = (/ & + &1.8442e-01_r8,1.6524e-01_r8,1.4721e-01_r8,1.2815e-01_r8,1.0771e-01_r8,8.5980e-02_r8, & + &6.2870e-02_r8,3.7580e-02_r8,5.4728e-03_r8/) + kao(:, 3,11, 8) = (/ & + &1.9077e-01_r8,1.7071e-01_r8,1.5197e-01_r8,1.3224e-01_r8,1.1114e-01_r8,8.8708e-02_r8, & + &6.4824e-02_r8,3.8654e-02_r8,5.4615e-03_r8/) + kao(:, 4,11, 8) = (/ & + &1.9746e-01_r8,1.7645e-01_r8,1.5699e-01_r8,1.3658e-01_r8,1.1475e-01_r8,9.1549e-02_r8, & + &6.6833e-02_r8,3.9764e-02_r8,5.4686e-03_r8/) + kao(:, 5,11, 8) = (/ & + &2.0452e-01_r8,1.8255e-01_r8,1.6232e-01_r8,1.4114e-01_r8,1.1852e-01_r8,9.4452e-02_r8, & + &6.8909e-02_r8,4.0947e-02_r8,5.4706e-03_r8/) + kao(:, 1,12, 8) = (/ & + &2.0120e-01_r8,1.7983e-01_r8,1.5919e-01_r8,1.3760e-01_r8,1.1465e-01_r8,9.0568e-02_r8, & + &6.5383e-02_r8,3.8355e-02_r8,5.7670e-03_r8/) + kao(:, 2,12, 8) = (/ & + &2.0757e-01_r8,1.8546e-01_r8,1.6435e-01_r8,1.4209e-01_r8,1.1843e-01_r8,9.3538e-02_r8, & + &6.7515e-02_r8,3.9583e-02_r8,5.7182e-03_r8/) + kao(:, 3,12, 8) = (/ & + &2.1449e-01_r8,1.9151e-01_r8,1.6961e-01_r8,1.4673e-01_r8,1.2244e-01_r8,9.6759e-02_r8, & + &6.9782e-02_r8,4.0857e-02_r8,5.7245e-03_r8/) + kao(:, 4,12, 8) = (/ & + &2.2222e-01_r8,1.9817e-01_r8,1.7542e-01_r8,1.5173e-01_r8,1.2653e-01_r8,1.0003e-01_r8, & + &7.2145e-02_r8,4.2184e-02_r8,5.7102e-03_r8/) + kao(:, 5,12, 8) = (/ & + &2.3023e-01_r8,2.0507e-01_r8,1.8144e-01_r8,1.5689e-01_r8,1.3087e-01_r8,1.0351e-01_r8, & + &7.4642e-02_r8,4.3620e-02_r8,5.7450e-03_r8/) + kao(:, 1,13, 8) = (/ & + &1.8448e-01_r8,1.6553e-01_r8,1.4649e-01_r8,1.2620e-01_r8,1.0471e-01_r8,8.2340e-02_r8, & + &5.9042e-02_r8,3.4367e-02_r8,5.6219e-03_r8/) + kao(:, 2,13, 8) = (/ & + &1.9034e-01_r8,1.7056e-01_r8,1.5103e-01_r8,1.3022e-01_r8,1.0811e-01_r8,8.5094e-02_r8, & + &6.1006e-02_r8,3.5479e-02_r8,5.5942e-03_r8/) + kao(:, 3,13, 8) = (/ & + &1.9658e-01_r8,1.7595e-01_r8,1.5589e-01_r8,1.3452e-01_r8,1.1170e-01_r8,8.7865e-02_r8, & + &6.2984e-02_r8,3.6599e-02_r8,5.6072e-03_r8/) + kao(:, 4,13, 8) = (/ & + &2.0338e-01_r8,1.8188e-01_r8,1.6115e-01_r8,1.3898e-01_r8,1.1533e-01_r8,9.0760e-02_r8, & + &6.5090e-02_r8,3.7803e-02_r8,5.6436e-03_r8/) + kao(:, 5,13, 8) = (/ & + &2.1087e-01_r8,1.8825e-01_r8,1.6661e-01_r8,1.4369e-01_r8,1.1939e-01_r8,9.3967e-02_r8, & + &6.7400e-02_r8,3.9148e-02_r8,5.6745e-03_r8/) + kao(:, 1, 1, 9) = (/ & + &9.4421e-04_r8,7.3440e-03_r8,1.3185e-02_r8,1.9434e-02_r8,2.5910e-02_r8,3.2531e-02_r8, & + &3.9377e-02_r8,4.6620e-02_r8,5.1571e-02_r8/) + kao(:, 2, 1, 9) = (/ & + &9.6482e-04_r8,7.2909e-03_r8,1.3109e-02_r8,1.9331e-02_r8,2.5776e-02_r8,3.2360e-02_r8, & + &3.9164e-02_r8,4.6323e-02_r8,5.1303e-02_r8/) + kao(:, 3, 1, 9) = (/ & + &9.8476e-04_r8,7.2409e-03_r8,1.3044e-02_r8,1.9248e-02_r8,2.5665e-02_r8,3.2216e-02_r8, & + &3.8981e-02_r8,4.6102e-02_r8,5.1082e-02_r8/) + kao(:, 4, 1, 9) = (/ & + &1.0020e-03_r8,7.1999e-03_r8,1.3010e-02_r8,1.9215e-02_r8,2.5618e-02_r8,3.2137e-02_r8, & + &3.8862e-02_r8,4.5932e-02_r8,5.0990e-02_r8/) + kao(:, 5, 1, 9) = (/ & + &1.0184e-03_r8,7.1770e-03_r8,1.3015e-02_r8,1.9243e-02_r8,2.5654e-02_r8,3.2165e-02_r8, & + &3.8858e-02_r8,4.5863e-02_r8,5.1066e-02_r8/) + kao(:, 1, 2, 9) = (/ & + &1.3462e-03_r8,8.0869e-03_r8,1.3393e-02_r8,1.9013e-02_r8,2.4987e-02_r8,3.1278e-02_r8, & + &3.7900e-02_r8,4.5296e-02_r8,4.9469e-02_r8/) + kao(:, 2, 2, 9) = (/ & + &1.3803e-03_r8,8.0241e-03_r8,1.3304e-02_r8,1.8903e-02_r8,2.4859e-02_r8,3.1123e-02_r8, & + &3.7707e-02_r8,4.5049e-02_r8,4.9230e-02_r8/) + kao(:, 3, 2, 9) = (/ & + &1.4130e-03_r8,7.9636e-03_r8,1.3235e-02_r8,1.8828e-02_r8,2.4777e-02_r8,3.1019e-02_r8, & + &3.7558e-02_r8,4.4839e-02_r8,4.9085e-02_r8/) + kao(:, 4, 2, 9) = (/ & + &1.4417e-03_r8,7.9144e-03_r8,1.3198e-02_r8,1.8807e-02_r8,2.4768e-02_r8,3.1006e-02_r8, & + &3.7513e-02_r8,4.4699e-02_r8,4.9090e-02_r8/) + kao(:, 5, 2, 9) = (/ & + &1.4672e-03_r8,7.8840e-03_r8,1.3197e-02_r8,1.8844e-02_r8,2.4841e-02_r8,3.1094e-02_r8, & + &3.7591e-02_r8,4.4701e-02_r8,4.9253e-02_r8/) + kao(:, 1, 3, 9) = (/ & + &2.5556e-03_r8,1.0082e-02_r8,1.5320e-02_r8,1.9920e-02_r8,2.4710e-02_r8,2.9907e-02_r8, & + &3.5684e-02_r8,4.2430e-02_r8,4.6609e-02_r8/) + kao(:, 2, 3, 9) = (/ & + &2.6284e-03_r8,1.0047e-02_r8,1.5209e-02_r8,1.9796e-02_r8,2.4582e-02_r8,2.9765e-02_r8, & + &3.5524e-02_r8,4.2220e-02_r8,4.6433e-02_r8/) + kao(:, 3, 3, 9) = (/ & + &2.6960e-03_r8,1.0006e-02_r8,1.5105e-02_r8,1.9696e-02_r8,2.4496e-02_r8,2.9686e-02_r8, & + &3.5446e-02_r8,4.2085e-02_r8,4.6365e-02_r8/) + kao(:, 4, 3, 9) = (/ & + &2.7589e-03_r8,9.9586e-03_r8,1.5035e-02_r8,1.9644e-02_r8,2.4475e-02_r8,2.9692e-02_r8, & + &3.5469e-02_r8,4.2071e-02_r8,4.6440e-02_r8/) + kao(:, 5, 3, 9) = (/ & + &2.8129e-03_r8,9.9196e-03_r8,1.4994e-02_r8,1.9639e-02_r8,2.4519e-02_r8,2.9788e-02_r8, & + &3.5597e-02_r8,4.2188e-02_r8,4.6642e-02_r8/) + kao(:, 1, 4, 9) = (/ & + &4.8937e-03_r8,1.3203e-02_r8,1.8921e-02_r8,2.3296e-02_r8,2.6924e-02_r8,3.0282e-02_r8, & + &3.4096e-02_r8,3.9071e-02_r8,4.3251e-02_r8/) + kao(:, 2, 4, 9) = (/ & + &5.0488e-03_r8,1.3226e-02_r8,1.8867e-02_r8,2.3170e-02_r8,2.6777e-02_r8,3.0147e-02_r8, & + &3.3963e-02_r8,3.8948e-02_r8,4.3159e-02_r8/) + kao(:, 3, 4, 9) = (/ & + &5.1910e-03_r8,1.3248e-02_r8,1.8795e-02_r8,2.3060e-02_r8,2.6655e-02_r8,3.0063e-02_r8, & + &3.3903e-02_r8,3.8899e-02_r8,4.3165e-02_r8/) + kao(:, 4, 4, 9) = (/ & + &5.3207e-03_r8,1.3268e-02_r8,1.8730e-02_r8,2.2981e-02_r8,2.6589e-02_r8,3.0040e-02_r8, & + &3.3930e-02_r8,3.8970e-02_r8,4.3287e-02_r8/) + kao(:, 5, 4, 9) = (/ & + &5.4422e-03_r8,1.3287e-02_r8,1.8693e-02_r8,2.2945e-02_r8,2.6576e-02_r8,3.0081e-02_r8, & + &3.4041e-02_r8,3.9135e-02_r8,4.3512e-02_r8/) + kao(:, 1, 5, 9) = (/ & + &8.5307e-03_r8,1.7183e-02_r8,2.3465e-02_r8,2.7970e-02_r8,3.1130e-02_r8,3.3358e-02_r8, & + &3.4774e-02_r8,3.6613e-02_r8,3.9589e-02_r8/) + kao(:, 2, 5, 9) = (/ & + &8.8245e-03_r8,1.7347e-02_r8,2.3508e-02_r8,2.7937e-02_r8,3.1047e-02_r8,3.3237e-02_r8, & + &3.4670e-02_r8,3.6530e-02_r8,3.9570e-02_r8/) + kao(:, 3, 5, 9) = (/ & + &9.0927e-03_r8,1.7496e-02_r8,2.3535e-02_r8,2.7881e-02_r8,3.0966e-02_r8,3.3147e-02_r8, & + &3.4603e-02_r8,3.6513e-02_r8,3.9628e-02_r8/) + kao(:, 4, 5, 9) = (/ & + &9.3371e-03_r8,1.7632e-02_r8,2.3559e-02_r8,2.7829e-02_r8,3.0920e-02_r8,3.3100e-02_r8, & + &3.4594e-02_r8,3.6581e-02_r8,3.9792e-02_r8/) + kao(:, 5, 5, 9) = (/ & + &9.5713e-03_r8,1.7760e-02_r8,2.3602e-02_r8,2.7816e-02_r8,3.0915e-02_r8,3.3109e-02_r8, & + &3.4648e-02_r8,3.6731e-02_r8,4.0039e-02_r8/) + kao(:, 1, 6, 9) = (/ & + &1.3837e-02_r8,2.2346e-02_r8,2.8803e-02_r8,3.3403e-02_r8,3.6375e-02_r8,3.7770e-02_r8, & + &3.7769e-02_r8,3.6158e-02_r8,3.5736e-02_r8/) + kao(:, 2, 6, 9) = (/ & + &1.4345e-02_r8,2.2684e-02_r8,2.9062e-02_r8,3.3523e-02_r8,3.6415e-02_r8,3.7748e-02_r8, & + &3.7698e-02_r8,3.6127e-02_r8,3.5788e-02_r8/) + kao(:, 3, 6, 9) = (/ & + &1.4814e-02_r8,2.3025e-02_r8,2.9297e-02_r8,3.3616e-02_r8,3.6414e-02_r8,3.7728e-02_r8, & + &3.7657e-02_r8,3.6132e-02_r8,3.5900e-02_r8/) + kao(:, 4, 6, 9) = (/ & + &1.5241e-02_r8,2.3333e-02_r8,2.9502e-02_r8,3.3707e-02_r8,3.6417e-02_r8,3.7743e-02_r8, & + &3.7671e-02_r8,3.6177e-02_r8,3.6086e-02_r8/) + kao(:, 5, 6, 9) = (/ & + &1.5643e-02_r8,2.3601e-02_r8,2.9688e-02_r8,3.3808e-02_r8,3.6468e-02_r8,3.7791e-02_r8, & + &3.7729e-02_r8,3.6273e-02_r8,3.6334e-02_r8/) + kao(:, 1, 7, 9) = (/ & + &2.3687e-02_r8,3.1230e-02_r8,3.7445e-02_r8,4.1636e-02_r8,4.4049e-02_r8,4.4684e-02_r8, & + &4.3161e-02_r8,3.8835e-02_r8,3.1866e-02_r8/) + kao(:, 2, 7, 9) = (/ & + &2.4610e-02_r8,3.1967e-02_r8,3.8037e-02_r8,4.2097e-02_r8,4.4354e-02_r8,4.4855e-02_r8, & + &4.3236e-02_r8,3.8850e-02_r8,3.1969e-02_r8/) + kao(:, 3, 7, 9) = (/ & + &2.5467e-02_r8,3.2639e-02_r8,3.8612e-02_r8,4.2519e-02_r8,4.4609e-02_r8,4.4967e-02_r8, & + &4.3302e-02_r8,3.8885e-02_r8,3.2129e-02_r8/) + kao(:, 4, 7, 9) = (/ & + &2.6267e-02_r8,3.3238e-02_r8,3.9137e-02_r8,4.2894e-02_r8,4.4845e-02_r8,4.5082e-02_r8, & + &4.3395e-02_r8,3.8965e-02_r8,3.2326e-02_r8/) + kao(:, 5, 7, 9) = (/ & + &2.6995e-02_r8,3.3786e-02_r8,3.9598e-02_r8,4.3239e-02_r8,4.5071e-02_r8,4.5249e-02_r8, & + &4.3527e-02_r8,3.9067e-02_r8,3.2557e-02_r8/) + kao(:, 1, 8, 9) = (/ & + &4.7920e-02_r8,5.2366e-02_r8,5.6749e-02_r8,5.9168e-02_r8,5.9712e-02_r8,5.8092e-02_r8, & + &5.3946e-02_r8,4.5783e-02_r8,2.8113e-02_r8/) + kao(:, 2, 8, 9) = (/ & + &4.9884e-02_r8,5.3965e-02_r8,5.8166e-02_r8,6.0347e-02_r8,6.0665e-02_r8,5.8786e-02_r8, & + &5.4351e-02_r8,4.5985e-02_r8,2.8254e-02_r8/) + kao(:, 3, 8, 9) = (/ & + &5.1719e-02_r8,5.5478e-02_r8,5.9448e-02_r8,6.1483e-02_r8,6.1565e-02_r8,5.9384e-02_r8, & + &5.4686e-02_r8,4.6159e-02_r8,2.8435e-02_r8/) + kao(:, 4, 8, 9) = (/ & + &5.3394e-02_r8,5.6807e-02_r8,6.0645e-02_r8,6.2509e-02_r8,6.2363e-02_r8,5.9916e-02_r8, & + &5.4999e-02_r8,4.6361e-02_r8,2.8611e-02_r8/) + kao(:, 5, 8, 9) = (/ & + &5.4964e-02_r8,5.7985e-02_r8,6.1688e-02_r8,6.3442e-02_r8,6.3043e-02_r8,6.0445e-02_r8, & + &5.5342e-02_r8,4.6592e-02_r8,2.8833e-02_r8/) + kao(:, 1, 9, 9) = (/ & + &1.8387e-01_r8,1.6808e-01_r8,1.5799e-01_r8,1.4671e-01_r8,1.3366e-01_r8,1.1828e-01_r8, & + &9.9590e-02_r8,7.4670e-02_r8,2.3960e-02_r8/) + kao(:, 2, 9, 9) = (/ & + &1.9171e-01_r8,1.7460e-01_r8,1.6351e-01_r8,1.5144e-01_r8,1.3758e-01_r8,1.2130e-01_r8, & + &1.0166e-01_r8,7.5740e-02_r8,2.4137e-02_r8/) + kao(:, 3, 9, 9) = (/ & + &1.9894e-01_r8,1.8065e-01_r8,1.6862e-01_r8,1.5587e-01_r8,1.4113e-01_r8,1.2411e-01_r8, & + &1.0364e-01_r8,7.6719e-02_r8,2.4294e-02_r8/) + kao(:, 4, 9, 9) = (/ & + &2.0563e-01_r8,1.8623e-01_r8,1.7319e-01_r8,1.5976e-01_r8,1.4435e-01_r8,1.2672e-01_r8, & + &1.0542e-01_r8,7.7598e-02_r8,2.4446e-02_r8/) + kao(:, 5, 9, 9) = (/ & + &2.1200e-01_r8,1.9152e-01_r8,1.7746e-01_r8,1.6330e-01_r8,1.4720e-01_r8,1.2898e-01_r8, & + &1.0699e-01_r8,7.8411e-02_r8,2.4664e-02_r8/) + kao(:, 1,10, 9) = (/ & + &7.9805e-01_r8,7.0103e-01_r8,6.0984e-01_r8,5.2274e-01_r8,4.3812e-01_r8,3.5220e-01_r8, & + &2.6270e-01_r8,1.6632e-01_r8,1.8620e-02_r8/) + kao(:, 2,10, 9) = (/ & + &8.3214e-01_r8,7.3068e-01_r8,6.3476e-01_r8,5.4295e-01_r8,4.5426e-01_r8,3.6461e-01_r8, & + &2.7128e-01_r8,1.7099e-01_r8,1.8699e-02_r8/) + kao(:, 3,10, 9) = (/ & + &8.6405e-01_r8,7.5844e-01_r8,6.5814e-01_r8,5.6198e-01_r8,4.6922e-01_r8,3.7620e-01_r8, & + &2.7918e-01_r8,1.7530e-01_r8,1.8761e-02_r8/) + kao(:, 4,10, 9) = (/ & + &8.9399e-01_r8,7.8448e-01_r8,6.8005e-01_r8,5.7978e-01_r8,4.8302e-01_r8,3.8668e-01_r8, & + &2.8631e-01_r8,1.7930e-01_r8,1.8825e-02_r8/) + kao(:, 5,10, 9) = (/ & + &9.2229e-01_r8,8.0909e-01_r8,7.0076e-01_r8,5.9657e-01_r8,4.9598e-01_r8,3.9642e-01_r8, & + &2.9286e-01_r8,1.8285e-01_r8,1.8959e-02_r8/) + kao(:, 1,11, 9) = (/ & + &1.2376e+00_r8,1.0851e+00_r8,9.3781e-01_r8,7.9479e-01_r8,6.5536e-01_r8,5.1636e-01_r8, & + &3.7350e-01_r8,2.2328e-01_r8,1.9046e-02_r8/) + kao(:, 2,11, 9) = (/ & + &1.2888e+00_r8,1.1296e+00_r8,9.7557e-01_r8,8.2566e-01_r8,6.7951e-01_r8,5.3467e-01_r8, & + &3.8601e-01_r8,2.3011e-01_r8,1.9117e-02_r8/) + kao(:, 3,11, 9) = (/ & + &1.3372e+00_r8,1.1719e+00_r8,1.0114e+00_r8,8.5500e-01_r8,7.0234e-01_r8,5.5187e-01_r8, & + &3.9765e-01_r8,2.3639e-01_r8,1.9165e-02_r8/) + kao(:, 4,11, 9) = (/ & + &1.3819e+00_r8,1.2109e+00_r8,1.0444e+00_r8,8.8194e-01_r8,7.2332e-01_r8,5.6752e-01_r8, & + &4.0827e-01_r8,2.4219e-01_r8,1.9058e-02_r8/) + kao(:, 5,11, 9) = (/ & + &1.4259e+00_r8,1.2494e+00_r8,1.0769e+00_r8,9.0854e-01_r8,7.4408e-01_r8,5.8286e-01_r8, & + &4.1859e-01_r8,2.4748e-01_r8,1.9067e-02_r8/) + kao(:, 1,12, 9) = (/ & + &1.4243e+00_r8,1.2488e+00_r8,1.0789e+00_r8,9.1317e-01_r8,7.5092e-01_r8,5.8812e-01_r8, & + &4.2112e-01_r8,2.4611e-01_r8,1.9872e-02_r8/) + kao(:, 2,12, 9) = (/ & + &1.4836e+00_r8,1.3004e+00_r8,1.1224e+00_r8,9.4876e-01_r8,7.7876e-01_r8,6.0917e-01_r8, & + &4.3528e-01_r8,2.5376e-01_r8,2.0064e-02_r8/) + kao(:, 3,12, 9) = (/ & + &1.5386e+00_r8,1.3484e+00_r8,1.1631e+00_r8,9.8199e-01_r8,8.0461e-01_r8,6.2868e-01_r8, & + &4.4843e-01_r8,2.6085e-01_r8,2.0179e-02_r8/) + kao(:, 4,12, 9) = (/ & + &1.5909e+00_r8,1.3940e+00_r8,1.2017e+00_r8,1.0136e+00_r8,8.2931e-01_r8,6.4713e-01_r8, & + &4.6088e-01_r8,2.6745e-01_r8,2.0157e-02_r8/) + kao(:, 5,12, 9) = (/ & + &1.6423e+00_r8,1.4388e+00_r8,1.2396e+00_r8,1.0446e+00_r8,8.5343e-01_r8,6.6506e-01_r8, & + &4.7297e-01_r8,2.7367e-01_r8,2.0135e-02_r8/) + kao(:, 1,13, 9) = (/ & + &1.3090e+00_r8,1.1487e+00_r8,9.9498e-01_r8,8.4529e-01_r8,6.9751e-01_r8,5.4690e-01_r8, & + &3.9201e-01_r8,2.2831e-01_r8,1.9648e-02_r8/) + kao(:, 2,13, 9) = (/ & + &1.3642e+00_r8,1.1967e+00_r8,1.0354e+00_r8,8.7822e-01_r8,7.2355e-01_r8,5.6643e-01_r8, & + &4.0528e-01_r8,2.3543e-01_r8,1.9783e-02_r8/) + kao(:, 3,13, 9) = (/ & + &1.4156e+00_r8,1.2415e+00_r8,1.0731e+00_r8,9.0892e-01_r8,7.4783e-01_r8,5.8491e-01_r8, & + &4.1788e-01_r8,2.4217e-01_r8,1.9878e-02_r8/) + kao(:, 4,13, 9) = (/ & + &1.4652e+00_r8,1.2846e+00_r8,1.1094e+00_r8,9.3863e-01_r8,7.7135e-01_r8,6.0268e-01_r8, & + &4.2988e-01_r8,2.4851e-01_r8,1.9864e-02_r8/) + kao(:, 5,13, 9) = (/ & + &1.5126e+00_r8,1.3260e+00_r8,1.1446e+00_r8,9.6741e-01_r8,7.9378e-01_r8,6.1968e-01_r8, & + &4.4123e-01_r8,2.5440e-01_r8,1.9877e-02_r8/) + kao(:, 1, 1,10) = (/ & + &3.3844e-03_r8,1.5864e-02_r8,3.0967e-02_r8,4.5960e-02_r8,6.0759e-02_r8,7.5076e-02_r8, & + &8.8299e-02_r8,9.7840e-02_r8,1.2109e-01_r8/) + kao(:, 2, 1,10) = (/ & + &3.3774e-03_r8,1.5840e-02_r8,3.0916e-02_r8,4.5912e-02_r8,6.0698e-02_r8,7.5010e-02_r8, & + &8.8211e-02_r8,9.7731e-02_r8,1.2099e-01_r8/) + kao(:, 3, 1,10) = (/ & + &3.3575e-03_r8,1.5844e-02_r8,3.0912e-02_r8,4.5937e-02_r8,6.0728e-02_r8,7.5022e-02_r8, & + &8.8124e-02_r8,9.7474e-02_r8,1.2106e-01_r8/) + kao(:, 4, 1,10) = (/ & + &3.3333e-03_r8,1.5824e-02_r8,3.0829e-02_r8,4.5838e-02_r8,6.0646e-02_r8,7.4990e-02_r8, & + &8.8084e-02_r8,9.7173e-02_r8,1.2089e-01_r8/) + kao(:, 5, 1,10) = (/ & + &3.3084e-03_r8,1.5776e-02_r8,3.0693e-02_r8,4.5649e-02_r8,6.0428e-02_r8,7.4773e-02_r8, & + &8.7909e-02_r8,9.6839e-02_r8,1.2042e-01_r8/) + kao(:, 1, 2,10) = (/ & + &5.1392e-03_r8,1.7464e-02_r8,3.2432e-02_r8,4.7915e-02_r8,6.3487e-02_r8,7.8847e-02_r8, & + &9.3621e-02_r8,1.0600e-01_r8,1.2635e-01_r8/) + kao(:, 2, 2,10) = (/ & + &5.1325e-03_r8,1.7471e-02_r8,3.2464e-02_r8,4.7934e-02_r8,6.3521e-02_r8,7.8889e-02_r8, & + &9.3606e-02_r8,1.0592e-01_r8,1.2642e-01_r8/) + kao(:, 3, 2,10) = (/ & + &5.1157e-03_r8,1.7466e-02_r8,3.2343e-02_r8,4.7787e-02_r8,6.3340e-02_r8,7.8722e-02_r8, & + &9.3575e-02_r8,1.0588e-01_r8,1.2605e-01_r8/) + kao(:, 4, 2,10) = (/ & + &5.0987e-03_r8,1.7399e-02_r8,3.2075e-02_r8,4.7428e-02_r8,6.2893e-02_r8,7.8221e-02_r8, & + &9.3145e-02_r8,1.0589e-01_r8,1.2513e-01_r8/) + kao(:, 5, 2,10) = (/ & + &5.0781e-03_r8,1.7287e-02_r8,3.1803e-02_r8,4.7068e-02_r8,6.2420e-02_r8,7.7655e-02_r8, & + &9.2528e-02_r8,1.0558e-01_r8,1.2418e-01_r8/) + kao(:, 1, 3,10) = (/ & + &1.0449e-02_r8,2.2920e-02_r8,3.5229e-02_r8,4.9841e-02_r8,6.5300e-02_r8,8.0993e-02_r8, & + &9.6715e-02_r8,1.1178e-01_r8,1.2900e-01_r8/) + kao(:, 2, 3,10) = (/ & + &1.0475e-02_r8,2.2840e-02_r8,3.5278e-02_r8,4.9881e-02_r8,6.5245e-02_r8,8.1037e-02_r8, & + &9.6863e-02_r8,1.1212e-01_r8,1.2899e-01_r8/) + kao(:, 3, 3,10) = (/ & + &1.0487e-02_r8,2.2756e-02_r8,3.5213e-02_r8,4.9645e-02_r8,6.4866e-02_r8,8.0649e-02_r8, & + &9.6451e-02_r8,1.1190e-01_r8,1.2830e-01_r8/) + kao(:, 4, 3,10) = (/ & + &1.0493e-02_r8,2.2711e-02_r8,3.4996e-02_r8,4.9204e-02_r8,6.4312e-02_r8,7.9994e-02_r8, & + &9.5693e-02_r8,1.1109e-01_r8,1.2723e-01_r8/) + kao(:, 5, 3,10) = (/ & + &1.0487e-02_r8,2.2599e-02_r8,3.4737e-02_r8,4.8786e-02_r8,6.3856e-02_r8,7.9443e-02_r8, & + &9.5024e-02_r8,1.1021e-01_r8,1.2638e-01_r8/) + kao(:, 1, 4,10) = (/ & + &2.1474e-02_r8,3.4011e-02_r8,4.5615e-02_r8,5.6742e-02_r8,6.8329e-02_r8,8.2791e-02_r8, & + &9.7759e-02_r8,1.1367e-01_r8,1.2934e-01_r8/) + kao(:, 2, 4,10) = (/ & + &2.1593e-02_r8,3.3751e-02_r8,4.5521e-02_r8,5.6645e-02_r8,6.8211e-02_r8,8.2434e-02_r8, & + &9.7517e-02_r8,1.1348e-01_r8,1.2896e-01_r8/) + kao(:, 3, 4,10) = (/ & + &2.1694e-02_r8,3.3429e-02_r8,4.5406e-02_r8,5.6399e-02_r8,6.7862e-02_r8,8.1741e-02_r8, & + &9.6866e-02_r8,1.1284e-01_r8,1.2803e-01_r8/) + kao(:, 4, 4,10) = (/ & + &2.1761e-02_r8,3.3088e-02_r8,4.5200e-02_r8,5.5990e-02_r8,6.7313e-02_r8,8.0951e-02_r8, & + &9.6103e-02_r8,1.1192e-01_r8,1.2712e-01_r8/) + kao(:, 5, 4,10) = (/ & + &2.1871e-02_r8,3.2779e-02_r8,4.4802e-02_r8,5.5607e-02_r8,6.6864e-02_r8,8.0377e-02_r8, & + &9.5554e-02_r8,1.1124e-01_r8,1.2647e-01_r8/) + kao(:, 1, 5,10) = (/ & + &3.9770e-02_r8,5.1894e-02_r8,6.3327e-02_r8,7.2180e-02_r8,8.0917e-02_r8,8.8056e-02_r8, & + &9.8598e-02_r8,1.1206e-01_r8,1.2671e-01_r8/) + kao(:, 2, 5,10) = (/ & + &4.0140e-02_r8,5.1409e-02_r8,6.3212e-02_r8,7.2060e-02_r8,8.0506e-02_r8,8.7647e-02_r8, & + &9.8026e-02_r8,1.1163e-01_r8,1.2617e-01_r8/) + kao(:, 3, 5,10) = (/ & + &4.0492e-02_r8,5.0925e-02_r8,6.2882e-02_r8,7.1952e-02_r8,8.0008e-02_r8,8.6965e-02_r8, & + &9.7225e-02_r8,1.1094e-01_r8,1.2542e-01_r8/) + kao(:, 4, 5,10) = (/ & + &4.0826e-02_r8,5.0532e-02_r8,6.2408e-02_r8,7.1612e-02_r8,7.9337e-02_r8,8.6238e-02_r8, & + &9.6327e-02_r8,1.1019e-01_r8,1.2470e-01_r8/) + kao(:, 5, 5,10) = (/ & + &4.1162e-02_r8,5.0261e-02_r8,6.1890e-02_r8,7.0980e-02_r8,7.8777e-02_r8,8.5713e-02_r8, & + &9.5778e-02_r8,1.0986e-01_r8,1.2449e-01_r8/) + kao(:, 1, 6,10) = (/ & + &6.7916e-02_r8,7.7649e-02_r8,8.9172e-02_r8,9.6900e-02_r8,1.0149e-01_r8,1.0503e-01_r8, & + &1.0523e-01_r8,1.0994e-01_r8,1.2156e-01_r8/) + kao(:, 2, 6,10) = (/ & + &6.8757e-02_r8,7.7814e-02_r8,8.8891e-02_r8,9.7030e-02_r8,1.0144e-01_r8,1.0468e-01_r8, & + &1.0479e-01_r8,1.0906e-01_r8,1.2102e-01_r8/) + kao(:, 3, 6,10) = (/ & + &6.9572e-02_r8,7.7629e-02_r8,8.8407e-02_r8,9.6716e-02_r8,1.0124e-01_r8,1.0403e-01_r8, & + &1.0408e-01_r8,1.0810e-01_r8,1.2040e-01_r8/) + kao(:, 4, 6,10) = (/ & + &7.0420e-02_r8,7.7345e-02_r8,8.8011e-02_r8,9.6134e-02_r8,1.0079e-01_r8,1.0305e-01_r8, & + &1.0321e-01_r8,1.0749e-01_r8,1.2017e-01_r8/) + kao(:, 5, 6,10) = (/ & + &7.1176e-02_r8,7.7213e-02_r8,8.7761e-02_r8,9.5353e-02_r8,9.9879e-02_r8,1.0215e-01_r8, & + &1.0265e-01_r8,1.0733e-01_r8,1.2038e-01_r8/) + kao(:, 1, 7,10) = (/ & + &1.2127e-01_r8,1.2412e-01_r8,1.3217e-01_r8,1.3765e-01_r8,1.3951e-01_r8,1.3625e-01_r8, & + &1.2814e-01_r8,1.1487e-01_r8,1.1426e-01_r8/) + kao(:, 2, 7,10) = (/ & + &1.2309e-01_r8,1.2453e-01_r8,1.3252e-01_r8,1.3798e-01_r8,1.3976e-01_r8,1.3644e-01_r8, & + &1.2796e-01_r8,1.1426e-01_r8,1.1391e-01_r8/) + kao(:, 3, 7,10) = (/ & + &1.2489e-01_r8,1.2494e-01_r8,1.3228e-01_r8,1.3764e-01_r8,1.3951e-01_r8,1.3625e-01_r8, & + &1.2756e-01_r8,1.1350e-01_r8,1.1349e-01_r8/) + kao(:, 4, 7,10) = (/ & + &1.2680e-01_r8,1.2557e-01_r8,1.3198e-01_r8,1.3739e-01_r8,1.3886e-01_r8,1.3552e-01_r8, & + &1.2649e-01_r8,1.1282e-01_r8,1.1362e-01_r8/) + kao(:, 5, 7,10) = (/ & + &1.2852e-01_r8,1.2615e-01_r8,1.3199e-01_r8,1.3726e-01_r8,1.3802e-01_r8,1.3430e-01_r8, & + &1.2550e-01_r8,1.1257e-01_r8,1.1419e-01_r8/) + kao(:, 1, 8,10) = (/ & + &2.5214e-01_r8,2.3134e-01_r8,2.3152e-01_r8,2.2506e-01_r8,2.1543e-01_r8,2.0242e-01_r8, & + &1.8079e-01_r8,1.4566e-01_r8,1.0565e-01_r8/) + kao(:, 2, 8,10) = (/ & + &2.5695e-01_r8,2.3363e-01_r8,2.3275e-01_r8,2.2604e-01_r8,2.1637e-01_r8,2.0282e-01_r8, & + &1.8105e-01_r8,1.4554e-01_r8,1.0546e-01_r8/) + kao(:, 3, 8,10) = (/ & + &2.6176e-01_r8,2.3588e-01_r8,2.3395e-01_r8,2.2621e-01_r8,2.1636e-01_r8,2.0257e-01_r8, & + &1.8076e-01_r8,1.4513e-01_r8,1.0533e-01_r8/) + kao(:, 4, 8,10) = (/ & + &2.6651e-01_r8,2.3871e-01_r8,2.3539e-01_r8,2.2647e-01_r8,2.1633e-01_r8,2.0229e-01_r8, & + &1.8002e-01_r8,1.4419e-01_r8,1.0597e-01_r8/) + kao(:, 5, 8,10) = (/ & + &2.7042e-01_r8,2.4131e-01_r8,2.3677e-01_r8,2.2700e-01_r8,2.1683e-01_r8,2.0167e-01_r8, & + &1.7891e-01_r8,1.4342e-01_r8,1.0666e-01_r8/) + kao(:, 1, 9,10) = (/ & + &9.7736e-01_r8,8.5726e-01_r8,7.4530e-01_r8,6.6330e-01_r8,5.7895e-01_r8,4.8711e-01_r8, & + &3.8944e-01_r8,2.7986e-01_r8,9.6120e-02_r8/) + kao(:, 2, 9,10) = (/ & + &1.0005e+00_r8,8.7740e-01_r8,7.5935e-01_r8,6.7173e-01_r8,5.8495e-01_r8,4.9078e-01_r8, & + &3.9206e-01_r8,2.8024e-01_r8,9.6028e-02_r8/) + kao(:, 3, 9,10) = (/ & + &1.0238e+00_r8,8.9765e-01_r8,7.7412e-01_r8,6.7963e-01_r8,5.9056e-01_r8,4.9392e-01_r8, & + &3.9381e-01_r8,2.7971e-01_r8,9.6387e-02_r8/) + kao(:, 4, 9,10) = (/ & + &1.0459e+00_r8,9.1704e-01_r8,7.8954e-01_r8,6.8917e-01_r8,5.9755e-01_r8,4.9657e-01_r8, & + &3.9497e-01_r8,2.7927e-01_r8,9.7373e-02_r8/) + kao(:, 5, 9,10) = (/ & + &1.0630e+00_r8,9.3201e-01_r8,8.0170e-01_r8,6.9634e-01_r8,6.0306e-01_r8,4.9955e-01_r8, & + &3.9651e-01_r8,2.7910e-01_r8,9.7962e-02_r8/) + kao(:, 1,10,10) = (/ & + &4.2057e+00_r8,3.6817e+00_r8,3.1579e+00_r8,2.6346e+00_r8,2.1198e+00_r8,1.6450e+00_r8, & + &1.1902e+00_r8,7.0817e-01_r8,7.8303e-02_r8/) + kao(:, 2,10,10) = (/ & + &4.3277e+00_r8,3.7881e+00_r8,3.2491e+00_r8,2.7104e+00_r8,2.1754e+00_r8,1.6774e+00_r8, & + &1.2094e+00_r8,7.1654e-01_r8,7.8798e-02_r8/) + kao(:, 3,10,10) = (/ & + &4.4500e+00_r8,3.8956e+00_r8,3.3411e+00_r8,2.7869e+00_r8,2.2338e+00_r8,1.7120e+00_r8, & + &1.2289e+00_r8,7.2324e-01_r8,7.8857e-02_r8/) + kao(:, 4,10,10) = (/ & + &4.5562e+00_r8,3.9883e+00_r8,3.4205e+00_r8,2.8532e+00_r8,2.2862e+00_r8,1.7446e+00_r8, & + &1.2492e+00_r8,7.3045e-01_r8,7.9497e-02_r8/) + kao(:, 5,10,10) = (/ & + &4.6429e+00_r8,4.0644e+00_r8,3.4858e+00_r8,2.9077e+00_r8,2.3298e+00_r8,1.7714e+00_r8, & + &1.2652e+00_r8,7.3636e-01_r8,7.8315e-02_r8/) + kao(:, 1,11,10) = (/ & + &6.3643e+00_r8,5.5702e+00_r8,4.7761e+00_r8,3.9823e+00_r8,3.1901e+00_r8,2.4267e+00_r8, & + &1.7139e+00_r8,9.8175e-01_r8,5.2396e-02_r8/) + kao(:, 2,11,10) = (/ & + &6.5707e+00_r8,5.7511e+00_r8,4.9312e+00_r8,4.1117e+00_r8,3.2928e+00_r8,2.4948e+00_r8, & + &1.7532e+00_r8,9.9614e-01_r8,5.2761e-02_r8/) + kao(:, 3,11,10) = (/ & + &6.7598e+00_r8,5.9160e+00_r8,5.0729e+00_r8,4.2301e+00_r8,3.3876e+00_r8,2.5590e+00_r8, & + &1.7914e+00_r8,1.0123e+00_r8,5.3574e-02_r8/) + kao(:, 4,11,10) = (/ & + &6.9211e+00_r8,6.0577e+00_r8,5.1942e+00_r8,4.3313e+00_r8,3.4687e+00_r8,2.6150e+00_r8, & + &1.8227e+00_r8,1.0262e+00_r8,5.6608e-02_r8/) + kao(:, 5,11,10) = (/ & + &7.0466e+00_r8,6.1673e+00_r8,5.2885e+00_r8,4.4096e+00_r8,3.5315e+00_r8,2.6584e+00_r8, & + &1.8463e+00_r8,1.0382e+00_r8,5.6583e-02_r8/) + kao(:, 1,12,10) = (/ & + &7.1591e+00_r8,6.2650e+00_r8,5.3715e+00_r8,4.4783e+00_r8,3.5872e+00_r8,2.7305e+00_r8, & + &1.9173e+00_r8,1.0829e+00_r8,5.4364e-02_r8/) + kao(:, 2,12,10) = (/ & + &7.3899e+00_r8,6.4678e+00_r8,5.5455e+00_r8,4.6234e+00_r8,3.7023e+00_r8,2.8086e+00_r8, & + &1.9670e+00_r8,1.1039e+00_r8,5.3004e-02_r8/) + kao(:, 3,12,10) = (/ & + &7.5932e+00_r8,6.6457e+00_r8,5.6978e+00_r8,4.7509e+00_r8,3.8044e+00_r8,2.8774e+00_r8, & + &2.0093e+00_r8,1.1228e+00_r8,5.1959e-02_r8/) + kao(:, 4,12,10) = (/ & + &7.7612e+00_r8,6.7925e+00_r8,5.8241e+00_r8,4.8562e+00_r8,3.8890e+00_r8,2.9344e+00_r8, & + &2.0429e+00_r8,1.1393e+00_r8,5.3174e-02_r8/) + kao(:, 5,12,10) = (/ & + &7.8969e+00_r8,6.9118e+00_r8,5.9263e+00_r8,4.9415e+00_r8,3.9571e+00_r8,2.9804e+00_r8, & + &2.0685e+00_r8,1.1516e+00_r8,5.1704e-02_r8/) + kao(:, 1,13,10) = (/ & + &6.4705e+00_r8,5.6627e+00_r8,4.8551e+00_r8,4.0480e+00_r8,3.2529e+00_r8,2.5042e+00_r8, & + &1.7607e+00_r8,9.9775e-01_r8,5.2819e-02_r8/) + kao(:, 2,13,10) = (/ & + &6.6649e+00_r8,5.8328e+00_r8,5.0012e+00_r8,4.1701e+00_r8,3.3469e+00_r8,2.5698e+00_r8, & + &1.8026e+00_r8,1.0186e+00_r8,5.2318e-02_r8/) + kao(:, 3,13,10) = (/ & + &6.8320e+00_r8,5.9796e+00_r8,5.1272e+00_r8,4.2755e+00_r8,3.4276e+00_r8,2.6233e+00_r8, & + &1.8383e+00_r8,1.0369e+00_r8,5.1248e-02_r8/) + kao(:, 4,13,10) = (/ & + &6.9674e+00_r8,6.0982e+00_r8,5.2289e+00_r8,4.3604e+00_r8,3.4933e+00_r8,2.6647e+00_r8, & + &1.8662e+00_r8,1.0505e+00_r8,5.2356e-02_r8/) + kao(:, 5,13,10) = (/ & + &7.0874e+00_r8,6.2027e+00_r8,5.3188e+00_r8,4.4355e+00_r8,3.5528e+00_r8,2.7014e+00_r8, & + &1.8899e+00_r8,1.0614e+00_r8,5.1111e-02_r8/) + kao(:, 1, 1,11) = (/ & + &4.6742e-03_r8,2.0279e-02_r8,3.9426e-02_r8,5.8543e-02_r8,7.7272e-02_r8,9.5241e-02_r8, & + &1.1148e-01_r8,1.2235e-01_r8,1.5408e-01_r8/) + kao(:, 2, 1,11) = (/ & + &4.6073e-03_r8,2.0296e-02_r8,3.9412e-02_r8,5.8523e-02_r8,7.7232e-02_r8,9.5132e-02_r8, & + &1.1121e-01_r8,1.2184e-01_r8,1.5399e-01_r8/) + kao(:, 3, 1,11) = (/ & + &4.5565e-03_r8,2.0227e-02_r8,3.9298e-02_r8,5.8356e-02_r8,7.7038e-02_r8,9.4961e-02_r8, & + &1.1109e-01_r8,1.2151e-01_r8,1.5359e-01_r8/) + kao(:, 4, 1,11) = (/ & + &4.5047e-03_r8,2.0130e-02_r8,3.9180e-02_r8,5.8173e-02_r8,7.6772e-02_r8,9.4618e-02_r8, & + &1.1074e-01_r8,1.2134e-01_r8,1.5306e-01_r8/) + kao(:, 5, 1,11) = (/ & + &4.4540e-03_r8,2.0027e-02_r8,3.9084e-02_r8,5.8025e-02_r8,7.6535e-02_r8,9.4251e-02_r8, & + &1.1025e-01_r8,1.2116e-01_r8,1.5260e-01_r8/) + kao(:, 1, 2,11) = (/ & + &7.4064e-03_r8,2.2194e-02_r8,4.1767e-02_r8,6.1911e-02_r8,8.1938e-02_r8,1.0155e-01_r8, & + &1.2014e-01_r8,1.3485e-01_r8,1.6319e-01_r8/) + kao(:, 2, 2,11) = (/ & + &7.3108e-03_r8,2.2143e-02_r8,4.1684e-02_r8,6.1877e-02_r8,8.1902e-02_r8,1.0152e-01_r8, & + &1.2013e-01_r8,1.3472e-01_r8,1.6312e-01_r8/) + kao(:, 3, 2,11) = (/ & + &7.2232e-03_r8,2.2079e-02_r8,4.1677e-02_r8,6.1891e-02_r8,8.1918e-02_r8,1.0151e-01_r8, & + &1.1999e-01_r8,1.3454e-01_r8,1.6316e-01_r8/) + kao(:, 4, 2,11) = (/ & + &7.1304e-03_r8,2.2033e-02_r8,4.1736e-02_r8,6.1998e-02_r8,8.2035e-02_r8,1.0158e-01_r8, & + &1.1988e-01_r8,1.3411e-01_r8,1.6341e-01_r8/) + kao(:, 5, 2,11) = (/ & + &7.0357e-03_r8,2.1988e-02_r8,4.1742e-02_r8,6.2041e-02_r8,8.2077e-02_r8,1.0158e-01_r8, & + &1.1983e-01_r8,1.3366e-01_r8,1.6350e-01_r8/) + kao(:, 1, 3,11) = (/ & + &1.5774e-02_r8,2.9169e-02_r8,4.5962e-02_r8,6.5827e-02_r8,8.6496e-02_r8,1.0742e-01_r8, & + &1.2791e-01_r8,1.4653e-01_r8,1.7156e-01_r8/) + kao(:, 2, 3,11) = (/ & + &1.5614e-02_r8,2.8989e-02_r8,4.5846e-02_r8,6.5612e-02_r8,8.6438e-02_r8,1.0734e-01_r8, & + &1.2776e-01_r8,1.4623e-01_r8,1.7149e-01_r8/) + kao(:, 3, 3,11) = (/ & + &1.5422e-02_r8,2.8825e-02_r8,4.5777e-02_r8,6.5531e-02_r8,8.6532e-02_r8,1.0747e-01_r8, & + &1.2790e-01_r8,1.4632e-01_r8,1.7170e-01_r8/) + kao(:, 4, 3,11) = (/ & + &1.5220e-02_r8,2.8664e-02_r8,4.5718e-02_r8,6.5531e-02_r8,8.6682e-02_r8,1.0768e-01_r8, & + &1.2815e-01_r8,1.4661e-01_r8,1.7201e-01_r8/) + kao(:, 5, 3,11) = (/ & + &1.5041e-02_r8,2.8491e-02_r8,4.5554e-02_r8,6.5387e-02_r8,8.6561e-02_r8,1.0758e-01_r8, & + &1.2814e-01_r8,1.4679e-01_r8,1.7174e-01_r8/) + kao(:, 1, 4,11) = (/ & + &3.3773e-02_r8,4.4438e-02_r8,5.9281e-02_r8,7.3962e-02_r8,9.2405e-02_r8,1.1202e-01_r8, & + &1.3347e-01_r8,1.5431e-01_r8,1.7769e-01_r8/) + kao(:, 2, 4,11) = (/ & + &3.3523e-02_r8,4.4307e-02_r8,5.8961e-02_r8,7.3730e-02_r8,9.2117e-02_r8,1.1213e-01_r8, & + &1.3369e-01_r8,1.5450e-01_r8,1.7797e-01_r8/) + kao(:, 3, 4,11) = (/ & + &3.3236e-02_r8,4.4011e-02_r8,5.8687e-02_r8,7.3516e-02_r8,9.1754e-02_r8,1.1213e-01_r8, & + &1.3376e-01_r8,1.5472e-01_r8,1.7805e-01_r8/) + kao(:, 4, 4,11) = (/ & + &3.2927e-02_r8,4.3662e-02_r8,5.8418e-02_r8,7.3212e-02_r8,9.1231e-02_r8,1.1190e-01_r8, & + &1.3353e-01_r8,1.5459e-01_r8,1.7761e-01_r8/) + kao(:, 5, 4,11) = (/ & + &3.2628e-02_r8,4.3294e-02_r8,5.8201e-02_r8,7.2680e-02_r8,9.0434e-02_r8,1.1128e-01_r8, & + &1.3281e-01_r8,1.5389e-01_r8,1.7655e-01_r8/) + kao(:, 1, 5,11) = (/ & + &6.5323e-02_r8,7.2628e-02_r8,8.3508e-02_r8,9.5963e-02_r8,1.0655e-01_r8,1.2020e-01_r8, & + &1.3782e-01_r8,1.5923e-01_r8,1.8200e-01_r8/) + kao(:, 2, 5,11) = (/ & + &6.5064e-02_r8,7.2406e-02_r8,8.3203e-02_r8,9.5444e-02_r8,1.0632e-01_r8,1.1979e-01_r8, & + &1.3760e-01_r8,1.5925e-01_r8,1.8207e-01_r8/) + kao(:, 3, 5,11) = (/ & + &6.4756e-02_r8,7.1969e-02_r8,8.2862e-02_r8,9.4908e-02_r8,1.0590e-01_r8,1.1930e-01_r8, & + &1.3724e-01_r8,1.5904e-01_r8,1.8162e-01_r8/) + kao(:, 4, 5,11) = (/ & + &6.4304e-02_r8,7.1135e-02_r8,8.2400e-02_r8,9.4416e-02_r8,1.0531e-01_r8,1.1853e-01_r8, & + &1.3656e-01_r8,1.5838e-01_r8,1.8061e-01_r8/) + kao(:, 5, 5,11) = (/ & + &6.3847e-02_r8,7.0072e-02_r8,8.1806e-02_r8,9.3969e-02_r8,1.0427e-01_r8,1.1735e-01_r8, & + &1.3557e-01_r8,1.5724e-01_r8,1.7920e-01_r8/) + kao(:, 1, 6,11) = (/ & + &1.1614e-01_r8,1.1612e-01_r8,1.2461e-01_r8,1.3093e-01_r8,1.3774e-01_r8,1.4186e-01_r8, & + &1.4765e-01_r8,1.6150e-01_r8,1.8364e-01_r8/) + kao(:, 2, 6,11) = (/ & + &1.1619e-01_r8,1.1550e-01_r8,1.2387e-01_r8,1.3036e-01_r8,1.3714e-01_r8,1.4135e-01_r8, & + &1.4700e-01_r8,1.6131e-01_r8,1.8335e-01_r8/) + kao(:, 3, 6,11) = (/ & + &1.1615e-01_r8,1.1477e-01_r8,1.2280e-01_r8,1.2991e-01_r8,1.3667e-01_r8,1.4072e-01_r8, & + &1.4596e-01_r8,1.6062e-01_r8,1.8242e-01_r8/) + kao(:, 4, 6,11) = (/ & + &1.1574e-01_r8,1.1387e-01_r8,1.2156e-01_r8,1.2938e-01_r8,1.3597e-01_r8,1.3977e-01_r8, & + &1.4470e-01_r8,1.5943e-01_r8,1.8095e-01_r8/) + kao(:, 5, 6,11) = (/ & + &1.1520e-01_r8,1.1286e-01_r8,1.2034e-01_r8,1.2877e-01_r8,1.3515e-01_r8,1.3854e-01_r8, & + &1.4325e-01_r8,1.5816e-01_r8,1.7948e-01_r8/) + kao(:, 1, 7,11) = (/ & + &2.1510e-01_r8,1.9619e-01_r8,2.0174e-01_r8,1.9935e-01_r8,1.9475e-01_r8,1.8847e-01_r8, & + &1.8001e-01_r8,1.6816e-01_r8,1.8086e-01_r8/) + kao(:, 2, 7,11) = (/ & + &2.1625e-01_r8,1.9617e-01_r8,2.0091e-01_r8,1.9825e-01_r8,1.9429e-01_r8,1.8801e-01_r8, & + &1.7902e-01_r8,1.6736e-01_r8,1.8038e-01_r8/) + kao(:, 3, 7,11) = (/ & + &2.1700e-01_r8,1.9569e-01_r8,1.9979e-01_r8,1.9686e-01_r8,1.9372e-01_r8,1.8767e-01_r8, & + &1.7767e-01_r8,1.6608e-01_r8,1.7932e-01_r8/) + kao(:, 4, 7,11) = (/ & + &2.1676e-01_r8,1.9471e-01_r8,1.9847e-01_r8,1.9536e-01_r8,1.9293e-01_r8,1.8720e-01_r8, & + &1.7635e-01_r8,1.6450e-01_r8,1.7799e-01_r8/) + kao(:, 5, 7,11) = (/ & + &2.1625e-01_r8,1.9358e-01_r8,1.9672e-01_r8,1.9373e-01_r8,1.9213e-01_r8,1.8631e-01_r8, & + &1.7483e-01_r8,1.6262e-01_r8,1.7662e-01_r8/) + kao(:, 1, 8,11) = (/ & + &4.6382e-01_r8,4.0807e-01_r8,3.7899e-01_r8,3.5840e-01_r8,3.2915e-01_r8,2.9613e-01_r8, & + &2.5854e-01_r8,2.1154e-01_r8,1.7388e-01_r8/) + kao(:, 2, 8,11) = (/ & + &4.6803e-01_r8,4.1204e-01_r8,3.7966e-01_r8,3.5758e-01_r8,3.2785e-01_r8,2.9605e-01_r8, & + &2.5875e-01_r8,2.1026e-01_r8,1.7332e-01_r8/) + kao(:, 3, 8,11) = (/ & + &4.7076e-01_r8,4.1406e-01_r8,3.7922e-01_r8,3.5601e-01_r8,3.2603e-01_r8,2.9561e-01_r8, & + &2.5861e-01_r8,2.0864e-01_r8,1.7242e-01_r8/) + kao(:, 4, 8,11) = (/ & + &4.7155e-01_r8,4.1450e-01_r8,3.7727e-01_r8,3.5413e-01_r8,3.2392e-01_r8,2.9447e-01_r8, & + &2.5827e-01_r8,2.0694e-01_r8,1.7120e-01_r8/) + kao(:, 5, 8,11) = (/ & + &4.7233e-01_r8,4.1516e-01_r8,3.7581e-01_r8,3.5208e-01_r8,3.2176e-01_r8,2.9332e-01_r8, & + &2.5728e-01_r8,2.0514e-01_r8,1.7042e-01_r8/) + kao(:, 1, 9,11) = (/ & + &1.8678e+00_r8,1.6362e+00_r8,1.4048e+00_r8,1.1793e+00_r8,9.9438e-01_r8,8.2136e-01_r8, & + &6.2834e-01_r8,4.2034e-01_r8,1.6334e-01_r8/) + kao(:, 2, 9,11) = (/ & + &1.8906e+00_r8,1.6563e+00_r8,1.4224e+00_r8,1.1919e+00_r8,9.9937e-01_r8,8.2259e-01_r8, & + &6.2713e-01_r8,4.2292e-01_r8,1.6311e-01_r8/) + kao(:, 3, 9,11) = (/ & + &1.9044e+00_r8,1.6682e+00_r8,1.4321e+00_r8,1.1983e+00_r8,1.0002e+00_r8,8.2124e-01_r8, & + &6.2419e-01_r8,4.2359e-01_r8,1.6249e-01_r8/) + kao(:, 4, 9,11) = (/ & + &1.9121e+00_r8,1.6748e+00_r8,1.4376e+00_r8,1.2016e+00_r8,9.9779e-01_r8,8.1901e-01_r8, & + &6.2159e-01_r8,4.2327e-01_r8,1.6166e-01_r8/) + kao(:, 5, 9,11) = (/ & + &1.9224e+00_r8,1.6839e+00_r8,1.4454e+00_r8,1.2078e+00_r8,9.9866e-01_r8,8.1827e-01_r8, & + &6.1893e-01_r8,4.2245e-01_r8,1.6163e-01_r8/) + kao(:, 1,10,11) = (/ & + &8.3490e+00_r8,7.3068e+00_r8,6.2652e+00_r8,5.2233e+00_r8,4.1816e+00_r8,3.1407e+00_r8, & + &2.1527e+00_r8,1.2369e+00_r8,1.2697e-01_r8/) + kao(:, 2,10,11) = (/ & + &8.4604e+00_r8,7.4045e+00_r8,6.3492e+00_r8,5.2936e+00_r8,4.2378e+00_r8,3.1825e+00_r8, & + &2.1701e+00_r8,1.2392e+00_r8,1.2746e-01_r8/) + kao(:, 3,10,11) = (/ & + &8.5299e+00_r8,7.4655e+00_r8,6.4008e+00_r8,5.3364e+00_r8,4.2721e+00_r8,3.2084e+00_r8, & + &2.1800e+00_r8,1.2385e+00_r8,1.2876e-01_r8/) + kao(:, 4,10,11) = (/ & + &8.6037e+00_r8,7.5302e+00_r8,6.4564e+00_r8,5.3827e+00_r8,4.3093e+00_r8,3.2362e+00_r8, & + &2.1902e+00_r8,1.2373e+00_r8,1.3016e-01_r8/) + kao(:, 5,10,11) = (/ & + &8.6811e+00_r8,7.5976e+00_r8,6.5142e+00_r8,5.4315e+00_r8,4.3481e+00_r8,3.2657e+00_r8, & + &2.2039e+00_r8,1.2408e+00_r8,1.3327e-01_r8/) + kao(:, 1,11,11) = (/ & + &1.2908e+01_r8,1.1296e+01_r8,9.6842e+00_r8,8.0726e+00_r8,6.4609e+00_r8,4.8491e+00_r8, & + &3.2606e+00_r8,1.7969e+00_r8,1.0870e-01_r8/) + kao(:, 2,11,11) = (/ & + &1.3081e+01_r8,1.1447e+01_r8,9.8136e+00_r8,8.1796e+00_r8,6.5463e+00_r8,4.9136e+00_r8, & + &3.2978e+00_r8,1.8090e+00_r8,1.0807e-01_r8/) + kao(:, 3,11,11) = (/ & + &1.3247e+01_r8,1.1593e+01_r8,9.9386e+00_r8,8.2843e+00_r8,6.6304e+00_r8,4.9764e+00_r8, & + &3.3344e+00_r8,1.8186e+00_r8,1.0723e-01_r8/) + kao(:, 4,11,11) = (/ & + &1.3412e+01_r8,1.1737e+01_r8,1.0062e+01_r8,8.3876e+00_r8,6.7133e+00_r8,5.0389e+00_r8, & + &3.3728e+00_r8,1.8302e+00_r8,1.0582e-01_r8/) + kao(:, 5,11,11) = (/ & + &1.3565e+01_r8,1.1871e+01_r8,1.0177e+01_r8,8.4837e+00_r8,6.7902e+00_r8,5.0972e+00_r8, & + &3.4088e+00_r8,1.8416e+00_r8,1.0800e-01_r8/) + kao(:, 1,12,11) = (/ & + &1.4642e+01_r8,1.2812e+01_r8,1.0983e+01_r8,9.1554e+00_r8,7.3265e+00_r8,5.4974e+00_r8, & + &3.7020e+00_r8,2.0284e+00_r8,8.2662e-02_r8/) + kao(:, 2,12,11) = (/ & + &1.4885e+01_r8,1.3026e+01_r8,1.1167e+01_r8,9.3078e+00_r8,7.4487e+00_r8,5.5898e+00_r8, & + &3.7559e+00_r8,2.0497e+00_r8,8.1390e-02_r8/) + kao(:, 3,12,11) = (/ & + &1.5119e+01_r8,1.3231e+01_r8,1.1343e+01_r8,9.4543e+00_r8,7.5661e+00_r8,5.6785e+00_r8, & + &3.8088e+00_r8,2.0698e+00_r8,8.0357e-02_r8/) + kao(:, 4,12,11) = (/ & + &1.5358e+01_r8,1.3440e+01_r8,1.1522e+01_r8,9.6047e+00_r8,7.6867e+00_r8,5.7694e+00_r8, & + &3.8642e+00_r8,2.0905e+00_r8,7.9812e-02_r8/) + kao(:, 5,12,11) = (/ & + &1.5578e+01_r8,1.3633e+01_r8,1.1688e+01_r8,9.7428e+00_r8,7.7978e+00_r8,5.8532e+00_r8, & + &3.9171e+00_r8,2.1122e+00_r8,8.2952e-02_r8/) + kao(:, 1,13,11) = (/ & + &1.3181e+01_r8,1.1536e+01_r8,9.8891e+00_r8,8.2428e+00_r8,6.5963e+00_r8,4.9547e+00_r8, & + &3.3878e+00_r8,1.8779e+00_r8,8.5930e-02_r8/) + kao(:, 2,13,11) = (/ & + &1.3431e+01_r8,1.1753e+01_r8,1.0076e+01_r8,8.3993e+00_r8,6.7218e+00_r8,5.0463e+00_r8, & + &3.4400e+00_r8,1.9003e+00_r8,8.2789e-02_r8/) + kao(:, 3,13,11) = (/ & + &1.3694e+01_r8,1.1985e+01_r8,1.0274e+01_r8,8.5642e+00_r8,6.8544e+00_r8,5.1452e+00_r8, & + &3.4940e+00_r8,1.9250e+00_r8,8.1321e-02_r8/) + kao(:, 4,13,11) = (/ & + &1.3957e+01_r8,1.2214e+01_r8,1.0471e+01_r8,8.7279e+00_r8,6.9861e+00_r8,5.2450e+00_r8, & + &3.5504e+00_r8,1.9524e+00_r8,7.8953e-02_r8/) + kao(:, 5,13,11) = (/ & + &1.4201e+01_r8,1.2428e+01_r8,1.0655e+01_r8,8.8819e+00_r8,7.1097e+00_r8,5.3381e+00_r8, & + &3.6055e+00_r8,1.9785e+00_r8,8.1036e-02_r8/) + kao(:, 1, 1,12) = (/ & + &6.5787e-03_r8,2.6236e-02_r8,5.1362e-02_r8,7.6305e-02_r8,1.0073e-01_r8,1.2420e-01_r8, & + &1.4556e-01_r8,1.6001e-01_r8,2.0088e-01_r8/) + kao(:, 2, 1,12) = (/ & + &6.5355e-03_r8,2.5963e-02_r8,5.1031e-02_r8,7.5853e-02_r8,1.0014e-01_r8,1.2346e-01_r8, & + &1.4463e-01_r8,1.5894e-01_r8,1.9973e-01_r8/) + kao(:, 3, 1,12) = (/ & + &6.4519e-03_r8,2.5842e-02_r8,5.0885e-02_r8,7.5629e-02_r8,9.9804e-02_r8,1.2294e-01_r8, & + &1.4394e-01_r8,1.5802e-01_r8,1.9913e-01_r8/) + kao(:, 4, 1,12) = (/ & + &6.3508e-03_r8,2.5827e-02_r8,5.0889e-02_r8,7.5643e-02_r8,9.9816e-02_r8,1.2289e-01_r8, & + &1.4367e-01_r8,1.5727e-01_r8,1.9918e-01_r8/) + kao(:, 5, 1,12) = (/ & + &6.2468e-03_r8,2.5824e-02_r8,5.0882e-02_r8,7.5643e-02_r8,9.9840e-02_r8,1.2300e-01_r8, & + &1.4386e-01_r8,1.5674e-01_r8,1.9923e-01_r8/) + kao(:, 1, 2,12) = (/ & + &1.0416e-02_r8,2.8932e-02_r8,5.5152e-02_r8,8.2023e-02_r8,1.0846e-01_r8,1.3404e-01_r8, & + &1.5780e-01_r8,1.7629e-01_r8,2.1619e-01_r8/) + kao(:, 2, 2,12) = (/ & + &1.0342e-02_r8,2.8637e-02_r8,5.4892e-02_r8,8.1654e-02_r8,1.0796e-01_r8,1.3340e-01_r8, & + &1.5695e-01_r8,1.7507e-01_r8,2.1532e-01_r8/) + kao(:, 3, 2,12) = (/ & + &1.0224e-02_r8,2.8457e-02_r8,5.4759e-02_r8,8.1469e-02_r8,1.0772e-01_r8,1.3310e-01_r8, & + &1.5656e-01_r8,1.7435e-01_r8,2.1487e-01_r8/) + kao(:, 4, 2,12) = (/ & + &1.0091e-02_r8,2.8318e-02_r8,5.4670e-02_r8,8.1344e-02_r8,1.0759e-01_r8,1.3299e-01_r8, & + &1.5649e-01_r8,1.7414e-01_r8,2.1459e-01_r8/) + kao(:, 5, 2,12) = (/ & + &9.9570e-03_r8,2.8146e-02_r8,5.4539e-02_r8,8.1138e-02_r8,1.0736e-01_r8,1.3278e-01_r8, & + &1.5638e-01_r8,1.7422e-01_r8,2.1411e-01_r8/) + kao(:, 1, 3,12) = (/ & + &2.2302e-02_r8,3.7417e-02_r8,6.1097e-02_r8,8.8747e-02_r8,1.1756e-01_r8,1.4593e-01_r8, & + &1.7314e-01_r8,1.9636e-01_r8,2.3403e-01_r8/) + kao(:, 2, 3,12) = (/ & + &2.2117e-02_r8,3.6950e-02_r8,6.0557e-02_r8,8.8385e-02_r8,1.1711e-01_r8,1.4537e-01_r8, & + &1.7254e-01_r8,1.9566e-01_r8,2.3319e-01_r8/) + kao(:, 3, 3,12) = (/ & + &2.1903e-02_r8,3.6596e-02_r8,6.0142e-02_r8,8.8214e-02_r8,1.1684e-01_r8,1.4504e-01_r8, & + &1.7207e-01_r8,1.9507e-01_r8,2.3270e-01_r8/) + kao(:, 4, 3,12) = (/ & + &2.1706e-02_r8,3.6379e-02_r8,5.9779e-02_r8,8.7937e-02_r8,1.1644e-01_r8,1.4454e-01_r8, & + &1.7162e-01_r8,1.9475e-01_r8,2.3180e-01_r8/) + kao(:, 5, 3,12) = (/ & + &2.1485e-02_r8,3.6152e-02_r8,5.9419e-02_r8,8.7609e-02_r8,1.1597e-01_r8,1.4392e-01_r8, & + &1.7083e-01_r8,1.9407e-01_r8,2.3079e-01_r8/) + kao(:, 1, 4,12) = (/ & + &4.8787e-02_r8,6.0363e-02_r8,7.6958e-02_r8,9.9608e-02_r8,1.2651e-01_r8,1.5698e-01_r8, & + &1.8722e-01_r8,2.1554e-01_r8,2.5046e-01_r8/) + kao(:, 2, 4,12) = (/ & + &4.8476e-02_r8,5.9621e-02_r8,7.6177e-02_r8,9.8903e-02_r8,1.2601e-01_r8,1.5644e-01_r8, & + &1.8652e-01_r8,2.1472e-01_r8,2.4963e-01_r8/) + kao(:, 3, 4,12) = (/ & + &4.8022e-02_r8,5.9054e-02_r8,7.5570e-02_r8,9.8295e-02_r8,1.2578e-01_r8,1.5620e-01_r8, & + &1.8618e-01_r8,2.1420e-01_r8,2.4913e-01_r8/) + kao(:, 4, 4,12) = (/ & + &4.7565e-02_r8,5.8399e-02_r8,7.5073e-02_r8,9.7780e-02_r8,1.2559e-01_r8,1.5591e-01_r8, & + &1.8579e-01_r8,2.1367e-01_r8,2.4858e-01_r8/) + kao(:, 5, 4,12) = (/ & + &4.7078e-02_r8,5.7702e-02_r8,7.4506e-02_r8,9.7303e-02_r8,1.2546e-01_r8,1.5568e-01_r8, & + &1.8546e-01_r8,2.1318e-01_r8,2.4815e-01_r8/) + kao(:, 1, 5,12) = (/ & + &9.7499e-02_r8,9.8718e-02_r8,1.1395e-01_r8,1.2710e-01_r8,1.4448e-01_r8,1.6872e-01_r8, & + &1.9875e-01_r8,2.3006e-01_r8,2.6441e-01_r8/) + kao(:, 2, 5,12) = (/ & + &9.6942e-02_r8,9.7852e-02_r8,1.1233e-01_r8,1.2606e-01_r8,1.4347e-01_r8,1.6785e-01_r8, & + &1.9829e-01_r8,2.2956e-01_r8,2.6367e-01_r8/) + kao(:, 3, 5,12) = (/ & + &9.6111e-02_r8,9.7066e-02_r8,1.1087e-01_r8,1.2520e-01_r8,1.4264e-01_r8,1.6720e-01_r8, & + &1.9804e-01_r8,2.2914e-01_r8,2.6333e-01_r8/) + kao(:, 4, 5,12) = (/ & + &9.5331e-02_r8,9.6285e-02_r8,1.0984e-01_r8,1.2440e-01_r8,1.4205e-01_r8,1.6680e-01_r8, & + &1.9797e-01_r8,2.2895e-01_r8,2.6319e-01_r8/) + kao(:, 5, 5,12) = (/ & + &9.4443e-02_r8,9.5498e-02_r8,1.0898e-01_r8,1.2351e-01_r8,1.4175e-01_r8,1.6646e-01_r8, & + &1.9775e-01_r8,2.2870e-01_r8,2.6275e-01_r8/) + kao(:, 1, 6,12) = (/ & + &1.8140e-01_r8,1.6408e-01_r8,1.7552e-01_r8,1.8196e-01_r8,1.8674e-01_r8,1.9489e-01_r8, & + &2.1183e-01_r8,2.4078e-01_r8,2.7512e-01_r8/) + kao(:, 2, 6,12) = (/ & + &1.8064e-01_r8,1.6323e-01_r8,1.7439e-01_r8,1.7956e-01_r8,1.8547e-01_r8,1.9334e-01_r8, & + &2.1068e-01_r8,2.4042e-01_r8,2.7473e-01_r8/) + kao(:, 3, 6,12) = (/ & + &1.7939e-01_r8,1.6216e-01_r8,1.7344e-01_r8,1.7751e-01_r8,1.8404e-01_r8,1.9207e-01_r8, & + &2.1020e-01_r8,2.4067e-01_r8,2.7502e-01_r8/) + kao(:, 4, 6,12) = (/ & + &1.7796e-01_r8,1.6097e-01_r8,1.7233e-01_r8,1.7595e-01_r8,1.8277e-01_r8,1.9147e-01_r8, & + &2.0971e-01_r8,2.4067e-01_r8,2.7492e-01_r8/) + kao(:, 5, 6,12) = (/ & + &1.7632e-01_r8,1.5943e-01_r8,1.7056e-01_r8,1.7456e-01_r8,1.8167e-01_r8,1.9081e-01_r8, & + &2.0890e-01_r8,2.4019e-01_r8,2.7421e-01_r8/) + kao(:, 1, 7,12) = (/ & + &3.5379e-01_r8,3.1064e-01_r8,2.9565e-01_r8,2.8816e-01_r8,2.7694e-01_r8,2.6472e-01_r8, & + &2.4939e-01_r8,2.5136e-01_r8,2.8304e-01_r8/) + kao(:, 2, 7,12) = (/ & + &3.5306e-01_r8,3.1059e-01_r8,2.9503e-01_r8,2.8682e-01_r8,2.7447e-01_r8,2.6248e-01_r8, & + &2.4787e-01_r8,2.5077e-01_r8,2.8333e-01_r8/) + kao(:, 3, 7,12) = (/ & + &3.5170e-01_r8,3.1024e-01_r8,2.9413e-01_r8,2.8605e-01_r8,2.7226e-01_r8,2.6030e-01_r8, & + &2.4686e-01_r8,2.5055e-01_r8,2.8358e-01_r8/) + kao(:, 4, 7,12) = (/ & + &3.4988e-01_r8,3.0935e-01_r8,2.9228e-01_r8,2.8440e-01_r8,2.7034e-01_r8,2.5822e-01_r8, & + &2.4645e-01_r8,2.4996e-01_r8,2.8315e-01_r8/) + kao(:, 5, 7,12) = (/ & + &3.4759e-01_r8,3.0773e-01_r8,2.8986e-01_r8,2.8199e-01_r8,2.6823e-01_r8,2.5660e-01_r8, & + &2.4547e-01_r8,2.4917e-01_r8,2.8239e-01_r8/) + kao(:, 1, 8,12) = (/ & + &8.0496e-01_r8,7.0527e-01_r8,6.0910e-01_r8,5.5199e-01_r8,5.0022e-01_r8,4.3776e-01_r8, & + &3.7465e-01_r8,3.0063e-01_r8,2.8877e-01_r8/) + kao(:, 2, 8,12) = (/ & + &8.0672e-01_r8,7.0707e-01_r8,6.1070e-01_r8,5.5311e-01_r8,5.0061e-01_r8,4.3582e-01_r8, & + &3.7176e-01_r8,2.9952e-01_r8,2.8902e-01_r8/) + kao(:, 3, 8,12) = (/ & + &8.0691e-01_r8,7.0823e-01_r8,6.1191e-01_r8,5.5364e-01_r8,5.0004e-01_r8,4.3422e-01_r8, & + &3.6951e-01_r8,2.9892e-01_r8,2.8876e-01_r8/) + kao(:, 4, 8,12) = (/ & + &8.0527e-01_r8,7.0753e-01_r8,6.1153e-01_r8,5.5173e-01_r8,4.9853e-01_r8,4.3157e-01_r8, & + &3.6699e-01_r8,2.9815e-01_r8,2.8834e-01_r8/) + kao(:, 5, 8,12) = (/ & + &8.0219e-01_r8,7.0523e-01_r8,6.0964e-01_r8,5.4776e-01_r8,4.9536e-01_r8,4.2816e-01_r8, & + &3.6486e-01_r8,2.9693e-01_r8,2.8675e-01_r8/) + kao(:, 1, 9,12) = (/ & + &3.4182e+00_r8,2.9916e+00_r8,2.5652e+00_r8,2.1389e+00_r8,1.7153e+00_r8,1.3419e+00_r8, & + &1.0101e+00_r8,6.4726e-01_r8,2.8926e-01_r8/) + kao(:, 2, 9,12) = (/ & + &3.4411e+00_r8,3.0119e+00_r8,2.5830e+00_r8,2.1544e+00_r8,1.7278e+00_r8,1.3490e+00_r8, & + &1.0168e+00_r8,6.4570e-01_r8,2.8901e-01_r8/) + kao(:, 3, 9,12) = (/ & + &3.4584e+00_r8,3.0278e+00_r8,2.5976e+00_r8,2.1679e+00_r8,1.7392e+00_r8,1.3535e+00_r8, & + &1.0208e+00_r8,6.4462e-01_r8,2.8863e-01_r8/) + kao(:, 4, 9,12) = (/ & + &3.4643e+00_r8,3.0337e+00_r8,2.6033e+00_r8,2.1735e+00_r8,1.7445e+00_r8,1.3538e+00_r8, & + &1.0204e+00_r8,6.4174e-01_r8,2.8774e-01_r8/) + kao(:, 5, 9,12) = (/ & + &3.4625e+00_r8,3.0324e+00_r8,2.6029e+00_r8,2.1736e+00_r8,1.7453e+00_r8,1.3500e+00_r8, & + &1.0152e+00_r8,6.3782e-01_r8,2.8595e-01_r8/) + kao(:, 1,10,12) = (/ & + &1.6048e+01_r8,1.4043e+01_r8,1.2038e+01_r8,1.0032e+01_r8,8.0269e+00_r8,6.0216e+00_r8, & + &4.0164e+00_r8,2.1217e+00_r8,2.8227e-01_r8/) + kao(:, 2,10,12) = (/ & + &1.6256e+01_r8,1.4226e+01_r8,1.2195e+01_r8,1.0164e+01_r8,8.1333e+00_r8,6.1029e+00_r8, & + &4.0729e+00_r8,2.1442e+00_r8,2.8170e-01_r8/) + kao(:, 3,10,12) = (/ & + &1.6399e+01_r8,1.4351e+01_r8,1.2303e+01_r8,1.0255e+01_r8,8.2073e+00_r8,6.1596e+00_r8, & + &4.1123e+00_r8,2.1594e+00_r8,2.8134e-01_r8/) + kao(:, 4,10,12) = (/ & + &1.6465e+01_r8,1.4409e+01_r8,1.2353e+01_r8,1.0297e+01_r8,8.2414e+00_r8,6.1861e+00_r8, & + &4.1319e+00_r8,2.1644e+00_r8,2.8049e-01_r8/) + kao(:, 5,10,12) = (/ & + &1.6472e+01_r8,1.4416e+01_r8,1.2359e+01_r8,1.0303e+01_r8,8.2464e+00_r8,6.1909e+00_r8, & + &4.1366e+00_r8,2.1582e+00_r8,2.7905e-01_r8/) + kao(:, 1,11,12) = (/ & + &2.6190e+01_r8,2.2917e+01_r8,1.9644e+01_r8,1.6372e+01_r8,1.3098e+01_r8,9.8258e+00_r8, & + &6.5533e+00_r8,3.3347e+00_r8,2.0130e-01_r8/) + kao(:, 2,11,12) = (/ & + &2.6572e+01_r8,2.3252e+01_r8,1.9932e+01_r8,1.6612e+01_r8,1.3292e+01_r8,9.9715e+00_r8, & + &6.6522e+00_r8,3.3768e+00_r8,2.0375e-01_r8/) + kao(:, 3,11,12) = (/ & + &2.6794e+01_r8,2.3447e+01_r8,2.0099e+01_r8,1.6751e+01_r8,1.3404e+01_r8,1.0057e+01_r8, & + &6.7102e+00_r8,3.4019e+00_r8,2.0648e-01_r8/) + kao(:, 4,11,12) = (/ & + &2.6905e+01_r8,2.3544e+01_r8,2.0183e+01_r8,1.6822e+01_r8,1.3461e+01_r8,1.0100e+01_r8, & + &6.7401e+00_r8,3.4102e+00_r8,2.0903e-01_r8/) + kao(:, 5,11,12) = (/ & + &2.6968e+01_r8,2.3599e+01_r8,2.0230e+01_r8,1.6860e+01_r8,1.3492e+01_r8,1.0123e+01_r8, & + &6.7556e+00_r8,3.4122e+00_r8,2.1045e-01_r8/) + kao(:, 1,12,12) = (/ & + &3.1310e+01_r8,2.7398e+01_r8,2.3484e+01_r8,1.9572e+01_r8,1.5659e+01_r8,1.1747e+01_r8, & + &7.8342e+00_r8,3.9879e+00_r8,1.6283e-01_r8/) + kao(:, 2,12,12) = (/ & + &3.1751e+01_r8,2.7784e+01_r8,2.3816e+01_r8,1.9849e+01_r8,1.5882e+01_r8,1.1914e+01_r8, & + &7.9470e+00_r8,4.0341e+00_r8,1.6415e-01_r8/) + kao(:, 3,12,12) = (/ & + &3.2043e+01_r8,2.8038e+01_r8,2.4036e+01_r8,2.0032e+01_r8,1.6028e+01_r8,1.2025e+01_r8, & + &8.0217e+00_r8,4.0620e+00_r8,1.6794e-01_r8/) + kao(:, 4,12,12) = (/ & + &3.2220e+01_r8,2.8195e+01_r8,2.4168e+01_r8,2.0143e+01_r8,1.6116e+01_r8,1.2091e+01_r8, & + &8.0659e+00_r8,4.0753e+00_r8,1.6850e-01_r8/) + kao(:, 5,12,12) = (/ & + &3.2373e+01_r8,2.8329e+01_r8,2.4283e+01_r8,2.0239e+01_r8,1.6193e+01_r8,1.2149e+01_r8, & + &8.1043e+00_r8,4.0871e+00_r8,1.6988e-01_r8/) + kao(:, 1,13,12) = (/ & + &2.9544e+01_r8,2.5852e+01_r8,2.2161e+01_r8,1.8469e+01_r8,1.4777e+01_r8,1.1085e+01_r8, & + &7.3931e+00_r8,3.8439e+00_r8,1.2880e-01_r8/) + kao(:, 2,13,12) = (/ & + &2.9974e+01_r8,2.6228e+01_r8,2.2483e+01_r8,1.8737e+01_r8,1.4992e+01_r8,1.1247e+01_r8, & + &7.5021e+00_r8,3.8830e+00_r8,1.3338e-01_r8/) + kao(:, 3,13,12) = (/ & + &3.0254e+01_r8,2.6474e+01_r8,2.2694e+01_r8,1.8912e+01_r8,1.5132e+01_r8,1.1352e+01_r8, & + &7.5719e+00_r8,3.9004e+00_r8,1.3721e-01_r8/) + kao(:, 4,13,12) = (/ & + &3.0504e+01_r8,2.6693e+01_r8,2.2881e+01_r8,1.9069e+01_r8,1.5258e+01_r8,1.1446e+01_r8, & + &7.6348e+00_r8,3.9163e+00_r8,1.3871e-01_r8/) + kao(:, 5,13,12) = (/ & + &3.0781e+01_r8,2.6934e+01_r8,2.3088e+01_r8,1.9241e+01_r8,1.5395e+01_r8,1.1550e+01_r8, & + &7.7042e+00_r8,3.9392e+00_r8,1.4036e-01_r8/) + kao(:, 1, 1,13) = (/ & + &9.0088e-03_r8,3.7171e-02_r8,7.3185e-02_r8,1.0841e-01_r8,1.4222e-01_r8,1.7328e-01_r8, & + &1.9823e-01_r8,2.0424e-01_r8,2.8396e-01_r8/) + kao(:, 2, 1,13) = (/ & + &8.8070e-03_r8,3.7017e-02_r8,7.2761e-02_r8,1.0769e-01_r8,1.4122e-01_r8,1.7208e-01_r8, & + &1.9703e-01_r8,2.0324e-01_r8,2.8185e-01_r8/) + kao(:, 3, 1,13) = (/ & + &8.6641e-03_r8,3.6729e-02_r8,7.2126e-02_r8,1.0675e-01_r8,1.4002e-01_r8,1.7072e-01_r8, & + &1.9555e-01_r8,2.0207e-01_r8,2.7936e-01_r8/) + kao(:, 4, 1,13) = (/ & + &8.5351e-03_r8,3.6304e-02_r8,7.1373e-02_r8,1.0562e-01_r8,1.3853e-01_r8,1.6891e-01_r8, & + &1.9361e-01_r8,2.0011e-01_r8,2.7631e-01_r8/) + kao(:, 5, 1,13) = (/ & + &8.4180e-03_r8,3.5892e-02_r8,7.0613e-02_r8,1.0456e-01_r8,1.3716e-01_r8,1.6725e-01_r8, & + &1.9159e-01_r8,1.9822e-01_r8,2.7366e-01_r8/) + kao(:, 1, 2,13) = (/ & + &1.4629e-02_r8,4.1401e-02_r8,8.1344e-02_r8,1.2092e-01_r8,1.5970e-01_r8,1.9686e-01_r8, & + &2.3007e-01_r8,2.4893e-01_r8,3.1872e-01_r8/) + kao(:, 2, 2,13) = (/ & + &1.4347e-02_r8,4.1149e-02_r8,8.0754e-02_r8,1.2000e-01_r8,1.5844e-01_r8,1.9525e-01_r8, & + &2.2811e-01_r8,2.4701e-01_r8,3.1592e-01_r8/) + kao(:, 3, 2,13) = (/ & + &1.4116e-02_r8,4.0731e-02_r8,7.9979e-02_r8,1.1881e-01_r8,1.5685e-01_r8,1.9333e-01_r8, & + &2.2600e-01_r8,2.4518e-01_r8,3.1267e-01_r8/) + kao(:, 4, 2,13) = (/ & + &1.3916e-02_r8,4.0235e-02_r8,7.9131e-02_r8,1.1757e-01_r8,1.5518e-01_r8,1.9122e-01_r8, & + &2.2354e-01_r8,2.4260e-01_r8,3.0926e-01_r8/) + kao(:, 5, 2,13) = (/ & + &1.3712e-02_r8,3.9826e-02_r8,7.8358e-02_r8,1.1644e-01_r8,1.5370e-01_r8,1.8938e-01_r8, & + &2.2131e-01_r8,2.4017e-01_r8,3.0647e-01_r8/) + kao(:, 1, 3,13) = (/ & + &3.2046e-02_r8,5.1387e-02_r8,8.9167e-02_r8,1.3251e-01_r8,1.7557e-01_r8,2.1798e-01_r8, & + &2.5867e-01_r8,2.9276e-01_r8,3.4967e-01_r8/) + kao(:, 2, 3,13) = (/ & + &3.1484e-02_r8,5.0885e-02_r8,8.8511e-02_r8,1.3146e-01_r8,1.7409e-01_r8,2.1604e-01_r8, & + &2.5621e-01_r8,2.8967e-01_r8,3.4641e-01_r8/) + kao(:, 3, 3,13) = (/ & + &3.1011e-02_r8,5.0194e-02_r8,8.7651e-02_r8,1.3011e-01_r8,1.7226e-01_r8,2.1375e-01_r8, & + &2.5357e-01_r8,2.8697e-01_r8,3.4255e-01_r8/) + kao(:, 4, 3,13) = (/ & + &3.0595e-02_r8,4.9306e-02_r8,8.6747e-02_r8,1.2888e-01_r8,1.7065e-01_r8,2.1172e-01_r8, & + &2.5094e-01_r8,2.8374e-01_r8,3.3932e-01_r8/) + kao(:, 5, 3,13) = (/ & + &3.0114e-02_r8,4.8480e-02_r8,8.6058e-02_r8,1.2788e-01_r8,1.6935e-01_r8,2.1010e-01_r8, & + &2.4901e-01_r8,2.8126e-01_r8,3.3697e-01_r8/) + kao(:, 1, 4,13) = (/ & + &7.1437e-02_r8,7.9531e-02_r8,1.0765e-01_r8,1.4496e-01_r8,1.9060e-01_r8,2.3699e-01_r8, & + &2.8255e-01_r8,3.2483e-01_r8,3.7856e-01_r8/) + kao(:, 2, 4,13) = (/ & + &7.0222e-02_r8,7.8795e-02_r8,1.0643e-01_r8,1.4338e-01_r8,1.8881e-01_r8,2.3460e-01_r8, & + &2.7960e-01_r8,3.2131e-01_r8,3.7439e-01_r8/) + kao(:, 3, 4,13) = (/ & + &6.9262e-02_r8,7.7852e-02_r8,1.0486e-01_r8,1.4165e-01_r8,1.8684e-01_r8,2.3207e-01_r8, & + &2.7650e-01_r8,3.1773e-01_r8,3.7008e-01_r8/) + kao(:, 4, 4,13) = (/ & + &6.8383e-02_r8,7.7009e-02_r8,1.0310e-01_r8,1.4004e-01_r8,1.8506e-01_r8,2.2994e-01_r8, & + &2.7397e-01_r8,3.1473e-01_r8,3.6682e-01_r8/) + kao(:, 5, 4,13) = (/ & + &6.7482e-02_r8,7.6264e-02_r8,1.0166e-01_r8,1.3889e-01_r8,1.8370e-01_r8,2.2828e-01_r8, & + &2.7201e-01_r8,3.1244e-01_r8,3.6430e-01_r8/) + kao(:, 1, 5,13) = (/ & + &1.4624e-01_r8,1.3361e-01_r8,1.5693e-01_r8,1.7752e-01_r8,2.1095e-01_r8,2.5537e-01_r8, & + &3.0486e-01_r8,3.5270e-01_r8,4.0651e-01_r8/) + kao(:, 2, 5,13) = (/ & + &1.4398e-01_r8,1.3165e-01_r8,1.5512e-01_r8,1.7519e-01_r8,2.0814e-01_r8,2.5302e-01_r8, & + &3.0184e-01_r8,3.4895e-01_r8,4.0217e-01_r8/) + kao(:, 3, 5,13) = (/ & + &1.4207e-01_r8,1.3000e-01_r8,1.5346e-01_r8,1.7248e-01_r8,2.0524e-01_r8,2.5056e-01_r8, & + &2.9880e-01_r8,3.4528e-01_r8,3.9789e-01_r8/) + kao(:, 4, 5,13) = (/ & + &1.4038e-01_r8,1.2884e-01_r8,1.5157e-01_r8,1.6985e-01_r8,2.0246e-01_r8,2.4823e-01_r8, & + &2.9613e-01_r8,3.4225e-01_r8,3.9462e-01_r8/) + kao(:, 5, 5,13) = (/ & + &1.3874e-01_r8,1.2784e-01_r8,1.4941e-01_r8,1.6780e-01_r8,2.0033e-01_r8,2.4657e-01_r8, & + &2.9417e-01_r8,3.3986e-01_r8,3.9218e-01_r8/) + kao(:, 1, 6,13) = (/ & + &2.8046e-01_r8,2.4640e-01_r8,2.4558e-01_r8,2.5477e-01_r8,2.6318e-01_r8,2.8661e-01_r8, & + &3.2769e-01_r8,3.7985e-01_r8,4.3568e-01_r8/) + kao(:, 2, 6,13) = (/ & + &2.7643e-01_r8,2.4318e-01_r8,2.4273e-01_r8,2.5156e-01_r8,2.5913e-01_r8,2.8275e-01_r8, & + &3.2478e-01_r8,3.7621e-01_r8,4.3126e-01_r8/) + kao(:, 3, 6,13) = (/ & + &2.7290e-01_r8,2.4050e-01_r8,2.4016e-01_r8,2.4894e-01_r8,2.5526e-01_r8,2.7880e-01_r8, & + &3.2177e-01_r8,3.7266e-01_r8,4.2706e-01_r8/) + kao(:, 4, 6,13) = (/ & + &2.7013e-01_r8,2.3869e-01_r8,2.3760e-01_r8,2.4573e-01_r8,2.5166e-01_r8,2.7510e-01_r8, & + &3.1929e-01_r8,3.6982e-01_r8,4.2412e-01_r8/) + kao(:, 5, 6,13) = (/ & + &2.6724e-01_r8,2.3701e-01_r8,2.3563e-01_r8,2.4210e-01_r8,2.4866e-01_r8,2.7240e-01_r8, & + &3.1774e-01_r8,3.6799e-01_r8,4.2206e-01_r8/) + kao(:, 1, 7,13) = (/ & + &5.6688e-01_r8,4.9674e-01_r8,4.3519e-01_r8,4.2029e-01_r8,3.9894e-01_r8,3.7594e-01_r8, & + &3.7424e-01_r8,4.0700e-01_r8,4.6486e-01_r8/) + kao(:, 2, 7,13) = (/ & + &5.6062e-01_r8,4.9147e-01_r8,4.2917e-01_r8,4.1552e-01_r8,3.9325e-01_r8,3.7043e-01_r8, & + &3.6935e-01_r8,4.0348e-01_r8,4.6044e-01_r8/) + kao(:, 3, 7,13) = (/ & + &5.5419e-01_r8,4.8620e-01_r8,4.2405e-01_r8,4.1052e-01_r8,3.8832e-01_r8,3.6566e-01_r8, & + &3.6433e-01_r8,4.0051e-01_r8,4.5715e-01_r8/) + kao(:, 4, 7,13) = (/ & + &5.4908e-01_r8,4.8208e-01_r8,4.2069e-01_r8,4.0630e-01_r8,3.8346e-01_r8,3.6097e-01_r8, & + &3.5952e-01_r8,3.9819e-01_r8,4.5457e-01_r8/) + kao(:, 5, 7,13) = (/ & + &5.4429e-01_r8,4.7829e-01_r8,4.1793e-01_r8,4.0260e-01_r8,3.7854e-01_r8,3.5674e-01_r8, & + &3.5560e-01_r8,3.9638e-01_r8,4.5240e-01_r8/) + kao(:, 1, 8,13) = (/ & + &1.3466e+00_r8,1.1788e+00_r8,1.0111e+00_r8,8.5366e-01_r8,7.5173e-01_r8,6.5869e-01_r8, & + &5.4376e-01_r8,4.6329e-01_r8,4.8785e-01_r8/) + kao(:, 2, 8,13) = (/ & + &1.3340e+00_r8,1.1680e+00_r8,1.0021e+00_r8,8.4354e-01_r8,7.4161e-01_r8,6.4846e-01_r8, & + &5.3530e-01_r8,4.5751e-01_r8,4.8487e-01_r8/) + kao(:, 3, 8,13) = (/ & + &1.3215e+00_r8,1.1573e+00_r8,9.9337e-01_r8,8.3476e-01_r8,7.3374e-01_r8,6.3918e-01_r8, & + &5.2901e-01_r8,4.5174e-01_r8,4.8277e-01_r8/) + kao(:, 4, 8,13) = (/ & + &1.3130e+00_r8,1.1502e+00_r8,9.8764e-01_r8,8.2958e-01_r8,7.2734e-01_r8,6.3251e-01_r8, & + &5.2258e-01_r8,4.4677e-01_r8,4.8075e-01_r8/) + kao(:, 5, 8,13) = (/ & + &1.3037e+00_r8,1.1423e+00_r8,9.8136e-01_r8,8.2511e-01_r8,7.2245e-01_r8,6.2665e-01_r8, & + &5.1636e-01_r8,4.4197e-01_r8,4.7928e-01_r8/) + kao(:, 1, 9,13) = (/ & + &6.0221e+00_r8,5.2697e+00_r8,4.5174e+00_r8,3.7653e+00_r8,3.0129e+00_r8,2.2622e+00_r8, & + &1.5952e+00_r8,9.9726e-01_r8,5.0671e-01_r8/) + kao(:, 2, 9,13) = (/ & + &5.9755e+00_r8,5.2290e+00_r8,4.4828e+00_r8,3.7364e+00_r8,2.9901e+00_r8,2.2441e+00_r8, & + &1.5732e+00_r8,9.8172e-01_r8,5.0573e-01_r8/) + kao(:, 3, 9,13) = (/ & + &5.9358e+00_r8,5.1947e+00_r8,4.4536e+00_r8,3.7125e+00_r8,2.9715e+00_r8,2.2305e+00_r8, & + &1.5561e+00_r8,9.6836e-01_r8,5.0514e-01_r8/) + kao(:, 4, 9,13) = (/ & + &5.9085e+00_r8,5.1712e+00_r8,4.4336e+00_r8,3.6962e+00_r8,2.9588e+00_r8,2.2217e+00_r8, & + &1.5446e+00_r8,9.5878e-01_r8,5.0373e-01_r8/) + kao(:, 5, 9,13) = (/ & + &5.8741e+00_r8,5.1412e+00_r8,4.4082e+00_r8,3.6753e+00_r8,2.9426e+00_r8,2.2110e+00_r8, & + &1.5366e+00_r8,9.5070e-01_r8,5.0223e-01_r8/) + kao(:, 1,10,13) = (/ & + &2.9983e+01_r8,2.6236e+01_r8,2.2488e+01_r8,1.8741e+01_r8,1.4994e+01_r8,1.1246e+01_r8, & + &7.4983e+00_r8,3.7584e+00_r8,5.2065e-01_r8/) + kao(:, 2,10,13) = (/ & + &2.9796e+01_r8,2.6072e+01_r8,2.2348e+01_r8,1.8624e+01_r8,1.4900e+01_r8,1.1176e+01_r8, & + &7.4520e+00_r8,3.7308e+00_r8,5.2186e-01_r8/) + kao(:, 3,10,13) = (/ & + &2.9702e+01_r8,2.5989e+01_r8,2.2278e+01_r8,1.8566e+01_r8,1.4854e+01_r8,1.1142e+01_r8, & + &7.4298e+00_r8,3.7183e+00_r8,5.2236e-01_r8/) + kao(:, 4,10,13) = (/ & + &2.9648e+01_r8,2.5942e+01_r8,2.2238e+01_r8,1.8533e+01_r8,1.4828e+01_r8,1.1123e+01_r8, & + &7.4177e+00_r8,3.7128e+00_r8,5.2097e-01_r8/) + kao(:, 5,10,13) = (/ & + &2.9599e+01_r8,2.5901e+01_r8,2.2202e+01_r8,1.8502e+01_r8,1.4804e+01_r8,1.1105e+01_r8, & + &7.4063e+00_r8,3.7092e+00_r8,5.1987e-01_r8/) + kao(:, 1,11,13) = (/ & + &5.1290e+01_r8,4.4882e+01_r8,3.8471e+01_r8,3.2058e+01_r8,2.5646e+01_r8,1.9236e+01_r8, & + &1.2824e+01_r8,6.4141e+00_r8,5.2983e-01_r8/) + kao(:, 2,11,13) = (/ & + &5.1244e+01_r8,4.4838e+01_r8,3.8434e+01_r8,3.2028e+01_r8,2.5623e+01_r8,1.9219e+01_r8, & + &1.2814e+01_r8,6.4089e+00_r8,5.3215e-01_r8/) + kao(:, 3,11,13) = (/ & + &5.1318e+01_r8,4.4905e+01_r8,3.8491e+01_r8,3.2076e+01_r8,2.5662e+01_r8,1.9248e+01_r8, & + &1.2833e+01_r8,6.4196e+00_r8,5.3209e-01_r8/) + kao(:, 4,11,13) = (/ & + &5.1488e+01_r8,4.5053e+01_r8,3.8617e+01_r8,3.2182e+01_r8,2.5747e+01_r8,1.9312e+01_r8, & + &1.2877e+01_r8,6.4422e+00_r8,5.3137e-01_r8/) + kao(:, 5,11,13) = (/ & + &5.1544e+01_r8,4.5101e+01_r8,3.8659e+01_r8,3.2218e+01_r8,2.5776e+01_r8,1.9335e+01_r8, & + &1.2893e+01_r8,6.4519e+00_r8,5.3038e-01_r8/) + kao(:, 1,12,13) = (/ & + &6.4625e+01_r8,5.6547e+01_r8,4.8469e+01_r8,4.0391e+01_r8,3.2315e+01_r8,2.4238e+01_r8, & + &1.6158e+01_r8,8.0814e+00_r8,4.6363e-01_r8/) + kao(:, 2,12,13) = (/ & + &6.4981e+01_r8,5.6858e+01_r8,4.8737e+01_r8,4.0614e+01_r8,3.2493e+01_r8,2.4371e+01_r8, & + &1.6249e+01_r8,8.1265e+00_r8,4.7141e-01_r8/) + kao(:, 3,12,13) = (/ & + &6.5489e+01_r8,5.7301e+01_r8,4.9118e+01_r8,4.0933e+01_r8,3.2747e+01_r8,2.4562e+01_r8, & + &1.6376e+01_r8,8.1908e+00_r8,4.7318e-01_r8/) + kao(:, 4,12,13) = (/ & + &6.5927e+01_r8,5.7688e+01_r8,4.9446e+01_r8,4.1208e+01_r8,3.2967e+01_r8,2.4727e+01_r8, & + &1.6488e+01_r8,8.2475e+00_r8,4.7664e-01_r8/) + kao(:, 5,12,13) = (/ & + &6.6087e+01_r8,5.7823e+01_r8,4.9566e+01_r8,4.1306e+01_r8,3.3048e+01_r8,2.4787e+01_r8, & + &1.6528e+01_r8,8.2690e+00_r8,4.7820e-01_r8/) + kao(:, 1,13,13) = (/ & + &6.4615e+01_r8,5.6540e+01_r8,4.8462e+01_r8,4.0385e+01_r8,3.2309e+01_r8,2.4232e+01_r8, & + &1.6156e+01_r8,8.0805e+00_r8,4.0088e-01_r8/) + kao(:, 2,13,13) = (/ & + &6.5417e+01_r8,5.7241e+01_r8,4.9064e+01_r8,4.0887e+01_r8,3.2711e+01_r8,2.4534e+01_r8, & + &1.6357e+01_r8,8.1804e+00_r8,3.9953e-01_r8/) + kao(:, 3,13,13) = (/ & + &6.6282e+01_r8,5.7998e+01_r8,4.9715e+01_r8,4.1430e+01_r8,3.3145e+01_r8,2.4860e+01_r8, & + &1.6576e+01_r8,8.2909e+00_r8,4.0385e-01_r8/) + kao(:, 4,13,13) = (/ & + &6.6847e+01_r8,5.8491e+01_r8,5.0137e+01_r8,4.1781e+01_r8,3.3427e+01_r8,2.5072e+01_r8, & + &1.6717e+01_r8,8.3627e+00_r8,4.1064e-01_r8/) + kao(:, 5,13,13) = (/ & + &6.7163e+01_r8,5.8769e+01_r8,5.0375e+01_r8,4.1983e+01_r8,3.3587e+01_r8,2.5193e+01_r8, & + &1.6798e+01_r8,8.4033e+00_r8,4.1414e-01_r8/) + kao(:, 1, 1,14) = (/ & + &1.2012e-02_r8,4.7001e-02_r8,9.2646e-02_r8,1.3669e-01_r8,1.7808e-01_r8,2.1465e-01_r8, & + &2.4110e-01_r8,2.4013e-01_r8,3.5593e-01_r8/) + kao(:, 2, 1,14) = (/ & + &1.1787e-02_r8,4.6471e-02_r8,9.1548e-02_r8,1.3506e-01_r8,1.7598e-01_r8,2.1215e-01_r8, & + &2.3833e-01_r8,2.3702e-01_r8,3.5168e-01_r8/) + kao(:, 3, 1,14) = (/ & + &1.1552e-02_r8,4.6117e-02_r8,9.0846e-02_r8,1.3398e-01_r8,1.7452e-01_r8,2.1037e-01_r8, & + &2.3630e-01_r8,2.3518e-01_r8,3.4867e-01_r8/) + kao(:, 4, 1,14) = (/ & + &1.1308e-02_r8,4.5919e-02_r8,9.0260e-02_r8,1.3312e-01_r8,1.7345e-01_r8,2.0914e-01_r8, & + &2.3511e-01_r8,2.3456e-01_r8,3.4647e-01_r8/) + kao(:, 5, 1,14) = (/ & + &1.1074e-02_r8,4.5680e-02_r8,8.9686e-02_r8,1.3217e-01_r8,1.7213e-01_r8,2.0750e-01_r8, & + &2.3330e-01_r8,2.3291e-01_r8,3.4372e-01_r8/) + kao(:, 1, 2,14) = (/ & + &1.9894e-02_r8,5.5751e-02_r8,1.1015e-01_r8,1.6336e-01_r8,2.1450e-01_r8,2.6180e-01_r8, & + &3.0044e-01_r8,3.1221e-01_r8,4.2855e-01_r8/) + kao(:, 2, 2,14) = (/ & + &1.9495e-02_r8,5.5076e-02_r8,1.0879e-01_r8,1.6130e-01_r8,2.1180e-01_r8,2.5853e-01_r8, & + &2.9678e-01_r8,3.0859e-01_r8,4.2309e-01_r8/) + kao(:, 3, 2,14) = (/ & + &1.9117e-02_r8,5.4639e-02_r8,1.0781e-01_r8,1.5983e-01_r8,2.0983e-01_r8,2.5605e-01_r8, & + &2.9379e-01_r8,3.0533e-01_r8,4.1905e-01_r8/) + kao(:, 4, 2,14) = (/ & + &1.8729e-02_r8,5.4397e-02_r8,1.0705e-01_r8,1.5861e-01_r8,2.0822e-01_r8,2.5408e-01_r8, & + &2.9159e-01_r8,3.0324e-01_r8,4.1584e-01_r8/) + kao(:, 5, 2,14) = (/ & + &1.8354e-02_r8,5.4135e-02_r8,1.0645e-01_r8,1.5762e-01_r8,2.0683e-01_r8,2.5235e-01_r8, & + &2.8960e-01_r8,3.0120e-01_r8,4.1280e-01_r8/) + kao(:, 1, 3,14) = (/ & + &4.4808e-02_r8,6.8120e-02_r8,1.3030e-01_r8,1.9402e-01_r8,2.5661e-01_r8,3.1701e-01_r8, & + &3.7210e-01_r8,4.0841e-01_r8,5.1219e-01_r8/) + kao(:, 2, 3,14) = (/ & + &4.3894e-02_r8,6.7026e-02_r8,1.2859e-01_r8,1.9144e-01_r8,2.5317e-01_r8,3.1271e-01_r8, & + &3.6711e-01_r8,4.0328e-01_r8,5.0524e-01_r8/) + kao(:, 3, 3,14) = (/ & + &4.3009e-02_r8,6.6189e-02_r8,1.2745e-01_r8,1.8969e-01_r8,2.5081e-01_r8,3.0975e-01_r8, & + &3.6348e-01_r8,3.9877e-01_r8,5.0039e-01_r8/) + kao(:, 4, 3,14) = (/ & + &4.2131e-02_r8,6.5604e-02_r8,1.2666e-01_r8,1.8820e-01_r8,2.4871e-01_r8,3.0709e-01_r8, & + &3.6038e-01_r8,3.9547e-01_r8,4.9608e-01_r8/) + kao(:, 5, 3,14) = (/ & + &4.1300e-02_r8,6.4954e-02_r8,1.2597e-01_r8,1.8706e-01_r8,2.4708e-01_r8,3.0499e-01_r8, & + &3.5781e-01_r8,3.9252e-01_r8,4.9231e-01_r8/) + kao(:, 1, 4,14) = (/ & + &1.0301e-01_r8,1.0024e-01_r8,1.5513e-01_r8,2.2660e-01_r8,3.0051e-01_r8,3.7330e-01_r8, & + &4.4331e-01_r8,5.0277e-01_r8,5.9886e-01_r8/) + kao(:, 2, 4,14) = (/ & + &1.0093e-01_r8,9.7693e-02_r8,1.5244e-01_r8,2.2368e-01_r8,2.9661e-01_r8,3.6838e-01_r8, & + &4.3740e-01_r8,4.9600e-01_r8,5.9091e-01_r8/) + kao(:, 3, 4,14) = (/ & + &9.8888e-02_r8,9.5814e-02_r8,1.5056e-01_r8,2.2160e-01_r8,2.9368e-01_r8,3.6475e-01_r8, & + &4.3305e-01_r8,4.9087e-01_r8,5.8504e-01_r8/) + kao(:, 4, 4,14) = (/ & + &9.6900e-02_r8,9.4385e-02_r8,1.4923e-01_r8,2.1998e-01_r8,2.9118e-01_r8,3.6134e-01_r8, & + &4.2884e-01_r8,4.8615e-01_r8,5.7910e-01_r8/) + kao(:, 5, 4,14) = (/ & + &9.5071e-02_r8,9.3054e-02_r8,1.4811e-01_r8,2.1854e-01_r8,2.8905e-01_r8,3.5852e-01_r8, & + &4.2539e-01_r8,4.8206e-01_r8,5.7407e-01_r8/) + kao(:, 1, 5,14) = (/ & + &2.1660e-01_r8,1.9045e-01_r8,2.0807e-01_r8,2.6919e-01_r8,3.4511e-01_r8,4.2945e-01_r8, & + &5.1231e-01_r8,5.8951e-01_r8,6.8618e-01_r8/) + kao(:, 2, 5,14) = (/ & + &2.1241e-01_r8,1.8672e-01_r8,2.0475e-01_r8,2.6424e-01_r8,3.4065e-01_r8,4.2384e-01_r8, & + &5.0554e-01_r8,5.8155e-01_r8,6.7701e-01_r8/) + kao(:, 3, 5,14) = (/ & + &2.0837e-01_r8,1.8314e-01_r8,2.0195e-01_r8,2.6053e-01_r8,3.3744e-01_r8,4.1942e-01_r8, & + &5.0021e-01_r8,5.7551e-01_r8,6.6986e-01_r8/) + kao(:, 4, 5,14) = (/ & + &2.0430e-01_r8,1.7971e-01_r8,1.9948e-01_r8,2.5756e-01_r8,3.3465e-01_r8,4.1558e-01_r8, & + &4.9517e-01_r8,5.6937e-01_r8,6.6243e-01_r8/) + kao(:, 5, 5,14) = (/ & + &2.0042e-01_r8,1.7656e-01_r8,1.9774e-01_r8,2.5482e-01_r8,3.3186e-01_r8,4.1183e-01_r8, & + &4.9052e-01_r8,5.6389e-01_r8,6.5569e-01_r8/) + kao(:, 1, 6,14) = (/ & + &4.2427e-01_r8,3.7203e-01_r8,3.3320e-01_r8,3.5686e-01_r8,4.1154e-01_r8,4.8492e-01_r8, & + &5.7932e-01_r8,6.7077e-01_r8,7.7255e-01_r8/) + kao(:, 2, 6,14) = (/ & + &4.1690e-01_r8,3.6557e-01_r8,3.2503e-01_r8,3.5212e-01_r8,4.0345e-01_r8,4.7827e-01_r8, & + &5.7140e-01_r8,6.6143e-01_r8,7.6181e-01_r8/) + kao(:, 3, 6,14) = (/ & + &4.0958e-01_r8,3.5909e-01_r8,3.1787e-01_r8,3.4706e-01_r8,3.9704e-01_r8,4.7318e-01_r8, & + &5.6463e-01_r8,6.5338e-01_r8,7.5243e-01_r8/) + kao(:, 4, 6,14) = (/ & + &4.0201e-01_r8,3.5239e-01_r8,3.1191e-01_r8,3.4259e-01_r8,3.9161e-01_r8,4.6839e-01_r8, & + &5.5839e-01_r8,6.4570e-01_r8,7.4289e-01_r8/) + kao(:, 5, 6,14) = (/ & + &3.9475e-01_r8,3.4591e-01_r8,3.0639e-01_r8,3.3917e-01_r8,3.8642e-01_r8,4.6363e-01_r8, & + &5.5236e-01_r8,6.3841e-01_r8,7.3426e-01_r8/) + kao(:, 1, 7,14) = (/ & + &8.8029e-01_r8,7.7094e-01_r8,6.6160e-01_r8,5.8339e-01_r8,5.7398e-01_r8,5.9529e-01_r8, & + &6.4618e-01_r8,7.4819e-01_r8,8.5701e-01_r8/) + kao(:, 2, 7,14) = (/ & + &8.6525e-01_r8,7.5771e-01_r8,6.5024e-01_r8,5.6937e-01_r8,5.6534e-01_r8,5.8297e-01_r8, & + &6.3577e-01_r8,7.3677e-01_r8,8.4377e-01_r8/) + kao(:, 3, 7,14) = (/ & + &8.5121e-01_r8,7.4536e-01_r8,6.3948e-01_r8,5.5760e-01_r8,5.5733e-01_r8,5.7172e-01_r8, & + &6.2728e-01_r8,7.2631e-01_r8,8.3134e-01_r8/) + kao(:, 4, 7,14) = (/ & + &8.3673e-01_r8,7.3261e-01_r8,6.2850e-01_r8,5.4720e-01_r8,5.4987e-01_r8,5.6219e-01_r8, & + &6.1953e-01_r8,7.1698e-01_r8,8.1995e-01_r8/) + kao(:, 5, 7,14) = (/ & + &8.2233e-01_r8,7.1991e-01_r8,6.1754e-01_r8,5.3796e-01_r8,5.4354e-01_r8,5.5330e-01_r8, & + &6.1303e-01_r8,7.0902e-01_r8,8.1040e-01_r8/) + kao(:, 1, 8,14) = (/ & + &2.1633e+00_r8,1.8933e+00_r8,1.6233e+00_r8,1.3534e+00_r8,1.1037e+00_r8,9.5036e-01_r8, & + &8.5982e-01_r8,8.2829e-01_r8,9.4205e-01_r8/) + kao(:, 2, 8,14) = (/ & + &2.1282e+00_r8,1.8626e+00_r8,1.5970e+00_r8,1.3314e+00_r8,1.0818e+00_r8,9.3527e-01_r8, & + &8.4498e-01_r8,8.1322e-01_r8,9.2537e-01_r8/) + kao(:, 3, 8,14) = (/ & + &2.0953e+00_r8,1.8337e+00_r8,1.5723e+00_r8,1.3107e+00_r8,1.0621e+00_r8,9.2114e-01_r8, & + &8.2743e-01_r8,8.0051e-01_r8,9.1039e-01_r8/) + kao(:, 4, 8,14) = (/ & + &2.0607e+00_r8,1.8035e+00_r8,1.5462e+00_r8,1.2890e+00_r8,1.0433e+00_r8,9.0766e-01_r8, & + &8.1242e-01_r8,7.8938e-01_r8,8.9703e-01_r8/) + kao(:, 5, 8,14) = (/ & + &2.0272e+00_r8,1.7741e+00_r8,1.5210e+00_r8,1.2680e+00_r8,1.0246e+00_r8,8.9475e-01_r8, & + &7.9856e-01_r8,7.8051e-01_r8,8.8639e-01_r8/) + kao(:, 1, 9,14) = (/ & + &1.0073e+01_r8,8.8141e+00_r8,7.5553e+00_r8,6.2968e+00_r8,5.0379e+00_r8,3.7790e+00_r8, & + &2.5252e+00_r8,1.5121e+00_r8,1.0239e+00_r8/) + kao(:, 2, 9,14) = (/ & + &9.9292e+00_r8,8.6881e+00_r8,7.4471e+00_r8,6.2062e+00_r8,4.9656e+00_r8,3.7249e+00_r8, & + &2.4866e+00_r8,1.4902e+00_r8,1.0036e+00_r8/) + kao(:, 3, 9,14) = (/ & + &9.7859e+00_r8,8.5628e+00_r8,7.3398e+00_r8,6.1169e+00_r8,4.8940e+00_r8,3.6711e+00_r8, & + &2.4492e+00_r8,1.4699e+00_r8,9.8554e-01_r8/) + kao(:, 4, 9,14) = (/ & + &9.6386e+00_r8,8.4340e+00_r8,7.2293e+00_r8,6.0249e+00_r8,4.8203e+00_r8,3.6156e+00_r8, & + &2.4114e+00_r8,1.4506e+00_r8,9.7113e-01_r8/) + kao(:, 5, 9,14) = (/ & + &9.4939e+00_r8,8.3072e+00_r8,7.1206e+00_r8,5.9343e+00_r8,4.7478e+00_r8,3.5614e+00_r8, & + &2.3752e+00_r8,1.4305e+00_r8,9.6050e-01_r8/) + kao(:, 1,10,14) = (/ & + &5.2612e+01_r8,4.6036e+01_r8,3.9459e+01_r8,3.2882e+01_r8,2.6307e+01_r8,1.9730e+01_r8, & + &1.3154e+01_r8,6.5782e+00_r8,1.1007e+00_r8/) + kao(:, 2,10,14) = (/ & + &5.2045e+01_r8,4.5541e+01_r8,3.9035e+01_r8,3.2530e+01_r8,2.6024e+01_r8,1.9518e+01_r8, & + &1.3013e+01_r8,6.5076e+00_r8,1.0772e+00_r8/) + kao(:, 3,10,14) = (/ & + &5.1396e+01_r8,4.4972e+01_r8,3.8548e+01_r8,3.2123e+01_r8,2.5700e+01_r8,1.9274e+01_r8, & + &1.2851e+01_r8,6.4259e+00_r8,1.0576e+00_r8/) + kao(:, 4,10,14) = (/ & + &5.0681e+01_r8,4.4348e+01_r8,3.8014e+01_r8,3.1677e+01_r8,2.5342e+01_r8,1.9007e+01_r8, & + &1.2671e+01_r8,6.3366e+00_r8,1.0433e+00_r8/) + kao(:, 5,10,14) = (/ & + &4.9909e+01_r8,4.3671e+01_r8,3.7433e+01_r8,3.1194e+01_r8,2.4957e+01_r8,1.8717e+01_r8, & + &1.2479e+01_r8,6.2406e+00_r8,1.0315e+00_r8/) + kao(:, 1,11,14) = (/ & + &9.5447e+01_r8,8.3519e+01_r8,7.1586e+01_r8,5.9654e+01_r8,4.7724e+01_r8,3.5792e+01_r8, & + &2.3862e+01_r8,1.1932e+01_r8,1.1580e+00_r8/) + kao(:, 2,11,14) = (/ & + &9.4633e+01_r8,8.2803e+01_r8,7.0974e+01_r8,5.9145e+01_r8,4.7317e+01_r8,3.5487e+01_r8, & + &2.3658e+01_r8,1.1830e+01_r8,1.1359e+00_r8/) + kao(:, 3,11,14) = (/ & + &9.3512e+01_r8,8.1822e+01_r8,7.0137e+01_r8,5.8447e+01_r8,4.6756e+01_r8,3.5068e+01_r8, & + &2.3379e+01_r8,1.1690e+01_r8,1.1191e+00_r8/) + kao(:, 4,11,14) = (/ & + &9.1943e+01_r8,8.0451e+01_r8,6.8957e+01_r8,5.7463e+01_r8,4.5972e+01_r8,3.4478e+01_r8, & + &2.2985e+01_r8,1.1494e+01_r8,1.1048e+00_r8/) + kao(:, 5,11,14) = (/ & + &9.0366e+01_r8,7.9072e+01_r8,6.7775e+01_r8,5.6480e+01_r8,4.5183e+01_r8,3.3888e+01_r8, & + &2.2593e+01_r8,1.1297e+01_r8,1.0941e+00_r8/) + kao(:, 1,12,14) = (/ & + &1.2829e+02_r8,1.1225e+02_r8,9.6218e+01_r8,8.0178e+01_r8,6.4148e+01_r8,4.8109e+01_r8, & + &3.2071e+01_r8,1.6037e+01_r8,1.2082e+00_r8/) + kao(:, 2,12,14) = (/ & + &1.2686e+02_r8,1.1100e+02_r8,9.5144e+01_r8,7.9288e+01_r8,6.3431e+01_r8,4.7572e+01_r8, & + &3.1716e+01_r8,1.5858e+01_r8,1.1882e+00_r8/) + kao(:, 3,12,14) = (/ & + &1.2492e+02_r8,1.0930e+02_r8,9.3686e+01_r8,7.8073e+01_r8,6.2461e+01_r8,4.6846e+01_r8, & + &3.1229e+01_r8,1.5615e+01_r8,1.1735e+00_r8/) + kao(:, 4,12,14) = (/ & + &1.2277e+02_r8,1.0742e+02_r8,9.2079e+01_r8,7.6735e+01_r8,6.1388e+01_r8,4.6041e+01_r8, & + &3.0695e+01_r8,1.5349e+01_r8,1.1628e+00_r8/) + kao(:, 5,12,14) = (/ & + &1.2083e+02_r8,1.0573e+02_r8,9.0624e+01_r8,7.5519e+01_r8,6.0418e+01_r8,4.5314e+01_r8, & + &3.0211e+01_r8,1.5107e+01_r8,1.1538e+00_r8/) + kao(:, 1,13,14) = (/ & + &1.3638e+02_r8,1.1933e+02_r8,1.0229e+02_r8,8.5232e+01_r8,6.8189e+01_r8,5.1142e+01_r8, & + &3.4096e+01_r8,1.7048e+01_r8,1.2383e+00_r8/) + kao(:, 2,13,14) = (/ & + &1.3472e+02_r8,1.1788e+02_r8,1.0104e+02_r8,8.4200e+01_r8,6.7359e+01_r8,5.0520e+01_r8, & + &3.3681e+01_r8,1.6841e+01_r8,1.2326e+00_r8/) + kao(:, 3,13,14) = (/ & + &1.3259e+02_r8,1.1602e+02_r8,9.9447e+01_r8,8.2873e+01_r8,6.6300e+01_r8,4.9725e+01_r8, & + &3.3151e+01_r8,1.6576e+01_r8,1.2214e+00_r8/) + kao(:, 4,13,14) = (/ & + &1.3062e+02_r8,1.1429e+02_r8,9.7966e+01_r8,8.1640e+01_r8,6.5311e+01_r8,4.8985e+01_r8, & + &3.2658e+01_r8,1.6329e+01_r8,1.2124e+00_r8/) + kao(:, 5,13,14) = (/ & + &1.2869e+02_r8,1.1261e+02_r8,9.6524e+01_r8,8.0437e+01_r8,6.4351e+01_r8,4.8263e+01_r8, & + &3.2178e+01_r8,1.6090e+01_r8,1.2063e+00_r8/) + kao(:, 1, 1,15) = (/ & + &1.6224e-02_r8,5.5981e-02_r8,1.1058e-01_r8,1.6311e-01_r8,2.1224e-01_r8,2.5534e-01_r8, & + &2.8563e-01_r8,2.8102e-01_r8,4.2449e-01_r8/) + kao(:, 2, 1,15) = (/ & + &1.5819e-02_r8,5.4235e-02_r8,1.0708e-01_r8,1.5789e-01_r8,2.0538e-01_r8,2.4690e-01_r8, & + &2.7600e-01_r8,2.7172e-01_r8,4.1075e-01_r8/) + kao(:, 3, 1,15) = (/ & + &1.5437e-02_r8,5.3030e-02_r8,1.0453e-01_r8,1.5410e-01_r8,2.0034e-01_r8,2.4064e-01_r8, & + &2.6869e-01_r8,2.6394e-01_r8,4.0067e-01_r8/) + kao(:, 4, 1,15) = (/ & + &1.5047e-02_r8,5.2309e-02_r8,1.0294e-01_r8,1.5163e-01_r8,1.9708e-01_r8,2.3671e-01_r8, & + &2.6420e-01_r8,2.5937e-01_r8,3.9409e-01_r8/) + kao(:, 5, 1,15) = (/ & + &1.4670e-02_r8,5.2264e-02_r8,1.0263e-01_r8,1.5109e-01_r8,1.9635e-01_r8,2.3592e-01_r8, & + &2.6369e-01_r8,2.6037e-01_r8,3.9232e-01_r8/) + kao(:, 1, 2,15) = (/ & + &2.7874e-02_r8,6.8016e-02_r8,1.3490e-01_r8,2.0013e-01_r8,2.6255e-01_r8,3.1976e-01_r8, & + &3.6546e-01_r8,3.7626e-01_r8,5.2506e-01_r8/) + kao(:, 2, 2,15) = (/ & + &2.7188e-02_r8,6.5949e-02_r8,1.3068e-01_r8,1.9379e-01_r8,2.5414e-01_r8,3.0936e-01_r8, & + &3.5322e-01_r8,3.6307e-01_r8,5.0826e-01_r8/) + kao(:, 3, 2,15) = (/ & + &2.6530e-02_r8,6.4457e-02_r8,1.2748e-01_r8,1.8895e-01_r8,2.4773e-01_r8,3.0143e-01_r8, & + &3.4397e-01_r8,3.5278e-01_r8,4.9544e-01_r8/) + kao(:, 4, 2,15) = (/ & + &2.5866e-02_r8,6.3478e-02_r8,1.2538e-01_r8,1.8573e-01_r8,2.4341e-01_r8,2.9608e-01_r8, & + &3.3770e-01_r8,3.4604e-01_r8,4.8658e-01_r8/) + kao(:, 5, 2,15) = (/ & + &2.5184e-02_r8,6.3069e-02_r8,1.2422e-01_r8,1.8387e-01_r8,2.4089e-01_r8,2.9292e-01_r8, & + &3.3402e-01_r8,3.4222e-01_r8,4.8125e-01_r8/) + kao(:, 1, 3,15) = (/ & + &6.4680e-02_r8,8.3094e-02_r8,1.6505e-01_r8,2.4624e-01_r8,3.2572e-01_r8,4.0189e-01_r8, & + &4.7033e-01_r8,5.1238e-01_r8,6.5139e-01_r8/) + kao(:, 2, 3,15) = (/ & + &6.3121e-02_r8,8.0680e-02_r8,1.6005e-01_r8,2.3872e-01_r8,3.1571e-01_r8,3.8944e-01_r8, & + &4.5551e-01_r8,4.9522e-01_r8,6.3135e-01_r8/) + kao(:, 3, 3,15) = (/ & + &6.1563e-02_r8,7.8867e-02_r8,1.5612e-01_r8,2.3258e-01_r8,3.0746e-01_r8,3.7914e-01_r8, & + &4.4323e-01_r8,4.8117e-01_r8,6.1483e-01_r8/) + kao(:, 4, 3,15) = (/ & + &6.0025e-02_r8,7.7639e-02_r8,1.5328e-01_r8,2.2820e-01_r8,3.0153e-01_r8,3.7164e-01_r8, & + &4.3426e-01_r8,4.7103e-01_r8,6.0254e-01_r8/) + kao(:, 5, 3,15) = (/ & + &5.8411e-02_r8,7.7256e-02_r8,1.5120e-01_r8,2.2490e-01_r8,2.9704e-01_r8,3.6599e-01_r8, & + &4.2759e-01_r8,4.6376e-01_r8,5.9316e-01_r8/) + kao(:, 1, 4,15) = (/ & + &1.5257e-01_r8,1.3544e-01_r8,2.0077e-01_r8,3.0036e-01_r8,3.9895e-01_r8,4.9562e-01_r8, & + &5.8758e-01_r8,6.6215e-01_r8,7.9779e-01_r8/) + kao(:, 2, 4,15) = (/ & + &1.4896e-01_r8,1.3204e-01_r8,1.9507e-01_r8,2.9140e-01_r8,3.8695e-01_r8,4.8067e-01_r8, & + &5.6978e-01_r8,6.4163e-01_r8,7.7379e-01_r8/) + kao(:, 3, 4,15) = (/ & + &1.4526e-01_r8,1.2874e-01_r8,1.9046e-01_r8,2.8415e-01_r8,3.7702e-01_r8,4.6809e-01_r8, & + &5.5459e-01_r8,6.2416e-01_r8,7.5329e-01_r8/) + kao(:, 4, 4,15) = (/ & + &1.4150e-01_r8,1.2551e-01_r8,1.8699e-01_r8,2.7869e-01_r8,3.6960e-01_r8,4.5869e-01_r8, & + &5.4325e-01_r8,6.1092e-01_r8,7.3794e-01_r8/) + kao(:, 5, 4,15) = (/ & + &1.3788e-01_r8,1.2292e-01_r8,1.8424e-01_r8,2.7423e-01_r8,3.6354e-01_r8,4.5105e-01_r8, & + &5.3408e-01_r8,6.0044e-01_r8,7.2537e-01_r8/) + kao(:, 1, 5,15) = (/ & + &3.2844e-01_r8,2.8856e-01_r8,2.7979e-01_r8,3.6340e-01_r8,4.8359e-01_r8,6.0259e-01_r8, & + &7.1867e-01_r8,8.2355e-01_r8,9.6702e-01_r8/) + kao(:, 2, 5,15) = (/ & + &3.2063e-01_r8,2.8155e-01_r8,2.6962e-01_r8,3.5320e-01_r8,4.6960e-01_r8,5.8494e-01_r8, & + &6.9755e-01_r8,7.9908e-01_r8,9.3875e-01_r8/) + kao(:, 3, 5,15) = (/ & + &3.1261e-01_r8,2.7434e-01_r8,2.6034e-01_r8,3.4461e-01_r8,4.5775e-01_r8,5.6986e-01_r8, & + &6.7919e-01_r8,7.7764e-01_r8,9.1375e-01_r8/) + kao(:, 4, 5,15) = (/ & + &3.0440e-01_r8,2.6704e-01_r8,2.5252e-01_r8,3.3787e-01_r8,4.4841e-01_r8,5.5807e-01_r8, & + &6.6481e-01_r8,7.6089e-01_r8,8.9431e-01_r8/) + kao(:, 5, 5,15) = (/ & + &2.9686e-01_r8,2.6035e-01_r8,2.4591e-01_r8,3.3225e-01_r8,4.4072e-01_r8,5.4821e-01_r8, & + &6.5299e-01_r8,7.4709e-01_r8,8.7822e-01_r8/) + kao(:, 1, 6,15) = (/ & + &6.6195e-01_r8,5.8013e-01_r8,4.9831e-01_r8,4.9605e-01_r8,5.8178e-01_r8,7.2595e-01_r8, & + &8.6836e-01_r8,1.0033e+00_r8,1.1633e+00_r8/) + kao(:, 2, 6,15) = (/ & + &6.4501e-01_r8,5.6519e-01_r8,4.8535e-01_r8,4.7586e-01_r8,5.6606e-01_r8,7.0584e-01_r8, & + &8.4395e-01_r8,9.7492e-01_r8,1.1306e+00_r8/) + kao(:, 3, 6,15) = (/ & + &6.2808e-01_r8,5.5020e-01_r8,4.7240e-01_r8,4.5801e-01_r8,5.5243e-01_r8,6.8837e-01_r8, & + &8.2269e-01_r8,9.4987e-01_r8,1.1015e+00_r8/) + kao(:, 4, 6,15) = (/ & + &6.1101e-01_r8,5.3520e-01_r8,4.5941e-01_r8,4.4278e-01_r8,5.4121e-01_r8,6.7408e-01_r8, & + &8.0538e-01_r8,9.2955e-01_r8,1.0781e+00_r8/) + kao(:, 5, 6,15) = (/ & + &5.9524e-01_r8,5.2132e-01_r8,4.4745e-01_r8,4.2965e-01_r8,5.3187e-01_r8,6.6218e-01_r8, & + &7.9084e-01_r8,9.1257e-01_r8,1.0584e+00_r8/) + kao(:, 1, 7,15) = (/ & + &1.4144e+00_r8,1.2384e+00_r8,1.0623e+00_r8,8.8626e-01_r8,8.1737e-01_r8,8.6950e-01_r8, & + &1.0395e+00_r8,1.2069e+00_r8,1.3892e+00_r8/) + kao(:, 2, 7,15) = (/ & + &1.3748e+00_r8,1.2036e+00_r8,1.0323e+00_r8,8.6117e-01_r8,7.8383e-01_r8,8.4592e-01_r8, & + &1.0122e+00_r8,1.1745e+00_r8,1.3519e+00_r8/) + kao(:, 3, 7,15) = (/ & + &1.3356e+00_r8,1.1692e+00_r8,1.0028e+00_r8,8.3643e-01_r8,7.5357e-01_r8,8.2575e-01_r8, & + &9.8798e-01_r8,1.1461e+00_r8,1.3189e+00_r8/) + kao(:, 4, 7,15) = (/ & + &1.2972e+00_r8,1.1356e+00_r8,9.7391e-01_r8,8.1222e-01_r8,7.2715e-01_r8,8.0916e-01_r8, & + &9.6777e-01_r8,1.1223e+00_r8,1.2914e+00_r8/) + kao(:, 5, 7,15) = (/ & + &1.2621e+00_r8,1.1049e+00_r8,9.4752e-01_r8,7.9014e-01_r8,7.0399e-01_r8,7.9481e-01_r8, & + &9.5022e-01_r8,1.1017e+00_r8,1.2675e+00_r8/) + kao(:, 1, 8,15) = (/ & + &3.5678e+00_r8,3.1226e+00_r8,2.6774e+00_r8,2.2323e+00_r8,1.7871e+00_r8,1.4068e+00_r8, & + &1.2751e+00_r8,1.4347e+00_r8,1.6442e+00_r8/) + kao(:, 2, 8,15) = (/ & + &3.4620e+00_r8,3.0298e+00_r8,2.5977e+00_r8,2.1657e+00_r8,1.7337e+00_r8,1.3525e+00_r8, & + &1.2330e+00_r8,1.4002e+00_r8,1.6038e+00_r8/) + kao(:, 3, 8,15) = (/ & + &3.3581e+00_r8,2.9387e+00_r8,2.5197e+00_r8,2.1005e+00_r8,1.6813e+00_r8,1.3030e+00_r8, & + &1.1987e+00_r8,1.3683e+00_r8,1.5668e+00_r8/) + kao(:, 4, 8,15) = (/ & + &3.2581e+00_r8,2.8514e+00_r8,2.4446e+00_r8,2.0378e+00_r8,1.6310e+00_r8,1.2580e+00_r8, & + &1.1700e+00_r8,1.3407e+00_r8,1.5349e+00_r8/) + kao(:, 5, 8,15) = (/ & + &3.1664e+00_r8,2.7709e+00_r8,2.3756e+00_r8,1.9802e+00_r8,1.5848e+00_r8,1.2171e+00_r8, & + &1.1461e+00_r8,1.3159e+00_r8,1.5061e+00_r8/) + kao(:, 1, 9,15) = (/ & + &1.6997e+01_r8,1.4874e+01_r8,1.2750e+01_r8,1.0625e+01_r8,8.5017e+00_r8,6.3777e+00_r8, & + &4.2536e+00_r8,2.2902e+00_r8,1.9313e+00_r8/) + kao(:, 2, 9,15) = (/ & + &1.6471e+01_r8,1.4414e+01_r8,1.2355e+01_r8,1.0296e+01_r8,8.2389e+00_r8,6.1803e+00_r8, & + &4.1219e+00_r8,2.1942e+00_r8,1.8874e+00_r8/) + kao(:, 3, 9,15) = (/ & + &1.5959e+01_r8,1.3964e+01_r8,1.1970e+01_r8,9.9759e+00_r8,7.9817e+00_r8,5.9872e+00_r8, & + &3.9932e+00_r8,2.1070e+00_r8,1.8460e+00_r8/) + kao(:, 4, 9,15) = (/ & + &1.5470e+01_r8,1.3538e+01_r8,1.1604e+01_r8,9.6708e+00_r8,7.7374e+00_r8,5.8040e+00_r8, & + &3.8707e+00_r8,2.0267e+00_r8,1.8089e+00_r8/) + kao(:, 5, 9,15) = (/ & + &1.5020e+01_r8,1.3143e+01_r8,1.1265e+01_r8,9.3885e+00_r8,7.5114e+00_r8,5.6345e+00_r8, & + &3.7577e+00_r8,1.9548e+00_r8,1.7742e+00_r8/) + kao(:, 1,10,15) = (/ & + &9.0636e+01_r8,7.9307e+01_r8,6.7977e+01_r8,5.6649e+01_r8,4.5320e+01_r8,3.3991e+01_r8, & + &2.2662e+01_r8,1.1334e+01_r8,2.2438e+00_r8/) + kao(:, 2,10,15) = (/ & + &8.7565e+01_r8,7.6621e+01_r8,6.5675e+01_r8,5.4728e+01_r8,4.3786e+01_r8,3.2842e+01_r8, & + &2.1895e+01_r8,1.0950e+01_r8,2.1955e+00_r8/) + kao(:, 3,10,15) = (/ & + &8.4686e+01_r8,7.4100e+01_r8,6.3516e+01_r8,5.2929e+01_r8,4.2345e+01_r8,3.1759e+01_r8, & + &2.1174e+01_r8,1.0590e+01_r8,2.1489e+00_r8/) + kao(:, 4,10,15) = (/ & + &8.2038e+01_r8,7.1783e+01_r8,6.1529e+01_r8,5.1276e+01_r8,4.1020e+01_r8,3.0766e+01_r8, & + &2.0512e+01_r8,1.0258e+01_r8,2.1057e+00_r8/) + kao(:, 5,10,15) = (/ & + &7.9656e+01_r8,6.9701e+01_r8,5.9744e+01_r8,4.9787e+01_r8,3.9829e+01_r8,2.9874e+01_r8, & + &1.9917e+01_r8,9.9593e+00_r8,2.0648e+00_r8/) + kao(:, 1,11,15) = (/ & + &1.6605e+02_r8,1.4529e+02_r8,1.2455e+02_r8,1.0378e+02_r8,8.3029e+01_r8,6.2280e+01_r8, & + &4.1517e+01_r8,2.0760e+01_r8,2.5530e+00_r8/) + kao(:, 2,11,15) = (/ & + &1.6006e+02_r8,1.4006e+02_r8,1.2005e+02_r8,1.0004e+02_r8,8.0031e+01_r8,6.0027e+01_r8, & + &4.0019e+01_r8,2.0011e+01_r8,2.4994e+00_r8/) + kao(:, 3,11,15) = (/ & + &1.5475e+02_r8,1.3539e+02_r8,1.1606e+02_r8,9.6709e+01_r8,7.7371e+01_r8,5.8029e+01_r8, & + &3.8687e+01_r8,1.9345e+01_r8,2.4484e+00_r8/) + kao(:, 4,11,15) = (/ & + &1.5058e+02_r8,1.3176e+02_r8,1.1294e+02_r8,9.4118e+01_r8,7.5292e+01_r8,5.6471e+01_r8, & + &3.7649e+01_r8,1.8825e+01_r8,2.4006e+00_r8/) + kao(:, 5,11,15) = (/ & + &1.4680e+02_r8,1.2845e+02_r8,1.1009e+02_r8,9.1748e+01_r8,7.3399e+01_r8,5.5050e+01_r8, & + &3.6700e+01_r8,1.8351e+01_r8,2.3540e+00_r8/) + kao(:, 1,12,15) = (/ & + &2.2602e+02_r8,1.9778e+02_r8,1.6953e+02_r8,1.4127e+02_r8,1.1301e+02_r8,8.4757e+01_r8, & + &5.6507e+01_r8,2.8257e+01_r8,2.8716e+00_r8/) + kao(:, 2,12,15) = (/ & + &2.1869e+02_r8,1.9135e+02_r8,1.6402e+02_r8,1.3669e+02_r8,1.0935e+02_r8,8.2013e+01_r8, & + &5.4674e+01_r8,2.7339e+01_r8,2.8132e+00_r8/) + kao(:, 3,12,15) = (/ & + &2.1253e+02_r8,1.8597e+02_r8,1.5940e+02_r8,1.3282e+02_r8,1.0626e+02_r8,7.9692e+01_r8, & + &5.3134e+01_r8,2.6567e+01_r8,2.7573e+00_r8/) + kao(:, 4,12,15) = (/ & + &2.0725e+02_r8,1.8134e+02_r8,1.5543e+02_r8,1.2952e+02_r8,1.0362e+02_r8,7.7720e+01_r8, & + &5.1811e+01_r8,2.5907e+01_r8,2.7022e+00_r8/) + kao(:, 5,12,15) = (/ & + &2.0216e+02_r8,1.7690e+02_r8,1.5162e+02_r8,1.2635e+02_r8,1.0108e+02_r8,7.5810e+01_r8, & + &5.0540e+01_r8,2.5271e+01_r8,2.6508e+00_r8/) + kao(:, 1,13,15) = (/ & + &2.4880e+02_r8,2.1770e+02_r8,1.8661e+02_r8,1.5550e+02_r8,1.2440e+02_r8,9.3305e+01_r8, & + &6.2205e+01_r8,3.1105e+01_r8,3.1971e+00_r8/) + kao(:, 2,13,15) = (/ & + &2.4131e+02_r8,2.1114e+02_r8,1.8097e+02_r8,1.5081e+02_r8,1.2065e+02_r8,9.0483e+01_r8, & + &6.0327e+01_r8,3.0165e+01_r8,3.1338e+00_r8/) + kao(:, 3,13,15) = (/ & + &2.3499e+02_r8,2.0562e+02_r8,1.7624e+02_r8,1.4687e+02_r8,1.1750e+02_r8,8.8123e+01_r8, & + &5.8749e+01_r8,2.9377e+01_r8,3.0697e+00_r8/) + kao(:, 4,13,15) = (/ & + &2.2900e+02_r8,2.0038e+02_r8,1.7175e+02_r8,1.4313e+02_r8,1.1451e+02_r8,8.5878e+01_r8, & + &5.7253e+01_r8,2.8627e+01_r8,3.0070e+00_r8/) + kao(:, 5,13,15) = (/ & + &2.2306e+02_r8,1.9518e+02_r8,1.6729e+02_r8,1.3941e+02_r8,1.1152e+02_r8,8.3649e+01_r8, & + &5.5766e+01_r8,2.7883e+01_r8,2.9481e+00_r8/) + kao(:, 1, 1,16) = (/ & + &1.9445e-02_r8,6.3230e-02_r8,1.2479e-01_r8,1.8384e-01_r8,2.3882e-01_r8,2.8643e-01_r8, & + &3.1893e-01_r8,3.1112e-01_r8,4.7763e-01_r8/) + kao(:, 2, 1,16) = (/ & + &1.8835e-02_r8,6.2634e-02_r8,1.2363e-01_r8,1.8213e-01_r8,2.3659e-01_r8,2.8379e-01_r8, & + &3.1600e-01_r8,3.0828e-01_r8,4.7319e-01_r8/) + kao(:, 3, 1,16) = (/ & + &1.8228e-02_r8,6.1941e-02_r8,1.2224e-01_r8,1.8013e-01_r8,2.3399e-01_r8,2.8070e-01_r8, & + &3.1257e-01_r8,3.0493e-01_r8,4.6798e-01_r8/) + kao(:, 4, 1,16) = (/ & + &1.7647e-02_r8,6.1170e-02_r8,1.2073e-01_r8,1.7790e-01_r8,2.3107e-01_r8,2.7723e-01_r8, & + &3.0877e-01_r8,3.0124e-01_r8,4.6215e-01_r8/) + kao(:, 5, 1,16) = (/ & + &1.7079e-02_r8,6.0350e-02_r8,1.1912e-01_r8,1.7548e-01_r8,2.2801e-01_r8,2.7357e-01_r8, & + &3.0466e-01_r8,2.9733e-01_r8,4.5602e-01_r8/) + kao(:, 1, 2,16) = (/ & + &3.4634e-02_r8,7.7044e-02_r8,1.5273e-01_r8,2.2632e-01_r8,2.9575e-01_r8,3.6021e-01_r8, & + &4.0997e-01_r8,4.1812e-01_r8,5.9296e-01_r8/) + kao(:, 2, 2,16) = (/ & + &3.3420e-02_r8,7.6207e-02_r8,1.5110e-01_r8,2.2402e-01_r8,2.9356e-01_r8,3.5685e-01_r8, & + &4.0638e-01_r8,4.1457e-01_r8,5.8711e-01_r8/) + kao(:, 3, 2,16) = (/ & + &3.2246e-02_r8,7.5373e-02_r8,1.4946e-01_r8,2.2157e-01_r8,2.9037e-01_r8,3.5299e-01_r8, & + &4.0204e-01_r8,4.1028e-01_r8,5.8073e-01_r8/) + kao(:, 4, 2,16) = (/ & + &3.1106e-02_r8,7.4437e-02_r8,1.4762e-01_r8,2.1883e-01_r8,2.8679e-01_r8,3.4868e-01_r8, & + &3.9718e-01_r8,4.0541e-01_r8,5.7357e-01_r8/) + kao(:, 5, 2,16) = (/ & + &3.0021e-02_r8,7.3426e-02_r8,1.4561e-01_r8,2.1587e-01_r8,2.8293e-01_r8,3.4400e-01_r8, & + &3.9193e-01_r8,4.0015e-01_r8,5.6584e-01_r8/) + kao(:, 1, 3,16) = (/ & + &8.3051e-02_r8,9.4793e-02_r8,1.8876e-01_r8,2.8144e-01_r8,3.7196e-01_r8,4.5816e-01_r8, & + &5.3450e-01_r8,5.7690e-01_r8,7.4391e-01_r8/) + kao(:, 2, 3,16) = (/ & + &7.9830e-02_r8,9.3082e-02_r8,1.8538e-01_r8,2.7644e-01_r8,3.6534e-01_r8,4.5017e-01_r8, & + &5.2550e-01_r8,5.6808e-01_r8,7.3067e-01_r8/) + kao(:, 3, 3,16) = (/ & + &7.6737e-02_r8,9.1705e-02_r8,1.8269e-01_r8,2.7246e-01_r8,3.6014e-01_r8,4.4395e-01_r8, & + &5.1857e-01_r8,5.6175e-01_r8,7.2028e-01_r8/) + kao(:, 4, 3,16) = (/ & + &7.3809e-02_r8,9.0497e-02_r8,1.8026e-01_r8,2.6888e-01_r8,3.5554e-01_r8,4.3839e-01_r8, & + &5.1223e-01_r8,5.5508e-01_r8,7.1107e-01_r8/) + kao(:, 5, 3,16) = (/ & + &7.1033e-02_r8,8.9276e-02_r8,1.7779e-01_r8,2.6523e-01_r8,3.5066e-01_r8,4.3243e-01_r8, & + &5.0536e-01_r8,5.4783e-01_r8,7.0132e-01_r8/) + kao(:, 1, 4,16) = (/ & + &2.0125e-01_r8,1.7779e-01_r8,2.3399e-01_r8,3.4997e-01_r8,4.6464e-01_r8,5.7674e-01_r8, & + &6.8253e-01_r8,7.6508e-01_r8,9.2928e-01_r8/) + kao(:, 2, 4,16) = (/ & + &1.9265e-01_r8,1.7048e-01_r8,2.2831e-01_r8,3.4146e-01_r8,4.5338e-01_r8,5.6281e-01_r8, & + &6.6618e-01_r8,7.4718e-01_r8,9.0679e-01_r8/) + kao(:, 3, 4,16) = (/ & + &1.8456e-01_r8,1.6365e-01_r8,2.2378e-01_r8,3.3476e-01_r8,4.4451e-01_r8,5.5182e-01_r8, & + &6.5330e-01_r8,7.3313e-01_r8,8.8901e-01_r8/) + kao(:, 4, 4,16) = (/ & + &1.7702e-01_r8,1.5723e-01_r8,2.1978e-01_r8,3.2875e-01_r8,4.3660e-01_r8,5.4199e-01_r8, & + &6.4188e-01_r8,7.2098e-01_r8,8.7320e-01_r8/) + kao(:, 5, 4,16) = (/ & + &1.6997e-01_r8,1.5116e-01_r8,2.1600e-01_r8,3.2314e-01_r8,4.2913e-01_r8,5.3288e-01_r8, & + &6.3120e-01_r8,7.0945e-01_r8,8.5826e-01_r8/) + kao(:, 1, 5,16) = (/ & + &4.4228e-01_r8,3.8795e-01_r8,3.3395e-01_r8,4.3605e-01_r8,5.8013e-01_r8,7.2255e-01_r8, & + &8.6084e-01_r8,9.8346e-01_r8,1.1603e+00_r8/) + kao(:, 2, 5,16) = (/ & + &4.2199e-01_r8,3.7056e-01_r8,3.1956e-01_r8,4.2215e-01_r8,5.6164e-01_r8,6.9945e-01_r8, & + &8.3347e-01_r8,9.5217e-01_r8,1.1233e+00_r8/) + kao(:, 3, 5,16) = (/ & + &4.0375e-01_r8,3.5492e-01_r8,3.0638e-01_r8,4.1150e-01_r8,5.4754e-01_r8,6.8200e-01_r8, & + &8.1260e-01_r8,9.2875e-01_r8,1.0951e+00_r8/) + kao(:, 4, 5,16) = (/ & + &3.8716e-01_r8,3.4051e-01_r8,2.9411e-01_r8,4.0247e-01_r8,5.3546e-01_r8,6.6706e-01_r8, & + &7.9494e-01_r8,9.0883e-01_r8,1.0709e+00_r8/) + kao(:, 5, 5,16) = (/ & + &3.7160e-01_r8,3.2689e-01_r8,2.8321e-01_r8,3.9414e-01_r8,5.2444e-01_r8,6.5338e-01_r8, & + &7.7865e-01_r8,8.9056e-01_r8,1.0489e+00_r8/) + kao(:, 1, 6,16) = (/ & + &9.0506e-01_r8,7.9284e-01_r8,6.8068e-01_r8,5.6916e-01_r8,7.2503e-01_r8,9.0468e-01_r8, & + &1.0813e+00_r8,1.2473e+00_r8,1.4500e+00_r8/) + kao(:, 2, 6,16) = (/ & + &8.6465e-01_r8,7.5773e-01_r8,6.5086e-01_r8,5.4531e-01_r8,6.9722e-01_r8,8.6983e-01_r8, & + &1.0397e+00_r8,1.1992e+00_r8,1.3944e+00_r8/) + kao(:, 3, 6,16) = (/ & + &8.2825e-01_r8,7.2598e-01_r8,6.2379e-01_r8,5.2549e-01_r8,6.7605e-01_r8,8.4340e-01_r8, & + &1.0082e+00_r8,1.1629e+00_r8,1.3521e+00_r8/) + kao(:, 4, 6,16) = (/ & + &7.9420e-01_r8,6.9632e-01_r8,5.9834e-01_r8,5.1029e-01_r8,6.5811e-01_r8,8.2106e-01_r8, & + &9.8160e-01_r8,1.1324e+00_r8,1.3162e+00_r8/) + kao(:, 5, 6,16) = (/ & + &7.6215e-01_r8,6.6829e-01_r8,5.7431e-01_r8,4.9359e-01_r8,6.4194e-01_r8,8.0089e-01_r8, & + &9.5749e-01_r8,1.1049e+00_r8,1.2839e+00_r8/) + kao(:, 1, 7,16) = (/ & + &1.9676e+00_r8,1.7224e+00_r8,1.4775e+00_r8,1.2325e+00_r8,9.8756e-01_r8,1.1304e+00_r8, & + &1.3539e+00_r8,1.5704e+00_r8,1.8105e+00_r8/) + kao(:, 2, 7,16) = (/ & + &1.8838e+00_r8,1.6493e+00_r8,1.4147e+00_r8,1.1804e+00_r8,9.4604e-01_r8,1.0806e+00_r8, & + &1.2942e+00_r8,1.5011e+00_r8,1.7307e+00_r8/) + kao(:, 3, 7,16) = (/ & + &1.8058e+00_r8,1.5808e+00_r8,1.3563e+00_r8,1.1318e+00_r8,9.0772e-01_r8,1.0432e+00_r8, & + &1.2494e+00_r8,1.4491e+00_r8,1.6707e+00_r8/) + kao(:, 4, 7,16) = (/ & + &1.7320e+00_r8,1.5166e+00_r8,1.3008e+00_r8,1.0854e+00_r8,8.7621e-01_r8,1.0114e+00_r8, & + &1.2114e+00_r8,1.4051e+00_r8,1.6197e+00_r8/) + kao(:, 5, 7,16) = (/ & + &1.6617e+00_r8,1.4551e+00_r8,1.2484e+00_r8,1.0417e+00_r8,8.4899e-01_r8,9.8293e-01_r8, & + &1.1773e+00_r8,1.3657e+00_r8,1.5743e+00_r8/) + kao(:, 1, 8,16) = (/ & + &5.0769e+00_r8,4.4432e+00_r8,3.8096e+00_r8,3.1755e+00_r8,2.5417e+00_r8,1.9082e+00_r8, & + &1.6892e+00_r8,1.9659e+00_r8,2.2550e+00_r8/) + kao(:, 2, 8,16) = (/ & + &4.8681e+00_r8,4.2603e+00_r8,3.6527e+00_r8,3.0450e+00_r8,2.4373e+00_r8,1.8300e+00_r8, & + &1.6072e+00_r8,1.8705e+00_r8,2.1455e+00_r8/) + kao(:, 3, 8,16) = (/ & + &4.6692e+00_r8,4.0861e+00_r8,3.5032e+00_r8,2.9205e+00_r8,2.3378e+00_r8,1.7550e+00_r8, & + &1.5446e+00_r8,1.7976e+00_r8,2.0621e+00_r8/) + kao(:, 4, 8,16) = (/ & + &4.4792e+00_r8,3.9199e+00_r8,3.3609e+00_r8,2.8016e+00_r8,2.2429e+00_r8,1.6836e+00_r8, & + &1.4923e+00_r8,1.7367e+00_r8,1.9921e+00_r8/) + kao(:, 5, 8,16) = (/ & + &4.2972e+00_r8,3.7609e+00_r8,3.2243e+00_r8,2.6879e+00_r8,2.1517e+00_r8,1.6153e+00_r8, & + &1.4455e+00_r8,1.6824e+00_r8,1.9297e+00_r8/) + kao(:, 1, 9,16) = (/ & + &2.4893e+01_r8,2.1786e+01_r8,1.8675e+01_r8,1.5563e+01_r8,1.2450e+01_r8,9.3398e+00_r8, & + &6.2286e+00_r8,3.1170e+00_r8,2.8014e+00_r8/) + kao(:, 2, 9,16) = (/ & + &2.3897e+01_r8,2.0912e+01_r8,1.7925e+01_r8,1.4937e+01_r8,1.1951e+01_r8,8.9651e+00_r8, & + &5.9788e+00_r8,2.9923e+00_r8,2.6581e+00_r8/) + kao(:, 3, 9,16) = (/ & + &2.2932e+01_r8,2.0066e+01_r8,1.7201e+01_r8,1.4334e+01_r8,1.1468e+01_r8,8.6027e+00_r8, & + &5.7371e+00_r8,2.8711e+00_r8,2.5442e+00_r8/) + kao(:, 4, 9,16) = (/ & + &2.1999e+01_r8,1.9250e+01_r8,1.6501e+01_r8,1.3753e+01_r8,1.1001e+01_r8,8.2533e+00_r8, & + &5.5038e+00_r8,2.7545e+00_r8,2.4493e+00_r8/) + kao(:, 5, 9,16) = (/ & + &2.1105e+01_r8,1.8469e+01_r8,1.5831e+01_r8,1.3195e+01_r8,1.0556e+01_r8,7.9178e+00_r8, & + &5.2806e+00_r8,2.6423e+00_r8,2.3650e+00_r8/) + kao(:, 1,10,16) = (/ & + &1.3702e+02_r8,1.1990e+02_r8,1.0277e+02_r8,8.5642e+01_r8,6.8515e+01_r8,5.1385e+01_r8, & + &3.4262e+01_r8,1.7133e+01_r8,3.4526e+00_r8/) + kao(:, 2,10,16) = (/ & + &1.3162e+02_r8,1.1516e+02_r8,9.8725e+01_r8,8.2273e+01_r8,6.5802e+01_r8,4.9353e+01_r8, & + &3.2909e+01_r8,1.6459e+01_r8,3.2683e+00_r8/) + kao(:, 3,10,16) = (/ & + &1.2631e+02_r8,1.1053e+02_r8,9.4741e+01_r8,7.8943e+01_r8,6.3147e+01_r8,4.7375e+01_r8, & + &3.1582e+01_r8,1.5793e+01_r8,3.1197e+00_r8/) + kao(:, 4,10,16) = (/ & + &1.2113e+02_r8,1.0599e+02_r8,9.0842e+01_r8,7.5703e+01_r8,6.0562e+01_r8,4.5424e+01_r8, & + &3.0282e+01_r8,1.5145e+01_r8,2.9946e+00_r8/) + kao(:, 5,10,16) = (/ & + &1.1642e+02_r8,1.0187e+02_r8,8.7320e+01_r8,7.2762e+01_r8,5.8215e+01_r8,4.3658e+01_r8, & + &2.9108e+01_r8,1.4557e+01_r8,2.8829e+00_r8/) + kao(:, 1,11,16) = (/ & + &2.5880e+02_r8,2.2644e+02_r8,1.9413e+02_r8,1.6174e+02_r8,1.2941e+02_r8,9.7065e+01_r8, & + &6.4700e+01_r8,3.2352e+01_r8,4.1212e+00_r8/) + kao(:, 2,11,16) = (/ & + &2.4838e+02_r8,2.1734e+02_r8,1.8628e+02_r8,1.5524e+02_r8,1.2419e+02_r8,9.3146e+01_r8, & + &6.2097e+01_r8,3.1052e+01_r8,3.9061e+00_r8/) + kao(:, 3,11,16) = (/ & + &2.3869e+02_r8,2.0886e+02_r8,1.7902e+02_r8,1.4918e+02_r8,1.1935e+02_r8,8.9511e+01_r8, & + &5.9677e+01_r8,2.9841e+01_r8,3.7301e+00_r8/) + kao(:, 4,11,16) = (/ & + &2.2943e+02_r8,2.0074e+02_r8,1.7207e+02_r8,1.4339e+02_r8,1.1472e+02_r8,8.6039e+01_r8, & + &5.7356e+01_r8,2.8682e+01_r8,3.5754e+00_r8/) + kao(:, 5,11,16) = (/ & + &2.2131e+02_r8,1.9367e+02_r8,1.6600e+02_r8,1.3834e+02_r8,1.1067e+02_r8,8.3001e+01_r8, & + &5.5340e+01_r8,2.7668e+01_r8,3.4351e+00_r8/) + kao(:, 1,12,16) = (/ & + &3.6519e+02_r8,3.1953e+02_r8,2.7390e+02_r8,2.2827e+02_r8,1.8260e+02_r8,1.3695e+02_r8, & + &9.1294e+01_r8,4.5654e+01_r8,4.8878e+00_r8/) + kao(:, 2,12,16) = (/ & + &3.5163e+02_r8,3.0767e+02_r8,2.6371e+02_r8,2.1977e+02_r8,1.7580e+02_r8,1.3186e+02_r8, & + &8.7903e+01_r8,4.3953e+01_r8,4.5957e+00_r8/) + kao(:, 3,12,16) = (/ & + &3.3818e+02_r8,2.9589e+02_r8,2.5364e+02_r8,2.1136e+02_r8,1.6910e+02_r8,1.2682e+02_r8, & + &8.4547e+01_r8,4.2272e+01_r8,4.4276e+00_r8/) + kao(:, 4,12,16) = (/ & + &3.2523e+02_r8,2.8457e+02_r8,2.4393e+02_r8,2.0329e+02_r8,1.6262e+02_r8,1.2197e+02_r8, & + &8.1319e+01_r8,4.0657e+01_r8,4.2352e+00_r8/) + kao(:, 5,12,16) = (/ & + &3.1377e+02_r8,2.7452e+02_r8,2.3534e+02_r8,1.9609e+02_r8,1.5688e+02_r8,1.1765e+02_r8, & + &7.8446e+01_r8,3.9220e+01_r8,4.0574e+00_r8/) + kao(:, 1,13,16) = (/ & + &4.1560e+02_r8,3.6364e+02_r8,3.1170e+02_r8,2.5976e+02_r8,2.0781e+02_r8,1.5585e+02_r8, & + &1.0390e+02_r8,5.1953e+01_r8,5.7636e+00_r8/) + kao(:, 2,13,16) = (/ & + &3.9970e+02_r8,3.4978e+02_r8,2.9980e+02_r8,2.4983e+02_r8,1.9986e+02_r8,1.4990e+02_r8, & + &9.9932e+01_r8,4.9970e+01_r8,5.4706e+00_r8/) + kao(:, 3,13,16) = (/ & + &3.8378e+02_r8,3.3582e+02_r8,2.8782e+02_r8,2.3987e+02_r8,1.9190e+02_r8,1.4391e+02_r8, & + &9.5948e+01_r8,4.7978e+01_r8,5.2080e+00_r8/) + kao(:, 4,13,16) = (/ & + &3.6900e+02_r8,3.2290e+02_r8,2.7675e+02_r8,2.3063e+02_r8,1.8451e+02_r8,1.3838e+02_r8, & + &9.2254e+01_r8,4.6129e+01_r8,4.9718e+00_r8/) + kao(:, 5,13,16) = (/ & + &3.5587e+02_r8,3.1138e+02_r8,2.6690e+02_r8,2.2242e+02_r8,1.7795e+02_r8,1.3345e+02_r8, & + &8.8970e+01_r8,4.4486e+01_r8,4.7553e+00_r8/) + +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. + + kbo(:,13, 1) = (/ & + &6.6242e-04_r8,6.9229e-04_r8,7.2125e-04_r8,7.5111e-04_r8,7.7882e-04_r8/) + kbo(:,14, 1) = (/ & + &5.7148e-04_r8,6.0011e-04_r8,6.2434e-04_r8,6.4765e-04_r8,6.6822e-04_r8/) + kbo(:,15, 1) = (/ & + &5.0245e-04_r8,5.2495e-04_r8,5.4519e-04_r8,5.6261e-04_r8,5.8004e-04_r8/) + kbo(:,16, 1) = (/ & + &4.4219e-04_r8,4.6335e-04_r8,4.7782e-04_r8,4.9293e-04_r8,5.0687e-04_r8/) + kbo(:,17, 1) = (/ & + &3.9452e-04_r8,4.1172e-04_r8,4.2558e-04_r8,4.3834e-04_r8,4.5031e-04_r8/) + kbo(:,18, 1) = (/ & + &3.5502e-04_r8,3.7021e-04_r8,3.8062e-04_r8,3.9326e-04_r8,4.0413e-04_r8/) + kbo(:,19, 1) = (/ & + &3.1835e-04_r8,3.3204e-04_r8,3.4438e-04_r8,3.5308e-04_r8,3.6251e-04_r8/) + kbo(:,20, 1) = (/ & + &2.7685e-04_r8,2.8739e-04_r8,2.9799e-04_r8,3.0565e-04_r8,3.1346e-04_r8/) + kbo(:,21, 1) = (/ & + &2.3803e-04_r8,2.4613e-04_r8,2.5507e-04_r8,2.6118e-04_r8,2.6805e-04_r8/) + kbo(:,22, 1) = (/ & + &2.0518e-04_r8,2.1064e-04_r8,2.1799e-04_r8,2.2345e-04_r8,2.2945e-04_r8/) + kbo(:,23, 1) = (/ & + &1.7609e-04_r8,1.8136e-04_r8,1.8691e-04_r8,1.9179e-04_r8,1.9680e-04_r8/) + kbo(:,24, 1) = (/ & + &1.5133e-04_r8,1.5582e-04_r8,1.6020e-04_r8,1.6517e-04_r8,1.6912e-04_r8/) + kbo(:,25, 1) = (/ & + &1.3023e-04_r8,1.3355e-04_r8,1.3826e-04_r8,1.4195e-04_r8,1.4464e-04_r8/) + kbo(:,26, 1) = (/ & + &1.1153e-04_r8,1.1437e-04_r8,1.1820e-04_r8,1.2126e-04_r8,1.2331e-04_r8/) + kbo(:,27, 1) = (/ & + &9.5262e-05_r8,9.8055e-05_r8,1.0080e-04_r8,1.0342e-04_r8,1.0508e-04_r8/) + kbo(:,28, 1) = (/ & + &8.1680e-05_r8,8.3691e-05_r8,8.6133e-05_r8,8.8128e-05_r8,8.9712e-05_r8/) + kbo(:,29, 1) = (/ & + &7.0309e-05_r8,7.1883e-05_r8,7.3686e-05_r8,7.5287e-05_r8,7.6689e-05_r8/) + kbo(:,30, 1) = (/ & + &6.0539e-05_r8,6.1910e-05_r8,6.3188e-05_r8,6.4488e-05_r8,6.6886e-05_r8/) + kbo(:,31, 1) = (/ & + &5.2744e-05_r8,5.3514e-05_r8,5.4453e-05_r8,5.5692e-05_r8,5.7687e-05_r8/) + kbo(:,32, 1) = (/ & + &4.5908e-05_r8,4.6319e-05_r8,4.7373e-05_r8,4.8133e-05_r8,4.9705e-05_r8/) + kbo(:,33, 1) = (/ & + &3.9867e-05_r8,4.0547e-05_r8,4.1159e-05_r8,4.1892e-05_r8,4.3045e-05_r8/) + kbo(:,34, 1) = (/ & + &3.4676e-05_r8,3.5573e-05_r8,3.6016e-05_r8,3.7022e-05_r8,3.7402e-05_r8/) + kbo(:,35, 1) = (/ & + &3.0380e-05_r8,3.1177e-05_r8,3.1680e-05_r8,3.2397e-05_r8,3.2578e-05_r8/) + kbo(:,36, 1) = (/ & + &2.6710e-05_r8,2.7409e-05_r8,2.7919e-05_r8,2.8397e-05_r8,2.8592e-05_r8/) + kbo(:,37, 1) = (/ & + &2.2468e-05_r8,2.3018e-05_r8,2.3378e-05_r8,2.3912e-05_r8,2.4011e-05_r8/) + kbo(:,38, 1) = (/ & + &1.8961e-05_r8,1.9311e-05_r8,1.9590e-05_r8,2.0060e-05_r8,2.0183e-05_r8/) + kbo(:,39, 1) = (/ & + &1.6038e-05_r8,1.6240e-05_r8,1.6497e-05_r8,1.6653e-05_r8,1.7067e-05_r8/) + kbo(:,40, 1) = (/ & + &1.3126e-05_r8,1.3247e-05_r8,1.3457e-05_r8,1.3586e-05_r8,1.3950e-05_r8/) + kbo(:,41, 1) = (/ & + &1.0642e-05_r8,1.0779e-05_r8,1.0904e-05_r8,1.1060e-05_r8,1.1348e-05_r8/) + kbo(:,42, 1) = (/ & + &8.5931e-06_r8,8.7256e-06_r8,8.8249e-06_r8,8.9763e-06_r8,9.1997e-06_r8/) + kbo(:,43, 1) = (/ & + &6.8315e-06_r8,7.0003e-06_r8,7.0825e-06_r8,7.1921e-06_r8,7.3080e-06_r8/) + kbo(:,44, 1) = (/ & + &5.4113e-06_r8,5.5622e-06_r8,5.6277e-06_r8,5.7357e-06_r8,5.8407e-06_r8/) + kbo(:,45, 1) = (/ & + &4.2868e-06_r8,4.4145e-06_r8,4.4700e-06_r8,4.5509e-06_r8,4.6597e-06_r8/) + kbo(:,46, 1) = (/ & + &3.3813e-06_r8,3.5001e-06_r8,3.5350e-06_r8,3.6083e-06_r8,3.6919e-06_r8/) + kbo(:,47, 1) = (/ & + &2.6664e-06_r8,2.7723e-06_r8,2.7972e-06_r8,2.8533e-06_r8,2.9267e-06_r8/) + kbo(:,48, 1) = (/ & + &2.0946e-06_r8,2.1711e-06_r8,2.2048e-06_r8,2.2465e-06_r8,2.3102e-06_r8/) + kbo(:,49, 1) = (/ & + &1.6333e-06_r8,1.6996e-06_r8,1.7388e-06_r8,1.7611e-06_r8,1.8115e-06_r8/) + kbo(:,50, 1) = (/ & + &1.2781e-06_r8,1.3328e-06_r8,1.3698e-06_r8,1.3938e-06_r8,1.4265e-06_r8/) + kbo(:,51, 1) = (/ & + &1.0076e-06_r8,1.0460e-06_r8,1.0807e-06_r8,1.1011e-06_r8,1.1257e-06_r8/) + kbo(:,52, 1) = (/ & + &7.9394e-07_r8,8.1840e-07_r8,8.4881e-07_r8,8.6654e-07_r8,8.8734e-07_r8/) + kbo(:,53, 1) = (/ & + &6.1785e-07_r8,6.3992e-07_r8,6.6144e-07_r8,6.7843e-07_r8,6.9618e-07_r8/) + kbo(:,54, 1) = (/ & + &4.8490e-07_r8,5.0506e-07_r8,5.1952e-07_r8,5.3413e-07_r8,5.4905e-07_r8/) + kbo(:,55, 1) = (/ & + &3.8198e-07_r8,3.9926e-07_r8,4.1207e-07_r8,4.2268e-07_r8,4.3489e-07_r8/) + kbo(:,56, 1) = (/ & + &3.0062e-07_r8,3.1357e-07_r8,3.2461e-07_r8,3.3313e-07_r8,3.4390e-07_r8/) + kbo(:,57, 1) = (/ & + &2.3579e-07_r8,2.4608e-07_r8,2.5500e-07_r8,2.6288e-07_r8,2.7145e-07_r8/) + kbo(:,58, 1) = (/ & + &1.8530e-07_r8,1.9293e-07_r8,2.0021e-07_r8,2.0804e-07_r8,2.1510e-07_r8/) + kbo(:,59, 1) = (/ & + &1.4951e-07_r8,1.5512e-07_r8,1.6259e-07_r8,1.6844e-07_r8,1.7451e-07_r8/) + kbo(:,13, 2) = (/ & + &2.8194e-03_r8,3.0121e-03_r8,3.1846e-03_r8,3.3490e-03_r8,3.5100e-03_r8/) + kbo(:,14, 2) = (/ & + &2.4827e-03_r8,2.6492e-03_r8,2.7938e-03_r8,2.9346e-03_r8,3.0538e-03_r8/) + kbo(:,15, 2) = (/ & + &2.2064e-03_r8,2.3375e-03_r8,2.4556e-03_r8,2.5697e-03_r8,2.6626e-03_r8/) + kbo(:,16, 2) = (/ & + &1.9378e-03_r8,2.0444e-03_r8,2.1458e-03_r8,2.2321e-03_r8,2.3069e-03_r8/) + kbo(:,17, 2) = (/ & + &1.7072e-03_r8,1.7953e-03_r8,1.8810e-03_r8,1.9513e-03_r8,2.0122e-03_r8/) + kbo(:,18, 2) = (/ & + &1.5182e-03_r8,1.5881e-03_r8,1.6604e-03_r8,1.7175e-03_r8,1.7691e-03_r8/) + kbo(:,19, 2) = (/ & + &1.3604e-03_r8,1.4237e-03_r8,1.4711e-03_r8,1.5216e-03_r8,1.5631e-03_r8/) + kbo(:,20, 2) = (/ & + &1.1858e-03_r8,1.2290e-03_r8,1.2712e-03_r8,1.3090e-03_r8,1.3421e-03_r8/) + kbo(:,21, 2) = (/ & + &1.0189e-03_r8,1.0547e-03_r8,1.0885e-03_r8,1.1186e-03_r8,1.1432e-03_r8/) + kbo(:,22, 2) = (/ & + &8.7055e-04_r8,9.0481e-04_r8,9.2821e-04_r8,9.5252e-04_r8,9.7075e-04_r8/) + kbo(:,23, 2) = (/ & + &7.4675e-04_r8,7.7099e-04_r8,7.9133e-04_r8,8.0933e-04_r8,8.2551e-04_r8/) + kbo(:,24, 2) = (/ & + &6.4034e-04_r8,6.5905e-04_r8,6.7517e-04_r8,6.8951e-04_r8,7.0349e-04_r8/) + kbo(:,25, 2) = (/ & + &5.4635e-04_r8,5.6117e-04_r8,5.7460e-04_r8,5.8668e-04_r8,5.9880e-04_r8/) + kbo(:,26, 2) = (/ & + &4.6328e-04_r8,4.7565e-04_r8,4.8724e-04_r8,4.9802e-04_r8,5.0785e-04_r8/) + kbo(:,27, 2) = (/ & + &3.9145e-04_r8,4.0138e-04_r8,4.1206e-04_r8,4.2067e-04_r8,4.2970e-04_r8/) + kbo(:,28, 2) = (/ & + &3.2965e-04_r8,3.3905e-04_r8,3.4755e-04_r8,3.5536e-04_r8,3.6345e-04_r8/) + kbo(:,29, 2) = (/ & + &2.7722e-04_r8,2.8535e-04_r8,2.9237e-04_r8,2.9947e-04_r8,3.0668e-04_r8/) + kbo(:,30, 2) = (/ & + &2.3378e-04_r8,2.4040e-04_r8,2.4667e-04_r8,2.5278e-04_r8,2.6270e-04_r8/) + kbo(:,31, 2) = (/ & + &1.9661e-04_r8,2.0207e-04_r8,2.0803e-04_r8,2.1348e-04_r8,2.2186e-04_r8/) + kbo(:,32, 2) = (/ & + &1.6562e-04_r8,1.7146e-04_r8,1.7695e-04_r8,1.8193e-04_r8,1.8929e-04_r8/) + kbo(:,33, 2) = (/ & + &1.4107e-04_r8,1.4666e-04_r8,1.5183e-04_r8,1.5594e-04_r8,1.6243e-04_r8/) + kbo(:,34, 2) = (/ & + &1.2158e-04_r8,1.2598e-04_r8,1.3011e-04_r8,1.3588e-04_r8,1.4023e-04_r8/) + kbo(:,35, 2) = (/ & + &1.0453e-04_r8,1.0824e-04_r8,1.1246e-04_r8,1.1806e-04_r8,1.2280e-04_r8/) + kbo(:,36, 2) = (/ & + &9.0281e-05_r8,9.3775e-05_r8,9.7901e-05_r8,1.0364e-04_r8,1.0744e-04_r8/) + kbo(:,37, 2) = (/ & + &7.5786e-05_r8,7.8742e-05_r8,8.2503e-05_r8,8.7040e-05_r8,8.9489e-05_r8/) + kbo(:,38, 2) = (/ & + &6.3149e-05_r8,6.6113e-05_r8,6.8833e-05_r8,7.2371e-05_r8,7.4496e-05_r8/) + kbo(:,39, 2) = (/ & + &5.2982e-05_r8,5.5381e-05_r8,5.7239e-05_r8,5.9241e-05_r8,6.1954e-05_r8/) + kbo(:,40, 2) = (/ & + &4.3111e-05_r8,4.5156e-05_r8,4.6617e-05_r8,4.8324e-05_r8,5.0544e-05_r8/) + kbo(:,41, 2) = (/ & + &3.4957e-05_r8,3.6661e-05_r8,3.7913e-05_r8,3.9243e-05_r8,4.1170e-05_r8/) + kbo(:,42, 2) = (/ & + &2.8335e-05_r8,2.9735e-05_r8,3.0788e-05_r8,3.1864e-05_r8,3.3563e-05_r8/) + kbo(:,43, 2) = (/ & + &2.2801e-05_r8,2.3962e-05_r8,2.4808e-05_r8,2.5685e-05_r8,2.6685e-05_r8/) + kbo(:,44, 2) = (/ & + &1.8216e-05_r8,1.9207e-05_r8,1.9940e-05_r8,2.0623e-05_r8,2.1468e-05_r8/) + kbo(:,45, 2) = (/ & + &1.4497e-05_r8,1.5369e-05_r8,1.6010e-05_r8,1.6560e-05_r8,1.7214e-05_r8/) + kbo(:,46, 2) = (/ & + &1.1546e-05_r8,1.2283e-05_r8,1.2829e-05_r8,1.3281e-05_r8,1.3789e-05_r8/) + kbo(:,47, 2) = (/ & + &9.1407e-06_r8,9.7102e-06_r8,1.0256e-05_r8,1.0642e-05_r8,1.1044e-05_r8/) + kbo(:,48, 2) = (/ & + &7.2582e-06_r8,7.7178e-06_r8,8.1771e-06_r8,8.5159e-06_r8,8.8287e-06_r8/) + kbo(:,49, 2) = (/ & + &5.7413e-06_r8,6.0895e-06_r8,6.4724e-06_r8,6.7948e-06_r8,7.0423e-06_r8/) + kbo(:,50, 2) = (/ & + &4.5645e-06_r8,4.8219e-06_r8,5.1398e-06_r8,5.4019e-06_r8,5.6251e-06_r8/) + kbo(:,51, 2) = (/ & + &3.6347e-06_r8,3.8345e-06_r8,4.0925e-06_r8,4.2999e-06_r8,4.4976e-06_r8/) + kbo(:,52, 2) = (/ & + &2.8914e-06_r8,3.0394e-06_r8,3.2506e-06_r8,3.4210e-06_r8,3.5835e-06_r8/) + kbo(:,53, 2) = (/ & + &2.2827e-06_r8,2.4183e-06_r8,2.5753e-06_r8,2.7165e-06_r8,2.8435e-06_r8/) + kbo(:,54, 2) = (/ & + &1.8109e-06_r8,1.9319e-06_r8,2.0517e-06_r8,2.1771e-06_r8,2.2825e-06_r8/) + kbo(:,55, 2) = (/ & + &1.4459e-06_r8,1.5442e-06_r8,1.6423e-06_r8,1.7466e-06_r8,1.8412e-06_r8/) + kbo(:,56, 2) = (/ & + &1.1487e-06_r8,1.2318e-06_r8,1.3168e-06_r8,1.4029e-06_r8,1.4853e-06_r8/) + kbo(:,57, 2) = (/ & + &9.1432e-07_r8,9.8206e-07_r8,1.0551e-06_r8,1.1262e-06_r8,1.1922e-06_r8/) + kbo(:,58, 2) = (/ & + &7.2392e-07_r8,7.8435e-07_r8,8.4467e-07_r8,9.0516e-07_r8,9.5596e-07_r8/) + kbo(:,59, 2) = (/ & + &5.9300e-07_r8,6.4245e-07_r8,6.9378e-07_r8,7.4259e-07_r8,7.8676e-07_r8/) + kbo(:,13, 3) = (/ & + &8.5247e-03_r8,8.9273e-03_r8,9.3494e-03_r8,9.7833e-03_r8,1.0198e-02_r8/) + kbo(:,14, 3) = (/ & + &7.6220e-03_r8,7.9465e-03_r8,8.3037e-03_r8,8.6680e-03_r8,9.0184e-03_r8/) + kbo(:,15, 3) = (/ & + &6.7313e-03_r8,7.0250e-03_r8,7.3390e-03_r8,7.6496e-03_r8,7.9523e-03_r8/) + kbo(:,16, 3) = (/ & + &5.8626e-03_r8,6.1324e-03_r8,6.4081e-03_r8,6.6680e-03_r8,6.9239e-03_r8/) + kbo(:,17, 3) = (/ & + &5.1190e-03_r8,5.3847e-03_r8,5.6114e-03_r8,5.8394e-03_r8,6.0319e-03_r8/) + kbo(:,18, 3) = (/ & + &4.4937e-03_r8,4.7329e-03_r8,4.9304e-03_r8,5.1178e-03_r8,5.2582e-03_r8/) + kbo(:,19, 3) = (/ & + &3.9714e-03_r8,4.1523e-03_r8,4.3393e-03_r8,4.4847e-03_r8,4.6081e-03_r8/) + kbo(:,20, 3) = (/ & + &3.4227e-03_r8,3.5888e-03_r8,3.7323e-03_r8,3.8457e-03_r8,3.9571e-03_r8/) + kbo(:,21, 3) = (/ & + &2.9355e-03_r8,3.0688e-03_r8,3.1813e-03_r8,3.2800e-03_r8,3.3665e-03_r8/) + kbo(:,22, 3) = (/ & + &2.5131e-03_r8,2.6136e-03_r8,2.7075e-03_r8,2.7888e-03_r8,2.8576e-03_r8/) + kbo(:,23, 3) = (/ & + &2.1439e-03_r8,2.2229e-03_r8,2.3069e-03_r8,2.3691e-03_r8,2.4314e-03_r8/) + kbo(:,24, 3) = (/ & + &1.8279e-03_r8,1.8995e-03_r8,1.9649e-03_r8,2.0190e-03_r8,2.0668e-03_r8/) + kbo(:,25, 3) = (/ & + &1.5582e-03_r8,1.6177e-03_r8,1.6674e-03_r8,1.7146e-03_r8,1.7550e-03_r8/) + kbo(:,26, 3) = (/ & + &1.3272e-03_r8,1.3717e-03_r8,1.4140e-03_r8,1.4536e-03_r8,1.4858e-03_r8/) + kbo(:,27, 3) = (/ & + &1.1230e-03_r8,1.1594e-03_r8,1.1953e-03_r8,1.2264e-03_r8,1.2540e-03_r8/) + kbo(:,28, 3) = (/ & + &9.4753e-04_r8,9.7763e-04_r8,1.0074e-03_r8,1.0308e-03_r8,1.0536e-03_r8/) + kbo(:,29, 3) = (/ & + &7.9502e-04_r8,8.1974e-04_r8,8.4372e-04_r8,8.6478e-04_r8,8.8308e-04_r8/) + kbo(:,30, 3) = (/ & + &6.6596e-04_r8,6.8697e-04_r8,7.0803e-04_r8,7.2439e-04_r8,7.5784e-04_r8/) + kbo(:,31, 3) = (/ & + &5.5745e-04_r8,5.7516e-04_r8,5.9220e-04_r8,6.0512e-04_r8,6.3289e-04_r8/) + kbo(:,32, 3) = (/ & + &4.6662e-04_r8,4.8150e-04_r8,4.9505e-04_r8,5.0361e-04_r8,5.2756e-04_r8/) + kbo(:,33, 3) = (/ & + &3.9094e-04_r8,4.0255e-04_r8,4.1211e-04_r8,4.1938e-04_r8,4.4050e-04_r8/) + kbo(:,34, 3) = (/ & + &3.2769e-04_r8,3.3699e-04_r8,3.4471e-04_r8,3.6275e-04_r8,3.6949e-04_r8/) + kbo(:,35, 3) = (/ & + &2.7475e-04_r8,2.8204e-04_r8,2.8828e-04_r8,3.0332e-04_r8,3.0836e-04_r8/) + kbo(:,36, 3) = (/ & + &2.2983e-04_r8,2.3568e-04_r8,2.4113e-04_r8,2.5319e-04_r8,2.5736e-04_r8/) + kbo(:,37, 3) = (/ & + &1.8895e-04_r8,1.9397e-04_r8,1.9807e-04_r8,2.0882e-04_r8,2.1275e-04_r8/) + kbo(:,38, 3) = (/ & + &1.5549e-04_r8,1.5951e-04_r8,1.6323e-04_r8,1.7252e-04_r8,1.7561e-04_r8/) + kbo(:,39, 3) = (/ & + &1.2765e-04_r8,1.3102e-04_r8,1.3443e-04_r8,1.3776e-04_r8,1.4478e-04_r8/) + kbo(:,40, 3) = (/ & + &1.0414e-04_r8,1.0697e-04_r8,1.0972e-04_r8,1.1251e-04_r8,1.1839e-04_r8/) + kbo(:,41, 3) = (/ & + &8.4861e-05_r8,8.7037e-05_r8,8.9345e-05_r8,9.1552e-05_r8,9.6450e-05_r8/) + kbo(:,42, 3) = (/ & + &6.9029e-05_r8,7.0620e-05_r8,7.2608e-05_r8,7.4362e-05_r8,7.8451e-05_r8/) + kbo(:,43, 3) = (/ & + &5.5731e-05_r8,5.6934e-05_r8,5.8627e-05_r8,6.0036e-05_r8,6.1419e-05_r8/) + kbo(:,44, 3) = (/ & + &4.4750e-05_r8,4.5795e-05_r8,4.7066e-05_r8,4.8320e-05_r8,4.9340e-05_r8/) + kbo(:,45, 3) = (/ & + &3.5902e-05_r8,3.6793e-05_r8,3.7710e-05_r8,3.8772e-05_r8,3.9634e-05_r8/) + kbo(:,46, 3) = (/ & + &2.8669e-05_r8,2.9406e-05_r8,3.0158e-05_r8,3.1055e-05_r8,3.1783e-05_r8/) + kbo(:,47, 3) = (/ & + &2.2957e-05_r8,2.3586e-05_r8,2.4179e-05_r8,2.4875e-05_r8,2.5463e-05_r8/) + kbo(:,48, 3) = (/ & + &1.8322e-05_r8,1.8764e-05_r8,1.9281e-05_r8,1.9846e-05_r8,2.0330e-05_r8/) + kbo(:,49, 3) = (/ & + &1.4581e-05_r8,1.4948e-05_r8,1.5326e-05_r8,1.5796e-05_r8,1.6188e-05_r8/) + kbo(:,50, 3) = (/ & + &1.1658e-05_r8,1.1996e-05_r8,1.2253e-05_r8,1.2626e-05_r8,1.2988e-05_r8/) + kbo(:,51, 3) = (/ & + &9.3098e-06_r8,9.6196e-06_r8,9.8320e-06_r8,1.0134e-05_r8,1.0431e-05_r8/) + kbo(:,52, 3) = (/ & + &7.3883e-06_r8,7.7108e-06_r8,7.8752e-06_r8,8.1035e-06_r8,8.3459e-06_r8/) + kbo(:,53, 3) = (/ & + &5.8592e-06_r8,6.1249e-06_r8,6.2920e-06_r8,6.4688e-06_r8,6.6480e-06_r8/) + kbo(:,54, 3) = (/ & + &4.7059e-06_r8,4.9088e-06_r8,5.0922e-06_r8,5.2219e-06_r8,5.3713e-06_r8/) + kbo(:,55, 3) = (/ & + &3.7899e-06_r8,3.9660e-06_r8,4.1365e-06_r8,4.2472e-06_r8,4.3644e-06_r8/) + kbo(:,56, 3) = (/ & + &3.0554e-06_r8,3.2100e-06_r8,3.3483e-06_r8,3.4494e-06_r8,3.5457e-06_r8/) + kbo(:,57, 3) = (/ & + &2.4489e-06_r8,2.5923e-06_r8,2.7014e-06_r8,2.7985e-06_r8,2.8823e-06_r8/) + kbo(:,58, 3) = (/ & + &1.9694e-06_r8,2.0948e-06_r8,2.1872e-06_r8,2.2740e-06_r8,2.3512e-06_r8/) + kbo(:,59, 3) = (/ & + &1.6303e-06_r8,1.7449e-06_r8,1.8268e-06_r8,1.9070e-06_r8,1.9708e-06_r8/) + kbo(:,13, 4) = (/ & + &1.8047e-02_r8,1.8718e-02_r8,1.9333e-02_r8,1.9945e-02_r8,2.0619e-02_r8/) + kbo(:,14, 4) = (/ & + &1.6432e-02_r8,1.7100e-02_r8,1.7741e-02_r8,1.8401e-02_r8,1.9089e-02_r8/) + kbo(:,15, 4) = (/ & + &1.4807e-02_r8,1.5451e-02_r8,1.6100e-02_r8,1.6750e-02_r8,1.7413e-02_r8/) + kbo(:,16, 4) = (/ & + &1.3139e-02_r8,1.3704e-02_r8,1.4262e-02_r8,1.4904e-02_r8,1.5552e-02_r8/) + kbo(:,17, 4) = (/ & + &1.1663e-02_r8,1.2130e-02_r8,1.2669e-02_r8,1.3218e-02_r8,1.3830e-02_r8/) + kbo(:,18, 4) = (/ & + &1.0329e-02_r8,1.0751e-02_r8,1.1271e-02_r8,1.1798e-02_r8,1.2374e-02_r8/) + kbo(:,19, 4) = (/ & + &9.2112e-03_r8,9.6353e-03_r8,1.0130e-02_r8,1.0649e-02_r8,1.1157e-02_r8/) + kbo(:,20, 4) = (/ & + &8.0574e-03_r8,8.4807e-03_r8,8.9054e-03_r8,9.3587e-03_r8,9.7992e-03_r8/) + kbo(:,21, 4) = (/ & + &7.0019e-03_r8,7.3853e-03_r8,7.7827e-03_r8,8.1758e-03_r8,8.5421e-03_r8/) + kbo(:,22, 4) = (/ & + &6.0893e-03_r8,6.4266e-03_r8,6.7752e-03_r8,7.1040e-03_r8,7.4095e-03_r8/) + kbo(:,23, 4) = (/ & + &5.2966e-03_r8,5.5992e-03_r8,5.8988e-03_r8,6.1748e-03_r8,6.4166e-03_r8/) + kbo(:,24, 4) = (/ & + &4.6174e-03_r8,4.8835e-03_r8,5.1353e-03_r8,5.3661e-03_r8,5.5632e-03_r8/) + kbo(:,25, 4) = (/ & + &4.0173e-03_r8,4.2433e-03_r8,4.4670e-03_r8,4.6521e-03_r8,4.8258e-03_r8/) + kbo(:,26, 4) = (/ & + &3.4865e-03_r8,3.6826e-03_r8,3.8670e-03_r8,4.0200e-03_r8,4.1614e-03_r8/) + kbo(:,27, 4) = (/ & + &3.0102e-03_r8,3.1785e-03_r8,3.3303e-03_r8,3.4548e-03_r8,3.5736e-03_r8/) + kbo(:,28, 4) = (/ & + &2.5902e-03_r8,2.7336e-03_r8,2.8553e-03_r8,2.9588e-03_r8,3.0603e-03_r8/) + kbo(:,29, 4) = (/ & + &2.2148e-03_r8,2.3314e-03_r8,2.4216e-03_r8,2.5098e-03_r8,2.5968e-03_r8/) + kbo(:,30, 4) = (/ & + &1.8884e-03_r8,1.9733e-03_r8,2.0479e-03_r8,2.1223e-03_r8,2.2826e-03_r8/) + kbo(:,31, 4) = (/ & + &1.5995e-03_r8,1.6617e-03_r8,1.7230e-03_r8,1.7883e-03_r8,1.9307e-03_r8/) + kbo(:,32, 4) = (/ & + &1.3496e-03_r8,1.3999e-03_r8,1.4538e-03_r8,1.5096e-03_r8,1.6319e-03_r8/) + kbo(:,33, 4) = (/ & + &1.1363e-03_r8,1.1813e-03_r8,1.2287e-03_r8,1.2753e-03_r8,1.3874e-03_r8/) + kbo(:,34, 4) = (/ & + &9.6663e-04_r8,1.0050e-03_r8,1.0440e-03_r8,1.1401e-03_r8,1.1914e-03_r8/) + kbo(:,35, 4) = (/ & + &8.2252e-04_r8,8.5291e-04_r8,8.9255e-04_r8,9.7906e-04_r8,1.0213e-03_r8/) + kbo(:,36, 4) = (/ & + &6.9843e-04_r8,7.2671e-04_r8,7.6052e-04_r8,8.3992e-04_r8,8.7893e-04_r8/) + kbo(:,37, 4) = (/ & + &5.7973e-04_r8,6.0624e-04_r8,6.3703e-04_r8,7.0532e-04_r8,7.4046e-04_r8/) + kbo(:,38, 4) = (/ & + &4.8124e-04_r8,5.0463e-04_r8,5.3059e-04_r8,5.8984e-04_r8,6.2161e-04_r8/) + kbo(:,39, 4) = (/ & + &3.9797e-04_r8,4.2007e-04_r8,4.4141e-04_r8,4.6508e-04_r8,5.2126e-04_r8/) + kbo(:,40, 4) = (/ & + &3.2587e-04_r8,3.4475e-04_r8,3.6264e-04_r8,3.8270e-04_r8,4.3106e-04_r8/) + kbo(:,41, 4) = (/ & + &2.6592e-04_r8,2.8134e-04_r8,2.9669e-04_r8,3.1406e-04_r8,3.5481e-04_r8/) + kbo(:,42, 4) = (/ & + &2.1654e-04_r8,2.2933e-04_r8,2.4233e-04_r8,2.5702e-04_r8,2.9186e-04_r8/) + kbo(:,43, 4) = (/ & + &1.7468e-04_r8,1.8487e-04_r8,1.9562e-04_r8,2.0857e-04_r8,2.2203e-04_r8/) + kbo(:,44, 4) = (/ & + &1.3990e-04_r8,1.4813e-04_r8,1.5725e-04_r8,1.6786e-04_r8,1.7935e-04_r8/) + kbo(:,45, 4) = (/ & + &1.1147e-04_r8,1.1816e-04_r8,1.2590e-04_r8,1.3456e-04_r8,1.4433e-04_r8/) + kbo(:,46, 4) = (/ & + &8.8593e-05_r8,9.4029e-05_r8,1.0037e-04_r8,1.0744e-04_r8,1.1598e-04_r8/) + kbo(:,47, 4) = (/ & + &7.0072e-05_r8,7.4712e-05_r8,7.9919e-05_r8,8.5900e-05_r8,9.3033e-05_r8/) + kbo(:,48, 4) = (/ & + &5.5180e-05_r8,5.9132e-05_r8,6.3502e-05_r8,6.8198e-05_r8,7.4266e-05_r8/) + kbo(:,49, 4) = (/ & + &4.3109e-05_r8,4.6388e-05_r8,5.0075e-05_r8,5.3912e-05_r8,5.8896e-05_r8/) + kbo(:,50, 4) = (/ & + &3.4049e-05_r8,3.6756e-05_r8,3.9830e-05_r8,4.3128e-05_r8,4.7184e-05_r8/) + kbo(:,51, 4) = (/ & + &2.7005e-05_r8,2.9148e-05_r8,3.1674e-05_r8,3.4539e-05_r8,3.7748e-05_r8/) + kbo(:,52, 4) = (/ & + &2.1299e-05_r8,2.3058e-05_r8,2.5114e-05_r8,2.7488e-05_r8,3.0113e-05_r8/) + kbo(:,53, 4) = (/ & + &1.6705e-05_r8,1.8140e-05_r8,1.9875e-05_r8,2.1784e-05_r8,2.3982e-05_r8/) + kbo(:,54, 4) = (/ & + &1.3350e-05_r8,1.4560e-05_r8,1.5930e-05_r8,1.7502e-05_r8,1.9341e-05_r8/) + kbo(:,55, 4) = (/ & + &1.0773e-05_r8,1.1749e-05_r8,1.2886e-05_r8,1.4153e-05_r8,1.5702e-05_r8/) + kbo(:,56, 4) = (/ & + &8.6460e-06_r8,9.4510e-06_r8,1.0398e-05_r8,1.1452e-05_r8,1.2706e-05_r8/) + kbo(:,57, 4) = (/ & + &6.9096e-06_r8,7.6015e-06_r8,8.3864e-06_r8,9.2473e-06_r8,1.0265e-05_r8/) + kbo(:,58, 4) = (/ & + &5.5254e-06_r8,6.1387e-06_r8,6.7789e-06_r8,7.4818e-06_r8,8.3075e-06_r8/) + kbo(:,59, 4) = (/ & + &4.6551e-06_r8,5.1865e-06_r8,5.7401e-06_r8,6.3194e-06_r8,7.0521e-06_r8/) + kbo(:,13, 5) = (/ & + &3.4718e-02_r8,3.5594e-02_r8,3.6803e-02_r8,3.8083e-02_r8,3.9520e-02_r8/) + kbo(:,14, 5) = (/ & + &3.2238e-02_r8,3.3220e-02_r8,3.4363e-02_r8,3.5532e-02_r8,3.6904e-02_r8/) + kbo(:,15, 5) = (/ & + &3.0600e-02_r8,3.1610e-02_r8,3.2771e-02_r8,3.3966e-02_r8,3.5285e-02_r8/) + kbo(:,16, 5) = (/ & + &2.8159e-02_r8,2.9168e-02_r8,3.0264e-02_r8,3.1396e-02_r8,3.2647e-02_r8/) + kbo(:,17, 5) = (/ & + &2.5788e-02_r8,2.6724e-02_r8,2.7768e-02_r8,2.8866e-02_r8,3.0013e-02_r8/) + kbo(:,18, 5) = (/ & + &2.3487e-02_r8,2.4520e-02_r8,2.5499e-02_r8,2.6557e-02_r8,2.7740e-02_r8/) + kbo(:,19, 5) = (/ & + &2.1508e-02_r8,2.2551e-02_r8,2.3562e-02_r8,2.4611e-02_r8,2.5770e-02_r8/) + kbo(:,20, 5) = (/ & + &1.9153e-02_r8,2.0099e-02_r8,2.1123e-02_r8,2.2234e-02_r8,2.3370e-02_r8/) + kbo(:,21, 5) = (/ & + &1.6910e-02_r8,1.7820e-02_r8,1.8821e-02_r8,1.9939e-02_r8,2.1019e-02_r8/) + kbo(:,22, 5) = (/ & + &1.4892e-02_r8,1.5824e-02_r8,1.6836e-02_r8,1.7897e-02_r8,1.8973e-02_r8/) + kbo(:,23, 5) = (/ & + &1.3201e-02_r8,1.4110e-02_r8,1.5066e-02_r8,1.6122e-02_r8,1.7163e-02_r8/) + kbo(:,24, 5) = (/ & + &1.1786e-02_r8,1.2643e-02_r8,1.3592e-02_r8,1.4574e-02_r8,1.5604e-02_r8/) + kbo(:,25, 5) = (/ & + &1.0551e-02_r8,1.1376e-02_r8,1.2278e-02_r8,1.3228e-02_r8,1.4135e-02_r8/) + kbo(:,26, 5) = (/ & + &9.4341e-03_r8,1.0259e-02_r8,1.1075e-02_r8,1.1949e-02_r8,1.2760e-02_r8/) + kbo(:,27, 5) = (/ & + &8.4286e-03_r8,9.1773e-03_r8,9.9233e-03_r8,1.0676e-02_r8,1.1418e-02_r8/) + kbo(:,28, 5) = (/ & + &7.5098e-03_r8,8.1852e-03_r8,8.8662e-03_r8,9.5190e-03_r8,1.0161e-02_r8/) + kbo(:,29, 5) = (/ & + &6.6339e-03_r8,7.2146e-03_r8,7.8111e-03_r8,8.3875e-03_r8,8.9339e-03_r8/) + kbo(:,30, 5) = (/ & + &5.8318e-03_r8,6.3504e-03_r8,6.8644e-03_r8,7.3656e-03_r8,8.2854e-03_r8/) + kbo(:,31, 5) = (/ & + &5.0938e-03_r8,5.5450e-03_r8,5.9883e-03_r8,6.4048e-03_r8,7.2251e-03_r8/) + kbo(:,32, 5) = (/ & + &4.4534e-03_r8,4.8436e-03_r8,5.2343e-03_r8,5.5836e-03_r8,6.3649e-03_r8/) + kbo(:,33, 5) = (/ & + &3.8952e-03_r8,4.2551e-03_r8,4.5701e-03_r8,4.9101e-03_r8,5.6667e-03_r8/) + kbo(:,34, 5) = (/ & + &3.4434e-03_r8,3.7546e-03_r8,4.0585e-03_r8,4.7206e-03_r8,5.1136e-03_r8/) + kbo(:,35, 5) = (/ & + &3.0323e-03_r8,3.3194e-03_r8,3.6005e-03_r8,4.2419e-03_r8,4.6276e-03_r8/) + kbo(:,36, 5) = (/ & + &2.6713e-03_r8,2.9283e-03_r8,3.2072e-03_r8,3.8119e-03_r8,4.2091e-03_r8/) + kbo(:,37, 5) = (/ & + &2.2748e-03_r8,2.5138e-03_r8,2.7697e-03_r8,3.3361e-03_r8,3.7192e-03_r8/) + kbo(:,38, 5) = (/ & + &1.9294e-03_r8,2.1456e-03_r8,2.3858e-03_r8,2.9205e-03_r8,3.2883e-03_r8/) + kbo(:,39, 5) = (/ & + &1.6394e-03_r8,1.8308e-03_r8,2.0616e-03_r8,2.3311e-03_r8,2.9179e-03_r8/) + kbo(:,40, 5) = (/ & + &1.3611e-03_r8,1.5347e-03_r8,1.7447e-03_r8,1.9909e-03_r8,2.5336e-03_r8/) + kbo(:,41, 5) = (/ & + &1.1258e-03_r8,1.2811e-03_r8,1.4710e-03_r8,1.6948e-03_r8,2.1957e-03_r8/) + kbo(:,42, 5) = (/ & + &9.3054e-04_r8,1.0685e-03_r8,1.2380e-03_r8,1.4417e-03_r8,1.8992e-03_r8/) + kbo(:,43, 5) = (/ & + &7.5595e-04_r8,8.7758e-04_r8,1.0267e-03_r8,1.2093e-03_r8,1.4383e-03_r8/) + kbo(:,44, 5) = (/ & + &6.0708e-04_r8,7.1329e-04_r8,8.4285e-04_r8,1.0050e-03_r8,1.2098e-03_r8/) + kbo(:,45, 5) = (/ & + &4.8565e-04_r8,5.7704e-04_r8,6.8980e-04_r8,8.3254e-04_r8,1.0112e-03_r8/) + kbo(:,46, 5) = (/ & + &3.8568e-04_r8,4.6292e-04_r8,5.6071e-04_r8,6.8523e-04_r8,8.4055e-04_r8/) + kbo(:,47, 5) = (/ & + &3.0303e-04_r8,3.6775e-04_r8,4.5081e-04_r8,5.5621e-04_r8,6.9040e-04_r8/) + kbo(:,48, 5) = (/ & + &2.3629e-04_r8,2.9047e-04_r8,3.6009e-04_r8,4.4971e-04_r8,5.6449e-04_r8/) + kbo(:,49, 5) = (/ & + &1.8277e-04_r8,2.2768e-04_r8,2.8500e-04_r8,3.5988e-04_r8,4.5780e-04_r8/) + kbo(:,50, 5) = (/ & + &1.4236e-04_r8,1.7948e-04_r8,2.2683e-04_r8,2.8959e-04_r8,3.7278e-04_r8/) + kbo(:,51, 5) = (/ & + &1.1105e-04_r8,1.4188e-04_r8,1.8087e-04_r8,2.3323e-04_r8,3.0421e-04_r8/) + kbo(:,52, 5) = (/ & + &8.5949e-05_r8,1.1090e-04_r8,1.4310e-04_r8,1.8669e-04_r8,2.4668e-04_r8/) + kbo(:,53, 5) = (/ & + &6.6010e-05_r8,8.6189e-05_r8,1.1254e-04_r8,1.4823e-04_r8,1.9832e-04_r8/) + kbo(:,54, 5) = (/ & + &5.1508e-05_r8,6.7802e-05_r8,8.9425e-05_r8,1.1908e-04_r8,1.6117e-04_r8/) + kbo(:,55, 5) = (/ & + &4.0450e-05_r8,5.3662e-05_r8,7.1436e-05_r8,9.6039e-05_r8,1.3135e-04_r8/) + kbo(:,56, 5) = (/ & + &3.1739e-05_r8,4.2180e-05_r8,5.6735e-05_r8,7.6991e-05_r8,1.0631e-04_r8/) + kbo(:,57, 5) = (/ & + &2.4823e-05_r8,3.2939e-05_r8,4.4784e-05_r8,6.1322e-05_r8,8.5682e-05_r8/) + kbo(:,58, 5) = (/ & + &1.9514e-05_r8,2.5849e-05_r8,3.5397e-05_r8,4.8867e-05_r8,6.9076e-05_r8/) + kbo(:,59, 5) = (/ & + &1.6536e-05_r8,2.1873e-05_r8,3.0188e-05_r8,4.2152e-05_r8,6.0090e-05_r8/) + kbo(:,13, 6) = (/ & + &7.0936e-02_r8,7.2599e-02_r8,7.4412e-02_r8,7.6631e-02_r8,7.9197e-02_r8/) + kbo(:,14, 6) = (/ & + &6.5108e-02_r8,6.6883e-02_r8,6.8861e-02_r8,7.1194e-02_r8,7.3890e-02_r8/) + kbo(:,15, 6) = (/ & + &6.1844e-02_r8,6.3875e-02_r8,6.5914e-02_r8,6.8440e-02_r8,7.1135e-02_r8/) + kbo(:,16, 6) = (/ & + &5.8757e-02_r8,6.1061e-02_r8,6.3588e-02_r8,6.6243e-02_r8,6.9218e-02_r8/) + kbo(:,17, 6) = (/ & + &5.6075e-02_r8,5.8373e-02_r8,6.0818e-02_r8,6.3696e-02_r8,6.6956e-02_r8/) + kbo(:,18, 6) = (/ & + &5.3195e-02_r8,5.5446e-02_r8,5.8088e-02_r8,6.0906e-02_r8,6.3907e-02_r8/) + kbo(:,19, 6) = (/ & + &5.0738e-02_r8,5.2979e-02_r8,5.5433e-02_r8,5.8280e-02_r8,6.1280e-02_r8/) + kbo(:,20, 6) = (/ & + &4.6694e-02_r8,4.8984e-02_r8,5.1371e-02_r8,5.4034e-02_r8,5.7035e-02_r8/) + kbo(:,21, 6) = (/ & + &4.2499e-02_r8,4.4760e-02_r8,4.7087e-02_r8,4.9709e-02_r8,5.2664e-02_r8/) + kbo(:,22, 6) = (/ & + &3.8535e-02_r8,4.0776e-02_r8,4.3118e-02_r8,4.5805e-02_r8,4.8711e-02_r8/) + kbo(:,23, 6) = (/ & + &3.4990e-02_r8,3.7200e-02_r8,3.9611e-02_r8,4.2290e-02_r8,4.5266e-02_r8/) + kbo(:,24, 6) = (/ & + &3.1926e-02_r8,3.4161e-02_r8,3.6618e-02_r8,3.9305e-02_r8,4.2288e-02_r8/) + kbo(:,25, 6) = (/ & + &2.9165e-02_r8,3.1418e-02_r8,3.3868e-02_r8,3.6528e-02_r8,3.9610e-02_r8/) + kbo(:,26, 6) = (/ & + &2.6632e-02_r8,2.8869e-02_r8,3.1334e-02_r8,3.4138e-02_r8,3.7332e-02_r8/) + kbo(:,27, 6) = (/ & + &2.4229e-02_r8,2.6481e-02_r8,2.9027e-02_r8,3.1970e-02_r8,3.5096e-02_r8/) + kbo(:,28, 6) = (/ & + &2.2118e-02_r8,2.4355e-02_r8,2.6986e-02_r8,2.9969e-02_r8,3.3170e-02_r8/) + kbo(:,29, 6) = (/ & + &2.0075e-02_r8,2.2435e-02_r8,2.5083e-02_r8,2.8074e-02_r8,3.1267e-02_r8/) + kbo(:,30, 6) = (/ & + &1.8356e-02_r8,2.0732e-02_r8,2.3448e-02_r8,2.6423e-02_r8,3.0839e-02_r8/) + kbo(:,31, 6) = (/ & + &1.6821e-02_r8,1.9252e-02_r8,2.1963e-02_r8,2.5007e-02_r8,2.9517e-02_r8/) + kbo(:,32, 6) = (/ & + &1.5646e-02_r8,1.8065e-02_r8,2.0807e-02_r8,2.3917e-02_r8,2.8359e-02_r8/) + kbo(:,33, 6) = (/ & + &1.4697e-02_r8,1.7147e-02_r8,1.9949e-02_r8,2.3040e-02_r8,2.7566e-02_r8/) + kbo(:,34, 6) = (/ & + &1.3988e-02_r8,1.6488e-02_r8,1.9318e-02_r8,2.3681e-02_r8,2.7159e-02_r8/) + kbo(:,35, 6) = (/ & + &1.3271e-02_r8,1.5781e-02_r8,1.8680e-02_r8,2.3148e-02_r8,2.6620e-02_r8/) + kbo(:,36, 6) = (/ & + &1.2443e-02_r8,1.5030e-02_r8,1.7973e-02_r8,2.2405e-02_r8,2.5873e-02_r8/) + kbo(:,37, 6) = (/ & + &1.1274e-02_r8,1.3767e-02_r8,1.6642e-02_r8,2.1024e-02_r8,2.4462e-02_r8/) + kbo(:,38, 6) = (/ & + &1.0206e-02_r8,1.2636e-02_r8,1.5395e-02_r8,1.9741e-02_r8,2.3148e-02_r8/) + kbo(:,39, 6) = (/ & + &9.2481e-03_r8,1.1600e-02_r8,1.4300e-02_r8,1.7327e-02_r8,2.1951e-02_r8/) + kbo(:,40, 6) = (/ & + &8.1267e-03_r8,1.0335e-02_r8,1.2898e-02_r8,1.5836e-02_r8,2.0384e-02_r8/) + kbo(:,41, 6) = (/ & + &7.0946e-03_r8,9.1506e-03_r8,1.1587e-02_r8,1.4430e-02_r8,1.8862e-02_r8/) + kbo(:,42, 6) = (/ & + &6.1743e-03_r8,8.0792e-03_r8,1.0417e-02_r8,1.3119e-02_r8,1.7424e-02_r8/) + kbo(:,43, 6) = (/ & + &5.2531e-03_r8,6.9901e-03_r8,9.1605e-03_r8,1.1697e-02_r8,1.4583e-02_r8/) + kbo(:,44, 6) = (/ & + &4.3985e-03_r8,5.9665e-03_r8,7.9494e-03_r8,1.0327e-02_r8,1.3038e-02_r8/) + kbo(:,45, 6) = (/ & + &3.6636e-03_r8,5.0581e-03_r8,6.8612e-03_r8,9.0504e-03_r8,1.1599e-02_r8/) + kbo(:,46, 6) = (/ & + &3.0066e-03_r8,4.2365e-03_r8,5.8498e-03_r8,7.8432e-03_r8,1.0214e-02_r8/) + kbo(:,47, 6) = (/ & + &2.4125e-03_r8,3.4783e-03_r8,4.8978e-03_r8,6.6863e-03_r8,8.8516e-03_r8/) + kbo(:,48, 6) = (/ & + &1.9141e-03_r8,2.8190e-03_r8,4.0533e-03_r8,5.6391e-03_r8,7.5940e-03_r8/) + kbo(:,49, 6) = (/ & + &1.4995e-03_r8,2.2582e-03_r8,3.3183e-03_r8,4.7078e-03_r8,6.4551e-03_r8/) + kbo(:,50, 6) = (/ & + &1.1787e-03_r8,1.8162e-03_r8,2.7290e-03_r8,3.9486e-03_r8,5.5105e-03_r8/) + kbo(:,51, 6) = (/ & + &9.2536e-04_r8,1.4546e-03_r8,2.2372e-03_r8,3.3051e-03_r8,4.6909e-03_r8/) + kbo(:,52, 6) = (/ & + &7.1718e-04_r8,1.1533e-03_r8,1.8133e-03_r8,2.7360e-03_r8,3.9584e-03_r8/) + kbo(:,53, 6) = (/ & + &5.4913e-04_r8,9.0136e-04_r8,1.4515e-03_r8,2.2390e-03_r8,3.3052e-03_r8/) + kbo(:,54, 6) = (/ & + &4.2639e-04_r8,7.1524e-04_r8,1.1781e-03_r8,1.8604e-03_r8,2.8043e-03_r8/) + kbo(:,55, 6) = (/ & + &3.3211e-04_r8,5.6986e-04_r8,9.6021e-04_r8,1.5541e-03_r8,2.3898e-03_r8/) + kbo(:,56, 6) = (/ & + &2.5572e-04_r8,4.4925e-04_r8,7.7580e-04_r8,1.2883e-03_r8,2.0250e-03_r8/) + kbo(:,57, 6) = (/ & + &1.9517e-04_r8,3.4994e-04_r8,6.2105e-04_r8,1.0576e-03_r8,1.7032e-03_r8/) + kbo(:,58, 6) = (/ & + &1.4935e-04_r8,2.7300e-04_r8,4.9776e-04_r8,8.6979e-04_r8,1.4384e-03_r8/) + kbo(:,59, 6) = (/ & + &1.2881e-04_r8,2.4100e-04_r8,4.4942e-04_r8,8.0211e-04_r8,1.3455e-03_r8/) + kbo(:,13, 7) = (/ & + &1.5834e-01_r8,1.6249e-01_r8,1.6718e-01_r8,1.7299e-01_r8,1.7881e-01_r8/) + kbo(:,14, 7) = (/ & + &1.4697e-01_r8,1.5136e-01_r8,1.5631e-01_r8,1.6088e-01_r8,1.6631e-01_r8/) + kbo(:,15, 7) = (/ & + &1.4037e-01_r8,1.4484e-01_r8,1.4966e-01_r8,1.5465e-01_r8,1.6040e-01_r8/) + kbo(:,16, 7) = (/ & + &1.3335e-01_r8,1.3799e-01_r8,1.4282e-01_r8,1.4817e-01_r8,1.5433e-01_r8/) + kbo(:,17, 7) = (/ & + &1.2994e-01_r8,1.3481e-01_r8,1.4043e-01_r8,1.4652e-01_r8,1.5312e-01_r8/) + kbo(:,18, 7) = (/ & + &1.2814e-01_r8,1.3395e-01_r8,1.4042e-01_r8,1.4789e-01_r8,1.5627e-01_r8/) + kbo(:,19, 7) = (/ & + &1.2710e-01_r8,1.3361e-01_r8,1.4139e-01_r8,1.4985e-01_r8,1.5917e-01_r8/) + kbo(:,20, 7) = (/ & + &1.2151e-01_r8,1.2844e-01_r8,1.3635e-01_r8,1.4526e-01_r8,1.5485e-01_r8/) + kbo(:,21, 7) = (/ & + &1.1463e-01_r8,1.2176e-01_r8,1.2980e-01_r8,1.3882e-01_r8,1.4834e-01_r8/) + kbo(:,22, 7) = (/ & + &1.0733e-01_r8,1.1471e-01_r8,1.2303e-01_r8,1.3189e-01_r8,1.4224e-01_r8/) + kbo(:,23, 7) = (/ & + &1.0056e-01_r8,1.0811e-01_r8,1.1675e-01_r8,1.2597e-01_r8,1.3621e-01_r8/) + kbo(:,24, 7) = (/ & + &9.4505e-02_r8,1.0259e-01_r8,1.1127e-01_r8,1.2075e-01_r8,1.3101e-01_r8/) + kbo(:,25, 7) = (/ & + &8.9426e-02_r8,9.7409e-02_r8,1.0620e-01_r8,1.1605e-01_r8,1.2683e-01_r8/) + kbo(:,26, 7) = (/ & + &8.4533e-02_r8,9.2442e-02_r8,1.0164e-01_r8,1.1173e-01_r8,1.2271e-01_r8/) + kbo(:,27, 7) = (/ & + &7.9749e-02_r8,8.8003e-02_r8,9.7311e-02_r8,1.0746e-01_r8,1.1871e-01_r8/) + kbo(:,28, 7) = (/ & + &7.5483e-02_r8,8.3936e-02_r8,9.3313e-02_r8,1.0378e-01_r8,1.1507e-01_r8/) + kbo(:,29, 7) = (/ & + &7.1103e-02_r8,7.9904e-02_r8,8.9739e-02_r8,1.0032e-01_r8,1.1148e-01_r8/) + kbo(:,30, 7) = (/ & + &6.7483e-02_r8,7.6590e-02_r8,8.6589e-02_r8,9.7210e-02_r8,1.1098e-01_r8/) + kbo(:,31, 7) = (/ & + &6.4404e-02_r8,7.3695e-02_r8,8.3853e-02_r8,9.4939e-02_r8,1.0916e-01_r8/) + kbo(:,32, 7) = (/ & + &6.2132e-02_r8,7.1593e-02_r8,8.2197e-02_r8,9.3726e-02_r8,1.0838e-01_r8/) + kbo(:,33, 7) = (/ & + &6.0812e-02_r8,7.0660e-02_r8,8.1722e-02_r8,9.3787e-02_r8,1.0875e-01_r8/) + kbo(:,34, 7) = (/ & + &6.0340e-02_r8,7.0788e-02_r8,8.2210e-02_r8,9.6618e-02_r8,1.0965e-01_r8/) + kbo(:,35, 7) = (/ & + &5.9655e-02_r8,7.0346e-02_r8,8.1926e-02_r8,9.6670e-02_r8,1.0999e-01_r8/) + kbo(:,36, 7) = (/ & + &5.8475e-02_r8,6.9222e-02_r8,8.1005e-02_r8,9.6061e-02_r8,1.0964e-01_r8/) + kbo(:,37, 7) = (/ & + &5.5330e-02_r8,6.5969e-02_r8,7.7716e-02_r8,9.2736e-02_r8,1.0626e-01_r8/) + kbo(:,38, 7) = (/ & + &5.2353e-02_r8,6.2872e-02_r8,7.4519e-02_r8,8.9400e-02_r8,1.0278e-01_r8/) + kbo(:,39, 7) = (/ & + &4.9669e-02_r8,5.9933e-02_r8,7.1439e-02_r8,8.4019e-02_r8,9.9553e-02_r8/) + kbo(:,40, 7) = (/ & + &4.5810e-02_r8,5.5845e-02_r8,6.7001e-02_r8,7.9231e-02_r8,9.4558e-02_r8/) + kbo(:,41, 7) = (/ & + &4.2118e-02_r8,5.1782e-02_r8,6.2542e-02_r8,7.4429e-02_r8,8.9527e-02_r8/) + kbo(:,42, 7) = (/ & + &3.8602e-02_r8,4.7947e-02_r8,5.8290e-02_r8,6.9790e-02_r8,8.4691e-02_r8/) + kbo(:,43, 7) = (/ & + &3.4683e-02_r8,4.3605e-02_r8,5.3513e-02_r8,6.4549e-02_r8,7.6612e-02_r8/) + kbo(:,44, 7) = (/ & + &3.0820e-02_r8,3.9228e-02_r8,4.8707e-02_r8,5.9113e-02_r8,7.0667e-02_r8/) + kbo(:,45, 7) = (/ & + &2.7206e-02_r8,3.5088e-02_r8,4.4017e-02_r8,5.3958e-02_r8,6.4971e-02_r8/) + kbo(:,46, 7) = (/ & + &2.3728e-02_r8,3.1004e-02_r8,3.9410e-02_r8,4.8844e-02_r8,5.9195e-02_r8/) + kbo(:,47, 7) = (/ & + &2.0318e-02_r8,2.6968e-02_r8,3.4803e-02_r8,4.3672e-02_r8,5.3514e-02_r8/) + kbo(:,48, 7) = (/ & + &1.7221e-02_r8,2.3270e-02_r8,3.0475e-02_r8,3.8751e-02_r8,4.8067e-02_r8/) + kbo(:,49, 7) = (/ & + &1.4371e-02_r8,1.9831e-02_r8,2.6371e-02_r8,3.4011e-02_r8,4.2706e-02_r8/) + kbo(:,50, 7) = (/ & + &1.2067e-02_r8,1.6953e-02_r8,2.2948e-02_r8,3.0025e-02_r8,3.8163e-02_r8/) + kbo(:,51, 7) = (/ & + &1.0081e-02_r8,1.4494e-02_r8,1.9976e-02_r8,2.6511e-02_r8,3.4117e-02_r8/) + kbo(:,52, 7) = (/ & + &8.3102e-03_r8,1.2227e-02_r8,1.7157e-02_r8,2.3198e-02_r8,3.0263e-02_r8/) + kbo(:,53, 7) = (/ & + &6.7300e-03_r8,1.0157e-02_r8,1.4580e-02_r8,2.0030e-02_r8,2.6549e-02_r8/) + kbo(:,54, 7) = (/ & + &5.5699e-03_r8,8.6183e-03_r8,1.2632e-02_r8,1.7641e-02_r8,2.3782e-02_r8/) + kbo(:,55, 7) = (/ & + &4.6424e-03_r8,7.3686e-03_r8,1.1048e-02_r8,1.5705e-02_r8,2.1480e-02_r8/) + kbo(:,56, 7) = (/ & + &3.8360e-03_r8,6.2508e-03_r8,9.5901e-03_r8,1.3914e-02_r8,1.9327e-02_r8/) + kbo(:,57, 7) = (/ & + &3.1377e-03_r8,5.2589e-03_r8,8.2647e-03_r8,1.2235e-02_r8,1.7290e-02_r8/) + kbo(:,58, 7) = (/ & + &2.5678e-03_r8,4.4320e-03_r8,7.1403e-03_r8,1.0793e-02_r8,1.5530e-02_r8/) + kbo(:,59, 7) = (/ & + &2.3969e-03_r8,4.2221e-03_r8,6.8990e-03_r8,1.0531e-02_r8,1.5294e-02_r8/) + kbo(:,13, 8) = (/ & + &4.5374e-01_r8,4.6892e-01_r8,4.8468e-01_r8,5.0059e-01_r8,5.1827e-01_r8/) + kbo(:,14, 8) = (/ & + &4.3219e-01_r8,4.4586e-01_r8,4.6019e-01_r8,4.7608e-01_r8,4.9298e-01_r8/) + kbo(:,15, 8) = (/ & + &4.0920e-01_r8,4.2277e-01_r8,4.3751e-01_r8,4.5370e-01_r8,4.7139e-01_r8/) + kbo(:,16, 8) = (/ & + &3.8774e-01_r8,3.9959e-01_r8,4.1438e-01_r8,4.3100e-01_r8,4.4920e-01_r8/) + kbo(:,17, 8) = (/ & + &3.7675e-01_r8,3.9034e-01_r8,4.0535e-01_r8,4.2142e-01_r8,4.3931e-01_r8/) + kbo(:,18, 8) = (/ & + &3.7210e-01_r8,3.8690e-01_r8,4.0196e-01_r8,4.1888e-01_r8,4.3633e-01_r8/) + kbo(:,19, 8) = (/ & + &3.8004e-01_r8,3.9604e-01_r8,4.1156e-01_r8,4.2942e-01_r8,4.4872e-01_r8/) + kbo(:,20, 8) = (/ & + &3.8032e-01_r8,3.9826e-01_r8,4.1629e-01_r8,4.3599e-01_r8,4.5653e-01_r8/) + kbo(:,21, 8) = (/ & + &3.7841e-01_r8,3.9929e-01_r8,4.1819e-01_r8,4.3972e-01_r8,4.6162e-01_r8/) + kbo(:,22, 8) = (/ & + &3.7504e-01_r8,3.9852e-01_r8,4.2087e-01_r8,4.4494e-01_r8,4.6985e-01_r8/) + kbo(:,23, 8) = (/ & + &3.7298e-01_r8,3.9721e-01_r8,4.2335e-01_r8,4.5127e-01_r8,4.7949e-01_r8/) + kbo(:,24, 8) = (/ & + &3.7096e-01_r8,3.9820e-01_r8,4.2817e-01_r8,4.5927e-01_r8,4.9128e-01_r8/) + kbo(:,25, 8) = (/ & + &3.6772e-01_r8,3.9818e-01_r8,4.3145e-01_r8,4.6548e-01_r8,5.0188e-01_r8/) + kbo(:,26, 8) = (/ & + &3.6515e-01_r8,3.9789e-01_r8,4.3248e-01_r8,4.6959e-01_r8,5.0716e-01_r8/) + kbo(:,27, 8) = (/ & + &3.5912e-01_r8,3.9421e-01_r8,4.3089e-01_r8,4.6934e-01_r8,5.0871e-01_r8/) + kbo(:,28, 8) = (/ & + &3.5260e-01_r8,3.8990e-01_r8,4.2842e-01_r8,4.6770e-01_r8,5.0872e-01_r8/) + kbo(:,29, 8) = (/ & + &3.4566e-01_r8,3.8302e-01_r8,4.2135e-01_r8,4.6236e-01_r8,5.0539e-01_r8/) + kbo(:,30, 8) = (/ & + &3.3909e-01_r8,3.7648e-01_r8,4.1601e-01_r8,4.5869e-01_r8,5.0690e-01_r8/) + kbo(:,31, 8) = (/ & + &3.3097e-01_r8,3.6927e-01_r8,4.1020e-01_r8,4.5248e-01_r8,5.0201e-01_r8/) + kbo(:,32, 8) = (/ & + &3.2677e-01_r8,3.6552e-01_r8,4.0712e-01_r8,4.4947e-01_r8,4.9828e-01_r8/) + kbo(:,33, 8) = (/ & + &3.2437e-01_r8,3.6324e-01_r8,4.0445e-01_r8,4.4744e-01_r8,4.9526e-01_r8/) + kbo(:,34, 8) = (/ & + &3.2478e-01_r8,3.6385e-01_r8,4.0433e-01_r8,4.5266e-01_r8,4.9618e-01_r8/) + kbo(:,35, 8) = (/ & + &3.2335e-01_r8,3.6225e-01_r8,4.0283e-01_r8,4.5093e-01_r8,4.9595e-01_r8/) + kbo(:,36, 8) = (/ & + &3.1952e-01_r8,3.5913e-01_r8,4.0020e-01_r8,4.4926e-01_r8,4.9354e-01_r8/) + kbo(:,37, 8) = (/ & + &3.0545e-01_r8,3.4531e-01_r8,3.8604e-01_r8,4.3520e-01_r8,4.7874e-01_r8/) + kbo(:,38, 8) = (/ & + &2.9161e-01_r8,3.3033e-01_r8,3.7111e-01_r8,4.1959e-01_r8,4.6334e-01_r8/) + kbo(:,39, 8) = (/ & + &2.7728e-01_r8,3.1579e-01_r8,3.5591e-01_r8,3.9884e-01_r8,4.4658e-01_r8/) + kbo(:,40, 8) = (/ & + &2.6059e-01_r8,2.9767e-01_r8,3.3670e-01_r8,3.7917e-01_r8,4.2621e-01_r8/) + kbo(:,41, 8) = (/ & + &2.4427e-01_r8,2.7974e-01_r8,3.1821e-01_r8,3.5868e-01_r8,4.0499e-01_r8/) + kbo(:,42, 8) = (/ & + &2.2818e-01_r8,2.6203e-01_r8,2.9920e-01_r8,3.3811e-01_r8,3.8330e-01_r8/) + kbo(:,43, 8) = (/ & + &2.1001e-01_r8,2.4274e-01_r8,2.7765e-01_r8,3.1477e-01_r8,3.5346e-01_r8/) + kbo(:,44, 8) = (/ & + &1.9124e-01_r8,2.2202e-01_r8,2.5515e-01_r8,2.8981e-01_r8,3.2699e-01_r8/) + kbo(:,45, 8) = (/ & + &1.7260e-01_r8,2.0229e-01_r8,2.3352e-01_r8,2.6561e-01_r8,2.9973e-01_r8/) + kbo(:,46, 8) = (/ & + &1.5463e-01_r8,1.8250e-01_r8,2.1175e-01_r8,2.4206e-01_r8,2.7362e-01_r8/) + kbo(:,47, 8) = (/ & + &1.3753e-01_r8,1.6353e-01_r8,1.9105e-01_r8,2.1973e-01_r8,2.4911e-01_r8/) + kbo(:,48, 8) = (/ & + &1.2102e-01_r8,1.4531e-01_r8,1.7086e-01_r8,1.9744e-01_r8,2.2473e-01_r8/) + kbo(:,49, 8) = (/ & + &1.0521e-01_r8,1.2719e-01_r8,1.5065e-01_r8,1.7507e-01_r8,1.9976e-01_r8/) + kbo(:,50, 8) = (/ & + &9.2290e-02_r8,1.1288e-01_r8,1.3468e-01_r8,1.5758e-01_r8,1.8102e-01_r8/) + kbo(:,51, 8) = (/ & + &8.1396e-02_r8,1.0065e-01_r8,1.2103e-01_r8,1.4278e-01_r8,1.6472e-01_r8/) + kbo(:,52, 8) = (/ & + &7.1108e-02_r8,8.8827e-02_r8,1.0785e-01_r8,1.2780e-01_r8,1.4857e-01_r8/) + kbo(:,53, 8) = (/ & + &6.0985e-02_r8,7.7296e-02_r8,9.4909e-02_r8,1.1304e-01_r8,1.3292e-01_r8/) + kbo(:,54, 8) = (/ & + &5.4165e-02_r8,6.9879e-02_r8,8.6686e-02_r8,1.0438e-01_r8,1.2336e-01_r8/) + kbo(:,55, 8) = (/ & + &4.9072e-02_r8,6.4377e-02_r8,8.0975e-02_r8,9.8517e-02_r8,1.1715e-01_r8/) + kbo(:,56, 8) = (/ & + &4.4131e-02_r8,5.9064e-02_r8,7.5254e-02_r8,9.2618e-02_r8,1.1083e-01_r8/) + kbo(:,57, 8) = (/ & + &3.9404e-02_r8,5.3744e-02_r8,6.9648e-02_r8,8.6728e-02_r8,1.0474e-01_r8/) + kbo(:,58, 8) = (/ & + &3.5245e-02_r8,4.9278e-02_r8,6.4917e-02_r8,8.1857e-02_r8,9.9966e-02_r8/) + kbo(:,59, 8) = (/ & + &3.5641e-02_r8,5.0530e-02_r8,6.7256e-02_r8,8.5600e-02_r8,1.0518e-01_r8/) + kbo(:,13, 9) = (/ & + &3.0582e+00_r8,3.1802e+00_r8,3.2924e+00_r8,3.3999e+00_r8,3.5039e+00_r8/) + kbo(:,14, 9) = (/ & + &2.7741e+00_r8,2.8902e+00_r8,2.9983e+00_r8,3.1018e+00_r8,3.1995e+00_r8/) + kbo(:,15, 9) = (/ & + &2.5019e+00_r8,2.6118e+00_r8,2.7174e+00_r8,2.8165e+00_r8,2.9092e+00_r8/) + kbo(:,16, 9) = (/ & + &2.2794e+00_r8,2.3785e+00_r8,2.4700e+00_r8,2.5601e+00_r8,2.6476e+00_r8/) + kbo(:,17, 9) = (/ & + &2.1431e+00_r8,2.2237e+00_r8,2.2973e+00_r8,2.3689e+00_r8,2.4470e+00_r8/) + kbo(:,18, 9) = (/ & + &2.1112e+00_r8,2.1931e+00_r8,2.2642e+00_r8,2.3350e+00_r8,2.3995e+00_r8/) + kbo(:,19, 9) = (/ & + &2.1192e+00_r8,2.1960e+00_r8,2.2679e+00_r8,2.3312e+00_r8,2.3985e+00_r8/) + kbo(:,20, 9) = (/ & + &2.0719e+00_r8,2.1504e+00_r8,2.2204e+00_r8,2.2883e+00_r8,2.3541e+00_r8/) + kbo(:,21, 9) = (/ & + &2.0023e+00_r8,2.0787e+00_r8,2.1566e+00_r8,2.2279e+00_r8,2.2981e+00_r8/) + kbo(:,22, 9) = (/ & + &1.9677e+00_r8,2.0354e+00_r8,2.1023e+00_r8,2.1820e+00_r8,2.2522e+00_r8/) + kbo(:,23, 9) = (/ & + &1.9509e+00_r8,2.0289e+00_r8,2.0929e+00_r8,2.1547e+00_r8,2.2177e+00_r8/) + kbo(:,24, 9) = (/ & + &1.9605e+00_r8,2.0316e+00_r8,2.0945e+00_r8,2.1537e+00_r8,2.2147e+00_r8/) + kbo(:,25, 9) = (/ & + &1.9774e+00_r8,2.0460e+00_r8,2.1037e+00_r8,2.1656e+00_r8,2.2237e+00_r8/) + kbo(:,26, 9) = (/ & + &1.9746e+00_r8,2.0494e+00_r8,2.1183e+00_r8,2.1793e+00_r8,2.2462e+00_r8/) + kbo(:,27, 9) = (/ & + &1.9769e+00_r8,2.0480e+00_r8,2.1184e+00_r8,2.1915e+00_r8,2.2594e+00_r8/) + kbo(:,28, 9) = (/ & + &1.9705e+00_r8,2.0478e+00_r8,2.1273e+00_r8,2.2021e+00_r8,2.2684e+00_r8/) + kbo(:,29, 9) = (/ & + &1.9428e+00_r8,2.0233e+00_r8,2.1092e+00_r8,2.1834e+00_r8,2.2523e+00_r8/) + kbo(:,30, 9) = (/ & + &1.9054e+00_r8,1.9928e+00_r8,2.0804e+00_r8,2.1559e+00_r8,2.2456e+00_r8/) + kbo(:,31, 9) = (/ & + &1.8578e+00_r8,1.9522e+00_r8,2.0363e+00_r8,2.1176e+00_r8,2.2067e+00_r8/) + kbo(:,32, 9) = (/ & + &1.8167e+00_r8,1.9163e+00_r8,1.9986e+00_r8,2.0826e+00_r8,2.1707e+00_r8/) + kbo(:,33, 9) = (/ & + &1.7835e+00_r8,1.8773e+00_r8,1.9713e+00_r8,2.0531e+00_r8,2.1415e+00_r8/) + kbo(:,34, 9) = (/ & + &1.7699e+00_r8,1.8654e+00_r8,1.9579e+00_r8,2.0589e+00_r8,2.1344e+00_r8/) + kbo(:,35, 9) = (/ & + &1.7588e+00_r8,1.8543e+00_r8,1.9464e+00_r8,2.0494e+00_r8,2.1255e+00_r8/) + kbo(:,36, 9) = (/ & + &1.7548e+00_r8,1.8549e+00_r8,1.9407e+00_r8,2.0440e+00_r8,2.1280e+00_r8/) + kbo(:,37, 9) = (/ & + &1.7109e+00_r8,1.8072e+00_r8,1.9003e+00_r8,1.9969e+00_r8,2.0787e+00_r8/) + kbo(:,38, 9) = (/ & + &1.6587e+00_r8,1.7570e+00_r8,1.8515e+00_r8,1.9517e+00_r8,2.0362e+00_r8/) + kbo(:,39, 9) = (/ & + &1.5996e+00_r8,1.6993e+00_r8,1.7940e+00_r8,1.8844e+00_r8,1.9872e+00_r8/) + kbo(:,40, 9) = (/ & + &1.5318e+00_r8,1.6341e+00_r8,1.7309e+00_r8,1.8212e+00_r8,1.9247e+00_r8/) + kbo(:,41, 9) = (/ & + &1.4675e+00_r8,1.5693e+00_r8,1.6630e+00_r8,1.7538e+00_r8,1.8608e+00_r8/) + kbo(:,42, 9) = (/ & + &1.4053e+00_r8,1.5014e+00_r8,1.5957e+00_r8,1.6862e+00_r8,1.7957e+00_r8/) + kbo(:,43, 9) = (/ & + &1.3266e+00_r8,1.4241e+00_r8,1.5193e+00_r8,1.6083e+00_r8,1.7037e+00_r8/) + kbo(:,44, 9) = (/ & + &1.2422e+00_r8,1.3405e+00_r8,1.4375e+00_r8,1.5296e+00_r8,1.6219e+00_r8/) + kbo(:,45, 9) = (/ & + &1.1571e+00_r8,1.2540e+00_r8,1.3469e+00_r8,1.4395e+00_r8,1.5427e+00_r8/) + kbo(:,46, 9) = (/ & + &1.0762e+00_r8,1.1688e+00_r8,1.2622e+00_r8,1.3587e+00_r8,1.4621e+00_r8/) + kbo(:,47, 9) = (/ & + &9.9321e-01_r8,1.0861e+00_r8,1.1791e+00_r8,1.2774e+00_r8,1.3779e+00_r8/) + kbo(:,48, 9) = (/ & + &9.0640e-01_r8,1.0035e+00_r8,1.0964e+00_r8,1.1955e+00_r8,1.2984e+00_r8/) + kbo(:,49, 9) = (/ & + &8.2476e-01_r8,9.1593e-01_r8,1.0111e+00_r8,1.1148e+00_r8,1.2202e+00_r8/) + kbo(:,50, 9) = (/ & + &7.5762e-01_r8,8.4984e-01_r8,9.4454e-01_r8,1.0468e+00_r8,1.1530e+00_r8/) + kbo(:,51, 9) = (/ & + &6.9972e-01_r8,7.8939e-01_r8,8.8551e-01_r8,9.8599e-01_r8,1.0894e+00_r8/) + kbo(:,52, 9) = (/ & + &6.4292e-01_r8,7.3062e-01_r8,8.2745e-01_r8,9.2620e-01_r8,1.0265e+00_r8/) + kbo(:,53, 9) = (/ & + &5.8631e-01_r8,6.7367e-01_r8,7.6794e-01_r8,8.6557e-01_r8,9.6191e-01_r8/) + kbo(:,54, 9) = (/ & + &5.4766e-01_r8,6.3312e-01_r8,7.2658e-01_r8,8.2340e-01_r8,9.1820e-01_r8/) + kbo(:,55, 9) = (/ & + &5.1893e-01_r8,6.0477e-01_r8,6.9346e-01_r8,7.9003e-01_r8,8.8552e-01_r8/) + kbo(:,56, 9) = (/ & + &4.9077e-01_r8,5.7504e-01_r8,6.6139e-01_r8,7.5822e-01_r8,8.5232e-01_r8/) + kbo(:,57, 9) = (/ & + &4.6294e-01_r8,5.4644e-01_r8,6.3217e-01_r8,7.2497e-01_r8,8.2095e-01_r8/) + kbo(:,58, 9) = (/ & + &4.3872e-01_r8,5.2209e-01_r8,6.0717e-01_r8,6.9576e-01_r8,7.9255e-01_r8/) + kbo(:,59, 9) = (/ & + &4.5355e-01_r8,5.4099e-01_r8,6.2851e-01_r8,7.1405e-01_r8,8.0552e-01_r8/) + kbo(:,13,10) = (/ & + &1.4982e+01_r8,1.5495e+01_r8,1.5954e+01_r8,1.6348e+01_r8,1.6704e+01_r8/) + kbo(:,14,10) = (/ & + &1.3335e+01_r8,1.3739e+01_r8,1.4075e+01_r8,1.4394e+01_r8,1.4701e+01_r8/) + kbo(:,15,10) = (/ & + &1.2249e+01_r8,1.2466e+01_r8,1.2680e+01_r8,1.2851e+01_r8,1.2999e+01_r8/) + kbo(:,16,10) = (/ & + &1.1258e+01_r8,1.1509e+01_r8,1.1735e+01_r8,1.1863e+01_r8,1.1992e+01_r8/) + kbo(:,17,10) = (/ & + &9.6399e+00_r8,9.9316e+00_r8,1.0198e+01_r8,1.0495e+01_r8,1.0685e+01_r8/) + kbo(:,18,10) = (/ & + &8.3200e+00_r8,8.3604e+00_r8,8.4791e+00_r8,8.5483e+00_r8,8.6485e+00_r8/) + kbo(:,19,10) = (/ & + &8.1074e+00_r8,8.1199e+00_r8,8.1734e+00_r8,8.2725e+00_r8,8.2532e+00_r8/) + kbo(:,20,10) = (/ & + &8.0251e+00_r8,8.0270e+00_r8,8.1639e+00_r8,8.2375e+00_r8,8.2230e+00_r8/) + kbo(:,21,10) = (/ & + &7.9993e+00_r8,8.0934e+00_r8,8.2060e+00_r8,8.1449e+00_r8,8.1878e+00_r8/) + kbo(:,22,10) = (/ & + &7.7052e+00_r8,7.8023e+00_r8,8.0192e+00_r8,8.0278e+00_r8,8.0411e+00_r8/) + kbo(:,23,10) = (/ & + &7.2443e+00_r8,7.3880e+00_r8,7.6036e+00_r8,7.7289e+00_r8,7.8141e+00_r8/) + kbo(:,24,10) = (/ & + &6.8599e+00_r8,6.9432e+00_r8,7.2334e+00_r8,7.4508e+00_r8,7.5685e+00_r8/) + kbo(:,25,10) = (/ & + &6.7077e+00_r8,6.7570e+00_r8,7.0253e+00_r8,7.1690e+00_r8,7.3506e+00_r8/) + kbo(:,26,10) = (/ & + &6.7805e+00_r8,6.7972e+00_r8,6.9739e+00_r8,6.9966e+00_r8,7.1457e+00_r8/) + kbo(:,27,10) = (/ & + &6.6456e+00_r8,6.8298e+00_r8,6.9537e+00_r8,6.8703e+00_r8,6.9847e+00_r8/) + kbo(:,28,10) = (/ & + &6.6227e+00_r8,6.7740e+00_r8,6.7717e+00_r8,6.7969e+00_r8,6.8834e+00_r8/) + kbo(:,29,10) = (/ & + &6.5026e+00_r8,6.7130e+00_r8,6.6983e+00_r8,6.7888e+00_r8,6.9842e+00_r8/) + kbo(:,30,10) = (/ & + &6.4613e+00_r8,6.7438e+00_r8,6.7406e+00_r8,6.8001e+00_r8,7.0628e+00_r8/) + kbo(:,31,10) = (/ & + &6.4453e+00_r8,6.5818e+00_r8,6.6914e+00_r8,6.8343e+00_r8,7.1118e+00_r8/) + kbo(:,32,10) = (/ & + &6.4750e+00_r8,6.5165e+00_r8,6.6931e+00_r8,6.9311e+00_r8,7.2907e+00_r8/) + kbo(:,33,10) = (/ & + &6.3852e+00_r8,6.5174e+00_r8,6.6687e+00_r8,7.0429e+00_r8,7.4921e+00_r8/) + kbo(:,34,10) = (/ & + &6.2937e+00_r8,6.5395e+00_r8,6.7522e+00_r8,7.1615e+00_r8,7.5856e+00_r8/) + kbo(:,35,10) = (/ & + &6.2760e+00_r8,6.5561e+00_r8,6.8772e+00_r8,7.3182e+00_r8,7.7508e+00_r8/) + kbo(:,36,10) = (/ & + &6.2498e+00_r8,6.5146e+00_r8,6.9721e+00_r8,7.4134e+00_r8,7.7777e+00_r8/) + kbo(:,37,10) = (/ & + &6.0875e+00_r8,6.4490e+00_r8,6.8813e+00_r8,7.4029e+00_r8,7.7937e+00_r8/) + kbo(:,38,10) = (/ & + &5.9776e+00_r8,6.3534e+00_r8,6.8337e+00_r8,7.2840e+00_r8,7.6800e+00_r8/) + kbo(:,39,10) = (/ & + &5.9369e+00_r8,6.2769e+00_r8,6.7228e+00_r8,7.1879e+00_r8,7.5772e+00_r8/) + kbo(:,40,10) = (/ & + &5.8199e+00_r8,6.1346e+00_r8,6.5569e+00_r8,7.0308e+00_r8,7.5139e+00_r8/) + kbo(:,41,10) = (/ & + &5.6637e+00_r8,5.9953e+00_r8,6.3928e+00_r8,6.8959e+00_r8,7.3899e+00_r8/) + kbo(:,42,10) = (/ & + &5.4578e+00_r8,5.8740e+00_r8,6.2837e+00_r8,6.7615e+00_r8,7.2182e+00_r8/) + kbo(:,43,10) = (/ & + &5.2432e+00_r8,5.6884e+00_r8,6.0915e+00_r8,6.5892e+00_r8,7.0176e+00_r8/) + kbo(:,44,10) = (/ & + &5.0352e+00_r8,5.5134e+00_r8,5.9765e+00_r8,6.3927e+00_r8,6.8192e+00_r8/) + kbo(:,45,10) = (/ & + &4.8185e+00_r8,5.3066e+00_r8,5.8216e+00_r8,6.2708e+00_r8,6.5394e+00_r8/) + kbo(:,46,10) = (/ & + &4.5458e+00_r8,5.0700e+00_r8,5.5601e+00_r8,5.9708e+00_r8,6.3061e+00_r8/) + kbo(:,47,10) = (/ & + &4.3290e+00_r8,4.8090e+00_r8,5.3177e+00_r8,5.7187e+00_r8,6.0493e+00_r8/) + kbo(:,48,10) = (/ & + &4.1252e+00_r8,4.6210e+00_r8,5.0031e+00_r8,5.3950e+00_r8,5.6779e+00_r8/) + kbo(:,49,10) = (/ & + &3.8776e+00_r8,4.3638e+00_r8,4.7491e+00_r8,5.0119e+00_r8,5.3209e+00_r8/) + kbo(:,50,10) = (/ & + &3.6432e+00_r8,4.1171e+00_r8,4.5036e+00_r8,4.8339e+00_r8,5.0310e+00_r8/) + kbo(:,51,10) = (/ & + &3.4528e+00_r8,3.8987e+00_r8,4.2685e+00_r8,4.6158e+00_r8,4.8586e+00_r8/) + kbo(:,52,10) = (/ & + &3.2373e+00_r8,3.6786e+00_r8,4.0057e+00_r8,4.3579e+00_r8,4.6615e+00_r8/) + kbo(:,53,10) = (/ & + &3.0066e+00_r8,3.4261e+00_r8,3.7660e+00_r8,4.0904e+00_r8,4.4162e+00_r8/) + kbo(:,54,10) = (/ & + &2.8305e+00_r8,3.2571e+00_r8,3.6215e+00_r8,3.9208e+00_r8,4.2651e+00_r8/) + kbo(:,55,10) = (/ & + &2.6852e+00_r8,3.0952e+00_r8,3.4961e+00_r8,3.7995e+00_r8,4.1315e+00_r8/) + kbo(:,56,10) = (/ & + &2.5024e+00_r8,2.9749e+00_r8,3.3840e+00_r8,3.6764e+00_r8,4.0215e+00_r8/) + kbo(:,57,10) = (/ & + &2.3413e+00_r8,2.8251e+00_r8,3.2333e+00_r8,3.5901e+00_r8,3.8695e+00_r8/) + kbo(:,58,10) = (/ & + &2.2399e+00_r8,2.6684e+00_r8,3.1055e+00_r8,3.4841e+00_r8,3.7568e+00_r8/) + kbo(:,59,10) = (/ & + &2.3106e+00_r8,2.6842e+00_r8,3.0911e+00_r8,3.5243e+00_r8,3.8718e+00_r8/) + kbo(:,13,11) = (/ & + &3.1114e+01_r8,3.1701e+01_r8,3.2323e+01_r8,3.2943e+01_r8,3.3516e+01_r8/) + kbo(:,14,11) = (/ & + &2.7715e+01_r8,2.8303e+01_r8,2.8933e+01_r8,2.9548e+01_r8,3.0169e+01_r8/) + kbo(:,15,11) = (/ & + &2.4338e+01_r8,2.4986e+01_r8,2.5617e+01_r8,2.6312e+01_r8,2.7005e+01_r8/) + kbo(:,16,11) = (/ & + &2.1212e+01_r8,2.1803e+01_r8,2.2432e+01_r8,2.3085e+01_r8,2.3696e+01_r8/) + kbo(:,17,11) = (/ & + &1.8965e+01_r8,1.9451e+01_r8,1.9925e+01_r8,2.0308e+01_r8,2.0718e+01_r8/) + kbo(:,18,11) = (/ & + &1.6301e+01_r8,1.6846e+01_r8,1.7358e+01_r8,1.7884e+01_r8,1.8436e+01_r8/) + kbo(:,19,11) = (/ & + &1.3305e+01_r8,1.3592e+01_r8,1.3869e+01_r8,1.4251e+01_r8,1.4704e+01_r8/) + kbo(:,20,11) = (/ & + &1.2734e+01_r8,1.2816e+01_r8,1.2643e+01_r8,1.2573e+01_r8,1.2686e+01_r8/) + kbo(:,21,11) = (/ & + &1.2657e+01_r8,1.2589e+01_r8,1.2354e+01_r8,1.2271e+01_r8,1.2114e+01_r8/) + kbo(:,22,11) = (/ & + &1.2492e+01_r8,1.2455e+01_r8,1.2170e+01_r8,1.1916e+01_r8,1.1871e+01_r8/) + kbo(:,23,11) = (/ & + &1.2437e+01_r8,1.2266e+01_r8,1.2152e+01_r8,1.1923e+01_r8,1.2016e+01_r8/) + kbo(:,24,11) = (/ & + &1.2312e+01_r8,1.2409e+01_r8,1.2179e+01_r8,1.1958e+01_r8,1.2034e+01_r8/) + kbo(:,25,11) = (/ & + &1.1905e+01_r8,1.2160e+01_r8,1.2010e+01_r8,1.2119e+01_r8,1.2127e+01_r8/) + kbo(:,26,11) = (/ & + &1.1398e+01_r8,1.1792e+01_r8,1.1851e+01_r8,1.2073e+01_r8,1.2295e+01_r8/) + kbo(:,27,11) = (/ & + &1.1115e+01_r8,1.1534e+01_r8,1.1738e+01_r8,1.2206e+01_r8,1.2469e+01_r8/) + kbo(:,28,11) = (/ & + &1.0833e+01_r8,1.1382e+01_r8,1.1757e+01_r8,1.2168e+01_r8,1.2751e+01_r8/) + kbo(:,29,11) = (/ & + &1.0849e+01_r8,1.1242e+01_r8,1.1765e+01_r8,1.2112e+01_r8,1.2581e+01_r8/) + kbo(:,30,11) = (/ & + &1.0908e+01_r8,1.1219e+01_r8,1.1698e+01_r8,1.2283e+01_r8,1.2675e+01_r8/) + kbo(:,31,11) = (/ & + &1.1065e+01_r8,1.1480e+01_r8,1.1755e+01_r8,1.2188e+01_r8,1.2848e+01_r8/) + kbo(:,32,11) = (/ & + &1.1087e+01_r8,1.1591e+01_r8,1.1912e+01_r8,1.2336e+01_r8,1.2746e+01_r8/) + kbo(:,33,11) = (/ & + &1.1325e+01_r8,1.1662e+01_r8,1.2022e+01_r8,1.2470e+01_r8,1.2619e+01_r8/) + kbo(:,34,11) = (/ & + &1.1533e+01_r8,1.1754e+01_r8,1.2155e+01_r8,1.2455e+01_r8,1.2615e+01_r8/) + kbo(:,35,11) = (/ & + &1.1659e+01_r8,1.1966e+01_r8,1.2184e+01_r8,1.2500e+01_r8,1.2545e+01_r8/) + kbo(:,36,11) = (/ & + &1.1755e+01_r8,1.2074e+01_r8,1.2225e+01_r8,1.2599e+01_r8,1.2813e+01_r8/) + kbo(:,37,11) = (/ & + &1.1716e+01_r8,1.1980e+01_r8,1.2067e+01_r8,1.2383e+01_r8,1.2671e+01_r8/) + kbo(:,38,11) = (/ & + &1.1652e+01_r8,1.1821e+01_r8,1.1815e+01_r8,1.2298e+01_r8,1.2561e+01_r8/) + kbo(:,39,11) = (/ & + &1.1437e+01_r8,1.1591e+01_r8,1.1776e+01_r8,1.2140e+01_r8,1.2306e+01_r8/) + kbo(:,40,11) = (/ & + &1.1267e+01_r8,1.1380e+01_r8,1.1567e+01_r8,1.1899e+01_r8,1.1967e+01_r8/) + kbo(:,41,11) = (/ & + &1.0928e+01_r8,1.1128e+01_r8,1.1355e+01_r8,1.1698e+01_r8,1.1735e+01_r8/) + kbo(:,42,11) = (/ & + &1.0609e+01_r8,1.0842e+01_r8,1.1168e+01_r8,1.1452e+01_r8,1.1524e+01_r8/) + kbo(:,43,11) = (/ & + &1.0251e+01_r8,1.0481e+01_r8,1.0835e+01_r8,1.1143e+01_r8,1.1300e+01_r8/) + kbo(:,44,11) = (/ & + &9.7650e+00_r8,1.0106e+01_r8,1.0340e+01_r8,1.0725e+01_r8,1.0899e+01_r8/) + kbo(:,45,11) = (/ & + &9.2584e+00_r8,9.6204e+00_r8,9.9580e+00_r8,1.0325e+01_r8,1.0626e+01_r8/) + kbo(:,46,11) = (/ & + &8.9377e+00_r8,9.1742e+00_r8,9.5458e+00_r8,9.9839e+00_r8,1.0197e+01_r8/) + kbo(:,47,11) = (/ & + &8.5371e+00_r8,8.7965e+00_r8,9.0763e+00_r8,9.5717e+00_r8,9.9938e+00_r8/) + kbo(:,48,11) = (/ & + &7.9850e+00_r8,8.3229e+00_r8,8.7471e+00_r8,9.1748e+00_r8,9.6663e+00_r8/) + kbo(:,49,11) = (/ & + &7.4325e+00_r8,7.8561e+00_r8,8.3257e+00_r8,8.9344e+00_r8,9.3488e+00_r8/) + kbo(:,50,11) = (/ & + &6.9934e+00_r8,7.5330e+00_r8,7.9938e+00_r8,8.5231e+00_r8,9.1226e+00_r8/) + kbo(:,51,11) = (/ & + &6.6292e+00_r8,7.1581e+00_r8,7.7030e+00_r8,8.1971e+00_r8,8.9077e+00_r8/) + kbo(:,52,11) = (/ & + &6.2107e+00_r8,6.7791e+00_r8,7.3981e+00_r8,7.9369e+00_r8,8.8177e+00_r8/) + kbo(:,53,11) = (/ & + &5.7771e+00_r8,6.3836e+00_r8,7.0431e+00_r8,7.8871e+00_r8,8.9292e+00_r8/) + kbo(:,54,11) = (/ & + &5.5085e+00_r8,6.1058e+00_r8,6.7091e+00_r8,7.6421e+00_r8,8.6682e+00_r8/) + kbo(:,55,11) = (/ & + &5.3542e+00_r8,5.9311e+00_r8,6.5099e+00_r8,7.2327e+00_r8,8.2463e+00_r8/) + kbo(:,56,11) = (/ & + &5.2013e+00_r8,5.6998e+00_r8,6.2622e+00_r8,6.8978e+00_r8,7.7861e+00_r8/) + kbo(:,57,11) = (/ & + &4.9844e+00_r8,5.4898e+00_r8,6.0972e+00_r8,6.6262e+00_r8,7.3665e+00_r8/) + kbo(:,58,11) = (/ & + &4.7470e+00_r8,5.3695e+00_r8,5.9047e+00_r8,6.4509e+00_r8,7.0483e+00_r8/) + kbo(:,59,11) = (/ & + &4.7734e+00_r8,5.4744e+00_r8,6.0332e+00_r8,6.5609e+00_r8,7.0505e+00_r8/) + kbo(:,13,12) = (/ & + &6.9738e+01_r8,7.0752e+01_r8,7.1414e+01_r8,7.2004e+01_r8,7.2657e+01_r8/) + kbo(:,14,12) = (/ & + &6.4422e+01_r8,6.5346e+01_r8,6.6191e+01_r8,6.7103e+01_r8,6.7985e+01_r8/) + kbo(:,15,12) = (/ & + &5.8702e+01_r8,5.9763e+01_r8,6.0895e+01_r8,6.1978e+01_r8,6.3157e+01_r8/) + kbo(:,16,12) = (/ & + &5.3091e+01_r8,5.4316e+01_r8,5.5558e+01_r8,5.6938e+01_r8,5.8399e+01_r8/) + kbo(:,17,12) = (/ & + &4.7175e+01_r8,4.8634e+01_r8,5.0234e+01_r8,5.1992e+01_r8,5.3803e+01_r8/) + kbo(:,18,12) = (/ & + &4.1145e+01_r8,4.2755e+01_r8,4.4548e+01_r8,4.6436e+01_r8,4.8468e+01_r8/) + kbo(:,19,12) = (/ & + &3.4889e+01_r8,3.6512e+01_r8,3.8406e+01_r8,4.0570e+01_r8,4.2997e+01_r8/) + kbo(:,20,12) = (/ & + &2.8470e+01_r8,3.0112e+01_r8,3.2281e+01_r8,3.4662e+01_r8,3.7243e+01_r8/) + kbo(:,21,12) = (/ & + &2.3947e+01_r8,2.5322e+01_r8,2.7206e+01_r8,2.9369e+01_r8,3.2034e+01_r8/) + kbo(:,22,12) = (/ & + &2.2071e+01_r8,2.2771e+01_r8,2.4136e+01_r8,2.6151e+01_r8,2.8304e+01_r8/) + kbo(:,23,12) = (/ & + &2.1437e+01_r8,2.2028e+01_r8,2.2789e+01_r8,2.3769e+01_r8,2.5664e+01_r8/) + kbo(:,24,12) = (/ & + &2.1104e+01_r8,2.1623e+01_r8,2.2496e+01_r8,2.3486e+01_r8,2.4592e+01_r8/) + kbo(:,25,12) = (/ & + &2.1238e+01_r8,2.1868e+01_r8,2.2645e+01_r8,2.3461e+01_r8,2.4762e+01_r8/) + kbo(:,26,12) = (/ & + &2.1604e+01_r8,2.2258e+01_r8,2.3294e+01_r8,2.4121e+01_r8,2.5265e+01_r8/) + kbo(:,27,12) = (/ & + &2.2115e+01_r8,2.2777e+01_r8,2.3909e+01_r8,2.4766e+01_r8,2.5867e+01_r8/) + kbo(:,28,12) = (/ & + &2.2448e+01_r8,2.3238e+01_r8,2.4298e+01_r8,2.5624e+01_r8,2.6343e+01_r8/) + kbo(:,29,12) = (/ & + &2.2577e+01_r8,2.3289e+01_r8,2.4323e+01_r8,2.5634e+01_r8,2.6765e+01_r8/) + kbo(:,30,12) = (/ & + &2.2578e+01_r8,2.3315e+01_r8,2.4386e+01_r8,2.5500e+01_r8,2.6908e+01_r8/) + kbo(:,31,12) = (/ & + &2.2201e+01_r8,2.3259e+01_r8,2.4131e+01_r8,2.5149e+01_r8,2.6545e+01_r8/) + kbo(:,32,12) = (/ & + &2.2079e+01_r8,2.2922e+01_r8,2.4111e+01_r8,2.5430e+01_r8,2.6527e+01_r8/) + kbo(:,33,12) = (/ & + &2.2095e+01_r8,2.2961e+01_r8,2.4279e+01_r8,2.5414e+01_r8,2.7005e+01_r8/) + kbo(:,34,12) = (/ & + &2.2319e+01_r8,2.3341e+01_r8,2.4447e+01_r8,2.6277e+01_r8,2.7940e+01_r8/) + kbo(:,35,12) = (/ & + &2.2552e+01_r8,2.3701e+01_r8,2.5211e+01_r8,2.6844e+01_r8,2.9224e+01_r8/) + kbo(:,36,12) = (/ & + &2.3085e+01_r8,2.4181e+01_r8,2.5665e+01_r8,2.7600e+01_r8,3.0387e+01_r8/) + kbo(:,37,12) = (/ & + &2.2925e+01_r8,2.4128e+01_r8,2.5553e+01_r8,2.7616e+01_r8,3.1077e+01_r8/) + kbo(:,38,12) = (/ & + &2.2707e+01_r8,2.3887e+01_r8,2.5581e+01_r8,2.8109e+01_r8,3.1584e+01_r8/) + kbo(:,39,12) = (/ & + &2.2511e+01_r8,2.3842e+01_r8,2.5754e+01_r8,2.8880e+01_r8,3.2658e+01_r8/) + kbo(:,40,12) = (/ & + &2.1948e+01_r8,2.3291e+01_r8,2.5416e+01_r8,2.8638e+01_r8,3.2604e+01_r8/) + kbo(:,41,12) = (/ & + &2.1476e+01_r8,2.2682e+01_r8,2.5024e+01_r8,2.8295e+01_r8,3.2225e+01_r8/) + kbo(:,42,12) = (/ & + &2.0874e+01_r8,2.2077e+01_r8,2.4841e+01_r8,2.8049e+01_r8,3.2070e+01_r8/) + kbo(:,43,12) = (/ & + &2.0317e+01_r8,2.1501e+01_r8,2.4302e+01_r8,2.7503e+01_r8,3.1532e+01_r8/) + kbo(:,44,12) = (/ & + &1.9539e+01_r8,2.0870e+01_r8,2.3855e+01_r8,2.7092e+01_r8,3.1110e+01_r8/) + kbo(:,45,12) = (/ & + &1.8830e+01_r8,2.0599e+01_r8,2.3570e+01_r8,2.6837e+01_r8,3.0566e+01_r8/) + kbo(:,46,12) = (/ & + &1.8029e+01_r8,2.0375e+01_r8,2.3363e+01_r8,2.6419e+01_r8,3.0085e+01_r8/) + kbo(:,47,12) = (/ & + &1.7365e+01_r8,1.9999e+01_r8,2.2921e+01_r8,2.5901e+01_r8,2.9166e+01_r8/) + kbo(:,48,12) = (/ & + &1.7043e+01_r8,1.9606e+01_r8,2.2433e+01_r8,2.5542e+01_r8,2.8495e+01_r8/) + kbo(:,49,12) = (/ & + &1.6912e+01_r8,1.9487e+01_r8,2.2139e+01_r8,2.5022e+01_r8,2.8110e+01_r8/) + kbo(:,50,12) = (/ & + &1.6517e+01_r8,1.8987e+01_r8,2.1585e+01_r8,2.4422e+01_r8,2.7428e+01_r8/) + kbo(:,51,12) = (/ & + &1.5891e+01_r8,1.8550e+01_r8,2.1056e+01_r8,2.3767e+01_r8,2.6461e+01_r8/) + kbo(:,52,12) = (/ & + &1.5362e+01_r8,1.8085e+01_r8,2.0538e+01_r8,2.3135e+01_r8,2.5477e+01_r8/) + kbo(:,53,12) = (/ & + &1.4979e+01_r8,1.7596e+01_r8,2.0169e+01_r8,2.2304e+01_r8,2.4351e+01_r8/) + kbo(:,54,12) = (/ & + &1.4292e+01_r8,1.6762e+01_r8,1.9386e+01_r8,2.1407e+01_r8,2.3360e+01_r8/) + kbo(:,55,12) = (/ & + &1.3424e+01_r8,1.5675e+01_r8,1.8295e+01_r8,2.0550e+01_r8,2.2398e+01_r8/) + kbo(:,56,12) = (/ & + &1.2558e+01_r8,1.4702e+01_r8,1.7198e+01_r8,1.9642e+01_r8,2.1560e+01_r8/) + kbo(:,57,12) = (/ & + &1.1789e+01_r8,1.3891e+01_r8,1.6101e+01_r8,1.8574e+01_r8,2.0696e+01_r8/) + kbo(:,58,12) = (/ & + &1.0944e+01_r8,1.2980e+01_r8,1.5007e+01_r8,1.7361e+01_r8,1.9688e+01_r8/) + kbo(:,59,12) = (/ & + &1.0805e+01_r8,1.1957e+01_r8,1.3692e+01_r8,1.5846e+01_r8,1.8110e+01_r8/) + kbo(:,13,13) = (/ & + &1.5252e+02_r8,1.5442e+02_r8,1.5646e+02_r8,1.5779e+02_r8,1.5854e+02_r8/) + kbo(:,14,13) = (/ & + &1.5029e+02_r8,1.5315e+02_r8,1.5552e+02_r8,1.5711e+02_r8,1.5813e+02_r8/) + kbo(:,15,13) = (/ & + &1.4712e+02_r8,1.5063e+02_r8,1.5294e+02_r8,1.5483e+02_r8,1.5630e+02_r8/) + kbo(:,16,13) = (/ & + &1.4282e+02_r8,1.4612e+02_r8,1.4898e+02_r8,1.5141e+02_r8,1.5352e+02_r8/) + kbo(:,17,13) = (/ & + &1.3686e+02_r8,1.4066e+02_r8,1.4417e+02_r8,1.4736e+02_r8,1.5020e+02_r8/) + kbo(:,18,13) = (/ & + &1.3031e+02_r8,1.3486e+02_r8,1.3910e+02_r8,1.4308e+02_r8,1.4669e+02_r8/) + kbo(:,19,13) = (/ & + &1.2305e+02_r8,1.2878e+02_r8,1.3410e+02_r8,1.3882e+02_r8,1.4318e+02_r8/) + kbo(:,20,13) = (/ & + &1.1539e+02_r8,1.2206e+02_r8,1.2838e+02_r8,1.3444e+02_r8,1.4010e+02_r8/) + kbo(:,21,13) = (/ & + &1.0694e+02_r8,1.1477e+02_r8,1.2233e+02_r8,1.2972e+02_r8,1.3638e+02_r8/) + kbo(:,22,13) = (/ & + &9.8072e+01_r8,1.0767e+02_r8,1.1673e+02_r8,1.2508e+02_r8,1.3303e+02_r8/) + kbo(:,23,13) = (/ & + &8.9638e+01_r8,1.0003e+02_r8,1.1035e+02_r8,1.2081e+02_r8,1.2954e+02_r8/) + kbo(:,24,13) = (/ & + &8.2450e+01_r8,9.3359e+01_r8,1.0421e+02_r8,1.1509e+02_r8,1.2544e+02_r8/) + kbo(:,25,13) = (/ & + &7.6879e+01_r8,8.7792e+01_r8,9.9290e+01_r8,1.1048e+02_r8,1.2100e+02_r8/) + kbo(:,26,13) = (/ & + &7.3470e+01_r8,8.4233e+01_r8,9.5225e+01_r8,1.0688e+02_r8,1.1752e+02_r8/) + kbo(:,27,13) = (/ & + &7.1984e+01_r8,8.2203e+01_r8,9.3044e+01_r8,1.0438e+02_r8,1.1537e+02_r8/) + kbo(:,28,13) = (/ & + &7.1683e+01_r8,8.1066e+01_r8,9.2180e+01_r8,1.0291e+02_r8,1.1419e+02_r8/) + kbo(:,29,13) = (/ & + &7.3240e+01_r8,8.2713e+01_r8,9.3261e+01_r8,1.0420e+02_r8,1.1497e+02_r8/) + kbo(:,30,13) = (/ & + &7.5656e+01_r8,8.5740e+01_r8,9.5155e+01_r8,1.0607e+02_r8,1.1653e+02_r8/) + kbo(:,31,13) = (/ & + &7.9639e+01_r8,8.9485e+01_r8,9.9623e+01_r8,1.0965e+02_r8,1.1967e+02_r8/) + kbo(:,32,13) = (/ & + &8.5052e+01_r8,9.4635e+01_r8,1.0433e+02_r8,1.1321e+02_r8,1.2287e+02_r8/) + kbo(:,33,13) = (/ & + &9.0468e+01_r8,1.0058e+02_r8,1.0969e+02_r8,1.1864e+02_r8,1.2671e+02_r8/) + kbo(:,34,13) = (/ & + &9.5615e+01_r8,1.0581e+02_r8,1.1476e+02_r8,1.2258e+02_r8,1.3070e+02_r8/) + kbo(:,35,13) = (/ & + &9.9168e+01_r8,1.0972e+02_r8,1.1933e+02_r8,1.2712e+02_r8,1.3373e+02_r8/) + kbo(:,36,13) = (/ & + &1.0086e+02_r8,1.1164e+02_r8,1.2168e+02_r8,1.3014e+02_r8,1.3667e+02_r8/) + kbo(:,37,13) = (/ & + &1.0047e+02_r8,1.1211e+02_r8,1.2253e+02_r8,1.3099e+02_r8,1.3706e+02_r8/) + kbo(:,38,13) = (/ & + &1.0049e+02_r8,1.1250e+02_r8,1.2313e+02_r8,1.3108e+02_r8,1.3732e+02_r8/) + kbo(:,39,13) = (/ & + &1.0115e+02_r8,1.1295e+02_r8,1.2350e+02_r8,1.3105e+02_r8,1.3768e+02_r8/) + kbo(:,40,13) = (/ & + &9.9765e+01_r8,1.1141e+02_r8,1.2196e+02_r8,1.2992e+02_r8,1.3631e+02_r8/) + kbo(:,41,13) = (/ & + &9.8221e+01_r8,1.1003e+02_r8,1.2037e+02_r8,1.2825e+02_r8,1.3487e+02_r8/) + kbo(:,42,13) = (/ & + &9.7048e+01_r8,1.0845e+02_r8,1.1823e+02_r8,1.2668e+02_r8,1.3349e+02_r8/) + kbo(:,43,13) = (/ & + &9.4582e+01_r8,1.0608e+02_r8,1.1575e+02_r8,1.2424e+02_r8,1.3118e+02_r8/) + kbo(:,44,13) = (/ & + &9.2428e+01_r8,1.0325e+02_r8,1.1298e+02_r8,1.2159e+02_r8,1.2888e+02_r8/) + kbo(:,45,13) = (/ & + &9.0012e+01_r8,1.0014e+02_r8,1.0975e+02_r8,1.1855e+02_r8,1.2634e+02_r8/) + kbo(:,46,13) = (/ & + &8.6912e+01_r8,9.6825e+01_r8,1.0618e+02_r8,1.1559e+02_r8,1.2362e+02_r8/) + kbo(:,47,13) = (/ & + &8.3243e+01_r8,9.2791e+01_r8,1.0216e+02_r8,1.1173e+02_r8,1.2014e+02_r8/) + kbo(:,48,13) = (/ & + &7.9277e+01_r8,8.8596e+01_r8,9.7998e+01_r8,1.0757e+02_r8,1.1661e+02_r8/) + kbo(:,49,13) = (/ & + &7.5292e+01_r8,8.4192e+01_r8,9.3715e+01_r8,1.0350e+02_r8,1.1301e+02_r8/) + kbo(:,50,13) = (/ & + &7.1230e+01_r8,8.0247e+01_r8,8.9698e+01_r8,9.9552e+01_r8,1.0903e+02_r8/) + kbo(:,51,13) = (/ & + &6.7476e+01_r8,7.6410e+01_r8,8.5492e+01_r8,9.5376e+01_r8,1.0529e+02_r8/) + kbo(:,52,13) = (/ & + &6.3984e+01_r8,7.2323e+01_r8,8.1379e+01_r8,9.1669e+01_r8,1.0161e+02_r8/) + kbo(:,53,13) = (/ & + &6.0507e+01_r8,6.8710e+01_r8,7.7291e+01_r8,8.7376e+01_r8,9.7642e+01_r8/) + kbo(:,54,13) = (/ & + &5.7140e+01_r8,6.5369e+01_r8,7.3636e+01_r8,8.3548e+01_r8,9.3708e+01_r8/) + kbo(:,55,13) = (/ & + &5.3812e+01_r8,6.2020e+01_r8,7.0040e+01_r8,7.9975e+01_r8,8.9949e+01_r8/) + kbo(:,56,13) = (/ & + &5.0680e+01_r8,5.8469e+01_r8,6.6837e+01_r8,7.6130e+01_r8,8.6168e+01_r8/) + kbo(:,57,13) = (/ & + &4.7704e+01_r8,5.5283e+01_r8,6.3212e+01_r8,7.2482e+01_r8,8.2593e+01_r8/) + kbo(:,58,13) = (/ & + &4.4831e+01_r8,5.2037e+01_r8,6.0082e+01_r8,6.9516e+01_r8,7.9098e+01_r8/) + kbo(:,59,13) = (/ & + &4.1993e+01_r8,5.0276e+01_r8,5.8426e+01_r8,6.7849e+01_r8,7.7045e+01_r8/) + kbo(:,13,14) = (/ & + &3.2192e+02_r8,3.1800e+02_r8,3.1299e+02_r8,3.0833e+02_r8,3.0378e+02_r8/) + kbo(:,14,14) = (/ & + &3.3616e+02_r8,3.3204e+02_r8,3.2756e+02_r8,3.2328e+02_r8,3.1928e+02_r8/) + kbo(:,15,14) = (/ & + &3.4851e+02_r8,3.4454e+02_r8,3.4128e+02_r8,3.3796e+02_r8,3.3453e+02_r8/) + kbo(:,16,14) = (/ & + &3.5910e+02_r8,3.5703e+02_r8,3.5472e+02_r8,3.5212e+02_r8,3.4919e+02_r8/) + kbo(:,17,14) = (/ & + &3.6944e+02_r8,3.6874e+02_r8,3.6739e+02_r8,3.6541e+02_r8,3.6285e+02_r8/) + kbo(:,18,14) = (/ & + &3.7860e+02_r8,3.7918e+02_r8,3.7877e+02_r8,3.7733e+02_r8,3.7491e+02_r8/) + kbo(:,19,14) = (/ & + &3.8633e+02_r8,3.8813e+02_r8,3.8858e+02_r8,3.8768e+02_r8,3.8541e+02_r8/) + kbo(:,20,14) = (/ & + &3.9291e+02_r8,3.9591e+02_r8,3.9708e+02_r8,3.9648e+02_r8,3.9435e+02_r8/) + kbo(:,21,14) = (/ & + &3.9871e+02_r8,4.0263e+02_r8,4.0428e+02_r8,4.0401e+02_r8,4.0199e+02_r8/) + kbo(:,22,14) = (/ & + &4.0411e+02_r8,4.0861e+02_r8,4.1054e+02_r8,4.1035e+02_r8,4.0818e+02_r8/) + kbo(:,23,14) = (/ & + &4.0907e+02_r8,4.1390e+02_r8,4.1591e+02_r8,4.1564e+02_r8,4.1319e+02_r8/) + kbo(:,24,14) = (/ & + &4.1361e+02_r8,4.1846e+02_r8,4.2039e+02_r8,4.1994e+02_r8,4.1722e+02_r8/) + kbo(:,25,14) = (/ & + &4.1735e+02_r8,4.2250e+02_r8,4.2427e+02_r8,4.2345e+02_r8,4.2038e+02_r8/) + kbo(:,26,14) = (/ & + &4.2023e+02_r8,4.2561e+02_r8,4.2741e+02_r8,4.2618e+02_r8,4.2275e+02_r8/) + kbo(:,27,14) = (/ & + &4.2191e+02_r8,4.2794e+02_r8,4.2966e+02_r8,4.2833e+02_r8,4.2447e+02_r8/) + kbo(:,28,14) = (/ & + &4.2376e+02_r8,4.3047e+02_r8,4.3157e+02_r8,4.2984e+02_r8,4.2560e+02_r8/) + kbo(:,29,14) = (/ & + &4.2494e+02_r8,4.3173e+02_r8,4.3312e+02_r8,4.3087e+02_r8,4.2623e+02_r8/) + kbo(:,30,14) = (/ & + &4.2606e+02_r8,4.3133e+02_r8,4.3417e+02_r8,4.3157e+02_r8,4.2642e+02_r8/) + kbo(:,31,14) = (/ & + &4.2650e+02_r8,4.3107e+02_r8,4.3305e+02_r8,4.3172e+02_r8,4.2612e+02_r8/) + kbo(:,32,14) = (/ & + &4.2471e+02_r8,4.2957e+02_r8,4.3084e+02_r8,4.2984e+02_r8,4.2547e+02_r8/) + kbo(:,33,14) = (/ & + &4.2258e+02_r8,4.2628e+02_r8,4.2740e+02_r8,4.2572e+02_r8,4.2270e+02_r8/) + kbo(:,34,14) = (/ & + &4.1904e+02_r8,4.2166e+02_r8,4.2281e+02_r8,4.2119e+02_r8,4.1745e+02_r8/) + kbo(:,35,14) = (/ & + &4.1547e+02_r8,4.1665e+02_r8,4.1587e+02_r8,4.1430e+02_r8,4.1140e+02_r8/) + kbo(:,36,14) = (/ & + &4.1132e+02_r8,4.1218e+02_r8,4.1072e+02_r8,4.0729e+02_r8,4.0326e+02_r8/) + kbo(:,37,14) = (/ & + &4.1025e+02_r8,4.1006e+02_r8,4.0857e+02_r8,4.0548e+02_r8,4.0090e+02_r8/) + kbo(:,38,14) = (/ & + &4.0864e+02_r8,4.0868e+02_r8,4.0686e+02_r8,4.0372e+02_r8,3.9921e+02_r8/) + kbo(:,39,14) = (/ & + &4.0644e+02_r8,4.0717e+02_r8,4.0510e+02_r8,4.0183e+02_r8,3.9677e+02_r8/) + kbo(:,40,14) = (/ & + &4.0674e+02_r8,4.0768e+02_r8,4.0593e+02_r8,4.0263e+02_r8,3.9822e+02_r8/) + kbo(:,41,14) = (/ & + &4.0619e+02_r8,4.0758e+02_r8,4.0668e+02_r8,4.0411e+02_r8,4.0014e+02_r8/) + kbo(:,42,14) = (/ & + &4.0516e+02_r8,4.0769e+02_r8,4.0744e+02_r8,4.0512e+02_r8,4.0147e+02_r8/) + kbo(:,43,14) = (/ & + &4.0427e+02_r8,4.0784e+02_r8,4.0882e+02_r8,4.0743e+02_r8,4.0425e+02_r8/) + kbo(:,44,14) = (/ & + &4.0222e+02_r8,4.0791e+02_r8,4.0985e+02_r8,4.0932e+02_r8,4.0671e+02_r8/) + kbo(:,45,14) = (/ & + &4.0049e+02_r8,4.0766e+02_r8,4.1090e+02_r8,4.1120e+02_r8,4.0941e+02_r8/) + kbo(:,46,14) = (/ & + &3.9818e+02_r8,4.0642e+02_r8,4.1148e+02_r8,4.1248e+02_r8,4.1163e+02_r8/) + kbo(:,47,14) = (/ & + &3.9380e+02_r8,4.0435e+02_r8,4.1138e+02_r8,4.1374e+02_r8,4.1407e+02_r8/) + kbo(:,48,14) = (/ & + &3.8928e+02_r8,4.0188e+02_r8,4.1084e+02_r8,4.1473e+02_r8,4.1611e+02_r8/) + kbo(:,49,14) = (/ & + &3.8359e+02_r8,3.9878e+02_r8,4.0957e+02_r8,4.1507e+02_r8,4.1710e+02_r8/) + kbo(:,50,14) = (/ & + &3.7809e+02_r8,3.9485e+02_r8,4.0769e+02_r8,4.1481e+02_r8,4.1835e+02_r8/) + kbo(:,51,14) = (/ & + &3.7168e+02_r8,3.9024e+02_r8,4.0538e+02_r8,4.1442e+02_r8,4.1907e+02_r8/) + kbo(:,52,14) = (/ & + &3.6416e+02_r8,3.8544e+02_r8,4.0242e+02_r8,4.1266e+02_r8,4.1894e+02_r8/) + kbo(:,53,14) = (/ & + &3.5526e+02_r8,3.7935e+02_r8,3.9858e+02_r8,4.1114e+02_r8,4.1870e+02_r8/) + kbo(:,54,14) = (/ & + &3.4652e+02_r8,3.7311e+02_r8,3.9451e+02_r8,4.0902e+02_r8,4.1841e+02_r8/) + kbo(:,55,14) = (/ & + &3.3749e+02_r8,3.6678e+02_r8,3.9033e+02_r8,4.0637e+02_r8,4.1776e+02_r8/) + kbo(:,56,14) = (/ & + &3.2816e+02_r8,3.6010e+02_r8,3.8512e+02_r8,4.0357e+02_r8,4.1651e+02_r8/) + kbo(:,57,14) = (/ & + &3.1792e+02_r8,3.5199e+02_r8,3.7987e+02_r8,4.0009e+02_r8,4.1450e+02_r8/) + kbo(:,58,14) = (/ & + &3.0792e+02_r8,3.4419e+02_r8,3.7396e+02_r8,3.9574e+02_r8,4.1235e+02_r8/) + kbo(:,59,14) = (/ & + &3.0450e+02_r8,3.4137e+02_r8,3.7215e+02_r8,3.9490e+02_r8,4.1294e+02_r8/) + kbo(:,13,15) = (/ & + &5.8728e+02_r8,5.6960e+02_r8,5.5469e+02_r8,5.4056e+02_r8,5.2654e+02_r8/) + kbo(:,14,15) = (/ & + &6.4066e+02_r8,6.2243e+02_r8,6.0593e+02_r8,5.8946e+02_r8,5.7294e+02_r8/) + kbo(:,15,15) = (/ & + &6.9682e+02_r8,6.7763e+02_r8,6.5849e+02_r8,6.3897e+02_r8,6.1931e+02_r8/) + kbo(:,16,15) = (/ & + &7.5471e+02_r8,7.3292e+02_r8,7.1026e+02_r8,6.8716e+02_r8,6.6402e+02_r8/) + kbo(:,17,15) = (/ & + &8.1231e+02_r8,7.8651e+02_r8,7.5977e+02_r8,7.3284e+02_r8,7.0637e+02_r8/) + kbo(:,18,15) = (/ & + &8.6774e+02_r8,8.3725e+02_r8,8.0641e+02_r8,7.7597e+02_r8,7.4653e+02_r8/) + kbo(:,19,15) = (/ & + &9.1989e+02_r8,8.8492e+02_r8,8.5007e+02_r8,8.1594e+02_r8,7.8315e+02_r8/) + kbo(:,20,15) = (/ & + &9.6712e+02_r8,9.2752e+02_r8,8.8885e+02_r8,8.5117e+02_r8,8.1509e+02_r8/) + kbo(:,21,15) = (/ & + &1.0088e+03_r8,9.6497e+02_r8,9.2264e+02_r8,8.8175e+02_r8,8.4261e+02_r8/) + kbo(:,22,15) = (/ & + &1.0418e+03_r8,9.9399e+02_r8,9.4844e+02_r8,9.0461e+02_r8,8.6306e+02_r8/) + kbo(:,23,15) = (/ & + &1.0679e+03_r8,1.0170e+03_r8,9.6858e+02_r8,9.2246e+02_r8,8.7882e+02_r8/) + kbo(:,24,15) = (/ & + &1.0878e+03_r8,1.0343e+03_r8,9.8346e+02_r8,9.3530e+02_r8,8.9008e+02_r8/) + kbo(:,25,15) = (/ & + &1.1017e+03_r8,1.0460e+03_r8,9.9332e+02_r8,9.4368e+02_r8,8.9722e+02_r8/) + kbo(:,26,15) = (/ & + &1.1097e+03_r8,1.0523e+03_r8,9.9837e+02_r8,9.4761e+02_r8,9.0024e+02_r8/) + kbo(:,27,15) = (/ & + &1.1134e+03_r8,1.0547e+03_r8,9.9983e+02_r8,9.4851e+02_r8,9.0041e+02_r8/) + kbo(:,28,15) = (/ & + &1.1133e+03_r8,1.0539e+03_r8,9.9848e+02_r8,9.4685e+02_r8,8.9828e+02_r8/) + kbo(:,29,15) = (/ & + &1.1100e+03_r8,1.0502e+03_r8,9.9454e+02_r8,9.4272e+02_r8,8.9398e+02_r8/) + kbo(:,30,15) = (/ & + &1.1040e+03_r8,1.0443e+03_r8,9.8865e+02_r8,9.3687e+02_r8,8.8821e+02_r8/) + kbo(:,31,15) = (/ & + &1.0960e+03_r8,1.0364e+03_r8,9.8114e+02_r8,9.2948e+02_r8,8.8105e+02_r8/) + kbo(:,32,15) = (/ & + &1.0862e+03_r8,1.0270e+03_r8,9.7213e+02_r8,9.2091e+02_r8,8.7298e+02_r8/) + kbo(:,33,15) = (/ & + &1.0752e+03_r8,1.0167e+03_r8,9.6230e+02_r8,9.1136e+02_r8,8.6427e+02_r8/) + kbo(:,34,15) = (/ & + &1.0653e+03_r8,1.0075e+03_r8,9.5353e+02_r8,9.0314e+02_r8,8.5654e+02_r8/) + kbo(:,35,15) = (/ & + &1.0607e+03_r8,1.0031e+03_r8,9.4921e+02_r8,8.9900e+02_r8,8.5273e+02_r8/) + kbo(:,36,15) = (/ & + &1.0620e+03_r8,1.0042e+03_r8,9.5018e+02_r8,8.9983e+02_r8,8.5343e+02_r8/) + kbo(:,37,15) = (/ & + &1.0721e+03_r8,1.0134e+03_r8,9.5885e+02_r8,9.0773e+02_r8,8.6067e+02_r8/) + kbo(:,38,15) = (/ & + &1.0824e+03_r8,1.0229e+03_r8,9.6769e+02_r8,9.1592e+02_r8,8.6811e+02_r8/) + kbo(:,39,15) = (/ & + &1.0926e+03_r8,1.0322e+03_r8,9.7633e+02_r8,9.2388e+02_r8,8.7544e+02_r8/) + kbo(:,40,15) = (/ & + &1.1061e+03_r8,1.0474e+03_r8,9.9047e+02_r8,9.3721e+02_r8,8.8756e+02_r8/) + kbo(:,41,15) = (/ & + &1.1226e+03_r8,1.0637e+03_r8,1.0055e+03_r8,9.5118e+02_r8,9.0046e+02_r8/) + kbo(:,42,15) = (/ & + &1.1394e+03_r8,1.0801e+03_r8,1.0206e+03_r8,9.6537e+02_r8,9.1362e+02_r8/) + kbo(:,43,15) = (/ & + &1.1611e+03_r8,1.1003e+03_r8,1.0393e+03_r8,9.8274e+02_r8,9.2982e+02_r8/) + kbo(:,44,15) = (/ & + &1.1862e+03_r8,1.1226e+03_r8,1.0598e+03_r8,1.0018e+03_r8,9.4776e+02_r8/) + kbo(:,45,15) = (/ & + &1.2106e+03_r8,1.1455e+03_r8,1.0808e+03_r8,1.0212e+03_r8,9.6597e+02_r8/) + kbo(:,46,15) = (/ & + &1.2373e+03_r8,1.1703e+03_r8,1.1039e+03_r8,1.0424e+03_r8,9.8575e+02_r8/) + kbo(:,47,15) = (/ & + &1.2689e+03_r8,1.1988e+03_r8,1.1303e+03_r8,1.0668e+03_r8,1.0082e+03_r8/) + kbo(:,48,15) = (/ & + &1.2999e+03_r8,1.2281e+03_r8,1.1575e+03_r8,1.0920e+03_r8,1.0314e+03_r8/) + kbo(:,49,15) = (/ & + &1.3314e+03_r8,1.2580e+03_r8,1.1855e+03_r8,1.1179e+03_r8,1.0553e+03_r8/) + kbo(:,50,15) = (/ & + &1.3612e+03_r8,1.2867e+03_r8,1.2124e+03_r8,1.1430e+03_r8,1.0785e+03_r8/) + kbo(:,51,15) = (/ & + &1.3905e+03_r8,1.3151e+03_r8,1.2392e+03_r8,1.1679e+03_r8,1.1016e+03_r8/) + kbo(:,52,15) = (/ & + &1.4202e+03_r8,1.3438e+03_r8,1.2667e+03_r8,1.1935e+03_r8,1.1254e+03_r8/) + kbo(:,53,15) = (/ & + &1.4513e+03_r8,1.3727e+03_r8,1.2946e+03_r8,1.2198e+03_r8,1.1498e+03_r8/) + kbo(:,54,15) = (/ & + &1.4800e+03_r8,1.3995e+03_r8,1.3206e+03_r8,1.2445e+03_r8,1.1728e+03_r8/) + kbo(:,55,15) = (/ & + &1.5077e+03_r8,1.4256e+03_r8,1.3457e+03_r8,1.2685e+03_r8,1.1953e+03_r8/) + kbo(:,56,15) = (/ & + &1.5346e+03_r8,1.4518e+03_r8,1.3711e+03_r8,1.2930e+03_r8,1.2182e+03_r8/) + kbo(:,57,15) = (/ & + &1.5614e+03_r8,1.4781e+03_r8,1.3967e+03_r8,1.3177e+03_r8,1.2417e+03_r8/) + kbo(:,58,15) = (/ & + &1.5868e+03_r8,1.5034e+03_r8,1.4212e+03_r8,1.3415e+03_r8,1.2645e+03_r8/) + kbo(:,59,15) = (/ & + &1.5970e+03_r8,1.5135e+03_r8,1.4312e+03_r8,1.3511e+03_r8,1.2737e+03_r8/) + kbo(:,13,16) = (/ & + &9.8102e+02_r8,9.4348e+02_r8,9.0592e+02_r8,8.7102e+02_r8,8.4003e+02_r8/) + kbo(:,14,16) = (/ & + &1.1017e+03_r8,1.0558e+03_r8,1.0119e+03_r8,9.7251e+02_r8,9.3606e+02_r8/) + kbo(:,15,16) = (/ & + &1.2294e+03_r8,1.1733e+03_r8,1.1221e+03_r8,1.0765e+03_r8,1.0331e+03_r8/) + kbo(:,16,16) = (/ & + &1.3605e+03_r8,1.2927e+03_r8,1.2335e+03_r8,1.1795e+03_r8,1.1282e+03_r8/) + kbo(:,17,16) = (/ & + &1.4907e+03_r8,1.4118e+03_r8,1.3426e+03_r8,1.2786e+03_r8,1.2181e+03_r8/) + kbo(:,18,16) = (/ & + &1.6164e+03_r8,1.5261e+03_r8,1.4460e+03_r8,1.3720e+03_r8,1.3020e+03_r8/) + kbo(:,19,16) = (/ & + &1.7353e+03_r8,1.6329e+03_r8,1.5412e+03_r8,1.4568e+03_r8,1.3777e+03_r8/) + kbo(:,20,16) = (/ & + &1.8432e+03_r8,1.7287e+03_r8,1.6256e+03_r8,1.5311e+03_r8,1.4432e+03_r8/) + kbo(:,21,16) = (/ & + &1.9386e+03_r8,1.8123e+03_r8,1.6986e+03_r8,1.5948e+03_r8,1.4993e+03_r8/) + kbo(:,22,16) = (/ & + &2.0105e+03_r8,1.8749e+03_r8,1.7520e+03_r8,1.6411e+03_r8,1.5395e+03_r8/) + kbo(:,23,16) = (/ & + &2.0682e+03_r8,1.9239e+03_r8,1.7938e+03_r8,1.6758e+03_r8,1.5698e+03_r8/) + kbo(:,24,16) = (/ & + &2.1097e+03_r8,1.9590e+03_r8,1.8231e+03_r8,1.7013e+03_r8,1.5912e+03_r8/) + kbo(:,25,16) = (/ & + &2.1366e+03_r8,1.9806e+03_r8,1.8412e+03_r8,1.7160e+03_r8,1.6035e+03_r8/) + kbo(:,26,16) = (/ & + &2.1483e+03_r8,1.9894e+03_r8,1.8477e+03_r8,1.7210e+03_r8,1.6077e+03_r8/) + kbo(:,27,16) = (/ & + &2.1499e+03_r8,1.9893e+03_r8,1.8466e+03_r8,1.7191e+03_r8,1.6062e+03_r8/) + kbo(:,28,16) = (/ & + &2.1427e+03_r8,1.9818e+03_r8,1.8393e+03_r8,1.7119e+03_r8,1.6006e+03_r8/) + kbo(:,29,16) = (/ & + &2.1277e+03_r8,1.9675e+03_r8,1.8260e+03_r8,1.6998e+03_r8,1.5909e+03_r8/) + kbo(:,30,16) = (/ & + &2.1075e+03_r8,1.9489e+03_r8,1.8089e+03_r8,1.6842e+03_r8,1.5788e+03_r8/) + kbo(:,31,16) = (/ & + &2.0822e+03_r8,1.9262e+03_r8,1.7881e+03_r8,1.6663e+03_r8,1.5639e+03_r8/) + kbo(:,32,16) = (/ & + &2.0533e+03_r8,1.9005e+03_r8,1.7649e+03_r8,1.6467e+03_r8,1.5469e+03_r8/) + kbo(:,33,16) = (/ & + &2.0222e+03_r8,1.8726e+03_r8,1.7400e+03_r8,1.6262e+03_r8,1.5282e+03_r8/) + kbo(:,34,16) = (/ & + &1.9951e+03_r8,1.8486e+03_r8,1.7187e+03_r8,1.6087e+03_r8,1.5123e+03_r8/) + kbo(:,35,16) = (/ & + &1.9819e+03_r8,1.8366e+03_r8,1.7081e+03_r8,1.6001e+03_r8,1.5043e+03_r8/) + kbo(:,36,16) = (/ & + &1.9843e+03_r8,1.8387e+03_r8,1.7099e+03_r8,1.6017e+03_r8,1.5056e+03_r8/) + kbo(:,37,16) = (/ & + &2.0096e+03_r8,1.8607e+03_r8,1.7293e+03_r8,1.6180e+03_r8,1.5204e+03_r8/) + kbo(:,38,16) = (/ & + &2.0360e+03_r8,1.8842e+03_r8,1.7495e+03_r8,1.6347e+03_r8,1.5358e+03_r8/) + kbo(:,39,16) = (/ & + &2.0619e+03_r8,1.9070e+03_r8,1.7697e+03_r8,1.6516e+03_r8,1.5509e+03_r8/) + kbo(:,40,16) = (/ & + &2.1060e+03_r8,1.9450e+03_r8,1.8033e+03_r8,1.6798e+03_r8,1.5761e+03_r8/) + kbo(:,41,16) = (/ & + &2.1534e+03_r8,1.9860e+03_r8,1.8395e+03_r8,1.7107e+03_r8,1.6027e+03_r8/) + kbo(:,42,16) = (/ & + &2.2020e+03_r8,2.0285e+03_r8,1.8771e+03_r8,1.7432e+03_r8,1.6297e+03_r8/) + kbo(:,43,16) = (/ & + &2.2623e+03_r8,2.0820e+03_r8,1.9234e+03_r8,1.7841e+03_r8,1.6639e+03_r8/) + kbo(:,44,16) = (/ & + &2.3303e+03_r8,2.1416e+03_r8,1.9758e+03_r8,1.8302e+03_r8,1.7027e+03_r8/) + kbo(:,45,16) = (/ & + &2.4015e+03_r8,2.2036e+03_r8,2.0305e+03_r8,1.8787e+03_r8,1.7442e+03_r8/) + kbo(:,46,16) = (/ & + &2.4806e+03_r8,2.2729e+03_r8,2.0910e+03_r8,1.9319e+03_r8,1.7910e+03_r8/) + kbo(:,47,16) = (/ & + &2.5738e+03_r8,2.3537e+03_r8,2.1621e+03_r8,1.9939e+03_r8,1.8463e+03_r8/) + kbo(:,48,16) = (/ & + &2.6744e+03_r8,2.4391e+03_r8,2.2368e+03_r8,2.0594e+03_r8,1.9042e+03_r8/) + kbo(:,49,16) = (/ & + &2.7827e+03_r8,2.5294e+03_r8,2.3154e+03_r8,2.1283e+03_r8,1.9646e+03_r8/) + kbo(:,50,16) = (/ & + &2.8923e+03_r8,2.6199e+03_r8,2.3931e+03_r8,2.1963e+03_r8,2.0240e+03_r8/) + kbo(:,51,16) = (/ & + &3.0068e+03_r8,2.7139e+03_r8,2.4725e+03_r8,2.2657e+03_r8,2.0848e+03_r8/) + kbo(:,52,16) = (/ & + &3.1290e+03_r8,2.8143e+03_r8,2.5557e+03_r8,2.3381e+03_r8,2.1483e+03_r8/) + kbo(:,53,16) = (/ & + &3.2592e+03_r8,2.9226e+03_r8,2.6451e+03_r8,2.4144e+03_r8,2.2150e+03_r8/) + kbo(:,54,16) = (/ & + &3.3865e+03_r8,3.0292e+03_r8,2.7322e+03_r8,2.4877e+03_r8,2.2788e+03_r8/) + kbo(:,55,16) = (/ & + &3.5154e+03_r8,3.1374e+03_r8,2.8210e+03_r8,2.5614e+03_r8,2.3429e+03_r8/) + kbo(:,56,16) = (/ & + &3.6521e+03_r8,3.2511e+03_r8,2.9159e+03_r8,2.6395e+03_r8,2.4095e+03_r8/) + kbo(:,57,16) = (/ & + &3.7974e+03_r8,3.3719e+03_r8,3.0171e+03_r8,2.7223e+03_r8,2.4795e+03_r8/) + kbo(:,58,16) = (/ & + &3.9425e+03_r8,3.4927e+03_r8,3.1186e+03_r8,2.8056e+03_r8,2.5484e+03_r8/) + kbo(:,59,16) = (/ & + &4.0032e+03_r8,3.5431e+03_r8,3.1604e+03_r8,2.8404e+03_r8,2.5772e+03_r8/) + +! The array FORREFO contains the coefficient of the water vapor +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index +! runs over the g-channel (1 to 16). + + forrefo(1,:) = (/ & + &5.1629e-06_r8,7.7578e-06_r8,1.9043e-05_r8,1.4802e-04_r8,2.2980e-04_r8,2.8057e-04_r8, & + &3.2824e-04_r8,3.4913e-04_r8,3.6515e-04_r8,3.8271e-04_r8,3.7499e-04_r8,3.6966e-04_r8, & + &3.7424e-04_r8,3.8884e-04_r8,3.7117e-04_r8,4.3710e-04_r8/) + forrefo(2,:) = (/ & + &5.0804e-06_r8,1.3466e-05_r8,7.2606e-05_r8,1.6940e-04_r8,2.1022e-04_r8,2.5900e-04_r8, & + &2.9106e-04_r8,3.2261e-04_r8,3.2066e-04_r8,3.5421e-04_r8,3.7128e-04_r8,3.8144e-04_r8, & + &3.7854e-04_r8,3.8347e-04_r8,3.8921e-04_r8,3.7339e-04_r8/) + forrefo(3,:) = (/ & + &5.4797e-05_r8,1.0026e-04_r8,1.2422e-04_r8,1.6386e-04_r8,1.8378e-04_r8,1.9616e-04_r8, & + &2.0711e-04_r8,2.2492e-04_r8,2.5240e-04_r8,2.6187e-04_r8,2.6058e-04_r8,2.4892e-04_r8, & + &2.6526e-04_r8,3.2105e-04_r8,3.6903e-04_r8,3.7213e-04_r8/) + forrefo(4,:) = (/ & + &4.2782e-05_r8,1.4775e-04_r8,1.4588e-04_r8,1.6964e-04_r8,1.6667e-04_r8,1.7192e-04_r8, & + &1.9057e-04_r8,2.0180e-04_r8,2.1177e-04_r8,2.2326e-04_r8,2.3801e-04_r8,2.9308e-04_r8, & + &3.1130e-04_r8,3.1829e-04_r8,3.5035e-04_r8,3.7782e-04_r8/) + +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 1.27793e-03_r8, 1.05944e-03_r8, 8.78300e-04_r8, 7.28133e-04_r8, 6.03641e-04_r8, & + & 5.00434e-04_r8, 4.14873e-04_r8, 3.43940e-04_r8, 2.85135e-04_r8, 2.36384e-04_r8/) + selfrefo(:, 2) = (/ & + & 1.42785e-03_r8, 1.17602e-03_r8, 9.68600e-04_r8, 7.97765e-04_r8, 6.57060e-04_r8, & + & 5.41172e-04_r8, 4.45724e-04_r8, 3.67110e-04_r8, 3.02361e-04_r8, 2.49033e-04_r8/) + selfrefo(:, 3) = (/ & + & 2.94095e-03_r8, 2.27102e-03_r8, 1.75370e-03_r8, 1.35422e-03_r8, 1.04574e-03_r8, & + & 8.07525e-04_r8, 6.23577e-04_r8, 4.81530e-04_r8, 3.71841e-04_r8, 2.87138e-04_r8/) + selfrefo(:, 4) = (/ & + & 3.94894e-03_r8, 3.48184e-03_r8, 3.07000e-03_r8, 2.70687e-03_r8, 2.38669e-03_r8, & + & 2.10439e-03_r8, 1.85547e-03_r8, 1.63600e-03_r8, 1.44249e-03_r8, 1.27187e-03_r8/) + selfrefo(:, 5) = (/ & + & 4.19971e-03_r8, 3.86333e-03_r8, 3.55390e-03_r8, 3.26925e-03_r8, 3.00740e-03_r8, & + & 2.76652e-03_r8, 2.54494e-03_r8, 2.34110e-03_r8, 2.15359e-03_r8, 1.98110e-03_r8/) + selfrefo(:, 6) = (/ & + & 4.95922e-03_r8, 4.57134e-03_r8, 4.21380e-03_r8, 3.88422e-03_r8, 3.58042e-03_r8, & + & 3.30038e-03_r8, 3.04225e-03_r8, 2.80430e-03_r8, 2.58496e-03_r8, 2.38278e-03_r8/) + selfrefo(:, 7) = (/ & + & 5.27379e-03_r8, 4.91005e-03_r8, 4.57140e-03_r8, 4.25611e-03_r8, 3.96256e-03_r8, & + & 3.68925e-03_r8, 3.43480e-03_r8, 3.19790e-03_r8, 2.97734e-03_r8, 2.77199e-03_r8/) + selfrefo(:, 8) = (/ & + & 5.75341e-03_r8, 5.31533e-03_r8, 4.91060e-03_r8, 4.53669e-03_r8, 4.19126e-03_r8, & + & 3.87212e-03_r8, 3.57729e-03_r8, 3.30490e-03_r8, 3.05325e-03_r8, 2.82077e-03_r8/) + selfrefo(:, 9) = (/ & + & 5.49849e-03_r8, 5.14295e-03_r8, 4.81040e-03_r8, 4.49935e-03_r8, 4.20842e-03_r8, & + & 3.93629e-03_r8, 3.68177e-03_r8, 3.44370e-03_r8, 3.22102e-03_r8, 3.01275e-03_r8/) + selfrefo(:,10) = (/ & + & 6.04962e-03_r8, 5.60945e-03_r8, 5.20130e-03_r8, 4.82285e-03_r8, 4.47194e-03_r8, & + & 4.14656e-03_r8, 3.84485e-03_r8, 3.56510e-03_r8, 3.30570e-03_r8, 3.06518e-03_r8/) + selfrefo(:,11) = (/ & + & 6.40108e-03_r8, 5.87551e-03_r8, 5.39310e-03_r8, 4.95029e-03_r8, 4.54385e-03_r8, & + & 4.17077e-03_r8, 3.82833e-03_r8, 3.51400e-03_r8, 3.22548e-03_r8, 2.96065e-03_r8/) + selfrefo(:,12) = (/ & + & 6.77938e-03_r8, 6.15713e-03_r8, 5.59200e-03_r8, 5.07874e-03_r8, 4.61259e-03_r8, & + & 4.18922e-03_r8, 3.80472e-03_r8, 3.45550e-03_r8, 3.13834e-03_r8, 2.85029e-03_r8/) + selfrefo(:,13) = (/ & + & 6.90020e-03_r8, 6.26766e-03_r8, 5.69310e-03_r8, 5.17121e-03_r8, 4.69717e-03_r8, & + & 4.26658e-03_r8, 3.87546e-03_r8, 3.52020e-03_r8, 3.19750e-03_r8, 2.90439e-03_r8/) + selfrefo(:,14) = (/ & + & 6.92759e-03_r8, 6.32882e-03_r8, 5.78180e-03_r8, 5.28206e-03_r8, 4.82552e-03_r8, & + & 4.40843e-03_r8, 4.02740e-03_r8, 3.67930e-03_r8, 3.36129e-03_r8, 3.07076e-03_r8/) + selfrefo(:,15) = (/ & + & 7.54539e-03_r8, 6.81161e-03_r8, 6.14920e-03_r8, 5.55120e-03_r8, 5.01136e-03_r8, & + & 4.52402e-03_r8, 4.08407e-03_r8, 3.68690e-03_r8, 3.32836e-03_r8, 3.00468e-03_r8/) + selfrefo(:,16) = (/ & + & 7.62039e-03_r8, 7.10834e-03_r8, 6.63070e-03_r8, 6.18515e-03_r8, 5.76955e-03_r8, & + & 5.38186e-03_r8, 5.02023e-03_r8, 4.68290e-03_r8, 4.36823e-03_r8, 4.07471e-03_r8/) + + end subroutine lw_kgb16 diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 new file mode 100644 index 0000000000..3b1ec1ce5b --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_rad.f90 @@ -0,0 +1,668 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.6 $ +! created: $Date: 2008/04/24 16:17:27 $ +! + +module rrtmg_lw_rad + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! +! **************************************************************************** +! * * +! * RRTMG_LW * +! * * +! * * +! * * +! * a rapid radiative transfer model * +! * for the longwave region * +! * for application to general circulation models * +! * * +! * * +! * Atmospheric and Environmental Research, Inc. * +! * 131 Hartwell Avenue * +! * Lexington, MA 02421 * +! * * +! * * +! * Eli J. Mlawer * +! * Jennifer S. Delamere * +! * Michael J. Iacono * +! * Shepard A. Clough * +! * * +! * * +! * * +! * * +! * * +! * * +! * email: miacono@aer.com * +! * email: emlawer@aer.com * +! * email: jdelamer@aer.com * +! * * +! * The authors wish to acknowledge the contributions of the * +! * following people: Steven J. Taubman, Karen Cady-Pereira, * +! * Patrick D. Brown, Ronald E. Farren, Luke Chen, Robert Bergstrom. * +! * * +! **************************************************************************** + +! -------- Modules -------- + +use shr_kind_mod, only: r8=>shr_kind_r8 + +use mcica_subcol_gen_lw, only: mcica_subcol_lw +use rrtmg_lw_setcoef, only: setcoef +use rrtmg_lw_taumol, only: taumol +use rrtmg_lw_rtrnmc, only: rtrnmc + +implicit none + +public :: rrtmg_lw + +! Set iaer to select aerosol option +! iaer = 0, no aerosols +! iaer = 10, input total aerosol optical depth (tauaer) directly +integer, parameter :: iaer = 10 + +!========================================================================================= +contains +!========================================================================================= + +subroutine rrtmg_lw & + (lchnk ,ncol ,nlay ,icld , & + play ,plev ,tlay ,tlev ,tsfc ,h2ovmr , & + o3vmr ,co2vmr ,ch4vmr ,o2vmr ,n2ovmr ,& + cfc11vmr,cfc12vmr, & + cfc22vmr,ccl4vmr ,emis , & + cldfmcl ,taucmcl ,ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , & + tauaer , & + uflx ,dflx ,hr ,uflxc ,dflxc, hrc, uflxs, dflxs ) + +! -------- Description -------- + +! This program is the driver subroutine for RRTMG_LW, the AER LW radiation +! model for application to GCMs, that has been adapted from RRTM_LW for +! improved efficiency. +! +! This routine: +! a) calls INATM to read in the atmospheric profile from GCM; +! all layering in RRTMG is ordered from surface to toa. +! b) call to CLDPRMC removed -- CAM supplies cloud optical depths +! c) calls SETCOEF to calculate various quantities needed for +! the radiative transfer algorithm +! d) calls TAUMOL to calculate gaseous optical depths for each +! of the 16 spectral bands +! e) calls RTRNMC (for both clear and cloudy profiles) to perform the +! radiative transfer calculation using McICA, the Monte-Carlo +! Independent Column Approximation, to represent sub-grid scale +! cloud variability +! f) passes the necessary fluxes and cooling rates back to GCM +! +! *** This version uses McICA *** +! Monte Carlo Independent Column Approximation (McICA, Pincus et al., +! JC, 2003) method is applied to the forward model calculation +! +! This call to RRTMG_LW must be preceeded by a call to the module +! mcica_subcol_gen_lw.f90 to run the McICA sub-column cloud generator, +! which will provide the cloud physical or cloud optical properties +! on the RRTMG quadrature point (ngpt) dimension. +! +! *** This version requires that cloud optical properties be input *** +! +! *** This version requires that aerosol optical properties be input *** +! Input aerosol optical depth directly by layer and spectral band (iaer=10); +! band average optical depth at the mid-point of each spectral band. +! RRTMG_LW currently treats only aerosol absorption; +! scattering capability is not presently available. +! +! +! ------- Modifications ------- +! +! This version of RRTMG_LW has been modified from RRTM_LW to use a reduced +! set of g-points for application to GCMs. +! +!-- Original version (derived from RRTM_LW), reduction of g-points, other +! revisions for use with GCMs. +! 1999: M. J. Iacono, AER, Inc. +!-- Adapted for use with NCAR/CAM. +! May 2004: M. J. Iacono, AER, Inc. +!-- Revised to add McICA capability. +! Nov 2005: M. J. Iacono, AER, Inc. +!-- Conversion to F90 formatting for consistency with rrtmg_sw. +! Feb 2007: M. J. Iacono, AER, Inc. +!-- Modifications to formatting to use assumed-shape arrays. +! Aug 2007: M. J. Iacono, AER, Inc. +!-- Modified to add longwave aerosol absorption. +! Apr 2008: M. J. Iacono, AER, Inc. + + use parrrtm, only: nbndlw, ngptlw, maxxsec, mxmol + use rrlw_con, only: fluxfac, oneminus, pi + use rrlw_wvn, only: ngb + + ! ----- Input ----- + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! Number of horizontal columns + integer, intent(in) :: nlay ! Number of model layers + integer, intent(in) :: icld ! Cloud overlap method + ! 0: Clear only + ! 1: Random + ! 2: Maximum/random + ! 3: Maximum + real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K) + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc11vmr(:,:) ! CFC11 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc12vmr(:,:) ! CFC12 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc22vmr(:,:) ! CFC22 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ccl4vmr(:,:) ! CCL4 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: emis(:,:) ! Surface emissivity + ! Dimensions: (ncol,nbndlw) + + real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: tauaer(:,:,:) ! aerosol optical depth + ! at mid-point of LW spectral bands + ! Dimensions: (ncol,nlay,nbndlw) + + ! ----- Output ----- + + real(kind=r8), intent(out) :: uflx(:,:) ! Total sky longwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: dflx(:,:) ! Total sky longwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: hr(:,:) ! Total sky longwave radiative heating rate (K/d) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: uflxc(:,:) ! Clear sky longwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: dflxc(:,:) ! Clear sky longwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: hrc(:,:) ! Clear sky longwave radiative heating rate (K/d) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: uflxs(:,:,:) ! Total sky longwave upward flux spectral (W/m2) + ! Dimensions: (nbndlw,ncol,nlay+1) + real(kind=r8), intent(out) :: dflxs(:,:,:) ! Total sky longwave downward flux spectral (W/m2) + ! Dimensions: (nbndlw,ncol,nlay+1) + + ! ----- Local ----- + + ! Control + integer :: istart ! beginning band of calculation + integer :: iend ! ending band of calculation + integer :: iout ! output option flag (inactive) + integer :: iplon ! column loop index + integer :: ims ! value for changing mcica permute seed + integer :: k ! layer loop index + integer :: ig ! g-point loop index + + ! Atmosphere + real(kind=r8) :: pavel(nlay) ! layer pressures (mb) + real(kind=r8) :: tavel(nlay) ! layer temperatures (K) + real(kind=r8) :: pz(0:nlay) ! level (interface) pressures (hPa, mb) + real(kind=r8) :: tz(0:nlay) ! level (interface) temperatures (K) + real(kind=r8) :: tbound ! surface temperature (K) + real(kind=r8) :: coldry(nlay) ! dry air column density (mol/cm2) + real(kind=r8) :: wbrodl(nlay) ! broadening gas column density (mol/cm2) + real(kind=r8) :: wkl(mxmol,nlay) ! molecular amounts (mol/cm-2) + real(kind=r8) :: wx(maxxsec,nlay) ! cross-section amounts (mol/cm-2) + real(kind=r8) :: pwvcm ! precipitable water vapor (cm) + real(kind=r8) :: semiss(nbndlw) ! lw surface emissivity + real(kind=r8) :: fracs(nlay,ngptlw) ! + real(kind=r8) :: taug(nlay,ngptlw) ! gaseous optical depths + real(kind=r8) :: taut(nlay,ngptlw) ! gaseous + aerosol optical depths + + real(kind=r8) :: taua(nlay,nbndlw) ! aerosol optical depth + + ! Atmosphere - setcoef + integer :: laytrop ! tropopause layer index + integer :: jp(nlay) ! lookup table index + integer :: jt(nlay) ! lookup table index + integer :: jt1(nlay) ! lookup table index + real(kind=r8) :: planklay(nlay,nbndlw) ! + real(kind=r8) :: planklev(0:nlay,nbndlw) ! + real(kind=r8) :: plankbnd(nbndlw) ! + + real(kind=r8) :: colh2o(nlay) ! column amount (h2o) + real(kind=r8) :: colco2(nlay) ! column amount (co2) + real(kind=r8) :: colo3(nlay) ! column amount (o3) + real(kind=r8) :: coln2o(nlay) ! column amount (n2o) + real(kind=r8) :: colco(nlay) ! column amount (co) + real(kind=r8) :: colch4(nlay) ! column amount (ch4) + real(kind=r8) :: colo2(nlay) ! column amount (o2) + real(kind=r8) :: colbrd(nlay) ! column amount (broadening gases) + + integer :: indself(nlay) + integer :: indfor(nlay) + real(kind=r8) :: selffac(nlay) + real(kind=r8) :: selffrac(nlay) + real(kind=r8) :: forfac(nlay) + real(kind=r8) :: forfrac(nlay) + + integer :: indminor(nlay) + real(kind=r8) :: minorfrac(nlay) + real(kind=r8) :: scaleminor(nlay) + real(kind=r8) :: scaleminorn2(nlay) + + real(kind=r8) :: & ! + fac00(nlay), fac01(nlay), & + fac10(nlay), fac11(nlay) + real(kind=r8) :: & ! + rat_h2oco2(nlay),rat_h2oco2_1(nlay), & + rat_h2oo3(nlay),rat_h2oo3_1(nlay), & + rat_h2on2o(nlay),rat_h2on2o_1(nlay), & + rat_h2och4(nlay),rat_h2och4_1(nlay), & + rat_n2oco2(nlay),rat_n2oco2_1(nlay), & + rat_o3co2(nlay),rat_o3co2_1(nlay) + + ! Atmosphere/clouds - cldprmc [mcica] + real(kind=r8) :: cldfmc(ngptlw,nlay) ! cloud fraction [mcica] + real(kind=r8) :: ciwpmc(ngptlw,nlay) ! cloud ice water path [mcica] + real(kind=r8) :: clwpmc(ngptlw,nlay) ! cloud liquid water path [mcica] + real(kind=r8) :: relqmc(nlay) ! liquid particle size (microns) + real(kind=r8) :: reicmc(nlay) ! ice particle effective radius (microns) + real(kind=r8) :: dgesmc(nlay) ! ice particle generalized effective size (microns) + real(kind=r8) :: taucmc(ngptlw,nlay) ! cloud optical depth [mcica] + + ! Output + real(kind=r8) :: totuflux(0:nlay) ! upward longwave flux (w/m2) + real(kind=r8) :: totdflux(0:nlay) ! downward longwave flux (w/m2) + real(kind=r8) :: totufluxs(nbndlw,0:nlay) ! upward longwave flux spectral (w/m2) + real(kind=r8) :: totdfluxs(nbndlw,0:nlay) ! downward longwave flux spectral (w/m2) + real(kind=r8) :: fnet(0:nlay) ! net longwave flux (w/m2) + real(kind=r8) :: htr(0:nlay) ! longwave heating rate (k/day) + real(kind=r8) :: totuclfl(0:nlay) ! clear sky upward longwave flux (w/m2) + real(kind=r8) :: totdclfl(0:nlay) ! clear sky downward longwave flux (w/m2) + real(kind=r8) :: fnetc(0:nlay) ! clear sky net longwave flux (w/m2) + real(kind=r8) :: htrc(0:nlay) ! clear sky longwave heating rate (k/day) + !---------------------------------------------------------------------------- + + oneminus = 1._r8 - 1.e-6_r8 + pi = 2._r8 * asin(1._r8) + fluxfac = pi * 2.e4_r8 + istart = 1 + iend = 16 + iout = 0 + ims = 1 + + ! Main longitude/column loop within RRTMG. + do iplon = 1, ncol + + ! Prepare atmospheric profile from GCM for use in RRTMG, and define + ! other input parameters. + + call inatm(iplon, nlay, icld, iaer, & + play, plev, tlay, tlev, tsfc, h2ovmr, & + o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, cfc11vmr, cfc12vmr, & + cfc22vmr, ccl4vmr, emis, & + cldfmcl, taucmcl, ciwpmcl, clwpmcl, reicmcl, relqmcl, tauaer, & + pavel, pz, tavel, tz, tbound, semiss, coldry, & + wkl, wbrodl, wx, pwvcm, & + cldfmc, taucmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, taua) + + ! Calculate information needed by the radiative transfer routine + ! that is specific to this atmosphere + ! by interpolating data from stored reference atmospheres. + + call setcoef(nlay, istart, pavel, tavel, tz, tbound, semiss, & + coldry, wkl, wbrodl, & + laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & + colbrd, fac00, fac01, fac10, fac11, & + rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & + rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, & + rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + minorfrac, scaleminor, scaleminorn2, indminor) + + ! Calculate the gaseous optical depths and Planck fractions for + ! each longwave spectral band. + + call taumol(nlay, pavel, wx, coldry, & + laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & + colbrd, fac00, fac01, fac10, fac11, & + rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & + rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, & + rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + minorfrac, scaleminor, scaleminorn2, indminor, & + fracs, taug) + + ! Combine gaseous and aerosol optical depths, if aerosol active + if (iaer == 0) then + do ig = 1, ngptlw + do k = 1, nlay + taut(k,ig) = taug(k,ig) + end do + end do + else if (iaer == 10) then + do ig = 1, ngptlw + do k = 1, nlay + taut(k,ig) = taug(k,ig) + taua(k,ngb(ig)) + end do + end do + end if + + ! Call the radiative transfer routine. + + call rtrnmc(nlay, istart, iend, iout, pz, semiss, & + cldfmc, taucmc, planklay, planklev, plankbnd, & + pwvcm, fracs, taut, & + totuflux, totdflux, fnet, htr, & + totuclfl, totdclfl, fnetc, htrc, totufluxs, totdfluxs ) + + ! Transfer up and down fluxes and heating rate to output arrays. + ! Vertical indexing goes from bottom to top + + do k = 0, nlay + uflx(iplon,k+1) = totuflux(k) + dflx(iplon,k+1) = totdflux(k) + uflxc(iplon,k+1) = totuclfl(k) + dflxc(iplon,k+1) = totdclfl(k) + uflxs(:,iplon,k+1) = totufluxs(1:nbndlw,k) + dflxs(:,iplon,k+1) = totdfluxs(1:nbndlw,k) + end do + do k = 0, nlay-1 + hr(iplon,k+1) = htr(k) + hrc(iplon,k+1) = htrc(k) + end do + + end do + +end subroutine rrtmg_lw + +!========================================================================================= + +subroutine inatm(iplon, nlay, icld, iaer, & + play, plev, tlay, tlev, tsfc, h2ovmr, & + o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, cfc11vmr, cfc12vmr, & + cfc22vmr, ccl4vmr, emis, & + cldfmcl, taucmcl, ciwpmcl, clwpmcl, reicmcl, relqmcl, tauaer, & + pavel, pz, tavel, tz, tbound, semiss, coldry, & + wkl, wbrodl, wx, pwvcm, & + cldfmc, taucmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, taua) + + ! Input atmospheric profile from GCM, and prepare it for use in RRTMG_LW. + ! Set other RRTMG_LW input parameters. + + use parrrtm, only: nbndlw, ngptlw, nmol, maxxsec, mxmol + use rrlw_con, only: grav, avogad + use rrlw_wvn, only: ixindx + + ! ----- Input ----- + integer, intent(in) :: iplon ! column loop index + integer, intent(in) :: nlay ! Number of model layers + integer, intent(in) :: icld ! clear/cloud and cloud overlap flag + integer, intent(in) :: iaer ! aerosol option flag + + real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K) + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc11vmr(:,:) ! CFC11 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc12vmr(:,:) ! CFC12 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: cfc22vmr(:,:) ! CFC22 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ccl4vmr(:,:) ! CCL4 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: emis(:,:) ! Surface emissivity + ! Dimensions: (ncol,nbndlw) + + real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=r8), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth + ! Dimensions: (ncol,nlay,nbndlw) + + ! ----- Output ----- + ! Atmosphere + real(kind=r8), intent(out) :: pavel(nlay) ! layer pressures (mb) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: tavel(nlay) ! layer temperatures (K) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: pz(0:nlay) ! level (interface) pressures (hPa, mb) + ! Dimensions: (0:nlay) + real(kind=r8), intent(out) :: tz(0:nlay) ! level (interface) temperatures (K) + ! Dimensions: (0:nlay) + real(kind=r8), intent(out) :: tbound ! surface temperature (K) + real(kind=r8), intent(out) :: coldry(nlay) ! dry air column density (mol/cm2) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: wbrodl(nlay) ! broadening gas column density (mol/cm2) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: wkl(mxmol,nlay) ! molecular amounts (mol/cm-2) + ! Dimensions: (mxmol,nlay) + real(kind=r8), intent(out) :: wx(maxxsec,nlay) ! cross-section amounts (mol/cm-2) + ! Dimensions: (maxxsec,nlay) + real(kind=r8), intent(out) :: pwvcm ! precipitable water vapor (cm) + real(kind=r8), intent(out) :: semiss(nbndlw) ! lw surface emissivity + ! Dimensions: (nbndlw) + + ! Atmosphere/clouds - cldprop + + real(kind=r8), intent(out) :: cldfmc(ngptlw,nlay) ! cloud fraction [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=r8), intent(out) :: ciwpmc(ngptlw,nlay) ! cloud ice water path [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=r8), intent(out) :: clwpmc(ngptlw,nlay) ! cloud liquid water path [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=r8), intent(out) :: relqmc(nlay) ! liquid particle effective radius (microns) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: reicmc(nlay) ! ice particle effective radius (microns) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: dgesmc(nlay) ! ice particle generalized effective size (microns) + ! Dimensions: (nlay) + real(kind=r8), intent(out) :: taucmc(ngptlw,nlay) ! cloud optical depth [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=r8), intent(out) :: taua(nlay,nbndlw) ! Aerosol optical depth + ! Dimensions: (nlay,nbndlw) + + ! ----- Local ----- + real(kind=r8), parameter :: amd = 28.9660_r8 ! Effective molecular weight of dry air (g/mol) + real(kind=r8), parameter :: amw = 18.0160_r8 ! Molecular weight of water vapor (g/mol) + + ! Set molecular weight ratios (for converting mmr to vmr) + ! e.g. h2ovmr = h2ommr * amdw) + real(kind=r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor + real(kind=r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide + real(kind=r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone + real(kind=r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane + real(kind=r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide + real(kind=r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 + real(kind=r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 + + real(kind=r8), parameter :: sbc = 5.67e-08_r8 ! Stefan-Boltzmann constant (W/m2K4) + + integer :: isp, l, ix, n, imol, ib, ig ! Loop indices + real(kind=r8) :: amm, amttl, wvttl, wvsh, summol + integer :: temp + !---------------------------------------------------------------------------- + + reicmc(:) = 0.0_r8 + dgesmc(:) = 0.0_r8 + relqmc(:) = 0.0_r8 + cldfmc(:,:) = 0.0_r8 + taucmc(:,:) = 0.0_r8 + ciwpmc(:,:) = 0.0_r8 + clwpmc(:,:) = 0.0_r8 + wkl(:,:) = 0.0_r8 + wx(:,:) = 0.0_r8 + taua(:,:) = 0.0_r8 + amttl = 0.0_r8 + wvttl = 0.0_r8 + + ! Set surface temperature. + tbound = tsfc(iplon) + + ! Install input GCM arrays into RRTMG_LW arrays for pressure, temperature, + ! and molecular amounts. + ! Pressures are input in mb, or are converted to mb here. + ! Molecular amounts are input in volume mixing ratio, or are converted from + ! mass mixing ratio (or specific humidity for h2o) to volume mixing ratio + ! here. These are then converted to molecular amount (molec/cm2) below. + ! The dry air column COLDRY (in molec/cm2) is calculated from the level + ! pressures, pz (in mb), based on the hydrostatic equation and includes a + ! correction to account for h2o in the layer. The molecular weight of moist + ! air (amm) is calculated for each layer. + ! Note: In RRTMG, layer indexing goes from bottom to top, and coding below + ! assumes GCM input fields are also bottom to top. Input layer indexing + ! from GCM fields should be reversed here if necessary. + + pz(0) = plev(iplon,nlay+1) + tz(0) = tlev(iplon,nlay+1) + do l = 1, nlay + pavel(l) = play(iplon,nlay-l+1) + tavel(l) = tlay(iplon,nlay-l+1) + pz(l) = plev(iplon,nlay-l+1) + tz(l) = tlev(iplon,nlay-l+1) + wkl(1,l) = h2ovmr(iplon,nlay-l+1) + wkl(2,l) = co2vmr(iplon,nlay-l+1) + wkl(3,l) = o3vmr(iplon,nlay-l+1) + wkl(4,l) = n2ovmr(iplon,nlay-l+1) + wkl(6,l) = ch4vmr(iplon,nlay-l+1) + wkl(7,l) = o2vmr(iplon,nlay-l+1) + + amm = (1._r8 - wkl(1,l)) * amd + wkl(1,l) * amw + + coldry(l) = (pz(l-1)-pz(l)) * 1.e3_r8 * avogad / & + (1.e2_r8 * grav * amm * (1._r8 + wkl(1,l))) + + ! Set cross section molecule amounts from input; convert to vmr if necessary + wx(1,l) = ccl4vmr(iplon,nlay-l+1) + wx(2,l) = cfc11vmr(iplon,nlay-l+1) + wx(3,l) = cfc12vmr(iplon,nlay-l+1) + wx(4,l) = cfc22vmr(iplon,nlay-l+1) + + end do + + coldry(nlay) = (pz(nlay-1)) * 1.e3_r8 * avogad / & + (1.e2_r8 * grav * amm * (1._r8 + wkl(1,nlay-1))) + + ! At this point all molecular amounts in wkl and wx are in volume mixing ratio; + ! convert to molec/cm2 based on coldry for use in rrtm. also, compute precipitable + ! water vapor for diffusivity angle adjustments in rtrn and rtrnmr. + do l = 1, nlay + summol = 0.0_r8 + do imol = 2, nmol + summol = summol + wkl(imol,l) + end do + wbrodl(l) = coldry(l) * (1._r8 - summol) + do imol = 1, nmol + wkl(imol,l) = coldry(l) * wkl(imol,l) + end do + amttl = amttl + coldry(l)+wkl(1,l) + wvttl = wvttl + wkl(1,l) + do ix = 1,maxxsec + if (ixindx(ix) .ne. 0) then + wx(ixindx(ix),l) = coldry(l) * wx(ix,l) * 1.e-20_r8 + end if + end do + end do + + wvsh = (amw * wvttl) / (amd * amttl) + pwvcm = wvsh * (1.e3_r8 * pz(0)) / (1.e2_r8 * grav) + + ! Set spectral surface emissivity for each longwave band. + do n = 1, nbndlw + semiss(n) = emis(iplon,n) + ! semiss(n) = 1.0_r8 + end do + + ! Transfer aerosol optical properties to RRTM variable; + ! modify to reverse layer indexing here if necessary. + if (iaer >= 1) then + do l = 1, nlay-1 + do ib = 1, nbndlw + taua(l,ib) = tauaer(iplon,nlay-l,ib) + end do + end do + end if + + ! Transfer cloud fraction and cloud optical properties to RRTM variables, + ! modify to reverse layer indexing here if necessary. + + if (icld >= 1) then + + ! Move incoming GCM cloud arrays to RRTMG cloud arrays. + + do l = 1, nlay-1 + do ig = 1, ngptlw + cldfmc(ig,l) = cldfmcl(ig,iplon,nlay-l) + taucmc(ig,l) = taucmcl(ig,iplon,nlay-l) + ciwpmc(ig,l) = ciwpmcl(ig,iplon,nlay-l) + clwpmc(ig,l) = clwpmcl(ig,iplon,nlay-l) + end do + reicmc(l) = reicmcl(iplon,nlay-l) + relqmc(l) = relqmcl(iplon,nlay-l) + end do + end if + +end subroutine inatm + +end module rrtmg_lw_rad diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 new file mode 100644 index 0000000000..5119b32b97 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_rtrnmc.f90 @@ -0,0 +1,504 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_rtrnmc.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.3 $ +! created: $Date: 2008/04/24 16:17:28 $ +! + module rrtmg_lw_rtrnmc + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! --------- Modules ---------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use parrrtm, only: mg, nbndlw, ngptlw + use rrlw_con, only: fluxfac, heatfac + use rrlw_wvn, only: delwave, ngb, ngs + use rrlw_tbl, only: tblint, bpade, tau_tbl, exp_tbl, tfn_tbl + + implicit none + + contains + +!----------------------------------------------------------------------------- + subroutine rtrnmc(nlayers, istart, iend, iout, pz, semiss, & + cldfmc, taucmc, planklay, planklev, plankbnd, & + pwvcm, fracs, taut, & + totuflux, totdflux, fnet, htr, & + totuclfl, totdclfl, fnetc, htrc, totufluxs, totdfluxs ) +!----------------------------------------------------------------------------- +! +! Original version: E. J. Mlawer, et al. RRTM_V3.0 +! Revision for GCMs: Michael J. Iacono; October, 2002 +! Revision for F90: Michael J. Iacono; June, 2006 +! +! This program calculates the upward fluxes, downward fluxes, and +! heating rates for an arbitrary clear or cloudy atmosphere. The input +! to this program is the atmospheric profile, all Planck function +! information, and the cloud fraction by layer. A variable diffusivity +! angle (SECDIFF) is used for the angle integration. Bands 2-3 and 5-9 +! use a value for SECDIFF that varies from 1.50 to 1.80 as a function of +! the column water vapor, and other bands use a value of 1.66. The Gaussian +! weight appropriate to this angle (WTDIFF=0.5) is applied here. Note that +! use of the emissivity angle for the flux integration can cause errors of +! 1 to 4 W/m2 within cloudy layers. +! Clouds are treated with the McICA stochastic approach and maximum-random +! cloud overlap. +!*************************************************************************** + +! ------- Declarations ------- + +! ----- Input ----- + integer, intent(in) :: nlayers ! total number of layers + integer, intent(in) :: istart ! beginning band of calculation + integer, intent(in) :: iend ! ending band of calculation + integer, intent(in) :: iout ! output option flag + +! Atmosphere + real(kind=r8), intent(in) :: pz(0:nlayers) ! level (interface) pressures (hPa, mb) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(in) :: pwvcm ! precipitable water vapor (cm) + real(kind=r8), intent(in) :: semiss(nbndlw) ! lw surface emissivity + ! Dimensions: (nbndlw) + real(kind=r8), intent(in) :: planklay(nlayers,nbndlw) ! + ! Dimensions: (nlayers,nbndlw) + real(kind=r8), intent(in) :: planklev(0:nlayers,nbndlw) ! + ! Dimensions: (0:nlayers,nbndlw) + real(kind=r8), intent(in) :: plankbnd(nbndlw) ! + ! Dimensions: (nbndlw) + real(kind=r8), intent(in) :: fracs(nlayers,ngptlw) ! + ! Dimensions: (nlayers,ngptw) + real(kind=r8), intent(in) :: taut(nlayers,ngptlw) ! gaseous + aerosol optical depths + ! Dimensions: (nlayers,ngptlw) + +! Clouds + real(kind=r8), intent(in) :: cldfmc(ngptlw,nlayers) ! layer cloud fraction [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=r8), intent(in) :: taucmc(ngptlw,nlayers) ! layer cloud optical depth [mcica] + ! Dimensions: (ngptlw,nlayers) + +! ----- Output ----- + real(kind=r8), intent(out) :: totuflux(0:) ! upward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: totdflux(0:) ! downward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: fnet(0:) ! net longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: htr(0:) ! longwave heating rate (k/day) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: totuclfl(0:) ! clear sky upward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: totdclfl(0:) ! clear sky downward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: fnetc(0:) ! clear sky net longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: htrc(0:) ! clear sky longwave heating rate (k/day) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(out) :: totufluxs(:,0:) ! upward longwave flux spectral (w/m2) + ! Dimensions: (nbndlw, 0:nlayers) + real(kind=r8), intent(out) :: totdfluxs(:,0:) ! downward longwave flux spectral (w/m2) + ! Dimensions: (nbndlw, 0:nlayers) + +! ----- Local ----- +! Declarations for radiative transfer + real(kind=r8) :: abscld(nlayers,ngptlw) + real(kind=r8) :: atot(nlayers) + real(kind=r8) :: atrans(nlayers) + real(kind=r8) :: bbugas(nlayers) + real(kind=r8) :: bbutot(nlayers) + real(kind=r8) :: clrurad(0:nlayers) + real(kind=r8) :: clrdrad(0:nlayers) + real(kind=r8) :: efclfrac(nlayers,ngptlw) + real(kind=r8) :: uflux(0:nlayers) + real(kind=r8) :: dflux(0:nlayers) + real(kind=r8) :: urad(0:nlayers) + real(kind=r8) :: drad(0:nlayers) + real(kind=r8) :: uclfl(0:nlayers) + real(kind=r8) :: dclfl(0:nlayers) + real(kind=r8) :: odcld(nlayers,ngptlw) + + + real(kind=r8) :: secdiff(nbndlw) ! secant of diffusivity angle + real(kind=r8) :: a0(nbndlw),a1(nbndlw),a2(nbndlw) ! diffusivity angle adjustment coefficients + real(kind=r8) :: wtdiff, rec_6 + real(kind=r8) :: transcld, radld, radclrd, plfrac, blay, dplankup, dplankdn + real(kind=r8) :: odepth, odtot, odepth_rec, odtot_rec, gassrc + real(kind=r8) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac + real(kind=r8) :: rad0, reflect, radlu, radclru + + integer :: icldlyr(nlayers) ! flag for cloud in layer + integer :: ibnd, ib, iband, lay, lev, l, ig ! loop indices + integer :: igc ! g-point interval counter + integer :: iclddn ! flag for cloud in down path + integer :: ittot, itgas, itr ! lookup table indices + +! ------- Definitions ------- +! input +! nlayers ! number of model layers +! ngptlw ! total number of g-point subintervals +! nbndlw ! number of longwave spectral bands +! secdiff ! diffusivity angle +! wtdiff ! weight for radiance to flux conversion +! pavel ! layer pressures (mb) +! pz ! level (interface) pressures (mb) +! tavel ! layer temperatures (k) +! tz ! level (interface) temperatures(mb) +! tbound ! surface temperature (k) +! cldfrac ! layer cloud fraction +! taucloud ! layer cloud optical depth +! itr ! integer look-up table index +! icldlyr ! flag for cloudy layers +! iclddn ! flag for cloud in column at any layer +! semiss ! surface emissivities for each band +! reflect ! surface reflectance +! bpade ! 1/(pade constant) +! tau_tbl ! clear sky optical depth look-up table +! exp_tbl ! exponential look-up table for transmittance +! tfn_tbl ! tau transition function look-up table + +! local +! atrans ! gaseous absorptivity +! abscld ! cloud absorptivity +! atot ! combined gaseous and cloud absorptivity +! odclr ! clear sky (gaseous) optical depth +! odcld ! cloud optical depth +! odtot ! optical depth of gas and cloud +! tfacgas ! gas-only pade factor, used for planck fn +! tfactot ! gas and cloud pade factor, used for planck fn +! bbdgas ! gas-only planck function for downward rt +! bbugas ! gas-only planck function for upward rt +! bbdtot ! gas and cloud planck function for downward rt +! bbutot ! gas and cloud planck function for upward calc. +! gassrc ! source radiance due to gas only +! efclfrac ! effective cloud fraction +! radlu ! spectrally summed upward radiance +! radclru ! spectrally summed clear sky upward radiance +! urad ! upward radiance by layer +! clrurad ! clear sky upward radiance by layer +! radld ! spectrally summed downward radiance +! radclrd ! spectrally summed clear sky downward radiance +! drad ! downward radiance by layer +! clrdrad ! clear sky downward radiance by layer + +! output +! totuflux ! upward longwave flux (w/m2) +! totdflux ! downward longwave flux (w/m2) +! fnet ! net longwave flux (w/m2) +! htr ! longwave heating rate (k/day) +! totuclfl ! clear sky upward longwave flux (w/m2) +! totdclfl ! clear sky downward longwave flux (w/m2) +! fnetc ! clear sky net longwave flux (w/m2) +! htrc ! clear sky longwave heating rate (k/day) + + +! This secant and weight corresponds to the standard diffusivity +! angle. This initial value is redefined below for some bands. + data wtdiff /0.5_r8/ + data rec_6 /0.166667_r8/ + +! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 +! and 1.80) as a function of total column water vapor. The function +! has been defined to minimize flux and cooling rate errors in these bands +! over a wide range of precipitable water values. + data a0 / 1.66_r8, 1.55_r8, 1.58_r8, 1.66_r8, & + 1.54_r8, 1.454_r8, 1.89_r8, 1.33_r8, & + 1.668_r8, 1.66_r8, 1.66_r8, 1.66_r8, & + 1.66_r8, 1.66_r8, 1.66_r8, 1.66_r8 / + data a1 / 0.00_r8, 0.25_r8, 0.22_r8, 0.00_r8, & + 0.13_r8, 0.446_r8, -0.10_r8, 0.40_r8, & + -0.006_r8, 0.00_r8, 0.00_r8, 0.00_r8, & + 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 / + data a2 / 0.00_r8, -12.0_r8, -11.7_r8, 0.00_r8, & + -0.72_r8,-0.243_r8, 0.19_r8,-0.062_r8, & + 0.414_r8, 0.00_r8, 0.00_r8, 0.00_r8, & + 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 / + + do ibnd = 1,nbndlw + if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then + secdiff(ibnd) = 1.66_r8 + else + secdiff(ibnd) = a0(ibnd) + a1(ibnd)*exp(a2(ibnd)*pwvcm) + if (secdiff(ibnd) .gt. 1.80_r8) secdiff(ibnd) = 1.80_r8 + if (secdiff(ibnd) .lt. 1.50_r8) secdiff(ibnd) = 1.50_r8 + endif + enddo + + urad(0) = 0.0_r8 + drad(0) = 0.0_r8 + totuflux(0) = 0.0_r8 + totdflux(0) = 0.0_r8 + clrurad(0) = 0.0_r8 + clrdrad(0) = 0.0_r8 + totuclfl(0) = 0.0_r8 + totdclfl(0) = 0.0_r8 + + do lay = 1, nlayers + urad(lay) = 0.0_r8 + drad(lay) = 0.0_r8 + totuflux(lay) = 0.0_r8 + totdflux(lay) = 0.0_r8 + clrurad(lay) = 0.0_r8 + clrdrad(lay) = 0.0_r8 + totuclfl(lay) = 0.0_r8 + totdclfl(lay) = 0.0_r8 + icldlyr(lay) = 0 + enddo +! Change to band loop? + do ig = 1, ngptlw + do lay = 1, nlayers + if (cldfmc(ig,lay) .eq. 1._r8) then + ib = ngb(ig) + odcld(lay,ig) = secdiff(ib) * taucmc(ig,lay) + transcld = exp(-odcld(lay,ig)) + abscld(lay,ig) = 1._r8 - transcld + efclfrac(lay,ig) = abscld(lay,ig) * cldfmc(ig,lay) + icldlyr(lay) = 1 + else + odcld(lay,ig) = 0.0_r8 + abscld(lay,ig) = 0.0_r8 + efclfrac(lay,ig) = 0.0_r8 + endif + enddo + + enddo + + igc = 1 +! Loop over frequency bands. + do iband = istart, iend + +! Reinitialize g-point counter for each band if output for each band is requested. + if (iout.gt.0.and.iband.ge.2) igc = ngs(iband-1)+1 + +! Loop over g-channels. + 1000 continue + +! Radiative transfer starts here. + radld = 0._r8 + radclrd = 0._r8 + iclddn = 0 + +! Downward radiative transfer loop. + + do lev = nlayers, 1, -1 + plfrac = fracs(lev,igc) + blay = planklay(lev,iband) + dplankup = planklev(lev,iband) - blay + dplankdn = planklev(lev-1,iband) - blay + odepth = secdiff(iband) * taut(lev,igc) + if (odepth .lt. 0.0_r8) odepth = 0.0_r8 +! Cloudy layer + if (icldlyr(lev).eq.1) then + iclddn = 1 + odtot = odepth + odcld(lev,igc) + if (odtot .lt. 0.06_r8) then + atrans(lev) = odepth - 0.5_r8*odepth*odepth + odepth_rec = rec_6*odepth + gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev) + + atot(lev) = odtot - 0.5_r8*odtot*odtot + odtot_rec = rec_6*odtot + bbdtot = plfrac * (blay+dplankdn*odtot_rec) + bbd = plfrac*(blay+dplankdn*odepth_rec) + radld = radld - radld * (atrans(lev) + & + efclfrac(lev,igc) * (1. - atrans(lev))) + & + gassrc + cldfmc(igc,lev) * & + (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + + bbugas(lev) = plfrac * (blay+dplankup*odepth_rec) + bbutot(lev) = plfrac * (blay+dplankup*odtot_rec) + + elseif (odepth .le. 0.06_r8) then + atrans(lev) = odepth - 0.5_r8*odepth*odepth + odepth_rec = rec_6*odepth + gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev) + + odtot = odepth + odcld(lev,igc) + tblind = odtot/(bpade+odtot) + ittot = tblint*tblind + 0.5_r8 + tfactot = tfn_tbl(ittot) + bbdtot = plfrac * (blay + tfactot*dplankdn) + bbd = plfrac*(blay+dplankdn*odepth_rec) + atot(lev) = 1. - exp_tbl(ittot) + + radld = radld - radld * (atrans(lev) + & + efclfrac(lev,igc) * (1._r8 - atrans(lev))) + & + gassrc + cldfmc(igc,lev) * & + (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + + bbugas(lev) = plfrac * (blay + dplankup*odepth_rec) + bbutot(lev) = plfrac * (blay + tfactot * dplankup) + + else + + tblind = odepth/(bpade+odepth) + itgas = tblint*tblind+0.5_r8 + odepth = tau_tbl(itgas) + atrans(lev) = 1._r8 - exp_tbl(itgas) + tfacgas = tfn_tbl(itgas) + gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn) + + odtot = odepth + odcld(lev,igc) + tblind = odtot/(bpade+odtot) + ittot = tblint*tblind + 0.5_r8 + tfactot = tfn_tbl(ittot) + bbdtot = plfrac * (blay + tfactot*dplankdn) + bbd = plfrac*(blay+tfacgas*dplankdn) + atot(lev) = 1._r8 - exp_tbl(ittot) + + radld = radld - radld * (atrans(lev) + & + efclfrac(lev,igc) * (1._r8 - atrans(lev))) + & + gassrc + cldfmc(igc,lev) * & + (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + bbugas(lev) = plfrac * (blay + tfacgas * dplankup) + bbutot(lev) = plfrac * (blay + tfactot * dplankup) + endif +! Clear layer + else + if (odepth .le. 0.06_r8) then + atrans(lev) = odepth-0.5_r8*odepth*odepth + odepth = rec_6*odepth + bbd = plfrac*(blay+dplankdn*odepth) + bbugas(lev) = plfrac*(blay+dplankup*odepth) + else + tblind = odepth/(bpade+odepth) + itr = tblint*tblind+0.5_r8 + transc = exp_tbl(itr) + atrans(lev) = 1._r8-transc + tausfac = tfn_tbl(itr) + bbd = plfrac*(blay+tausfac*dplankdn) + bbugas(lev) = plfrac * (blay + tausfac * dplankup) + endif + radld = radld + (bbd-radld)*atrans(lev) + drad(lev-1) = drad(lev-1) + radld + endif +! Set clear sky stream to total sky stream as long as layers +! remain clear. Streams diverge when a cloud is reached (iclddn=1), +! and clear sky stream must be computed separately from that point. + if (iclddn.eq.1) then + radclrd = radclrd + (bbd-radclrd) * atrans(lev) + clrdrad(lev-1) = clrdrad(lev-1) + radclrd + else + radclrd = radld + clrdrad(lev-1) = drad(lev-1) + endif + enddo + +! Spectral emissivity & reflectance +! Include the contribution of spectrally varying longwave emissivity +! and reflection from the surface to the upward radiative transfer. +! Note: Spectral and Lambertian reflection are identical for the +! diffusivity angle flux integration used here. + + rad0 = fracs(1,igc) * plankbnd(iband) +! Add in specular reflection of surface downward radiance. + reflect = 1._r8 - semiss(iband) + radlu = rad0 + reflect * radld + radclru = rad0 + reflect * radclrd + + +! Upward radiative transfer loop. + urad(0) = urad(0) + radlu + clrurad(0) = clrurad(0) + radclru + + do lev = 1, nlayers +! Cloudy layer + if (icldlyr(lev) .eq. 1) then + gassrc = bbugas(lev) * atrans(lev) + radlu = radlu - radlu * (atrans(lev) + & + efclfrac(lev,igc) * (1._r8 - atrans(lev))) + & + gassrc + cldfmc(igc,lev) * & + (bbutot(lev) * atot(lev) - gassrc) + urad(lev) = urad(lev) + radlu +! Clear layer + else + radlu = radlu + (bbugas(lev)-radlu)*atrans(lev) + urad(lev) = urad(lev) + radlu + endif +! Set clear sky stream to total sky stream as long as all layers +! are clear (iclddn=0). Streams must be calculated separately at +! all layers when a cloud is present (ICLDDN=1), because surface +! reflectance is different for each stream. + if (iclddn.eq.1) then + radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) + clrurad(lev) = clrurad(lev) + radclru + else + radclru = radlu + clrurad(lev) = urad(lev) + endif + enddo + +! Increment g-point counter + igc = igc + 1 +! Return to continue radiative transfer for all g-channels in present band + if (igc .le. ngs(iband)) go to 1000 + +! Process longwave output from band for total and clear streams. +! Calculate upward, downward, and net flux. + do lev = nlayers, 0, -1 + uflux(lev) = urad(lev)*wtdiff + dflux(lev) = drad(lev)*wtdiff + urad(lev) = 0.0_r8 + drad(lev) = 0.0_r8 + uclfl(lev) = clrurad(lev)*wtdiff + dclfl(lev) = clrdrad(lev)*wtdiff + clrurad(lev) = 0.0_r8 + clrdrad(lev) = 0.0_r8 + enddo + + do lev = nlayers, 0, -1 + totuflux(lev) = totuflux(lev) + uflux(lev) * delwave(iband) + totdflux(lev) = totdflux(lev) + dflux(lev) * delwave(iband) + totuclfl(lev) = totuclfl(lev) + uclfl(lev) * delwave(iband) + totdclfl(lev) = totdclfl(lev) + dclfl(lev) * delwave(iband) + totufluxs(iband,lev) = uflux(lev) * delwave(iband) + totdfluxs(iband,lev) = dflux(lev) * delwave(iband) + enddo +! End spectral band loop + enddo + +! Calculate fluxes at surface + totuflux(0) = totuflux(0) * fluxfac + totdflux(0) = totdflux(0) * fluxfac + totufluxs(:,0) = totufluxs(:,0) * fluxfac + totdfluxs(:,0) = totdfluxs(:,0) * fluxfac + fnet(0) = totuflux(0) - totdflux(0) + totuclfl(0) = totuclfl(0) * fluxfac + totdclfl(0) = totdclfl(0) * fluxfac + fnetc(0) = totuclfl(0) - totdclfl(0) + +! Calculate fluxes at model levels + do lev = 1, nlayers + totuflux(lev) = totuflux(lev) * fluxfac + totdflux(lev) = totdflux(lev) * fluxfac + totufluxs(:,lev) = totufluxs(:,lev) * fluxfac + totdfluxs(:,lev) = totdfluxs(:,lev) * fluxfac + fnet(lev) = totuflux(lev) - totdflux(lev) + totuclfl(lev) = totuclfl(lev) * fluxfac + totdclfl(lev) = totdclfl(lev) * fluxfac + fnetc(lev) = totuclfl(lev) - totdclfl(lev) + l = lev - 1 + +! Calculate heating rates at model layers + htr(l)=heatfac*(fnet(l)-fnet(lev))/(pz(l)-pz(lev)) + htrc(l)=heatfac*(fnetc(l)-fnetc(lev))/(pz(l)-pz(lev)) + enddo + +! Set heating rate to zero in top layer + htr(nlayers) = 0.0_r8 + htrc(nlayers) = 0.0_r8 + + end subroutine rtrnmc + + end module rrtmg_lw_rtrnmc + diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_setcoef.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_setcoef.f90 new file mode 100644 index 0000000000..21989f3978 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_setcoef.f90 @@ -0,0 +1,1266 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_setcoef.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/22 19:20:05 $ +! + module rrtmg_lw_setcoef + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use parrrtm, only : nbndlw, mg, maxxsec, mxmol + use rrlw_wvn, only: totplnk, totplk16 + use rrlw_ref, only: pref, preflog, tref, chi_mls + + implicit none + + contains + +!---------------------------------------------------------------------------- + subroutine setcoef(nlayers, istart, pavel, tavel, tz, tbound, semiss, & + coldry, wkl, wbroad, & + laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & + colbrd, fac00, fac01, fac10, fac11, & + rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & + rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, & + rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + minorfrac, scaleminor, scaleminorn2, indminor) +!---------------------------------------------------------------------------- +! +! Purpose: For a given atmosphere, calculate the indices and +! fractions related to the pressure and temperature interpolations. +! Also calculate the values of the integrated Planck functions +! for each band at the level and layer temperatures. + +! ------- Declarations ------- + +! ----- Input ----- + integer, intent(in) :: nlayers ! total number of layers + integer, intent(in) :: istart ! beginning band of calculation + + real(kind=r8), intent(in) :: pavel(nlayers) ! layer pressures (mb) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: tavel(nlayers) ! layer temperatures (K) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: tz(0:nlayers) ! level (interface) temperatures (K) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(in) :: tbound ! surface temperature (K) + real(kind=r8), intent(in) :: coldry(nlayers) ! dry air column density (mol/cm2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: wbroad(nlayers) ! broadening gas column density (mol/cm2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: wkl(mxmol,nlayers) ! molecular amounts (mol/cm-2) + ! Dimensions: (mxmol,nlayers) + real(kind=r8), intent(in) :: semiss(nbndlw) ! lw surface emissivity + ! Dimensions: (nbndlw) + +! ----- Output ----- + integer, intent(out) :: laytrop ! tropopause layer index + integer, intent(out) :: jp(nlayers) ! + ! Dimensions: (nlayers) + integer, intent(out) :: jt(nlayers) ! + ! Dimensions: (nlayers) + integer, intent(out) :: jt1(nlayers) ! + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: planklay(nlayers,nbndlw) ! + ! Dimensions: (nlayers,nbndlw) + real(kind=r8), intent(out) :: planklev(0:nlayers,nbndlw) ! + ! Dimensions: (0:nlayers,nbndlw) + real(kind=r8), intent(out) :: plankbnd(nbndlw) ! + ! Dimensions: (nbndlw) + + real(kind=r8), intent(out) :: colh2o(nlayers) ! column amount (h2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colco2(nlayers) ! column amount (co2) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colo3(nlayers) ! column amount (o3) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: coln2o(nlayers) ! column amount (n2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colco(nlayers) ! column amount (co) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colch4(nlayers) ! column amount (ch4) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colo2(nlayers) ! column amount (o2) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colbrd(nlayers) ! column amount (broadening gases) + ! Dimensions: (nlayers) + + integer, intent(out) :: indself(nlayers) + ! Dimensions: (nlayers) + integer, intent(out) :: indfor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: selffac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: selffrac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: forfac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: forfrac(nlayers) + ! Dimensions: (nlayers) + + integer, intent(out) :: indminor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: minorfrac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: scaleminor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: scaleminorn2(nlayers) + ! Dimensions: (nlayers) + + real(kind=r8), intent(out) :: & ! + fac00(nlayers), fac01(nlayers), & ! Dimensions: (nlayers) + fac10(nlayers), fac11(nlayers) + + real(kind=r8), intent(out) :: & ! + rat_h2oco2(nlayers),rat_h2oco2_1(nlayers), & + rat_h2oo3(nlayers),rat_h2oo3_1(nlayers), & ! Dimensions: (nlayers) + rat_h2on2o(nlayers),rat_h2on2o_1(nlayers), & + rat_h2och4(nlayers),rat_h2och4_1(nlayers), & + rat_n2oco2(nlayers),rat_n2oco2_1(nlayers), & + rat_o3co2(nlayers),rat_o3co2_1(nlayers) + + +! ----- Local ----- + integer :: indbound, indlev0 + integer :: lay, indlay, indlev, iband + integer :: jp1 + real(kind=r8) :: stpfac, tbndfrac, t0frac, tlayfrac, tlevfrac + real(kind=r8) :: dbdtlev, dbdtlay + real(kind=r8) :: plog, fp, ft, ft1, water, scalefac, factor, compfp + + + stpfac = 296._r8/1013._r8 + + indbound = tbound - 159._r8 + if (indbound .lt. 1) then + indbound = 1 + elseif (indbound .gt. 180) then + indbound = 180 + endif + tbndfrac = tbound - 159._r8 - float(indbound) + indlev0 = tz(0) - 159._r8 + if (indlev0 .lt. 1) then + indlev0 = 1 + elseif (indlev0 .gt. 180) then + indlev0 = 180 + endif + t0frac = tz(0) - 159._r8 - float(indlev0) + laytrop = 0 + +! Begin layer loop +! Calculate the integrated Planck functions for each band at the +! surface, level, and layer temperatures. + do lay = 1, nlayers + indlay = tavel(lay) - 159._r8 + if (indlay .lt. 1) then + indlay = 1 + elseif (indlay .gt. 180) then + indlay = 180 + endif + tlayfrac = tavel(lay) - 159._r8 - float(indlay) + indlev = tz(lay) - 159._r8 + if (indlev .lt. 1) then + indlev = 1 + elseif (indlev .gt. 180) then + indlev = 180 + endif + tlevfrac = tz(lay) - 159._r8 - float(indlev) + +! Begin spectral band loop + do iband = 1, 15 + if (lay.eq.1) then + dbdtlev = totplnk(indbound+1,iband) - totplnk(indbound,iband) + plankbnd(iband) = semiss(iband) * & + (totplnk(indbound,iband) + tbndfrac * dbdtlev) + dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband) + planklev(0,iband) = totplnk(indlev0,iband) + t0frac * dbdtlev + endif + dbdtlev = totplnk(indlev+1,iband) - totplnk(indlev,iband) + dbdtlay = totplnk(indlay+1,iband) - totplnk(indlay,iband) + planklay(lay,iband) = totplnk(indlay,iband) + tlayfrac * dbdtlay + planklev(lay,iband) = totplnk(indlev,iband) + tlevfrac * dbdtlev + enddo + +! For band 16, if radiative transfer will be performed on just +! this band, use integrated Planck values up to 3250 cm-1. +! If radiative transfer will be performed across all 16 bands, +! then include in the integrated Planck values for this band +! contributions from 2600 cm-1 to infinity. + iband = 16 + if (istart .eq. 16) then + if (lay.eq.1) then + dbdtlev = totplk16(indbound+1) - totplk16(indbound) + plankbnd(iband) = semiss(iband) * & + (totplk16(indbound) + tbndfrac * dbdtlev) + dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband) + planklev(0,iband) = totplk16(indlev0) + & + t0frac * dbdtlev + endif + dbdtlev = totplk16(indlev+1) - totplk16(indlev) + dbdtlay = totplk16(indlay+1) - totplk16(indlay) + planklay(lay,iband) = totplk16(indlay) + tlayfrac * dbdtlay + planklev(lay,iband) = totplk16(indlev) + tlevfrac * dbdtlev + else + if (lay.eq.1) then + dbdtlev = totplnk(indbound+1,iband) - totplnk(indbound,iband) + plankbnd(iband) = semiss(iband) * & + (totplnk(indbound,iband) + tbndfrac * dbdtlev) + dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband) + planklev(0,iband) = totplnk(indlev0,iband) + t0frac * dbdtlev + endif + dbdtlev = totplnk(indlev+1,iband) - totplnk(indlev,iband) + dbdtlay = totplnk(indlay+1,iband) - totplnk(indlay,iband) + planklay(lay,iband) = totplnk(indlay,iband) + tlayfrac * dbdtlay + planklev(lay,iband) = totplnk(indlev,iband) + tlevfrac * dbdtlev + endif + +! Find the two reference pressures on either side of the +! layer pressure. Store them in JP and JP1. Store in FP the +! fraction of the difference (in ln(pressure)) between these +! two values that the layer pressure lies. +! plog = alog(pavel(lay)) + plog = dlog(pavel(lay)) + jp(lay) = int(36._r8 - 5*(plog+0.04_r8)) + if (jp(lay) .lt. 1) then + jp(lay) = 1 + elseif (jp(lay) .gt. 58) then + jp(lay) = 58 + endif + jp1 = jp(lay) + 1 + fp = min(3._r8, max(-2._r8, 5._r8 *(preflog(jp(lay)) - plog))) + +! Determine, for each reference pressure (JP and JP1), which +! reference temperature (these are different for each +! reference pressure) is nearest the layer temperature but does +! not exceed it. Store these indices in JT and JT1, resp. +! Store in FT (resp. FT1) the fraction of the way between JT +! (JT1) and the next highest reference temperature that the +! layer temperature falls. + jt(lay) = int(3._r8 + (tavel(lay)-tref(jp(lay)))/15._r8) + if (jt(lay) .lt. 1) then + jt(lay) = 1 + elseif (jt(lay) .gt. 4) then + jt(lay) = 4 + endif + ft = min(3._r8, max(-2._r8, ((tavel(lay)-tref(jp(lay)))/15._r8) - float(jt(lay)-3))) + jt1(lay) = int(3._r8 + (tavel(lay)-tref(jp1))/15._r8) + if (jt1(lay) .lt. 1) then + jt1(lay) = 1 + elseif (jt1(lay) .gt. 4) then + jt1(lay) = 4 + endif + ft1 = min(3._r8, max(-2._r8, ((tavel(lay)-tref(jp1))/15._r8) - float(jt1(lay)-3))) + water = wkl(1,lay)/coldry(lay) + scalefac = pavel(lay) * stpfac / tavel(lay) + +! If the pressure is less than ~100mb, perform a different +! set of species interpolations. + if (plog .le. 4.56_r8) go to 5300 + laytrop = laytrop + 1 + + forfac(lay) = scalefac / (1.+water) + factor = (332.0_r8-tavel(lay))/36.0_r8 + indfor(lay) = min(2, max(1, int(factor))) + forfrac(lay) = min(3._r8, max(-2._r8, factor - float(indfor(lay)))) + +! Set up factors needed to separately include the water vapor +! self-continuum in the calculation of absorption coefficient. + selffac(lay) = water * forfac(lay) + factor = (tavel(lay)-188.0_r8)/7.2_r8 + indself(lay) = min(9, max(1, int(factor)-7)) + selffrac(lay) = min(3._r8, max(-2._r8, factor - float(indself(lay) + 7))) + +! Set up factors needed to separately include the minor gases +! in the calculation of absorption coefficient + scaleminor(lay) = pavel(lay)/tavel(lay) + scaleminorn2(lay) = (pavel(lay)/tavel(lay)) & + *(wbroad(lay)/(coldry(lay)+wkl(1,lay))) + factor = (tavel(lay)-180.8_r8)/7.2_r8 + indminor(lay) = min(18, max(1, int(factor))) + minorfrac(lay) = min(3._r8, max(-2._r8, factor - float(indminor(lay)))) + +! Setup reference ratio to be used in calculation of binary +! species parameter in lower atmosphere. + rat_h2oco2(lay)=chi_mls(1,jp(lay))/chi_mls(2,jp(lay)) + rat_h2oco2_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(2,jp(lay)+1) + + rat_h2oo3(lay)=chi_mls(1,jp(lay))/chi_mls(3,jp(lay)) + rat_h2oo3_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(3,jp(lay)+1) + + rat_h2on2o(lay)=chi_mls(1,jp(lay))/chi_mls(4,jp(lay)) + rat_h2on2o_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(4,jp(lay)+1) + + rat_h2och4(lay)=chi_mls(1,jp(lay))/chi_mls(6,jp(lay)) + rat_h2och4_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(6,jp(lay)+1) + + rat_n2oco2(lay)=chi_mls(4,jp(lay))/chi_mls(2,jp(lay)) + rat_n2oco2_1(lay)=chi_mls(4,jp(lay)+1)/chi_mls(2,jp(lay)+1) + +! Calculate needed column amounts. + colh2o(lay) = 1.e-20_r8 * wkl(1,lay) + colco2(lay) = 1.e-20_r8 * wkl(2,lay) + colo3(lay) = 1.e-20_r8 * wkl(3,lay) + coln2o(lay) = 1.e-20_r8 * wkl(4,lay) + colco(lay) = 1.e-20_r8 * wkl(5,lay) + colch4(lay) = 1.e-20_r8 * wkl(6,lay) + colo2(lay) = 1.e-20_r8 * wkl(7,lay) + if (colco2(lay) .eq. 0._r8) colco2(lay) = 1.e-32_r8 * coldry(lay) + if (colo3(lay) .eq. 0._r8) colo3(lay) = 1.e-32_r8 * coldry(lay) + if (coln2o(lay) .eq. 0._r8) coln2o(lay) = 1.e-32_r8 * coldry(lay) + if (colco(lay) .eq. 0._r8) colco(lay) = 1.e-32_r8 * coldry(lay) + if (colch4(lay) .eq. 0._r8) colch4(lay) = 1.e-32_r8 * coldry(lay) + colbrd(lay) = 1.e-20_r8 * wbroad(lay) + go to 5400 + +! Above laytrop. + 5300 continue + + forfac(lay) = scalefac / (1.+water) + factor = (tavel(lay)-188.0_r8)/36.0_r8 + indfor(lay) = 3 + forfrac(lay) = min(3._r8, max(-2._r8, factor - 1.0_r8)) + +! Set up factors needed to separately include the water vapor +! self-continuum in the calculation of absorption coefficient. + selffac(lay) = water * forfac(lay) + +! Set up factors needed to separately include the minor gases +! in the calculation of absorption coefficient + scaleminor(lay) = pavel(lay)/tavel(lay) + scaleminorn2(lay) = (pavel(lay)/tavel(lay)) & + * (wbroad(lay)/(coldry(lay)+wkl(1,lay))) + factor = (tavel(lay)-180.8_r8)/7.2_r8 + indminor(lay) = min(18, max(1, int(factor))) + minorfrac(lay) = min(3._r8, max(-2._r8, factor - float(indminor(lay)))) + +! Setup reference ratio to be used in calculation of binary +! species parameter in upper atmosphere. + rat_h2oco2(lay)=chi_mls(1,jp(lay))/chi_mls(2,jp(lay)) + rat_h2oco2_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(2,jp(lay)+1) + + rat_o3co2(lay)=chi_mls(3,jp(lay))/chi_mls(2,jp(lay)) + rat_o3co2_1(lay)=chi_mls(3,jp(lay)+1)/chi_mls(2,jp(lay)+1) + +! Calculate needed column amounts. + colh2o(lay) = 1.e-20_r8 * wkl(1,lay) + colco2(lay) = 1.e-20_r8 * wkl(2,lay) + colo3(lay) = 1.e-20_r8 * wkl(3,lay) + coln2o(lay) = 1.e-20_r8 * wkl(4,lay) + colco(lay) = 1.e-20_r8 * wkl(5,lay) + colch4(lay) = 1.e-20_r8 * wkl(6,lay) + colo2(lay) = 1.e-20_r8 * wkl(7,lay) + if (colco2(lay) .eq. 0._r8) colco2(lay) = 1.e-32_r8 * coldry(lay) + if (colo3(lay) .eq. 0._r8) colo3(lay) = 1.e-32_r8 * coldry(lay) + if (coln2o(lay) .eq. 0._r8) coln2o(lay) = 1.e-32_r8 * coldry(lay) + if (colco(lay) .eq. 0._r8) colco(lay) = 1.e-32_r8 * coldry(lay) + if (colch4(lay) .eq. 0._r8) colch4(lay) = 1.e-32_r8 * coldry(lay) + colbrd(lay) = 1.e-20_r8 * wbroad(lay) + 5400 continue + +! We have now isolated the layer ln pressure and temperature, +! between two reference pressures and two reference temperatures +! (for each reference pressure). We multiply the pressure +! fraction FP with the appropriate temperature fractions to get +! the factors that will be needed for the interpolation that yields +! the optical depths (performed in routines TAUGBn for band n).` + + compfp = 1. - fp + fac10(lay) = compfp * ft + fac00(lay) = compfp * (1._r8 - ft) + fac11(lay) = fp * ft1 + fac01(lay) = fp * (1._r8 - ft1) + +! Rescale selffac and forfac for use in taumol + selffac(lay) = colh2o(lay)*selffac(lay) + forfac(lay) = colh2o(lay)*forfac(lay) + +! End layer loop + enddo + + end subroutine setcoef + +!*************************************************************************** + subroutine lwatmref +!*************************************************************************** + + save + +! These pressures are chosen such that the ln of the first pressure +! has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and +! each subsequent ln(pressure) differs from the previous one by 0.2. + + pref(:) = (/ & + 1.05363e+03_r8,8.62642e+02_r8,7.06272e+02_r8,5.78246e+02_r8,4.73428e+02_r8, & + 3.87610e+02_r8,3.17348e+02_r8,2.59823e+02_r8,2.12725e+02_r8,1.74164e+02_r8, & + 1.42594e+02_r8,1.16746e+02_r8,9.55835e+01_r8,7.82571e+01_r8,6.40715e+01_r8, & + 5.24573e+01_r8,4.29484e+01_r8,3.51632e+01_r8,2.87892e+01_r8,2.35706e+01_r8, & + 1.92980e+01_r8,1.57998e+01_r8,1.29358e+01_r8,1.05910e+01_r8,8.67114e+00_r8, & + 7.09933e+00_r8,5.81244e+00_r8,4.75882e+00_r8,3.89619e+00_r8,3.18993e+00_r8, & + 2.61170e+00_r8,2.13828e+00_r8,1.75067e+00_r8,1.43333e+00_r8,1.17351e+00_r8, & + 9.60789e-01_r8,7.86628e-01_r8,6.44036e-01_r8,5.27292e-01_r8,4.31710e-01_r8, & + 3.53455e-01_r8,2.89384e-01_r8,2.36928e-01_r8,1.93980e-01_r8,1.58817e-01_r8, & + 1.30029e-01_r8,1.06458e-01_r8,8.71608e-02_r8,7.13612e-02_r8,5.84256e-02_r8, & + 4.78349e-02_r8,3.91639e-02_r8,3.20647e-02_r8,2.62523e-02_r8,2.14936e-02_r8, & + 1.75975e-02_r8,1.44076e-02_r8,1.17959e-02_r8,9.65769e-03_r8/) + + preflog(:) = (/ & + 6.9600e+00_r8, 6.7600e+00_r8, 6.5600e+00_r8, 6.3600e+00_r8, 6.1600e+00_r8, & + 5.9600e+00_r8, 5.7600e+00_r8, 5.5600e+00_r8, 5.3600e+00_r8, 5.1600e+00_r8, & + 4.9600e+00_r8, 4.7600e+00_r8, 4.5600e+00_r8, 4.3600e+00_r8, 4.1600e+00_r8, & + 3.9600e+00_r8, 3.7600e+00_r8, 3.5600e+00_r8, 3.3600e+00_r8, 3.1600e+00_r8, & + 2.9600e+00_r8, 2.7600e+00_r8, 2.5600e+00_r8, 2.3600e+00_r8, 2.1600e+00_r8, & + 1.9600e+00_r8, 1.7600e+00_r8, 1.5600e+00_r8, 1.3600e+00_r8, 1.1600e+00_r8, & + 9.6000e-01_r8, 7.6000e-01_r8, 5.6000e-01_r8, 3.6000e-01_r8, 1.6000e-01_r8, & + -4.0000e-02_r8,-2.4000e-01_r8,-4.4000e-01_r8,-6.4000e-01_r8,-8.4000e-01_r8, & + -1.0400e+00_r8,-1.2400e+00_r8,-1.4400e+00_r8,-1.6400e+00_r8,-1.8400e+00_r8, & + -2.0400e+00_r8,-2.2400e+00_r8,-2.4400e+00_r8,-2.6400e+00_r8,-2.8400e+00_r8, & + -3.0400e+00_r8,-3.2400e+00_r8,-3.4400e+00_r8,-3.6400e+00_r8,-3.8400e+00_r8, & + -4.0400e+00_r8,-4.2400e+00_r8,-4.4400e+00_r8,-4.6400e+00_r8/) + +! These are the temperatures associated with the respective +! pressures for the mls standard atmosphere. + + tref(:) = (/ & + 2.9420e+02_r8, 2.8799e+02_r8, 2.7894e+02_r8, 2.6925e+02_r8, 2.5983e+02_r8, & + 2.5017e+02_r8, 2.4077e+02_r8, 2.3179e+02_r8, 2.2306e+02_r8, 2.1578e+02_r8, & + 2.1570e+02_r8, 2.1570e+02_r8, 2.1570e+02_r8, 2.1706e+02_r8, 2.1858e+02_r8, & + 2.2018e+02_r8, 2.2174e+02_r8, 2.2328e+02_r8, 2.2479e+02_r8, 2.2655e+02_r8, & + 2.2834e+02_r8, 2.3113e+02_r8, 2.3401e+02_r8, 2.3703e+02_r8, 2.4022e+02_r8, & + 2.4371e+02_r8, 2.4726e+02_r8, 2.5085e+02_r8, 2.5457e+02_r8, 2.5832e+02_r8, & + 2.6216e+02_r8, 2.6606e+02_r8, 2.6999e+02_r8, 2.7340e+02_r8, 2.7536e+02_r8, & + 2.7568e+02_r8, 2.7372e+02_r8, 2.7163e+02_r8, 2.6955e+02_r8, 2.6593e+02_r8, & + 2.6211e+02_r8, 2.5828e+02_r8, 2.5360e+02_r8, 2.4854e+02_r8, 2.4348e+02_r8, & + 2.3809e+02_r8, 2.3206e+02_r8, 2.2603e+02_r8, 2.2000e+02_r8, 2.1435e+02_r8, & + 2.0887e+02_r8, 2.0340e+02_r8, 1.9792e+02_r8, 1.9290e+02_r8, 1.8809e+02_r8, & + 1.8329e+02_r8, 1.7849e+02_r8, 1.7394e+02_r8, 1.7212e+02_r8/) + + chi_mls(1,1:12) = (/ & + 1.8760e-02_r8, 1.2223e-02_r8, 5.8909e-03_r8, 2.7675e-03_r8, 1.4065e-03_r8, & + 7.5970e-04_r8, 3.8876e-04_r8, 1.6542e-04_r8, 3.7190e-05_r8, 7.4765e-06_r8, & + 4.3082e-06_r8, 3.3319e-06_r8/) + chi_mls(1,13:59) = (/ & + 3.2039e-06_r8, 3.1619e-06_r8, 3.2524e-06_r8, 3.4226e-06_r8, 3.6288e-06_r8, & + 3.9148e-06_r8, 4.1488e-06_r8, 4.3081e-06_r8, 4.4420e-06_r8, 4.5778e-06_r8, & + 4.7087e-06_r8, 4.7943e-06_r8, 4.8697e-06_r8, 4.9260e-06_r8, 4.9669e-06_r8, & + 4.9963e-06_r8, 5.0527e-06_r8, 5.1266e-06_r8, 5.2503e-06_r8, 5.3571e-06_r8, & + 5.4509e-06_r8, 5.4830e-06_r8, 5.5000e-06_r8, 5.5000e-06_r8, 5.4536e-06_r8, & + 5.4047e-06_r8, 5.3558e-06_r8, 5.2533e-06_r8, 5.1436e-06_r8, 5.0340e-06_r8, & + 4.8766e-06_r8, 4.6979e-06_r8, 4.5191e-06_r8, 4.3360e-06_r8, 4.1442e-06_r8, & + 3.9523e-06_r8, 3.7605e-06_r8, 3.5722e-06_r8, 3.3855e-06_r8, 3.1988e-06_r8, & + 3.0121e-06_r8, 2.8262e-06_r8, 2.6407e-06_r8, 2.4552e-06_r8, 2.2696e-06_r8, & + 4.3360e-06_r8, 4.1442e-06_r8/) + chi_mls(2,1:12) = (/ & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8/) + chi_mls(2,13:59) = (/ & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, 3.5500e-04_r8, & + 3.5500e-04_r8, 3.5471e-04_r8, 3.5427e-04_r8, 3.5384e-04_r8, 3.5340e-04_r8, & + 3.5500e-04_r8, 3.5500e-04_r8/) + chi_mls(3,1:12) = (/ & + 3.0170e-08_r8, 3.4725e-08_r8, 4.2477e-08_r8, 5.2759e-08_r8, 6.6944e-08_r8, & + 8.7130e-08_r8, 1.1391e-07_r8, 1.5677e-07_r8, 2.1788e-07_r8, 3.2443e-07_r8, & + 4.6594e-07_r8, 5.6806e-07_r8/) + chi_mls(3,13:59) = (/ & + 6.9607e-07_r8, 1.1186e-06_r8, 1.7618e-06_r8, 2.3269e-06_r8, 2.9577e-06_r8, & + 3.6593e-06_r8, 4.5950e-06_r8, 5.3189e-06_r8, 5.9618e-06_r8, 6.5113e-06_r8, & + 7.0635e-06_r8, 7.6917e-06_r8, 8.2577e-06_r8, 8.7082e-06_r8, 8.8325e-06_r8, & + 8.7149e-06_r8, 8.0943e-06_r8, 7.3307e-06_r8, 6.3101e-06_r8, 5.3672e-06_r8, & + 4.4829e-06_r8, 3.8391e-06_r8, 3.2827e-06_r8, 2.8235e-06_r8, 2.4906e-06_r8, & + 2.1645e-06_r8, 1.8385e-06_r8, 1.6618e-06_r8, 1.5052e-06_r8, 1.3485e-06_r8, & + 1.1972e-06_r8, 1.0482e-06_r8, 8.9926e-07_r8, 7.6343e-07_r8, 6.5381e-07_r8, & + 5.4419e-07_r8, 4.3456e-07_r8, 3.6421e-07_r8, 3.1194e-07_r8, 2.5967e-07_r8, & + 2.0740e-07_r8, 1.9146e-07_r8, 1.9364e-07_r8, 1.9582e-07_r8, 1.9800e-07_r8, & + 7.6343e-07_r8, 6.5381e-07_r8/) + chi_mls(4,1:12) = (/ & + 3.2000e-07_r8, 3.2000e-07_r8, 3.2000e-07_r8, 3.2000e-07_r8, 3.2000e-07_r8, & + 3.1965e-07_r8, 3.1532e-07_r8, 3.0383e-07_r8, 2.9422e-07_r8, 2.8495e-07_r8, & + 2.7671e-07_r8, 2.6471e-07_r8/) + chi_mls(4,13:59) = (/ & + 2.4285e-07_r8, 2.0955e-07_r8, 1.7195e-07_r8, 1.3749e-07_r8, 1.1332e-07_r8, & + 1.0035e-07_r8, 9.1281e-08_r8, 8.5463e-08_r8, 8.0363e-08_r8, 7.3372e-08_r8, & + 6.5975e-08_r8, 5.6039e-08_r8, 4.7090e-08_r8, 3.9977e-08_r8, 3.2979e-08_r8, & + 2.6064e-08_r8, 2.1066e-08_r8, 1.6592e-08_r8, 1.3017e-08_r8, 1.0090e-08_r8, & + 7.6249e-09_r8, 6.1159e-09_r8, 4.6672e-09_r8, 3.2857e-09_r8, 2.8484e-09_r8, & + 2.4620e-09_r8, 2.0756e-09_r8, 1.8551e-09_r8, 1.6568e-09_r8, 1.4584e-09_r8, & + 1.3195e-09_r8, 1.2072e-09_r8, 1.0948e-09_r8, 9.9780e-10_r8, 9.3126e-10_r8, & + 8.6472e-10_r8, 7.9818e-10_r8, 7.5138e-10_r8, 7.1367e-10_r8, 6.7596e-10_r8, & + 6.3825e-10_r8, 6.0981e-10_r8, 5.8600e-10_r8, 5.6218e-10_r8, 5.3837e-10_r8, & + 9.9780e-10_r8, 9.3126e-10_r8/) + chi_mls(5,1:12) = (/ & + 1.5000e-07_r8, 1.4306e-07_r8, 1.3474e-07_r8, 1.3061e-07_r8, 1.2793e-07_r8, & + 1.2038e-07_r8, 1.0798e-07_r8, 9.4238e-08_r8, 7.9488e-08_r8, 6.1386e-08_r8, & + 4.5563e-08_r8, 3.3475e-08_r8/) + chi_mls(5,13:59) = (/ & + 2.5118e-08_r8, 1.8671e-08_r8, 1.4349e-08_r8, 1.2501e-08_r8, 1.2407e-08_r8, & + 1.3472e-08_r8, 1.4900e-08_r8, 1.6079e-08_r8, 1.7156e-08_r8, 1.8616e-08_r8, & + 2.0106e-08_r8, 2.1654e-08_r8, 2.3096e-08_r8, 2.4340e-08_r8, 2.5643e-08_r8, & + 2.6990e-08_r8, 2.8456e-08_r8, 2.9854e-08_r8, 3.0943e-08_r8, 3.2023e-08_r8, & + 3.3101e-08_r8, 3.4260e-08_r8, 3.5360e-08_r8, 3.6397e-08_r8, 3.7310e-08_r8, & + 3.8217e-08_r8, 3.9123e-08_r8, 4.1303e-08_r8, 4.3652e-08_r8, 4.6002e-08_r8, & + 5.0289e-08_r8, 5.5446e-08_r8, 6.0603e-08_r8, 6.8946e-08_r8, 8.3652e-08_r8, & + 9.8357e-08_r8, 1.1306e-07_r8, 1.4766e-07_r8, 1.9142e-07_r8, 2.3518e-07_r8, & + 2.7894e-07_r8, 3.5001e-07_r8, 4.3469e-07_r8, 5.1938e-07_r8, 6.0407e-07_r8, & + 6.8946e-08_r8, 8.3652e-08_r8/) + chi_mls(6,1:12) = (/ & + 1.7000e-06_r8, 1.7000e-06_r8, 1.6999e-06_r8, 1.6904e-06_r8, 1.6671e-06_r8, & + 1.6351e-06_r8, 1.6098e-06_r8, 1.5590e-06_r8, 1.5120e-06_r8, 1.4741e-06_r8, & + 1.4385e-06_r8, 1.4002e-06_r8/) + chi_mls(6,13:59) = (/ & + 1.3573e-06_r8, 1.3130e-06_r8, 1.2512e-06_r8, 1.1668e-06_r8, 1.0553e-06_r8, & + 9.3281e-07_r8, 8.1217e-07_r8, 7.5239e-07_r8, 7.0728e-07_r8, 6.6722e-07_r8, & + 6.2733e-07_r8, 5.8604e-07_r8, 5.4769e-07_r8, 5.1480e-07_r8, 4.8206e-07_r8, & + 4.4943e-07_r8, 4.1702e-07_r8, 3.8460e-07_r8, 3.5200e-07_r8, 3.1926e-07_r8, & + 2.8646e-07_r8, 2.5498e-07_r8, 2.2474e-07_r8, 1.9588e-07_r8, 1.8295e-07_r8, & + 1.7089e-07_r8, 1.5882e-07_r8, 1.5536e-07_r8, 1.5304e-07_r8, 1.5072e-07_r8, & + 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, & + 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, & + 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, 1.5000e-07_r8, & + 1.5000e-07_r8, 1.5000e-07_r8/) + chi_mls(7,1:12) = (/ & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8/) + chi_mls(7,13:59) = (/ & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, 0.2090_r8, & + 0.2090_r8, 0.2090_r8/) + + end subroutine lwatmref + +!*************************************************************************** + subroutine lwavplank +!*************************************************************************** + + save + + totplnk(1:50, 1) = (/ & + 0.14783e-05_r8,0.15006e-05_r8,0.15230e-05_r8,0.15455e-05_r8,0.15681e-05_r8, & + 0.15908e-05_r8,0.16136e-05_r8,0.16365e-05_r8,0.16595e-05_r8,0.16826e-05_r8, & + 0.17059e-05_r8,0.17292e-05_r8,0.17526e-05_r8,0.17762e-05_r8,0.17998e-05_r8, & + 0.18235e-05_r8,0.18473e-05_r8,0.18712e-05_r8,0.18953e-05_r8,0.19194e-05_r8, & + 0.19435e-05_r8,0.19678e-05_r8,0.19922e-05_r8,0.20166e-05_r8,0.20412e-05_r8, & + 0.20658e-05_r8,0.20905e-05_r8,0.21153e-05_r8,0.21402e-05_r8,0.21652e-05_r8, & + 0.21902e-05_r8,0.22154e-05_r8,0.22406e-05_r8,0.22659e-05_r8,0.22912e-05_r8, & + 0.23167e-05_r8,0.23422e-05_r8,0.23678e-05_r8,0.23934e-05_r8,0.24192e-05_r8, & + 0.24450e-05_r8,0.24709e-05_r8,0.24968e-05_r8,0.25229e-05_r8,0.25490e-05_r8, & + 0.25751e-05_r8,0.26014e-05_r8,0.26277e-05_r8,0.26540e-05_r8,0.26805e-05_r8/) + totplnk(51:100, 1) = (/ & + 0.27070e-05_r8,0.27335e-05_r8,0.27602e-05_r8,0.27869e-05_r8,0.28136e-05_r8, & + 0.28404e-05_r8,0.28673e-05_r8,0.28943e-05_r8,0.29213e-05_r8,0.29483e-05_r8, & + 0.29754e-05_r8,0.30026e-05_r8,0.30298e-05_r8,0.30571e-05_r8,0.30845e-05_r8, & + 0.31119e-05_r8,0.31393e-05_r8,0.31669e-05_r8,0.31944e-05_r8,0.32220e-05_r8, & + 0.32497e-05_r8,0.32774e-05_r8,0.33052e-05_r8,0.33330e-05_r8,0.33609e-05_r8, & + 0.33888e-05_r8,0.34168e-05_r8,0.34448e-05_r8,0.34729e-05_r8,0.35010e-05_r8, & + 0.35292e-05_r8,0.35574e-05_r8,0.35857e-05_r8,0.36140e-05_r8,0.36424e-05_r8, & + 0.36708e-05_r8,0.36992e-05_r8,0.37277e-05_r8,0.37563e-05_r8,0.37848e-05_r8, & + 0.38135e-05_r8,0.38421e-05_r8,0.38708e-05_r8,0.38996e-05_r8,0.39284e-05_r8, & + 0.39572e-05_r8,0.39861e-05_r8,0.40150e-05_r8,0.40440e-05_r8,0.40730e-05_r8/) + totplnk(101:150, 1) = (/ & + 0.41020e-05_r8,0.41311e-05_r8,0.41602e-05_r8,0.41893e-05_r8,0.42185e-05_r8, & + 0.42477e-05_r8,0.42770e-05_r8,0.43063e-05_r8,0.43356e-05_r8,0.43650e-05_r8, & + 0.43944e-05_r8,0.44238e-05_r8,0.44533e-05_r8,0.44828e-05_r8,0.45124e-05_r8, & + 0.45419e-05_r8,0.45715e-05_r8,0.46012e-05_r8,0.46309e-05_r8,0.46606e-05_r8, & + 0.46903e-05_r8,0.47201e-05_r8,0.47499e-05_r8,0.47797e-05_r8,0.48096e-05_r8, & + 0.48395e-05_r8,0.48695e-05_r8,0.48994e-05_r8,0.49294e-05_r8,0.49594e-05_r8, & + 0.49895e-05_r8,0.50196e-05_r8,0.50497e-05_r8,0.50798e-05_r8,0.51100e-05_r8, & + 0.51402e-05_r8,0.51704e-05_r8,0.52007e-05_r8,0.52309e-05_r8,0.52612e-05_r8, & + 0.52916e-05_r8,0.53219e-05_r8,0.53523e-05_r8,0.53827e-05_r8,0.54132e-05_r8, & + 0.54436e-05_r8,0.54741e-05_r8,0.55047e-05_r8,0.55352e-05_r8,0.55658e-05_r8/) + totplnk(151:181, 1) = (/ & + 0.55964e-05_r8,0.56270e-05_r8,0.56576e-05_r8,0.56883e-05_r8,0.57190e-05_r8, & + 0.57497e-05_r8,0.57804e-05_r8,0.58112e-05_r8,0.58420e-05_r8,0.58728e-05_r8, & + 0.59036e-05_r8,0.59345e-05_r8,0.59653e-05_r8,0.59962e-05_r8,0.60272e-05_r8, & + 0.60581e-05_r8,0.60891e-05_r8,0.61201e-05_r8,0.61511e-05_r8,0.61821e-05_r8, & + 0.62131e-05_r8,0.62442e-05_r8,0.62753e-05_r8,0.63064e-05_r8,0.63376e-05_r8, & + 0.63687e-05_r8,0.63998e-05_r8,0.64310e-05_r8,0.64622e-05_r8,0.64935e-05_r8, & + 0.65247e-05_r8/) + totplnk(1:50, 2) = (/ & + 0.20262e-05_r8,0.20757e-05_r8,0.21257e-05_r8,0.21763e-05_r8,0.22276e-05_r8, & + 0.22794e-05_r8,0.23319e-05_r8,0.23849e-05_r8,0.24386e-05_r8,0.24928e-05_r8, & + 0.25477e-05_r8,0.26031e-05_r8,0.26591e-05_r8,0.27157e-05_r8,0.27728e-05_r8, & + 0.28306e-05_r8,0.28889e-05_r8,0.29478e-05_r8,0.30073e-05_r8,0.30673e-05_r8, & + 0.31279e-05_r8,0.31890e-05_r8,0.32507e-05_r8,0.33129e-05_r8,0.33757e-05_r8, & + 0.34391e-05_r8,0.35029e-05_r8,0.35674e-05_r8,0.36323e-05_r8,0.36978e-05_r8, & + 0.37638e-05_r8,0.38304e-05_r8,0.38974e-05_r8,0.39650e-05_r8,0.40331e-05_r8, & + 0.41017e-05_r8,0.41708e-05_r8,0.42405e-05_r8,0.43106e-05_r8,0.43812e-05_r8, & + 0.44524e-05_r8,0.45240e-05_r8,0.45961e-05_r8,0.46687e-05_r8,0.47418e-05_r8, & + 0.48153e-05_r8,0.48894e-05_r8,0.49639e-05_r8,0.50389e-05_r8,0.51143e-05_r8/) + totplnk(51:100, 2) = (/ & + 0.51902e-05_r8,0.52666e-05_r8,0.53434e-05_r8,0.54207e-05_r8,0.54985e-05_r8, & + 0.55767e-05_r8,0.56553e-05_r8,0.57343e-05_r8,0.58139e-05_r8,0.58938e-05_r8, & + 0.59742e-05_r8,0.60550e-05_r8,0.61362e-05_r8,0.62179e-05_r8,0.63000e-05_r8, & + 0.63825e-05_r8,0.64654e-05_r8,0.65487e-05_r8,0.66324e-05_r8,0.67166e-05_r8, & + 0.68011e-05_r8,0.68860e-05_r8,0.69714e-05_r8,0.70571e-05_r8,0.71432e-05_r8, & + 0.72297e-05_r8,0.73166e-05_r8,0.74039e-05_r8,0.74915e-05_r8,0.75796e-05_r8, & + 0.76680e-05_r8,0.77567e-05_r8,0.78459e-05_r8,0.79354e-05_r8,0.80252e-05_r8, & + 0.81155e-05_r8,0.82061e-05_r8,0.82970e-05_r8,0.83883e-05_r8,0.84799e-05_r8, & + 0.85719e-05_r8,0.86643e-05_r8,0.87569e-05_r8,0.88499e-05_r8,0.89433e-05_r8, & + 0.90370e-05_r8,0.91310e-05_r8,0.92254e-05_r8,0.93200e-05_r8,0.94150e-05_r8/) + totplnk(101:150, 2) = (/ & + 0.95104e-05_r8,0.96060e-05_r8,0.97020e-05_r8,0.97982e-05_r8,0.98948e-05_r8, & + 0.99917e-05_r8,0.10089e-04_r8,0.10186e-04_r8,0.10284e-04_r8,0.10382e-04_r8, & + 0.10481e-04_r8,0.10580e-04_r8,0.10679e-04_r8,0.10778e-04_r8,0.10877e-04_r8, & + 0.10977e-04_r8,0.11077e-04_r8,0.11178e-04_r8,0.11279e-04_r8,0.11380e-04_r8, & + 0.11481e-04_r8,0.11583e-04_r8,0.11684e-04_r8,0.11786e-04_r8,0.11889e-04_r8, & + 0.11992e-04_r8,0.12094e-04_r8,0.12198e-04_r8,0.12301e-04_r8,0.12405e-04_r8, & + 0.12509e-04_r8,0.12613e-04_r8,0.12717e-04_r8,0.12822e-04_r8,0.12927e-04_r8, & + 0.13032e-04_r8,0.13138e-04_r8,0.13244e-04_r8,0.13349e-04_r8,0.13456e-04_r8, & + 0.13562e-04_r8,0.13669e-04_r8,0.13776e-04_r8,0.13883e-04_r8,0.13990e-04_r8, & + 0.14098e-04_r8,0.14206e-04_r8,0.14314e-04_r8,0.14422e-04_r8,0.14531e-04_r8/) + totplnk(151:181, 2) = (/ & + 0.14639e-04_r8,0.14748e-04_r8,0.14857e-04_r8,0.14967e-04_r8,0.15076e-04_r8, & + 0.15186e-04_r8,0.15296e-04_r8,0.15407e-04_r8,0.15517e-04_r8,0.15628e-04_r8, & + 0.15739e-04_r8,0.15850e-04_r8,0.15961e-04_r8,0.16072e-04_r8,0.16184e-04_r8, & + 0.16296e-04_r8,0.16408e-04_r8,0.16521e-04_r8,0.16633e-04_r8,0.16746e-04_r8, & + 0.16859e-04_r8,0.16972e-04_r8,0.17085e-04_r8,0.17198e-04_r8,0.17312e-04_r8, & + 0.17426e-04_r8,0.17540e-04_r8,0.17654e-04_r8,0.17769e-04_r8,0.17883e-04_r8, & + 0.17998e-04_r8/) + totplnk(1:50, 3) = (/ & + 1.34822e-06_r8,1.39134e-06_r8,1.43530e-06_r8,1.48010e-06_r8,1.52574e-06_r8, & + 1.57222e-06_r8,1.61956e-06_r8,1.66774e-06_r8,1.71678e-06_r8,1.76666e-06_r8, & + 1.81741e-06_r8,1.86901e-06_r8,1.92147e-06_r8,1.97479e-06_r8,2.02898e-06_r8, & + 2.08402e-06_r8,2.13993e-06_r8,2.19671e-06_r8,2.25435e-06_r8,2.31285e-06_r8, & + 2.37222e-06_r8,2.43246e-06_r8,2.49356e-06_r8,2.55553e-06_r8,2.61837e-06_r8, & + 2.68207e-06_r8,2.74664e-06_r8,2.81207e-06_r8,2.87837e-06_r8,2.94554e-06_r8, & + 3.01356e-06_r8,3.08245e-06_r8,3.15221e-06_r8,3.22282e-06_r8,3.29429e-06_r8, & + 3.36662e-06_r8,3.43982e-06_r8,3.51386e-06_r8,3.58876e-06_r8,3.66451e-06_r8, & + 3.74112e-06_r8,3.81857e-06_r8,3.89688e-06_r8,3.97602e-06_r8,4.05601e-06_r8, & + 4.13685e-06_r8,4.21852e-06_r8,4.30104e-06_r8,4.38438e-06_r8,4.46857e-06_r8/) + totplnk(51:100, 3) = (/ & + 4.55358e-06_r8,4.63943e-06_r8,4.72610e-06_r8,4.81359e-06_r8,4.90191e-06_r8, & + 4.99105e-06_r8,5.08100e-06_r8,5.17176e-06_r8,5.26335e-06_r8,5.35573e-06_r8, & + 5.44892e-06_r8,5.54292e-06_r8,5.63772e-06_r8,5.73331e-06_r8,5.82970e-06_r8, & + 5.92688e-06_r8,6.02485e-06_r8,6.12360e-06_r8,6.22314e-06_r8,6.32346e-06_r8, & + 6.42455e-06_r8,6.52641e-06_r8,6.62906e-06_r8,6.73247e-06_r8,6.83664e-06_r8, & + 6.94156e-06_r8,7.04725e-06_r8,7.15370e-06_r8,7.26089e-06_r8,7.36883e-06_r8, & + 7.47752e-06_r8,7.58695e-06_r8,7.69712e-06_r8,7.80801e-06_r8,7.91965e-06_r8, & + 8.03201e-06_r8,8.14510e-06_r8,8.25891e-06_r8,8.37343e-06_r8,8.48867e-06_r8, & + 8.60463e-06_r8,8.72128e-06_r8,8.83865e-06_r8,8.95672e-06_r8,9.07548e-06_r8, & + 9.19495e-06_r8,9.31510e-06_r8,9.43594e-06_r8,9.55745e-06_r8,9.67966e-06_r8/) + totplnk(101:150, 3) = (/ & + 9.80254e-06_r8,9.92609e-06_r8,1.00503e-05_r8,1.01752e-05_r8,1.03008e-05_r8, & + 1.04270e-05_r8,1.05539e-05_r8,1.06814e-05_r8,1.08096e-05_r8,1.09384e-05_r8, & + 1.10679e-05_r8,1.11980e-05_r8,1.13288e-05_r8,1.14601e-05_r8,1.15922e-05_r8, & + 1.17248e-05_r8,1.18581e-05_r8,1.19920e-05_r8,1.21265e-05_r8,1.22616e-05_r8, & + 1.23973e-05_r8,1.25337e-05_r8,1.26706e-05_r8,1.28081e-05_r8,1.29463e-05_r8, & + 1.30850e-05_r8,1.32243e-05_r8,1.33642e-05_r8,1.35047e-05_r8,1.36458e-05_r8, & + 1.37875e-05_r8,1.39297e-05_r8,1.40725e-05_r8,1.42159e-05_r8,1.43598e-05_r8, & + 1.45044e-05_r8,1.46494e-05_r8,1.47950e-05_r8,1.49412e-05_r8,1.50879e-05_r8, & + 1.52352e-05_r8,1.53830e-05_r8,1.55314e-05_r8,1.56803e-05_r8,1.58297e-05_r8, & + 1.59797e-05_r8,1.61302e-05_r8,1.62812e-05_r8,1.64327e-05_r8,1.65848e-05_r8/) + totplnk(151:181, 3) = (/ & + 1.67374e-05_r8,1.68904e-05_r8,1.70441e-05_r8,1.71982e-05_r8,1.73528e-05_r8, & + 1.75079e-05_r8,1.76635e-05_r8,1.78197e-05_r8,1.79763e-05_r8,1.81334e-05_r8, & + 1.82910e-05_r8,1.84491e-05_r8,1.86076e-05_r8,1.87667e-05_r8,1.89262e-05_r8, & + 1.90862e-05_r8,1.92467e-05_r8,1.94076e-05_r8,1.95690e-05_r8,1.97309e-05_r8, & + 1.98932e-05_r8,2.00560e-05_r8,2.02193e-05_r8,2.03830e-05_r8,2.05472e-05_r8, & + 2.07118e-05_r8,2.08768e-05_r8,2.10423e-05_r8,2.12083e-05_r8,2.13747e-05_r8, & + 2.15414e-05_r8/) + totplnk(1:50, 4) = (/ & + 8.90528e-07_r8,9.24222e-07_r8,9.58757e-07_r8,9.94141e-07_r8,1.03038e-06_r8, & + 1.06748e-06_r8,1.10545e-06_r8,1.14430e-06_r8,1.18403e-06_r8,1.22465e-06_r8, & + 1.26618e-06_r8,1.30860e-06_r8,1.35193e-06_r8,1.39619e-06_r8,1.44136e-06_r8, & + 1.48746e-06_r8,1.53449e-06_r8,1.58246e-06_r8,1.63138e-06_r8,1.68124e-06_r8, & + 1.73206e-06_r8,1.78383e-06_r8,1.83657e-06_r8,1.89028e-06_r8,1.94495e-06_r8, & + 2.00060e-06_r8,2.05724e-06_r8,2.11485e-06_r8,2.17344e-06_r8,2.23303e-06_r8, & + 2.29361e-06_r8,2.35519e-06_r8,2.41777e-06_r8,2.48134e-06_r8,2.54592e-06_r8, & + 2.61151e-06_r8,2.67810e-06_r8,2.74571e-06_r8,2.81433e-06_r8,2.88396e-06_r8, & + 2.95461e-06_r8,3.02628e-06_r8,3.09896e-06_r8,3.17267e-06_r8,3.24741e-06_r8, & + 3.32316e-06_r8,3.39994e-06_r8,3.47774e-06_r8,3.55657e-06_r8,3.63642e-06_r8/) + totplnk(51:100, 4) = (/ & + 3.71731e-06_r8,3.79922e-06_r8,3.88216e-06_r8,3.96612e-06_r8,4.05112e-06_r8, & + 4.13714e-06_r8,4.22419e-06_r8,4.31227e-06_r8,4.40137e-06_r8,4.49151e-06_r8, & + 4.58266e-06_r8,4.67485e-06_r8,4.76806e-06_r8,4.86229e-06_r8,4.95754e-06_r8, & + 5.05383e-06_r8,5.15113e-06_r8,5.24946e-06_r8,5.34879e-06_r8,5.44916e-06_r8, & + 5.55053e-06_r8,5.65292e-06_r8,5.75632e-06_r8,5.86073e-06_r8,5.96616e-06_r8, & + 6.07260e-06_r8,6.18003e-06_r8,6.28848e-06_r8,6.39794e-06_r8,6.50838e-06_r8, & + 6.61983e-06_r8,6.73229e-06_r8,6.84573e-06_r8,6.96016e-06_r8,7.07559e-06_r8, & + 7.19200e-06_r8,7.30940e-06_r8,7.42779e-06_r8,7.54715e-06_r8,7.66749e-06_r8, & + 7.78882e-06_r8,7.91110e-06_r8,8.03436e-06_r8,8.15859e-06_r8,8.28379e-06_r8, & + 8.40994e-06_r8,8.53706e-06_r8,8.66515e-06_r8,8.79418e-06_r8,8.92416e-06_r8/) + totplnk(101:150, 4) = (/ & + 9.05510e-06_r8,9.18697e-06_r8,9.31979e-06_r8,9.45356e-06_r8,9.58826e-06_r8, & + 9.72389e-06_r8,9.86046e-06_r8,9.99793e-06_r8,1.01364e-05_r8,1.02757e-05_r8, & + 1.04159e-05_r8,1.05571e-05_r8,1.06992e-05_r8,1.08422e-05_r8,1.09861e-05_r8, & + 1.11309e-05_r8,1.12766e-05_r8,1.14232e-05_r8,1.15707e-05_r8,1.17190e-05_r8, & + 1.18683e-05_r8,1.20184e-05_r8,1.21695e-05_r8,1.23214e-05_r8,1.24741e-05_r8, & + 1.26277e-05_r8,1.27822e-05_r8,1.29376e-05_r8,1.30939e-05_r8,1.32509e-05_r8, & + 1.34088e-05_r8,1.35676e-05_r8,1.37273e-05_r8,1.38877e-05_r8,1.40490e-05_r8, & + 1.42112e-05_r8,1.43742e-05_r8,1.45380e-05_r8,1.47026e-05_r8,1.48680e-05_r8, & + 1.50343e-05_r8,1.52014e-05_r8,1.53692e-05_r8,1.55379e-05_r8,1.57074e-05_r8, & + 1.58778e-05_r8,1.60488e-05_r8,1.62207e-05_r8,1.63934e-05_r8,1.65669e-05_r8/) + totplnk(151:181, 4) = (/ & + 1.67411e-05_r8,1.69162e-05_r8,1.70920e-05_r8,1.72685e-05_r8,1.74459e-05_r8, & + 1.76240e-05_r8,1.78029e-05_r8,1.79825e-05_r8,1.81629e-05_r8,1.83440e-05_r8, & + 1.85259e-05_r8,1.87086e-05_r8,1.88919e-05_r8,1.90760e-05_r8,1.92609e-05_r8, & + 1.94465e-05_r8,1.96327e-05_r8,1.98199e-05_r8,2.00076e-05_r8,2.01961e-05_r8, & + 2.03853e-05_r8,2.05752e-05_r8,2.07658e-05_r8,2.09571e-05_r8,2.11491e-05_r8, & + 2.13418e-05_r8,2.15352e-05_r8,2.17294e-05_r8,2.19241e-05_r8,2.21196e-05_r8, & + 2.23158e-05_r8/) + totplnk(1:50, 5) = (/ & + 5.70230e-07_r8,5.94788e-07_r8,6.20085e-07_r8,6.46130e-07_r8,6.72936e-07_r8, & + 7.00512e-07_r8,7.28869e-07_r8,7.58019e-07_r8,7.87971e-07_r8,8.18734e-07_r8, & + 8.50320e-07_r8,8.82738e-07_r8,9.15999e-07_r8,9.50110e-07_r8,9.85084e-07_r8, & + 1.02093e-06_r8,1.05765e-06_r8,1.09527e-06_r8,1.13378e-06_r8,1.17320e-06_r8, & + 1.21353e-06_r8,1.25479e-06_r8,1.29698e-06_r8,1.34011e-06_r8,1.38419e-06_r8, & + 1.42923e-06_r8,1.47523e-06_r8,1.52221e-06_r8,1.57016e-06_r8,1.61910e-06_r8, & + 1.66904e-06_r8,1.71997e-06_r8,1.77192e-06_r8,1.82488e-06_r8,1.87886e-06_r8, & + 1.93387e-06_r8,1.98991e-06_r8,2.04699e-06_r8,2.10512e-06_r8,2.16430e-06_r8, & + 2.22454e-06_r8,2.28584e-06_r8,2.34821e-06_r8,2.41166e-06_r8,2.47618e-06_r8, & + 2.54178e-06_r8,2.60847e-06_r8,2.67626e-06_r8,2.74514e-06_r8,2.81512e-06_r8/) + totplnk(51:100, 5) = (/ & + 2.88621e-06_r8,2.95841e-06_r8,3.03172e-06_r8,3.10615e-06_r8,3.18170e-06_r8, & + 3.25838e-06_r8,3.33618e-06_r8,3.41511e-06_r8,3.49518e-06_r8,3.57639e-06_r8, & + 3.65873e-06_r8,3.74221e-06_r8,3.82684e-06_r8,3.91262e-06_r8,3.99955e-06_r8, & + 4.08763e-06_r8,4.17686e-06_r8,4.26725e-06_r8,4.35880e-06_r8,4.45150e-06_r8, & + 4.54537e-06_r8,4.64039e-06_r8,4.73659e-06_r8,4.83394e-06_r8,4.93246e-06_r8, & + 5.03215e-06_r8,5.13301e-06_r8,5.23504e-06_r8,5.33823e-06_r8,5.44260e-06_r8, & + 5.54814e-06_r8,5.65484e-06_r8,5.76272e-06_r8,5.87177e-06_r8,5.98199e-06_r8, & + 6.09339e-06_r8,6.20596e-06_r8,6.31969e-06_r8,6.43460e-06_r8,6.55068e-06_r8, & + 6.66793e-06_r8,6.78636e-06_r8,6.90595e-06_r8,7.02670e-06_r8,7.14863e-06_r8, & + 7.27173e-06_r8,7.39599e-06_r8,7.52142e-06_r8,7.64802e-06_r8,7.77577e-06_r8/) + totplnk(101:150, 5) = (/ & + 7.90469e-06_r8,8.03477e-06_r8,8.16601e-06_r8,8.29841e-06_r8,8.43198e-06_r8, & + 8.56669e-06_r8,8.70256e-06_r8,8.83957e-06_r8,8.97775e-06_r8,9.11706e-06_r8, & + 9.25753e-06_r8,9.39915e-06_r8,9.54190e-06_r8,9.68580e-06_r8,9.83085e-06_r8, & + 9.97704e-06_r8,1.01243e-05_r8,1.02728e-05_r8,1.04224e-05_r8,1.05731e-05_r8, & + 1.07249e-05_r8,1.08779e-05_r8,1.10320e-05_r8,1.11872e-05_r8,1.13435e-05_r8, & + 1.15009e-05_r8,1.16595e-05_r8,1.18191e-05_r8,1.19799e-05_r8,1.21418e-05_r8, & + 1.23048e-05_r8,1.24688e-05_r8,1.26340e-05_r8,1.28003e-05_r8,1.29676e-05_r8, & + 1.31361e-05_r8,1.33056e-05_r8,1.34762e-05_r8,1.36479e-05_r8,1.38207e-05_r8, & + 1.39945e-05_r8,1.41694e-05_r8,1.43454e-05_r8,1.45225e-05_r8,1.47006e-05_r8, & + 1.48797e-05_r8,1.50600e-05_r8,1.52413e-05_r8,1.54236e-05_r8,1.56070e-05_r8/) + totplnk(151:181, 5) = (/ & + 1.57914e-05_r8,1.59768e-05_r8,1.61633e-05_r8,1.63509e-05_r8,1.65394e-05_r8, & + 1.67290e-05_r8,1.69197e-05_r8,1.71113e-05_r8,1.73040e-05_r8,1.74976e-05_r8, & + 1.76923e-05_r8,1.78880e-05_r8,1.80847e-05_r8,1.82824e-05_r8,1.84811e-05_r8, & + 1.86808e-05_r8,1.88814e-05_r8,1.90831e-05_r8,1.92857e-05_r8,1.94894e-05_r8, & + 1.96940e-05_r8,1.98996e-05_r8,2.01061e-05_r8,2.03136e-05_r8,2.05221e-05_r8, & + 2.07316e-05_r8,2.09420e-05_r8,2.11533e-05_r8,2.13657e-05_r8,2.15789e-05_r8, & + 2.17931e-05_r8/) + totplnk(1:50, 6) = (/ & + 2.73493e-07_r8,2.87408e-07_r8,3.01848e-07_r8,3.16825e-07_r8,3.32352e-07_r8, & + 3.48439e-07_r8,3.65100e-07_r8,3.82346e-07_r8,4.00189e-07_r8,4.18641e-07_r8, & + 4.37715e-07_r8,4.57422e-07_r8,4.77774e-07_r8,4.98784e-07_r8,5.20464e-07_r8, & + 5.42824e-07_r8,5.65879e-07_r8,5.89638e-07_r8,6.14115e-07_r8,6.39320e-07_r8, & + 6.65266e-07_r8,6.91965e-07_r8,7.19427e-07_r8,7.47666e-07_r8,7.76691e-07_r8, & + 8.06516e-07_r8,8.37151e-07_r8,8.68607e-07_r8,9.00896e-07_r8,9.34029e-07_r8, & + 9.68018e-07_r8,1.00287e-06_r8,1.03860e-06_r8,1.07522e-06_r8,1.11274e-06_r8, & + 1.15117e-06_r8,1.19052e-06_r8,1.23079e-06_r8,1.27201e-06_r8,1.31418e-06_r8, & + 1.35731e-06_r8,1.40141e-06_r8,1.44650e-06_r8,1.49257e-06_r8,1.53965e-06_r8, & + 1.58773e-06_r8,1.63684e-06_r8,1.68697e-06_r8,1.73815e-06_r8,1.79037e-06_r8/) + totplnk(51:100, 6) = (/ & + 1.84365e-06_r8,1.89799e-06_r8,1.95341e-06_r8,2.00991e-06_r8,2.06750e-06_r8, & + 2.12619e-06_r8,2.18599e-06_r8,2.24691e-06_r8,2.30895e-06_r8,2.37212e-06_r8, & + 2.43643e-06_r8,2.50189e-06_r8,2.56851e-06_r8,2.63628e-06_r8,2.70523e-06_r8, & + 2.77536e-06_r8,2.84666e-06_r8,2.91916e-06_r8,2.99286e-06_r8,3.06776e-06_r8, & + 3.14387e-06_r8,3.22120e-06_r8,3.29975e-06_r8,3.37953e-06_r8,3.46054e-06_r8, & + 3.54280e-06_r8,3.62630e-06_r8,3.71105e-06_r8,3.79707e-06_r8,3.88434e-06_r8, & + 3.97288e-06_r8,4.06270e-06_r8,4.15380e-06_r8,4.24617e-06_r8,4.33984e-06_r8, & + 4.43479e-06_r8,4.53104e-06_r8,4.62860e-06_r8,4.72746e-06_r8,4.82763e-06_r8, & + 4.92911e-06_r8,5.03191e-06_r8,5.13603e-06_r8,5.24147e-06_r8,5.34824e-06_r8, & + 5.45634e-06_r8,5.56578e-06_r8,5.67656e-06_r8,5.78867e-06_r8,5.90213e-06_r8/) + totplnk(101:150, 6) = (/ & + 6.01694e-06_r8,6.13309e-06_r8,6.25060e-06_r8,6.36947e-06_r8,6.48968e-06_r8, & + 6.61126e-06_r8,6.73420e-06_r8,6.85850e-06_r8,6.98417e-06_r8,7.11120e-06_r8, & + 7.23961e-06_r8,7.36938e-06_r8,7.50053e-06_r8,7.63305e-06_r8,7.76694e-06_r8, & + 7.90221e-06_r8,8.03887e-06_r8,8.17690e-06_r8,8.31632e-06_r8,8.45710e-06_r8, & + 8.59928e-06_r8,8.74282e-06_r8,8.88776e-06_r8,9.03409e-06_r8,9.18179e-06_r8, & + 9.33088e-06_r8,9.48136e-06_r8,9.63323e-06_r8,9.78648e-06_r8,9.94111e-06_r8, & + 1.00971e-05_r8,1.02545e-05_r8,1.04133e-05_r8,1.05735e-05_r8,1.07351e-05_r8, & + 1.08980e-05_r8,1.10624e-05_r8,1.12281e-05_r8,1.13952e-05_r8,1.15637e-05_r8, & + 1.17335e-05_r8,1.19048e-05_r8,1.20774e-05_r8,1.22514e-05_r8,1.24268e-05_r8, & + 1.26036e-05_r8,1.27817e-05_r8,1.29612e-05_r8,1.31421e-05_r8,1.33244e-05_r8/) + totplnk(151:181, 6) = (/ & + 1.35080e-05_r8,1.36930e-05_r8,1.38794e-05_r8,1.40672e-05_r8,1.42563e-05_r8, & + 1.44468e-05_r8,1.46386e-05_r8,1.48318e-05_r8,1.50264e-05_r8,1.52223e-05_r8, & + 1.54196e-05_r8,1.56182e-05_r8,1.58182e-05_r8,1.60196e-05_r8,1.62223e-05_r8, & + 1.64263e-05_r8,1.66317e-05_r8,1.68384e-05_r8,1.70465e-05_r8,1.72559e-05_r8, & + 1.74666e-05_r8,1.76787e-05_r8,1.78921e-05_r8,1.81069e-05_r8,1.83230e-05_r8, & + 1.85404e-05_r8,1.87591e-05_r8,1.89791e-05_r8,1.92005e-05_r8,1.94232e-05_r8, & + 1.96471e-05_r8/) + totplnk(1:50, 7) = (/ & + 1.25349e-07_r8,1.32735e-07_r8,1.40458e-07_r8,1.48527e-07_r8,1.56954e-07_r8, & + 1.65748e-07_r8,1.74920e-07_r8,1.84481e-07_r8,1.94443e-07_r8,2.04814e-07_r8, & + 2.15608e-07_r8,2.26835e-07_r8,2.38507e-07_r8,2.50634e-07_r8,2.63229e-07_r8, & + 2.76301e-07_r8,2.89864e-07_r8,3.03930e-07_r8,3.18508e-07_r8,3.33612e-07_r8, & + 3.49253e-07_r8,3.65443e-07_r8,3.82195e-07_r8,3.99519e-07_r8,4.17428e-07_r8, & + 4.35934e-07_r8,4.55050e-07_r8,4.74785e-07_r8,4.95155e-07_r8,5.16170e-07_r8, & + 5.37844e-07_r8,5.60186e-07_r8,5.83211e-07_r8,6.06929e-07_r8,6.31355e-07_r8, & + 6.56498e-07_r8,6.82373e-07_r8,7.08990e-07_r8,7.36362e-07_r8,7.64501e-07_r8, & + 7.93420e-07_r8,8.23130e-07_r8,8.53643e-07_r8,8.84971e-07_r8,9.17128e-07_r8, & + 9.50123e-07_r8,9.83969e-07_r8,1.01868e-06_r8,1.05426e-06_r8,1.09073e-06_r8/) + totplnk(51:100, 7) = (/ & + 1.12810e-06_r8,1.16638e-06_r8,1.20558e-06_r8,1.24572e-06_r8,1.28680e-06_r8, & + 1.32883e-06_r8,1.37183e-06_r8,1.41581e-06_r8,1.46078e-06_r8,1.50675e-06_r8, & + 1.55374e-06_r8,1.60174e-06_r8,1.65078e-06_r8,1.70087e-06_r8,1.75200e-06_r8, & + 1.80421e-06_r8,1.85749e-06_r8,1.91186e-06_r8,1.96732e-06_r8,2.02389e-06_r8, & + 2.08159e-06_r8,2.14040e-06_r8,2.20035e-06_r8,2.26146e-06_r8,2.32372e-06_r8, & + 2.38714e-06_r8,2.45174e-06_r8,2.51753e-06_r8,2.58451e-06_r8,2.65270e-06_r8, & + 2.72210e-06_r8,2.79272e-06_r8,2.86457e-06_r8,2.93767e-06_r8,3.01201e-06_r8, & + 3.08761e-06_r8,3.16448e-06_r8,3.24261e-06_r8,3.32204e-06_r8,3.40275e-06_r8, & + 3.48476e-06_r8,3.56808e-06_r8,3.65271e-06_r8,3.73866e-06_r8,3.82595e-06_r8, & + 3.91456e-06_r8,4.00453e-06_r8,4.09584e-06_r8,4.18851e-06_r8,4.28254e-06_r8/) + totplnk(101:150, 7) = (/ & + 4.37796e-06_r8,4.47475e-06_r8,4.57293e-06_r8,4.67249e-06_r8,4.77346e-06_r8, & + 4.87583e-06_r8,4.97961e-06_r8,5.08481e-06_r8,5.19143e-06_r8,5.29948e-06_r8, & + 5.40896e-06_r8,5.51989e-06_r8,5.63226e-06_r8,5.74608e-06_r8,5.86136e-06_r8, & + 5.97810e-06_r8,6.09631e-06_r8,6.21597e-06_r8,6.33713e-06_r8,6.45976e-06_r8, & + 6.58388e-06_r8,6.70950e-06_r8,6.83661e-06_r8,6.96521e-06_r8,7.09531e-06_r8, & + 7.22692e-06_r8,7.36005e-06_r8,7.49468e-06_r8,7.63084e-06_r8,7.76851e-06_r8, & + 7.90773e-06_r8,8.04846e-06_r8,8.19072e-06_r8,8.33452e-06_r8,8.47985e-06_r8, & + 8.62674e-06_r8,8.77517e-06_r8,8.92514e-06_r8,9.07666e-06_r8,9.22975e-06_r8, & + 9.38437e-06_r8,9.54057e-06_r8,9.69832e-06_r8,9.85762e-06_r8,1.00185e-05_r8, & + 1.01810e-05_r8,1.03450e-05_r8,1.05106e-05_r8,1.06777e-05_r8,1.08465e-05_r8/) + totplnk(151:181, 7) = (/ & + 1.10168e-05_r8,1.11887e-05_r8,1.13621e-05_r8,1.15372e-05_r8,1.17138e-05_r8, & + 1.18920e-05_r8,1.20718e-05_r8,1.22532e-05_r8,1.24362e-05_r8,1.26207e-05_r8, & + 1.28069e-05_r8,1.29946e-05_r8,1.31839e-05_r8,1.33749e-05_r8,1.35674e-05_r8, & + 1.37615e-05_r8,1.39572e-05_r8,1.41544e-05_r8,1.43533e-05_r8,1.45538e-05_r8, & + 1.47558e-05_r8,1.49595e-05_r8,1.51647e-05_r8,1.53716e-05_r8,1.55800e-05_r8, & + 1.57900e-05_r8,1.60017e-05_r8,1.62149e-05_r8,1.64296e-05_r8,1.66460e-05_r8, & + 1.68640e-05_r8/) + totplnk(1:50, 8) = (/ & + 6.74445e-08_r8,7.18176e-08_r8,7.64153e-08_r8,8.12456e-08_r8,8.63170e-08_r8, & + 9.16378e-08_r8,9.72168e-08_r8,1.03063e-07_r8,1.09184e-07_r8,1.15591e-07_r8, & + 1.22292e-07_r8,1.29296e-07_r8,1.36613e-07_r8,1.44253e-07_r8,1.52226e-07_r8, & + 1.60540e-07_r8,1.69207e-07_r8,1.78236e-07_r8,1.87637e-07_r8,1.97421e-07_r8, & + 2.07599e-07_r8,2.18181e-07_r8,2.29177e-07_r8,2.40598e-07_r8,2.52456e-07_r8, & + 2.64761e-07_r8,2.77523e-07_r8,2.90755e-07_r8,3.04468e-07_r8,3.18673e-07_r8, & + 3.33381e-07_r8,3.48603e-07_r8,3.64352e-07_r8,3.80638e-07_r8,3.97474e-07_r8, & + 4.14871e-07_r8,4.32841e-07_r8,4.51395e-07_r8,4.70547e-07_r8,4.90306e-07_r8, & + 5.10687e-07_r8,5.31699e-07_r8,5.53357e-07_r8,5.75670e-07_r8,5.98652e-07_r8, & + 6.22315e-07_r8,6.46672e-07_r8,6.71731e-07_r8,6.97511e-07_r8,7.24018e-07_r8/) + totplnk(51:100, 8) = (/ & + 7.51266e-07_r8,7.79269e-07_r8,8.08038e-07_r8,8.37584e-07_r8,8.67922e-07_r8, & + 8.99061e-07_r8,9.31016e-07_r8,9.63797e-07_r8,9.97417e-07_r8,1.03189e-06_r8, & + 1.06722e-06_r8,1.10343e-06_r8,1.14053e-06_r8,1.17853e-06_r8,1.21743e-06_r8, & + 1.25726e-06_r8,1.29803e-06_r8,1.33974e-06_r8,1.38241e-06_r8,1.42606e-06_r8, & + 1.47068e-06_r8,1.51630e-06_r8,1.56293e-06_r8,1.61056e-06_r8,1.65924e-06_r8, & + 1.70894e-06_r8,1.75971e-06_r8,1.81153e-06_r8,1.86443e-06_r8,1.91841e-06_r8, & + 1.97350e-06_r8,2.02968e-06_r8,2.08699e-06_r8,2.14543e-06_r8,2.20500e-06_r8, & + 2.26573e-06_r8,2.32762e-06_r8,2.39068e-06_r8,2.45492e-06_r8,2.52036e-06_r8, & + 2.58700e-06_r8,2.65485e-06_r8,2.72393e-06_r8,2.79424e-06_r8,2.86580e-06_r8, & + 2.93861e-06_r8,3.01269e-06_r8,3.08803e-06_r8,3.16467e-06_r8,3.24259e-06_r8/) + totplnk(101:150, 8) = (/ & + 3.32181e-06_r8,3.40235e-06_r8,3.48420e-06_r8,3.56739e-06_r8,3.65192e-06_r8, & + 3.73779e-06_r8,3.82502e-06_r8,3.91362e-06_r8,4.00359e-06_r8,4.09494e-06_r8, & + 4.18768e-06_r8,4.28182e-06_r8,4.37737e-06_r8,4.47434e-06_r8,4.57273e-06_r8, & + 4.67254e-06_r8,4.77380e-06_r8,4.87651e-06_r8,4.98067e-06_r8,5.08630e-06_r8, & + 5.19339e-06_r8,5.30196e-06_r8,5.41201e-06_r8,5.52356e-06_r8,5.63660e-06_r8, & + 5.75116e-06_r8,5.86722e-06_r8,5.98479e-06_r8,6.10390e-06_r8,6.22453e-06_r8, & + 6.34669e-06_r8,6.47042e-06_r8,6.59569e-06_r8,6.72252e-06_r8,6.85090e-06_r8, & + 6.98085e-06_r8,7.11238e-06_r8,7.24549e-06_r8,7.38019e-06_r8,7.51646e-06_r8, & + 7.65434e-06_r8,7.79382e-06_r8,7.93490e-06_r8,8.07760e-06_r8,8.22192e-06_r8, & + 8.36784e-06_r8,8.51540e-06_r8,8.66459e-06_r8,8.81542e-06_r8,8.96786e-06_r8/) + totplnk(151:181, 8) = (/ & + 9.12197e-06_r8,9.27772e-06_r8,9.43513e-06_r8,9.59419e-06_r8,9.75490e-06_r8, & + 9.91728e-06_r8,1.00813e-05_r8,1.02471e-05_r8,1.04144e-05_r8,1.05835e-05_r8, & + 1.07543e-05_r8,1.09267e-05_r8,1.11008e-05_r8,1.12766e-05_r8,1.14541e-05_r8, & + 1.16333e-05_r8,1.18142e-05_r8,1.19969e-05_r8,1.21812e-05_r8,1.23672e-05_r8, & + 1.25549e-05_r8,1.27443e-05_r8,1.29355e-05_r8,1.31284e-05_r8,1.33229e-05_r8, & + 1.35193e-05_r8,1.37173e-05_r8,1.39170e-05_r8,1.41185e-05_r8,1.43217e-05_r8, & + 1.45267e-05_r8/) + totplnk(1:50, 9) = (/ & + 2.61522e-08_r8,2.80613e-08_r8,3.00838e-08_r8,3.22250e-08_r8,3.44899e-08_r8, & + 3.68841e-08_r8,3.94129e-08_r8,4.20820e-08_r8,4.48973e-08_r8,4.78646e-08_r8, & + 5.09901e-08_r8,5.42799e-08_r8,5.77405e-08_r8,6.13784e-08_r8,6.52001e-08_r8, & + 6.92126e-08_r8,7.34227e-08_r8,7.78375e-08_r8,8.24643e-08_r8,8.73103e-08_r8, & + 9.23832e-08_r8,9.76905e-08_r8,1.03240e-07_r8,1.09039e-07_r8,1.15097e-07_r8, & + 1.21421e-07_r8,1.28020e-07_r8,1.34902e-07_r8,1.42075e-07_r8,1.49548e-07_r8, & + 1.57331e-07_r8,1.65432e-07_r8,1.73860e-07_r8,1.82624e-07_r8,1.91734e-07_r8, & + 2.01198e-07_r8,2.11028e-07_r8,2.21231e-07_r8,2.31818e-07_r8,2.42799e-07_r8, & + 2.54184e-07_r8,2.65983e-07_r8,2.78205e-07_r8,2.90862e-07_r8,3.03963e-07_r8, & + 3.17519e-07_r8,3.31541e-07_r8,3.46039e-07_r8,3.61024e-07_r8,3.76507e-07_r8/) + totplnk(51:100, 9) = (/ & + 3.92498e-07_r8,4.09008e-07_r8,4.26050e-07_r8,4.43633e-07_r8,4.61769e-07_r8, & + 4.80469e-07_r8,4.99744e-07_r8,5.19606e-07_r8,5.40067e-07_r8,5.61136e-07_r8, & + 5.82828e-07_r8,6.05152e-07_r8,6.28120e-07_r8,6.51745e-07_r8,6.76038e-07_r8, & + 7.01010e-07_r8,7.26674e-07_r8,7.53041e-07_r8,7.80124e-07_r8,8.07933e-07_r8, & + 8.36482e-07_r8,8.65781e-07_r8,8.95845e-07_r8,9.26683e-07_r8,9.58308e-07_r8, & + 9.90732e-07_r8,1.02397e-06_r8,1.05803e-06_r8,1.09292e-06_r8,1.12866e-06_r8, & + 1.16526e-06_r8,1.20274e-06_r8,1.24109e-06_r8,1.28034e-06_r8,1.32050e-06_r8, & + 1.36158e-06_r8,1.40359e-06_r8,1.44655e-06_r8,1.49046e-06_r8,1.53534e-06_r8, & + 1.58120e-06_r8,1.62805e-06_r8,1.67591e-06_r8,1.72478e-06_r8,1.77468e-06_r8, & + 1.82561e-06_r8,1.87760e-06_r8,1.93066e-06_r8,1.98479e-06_r8,2.04000e-06_r8/) + totplnk(101:150, 9) = (/ & + 2.09631e-06_r8,2.15373e-06_r8,2.21228e-06_r8,2.27196e-06_r8,2.33278e-06_r8, & + 2.39475e-06_r8,2.45790e-06_r8,2.52222e-06_r8,2.58773e-06_r8,2.65445e-06_r8, & + 2.72238e-06_r8,2.79152e-06_r8,2.86191e-06_r8,2.93354e-06_r8,3.00643e-06_r8, & + 3.08058e-06_r8,3.15601e-06_r8,3.23273e-06_r8,3.31075e-06_r8,3.39009e-06_r8, & + 3.47074e-06_r8,3.55272e-06_r8,3.63605e-06_r8,3.72072e-06_r8,3.80676e-06_r8, & + 3.89417e-06_r8,3.98297e-06_r8,4.07315e-06_r8,4.16474e-06_r8,4.25774e-06_r8, & + 4.35217e-06_r8,4.44802e-06_r8,4.54532e-06_r8,4.64406e-06_r8,4.74428e-06_r8, & + 4.84595e-06_r8,4.94911e-06_r8,5.05376e-06_r8,5.15990e-06_r8,5.26755e-06_r8, & + 5.37671e-06_r8,5.48741e-06_r8,5.59963e-06_r8,5.71340e-06_r8,5.82871e-06_r8, & + 5.94559e-06_r8,6.06403e-06_r8,6.18404e-06_r8,6.30565e-06_r8,6.42885e-06_r8/) + totplnk(151:181, 9) = (/ & + 6.55364e-06_r8,6.68004e-06_r8,6.80806e-06_r8,6.93771e-06_r8,7.06898e-06_r8, & + 7.20190e-06_r8,7.33646e-06_r8,7.47267e-06_r8,7.61056e-06_r8,7.75010e-06_r8, & + 7.89133e-06_r8,8.03423e-06_r8,8.17884e-06_r8,8.32514e-06_r8,8.47314e-06_r8, & + 8.62284e-06_r8,8.77427e-06_r8,8.92743e-06_r8,9.08231e-06_r8,9.23893e-06_r8, & + 9.39729e-06_r8,9.55741e-06_r8,9.71927e-06_r8,9.88291e-06_r8,1.00483e-05_r8, & + 1.02155e-05_r8,1.03844e-05_r8,1.05552e-05_r8,1.07277e-05_r8,1.09020e-05_r8, & + 1.10781e-05_r8/) + totplnk(1:50,10) = (/ & + 8.89300e-09_r8,9.63263e-09_r8,1.04235e-08_r8,1.12685e-08_r8,1.21703e-08_r8, & + 1.31321e-08_r8,1.41570e-08_r8,1.52482e-08_r8,1.64090e-08_r8,1.76428e-08_r8, & + 1.89533e-08_r8,2.03441e-08_r8,2.18190e-08_r8,2.33820e-08_r8,2.50370e-08_r8, & + 2.67884e-08_r8,2.86402e-08_r8,3.05969e-08_r8,3.26632e-08_r8,3.48436e-08_r8, & + 3.71429e-08_r8,3.95660e-08_r8,4.21179e-08_r8,4.48040e-08_r8,4.76294e-08_r8, & + 5.05996e-08_r8,5.37201e-08_r8,5.69966e-08_r8,6.04349e-08_r8,6.40411e-08_r8, & + 6.78211e-08_r8,7.17812e-08_r8,7.59276e-08_r8,8.02670e-08_r8,8.48059e-08_r8, & + 8.95508e-08_r8,9.45090e-08_r8,9.96873e-08_r8,1.05093e-07_r8,1.10733e-07_r8, & + 1.16614e-07_r8,1.22745e-07_r8,1.29133e-07_r8,1.35786e-07_r8,1.42711e-07_r8, & + 1.49916e-07_r8,1.57410e-07_r8,1.65202e-07_r8,1.73298e-07_r8,1.81709e-07_r8/) + totplnk(51:100,10) = (/ & + 1.90441e-07_r8,1.99505e-07_r8,2.08908e-07_r8,2.18660e-07_r8,2.28770e-07_r8, & + 2.39247e-07_r8,2.50101e-07_r8,2.61340e-07_r8,2.72974e-07_r8,2.85013e-07_r8, & + 2.97467e-07_r8,3.10345e-07_r8,3.23657e-07_r8,3.37413e-07_r8,3.51623e-07_r8, & + 3.66298e-07_r8,3.81448e-07_r8,3.97082e-07_r8,4.13212e-07_r8,4.29848e-07_r8, & + 4.47000e-07_r8,4.64680e-07_r8,4.82898e-07_r8,5.01664e-07_r8,5.20991e-07_r8, & + 5.40888e-07_r8,5.61369e-07_r8,5.82440e-07_r8,6.04118e-07_r8,6.26410e-07_r8, & + 6.49329e-07_r8,6.72887e-07_r8,6.97095e-07_r8,7.21964e-07_r8,7.47506e-07_r8, & + 7.73732e-07_r8,8.00655e-07_r8,8.28287e-07_r8,8.56635e-07_r8,8.85717e-07_r8, & + 9.15542e-07_r8,9.46122e-07_r8,9.77469e-07_r8,1.00960e-06_r8,1.04251e-06_r8, & + 1.07623e-06_r8,1.11077e-06_r8,1.14613e-06_r8,1.18233e-06_r8,1.21939e-06_r8/) + totplnk(101:150,10) = (/ & + 1.25730e-06_r8,1.29610e-06_r8,1.33578e-06_r8,1.37636e-06_r8,1.41785e-06_r8, & + 1.46027e-06_r8,1.50362e-06_r8,1.54792e-06_r8,1.59319e-06_r8,1.63942e-06_r8, & + 1.68665e-06_r8,1.73487e-06_r8,1.78410e-06_r8,1.83435e-06_r8,1.88564e-06_r8, & + 1.93797e-06_r8,1.99136e-06_r8,2.04582e-06_r8,2.10137e-06_r8,2.15801e-06_r8, & + 2.21576e-06_r8,2.27463e-06_r8,2.33462e-06_r8,2.39577e-06_r8,2.45806e-06_r8, & + 2.52153e-06_r8,2.58617e-06_r8,2.65201e-06_r8,2.71905e-06_r8,2.78730e-06_r8, & + 2.85678e-06_r8,2.92749e-06_r8,2.99946e-06_r8,3.07269e-06_r8,3.14720e-06_r8, & + 3.22299e-06_r8,3.30007e-06_r8,3.37847e-06_r8,3.45818e-06_r8,3.53923e-06_r8, & + 3.62161e-06_r8,3.70535e-06_r8,3.79046e-06_r8,3.87695e-06_r8,3.96481e-06_r8, & + 4.05409e-06_r8,4.14477e-06_r8,4.23687e-06_r8,4.33040e-06_r8,4.42538e-06_r8/) + totplnk(151:181,10) = (/ & + 4.52180e-06_r8,4.61969e-06_r8,4.71905e-06_r8,4.81991e-06_r8,4.92226e-06_r8, & + 5.02611e-06_r8,5.13148e-06_r8,5.23839e-06_r8,5.34681e-06_r8,5.45681e-06_r8, & + 5.56835e-06_r8,5.68146e-06_r8,5.79614e-06_r8,5.91242e-06_r8,6.03030e-06_r8, & + 6.14978e-06_r8,6.27088e-06_r8,6.39360e-06_r8,6.51798e-06_r8,6.64398e-06_r8, & + 6.77165e-06_r8,6.90099e-06_r8,7.03198e-06_r8,7.16468e-06_r8,7.29906e-06_r8, & + 7.43514e-06_r8,7.57294e-06_r8,7.71244e-06_r8,7.85369e-06_r8,7.99666e-06_r8, & + 8.14138e-06_r8/) + totplnk(1:50,11) = (/ & + 2.53767e-09_r8,2.77242e-09_r8,3.02564e-09_r8,3.29851e-09_r8,3.59228e-09_r8, & + 3.90825e-09_r8,4.24777e-09_r8,4.61227e-09_r8,5.00322e-09_r8,5.42219e-09_r8, & + 5.87080e-09_r8,6.35072e-09_r8,6.86370e-09_r8,7.41159e-09_r8,7.99628e-09_r8, & + 8.61974e-09_r8,9.28404e-09_r8,9.99130e-09_r8,1.07437e-08_r8,1.15436e-08_r8, & + 1.23933e-08_r8,1.32953e-08_r8,1.42522e-08_r8,1.52665e-08_r8,1.63410e-08_r8, & + 1.74786e-08_r8,1.86820e-08_r8,1.99542e-08_r8,2.12985e-08_r8,2.27179e-08_r8, & + 2.42158e-08_r8,2.57954e-08_r8,2.74604e-08_r8,2.92141e-08_r8,3.10604e-08_r8, & + 3.30029e-08_r8,3.50457e-08_r8,3.71925e-08_r8,3.94476e-08_r8,4.18149e-08_r8, & + 4.42991e-08_r8,4.69043e-08_r8,4.96352e-08_r8,5.24961e-08_r8,5.54921e-08_r8, & + 5.86277e-08_r8,6.19081e-08_r8,6.53381e-08_r8,6.89231e-08_r8,7.26681e-08_r8/) + totplnk(51:100,11) = (/ & + 7.65788e-08_r8,8.06604e-08_r8,8.49187e-08_r8,8.93591e-08_r8,9.39879e-08_r8, & + 9.88106e-08_r8,1.03834e-07_r8,1.09063e-07_r8,1.14504e-07_r8,1.20165e-07_r8, & + 1.26051e-07_r8,1.32169e-07_r8,1.38525e-07_r8,1.45128e-07_r8,1.51982e-07_r8, & + 1.59096e-07_r8,1.66477e-07_r8,1.74132e-07_r8,1.82068e-07_r8,1.90292e-07_r8, & + 1.98813e-07_r8,2.07638e-07_r8,2.16775e-07_r8,2.26231e-07_r8,2.36015e-07_r8, & + 2.46135e-07_r8,2.56599e-07_r8,2.67415e-07_r8,2.78592e-07_r8,2.90137e-07_r8, & + 3.02061e-07_r8,3.14371e-07_r8,3.27077e-07_r8,3.40186e-07_r8,3.53710e-07_r8, & + 3.67655e-07_r8,3.82031e-07_r8,3.96848e-07_r8,4.12116e-07_r8,4.27842e-07_r8, & + 4.44039e-07_r8,4.60713e-07_r8,4.77876e-07_r8,4.95537e-07_r8,5.13706e-07_r8, & + 5.32392e-07_r8,5.51608e-07_r8,5.71360e-07_r8,5.91662e-07_r8,6.12521e-07_r8/) + totplnk(101:150,11) = (/ & + 6.33950e-07_r8,6.55958e-07_r8,6.78556e-07_r8,7.01753e-07_r8,7.25562e-07_r8, & + 7.49992e-07_r8,7.75055e-07_r8,8.00760e-07_r8,8.27120e-07_r8,8.54145e-07_r8, & + 8.81845e-07_r8,9.10233e-07_r8,9.39318e-07_r8,9.69113e-07_r8,9.99627e-07_r8, & + 1.03087e-06_r8,1.06286e-06_r8,1.09561e-06_r8,1.12912e-06_r8,1.16340e-06_r8, & + 1.19848e-06_r8,1.23435e-06_r8,1.27104e-06_r8,1.30855e-06_r8,1.34690e-06_r8, & + 1.38609e-06_r8,1.42614e-06_r8,1.46706e-06_r8,1.50886e-06_r8,1.55155e-06_r8, & + 1.59515e-06_r8,1.63967e-06_r8,1.68512e-06_r8,1.73150e-06_r8,1.77884e-06_r8, & + 1.82715e-06_r8,1.87643e-06_r8,1.92670e-06_r8,1.97797e-06_r8,2.03026e-06_r8, & + 2.08356e-06_r8,2.13791e-06_r8,2.19330e-06_r8,2.24975e-06_r8,2.30728e-06_r8, & + 2.36589e-06_r8,2.42560e-06_r8,2.48641e-06_r8,2.54835e-06_r8,2.61142e-06_r8/) + totplnk(151:181,11) = (/ & + 2.67563e-06_r8,2.74100e-06_r8,2.80754e-06_r8,2.87526e-06_r8,2.94417e-06_r8, & + 3.01429e-06_r8,3.08562e-06_r8,3.15819e-06_r8,3.23199e-06_r8,3.30704e-06_r8, & + 3.38336e-06_r8,3.46096e-06_r8,3.53984e-06_r8,3.62002e-06_r8,3.70151e-06_r8, & + 3.78433e-06_r8,3.86848e-06_r8,3.95399e-06_r8,4.04084e-06_r8,4.12907e-06_r8, & + 4.21868e-06_r8,4.30968e-06_r8,4.40209e-06_r8,4.49592e-06_r8,4.59117e-06_r8, & + 4.68786e-06_r8,4.78600e-06_r8,4.88561e-06_r8,4.98669e-06_r8,5.08926e-06_r8, & + 5.19332e-06_r8/) + totplnk(1:50,12) = (/ & + 2.73921e-10_r8,3.04500e-10_r8,3.38056e-10_r8,3.74835e-10_r8,4.15099e-10_r8, & + 4.59126e-10_r8,5.07214e-10_r8,5.59679e-10_r8,6.16857e-10_r8,6.79103e-10_r8, & + 7.46796e-10_r8,8.20335e-10_r8,9.00144e-10_r8,9.86671e-10_r8,1.08039e-09_r8, & + 1.18180e-09_r8,1.29142e-09_r8,1.40982e-09_r8,1.53757e-09_r8,1.67529e-09_r8, & + 1.82363e-09_r8,1.98327e-09_r8,2.15492e-09_r8,2.33932e-09_r8,2.53726e-09_r8, & + 2.74957e-09_r8,2.97710e-09_r8,3.22075e-09_r8,3.48145e-09_r8,3.76020e-09_r8, & + 4.05801e-09_r8,4.37595e-09_r8,4.71513e-09_r8,5.07672e-09_r8,5.46193e-09_r8, & + 5.87201e-09_r8,6.30827e-09_r8,6.77205e-09_r8,7.26480e-09_r8,7.78794e-09_r8, & + 8.34304e-09_r8,8.93163e-09_r8,9.55537e-09_r8,1.02159e-08_r8,1.09151e-08_r8, & + 1.16547e-08_r8,1.24365e-08_r8,1.32625e-08_r8,1.41348e-08_r8,1.50554e-08_r8/) + totplnk(51:100,12) = (/ & + 1.60264e-08_r8,1.70500e-08_r8,1.81285e-08_r8,1.92642e-08_r8,2.04596e-08_r8, & + 2.17171e-08_r8,2.30394e-08_r8,2.44289e-08_r8,2.58885e-08_r8,2.74209e-08_r8, & + 2.90290e-08_r8,3.07157e-08_r8,3.24841e-08_r8,3.43371e-08_r8,3.62782e-08_r8, & + 3.83103e-08_r8,4.04371e-08_r8,4.26617e-08_r8,4.49878e-08_r8,4.74190e-08_r8, & + 4.99589e-08_r8,5.26113e-08_r8,5.53801e-08_r8,5.82692e-08_r8,6.12826e-08_r8, & + 6.44245e-08_r8,6.76991e-08_r8,7.11105e-08_r8,7.46634e-08_r8,7.83621e-08_r8, & + 8.22112e-08_r8,8.62154e-08_r8,9.03795e-08_r8,9.47081e-08_r8,9.92066e-08_r8, & + 1.03879e-07_r8,1.08732e-07_r8,1.13770e-07_r8,1.18998e-07_r8,1.24422e-07_r8, & + 1.30048e-07_r8,1.35880e-07_r8,1.41924e-07_r8,1.48187e-07_r8,1.54675e-07_r8, & + 1.61392e-07_r8,1.68346e-07_r8,1.75543e-07_r8,1.82988e-07_r8,1.90688e-07_r8/) + totplnk(101:150,12) = (/ & + 1.98650e-07_r8,2.06880e-07_r8,2.15385e-07_r8,2.24172e-07_r8,2.33247e-07_r8, & + 2.42617e-07_r8,2.52289e-07_r8,2.62272e-07_r8,2.72571e-07_r8,2.83193e-07_r8, & + 2.94147e-07_r8,3.05440e-07_r8,3.17080e-07_r8,3.29074e-07_r8,3.41430e-07_r8, & + 3.54155e-07_r8,3.67259e-07_r8,3.80747e-07_r8,3.94631e-07_r8,4.08916e-07_r8, & + 4.23611e-07_r8,4.38725e-07_r8,4.54267e-07_r8,4.70245e-07_r8,4.86666e-07_r8, & + 5.03541e-07_r8,5.20879e-07_r8,5.38687e-07_r8,5.56975e-07_r8,5.75751e-07_r8, & + 5.95026e-07_r8,6.14808e-07_r8,6.35107e-07_r8,6.55932e-07_r8,6.77293e-07_r8, & + 6.99197e-07_r8,7.21656e-07_r8,7.44681e-07_r8,7.68278e-07_r8,7.92460e-07_r8, & + 8.17235e-07_r8,8.42614e-07_r8,8.68606e-07_r8,8.95223e-07_r8,9.22473e-07_r8, & + 9.50366e-07_r8,9.78915e-07_r8,1.00813e-06_r8,1.03802e-06_r8,1.06859e-06_r8/) + totplnk(151:181,12) = (/ & + 1.09986e-06_r8,1.13184e-06_r8,1.16453e-06_r8,1.19796e-06_r8,1.23212e-06_r8, & + 1.26703e-06_r8,1.30270e-06_r8,1.33915e-06_r8,1.37637e-06_r8,1.41440e-06_r8, & + 1.45322e-06_r8,1.49286e-06_r8,1.53333e-06_r8,1.57464e-06_r8,1.61679e-06_r8, & + 1.65981e-06_r8,1.70370e-06_r8,1.74847e-06_r8,1.79414e-06_r8,1.84071e-06_r8, & + 1.88821e-06_r8,1.93663e-06_r8,1.98599e-06_r8,2.03631e-06_r8,2.08759e-06_r8, & + 2.13985e-06_r8,2.19310e-06_r8,2.24734e-06_r8,2.30260e-06_r8,2.35888e-06_r8, & + 2.41619e-06_r8/) + totplnk(1:50,13) = (/ & + 4.53634e-11_r8,5.11435e-11_r8,5.75754e-11_r8,6.47222e-11_r8,7.26531e-11_r8, & + 8.14420e-11_r8,9.11690e-11_r8,1.01921e-10_r8,1.13790e-10_r8,1.26877e-10_r8, & + 1.41288e-10_r8,1.57140e-10_r8,1.74555e-10_r8,1.93665e-10_r8,2.14613e-10_r8, & + 2.37548e-10_r8,2.62633e-10_r8,2.90039e-10_r8,3.19948e-10_r8,3.52558e-10_r8, & + 3.88073e-10_r8,4.26716e-10_r8,4.68719e-10_r8,5.14331e-10_r8,5.63815e-10_r8, & + 6.17448e-10_r8,6.75526e-10_r8,7.38358e-10_r8,8.06277e-10_r8,8.79625e-10_r8, & + 9.58770e-10_r8,1.04410e-09_r8,1.13602e-09_r8,1.23495e-09_r8,1.34135e-09_r8, & + 1.45568e-09_r8,1.57845e-09_r8,1.71017e-09_r8,1.85139e-09_r8,2.00268e-09_r8, & + 2.16464e-09_r8,2.33789e-09_r8,2.52309e-09_r8,2.72093e-09_r8,2.93212e-09_r8, & + 3.15740e-09_r8,3.39757e-09_r8,3.65341e-09_r8,3.92579e-09_r8,4.21559e-09_r8/) + totplnk(51:100,13) = (/ & + 4.52372e-09_r8,4.85115e-09_r8,5.19886e-09_r8,5.56788e-09_r8,5.95928e-09_r8, & + 6.37419e-09_r8,6.81375e-09_r8,7.27917e-09_r8,7.77168e-09_r8,8.29256e-09_r8, & + 8.84317e-09_r8,9.42487e-09_r8,1.00391e-08_r8,1.06873e-08_r8,1.13710e-08_r8, & + 1.20919e-08_r8,1.28515e-08_r8,1.36514e-08_r8,1.44935e-08_r8,1.53796e-08_r8, & + 1.63114e-08_r8,1.72909e-08_r8,1.83201e-08_r8,1.94008e-08_r8,2.05354e-08_r8, & + 2.17258e-08_r8,2.29742e-08_r8,2.42830e-08_r8,2.56545e-08_r8,2.70910e-08_r8, & + 2.85950e-08_r8,3.01689e-08_r8,3.18155e-08_r8,3.35373e-08_r8,3.53372e-08_r8, & + 3.72177e-08_r8,3.91818e-08_r8,4.12325e-08_r8,4.33727e-08_r8,4.56056e-08_r8, & + 4.79342e-08_r8,5.03617e-08_r8,5.28915e-08_r8,5.55270e-08_r8,5.82715e-08_r8, & + 6.11286e-08_r8,6.41019e-08_r8,6.71951e-08_r8,7.04119e-08_r8,7.37560e-08_r8/) + totplnk(101:150,13) = (/ & + 7.72315e-08_r8,8.08424e-08_r8,8.45927e-08_r8,8.84866e-08_r8,9.25281e-08_r8, & + 9.67218e-08_r8,1.01072e-07_r8,1.05583e-07_r8,1.10260e-07_r8,1.15107e-07_r8, & + 1.20128e-07_r8,1.25330e-07_r8,1.30716e-07_r8,1.36291e-07_r8,1.42061e-07_r8, & + 1.48031e-07_r8,1.54206e-07_r8,1.60592e-07_r8,1.67192e-07_r8,1.74015e-07_r8, & + 1.81064e-07_r8,1.88345e-07_r8,1.95865e-07_r8,2.03628e-07_r8,2.11643e-07_r8, & + 2.19912e-07_r8,2.28443e-07_r8,2.37244e-07_r8,2.46318e-07_r8,2.55673e-07_r8, & + 2.65316e-07_r8,2.75252e-07_r8,2.85489e-07_r8,2.96033e-07_r8,3.06891e-07_r8, & + 3.18070e-07_r8,3.29576e-07_r8,3.41417e-07_r8,3.53600e-07_r8,3.66133e-07_r8, & + 3.79021e-07_r8,3.92274e-07_r8,4.05897e-07_r8,4.19899e-07_r8,4.34288e-07_r8, & + 4.49071e-07_r8,4.64255e-07_r8,4.79850e-07_r8,4.95863e-07_r8,5.12300e-07_r8/) + totplnk(151:181,13) = (/ & + 5.29172e-07_r8,5.46486e-07_r8,5.64250e-07_r8,5.82473e-07_r8,6.01164e-07_r8, & + 6.20329e-07_r8,6.39979e-07_r8,6.60122e-07_r8,6.80767e-07_r8,7.01922e-07_r8, & + 7.23596e-07_r8,7.45800e-07_r8,7.68539e-07_r8,7.91826e-07_r8,8.15669e-07_r8, & + 8.40076e-07_r8,8.65058e-07_r8,8.90623e-07_r8,9.16783e-07_r8,9.43544e-07_r8, & + 9.70917e-07_r8,9.98912e-07_r8,1.02754e-06_r8,1.05681e-06_r8,1.08673e-06_r8, & + 1.11731e-06_r8,1.14856e-06_r8,1.18050e-06_r8,1.21312e-06_r8,1.24645e-06_r8, & + 1.28049e-06_r8/) + totplnk(1:50,14) = (/ & + 1.40113e-11_r8,1.59358e-11_r8,1.80960e-11_r8,2.05171e-11_r8,2.32266e-11_r8, & + 2.62546e-11_r8,2.96335e-11_r8,3.33990e-11_r8,3.75896e-11_r8,4.22469e-11_r8, & + 4.74164e-11_r8,5.31466e-11_r8,5.94905e-11_r8,6.65054e-11_r8,7.42522e-11_r8, & + 8.27975e-11_r8,9.22122e-11_r8,1.02573e-10_r8,1.13961e-10_r8,1.26466e-10_r8, & + 1.40181e-10_r8,1.55206e-10_r8,1.71651e-10_r8,1.89630e-10_r8,2.09265e-10_r8, & + 2.30689e-10_r8,2.54040e-10_r8,2.79467e-10_r8,3.07128e-10_r8,3.37190e-10_r8, & + 3.69833e-10_r8,4.05243e-10_r8,4.43623e-10_r8,4.85183e-10_r8,5.30149e-10_r8, & + 5.78755e-10_r8,6.31255e-10_r8,6.87910e-10_r8,7.49002e-10_r8,8.14824e-10_r8, & + 8.85687e-10_r8,9.61914e-10_r8,1.04385e-09_r8,1.13186e-09_r8,1.22631e-09_r8, & + 1.32761e-09_r8,1.43617e-09_r8,1.55243e-09_r8,1.67686e-09_r8,1.80992e-09_r8/) + totplnk(51:100,14) = (/ & + 1.95212e-09_r8,2.10399e-09_r8,2.26607e-09_r8,2.43895e-09_r8,2.62321e-09_r8, & + 2.81949e-09_r8,3.02844e-09_r8,3.25073e-09_r8,3.48707e-09_r8,3.73820e-09_r8, & + 4.00490e-09_r8,4.28794e-09_r8,4.58819e-09_r8,4.90647e-09_r8,5.24371e-09_r8, & + 5.60081e-09_r8,5.97875e-09_r8,6.37854e-09_r8,6.80120e-09_r8,7.24782e-09_r8, & + 7.71950e-09_r8,8.21740e-09_r8,8.74271e-09_r8,9.29666e-09_r8,9.88054e-09_r8, & + 1.04956e-08_r8,1.11434e-08_r8,1.18251e-08_r8,1.25422e-08_r8,1.32964e-08_r8, & + 1.40890e-08_r8,1.49217e-08_r8,1.57961e-08_r8,1.67140e-08_r8,1.76771e-08_r8, & + 1.86870e-08_r8,1.97458e-08_r8,2.08553e-08_r8,2.20175e-08_r8,2.32342e-08_r8, & + 2.45077e-08_r8,2.58401e-08_r8,2.72334e-08_r8,2.86900e-08_r8,3.02122e-08_r8, & + 3.18021e-08_r8,3.34624e-08_r8,3.51954e-08_r8,3.70037e-08_r8,3.88899e-08_r8/) + totplnk(101:150,14) = (/ & + 4.08568e-08_r8,4.29068e-08_r8,4.50429e-08_r8,4.72678e-08_r8,4.95847e-08_r8, & + 5.19963e-08_r8,5.45058e-08_r8,5.71161e-08_r8,5.98309e-08_r8,6.26529e-08_r8, & + 6.55857e-08_r8,6.86327e-08_r8,7.17971e-08_r8,7.50829e-08_r8,7.84933e-08_r8, & + 8.20323e-08_r8,8.57035e-08_r8,8.95105e-08_r8,9.34579e-08_r8,9.75488e-08_r8, & + 1.01788e-07_r8,1.06179e-07_r8,1.10727e-07_r8,1.15434e-07_r8,1.20307e-07_r8, & + 1.25350e-07_r8,1.30566e-07_r8,1.35961e-07_r8,1.41539e-07_r8,1.47304e-07_r8, & + 1.53263e-07_r8,1.59419e-07_r8,1.65778e-07_r8,1.72345e-07_r8,1.79124e-07_r8, & + 1.86122e-07_r8,1.93343e-07_r8,2.00792e-07_r8,2.08476e-07_r8,2.16400e-07_r8, & + 2.24568e-07_r8,2.32988e-07_r8,2.41666e-07_r8,2.50605e-07_r8,2.59813e-07_r8, & + 2.69297e-07_r8,2.79060e-07_r8,2.89111e-07_r8,2.99455e-07_r8,3.10099e-07_r8/) + totplnk(151:181,14) = (/ & + 3.21049e-07_r8,3.32311e-07_r8,3.43893e-07_r8,3.55801e-07_r8,3.68041e-07_r8, & + 3.80621e-07_r8,3.93547e-07_r8,4.06826e-07_r8,4.20465e-07_r8,4.34473e-07_r8, & + 4.48856e-07_r8,4.63620e-07_r8,4.78774e-07_r8,4.94325e-07_r8,5.10280e-07_r8, & + 5.26648e-07_r8,5.43436e-07_r8,5.60652e-07_r8,5.78302e-07_r8,5.96397e-07_r8, & + 6.14943e-07_r8,6.33949e-07_r8,6.53421e-07_r8,6.73370e-07_r8,6.93803e-07_r8, & + 7.14731e-07_r8,7.36157e-07_r8,7.58095e-07_r8,7.80549e-07_r8,8.03533e-07_r8, & + 8.27050e-07_r8/) + totplnk(1:50,15) = (/ & + 3.90483e-12_r8,4.47999e-12_r8,5.13122e-12_r8,5.86739e-12_r8,6.69829e-12_r8, & + 7.63467e-12_r8,8.68833e-12_r8,9.87221e-12_r8,1.12005e-11_r8,1.26885e-11_r8, & + 1.43534e-11_r8,1.62134e-11_r8,1.82888e-11_r8,2.06012e-11_r8,2.31745e-11_r8, & + 2.60343e-11_r8,2.92087e-11_r8,3.27277e-11_r8,3.66242e-11_r8,4.09334e-11_r8, & + 4.56935e-11_r8,5.09455e-11_r8,5.67338e-11_r8,6.31057e-11_r8,7.01127e-11_r8, & + 7.78096e-11_r8,8.62554e-11_r8,9.55130e-11_r8,1.05651e-10_r8,1.16740e-10_r8, & + 1.28858e-10_r8,1.42089e-10_r8,1.56519e-10_r8,1.72243e-10_r8,1.89361e-10_r8, & + 2.07978e-10_r8,2.28209e-10_r8,2.50173e-10_r8,2.73999e-10_r8,2.99820e-10_r8, & + 3.27782e-10_r8,3.58034e-10_r8,3.90739e-10_r8,4.26067e-10_r8,4.64196e-10_r8, & + 5.05317e-10_r8,5.49631e-10_r8,5.97347e-10_r8,6.48689e-10_r8,7.03891e-10_r8/) + totplnk(51:100,15) = (/ & + 7.63201e-10_r8,8.26876e-10_r8,8.95192e-10_r8,9.68430e-10_r8,1.04690e-09_r8, & + 1.13091e-09_r8,1.22079e-09_r8,1.31689e-09_r8,1.41957e-09_r8,1.52922e-09_r8, & + 1.64623e-09_r8,1.77101e-09_r8,1.90401e-09_r8,2.04567e-09_r8,2.19647e-09_r8, & + 2.35690e-09_r8,2.52749e-09_r8,2.70875e-09_r8,2.90127e-09_r8,3.10560e-09_r8, & + 3.32238e-09_r8,3.55222e-09_r8,3.79578e-09_r8,4.05375e-09_r8,4.32682e-09_r8, & + 4.61574e-09_r8,4.92128e-09_r8,5.24420e-09_r8,5.58536e-09_r8,5.94558e-09_r8, & + 6.32575e-09_r8,6.72678e-09_r8,7.14964e-09_r8,7.59526e-09_r8,8.06470e-09_r8, & + 8.55897e-09_r8,9.07916e-09_r8,9.62638e-09_r8,1.02018e-08_r8,1.08066e-08_r8, & + 1.14420e-08_r8,1.21092e-08_r8,1.28097e-08_r8,1.35446e-08_r8,1.43155e-08_r8, & + 1.51237e-08_r8,1.59708e-08_r8,1.68581e-08_r8,1.77873e-08_r8,1.87599e-08_r8/) + totplnk(101:150,15) = (/ & + 1.97777e-08_r8,2.08423e-08_r8,2.19555e-08_r8,2.31190e-08_r8,2.43348e-08_r8, & + 2.56045e-08_r8,2.69302e-08_r8,2.83140e-08_r8,2.97578e-08_r8,3.12636e-08_r8, & + 3.28337e-08_r8,3.44702e-08_r8,3.61755e-08_r8,3.79516e-08_r8,3.98012e-08_r8, & + 4.17265e-08_r8,4.37300e-08_r8,4.58143e-08_r8,4.79819e-08_r8,5.02355e-08_r8, & + 5.25777e-08_r8,5.50114e-08_r8,5.75393e-08_r8,6.01644e-08_r8,6.28896e-08_r8, & + 6.57177e-08_r8,6.86521e-08_r8,7.16959e-08_r8,7.48520e-08_r8,7.81239e-08_r8, & + 8.15148e-08_r8,8.50282e-08_r8,8.86675e-08_r8,9.24362e-08_r8,9.63380e-08_r8, & + 1.00376e-07_r8,1.04555e-07_r8,1.08878e-07_r8,1.13349e-07_r8,1.17972e-07_r8, & + 1.22751e-07_r8,1.27690e-07_r8,1.32793e-07_r8,1.38064e-07_r8,1.43508e-07_r8, & + 1.49129e-07_r8,1.54931e-07_r8,1.60920e-07_r8,1.67099e-07_r8,1.73473e-07_r8/) + totplnk(151:181,15) = (/ & + 1.80046e-07_r8,1.86825e-07_r8,1.93812e-07_r8,2.01014e-07_r8,2.08436e-07_r8, & + 2.16082e-07_r8,2.23957e-07_r8,2.32067e-07_r8,2.40418e-07_r8,2.49013e-07_r8, & + 2.57860e-07_r8,2.66963e-07_r8,2.76328e-07_r8,2.85961e-07_r8,2.95868e-07_r8, & + 3.06053e-07_r8,3.16524e-07_r8,3.27286e-07_r8,3.38345e-07_r8,3.49707e-07_r8, & + 3.61379e-07_r8,3.73367e-07_r8,3.85676e-07_r8,3.98315e-07_r8,4.11287e-07_r8, & + 4.24602e-07_r8,4.38265e-07_r8,4.52283e-07_r8,4.66662e-07_r8,4.81410e-07_r8, & + 4.96535e-07_r8/) + totplnk(1:50,16) = (/ & + 0.28639e-12_r8,0.33349e-12_r8,0.38764e-12_r8,0.44977e-12_r8,0.52093e-12_r8, & + 0.60231e-12_r8,0.69522e-12_r8,0.80111e-12_r8,0.92163e-12_r8,0.10586e-11_r8, & + 0.12139e-11_r8,0.13899e-11_r8,0.15890e-11_r8,0.18138e-11_r8,0.20674e-11_r8, & + 0.23531e-11_r8,0.26744e-11_r8,0.30352e-11_r8,0.34401e-11_r8,0.38936e-11_r8, & + 0.44011e-11_r8,0.49681e-11_r8,0.56010e-11_r8,0.63065e-11_r8,0.70919e-11_r8, & + 0.79654e-11_r8,0.89357e-11_r8,0.10012e-10_r8,0.11205e-10_r8,0.12526e-10_r8, & + 0.13986e-10_r8,0.15600e-10_r8,0.17380e-10_r8,0.19342e-10_r8,0.21503e-10_r8, & + 0.23881e-10_r8,0.26494e-10_r8,0.29362e-10_r8,0.32509e-10_r8,0.35958e-10_r8, & + 0.39733e-10_r8,0.43863e-10_r8,0.48376e-10_r8,0.53303e-10_r8,0.58679e-10_r8, & + 0.64539e-10_r8,0.70920e-10_r8,0.77864e-10_r8,0.85413e-10_r8,0.93615e-10_r8/) + totplnk(51:100,16) = (/ & + 0.10252e-09_r8,0.11217e-09_r8,0.12264e-09_r8,0.13397e-09_r8,0.14624e-09_r8, & + 0.15950e-09_r8,0.17383e-09_r8,0.18930e-09_r8,0.20599e-09_r8,0.22399e-09_r8, & + 0.24339e-09_r8,0.26427e-09_r8,0.28674e-09_r8,0.31090e-09_r8,0.33686e-09_r8, & + 0.36474e-09_r8,0.39466e-09_r8,0.42676e-09_r8,0.46115e-09_r8,0.49800e-09_r8, & + 0.53744e-09_r8,0.57964e-09_r8,0.62476e-09_r8,0.67298e-09_r8,0.72448e-09_r8, & + 0.77945e-09_r8,0.83809e-09_r8,0.90062e-09_r8,0.96725e-09_r8,0.10382e-08_r8, & + 0.11138e-08_r8,0.11941e-08_r8,0.12796e-08_r8,0.13704e-08_r8,0.14669e-08_r8, & + 0.15694e-08_r8,0.16781e-08_r8,0.17934e-08_r8,0.19157e-08_r8,0.20453e-08_r8, & + 0.21825e-08_r8,0.23278e-08_r8,0.24815e-08_r8,0.26442e-08_r8,0.28161e-08_r8, & + 0.29978e-08_r8,0.31898e-08_r8,0.33925e-08_r8,0.36064e-08_r8,0.38321e-08_r8/) + totplnk(101:150,16) = (/ & + 0.40700e-08_r8,0.43209e-08_r8,0.45852e-08_r8,0.48636e-08_r8,0.51567e-08_r8, & + 0.54652e-08_r8,0.57897e-08_r8,0.61310e-08_r8,0.64897e-08_r8,0.68667e-08_r8, & + 0.72626e-08_r8,0.76784e-08_r8,0.81148e-08_r8,0.85727e-08_r8,0.90530e-08_r8, & + 0.95566e-08_r8,0.10084e-07_r8,0.10638e-07_r8,0.11217e-07_r8,0.11824e-07_r8, & + 0.12458e-07_r8,0.13123e-07_r8,0.13818e-07_r8,0.14545e-07_r8,0.15305e-07_r8, & + 0.16099e-07_r8,0.16928e-07_r8,0.17795e-07_r8,0.18699e-07_r8,0.19643e-07_r8, & + 0.20629e-07_r8,0.21656e-07_r8,0.22728e-07_r8,0.23845e-07_r8,0.25010e-07_r8, & + 0.26223e-07_r8,0.27487e-07_r8,0.28804e-07_r8,0.30174e-07_r8,0.31600e-07_r8, & + 0.33084e-07_r8,0.34628e-07_r8,0.36233e-07_r8,0.37902e-07_r8,0.39637e-07_r8, & + 0.41440e-07_r8,0.43313e-07_r8,0.45259e-07_r8,0.47279e-07_r8,0.49376e-07_r8/) + totplnk(151:181,16) = (/ & + 0.51552e-07_r8,0.53810e-07_r8,0.56153e-07_r8,0.58583e-07_r8,0.61102e-07_r8, & + 0.63713e-07_r8,0.66420e-07_r8,0.69224e-07_r8,0.72129e-07_r8,0.75138e-07_r8, & + 0.78254e-07_r8,0.81479e-07_r8,0.84818e-07_r8,0.88272e-07_r8,0.91846e-07_r8, & + 0.95543e-07_r8,0.99366e-07_r8,0.10332e-06_r8,0.10740e-06_r8,0.11163e-06_r8, & + 0.11599e-06_r8,0.12050e-06_r8,0.12515e-06_r8,0.12996e-06_r8,0.13493e-06_r8, & + 0.14005e-06_r8,0.14534e-06_r8,0.15080e-06_r8,0.15643e-06_r8,0.16224e-06_r8, & + 0.16823e-06_r8/) + totplk16(1:50) = (/ & + 0.28481e-12_r8,0.33159e-12_r8,0.38535e-12_r8,0.44701e-12_r8,0.51763e-12_r8, & + 0.59836e-12_r8,0.69049e-12_r8,0.79549e-12_r8,0.91493e-12_r8,0.10506e-11_r8, & + 0.12045e-11_r8,0.13788e-11_r8,0.15758e-11_r8,0.17984e-11_r8,0.20493e-11_r8, & + 0.23317e-11_r8,0.26494e-11_r8,0.30060e-11_r8,0.34060e-11_r8,0.38539e-11_r8, & + 0.43548e-11_r8,0.49144e-11_r8,0.55387e-11_r8,0.62344e-11_r8,0.70086e-11_r8, & + 0.78692e-11_r8,0.88248e-11_r8,0.98846e-11_r8,0.11059e-10_r8,0.12358e-10_r8, & + 0.13794e-10_r8,0.15379e-10_r8,0.17128e-10_r8,0.19055e-10_r8,0.21176e-10_r8, & + 0.23508e-10_r8,0.26070e-10_r8,0.28881e-10_r8,0.31963e-10_r8,0.35339e-10_r8, & + 0.39034e-10_r8,0.43073e-10_r8,0.47484e-10_r8,0.52299e-10_r8,0.57548e-10_r8, & + 0.63267e-10_r8,0.69491e-10_r8,0.76261e-10_r8,0.83616e-10_r8,0.91603e-10_r8/) + totplk16(51:100) = (/ & + 0.10027e-09_r8,0.10966e-09_r8,0.11983e-09_r8,0.13084e-09_r8,0.14275e-09_r8, & + 0.15562e-09_r8,0.16951e-09_r8,0.18451e-09_r8,0.20068e-09_r8,0.21810e-09_r8, & + 0.23686e-09_r8,0.25704e-09_r8,0.27875e-09_r8,0.30207e-09_r8,0.32712e-09_r8, & + 0.35400e-09_r8,0.38282e-09_r8,0.41372e-09_r8,0.44681e-09_r8,0.48223e-09_r8, & + 0.52013e-09_r8,0.56064e-09_r8,0.60392e-09_r8,0.65015e-09_r8,0.69948e-09_r8, & + 0.75209e-09_r8,0.80818e-09_r8,0.86794e-09_r8,0.93157e-09_r8,0.99929e-09_r8, & + 0.10713e-08_r8,0.11479e-08_r8,0.12293e-08_r8,0.13157e-08_r8,0.14074e-08_r8, & + 0.15047e-08_r8,0.16079e-08_r8,0.17172e-08_r8,0.18330e-08_r8,0.19557e-08_r8, & + 0.20855e-08_r8,0.22228e-08_r8,0.23680e-08_r8,0.25214e-08_r8,0.26835e-08_r8, & + 0.28546e-08_r8,0.30352e-08_r8,0.32257e-08_r8,0.34266e-08_r8,0.36384e-08_r8/) + totplk16(101:150) = (/ & + 0.38615e-08_r8,0.40965e-08_r8,0.43438e-08_r8,0.46041e-08_r8,0.48779e-08_r8, & + 0.51658e-08_r8,0.54683e-08_r8,0.57862e-08_r8,0.61200e-08_r8,0.64705e-08_r8, & + 0.68382e-08_r8,0.72240e-08_r8,0.76285e-08_r8,0.80526e-08_r8,0.84969e-08_r8, & + 0.89624e-08_r8,0.94498e-08_r8,0.99599e-08_r8,0.10494e-07_r8,0.11052e-07_r8, & + 0.11636e-07_r8,0.12246e-07_r8,0.12884e-07_r8,0.13551e-07_r8,0.14246e-07_r8, & + 0.14973e-07_r8,0.15731e-07_r8,0.16522e-07_r8,0.17347e-07_r8,0.18207e-07_r8, & + 0.19103e-07_r8,0.20037e-07_r8,0.21011e-07_r8,0.22024e-07_r8,0.23079e-07_r8, & + 0.24177e-07_r8,0.25320e-07_r8,0.26508e-07_r8,0.27744e-07_r8,0.29029e-07_r8, & + 0.30365e-07_r8,0.31753e-07_r8,0.33194e-07_r8,0.34691e-07_r8,0.36246e-07_r8, & + 0.37859e-07_r8,0.39533e-07_r8,0.41270e-07_r8,0.43071e-07_r8,0.44939e-07_r8/) + totplk16(151:181) = (/ & + 0.46875e-07_r8,0.48882e-07_r8,0.50961e-07_r8,0.53115e-07_r8,0.55345e-07_r8, & + 0.57655e-07_r8,0.60046e-07_r8,0.62520e-07_r8,0.65080e-07_r8,0.67728e-07_r8, & + 0.70466e-07_r8,0.73298e-07_r8,0.76225e-07_r8,0.79251e-07_r8,0.82377e-07_r8, & + 0.85606e-07_r8,0.88942e-07_r8,0.92386e-07_r8,0.95942e-07_r8,0.99612e-07_r8, & + 0.10340e-06_r8,0.10731e-06_r8,0.11134e-06_r8,0.11550e-06_r8,0.11979e-06_r8, & + 0.12421e-06_r8,0.12876e-06_r8,0.13346e-06_r8,0.13830e-06_r8,0.14328e-06_r8, & + 0.14841e-06_r8/) + + end subroutine lwavplank + + end module rrtmg_lw_setcoef + diff --git a/src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 b/src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 new file mode 100644 index 0000000000..a957c1ba6f --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_lw_taumol.f90 @@ -0,0 +1,3164 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_taumol.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.7 $ +! created: $Date: 2009/10/20 15:08:37 $ +! + module rrtmg_lw_taumol + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use parrrtm, only: nbndlw, maxxsec, ngptlw + use rrlw_con, only: oneminus + use rrlw_wvn, only: nspa, nspb + + implicit none + + contains + +!---------------------------------------------------------------------------- + subroutine taumol(nlayers, pavel, wx, coldry, & + laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & + colbrd, fac00, fac01, fac10, fac11, & + rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & + rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, & + rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + minorfrac, scaleminor, scaleminorn2, indminor, & + fracs, taug) +!---------------------------------------------------------------------------- + +! ******************************************************************************* +! * * +! * Optical depths developed for the * +! * * +! * RAPID RADIATIVE TRANSFER MODEL (RRTM) * +! * * +! * * +! * ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. * +! * 131 HARTWELL AVENUE * +! * LEXINGTON, MA 02421 * +! * * +! * * +! * ELI J. MLAWER * +! * JENNIFER DELAMERE * +! * STEVEN J. TAUBMAN * +! * SHEPARD A. CLOUGH * +! * * +! * * +! * * +! * * +! * email: mlawer@aer.com * +! * email: jdelamer@aer.com * +! * * +! * The authors wish to acknowledge the contributions of the * +! * following people: Karen Cady-Pereira, Patrick D. Brown, * +! * Michael J. Iacono, Ronald E. Farren, Luke Chen, Robert Bergstrom. * +! * * +! ******************************************************************************* +! * * +! * Revision for g-point reduction: Michael J. Iacono, AER, Inc. * +! * * +! ******************************************************************************* +! * TAUMOL * +! * * +! * This file contains the subroutines TAUGBn (where n goes from * +! * 1 to 16). TAUGBn calculates the optical depths and Planck fractions * +! * per g-value and layer for band n. * +! * * +! * Output: optical depths (unitless) * +! * fractions needed to compute Planck functions at every layer * +! * and g-value * +! * * +! * COMMON /TAUGCOM/ TAUG(MXLAY,MG) * +! * COMMON /PLANKG/ FRACS(MXLAY,MG) * +! * * +! * Input * +! * * +! * COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS) * +! * COMMON /PRECISE/ ONEMINUS * +! * COMMON /PROFILE/ NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY), * +! * & PZ(0:MXLAY),TZ(0:MXLAY) * +! * COMMON /PROFDATA/ LAYTROP, * +! * & COLH2O(MXLAY),COLCO2(MXLAY),COLO3(MXLAY), * +! * & COLN2O(MXLAY),COLCO(MXLAY),COLCH4(MXLAY), * +! * & COLO2(MXLAY) +! * COMMON /INTFAC/ FAC00(MXLAY),FAC01(MXLAY), * +! * & FAC10(MXLAY),FAC11(MXLAY) * +! * COMMON /INTIND/ JP(MXLAY),JT(MXLAY),JT1(MXLAY) * +! * COMMON /SELF/ SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY) * +! * * +! * Description: * +! * NG(IBAND) - number of g-values in band IBAND * +! * NSPA(IBAND) - for the lower atmosphere, the number of reference * +! * atmospheres that are stored for band IBAND per * +! * pressure level and temperature. Each of these * +! * atmospheres has different relative amounts of the * +! * key species for the band (i.e. different binary * +! * species parameters). * +! * NSPB(IBAND) - same for upper atmosphere * +! * ONEMINUS - since problems are caused in some cases by interpolation * +! * parameters equal to or greater than 1, for these cases * +! * these parameters are set to this value, slightly < 1. * +! * PAVEL - layer pressures (mb) * +! * TAVEL - layer temperatures (degrees K) * +! * PZ - level pressures (mb) * +! * TZ - level temperatures (degrees K) * +! * LAYTROP - layer at which switch is made from one combination of * +! * key species to another * +! * COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water * +! * vapor,carbon dioxide, ozone, nitrous ozide, methane, * +! * respectively (molecules/cm**2) * +! * FACij(LAY) - for layer LAY, these are factors that are needed to * +! * compute the interpolation factors that multiply the * +! * appropriate reference k-values. A value of 0 (1) for * +! * i,j indicates that the corresponding factor multiplies * +! * reference k-value for the lower (higher) of the two * +! * appropriate temperatures, and altitudes, respectively. * +! * JP - the index of the lower (in altitude) of the two appropriate * +! * reference pressure levels needed for interpolation * +! * JT, JT1 - the indices of the lower of the two appropriate reference * +! * temperatures needed for interpolation (for pressure * +! * levels JP and JP+1, respectively) * +! * SELFFAC - scale factor needed for water vapor self-continuum, equals * +! * (water vapor density)/(atmospheric density at 296K and * +! * 1013 mb) * +! * SELFFRAC - factor needed for temperature interpolation of reference * +! * water vapor self-continuum data * +! * INDSELF - index of the lower of the two appropriate reference * +! * temperatures needed for the self-continuum interpolation * +! * FORFAC - scale factor needed for water vapor foreign-continuum. * +! * FORFRAC - factor needed for temperature interpolation of reference * +! * water vapor foreign-continuum data * +! * INDFOR - index of the lower of the two appropriate reference * +! * temperatures needed for the foreign-continuum interpolation * +! * * +! * Data input * +! * COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG),* +! * FORREF(4,MG), KA_M'MGAS', KB_M'MGAS' * +! * (note: n is the band number,'MGAS' is the species name of the minor * +! * gas) * +! * * +! * Description: * +! * KA - k-values for low reference atmospheres (key-species only) * +! * (units: cm**2/molecule) * +! * KB - k-values for high reference atmospheres (key-species only) * +! * (units: cm**2/molecule) * +! * KA_M'MGAS' - k-values for low reference atmosphere minor species * +! * (units: cm**2/molecule) * +! * KB_M'MGAS' - k-values for high reference atmosphere minor species * +! * (units: cm**2/molecule) * +! * SELFREF - k-values for water vapor self-continuum for reference * +! * atmospheres (used below LAYTROP) * +! * (units: cm**2/molecule) * +! * FORREF - k-values for water vapor foreign-continuum for reference * +! * atmospheres (used below/above LAYTROP) * +! * (units: cm**2/molecule) * +! * * +! * DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG) * +! * EQUIVALENCE (KA,ABSA),(KB,ABSB) * +! * * +!******************************************************************************* + +! ------- Declarations ------- + +! ----- Input ----- + integer, intent(in) :: nlayers ! total number of layers + real(kind=r8), intent(in) :: pavel(nlayers) ! layer pressures (mb) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: wx(maxxsec,nlayers) ! cross-section amounts (mol/cm2) + ! Dimensions: (maxxsec,nlayers) + real(kind=r8), intent(in) :: coldry(nlayers) ! column amount (dry air) + ! Dimensions: (nlayers) + + integer, intent(in) :: laytrop ! tropopause layer index + integer, intent(in) :: jp(nlayers) ! + ! Dimensions: (nlayers) + integer, intent(in) :: jt(nlayers) ! + ! Dimensions: (nlayers) + integer, intent(in) :: jt1(nlayers) ! + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: planklay(nlayers,nbndlw) ! + ! Dimensions: (nlayers,nbndlw) + real(kind=r8), intent(in) :: planklev(0:nlayers,nbndlw) ! + ! Dimensions: (nlayers,nbndlw) + real(kind=r8), intent(in) :: plankbnd(nbndlw) ! + ! Dimensions: (nbndlw) + + real(kind=r8), intent(in) :: colh2o(nlayers) ! column amount (h2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colco2(nlayers) ! column amount (co2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colo3(nlayers) ! column amount (o3) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: coln2o(nlayers) ! column amount (n2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colco(nlayers) ! column amount (co) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colch4(nlayers) ! column amount (ch4) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colo2(nlayers) ! column amount (o2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colbrd(nlayers) ! column amount (broadening gases) + ! Dimensions: (nlayers) + + integer, intent(in) :: indself(nlayers) + ! Dimensions: (nlayers) + integer, intent(in) :: indfor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: selffac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: selffrac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: forfac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: forfrac(nlayers) + ! Dimensions: (nlayers) + + integer, intent(in) :: indminor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: minorfrac(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: scaleminor(nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: scaleminorn2(nlayers) + ! Dimensions: (nlayers) + + real(kind=r8), dimension(nlayers), intent(in) :: & ! + fac00, fac01, & ! Dimensions: (nlayers) + fac10, fac11 + real(kind=r8), dimension(nlayers), intent(in) :: & ! + rat_h2oco2,rat_h2oco2_1, & + rat_h2oo3,rat_h2oo3_1, & ! Dimensions: (nlayers) + rat_h2on2o,rat_h2on2o_1, & + rat_h2och4,rat_h2och4_1, & + rat_n2oco2,rat_n2oco2_1, & + rat_o3co2,rat_o3co2_1 + +! ----- Output ----- + real(kind=r8), intent(out) :: fracs(nlayers,ngptlw) ! planck fractions + ! Dimensions: (nlayers,ngptlw) + real(kind=r8), intent(out) :: taug(nlayers,ngptlw) ! gaseous optical depth + ! Dimensions: (nlayers,ngptlw) + +! Calculate gaseous optical depth and planck fractions for each spectral band. + + call taugb1 + call taugb2 + call taugb3 + call taugb4 + call taugb5 + call taugb6 + call taugb7 + call taugb8 + call taugb9 + call taugb10 + call taugb11 + call taugb12 + call taugb13 + call taugb14 + call taugb15 + call taugb16 + + contains + +!---------------------------------------------------------------------------- + subroutine taugb1 +!---------------------------------------------------------------------------- + +! ------- Modifications ------- +! Written by Eli J. Mlawer, Atmospheric & Environmental Research. +! Revised by Michael J. Iacono, Atmospheric & Environmental Research. +! +! band 1: 10-350 cm-1 (low key - h2o; low minor - n2) +! (high key - h2o; high minor - n2) +! +! note: previous versions of rrtm band 1: +! 10-250 cm-1 (low - h2o; high - h2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng1 + use rrlw_kg01, only : fracrefa, fracrefb, absa, absb, & + ka_mn2, kb_mn2, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: corradj(nlayers), scalen2(nlayers), tauself, taufor, taun2 + + +! Minor gas mapping levels: +! lower - n2, p = 142.5490 mbar, t = 215.70 k +! upper - n2, p = 142.5490 mbar, t = 215.70 k + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. Below laytrop, the water vapor self-continuum and +! foreign continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(1) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(1) + 1 + !inds = indself(lay) + !indf = indfor(lay) + !indm = indminor(lay) + !pp = pavel(lay) + corradj(lay) = 1. + scalen2(lay) = colbrd(lay) * scaleminorn2(lay) + enddo + do lay = 1, laytrop + if (pavel(lay) .lt. 250._r8) then + corradj(lay) = 1._r8 - 0.15_r8 * (250._r8-pavel(lay)) / 154.4_r8 + endif + enddo + do lay = 1, laytrop + do ig = 1, ng1 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taun2 = scalen2(lay)*(ka_mn2(indminor(lay),ig) + & + minorfrac(lay) * (ka_mn2(indminor(lay)+1,ig) - ka_mn2(indminor(lay),ig))) + taug(lay,ig) = corradj(lay) * (colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor + taun2) + fracs(lay,ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(1) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(1) + 1 + !indf = indfor(lay) + !indm = indminor(lay) + !pp = pavel(lay) + corradj(lay) = 1._r8 - 0.15_r8 * (pavel(lay) / 95.6_r8) + + scalen2(lay) = colbrd(lay) * scaleminorn2(lay) + enddo + do lay = laytrop+1, nlayers + do ig = 1, ng1 + taufor = forfac(lay) * (forref(indfor(lay),ig) + & + forfrac(lay) * (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taun2 = scalen2(lay)*(kb_mn2(indminor(lay),ig) + & + minorfrac(lay) * (kb_mn2(indminor(lay)+1,ig) - kb_mn2(indminor(lay),ig))) + taug(lay,ig) = corradj(lay) * (colh2o(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + taufor + taun2) + fracs(lay,ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb1 + +!---------------------------------------------------------------------------- + subroutine taugb2 +!---------------------------------------------------------------------------- +! +! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) +! +! note: previous version of rrtm band 2: +! 250 - 500 cm-1 (low - h2o; high - h2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng2, ngs1 + use rrlw_kg02, only : fracrefa, fracrefb, absa, absb, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: corradj(nlayers), tauself, taufor + + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. Below laytrop, the water vapor self-continuum and +! foreign continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(2) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(2) + 1 + !inds = indself(lay) + !indf = indfor(lay) + !pp = pavel(lay) + corradj(lay) = 1._r8 - .05_r8 * (pavel(lay) - 100._r8) / 900._r8 + enddo + do lay = 1, laytrop + do ig = 1, ng2 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taug(lay,ngs1+ig) = corradj(lay) * (colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor) + fracs(lay,ngs1+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(2) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(2) + 1 + !indf = indfor(lay) + enddo + do lay = laytrop+1, nlayers + do ig = 1, ng2 + taufor = forfac(lay) * (forref(indfor(lay),ig) + & + forfrac(lay) * (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taug(lay,ngs1+ig) = colh2o(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + taufor + fracs(lay,ngs1+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb2 + +!---------------------------------------------------------------------------- + subroutine taugb3 +!---------------------------------------------------------------------------- +! +! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) +! (high key - h2o,co2; high minor - n2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng3, ngs2 + use rrlw_ref, only : chi_mls + use rrlw_kg03, only : fracrefa, fracrefb, absa, absb,& + ka_mn2o, kb_mn2o, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmn2o, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, & + fmn2o, fmn2omf, chi_n2o, ratn2o, adjfac, adjcoln2o + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor, n2om1, n2om2, absn2o + real(kind=r8) :: refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping levels: +! lower - n2o, p = 706.272 mbar, t = 278.94 k +! upper - n2o, p = 95.58 mbar, t = 215.7 k + +! P = 212.725 mb + refrat_planck_a = chi_mls(1,9)/chi_mls(2,9) + +! P = 95.58 mb + refrat_planck_b = chi_mls(1,13)/chi_mls(2,13) + +! P = 706.270mb + refrat_m_a = chi_mls(1,3)/chi_mls(2,3) + +! P = 95.58 mb + refrat_m_b = chi_mls(1,13)/chi_mls(2,13) + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature, and appropriate species. Below laytrop, the water vapor +! self-continuum and foreign continuum is interpolated (in temperature) +! separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2oco2(lay)*colco2(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mn2o(lay) = colh2o(lay) + refrat_m_a*colco2(lay) + specparm_mn2o(lay) = colh2o(lay)/speccomb_mn2o(lay) + if (specparm_mn2o(lay) .ge. oneminus) specparm_mn2o(lay) = oneminus + specmult_mn2o(lay) = 8._r8*specparm_mn2o(lay) + jmn2o(lay) = 1 + int(specmult_mn2o(lay)) + fmn2o(lay) = mod(specmult_mn2o(lay),1.0_r8) + fmn2omf(lay) = minorfrac(lay)*fmn2o(lay) +! In atmospheres where the amount of N2O is too great to be considered +! a minor species, adjust the column amount of N2O by an empirical factor +! to obtain the proper contribution. + chi_n2o(lay) = coln2o(lay)/coldry(lay) + ratn2o(lay) = 1.e20_r8*chi_n2o(lay)/chi_mls(4,jp(lay)+1) + enddo + do lay = 1, laytrop + if (ratn2o(lay) .gt. 1.5_r8) then + adjfac(lay) = 0.5_r8+(ratn2o(lay)-0.5_r8)**0.65_r8 + adjcoln2o(lay) = adjfac(lay)*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcoln2o(lay) = coln2o(lay) + endif + enddo + do lay = 1, laytrop + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colco2(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(3) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(3) + js1(lay) + enddo + do lay = 1, laytrop + + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng3 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + n2om1 = ka_mn2o(jmn2o(lay),indminor(lay),ig) + fmn2o(lay) * & + (ka_mn2o(jmn2o(lay)+1,indminor(lay),ig) - ka_mn2o(jmn2o(lay),indminor(lay),ig)) + n2om2 = ka_mn2o(jmn2o(lay),indminor(lay)+1,ig) + fmn2o(lay) * & + (ka_mn2o(jmn2o(lay)+1,indminor(lay)+1,ig) - ka_mn2o(jmn2o(lay),indminor(lay)+1,ig)) + absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs2+ig) = tau_major + tau_major1 & + + tauself + taufor & + + adjcoln2o(lay)*absn2o + fracs(lay,ngs2+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + + speccomb(lay) = colh2o(lay) + rat_h2oco2(lay)*colco2(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 4._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 4._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + + speccomb_mn2o(lay) = colh2o(lay) + refrat_m_b*colco2(lay) + specparm_mn2o(lay) = colh2o(lay)/speccomb_mn2o(lay) + if (specparm_mn2o(lay) .ge. oneminus) specparm_mn2o(lay) = oneminus + specmult_mn2o(lay) = 4._r8*specparm_mn2o(lay) + jmn2o(lay) = 1 + int(specmult_mn2o(lay)) + fmn2o(lay) = mod(specmult_mn2o(lay),1.0_r8) + fmn2omf(lay) = minorfrac(lay)*fmn2o(lay) +! In atmospheres where the amount of N2O is too great to be considered +! a minor species, adjust the column amount of N2O by an empirical factor +! to obtain the proper contribution. + chi_n2o(lay) = coln2o(lay)/coldry(lay) + ratn2o(lay) = 1.e20*chi_n2o(lay)/chi_mls(4,jp(lay)+1) + enddo + do lay = laytrop+1, nlayers + if (ratn2o(lay) .gt. 1.5_r8) then + adjfac(lay) = 0.5_r8+(ratn2o(lay)-0.5_r8)**0.65_r8 + adjcoln2o(lay) = adjfac(lay)*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcoln2o(lay) = coln2o(lay) + endif + enddo + do lay = laytrop+1, nlayers + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_b*colco2(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 4._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(3) + js(lay) + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(3) + js1(lay) + enddo + do lay = laytrop+1, nlayers + + do ig = 1, ng3 + taufor = forfac(lay) * (forref(indfor(lay),ig) + & + forfrac(lay) * (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + n2om1 = kb_mn2o(jmn2o(lay),indminor(lay),ig) + fmn2o(lay) * & + (kb_mn2o(jmn2o(lay)+1,indminor(lay),ig)-kb_mn2o(jmn2o(lay),indminor(lay),ig)) + n2om2 = kb_mn2o(jmn2o(lay),indminor(lay)+1,ig) + fmn2o(lay) * & + (kb_mn2o(jmn2o(lay)+1,indminor(lay)+1,ig)-kb_mn2o(jmn2o(lay),indminor(lay)+1,ig)) + absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1) + taug(lay,ngs2+ig) = speccomb(lay) * & + (fac000(lay) * absb(ind0(lay),ig) + & + fac100(lay) * absb(ind0(lay)+1,ig) + & + fac010(lay) * absb(ind0(lay)+5,ig) + & + fac110(lay) * absb(ind0(lay)+6,ig)) & + + speccomb1(lay) * & + (fac001(lay) * absb(ind1(lay),ig) + & + fac101(lay) * absb(ind1(lay)+1,ig) + & + fac011(lay) * absb(ind1(lay)+5,ig) + & + fac111(lay) * absb(ind1(lay)+6,ig)) & + + taufor & + + adjcoln2o(lay)*absn2o + fracs(lay,ngs2+ig) = fracrefb(ig,jpl(lay)) + fpl(lay) * & + (fracrefb(ig,jpl(lay)+1)-fracrefb(ig,jpl(lay))) + enddo + enddo + + end subroutine taugb3 + +!---------------------------------------------------------------------------- + subroutine taugb4 +!---------------------------------------------------------------------------- +! +! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng4, ngs3 + use rrlw_ref, only : chi_mls + use rrlw_kg04, only : fracrefa, fracrefb, absa, absb, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor + real(kind=r8) :: refrat_planck_a, refrat_planck_b + real(kind=r8) :: tau_major, tau_major1 + + +! P = 142.5940 mb + refrat_planck_a = chi_mls(1,11)/chi_mls(2,11) + +! P = 95.58350 mb + refrat_planck_b = chi_mls(3,13)/chi_mls(2,13) + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated (in temperature) +! separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2oco2(lay)*colco2(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colco2(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(4) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(4) + js1(lay) + enddo + do lay = 1, laytrop + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng4 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs3+ig) = tau_major + tau_major1 & + + tauself + taufor + fracs(lay,ngs3+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + + speccomb(lay) = colo3(lay) + rat_o3co2(lay)*colco2(lay) + specparm(lay) = colo3(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 4._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colo3(lay) + rat_o3co2_1(lay)*colco2(lay) + specparm1(lay) = colo3(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 4._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + + speccomb_planck(lay) = colo3(lay)+refrat_planck_b*colco2(lay) + specparm_planck(lay) = colo3(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 4._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(4) + js(lay) + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(4) + js1(lay) + do ig = 1, ng4 + taug(lay,ngs3+ig) = speccomb(lay) * & + (fac000(lay) * absb(ind0(lay),ig) + & + fac100(lay) * absb(ind0(lay)+1,ig) + & + fac010(lay) * absb(ind0(lay)+5,ig) + & + fac110(lay) * absb(ind0(lay)+6,ig)) & + + speccomb1(lay) * & + (fac001(lay) * absb(ind1(lay),ig) + & + fac101(lay) * absb(ind1(lay)+1,ig) + & + fac011(lay) * absb(ind1(lay)+5,ig) + & + fac111(lay) * absb(ind1(lay)+6,ig)) + fracs(lay,ngs3+ig) = fracrefb(ig,jpl(lay)) + fpl(lay) * & + (fracrefb(ig,jpl(lay)+1)-fracrefb(ig,jpl(lay))) + enddo + +! Empirical modification to code to improve stratospheric cooling rates +! for co2. Revised to apply weighting for g-point reduction in this band. + + taug(lay,ngs3+8)=taug(lay,ngs3+8)*0.92 + taug(lay,ngs3+9)=taug(lay,ngs3+9)*0.88 + taug(lay,ngs3+10)=taug(lay,ngs3+10)*1.07 + taug(lay,ngs3+11)=taug(lay,ngs3+11)*1.1 + taug(lay,ngs3+12)=taug(lay,ngs3+12)*0.99 + taug(lay,ngs3+13)=taug(lay,ngs3+13)*0.88 + taug(lay,ngs3+14)=taug(lay,ngs3+14)*0.943 + + enddo + + end subroutine taugb4 + +!---------------------------------------------------------------------------- + subroutine taugb5 +!---------------------------------------------------------------------------- +! +! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) +! (high key - o3,co2) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng5, ngs4 + use rrlw_ref, only : chi_mls + use rrlw_kg05, only : fracrefa, fracrefb, absa, absb, & + ka_mo3, selfref, forref, ccl4 + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmo3, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mo3, specparm_mo3, specmult_mo3, fmo3 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor, o3m1, o3m2, abso3 + real(kind=r8) :: refrat_planck_a, refrat_planck_b, refrat_m_a + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping level : +! lower - o3, p = 317.34 mbar, t = 240.77 k +! lower - ccl4 + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + +! P = 473.420 mb + refrat_planck_a = chi_mls(1,5)/chi_mls(2,5) + +! P = 0.2369 mb + refrat_planck_b = chi_mls(3,43)/chi_mls(2,43) + +! P = 317.3480 + refrat_m_a = chi_mls(1,7)/chi_mls(2,7) + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature, and appropriate species. Below laytrop, the +! water vapor self-continuum and foreign continuum is +! interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2oco2(lay)*colco2(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mo3(lay) = colh2o(lay) + refrat_m_a*colco2(lay) + specparm_mo3(lay) = colh2o(lay)/speccomb_mo3(lay) + if (specparm_mo3(lay) .ge. oneminus) specparm_mo3(lay) = oneminus + specmult_mo3(lay) = 8._r8*specparm_mo3(lay) + jmo3(lay) = 1 + int(specmult_mo3(lay)) + fmo3(lay) = mod(specmult_mo3(lay),1.0_r8) + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colco2(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(5) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(5) + js1(lay) + enddo + do lay = 1, laytrop + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng5 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + o3m1 = ka_mo3(jmo3(lay),indminor(lay),ig) + fmo3(lay) * & + (ka_mo3(jmo3(lay)+1,indminor(lay),ig)-ka_mo3(jmo3(lay),indminor(lay),ig)) + o3m2 = ka_mo3(jmo3(lay),indminor(lay)+1,ig) + fmo3(lay) * & + (ka_mo3(jmo3(lay)+1,indminor(lay)+1,ig)-ka_mo3(jmo3(lay),indminor(lay)+1,ig)) + abso3 = o3m1 + minorfrac(lay)*(o3m2-o3m1) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs4+ig) = tau_major + tau_major1 & + + tauself + taufor & + + abso3*colo3(lay) & + + wx(1,lay) * ccl4(ig) + fracs(lay,ngs4+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + + speccomb(lay) = colo3(lay) + rat_o3co2(lay)*colco2(lay) + specparm(lay) = colo3(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 4._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colo3(lay) + rat_o3co2_1(lay)*colco2(lay) + specparm1(lay) = colo3(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 4._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + + speccomb_planck(lay) = colo3(lay)+refrat_planck_b*colco2(lay) + specparm_planck(lay) = colo3(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 4._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(5) + js(lay) + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(5) + js1(lay) + enddo + do lay = laytrop+1, nlayers + do ig = 1, ng5 + taug(lay,ngs4+ig) = speccomb(lay) * & + (fac000(lay) * absb(ind0(lay),ig) + & + fac100(lay) * absb(ind0(lay)+1,ig) + & + fac010(lay) * absb(ind0(lay)+5,ig) + & + fac110(lay) * absb(ind0(lay)+6,ig)) & + + speccomb1(lay) * & + (fac001(lay) * absb(ind1(lay),ig) + & + fac101(lay) * absb(ind1(lay)+1,ig) + & + fac011(lay) * absb(ind1(lay)+5,ig) + & + fac111(lay) * absb(ind1(lay)+6,ig)) & + + wx(1,lay) * ccl4(ig) + fracs(lay,ngs4+ig) = fracrefb(ig,jpl(lay)) + fpl(lay) * & + (fracrefb(ig,jpl(lay)+1)-fracrefb(ig,jpl(lay))) + enddo + enddo + + end subroutine taugb5 + +!---------------------------------------------------------------------------- + subroutine taugb6 +!---------------------------------------------------------------------------- +! +! band 6: 820-980 cm-1 (low key - h2o; low minor - co2) +! (high key - nothing; high minor - cfc11, cfc12) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng6, ngs5 + use rrlw_ref, only : chi_mls + use rrlw_kg06, only : fracrefa, absa, ka_mco2, & + selfref, forref, cfc11adj, cfc12 + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8), dimension(nlayers) :: chi_co2, ratco2, adjfac, adjcolco2 + real(kind=r8) :: tauself, taufor, absco2 + + +! Minor gas mapping level: +! lower - co2, p = 706.2720 mb, t = 294.2 k +! upper - cfc11, cfc12 + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. The water vapor self-continuum and foreign continuum +! is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/(coldry(lay)) + ratco2(lay) = 1.e20_r8*chi_co2(lay)/chi_mls(2,jp(lay)+1) + enddo + do lay = 1, laytrop + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 2.0_r8+(ratco2(lay)-2.0_r8)**0.77_r8 + adjcolco2(lay) = adjfac(lay)*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + enddo + do lay = 1, laytrop + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(6) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(6) + 1 + enddo + do lay = 1, laytrop + + do ig = 1, ng6 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + absco2 = (ka_mco2(indminor(lay),ig) + minorfrac(lay) * & + (ka_mco2(indminor(lay)+1,ig) - ka_mco2(indminor(lay),ig))) + taug(lay,ngs5+ig) = colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor & + + adjcolco2(lay) * absco2 & + + wx(2,lay) * cfc11adj(ig) & + + wx(3,lay) * cfc12(ig) + fracs(lay,ngs5+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop +! Nothing important goes on above laytrop in this band. + do lay = laytrop+1, nlayers + + do ig = 1, ng6 + taug(lay,ngs5+ig) = 0.0_r8 & + + wx(2,lay) * cfc11adj(ig) & + + wx(3,lay) * cfc12(ig) + fracs(lay,ngs5+ig) = fracrefa(ig) + enddo + enddo + + end subroutine taugb6 + +!---------------------------------------------------------------------------- + subroutine taugb7 +!---------------------------------------------------------------------------- +! +! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) +! (high key - o3; high minor - co2) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng7, ngs6 + use rrlw_ref, only : chi_mls + use rrlw_kg07, only : fracrefa, fracrefb, absa, absb, & + ka_mco2, kb_mco2, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmco2, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor, co2m1, co2m2, absco2 + real(kind=r8), dimension(nlayers) :: chi_co2, ratco2, adjfac, adjcolco2 + real(kind=r8) :: refrat_planck_a, refrat_m_a + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping level : +! lower - co2, p = 706.2620 mbar, t= 278.94 k +! upper - co2, p = 12.9350 mbar, t = 234.01 k + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. + +! P = 706.2620 mb + refrat_planck_a = chi_mls(1,3)/chi_mls(3,3) + +! P = 706.2720 mb + refrat_m_a = chi_mls(1,3)/chi_mls(3,3) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2oo3(lay)*colo3(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oo3_1(lay)*colo3(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mco2(lay) = colh2o(lay) + refrat_m_a*colo3(lay) + specparm_mco2(lay) = colh2o(lay)/speccomb_mco2(lay) + if (specparm_mco2(lay) .ge. oneminus) specparm_mco2(lay) = oneminus + specmult_mco2(lay) = 8._r8*specparm_mco2(lay) + + jmco2(lay) = 1 + int(specmult_mco2(lay)) + fmco2(lay) = mod(specmult_mco2(lay),1.0_r8) + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/(coldry(lay)) + ratco2(lay) = 1.e20*chi_co2(lay)/chi_mls(2,jp(lay)+1) + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 3.0_r8+(ratco2(lay)-3.0_r8)**0.79_r8 + adjcolco2(lay) = adjfac(lay)*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colo3(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(7) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(7) + js1(lay) + + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + if (specparm(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + + do ig = 1, ng7 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + co2m1 = ka_mco2(jmco2(lay),indminor(lay),ig) + fmco2(lay) * & + (ka_mco2(jmco2(lay)+1,indminor(lay),ig) - ka_mco2(jmco2(lay),indminor(lay),ig)) + co2m2 = ka_mco2(jmco2(lay),indminor(lay)+1,ig) + fmco2(lay) * & + (ka_mco2(jmco2(lay)+1,indminor(lay)+1,ig) - ka_mco2(jmco2(lay),indminor(lay)+1,ig)) + absco2 = co2m1 + minorfrac(lay) * (co2m2 - co2m1) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs6+ig) = tau_major + tau_major1 & + + tauself + taufor & + + adjcolco2(lay)*absco2 + fracs(lay,ngs6+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/(coldry(lay)) + ratco2(lay) = 1.e20*chi_co2(lay)/chi_mls(2,jp(lay)+1) + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 2.0_r8+(ratco2(lay)-2.0_r8)**0.79_r8 + adjcolco2(lay) = adjfac(lay)*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(7) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(7) + 1 + + do ig = 1, ng7 + absco2 = kb_mco2(indminor(lay),ig) + minorfrac(lay) * & + (kb_mco2(indminor(lay)+1,ig) - kb_mco2(indminor(lay),ig)) + taug(lay,ngs6+ig) = colo3(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + adjcolco2(lay) * absco2 + fracs(lay,ngs6+ig) = fracrefb(ig) + enddo + +! Empirical modification to code to improve stratospheric cooling rates +! for o3. Revised to apply weighting for g-point reduction in this band. + + taug(lay,ngs6+6)=taug(lay,ngs6+6)*0.92_r8 + taug(lay,ngs6+7)=taug(lay,ngs6+7)*0.88_r8 + taug(lay,ngs6+8)=taug(lay,ngs6+8)*1.07_r8 + taug(lay,ngs6+9)=taug(lay,ngs6+9)*1.1_r8 + taug(lay,ngs6+10)=taug(lay,ngs6+10)*0.99_r8 + taug(lay,ngs6+11)=taug(lay,ngs6+11)*0.855_r8 + + enddo + + end subroutine taugb7 + +!---------------------------------------------------------------------------- + subroutine taugb8 +!---------------------------------------------------------------------------- +! +! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) +! (high key - o3; high minor - co2, n2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng8, ngs7 + use rrlw_ref, only : chi_mls + use rrlw_kg08, only : fracrefa, fracrefb, absa, absb, & + ka_mco2, ka_mn2o, ka_mo3, kb_mco2, kb_mn2o, & + selfref, forref, cfc12, cfc22adj + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: tauself, taufor, absco2, abso3, absn2o + real(kind=r8), dimension(nlayers) :: chi_co2, ratco2, adjfac, adjcolco2 + + +! Minor gas mapping level: +! lower - co2, p = 1053.63 mb, t = 294.2 k +! lower - o3, p = 317.348 mb, t = 240.77 k +! lower - n2o, p = 706.2720 mb, t= 278.94 k +! lower - cfc12,cfc11 +! upper - co2, p = 35.1632 mb, t = 223.28 k +! upper - n2o, p = 8.716e-2 mb, t = 226.03 k + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature, and appropriate species. Below laytrop, the water vapor +! self-continuum and foreign continuum is interpolated (in temperature) +! separately. + +! Lower atmosphere loop + do lay = 1, laytrop + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/(coldry(lay)) + ratco2(lay) = 1.e20_r8*chi_co2(lay)/chi_mls(2,jp(lay)+1) + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 2.0_r8+(ratco2(lay)-2.0_r8)**0.65_r8 + adjcolco2(lay) = adjfac(lay)*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(8) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(8) + 1 + + do ig = 1, ng8 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + absco2 = (ka_mco2(indminor(lay),ig) + minorfrac(lay) * & + (ka_mco2(indminor(lay)+1,ig) - ka_mco2(indminor(lay),ig))) + abso3 = (ka_mo3(indminor(lay),ig) + minorfrac(lay) * & + (ka_mo3(indminor(lay)+1,ig) - ka_mo3(indminor(lay),ig))) + absn2o = (ka_mn2o(indminor(lay),ig) + minorfrac(lay) * & + (ka_mn2o(indminor(lay)+1,ig) - ka_mn2o(indminor(lay),ig))) + taug(lay,ngs7+ig) = colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor & + + adjcolco2(lay)*absco2 & + + colo3(lay) * abso3 & + + coln2o(lay) * absn2o & + + wx(3,lay) * cfc12(ig) & + + wx(4,lay) * cfc22adj(ig) + fracs(lay,ngs7+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/coldry(lay) + ratco2(lay) = 1.e20_r8*chi_co2(lay)/chi_mls(2,jp(lay)+1) + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 2.0_r8+(ratco2(lay)-2.0_r8)**0.65_r8 + adjcolco2(lay) = adjfac(lay)*chi_mls(2,jp(lay)+1) * coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(8) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(8) + 1 + + do ig = 1, ng8 + absco2 = (kb_mco2(indminor(lay),ig) + minorfrac(lay) * & + (kb_mco2(indminor(lay)+1,ig) - kb_mco2(indminor(lay),ig))) + absn2o = (kb_mn2o(indminor(lay),ig) + minorfrac(lay) * & + (kb_mn2o(indminor(lay)+1,ig) - kb_mn2o(indminor(lay),ig))) + taug(lay,ngs7+ig) = colo3(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + adjcolco2(lay)*absco2 & + + coln2o(lay)*absn2o & + + wx(3,lay) * cfc12(ig) & + + wx(4,lay) * cfc22adj(ig) + fracs(lay,ngs7+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb8 + +!---------------------------------------------------------------------------- + subroutine taugb9 +!---------------------------------------------------------------------------- +! +! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) +! (high key - ch4; high minor - n2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng9, ngs8 + use rrlw_ref, only : chi_mls + use rrlw_kg09, only : fracrefa, fracrefb, absa, absb, & + ka_mn2o, kb_mn2o, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmn2o, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor, n2om1, n2om2, absn2o + real(kind=r8), dimension(nlayers) :: chi_n2o, ratn2o, adjfac, adjcoln2o + real(kind=r8) :: refrat_planck_a, refrat_m_a + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping level : +! lower - n2o, p = 706.272 mbar, t = 278.94 k +! upper - n2o, p = 95.58 mbar, t = 215.7 k + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + +! P = 212 mb + refrat_planck_a = chi_mls(1,9)/chi_mls(6,9) + +! P = 706.272 mb + refrat_m_a = chi_mls(1,3)/chi_mls(6,3) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2och4(lay)*colch4(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2och4_1(lay)*colch4(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mn2o(lay) = colh2o(lay) + refrat_m_a*colch4(lay) + specparm_mn2o(lay) = colh2o(lay)/speccomb_mn2o(lay) + if (specparm_mn2o(lay) .ge. oneminus) specparm_mn2o(lay) = oneminus + specmult_mn2o(lay) = 8._r8*specparm_mn2o(lay) + jmn2o(lay) = 1 + int(specmult_mn2o(lay)) + fmn2o(lay) = mod(specmult_mn2o(lay),1.0_r8) + +! In atmospheres where the amount of N2O is too great to be considered +! a minor species, adjust the column amount of N2O by an empirical factor +! to obtain the proper contribution. + chi_n2o(lay) = coln2o(lay)/(coldry(lay)) + ratn2o(lay) = 1.e20_r8*chi_n2o(lay)/chi_mls(4,jp(lay)+1) + if (ratn2o(lay) .gt. 1.5_r8) then + adjfac(lay) = 0.5_r8+(ratn2o(lay)-0.5_r8)**0.65_r8 + adjcoln2o(lay) = adjfac(lay)*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcoln2o(lay) = coln2o(lay) + endif + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colch4(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(9) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(9) + js1(lay) + + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + + do ig = 1, ng9 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + n2om1 = ka_mn2o(jmn2o(lay),indminor(lay),ig) + fmn2o(lay) * & + (ka_mn2o(jmn2o(lay)+1,indminor(lay),ig) - ka_mn2o(jmn2o(lay),indminor(lay),ig)) + n2om2 = ka_mn2o(jmn2o(lay),indminor(lay)+1,ig) + fmn2o(lay) * & + (ka_mn2o(jmn2o(lay)+1,indminor(lay)+1,ig) - ka_mn2o(jmn2o(lay),indminor(lay)+1,ig)) + absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs8+ig) = tau_major + tau_major1 & + + tauself + taufor & + + adjcoln2o(lay)*absn2o + fracs(lay,ngs8+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + +! In atmospheres where the amount of N2O is too great to be considered +! a minor species, adjust the column amount of N2O by an empirical factor +! to obtain the proper contribution. + chi_n2o(lay) = coln2o(lay)/(coldry(lay)) + ratn2o(lay) = 1.e20_r8*chi_n2o(lay)/chi_mls(4,jp(lay)+1) + if (ratn2o(lay) .gt. 1.5_r8) then + adjfac(lay) = 0.5_r8+(ratn2o(lay)-0.5_r8)**0.65_r8 + adjcoln2o(lay) = adjfac(lay)*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_r8 + else + adjcoln2o(lay) = coln2o(lay) + endif + + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(9) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(9) + 1 + + do ig = 1, ng9 + absn2o = kb_mn2o(indminor(lay),ig) + minorfrac(lay) * & + (kb_mn2o(indminor(lay)+1,ig) - kb_mn2o(indminor(lay),ig)) + taug(lay,ngs8+ig) = colch4(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + adjcoln2o(lay)*absn2o + fracs(lay,ngs8+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb9 + +!---------------------------------------------------------------------------- + subroutine taugb10 +!---------------------------------------------------------------------------- +! +! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng10, ngs9 + use rrlw_kg10, only : fracrefa, fracrefb, absa, absb, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: tauself, taufor + + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. Below laytrop, the water vapor self-continuum and +! foreign continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(10) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(10) + 1 + + do ig = 1, ng10 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taug(lay,ngs9+ig) = colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor + fracs(lay,ngs9+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(10) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(10) + 1 + + do ig = 1, ng10 + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taug(lay,ngs9+ig) = colh2o(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + taufor + fracs(lay,ngs9+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb10 + +!---------------------------------------------------------------------------- + subroutine taugb11 +!---------------------------------------------------------------------------- +! +! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) +! (high key - h2o; high minor - o2) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng11, ngs10 + use rrlw_kg11, only : fracrefa, fracrefb, absa, absb, & + ka_mo2, kb_mo2, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: scaleo2(nlayers), tauself, taufor, tauo2 + + +! Minor gas mapping level : +! lower - o2, p = 706.2720 mbar, t = 278.94 k +! upper - o2, p = 4.758820 mbarm t = 250.85 k + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. Below laytrop, the water vapor self-continuum and +! foreign continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(11) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(11) + 1 + scaleo2(lay) = colo2(lay)*scaleminor(lay) + do ig = 1, ng11 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + tauo2 = scaleo2(lay) * (ka_mo2(indminor(lay),ig) + minorfrac(lay) * & + (ka_mo2(indminor(lay)+1,ig) - ka_mo2(indminor(lay),ig))) + taug(lay,ngs10+ig) = colh2o(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor & + + tauo2 + fracs(lay,ngs10+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(11) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(11) + 1 + scaleo2(lay) = colo2(lay)*scaleminor(lay) + do ig = 1, ng11 + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + tauo2 = scaleo2(lay) * (kb_mo2(indminor(lay),ig) + minorfrac(lay) * & + (kb_mo2(indminor(lay)+1,ig) - kb_mo2(indminor(lay),ig))) + taug(lay,ngs10+ig) = colh2o(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) & + + taufor & + + tauo2 + fracs(lay,ngs10+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb11 + +!---------------------------------------------------------------------------- + subroutine taugb12 +!---------------------------------------------------------------------------- +! +! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng12, ngs11 + use rrlw_ref, only : chi_mls + use rrlw_kg12, only : fracrefa, absa, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor + real(kind=r8) :: refrat_planck_a + real(kind=r8) :: tau_major, tau_major1 + + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + +! P = 174.164 mb + refrat_planck_a = chi_mls(1,10)/chi_mls(2,10) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum adn foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2oco2(lay)*colco2(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colco2(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(12) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(12) + js1(lay) + enddo + do lay = 1, laytrop + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + + enddo + do lay = 1, laytrop + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng12 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs11+ig) = tau_major + tau_major1 & + + tauself + taufor + fracs(lay,ngs11+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng12 + taug(lay,ngs11+ig) = 0.0_r8 + fracs(lay,ngs11+ig) = 0.0_r8 + enddo + enddo + + end subroutine taugb12 + +!---------------------------------------------------------------------------- + subroutine taugb13 +!---------------------------------------------------------------------------- +! +! band 13: 2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng13, ngs12 + use rrlw_ref, only : chi_mls + use rrlw_kg13, only : fracrefa, fracrefb, absa, & + ka_mco2, ka_mco, kb_mo3, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmco2, jmco, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2 + real(kind=r8), dimension(nlayers) :: speccomb_mco, specparm_mco, specmult_mco, fmco + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor, co2m1, co2m2, absco2 + real(kind=r8) :: com1, com2, absco, abso3 + real(kind=r8), dimension(nlayers) :: chi_co2, ratco2, adjfac, adjcolco2 + real(kind=r8) :: refrat_planck_a, refrat_m_a, refrat_m_a3 + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping levels : +! lower - co2, p = 1053.63 mb, t = 294.2 k +! lower - co, p = 706 mb, t = 278.94 k +! upper - o3, p = 95.5835 mb, t = 215.7 k + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + +! P = 473.420 mb (Level 5) + refrat_planck_a = chi_mls(1,5)/chi_mls(4,5) + +! P = 1053. (Level 1) + refrat_m_a = chi_mls(1,1)/chi_mls(4,1) + +! P = 706. (Level 3) + refrat_m_a3 = chi_mls(1,3)/chi_mls(4,3) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2on2o(lay)*coln2o(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2on2o_1(lay)*coln2o(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mco2(lay) = colh2o(lay) + refrat_m_a*coln2o(lay) + specparm_mco2(lay) = colh2o(lay)/speccomb_mco2(lay) + if (specparm_mco2(lay) .ge. oneminus) specparm_mco2(lay) = oneminus + specmult_mco2(lay) = 8._r8*specparm_mco2(lay) + jmco2(lay) = 1 + int(specmult_mco2(lay)) + fmco2(lay) = mod(specmult_mco2(lay),1.0_r8) + +! In atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + chi_co2(lay) = colco2(lay)/(coldry(lay)) + ratco2(lay) = 1.e20_r8*chi_co2(lay)/3.55e-4_r8 + enddo + do lay = 1, laytrop + if (ratco2(lay) .gt. 3.0_r8) then + adjfac(lay) = 2.0_r8+(ratco2(lay)-2.0_r8)**0.68_r8 + adjcolco2(lay) = adjfac(lay)*3.55e-4*coldry(lay)*1.e-20_r8 + else + adjcolco2(lay) = colco2(lay) + endif + + enddo + do lay = 1, laytrop + speccomb_mco(lay) = colh2o(lay) + refrat_m_a3*coln2o(lay) + specparm_mco(lay) = colh2o(lay)/speccomb_mco(lay) + if (specparm_mco(lay) .ge. oneminus) specparm_mco(lay) = oneminus + specmult_mco(lay) = 8._r8*specparm_mco(lay) + jmco(lay) = 1 + int(specmult_mco(lay)) + fmco(lay) = mod(specmult_mco(lay),1.0_r8) + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*coln2o(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(13) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(13) + js1(lay) + enddo + do lay = 1, laytrop + + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + + enddo + do lay = 1, laytrop + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng13 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + co2m1 = ka_mco2(jmco2(lay),indminor(lay),ig) + fmco2(lay) * & + (ka_mco2(jmco2(lay)+1,indminor(lay),ig) - ka_mco2(jmco2(lay),indminor(lay),ig)) + co2m2 = ka_mco2(jmco2(lay),indminor(lay)+1,ig) + fmco2(lay) * & + (ka_mco2(jmco2(lay)+1,indminor(lay)+1,ig) - ka_mco2(jmco2(lay),indminor(lay)+1,ig)) + absco2 = co2m1 + minorfrac(lay) * (co2m2 - co2m1) + com1 = ka_mco(jmco(lay),indminor(lay),ig) + fmco(lay) * & + (ka_mco(jmco(lay)+1,indminor(lay),ig) - ka_mco(jmco(lay),indminor(lay),ig)) + com2 = ka_mco(jmco(lay),indminor(lay)+1,ig) + fmco(lay) * & + (ka_mco(jmco(lay)+1,indminor(lay)+1,ig) - ka_mco(jmco(lay),indminor(lay)+1,ig)) + absco = com1 + minorfrac(lay) * (com2 - com1) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs12+ig) = tau_major + tau_major1 & + + tauself + taufor & + + adjcolco2(lay)*absco2 & + + colco(lay)*absco + fracs(lay,ngs12+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng13 + abso3 = kb_mo3(indminor(lay),ig) + minorfrac(lay) * & + (kb_mo3(indminor(lay)+1,ig) - kb_mo3(indminor(lay),ig)) + taug(lay,ngs12+ig) = colo3(lay)*abso3 + fracs(lay,ngs12+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb13 + +!---------------------------------------------------------------------------- + subroutine taugb14 +!---------------------------------------------------------------------------- +! +! band 14: 2250-2380 cm-1 (low - co2; high - co2) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng14, ngs13 + use rrlw_kg14, only : fracrefa, fracrefb, absa, absb, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + real(kind=r8) :: tauself, taufor + + +! Compute the optical depth by interpolating in ln(pressure) and +! temperature. Below laytrop, the water vapor self-continuum +! and foreign continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(14) + 1 + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(14) + 1 + do ig = 1, ng14 + tauself = selffac(lay) * (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + taug(lay,ngs13+ig) = colco2(lay) * & + (fac00(lay) * absa(ind0(lay),ig) + & + fac10(lay) * absa(ind0(lay)+1,ig) + & + fac01(lay) * absa(ind1(lay),ig) + & + fac11(lay) * absa(ind1(lay)+1,ig)) & + + tauself + taufor + fracs(lay,ngs13+ig) = fracrefa(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(14) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(14) + 1 + do ig = 1, ng14 + taug(lay,ngs13+ig) = colco2(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) + fracs(lay,ngs13+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb14 + +!---------------------------------------------------------------------------- + subroutine taugb15 +!---------------------------------------------------------------------------- +! +! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) +! (high - nothing) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng15, ngs14 + use rrlw_ref, only : chi_mls + use rrlw_kg15, only : fracrefa, absa, & + ka_mn2, selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jmn2, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_mn2, specparm_mn2, specmult_mn2, fmn2 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: scalen2(nlayers), tauself, taufor, n2m1, n2m2, taun2 + real(kind=r8) :: refrat_planck_a, refrat_m_a + real(kind=r8) :: tau_major, tau_major1 + + +! Minor gas mapping level : +! Lower - Nitrogen Continuum, P = 1053., T = 294. + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. +! P = 1053. mb (Level 1) + refrat_planck_a = chi_mls(4,1)/chi_mls(2,1) + +! P = 1053. + refrat_m_a = chi_mls(4,1)/chi_mls(2,1) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = coln2o(lay) + rat_n2oco2(lay)*colco2(lay) + specparm(lay) = coln2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = coln2o(lay) + rat_n2oco2_1(lay)*colco2(lay) + specparm1(lay) = coln2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_mn2(lay) = coln2o(lay) + refrat_m_a*colco2(lay) + specparm_mn2(lay) = coln2o(lay)/speccomb_mn2(lay) + if (specparm_mn2(lay) .ge. oneminus) specparm_mn2(lay) = oneminus + specmult_mn2(lay) = 8._r8*specparm_mn2(lay) + jmn2(lay) = 1 + int(specmult_mn2(lay)) + fmn2(lay) = mod(specmult_mn2(lay),1.0_r8) + + speccomb_planck(lay) = coln2o(lay)+refrat_planck_a*colco2(lay) + specparm_planck(lay) = coln2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(15) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(15) + js1(lay) + + scalen2(lay) = colbrd(lay)*scaleminor(lay) + enddo + do lay = 1, laytrop + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + enddo + do lay = 1, laytrop + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + + enddo + do lay = 1, laytrop + do ig = 1, ng15 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + n2m1 = ka_mn2(jmn2(lay),indminor(lay),ig) + fmn2(lay) * & + (ka_mn2(jmn2(lay)+1,indminor(lay),ig) - ka_mn2(jmn2(lay),indminor(lay),ig)) + n2m2 = ka_mn2(jmn2(lay),indminor(lay)+1,ig) + fmn2(lay) * & + (ka_mn2(jmn2(lay)+1,indminor(lay)+1,ig) - ka_mn2(jmn2(lay),indminor(lay)+1,ig)) + taun2 = scalen2(lay) * (n2m1 + minorfrac(lay) * (n2m2 - n2m1)) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs14+ig) = tau_major + tau_major1 & + + tauself + taufor & + + taun2 + fracs(lay,ngs14+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng15 + taug(lay,ngs14+ig) = 0.0_r8 + fracs(lay,ngs14+ig) = 0.0_r8 + enddo + enddo + + end subroutine taugb15 + +!---------------------------------------------------------------------------- + subroutine taugb16 +!---------------------------------------------------------------------------- +! +! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrtm, only : ng16, ngs15 + use rrlw_ref, only : chi_mls + use rrlw_kg16, only : fracrefa, fracrefb, absa, absb, & + selfref, forref + +! ------- Declarations ------- + +! Local + integer :: lay, ind0(nlayers), ind1(nlayers), ig + integer, dimension(nlayers) :: js, js1, jpl + real(kind=r8), dimension(nlayers) :: speccomb, specparm, specmult, fs + real(kind=r8), dimension(nlayers) :: speccomb1, specparm1, specmult1, fs1 + real(kind=r8), dimension(nlayers) :: speccomb_planck, specparm_planck, specmult_planck, fpl + real(kind=r8) :: p, p4, fk0, fk1, fk2 + real(kind=r8), dimension(nlayers) :: fac000, fac100, fac200, fac010, fac110, fac210 + real(kind=r8), dimension(nlayers) :: fac001, fac101, fac201, fac011, fac111, fac211 + real(kind=r8) :: tauself, taufor + real(kind=r8) :: refrat_planck_a + real(kind=r8) :: tau_major, tau_major1 + + +! Calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. + +! P = 387. mb (Level 6) + refrat_planck_a = chi_mls(1,6)/chi_mls(6,6) + +! Compute the optical depth by interpolating in ln(pressure), +! temperature,and appropriate species. Below laytrop, the water +! vapor self-continuum and foreign continuum is interpolated +! (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + + speccomb(lay) = colh2o(lay) + rat_h2och4(lay)*colch4(lay) + specparm(lay) = colh2o(lay)/speccomb(lay) + if (specparm(lay) .ge. oneminus) specparm(lay) = oneminus + specmult(lay) = 8._r8*(specparm(lay)) + js(lay) = 1 + int(specmult(lay)) + fs(lay) = mod(specmult(lay),1.0_r8) + + speccomb1(lay) = colh2o(lay) + rat_h2och4_1(lay)*colch4(lay) + specparm1(lay) = colh2o(lay)/speccomb1(lay) + if (specparm1(lay) .ge. oneminus) specparm1(lay) = oneminus + specmult1(lay) = 8._r8*(specparm1(lay)) + js1(lay) = 1 + int(specmult1(lay)) + fs1(lay) = mod(specmult1(lay),1.0_r8) + + speccomb_planck(lay) = colh2o(lay)+refrat_planck_a*colch4(lay) + specparm_planck(lay) = colh2o(lay)/speccomb_planck(lay) + if (specparm_planck(lay) .ge. oneminus) specparm_planck(lay)=oneminus + specmult_planck(lay) = 8._r8*specparm_planck(lay) + jpl(lay)= 1 + int(specmult_planck(lay)) + fpl(lay) = mod(specmult_planck(lay),1.0_r8) + + ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js(lay) + ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js1(lay) + enddo + do lay = 1, laytrop + if (specparm(lay) .lt. 0.125_r8) then + p = fs(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else if (specparm(lay) .gt. 0.875_r8) then + p = -fs(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac000(lay) = fk0*fac00(lay) + fac100(lay) = fk1*fac00(lay) + fac200(lay) = fk2*fac00(lay) + fac010(lay) = fk0*fac10(lay) + fac110(lay) = fk1*fac10(lay) + fac210(lay) = fk2*fac10(lay) + else + fac000(lay) = (1._r8 - fs(lay)) * fac00(lay) + fac010(lay) = (1._r8 - fs(lay)) * fac10(lay) + fac100(lay) = fs(lay) * fac00(lay) + fac110(lay) = fs(lay) * fac10(lay) + endif + enddo + do lay = 1, laytrop + + if (specparm1(lay) .lt. 0.125_r8) then + p = fs1(lay) - 1 + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else if (specparm1(lay) .gt. 0.875_r8) then + p = -fs1(lay) + p4 = p**4 + fk0 = p4 + fk1 = 1 - p - 2.0_r8*p4 + fk2 = p + p4 + fac001(lay) = fk0*fac01(lay) + fac101(lay) = fk1*fac01(lay) + fac201(lay) = fk2*fac01(lay) + fac011(lay) = fk0*fac11(lay) + fac111(lay) = fk1*fac11(lay) + fac211(lay) = fk2*fac11(lay) + else + fac001(lay) = (1._r8 - fs1(lay)) * fac01(lay) + fac011(lay) = (1._r8 - fs1(lay)) * fac11(lay) + fac101(lay) = fs1(lay) * fac01(lay) + fac111(lay) = fs1(lay) * fac11(lay) + endif + enddo + do lay = 1, laytrop + + do ig = 1, ng16 + tauself = selffac(lay)* (selfref(indself(lay),ig) + selffrac(lay) * & + (selfref(indself(lay)+1,ig) - selfref(indself(lay),ig))) + taufor = forfac(lay) * (forref(indfor(lay),ig) + forfrac(lay) * & + (forref(indfor(lay)+1,ig) - forref(indfor(lay),ig))) + + if (specparm(lay) .lt. 0.125_r8) then + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac200(lay) * absa(ind0(lay)+2,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig) + & + fac210(lay) * absa(ind0(lay)+11,ig)) + else if (specparm(lay) .gt. 0.875_r8) then + tau_major = speccomb(lay) * & + (fac200(lay) * absa(ind0(lay)-1,ig) + & + fac100(lay) * absa(ind0(lay),ig) + & + fac000(lay) * absa(ind0(lay)+1,ig) + & + fac210(lay) * absa(ind0(lay)+8,ig) + & + fac110(lay) * absa(ind0(lay)+9,ig) + & + fac010(lay) * absa(ind0(lay)+10,ig)) + else + tau_major = speccomb(lay) * & + (fac000(lay) * absa(ind0(lay),ig) + & + fac100(lay) * absa(ind0(lay)+1,ig) + & + fac010(lay) * absa(ind0(lay)+9,ig) + & + fac110(lay) * absa(ind0(lay)+10,ig)) + endif + + if (specparm1(lay) .lt. 0.125_r8) then + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac201(lay) * absa(ind1(lay)+2,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig) + & + fac211(lay) * absa(ind1(lay)+11,ig)) + else if (specparm1(lay) .gt. 0.875_r8) then + tau_major1 = speccomb1(lay) * & + (fac201(lay) * absa(ind1(lay)-1,ig) + & + fac101(lay) * absa(ind1(lay),ig) + & + fac001(lay) * absa(ind1(lay)+1,ig) + & + fac211(lay) * absa(ind1(lay)+8,ig) + & + fac111(lay) * absa(ind1(lay)+9,ig) + & + fac011(lay) * absa(ind1(lay)+10,ig)) + else + tau_major1 = speccomb1(lay) * & + (fac001(lay) * absa(ind1(lay),ig) + & + fac101(lay) * absa(ind1(lay)+1,ig) + & + fac011(lay) * absa(ind1(lay)+9,ig) + & + fac111(lay) * absa(ind1(lay)+10,ig)) + endif + + taug(lay,ngs15+ig) = tau_major + tau_major1 & + + tauself + taufor + fracs(lay,ngs15+ig) = fracrefa(ig,jpl(lay)) + fpl(lay) * & + (fracrefa(ig,jpl(lay)+1)-fracrefa(ig,jpl(lay))) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1 + ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1 + enddo + do lay = laytrop+1, nlayers + do ig = 1, ng16 + taug(lay,ngs15+ig) = colch4(lay) * & + (fac00(lay) * absb(ind0(lay),ig) + & + fac10(lay) * absb(ind0(lay)+1,ig) + & + fac01(lay) * absb(ind1(lay),ig) + & + fac11(lay) * absb(ind1(lay)+1,ig)) + fracs(lay,ngs15+ig) = fracrefb(ig) + enddo + enddo + + end subroutine taugb16 + + end subroutine taumol + + end module rrtmg_lw_taumol + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 new file mode 100644 index 0000000000..389cf23a5c --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_cldprmc.f90 @@ -0,0 +1,119 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_cldprmc.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.4 $ +! created: $Date: 2008/01/03 21:35:36 $ + +module rrtmg_sw_cldprmc + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 + +use parrrsw, only: ngptsw + +implicit none + +!========================================================================================= +contains +!========================================================================================= + +subroutine cldprmc_sw(ncol,nlayers, inflag, iceflag, liqflag, zcldfmc, & + ciwpmc, clwpmc, reicmc, dgesmc, relqmc, & + ztaormc, ztaucmc, zssacmc, zasmcmc, fsfcmc) + + ! Purpose: Compute the cloud optical properties for each cloudy layer + ! and g-point interval for use by the McICA method. + ! Note: Only inflag = 0 and inflag=2/liqflag=1/iceflag=2,3 are available; + ! (Hu & Stamnes, Key, and Fu) are implemented. + + ! ------- Input ------- + + integer, intent(in) :: nlayers ! total number of layers + integer, intent(in) :: ncol ! total number of layers + integer, intent(in) :: inflag ! see definitions + integer, intent(in) :: iceflag ! see definitions + integer, intent(in) :: liqflag ! see definitions + + real(kind=r8), intent(in) :: zcldfmc(ncol,nlayers,ngptsw) ! cloud fraction [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: ciwpmc(ncol,ngptsw,nlayers) ! cloud ice water path [mcica] + ! Dimensions: (ncol,ngptsw,nlayers) + real(kind=r8), intent(in) :: clwpmc(ncol,ngptsw,nlayers) ! cloud liquid water path [mcica] + ! Dimensions: (ncol,ngptsw,nlayers) + real(kind=r8), intent(in) :: relqmc(ncol,nlayers) ! cloud liquid particle effective radius (microns) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: reicmc(ncol,nlayers) ! cloud ice particle effective radius (microns) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: dgesmc(ncol,nlayers) ! cloud ice particle generalized effective size (microns) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: fsfcmc(ncol,ngptsw,nlayers) ! cloud forward scattering fraction + ! Dimensions: (ncol,ngptsw,nlayers) + + ! ------- Output ------- + + real(kind=r8), intent(inout) :: ztaucmc(ncol,nlayers,ngptsw) ! cloud optical depth (delta scaled) + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(inout) :: zssacmc(ncol,nlayers,ngptsw) ! single scattering albedo (delta scaled) + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(inout) :: zasmcmc(ncol,nlayers,ngptsw) ! asymmetry parameter (delta scaled) + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(out) :: ztaormc(ncol,nlayers,ngptsw) ! cloud optical depth (non-delta scaled) + ! Dimensions: (ncol,nlayers,ngptsw) + + ! ------- Local ------- + + integer :: lay, ig, iplon + real(kind=r8), parameter :: eps = 1.e-06_r8 ! epsilon + real(kind=r8), parameter :: cldmin = 1.e-80_r8 ! minimum value for cloud quantities + real(kind=r8) :: cwp(ncol) ! total cloud water path + + real(kind=r8), dimension(ncol) :: taucldorig_a, taucloud_a, ssacloud_a, ffp, ffp1, ffpssa + !---------------------------------------------------------------------------- + + ! Main layer loop + do lay = 1, nlayers + + ! Main g-point interval loop + do ig = 1, ngptsw + + do iplon=1, ncol + + ztaormc(iplon,lay,ig) = ztaucmc(iplon,lay,ig) + cwp(iplon) = ciwpmc(iplon,ig,lay) + clwpmc(iplon,ig,lay) + if (zcldfmc(iplon,lay,ig) .ge. cldmin .and. & + (cwp(iplon) .ge. cldmin .or. ztaucmc(iplon,lay,ig) .ge. cldmin)) then + + ! (inflag=0): Cloud optical properties input directly + if (inflag .eq. 0) then + ! Cloud optical properties already defined in ztaucmc, zssacmc, zasmcmc are unscaled; + ! Apply delta-M scaling here (using Henyey-Greenstein approximation) + taucldorig_a(iplon) = ztaucmc(iplon,lay,ig) + ffp(iplon) = fsfcmc(iplon,ig,lay) + ffp1(iplon) = 1.0_r8 - ffp(iplon) + ffpssa(iplon) = 1.0_r8 - ffp(iplon) * zssacmc(iplon,lay,ig) + ssacloud_a(iplon) = ffp1(iplon) * zssacmc(iplon,lay,ig) / ffpssa(iplon) + taucloud_a(iplon) = ffpssa(iplon) * taucldorig_a(iplon) + + ztaormc(iplon,lay,ig) = taucldorig_a(iplon) + zssacmc(iplon,lay,ig) = ssacloud_a(iplon) + ztaucmc(iplon,lay,ig) = taucloud_a(iplon) + zasmcmc(iplon,lay,ig) = (zasmcmc(iplon,lay,ig) - ffp(iplon)) / (ffp1(iplon)) + + end if + end if + + end do + end do + end do + +end subroutine cldprmc_sw + +end module rrtmg_sw_cldprmc diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 new file mode 100644 index 0000000000..d71fa2a897 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 @@ -0,0 +1,1407 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_init.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:13 $ + + module rrtmg_sw_init + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_wvn + use rrtmg_sw_setcoef, only: swatmref + + implicit none + + contains + +! ************************************************************************** + subroutine rrtmg_sw_ini +! ************************************************************************** +! +! Original version: Michael J. Iacono; February, 2004 +! Revision for F90 formatting: M. J. Iacono, July, 2006 +! +! This subroutine performs calculations necessary for the initialization +! of the shortwave model. Lookup tables are computed for use in the SW +! radiative transfer, and input absorption coefficient data for each +! spectral band are reduced from 224 g-point intervals to 112. +! ************************************************************************** + + use parrrsw, only : mg, nbndsw, ngptsw + use rrsw_tbl, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl + +! ------- Local ------- + + integer :: ibnd, igc, ig, ind, ipr + integer :: igcsm, iprsm + integer :: itr + + real(kind=r8) :: wtsum, wtsm(mg) + real(kind=r8) :: tfn + +! ------- Definitions ------- +! Arrays for 10000-point look-up tables: +! TAU_TBL Clear-sky optical depth +! EXP_TBL Exponential lookup table for transmittance +! PADE Pade approximation constant (= 0.278) +! BPADE Inverse of the Pade approximation constant +! + +! Initialize model data + call swdatinit + call swcmbdat ! g-point interval reduction data + call swatmref ! reference MLS profile + call sw_kgb16 ! molecular absorption coefficients + call sw_kgb17 + call sw_kgb18 + call sw_kgb19 + call sw_kgb20 + call sw_kgb21 + call sw_kgb22 + call sw_kgb23 + call sw_kgb24 + call sw_kgb25 + call sw_kgb26 + call sw_kgb27 + call sw_kgb28 + call sw_kgb29 + +! Define exponential lookup tables for transmittance. Tau is +! computed as a function of the tau transition function, and transmittance +! is calculated as a function of tau. All tables are computed at intervals +! of 0.0001. The inverse of the constant used in the Pade approximation to +! the tau transition function is set to bpade. + + exp_tbl(0) = 1.0_r8 + exp_tbl(ntbl) = 0.0_r8 + bpade = 1.0_r8 / pade + do itr = 1, ntbl-1 + tfn = float(itr) / float(ntbl) + tau_tbl = bpade * tfn / (1._r8 - tfn) + exp_tbl(itr) = exp(-tau_tbl) + enddo + +! Perform g-point reduction from 16 per band (224 total points) to +! a band dependent number (112 total points) for all absorption +! coefficient input data and Planck fraction input data. +! Compute relative weighting for new g-point combinations. + + igcsm = 0 + do ibnd = 1,nbndsw + iprsm = 0 + if (ngc(ibnd).lt.mg) then + do igc = 1,ngc(ibnd) + igcsm = igcsm + 1 + wtsum = 0. + do ipr = 1, ngn(igcsm) + iprsm = iprsm + 1 + wtsum = wtsum + wt(iprsm) + enddo + wtsm(igc) = wtsum + enddo + do ig = 1, ng(ibnd+15) + ind = (ibnd-1)*mg + ig + rwgt(ind) = wt(ig)/wtsm(ngm(ind)) + enddo + else + do ig = 1, ng(ibnd+15) + igcsm = igcsm + 1 + ind = (ibnd-1)*mg + ig + rwgt(ind) = 1.0_r8 + enddo + endif + enddo + +! Reduce g-points for absorption coefficient data in each LW spectral band. + + call cmbgb16s + call cmbgb17 + call cmbgb18 + call cmbgb19 + call cmbgb20 + call cmbgb21 + call cmbgb22 + call cmbgb23 + call cmbgb24 + call cmbgb25 + call cmbgb26 + call cmbgb27 + call cmbgb28 + call cmbgb29 + + end subroutine rrtmg_sw_ini + +!*************************************************************************** + subroutine swdatinit +!*************************************************************************** + +! --------- Modules ---------- + + use rrsw_con, only: heatfac, grav, planck, boltz, & + clight, avogad, alosmt, gascon, radcn1, radcn2 + use rrsw_wvn, only: ng, nspa, nspb, wavenum1, wavenum2, delwave + use shr_const_mod, only: shr_const_avogad + use physconst, only: cday, gravit, cpair + + save + +! Shortwave spectral band limits (wavenumbers) + wavenum1(:) = (/2600._r8, 3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, & + 8050._r8,12850._r8,16000._r8,22650._r8,29000._r8,38000._r8, 820._r8/) + wavenum2(:) = (/3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, 8050._r8, & + 12850._r8,16000._r8,22650._r8,29000._r8,38000._r8,50000._r8, 2600._r8/) + delwave(:) = (/ 650._r8, 750._r8, 650._r8, 500._r8, 1000._r8, 1550._r8, 350._r8, & + 4800._r8, 3150._r8, 6650._r8, 6350._r8, 9000._r8,12000._r8, 1780._r8/) + +! Spectral band information + ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16/) + nspa(:) = (/9,9,9,9,1,9,9,1,9,1,0,1,9,1/) + nspb(:) = (/1,5,1,1,1,5,1,0,1,0,0,1,5,1/) + +! Use constants set in CAM for consistency + grav = gravit + avogad = shr_const_avogad * 1.e-3_r8 + +! Heatfac is the factor by which one must multiply delta-flux/ +! delta-pressure, with flux in w/m-2 and pressure in mbar, to get +! the heating rate in units of degrees/day. It is equal to +! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p) +! = (9.8066)(86400)(1e-5)/(1.004) +! heatfac = 8.4391_r8 + +! Modified values for consistency with CAM3: +! = (9.80616)(86400)(1e-5)/(1.00464) +! heatfac = 8.43339130434_r8 + +! Calculate heatfac directly from CAM constants: + heatfac = grav * cday * 1.e-5_r8 / (cpair * 1.e-3_r8) + +! Constants from NIST 01/11/2002 + +! grav = 9.8066_r8 + planck = 6.62606876e-27_r8 + boltz = 1.3806503e-16_r8 + clight = 2.99792458e+10_r8 +! avogad = 6.02214199e+23_r8 + alosmt = 2.6867775e+19_r8 + gascon = 8.31447200e+07_r8 + radcn1 = 1.191042722e-12_r8 + radcn2 = 1.4387752_r8 + +! +! units are generally cgs +! +! The first and second radiation constants are taken from NIST. +! They were previously obtained from the relations: +! radcn1 = 2.*planck*clight*clight*1.e-07 +! radcn2 = planck*clight/boltz + + end subroutine swdatinit + +!*************************************************************************** + subroutine swcmbdat +!*************************************************************************** + + use rrsw_wvn, only: ngc, ngs, ngn, ngb, ngm, wt + + save + +! ------- Definitions ------- +! Arrays for the g-point reduction from 224 to 112 for the 16 LW bands: +! This mapping from 224 to 112 points has been carefully selected to +! minimize the effect on the resulting fluxes and cooling rates, and +! caution should be used if the mapping is modified. The full 224 +! g-point set can be restored with ngpt=224, ngc=16*16, ngn=224*1., etc. +! ngpt The total number of new g-points +! ngc The number of new g-points in each band +! ngs The cumulative sum of new g-points for each band +! ngm The index of each new g-point relative to the original +! 16 g-points for each band. +! ngn The number of original g-points that are combined to make +! each new g-point in each band. +! ngb The band index for each new g-point. +! wt RRTM weights for 16 g-points. + +! Use this set for 112 quadrature point (g-point) model +! ------- Data statements ------- + ngc(:) = (/ 6,12, 8, 8,10,10, 2,10, 8, 6, 6, 8, 6,12 /) + ngs(:) = (/ 6,18,26,34,44,54,56,66,74,80,86,94,100,112 /) + ngm(:) = (/ 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, & ! band 16 + 1,2,3,4,5,6,6,7,8,8,9,10,10,11,12,12, & ! band 17 + 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, & ! band 18 + 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, & ! band 19 + 1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, & ! band 20 + 1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, & ! band 21 + 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! band 22 + 1,1,2,2,3,4,5,6,7,8,9,9,10,10,10,10, & ! band 23 + 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! band 24 + 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, & ! band 25 + 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, & ! band 26 + 1,2,3,4,5,6,7,7,7,7,8,8,8,8,8,8, & ! band 27 + 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, & ! band 28 + 1,2,3,4,5,5,6,6,7,7,8,8,9,10,11,12 /) ! band 29 + ngn(:) = (/ 2,2,2,2,4,4, & ! band 16 + 1,1,1,1,1,2,1,2,1,2,1,2, & ! band 17 + 1,1,1,1,2,2,4,4, & ! band 18 + 1,1,1,1,2,2,4,4, & ! band 19 + 1,1,1,1,1,1,1,1,2,6, & ! band 20 + 1,1,1,1,1,1,1,1,2,6, & ! band 21 + 8,8, & ! band 22 + 2,2,1,1,1,1,1,1,2,4, & ! band 23 + 2,2,2,2,2,2,2,2, & ! band 24 + 1,1,2,2,4,6, & ! band 25 + 1,1,2,2,4,6, & ! band 26 + 1,1,1,1,1,1,4,6, & ! band 27 + 1,1,2,2,4,6, & ! band 28 + 1,1,1,1,2,2,2,2,1,1,1,1 /) ! band 29 + ngb(:) = (/ 16,16,16,16,16,16, & ! band 16 + 17,17,17,17,17,17,17,17,17,17,17,17, & ! band 17 + 18,18,18,18,18,18,18,18, & ! band 18 + 19,19,19,19,19,19,19,19, & ! band 19 + 20,20,20,20,20,20,20,20,20,20, & ! band 20 + 21,21,21,21,21,21,21,21,21,21, & ! band 21 + 22,22, & ! band 22 + 23,23,23,23,23,23,23,23,23,23, & ! band 23 + 24,24,24,24,24,24,24,24, & ! band 24 + 25,25,25,25,25,25, & ! band 25 + 26,26,26,26,26,26, & ! band 26 + 27,27,27,27,27,27,27,27, & ! band 27 + 28,28,28,28,28,28, & ! band 28 + 29,29,29,29,29,29,29,29,29,29,29,29 /) ! band 29 + +! Use this set for full 224 quadrature point (g-point) model +! ------- Data statements ------- +! ngc(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /) +! ngs(:) = (/ 16,32,48,64,80,96,112,128,144,160,176,192,208,224 /) +! ngm(:) = (/ 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 16 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 17 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 18 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 19 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 20 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 21 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 22 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 23 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 24 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 25 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 26 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 27 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 28 +! 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /) ! band 29 +! ngn(:) = (/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 16 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 17 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 18 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 19 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 20 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 21 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 22 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 23 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 24 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 25 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 26 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 27 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 28 +! 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 /) ! band 29 +! ngb(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, & ! band 16 +! 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17, & ! band 17 +! 18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18, & ! band 18 +! 19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19, & ! band 19 +! 20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20, & ! band 20 +! 21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21, & ! band 21 +! 22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22, & ! band 22 +! 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, & ! band 23 +! 24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, & ! band 24 +! 25,25,25,25,25,25,25,25,25,25,25,25,25,25,25,25, & ! band 25 +! 26,26,26,26,26,26,26,26,26,26,26,26,26,26,26,26, & ! band 26 +! 27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27, & ! band 27 +! 28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28, & ! band 28 +! 29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29 /) ! band 29 + + + wt(:) = (/ 0.1527534276_r8, 0.1491729617_r8, 0.1420961469_r8, & + 0.1316886544_r8, 0.1181945205_r8, 0.1019300893_r8, & + 0.0832767040_r8, 0.0626720116_r8, 0.0424925000_r8, & + 0.0046269894_r8, 0.0038279891_r8, 0.0030260086_r8, & + 0.0022199750_r8, 0.0014140010_r8, 0.0005330000_r8, & + 0.0000750000_r8 /) + + end subroutine swcmbdat + +!*************************************************************************** + subroutine cmbgb16s +!*************************************************************************** +! +! Original version: MJIacono; July 1998 +! Revision for RRTM_SW: MJIacono; November 2002 +! Revision for RRTMG_SW: MJIacono; December 2003 +! Revision for F90 reformatting: MJIacono; July 2006 +! +! The subroutines CMBGB16->CMBGB29 input the absorption coefficient +! data for each band, which are defined for 16 g-points and 14 spectral +! bands. The data are combined with appropriate weighting following the +! g-point mapping arrays specified in RRTMG_SW_INIT. Solar source +! function data in array SFLUXREF are combined without weighting. All +! g-point reduced data are put into new arrays for use in RRTMG_SW. +! +! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) +! +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg16, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(1) + sumk = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(1) + sumf = 0. + do ipr = 1, ngn(igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm) + enddo + sfluxref(igc) = sumf + enddo + + end subroutine cmbgb16s + +!*************************************************************************** + subroutine cmbgb17 +!*************************************************************************** +! +! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg17, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+16) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+16) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+16) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(2) + sumk = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+16) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,5 + iprsm = 0 + do igc = 1,ngc(2) + sumf = 0. + do ipr = 1, ngn(ngs(1)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb17 + +!*************************************************************************** + subroutine cmbgb18 +!*************************************************************************** +! +! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg18, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+32) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+32) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+32) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(3) + sumk = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+32) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(3) + sumf = 0. + do ipr = 1, ngn(ngs(2)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb18 + +!*************************************************************************** + subroutine cmbgb19 +!*************************************************************************** +! +! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg19, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+48) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+48) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+48) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(4) + sumk = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+48) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(4) + sumf = 0. + do ipr = 1, ngn(ngs(3)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb19 + +!*************************************************************************** + subroutine cmbgb20 +!*************************************************************************** +! +! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg20, only : kao, kbo, selfrefo, forrefo, sfluxrefo, absch4o, & + ka, kb, selfref, forref, sfluxref, absch4 + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+64) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+64) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+64) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(5) + sumk = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+64) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(5) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(4)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm) + sumf2 = sumf2 + absch4o(iprsm)*rwgt(iprsm+64) + enddo + sfluxref(igc) = sumf1 + absch4(igc) = sumf2 + enddo + + end subroutine cmbgb20 + +!*************************************************************************** + subroutine cmbgb21 +!*************************************************************************** +! +! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg21, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+80) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+80) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+80) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(6) + sumk = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+80) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(6) + sumf = 0. + do ipr = 1, ngn(ngs(5)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb21 + +!*************************************************************************** + subroutine cmbgb22 +!*************************************************************************** +! +! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg22, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + ka, kb, selfref, forref, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+96) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+96) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+96) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(7) + sumk = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+96) + enddo + forref(jt,igc) = sumk + enddo + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(7) + sumf = 0. + do ipr = 1, ngn(ngs(6)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb22 + +!*************************************************************************** + subroutine cmbgb23 +!*************************************************************************** +! +! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg23, only : kao, selfrefo, forrefo, sfluxrefo, raylo, & + ka, selfref, forref, sfluxref, rayl + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(8) + sumk = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+112) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(8) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(7)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm) + sumf2 = sumf2 + raylo(iprsm)*rwgt(iprsm+112) + enddo + sfluxref(igc) = sumf1 + rayl(igc) = sumf2 + enddo + + end subroutine cmbgb23 + +!*************************************************************************** + subroutine cmbgb24 +!*************************************************************************** +! +! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg24, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + abso3ao, abso3bo, raylao, raylbo, & + ka, kb, selfref, forref, sfluxref, & + abso3a, abso3b, rayla, raylb + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2, sumf3 + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+128) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+128) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+128) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,3 + iprsm = 0 + do igc = 1,ngc(9) + sumk = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+128) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(9) + sumf1 = 0. + sumf2 = 0. + sumf3 = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + raylbo(iprsm)*rwgt(iprsm+128) + sumf2 = sumf2 + abso3ao(iprsm)*rwgt(iprsm+128) + sumf3 = sumf3 + abso3bo(iprsm)*rwgt(iprsm+128) + enddo + raylb(igc) = sumf1 + abso3a(igc) = sumf2 + abso3b(igc) = sumf3 + enddo + + do jp = 1,9 + iprsm = 0 + do igc = 1,ngc(9) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(8)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm,jp) + sumf2 = sumf2 + raylao(iprsm,jp)*rwgt(iprsm+128) + enddo + sfluxref(igc,jp) = sumf1 + rayla(igc,jp) = sumf2 + enddo + enddo + + end subroutine cmbgb24 + +!*************************************************************************** + subroutine cmbgb25 +!*************************************************************************** +! +! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg25, only : kao, sfluxrefo, & + abso3ao, abso3bo, raylo, & + ka, sfluxref, & + abso3a, abso3b, rayl + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2, sumf3, sumf4 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(10) + sumk = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+144) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(10) + sumf1 = 0. + sumf2 = 0. + sumf3 = 0. + sumf4 = 0. + do ipr = 1, ngn(ngs(9)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm) + sumf2 = sumf2 + abso3ao(iprsm)*rwgt(iprsm+144) + sumf3 = sumf3 + abso3bo(iprsm)*rwgt(iprsm+144) + sumf4 = sumf4 + raylo(iprsm)*rwgt(iprsm+144) + enddo + sfluxref(igc) = sumf1 + abso3a(igc) = sumf2 + abso3b(igc) = sumf3 + rayl(igc) = sumf4 + enddo + + end subroutine cmbgb25 + +!*************************************************************************** + subroutine cmbgb26 +!*************************************************************************** +! +! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg26, only : sfluxrefo, raylo, & + sfluxref, rayl + +! ------- Local ------- + integer :: igc, ipr, iprsm + real(kind=r8) :: sumf1, sumf2 + + + iprsm = 0 + do igc = 1,ngc(11) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(10)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + raylo(iprsm)*rwgt(iprsm+160) + sumf2 = sumf2 + sfluxrefo(iprsm) + enddo + rayl(igc) = sumf1 + sfluxref(igc) = sumf2 + enddo + + end subroutine cmbgb26 + +!*************************************************************************** + subroutine cmbgb27 +!*************************************************************************** +! +! band 27: 29000-38000 cm-1 (low - o3; high - o3) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg27, only : kao, kbo, sfluxrefo, raylo, & + ka, kb, sfluxref, rayl + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(12) + sumk = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+176) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(12) + sumk = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+176) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(12) + sumf1 = 0. + sumf2 = 0. + do ipr = 1, ngn(ngs(11)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm) + sumf2 = sumf2 + raylo(iprsm)*rwgt(iprsm+176) + enddo + sfluxref(igc) = sumf1 + rayl(igc) = sumf2 + enddo + + end subroutine cmbgb27 + +!*************************************************************************** + subroutine cmbgb28 +!*************************************************************************** +! +! band 28: 38000-50000 cm-1 (low - o3,o2; high - o3,o2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg28, only : kao, kbo, sfluxrefo, & + ka, kb, sfluxref + +! ------- Local ------- + integer :: jn, jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf + + + do jn = 1,9 + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+192) + enddo + ka(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jn = 1,5 + do jt = 1,5 + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(13) + sumk = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+192) + enddo + kb(jn,jt,jp,igc) = sumk + enddo + enddo + enddo + enddo + + do jp = 1,5 + iprsm = 0 + do igc = 1,ngc(13) + sumf = 0. + do ipr = 1, ngn(ngs(12)+igc) + iprsm = iprsm + 1 + sumf = sumf + sfluxrefo(iprsm,jp) + enddo + sfluxref(igc,jp) = sumf + enddo + enddo + + end subroutine cmbgb28 + +!*************************************************************************** + subroutine cmbgb29 +!*************************************************************************** +! +! band 29: 820-2600 cm-1 (low - h2o; high - co2) +!----------------------------------------------------------------------- + + use rrsw_wvn, only : ngc, ngs, ngn, wt, rwgt + use rrsw_kg29, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + absh2oo, absco2o, & + ka, kb, selfref, forref, sfluxref, & + absh2o, absco2 + +! ------- Local ------- + integer :: jt, jp, igc, ipr, iprsm + real(kind=r8) :: sumk, sumf1, sumf2, sumf3 + + + do jt = 1,5 + do jp = 1,13 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+208) + enddo + ka(jt,jp,igc) = sumk + enddo + enddo + do jp = 13,59 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+208) + enddo + kb(jt,jp,igc) = sumk + enddo + enddo + enddo + + do jt = 1,10 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+208) + enddo + selfref(jt,igc) = sumk + enddo + enddo + + do jt = 1,4 + iprsm = 0 + do igc = 1,ngc(14) + sumk = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+208) + enddo + forref(jt,igc) = sumk + enddo + enddo + + iprsm = 0 + do igc = 1,ngc(14) + sumf1 = 0. + sumf2 = 0. + sumf3 = 0. + do ipr = 1, ngn(ngs(13)+igc) + iprsm = iprsm + 1 + sumf1 = sumf1 + sfluxrefo(iprsm) + sumf2 = sumf2 + absco2o(iprsm)*rwgt(iprsm+208) + sumf3 = sumf3 + absh2oo(iprsm)*rwgt(iprsm+208) + enddo + sfluxref(igc) = sumf1 + absco2(igc) = sumf2 + absh2o(igc) = sumf3 + enddo + + end subroutine cmbgb29 + +!*************************************************************************** + + + end module rrtmg_sw_init + + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 new file mode 100644 index 0000000000..8e1cf7914e --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_k_g.f90 @@ -0,0 +1,63576 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_k_g.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:13 $ + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ************************************************************************** +! subroutine sw_kgbnn +! ************************************************************************** +! RRTM Shortwave Radiative Transfer Model +! Atmospheric and Environmental Research, Inc., Cambridge, MA +! +! Original by J.Delamere, Atmospheric & Environmental Research. +! Reformatted for F90: JJMorcrette, ECMWF +! Further F90 and GCM revisions: MJIacono, AER, July 2002 +! +! This file contains 14 subroutines that include the +! absorption coefficients and other data for each of the 14 shortwave +! spectral bands used in RRTM_SW. Here, the data are defined for 16 +! g-points, or sub-intervals, per band. These data are combined and +! weighted using a mapping procedure in routine RRTMG_SW_INIT to reduce +! the total number of g-points from 224 to 112 for use in the GCM. +! ************************************************************************** + subroutine sw_kgb16 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg16, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat1, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & + & 1.92269_r8 , 1.72844_r8 , 1.64326_r8 , 1.58451_r8 & + &, 1.44031_r8 , 1.25108_r8 , 1.02724_r8 , 0.776759_r8 & + &, 0.534444_r8 , 5.87755e-02_r8, 4.86706e-02_r8, 3.87989e-02_r8 & + &, 2.84532e-02_r8, 1.82431e-02_r8, 6.92320e-03_r8, 9.70770e-04_r8 /) + +! Rayleigh extinction coefficient at v = 2925 cm-1. + rayl = 2.91e-10_r8 + + strrat1 = 252.131_r8 + + layreffr = 18 + +! ----------------------------------------------------------------- +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.15349e-04_r8,0.89162e-04_r8,0.97706e-04_r8,0.96973e-04_r8,0.90703e-04_r8, & + & 0.80393e-04_r8,0.67242e-04_r8,0.50804e-04_r8,0.23334e-04_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.16138e-04_r8,0.89235e-04_r8,0.97696e-04_r8,0.96116e-04_r8,0.89625e-04_r8, & + & 0.79382e-04_r8,0.66587e-04_r8,0.50583e-04_r8,0.24342e-04_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.16801e-04_r8,0.89390e-04_r8,0.97492e-04_r8,0.95146e-04_r8,0.88483e-04_r8, & + & 0.78325e-04_r8,0.65873e-04_r8,0.50342e-04_r8,0.25245e-04_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.17584e-04_r8,0.89321e-04_r8,0.97141e-04_r8,0.93952e-04_r8,0.87141e-04_r8, & + & 0.77126e-04_r8,0.65068e-04_r8,0.49985e-04_r8,0.26046e-04_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.18258e-04_r8,0.89204e-04_r8,0.96602e-04_r8,0.92773e-04_r8,0.85832e-04_r8, & + & 0.76015e-04_r8,0.64318e-04_r8,0.49612e-04_r8,0.26697e-04_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.12783e-04_r8,0.77013e-04_r8,0.85056e-04_r8,0.84160e-04_r8,0.79021e-04_r8, & + & 0.70101e-04_r8,0.58520e-04_r8,0.44007e-04_r8,0.19895e-04_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.13452e-04_r8,0.77084e-04_r8,0.84929e-04_r8,0.83386e-04_r8,0.78122e-04_r8, & + & 0.69293e-04_r8,0.57974e-04_r8,0.43855e-04_r8,0.20713e-04_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.14066e-04_r8,0.77185e-04_r8,0.84612e-04_r8,0.82498e-04_r8,0.77177e-04_r8, & + & 0.68443e-04_r8,0.57444e-04_r8,0.43722e-04_r8,0.21494e-04_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.14678e-04_r8,0.76996e-04_r8,0.83962e-04_r8,0.81526e-04_r8,0.76049e-04_r8, & + & 0.67485e-04_r8,0.56822e-04_r8,0.43530e-04_r8,0.22200e-04_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.15258e-04_r8,0.76788e-04_r8,0.82821e-04_r8,0.80320e-04_r8,0.74845e-04_r8, & + & 0.66487e-04_r8,0.56144e-04_r8,0.43262e-04_r8,0.22757e-04_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.10474e-04_r8,0.66144e-04_r8,0.73703e-04_r8,0.72701e-04_r8,0.68638e-04_r8, & + & 0.60826e-04_r8,0.50854e-04_r8,0.37989e-04_r8,0.17743e-04_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.11024e-04_r8,0.66096e-04_r8,0.73447e-04_r8,0.72029e-04_r8,0.67858e-04_r8, & + & 0.60163e-04_r8,0.50424e-04_r8,0.37886e-04_r8,0.18519e-04_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.11534e-04_r8,0.65974e-04_r8,0.72795e-04_r8,0.71229e-04_r8,0.67005e-04_r8, & + & 0.59442e-04_r8,0.49950e-04_r8,0.37779e-04_r8,0.19184e-04_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.12091e-04_r8,0.65752e-04_r8,0.72003e-04_r8,0.70357e-04_r8,0.66129e-04_r8, & + & 0.58718e-04_r8,0.49503e-04_r8,0.37690e-04_r8,0.19788e-04_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.12560e-04_r8,0.65678e-04_r8,0.71013e-04_r8,0.69266e-04_r8,0.65076e-04_r8, & + & 0.57873e-04_r8,0.48947e-04_r8,0.37519e-04_r8,0.20290e-04_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.85236e-05_r8,0.56692e-04_r8,0.63625e-04_r8,0.62567e-04_r8,0.59412e-04_r8, & + & 0.52601e-04_r8,0.43957e-04_r8,0.32602e-04_r8,0.16862e-04_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.89886e-05_r8,0.56512e-04_r8,0.63288e-04_r8,0.61902e-04_r8,0.58733e-04_r8, & + & 0.52036e-04_r8,0.43629e-04_r8,0.32592e-04_r8,0.17543e-04_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.94085e-05_r8,0.56287e-04_r8,0.62588e-04_r8,0.61197e-04_r8,0.58020e-04_r8, & + & 0.51469e-04_r8,0.43247e-04_r8,0.32567e-04_r8,0.18199e-04_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.98830e-05_r8,0.55998e-04_r8,0.61716e-04_r8,0.60485e-04_r8,0.57250e-04_r8, & + & 0.50840e-04_r8,0.42842e-04_r8,0.32520e-04_r8,0.18771e-04_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.10278e-04_r8,0.55929e-04_r8,0.61011e-04_r8,0.59745e-04_r8,0.56462e-04_r8, & + & 0.50254e-04_r8,0.42468e-04_r8,0.32457e-04_r8,0.19296e-04_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.68852e-05_r8,0.48282e-04_r8,0.54761e-04_r8,0.53543e-04_r8,0.51345e-04_r8, & + & 0.45380e-04_r8,0.37794e-04_r8,0.27880e-04_r8,0.14959e-04_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.72830e-05_r8,0.48206e-04_r8,0.54379e-04_r8,0.52923e-04_r8,0.50723e-04_r8, & + & 0.44903e-04_r8,0.37536e-04_r8,0.27938e-04_r8,0.15841e-04_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.76436e-05_r8,0.47928e-04_r8,0.53597e-04_r8,0.52299e-04_r8,0.50061e-04_r8, & + & 0.44426e-04_r8,0.37240e-04_r8,0.27962e-04_r8,0.16760e-04_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.80055e-05_r8,0.47625e-04_r8,0.52896e-04_r8,0.51678e-04_r8,0.49302e-04_r8, & + & 0.43902e-04_r8,0.36930e-04_r8,0.27968e-04_r8,0.17586e-04_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.83555e-05_r8,0.47486e-04_r8,0.52258e-04_r8,0.51112e-04_r8,0.48444e-04_r8, & + & 0.43409e-04_r8,0.36652e-04_r8,0.27966e-04_r8,0.18270e-04_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.55363e-05_r8,0.40995e-04_r8,0.46991e-04_r8,0.45840e-04_r8,0.44200e-04_r8, & + & 0.38984e-04_r8,0.32341e-04_r8,0.23743e-04_r8,0.12825e-04_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.58741e-05_r8,0.40851e-04_r8,0.46490e-04_r8,0.45277e-04_r8,0.43651e-04_r8, & + & 0.38565e-04_r8,0.32141e-04_r8,0.23813e-04_r8,0.13671e-04_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.61821e-05_r8,0.40643e-04_r8,0.45850e-04_r8,0.44728e-04_r8,0.42924e-04_r8, & + & 0.38164e-04_r8,0.31920e-04_r8,0.23858e-04_r8,0.14647e-04_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.64614e-05_r8,0.40329e-04_r8,0.45202e-04_r8,0.44163e-04_r8,0.42054e-04_r8, & + & 0.37723e-04_r8,0.31679e-04_r8,0.23886e-04_r8,0.15533e-04_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.67675e-05_r8,0.40137e-04_r8,0.44578e-04_r8,0.43574e-04_r8,0.41267e-04_r8, & + & 0.37271e-04_r8,0.31420e-04_r8,0.23883e-04_r8,0.16436e-04_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.44217e-05_r8,0.34626e-04_r8,0.39970e-04_r8,0.39080e-04_r8,0.37744e-04_r8, & + & 0.33237e-04_r8,0.27507e-04_r8,0.20074e-04_r8,0.11007e-04_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.47104e-05_r8,0.34494e-04_r8,0.39592e-04_r8,0.38568e-04_r8,0.37283e-04_r8, & + & 0.32875e-04_r8,0.27342e-04_r8,0.20149e-04_r8,0.11834e-04_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.49764e-05_r8,0.34300e-04_r8,0.39007e-04_r8,0.38074e-04_r8,0.36415e-04_r8, & + & 0.32528e-04_r8,0.27158e-04_r8,0.20213e-04_r8,0.12801e-04_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.52135e-05_r8,0.34067e-04_r8,0.38449e-04_r8,0.37591e-04_r8,0.35661e-04_r8, & + & 0.32173e-04_r8,0.26959e-04_r8,0.20265e-04_r8,0.13763e-04_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.54275e-05_r8,0.33832e-04_r8,0.37875e-04_r8,0.37057e-04_r8,0.35065e-04_r8, & + & 0.31800e-04_r8,0.26760e-04_r8,0.20278e-04_r8,0.14677e-04_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.35317e-05_r8,0.29115e-04_r8,0.33824e-04_r8,0.33370e-04_r8,0.32237e-04_r8, & + & 0.28331e-04_r8,0.23362e-04_r8,0.16932e-04_r8,0.96086e-05_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.37854e-05_r8,0.29084e-04_r8,0.33632e-04_r8,0.32929e-04_r8,0.31805e-04_r8, & + & 0.28018e-04_r8,0.23236e-04_r8,0.17006e-04_r8,0.10621e-04_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.40127e-05_r8,0.28935e-04_r8,0.33190e-04_r8,0.32483e-04_r8,0.30936e-04_r8, & + & 0.27716e-04_r8,0.23074e-04_r8,0.17087e-04_r8,0.11657e-04_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.42184e-05_r8,0.28732e-04_r8,0.32711e-04_r8,0.32042e-04_r8,0.30351e-04_r8, & + & 0.27404e-04_r8,0.22906e-04_r8,0.17140e-04_r8,0.12504e-04_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.44040e-05_r8,0.28488e-04_r8,0.32207e-04_r8,0.31581e-04_r8,0.29852e-04_r8, & + & 0.27086e-04_r8,0.22740e-04_r8,0.17166e-04_r8,0.13401e-04_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.28004e-05_r8,0.24421e-04_r8,0.28507e-04_r8,0.28270e-04_r8,0.27415e-04_r8, & + & 0.24038e-04_r8,0.19759e-04_r8,0.14209e-04_r8,0.88498e-05_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.30342e-05_r8,0.24385e-04_r8,0.28391e-04_r8,0.27999e-04_r8,0.26969e-04_r8, & + & 0.23770e-04_r8,0.19651e-04_r8,0.14288e-04_r8,0.10048e-04_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.32304e-05_r8,0.24304e-04_r8,0.28136e-04_r8,0.27602e-04_r8,0.26246e-04_r8, & + & 0.23508e-04_r8,0.19517e-04_r8,0.14360e-04_r8,0.11188e-04_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.34049e-05_r8,0.24160e-04_r8,0.27731e-04_r8,0.27211e-04_r8,0.25756e-04_r8, & + & 0.23246e-04_r8,0.19380e-04_r8,0.14426e-04_r8,0.12319e-04_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.35648e-05_r8,0.23940e-04_r8,0.27283e-04_r8,0.26806e-04_r8,0.25320e-04_r8, & + & 0.22960e-04_r8,0.19234e-04_r8,0.14451e-04_r8,0.13506e-04_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.22115e-05_r8,0.20358e-04_r8,0.23898e-04_r8,0.23781e-04_r8,0.23142e-04_r8, & + & 0.20260e-04_r8,0.16593e-04_r8,0.11876e-04_r8,0.77665e-05_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.24264e-05_r8,0.20362e-04_r8,0.23820e-04_r8,0.23569e-04_r8,0.22708e-04_r8, & + & 0.20037e-04_r8,0.16524e-04_r8,0.11954e-04_r8,0.90216e-05_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.26002e-05_r8,0.20303e-04_r8,0.23663e-04_r8,0.23295e-04_r8,0.22132e-04_r8, & + & 0.19806e-04_r8,0.16414e-04_r8,0.12011e-04_r8,0.10379e-04_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.27486e-05_r8,0.20198e-04_r8,0.23357e-04_r8,0.22943e-04_r8,0.21707e-04_r8, & + & 0.19580e-04_r8,0.16298e-04_r8,0.12060e-04_r8,0.11771e-04_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.28881e-05_r8,0.20019e-04_r8,0.22982e-04_r8,0.22584e-04_r8,0.21296e-04_r8, & + & 0.19341e-04_r8,0.16164e-04_r8,0.12088e-04_r8,0.13279e-04_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.18320e-05_r8,0.16927e-04_r8,0.19968e-04_r8,0.19856e-04_r8,0.19352e-04_r8, & + & 0.16934e-04_r8,0.13866e-04_r8,0.99116e-05_r8,0.67134e-05_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.20049e-05_r8,0.16927e-04_r8,0.19853e-04_r8,0.19674e-04_r8,0.18853e-04_r8, & + & 0.16739e-04_r8,0.13797e-04_r8,0.99757e-05_r8,0.78968e-05_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.21502e-05_r8,0.16866e-04_r8,0.19704e-04_r8,0.19448e-04_r8,0.18441e-04_r8, & + & 0.16541e-04_r8,0.13705e-04_r8,0.10023e-04_r8,0.91593e-05_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.22714e-05_r8,0.16777e-04_r8,0.19465e-04_r8,0.19143e-04_r8,0.18062e-04_r8, & + & 0.16347e-04_r8,0.13601e-04_r8,0.10057e-04_r8,0.10536e-04_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.23867e-05_r8,0.16634e-04_r8,0.19123e-04_r8,0.18829e-04_r8,0.17732e-04_r8, & + & 0.16132e-04_r8,0.13484e-04_r8,0.10082e-04_r8,0.12018e-04_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.15169e-05_r8,0.14042e-04_r8,0.16626e-04_r8,0.16552e-04_r8,0.16148e-04_r8, & + & 0.14121e-04_r8,0.11557e-04_r8,0.82558e-05_r8,0.56116e-05_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.16576e-05_r8,0.14051e-04_r8,0.16515e-04_r8,0.16389e-04_r8,0.15651e-04_r8, & + & 0.13956e-04_r8,0.11498e-04_r8,0.83065e-05_r8,0.66756e-05_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.17786e-05_r8,0.13996e-04_r8,0.16382e-04_r8,0.16200e-04_r8,0.15335e-04_r8, & + & 0.13791e-04_r8,0.11414e-04_r8,0.83396e-05_r8,0.78609e-05_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.18784e-05_r8,0.13920e-04_r8,0.16173e-04_r8,0.15944e-04_r8,0.15016e-04_r8, & + & 0.13612e-04_r8,0.11321e-04_r8,0.83696e-05_r8,0.90657e-05_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.19730e-05_r8,0.13808e-04_r8,0.15876e-04_r8,0.15671e-04_r8,0.14704e-04_r8, & + & 0.13425e-04_r8,0.11218e-04_r8,0.83846e-05_r8,0.10342e-04_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.12548e-05_r8,0.11622e-04_r8,0.13817e-04_r8,0.13765e-04_r8,0.13366e-04_r8, & + & 0.11761e-04_r8,0.96214e-05_r8,0.68586e-05_r8,0.46815e-05_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.13720e-05_r8,0.11638e-04_r8,0.13707e-04_r8,0.13640e-04_r8,0.13007e-04_r8, & + & 0.11624e-04_r8,0.95672e-05_r8,0.68978e-05_r8,0.55831e-05_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.14716e-05_r8,0.11595e-04_r8,0.13603e-04_r8,0.13476e-04_r8,0.12728e-04_r8, & + & 0.11474e-04_r8,0.94883e-05_r8,0.69284e-05_r8,0.65694e-05_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.15544e-05_r8,0.11533e-04_r8,0.13432e-04_r8,0.13265e-04_r8,0.12450e-04_r8, & + & 0.11320e-04_r8,0.94054e-05_r8,0.69510e-05_r8,0.75699e-05_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.16324e-05_r8,0.11450e-04_r8,0.13177e-04_r8,0.13030e-04_r8,0.12193e-04_r8, & + & 0.11159e-04_r8,0.93157e-05_r8,0.69543e-05_r8,0.86449e-05_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.10905e-03_r8,0.19084e-03_r8,0.20069e-03_r8,0.19832e-03_r8,0.18610e-03_r8, & + & 0.17089e-03_r8,0.14990e-03_r8,0.11759e-03_r8,0.64675e-04_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.11105e-03_r8,0.18952e-03_r8,0.19885e-03_r8,0.19823e-03_r8,0.18675e-03_r8, & + & 0.17126e-03_r8,0.15098e-03_r8,0.11929e-03_r8,0.67071e-04_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.11276e-03_r8,0.18853e-03_r8,0.19769e-03_r8,0.19892e-03_r8,0.18804e-03_r8, & + & 0.17228e-03_r8,0.15234e-03_r8,0.12104e-03_r8,0.69562e-04_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.11331e-03_r8,0.18716e-03_r8,0.19673e-03_r8,0.19862e-03_r8,0.18922e-03_r8, & + & 0.17345e-03_r8,0.15364e-03_r8,0.12287e-03_r8,0.72145e-04_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.11374e-03_r8,0.18626e-03_r8,0.19656e-03_r8,0.19857e-03_r8,0.19062e-03_r8, & + & 0.17445e-03_r8,0.15373e-03_r8,0.12483e-03_r8,0.74697e-04_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.94458e-04_r8,0.16650e-03_r8,0.17483e-03_r8,0.17491e-03_r8,0.16501e-03_r8, & + & 0.15069e-03_r8,0.13359e-03_r8,0.10498e-03_r8,0.55352e-04_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.96121e-04_r8,0.16557e-03_r8,0.17383e-03_r8,0.17514e-03_r8,0.16597e-03_r8, & + & 0.15082e-03_r8,0.13480e-03_r8,0.10677e-03_r8,0.57531e-04_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.97581e-04_r8,0.16494e-03_r8,0.17349e-03_r8,0.17480e-03_r8,0.16726e-03_r8, & + & 0.15206e-03_r8,0.13520e-03_r8,0.10844e-03_r8,0.59621e-04_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.98152e-04_r8,0.16427e-03_r8,0.17323e-03_r8,0.17471e-03_r8,0.16812e-03_r8, & + & 0.15352e-03_r8,0.13523e-03_r8,0.11008e-03_r8,0.61894e-04_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.98081e-04_r8,0.16346e-03_r8,0.17334e-03_r8,0.17481e-03_r8,0.16845e-03_r8, & + & 0.15496e-03_r8,0.13612e-03_r8,0.11175e-03_r8,0.64159e-04_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.80988e-04_r8,0.14444e-03_r8,0.15236e-03_r8,0.15355e-03_r8,0.14515e-03_r8, & + & 0.13201e-03_r8,0.11827e-03_r8,0.92843e-04_r8,0.47818e-04_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.82627e-04_r8,0.14399e-03_r8,0.15198e-03_r8,0.15308e-03_r8,0.14622e-03_r8, & + & 0.13285e-03_r8,0.11829e-03_r8,0.94579e-04_r8,0.49498e-04_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.83666e-04_r8,0.14365e-03_r8,0.15183e-03_r8,0.15300e-03_r8,0.14704e-03_r8, & + & 0.13418e-03_r8,0.11832e-03_r8,0.96259e-04_r8,0.51225e-04_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.84164e-04_r8,0.14362e-03_r8,0.15205e-03_r8,0.15285e-03_r8,0.14764e-03_r8, & + & 0.13590e-03_r8,0.11954e-03_r8,0.97885e-04_r8,0.52990e-04_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.84014e-04_r8,0.14269e-03_r8,0.15214e-03_r8,0.15331e-03_r8,0.14865e-03_r8, & + & 0.13747e-03_r8,0.12089e-03_r8,0.99389e-04_r8,0.54936e-04_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.69055e-04_r8,0.12498e-03_r8,0.13260e-03_r8,0.13427e-03_r8,0.12748e-03_r8, & + & 0.11593e-03_r8,0.10318e-03_r8,0.81535e-04_r8,0.43344e-04_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.70374e-04_r8,0.12479e-03_r8,0.13217e-03_r8,0.13387e-03_r8,0.12823e-03_r8, & + & 0.11702e-03_r8,0.10316e-03_r8,0.83059e-04_r8,0.44577e-04_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.71321e-04_r8,0.12483e-03_r8,0.13205e-03_r8,0.13371e-03_r8,0.12866e-03_r8, & + & 0.11820e-03_r8,0.10422e-03_r8,0.84648e-04_r8,0.45880e-04_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.71712e-04_r8,0.12475e-03_r8,0.13249e-03_r8,0.13379e-03_r8,0.12934e-03_r8, & + & 0.11960e-03_r8,0.10551e-03_r8,0.86238e-04_r8,0.47243e-04_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.71917e-04_r8,0.12433e-03_r8,0.13275e-03_r8,0.13434e-03_r8,0.13049e-03_r8, & + & 0.12131e-03_r8,0.10676e-03_r8,0.87830e-04_r8,0.48641e-04_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.58527e-04_r8,0.10840e-03_r8,0.11507e-03_r8,0.11730e-03_r8,0.11099e-03_r8, & + & 0.10118e-03_r8,0.89566e-04_r8,0.71122e-04_r8,0.43658e-04_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.59798e-04_r8,0.10799e-03_r8,0.11447e-03_r8,0.11692e-03_r8,0.11189e-03_r8, & + & 0.10224e-03_r8,0.90255e-04_r8,0.72476e-04_r8,0.44361e-04_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.60601e-04_r8,0.10799e-03_r8,0.11464e-03_r8,0.11677e-03_r8,0.11225e-03_r8, & + & 0.10358e-03_r8,0.91122e-04_r8,0.73922e-04_r8,0.45004e-04_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.60971e-04_r8,0.10798e-03_r8,0.11486e-03_r8,0.11681e-03_r8,0.11304e-03_r8, & + & 0.10512e-03_r8,0.91981e-04_r8,0.75441e-04_r8,0.45782e-04_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.61166e-04_r8,0.10769e-03_r8,0.11529e-03_r8,0.11740e-03_r8,0.11428e-03_r8, & + & 0.10674e-03_r8,0.93329e-04_r8,0.76963e-04_r8,0.46781e-04_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.49298e-04_r8,0.93665e-04_r8,0.99302e-04_r8,0.10166e-03_r8,0.96125e-04_r8, & + & 0.87991e-04_r8,0.77830e-04_r8,0.61651e-04_r8,0.45761e-04_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.50498e-04_r8,0.93479e-04_r8,0.98966e-04_r8,0.10139e-03_r8,0.96705e-04_r8, & + & 0.89173e-04_r8,0.78227e-04_r8,0.62850e-04_r8,0.46039e-04_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.51269e-04_r8,0.93203e-04_r8,0.98973e-04_r8,0.10127e-03_r8,0.97298e-04_r8, & + & 0.90362e-04_r8,0.78802e-04_r8,0.64157e-04_r8,0.46346e-04_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.51588e-04_r8,0.93137e-04_r8,0.99162e-04_r8,0.10129e-03_r8,0.98592e-04_r8, & + & 0.91554e-04_r8,0.79929e-04_r8,0.65574e-04_r8,0.46727e-04_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.51597e-04_r8,0.92792e-04_r8,0.99458e-04_r8,0.10170e-03_r8,0.99448e-04_r8, & + & 0.92834e-04_r8,0.81330e-04_r8,0.66366e-04_r8,0.47183e-04_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.41246e-04_r8,0.80496e-04_r8,0.85316e-04_r8,0.87435e-04_r8,0.82542e-04_r8, & + & 0.75819e-04_r8,0.67022e-04_r8,0.53111e-04_r8,0.48352e-04_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.42332e-04_r8,0.80236e-04_r8,0.84984e-04_r8,0.87173e-04_r8,0.83192e-04_r8, & + & 0.76872e-04_r8,0.67154e-04_r8,0.54235e-04_r8,0.49203e-04_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.43069e-04_r8,0.79969e-04_r8,0.85117e-04_r8,0.87191e-04_r8,0.83963e-04_r8, & + & 0.78027e-04_r8,0.67911e-04_r8,0.55423e-04_r8,0.50036e-04_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.43347e-04_r8,0.79762e-04_r8,0.85176e-04_r8,0.87282e-04_r8,0.84970e-04_r8, & + & 0.78971e-04_r8,0.69097e-04_r8,0.56659e-04_r8,0.50699e-04_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.43381e-04_r8,0.79473e-04_r8,0.85320e-04_r8,0.87550e-04_r8,0.85526e-04_r8, & + & 0.80111e-04_r8,0.70399e-04_r8,0.56992e-04_r8,0.51218e-04_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.34402e-04_r8,0.69256e-04_r8,0.73264e-04_r8,0.74907e-04_r8,0.70733e-04_r8, & + & 0.65058e-04_r8,0.57123e-04_r8,0.45547e-04_r8,0.49061e-04_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.35394e-04_r8,0.68938e-04_r8,0.72891e-04_r8,0.74693e-04_r8,0.71198e-04_r8, & + & 0.66010e-04_r8,0.57419e-04_r8,0.46585e-04_r8,0.51368e-04_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.36086e-04_r8,0.68637e-04_r8,0.72875e-04_r8,0.74679e-04_r8,0.72090e-04_r8, & + & 0.66902e-04_r8,0.58282e-04_r8,0.47622e-04_r8,0.51837e-04_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.36445e-04_r8,0.68326e-04_r8,0.72869e-04_r8,0.74856e-04_r8,0.72765e-04_r8, & + & 0.67827e-04_r8,0.59362e-04_r8,0.48483e-04_r8,0.52297e-04_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.36483e-04_r8,0.68010e-04_r8,0.72961e-04_r8,0.75096e-04_r8,0.73241e-04_r8, & + & 0.68587e-04_r8,0.60512e-04_r8,0.48784e-04_r8,0.53745e-04_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.28433e-04_r8,0.59232e-04_r8,0.62701e-04_r8,0.63901e-04_r8,0.60103e-04_r8, & + & 0.55141e-04_r8,0.48531e-04_r8,0.38847e-04_r8,0.54662e-04_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.29405e-04_r8,0.58918e-04_r8,0.62216e-04_r8,0.63604e-04_r8,0.60633e-04_r8, & + & 0.55830e-04_r8,0.48918e-04_r8,0.39795e-04_r8,0.56459e-04_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.30040e-04_r8,0.58597e-04_r8,0.61986e-04_r8,0.63627e-04_r8,0.61357e-04_r8, & + & 0.56779e-04_r8,0.49706e-04_r8,0.40729e-04_r8,0.58698e-04_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.30412e-04_r8,0.58268e-04_r8,0.61940e-04_r8,0.63690e-04_r8,0.61916e-04_r8, & + & 0.57700e-04_r8,0.50677e-04_r8,0.41137e-04_r8,0.60426e-04_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.30517e-04_r8,0.57913e-04_r8,0.61982e-04_r8,0.63808e-04_r8,0.62307e-04_r8, & + & 0.58353e-04_r8,0.51602e-04_r8,0.41668e-04_r8,0.61933e-04_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.23291e-04_r8,0.50308e-04_r8,0.53243e-04_r8,0.54258e-04_r8,0.50787e-04_r8, & + & 0.46509e-04_r8,0.41036e-04_r8,0.32969e-04_r8,0.63749e-04_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.24304e-04_r8,0.50027e-04_r8,0.52858e-04_r8,0.54035e-04_r8,0.51457e-04_r8, & + & 0.47117e-04_r8,0.41427e-04_r8,0.33795e-04_r8,0.67891e-04_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.24884e-04_r8,0.49658e-04_r8,0.52484e-04_r8,0.53877e-04_r8,0.52001e-04_r8, & + & 0.47908e-04_r8,0.42080e-04_r8,0.34652e-04_r8,0.71374e-04_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.25245e-04_r8,0.49329e-04_r8,0.52369e-04_r8,0.53861e-04_r8,0.52353e-04_r8, & + & 0.48763e-04_r8,0.42918e-04_r8,0.34903e-04_r8,0.73983e-04_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.25399e-04_r8,0.49019e-04_r8,0.52344e-04_r8,0.53920e-04_r8,0.52702e-04_r8, & + & 0.49354e-04_r8,0.43795e-04_r8,0.35336e-04_r8,0.76874e-04_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.19464e-04_r8,0.42428e-04_r8,0.44774e-04_r8,0.45764e-04_r8,0.43065e-04_r8, & + & 0.39257e-04_r8,0.34681e-04_r8,0.28149e-04_r8,0.56538e-04_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.20274e-04_r8,0.42118e-04_r8,0.44484e-04_r8,0.45525e-04_r8,0.43594e-04_r8, & + & 0.39908e-04_r8,0.35109e-04_r8,0.28880e-04_r8,0.61143e-04_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.20723e-04_r8,0.41781e-04_r8,0.44183e-04_r8,0.45345e-04_r8,0.43968e-04_r8, & + & 0.40542e-04_r8,0.35722e-04_r8,0.29427e-04_r8,0.66428e-04_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.20986e-04_r8,0.41469e-04_r8,0.44005e-04_r8,0.45299e-04_r8,0.44240e-04_r8, & + & 0.41204e-04_r8,0.36501e-04_r8,0.29565e-04_r8,0.70536e-04_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.21088e-04_r8,0.41122e-04_r8,0.44008e-04_r8,0.45344e-04_r8,0.44427e-04_r8, & + & 0.41695e-04_r8,0.37345e-04_r8,0.29974e-04_r8,0.74164e-04_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.16205e-04_r8,0.35661e-04_r8,0.37585e-04_r8,0.38332e-04_r8,0.36196e-04_r8, & + & 0.33054e-04_r8,0.29216e-04_r8,0.23917e-04_r8,0.49111e-04_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.16873e-04_r8,0.35314e-04_r8,0.37290e-04_r8,0.38165e-04_r8,0.36667e-04_r8, & + & 0.33618e-04_r8,0.29598e-04_r8,0.24536e-04_r8,0.53408e-04_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.17216e-04_r8,0.35012e-04_r8,0.37013e-04_r8,0.37971e-04_r8,0.36937e-04_r8, & + & 0.34200e-04_r8,0.30188e-04_r8,0.24727e-04_r8,0.56692e-04_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.17409e-04_r8,0.34711e-04_r8,0.36851e-04_r8,0.37885e-04_r8,0.37053e-04_r8, & + & 0.34609e-04_r8,0.30881e-04_r8,0.24937e-04_r8,0.60809e-04_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.17480e-04_r8,0.34362e-04_r8,0.36830e-04_r8,0.37891e-04_r8,0.37213e-04_r8, & + & 0.35045e-04_r8,0.31524e-04_r8,0.25269e-04_r8,0.65163e-04_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.13457e-04_r8,0.29884e-04_r8,0.31446e-04_r8,0.32052e-04_r8,0.30374e-04_r8, & + & 0.27733e-04_r8,0.24511e-04_r8,0.20198e-04_r8,0.41009e-04_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.14007e-04_r8,0.29560e-04_r8,0.31187e-04_r8,0.31882e-04_r8,0.30716e-04_r8, & + & 0.28181e-04_r8,0.24877e-04_r8,0.20737e-04_r8,0.44661e-04_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.14280e-04_r8,0.29273e-04_r8,0.30932e-04_r8,0.31685e-04_r8,0.30856e-04_r8, & + & 0.28687e-04_r8,0.25310e-04_r8,0.20664e-04_r8,0.47397e-04_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.14434e-04_r8,0.28982e-04_r8,0.30751e-04_r8,0.31601e-04_r8,0.30957e-04_r8, & + & 0.28945e-04_r8,0.25864e-04_r8,0.20868e-04_r8,0.50575e-04_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.14483e-04_r8,0.28660e-04_r8,0.30711e-04_r8,0.31533e-04_r8,0.31075e-04_r8, & + & 0.29320e-04_r8,0.26408e-04_r8,0.21257e-04_r8,0.54097e-04_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.22536e-03_r8,0.32037e-03_r8,0.33781e-03_r8,0.34273e-03_r8,0.33729e-03_r8, & + & 0.32075e-03_r8,0.29153e-03_r8,0.24856e-03_r8,0.16410e-03_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.22342e-03_r8,0.32281e-03_r8,0.34293e-03_r8,0.34673e-03_r8,0.34167e-03_r8, & + & 0.32688e-03_r8,0.29787e-03_r8,0.25566e-03_r8,0.17029e-03_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.22157e-03_r8,0.32559e-03_r8,0.34865e-03_r8,0.35164e-03_r8,0.34805e-03_r8, & + & 0.33353e-03_r8,0.30505e-03_r8,0.26380e-03_r8,0.17749e-03_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.21986e-03_r8,0.32894e-03_r8,0.35375e-03_r8,0.35845e-03_r8,0.35514e-03_r8, & + & 0.33992e-03_r8,0.31266e-03_r8,0.27259e-03_r8,0.18209e-03_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.21815e-03_r8,0.33282e-03_r8,0.35982e-03_r8,0.36699e-03_r8,0.36319e-03_r8, & + & 0.34849e-03_r8,0.32265e-03_r8,0.28174e-03_r8,0.18630e-03_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.19541e-03_r8,0.28383e-03_r8,0.30057e-03_r8,0.30208e-03_r8,0.29811e-03_r8, & + & 0.28614e-03_r8,0.25813e-03_r8,0.22172e-03_r8,0.14533e-03_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.19410e-03_r8,0.28606e-03_r8,0.30502e-03_r8,0.30638e-03_r8,0.30342e-03_r8, & + & 0.29123e-03_r8,0.26438e-03_r8,0.22759e-03_r8,0.15063e-03_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.19280e-03_r8,0.28892e-03_r8,0.31031e-03_r8,0.31345e-03_r8,0.30930e-03_r8, & + & 0.29708e-03_r8,0.27075e-03_r8,0.23476e-03_r8,0.15387e-03_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.19169e-03_r8,0.29226e-03_r8,0.31596e-03_r8,0.32060e-03_r8,0.31687e-03_r8, & + & 0.30282e-03_r8,0.27961e-03_r8,0.24147e-03_r8,0.15653e-03_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.19047e-03_r8,0.29594e-03_r8,0.32186e-03_r8,0.32831e-03_r8,0.32510e-03_r8, & + & 0.31022e-03_r8,0.28786e-03_r8,0.24847e-03_r8,0.16195e-03_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.16871e-03_r8,0.24969e-03_r8,0.26468e-03_r8,0.26465e-03_r8,0.26214e-03_r8, & + & 0.25247e-03_r8,0.22732e-03_r8,0.19530e-03_r8,0.12777e-03_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.16793e-03_r8,0.25161e-03_r8,0.26876e-03_r8,0.26973e-03_r8,0.26695e-03_r8, & + & 0.25688e-03_r8,0.23244e-03_r8,0.20054e-03_r8,0.12972e-03_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.16733e-03_r8,0.25378e-03_r8,0.27385e-03_r8,0.27612e-03_r8,0.27305e-03_r8, & + & 0.26119e-03_r8,0.23922e-03_r8,0.20542e-03_r8,0.13061e-03_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.16706e-03_r8,0.25676e-03_r8,0.27970e-03_r8,0.28379e-03_r8,0.28013e-03_r8, & + & 0.26708e-03_r8,0.24668e-03_r8,0.21081e-03_r8,0.13394e-03_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.16637e-03_r8,0.26037e-03_r8,0.28504e-03_r8,0.29050e-03_r8,0.28611e-03_r8, & + & 0.27355e-03_r8,0.25260e-03_r8,0.21670e-03_r8,0.13844e-03_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.14579e-03_r8,0.21908e-03_r8,0.23187e-03_r8,0.23162e-03_r8,0.22921e-03_r8, & + & 0.22070e-03_r8,0.19997e-03_r8,0.17094e-03_r8,0.11198e-03_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.14542e-03_r8,0.22095e-03_r8,0.23576e-03_r8,0.23659e-03_r8,0.23393e-03_r8, & + & 0.22421e-03_r8,0.20413e-03_r8,0.17485e-03_r8,0.11080e-03_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.14519e-03_r8,0.22277e-03_r8,0.24039e-03_r8,0.24264e-03_r8,0.23941e-03_r8, & + & 0.22826e-03_r8,0.20957e-03_r8,0.17862e-03_r8,0.11236e-03_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.14504e-03_r8,0.22526e-03_r8,0.24523e-03_r8,0.24877e-03_r8,0.24473e-03_r8, & + & 0.23381e-03_r8,0.21512e-03_r8,0.18339e-03_r8,0.11577e-03_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.14497e-03_r8,0.22869e-03_r8,0.25070e-03_r8,0.25513e-03_r8,0.25076e-03_r8, & + & 0.23990e-03_r8,0.22117e-03_r8,0.18804e-03_r8,0.11947e-03_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.12609e-03_r8,0.19125e-03_r8,0.20302e-03_r8,0.20235e-03_r8,0.20038e-03_r8, & + & 0.19210e-03_r8,0.17493e-03_r8,0.14918e-03_r8,0.95914e-04_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.12575e-03_r8,0.19304e-03_r8,0.20668e-03_r8,0.20708e-03_r8,0.20395e-03_r8, & + & 0.19513e-03_r8,0.17862e-03_r8,0.15191e-03_r8,0.95952e-04_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.12572e-03_r8,0.19504e-03_r8,0.21070e-03_r8,0.21227e-03_r8,0.20862e-03_r8, & + & 0.19877e-03_r8,0.18323e-03_r8,0.15540e-03_r8,0.98040e-04_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.12578e-03_r8,0.19736e-03_r8,0.21498e-03_r8,0.21770e-03_r8,0.21305e-03_r8, & + & 0.20380e-03_r8,0.18766e-03_r8,0.15949e-03_r8,0.10020e-03_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.12588e-03_r8,0.20051e-03_r8,0.21971e-03_r8,0.22313e-03_r8,0.21848e-03_r8, & + & 0.20915e-03_r8,0.19284e-03_r8,0.16321e-03_r8,0.10267e-03_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.10863e-03_r8,0.16576e-03_r8,0.17695e-03_r8,0.17678e-03_r8,0.17469e-03_r8, & + & 0.16678e-03_r8,0.15163e-03_r8,0.12940e-03_r8,0.89550e-04_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.10863e-03_r8,0.16706e-03_r8,0.18030e-03_r8,0.18081e-03_r8,0.17775e-03_r8, & + & 0.16938e-03_r8,0.15534e-03_r8,0.13148e-03_r8,0.89670e-04_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.10855e-03_r8,0.16916e-03_r8,0.18384e-03_r8,0.18538e-03_r8,0.18134e-03_r8, & + & 0.17272e-03_r8,0.15912e-03_r8,0.13459e-03_r8,0.90520e-04_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.10855e-03_r8,0.17152e-03_r8,0.18761e-03_r8,0.18997e-03_r8,0.18510e-03_r8, & + & 0.17711e-03_r8,0.16286e-03_r8,0.13757e-03_r8,0.91792e-04_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.10853e-03_r8,0.17415e-03_r8,0.19152e-03_r8,0.19450e-03_r8,0.18955e-03_r8, & + & 0.18160e-03_r8,0.16658e-03_r8,0.14151e-03_r8,0.94030e-04_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.92930e-04_r8,0.14283e-03_r8,0.15332e-03_r8,0.15365e-03_r8,0.15192e-03_r8, & + & 0.14476e-03_r8,0.13092e-03_r8,0.11095e-03_r8,0.91877e-04_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.92984e-04_r8,0.14401e-03_r8,0.15614e-03_r8,0.15721e-03_r8,0.15413e-03_r8, & + & 0.14688e-03_r8,0.13443e-03_r8,0.11315e-03_r8,0.90405e-04_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.92945e-04_r8,0.14573e-03_r8,0.15905e-03_r8,0.16110e-03_r8,0.15737e-03_r8, & + & 0.14983e-03_r8,0.13738e-03_r8,0.11591e-03_r8,0.89977e-04_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.93035e-04_r8,0.14787e-03_r8,0.16239e-03_r8,0.16472e-03_r8,0.16084e-03_r8, & + & 0.15371e-03_r8,0.14051e-03_r8,0.11827e-03_r8,0.90955e-04_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.92985e-04_r8,0.15023e-03_r8,0.16593e-03_r8,0.16877e-03_r8,0.16496e-03_r8, & + & 0.15743e-03_r8,0.14348e-03_r8,0.12221e-03_r8,0.92269e-04_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.79600e-04_r8,0.12290e-03_r8,0.13269e-03_r8,0.13322e-03_r8,0.13145e-03_r8, & + & 0.12540e-03_r8,0.11354e-03_r8,0.94559e-04_r8,0.10796e-03_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.79683e-04_r8,0.12390e-03_r8,0.13495e-03_r8,0.13633e-03_r8,0.13351e-03_r8, & + & 0.12708e-03_r8,0.11620e-03_r8,0.96898e-04_r8,0.10854e-03_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.79630e-04_r8,0.12537e-03_r8,0.13745e-03_r8,0.13937e-03_r8,0.13626e-03_r8, & + & 0.12970e-03_r8,0.11867e-03_r8,0.99068e-04_r8,0.10974e-03_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.79625e-04_r8,0.12719e-03_r8,0.14027e-03_r8,0.14234e-03_r8,0.13941e-03_r8, & + & 0.13283e-03_r8,0.12113e-03_r8,0.10155e-03_r8,0.11075e-03_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.79589e-04_r8,0.12914e-03_r8,0.14322e-03_r8,0.14575e-03_r8,0.14305e-03_r8, & + & 0.13597e-03_r8,0.12361e-03_r8,0.10505e-03_r8,0.11038e-03_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.67917e-04_r8,0.10525e-03_r8,0.11421e-03_r8,0.11510e-03_r8,0.11341e-03_r8, & + & 0.10850e-03_r8,0.97945e-04_r8,0.80197e-04_r8,0.13259e-03_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.67928e-04_r8,0.10625e-03_r8,0.11606e-03_r8,0.11762e-03_r8,0.11532e-03_r8, & + & 0.11035e-03_r8,0.10017e-03_r8,0.82394e-04_r8,0.13427e-03_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.67856e-04_r8,0.10744e-03_r8,0.11824e-03_r8,0.11998e-03_r8,0.11756e-03_r8, & + & 0.11235e-03_r8,0.10203e-03_r8,0.84408e-04_r8,0.13461e-03_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.67768e-04_r8,0.10890e-03_r8,0.12070e-03_r8,0.12262e-03_r8,0.12012e-03_r8, & + & 0.11456e-03_r8,0.10420e-03_r8,0.86916e-04_r8,0.13504e-03_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.67707e-04_r8,0.11054e-03_r8,0.12323e-03_r8,0.12567e-03_r8,0.12318e-03_r8, & + & 0.11694e-03_r8,0.10644e-03_r8,0.89648e-04_r8,0.13829e-03_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.57658e-04_r8,0.89812e-04_r8,0.97774e-04_r8,0.98825e-04_r8,0.97412e-04_r8, & + & 0.93433e-04_r8,0.84119e-04_r8,0.68026e-04_r8,0.20137e-03_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.57461e-04_r8,0.90575e-04_r8,0.99228e-04_r8,0.10076e-03_r8,0.98930e-04_r8, & + & 0.94984e-04_r8,0.86081e-04_r8,0.70085e-04_r8,0.20178e-03_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.57397e-04_r8,0.91666e-04_r8,0.10122e-03_r8,0.10281e-03_r8,0.10088e-03_r8, & + & 0.96688e-04_r8,0.87695e-04_r8,0.72010e-04_r8,0.20052e-03_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.57291e-04_r8,0.92869e-04_r8,0.10334e-03_r8,0.10517e-03_r8,0.10317e-03_r8, & + & 0.98293e-04_r8,0.89394e-04_r8,0.74251e-04_r8,0.20103e-03_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.57126e-04_r8,0.94072e-04_r8,0.10545e-03_r8,0.10789e-03_r8,0.10579e-03_r8, & + & 0.10034e-03_r8,0.91420e-04_r8,0.76761e-04_r8,0.20035e-03_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.48600e-04_r8,0.76535e-04_r8,0.83721e-04_r8,0.84782e-04_r8,0.83379e-04_r8, & + & 0.80481e-04_r8,0.72441e-04_r8,0.58503e-04_r8,0.20926e-03_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.48356e-04_r8,0.77272e-04_r8,0.85067e-04_r8,0.86588e-04_r8,0.84928e-04_r8, & + & 0.81803e-04_r8,0.74015e-04_r8,0.60222e-04_r8,0.21110e-03_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.48180e-04_r8,0.78198e-04_r8,0.86939e-04_r8,0.88416e-04_r8,0.86712e-04_r8, & + & 0.83176e-04_r8,0.75535e-04_r8,0.61973e-04_r8,0.20823e-03_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.48042e-04_r8,0.79160e-04_r8,0.88776e-04_r8,0.90704e-04_r8,0.88934e-04_r8, & + & 0.84522e-04_r8,0.76983e-04_r8,0.64264e-04_r8,0.20745e-03_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.47901e-04_r8,0.80171e-04_r8,0.90395e-04_r8,0.92950e-04_r8,0.91253e-04_r8, & + & 0.86364e-04_r8,0.78675e-04_r8,0.66159e-04_r8,0.20642e-03_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.40769e-04_r8,0.64775e-04_r8,0.71240e-04_r8,0.72409e-04_r8,0.71085e-04_r8, & + & 0.68679e-04_r8,0.61925e-04_r8,0.50009e-04_r8,0.19056e-03_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.40486e-04_r8,0.65479e-04_r8,0.72574e-04_r8,0.73906e-04_r8,0.72438e-04_r8, & + & 0.69693e-04_r8,0.63286e-04_r8,0.51717e-04_r8,0.19000e-03_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.40313e-04_r8,0.66212e-04_r8,0.74137e-04_r8,0.75686e-04_r8,0.74201e-04_r8, & + & 0.70781e-04_r8,0.64554e-04_r8,0.53372e-04_r8,0.19242e-03_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.40107e-04_r8,0.66938e-04_r8,0.75524e-04_r8,0.77664e-04_r8,0.76142e-04_r8, & + & 0.72280e-04_r8,0.65894e-04_r8,0.55174e-04_r8,0.19382e-03_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.39910e-04_r8,0.67782e-04_r8,0.76780e-04_r8,0.79463e-04_r8,0.78210e-04_r8, & + & 0.73902e-04_r8,0.67292e-04_r8,0.56789e-04_r8,0.19106e-03_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.34103e-04_r8,0.54622e-04_r8,0.60315e-04_r8,0.61417e-04_r8,0.60332e-04_r8, & + & 0.58110e-04_r8,0.52537e-04_r8,0.42612e-04_r8,0.15955e-03_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.33853e-04_r8,0.55148e-04_r8,0.61492e-04_r8,0.62745e-04_r8,0.61577e-04_r8, & + & 0.59061e-04_r8,0.53702e-04_r8,0.43873e-04_r8,0.15892e-03_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.33647e-04_r8,0.55699e-04_r8,0.62687e-04_r8,0.64355e-04_r8,0.63160e-04_r8, & + & 0.60072e-04_r8,0.54954e-04_r8,0.45643e-04_r8,0.16047e-03_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.33430e-04_r8,0.56291e-04_r8,0.63770e-04_r8,0.65844e-04_r8,0.64844e-04_r8, & + & 0.61457e-04_r8,0.56064e-04_r8,0.47101e-04_r8,0.16125e-03_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.33186e-04_r8,0.56947e-04_r8,0.64747e-04_r8,0.67352e-04_r8,0.66508e-04_r8, & + & 0.62903e-04_r8,0.57307e-04_r8,0.48379e-04_r8,0.16021e-03_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.36602e-03_r8,0.52858e-03_r8,0.59251e-03_r8,0.61027e-03_r8,0.60893e-03_r8, & + & 0.58987e-03_r8,0.55560e-03_r8,0.49855e-03_r8,0.38105e-03_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.36935e-03_r8,0.53570e-03_r8,0.60138e-03_r8,0.62341e-03_r8,0.62297e-03_r8, & + & 0.60228e-03_r8,0.56872e-03_r8,0.51035e-03_r8,0.39106e-03_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.37348e-03_r8,0.54590e-03_r8,0.61238e-03_r8,0.63855e-03_r8,0.63820e-03_r8, & + & 0.61734e-03_r8,0.58475e-03_r8,0.52206e-03_r8,0.40317e-03_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.37665e-03_r8,0.55373e-03_r8,0.62261e-03_r8,0.65120e-03_r8,0.65250e-03_r8, & + & 0.63373e-03_r8,0.59840e-03_r8,0.53517e-03_r8,0.41639e-03_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.38076e-03_r8,0.56302e-03_r8,0.63456e-03_r8,0.66611e-03_r8,0.66857e-03_r8, & + & 0.65240e-03_r8,0.61521e-03_r8,0.55178e-03_r8,0.43702e-03_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.32225e-03_r8,0.47151e-03_r8,0.53262e-03_r8,0.55192e-03_r8,0.54706e-03_r8, & + & 0.52658e-03_r8,0.49569e-03_r8,0.43958e-03_r8,0.31739e-03_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.32532e-03_r8,0.47816e-03_r8,0.54076e-03_r8,0.56222e-03_r8,0.55834e-03_r8, & + & 0.53879e-03_r8,0.50612e-03_r8,0.44777e-03_r8,0.32763e-03_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.32941e-03_r8,0.48729e-03_r8,0.55083e-03_r8,0.57497e-03_r8,0.57312e-03_r8, & + & 0.55394e-03_r8,0.51991e-03_r8,0.45969e-03_r8,0.33942e-03_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.33303e-03_r8,0.49510e-03_r8,0.56036e-03_r8,0.58720e-03_r8,0.58669e-03_r8, & + & 0.56974e-03_r8,0.53255e-03_r8,0.47385e-03_r8,0.35453e-03_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.33657e-03_r8,0.50290e-03_r8,0.57014e-03_r8,0.59917e-03_r8,0.59997e-03_r8, & + & 0.58475e-03_r8,0.54777e-03_r8,0.48909e-03_r8,0.36980e-03_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.28263e-03_r8,0.41968e-03_r8,0.47376e-03_r8,0.49297e-03_r8,0.48633e-03_r8, & + & 0.46530e-03_r8,0.43654e-03_r8,0.38496e-03_r8,0.26217e-03_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.28517e-03_r8,0.42528e-03_r8,0.48017e-03_r8,0.50148e-03_r8,0.49564e-03_r8, & + & 0.47634e-03_r8,0.44517e-03_r8,0.39228e-03_r8,0.27386e-03_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.28805e-03_r8,0.43254e-03_r8,0.48769e-03_r8,0.51075e-03_r8,0.50628e-03_r8, & + & 0.48940e-03_r8,0.45557e-03_r8,0.40274e-03_r8,0.28527e-03_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.29156e-03_r8,0.44130e-03_r8,0.49824e-03_r8,0.52245e-03_r8,0.52001e-03_r8, & + & 0.50355e-03_r8,0.46711e-03_r8,0.41540e-03_r8,0.29729e-03_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.29453e-03_r8,0.44828e-03_r8,0.50753e-03_r8,0.53257e-03_r8,0.53321e-03_r8, & + & 0.51645e-03_r8,0.48189e-03_r8,0.42882e-03_r8,0.30960e-03_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.24709e-03_r8,0.37040e-03_r8,0.41811e-03_r8,0.43692e-03_r8,0.42924e-03_r8, & + & 0.40974e-03_r8,0.38217e-03_r8,0.33504e-03_r8,0.21956e-03_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.24935e-03_r8,0.37531e-03_r8,0.42359e-03_r8,0.44356e-03_r8,0.43669e-03_r8, & + & 0.41955e-03_r8,0.39063e-03_r8,0.34337e-03_r8,0.23257e-03_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.25192e-03_r8,0.38183e-03_r8,0.43049e-03_r8,0.45130e-03_r8,0.44572e-03_r8, & + & 0.43016e-03_r8,0.39919e-03_r8,0.35274e-03_r8,0.24051e-03_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.25420e-03_r8,0.38887e-03_r8,0.43864e-03_r8,0.46020e-03_r8,0.45692e-03_r8, & + & 0.44111e-03_r8,0.40882e-03_r8,0.36219e-03_r8,0.24966e-03_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.25772e-03_r8,0.39769e-03_r8,0.44993e-03_r8,0.47213e-03_r8,0.47068e-03_r8, & + & 0.45426e-03_r8,0.42157e-03_r8,0.37400e-03_r8,0.25930e-03_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.21574e-03_r8,0.32603e-03_r8,0.36644e-03_r8,0.38307e-03_r8,0.37721e-03_r8, & + & 0.36018e-03_r8,0.33363e-03_r8,0.29143e-03_r8,0.18896e-03_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.21778e-03_r8,0.33044e-03_r8,0.37107e-03_r8,0.38833e-03_r8,0.38426e-03_r8, & + & 0.36797e-03_r8,0.34054e-03_r8,0.29920e-03_r8,0.19816e-03_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.22015e-03_r8,0.33584e-03_r8,0.37735e-03_r8,0.39513e-03_r8,0.39228e-03_r8, & + & 0.37720e-03_r8,0.34842e-03_r8,0.30654e-03_r8,0.20383e-03_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.22252e-03_r8,0.34167e-03_r8,0.38484e-03_r8,0.40343e-03_r8,0.40251e-03_r8, & + & 0.38567e-03_r8,0.35760e-03_r8,0.31401e-03_r8,0.21178e-03_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.22604e-03_r8,0.34964e-03_r8,0.39509e-03_r8,0.41443e-03_r8,0.41465e-03_r8, & + & 0.39685e-03_r8,0.36847e-03_r8,0.32400e-03_r8,0.21929e-03_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.18783e-03_r8,0.28666e-03_r8,0.32037e-03_r8,0.33351e-03_r8,0.32945e-03_r8, & + & 0.31516e-03_r8,0.29066e-03_r8,0.25263e-03_r8,0.16238e-03_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.18921e-03_r8,0.29078e-03_r8,0.32423e-03_r8,0.33799e-03_r8,0.33536e-03_r8, & + & 0.32156e-03_r8,0.29643e-03_r8,0.25941e-03_r8,0.16831e-03_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.19117e-03_r8,0.29487e-03_r8,0.32978e-03_r8,0.34375e-03_r8,0.34274e-03_r8, & + & 0.32907e-03_r8,0.30344e-03_r8,0.26560e-03_r8,0.17389e-03_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.19356e-03_r8,0.29979e-03_r8,0.33631e-03_r8,0.35135e-03_r8,0.35098e-03_r8, & + & 0.33648e-03_r8,0.31108e-03_r8,0.27199e-03_r8,0.18056e-03_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.19643e-03_r8,0.30567e-03_r8,0.34396e-03_r8,0.35996e-03_r8,0.36067e-03_r8, & + & 0.34559e-03_r8,0.32056e-03_r8,0.28009e-03_r8,0.18507e-03_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.16233e-03_r8,0.25159e-03_r8,0.28051e-03_r8,0.29071e-03_r8,0.28724e-03_r8, & + & 0.27399e-03_r8,0.25257e-03_r8,0.21995e-03_r8,0.15053e-03_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.16394e-03_r8,0.25497e-03_r8,0.28374e-03_r8,0.29454e-03_r8,0.29203e-03_r8, & + & 0.28002e-03_r8,0.25781e-03_r8,0.22523e-03_r8,0.15467e-03_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.16554e-03_r8,0.25862e-03_r8,0.28837e-03_r8,0.29946e-03_r8,0.29804e-03_r8, & + & 0.28580e-03_r8,0.26386e-03_r8,0.23003e-03_r8,0.15858e-03_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.16755e-03_r8,0.26275e-03_r8,0.29380e-03_r8,0.30624e-03_r8,0.30499e-03_r8, & + & 0.29233e-03_r8,0.27029e-03_r8,0.23539e-03_r8,0.16161e-03_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.17007e-03_r8,0.26765e-03_r8,0.30035e-03_r8,0.31353e-03_r8,0.31332e-03_r8, & + & 0.30019e-03_r8,0.27871e-03_r8,0.24192e-03_r8,0.16587e-03_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.14021e-03_r8,0.21983e-03_r8,0.24557e-03_r8,0.25394e-03_r8,0.25027e-03_r8, & + & 0.23769e-03_r8,0.21853e-03_r8,0.19056e-03_r8,0.17210e-03_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.14181e-03_r8,0.22244e-03_r8,0.24837e-03_r8,0.25730e-03_r8,0.25433e-03_r8, & + & 0.24284e-03_r8,0.22361e-03_r8,0.19448e-03_r8,0.16707e-03_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.14344e-03_r8,0.22578e-03_r8,0.25216e-03_r8,0.26169e-03_r8,0.25950e-03_r8, & + & 0.24760e-03_r8,0.22868e-03_r8,0.19861e-03_r8,0.16518e-03_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.14524e-03_r8,0.22935e-03_r8,0.25652e-03_r8,0.26715e-03_r8,0.26554e-03_r8, & + & 0.25327e-03_r8,0.23470e-03_r8,0.20360e-03_r8,0.16514e-03_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.14752e-03_r8,0.23348e-03_r8,0.26209e-03_r8,0.27316e-03_r8,0.27225e-03_r8, & + & 0.26056e-03_r8,0.24203e-03_r8,0.20916e-03_r8,0.16671e-03_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.12008e-03_r8,0.19084e-03_r8,0.21359e-03_r8,0.22137e-03_r8,0.21826e-03_r8, & + & 0.20646e-03_r8,0.18855e-03_r8,0.16443e-03_r8,0.31379e-03_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.12170e-03_r8,0.19281e-03_r8,0.21619e-03_r8,0.22414e-03_r8,0.22156e-03_r8, & + & 0.21036e-03_r8,0.19272e-03_r8,0.16751e-03_r8,0.30810e-03_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.12341e-03_r8,0.19553e-03_r8,0.21930e-03_r8,0.22810e-03_r8,0.22604e-03_r8, & + & 0.21457e-03_r8,0.19724e-03_r8,0.17093e-03_r8,0.30579e-03_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.12515e-03_r8,0.19866e-03_r8,0.22306e-03_r8,0.23273e-03_r8,0.23128e-03_r8, & + & 0.22000e-03_r8,0.20255e-03_r8,0.17520e-03_r8,0.30468e-03_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.12711e-03_r8,0.20244e-03_r8,0.22780e-03_r8,0.23779e-03_r8,0.23723e-03_r8, & + & 0.22672e-03_r8,0.20873e-03_r8,0.18006e-03_r8,0.30071e-03_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.10239e-03_r8,0.16495e-03_r8,0.18568e-03_r8,0.19287e-03_r8,0.19038e-03_r8, & + & 0.17962e-03_r8,0.16274e-03_r8,0.14112e-03_r8,0.46281e-03_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.10386e-03_r8,0.16652e-03_r8,0.18791e-03_r8,0.19539e-03_r8,0.19307e-03_r8, & + & 0.18291e-03_r8,0.16628e-03_r8,0.14354e-03_r8,0.46032e-03_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.10550e-03_r8,0.16884e-03_r8,0.19060e-03_r8,0.19863e-03_r8,0.19685e-03_r8, & + & 0.18669e-03_r8,0.17045e-03_r8,0.14674e-03_r8,0.45882e-03_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.10710e-03_r8,0.17185e-03_r8,0.19377e-03_r8,0.20238e-03_r8,0.20140e-03_r8, & + & 0.19164e-03_r8,0.17544e-03_r8,0.15076e-03_r8,0.45556e-03_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.10887e-03_r8,0.17528e-03_r8,0.19755e-03_r8,0.20663e-03_r8,0.20650e-03_r8, & + & 0.19756e-03_r8,0.18068e-03_r8,0.15495e-03_r8,0.45295e-03_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.87454e-04_r8,0.14214e-03_r8,0.16093e-03_r8,0.16784e-03_r8,0.16634e-03_r8, & + & 0.15750e-03_r8,0.14233e-03_r8,0.12157e-03_r8,0.50227e-03_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.89026e-04_r8,0.14363e-03_r8,0.16297e-03_r8,0.17024e-03_r8,0.16905e-03_r8, & + & 0.16052e-03_r8,0.14560e-03_r8,0.12384e-03_r8,0.48800e-03_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.90456e-04_r8,0.14595e-03_r8,0.16534e-03_r8,0.17342e-03_r8,0.17281e-03_r8, & + & 0.16441e-03_r8,0.14965e-03_r8,0.12699e-03_r8,0.48638e-03_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.91788e-04_r8,0.14885e-03_r8,0.16823e-03_r8,0.17680e-03_r8,0.17688e-03_r8, & + & 0.16911e-03_r8,0.15409e-03_r8,0.13060e-03_r8,0.48097e-03_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.92958e-04_r8,0.15220e-03_r8,0.17197e-03_r8,0.18085e-03_r8,0.18150e-03_r8, & + & 0.17440e-03_r8,0.15892e-03_r8,0.13466e-03_r8,0.48115e-03_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.74228e-04_r8,0.12171e-03_r8,0.13828e-03_r8,0.14464e-03_r8,0.14381e-03_r8, & + & 0.13674e-03_r8,0.12370e-03_r8,0.10454e-03_r8,0.48263e-03_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.75542e-04_r8,0.12330e-03_r8,0.13992e-03_r8,0.14688e-03_r8,0.14666e-03_r8, & + & 0.13981e-03_r8,0.12694e-03_r8,0.10662e-03_r8,0.46961e-03_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.76696e-04_r8,0.12551e-03_r8,0.14218e-03_r8,0.14964e-03_r8,0.14989e-03_r8, & + & 0.14346e-03_r8,0.13058e-03_r8,0.10986e-03_r8,0.45986e-03_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.77769e-04_r8,0.12821e-03_r8,0.14505e-03_r8,0.15276e-03_r8,0.15361e-03_r8, & + & 0.14764e-03_r8,0.13466e-03_r8,0.11322e-03_r8,0.45064e-03_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.78633e-04_r8,0.13113e-03_r8,0.14863e-03_r8,0.15667e-03_r8,0.15783e-03_r8, & + & 0.15249e-03_r8,0.13915e-03_r8,0.11696e-03_r8,0.45257e-03_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.62659e-04_r8,0.10388e-03_r8,0.11828e-03_r8,0.12392e-03_r8,0.12371e-03_r8, & + & 0.11811e-03_r8,0.10712e-03_r8,0.89769e-04_r8,0.40925e-03_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.63709e-04_r8,0.10546e-03_r8,0.11986e-03_r8,0.12594e-03_r8,0.12627e-03_r8, & + & 0.12095e-03_r8,0.11006e-03_r8,0.92053e-04_r8,0.39852e-03_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.64717e-04_r8,0.10750e-03_r8,0.12189e-03_r8,0.12839e-03_r8,0.12907e-03_r8, & + & 0.12414e-03_r8,0.11317e-03_r8,0.94939e-04_r8,0.39013e-03_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.65465e-04_r8,0.10983e-03_r8,0.12464e-03_r8,0.13149e-03_r8,0.13253e-03_r8, & + & 0.12801e-03_r8,0.11693e-03_r8,0.98001e-04_r8,0.38349e-03_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.66137e-04_r8,0.11222e-03_r8,0.12786e-03_r8,0.13517e-03_r8,0.13652e-03_r8, & + & 0.13219e-03_r8,0.12093e-03_r8,0.10155e-03_r8,0.38305e-03_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.60998e-03_r8,0.92357e-03_r8,0.10463e-02_r8,0.11196e-02_r8,0.11571e-02_r8, & + & 0.11569e-02_r8,0.11152e-02_r8,0.10342e-02_r8,0.80721e-03_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.61496e-03_r8,0.93510e-03_r8,0.10604e-02_r8,0.11361e-02_r8,0.11777e-02_r8, & + & 0.11834e-02_r8,0.11457e-02_r8,0.10708e-02_r8,0.83732e-03_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.62454e-03_r8,0.95002e-03_r8,0.10819e-02_r8,0.11594e-02_r8,0.12038e-02_r8, & + & 0.12158e-02_r8,0.11823e-02_r8,0.11158e-02_r8,0.87187e-03_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.63013e-03_r8,0.96444e-03_r8,0.11010e-02_r8,0.11847e-02_r8,0.12326e-02_r8, & + & 0.12499e-02_r8,0.12239e-02_r8,0.11623e-02_r8,0.91505e-03_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.63867e-03_r8,0.98562e-03_r8,0.11276e-02_r8,0.12151e-02_r8,0.12673e-02_r8, & + & 0.12886e-02_r8,0.12687e-02_r8,0.12127e-02_r8,0.95931e-03_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.54006e-03_r8,0.82110e-03_r8,0.93517e-03_r8,0.10086e-02_r8,0.10436e-02_r8, & + & 0.10473e-02_r8,0.10071e-02_r8,0.92435e-03_r8,0.69632e-03_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.54512e-03_r8,0.83214e-03_r8,0.94586e-03_r8,0.10224e-02_r8,0.10616e-02_r8, & + & 0.10697e-02_r8,0.10360e-02_r8,0.95897e-03_r8,0.72282e-03_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.55430e-03_r8,0.84713e-03_r8,0.96481e-03_r8,0.10423e-02_r8,0.10850e-02_r8, & + & 0.10972e-02_r8,0.10691e-02_r8,0.99640e-03_r8,0.75512e-03_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.56089e-03_r8,0.86369e-03_r8,0.98575e-03_r8,0.10648e-02_r8,0.11112e-02_r8, & + & 0.11281e-02_r8,0.11049e-02_r8,0.10361e-02_r8,0.79150e-03_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.56701e-03_r8,0.88105e-03_r8,0.10081e-02_r8,0.10898e-02_r8,0.11420e-02_r8, & + & 0.11626e-02_r8,0.11406e-02_r8,0.10780e-02_r8,0.83023e-03_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.47586e-03_r8,0.72781e-03_r8,0.83369e-03_r8,0.89860e-03_r8,0.93234e-03_r8, & + & 0.93626e-03_r8,0.89909e-03_r8,0.81585e-03_r8,0.59036e-03_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.48035e-03_r8,0.73757e-03_r8,0.84502e-03_r8,0.91276e-03_r8,0.94800e-03_r8, & + & 0.95536e-03_r8,0.92668e-03_r8,0.84501e-03_r8,0.61080e-03_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.48667e-03_r8,0.74941e-03_r8,0.86058e-03_r8,0.92996e-03_r8,0.96794e-03_r8, & + & 0.97737e-03_r8,0.95368e-03_r8,0.87646e-03_r8,0.63872e-03_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.49637e-03_r8,0.76538e-03_r8,0.87882e-03_r8,0.95073e-03_r8,0.99190e-03_r8, & + & 0.10051e-02_r8,0.98438e-03_r8,0.91070e-03_r8,0.66866e-03_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.50269e-03_r8,0.78028e-03_r8,0.89635e-03_r8,0.97198e-03_r8,0.10179e-02_r8, & + & 0.10338e-02_r8,0.10130e-02_r8,0.94553e-03_r8,0.70095e-03_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.41745e-03_r8,0.64505e-03_r8,0.73966e-03_r8,0.79761e-03_r8,0.82752e-03_r8, & + & 0.82878e-03_r8,0.79470e-03_r8,0.71636e-03_r8,0.49987e-03_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.42212e-03_r8,0.65318e-03_r8,0.75017e-03_r8,0.80979e-03_r8,0.84194e-03_r8, & + & 0.84473e-03_r8,0.81717e-03_r8,0.73865e-03_r8,0.51625e-03_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.42808e-03_r8,0.66407e-03_r8,0.76314e-03_r8,0.82416e-03_r8,0.85814e-03_r8, & + & 0.86375e-03_r8,0.83972e-03_r8,0.76440e-03_r8,0.53894e-03_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.43544e-03_r8,0.67737e-03_r8,0.77911e-03_r8,0.84222e-03_r8,0.87777e-03_r8, & + & 0.88583e-03_r8,0.86479e-03_r8,0.79362e-03_r8,0.56271e-03_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.44549e-03_r8,0.69330e-03_r8,0.79686e-03_r8,0.86274e-03_r8,0.90103e-03_r8, & + & 0.91189e-03_r8,0.89184e-03_r8,0.82416e-03_r8,0.58887e-03_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.36593e-03_r8,0.56942e-03_r8,0.65432e-03_r8,0.70354e-03_r8,0.72916e-03_r8, & + & 0.72850e-03_r8,0.69713e-03_r8,0.62558e-03_r8,0.42621e-03_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.37099e-03_r8,0.57654e-03_r8,0.66395e-03_r8,0.71472e-03_r8,0.74107e-03_r8, & + & 0.74240e-03_r8,0.71535e-03_r8,0.64376e-03_r8,0.43884e-03_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.37647e-03_r8,0.58652e-03_r8,0.67530e-03_r8,0.72837e-03_r8,0.75654e-03_r8, & + & 0.75759e-03_r8,0.73402e-03_r8,0.66546e-03_r8,0.45630e-03_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.38311e-03_r8,0.59837e-03_r8,0.68871e-03_r8,0.74328e-03_r8,0.77277e-03_r8, & + & 0.77677e-03_r8,0.75490e-03_r8,0.68962e-03_r8,0.47449e-03_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.39217e-03_r8,0.61368e-03_r8,0.70480e-03_r8,0.76178e-03_r8,0.79297e-03_r8, & + & 0.79889e-03_r8,0.77761e-03_r8,0.71542e-03_r8,0.49580e-03_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.32055e-03_r8,0.49922e-03_r8,0.57435e-03_r8,0.61868e-03_r8,0.63931e-03_r8, & + & 0.63779e-03_r8,0.60689e-03_r8,0.54327e-03_r8,0.36282e-03_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.32502e-03_r8,0.50520e-03_r8,0.58251e-03_r8,0.62835e-03_r8,0.64977e-03_r8, & + & 0.64920e-03_r8,0.62209e-03_r8,0.55837e-03_r8,0.37399e-03_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.33055e-03_r8,0.51462e-03_r8,0.59267e-03_r8,0.63972e-03_r8,0.66253e-03_r8, & + & 0.66213e-03_r8,0.63802e-03_r8,0.57660e-03_r8,0.38710e-03_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.33647e-03_r8,0.52569e-03_r8,0.60454e-03_r8,0.65260e-03_r8,0.67645e-03_r8, & + & 0.67638e-03_r8,0.65560e-03_r8,0.59667e-03_r8,0.40130e-03_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.34306e-03_r8,0.53846e-03_r8,0.61820e-03_r8,0.66796e-03_r8,0.69284e-03_r8, & + & 0.69400e-03_r8,0.67340e-03_r8,0.61700e-03_r8,0.41923e-03_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.28149e-03_r8,0.43644e-03_r8,0.49974e-03_r8,0.53938e-03_r8,0.55701e-03_r8, & + & 0.55579e-03_r8,0.52736e-03_r8,0.47001e-03_r8,0.31306e-03_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.28528e-03_r8,0.44207e-03_r8,0.50655e-03_r8,0.54763e-03_r8,0.56691e-03_r8, & + & 0.56439e-03_r8,0.53930e-03_r8,0.48247e-03_r8,0.32173e-03_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.29004e-03_r8,0.45020e-03_r8,0.51518e-03_r8,0.55741e-03_r8,0.57771e-03_r8, & + & 0.57585e-03_r8,0.55263e-03_r8,0.49748e-03_r8,0.33090e-03_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.29568e-03_r8,0.46070e-03_r8,0.52625e-03_r8,0.56864e-03_r8,0.58962e-03_r8, & + & 0.58944e-03_r8,0.56702e-03_r8,0.51458e-03_r8,0.34232e-03_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.30178e-03_r8,0.47274e-03_r8,0.53886e-03_r8,0.58253e-03_r8,0.60354e-03_r8, & + & 0.60454e-03_r8,0.58225e-03_r8,0.53128e-03_r8,0.35470e-03_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.24786e-03_r8,0.38205e-03_r8,0.43403e-03_r8,0.46727e-03_r8,0.48302e-03_r8, & + & 0.48227e-03_r8,0.45812e-03_r8,0.40611e-03_r8,0.30468e-03_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.25026e-03_r8,0.38705e-03_r8,0.43948e-03_r8,0.47351e-03_r8,0.49158e-03_r8, & + & 0.49003e-03_r8,0.46771e-03_r8,0.41673e-03_r8,0.30992e-03_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.25464e-03_r8,0.39453e-03_r8,0.44681e-03_r8,0.48211e-03_r8,0.50112e-03_r8, & + & 0.49992e-03_r8,0.47844e-03_r8,0.42901e-03_r8,0.31626e-03_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.25978e-03_r8,0.40390e-03_r8,0.45683e-03_r8,0.49220e-03_r8,0.51134e-03_r8, & + & 0.51141e-03_r8,0.48898e-03_r8,0.44238e-03_r8,0.32406e-03_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.26514e-03_r8,0.41428e-03_r8,0.46827e-03_r8,0.50433e-03_r8,0.52333e-03_r8, & + & 0.52414e-03_r8,0.50147e-03_r8,0.45619e-03_r8,0.33317e-03_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.21824e-03_r8,0.33786e-03_r8,0.37946e-03_r8,0.40535e-03_r8,0.41752e-03_r8, & + & 0.41661e-03_r8,0.39611e-03_r8,0.34986e-03_r8,0.52178e-03_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.22059e-03_r8,0.34230e-03_r8,0.38410e-03_r8,0.41056e-03_r8,0.42477e-03_r8, & + & 0.42372e-03_r8,0.40485e-03_r8,0.35866e-03_r8,0.50681e-03_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.22400e-03_r8,0.34814e-03_r8,0.39039e-03_r8,0.41748e-03_r8,0.43284e-03_r8, & + & 0.43220e-03_r8,0.41363e-03_r8,0.36885e-03_r8,0.49302e-03_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.22873e-03_r8,0.35603e-03_r8,0.39905e-03_r8,0.42659e-03_r8,0.44174e-03_r8, & + & 0.44167e-03_r8,0.42288e-03_r8,0.37972e-03_r8,0.48294e-03_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.23347e-03_r8,0.36495e-03_r8,0.40893e-03_r8,0.43763e-03_r8,0.45181e-03_r8, & + & 0.45234e-03_r8,0.43347e-03_r8,0.39120e-03_r8,0.47762e-03_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.19122e-03_r8,0.29954e-03_r8,0.33486e-03_r8,0.35474e-03_r8,0.36349e-03_r8, & + & 0.36120e-03_r8,0.34300e-03_r8,0.30153e-03_r8,0.10818e-02_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.19375e-03_r8,0.30331e-03_r8,0.33858e-03_r8,0.35959e-03_r8,0.36963e-03_r8, & + & 0.36736e-03_r8,0.35033e-03_r8,0.30927e-03_r8,0.10683e-02_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.19685e-03_r8,0.30858e-03_r8,0.34410e-03_r8,0.36599e-03_r8,0.37648e-03_r8, & + & 0.37420e-03_r8,0.35748e-03_r8,0.31737e-03_r8,0.10704e-02_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.20091e-03_r8,0.31499e-03_r8,0.35151e-03_r8,0.37400e-03_r8,0.38421e-03_r8, & + & 0.38207e-03_r8,0.36506e-03_r8,0.32617e-03_r8,0.10743e-02_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.20539e-03_r8,0.32294e-03_r8,0.36050e-03_r8,0.38325e-03_r8,0.39308e-03_r8, & + & 0.39074e-03_r8,0.37406e-03_r8,0.33544e-03_r8,0.10696e-02_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.16667e-03_r8,0.26520e-03_r8,0.29671e-03_r8,0.31441e-03_r8,0.32093e-03_r8, & + & 0.31659e-03_r8,0.30045e-03_r8,0.26340e-03_r8,0.11835e-02_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.16885e-03_r8,0.26948e-03_r8,0.30096e-03_r8,0.31914e-03_r8,0.32661e-03_r8, & + & 0.32210e-03_r8,0.30657e-03_r8,0.27004e-03_r8,0.11814e-02_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.17223e-03_r8,0.27439e-03_r8,0.30661e-03_r8,0.32470e-03_r8,0.33272e-03_r8, & + & 0.32842e-03_r8,0.31227e-03_r8,0.27654e-03_r8,0.11630e-02_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.17618e-03_r8,0.28049e-03_r8,0.31365e-03_r8,0.33181e-03_r8,0.33965e-03_r8, & + & 0.33555e-03_r8,0.31903e-03_r8,0.28400e-03_r8,0.11485e-02_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.18103e-03_r8,0.28752e-03_r8,0.32181e-03_r8,0.34031e-03_r8,0.34776e-03_r8, & + & 0.34353e-03_r8,0.32710e-03_r8,0.29221e-03_r8,0.11367e-02_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.14364e-03_r8,0.23191e-03_r8,0.26011e-03_r8,0.27602e-03_r8,0.28230e-03_r8, & + & 0.27753e-03_r8,0.26259e-03_r8,0.22940e-03_r8,0.11242e-02_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.14586e-03_r8,0.23578e-03_r8,0.26464e-03_r8,0.28074e-03_r8,0.28728e-03_r8, & + & 0.28268e-03_r8,0.26740e-03_r8,0.23511e-03_r8,0.11131e-02_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.14908e-03_r8,0.24042e-03_r8,0.27020e-03_r8,0.28659e-03_r8,0.29280e-03_r8, & + & 0.28866e-03_r8,0.27254e-03_r8,0.24089e-03_r8,0.10996e-02_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.15297e-03_r8,0.24595e-03_r8,0.27661e-03_r8,0.29313e-03_r8,0.29926e-03_r8, & + & 0.29513e-03_r8,0.27870e-03_r8,0.24706e-03_r8,0.10965e-02_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.15735e-03_r8,0.25242e-03_r8,0.28422e-03_r8,0.30069e-03_r8,0.30695e-03_r8, & + & 0.30241e-03_r8,0.28613e-03_r8,0.25425e-03_r8,0.10839e-02_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.12345e-03_r8,0.20108e-03_r8,0.22674e-03_r8,0.24086e-03_r8,0.24638e-03_r8, & + & 0.24238e-03_r8,0.22876e-03_r8,0.19931e-03_r8,0.96895e-03_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.12581e-03_r8,0.20480e-03_r8,0.23117e-03_r8,0.24535e-03_r8,0.25104e-03_r8, & + & 0.24702e-03_r8,0.23303e-03_r8,0.20421e-03_r8,0.96294e-03_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.12856e-03_r8,0.20921e-03_r8,0.23606e-03_r8,0.25076e-03_r8,0.25631e-03_r8, & + & 0.25243e-03_r8,0.23816e-03_r8,0.20920e-03_r8,0.95736e-03_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.13210e-03_r8,0.21428e-03_r8,0.24223e-03_r8,0.25691e-03_r8,0.26218e-03_r8, & + & 0.25847e-03_r8,0.24400e-03_r8,0.21468e-03_r8,0.95389e-03_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.13599e-03_r8,0.22037e-03_r8,0.24914e-03_r8,0.26391e-03_r8,0.26911e-03_r8, & + & 0.26543e-03_r8,0.25095e-03_r8,0.22101e-03_r8,0.94116e-03_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.10602e-02_r8,0.17123e-02_r8,0.20157e-02_r8,0.22277e-02_r8,0.23726e-02_r8, & + & 0.24628e-02_r8,0.25069e-02_r8,0.24686e-02_r8,0.20168e-02_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.10672e-02_r8,0.17270e-02_r8,0.20414e-02_r8,0.22652e-02_r8,0.24211e-02_r8, & + & 0.25212e-02_r8,0.25704e-02_r8,0.25272e-02_r8,0.20646e-02_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.10788e-02_r8,0.17509e-02_r8,0.20769e-02_r8,0.23112e-02_r8,0.24814e-02_r8, & + & 0.25914e-02_r8,0.26418e-02_r8,0.25942e-02_r8,0.21193e-02_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.10874e-02_r8,0.17764e-02_r8,0.21176e-02_r8,0.23585e-02_r8,0.25381e-02_r8, & + & 0.26622e-02_r8,0.27175e-02_r8,0.26689e-02_r8,0.21851e-02_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.11018e-02_r8,0.18090e-02_r8,0.21640e-02_r8,0.24172e-02_r8,0.26051e-02_r8, & + & 0.27415e-02_r8,0.28075e-02_r8,0.27566e-02_r8,0.22604e-02_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.95075e-03_r8,0.15355e-02_r8,0.17976e-02_r8,0.19766e-02_r8,0.21006e-02_r8, & + & 0.21710e-02_r8,0.21998e-02_r8,0.21663e-02_r8,0.17568e-02_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.96010e-03_r8,0.15501e-02_r8,0.18242e-02_r8,0.20112e-02_r8,0.21419e-02_r8, & + & 0.22180e-02_r8,0.22475e-02_r8,0.22135e-02_r8,0.17960e-02_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.97337e-03_r8,0.15726e-02_r8,0.18580e-02_r8,0.20531e-02_r8,0.21905e-02_r8, & + & 0.22742e-02_r8,0.23072e-02_r8,0.22697e-02_r8,0.18409e-02_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.98600e-03_r8,0.15975e-02_r8,0.18942e-02_r8,0.20984e-02_r8,0.22403e-02_r8, & + & 0.23334e-02_r8,0.23735e-02_r8,0.23328e-02_r8,0.18922e-02_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.99685e-03_r8,0.16266e-02_r8,0.19353e-02_r8,0.21493e-02_r8,0.22931e-02_r8, & + & 0.23955e-02_r8,0.24466e-02_r8,0.24068e-02_r8,0.19548e-02_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.85253e-03_r8,0.13731e-02_r8,0.15966e-02_r8,0.17555e-02_r8,0.18660e-02_r8, & + & 0.19267e-02_r8,0.19415e-02_r8,0.18992e-02_r8,0.15125e-02_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.86131e-03_r8,0.13853e-02_r8,0.16172e-02_r8,0.17827e-02_r8,0.18992e-02_r8, & + & 0.19616e-02_r8,0.19781e-02_r8,0.19388e-02_r8,0.15472e-02_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.87215e-03_r8,0.13990e-02_r8,0.16433e-02_r8,0.18151e-02_r8,0.19357e-02_r8, & + & 0.20044e-02_r8,0.20244e-02_r8,0.19864e-02_r8,0.15842e-02_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.88704e-03_r8,0.14261e-02_r8,0.16795e-02_r8,0.18576e-02_r8,0.19802e-02_r8, & + & 0.20536e-02_r8,0.20804e-02_r8,0.20410e-02_r8,0.16256e-02_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.89758e-03_r8,0.14527e-02_r8,0.17171e-02_r8,0.19025e-02_r8,0.20236e-02_r8, & + & 0.21045e-02_r8,0.21413e-02_r8,0.21023e-02_r8,0.16764e-02_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.76168e-03_r8,0.12206e-02_r8,0.14175e-02_r8,0.15588e-02_r8,0.16575e-02_r8, & + & 0.17098e-02_r8,0.17134e-02_r8,0.16603e-02_r8,0.12974e-02_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.76958e-03_r8,0.12314e-02_r8,0.14342e-02_r8,0.15807e-02_r8,0.16847e-02_r8, & + & 0.17400e-02_r8,0.17442e-02_r8,0.16938e-02_r8,0.13260e-02_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.78002e-03_r8,0.12481e-02_r8,0.14573e-02_r8,0.16092e-02_r8,0.17173e-02_r8, & + & 0.17771e-02_r8,0.17830e-02_r8,0.17337e-02_r8,0.13577e-02_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.79261e-03_r8,0.12694e-02_r8,0.14861e-02_r8,0.16420e-02_r8,0.17536e-02_r8, & + & 0.18179e-02_r8,0.18286e-02_r8,0.17776e-02_r8,0.13930e-02_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.80905e-03_r8,0.12930e-02_r8,0.15216e-02_r8,0.16835e-02_r8,0.17969e-02_r8, & + & 0.18651e-02_r8,0.18829e-02_r8,0.18324e-02_r8,0.14370e-02_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.67567e-03_r8,0.10847e-02_r8,0.12673e-02_r8,0.13865e-02_r8,0.14678e-02_r8, & + & 0.15102e-02_r8,0.15099e-02_r8,0.14466e-02_r8,0.11079e-02_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.68234e-03_r8,0.10948e-02_r8,0.12810e-02_r8,0.14048e-02_r8,0.14909e-02_r8, & + & 0.15364e-02_r8,0.15351e-02_r8,0.14749e-02_r8,0.11322e-02_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.69172e-03_r8,0.11094e-02_r8,0.12954e-02_r8,0.14275e-02_r8,0.15177e-02_r8, & + & 0.15693e-02_r8,0.15680e-02_r8,0.15069e-02_r8,0.11581e-02_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.70397e-03_r8,0.11284e-02_r8,0.13174e-02_r8,0.14563e-02_r8,0.15501e-02_r8, & + & 0.16053e-02_r8,0.16071e-02_r8,0.15445e-02_r8,0.11891e-02_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.72110e-03_r8,0.11540e-02_r8,0.13487e-02_r8,0.14917e-02_r8,0.15891e-02_r8, & + & 0.16474e-02_r8,0.16536e-02_r8,0.15913e-02_r8,0.12262e-02_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.59508e-03_r8,0.96565e-03_r8,0.11271e-02_r8,0.12321e-02_r8,0.12935e-02_r8, & + & 0.13263e-02_r8,0.13235e-02_r8,0.12583e-02_r8,0.94318e-03_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.60163e-03_r8,0.97555e-03_r8,0.11390e-02_r8,0.12428e-02_r8,0.13136e-02_r8, & + & 0.13483e-02_r8,0.13443e-02_r8,0.12812e-02_r8,0.96040e-03_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.61035e-03_r8,0.98842e-03_r8,0.11551e-02_r8,0.12623e-02_r8,0.13370e-02_r8, & + & 0.13759e-02_r8,0.13716e-02_r8,0.13073e-02_r8,0.98049e-03_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.62216e-03_r8,0.10038e-02_r8,0.11750e-02_r8,0.12870e-02_r8,0.13646e-02_r8, & + & 0.14087e-02_r8,0.14042e-02_r8,0.13389e-02_r8,0.10049e-02_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.63568e-03_r8,0.10246e-02_r8,0.11986e-02_r8,0.13152e-02_r8,0.13969e-02_r8, & + & 0.14439e-02_r8,0.14425e-02_r8,0.13760e-02_r8,0.10351e-02_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.52222e-03_r8,0.85609e-03_r8,0.99991e-03_r8,0.10870e-02_r8,0.11353e-02_r8, & + & 0.11602e-02_r8,0.11537e-02_r8,0.10909e-02_r8,0.79969e-03_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.52839e-03_r8,0.86572e-03_r8,0.10120e-02_r8,0.11011e-02_r8,0.11521e-02_r8, & + & 0.11786e-02_r8,0.11705e-02_r8,0.11093e-02_r8,0.81421e-03_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.53695e-03_r8,0.87703e-03_r8,0.10261e-02_r8,0.11177e-02_r8,0.11714e-02_r8, & + & 0.12016e-02_r8,0.11930e-02_r8,0.11309e-02_r8,0.83157e-03_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.54734e-03_r8,0.89105e-03_r8,0.10435e-02_r8,0.11340e-02_r8,0.11954e-02_r8, & + & 0.12276e-02_r8,0.12204e-02_r8,0.11559e-02_r8,0.85189e-03_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.56071e-03_r8,0.90902e-03_r8,0.10648e-02_r8,0.11575e-02_r8,0.12234e-02_r8, & + & 0.12571e-02_r8,0.12523e-02_r8,0.11865e-02_r8,0.87630e-03_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.45809e-03_r8,0.75296e-03_r8,0.88022e-03_r8,0.95530e-03_r8,0.99775e-03_r8, & + & 0.10107e-02_r8,0.99991e-03_r8,0.94255e-03_r8,0.69349e-03_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.46457e-03_r8,0.76241e-03_r8,0.89241e-03_r8,0.96833e-03_r8,0.10107e-02_r8, & + & 0.10258e-02_r8,0.10136e-02_r8,0.95735e-03_r8,0.70413e-03_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.47249e-03_r8,0.77258e-03_r8,0.90578e-03_r8,0.98260e-03_r8,0.10233e-02_r8, & + & 0.10448e-02_r8,0.10324e-02_r8,0.97481e-03_r8,0.71522e-03_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.48263e-03_r8,0.78537e-03_r8,0.92183e-03_r8,0.10012e-02_r8,0.10427e-02_r8, & + & 0.10663e-02_r8,0.10558e-02_r8,0.99531e-03_r8,0.72922e-03_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.49501e-03_r8,0.80218e-03_r8,0.94059e-03_r8,0.10219e-02_r8,0.10669e-02_r8, & + & 0.10907e-02_r8,0.10824e-02_r8,0.10204e-02_r8,0.74659e-03_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.40630e-03_r8,0.65697e-03_r8,0.76693e-03_r8,0.83253e-03_r8,0.86881e-03_r8, & + & 0.87661e-03_r8,0.86393e-03_r8,0.81158e-03_r8,0.85763e-03_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.41166e-03_r8,0.66657e-03_r8,0.77941e-03_r8,0.84564e-03_r8,0.88174e-03_r8, & + & 0.88952e-03_r8,0.87488e-03_r8,0.82351e-03_r8,0.84633e-03_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.41847e-03_r8,0.67680e-03_r8,0.79185e-03_r8,0.85875e-03_r8,0.89476e-03_r8, & + & 0.90456e-03_r8,0.89101e-03_r8,0.83833e-03_r8,0.84017e-03_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.42661e-03_r8,0.68815e-03_r8,0.80637e-03_r8,0.87435e-03_r8,0.91036e-03_r8, & + & 0.92205e-03_r8,0.90961e-03_r8,0.85502e-03_r8,0.83895e-03_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.43776e-03_r8,0.70278e-03_r8,0.82329e-03_r8,0.89247e-03_r8,0.92828e-03_r8, & + & 0.94238e-03_r8,0.93168e-03_r8,0.87536e-03_r8,0.84088e-03_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.36854e-03_r8,0.57908e-03_r8,0.66869e-03_r8,0.72258e-03_r8,0.75231e-03_r8, & + & 0.75942e-03_r8,0.74383e-03_r8,0.69709e-03_r8,0.20395e-02_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.37298e-03_r8,0.58711e-03_r8,0.68015e-03_r8,0.73349e-03_r8,0.76293e-03_r8, & + & 0.77052e-03_r8,0.75338e-03_r8,0.70798e-03_r8,0.19202e-02_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.37876e-03_r8,0.59595e-03_r8,0.69100e-03_r8,0.74575e-03_r8,0.77497e-03_r8, & + & 0.78295e-03_r8,0.76740e-03_r8,0.72017e-03_r8,0.18161e-02_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.38615e-03_r8,0.60708e-03_r8,0.70373e-03_r8,0.75914e-03_r8,0.78952e-03_r8, & + & 0.79663e-03_r8,0.78331e-03_r8,0.73385e-03_r8,0.17247e-02_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.39564e-03_r8,0.62052e-03_r8,0.71856e-03_r8,0.77512e-03_r8,0.80699e-03_r8, & + & 0.81444e-03_r8,0.80141e-03_r8,0.75081e-03_r8,0.16568e-02_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.33320e-03_r8,0.52088e-03_r8,0.59646e-03_r8,0.63812e-03_r8,0.65660e-03_r8, & + & 0.65900e-03_r8,0.64138e-03_r8,0.60020e-03_r8,0.25696e-02_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.33882e-03_r8,0.52942e-03_r8,0.60584e-03_r8,0.64728e-03_r8,0.66639e-03_r8, & + & 0.66995e-03_r8,0.65115e-03_r8,0.61030e-03_r8,0.24243e-02_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.34516e-03_r8,0.53993e-03_r8,0.61579e-03_r8,0.65783e-03_r8,0.67758e-03_r8, & + & 0.68193e-03_r8,0.66413e-03_r8,0.62169e-03_r8,0.23408e-02_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.35301e-03_r8,0.55124e-03_r8,0.62753e-03_r8,0.66999e-03_r8,0.69148e-03_r8, & + & 0.69508e-03_r8,0.67858e-03_r8,0.63426e-03_r8,0.22732e-02_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.36214e-03_r8,0.56453e-03_r8,0.64151e-03_r8,0.68481e-03_r8,0.70755e-03_r8, & + & 0.71086e-03_r8,0.69483e-03_r8,0.64938e-03_r8,0.21869e-02_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.29653e-03_r8,0.46559e-03_r8,0.53073e-03_r8,0.56520e-03_r8,0.57894e-03_r8, & + & 0.57686e-03_r8,0.55698e-03_r8,0.51584e-03_r8,0.26304e-02_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.30188e-03_r8,0.47447e-03_r8,0.54017e-03_r8,0.57406e-03_r8,0.58804e-03_r8, & + & 0.58653e-03_r8,0.56630e-03_r8,0.52472e-03_r8,0.24930e-02_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.30861e-03_r8,0.48517e-03_r8,0.55102e-03_r8,0.58380e-03_r8,0.59890e-03_r8, & + & 0.59725e-03_r8,0.57721e-03_r8,0.53486e-03_r8,0.23834e-02_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.31637e-03_r8,0.49701e-03_r8,0.56299e-03_r8,0.59618e-03_r8,0.61191e-03_r8, & + & 0.60936e-03_r8,0.58930e-03_r8,0.54649e-03_r8,0.22824e-02_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.32604e-03_r8,0.51148e-03_r8,0.57604e-03_r8,0.61103e-03_r8,0.62611e-03_r8, & + & 0.62412e-03_r8,0.60375e-03_r8,0.56026e-03_r8,0.22084e-02_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.26154e-03_r8,0.41366e-03_r8,0.47019e-03_r8,0.50056e-03_r8,0.51140e-03_r8, & + & 0.50695e-03_r8,0.48611e-03_r8,0.44348e-03_r8,0.22773e-02_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.26669e-03_r8,0.42267e-03_r8,0.47957e-03_r8,0.51009e-03_r8,0.52067e-03_r8, & + & 0.51611e-03_r8,0.49506e-03_r8,0.45138e-03_r8,0.21516e-02_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.27302e-03_r8,0.43290e-03_r8,0.49082e-03_r8,0.52081e-03_r8,0.53105e-03_r8, & + & 0.52578e-03_r8,0.50476e-03_r8,0.46026e-03_r8,0.20522e-02_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.28114e-03_r8,0.44552e-03_r8,0.50271e-03_r8,0.53316e-03_r8,0.54314e-03_r8, & + & 0.53754e-03_r8,0.51555e-03_r8,0.47096e-03_r8,0.19694e-02_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.29046e-03_r8,0.45904e-03_r8,0.51716e-03_r8,0.54751e-03_r8,0.55727e-03_r8, & + & 0.55147e-03_r8,0.52828e-03_r8,0.48333e-03_r8,0.19102e-02_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.21025e-02_r8,0.35934e-02_r8,0.44505e-02_r8,0.51294e-02_r8,0.56565e-02_r8, & + & 0.60638e-02_r8,0.63051e-02_r8,0.63060e-02_r8,0.53132e-02_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.21147e-02_r8,0.36363e-02_r8,0.45228e-02_r8,0.52203e-02_r8,0.57590e-02_r8, & + & 0.61627e-02_r8,0.64080e-02_r8,0.64123e-02_r8,0.54186e-02_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.21423e-02_r8,0.36907e-02_r8,0.46129e-02_r8,0.53384e-02_r8,0.58809e-02_r8, & + & 0.62832e-02_r8,0.65320e-02_r8,0.65359e-02_r8,0.55396e-02_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.21655e-02_r8,0.37303e-02_r8,0.46928e-02_r8,0.54454e-02_r8,0.60067e-02_r8, & + & 0.64159e-02_r8,0.66758e-02_r8,0.66776e-02_r8,0.56738e-02_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.22041e-02_r8,0.37865e-02_r8,0.47900e-02_r8,0.55720e-02_r8,0.61575e-02_r8, & + & 0.65795e-02_r8,0.68426e-02_r8,0.68332e-02_r8,0.58218e-02_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.19184e-02_r8,0.32868e-02_r8,0.40037e-02_r8,0.45520e-02_r8,0.49723e-02_r8, & + & 0.52862e-02_r8,0.54779e-02_r8,0.54778e-02_r8,0.44696e-02_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.19302e-02_r8,0.33258e-02_r8,0.40693e-02_r8,0.46336e-02_r8,0.50634e-02_r8, & + & 0.53829e-02_r8,0.55797e-02_r8,0.55784e-02_r8,0.45568e-02_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.19586e-02_r8,0.33762e-02_r8,0.41518e-02_r8,0.47383e-02_r8,0.51749e-02_r8, & + & 0.54993e-02_r8,0.56986e-02_r8,0.56923e-02_r8,0.46572e-02_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.19876e-02_r8,0.34214e-02_r8,0.42297e-02_r8,0.48395e-02_r8,0.52957e-02_r8, & + & 0.56305e-02_r8,0.58340e-02_r8,0.58219e-02_r8,0.47733e-02_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.20222e-02_r8,0.34660e-02_r8,0.43057e-02_r8,0.49428e-02_r8,0.54286e-02_r8, & + & 0.57769e-02_r8,0.59846e-02_r8,0.59651e-02_r8,0.49022e-02_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.17389e-02_r8,0.29833e-02_r8,0.35894e-02_r8,0.40314e-02_r8,0.43535e-02_r8, & + & 0.45848e-02_r8,0.47251e-02_r8,0.47273e-02_r8,0.37675e-02_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.17511e-02_r8,0.30210e-02_r8,0.36487e-02_r8,0.40996e-02_r8,0.44314e-02_r8, & + & 0.46730e-02_r8,0.48141e-02_r8,0.48126e-02_r8,0.38333e-02_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.17713e-02_r8,0.30646e-02_r8,0.37133e-02_r8,0.41800e-02_r8,0.45216e-02_r8, & + & 0.47732e-02_r8,0.49178e-02_r8,0.49079e-02_r8,0.39121e-02_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.18058e-02_r8,0.31149e-02_r8,0.37889e-02_r8,0.42777e-02_r8,0.46349e-02_r8, & + & 0.48925e-02_r8,0.50383e-02_r8,0.50219e-02_r8,0.40071e-02_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.18379e-02_r8,0.31573e-02_r8,0.38545e-02_r8,0.43660e-02_r8,0.47479e-02_r8, & + & 0.50186e-02_r8,0.51717e-02_r8,0.51483e-02_r8,0.41141e-02_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.15760e-02_r8,0.26881e-02_r8,0.32116e-02_r8,0.35706e-02_r8,0.38258e-02_r8, & + & 0.39911e-02_r8,0.40833e-02_r8,0.40813e-02_r8,0.32298e-02_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.15813e-02_r8,0.27249e-02_r8,0.32627e-02_r8,0.36295e-02_r8,0.38889e-02_r8, & + & 0.40640e-02_r8,0.41571e-02_r8,0.41534e-02_r8,0.32787e-02_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.16001e-02_r8,0.27603e-02_r8,0.33193e-02_r8,0.36971e-02_r8,0.39631e-02_r8, & + & 0.41442e-02_r8,0.42435e-02_r8,0.42324e-02_r8,0.33394e-02_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.16258e-02_r8,0.28020e-02_r8,0.33780e-02_r8,0.37750e-02_r8,0.40494e-02_r8, & + & 0.42369e-02_r8,0.43436e-02_r8,0.43281e-02_r8,0.34138e-02_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.16664e-02_r8,0.28640e-02_r8,0.34503e-02_r8,0.38637e-02_r8,0.41572e-02_r8, & + & 0.43540e-02_r8,0.44611e-02_r8,0.44376e-02_r8,0.34982e-02_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.14233e-02_r8,0.24061e-02_r8,0.28484e-02_r8,0.31675e-02_r8,0.33803e-02_r8, & + & 0.35027e-02_r8,0.35528e-02_r8,0.35417e-02_r8,0.27814e-02_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.14350e-02_r8,0.24395e-02_r8,0.28937e-02_r8,0.32168e-02_r8,0.34318e-02_r8, & + & 0.35619e-02_r8,0.36148e-02_r8,0.35990e-02_r8,0.28208e-02_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.14521e-02_r8,0.24725e-02_r8,0.29512e-02_r8,0.32733e-02_r8,0.34917e-02_r8, & + & 0.36258e-02_r8,0.36856e-02_r8,0.36654e-02_r8,0.28719e-02_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.14701e-02_r8,0.25117e-02_r8,0.30081e-02_r8,0.33364e-02_r8,0.35619e-02_r8, & + & 0.37016e-02_r8,0.37673e-02_r8,0.37455e-02_r8,0.29344e-02_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.15037e-02_r8,0.25667e-02_r8,0.30753e-02_r8,0.34136e-02_r8,0.36518e-02_r8, & + & 0.37975e-02_r8,0.38648e-02_r8,0.38367e-02_r8,0.30050e-02_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.12833e-02_r8,0.21397e-02_r8,0.25249e-02_r8,0.27989e-02_r8,0.29941e-02_r8, & + & 0.30943e-02_r8,0.31134e-02_r8,0.30718e-02_r8,0.23837e-02_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.12955e-02_r8,0.21689e-02_r8,0.25640e-02_r8,0.28465e-02_r8,0.30386e-02_r8, & + & 0.31442e-02_r8,0.31666e-02_r8,0.31216e-02_r8,0.24190e-02_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.13128e-02_r8,0.22001e-02_r8,0.26092e-02_r8,0.28949e-02_r8,0.30875e-02_r8, & + & 0.31967e-02_r8,0.32254e-02_r8,0.31772e-02_r8,0.24633e-02_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.13321e-02_r8,0.22373e-02_r8,0.26583e-02_r8,0.29483e-02_r8,0.31454e-02_r8, & + & 0.32584e-02_r8,0.32916e-02_r8,0.32451e-02_r8,0.25158e-02_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.13570e-02_r8,0.22801e-02_r8,0.27142e-02_r8,0.30110e-02_r8,0.32147e-02_r8, & + & 0.33324e-02_r8,0.33699e-02_r8,0.33240e-02_r8,0.25751e-02_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.11500e-02_r8,0.18956e-02_r8,0.22352e-02_r8,0.24771e-02_r8,0.26462e-02_r8, & + & 0.27285e-02_r8,0.27284e-02_r8,0.26574e-02_r8,0.20286e-02_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.11641e-02_r8,0.19221e-02_r8,0.22681e-02_r8,0.25137e-02_r8,0.26876e-02_r8, & + & 0.27741e-02_r8,0.27762e-02_r8,0.27013e-02_r8,0.20553e-02_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.11813e-02_r8,0.19513e-02_r8,0.23065e-02_r8,0.25547e-02_r8,0.27305e-02_r8, & + & 0.28210e-02_r8,0.28261e-02_r8,0.27499e-02_r8,0.20900e-02_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.12020e-02_r8,0.19854e-02_r8,0.23499e-02_r8,0.26064e-02_r8,0.27813e-02_r8, & + & 0.28738e-02_r8,0.28824e-02_r8,0.28095e-02_r8,0.21311e-02_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.12251e-02_r8,0.20252e-02_r8,0.23984e-02_r8,0.26618e-02_r8,0.28401e-02_r8, & + & 0.29374e-02_r8,0.29496e-02_r8,0.28780e-02_r8,0.21792e-02_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.10232e-02_r8,0.16906e-02_r8,0.19769e-02_r8,0.21832e-02_r8,0.23202e-02_r8, & + & 0.23917e-02_r8,0.23852e-02_r8,0.22950e-02_r8,0.17101e-02_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.10391e-02_r8,0.17050e-02_r8,0.20071e-02_r8,0.22179e-02_r8,0.23606e-02_r8, & + & 0.24337e-02_r8,0.24284e-02_r8,0.23335e-02_r8,0.17331e-02_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.10558e-02_r8,0.17304e-02_r8,0.20412e-02_r8,0.22560e-02_r8,0.24048e-02_r8, & + & 0.24767e-02_r8,0.24718e-02_r8,0.23758e-02_r8,0.17638e-02_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.10757e-02_r8,0.17611e-02_r8,0.20788e-02_r8,0.22974e-02_r8,0.24509e-02_r8, & + & 0.25242e-02_r8,0.25220e-02_r8,0.24275e-02_r8,0.17981e-02_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.10980e-02_r8,0.17974e-02_r8,0.21207e-02_r8,0.23464e-02_r8,0.25025e-02_r8, & + & 0.25827e-02_r8,0.25792e-02_r8,0.24843e-02_r8,0.18371e-02_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.89817e-03_r8,0.14995e-02_r8,0.17424e-02_r8,0.19141e-02_r8,0.20277e-02_r8, & + & 0.20847e-02_r8,0.20717e-02_r8,0.19779e-02_r8,0.16529e-02_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.91497e-03_r8,0.15202e-02_r8,0.17713e-02_r8,0.19473e-02_r8,0.20642e-02_r8, & + & 0.21241e-02_r8,0.21112e-02_r8,0.20125e-02_r8,0.16590e-02_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.93269e-03_r8,0.15411e-02_r8,0.18029e-02_r8,0.19839e-02_r8,0.21017e-02_r8, & + & 0.21633e-02_r8,0.21507e-02_r8,0.20494e-02_r8,0.16738e-02_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.95304e-03_r8,0.15646e-02_r8,0.18368e-02_r8,0.20225e-02_r8,0.21451e-02_r8, & + & 0.22062e-02_r8,0.21951e-02_r8,0.20930e-02_r8,0.16939e-02_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.97498e-03_r8,0.15941e-02_r8,0.18742e-02_r8,0.20657e-02_r8,0.21958e-02_r8, & + & 0.22577e-02_r8,0.22448e-02_r8,0.21409e-02_r8,0.17176e-02_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.79262e-03_r8,0.13163e-02_r8,0.15328e-02_r8,0.16707e-02_r8,0.17648e-02_r8, & + & 0.18068e-02_r8,0.17935e-02_r8,0.17058e-02_r8,0.29700e-02_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.80762e-03_r8,0.13411e-02_r8,0.15596e-02_r8,0.17027e-02_r8,0.18000e-02_r8, & + & 0.18435e-02_r8,0.18291e-02_r8,0.17355e-02_r8,0.28651e-02_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.82251e-03_r8,0.13646e-02_r8,0.15856e-02_r8,0.17370e-02_r8,0.18349e-02_r8, & + & 0.18799e-02_r8,0.18643e-02_r8,0.17669e-02_r8,0.27637e-02_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.84077e-03_r8,0.13892e-02_r8,0.16170e-02_r8,0.17747e-02_r8,0.18736e-02_r8, & + & 0.19201e-02_r8,0.19036e-02_r8,0.18042e-02_r8,0.26870e-02_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.86106e-03_r8,0.14180e-02_r8,0.16516e-02_r8,0.18147e-02_r8,0.19171e-02_r8, & + & 0.19660e-02_r8,0.19468e-02_r8,0.18451e-02_r8,0.26342e-02_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.72744e-03_r8,0.11669e-02_r8,0.13481e-02_r8,0.14590e-02_r8,0.15393e-02_r8, & + & 0.15747e-02_r8,0.15610e-02_r8,0.14772e-02_r8,0.38429e-02_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.73930e-03_r8,0.11904e-02_r8,0.13759e-02_r8,0.14894e-02_r8,0.15715e-02_r8, & + & 0.16066e-02_r8,0.15925e-02_r8,0.15038e-02_r8,0.36308e-02_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.75350e-03_r8,0.12120e-02_r8,0.14044e-02_r8,0.15240e-02_r8,0.16053e-02_r8, & + & 0.16390e-02_r8,0.16251e-02_r8,0.15339e-02_r8,0.34122e-02_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.76930e-03_r8,0.12355e-02_r8,0.14324e-02_r8,0.15603e-02_r8,0.16424e-02_r8, & + & 0.16774e-02_r8,0.16611e-02_r8,0.15677e-02_r8,0.32391e-02_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.78824e-03_r8,0.12645e-02_r8,0.14660e-02_r8,0.15998e-02_r8,0.16846e-02_r8, & + & 0.17204e-02_r8,0.17007e-02_r8,0.16046e-02_r8,0.31291e-02_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.66909e-03_r8,0.10517e-02_r8,0.11921e-02_r8,0.12822e-02_r8,0.13379e-02_r8, & + & 0.13630e-02_r8,0.13492e-02_r8,0.12752e-02_r8,0.39255e-02_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.68372e-03_r8,0.10717e-02_r8,0.12175e-02_r8,0.13089e-02_r8,0.13666e-02_r8, & + & 0.13913e-02_r8,0.13783e-02_r8,0.12999e-02_r8,0.37011e-02_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.69881e-03_r8,0.10912e-02_r8,0.12439e-02_r8,0.13402e-02_r8,0.13970e-02_r8, & + & 0.14222e-02_r8,0.14099e-02_r8,0.13279e-02_r8,0.35002e-02_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.71487e-03_r8,0.11132e-02_r8,0.12732e-02_r8,0.13738e-02_r8,0.14317e-02_r8, & + & 0.14583e-02_r8,0.14439e-02_r8,0.13590e-02_r8,0.33360e-02_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.73461e-03_r8,0.11382e-02_r8,0.13053e-02_r8,0.14102e-02_r8,0.14713e-02_r8, & + & 0.14974e-02_r8,0.14808e-02_r8,0.13924e-02_r8,0.31844e-02_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.61282e-03_r8,0.95575e-03_r8,0.10730e-02_r8,0.11388e-02_r8,0.11718e-02_r8, & + & 0.11795e-02_r8,0.11618e-02_r8,0.10974e-02_r8,0.34089e-02_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.62765e-03_r8,0.97500e-03_r8,0.10966e-02_r8,0.11619e-02_r8,0.11959e-02_r8, & + & 0.12054e-02_r8,0.11876e-02_r8,0.11206e-02_r8,0.32141e-02_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.64409e-03_r8,0.99523e-03_r8,0.11197e-02_r8,0.11873e-02_r8,0.12235e-02_r8, & + & 0.12347e-02_r8,0.12163e-02_r8,0.11468e-02_r8,0.30396e-02_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.66230e-03_r8,0.10180e-02_r8,0.11464e-02_r8,0.12161e-02_r8,0.12557e-02_r8, & + & 0.12667e-02_r8,0.12475e-02_r8,0.11749e-02_r8,0.28911e-02_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.68383e-03_r8,0.10452e-02_r8,0.11767e-02_r8,0.12484e-02_r8,0.12902e-02_r8, & + & 0.13021e-02_r8,0.12822e-02_r8,0.12049e-02_r8,0.27576e-02_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.59073e-02_r8,0.94320e-02_r8,0.12084e-01_r8,0.14049e-01_r8,0.15571e-01_r8, & + & 0.16640e-01_r8,0.17123e-01_r8,0.16625e-01_r8,0.14851e-01_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.60213e-02_r8,0.95565e-02_r8,0.12218e-01_r8,0.14200e-01_r8,0.15736e-01_r8, & + & 0.16810e-01_r8,0.17290e-01_r8,0.16722e-01_r8,0.14969e-01_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.61698e-02_r8,0.97176e-02_r8,0.12383e-01_r8,0.14381e-01_r8,0.15939e-01_r8, & + & 0.17010e-01_r8,0.17476e-01_r8,0.16866e-01_r8,0.15129e-01_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.62862e-02_r8,0.98624e-02_r8,0.12544e-01_r8,0.14586e-01_r8,0.16163e-01_r8, & + & 0.17225e-01_r8,0.17690e-01_r8,0.17043e-01_r8,0.15322e-01_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.64346e-02_r8,0.10033e-01_r8,0.12746e-01_r8,0.14817e-01_r8,0.16408e-01_r8, & + & 0.17481e-01_r8,0.17940e-01_r8,0.17253e-01_r8,0.15543e-01_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.53740e-02_r8,0.87218e-02_r8,0.11053e-01_r8,0.12810e-01_r8,0.14176e-01_r8, & + & 0.15120e-01_r8,0.15546e-01_r8,0.15059e-01_r8,0.12919e-01_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.54730e-02_r8,0.88522e-02_r8,0.11203e-01_r8,0.12984e-01_r8,0.14363e-01_r8, & + & 0.15303e-01_r8,0.15712e-01_r8,0.15177e-01_r8,0.13038e-01_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.56074e-02_r8,0.90112e-02_r8,0.11386e-01_r8,0.13184e-01_r8,0.14577e-01_r8, & + & 0.15506e-01_r8,0.15908e-01_r8,0.15341e-01_r8,0.13193e-01_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.57291e-02_r8,0.91663e-02_r8,0.11581e-01_r8,0.13408e-01_r8,0.14805e-01_r8, & + & 0.15738e-01_r8,0.16140e-01_r8,0.15527e-01_r8,0.13373e-01_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.58374e-02_r8,0.93237e-02_r8,0.11790e-01_r8,0.13642e-01_r8,0.15063e-01_r8, & + & 0.16008e-01_r8,0.16391e-01_r8,0.15740e-01_r8,0.13573e-01_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.49151e-02_r8,0.80083e-02_r8,0.10006e-01_r8,0.11528e-01_r8,0.12727e-01_r8, & + & 0.13551e-01_r8,0.13911e-01_r8,0.13469e-01_r8,0.11070e-01_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.50045e-02_r8,0.81384e-02_r8,0.10158e-01_r8,0.11712e-01_r8,0.12918e-01_r8, & + & 0.13727e-01_r8,0.14078e-01_r8,0.13598e-01_r8,0.11182e-01_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.51018e-02_r8,0.82774e-02_r8,0.10333e-01_r8,0.11906e-01_r8,0.13128e-01_r8, & + & 0.13932e-01_r8,0.14276e-01_r8,0.13758e-01_r8,0.11318e-01_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.52290e-02_r8,0.84457e-02_r8,0.10545e-01_r8,0.12130e-01_r8,0.13362e-01_r8, & + & 0.14179e-01_r8,0.14506e-01_r8,0.13944e-01_r8,0.11475e-01_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.53219e-02_r8,0.86004e-02_r8,0.10753e-01_r8,0.12365e-01_r8,0.13624e-01_r8, & + & 0.14443e-01_r8,0.14743e-01_r8,0.14150e-01_r8,0.11664e-01_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.44996e-02_r8,0.73324e-02_r8,0.89976e-02_r8,0.10282e-01_r8,0.11291e-01_r8, & + & 0.11989e-01_r8,0.12308e-01_r8,0.11915e-01_r8,0.94610e-02_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.45903e-02_r8,0.74608e-02_r8,0.91511e-02_r8,0.10467e-01_r8,0.11476e-01_r8, & + & 0.12168e-01_r8,0.12474e-01_r8,0.12040e-01_r8,0.95583e-02_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.46786e-02_r8,0.75960e-02_r8,0.93200e-02_r8,0.10651e-01_r8,0.11685e-01_r8, & + & 0.12375e-01_r8,0.12662e-01_r8,0.12197e-01_r8,0.96836e-02_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.47771e-02_r8,0.77407e-02_r8,0.95085e-02_r8,0.10860e-01_r8,0.11915e-01_r8, & + & 0.12611e-01_r8,0.12868e-01_r8,0.12374e-01_r8,0.98243e-02_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.48920e-02_r8,0.79194e-02_r8,0.97305e-02_r8,0.11107e-01_r8,0.12174e-01_r8, & + & 0.12866e-01_r8,0.13096e-01_r8,0.12573e-01_r8,0.99978e-02_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.41203e-02_r8,0.67057e-02_r8,0.80820e-02_r8,0.91247e-02_r8,0.99321e-02_r8, & + & 0.10510e-01_r8,0.10783e-01_r8,0.10430e-01_r8,0.81020e-02_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.41993e-02_r8,0.68279e-02_r8,0.82322e-02_r8,0.92959e-02_r8,0.10115e-01_r8, & + & 0.10684e-01_r8,0.10936e-01_r8,0.10557e-01_r8,0.81860e-02_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.42833e-02_r8,0.69588e-02_r8,0.83884e-02_r8,0.94726e-02_r8,0.10319e-01_r8, & + & 0.10879e-01_r8,0.11113e-01_r8,0.10704e-01_r8,0.82915e-02_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.43800e-02_r8,0.70975e-02_r8,0.85585e-02_r8,0.96769e-02_r8,0.10538e-01_r8, & + & 0.11098e-01_r8,0.11307e-01_r8,0.10873e-01_r8,0.84082e-02_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.44913e-02_r8,0.72638e-02_r8,0.87668e-02_r8,0.99106e-02_r8,0.10776e-01_r8, & + & 0.11337e-01_r8,0.11521e-01_r8,0.11061e-01_r8,0.85492e-02_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.37432e-02_r8,0.61135e-02_r8,0.72507e-02_r8,0.80822e-02_r8,0.86984e-02_r8, & + & 0.91424e-02_r8,0.93607e-02_r8,0.90800e-02_r8,0.69637e-02_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.38232e-02_r8,0.62277e-02_r8,0.73923e-02_r8,0.82383e-02_r8,0.88666e-02_r8, & + & 0.93013e-02_r8,0.95051e-02_r8,0.91939e-02_r8,0.70311e-02_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.39028e-02_r8,0.63516e-02_r8,0.75330e-02_r8,0.84072e-02_r8,0.90542e-02_r8, & + & 0.94860e-02_r8,0.96693e-02_r8,0.93306e-02_r8,0.71143e-02_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.39917e-02_r8,0.64850e-02_r8,0.76893e-02_r8,0.85935e-02_r8,0.92562e-02_r8, & + & 0.96859e-02_r8,0.98481e-02_r8,0.94821e-02_r8,0.72080e-02_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.40851e-02_r8,0.66256e-02_r8,0.78694e-02_r8,0.87911e-02_r8,0.94733e-02_r8, & + & 0.99019e-02_r8,0.10042e-01_r8,0.96464e-02_r8,0.73211e-02_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.33812e-02_r8,0.55475e-02_r8,0.65017e-02_r8,0.71556e-02_r8,0.76235e-02_r8, & + & 0.79451e-02_r8,0.81101e-02_r8,0.78877e-02_r8,0.60070e-02_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.34581e-02_r8,0.56575e-02_r8,0.66301e-02_r8,0.72977e-02_r8,0.77709e-02_r8, & + & 0.80903e-02_r8,0.82426e-02_r8,0.79917e-02_r8,0.60625e-02_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.35355e-02_r8,0.57759e-02_r8,0.67602e-02_r8,0.74532e-02_r8,0.79395e-02_r8, & + & 0.82549e-02_r8,0.83890e-02_r8,0.81121e-02_r8,0.61274e-02_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.36191e-02_r8,0.58987e-02_r8,0.69034e-02_r8,0.76219e-02_r8,0.81209e-02_r8, & + & 0.84343e-02_r8,0.85495e-02_r8,0.82395e-02_r8,0.62026e-02_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.37084e-02_r8,0.60308e-02_r8,0.70671e-02_r8,0.77977e-02_r8,0.83160e-02_r8, & + & 0.86266e-02_r8,0.87205e-02_r8,0.83802e-02_r8,0.62947e-02_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.30376e-02_r8,0.49774e-02_r8,0.58172e-02_r8,0.63470e-02_r8,0.67038e-02_r8, & + & 0.69396e-02_r8,0.70412e-02_r8,0.68509e-02_r8,0.51374e-02_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.31099e-02_r8,0.50996e-02_r8,0.59344e-02_r8,0.64736e-02_r8,0.68367e-02_r8, & + & 0.70701e-02_r8,0.71564e-02_r8,0.69425e-02_r8,0.51813e-02_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.31853e-02_r8,0.52155e-02_r8,0.60541e-02_r8,0.66147e-02_r8,0.69858e-02_r8, & + & 0.72120e-02_r8,0.72858e-02_r8,0.70465e-02_r8,0.52319e-02_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.32663e-02_r8,0.53312e-02_r8,0.61863e-02_r8,0.67654e-02_r8,0.71468e-02_r8, & + & 0.73677e-02_r8,0.74252e-02_r8,0.71560e-02_r8,0.52932e-02_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.33510e-02_r8,0.54583e-02_r8,0.63345e-02_r8,0.69235e-02_r8,0.73170e-02_r8, & + & 0.75339e-02_r8,0.75720e-02_r8,0.72770e-02_r8,0.53726e-02_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.27168e-02_r8,0.44406e-02_r8,0.51768e-02_r8,0.56339e-02_r8,0.59208e-02_r8, & + & 0.60958e-02_r8,0.61438e-02_r8,0.59554e-02_r8,0.42511e-02_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.27853e-02_r8,0.45486e-02_r8,0.52870e-02_r8,0.57491e-02_r8,0.60397e-02_r8, & + & 0.62076e-02_r8,0.62421e-02_r8,0.60358e-02_r8,0.42982e-02_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.28572e-02_r8,0.46609e-02_r8,0.53998e-02_r8,0.58755e-02_r8,0.61719e-02_r8, & + & 0.63300e-02_r8,0.63536e-02_r8,0.61272e-02_r8,0.43479e-02_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.29351e-02_r8,0.47766e-02_r8,0.55244e-02_r8,0.60103e-02_r8,0.63121e-02_r8, & + & 0.64656e-02_r8,0.64718e-02_r8,0.62231e-02_r8,0.44012e-02_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.30174e-02_r8,0.49013e-02_r8,0.56608e-02_r8,0.61542e-02_r8,0.64584e-02_r8, & + & 0.66094e-02_r8,0.65960e-02_r8,0.63252e-02_r8,0.44655e-02_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.24055e-02_r8,0.39503e-02_r8,0.45833e-02_r8,0.49951e-02_r8,0.52507e-02_r8, & + & 0.53857e-02_r8,0.53791e-02_r8,0.51629e-02_r8,0.55379e-02_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.24728e-02_r8,0.40487e-02_r8,0.46867e-02_r8,0.51042e-02_r8,0.53576e-02_r8, & + & 0.54844e-02_r8,0.54704e-02_r8,0.52383e-02_r8,0.55398e-02_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.25454e-02_r8,0.41511e-02_r8,0.48010e-02_r8,0.52206e-02_r8,0.54751e-02_r8, & + & 0.55927e-02_r8,0.55711e-02_r8,0.53216e-02_r8,0.55501e-02_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.26224e-02_r8,0.42542e-02_r8,0.49201e-02_r8,0.53438e-02_r8,0.55977e-02_r8, & + & 0.57114e-02_r8,0.56753e-02_r8,0.54074e-02_r8,0.55558e-02_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.27039e-02_r8,0.43672e-02_r8,0.50470e-02_r8,0.54750e-02_r8,0.57276e-02_r8, & + & 0.58363e-02_r8,0.57849e-02_r8,0.54996e-02_r8,0.55710e-02_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.21256e-02_r8,0.35221e-02_r8,0.40853e-02_r8,0.44612e-02_r8,0.46874e-02_r8, & + & 0.47866e-02_r8,0.47389e-02_r8,0.44975e-02_r8,0.66135e-02_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.21937e-02_r8,0.36149e-02_r8,0.41854e-02_r8,0.45677e-02_r8,0.47907e-02_r8, & + & 0.48833e-02_r8,0.48291e-02_r8,0.45707e-02_r8,0.65729e-02_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.22650e-02_r8,0.37098e-02_r8,0.42933e-02_r8,0.46764e-02_r8,0.49020e-02_r8, & + & 0.49895e-02_r8,0.49234e-02_r8,0.46462e-02_r8,0.65598e-02_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.23425e-02_r8,0.38113e-02_r8,0.44107e-02_r8,0.47931e-02_r8,0.50165e-02_r8, & + & 0.51000e-02_r8,0.50211e-02_r8,0.47251e-02_r8,0.65419e-02_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.24251e-02_r8,0.39222e-02_r8,0.45344e-02_r8,0.49164e-02_r8,0.51382e-02_r8, & + & 0.52156e-02_r8,0.51233e-02_r8,0.48118e-02_r8,0.65404e-02_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.19014e-02_r8,0.31169e-02_r8,0.36336e-02_r8,0.39642e-02_r8,0.41602e-02_r8, & + & 0.42352e-02_r8,0.41726e-02_r8,0.39183e-02_r8,0.68121e-02_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.19605e-02_r8,0.32068e-02_r8,0.37314e-02_r8,0.40676e-02_r8,0.42627e-02_r8, & + & 0.43333e-02_r8,0.42591e-02_r8,0.39851e-02_r8,0.67229e-02_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.20227e-02_r8,0.33010e-02_r8,0.38333e-02_r8,0.41743e-02_r8,0.43708e-02_r8, & + & 0.44355e-02_r8,0.43461e-02_r8,0.40520e-02_r8,0.66419e-02_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.20945e-02_r8,0.34006e-02_r8,0.39411e-02_r8,0.42851e-02_r8,0.44804e-02_r8, & + & 0.45405e-02_r8,0.44353e-02_r8,0.41230e-02_r8,0.65948e-02_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.21695e-02_r8,0.35114e-02_r8,0.40581e-02_r8,0.44020e-02_r8,0.45960e-02_r8, & + & 0.46501e-02_r8,0.45319e-02_r8,0.42045e-02_r8,0.65716e-02_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.17348e-02_r8,0.27575e-02_r8,0.32033e-02_r8,0.34905e-02_r8,0.36669e-02_r8, & + & 0.37299e-02_r8,0.36615e-02_r8,0.34092e-02_r8,0.62173e-02_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.17868e-02_r8,0.28403e-02_r8,0.32978e-02_r8,0.35924e-02_r8,0.37684e-02_r8, & + & 0.38248e-02_r8,0.37430e-02_r8,0.34686e-02_r8,0.61248e-02_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.18438e-02_r8,0.29272e-02_r8,0.33982e-02_r8,0.36985e-02_r8,0.38711e-02_r8, & + & 0.39210e-02_r8,0.38240e-02_r8,0.35286e-02_r8,0.60637e-02_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.19066e-02_r8,0.30192e-02_r8,0.35016e-02_r8,0.38072e-02_r8,0.39764e-02_r8, & + & 0.40199e-02_r8,0.39089e-02_r8,0.35954e-02_r8,0.60138e-02_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.19732e-02_r8,0.31237e-02_r8,0.36129e-02_r8,0.39207e-02_r8,0.40892e-02_r8, & + & 0.41240e-02_r8,0.40022e-02_r8,0.36721e-02_r8,0.59944e-02_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.41219e-01_r8,0.41795e-01_r8,0.46848e-01_r8,0.50877e-01_r8,0.53437e-01_r8, & + & 0.54488e-01_r8,0.53560e-01_r8,0.50235e-01_r8,0.51545e-01_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.42156e-01_r8,0.42406e-01_r8,0.47180e-01_r8,0.51006e-01_r8,0.53354e-01_r8, & + & 0.54221e-01_r8,0.53185e-01_r8,0.49897e-01_r8,0.51289e-01_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.43082e-01_r8,0.43034e-01_r8,0.47543e-01_r8,0.51133e-01_r8,0.53289e-01_r8, & + & 0.53978e-01_r8,0.52866e-01_r8,0.49591e-01_r8,0.51083e-01_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.43908e-01_r8,0.43606e-01_r8,0.47876e-01_r8,0.51241e-01_r8,0.53225e-01_r8, & + & 0.53768e-01_r8,0.52555e-01_r8,0.49365e-01_r8,0.51010e-01_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.44717e-01_r8,0.44169e-01_r8,0.48160e-01_r8,0.51395e-01_r8,0.53206e-01_r8, & + & 0.53607e-01_r8,0.52301e-01_r8,0.49268e-01_r8,0.51108e-01_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.38280e-01_r8,0.40368e-01_r8,0.46271e-01_r8,0.50387e-01_r8,0.53287e-01_r8, & + & 0.54294e-01_r8,0.53147e-01_r8,0.49359e-01_r8,0.49444e-01_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.39278e-01_r8,0.41016e-01_r8,0.46659e-01_r8,0.50565e-01_r8,0.53249e-01_r8, & + & 0.54064e-01_r8,0.52823e-01_r8,0.49016e-01_r8,0.49210e-01_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.40252e-01_r8,0.41678e-01_r8,0.47048e-01_r8,0.50745e-01_r8,0.53223e-01_r8, & + & 0.53871e-01_r8,0.52519e-01_r8,0.48730e-01_r8,0.49081e-01_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.41132e-01_r8,0.42274e-01_r8,0.47387e-01_r8,0.50925e-01_r8,0.53214e-01_r8, & + & 0.53693e-01_r8,0.52217e-01_r8,0.48559e-01_r8,0.49102e-01_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.41937e-01_r8,0.42806e-01_r8,0.47675e-01_r8,0.51115e-01_r8,0.53221e-01_r8, & + & 0.53535e-01_r8,0.52007e-01_r8,0.48511e-01_r8,0.49285e-01_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.35016e-01_r8,0.38740e-01_r8,0.45035e-01_r8,0.49481e-01_r8,0.52517e-01_r8, & + & 0.53496e-01_r8,0.52191e-01_r8,0.48044e-01_r8,0.46584e-01_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.36031e-01_r8,0.39393e-01_r8,0.45463e-01_r8,0.49713e-01_r8,0.52514e-01_r8, & + & 0.53329e-01_r8,0.51912e-01_r8,0.47725e-01_r8,0.46413e-01_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.36991e-01_r8,0.40024e-01_r8,0.45863e-01_r8,0.49943e-01_r8,0.52531e-01_r8, & + & 0.53167e-01_r8,0.51622e-01_r8,0.47472e-01_r8,0.46354e-01_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.37902e-01_r8,0.40620e-01_r8,0.46253e-01_r8,0.50181e-01_r8,0.52583e-01_r8, & + & 0.53007e-01_r8,0.51384e-01_r8,0.47335e-01_r8,0.46441e-01_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.38707e-01_r8,0.41126e-01_r8,0.46598e-01_r8,0.50384e-01_r8,0.52633e-01_r8, & + & 0.52879e-01_r8,0.51240e-01_r8,0.47311e-01_r8,0.46661e-01_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.31672e-01_r8,0.36966e-01_r8,0.43365e-01_r8,0.48073e-01_r8,0.51081e-01_r8, & + & 0.52063e-01_r8,0.50596e-01_r8,0.46210e-01_r8,0.43228e-01_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.32685e-01_r8,0.37616e-01_r8,0.43827e-01_r8,0.48349e-01_r8,0.51147e-01_r8, & + & 0.51967e-01_r8,0.50386e-01_r8,0.45960e-01_r8,0.43137e-01_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.33628e-01_r8,0.38241e-01_r8,0.44270e-01_r8,0.48639e-01_r8,0.51209e-01_r8, & + & 0.51848e-01_r8,0.50172e-01_r8,0.45771e-01_r8,0.43147e-01_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.34503e-01_r8,0.38804e-01_r8,0.44698e-01_r8,0.48896e-01_r8,0.51278e-01_r8, & + & 0.51724e-01_r8,0.50016e-01_r8,0.45686e-01_r8,0.43281e-01_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.35339e-01_r8,0.39319e-01_r8,0.45124e-01_r8,0.49160e-01_r8,0.51368e-01_r8, & + & 0.51672e-01_r8,0.49945e-01_r8,0.45702e-01_r8,0.43520e-01_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.28453e-01_r8,0.34915e-01_r8,0.41400e-01_r8,0.46104e-01_r8,0.49014e-01_r8, & + & 0.49952e-01_r8,0.48370e-01_r8,0.43932e-01_r8,0.39569e-01_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.29434e-01_r8,0.35588e-01_r8,0.41893e-01_r8,0.46437e-01_r8,0.49144e-01_r8, & + & 0.49919e-01_r8,0.48254e-01_r8,0.43775e-01_r8,0.39548e-01_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.30340e-01_r8,0.36236e-01_r8,0.42373e-01_r8,0.46769e-01_r8,0.49255e-01_r8, & + & 0.49873e-01_r8,0.48133e-01_r8,0.43667e-01_r8,0.39610e-01_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.31178e-01_r8,0.36810e-01_r8,0.42835e-01_r8,0.47061e-01_r8,0.49370e-01_r8, & + & 0.49827e-01_r8,0.48071e-01_r8,0.43623e-01_r8,0.39779e-01_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.31999e-01_r8,0.37346e-01_r8,0.43284e-01_r8,0.47361e-01_r8,0.49516e-01_r8, & + & 0.49857e-01_r8,0.48088e-01_r8,0.43666e-01_r8,0.40037e-01_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.25421e-01_r8,0.32626e-01_r8,0.39116e-01_r8,0.43609e-01_r8,0.46371e-01_r8, & + & 0.47186e-01_r8,0.45634e-01_r8,0.41276e-01_r8,0.35722e-01_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.26347e-01_r8,0.33315e-01_r8,0.39629e-01_r8,0.44004e-01_r8,0.46570e-01_r8, & + & 0.47251e-01_r8,0.45602e-01_r8,0.41217e-01_r8,0.35770e-01_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.27211e-01_r8,0.33965e-01_r8,0.40142e-01_r8,0.44371e-01_r8,0.46737e-01_r8, & + & 0.47271e-01_r8,0.45579e-01_r8,0.41184e-01_r8,0.35883e-01_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.28013e-01_r8,0.34546e-01_r8,0.40641e-01_r8,0.44704e-01_r8,0.46903e-01_r8, & + & 0.47305e-01_r8,0.45608e-01_r8,0.41201e-01_r8,0.36071e-01_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.28777e-01_r8,0.35080e-01_r8,0.41083e-01_r8,0.45018e-01_r8,0.47083e-01_r8, & + & 0.47404e-01_r8,0.45685e-01_r8,0.41273e-01_r8,0.36328e-01_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.22628e-01_r8,0.30290e-01_r8,0.36520e-01_r8,0.40736e-01_r8,0.43195e-01_r8, & + & 0.43894e-01_r8,0.42478e-01_r8,0.38357e-01_r8,0.31858e-01_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.23496e-01_r8,0.30981e-01_r8,0.37071e-01_r8,0.41159e-01_r8,0.43459e-01_r8, & + & 0.44039e-01_r8,0.42534e-01_r8,0.38366e-01_r8,0.31954e-01_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.24311e-01_r8,0.31616e-01_r8,0.37614e-01_r8,0.41552e-01_r8,0.43690e-01_r8, & + & 0.44135e-01_r8,0.42598e-01_r8,0.38398e-01_r8,0.32112e-01_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.25081e-01_r8,0.32194e-01_r8,0.38124e-01_r8,0.41906e-01_r8,0.43917e-01_r8, & + & 0.44249e-01_r8,0.42700e-01_r8,0.38476e-01_r8,0.32312e-01_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.25796e-01_r8,0.32737e-01_r8,0.38583e-01_r8,0.42251e-01_r8,0.44147e-01_r8, & + & 0.44425e-01_r8,0.42840e-01_r8,0.38587e-01_r8,0.32545e-01_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.20122e-01_r8,0.27995e-01_r8,0.33719e-01_r8,0.37485e-01_r8,0.39621e-01_r8, & + & 0.40226e-01_r8,0.38971e-01_r8,0.35214e-01_r8,0.28110e-01_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.20930e-01_r8,0.28671e-01_r8,0.34304e-01_r8,0.37966e-01_r8,0.39957e-01_r8, & + & 0.40447e-01_r8,0.39124e-01_r8,0.35304e-01_r8,0.28246e-01_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.21692e-01_r8,0.29291e-01_r8,0.34870e-01_r8,0.38392e-01_r8,0.40254e-01_r8, & + & 0.40624e-01_r8,0.39266e-01_r8,0.35403e-01_r8,0.28424e-01_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.22396e-01_r8,0.29880e-01_r8,0.35388e-01_r8,0.38779e-01_r8,0.40528e-01_r8, & + & 0.40815e-01_r8,0.39436e-01_r8,0.35538e-01_r8,0.28597e-01_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.23064e-01_r8,0.30402e-01_r8,0.35848e-01_r8,0.39151e-01_r8,0.40824e-01_r8, & + & 0.41057e-01_r8,0.39639e-01_r8,0.35669e-01_r8,0.28823e-01_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.17909e-01_r8,0.25709e-01_r8,0.30840e-01_r8,0.34036e-01_r8,0.35851e-01_r8, & + & 0.36360e-01_r8,0.35282e-01_r8,0.31947e-01_r8,0.24003e-01_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.18652e-01_r8,0.26369e-01_r8,0.31431e-01_r8,0.34542e-01_r8,0.36244e-01_r8, & + & 0.36648e-01_r8,0.35513e-01_r8,0.32109e-01_r8,0.24164e-01_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.19344e-01_r8,0.26986e-01_r8,0.31997e-01_r8,0.35005e-01_r8,0.36599e-01_r8, & + & 0.36904e-01_r8,0.35718e-01_r8,0.32277e-01_r8,0.24318e-01_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.19991e-01_r8,0.27565e-01_r8,0.32506e-01_r8,0.35425e-01_r8,0.36934e-01_r8, & + & 0.37163e-01_r8,0.35949e-01_r8,0.32440e-01_r8,0.24470e-01_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.20615e-01_r8,0.28069e-01_r8,0.32961e-01_r8,0.35817e-01_r8,0.37281e-01_r8, & + & 0.37462e-01_r8,0.36191e-01_r8,0.32591e-01_r8,0.24688e-01_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.16038e-01_r8,0.23520e-01_r8,0.27944e-01_r8,0.30612e-01_r8,0.32108e-01_r8, & + & 0.32531e-01_r8,0.31594e-01_r8,0.28710e-01_r8,0.19040e-01_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.16702e-01_r8,0.24155e-01_r8,0.28537e-01_r8,0.31140e-01_r8,0.32544e-01_r8, & + & 0.32858e-01_r8,0.31863e-01_r8,0.28938e-01_r8,0.19154e-01_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.17329e-01_r8,0.24747e-01_r8,0.29094e-01_r8,0.31618e-01_r8,0.32949e-01_r8, & + & 0.33160e-01_r8,0.32119e-01_r8,0.29151e-01_r8,0.19214e-01_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.17922e-01_r8,0.25302e-01_r8,0.29595e-01_r8,0.32058e-01_r8,0.33330e-01_r8, & + & 0.33472e-01_r8,0.32385e-01_r8,0.29320e-01_r8,0.19269e-01_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.18489e-01_r8,0.25799e-01_r8,0.30045e-01_r8,0.32466e-01_r8,0.33700e-01_r8, & + & 0.33812e-01_r8,0.32629e-01_r8,0.29481e-01_r8,0.19405e-01_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.14687e-01_r8,0.21702e-01_r8,0.25384e-01_r8,0.27570e-01_r8,0.28760e-01_r8, & + & 0.29017e-01_r8,0.28178e-01_r8,0.25716e-01_r8,0.20195e-01_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.15274e-01_r8,0.22296e-01_r8,0.25944e-01_r8,0.28087e-01_r8,0.29202e-01_r8, & + & 0.29352e-01_r8,0.28471e-01_r8,0.25960e-01_r8,0.20265e-01_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.15835e-01_r8,0.22836e-01_r8,0.26465e-01_r8,0.28550e-01_r8,0.29611e-01_r8, & + & 0.29694e-01_r8,0.28754e-01_r8,0.26152e-01_r8,0.20296e-01_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.16357e-01_r8,0.23338e-01_r8,0.26927e-01_r8,0.28982e-01_r8,0.29998e-01_r8, & + & 0.30045e-01_r8,0.29008e-01_r8,0.26312e-01_r8,0.20131e-01_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.16879e-01_r8,0.23791e-01_r8,0.27359e-01_r8,0.29394e-01_r8,0.30387e-01_r8, & + & 0.30372e-01_r8,0.29268e-01_r8,0.26507e-01_r8,0.20180e-01_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.13435e-01_r8,0.19917e-01_r8,0.22947e-01_r8,0.24741e-01_r8,0.25656e-01_r8, & + & 0.25762e-01_r8,0.25010e-01_r8,0.22879e-01_r8,0.21935e-01_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.13973e-01_r8,0.20460e-01_r8,0.23475e-01_r8,0.25221e-01_r8,0.26084e-01_r8, & + & 0.26126e-01_r8,0.25297e-01_r8,0.23091e-01_r8,0.22096e-01_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.14481e-01_r8,0.20956e-01_r8,0.23951e-01_r8,0.25665e-01_r8,0.26486e-01_r8, & + & 0.26478e-01_r8,0.25558e-01_r8,0.23263e-01_r8,0.22257e-01_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.14966e-01_r8,0.21408e-01_r8,0.24388e-01_r8,0.26079e-01_r8,0.26872e-01_r8, & + & 0.26802e-01_r8,0.25814e-01_r8,0.23444e-01_r8,0.22244e-01_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.15448e-01_r8,0.21834e-01_r8,0.24813e-01_r8,0.26492e-01_r8,0.27230e-01_r8, & + & 0.27128e-01_r8,0.26103e-01_r8,0.23676e-01_r8,0.22318e-01_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.12253e-01_r8,0.18169e-01_r8,0.20712e-01_r8,0.22143e-01_r8,0.22829e-01_r8, & + & 0.22840e-01_r8,0.22092e-01_r8,0.20210e-01_r8,0.22350e-01_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.12752e-01_r8,0.18675e-01_r8,0.21188e-01_r8,0.22590e-01_r8,0.23242e-01_r8, & + & 0.23184e-01_r8,0.22356e-01_r8,0.20395e-01_r8,0.22569e-01_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.13220e-01_r8,0.19134e-01_r8,0.21627e-01_r8,0.23007e-01_r8,0.23621e-01_r8, & + & 0.23502e-01_r8,0.22612e-01_r8,0.20571e-01_r8,0.22750e-01_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.13675e-01_r8,0.19566e-01_r8,0.22044e-01_r8,0.23405e-01_r8,0.23969e-01_r8, & + & 0.23813e-01_r8,0.22875e-01_r8,0.20780e-01_r8,0.22726e-01_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.14122e-01_r8,0.19976e-01_r8,0.22454e-01_r8,0.23786e-01_r8,0.24318e-01_r8, & + & 0.24140e-01_r8,0.23183e-01_r8,0.21041e-01_r8,0.22784e-01_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.14776e+00_r8,0.13250e+00_r8,0.11877e+00_r8,0.11907e+00_r8,0.11538e+00_r8, & + & 0.11234e+00_r8,0.10926e+00_r8,0.11039e+00_r8,0.12102e+00_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.14758e+00_r8,0.13180e+00_r8,0.11760e+00_r8,0.11720e+00_r8,0.11379e+00_r8, & + & 0.11206e+00_r8,0.10856e+00_r8,0.11029e+00_r8,0.12093e+00_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.14691e+00_r8,0.13078e+00_r8,0.11629e+00_r8,0.11563e+00_r8,0.11248e+00_r8, & + & 0.11149e+00_r8,0.10785e+00_r8,0.11040e+00_r8,0.12104e+00_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.14609e+00_r8,0.12985e+00_r8,0.11503e+00_r8,0.11426e+00_r8,0.11150e+00_r8, & + & 0.11061e+00_r8,0.10739e+00_r8,0.11031e+00_r8,0.12092e+00_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.14529e+00_r8,0.12911e+00_r8,0.11448e+00_r8,0.11310e+00_r8,0.11058e+00_r8, & + & 0.10959e+00_r8,0.10721e+00_r8,0.11007e+00_r8,0.12050e+00_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.14616e+00_r8,0.13131e+00_r8,0.12350e+00_r8,0.12510e+00_r8,0.11934e+00_r8, & + & 0.11762e+00_r8,0.11417e+00_r8,0.11460e+00_r8,0.12626e+00_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.14607e+00_r8,0.13063e+00_r8,0.12202e+00_r8,0.12312e+00_r8,0.11789e+00_r8, & + & 0.11742e+00_r8,0.11363e+00_r8,0.11470e+00_r8,0.12636e+00_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.14577e+00_r8,0.12991e+00_r8,0.12074e+00_r8,0.12132e+00_r8,0.11671e+00_r8, & + & 0.11676e+00_r8,0.11334e+00_r8,0.11448e+00_r8,0.12602e+00_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.14549e+00_r8,0.12948e+00_r8,0.11982e+00_r8,0.11971e+00_r8,0.11561e+00_r8, & + & 0.11583e+00_r8,0.11311e+00_r8,0.11380e+00_r8,0.12515e+00_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.14518e+00_r8,0.12921e+00_r8,0.11930e+00_r8,0.11856e+00_r8,0.11453e+00_r8, & + & 0.11499e+00_r8,0.11278e+00_r8,0.11303e+00_r8,0.12425e+00_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.14318e+00_r8,0.12893e+00_r8,0.12918e+00_r8,0.12942e+00_r8,0.12491e+00_r8, & + & 0.12238e+00_r8,0.11842e+00_r8,0.11706e+00_r8,0.12892e+00_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.14362e+00_r8,0.12877e+00_r8,0.12794e+00_r8,0.12738e+00_r8,0.12367e+00_r8, & + & 0.12214e+00_r8,0.11818e+00_r8,0.11730e+00_r8,0.12892e+00_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.14392e+00_r8,0.12859e+00_r8,0.12673e+00_r8,0.12555e+00_r8,0.12238e+00_r8, & + & 0.12154e+00_r8,0.11804e+00_r8,0.11693e+00_r8,0.12825e+00_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.14418e+00_r8,0.12858e+00_r8,0.12588e+00_r8,0.12406e+00_r8,0.12111e+00_r8, & + & 0.12100e+00_r8,0.11768e+00_r8,0.11605e+00_r8,0.12723e+00_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.14433e+00_r8,0.12868e+00_r8,0.12520e+00_r8,0.12307e+00_r8,0.11981e+00_r8, & + & 0.12050e+00_r8,0.11702e+00_r8,0.11519e+00_r8,0.12642e+00_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.13900e+00_r8,0.12627e+00_r8,0.13262e+00_r8,0.13246e+00_r8,0.13018e+00_r8, & + & 0.12656e+00_r8,0.12207e+00_r8,0.11856e+00_r8,0.12927e+00_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.13981e+00_r8,0.12631e+00_r8,0.13168e+00_r8,0.13063e+00_r8,0.12928e+00_r8, & + & 0.12634e+00_r8,0.12180e+00_r8,0.11842e+00_r8,0.12888e+00_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.14055e+00_r8,0.12635e+00_r8,0.13064e+00_r8,0.12886e+00_r8,0.12826e+00_r8, & + & 0.12591e+00_r8,0.12147e+00_r8,0.11781e+00_r8,0.12798e+00_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.14115e+00_r8,0.12659e+00_r8,0.12979e+00_r8,0.12765e+00_r8,0.12712e+00_r8, & + & 0.12539e+00_r8,0.12094e+00_r8,0.11686e+00_r8,0.12709e+00_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.14205e+00_r8,0.12716e+00_r8,0.12897e+00_r8,0.12678e+00_r8,0.12607e+00_r8, & + & 0.12463e+00_r8,0.12022e+00_r8,0.11611e+00_r8,0.12648e+00_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.13267e+00_r8,0.12451e+00_r8,0.13264e+00_r8,0.13467e+00_r8,0.13410e+00_r8, & + & 0.12976e+00_r8,0.12532e+00_r8,0.11842e+00_r8,0.12663e+00_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.13391e+00_r8,0.12448e+00_r8,0.13222e+00_r8,0.13349e+00_r8,0.13365e+00_r8, & + & 0.12967e+00_r8,0.12478e+00_r8,0.11793e+00_r8,0.12610e+00_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.13513e+00_r8,0.12441e+00_r8,0.13150e+00_r8,0.13226e+00_r8,0.13285e+00_r8, & + & 0.12935e+00_r8,0.12414e+00_r8,0.11714e+00_r8,0.12535e+00_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.13635e+00_r8,0.12468e+00_r8,0.13071e+00_r8,0.13132e+00_r8,0.13192e+00_r8, & + & 0.12883e+00_r8,0.12325e+00_r8,0.11628e+00_r8,0.12465e+00_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.13765e+00_r8,0.12523e+00_r8,0.12989e+00_r8,0.13067e+00_r8,0.13104e+00_r8, & + & 0.12778e+00_r8,0.12230e+00_r8,0.11574e+00_r8,0.12447e+00_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.12480e+00_r8,0.12304e+00_r8,0.13086e+00_r8,0.13535e+00_r8,0.13580e+00_r8, & + & 0.13244e+00_r8,0.12684e+00_r8,0.11687e+00_r8,0.12150e+00_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.12631e+00_r8,0.12320e+00_r8,0.13089e+00_r8,0.13488e+00_r8,0.13591e+00_r8, & + & 0.13240e+00_r8,0.12644e+00_r8,0.11610e+00_r8,0.12096e+00_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.12783e+00_r8,0.12334e+00_r8,0.13031e+00_r8,0.13415e+00_r8,0.13555e+00_r8, & + & 0.13212e+00_r8,0.12571e+00_r8,0.11517e+00_r8,0.12033e+00_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.12946e+00_r8,0.12375e+00_r8,0.12962e+00_r8,0.13360e+00_r8,0.13480e+00_r8, & + & 0.13147e+00_r8,0.12458e+00_r8,0.11440e+00_r8,0.12012e+00_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.13098e+00_r8,0.12424e+00_r8,0.12926e+00_r8,0.13328e+00_r8,0.13390e+00_r8, & + & 0.13035e+00_r8,0.12352e+00_r8,0.11410e+00_r8,0.12034e+00_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.11587e+00_r8,0.11977e+00_r8,0.12827e+00_r8,0.13413e+00_r8,0.13637e+00_r8, & + & 0.13338e+00_r8,0.12607e+00_r8,0.11369e+00_r8,0.11422e+00_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.11755e+00_r8,0.12008e+00_r8,0.12851e+00_r8,0.13433e+00_r8,0.13653e+00_r8, & + & 0.13350e+00_r8,0.12579e+00_r8,0.11303e+00_r8,0.11384e+00_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.11925e+00_r8,0.12045e+00_r8,0.12827e+00_r8,0.13401e+00_r8,0.13627e+00_r8, & + & 0.13335e+00_r8,0.12531e+00_r8,0.11227e+00_r8,0.11342e+00_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.12111e+00_r8,0.12107e+00_r8,0.12798e+00_r8,0.13385e+00_r8,0.13564e+00_r8, & + & 0.13268e+00_r8,0.12424e+00_r8,0.11167e+00_r8,0.11355e+00_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.12285e+00_r8,0.12168e+00_r8,0.12798e+00_r8,0.13376e+00_r8,0.13482e+00_r8, & + & 0.13151e+00_r8,0.12334e+00_r8,0.11149e+00_r8,0.11415e+00_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.10591e+00_r8,0.11393e+00_r8,0.12456e+00_r8,0.13177e+00_r8,0.13532e+00_r8, & + & 0.13189e+00_r8,0.12388e+00_r8,0.10965e+00_r8,0.10563e+00_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.10784e+00_r8,0.11446e+00_r8,0.12497e+00_r8,0.13191e+00_r8,0.13527e+00_r8, & + & 0.13206e+00_r8,0.12372e+00_r8,0.10901e+00_r8,0.10541e+00_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.10982e+00_r8,0.11499e+00_r8,0.12496e+00_r8,0.13190e+00_r8,0.13491e+00_r8, & + & 0.13198e+00_r8,0.12329e+00_r8,0.10836e+00_r8,0.10528e+00_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.11183e+00_r8,0.11569e+00_r8,0.12499e+00_r8,0.13184e+00_r8,0.13435e+00_r8, & + & 0.13149e+00_r8,0.12252e+00_r8,0.10787e+00_r8,0.10590e+00_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.11351e+00_r8,0.11638e+00_r8,0.12535e+00_r8,0.13176e+00_r8,0.13360e+00_r8, & + & 0.13054e+00_r8,0.12191e+00_r8,0.10801e+00_r8,0.10661e+00_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.95227e-01_r8,0.10714e+00_r8,0.11944e+00_r8,0.12826e+00_r8,0.13131e+00_r8, & + & 0.12801e+00_r8,0.11973e+00_r8,0.10506e+00_r8,0.96127e-01_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.97380e-01_r8,0.10792e+00_r8,0.12010e+00_r8,0.12848e+00_r8,0.13131e+00_r8, & + & 0.12823e+00_r8,0.11988e+00_r8,0.10446e+00_r8,0.96013e-01_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.99589e-01_r8,0.10861e+00_r8,0.12043e+00_r8,0.12826e+00_r8,0.13099e+00_r8, & + & 0.12821e+00_r8,0.11964e+00_r8,0.10385e+00_r8,0.96337e-01_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.10172e+00_r8,0.10937e+00_r8,0.12073e+00_r8,0.12822e+00_r8,0.13048e+00_r8, & + & 0.12786e+00_r8,0.11915e+00_r8,0.10369e+00_r8,0.97324e-01_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.10340e+00_r8,0.11015e+00_r8,0.12136e+00_r8,0.12832e+00_r8,0.12998e+00_r8, & + & 0.12724e+00_r8,0.11892e+00_r8,0.10410e+00_r8,0.97908e-01_r8 /) + kao(:, 1,10,10) = (/ & + & 0.84549e-01_r8,0.10005e+00_r8,0.11370e+00_r8,0.12280e+00_r8,0.12503e+00_r8, & + & 0.12157e+00_r8,0.11395e+00_r8,0.99558e-01_r8,0.78463e-01_r8 /) + kao(:, 2,10,10) = (/ & + & 0.86895e-01_r8,0.10114e+00_r8,0.11438e+00_r8,0.12270e+00_r8,0.12494e+00_r8, & + & 0.12211e+00_r8,0.11447e+00_r8,0.98932e-01_r8,0.78293e-01_r8 /) + kao(:, 3,10,10) = (/ & + & 0.89280e-01_r8,0.10200e+00_r8,0.11501e+00_r8,0.12255e+00_r8,0.12466e+00_r8, & + & 0.12232e+00_r8,0.11449e+00_r8,0.98490e-01_r8,0.78963e-01_r8 /) + kao(:, 4,10,10) = (/ & + & 0.91373e-01_r8,0.10297e+00_r8,0.11555e+00_r8,0.12264e+00_r8,0.12433e+00_r8, & + & 0.12211e+00_r8,0.11429e+00_r8,0.98808e-01_r8,0.79894e-01_r8 /) + kao(:, 5,10,10) = (/ & + & 0.93116e-01_r8,0.10381e+00_r8,0.11616e+00_r8,0.12299e+00_r8,0.12420e+00_r8, & + & 0.12176e+00_r8,0.11463e+00_r8,0.99400e-01_r8,0.79228e-01_r8 /) + kao(:, 1,11,10) = (/ & + & 0.75544e-01_r8,0.93054e-01_r8,0.10724e+00_r8,0.11489e+00_r8,0.11666e+00_r8, & + & 0.11411e+00_r8,0.10739e+00_r8,0.92708e-01_r8,0.54552e-01_r8 /) + kao(:, 2,11,10) = (/ & + & 0.77908e-01_r8,0.94287e-01_r8,0.10808e+00_r8,0.11471e+00_r8,0.11661e+00_r8, & + & 0.11478e+00_r8,0.10772e+00_r8,0.92504e-01_r8,0.54848e-01_r8 /) + kao(:, 3,11,10) = (/ & + & 0.80077e-01_r8,0.95473e-01_r8,0.10868e+00_r8,0.11491e+00_r8,0.11655e+00_r8, & + & 0.11482e+00_r8,0.10782e+00_r8,0.93001e-01_r8,0.55769e-01_r8 /) + kao(:, 4,11,10) = (/ & + & 0.81960e-01_r8,0.96566e-01_r8,0.10943e+00_r8,0.11546e+00_r8,0.11672e+00_r8, & + & 0.11473e+00_r8,0.10831e+00_r8,0.93879e-01_r8,0.57926e-01_r8 /) + kao(:, 5,11,10) = (/ & + & 0.83450e-01_r8,0.97453e-01_r8,0.11008e+00_r8,0.11599e+00_r8,0.11716e+00_r8, & + & 0.11515e+00_r8,0.10911e+00_r8,0.94288e-01_r8,0.57746e-01_r8 /) + kao(:, 1,12,10) = (/ & + & 0.67513e-01_r8,0.86189e-01_r8,0.99369e-01_r8,0.10520e+00_r8,0.10724e+00_r8, & + & 0.10586e+00_r8,0.99242e-01_r8,0.85556e-01_r8,0.53156e-01_r8 /) + kao(:, 2,12,10) = (/ & + & 0.69613e-01_r8,0.87484e-01_r8,0.10007e+00_r8,0.10560e+00_r8,0.10749e+00_r8, & + & 0.10614e+00_r8,0.99761e-01_r8,0.86270e-01_r8,0.51781e-01_r8 /) + kao(:, 3,12,10) = (/ & + & 0.71469e-01_r8,0.88722e-01_r8,0.10094e+00_r8,0.10629e+00_r8,0.10784e+00_r8, & + & 0.10630e+00_r8,0.10046e+00_r8,0.87349e-01_r8,0.51450e-01_r8 /) + kao(:, 4,12,10) = (/ & + & 0.73024e-01_r8,0.89773e-01_r8,0.10183e+00_r8,0.10713e+00_r8,0.10860e+00_r8, & + & 0.10686e+00_r8,0.10138e+00_r8,0.88130e-01_r8,0.52601e-01_r8 /) + kao(:, 5,12,10) = (/ & + & 0.74303e-01_r8,0.90696e-01_r8,0.10259e+00_r8,0.10797e+00_r8,0.10971e+00_r8, & + & 0.10792e+00_r8,0.10184e+00_r8,0.88445e-01_r8,0.51152e-01_r8 /) + kao(:, 1,13,10) = (/ & + & 0.60529e-01_r8,0.79607e-01_r8,0.90318e-01_r8,0.95428e-01_r8,0.97408e-01_r8, & + & 0.96227e-01_r8,0.90699e-01_r8,0.78779e-01_r8,0.52832e-01_r8 /) + kao(:, 2,13,10) = (/ & + & 0.62276e-01_r8,0.80870e-01_r8,0.91247e-01_r8,0.96259e-01_r8,0.97934e-01_r8, & + & 0.96714e-01_r8,0.91680e-01_r8,0.79941e-01_r8,0.52303e-01_r8 /) + kao(:, 3,13,10) = (/ & + & 0.63790e-01_r8,0.81933e-01_r8,0.92274e-01_r8,0.97270e-01_r8,0.98880e-01_r8, & + & 0.97553e-01_r8,0.92636e-01_r8,0.80918e-01_r8,0.51576e-01_r8 /) + kao(:, 4,13,10) = (/ & + & 0.65028e-01_r8,0.82921e-01_r8,0.93287e-01_r8,0.98387e-01_r8,0.10023e+00_r8, & + & 0.98785e-01_r8,0.93367e-01_r8,0.81491e-01_r8,0.53387e-01_r8 /) + kao(:, 5,13,10) = (/ & + & 0.66150e-01_r8,0.83739e-01_r8,0.94354e-01_r8,0.99696e-01_r8,0.10169e+00_r8, & + & 0.99901e-01_r8,0.93863e-01_r8,0.81907e-01_r8,0.52837e-01_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.20407e+00_r8,0.18071e+00_r8,0.16029e+00_r8,0.15138e+00_r8,0.14997e+00_r8, & + & 0.13984e+00_r8,0.13275e+00_r8,0.14129e+00_r8,0.15399e+00_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.20135e+00_r8,0.17935e+00_r8,0.15932e+00_r8,0.15017e+00_r8,0.14962e+00_r8, & + & 0.13862e+00_r8,0.13266e+00_r8,0.14117e+00_r8,0.15393e+00_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.19936e+00_r8,0.17801e+00_r8,0.15787e+00_r8,0.14825e+00_r8,0.14805e+00_r8, & + & 0.13791e+00_r8,0.13257e+00_r8,0.14065e+00_r8,0.15357e+00_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.19744e+00_r8,0.17636e+00_r8,0.15587e+00_r8,0.14600e+00_r8,0.14568e+00_r8, & + & 0.13759e+00_r8,0.13216e+00_r8,0.14003e+00_r8,0.15311e+00_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.19560e+00_r8,0.17445e+00_r8,0.15370e+00_r8,0.14366e+00_r8,0.14353e+00_r8, & + & 0.13719e+00_r8,0.13142e+00_r8,0.13943e+00_r8,0.15271e+00_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.21063e+00_r8,0.18653e+00_r8,0.16583e+00_r8,0.16261e+00_r8,0.15745e+00_r8, & + & 0.14703e+00_r8,0.14143e+00_r8,0.14831e+00_r8,0.16307e+00_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.20807e+00_r8,0.18515e+00_r8,0.16450e+00_r8,0.16174e+00_r8,0.15680e+00_r8, & + & 0.14604e+00_r8,0.14115e+00_r8,0.14798e+00_r8,0.16304e+00_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.20581e+00_r8,0.18338e+00_r8,0.16244e+00_r8,0.15978e+00_r8,0.15520e+00_r8, & + & 0.14566e+00_r8,0.14067e+00_r8,0.14768e+00_r8,0.16312e+00_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.20347e+00_r8,0.18119e+00_r8,0.16010e+00_r8,0.15745e+00_r8,0.15333e+00_r8, & + & 0.14529e+00_r8,0.14007e+00_r8,0.14753e+00_r8,0.16343e+00_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.20115e+00_r8,0.17885e+00_r8,0.15773e+00_r8,0.15483e+00_r8,0.15150e+00_r8, & + & 0.14453e+00_r8,0.13948e+00_r8,0.14731e+00_r8,0.16359e+00_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.21616e+00_r8,0.19157e+00_r8,0.17353e+00_r8,0.17142e+00_r8,0.16301e+00_r8, & + & 0.15566e+00_r8,0.14998e+00_r8,0.15514e+00_r8,0.17145e+00_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.21408e+00_r8,0.19026e+00_r8,0.17182e+00_r8,0.17122e+00_r8,0.16252e+00_r8, & + & 0.15476e+00_r8,0.14939e+00_r8,0.15448e+00_r8,0.17139e+00_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.21163e+00_r8,0.18824e+00_r8,0.16950e+00_r8,0.16996e+00_r8,0.16151e+00_r8, & + & 0.15419e+00_r8,0.14882e+00_r8,0.15406e+00_r8,0.17163e+00_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.20914e+00_r8,0.18593e+00_r8,0.16692e+00_r8,0.16757e+00_r8,0.16029e+00_r8, & + & 0.15344e+00_r8,0.14837e+00_r8,0.15392e+00_r8,0.17198e+00_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.20701e+00_r8,0.18381e+00_r8,0.16453e+00_r8,0.16472e+00_r8,0.15897e+00_r8, & + & 0.15236e+00_r8,0.14801e+00_r8,0.15351e+00_r8,0.17179e+00_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.21862e+00_r8,0.19379e+00_r8,0.18221e+00_r8,0.17807e+00_r8,0.16954e+00_r8, & + & 0.16407e+00_r8,0.15829e+00_r8,0.16056e+00_r8,0.17755e+00_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.21705e+00_r8,0.19285e+00_r8,0.18086e+00_r8,0.17812e+00_r8,0.16909e+00_r8, & + & 0.16313e+00_r8,0.15767e+00_r8,0.16003e+00_r8,0.17784e+00_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.21534e+00_r8,0.19129e+00_r8,0.17879e+00_r8,0.17719e+00_r8,0.16821e+00_r8, & + & 0.16252e+00_r8,0.15706e+00_r8,0.15944e+00_r8,0.17796e+00_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.21357e+00_r8,0.18961e+00_r8,0.17644e+00_r8,0.17503e+00_r8,0.16720e+00_r8, & + & 0.16179e+00_r8,0.15644e+00_r8,0.15869e+00_r8,0.17755e+00_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.21192e+00_r8,0.18796e+00_r8,0.17436e+00_r8,0.17237e+00_r8,0.16599e+00_r8, & + & 0.16096e+00_r8,0.15564e+00_r8,0.15746e+00_r8,0.17656e+00_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.21793e+00_r8,0.19325e+00_r8,0.18965e+00_r8,0.18402e+00_r8,0.17692e+00_r8, & + & 0.17250e+00_r8,0.16494e+00_r8,0.16474e+00_r8,0.18189e+00_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.21706e+00_r8,0.19287e+00_r8,0.18835e+00_r8,0.18355e+00_r8,0.17627e+00_r8, & + & 0.17161e+00_r8,0.16474e+00_r8,0.16398e+00_r8,0.18195e+00_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.21612e+00_r8,0.19181e+00_r8,0.18687e+00_r8,0.18213e+00_r8,0.17553e+00_r8, & + & 0.17088e+00_r8,0.16425e+00_r8,0.16313e+00_r8,0.18152e+00_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.21478e+00_r8,0.19045e+00_r8,0.18500e+00_r8,0.18018e+00_r8,0.17440e+00_r8, & + & 0.16996e+00_r8,0.16342e+00_r8,0.16188e+00_r8,0.18054e+00_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.21350e+00_r8,0.18909e+00_r8,0.18333e+00_r8,0.17782e+00_r8,0.17309e+00_r8, & + & 0.16916e+00_r8,0.16213e+00_r8,0.16034e+00_r8,0.17917e+00_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.21342e+00_r8,0.19093e+00_r8,0.19390e+00_r8,0.18953e+00_r8,0.18412e+00_r8, & + & 0.17932e+00_r8,0.17133e+00_r8,0.16726e+00_r8,0.18355e+00_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.21345e+00_r8,0.19062e+00_r8,0.19295e+00_r8,0.18836e+00_r8,0.18309e+00_r8, & + & 0.17848e+00_r8,0.17069e+00_r8,0.16650e+00_r8,0.18323e+00_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.21341e+00_r8,0.18999e+00_r8,0.19180e+00_r8,0.18672e+00_r8,0.18231e+00_r8, & + & 0.17805e+00_r8,0.16996e+00_r8,0.16523e+00_r8,0.18230e+00_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.21278e+00_r8,0.18888e+00_r8,0.19035e+00_r8,0.18488e+00_r8,0.18150e+00_r8, & + & 0.17740e+00_r8,0.16888e+00_r8,0.16361e+00_r8,0.18086e+00_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.21199e+00_r8,0.18788e+00_r8,0.18853e+00_r8,0.18312e+00_r8,0.18053e+00_r8, & + & 0.17647e+00_r8,0.16753e+00_r8,0.16185e+00_r8,0.17942e+00_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.20554e+00_r8,0.18880e+00_r8,0.19483e+00_r8,0.19351e+00_r8,0.18975e+00_r8, & + & 0.18476e+00_r8,0.17703e+00_r8,0.16712e+00_r8,0.18079e+00_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.20652e+00_r8,0.18855e+00_r8,0.19393e+00_r8,0.19243e+00_r8,0.18938e+00_r8, & + & 0.18427e+00_r8,0.17598e+00_r8,0.16627e+00_r8,0.18028e+00_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.20722e+00_r8,0.18798e+00_r8,0.19279e+00_r8,0.19112e+00_r8,0.18883e+00_r8, & + & 0.18376e+00_r8,0.17458e+00_r8,0.16493e+00_r8,0.17920e+00_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.20704e+00_r8,0.18700e+00_r8,0.19152e+00_r8,0.18972e+00_r8,0.18818e+00_r8, & + & 0.18325e+00_r8,0.17326e+00_r8,0.16331e+00_r8,0.17789e+00_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.20670e+00_r8,0.18595e+00_r8,0.18990e+00_r8,0.18822e+00_r8,0.18756e+00_r8, & + & 0.18244e+00_r8,0.17179e+00_r8,0.16146e+00_r8,0.17654e+00_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.19482e+00_r8,0.18644e+00_r8,0.19372e+00_r8,0.19534e+00_r8,0.19341e+00_r8, & + & 0.18978e+00_r8,0.17991e+00_r8,0.16480e+00_r8,0.17385e+00_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.19645e+00_r8,0.18662e+00_r8,0.19286e+00_r8,0.19499e+00_r8,0.19364e+00_r8, & + & 0.18939e+00_r8,0.17872e+00_r8,0.16377e+00_r8,0.17323e+00_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.19752e+00_r8,0.18632e+00_r8,0.19176e+00_r8,0.19416e+00_r8,0.19361e+00_r8, & + & 0.18898e+00_r8,0.17730e+00_r8,0.16248e+00_r8,0.17231e+00_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.19786e+00_r8,0.18535e+00_r8,0.19058e+00_r8,0.19340e+00_r8,0.19352e+00_r8, & + & 0.18844e+00_r8,0.17582e+00_r8,0.16092e+00_r8,0.17110e+00_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.19827e+00_r8,0.18472e+00_r8,0.18922e+00_r8,0.19254e+00_r8,0.19302e+00_r8, & + & 0.18739e+00_r8,0.17431e+00_r8,0.15936e+00_r8,0.17034e+00_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.18199e+00_r8,0.18200e+00_r8,0.19084e+00_r8,0.19456e+00_r8,0.19545e+00_r8, & + & 0.19216e+00_r8,0.18018e+00_r8,0.16033e+00_r8,0.16333e+00_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.18402e+00_r8,0.18227e+00_r8,0.19032e+00_r8,0.19515e+00_r8,0.19643e+00_r8, & + & 0.19212e+00_r8,0.17883e+00_r8,0.15954e+00_r8,0.16306e+00_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.18527e+00_r8,0.18204e+00_r8,0.18956e+00_r8,0.19541e+00_r8,0.19690e+00_r8, & + & 0.19201e+00_r8,0.17754e+00_r8,0.15865e+00_r8,0.16240e+00_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.18597e+00_r8,0.18146e+00_r8,0.18866e+00_r8,0.19510e+00_r8,0.19689e+00_r8, & + & 0.19145e+00_r8,0.17626e+00_r8,0.15729e+00_r8,0.16157e+00_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.18701e+00_r8,0.18150e+00_r8,0.18776e+00_r8,0.19449e+00_r8,0.19637e+00_r8, & + & 0.19035e+00_r8,0.17490e+00_r8,0.15605e+00_r8,0.16154e+00_r8 /) + kao(:, 1,10,11) = (/ & + & 0.16786e+00_r8,0.17459e+00_r8,0.18572e+00_r8,0.19196e+00_r8,0.19497e+00_r8, & + & 0.19093e+00_r8,0.17775e+00_r8,0.15445e+00_r8,0.12845e+00_r8 /) + kao(:, 2,10,11) = (/ & + & 0.16990e+00_r8,0.17470e+00_r8,0.18604e+00_r8,0.19354e+00_r8,0.19670e+00_r8, & + & 0.19124e+00_r8,0.17643e+00_r8,0.15415e+00_r8,0.12953e+00_r8 /) + kao(:, 3,10,11) = (/ & + & 0.17115e+00_r8,0.17447e+00_r8,0.18577e+00_r8,0.19420e+00_r8,0.19734e+00_r8, & + & 0.19133e+00_r8,0.17544e+00_r8,0.15343e+00_r8,0.13019e+00_r8 /) + kao(:, 4,10,11) = (/ & + & 0.17256e+00_r8,0.17421e+00_r8,0.18540e+00_r8,0.19426e+00_r8,0.19741e+00_r8, & + & 0.19105e+00_r8,0.17463e+00_r8,0.15245e+00_r8,0.13135e+00_r8 /) + kao(:, 5,10,11) = (/ & + & 0.17411e+00_r8,0.17469e+00_r8,0.18532e+00_r8,0.19400e+00_r8,0.19690e+00_r8, & + & 0.19024e+00_r8,0.17373e+00_r8,0.15177e+00_r8,0.13443e+00_r8 /) + kao(:, 1,11,11) = (/ & + & 0.15326e+00_r8,0.16530e+00_r8,0.17933e+00_r8,0.18873e+00_r8,0.19204e+00_r8, & + & 0.18645e+00_r8,0.17157e+00_r8,0.14842e+00_r8,0.10906e+00_r8 /) + kao(:, 2,11,11) = (/ & + & 0.15510e+00_r8,0.16508e+00_r8,0.18002e+00_r8,0.19054e+00_r8,0.19337e+00_r8, & + & 0.18697e+00_r8,0.17132e+00_r8,0.14823e+00_r8,0.10821e+00_r8 /) + kao(:, 3,11,11) = (/ & + & 0.15695e+00_r8,0.16517e+00_r8,0.18033e+00_r8,0.19125e+00_r8,0.19395e+00_r8, & + & 0.18719e+00_r8,0.17114e+00_r8,0.14748e+00_r8,0.10735e+00_r8 /) + kao(:, 4,11,11) = (/ & + & 0.15884e+00_r8,0.16584e+00_r8,0.18066e+00_r8,0.19107e+00_r8,0.19386e+00_r8, & + & 0.18714e+00_r8,0.17083e+00_r8,0.14679e+00_r8,0.10767e+00_r8 /) + kao(:, 5,11,11) = (/ & + & 0.16065e+00_r8,0.16693e+00_r8,0.18136e+00_r8,0.19090e+00_r8,0.19313e+00_r8, & + & 0.18652e+00_r8,0.17043e+00_r8,0.14693e+00_r8,0.10852e+00_r8 /) + kao(:, 1,12,11) = (/ & + & 0.13812e+00_r8,0.15482e+00_r8,0.17200e+00_r8,0.18322e+00_r8,0.18516e+00_r8, & + & 0.17855e+00_r8,0.16404e+00_r8,0.14149e+00_r8,0.85521e-01_r8 /) + kao(:, 2,12,11) = (/ & + & 0.14024e+00_r8,0.15523e+00_r8,0.17295e+00_r8,0.18464e+00_r8,0.18616e+00_r8, & + & 0.17947e+00_r8,0.16474e+00_r8,0.14107e+00_r8,0.84251e-01_r8 /) + kao(:, 3,12,11) = (/ & + & 0.14232e+00_r8,0.15625e+00_r8,0.17374e+00_r8,0.18482e+00_r8,0.18666e+00_r8, & + & 0.18015e+00_r8,0.16507e+00_r8,0.14067e+00_r8,0.83221e-01_r8 /) + kao(:, 4,12,11) = (/ & + & 0.14452e+00_r8,0.15760e+00_r8,0.17483e+00_r8,0.18482e+00_r8,0.18644e+00_r8, & + & 0.18031e+00_r8,0.16530e+00_r8,0.14085e+00_r8,0.83052e-01_r8 /) + kao(:, 5,12,11) = (/ & + & 0.14659e+00_r8,0.15898e+00_r8,0.17608e+00_r8,0.18496e+00_r8,0.18608e+00_r8, & + & 0.18007e+00_r8,0.16596e+00_r8,0.14156e+00_r8,0.86150e-01_r8 /) + kao(:, 1,13,11) = (/ & + & 0.12335e+00_r8,0.14397e+00_r8,0.16332e+00_r8,0.17403e+00_r8,0.17485e+00_r8, & + & 0.16858e+00_r8,0.15532e+00_r8,0.13315e+00_r8,0.86982e-01_r8 /) + kao(:, 2,13,11) = (/ & + & 0.12553e+00_r8,0.14531e+00_r8,0.16473e+00_r8,0.17477e+00_r8,0.17593e+00_r8, & + & 0.16998e+00_r8,0.15639e+00_r8,0.13322e+00_r8,0.83311e-01_r8 /) + kao(:, 3,13,11) = (/ & + & 0.12788e+00_r8,0.14705e+00_r8,0.16612e+00_r8,0.17511e+00_r8,0.17644e+00_r8, & + & 0.17090e+00_r8,0.15730e+00_r8,0.13374e+00_r8,0.80969e-01_r8 /) + kao(:, 4,13,11) = (/ & + & 0.13027e+00_r8,0.14889e+00_r8,0.16746e+00_r8,0.17569e+00_r8,0.17660e+00_r8, & + & 0.17136e+00_r8,0.15852e+00_r8,0.13468e+00_r8,0.79671e-01_r8 /) + kao(:, 5,13,11) = (/ & + & 0.13255e+00_r8,0.15069e+00_r8,0.16867e+00_r8,0.17661e+00_r8,0.17696e+00_r8, & + & 0.17204e+00_r8,0.15992e+00_r8,0.13520e+00_r8,0.81334e-01_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.28721e+00_r8,0.25323e+00_r8,0.21917e+00_r8,0.19050e+00_r8,0.18439e+00_r8, & + & 0.17842e+00_r8,0.17156e+00_r8,0.18245e+00_r8,0.20075e+00_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.28561e+00_r8,0.25177e+00_r8,0.21845e+00_r8,0.19052e+00_r8,0.18309e+00_r8, & + & 0.17638e+00_r8,0.16966e+00_r8,0.18096e+00_r8,0.19965e+00_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.28230e+00_r8,0.24910e+00_r8,0.21697e+00_r8,0.19014e+00_r8,0.18233e+00_r8, & + & 0.17414e+00_r8,0.16821e+00_r8,0.18034e+00_r8,0.19910e+00_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.27834e+00_r8,0.24592e+00_r8,0.21540e+00_r8,0.18935e+00_r8,0.18163e+00_r8, & + & 0.17186e+00_r8,0.16739e+00_r8,0.18033e+00_r8,0.19922e+00_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.27434e+00_r8,0.24303e+00_r8,0.21391e+00_r8,0.18803e+00_r8,0.18019e+00_r8, & + & 0.17025e+00_r8,0.16693e+00_r8,0.18042e+00_r8,0.19937e+00_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.29623e+00_r8,0.26097e+00_r8,0.22609e+00_r8,0.20293e+00_r8,0.20182e+00_r8, & + & 0.19085e+00_r8,0.18240e+00_r8,0.19397e+00_r8,0.21604e+00_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.29432e+00_r8,0.25931e+00_r8,0.22539e+00_r8,0.20142e+00_r8,0.20026e+00_r8, & + & 0.18828e+00_r8,0.18057e+00_r8,0.19299e+00_r8,0.21521e+00_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.29132e+00_r8,0.25712e+00_r8,0.22457e+00_r8,0.20070e+00_r8,0.19917e+00_r8, & + & 0.18573e+00_r8,0.17946e+00_r8,0.19254e+00_r8,0.21482e+00_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.28797e+00_r8,0.25474e+00_r8,0.22345e+00_r8,0.19986e+00_r8,0.19780e+00_r8, & + & 0.18370e+00_r8,0.17875e+00_r8,0.19238e+00_r8,0.21459e+00_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.28466e+00_r8,0.25242e+00_r8,0.22205e+00_r8,0.19838e+00_r8,0.19562e+00_r8, & + & 0.18242e+00_r8,0.17806e+00_r8,0.19203e+00_r8,0.21421e+00_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.30561e+00_r8,0.26889e+00_r8,0.23295e+00_r8,0.21956e+00_r8,0.21717e+00_r8, & + & 0.20307e+00_r8,0.19524e+00_r8,0.20742e+00_r8,0.23388e+00_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.30324e+00_r8,0.26704e+00_r8,0.23237e+00_r8,0.21738e+00_r8,0.21493e+00_r8, & + & 0.20036e+00_r8,0.19375e+00_r8,0.20659e+00_r8,0.23304e+00_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.30058e+00_r8,0.26531e+00_r8,0.23190e+00_r8,0.21598e+00_r8,0.21300e+00_r8, & + & 0.19790e+00_r8,0.19244e+00_r8,0.20627e+00_r8,0.23259e+00_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.29826e+00_r8,0.26386e+00_r8,0.23125e+00_r8,0.21516e+00_r8,0.21099e+00_r8, & + & 0.19626e+00_r8,0.19135e+00_r8,0.20570e+00_r8,0.23176e+00_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.29569e+00_r8,0.26204e+00_r8,0.22972e+00_r8,0.21357e+00_r8,0.20846e+00_r8, & + & 0.19500e+00_r8,0.19003e+00_r8,0.20504e+00_r8,0.23084e+00_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.31580e+00_r8,0.27765e+00_r8,0.24256e+00_r8,0.23825e+00_r8,0.23010e+00_r8, & + & 0.21605e+00_r8,0.20908e+00_r8,0.22073e+00_r8,0.25027e+00_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.31385e+00_r8,0.27619e+00_r8,0.24143e+00_r8,0.23561e+00_r8,0.22732e+00_r8, & + & 0.21355e+00_r8,0.20732e+00_r8,0.21997e+00_r8,0.24945e+00_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.31115e+00_r8,0.27450e+00_r8,0.24049e+00_r8,0.23383e+00_r8,0.22480e+00_r8, & + & 0.21136e+00_r8,0.20583e+00_r8,0.21971e+00_r8,0.24898e+00_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.30851e+00_r8,0.27268e+00_r8,0.23896e+00_r8,0.23220e+00_r8,0.22243e+00_r8, & + & 0.20992e+00_r8,0.20459e+00_r8,0.21945e+00_r8,0.24850e+00_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.30578e+00_r8,0.27071e+00_r8,0.23717e+00_r8,0.23033e+00_r8,0.22018e+00_r8, & + & 0.20870e+00_r8,0.20353e+00_r8,0.21927e+00_r8,0.24814e+00_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.32525e+00_r8,0.28587e+00_r8,0.25583e+00_r8,0.25377e+00_r8,0.24260e+00_r8, & + & 0.22945e+00_r8,0.22249e+00_r8,0.23280e+00_r8,0.26422e+00_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.32339e+00_r8,0.28450e+00_r8,0.25406e+00_r8,0.25143e+00_r8,0.23950e+00_r8, & + & 0.22738e+00_r8,0.22044e+00_r8,0.23211e+00_r8,0.26348e+00_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.32075e+00_r8,0.28298e+00_r8,0.25200e+00_r8,0.24974e+00_r8,0.23665e+00_r8, & + & 0.22565e+00_r8,0.21882e+00_r8,0.23178e+00_r8,0.26317e+00_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.31838e+00_r8,0.28134e+00_r8,0.24992e+00_r8,0.24807e+00_r8,0.23442e+00_r8, & + & 0.22435e+00_r8,0.21780e+00_r8,0.23180e+00_r8,0.26307e+00_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.31581e+00_r8,0.27952e+00_r8,0.24774e+00_r8,0.24618e+00_r8,0.23239e+00_r8, & + & 0.22315e+00_r8,0.21723e+00_r8,0.23168e+00_r8,0.26269e+00_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.33335e+00_r8,0.29286e+00_r8,0.27107e+00_r8,0.26707e+00_r8,0.25627e+00_r8, & + & 0.24388e+00_r8,0.23516e+00_r8,0.24254e+00_r8,0.27495e+00_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.33185e+00_r8,0.29196e+00_r8,0.26927e+00_r8,0.26528e+00_r8,0.25338e+00_r8, & + & 0.24199e+00_r8,0.23321e+00_r8,0.24178e+00_r8,0.27452e+00_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.32960e+00_r8,0.29070e+00_r8,0.26757e+00_r8,0.26387e+00_r8,0.25062e+00_r8, & + & 0.24015e+00_r8,0.23158e+00_r8,0.24188e+00_r8,0.27485e+00_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.32714e+00_r8,0.28920e+00_r8,0.26543e+00_r8,0.26229e+00_r8,0.24828e+00_r8, & + & 0.23863e+00_r8,0.23085e+00_r8,0.24191e+00_r8,0.27476e+00_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.32443e+00_r8,0.28722e+00_r8,0.26300e+00_r8,0.25993e+00_r8,0.24627e+00_r8, & + & 0.23716e+00_r8,0.23011e+00_r8,0.24150e+00_r8,0.27410e+00_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.33805e+00_r8,0.29686e+00_r8,0.28577e+00_r8,0.27897e+00_r8,0.26998e+00_r8, & + & 0.25892e+00_r8,0.24589e+00_r8,0.25046e+00_r8,0.28292e+00_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.33717e+00_r8,0.29673e+00_r8,0.28505e+00_r8,0.27748e+00_r8,0.26727e+00_r8, & + & 0.25668e+00_r8,0.24439e+00_r8,0.24991e+00_r8,0.28315e+00_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.33582e+00_r8,0.29639e+00_r8,0.28414e+00_r8,0.27664e+00_r8,0.26503e+00_r8, & + & 0.25454e+00_r8,0.24355e+00_r8,0.24982e+00_r8,0.28339e+00_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.33418e+00_r8,0.29565e+00_r8,0.28243e+00_r8,0.27502e+00_r8,0.26319e+00_r8, & + & 0.25262e+00_r8,0.24314e+00_r8,0.24937e+00_r8,0.28297e+00_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.33223e+00_r8,0.29432e+00_r8,0.28036e+00_r8,0.27276e+00_r8,0.26126e+00_r8, & + & 0.25114e+00_r8,0.24223e+00_r8,0.24874e+00_r8,0.28224e+00_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.33811e+00_r8,0.29881e+00_r8,0.29770e+00_r8,0.29087e+00_r8,0.28271e+00_r8, & + & 0.27088e+00_r8,0.25606e+00_r8,0.25702e+00_r8,0.28869e+00_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.33858e+00_r8,0.29933e+00_r8,0.29817e+00_r8,0.28968e+00_r8,0.28063e+00_r8, & + & 0.26913e+00_r8,0.25508e+00_r8,0.25647e+00_r8,0.28886e+00_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.33853e+00_r8,0.29979e+00_r8,0.29803e+00_r8,0.28900e+00_r8,0.27895e+00_r8, & + & 0.26698e+00_r8,0.25454e+00_r8,0.25561e+00_r8,0.28857e+00_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.33786e+00_r8,0.29958e+00_r8,0.29705e+00_r8,0.28721e+00_r8,0.27754e+00_r8, & + & 0.26522e+00_r8,0.25386e+00_r8,0.25480e+00_r8,0.28812e+00_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.33672e+00_r8,0.29874e+00_r8,0.29538e+00_r8,0.28492e+00_r8,0.27593e+00_r8, & + & 0.26422e+00_r8,0.25288e+00_r8,0.25337e+00_r8,0.28657e+00_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.33304e+00_r8,0.29965e+00_r8,0.30451e+00_r8,0.30108e+00_r8,0.29380e+00_r8, & + & 0.28100e+00_r8,0.26620e+00_r8,0.26062e+00_r8,0.28923e+00_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.33493e+00_r8,0.30099e+00_r8,0.30590e+00_r8,0.30051e+00_r8,0.29241e+00_r8, & + & 0.27971e+00_r8,0.26553e+00_r8,0.25927e+00_r8,0.28890e+00_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.33639e+00_r8,0.30210e+00_r8,0.30672e+00_r8,0.29976e+00_r8,0.29135e+00_r8, & + & 0.27789e+00_r8,0.26459e+00_r8,0.25779e+00_r8,0.28847e+00_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.33691e+00_r8,0.30238e+00_r8,0.30636e+00_r8,0.29831e+00_r8,0.29055e+00_r8, & + & 0.27684e+00_r8,0.26372e+00_r8,0.25629e+00_r8,0.28756e+00_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.33680e+00_r8,0.30184e+00_r8,0.30474e+00_r8,0.29664e+00_r8,0.28906e+00_r8, & + & 0.27593e+00_r8,0.26250e+00_r8,0.25436e+00_r8,0.28576e+00_r8 /) + kao(:, 1,10,12) = (/ & + & 0.32265e+00_r8,0.29931e+00_r8,0.30809e+00_r8,0.30788e+00_r8,0.30155e+00_r8, & + & 0.29032e+00_r8,0.27398e+00_r8,0.25958e+00_r8,0.28232e+00_r8 /) + kao(:, 2,10,12) = (/ & + & 0.32643e+00_r8,0.30217e+00_r8,0.30992e+00_r8,0.30804e+00_r8,0.30109e+00_r8, & + & 0.28947e+00_r8,0.27364e+00_r8,0.25761e+00_r8,0.28165e+00_r8 /) + kao(:, 3,10,12) = (/ & + & 0.32903e+00_r8,0.30409e+00_r8,0.31077e+00_r8,0.30846e+00_r8,0.30095e+00_r8, & + & 0.28833e+00_r8,0.27259e+00_r8,0.25601e+00_r8,0.28124e+00_r8 /) + kao(:, 4,10,12) = (/ & + & 0.33021e+00_r8,0.30472e+00_r8,0.31062e+00_r8,0.30777e+00_r8,0.30050e+00_r8, & + & 0.28725e+00_r8,0.27132e+00_r8,0.25418e+00_r8,0.28034e+00_r8 /) + kao(:, 5,10,12) = (/ & + & 0.33035e+00_r8,0.30379e+00_r8,0.30948e+00_r8,0.30647e+00_r8,0.29984e+00_r8, & + & 0.28648e+00_r8,0.26959e+00_r8,0.25216e+00_r8,0.27891e+00_r8 /) + kao(:, 1,11,12) = (/ & + & 0.31092e+00_r8,0.29828e+00_r8,0.30944e+00_r8,0.31067e+00_r8,0.30618e+00_r8, & + & 0.29698e+00_r8,0.27822e+00_r8,0.25367e+00_r8,0.20521e+00_r8 /) + kao(:, 2,11,12) = (/ & + & 0.31508e+00_r8,0.30179e+00_r8,0.31084e+00_r8,0.31247e+00_r8,0.30712e+00_r8, & + & 0.29665e+00_r8,0.27717e+00_r8,0.25137e+00_r8,0.20791e+00_r8 /) + kao(:, 3,11,12) = (/ & + & 0.31745e+00_r8,0.30351e+00_r8,0.31148e+00_r8,0.31329e+00_r8,0.30764e+00_r8, & + & 0.29592e+00_r8,0.27601e+00_r8,0.24946e+00_r8,0.21041e+00_r8 /) + kao(:, 4,11,12) = (/ & + & 0.31864e+00_r8,0.30345e+00_r8,0.31137e+00_r8,0.31328e+00_r8,0.30818e+00_r8, & + & 0.29525e+00_r8,0.27444e+00_r8,0.24795e+00_r8,0.21312e+00_r8 /) + kao(:, 5,11,12) = (/ & + & 0.31936e+00_r8,0.30268e+00_r8,0.31034e+00_r8,0.31260e+00_r8,0.30827e+00_r8, & + & 0.29465e+00_r8,0.27259e+00_r8,0.24615e+00_r8,0.21621e+00_r8 /) + kao(:, 1,12,12) = (/ & + & 0.29534e+00_r8,0.29381e+00_r8,0.30706e+00_r8,0.31081e+00_r8,0.30893e+00_r8, & + & 0.29961e+00_r8,0.27811e+00_r8,0.24533e+00_r8,0.16496e+00_r8 /) + kao(:, 2,12,12) = (/ & + & 0.29914e+00_r8,0.29664e+00_r8,0.30890e+00_r8,0.31347e+00_r8,0.31102e+00_r8, & + & 0.29958e+00_r8,0.27683e+00_r8,0.24361e+00_r8,0.16812e+00_r8 /) + kao(:, 3,12,12) = (/ & + & 0.30164e+00_r8,0.29790e+00_r8,0.30986e+00_r8,0.31529e+00_r8,0.31277e+00_r8, & + & 0.29960e+00_r8,0.27547e+00_r8,0.24230e+00_r8,0.17163e+00_r8 /) + kao(:, 4,12,12) = (/ & + & 0.30318e+00_r8,0.29799e+00_r8,0.30963e+00_r8,0.31596e+00_r8,0.31358e+00_r8, & + & 0.29964e+00_r8,0.27410e+00_r8,0.24090e+00_r8,0.17207e+00_r8 /) + kao(:, 5,12,12) = (/ & + & 0.30462e+00_r8,0.29774e+00_r8,0.30883e+00_r8,0.31580e+00_r8,0.31382e+00_r8, & + & 0.29942e+00_r8,0.27289e+00_r8,0.23940e+00_r8,0.17248e+00_r8 /) + kao(:, 1,13,12) = (/ & + & 0.27646e+00_r8,0.28482e+00_r8,0.30092e+00_r8,0.30845e+00_r8,0.30839e+00_r8, & + & 0.29721e+00_r8,0.27391e+00_r8,0.23566e+00_r8,0.13145e+00_r8 /) + kao(:, 2,13,12) = (/ & + & 0.28013e+00_r8,0.28703e+00_r8,0.30330e+00_r8,0.31210e+00_r8,0.31152e+00_r8, & + & 0.29799e+00_r8,0.27265e+00_r8,0.23501e+00_r8,0.13680e+00_r8 /) + kao(:, 3,13,12) = (/ & + & 0.28251e+00_r8,0.28781e+00_r8,0.30455e+00_r8,0.31430e+00_r8,0.31342e+00_r8, & + & 0.29883e+00_r8,0.27192e+00_r8,0.23420e+00_r8,0.14031e+00_r8 /) + kao(:, 4,13,12) = (/ & + & 0.28473e+00_r8,0.28806e+00_r8,0.30532e+00_r8,0.31558e+00_r8,0.31478e+00_r8, & + & 0.29964e+00_r8,0.27140e+00_r8,0.23324e+00_r8,0.14138e+00_r8 /) + kao(:, 5,13,12) = (/ & + & 0.28731e+00_r8,0.28885e+00_r8,0.30563e+00_r8,0.31603e+00_r8,0.31529e+00_r8, & + & 0.30003e+00_r8,0.27073e+00_r8,0.23300e+00_r8,0.14291e+00_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.39331e+00_r8,0.34536e+00_r8,0.29823e+00_r8,0.25200e+00_r8,0.22257e+00_r8, & + & 0.22153e+00_r8,0.23263e+00_r8,0.25940e+00_r8,0.28372e+00_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.38484e+00_r8,0.33824e+00_r8,0.29242e+00_r8,0.24772e+00_r8,0.21768e+00_r8, & + & 0.21972e+00_r8,0.23098e+00_r8,0.25833e+00_r8,0.28173e+00_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.37910e+00_r8,0.33360e+00_r8,0.28884e+00_r8,0.24475e+00_r8,0.21421e+00_r8, & + & 0.21744e+00_r8,0.22823e+00_r8,0.25633e+00_r8,0.27932e+00_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.37406e+00_r8,0.32956e+00_r8,0.28576e+00_r8,0.24212e+00_r8,0.21151e+00_r8, & + & 0.21463e+00_r8,0.22480e+00_r8,0.25354e+00_r8,0.27637e+00_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.36968e+00_r8,0.32602e+00_r8,0.28272e+00_r8,0.24026e+00_r8,0.20970e+00_r8, & + & 0.21134e+00_r8,0.22163e+00_r8,0.25081e+00_r8,0.27385e+00_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.41602e+00_r8,0.36529e+00_r8,0.31527e+00_r8,0.26672e+00_r8,0.24637e+00_r8, & + & 0.24718e+00_r8,0.25604e+00_r8,0.28585e+00_r8,0.31850e+00_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.40830e+00_r8,0.35891e+00_r8,0.31022e+00_r8,0.26338e+00_r8,0.24193e+00_r8, & + & 0.24484e+00_r8,0.25382e+00_r8,0.28396e+00_r8,0.31574e+00_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.40220e+00_r8,0.35391e+00_r8,0.30635e+00_r8,0.26042e+00_r8,0.23856e+00_r8, & + & 0.24224e+00_r8,0.25030e+00_r8,0.28140e+00_r8,0.31256e+00_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.39708e+00_r8,0.34976e+00_r8,0.30310e+00_r8,0.25764e+00_r8,0.23590e+00_r8, & + & 0.23895e+00_r8,0.24655e+00_r8,0.27840e+00_r8,0.30929e+00_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.39199e+00_r8,0.34559e+00_r8,0.29962e+00_r8,0.25559e+00_r8,0.23369e+00_r8, & + & 0.23517e+00_r8,0.24316e+00_r8,0.27577e+00_r8,0.30660e+00_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.43911e+00_r8,0.38551e+00_r8,0.33254e+00_r8,0.28548e+00_r8,0.27501e+00_r8, & + & 0.27158e+00_r8,0.27806e+00_r8,0.30961e+00_r8,0.34942e+00_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.43165e+00_r8,0.37930e+00_r8,0.32763e+00_r8,0.28158e+00_r8,0.27135e+00_r8, & + & 0.26881e+00_r8,0.27489e+00_r8,0.30725e+00_r8,0.34620e+00_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.42551e+00_r8,0.37419e+00_r8,0.32362e+00_r8,0.27772e+00_r8,0.26799e+00_r8, & + & 0.26571e+00_r8,0.27096e+00_r8,0.30422e+00_r8,0.34240e+00_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.42038e+00_r8,0.37000e+00_r8,0.32049e+00_r8,0.27494e+00_r8,0.26498e+00_r8, & + & 0.26183e+00_r8,0.26698e+00_r8,0.30136e+00_r8,0.33931e+00_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.41446e+00_r8,0.36533e+00_r8,0.31734e+00_r8,0.27304e+00_r8,0.26234e+00_r8, & + & 0.25777e+00_r8,0.26380e+00_r8,0.29913e+00_r8,0.33705e+00_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.46241e+00_r8,0.40571e+00_r8,0.34961e+00_r8,0.30954e+00_r8,0.30425e+00_r8, & + & 0.29507e+00_r8,0.29890e+00_r8,0.33301e+00_r8,0.37827e+00_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.45465e+00_r8,0.39923e+00_r8,0.34450e+00_r8,0.30510e+00_r8,0.30124e+00_r8, & + & 0.29145e+00_r8,0.29516e+00_r8,0.32984e+00_r8,0.37410e+00_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.44872e+00_r8,0.39432e+00_r8,0.34072e+00_r8,0.30104e+00_r8,0.29841e+00_r8, & + & 0.28758e+00_r8,0.29090e+00_r8,0.32641e+00_r8,0.36986e+00_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.44350e+00_r8,0.39014e+00_r8,0.33810e+00_r8,0.29814e+00_r8,0.29548e+00_r8, & + & 0.28294e+00_r8,0.28676e+00_r8,0.32342e+00_r8,0.36667e+00_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.43828e+00_r8,0.38609e+00_r8,0.33570e+00_r8,0.29627e+00_r8,0.29269e+00_r8, & + & 0.27870e+00_r8,0.28357e+00_r8,0.32115e+00_r8,0.36426e+00_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.48784e+00_r8,0.42784e+00_r8,0.36835e+00_r8,0.33984e+00_r8,0.33294e+00_r8, & + & 0.31846e+00_r8,0.32126e+00_r8,0.35651e+00_r8,0.40621e+00_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.48030e+00_r8,0.42153e+00_r8,0.36340e+00_r8,0.33519e+00_r8,0.32973e+00_r8, & + & 0.31380e+00_r8,0.31683e+00_r8,0.35311e+00_r8,0.40187e+00_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.47411e+00_r8,0.41636e+00_r8,0.35974e+00_r8,0.33136e+00_r8,0.32664e+00_r8, & + & 0.30892e+00_r8,0.31220e+00_r8,0.34964e+00_r8,0.39763e+00_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.46883e+00_r8,0.41227e+00_r8,0.35745e+00_r8,0.32776e+00_r8,0.32317e+00_r8, & + & 0.30393e+00_r8,0.30777e+00_r8,0.34651e+00_r8,0.39440e+00_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.46388e+00_r8,0.40844e+00_r8,0.35543e+00_r8,0.32520e+00_r8,0.31964e+00_r8, & + & 0.29971e+00_r8,0.30439e+00_r8,0.34429e+00_r8,0.39205e+00_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.51535e+00_r8,0.45180e+00_r8,0.39162e+00_r8,0.37322e+00_r8,0.36050e+00_r8, & + & 0.34300e+00_r8,0.34505e+00_r8,0.38137e+00_r8,0.43538e+00_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.50781e+00_r8,0.44545e+00_r8,0.38586e+00_r8,0.36868e+00_r8,0.35573e+00_r8, & + & 0.33760e+00_r8,0.34025e+00_r8,0.37783e+00_r8,0.43095e+00_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.50139e+00_r8,0.44011e+00_r8,0.38148e+00_r8,0.36480e+00_r8,0.35183e+00_r8, & + & 0.33217e+00_r8,0.33546e+00_r8,0.37434e+00_r8,0.42674e+00_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.49657e+00_r8,0.43636e+00_r8,0.37891e+00_r8,0.36116e+00_r8,0.34800e+00_r8, & + & 0.32704e+00_r8,0.33102e+00_r8,0.37152e+00_r8,0.42385e+00_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.49171e+00_r8,0.43263e+00_r8,0.37693e+00_r8,0.35827e+00_r8,0.34376e+00_r8, & + & 0.32320e+00_r8,0.32782e+00_r8,0.36976e+00_r8,0.42188e+00_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.54162e+00_r8,0.47464e+00_r8,0.41834e+00_r8,0.40782e+00_r8,0.38721e+00_r8, & + & 0.36824e+00_r8,0.37067e+00_r8,0.40670e+00_r8,0.46460e+00_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.53535e+00_r8,0.46937e+00_r8,0.41220e+00_r8,0.40296e+00_r8,0.38145e+00_r8, & + & 0.36278e+00_r8,0.36581e+00_r8,0.40309e+00_r8,0.46013e+00_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.52914e+00_r8,0.46429e+00_r8,0.40710e+00_r8,0.39788e+00_r8,0.37673e+00_r8, & + & 0.35819e+00_r8,0.36078e+00_r8,0.40008e+00_r8,0.45678e+00_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.52440e+00_r8,0.46050e+00_r8,0.40384e+00_r8,0.39374e+00_r8,0.37204e+00_r8, & + & 0.35371e+00_r8,0.35616e+00_r8,0.39775e+00_r8,0.45424e+00_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.52017e+00_r8,0.45722e+00_r8,0.40132e+00_r8,0.39030e+00_r8,0.36733e+00_r8, & + & 0.34991e+00_r8,0.35252e+00_r8,0.39600e+00_r8,0.45213e+00_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.56560e+00_r8,0.49547e+00_r8,0.44792e+00_r8,0.43980e+00_r8,0.41568e+00_r8, & + & 0.39571e+00_r8,0.39516e+00_r8,0.42687e+00_r8,0.48767e+00_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.55986e+00_r8,0.49068e+00_r8,0.44130e+00_r8,0.43344e+00_r8,0.40921e+00_r8, & + & 0.39033e+00_r8,0.39006e+00_r8,0.42429e+00_r8,0.48458e+00_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.55439e+00_r8,0.48622e+00_r8,0.43604e+00_r8,0.42727e+00_r8,0.40340e+00_r8, & + & 0.38637e+00_r8,0.38517e+00_r8,0.42255e+00_r8,0.48243e+00_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.55085e+00_r8,0.48344e+00_r8,0.43251e+00_r8,0.42285e+00_r8,0.39791e+00_r8, & + & 0.38219e+00_r8,0.38096e+00_r8,0.42076e+00_r8,0.48039e+00_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.54722e+00_r8,0.48060e+00_r8,0.42969e+00_r8,0.41964e+00_r8,0.39283e+00_r8, & + & 0.37840e+00_r8,0.37699e+00_r8,0.41955e+00_r8,0.47894e+00_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.58672e+00_r8,0.51388e+00_r8,0.47909e+00_r8,0.46769e+00_r8,0.44479e+00_r8, & + & 0.42421e+00_r8,0.41694e+00_r8,0.44339e+00_r8,0.50662e+00_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.58159e+00_r8,0.50951e+00_r8,0.47213e+00_r8,0.46028e+00_r8,0.43736e+00_r8, & + & 0.41895e+00_r8,0.41246e+00_r8,0.44257e+00_r8,0.50550e+00_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.57736e+00_r8,0.50610e+00_r8,0.46657e+00_r8,0.45431e+00_r8,0.43100e+00_r8, & + & 0.41543e+00_r8,0.40868e+00_r8,0.44206e+00_r8,0.50480e+00_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.57459e+00_r8,0.50394e+00_r8,0.46330e+00_r8,0.44994e+00_r8,0.42562e+00_r8, & + & 0.41143e+00_r8,0.40432e+00_r8,0.44089e+00_r8,0.50333e+00_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.57136e+00_r8,0.50148e+00_r8,0.46136e+00_r8,0.44665e+00_r8,0.42115e+00_r8, & + & 0.40792e+00_r8,0.40001e+00_r8,0.43966e+00_r8,0.50186e+00_r8 /) + kao(:, 1,10,13) = (/ & + & 0.60279e+00_r8,0.52914e+00_r8,0.50725e+00_r8,0.49385e+00_r8,0.47296e+00_r8, & + & 0.45056e+00_r8,0.43650e+00_r8,0.45649e+00_r8,0.52069e+00_r8 /) + kao(:, 2,10,13) = (/ & + & 0.59826e+00_r8,0.52452e+00_r8,0.50048e+00_r8,0.48635e+00_r8,0.46511e+00_r8, & + & 0.44618e+00_r8,0.43278e+00_r8,0.45737e+00_r8,0.52170e+00_r8 /) + kao(:, 3,10,13) = (/ & + & 0.59590e+00_r8,0.52228e+00_r8,0.49610e+00_r8,0.47997e+00_r8,0.45903e+00_r8, & + & 0.44309e+00_r8,0.42962e+00_r8,0.45759e+00_r8,0.52208e+00_r8 /) + kao(:, 4,10,13) = (/ & + & 0.59454e+00_r8,0.52120e+00_r8,0.49388e+00_r8,0.47548e+00_r8,0.45447e+00_r8, & + & 0.44006e+00_r8,0.42512e+00_r8,0.45631e+00_r8,0.52061e+00_r8 /) + kao(:, 5,10,13) = (/ & + & 0.59357e+00_r8,0.52070e+00_r8,0.49246e+00_r8,0.47250e+00_r8,0.45028e+00_r8, & + & 0.43610e+00_r8,0.42114e+00_r8,0.45529e+00_r8,0.51951e+00_r8 /) + kao(:, 1,11,13) = (/ & + & 0.60887e+00_r8,0.53839e+00_r8,0.52807e+00_r8,0.51587e+00_r8,0.49623e+00_r8, & + & 0.47362e+00_r8,0.45440e+00_r8,0.46645e+00_r8,0.53001e+00_r8 /) + kao(:, 2,11,13) = (/ & + & 0.60756e+00_r8,0.53578e+00_r8,0.52411e+00_r8,0.50806e+00_r8,0.48992e+00_r8, & + & 0.47089e+00_r8,0.45204e+00_r8,0.46808e+00_r8,0.53215e+00_r8 /) + kao(:, 3,11,13) = (/ & + & 0.60793e+00_r8,0.53524e+00_r8,0.52214e+00_r8,0.50280e+00_r8,0.48540e+00_r8, & + & 0.46881e+00_r8,0.44770e+00_r8,0.46764e+00_r8,0.53195e+00_r8 /) + kao(:, 4,11,13) = (/ & + & 0.60970e+00_r8,0.53618e+00_r8,0.52106e+00_r8,0.49960e+00_r8,0.48160e+00_r8, & + & 0.46481e+00_r8,0.44371e+00_r8,0.46667e+00_r8,0.53096e+00_r8 /) + kao(:, 5,11,13) = (/ & + & 0.61038e+00_r8,0.53650e+00_r8,0.52014e+00_r8,0.49804e+00_r8,0.47818e+00_r8, & + & 0.45984e+00_r8,0.44017e+00_r8,0.46579e+00_r8,0.53008e+00_r8 /) + kao(:, 1,12,13) = (/ & + & 0.60957e+00_r8,0.54609e+00_r8,0.54565e+00_r8,0.53521e+00_r8,0.51779e+00_r8, & + & 0.49593e+00_r8,0.47189e+00_r8,0.47309e+00_r8,0.46983e+00_r8 /) + kao(:, 2,12,13) = (/ & + & 0.61214e+00_r8,0.54625e+00_r8,0.54367e+00_r8,0.52921e+00_r8,0.51339e+00_r8, & + & 0.49443e+00_r8,0.46946e+00_r8,0.47371e+00_r8,0.47545e+00_r8 /) + kao(:, 3,12,13) = (/ & + & 0.61642e+00_r8,0.54787e+00_r8,0.54269e+00_r8,0.52579e+00_r8,0.50981e+00_r8, & + & 0.49118e+00_r8,0.46605e+00_r8,0.47265e+00_r8,0.47706e+00_r8 /) + kao(:, 4,12,13) = (/ & + & 0.62028e+00_r8,0.54980e+00_r8,0.54303e+00_r8,0.52440e+00_r8,0.50697e+00_r8, & + & 0.48619e+00_r8,0.46182e+00_r8,0.47123e+00_r8,0.48084e+00_r8 /) + kao(:, 5,12,13) = (/ & + & 0.62175e+00_r8,0.55026e+00_r8,0.54305e+00_r8,0.52373e+00_r8,0.50407e+00_r8, & + & 0.48153e+00_r8,0.45738e+00_r8,0.46998e+00_r8,0.48415e+00_r8 /) + kao(:, 1,13,13) = (/ & + & 0.60459e+00_r8,0.55304e+00_r8,0.55845e+00_r8,0.55195e+00_r8,0.53769e+00_r8, & + & 0.51606e+00_r8,0.48661e+00_r8,0.47383e+00_r8,0.40484e+00_r8 /) + kao(:, 2,13,13) = (/ & + & 0.61134e+00_r8,0.55569e+00_r8,0.55809e+00_r8,0.54885e+00_r8,0.53426e+00_r8, & + & 0.51450e+00_r8,0.48473e+00_r8,0.47289e+00_r8,0.40823e+00_r8 /) + kao(:, 3,13,13) = (/ & + & 0.61890e+00_r8,0.55963e+00_r8,0.55924e+00_r8,0.54802e+00_r8,0.53230e+00_r8, & + & 0.51039e+00_r8,0.48075e+00_r8,0.47078e+00_r8,0.41355e+00_r8 /) + kao(:, 4,13,13) = (/ & + & 0.62388e+00_r8,0.56213e+00_r8,0.56099e+00_r8,0.54740e+00_r8,0.52999e+00_r8, & + & 0.50582e+00_r8,0.47603e+00_r8,0.46901e+00_r8,0.41977e+00_r8 /) + kao(:, 5,13,13) = (/ & + & 0.62688e+00_r8,0.56314e+00_r8,0.56152e+00_r8,0.54685e+00_r8,0.52723e+00_r8, & + & 0.50138e+00_r8,0.47115e+00_r8,0.46700e+00_r8,0.42405e+00_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.52445e+00_r8,0.46003e+00_r8,0.39566e+00_r8,0.33139e+00_r8,0.26995e+00_r8, & + & 0.25837e+00_r8,0.28528e+00_r8,0.32819e+00_r8,0.35568e+00_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.51513e+00_r8,0.45183e+00_r8,0.38858e+00_r8,0.32553e+00_r8,0.26784e+00_r8, & + & 0.25515e+00_r8,0.28229e+00_r8,0.32456e+00_r8,0.35149e+00_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.50548e+00_r8,0.44334e+00_r8,0.38125e+00_r8,0.32054e+00_r8,0.26590e+00_r8, & + & 0.25305e+00_r8,0.28136e+00_r8,0.32218e+00_r8,0.34858e+00_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.49563e+00_r8,0.43466e+00_r8,0.37374e+00_r8,0.31559e+00_r8,0.26350e+00_r8, & + & 0.25115e+00_r8,0.28088e+00_r8,0.32077e+00_r8,0.34651e+00_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.48636e+00_r8,0.42650e+00_r8,0.36724e+00_r8,0.31119e+00_r8,0.26146e+00_r8, & + & 0.24908e+00_r8,0.27907e+00_r8,0.31920e+00_r8,0.34392e+00_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.56575e+00_r8,0.49609e+00_r8,0.42647e+00_r8,0.35691e+00_r8,0.29788e+00_r8, & + & 0.29937e+00_r8,0.33584e+00_r8,0.38701e+00_r8,0.42822e+00_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.55481e+00_r8,0.48648e+00_r8,0.41819e+00_r8,0.35023e+00_r8,0.29393e+00_r8, & + & 0.29578e+00_r8,0.33190e+00_r8,0.38233e+00_r8,0.42282e+00_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.54468e+00_r8,0.47756e+00_r8,0.41048e+00_r8,0.34498e+00_r8,0.29076e+00_r8, & + & 0.29330e+00_r8,0.33000e+00_r8,0.37899e+00_r8,0.41892e+00_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.53444e+00_r8,0.46857e+00_r8,0.40281e+00_r8,0.34010e+00_r8,0.28772e+00_r8, & + & 0.29117e+00_r8,0.32899e+00_r8,0.37674e+00_r8,0.41581e+00_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.52472e+00_r8,0.46000e+00_r8,0.39601e+00_r8,0.33543e+00_r8,0.28544e+00_r8, & + & 0.28841e+00_r8,0.32728e+00_r8,0.37488e+00_r8,0.41300e+00_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.61401e+00_r8,0.53826e+00_r8,0.46254e+00_r8,0.38687e+00_r8,0.33653e+00_r8, & + & 0.34874e+00_r8,0.39278e+00_r8,0.45331e+00_r8,0.51178e+00_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.60181e+00_r8,0.52754e+00_r8,0.45329e+00_r8,0.37917e+00_r8,0.33018e+00_r8, & + & 0.34432e+00_r8,0.38762e+00_r8,0.44735e+00_r8,0.50487e+00_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.59018e+00_r8,0.51732e+00_r8,0.44448e+00_r8,0.37278e+00_r8,0.32516e+00_r8, & + & 0.34086e+00_r8,0.38493e+00_r8,0.44336e+00_r8,0.50014e+00_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.57893e+00_r8,0.50743e+00_r8,0.43595e+00_r8,0.36714e+00_r8,0.32113e+00_r8, & + & 0.33824e+00_r8,0.38315e+00_r8,0.44016e+00_r8,0.49598e+00_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.56842e+00_r8,0.49818e+00_r8,0.42822e+00_r8,0.36203e+00_r8,0.31748e+00_r8, & + & 0.33494e+00_r8,0.38145e+00_r8,0.43774e+00_r8,0.49238e+00_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.66683e+00_r8,0.58444e+00_r8,0.50208e+00_r8,0.41977e+00_r8,0.38494e+00_r8, & + & 0.40485e+00_r8,0.45417e+00_r8,0.52508e+00_r8,0.59839e+00_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.65354e+00_r8,0.57275e+00_r8,0.49199e+00_r8,0.41128e+00_r8,0.37591e+00_r8, & + & 0.39916e+00_r8,0.44835e+00_r8,0.51820e+00_r8,0.59043e+00_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.64071e+00_r8,0.56148e+00_r8,0.48227e+00_r8,0.40388e+00_r8,0.36879e+00_r8, & + & 0.39404e+00_r8,0.44465e+00_r8,0.51320e+00_r8,0.58464e+00_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.62844e+00_r8,0.55070e+00_r8,0.47297e+00_r8,0.39753e+00_r8,0.36329e+00_r8, & + & 0.39017e+00_r8,0.44183e+00_r8,0.50881e+00_r8,0.57888e+00_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.61748e+00_r8,0.54106e+00_r8,0.46467e+00_r8,0.39213e+00_r8,0.35832e+00_r8, & + & 0.38631e+00_r8,0.43926e+00_r8,0.50522e+00_r8,0.57403e+00_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.72260e+00_r8,0.63317e+00_r8,0.54375e+00_r8,0.45913e+00_r8,0.43732e+00_r8, & + & 0.46505e+00_r8,0.51783e+00_r8,0.59954e+00_r8,0.68564e+00_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.70858e+00_r8,0.62085e+00_r8,0.53314e+00_r8,0.44897e+00_r8,0.42823e+00_r8, & + & 0.45720e+00_r8,0.51115e+00_r8,0.59162e+00_r8,0.67653e+00_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.69539e+00_r8,0.60926e+00_r8,0.52314e+00_r8,0.43994e+00_r8,0.42099e+00_r8, & + & 0.45017e+00_r8,0.50656e+00_r8,0.58542e+00_r8,0.66941e+00_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.68235e+00_r8,0.59780e+00_r8,0.51326e+00_r8,0.43281e+00_r8,0.41557e+00_r8, & + & 0.44468e+00_r8,0.50258e+00_r8,0.57996e+00_r8,0.66206e+00_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.67018e+00_r8,0.58711e+00_r8,0.50404e+00_r8,0.42628e+00_r8,0.41131e+00_r8, & + & 0.43975e+00_r8,0.49863e+00_r8,0.57477e+00_r8,0.65556e+00_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.77964e+00_r8,0.68298e+00_r8,0.58633e+00_r8,0.50766e+00_r8,0.49641e+00_r8, & + & 0.52605e+00_r8,0.58161e+00_r8,0.67425e+00_r8,0.77212e+00_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.76589e+00_r8,0.67092e+00_r8,0.57596e+00_r8,0.49531e+00_r8,0.48834e+00_r8, & + & 0.51573e+00_r8,0.57361e+00_r8,0.66493e+00_r8,0.76124e+00_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.75251e+00_r8,0.65917e+00_r8,0.56583e+00_r8,0.48459e+00_r8,0.48115e+00_r8, & + & 0.50704e+00_r8,0.56757e+00_r8,0.65686e+00_r8,0.75182e+00_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.73905e+00_r8,0.64728e+00_r8,0.55554e+00_r8,0.47565e+00_r8,0.47497e+00_r8, & + & 0.50004e+00_r8,0.56191e+00_r8,0.64957e+00_r8,0.74243e+00_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.72636e+00_r8,0.63608e+00_r8,0.54581e+00_r8,0.46758e+00_r8,0.47009e+00_r8, & + & 0.49349e+00_r8,0.55635e+00_r8,0.64252e+00_r8,0.73397e+00_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.84113e+00_r8,0.73668e+00_r8,0.63225e+00_r8,0.56459e+00_r8,0.56168e+00_r8, & + & 0.58736e+00_r8,0.64476e+00_r8,0.74759e+00_r8,0.85655e+00_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.82630e+00_r8,0.72365e+00_r8,0.62103e+00_r8,0.55091e+00_r8,0.55367e+00_r8, & + & 0.57467e+00_r8,0.63457e+00_r8,0.73605e+00_r8,0.84323e+00_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.81279e+00_r8,0.71173e+00_r8,0.61068e+00_r8,0.53944e+00_r8,0.54564e+00_r8, & + & 0.56363e+00_r8,0.62610e+00_r8,0.72557e+00_r8,0.83073e+00_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.79922e+00_r8,0.69978e+00_r8,0.60035e+00_r8,0.52974e+00_r8,0.53833e+00_r8, & + & 0.55444e+00_r8,0.61857e+00_r8,0.71625e+00_r8,0.81942e+00_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.78598e+00_r8,0.68814e+00_r8,0.59031e+00_r8,0.52130e+00_r8,0.53249e+00_r8, & + & 0.54592e+00_r8,0.61225e+00_r8,0.70842e+00_r8,0.80994e+00_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.90865e+00_r8,0.79552e+00_r8,0.68301e+00_r8,0.62894e+00_r8,0.62980e+00_r8, & + & 0.64956e+00_r8,0.70917e+00_r8,0.82179e+00_r8,0.94167e+00_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.89327e+00_r8,0.78202e+00_r8,0.67089e+00_r8,0.61713e+00_r8,0.62095e+00_r8, & + & 0.63402e+00_r8,0.69617e+00_r8,0.80717e+00_r8,0.92484e+00_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.87903e+00_r8,0.76952e+00_r8,0.66001e+00_r8,0.60628e+00_r8,0.61235e+00_r8, & + & 0.62019e+00_r8,0.68531e+00_r8,0.79440e+00_r8,0.90974e+00_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.86460e+00_r8,0.75687e+00_r8,0.64914e+00_r8,0.59649e+00_r8,0.60349e+00_r8, & + & 0.60828e+00_r8,0.67580e+00_r8,0.78318e+00_r8,0.89639e+00_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.85091e+00_r8,0.74488e+00_r8,0.63886e+00_r8,0.58665e+00_r8,0.59566e+00_r8, & + & 0.59754e+00_r8,0.66827e+00_r8,0.77422e+00_r8,0.88585e+00_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.98149e+00_r8,0.85912e+00_r8,0.74373e+00_r8,0.70295e+00_r8,0.70214e+00_r8, & + & 0.71285e+00_r8,0.77237e+00_r8,0.89352e+00_r8,0.10239e+01_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.96640e+00_r8,0.84589e+00_r8,0.73081e+00_r8,0.69152e+00_r8,0.69170e+00_r8, & + & 0.69439e+00_r8,0.75605e+00_r8,0.87558e+00_r8,0.10032e+01_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.95188e+00_r8,0.83316e+00_r8,0.71892e+00_r8,0.68080e+00_r8,0.68028e+00_r8, & + & 0.67751e+00_r8,0.74271e+00_r8,0.86004e+00_r8,0.98493e+00_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.93737e+00_r8,0.82045e+00_r8,0.70700e+00_r8,0.67076e+00_r8,0.66785e+00_r8, & + & 0.66265e+00_r8,0.73184e+00_r8,0.84775e+00_r8,0.97055e+00_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.92346e+00_r8,0.80828e+00_r8,0.69536e+00_r8,0.66047e+00_r8,0.65652e+00_r8, & + & 0.65000e+00_r8,0.72388e+00_r8,0.83863e+00_r8,0.95986e+00_r8 /) + kao(:, 1,10,14) = (/ & + & 0.10577e+01_r8,0.92576e+00_r8,0.81364e+00_r8,0.78190e+00_r8,0.77617e+00_r8, & + & 0.77603e+00_r8,0.83269e+00_r8,0.96109e+00_r8,0.11008e+01_r8 /) + kao(:, 2,10,14) = (/ & + & 0.10450e+01_r8,0.91463e+00_r8,0.80097e+00_r8,0.77046e+00_r8,0.76182e+00_r8, & + & 0.75411e+00_r8,0.81384e+00_r8,0.94032e+00_r8,0.10769e+01_r8 /) + kao(:, 3,10,14) = (/ & + & 0.10312e+01_r8,0.90248e+00_r8,0.78812e+00_r8,0.75969e+00_r8,0.74632e+00_r8, & + & 0.73436e+00_r8,0.79822e+00_r8,0.92300e+00_r8,0.10571e+01_r8 /) + kao(:, 4,10,14) = (/ & + & 0.10164e+01_r8,0.88956e+00_r8,0.77444e+00_r8,0.74952e+00_r8,0.73099e+00_r8, & + & 0.71729e+00_r8,0.78702e+00_r8,0.91062e+00_r8,0.10426e+01_r8 /) + kao(:, 5,10,14) = (/ & + & 0.10010e+01_r8,0.87610e+00_r8,0.76045e+00_r8,0.73747e+00_r8,0.71669e+00_r8, & + & 0.70419e+00_r8,0.77819e+00_r8,0.90060e+00_r8,0.10309e+01_r8 /) + kao(:, 1,11,14) = (/ & + & 0.11332e+01_r8,0.99169e+00_r8,0.88520e+00_r8,0.85938e+00_r8,0.84171e+00_r8, & + & 0.82777e+00_r8,0.88045e+00_r8,0.10119e+01_r8,0.11581e+01_r8 /) + kao(:, 2,11,14) = (/ & + & 0.11221e+01_r8,0.98196e+00_r8,0.87210e+00_r8,0.84745e+00_r8,0.82287e+00_r8, & + & 0.80383e+00_r8,0.86097e+00_r8,0.99198e+00_r8,0.11355e+01_r8 /) + kao(:, 3,11,14) = (/ & + & 0.11079e+01_r8,0.96953e+00_r8,0.85745e+00_r8,0.83492e+00_r8,0.80465e+00_r8, & + & 0.78293e+00_r8,0.84710e+00_r8,0.97731e+00_r8,0.11185e+01_r8 /) + kao(:, 4,11,14) = (/ & + & 0.10888e+01_r8,0.95287e+00_r8,0.84018e+00_r8,0.82112e+00_r8,0.78666e+00_r8, & + & 0.76752e+00_r8,0.83583e+00_r8,0.96514e+00_r8,0.11044e+01_r8 /) + kao(:, 5,11,14) = (/ & + & 0.10701e+01_r8,0.93668e+00_r8,0.82311e+00_r8,0.80490e+00_r8,0.77024e+00_r8, & + & 0.75616e+00_r8,0.82679e+00_r8,0.95569e+00_r8,0.10935e+01_r8 /) + kao(:, 1,12,14) = (/ & + & 0.12101e+01_r8,0.10589e+01_r8,0.96254e+00_r8,0.93478e+00_r8,0.90424e+00_r8, & + & 0.88111e+00_r8,0.92612e+00_r8,0.10566e+01_r8,0.12084e+01_r8 /) + kao(:, 2,12,14) = (/ & + & 0.11952e+01_r8,0.10459e+01_r8,0.94639e+00_r8,0.91979e+00_r8,0.88299e+00_r8, & + & 0.85667e+00_r8,0.90737e+00_r8,0.10393e+01_r8,0.11885e+01_r8 /) + kao(:, 3,12,14) = (/ & + & 0.11758e+01_r8,0.10290e+01_r8,0.92827e+00_r8,0.90412e+00_r8,0.86234e+00_r8, & + & 0.83719e+00_r8,0.89320e+00_r8,0.10260e+01_r8,0.11732e+01_r8 /) + kao(:, 4,12,14) = (/ & + & 0.11552e+01_r8,0.10111e+01_r8,0.90821e+00_r8,0.88659e+00_r8,0.84346e+00_r8, & + & 0.82327e+00_r8,0.88324e+00_r8,0.10165e+01_r8,0.11624e+01_r8 /) + kao(:, 5,12,14) = (/ & + & 0.11370e+01_r8,0.99527e+00_r8,0.88941e+00_r8,0.86803e+00_r8,0.82686e+00_r8, & + & 0.81098e+00_r8,0.87502e+00_r8,0.10085e+01_r8,0.11531e+01_r8 /) + kao(:, 1,13,14) = (/ & + & 0.12761e+01_r8,0.11169e+01_r8,0.10366e+01_r8,0.10056e+01_r8,0.96619e+00_r8, & + & 0.93741e+00_r8,0.96971e+00_r8,0.10971e+01_r8,0.12455e+01_r8 /) + kao(:, 2,13,14) = (/ & + & 0.12590e+01_r8,0.11018e+01_r8,0.10193e+01_r8,0.98827e+00_r8,0.94401e+00_r8, & + & 0.91331e+00_r8,0.95200e+00_r8,0.10824e+01_r8,0.12321e+01_r8 /) + kao(:, 3,13,14) = (/ & + & 0.12382e+01_r8,0.10836e+01_r8,0.99864e+00_r8,0.96922e+00_r8,0.92237e+00_r8, & + & 0.89570e+00_r8,0.94013e+00_r8,0.10732e+01_r8,0.12212e+01_r8 /) + kao(:, 4,13,14) = (/ & + & 0.12192e+01_r8,0.10671e+01_r8,0.97718e+00_r8,0.94975e+00_r8,0.90316e+00_r8, & + & 0.88110e+00_r8,0.93100e+00_r8,0.10658e+01_r8,0.12124e+01_r8 /) + kao(:, 5,13,14) = (/ & + & 0.12013e+01_r8,0.10515e+01_r8,0.95818e+00_r8,0.93022e+00_r8,0.88690e+00_r8, & + & 0.86844e+00_r8,0.92401e+00_r8,0.10605e+01_r8,0.12064e+01_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.70834e+00_r8,0.62203e+00_r8,0.53582e+00_r8,0.44981e+00_r8,0.36430e+00_r8, & + & 0.30456e+00_r8,0.33772e+00_r8,0.39113e+00_r8,0.42417e+00_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.69132e+00_r8,0.60682e+00_r8,0.52239e+00_r8,0.43815e+00_r8,0.35442e+00_r8, & + & 0.29618e+00_r8,0.32847e+00_r8,0.37897e+00_r8,0.41053e+00_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.67551e+00_r8,0.59273e+00_r8,0.51002e+00_r8,0.42746e+00_r8,0.34540e+00_r8, & + & 0.29170e+00_r8,0.32190e+00_r8,0.37054e+00_r8,0.40056e+00_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.65954e+00_r8,0.57855e+00_r8,0.49762e+00_r8,0.41681e+00_r8,0.33774e+00_r8, & + & 0.29058e+00_r8,0.31932e+00_r8,0.36553e+00_r8,0.39416e+00_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.64426e+00_r8,0.56502e+00_r8,0.48582e+00_r8,0.40671e+00_r8,0.33237e+00_r8, & + & 0.29156e+00_r8,0.32280e+00_r8,0.36526e+00_r8,0.39257e+00_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.79278e+00_r8,0.69566e+00_r8,0.59863e+00_r8,0.50180e+00_r8,0.40547e+00_r8, & + & 0.36074e+00_r8,0.40858e+00_r8,0.47363e+00_r8,0.52463e+00_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.77384e+00_r8,0.67879e+00_r8,0.58381e+00_r8,0.48896e+00_r8,0.39453e+00_r8, & + & 0.34912e+00_r8,0.39677e+00_r8,0.45884e+00_r8,0.50797e+00_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.75601e+00_r8,0.66296e+00_r8,0.56995e+00_r8,0.47701e+00_r8,0.38437e+00_r8, & + & 0.34005e+00_r8,0.38826e+00_r8,0.44800e+00_r8,0.49524e+00_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.73809e+00_r8,0.64708e+00_r8,0.55610e+00_r8,0.46517e+00_r8,0.37616e+00_r8, & + & 0.33560e+00_r8,0.38277e+00_r8,0.44095e+00_r8,0.48660e+00_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.72001e+00_r8,0.63111e+00_r8,0.54222e+00_r8,0.45336e+00_r8,0.36992e+00_r8, & + & 0.33536e+00_r8,0.38227e+00_r8,0.43734e+00_r8,0.48144e+00_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.88640e+00_r8,0.77731e+00_r8,0.66826e+00_r8,0.55931e+00_r8,0.45077e+00_r8, & + & 0.42993e+00_r8,0.49594e+00_r8,0.57510e+00_r8,0.65079e+00_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.86545e+00_r8,0.75870e+00_r8,0.65198e+00_r8,0.54530e+00_r8,0.43919e+00_r8, & + & 0.41467e+00_r8,0.48152e+00_r8,0.55764e+00_r8,0.63093e+00_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.84484e+00_r8,0.74046e+00_r8,0.63609e+00_r8,0.53174e+00_r8,0.42841e+00_r8, & + & 0.40263e+00_r8,0.47018e+00_r8,0.54358e+00_r8,0.61450e+00_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.82484e+00_r8,0.72279e+00_r8,0.62074e+00_r8,0.51870e+00_r8,0.41933e+00_r8, & + & 0.39440e+00_r8,0.46214e+00_r8,0.53355e+00_r8,0.60235e+00_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.80403e+00_r8,0.70444e+00_r8,0.60484e+00_r8,0.50526e+00_r8,0.41249e+00_r8, & + & 0.39177e+00_r8,0.45674e+00_r8,0.52614e+00_r8,0.59324e+00_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.98775e+00_r8,0.86568e+00_r8,0.74362e+00_r8,0.62157e+00_r8,0.50893e+00_r8, & + & 0.51227e+00_r8,0.60104e+00_r8,0.69710e+00_r8,0.79722e+00_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.96448e+00_r8,0.84510e+00_r8,0.72572e+00_r8,0.60634e+00_r8,0.49496e+00_r8, & + & 0.49365e+00_r8,0.58337e+00_r8,0.67615e+00_r8,0.77326e+00_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.94121e+00_r8,0.82456e+00_r8,0.70790e+00_r8,0.59124e+00_r8,0.48214e+00_r8, & + & 0.47977e+00_r8,0.56920e+00_r8,0.65880e+00_r8,0.75281e+00_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.91776e+00_r8,0.80389e+00_r8,0.69002e+00_r8,0.57613e+00_r8,0.47050e+00_r8, & + & 0.47009e+00_r8,0.55863e+00_r8,0.64595e+00_r8,0.73761e+00_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.89560e+00_r8,0.78437e+00_r8,0.67314e+00_r8,0.56190e+00_r8,0.46260e+00_r8, & + & 0.46419e+00_r8,0.55009e+00_r8,0.63560e+00_r8,0.72526e+00_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.10958e+01_r8,0.95999e+00_r8,0.82419e+00_r8,0.68839e+00_r8,0.58904e+00_r8, & + & 0.60909e+00_r8,0.72523e+00_r8,0.84139e+00_r8,0.96623e+00_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.10697e+01_r8,0.93701e+00_r8,0.80427e+00_r8,0.67151e+00_r8,0.56892e+00_r8, & + & 0.58963e+00_r8,0.70431e+00_r8,0.81667e+00_r8,0.93800e+00_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.10434e+01_r8,0.91377e+00_r8,0.78415e+00_r8,0.65453e+00_r8,0.55082e+00_r8, & + & 0.57510e+00_r8,0.68668e+00_r8,0.79542e+00_r8,0.91311e+00_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.10167e+01_r8,0.89033e+00_r8,0.76393e+00_r8,0.63753e+00_r8,0.53477e+00_r8, & + & 0.56392e+00_r8,0.67291e+00_r8,0.77892e+00_r8,0.89383e+00_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.99271e+00_r8,0.86922e+00_r8,0.74573e+00_r8,0.62224e+00_r8,0.52129e+00_r8, & + & 0.55503e+00_r8,0.66157e+00_r8,0.76538e+00_r8,0.87797e+00_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.12165e+01_r8,0.10653e+01_r8,0.91421e+00_r8,0.76309e+00_r8,0.68684e+00_r8, & + & 0.72751e+00_r8,0.87072e+00_r8,0.10104e+01_r8,0.11626e+01_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.11851e+01_r8,0.10377e+01_r8,0.89038e+00_r8,0.74302e+00_r8,0.66078e+00_r8, & + & 0.70740e+00_r8,0.84652e+00_r8,0.98180e+00_r8,0.11298e+01_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.11540e+01_r8,0.10104e+01_r8,0.86680e+00_r8,0.72322e+00_r8,0.63673e+00_r8, & + & 0.69046e+00_r8,0.82558e+00_r8,0.95705e+00_r8,0.11007e+01_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.11233e+01_r8,0.98347e+00_r8,0.84364e+00_r8,0.70381e+00_r8,0.61623e+00_r8, & + & 0.67656e+00_r8,0.80855e+00_r8,0.93682e+00_r8,0.10775e+01_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.10954e+01_r8,0.95895e+00_r8,0.82254e+00_r8,0.68614e+00_r8,0.59850e+00_r8, & + & 0.66513e+00_r8,0.79440e+00_r8,0.92006e+00_r8,0.10579e+01_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.13516e+01_r8,0.11834e+01_r8,0.10152e+01_r8,0.84752e+00_r8,0.80189e+00_r8, & + & 0.86751e+00_r8,0.10388e+01_r8,0.12059e+01_r8,0.13885e+01_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.13129e+01_r8,0.11495e+01_r8,0.98601e+00_r8,0.82254e+00_r8,0.76801e+00_r8, & + & 0.84476e+00_r8,0.10112e+01_r8,0.11733e+01_r8,0.13510e+01_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.12754e+01_r8,0.11166e+01_r8,0.95771e+00_r8,0.79885e+00_r8,0.73832e+00_r8, & + & 0.82499e+00_r8,0.98705e+00_r8,0.11448e+01_r8,0.13179e+01_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.12391e+01_r8,0.10847e+01_r8,0.93032e+00_r8,0.77593e+00_r8,0.71267e+00_r8, & + & 0.80837e+00_r8,0.96685e+00_r8,0.11210e+01_r8,0.12906e+01_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.12065e+01_r8,0.10561e+01_r8,0.90576e+00_r8,0.75539e+00_r8,0.69035e+00_r8, & + & 0.79409e+00_r8,0.94938e+00_r8,0.11005e+01_r8,0.12668e+01_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.14988e+01_r8,0.13122e+01_r8,0.11257e+01_r8,0.95045e+00_r8,0.92736e+00_r8, & + & 0.10268e+01_r8,0.12293e+01_r8,0.14274e+01_r8,0.16436e+01_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.14532e+01_r8,0.12722e+01_r8,0.10913e+01_r8,0.91652e+00_r8,0.88763e+00_r8, & + & 0.10018e+01_r8,0.11994e+01_r8,0.13921e+01_r8,0.16030e+01_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.14089e+01_r8,0.12334e+01_r8,0.10579e+01_r8,0.88636e+00_r8,0.85277e+00_r8, & + & 0.97910e+00_r8,0.11719e+01_r8,0.13598e+01_r8,0.15656e+01_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.13671e+01_r8,0.11967e+01_r8,0.10263e+01_r8,0.85849e+00_r8,0.82373e+00_r8, & + & 0.95955e+00_r8,0.11482e+01_r8,0.13320e+01_r8,0.15338e+01_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.13292e+01_r8,0.11635e+01_r8,0.99774e+00_r8,0.83411e+00_r8,0.79958e+00_r8, & + & 0.94221e+00_r8,0.11271e+01_r8,0.13073e+01_r8,0.15052e+01_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.16562e+01_r8,0.14500e+01_r8,0.12437e+01_r8,0.10742e+01_r8,0.10651e+01_r8, & + & 0.12070e+01_r8,0.14445e+01_r8,0.16775e+01_r8,0.19311e+01_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.16034e+01_r8,0.14036e+01_r8,0.12039e+01_r8,0.10312e+01_r8,0.10206e+01_r8, & + & 0.11791e+01_r8,0.14116e+01_r8,0.16391e+01_r8,0.18869e+01_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.15525e+01_r8,0.13590e+01_r8,0.11655e+01_r8,0.99233e+00_r8,0.98476e+00_r8, & + & 0.11530e+01_r8,0.13804e+01_r8,0.16026e+01_r8,0.18449e+01_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.15047e+01_r8,0.13171e+01_r8,0.11295e+01_r8,0.95737e+00_r8,0.95592e+00_r8, & + & 0.11301e+01_r8,0.13529e+01_r8,0.15703e+01_r8,0.18077e+01_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.14611e+01_r8,0.12789e+01_r8,0.10967e+01_r8,0.92635e+00_r8,0.93256e+00_r8, & + & 0.11088e+01_r8,0.13272e+01_r8,0.15403e+01_r8,0.17730e+01_r8 /) + kao(:, 1,10,15) = (/ & + & 0.18225e+01_r8,0.15953e+01_r8,0.13682e+01_r8,0.12131e+01_r8,0.12195e+01_r8, & + & 0.14041e+01_r8,0.16789e+01_r8,0.19504e+01_r8,0.22442e+01_r8 /) + kao(:, 2,10,15) = (/ & + & 0.17586e+01_r8,0.15393e+01_r8,0.13201e+01_r8,0.11608e+01_r8,0.11760e+01_r8, & + & 0.13729e+01_r8,0.16424e+01_r8,0.19078e+01_r8,0.21951e+01_r8 /) + kao(:, 3,10,15) = (/ & + & 0.16992e+01_r8,0.14873e+01_r8,0.12754e+01_r8,0.11134e+01_r8,0.11408e+01_r8, & + & 0.13430e+01_r8,0.16073e+01_r8,0.18666e+01_r8,0.21480e+01_r8 /) + kao(:, 4,10,15) = (/ & + & 0.16453e+01_r8,0.14401e+01_r8,0.12349e+01_r8,0.10705e+01_r8,0.11101e+01_r8, & + & 0.13157e+01_r8,0.15751e+01_r8,0.18293e+01_r8,0.21045e+01_r8 /) + kao(:, 5,10,15) = (/ & + & 0.15976e+01_r8,0.13983e+01_r8,0.11990e+01_r8,0.10350e+01_r8,0.10845e+01_r8, & + & 0.12900e+01_r8,0.15444e+01_r8,0.17936e+01_r8,0.20634e+01_r8 /) + kao(:, 1,11,15) = (/ & + & 0.19716e+01_r8,0.17256e+01_r8,0.14797e+01_r8,0.13408e+01_r8,0.13798e+01_r8, & + & 0.16011e+01_r8,0.19108e+01_r8,0.22209e+01_r8,0.25534e+01_r8 /) + kao(:, 2,11,15) = (/ & + & 0.18980e+01_r8,0.16613e+01_r8,0.14245e+01_r8,0.12841e+01_r8,0.13393e+01_r8, & + & 0.15661e+01_r8,0.18703e+01_r8,0.21736e+01_r8,0.24991e+01_r8 /) + kao(:, 3,11,15) = (/ & + & 0.18334e+01_r8,0.16046e+01_r8,0.13758e+01_r8,0.12346e+01_r8,0.13019e+01_r8, & + & 0.15332e+01_r8,0.18320e+01_r8,0.21288e+01_r8,0.24477e+01_r8 /) + kao(:, 4,11,15) = (/ & + & 0.17833e+01_r8,0.15608e+01_r8,0.13382e+01_r8,0.11928e+01_r8,0.12697e+01_r8, & + & 0.15019e+01_r8,0.17959e+01_r8,0.20867e+01_r8,0.23990e+01_r8 /) + kao(:, 5,11,15) = (/ & + & 0.17385e+01_r8,0.15215e+01_r8,0.13045e+01_r8,0.11584e+01_r8,0.12412e+01_r8, & + & 0.14723e+01_r8,0.17610e+01_r8,0.20462e+01_r8,0.23526e+01_r8 /) + kao(:, 1,12,15) = (/ & + & 0.21322e+01_r8,0.18661e+01_r8,0.16009e+01_r8,0.14913e+01_r8,0.15626e+01_r8, & + & 0.18065e+01_r8,0.21498e+01_r8,0.24997e+01_r8,0.28719e+01_r8 /) + kao(:, 2,12,15) = (/ & + & 0.20605e+01_r8,0.18033e+01_r8,0.15462e+01_r8,0.14346e+01_r8,0.15183e+01_r8, & + & 0.17679e+01_r8,0.21055e+01_r8,0.24481e+01_r8,0.28126e+01_r8 /) + kao(:, 3,12,15) = (/ & + & 0.20007e+01_r8,0.17509e+01_r8,0.15011e+01_r8,0.13841e+01_r8,0.14777e+01_r8, & + & 0.17312e+01_r8,0.20634e+01_r8,0.23990e+01_r8,0.27564e+01_r8 /) + kao(:, 4,12,15) = (/ & + & 0.19501e+01_r8,0.17066e+01_r8,0.14631e+01_r8,0.13415e+01_r8,0.14420e+01_r8, & + & 0.16956e+01_r8,0.20218e+01_r8,0.23506e+01_r8,0.27007e+01_r8 /) + kao(:, 5,12,15) = (/ & + & 0.19023e+01_r8,0.16648e+01_r8,0.14272e+01_r8,0.13048e+01_r8,0.14093e+01_r8, & + & 0.16619e+01_r8,0.19834e+01_r8,0.23060e+01_r8,0.26492e+01_r8 /) + kao(:, 1,13,15) = (/ & + & 0.23283e+01_r8,0.20376e+01_r8,0.17570e+01_r8,0.16678e+01_r8,0.17574e+01_r8, & + & 0.20182e+01_r8,0.23943e+01_r8,0.27850e+01_r8,0.31979e+01_r8 /) + kao(:, 2,13,15) = (/ & + & 0.22552e+01_r8,0.19735e+01_r8,0.16974e+01_r8,0.16068e+01_r8,0.17079e+01_r8, & + & 0.19757e+01_r8,0.23460e+01_r8,0.27289e+01_r8,0.31334e+01_r8 /) + kao(:, 3,13,15) = (/ & + & 0.21945e+01_r8,0.19204e+01_r8,0.16488e+01_r8,0.15544e+01_r8,0.16639e+01_r8, & + & 0.19336e+01_r8,0.22972e+01_r8,0.26723e+01_r8,0.30681e+01_r8 /) + kao(:, 4,13,15) = (/ & + & 0.21377e+01_r8,0.18706e+01_r8,0.16045e+01_r8,0.15082e+01_r8,0.16235e+01_r8, & + & 0.18922e+01_r8,0.22504e+01_r8,0.26179e+01_r8,0.30055e+01_r8 /) + kao(:, 5,13,15) = (/ & + & 0.20822e+01_r8,0.18221e+01_r8,0.15623e+01_r8,0.14670e+01_r8,0.15845e+01_r8, & + & 0.18531e+01_r8,0.22061e+01_r8,0.25663e+01_r8,0.29464e+01_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.84891e+00_r8,0.74682e+00_r8,0.64540e+00_r8,0.54510e+00_r8,0.44671e+00_r8, & + & 0.34895e+00_r8,0.38105e+00_r8,0.44177e+00_r8,0.47725e+00_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.82292e+00_r8,0.72425e+00_r8,0.62615e+00_r8,0.52904e+00_r8,0.43334e+00_r8, & + & 0.33791e+00_r8,0.37758e+00_r8,0.43769e+00_r8,0.47292e+00_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.79766e+00_r8,0.70221e+00_r8,0.60725e+00_r8,0.51315e+00_r8,0.42001e+00_r8, & + & 0.32708e+00_r8,0.37351e+00_r8,0.43297e+00_r8,0.46789e+00_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.77341e+00_r8,0.68098e+00_r8,0.58899e+00_r8,0.49774e+00_r8,0.40711e+00_r8, & + & 0.31834e+00_r8,0.36899e+00_r8,0.42775e+00_r8,0.46227e+00_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.74989e+00_r8,0.66035e+00_r8,0.57119e+00_r8,0.48264e+00_r8,0.39437e+00_r8, & + & 0.32430e+00_r8,0.36416e+00_r8,0.42216e+00_r8,0.45636e+00_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.98489e+00_r8,0.86457e+00_r8,0.74461e+00_r8,0.62525e+00_r8,0.50699e+00_r8, & + & 0.39502e+00_r8,0.46270e+00_r8,0.53626e+00_r8,0.59246e+00_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.95110e+00_r8,0.83523e+00_r8,0.71967e+00_r8,0.60464e+00_r8,0.49055e+00_r8, & + & 0.38714e+00_r8,0.45775e+00_r8,0.53066e+00_r8,0.58669e+00_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.91868e+00_r8,0.80699e+00_r8,0.69557e+00_r8,0.58461e+00_r8,0.47447e+00_r8, & + & 0.38030e+00_r8,0.45287e+00_r8,0.52498e+00_r8,0.58057e+00_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.88783e+00_r8,0.78006e+00_r8,0.67253e+00_r8,0.56540e+00_r8,0.45894e+00_r8, & + & 0.37426e+00_r8,0.44739e+00_r8,0.51869e+00_r8,0.57355e+00_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.85824e+00_r8,0.75420e+00_r8,0.65037e+00_r8,0.54691e+00_r8,0.44407e+00_r8, & + & 0.37572e+00_r8,0.44151e+00_r8,0.51192e+00_r8,0.56619e+00_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.11382e+01_r8,0.99791e+00_r8,0.85785e+00_r8,0.71816e+00_r8,0.57913e+00_r8, & + & 0.47378e+00_r8,0.56732e+00_r8,0.65745e+00_r8,0.74321e+00_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.10944e+01_r8,0.95984e+00_r8,0.82550e+00_r8,0.69149e+00_r8,0.55807e+00_r8, & + & 0.46534e+00_r8,0.55716e+00_r8,0.64588e+00_r8,0.73020e+00_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.10534e+01_r8,0.92416e+00_r8,0.79509e+00_r8,0.66633e+00_r8,0.53808e+00_r8, & + & 0.45863e+00_r8,0.54915e+00_r8,0.63663e+00_r8,0.71995e+00_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.10141e+01_r8,0.88986e+00_r8,0.76582e+00_r8,0.64206e+00_r8,0.51870e+00_r8, & + & 0.45265e+00_r8,0.54212e+00_r8,0.62853e+00_r8,0.71089e+00_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.97757e+00_r8,0.85802e+00_r8,0.73862e+00_r8,0.61943e+00_r8,0.50068e+00_r8, & + & 0.44732e+00_r8,0.53486e+00_r8,0.62017e+00_r8,0.70154e+00_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.13027e+01_r8,0.11412e+01_r8,0.97988e+00_r8,0.81881e+00_r8,0.65819e+00_r8, & + & 0.58495e+00_r8,0.70040e+00_r8,0.81176e+00_r8,0.92845e+00_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.12473e+01_r8,0.10931e+01_r8,0.93894e+00_r8,0.78506e+00_r8,0.63160e+00_r8, & + & 0.57073e+00_r8,0.68340e+00_r8,0.79216e+00_r8,0.90610e+00_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.11956e+01_r8,0.10481e+01_r8,0.90063e+00_r8,0.75344e+00_r8,0.60663e+00_r8, & + & 0.55958e+00_r8,0.67003e+00_r8,0.77669e+00_r8,0.88836e+00_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.11480e+01_r8,0.10066e+01_r8,0.86532e+00_r8,0.72426e+00_r8,0.58351e+00_r8, & + & 0.54965e+00_r8,0.65819e+00_r8,0.76307e+00_r8,0.87291e+00_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.11042e+01_r8,0.96837e+00_r8,0.83267e+00_r8,0.69709e+00_r8,0.56180e+00_r8, & + & 0.54039e+00_r8,0.64710e+00_r8,0.75045e+00_r8,0.85825e+00_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.14755e+01_r8,0.12919e+01_r8,0.11084e+01_r8,0.92503e+00_r8,0.74199e+00_r8, & + & 0.72656e+00_r8,0.86992e+00_r8,0.10084e+01_r8,0.11593e+01_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.14077e+01_r8,0.12330e+01_r8,0.10584e+01_r8,0.88396e+00_r8,0.70985e+00_r8, & + & 0.70337e+00_r8,0.84221e+00_r8,0.97628e+00_r8,0.11223e+01_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.13473e+01_r8,0.11805e+01_r8,0.10138e+01_r8,0.84723e+00_r8,0.68084e+00_r8, & + & 0.68573e+00_r8,0.82117e+00_r8,0.95190e+00_r8,0.10943e+01_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.12931e+01_r8,0.11332e+01_r8,0.97336e+00_r8,0.81358e+00_r8,0.65399e+00_r8, & + & 0.67083e+00_r8,0.80321e+00_r8,0.93120e+00_r8,0.10704e+01_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.12425e+01_r8,0.10889e+01_r8,0.93535e+00_r8,0.78185e+00_r8,0.62849e+00_r8, & + & 0.65706e+00_r8,0.78689e+00_r8,0.91252e+00_r8,0.10486e+01_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.16632e+01_r8,0.14561e+01_r8,0.12491e+01_r8,0.10422e+01_r8,0.83545e+00_r8, & + & 0.90592e+00_r8,0.10850e+01_r8,0.12579e+01_r8,0.14491e+01_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.15885e+01_r8,0.13911e+01_r8,0.11938e+01_r8,0.99649e+00_r8,0.79932e+00_r8, & + & 0.87105e+00_r8,0.10430e+01_r8,0.12092e+01_r8,0.13933e+01_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.15219e+01_r8,0.13330e+01_r8,0.11441e+01_r8,0.95525e+00_r8,0.76651e+00_r8, & + & 0.84460e+00_r8,0.10114e+01_r8,0.11726e+01_r8,0.13510e+01_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.14602e+01_r8,0.12790e+01_r8,0.10978e+01_r8,0.91668e+00_r8,0.73549e+00_r8, & + & 0.82233e+00_r8,0.98468e+00_r8,0.11417e+01_r8,0.13152e+01_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.14027e+01_r8,0.12286e+01_r8,0.10546e+01_r8,0.88053e+00_r8,0.70846e+00_r8, & + & 0.80220e+00_r8,0.96072e+00_r8,0.11140e+01_r8,0.12832e+01_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.18802e+01_r8,0.16460e+01_r8,0.14119e+01_r8,0.11779e+01_r8,0.95036e+00_r8, & + & 0.11297e+01_r8,0.13528e+01_r8,0.15688e+01_r8,0.18094e+01_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.17989e+01_r8,0.15751e+01_r8,0.13512e+01_r8,0.11274e+01_r8,0.91055e+00_r8, & + & 0.10797e+01_r8,0.12930e+01_r8,0.14993e+01_r8,0.17294e+01_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.17245e+01_r8,0.15100e+01_r8,0.12954e+01_r8,0.10809e+01_r8,0.87508e+00_r8, & + & 0.10422e+01_r8,0.12481e+01_r8,0.14473e+01_r8,0.16693e+01_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.16543e+01_r8,0.14485e+01_r8,0.12427e+01_r8,0.10370e+01_r8,0.84724e+00_r8, & + & 0.10105e+01_r8,0.12102e+01_r8,0.14035e+01_r8,0.16185e+01_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.15884e+01_r8,0.13908e+01_r8,0.11932e+01_r8,0.99569e+00_r8,0.82331e+00_r8, & + & 0.98227e+00_r8,0.11764e+01_r8,0.13643e+01_r8,0.15734e+01_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.21327e+01_r8,0.18670e+01_r8,0.16012e+01_r8,0.13355e+01_r8,0.11430e+01_r8, & + & 0.14062e+01_r8,0.16843e+01_r8,0.19535e+01_r8,0.22540e+01_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.20434e+01_r8,0.17888e+01_r8,0.15342e+01_r8,0.12796e+01_r8,0.10891e+01_r8, & + & 0.13377e+01_r8,0.16020e+01_r8,0.18582e+01_r8,0.21442e+01_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.19592e+01_r8,0.17151e+01_r8,0.14711e+01_r8,0.12270e+01_r8,0.10443e+01_r8, & + & 0.12854e+01_r8,0.15395e+01_r8,0.17855e+01_r8,0.20605e+01_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.18795e+01_r8,0.16454e+01_r8,0.14112e+01_r8,0.11771e+01_r8,0.10093e+01_r8, & + & 0.12418e+01_r8,0.14873e+01_r8,0.17251e+01_r8,0.19905e+01_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.18040e+01_r8,0.15793e+01_r8,0.13546e+01_r8,0.11298e+01_r8,0.97893e+00_r8, & + & 0.12029e+01_r8,0.14409e+01_r8,0.16715e+01_r8,0.19284e+01_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.24263e+01_r8,0.21237e+01_r8,0.18212e+01_r8,0.15186e+01_r8,0.14038e+01_r8, & + & 0.17468e+01_r8,0.20923e+01_r8,0.24275e+01_r8,0.28010e+01_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.23266e+01_r8,0.20365e+01_r8,0.17464e+01_r8,0.14563e+01_r8,0.13334e+01_r8, & + & 0.16567e+01_r8,0.19843e+01_r8,0.23023e+01_r8,0.26565e+01_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.22311e+01_r8,0.19529e+01_r8,0.16747e+01_r8,0.13965e+01_r8,0.12741e+01_r8, & + & 0.15855e+01_r8,0.18989e+01_r8,0.22031e+01_r8,0.25421e+01_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.21400e+01_r8,0.18731e+01_r8,0.16063e+01_r8,0.13394e+01_r8,0.12261e+01_r8, & + & 0.15261e+01_r8,0.18280e+01_r8,0.21210e+01_r8,0.24473e+01_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.20537e+01_r8,0.17976e+01_r8,0.15415e+01_r8,0.12854e+01_r8,0.11844e+01_r8, & + & 0.14739e+01_r8,0.17653e+01_r8,0.20482e+01_r8,0.23631e+01_r8 /) + kao(:, 1,10,16) = (/ & + & 0.27556e+01_r8,0.24117e+01_r8,0.20679e+01_r8,0.17241e+01_r8,0.17250e+01_r8, & + & 0.21531e+01_r8,0.25793e+01_r8,0.29930e+01_r8,0.34529e+01_r8 /) + kao(:, 2,10,16) = (/ & + & 0.26436e+01_r8,0.23137e+01_r8,0.19838e+01_r8,0.16540e+01_r8,0.16343e+01_r8, & + & 0.20375e+01_r8,0.24406e+01_r8,0.28326e+01_r8,0.32672e+01_r8 /) + kao(:, 3,10,16) = (/ & + & 0.25350e+01_r8,0.22187e+01_r8,0.19024e+01_r8,0.15861e+01_r8,0.15582e+01_r8, & + & 0.19443e+01_r8,0.23290e+01_r8,0.27026e+01_r8,0.31178e+01_r8 /) + kao(:, 4,10,16) = (/ & + & 0.24300e+01_r8,0.21267e+01_r8,0.18235e+01_r8,0.15203e+01_r8,0.14955e+01_r8, & + & 0.18662e+01_r8,0.22353e+01_r8,0.25942e+01_r8,0.29924e+01_r8 /) + kao(:, 5,10,16) = (/ & + & 0.23355e+01_r8,0.20440e+01_r8,0.17526e+01_r8,0.14611e+01_r8,0.14399e+01_r8, & + & 0.17966e+01_r8,0.21521e+01_r8,0.24975e+01_r8,0.28809e+01_r8 /) + kao(:, 1,11,16) = (/ & + & 0.30736e+01_r8,0.26899e+01_r8,0.23062e+01_r8,0.19287e+01_r8,0.20594e+01_r8, & + & 0.25707e+01_r8,0.30796e+01_r8,0.35755e+01_r8,0.41218e+01_r8 /) + kao(:, 2,11,16) = (/ & + & 0.29458e+01_r8,0.25780e+01_r8,0.22102e+01_r8,0.18490e+01_r8,0.19506e+01_r8, & + & 0.24353e+01_r8,0.29176e+01_r8,0.33867e+01_r8,0.39048e+01_r8 /) + kao(:, 3,11,16) = (/ & + & 0.28287e+01_r8,0.24755e+01_r8,0.21223e+01_r8,0.17723e+01_r8,0.18621e+01_r8, & + & 0.23252e+01_r8,0.27855e+01_r8,0.32334e+01_r8,0.37281e+01_r8 /) + kao(:, 4,11,16) = (/ & + & 0.27181e+01_r8,0.23787e+01_r8,0.20393e+01_r8,0.17010e+01_r8,0.17848e+01_r8, & + & 0.22284e+01_r8,0.26698e+01_r8,0.30991e+01_r8,0.35730e+01_r8 /) + kao(:, 5,11,16) = (/ & + & 0.26214e+01_r8,0.22941e+01_r8,0.19667e+01_r8,0.16394e+01_r8,0.17149e+01_r8, & + & 0.21409e+01_r8,0.25649e+01_r8,0.29778e+01_r8,0.34326e+01_r8 /) + kao(:, 1,12,16) = (/ & + & 0.34457e+01_r8,0.30154e+01_r8,0.25850e+01_r8,0.22002e+01_r8,0.24421e+01_r8, & + & 0.30491e+01_r8,0.36532e+01_r8,0.42422e+01_r8,0.48881e+01_r8 /) + kao(:, 2,12,16) = (/ & + & 0.33132e+01_r8,0.28993e+01_r8,0.24855e+01_r8,0.21037e+01_r8,0.23175e+01_r8, & + & 0.28938e+01_r8,0.34673e+01_r8,0.40262e+01_r8,0.46397e+01_r8 /) + kao(:, 3,12,16) = (/ & + & 0.31843e+01_r8,0.27866e+01_r8,0.23888e+01_r8,0.20132e+01_r8,0.22107e+01_r8, & + & 0.27603e+01_r8,0.33070e+01_r8,0.38403e+01_r8,0.44248e+01_r8 /) + kao(:, 4,12,16) = (/ & + & 0.30610e+01_r8,0.26787e+01_r8,0.22963e+01_r8,0.19289e+01_r8,0.21145e+01_r8, & + & 0.26402e+01_r8,0.31632e+01_r8,0.36735e+01_r8,0.42326e+01_r8 /) + kao(:, 5,12,16) = (/ & + & 0.29533e+01_r8,0.25844e+01_r8,0.22155e+01_r8,0.18569e+01_r8,0.20264e+01_r8, & + & 0.25300e+01_r8,0.30314e+01_r8,0.35205e+01_r8,0.40560e+01_r8 /) + kao(:, 1,13,16) = (/ & + & 0.38898e+01_r8,0.34039e+01_r8,0.29179e+01_r8,0.25320e+01_r8,0.28809e+01_r8, & + & 0.35965e+01_r8,0.43091e+01_r8,0.50055e+01_r8,0.57650e+01_r8 /) + kao(:, 2,13,16) = (/ & + & 0.37371e+01_r8,0.32702e+01_r8,0.28033e+01_r8,0.24146e+01_r8,0.27330e+01_r8, & + & 0.34120e+01_r8,0.40886e+01_r8,0.47494e+01_r8,0.54692e+01_r8 /) + kao(:, 3,13,16) = (/ & + & 0.35846e+01_r8,0.31367e+01_r8,0.26889e+01_r8,0.23047e+01_r8,0.26019e+01_r8, & + & 0.32482e+01_r8,0.38921e+01_r8,0.45212e+01_r8,0.52066e+01_r8 /) + kao(:, 4,13,16) = (/ & + & 0.34450e+01_r8,0.30146e+01_r8,0.25842e+01_r8,0.22048e+01_r8,0.24829e+01_r8, & + & 0.31006e+01_r8,0.37153e+01_r8,0.43162e+01_r8,0.49694e+01_r8 /) + kao(:, 5,13,16) = (/ & + & 0.33226e+01_r8,0.29075e+01_r8,0.24923e+01_r8,0.21144e+01_r8,0.23741e+01_r8, & + & 0.29651e+01_r8,0.35532e+01_r8,0.41282e+01_r8,0.47532e+01_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.78344e-03_r8,0.81478e-03_r8,0.83713e-03_r8,0.85265e-03_r8,0.85991e-03_r8 /) + kbo(:,14, 1) = (/ & + & 0.65374e-03_r8,0.67963e-03_r8,0.69840e-03_r8,0.71131e-03_r8,0.71719e-03_r8 /) + kbo(:,15, 1) = (/ & + & 0.55587e-03_r8,0.57751e-03_r8,0.59343e-03_r8,0.60410e-03_r8,0.60993e-03_r8 /) + kbo(:,16, 1) = (/ & + & 0.48145e-03_r8,0.49780e-03_r8,0.51251e-03_r8,0.52093e-03_r8,0.52706e-03_r8 /) + kbo(:,17, 1) = (/ & + & 0.42610e-03_r8,0.43577e-03_r8,0.44892e-03_r8,0.45812e-03_r8,0.46352e-03_r8 /) + kbo(:,18, 1) = (/ & + & 0.38503e-03_r8,0.38849e-03_r8,0.40094e-03_r8,0.41067e-03_r8,0.41529e-03_r8 /) + kbo(:,19, 1) = (/ & + & 0.35025e-03_r8,0.34902e-03_r8,0.35803e-03_r8,0.36759e-03_r8,0.37429e-03_r8 /) + kbo(:,20, 1) = (/ & + & 0.30557e-03_r8,0.30381e-03_r8,0.30983e-03_r8,0.31782e-03_r8,0.32429e-03_r8 /) + kbo(:,21, 1) = (/ & + & 0.26346e-03_r8,0.26127e-03_r8,0.26616e-03_r8,0.27270e-03_r8,0.27830e-03_r8 /) + kbo(:,22, 1) = (/ & + & 0.22630e-03_r8,0.22463e-03_r8,0.22867e-03_r8,0.23419e-03_r8,0.23829e-03_r8 /) + kbo(:,23, 1) = (/ & + & 0.19498e-03_r8,0.19376e-03_r8,0.19644e-03_r8,0.20096e-03_r8,0.20404e-03_r8 /) + kbo(:,24, 1) = (/ & + & 0.16839e-03_r8,0.16687e-03_r8,0.16820e-03_r8,0.17215e-03_r8,0.17490e-03_r8 /) + kbo(:,25, 1) = (/ & + & 0.14494e-03_r8,0.14347e-03_r8,0.14334e-03_r8,0.14728e-03_r8,0.14954e-03_r8 /) + kbo(:,26, 1) = (/ & + & 0.12363e-03_r8,0.12241e-03_r8,0.12233e-03_r8,0.12518e-03_r8,0.12767e-03_r8 /) + kbo(:,27, 1) = (/ & + & 0.10560e-03_r8,0.10482e-03_r8,0.10446e-03_r8,0.10681e-03_r8,0.10897e-03_r8 /) + kbo(:,28, 1) = (/ & + & 0.90453e-04_r8,0.89921e-04_r8,0.89199e-04_r8,0.91278e-04_r8,0.93235e-04_r8 /) + kbo(:,29, 1) = (/ & + & 0.77854e-04_r8,0.77467e-04_r8,0.76947e-04_r8,0.77977e-04_r8,0.79713e-04_r8 /) + kbo(:,30, 1) = (/ & + & 0.67346e-04_r8,0.67074e-04_r8,0.66981e-04_r8,0.67340e-04_r8,0.68453e-04_r8 /) + kbo(:,31, 1) = (/ & + & 0.58739e-04_r8,0.58583e-04_r8,0.58517e-04_r8,0.58421e-04_r8,0.59277e-04_r8 /) + kbo(:,32, 1) = (/ & + & 0.51671e-04_r8,0.51476e-04_r8,0.51254e-04_r8,0.51199e-04_r8,0.51510e-04_r8 /) + kbo(:,33, 1) = (/ & + & 0.45523e-04_r8,0.45406e-04_r8,0.45028e-04_r8,0.44849e-04_r8,0.44977e-04_r8 /) + kbo(:,34, 1) = (/ & + & 0.40256e-04_r8,0.40062e-04_r8,0.39751e-04_r8,0.39416e-04_r8,0.39181e-04_r8 /) + kbo(:,35, 1) = (/ & + & 0.35762e-04_r8,0.35429e-04_r8,0.35245e-04_r8,0.34916e-04_r8,0.34484e-04_r8 /) + kbo(:,36, 1) = (/ & + & 0.31776e-04_r8,0.31666e-04_r8,0.31200e-04_r8,0.31013e-04_r8,0.30768e-04_r8 /) + kbo(:,37, 1) = (/ & + & 0.26934e-04_r8,0.26971e-04_r8,0.26615e-04_r8,0.26355e-04_r8,0.26214e-04_r8 /) + kbo(:,38, 1) = (/ & + & 0.22652e-04_r8,0.22874e-04_r8,0.22686e-04_r8,0.22466e-04_r8,0.22266e-04_r8 /) + kbo(:,39, 1) = (/ & + & 0.18970e-04_r8,0.19273e-04_r8,0.19385e-04_r8,0.19198e-04_r8,0.19016e-04_r8 /) + kbo(:,40, 1) = (/ & + & 0.15533e-04_r8,0.15831e-04_r8,0.15964e-04_r8,0.15836e-04_r8,0.15700e-04_r8 /) + kbo(:,41, 1) = (/ & + & 0.12668e-04_r8,0.12826e-04_r8,0.12999e-04_r8,0.13018e-04_r8,0.12872e-04_r8 /) + kbo(:,42, 1) = (/ & + & 0.10356e-04_r8,0.10475e-04_r8,0.10620e-04_r8,0.10666e-04_r8,0.10580e-04_r8 /) + kbo(:,43, 1) = (/ & + & 0.83551e-05_r8,0.84490e-05_r8,0.85217e-05_r8,0.86140e-05_r8,0.86044e-05_r8 /) + kbo(:,44, 1) = (/ & + & 0.66829e-05_r8,0.68022e-05_r8,0.68791e-05_r8,0.69429e-05_r8,0.69314e-05_r8 /) + kbo(:,45, 1) = (/ & + & 0.53860e-05_r8,0.54494e-05_r8,0.55341e-05_r8,0.55544e-05_r8,0.55761e-05_r8 /) + kbo(:,46, 1) = (/ & + & 0.43207e-05_r8,0.43601e-05_r8,0.44477e-05_r8,0.44761e-05_r8,0.44727e-05_r8 /) + kbo(:,47, 1) = (/ & + & 0.34852e-05_r8,0.34924e-05_r8,0.35555e-05_r8,0.35928e-05_r8,0.35957e-05_r8 /) + kbo(:,48, 1) = (/ & + & 0.27913e-05_r8,0.28024e-05_r8,0.28395e-05_r8,0.28713e-05_r8,0.28836e-05_r8 /) + kbo(:,49, 1) = (/ & + & 0.22267e-05_r8,0.22549e-05_r8,0.22736e-05_r8,0.22769e-05_r8,0.23083e-05_r8 /) + kbo(:,50, 1) = (/ & + & 0.17814e-05_r8,0.18056e-05_r8,0.18272e-05_r8,0.18178e-05_r8,0.18340e-05_r8 /) + kbo(:,51, 1) = (/ & + & 0.14202e-05_r8,0.14390e-05_r8,0.14605e-05_r8,0.14515e-05_r8,0.14607e-05_r8 /) + kbo(:,52, 1) = (/ & + & 0.11328e-05_r8,0.11511e-05_r8,0.11629e-05_r8,0.11627e-05_r8,0.11618e-05_r8 /) + kbo(:,53, 1) = (/ & + & 0.90478e-06_r8,0.91291e-06_r8,0.92251e-06_r8,0.92910e-06_r8,0.92898e-06_r8 /) + kbo(:,54, 1) = (/ & + & 0.71737e-06_r8,0.72444e-06_r8,0.73271e-06_r8,0.73646e-06_r8,0.74079e-06_r8 /) + kbo(:,55, 1) = (/ & + & 0.56522e-06_r8,0.57444e-06_r8,0.57690e-06_r8,0.58444e-06_r8,0.59006e-06_r8 /) + kbo(:,56, 1) = (/ & + & 0.44522e-06_r8,0.45152e-06_r8,0.45592e-06_r8,0.46208e-06_r8,0.46721e-06_r8 /) + kbo(:,57, 1) = (/ & + & 0.35045e-06_r8,0.35432e-06_r8,0.36035e-06_r8,0.36444e-06_r8,0.36942e-06_r8 /) + kbo(:,58, 1) = (/ & + & 0.27513e-06_r8,0.27793e-06_r8,0.28330e-06_r8,0.28729e-06_r8,0.29229e-06_r8 /) + kbo(:,59, 1) = (/ & + & 0.21608e-06_r8,0.21966e-06_r8,0.22301e-06_r8,0.22740e-06_r8,0.23129e-06_r8 /) + kbo(:,13, 2) = (/ & + & 0.41669e-02_r8,0.42141e-02_r8,0.42434e-02_r8,0.42683e-02_r8,0.42755e-02_r8 /) + kbo(:,14, 2) = (/ & + & 0.34875e-02_r8,0.35201e-02_r8,0.35377e-02_r8,0.35547e-02_r8,0.35629e-02_r8 /) + kbo(:,15, 2) = (/ & + & 0.29417e-02_r8,0.29682e-02_r8,0.29797e-02_r8,0.29877e-02_r8,0.29948e-02_r8 /) + kbo(:,16, 2) = (/ & + & 0.25072e-02_r8,0.25337e-02_r8,0.25373e-02_r8,0.25423e-02_r8,0.25464e-02_r8 /) + kbo(:,17, 2) = (/ & + & 0.21640e-02_r8,0.21948e-02_r8,0.21974e-02_r8,0.21951e-02_r8,0.21930e-02_r8 /) + kbo(:,18, 2) = (/ & + & 0.18910e-02_r8,0.19229e-02_r8,0.19301e-02_r8,0.19201e-02_r8,0.19153e-02_r8 /) + kbo(:,19, 2) = (/ & + & 0.16495e-02_r8,0.16848e-02_r8,0.16944e-02_r8,0.16885e-02_r8,0.16779e-02_r8 /) + kbo(:,20, 2) = (/ & + & 0.14018e-02_r8,0.14333e-02_r8,0.14424e-02_r8,0.14394e-02_r8,0.14287e-02_r8 /) + kbo(:,21, 2) = (/ & + & 0.11832e-02_r8,0.12125e-02_r8,0.12189e-02_r8,0.12151e-02_r8,0.12082e-02_r8 /) + kbo(:,22, 2) = (/ & + & 0.99669e-03_r8,0.10233e-02_r8,0.10268e-02_r8,0.10250e-02_r8,0.10191e-02_r8 /) + kbo(:,23, 2) = (/ & + & 0.83734e-03_r8,0.86220e-03_r8,0.86642e-03_r8,0.86487e-03_r8,0.86054e-03_r8 /) + kbo(:,24, 2) = (/ & + & 0.70349e-03_r8,0.72654e-03_r8,0.73243e-03_r8,0.73077e-03_r8,0.72754e-03_r8 /) + kbo(:,25, 2) = (/ & + & 0.59070e-03_r8,0.61044e-03_r8,0.61929e-03_r8,0.61773e-03_r8,0.61583e-03_r8 /) + kbo(:,26, 2) = (/ & + & 0.49716e-03_r8,0.51139e-03_r8,0.52115e-03_r8,0.52139e-03_r8,0.52023e-03_r8 /) + kbo(:,27, 2) = (/ & + & 0.41822e-03_r8,0.42737e-03_r8,0.43808e-03_r8,0.43978e-03_r8,0.43884e-03_r8 /) + kbo(:,28, 2) = (/ & + & 0.35061e-03_r8,0.35848e-03_r8,0.36841e-03_r8,0.37095e-03_r8,0.37053e-03_r8 /) + kbo(:,29, 2) = (/ & + & 0.29391e-03_r8,0.30227e-03_r8,0.30912e-03_r8,0.31376e-03_r8,0.31382e-03_r8 /) + kbo(:,30, 2) = (/ & + & 0.24878e-03_r8,0.25551e-03_r8,0.25990e-03_r8,0.26493e-03_r8,0.26717e-03_r8 /) + kbo(:,31, 2) = (/ & + & 0.21146e-03_r8,0.21606e-03_r8,0.21973e-03_r8,0.22385e-03_r8,0.22711e-03_r8 /) + kbo(:,32, 2) = (/ & + & 0.17989e-03_r8,0.18248e-03_r8,0.18678e-03_r8,0.18914e-03_r8,0.19265e-03_r8 /) + kbo(:,33, 2) = (/ & + & 0.15377e-03_r8,0.15569e-03_r8,0.15798e-03_r8,0.16109e-03_r8,0.16313e-03_r8 /) + kbo(:,34, 2) = (/ & + & 0.13129e-03_r8,0.13289e-03_r8,0.13431e-03_r8,0.13679e-03_r8,0.13869e-03_r8 /) + kbo(:,35, 2) = (/ & + & 0.11225e-03_r8,0.11370e-03_r8,0.11480e-03_r8,0.11616e-03_r8,0.11774e-03_r8 /) + kbo(:,36, 2) = (/ & + & 0.96722e-04_r8,0.97093e-04_r8,0.98641e-04_r8,0.99964e-04_r8,0.10029e-03_r8 /) + kbo(:,37, 2) = (/ & + & 0.81278e-04_r8,0.81350e-04_r8,0.82442e-04_r8,0.83555e-04_r8,0.83990e-04_r8 /) + kbo(:,38, 2) = (/ & + & 0.68481e-04_r8,0.68398e-04_r8,0.68899e-04_r8,0.69737e-04_r8,0.70187e-04_r8 /) + kbo(:,39, 2) = (/ & + & 0.57588e-04_r8,0.57895e-04_r8,0.57814e-04_r8,0.58095e-04_r8,0.58861e-04_r8 /) + kbo(:,40, 2) = (/ & + & 0.47541e-04_r8,0.47609e-04_r8,0.47587e-04_r8,0.47727e-04_r8,0.48149e-04_r8 /) + kbo(:,41, 2) = (/ & + & 0.39099e-04_r8,0.39119e-04_r8,0.39164e-04_r8,0.39161e-04_r8,0.39530e-04_r8 /) + kbo(:,42, 2) = (/ & + & 0.32129e-04_r8,0.32067e-04_r8,0.32113e-04_r8,0.32128e-04_r8,0.32332e-04_r8 /) + kbo(:,43, 2) = (/ & + & 0.26339e-04_r8,0.26195e-04_r8,0.26218e-04_r8,0.26313e-04_r8,0.26301e-04_r8 /) + kbo(:,44, 2) = (/ & + & 0.21510e-04_r8,0.21341e-04_r8,0.21297e-04_r8,0.21378e-04_r8,0.21395e-04_r8 /) + kbo(:,45, 2) = (/ & + & 0.17530e-04_r8,0.17454e-04_r8,0.17341e-04_r8,0.17352e-04_r8,0.17454e-04_r8 /) + kbo(:,46, 2) = (/ & + & 0.14267e-04_r8,0.14213e-04_r8,0.14118e-04_r8,0.14076e-04_r8,0.14192e-04_r8 /) + kbo(:,47, 2) = (/ & + & 0.11510e-04_r8,0.11593e-04_r8,0.11522e-04_r8,0.11431e-04_r8,0.11494e-04_r8 /) + kbo(:,48, 2) = (/ & + & 0.92607e-05_r8,0.93963e-05_r8,0.93931e-05_r8,0.93302e-05_r8,0.93175e-05_r8 /) + kbo(:,49, 2) = (/ & + & 0.74566e-05_r8,0.75640e-05_r8,0.76551e-05_r8,0.76195e-05_r8,0.75706e-05_r8 /) + kbo(:,50, 2) = (/ & + & 0.60069e-05_r8,0.60789e-05_r8,0.61866e-05_r8,0.62136e-05_r8,0.61878e-05_r8 /) + kbo(:,51, 2) = (/ & + & 0.48719e-05_r8,0.49189e-05_r8,0.49852e-05_r8,0.50599e-05_r8,0.50406e-05_r8 /) + kbo(:,52, 2) = (/ & + & 0.39542e-05_r8,0.39622e-05_r8,0.40023e-05_r8,0.40853e-05_r8,0.41134e-05_r8 /) + kbo(:,53, 2) = (/ & + & 0.31898e-05_r8,0.32108e-05_r8,0.32348e-05_r8,0.32873e-05_r8,0.33341e-05_r8 /) + kbo(:,54, 2) = (/ & + & 0.25786e-05_r8,0.26009e-05_r8,0.26192e-05_r8,0.26504e-05_r8,0.26983e-05_r8 /) + kbo(:,55, 2) = (/ & + & 0.20942e-05_r8,0.21017e-05_r8,0.21274e-05_r8,0.21442e-05_r8,0.21775e-05_r8 /) + kbo(:,56, 2) = (/ & + & 0.16959e-05_r8,0.17018e-05_r8,0.17251e-05_r8,0.17374e-05_r8,0.17575e-05_r8 /) + kbo(:,57, 2) = (/ & + & 0.13662e-05_r8,0.13805e-05_r8,0.13926e-05_r8,0.14091e-05_r8,0.14210e-05_r8 /) + kbo(:,58, 2) = (/ & + & 0.10989e-05_r8,0.11199e-05_r8,0.11269e-05_r8,0.11436e-05_r8,0.11502e-05_r8 /) + kbo(:,59, 2) = (/ & + & 0.88647e-06_r8,0.91054e-06_r8,0.91770e-06_r8,0.92872e-06_r8,0.93619e-06_r8 /) + kbo(:,13, 3) = (/ & + & 0.91432e-02_r8,0.90907e-02_r8,0.90565e-02_r8,0.89984e-02_r8,0.89385e-02_r8 /) + kbo(:,14, 3) = (/ & + & 0.76455e-02_r8,0.75988e-02_r8,0.75709e-02_r8,0.75150e-02_r8,0.74448e-02_r8 /) + kbo(:,15, 3) = (/ & + & 0.64231e-02_r8,0.63826e-02_r8,0.63449e-02_r8,0.62999e-02_r8,0.62412e-02_r8 /) + kbo(:,16, 3) = (/ & + & 0.54475e-02_r8,0.53998e-02_r8,0.53630e-02_r8,0.53153e-02_r8,0.52574e-02_r8 /) + kbo(:,17, 3) = (/ & + & 0.46876e-02_r8,0.46363e-02_r8,0.45869e-02_r8,0.45398e-02_r8,0.44911e-02_r8 /) + kbo(:,18, 3) = (/ & + & 0.40806e-02_r8,0.40265e-02_r8,0.39670e-02_r8,0.39185e-02_r8,0.38714e-02_r8 /) + kbo(:,19, 3) = (/ & + & 0.35897e-02_r8,0.35272e-02_r8,0.34695e-02_r8,0.34174e-02_r8,0.33721e-02_r8 /) + kbo(:,20, 3) = (/ & + & 0.30557e-02_r8,0.30003e-02_r8,0.29518e-02_r8,0.29027e-02_r8,0.28623e-02_r8 /) + kbo(:,21, 3) = (/ & + & 0.25840e-02_r8,0.25346e-02_r8,0.24907e-02_r8,0.24530e-02_r8,0.24134e-02_r8 /) + kbo(:,22, 3) = (/ & + & 0.21784e-02_r8,0.21342e-02_r8,0.20972e-02_r8,0.20639e-02_r8,0.20310e-02_r8 /) + kbo(:,23, 3) = (/ & + & 0.18415e-02_r8,0.17987e-02_r8,0.17683e-02_r8,0.17405e-02_r8,0.17162e-02_r8 /) + kbo(:,24, 3) = (/ & + & 0.15599e-02_r8,0.15210e-02_r8,0.14940e-02_r8,0.14715e-02_r8,0.14516e-02_r8 /) + kbo(:,25, 3) = (/ & + & 0.13214e-02_r8,0.12882e-02_r8,0.12631e-02_r8,0.12449e-02_r8,0.12269e-02_r8 /) + kbo(:,26, 3) = (/ & + & 0.11148e-02_r8,0.10885e-02_r8,0.10663e-02_r8,0.10485e-02_r8,0.10339e-02_r8 /) + kbo(:,27, 3) = (/ & + & 0.94180e-03_r8,0.92291e-03_r8,0.90201e-03_r8,0.88582e-03_r8,0.87360e-03_r8 /) + kbo(:,28, 3) = (/ & + & 0.79929e-03_r8,0.78315e-03_r8,0.76525e-03_r8,0.75093e-03_r8,0.73943e-03_r8 /) + kbo(:,29, 3) = (/ & + & 0.68110e-03_r8,0.66580e-03_r8,0.65234e-03_r8,0.63866e-03_r8,0.62757e-03_r8 /) + kbo(:,30, 3) = (/ & + & 0.57975e-03_r8,0.56820e-03_r8,0.55835e-03_r8,0.54581e-03_r8,0.53624e-03_r8 /) + kbo(:,31, 3) = (/ & + & 0.49551e-03_r8,0.48804e-03_r8,0.47841e-03_r8,0.46871e-03_r8,0.45833e-03_r8 /) + kbo(:,32, 3) = (/ & + & 0.42572e-03_r8,0.42052e-03_r8,0.41099e-03_r8,0.40377e-03_r8,0.39554e-03_r8 /) + kbo(:,33, 3) = (/ & + & 0.36528e-03_r8,0.36135e-03_r8,0.35701e-03_r8,0.34948e-03_r8,0.34456e-03_r8 /) + kbo(:,34, 3) = (/ & + & 0.31415e-03_r8,0.31283e-03_r8,0.30989e-03_r8,0.30612e-03_r8,0.30054e-03_r8 /) + kbo(:,35, 3) = (/ & + & 0.27352e-03_r8,0.27102e-03_r8,0.26979e-03_r8,0.26826e-03_r8,0.26448e-03_r8 /) + kbo(:,36, 3) = (/ & + & 0.23967e-03_r8,0.23742e-03_r8,0.23456e-03_r8,0.23474e-03_r8,0.23316e-03_r8 /) + kbo(:,37, 3) = (/ & + & 0.20338e-03_r8,0.20142e-03_r8,0.19919e-03_r8,0.19875e-03_r8,0.19818e-03_r8 /) + kbo(:,38, 3) = (/ & + & 0.17257e-03_r8,0.17079e-03_r8,0.16890e-03_r8,0.16818e-03_r8,0.16767e-03_r8 /) + kbo(:,39, 3) = (/ & + & 0.14733e-03_r8,0.14508e-03_r8,0.14396e-03_r8,0.14263e-03_r8,0.14203e-03_r8 /) + kbo(:,40, 3) = (/ & + & 0.12225e-03_r8,0.12069e-03_r8,0.11949e-03_r8,0.11833e-03_r8,0.11808e-03_r8 /) + kbo(:,41, 3) = (/ & + & 0.10097e-03_r8,0.10002e-03_r8,0.98765e-04_r8,0.97895e-04_r8,0.97754e-04_r8 /) + kbo(:,42, 3) = (/ & + & 0.83346e-04_r8,0.82796e-04_r8,0.81713e-04_r8,0.81007e-04_r8,0.80814e-04_r8 /) + kbo(:,43, 3) = (/ & + & 0.68346e-04_r8,0.68043e-04_r8,0.67367e-04_r8,0.66543e-04_r8,0.66059e-04_r8 /) + kbo(:,44, 3) = (/ & + & 0.55818e-04_r8,0.55703e-04_r8,0.55284e-04_r8,0.54584e-04_r8,0.54239e-04_r8 /) + kbo(:,45, 3) = (/ & + & 0.45332e-04_r8,0.45541e-04_r8,0.45337e-04_r8,0.44929e-04_r8,0.44433e-04_r8 /) + kbo(:,46, 3) = (/ & + & 0.36748e-04_r8,0.37223e-04_r8,0.37146e-04_r8,0.36884e-04_r8,0.36439e-04_r8 /) + kbo(:,47, 3) = (/ & + & 0.29601e-04_r8,0.30289e-04_r8,0.30405e-04_r8,0.30257e-04_r8,0.29929e-04_r8 /) + kbo(:,48, 3) = (/ & + & 0.23826e-04_r8,0.24579e-04_r8,0.24815e-04_r8,0.24762e-04_r8,0.24572e-04_r8 /) + kbo(:,49, 3) = (/ & + & 0.19377e-04_r8,0.19814e-04_r8,0.20191e-04_r8,0.20227e-04_r8,0.20080e-04_r8 /) + kbo(:,50, 3) = (/ & + & 0.15665e-04_r8,0.15965e-04_r8,0.16366e-04_r8,0.16467e-04_r8,0.16386e-04_r8 /) + kbo(:,51, 3) = (/ & + & 0.12631e-04_r8,0.12915e-04_r8,0.13203e-04_r8,0.13389e-04_r8,0.13403e-04_r8 /) + kbo(:,52, 3) = (/ & + & 0.10160e-04_r8,0.10402e-04_r8,0.10609e-04_r8,0.10858e-04_r8,0.10900e-04_r8 /) + kbo(:,53, 3) = (/ & + & 0.81514e-05_r8,0.83717e-05_r8,0.85717e-05_r8,0.87255e-05_r8,0.88490e-05_r8 /) + kbo(:,54, 3) = (/ & + & 0.65924e-05_r8,0.67623e-05_r8,0.69218e-05_r8,0.70363e-05_r8,0.71744e-05_r8 /) + kbo(:,55, 3) = (/ & + & 0.53378e-05_r8,0.54823e-05_r8,0.56002e-05_r8,0.57079e-05_r8,0.58136e-05_r8 /) + kbo(:,56, 3) = (/ & + & 0.43093e-05_r8,0.44306e-05_r8,0.45341e-05_r8,0.46443e-05_r8,0.47053e-05_r8 /) + kbo(:,57, 3) = (/ & + & 0.34880e-05_r8,0.35826e-05_r8,0.36738e-05_r8,0.37492e-05_r8,0.38094e-05_r8 /) + kbo(:,58, 3) = (/ & + & 0.28214e-05_r8,0.28911e-05_r8,0.29636e-05_r8,0.30269e-05_r8,0.30943e-05_r8 /) + kbo(:,59, 3) = (/ & + & 0.23049e-05_r8,0.23610e-05_r8,0.24232e-05_r8,0.24708e-05_r8,0.25266e-05_r8 /) + kbo(:,13, 4) = (/ & + & 0.16886e-01_r8,0.17177e-01_r8,0.17415e-01_r8,0.17613e-01_r8,0.17771e-01_r8 /) + kbo(:,14, 4) = (/ & + & 0.14297e-01_r8,0.14572e-01_r8,0.14791e-01_r8,0.14925e-01_r8,0.15051e-01_r8 /) + kbo(:,15, 4) = (/ & + & 0.12142e-01_r8,0.12342e-01_r8,0.12507e-01_r8,0.12640e-01_r8,0.12754e-01_r8 /) + kbo(:,16, 4) = (/ & + & 0.10284e-01_r8,0.10422e-01_r8,0.10545e-01_r8,0.10662e-01_r8,0.10740e-01_r8 /) + kbo(:,17, 4) = (/ & + & 0.87377e-02_r8,0.88415e-02_r8,0.89329e-02_r8,0.90175e-02_r8,0.90716e-02_r8 /) + kbo(:,18, 4) = (/ & + & 0.74766e-02_r8,0.75366e-02_r8,0.76038e-02_r8,0.76818e-02_r8,0.77135e-02_r8 /) + kbo(:,19, 4) = (/ & + & 0.64241e-02_r8,0.64546e-02_r8,0.65027e-02_r8,0.65449e-02_r8,0.65755e-02_r8 /) + kbo(:,20, 4) = (/ & + & 0.54390e-02_r8,0.54528e-02_r8,0.54854e-02_r8,0.55046e-02_r8,0.55309e-02_r8 /) + kbo(:,21, 4) = (/ & + & 0.45856e-02_r8,0.45888e-02_r8,0.46080e-02_r8,0.46219e-02_r8,0.46381e-02_r8 /) + kbo(:,22, 4) = (/ & + & 0.38581e-02_r8,0.38555e-02_r8,0.38631e-02_r8,0.38756e-02_r8,0.38888e-02_r8 /) + kbo(:,23, 4) = (/ & + & 0.32522e-02_r8,0.32442e-02_r8,0.32437e-02_r8,0.32522e-02_r8,0.32616e-02_r8 /) + kbo(:,24, 4) = (/ & + & 0.27421e-02_r8,0.27302e-02_r8,0.27267e-02_r8,0.27311e-02_r8,0.27351e-02_r8 /) + kbo(:,25, 4) = (/ & + & 0.23082e-02_r8,0.22984e-02_r8,0.22916e-02_r8,0.22928e-02_r8,0.22950e-02_r8 /) + kbo(:,26, 4) = (/ & + & 0.19386e-02_r8,0.19299e-02_r8,0.19241e-02_r8,0.19234e-02_r8,0.19234e-02_r8 /) + kbo(:,27, 4) = (/ & + & 0.16295e-02_r8,0.16227e-02_r8,0.16172e-02_r8,0.16132e-02_r8,0.16138e-02_r8 /) + kbo(:,28, 4) = (/ & + & 0.13714e-02_r8,0.13653e-02_r8,0.13589e-02_r8,0.13555e-02_r8,0.13562e-02_r8 /) + kbo(:,29, 4) = (/ & + & 0.11583e-02_r8,0.11513e-02_r8,0.11440e-02_r8,0.11416e-02_r8,0.11458e-02_r8 /) + kbo(:,30, 4) = (/ & + & 0.98213e-03_r8,0.97362e-03_r8,0.96774e-03_r8,0.96738e-03_r8,0.97898e-03_r8 /) + kbo(:,31, 4) = (/ & + & 0.83694e-03_r8,0.82733e-03_r8,0.82506e-03_r8,0.82584e-03_r8,0.83454e-03_r8 /) + kbo(:,32, 4) = (/ & + & 0.71631e-03_r8,0.70972e-03_r8,0.70944e-03_r8,0.70782e-03_r8,0.71382e-03_r8 /) + kbo(:,33, 4) = (/ & + & 0.62056e-03_r8,0.61607e-03_r8,0.61112e-03_r8,0.60974e-03_r8,0.61416e-03_r8 /) + kbo(:,34, 4) = (/ & + & 0.54260e-03_r8,0.53530e-03_r8,0.53018e-03_r8,0.53196e-03_r8,0.53190e-03_r8 /) + kbo(:,35, 4) = (/ & + & 0.47557e-03_r8,0.47060e-03_r8,0.46470e-03_r8,0.46463e-03_r8,0.46278e-03_r8 /) + kbo(:,36, 4) = (/ & + & 0.42108e-03_r8,0.41716e-03_r8,0.41356e-03_r8,0.41052e-03_r8,0.40671e-03_r8 /) + kbo(:,37, 4) = (/ & + & 0.36059e-03_r8,0.35753e-03_r8,0.35465e-03_r8,0.35204e-03_r8,0.34625e-03_r8 /) + kbo(:,38, 4) = (/ & + & 0.30926e-03_r8,0.30682e-03_r8,0.30403e-03_r8,0.30126e-03_r8,0.29597e-03_r8 /) + kbo(:,39, 4) = (/ & + & 0.26586e-03_r8,0.26397e-03_r8,0.26023e-03_r8,0.25654e-03_r8,0.25399e-03_r8 /) + kbo(:,40, 4) = (/ & + & 0.22228e-03_r8,0.22028e-03_r8,0.21711e-03_r8,0.21418e-03_r8,0.21203e-03_r8 /) + kbo(:,41, 4) = (/ & + & 0.18516e-03_r8,0.18277e-03_r8,0.18056e-03_r8,0.17797e-03_r8,0.17615e-03_r8 /) + kbo(:,42, 4) = (/ & + & 0.15367e-03_r8,0.15191e-03_r8,0.15012e-03_r8,0.14803e-03_r8,0.14667e-03_r8 /) + kbo(:,43, 4) = (/ & + & 0.12696e-03_r8,0.12546e-03_r8,0.12398e-03_r8,0.12239e-03_r8,0.12042e-03_r8 /) + kbo(:,44, 4) = (/ & + & 0.10470e-03_r8,0.10323e-03_r8,0.10199e-03_r8,0.10082e-03_r8,0.99093e-04_r8 /) + kbo(:,45, 4) = (/ & + & 0.86543e-04_r8,0.84786e-04_r8,0.83972e-04_r8,0.82789e-04_r8,0.81392e-04_r8 /) + kbo(:,46, 4) = (/ & + & 0.71529e-04_r8,0.69963e-04_r8,0.68982e-04_r8,0.67996e-04_r8,0.66867e-04_r8 /) + kbo(:,47, 4) = (/ & + & 0.59457e-04_r8,0.57707e-04_r8,0.56668e-04_r8,0.55899e-04_r8,0.54959e-04_r8 /) + kbo(:,48, 4) = (/ & + & 0.49467e-04_r8,0.47679e-04_r8,0.46593e-04_r8,0.45887e-04_r8,0.45090e-04_r8 /) + kbo(:,49, 4) = (/ & + & 0.40766e-04_r8,0.39435e-04_r8,0.38281e-04_r8,0.37548e-04_r8,0.37003e-04_r8 /) + kbo(:,50, 4) = (/ & + & 0.33628e-04_r8,0.32753e-04_r8,0.31623e-04_r8,0.30893e-04_r8,0.30385e-04_r8 /) + kbo(:,51, 4) = (/ & + & 0.27865e-04_r8,0.27055e-04_r8,0.26162e-04_r8,0.25458e-04_r8,0.24898e-04_r8 /) + kbo(:,52, 4) = (/ & + & 0.22934e-04_r8,0.22328e-04_r8,0.21731e-04_r8,0.20990e-04_r8,0.20456e-04_r8 /) + kbo(:,53, 4) = (/ & + & 0.18846e-04_r8,0.18445e-04_r8,0.17912e-04_r8,0.17357e-04_r8,0.16833e-04_r8 /) + kbo(:,54, 4) = (/ & + & 0.15388e-04_r8,0.15212e-04_r8,0.14808e-04_r8,0.14414e-04_r8,0.13935e-04_r8 /) + kbo(:,55, 4) = (/ & + & 0.12598e-04_r8,0.12543e-04_r8,0.12261e-04_r8,0.11957e-04_r8,0.11571e-04_r8 /) + kbo(:,56, 4) = (/ & + & 0.10381e-04_r8,0.10344e-04_r8,0.10166e-04_r8,0.98775e-05_r8,0.96020e-05_r8 /) + kbo(:,57, 4) = (/ & + & 0.85457e-05_r8,0.84639e-05_r8,0.83932e-05_r8,0.81757e-05_r8,0.79545e-05_r8 /) + kbo(:,58, 4) = (/ & + & 0.70397e-05_r8,0.69486e-05_r8,0.69316e-05_r8,0.67696e-05_r8,0.65859e-05_r8 /) + kbo(:,59, 4) = (/ & + & 0.58257e-05_r8,0.57596e-05_r8,0.57448e-05_r8,0.56300e-05_r8,0.54831e-05_r8 /) + kbo(:,13, 5) = (/ & + & 0.33040e-01_r8,0.33623e-01_r8,0.34360e-01_r8,0.35360e-01_r8,0.36383e-01_r8 /) + kbo(:,14, 5) = (/ & + & 0.28634e-01_r8,0.29145e-01_r8,0.29913e-01_r8,0.30773e-01_r8,0.31595e-01_r8 /) + kbo(:,15, 5) = (/ & + & 0.24852e-01_r8,0.25387e-01_r8,0.26038e-01_r8,0.26736e-01_r8,0.27406e-01_r8 /) + kbo(:,16, 5) = (/ & + & 0.21426e-01_r8,0.21995e-01_r8,0.22531e-01_r8,0.23082e-01_r8,0.23575e-01_r8 /) + kbo(:,17, 5) = (/ & + & 0.18563e-01_r8,0.19011e-01_r8,0.19492e-01_r8,0.19940e-01_r8,0.20337e-01_r8 /) + kbo(:,18, 5) = (/ & + & 0.16067e-01_r8,0.16476e-01_r8,0.16902e-01_r8,0.17235e-01_r8,0.17579e-01_r8 /) + kbo(:,19, 5) = (/ & + & 0.13911e-01_r8,0.14318e-01_r8,0.14657e-01_r8,0.14999e-01_r8,0.15265e-01_r8 /) + kbo(:,20, 5) = (/ & + & 0.11889e-01_r8,0.12220e-01_r8,0.12522e-01_r8,0.12793e-01_r8,0.13028e-01_r8 /) + kbo(:,21, 5) = (/ & + & 0.10107e-01_r8,0.10365e-01_r8,0.10626e-01_r8,0.10840e-01_r8,0.11030e-01_r8 /) + kbo(:,22, 5) = (/ & + & 0.85828e-02_r8,0.88037e-02_r8,0.90066e-02_r8,0.91828e-02_r8,0.93108e-02_r8 /) + kbo(:,23, 5) = (/ & + & 0.72873e-02_r8,0.74698e-02_r8,0.76229e-02_r8,0.77606e-02_r8,0.78812e-02_r8 /) + kbo(:,24, 5) = (/ & + & 0.61731e-02_r8,0.63486e-02_r8,0.64551e-02_r8,0.65686e-02_r8,0.66826e-02_r8 /) + kbo(:,25, 5) = (/ & + & 0.52349e-02_r8,0.53827e-02_r8,0.54728e-02_r8,0.55581e-02_r8,0.56691e-02_r8 /) + kbo(:,26, 5) = (/ & + & 0.44343e-02_r8,0.45615e-02_r8,0.46303e-02_r8,0.47140e-02_r8,0.48058e-02_r8 /) + kbo(:,27, 5) = (/ & + & 0.37566e-02_r8,0.38599e-02_r8,0.39250e-02_r8,0.39996e-02_r8,0.40739e-02_r8 /) + kbo(:,28, 5) = (/ & + & 0.31898e-02_r8,0.32700e-02_r8,0.33284e-02_r8,0.33863e-02_r8,0.34483e-02_r8 /) + kbo(:,29, 5) = (/ & + & 0.27069e-02_r8,0.27638e-02_r8,0.28173e-02_r8,0.28668e-02_r8,0.29159e-02_r8 /) + kbo(:,30, 5) = (/ & + & 0.22952e-02_r8,0.23414e-02_r8,0.23862e-02_r8,0.24319e-02_r8,0.25045e-02_r8 /) + kbo(:,31, 5) = (/ & + & 0.19469e-02_r8,0.19866e-02_r8,0.20269e-02_r8,0.20617e-02_r8,0.21285e-02_r8 /) + kbo(:,32, 5) = (/ & + & 0.16569e-02_r8,0.16912e-02_r8,0.17225e-02_r8,0.17537e-02_r8,0.18151e-02_r8 /) + kbo(:,33, 5) = (/ & + & 0.14159e-02_r8,0.14407e-02_r8,0.14672e-02_r8,0.14987e-02_r8,0.15568e-02_r8 /) + kbo(:,34, 5) = (/ & + & 0.12124e-02_r8,0.12314e-02_r8,0.12565e-02_r8,0.13096e-02_r8,0.13455e-02_r8 /) + kbo(:,35, 5) = (/ & + & 0.10402e-02_r8,0.10574e-02_r8,0.10852e-02_r8,0.11323e-02_r8,0.11671e-02_r8 /) + kbo(:,36, 5) = (/ & + & 0.89606e-03_r8,0.91393e-03_r8,0.93957e-03_r8,0.98258e-03_r8,0.10142e-02_r8 /) + kbo(:,37, 5) = (/ & + & 0.75556e-03_r8,0.77347e-03_r8,0.79494e-03_r8,0.83337e-03_r8,0.86466e-03_r8 /) + kbo(:,38, 5) = (/ & + & 0.63793e-03_r8,0.65386e-03_r8,0.67373e-03_r8,0.70925e-03_r8,0.73610e-03_r8 /) + kbo(:,39, 5) = (/ & + & 0.53995e-03_r8,0.55394e-03_r8,0.57091e-03_r8,0.59316e-03_r8,0.62725e-03_r8 /) + kbo(:,40, 5) = (/ & + & 0.44830e-03_r8,0.46041e-03_r8,0.47605e-03_r8,0.49517e-03_r8,0.52406e-03_r8 /) + kbo(:,41, 5) = (/ & + & 0.37113e-03_r8,0.38143e-03_r8,0.39555e-03_r8,0.41230e-03_r8,0.43648e-03_r8 /) + kbo(:,42, 5) = (/ & + & 0.30743e-03_r8,0.31617e-03_r8,0.32840e-03_r8,0.34246e-03_r8,0.36323e-03_r8 /) + kbo(:,43, 5) = (/ & + & 0.25237e-03_r8,0.25981e-03_r8,0.27013e-03_r8,0.28179e-03_r8,0.29414e-03_r8 /) + kbo(:,44, 5) = (/ & + & 0.20643e-03_r8,0.21247e-03_r8,0.22138e-03_r8,0.23093e-03_r8,0.24175e-03_r8 /) + kbo(:,45, 5) = (/ & + & 0.16882e-03_r8,0.17379e-03_r8,0.18072e-03_r8,0.18917e-03_r8,0.19837e-03_r8 /) + kbo(:,46, 5) = (/ & + & 0.13808e-03_r8,0.14140e-03_r8,0.14740e-03_r8,0.15462e-03_r8,0.16243e-03_r8 /) + kbo(:,47, 5) = (/ & + & 0.11262e-03_r8,0.11523e-03_r8,0.12010e-03_r8,0.12571e-03_r8,0.13225e-03_r8 /) + kbo(:,48, 5) = (/ & + & 0.91738e-04_r8,0.93816e-04_r8,0.97414e-04_r8,0.10204e-03_r8,0.10733e-03_r8 /) + kbo(:,49, 5) = (/ & + & 0.74533e-04_r8,0.76356e-04_r8,0.78756e-04_r8,0.82697e-04_r8,0.86848e-04_r8 /) + kbo(:,50, 5) = (/ & + & 0.60870e-04_r8,0.62211e-04_r8,0.64031e-04_r8,0.67056e-04_r8,0.70590e-04_r8 /) + kbo(:,51, 5) = (/ & + & 0.49547e-04_r8,0.50786e-04_r8,0.52181e-04_r8,0.54428e-04_r8,0.57574e-04_r8 /) + kbo(:,52, 5) = (/ & + & 0.40457e-04_r8,0.41364e-04_r8,0.42403e-04_r8,0.44095e-04_r8,0.46746e-04_r8 /) + kbo(:,53, 5) = (/ & + & 0.33032e-04_r8,0.33540e-04_r8,0.34449e-04_r8,0.35762e-04_r8,0.37780e-04_r8 /) + kbo(:,54, 5) = (/ & + & 0.27201e-04_r8,0.27411e-04_r8,0.28166e-04_r8,0.29168e-04_r8,0.30744e-04_r8 /) + kbo(:,55, 5) = (/ & + & 0.22471e-04_r8,0.22532e-04_r8,0.23075e-04_r8,0.23887e-04_r8,0.25092e-04_r8 /) + kbo(:,56, 5) = (/ & + & 0.18480e-04_r8,0.18516e-04_r8,0.18857e-04_r8,0.19555e-04_r8,0.20483e-04_r8 /) + kbo(:,57, 5) = (/ & + & 0.15198e-04_r8,0.15262e-04_r8,0.15424e-04_r8,0.15989e-04_r8,0.16742e-04_r8 /) + kbo(:,58, 5) = (/ & + & 0.12523e-04_r8,0.12562e-04_r8,0.12648e-04_r8,0.13089e-04_r8,0.13686e-04_r8 /) + kbo(:,59, 5) = (/ & + & 0.10416e-04_r8,0.10433e-04_r8,0.10536e-04_r8,0.10919e-04_r8,0.11421e-04_r8 /) + kbo(:,13, 6) = (/ & + & 0.69718e-01_r8,0.71167e-01_r8,0.72961e-01_r8,0.74885e-01_r8,0.77322e-01_r8 /) + kbo(:,14, 6) = (/ & + & 0.62182e-01_r8,0.63649e-01_r8,0.65193e-01_r8,0.67193e-01_r8,0.69746e-01_r8 /) + kbo(:,15, 6) = (/ & + & 0.55177e-01_r8,0.56711e-01_r8,0.58414e-01_r8,0.60422e-01_r8,0.62756e-01_r8 /) + kbo(:,16, 6) = (/ & + & 0.48867e-01_r8,0.50234e-01_r8,0.52023e-01_r8,0.54055e-01_r8,0.56254e-01_r8 /) + kbo(:,17, 6) = (/ & + & 0.43174e-01_r8,0.44610e-01_r8,0.46287e-01_r8,0.48302e-01_r8,0.50389e-01_r8 /) + kbo(:,18, 6) = (/ & + & 0.38339e-01_r8,0.39749e-01_r8,0.41335e-01_r8,0.43237e-01_r8,0.45123e-01_r8 /) + kbo(:,19, 6) = (/ & + & 0.34315e-01_r8,0.35543e-01_r8,0.37065e-01_r8,0.38754e-01_r8,0.40597e-01_r8 /) + kbo(:,20, 6) = (/ & + & 0.30036e-01_r8,0.31291e-01_r8,0.32637e-01_r8,0.34202e-01_r8,0.35839e-01_r8 /) + kbo(:,21, 6) = (/ & + & 0.26135e-01_r8,0.27343e-01_r8,0.28574e-01_r8,0.30000e-01_r8,0.31460e-01_r8 /) + kbo(:,22, 6) = (/ & + & 0.22750e-01_r8,0.23832e-01_r8,0.25080e-01_r8,0.26299e-01_r8,0.27580e-01_r8 /) + kbo(:,23, 6) = (/ & + & 0.19795e-01_r8,0.20915e-01_r8,0.22028e-01_r8,0.23060e-01_r8,0.24140e-01_r8 /) + kbo(:,24, 6) = (/ & + & 0.17353e-01_r8,0.18346e-01_r8,0.19305e-01_r8,0.20238e-01_r8,0.21103e-01_r8 /) + kbo(:,25, 6) = (/ & + & 0.15226e-01_r8,0.16064e-01_r8,0.16955e-01_r8,0.17722e-01_r8,0.18477e-01_r8 /) + kbo(:,26, 6) = (/ & + & 0.13309e-01_r8,0.14087e-01_r8,0.14848e-01_r8,0.15498e-01_r8,0.16180e-01_r8 /) + kbo(:,27, 6) = (/ & + & 0.11623e-01_r8,0.12295e-01_r8,0.12913e-01_r8,0.13525e-01_r8,0.14113e-01_r8 /) + kbo(:,28, 6) = (/ & + & 0.10147e-01_r8,0.10710e-01_r8,0.11240e-01_r8,0.11795e-01_r8,0.12384e-01_r8 /) + kbo(:,29, 6) = (/ & + & 0.87968e-02_r8,0.92904e-02_r8,0.97797e-02_r8,0.10288e-01_r8,0.10828e-01_r8 /) + kbo(:,30, 6) = (/ & + & 0.76490e-02_r8,0.80771e-02_r8,0.85219e-02_r8,0.90152e-02_r8,0.97888e-02_r8 /) + kbo(:,31, 6) = (/ & + & 0.66330e-02_r8,0.70376e-02_r8,0.74659e-02_r8,0.79113e-02_r8,0.86622e-02_r8 /) + kbo(:,32, 6) = (/ & + & 0.58073e-02_r8,0.61697e-02_r8,0.65754e-02_r8,0.70309e-02_r8,0.77115e-02_r8 /) + kbo(:,33, 6) = (/ & + & 0.51062e-02_r8,0.54682e-02_r8,0.58582e-02_r8,0.62737e-02_r8,0.69163e-02_r8 /) + kbo(:,34, 6) = (/ & + & 0.45302e-02_r8,0.48855e-02_r8,0.52639e-02_r8,0.58227e-02_r8,0.62719e-02_r8 /) + kbo(:,35, 6) = (/ & + & 0.40254e-02_r8,0.43599e-02_r8,0.47158e-02_r8,0.52732e-02_r8,0.57228e-02_r8 /) + kbo(:,36, 6) = (/ & + & 0.35647e-02_r8,0.38837e-02_r8,0.42167e-02_r8,0.47705e-02_r8,0.52032e-02_r8 /) + kbo(:,37, 6) = (/ & + & 0.30730e-02_r8,0.33561e-02_r8,0.36823e-02_r8,0.41868e-02_r8,0.45932e-02_r8 /) + kbo(:,38, 6) = (/ & + & 0.26407e-02_r8,0.29052e-02_r8,0.32061e-02_r8,0.36781e-02_r8,0.40664e-02_r8 /) + kbo(:,39, 6) = (/ & + & 0.22667e-02_r8,0.25156e-02_r8,0.28017e-02_r8,0.31173e-02_r8,0.36136e-02_r8 /) + kbo(:,40, 6) = (/ & + & 0.19056e-02_r8,0.21267e-02_r8,0.23879e-02_r8,0.26789e-02_r8,0.31309e-02_r8 /) + kbo(:,41, 6) = (/ & + & 0.15967e-02_r8,0.17952e-02_r8,0.20263e-02_r8,0.22865e-02_r8,0.27062e-02_r8 /) + kbo(:,42, 6) = (/ & + & 0.13343e-02_r8,0.15081e-02_r8,0.17167e-02_r8,0.19538e-02_r8,0.23416e-02_r8 /) + kbo(:,43, 6) = (/ & + & 0.10981e-02_r8,0.12492e-02_r8,0.14292e-02_r8,0.16430e-02_r8,0.19013e-02_r8 /) + kbo(:,44, 6) = (/ & + & 0.89464e-03_r8,0.10267e-02_r8,0.11827e-02_r8,0.13698e-02_r8,0.16046e-02_r8 /) + kbo(:,45, 6) = (/ & + & 0.72683e-03_r8,0.83985e-03_r8,0.97469e-03_r8,0.11376e-02_r8,0.13459e-02_r8 /) + kbo(:,46, 6) = (/ & + & 0.58610e-03_r8,0.68242e-03_r8,0.79873e-03_r8,0.94079e-03_r8,0.11248e-02_r8 /) + kbo(:,47, 6) = (/ & + & 0.46823e-03_r8,0.54958e-03_r8,0.64876e-03_r8,0.77111e-03_r8,0.93276e-03_r8 /) + kbo(:,48, 6) = (/ & + & 0.37202e-03_r8,0.44089e-03_r8,0.52431e-03_r8,0.62811e-03_r8,0.76979e-03_r8 /) + kbo(:,49, 6) = (/ & + & 0.29424e-03_r8,0.35087e-03_r8,0.42017e-03_r8,0.50926e-03_r8,0.63166e-03_r8 /) + kbo(:,50, 6) = (/ & + & 0.23381e-03_r8,0.28036e-03_r8,0.33854e-03_r8,0.41547e-03_r8,0.52066e-03_r8 /) + kbo(:,51, 6) = (/ & + & 0.18542e-03_r8,0.22410e-03_r8,0.27211e-03_r8,0.33806e-03_r8,0.42775e-03_r8 /) + kbo(:,52, 6) = (/ & + & 0.14646e-03_r8,0.17824e-03_r8,0.21799e-03_r8,0.27400e-03_r8,0.34964e-03_r8 /) + kbo(:,53, 6) = (/ & + & 0.11499e-03_r8,0.14049e-03_r8,0.17412e-03_r8,0.22038e-03_r8,0.28435e-03_r8 /) + kbo(:,54, 6) = (/ & + & 0.91160e-04_r8,0.11217e-03_r8,0.13972e-03_r8,0.17793e-03_r8,0.23213e-03_r8 /) + kbo(:,55, 6) = (/ & + & 0.72474e-04_r8,0.89606e-04_r8,0.11228e-03_r8,0.14368e-03_r8,0.18928e-03_r8 /) + kbo(:,56, 6) = (/ & + & 0.57463e-04_r8,0.71291e-04_r8,0.89786e-04_r8,0.11554e-03_r8,0.15352e-03_r8 /) + kbo(:,57, 6) = (/ & + & 0.45287e-04_r8,0.56571e-04_r8,0.71524e-04_r8,0.92319e-04_r8,0.12382e-03_r8 /) + kbo(:,58, 6) = (/ & + & 0.35841e-04_r8,0.44939e-04_r8,0.57025e-04_r8,0.73710e-04_r8,0.99673e-04_r8 /) + kbo(:,59, 6) = (/ & + & 0.29941e-04_r8,0.37721e-04_r8,0.48119e-04_r8,0.62420e-04_r8,0.85059e-04_r8 /) + kbo(:,13, 7) = (/ & + & 0.16189e+00_r8,0.16561e+00_r8,0.16999e+00_r8,0.17514e+00_r8,0.18068e+00_r8 /) + kbo(:,14, 7) = (/ & + & 0.14981e+00_r8,0.15416e+00_r8,0.15917e+00_r8,0.16420e+00_r8,0.16989e+00_r8 /) + kbo(:,15, 7) = (/ & + & 0.13875e+00_r8,0.14297e+00_r8,0.14757e+00_r8,0.15249e+00_r8,0.15852e+00_r8 /) + kbo(:,16, 7) = (/ & + & 0.12672e+00_r8,0.13073e+00_r8,0.13523e+00_r8,0.14037e+00_r8,0.14640e+00_r8 /) + kbo(:,17, 7) = (/ & + & 0.11530e+00_r8,0.11958e+00_r8,0.12450e+00_r8,0.12975e+00_r8,0.13596e+00_r8 /) + kbo(:,18, 7) = (/ & + & 0.10572e+00_r8,0.11005e+00_r8,0.11482e+00_r8,0.12031e+00_r8,0.12674e+00_r8 /) + kbo(:,19, 7) = (/ & + & 0.97798e-01_r8,0.10221e+00_r8,0.10713e+00_r8,0.11251e+00_r8,0.11882e+00_r8 /) + kbo(:,20, 7) = (/ & + & 0.88438e-01_r8,0.93059e-01_r8,0.98290e-01_r8,0.10406e+00_r8,0.11034e+00_r8 /) + kbo(:,21, 7) = (/ & + & 0.79615e-01_r8,0.84383e-01_r8,0.89776e-01_r8,0.95707e-01_r8,0.10218e+00_r8 /) + kbo(:,22, 7) = (/ & + & 0.71663e-01_r8,0.76568e-01_r8,0.81968e-01_r8,0.88106e-01_r8,0.94703e-01_r8 /) + kbo(:,23, 7) = (/ & + & 0.64729e-01_r8,0.69601e-01_r8,0.75178e-01_r8,0.81445e-01_r8,0.88072e-01_r8 /) + kbo(:,24, 7) = (/ & + & 0.58713e-01_r8,0.63692e-01_r8,0.69398e-01_r8,0.75609e-01_r8,0.82402e-01_r8 /) + kbo(:,25, 7) = (/ & + & 0.53422e-01_r8,0.58504e-01_r8,0.64255e-01_r8,0.70582e-01_r8,0.77266e-01_r8 /) + kbo(:,26, 7) = (/ & + & 0.48884e-01_r8,0.53907e-01_r8,0.59754e-01_r8,0.66093e-01_r8,0.72781e-01_r8 /) + kbo(:,27, 7) = (/ & + & 0.44782e-01_r8,0.49959e-01_r8,0.55649e-01_r8,0.61937e-01_r8,0.68517e-01_r8 /) + kbo(:,28, 7) = (/ & + & 0.41164e-01_r8,0.46305e-01_r8,0.52009e-01_r8,0.58205e-01_r8,0.64389e-01_r8 /) + kbo(:,29, 7) = (/ & + & 0.37976e-01_r8,0.43033e-01_r8,0.48696e-01_r8,0.54470e-01_r8,0.60707e-01_r8 /) + kbo(:,30, 7) = (/ & + & 0.35210e-01_r8,0.40258e-01_r8,0.45653e-01_r8,0.51435e-01_r8,0.59091e-01_r8 /) + kbo(:,31, 7) = (/ & + & 0.32774e-01_r8,0.37557e-01_r8,0.43028e-01_r8,0.48762e-01_r8,0.56208e-01_r8 /) + kbo(:,32, 7) = (/ & + & 0.30628e-01_r8,0.35555e-01_r8,0.40840e-01_r8,0.46513e-01_r8,0.53917e-01_r8 /) + kbo(:,33, 7) = (/ & + & 0.29120e-01_r8,0.33908e-01_r8,0.39209e-01_r8,0.44801e-01_r8,0.52179e-01_r8 /) + kbo(:,34, 7) = (/ & + & 0.27843e-01_r8,0.32610e-01_r8,0.37873e-01_r8,0.45101e-01_r8,0.51127e-01_r8 /) + kbo(:,35, 7) = (/ & + & 0.26429e-01_r8,0.31201e-01_r8,0.36480e-01_r8,0.43796e-01_r8,0.49886e-01_r8 /) + kbo(:,36, 7) = (/ & + & 0.24910e-01_r8,0.29603e-01_r8,0.34935e-01_r8,0.42317e-01_r8,0.48474e-01_r8 /) + kbo(:,37, 7) = (/ & + & 0.22623e-01_r8,0.27186e-01_r8,0.32364e-01_r8,0.39709e-01_r8,0.45895e-01_r8 /) + kbo(:,38, 7) = (/ & + & 0.20536e-01_r8,0.25035e-01_r8,0.30138e-01_r8,0.37341e-01_r8,0.43584e-01_r8 /) + kbo(:,39, 7) = (/ & + & 0.18744e-01_r8,0.23143e-01_r8,0.28133e-01_r8,0.33754e-01_r8,0.41569e-01_r8 /) + kbo(:,40, 7) = (/ & + & 0.16632e-01_r8,0.20751e-01_r8,0.25556e-01_r8,0.30972e-01_r8,0.38593e-01_r8 /) + kbo(:,41, 7) = (/ & + & 0.14671e-01_r8,0.18541e-01_r8,0.23110e-01_r8,0.28292e-01_r8,0.35702e-01_r8 /) + kbo(:,42, 7) = (/ & + & 0.12909e-01_r8,0.16573e-01_r8,0.20901e-01_r8,0.25885e-01_r8,0.32997e-01_r8 /) + kbo(:,43, 7) = (/ & + & 0.11155e-01_r8,0.14521e-01_r8,0.18561e-01_r8,0.23268e-01_r8,0.28558e-01_r8 /) + kbo(:,44, 7) = (/ & + & 0.95144e-02_r8,0.12576e-01_r8,0.16313e-01_r8,0.20662e-01_r8,0.25638e-01_r8 /) + kbo(:,45, 7) = (/ & + & 0.80643e-02_r8,0.10847e-01_r8,0.14290e-01_r8,0.18347e-01_r8,0.23034e-01_r8 /) + kbo(:,46, 7) = (/ & + & 0.67589e-02_r8,0.92659e-02_r8,0.12372e-01_r8,0.16082e-01_r8,0.20456e-01_r8 /) + kbo(:,47, 7) = (/ & + & 0.55482e-02_r8,0.77474e-02_r8,0.10528e-01_r8,0.13920e-01_r8,0.17966e-01_r8 /) + kbo(:,48, 7) = (/ & + & 0.45013e-02_r8,0.64175e-02_r8,0.88907e-02_r8,0.11958e-01_r8,0.15638e-01_r8 /) + kbo(:,49, 7) = (/ & + & 0.36173e-02_r8,0.52743e-02_r8,0.74530e-02_r8,0.10200e-01_r8,0.13544e-01_r8 /) + kbo(:,50, 7) = (/ & + & 0.29073e-02_r8,0.43372e-02_r8,0.62514e-02_r8,0.87078e-02_r8,0.11757e-01_r8 /) + kbo(:,51, 7) = (/ & + & 0.23200e-02_r8,0.35429e-02_r8,0.52236e-02_r8,0.74160e-02_r8,0.10190e-01_r8 /) + kbo(:,52, 7) = (/ & + & 0.18398e-02_r8,0.28704e-02_r8,0.43321e-02_r8,0.62743e-02_r8,0.87585e-02_r8 /) + kbo(:,53, 7) = (/ & + & 0.14394e-02_r8,0.22999e-02_r8,0.35535e-02_r8,0.52615e-02_r8,0.74854e-02_r8 /) + kbo(:,54, 7) = (/ & + & 0.11368e-02_r8,0.18545e-02_r8,0.29326e-02_r8,0.44372e-02_r8,0.64347e-02_r8 /) + kbo(:,55, 7) = (/ & + & 0.89467e-03_r8,0.14935e-02_r8,0.24197e-02_r8,0.37410e-02_r8,0.55222e-02_r8 /) + kbo(:,56, 7) = (/ & + & 0.69687e-03_r8,0.11894e-02_r8,0.19763e-02_r8,0.31286e-02_r8,0.47149e-02_r8 /) + kbo(:,57, 7) = (/ & + & 0.53791e-03_r8,0.93747e-03_r8,0.15990e-02_r8,0.25976e-02_r8,0.39986e-02_r8 /) + kbo(:,58, 7) = (/ & + & 0.41410e-03_r8,0.73971e-03_r8,0.12907e-02_r8,0.21482e-02_r8,0.33858e-02_r8 /) + kbo(:,59, 7) = (/ & + & 0.35405e-03_r8,0.64717e-03_r8,0.11503e-02_r8,0.19466e-02_r8,0.31094e-02_r8 /) + kbo(:,13, 8) = (/ & + & 0.45516e+00_r8,0.46955e+00_r8,0.48450e+00_r8,0.50029e+00_r8,0.51769e+00_r8 /) + kbo(:,14, 8) = (/ & + & 0.43991e+00_r8,0.45312e+00_r8,0.46646e+00_r8,0.48116e+00_r8,0.49718e+00_r8 /) + kbo(:,15, 8) = (/ & + & 0.42871e+00_r8,0.44246e+00_r8,0.45762e+00_r8,0.47406e+00_r8,0.49132e+00_r8 /) + kbo(:,16, 8) = (/ & + & 0.40699e+00_r8,0.42153e+00_r8,0.43710e+00_r8,0.45468e+00_r8,0.47435e+00_r8 /) + kbo(:,17, 8) = (/ & + & 0.38538e+00_r8,0.39940e+00_r8,0.41418e+00_r8,0.43146e+00_r8,0.45140e+00_r8 /) + kbo(:,18, 8) = (/ & + & 0.36235e+00_r8,0.37741e+00_r8,0.39391e+00_r8,0.41121e+00_r8,0.43054e+00_r8 /) + kbo(:,19, 8) = (/ & + & 0.34180e+00_r8,0.35677e+00_r8,0.37295e+00_r8,0.39070e+00_r8,0.41121e+00_r8 /) + kbo(:,20, 8) = (/ & + & 0.31818e+00_r8,0.33243e+00_r8,0.34824e+00_r8,0.36683e+00_r8,0.38832e+00_r8 /) + kbo(:,21, 8) = (/ & + & 0.29454e+00_r8,0.30892e+00_r8,0.32519e+00_r8,0.34434e+00_r8,0.36621e+00_r8 /) + kbo(:,22, 8) = (/ & + & 0.27292e+00_r8,0.28819e+00_r8,0.30567e+00_r8,0.32553e+00_r8,0.34730e+00_r8 /) + kbo(:,23, 8) = (/ & + & 0.25455e+00_r8,0.27053e+00_r8,0.28810e+00_r8,0.30845e+00_r8,0.33065e+00_r8 /) + kbo(:,24, 8) = (/ & + & 0.23920e+00_r8,0.25523e+00_r8,0.27293e+00_r8,0.29370e+00_r8,0.31644e+00_r8 /) + kbo(:,25, 8) = (/ & + & 0.22572e+00_r8,0.24152e+00_r8,0.26024e+00_r8,0.28092e+00_r8,0.30402e+00_r8 /) + kbo(:,26, 8) = (/ & + & 0.21333e+00_r8,0.23053e+00_r8,0.24913e+00_r8,0.27069e+00_r8,0.29445e+00_r8 /) + kbo(:,27, 8) = (/ & + & 0.20216e+00_r8,0.22006e+00_r8,0.23987e+00_r8,0.26172e+00_r8,0.28552e+00_r8 /) + kbo(:,28, 8) = (/ & + & 0.19243e+00_r8,0.21106e+00_r8,0.23162e+00_r8,0.25373e+00_r8,0.27880e+00_r8 /) + kbo(:,29, 8) = (/ & + & 0.18399e+00_r8,0.20352e+00_r8,0.22446e+00_r8,0.24815e+00_r8,0.27383e+00_r8 /) + kbo(:,30, 8) = (/ & + & 0.17696e+00_r8,0.19707e+00_r8,0.21934e+00_r8,0.24428e+00_r8,0.27560e+00_r8 /) + kbo(:,31, 8) = (/ & + & 0.17154e+00_r8,0.19276e+00_r8,0.21622e+00_r8,0.24297e+00_r8,0.27512e+00_r8 /) + kbo(:,32, 8) = (/ & + & 0.16864e+00_r8,0.19074e+00_r8,0.21586e+00_r8,0.24341e+00_r8,0.27678e+00_r8 /) + kbo(:,33, 8) = (/ & + & 0.16705e+00_r8,0.19103e+00_r8,0.21725e+00_r8,0.24571e+00_r8,0.27988e+00_r8 /) + kbo(:,34, 8) = (/ & + & 0.16718e+00_r8,0.19214e+00_r8,0.21923e+00_r8,0.25236e+00_r8,0.28358e+00_r8 /) + kbo(:,35, 8) = (/ & + & 0.16615e+00_r8,0.19194e+00_r8,0.21973e+00_r8,0.25386e+00_r8,0.28528e+00_r8 /) + kbo(:,36, 8) = (/ & + & 0.16355e+00_r8,0.18981e+00_r8,0.21857e+00_r8,0.25318e+00_r8,0.28503e+00_r8 /) + kbo(:,37, 8) = (/ & + & 0.15644e+00_r8,0.18272e+00_r8,0.21137e+00_r8,0.24627e+00_r8,0.27830e+00_r8 /) + kbo(:,38, 8) = (/ & + & 0.14985e+00_r8,0.17574e+00_r8,0.20437e+00_r8,0.23950e+00_r8,0.27160e+00_r8 /) + kbo(:,39, 8) = (/ & + & 0.14373e+00_r8,0.16918e+00_r8,0.19762e+00_r8,0.22814e+00_r8,0.26522e+00_r8 /) + kbo(:,40, 8) = (/ & + & 0.13479e+00_r8,0.15968e+00_r8,0.18756e+00_r8,0.21775e+00_r8,0.25463e+00_r8 /) + kbo(:,41, 8) = (/ & + & 0.12605e+00_r8,0.15045e+00_r8,0.17752e+00_r8,0.20726e+00_r8,0.24367e+00_r8 /) + kbo(:,42, 8) = (/ & + & 0.11784e+00_r8,0.14153e+00_r8,0.16784e+00_r8,0.19712e+00_r8,0.23353e+00_r8 /) + kbo(:,43, 8) = (/ & + & 0.10839e+00_r8,0.13122e+00_r8,0.15696e+00_r8,0.18528e+00_r8,0.21641e+00_r8 /) + kbo(:,44, 8) = (/ & + & 0.98772e-01_r8,0.12078e+00_r8,0.14549e+00_r8,0.17313e+00_r8,0.20344e+00_r8 /) + kbo(:,45, 8) = (/ & + & 0.89757e-01_r8,0.11096e+00_r8,0.13484e+00_r8,0.16135e+00_r8,0.19086e+00_r8 /) + kbo(:,46, 8) = (/ & + & 0.80754e-01_r8,0.10111e+00_r8,0.12397e+00_r8,0.14951e+00_r8,0.17812e+00_r8 /) + kbo(:,47, 8) = (/ & + & 0.71551e-01_r8,0.90848e-01_r8,0.11265e+00_r8,0.13712e+00_r8,0.16456e+00_r8 /) + kbo(:,48, 8) = (/ & + & 0.63023e-01_r8,0.81188e-01_r8,0.10192e+00_r8,0.12530e+00_r8,0.15155e+00_r8 /) + kbo(:,49, 8) = (/ & + & 0.55112e-01_r8,0.71966e-01_r8,0.91627e-01_r8,0.11386e+00_r8,0.13887e+00_r8 /) + kbo(:,50, 8) = (/ & + & 0.48148e-01_r8,0.63904e-01_r8,0.82545e-01_r8,0.10380e+00_r8,0.12775e+00_r8 /) + kbo(:,51, 8) = (/ & + & 0.42077e-01_r8,0.56742e-01_r8,0.74219e-01_r8,0.94436e-01_r8,0.11735e+00_r8 /) + kbo(:,52, 8) = (/ & + & 0.36406e-01_r8,0.49929e-01_r8,0.66400e-01_r8,0.85557e-01_r8,0.10751e+00_r8 /) + kbo(:,53, 8) = (/ & + & 0.31162e-01_r8,0.43645e-01_r8,0.58971e-01_r8,0.77049e-01_r8,0.97772e-01_r8 /) + kbo(:,54, 8) = (/ & + & 0.26848e-01_r8,0.38389e-01_r8,0.52700e-01_r8,0.69937e-01_r8,0.89664e-01_r8 /) + kbo(:,55, 8) = (/ & + & 0.23145e-01_r8,0.33793e-01_r8,0.47177e-01_r8,0.63590e-01_r8,0.82440e-01_r8 /) + kbo(:,56, 8) = (/ & + & 0.19764e-01_r8,0.29522e-01_r8,0.42050e-01_r8,0.57472e-01_r8,0.75623e-01_r8 /) + kbo(:,57, 8) = (/ & + & 0.16713e-01_r8,0.25602e-01_r8,0.37259e-01_r8,0.51705e-01_r8,0.68976e-01_r8 /) + kbo(:,58, 8) = (/ & + & 0.14134e-01_r8,0.22215e-01_r8,0.32983e-01_r8,0.46579e-01_r8,0.62982e-01_r8 /) + kbo(:,59, 8) = (/ & + & 0.13103e-01_r8,0.20874e-01_r8,0.31397e-01_r8,0.44700e-01_r8,0.60881e-01_r8 /) + kbo(:,13, 9) = (/ & + & 0.30563e+01_r8,0.31744e+01_r8,0.32842e+01_r8,0.33901e+01_r8,0.34937e+01_r8 /) + kbo(:,14, 9) = (/ & + & 0.27752e+01_r8,0.28869e+01_r8,0.29933e+01_r8,0.30958e+01_r8,0.31932e+01_r8 /) + kbo(:,15, 9) = (/ & + & 0.25099e+01_r8,0.26164e+01_r8,0.27185e+01_r8,0.28161e+01_r8,0.29094e+01_r8 /) + kbo(:,16, 9) = (/ & + & 0.23062e+01_r8,0.23985e+01_r8,0.24887e+01_r8,0.25791e+01_r8,0.26657e+01_r8 /) + kbo(:,17, 9) = (/ & + & 0.21996e+01_r8,0.22783e+01_r8,0.23521e+01_r8,0.24248e+01_r8,0.25028e+01_r8 /) + kbo(:,18, 9) = (/ & + & 0.22125e+01_r8,0.22932e+01_r8,0.23665e+01_r8,0.24375e+01_r8,0.25051e+01_r8 /) + kbo(:,19, 9) = (/ & + & 0.22641e+01_r8,0.23491e+01_r8,0.24239e+01_r8,0.24973e+01_r8,0.25657e+01_r8 /) + kbo(:,20, 9) = (/ & + & 0.22472e+01_r8,0.23357e+01_r8,0.24204e+01_r8,0.24964e+01_r8,0.25675e+01_r8 /) + kbo(:,21, 9) = (/ & + & 0.21851e+01_r8,0.22830e+01_r8,0.23690e+01_r8,0.24562e+01_r8,0.25370e+01_r8 /) + kbo(:,22, 9) = (/ & + & 0.21175e+01_r8,0.22142e+01_r8,0.23108e+01_r8,0.24049e+01_r8,0.24949e+01_r8 /) + kbo(:,23, 9) = (/ & + & 0.20447e+01_r8,0.21452e+01_r8,0.22435e+01_r8,0.23385e+01_r8,0.24298e+01_r8 /) + kbo(:,24, 9) = (/ & + & 0.19721e+01_r8,0.20737e+01_r8,0.21717e+01_r8,0.22760e+01_r8,0.23715e+01_r8 /) + kbo(:,25, 9) = (/ & + & 0.18957e+01_r8,0.20036e+01_r8,0.21100e+01_r8,0.22176e+01_r8,0.23221e+01_r8 /) + kbo(:,26, 9) = (/ & + & 0.18288e+01_r8,0.19378e+01_r8,0.20515e+01_r8,0.21609e+01_r8,0.22728e+01_r8 /) + kbo(:,27, 9) = (/ & + & 0.17692e+01_r8,0.18810e+01_r8,0.19951e+01_r8,0.21151e+01_r8,0.22361e+01_r8 /) + kbo(:,28, 9) = (/ & + & 0.17168e+01_r8,0.18338e+01_r8,0.19558e+01_r8,0.20789e+01_r8,0.22051e+01_r8 /) + kbo(:,29, 9) = (/ & + & 0.16702e+01_r8,0.17936e+01_r8,0.19235e+01_r8,0.20524e+01_r8,0.21850e+01_r8 /) + kbo(:,30, 9) = (/ & + & 0.16394e+01_r8,0.17677e+01_r8,0.19029e+01_r8,0.20369e+01_r8,0.21882e+01_r8 /) + kbo(:,31, 9) = (/ & + & 0.16228e+01_r8,0.17523e+01_r8,0.18896e+01_r8,0.20262e+01_r8,0.21815e+01_r8 /) + kbo(:,32, 9) = (/ & + & 0.16178e+01_r8,0.17489e+01_r8,0.18859e+01_r8,0.20233e+01_r8,0.21838e+01_r8 /) + kbo(:,33, 9) = (/ & + & 0.16221e+01_r8,0.17529e+01_r8,0.18876e+01_r8,0.20327e+01_r8,0.21960e+01_r8 /) + kbo(:,34, 9) = (/ & + & 0.16321e+01_r8,0.17688e+01_r8,0.19069e+01_r8,0.20650e+01_r8,0.22191e+01_r8 /) + kbo(:,35, 9) = (/ & + & 0.16388e+01_r8,0.17830e+01_r8,0.19261e+01_r8,0.20887e+01_r8,0.22365e+01_r8 /) + kbo(:,36, 9) = (/ & + & 0.16423e+01_r8,0.17895e+01_r8,0.19390e+01_r8,0.21032e+01_r8,0.22561e+01_r8 /) + kbo(:,37, 9) = (/ & + & 0.16080e+01_r8,0.17565e+01_r8,0.19076e+01_r8,0.20741e+01_r8,0.22287e+01_r8 /) + kbo(:,38, 9) = (/ & + & 0.15745e+01_r8,0.17245e+01_r8,0.18721e+01_r8,0.20419e+01_r8,0.21969e+01_r8 /) + kbo(:,39, 9) = (/ & + & 0.15386e+01_r8,0.16919e+01_r8,0.18410e+01_r8,0.19923e+01_r8,0.21638e+01_r8 /) + kbo(:,40, 9) = (/ & + & 0.14840e+01_r8,0.16355e+01_r8,0.17855e+01_r8,0.19337e+01_r8,0.21026e+01_r8 /) + kbo(:,41, 9) = (/ & + & 0.14260e+01_r8,0.15758e+01_r8,0.17241e+01_r8,0.18746e+01_r8,0.20398e+01_r8 /) + kbo(:,42, 9) = (/ & + & 0.13688e+01_r8,0.15162e+01_r8,0.16646e+01_r8,0.18157e+01_r8,0.19780e+01_r8 /) + kbo(:,43, 9) = (/ & + & 0.13011e+01_r8,0.14473e+01_r8,0.15936e+01_r8,0.17402e+01_r8,0.18823e+01_r8 /) + kbo(:,44, 9) = (/ & + & 0.12278e+01_r8,0.13710e+01_r8,0.15157e+01_r8,0.16568e+01_r8,0.17952e+01_r8 /) + kbo(:,45, 9) = (/ & + & 0.11558e+01_r8,0.12957e+01_r8,0.14361e+01_r8,0.15731e+01_r8,0.17094e+01_r8 /) + kbo(:,46, 9) = (/ & + & 0.10820e+01_r8,0.12147e+01_r8,0.13532e+01_r8,0.14890e+01_r8,0.16181e+01_r8 /) + kbo(:,47, 9) = (/ & + & 0.10024e+01_r8,0.11346e+01_r8,0.12669e+01_r8,0.14002e+01_r8,0.15260e+01_r8 /) + kbo(:,48, 9) = (/ & + & 0.92524e+00_r8,0.10524e+01_r8,0.11804e+01_r8,0.13068e+01_r8,0.14296e+01_r8 /) + kbo(:,49, 9) = (/ & + & 0.84698e+00_r8,0.96805e+00_r8,0.10902e+01_r8,0.12100e+01_r8,0.13299e+01_r8 /) + kbo(:,50, 9) = (/ & + & 0.78084e+00_r8,0.89928e+00_r8,0.10161e+01_r8,0.11323e+01_r8,0.12472e+01_r8 /) + kbo(:,51, 9) = (/ & + & 0.72222e+00_r8,0.83480e+00_r8,0.94748e+00_r8,0.10626e+01_r8,0.11740e+01_r8 /) + kbo(:,52, 9) = (/ & + & 0.66260e+00_r8,0.77045e+00_r8,0.88348e+00_r8,0.99181e+00_r8,0.10995e+01_r8 /) + kbo(:,53, 9) = (/ & + & 0.60516e+00_r8,0.71083e+00_r8,0.81698e+00_r8,0.91863e+00_r8,0.10219e+01_r8 /) + kbo(:,54, 9) = (/ & + & 0.56176e+00_r8,0.66472e+00_r8,0.77054e+00_r8,0.87249e+00_r8,0.97306e+00_r8 /) + kbo(:,55, 9) = (/ & + & 0.52563e+00_r8,0.63037e+00_r8,0.73497e+00_r8,0.83878e+00_r8,0.93923e+00_r8 /) + kbo(:,56, 9) = (/ & + & 0.49056e+00_r8,0.59429e+00_r8,0.69788e+00_r8,0.80509e+00_r8,0.90615e+00_r8 /) + kbo(:,57, 9) = (/ & + & 0.45575e+00_r8,0.55861e+00_r8,0.66303e+00_r8,0.76942e+00_r8,0.87211e+00_r8 /) + kbo(:,58, 9) = (/ & + & 0.42419e+00_r8,0.52609e+00_r8,0.63048e+00_r8,0.73708e+00_r8,0.84331e+00_r8 /) + kbo(:,59, 9) = (/ & + & 0.42340e+00_r8,0.52953e+00_r8,0.63843e+00_r8,0.74879e+00_r8,0.86046e+00_r8 /) + kbo(:,13,10) = (/ & + & 0.14973e+02_r8,0.15466e+02_r8,0.15907e+02_r8,0.16294e+02_r8,0.16648e+02_r8 /) + kbo(:,14,10) = (/ & + & 0.13327e+02_r8,0.13717e+02_r8,0.14036e+02_r8,0.14348e+02_r8,0.14658e+02_r8 /) + kbo(:,15,10) = (/ & + & 0.12219e+02_r8,0.12428e+02_r8,0.12649e+02_r8,0.12810e+02_r8,0.12959e+02_r8 /) + kbo(:,16,10) = (/ & + & 0.11245e+02_r8,0.11501e+02_r8,0.11701e+02_r8,0.11817e+02_r8,0.11948e+02_r8 /) + kbo(:,17,10) = (/ & + & 0.96706e+01_r8,0.99707e+01_r8,0.10257e+02_r8,0.10540e+02_r8,0.10718e+02_r8 /) + kbo(:,18,10) = (/ & + & 0.83018e+01_r8,0.83446e+01_r8,0.84207e+01_r8,0.85262e+01_r8,0.86783e+01_r8 /) + kbo(:,19,10) = (/ & + & 0.82250e+01_r8,0.81929e+01_r8,0.82337e+01_r8,0.82572e+01_r8,0.83177e+01_r8 /) + kbo(:,20,10) = (/ & + & 0.81684e+01_r8,0.81782e+01_r8,0.82244e+01_r8,0.82765e+01_r8,0.82985e+01_r8 /) + kbo(:,21,10) = (/ & + & 0.82586e+01_r8,0.83055e+01_r8,0.84017e+01_r8,0.83815e+01_r8,0.83594e+01_r8 /) + kbo(:,22,10) = (/ & + & 0.83686e+01_r8,0.84604e+01_r8,0.85363e+01_r8,0.84786e+01_r8,0.84786e+01_r8 /) + kbo(:,23,10) = (/ & + & 0.84301e+01_r8,0.85903e+01_r8,0.87569e+01_r8,0.87953e+01_r8,0.87965e+01_r8 /) + kbo(:,24,10) = (/ & + & 0.85690e+01_r8,0.88097e+01_r8,0.90359e+01_r8,0.90994e+01_r8,0.92201e+01_r8 /) + kbo(:,25,10) = (/ & + & 0.87852e+01_r8,0.90719e+01_r8,0.92672e+01_r8,0.94098e+01_r8,0.95600e+01_r8 /) + kbo(:,26,10) = (/ & + & 0.88651e+01_r8,0.92334e+01_r8,0.94525e+01_r8,0.97256e+01_r8,0.98986e+01_r8 /) + kbo(:,27,10) = (/ & + & 0.88645e+01_r8,0.92932e+01_r8,0.96152e+01_r8,0.98392e+01_r8,0.10037e+02_r8 /) + kbo(:,28,10) = (/ & + & 0.88548e+01_r8,0.93070e+01_r8,0.96176e+01_r8,0.99813e+01_r8,0.10238e+02_r8 /) + kbo(:,29,10) = (/ & + & 0.88198e+01_r8,0.92265e+01_r8,0.96024e+01_r8,0.99285e+01_r8,0.10232e+02_r8 /) + kbo(:,30,10) = (/ & + & 0.87818e+01_r8,0.92083e+01_r8,0.95579e+01_r8,0.98976e+01_r8,0.10208e+02_r8 /) + kbo(:,31,10) = (/ & + & 0.86036e+01_r8,0.90621e+01_r8,0.94967e+01_r8,0.98500e+01_r8,0.10159e+02_r8 /) + kbo(:,32,10) = (/ & + & 0.84748e+01_r8,0.89960e+01_r8,0.94428e+01_r8,0.98336e+01_r8,0.10196e+02_r8 /) + kbo(:,33,10) = (/ & + & 0.84172e+01_r8,0.89420e+01_r8,0.94383e+01_r8,0.98344e+01_r8,0.10060e+02_r8 /) + kbo(:,34,10) = (/ & + & 0.84605e+01_r8,0.89751e+01_r8,0.94683e+01_r8,0.98852e+01_r8,0.10023e+02_r8 /) + kbo(:,35,10) = (/ & + & 0.84589e+01_r8,0.89233e+01_r8,0.94002e+01_r8,0.98511e+01_r8,0.10024e+02_r8 /) + kbo(:,36,10) = (/ & + & 0.84558e+01_r8,0.89580e+01_r8,0.93747e+01_r8,0.98030e+01_r8,0.10000e+02_r8 /) + kbo(:,37,10) = (/ & + & 0.82385e+01_r8,0.87614e+01_r8,0.91541e+01_r8,0.95514e+01_r8,0.97363e+01_r8 /) + kbo(:,38,10) = (/ & + & 0.80132e+01_r8,0.84437e+01_r8,0.89304e+01_r8,0.92902e+01_r8,0.94811e+01_r8 /) + kbo(:,39,10) = (/ & + & 0.78203e+01_r8,0.81981e+01_r8,0.85539e+01_r8,0.89689e+01_r8,0.90927e+01_r8 /) + kbo(:,40,10) = (/ & + & 0.75978e+01_r8,0.79610e+01_r8,0.82423e+01_r8,0.86095e+01_r8,0.88190e+01_r8 /) + kbo(:,41,10) = (/ & + & 0.73029e+01_r8,0.76481e+01_r8,0.79708e+01_r8,0.82445e+01_r8,0.84426e+01_r8 /) + kbo(:,42,10) = (/ & + & 0.70166e+01_r8,0.73754e+01_r8,0.76378e+01_r8,0.78862e+01_r8,0.80985e+01_r8 /) + kbo(:,43,10) = (/ & + & 0.66293e+01_r8,0.69504e+01_r8,0.72276e+01_r8,0.75120e+01_r8,0.77099e+01_r8 /) + kbo(:,44,10) = (/ & + & 0.62312e+01_r8,0.65696e+01_r8,0.68647e+01_r8,0.71226e+01_r8,0.73305e+01_r8 /) + kbo(:,45,10) = (/ & + & 0.58229e+01_r8,0.61620e+01_r8,0.64682e+01_r8,0.67341e+01_r8,0.69070e+01_r8 /) + kbo(:,46,10) = (/ & + & 0.53657e+01_r8,0.57492e+01_r8,0.60377e+01_r8,0.63031e+01_r8,0.64992e+01_r8 /) + kbo(:,47,10) = (/ & + & 0.50350e+01_r8,0.53678e+01_r8,0.56656e+01_r8,0.59201e+01_r8,0.61262e+01_r8 /) + kbo(:,48,10) = (/ & + & 0.46566e+01_r8,0.49901e+01_r8,0.52633e+01_r8,0.54964e+01_r8,0.57537e+01_r8 /) + kbo(:,49,10) = (/ & + & 0.42801e+01_r8,0.46217e+01_r8,0.49093e+01_r8,0.51104e+01_r8,0.53644e+01_r8 /) + kbo(:,50,10) = (/ & + & 0.39613e+01_r8,0.43120e+01_r8,0.45848e+01_r8,0.48588e+01_r8,0.50774e+01_r8 /) + kbo(:,51,10) = (/ & + & 0.37006e+01_r8,0.40662e+01_r8,0.43615e+01_r8,0.46264e+01_r8,0.48701e+01_r8 /) + kbo(:,52,10) = (/ & + & 0.34485e+01_r8,0.37934e+01_r8,0.40667e+01_r8,0.43544e+01_r8,0.46481e+01_r8 /) + kbo(:,53,10) = (/ & + & 0.31594e+01_r8,0.35032e+01_r8,0.37934e+01_r8,0.41156e+01_r8,0.44077e+01_r8 /) + kbo(:,54,10) = (/ & + & 0.29800e+01_r8,0.33284e+01_r8,0.36333e+01_r8,0.39624e+01_r8,0.42528e+01_r8 /) + kbo(:,55,10) = (/ & + & 0.28569e+01_r8,0.32159e+01_r8,0.35391e+01_r8,0.38186e+01_r8,0.41402e+01_r8 /) + kbo(:,56,10) = (/ & + & 0.26907e+01_r8,0.31071e+01_r8,0.34476e+01_r8,0.36941e+01_r8,0.40212e+01_r8 /) + kbo(:,57,10) = (/ & + & 0.25638e+01_r8,0.29869e+01_r8,0.33345e+01_r8,0.36081e+01_r8,0.38859e+01_r8 /) + kbo(:,58,10) = (/ & + & 0.24665e+01_r8,0.28708e+01_r8,0.32402e+01_r8,0.35331e+01_r8,0.37851e+01_r8 /) + kbo(:,59,10) = (/ & + & 0.25432e+01_r8,0.29855e+01_r8,0.33662e+01_r8,0.37020e+01_r8,0.39522e+01_r8 /) + kbo(:,13,11) = (/ & + & 0.31099e+02_r8,0.31647e+02_r8,0.32241e+02_r8,0.32842e+02_r8,0.33417e+02_r8 /) + kbo(:,14,11) = (/ & + & 0.27698e+02_r8,0.28253e+02_r8,0.28859e+02_r8,0.29460e+02_r8,0.30083e+02_r8 /) + kbo(:,15,11) = (/ & + & 0.24330e+02_r8,0.24945e+02_r8,0.25542e+02_r8,0.26234e+02_r8,0.26922e+02_r8 /) + kbo(:,16,11) = (/ & + & 0.21190e+02_r8,0.21758e+02_r8,0.22384e+02_r8,0.23019e+02_r8,0.23628e+02_r8 /) + kbo(:,17,11) = (/ & + & 0.18967e+02_r8,0.19413e+02_r8,0.19858e+02_r8,0.20261e+02_r8,0.20672e+02_r8 /) + kbo(:,18,11) = (/ & + & 0.16374e+02_r8,0.16952e+02_r8,0.17497e+02_r8,0.17964e+02_r8,0.18478e+02_r8 /) + kbo(:,19,11) = (/ & + & 0.13248e+02_r8,0.13545e+02_r8,0.13847e+02_r8,0.14297e+02_r8,0.14705e+02_r8 /) + kbo(:,20,11) = (/ & + & 0.12757e+02_r8,0.12785e+02_r8,0.12667e+02_r8,0.12601e+02_r8,0.12612e+02_r8 /) + kbo(:,21,11) = (/ & + & 0.12844e+02_r8,0.12624e+02_r8,0.12433e+02_r8,0.12193e+02_r8,0.12175e+02_r8 /) + kbo(:,22,11) = (/ & + & 0.12738e+02_r8,0.12567e+02_r8,0.12225e+02_r8,0.12063e+02_r8,0.11980e+02_r8 /) + kbo(:,23,11) = (/ & + & 0.12815e+02_r8,0.12660e+02_r8,0.12272e+02_r8,0.12108e+02_r8,0.12066e+02_r8 /) + kbo(:,24,11) = (/ & + & 0.13079e+02_r8,0.12972e+02_r8,0.12651e+02_r8,0.12388e+02_r8,0.12367e+02_r8 /) + kbo(:,25,11) = (/ & + & 0.13341e+02_r8,0.13256e+02_r8,0.13023e+02_r8,0.12848e+02_r8,0.12659e+02_r8 /) + kbo(:,26,11) = (/ & + & 0.13512e+02_r8,0.13453e+02_r8,0.13443e+02_r8,0.13113e+02_r8,0.13141e+02_r8 /) + kbo(:,27,11) = (/ & + & 0.13706e+02_r8,0.13750e+02_r8,0.13824e+02_r8,0.13564e+02_r8,0.13665e+02_r8 /) + kbo(:,28,11) = (/ & + & 0.13979e+02_r8,0.14080e+02_r8,0.14203e+02_r8,0.13858e+02_r8,0.13981e+02_r8 /) + kbo(:,29,11) = (/ & + & 0.13934e+02_r8,0.14086e+02_r8,0.14156e+02_r8,0.14057e+02_r8,0.14114e+02_r8 /) + kbo(:,30,11) = (/ & + & 0.13981e+02_r8,0.13996e+02_r8,0.13975e+02_r8,0.14010e+02_r8,0.14196e+02_r8 /) + kbo(:,31,11) = (/ & + & 0.13896e+02_r8,0.13857e+02_r8,0.13654e+02_r8,0.13807e+02_r8,0.13871e+02_r8 /) + kbo(:,32,11) = (/ & + & 0.13655e+02_r8,0.13646e+02_r8,0.13416e+02_r8,0.13538e+02_r8,0.13488e+02_r8 /) + kbo(:,33,11) = (/ & + & 0.13398e+02_r8,0.13279e+02_r8,0.13235e+02_r8,0.13164e+02_r8,0.13195e+02_r8 /) + kbo(:,34,11) = (/ & + & 0.13280e+02_r8,0.13155e+02_r8,0.13035e+02_r8,0.13095e+02_r8,0.13023e+02_r8 /) + kbo(:,35,11) = (/ & + & 0.13174e+02_r8,0.13038e+02_r8,0.12951e+02_r8,0.12819e+02_r8,0.12932e+02_r8 /) + kbo(:,36,11) = (/ & + & 0.13159e+02_r8,0.12953e+02_r8,0.12943e+02_r8,0.12899e+02_r8,0.13077e+02_r8 /) + kbo(:,37,11) = (/ & + & 0.12968e+02_r8,0.12722e+02_r8,0.12741e+02_r8,0.12684e+02_r8,0.12881e+02_r8 /) + kbo(:,38,11) = (/ & + & 0.12648e+02_r8,0.12436e+02_r8,0.12390e+02_r8,0.12534e+02_r8,0.12593e+02_r8 /) + kbo(:,39,11) = (/ & + & 0.12145e+02_r8,0.12036e+02_r8,0.12198e+02_r8,0.12171e+02_r8,0.12374e+02_r8 /) + kbo(:,40,11) = (/ & + & 0.11784e+02_r8,0.11714e+02_r8,0.11852e+02_r8,0.11995e+02_r8,0.12020e+02_r8 /) + kbo(:,41,11) = (/ & + & 0.11419e+02_r8,0.11429e+02_r8,0.11554e+02_r8,0.11799e+02_r8,0.11809e+02_r8 /) + kbo(:,42,11) = (/ & + & 0.11076e+02_r8,0.11047e+02_r8,0.11287e+02_r8,0.11460e+02_r8,0.11610e+02_r8 /) + kbo(:,43,11) = (/ & + & 0.10635e+02_r8,0.10772e+02_r8,0.10970e+02_r8,0.11110e+02_r8,0.11339e+02_r8 /) + kbo(:,44,11) = (/ & + & 0.10081e+02_r8,0.10347e+02_r8,0.10495e+02_r8,0.10710e+02_r8,0.10998e+02_r8 /) + kbo(:,45,11) = (/ & + & 0.95493e+01_r8,0.97720e+01_r8,0.10013e+02_r8,0.10318e+02_r8,0.10626e+02_r8 /) + kbo(:,46,11) = (/ & + & 0.91901e+01_r8,0.92815e+01_r8,0.95285e+01_r8,0.99399e+01_r8,0.10216e+02_r8 /) + kbo(:,47,11) = (/ & + & 0.86762e+01_r8,0.88384e+01_r8,0.91370e+01_r8,0.95143e+01_r8,0.99290e+01_r8 /) + kbo(:,48,11) = (/ & + & 0.80969e+01_r8,0.84350e+01_r8,0.87222e+01_r8,0.91427e+01_r8,0.95881e+01_r8 /) + kbo(:,49,11) = (/ & + & 0.74881e+01_r8,0.78692e+01_r8,0.82390e+01_r8,0.88564e+01_r8,0.92509e+01_r8 /) + kbo(:,50,11) = (/ & + & 0.70193e+01_r8,0.74373e+01_r8,0.79400e+01_r8,0.84415e+01_r8,0.90721e+01_r8 /) + kbo(:,51,11) = (/ & + & 0.66370e+01_r8,0.71214e+01_r8,0.76381e+01_r8,0.81180e+01_r8,0.89263e+01_r8 /) + kbo(:,52,11) = (/ & + & 0.62242e+01_r8,0.68097e+01_r8,0.73447e+01_r8,0.79515e+01_r8,0.88951e+01_r8 /) + kbo(:,53,11) = (/ & + & 0.58238e+01_r8,0.63775e+01_r8,0.69942e+01_r8,0.79247e+01_r8,0.89454e+01_r8 /) + kbo(:,54,11) = (/ & + & 0.55499e+01_r8,0.61225e+01_r8,0.67115e+01_r8,0.76390e+01_r8,0.86771e+01_r8 /) + kbo(:,55,11) = (/ & + & 0.53976e+01_r8,0.59288e+01_r8,0.64661e+01_r8,0.72387e+01_r8,0.82482e+01_r8 /) + kbo(:,56,11) = (/ & + & 0.52864e+01_r8,0.57486e+01_r8,0.62663e+01_r8,0.68889e+01_r8,0.78153e+01_r8 /) + kbo(:,57,11) = (/ & + & 0.51174e+01_r8,0.55624e+01_r8,0.60808e+01_r8,0.66051e+01_r8,0.73800e+01_r8 /) + kbo(:,58,11) = (/ & + & 0.49368e+01_r8,0.54350e+01_r8,0.59533e+01_r8,0.64218e+01_r8,0.70057e+01_r8 /) + kbo(:,59,11) = (/ & + & 0.50812e+01_r8,0.56369e+01_r8,0.60928e+01_r8,0.64990e+01_r8,0.70265e+01_r8 /) + kbo(:,13,12) = (/ & + & 0.69704e+02_r8,0.70627e+02_r8,0.71228e+02_r8,0.71788e+02_r8,0.72437e+02_r8 /) + kbo(:,14,12) = (/ & + & 0.64379e+02_r8,0.65225e+02_r8,0.66016e+02_r8,0.66901e+02_r8,0.67785e+02_r8 /) + kbo(:,15,12) = (/ & + & 0.58655e+02_r8,0.59644e+02_r8,0.60731e+02_r8,0.61788e+02_r8,0.62973e+02_r8 /) + kbo(:,16,12) = (/ & + & 0.53041e+02_r8,0.54211e+02_r8,0.55406e+02_r8,0.56764e+02_r8,0.58230e+02_r8 /) + kbo(:,17,12) = (/ & + & 0.47145e+02_r8,0.48549e+02_r8,0.50104e+02_r8,0.51815e+02_r8,0.53646e+02_r8 /) + kbo(:,18,12) = (/ & + & 0.41118e+02_r8,0.42628e+02_r8,0.44372e+02_r8,0.46307e+02_r8,0.48319e+02_r8 /) + kbo(:,19,12) = (/ & + & 0.35042e+02_r8,0.36608e+02_r8,0.38443e+02_r8,0.40582e+02_r8,0.43018e+02_r8 /) + kbo(:,20,12) = (/ & + & 0.28625e+02_r8,0.30224e+02_r8,0.32288e+02_r8,0.34780e+02_r8,0.37414e+02_r8 /) + kbo(:,21,12) = (/ & + & 0.24017e+02_r8,0.25409e+02_r8,0.27330e+02_r8,0.29600e+02_r8,0.32108e+02_r8 /) + kbo(:,22,12) = (/ & + & 0.21793e+02_r8,0.22620e+02_r8,0.24096e+02_r8,0.26102e+02_r8,0.28497e+02_r8 /) + kbo(:,23,12) = (/ & + & 0.21413e+02_r8,0.21831e+02_r8,0.22594e+02_r8,0.23606e+02_r8,0.25745e+02_r8 /) + kbo(:,24,12) = (/ & + & 0.21009e+02_r8,0.21418e+02_r8,0.22293e+02_r8,0.23189e+02_r8,0.24234e+02_r8 /) + kbo(:,25,12) = (/ & + & 0.21184e+02_r8,0.21661e+02_r8,0.22476e+02_r8,0.23334e+02_r8,0.24471e+02_r8 /) + kbo(:,26,12) = (/ & + & 0.21853e+02_r8,0.22488e+02_r8,0.23205e+02_r8,0.24024e+02_r8,0.25192e+02_r8 /) + kbo(:,27,12) = (/ & + & 0.22275e+02_r8,0.22928e+02_r8,0.23659e+02_r8,0.24768e+02_r8,0.25734e+02_r8 /) + kbo(:,28,12) = (/ & + & 0.22649e+02_r8,0.23413e+02_r8,0.24091e+02_r8,0.25549e+02_r8,0.26436e+02_r8 /) + kbo(:,29,12) = (/ & + & 0.22704e+02_r8,0.23483e+02_r8,0.24191e+02_r8,0.25460e+02_r8,0.26653e+02_r8 /) + kbo(:,30,12) = (/ & + & 0.22666e+02_r8,0.23444e+02_r8,0.24530e+02_r8,0.25500e+02_r8,0.26652e+02_r8 /) + kbo(:,31,12) = (/ & + & 0.22235e+02_r8,0.23247e+02_r8,0.24248e+02_r8,0.25076e+02_r8,0.26466e+02_r8 /) + kbo(:,32,12) = (/ & + & 0.22226e+02_r8,0.22827e+02_r8,0.24083e+02_r8,0.25139e+02_r8,0.26181e+02_r8 /) + kbo(:,33,12) = (/ & + & 0.22210e+02_r8,0.22941e+02_r8,0.24126e+02_r8,0.25269e+02_r8,0.26783e+02_r8 /) + kbo(:,34,12) = (/ & + & 0.22243e+02_r8,0.23077e+02_r8,0.24337e+02_r8,0.25761e+02_r8,0.27799e+02_r8 /) + kbo(:,35,12) = (/ & + & 0.22396e+02_r8,0.23583e+02_r8,0.24898e+02_r8,0.26594e+02_r8,0.29392e+02_r8 /) + kbo(:,36,12) = (/ & + & 0.22982e+02_r8,0.24125e+02_r8,0.25363e+02_r8,0.27311e+02_r8,0.30508e+02_r8 /) + kbo(:,37,12) = (/ & + & 0.22918e+02_r8,0.23937e+02_r8,0.25281e+02_r8,0.27602e+02_r8,0.31235e+02_r8 /) + kbo(:,38,12) = (/ & + & 0.22758e+02_r8,0.23720e+02_r8,0.25240e+02_r8,0.28261e+02_r8,0.32012e+02_r8 /) + kbo(:,39,12) = (/ & + & 0.22553e+02_r8,0.23629e+02_r8,0.25559e+02_r8,0.29164e+02_r8,0.32971e+02_r8 /) + kbo(:,40,12) = (/ & + & 0.21913e+02_r8,0.23010e+02_r8,0.25397e+02_r8,0.28931e+02_r8,0.33000e+02_r8 /) + kbo(:,41,12) = (/ & + & 0.21428e+02_r8,0.22543e+02_r8,0.25193e+02_r8,0.28521e+02_r8,0.32655e+02_r8 /) + kbo(:,42,12) = (/ & + & 0.20806e+02_r8,0.22057e+02_r8,0.24895e+02_r8,0.28307e+02_r8,0.32344e+02_r8 /) + kbo(:,43,12) = (/ & + & 0.20230e+02_r8,0.21402e+02_r8,0.24438e+02_r8,0.27778e+02_r8,0.31742e+02_r8 /) + kbo(:,44,12) = (/ & + & 0.19439e+02_r8,0.20816e+02_r8,0.24038e+02_r8,0.27280e+02_r8,0.31112e+02_r8 /) + kbo(:,45,12) = (/ & + & 0.18615e+02_r8,0.20644e+02_r8,0.23787e+02_r8,0.26906e+02_r8,0.30508e+02_r8 /) + kbo(:,46,12) = (/ & + & 0.17932e+02_r8,0.20436e+02_r8,0.23444e+02_r8,0.26514e+02_r8,0.30043e+02_r8 /) + kbo(:,47,12) = (/ & + & 0.17388e+02_r8,0.20062e+02_r8,0.22865e+02_r8,0.25992e+02_r8,0.29187e+02_r8 /) + kbo(:,48,12) = (/ & + & 0.17144e+02_r8,0.19562e+02_r8,0.22419e+02_r8,0.25556e+02_r8,0.28578e+02_r8 /) + kbo(:,49,12) = (/ & + & 0.16956e+02_r8,0.19439e+02_r8,0.22133e+02_r8,0.25135e+02_r8,0.28141e+02_r8 /) + kbo(:,50,12) = (/ & + & 0.16529e+02_r8,0.19034e+02_r8,0.21605e+02_r8,0.24563e+02_r8,0.27331e+02_r8 /) + kbo(:,51,12) = (/ & + & 0.15953e+02_r8,0.18522e+02_r8,0.21071e+02_r8,0.23856e+02_r8,0.26389e+02_r8 /) + kbo(:,52,12) = (/ & + & 0.15476e+02_r8,0.18037e+02_r8,0.20576e+02_r8,0.23092e+02_r8,0.25303e+02_r8 /) + kbo(:,53,12) = (/ & + & 0.14987e+02_r8,0.17619e+02_r8,0.20150e+02_r8,0.22182e+02_r8,0.24323e+02_r8 /) + kbo(:,54,12) = (/ & + & 0.14316e+02_r8,0.16769e+02_r8,0.19340e+02_r8,0.21295e+02_r8,0.23328e+02_r8 /) + kbo(:,55,12) = (/ & + & 0.13478e+02_r8,0.15723e+02_r8,0.18284e+02_r8,0.20497e+02_r8,0.22282e+02_r8 /) + kbo(:,56,12) = (/ & + & 0.12615e+02_r8,0.14717e+02_r8,0.17222e+02_r8,0.19626e+02_r8,0.21412e+02_r8 /) + kbo(:,57,12) = (/ & + & 0.11789e+02_r8,0.13910e+02_r8,0.16111e+02_r8,0.18559e+02_r8,0.20605e+02_r8 /) + kbo(:,58,12) = (/ & + & 0.10935e+02_r8,0.12994e+02_r8,0.15023e+02_r8,0.17386e+02_r8,0.19630e+02_r8 /) + kbo(:,59,12) = (/ & + & 0.10847e+02_r8,0.11985e+02_r8,0.13699e+02_r8,0.15922e+02_r8,0.18130e+02_r8 /) + kbo(:,13,13) = (/ & + & 0.15243e+03_r8,0.15414e+03_r8,0.15604e+03_r8,0.15731e+03_r8,0.15805e+03_r8 /) + kbo(:,14,13) = (/ & + & 0.15017e+03_r8,0.15285e+03_r8,0.15509e+03_r8,0.15662e+03_r8,0.15764e+03_r8 /) + kbo(:,15,13) = (/ & + & 0.14701e+03_r8,0.15032e+03_r8,0.15250e+03_r8,0.15435e+03_r8,0.15583e+03_r8 /) + kbo(:,16,13) = (/ & + & 0.14269e+03_r8,0.14580e+03_r8,0.14857e+03_r8,0.15094e+03_r8,0.15306e+03_r8 /) + kbo(:,17,13) = (/ & + & 0.13670e+03_r8,0.14035e+03_r8,0.14376e+03_r8,0.14689e+03_r8,0.14976e+03_r8 /) + kbo(:,18,13) = (/ & + & 0.13015e+03_r8,0.13455e+03_r8,0.13871e+03_r8,0.14263e+03_r8,0.14625e+03_r8 /) + kbo(:,19,13) = (/ & + & 0.12287e+03_r8,0.12845e+03_r8,0.13370e+03_r8,0.13836e+03_r8,0.14277e+03_r8 /) + kbo(:,20,13) = (/ & + & 0.11516e+03_r8,0.12176e+03_r8,0.12807e+03_r8,0.13396e+03_r8,0.13973e+03_r8 /) + kbo(:,21,13) = (/ & + & 0.10676e+03_r8,0.11461e+03_r8,0.12196e+03_r8,0.12926e+03_r8,0.13605e+03_r8 /) + kbo(:,22,13) = (/ & + & 0.98495e+02_r8,0.10775e+03_r8,0.11663e+03_r8,0.12493e+03_r8,0.13260e+03_r8 /) + kbo(:,23,13) = (/ & + & 0.89816e+02_r8,0.10015e+03_r8,0.11065e+03_r8,0.12084e+03_r8,0.12951e+03_r8 /) + kbo(:,24,13) = (/ & + & 0.82797e+02_r8,0.93590e+02_r8,0.10444e+03_r8,0.11545e+03_r8,0.12590e+03_r8 /) + kbo(:,25,13) = (/ & + & 0.77256e+02_r8,0.88067e+02_r8,0.99408e+02_r8,0.11069e+03_r8,0.12164e+03_r8 /) + kbo(:,26,13) = (/ & + & 0.73787e+02_r8,0.84230e+02_r8,0.95403e+02_r8,0.10719e+03_r8,0.11797e+03_r8 /) + kbo(:,27,13) = (/ & + & 0.72626e+02_r8,0.82623e+02_r8,0.93417e+02_r8,0.10482e+03_r8,0.11588e+03_r8 /) + kbo(:,28,13) = (/ & + & 0.72289e+02_r8,0.81705e+02_r8,0.92658e+02_r8,0.10355e+03_r8,0.11467e+03_r8 /) + kbo(:,29,13) = (/ & + & 0.73831e+02_r8,0.83248e+02_r8,0.93801e+02_r8,0.10474e+03_r8,0.11551e+03_r8 /) + kbo(:,30,13) = (/ & + & 0.76016e+02_r8,0.86113e+02_r8,0.95367e+02_r8,0.10651e+03_r8,0.11733e+03_r8 /) + kbo(:,31,13) = (/ & + & 0.80058e+02_r8,0.89705e+02_r8,0.99793e+02_r8,0.10982e+03_r8,0.12052e+03_r8 /) + kbo(:,32,13) = (/ & + & 0.85064e+02_r8,0.94860e+02_r8,0.10434e+03_r8,0.11401e+03_r8,0.12404e+03_r8 /) + kbo(:,33,13) = (/ & + & 0.90655e+02_r8,0.10081e+03_r8,0.10992e+03_r8,0.11933e+03_r8,0.12788e+03_r8 /) + kbo(:,34,13) = (/ & + & 0.95857e+02_r8,0.10597e+03_r8,0.11520e+03_r8,0.12356e+03_r8,0.13127e+03_r8 /) + kbo(:,35,13) = (/ & + & 0.99393e+02_r8,0.11014e+03_r8,0.12003e+03_r8,0.12794e+03_r8,0.13407e+03_r8 /) + kbo(:,36,13) = (/ & + & 0.10100e+03_r8,0.11220e+03_r8,0.12221e+03_r8,0.13085e+03_r8,0.13724e+03_r8 /) + kbo(:,37,13) = (/ & + & 0.10052e+03_r8,0.11217e+03_r8,0.12302e+03_r8,0.13127e+03_r8,0.13704e+03_r8 /) + kbo(:,38,13) = (/ & + & 0.10046e+03_r8,0.11273e+03_r8,0.12310e+03_r8,0.13118e+03_r8,0.13742e+03_r8 /) + kbo(:,39,13) = (/ & + & 0.10122e+03_r8,0.11326e+03_r8,0.12361e+03_r8,0.13081e+03_r8,0.13784e+03_r8 /) + kbo(:,40,13) = (/ & + & 0.10000e+03_r8,0.11180e+03_r8,0.12195e+03_r8,0.12930e+03_r8,0.13636e+03_r8 /) + kbo(:,41,13) = (/ & + & 0.98394e+02_r8,0.11024e+03_r8,0.11969e+03_r8,0.12788e+03_r8,0.13497e+03_r8 /) + kbo(:,42,13) = (/ & + & 0.97071e+02_r8,0.10823e+03_r8,0.11769e+03_r8,0.12630e+03_r8,0.13330e+03_r8 /) + kbo(:,43,13) = (/ & + & 0.94820e+02_r8,0.10592e+03_r8,0.11514e+03_r8,0.12393e+03_r8,0.13107e+03_r8 /) + kbo(:,44,13) = (/ & + & 0.92475e+02_r8,0.10313e+03_r8,0.11198e+03_r8,0.12120e+03_r8,0.12869e+03_r8 /) + kbo(:,45,13) = (/ & + & 0.90255e+02_r8,0.99678e+02_r8,0.10888e+03_r8,0.11824e+03_r8,0.12634e+03_r8 /) + kbo(:,46,13) = (/ & + & 0.87084e+02_r8,0.96376e+02_r8,0.10582e+03_r8,0.11496e+03_r8,0.12350e+03_r8 /) + kbo(:,47,13) = (/ & + & 0.83116e+02_r8,0.92026e+02_r8,0.10209e+03_r8,0.11120e+03_r8,0.12020e+03_r8 /) + kbo(:,48,13) = (/ & + & 0.78845e+02_r8,0.88316e+02_r8,0.97984e+02_r8,0.10729e+03_r8,0.11639e+03_r8 /) + kbo(:,49,13) = (/ & + & 0.74841e+02_r8,0.84389e+02_r8,0.93907e+02_r8,0.10286e+03_r8,0.11277e+03_r8 /) + kbo(:,50,13) = (/ & + & 0.71259e+02_r8,0.80370e+02_r8,0.89851e+02_r8,0.99011e+02_r8,0.10882e+03_r8 /) + kbo(:,51,13) = (/ & + & 0.67667e+02_r8,0.76332e+02_r8,0.85552e+02_r8,0.95111e+02_r8,0.10517e+03_r8 /) + kbo(:,52,13) = (/ & + & 0.64036e+02_r8,0.72373e+02_r8,0.81228e+02_r8,0.91458e+02_r8,0.10109e+03_r8 /) + kbo(:,53,13) = (/ & + & 0.60531e+02_r8,0.68539e+02_r8,0.77029e+02_r8,0.87314e+02_r8,0.97171e+02_r8 /) + kbo(:,54,13) = (/ & + & 0.57169e+02_r8,0.65298e+02_r8,0.73473e+02_r8,0.83504e+02_r8,0.93303e+02_r8 /) + kbo(:,55,13) = (/ & + & 0.53955e+02_r8,0.61813e+02_r8,0.70099e+02_r8,0.79656e+02_r8,0.89859e+02_r8 /) + kbo(:,56,13) = (/ & + & 0.50772e+02_r8,0.58658e+02_r8,0.66829e+02_r8,0.76079e+02_r8,0.86127e+02_r8 /) + kbo(:,57,13) = (/ & + & 0.47708e+02_r8,0.55213e+02_r8,0.63250e+02_r8,0.72545e+02_r8,0.82495e+02_r8 /) + kbo(:,58,13) = (/ & + & 0.45026e+02_r8,0.52243e+02_r8,0.60123e+02_r8,0.69281e+02_r8,0.79017e+02_r8 /) + kbo(:,59,13) = (/ & + & 0.42111e+02_r8,0.50365e+02_r8,0.58368e+02_r8,0.67832e+02_r8,0.76877e+02_r8 /) + kbo(:,13,14) = (/ & + & 0.32174e+03_r8,0.31744e+03_r8,0.31218e+03_r8,0.30740e+03_r8,0.30288e+03_r8 /) + kbo(:,14,14) = (/ & + & 0.33593e+03_r8,0.33142e+03_r8,0.32669e+03_r8,0.32231e+03_r8,0.31834e+03_r8 /) + kbo(:,15,14) = (/ & + & 0.34823e+03_r8,0.34389e+03_r8,0.34037e+03_r8,0.33690e+03_r8,0.33355e+03_r8 /) + kbo(:,16,14) = (/ & + & 0.35878e+03_r8,0.35631e+03_r8,0.35376e+03_r8,0.35105e+03_r8,0.34819e+03_r8 /) + kbo(:,17,14) = (/ & + & 0.36906e+03_r8,0.36793e+03_r8,0.36636e+03_r8,0.36433e+03_r8,0.36182e+03_r8 /) + kbo(:,18,14) = (/ & + & 0.37817e+03_r8,0.37835e+03_r8,0.37763e+03_r8,0.37618e+03_r8,0.37389e+03_r8 /) + kbo(:,19,14) = (/ & + & 0.38585e+03_r8,0.38729e+03_r8,0.38746e+03_r8,0.38655e+03_r8,0.38433e+03_r8 /) + kbo(:,20,14) = (/ & + & 0.39236e+03_r8,0.39495e+03_r8,0.39589e+03_r8,0.39530e+03_r8,0.39330e+03_r8 /) + kbo(:,21,14) = (/ & + & 0.39808e+03_r8,0.40159e+03_r8,0.40312e+03_r8,0.40280e+03_r8,0.40090e+03_r8 /) + kbo(:,22,14) = (/ & + & 0.40338e+03_r8,0.40757e+03_r8,0.40933e+03_r8,0.40908e+03_r8,0.40708e+03_r8 /) + kbo(:,23,14) = (/ & + & 0.40834e+03_r8,0.41282e+03_r8,0.41463e+03_r8,0.41442e+03_r8,0.41222e+03_r8 /) + kbo(:,24,14) = (/ & + & 0.41280e+03_r8,0.41739e+03_r8,0.41916e+03_r8,0.41879e+03_r8,0.41631e+03_r8 /) + kbo(:,25,14) = (/ & + & 0.41635e+03_r8,0.42140e+03_r8,0.42295e+03_r8,0.42231e+03_r8,0.41948e+03_r8 /) + kbo(:,26,14) = (/ & + & 0.41887e+03_r8,0.42439e+03_r8,0.42613e+03_r8,0.42509e+03_r8,0.42199e+03_r8 /) + kbo(:,27,14) = (/ & + & 0.42034e+03_r8,0.42637e+03_r8,0.42837e+03_r8,0.42723e+03_r8,0.42380e+03_r8 /) + kbo(:,28,14) = (/ & + & 0.42191e+03_r8,0.42841e+03_r8,0.43008e+03_r8,0.42870e+03_r8,0.42501e+03_r8 /) + kbo(:,29,14) = (/ & + & 0.42351e+03_r8,0.42979e+03_r8,0.43162e+03_r8,0.42986e+03_r8,0.42579e+03_r8 /) + kbo(:,30,14) = (/ & + & 0.42461e+03_r8,0.42985e+03_r8,0.43291e+03_r8,0.43068e+03_r8,0.42610e+03_r8 /) + kbo(:,31,14) = (/ & + & 0.42505e+03_r8,0.43017e+03_r8,0.43191e+03_r8,0.43099e+03_r8,0.42603e+03_r8 /) + kbo(:,32,14) = (/ & + & 0.42362e+03_r8,0.42860e+03_r8,0.43041e+03_r8,0.42915e+03_r8,0.42555e+03_r8 /) + kbo(:,33,14) = (/ & + & 0.42123e+03_r8,0.42505e+03_r8,0.42663e+03_r8,0.42551e+03_r8,0.42290e+03_r8 /) + kbo(:,34,14) = (/ & + & 0.41773e+03_r8,0.42082e+03_r8,0.42178e+03_r8,0.42110e+03_r8,0.41858e+03_r8 /) + kbo(:,35,14) = (/ & + & 0.41435e+03_r8,0.41544e+03_r8,0.41491e+03_r8,0.41443e+03_r8,0.41216e+03_r8 /) + kbo(:,36,14) = (/ & + & 0.41009e+03_r8,0.41065e+03_r8,0.40988e+03_r8,0.40756e+03_r8,0.40367e+03_r8 /) + kbo(:,37,14) = (/ & + & 0.40889e+03_r8,0.40948e+03_r8,0.40755e+03_r8,0.40547e+03_r8,0.40195e+03_r8 /) + kbo(:,38,14) = (/ & + & 0.40736e+03_r8,0.40781e+03_r8,0.40666e+03_r8,0.40322e+03_r8,0.39939e+03_r8 /) + kbo(:,39,14) = (/ & + & 0.40514e+03_r8,0.40605e+03_r8,0.40431e+03_r8,0.40166e+03_r8,0.39666e+03_r8 /) + kbo(:,40,14) = (/ & + & 0.40543e+03_r8,0.40633e+03_r8,0.40490e+03_r8,0.40260e+03_r8,0.39791e+03_r8 /) + kbo(:,41,14) = (/ & + & 0.40503e+03_r8,0.40615e+03_r8,0.40599e+03_r8,0.40348e+03_r8,0.39947e+03_r8 /) + kbo(:,42,14) = (/ & + & 0.40408e+03_r8,0.40664e+03_r8,0.40681e+03_r8,0.40441e+03_r8,0.40107e+03_r8 /) + kbo(:,43,14) = (/ & + & 0.40250e+03_r8,0.40659e+03_r8,0.40791e+03_r8,0.40633e+03_r8,0.40362e+03_r8 /) + kbo(:,44,14) = (/ & + & 0.40121e+03_r8,0.40653e+03_r8,0.40934e+03_r8,0.40832e+03_r8,0.40616e+03_r8 /) + kbo(:,45,14) = (/ & + & 0.39928e+03_r8,0.40669e+03_r8,0.41014e+03_r8,0.41010e+03_r8,0.40849e+03_r8 /) + kbo(:,46,14) = (/ & + & 0.39656e+03_r8,0.40551e+03_r8,0.41027e+03_r8,0.41167e+03_r8,0.41068e+03_r8 /) + kbo(:,47,14) = (/ & + & 0.39317e+03_r8,0.40403e+03_r8,0.40985e+03_r8,0.41273e+03_r8,0.41264e+03_r8 /) + kbo(:,48,14) = (/ & + & 0.38915e+03_r8,0.40116e+03_r8,0.40932e+03_r8,0.41346e+03_r8,0.41469e+03_r8 /) + kbo(:,49,14) = (/ & + & 0.38398e+03_r8,0.39755e+03_r8,0.40789e+03_r8,0.41416e+03_r8,0.41577e+03_r8 /) + kbo(:,50,14) = (/ & + & 0.37757e+03_r8,0.39396e+03_r8,0.40616e+03_r8,0.41381e+03_r8,0.41707e+03_r8 /) + kbo(:,51,14) = (/ & + & 0.37117e+03_r8,0.38987e+03_r8,0.40415e+03_r8,0.41318e+03_r8,0.41740e+03_r8 /) + kbo(:,52,14) = (/ & + & 0.36408e+03_r8,0.38505e+03_r8,0.40161e+03_r8,0.41151e+03_r8,0.41801e+03_r8 /) + kbo(:,53,14) = (/ & + & 0.35611e+03_r8,0.37948e+03_r8,0.39824e+03_r8,0.40994e+03_r8,0.41764e+03_r8 /) + kbo(:,54,14) = (/ & + & 0.34712e+03_r8,0.37341e+03_r8,0.39425e+03_r8,0.40798e+03_r8,0.41739e+03_r8 /) + kbo(:,55,14) = (/ & + & 0.33857e+03_r8,0.36757e+03_r8,0.38995e+03_r8,0.40583e+03_r8,0.41654e+03_r8 /) + kbo(:,56,14) = (/ & + & 0.32949e+03_r8,0.36056e+03_r8,0.38492e+03_r8,0.40281e+03_r8,0.41532e+03_r8 /) + kbo(:,57,14) = (/ & + & 0.31954e+03_r8,0.35312e+03_r8,0.37997e+03_r8,0.39944e+03_r8,0.41349e+03_r8 /) + kbo(:,58,14) = (/ & + & 0.30943e+03_r8,0.34518e+03_r8,0.37428e+03_r8,0.39571e+03_r8,0.41155e+03_r8 /) + kbo(:,59,14) = (/ & + & 0.30628e+03_r8,0.34259e+03_r8,0.37284e+03_r8,0.39463e+03_r8,0.41220e+03_r8 /) + kbo(:,13,15) = (/ & + & 0.58702e+03_r8,0.56862e+03_r8,0.55331e+03_r8,0.53896e+03_r8,0.52495e+03_r8 /) + kbo(:,14,15) = (/ & + & 0.64037e+03_r8,0.62129e+03_r8,0.60436e+03_r8,0.58772e+03_r8,0.57127e+03_r8 /) + kbo(:,15,15) = (/ & + & 0.69642e+03_r8,0.67640e+03_r8,0.65677e+03_r8,0.63714e+03_r8,0.61752e+03_r8 /) + kbo(:,16,15) = (/ & + & 0.75408e+03_r8,0.73150e+03_r8,0.70834e+03_r8,0.68512e+03_r8,0.66206e+03_r8 /) + kbo(:,17,15) = (/ & + & 0.81156e+03_r8,0.78496e+03_r8,0.75773e+03_r8,0.73064e+03_r8,0.70441e+03_r8 /) + kbo(:,18,15) = (/ & + & 0.86684e+03_r8,0.83552e+03_r8,0.80425e+03_r8,0.77370e+03_r8,0.74441e+03_r8 /) + kbo(:,19,15) = (/ & + & 0.91879e+03_r8,0.88284e+03_r8,0.84773e+03_r8,0.81356e+03_r8,0.78105e+03_r8 /) + kbo(:,20,15) = (/ & + & 0.96599e+03_r8,0.92558e+03_r8,0.88651e+03_r8,0.84884e+03_r8,0.81303e+03_r8 /) + kbo(:,21,15) = (/ & + & 0.10076e+04_r8,0.96291e+03_r8,0.92009e+03_r8,0.87920e+03_r8,0.84047e+03_r8 /) + kbo(:,22,15) = (/ & + & 0.10401e+04_r8,0.99157e+03_r8,0.94567e+03_r8,0.90208e+03_r8,0.86095e+03_r8 /) + kbo(:,23,15) = (/ & + & 0.10659e+04_r8,0.10143e+04_r8,0.96587e+03_r8,0.91983e+03_r8,0.87686e+03_r8 /) + kbo(:,24,15) = (/ & + & 0.10857e+04_r8,0.10316e+04_r8,0.98077e+03_r8,0.93285e+03_r8,0.88829e+03_r8 /) + kbo(:,25,15) = (/ & + & 0.10994e+04_r8,0.10434e+04_r8,0.99070e+03_r8,0.94138e+03_r8,0.89569e+03_r8 /) + kbo(:,26,15) = (/ & + & 0.11072e+04_r8,0.10495e+04_r8,0.99578e+03_r8,0.94553e+03_r8,0.89886e+03_r8 /) + kbo(:,27,15) = (/ & + & 0.11107e+04_r8,0.10519e+04_r8,0.99732e+03_r8,0.94654e+03_r8,0.89932e+03_r8 /) + kbo(:,28,15) = (/ & + & 0.11104e+04_r8,0.10510e+04_r8,0.99596e+03_r8,0.94493e+03_r8,0.89744e+03_r8 /) + kbo(:,29,15) = (/ & + & 0.11068e+04_r8,0.10472e+04_r8,0.99206e+03_r8,0.94099e+03_r8,0.89320e+03_r8 /) + kbo(:,30,15) = (/ & + & 0.11008e+04_r8,0.10413e+04_r8,0.98636e+03_r8,0.93544e+03_r8,0.88772e+03_r8 /) + kbo(:,31,15) = (/ & + & 0.10926e+04_r8,0.10334e+04_r8,0.97895e+03_r8,0.92827e+03_r8,0.88094e+03_r8 /) + kbo(:,32,15) = (/ & + & 0.10829e+04_r8,0.10242e+04_r8,0.97015e+03_r8,0.91986e+03_r8,0.87315e+03_r8 /) + kbo(:,33,15) = (/ & + & 0.10718e+04_r8,0.10140e+04_r8,0.96048e+03_r8,0.91059e+03_r8,0.86462e+03_r8 /) + kbo(:,34,15) = (/ & + & 0.10622e+04_r8,0.10049e+04_r8,0.95198e+03_r8,0.90258e+03_r8,0.85725e+03_r8 /) + kbo(:,35,15) = (/ & + & 0.10576e+04_r8,0.10006e+04_r8,0.94772e+03_r8,0.89854e+03_r8,0.85365e+03_r8 /) + kbo(:,36,15) = (/ & + & 0.10589e+04_r8,0.10017e+04_r8,0.94880e+03_r8,0.89934e+03_r8,0.85436e+03_r8 /) + kbo(:,37,15) = (/ & + & 0.10689e+04_r8,0.10108e+04_r8,0.95721e+03_r8,0.90723e+03_r8,0.86136e+03_r8 /) + kbo(:,38,15) = (/ & + & 0.10792e+04_r8,0.10202e+04_r8,0.96581e+03_r8,0.91534e+03_r8,0.86861e+03_r8 /) + kbo(:,39,15) = (/ & + & 0.10893e+04_r8,0.10294e+04_r8,0.97432e+03_r8,0.92308e+03_r8,0.87586e+03_r8 /) + kbo(:,40,15) = (/ & + & 0.11025e+04_r8,0.10445e+04_r8,0.98826e+03_r8,0.93598e+03_r8,0.88770e+03_r8 /) + kbo(:,41,15) = (/ & + & 0.11189e+04_r8,0.10606e+04_r8,0.10030e+04_r8,0.94969e+03_r8,0.90027e+03_r8 /) + kbo(:,42,15) = (/ & + & 0.11355e+04_r8,0.10769e+04_r8,0.10180e+04_r8,0.96359e+03_r8,0.91305e+03_r8 /) + kbo(:,43,15) = (/ & + & 0.11585e+04_r8,0.10971e+04_r8,0.10364e+04_r8,0.98067e+03_r8,0.92886e+03_r8 /) + kbo(:,44,15) = (/ & + & 0.11827e+04_r8,0.11193e+04_r8,0.10568e+04_r8,0.99947e+03_r8,0.94636e+03_r8 /) + kbo(:,45,15) = (/ & + & 0.12075e+04_r8,0.11422e+04_r8,0.10778e+04_r8,0.10187e+04_r8,0.96421e+03_r8 /) + kbo(:,46,15) = (/ & + & 0.12357e+04_r8,0.11671e+04_r8,0.11007e+04_r8,0.10396e+04_r8,0.98362e+03_r8 /) + kbo(:,47,15) = (/ & + & 0.12667e+04_r8,0.11958e+04_r8,0.11271e+04_r8,0.10639e+04_r8,0.10059e+04_r8 /) + kbo(:,48,15) = (/ & + & 0.12983e+04_r8,0.12254e+04_r8,0.11543e+04_r8,0.10888e+04_r8,0.10288e+04_r8 /) + kbo(:,49,15) = (/ & + & 0.13304e+04_r8,0.12559e+04_r8,0.11825e+04_r8,0.11147e+04_r8,0.10526e+04_r8 /) + kbo(:,50,15) = (/ & + & 0.13621e+04_r8,0.12852e+04_r8,0.12096e+04_r8,0.11397e+04_r8,0.10755e+04_r8 /) + kbo(:,51,15) = (/ & + & 0.13919e+04_r8,0.13140e+04_r8,0.12368e+04_r8,0.11648e+04_r8,0.10985e+04_r8 /) + kbo(:,52,15) = (/ & + & 0.14222e+04_r8,0.13432e+04_r8,0.12647e+04_r8,0.11905e+04_r8,0.11221e+04_r8 /) + kbo(:,53,15) = (/ & + & 0.14531e+04_r8,0.13729e+04_r8,0.12932e+04_r8,0.12171e+04_r8,0.11465e+04_r8 /) + kbo(:,54,15) = (/ & + & 0.14842e+04_r8,0.14002e+04_r8,0.13197e+04_r8,0.12421e+04_r8,0.11696e+04_r8 /) + kbo(:,55,15) = (/ & + & 0.15120e+04_r8,0.14267e+04_r8,0.13453e+04_r8,0.12667e+04_r8,0.11922e+04_r8 /) + kbo(:,56,15) = (/ & + & 0.15401e+04_r8,0.14538e+04_r8,0.13712e+04_r8,0.12915e+04_r8,0.12155e+04_r8 /) + kbo(:,57,15) = (/ & + & 0.15682e+04_r8,0.14811e+04_r8,0.13973e+04_r8,0.13167e+04_r8,0.12393e+04_r8 /) + kbo(:,58,15) = (/ & + & 0.15949e+04_r8,0.15073e+04_r8,0.14224e+04_r8,0.13410e+04_r8,0.12625e+04_r8 /) + kbo(:,59,15) = (/ & + & 0.16055e+04_r8,0.15180e+04_r8,0.14326e+04_r8,0.13507e+04_r8,0.12718e+04_r8 /) + kbo(:,13,16) = (/ & + & 0.98069e+03_r8,0.94212e+03_r8,0.90378e+03_r8,0.86861e+03_r8,0.83780e+03_r8 /) + kbo(:,14,16) = (/ & + & 0.11010e+04_r8,0.10540e+04_r8,0.10095e+04_r8,0.96975e+03_r8,0.93339e+03_r8 /) + kbo(:,15,16) = (/ & + & 0.12287e+04_r8,0.11714e+04_r8,0.11195e+04_r8,0.10736e+04_r8,0.10305e+04_r8 /) + kbo(:,16,16) = (/ & + & 0.13596e+04_r8,0.12909e+04_r8,0.12306e+04_r8,0.11762e+04_r8,0.11252e+04_r8 /) + kbo(:,17,16) = (/ & + & 0.14895e+04_r8,0.14091e+04_r8,0.13394e+04_r8,0.12751e+04_r8,0.12151e+04_r8 /) + kbo(:,18,16) = (/ & + & 0.16148e+04_r8,0.15230e+04_r8,0.14425e+04_r8,0.13683e+04_r8,0.12989e+04_r8 /) + kbo(:,19,16) = (/ & + & 0.17336e+04_r8,0.16302e+04_r8,0.15375e+04_r8,0.14530e+04_r8,0.13744e+04_r8 /) + kbo(:,20,16) = (/ & + & 0.18405e+04_r8,0.17248e+04_r8,0.16208e+04_r8,0.15267e+04_r8,0.14397e+04_r8 /) + kbo(:,21,16) = (/ & + & 0.19359e+04_r8,0.18083e+04_r8,0.16938e+04_r8,0.15909e+04_r8,0.14962e+04_r8 /) + kbo(:,22,16) = (/ & + & 0.20085e+04_r8,0.18707e+04_r8,0.17478e+04_r8,0.16373e+04_r8,0.15366e+04_r8 /) + kbo(:,23,16) = (/ & + & 0.20648e+04_r8,0.19188e+04_r8,0.17890e+04_r8,0.16725e+04_r8,0.15672e+04_r8 /) + kbo(:,24,16) = (/ & + & 0.21054e+04_r8,0.19528e+04_r8,0.18178e+04_r8,0.16967e+04_r8,0.15881e+04_r8 /) + kbo(:,25,16) = (/ & + & 0.21318e+04_r8,0.19742e+04_r8,0.18353e+04_r8,0.17113e+04_r8,0.16005e+04_r8 /) + kbo(:,26,16) = (/ & + & 0.21433e+04_r8,0.19836e+04_r8,0.18416e+04_r8,0.17161e+04_r8,0.16044e+04_r8 /) + kbo(:,27,16) = (/ & + & 0.21445e+04_r8,0.19835e+04_r8,0.18409e+04_r8,0.17145e+04_r8,0.16033e+04_r8 /) + kbo(:,28,16) = (/ & + & 0.21374e+04_r8,0.19764e+04_r8,0.18336e+04_r8,0.17081e+04_r8,0.15978e+04_r8 /) + kbo(:,29,16) = (/ & + & 0.21225e+04_r8,0.19618e+04_r8,0.18208e+04_r8,0.16961e+04_r8,0.15894e+04_r8 /) + kbo(:,30,16) = (/ & + & 0.21033e+04_r8,0.19434e+04_r8,0.18039e+04_r8,0.16808e+04_r8,0.15775e+04_r8 /) + kbo(:,31,16) = (/ & + & 0.20779e+04_r8,0.19206e+04_r8,0.17837e+04_r8,0.16635e+04_r8,0.15631e+04_r8 /) + kbo(:,32,16) = (/ & + & 0.20491e+04_r8,0.18949e+04_r8,0.17612e+04_r8,0.16447e+04_r8,0.15471e+04_r8 /) + kbo(:,33,16) = (/ & + & 0.20177e+04_r8,0.18682e+04_r8,0.17367e+04_r8,0.16246e+04_r8,0.15302e+04_r8 /) + kbo(:,34,16) = (/ & + & 0.19905e+04_r8,0.18445e+04_r8,0.17155e+04_r8,0.16076e+04_r8,0.15146e+04_r8 /) + kbo(:,35,16) = (/ & + & 0.19774e+04_r8,0.18329e+04_r8,0.17061e+04_r8,0.16001e+04_r8,0.15070e+04_r8 /) + kbo(:,36,16) = (/ & + & 0.19799e+04_r8,0.18350e+04_r8,0.17079e+04_r8,0.16017e+04_r8,0.15083e+04_r8 /) + kbo(:,37,16) = (/ & + & 0.20051e+04_r8,0.18569e+04_r8,0.17271e+04_r8,0.16176e+04_r8,0.15230e+04_r8 /) + kbo(:,38,16) = (/ & + & 0.20315e+04_r8,0.18800e+04_r8,0.17473e+04_r8,0.16343e+04_r8,0.15379e+04_r8 /) + kbo(:,39,16) = (/ & + & 0.20576e+04_r8,0.19026e+04_r8,0.17672e+04_r8,0.16508e+04_r8,0.15527e+04_r8 /) + kbo(:,40,16) = (/ & + & 0.21013e+04_r8,0.19405e+04_r8,0.18004e+04_r8,0.16787e+04_r8,0.15771e+04_r8 /) + kbo(:,41,16) = (/ & + & 0.21482e+04_r8,0.19814e+04_r8,0.18363e+04_r8,0.17091e+04_r8,0.16029e+04_r8 /) + kbo(:,42,16) = (/ & + & 0.21964e+04_r8,0.20236e+04_r8,0.18732e+04_r8,0.17410e+04_r8,0.16295e+04_r8 /) + kbo(:,43,16) = (/ & + & 0.22568e+04_r8,0.20769e+04_r8,0.19193e+04_r8,0.17816e+04_r8,0.16630e+04_r8 /) + kbo(:,44,16) = (/ & + & 0.23247e+04_r8,0.21362e+04_r8,0.19712e+04_r8,0.18270e+04_r8,0.17012e+04_r8 /) + kbo(:,45,16) = (/ & + & 0.23959e+04_r8,0.21983e+04_r8,0.20252e+04_r8,0.18744e+04_r8,0.17420e+04_r8 /) + kbo(:,46,16) = (/ & + & 0.24748e+04_r8,0.22670e+04_r8,0.20858e+04_r8,0.19269e+04_r8,0.17884e+04_r8 /) + kbo(:,47,16) = (/ & + & 0.25688e+04_r8,0.23479e+04_r8,0.21568e+04_r8,0.19886e+04_r8,0.18424e+04_r8 /) + kbo(:,48,16) = (/ & + & 0.26704e+04_r8,0.24334e+04_r8,0.22313e+04_r8,0.20542e+04_r8,0.18994e+04_r8 /) + kbo(:,49,16) = (/ & + & 0.27805e+04_r8,0.25238e+04_r8,0.23096e+04_r8,0.21232e+04_r8,0.19594e+04_r8 /) + kbo(:,50,16) = (/ & + & 0.28920e+04_r8,0.26151e+04_r8,0.23873e+04_r8,0.21911e+04_r8,0.20186e+04_r8 /) + kbo(:,51,16) = (/ & + & 0.30093e+04_r8,0.27098e+04_r8,0.24666e+04_r8,0.22601e+04_r8,0.20794e+04_r8 /) + kbo(:,52,16) = (/ & + & 0.31338e+04_r8,0.28121e+04_r8,0.25503e+04_r8,0.23323e+04_r8,0.21428e+04_r8 /) + kbo(:,53,16) = (/ & + & 0.32663e+04_r8,0.29228e+04_r8,0.26405e+04_r8,0.24086e+04_r8,0.22095e+04_r8 /) + kbo(:,54,16) = (/ & + & 0.33958e+04_r8,0.30317e+04_r8,0.27288e+04_r8,0.24819e+04_r8,0.22731e+04_r8 /) + kbo(:,55,16) = (/ & + & 0.35272e+04_r8,0.31418e+04_r8,0.28194e+04_r8,0.25560e+04_r8,0.23371e+04_r8 /) + kbo(:,56,16) = (/ & + & 0.36664e+04_r8,0.32577e+04_r8,0.29162e+04_r8,0.26350e+04_r8,0.24040e+04_r8 /) + kbo(:,57,16) = (/ & + & 0.38139e+04_r8,0.33808e+04_r8,0.30193e+04_r8,0.27188e+04_r8,0.24736e+04_r8 /) + kbo(:,58,16) = (/ & + & 0.39629e+04_r8,0.35038e+04_r8,0.31229e+04_r8,0.28034e+04_r8,0.25431e+04_r8 /) + kbo(:,59,16) = (/ & + & 0.40252e+04_r8,0.35562e+04_r8,0.31659e+04_r8,0.28393e+04_r8,0.25724e+04_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.525585e-05_r8, 0.527618e-05_r8, 0.746929e-04_r8 /) + forrefo(:, 2) = (/ 0.794660e-05_r8, 0.136902e-04_r8, 0.849878e-04_r8 /) + forrefo(:, 3) = (/ 0.197099e-04_r8, 0.733094e-04_r8, 0.121687e-03_r8 /) + forrefo(:, 4) = (/ 0.148274e-03_r8, 0.169776e-03_r8, 0.164848e-03_r8 /) + forrefo(:, 5) = (/ 0.230296e-03_r8, 0.210384e-03_r8, 0.182028e-03_r8 /) + forrefo(:, 6) = (/ 0.280575e-03_r8, 0.259217e-03_r8, 0.196080e-03_r8 /) + forrefo(:, 7) = (/ 0.329034e-03_r8, 0.291575e-03_r8, 0.207044e-03_r8 /) + forrefo(:, 8) = (/ 0.349989e-03_r8, 0.323471e-03_r8, 0.225712e-03_r8 /) + forrefo(:, 9) = (/ 0.366097e-03_r8, 0.321519e-03_r8, 0.253150e-03_r8 /) + forrefo(:,10) = (/ 0.383589e-03_r8, 0.355314e-03_r8, 0.262555e-03_r8 /) + forrefo(:,11) = (/ 0.375933e-03_r8, 0.372443e-03_r8, 0.261313e-03_r8 /) + forrefo(:,12) = (/ 0.370652e-03_r8, 0.382366e-03_r8, 0.250070e-03_r8 /) + forrefo(:,13) = (/ 0.375092e-03_r8, 0.379542e-03_r8, 0.265794e-03_r8 /) + forrefo(:,14) = (/ 0.389705e-03_r8, 0.384274e-03_r8, 0.322135e-03_r8 /) + forrefo(:,15) = (/ 0.372084e-03_r8, 0.390422e-03_r8, 0.370035e-03_r8 /) + forrefo(:,16) = (/ 0.437802e-03_r8, 0.373406e-03_r8, 0.373222e-03_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). +! ----------------------------------------------------------------- + + selfrefo(:, 1) = (/ & + & 0.126758e-02_r8, 0.105253e-02_r8, 0.873963e-03_r8, 0.725690e-03_r8, 0.602573e-03_r8, & + & 0.500344e-03_r8, 0.415458e-03_r8, 0.344973e-03_r8, 0.286447e-03_r8, 0.237849e-03_r8 /) + selfrefo(:, 2) = (/ & + & 0.144006e-02_r8, 0.118514e-02_r8, 0.975351e-03_r8, 0.802697e-03_r8, 0.660606e-03_r8, & + & 0.543667e-03_r8, 0.447429e-03_r8, 0.368226e-03_r8, 0.303044e-03_r8, 0.249400e-03_r8 /) + selfrefo(:, 3) = (/ & + & 0.294018e-02_r8, 0.227428e-02_r8, 0.175920e-02_r8, 0.136077e-02_r8, 0.105258e-02_r8, & + & 0.814189e-03_r8, 0.629789e-03_r8, 0.487153e-03_r8, 0.376821e-03_r8, 0.291478e-03_r8 /) + selfrefo(:, 4) = (/ & + & 0.395290e-02_r8, 0.348405e-02_r8, 0.307081e-02_r8, 0.270658e-02_r8, 0.238556e-02_r8, & + & 0.210261e-02_r8, 0.185322e-02_r8, 0.163341e-02_r8, 0.143967e-02_r8, 0.126891e-02_r8 /) + selfrefo(:, 5) = (/ & + & 0.419122e-02_r8, 0.385638e-02_r8, 0.354829e-02_r8, 0.326481e-02_r8, 0.300398e-02_r8, & + & 0.276399e-02_r8, 0.254317e-02_r8, 0.234000e-02_r8, 0.215305e-02_r8, 0.198104e-02_r8 /) + selfrefo(:, 6) = (/ & + & 0.495659e-02_r8, 0.456777e-02_r8, 0.420945e-02_r8, 0.387924e-02_r8, 0.357494e-02_r8, & + & 0.329450e-02_r8, 0.303606e-02_r8, 0.279790e-02_r8, 0.257842e-02_r8, 0.237615e-02_r8 /) + selfrefo(:, 7) = (/ & + & 0.526981e-02_r8, 0.490687e-02_r8, 0.456893e-02_r8, 0.425426e-02_r8, 0.396126e-02_r8, & + & 0.368844e-02_r8, 0.343441e-02_r8, 0.319788e-02_r8, 0.297764e-02_r8, 0.277256e-02_r8 /) + selfrefo(:, 8) = (/ & + & 0.575426e-02_r8, 0.531597e-02_r8, 0.491106e-02_r8, 0.453699e-02_r8, 0.419141e-02_r8, & + & 0.387216e-02_r8, 0.357722e-02_r8, 0.330475e-02_r8, 0.305303e-02_r8, 0.282048e-02_r8 /) + selfrefo(:, 9) = (/ & + & 0.549881e-02_r8, 0.514328e-02_r8, 0.481074e-02_r8, 0.449970e-02_r8, 0.420877e-02_r8, & + & 0.393665e-02_r8, 0.368213e-02_r8, 0.344406e-02_r8, 0.322138e-02_r8, 0.301310e-02_r8 /) + selfrefo(:,10) = (/ & + & 0.605357e-02_r8, 0.561246e-02_r8, 0.520349e-02_r8, 0.482432e-02_r8, 0.447278e-02_r8, & + & 0.414686e-02_r8, 0.384469e-02_r8, 0.356453e-02_r8, 0.330479e-02_r8, 0.306398e-02_r8 /) + selfrefo(:,11) = (/ & + & 0.640504e-02_r8, 0.587858e-02_r8, 0.539540e-02_r8, 0.495194e-02_r8, 0.454492e-02_r8, & + & 0.417136e-02_r8, 0.382850e-02_r8, 0.351382e-02_r8, 0.322501e-02_r8, 0.295993e-02_r8 /) + selfrefo(:,12) = (/ & + & 0.677803e-02_r8, 0.615625e-02_r8, 0.559152e-02_r8, 0.507859e-02_r8, 0.461271e-02_r8, & + & 0.418957e-02_r8, 0.380524e-02_r8, 0.345617e-02_r8, 0.313913e-02_r8, 0.285116e-02_r8 /) + selfrefo(:,13) = (/ & + & 0.690347e-02_r8, 0.627003e-02_r8, 0.569472e-02_r8, 0.517219e-02_r8, 0.469761e-02_r8, & + & 0.426658e-02_r8, 0.387509e-02_r8, 0.351953e-02_r8, 0.319659e-02_r8, 0.290328e-02_r8 /) + selfrefo(:,14) = (/ & + & 0.692680e-02_r8, 0.632795e-02_r8, 0.578087e-02_r8, 0.528109e-02_r8, 0.482452e-02_r8, & + & 0.440742e-02_r8, 0.402638e-02_r8, 0.367828e-02_r8, 0.336028e-02_r8, 0.306977e-02_r8 /) + selfrefo(:,15) = (/ & + & 0.754894e-02_r8, 0.681481e-02_r8, 0.615207e-02_r8, 0.555378e-02_r8, 0.501367e-02_r8, & + & 0.452609e-02_r8, 0.408593e-02_r8, 0.368857e-02_r8, 0.332986e-02_r8, 0.300603e-02_r8 /) + selfrefo(:,16) = (/ & + & 0.760689e-02_r8, 0.709755e-02_r8, 0.662232e-02_r8, 0.617891e-02_r8, 0.576519e-02_r8, & + & 0.537917e-02_r8, 0.501899e-02_r8, 0.468293e-02_r8, 0.436938e-02_r8, 0.407682e-02_r8 /) + + end subroutine sw_kgb16 + +! ************************************************************************** + subroutine sw_kgb17 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg17, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:,1) = (/ & + & 3.15613_r8 , 3.03449_r8 , 2.92069_r8 , 2.63874_r8 , & + & 2.34581_r8 , 2.06999_r8 , 1.70906_r8 , 1.29085_r8 , & + & 0.874851_r8 , 0.0955392_r8, 0.0787813_r8, 0.0621951_r8 , & + & 0.0459076_r8, 0.0294129_r8, 0.0110387_r8, 0.00159668_r8 /) + sfluxrefo(:,2) = (/ & + & 2.83147_r8 , 2.95919_r8 , 2.96674_r8 , 2.77677_r8 , & + & 2.46826_r8 , 2.11481_r8 , 1.73243_r8 , 1.30279_r8 , & + & 0.882714_r8 , 0.0962350_r8, 0.0802122_r8, 0.0636194_r8 , & + & 0.0472620_r8, 0.0299051_r8, 0.0110785_r8, 0.00159668_r8 /) + sfluxrefo(:,3) = (/ & + & 2.82300_r8 , 2.94845_r8 , 2.95887_r8 , 2.77593_r8 , & + & 2.47096_r8 , 2.12596_r8 , 1.73847_r8 , 1.30796_r8 , & + & 0.884395_r8 , 0.0966936_r8, 0.0801996_r8, 0.0640199_r8 , & + & 0.0472803_r8, 0.0300515_r8, 0.0112366_r8, 0.00160814_r8 /) + sfluxrefo(:,4) = (/ & + & 2.81715_r8 , 2.93789_r8 , 2.95091_r8 , 2.77046_r8 , & + & 2.47716_r8 , 2.13591_r8 , 1.74365_r8 , 1.31277_r8 , & + & 0.887443_r8 , 0.0967016_r8, 0.0803391_r8, 0.0642442_r8 , & + & 0.0472909_r8, 0.0300720_r8, 0.0114817_r8, 0.00161875_r8 /) + sfluxrefo(:,5) = (/ & + & 2.82335_r8 , 2.93168_r8 , 2.91455_r8 , 2.75213_r8 , & + & 2.49168_r8 , 2.14408_r8 , 1.75726_r8 , 1.32401_r8 , & + & 0.893644_r8 , 0.0969523_r8, 0.0805197_r8, 0.0639936_r8 , & + & 0.0475099_r8, 0.0305667_r8, 0.0115372_r8, 0.00161875_r8 /) + +! Rayleigh extinction coefficient at v = 3625 cm-1. + rayl = 6.86e-10_r8 + + strrat = 0.364641_r8 + + layreffr = 30 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.11134e-05_r8,0.32092e-03_r8,0.55663e-03_r8,0.78227e-03_r8,0.99421e-03_r8, & + & 0.12045e-02_r8,0.14116e-02_r8,0.16069e-02_r8,0.19330e-02_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.10544e-05_r8,0.35434e-03_r8,0.61480e-03_r8,0.86424e-03_r8,0.11055e-02_r8, & + & 0.13431e-02_r8,0.15754e-02_r8,0.17951e-02_r8,0.21280e-02_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.98345e-06_r8,0.38989e-03_r8,0.67747e-03_r8,0.95289e-03_r8,0.12196e-02_r8, & + & 0.14864e-02_r8,0.17449e-02_r8,0.19897e-02_r8,0.23564e-02_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.95017e-06_r8,0.42582e-03_r8,0.74419e-03_r8,0.10463e-02_r8,0.13424e-02_r8, & + & 0.16353e-02_r8,0.19215e-02_r8,0.21939e-02_r8,0.25993e-02_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.91870e-06_r8,0.46371e-03_r8,0.81394e-03_r8,0.11464e-02_r8,0.14715e-02_r8, & + & 0.17937e-02_r8,0.21072e-02_r8,0.24077e-02_r8,0.28540e-02_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.94184e-06_r8,0.26532e-03_r8,0.46157e-03_r8,0.63776e-03_r8,0.81087e-03_r8, & + & 0.97728e-03_r8,0.11419e-02_r8,0.12991e-02_r8,0.15121e-02_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.89060e-06_r8,0.29417e-03_r8,0.50967e-03_r8,0.70759e-03_r8,0.90203e-03_r8, & + & 0.10920e-02_r8,0.12764e-02_r8,0.14544e-02_r8,0.16795e-02_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.82720e-06_r8,0.32361e-03_r8,0.56124e-03_r8,0.78299e-03_r8,0.99718e-03_r8, & + & 0.12094e-02_r8,0.14172e-02_r8,0.16165e-02_r8,0.18637e-02_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.78842e-06_r8,0.35495e-03_r8,0.61684e-03_r8,0.86176e-03_r8,0.10995e-02_r8, & + & 0.13345e-02_r8,0.15652e-02_r8,0.17856e-02_r8,0.20621e-02_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.76610e-06_r8,0.38728e-03_r8,0.67538e-03_r8,0.94613e-03_r8,0.12082e-02_r8, & + & 0.14675e-02_r8,0.17206e-02_r8,0.19640e-02_r8,0.22720e-02_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.79663e-06_r8,0.21369e-03_r8,0.37088e-03_r8,0.51222e-03_r8,0.64549e-03_r8, & + & 0.77322e-03_r8,0.89939e-03_r8,0.10205e-02_r8,0.11568e-02_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.75955e-06_r8,0.23780e-03_r8,0.41153e-03_r8,0.56901e-03_r8,0.72009e-03_r8, & + & 0.86735e-03_r8,0.10092e-02_r8,0.11476e-02_r8,0.12913e-02_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.71692e-06_r8,0.26276e-03_r8,0.45488e-03_r8,0.62922e-03_r8,0.79836e-03_r8, & + & 0.96259e-03_r8,0.11236e-02_r8,0.12796e-02_r8,0.14398e-02_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.66348e-06_r8,0.28896e-03_r8,0.50221e-03_r8,0.69411e-03_r8,0.88226e-03_r8, & + & 0.10658e-02_r8,0.12456e-02_r8,0.14191e-02_r8,0.15991e-02_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.64013e-06_r8,0.31643e-03_r8,0.55166e-03_r8,0.76434e-03_r8,0.97216e-03_r8, & + & 0.11745e-02_r8,0.13731e-02_r8,0.15657e-02_r8,0.17671e-02_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.66217e-06_r8,0.16966e-03_r8,0.29358e-03_r8,0.40688e-03_r8,0.51114e-03_r8, & + & 0.60739e-03_r8,0.70191e-03_r8,0.79446e-03_r8,0.88832e-03_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.64111e-06_r8,0.18902e-03_r8,0.32742e-03_r8,0.45364e-03_r8,0.57086e-03_r8, & + & 0.68401e-03_r8,0.79116e-03_r8,0.89507e-03_r8,0.99655e-03_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.60729e-06_r8,0.21007e-03_r8,0.36354e-03_r8,0.50354e-03_r8,0.63459e-03_r8, & + & 0.76113e-03_r8,0.88473e-03_r8,0.10035e-02_r8,0.11163e-02_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.57250e-06_r8,0.23203e-03_r8,0.40245e-03_r8,0.55758e-03_r8,0.70295e-03_r8, & + & 0.84515e-03_r8,0.98379e-03_r8,0.11165e-02_r8,0.12444e-02_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.53524e-06_r8,0.25529e-03_r8,0.44399e-03_r8,0.61564e-03_r8,0.77626e-03_r8, & + & 0.93405e-03_r8,0.10892e-02_r8,0.12369e-02_r8,0.13795e-02_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.55112e-06_r8,0.13422e-03_r8,0.23166e-03_r8,0.32119e-03_r8,0.40265e-03_r8, & + & 0.47812e-03_r8,0.54797e-03_r8,0.61873e-03_r8,0.68912e-03_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.53669e-06_r8,0.14990e-03_r8,0.25949e-03_r8,0.35886e-03_r8,0.45239e-03_r8, & + & 0.53936e-03_r8,0.61894e-03_r8,0.69718e-03_r8,0.77732e-03_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.51495e-06_r8,0.16706e-03_r8,0.28960e-03_r8,0.40020e-03_r8,0.50461e-03_r8, & + & 0.60249e-03_r8,0.69677e-03_r8,0.78464e-03_r8,0.87334e-03_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.48633e-06_r8,0.18543e-03_r8,0.32159e-03_r8,0.44499e-03_r8,0.56095e-03_r8, & + & 0.67055e-03_r8,0.77575e-03_r8,0.87717e-03_r8,0.97694e-03_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.45162e-06_r8,0.20472e-03_r8,0.35591e-03_r8,0.49350e-03_r8,0.62163e-03_r8, & + & 0.74253e-03_r8,0.86247e-03_r8,0.97518e-03_r8,0.10864e-02_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.45055e-06_r8,0.10556e-03_r8,0.18176e-03_r8,0.25137e-03_r8,0.31438e-03_r8, & + & 0.37363e-03_r8,0.42759e-03_r8,0.47883e-03_r8,0.53437e-03_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.44502e-06_r8,0.11814e-03_r8,0.20383e-03_r8,0.28162e-03_r8,0.35547e-03_r8, & + & 0.42261e-03_r8,0.48340e-03_r8,0.54066e-03_r8,0.60352e-03_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.43066e-06_r8,0.13217e-03_r8,0.22836e-03_r8,0.31552e-03_r8,0.39762e-03_r8, & + & 0.47493e-03_r8,0.54543e-03_r8,0.61066e-03_r8,0.68176e-03_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.41116e-06_r8,0.14733e-03_r8,0.25472e-03_r8,0.35204e-03_r8,0.44334e-03_r8, & + & 0.52997e-03_r8,0.60966e-03_r8,0.68622e-03_r8,0.76607e-03_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.38748e-06_r8,0.16344e-03_r8,0.28281e-03_r8,0.39173e-03_r8,0.49305e-03_r8, & + & 0.58880e-03_r8,0.67954e-03_r8,0.76485e-03_r8,0.85401e-03_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.36582e-06_r8,0.82958e-04_r8,0.14210e-03_r8,0.19574e-03_r8,0.24440e-03_r8, & + & 0.29039e-03_r8,0.33281e-03_r8,0.37177e-03_r8,0.42178e-03_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.36707e-06_r8,0.92909e-04_r8,0.15977e-03_r8,0.22034e-03_r8,0.27742e-03_r8, & + & 0.32955e-03_r8,0.37727e-03_r8,0.41956e-03_r8,0.47859e-03_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.35787e-06_r8,0.10432e-03_r8,0.17930e-03_r8,0.24769e-03_r8,0.31155e-03_r8, & + & 0.37242e-03_r8,0.42699e-03_r8,0.47474e-03_r8,0.54083e-03_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.34482e-06_r8,0.11685e-03_r8,0.20055e-03_r8,0.27725e-03_r8,0.34866e-03_r8, & + & 0.41677e-03_r8,0.47903e-03_r8,0.53518e-03_r8,0.60812e-03_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.32598e-06_r8,0.13001e-03_r8,0.22341e-03_r8,0.30900e-03_r8,0.38919e-03_r8, & + & 0.46465e-03_r8,0.53467e-03_r8,0.59926e-03_r8,0.67733e-03_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.29834e-06_r8,0.65009e-04_r8,0.11183e-03_r8,0.15200e-03_r8,0.18969e-03_r8, & + & 0.22517e-03_r8,0.25832e-03_r8,0.28730e-03_r8,0.33955e-03_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.29745e-06_r8,0.72872e-04_r8,0.12482e-03_r8,0.17221e-03_r8,0.21583e-03_r8, & + & 0.25596e-03_r8,0.29328e-03_r8,0.32520e-03_r8,0.38620e-03_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.29421e-06_r8,0.82036e-04_r8,0.14010e-03_r8,0.19344e-03_r8,0.24362e-03_r8, & + & 0.29071e-03_r8,0.33308e-03_r8,0.36867e-03_r8,0.43901e-03_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.28596e-06_r8,0.92256e-04_r8,0.15738e-03_r8,0.21752e-03_r8,0.27325e-03_r8, & + & 0.32643e-03_r8,0.37578e-03_r8,0.41710e-03_r8,0.49358e-03_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.27296e-06_r8,0.10320e-03_r8,0.17598e-03_r8,0.24339e-03_r8,0.30591e-03_r8, & + & 0.36505e-03_r8,0.42061e-03_r8,0.46872e-03_r8,0.54993e-03_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.24259e-06_r8,0.50626e-04_r8,0.86945e-04_r8,0.11778e-03_r8,0.14692e-03_r8, & + & 0.17431e-03_r8,0.20057e-03_r8,0.22131e-03_r8,0.29919e-03_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.24058e-06_r8,0.56966e-04_r8,0.97467e-04_r8,0.13405e-03_r8,0.16750e-03_r8, & + & 0.19814e-03_r8,0.22739e-03_r8,0.25281e-03_r8,0.34022e-03_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.24091e-06_r8,0.64324e-04_r8,0.10971e-03_r8,0.15061e-03_r8,0.18996e-03_r8, & + & 0.22580e-03_r8,0.25885e-03_r8,0.28694e-03_r8,0.38045e-03_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.23550e-06_r8,0.72451e-04_r8,0.12345e-03_r8,0.16991e-03_r8,0.21362e-03_r8, & + & 0.25484e-03_r8,0.29341e-03_r8,0.32523e-03_r8,0.42836e-03_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.22696e-06_r8,0.81351e-04_r8,0.13839e-03_r8,0.19090e-03_r8,0.23986e-03_r8, & + & 0.28608e-03_r8,0.32910e-03_r8,0.36639e-03_r8,0.47925e-03_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.19679e-06_r8,0.39760e-04_r8,0.68052e-04_r8,0.92295e-04_r8,0.11498e-03_r8, & + & 0.13656e-03_r8,0.15604e-03_r8,0.17171e-03_r8,0.29679e-03_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.19567e-06_r8,0.44847e-04_r8,0.76829e-04_r8,0.10518e-03_r8,0.13102e-03_r8, & + & 0.15509e-03_r8,0.17764e-03_r8,0.19843e-03_r8,0.32863e-03_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.19574e-06_r8,0.50565e-04_r8,0.86466e-04_r8,0.11878e-03_r8,0.14920e-03_r8, & + & 0.17698e-03_r8,0.20258e-03_r8,0.22526e-03_r8,0.36959e-03_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.19262e-06_r8,0.57124e-04_r8,0.97546e-04_r8,0.13398e-03_r8,0.16803e-03_r8, & + & 0.20046e-03_r8,0.23022e-03_r8,0.25578e-03_r8,0.41543e-03_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.18747e-06_r8,0.64264e-04_r8,0.10971e-03_r8,0.15086e-03_r8,0.18923e-03_r8, & + & 0.22565e-03_r8,0.25934e-03_r8,0.28921e-03_r8,0.46463e-03_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.16015e-06_r8,0.33025e-04_r8,0.56562e-04_r8,0.76625e-04_r8,0.95645e-04_r8, & + & 0.11358e-03_r8,0.12955e-03_r8,0.14269e-03_r8,0.27545e-03_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.15918e-06_r8,0.37148e-04_r8,0.63775e-04_r8,0.87600e-04_r8,0.10897e-03_r8, & + & 0.12893e-03_r8,0.14756e-03_r8,0.16465e-03_r8,0.30799e-03_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.15897e-06_r8,0.41993e-04_r8,0.72040e-04_r8,0.98928e-04_r8,0.12433e-03_r8, & + & 0.14733e-03_r8,0.16824e-03_r8,0.18694e-03_r8,0.34340e-03_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.15578e-06_r8,0.47441e-04_r8,0.81426e-04_r8,0.11165e-03_r8,0.13985e-03_r8, & + & 0.16673e-03_r8,0.19156e-03_r8,0.21268e-03_r8,0.38176e-03_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.15210e-06_r8,0.53398e-04_r8,0.91657e-04_r8,0.12592e-03_r8,0.15769e-03_r8, & + & 0.18781e-03_r8,0.21569e-03_r8,0.24069e-03_r8,0.42228e-03_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.13021e-06_r8,0.27272e-04_r8,0.46832e-04_r8,0.63511e-04_r8,0.79205e-04_r8, & + & 0.93949e-04_r8,0.10719e-03_r8,0.11827e-03_r8,0.23944e-03_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.12930e-06_r8,0.30686e-04_r8,0.52925e-04_r8,0.72782e-04_r8,0.90527e-04_r8, & + & 0.10708e-03_r8,0.12236e-03_r8,0.13620e-03_r8,0.27121e-03_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.12900e-06_r8,0.34723e-04_r8,0.59867e-04_r8,0.82205e-04_r8,0.10326e-03_r8, & + & 0.12238e-03_r8,0.13958e-03_r8,0.15498e-03_r8,0.29930e-03_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.12648e-06_r8,0.39252e-04_r8,0.67618e-04_r8,0.92949e-04_r8,0.11636e-03_r8, & + & 0.13835e-03_r8,0.15924e-03_r8,0.17653e-03_r8,0.33050e-03_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.12299e-06_r8,0.44213e-04_r8,0.76244e-04_r8,0.10488e-03_r8,0.13135e-03_r8, & + & 0.15601e-03_r8,0.17902e-03_r8,0.19976e-03_r8,0.36579e-03_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.10554e-06_r8,0.22388e-04_r8,0.38597e-04_r8,0.52378e-04_r8,0.65404e-04_r8, & + & 0.77567e-04_r8,0.88543e-04_r8,0.97801e-04_r8,0.19599e-03_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.10480e-06_r8,0.25181e-04_r8,0.43670e-04_r8,0.60205e-04_r8,0.74883e-04_r8, & + & 0.88605e-04_r8,0.10117e-03_r8,0.11242e-03_r8,0.22146e-03_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.10429e-06_r8,0.28530e-04_r8,0.49422e-04_r8,0.68039e-04_r8,0.85435e-04_r8, & + & 0.10136e-03_r8,0.11557e-03_r8,0.12828e-03_r8,0.24447e-03_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.10232e-06_r8,0.32301e-04_r8,0.55797e-04_r8,0.76948e-04_r8,0.96447e-04_r8, & + & 0.11462e-03_r8,0.13166e-03_r8,0.14616e-03_r8,0.26999e-03_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.99014e-07_r8,0.36394e-04_r8,0.62994e-04_r8,0.86946e-04_r8,0.10900e-03_r8, & + & 0.12937e-03_r8,0.14833e-03_r8,0.16540e-03_r8,0.29916e-03_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.23488e-04_r8,0.16684e-02_r8,0.29575e-02_r8,0.40083e-02_r8,0.49953e-02_r8, & + & 0.59021e-02_r8,0.67446e-02_r8,0.76008e-02_r8,0.87032e-02_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.25156e-04_r8,0.18462e-02_r8,0.32711e-02_r8,0.45008e-02_r8,0.56182e-02_r8, & + & 0.66287e-02_r8,0.75909e-02_r8,0.85558e-02_r8,0.97543e-02_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.27084e-04_r8,0.20325e-02_r8,0.36034e-02_r8,0.49992e-02_r8,0.62796e-02_r8, & + & 0.74134e-02_r8,0.84994e-02_r8,0.95694e-02_r8,0.10847e-01_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.28147e-04_r8,0.22347e-02_r8,0.39628e-02_r8,0.55005e-02_r8,0.69453e-02_r8, & + & 0.82429e-02_r8,0.94699e-02_r8,0.10660e-01_r8,0.11991e-01_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.28719e-04_r8,0.24475e-02_r8,0.43369e-02_r8,0.60360e-02_r8,0.76183e-02_r8, & + & 0.90878e-02_r8,0.10493e-01_r8,0.11805e-01_r8,0.13204e-01_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.20947e-04_r8,0.14015e-02_r8,0.24728e-02_r8,0.33676e-02_r8,0.41801e-02_r8, & + & 0.49244e-02_r8,0.55787e-02_r8,0.62206e-02_r8,0.69741e-02_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.22352e-04_r8,0.15535e-02_r8,0.27396e-02_r8,0.37870e-02_r8,0.47121e-02_r8, & + & 0.55571e-02_r8,0.62892e-02_r8,0.70132e-02_r8,0.78092e-02_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.23882e-04_r8,0.17213e-02_r8,0.30345e-02_r8,0.42020e-02_r8,0.52782e-02_r8, & + & 0.62285e-02_r8,0.70556e-02_r8,0.78819e-02_r8,0.87330e-02_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.24650e-04_r8,0.18954e-02_r8,0.33384e-02_r8,0.46336e-02_r8,0.58333e-02_r8, & + & 0.69311e-02_r8,0.78751e-02_r8,0.88149e-02_r8,0.96911e-02_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.25136e-04_r8,0.20806e-02_r8,0.36641e-02_r8,0.50966e-02_r8,0.64193e-02_r8, & + & 0.76281e-02_r8,0.87403e-02_r8,0.97943e-02_r8,0.10704e-01_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.17720e-04_r8,0.11414e-02_r8,0.20045e-02_r8,0.27288e-02_r8,0.33891e-02_r8, & + & 0.39755e-02_r8,0.44967e-02_r8,0.49389e-02_r8,0.53858e-02_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.19087e-04_r8,0.12745e-02_r8,0.22336e-02_r8,0.30841e-02_r8,0.38333e-02_r8, & + & 0.44983e-02_r8,0.50895e-02_r8,0.55930e-02_r8,0.60666e-02_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.20125e-04_r8,0.14178e-02_r8,0.24795e-02_r8,0.34278e-02_r8,0.43106e-02_r8, & + & 0.50607e-02_r8,0.57280e-02_r8,0.63092e-02_r8,0.68285e-02_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.20895e-04_r8,0.15666e-02_r8,0.27348e-02_r8,0.37934e-02_r8,0.47769e-02_r8, & + & 0.56621e-02_r8,0.64046e-02_r8,0.70864e-02_r8,0.76026e-02_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.21508e-04_r8,0.17251e-02_r8,0.30153e-02_r8,0.41809e-02_r8,0.52689e-02_r8, & + & 0.62462e-02_r8,0.71125e-02_r8,0.79104e-02_r8,0.84389e-02_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.14661e-04_r8,0.92261e-03_r8,0.16088e-02_r8,0.21788e-02_r8,0.26956e-02_r8, & + & 0.31612e-02_r8,0.35626e-02_r8,0.38878e-02_r8,0.41525e-02_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.15607e-04_r8,0.10329e-02_r8,0.17973e-02_r8,0.24735e-02_r8,0.30696e-02_r8, & + & 0.35953e-02_r8,0.40511e-02_r8,0.44162e-02_r8,0.46990e-02_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.16559e-04_r8,0.11550e-02_r8,0.20019e-02_r8,0.27577e-02_r8,0.34625e-02_r8, & + & 0.40662e-02_r8,0.45831e-02_r8,0.49995e-02_r8,0.53073e-02_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.17263e-04_r8,0.12794e-02_r8,0.22184e-02_r8,0.30614e-02_r8,0.38510e-02_r8, & + & 0.45664e-02_r8,0.51532e-02_r8,0.56290e-02_r8,0.59436e-02_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.17895e-04_r8,0.14130e-02_r8,0.24526e-02_r8,0.33805e-02_r8,0.42622e-02_r8, & + & 0.50556e-02_r8,0.57489e-02_r8,0.63094e-02_r8,0.66256e-02_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.11885e-04_r8,0.74888e-03_r8,0.12826e-02_r8,0.17258e-02_r8,0.21346e-02_r8, & + & 0.24972e-02_r8,0.28046e-02_r8,0.30606e-02_r8,0.32323e-02_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.12452e-04_r8,0.84084e-03_r8,0.14380e-02_r8,0.19698e-02_r8,0.24386e-02_r8, & + & 0.28536e-02_r8,0.32075e-02_r8,0.34937e-02_r8,0.36562e-02_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.13439e-04_r8,0.94272e-03_r8,0.16065e-02_r8,0.22079e-02_r8,0.27660e-02_r8, & + & 0.32389e-02_r8,0.36440e-02_r8,0.39673e-02_r8,0.41393e-02_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.14053e-04_r8,0.10473e-02_r8,0.17899e-02_r8,0.24603e-02_r8,0.30861e-02_r8, & + & 0.36521e-02_r8,0.41156e-02_r8,0.44825e-02_r8,0.46529e-02_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.14586e-04_r8,0.11585e-02_r8,0.19886e-02_r8,0.27257e-02_r8,0.34272e-02_r8, & + & 0.40599e-02_r8,0.46115e-02_r8,0.50286e-02_r8,0.52085e-02_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.94872e-05_r8,0.59793e-03_r8,0.10210e-02_r8,0.13572e-02_r8,0.16716e-02_r8, & + & 0.19512e-02_r8,0.21890e-02_r8,0.23827e-02_r8,0.25347e-02_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.10060e-04_r8,0.67400e-03_r8,0.11432e-02_r8,0.15564e-02_r8,0.19188e-02_r8, & + & 0.22389e-02_r8,0.25161e-02_r8,0.27308e-02_r8,0.28770e-02_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.10743e-04_r8,0.75948e-03_r8,0.12806e-02_r8,0.17551e-02_r8,0.21862e-02_r8, & + & 0.25545e-02_r8,0.28729e-02_r8,0.31149e-02_r8,0.32716e-02_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.11322e-04_r8,0.85134e-03_r8,0.14320e-02_r8,0.19630e-02_r8,0.24514e-02_r8, & + & 0.28930e-02_r8,0.32578e-02_r8,0.35375e-02_r8,0.36912e-02_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.11755e-04_r8,0.94611e-03_r8,0.15986e-02_r8,0.21804e-02_r8,0.27291e-02_r8, & + & 0.32306e-02_r8,0.36695e-02_r8,0.39913e-02_r8,0.41439e-02_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.75931e-05_r8,0.47130e-03_r8,0.81211e-03_r8,0.10658e-02_r8,0.13004e-02_r8, & + & 0.15175e-02_r8,0.17002e-02_r8,0.18473e-02_r8,0.19861e-02_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.80724e-05_r8,0.53358e-03_r8,0.91163e-03_r8,0.12261e-02_r8,0.15014e-02_r8, & + & 0.17483e-02_r8,0.19612e-02_r8,0.21201e-02_r8,0.22591e-02_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.84404e-05_r8,0.60517e-03_r8,0.10236e-02_r8,0.13887e-02_r8,0.17204e-02_r8, & + & 0.20031e-02_r8,0.22497e-02_r8,0.24321e-02_r8,0.25823e-02_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.90511e-05_r8,0.68037e-03_r8,0.11475e-02_r8,0.15596e-02_r8,0.19402e-02_r8, & + & 0.22789e-02_r8,0.25633e-02_r8,0.27753e-02_r8,0.29247e-02_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.94405e-05_r8,0.76103e-03_r8,0.12836e-02_r8,0.17422e-02_r8,0.21698e-02_r8, & + & 0.25585e-02_r8,0.28989e-02_r8,0.31444e-02_r8,0.33016e-02_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.58080e-05_r8,0.36782e-03_r8,0.63516e-03_r8,0.83799e-03_r8,0.10119e-02_r8, & + & 0.11754e-02_r8,0.13161e-02_r8,0.14382e-02_r8,0.15837e-02_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.63156e-05_r8,0.41909e-03_r8,0.71974e-03_r8,0.96952e-03_r8,0.11711e-02_r8, & + & 0.13617e-02_r8,0.15234e-02_r8,0.16441e-02_r8,0.18118e-02_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.66776e-05_r8,0.47829e-03_r8,0.81150e-03_r8,0.11056e-02_r8,0.13493e-02_r8, & + & 0.15646e-02_r8,0.17524e-02_r8,0.18937e-02_r8,0.20698e-02_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.70582e-05_r8,0.54017e-03_r8,0.91330e-03_r8,0.12434e-02_r8,0.15411e-02_r8, & + & 0.17884e-02_r8,0.20057e-02_r8,0.21704e-02_r8,0.23548e-02_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.74902e-05_r8,0.60717e-03_r8,0.10267e-02_r8,0.13908e-02_r8,0.17231e-02_r8, & + & 0.20285e-02_r8,0.22810e-02_r8,0.24710e-02_r8,0.26631e-02_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.45061e-05_r8,0.28626e-03_r8,0.49448e-03_r8,0.65317e-03_r8,0.79081e-03_r8, & + & 0.91066e-03_r8,0.10182e-02_r8,0.11107e-02_r8,0.14592e-02_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.49392e-05_r8,0.32734e-03_r8,0.56558e-03_r8,0.76077e-03_r8,0.91846e-03_r8, & + & 0.10578e-02_r8,0.11776e-02_r8,0.12720e-02_r8,0.16778e-02_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.52580e-05_r8,0.37522e-03_r8,0.63845e-03_r8,0.87805e-03_r8,0.10619e-02_r8, & + & 0.12194e-02_r8,0.13606e-02_r8,0.14680e-02_r8,0.19259e-02_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.54991e-05_r8,0.42659e-03_r8,0.72103e-03_r8,0.98756e-03_r8,0.12163e-02_r8, & + & 0.14007e-02_r8,0.15647e-02_r8,0.16900e-02_r8,0.21772e-02_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.58769e-05_r8,0.48199e-03_r8,0.81466e-03_r8,0.11072e-02_r8,0.13684e-02_r8, & + & 0.15984e-02_r8,0.17887e-02_r8,0.19333e-02_r8,0.24331e-02_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.34154e-05_r8,0.22534e-03_r8,0.38788e-03_r8,0.51113e-03_r8,0.62194e-03_r8, & + & 0.71432e-03_r8,0.79743e-03_r8,0.86289e-03_r8,0.14758e-02_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.38085e-05_r8,0.25832e-03_r8,0.44748e-03_r8,0.59835e-03_r8,0.72514e-03_r8, & + & 0.83284e-03_r8,0.91941e-03_r8,0.99583e-03_r8,0.17358e-02_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.41578e-05_r8,0.29655e-03_r8,0.50553e-03_r8,0.69511e-03_r8,0.84107e-03_r8, & + & 0.96374e-03_r8,0.10666e-02_r8,0.11478e-02_r8,0.19625e-02_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.43917e-05_r8,0.33908e-03_r8,0.57351e-03_r8,0.78640e-03_r8,0.96862e-03_r8, & + & 0.11109e-02_r8,0.12309e-02_r8,0.13266e-02_r8,0.22103e-02_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.45446e-05_r8,0.38548e-03_r8,0.64883e-03_r8,0.88401e-03_r8,0.10952e-02_r8, & + & 0.12706e-02_r8,0.14136e-02_r8,0.15239e-02_r8,0.24754e-02_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.27604e-05_r8,0.18848e-03_r8,0.32532e-03_r8,0.42949e-03_r8,0.52350e-03_r8, & + & 0.60084e-03_r8,0.66640e-03_r8,0.72070e-03_r8,0.13692e-02_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.30908e-05_r8,0.21679e-03_r8,0.37259e-03_r8,0.50366e-03_r8,0.61074e-03_r8, & + & 0.70158e-03_r8,0.77271e-03_r8,0.83037e-03_r8,0.15689e-02_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.33674e-05_r8,0.24965e-03_r8,0.42244e-03_r8,0.58353e-03_r8,0.70923e-03_r8, & + & 0.81330e-03_r8,0.89750e-03_r8,0.96131e-03_r8,0.17971e-02_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.35568e-05_r8,0.28602e-03_r8,0.48044e-03_r8,0.65868e-03_r8,0.81816e-03_r8, & + & 0.93857e-03_r8,0.10357e-02_r8,0.11119e-02_r8,0.20509e-02_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.36921e-05_r8,0.32484e-03_r8,0.54623e-03_r8,0.74475e-03_r8,0.92307e-03_r8, & + & 0.10758e-02_r8,0.11895e-02_r8,0.12777e-02_r8,0.23253e-02_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.22272e-05_r8,0.15807e-03_r8,0.27163e-03_r8,0.35935e-03_r8,0.43781e-03_r8, & + & 0.50321e-03_r8,0.55776e-03_r8,0.60046e-03_r8,0.11852e-02_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.24898e-05_r8,0.18201e-03_r8,0.31004e-03_r8,0.42206e-03_r8,0.51226e-03_r8, & + & 0.58824e-03_r8,0.64919e-03_r8,0.69291e-03_r8,0.13623e-02_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.27021e-05_r8,0.20958e-03_r8,0.35322e-03_r8,0.48676e-03_r8,0.59587e-03_r8, & + & 0.68364e-03_r8,0.75527e-03_r8,0.80436e-03_r8,0.15654e-02_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.28526e-05_r8,0.24038e-03_r8,0.40262e-03_r8,0.55096e-03_r8,0.68671e-03_r8, & + & 0.79103e-03_r8,0.87211e-03_r8,0.93124e-03_r8,0.17898e-02_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.29899e-05_r8,0.27289e-03_r8,0.45904e-03_r8,0.62448e-03_r8,0.77496e-03_r8, & + & 0.90212e-03_r8,0.10018e-02_r8,0.10706e-02_r8,0.20265e-02_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.17576e-05_r8,0.13151e-03_r8,0.22518e-03_r8,0.29890e-03_r8,0.36398e-03_r8, & + & 0.41884e-03_r8,0.46505e-03_r8,0.50086e-03_r8,0.97916e-03_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.19524e-05_r8,0.15189e-03_r8,0.25686e-03_r8,0.35123e-03_r8,0.42723e-03_r8, & + & 0.49061e-03_r8,0.54293e-03_r8,0.57815e-03_r8,0.11260e-02_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.21134e-05_r8,0.17558e-03_r8,0.29382e-03_r8,0.40457e-03_r8,0.49777e-03_r8, & + & 0.57153e-03_r8,0.63185e-03_r8,0.67213e-03_r8,0.12960e-02_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.22681e-05_r8,0.20106e-03_r8,0.33583e-03_r8,0.45977e-03_r8,0.57094e-03_r8, & + & 0.66275e-03_r8,0.73149e-03_r8,0.77799e-03_r8,0.14856e-02_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.23940e-05_r8,0.22853e-03_r8,0.38323e-03_r8,0.52126e-03_r8,0.64684e-03_r8, & + & 0.75455e-03_r8,0.84115e-03_r8,0.89575e-03_r8,0.16816e-02_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.87154e-04_r8,0.70456e-02_r8,0.11624e-01_r8,0.16007e-01_r8,0.20277e-01_r8, & + & 0.24349e-01_r8,0.27902e-01_r8,0.30956e-01_r8,0.33159e-01_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.92678e-04_r8,0.75324e-02_r8,0.12552e-01_r8,0.17444e-01_r8,0.21967e-01_r8, & + & 0.26250e-01_r8,0.30241e-01_r8,0.33348e-01_r8,0.36164e-01_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.97955e-04_r8,0.80153e-02_r8,0.13502e-01_r8,0.18812e-01_r8,0.23862e-01_r8, & + & 0.28480e-01_r8,0.32511e-01_r8,0.35713e-01_r8,0.38349e-01_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.10404e-03_r8,0.84724e-02_r8,0.14429e-01_r8,0.20136e-01_r8,0.25672e-01_r8, & + & 0.30688e-01_r8,0.35011e-01_r8,0.38379e-01_r8,0.40673e-01_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.11110e-03_r8,0.89123e-02_r8,0.15343e-01_r8,0.21479e-01_r8,0.27290e-01_r8, & + & 0.32751e-01_r8,0.37455e-01_r8,0.40931e-01_r8,0.42463e-01_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.73214e-04_r8,0.61410e-02_r8,0.10125e-01_r8,0.13650e-01_r8,0.17158e-01_r8, & + & 0.20627e-01_r8,0.23628e-01_r8,0.26251e-01_r8,0.27481e-01_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.77936e-04_r8,0.65751e-02_r8,0.10966e-01_r8,0.14877e-01_r8,0.18693e-01_r8, & + & 0.22272e-01_r8,0.25630e-01_r8,0.28395e-01_r8,0.29894e-01_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.83061e-04_r8,0.69828e-02_r8,0.11774e-01_r8,0.16068e-01_r8,0.20317e-01_r8, & + & 0.24244e-01_r8,0.27748e-01_r8,0.30432e-01_r8,0.31851e-01_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.88564e-04_r8,0.73985e-02_r8,0.12581e-01_r8,0.17226e-01_r8,0.21842e-01_r8, & + & 0.26177e-01_r8,0.29969e-01_r8,0.32748e-01_r8,0.33805e-01_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.94933e-04_r8,0.77988e-02_r8,0.13372e-01_r8,0.18367e-01_r8,0.23323e-01_r8, & + & 0.27928e-01_r8,0.31964e-01_r8,0.35013e-01_r8,0.35327e-01_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.60947e-04_r8,0.52436e-02_r8,0.86174e-02_r8,0.11520e-01_r8,0.14231e-01_r8, & + & 0.17027e-01_r8,0.19469e-01_r8,0.21634e-01_r8,0.21981e-01_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.64921e-04_r8,0.55975e-02_r8,0.93512e-02_r8,0.12526e-01_r8,0.15516e-01_r8, & + & 0.18471e-01_r8,0.21270e-01_r8,0.23512e-01_r8,0.24114e-01_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.69521e-04_r8,0.59648e-02_r8,0.10060e-01_r8,0.13582e-01_r8,0.16903e-01_r8, & + & 0.20177e-01_r8,0.23055e-01_r8,0.25380e-01_r8,0.25822e-01_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.74348e-04_r8,0.63104e-02_r8,0.10767e-01_r8,0.14599e-01_r8,0.18273e-01_r8, & + & 0.21836e-01_r8,0.24984e-01_r8,0.27358e-01_r8,0.27450e-01_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.79780e-04_r8,0.66671e-02_r8,0.11458e-01_r8,0.15590e-01_r8,0.19579e-01_r8, & + & 0.23358e-01_r8,0.26806e-01_r8,0.29335e-01_r8,0.28786e-01_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.50799e-04_r8,0.44148e-02_r8,0.72225e-02_r8,0.96483e-02_r8,0.11767e-01_r8, & + & 0.13828e-01_r8,0.15844e-01_r8,0.17588e-01_r8,0.17391e-01_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.54227e-04_r8,0.47231e-02_r8,0.78527e-02_r8,0.10493e-01_r8,0.12835e-01_r8, & + & 0.15126e-01_r8,0.17466e-01_r8,0.19219e-01_r8,0.19351e-01_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.58151e-04_r8,0.50277e-02_r8,0.84823e-02_r8,0.11418e-01_r8,0.13969e-01_r8, & + & 0.16576e-01_r8,0.18903e-01_r8,0.20840e-01_r8,0.20853e-01_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.62433e-04_r8,0.53372e-02_r8,0.90813e-02_r8,0.12325e-01_r8,0.15163e-01_r8, & + & 0.17971e-01_r8,0.20590e-01_r8,0.22529e-01_r8,0.22273e-01_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.66852e-04_r8,0.56429e-02_r8,0.96836e-02_r8,0.13189e-01_r8,0.16280e-01_r8, & + & 0.19312e-01_r8,0.22136e-01_r8,0.24263e-01_r8,0.23466e-01_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.42593e-04_r8,0.36760e-02_r8,0.59913e-02_r8,0.79812e-02_r8,0.97729e-02_r8, & + & 0.11265e-01_r8,0.12874e-01_r8,0.14150e-01_r8,0.13651e-01_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.45779e-04_r8,0.39344e-02_r8,0.65401e-02_r8,0.87030e-02_r8,0.10650e-01_r8, & + & 0.12374e-01_r8,0.14135e-01_r8,0.15529e-01_r8,0.15507e-01_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.48868e-04_r8,0.42013e-02_r8,0.70859e-02_r8,0.94912e-02_r8,0.11609e-01_r8, & + & 0.13557e-01_r8,0.15381e-01_r8,0.16993e-01_r8,0.16785e-01_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.52509e-04_r8,0.44674e-02_r8,0.76022e-02_r8,0.10271e-01_r8,0.12630e-01_r8, & + & 0.14736e-01_r8,0.16830e-01_r8,0.18387e-01_r8,0.18040e-01_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.56196e-04_r8,0.47381e-02_r8,0.81005e-02_r8,0.11026e-01_r8,0.13586e-01_r8, & + & 0.15940e-01_r8,0.18160e-01_r8,0.19920e-01_r8,0.19092e-01_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.36112e-04_r8,0.30316e-02_r8,0.49038e-02_r8,0.65325e-02_r8,0.79606e-02_r8, & + & 0.91706e-02_r8,0.10285e-01_r8,0.11252e-01_r8,0.10556e-01_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.38502e-04_r8,0.32575e-02_r8,0.53855e-02_r8,0.71302e-02_r8,0.87200e-02_r8, & + & 0.10138e-01_r8,0.11319e-01_r8,0.12504e-01_r8,0.12109e-01_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.41070e-04_r8,0.34869e-02_r8,0.58643e-02_r8,0.78020e-02_r8,0.95232e-02_r8, & + & 0.11081e-01_r8,0.12413e-01_r8,0.13700e-01_r8,0.13350e-01_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.44034e-04_r8,0.37142e-02_r8,0.62924e-02_r8,0.84867e-02_r8,0.10400e-01_r8, & + & 0.12091e-01_r8,0.13614e-01_r8,0.14850e-01_r8,0.14396e-01_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.47021e-04_r8,0.39387e-02_r8,0.67171e-02_r8,0.91319e-02_r8,0.11231e-01_r8, & + & 0.13129e-01_r8,0.14745e-01_r8,0.16155e-01_r8,0.15392e-01_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.30001e-04_r8,0.24884e-02_r8,0.39787e-02_r8,0.53262e-02_r8,0.64254e-02_r8, & + & 0.74422e-02_r8,0.82418e-02_r8,0.87651e-02_r8,0.83241e-02_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.32067e-04_r8,0.26831e-02_r8,0.43873e-02_r8,0.58009e-02_r8,0.70881e-02_r8, & + & 0.82303e-02_r8,0.91115e-02_r8,0.99530e-02_r8,0.95843e-02_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.34414e-04_r8,0.28762e-02_r8,0.47981e-02_r8,0.63650e-02_r8,0.77555e-02_r8, & + & 0.90130e-02_r8,0.10051e-01_r8,0.10944e-01_r8,0.10687e-01_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.36543e-04_r8,0.30749e-02_r8,0.51697e-02_r8,0.69549e-02_r8,0.84939e-02_r8, & + & 0.98621e-02_r8,0.11012e-01_r8,0.11950e-01_r8,0.11596e-01_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.38986e-04_r8,0.32672e-02_r8,0.55268e-02_r8,0.74950e-02_r8,0.92206e-02_r8, & + & 0.10750e-01_r8,0.11970e-01_r8,0.13029e-01_r8,0.12461e-01_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.24718e-04_r8,0.20304e-02_r8,0.32253e-02_r8,0.42957e-02_r8,0.51621e-02_r8, & + & 0.59477e-02_r8,0.65543e-02_r8,0.67901e-02_r8,0.66578e-02_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.26226e-04_r8,0.22027e-02_r8,0.35528e-02_r8,0.46844e-02_r8,0.57463e-02_r8, & + & 0.66070e-02_r8,0.73566e-02_r8,0.79086e-02_r8,0.76807e-02_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.28095e-04_r8,0.23614e-02_r8,0.38960e-02_r8,0.51529e-02_r8,0.62773e-02_r8, & + & 0.72919e-02_r8,0.81475e-02_r8,0.87344e-02_r8,0.86509e-02_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.29856e-04_r8,0.25346e-02_r8,0.42180e-02_r8,0.56507e-02_r8,0.68867e-02_r8, & + & 0.79948e-02_r8,0.89169e-02_r8,0.96226e-02_r8,0.94212e-02_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.31432e-04_r8,0.26989e-02_r8,0.45288e-02_r8,0.61158e-02_r8,0.75231e-02_r8, & + & 0.87319e-02_r8,0.97447e-02_r8,0.10470e-01_r8,0.10172e-01_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.20151e-04_r8,0.16622e-02_r8,0.26102e-02_r8,0.34345e-02_r8,0.41518e-02_r8, & + & 0.47356e-02_r8,0.51198e-02_r8,0.52901e-02_r8,0.55608e-02_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.21290e-04_r8,0.18112e-02_r8,0.28622e-02_r8,0.37770e-02_r8,0.46098e-02_r8, & + & 0.52825e-02_r8,0.58719e-02_r8,0.62115e-02_r8,0.64287e-02_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.22604e-04_r8,0.19483e-02_r8,0.31536e-02_r8,0.41418e-02_r8,0.50513e-02_r8, & + & 0.58883e-02_r8,0.65199e-02_r8,0.70000e-02_r8,0.71641e-02_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.24039e-04_r8,0.20909e-02_r8,0.34321e-02_r8,0.45633e-02_r8,0.55575e-02_r8, & + & 0.64453e-02_r8,0.71800e-02_r8,0.77062e-02_r8,0.77821e-02_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.25275e-04_r8,0.22325e-02_r8,0.36976e-02_r8,0.49727e-02_r8,0.60945e-02_r8, & + & 0.70632e-02_r8,0.78696e-02_r8,0.84048e-02_r8,0.84571e-02_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.16520e-04_r8,0.13579e-02_r8,0.21217e-02_r8,0.27650e-02_r8,0.33209e-02_r8, & + & 0.37657e-02_r8,0.40263e-02_r8,0.41632e-02_r8,0.59019e-02_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.17307e-04_r8,0.14868e-02_r8,0.23230e-02_r8,0.30616e-02_r8,0.37000e-02_r8, & + & 0.42629e-02_r8,0.46958e-02_r8,0.48956e-02_r8,0.64729e-02_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.18210e-04_r8,0.16086e-02_r8,0.25635e-02_r8,0.33480e-02_r8,0.40827e-02_r8, & + & 0.47590e-02_r8,0.52424e-02_r8,0.56088e-02_r8,0.71072e-02_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.19263e-04_r8,0.17308e-02_r8,0.28038e-02_r8,0.37016e-02_r8,0.44933e-02_r8, & + & 0.52114e-02_r8,0.58224e-02_r8,0.62053e-02_r8,0.76445e-02_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.20450e-04_r8,0.18514e-02_r8,0.30286e-02_r8,0.40569e-02_r8,0.49417e-02_r8, & + & 0.57292e-02_r8,0.63809e-02_r8,0.68162e-02_r8,0.81800e-02_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.13743e-04_r8,0.11544e-02_r8,0.18005e-02_r8,0.23380e-02_r8,0.28127e-02_r8, & + & 0.32019e-02_r8,0.34184e-02_r8,0.35137e-02_r8,0.55132e-02_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.14314e-04_r8,0.12648e-02_r8,0.19811e-02_r8,0.25794e-02_r8,0.31283e-02_r8, & + & 0.35835e-02_r8,0.39635e-02_r8,0.41524e-02_r8,0.60640e-02_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.14980e-04_r8,0.13667e-02_r8,0.21846e-02_r8,0.28316e-02_r8,0.34390e-02_r8, & + & 0.40069e-02_r8,0.44283e-02_r8,0.47282e-02_r8,0.65662e-02_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.15843e-04_r8,0.14691e-02_r8,0.23844e-02_r8,0.31346e-02_r8,0.37915e-02_r8, & + & 0.43926e-02_r8,0.49108e-02_r8,0.52431e-02_r8,0.70521e-02_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.16801e-04_r8,0.15709e-02_r8,0.25738e-02_r8,0.34250e-02_r8,0.41781e-02_r8, & + & 0.48258e-02_r8,0.53776e-02_r8,0.57400e-02_r8,0.74913e-02_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.11265e-04_r8,0.97473e-03_r8,0.15190e-02_r8,0.19779e-02_r8,0.23708e-02_r8, & + & 0.27002e-02_r8,0.28954e-02_r8,0.29689e-02_r8,0.49052e-02_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.11703e-04_r8,0.10660e-02_r8,0.16806e-02_r8,0.21742e-02_r8,0.26370e-02_r8, & + & 0.30184e-02_r8,0.33461e-02_r8,0.35081e-02_r8,0.53515e-02_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.12275e-04_r8,0.11524e-02_r8,0.18532e-02_r8,0.24014e-02_r8,0.28932e-02_r8, & + & 0.33615e-02_r8,0.37332e-02_r8,0.39759e-02_r8,0.57806e-02_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.12963e-04_r8,0.12405e-02_r8,0.20200e-02_r8,0.26573e-02_r8,0.31978e-02_r8, & + & 0.36904e-02_r8,0.41225e-02_r8,0.44151e-02_r8,0.61956e-02_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.13696e-04_r8,0.13266e-02_r8,0.21814e-02_r8,0.28939e-02_r8,0.35284e-02_r8, & + & 0.40629e-02_r8,0.45191e-02_r8,0.48283e-02_r8,0.65800e-02_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.91179e-05_r8,0.81531e-03_r8,0.12754e-02_r8,0.16598e-02_r8,0.19900e-02_r8, & + & 0.22634e-02_r8,0.24441e-02_r8,0.24984e-02_r8,0.40576e-02_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.95039e-05_r8,0.89093e-03_r8,0.14150e-02_r8,0.18287e-02_r8,0.22143e-02_r8, & + & 0.25329e-02_r8,0.28092e-02_r8,0.29546e-02_r8,0.44374e-02_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.99762e-05_r8,0.96494e-03_r8,0.15625e-02_r8,0.20288e-02_r8,0.24319e-02_r8, & + & 0.28108e-02_r8,0.31373e-02_r8,0.33177e-02_r8,0.48094e-02_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.10509e-04_r8,0.10398e-02_r8,0.16996e-02_r8,0.22443e-02_r8,0.26925e-02_r8, & + & 0.30942e-02_r8,0.34481e-02_r8,0.37003e-02_r8,0.51550e-02_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.11033e-04_r8,0.11134e-02_r8,0.18372e-02_r8,0.24408e-02_r8,0.29682e-02_r8, & + & 0.34114e-02_r8,0.37859e-02_r8,0.40424e-02_r8,0.54893e-02_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.25564e-03_r8,0.23940e-01_r8,0.41535e-01_r8,0.56276e-01_r8,0.68561e-01_r8, & + & 0.78630e-01_r8,0.86993e-01_r8,0.91794e-01_r8,0.84229e-01_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.29194e-03_r8,0.25170e-01_r8,0.43659e-01_r8,0.59016e-01_r8,0.72302e-01_r8, & + & 0.83167e-01_r8,0.91739e-01_r8,0.96774e-01_r8,0.86838e-01_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.33934e-03_r8,0.26430e-01_r8,0.45835e-01_r8,0.61922e-01_r8,0.75614e-01_r8, & + & 0.87285e-01_r8,0.96606e-01_r8,0.10156e+00_r8,0.90084e-01_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.38871e-03_r8,0.27733e-01_r8,0.48058e-01_r8,0.64973e-01_r8,0.79090e-01_r8, & + & 0.91156e-01_r8,0.10084e+00_r8,0.10589e+00_r8,0.92583e-01_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.44473e-03_r8,0.29028e-01_r8,0.50287e-01_r8,0.68010e-01_r8,0.82805e-01_r8, & + & 0.95193e-01_r8,0.10492e+00_r8,0.10995e+00_r8,0.95419e-01_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.23400e-03_r8,0.20753e-01_r8,0.35742e-01_r8,0.48709e-01_r8,0.59548e-01_r8, & + & 0.68206e-01_r8,0.75045e-01_r8,0.78915e-01_r8,0.70180e-01_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.26775e-03_r8,0.21832e-01_r8,0.37611e-01_r8,0.51156e-01_r8,0.62768e-01_r8, & + & 0.72267e-01_r8,0.79422e-01_r8,0.83262e-01_r8,0.72735e-01_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.30033e-03_r8,0.22961e-01_r8,0.39618e-01_r8,0.53774e-01_r8,0.65773e-01_r8, & + & 0.75819e-01_r8,0.83532e-01_r8,0.87496e-01_r8,0.75459e-01_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.34366e-03_r8,0.24116e-01_r8,0.41597e-01_r8,0.56506e-01_r8,0.68944e-01_r8, & + & 0.79231e-01_r8,0.87245e-01_r8,0.91336e-01_r8,0.77669e-01_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.39179e-03_r8,0.25289e-01_r8,0.43575e-01_r8,0.59282e-01_r8,0.72132e-01_r8, & + & 0.82956e-01_r8,0.91038e-01_r8,0.94937e-01_r8,0.80272e-01_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.20730e-03_r8,0.18044e-01_r8,0.30227e-01_r8,0.41206e-01_r8,0.50626e-01_r8, & + & 0.58095e-01_r8,0.63725e-01_r8,0.66721e-01_r8,0.57780e-01_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.24007e-03_r8,0.18972e-01_r8,0.31883e-01_r8,0.43486e-01_r8,0.53572e-01_r8, & + & 0.61742e-01_r8,0.67489e-01_r8,0.70552e-01_r8,0.60009e-01_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.26931e-03_r8,0.19934e-01_r8,0.33681e-01_r8,0.45775e-01_r8,0.56255e-01_r8, & + & 0.64869e-01_r8,0.71254e-01_r8,0.74232e-01_r8,0.62350e-01_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.30064e-03_r8,0.20965e-01_r8,0.35448e-01_r8,0.48199e-01_r8,0.59036e-01_r8, & + & 0.67921e-01_r8,0.74594e-01_r8,0.77689e-01_r8,0.64410e-01_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.33967e-03_r8,0.21972e-01_r8,0.37192e-01_r8,0.50676e-01_r8,0.61884e-01_r8, & + & 0.71207e-01_r8,0.77888e-01_r8,0.80947e-01_r8,0.66667e-01_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.18201e-03_r8,0.15595e-01_r8,0.25372e-01_r8,0.34431e-01_r8,0.42401e-01_r8, & + & 0.48915e-01_r8,0.53613e-01_r8,0.55953e-01_r8,0.47727e-01_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.20883e-03_r8,0.16422e-01_r8,0.26851e-01_r8,0.36481e-01_r8,0.45074e-01_r8, & + & 0.52078e-01_r8,0.56860e-01_r8,0.59287e-01_r8,0.49553e-01_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.23874e-03_r8,0.17285e-01_r8,0.28425e-01_r8,0.38514e-01_r8,0.47542e-01_r8, & + & 0.54904e-01_r8,0.60284e-01_r8,0.62561e-01_r8,0.51595e-01_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.26707e-03_r8,0.18200e-01_r8,0.30007e-01_r8,0.40613e-01_r8,0.49982e-01_r8, & + & 0.57662e-01_r8,0.63231e-01_r8,0.65666e-01_r8,0.53450e-01_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.30102e-03_r8,0.19113e-01_r8,0.31552e-01_r8,0.42805e-01_r8,0.52535e-01_r8, & + & 0.60559e-01_r8,0.66195e-01_r8,0.68549e-01_r8,0.55415e-01_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.15801e-03_r8,0.13295e-01_r8,0.21524e-01_r8,0.28666e-01_r8,0.35142e-01_r8, & + & 0.40757e-01_r8,0.44715e-01_r8,0.46740e-01_r8,0.39384e-01_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.17994e-03_r8,0.14057e-01_r8,0.22786e-01_r8,0.30487e-01_r8,0.37563e-01_r8, & + & 0.43509e-01_r8,0.47676e-01_r8,0.49638e-01_r8,0.40849e-01_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.20535e-03_r8,0.14811e-01_r8,0.24116e-01_r8,0.32266e-01_r8,0.39764e-01_r8, & + & 0.46122e-01_r8,0.50669e-01_r8,0.52413e-01_r8,0.42683e-01_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.23511e-03_r8,0.15598e-01_r8,0.25481e-01_r8,0.34103e-01_r8,0.41924e-01_r8, & + & 0.48592e-01_r8,0.53283e-01_r8,0.55235e-01_r8,0.44335e-01_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.26640e-03_r8,0.16402e-01_r8,0.26844e-01_r8,0.36000e-01_r8,0.44180e-01_r8, & + & 0.51086e-01_r8,0.55918e-01_r8,0.57796e-01_r8,0.45991e-01_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.13805e-03_r8,0.11222e-01_r8,0.18125e-01_r8,0.23877e-01_r8,0.28939e-01_r8, & + & 0.33506e-01_r8,0.36944e-01_r8,0.38672e-01_r8,0.32335e-01_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.15439e-03_r8,0.11883e-01_r8,0.19262e-01_r8,0.25521e-01_r8,0.31068e-01_r8, & + & 0.35882e-01_r8,0.39589e-01_r8,0.41132e-01_r8,0.33684e-01_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.17561e-03_r8,0.12558e-01_r8,0.20409e-01_r8,0.27033e-01_r8,0.33056e-01_r8, & + & 0.38260e-01_r8,0.42155e-01_r8,0.43639e-01_r8,0.35175e-01_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.19967e-03_r8,0.13236e-01_r8,0.21628e-01_r8,0.28554e-01_r8,0.34939e-01_r8, & + & 0.40459e-01_r8,0.44550e-01_r8,0.46147e-01_r8,0.36643e-01_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.23117e-03_r8,0.13936e-01_r8,0.22836e-01_r8,0.30183e-01_r8,0.36909e-01_r8, & + & 0.42652e-01_r8,0.46864e-01_r8,0.48440e-01_r8,0.37992e-01_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.11987e-03_r8,0.93983e-02_r8,0.15130e-01_r8,0.19808e-01_r8,0.23796e-01_r8, & + & 0.27285e-01_r8,0.30176e-01_r8,0.31906e-01_r8,0.26193e-01_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.13164e-03_r8,0.99743e-02_r8,0.16118e-01_r8,0.21319e-01_r8,0.25600e-01_r8, & + & 0.29404e-01_r8,0.32485e-01_r8,0.33909e-01_r8,0.27439e-01_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.14862e-03_r8,0.10559e-01_r8,0.17124e-01_r8,0.22674e-01_r8,0.27373e-01_r8, & + & 0.31501e-01_r8,0.34705e-01_r8,0.36112e-01_r8,0.28667e-01_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.16941e-03_r8,0.11142e-01_r8,0.18163e-01_r8,0.23992e-01_r8,0.29023e-01_r8, & + & 0.33461e-01_r8,0.36882e-01_r8,0.38288e-01_r8,0.29990e-01_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.19444e-03_r8,0.11740e-01_r8,0.19231e-01_r8,0.25410e-01_r8,0.30702e-01_r8, & + & 0.35380e-01_r8,0.38933e-01_r8,0.40325e-01_r8,0.31163e-01_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.10266e-03_r8,0.78132e-02_r8,0.12495e-01_r8,0.16294e-01_r8,0.19552e-01_r8, & + & 0.22203e-01_r8,0.24522e-01_r8,0.26158e-01_r8,0.21477e-01_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.11308e-03_r8,0.82996e-02_r8,0.13385e-01_r8,0.17650e-01_r8,0.21113e-01_r8, & + & 0.24026e-01_r8,0.26424e-01_r8,0.27779e-01_r8,0.22661e-01_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.12431e-03_r8,0.88118e-02_r8,0.14254e-01_r8,0.18852e-01_r8,0.22717e-01_r8, & + & 0.25822e-01_r8,0.28352e-01_r8,0.29667e-01_r8,0.23674e-01_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.14146e-03_r8,0.93080e-02_r8,0.15152e-01_r8,0.20013e-01_r8,0.24158e-01_r8, & + & 0.27569e-01_r8,0.30306e-01_r8,0.31495e-01_r8,0.24838e-01_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.16275e-03_r8,0.98287e-02_r8,0.16080e-01_r8,0.21227e-01_r8,0.25592e-01_r8, & + & 0.29226e-01_r8,0.32075e-01_r8,0.33357e-01_r8,0.25887e-01_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.85797e-04_r8,0.64412e-02_r8,0.10231e-01_r8,0.13327e-01_r8,0.15923e-01_r8, & + & 0.18103e-01_r8,0.19903e-01_r8,0.21189e-01_r8,0.17975e-01_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.94370e-04_r8,0.68514e-02_r8,0.11041e-01_r8,0.14472e-01_r8,0.17298e-01_r8, & + & 0.19661e-01_r8,0.21421e-01_r8,0.22631e-01_r8,0.18990e-01_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.10603e-03_r8,0.72870e-02_r8,0.11786e-01_r8,0.15570e-01_r8,0.18710e-01_r8, & + & 0.21195e-01_r8,0.23092e-01_r8,0.24157e-01_r8,0.19934e-01_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.11819e-03_r8,0.77217e-02_r8,0.12559e-01_r8,0.16589e-01_r8,0.19991e-01_r8, & + & 0.22738e-01_r8,0.24769e-01_r8,0.25771e-01_r8,0.20946e-01_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.13500e-03_r8,0.81624e-02_r8,0.13346e-01_r8,0.17610e-01_r8,0.21227e-01_r8, & + & 0.24140e-01_r8,0.26339e-01_r8,0.27388e-01_r8,0.21819e-01_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.73275e-04_r8,0.53147e-02_r8,0.83832e-02_r8,0.10890e-01_r8,0.12998e-01_r8, & + & 0.14772e-01_r8,0.16237e-01_r8,0.17165e-01_r8,0.15972e-01_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.80303e-04_r8,0.56594e-02_r8,0.90964e-02_r8,0.11869e-01_r8,0.14181e-01_r8, & + & 0.16065e-01_r8,0.17493e-01_r8,0.18447e-01_r8,0.17075e-01_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.88821e-04_r8,0.60286e-02_r8,0.97491e-02_r8,0.12852e-01_r8,0.15387e-01_r8, & + & 0.17394e-01_r8,0.18909e-01_r8,0.19708e-01_r8,0.18078e-01_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.10142e-03_r8,0.63962e-02_r8,0.10392e-01_r8,0.13730e-01_r8,0.16522e-01_r8, & + & 0.18771e-01_r8,0.20308e-01_r8,0.21096e-01_r8,0.19037e-01_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.11405e-03_r8,0.67754e-02_r8,0.11065e-01_r8,0.14605e-01_r8,0.17581e-01_r8, & + & 0.19991e-01_r8,0.21687e-01_r8,0.22458e-01_r8,0.19875e-01_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.64517e-04_r8,0.45135e-02_r8,0.71165e-02_r8,0.92384e-02_r8,0.10998e-01_r8, & + & 0.12474e-01_r8,0.13700e-01_r8,0.14388e-01_r8,0.14631e-01_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.71535e-04_r8,0.48070e-02_r8,0.77137e-02_r8,0.10092e-01_r8,0.12023e-01_r8, & + & 0.13623e-01_r8,0.14792e-01_r8,0.15449e-01_r8,0.15481e-01_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.79504e-04_r8,0.51199e-02_r8,0.82600e-02_r8,0.10911e-01_r8,0.13076e-01_r8, & + & 0.14755e-01_r8,0.16002e-01_r8,0.16546e-01_r8,0.16298e-01_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.90433e-04_r8,0.54351e-02_r8,0.88101e-02_r8,0.11647e-01_r8,0.14018e-01_r8, & + & 0.15922e-01_r8,0.17206e-01_r8,0.17715e-01_r8,0.16991e-01_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.10146e-03_r8,0.57596e-02_r8,0.93865e-02_r8,0.12407e-01_r8,0.14922e-01_r8, & + & 0.16951e-01_r8,0.18384e-01_r8,0.18893e-01_r8,0.17666e-01_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.56913e-04_r8,0.38361e-02_r8,0.60238e-02_r8,0.78101e-02_r8,0.92943e-02_r8, & + & 0.10515e-01_r8,0.11514e-01_r8,0.12051e-01_r8,0.12708e-01_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.62984e-04_r8,0.40886e-02_r8,0.65153e-02_r8,0.85464e-02_r8,0.10168e-01_r8, & + & 0.11498e-01_r8,0.12452e-01_r8,0.12938e-01_r8,0.13473e-01_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.70588e-04_r8,0.43561e-02_r8,0.69761e-02_r8,0.92137e-02_r8,0.11068e-01_r8, & + & 0.12482e-01_r8,0.13497e-01_r8,0.13892e-01_r8,0.14090e-01_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.79556e-04_r8,0.46222e-02_r8,0.74472e-02_r8,0.98382e-02_r8,0.11852e-01_r8, & + & 0.13461e-01_r8,0.14539e-01_r8,0.14868e-01_r8,0.14684e-01_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.89330e-04_r8,0.49037e-02_r8,0.79332e-02_r8,0.10492e-01_r8,0.12613e-01_r8, & + & 0.14331e-01_r8,0.15523e-01_r8,0.15867e-01_r8,0.15266e-01_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.49040e-04_r8,0.32470e-02_r8,0.50782e-02_r8,0.65813e-02_r8,0.78254e-02_r8, & + & 0.88398e-02_r8,0.96483e-02_r8,0.10090e-01_r8,0.10614e-01_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.54225e-04_r8,0.34616e-02_r8,0.54906e-02_r8,0.71951e-02_r8,0.85711e-02_r8, & + & 0.96781e-02_r8,0.10460e-01_r8,0.10840e-01_r8,0.11206e-01_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.61136e-04_r8,0.36878e-02_r8,0.58777e-02_r8,0.77458e-02_r8,0.93183e-02_r8, & + & 0.10528e-01_r8,0.11347e-01_r8,0.11684e-01_r8,0.11730e-01_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.68788e-04_r8,0.39213e-02_r8,0.62791e-02_r8,0.82774e-02_r8,0.99761e-02_r8, & + & 0.11332e-01_r8,0.12247e-01_r8,0.12495e-01_r8,0.12250e-01_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.77427e-04_r8,0.41640e-02_r8,0.66890e-02_r8,0.88358e-02_r8,0.10624e-01_r8, & + & 0.12069e-01_r8,0.13064e-01_r8,0.13341e-01_r8,0.12730e-01_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.69098e-02_r8,0.84650e-01_r8,0.13006e+00_r8,0.16652e+00_r8,0.19608e+00_r8, & + & 0.21975e+00_r8,0.23496e+00_r8,0.23277e+00_r8,0.18007e+00_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.78200e-02_r8,0.89279e-01_r8,0.13630e+00_r8,0.17409e+00_r8,0.20398e+00_r8, & + & 0.22718e+00_r8,0.24129e+00_r8,0.23750e+00_r8,0.18438e+00_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.89787e-02_r8,0.94428e-01_r8,0.14296e+00_r8,0.18170e+00_r8,0.21205e+00_r8, & + & 0.23450e+00_r8,0.24726e+00_r8,0.24172e+00_r8,0.18878e+00_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.10426e-01_r8,0.10003e+00_r8,0.15009e+00_r8,0.18943e+00_r8,0.22015e+00_r8, & + & 0.24206e+00_r8,0.25341e+00_r8,0.24571e+00_r8,0.19325e+00_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.12209e-01_r8,0.10603e+00_r8,0.15781e+00_r8,0.19756e+00_r8,0.22832e+00_r8, & + & 0.24963e+00_r8,0.25957e+00_r8,0.24958e+00_r8,0.19748e+00_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.64020e-02_r8,0.74597e-01_r8,0.11458e+00_r8,0.14581e+00_r8,0.17103e+00_r8, & + & 0.19105e+00_r8,0.20412e+00_r8,0.20133e+00_r8,0.15242e+00_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.72586e-02_r8,0.78857e-01_r8,0.12024e+00_r8,0.15257e+00_r8,0.17796e+00_r8, & + & 0.19765e+00_r8,0.20972e+00_r8,0.20548e+00_r8,0.15620e+00_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.82903e-02_r8,0.83602e-01_r8,0.12623e+00_r8,0.15931e+00_r8,0.18512e+00_r8, & + & 0.20423e+00_r8,0.21503e+00_r8,0.20937e+00_r8,0.15993e+00_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.94578e-02_r8,0.88668e-01_r8,0.13277e+00_r8,0.16635e+00_r8,0.19233e+00_r8, & + & 0.21098e+00_r8,0.22050e+00_r8,0.21294e+00_r8,0.16397e+00_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.10865e-01_r8,0.94113e-01_r8,0.13987e+00_r8,0.17375e+00_r8,0.19975e+00_r8, & + & 0.21771e+00_r8,0.22592e+00_r8,0.21639e+00_r8,0.16745e+00_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.56943e-02_r8,0.64084e-01_r8,0.99294e-01_r8,0.12614e+00_r8,0.14746e+00_r8, & + & 0.16414e+00_r8,0.17503e+00_r8,0.17255e+00_r8,0.12738e+00_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.64702e-02_r8,0.67967e-01_r8,0.10427e+00_r8,0.13197e+00_r8,0.15350e+00_r8, & + & 0.16985e+00_r8,0.18008e+00_r8,0.17631e+00_r8,0.13087e+00_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.74200e-02_r8,0.72252e-01_r8,0.10956e+00_r8,0.13801e+00_r8,0.15978e+00_r8, & + & 0.17567e+00_r8,0.18476e+00_r8,0.17977e+00_r8,0.13421e+00_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.84907e-02_r8,0.76772e-01_r8,0.11539e+00_r8,0.14427e+00_r8,0.16615e+00_r8, & + & 0.18168e+00_r8,0.18947e+00_r8,0.18300e+00_r8,0.13761e+00_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.97078e-02_r8,0.81671e-01_r8,0.12172e+00_r8,0.15082e+00_r8,0.17277e+00_r8, & + & 0.18769e+00_r8,0.19427e+00_r8,0.18608e+00_r8,0.14067e+00_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.48829e-02_r8,0.54383e-01_r8,0.85075e-01_r8,0.10815e+00_r8,0.12638e+00_r8, & + & 0.14020e+00_r8,0.14903e+00_r8,0.14670e+00_r8,0.10614e+00_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.55740e-02_r8,0.57779e-01_r8,0.89436e-01_r8,0.11323e+00_r8,0.13160e+00_r8, & + & 0.14514e+00_r8,0.15349e+00_r8,0.15027e+00_r8,0.10949e+00_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.64015e-02_r8,0.61546e-01_r8,0.94139e-01_r8,0.11850e+00_r8,0.13701e+00_r8, & + & 0.15017e+00_r8,0.15757e+00_r8,0.15344e+00_r8,0.11257e+00_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.73719e-02_r8,0.65521e-01_r8,0.99232e-01_r8,0.12403e+00_r8,0.14259e+00_r8, & + & 0.15541e+00_r8,0.16175e+00_r8,0.15634e+00_r8,0.11557e+00_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.84789e-02_r8,0.69810e-01_r8,0.10478e+00_r8,0.12985e+00_r8,0.14840e+00_r8, & + & 0.16071e+00_r8,0.16597e+00_r8,0.15910e+00_r8,0.11833e+00_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.41357e-02_r8,0.45878e-01_r8,0.71866e-01_r8,0.92130e-01_r8,0.10772e+00_r8, & + & 0.11935e+00_r8,0.12627e+00_r8,0.12382e+00_r8,0.88490e-01_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.47278e-02_r8,0.48809e-01_r8,0.75724e-01_r8,0.96485e-01_r8,0.11218e+00_r8, & + & 0.12363e+00_r8,0.13023e+00_r8,0.12723e+00_r8,0.91646e-01_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.54234e-02_r8,0.52108e-01_r8,0.79925e-01_r8,0.10105e+00_r8,0.11684e+00_r8, & + & 0.12795e+00_r8,0.13389e+00_r8,0.13024e+00_r8,0.94384e-01_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.62672e-02_r8,0.55647e-01_r8,0.84438e-01_r8,0.10591e+00_r8,0.12167e+00_r8, & + & 0.13255e+00_r8,0.13759e+00_r8,0.13288e+00_r8,0.97037e-01_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.72387e-02_r8,0.59393e-01_r8,0.89326e-01_r8,0.11102e+00_r8,0.12680e+00_r8, & + & 0.13723e+00_r8,0.14128e+00_r8,0.13530e+00_r8,0.99585e-01_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.34820e-02_r8,0.38455e-01_r8,0.60106e-01_r8,0.77515e-01_r8,0.91143e-01_r8, & + & 0.10094e+00_r8,0.10649e+00_r8,0.10403e+00_r8,0.73509e-01_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.39507e-02_r8,0.40927e-01_r8,0.63402e-01_r8,0.81240e-01_r8,0.94968e-01_r8, & + & 0.10469e+00_r8,0.11001e+00_r8,0.10717e+00_r8,0.76426e-01_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.45266e-02_r8,0.43726e-01_r8,0.67041e-01_r8,0.85234e-01_r8,0.98911e-01_r8, & + & 0.10845e+00_r8,0.11329e+00_r8,0.10996e+00_r8,0.78861e-01_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.52242e-02_r8,0.46807e-01_r8,0.70939e-01_r8,0.89547e-01_r8,0.10312e+00_r8, & + & 0.11247e+00_r8,0.11653e+00_r8,0.11237e+00_r8,0.81250e-01_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.60449e-02_r8,0.50083e-01_r8,0.75175e-01_r8,0.94041e-01_r8,0.10760e+00_r8, & + & 0.11657e+00_r8,0.11980e+00_r8,0.11449e+00_r8,0.83549e-01_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.28711e-02_r8,0.32523e-01_r8,0.49971e-01_r8,0.64597e-01_r8,0.76360e-01_r8, & + & 0.84918e-01_r8,0.89523e-01_r8,0.87200e-01_r8,0.60618e-01_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.32550e-02_r8,0.34614e-01_r8,0.52803e-01_r8,0.67740e-01_r8,0.79713e-01_r8, & + & 0.88207e-01_r8,0.92681e-01_r8,0.90060e-01_r8,0.63331e-01_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.37263e-02_r8,0.36968e-01_r8,0.55904e-01_r8,0.71153e-01_r8,0.83143e-01_r8, & + & 0.91509e-01_r8,0.95607e-01_r8,0.92564e-01_r8,0.65595e-01_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.42953e-02_r8,0.39538e-01_r8,0.59281e-01_r8,0.74912e-01_r8,0.86822e-01_r8, & + & 0.94956e-01_r8,0.98438e-01_r8,0.94728e-01_r8,0.67680e-01_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.49788e-02_r8,0.42264e-01_r8,0.62953e-01_r8,0.78842e-01_r8,0.90742e-01_r8, & + & 0.98510e-01_r8,0.10129e+00_r8,0.96641e-01_r8,0.69746e-01_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.23480e-02_r8,0.27230e-01_r8,0.41671e-01_r8,0.53565e-01_r8,0.63436e-01_r8, & + & 0.70999e-01_r8,0.75020e-01_r8,0.72906e-01_r8,0.49386e-01_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.26517e-02_r8,0.29065e-01_r8,0.44017e-01_r8,0.56225e-01_r8,0.66341e-01_r8, & + & 0.73935e-01_r8,0.77879e-01_r8,0.75468e-01_r8,0.51750e-01_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.30285e-02_r8,0.31112e-01_r8,0.46598e-01_r8,0.59161e-01_r8,0.69302e-01_r8, & + & 0.76809e-01_r8,0.80439e-01_r8,0.77729e-01_r8,0.53904e-01_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.34816e-02_r8,0.33348e-01_r8,0.49448e-01_r8,0.62380e-01_r8,0.72502e-01_r8, & + & 0.79786e-01_r8,0.82887e-01_r8,0.79683e-01_r8,0.55731e-01_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.40444e-02_r8,0.35730e-01_r8,0.52545e-01_r8,0.65794e-01_r8,0.75878e-01_r8, & + & 0.82889e-01_r8,0.85379e-01_r8,0.81391e-01_r8,0.57509e-01_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.19247e-02_r8,0.22630e-01_r8,0.34752e-01_r8,0.44387e-01_r8,0.52455e-01_r8, & + & 0.58833e-01_r8,0.62468e-01_r8,0.60719e-01_r8,0.41880e-01_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.21557e-02_r8,0.24204e-01_r8,0.36750e-01_r8,0.46636e-01_r8,0.54976e-01_r8, & + & 0.61421e-01_r8,0.65052e-01_r8,0.62994e-01_r8,0.44010e-01_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.24477e-02_r8,0.25958e-01_r8,0.38981e-01_r8,0.49108e-01_r8,0.57526e-01_r8, & + & 0.63907e-01_r8,0.67351e-01_r8,0.65038e-01_r8,0.45929e-01_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.28196e-02_r8,0.27882e-01_r8,0.41431e-01_r8,0.51802e-01_r8,0.60249e-01_r8, & + & 0.66480e-01_r8,0.69467e-01_r8,0.66788e-01_r8,0.47555e-01_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.32654e-02_r8,0.29939e-01_r8,0.44072e-01_r8,0.54714e-01_r8,0.63163e-01_r8, & + & 0.69207e-01_r8,0.71600e-01_r8,0.68328e-01_r8,0.49077e-01_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.16200e-02_r8,0.18814e-01_r8,0.28911e-01_r8,0.37025e-01_r8,0.43479e-01_r8, & + & 0.48691e-01_r8,0.51767e-01_r8,0.50517e-01_r8,0.36565e-01_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.18031e-02_r8,0.20150e-01_r8,0.30632e-01_r8,0.38967e-01_r8,0.45609e-01_r8, & + & 0.50940e-01_r8,0.54046e-01_r8,0.52515e-01_r8,0.38425e-01_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.20232e-02_r8,0.21640e-01_r8,0.32572e-01_r8,0.41079e-01_r8,0.47788e-01_r8, & + & 0.53101e-01_r8,0.56114e-01_r8,0.54338e-01_r8,0.40162e-01_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.23038e-02_r8,0.23298e-01_r8,0.34703e-01_r8,0.43393e-01_r8,0.50110e-01_r8, & + & 0.55298e-01_r8,0.57982e-01_r8,0.55873e-01_r8,0.41782e-01_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.26649e-02_r8,0.25073e-01_r8,0.36983e-01_r8,0.45868e-01_r8,0.52617e-01_r8, & + & 0.57641e-01_r8,0.59833e-01_r8,0.57222e-01_r8,0.43243e-01_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.14241e-02_r8,0.16065e-01_r8,0.24586e-01_r8,0.31465e-01_r8,0.36963e-01_r8, & + & 0.41093e-01_r8,0.43617e-01_r8,0.42673e-01_r8,0.32343e-01_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.15878e-02_r8,0.17268e-01_r8,0.26144e-01_r8,0.33169e-01_r8,0.38816e-01_r8, & + & 0.42988e-01_r8,0.45546e-01_r8,0.44327e-01_r8,0.34054e-01_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.18003e-02_r8,0.18609e-01_r8,0.27888e-01_r8,0.35066e-01_r8,0.40717e-01_r8, & + & 0.44861e-01_r8,0.47277e-01_r8,0.45845e-01_r8,0.35562e-01_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.20513e-02_r8,0.20069e-01_r8,0.29794e-01_r8,0.37147e-01_r8,0.42781e-01_r8, & + & 0.46774e-01_r8,0.48869e-01_r8,0.47106e-01_r8,0.36881e-01_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.23610e-02_r8,0.21636e-01_r8,0.31786e-01_r8,0.39341e-01_r8,0.44964e-01_r8, & + & 0.48832e-01_r8,0.50478e-01_r8,0.48237e-01_r8,0.38136e-01_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.12367e-02_r8,0.13664e-01_r8,0.20841e-01_r8,0.26619e-01_r8,0.31258e-01_r8, & + & 0.34766e-01_r8,0.36665e-01_r8,0.35873e-01_r8,0.27811e-01_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.13898e-02_r8,0.14747e-01_r8,0.22238e-01_r8,0.28134e-01_r8,0.32876e-01_r8, & + & 0.36392e-01_r8,0.38286e-01_r8,0.37257e-01_r8,0.29212e-01_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.15822e-02_r8,0.15920e-01_r8,0.23808e-01_r8,0.29830e-01_r8,0.34558e-01_r8, & + & 0.38014e-01_r8,0.39728e-01_r8,0.38493e-01_r8,0.30517e-01_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.18117e-02_r8,0.17195e-01_r8,0.25479e-01_r8,0.31664e-01_r8,0.36378e-01_r8, & + & 0.39675e-01_r8,0.41098e-01_r8,0.39553e-01_r8,0.31705e-01_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.20996e-02_r8,0.18567e-01_r8,0.27225e-01_r8,0.33571e-01_r8,0.38302e-01_r8, & + & 0.41437e-01_r8,0.42501e-01_r8,0.40525e-01_r8,0.32748e-01_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.10606e-02_r8,0.11594e-01_r8,0.17616e-01_r8,0.22456e-01_r8,0.26337e-01_r8, & + & 0.29282e-01_r8,0.30831e-01_r8,0.30037e-01_r8,0.23251e-01_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.11975e-02_r8,0.12541e-01_r8,0.18850e-01_r8,0.23795e-01_r8,0.27745e-01_r8, & + & 0.30676e-01_r8,0.32191e-01_r8,0.31186e-01_r8,0.24461e-01_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.13686e-02_r8,0.13557e-01_r8,0.20236e-01_r8,0.25287e-01_r8,0.29224e-01_r8, & + & 0.32085e-01_r8,0.33411e-01_r8,0.32190e-01_r8,0.25539e-01_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.15787e-02_r8,0.14655e-01_r8,0.21685e-01_r8,0.26887e-01_r8,0.30821e-01_r8, & + & 0.33533e-01_r8,0.34581e-01_r8,0.33091e-01_r8,0.26483e-01_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.18422e-02_r8,0.15847e-01_r8,0.23201e-01_r8,0.28535e-01_r8,0.32486e-01_r8, & + & 0.35059e-01_r8,0.35791e-01_r8,0.33942e-01_r8,0.27340e-01_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.11257e+00_r8,0.31731e+00_r8,0.42139e+00_r8,0.49121e+00_r8,0.53179e+00_r8, & + & 0.54416e+00_r8,0.52879e+00_r8,0.48565e+00_r8,0.38185e+00_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.12995e+00_r8,0.33757e+00_r8,0.44079e+00_r8,0.50693e+00_r8,0.54374e+00_r8, & + & 0.55231e+00_r8,0.53411e+00_r8,0.48973e+00_r8,0.38664e+00_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.14899e+00_r8,0.35787e+00_r8,0.45940e+00_r8,0.52235e+00_r8,0.55490e+00_r8, & + & 0.56009e+00_r8,0.53945e+00_r8,0.49411e+00_r8,0.39028e+00_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.16946e+00_r8,0.37848e+00_r8,0.47747e+00_r8,0.53692e+00_r8,0.56497e+00_r8, & + & 0.56760e+00_r8,0.54484e+00_r8,0.49832e+00_r8,0.39391e+00_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.19143e+00_r8,0.39915e+00_r8,0.49476e+00_r8,0.55039e+00_r8,0.57468e+00_r8, & + & 0.57486e+00_r8,0.55036e+00_r8,0.50307e+00_r8,0.39756e+00_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.97091e-01_r8,0.28037e+00_r8,0.37054e+00_r8,0.43162e+00_r8,0.46715e+00_r8, & + & 0.47740e+00_r8,0.46327e+00_r8,0.42557e+00_r8,0.32833e+00_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.11208e+00_r8,0.29815e+00_r8,0.38764e+00_r8,0.44615e+00_r8,0.47841e+00_r8, & + & 0.48513e+00_r8,0.46886e+00_r8,0.42998e+00_r8,0.33260e+00_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.12856e+00_r8,0.31599e+00_r8,0.40420e+00_r8,0.45996e+00_r8,0.48848e+00_r8, & + & 0.49285e+00_r8,0.47441e+00_r8,0.43431e+00_r8,0.33632e+00_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.14648e+00_r8,0.33425e+00_r8,0.42020e+00_r8,0.47262e+00_r8,0.49778e+00_r8, & + & 0.50015e+00_r8,0.47996e+00_r8,0.43890e+00_r8,0.33965e+00_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.16579e+00_r8,0.35250e+00_r8,0.43554e+00_r8,0.48445e+00_r8,0.50655e+00_r8, & + & 0.50702e+00_r8,0.48572e+00_r8,0.44375e+00_r8,0.34330e+00_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.80654e-01_r8,0.24334e+00_r8,0.32145e+00_r8,0.37485e+00_r8,0.40615e+00_r8, & + & 0.41488e+00_r8,0.40284e+00_r8,0.37005e+00_r8,0.27897e+00_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.93334e-01_r8,0.25889e+00_r8,0.33665e+00_r8,0.38799e+00_r8,0.41628e+00_r8, & + & 0.42254e+00_r8,0.40845e+00_r8,0.37420e+00_r8,0.28281e+00_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.10735e+00_r8,0.27449e+00_r8,0.35143e+00_r8,0.40015e+00_r8,0.42551e+00_r8, & + & 0.42981e+00_r8,0.41382e+00_r8,0.37871e+00_r8,0.28619e+00_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.12265e+00_r8,0.29043e+00_r8,0.36548e+00_r8,0.41153e+00_r8,0.43393e+00_r8, & + & 0.43649e+00_r8,0.41932e+00_r8,0.38340e+00_r8,0.28955e+00_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.13925e+00_r8,0.30659e+00_r8,0.37895e+00_r8,0.42211e+00_r8,0.44187e+00_r8, & + & 0.44276e+00_r8,0.42490e+00_r8,0.38830e+00_r8,0.29282e+00_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.65986e-01_r8,0.20968e+00_r8,0.27746e+00_r8,0.32321e+00_r8,0.35021e+00_r8, & + & 0.35817e+00_r8,0.34816e+00_r8,0.31914e+00_r8,0.23714e+00_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.76550e-01_r8,0.22318e+00_r8,0.29094e+00_r8,0.33486e+00_r8,0.35941e+00_r8, & + & 0.36546e+00_r8,0.35341e+00_r8,0.32318e+00_r8,0.24040e+00_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.88349e-01_r8,0.23676e+00_r8,0.30387e+00_r8,0.34562e+00_r8,0.36786e+00_r8, & + & 0.37204e+00_r8,0.35871e+00_r8,0.32765e+00_r8,0.24343e+00_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.10129e+00_r8,0.25065e+00_r8,0.31610e+00_r8,0.35574e+00_r8,0.37546e+00_r8, & + & 0.37811e+00_r8,0.36390e+00_r8,0.33220e+00_r8,0.24649e+00_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.11540e+00_r8,0.26489e+00_r8,0.32784e+00_r8,0.36504e+00_r8,0.38250e+00_r8, & + & 0.38387e+00_r8,0.36919e+00_r8,0.33697e+00_r8,0.24943e+00_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.53393e-01_r8,0.18000e+00_r8,0.23883e+00_r8,0.27751e+00_r8,0.30053e+00_r8, & + & 0.30742e+00_r8,0.29898e+00_r8,0.27383e+00_r8,0.20106e+00_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.62233e-01_r8,0.19175e+00_r8,0.25050e+00_r8,0.28777e+00_r8,0.30898e+00_r8, & + & 0.31400e+00_r8,0.30389e+00_r8,0.27769e+00_r8,0.20390e+00_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.72177e-01_r8,0.20364e+00_r8,0.26165e+00_r8,0.29741e+00_r8,0.31640e+00_r8, & + & 0.31996e+00_r8,0.30876e+00_r8,0.28174e+00_r8,0.20671e+00_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.83134e-01_r8,0.21576e+00_r8,0.27227e+00_r8,0.30617e+00_r8,0.32319e+00_r8, & + & 0.32542e+00_r8,0.31353e+00_r8,0.28599e+00_r8,0.20956e+00_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.95090e-01_r8,0.22815e+00_r8,0.28259e+00_r8,0.31429e+00_r8,0.32943e+00_r8, & + & 0.33059e+00_r8,0.31837e+00_r8,0.29043e+00_r8,0.21220e+00_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.42433e-01_r8,0.15317e+00_r8,0.20425e+00_r8,0.23740e+00_r8,0.25663e+00_r8, & + & 0.26234e+00_r8,0.25512e+00_r8,0.23364e+00_r8,0.16949e+00_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.49749e-01_r8,0.16341e+00_r8,0.21435e+00_r8,0.24646e+00_r8,0.26413e+00_r8, & + & 0.26825e+00_r8,0.25968e+00_r8,0.23716e+00_r8,0.17204e+00_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.58017e-01_r8,0.17381e+00_r8,0.22409e+00_r8,0.25485e+00_r8,0.27073e+00_r8, & + & 0.27356e+00_r8,0.26405e+00_r8,0.24070e+00_r8,0.17477e+00_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.67231e-01_r8,0.18439e+00_r8,0.23345e+00_r8,0.26240e+00_r8,0.27677e+00_r8, & + & 0.27839e+00_r8,0.26819e+00_r8,0.24459e+00_r8,0.17741e+00_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.77316e-01_r8,0.19517e+00_r8,0.24253e+00_r8,0.26953e+00_r8,0.28221e+00_r8, & + & 0.28296e+00_r8,0.27246e+00_r8,0.24867e+00_r8,0.17984e+00_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.33835e-01_r8,0.12894e+00_r8,0.17377e+00_r8,0.20223e+00_r8,0.21858e+00_r8, & + & 0.22305e+00_r8,0.21661e+00_r8,0.19799e+00_r8,0.14234e+00_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.39495e-01_r8,0.13775e+00_r8,0.18255e+00_r8,0.21017e+00_r8,0.22506e+00_r8, & + & 0.22828e+00_r8,0.22063e+00_r8,0.20115e+00_r8,0.14469e+00_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.46213e-01_r8,0.14677e+00_r8,0.19104e+00_r8,0.21747e+00_r8,0.23085e+00_r8, & + & 0.23293e+00_r8,0.22444e+00_r8,0.20438e+00_r8,0.14721e+00_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.53881e-01_r8,0.15604e+00_r8,0.19912e+00_r8,0.22407e+00_r8,0.23606e+00_r8, & + & 0.23711e+00_r8,0.22803e+00_r8,0.20793e+00_r8,0.14967e+00_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.62313e-01_r8,0.16559e+00_r8,0.20703e+00_r8,0.23032e+00_r8,0.24086e+00_r8, & + & 0.24109e+00_r8,0.23183e+00_r8,0.21164e+00_r8,0.15187e+00_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.27294e-01_r8,0.10784e+00_r8,0.14673e+00_r8,0.17152e+00_r8,0.18541e+00_r8, & + & 0.18896e+00_r8,0.18302e+00_r8,0.16686e+00_r8,0.11892e+00_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.31945e-01_r8,0.11533e+00_r8,0.15437e+00_r8,0.17841e+00_r8,0.19097e+00_r8, & + & 0.19348e+00_r8,0.18650e+00_r8,0.16969e+00_r8,0.12123e+00_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.37290e-01_r8,0.12309e+00_r8,0.16174e+00_r8,0.18467e+00_r8,0.19597e+00_r8, & + & 0.19753e+00_r8,0.18983e+00_r8,0.17262e+00_r8,0.12344e+00_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.43331e-01_r8,0.13110e+00_r8,0.16878e+00_r8,0.19044e+00_r8,0.20053e+00_r8, & + & 0.20117e+00_r8,0.19304e+00_r8,0.17581e+00_r8,0.12571e+00_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.50086e-01_r8,0.13937e+00_r8,0.17577e+00_r8,0.19586e+00_r8,0.20476e+00_r8, & + & 0.20472e+00_r8,0.19647e+00_r8,0.17915e+00_r8,0.12770e+00_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.21763e-01_r8,0.89580e-01_r8,0.12270e+00_r8,0.14431e+00_r8,0.15639e+00_r8, & + & 0.15936e+00_r8,0.15421e+00_r8,0.14030e+00_r8,0.10042e+00_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.25609e-01_r8,0.95974e-01_r8,0.12925e+00_r8,0.15030e+00_r8,0.16119e+00_r8, & + & 0.16326e+00_r8,0.15719e+00_r8,0.14283e+00_r8,0.10252e+00_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.30067e-01_r8,0.10261e+00_r8,0.13551e+00_r8,0.15572e+00_r8,0.16552e+00_r8, & + & 0.16675e+00_r8,0.16007e+00_r8,0.14539e+00_r8,0.10448e+00_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.35097e-01_r8,0.10949e+00_r8,0.14161e+00_r8,0.16075e+00_r8,0.16947e+00_r8, & + & 0.16997e+00_r8,0.16297e+00_r8,0.14823e+00_r8,0.10645e+00_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.40711e-01_r8,0.11658e+00_r8,0.14773e+00_r8,0.16552e+00_r8,0.17324e+00_r8, & + & 0.17317e+00_r8,0.16604e+00_r8,0.15112e+00_r8,0.10826e+00_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.17370e-01_r8,0.74466e-01_r8,0.10240e+00_r8,0.12053e+00_r8,0.13126e+00_r8, & + & 0.13417e+00_r8,0.12989e+00_r8,0.11790e+00_r8,0.87103e-01_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.20536e-01_r8,0.79866e-01_r8,0.10796e+00_r8,0.12568e+00_r8,0.13547e+00_r8, & + & 0.13755e+00_r8,0.13244e+00_r8,0.12017e+00_r8,0.88680e-01_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.24274e-01_r8,0.85524e-01_r8,0.11324e+00_r8,0.13036e+00_r8,0.13925e+00_r8, & + & 0.14055e+00_r8,0.13491e+00_r8,0.12243e+00_r8,0.90062e-01_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.28508e-01_r8,0.91420e-01_r8,0.11852e+00_r8,0.13467e+00_r8,0.14267e+00_r8, & + & 0.14339e+00_r8,0.13748e+00_r8,0.12487e+00_r8,0.91240e-01_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.33217e-01_r8,0.97522e-01_r8,0.12382e+00_r8,0.13886e+00_r8,0.14603e+00_r8, & + & 0.14625e+00_r8,0.14015e+00_r8,0.12740e+00_r8,0.92631e-01_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.14918e-01_r8,0.64249e-01_r8,0.87193e-01_r8,0.10225e+00_r8,0.11107e+00_r8, & + & 0.11380e+00_r8,0.11017e+00_r8,0.99775e-01_r8,0.75883e-01_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.17707e-01_r8,0.68887e-01_r8,0.91783e-01_r8,0.10653e+00_r8,0.11454e+00_r8, & + & 0.11659e+00_r8,0.11231e+00_r8,0.10178e+00_r8,0.77400e-01_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.20985e-01_r8,0.73723e-01_r8,0.96290e-01_r8,0.11038e+00_r8,0.11765e+00_r8, & + & 0.11911e+00_r8,0.11446e+00_r8,0.10377e+00_r8,0.78827e-01_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.24698e-01_r8,0.78820e-01_r8,0.10085e+00_r8,0.11403e+00_r8,0.12064e+00_r8, & + & 0.12159e+00_r8,0.11674e+00_r8,0.10593e+00_r8,0.80678e-01_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.28798e-01_r8,0.84087e-01_r8,0.10545e+00_r8,0.11772e+00_r8,0.12367e+00_r8, & + & 0.12416e+00_r8,0.11916e+00_r8,0.10818e+00_r8,0.82090e-01_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.12778e-01_r8,0.55028e-01_r8,0.74326e-01_r8,0.86458e-01_r8,0.93690e-01_r8, & + & 0.95887e-01_r8,0.92996e-01_r8,0.84239e-01_r8,0.65531e-01_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.15226e-01_r8,0.59056e-01_r8,0.78180e-01_r8,0.90004e-01_r8,0.96562e-01_r8, & + & 0.98210e-01_r8,0.94824e-01_r8,0.85996e-01_r8,0.67232e-01_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.18073e-01_r8,0.63328e-01_r8,0.81993e-01_r8,0.93245e-01_r8,0.99175e-01_r8, & + & 0.10034e+00_r8,0.96751e-01_r8,0.87779e-01_r8,0.68728e-01_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.21287e-01_r8,0.67814e-01_r8,0.85944e-01_r8,0.96446e-01_r8,0.10181e+00_r8, & + & 0.10253e+00_r8,0.98787e-01_r8,0.89700e-01_r8,0.70024e-01_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.24810e-01_r8,0.72405e-01_r8,0.89913e-01_r8,0.99700e-01_r8,0.10454e+00_r8, & + & 0.10492e+00_r8,0.10099e+00_r8,0.91662e-01_r8,0.71222e-01_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.10897e-01_r8,0.46824e-01_r8,0.63070e-01_r8,0.73198e-01_r8,0.78826e-01_r8, & + & 0.80547e-01_r8,0.78087e-01_r8,0.70945e-01_r8,0.55427e-01_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.13037e-01_r8,0.50331e-01_r8,0.66369e-01_r8,0.76169e-01_r8,0.81229e-01_r8, & + & 0.82485e-01_r8,0.79688e-01_r8,0.72492e-01_r8,0.56776e-01_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.15498e-01_r8,0.54103e-01_r8,0.69687e-01_r8,0.78968e-01_r8,0.83486e-01_r8, & + & 0.84334e-01_r8,0.81403e-01_r8,0.74109e-01_r8,0.57973e-01_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.18239e-01_r8,0.58007e-01_r8,0.73146e-01_r8,0.81751e-01_r8,0.85842e-01_r8, & + & 0.86346e-01_r8,0.83244e-01_r8,0.75789e-01_r8,0.59123e-01_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.21231e-01_r8,0.61947e-01_r8,0.76584e-01_r8,0.84579e-01_r8,0.88268e-01_r8, & + & 0.88508e-01_r8,0.85245e-01_r8,0.77486e-01_r8,0.60191e-01_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.71609e+00_r8,0.10081e+01_r8,0.11118e+01_r8,0.11603e+01_r8,0.11765e+01_r8, & + & 0.11643e+01_r8,0.11202e+01_r8,0.10296e+01_r8,0.82502e+00_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.75920e+00_r8,0.10292e+01_r8,0.11252e+01_r8,0.11685e+01_r8,0.11822e+01_r8, & + & 0.11684e+01_r8,0.11228e+01_r8,0.10318e+01_r8,0.83157e+00_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.79807e+00_r8,0.10500e+01_r8,0.11397e+01_r8,0.11794e+01_r8,0.11904e+01_r8, & + & 0.11740e+01_r8,0.11264e+01_r8,0.10343e+01_r8,0.83726e+00_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.83183e+00_r8,0.10700e+01_r8,0.11548e+01_r8,0.11918e+01_r8,0.12010e+01_r8, & + & 0.11815e+01_r8,0.11313e+01_r8,0.10364e+01_r8,0.84249e+00_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.86161e+00_r8,0.10887e+01_r8,0.11706e+01_r8,0.12061e+01_r8,0.12126e+01_r8, & + & 0.11904e+01_r8,0.11363e+01_r8,0.10383e+01_r8,0.84713e+00_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.62079e+00_r8,0.89078e+00_r8,0.98349e+00_r8,0.10275e+01_r8,0.10413e+01_r8, & + & 0.10318e+01_r8,0.99528e+00_r8,0.92037e+00_r8,0.72464e+00_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.65800e+00_r8,0.91114e+00_r8,0.99789e+00_r8,0.10381e+01_r8,0.10488e+01_r8, & + & 0.10378e+01_r8,0.99952e+00_r8,0.92364e+00_r8,0.73140e+00_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.69092e+00_r8,0.93058e+00_r8,0.10122e+01_r8,0.10502e+01_r8,0.10590e+01_r8, & + & 0.10454e+01_r8,0.10054e+01_r8,0.92699e+00_r8,0.73764e+00_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.71970e+00_r8,0.94840e+00_r8,0.10270e+01_r8,0.10636e+01_r8,0.10709e+01_r8, & + & 0.10547e+01_r8,0.10116e+01_r8,0.93021e+00_r8,0.74329e+00_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.74579e+00_r8,0.96581e+00_r8,0.10421e+01_r8,0.10781e+01_r8,0.10844e+01_r8, & + & 0.10644e+01_r8,0.10185e+01_r8,0.93369e+00_r8,0.74789e+00_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.52823e+00_r8,0.77783e+00_r8,0.86297e+00_r8,0.90265e+00_r8,0.91464e+00_r8, & + & 0.90839e+00_r8,0.87923e+00_r8,0.81632e+00_r8,0.63067e+00_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.56021e+00_r8,0.79652e+00_r8,0.87677e+00_r8,0.91375e+00_r8,0.92363e+00_r8, & + & 0.91571e+00_r8,0.88529e+00_r8,0.82096e+00_r8,0.63740e+00_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.58848e+00_r8,0.81389e+00_r8,0.89039e+00_r8,0.92584e+00_r8,0.93460e+00_r8, & + & 0.92486e+00_r8,0.89232e+00_r8,0.82527e+00_r8,0.64377e+00_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.61369e+00_r8,0.83008e+00_r8,0.90459e+00_r8,0.93860e+00_r8,0.94727e+00_r8, & + & 0.93485e+00_r8,0.89989e+00_r8,0.82959e+00_r8,0.64921e+00_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.63687e+00_r8,0.84580e+00_r8,0.91897e+00_r8,0.95268e+00_r8,0.96085e+00_r8, & + & 0.94565e+00_r8,0.90780e+00_r8,0.83380e+00_r8,0.65367e+00_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.44508e+00_r8,0.67351e+00_r8,0.75154e+00_r8,0.78756e+00_r8,0.79977e+00_r8, & + & 0.79563e+00_r8,0.77123e+00_r8,0.71868e+00_r8,0.54794e+00_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.47271e+00_r8,0.69026e+00_r8,0.76424e+00_r8,0.79840e+00_r8,0.80928e+00_r8, & + & 0.80400e+00_r8,0.77859e+00_r8,0.72416e+00_r8,0.55496e+00_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.49708e+00_r8,0.70580e+00_r8,0.77670e+00_r8,0.80989e+00_r8,0.82043e+00_r8, & + & 0.81421e+00_r8,0.78653e+00_r8,0.72918e+00_r8,0.56105e+00_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.51921e+00_r8,0.72040e+00_r8,0.78970e+00_r8,0.82209e+00_r8,0.83296e+00_r8, & + & 0.82477e+00_r8,0.79492e+00_r8,0.73435e+00_r8,0.56612e+00_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.53991e+00_r8,0.73468e+00_r8,0.80284e+00_r8,0.83540e+00_r8,0.84599e+00_r8, & + & 0.83588e+00_r8,0.80349e+00_r8,0.73920e+00_r8,0.57048e+00_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.37413e+00_r8,0.58022e+00_r8,0.65026e+00_r8,0.68370e+00_r8,0.69632e+00_r8, & + & 0.69319e+00_r8,0.67239e+00_r8,0.62755e+00_r8,0.47517e+00_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.39785e+00_r8,0.59500e+00_r8,0.66160e+00_r8,0.69388e+00_r8,0.70581e+00_r8, & + & 0.70224e+00_r8,0.68037e+00_r8,0.63372e+00_r8,0.48187e+00_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.41894e+00_r8,0.60858e+00_r8,0.67282e+00_r8,0.70454e+00_r8,0.71693e+00_r8, & + & 0.71249e+00_r8,0.68889e+00_r8,0.63962e+00_r8,0.48765e+00_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.43810e+00_r8,0.62138e+00_r8,0.68416e+00_r8,0.71639e+00_r8,0.72873e+00_r8, & + & 0.72302e+00_r8,0.69785e+00_r8,0.64510e+00_r8,0.49243e+00_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.45627e+00_r8,0.63437e+00_r8,0.69610e+00_r8,0.72855e+00_r8,0.74096e+00_r8, & + & 0.73385e+00_r8,0.70672e+00_r8,0.65052e+00_r8,0.49657e+00_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.31382e+00_r8,0.49799e+00_r8,0.55977e+00_r8,0.58971e+00_r8,0.60230e+00_r8, & + & 0.60065e+00_r8,0.58267e+00_r8,0.54392e+00_r8,0.40911e+00_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.33427e+00_r8,0.51077e+00_r8,0.56976e+00_r8,0.59903e+00_r8,0.61148e+00_r8, & + & 0.60961e+00_r8,0.59093e+00_r8,0.55057e+00_r8,0.41554e+00_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.35247e+00_r8,0.52249e+00_r8,0.57948e+00_r8,0.60895e+00_r8,0.62185e+00_r8, & + & 0.61942e+00_r8,0.59984e+00_r8,0.55707e+00_r8,0.42096e+00_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.36909e+00_r8,0.53360e+00_r8,0.58950e+00_r8,0.61977e+00_r8,0.63265e+00_r8, & + & 0.62957e+00_r8,0.60872e+00_r8,0.56306e+00_r8,0.42549e+00_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.38489e+00_r8,0.54511e+00_r8,0.60025e+00_r8,0.63086e+00_r8,0.64395e+00_r8, & + & 0.63979e+00_r8,0.61739e+00_r8,0.56897e+00_r8,0.42951e+00_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.26224e+00_r8,0.42663e+00_r8,0.48031e+00_r8,0.50651e+00_r8,0.51797e+00_r8, & + & 0.51738e+00_r8,0.50230e+00_r8,0.46824e+00_r8,0.34967e+00_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.28013e+00_r8,0.43764e+00_r8,0.48906e+00_r8,0.51485e+00_r8,0.52656e+00_r8, & + & 0.52602e+00_r8,0.51065e+00_r8,0.47517e+00_r8,0.35569e+00_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.29592e+00_r8,0.44770e+00_r8,0.49758e+00_r8,0.52367e+00_r8,0.53583e+00_r8, & + & 0.53525e+00_r8,0.51944e+00_r8,0.48175e+00_r8,0.36089e+00_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.31035e+00_r8,0.45721e+00_r8,0.50658e+00_r8,0.53311e+00_r8,0.54562e+00_r8, & + & 0.54468e+00_r8,0.52799e+00_r8,0.48800e+00_r8,0.36523e+00_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.32410e+00_r8,0.46702e+00_r8,0.51628e+00_r8,0.54315e+00_r8,0.55572e+00_r8, & + & 0.55402e+00_r8,0.53619e+00_r8,0.49402e+00_r8,0.36906e+00_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.21802e+00_r8,0.36523e+00_r8,0.41109e+00_r8,0.43388e+00_r8,0.44363e+00_r8, & + & 0.44316e+00_r8,0.43058e+00_r8,0.40065e+00_r8,0.29668e+00_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.23315e+00_r8,0.37455e+00_r8,0.41894e+00_r8,0.44116e+00_r8,0.45154e+00_r8, & + & 0.45134e+00_r8,0.43880e+00_r8,0.40751e+00_r8,0.30231e+00_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.24686e+00_r8,0.38301e+00_r8,0.42637e+00_r8,0.44889e+00_r8,0.45978e+00_r8, & + & 0.45969e+00_r8,0.44700e+00_r8,0.41408e+00_r8,0.30721e+00_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.25967e+00_r8,0.39102e+00_r8,0.43427e+00_r8,0.45708e+00_r8,0.46833e+00_r8, & + & 0.46819e+00_r8,0.45488e+00_r8,0.42031e+00_r8,0.31131e+00_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.27188e+00_r8,0.39949e+00_r8,0.44272e+00_r8,0.46608e+00_r8,0.47706e+00_r8, & + & 0.47653e+00_r8,0.46230e+00_r8,0.42618e+00_r8,0.31504e+00_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.18022e+00_r8,0.31183e+00_r8,0.35120e+00_r8,0.37079e+00_r8,0.37884e+00_r8, & + & 0.37804e+00_r8,0.36693e+00_r8,0.34063e+00_r8,0.24612e+00_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.19307e+00_r8,0.31966e+00_r8,0.35801e+00_r8,0.37712e+00_r8,0.38585e+00_r8, & + & 0.38558e+00_r8,0.37468e+00_r8,0.34716e+00_r8,0.25138e+00_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.20463e+00_r8,0.32683e+00_r8,0.36444e+00_r8,0.38387e+00_r8,0.39308e+00_r8, & + & 0.39294e+00_r8,0.38210e+00_r8,0.35364e+00_r8,0.25593e+00_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.21550e+00_r8,0.33367e+00_r8,0.37119e+00_r8,0.39103e+00_r8,0.40042e+00_r8, & + & 0.40039e+00_r8,0.38916e+00_r8,0.35964e+00_r8,0.25996e+00_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.22607e+00_r8,0.34108e+00_r8,0.37860e+00_r8,0.39875e+00_r8,0.40805e+00_r8, & + & 0.40762e+00_r8,0.39578e+00_r8,0.36518e+00_r8,0.26360e+00_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.14867e+00_r8,0.26554e+00_r8,0.29985e+00_r8,0.31657e+00_r8,0.32318e+00_r8, & + & 0.32201e+00_r8,0.31162e+00_r8,0.28815e+00_r8,0.21732e+00_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.15961e+00_r8,0.27217e+00_r8,0.30555e+00_r8,0.32206e+00_r8,0.32938e+00_r8, & + & 0.32864e+00_r8,0.31877e+00_r8,0.29424e+00_r8,0.22230e+00_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.16940e+00_r8,0.27829e+00_r8,0.31116e+00_r8,0.32786e+00_r8,0.33559e+00_r8, & + & 0.33509e+00_r8,0.32534e+00_r8,0.30046e+00_r8,0.22643e+00_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.17863e+00_r8,0.28410e+00_r8,0.31692e+00_r8,0.33409e+00_r8,0.34189e+00_r8, & + & 0.34154e+00_r8,0.33152e+00_r8,0.30607e+00_r8,0.23022e+00_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.18774e+00_r8,0.29050e+00_r8,0.32341e+00_r8,0.34075e+00_r8,0.34846e+00_r8, & + & 0.34771e+00_r8,0.33731e+00_r8,0.31120e+00_r8,0.23340e+00_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.12627e+00_r8,0.22669e+00_r8,0.25719e+00_r8,0.27172e+00_r8,0.27732e+00_r8, & + & 0.27601e+00_r8,0.26659e+00_r8,0.24512e+00_r8,0.18584e+00_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.13516e+00_r8,0.23214e+00_r8,0.26193e+00_r8,0.27653e+00_r8,0.28265e+00_r8, & + & 0.28160e+00_r8,0.27265e+00_r8,0.25095e+00_r8,0.18968e+00_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.14321e+00_r8,0.23722e+00_r8,0.26679e+00_r8,0.28162e+00_r8,0.28797e+00_r8, & + & 0.28724e+00_r8,0.27822e+00_r8,0.25645e+00_r8,0.19293e+00_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.15107e+00_r8,0.24247e+00_r8,0.27199e+00_r8,0.28706e+00_r8,0.29346e+00_r8, & + & 0.29269e+00_r8,0.28343e+00_r8,0.26131e+00_r8,0.19541e+00_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.15896e+00_r8,0.24837e+00_r8,0.27786e+00_r8,0.29309e+00_r8,0.29929e+00_r8, & + & 0.29804e+00_r8,0.28838e+00_r8,0.26594e+00_r8,0.19802e+00_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.10682e+00_r8,0.19256e+00_r8,0.21863e+00_r8,0.23192e+00_r8,0.23695e+00_r8, & + & 0.23560e+00_r8,0.22744e+00_r8,0.20844e+00_r8,0.16014e+00_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.11409e+00_r8,0.19699e+00_r8,0.22274e+00_r8,0.23606e+00_r8,0.24149e+00_r8, & + & 0.24040e+00_r8,0.23256e+00_r8,0.21367e+00_r8,0.16300e+00_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.12093e+00_r8,0.20128e+00_r8,0.22702e+00_r8,0.24050e+00_r8,0.24609e+00_r8, & + & 0.24521e+00_r8,0.23721e+00_r8,0.21831e+00_r8,0.16579e+00_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.12767e+00_r8,0.20601e+00_r8,0.23174e+00_r8,0.24542e+00_r8,0.25091e+00_r8, & + & 0.24990e+00_r8,0.24163e+00_r8,0.22258e+00_r8,0.16866e+00_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.13446e+00_r8,0.21151e+00_r8,0.23730e+00_r8,0.25089e+00_r8,0.25608e+00_r8, & + & 0.25469e+00_r8,0.24607e+00_r8,0.22668e+00_r8,0.17141e+00_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.90556e-01_r8,0.16301e+00_r8,0.18506e+00_r8,0.19633e+00_r8,0.20124e+00_r8, & + & 0.20042e+00_r8,0.19353e+00_r8,0.17713e+00_r8,0.13589e+00_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.96629e-01_r8,0.16667e+00_r8,0.18855e+00_r8,0.19991e+00_r8,0.20512e+00_r8, & + & 0.20458e+00_r8,0.19781e+00_r8,0.18150e+00_r8,0.13866e+00_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.10246e+00_r8,0.17045e+00_r8,0.19232e+00_r8,0.20386e+00_r8,0.20916e+00_r8, & + & 0.20868e+00_r8,0.20175e+00_r8,0.18546e+00_r8,0.14157e+00_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.10831e+00_r8,0.17481e+00_r8,0.19664e+00_r8,0.20827e+00_r8,0.21340e+00_r8, & + & 0.21278e+00_r8,0.20565e+00_r8,0.18920e+00_r8,0.14421e+00_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.11418e+00_r8,0.17993e+00_r8,0.20190e+00_r8,0.21347e+00_r8,0.21830e+00_r8, & + & 0.21718e+00_r8,0.20964e+00_r8,0.19280e+00_r8,0.14715e+00_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.20844e+01_r8,0.23344e+01_r8,0.25576e+01_r8,0.26701e+01_r8,0.27010e+01_r8, & + & 0.26681e+01_r8,0.25683e+01_r8,0.23655e+01_r8,0.20810e+01_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.20807e+01_r8,0.23304e+01_r8,0.25489e+01_r8,0.26611e+01_r8,0.26920e+01_r8, & + & 0.26609e+01_r8,0.25647e+01_r8,0.23645e+01_r8,0.20859e+01_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.20877e+01_r8,0.23342e+01_r8,0.25477e+01_r8,0.26548e+01_r8,0.26843e+01_r8, & + & 0.26541e+01_r8,0.25605e+01_r8,0.23637e+01_r8,0.20903e+01_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.21052e+01_r8,0.23454e+01_r8,0.25520e+01_r8,0.26529e+01_r8,0.26778e+01_r8, & + & 0.26478e+01_r8,0.25565e+01_r8,0.23630e+01_r8,0.20935e+01_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.21303e+01_r8,0.23633e+01_r8,0.25619e+01_r8,0.26546e+01_r8,0.26749e+01_r8, & + & 0.26429e+01_r8,0.25542e+01_r8,0.23619e+01_r8,0.20958e+01_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.18120e+01_r8,0.21101e+01_r8,0.23204e+01_r8,0.24266e+01_r8,0.24657e+01_r8, & + & 0.24469e+01_r8,0.23702e+01_r8,0.21931e+01_r8,0.18669e+01_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.18187e+01_r8,0.21137e+01_r8,0.23188e+01_r8,0.24223e+01_r8,0.24620e+01_r8, & + & 0.24436e+01_r8,0.23687e+01_r8,0.21944e+01_r8,0.18726e+01_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.18356e+01_r8,0.21255e+01_r8,0.23256e+01_r8,0.24232e+01_r8,0.24590e+01_r8, & + & 0.24407e+01_r8,0.23674e+01_r8,0.21960e+01_r8,0.18776e+01_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.18614e+01_r8,0.21447e+01_r8,0.23386e+01_r8,0.24287e+01_r8,0.24595e+01_r8, & + & 0.24387e+01_r8,0.23672e+01_r8,0.21970e+01_r8,0.18816e+01_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.18927e+01_r8,0.21683e+01_r8,0.23579e+01_r8,0.24392e+01_r8,0.24636e+01_r8, & + & 0.24407e+01_r8,0.23665e+01_r8,0.21974e+01_r8,0.18864e+01_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.15702e+01_r8,0.18942e+01_r8,0.20837e+01_r8,0.21854e+01_r8,0.22324e+01_r8, & + & 0.22266e+01_r8,0.21649e+01_r8,0.20134e+01_r8,0.16617e+01_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.15827e+01_r8,0.19038e+01_r8,0.20886e+01_r8,0.21865e+01_r8,0.22329e+01_r8, & + & 0.22266e+01_r8,0.21649e+01_r8,0.20167e+01_r8,0.16695e+01_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.16046e+01_r8,0.19213e+01_r8,0.21019e+01_r8,0.21942e+01_r8,0.22360e+01_r8, & + & 0.22271e+01_r8,0.21665e+01_r8,0.20195e+01_r8,0.16762e+01_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.16329e+01_r8,0.19443e+01_r8,0.21213e+01_r8,0.22070e+01_r8,0.22424e+01_r8, & + & 0.22311e+01_r8,0.21683e+01_r8,0.20214e+01_r8,0.16830e+01_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.16658e+01_r8,0.19717e+01_r8,0.21452e+01_r8,0.22251e+01_r8,0.22530e+01_r8, & + & 0.22371e+01_r8,0.21708e+01_r8,0.20238e+01_r8,0.16904e+01_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.13564e+01_r8,0.16869e+01_r8,0.18550e+01_r8,0.19537e+01_r8,0.20049e+01_r8, & + & 0.20085e+01_r8,0.19601e+01_r8,0.18287e+01_r8,0.14756e+01_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.13720e+01_r8,0.17000e+01_r8,0.18655e+01_r8,0.19607e+01_r8,0.20100e+01_r8, & + & 0.20105e+01_r8,0.19622e+01_r8,0.18339e+01_r8,0.14854e+01_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.13952e+01_r8,0.17204e+01_r8,0.18837e+01_r8,0.19740e+01_r8,0.20182e+01_r8, & + & 0.20154e+01_r8,0.19654e+01_r8,0.18384e+01_r8,0.14948e+01_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.14229e+01_r8,0.17461e+01_r8,0.19072e+01_r8,0.19926e+01_r8,0.20303e+01_r8, & + & 0.20234e+01_r8,0.19691e+01_r8,0.18420e+01_r8,0.15040e+01_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.14534e+01_r8,0.17751e+01_r8,0.19345e+01_r8,0.20154e+01_r8,0.20467e+01_r8, & + & 0.20337e+01_r8,0.19742e+01_r8,0.18465e+01_r8,0.15131e+01_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.11675e+01_r8,0.14906e+01_r8,0.16422e+01_r8,0.17364e+01_r8,0.17875e+01_r8, & + & 0.17970e+01_r8,0.17582e+01_r8,0.16459e+01_r8,0.13057e+01_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.11839e+01_r8,0.15062e+01_r8,0.16573e+01_r8,0.17483e+01_r8,0.17956e+01_r8, & + & 0.18020e+01_r8,0.17623e+01_r8,0.16529e+01_r8,0.13176e+01_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.12061e+01_r8,0.15281e+01_r8,0.16790e+01_r8,0.17660e+01_r8,0.18082e+01_r8, & + & 0.18106e+01_r8,0.17678e+01_r8,0.16587e+01_r8,0.13289e+01_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.12311e+01_r8,0.15549e+01_r8,0.17048e+01_r8,0.17877e+01_r8,0.18250e+01_r8, & + & 0.18222e+01_r8,0.17742e+01_r8,0.16644e+01_r8,0.13398e+01_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.12582e+01_r8,0.15836e+01_r8,0.17338e+01_r8,0.18131e+01_r8,0.18457e+01_r8, & + & 0.18359e+01_r8,0.17826e+01_r8,0.16710e+01_r8,0.13507e+01_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.99981e+00_r8,0.13080e+01_r8,0.14477e+01_r8,0.15356e+01_r8,0.15829e+01_r8, & + & 0.15936e+01_r8,0.15636e+01_r8,0.14683e+01_r8,0.11482e+01_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.10151e+01_r8,0.13251e+01_r8,0.14655e+01_r8,0.15504e+01_r8,0.15941e+01_r8, & + & 0.16015e+01_r8,0.15698e+01_r8,0.14767e+01_r8,0.11619e+01_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.10344e+01_r8,0.13476e+01_r8,0.14887e+01_r8,0.15702e+01_r8,0.16097e+01_r8, & + & 0.16130e+01_r8,0.15772e+01_r8,0.14847e+01_r8,0.11743e+01_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.10560e+01_r8,0.13735e+01_r8,0.15155e+01_r8,0.15939e+01_r8,0.16293e+01_r8, & + & 0.16276e+01_r8,0.15870e+01_r8,0.14924e+01_r8,0.11864e+01_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.10794e+01_r8,0.13996e+01_r8,0.15438e+01_r8,0.16205e+01_r8,0.16521e+01_r8, & + & 0.16451e+01_r8,0.15991e+01_r8,0.15003e+01_r8,0.11982e+01_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.85239e+00_r8,0.11419e+01_r8,0.12714e+01_r8,0.13507e+01_r8,0.13930e+01_r8, & + & 0.14039e+01_r8,0.13790e+01_r8,0.12971e+01_r8,0.10034e+01_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.86542e+00_r8,0.11591e+01_r8,0.12898e+01_r8,0.13670e+01_r8,0.14062e+01_r8, & + & 0.14139e+01_r8,0.13871e+01_r8,0.13072e+01_r8,0.10179e+01_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.88108e+00_r8,0.11809e+01_r8,0.13130e+01_r8,0.13880e+01_r8,0.14241e+01_r8, & + & 0.14278e+01_r8,0.13975e+01_r8,0.13172e+01_r8,0.10310e+01_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.89900e+00_r8,0.12041e+01_r8,0.13390e+01_r8,0.14123e+01_r8,0.14455e+01_r8, & + & 0.14453e+01_r8,0.14105e+01_r8,0.13266e+01_r8,0.10434e+01_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.91862e+00_r8,0.12279e+01_r8,0.13649e+01_r8,0.14386e+01_r8,0.14692e+01_r8, & + & 0.14664e+01_r8,0.14254e+01_r8,0.13367e+01_r8,0.10558e+01_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.72497e+00_r8,0.99201e+00_r8,0.11107e+01_r8,0.11813e+01_r8,0.12195e+01_r8, & + & 0.12285e+01_r8,0.12058e+01_r8,0.11359e+01_r8,0.87110e+00_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.73517e+00_r8,0.10086e+01_r8,0.11285e+01_r8,0.11988e+01_r8,0.12342e+01_r8, & + & 0.12405e+01_r8,0.12160e+01_r8,0.11479e+01_r8,0.88568e+00_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.74752e+00_r8,0.10285e+01_r8,0.11507e+01_r8,0.12198e+01_r8,0.12532e+01_r8, & + & 0.12570e+01_r8,0.12289e+01_r8,0.11589e+01_r8,0.89927e+00_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.76213e+00_r8,0.10489e+01_r8,0.11747e+01_r8,0.12436e+01_r8,0.12757e+01_r8, & + & 0.12769e+01_r8,0.12445e+01_r8,0.11700e+01_r8,0.91203e+00_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.77854e+00_r8,0.10697e+01_r8,0.11980e+01_r8,0.12679e+01_r8,0.13002e+01_r8, & + & 0.12994e+01_r8,0.12621e+01_r8,0.11816e+01_r8,0.92392e+00_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.61682e+00_r8,0.85841e+00_r8,0.96403e+00_r8,0.10272e+01_r8,0.10606e+01_r8, & + & 0.10679e+01_r8,0.10472e+01_r8,0.98715e+00_r8,0.74825e+00_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.62415e+00_r8,0.87401e+00_r8,0.98140e+00_r8,0.10446e+01_r8,0.10763e+01_r8, & + & 0.10811e+01_r8,0.10593e+01_r8,0.10003e+01_r8,0.76294e+00_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.63387e+00_r8,0.89104e+00_r8,0.10022e+01_r8,0.10651e+01_r8,0.10962e+01_r8, & + & 0.10997e+01_r8,0.10740e+01_r8,0.10120e+01_r8,0.77659e+00_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.64542e+00_r8,0.90872e+00_r8,0.10230e+01_r8,0.10878e+01_r8,0.11188e+01_r8, & + & 0.11207e+01_r8,0.10911e+01_r8,0.10243e+01_r8,0.78905e+00_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.65900e+00_r8,0.92674e+00_r8,0.10436e+01_r8,0.11103e+01_r8,0.11424e+01_r8, & + & 0.11435e+01_r8,0.11102e+01_r8,0.10375e+01_r8,0.80034e+00_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.52547e+00_r8,0.74220e+00_r8,0.83433e+00_r8,0.88890e+00_r8,0.91741e+00_r8, & + & 0.92336e+00_r8,0.90538e+00_r8,0.85311e+00_r8,0.64696e+00_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.53064e+00_r8,0.75604e+00_r8,0.85107e+00_r8,0.90584e+00_r8,0.93361e+00_r8, & + & 0.93836e+00_r8,0.91861e+00_r8,0.86626e+00_r8,0.66062e+00_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.53809e+00_r8,0.77037e+00_r8,0.86942e+00_r8,0.92562e+00_r8,0.95409e+00_r8, & + & 0.95774e+00_r8,0.93423e+00_r8,0.87871e+00_r8,0.67391e+00_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.54734e+00_r8,0.78576e+00_r8,0.88734e+00_r8,0.94634e+00_r8,0.97611e+00_r8, & + & 0.97890e+00_r8,0.95253e+00_r8,0.89191e+00_r8,0.68526e+00_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.55842e+00_r8,0.80129e+00_r8,0.90542e+00_r8,0.96675e+00_r8,0.99781e+00_r8, & + & 0.10013e+01_r8,0.97253e+00_r8,0.90597e+00_r8,0.69583e+00_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.44902e+00_r8,0.64641e+00_r8,0.72682e+00_r8,0.77295e+00_r8,0.79679e+00_r8, & + & 0.80095e+00_r8,0.78478e+00_r8,0.73880e+00_r8,0.57500e+00_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.45343e+00_r8,0.65819e+00_r8,0.74259e+00_r8,0.79030e+00_r8,0.81509e+00_r8, & + & 0.81866e+00_r8,0.79960e+00_r8,0.75137e+00_r8,0.58784e+00_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.45968e+00_r8,0.67094e+00_r8,0.75812e+00_r8,0.80898e+00_r8,0.83522e+00_r8, & + & 0.83854e+00_r8,0.81711e+00_r8,0.76461e+00_r8,0.59939e+00_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.46764e+00_r8,0.68418e+00_r8,0.77402e+00_r8,0.82711e+00_r8,0.85518e+00_r8, & + & 0.85968e+00_r8,0.83634e+00_r8,0.77859e+00_r8,0.60954e+00_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.47750e+00_r8,0.69798e+00_r8,0.79021e+00_r8,0.84534e+00_r8,0.87480e+00_r8, & + & 0.88011e+00_r8,0.85595e+00_r8,0.79269e+00_r8,0.61896e+00_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.38252e+00_r8,0.56123e+00_r8,0.63221e+00_r8,0.67207e+00_r8,0.69191e+00_r8, & + & 0.69451e+00_r8,0.67853e+00_r8,0.63671e+00_r8,0.49624e+00_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.38610e+00_r8,0.57152e+00_r8,0.64559e+00_r8,0.68857e+00_r8,0.70992e+00_r8, & + & 0.71250e+00_r8,0.69440e+00_r8,0.64948e+00_r8,0.50772e+00_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.39135e+00_r8,0.58251e+00_r8,0.65953e+00_r8,0.70459e+00_r8,0.72793e+00_r8, & + & 0.73188e+00_r8,0.71251e+00_r8,0.66314e+00_r8,0.51771e+00_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.39838e+00_r8,0.59406e+00_r8,0.67357e+00_r8,0.72066e+00_r8,0.74570e+00_r8, & + & 0.75075e+00_r8,0.73108e+00_r8,0.67696e+00_r8,0.52680e+00_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.40785e+00_r8,0.60628e+00_r8,0.68802e+00_r8,0.73685e+00_r8,0.76342e+00_r8, & + & 0.76842e+00_r8,0.74857e+00_r8,0.69135e+00_r8,0.53408e+00_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.32297e+00_r8,0.48556e+00_r8,0.54760e+00_r8,0.58350e+00_r8,0.60079e+00_r8, & + & 0.60116e+00_r8,0.58518e+00_r8,0.54699e+00_r8,0.42276e+00_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.32591e+00_r8,0.49445e+00_r8,0.55963e+00_r8,0.59764e+00_r8,0.61654e+00_r8, & + & 0.61844e+00_r8,0.60149e+00_r8,0.55973e+00_r8,0.43280e+00_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.33057e+00_r8,0.50405e+00_r8,0.57184e+00_r8,0.61186e+00_r8,0.63239e+00_r8, & + & 0.63557e+00_r8,0.61864e+00_r8,0.57305e+00_r8,0.44151e+00_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.33705e+00_r8,0.51427e+00_r8,0.58428e+00_r8,0.62614e+00_r8,0.64825e+00_r8, & + & 0.65175e+00_r8,0.63492e+00_r8,0.58689e+00_r8,0.44893e+00_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.34636e+00_r8,0.52544e+00_r8,0.59740e+00_r8,0.64055e+00_r8,0.66342e+00_r8, & + & 0.66736e+00_r8,0.65002e+00_r8,0.60055e+00_r8,0.45487e+00_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.72991e+01_r8,0.69722e+01_r8,0.72863e+01_r8,0.75002e+01_r8,0.75688e+01_r8, & + & 0.74622e+01_r8,0.71020e+01_r8,0.65825e+01_r8,0.69144e+01_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.72210e+01_r8,0.69084e+01_r8,0.72319e+01_r8,0.74567e+01_r8,0.75409e+01_r8, & + & 0.74459e+01_r8,0.71001e+01_r8,0.65930e+01_r8,0.69213e+01_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.71481e+01_r8,0.68475e+01_r8,0.71760e+01_r8,0.74130e+01_r8,0.75097e+01_r8, & + & 0.74266e+01_r8,0.70905e+01_r8,0.65992e+01_r8,0.69258e+01_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.70810e+01_r8,0.67891e+01_r8,0.71222e+01_r8,0.73713e+01_r8,0.74785e+01_r8, & + & 0.74023e+01_r8,0.70766e+01_r8,0.66037e+01_r8,0.69303e+01_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.70205e+01_r8,0.67342e+01_r8,0.70686e+01_r8,0.73258e+01_r8,0.74436e+01_r8, & + & 0.73740e+01_r8,0.70585e+01_r8,0.66060e+01_r8,0.69339e+01_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.68023e+01_r8,0.66845e+01_r8,0.71435e+01_r8,0.74293e+01_r8,0.75528e+01_r8, & + & 0.74805e+01_r8,0.71383e+01_r8,0.65087e+01_r8,0.66425e+01_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.67309e+01_r8,0.66228e+01_r8,0.70899e+01_r8,0.73862e+01_r8,0.75243e+01_r8, & + & 0.74671e+01_r8,0.71358e+01_r8,0.65240e+01_r8,0.66588e+01_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.66680e+01_r8,0.65659e+01_r8,0.70365e+01_r8,0.73443e+01_r8,0.74954e+01_r8, & + & 0.74486e+01_r8,0.71260e+01_r8,0.65367e+01_r8,0.66745e+01_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.66136e+01_r8,0.65139e+01_r8,0.69841e+01_r8,0.73016e+01_r8,0.74627e+01_r8, & + & 0.74252e+01_r8,0.71129e+01_r8,0.65455e+01_r8,0.66889e+01_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.65687e+01_r8,0.64706e+01_r8,0.69322e+01_r8,0.72576e+01_r8,0.74266e+01_r8, & + & 0.73967e+01_r8,0.70986e+01_r8,0.65510e+01_r8,0.67011e+01_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.62554e+01_r8,0.63717e+01_r8,0.69259e+01_r8,0.72750e+01_r8,0.74339e+01_r8, & + & 0.73812e+01_r8,0.70638e+01_r8,0.63830e+01_r8,0.62738e+01_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.61935e+01_r8,0.63130e+01_r8,0.68741e+01_r8,0.72340e+01_r8,0.74081e+01_r8, & + & 0.73723e+01_r8,0.70661e+01_r8,0.64055e+01_r8,0.63017e+01_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.61417e+01_r8,0.62609e+01_r8,0.68234e+01_r8,0.71924e+01_r8,0.73793e+01_r8, & + & 0.73559e+01_r8,0.70613e+01_r8,0.64217e+01_r8,0.63259e+01_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.61027e+01_r8,0.62184e+01_r8,0.67754e+01_r8,0.71518e+01_r8,0.73493e+01_r8, & + & 0.73341e+01_r8,0.70537e+01_r8,0.64352e+01_r8,0.63471e+01_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.60751e+01_r8,0.61846e+01_r8,0.67335e+01_r8,0.71090e+01_r8,0.73143e+01_r8, & + & 0.73100e+01_r8,0.70431e+01_r8,0.64459e+01_r8,0.63674e+01_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.56712e+01_r8,0.60174e+01_r8,0.66407e+01_r8,0.70308e+01_r8,0.72054e+01_r8, & + & 0.71700e+01_r8,0.68768e+01_r8,0.62076e+01_r8,0.58601e+01_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.56177e+01_r8,0.59637e+01_r8,0.65912e+01_r8,0.69914e+01_r8,0.71823e+01_r8, & + & 0.71644e+01_r8,0.68840e+01_r8,0.62360e+01_r8,0.58965e+01_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.55798e+01_r8,0.59204e+01_r8,0.65459e+01_r8,0.69532e+01_r8,0.71589e+01_r8, & + & 0.71503e+01_r8,0.68872e+01_r8,0.62571e+01_r8,0.59275e+01_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.55576e+01_r8,0.58874e+01_r8,0.65057e+01_r8,0.69160e+01_r8,0.71305e+01_r8, & + & 0.71327e+01_r8,0.68860e+01_r8,0.62738e+01_r8,0.59560e+01_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.55509e+01_r8,0.58664e+01_r8,0.64735e+01_r8,0.68799e+01_r8,0.70989e+01_r8, & + & 0.71129e+01_r8,0.68803e+01_r8,0.62864e+01_r8,0.59817e+01_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.50748e+01_r8,0.56236e+01_r8,0.62897e+01_r8,0.66937e+01_r8,0.68773e+01_r8, & + & 0.68583e+01_r8,0.65966e+01_r8,0.59739e+01_r8,0.54247e+01_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.50332e+01_r8,0.55772e+01_r8,0.62435e+01_r8,0.66588e+01_r8,0.68602e+01_r8, & + & 0.68553e+01_r8,0.66099e+01_r8,0.60056e+01_r8,0.54668e+01_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.50094e+01_r8,0.55429e+01_r8,0.62032e+01_r8,0.66264e+01_r8,0.68392e+01_r8, & + & 0.68457e+01_r8,0.66198e+01_r8,0.60291e+01_r8,0.55024e+01_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.50054e+01_r8,0.55221e+01_r8,0.61728e+01_r8,0.65959e+01_r8,0.68138e+01_r8, & + & 0.68347e+01_r8,0.66239e+01_r8,0.60504e+01_r8,0.55378e+01_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.50196e+01_r8,0.55140e+01_r8,0.61502e+01_r8,0.65696e+01_r8,0.67880e+01_r8, & + & 0.68224e+01_r8,0.66232e+01_r8,0.60661e+01_r8,0.55660e+01_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.44929e+01_r8,0.51985e+01_r8,0.58791e+01_r8,0.62757e+01_r8,0.64716e+01_r8, & + & 0.64669e+01_r8,0.62368e+01_r8,0.56853e+01_r8,0.49792e+01_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.44612e+01_r8,0.51596e+01_r8,0.58385e+01_r8,0.62487e+01_r8,0.64570e+01_r8, & + & 0.64678e+01_r8,0.62575e+01_r8,0.57196e+01_r8,0.50244e+01_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.44521e+01_r8,0.51348e+01_r8,0.58071e+01_r8,0.62248e+01_r8,0.64383e+01_r8, & + & 0.64639e+01_r8,0.62747e+01_r8,0.57459e+01_r8,0.50676e+01_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.44651e+01_r8,0.51248e+01_r8,0.57862e+01_r8,0.62029e+01_r8,0.64206e+01_r8, & + & 0.64594e+01_r8,0.62829e+01_r8,0.57703e+01_r8,0.51061e+01_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.44974e+01_r8,0.51321e+01_r8,0.57769e+01_r8,0.61847e+01_r8,0.64045e+01_r8, & + & 0.64518e+01_r8,0.62850e+01_r8,0.57880e+01_r8,0.51383e+01_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.39405e+01_r8,0.47599e+01_r8,0.54183e+01_r8,0.58070e+01_r8,0.60002e+01_r8, & + & 0.60137e+01_r8,0.58231e+01_r8,0.53430e+01_r8,0.45395e+01_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.39200e+01_r8,0.47279e+01_r8,0.53865e+01_r8,0.57866e+01_r8,0.59900e+01_r8, & + & 0.60178e+01_r8,0.58493e+01_r8,0.53803e+01_r8,0.45897e+01_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.39243e+01_r8,0.47128e+01_r8,0.53651e+01_r8,0.57689e+01_r8,0.59779e+01_r8, & + & 0.60210e+01_r8,0.58689e+01_r8,0.54093e+01_r8,0.46370e+01_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.39509e+01_r8,0.47158e+01_r8,0.53566e+01_r8,0.57541e+01_r8,0.59686e+01_r8, & + & 0.60221e+01_r8,0.58794e+01_r8,0.54360e+01_r8,0.46801e+01_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.39997e+01_r8,0.47365e+01_r8,0.53625e+01_r8,0.57480e+01_r8,0.59641e+01_r8, & + & 0.60191e+01_r8,0.58864e+01_r8,0.54567e+01_r8,0.47154e+01_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.34277e+01_r8,0.43224e+01_r8,0.49312e+01_r8,0.53036e+01_r8,0.54930e+01_r8, & + & 0.55228e+01_r8,0.53766e+01_r8,0.49651e+01_r8,0.41155e+01_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.34174e+01_r8,0.42976e+01_r8,0.49104e+01_r8,0.52883e+01_r8,0.54862e+01_r8, & + & 0.55322e+01_r8,0.54048e+01_r8,0.50049e+01_r8,0.41706e+01_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.34328e+01_r8,0.42901e+01_r8,0.49000e+01_r8,0.52782e+01_r8,0.54821e+01_r8, & + & 0.55409e+01_r8,0.54257e+01_r8,0.50383e+01_r8,0.42218e+01_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.34724e+01_r8,0.43054e+01_r8,0.49030e+01_r8,0.52739e+01_r8,0.54825e+01_r8, & + & 0.55468e+01_r8,0.54402e+01_r8,0.50678e+01_r8,0.42656e+01_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.35331e+01_r8,0.43394e+01_r8,0.49199e+01_r8,0.52816e+01_r8,0.54871e+01_r8, & + & 0.55512e+01_r8,0.54505e+01_r8,0.50918e+01_r8,0.43035e+01_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.29643e+01_r8,0.38841e+01_r8,0.44459e+01_r8,0.47885e+01_r8,0.49734e+01_r8, & + & 0.50221e+01_r8,0.49131e+01_r8,0.45659e+01_r8,0.37057e+01_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.29616e+01_r8,0.38662e+01_r8,0.44298e+01_r8,0.47788e+01_r8,0.49743e+01_r8, & + & 0.50365e+01_r8,0.49428e+01_r8,0.46088e+01_r8,0.37656e+01_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.29848e+01_r8,0.38693e+01_r8,0.44274e+01_r8,0.47752e+01_r8,0.49768e+01_r8, & + & 0.50477e+01_r8,0.49663e+01_r8,0.46464e+01_r8,0.38194e+01_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.30329e+01_r8,0.38944e+01_r8,0.44404e+01_r8,0.47824e+01_r8,0.49850e+01_r8, & + & 0.50582e+01_r8,0.49851e+01_r8,0.46790e+01_r8,0.38645e+01_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.31033e+01_r8,0.39395e+01_r8,0.44689e+01_r8,0.48029e+01_r8,0.49990e+01_r8, & + & 0.50689e+01_r8,0.50004e+01_r8,0.47030e+01_r8,0.39063e+01_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.25528e+01_r8,0.34541e+01_r8,0.39652e+01_r8,0.42831e+01_r8,0.44659e+01_r8, & + & 0.45285e+01_r8,0.44509e+01_r8,0.41587e+01_r8,0.32612e+01_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.25575e+01_r8,0.34458e+01_r8,0.39558e+01_r8,0.42802e+01_r8,0.44723e+01_r8, & + & 0.45451e+01_r8,0.44820e+01_r8,0.42051e+01_r8,0.33240e+01_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.25883e+01_r8,0.34607e+01_r8,0.39625e+01_r8,0.42854e+01_r8,0.44811e+01_r8, & + & 0.45602e+01_r8,0.45090e+01_r8,0.42460e+01_r8,0.33785e+01_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.26435e+01_r8,0.34963e+01_r8,0.39867e+01_r8,0.43038e+01_r8,0.44956e+01_r8, & + & 0.45761e+01_r8,0.45312e+01_r8,0.42799e+01_r8,0.34270e+01_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.27203e+01_r8,0.35517e+01_r8,0.40270e+01_r8,0.43344e+01_r8,0.45189e+01_r8, & + & 0.45941e+01_r8,0.45504e+01_r8,0.43065e+01_r8,0.34705e+01_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.21958e+01_r8,0.30498e+01_r8,0.35059e+01_r8,0.38049e+01_r8,0.39876e+01_r8, & + & 0.40622e+01_r8,0.40123e+01_r8,0.37729e+01_r8,0.28786e+01_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.22177e+01_r8,0.30598e+01_r8,0.35116e+01_r8,0.38116e+01_r8,0.39989e+01_r8, & + & 0.40819e+01_r8,0.40442e+01_r8,0.38191e+01_r8,0.29389e+01_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.22647e+01_r8,0.30907e+01_r8,0.35359e+01_r8,0.38306e+01_r8,0.40167e+01_r8, & + & 0.41020e+01_r8,0.40724e+01_r8,0.38578e+01_r8,0.29915e+01_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.23337e+01_r8,0.31425e+01_r8,0.35763e+01_r8,0.38632e+01_r8,0.40437e+01_r8, & + & 0.41245e+01_r8,0.40973e+01_r8,0.38902e+01_r8,0.30386e+01_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.24135e+01_r8,0.32120e+01_r8,0.36330e+01_r8,0.39077e+01_r8,0.40797e+01_r8, & + & 0.41526e+01_r8,0.41204e+01_r8,0.39195e+01_r8,0.30818e+01_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.18956e+01_r8,0.26861e+01_r8,0.30931e+01_r8,0.33674e+01_r8,0.35425e+01_r8, & + & 0.36210e+01_r8,0.35899e+01_r8,0.33921e+01_r8,0.25824e+01_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.19314e+01_r8,0.27108e+01_r8,0.31141e+01_r8,0.33855e+01_r8,0.35620e+01_r8, & + & 0.36450e+01_r8,0.36224e+01_r8,0.34362e+01_r8,0.26351e+01_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.19899e+01_r8,0.27565e+01_r8,0.31515e+01_r8,0.34177e+01_r8,0.35909e+01_r8, & + & 0.36718e+01_r8,0.36517e+01_r8,0.34743e+01_r8,0.26837e+01_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.20599e+01_r8,0.28211e+01_r8,0.32055e+01_r8,0.34628e+01_r8,0.36291e+01_r8, & + & 0.37038e+01_r8,0.36800e+01_r8,0.35081e+01_r8,0.27286e+01_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.21342e+01_r8,0.28994e+01_r8,0.32752e+01_r8,0.35201e+01_r8,0.36745e+01_r8, & + & 0.37420e+01_r8,0.37112e+01_r8,0.35392e+01_r8,0.27703e+01_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.16403e+01_r8,0.23651e+01_r8,0.27290e+01_r8,0.29746e+01_r8,0.31326e+01_r8, & + & 0.32080e+01_r8,0.31891e+01_r8,0.30274e+01_r8,0.23307e+01_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.16863e+01_r8,0.24025e+01_r8,0.27611e+01_r8,0.30044e+01_r8,0.31618e+01_r8, & + & 0.32369e+01_r8,0.32226e+01_r8,0.30700e+01_r8,0.23815e+01_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.17455e+01_r8,0.24598e+01_r8,0.28102e+01_r8,0.30475e+01_r8,0.32007e+01_r8, & + & 0.32722e+01_r8,0.32554e+01_r8,0.31073e+01_r8,0.24291e+01_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.18100e+01_r8,0.25311e+01_r8,0.28759e+01_r8,0.31035e+01_r8,0.32472e+01_r8, & + & 0.33131e+01_r8,0.32901e+01_r8,0.31417e+01_r8,0.24730e+01_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.18736e+01_r8,0.26085e+01_r8,0.29527e+01_r8,0.31711e+01_r8,0.33027e+01_r8, & + & 0.33589e+01_r8,0.33290e+01_r8,0.31763e+01_r8,0.25126e+01_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.19065e+02_r8,0.16899e+02_r8,0.15643e+02_r8,0.15578e+02_r8,0.15043e+02_r8, & + & 0.14288e+02_r8,0.13684e+02_r8,0.14703e+02_r8,0.16312e+02_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.18912e+02_r8,0.16761e+02_r8,0.15514e+02_r8,0.15480e+02_r8,0.14973e+02_r8, & + & 0.14273e+02_r8,0.13717e+02_r8,0.14749e+02_r8,0.16352e+02_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.18728e+02_r8,0.16596e+02_r8,0.15380e+02_r8,0.15367e+02_r8,0.14915e+02_r8, & + & 0.14240e+02_r8,0.13761e+02_r8,0.14772e+02_r8,0.16373e+02_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.18544e+02_r8,0.16434e+02_r8,0.15250e+02_r8,0.15223e+02_r8,0.14839e+02_r8, & + & 0.14214e+02_r8,0.13761e+02_r8,0.14749e+02_r8,0.16351e+02_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.18333e+02_r8,0.16256e+02_r8,0.15122e+02_r8,0.15098e+02_r8,0.14749e+02_r8, & + & 0.14176e+02_r8,0.13735e+02_r8,0.14720e+02_r8,0.16309e+02_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.19359e+02_r8,0.17148e+02_r8,0.16419e+02_r8,0.16424e+02_r8,0.16006e+02_r8, & + & 0.15375e+02_r8,0.14545e+02_r8,0.15202e+02_r8,0.16997e+02_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.19172e+02_r8,0.16980e+02_r8,0.16267e+02_r8,0.16317e+02_r8,0.15911e+02_r8, & + & 0.15334e+02_r8,0.14618e+02_r8,0.15283e+02_r8,0.17084e+02_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.18973e+02_r8,0.16804e+02_r8,0.16126e+02_r8,0.16185e+02_r8,0.15827e+02_r8, & + & 0.15302e+02_r8,0.14664e+02_r8,0.15280e+02_r8,0.17092e+02_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.18751e+02_r8,0.16617e+02_r8,0.15988e+02_r8,0.16055e+02_r8,0.15738e+02_r8, & + & 0.15272e+02_r8,0.14654e+02_r8,0.15237e+02_r8,0.17035e+02_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.18520e+02_r8,0.16417e+02_r8,0.15855e+02_r8,0.15950e+02_r8,0.15639e+02_r8, & + & 0.15219e+02_r8,0.14617e+02_r8,0.15192e+02_r8,0.16961e+02_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.19263e+02_r8,0.17075e+02_r8,0.17060e+02_r8,0.17120e+02_r8,0.16883e+02_r8, & + & 0.16381e+02_r8,0.15414e+02_r8,0.15455e+02_r8,0.17398e+02_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.19059e+02_r8,0.16894e+02_r8,0.16898e+02_r8,0.17000e+02_r8,0.16773e+02_r8, & + & 0.16323e+02_r8,0.15500e+02_r8,0.15491e+02_r8,0.17437e+02_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.18835e+02_r8,0.16708e+02_r8,0.16745e+02_r8,0.16865e+02_r8,0.16669e+02_r8, & + & 0.16285e+02_r8,0.15530e+02_r8,0.15496e+02_r8,0.17423e+02_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.18600e+02_r8,0.16513e+02_r8,0.16588e+02_r8,0.16744e+02_r8,0.16560e+02_r8, & + & 0.16244e+02_r8,0.15515e+02_r8,0.15476e+02_r8,0.17372e+02_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.18358e+02_r8,0.16312e+02_r8,0.16416e+02_r8,0.16627e+02_r8,0.16462e+02_r8, & + & 0.16172e+02_r8,0.15490e+02_r8,0.15433e+02_r8,0.17293e+02_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.18801e+02_r8,0.16888e+02_r8,0.17351e+02_r8,0.17638e+02_r8,0.17654e+02_r8, & + & 0.17241e+02_r8,0.16305e+02_r8,0.15458e+02_r8,0.17321e+02_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.18579e+02_r8,0.16692e+02_r8,0.17197e+02_r8,0.17496e+02_r8,0.17520e+02_r8, & + & 0.17188e+02_r8,0.16384e+02_r8,0.15486e+02_r8,0.17346e+02_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.18342e+02_r8,0.16488e+02_r8,0.17035e+02_r8,0.17349e+02_r8,0.17380e+02_r8, & + & 0.17158e+02_r8,0.16385e+02_r8,0.15526e+02_r8,0.17367e+02_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.18091e+02_r8,0.16279e+02_r8,0.16863e+02_r8,0.17208e+02_r8,0.17266e+02_r8, & + & 0.17103e+02_r8,0.16355e+02_r8,0.15560e+02_r8,0.17358e+02_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.17836e+02_r8,0.16059e+02_r8,0.16677e+02_r8,0.17068e+02_r8,0.17166e+02_r8, & + & 0.17011e+02_r8,0.16312e+02_r8,0.15578e+02_r8,0.17344e+02_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.17961e+02_r8,0.16659e+02_r8,0.17334e+02_r8,0.17976e+02_r8,0.18171e+02_r8, & + & 0.17832e+02_r8,0.16966e+02_r8,0.15432e+02_r8,0.16855e+02_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.17714e+02_r8,0.16442e+02_r8,0.17178e+02_r8,0.17800e+02_r8,0.18030e+02_r8, & + & 0.17804e+02_r8,0.17004e+02_r8,0.15487e+02_r8,0.16904e+02_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.17470e+02_r8,0.16231e+02_r8,0.17012e+02_r8,0.17636e+02_r8,0.17902e+02_r8, & + & 0.17774e+02_r8,0.16959e+02_r8,0.15590e+02_r8,0.16987e+02_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.17221e+02_r8,0.16002e+02_r8,0.16835e+02_r8,0.17477e+02_r8,0.17804e+02_r8, & + & 0.17680e+02_r8,0.16923e+02_r8,0.15646e+02_r8,0.17004e+02_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.16955e+02_r8,0.15778e+02_r8,0.16648e+02_r8,0.17325e+02_r8,0.17709e+02_r8, & + & 0.17576e+02_r8,0.16895e+02_r8,0.15664e+02_r8,0.17027e+02_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.16796e+02_r8,0.16241e+02_r8,0.17123e+02_r8,0.18098e+02_r8,0.18345e+02_r8, & + & 0.18145e+02_r8,0.17297e+02_r8,0.15317e+02_r8,0.16076e+02_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.16561e+02_r8,0.16019e+02_r8,0.16973e+02_r8,0.17901e+02_r8,0.18253e+02_r8, & + & 0.18123e+02_r8,0.17284e+02_r8,0.15411e+02_r8,0.16194e+02_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.16307e+02_r8,0.15790e+02_r8,0.16801e+02_r8,0.17722e+02_r8,0.18189e+02_r8, & + & 0.18068e+02_r8,0.17217e+02_r8,0.15556e+02_r8,0.16309e+02_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.16045e+02_r8,0.15571e+02_r8,0.16615e+02_r8,0.17565e+02_r8,0.18113e+02_r8, & + & 0.17968e+02_r8,0.17201e+02_r8,0.15625e+02_r8,0.16374e+02_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.15792e+02_r8,0.15350e+02_r8,0.16424e+02_r8,0.17437e+02_r8,0.17997e+02_r8, & + & 0.17869e+02_r8,0.17203e+02_r8,0.15664e+02_r8,0.16420e+02_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.15441e+02_r8,0.15555e+02_r8,0.16836e+02_r8,0.17857e+02_r8,0.18265e+02_r8, & + & 0.18114e+02_r8,0.17249e+02_r8,0.15143e+02_r8,0.15078e+02_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.15190e+02_r8,0.15341e+02_r8,0.16649e+02_r8,0.17679e+02_r8,0.18211e+02_r8, & + & 0.18098e+02_r8,0.17215e+02_r8,0.15278e+02_r8,0.15251e+02_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.14946e+02_r8,0.15122e+02_r8,0.16458e+02_r8,0.17534e+02_r8,0.18165e+02_r8, & + & 0.18029e+02_r8,0.17165e+02_r8,0.15443e+02_r8,0.15389e+02_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.14700e+02_r8,0.14908e+02_r8,0.16252e+02_r8,0.17424e+02_r8,0.18072e+02_r8, & + & 0.17929e+02_r8,0.17187e+02_r8,0.15518e+02_r8,0.15458e+02_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.14445e+02_r8,0.14710e+02_r8,0.16048e+02_r8,0.17304e+02_r8,0.17932e+02_r8, & + & 0.17873e+02_r8,0.17206e+02_r8,0.15573e+02_r8,0.15541e+02_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.13963e+02_r8,0.14641e+02_r8,0.16339e+02_r8,0.17287e+02_r8,0.17853e+02_r8, & + & 0.17712e+02_r8,0.16836e+02_r8,0.14867e+02_r8,0.13958e+02_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.13720e+02_r8,0.14441e+02_r8,0.16121e+02_r8,0.17175e+02_r8,0.17806e+02_r8, & + & 0.17701e+02_r8,0.16817e+02_r8,0.15013e+02_r8,0.14139e+02_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.13475e+02_r8,0.14253e+02_r8,0.15918e+02_r8,0.17071e+02_r8,0.17741e+02_r8, & + & 0.17634e+02_r8,0.16820e+02_r8,0.15155e+02_r8,0.14269e+02_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.13235e+02_r8,0.14056e+02_r8,0.15727e+02_r8,0.16983e+02_r8,0.17630e+02_r8, & + & 0.17564e+02_r8,0.16869e+02_r8,0.15238e+02_r8,0.14383e+02_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.13009e+02_r8,0.13855e+02_r8,0.15556e+02_r8,0.16857e+02_r8,0.17508e+02_r8, & + & 0.17529e+02_r8,0.16912e+02_r8,0.15302e+02_r8,0.14496e+02_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.12422e+02_r8,0.13743e+02_r8,0.15496e+02_r8,0.16530e+02_r8,0.17068e+02_r8, & + & 0.16944e+02_r8,0.16119e+02_r8,0.14360e+02_r8,0.12852e+02_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.12195e+02_r8,0.13543e+02_r8,0.15328e+02_r8,0.16447e+02_r8,0.17000e+02_r8, & + & 0.16934e+02_r8,0.16148e+02_r8,0.14484e+02_r8,0.13012e+02_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.11972e+02_r8,0.13354e+02_r8,0.15163e+02_r8,0.16359e+02_r8,0.16940e+02_r8, & + & 0.16900e+02_r8,0.16191e+02_r8,0.14599e+02_r8,0.13152e+02_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.11752e+02_r8,0.13166e+02_r8,0.15011e+02_r8,0.16249e+02_r8,0.16842e+02_r8, & + & 0.16880e+02_r8,0.16254e+02_r8,0.14688e+02_r8,0.13295e+02_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.11542e+02_r8,0.12972e+02_r8,0.14878e+02_r8,0.16107e+02_r8,0.16750e+02_r8, & + & 0.16884e+02_r8,0.16301e+02_r8,0.14790e+02_r8,0.13417e+02_r8 /) + kao(:, 1,10,10) = (/ & + & 0.10883e+02_r8,0.12799e+02_r8,0.14471e+02_r8,0.15523e+02_r8,0.15963e+02_r8, & + & 0.15867e+02_r8,0.15188e+02_r8,0.13687e+02_r8,0.11830e+02_r8 /) + kao(:, 2,10,10) = (/ & + & 0.10669e+02_r8,0.12615e+02_r8,0.14351e+02_r8,0.15423e+02_r8,0.15920e+02_r8, & + & 0.15883e+02_r8,0.15251e+02_r8,0.13796e+02_r8,0.11997e+02_r8 /) + kao(:, 3,10,10) = (/ & + & 0.10461e+02_r8,0.12417e+02_r8,0.14235e+02_r8,0.15340e+02_r8,0.15857e+02_r8, & + & 0.15885e+02_r8,0.15315e+02_r8,0.13895e+02_r8,0.12154e+02_r8 /) + kao(:, 4,10,10) = (/ & + & 0.10271e+02_r8,0.12218e+02_r8,0.14109e+02_r8,0.15234e+02_r8,0.15808e+02_r8, & + & 0.15905e+02_r8,0.15383e+02_r8,0.14000e+02_r8,0.12311e+02_r8 /) + kao(:, 5,10,10) = (/ & + & 0.10108e+02_r8,0.12035e+02_r8,0.13977e+02_r8,0.15117e+02_r8,0.15764e+02_r8, & + & 0.15927e+02_r8,0.15450e+02_r8,0.14121e+02_r8,0.12430e+02_r8 /) + kao(:, 1,11,10) = (/ & + & 0.93334e+01_r8,0.11625e+02_r8,0.13302e+02_r8,0.14226e+02_r8,0.14663e+02_r8, & + & 0.14671e+02_r8,0.14179e+02_r8,0.12958e+02_r8,0.10939e+02_r8 /) + kao(:, 2,11,10) = (/ & + & 0.91435e+01_r8,0.11452e+02_r8,0.13192e+02_r8,0.14163e+02_r8,0.14640e+02_r8, & + & 0.14697e+02_r8,0.14256e+02_r8,0.13072e+02_r8,0.11104e+02_r8 /) + kao(:, 3,11,10) = (/ & + & 0.89744e+01_r8,0.11286e+02_r8,0.13068e+02_r8,0.14085e+02_r8,0.14619e+02_r8, & + & 0.14728e+02_r8,0.14326e+02_r8,0.13192e+02_r8,0.11276e+02_r8 /) + kao(:, 4,11,10) = (/ & + & 0.88386e+01_r8,0.11134e+02_r8,0.12957e+02_r8,0.14008e+02_r8,0.14602e+02_r8, & + & 0.14761e+02_r8,0.14404e+02_r8,0.13322e+02_r8,0.11423e+02_r8 /) + kao(:, 5,11,10) = (/ & + & 0.88280e+01_r8,0.11011e+02_r8,0.12844e+02_r8,0.13942e+02_r8,0.14584e+02_r8, & + & 0.14790e+02_r8,0.14494e+02_r8,0.13437e+02_r8,0.11537e+02_r8 /) + kao(:, 1,12,10) = (/ & + & 0.79516e+01_r8,0.10418e+02_r8,0.11985e+02_r8,0.12856e+02_r8,0.13326e+02_r8, & + & 0.13448e+02_r8,0.13142e+02_r8,0.12163e+02_r8,0.97408e+01_r8 /) + kao(:, 2,12,10) = (/ & + & 0.78004e+01_r8,0.10286e+02_r8,0.11886e+02_r8,0.12812e+02_r8,0.13327e+02_r8, & + & 0.13488e+02_r8,0.13229e+02_r8,0.12301e+02_r8,0.99474e+01_r8 /) + kao(:, 3,12,10) = (/ & + & 0.76847e+01_r8,0.10169e+02_r8,0.11799e+02_r8,0.12768e+02_r8,0.13325e+02_r8, & + & 0.13529e+02_r8,0.13323e+02_r8,0.12442e+02_r8,0.10130e+02_r8 /) + kao(:, 4,12,10) = (/ & + & 0.76979e+01_r8,0.10072e+02_r8,0.11716e+02_r8,0.12735e+02_r8,0.13318e+02_r8, & + & 0.13569e+02_r8,0.13422e+02_r8,0.12581e+02_r8,0.10272e+02_r8 /) + kao(:, 5,12,10) = (/ & + & 0.78582e+01_r8,0.10030e+02_r8,0.11643e+02_r8,0.12707e+02_r8,0.13325e+02_r8, & + & 0.13613e+02_r8,0.13505e+02_r8,0.12682e+02_r8,0.10410e+02_r8 /) + kao(:, 1,13,10) = (/ & + & 0.68077e+01_r8,0.92695e+01_r8,0.10647e+02_r8,0.11513e+02_r8,0.12044e+02_r8, & + & 0.12269e+02_r8,0.12092e+02_r8,0.11295e+02_r8,0.85103e+01_r8 /) + kao(:, 2,13,10) = (/ & + & 0.67020e+01_r8,0.91675e+01_r8,0.10585e+02_r8,0.11489e+02_r8,0.12056e+02_r8, & + & 0.12329e+02_r8,0.12198e+02_r8,0.11449e+02_r8,0.87111e+01_r8 /) + kao(:, 3,13,10) = (/ & + & 0.67136e+01_r8,0.90765e+01_r8,0.10537e+02_r8,0.11473e+02_r8,0.12065e+02_r8, & + & 0.12379e+02_r8,0.12312e+02_r8,0.11602e+02_r8,0.88718e+01_r8 /) + kao(:, 4,13,10) = (/ & + & 0.68715e+01_r8,0.90508e+01_r8,0.10490e+02_r8,0.11454e+02_r8,0.12087e+02_r8, & + & 0.12433e+02_r8,0.12413e+02_r8,0.11728e+02_r8,0.90172e+01_r8 /) + kao(:, 5,13,10) = (/ & + & 0.71183e+01_r8,0.91466e+01_r8,0.10479e+02_r8,0.11436e+02_r8,0.12120e+02_r8, & + & 0.12489e+02_r8,0.12478e+02_r8,0.11826e+02_r8,0.91846e+01_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.25290e+02_r8,0.22378e+02_r8,0.19682e+02_r8,0.19092e+02_r8,0.18401e+02_r8, & + & 0.17330e+02_r8,0.17194e+02_r8,0.19513e+02_r8,0.21546e+02_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.25153e+02_r8,0.22251e+02_r8,0.19574e+02_r8,0.19002e+02_r8,0.18309e+02_r8, & + & 0.17346e+02_r8,0.17168e+02_r8,0.19469e+02_r8,0.21516e+02_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.24990e+02_r8,0.22108e+02_r8,0.19457e+02_r8,0.18891e+02_r8,0.18197e+02_r8, & + & 0.17344e+02_r8,0.17153e+02_r8,0.19435e+02_r8,0.21516e+02_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.24785e+02_r8,0.21926e+02_r8,0.19312e+02_r8,0.18774e+02_r8,0.18111e+02_r8, & + & 0.17300e+02_r8,0.17168e+02_r8,0.19426e+02_r8,0.21524e+02_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.24562e+02_r8,0.21729e+02_r8,0.19145e+02_r8,0.18657e+02_r8,0.18043e+02_r8, & + & 0.17239e+02_r8,0.17190e+02_r8,0.19400e+02_r8,0.21517e+02_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.26738e+02_r8,0.23635e+02_r8,0.21164e+02_r8,0.20882e+02_r8,0.20133e+02_r8, & + & 0.18952e+02_r8,0.18391e+02_r8,0.20397e+02_r8,0.22752e+02_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.26579e+02_r8,0.23493e+02_r8,0.21026e+02_r8,0.20770e+02_r8,0.20046e+02_r8, & + & 0.18924e+02_r8,0.18351e+02_r8,0.20302e+02_r8,0.22673e+02_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.26369e+02_r8,0.23304e+02_r8,0.20847e+02_r8,0.20634e+02_r8,0.19955e+02_r8, & + & 0.18867e+02_r8,0.18355e+02_r8,0.20274e+02_r8,0.22643e+02_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.26147e+02_r8,0.23108e+02_r8,0.20663e+02_r8,0.20491e+02_r8,0.19870e+02_r8, & + & 0.18790e+02_r8,0.18365e+02_r8,0.20271e+02_r8,0.22638e+02_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.25876e+02_r8,0.22867e+02_r8,0.20457e+02_r8,0.20308e+02_r8,0.19788e+02_r8, & + & 0.18723e+02_r8,0.18359e+02_r8,0.20242e+02_r8,0.22612e+02_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.27801e+02_r8,0.24558e+02_r8,0.22625e+02_r8,0.22456e+02_r8,0.21766e+02_r8, & + & 0.20723e+02_r8,0.19785e+02_r8,0.21193e+02_r8,0.23811e+02_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.27586e+02_r8,0.24366e+02_r8,0.22444e+02_r8,0.22341e+02_r8,0.21670e+02_r8, & + & 0.20651e+02_r8,0.19732e+02_r8,0.21163e+02_r8,0.23778e+02_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.27362e+02_r8,0.24166e+02_r8,0.22236e+02_r8,0.22200e+02_r8,0.21575e+02_r8, & + & 0.20557e+02_r8,0.19718e+02_r8,0.21155e+02_r8,0.23783e+02_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.27084e+02_r8,0.23919e+02_r8,0.22013e+02_r8,0.22018e+02_r8,0.21471e+02_r8, & + & 0.20457e+02_r8,0.19708e+02_r8,0.21136e+02_r8,0.23769e+02_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.26795e+02_r8,0.23666e+02_r8,0.21794e+02_r8,0.21827e+02_r8,0.21355e+02_r8, & + & 0.20374e+02_r8,0.19655e+02_r8,0.21092e+02_r8,0.23724e+02_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.28327e+02_r8,0.25026e+02_r8,0.23910e+02_r8,0.23720e+02_r8,0.23265e+02_r8, & + & 0.22396e+02_r8,0.21086e+02_r8,0.21859e+02_r8,0.24649e+02_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.28095e+02_r8,0.24816e+02_r8,0.23683e+02_r8,0.23594e+02_r8,0.23156e+02_r8, & + & 0.22304e+02_r8,0.21023e+02_r8,0.21873e+02_r8,0.24674e+02_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.27817e+02_r8,0.24569e+02_r8,0.23454e+02_r8,0.23446e+02_r8,0.23031e+02_r8, & + & 0.22182e+02_r8,0.21022e+02_r8,0.21878e+02_r8,0.24680e+02_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.27525e+02_r8,0.24310e+02_r8,0.23220e+02_r8,0.23268e+02_r8,0.22908e+02_r8, & + & 0.22090e+02_r8,0.21022e+02_r8,0.21824e+02_r8,0.24620e+02_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.27191e+02_r8,0.24023e+02_r8,0.22996e+02_r8,0.23072e+02_r8,0.22769e+02_r8, & + & 0.22022e+02_r8,0.20982e+02_r8,0.21737e+02_r8,0.24514e+02_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.28259e+02_r8,0.25014e+02_r8,0.24907e+02_r8,0.24706e+02_r8,0.24642e+02_r8, & + & 0.23918e+02_r8,0.22330e+02_r8,0.22219e+02_r8,0.25091e+02_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.27993e+02_r8,0.24771e+02_r8,0.24666e+02_r8,0.24596e+02_r8,0.24487e+02_r8, & + & 0.23818e+02_r8,0.22348e+02_r8,0.22269e+02_r8,0.25149e+02_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.27691e+02_r8,0.24499e+02_r8,0.24421e+02_r8,0.24432e+02_r8,0.24340e+02_r8, & + & 0.23705e+02_r8,0.22420e+02_r8,0.22242e+02_r8,0.25109e+02_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.27357e+02_r8,0.24214e+02_r8,0.24178e+02_r8,0.24253e+02_r8,0.24191e+02_r8, & + & 0.23642e+02_r8,0.22422e+02_r8,0.22174e+02_r8,0.25030e+02_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.27008e+02_r8,0.23916e+02_r8,0.23935e+02_r8,0.24063e+02_r8,0.24020e+02_r8, & + & 0.23572e+02_r8,0.22355e+02_r8,0.22132e+02_r8,0.24957e+02_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.27627e+02_r8,0.24841e+02_r8,0.25414e+02_r8,0.25513e+02_r8,0.25788e+02_r8, & + & 0.25161e+02_r8,0.23567e+02_r8,0.22384e+02_r8,0.25091e+02_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.27317e+02_r8,0.24550e+02_r8,0.25165e+02_r8,0.25384e+02_r8,0.25578e+02_r8, & + & 0.25083e+02_r8,0.23662e+02_r8,0.22423e+02_r8,0.25102e+02_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.26994e+02_r8,0.24259e+02_r8,0.24926e+02_r8,0.25206e+02_r8,0.25391e+02_r8, & + & 0.25015e+02_r8,0.23758e+02_r8,0.22363e+02_r8,0.25025e+02_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.26640e+02_r8,0.23945e+02_r8,0.24692e+02_r8,0.25002e+02_r8,0.25193e+02_r8, & + & 0.24973e+02_r8,0.23733e+02_r8,0.22328e+02_r8,0.24965e+02_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.26265e+02_r8,0.23625e+02_r8,0.24446e+02_r8,0.24785e+02_r8,0.25037e+02_r8, & + & 0.24906e+02_r8,0.23659e+02_r8,0.22352e+02_r8,0.24965e+02_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.26430e+02_r8,0.24581e+02_r8,0.25439e+02_r8,0.26140e+02_r8,0.26524e+02_r8, & + & 0.25974e+02_r8,0.24552e+02_r8,0.22441e+02_r8,0.24498e+02_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.26105e+02_r8,0.24263e+02_r8,0.25225e+02_r8,0.25974e+02_r8,0.26315e+02_r8, & + & 0.25946e+02_r8,0.24677e+02_r8,0.22471e+02_r8,0.24490e+02_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.25752e+02_r8,0.23938e+02_r8,0.24996e+02_r8,0.25749e+02_r8,0.26113e+02_r8, & + & 0.25925e+02_r8,0.24758e+02_r8,0.22442e+02_r8,0.24454e+02_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.25389e+02_r8,0.23609e+02_r8,0.24761e+02_r8,0.25499e+02_r8,0.25940e+02_r8, & + & 0.25913e+02_r8,0.24720e+02_r8,0.22473e+02_r8,0.24475e+02_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.25010e+02_r8,0.23260e+02_r8,0.24510e+02_r8,0.25262e+02_r8,0.25804e+02_r8, & + & 0.25811e+02_r8,0.24640e+02_r8,0.22547e+02_r8,0.24534e+02_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.24762e+02_r8,0.23997e+02_r8,0.25209e+02_r8,0.26467e+02_r8,0.26748e+02_r8, & + & 0.26365e+02_r8,0.25094e+02_r8,0.22357e+02_r8,0.23406e+02_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.24421e+02_r8,0.23672e+02_r8,0.24981e+02_r8,0.26217e+02_r8,0.26595e+02_r8, & + & 0.26375e+02_r8,0.25195e+02_r8,0.22435e+02_r8,0.23453e+02_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.24067e+02_r8,0.23336e+02_r8,0.24754e+02_r8,0.25956e+02_r8,0.26455e+02_r8, & + & 0.26361e+02_r8,0.25241e+02_r8,0.22458e+02_r8,0.23475e+02_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.23691e+02_r8,0.22996e+02_r8,0.24502e+02_r8,0.25698e+02_r8,0.26330e+02_r8, & + & 0.26343e+02_r8,0.25197e+02_r8,0.22533e+02_r8,0.23575e+02_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.23311e+02_r8,0.22660e+02_r8,0.24234e+02_r8,0.25450e+02_r8,0.26215e+02_r8, & + & 0.26209e+02_r8,0.25123e+02_r8,0.22642e+02_r8,0.23709e+02_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.22800e+02_r8,0.23011e+02_r8,0.24799e+02_r8,0.26181e+02_r8,0.26533e+02_r8, & + & 0.26301e+02_r8,0.25044e+02_r8,0.22077e+02_r8,0.21907e+02_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.22436e+02_r8,0.22697e+02_r8,0.24546e+02_r8,0.25945e+02_r8,0.26460e+02_r8, & + & 0.26314e+02_r8,0.25122e+02_r8,0.22204e+02_r8,0.22029e+02_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.22079e+02_r8,0.22367e+02_r8,0.24295e+02_r8,0.25706e+02_r8,0.26370e+02_r8, & + & 0.26288e+02_r8,0.25162e+02_r8,0.22314e+02_r8,0.22151e+02_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.21719e+02_r8,0.22029e+02_r8,0.24017e+02_r8,0.25487e+02_r8,0.26273e+02_r8, & + & 0.26217e+02_r8,0.25110e+02_r8,0.22435e+02_r8,0.22334e+02_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.21341e+02_r8,0.21707e+02_r8,0.23702e+02_r8,0.25282e+02_r8,0.26159e+02_r8, & + & 0.26086e+02_r8,0.25065e+02_r8,0.22578e+02_r8,0.22506e+02_r8 /) + kao(:, 1,10,11) = (/ & + & 0.20601e+02_r8,0.21678e+02_r8,0.24058e+02_r8,0.25352e+02_r8,0.25931e+02_r8, & + & 0.25718e+02_r8,0.24432e+02_r8,0.21607e+02_r8,0.20262e+02_r8 /) + kao(:, 2,10,11) = (/ & + & 0.20254e+02_r8,0.21345e+02_r8,0.23796e+02_r8,0.25183e+02_r8,0.25875e+02_r8, & + & 0.25691e+02_r8,0.24508e+02_r8,0.21774e+02_r8,0.20445e+02_r8 /) + kao(:, 3,10,11) = (/ & + & 0.19899e+02_r8,0.21048e+02_r8,0.23494e+02_r8,0.25000e+02_r8,0.25800e+02_r8, & + & 0.25662e+02_r8,0.24533e+02_r8,0.21922e+02_r8,0.20638e+02_r8 /) + kao(:, 4,10,11) = (/ & + & 0.19544e+02_r8,0.20766e+02_r8,0.23207e+02_r8,0.24826e+02_r8,0.25686e+02_r8, & + & 0.25593e+02_r8,0.24527e+02_r8,0.22085e+02_r8,0.20832e+02_r8 /) + kao(:, 5,10,11) = (/ & + & 0.19193e+02_r8,0.20470e+02_r8,0.22936e+02_r8,0.24673e+02_r8,0.25544e+02_r8, & + & 0.25480e+02_r8,0.24537e+02_r8,0.22218e+02_r8,0.21044e+02_r8 /) + kao(:, 1,11,11) = (/ & + & 0.18170e+02_r8,0.20155e+02_r8,0.22721e+02_r8,0.24145e+02_r8,0.24798e+02_r8, & + & 0.24559e+02_r8,0.23403e+02_r8,0.20895e+02_r8,0.18740e+02_r8 /) + kao(:, 2,11,11) = (/ & + & 0.17830e+02_r8,0.19860e+02_r8,0.22479e+02_r8,0.24018e+02_r8,0.24721e+02_r8, & + & 0.24556e+02_r8,0.23466e+02_r8,0.21069e+02_r8,0.18949e+02_r8 /) + kao(:, 3,11,11) = (/ & + & 0.17496e+02_r8,0.19576e+02_r8,0.22242e+02_r8,0.23886e+02_r8,0.24621e+02_r8, & + & 0.24529e+02_r8,0.23525e+02_r8,0.21231e+02_r8,0.19147e+02_r8 /) + kao(:, 4,11,11) = (/ & + & 0.17168e+02_r8,0.19292e+02_r8,0.22005e+02_r8,0.23734e+02_r8,0.24514e+02_r8, & + & 0.24476e+02_r8,0.23580e+02_r8,0.21376e+02_r8,0.19368e+02_r8 /) + kao(:, 5,11,11) = (/ & + & 0.16844e+02_r8,0.19013e+02_r8,0.21771e+02_r8,0.23570e+02_r8,0.24390e+02_r8, & + & 0.24440e+02_r8,0.23651e+02_r8,0.21517e+02_r8,0.19612e+02_r8 /) + kao(:, 1,12,11) = (/ & + & 0.15762e+02_r8,0.18615e+02_r8,0.21133e+02_r8,0.22639e+02_r8,0.23214e+02_r8, & + & 0.23022e+02_r8,0.22060e+02_r8,0.19958e+02_r8,0.17314e+02_r8 /) + kao(:, 2,12,11) = (/ & + & 0.15455e+02_r8,0.18341e+02_r8,0.20944e+02_r8,0.22510e+02_r8,0.23148e+02_r8, & + & 0.23042e+02_r8,0.22164e+02_r8,0.20127e+02_r8,0.17543e+02_r8 /) + kao(:, 3,12,11) = (/ & + & 0.15156e+02_r8,0.18068e+02_r8,0.20768e+02_r8,0.22374e+02_r8,0.23084e+02_r8, & + & 0.23060e+02_r8,0.22257e+02_r8,0.20275e+02_r8,0.17770e+02_r8 /) + kao(:, 4,12,11) = (/ & + & 0.14865e+02_r8,0.17794e+02_r8,0.20582e+02_r8,0.22237e+02_r8,0.23018e+02_r8, & + & 0.23079e+02_r8,0.22350e+02_r8,0.20427e+02_r8,0.18026e+02_r8 /) + kao(:, 5,12,11) = (/ & + & 0.14612e+02_r8,0.17534e+02_r8,0.20399e+02_r8,0.22086e+02_r8,0.22956e+02_r8, & + & 0.23112e+02_r8,0.22443e+02_r8,0.20607e+02_r8,0.18280e+02_r8 /) + kao(:, 1,13,11) = (/ & + & 0.13517e+02_r8,0.16914e+02_r8,0.19425e+02_r8,0.20790e+02_r8,0.21367e+02_r8, & + & 0.21315e+02_r8,0.20607e+02_r8,0.18871e+02_r8,0.15967e+02_r8 /) + kao(:, 2,13,11) = (/ & + & 0.13249e+02_r8,0.16688e+02_r8,0.19279e+02_r8,0.20693e+02_r8,0.21344e+02_r8, & + & 0.21372e+02_r8,0.20725e+02_r8,0.19043e+02_r8,0.16217e+02_r8 /) + kao(:, 3,13,11) = (/ & + & 0.12994e+02_r8,0.16467e+02_r8,0.19108e+02_r8,0.20602e+02_r8,0.21343e+02_r8, & + & 0.21436e+02_r8,0.20839e+02_r8,0.19212e+02_r8,0.16494e+02_r8 /) + kao(:, 4,13,11) = (/ & + & 0.12784e+02_r8,0.16250e+02_r8,0.18951e+02_r8,0.20506e+02_r8,0.21335e+02_r8, & + & 0.21503e+02_r8,0.20961e+02_r8,0.19415e+02_r8,0.16770e+02_r8 /) + kao(:, 5,13,11) = (/ & + & 0.12734e+02_r8,0.16049e+02_r8,0.18819e+02_r8,0.20438e+02_r8,0.21329e+02_r8, & + & 0.21573e+02_r8,0.21104e+02_r8,0.19623e+02_r8,0.16983e+02_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.32549e+02_r8,0.28774e+02_r8,0.25031e+02_r8,0.22926e+02_r8,0.22117e+02_r8, & + & 0.21695e+02_r8,0.23417e+02_r8,0.26761e+02_r8,0.29694e+02_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.32499e+02_r8,0.28739e+02_r8,0.25006e+02_r8,0.22835e+02_r8,0.22088e+02_r8, & + & 0.21560e+02_r8,0.23253e+02_r8,0.26542e+02_r8,0.29377e+02_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.32407e+02_r8,0.28660e+02_r8,0.24923e+02_r8,0.22714e+02_r8,0.22014e+02_r8, & + & 0.21461e+02_r8,0.23148e+02_r8,0.26398e+02_r8,0.29117e+02_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.32260e+02_r8,0.28512e+02_r8,0.24788e+02_r8,0.22590e+02_r8,0.21881e+02_r8, & + & 0.21430e+02_r8,0.23071e+02_r8,0.26295e+02_r8,0.28961e+02_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.32039e+02_r8,0.28307e+02_r8,0.24614e+02_r8,0.22444e+02_r8,0.21715e+02_r8, & + & 0.21428e+02_r8,0.22979e+02_r8,0.26201e+02_r8,0.28821e+02_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.35951e+02_r8,0.31737e+02_r8,0.27558e+02_r8,0.25749e+02_r8,0.24746e+02_r8, & + & 0.23905e+02_r8,0.24887e+02_r8,0.28459e+02_r8,0.31791e+02_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.35862e+02_r8,0.31672e+02_r8,0.27501e+02_r8,0.25642e+02_r8,0.24725e+02_r8, & + & 0.23810e+02_r8,0.24734e+02_r8,0.28277e+02_r8,0.31526e+02_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.35737e+02_r8,0.31562e+02_r8,0.27401e+02_r8,0.25522e+02_r8,0.24641e+02_r8, & + & 0.23751e+02_r8,0.24591e+02_r8,0.28127e+02_r8,0.31321e+02_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.35534e+02_r8,0.31380e+02_r8,0.27248e+02_r8,0.25379e+02_r8,0.24498e+02_r8, & + & 0.23724e+02_r8,0.24485e+02_r8,0.28006e+02_r8,0.31168e+02_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.35285e+02_r8,0.31161e+02_r8,0.27065e+02_r8,0.25222e+02_r8,0.24328e+02_r8, & + & 0.23689e+02_r8,0.24406e+02_r8,0.27908e+02_r8,0.31060e+02_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.39089e+02_r8,0.34457e+02_r8,0.30041e+02_r8,0.28724e+02_r8,0.27574e+02_r8, & + & 0.26213e+02_r8,0.26498e+02_r8,0.30215e+02_r8,0.33960e+02_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.38998e+02_r8,0.34382e+02_r8,0.29952e+02_r8,0.28581e+02_r8,0.27562e+02_r8, & + & 0.26150e+02_r8,0.26309e+02_r8,0.29980e+02_r8,0.33662e+02_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.38820e+02_r8,0.34217e+02_r8,0.29804e+02_r8,0.28424e+02_r8,0.27473e+02_r8, & + & 0.26126e+02_r8,0.26176e+02_r8,0.29817e+02_r8,0.33458e+02_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.38594e+02_r8,0.34019e+02_r8,0.29631e+02_r8,0.28264e+02_r8,0.27343e+02_r8, & + & 0.26103e+02_r8,0.26063e+02_r8,0.29657e+02_r8,0.33303e+02_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.38290e+02_r8,0.33755e+02_r8,0.29411e+02_r8,0.28094e+02_r8,0.27189e+02_r8, & + & 0.26048e+02_r8,0.25993e+02_r8,0.29534e+02_r8,0.33212e+02_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.41846e+02_r8,0.36848e+02_r8,0.32642e+02_r8,0.31752e+02_r8,0.30348e+02_r8, & + & 0.28783e+02_r8,0.28429e+02_r8,0.31940e+02_r8,0.36003e+02_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.41706e+02_r8,0.36722e+02_r8,0.32481e+02_r8,0.31589e+02_r8,0.30346e+02_r8, & + & 0.28731e+02_r8,0.28275e+02_r8,0.31704e+02_r8,0.35716e+02_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.41502e+02_r8,0.36539e+02_r8,0.32269e+02_r8,0.31417e+02_r8,0.30279e+02_r8, & + & 0.28696e+02_r8,0.28151e+02_r8,0.31470e+02_r8,0.35494e+02_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.41217e+02_r8,0.36286e+02_r8,0.32033e+02_r8,0.31226e+02_r8,0.30155e+02_r8, & + & 0.28647e+02_r8,0.28039e+02_r8,0.31307e+02_r8,0.35368e+02_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.40876e+02_r8,0.35985e+02_r8,0.31743e+02_r8,0.31019e+02_r8,0.30013e+02_r8, & + & 0.28553e+02_r8,0.27986e+02_r8,0.31205e+02_r8,0.35294e+02_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.43995e+02_r8,0.38706e+02_r8,0.35200e+02_r8,0.34595e+02_r8,0.33005e+02_r8, & + & 0.31594e+02_r8,0.30727e+02_r8,0.33547e+02_r8,0.37840e+02_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.43792e+02_r8,0.38521e+02_r8,0.34965e+02_r8,0.34413e+02_r8,0.33017e+02_r8, & + & 0.31523e+02_r8,0.30579e+02_r8,0.33292e+02_r8,0.37593e+02_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.43530e+02_r8,0.38288e+02_r8,0.34710e+02_r8,0.34215e+02_r8,0.32953e+02_r8, & + & 0.31452e+02_r8,0.30422e+02_r8,0.33082e+02_r8,0.37437e+02_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.43192e+02_r8,0.37991e+02_r8,0.34400e+02_r8,0.33987e+02_r8,0.32832e+02_r8, & + & 0.31362e+02_r8,0.30341e+02_r8,0.32970e+02_r8,0.37357e+02_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.42817e+02_r8,0.37661e+02_r8,0.34079e+02_r8,0.33725e+02_r8,0.32688e+02_r8, & + & 0.31220e+02_r8,0.30292e+02_r8,0.32861e+02_r8,0.37270e+02_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.45371e+02_r8,0.39886e+02_r8,0.37563e+02_r8,0.36985e+02_r8,0.35582e+02_r8, & + & 0.34395e+02_r8,0.32997e+02_r8,0.34724e+02_r8,0.39202e+02_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.45116e+02_r8,0.39656e+02_r8,0.37269e+02_r8,0.36794e+02_r8,0.35596e+02_r8, & + & 0.34289e+02_r8,0.32827e+02_r8,0.34552e+02_r8,0.39098e+02_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.44794e+02_r8,0.39373e+02_r8,0.36959e+02_r8,0.36575e+02_r8,0.35485e+02_r8, & + & 0.34189e+02_r8,0.32665e+02_r8,0.34424e+02_r8,0.39024e+02_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.44425e+02_r8,0.39049e+02_r8,0.36596e+02_r8,0.36352e+02_r8,0.35337e+02_r8, & + & 0.34032e+02_r8,0.32591e+02_r8,0.34348e+02_r8,0.38980e+02_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.43987e+02_r8,0.38666e+02_r8,0.36218e+02_r8,0.36087e+02_r8,0.35122e+02_r8, & + & 0.33853e+02_r8,0.32536e+02_r8,0.34232e+02_r8,0.38883e+02_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.45829e+02_r8,0.40296e+02_r8,0.39507e+02_r8,0.38911e+02_r8,0.38052e+02_r8, & + & 0.37051e+02_r8,0.34926e+02_r8,0.35286e+02_r8,0.39874e+02_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.45523e+02_r8,0.40015e+02_r8,0.39164e+02_r8,0.38712e+02_r8,0.37995e+02_r8, & + & 0.36879e+02_r8,0.34780e+02_r8,0.35237e+02_r8,0.39916e+02_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.45143e+02_r8,0.39672e+02_r8,0.38788e+02_r8,0.38484e+02_r8,0.37843e+02_r8, & + & 0.36693e+02_r8,0.34674e+02_r8,0.35202e+02_r8,0.39935e+02_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.44711e+02_r8,0.39294e+02_r8,0.38380e+02_r8,0.38261e+02_r8,0.37608e+02_r8, & + & 0.36475e+02_r8,0.34639e+02_r8,0.35181e+02_r8,0.39952e+02_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.44229e+02_r8,0.38875e+02_r8,0.37956e+02_r8,0.37973e+02_r8,0.37347e+02_r8, & + & 0.36293e+02_r8,0.34620e+02_r8,0.35062e+02_r8,0.39846e+02_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.45335e+02_r8,0.40267e+02_r8,0.40744e+02_r8,0.40443e+02_r8,0.40247e+02_r8, & + & 0.39223e+02_r8,0.36584e+02_r8,0.35367e+02_r8,0.39844e+02_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.44955e+02_r8,0.39893e+02_r8,0.40398e+02_r8,0.40216e+02_r8,0.40115e+02_r8, & + & 0.39023e+02_r8,0.36582e+02_r8,0.35440e+02_r8,0.40008e+02_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.44529e+02_r8,0.39492e+02_r8,0.39985e+02_r8,0.39979e+02_r8,0.39873e+02_r8, & + & 0.38831e+02_r8,0.36587e+02_r8,0.35498e+02_r8,0.40121e+02_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.44061e+02_r8,0.39061e+02_r8,0.39564e+02_r8,0.39715e+02_r8,0.39565e+02_r8, & + & 0.38623e+02_r8,0.36619e+02_r8,0.35513e+02_r8,0.40138e+02_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.43543e+02_r8,0.38605e+02_r8,0.39136e+02_r8,0.39437e+02_r8,0.39265e+02_r8, & + & 0.38474e+02_r8,0.36637e+02_r8,0.35396e+02_r8,0.40011e+02_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.43909e+02_r8,0.39954e+02_r8,0.41167e+02_r8,0.41626e+02_r8,0.41945e+02_r8, & + & 0.40736e+02_r8,0.38077e+02_r8,0.35393e+02_r8,0.39221e+02_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.43480e+02_r8,0.39498e+02_r8,0.40786e+02_r8,0.41338e+02_r8,0.41733e+02_r8, & + & 0.40609e+02_r8,0.38181e+02_r8,0.35523e+02_r8,0.39397e+02_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.43002e+02_r8,0.39038e+02_r8,0.40373e+02_r8,0.41094e+02_r8,0.41410e+02_r8, & + & 0.40471e+02_r8,0.38255e+02_r8,0.35563e+02_r8,0.39462e+02_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.42479e+02_r8,0.38560e+02_r8,0.39995e+02_r8,0.40806e+02_r8,0.41101e+02_r8, & + & 0.40341e+02_r8,0.38344e+02_r8,0.35573e+02_r8,0.39457e+02_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.41942e+02_r8,0.38060e+02_r8,0.39621e+02_r8,0.40473e+02_r8,0.40785e+02_r8, & + & 0.40226e+02_r8,0.38369e+02_r8,0.35494e+02_r8,0.39400e+02_r8 /) + kao(:, 1,10,12) = (/ & + & 0.41598e+02_r8,0.39277e+02_r8,0.40964e+02_r8,0.42358e+02_r8,0.42727e+02_r8, & + & 0.41605e+02_r8,0.39147e+02_r8,0.35243e+02_r8,0.37755e+02_r8 /) + kao(:, 2,10,12) = (/ & + & 0.41110e+02_r8,0.38804e+02_r8,0.40573e+02_r8,0.42061e+02_r8,0.42547e+02_r8, & + & 0.41580e+02_r8,0.39298e+02_r8,0.35367e+02_r8,0.37893e+02_r8 /) + kao(:, 3,10,12) = (/ & + & 0.40607e+02_r8,0.38301e+02_r8,0.40218e+02_r8,0.41774e+02_r8,0.42273e+02_r8, & + & 0.41520e+02_r8,0.39406e+02_r8,0.35478e+02_r8,0.38009e+02_r8 /) + kao(:, 4,10,12) = (/ & + & 0.40087e+02_r8,0.37793e+02_r8,0.39835e+02_r8,0.41418e+02_r8,0.42009e+02_r8, & + & 0.41467e+02_r8,0.39471e+02_r8,0.35532e+02_r8,0.38110e+02_r8 /) + kao(:, 5,10,12) = (/ & + & 0.39528e+02_r8,0.37276e+02_r8,0.39445e+02_r8,0.41009e+02_r8,0.41755e+02_r8, & + & 0.41409e+02_r8,0.39460e+02_r8,0.35536e+02_r8,0.38153e+02_r8 /) + kao(:, 1,11,12) = (/ & + & 0.38423e+02_r8,0.37785e+02_r8,0.40246e+02_r8,0.42229e+02_r8,0.42700e+02_r8, & + & 0.41861e+02_r8,0.39594e+02_r8,0.34991e+02_r8,0.35642e+02_r8 /) + kao(:, 2,11,12) = (/ & + & 0.37903e+02_r8,0.37296e+02_r8,0.39841e+02_r8,0.41927e+02_r8,0.42539e+02_r8, & + & 0.41882e+02_r8,0.39751e+02_r8,0.35170e+02_r8,0.35883e+02_r8 /) + kao(:, 3,11,12) = (/ & + & 0.37383e+02_r8,0.36809e+02_r8,0.39442e+02_r8,0.41575e+02_r8,0.42342e+02_r8, & + & 0.41911e+02_r8,0.39809e+02_r8,0.35335e+02_r8,0.36101e+02_r8 /) + kao(:, 4,11,12) = (/ & + & 0.36841e+02_r8,0.36301e+02_r8,0.39055e+02_r8,0.41199e+02_r8,0.42145e+02_r8, & + & 0.41876e+02_r8,0.39854e+02_r8,0.35442e+02_r8,0.36276e+02_r8 /) + kao(:, 5,11,12) = (/ & + & 0.36274e+02_r8,0.35783e+02_r8,0.38676e+02_r8,0.40833e+02_r8,0.41945e+02_r8, & + & 0.41808e+02_r8,0.39839e+02_r8,0.35539e+02_r8,0.36455e+02_r8 /) + kao(:, 1,12,12) = (/ & + & 0.34828e+02_r8,0.35770e+02_r8,0.39099e+02_r8,0.41221e+02_r8,0.41958e+02_r8, & + & 0.41456e+02_r8,0.39253e+02_r8,0.34461e+02_r8,0.33246e+02_r8 /) + kao(:, 2,12,12) = (/ & + & 0.34304e+02_r8,0.35295e+02_r8,0.38700e+02_r8,0.40987e+02_r8,0.41846e+02_r8, & + & 0.41525e+02_r8,0.39359e+02_r8,0.34698e+02_r8,0.33560e+02_r8 /) + kao(:, 3,12,12) = (/ & + & 0.33784e+02_r8,0.34798e+02_r8,0.38311e+02_r8,0.40707e+02_r8,0.41743e+02_r8, & + & 0.41505e+02_r8,0.39465e+02_r8,0.34925e+02_r8,0.33882e+02_r8 /) + kao(:, 4,12,12) = (/ & + & 0.33241e+02_r8,0.34324e+02_r8,0.37917e+02_r8,0.40393e+02_r8,0.41632e+02_r8, & + & 0.41461e+02_r8,0.39554e+02_r8,0.35117e+02_r8,0.34172e+02_r8 /) + kao(:, 5,12,12) = (/ & + & 0.32710e+02_r8,0.33867e+02_r8,0.37489e+02_r8,0.40112e+02_r8,0.41490e+02_r8, & + & 0.41392e+02_r8,0.39590e+02_r8,0.35312e+02_r8,0.34501e+02_r8 /) + kao(:, 1,13,12) = (/ & + & 0.30997e+02_r8,0.33431e+02_r8,0.37385e+02_r8,0.39653e+02_r8,0.40610e+02_r8, & + & 0.40222e+02_r8,0.38101e+02_r8,0.33638e+02_r8,0.30845e+02_r8 /) + kao(:, 2,13,12) = (/ & + & 0.30492e+02_r8,0.32952e+02_r8,0.37042e+02_r8,0.39451e+02_r8,0.40583e+02_r8, & + & 0.40257e+02_r8,0.38272e+02_r8,0.33940e+02_r8,0.31245e+02_r8 /) + kao(:, 3,13,12) = (/ & + & 0.29985e+02_r8,0.32520e+02_r8,0.36699e+02_r8,0.39235e+02_r8,0.40521e+02_r8, & + & 0.40274e+02_r8,0.38447e+02_r8,0.34242e+02_r8,0.31622e+02_r8 /) + kao(:, 4,13,12) = (/ & + & 0.29485e+02_r8,0.32102e+02_r8,0.36327e+02_r8,0.39047e+02_r8,0.40416e+02_r8, & + & 0.40299e+02_r8,0.38596e+02_r8,0.34522e+02_r8,0.32000e+02_r8 /) + kao(:, 5,13,12) = (/ & + & 0.29016e+02_r8,0.31685e+02_r8,0.35962e+02_r8,0.38852e+02_r8,0.40311e+02_r8, & + & 0.40331e+02_r8,0.38749e+02_r8,0.34802e+02_r8,0.32433e+02_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.40414e+02_r8,0.35530e+02_r8,0.30727e+02_r8,0.26813e+02_r8,0.26498e+02_r8, & + & 0.27724e+02_r8,0.32451e+02_r8,0.37296e+02_r8,0.40920e+02_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.40378e+02_r8,0.35506e+02_r8,0.30718e+02_r8,0.26787e+02_r8,0.26360e+02_r8, & + & 0.27557e+02_r8,0.32109e+02_r8,0.36904e+02_r8,0.40512e+02_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.40288e+02_r8,0.35435e+02_r8,0.30689e+02_r8,0.26758e+02_r8,0.26294e+02_r8, & + & 0.27365e+02_r8,0.31721e+02_r8,0.36448e+02_r8,0.40077e+02_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.40152e+02_r8,0.35337e+02_r8,0.30607e+02_r8,0.26666e+02_r8,0.26235e+02_r8, & + & 0.27137e+02_r8,0.31350e+02_r8,0.36026e+02_r8,0.39605e+02_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.39996e+02_r8,0.35209e+02_r8,0.30500e+02_r8,0.26544e+02_r8,0.26176e+02_r8, & + & 0.26906e+02_r8,0.31054e+02_r8,0.35676e+02_r8,0.39227e+02_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.46201e+02_r8,0.40631e+02_r8,0.35149e+02_r8,0.31004e+02_r8,0.30338e+02_r8, & + & 0.30975e+02_r8,0.35648e+02_r8,0.41032e+02_r8,0.45728e+02_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.46189e+02_r8,0.40616e+02_r8,0.35151e+02_r8,0.30920e+02_r8,0.30181e+02_r8, & + & 0.30854e+02_r8,0.35321e+02_r8,0.40601e+02_r8,0.45258e+02_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.46107e+02_r8,0.40548e+02_r8,0.35109e+02_r8,0.30814e+02_r8,0.30060e+02_r8, & + & 0.30665e+02_r8,0.34964e+02_r8,0.40159e+02_r8,0.44756e+02_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.45964e+02_r8,0.40421e+02_r8,0.35002e+02_r8,0.30664e+02_r8,0.29967e+02_r8, & + & 0.30436e+02_r8,0.34636e+02_r8,0.39757e+02_r8,0.44299e+02_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.45779e+02_r8,0.40257e+02_r8,0.34861e+02_r8,0.30500e+02_r8,0.29866e+02_r8, & + & 0.30215e+02_r8,0.34343e+02_r8,0.39421e+02_r8,0.43898e+02_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.52493e+02_r8,0.46184e+02_r8,0.39933e+02_r8,0.35707e+02_r8,0.34547e+02_r8, & + & 0.34524e+02_r8,0.38680e+02_r8,0.44581e+02_r8,0.50362e+02_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.52499e+02_r8,0.46190e+02_r8,0.39958e+02_r8,0.35613e+02_r8,0.34342e+02_r8, & + & 0.34438e+02_r8,0.38422e+02_r8,0.44213e+02_r8,0.49916e+02_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.52430e+02_r8,0.46141e+02_r8,0.39924e+02_r8,0.35477e+02_r8,0.34202e+02_r8, & + & 0.34294e+02_r8,0.38128e+02_r8,0.43804e+02_r8,0.49438e+02_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.52296e+02_r8,0.46021e+02_r8,0.39821e+02_r8,0.35288e+02_r8,0.34063e+02_r8, & + & 0.34077e+02_r8,0.37857e+02_r8,0.43466e+02_r8,0.49020e+02_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.52087e+02_r8,0.45828e+02_r8,0.39654e+02_r8,0.35060e+02_r8,0.33889e+02_r8, & + & 0.33876e+02_r8,0.37613e+02_r8,0.43182e+02_r8,0.48640e+02_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.58998e+02_r8,0.51894e+02_r8,0.44809e+02_r8,0.40767e+02_r8,0.39196e+02_r8, & + & 0.38349e+02_r8,0.41490e+02_r8,0.47820e+02_r8,0.54353e+02_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.58998e+02_r8,0.51911e+02_r8,0.44850e+02_r8,0.40692e+02_r8,0.38973e+02_r8, & + & 0.38281e+02_r8,0.41275e+02_r8,0.47479e+02_r8,0.53941e+02_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.58946e+02_r8,0.51872e+02_r8,0.44826e+02_r8,0.40545e+02_r8,0.38818e+02_r8, & + & 0.38152e+02_r8,0.41007e+02_r8,0.47151e+02_r8,0.53507e+02_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.58797e+02_r8,0.51741e+02_r8,0.44719e+02_r8,0.40328e+02_r8,0.38647e+02_r8, & + & 0.37950e+02_r8,0.40768e+02_r8,0.46871e+02_r8,0.53108e+02_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.58578e+02_r8,0.51549e+02_r8,0.44555e+02_r8,0.40074e+02_r8,0.38419e+02_r8, & + & 0.37769e+02_r8,0.40542e+02_r8,0.46625e+02_r8,0.52790e+02_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.65454e+02_r8,0.57537e+02_r8,0.49631e+02_r8,0.46171e+02_r8,0.44093e+02_r8, & + & 0.42375e+02_r8,0.44216e+02_r8,0.50929e+02_r8,0.58021e+02_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.65480e+02_r8,0.57591e+02_r8,0.49679e+02_r8,0.46047e+02_r8,0.43916e+02_r8, & + & 0.42317e+02_r8,0.44023e+02_r8,0.50643e+02_r8,0.57621e+02_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.65404e+02_r8,0.57534e+02_r8,0.49633e+02_r8,0.45875e+02_r8,0.43765e+02_r8, & + & 0.42200e+02_r8,0.43791e+02_r8,0.50364e+02_r8,0.57215e+02_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.65236e+02_r8,0.57393e+02_r8,0.49518e+02_r8,0.45648e+02_r8,0.43596e+02_r8, & + & 0.42013e+02_r8,0.43533e+02_r8,0.50076e+02_r8,0.56838e+02_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.64960e+02_r8,0.57155e+02_r8,0.49326e+02_r8,0.45390e+02_r8,0.43392e+02_r8, & + & 0.41855e+02_r8,0.43285e+02_r8,0.49832e+02_r8,0.56537e+02_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.71553e+02_r8,0.62830e+02_r8,0.54580e+02_r8,0.51897e+02_r8,0.49249e+02_r8, & + & 0.46670e+02_r8,0.47221e+02_r8,0.54164e+02_r8,0.61741e+02_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.71559e+02_r8,0.62858e+02_r8,0.54547e+02_r8,0.51727e+02_r8,0.49114e+02_r8, & + & 0.46626e+02_r8,0.47093e+02_r8,0.53907e+02_r8,0.61336e+02_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.71474e+02_r8,0.62796e+02_r8,0.54422e+02_r8,0.51491e+02_r8,0.49001e+02_r8, & + & 0.46518e+02_r8,0.46873e+02_r8,0.53599e+02_r8,0.60908e+02_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.71253e+02_r8,0.62620e+02_r8,0.54248e+02_r8,0.51208e+02_r8,0.48873e+02_r8, & + & 0.46377e+02_r8,0.46595e+02_r8,0.53243e+02_r8,0.60469e+02_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.70931e+02_r8,0.62354e+02_r8,0.53993e+02_r8,0.50888e+02_r8,0.48719e+02_r8, & + & 0.46222e+02_r8,0.46318e+02_r8,0.52946e+02_r8,0.60113e+02_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.76995e+02_r8,0.67566e+02_r8,0.59542e+02_r8,0.57607e+02_r8,0.54461e+02_r8, & + & 0.51316e+02_r8,0.50984e+02_r8,0.57643e+02_r8,0.65674e+02_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.76958e+02_r8,0.67548e+02_r8,0.59397e+02_r8,0.57376e+02_r8,0.54369e+02_r8, & + & 0.51326e+02_r8,0.50889e+02_r8,0.57330e+02_r8,0.65196e+02_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.76815e+02_r8,0.67433e+02_r8,0.59207e+02_r8,0.57127e+02_r8,0.54289e+02_r8, & + & 0.51287e+02_r8,0.50622e+02_r8,0.56904e+02_r8,0.64662e+02_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.76535e+02_r8,0.67198e+02_r8,0.58948e+02_r8,0.56779e+02_r8,0.54224e+02_r8, & + & 0.51158e+02_r8,0.50286e+02_r8,0.56459e+02_r8,0.64124e+02_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.76156e+02_r8,0.66876e+02_r8,0.58634e+02_r8,0.56401e+02_r8,0.54096e+02_r8, & + & 0.50976e+02_r8,0.49973e+02_r8,0.56129e+02_r8,0.63785e+02_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.81421e+02_r8,0.71418e+02_r8,0.64455e+02_r8,0.62977e+02_r8,0.59643e+02_r8, & + & 0.56434e+02_r8,0.55164e+02_r8,0.60758e+02_r8,0.69127e+02_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.81348e+02_r8,0.71366e+02_r8,0.64215e+02_r8,0.62779e+02_r8,0.59582e+02_r8, & + & 0.56462e+02_r8,0.55001e+02_r8,0.60346e+02_r8,0.68584e+02_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.81121e+02_r8,0.71177e+02_r8,0.63909e+02_r8,0.62467e+02_r8,0.59508e+02_r8, & + & 0.56437e+02_r8,0.54668e+02_r8,0.59898e+02_r8,0.68043e+02_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.80795e+02_r8,0.70901e+02_r8,0.63558e+02_r8,0.62070e+02_r8,0.59450e+02_r8, & + & 0.56283e+02_r8,0.54317e+02_r8,0.59470e+02_r8,0.67583e+02_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.80315e+02_r8,0.70489e+02_r8,0.63126e+02_r8,0.61649e+02_r8,0.59298e+02_r8, & + & 0.56050e+02_r8,0.54007e+02_r8,0.59179e+02_r8,0.67330e+02_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.84526e+02_r8,0.74114e+02_r8,0.69139e+02_r8,0.67766e+02_r8,0.64700e+02_r8, & + & 0.61791e+02_r8,0.59295e+02_r8,0.62885e+02_r8,0.71468e+02_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.84370e+02_r8,0.73989e+02_r8,0.68856e+02_r8,0.67565e+02_r8,0.64593e+02_r8, & + & 0.61811e+02_r8,0.59181e+02_r8,0.62666e+02_r8,0.71181e+02_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.84053e+02_r8,0.73721e+02_r8,0.68457e+02_r8,0.67233e+02_r8,0.64524e+02_r8, & + & 0.61778e+02_r8,0.58870e+02_r8,0.62384e+02_r8,0.70849e+02_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.83638e+02_r8,0.73367e+02_r8,0.67980e+02_r8,0.66820e+02_r8,0.64408e+02_r8, & + & 0.61582e+02_r8,0.58561e+02_r8,0.62049e+02_r8,0.70550e+02_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.83125e+02_r8,0.72897e+02_r8,0.67415e+02_r8,0.66418e+02_r8,0.64238e+02_r8, & + & 0.61304e+02_r8,0.58306e+02_r8,0.61805e+02_r8,0.70366e+02_r8 /) + kao(:, 1,10,13) = (/ & + & 0.86099e+02_r8,0.75664e+02_r8,0.73052e+02_r8,0.71784e+02_r8,0.69581e+02_r8, & + & 0.67013e+02_r8,0.63079e+02_r8,0.64019e+02_r8,0.72668e+02_r8 /) + kao(:, 2,10,13) = (/ & + & 0.85793e+02_r8,0.75364e+02_r8,0.72621e+02_r8,0.71506e+02_r8,0.69364e+02_r8, & + & 0.66992e+02_r8,0.63098e+02_r8,0.64105e+02_r8,0.72738e+02_r8 /) + kao(:, 3,10,13) = (/ & + & 0.85391e+02_r8,0.74983e+02_r8,0.72119e+02_r8,0.71136e+02_r8,0.69201e+02_r8, & + & 0.66897e+02_r8,0.62939e+02_r8,0.63964e+02_r8,0.72620e+02_r8 /) + kao(:, 4,10,13) = (/ & + & 0.84829e+02_r8,0.74472e+02_r8,0.71563e+02_r8,0.70768e+02_r8,0.69027e+02_r8, & + & 0.66600e+02_r8,0.62760e+02_r8,0.63750e+02_r8,0.72497e+02_r8 /) + kao(:, 5,10,13) = (/ & + & 0.84210e+02_r8,0.73923e+02_r8,0.70963e+02_r8,0.70409e+02_r8,0.68788e+02_r8, & + & 0.66285e+02_r8,0.62604e+02_r8,0.63643e+02_r8,0.72460e+02_r8 /) + kao(:, 1,11,13) = (/ & + & 0.85661e+02_r8,0.75976e+02_r8,0.75616e+02_r8,0.74895e+02_r8,0.73796e+02_r8, & + & 0.71450e+02_r8,0.66595e+02_r8,0.64723e+02_r8,0.72988e+02_r8 /) + kao(:, 2,11,13) = (/ & + & 0.85212e+02_r8,0.75487e+02_r8,0.75133e+02_r8,0.74528e+02_r8,0.73552e+02_r8, & + & 0.71413e+02_r8,0.66688e+02_r8,0.64835e+02_r8,0.73147e+02_r8 /) + kao(:, 3,11,13) = (/ & + & 0.84633e+02_r8,0.74907e+02_r8,0.74581e+02_r8,0.74183e+02_r8,0.73356e+02_r8, & + & 0.71194e+02_r8,0.66687e+02_r8,0.64831e+02_r8,0.73292e+02_r8 /) + kao(:, 4,11,13) = (/ & + & 0.83975e+02_r8,0.74286e+02_r8,0.73943e+02_r8,0.73830e+02_r8,0.73088e+02_r8, & + & 0.70916e+02_r8,0.66610e+02_r8,0.64920e+02_r8,0.73470e+02_r8 /) + kao(:, 5,11,13) = (/ & + & 0.83246e+02_r8,0.73605e+02_r8,0.73209e+02_r8,0.73386e+02_r8,0.72735e+02_r8, & + & 0.70587e+02_r8,0.66523e+02_r8,0.64950e+02_r8,0.73537e+02_r8 /) + kao(:, 1,12,13) = (/ & + & 0.83352e+02_r8,0.75282e+02_r8,0.76925e+02_r8,0.77365e+02_r8,0.77206e+02_r8, & + & 0.74850e+02_r8,0.69716e+02_r8,0.65048e+02_r8,0.72181e+02_r8 /) + kao(:, 2,12,13) = (/ & + & 0.82736e+02_r8,0.74597e+02_r8,0.76403e+02_r8,0.76949e+02_r8,0.76971e+02_r8, & + & 0.74863e+02_r8,0.69929e+02_r8,0.65330e+02_r8,0.72664e+02_r8 /) + kao(:, 3,12,13) = (/ & + & 0.82054e+02_r8,0.73916e+02_r8,0.75743e+02_r8,0.76528e+02_r8,0.76666e+02_r8, & + & 0.74738e+02_r8,0.70022e+02_r8,0.65629e+02_r8,0.73075e+02_r8 /) + kao(:, 4,12,13) = (/ & + & 0.81316e+02_r8,0.73173e+02_r8,0.75030e+02_r8,0.76061e+02_r8,0.76286e+02_r8, & + & 0.74512e+02_r8,0.70083e+02_r8,0.65825e+02_r8,0.73345e+02_r8 /) + kao(:, 5,12,13) = (/ & + & 0.80516e+02_r8,0.72378e+02_r8,0.74331e+02_r8,0.75554e+02_r8,0.75785e+02_r8, & + & 0.74233e+02_r8,0.70124e+02_r8,0.65929e+02_r8,0.73501e+02_r8 /) + kao(:, 1,13,13) = (/ & + & 0.79408e+02_r8,0.73858e+02_r8,0.76980e+02_r8,0.78869e+02_r8,0.79397e+02_r8, & + & 0.77263e+02_r8,0.72263e+02_r8,0.65338e+02_r8,0.70604e+02_r8 /) + kao(:, 2,13,13) = (/ & + & 0.78716e+02_r8,0.73093e+02_r8,0.76326e+02_r8,0.78426e+02_r8,0.79146e+02_r8, & + & 0.77408e+02_r8,0.72561e+02_r8,0.65807e+02_r8,0.71230e+02_r8 /) + kao(:, 3,13,13) = (/ & + & 0.77962e+02_r8,0.72251e+02_r8,0.75686e+02_r8,0.77926e+02_r8,0.78867e+02_r8, & + & 0.77356e+02_r8,0.72810e+02_r8,0.66137e+02_r8,0.71698e+02_r8 /) + kao(:, 4,13,13) = (/ & + & 0.77177e+02_r8,0.71385e+02_r8,0.75042e+02_r8,0.77408e+02_r8,0.78464e+02_r8, & + & 0.77172e+02_r8,0.73006e+02_r8,0.66333e+02_r8,0.72067e+02_r8 /) + kao(:, 5,13,13) = (/ & + & 0.76340e+02_r8,0.70519e+02_r8,0.74355e+02_r8,0.76889e+02_r8,0.78015e+02_r8, & + & 0.76988e+02_r8,0.73079e+02_r8,0.66485e+02_r8,0.72407e+02_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.51404e+02_r8,0.45212e+02_r8,0.39078e+02_r8,0.32978e+02_r8,0.31213e+02_r8, & + & 0.35689e+02_r8,0.42239e+02_r8,0.49109e+02_r8,0.53555e+02_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.51456e+02_r8,0.45263e+02_r8,0.39085e+02_r8,0.32975e+02_r8,0.31034e+02_r8, & + & 0.35237e+02_r8,0.41756e+02_r8,0.48531e+02_r8,0.52877e+02_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.51419e+02_r8,0.45226e+02_r8,0.39013e+02_r8,0.32932e+02_r8,0.30826e+02_r8, & + & 0.34871e+02_r8,0.41372e+02_r8,0.48070e+02_r8,0.52319e+02_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.51315e+02_r8,0.45122e+02_r8,0.38925e+02_r8,0.32886e+02_r8,0.30643e+02_r8, & + & 0.34565e+02_r8,0.41054e+02_r8,0.47690e+02_r8,0.51853e+02_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.51134e+02_r8,0.44958e+02_r8,0.38787e+02_r8,0.32819e+02_r8,0.30476e+02_r8, & + & 0.34330e+02_r8,0.40799e+02_r8,0.47384e+02_r8,0.51513e+02_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.59575e+02_r8,0.52343e+02_r8,0.45168e+02_r8,0.38156e+02_r8,0.36549e+02_r8, & + & 0.40798e+02_r8,0.48433e+02_r8,0.56320e+02_r8,0.62499e+02_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.59656e+02_r8,0.52415e+02_r8,0.45196e+02_r8,0.38159e+02_r8,0.36356e+02_r8, & + & 0.40232e+02_r8,0.47806e+02_r8,0.55603e+02_r8,0.61692e+02_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.59635e+02_r8,0.52395e+02_r8,0.45146e+02_r8,0.38116e+02_r8,0.36139e+02_r8, & + & 0.39805e+02_r8,0.47339e+02_r8,0.55046e+02_r8,0.61068e+02_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.59522e+02_r8,0.52285e+02_r8,0.45051e+02_r8,0.38066e+02_r8,0.35889e+02_r8, & + & 0.39470e+02_r8,0.46981e+02_r8,0.54621e+02_r8,0.60592e+02_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.59307e+02_r8,0.52094e+02_r8,0.44889e+02_r8,0.37960e+02_r8,0.35677e+02_r8, & + & 0.39216e+02_r8,0.46687e+02_r8,0.54268e+02_r8,0.60193e+02_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.68809e+02_r8,0.60397e+02_r8,0.52025e+02_r8,0.44161e+02_r8,0.42701e+02_r8, & + & 0.46667e+02_r8,0.55520e+02_r8,0.64493e+02_r8,0.72669e+02_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.68924e+02_r8,0.60499e+02_r8,0.52098e+02_r8,0.44133e+02_r8,0.42521e+02_r8, & + & 0.45966e+02_r8,0.54732e+02_r8,0.63594e+02_r8,0.71705e+02_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.68950e+02_r8,0.60531e+02_r8,0.52101e+02_r8,0.44100e+02_r8,0.42285e+02_r8, & + & 0.45418e+02_r8,0.54095e+02_r8,0.62883e+02_r8,0.70919e+02_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.68857e+02_r8,0.60434e+02_r8,0.52014e+02_r8,0.44041e+02_r8,0.42031e+02_r8, & + & 0.45005e+02_r8,0.53564e+02_r8,0.62291e+02_r8,0.70247e+02_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.68666e+02_r8,0.60265e+02_r8,0.51871e+02_r8,0.43942e+02_r8,0.41842e+02_r8, & + & 0.44690e+02_r8,0.53134e+02_r8,0.61806e+02_r8,0.69686e+02_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.79311e+02_r8,0.69561e+02_r8,0.59881e+02_r8,0.51276e+02_r8,0.49761e+02_r8, & + & 0.53193e+02_r8,0.63396e+02_r8,0.73656e+02_r8,0.83652e+02_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.79511e+02_r8,0.69736e+02_r8,0.60019e+02_r8,0.51173e+02_r8,0.49594e+02_r8, & + & 0.52466e+02_r8,0.62461e+02_r8,0.72578e+02_r8,0.82426e+02_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.79562e+02_r8,0.69789e+02_r8,0.60043e+02_r8,0.51075e+02_r8,0.49346e+02_r8, & + & 0.51847e+02_r8,0.61639e+02_r8,0.71632e+02_r8,0.81369e+02_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.79512e+02_r8,0.69733e+02_r8,0.59989e+02_r8,0.50979e+02_r8,0.49088e+02_r8, & + & 0.51360e+02_r8,0.60947e+02_r8,0.70836e+02_r8,0.80468e+02_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.79325e+02_r8,0.69569e+02_r8,0.59854e+02_r8,0.50871e+02_r8,0.48882e+02_r8, & + & 0.50991e+02_r8,0.60362e+02_r8,0.70161e+02_r8,0.79701e+02_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.91112e+02_r8,0.79892e+02_r8,0.68781e+02_r8,0.59496e+02_r8,0.57988e+02_r8, & + & 0.60415e+02_r8,0.71595e+02_r8,0.83227e+02_r8,0.94854e+02_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.91447e+02_r8,0.80173e+02_r8,0.69023e+02_r8,0.59416e+02_r8,0.57743e+02_r8, & + & 0.59673e+02_r8,0.70483e+02_r8,0.81942e+02_r8,0.93394e+02_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.91583e+02_r8,0.80288e+02_r8,0.69106e+02_r8,0.59276e+02_r8,0.57416e+02_r8, & + & 0.59035e+02_r8,0.69528e+02_r8,0.80829e+02_r8,0.92131e+02_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.91566e+02_r8,0.80257e+02_r8,0.69073e+02_r8,0.59136e+02_r8,0.57092e+02_r8, & + & 0.58527e+02_r8,0.68724e+02_r8,0.79885e+02_r8,0.91053e+02_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.91390e+02_r8,0.80104e+02_r8,0.68937e+02_r8,0.58973e+02_r8,0.56776e+02_r8, & + & 0.58107e+02_r8,0.68079e+02_r8,0.79072e+02_r8,0.90122e+02_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.10419e+03_r8,0.91394e+02_r8,0.78656e+02_r8,0.68916e+02_r8,0.67128e+02_r8, & + & 0.68461e+02_r8,0.79894e+02_r8,0.92926e+02_r8,0.10607e+03_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.10463e+03_r8,0.91782e+02_r8,0.79002e+02_r8,0.68819e+02_r8,0.66845e+02_r8, & + & 0.67738e+02_r8,0.78628e+02_r8,0.91458e+02_r8,0.10440e+03_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.10486e+03_r8,0.91970e+02_r8,0.79156e+02_r8,0.68698e+02_r8,0.66470e+02_r8, & + & 0.67066e+02_r8,0.77628e+02_r8,0.90242e+02_r8,0.10302e+03_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.10494e+03_r8,0.92025e+02_r8,0.79207e+02_r8,0.68555e+02_r8,0.66081e+02_r8, & + & 0.66543e+02_r8,0.76843e+02_r8,0.89253e+02_r8,0.10189e+03_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.10481e+03_r8,0.91892e+02_r8,0.79105e+02_r8,0.68344e+02_r8,0.65668e+02_r8, & + & 0.66109e+02_r8,0.76190e+02_r8,0.88386e+02_r8,0.10090e+03_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.11850e+03_r8,0.10394e+03_r8,0.89423e+02_r8,0.79509e+02_r8,0.77207e+02_r8, & + & 0.77196e+02_r8,0.87943e+02_r8,0.10236e+03_r8,0.11694e+03_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.11905e+03_r8,0.10443e+03_r8,0.89864e+02_r8,0.79528e+02_r8,0.76905e+02_r8, & + & 0.76494e+02_r8,0.86650e+02_r8,0.10078e+03_r8,0.11515e+03_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.11939e+03_r8,0.10473e+03_r8,0.90115e+02_r8,0.79401e+02_r8,0.76523e+02_r8, & + & 0.75853e+02_r8,0.85715e+02_r8,0.99595e+02_r8,0.11380e+03_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.11951e+03_r8,0.10484e+03_r8,0.90222e+02_r8,0.79220e+02_r8,0.76090e+02_r8, & + & 0.75405e+02_r8,0.85022e+02_r8,0.98653e+02_r8,0.11271e+03_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.11942e+03_r8,0.10476e+03_r8,0.90169e+02_r8,0.78976e+02_r8,0.75607e+02_r8, & + & 0.75018e+02_r8,0.84352e+02_r8,0.97783e+02_r8,0.11167e+03_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.13381e+03_r8,0.11735e+03_r8,0.10095e+03_r8,0.91226e+02_r8,0.88188e+02_r8, & + & 0.86379e+02_r8,0.95828e+02_r8,0.11155e+03_r8,0.12755e+03_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.13446e+03_r8,0.11794e+03_r8,0.10145e+03_r8,0.91271e+02_r8,0.87947e+02_r8, & + & 0.85766e+02_r8,0.94652e+02_r8,0.11006e+03_r8,0.12583e+03_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.13492e+03_r8,0.11834e+03_r8,0.10180e+03_r8,0.91233e+02_r8,0.87619e+02_r8, & + & 0.85228e+02_r8,0.93811e+02_r8,0.10892e+03_r8,0.12452e+03_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.13505e+03_r8,0.11846e+03_r8,0.10192e+03_r8,0.91090e+02_r8,0.87150e+02_r8, & + & 0.84887e+02_r8,0.93111e+02_r8,0.10797e+03_r8,0.12337e+03_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.13500e+03_r8,0.11844e+03_r8,0.10192e+03_r8,0.90797e+02_r8,0.86626e+02_r8, & + & 0.84570e+02_r8,0.92421e+02_r8,0.10710e+03_r8,0.12226e+03_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.14952e+03_r8,0.13110e+03_r8,0.11316e+03_r8,0.10410e+03_r8,0.99927e+02_r8, & + & 0.96074e+02_r8,0.10374e+03_r8,0.12067e+03_r8,0.13801e+03_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.15028e+03_r8,0.13179e+03_r8,0.11360e+03_r8,0.10415e+03_r8,0.99870e+02_r8, & + & 0.95589e+02_r8,0.10257e+03_r8,0.11912e+03_r8,0.13623e+03_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.15082e+03_r8,0.13227e+03_r8,0.11392e+03_r8,0.10405e+03_r8,0.99571e+02_r8, & + & 0.95189e+02_r8,0.10182e+03_r8,0.11803e+03_r8,0.13496e+03_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.15103e+03_r8,0.13247e+03_r8,0.11403e+03_r8,0.10385e+03_r8,0.99126e+02_r8, & + & 0.94980e+02_r8,0.10122e+03_r8,0.11720e+03_r8,0.13388e+03_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.15094e+03_r8,0.13245e+03_r8,0.11401e+03_r8,0.10348e+03_r8,0.98550e+02_r8, & + & 0.94746e+02_r8,0.10055e+03_r8,0.11636e+03_r8,0.13276e+03_r8 /) + kao(:, 1,10,14) = (/ & + & 0.16524e+03_r8,0.14486e+03_r8,0.12594e+03_r8,0.11785e+03_r8,0.11225e+03_r8, & + & 0.10654e+03_r8,0.11202e+03_r8,0.12965e+03_r8,0.14829e+03_r8 /) + kao(:, 2,10,14) = (/ & + & 0.16610e+03_r8,0.14564e+03_r8,0.12636e+03_r8,0.11787e+03_r8,0.11233e+03_r8, & + & 0.10630e+03_r8,0.11093e+03_r8,0.12811e+03_r8,0.14653e+03_r8 /) + kao(:, 3,10,14) = (/ & + & 0.16659e+03_r8,0.14608e+03_r8,0.12656e+03_r8,0.11769e+03_r8,0.11214e+03_r8, & + & 0.10609e+03_r8,0.11032e+03_r8,0.12713e+03_r8,0.14532e+03_r8 /) + kao(:, 4,10,14) = (/ & + & 0.16681e+03_r8,0.14630e+03_r8,0.12659e+03_r8,0.11736e+03_r8,0.11169e+03_r8, & + & 0.10597e+03_r8,0.10973e+03_r8,0.12629e+03_r8,0.14416e+03_r8 /) + kao(:, 5,10,14) = (/ & + & 0.16671e+03_r8,0.14623e+03_r8,0.12639e+03_r8,0.11688e+03_r8,0.11111e+03_r8, & + & 0.10576e+03_r8,0.10909e+03_r8,0.12542e+03_r8,0.14303e+03_r8 /) + kao(:, 1,11,14) = (/ & + & 0.18065e+03_r8,0.15832e+03_r8,0.13903e+03_r8,0.13201e+03_r8,0.12519e+03_r8, & + & 0.11820e+03_r8,0.12047e+03_r8,0.13760e+03_r8,0.15739e+03_r8 /) + kao(:, 2,11,14) = (/ & + & 0.18131e+03_r8,0.15893e+03_r8,0.13916e+03_r8,0.13183e+03_r8,0.12520e+03_r8, & + & 0.11800e+03_r8,0.11979e+03_r8,0.13660e+03_r8,0.15612e+03_r8 /) + kao(:, 3,11,14) = (/ & + & 0.18162e+03_r8,0.15925e+03_r8,0.13912e+03_r8,0.13145e+03_r8,0.12487e+03_r8, & + & 0.11789e+03_r8,0.11922e+03_r8,0.13566e+03_r8,0.15481e+03_r8 /) + kao(:, 4,11,14) = (/ & + & 0.18161e+03_r8,0.15927e+03_r8,0.13888e+03_r8,0.13091e+03_r8,0.12432e+03_r8, & + & 0.11770e+03_r8,0.11858e+03_r8,0.13462e+03_r8,0.15350e+03_r8 /) + kao(:, 5,11,14) = (/ & + & 0.18129e+03_r8,0.15901e+03_r8,0.13849e+03_r8,0.13027e+03_r8,0.12371e+03_r8, & + & 0.11738e+03_r8,0.11800e+03_r8,0.13378e+03_r8,0.15248e+03_r8 /) + kao(:, 1,12,14) = (/ & + & 0.19439e+03_r8,0.17031e+03_r8,0.15181e+03_r8,0.14577e+03_r8,0.13828e+03_r8, & + & 0.13070e+03_r8,0.12972e+03_r8,0.14546e+03_r8,0.16618e+03_r8 /) + kao(:, 2,12,14) = (/ & + & 0.19483e+03_r8,0.17073e+03_r8,0.15156e+03_r8,0.14543e+03_r8,0.13812e+03_r8, & + & 0.13043e+03_r8,0.12913e+03_r8,0.14443e+03_r8,0.16476e+03_r8 /) + kao(:, 3,12,14) = (/ & + & 0.19494e+03_r8,0.17087e+03_r8,0.15124e+03_r8,0.14493e+03_r8,0.13771e+03_r8, & + & 0.13020e+03_r8,0.12847e+03_r8,0.14330e+03_r8,0.16335e+03_r8 /) + kao(:, 4,12,14) = (/ & + & 0.19474e+03_r8,0.17073e+03_r8,0.15078e+03_r8,0.14425e+03_r8,0.13718e+03_r8, & + & 0.12986e+03_r8,0.12779e+03_r8,0.14240e+03_r8,0.16229e+03_r8 /) + kao(:, 5,12,14) = (/ & + & 0.19420e+03_r8,0.17029e+03_r8,0.15011e+03_r8,0.14337e+03_r8,0.13666e+03_r8, & + & 0.12942e+03_r8,0.12725e+03_r8,0.14171e+03_r8,0.16147e+03_r8 /) + kao(:, 1,13,14) = (/ & + & 0.20562e+03_r8,0.18014e+03_r8,0.16395e+03_r8,0.15885e+03_r8,0.15131e+03_r8, & + & 0.14344e+03_r8,0.13928e+03_r8,0.15201e+03_r8,0.17336e+03_r8 /) + kao(:, 2,13,14) = (/ & + & 0.20583e+03_r8,0.18034e+03_r8,0.16346e+03_r8,0.15844e+03_r8,0.15102e+03_r8, & + & 0.14310e+03_r8,0.13867e+03_r8,0.15101e+03_r8,0.17210e+03_r8 /) + kao(:, 3,13,14) = (/ & + & 0.20579e+03_r8,0.18034e+03_r8,0.16282e+03_r8,0.15782e+03_r8,0.15051e+03_r8, & + & 0.14271e+03_r8,0.13803e+03_r8,0.15026e+03_r8,0.17119e+03_r8 /) + kao(:, 4,13,14) = (/ & + & 0.20539e+03_r8,0.18002e+03_r8,0.16199e+03_r8,0.15696e+03_r8,0.15005e+03_r8, & + & 0.14226e+03_r8,0.13746e+03_r8,0.14977e+03_r8,0.17061e+03_r8 /) + kao(:, 5,13,14) = (/ & + & 0.20471e+03_r8,0.17946e+03_r8,0.16101e+03_r8,0.15580e+03_r8,0.14942e+03_r8, & + & 0.14163e+03_r8,0.13685e+03_r8,0.14922e+03_r8,0.16998e+03_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.61110e+02_r8,0.53539e+02_r8,0.46005e+02_r8,0.38902e+02_r8,0.35970e+02_r8, & + & 0.43986e+02_r8,0.52608e+02_r8,0.61157e+02_r8,0.65911e+02_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.61315e+02_r8,0.53717e+02_r8,0.46235e+02_r8,0.39083e+02_r8,0.35687e+02_r8, & + & 0.43381e+02_r8,0.51871e+02_r8,0.60290e+02_r8,0.64963e+02_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.61422e+02_r8,0.53821e+02_r8,0.46411e+02_r8,0.39188e+02_r8,0.35438e+02_r8, & + & 0.42839e+02_r8,0.51205e+02_r8,0.59514e+02_r8,0.64157e+02_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.61394e+02_r8,0.53877e+02_r8,0.46504e+02_r8,0.39222e+02_r8,0.35189e+02_r8, & + & 0.42365e+02_r8,0.50625e+02_r8,0.58813e+02_r8,0.63464e+02_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.61322e+02_r8,0.53865e+02_r8,0.46511e+02_r8,0.39177e+02_r8,0.34939e+02_r8, & + & 0.41926e+02_r8,0.50070e+02_r8,0.58152e+02_r8,0.62761e+02_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.73139e+02_r8,0.64054e+02_r8,0.54971e+02_r8,0.46172e+02_r8,0.42554e+02_r8, & + & 0.52369e+02_r8,0.62683e+02_r8,0.72904e+02_r8,0.80226e+02_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.73363e+02_r8,0.64250e+02_r8,0.55203e+02_r8,0.46423e+02_r8,0.42168e+02_r8, & + & 0.51668e+02_r8,0.61839e+02_r8,0.71917e+02_r8,0.79110e+02_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.73487e+02_r8,0.64383e+02_r8,0.55429e+02_r8,0.46632e+02_r8,0.41828e+02_r8, & + & 0.50986e+02_r8,0.61016e+02_r8,0.70950e+02_r8,0.78048e+02_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.73536e+02_r8,0.64501e+02_r8,0.55558e+02_r8,0.46729e+02_r8,0.41557e+02_r8, & + & 0.50314e+02_r8,0.60204e+02_r8,0.70005e+02_r8,0.77009e+02_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.73500e+02_r8,0.64509e+02_r8,0.55582e+02_r8,0.46709e+02_r8,0.41283e+02_r8, & + & 0.49695e+02_r8,0.59450e+02_r8,0.69119e+02_r8,0.76024e+02_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.87361e+02_r8,0.76491e+02_r8,0.65621e+02_r8,0.54890e+02_r8,0.50598e+02_r8, & + & 0.62297e+02_r8,0.74612e+02_r8,0.86825e+02_r8,0.97550e+02_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.87685e+02_r8,0.76774e+02_r8,0.65885e+02_r8,0.55188e+02_r8,0.50206e+02_r8, & + & 0.61585e+02_r8,0.73754e+02_r8,0.85807e+02_r8,0.96409e+02_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.87844e+02_r8,0.76919e+02_r8,0.66106e+02_r8,0.55413e+02_r8,0.49812e+02_r8, & + & 0.60785e+02_r8,0.72789e+02_r8,0.84689e+02_r8,0.95141e+02_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.87889e+02_r8,0.77037e+02_r8,0.66247e+02_r8,0.55541e+02_r8,0.49446e+02_r8, & + & 0.60010e+02_r8,0.71857e+02_r8,0.83593e+02_r8,0.93898e+02_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.87858e+02_r8,0.77051e+02_r8,0.66285e+02_r8,0.55583e+02_r8,0.49097e+02_r8, & + & 0.59241e+02_r8,0.70929e+02_r8,0.82513e+02_r8,0.92686e+02_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.10387e+03_r8,0.90929e+02_r8,0.77989e+02_r8,0.65095e+02_r8,0.60436e+02_r8, & + & 0.74039e+02_r8,0.88717e+02_r8,0.10327e+03_r8,0.11725e+03_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.10441e+03_r8,0.91405e+02_r8,0.78408e+02_r8,0.65545e+02_r8,0.59926e+02_r8, & + & 0.73070e+02_r8,0.87549e+02_r8,0.10190e+03_r8,0.11570e+03_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.10471e+03_r8,0.91680e+02_r8,0.78722e+02_r8,0.65845e+02_r8,0.59509e+02_r8, & + & 0.72264e+02_r8,0.86581e+02_r8,0.10076e+03_r8,0.11440e+03_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.10486e+03_r8,0.91873e+02_r8,0.78926e+02_r8,0.66032e+02_r8,0.59086e+02_r8, & + & 0.71381e+02_r8,0.85514e+02_r8,0.99526e+02_r8,0.11299e+03_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.10483e+03_r8,0.91879e+02_r8,0.78952e+02_r8,0.66063e+02_r8,0.58651e+02_r8, & + & 0.70432e+02_r8,0.84377e+02_r8,0.98185e+02_r8,0.11148e+03_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.12314e+03_r8,0.10778e+03_r8,0.92429e+02_r8,0.77074e+02_r8,0.72086e+02_r8, & + & 0.87688e+02_r8,0.10511e+03_r8,0.12238e+03_r8,0.13959e+03_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.12380e+03_r8,0.10836e+03_r8,0.92922e+02_r8,0.77571e+02_r8,0.71572e+02_r8, & + & 0.86586e+02_r8,0.10378e+03_r8,0.12082e+03_r8,0.13782e+03_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.12423e+03_r8,0.10877e+03_r8,0.93351e+02_r8,0.77983e+02_r8,0.71097e+02_r8, & + & 0.85507e+02_r8,0.10249e+03_r8,0.11931e+03_r8,0.13609e+03_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.12450e+03_r8,0.10905e+03_r8,0.93631e+02_r8,0.78238e+02_r8,0.70653e+02_r8, & + & 0.84488e+02_r8,0.10126e+03_r8,0.11788e+03_r8,0.13445e+03_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.12453e+03_r8,0.10910e+03_r8,0.93684e+02_r8,0.78289e+02_r8,0.70179e+02_r8, & + & 0.83403e+02_r8,0.99954e+02_r8,0.11636e+03_r8,0.13271e+03_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.14538e+03_r8,0.12724e+03_r8,0.10910e+03_r8,0.90962e+02_r8,0.85931e+02_r8, & + & 0.10354e+03_r8,0.12413e+03_r8,0.14456e+03_r8,0.16524e+03_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.14625e+03_r8,0.12800e+03_r8,0.10975e+03_r8,0.91547e+02_r8,0.85303e+02_r8, & + & 0.10223e+03_r8,0.12256e+03_r8,0.14271e+03_r8,0.16313e+03_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.14683e+03_r8,0.12855e+03_r8,0.11028e+03_r8,0.92053e+02_r8,0.84796e+02_r8, & + & 0.10095e+03_r8,0.12102e+03_r8,0.14092e+03_r8,0.16108e+03_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.14716e+03_r8,0.12887e+03_r8,0.11059e+03_r8,0.92330e+02_r8,0.84296e+02_r8, & + & 0.99657e+02_r8,0.11947e+03_r8,0.13910e+03_r8,0.15900e+03_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.14726e+03_r8,0.12897e+03_r8,0.11069e+03_r8,0.92414e+02_r8,0.83857e+02_r8, & + & 0.98384e+02_r8,0.11794e+03_r8,0.13732e+03_r8,0.15696e+03_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.17053e+03_r8,0.14925e+03_r8,0.12796e+03_r8,0.10716e+03_r8,0.10213e+03_r8, & + & 0.12188e+03_r8,0.14615e+03_r8,0.17020e+03_r8,0.19480e+03_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.17172e+03_r8,0.15029e+03_r8,0.12885e+03_r8,0.10758e+03_r8,0.10144e+03_r8, & + & 0.12029e+03_r8,0.14423e+03_r8,0.16798e+03_r8,0.19224e+03_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.17251e+03_r8,0.15103e+03_r8,0.12955e+03_r8,0.10811e+03_r8,0.10086e+03_r8, & + & 0.11869e+03_r8,0.14231e+03_r8,0.16572e+03_r8,0.18967e+03_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.17303e+03_r8,0.15150e+03_r8,0.12997e+03_r8,0.10845e+03_r8,0.10032e+03_r8, & + & 0.11701e+03_r8,0.14029e+03_r8,0.16338e+03_r8,0.18697e+03_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.17326e+03_r8,0.15170e+03_r8,0.13015e+03_r8,0.10860e+03_r8,0.99828e+02_r8, & + & 0.11540e+03_r8,0.13837e+03_r8,0.16114e+03_r8,0.18440e+03_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.19897e+03_r8,0.17412e+03_r8,0.14927e+03_r8,0.12609e+03_r8,0.12102e+03_r8, & + & 0.14307e+03_r8,0.17149e+03_r8,0.19971e+03_r8,0.22868e+03_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.20045e+03_r8,0.17541e+03_r8,0.15039e+03_r8,0.12643e+03_r8,0.12014e+03_r8, & + & 0.14095e+03_r8,0.16896e+03_r8,0.19679e+03_r8,0.22532e+03_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.20144e+03_r8,0.17633e+03_r8,0.15122e+03_r8,0.12673e+03_r8,0.11946e+03_r8, & + & 0.13885e+03_r8,0.16646e+03_r8,0.19386e+03_r8,0.22200e+03_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.20212e+03_r8,0.17694e+03_r8,0.15175e+03_r8,0.12692e+03_r8,0.11890e+03_r8, & + & 0.13670e+03_r8,0.16392e+03_r8,0.19092e+03_r8,0.21864e+03_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.20244e+03_r8,0.17722e+03_r8,0.15200e+03_r8,0.12703e+03_r8,0.11832e+03_r8, & + & 0.13474e+03_r8,0.16157e+03_r8,0.18819e+03_r8,0.21551e+03_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.23120e+03_r8,0.20232e+03_r8,0.17344e+03_r8,0.14797e+03_r8,0.14299e+03_r8, & + & 0.16694e+03_r8,0.20011e+03_r8,0.23304e+03_r8,0.26690e+03_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.23311e+03_r8,0.20399e+03_r8,0.17488e+03_r8,0.14825e+03_r8,0.14181e+03_r8, & + & 0.16424e+03_r8,0.19689e+03_r8,0.22930e+03_r8,0.26259e+03_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.23434e+03_r8,0.20510e+03_r8,0.17587e+03_r8,0.14844e+03_r8,0.14100e+03_r8, & + & 0.16150e+03_r8,0.19359e+03_r8,0.22546e+03_r8,0.25821e+03_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.23518e+03_r8,0.20584e+03_r8,0.17651e+03_r8,0.14849e+03_r8,0.14028e+03_r8, & + & 0.15873e+03_r8,0.19031e+03_r8,0.22162e+03_r8,0.25383e+03_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.23553e+03_r8,0.20616e+03_r8,0.17678e+03_r8,0.14839e+03_r8,0.13959e+03_r8, & + & 0.15626e+03_r8,0.18736e+03_r8,0.21823e+03_r8,0.24993e+03_r8 /) + kao(:, 1,10,15) = (/ & + & 0.26766e+03_r8,0.23422e+03_r8,0.20086e+03_r8,0.17305e+03_r8,0.16820e+03_r8, & + & 0.19275e+03_r8,0.23109e+03_r8,0.26916e+03_r8,0.30826e+03_r8 /) + kao(:, 2,10,15) = (/ & + & 0.26991e+03_r8,0.23619e+03_r8,0.20254e+03_r8,0.17334e+03_r8,0.16673e+03_r8, & + & 0.18936e+03_r8,0.22702e+03_r8,0.26442e+03_r8,0.30283e+03_r8 /) + kao(:, 3,10,15) = (/ & + & 0.27155e+03_r8,0.23766e+03_r8,0.20381e+03_r8,0.17344e+03_r8,0.16570e+03_r8, & + & 0.18588e+03_r8,0.22280e+03_r8,0.25950e+03_r8,0.29719e+03_r8 /) + kao(:, 4,10,15) = (/ & + & 0.27254e+03_r8,0.23853e+03_r8,0.20456e+03_r8,0.17332e+03_r8,0.16480e+03_r8, & + & 0.18267e+03_r8,0.21887e+03_r8,0.25495e+03_r8,0.29197e+03_r8 /) + kao(:, 5,10,15) = (/ & + & 0.27304e+03_r8,0.23896e+03_r8,0.20491e+03_r8,0.17301e+03_r8,0.16390e+03_r8, & + & 0.17979e+03_r8,0.21534e+03_r8,0.25082e+03_r8,0.28725e+03_r8 /) + kao(:, 1,11,15) = (/ & + & 0.31010e+03_r8,0.27147e+03_r8,0.23291e+03_r8,0.20181e+03_r8,0.19592e+03_r8, & + & 0.21861e+03_r8,0.26152e+03_r8,0.30466e+03_r8,0.34889e+03_r8 /) + kao(:, 2,11,15) = (/ & + & 0.31237e+03_r8,0.27343e+03_r8,0.23463e+03_r8,0.20183e+03_r8,0.19444e+03_r8, & + & 0.21467e+03_r8,0.25634e+03_r8,0.29864e+03_r8,0.34194e+03_r8 /) + kao(:, 3,11,15) = (/ & + & 0.31396e+03_r8,0.27478e+03_r8,0.23578e+03_r8,0.20169e+03_r8,0.19320e+03_r8, & + & 0.21082e+03_r8,0.25169e+03_r8,0.29321e+03_r8,0.33575e+03_r8 /) + kao(:, 4,11,15) = (/ & + & 0.31491e+03_r8,0.27559e+03_r8,0.23646e+03_r8,0.20134e+03_r8,0.19199e+03_r8, & + & 0.20744e+03_r8,0.24738e+03_r8,0.28820e+03_r8,0.33002e+03_r8 /) + kao(:, 5,11,15) = (/ & + & 0.31516e+03_r8,0.27581e+03_r8,0.23662e+03_r8,0.20063e+03_r8,0.19065e+03_r8, & + & 0.20428e+03_r8,0.24308e+03_r8,0.28319e+03_r8,0.32426e+03_r8 /) + kao(:, 1,12,15) = (/ & + & 0.35746e+03_r8,0.31300e+03_r8,0.26858e+03_r8,0.23433e+03_r8,0.22701e+03_r8, & + & 0.24649e+03_r8,0.29230e+03_r8,0.34058e+03_r8,0.38993e+03_r8 /) + kao(:, 2,12,15) = (/ & + & 0.35965e+03_r8,0.31492e+03_r8,0.27026e+03_r8,0.23392e+03_r8,0.22536e+03_r8, & + & 0.24218e+03_r8,0.28684e+03_r8,0.33421e+03_r8,0.38264e+03_r8 /) + kao(:, 3,12,15) = (/ & + & 0.36096e+03_r8,0.31606e+03_r8,0.27127e+03_r8,0.23331e+03_r8,0.22367e+03_r8, & + & 0.23821e+03_r8,0.28173e+03_r8,0.32828e+03_r8,0.37584e+03_r8 /) + kao(:, 4,12,15) = (/ & + & 0.36159e+03_r8,0.31657e+03_r8,0.27171e+03_r8,0.23251e+03_r8,0.22182e+03_r8, & + & 0.23456e+03_r8,0.27669e+03_r8,0.32238e+03_r8,0.36910e+03_r8 /) + kao(:, 5,12,15) = (/ & + & 0.36141e+03_r8,0.31636e+03_r8,0.27153e+03_r8,0.23134e+03_r8,0.21976e+03_r8, & + & 0.23095e+03_r8,0.27160e+03_r8,0.31644e+03_r8,0.36227e+03_r8 /) + kao(:, 1,13,15) = (/ & + & 0.40931e+03_r8,0.35842e+03_r8,0.30758e+03_r8,0.27041e+03_r8,0.26133e+03_r8, & + & 0.27679e+03_r8,0.32393e+03_r8,0.37751e+03_r8,0.43213e+03_r8 /) + kao(:, 2,13,15) = (/ & + & 0.41124e+03_r8,0.36013e+03_r8,0.30908e+03_r8,0.26935e+03_r8,0.25923e+03_r8, & + & 0.27218e+03_r8,0.31806e+03_r8,0.37065e+03_r8,0.42432e+03_r8 /) + kao(:, 3,13,15) = (/ & + & 0.41214e+03_r8,0.36093e+03_r8,0.30979e+03_r8,0.26811e+03_r8,0.25684e+03_r8, & + & 0.26794e+03_r8,0.31214e+03_r8,0.36375e+03_r8,0.41639e+03_r8 /) + kao(:, 4,13,15) = (/ & + & 0.41225e+03_r8,0.36102e+03_r8,0.30989e+03_r8,0.26655e+03_r8,0.25418e+03_r8, & + & 0.26378e+03_r8,0.30615e+03_r8,0.35676e+03_r8,0.40836e+03_r8 /) + kao(:, 5,13,15) = (/ & + & 0.41130e+03_r8,0.36017e+03_r8,0.30917e+03_r8,0.26471e+03_r8,0.25127e+03_r8, & + & 0.25962e+03_r8,0.30054e+03_r8,0.35018e+03_r8,0.40087e+03_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.66783e+02_r8,0.58494e+02_r8,0.50207e+02_r8,0.41922e+02_r8,0.39207e+02_r8, & + & 0.48837e+02_r8,0.58441e+02_r8,0.67973e+02_r8,0.73684e+02_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.66987e+02_r8,0.58663e+02_r8,0.50340e+02_r8,0.42083e+02_r8,0.39992e+02_r8, & + & 0.49756e+02_r8,0.59507e+02_r8,0.69167e+02_r8,0.75232e+02_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.67128e+02_r8,0.58776e+02_r8,0.50426e+02_r8,0.42412e+02_r8,0.40738e+02_r8, & + & 0.50635e+02_r8,0.60514e+02_r8,0.70320e+02_r8,0.76487e+02_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.67159e+02_r8,0.58797e+02_r8,0.50435e+02_r8,0.42709e+02_r8,0.41336e+02_r8, & + & 0.51345e+02_r8,0.61329e+02_r8,0.71239e+02_r8,0.77474e+02_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.67048e+02_r8,0.58698e+02_r8,0.50349e+02_r8,0.42916e+02_r8,0.41806e+02_r8, & + & 0.51893e+02_r8,0.61955e+02_r8,0.71939e+02_r8,0.78212e+02_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.80817e+02_r8,0.70771e+02_r8,0.60724e+02_r8,0.50680e+02_r8,0.46121e+02_r8, & + & 0.57561e+02_r8,0.68978e+02_r8,0.80276e+02_r8,0.88125e+02_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.81120e+02_r8,0.71031e+02_r8,0.60942e+02_r8,0.50856e+02_r8,0.46531e+02_r8, & + & 0.58009e+02_r8,0.69466e+02_r8,0.80811e+02_r8,0.88902e+02_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.81295e+02_r8,0.71179e+02_r8,0.61065e+02_r8,0.50952e+02_r8,0.47046e+02_r8, & + & 0.58603e+02_r8,0.70144e+02_r8,0.81568e+02_r8,0.89842e+02_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.81302e+02_r8,0.71181e+02_r8,0.61061e+02_r8,0.50998e+02_r8,0.47535e+02_r8, & + & 0.59172e+02_r8,0.70788e+02_r8,0.82285e+02_r8,0.90723e+02_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.81254e+02_r8,0.71123e+02_r8,0.60992e+02_r8,0.51150e+02_r8,0.47959e+02_r8, & + & 0.59657e+02_r8,0.71327e+02_r8,0.82908e+02_r8,0.91460e+02_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.97635e+02_r8,0.85483e+02_r8,0.73330e+02_r8,0.61179e+02_r8,0.56207e+02_r8, & + & 0.70215e+02_r8,0.84188e+02_r8,0.98014e+02_r8,0.10988e+03_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.98163e+02_r8,0.85943e+02_r8,0.73724e+02_r8,0.61504e+02_r8,0.55633e+02_r8, & + & 0.69472e+02_r8,0.83276e+02_r8,0.96935e+02_r8,0.10869e+03_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.98472e+02_r8,0.86211e+02_r8,0.73951e+02_r8,0.61693e+02_r8,0.55697e+02_r8, & + & 0.69495e+02_r8,0.83260e+02_r8,0.96885e+02_r8,0.10871e+03_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.98535e+02_r8,0.86265e+02_r8,0.73995e+02_r8,0.61728e+02_r8,0.55937e+02_r8, & + & 0.69749e+02_r8,0.83530e+02_r8,0.97171e+02_r8,0.10906e+03_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.98433e+02_r8,0.86165e+02_r8,0.73899e+02_r8,0.61635e+02_r8,0.56204e+02_r8, & + & 0.70040e+02_r8,0.83840e+02_r8,0.97500e+02_r8,0.10946e+03_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.11801e+03_r8,0.10331e+03_r8,0.88600e+02_r8,0.73894e+02_r8,0.68841e+02_r8, & + & 0.86008e+02_r8,0.10313e+03_r8,0.12007e+03_r8,0.13623e+03_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.11855e+03_r8,0.10378e+03_r8,0.89007e+02_r8,0.74235e+02_r8,0.68009e+02_r8, & + & 0.84957e+02_r8,0.10186e+03_r8,0.11859e+03_r8,0.13456e+03_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.11911e+03_r8,0.10427e+03_r8,0.89430e+02_r8,0.74590e+02_r8,0.67220e+02_r8, & + & 0.83955e+02_r8,0.10065e+03_r8,0.11716e+03_r8,0.13292e+03_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.11932e+03_r8,0.10446e+03_r8,0.89591e+02_r8,0.74725e+02_r8,0.66996e+02_r8, & + & 0.83620e+02_r8,0.10020e+03_r8,0.11661e+03_r8,0.13231e+03_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.11933e+03_r8,0.10445e+03_r8,0.89579e+02_r8,0.74708e+02_r8,0.67016e+02_r8, & + & 0.83607e+02_r8,0.10016e+03_r8,0.11655e+03_r8,0.13223e+03_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.14253e+03_r8,0.12475e+03_r8,0.10698e+03_r8,0.89200e+02_r8,0.84755e+02_r8, & + & 0.10590e+03_r8,0.12699e+03_r8,0.14785e+03_r8,0.16865e+03_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.14325e+03_r8,0.12539e+03_r8,0.10752e+03_r8,0.89655e+02_r8,0.83145e+02_r8, & + & 0.10388e+03_r8,0.12456e+03_r8,0.14501e+03_r8,0.16542e+03_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.14383e+03_r8,0.12589e+03_r8,0.10795e+03_r8,0.90019e+02_r8,0.82092e+02_r8, & + & 0.10255e+03_r8,0.12296e+03_r8,0.14315e+03_r8,0.16327e+03_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.14418e+03_r8,0.12620e+03_r8,0.10822e+03_r8,0.90248e+02_r8,0.81037e+02_r8, & + & 0.10121e+03_r8,0.12133e+03_r8,0.14124e+03_r8,0.16108e+03_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.14437e+03_r8,0.12637e+03_r8,0.10836e+03_r8,0.90358e+02_r8,0.80556e+02_r8, & + & 0.10057e+03_r8,0.12052e+03_r8,0.14027e+03_r8,0.15994e+03_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.17174e+03_r8,0.15031e+03_r8,0.12887e+03_r8,0.10744e+03_r8,0.10459e+03_r8, & + & 0.13069e+03_r8,0.15672e+03_r8,0.18250e+03_r8,0.20866e+03_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.17281e+03_r8,0.15124e+03_r8,0.12968e+03_r8,0.10811e+03_r8,0.10205e+03_r8, & + & 0.12751e+03_r8,0.15290e+03_r8,0.17802e+03_r8,0.20356e+03_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.17366e+03_r8,0.15199e+03_r8,0.13032e+03_r8,0.10865e+03_r8,0.10020e+03_r8, & + & 0.12519e+03_r8,0.15010e+03_r8,0.17475e+03_r8,0.19982e+03_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.17410e+03_r8,0.15237e+03_r8,0.13065e+03_r8,0.10893e+03_r8,0.98757e+02_r8, & + & 0.12337e+03_r8,0.14792e+03_r8,0.17221e+03_r8,0.19689e+03_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.17426e+03_r8,0.15251e+03_r8,0.13077e+03_r8,0.10903e+03_r8,0.97456e+02_r8, & + & 0.12171e+03_r8,0.14591e+03_r8,0.16984e+03_r8,0.19419e+03_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.20639e+03_r8,0.18062e+03_r8,0.15485e+03_r8,0.12907e+03_r8,0.12889e+03_r8, & + & 0.16105e+03_r8,0.19314e+03_r8,0.22488e+03_r8,0.25751e+03_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.20793e+03_r8,0.18197e+03_r8,0.15600e+03_r8,0.13004e+03_r8,0.12536e+03_r8, & + & 0.15664e+03_r8,0.18784e+03_r8,0.21870e+03_r8,0.25043e+03_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.20918e+03_r8,0.18307e+03_r8,0.15695e+03_r8,0.13084e+03_r8,0.12258e+03_r8, & + & 0.15317e+03_r8,0.18368e+03_r8,0.21386e+03_r8,0.24487e+03_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.20994e+03_r8,0.18373e+03_r8,0.15753e+03_r8,0.13132e+03_r8,0.12024e+03_r8, & + & 0.15023e+03_r8,0.18014e+03_r8,0.20974e+03_r8,0.24016e+03_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.21017e+03_r8,0.18393e+03_r8,0.15770e+03_r8,0.13147e+03_r8,0.11817e+03_r8, & + & 0.14763e+03_r8,0.17700e+03_r8,0.20610e+03_r8,0.23592e+03_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.24808e+03_r8,0.21709e+03_r8,0.18610e+03_r8,0.15511e+03_r8,0.15824e+03_r8, & + & 0.19773e+03_r8,0.23715e+03_r8,0.27617e+03_r8,0.31647e+03_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.24976e+03_r8,0.21856e+03_r8,0.18737e+03_r8,0.15617e+03_r8,0.15364e+03_r8, & + & 0.19198e+03_r8,0.23024e+03_r8,0.26808e+03_r8,0.30723e+03_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.25153e+03_r8,0.22011e+03_r8,0.18870e+03_r8,0.15729e+03_r8,0.14986e+03_r8, & + & 0.18726e+03_r8,0.22456e+03_r8,0.26146e+03_r8,0.29964e+03_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.25266e+03_r8,0.22111e+03_r8,0.18956e+03_r8,0.15801e+03_r8,0.14651e+03_r8, & + & 0.18308e+03_r8,0.21955e+03_r8,0.25564e+03_r8,0.29297e+03_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.25306e+03_r8,0.22146e+03_r8,0.18986e+03_r8,0.15826e+03_r8,0.14346e+03_r8, & + & 0.17924e+03_r8,0.21492e+03_r8,0.25024e+03_r8,0.28677e+03_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.29758e+03_r8,0.26040e+03_r8,0.22322e+03_r8,0.18603e+03_r8,0.19348e+03_r8, & + & 0.24177e+03_r8,0.28996e+03_r8,0.33765e+03_r8,0.38707e+03_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.29980e+03_r8,0.26234e+03_r8,0.22489e+03_r8,0.18744e+03_r8,0.18763e+03_r8, & + & 0.23446e+03_r8,0.28116e+03_r8,0.32742e+03_r8,0.37536e+03_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.30182e+03_r8,0.26412e+03_r8,0.22641e+03_r8,0.18871e+03_r8,0.18264e+03_r8, & + & 0.22823e+03_r8,0.27370e+03_r8,0.31874e+03_r8,0.36539e+03_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.30335e+03_r8,0.26546e+03_r8,0.22757e+03_r8,0.18968e+03_r8,0.17814e+03_r8, & + & 0.22260e+03_r8,0.26695e+03_r8,0.31086e+03_r8,0.35637e+03_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.30399e+03_r8,0.26602e+03_r8,0.22805e+03_r8,0.19008e+03_r8,0.17393e+03_r8, & + & 0.21734e+03_r8,0.26062e+03_r8,0.30347e+03_r8,0.34789e+03_r8 /) + kao(:, 1,10,16) = (/ & + & 0.35657e+03_r8,0.31201e+03_r8,0.26745e+03_r8,0.22289e+03_r8,0.23471e+03_r8, & + & 0.29329e+03_r8,0.35175e+03_r8,0.40960e+03_r8,0.46960e+03_r8 /) + kao(:, 2,10,16) = (/ & + & 0.35941e+03_r8,0.31450e+03_r8,0.26959e+03_r8,0.22468e+03_r8,0.22747e+03_r8, & + & 0.28425e+03_r8,0.34089e+03_r8,0.39700e+03_r8,0.45514e+03_r8 /) + kao(:, 3,10,16) = (/ & + & 0.36173e+03_r8,0.31654e+03_r8,0.27134e+03_r8,0.22614e+03_r8,0.22110e+03_r8, & + & 0.27628e+03_r8,0.33132e+03_r8,0.38584e+03_r8,0.44234e+03_r8 /) + kao(:, 4,10,16) = (/ & + & 0.36337e+03_r8,0.31797e+03_r8,0.27257e+03_r8,0.22717e+03_r8,0.21518e+03_r8, & + & 0.26889e+03_r8,0.32246e+03_r8,0.37553e+03_r8,0.43052e+03_r8 /) + kao(:, 5,10,16) = (/ & + & 0.36404e+03_r8,0.31855e+03_r8,0.27307e+03_r8,0.22759e+03_r8,0.20959e+03_r8, & + & 0.26189e+03_r8,0.31406e+03_r8,0.36572e+03_r8,0.41925e+03_r8 /) + kao(:, 1,11,16) = (/ & + & 0.42778e+03_r8,0.37432e+03_r8,0.32086e+03_r8,0.26740e+03_r8,0.27872e+03_r8, & + & 0.34830e+03_r8,0.41771e+03_r8,0.48646e+03_r8,0.55765e+03_r8 /) + kao(:, 2,11,16) = (/ & + & 0.43110e+03_r8,0.37723e+03_r8,0.32336e+03_r8,0.26948e+03_r8,0.27023e+03_r8, & + & 0.33769e+03_r8,0.40499e+03_r8,0.47168e+03_r8,0.54065e+03_r8 /) + kao(:, 3,11,16) = (/ & + & 0.43351e+03_r8,0.37933e+03_r8,0.32516e+03_r8,0.27099e+03_r8,0.26235e+03_r8, & + & 0.32784e+03_r8,0.39315e+03_r8,0.45790e+03_r8,0.52488e+03_r8 /) + kao(:, 4,11,16) = (/ & + & 0.43444e+03_r8,0.38015e+03_r8,0.32587e+03_r8,0.27158e+03_r8,0.25502e+03_r8, & + & 0.31866e+03_r8,0.38217e+03_r8,0.44507e+03_r8,0.51019e+03_r8 /) + kao(:, 5,11,16) = (/ & + & 0.43455e+03_r8,0.38025e+03_r8,0.32595e+03_r8,0.27165e+03_r8,0.24835e+03_r8, & + & 0.31008e+03_r8,0.37185e+03_r8,0.43305e+03_r8,0.49635e+03_r8 /) + kao(:, 1,12,16) = (/ & + & 0.51115e+03_r8,0.44727e+03_r8,0.38338e+03_r8,0.31950e+03_r8,0.32868e+03_r8, & + & 0.41075e+03_r8,0.49264e+03_r8,0.57375e+03_r8,0.65765e+03_r8 /) + kao(:, 2,12,16) = (/ & + & 0.51481e+03_r8,0.45047e+03_r8,0.38614e+03_r8,0.32180e+03_r8,0.31846e+03_r8, & + & 0.39795e+03_r8,0.47726e+03_r8,0.55589e+03_r8,0.63715e+03_r8 /) + kao(:, 3,12,16) = (/ & + & 0.51667e+03_r8,0.45210e+03_r8,0.38753e+03_r8,0.32296e+03_r8,0.30906e+03_r8, & + & 0.38614e+03_r8,0.46310e+03_r8,0.53942e+03_r8,0.61825e+03_r8 /) + kao(:, 4,12,16) = (/ & + & 0.51678e+03_r8,0.45219e+03_r8,0.38761e+03_r8,0.32303e+03_r8,0.30046e+03_r8, & + & 0.37494e+03_r8,0.44968e+03_r8,0.52372e+03_r8,0.60018e+03_r8 /) + kao(:, 5,12,16) = (/ & + & 0.51600e+03_r8,0.45151e+03_r8,0.38702e+03_r8,0.32254e+03_r8,0.29255e+03_r8, & + & 0.36403e+03_r8,0.43655e+03_r8,0.50852e+03_r8,0.58277e+03_r8 /) + kao(:, 1,13,16) = (/ & + & 0.60779e+03_r8,0.53183e+03_r8,0.45587e+03_r8,0.37990e+03_r8,0.38498e+03_r8, & + & 0.48109e+03_r8,0.57702e+03_r8,0.67207e+03_r8,0.77032e+03_r8 /) + kao(:, 2,13,16) = (/ & + & 0.61089e+03_r8,0.53454e+03_r8,0.45819e+03_r8,0.38184e+03_r8,0.37288e+03_r8, & + & 0.46566e+03_r8,0.55850e+03_r8,0.65053e+03_r8,0.74557e+03_r8 /) + kao(:, 3,13,16) = (/ & + & 0.61168e+03_r8,0.53523e+03_r8,0.45878e+03_r8,0.38233e+03_r8,0.36190e+03_r8, & + & 0.45112e+03_r8,0.54103e+03_r8,0.63023e+03_r8,0.72223e+03_r8 /) + kao(:, 4,13,16) = (/ & + & 0.61073e+03_r8,0.53440e+03_r8,0.45807e+03_r8,0.38174e+03_r8,0.35168e+03_r8, & + & 0.43693e+03_r8,0.52405e+03_r8,0.61044e+03_r8,0.69951e+03_r8 /) + kao(:, 5,13,16) = (/ & + & 0.60852e+03_r8,0.53247e+03_r8,0.45641e+03_r8,0.38036e+03_r8,0.34198e+03_r8, & + & 0.42302e+03_r8,0.50734e+03_r8,0.59097e+03_r8,0.67714e+03_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:, 1,13, 1) = (/ & + & 0.10554e-06_r8,0.38596e-04_r8,0.65402e-04_r8,0.88540e-04_r8,0.19601e-03_r8 /) + kbo(:, 2,13, 1) = (/ & + & 0.10479e-06_r8,0.43672e-04_r8,0.74889e-04_r8,0.10118e-03_r8,0.22146e-03_r8 /) + kbo(:, 3,13, 1) = (/ & + & 0.10429e-06_r8,0.49418e-04_r8,0.85429e-04_r8,0.11557e-03_r8,0.24448e-03_r8 /) + kbo(:, 4,13, 1) = (/ & + & 0.10232e-06_r8,0.55802e-04_r8,0.96459e-04_r8,0.13167e-03_r8,0.27001e-03_r8 /) + kbo(:, 5,13, 1) = (/ & + & 0.99013e-07_r8,0.62996e-04_r8,0.10900e-03_r8,0.14834e-03_r8,0.29917e-03_r8 /) + kbo(:, 1,14, 1) = (/ & + & 0.85136e-07_r8,0.31943e-04_r8,0.54402e-04_r8,0.73887e-04_r8,0.15895e-03_r8 /) + kbo(:, 2,14, 1) = (/ & + & 0.84597e-07_r8,0.36196e-04_r8,0.62429e-04_r8,0.84479e-04_r8,0.17749e-03_r8 /) + kbo(:, 3,14, 1) = (/ & + & 0.83629e-07_r8,0.40982e-04_r8,0.71126e-04_r8,0.96573e-04_r8,0.19740e-03_r8 /) + kbo(:, 4,14, 1) = (/ & + & 0.82310e-07_r8,0.46344e-04_r8,0.80458e-04_r8,0.10984e-03_r8,0.21847e-03_r8 /) + kbo(:, 5,14, 1) = (/ & + & 0.78709e-07_r8,0.52252e-04_r8,0.90989e-04_r8,0.12394e-03_r8,0.24281e-03_r8 /) + kbo(:, 1,15, 1) = (/ & + & 0.68497e-07_r8,0.26393e-04_r8,0.45164e-04_r8,0.61570e-04_r8,0.12493e-03_r8 /) + kbo(:, 2,15, 1) = (/ & + & 0.68062e-07_r8,0.29936e-04_r8,0.51919e-04_r8,0.70387e-04_r8,0.13953e-03_r8 /) + kbo(:, 3,15, 1) = (/ & + & 0.66766e-07_r8,0.33863e-04_r8,0.59056e-04_r8,0.80693e-04_r8,0.15653e-03_r8 /) + kbo(:, 4,15, 1) = (/ & + & 0.65636e-07_r8,0.38294e-04_r8,0.66885e-04_r8,0.91555e-04_r8,0.17510e-03_r8 /) + kbo(:, 5,15, 1) = (/ & + & 0.62711e-07_r8,0.43189e-04_r8,0.75756e-04_r8,0.10355e-03_r8,0.19439e-03_r8 /) + kbo(:, 1,16, 1) = (/ & + & 0.55083e-07_r8,0.21761e-04_r8,0.37484e-04_r8,0.51301e-04_r8,0.97875e-04_r8 /) + kbo(:, 2,16, 1) = (/ & + & 0.54095e-07_r8,0.24670e-04_r8,0.43084e-04_r8,0.58639e-04_r8,0.10996e-03_r8 /) + kbo(:, 3,16, 1) = (/ & + & 0.53340e-07_r8,0.27925e-04_r8,0.48976e-04_r8,0.67234e-04_r8,0.12415e-03_r8 /) + kbo(:, 4,16, 1) = (/ & + & 0.51412e-07_r8,0.31588e-04_r8,0.55576e-04_r8,0.76352e-04_r8,0.13939e-03_r8 /) + kbo(:, 5,16, 1) = (/ & + & 0.49341e-07_r8,0.35677e-04_r8,0.62937e-04_r8,0.86363e-04_r8,0.15543e-03_r8 /) + kbo(:, 1,17, 1) = (/ & + & 0.44022e-07_r8,0.17963e-04_r8,0.31102e-04_r8,0.42604e-04_r8,0.78290e-04_r8 /) + kbo(:, 2,17, 1) = (/ & + & 0.43167e-07_r8,0.20382e-04_r8,0.35754e-04_r8,0.48875e-04_r8,0.87941e-04_r8 /) + kbo(:, 3,17, 1) = (/ & + & 0.42210e-07_r8,0.23091e-04_r8,0.40674e-04_r8,0.56059e-04_r8,0.99257e-04_r8 /) + kbo(:, 4,17, 1) = (/ & + & 0.40402e-07_r8,0.26125e-04_r8,0.46162e-04_r8,0.63586e-04_r8,0.11166e-03_r8 /) + kbo(:, 5,17, 1) = (/ & + & 0.38532e-07_r8,0.29494e-04_r8,0.52327e-04_r8,0.71960e-04_r8,0.12480e-03_r8 /) + kbo(:, 1,18, 1) = (/ & + & 0.34937e-07_r8,0.14903e-04_r8,0.25868e-04_r8,0.35503e-04_r8,0.63368e-04_r8 /) + kbo(:, 2,18, 1) = (/ & + & 0.34308e-07_r8,0.16923e-04_r8,0.29781e-04_r8,0.40789e-04_r8,0.71115e-04_r8 /) + kbo(:, 3,18, 1) = (/ & + & 0.32995e-07_r8,0.19171e-04_r8,0.33872e-04_r8,0.46810e-04_r8,0.80302e-04_r8 /) + kbo(:, 4,18, 1) = (/ & + & 0.31654e-07_r8,0.21679e-04_r8,0.38468e-04_r8,0.53048e-04_r8,0.90431e-04_r8 /) + kbo(:, 5,18, 1) = (/ & + & 0.30282e-07_r8,0.24491e-04_r8,0.43596e-04_r8,0.60078e-04_r8,0.10133e-03_r8 /) + kbo(:, 1,19, 1) = (/ & + & 0.27971e-07_r8,0.12385e-04_r8,0.21549e-04_r8,0.29618e-04_r8,0.51732e-04_r8 /) + kbo(:, 2,19, 1) = (/ & + & 0.27128e-07_r8,0.14042e-04_r8,0.24826e-04_r8,0.34047e-04_r8,0.58064e-04_r8 /) + kbo(:, 3,19, 1) = (/ & + & 0.26018e-07_r8,0.15920e-04_r8,0.28221e-04_r8,0.39072e-04_r8,0.65495e-04_r8 /) + kbo(:, 4,19, 1) = (/ & + & 0.24717e-07_r8,0.18017e-04_r8,0.32056e-04_r8,0.44285e-04_r8,0.73859e-04_r8 /) + kbo(:, 5,19, 1) = (/ & + & 0.23859e-07_r8,0.20360e-04_r8,0.36341e-04_r8,0.50170e-04_r8,0.82944e-04_r8 /) + kbo(:, 1,20, 1) = (/ & + & 0.22529e-07_r8,0.10336e-04_r8,0.17999e-04_r8,0.24776e-04_r8,0.42602e-04_r8 /) + kbo(:, 2,20, 1) = (/ & + & 0.21733e-07_r8,0.11685e-04_r8,0.20769e-04_r8,0.28503e-04_r8,0.47833e-04_r8 /) + kbo(:, 3,20, 1) = (/ & + & 0.20791e-07_r8,0.13280e-04_r8,0.23571e-04_r8,0.32654e-04_r8,0.53995e-04_r8 /) + kbo(:, 4,20, 1) = (/ & + & 0.19663e-07_r8,0.15029e-04_r8,0.26788e-04_r8,0.37066e-04_r8,0.60944e-04_r8 /) + kbo(:, 5,20, 1) = (/ & + & 0.19169e-07_r8,0.16975e-04_r8,0.30353e-04_r8,0.41996e-04_r8,0.68344e-04_r8 /) + kbo(:, 1,21, 1) = (/ & + & 0.18148e-07_r8,0.86039e-05_r8,0.15041e-04_r8,0.20717e-04_r8,0.35143e-04_r8 /) + kbo(:, 2,21, 1) = (/ & + & 0.17465e-07_r8,0.97287e-05_r8,0.17348e-04_r8,0.23862e-04_r8,0.39508e-04_r8 /) + kbo(:, 3,21, 1) = (/ & + & 0.16537e-07_r8,0.11073e-04_r8,0.19687e-04_r8,0.27271e-04_r8,0.44652e-04_r8 /) + kbo(:, 4,21, 1) = (/ & + & 0.15860e-07_r8,0.12526e-04_r8,0.22388e-04_r8,0.31015e-04_r8,0.50269e-04_r8 /) + kbo(:, 5,21, 1) = (/ & + & 0.15452e-07_r8,0.14158e-04_r8,0.25339e-04_r8,0.35141e-04_r8,0.56327e-04_r8 /) + kbo(:, 1,22, 1) = (/ & + & 0.14542e-07_r8,0.71807e-05_r8,0.12682e-04_r8,0.17473e-04_r8,0.29179e-04_r8 /) + kbo(:, 2,22, 1) = (/ & + & 0.13967e-07_r8,0.81574e-05_r8,0.14550e-04_r8,0.20147e-04_r8,0.32795e-04_r8 /) + kbo(:, 3,22, 1) = (/ & + & 0.13241e-07_r8,0.92839e-05_r8,0.16547e-04_r8,0.22971e-04_r8,0.37036e-04_r8 /) + kbo(:, 4,22, 1) = (/ & + & 0.12746e-07_r8,0.10522e-04_r8,0.18840e-04_r8,0.26114e-04_r8,0.41617e-04_r8 /) + kbo(:, 5,22, 1) = (/ & + & 0.12426e-07_r8,0.11886e-04_r8,0.21313e-04_r8,0.29604e-04_r8,0.46709e-04_r8 /) + kbo(:, 1,23, 1) = (/ & + & 0.11724e-07_r8,0.60196e-05_r8,0.10703e-04_r8,0.14753e-04_r8,0.24143e-04_r8 /) + kbo(:, 2,23, 1) = (/ & + & 0.11124e-07_r8,0.68499e-05_r8,0.12233e-04_r8,0.17009e-04_r8,0.27147e-04_r8 /) + kbo(:, 3,23, 1) = (/ & + & 0.10552e-07_r8,0.77897e-05_r8,0.13927e-04_r8,0.19362e-04_r8,0.30661e-04_r8 /) + kbo(:, 4,23, 1) = (/ & + & 0.10213e-07_r8,0.88398e-05_r8,0.15850e-04_r8,0.22024e-04_r8,0.34519e-04_r8 /) + kbo(:, 5,23, 1) = (/ & + & 0.99627e-08_r8,0.99755e-05_r8,0.17919e-04_r8,0.24944e-04_r8,0.38730e-04_r8 /) + kbo(:, 1,24, 1) = (/ & + & 0.93835e-08_r8,0.50505e-05_r8,0.90298e-05_r8,0.12450e-04_r8,0.19940e-04_r8 /) + kbo(:, 2,24, 1) = (/ & + & 0.88722e-08_r8,0.57494e-05_r8,0.10287e-04_r8,0.14351e-04_r8,0.22450e-04_r8 /) + kbo(:, 3,24, 1) = (/ & + & 0.84719e-08_r8,0.65374e-05_r8,0.11727e-04_r8,0.16329e-04_r8,0.25378e-04_r8 /) + kbo(:, 4,24, 1) = (/ & + & 0.81924e-08_r8,0.74186e-05_r8,0.13334e-04_r8,0.18567e-04_r8,0.28560e-04_r8 /) + kbo(:, 5,24, 1) = (/ & + & 0.79194e-08_r8,0.83719e-05_r8,0.15056e-04_r8,0.21003e-04_r8,0.31990e-04_r8 /) + kbo(:, 1,25, 1) = (/ & + & 0.74535e-08_r8,0.42437e-05_r8,0.76220e-05_r8,0.10523e-04_r8,0.16531e-04_r8 /) + kbo(:, 2,25, 1) = (/ & + & 0.70516e-08_r8,0.48300e-05_r8,0.86667e-05_r8,0.12089e-04_r8,0.18616e-04_r8 /) + kbo(:, 3,25, 1) = (/ & + & 0.67746e-08_r8,0.54941e-05_r8,0.98927e-05_r8,0.13790e-04_r8,0.21024e-04_r8 /) + kbo(:, 4,25, 1) = (/ & + & 0.65375e-08_r8,0.62357e-05_r8,0.11233e-04_r8,0.15662e-04_r8,0.23642e-04_r8 /) + kbo(:, 5,25, 1) = (/ & + & 0.63001e-08_r8,0.70282e-05_r8,0.12669e-04_r8,0.17695e-04_r8,0.26478e-04_r8 /) + kbo(:, 1,26, 1) = (/ & + & 0.59520e-08_r8,0.35739e-05_r8,0.64350e-05_r8,0.89330e-05_r8,0.13754e-04_r8 /) + kbo(:, 2,26, 1) = (/ & + & 0.56644e-08_r8,0.40797e-05_r8,0.73291e-05_r8,0.10228e-04_r8,0.15489e-04_r8 /) + kbo(:, 3,26, 1) = (/ & + & 0.54229e-08_r8,0.46366e-05_r8,0.83664e-05_r8,0.11659e-04_r8,0.17486e-04_r8 /) + kbo(:, 4,26, 1) = (/ & + & 0.52155e-08_r8,0.52546e-05_r8,0.94829e-05_r8,0.13246e-04_r8,0.19643e-04_r8 /) + kbo(:, 5,26, 1) = (/ & + & 0.50026e-08_r8,0.59134e-05_r8,0.10676e-04_r8,0.14933e-04_r8,0.21979e-04_r8 /) + kbo(:, 1,27, 1) = (/ & + & 0.47347e-08_r8,0.30117e-05_r8,0.54223e-05_r8,0.75810e-05_r8,0.11424e-04_r8 /) + kbo(:, 2,27, 1) = (/ & + & 0.45215e-08_r8,0.34421e-05_r8,0.61959e-05_r8,0.86619e-05_r8,0.12884e-04_r8 /) + kbo(:, 3,27, 1) = (/ & + & 0.43334e-08_r8,0.39143e-05_r8,0.70702e-05_r8,0.98761e-05_r8,0.14543e-04_r8 /) + kbo(:, 4,27, 1) = (/ & + & 0.41350e-08_r8,0.44275e-05_r8,0.80005e-05_r8,0.11195e-04_r8,0.16319e-04_r8 /) + kbo(:, 5,27, 1) = (/ & + & 0.39653e-08_r8,0.49769e-05_r8,0.89931e-05_r8,0.12598e-04_r8,0.18160e-04_r8 /) + kbo(:, 1,28, 1) = (/ & + & 0.37948e-08_r8,0.25415e-05_r8,0.45819e-05_r8,0.64336e-05_r8,0.94956e-05_r8 /) + kbo(:, 2,28, 1) = (/ & + & 0.36083e-08_r8,0.29038e-05_r8,0.52426e-05_r8,0.73400e-05_r8,0.10719e-04_r8 /) + kbo(:, 3,28, 1) = (/ & + & 0.34418e-08_r8,0.33017e-05_r8,0.59733e-05_r8,0.83575e-05_r8,0.12066e-04_r8 /) + kbo(:, 4,28, 1) = (/ & + & 0.32636e-08_r8,0.37297e-05_r8,0.67493e-05_r8,0.94558e-05_r8,0.13468e-04_r8 /) + kbo(:, 5,28, 1) = (/ & + & 0.31340e-08_r8,0.41873e-05_r8,0.75759e-05_r8,0.10620e-04_r8,0.14953e-04_r8 /) + kbo(:, 1,29, 1) = (/ & + & 0.30121e-08_r8,0.21536e-05_r8,0.38841e-05_r8,0.54491e-05_r8,0.79090e-05_r8 /) + kbo(:, 2,29, 1) = (/ & + & 0.28775e-08_r8,0.24557e-05_r8,0.44467e-05_r8,0.62247e-05_r8,0.89148e-05_r8 /) + kbo(:, 3,29, 1) = (/ & + & 0.27196e-08_r8,0.27900e-05_r8,0.50543e-05_r8,0.70782e-05_r8,0.99943e-05_r8 /) + kbo(:, 4,29, 1) = (/ & + & 0.25798e-08_r8,0.31473e-05_r8,0.57011e-05_r8,0.79936e-05_r8,0.11135e-04_r8 /) + kbo(:, 5,29, 1) = (/ & + & 0.24785e-08_r8,0.35287e-05_r8,0.63894e-05_r8,0.89624e-05_r8,0.12357e-04_r8 /) + kbo(:, 1,30, 1) = (/ & + & 0.24034e-08_r8,0.18231e-05_r8,0.32945e-05_r8,0.46183e-05_r8,0.65837e-05_r8 /) + kbo(:, 2,30, 1) = (/ & + & 0.22702e-08_r8,0.20766e-05_r8,0.37671e-05_r8,0.52735e-05_r8,0.73875e-05_r8 /) + kbo(:, 3,30, 1) = (/ & + & 0.21551e-08_r8,0.23559e-05_r8,0.42744e-05_r8,0.59932e-05_r8,0.82665e-05_r8 /) + kbo(:, 4,30, 1) = (/ & + & 0.20397e-08_r8,0.26541e-05_r8,0.48137e-05_r8,0.67549e-05_r8,0.92071e-05_r8 /) + kbo(:, 5,30, 1) = (/ & + & 0.19208e-08_r8,0.29711e-05_r8,0.53880e-05_r8,0.75598e-05_r8,0.10211e-04_r8 /) + kbo(:, 1,31, 1) = (/ & + & 0.19116e-08_r8,0.15454e-05_r8,0.27957e-05_r8,0.39228e-05_r8,0.54664e-05_r8 /) + kbo(:, 2,31, 1) = (/ & + & 0.18045e-08_r8,0.17579e-05_r8,0.31938e-05_r8,0.44780e-05_r8,0.61205e-05_r8 /) + kbo(:, 3,31, 1) = (/ & + & 0.17015e-08_r8,0.19911e-05_r8,0.36167e-05_r8,0.50753e-05_r8,0.68523e-05_r8 /) + kbo(:, 4,31, 1) = (/ & + & 0.16042e-08_r8,0.22393e-05_r8,0.40666e-05_r8,0.57094e-05_r8,0.76260e-05_r8 /) + kbo(:, 5,31, 1) = (/ & + & 0.15189e-08_r8,0.25035e-05_r8,0.45439e-05_r8,0.63785e-05_r8,0.84562e-05_r8 /) + kbo(:, 1,32, 1) = (/ & + & 0.15134e-08_r8,0.13080e-05_r8,0.23763e-05_r8,0.33360e-05_r8,0.45382e-05_r8 /) + kbo(:, 2,32, 1) = (/ & + & 0.14254e-08_r8,0.14886e-05_r8,0.27086e-05_r8,0.37995e-05_r8,0.50938e-05_r8 /) + kbo(:, 3,32, 1) = (/ & + & 0.13478e-08_r8,0.16831e-05_r8,0.30605e-05_r8,0.42971e-05_r8,0.56933e-05_r8 /) + kbo(:, 4,32, 1) = (/ & + & 0.12726e-08_r8,0.18904e-05_r8,0.34353e-05_r8,0.48247e-05_r8,0.63353e-05_r8 /) + kbo(:, 5,32, 1) = (/ & + & 0.12027e-08_r8,0.21098e-05_r8,0.38318e-05_r8,0.53809e-05_r8,0.70302e-05_r8 /) + kbo(:, 1,33, 1) = (/ & + & 0.12024e-08_r8,0.11084e-05_r8,0.20193e-05_r8,0.28310e-05_r8,0.37849e-05_r8 /) + kbo(:, 2,33, 1) = (/ & + & 0.11338e-08_r8,0.12605e-05_r8,0.22949e-05_r8,0.32221e-05_r8,0.42458e-05_r8 /) + kbo(:, 3,33, 1) = (/ & + & 0.10678e-08_r8,0.14231e-05_r8,0.25881e-05_r8,0.36365e-05_r8,0.47460e-05_r8 /) + kbo(:, 4,33, 1) = (/ & + & 0.10052e-08_r8,0.15963e-05_r8,0.29010e-05_r8,0.40728e-05_r8,0.52804e-05_r8 /) + kbo(:, 5,33, 1) = (/ & + & 0.95946e-09_r8,0.17779e-05_r8,0.32301e-05_r8,0.45381e-05_r8,0.58547e-05_r8 /) + kbo(:, 1,34, 1) = (/ & + & 0.95750e-09_r8,0.93665e-06_r8,0.17068e-05_r8,0.23954e-05_r8,0.31611e-05_r8 /) + kbo(:, 2,34, 1) = (/ & + & 0.89991e-09_r8,0.10636e-05_r8,0.19366e-05_r8,0.27209e-05_r8,0.35440e-05_r8 /) + kbo(:, 3,34, 1) = (/ & + & 0.84944e-09_r8,0.11994e-05_r8,0.21804e-05_r8,0.30651e-05_r8,0.39600e-05_r8 /) + kbo(:, 4,34, 1) = (/ & + & 0.80863e-09_r8,0.13431e-05_r8,0.24406e-05_r8,0.34285e-05_r8,0.44045e-05_r8 /) + kbo(:, 5,34, 1) = (/ & + & 0.76697e-09_r8,0.14937e-05_r8,0.27138e-05_r8,0.38153e-05_r8,0.48739e-05_r8 /) + kbo(:, 1,35, 1) = (/ & + & 0.76931e-09_r8,0.78145e-06_r8,0.14243e-05_r8,0.20004e-05_r8,0.26088e-05_r8 /) + kbo(:, 2,35, 1) = (/ & + & 0.72554e-09_r8,0.88652e-06_r8,0.16140e-05_r8,0.22684e-05_r8,0.29255e-05_r8 /) + kbo(:, 3,35, 1) = (/ & + & 0.68677e-09_r8,0.99872e-06_r8,0.18159e-05_r8,0.25537e-05_r8,0.32672e-05_r8 /) + kbo(:, 4,35, 1) = (/ & + & 0.64986e-09_r8,0.11178e-05_r8,0.20312e-05_r8,0.28542e-05_r8,0.36304e-05_r8 /) + kbo(:, 5,35, 1) = (/ & + & 0.62177e-09_r8,0.12420e-05_r8,0.22566e-05_r8,0.31737e-05_r8,0.40187e-05_r8 /) + kbo(:, 1,36, 1) = (/ & + & 0.62245e-09_r8,0.64235e-06_r8,0.11709e-05_r8,0.16445e-05_r8,0.21213e-05_r8 /) + kbo(:, 2,36, 1) = (/ & + & 0.58696e-09_r8,0.72876e-06_r8,0.13266e-05_r8,0.18646e-05_r8,0.23798e-05_r8 /) + kbo(:, 3,36, 1) = (/ & + & 0.55693e-09_r8,0.82089e-06_r8,0.14927e-05_r8,0.20991e-05_r8,0.26600e-05_r8 /) + kbo(:, 4,36, 1) = (/ & + & 0.52934e-09_r8,0.91874e-06_r8,0.16695e-05_r8,0.23457e-05_r8,0.29575e-05_r8 /) + kbo(:, 5,36, 1) = (/ & + & 0.50585e-09_r8,0.10210e-05_r8,0.18549e-05_r8,0.26085e-05_r8,0.32758e-05_r8 /) + kbo(:, 1,37, 1) = (/ & + & 0.51156e-09_r8,0.51872e-06_r8,0.94550e-06_r8,0.13287e-05_r8,0.17089e-05_r8 /) + kbo(:, 2,37, 1) = (/ & + & 0.48258e-09_r8,0.58908e-06_r8,0.10722e-05_r8,0.15079e-05_r8,0.19187e-05_r8 /) + kbo(:, 3,37, 1) = (/ & + & 0.45694e-09_r8,0.66421e-06_r8,0.12078e-05_r8,0.16992e-05_r8,0.21456e-05_r8 /) + kbo(:, 4,37, 1) = (/ & + & 0.43502e-09_r8,0.74408e-06_r8,0.13520e-05_r8,0.19000e-05_r8,0.23876e-05_r8 /) + kbo(:, 5,37, 1) = (/ & + & 0.41517e-09_r8,0.82758e-06_r8,0.15034e-05_r8,0.21146e-05_r8,0.26473e-05_r8 /) + kbo(:, 1,38, 1) = (/ & + & 0.42094e-09_r8,0.41837e-06_r8,0.76260e-06_r8,0.10719e-05_r8,0.13756e-05_r8 /) + kbo(:, 2,38, 1) = (/ & + & 0.39700e-09_r8,0.47557e-06_r8,0.86572e-06_r8,0.12180e-05_r8,0.15462e-05_r8 /) + kbo(:, 3,38, 1) = (/ & + & 0.37563e-09_r8,0.53684e-06_r8,0.97613e-06_r8,0.13738e-05_r8,0.17289e-05_r8 /) + kbo(:, 4,38, 1) = (/ & + & 0.35783e-09_r8,0.60193e-06_r8,0.10936e-05_r8,0.15374e-05_r8,0.19252e-05_r8 /) + kbo(:, 5,38, 1) = (/ & + & 0.34107e-09_r8,0.67014e-06_r8,0.12173e-05_r8,0.17127e-05_r8,0.21369e-05_r8 /) + kbo(:, 1,39, 1) = (/ & + & 0.34635e-09_r8,0.33732e-06_r8,0.61492e-06_r8,0.86447e-06_r8,0.11055e-05_r8 /) + kbo(:, 2,39, 1) = (/ & + & 0.32654e-09_r8,0.38383e-06_r8,0.69869e-06_r8,0.98355e-06_r8,0.12440e-05_r8 /) + kbo(:, 3,39, 1) = (/ & + & 0.30909e-09_r8,0.43371e-06_r8,0.78869e-06_r8,0.11105e-05_r8,0.13924e-05_r8 /) + kbo(:, 4,39, 1) = (/ & + & 0.29425e-09_r8,0.48681e-06_r8,0.88446e-06_r8,0.12433e-05_r8,0.15526e-05_r8 /) + kbo(:, 5,39, 1) = (/ & + & 0.28000e-09_r8,0.54256e-06_r8,0.98550e-06_r8,0.13868e-05_r8,0.17238e-05_r8 /) + kbo(:, 1,40, 1) = (/ & + & 0.28731e-09_r8,0.26843e-06_r8,0.48915e-06_r8,0.68810e-06_r8,0.87867e-06_r8 /) + kbo(:, 2,40, 1) = (/ & + & 0.27089e-09_r8,0.30600e-06_r8,0.55698e-06_r8,0.78430e-06_r8,0.99075e-06_r8 /) + kbo(:, 3,40, 1) = (/ & + & 0.25607e-09_r8,0.34624e-06_r8,0.62966e-06_r8,0.88677e-06_r8,0.11107e-05_r8 /) + kbo(:, 4,40, 1) = (/ & + & 0.24372e-09_r8,0.38926e-06_r8,0.70732e-06_r8,0.99430e-06_r8,0.12402e-05_r8 /) + kbo(:, 5,40, 1) = (/ & + & 0.23176e-09_r8,0.43465e-06_r8,0.78943e-06_r8,0.11107e-05_r8,0.13787e-05_r8 /) + kbo(:, 1,41, 1) = (/ & + & 0.23903e-09_r8,0.21323e-06_r8,0.38855e-06_r8,0.54701e-06_r8,0.69781e-06_r8 /) + kbo(:, 2,41, 1) = (/ & + & 0.22487e-09_r8,0.24332e-06_r8,0.44328e-06_r8,0.62397e-06_r8,0.78774e-06_r8 /) + kbo(:, 3,41, 1) = (/ & + & 0.21236e-09_r8,0.27581e-06_r8,0.50170e-06_r8,0.70664e-06_r8,0.88427e-06_r8 /) + kbo(:, 4,41, 1) = (/ & + & 0.20204e-09_r8,0.31066e-06_r8,0.56435e-06_r8,0.79384e-06_r8,0.98899e-06_r8 /) + kbo(:, 5,41, 1) = (/ & + & 0.19209e-09_r8,0.34753e-06_r8,0.63119e-06_r8,0.88787e-06_r8,0.11007e-05_r8 /) + kbo(:, 1,42, 1) = (/ & + & 0.19868e-09_r8,0.16950e-06_r8,0.30885e-06_r8,0.43426e-06_r8,0.55336e-06_r8 /) + kbo(:, 2,42, 1) = (/ & + & 0.18681e-09_r8,0.19338e-06_r8,0.35250e-06_r8,0.49622e-06_r8,0.62628e-06_r8 /) + kbo(:, 3,42, 1) = (/ & + & 0.17649e-09_r8,0.21963e-06_r8,0.39950e-06_r8,0.56269e-06_r8,0.70396e-06_r8 /) + kbo(:, 4,42, 1) = (/ & + & 0.16753e-09_r8,0.24778e-06_r8,0.45013e-06_r8,0.63342e-06_r8,0.78770e-06_r8 /) + kbo(:, 5,42, 1) = (/ & + & 0.15930e-09_r8,0.27772e-06_r8,0.50439e-06_r8,0.70945e-06_r8,0.87783e-06_r8 /) + kbo(:, 1,43, 1) = (/ & + & 0.16577e-09_r8,0.13332e-06_r8,0.24323e-06_r8,0.34184e-06_r8,0.43594e-06_r8 /) + kbo(:, 2,43, 1) = (/ & + & 0.15597e-09_r8,0.15245e-06_r8,0.27801e-06_r8,0.39130e-06_r8,0.49460e-06_r8 /) + kbo(:, 3,43, 1) = (/ & + & 0.14721e-09_r8,0.17354e-06_r8,0.31584e-06_r8,0.44499e-06_r8,0.55705e-06_r8 /) + kbo(:, 4,43, 1) = (/ & + & 0.13936e-09_r8,0.19625e-06_r8,0.35661e-06_r8,0.50189e-06_r8,0.62398e-06_r8 /) + kbo(:, 5,43, 1) = (/ & + & 0.13255e-09_r8,0.22044e-06_r8,0.40034e-06_r8,0.56308e-06_r8,0.69634e-06_r8 /) + kbo(:, 1,44, 1) = (/ & + & 0.13861e-09_r8,0.10445e-06_r8,0.19058e-06_r8,0.26841e-06_r8,0.34233e-06_r8 /) + kbo(:, 2,44, 1) = (/ & + & 0.13027e-09_r8,0.11974e-06_r8,0.21836e-06_r8,0.30744e-06_r8,0.38897e-06_r8 /) + kbo(:, 3,44, 1) = (/ & + & 0.12290e-09_r8,0.13662e-06_r8,0.24864e-06_r8,0.35065e-06_r8,0.43916e-06_r8 /) + kbo(:, 4,44, 1) = (/ & + & 0.11611e-09_r8,0.15484e-06_r8,0.28155e-06_r8,0.39627e-06_r8,0.49273e-06_r8 /) + kbo(:, 5,44, 1) = (/ & + & 0.11042e-09_r8,0.17431e-06_r8,0.31666e-06_r8,0.44540e-06_r8,0.55087e-06_r8 /) + kbo(:, 1,45, 1) = (/ & + & 0.11581e-09_r8,0.81915e-07_r8,0.14915e-06_r8,0.21140e-06_r8,0.26987e-06_r8 /) + kbo(:, 2,45, 1) = (/ & + & 0.10906e-09_r8,0.94077e-07_r8,0.17143e-06_r8,0.24173e-06_r8,0.30586e-06_r8 /) + kbo(:, 3,45, 1) = (/ & + & 0.10254e-09_r8,0.10745e-06_r8,0.19582e-06_r8,0.27606e-06_r8,0.34593e-06_r8 /) + kbo(:, 4,45, 1) = (/ & + & 0.96757e-10_r8,0.12205e-06_r8,0.22201e-06_r8,0.31271e-06_r8,0.38876e-06_r8 /) + kbo(:, 5,45, 1) = (/ & + & 0.91979e-10_r8,0.13772e-06_r8,0.25015e-06_r8,0.35208e-06_r8,0.43561e-06_r8 /) + kbo(:, 1,46, 1) = (/ & + & 0.96889e-10_r8,0.64116e-07_r8,0.11708e-06_r8,0.16455e-06_r8,0.21036e-06_r8 /) + kbo(:, 2,46, 1) = (/ & + & 0.91281e-10_r8,0.73641e-07_r8,0.13436e-06_r8,0.18895e-06_r8,0.23951e-06_r8 /) + kbo(:, 3,46, 1) = (/ & + & 0.85830e-10_r8,0.84161e-07_r8,0.15360e-06_r8,0.21643e-06_r8,0.27176e-06_r8 /) + kbo(:, 4,46, 1) = (/ & + & 0.81048e-10_r8,0.95867e-07_r8,0.17447e-06_r8,0.24582e-06_r8,0.30613e-06_r8 /) + kbo(:, 5,46, 1) = (/ & + & 0.76712e-10_r8,0.10844e-06_r8,0.19706e-06_r8,0.27743e-06_r8,0.34329e-06_r8 /) + kbo(:, 1,47, 1) = (/ & + & 0.81516e-10_r8,0.49698e-07_r8,0.90596e-07_r8,0.12727e-06_r8,0.16313e-06_r8 /) + kbo(:, 2,47, 1) = (/ & + & 0.76609e-10_r8,0.57132e-07_r8,0.10433e-06_r8,0.14694e-06_r8,0.18672e-06_r8 /) + kbo(:, 3,47, 1) = (/ & + & 0.71975e-10_r8,0.65534e-07_r8,0.11955e-06_r8,0.16850e-06_r8,0.21215e-06_r8 /) + kbo(:, 4,47, 1) = (/ & + & 0.67908e-10_r8,0.74829e-07_r8,0.13619e-06_r8,0.19209e-06_r8,0.23959e-06_r8 /) + kbo(:, 5,47, 1) = (/ & + & 0.64117e-10_r8,0.84872e-07_r8,0.15433e-06_r8,0.21733e-06_r8,0.26915e-06_r8 /) + kbo(:, 1,48, 1) = (/ & + & 0.68429e-10_r8,0.38715e-07_r8,0.69854e-07_r8,0.98377e-07_r8,0.12619e-06_r8 /) + kbo(:, 2,48, 1) = (/ & + & 0.64236e-10_r8,0.44375e-07_r8,0.80895e-07_r8,0.11471e-06_r8,0.14604e-06_r8 /) + kbo(:, 3,48, 1) = (/ & + & 0.60510e-10_r8,0.51025e-07_r8,0.92977e-07_r8,0.13123e-06_r8,0.16542e-06_r8 /) + kbo(:, 4,48, 1) = (/ & + & 0.56851e-10_r8,0.58345e-07_r8,0.10633e-06_r8,0.14991e-06_r8,0.18745e-06_r8 /) + kbo(:, 5,48, 1) = (/ & + & 0.53674e-10_r8,0.66346e-07_r8,0.12070e-06_r8,0.17001e-06_r8,0.21095e-06_r8 /) + kbo(:, 1,49, 1) = (/ & + & 0.57387e-10_r8,0.29800e-07_r8,0.53817e-07_r8,0.75906e-07_r8,0.97710e-07_r8 /) + kbo(:, 2,49, 1) = (/ & + & 0.53960e-10_r8,0.34500e-07_r8,0.63205e-07_r8,0.88655e-07_r8,0.11310e-06_r8 /) + kbo(:, 3,49, 1) = (/ & + & 0.50740e-10_r8,0.39684e-07_r8,0.72502e-07_r8,0.10193e-06_r8,0.12892e-06_r8 /) + kbo(:, 4,49, 1) = (/ & + & 0.47710e-10_r8,0.45418e-07_r8,0.82941e-07_r8,0.11692e-06_r8,0.14649e-06_r8 /) + kbo(:, 5,49, 1) = (/ & + & 0.45050e-10_r8,0.51797e-07_r8,0.94320e-07_r8,0.13296e-06_r8,0.16526e-06_r8 /) + kbo(:, 1,50, 1) = (/ & + & 0.48010e-10_r8,0.22999e-07_r8,0.41682e-07_r8,0.58975e-07_r8,0.75898e-07_r8 /) + kbo(:, 2,50, 1) = (/ & + & 0.45282e-10_r8,0.26917e-07_r8,0.48929e-07_r8,0.68765e-07_r8,0.87983e-07_r8 /) + kbo(:, 3,50, 1) = (/ & + & 0.42531e-10_r8,0.30879e-07_r8,0.56406e-07_r8,0.79593e-07_r8,0.10109e-06_r8 /) + kbo(:, 4,50, 1) = (/ & + & 0.40002e-10_r8,0.35470e-07_r8,0.64706e-07_r8,0.91312e-07_r8,0.11473e-06_r8 /) + kbo(:, 5,50, 1) = (/ & + & 0.37674e-10_r8,0.40542e-07_r8,0.73834e-07_r8,0.10412e-06_r8,0.12967e-06_r8 /) + kbo(:, 1,51, 1) = (/ & + & 0.40094e-10_r8,0.17810e-07_r8,0.32412e-07_r8,0.45985e-07_r8,0.59041e-07_r8 /) + kbo(:, 2,51, 1) = (/ & + & 0.37901e-10_r8,0.21013e-07_r8,0.37921e-07_r8,0.53479e-07_r8,0.68479e-07_r8 /) + kbo(:, 3,51, 1) = (/ & + & 0.35584e-10_r8,0.24100e-07_r8,0.43988e-07_r8,0.62409e-07_r8,0.79311e-07_r8 /) + kbo(:, 4,51, 1) = (/ & + & 0.33516e-10_r8,0.27737e-07_r8,0.50544e-07_r8,0.71436e-07_r8,0.89912e-07_r8 /) + kbo(:, 5,51, 1) = (/ & + & 0.31503e-10_r8,0.31738e-07_r8,0.57889e-07_r8,0.81591e-07_r8,0.10195e-06_r8 /) + kbo(:, 1,52, 1) = (/ & + & 0.33462e-10_r8,0.13829e-07_r8,0.25227e-07_r8,0.35498e-07_r8,0.45793e-07_r8 /) + kbo(:, 2,52, 1) = (/ & + & 0.31703e-10_r8,0.16272e-07_r8,0.29393e-07_r8,0.41476e-07_r8,0.53340e-07_r8 /) + kbo(:, 3,52, 1) = (/ & + & 0.29856e-10_r8,0.18836e-07_r8,0.34537e-07_r8,0.48490e-07_r8,0.61791e-07_r8 /) + kbo(:, 4,52, 1) = (/ & + & 0.28038e-10_r8,0.21684e-07_r8,0.39578e-07_r8,0.55751e-07_r8,0.70422e-07_r8 /) + kbo(:, 5,52, 1) = (/ & + & 0.26375e-10_r8,0.24824e-07_r8,0.45389e-07_r8,0.63898e-07_r8,0.80071e-07_r8 /) + kbo(:, 1,53, 1) = (/ & + & 0.27859e-10_r8,0.10757e-07_r8,0.19436e-07_r8,0.27368e-07_r8,0.35401e-07_r8 /) + kbo(:, 2,53, 1) = (/ & + & 0.26482e-10_r8,0.12575e-07_r8,0.22786e-07_r8,0.32275e-07_r8,0.41504e-07_r8 /) + kbo(:, 3,53, 1) = (/ & + & 0.25013e-10_r8,0.14718e-07_r8,0.26786e-07_r8,0.37657e-07_r8,0.48150e-07_r8 /) + kbo(:, 4,53, 1) = (/ & + & 0.23481e-10_r8,0.16890e-07_r8,0.30875e-07_r8,0.43561e-07_r8,0.55284e-07_r8 /) + kbo(:, 5,53, 1) = (/ & + & 0.22103e-10_r8,0.19405e-07_r8,0.35435e-07_r8,0.50046e-07_r8,0.62824e-07_r8 /) + kbo(:, 1,54, 1) = (/ & + & 0.23262e-10_r8,0.83534e-08_r8,0.15033e-07_r8,0.21142e-07_r8,0.27491e-07_r8 /) + kbo(:, 2,54, 1) = (/ & + & 0.22075e-10_r8,0.97821e-08_r8,0.17791e-07_r8,0.25298e-07_r8,0.32447e-07_r8 /) + kbo(:, 3,54, 1) = (/ & + & 0.20887e-10_r8,0.11541e-07_r8,0.20852e-07_r8,0.29392e-07_r8,0.37643e-07_r8 /) + kbo(:, 4,54, 1) = (/ & + & 0.19629e-10_r8,0.13228e-07_r8,0.24164e-07_r8,0.34330e-07_r8,0.43622e-07_r8 /) + kbo(:, 5,54, 1) = (/ & + & 0.18475e-10_r8,0.15233e-07_r8,0.27779e-07_r8,0.39304e-07_r8,0.49432e-07_r8 /) + kbo(:, 1,55, 1) = (/ & + & 0.19360e-10_r8,0.64888e-08_r8,0.11644e-07_r8,0.16387e-07_r8,0.21340e-07_r8 /) + kbo(:, 2,55, 1) = (/ & + & 0.18372e-10_r8,0.76367e-08_r8,0.13947e-07_r8,0.19672e-07_r8,0.25401e-07_r8 /) + kbo(:, 3,55, 1) = (/ & + & 0.17421e-10_r8,0.90083e-08_r8,0.16275e-07_r8,0.22971e-07_r8,0.29522e-07_r8 /) + kbo(:, 4,55, 1) = (/ & + & 0.16413e-10_r8,0.10402e-07_r8,0.19081e-07_r8,0.26854e-07_r8,0.34233e-07_r8 /) + kbo(:, 5,55, 1) = (/ & + & 0.15417e-10_r8,0.11984e-07_r8,0.21835e-07_r8,0.30856e-07_r8,0.38954e-07_r8 /) + kbo(:, 1,56, 1) = (/ & + & 0.16094e-10_r8,0.50174e-08_r8,0.90283e-08_r8,0.12718e-07_r8,0.16576e-07_r8 /) + kbo(:, 2,56, 1) = (/ & + & 0.15265e-10_r8,0.59747e-08_r8,0.10850e-07_r8,0.15297e-07_r8,0.19783e-07_r8 /) + kbo(:, 3,56, 1) = (/ & + & 0.14515e-10_r8,0.70142e-08_r8,0.12699e-07_r8,0.17960e-07_r8,0.23171e-07_r8 /) + kbo(:, 4,56, 1) = (/ & + & 0.13715e-10_r8,0.81626e-08_r8,0.14940e-07_r8,0.20994e-07_r8,0.26865e-07_r8 /) + kbo(:, 5,56, 1) = (/ & + & 0.12880e-10_r8,0.94054e-08_r8,0.17206e-07_r8,0.24221e-07_r8,0.30739e-07_r8 /) + kbo(:, 1,57, 1) = (/ & + & 0.13368e-10_r8,0.38838e-08_r8,0.69991e-08_r8,0.98372e-08_r8,0.12821e-07_r8 /) + kbo(:, 2,57, 1) = (/ & + & 0.12743e-10_r8,0.46751e-08_r8,0.84243e-08_r8,0.11856e-07_r8,0.15406e-07_r8 /) + kbo(:, 3,57, 1) = (/ & + & 0.12087e-10_r8,0.54642e-08_r8,0.99295e-08_r8,0.14069e-07_r8,0.18144e-07_r8 /) + kbo(:, 4,57, 1) = (/ & + & 0.11442e-10_r8,0.64461e-08_r8,0.11657e-07_r8,0.16407e-07_r8,0.21072e-07_r8 /) + kbo(:, 5,57, 1) = (/ & + & 0.10759e-10_r8,0.73711e-08_r8,0.13478e-07_r8,0.19106e-07_r8,0.24314e-07_r8 /) + kbo(:, 1,58, 1) = (/ & + & 0.11081e-10_r8,0.30148e-08_r8,0.54165e-08_r8,0.76421e-08_r8,0.99496e-08_r8 /) + kbo(:, 2,58, 1) = (/ & + & 0.10598e-10_r8,0.36337e-08_r8,0.65375e-08_r8,0.92041e-08_r8,0.12025e-07_r8 /) + kbo(:, 3,58, 1) = (/ & + & 0.10052e-10_r8,0.42712e-08_r8,0.77841e-08_r8,0.11053e-07_r8,0.14306e-07_r8 /) + kbo(:, 4,58, 1) = (/ & + & 0.95308e-11_r8,0.50429e-08_r8,0.91133e-08_r8,0.12865e-07_r8,0.16554e-07_r8 /) + kbo(:, 5,58, 1) = (/ & + & 0.89795e-11_r8,0.57979e-08_r8,0.10615e-07_r8,0.15051e-07_r8,0.19216e-07_r8 /) + kbo(:, 1,59, 1) = (/ & + & 0.91194e-11_r8,0.24214e-08_r8,0.43496e-08_r8,0.61531e-08_r8,0.80136e-08_r8 /) + kbo(:, 2,59, 1) = (/ & + & 0.87287e-11_r8,0.29232e-08_r8,0.52535e-08_r8,0.73966e-08_r8,0.96830e-08_r8 /) + kbo(:, 3,59, 1) = (/ & + & 0.82765e-11_r8,0.34412e-08_r8,0.62788e-08_r8,0.88992e-08_r8,0.11534e-07_r8 /) + kbo(:, 4,59, 1) = (/ & + & 0.78605e-11_r8,0.40632e-08_r8,0.73454e-08_r8,0.10382e-07_r8,0.13372e-07_r8 /) + kbo(:, 5,59, 1) = (/ & + & 0.74127e-11_r8,0.46801e-08_r8,0.85910e-08_r8,0.12137e-07_r8,0.15530e-07_r8 /) + kbo(:, 1,13, 2) = (/ & + & 0.17576e-05_r8,0.22518e-03_r8,0.36398e-03_r8,0.46505e-03_r8,0.97920e-03_r8 /) + kbo(:, 2,13, 2) = (/ & + & 0.19522e-05_r8,0.25688e-03_r8,0.42724e-03_r8,0.54293e-03_r8,0.11261e-02_r8 /) + kbo(:, 3,13, 2) = (/ & + & 0.21134e-05_r8,0.29382e-03_r8,0.49778e-03_r8,0.63186e-03_r8,0.12961e-02_r8 /) + kbo(:, 4,13, 2) = (/ & + & 0.22680e-05_r8,0.33585e-03_r8,0.57095e-03_r8,0.73149e-03_r8,0.14857e-02_r8 /) + kbo(:, 5,13, 2) = (/ & + & 0.23939e-05_r8,0.38326e-03_r8,0.64688e-03_r8,0.84120e-03_r8,0.16815e-02_r8 /) + kbo(:, 1,14, 2) = (/ & + & 0.13866e-05_r8,0.18816e-03_r8,0.30541e-03_r8,0.39082e-03_r8,0.80614e-03_r8 /) + kbo(:, 2,14, 2) = (/ & + & 0.14825e-05_r8,0.21525e-03_r8,0.35906e-03_r8,0.45772e-03_r8,0.92976e-03_r8 /) + kbo(:, 3,14, 2) = (/ & + & 0.16428e-05_r8,0.24664e-03_r8,0.41891e-03_r8,0.53341e-03_r8,0.10689e-02_r8 /) + kbo(:, 4,14, 2) = (/ & + & 0.17807e-05_r8,0.28218e-03_r8,0.48021e-03_r8,0.61861e-03_r8,0.12236e-02_r8 /) + kbo(:, 5,14, 2) = (/ & + & 0.18685e-05_r8,0.32204e-03_r8,0.54385e-03_r8,0.71223e-03_r8,0.13844e-02_r8 /) + kbo(:, 1,15, 2) = (/ & + & 0.10483e-05_r8,0.15699e-03_r8,0.25571e-03_r8,0.32803e-03_r8,0.65873e-03_r8 /) + kbo(:, 2,15, 2) = (/ & + & 0.11310e-05_r8,0.18016e-03_r8,0.30071e-03_r8,0.38534e-03_r8,0.75916e-03_r8 /) + kbo(:, 3,15, 2) = (/ & + & 0.12330e-05_r8,0.20672e-03_r8,0.35181e-03_r8,0.44940e-03_r8,0.87041e-03_r8 /) + kbo(:, 4,15, 2) = (/ & + & 0.13426e-05_r8,0.23650e-03_r8,0.40292e-03_r8,0.52246e-03_r8,0.99445e-03_r8 /) + kbo(:, 5,15, 2) = (/ & + & 0.14514e-05_r8,0.26979e-03_r8,0.45684e-03_r8,0.60195e-03_r8,0.11173e-02_r8 /) + kbo(:, 1,16, 2) = (/ & + & 0.80663e-06_r8,0.13098e-03_r8,0.21382e-03_r8,0.27539e-03_r8,0.53727e-03_r8 /) + kbo(:, 2,16, 2) = (/ & + & 0.85747e-06_r8,0.15058e-03_r8,0.25201e-03_r8,0.32406e-03_r8,0.61573e-03_r8 /) + kbo(:, 3,16, 2) = (/ & + & 0.92435e-06_r8,0.17283e-03_r8,0.29542e-03_r8,0.37879e-03_r8,0.70140e-03_r8 /) + kbo(:, 4,16, 2) = (/ & + & 0.99747e-06_r8,0.19793e-03_r8,0.33807e-03_r8,0.44076e-03_r8,0.79468e-03_r8 /) + kbo(:, 5,16, 2) = (/ & + & 0.10819e-05_r8,0.22582e-03_r8,0.38354e-03_r8,0.50663e-03_r8,0.88980e-03_r8 /) + kbo(:, 1,17, 2) = (/ & + & 0.61772e-06_r8,0.10941e-03_r8,0.17926e-03_r8,0.23144e-03_r8,0.43554e-03_r8 /) + kbo(:, 2,17, 2) = (/ & + & 0.65718e-06_r8,0.12576e-03_r8,0.21174e-03_r8,0.27275e-03_r8,0.49750e-03_r8 /) + kbo(:, 3,17, 2) = (/ & + & 0.69949e-06_r8,0.14461e-03_r8,0.24852e-03_r8,0.31937e-03_r8,0.56462e-03_r8 /) + kbo(:, 4,17, 2) = (/ & + & 0.75387e-06_r8,0.16580e-03_r8,0.28374e-03_r8,0.37213e-03_r8,0.63507e-03_r8 /) + kbo(:, 5,17, 2) = (/ & + & 0.79715e-06_r8,0.18926e-03_r8,0.32236e-03_r8,0.42588e-03_r8,0.70728e-03_r8 /) + kbo(:, 1,18, 2) = (/ & + & 0.47188e-06_r8,0.91952e-04_r8,0.15100e-03_r8,0.19495e-03_r8,0.35543e-03_r8 /) + kbo(:, 2,18, 2) = (/ & + & 0.50937e-06_r8,0.10513e-03_r8,0.17852e-03_r8,0.22999e-03_r8,0.40250e-03_r8 /) + kbo(:, 3,18, 2) = (/ & + & 0.54206e-06_r8,0.12130e-03_r8,0.20959e-03_r8,0.26979e-03_r8,0.45662e-03_r8 /) + kbo(:, 4,18, 2) = (/ & + & 0.57328e-06_r8,0.13936e-03_r8,0.23815e-03_r8,0.31451e-03_r8,0.51113e-03_r8 /) + kbo(:, 5,18, 2) = (/ & + & 0.61077e-06_r8,0.15916e-03_r8,0.27075e-03_r8,0.35967e-03_r8,0.57076e-03_r8 /) + kbo(:, 1,19, 2) = (/ & + & 0.36005e-06_r8,0.76984e-04_r8,0.12743e-03_r8,0.16422e-03_r8,0.28885e-03_r8 /) + kbo(:, 2,19, 2) = (/ & + & 0.38988e-06_r8,0.88029e-04_r8,0.15067e-03_r8,0.19396e-03_r8,0.32854e-03_r8 /) + kbo(:, 3,19, 2) = (/ & + & 0.41989e-06_r8,0.10172e-03_r8,0.17539e-03_r8,0.22784e-03_r8,0.37045e-03_r8 /) + kbo(:, 4,19, 2) = (/ & + & 0.44092e-06_r8,0.11727e-03_r8,0.20004e-03_r8,0.26592e-03_r8,0.41598e-03_r8 /) + kbo(:, 5,19, 2) = (/ & + & 0.46883e-06_r8,0.13386e-03_r8,0.22769e-03_r8,0.30285e-03_r8,0.46550e-03_r8 /) + kbo(:, 1,20, 2) = (/ & + & 0.27908e-06_r8,0.64450e-04_r8,0.10795e-03_r8,0.13889e-03_r8,0.23878e-03_r8 /) + kbo(:, 2,20, 2) = (/ & + & 0.30934e-06_r8,0.74187e-04_r8,0.12773e-03_r8,0.16417e-03_r8,0.27017e-03_r8 /) + kbo(:, 3,20, 2) = (/ & + & 0.33086e-06_r8,0.85801e-04_r8,0.14782e-03_r8,0.19307e-03_r8,0.30508e-03_r8 /) + kbo(:, 4,20, 2) = (/ & + & 0.35058e-06_r8,0.98861e-04_r8,0.16868e-03_r8,0.22508e-03_r8,0.34249e-03_r8 /) + kbo(:, 5,20, 2) = (/ & + & 0.37069e-06_r8,0.11306e-03_r8,0.19188e-03_r8,0.25601e-03_r8,0.38519e-03_r8 /) + kbo(:, 1,21, 2) = (/ & + & 0.22418e-06_r8,0.54095e-04_r8,0.91414e-04_r8,0.11757e-03_r8,0.19697e-03_r8 /) + kbo(:, 2,21, 2) = (/ & + & 0.24559e-06_r8,0.62567e-04_r8,0.10819e-03_r8,0.13908e-03_r8,0.22284e-03_r8 /) + kbo(:, 3,21, 2) = (/ & + & 0.26169e-06_r8,0.72383e-04_r8,0.12481e-03_r8,0.16368e-03_r8,0.25205e-03_r8 /) + kbo(:, 4,21, 2) = (/ & + & 0.27885e-06_r8,0.83446e-04_r8,0.14258e-03_r8,0.18910e-03_r8,0.28386e-03_r8 /) + kbo(:, 5,21, 2) = (/ & + & 0.29344e-06_r8,0.95540e-04_r8,0.16198e-03_r8,0.21609e-03_r8,0.31947e-03_r8 /) + kbo(:, 1,22, 2) = (/ & + & 0.17941e-06_r8,0.45830e-04_r8,0.78176e-04_r8,0.10061e-03_r8,0.16313e-03_r8 /) + kbo(:, 2,22, 2) = (/ & + & 0.19397e-06_r8,0.53139e-04_r8,0.92556e-04_r8,0.11901e-03_r8,0.18482e-03_r8 /) + kbo(:, 3,22, 2) = (/ & + & 0.20707e-06_r8,0.61593e-04_r8,0.10579e-03_r8,0.14008e-03_r8,0.20965e-03_r8 /) + kbo(:, 4,22, 2) = (/ & + & 0.22071e-06_r8,0.71016e-04_r8,0.12100e-03_r8,0.16128e-03_r8,0.23661e-03_r8 /) + kbo(:, 5,22, 2) = (/ & + & 0.23148e-06_r8,0.81286e-04_r8,0.13795e-03_r8,0.18401e-03_r8,0.26580e-03_r8 /) + kbo(:, 1,23, 2) = (/ & + & 0.14291e-06_r8,0.38825e-04_r8,0.66866e-04_r8,0.86140e-04_r8,0.13511e-03_r8 /) + kbo(:, 2,23, 2) = (/ & + & 0.15179e-06_r8,0.45135e-04_r8,0.78450e-04_r8,0.10194e-03_r8,0.15369e-03_r8 /) + kbo(:, 3,23, 2) = (/ & + & 0.16326e-06_r8,0.52399e-04_r8,0.89919e-04_r8,0.12001e-03_r8,0.17441e-03_r8 /) + kbo(:, 4,23, 2) = (/ & + & 0.17307e-06_r8,0.60440e-04_r8,0.10293e-03_r8,0.13735e-03_r8,0.19668e-03_r8 /) + kbo(:, 5,23, 2) = (/ & + & 0.18137e-06_r8,0.69189e-04_r8,0.11759e-03_r8,0.15651e-03_r8,0.21998e-03_r8 /) + kbo(:, 1,24, 2) = (/ & + & 0.11245e-06_r8,0.32862e-04_r8,0.57166e-04_r8,0.73828e-04_r8,0.11185e-03_r8 /) + kbo(:, 2,24, 2) = (/ & + & 0.11958e-06_r8,0.38281e-04_r8,0.66635e-04_r8,0.87390e-04_r8,0.12740e-03_r8 /) + kbo(:, 3,24, 2) = (/ & + & 0.12702e-06_r8,0.44519e-04_r8,0.76606e-04_r8,0.10190e-03_r8,0.14418e-03_r8 /) + kbo(:, 4,24, 2) = (/ & + & 0.13467e-06_r8,0.51373e-04_r8,0.87622e-04_r8,0.11700e-03_r8,0.16205e-03_r8 /) + kbo(:, 5,24, 2) = (/ & + & 0.14120e-06_r8,0.58874e-04_r8,0.10019e-03_r8,0.13348e-03_r8,0.18188e-03_r8 /) + kbo(:, 1,25, 2) = (/ & + & 0.88242e-07_r8,0.27950e-04_r8,0.49010e-04_r8,0.63434e-04_r8,0.92877e-04_r8 /) + kbo(:, 2,25, 2) = (/ & + & 0.94383e-07_r8,0.32610e-04_r8,0.56690e-04_r8,0.75114e-04_r8,0.10531e-03_r8 /) + kbo(:, 3,25, 2) = (/ & + & 0.99712e-07_r8,0.37929e-04_r8,0.65204e-04_r8,0.87113e-04_r8,0.11931e-03_r8 /) + kbo(:, 4,25, 2) = (/ & + & 0.10473e-06_r8,0.43778e-04_r8,0.74805e-04_r8,0.99950e-04_r8,0.13427e-03_r8 /) + kbo(:, 5,25, 2) = (/ & + & 0.10988e-06_r8,0.50229e-04_r8,0.85598e-04_r8,0.11406e-03_r8,0.15050e-03_r8 /) + kbo(:, 1,26, 2) = (/ & + & 0.69696e-07_r8,0.23895e-04_r8,0.42166e-04_r8,0.54733e-04_r8,0.77146e-04_r8 /) + kbo(:, 2,26, 2) = (/ & + & 0.74390e-07_r8,0.27921e-04_r8,0.48387e-04_r8,0.64817e-04_r8,0.87607e-04_r8 /) + kbo(:, 3,26, 2) = (/ & + & 0.78856e-07_r8,0.32497e-04_r8,0.55692e-04_r8,0.74691e-04_r8,0.99387e-04_r8 /) + kbo(:, 4,26, 2) = (/ & + & 0.83253e-07_r8,0.37491e-04_r8,0.64130e-04_r8,0.85609e-04_r8,0.11193e-03_r8 /) + kbo(:, 5,26, 2) = (/ & + & 0.87675e-07_r8,0.43011e-04_r8,0.73398e-04_r8,0.97828e-04_r8,0.12574e-03_r8 /) + kbo(:, 1,27, 2) = (/ & + & 0.54619e-07_r8,0.20469e-04_r8,0.35869e-04_r8,0.47259e-04_r8,0.64151e-04_r8 /) + kbo(:, 2,27, 2) = (/ & + & 0.58657e-07_r8,0.23925e-04_r8,0.41468e-04_r8,0.55499e-04_r8,0.72911e-04_r8 /) + kbo(:, 3,27, 2) = (/ & + & 0.62532e-07_r8,0.27839e-04_r8,0.47735e-04_r8,0.63985e-04_r8,0.82955e-04_r8 /) + kbo(:, 4,27, 2) = (/ & + & 0.66184e-07_r8,0.32141e-04_r8,0.55001e-04_r8,0.73456e-04_r8,0.93567e-04_r8 /) + kbo(:, 5,27, 2) = (/ & + & 0.69305e-07_r8,0.36605e-04_r8,0.62968e-04_r8,0.83938e-04_r8,0.10517e-03_r8 /) + kbo(:, 1,28, 2) = (/ & + & 0.43348e-07_r8,0.17476e-04_r8,0.30692e-04_r8,0.40803e-04_r8,0.53271e-04_r8 /) + kbo(:, 2,28, 2) = (/ & + & 0.46348e-07_r8,0.20496e-04_r8,0.35498e-04_r8,0.47629e-04_r8,0.60809e-04_r8 /) + kbo(:, 3,28, 2) = (/ & + & 0.49507e-07_r8,0.23857e-04_r8,0.40974e-04_r8,0.54947e-04_r8,0.69222e-04_r8 /) + kbo(:, 4,28, 2) = (/ & + & 0.52419e-07_r8,0.27560e-04_r8,0.47205e-04_r8,0.63044e-04_r8,0.78123e-04_r8 /) + kbo(:, 5,28, 2) = (/ & + & 0.54842e-07_r8,0.31094e-04_r8,0.54028e-04_r8,0.72116e-04_r8,0.87834e-04_r8 /) + kbo(:, 1,29, 2) = (/ & + & 0.34480e-07_r8,0.15027e-04_r8,0.26268e-04_r8,0.35358e-04_r8,0.44711e-04_r8 /) + kbo(:, 2,29, 2) = (/ & + & 0.36985e-07_r8,0.17638e-04_r8,0.30405e-04_r8,0.40938e-04_r8,0.51054e-04_r8 /) + kbo(:, 3,29, 2) = (/ & + & 0.39476e-07_r8,0.20512e-04_r8,0.35237e-04_r8,0.47207e-04_r8,0.58034e-04_r8 /) + kbo(:, 4,29, 2) = (/ & + & 0.41650e-07_r8,0.23694e-04_r8,0.40586e-04_r8,0.54286e-04_r8,0.65708e-04_r8 /) + kbo(:, 5,29, 2) = (/ & + & 0.43693e-07_r8,0.26438e-04_r8,0.46467e-04_r8,0.62035e-04_r8,0.73872e-04_r8 /) + kbo(:, 1,30, 2) = (/ & + & 0.27402e-07_r8,0.12932e-04_r8,0.22585e-04_r8,0.30365e-04_r8,0.37471e-04_r8 /) + kbo(:, 2,30, 2) = (/ & + & 0.29377e-07_r8,0.15183e-04_r8,0.26158e-04_r8,0.35195e-04_r8,0.42867e-04_r8 /) + kbo(:, 3,30, 2) = (/ & + & 0.31353e-07_r8,0.17658e-04_r8,0.30343e-04_r8,0.40606e-04_r8,0.48858e-04_r8 /) + kbo(:, 4,30, 2) = (/ & + & 0.33056e-07_r8,0.20286e-04_r8,0.34924e-04_r8,0.46735e-04_r8,0.55329e-04_r8 /) + kbo(:, 5,30, 2) = (/ & + & 0.34673e-07_r8,0.22451e-04_r8,0.39717e-04_r8,0.53329e-04_r8,0.62151e-04_r8 /) + kbo(:, 1,31, 2) = (/ & + & 0.21716e-07_r8,0.11156e-04_r8,0.19427e-04_r8,0.26169e-04_r8,0.31512e-04_r8 /) + kbo(:, 2,31, 2) = (/ & + & 0.23313e-07_r8,0.13091e-04_r8,0.22568e-04_r8,0.30377e-04_r8,0.36216e-04_r8 /) + kbo(:, 3,31, 2) = (/ & + & 0.24803e-07_r8,0.15221e-04_r8,0.26157e-04_r8,0.35050e-04_r8,0.41256e-04_r8 /) + kbo(:, 4,31, 2) = (/ & + & 0.26260e-07_r8,0.17277e-04_r8,0.30091e-04_r8,0.40288e-04_r8,0.46693e-04_r8 /) + kbo(:, 5,31, 2) = (/ & + & 0.27334e-07_r8,0.19159e-04_r8,0.33773e-04_r8,0.45892e-04_r8,0.52314e-04_r8 /) + kbo(:, 1,32, 2) = (/ & + & 0.17123e-07_r8,0.96453e-05_r8,0.16688e-04_r8,0.22528e-04_r8,0.26648e-04_r8 /) + kbo(:, 2,32, 2) = (/ & + & 0.18489e-07_r8,0.11305e-04_r8,0.19464e-04_r8,0.26137e-04_r8,0.30617e-04_r8 /) + kbo(:, 3,32, 2) = (/ & + & 0.19621e-07_r8,0.13143e-04_r8,0.22554e-04_r8,0.30238e-04_r8,0.34876e-04_r8 /) + kbo(:, 4,32, 2) = (/ & + & 0.20653e-07_r8,0.14698e-04_r8,0.25928e-04_r8,0.34712e-04_r8,0.39398e-04_r8 /) + kbo(:, 5,32, 2) = (/ & + & 0.21500e-07_r8,0.16315e-04_r8,0.28651e-04_r8,0.39302e-04_r8,0.44097e-04_r8 /) + kbo(:, 1,33, 2) = (/ & + & 0.13414e-07_r8,0.83355e-05_r8,0.14409e-04_r8,0.19461e-04_r8,0.22582e-04_r8 /) + kbo(:, 2,33, 2) = (/ & + & 0.14456e-07_r8,0.97647e-05_r8,0.16818e-04_r8,0.22578e-04_r8,0.25923e-04_r8 /) + kbo(:, 3,33, 2) = (/ & + & 0.15416e-07_r8,0.11250e-04_r8,0.19451e-04_r8,0.26119e-04_r8,0.29482e-04_r8 /) + kbo(:, 4,33, 2) = (/ & + & 0.16184e-07_r8,0.12520e-04_r8,0.22064e-04_r8,0.29911e-04_r8,0.33230e-04_r8 /) + kbo(:, 5,33, 2) = (/ & + & 0.16861e-07_r8,0.13810e-04_r8,0.24332e-04_r8,0.33363e-04_r8,0.37135e-04_r8 /) + kbo(:, 1,34, 2) = (/ & + & 0.10575e-07_r8,0.71786e-05_r8,0.12407e-04_r8,0.16719e-04_r8,0.19158e-04_r8 /) + kbo(:, 2,34, 2) = (/ & + & 0.11328e-07_r8,0.84093e-05_r8,0.14457e-04_r8,0.19433e-04_r8,0.21940e-04_r8 /) + kbo(:, 3,34, 2) = (/ & + & 0.12049e-07_r8,0.95860e-05_r8,0.16718e-04_r8,0.22425e-04_r8,0.24932e-04_r8 /) + kbo(:, 4,34, 2) = (/ & + & 0.12689e-07_r8,0.10655e-04_r8,0.18771e-04_r8,0.25647e-04_r8,0.28065e-04_r8 /) + kbo(:, 5,34, 2) = (/ & + & 0.13241e-07_r8,0.11703e-04_r8,0.20628e-04_r8,0.28184e-04_r8,0.31323e-04_r8 /) + kbo(:, 1,35, 2) = (/ & + & 0.82489e-08_r8,0.60850e-05_r8,0.10505e-04_r8,0.14140e-04_r8,0.16004e-04_r8 /) + kbo(:, 2,35, 2) = (/ & + & 0.88532e-08_r8,0.71306e-05_r8,0.12250e-04_r8,0.16463e-04_r8,0.18333e-04_r8 /) + kbo(:, 3,35, 2) = (/ & + & 0.93468e-08_r8,0.80269e-05_r8,0.14158e-04_r8,0.18989e-04_r8,0.20835e-04_r8 /) + kbo(:, 4,35, 2) = (/ & + & 0.98478e-08_r8,0.89450e-05_r8,0.15691e-04_r8,0.21576e-04_r8,0.23428e-04_r8 /) + kbo(:, 5,35, 2) = (/ & + & 0.10332e-07_r8,0.98354e-05_r8,0.17293e-04_r8,0.23618e-04_r8,0.26128e-04_r8 /) + kbo(:, 1,36, 2) = (/ & + & 0.63951e-08_r8,0.50545e-05_r8,0.87378e-05_r8,0.11778e-04_r8,0.13176e-04_r8 /) + kbo(:, 2,36, 2) = (/ & + & 0.68252e-08_r8,0.59348e-05_r8,0.10193e-04_r8,0.13730e-04_r8,0.15104e-04_r8 /) + kbo(:, 3,36, 2) = (/ & + & 0.72445e-08_r8,0.66480e-05_r8,0.11783e-04_r8,0.15832e-04_r8,0.17160e-04_r8 /) + kbo(:, 4,36, 2) = (/ & + & 0.75871e-08_r8,0.73960e-05_r8,0.13005e-04_r8,0.17866e-04_r8,0.19295e-04_r8 /) + kbo(:, 5,36, 2) = (/ & + & 0.79075e-08_r8,0.81558e-05_r8,0.14306e-04_r8,0.19617e-04_r8,0.21532e-04_r8 /) + kbo(:, 1,37, 2) = (/ & + & 0.50574e-08_r8,0.41215e-05_r8,0.71249e-05_r8,0.95923e-05_r8,0.10686e-04_r8 /) + kbo(:, 2,37, 2) = (/ & + & 0.53967e-08_r8,0.48518e-05_r8,0.83286e-05_r8,0.11206e-04_r8,0.12269e-04_r8 /) + kbo(:, 3,37, 2) = (/ & + & 0.57517e-08_r8,0.54411e-05_r8,0.96383e-05_r8,0.12942e-04_r8,0.13958e-04_r8 /) + kbo(:, 4,37, 2) = (/ & + & 0.60273e-08_r8,0.60590e-05_r8,0.10644e-04_r8,0.14619e-04_r8,0.15714e-04_r8 /) + kbo(:, 5,37, 2) = (/ & + & 0.62775e-08_r8,0.66900e-05_r8,0.11723e-04_r8,0.16077e-04_r8,0.17560e-04_r8 /) + kbo(:, 1,38, 2) = (/ & + & 0.39948e-08_r8,0.33535e-05_r8,0.57976e-05_r8,0.77989e-05_r8,0.86548e-05_r8 /) + kbo(:, 2,38, 2) = (/ & + & 0.42642e-08_r8,0.39584e-05_r8,0.67932e-05_r8,0.91290e-05_r8,0.99507e-05_r8 /) + kbo(:, 3,38, 2) = (/ & + & 0.45529e-08_r8,0.44478e-05_r8,0.78746e-05_r8,0.10563e-04_r8,0.11338e-04_r8 /) + kbo(:, 4,38, 2) = (/ & + & 0.47911e-08_r8,0.49592e-05_r8,0.87019e-05_r8,0.11950e-04_r8,0.12783e-04_r8 /) + kbo(:, 5,38, 2) = (/ & + & 0.49959e-08_r8,0.54820e-05_r8,0.95964e-05_r8,0.13155e-04_r8,0.14308e-04_r8 /) + kbo(:, 1,39, 2) = (/ & + & 0.31607e-08_r8,0.27260e-05_r8,0.47143e-05_r8,0.63381e-05_r8,0.70094e-05_r8 /) + kbo(:, 2,39, 2) = (/ & + & 0.33771e-08_r8,0.32263e-05_r8,0.55352e-05_r8,0.74322e-05_r8,0.80695e-05_r8 /) + kbo(:, 3,39, 2) = (/ & + & 0.35907e-08_r8,0.36316e-05_r8,0.64256e-05_r8,0.86133e-05_r8,0.92019e-05_r8 /) + kbo(:, 4,39, 2) = (/ & + & 0.37920e-08_r8,0.40555e-05_r8,0.71128e-05_r8,0.97677e-05_r8,0.10392e-04_r8 /) + kbo(:, 5,39, 2) = (/ & + & 0.39687e-08_r8,0.44882e-05_r8,0.78499e-05_r8,0.10753e-04_r8,0.11647e-04_r8 /) + kbo(:, 1,40, 2) = (/ & + & 0.25137e-08_r8,0.21782e-05_r8,0.37700e-05_r8,0.50636e-05_r8,0.55872e-05_r8 /) + kbo(:, 2,40, 2) = (/ & + & 0.26953e-08_r8,0.25872e-05_r8,0.44411e-05_r8,0.59538e-05_r8,0.64693e-05_r8 /) + kbo(:, 3,40, 2) = (/ & + & 0.28738e-08_r8,0.29415e-05_r8,0.51697e-05_r8,0.69217e-05_r8,0.73806e-05_r8 /) + kbo(:, 4,40, 2) = (/ & + & 0.30365e-08_r8,0.32887e-05_r8,0.57574e-05_r8,0.79115e-05_r8,0.83547e-05_r8 /) + kbo(:, 5,40, 2) = (/ & + & 0.31827e-08_r8,0.36391e-05_r8,0.63730e-05_r8,0.87114e-05_r8,0.93854e-05_r8 /) + kbo(:, 1,41, 2) = (/ & + & 0.20049e-08_r8,0.17350e-05_r8,0.30089e-05_r8,0.40342e-05_r8,0.44437e-05_r8 /) + kbo(:, 2,41, 2) = (/ & + & 0.21522e-08_r8,0.20685e-05_r8,0.35532e-05_r8,0.47542e-05_r8,0.51577e-05_r8 /) + kbo(:, 3,41, 2) = (/ & + & 0.22978e-08_r8,0.23716e-05_r8,0.41490e-05_r8,0.55459e-05_r8,0.59029e-05_r8 /) + kbo(:, 4,41, 2) = (/ & + & 0.24277e-08_r8,0.26608e-05_r8,0.46585e-05_r8,0.63928e-05_r8,0.67015e-05_r8 /) + kbo(:, 5,41, 2) = (/ & + & 0.25592e-08_r8,0.29434e-05_r8,0.51614e-05_r8,0.70376e-05_r8,0.75472e-05_r8 /) + kbo(:, 1,42, 2) = (/ & + & 0.16007e-08_r8,0.13793e-05_r8,0.23939e-05_r8,0.32203e-05_r8,0.35347e-05_r8 /) + kbo(:, 2,42, 2) = (/ & + & 0.17182e-08_r8,0.16509e-05_r8,0.28388e-05_r8,0.37950e-05_r8,0.41069e-05_r8 /) + kbo(:, 3,42, 2) = (/ & + & 0.18364e-08_r8,0.19058e-05_r8,0.33250e-05_r8,0.44386e-05_r8,0.47169e-05_r8 /) + kbo(:, 4,42, 2) = (/ & + & 0.19459e-08_r8,0.21436e-05_r8,0.37676e-05_r8,0.51389e-05_r8,0.53710e-05_r8 /) + kbo(:, 5,42, 2) = (/ & + & 0.20555e-08_r8,0.23781e-05_r8,0.41722e-05_r8,0.56915e-05_r8,0.60613e-05_r8 /) + kbo(:, 1,43, 2) = (/ & + & 0.12763e-08_r8,0.10855e-05_r8,0.18842e-05_r8,0.25355e-05_r8,0.27894e-05_r8 /) + kbo(:, 2,43, 2) = (/ & + & 0.13693e-08_r8,0.13038e-05_r8,0.22434e-05_r8,0.29991e-05_r8,0.32452e-05_r8 /) + kbo(:, 3,43, 2) = (/ & + & 0.14669e-08_r8,0.15227e-05_r8,0.26394e-05_r8,0.35195e-05_r8,0.37403e-05_r8 /) + kbo(:, 4,43, 2) = (/ & + & 0.15621e-08_r8,0.17145e-05_r8,0.30188e-05_r8,0.40881e-05_r8,0.42757e-05_r8 /) + kbo(:, 5,43, 2) = (/ & + & 0.16467e-08_r8,0.19093e-05_r8,0.33481e-05_r8,0.45768e-05_r8,0.48357e-05_r8 /) + kbo(:, 1,44, 2) = (/ & + & 0.10164e-08_r8,0.84908e-06_r8,0.14741e-05_r8,0.19864e-05_r8,0.21744e-05_r8 /) + kbo(:, 2,44, 2) = (/ & + & 0.10926e-08_r8,0.10232e-05_r8,0.17642e-05_r8,0.23536e-05_r8,0.25562e-05_r8 /) + kbo(:, 3,44, 2) = (/ & + & 0.11717e-08_r8,0.12156e-05_r8,0.20836e-05_r8,0.27750e-05_r8,0.29547e-05_r8 /) + kbo(:, 4,44, 2) = (/ & + & 0.12502e-08_r8,0.13671e-05_r8,0.24149e-05_r8,0.32374e-05_r8,0.33856e-05_r8 /) + kbo(:, 5,44, 2) = (/ & + & 0.13204e-08_r8,0.15290e-05_r8,0.26801e-05_r8,0.36631e-05_r8,0.38430e-05_r8 /) + kbo(:, 1,45, 2) = (/ & + & 0.80967e-09_r8,0.66247e-06_r8,0.11525e-05_r8,0.15557e-05_r8,0.16911e-05_r8 /) + kbo(:, 2,45, 2) = (/ & + & 0.87091e-09_r8,0.80114e-06_r8,0.13838e-05_r8,0.18457e-05_r8,0.20071e-05_r8 /) + kbo(:, 3,45, 2) = (/ & + & 0.93471e-09_r8,0.96063e-06_r8,0.16414e-05_r8,0.21862e-05_r8,0.23357e-05_r8 /) + kbo(:, 4,45, 2) = (/ & + & 0.99996e-09_r8,0.10898e-05_r8,0.19287e-05_r8,0.25587e-05_r8,0.26765e-05_r8 /) + kbo(:, 5,45, 2) = (/ & + & 0.10594e-08_r8,0.12255e-05_r8,0.21437e-05_r8,0.29239e-05_r8,0.30491e-05_r8 /) + kbo(:, 1,46, 2) = (/ & + & 0.64438e-09_r8,0.51408e-06_r8,0.89692e-06_r8,0.12176e-05_r8,0.13094e-05_r8 /) + kbo(:, 2,46, 2) = (/ & + & 0.69338e-09_r8,0.62335e-06_r8,0.10783e-05_r8,0.14408e-05_r8,0.15697e-05_r8 /) + kbo(:, 3,46, 2) = (/ & + & 0.74249e-09_r8,0.75197e-06_r8,0.12859e-05_r8,0.17116e-05_r8,0.18286e-05_r8 /) + kbo(:, 4,46, 2) = (/ & + & 0.79710e-09_r8,0.86785e-06_r8,0.15182e-05_r8,0.20117e-05_r8,0.21072e-05_r8 /) + kbo(:, 5,46, 2) = (/ & + & 0.84966e-09_r8,0.97923e-06_r8,0.17156e-05_r8,0.23354e-05_r8,0.24096e-05_r8 /) + kbo(:, 1,47, 2) = (/ & + & 0.51236e-09_r8,0.39483e-06_r8,0.69100e-06_r8,0.94871e-06_r8,0.10050e-05_r8 /) + kbo(:, 2,47, 2) = (/ & + & 0.55075e-09_r8,0.48075e-06_r8,0.83326e-06_r8,0.11171e-05_r8,0.12169e-05_r8 /) + kbo(:, 3,47, 2) = (/ & + & 0.59153e-09_r8,0.58279e-06_r8,0.99922e-06_r8,0.13307e-05_r8,0.14227e-05_r8 /) + kbo(:, 4,47, 2) = (/ & + & 0.63485e-09_r8,0.68347e-06_r8,0.11845e-05_r8,0.15696e-05_r8,0.16474e-05_r8 /) + kbo(:, 5,47, 2) = (/ & + & 0.67833e-09_r8,0.77359e-06_r8,0.13593e-05_r8,0.18329e-05_r8,0.18933e-05_r8 /) + kbo(:, 1,48, 2) = (/ & + & 0.40749e-09_r8,0.30162e-06_r8,0.53408e-06_r8,0.72777e-06_r8,0.76768e-06_r8 /) + kbo(:, 2,48, 2) = (/ & + & 0.43682e-09_r8,0.36975e-06_r8,0.64201e-06_r8,0.86174e-06_r8,0.93334e-06_r8 /) + kbo(:, 3,48, 2) = (/ & + & 0.46981e-09_r8,0.45015e-06_r8,0.77460e-06_r8,0.10306e-05_r8,0.11092e-05_r8 /) + kbo(:, 4,48, 2) = (/ & + & 0.50302e-09_r8,0.53912e-06_r8,0.92171e-06_r8,0.12225e-05_r8,0.12874e-05_r8 /) + kbo(:, 5,48, 2) = (/ & + & 0.53999e-09_r8,0.61013e-06_r8,0.10790e-05_r8,0.14334e-05_r8,0.14828e-05_r8 /) + kbo(:, 1,49, 2) = (/ & + & 0.32288e-09_r8,0.23115e-06_r8,0.41625e-06_r8,0.55318e-06_r8,0.58476e-06_r8 /) + kbo(:, 2,49, 2) = (/ & + & 0.34731e-09_r8,0.28355e-06_r8,0.49493e-06_r8,0.66850e-06_r8,0.71600e-06_r8 /) + kbo(:, 3,49, 2) = (/ & + & 0.37310e-09_r8,0.34682e-06_r8,0.59820e-06_r8,0.79617e-06_r8,0.85985e-06_r8 /) + kbo(:, 4,49, 2) = (/ & + & 0.39975e-09_r8,0.42034e-06_r8,0.71527e-06_r8,0.95046e-06_r8,0.10041e-05_r8 /) + kbo(:, 5,49, 2) = (/ & + & 0.42970e-09_r8,0.48341e-06_r8,0.84829e-06_r8,0.11191e-05_r8,0.11582e-05_r8 /) + kbo(:, 1,50, 2) = (/ & + & 0.25646e-09_r8,0.17743e-06_r8,0.32423e-06_r8,0.42175e-06_r8,0.44754e-06_r8 /) + kbo(:, 2,50, 2) = (/ & + & 0.27669e-09_r8,0.21856e-06_r8,0.38220e-06_r8,0.52102e-06_r8,0.55141e-06_r8 /) + kbo(:, 3,50, 2) = (/ & + & 0.29654e-09_r8,0.26808e-06_r8,0.46375e-06_r8,0.61921e-06_r8,0.67025e-06_r8 /) + kbo(:, 4,50, 2) = (/ & + & 0.31872e-09_r8,0.32662e-06_r8,0.55687e-06_r8,0.73985e-06_r8,0.78291e-06_r8 /) + kbo(:, 5,50, 2) = (/ & + & 0.34198e-09_r8,0.38136e-06_r8,0.66385e-06_r8,0.87591e-06_r8,0.90771e-06_r8 /) + kbo(:, 1,51, 2) = (/ & + & 0.20472e-09_r8,0.13694e-06_r8,0.24726e-06_r8,0.32216e-06_r8,0.34229e-06_r8 /) + kbo(:, 2,51, 2) = (/ & + & 0.22054e-09_r8,0.16842e-06_r8,0.29646e-06_r8,0.40635e-06_r8,0.42402e-06_r8 /) + kbo(:, 3,51, 2) = (/ & + & 0.23653e-09_r8,0.20731e-06_r8,0.35913e-06_r8,0.48027e-06_r8,0.51714e-06_r8 /) + kbo(:, 4,51, 2) = (/ & + & 0.25402e-09_r8,0.25379e-06_r8,0.43377e-06_r8,0.57689e-06_r8,0.61228e-06_r8 /) + kbo(:, 5,51, 2) = (/ & + & 0.27233e-09_r8,0.30202e-06_r8,0.51940e-06_r8,0.68626e-06_r8,0.71146e-06_r8 /) + kbo(:, 1,52, 2) = (/ & + & 0.16428e-09_r8,0.10687e-06_r8,0.18803e-06_r8,0.24517e-06_r8,0.26090e-06_r8 /) + kbo(:, 2,52, 2) = (/ & + & 0.17520e-09_r8,0.12978e-06_r8,0.23025e-06_r8,0.31106e-06_r8,0.32512e-06_r8 /) + kbo(:, 3,52, 2) = (/ & + & 0.18865e-09_r8,0.15994e-06_r8,0.27726e-06_r8,0.37261e-06_r8,0.39888e-06_r8 /) + kbo(:, 4,52, 2) = (/ & + & 0.20265e-09_r8,0.19670e-06_r8,0.33708e-06_r8,0.44845e-06_r8,0.47779e-06_r8 /) + kbo(:, 5,52, 2) = (/ & + & 0.21711e-09_r8,0.23739e-06_r8,0.40528e-06_r8,0.53668e-06_r8,0.55828e-06_r8 /) + kbo(:, 1,53, 2) = (/ & + & 0.13206e-09_r8,0.82677e-07_r8,0.14284e-06_r8,0.18640e-06_r8,0.19898e-06_r8 /) + kbo(:, 2,53, 2) = (/ & + & 0.13938e-09_r8,0.99597e-07_r8,0.18095e-06_r8,0.23725e-06_r8,0.24911e-06_r8 /) + kbo(:, 3,53, 2) = (/ & + & 0.15056e-09_r8,0.12309e-06_r8,0.21494e-06_r8,0.29026e-06_r8,0.30720e-06_r8 /) + kbo(:, 4,53, 2) = (/ & + & 0.16136e-09_r8,0.15205e-06_r8,0.26147e-06_r8,0.34774e-06_r8,0.37331e-06_r8 /) + kbo(:, 5,53, 2) = (/ & + & 0.17318e-09_r8,0.18547e-06_r8,0.31566e-06_r8,0.41857e-06_r8,0.43649e-06_r8 /) + kbo(:, 1,54, 2) = (/ & + & 0.10628e-09_r8,0.63529e-07_r8,0.10938e-06_r8,0.14285e-06_r8,0.15281e-06_r8 /) + kbo(:, 2,54, 2) = (/ & + & 0.11181e-09_r8,0.77068e-07_r8,0.14036e-06_r8,0.18201e-06_r8,0.19163e-06_r8 /) + kbo(:, 3,54, 2) = (/ & + & 0.11992e-09_r8,0.95387e-07_r8,0.16692e-06_r8,0.22878e-06_r8,0.23824e-06_r8 /) + kbo(:, 4,54, 2) = (/ & + & 0.12900e-09_r8,0.11809e-06_r8,0.20406e-06_r8,0.27163e-06_r8,0.29078e-06_r8 /) + kbo(:, 5,54, 2) = (/ & + & 0.13828e-09_r8,0.14510e-06_r8,0.24678e-06_r8,0.32753e-06_r8,0.34217e-06_r8 /) + kbo(:, 1,55, 2) = (/ & + & 0.85664e-10_r8,0.48444e-07_r8,0.83932e-07_r8,0.10950e-06_r8,0.11785e-06_r8 /) + kbo(:, 2,55, 2) = (/ & + & 0.89999e-10_r8,0.59885e-07_r8,0.10776e-06_r8,0.14023e-06_r8,0.14763e-06_r8 /) + kbo(:, 3,55, 2) = (/ & + & 0.95836e-10_r8,0.73941e-07_r8,0.13023e-06_r8,0.17876e-06_r8,0.18426e-06_r8 /) + kbo(:, 4,55, 2) = (/ & + & 0.10323e-09_r8,0.91791e-07_r8,0.15882e-06_r8,0.21202e-06_r8,0.22611e-06_r8 /) + kbo(:, 5,55, 2) = (/ & + & 0.11081e-09_r8,0.11336e-06_r8,0.19316e-06_r8,0.25647e-06_r8,0.26918e-06_r8 /) + kbo(:, 1,56, 2) = (/ & + & 0.69093e-10_r8,0.36832e-07_r8,0.64123e-07_r8,0.84030e-07_r8,0.90974e-07_r8 /) + kbo(:, 2,56, 2) = (/ & + & 0.72433e-10_r8,0.47084e-07_r8,0.82613e-07_r8,0.10758e-06_r8,0.11346e-06_r8 /) + kbo(:, 3,56, 2) = (/ & + & 0.76616e-10_r8,0.57388e-07_r8,0.10182e-06_r8,0.13768e-06_r8,0.14224e-06_r8 /) + kbo(:, 4,56, 2) = (/ & + & 0.82709e-10_r8,0.71294e-07_r8,0.12355e-06_r8,0.16530e-06_r8,0.17549e-06_r8 /) + kbo(:, 5,56, 2) = (/ & + & 0.88636e-10_r8,0.88445e-07_r8,0.15094e-06_r8,0.20067e-06_r8,0.21118e-06_r8 /) + kbo(:, 1,57, 2) = (/ & + & 0.55980e-10_r8,0.28018e-07_r8,0.48867e-07_r8,0.64857e-07_r8,0.70055e-07_r8 /) + kbo(:, 2,57, 2) = (/ & + & 0.58397e-10_r8,0.36620e-07_r8,0.63232e-07_r8,0.82428e-07_r8,0.87457e-07_r8 /) + kbo(:, 3,57, 2) = (/ & + & 0.61509e-10_r8,0.44446e-07_r8,0.80512e-07_r8,0.10580e-06_r8,0.10988e-06_r8 /) + kbo(:, 4,57, 2) = (/ & + & 0.66015e-10_r8,0.55222e-07_r8,0.96401e-07_r8,0.12935e-06_r8,0.13614e-06_r8 /) + kbo(:, 5,57, 2) = (/ & + & 0.70976e-10_r8,0.68821e-07_r8,0.11780e-06_r8,0.15632e-06_r8,0.16586e-06_r8 /) + kbo(:, 1,58, 2) = (/ & + & 0.45722e-10_r8,0.21506e-07_r8,0.37326e-07_r8,0.50333e-07_r8,0.54855e-07_r8 /) + kbo(:, 2,58, 2) = (/ & + & 0.47090e-10_r8,0.28249e-07_r8,0.48612e-07_r8,0.63442e-07_r8,0.67550e-07_r8 /) + kbo(:, 3,58, 2) = (/ & + & 0.49550e-10_r8,0.34430e-07_r8,0.62769e-07_r8,0.81509e-07_r8,0.84917e-07_r8 /) + kbo(:, 4,58, 2) = (/ & + & 0.52817e-10_r8,0.42958e-07_r8,0.75173e-07_r8,0.10204e-06_r8,0.10603e-06_r8 /) + kbo(:, 5,58, 2) = (/ & + & 0.56864e-10_r8,0.53637e-07_r8,0.92044e-07_r8,0.12229e-06_r8,0.13011e-06_r8 /) + kbo(:, 1,59, 2) = (/ & + & 0.37496e-10_r8,0.17255e-07_r8,0.29967e-07_r8,0.40394e-07_r8,0.44059e-07_r8 /) + kbo(:, 2,59, 2) = (/ & + & 0.38367e-10_r8,0.22782e-07_r8,0.39144e-07_r8,0.51019e-07_r8,0.54404e-07_r8 /) + kbo(:, 3,59, 2) = (/ & + & 0.40346e-10_r8,0.27842e-07_r8,0.50692e-07_r8,0.65716e-07_r8,0.68440e-07_r8 /) + kbo(:, 4,59, 2) = (/ & + & 0.42908e-10_r8,0.34761e-07_r8,0.60846e-07_r8,0.82834e-07_r8,0.85713e-07_r8 /) + kbo(:, 5,59, 2) = (/ & + & 0.46213e-10_r8,0.43467e-07_r8,0.74626e-07_r8,0.99144e-07_r8,0.10518e-06_r8 /) + kbo(:, 1,13, 3) = (/ & + & 0.91180e-05_r8,0.12754e-02_r8,0.19900e-02_r8,0.24440e-02_r8,0.40576e-02_r8 /) + kbo(:, 2,13, 3) = (/ & + & 0.95037e-05_r8,0.14150e-02_r8,0.22145e-02_r8,0.28094e-02_r8,0.44375e-02_r8 /) + kbo(:, 3,13, 3) = (/ & + & 0.99757e-05_r8,0.15626e-02_r8,0.24320e-02_r8,0.31375e-02_r8,0.48097e-02_r8 /) + kbo(:, 4,13, 3) = (/ & + & 0.10508e-04_r8,0.16997e-02_r8,0.26926e-02_r8,0.34483e-02_r8,0.51554e-02_r8 /) + kbo(:, 5,13, 3) = (/ & + & 0.11033e-04_r8,0.18373e-02_r8,0.29684e-02_r8,0.37861e-02_r8,0.54896e-02_r8 /) + kbo(:, 1,14, 3) = (/ & + & 0.73209e-05_r8,0.10727e-02_r8,0.16787e-02_r8,0.20881e-02_r8,0.33041e-02_r8 /) + kbo(:, 2,14, 3) = (/ & + & 0.76795e-05_r8,0.11937e-02_r8,0.18683e-02_r8,0.23616e-02_r8,0.36246e-02_r8 /) + kbo(:, 3,14, 3) = (/ & + & 0.80417e-05_r8,0.13177e-02_r8,0.20567e-02_r8,0.26465e-02_r8,0.39438e-02_r8 /) + kbo(:, 4,14, 3) = (/ & + & 0.84296e-05_r8,0.14317e-02_r8,0.22826e-02_r8,0.29022e-02_r8,0.42368e-02_r8 /) + kbo(:, 5,14, 3) = (/ & + & 0.88950e-05_r8,0.15495e-02_r8,0.25084e-02_r8,0.31901e-02_r8,0.44992e-02_r8 /) + kbo(:, 1,15, 3) = (/ & + & 0.58275e-05_r8,0.89895e-03_r8,0.14161e-02_r8,0.17760e-02_r8,0.26508e-02_r8 /) + kbo(:, 2,15, 3) = (/ & + & 0.61166e-05_r8,0.10025e-02_r8,0.15706e-02_r8,0.19893e-02_r8,0.29219e-02_r8 /) + kbo(:, 3,15, 3) = (/ & + & 0.64340e-05_r8,0.11055e-02_r8,0.17375e-02_r8,0.22237e-02_r8,0.31718e-02_r8 /) + kbo(:, 4,15, 3) = (/ & + & 0.67501e-05_r8,0.12028e-02_r8,0.19291e-02_r8,0.24433e-02_r8,0.34015e-02_r8 /) + kbo(:, 5,15, 3) = (/ & + & 0.70843e-05_r8,0.13034e-02_r8,0.21152e-02_r8,0.26892e-02_r8,0.36350e-02_r8 /) + kbo(:, 1,16, 3) = (/ & + & 0.45776e-05_r8,0.75233e-03_r8,0.11906e-02_r8,0.14957e-02_r8,0.21076e-02_r8 /) + kbo(:, 2,16, 3) = (/ & + & 0.48262e-05_r8,0.84051e-03_r8,0.13192e-02_r8,0.16780e-02_r8,0.23267e-02_r8 /) + kbo(:, 3,16, 3) = (/ & + & 0.51024e-05_r8,0.92603e-03_r8,0.14653e-02_r8,0.18671e-02_r8,0.25242e-02_r8 /) + kbo(:, 4,16, 3) = (/ & + & 0.53856e-05_r8,0.10093e-02_r8,0.16288e-02_r8,0.20599e-02_r8,0.27134e-02_r8 /) + kbo(:, 5,16, 3) = (/ & + & 0.56625e-05_r8,0.10939e-02_r8,0.17834e-02_r8,0.22693e-02_r8,0.29092e-02_r8 /) + kbo(:, 1,17, 3) = (/ & + & 0.35978e-05_r8,0.63055e-03_r8,0.10001e-02_r8,0.12618e-02_r8,0.16759e-02_r8 /) + kbo(:, 2,17, 3) = (/ & + & 0.38090e-05_r8,0.70519e-03_r8,0.11080e-02_r8,0.14142e-02_r8,0.18563e-02_r8 /) + kbo(:, 3,17, 3) = (/ & + & 0.40365e-05_r8,0.77593e-03_r8,0.12352e-02_r8,0.15692e-02_r8,0.20215e-02_r8 /) + kbo(:, 4,17, 3) = (/ & + & 0.42692e-05_r8,0.84648e-03_r8,0.13753e-02_r8,0.17361e-02_r8,0.21882e-02_r8 /) + kbo(:, 5,17, 3) = (/ & + & 0.45325e-05_r8,0.91815e-03_r8,0.15031e-02_r8,0.19156e-02_r8,0.23511e-02_r8 /) + kbo(:, 1,18, 3) = (/ & + & 0.28577e-05_r8,0.52923e-03_r8,0.84060e-03_r8,0.10641e-02_r8,0.13524e-02_r8 /) + kbo(:, 2,18, 3) = (/ & + & 0.30189e-05_r8,0.59275e-03_r8,0.93264e-03_r8,0.11925e-02_r8,0.15051e-02_r8 /) + kbo(:, 3,18, 3) = (/ & + & 0.31971e-05_r8,0.65140e-03_r8,0.10422e-02_r8,0.13174e-02_r8,0.16413e-02_r8 /) + kbo(:, 4,18, 3) = (/ & + & 0.33981e-05_r8,0.71144e-03_r8,0.11594e-02_r8,0.14613e-02_r8,0.17851e-02_r8 /) + kbo(:, 5,18, 3) = (/ & + & 0.36127e-05_r8,0.77200e-03_r8,0.12685e-02_r8,0.16164e-02_r8,0.19166e-02_r8 /) + kbo(:, 1,19, 3) = (/ & + & 0.22832e-05_r8,0.44489e-03_r8,0.70523e-03_r8,0.89150e-03_r8,0.11054e-02_r8 /) + kbo(:, 2,19, 3) = (/ & + & 0.24005e-05_r8,0.49860e-03_r8,0.78596e-03_r8,0.10033e-02_r8,0.12310e-02_r8 /) + kbo(:, 3,19, 3) = (/ & + & 0.25465e-05_r8,0.54746e-03_r8,0.88096e-03_r8,0.11084e-02_r8,0.13479e-02_r8 /) + kbo(:, 4,19, 3) = (/ & + & 0.27167e-05_r8,0.59760e-03_r8,0.97685e-03_r8,0.12305e-02_r8,0.14668e-02_r8 /) + kbo(:, 5,19, 3) = (/ & + & 0.28927e-05_r8,0.64844e-03_r8,0.10695e-02_r8,0.13632e-02_r8,0.15746e-02_r8 /) + kbo(:, 1,20, 3) = (/ & + & 0.18426e-05_r8,0.37567e-03_r8,0.59276e-03_r8,0.75002e-03_r8,0.91159e-03_r8 /) + kbo(:, 2,20, 3) = (/ & + & 0.19324e-05_r8,0.42049e-03_r8,0.66376e-03_r8,0.84304e-03_r8,0.10175e-02_r8 /) + kbo(:, 3,20, 3) = (/ & + & 0.20563e-05_r8,0.46104e-03_r8,0.74561e-03_r8,0.93568e-03_r8,0.11153e-02_r8 /) + kbo(:, 4,20, 3) = (/ & + & 0.21952e-05_r8,0.50302e-03_r8,0.82491e-03_r8,0.10410e-02_r8,0.12131e-02_r8 /) + kbo(:, 5,20, 3) = (/ & + & 0.23429e-05_r8,0.54570e-03_r8,0.90324e-03_r8,0.11512e-02_r8,0.13002e-02_r8 /) + kbo(:, 1,21, 3) = (/ & + & 0.14914e-05_r8,0.31727e-03_r8,0.49879e-03_r8,0.63141e-03_r8,0.75480e-03_r8 /) + kbo(:, 2,21, 3) = (/ & + & 0.15711e-05_r8,0.35367e-03_r8,0.56105e-03_r8,0.70859e-03_r8,0.84278e-03_r8 /) + kbo(:, 3,21, 3) = (/ & + & 0.16720e-05_r8,0.38776e-03_r8,0.63122e-03_r8,0.79066e-03_r8,0.92492e-03_r8 /) + kbo(:, 4,21, 3) = (/ & + & 0.17830e-05_r8,0.42327e-03_r8,0.69655e-03_r8,0.88311e-03_r8,0.10041e-02_r8 /) + kbo(:, 5,21, 3) = (/ & + & 0.19065e-05_r8,0.45905e-03_r8,0.76238e-03_r8,0.97320e-03_r8,0.10767e-02_r8 /) + kbo(:, 1,22, 3) = (/ & + & 0.12007e-05_r8,0.26976e-03_r8,0.42316e-03_r8,0.53750e-03_r8,0.62747e-03_r8 /) + kbo(:, 2,22, 3) = (/ & + & 0.12744e-05_r8,0.29880e-03_r8,0.47840e-03_r8,0.60094e-03_r8,0.70134e-03_r8 /) + kbo(:, 3,22, 3) = (/ & + & 0.13572e-05_r8,0.32813e-03_r8,0.53672e-03_r8,0.67341e-03_r8,0.76916e-03_r8 /) + kbo(:, 4,22, 3) = (/ & + & 0.14459e-05_r8,0.35761e-03_r8,0.59154e-03_r8,0.75421e-03_r8,0.83371e-03_r8 /) + kbo(:, 5,22, 3) = (/ & + & 0.15538e-05_r8,0.38792e-03_r8,0.64663e-03_r8,0.82877e-03_r8,0.89529e-03_r8 /) + kbo(:, 1,23, 3) = (/ & + & 0.96861e-06_r8,0.22918e-03_r8,0.36015e-03_r8,0.45719e-03_r8,0.52404e-03_r8 /) + kbo(:, 2,23, 3) = (/ & + & 0.10336e-05_r8,0.25321e-03_r8,0.40834e-03_r8,0.51161e-03_r8,0.58351e-03_r8 /) + kbo(:, 3,23, 3) = (/ & + & 0.10985e-05_r8,0.27767e-03_r8,0.45571e-03_r8,0.57459e-03_r8,0.63985e-03_r8 /) + kbo(:, 4,23, 3) = (/ & + & 0.11768e-05_r8,0.30252e-03_r8,0.50195e-03_r8,0.64190e-03_r8,0.69303e-03_r8 /) + kbo(:, 5,23, 3) = (/ & + & 0.12615e-05_r8,0.32794e-03_r8,0.54831e-03_r8,0.70579e-03_r8,0.74540e-03_r8 /) + kbo(:, 1,24, 3) = (/ & + & 0.77560e-06_r8,0.19437e-03_r8,0.30748e-03_r8,0.38828e-03_r8,0.43529e-03_r8 /) + kbo(:, 2,24, 3) = (/ & + & 0.82580e-06_r8,0.21438e-03_r8,0.34835e-03_r8,0.43617e-03_r8,0.48373e-03_r8 /) + kbo(:, 3,24, 3) = (/ & + & 0.88200e-06_r8,0.23492e-03_r8,0.38680e-03_r8,0.49169e-03_r8,0.53189e-03_r8 /) + kbo(:, 4,24, 3) = (/ & + & 0.94947e-06_r8,0.25573e-03_r8,0.42635e-03_r8,0.54641e-03_r8,0.57637e-03_r8 /) + kbo(:, 5,24, 3) = (/ & + & 0.10182e-05_r8,0.27745e-03_r8,0.46607e-03_r8,0.60046e-03_r8,0.61998e-03_r8 /) + kbo(:, 1,25, 3) = (/ & + & 0.61963e-06_r8,0.16454e-03_r8,0.26284e-03_r8,0.33016e-03_r8,0.36284e-03_r8 /) + kbo(:, 2,25, 3) = (/ & + & 0.66146e-06_r8,0.18162e-03_r8,0.29714e-03_r8,0.37315e-03_r8,0.40370e-03_r8 /) + kbo(:, 3,25, 3) = (/ & + & 0.71111e-06_r8,0.19882e-03_r8,0.32942e-03_r8,0.42130e-03_r8,0.44382e-03_r8 /) + kbo(:, 4,25, 3) = (/ & + & 0.76573e-06_r8,0.21663e-03_r8,0.36228e-03_r8,0.46640e-03_r8,0.48052e-03_r8 /) + kbo(:, 5,25, 3) = (/ & + & 0.82100e-06_r8,0.23503e-03_r8,0.39627e-03_r8,0.51132e-03_r8,0.51776e-03_r8 /) + kbo(:, 1,26, 3) = (/ & + & 0.49718e-06_r8,0.13982e-03_r8,0.22523e-03_r8,0.28275e-03_r8,0.30558e-03_r8 /) + kbo(:, 2,26, 3) = (/ & + & 0.53365e-06_r8,0.15431e-03_r8,0.25368e-03_r8,0.32044e-03_r8,0.33895e-03_r8 /) + kbo(:, 3,26, 3) = (/ & + & 0.57705e-06_r8,0.16884e-03_r8,0.28082e-03_r8,0.36019e-03_r8,0.37173e-03_r8 /) + kbo(:, 4,26, 3) = (/ & + & 0.62061e-06_r8,0.18393e-03_r8,0.30865e-03_r8,0.39866e-03_r8,0.40243e-03_r8 /) + kbo(:, 5,26, 3) = (/ & + & 0.66427e-06_r8,0.19968e-03_r8,0.33757e-03_r8,0.43663e-03_r8,0.43309e-03_r8 /) + kbo(:, 1,27, 3) = (/ & + & 0.39961e-06_r8,0.11889e-03_r8,0.19361e-03_r8,0.24270e-03_r8,0.25693e-03_r8 /) + kbo(:, 2,27, 3) = (/ & + & 0.43136e-06_r8,0.13100e-03_r8,0.21632e-03_r8,0.27591e-03_r8,0.28463e-03_r8 /) + kbo(:, 3,27, 3) = (/ & + & 0.46490e-06_r8,0.14333e-03_r8,0.23966e-03_r8,0.30849e-03_r8,0.31106e-03_r8 /) + kbo(:, 4,27, 3) = (/ & + & 0.50009e-06_r8,0.15630e-03_r8,0.26346e-03_r8,0.34083e-03_r8,0.33713e-03_r8 /) + kbo(:, 5,27, 3) = (/ & + & 0.53808e-06_r8,0.16999e-03_r8,0.28768e-03_r8,0.37323e-03_r8,0.36279e-03_r8 /) + kbo(:, 1,28, 3) = (/ & + & 0.31986e-06_r8,0.10106e-03_r8,0.16585e-03_r8,0.20891e-03_r8,0.21558e-03_r8 /) + kbo(:, 2,28, 3) = (/ & + & 0.34540e-06_r8,0.11119e-03_r8,0.18500e-03_r8,0.23760e-03_r8,0.23854e-03_r8 /) + kbo(:, 3,28, 3) = (/ & + & 0.37226e-06_r8,0.12183e-03_r8,0.20456e-03_r8,0.26419e-03_r8,0.26053e-03_r8 /) + kbo(:, 4,28, 3) = (/ & + & 0.40317e-06_r8,0.13290e-03_r8,0.22487e-03_r8,0.29156e-03_r8,0.28262e-03_r8 /) + kbo(:, 5,28, 3) = (/ & + & 0.43271e-06_r8,0.14482e-03_r8,0.24541e-03_r8,0.31934e-03_r8,0.30419e-03_r8 /) + kbo(:, 1,29, 3) = (/ & + & 0.25677e-06_r8,0.86060e-04_r8,0.14206e-03_r8,0.18023e-03_r8,0.18141e-03_r8 /) + kbo(:, 2,29, 3) = (/ & + & 0.27736e-06_r8,0.94677e-04_r8,0.15841e-03_r8,0.20378e-03_r8,0.20088e-03_r8 /) + kbo(:, 3,29, 3) = (/ & + & 0.30104e-06_r8,0.10372e-03_r8,0.17515e-03_r8,0.22663e-03_r8,0.21921e-03_r8 /) + kbo(:, 4,29, 3) = (/ & + & 0.32584e-06_r8,0.11340e-03_r8,0.19232e-03_r8,0.24953e-03_r8,0.23789e-03_r8 /) + kbo(:, 5,29, 3) = (/ & + & 0.34891e-06_r8,0.12368e-03_r8,0.20976e-03_r8,0.27364e-03_r8,0.25570e-03_r8 /) + kbo(:, 1,30, 3) = (/ & + & 0.20556e-06_r8,0.73274e-04_r8,0.12170e-03_r8,0.15588e-03_r8,0.15312e-03_r8 /) + kbo(:, 2,30, 3) = (/ & + & 0.22376e-06_r8,0.80651e-04_r8,0.13568e-03_r8,0.17524e-03_r8,0.16948e-03_r8 /) + kbo(:, 3,30, 3) = (/ & + & 0.24313e-06_r8,0.88481e-04_r8,0.14992e-03_r8,0.19447e-03_r8,0.18477e-03_r8 /) + kbo(:, 4,30, 3) = (/ & + & 0.26233e-06_r8,0.96824e-04_r8,0.16458e-03_r8,0.21409e-03_r8,0.20027e-03_r8 /) + kbo(:, 5,30, 3) = (/ & + & 0.28249e-06_r8,0.10580e-03_r8,0.17987e-03_r8,0.23435e-03_r8,0.21532e-03_r8 /) + kbo(:, 1,31, 3) = (/ & + & 0.16553e-06_r8,0.62536e-04_r8,0.10457e-03_r8,0.13443e-03_r8,0.12968e-03_r8 /) + kbo(:, 2,31, 3) = (/ & + & 0.18078e-06_r8,0.68863e-04_r8,0.11643e-03_r8,0.15060e-03_r8,0.14304e-03_r8 /) + kbo(:, 3,31, 3) = (/ & + & 0.19619e-06_r8,0.75670e-04_r8,0.12864e-03_r8,0.16681e-03_r8,0.15615e-03_r8 /) + kbo(:, 4,31, 3) = (/ & + & 0.21158e-06_r8,0.82899e-04_r8,0.14114e-03_r8,0.18385e-03_r8,0.16911e-03_r8 /) + kbo(:, 5,31, 3) = (/ & + & 0.22915e-06_r8,0.90629e-04_r8,0.15456e-03_r8,0.20099e-03_r8,0.18146e-03_r8 /) + kbo(:, 1,32, 3) = (/ & + & 0.13380e-06_r8,0.53407e-04_r8,0.89930e-04_r8,0.11591e-03_r8,0.11005e-03_r8 /) + kbo(:, 2,32, 3) = (/ & + & 0.14604e-06_r8,0.58887e-04_r8,0.10001e-03_r8,0.12963e-03_r8,0.12107e-03_r8 /) + kbo(:, 3,32, 3) = (/ & + & 0.15848e-06_r8,0.64790e-04_r8,0.11040e-03_r8,0.14349e-03_r8,0.13230e-03_r8 /) + kbo(:, 4,32, 3) = (/ & + & 0.17190e-06_r8,0.71169e-04_r8,0.12125e-03_r8,0.15792e-03_r8,0.14297e-03_r8 /) + kbo(:, 5,32, 3) = (/ & + & 0.18587e-06_r8,0.77792e-04_r8,0.13292e-03_r8,0.17265e-03_r8,0.15308e-03_r8 /) + kbo(:, 1,33, 3) = (/ & + & 0.10830e-06_r8,0.45686e-04_r8,0.77339e-04_r8,0.99867e-04_r8,0.93562e-04_r8 /) + kbo(:, 2,33, 3) = (/ & + & 0.11765e-06_r8,0.50526e-04_r8,0.85959e-04_r8,0.11153e-03_r8,0.10269e-03_r8 /) + kbo(:, 3,33, 3) = (/ & + & 0.12824e-06_r8,0.55627e-04_r8,0.94900e-04_r8,0.12354e-03_r8,0.11205e-03_r8 /) + kbo(:, 4,33, 3) = (/ & + & 0.13958e-06_r8,0.61158e-04_r8,0.10440e-03_r8,0.13573e-03_r8,0.12099e-03_r8 /) + kbo(:, 5,33, 3) = (/ & + & 0.15078e-06_r8,0.66909e-04_r8,0.11431e-03_r8,0.14861e-03_r8,0.12918e-03_r8 /) + kbo(:, 1,34, 3) = (/ & + & 0.87537e-07_r8,0.39073e-04_r8,0.66330e-04_r8,0.85860e-04_r8,0.79296e-04_r8 /) + kbo(:, 2,34, 3) = (/ & + & 0.95270e-07_r8,0.43282e-04_r8,0.73743e-04_r8,0.95733e-04_r8,0.87082e-04_r8 /) + kbo(:, 3,34, 3) = (/ & + & 0.10423e-06_r8,0.47701e-04_r8,0.81447e-04_r8,0.10609e-03_r8,0.94857e-04_r8 /) + kbo(:, 4,34, 3) = (/ & + & 0.11348e-06_r8,0.52484e-04_r8,0.89624e-04_r8,0.11638e-03_r8,0.10211e-03_r8 /) + kbo(:, 5,34, 3) = (/ & + & 0.12289e-06_r8,0.57431e-04_r8,0.98122e-04_r8,0.12760e-03_r8,0.10866e-03_r8 /) + kbo(:, 1,35, 3) = (/ & + & 0.69891e-07_r8,0.33129e-04_r8,0.56323e-04_r8,0.73036e-04_r8,0.66568e-04_r8 /) + kbo(:, 2,35, 3) = (/ & + & 0.76465e-07_r8,0.36724e-04_r8,0.62627e-04_r8,0.81520e-04_r8,0.73176e-04_r8 /) + kbo(:, 3,35, 3) = (/ & + & 0.83833e-07_r8,0.40619e-04_r8,0.69293e-04_r8,0.90161e-04_r8,0.79548e-04_r8 /) + kbo(:, 4,35, 3) = (/ & + & 0.91436e-07_r8,0.44671e-04_r8,0.76362e-04_r8,0.99075e-04_r8,0.85497e-04_r8 /) + kbo(:, 5,35, 3) = (/ & + & 0.99263e-07_r8,0.48886e-04_r8,0.83550e-04_r8,0.10849e-03_r8,0.90720e-04_r8 /) + kbo(:, 1,36, 3) = (/ & + & 0.55080e-07_r8,0.27796e-04_r8,0.47261e-04_r8,0.61299e-04_r8,0.55237e-04_r8 /) + kbo(:, 2,36, 3) = (/ & + & 0.60562e-07_r8,0.30850e-04_r8,0.52635e-04_r8,0.68515e-04_r8,0.60794e-04_r8 /) + kbo(:, 3,36, 3) = (/ & + & 0.66440e-07_r8,0.34200e-04_r8,0.58298e-04_r8,0.75847e-04_r8,0.66097e-04_r8 /) + kbo(:, 4,36, 3) = (/ & + & 0.72913e-07_r8,0.37650e-04_r8,0.64310e-04_r8,0.83530e-04_r8,0.71032e-04_r8 /) + kbo(:, 5,36, 3) = (/ & + & 0.79545e-07_r8,0.41216e-04_r8,0.70397e-04_r8,0.91304e-04_r8,0.75193e-04_r8 /) + kbo(:, 1,37, 3) = (/ & + & 0.43644e-07_r8,0.22997e-04_r8,0.39088e-04_r8,0.50714e-04_r8,0.45374e-04_r8 /) + kbo(:, 2,37, 3) = (/ & + & 0.48182e-07_r8,0.25585e-04_r8,0.43661e-04_r8,0.56813e-04_r8,0.50057e-04_r8 /) + kbo(:, 3,37, 3) = (/ & + & 0.53067e-07_r8,0.28429e-04_r8,0.48465e-04_r8,0.63020e-04_r8,0.54490e-04_r8 /) + kbo(:, 4,37, 3) = (/ & + & 0.58349e-07_r8,0.31365e-04_r8,0.53603e-04_r8,0.69516e-04_r8,0.58585e-04_r8 /) + kbo(:, 5,37, 3) = (/ & + & 0.63727e-07_r8,0.34398e-04_r8,0.58710e-04_r8,0.76032e-04_r8,0.62046e-04_r8 /) + kbo(:, 1,38, 3) = (/ & + & 0.34661e-07_r8,0.19003e-04_r8,0.32295e-04_r8,0.41898e-04_r8,0.37207e-04_r8 /) + kbo(:, 2,38, 3) = (/ & + & 0.38414e-07_r8,0.21200e-04_r8,0.36170e-04_r8,0.47045e-04_r8,0.41150e-04_r8 /) + kbo(:, 3,38, 3) = (/ & + & 0.42378e-07_r8,0.23605e-04_r8,0.40247e-04_r8,0.52306e-04_r8,0.44872e-04_r8 /) + kbo(:, 4,38, 3) = (/ & + & 0.46598e-07_r8,0.26110e-04_r8,0.44620e-04_r8,0.57800e-04_r8,0.48293e-04_r8 /) + kbo(:, 5,38, 3) = (/ & + & 0.50995e-07_r8,0.28683e-04_r8,0.48935e-04_r8,0.63250e-04_r8,0.51155e-04_r8 /) + kbo(:, 1,39, 3) = (/ & + & 0.27545e-07_r8,0.15700e-04_r8,0.26661e-04_r8,0.34603e-04_r8,0.30487e-04_r8 /) + kbo(:, 2,39, 3) = (/ & + & 0.30553e-07_r8,0.17568e-04_r8,0.29948e-04_r8,0.38935e-04_r8,0.33813e-04_r8 /) + kbo(:, 3,39, 3) = (/ & + & 0.33772e-07_r8,0.19601e-04_r8,0.33411e-04_r8,0.43403e-04_r8,0.36922e-04_r8 /) + kbo(:, 4,39, 3) = (/ & + & 0.37164e-07_r8,0.21726e-04_r8,0.37113e-04_r8,0.48030e-04_r8,0.39771e-04_r8 /) + kbo(:, 5,39, 3) = (/ & + & 0.40795e-07_r8,0.23901e-04_r8,0.40765e-04_r8,0.52607e-04_r8,0.42152e-04_r8 /) + kbo(:, 1,40, 3) = (/ & + & 0.21852e-07_r8,0.12819e-04_r8,0.21757e-04_r8,0.28221e-04_r8,0.24745e-04_r8 /) + kbo(:, 2,40, 3) = (/ & + & 0.24207e-07_r8,0.14395e-04_r8,0.24527e-04_r8,0.31867e-04_r8,0.27502e-04_r8 /) + kbo(:, 3,40, 3) = (/ & + & 0.26806e-07_r8,0.16092e-04_r8,0.27462e-04_r8,0.35646e-04_r8,0.30145e-04_r8 /) + kbo(:, 4,40, 3) = (/ & + & 0.29612e-07_r8,0.17894e-04_r8,0.30572e-04_r8,0.39527e-04_r8,0.32543e-04_r8 /) + kbo(:, 5,40, 3) = (/ & + & 0.32577e-07_r8,0.19746e-04_r8,0.33672e-04_r8,0.43399e-04_r8,0.34556e-04_r8 /) + kbo(:, 1,41, 3) = (/ & + & 0.17336e-07_r8,0.10441e-04_r8,0.17695e-04_r8,0.22954e-04_r8,0.20042e-04_r8 /) + kbo(:, 2,41, 3) = (/ & + & 0.19187e-07_r8,0.11771e-04_r8,0.20025e-04_r8,0.26029e-04_r8,0.22346e-04_r8 /) + kbo(:, 3,41, 3) = (/ & + & 0.21311e-07_r8,0.13190e-04_r8,0.22516e-04_r8,0.29201e-04_r8,0.24577e-04_r8 /) + kbo(:, 4,41, 3) = (/ & + & 0.23597e-07_r8,0.14712e-04_r8,0.25122e-04_r8,0.32466e-04_r8,0.26584e-04_r8 /) + kbo(:, 5,41, 3) = (/ & + & 0.25958e-07_r8,0.16280e-04_r8,0.27744e-04_r8,0.35762e-04_r8,0.28295e-04_r8 /) + kbo(:, 1,42, 3) = (/ & + & 0.13752e-07_r8,0.84970e-05_r8,0.14379e-04_r8,0.18640e-04_r8,0.16205e-04_r8 /) + kbo(:, 2,42, 3) = (/ & + & 0.15240e-07_r8,0.96082e-05_r8,0.16325e-04_r8,0.21225e-04_r8,0.18124e-04_r8 /) + kbo(:, 3,42, 3) = (/ & + & 0.16924e-07_r8,0.10802e-04_r8,0.18430e-04_r8,0.23896e-04_r8,0.20024e-04_r8 /) + kbo(:, 4,42, 3) = (/ & + & 0.18767e-07_r8,0.12087e-04_r8,0.20609e-04_r8,0.26651e-04_r8,0.21698e-04_r8 /) + kbo(:, 5,42, 3) = (/ & + & 0.20666e-07_r8,0.13409e-04_r8,0.22837e-04_r8,0.29427e-04_r8,0.23153e-04_r8 /) + kbo(:, 1,43, 3) = (/ & + & 0.10827e-07_r8,0.68624e-05_r8,0.11586e-04_r8,0.14999e-04_r8,0.12975e-04_r8 /) + kbo(:, 2,43, 3) = (/ & + & 0.12030e-07_r8,0.77847e-05_r8,0.13205e-04_r8,0.17164e-04_r8,0.14605e-04_r8 /) + kbo(:, 3,43, 3) = (/ & + & 0.13352e-07_r8,0.87779e-05_r8,0.14974e-04_r8,0.19410e-04_r8,0.16231e-04_r8 /) + kbo(:, 4,43, 3) = (/ & + & 0.14829e-07_r8,0.98620e-05_r8,0.16795e-04_r8,0.21751e-04_r8,0.17634e-04_r8 /) + kbo(:, 5,43, 3) = (/ & + & 0.16396e-07_r8,0.10975e-04_r8,0.18682e-04_r8,0.24066e-04_r8,0.18879e-04_r8 /) + kbo(:, 1,44, 3) = (/ & + & 0.85731e-08_r8,0.55132e-05_r8,0.92862e-05_r8,0.12000e-04_r8,0.10347e-04_r8 /) + kbo(:, 2,44, 3) = (/ & + & 0.95033e-08_r8,0.62816e-05_r8,0.10629e-04_r8,0.13817e-04_r8,0.11712e-04_r8 /) + kbo(:, 3,44, 3) = (/ & + & 0.10537e-07_r8,0.70964e-05_r8,0.12108e-04_r8,0.15700e-04_r8,0.13095e-04_r8 /) + kbo(:, 4,44, 3) = (/ & + & 0.11722e-07_r8,0.80120e-05_r8,0.13621e-04_r8,0.17679e-04_r8,0.14296e-04_r8 /) + kbo(:, 5,44, 3) = (/ & + & 0.12991e-07_r8,0.89457e-05_r8,0.15220e-04_r8,0.19614e-04_r8,0.15350e-04_r8 /) + kbo(:, 1,45, 3) = (/ & + & 0.67515e-08_r8,0.44212e-05_r8,0.74244e-05_r8,0.95776e-05_r8,0.82429e-05_r8 /) + kbo(:, 2,45, 3) = (/ & + & 0.74999e-08_r8,0.50603e-05_r8,0.85360e-05_r8,0.11095e-04_r8,0.93791e-05_r8 /) + kbo(:, 3,45, 3) = (/ & + & 0.83182e-08_r8,0.57411e-05_r8,0.97686e-05_r8,0.12667e-04_r8,0.10528e-04_r8 /) + kbo(:, 4,45, 3) = (/ & + & 0.92526e-08_r8,0.64942e-05_r8,0.11028e-04_r8,0.14328e-04_r8,0.11566e-04_r8 /) + kbo(:, 5,45, 3) = (/ & + & 0.10269e-07_r8,0.72769e-05_r8,0.12375e-04_r8,0.15964e-04_r8,0.12472e-04_r8 /) + kbo(:, 1,46, 3) = (/ & + & 0.53031e-08_r8,0.35301e-05_r8,0.59050e-05_r8,0.75965e-05_r8,0.65452e-05_r8 /) + kbo(:, 2,46, 3) = (/ & + & 0.58907e-08_r8,0.40561e-05_r8,0.68233e-05_r8,0.88621e-05_r8,0.74771e-05_r8 /) + kbo(:, 3,46, 3) = (/ & + & 0.65422e-08_r8,0.46270e-05_r8,0.78393e-05_r8,0.10169e-04_r8,0.84370e-05_r8 /) + kbo(:, 4,46, 3) = (/ & + & 0.72669e-08_r8,0.52433e-05_r8,0.89061e-05_r8,0.11563e-04_r8,0.93268e-05_r8 /) + kbo(:, 5,46, 3) = (/ & + & 0.80880e-08_r8,0.58967e-05_r8,0.10016e-04_r8,0.12930e-04_r8,0.10106e-04_r8 /) + kbo(:, 1,47, 3) = (/ & + & 0.41459e-08_r8,0.27965e-05_r8,0.46529e-05_r8,0.59648e-05_r8,0.51552e-05_r8 /) + kbo(:, 2,47, 3) = (/ & + & 0.46324e-08_r8,0.32253e-05_r8,0.54100e-05_r8,0.70094e-05_r8,0.59110e-05_r8 /) + kbo(:, 3,47, 3) = (/ & + & 0.51433e-08_r8,0.37014e-05_r8,0.62395e-05_r8,0.80976e-05_r8,0.67100e-05_r8 /) + kbo(:, 4,47, 3) = (/ & + & 0.57045e-08_r8,0.42091e-05_r8,0.71381e-05_r8,0.92537e-05_r8,0.74896e-05_r8 /) + kbo(:, 5,47, 3) = (/ & + & 0.63526e-08_r8,0.47541e-05_r8,0.80573e-05_r8,0.10428e-04_r8,0.81540e-05_r8 /) + kbo(:, 1,48, 3) = (/ & + & 0.32549e-08_r8,0.22089e-05_r8,0.36571e-05_r8,0.46663e-05_r8,0.40387e-05_r8 /) + kbo(:, 2,48, 3) = (/ & + & 0.36192e-08_r8,0.25581e-05_r8,0.42752e-05_r8,0.55265e-05_r8,0.46582e-05_r8 /) + kbo(:, 3,48, 3) = (/ & + & 0.40215e-08_r8,0.29515e-05_r8,0.49553e-05_r8,0.64327e-05_r8,0.53236e-05_r8 /) + kbo(:, 4,48, 3) = (/ & + & 0.44736e-08_r8,0.33690e-05_r8,0.57015e-05_r8,0.73859e-05_r8,0.59960e-05_r8 /) + kbo(:, 5,48, 3) = (/ & + & 0.49760e-08_r8,0.38276e-05_r8,0.64596e-05_r8,0.83844e-05_r8,0.65647e-05_r8 /) + kbo(:, 1,49, 3) = (/ & + & 0.25432e-08_r8,0.17390e-05_r8,0.28607e-05_r8,0.36438e-05_r8,0.31425e-05_r8 /) + kbo(:, 2,49, 3) = (/ & + & 0.28364e-08_r8,0.20219e-05_r8,0.33698e-05_r8,0.43412e-05_r8,0.36654e-05_r8 /) + kbo(:, 3,49, 3) = (/ & + & 0.31601e-08_r8,0.23472e-05_r8,0.39232e-05_r8,0.50964e-05_r8,0.42142e-05_r8 /) + kbo(:, 4,49, 3) = (/ & + & 0.35101e-08_r8,0.26948e-05_r8,0.45429e-05_r8,0.58797e-05_r8,0.47715e-05_r8 /) + kbo(:, 5,49, 3) = (/ & + & 0.38989e-08_r8,0.30718e-05_r8,0.51731e-05_r8,0.67190e-05_r8,0.52720e-05_r8 /) + kbo(:, 1,50, 3) = (/ & + & 0.20093e-08_r8,0.13704e-05_r8,0.22373e-05_r8,0.28375e-05_r8,0.24550e-05_r8 /) + kbo(:, 2,50, 3) = (/ & + & 0.22270e-08_r8,0.16020e-05_r8,0.26626e-05_r8,0.34144e-05_r8,0.28963e-05_r8 /) + kbo(:, 3,50, 3) = (/ & + & 0.24797e-08_r8,0.18686e-05_r8,0.31131e-05_r8,0.40348e-05_r8,0.33398e-05_r8 /) + kbo(:, 4,50, 3) = (/ & + & 0.27614e-08_r8,0.21593e-05_r8,0.36199e-05_r8,0.46856e-05_r8,0.38019e-05_r8 /) + kbo(:, 5,50, 3) = (/ & + & 0.30674e-08_r8,0.24699e-05_r8,0.41517e-05_r8,0.53844e-05_r8,0.42322e-05_r8 /) + kbo(:, 1,51, 3) = (/ & + & 0.15907e-08_r8,0.10803e-05_r8,0.17518e-05_r8,0.22064e-05_r8,0.19254e-05_r8 /) + kbo(:, 2,51, 3) = (/ & + & 0.17509e-08_r8,0.12691e-05_r8,0.21000e-05_r8,0.26794e-05_r8,0.22832e-05_r8 /) + kbo(:, 3,51, 3) = (/ & + & 0.19509e-08_r8,0.14861e-05_r8,0.24726e-05_r8,0.31957e-05_r8,0.26418e-05_r8 /) + kbo(:, 4,51, 3) = (/ & + & 0.21703e-08_r8,0.17284e-05_r8,0.28838e-05_r8,0.37325e-05_r8,0.30257e-05_r8 /) + kbo(:, 5,51, 3) = (/ & + & 0.24124e-08_r8,0.19844e-05_r8,0.33305e-05_r8,0.43128e-05_r8,0.34015e-05_r8 /) + kbo(:, 1,52, 3) = (/ & + & 0.12564e-08_r8,0.84669e-06_r8,0.13717e-05_r8,0.17147e-05_r8,0.14947e-05_r8 /) + kbo(:, 2,52, 3) = (/ & + & 0.13794e-08_r8,0.10024e-05_r8,0.16523e-05_r8,0.20993e-05_r8,0.17870e-05_r8 /) + kbo(:, 3,52, 3) = (/ & + & 0.15320e-08_r8,0.11790e-05_r8,0.19577e-05_r8,0.25220e-05_r8,0.20845e-05_r8 /) + kbo(:, 4,52, 3) = (/ & + & 0.17130e-08_r8,0.13791e-05_r8,0.22952e-05_r8,0.29677e-05_r8,0.24040e-05_r8 /) + kbo(:, 5,52, 3) = (/ & + & 0.19041e-08_r8,0.15914e-05_r8,0.26635e-05_r8,0.34439e-05_r8,0.27247e-05_r8 /) + kbo(:, 1,53, 3) = (/ & + & 0.99523e-09_r8,0.66219e-06_r8,0.10632e-05_r8,0.13341e-05_r8,0.11550e-05_r8 /) + kbo(:, 2,53, 3) = (/ & + & 0.10903e-08_r8,0.79022e-06_r8,0.12914e-05_r8,0.16401e-05_r8,0.13929e-05_r8 /) + kbo(:, 3,53, 3) = (/ & + & 0.12082e-08_r8,0.93266e-06_r8,0.15445e-05_r8,0.19841e-05_r8,0.16452e-05_r8 /) + kbo(:, 4,53, 3) = (/ & + & 0.13437e-08_r8,0.10969e-05_r8,0.18212e-05_r8,0.23517e-05_r8,0.19029e-05_r8 /) + kbo(:, 5,53, 3) = (/ & + & 0.14972e-08_r8,0.12734e-05_r8,0.21276e-05_r8,0.27431e-05_r8,0.21722e-05_r8 /) + kbo(:, 1,54, 3) = (/ & + & 0.78782e-09_r8,0.51993e-06_r8,0.82752e-06_r8,0.10421e-05_r8,0.88632e-06_r8 /) + kbo(:, 2,54, 3) = (/ & + & 0.86642e-09_r8,0.62440e-06_r8,0.10138e-05_r8,0.12820e-05_r8,0.10958e-05_r8 /) + kbo(:, 3,54, 3) = (/ & + & 0.95141e-09_r8,0.74051e-06_r8,0.12221e-05_r8,0.15626e-05_r8,0.13014e-05_r8 /) + kbo(:, 4,54, 3) = (/ & + & 0.10622e-08_r8,0.87438e-06_r8,0.14481e-05_r8,0.18675e-05_r8,0.15138e-05_r8 /) + kbo(:, 5,54, 3) = (/ & + & 0.11829e-08_r8,0.10217e-05_r8,0.17025e-05_r8,0.21900e-05_r8,0.17349e-05_r8 /) + kbo(:, 1,55, 3) = (/ & + & 0.62734e-09_r8,0.40844e-06_r8,0.64675e-06_r8,0.81168e-06_r8,0.68015e-06_r8 /) + kbo(:, 2,55, 3) = (/ & + & 0.68670e-09_r8,0.49437e-06_r8,0.79822e-06_r8,0.10031e-05_r8,0.85955e-06_r8 /) + kbo(:, 3,55, 3) = (/ & + & 0.75551e-09_r8,0.58813e-06_r8,0.96640e-06_r8,0.12305e-05_r8,0.10290e-05_r8 /) + kbo(:, 4,55, 3) = (/ & + & 0.83896e-09_r8,0.69762e-06_r8,0.11529e-05_r8,0.14845e-05_r8,0.12025e-05_r8 /) + kbo(:, 5,55, 3) = (/ & + & 0.93727e-09_r8,0.81992e-06_r8,0.13618e-05_r8,0.17489e-05_r8,0.13856e-05_r8 /) + kbo(:, 1,56, 3) = (/ & + & 0.50214e-09_r8,0.32028e-06_r8,0.50524e-06_r8,0.63147e-06_r8,0.51903e-06_r8 /) + kbo(:, 2,56, 3) = (/ & + & 0.54775e-09_r8,0.38841e-06_r8,0.62589e-06_r8,0.78445e-06_r8,0.67099e-06_r8 /) + kbo(:, 3,56, 3) = (/ & + & 0.59971e-09_r8,0.46602e-06_r8,0.76356e-06_r8,0.96978e-06_r8,0.80912e-06_r8 /) + kbo(:, 4,56, 3) = (/ & + & 0.66466e-09_r8,0.55509e-06_r8,0.91533e-06_r8,0.11766e-05_r8,0.95284e-06_r8 /) + kbo(:, 5,56, 3) = (/ & + & 0.73931e-09_r8,0.65625e-06_r8,0.10864e-05_r8,0.13946e-05_r8,0.11055e-05_r8 /) + kbo(:, 1,57, 3) = (/ & + & 0.40171e-09_r8,0.25009e-06_r8,0.39211e-06_r8,0.49250e-06_r8,0.39332e-06_r8 /) + kbo(:, 2,57, 3) = (/ & + & 0.43379e-09_r8,0.30473e-06_r8,0.48932e-06_r8,0.61342e-06_r8,0.52076e-06_r8 /) + kbo(:, 3,57, 3) = (/ & + & 0.47729e-09_r8,0.36874e-06_r8,0.59978e-06_r8,0.76246e-06_r8,0.63556e-06_r8 /) + kbo(:, 4,57, 3) = (/ & + & 0.52454e-09_r8,0.44075e-06_r8,0.72488e-06_r8,0.93079e-06_r8,0.75448e-06_r8 /) + kbo(:, 5,57, 3) = (/ & + & 0.58546e-09_r8,0.52389e-06_r8,0.86565e-06_r8,0.11107e-05_r8,0.87858e-06_r8 /) + kbo(:, 1,58, 3) = (/ & + & 0.32222e-09_r8,0.19536e-06_r8,0.30484e-06_r8,0.38123e-06_r8,0.29798e-06_r8 /) + kbo(:, 2,58, 3) = (/ & + & 0.34550e-09_r8,0.24003e-06_r8,0.38206e-06_r8,0.48033e-06_r8,0.40193e-06_r8 /) + kbo(:, 3,58, 3) = (/ & + & 0.37930e-09_r8,0.29179e-06_r8,0.47226e-06_r8,0.59938e-06_r8,0.50056e-06_r8 /) + kbo(:, 4,58, 3) = (/ & + & 0.41675e-09_r8,0.35035e-06_r8,0.57500e-06_r8,0.73642e-06_r8,0.59836e-06_r8 /) + kbo(:, 5,58, 3) = (/ & + & 0.46320e-09_r8,0.41854e-06_r8,0.69041e-06_r8,0.88548e-06_r8,0.70003e-06_r8 /) + kbo(:, 1,59, 3) = (/ & + & 0.26166e-09_r8,0.15868e-06_r8,0.24697e-06_r8,0.30892e-06_r8,0.23964e-06_r8 /) + kbo(:, 2,59, 3) = (/ & + & 0.28095e-09_r8,0.19552e-06_r8,0.31068e-06_r8,0.39037e-06_r8,0.32469e-06_r8 /) + kbo(:, 3,59, 3) = (/ & + & 0.30730e-09_r8,0.23856e-06_r8,0.38554e-06_r8,0.48902e-06_r8,0.40738e-06_r8 /) + kbo(:, 4,59, 3) = (/ & + & 0.33781e-09_r8,0.28749e-06_r8,0.47157e-06_r8,0.60286e-06_r8,0.48803e-06_r8 /) + kbo(:, 5,59, 3) = (/ & + & 0.37526e-09_r8,0.34439e-06_r8,0.56789e-06_r8,0.72742e-06_r8,0.57238e-06_r8 /) + kbo(:, 1,13, 4) = (/ & + & 0.49038e-04_r8,0.50781e-02_r8,0.78254e-02_r8,0.96484e-02_r8,0.10614e-01_r8 /) + kbo(:, 2,13, 4) = (/ & + & 0.54225e-04_r8,0.54905e-02_r8,0.85710e-02_r8,0.10460e-01_r8,0.11206e-01_r8 /) + kbo(:, 3,13, 4) = (/ & + & 0.61134e-04_r8,0.58773e-02_r8,0.93183e-02_r8,0.11347e-01_r8,0.11729e-01_r8 /) + kbo(:, 4,13, 4) = (/ & + & 0.68793e-04_r8,0.62794e-02_r8,0.99768e-02_r8,0.12248e-01_r8,0.12250e-01_r8 /) + kbo(:, 5,13, 4) = (/ & + & 0.77429e-04_r8,0.66893e-02_r8,0.10624e-01_r8,0.13064e-01_r8,0.12730e-01_r8 /) + kbo(:, 1,14, 4) = (/ & + & 0.40706e-04_r8,0.43045e-02_r8,0.66240e-02_r8,0.81227e-02_r8,0.87105e-02_r8 /) + kbo(:, 2,14, 4) = (/ & + & 0.45789e-04_r8,0.46404e-02_r8,0.72547e-02_r8,0.88508e-02_r8,0.92183e-02_r8 /) + kbo(:, 3,14, 4) = (/ & + & 0.51359e-04_r8,0.49670e-02_r8,0.78649e-02_r8,0.95928e-02_r8,0.96590e-02_r8 /) + kbo(:, 4,14, 4) = (/ & + & 0.58448e-04_r8,0.53112e-02_r8,0.84165e-02_r8,0.10356e-01_r8,0.10085e-01_r8 /) + kbo(:, 5,14, 4) = (/ & + & 0.66585e-04_r8,0.56590e-02_r8,0.89770e-02_r8,0.11022e-01_r8,0.10540e-01_r8 /) + kbo(:, 1,15, 4) = (/ & + & 0.33161e-04_r8,0.36374e-02_r8,0.56007e-02_r8,0.68408e-02_r8,0.70399e-02_r8 /) + kbo(:, 2,15, 4) = (/ & + & 0.37316e-04_r8,0.39145e-02_r8,0.61318e-02_r8,0.74812e-02_r8,0.74533e-02_r8 /) + kbo(:, 3,15, 4) = (/ & + & 0.42184e-04_r8,0.41949e-02_r8,0.66272e-02_r8,0.81097e-02_r8,0.78393e-02_r8 /) + kbo(:, 4,15, 4) = (/ & + & 0.48249e-04_r8,0.44861e-02_r8,0.70934e-02_r8,0.87330e-02_r8,0.82262e-02_r8 /) + kbo(:, 5,15, 4) = (/ & + & 0.54912e-04_r8,0.47829e-02_r8,0.75688e-02_r8,0.92830e-02_r8,0.86058e-02_r8 /) + kbo(:, 1,16, 4) = (/ & + & 0.26598e-04_r8,0.30649e-02_r8,0.47323e-02_r8,0.57742e-02_r8,0.56644e-02_r8 /) + kbo(:, 2,16, 4) = (/ & + & 0.30096e-04_r8,0.32950e-02_r8,0.51778e-02_r8,0.63145e-02_r8,0.60193e-02_r8 /) + kbo(:, 3,16, 4) = (/ & + & 0.34085e-04_r8,0.35350e-02_r8,0.55806e-02_r8,0.68447e-02_r8,0.63708e-02_r8 /) + kbo(:, 4,16, 4) = (/ & + & 0.38919e-04_r8,0.37831e-02_r8,0.59719e-02_r8,0.73465e-02_r8,0.67088e-02_r8 /) + kbo(:, 5,16, 4) = (/ & + & 0.44492e-04_r8,0.40393e-02_r8,0.63750e-02_r8,0.78120e-02_r8,0.70249e-02_r8 /) + kbo(:, 1,17, 4) = (/ & + & 0.21449e-04_r8,0.25756e-02_r8,0.39936e-02_r8,0.48662e-02_r8,0.46205e-02_r8 /) + kbo(:, 2,17, 4) = (/ & + & 0.24103e-04_r8,0.27706e-02_r8,0.43619e-02_r8,0.53164e-02_r8,0.49202e-02_r8 /) + kbo(:, 3,17, 4) = (/ & + & 0.27451e-04_r8,0.29765e-02_r8,0.46959e-02_r8,0.57632e-02_r8,0.52122e-02_r8 /) + kbo(:, 4,17, 4) = (/ & + & 0.31381e-04_r8,0.31884e-02_r8,0.50222e-02_r8,0.61735e-02_r8,0.54790e-02_r8 /) + kbo(:, 5,17, 4) = (/ & + & 0.35953e-04_r8,0.34099e-02_r8,0.53645e-02_r8,0.65659e-02_r8,0.57419e-02_r8 /) + kbo(:, 1,18, 4) = (/ & + & 0.17468e-04_r8,0.21642e-02_r8,0.33642e-02_r8,0.40972e-02_r8,0.37921e-02_r8 /) + kbo(:, 2,18, 4) = (/ & + & 0.19506e-04_r8,0.23308e-02_r8,0.36683e-02_r8,0.44696e-02_r8,0.40385e-02_r8 /) + kbo(:, 3,18, 4) = (/ & + & 0.22326e-04_r8,0.25072e-02_r8,0.39454e-02_r8,0.48507e-02_r8,0.42773e-02_r8 /) + kbo(:, 4,18, 4) = (/ & + & 0.25558e-04_r8,0.26901e-02_r8,0.42240e-02_r8,0.51855e-02_r8,0.45000e-02_r8 /) + kbo(:, 5,18, 4) = (/ & + & 0.29519e-04_r8,0.28816e-02_r8,0.45135e-02_r8,0.55168e-02_r8,0.47259e-02_r8 /) + kbo(:, 1,19, 4) = (/ & + & 0.14162e-04_r8,0.18165e-02_r8,0.28311e-02_r8,0.34491e-02_r8,0.31263e-02_r8 /) + kbo(:, 2,19, 4) = (/ & + & 0.15880e-04_r8,0.19594e-02_r8,0.30792e-02_r8,0.37577e-02_r8,0.33277e-02_r8 /) + kbo(:, 3,19, 4) = (/ & + & 0.18250e-04_r8,0.21124e-02_r8,0.33110e-02_r8,0.40717e-02_r8,0.35255e-02_r8 /) + kbo(:, 4,19, 4) = (/ & + & 0.20948e-04_r8,0.22711e-02_r8,0.35512e-02_r8,0.43541e-02_r8,0.37114e-02_r8 /) + kbo(:, 5,19, 4) = (/ & + & 0.24279e-04_r8,0.24360e-02_r8,0.37972e-02_r8,0.46336e-02_r8,0.39063e-02_r8 /) + kbo(:, 1,20, 4) = (/ & + & 0.11677e-04_r8,0.15268e-02_r8,0.23854e-02_r8,0.29054e-02_r8,0.25927e-02_r8 /) + kbo(:, 2,20, 4) = (/ & + & 0.13127e-04_r8,0.16502e-02_r8,0.25884e-02_r8,0.31642e-02_r8,0.27584e-02_r8 /) + kbo(:, 3,20, 4) = (/ & + & 0.15145e-04_r8,0.17827e-02_r8,0.27854e-02_r8,0.34198e-02_r8,0.29228e-02_r8 /) + kbo(:, 4,20, 4) = (/ & + & 0.17426e-04_r8,0.19208e-02_r8,0.29919e-02_r8,0.36563e-02_r8,0.30836e-02_r8 /) + kbo(:, 5,20, 4) = (/ & + & 0.20187e-04_r8,0.20638e-02_r8,0.32027e-02_r8,0.38955e-02_r8,0.32517e-02_r8 /) + kbo(:, 1,21, 4) = (/ & + & 0.96248e-05_r8,0.12839e-02_r8,0.20069e-02_r8,0.24439e-02_r8,0.21521e-02_r8 /) + kbo(:, 2,21, 4) = (/ & + & 0.10884e-04_r8,0.13905e-02_r8,0.21753e-02_r8,0.26634e-02_r8,0.22901e-02_r8 /) + kbo(:, 3,21, 4) = (/ & + & 0.12576e-04_r8,0.15057e-02_r8,0.23430e-02_r8,0.28714e-02_r8,0.24271e-02_r8 /) + kbo(:, 4,21, 4) = (/ & + & 0.14492e-04_r8,0.16245e-02_r8,0.25229e-02_r8,0.30709e-02_r8,0.25653e-02_r8 /) + kbo(:, 5,21, 4) = (/ & + & 0.16785e-04_r8,0.17487e-02_r8,0.27053e-02_r8,0.32769e-02_r8,0.27041e-02_r8 /) + kbo(:, 1,22, 4) = (/ & + & 0.78987e-05_r8,0.10841e-02_r8,0.16963e-02_r8,0.20646e-02_r8,0.17920e-02_r8 /) + kbo(:, 2,22, 4) = (/ & + & 0.90688e-05_r8,0.11783e-02_r8,0.18364e-02_r8,0.22523e-02_r8,0.19054e-02_r8 /) + kbo(:, 3,22, 4) = (/ & + & 0.10436e-04_r8,0.12776e-02_r8,0.19832e-02_r8,0.24220e-02_r8,0.20200e-02_r8 /) + kbo(:, 4,22, 4) = (/ & + & 0.12051e-04_r8,0.13800e-02_r8,0.21391e-02_r8,0.25904e-02_r8,0.21364e-02_r8 /) + kbo(:, 5,22, 4) = (/ & + & 0.13992e-04_r8,0.14877e-02_r8,0.22983e-02_r8,0.27690e-02_r8,0.22519e-02_r8 /) + kbo(:, 1,23, 4) = (/ & + & 0.65143e-05_r8,0.91629e-03_r8,0.14337e-02_r8,0.17468e-02_r8,0.14890e-02_r8 /) + kbo(:, 2,23, 4) = (/ & + & 0.75295e-05_r8,0.99880e-03_r8,0.15532e-02_r8,0.19017e-02_r8,0.15844e-02_r8 /) + kbo(:, 3,23, 4) = (/ & + & 0.86172e-05_r8,0.10843e-02_r8,0.16828e-02_r8,0.20454e-02_r8,0.16822e-02_r8 /) + kbo(:, 4,23, 4) = (/ & + & 0.10017e-04_r8,0.11729e-02_r8,0.18176e-02_r8,0.21912e-02_r8,0.17800e-02_r8 /) + kbo(:, 5,23, 4) = (/ & + & 0.11640e-04_r8,0.12668e-02_r8,0.19549e-02_r8,0.23447e-02_r8,0.18765e-02_r8 /) + kbo(:, 1,24, 4) = (/ & + & 0.53432e-05_r8,0.77571e-03_r8,0.12114e-02_r8,0.14805e-02_r8,0.12372e-02_r8 /) + kbo(:, 2,24, 4) = (/ & + & 0.61515e-05_r8,0.84718e-03_r8,0.13153e-02_r8,0.16078e-02_r8,0.13181e-02_r8 /) + kbo(:, 3,24, 4) = (/ & + & 0.70923e-05_r8,0.92024e-03_r8,0.14293e-02_r8,0.17300e-02_r8,0.13989e-02_r8 /) + kbo(:, 4,24, 4) = (/ & + & 0.82684e-05_r8,0.99740e-03_r8,0.15447e-02_r8,0.18573e-02_r8,0.14811e-02_r8 /) + kbo(:, 5,24, 4) = (/ & + & 0.96268e-05_r8,0.10789e-02_r8,0.16627e-02_r8,0.19892e-02_r8,0.15621e-02_r8 /) + kbo(:, 1,25, 4) = (/ & + & 0.43932e-05_r8,0.65898e-03_r8,0.10259e-02_r8,0.12568e-02_r8,0.10287e-02_r8 /) + kbo(:, 2,25, 4) = (/ & + & 0.50483e-05_r8,0.71973e-03_r8,0.11174e-02_r8,0.13610e-02_r8,0.10973e-02_r8 /) + kbo(:, 3,25, 4) = (/ & + & 0.58527e-05_r8,0.78269e-03_r8,0.12157e-02_r8,0.14658e-02_r8,0.11648e-02_r8 /) + kbo(:, 4,25, 4) = (/ & + & 0.68258e-05_r8,0.84968e-03_r8,0.13158e-02_r8,0.15774e-02_r8,0.12354e-02_r8 /) + kbo(:, 5,25, 4) = (/ & + & 0.79780e-05_r8,0.92093e-03_r8,0.14171e-02_r8,0.16917e-02_r8,0.13029e-02_r8 /) + kbo(:, 1,26, 4) = (/ & + & 0.36349e-05_r8,0.56139e-03_r8,0.87232e-03_r8,0.10671e-02_r8,0.85747e-03_r8 /) + kbo(:, 2,26, 4) = (/ & + & 0.41763e-05_r8,0.61307e-03_r8,0.95284e-03_r8,0.11559e-02_r8,0.91640e-03_r8 /) + kbo(:, 3,26, 4) = (/ & + & 0.48643e-05_r8,0.66769e-03_r8,0.10377e-02_r8,0.12480e-02_r8,0.97417e-03_r8 /) + kbo(:, 4,26, 4) = (/ & + & 0.56806e-05_r8,0.72618e-03_r8,0.11238e-02_r8,0.13443e-02_r8,0.10341e-02_r8 /) + kbo(:, 5,26, 4) = (/ & + & 0.66574e-05_r8,0.78791e-03_r8,0.12118e-02_r8,0.14426e-02_r8,0.10908e-02_r8 /) + kbo(:, 1,27, 4) = (/ & + & 0.29849e-05_r8,0.47845e-03_r8,0.74324e-03_r8,0.90695e-03_r8,0.71654e-03_r8 /) + kbo(:, 2,27, 4) = (/ & + & 0.34528e-05_r8,0.52305e-03_r8,0.81407e-03_r8,0.98348e-03_r8,0.76622e-03_r8 /) + kbo(:, 3,27, 4) = (/ & + & 0.40386e-05_r8,0.57067e-03_r8,0.88635e-03_r8,0.10643e-02_r8,0.81617e-03_r8 /) + kbo(:, 4,27, 4) = (/ & + & 0.47349e-05_r8,0.62159e-03_r8,0.96045e-03_r8,0.11476e-02_r8,0.86667e-03_r8 /) + kbo(:, 5,27, 4) = (/ & + & 0.55504e-05_r8,0.67486e-03_r8,0.10373e-02_r8,0.12327e-02_r8,0.91437e-03_r8 /) + kbo(:, 1,28, 4) = (/ & + & 0.24474e-05_r8,0.40819e-03_r8,0.63469e-03_r8,0.77184e-03_r8,0.59959e-03_r8 /) + kbo(:, 2,28, 4) = (/ & + & 0.28527e-05_r8,0.44694e-03_r8,0.69550e-03_r8,0.83809e-03_r8,0.64151e-03_r8 /) + kbo(:, 3,28, 4) = (/ & + & 0.33444e-05_r8,0.48804e-03_r8,0.75797e-03_r8,0.90921e-03_r8,0.68464e-03_r8 /) + kbo(:, 4,28, 4) = (/ & + & 0.39332e-05_r8,0.53229e-03_r8,0.82174e-03_r8,0.98103e-03_r8,0.72680e-03_r8 /) + kbo(:, 5,28, 4) = (/ & + & 0.46245e-05_r8,0.57864e-03_r8,0.88872e-03_r8,0.10544e-02_r8,0.76723e-03_r8 /) + kbo(:, 1,29, 4) = (/ & + & 0.20253e-05_r8,0.34921e-03_r8,0.54365e-03_r8,0.65865e-03_r8,0.50331e-03_r8 /) + kbo(:, 2,29, 4) = (/ & + & 0.23720e-05_r8,0.38278e-03_r8,0.59577e-03_r8,0.71729e-03_r8,0.53864e-03_r8 /) + kbo(:, 3,29, 4) = (/ & + & 0.27945e-05_r8,0.41887e-03_r8,0.64907e-03_r8,0.77823e-03_r8,0.57581e-03_r8 /) + kbo(:, 4,29, 4) = (/ & + & 0.32936e-05_r8,0.45699e-03_r8,0.70481e-03_r8,0.84074e-03_r8,0.61089e-03_r8 /) + kbo(:, 5,29, 4) = (/ & + & 0.38881e-05_r8,0.49757e-03_r8,0.76325e-03_r8,0.90356e-03_r8,0.64564e-03_r8 /) + kbo(:, 1,30, 4) = (/ & + & 0.16797e-05_r8,0.29918e-03_r8,0.46598e-03_r8,0.56316e-03_r8,0.42270e-03_r8 /) + kbo(:, 2,30, 4) = (/ & + & 0.19764e-05_r8,0.32839e-03_r8,0.51076e-03_r8,0.61439e-03_r8,0.45306e-03_r8 /) + kbo(:, 3,30, 4) = (/ & + & 0.23384e-05_r8,0.35985e-03_r8,0.55686e-03_r8,0.66712e-03_r8,0.48445e-03_r8 /) + kbo(:, 4,30, 4) = (/ & + & 0.27662e-05_r8,0.39302e-03_r8,0.60525e-03_r8,0.72092e-03_r8,0.51425e-03_r8 /) + kbo(:, 5,30, 4) = (/ & + & 0.32687e-05_r8,0.42837e-03_r8,0.65610e-03_r8,0.77570e-03_r8,0.54396e-03_r8 /) + kbo(:, 1,31, 4) = (/ & + & 0.13991e-05_r8,0.25687e-03_r8,0.39996e-03_r8,0.48307e-03_r8,0.35570e-03_r8 /) + kbo(:, 2,31, 4) = (/ & + & 0.16564e-05_r8,0.28246e-03_r8,0.43858e-03_r8,0.52743e-03_r8,0.38211e-03_r8 /) + kbo(:, 3,31, 4) = (/ & + & 0.19660e-05_r8,0.30971e-03_r8,0.47856e-03_r8,0.57309e-03_r8,0.40826e-03_r8 /) + kbo(:, 4,31, 4) = (/ & + & 0.23334e-05_r8,0.33881e-03_r8,0.52066e-03_r8,0.61919e-03_r8,0.43367e-03_r8 /) + kbo(:, 5,31, 4) = (/ & + & 0.27587e-05_r8,0.36964e-03_r8,0.56499e-03_r8,0.66660e-03_r8,0.45969e-03_r8 /) + kbo(:, 1,32, 4) = (/ & + & 0.11711e-05_r8,0.22102e-03_r8,0.34394e-03_r8,0.41512e-03_r8,0.29980e-03_r8 /) + kbo(:, 2,32, 4) = (/ & + & 0.13928e-05_r8,0.24337e-03_r8,0.37713e-03_r8,0.45351e-03_r8,0.32253e-03_r8 /) + kbo(:, 3,32, 4) = (/ & + & 0.16589e-05_r8,0.26704e-03_r8,0.41202e-03_r8,0.49272e-03_r8,0.34442e-03_r8 /) + kbo(:, 4,32, 4) = (/ & + & 0.19740e-05_r8,0.29261e-03_r8,0.44855e-03_r8,0.53274e-03_r8,0.36633e-03_r8 /) + kbo(:, 5,32, 4) = (/ & + & 0.23323e-05_r8,0.31973e-03_r8,0.48726e-03_r8,0.57383e-03_r8,0.38915e-03_r8 /) + kbo(:, 1,33, 4) = (/ & + & 0.98300e-06_r8,0.19047e-03_r8,0.29592e-03_r8,0.35739e-03_r8,0.25303e-03_r8 /) + kbo(:, 2,33, 4) = (/ & + & 0.11751e-05_r8,0.20983e-03_r8,0.32474e-03_r8,0.39043e-03_r8,0.27259e-03_r8 /) + kbo(:, 3,33, 4) = (/ & + & 0.14027e-05_r8,0.23065e-03_r8,0.35505e-03_r8,0.42405e-03_r8,0.29120e-03_r8 /) + kbo(:, 4,33, 4) = (/ & + & 0.16692e-05_r8,0.25302e-03_r8,0.38699e-03_r8,0.45888e-03_r8,0.31018e-03_r8 /) + kbo(:, 5,33, 4) = (/ & + & 0.19716e-05_r8,0.27715e-03_r8,0.42119e-03_r8,0.49468e-03_r8,0.32989e-03_r8 /) + kbo(:, 1,34, 4) = (/ & + & 0.82915e-06_r8,0.16396e-03_r8,0.25433e-03_r8,0.30700e-03_r8,0.21406e-03_r8 /) + kbo(:, 2,34, 4) = (/ & + & 0.99352e-06_r8,0.18083e-03_r8,0.27935e-03_r8,0.33552e-03_r8,0.23048e-03_r8 /) + kbo(:, 3,34, 4) = (/ & + & 0.11877e-05_r8,0.19915e-03_r8,0.30578e-03_r8,0.36455e-03_r8,0.24659e-03_r8 /) + kbo(:, 4,34, 4) = (/ & + & 0.14139e-05_r8,0.21886e-03_r8,0.33384e-03_r8,0.39476e-03_r8,0.26317e-03_r8 /) + kbo(:, 5,34, 4) = (/ & + & 0.16670e-05_r8,0.24021e-03_r8,0.36390e-03_r8,0.42603e-03_r8,0.28005e-03_r8 /) + kbo(:, 1,35, 4) = (/ & + & 0.68670e-06_r8,0.13979e-03_r8,0.21673e-03_r8,0.26161e-03_r8,0.17974e-03_r8 /) + kbo(:, 2,35, 4) = (/ & + & 0.82437e-06_r8,0.15448e-03_r8,0.23846e-03_r8,0.28611e-03_r8,0.19377e-03_r8 /) + kbo(:, 3,35, 4) = (/ & + & 0.98649e-06_r8,0.17044e-03_r8,0.26139e-03_r8,0.31132e-03_r8,0.20765e-03_r8 /) + kbo(:, 4,35, 4) = (/ & + & 0.11740e-05_r8,0.18773e-03_r8,0.28609e-03_r8,0.33740e-03_r8,0.22197e-03_r8 /) + kbo(:, 5,35, 4) = (/ & + & 0.13833e-05_r8,0.20652e-03_r8,0.31233e-03_r8,0.36449e-03_r8,0.23658e-03_r8 /) + kbo(:, 1,36, 4) = (/ & + & 0.55564e-06_r8,0.11786e-03_r8,0.18283e-03_r8,0.22089e-03_r8,0.14951e-03_r8 /) + kbo(:, 2,36, 4) = (/ & + & 0.66731e-06_r8,0.13053e-03_r8,0.20151e-03_r8,0.24189e-03_r8,0.16146e-03_r8 /) + kbo(:, 3,36, 4) = (/ & + & 0.80048e-06_r8,0.14432e-03_r8,0.22154e-03_r8,0.26364e-03_r8,0.17348e-03_r8 /) + kbo(:, 4,36, 4) = (/ & + & 0.95195e-06_r8,0.15937e-03_r8,0.24310e-03_r8,0.28609e-03_r8,0.18577e-03_r8 /) + kbo(:, 5,36, 4) = (/ & + & 0.11217e-05_r8,0.17580e-03_r8,0.26601e-03_r8,0.30949e-03_r8,0.19850e-03_r8 /) + kbo(:, 1,37, 4) = (/ & + & 0.44526e-06_r8,0.98334e-04_r8,0.15236e-03_r8,0.18395e-03_r8,0.12369e-03_r8 /) + kbo(:, 2,37, 4) = (/ & + & 0.53551e-06_r8,0.10927e-03_r8,0.16837e-03_r8,0.20194e-03_r8,0.13387e-03_r8 /) + kbo(:, 3,37, 4) = (/ & + & 0.64307e-06_r8,0.12110e-03_r8,0.18556e-03_r8,0.22059e-03_r8,0.14418e-03_r8 /) + kbo(:, 4,37, 4) = (/ & + & 0.76688e-06_r8,0.13411e-03_r8,0.20414e-03_r8,0.23985e-03_r8,0.15477e-03_r8 /) + kbo(:, 5,37, 4) = (/ & + & 0.90591e-06_r8,0.14842e-03_r8,0.22405e-03_r8,0.25996e-03_r8,0.16566e-03_r8 /) + kbo(:, 1,38, 4) = (/ & + & 0.35630e-06_r8,0.81991e-04_r8,0.12690e-03_r8,0.15312e-03_r8,0.10226e-03_r8 /) + kbo(:, 2,38, 4) = (/ & + & 0.42911e-06_r8,0.91391e-04_r8,0.14064e-03_r8,0.16849e-03_r8,0.11095e-03_r8 /) + kbo(:, 3,38, 4) = (/ & + & 0.51583e-06_r8,0.10163e-03_r8,0.15538e-03_r8,0.18448e-03_r8,0.11977e-03_r8 /) + kbo(:, 4,38, 4) = (/ & + & 0.61654e-06_r8,0.11287e-03_r8,0.17138e-03_r8,0.20101e-03_r8,0.12884e-03_r8 /) + kbo(:, 5,38, 4) = (/ & + & 0.73028e-06_r8,0.12530e-03_r8,0.18862e-03_r8,0.21826e-03_r8,0.13816e-03_r8 /) + kbo(:, 1,39, 4) = (/ & + & 0.28455e-06_r8,0.68362e-04_r8,0.10572e-03_r8,0.12747e-03_r8,0.84494e-04_r8 /) + kbo(:, 2,39, 4) = (/ & + & 0.34313e-06_r8,0.76413e-04_r8,0.11751e-03_r8,0.14060e-03_r8,0.91905e-04_r8 /) + kbo(:, 3,39, 4) = (/ & + & 0.41305e-06_r8,0.85299e-04_r8,0.13016e-03_r8,0.15431e-03_r8,0.99463e-04_r8 /) + kbo(:, 4,39, 4) = (/ & + & 0.49466e-06_r8,0.95047e-04_r8,0.14396e-03_r8,0.16851e-03_r8,0.10725e-03_r8 /) + kbo(:, 5,39, 4) = (/ & + & 0.58721e-06_r8,0.10583e-03_r8,0.15886e-03_r8,0.18332e-03_r8,0.11516e-03_r8 /) + kbo(:, 1,40, 4) = (/ & + & 0.22416e-06_r8,0.56451e-04_r8,0.87192e-04_r8,0.10503e-03_r8,0.69299e-04_r8 /) + kbo(:, 2,40, 4) = (/ & + & 0.27058e-06_r8,0.63325e-04_r8,0.97241e-04_r8,0.11625e-03_r8,0.75635e-04_r8 /) + kbo(:, 3,40, 4) = (/ & + & 0.32640e-06_r8,0.70942e-04_r8,0.10801e-03_r8,0.12792e-03_r8,0.82061e-04_r8 /) + kbo(:, 4,40, 4) = (/ & + & 0.39178e-06_r8,0.79381e-04_r8,0.11985e-03_r8,0.14005e-03_r8,0.88722e-04_r8 /) + kbo(:, 5,40, 4) = (/ & + & 0.46694e-06_r8,0.88673e-04_r8,0.13261e-03_r8,0.15274e-03_r8,0.95437e-04_r8 /) + kbo(:, 1,41, 4) = (/ & + & 0.17620e-06_r8,0.46495e-04_r8,0.71829e-04_r8,0.86351e-04_r8,0.56701e-04_r8 /) + kbo(:, 2,41, 4) = (/ & + & 0.21295e-06_r8,0.52383e-04_r8,0.80380e-04_r8,0.95937e-04_r8,0.62100e-04_r8 /) + kbo(:, 3,41, 4) = (/ & + & 0.25720e-06_r8,0.58900e-04_r8,0.89548e-04_r8,0.10594e-03_r8,0.67568e-04_r8 /) + kbo(:, 4,41, 4) = (/ & + & 0.30957e-06_r8,0.66136e-04_r8,0.99643e-04_r8,0.11623e-03_r8,0.73280e-04_r8 /) + kbo(:, 5,41, 4) = (/ & + & 0.37003e-06_r8,0.74203e-04_r8,0.11061e-03_r8,0.12707e-03_r8,0.78979e-04_r8 /) + kbo(:, 1,42, 4) = (/ & + & 0.13843e-06_r8,0.38238e-04_r8,0.59124e-04_r8,0.70982e-04_r8,0.46331e-04_r8 /) + kbo(:, 2,42, 4) = (/ & + & 0.16726e-06_r8,0.43269e-04_r8,0.66424e-04_r8,0.79125e-04_r8,0.50956e-04_r8 /) + kbo(:, 3,42, 4) = (/ & + & 0.20232e-06_r8,0.48870e-04_r8,0.74247e-04_r8,0.87661e-04_r8,0.55561e-04_r8 /) + kbo(:, 4,42, 4) = (/ & + & 0.24408e-06_r8,0.55119e-04_r8,0.82827e-04_r8,0.96453e-04_r8,0.60447e-04_r8 /) + kbo(:, 5,42, 4) = (/ & + & 0.29276e-06_r8,0.62028e-04_r8,0.92221e-04_r8,0.10570e-03_r8,0.65281e-04_r8 /) + kbo(:, 1,43, 4) = (/ & + & 0.10793e-06_r8,0.31191e-04_r8,0.48305e-04_r8,0.57948e-04_r8,0.37666e-04_r8 /) + kbo(:, 2,43, 4) = (/ & + & 0.13017e-06_r8,0.35465e-04_r8,0.54489e-04_r8,0.64841e-04_r8,0.41556e-04_r8 /) + kbo(:, 3,43, 4) = (/ & + & 0.15771e-06_r8,0.40235e-04_r8,0.61176e-04_r8,0.72082e-04_r8,0.45452e-04_r8 /) + kbo(:, 4,43, 4) = (/ & + & 0.19064e-06_r8,0.45599e-04_r8,0.68488e-04_r8,0.79576e-04_r8,0.49593e-04_r8 /) + kbo(:, 5,43, 4) = (/ & + & 0.22944e-06_r8,0.51552e-04_r8,0.76431e-04_r8,0.87462e-04_r8,0.53715e-04_r8 /) + kbo(:, 1,44, 4) = (/ & + & 0.83879e-07_r8,0.25325e-04_r8,0.39297e-04_r8,0.47118e-04_r8,0.30510e-04_r8 /) + kbo(:, 2,44, 4) = (/ & + & 0.10087e-06_r8,0.28920e-04_r8,0.44532e-04_r8,0.52929e-04_r8,0.33772e-04_r8 /) + kbo(:, 3,44, 4) = (/ & + & 0.12238e-06_r8,0.32977e-04_r8,0.50189e-04_r8,0.59075e-04_r8,0.37069e-04_r8 /) + kbo(:, 4,44, 4) = (/ & + & 0.14813e-06_r8,0.37556e-04_r8,0.56451e-04_r8,0.65448e-04_r8,0.40567e-04_r8 /) + kbo(:, 5,44, 4) = (/ & + & 0.17874e-06_r8,0.42672e-04_r8,0.63196e-04_r8,0.72159e-04_r8,0.44085e-04_r8 /) + kbo(:, 1,45, 4) = (/ & + & 0.65261e-07_r8,0.20516e-04_r8,0.31895e-04_r8,0.38279e-04_r8,0.24650e-04_r8 /) + kbo(:, 2,45, 4) = (/ & + & 0.78145e-07_r8,0.23540e-04_r8,0.36319e-04_r8,0.43161e-04_r8,0.27390e-04_r8 /) + kbo(:, 3,45, 4) = (/ & + & 0.94805e-07_r8,0.26962e-04_r8,0.41134e-04_r8,0.48357e-04_r8,0.30190e-04_r8 /) + kbo(:, 4,45, 4) = (/ & + & 0.11490e-06_r8,0.30858e-04_r8,0.46429e-04_r8,0.53785e-04_r8,0.33136e-04_r8 /) + kbo(:, 5,45, 4) = (/ & + & 0.13905e-06_r8,0.35210e-04_r8,0.52216e-04_r8,0.59482e-04_r8,0.36122e-04_r8 /) + kbo(:, 1,46, 4) = (/ & + & 0.50668e-07_r8,0.16526e-04_r8,0.25752e-04_r8,0.30954e-04_r8,0.19817e-04_r8 /) + kbo(:, 2,46, 4) = (/ & + & 0.60361e-07_r8,0.19058e-04_r8,0.29471e-04_r8,0.35060e-04_r8,0.22123e-04_r8 /) + kbo(:, 3,46, 4) = (/ & + & 0.73101e-07_r8,0.21937e-04_r8,0.33569e-04_r8,0.39461e-04_r8,0.24498e-04_r8 /) + kbo(:, 4,46, 4) = (/ & + & 0.88747e-07_r8,0.25222e-04_r8,0.38048e-04_r8,0.44039e-04_r8,0.26973e-04_r8 /) + kbo(:, 5,46, 4) = (/ & + & 0.10762e-06_r8,0.28932e-04_r8,0.42964e-04_r8,0.48871e-04_r8,0.29499e-04_r8 /) + kbo(:, 1,47, 4) = (/ & + & 0.39185e-07_r8,0.13207e-04_r8,0.20626e-04_r8,0.24835e-04_r8,0.15826e-04_r8 /) + kbo(:, 2,47, 4) = (/ & + & 0.46335e-07_r8,0.15303e-04_r8,0.23722e-04_r8,0.28277e-04_r8,0.17762e-04_r8 /) + kbo(:, 3,47, 4) = (/ & + & 0.55896e-07_r8,0.17703e-04_r8,0.27162e-04_r8,0.31976e-04_r8,0.19780e-04_r8 /) + kbo(:, 4,47, 4) = (/ & + & 0.67962e-07_r8,0.20451e-04_r8,0.30940e-04_r8,0.35867e-04_r8,0.21834e-04_r8 /) + kbo(:, 5,47, 4) = (/ & + & 0.82535e-07_r8,0.23583e-04_r8,0.35128e-04_r8,0.39933e-04_r8,0.23972e-04_r8 /) + kbo(:, 1,48, 4) = (/ & + & 0.30435e-07_r8,0.10528e-04_r8,0.16458e-04_r8,0.19871e-04_r8,0.12630e-04_r8 /) + kbo(:, 2,48, 4) = (/ & + & 0.35657e-07_r8,0.12255e-04_r8,0.19034e-04_r8,0.22757e-04_r8,0.14230e-04_r8 /) + kbo(:, 3,48, 4) = (/ & + & 0.42777e-07_r8,0.14241e-04_r8,0.21916e-04_r8,0.25856e-04_r8,0.15916e-04_r8 /) + kbo(:, 4,48, 4) = (/ & + & 0.51977e-07_r8,0.16531e-04_r8,0.25094e-04_r8,0.29142e-04_r8,0.17632e-04_r8 /) + kbo(:, 5,48, 4) = (/ & + & 0.63246e-07_r8,0.19162e-04_r8,0.28631e-04_r8,0.32586e-04_r8,0.19447e-04_r8 /) + kbo(:, 1,49, 4) = (/ & + & 0.23722e-07_r8,0.83656e-05_r8,0.13088e-04_r8,0.15834e-04_r8,0.10060e-04_r8 /) + kbo(:, 2,49, 4) = (/ & + & 0.27509e-07_r8,0.97869e-05_r8,0.15227e-04_r8,0.18252e-04_r8,0.11363e-04_r8 /) + kbo(:, 3,49, 4) = (/ & + & 0.32769e-07_r8,0.11426e-04_r8,0.17628e-04_r8,0.20853e-04_r8,0.12767e-04_r8 /) + kbo(:, 4,49, 4) = (/ & + & 0.39719e-07_r8,0.13326e-04_r8,0.20285e-04_r8,0.23637e-04_r8,0.14223e-04_r8 /) + kbo(:, 5,49, 4) = (/ & + & 0.48415e-07_r8,0.15524e-04_r8,0.23268e-04_r8,0.26530e-04_r8,0.15739e-04_r8 /) + kbo(:, 1,50, 4) = (/ & + & 0.18623e-07_r8,0.66620e-05_r8,0.10425e-04_r8,0.12634e-04_r8,0.80132e-05_r8 /) + kbo(:, 2,50, 4) = (/ & + & 0.21393e-07_r8,0.78264e-05_r8,0.12188e-04_r8,0.14643e-04_r8,0.90757e-05_r8 /) + kbo(:, 3,50, 4) = (/ & + & 0.25281e-07_r8,0.91787e-05_r8,0.14186e-04_r8,0.16825e-04_r8,0.10247e-04_r8 /) + kbo(:, 4,50, 4) = (/ & + & 0.30530e-07_r8,0.10758e-04_r8,0.16419e-04_r8,0.19178e-04_r8,0.11482e-04_r8 /) + kbo(:, 5,50, 4) = (/ & + & 0.37213e-07_r8,0.12593e-04_r8,0.18920e-04_r8,0.21643e-04_r8,0.12749e-04_r8 /) + kbo(:, 1,51, 4) = (/ & + & 0.14681e-07_r8,0.53043e-05_r8,0.82956e-05_r8,0.10064e-04_r8,0.63669e-05_r8 /) + kbo(:, 2,51, 4) = (/ & + & 0.16717e-07_r8,0.62508e-05_r8,0.97501e-05_r8,0.11737e-04_r8,0.72473e-05_r8 /) + kbo(:, 3,51, 4) = (/ & + & 0.19587e-07_r8,0.73643e-05_r8,0.11400e-04_r8,0.13558e-04_r8,0.82290e-05_r8 /) + kbo(:, 4,51, 4) = (/ & + & 0.23555e-07_r8,0.86748e-05_r8,0.13268e-04_r8,0.15537e-04_r8,0.92634e-05_r8 /) + kbo(:, 5,51, 4) = (/ & + & 0.28671e-07_r8,0.10209e-04_r8,0.15379e-04_r8,0.17635e-04_r8,0.10316e-04_r8 /) + kbo(:, 1,52, 4) = (/ & + & 0.11626e-07_r8,0.42149e-05_r8,0.65740e-05_r8,0.79835e-05_r8,0.50595e-05_r8 /) + kbo(:, 2,52, 4) = (/ & + & 0.13102e-07_r8,0.49884e-05_r8,0.77758e-05_r8,0.93846e-05_r8,0.57856e-05_r8 /) + kbo(:, 3,52, 4) = (/ & + & 0.15208e-07_r8,0.58955e-05_r8,0.91392e-05_r8,0.10898e-04_r8,0.65937e-05_r8 /) + kbo(:, 4,52, 4) = (/ & + & 0.18174e-07_r8,0.69758e-05_r8,0.10692e-04_r8,0.12554e-04_r8,0.74564e-05_r8 /) + kbo(:, 5,52, 4) = (/ & + & 0.22057e-07_r8,0.82505e-05_r8,0.12462e-04_r8,0.14331e-04_r8,0.83301e-05_r8 /) + kbo(:, 1,53, 4) = (/ & + & 0.92130e-08_r8,0.33378e-05_r8,0.51998e-05_r8,0.63006e-05_r8,0.40097e-05_r8 /) + kbo(:, 2,53, 4) = (/ & + & 0.10298e-07_r8,0.39704e-05_r8,0.61839e-05_r8,0.74775e-05_r8,0.46077e-05_r8 /) + kbo(:, 3,53, 4) = (/ & + & 0.11831e-07_r8,0.47088e-05_r8,0.73062e-05_r8,0.87345e-05_r8,0.52620e-05_r8 /) + kbo(:, 4,53, 4) = (/ & + & 0.14030e-07_r8,0.55942e-05_r8,0.85921e-05_r8,0.10119e-04_r8,0.59838e-05_r8 /) + kbo(:, 5,53, 4) = (/ & + & 0.16970e-07_r8,0.66447e-05_r8,0.10063e-04_r8,0.11620e-04_r8,0.67208e-05_r8 /) + kbo(:, 1,54, 4) = (/ & + & 0.73443e-08_r8,0.26498e-05_r8,0.41229e-05_r8,0.49788e-05_r8,0.31929e-05_r8 /) + kbo(:, 2,54, 4) = (/ & + & 0.81453e-08_r8,0.31689e-05_r8,0.49320e-05_r8,0.59701e-05_r8,0.36706e-05_r8 /) + kbo(:, 3,54, 4) = (/ & + & 0.92853e-08_r8,0.37746e-05_r8,0.58561e-05_r8,0.70139e-05_r8,0.42105e-05_r8 /) + kbo(:, 4,54, 4) = (/ & + & 0.10913e-07_r8,0.44986e-05_r8,0.69192e-05_r8,0.81733e-05_r8,0.48081e-05_r8 /) + kbo(:, 5,54, 4) = (/ & + & 0.13151e-07_r8,0.53689e-05_r8,0.81469e-05_r8,0.94377e-05_r8,0.54320e-05_r8 /) + kbo(:, 1,55, 4) = (/ & + & 0.58690e-08_r8,0.21056e-05_r8,0.32710e-05_r8,0.39362e-05_r8,0.25357e-05_r8 /) + kbo(:, 2,55, 4) = (/ & + & 0.64824e-08_r8,0.25292e-05_r8,0.39335e-05_r8,0.47652e-05_r8,0.29266e-05_r8 /) + kbo(:, 3,55, 4) = (/ & + & 0.73195e-08_r8,0.30260e-05_r8,0.46942e-05_r8,0.56346e-05_r8,0.33700e-05_r8 /) + kbo(:, 4,55, 4) = (/ & + & 0.85298e-08_r8,0.36216e-05_r8,0.55727e-05_r8,0.65990e-05_r8,0.38662e-05_r8 /) + kbo(:, 5,55, 4) = (/ & + & 0.10227e-07_r8,0.43366e-05_r8,0.65935e-05_r8,0.76627e-05_r8,0.43889e-05_r8 /) + kbo(:, 1,56, 4) = (/ & + & 0.46879e-08_r8,0.16674e-05_r8,0.25848e-05_r8,0.30992e-05_r8,0.20097e-05_r8 /) + kbo(:, 2,56, 4) = (/ & + & 0.51579e-08_r8,0.20145e-05_r8,0.31307e-05_r8,0.37875e-05_r8,0.23304e-05_r8 /) + kbo(:, 3,56, 4) = (/ & + & 0.57829e-08_r8,0.24199e-05_r8,0.37529e-05_r8,0.45119e-05_r8,0.26962e-05_r8 /) + kbo(:, 4,56, 4) = (/ & + & 0.66817e-08_r8,0.29092e-05_r8,0.44788e-05_r8,0.53142e-05_r8,0.31037e-05_r8 /) + kbo(:, 5,56, 4) = (/ & + & 0.79548e-08_r8,0.34985e-05_r8,0.53248e-05_r8,0.62066e-05_r8,0.35387e-05_r8 /) + kbo(:, 1,57, 4) = (/ & + & 0.37487e-08_r8,0.13177e-05_r8,0.20362e-05_r8,0.24278e-05_r8,0.15888e-05_r8 /) + kbo(:, 2,57, 4) = (/ & + & 0.41132e-08_r8,0.16006e-05_r8,0.24863e-05_r8,0.30001e-05_r8,0.18530e-05_r8 /) + kbo(:, 3,57, 4) = (/ & + & 0.45796e-08_r8,0.19301e-05_r8,0.29957e-05_r8,0.36053e-05_r8,0.21515e-05_r8 /) + kbo(:, 4,57, 4) = (/ & + & 0.52447e-08_r8,0.23301e-05_r8,0.35902e-05_r8,0.42690e-05_r8,0.24844e-05_r8 /) + kbo(:, 5,57, 4) = (/ & + & 0.61952e-08_r8,0.28175e-05_r8,0.42894e-05_r8,0.50133e-05_r8,0.28503e-05_r8 /) + kbo(:, 1,58, 4) = (/ & + & 0.30053e-08_r8,0.10419e-05_r8,0.16034e-05_r8,0.19071e-05_r8,0.12550e-05_r8 /) + kbo(:, 2,58, 4) = (/ & + & 0.32906e-08_r8,0.12717e-05_r8,0.19750e-05_r8,0.23751e-05_r8,0.14761e-05_r8 /) + kbo(:, 3,58, 4) = (/ & + & 0.36412e-08_r8,0.15413e-05_r8,0.23950e-05_r8,0.28817e-05_r8,0.17173e-05_r8 /) + kbo(:, 4,58, 4) = (/ & + & 0.41327e-08_r8,0.18673e-05_r8,0.28800e-05_r8,0.34301e-05_r8,0.19893e-05_r8 /) + kbo(:, 5,58, 4) = (/ & + & 0.48448e-08_r8,0.22699e-05_r8,0.34559e-05_r8,0.40496e-05_r8,0.22938e-05_r8 /) + kbo(:, 1,59, 4) = (/ & + & 0.24517e-08_r8,0.85367e-06_r8,0.13121e-05_r8,0.15587e-05_r8,0.10209e-05_r8 /) + kbo(:, 2,59, 4) = (/ & + & 0.26814e-08_r8,0.10459e-05_r8,0.16241e-05_r8,0.19505e-05_r8,0.12067e-05_r8 /) + kbo(:, 3,59, 4) = (/ & + & 0.29604e-08_r8,0.12726e-05_r8,0.19786e-05_r8,0.23765e-05_r8,0.14071e-05_r8 /) + kbo(:, 4,59, 4) = (/ & + & 0.33490e-08_r8,0.15486e-05_r8,0.23884e-05_r8,0.28393e-05_r8,0.16353e-05_r8 /) + kbo(:, 5,59, 4) = (/ & + & 0.39177e-08_r8,0.18923e-05_r8,0.28751e-05_r8,0.33648e-05_r8,0.18896e-05_r8 /) + kbo(:, 1,13, 5) = (/ & + & 0.10606e-02_r8,0.17616e-01_r8,0.26337e-01_r8,0.30832e-01_r8,0.23250e-01_r8 /) + kbo(:, 2,13, 5) = (/ & + & 0.11975e-02_r8,0.18851e-01_r8,0.27746e-01_r8,0.32191e-01_r8,0.24461e-01_r8 /) + kbo(:, 3,13, 5) = (/ & + & 0.13686e-02_r8,0.20236e-01_r8,0.29224e-01_r8,0.33409e-01_r8,0.25538e-01_r8 /) + kbo(:, 4,13, 5) = (/ & + & 0.15788e-02_r8,0.21686e-01_r8,0.30822e-01_r8,0.34581e-01_r8,0.26483e-01_r8 /) + kbo(:, 5,13, 5) = (/ & + & 0.18422e-02_r8,0.23201e-01_r8,0.32485e-01_r8,0.35791e-01_r8,0.27339e-01_r8 /) + kbo(:, 1,14, 5) = (/ & + & 0.90299e-03_r8,0.14939e-01_r8,0.22235e-01_r8,0.25969e-01_r8,0.19459e-01_r8 /) + kbo(:, 2,14, 5) = (/ & + & 0.10276e-02_r8,0.16043e-01_r8,0.23464e-01_r8,0.27102e-01_r8,0.20418e-01_r8 /) + kbo(:, 3,14, 5) = (/ & + & 0.11848e-02_r8,0.17244e-01_r8,0.24766e-01_r8,0.28137e-01_r8,0.21279e-01_r8 /) + kbo(:, 4,14, 5) = (/ & + & 0.13763e-02_r8,0.18494e-01_r8,0.26159e-01_r8,0.29141e-01_r8,0.22035e-01_r8 /) + kbo(:, 5,14, 5) = (/ & + & 0.16087e-02_r8,0.19801e-01_r8,0.27586e-01_r8,0.30208e-01_r8,0.22712e-01_r8 /) + kbo(:, 1,15, 5) = (/ & + & 0.76169e-03_r8,0.12657e-01_r8,0.18744e-01_r8,0.21807e-01_r8,0.16155e-01_r8 /) + kbo(:, 2,15, 5) = (/ & + & 0.87429e-03_r8,0.13622e-01_r8,0.19820e-01_r8,0.22753e-01_r8,0.16908e-01_r8 /) + kbo(:, 3,15, 5) = (/ & + & 0.10153e-02_r8,0.14650e-01_r8,0.20967e-01_r8,0.23637e-01_r8,0.17597e-01_r8 /) + kbo(:, 4,15, 5) = (/ & + & 0.11860e-02_r8,0.15728e-01_r8,0.22159e-01_r8,0.24521e-01_r8,0.18236e-01_r8 /) + kbo(:, 5,15, 5) = (/ & + & 0.13940e-02_r8,0.16855e-01_r8,0.23377e-01_r8,0.25442e-01_r8,0.18800e-01_r8 /) + kbo(:, 1,16, 5) = (/ & + & 0.63979e-03_r8,0.10716e-01_r8,0.15782e-01_r8,0.18280e-01_r8,0.13330e-01_r8 /) + kbo(:, 2,16, 5) = (/ & + & 0.73992e-03_r8,0.11550e-01_r8,0.16721e-01_r8,0.19074e-01_r8,0.13955e-01_r8 /) + kbo(:, 3,16, 5) = (/ & + & 0.86535e-03_r8,0.12432e-01_r8,0.17715e-01_r8,0.19835e-01_r8,0.14519e-01_r8 /) + kbo(:, 4,16, 5) = (/ & + & 0.10180e-02_r8,0.13358e-01_r8,0.18733e-01_r8,0.20612e-01_r8,0.15053e-01_r8 /) + kbo(:, 5,16, 5) = (/ & + & 0.12020e-02_r8,0.14330e-01_r8,0.19780e-01_r8,0.21390e-01_r8,0.15523e-01_r8 /) + kbo(:, 1,17, 5) = (/ & + & 0.53827e-03_r8,0.90675e-02_r8,0.13282e-01_r8,0.15310e-01_r8,0.11002e-01_r8 /) + kbo(:, 2,17, 5) = (/ & + & 0.62733e-03_r8,0.97818e-02_r8,0.14093e-01_r8,0.15985e-01_r8,0.11517e-01_r8 /) + kbo(:, 3,17, 5) = (/ & + & 0.73894e-03_r8,0.10536e-01_r8,0.14937e-01_r8,0.16642e-01_r8,0.11982e-01_r8 /) + kbo(:, 4,17, 5) = (/ & + & 0.87471e-03_r8,0.11329e-01_r8,0.15813e-01_r8,0.17308e-01_r8,0.12431e-01_r8 /) + kbo(:, 5,17, 5) = (/ & + & 0.10369e-02_r8,0.12167e-01_r8,0.16717e-01_r8,0.17966e-01_r8,0.12833e-01_r8 /) + kbo(:, 1,18, 5) = (/ & + & 0.45632e-03_r8,0.76631e-02_r8,0.11175e-01_r8,0.12821e-01_r8,0.91007e-02_r8 /) + kbo(:, 2,18, 5) = (/ & + & 0.53618e-03_r8,0.82741e-02_r8,0.11867e-01_r8,0.13402e-01_r8,0.95284e-02_r8 /) + kbo(:, 3,18, 5) = (/ & + & 0.63520e-03_r8,0.89179e-02_r8,0.12591e-01_r8,0.13960e-01_r8,0.99227e-02_r8 /) + kbo(:, 4,18, 5) = (/ & + & 0.75513e-03_r8,0.95966e-02_r8,0.13345e-01_r8,0.14529e-01_r8,0.10294e-01_r8 /) + kbo(:, 5,18, 5) = (/ & + & 0.89828e-03_r8,0.10325e-01_r8,0.14127e-01_r8,0.15082e-01_r8,0.10637e-01_r8 /) + kbo(:, 1,19, 5) = (/ & + & 0.38782e-03_r8,0.64686e-02_r8,0.93947e-02_r8,0.10738e-01_r8,0.75366e-02_r8 /) + kbo(:, 2,19, 5) = (/ & + & 0.45826e-03_r8,0.69872e-02_r8,0.99878e-02_r8,0.11230e-01_r8,0.78920e-02_r8 /) + kbo(:, 3,19, 5) = (/ & + & 0.54544e-03_r8,0.75386e-02_r8,0.10613e-01_r8,0.11706e-01_r8,0.82219e-02_r8 /) + kbo(:, 4,19, 5) = (/ & + & 0.65085e-03_r8,0.81243e-02_r8,0.11261e-01_r8,0.12183e-01_r8,0.85447e-02_r8 /) + kbo(:, 5,19, 5) = (/ & + & 0.77601e-03_r8,0.87598e-02_r8,0.11933e-01_r8,0.12660e-01_r8,0.88388e-02_r8 /) + kbo(:, 1,20, 5) = (/ & + & 0.33304e-03_r8,0.54623e-02_r8,0.79028e-02_r8,0.89960e-02_r8,0.62635e-02_r8 /) + kbo(:, 2,20, 5) = (/ & + & 0.39553e-03_r8,0.59055e-02_r8,0.84155e-02_r8,0.94111e-02_r8,0.65613e-02_r8 /) + kbo(:, 3,20, 5) = (/ & + & 0.47180e-03_r8,0.63779e-02_r8,0.89500e-02_r8,0.98172e-02_r8,0.68459e-02_r8 /) + kbo(:, 4,20, 5) = (/ & + & 0.56453e-03_r8,0.68862e-02_r8,0.95048e-02_r8,0.10225e-01_r8,0.71246e-02_r8 /) + kbo(:, 5,20, 5) = (/ & + & 0.67486e-03_r8,0.74411e-02_r8,0.10082e-01_r8,0.10637e-01_r8,0.73786e-02_r8 /) + kbo(:, 1,21, 5) = (/ & + & 0.28693e-03_r8,0.46180e-02_r8,0.66504e-02_r8,0.75379e-02_r8,0.52071e-02_r8 /) + kbo(:, 2,21, 5) = (/ & + & 0.34180e-03_r8,0.49948e-02_r8,0.70898e-02_r8,0.78866e-02_r8,0.54645e-02_r8 /) + kbo(:, 3,21, 5) = (/ & + & 0.40811e-03_r8,0.54006e-02_r8,0.75474e-02_r8,0.82331e-02_r8,0.57127e-02_r8 /) + kbo(:, 4,21, 5) = (/ & + & 0.48873e-03_r8,0.58434e-02_r8,0.80212e-02_r8,0.85844e-02_r8,0.59470e-02_r8 /) + kbo(:, 5,21, 5) = (/ & + & 0.58593e-03_r8,0.63260e-02_r8,0.85182e-02_r8,0.89408e-02_r8,0.61662e-02_r8 /) + kbo(:, 1,22, 5) = (/ & + & 0.24974e-03_r8,0.39240e-02_r8,0.56208e-02_r8,0.63345e-02_r8,0.43431e-02_r8 /) + kbo(:, 2,22, 5) = (/ & + & 0.29749e-03_r8,0.42526e-02_r8,0.59996e-02_r8,0.66266e-02_r8,0.45624e-02_r8 /) + kbo(:, 3,22, 5) = (/ & + & 0.35608e-03_r8,0.46047e-02_r8,0.63919e-02_r8,0.69259e-02_r8,0.47738e-02_r8 /) + kbo(:, 4,22, 5) = (/ & + & 0.42699e-03_r8,0.49920e-02_r8,0.67993e-02_r8,0.72276e-02_r8,0.49714e-02_r8 /) + kbo(:, 5,22, 5) = (/ & + & 0.51198e-03_r8,0.54166e-02_r8,0.72302e-02_r8,0.75387e-02_r8,0.51660e-02_r8 /) + kbo(:, 1,23, 5) = (/ & + & 0.21716e-03_r8,0.33375e-02_r8,0.47528e-02_r8,0.53238e-02_r8,0.36258e-02_r8 /) + kbo(:, 2,23, 5) = (/ & + & 0.25886e-03_r8,0.36243e-02_r8,0.50797e-02_r8,0.55740e-02_r8,0.38107e-02_r8 /) + kbo(:, 3,23, 5) = (/ & + & 0.31026e-03_r8,0.39353e-02_r8,0.54169e-02_r8,0.58309e-02_r8,0.39876e-02_r8 /) + kbo(:, 4,23, 5) = (/ & + & 0.37235e-03_r8,0.42757e-02_r8,0.57711e-02_r8,0.60911e-02_r8,0.41586e-02_r8 /) + kbo(:, 5,23, 5) = (/ & + & 0.44568e-03_r8,0.46463e-02_r8,0.61476e-02_r8,0.63633e-02_r8,0.43277e-02_r8 /) + kbo(:, 1,24, 5) = (/ & + & 0.18738e-03_r8,0.28412e-02_r8,0.40251e-02_r8,0.44754e-02_r8,0.30232e-02_r8 /) + kbo(:, 2,24, 5) = (/ & + & 0.22422e-03_r8,0.30930e-02_r8,0.43062e-02_r8,0.46921e-02_r8,0.31788e-02_r8 /) + kbo(:, 3,24, 5) = (/ & + & 0.26942e-03_r8,0.33694e-02_r8,0.45983e-02_r8,0.49126e-02_r8,0.33287e-02_r8 /) + kbo(:, 4,24, 5) = (/ & + & 0.32317e-03_r8,0.36702e-02_r8,0.49092e-02_r8,0.51393e-02_r8,0.34771e-02_r8 /) + kbo(:, 5,24, 5) = (/ & + & 0.38638e-03_r8,0.39951e-02_r8,0.52385e-02_r8,0.53815e-02_r8,0.36232e-02_r8 /) + kbo(:, 1,25, 5) = (/ & + & 0.16224e-03_r8,0.24232e-02_r8,0.34141e-02_r8,0.37661e-02_r8,0.25262e-02_r8 /) + kbo(:, 2,25, 5) = (/ & + & 0.19465e-03_r8,0.26463e-02_r8,0.36575e-02_r8,0.39541e-02_r8,0.26577e-02_r8 /) + kbo(:, 3,25, 5) = (/ & + & 0.23391e-03_r8,0.28936e-02_r8,0.39130e-02_r8,0.41446e-02_r8,0.27841e-02_r8 /) + kbo(:, 4,25, 5) = (/ & + & 0.28044e-03_r8,0.31598e-02_r8,0.41853e-02_r8,0.43442e-02_r8,0.29098e-02_r8 /) + kbo(:, 5,25, 5) = (/ & + & 0.33483e-03_r8,0.34437e-02_r8,0.44735e-02_r8,0.45625e-02_r8,0.30351e-02_r8 /) + kbo(:, 1,26, 5) = (/ & + & 0.14132e-03_r8,0.20737e-02_r8,0.29036e-02_r8,0.31762e-02_r8,0.21157e-02_r8 /) + kbo(:, 2,26, 5) = (/ & + & 0.16977e-03_r8,0.22743e-02_r8,0.31152e-02_r8,0.33382e-02_r8,0.22258e-02_r8 /) + kbo(:, 3,26, 5) = (/ & + & 0.20409e-03_r8,0.24947e-02_r8,0.33401e-02_r8,0.35048e-02_r8,0.23338e-02_r8 /) + kbo(:, 4,26, 5) = (/ & + & 0.24472e-03_r8,0.27297e-02_r8,0.35798e-02_r8,0.36835e-02_r8,0.24421e-02_r8 /) + kbo(:, 5,26, 5) = (/ & + & 0.29131e-03_r8,0.29804e-02_r8,0.38308e-02_r8,0.38797e-02_r8,0.25500e-02_r8 /) + kbo(:, 1,27, 5) = (/ & + & 0.12293e-03_r8,0.17797e-02_r8,0.24725e-02_r8,0.26822e-02_r8,0.17718e-02_r8 /) + kbo(:, 2,27, 5) = (/ & + & 0.14789e-03_r8,0.19595e-02_r8,0.26584e-02_r8,0.28222e-02_r8,0.18655e-02_r8 /) + kbo(:, 3,27, 5) = (/ & + & 0.17790e-03_r8,0.21552e-02_r8,0.28584e-02_r8,0.29695e-02_r8,0.19589e-02_r8 /) + kbo(:, 4,27, 5) = (/ & + & 0.21315e-03_r8,0.23624e-02_r8,0.30688e-02_r8,0.31309e-02_r8,0.20520e-02_r8 /) + kbo(:, 5,27, 5) = (/ & + & 0.25285e-03_r8,0.25825e-02_r8,0.32876e-02_r8,0.33068e-02_r8,0.21445e-02_r8 /) + kbo(:, 1,28, 5) = (/ & + & 0.10657e-03_r8,0.15319e-02_r8,0.21096e-02_r8,0.22678e-02_r8,0.14844e-02_r8 /) + kbo(:, 2,28, 5) = (/ & + & 0.12856e-03_r8,0.16920e-02_r8,0.22743e-02_r8,0.23899e-02_r8,0.15639e-02_r8 /) + kbo(:, 3,28, 5) = (/ & + & 0.15471e-03_r8,0.18636e-02_r8,0.24511e-02_r8,0.25221e-02_r8,0.16436e-02_r8 /) + kbo(:, 4,28, 5) = (/ & + & 0.18512e-03_r8,0.20472e-02_r8,0.26364e-02_r8,0.26681e-02_r8,0.17238e-02_r8 /) + kbo(:, 5,28, 5) = (/ & + & 0.21872e-03_r8,0.22411e-02_r8,0.28270e-02_r8,0.28260e-02_r8,0.18048e-02_r8 /) + kbo(:, 1,29, 5) = (/ & + & 0.92876e-04_r8,0.13237e-02_r8,0.18049e-02_r8,0.19214e-02_r8,0.12471e-02_r8 /) + kbo(:, 2,29, 5) = (/ & + & 0.11226e-03_r8,0.14659e-02_r8,0.19518e-02_r8,0.20295e-02_r8,0.13143e-02_r8 /) + kbo(:, 3,29, 5) = (/ & + & 0.13519e-03_r8,0.16171e-02_r8,0.21089e-02_r8,0.21498e-02_r8,0.13833e-02_r8 /) + kbo(:, 4,29, 5) = (/ & + & 0.16102e-03_r8,0.17778e-02_r8,0.22703e-02_r8,0.22810e-02_r8,0.14528e-02_r8 /) + kbo(:, 5,29, 5) = (/ & + & 0.18981e-03_r8,0.19484e-02_r8,0.24374e-02_r8,0.24249e-02_r8,0.15236e-02_r8 /) + kbo(:, 1,30, 5) = (/ & + & 0.80828e-04_r8,0.11471e-02_r8,0.15486e-02_r8,0.16307e-02_r8,0.10482e-02_r8 /) + kbo(:, 2,30, 5) = (/ & + & 0.98063e-04_r8,0.12718e-02_r8,0.16797e-02_r8,0.17287e-02_r8,0.11053e-02_r8 /) + kbo(:, 3,30, 5) = (/ & + & 0.11772e-03_r8,0.14050e-02_r8,0.18177e-02_r8,0.18379e-02_r8,0.11648e-02_r8 /) + kbo(:, 4,30, 5) = (/ & + & 0.13981e-03_r8,0.15469e-02_r8,0.19589e-02_r8,0.19565e-02_r8,0.12258e-02_r8 /) + kbo(:, 5,30, 5) = (/ & + & 0.16446e-03_r8,0.16947e-02_r8,0.21055e-02_r8,0.20874e-02_r8,0.12885e-02_r8 /) + kbo(:, 1,31, 5) = (/ & + & 0.70539e-04_r8,0.99621e-03_r8,0.13325e-02_r8,0.13879e-02_r8,0.88220e-03_r8 /) + kbo(:, 2,31, 5) = (/ & + & 0.85589e-04_r8,0.11063e-02_r8,0.14492e-02_r8,0.14776e-02_r8,0.93113e-03_r8 /) + kbo(:, 3,31, 5) = (/ & + & 0.10244e-03_r8,0.12240e-02_r8,0.15701e-02_r8,0.15764e-02_r8,0.98237e-03_r8 /) + kbo(:, 4,31, 5) = (/ & + & 0.12151e-03_r8,0.13488e-02_r8,0.16942e-02_r8,0.16846e-02_r8,0.10364e-02_r8 /) + kbo(:, 5,31, 5) = (/ & + & 0.14245e-03_r8,0.14753e-02_r8,0.18229e-02_r8,0.18042e-02_r8,0.10910e-02_r8 /) + kbo(:, 1,32, 5) = (/ & + & 0.61598e-04_r8,0.86708e-03_r8,0.11506e-02_r8,0.11857e-02_r8,0.74396e-03_r8 /) + kbo(:, 2,32, 5) = (/ & + & 0.74698e-04_r8,0.96443e-03_r8,0.12533e-02_r8,0.12673e-02_r8,0.78590e-03_r8 /) + kbo(:, 3,32, 5) = (/ & + & 0.89092e-04_r8,0.10684e-02_r8,0.13590e-02_r8,0.13571e-02_r8,0.83090e-03_r8 /) + kbo(:, 4,32, 5) = (/ & + & 0.10537e-03_r8,0.11766e-02_r8,0.14682e-02_r8,0.14560e-02_r8,0.87827e-03_r8 /) + kbo(:, 5,32, 5) = (/ & + & 0.12327e-03_r8,0.12850e-02_r8,0.15813e-02_r8,0.15643e-02_r8,0.92599e-03_r8 /) + kbo(:, 1,33, 5) = (/ & + & 0.53748e-04_r8,0.75629e-03_r8,0.99595e-03_r8,0.10163e-02_r8,0.62809e-03_r8 /) + kbo(:, 2,33, 5) = (/ & + & 0.64972e-04_r8,0.84265e-03_r8,0.10856e-02_r8,0.10908e-02_r8,0.66416e-03_r8 /) + kbo(:, 3,33, 5) = (/ & + & 0.77386e-04_r8,0.93397e-03_r8,0.11787e-02_r8,0.11727e-02_r8,0.70387e-03_r8 /) + kbo(:, 4,33, 5) = (/ & + & 0.91138e-04_r8,0.10266e-02_r8,0.12749e-02_r8,0.12630e-02_r8,0.74507e-03_r8 /) + kbo(:, 5,33, 5) = (/ & + & 0.10640e-03_r8,0.11189e-02_r8,0.13738e-02_r8,0.13608e-02_r8,0.78830e-03_r8 /) + kbo(:, 1,34, 5) = (/ & + & 0.46667e-04_r8,0.65884e-03_r8,0.86049e-03_r8,0.87214e-03_r8,0.53099e-03_r8 /) + kbo(:, 2,34, 5) = (/ & + & 0.56263e-04_r8,0.73490e-03_r8,0.93900e-03_r8,0.93946e-03_r8,0.56278e-03_r8 /) + kbo(:, 3,34, 5) = (/ & + & 0.66853e-04_r8,0.81383e-03_r8,0.10209e-02_r8,0.10142e-02_r8,0.59776e-03_r8 /) + kbo(:, 4,34, 5) = (/ & + & 0.78598e-04_r8,0.89314e-03_r8,0.11054e-02_r8,0.10963e-02_r8,0.63419e-03_r8 /) + kbo(:, 5,34, 5) = (/ & + & 0.91503e-04_r8,0.97193e-03_r8,0.11927e-02_r8,0.11840e-02_r8,0.67320e-03_r8 /) + kbo(:, 1,35, 5) = (/ & + & 0.39599e-04_r8,0.56866e-03_r8,0.73803e-03_r8,0.74491e-03_r8,0.44688e-03_r8 /) + kbo(:, 2,35, 5) = (/ & + & 0.47677e-04_r8,0.63490e-03_r8,0.80685e-03_r8,0.80540e-03_r8,0.47466e-03_r8 /) + kbo(:, 3,35, 5) = (/ & + & 0.56630e-04_r8,0.70279e-03_r8,0.87860e-03_r8,0.87332e-03_r8,0.50476e-03_r8 /) + kbo(:, 4,35, 5) = (/ & + & 0.66506e-04_r8,0.77061e-03_r8,0.95262e-03_r8,0.94676e-03_r8,0.53730e-03_r8 /) + kbo(:, 5,35, 5) = (/ & + & 0.77343e-04_r8,0.83870e-03_r8,0.10295e-02_r8,0.10250e-02_r8,0.57200e-03_r8 /) + kbo(:, 1,36, 5) = (/ & + & 0.32767e-04_r8,0.48523e-03_r8,0.62751e-03_r8,0.63183e-03_r8,0.37353e-03_r8 /) + kbo(:, 2,36, 5) = (/ & + & 0.39450e-04_r8,0.54261e-03_r8,0.68744e-03_r8,0.68587e-03_r8,0.39744e-03_r8 /) + kbo(:, 3,36, 5) = (/ & + & 0.46861e-04_r8,0.60093e-03_r8,0.74977e-03_r8,0.74623e-03_r8,0.42315e-03_r8 /) + kbo(:, 4,36, 5) = (/ & + & 0.54956e-04_r8,0.65916e-03_r8,0.81469e-03_r8,0.81158e-03_r8,0.45144e-03_r8 /) + kbo(:, 5,36, 5) = (/ & + & 0.63908e-04_r8,0.71820e-03_r8,0.88212e-03_r8,0.88103e-03_r8,0.48165e-03_r8 /) + kbo(:, 1,37, 5) = (/ & + & 0.26734e-04_r8,0.40754e-03_r8,0.52645e-03_r8,0.53014e-03_r8,0.31118e-03_r8 /) + kbo(:, 2,37, 5) = (/ & + & 0.32273e-04_r8,0.45661e-03_r8,0.57825e-03_r8,0.57766e-03_r8,0.33206e-03_r8 /) + kbo(:, 3,37, 5) = (/ & + & 0.38488e-04_r8,0.50697e-03_r8,0.63245e-03_r8,0.63058e-03_r8,0.35476e-03_r8 /) + kbo(:, 4,37, 5) = (/ & + & 0.45228e-04_r8,0.55706e-03_r8,0.68918e-03_r8,0.68809e-03_r8,0.37944e-03_r8 /) + kbo(:, 5,37, 5) = (/ & + & 0.52675e-04_r8,0.60808e-03_r8,0.74794e-03_r8,0.74934e-03_r8,0.40598e-03_r8 /) + kbo(:, 1,38, 5) = (/ & + & 0.21751e-04_r8,0.34209e-03_r8,0.44146e-03_r8,0.44458e-03_r8,0.25920e-03_r8 /) + kbo(:, 2,38, 5) = (/ & + & 0.26326e-04_r8,0.38415e-03_r8,0.48603e-03_r8,0.48632e-03_r8,0.27730e-03_r8 /) + kbo(:, 3,38, 5) = (/ & + & 0.31515e-04_r8,0.42736e-03_r8,0.53325e-03_r8,0.53262e-03_r8,0.29714e-03_r8 /) + kbo(:, 4,38, 5) = (/ & + & 0.37219e-04_r8,0.47064e-03_r8,0.58263e-03_r8,0.58321e-03_r8,0.31890e-03_r8 /) + kbo(:, 5,38, 5) = (/ & + & 0.43344e-04_r8,0.51493e-03_r8,0.63402e-03_r8,0.63729e-03_r8,0.34212e-03_r8 /) + kbo(:, 1,39, 5) = (/ & + & 0.17643e-04_r8,0.28717e-03_r8,0.37020e-03_r8,0.37288e-03_r8,0.21580e-03_r8 /) + kbo(:, 2,39, 5) = (/ & + & 0.21418e-04_r8,0.32343e-03_r8,0.40871e-03_r8,0.40953e-03_r8,0.23151e-03_r8 /) + kbo(:, 3,39, 5) = (/ & + & 0.25725e-04_r8,0.36044e-03_r8,0.44966e-03_r8,0.45005e-03_r8,0.24880e-03_r8 /) + kbo(:, 4,39, 5) = (/ & + & 0.30479e-04_r8,0.39785e-03_r8,0.49263e-03_r8,0.49445e-03_r8,0.26783e-03_r8 /) + kbo(:, 5,39, 5) = (/ & + & 0.35653e-04_r8,0.43646e-03_r8,0.53771e-03_r8,0.54230e-03_r8,0.28822e-03_r8 /) + kbo(:, 1,40, 5) = (/ & + & 0.14102e-04_r8,0.23814e-03_r8,0.30730e-03_r8,0.30981e-03_r8,0.17864e-03_r8 /) + kbo(:, 2,40, 5) = (/ & + & 0.17187e-04_r8,0.26934e-03_r8,0.34039e-03_r8,0.34146e-03_r8,0.19234e-03_r8 /) + kbo(:, 3,40, 5) = (/ & + & 0.20739e-04_r8,0.30130e-03_r8,0.37571e-03_r8,0.37672e-03_r8,0.20737e-03_r8 /) + kbo(:, 4,40, 5) = (/ & + & 0.24670e-04_r8,0.33333e-03_r8,0.41283e-03_r8,0.41538e-03_r8,0.22408e-03_r8 /) + kbo(:, 5,40, 5) = (/ & + & 0.29046e-04_r8,0.36694e-03_r8,0.45216e-03_r8,0.45729e-03_r8,0.24187e-03_r8 /) + kbo(:, 1,41, 5) = (/ & + & 0.11221e-04_r8,0.19710e-03_r8,0.25465e-03_r8,0.25696e-03_r8,0.14773e-03_r8 /) + kbo(:, 2,41, 5) = (/ & + & 0.13747e-04_r8,0.22390e-03_r8,0.28305e-03_r8,0.28413e-03_r8,0.15955e-03_r8 /) + kbo(:, 3,41, 5) = (/ & + & 0.16649e-04_r8,0.25145e-03_r8,0.31346e-03_r8,0.31467e-03_r8,0.17269e-03_r8 /) + kbo(:, 4,41, 5) = (/ & + & 0.19899e-04_r8,0.27935e-03_r8,0.34563e-03_r8,0.34845e-03_r8,0.18718e-03_r8 /) + kbo(:, 5,41, 5) = (/ & + & 0.23568e-04_r8,0.30830e-03_r8,0.37974e-03_r8,0.38512e-03_r8,0.20281e-03_r8 /) + kbo(:, 1,42, 5) = (/ & + & 0.89147e-05_r8,0.16314e-03_r8,0.21088e-03_r8,0.21294e-03_r8,0.12205e-03_r8 /) + kbo(:, 2,42, 5) = (/ & + & 0.10957e-04_r8,0.18596e-03_r8,0.23523e-03_r8,0.23628e-03_r8,0.13225e-03_r8 /) + kbo(:, 3,42, 5) = (/ & + & 0.13327e-04_r8,0.20974e-03_r8,0.26134e-03_r8,0.26263e-03_r8,0.14356e-03_r8 /) + kbo(:, 4,42, 5) = (/ & + & 0.16005e-04_r8,0.23378e-03_r8,0.28925e-03_r8,0.29202e-03_r8,0.15621e-03_r8 /) + kbo(:, 5,42, 5) = (/ & + & 0.19038e-04_r8,0.25914e-03_r8,0.31897e-03_r8,0.32415e-03_r8,0.16982e-03_r8 /) + kbo(:, 1,43, 5) = (/ & + & 0.69995e-05_r8,0.13405e-03_r8,0.17338e-03_r8,0.17535e-03_r8,0.10036e-03_r8 /) + kbo(:, 2,43, 5) = (/ & + & 0.86406e-05_r8,0.15345e-03_r8,0.19416e-03_r8,0.19514e-03_r8,0.10910e-03_r8 /) + kbo(:, 3,43, 5) = (/ & + & 0.10556e-04_r8,0.17373e-03_r8,0.21659e-03_r8,0.21767e-03_r8,0.11887e-03_r8 /) + kbo(:, 4,43, 5) = (/ & + & 0.12739e-04_r8,0.19445e-03_r8,0.24053e-03_r8,0.24311e-03_r8,0.12980e-03_r8 /) + kbo(:, 5,43, 5) = (/ & + & 0.15232e-04_r8,0.21640e-03_r8,0.26645e-03_r8,0.27107e-03_r8,0.14169e-03_r8 /) + kbo(:, 1,44, 5) = (/ & + & 0.54712e-05_r8,0.10970e-03_r8,0.14195e-03_r8,0.14386e-03_r8,0.82260e-04_r8 /) + kbo(:, 2,44, 5) = (/ & + & 0.67644e-05_r8,0.12612e-03_r8,0.15963e-03_r8,0.16061e-03_r8,0.89727e-04_r8 /) + kbo(:, 3,44, 5) = (/ & + & 0.82973e-05_r8,0.14348e-03_r8,0.17878e-03_r8,0.17975e-03_r8,0.98122e-04_r8 /) + kbo(:, 4,44, 5) = (/ & + & 0.10082e-04_r8,0.16132e-03_r8,0.19952e-03_r8,0.20155e-03_r8,0.10755e-03_r8 /) + kbo(:, 5,44, 5) = (/ & + & 0.12107e-04_r8,0.18008e-03_r8,0.22179e-03_r8,0.22576e-03_r8,0.11787e-03_r8 /) + kbo(:, 1,45, 5) = (/ & + & 0.42767e-05_r8,0.89680e-04_r8,0.11611e-03_r8,0.11781e-03_r8,0.67338e-04_r8 /) + kbo(:, 2,45, 5) = (/ & + & 0.52860e-05_r8,0.10360e-03_r8,0.13107e-03_r8,0.13203e-03_r8,0.73722e-04_r8 /) + kbo(:, 3,45, 5) = (/ & + & 0.65107e-05_r8,0.11838e-03_r8,0.14735e-03_r8,0.14829e-03_r8,0.80852e-04_r8 /) + kbo(:, 4,45, 5) = (/ & + & 0.79501e-05_r8,0.13374e-03_r8,0.16520e-03_r8,0.16693e-03_r8,0.88969e-04_r8 /) + kbo(:, 5,45, 5) = (/ & + & 0.95937e-05_r8,0.14993e-03_r8,0.18456e-03_r8,0.18781e-03_r8,0.97897e-04_r8 /) + kbo(:, 1,46, 5) = (/ & + & 0.33226e-05_r8,0.72918e-04_r8,0.94635e-04_r8,0.96069e-04_r8,0.54912e-04_r8 /) + kbo(:, 2,46, 5) = (/ & + & 0.41185e-05_r8,0.84705e-04_r8,0.10726e-03_r8,0.10809e-03_r8,0.60325e-04_r8 /) + kbo(:, 3,46, 5) = (/ & + & 0.50796e-05_r8,0.97414e-04_r8,0.12106e-03_r8,0.12184e-03_r8,0.66415e-04_r8 /) + kbo(:, 4,46, 5) = (/ & + & 0.62311e-05_r8,0.11055e-03_r8,0.13625e-03_r8,0.13772e-03_r8,0.73354e-04_r8 /) + kbo(:, 5,46, 5) = (/ & + & 0.75594e-05_r8,0.12439e-03_r8,0.15297e-03_r8,0.15569e-03_r8,0.80972e-04_r8 /) + kbo(:, 1,47, 5) = (/ & + & 0.25507e-05_r8,0.58753e-04_r8,0.76599e-04_r8,0.77798e-04_r8,0.44508e-04_r8 /) + kbo(:, 2,47, 5) = (/ & + & 0.31800e-05_r8,0.68679e-04_r8,0.87240e-04_r8,0.87843e-04_r8,0.49115e-04_r8 /) + kbo(:, 3,47, 5) = (/ & + & 0.39273e-05_r8,0.79497e-04_r8,0.98871e-04_r8,0.99421e-04_r8,0.54249e-04_r8 /) + kbo(:, 4,47, 5) = (/ & + & 0.48346e-05_r8,0.90782e-04_r8,0.11173e-03_r8,0.11282e-03_r8,0.60113e-04_r8 /) + kbo(:, 5,47, 5) = (/ & + & 0.58995e-05_r8,0.10267e-03_r8,0.12592e-03_r8,0.12815e-03_r8,0.66656e-04_r8 /) + kbo(:, 1,48, 5) = (/ & + & 0.19539e-05_r8,0.47174e-04_r8,0.61874e-04_r8,0.62916e-04_r8,0.35973e-04_r8 /) + kbo(:, 2,48, 5) = (/ & + & 0.24452e-05_r8,0.55575e-04_r8,0.70853e-04_r8,0.71238e-04_r8,0.39898e-04_r8 /) + kbo(:, 3,48, 5) = (/ & + & 0.30402e-05_r8,0.64783e-04_r8,0.80633e-04_r8,0.80921e-04_r8,0.44214e-04_r8 /) + kbo(:, 4,48, 5) = (/ & + & 0.37390e-05_r8,0.74439e-04_r8,0.91498e-04_r8,0.92208e-04_r8,0.49162e-04_r8 /) + kbo(:, 5,48, 5) = (/ & + & 0.45836e-05_r8,0.84608e-04_r8,0.10358e-03_r8,0.10531e-03_r8,0.54702e-04_r8 /) + kbo(:, 1,49, 5) = (/ & + & 0.14940e-05_r8,0.37716e-04_r8,0.49829e-04_r8,0.50804e-04_r8,0.28987e-04_r8 /) + kbo(:, 2,49, 5) = (/ & + & 0.18758e-05_r8,0.44777e-04_r8,0.57392e-04_r8,0.57697e-04_r8,0.32317e-04_r8 /) + kbo(:, 3,49, 5) = (/ & + & 0.23413e-05_r8,0.52604e-04_r8,0.65608e-04_r8,0.65748e-04_r8,0.35946e-04_r8 /) + kbo(:, 4,49, 5) = (/ & + & 0.28961e-05_r8,0.60891e-04_r8,0.74824e-04_r8,0.75182e-04_r8,0.40099e-04_r8 /) + kbo(:, 5,49, 5) = (/ & + & 0.35524e-05_r8,0.69587e-04_r8,0.85068e-04_r8,0.86295e-04_r8,0.44804e-04_r8 /) + kbo(:, 1,50, 5) = (/ & + & 0.11500e-05_r8,0.30169e-04_r8,0.40157e-04_r8,0.41069e-04_r8,0.23362e-04_r8 /) + kbo(:, 2,50, 5) = (/ & + & 0.14453e-05_r8,0.36089e-04_r8,0.46549e-04_r8,0.46799e-04_r8,0.26193e-04_r8 /) + kbo(:, 3,50, 5) = (/ & + & 0.18129e-05_r8,0.42735e-04_r8,0.53474e-04_r8,0.53514e-04_r8,0.29249e-04_r8 /) + kbo(:, 4,50, 5) = (/ & + & 0.22529e-05_r8,0.49843e-04_r8,0.61234e-04_r8,0.61404e-04_r8,0.32748e-04_r8 /) + kbo(:, 5,50, 5) = (/ & + & 0.27762e-05_r8,0.57328e-04_r8,0.70027e-04_r8,0.70783e-04_r8,0.36712e-04_r8 /) + kbo(:, 1,51, 5) = (/ & + & 0.88851e-06_r8,0.24095e-04_r8,0.32303e-04_r8,0.33210e-04_r8,0.18805e-04_r8 /) + kbo(:, 2,51, 5) = (/ & + & 0.11177e-05_r8,0.29082e-04_r8,0.37705e-04_r8,0.37944e-04_r8,0.21209e-04_r8 /) + kbo(:, 3,51, 5) = (/ & + & 0.14060e-05_r8,0.34667e-04_r8,0.43578e-04_r8,0.43570e-04_r8,0.23792e-04_r8 /) + kbo(:, 4,51, 5) = (/ & + & 0.17539e-05_r8,0.40739e-04_r8,0.50114e-04_r8,0.50172e-04_r8,0.26720e-04_r8 /) + kbo(:, 5,51, 5) = (/ & + & 0.21729e-05_r8,0.47224e-04_r8,0.57598e-04_r8,0.58070e-04_r8,0.30079e-04_r8 /) + kbo(:, 1,52, 5) = (/ & + & 0.68525e-06_r8,0.19178e-04_r8,0.25896e-04_r8,0.26809e-04_r8,0.15097e-04_r8 /) + kbo(:, 2,52, 5) = (/ & + & 0.86301e-06_r8,0.23336e-04_r8,0.30434e-04_r8,0.30713e-04_r8,0.17120e-04_r8 /) + kbo(:, 3,52, 5) = (/ & + & 0.10889e-05_r8,0.28028e-04_r8,0.35422e-04_r8,0.35397e-04_r8,0.19301e-04_r8 /) + kbo(:, 4,52, 5) = (/ & + & 0.13649e-05_r8,0.33187e-04_r8,0.40954e-04_r8,0.40921e-04_r8,0.21752e-04_r8 /) + kbo(:, 5,52, 5) = (/ & + & 0.16982e-05_r8,0.38747e-04_r8,0.47260e-04_r8,0.47557e-04_r8,0.24588e-04_r8 /) + kbo(:, 1,53, 5) = (/ & + & 0.52809e-06_r8,0.15206e-04_r8,0.20688e-04_r8,0.21592e-04_r8,0.12084e-04_r8 /) + kbo(:, 2,53, 5) = (/ & + & 0.66493e-06_r8,0.18647e-04_r8,0.24479e-04_r8,0.24819e-04_r8,0.13781e-04_r8 /) + kbo(:, 3,53, 5) = (/ & + & 0.84102e-06_r8,0.22574e-04_r8,0.28683e-04_r8,0.28690e-04_r8,0.15621e-04_r8 /) + kbo(:, 4,53, 5) = (/ & + & 0.10585e-05_r8,0.26955e-04_r8,0.33364e-04_r8,0.33298e-04_r8,0.17677e-04_r8 /) + kbo(:, 5,53, 5) = (/ & + & 0.13239e-05_r8,0.31710e-04_r8,0.38733e-04_r8,0.38864e-04_r8,0.20049e-04_r8 /) + kbo(:, 1,54, 5) = (/ & + & 0.40969e-06_r8,0.12093e-04_r8,0.16564e-04_r8,0.17421e-04_r8,0.96882e-05_r8 /) + kbo(:, 2,54, 5) = (/ & + & 0.51569e-06_r8,0.14937e-04_r8,0.19734e-04_r8,0.20094e-04_r8,0.11112e-04_r8 /) + kbo(:, 3,54, 5) = (/ & + & 0.65296e-06_r8,0.18229e-04_r8,0.23282e-04_r8,0.23321e-04_r8,0.12664e-04_r8 /) + kbo(:, 4,54, 5) = (/ & + & 0.82573e-06_r8,0.21950e-04_r8,0.27231e-04_r8,0.27150e-04_r8,0.14393e-04_r8 /) + kbo(:, 5,54, 5) = (/ & + & 0.10373e-05_r8,0.26013e-04_r8,0.31791e-04_r8,0.31828e-04_r8,0.16379e-04_r8 /) + kbo(:, 1,55, 5) = (/ & + & 0.31928e-06_r8,0.96162e-05_r8,0.13257e-04_r8,0.14053e-04_r8,0.77741e-05_r8 /) + kbo(:, 2,55, 5) = (/ & + & 0.40112e-06_r8,0.11963e-04_r8,0.15906e-04_r8,0.16257e-04_r8,0.89578e-05_r8 /) + kbo(:, 3,55, 5) = (/ & + & 0.50816e-06_r8,0.14717e-04_r8,0.18886e-04_r8,0.18947e-04_r8,0.10262e-04_r8 /) + kbo(:, 4,55, 5) = (/ & + & 0.64465e-06_r8,0.17864e-04_r8,0.22207e-04_r8,0.22155e-04_r8,0.11715e-04_r8 /) + kbo(:, 5,55, 5) = (/ & + & 0.81328e-06_r8,0.21326e-04_r8,0.26076e-04_r8,0.26061e-04_r8,0.13376e-04_r8 /) + kbo(:, 1,56, 5) = (/ & + & 0.24829e-06_r8,0.76204e-05_r8,0.10578e-04_r8,0.11309e-04_r8,0.62208e-05_r8 /) + kbo(:, 2,56, 5) = (/ & + & 0.31176e-06_r8,0.95488e-05_r8,0.12780e-04_r8,0.13125e-04_r8,0.72013e-05_r8 /) + kbo(:, 3,56, 5) = (/ & + & 0.39506e-06_r8,0.11850e-04_r8,0.15279e-04_r8,0.15348e-04_r8,0.82947e-05_r8 /) + kbo(:, 4,56, 5) = (/ & + & 0.50266e-06_r8,0.14492e-04_r8,0.18074e-04_r8,0.18040e-04_r8,0.95153e-05_r8 /) + kbo(:, 5,56, 5) = (/ & + & 0.63638e-06_r8,0.17442e-04_r8,0.21336e-04_r8,0.21310e-04_r8,0.10904e-04_r8 /) + kbo(:, 1,57, 5) = (/ & + & 0.19302e-06_r8,0.60187e-05_r8,0.84162e-05_r8,0.90799e-05_r8,0.49649e-05_r8 /) + kbo(:, 2,57, 5) = (/ & + & 0.24222e-06_r8,0.75959e-05_r8,0.10233e-04_r8,0.10570e-04_r8,0.57701e-05_r8 /) + kbo(:, 3,57, 5) = (/ & + & 0.30688e-06_r8,0.95080e-05_r8,0.12318e-04_r8,0.12403e-04_r8,0.66913e-05_r8 /) + kbo(:, 4,57, 5) = (/ & + & 0.39089e-06_r8,0.11719e-04_r8,0.14670e-04_r8,0.14644e-04_r8,0.77166e-05_r8 /) + kbo(:, 5,57, 5) = (/ & + & 0.49674e-06_r8,0.14214e-04_r8,0.17402e-04_r8,0.17382e-04_r8,0.88727e-05_r8 /) + kbo(:, 1,58, 5) = (/ & + & 0.15046e-06_r8,0.47663e-05_r8,0.66998e-05_r8,0.72908e-05_r8,0.39631e-05_r8 /) + kbo(:, 2,58, 5) = (/ & + & 0.18856e-06_r8,0.60459e-05_r8,0.81908e-05_r8,0.85206e-05_r8,0.46270e-05_r8 /) + kbo(:, 3,58, 5) = (/ & + & 0.23869e-06_r8,0.76302e-05_r8,0.99245e-05_r8,0.10023e-04_r8,0.53977e-05_r8 /) + kbo(:, 4,58, 5) = (/ & + & 0.30459e-06_r8,0.94767e-05_r8,0.11911e-04_r8,0.11894e-04_r8,0.62579e-05_r8 /) + kbo(:, 5,58, 5) = (/ & + & 0.38820e-06_r8,0.11588e-04_r8,0.14205e-04_r8,0.14182e-04_r8,0.72226e-05_r8 /) + kbo(:, 1,59, 5) = (/ & + & 0.12212e-06_r8,0.39332e-05_r8,0.55230e-05_r8,0.60094e-05_r8,0.32499e-05_r8 /) + kbo(:, 2,59, 5) = (/ & + & 0.15324e-06_r8,0.50178e-05_r8,0.67879e-05_r8,0.70566e-05_r8,0.38108e-05_r8 /) + kbo(:, 3,59, 5) = (/ & + & 0.19418e-06_r8,0.63678e-05_r8,0.82647e-05_r8,0.83443e-05_r8,0.44672e-05_r8 /) + kbo(:, 4,59, 5) = (/ & + & 0.24820e-06_r8,0.79543e-05_r8,0.99670e-05_r8,0.99518e-05_r8,0.52027e-05_r8 /) + kbo(:, 5,59, 5) = (/ & + & 0.31740e-06_r8,0.97704e-05_r8,0.11964e-04_r8,0.11938e-04_r8,0.60278e-05_r8 /) + kbo(:, 1,13, 6) = (/ & + & 0.10896e-01_r8,0.63076e-01_r8,0.78831e-01_r8,0.78091e-01_r8,0.55428e-01_r8 /) + kbo(:, 2,13, 6) = (/ & + & 0.13036e-01_r8,0.66370e-01_r8,0.81226e-01_r8,0.79692e-01_r8,0.56778e-01_r8 /) + kbo(:, 3,13, 6) = (/ & + & 0.15498e-01_r8,0.69685e-01_r8,0.83483e-01_r8,0.81400e-01_r8,0.57975e-01_r8 /) + kbo(:, 4,13, 6) = (/ & + & 0.18239e-01_r8,0.73147e-01_r8,0.85845e-01_r8,0.83249e-01_r8,0.59127e-01_r8 /) + kbo(:, 5,13, 6) = (/ & + & 0.21232e-01_r8,0.76581e-01_r8,0.88266e-01_r8,0.85245e-01_r8,0.60192e-01_r8 /) + kbo(:, 1,14, 6) = (/ & + & 0.94274e-02_r8,0.53526e-01_r8,0.66496e-01_r8,0.65527e-01_r8,0.46374e-01_r8 /) + kbo(:, 2,14, 6) = (/ & + & 0.11284e-01_r8,0.56390e-01_r8,0.68527e-01_r8,0.66955e-01_r8,0.47524e-01_r8 /) + kbo(:, 3,14, 6) = (/ & + & 0.13394e-01_r8,0.59305e-01_r8,0.70546e-01_r8,0.68479e-01_r8,0.48560e-01_r8 /) + kbo(:, 4,14, 6) = (/ & + & 0.15751e-01_r8,0.62293e-01_r8,0.72634e-01_r8,0.70165e-01_r8,0.49587e-01_r8 /) + kbo(:, 5,14, 6) = (/ & + & 0.18326e-01_r8,0.65240e-01_r8,0.74773e-01_r8,0.71967e-01_r8,0.50492e-01_r8 /) + kbo(:, 1,15, 6) = (/ & + & 0.81352e-02_r8,0.45294e-01_r8,0.55939e-01_r8,0.54933e-01_r8,0.38471e-01_r8 /) + kbo(:, 2,15, 6) = (/ & + & 0.97406e-02_r8,0.47797e-01_r8,0.57705e-01_r8,0.56201e-01_r8,0.39475e-01_r8 /) + kbo(:, 3,15, 6) = (/ & + & 0.11542e-01_r8,0.50349e-01_r8,0.59500e-01_r8,0.57588e-01_r8,0.40391e-01_r8 /) + kbo(:, 4,15, 6) = (/ & + & 0.13568e-01_r8,0.52924e-01_r8,0.61342e-01_r8,0.59116e-01_r8,0.41250e-01_r8 /) + kbo(:, 5,15, 6) = (/ & + & 0.15789e-01_r8,0.55427e-01_r8,0.63250e-01_r8,0.60727e-01_r8,0.42016e-01_r8 /) + kbo(:, 1,16, 6) = (/ & + & 0.70159e-02_r8,0.38272e-01_r8,0.46984e-01_r8,0.46002e-01_r8,0.31818e-01_r8 /) + kbo(:, 2,16, 6) = (/ & + & 0.83846e-02_r8,0.40476e-01_r8,0.48519e-01_r8,0.47148e-01_r8,0.32640e-01_r8 /) + kbo(:, 3,16, 6) = (/ & + & 0.99392e-02_r8,0.42699e-01_r8,0.50118e-01_r8,0.48421e-01_r8,0.33435e-01_r8 /) + kbo(:, 4,16, 6) = (/ & + & 0.11675e-01_r8,0.44875e-01_r8,0.51760e-01_r8,0.49780e-01_r8,0.34161e-01_r8 /) + kbo(:, 5,16, 6) = (/ & + & 0.13584e-01_r8,0.46992e-01_r8,0.53405e-01_r8,0.51224e-01_r8,0.34855e-01_r8 /) + kbo(:, 1,17, 6) = (/ & + & 0.60402e-02_r8,0.32343e-01_r8,0.39419e-01_r8,0.38482e-01_r8,0.26323e-01_r8 /) + kbo(:, 2,17, 6) = (/ & + & 0.72134e-02_r8,0.34265e-01_r8,0.40783e-01_r8,0.39523e-01_r8,0.27045e-01_r8 /) + kbo(:, 3,17, 6) = (/ & + & 0.85415e-02_r8,0.36157e-01_r8,0.42200e-01_r8,0.40657e-01_r8,0.27733e-01_r8 /) + kbo(:, 4,17, 6) = (/ & + & 0.10023e-01_r8,0.37979e-01_r8,0.43620e-01_r8,0.41877e-01_r8,0.28354e-01_r8 /) + kbo(:, 5,17, 6) = (/ & + & 0.11662e-01_r8,0.39775e-01_r8,0.45034e-01_r8,0.43161e-01_r8,0.28989e-01_r8 /) + kbo(:, 1,18, 6) = (/ & + & 0.51905e-02_r8,0.27334e-01_r8,0.33081e-01_r8,0.32183e-01_r8,0.21845e-01_r8 /) + kbo(:, 2,18, 6) = (/ & + & 0.61907e-02_r8,0.28996e-01_r8,0.34295e-01_r8,0.33127e-01_r8,0.22456e-01_r8 /) + kbo(:, 3,18, 6) = (/ & + & 0.73283e-02_r8,0.30572e-01_r8,0.35522e-01_r8,0.34131e-01_r8,0.23047e-01_r8 /) + kbo(:, 4,18, 6) = (/ & + & 0.85960e-02_r8,0.32113e-01_r8,0.36725e-01_r8,0.35202e-01_r8,0.23589e-01_r8 /) + kbo(:, 5,18, 6) = (/ & + & 0.10011e-01_r8,0.33654e-01_r8,0.37950e-01_r8,0.36339e-01_r8,0.24154e-01_r8 /) + kbo(:, 1,19, 6) = (/ & + & 0.44474e-02_r8,0.23093e-01_r8,0.27758e-01_r8,0.26913e-01_r8,0.18159e-01_r8 /) + kbo(:, 2,19, 6) = (/ & + & 0.53019e-02_r8,0.24497e-01_r8,0.28826e-01_r8,0.27764e-01_r8,0.18694e-01_r8 /) + kbo(:, 3,19, 6) = (/ & + & 0.62735e-02_r8,0.25825e-01_r8,0.29864e-01_r8,0.28669e-01_r8,0.19187e-01_r8 /) + kbo(:, 4,19, 6) = (/ & + & 0.73683e-02_r8,0.27139e-01_r8,0.30890e-01_r8,0.29627e-01_r8,0.19650e-01_r8 /) + kbo(:, 5,19, 6) = (/ & + & 0.85933e-02_r8,0.28467e-01_r8,0.31975e-01_r8,0.30634e-01_r8,0.20138e-01_r8 /) + kbo(:, 1,20, 6) = (/ & + & 0.38215e-02_r8,0.19522e-01_r8,0.23307e-01_r8,0.22532e-01_r8,0.15180e-01_r8 /) + kbo(:, 2,20, 6) = (/ & + & 0.45489e-02_r8,0.20697e-01_r8,0.24217e-01_r8,0.23292e-01_r8,0.15626e-01_r8 /) + kbo(:, 3,20, 6) = (/ & + & 0.53838e-02_r8,0.21827e-01_r8,0.25099e-01_r8,0.24107e-01_r8,0.16039e-01_r8 /) + kbo(:, 4,20, 6) = (/ & + & 0.63294e-02_r8,0.22947e-01_r8,0.25996e-01_r8,0.24951e-01_r8,0.16431e-01_r8 /) + kbo(:, 5,20, 6) = (/ & + & 0.73910e-02_r8,0.24098e-01_r8,0.26969e-01_r8,0.25840e-01_r8,0.16861e-01_r8 /) + kbo(:, 1,21, 6) = (/ & + & 0.32849e-02_r8,0.16485e-01_r8,0.19564e-01_r8,0.18873e-01_r8,0.12724e-01_r8 /) + kbo(:, 2,21, 6) = (/ & + & 0.39093e-02_r8,0.17476e-01_r8,0.20333e-01_r8,0.19553e-01_r8,0.13080e-01_r8 /) + kbo(:, 3,21, 6) = (/ & + & 0.46257e-02_r8,0.18440e-01_r8,0.21099e-01_r8,0.20272e-01_r8,0.13424e-01_r8 /) + kbo(:, 4,21, 6) = (/ & + & 0.54436e-02_r8,0.19400e-01_r8,0.21897e-01_r8,0.21018e-01_r8,0.13774e-01_r8 /) + kbo(:, 5,21, 6) = (/ & + & 0.63568e-02_r8,0.20406e-01_r8,0.22777e-01_r8,0.21806e-01_r8,0.14153e-01_r8 /) + kbo(:, 1,22, 6) = (/ & + & 0.28524e-02_r8,0.13970e-01_r8,0.16464e-01_r8,0.15855e-01_r8,0.10647e-01_r8 /) + kbo(:, 2,22, 6) = (/ & + & 0.33998e-02_r8,0.14799e-01_r8,0.17121e-01_r8,0.16464e-01_r8,0.10957e-01_r8 /) + kbo(:, 3,22, 6) = (/ & + & 0.40218e-02_r8,0.15618e-01_r8,0.17789e-01_r8,0.17098e-01_r8,0.11264e-01_r8 /) + kbo(:, 4,22, 6) = (/ & + & 0.47350e-02_r8,0.16459e-01_r8,0.18512e-01_r8,0.17761e-01_r8,0.11585e-01_r8 /) + kbo(:, 5,22, 6) = (/ & + & 0.55269e-02_r8,0.17342e-01_r8,0.19306e-01_r8,0.18466e-01_r8,0.11905e-01_r8 /) + kbo(:, 1,23, 6) = (/ & + & 0.24776e-02_r8,0.11832e-01_r8,0.13862e-01_r8,0.13338e-01_r8,0.89101e-02_r8 /) + kbo(:, 2,23, 6) = (/ & + & 0.29594e-02_r8,0.12532e-01_r8,0.14430e-01_r8,0.13874e-01_r8,0.91836e-02_r8 /) + kbo(:, 3,23, 6) = (/ & + & 0.35060e-02_r8,0.13237e-01_r8,0.15025e-01_r8,0.14435e-01_r8,0.94582e-02_r8 /) + kbo(:, 4,23, 6) = (/ & + & 0.41276e-02_r8,0.13976e-01_r8,0.15673e-01_r8,0.15028e-01_r8,0.97462e-02_r8 /) + kbo(:, 5,23, 6) = (/ & + & 0.48108e-02_r8,0.14761e-01_r8,0.16387e-01_r8,0.15666e-01_r8,0.10041e-01_r8 /) + kbo(:, 1,24, 6) = (/ & + & 0.21553e-02_r8,0.10022e-01_r8,0.11681e-01_r8,0.11233e-01_r8,0.74484e-02_r8 /) + kbo(:, 2,24, 6) = (/ & + & 0.25764e-02_r8,0.10621e-01_r8,0.12176e-01_r8,0.11709e-01_r8,0.76914e-02_r8 /) + kbo(:, 3,24, 6) = (/ & + & 0.30587e-02_r8,0.11236e-01_r8,0.12711e-01_r8,0.12208e-01_r8,0.79451e-02_r8 /) + kbo(:, 4,24, 6) = (/ & + & 0.36022e-02_r8,0.11891e-01_r8,0.13293e-01_r8,0.12744e-01_r8,0.82033e-02_r8 /) + kbo(:, 5,24, 6) = (/ & + & 0.41914e-02_r8,0.12593e-01_r8,0.13939e-01_r8,0.13324e-01_r8,0.84674e-02_r8 /) + kbo(:, 1,25, 6) = (/ & + & 0.18796e-02_r8,0.85000e-02_r8,0.98543e-02_r8,0.94788e-02_r8,0.62281e-02_r8 /) + kbo(:, 2,25, 6) = (/ & + & 0.22512e-02_r8,0.90173e-02_r8,0.10293e-01_r8,0.99015e-02_r8,0.64465e-02_r8 /) + kbo(:, 3,25, 6) = (/ & + & 0.26761e-02_r8,0.95606e-02_r8,0.10772e-01_r8,0.10351e-01_r8,0.66771e-02_r8 /) + kbo(:, 4,25, 6) = (/ & + & 0.31512e-02_r8,0.10144e-01_r8,0.11303e-01_r8,0.10838e-01_r8,0.69100e-02_r8 /) + kbo(:, 5,25, 6) = (/ & + & 0.36575e-02_r8,0.10772e-01_r8,0.11893e-01_r8,0.11363e-01_r8,0.71526e-02_r8 /) + kbo(:, 1,26, 6) = (/ & + & 0.16486e-02_r8,0.72263e-02_r8,0.83293e-02_r8,0.80207e-02_r8,0.52267e-02_r8 /) + kbo(:, 2,26, 6) = (/ & + & 0.19790e-02_r8,0.76783e-02_r8,0.87239e-02_r8,0.83966e-02_r8,0.54266e-02_r8 /) + kbo(:, 3,26, 6) = (/ & + & 0.23552e-02_r8,0.81632e-02_r8,0.91606e-02_r8,0.88030e-02_r8,0.56340e-02_r8 /) + kbo(:, 4,26, 6) = (/ & + & 0.27655e-02_r8,0.86841e-02_r8,0.96465e-02_r8,0.92463e-02_r8,0.58421e-02_r8 /) + kbo(:, 5,26, 6) = (/ & + & 0.32014e-02_r8,0.92461e-02_r8,0.10190e-01_r8,0.97263e-02_r8,0.60618e-02_r8 /) + kbo(:, 1,27, 6) = (/ & + & 0.14479e-02_r8,0.61551e-02_r8,0.70548e-02_r8,0.67980e-02_r8,0.43916e-02_r8 /) + kbo(:, 2,27, 6) = (/ & + & 0.17422e-02_r8,0.65560e-02_r8,0.74109e-02_r8,0.71369e-02_r8,0.45703e-02_r8 /) + kbo(:, 3,27, 6) = (/ & + & 0.20711e-02_r8,0.69878e-02_r8,0.78116e-02_r8,0.75081e-02_r8,0.47565e-02_r8 /) + kbo(:, 4,27, 6) = (/ & + & 0.24273e-02_r8,0.74543e-02_r8,0.82596e-02_r8,0.79125e-02_r8,0.49414e-02_r8 /) + kbo(:, 5,27, 6) = (/ & + & 0.28006e-02_r8,0.79622e-02_r8,0.87633e-02_r8,0.83523e-02_r8,0.51438e-02_r8 /) + kbo(:, 1,28, 6) = (/ & + & 0.12757e-02_r8,0.52552e-02_r8,0.59880e-02_r8,0.57731e-02_r8,0.36940e-02_r8 /) + kbo(:, 2,28, 6) = (/ & + & 0.15355e-02_r8,0.56117e-02_r8,0.63148e-02_r8,0.60828e-02_r8,0.38537e-02_r8 /) + kbo(:, 3,28, 6) = (/ & + & 0.18209e-02_r8,0.60000e-02_r8,0.66831e-02_r8,0.64236e-02_r8,0.40153e-02_r8 /) + kbo(:, 4,28, 6) = (/ & + & 0.21272e-02_r8,0.64202e-02_r8,0.70979e-02_r8,0.67923e-02_r8,0.41811e-02_r8 /) + kbo(:, 5,28, 6) = (/ & + & 0.24474e-02_r8,0.68778e-02_r8,0.75643e-02_r8,0.71983e-02_r8,0.43640e-02_r8 /) + kbo(:, 1,29, 6) = (/ & + & 0.11295e-02_r8,0.45004e-02_r8,0.50997e-02_r8,0.49184e-02_r8,0.31153e-02_r8 /) + kbo(:, 2,29, 6) = (/ & + & 0.13559e-02_r8,0.48180e-02_r8,0.54010e-02_r8,0.52034e-02_r8,0.32572e-02_r8 /) + kbo(:, 3,29, 6) = (/ & + & 0.16033e-02_r8,0.51685e-02_r8,0.57423e-02_r8,0.55151e-02_r8,0.33997e-02_r8 /) + kbo(:, 4,29, 6) = (/ & + & 0.18647e-02_r8,0.55488e-02_r8,0.61280e-02_r8,0.58545e-02_r8,0.35531e-02_r8 /) + kbo(:, 5,29, 6) = (/ & + & 0.21368e-02_r8,0.59683e-02_r8,0.65578e-02_r8,0.62309e-02_r8,0.37192e-02_r8 /) + kbo(:, 1,30, 6) = (/ & + & 0.10010e-02_r8,0.38621e-02_r8,0.43580e-02_r8,0.42036e-02_r8,0.26325e-02_r8 /) + kbo(:, 2,30, 6) = (/ & + & 0.11967e-02_r8,0.41511e-02_r8,0.46366e-02_r8,0.44656e-02_r8,0.27570e-02_r8 /) + kbo(:, 3,30, 6) = (/ & + & 0.14096e-02_r8,0.44678e-02_r8,0.49534e-02_r8,0.47515e-02_r8,0.28856e-02_r8 /) + kbo(:, 4,30, 6) = (/ & + & 0.16325e-02_r8,0.48140e-02_r8,0.53117e-02_r8,0.50685e-02_r8,0.30242e-02_r8 /) + kbo(:, 5,30, 6) = (/ & + & 0.18599e-02_r8,0.52016e-02_r8,0.57103e-02_r8,0.54169e-02_r8,0.31738e-02_r8 /) + kbo(:, 1,31, 6) = (/ & + & 0.88685e-03_r8,0.33266e-02_r8,0.37394e-02_r8,0.36064e-02_r8,0.22280e-02_r8 /) + kbo(:, 2,31, 6) = (/ & + & 0.10569e-02_r8,0.35897e-02_r8,0.39964e-02_r8,0.38465e-02_r8,0.23389e-02_r8 /) + kbo(:, 3,31, 6) = (/ & + & 0.12382e-02_r8,0.38779e-02_r8,0.42920e-02_r8,0.41135e-02_r8,0.24573e-02_r8 /) + kbo(:, 4,31, 6) = (/ & + & 0.14278e-02_r8,0.41961e-02_r8,0.46258e-02_r8,0.44080e-02_r8,0.25818e-02_r8 /) + kbo(:, 5,31, 6) = (/ & + & 0.16136e-02_r8,0.45547e-02_r8,0.50001e-02_r8,0.47313e-02_r8,0.27214e-02_r8 /) + kbo(:, 1,32, 6) = (/ & + & 0.78559e-03_r8,0.28763e-02_r8,0.32195e-02_r8,0.31059e-02_r8,0.18911e-02_r8 /) + kbo(:, 2,32, 6) = (/ & + & 0.93178e-03_r8,0.31157e-02_r8,0.34609e-02_r8,0.33287e-02_r8,0.19930e-02_r8 /) + kbo(:, 3,32, 6) = (/ & + & 0.10867e-02_r8,0.33798e-02_r8,0.37377e-02_r8,0.35772e-02_r8,0.21006e-02_r8 /) + kbo(:, 4,32, 6) = (/ & + & 0.12446e-02_r8,0.36754e-02_r8,0.40497e-02_r8,0.38517e-02_r8,0.22158e-02_r8 /) + kbo(:, 5,32, 6) = (/ & + & 0.13936e-02_r8,0.40072e-02_r8,0.44007e-02_r8,0.41538e-02_r8,0.23413e-02_r8 /) + kbo(:, 1,33, 6) = (/ & + & 0.69486e-03_r8,0.24959e-02_r8,0.27846e-02_r8,0.26858e-02_r8,0.16103e-02_r8 /) + kbo(:, 2,33, 6) = (/ & + & 0.82037e-03_r8,0.27142e-02_r8,0.30117e-02_r8,0.28933e-02_r8,0.17041e-02_r8 /) + kbo(:, 3,33, 6) = (/ & + & 0.95137e-03_r8,0.29589e-02_r8,0.32703e-02_r8,0.31258e-02_r8,0.18033e-02_r8 /) + kbo(:, 4,33, 6) = (/ & + & 0.10800e-02_r8,0.32345e-02_r8,0.35641e-02_r8,0.33810e-02_r8,0.19089e-02_r8 /) + kbo(:, 5,33, 6) = (/ & + & 0.11986e-02_r8,0.35406e-02_r8,0.38943e-02_r8,0.36682e-02_r8,0.20234e-02_r8 /) + kbo(:, 1,34, 6) = (/ & + & 0.61032e-03_r8,0.21671e-02_r8,0.24134e-02_r8,0.23268e-02_r8,0.13754e-02_r8 /) + kbo(:, 2,34, 6) = (/ & + & 0.71748e-03_r8,0.23678e-02_r8,0.26264e-02_r8,0.25207e-02_r8,0.14624e-02_r8 /) + kbo(:, 3,34, 6) = (/ & + & 0.82600e-03_r8,0.25947e-02_r8,0.28697e-02_r8,0.27368e-02_r8,0.15523e-02_r8 /) + kbo(:, 4,34, 6) = (/ & + & 0.92939e-03_r8,0.28495e-02_r8,0.31449e-02_r8,0.29773e-02_r8,0.16488e-02_r8 /) + kbo(:, 5,34, 6) = (/ & + & 0.10239e-02_r8,0.31299e-02_r8,0.34552e-02_r8,0.32520e-02_r8,0.17543e-02_r8 /) + kbo(:, 1,35, 6) = (/ & + & 0.52678e-03_r8,0.18713e-02_r8,0.20838e-02_r8,0.20082e-02_r8,0.11717e-02_r8 /) + kbo(:, 2,35, 6) = (/ & + & 0.61674e-03_r8,0.20541e-02_r8,0.22811e-02_r8,0.21873e-02_r8,0.12500e-02_r8 /) + kbo(:, 3,35, 6) = (/ & + & 0.70570e-03_r8,0.22625e-02_r8,0.25066e-02_r8,0.23870e-02_r8,0.13326e-02_r8 /) + kbo(:, 4,35, 6) = (/ & + & 0.78855e-03_r8,0.24971e-02_r8,0.27629e-02_r8,0.26134e-02_r8,0.14204e-02_r8 /) + kbo(:, 5,35, 6) = (/ & + & 0.86492e-03_r8,0.27499e-02_r8,0.30514e-02_r8,0.28766e-02_r8,0.15154e-02_r8 /) + kbo(:, 1,36, 6) = (/ & + & 0.44569e-03_r8,0.16031e-02_r8,0.17868e-02_r8,0.17221e-02_r8,0.99240e-03_r8 /) + kbo(:, 2,36, 6) = (/ & + & 0.52055e-03_r8,0.17679e-02_r8,0.19674e-02_r8,0.18854e-02_r8,0.10623e-02_r8 /) + kbo(:, 3,36, 6) = (/ & + & 0.59380e-03_r8,0.19567e-02_r8,0.21742e-02_r8,0.20700e-02_r8,0.11368e-02_r8 /) + kbo(:, 4,36, 6) = (/ & + & 0.66114e-03_r8,0.21690e-02_r8,0.24093e-02_r8,0.22827e-02_r8,0.12171e-02_r8 /) + kbo(:, 5,36, 6) = (/ & + & 0.72347e-03_r8,0.23953e-02_r8,0.26735e-02_r8,0.25294e-02_r8,0.13028e-02_r8 /) + kbo(:, 1,37, 6) = (/ & + & 0.36881e-03_r8,0.13558e-02_r8,0.15140e-02_r8,0.14605e-02_r8,0.83527e-03_r8 /) + kbo(:, 2,37, 6) = (/ & + & 0.43070e-03_r8,0.15018e-02_r8,0.16759e-02_r8,0.16073e-02_r8,0.89749e-03_r8 /) + kbo(:, 3,37, 6) = (/ & + & 0.49122e-03_r8,0.16697e-02_r8,0.18620e-02_r8,0.17747e-02_r8,0.96428e-03_r8 /) + kbo(:, 4,37, 6) = (/ & + & 0.54687e-03_r8,0.18590e-02_r8,0.20742e-02_r8,0.19690e-02_r8,0.10365e-02_r8 /) + kbo(:, 5,37, 6) = (/ & + & 0.59826e-03_r8,0.20615e-02_r8,0.23143e-02_r8,0.21948e-02_r8,0.11140e-02_r8 /) + kbo(:, 1,38, 6) = (/ & + & 0.30472e-03_r8,0.11463e-02_r8,0.12827e-02_r8,0.12387e-02_r8,0.70293e-03_r8 /) + kbo(:, 2,38, 6) = (/ & + & 0.35606e-03_r8,0.12755e-02_r8,0.14277e-02_r8,0.13705e-02_r8,0.75844e-03_r8 /) + kbo(:, 3,38, 6) = (/ & + & 0.40587e-03_r8,0.14248e-02_r8,0.15948e-02_r8,0.15225e-02_r8,0.81832e-03_r8 /) + kbo(:, 4,38, 6) = (/ & + & 0.45170e-03_r8,0.15929e-02_r8,0.17869e-02_r8,0.16996e-02_r8,0.88272e-03_r8 /) + kbo(:, 5,38, 6) = (/ & + & 0.49447e-03_r8,0.17743e-02_r8,0.20049e-02_r8,0.19060e-02_r8,0.95296e-03_r8 /) + kbo(:, 1,39, 6) = (/ & + & 0.25159e-03_r8,0.96943e-03_r8,0.10877e-02_r8,0.10513e-02_r8,0.59159e-03_r8 /) + kbo(:, 2,39, 6) = (/ & + & 0.29433e-03_r8,0.10839e-02_r8,0.12173e-02_r8,0.11700e-02_r8,0.64088e-03_r8 /) + kbo(:, 3,39, 6) = (/ & + & 0.33554e-03_r8,0.12164e-02_r8,0.13675e-02_r8,0.13079e-02_r8,0.69454e-03_r8 /) + kbo(:, 4,39, 6) = (/ & + & 0.37315e-03_r8,0.13660e-02_r8,0.15416e-02_r8,0.14697e-02_r8,0.75241e-03_r8 /) + kbo(:, 5,39, 6) = (/ & + & 0.40840e-03_r8,0.15291e-02_r8,0.17396e-02_r8,0.16583e-02_r8,0.81566e-03_r8 /) + kbo(:, 1,40, 6) = (/ & + & 0.20445e-03_r8,0.81104e-03_r8,0.91201e-03_r8,0.88303e-03_r8,0.49462e-03_r8 /) + kbo(:, 2,40, 6) = (/ & + & 0.24013e-03_r8,0.91062e-03_r8,0.10259e-02_r8,0.98834e-03_r8,0.53806e-03_r8 /) + kbo(:, 3,40, 6) = (/ & + & 0.27454e-03_r8,0.10267e-02_r8,0.11591e-02_r8,0.11112e-02_r8,0.58582e-03_r8 /) + kbo(:, 4,40, 6) = (/ & + & 0.30609e-03_r8,0.11586e-02_r8,0.13148e-02_r8,0.12564e-02_r8,0.63733e-03_r8 /) + kbo(:, 5,40, 6) = (/ & + & 0.33521e-03_r8,0.13038e-02_r8,0.14932e-02_r8,0.14267e-02_r8,0.69406e-03_r8 /) + kbo(:, 1,41, 6) = (/ & + & 0.16568e-03_r8,0.67706e-03_r8,0.76339e-03_r8,0.74014e-03_r8,0.41311e-03_r8 /) + kbo(:, 2,41, 6) = (/ & + & 0.19545e-03_r8,0.76370e-03_r8,0.86317e-03_r8,0.83349e-03_r8,0.45126e-03_r8 /) + kbo(:, 3,41, 6) = (/ & + & 0.22429e-03_r8,0.86513e-03_r8,0.98057e-03_r8,0.94284e-03_r8,0.49336e-03_r8 /) + kbo(:, 4,41, 6) = (/ & + & 0.25075e-03_r8,0.98100e-03_r8,0.11192e-02_r8,0.10723e-02_r8,0.53916e-03_r8 /) + kbo(:, 5,41, 6) = (/ & + & 0.27523e-03_r8,0.11101e-02_r8,0.12797e-02_r8,0.12259e-02_r8,0.58980e-03_r8 /) + kbo(:, 1,42, 6) = (/ & + & 0.13464e-03_r8,0.56478e-03_r8,0.63846e-03_r8,0.61972e-03_r8,0.34485e-03_r8 /) + kbo(:, 2,42, 6) = (/ & + & 0.15918e-03_r8,0.64002e-03_r8,0.72573e-03_r8,0.70212e-03_r8,0.37807e-03_r8 /) + kbo(:, 3,42, 6) = (/ & + & 0.18309e-03_r8,0.72866e-03_r8,0.82914e-03_r8,0.79959e-03_r8,0.41541e-03_r8 /) + kbo(:, 4,42, 6) = (/ & + & 0.20534e-03_r8,0.83063e-03_r8,0.95224e-03_r8,0.91510e-03_r8,0.45609e-03_r8 /) + kbo(:, 5,42, 6) = (/ & + & 0.22591e-03_r8,0.94536e-03_r8,0.10960e-02_r8,0.10535e-02_r8,0.50132e-03_r8 /) + kbo(:, 1,43, 6) = (/ & + & 0.10834e-03_r8,0.46763e-03_r8,0.52964e-03_r8,0.51479e-03_r8,0.28641e-03_r8 /) + kbo(:, 2,43, 6) = (/ & + & 0.12878e-03_r8,0.53191e-03_r8,0.60529e-03_r8,0.58655e-03_r8,0.31538e-03_r8 /) + kbo(:, 3,43, 6) = (/ & + & 0.14877e-03_r8,0.60848e-03_r8,0.69517e-03_r8,0.67233e-03_r8,0.34781e-03_r8 /) + kbo(:, 4,43, 6) = (/ & + & 0.16739e-03_r8,0.69818e-03_r8,0.80315e-03_r8,0.77433e-03_r8,0.38376e-03_r8 /) + kbo(:, 5,43, 6) = (/ & + & 0.18458e-03_r8,0.79951e-03_r8,0.93071e-03_r8,0.89755e-03_r8,0.42371e-03_r8 /) + kbo(:, 1,44, 6) = (/ & + & 0.86770e-04_r8,0.38551e-03_r8,0.43712e-03_r8,0.42544e-03_r8,0.23710e-03_r8 /) + kbo(:, 2,44, 6) = (/ & + & 0.10382e-03_r8,0.44040e-03_r8,0.50222e-03_r8,0.48753e-03_r8,0.26235e-03_r8 /) + kbo(:, 3,44, 6) = (/ & + & 0.12059e-03_r8,0.50571e-03_r8,0.58013e-03_r8,0.56233e-03_r8,0.29036e-03_r8 /) + kbo(:, 4,44, 6) = (/ & + & 0.13632e-03_r8,0.58391e-03_r8,0.67429e-03_r8,0.65221e-03_r8,0.32192e-03_r8 /) + kbo(:, 5,44, 6) = (/ & + & 0.15073e-03_r8,0.67339e-03_r8,0.78624e-03_r8,0.76086e-03_r8,0.35732e-03_r8 /) + kbo(:, 1,45, 6) = (/ & + & 0.69317e-04_r8,0.31724e-03_r8,0.36001e-03_r8,0.35090e-03_r8,0.19579e-03_r8 /) + kbo(:, 2,45, 6) = (/ & + & 0.83569e-04_r8,0.36417e-03_r8,0.41579e-03_r8,0.40435e-03_r8,0.21781e-03_r8 /) + kbo(:, 3,45, 6) = (/ & + & 0.97725e-04_r8,0.42014e-03_r8,0.48329e-03_r8,0.46938e-03_r8,0.24226e-03_r8 /) + kbo(:, 4,45, 6) = (/ & + & 0.11101e-03_r8,0.48745e-03_r8,0.56520e-03_r8,0.54804e-03_r8,0.26965e-03_r8 /) + kbo(:, 5,45, 6) = (/ & + & 0.12310e-03_r8,0.56606e-03_r8,0.66327e-03_r8,0.64374e-03_r8,0.30080e-03_r8 /) + kbo(:, 1,46, 6) = (/ & + & 0.55030e-04_r8,0.26007e-03_r8,0.29522e-03_r8,0.28798e-03_r8,0.16098e-03_r8 /) + kbo(:, 2,46, 6) = (/ & + & 0.66908e-04_r8,0.29981e-03_r8,0.34235e-03_r8,0.33361e-03_r8,0.18009e-03_r8 /) + kbo(:, 3,46, 6) = (/ & + & 0.78894e-04_r8,0.34737e-03_r8,0.40028e-03_r8,0.38969e-03_r8,0.20138e-03_r8 /) + kbo(:, 4,46, 6) = (/ & + & 0.90228e-04_r8,0.40507e-03_r8,0.47110e-03_r8,0.45796e-03_r8,0.22525e-03_r8 /) + kbo(:, 5,46, 6) = (/ & + & 0.10044e-03_r8,0.47380e-03_r8,0.55673e-03_r8,0.54149e-03_r8,0.25231e-03_r8 /) + kbo(:, 1,47, 6) = (/ & + & 0.43131e-04_r8,0.21132e-03_r8,0.23992e-03_r8,0.23430e-03_r8,0.13147e-03_r8 /) + kbo(:, 2,47, 6) = (/ & + & 0.53026e-04_r8,0.24489e-03_r8,0.27966e-03_r8,0.27282e-03_r8,0.14794e-03_r8 /) + kbo(:, 3,47, 6) = (/ & + & 0.63179e-04_r8,0.28502e-03_r8,0.32837e-03_r8,0.32046e-03_r8,0.16642e-03_r8 /) + kbo(:, 4,47, 6) = (/ & + & 0.72849e-04_r8,0.33391e-03_r8,0.38868e-03_r8,0.37909e-03_r8,0.18727e-03_r8 /) + kbo(:, 5,47, 6) = (/ & + & 0.81641e-04_r8,0.39308e-03_r8,0.46293e-03_r8,0.45114e-03_r8,0.21071e-03_r8 /) + kbo(:, 1,48, 6) = (/ & + & 0.33560e-04_r8,0.17139e-03_r8,0.19468e-03_r8,0.19001e-03_r8,0.10710e-03_r8 /) + kbo(:, 2,48, 6) = (/ & + & 0.41736e-04_r8,0.19942e-03_r8,0.22765e-03_r8,0.22235e-03_r8,0.12121e-03_r8 /) + kbo(:, 3,48, 6) = (/ & + & 0.50371e-04_r8,0.23319e-03_r8,0.26893e-03_r8,0.26280e-03_r8,0.13718e-03_r8 /) + kbo(:, 4,48, 6) = (/ & + & 0.58779e-04_r8,0.27466e-03_r8,0.31973e-03_r8,0.31295e-03_r8,0.15543e-03_r8 /) + kbo(:, 5,48, 6) = (/ & + & 0.66247e-04_r8,0.32531e-03_r8,0.38347e-03_r8,0.37465e-03_r8,0.17582e-03_r8 /) + kbo(:, 1,49, 6) = (/ & + & 0.25958e-04_r8,0.13895e-03_r8,0.15751e-03_r8,0.15378e-03_r8,0.86997e-04_r8 /) + kbo(:, 2,49, 6) = (/ & + & 0.32663e-04_r8,0.16210e-03_r8,0.18496e-03_r8,0.18058e-03_r8,0.99003e-04_r8 /) + kbo(:, 3,49, 6) = (/ & + & 0.39912e-04_r8,0.19033e-03_r8,0.21954e-03_r8,0.21463e-03_r8,0.11278e-03_r8 /) + kbo(:, 4,49, 6) = (/ & + & 0.47146e-04_r8,0.22536e-03_r8,0.26252e-03_r8,0.25743e-03_r8,0.12854e-03_r8 /) + kbo(:, 5,49, 6) = (/ & + & 0.53714e-04_r8,0.26879e-03_r8,0.31652e-03_r8,0.31040e-03_r8,0.14638e-03_r8 /) + kbo(:, 1,50, 6) = (/ & + & 0.20123e-04_r8,0.11283e-03_r8,0.12763e-03_r8,0.12462e-03_r8,0.70722e-04_r8 /) + kbo(:, 2,50, 6) = (/ & + & 0.25601e-04_r8,0.13215e-03_r8,0.15042e-03_r8,0.14697e-03_r8,0.80931e-04_r8 /) + kbo(:, 3,50, 6) = (/ & + & 0.31614e-04_r8,0.15574e-03_r8,0.17957e-03_r8,0.17552e-03_r8,0.92734e-04_r8 /) + kbo(:, 4,50, 6) = (/ & + & 0.37764e-04_r8,0.18520e-03_r8,0.21596e-03_r8,0.21200e-03_r8,0.10641e-03_r8 /) + kbo(:, 5,50, 6) = (/ & + & 0.43463e-04_r8,0.22248e-03_r8,0.26195e-03_r8,0.25758e-03_r8,0.12203e-03_r8 /) + kbo(:, 1,51, 6) = (/ & + & 0.15566e-04_r8,0.91692e-04_r8,0.10348e-03_r8,0.10093e-03_r8,0.57420e-04_r8 /) + kbo(:, 2,51, 6) = (/ & + & 0.20041e-04_r8,0.10771e-03_r8,0.12230e-03_r8,0.11952e-03_r8,0.66019e-04_r8 /) + kbo(:, 3,51, 6) = (/ & + & 0.25022e-04_r8,0.12757e-03_r8,0.14670e-03_r8,0.14349e-03_r8,0.76182e-04_r8 /) + kbo(:, 4,51, 6) = (/ & + & 0.30196e-04_r8,0.15226e-03_r8,0.17772e-03_r8,0.17429e-03_r8,0.87954e-04_r8 /) + kbo(:, 5,51, 6) = (/ & + & 0.35140e-04_r8,0.18405e-03_r8,0.21697e-03_r8,0.21356e-03_r8,0.10162e-03_r8 /) + kbo(:, 1,52, 6) = (/ & + & 0.11977e-04_r8,0.74321e-04_r8,0.83777e-04_r8,0.81525e-04_r8,0.46492e-04_r8 /) + kbo(:, 2,52, 6) = (/ & + & 0.15618e-04_r8,0.87662e-04_r8,0.99315e-04_r8,0.96995e-04_r8,0.53744e-04_r8 /) + kbo(:, 3,52, 6) = (/ & + & 0.19731e-04_r8,0.10434e-03_r8,0.11957e-03_r8,0.11696e-03_r8,0.62355e-04_r8 /) + kbo(:, 4,52, 6) = (/ & + & 0.24071e-04_r8,0.12514e-03_r8,0.14574e-03_r8,0.14300e-03_r8,0.72491e-04_r8 /) + kbo(:, 5,52, 6) = (/ & + & 0.28292e-04_r8,0.15185e-03_r8,0.17919e-03_r8,0.17642e-03_r8,0.84356e-04_r8 /) + kbo(:, 1,53, 6) = (/ & + & 0.91836e-05_r8,0.60131e-04_r8,0.67720e-04_r8,0.65649e-04_r8,0.37522e-04_r8 /) + kbo(:, 2,53, 6) = (/ & + & 0.12113e-04_r8,0.71192e-04_r8,0.80457e-04_r8,0.78425e-04_r8,0.43599e-04_r8 /) + kbo(:, 3,53, 6) = (/ & + & 0.15471e-04_r8,0.85141e-04_r8,0.97276e-04_r8,0.95110e-04_r8,0.50903e-04_r8 /) + kbo(:, 4,53, 6) = (/ & + & 0.19102e-04_r8,0.10263e-03_r8,0.11918e-03_r8,0.11694e-03_r8,0.59553e-04_r8 /) + kbo(:, 5,53, 6) = (/ & + & 0.22693e-04_r8,0.12514e-03_r8,0.14755e-03_r8,0.14527e-03_r8,0.69812e-04_r8 /) + kbo(:, 1,54, 6) = (/ & + & 0.70721e-05_r8,0.48764e-04_r8,0.54926e-04_r8,0.53041e-04_r8,0.30337e-04_r8 /) + kbo(:, 2,54, 6) = (/ & + & 0.94270e-05_r8,0.57982e-04_r8,0.65461e-04_r8,0.63579e-04_r8,0.35439e-04_r8 /) + kbo(:, 3,54, 6) = (/ & + & 0.12173e-04_r8,0.69671e-04_r8,0.79433e-04_r8,0.77530e-04_r8,0.41618e-04_r8 /) + kbo(:, 4,54, 6) = (/ & + & 0.15195e-04_r8,0.84502e-04_r8,0.97826e-04_r8,0.96029e-04_r8,0.49017e-04_r8 /) + kbo(:, 5,54, 6) = (/ & + & 0.18243e-04_r8,0.10358e-03_r8,0.12196e-03_r8,0.12023e-03_r8,0.57880e-04_r8 /) + kbo(:, 1,55, 6) = (/ & + & 0.54549e-05_r8,0.39521e-04_r8,0.44580e-04_r8,0.42901e-04_r8,0.24523e-04_r8 /) + kbo(:, 2,55, 6) = (/ & + & 0.73474e-05_r8,0.47258e-04_r8,0.53311e-04_r8,0.51627e-04_r8,0.28799e-04_r8 /) + kbo(:, 3,55, 6) = (/ & + & 0.95818e-05_r8,0.57041e-04_r8,0.64957e-04_r8,0.63210e-04_r8,0.34015e-04_r8 /) + kbo(:, 4,55, 6) = (/ & + & 0.12078e-04_r8,0.69528e-04_r8,0.80422e-04_r8,0.78845e-04_r8,0.40325e-04_r8 /) + kbo(:, 5,55, 6) = (/ & + & 0.14658e-04_r8,0.85891e-04_r8,0.10087e-03_r8,0.99485e-04_r8,0.47973e-04_r8 /) + kbo(:, 1,56, 6) = (/ & + & 0.41972e-05_r8,0.31935e-04_r8,0.36125e-04_r8,0.34628e-04_r8,0.19758e-04_r8 /) + kbo(:, 2,56, 6) = (/ & + & 0.56951e-05_r8,0.38357e-04_r8,0.43303e-04_r8,0.41823e-04_r8,0.23341e-04_r8 /) + kbo(:, 3,56, 6) = (/ & + & 0.75109e-05_r8,0.46586e-04_r8,0.52984e-04_r8,0.51438e-04_r8,0.27705e-04_r8 /) + kbo(:, 4,56, 6) = (/ & + & 0.95701e-05_r8,0.57135e-04_r8,0.66020e-04_r8,0.64513e-04_r8,0.33090e-04_r8 /) + kbo(:, 5,56, 6) = (/ & + & 0.11741e-04_r8,0.70996e-04_r8,0.83348e-04_r8,0.82172e-04_r8,0.39639e-04_r8 /) + kbo(:, 1,57, 6) = (/ & + & 0.32187e-05_r8,0.25710e-04_r8,0.29175e-04_r8,0.27903e-04_r8,0.15874e-04_r8 /) + kbo(:, 2,57, 6) = (/ & + & 0.44067e-05_r8,0.31037e-04_r8,0.35094e-04_r8,0.33812e-04_r8,0.18857e-04_r8 /) + kbo(:, 3,57, 6) = (/ & + & 0.58663e-05_r8,0.37889e-04_r8,0.43100e-04_r8,0.41766e-04_r8,0.22502e-04_r8 /) + kbo(:, 4,57, 6) = (/ & + & 0.75519e-05_r8,0.46817e-04_r8,0.54053e-04_r8,0.52634e-04_r8,0.27030e-04_r8 /) + kbo(:, 5,57, 6) = (/ & + & 0.93649e-05_r8,0.58529e-04_r8,0.68705e-04_r8,0.67601e-04_r8,0.32661e-04_r8 /) + kbo(:, 1,58, 6) = (/ & + & 0.24696e-05_r8,0.20698e-04_r8,0.23574e-04_r8,0.22507e-04_r8,0.12764e-04_r8 /) + kbo(:, 2,58, 6) = (/ & + & 0.34175e-05_r8,0.25141e-04_r8,0.28438e-04_r8,0.27351e-04_r8,0.15243e-04_r8 /) + kbo(:, 3,58, 6) = (/ & + & 0.45825e-05_r8,0.30855e-04_r8,0.35092e-04_r8,0.33951e-04_r8,0.18275e-04_r8 /) + kbo(:, 4,58, 6) = (/ & + & 0.59665e-05_r8,0.38392e-04_r8,0.44239e-04_r8,0.43055e-04_r8,0.22112e-04_r8 /) + kbo(:, 5,58, 6) = (/ & + & 0.74784e-05_r8,0.48383e-04_r8,0.56772e-04_r8,0.55657e-04_r8,0.26900e-04_r8 /) + kbo(:, 1,59, 6) = (/ & + & 0.20113e-05_r8,0.17223e-04_r8,0.19628e-04_r8,0.18772e-04_r8,0.10576e-04_r8 /) + kbo(:, 2,59, 6) = (/ & + & 0.27973e-05_r8,0.21075e-04_r8,0.23849e-04_r8,0.22960e-04_r8,0.12702e-04_r8 /) + kbo(:, 3,59, 6) = (/ & + & 0.37714e-05_r8,0.26064e-04_r8,0.29696e-04_r8,0.28726e-04_r8,0.15326e-04_r8 /) + kbo(:, 4,59, 6) = (/ & + & 0.49189e-05_r8,0.32724e-04_r8,0.37808e-04_r8,0.36791e-04_r8,0.18710e-04_r8 /) + kbo(:, 5,59, 6) = (/ & + & 0.61850e-05_r8,0.41676e-04_r8,0.49043e-04_r8,0.48051e-04_r8,0.22936e-04_r8 /) + kbo(:, 1,13, 7) = (/ & + & 0.90574e-01_r8,0.18508e+00_r8,0.20125e+00_r8,0.19353e+00_r8,0.13590e+00_r8 /) + kbo(:, 2,13, 7) = (/ & + & 0.96633e-01_r8,0.18856e+00_r8,0.20514e+00_r8,0.19781e+00_r8,0.13867e+00_r8 /) + kbo(:, 3,13, 7) = (/ & + & 0.10246e+00_r8,0.19231e+00_r8,0.20916e+00_r8,0.20175e+00_r8,0.14157e+00_r8 /) + kbo(:, 4,13, 7) = (/ & + & 0.10831e+00_r8,0.19664e+00_r8,0.21340e+00_r8,0.20566e+00_r8,0.14422e+00_r8 /) + kbo(:, 5,13, 7) = (/ & + & 0.11418e+00_r8,0.20190e+00_r8,0.21829e+00_r8,0.20964e+00_r8,0.14715e+00_r8 /) + kbo(:, 1,14, 7) = (/ & + & 0.76731e-01_r8,0.15637e+00_r8,0.17031e+00_r8,0.16454e+00_r8,0.11471e+00_r8 /) + kbo(:, 2,14, 7) = (/ & + & 0.81853e-01_r8,0.15935e+00_r8,0.17367e+00_r8,0.16809e+00_r8,0.11738e+00_r8 /) + kbo(:, 3,14, 7) = (/ & + & 0.86939e-01_r8,0.16284e+00_r8,0.17719e+00_r8,0.17151e+00_r8,0.11993e+00_r8 /) + kbo(:, 4,14, 7) = (/ & + & 0.91985e-01_r8,0.16698e+00_r8,0.18115e+00_r8,0.17500e+00_r8,0.12254e+00_r8 /) + kbo(:, 5,14, 7) = (/ & + & 0.97005e-01_r8,0.17199e+00_r8,0.18590e+00_r8,0.17860e+00_r8,0.12524e+00_r8 /) + kbo(:, 1,15, 7) = (/ & + & 0.64796e-01_r8,0.13180e+00_r8,0.14379e+00_r8,0.13927e+00_r8,0.96282e-01_r8 /) + kbo(:, 2,15, 7) = (/ & + & 0.69175e-01_r8,0.13451e+00_r8,0.14669e+00_r8,0.14230e+00_r8,0.98702e-01_r8 /) + kbo(:, 3,15, 7) = (/ & + & 0.73574e-01_r8,0.13779e+00_r8,0.14991e+00_r8,0.14533e+00_r8,0.10111e+00_r8 /) + kbo(:, 4,15, 7) = (/ & + & 0.77907e-01_r8,0.14175e+00_r8,0.15375e+00_r8,0.14848e+00_r8,0.10336e+00_r8 /) + kbo(:, 5,15, 7) = (/ & + & 0.82082e-01_r8,0.14644e+00_r8,0.15826e+00_r8,0.15192e+00_r8,0.10558e+00_r8 /) + kbo(:, 1,16, 7) = (/ & + & 0.54603e-01_r8,0.11092e+00_r8,0.12113e+00_r8,0.11747e+00_r8,0.80564e-01_r8 /) + kbo(:, 2,16, 7) = (/ & + & 0.58392e-01_r8,0.11343e+00_r8,0.12376e+00_r8,0.12011e+00_r8,0.82662e-01_r8 /) + kbo(:, 3,16, 7) = (/ & + & 0.62149e-01_r8,0.11652e+00_r8,0.12680e+00_r8,0.12283e+00_r8,0.84744e-01_r8 /) + kbo(:, 4,16, 7) = (/ & + & 0.65779e-01_r8,0.12031e+00_r8,0.13049e+00_r8,0.12576e+00_r8,0.86806e-01_r8 /) + kbo(:, 5,16, 7) = (/ & + & 0.69275e-01_r8,0.12462e+00_r8,0.13474e+00_r8,0.12909e+00_r8,0.88592e-01_r8 /) + kbo(:, 1,17, 7) = (/ & + & 0.46019e-01_r8,0.93276e-01_r8,0.10182e+00_r8,0.98886e-01_r8,0.67386e-01_r8 /) + kbo(:, 2,17, 7) = (/ & + & 0.49257e-01_r8,0.95617e-01_r8,0.10427e+00_r8,0.10122e+00_r8,0.69214e-01_r8 /) + kbo(:, 3,17, 7) = (/ & + & 0.52438e-01_r8,0.98544e-01_r8,0.10723e+00_r8,0.10369e+00_r8,0.71047e-01_r8 /) + kbo(:, 4,17, 7) = (/ & + & 0.55444e-01_r8,0.10204e+00_r8,0.11074e+00_r8,0.10647e+00_r8,0.72809e-01_r8 /) + kbo(:, 5,17, 7) = (/ & + & 0.58360e-01_r8,0.10585e+00_r8,0.11469e+00_r8,0.10967e+00_r8,0.74297e-01_r8 /) + kbo(:, 1,18, 7) = (/ & + & 0.38789e-01_r8,0.78385e-01_r8,0.85426e-01_r8,0.83127e-01_r8,0.56424e-01_r8 /) + kbo(:, 2,18, 7) = (/ & + & 0.41550e-01_r8,0.80626e-01_r8,0.87775e-01_r8,0.85216e-01_r8,0.58103e-01_r8 /) + kbo(:, 3,18, 7) = (/ & + & 0.44172e-01_r8,0.83391e-01_r8,0.90633e-01_r8,0.87547e-01_r8,0.59665e-01_r8 /) + kbo(:, 4,18, 7) = (/ & + & 0.46672e-01_r8,0.86541e-01_r8,0.93910e-01_r8,0.90224e-01_r8,0.61155e-01_r8 /) + kbo(:, 5,18, 7) = (/ & + & 0.49119e-01_r8,0.89890e-01_r8,0.97478e-01_r8,0.93171e-01_r8,0.62440e-01_r8 /) + kbo(:, 1,19, 7) = (/ & + & 0.32688e-01_r8,0.65866e-01_r8,0.71699e-01_r8,0.69831e-01_r8,0.47341e-01_r8 /) + kbo(:, 2,19, 7) = (/ & + & 0.34993e-01_r8,0.67987e-01_r8,0.73938e-01_r8,0.71758e-01_r8,0.48787e-01_r8 /) + kbo(:, 3,19, 7) = (/ & + & 0.37158e-01_r8,0.70566e-01_r8,0.76608e-01_r8,0.73972e-01_r8,0.50204e-01_r8 /) + kbo(:, 4,19, 7) = (/ & + & 0.39257e-01_r8,0.73365e-01_r8,0.79594e-01_r8,0.76458e-01_r8,0.51459e-01_r8 /) + kbo(:, 5,19, 7) = (/ & + & 0.41326e-01_r8,0.76343e-01_r8,0.82757e-01_r8,0.79138e-01_r8,0.52598e-01_r8 /) + kbo(:, 1,20, 7) = (/ & + & 0.27557e-01_r8,0.55396e-01_r8,0.60366e-01_r8,0.58674e-01_r8,0.39775e-01_r8 /) + kbo(:, 2,20, 7) = (/ & + & 0.29458e-01_r8,0.57423e-01_r8,0.62478e-01_r8,0.60497e-01_r8,0.41091e-01_r8 /) + kbo(:, 3,20, 7) = (/ & + & 0.31261e-01_r8,0.59745e-01_r8,0.64927e-01_r8,0.62579e-01_r8,0.42317e-01_r8 /) + kbo(:, 4,20, 7) = (/ & + & 0.33046e-01_r8,0.62240e-01_r8,0.67549e-01_r8,0.64853e-01_r8,0.43439e-01_r8 /) + kbo(:, 5,20, 7) = (/ & + & 0.34818e-01_r8,0.64890e-01_r8,0.70320e-01_r8,0.67290e-01_r8,0.44513e-01_r8 /) + kbo(:, 1,21, 7) = (/ & + & 0.23194e-01_r8,0.46662e-01_r8,0.50879e-01_r8,0.49331e-01_r8,0.33429e-01_r8 /) + kbo(:, 2,21, 7) = (/ & + & 0.24776e-01_r8,0.48529e-01_r8,0.52871e-01_r8,0.51054e-01_r8,0.34590e-01_r8 /) + kbo(:, 3,21, 7) = (/ & + & 0.26303e-01_r8,0.50578e-01_r8,0.55098e-01_r8,0.52980e-01_r8,0.35684e-01_r8 /) + kbo(:, 4,21, 7) = (/ & + & 0.27810e-01_r8,0.52793e-01_r8,0.57429e-01_r8,0.55052e-01_r8,0.36688e-01_r8 /) + kbo(:, 5,21, 7) = (/ & + & 0.29323e-01_r8,0.55187e-01_r8,0.59853e-01_r8,0.57245e-01_r8,0.37657e-01_r8 /) + kbo(:, 1,22, 7) = (/ & + & 0.19600e-01_r8,0.39448e-01_r8,0.43057e-01_r8,0.41623e-01_r8,0.28169e-01_r8 /) + kbo(:, 2,22, 7) = (/ & + & 0.20910e-01_r8,0.41135e-01_r8,0.44924e-01_r8,0.43250e-01_r8,0.29188e-01_r8 /) + kbo(:, 3,22, 7) = (/ & + & 0.22195e-01_r8,0.42970e-01_r8,0.46916e-01_r8,0.45021e-01_r8,0.30138e-01_r8 /) + kbo(:, 4,22, 7) = (/ & + & 0.23466e-01_r8,0.44963e-01_r8,0.48978e-01_r8,0.46906e-01_r8,0.31021e-01_r8 /) + kbo(:, 5,22, 7) = (/ & + & 0.24791e-01_r8,0.47151e-01_r8,0.51143e-01_r8,0.48901e-01_r8,0.31919e-01_r8 /) + kbo(:, 1,23, 7) = (/ & + & 0.16563e-01_r8,0.33405e-01_r8,0.36517e-01_r8,0.35235e-01_r8,0.23758e-01_r8 /) + kbo(:, 2,23, 7) = (/ & + & 0.17634e-01_r8,0.34920e-01_r8,0.38215e-01_r8,0.36726e-01_r8,0.24656e-01_r8 /) + kbo(:, 3,23, 7) = (/ & + & 0.18715e-01_r8,0.36571e-01_r8,0.39976e-01_r8,0.38337e-01_r8,0.25473e-01_r8 /) + kbo(:, 4,23, 7) = (/ & + & 0.19810e-01_r8,0.38397e-01_r8,0.41828e-01_r8,0.40046e-01_r8,0.26273e-01_r8 /) + kbo(:, 5,23, 7) = (/ & + & 0.20990e-01_r8,0.40406e-01_r8,0.43840e-01_r8,0.41881e-01_r8,0.27068e-01_r8 /) + kbo(:, 1,24, 7) = (/ & + & 0.13980e-01_r8,0.28346e-01_r8,0.31027e-01_r8,0.29909e-01_r8,0.20058e-01_r8 /) + kbo(:, 2,24, 7) = (/ & + & 0.14874e-01_r8,0.29707e-01_r8,0.32546e-01_r8,0.31266e-01_r8,0.20839e-01_r8 /) + kbo(:, 3,24, 7) = (/ & + & 0.15797e-01_r8,0.31204e-01_r8,0.34123e-01_r8,0.32728e-01_r8,0.21557e-01_r8 /) + kbo(:, 4,24, 7) = (/ & + & 0.16758e-01_r8,0.32875e-01_r8,0.35824e-01_r8,0.34296e-01_r8,0.22274e-01_r8 /) + kbo(:, 5,24, 7) = (/ & + & 0.17809e-01_r8,0.34737e-01_r8,0.37711e-01_r8,0.35981e-01_r8,0.22992e-01_r8 /) + kbo(:, 1,25, 7) = (/ & + & 0.11798e-01_r8,0.24110e-01_r8,0.26426e-01_r8,0.25457e-01_r8,0.16985e-01_r8 /) + kbo(:, 2,25, 7) = (/ & + & 0.12561e-01_r8,0.25347e-01_r8,0.27781e-01_r8,0.26691e-01_r8,0.17655e-01_r8 /) + kbo(:, 3,25, 7) = (/ & + & 0.13359e-01_r8,0.26711e-01_r8,0.29222e-01_r8,0.28026e-01_r8,0.18302e-01_r8 /) + kbo(:, 4,25, 7) = (/ & + & 0.14208e-01_r8,0.28241e-01_r8,0.30806e-01_r8,0.29472e-01_r8,0.18949e-01_r8 /) + kbo(:, 5,25, 7) = (/ & + & 0.15157e-01_r8,0.29980e-01_r8,0.32597e-01_r8,0.31029e-01_r8,0.19596e-01_r8 /) + kbo(:, 1,26, 7) = (/ & + & 0.99745e-02_r8,0.20581e-01_r8,0.22580e-01_r8,0.21746e-01_r8,0.14432e-01_r8 /) + kbo(:, 2,26, 7) = (/ & + & 0.10633e-01_r8,0.21703e-01_r8,0.23807e-01_r8,0.22873e-01_r8,0.15014e-01_r8 /) + kbo(:, 3,26, 7) = (/ & + & 0.11328e-01_r8,0.22948e-01_r8,0.25141e-01_r8,0.24108e-01_r8,0.15588e-01_r8 /) + kbo(:, 4,26, 7) = (/ & + & 0.12091e-01_r8,0.24380e-01_r8,0.26636e-01_r8,0.25439e-01_r8,0.16180e-01_r8 /) + kbo(:, 5,26, 7) = (/ & + & 0.12943e-01_r8,0.26016e-01_r8,0.28335e-01_r8,0.26899e-01_r8,0.16787e-01_r8 /) + kbo(:, 1,27, 7) = (/ & + & 0.84424e-02_r8,0.17603e-01_r8,0.19348e-01_r8,0.18632e-01_r8,0.12275e-01_r8 /) + kbo(:, 2,27, 7) = (/ & + & 0.90172e-02_r8,0.18627e-01_r8,0.20475e-01_r8,0.19670e-01_r8,0.12796e-01_r8 /) + kbo(:, 3,27, 7) = (/ & + & 0.96344e-02_r8,0.19791e-01_r8,0.21724e-01_r8,0.20817e-01_r8,0.13316e-01_r8 /) + kbo(:, 4,27, 7) = (/ & + & 0.10319e-01_r8,0.21143e-01_r8,0.23141e-01_r8,0.22059e-01_r8,0.13859e-01_r8 /) + kbo(:, 5,27, 7) = (/ & + & 0.11083e-01_r8,0.22688e-01_r8,0.24742e-01_r8,0.23449e-01_r8,0.14418e-01_r8 /) + kbo(:, 1,28, 7) = (/ & + & 0.71594e-02_r8,0.15094e-01_r8,0.16638e-01_r8,0.16016e-01_r8,0.10452e-01_r8 /) + kbo(:, 2,28, 7) = (/ & + & 0.76603e-02_r8,0.16043e-01_r8,0.17678e-01_r8,0.16989e-01_r8,0.10928e-01_r8 /) + kbo(:, 3,28, 7) = (/ & + & 0.82161e-02_r8,0.17148e-01_r8,0.18856e-01_r8,0.18055e-01_r8,0.11409e-01_r8 /) + kbo(:, 4,28, 7) = (/ & + & 0.88297e-02_r8,0.18429e-01_r8,0.20193e-01_r8,0.19234e-01_r8,0.11908e-01_r8 /) + kbo(:, 5,28, 7) = (/ & + & 0.95210e-02_r8,0.19896e-01_r8,0.21697e-01_r8,0.20565e-01_r8,0.12423e-01_r8 /) + kbo(:, 1,29, 7) = (/ & + & 0.60865e-02_r8,0.12992e-01_r8,0.14367e-01_r8,0.13830e-01_r8,0.89337e-02_r8 /) + kbo(:, 2,29, 7) = (/ & + & 0.65273e-02_r8,0.13894e-01_r8,0.15342e-01_r8,0.14741e-01_r8,0.93649e-02_r8 /) + kbo(:, 3,29, 7) = (/ & + & 0.70278e-02_r8,0.14949e-01_r8,0.16457e-01_r8,0.15746e-01_r8,0.98158e-02_r8 /) + kbo(:, 4,29, 7) = (/ & + & 0.75858e-02_r8,0.16169e-01_r8,0.17720e-01_r8,0.16877e-01_r8,0.10273e-01_r8 /) + kbo(:, 5,29, 7) = (/ & + & 0.82154e-02_r8,0.17564e-01_r8,0.19150e-01_r8,0.18159e-01_r8,0.10745e-01_r8 /) + kbo(:, 1,30, 7) = (/ & + & 0.51820e-02_r8,0.11236e-01_r8,0.12459e-01_r8,0.12000e-01_r8,0.76507e-02_r8 /) + kbo(:, 2,30, 7) = (/ & + & 0.55811e-02_r8,0.12098e-01_r8,0.13380e-01_r8,0.12854e-01_r8,0.80497e-02_r8 /) + kbo(:, 3,30, 7) = (/ & + & 0.60310e-02_r8,0.13108e-01_r8,0.14440e-01_r8,0.13813e-01_r8,0.84648e-02_r8 /) + kbo(:, 4,30, 7) = (/ & + & 0.65404e-02_r8,0.14273e-01_r8,0.15644e-01_r8,0.14905e-01_r8,0.88882e-02_r8 /) + kbo(:, 5,30, 7) = (/ & + & 0.71170e-02_r8,0.15597e-01_r8,0.17012e-01_r8,0.16134e-01_r8,0.93248e-02_r8 /) + kbo(:, 1,31, 7) = (/ & + & 0.44272e-02_r8,0.97757e-02_r8,0.10859e-01_r8,0.10467e-01_r8,0.65734e-02_r8 /) + kbo(:, 2,31, 7) = (/ & + & 0.47878e-02_r8,0.10603e-01_r8,0.11740e-01_r8,0.11277e-01_r8,0.69415e-02_r8 /) + kbo(:, 3,31, 7) = (/ & + & 0.51963e-02_r8,0.11572e-01_r8,0.12753e-01_r8,0.12201e-01_r8,0.73188e-02_r8 /) + kbo(:, 4,31, 7) = (/ & + & 0.56609e-02_r8,0.12684e-01_r8,0.13904e-01_r8,0.13252e-01_r8,0.77091e-02_r8 /) + kbo(:, 5,31, 7) = (/ & + & 0.61977e-02_r8,0.13944e-01_r8,0.15244e-01_r8,0.14424e-01_r8,0.81161e-02_r8 /) + kbo(:, 1,32, 7) = (/ & + & 0.37962e-02_r8,0.85614e-02_r8,0.95233e-02_r8,0.91812e-02_r8,0.56658e-02_r8 /) + kbo(:, 2,32, 7) = (/ & + & 0.41228e-02_r8,0.93595e-02_r8,0.10368e-01_r8,0.99574e-02_r8,0.60000e-02_r8 /) + kbo(:, 3,32, 7) = (/ & + & 0.44947e-02_r8,0.10287e-01_r8,0.11338e-01_r8,0.10850e-01_r8,0.63462e-02_r8 /) + kbo(:, 4,32, 7) = (/ & + & 0.49244e-02_r8,0.11349e-01_r8,0.12467e-01_r8,0.11857e-01_r8,0.67069e-02_r8 /) + kbo(:, 5,32, 7) = (/ & + & 0.54252e-02_r8,0.12554e-01_r8,0.13767e-01_r8,0.12983e-01_r8,0.70910e-02_r8 /) + kbo(:, 1,33, 7) = (/ & + & 0.32656e-02_r8,0.75519e-02_r8,0.84026e-02_r8,0.81028e-02_r8,0.48937e-02_r8 /) + kbo(:, 2,33, 7) = (/ & + & 0.35630e-02_r8,0.83178e-02_r8,0.92157e-02_r8,0.88531e-02_r8,0.52004e-02_r8 /) + kbo(:, 3,33, 7) = (/ & + & 0.39050e-02_r8,0.92063e-02_r8,0.10168e-01_r8,0.97125e-02_r8,0.55156e-02_r8 /) + kbo(:, 4,33, 7) = (/ & + & 0.43055e-02_r8,0.10227e-01_r8,0.11270e-01_r8,0.10682e-01_r8,0.58516e-02_r8 /) + kbo(:, 5,33, 7) = (/ & + & 0.47651e-02_r8,0.11396e-01_r8,0.12524e-01_r8,0.11769e-01_r8,0.62091e-02_r8 /) + kbo(:, 1,34, 7) = (/ & + & 0.28105e-02_r8,0.66873e-02_r8,0.74405e-02_r8,0.71742e-02_r8,0.42413e-02_r8 /) + kbo(:, 2,34, 7) = (/ & + & 0.30819e-02_r8,0.74197e-02_r8,0.82328e-02_r8,0.78962e-02_r8,0.45189e-02_r8 /) + kbo(:, 3,34, 7) = (/ & + & 0.33974e-02_r8,0.82731e-02_r8,0.91582e-02_r8,0.87214e-02_r8,0.48133e-02_r8 /) + kbo(:, 4,34, 7) = (/ & + & 0.37682e-02_r8,0.92558e-02_r8,0.10225e-01_r8,0.96550e-02_r8,0.51300e-02_r8 /) + kbo(:, 5,34, 7) = (/ & + & 0.41836e-02_r8,0.10408e-01_r8,0.11429e-01_r8,0.10709e-01_r8,0.54671e-02_r8 /) + kbo(:, 1,35, 7) = (/ & + & 0.24038e-02_r8,0.58948e-02_r8,0.65709e-02_r8,0.63304e-02_r8,0.36544e-02_r8 /) + kbo(:, 2,35, 7) = (/ & + & 0.26483e-02_r8,0.65885e-02_r8,0.73295e-02_r8,0.70175e-02_r8,0.39080e-02_r8 /) + kbo(:, 3,35, 7) = (/ & + & 0.29372e-02_r8,0.74016e-02_r8,0.82197e-02_r8,0.78032e-02_r8,0.41855e-02_r8 /) + kbo(:, 4,35, 7) = (/ & + & 0.32728e-02_r8,0.83531e-02_r8,0.92365e-02_r8,0.86973e-02_r8,0.44777e-02_r8 /) + kbo(:, 5,35, 7) = (/ & + & 0.36421e-02_r8,0.94681e-02_r8,0.10387e-01_r8,0.97145e-02_r8,0.47967e-02_r8 /) + kbo(:, 1,36, 7) = (/ & + & 0.20373e-02_r8,0.51550e-02_r8,0.57662e-02_r8,0.55498e-02_r8,0.31231e-02_r8 /) + kbo(:, 2,36, 7) = (/ & + & 0.22554e-02_r8,0.58057e-02_r8,0.64818e-02_r8,0.61953e-02_r8,0.33549e-02_r8 /) + kbo(:, 3,36, 7) = (/ & + & 0.25127e-02_r8,0.65796e-02_r8,0.73228e-02_r8,0.69361e-02_r8,0.36112e-02_r8 /) + kbo(:, 4,36, 7) = (/ & + & 0.28104e-02_r8,0.74827e-02_r8,0.82833e-02_r8,0.77843e-02_r8,0.38823e-02_r8 /) + kbo(:, 5,36, 7) = (/ & + & 0.31359e-02_r8,0.85467e-02_r8,0.93763e-02_r8,0.87575e-02_r8,0.41812e-02_r8 /) + kbo(:, 1,37, 7) = (/ & + & 0.17035e-02_r8,0.44466e-02_r8,0.49856e-02_r8,0.47970e-02_r8,0.26734e-02_r8 /) + kbo(:, 2,37, 7) = (/ & + & 0.18934e-02_r8,0.50433e-02_r8,0.56462e-02_r8,0.53907e-02_r8,0.28873e-02_r8 /) + kbo(:, 3,37, 7) = (/ & + & 0.21171e-02_r8,0.57558e-02_r8,0.64223e-02_r8,0.60783e-02_r8,0.31233e-02_r8 /) + kbo(:, 4,37, 7) = (/ & + & 0.23767e-02_r8,0.65938e-02_r8,0.73141e-02_r8,0.68717e-02_r8,0.33760e-02_r8 /) + kbo(:, 5,37, 7) = (/ & + & 0.26616e-02_r8,0.75860e-02_r8,0.83359e-02_r8,0.77859e-02_r8,0.36530e-02_r8 /) + kbo(:, 1,38, 7) = (/ & + & 0.14234e-02_r8,0.38379e-02_r8,0.43139e-02_r8,0.41486e-02_r8,0.22904e-02_r8 /) + kbo(:, 2,38, 7) = (/ & + & 0.15875e-02_r8,0.43850e-02_r8,0.49236e-02_r8,0.46956e-02_r8,0.24873e-02_r8 /) + kbo(:, 3,38, 7) = (/ & + & 0.17824e-02_r8,0.50419e-02_r8,0.56400e-02_r8,0.53338e-02_r8,0.27024e-02_r8 /) + kbo(:, 4,38, 7) = (/ & + & 0.20080e-02_r8,0.58195e-02_r8,0.64682e-02_r8,0.60767e-02_r8,0.29386e-02_r8 /) + kbo(:, 5,38, 7) = (/ & + & 0.22567e-02_r8,0.67445e-02_r8,0.74253e-02_r8,0.69357e-02_r8,0.31979e-02_r8 /) + kbo(:, 1,39, 7) = (/ & + & 0.11890e-02_r8,0.33180e-02_r8,0.37396e-02_r8,0.35935e-02_r8,0.19623e-02_r8 /) + kbo(:, 2,39, 7) = (/ & + & 0.13309e-02_r8,0.38204e-02_r8,0.43017e-02_r8,0.40980e-02_r8,0.21427e-02_r8 /) + kbo(:, 3,39, 7) = (/ & + & 0.14997e-02_r8,0.44279e-02_r8,0.49653e-02_r8,0.46926e-02_r8,0.23415e-02_r8 /) + kbo(:, 4,39, 7) = (/ & + & 0.16956e-02_r8,0.51508e-02_r8,0.57361e-02_r8,0.53891e-02_r8,0.25595e-02_r8 /) + kbo(:, 5,39, 7) = (/ & + & 0.19128e-02_r8,0.60136e-02_r8,0.66353e-02_r8,0.61975e-02_r8,0.28034e-02_r8 /) + kbo(:, 1,40, 7) = (/ & + & 0.98185e-03_r8,0.28304e-02_r8,0.31989e-02_r8,0.30741e-02_r8,0.16759e-02_r8 /) + kbo(:, 2,40, 7) = (/ & + & 0.11018e-02_r8,0.32825e-02_r8,0.37073e-02_r8,0.35318e-02_r8,0.18412e-02_r8 /) + kbo(:, 3,40, 7) = (/ & + & 0.12459e-02_r8,0.38338e-02_r8,0.43125e-02_r8,0.40771e-02_r8,0.20230e-02_r8 /) + kbo(:, 4,40, 7) = (/ & + & 0.14138e-02_r8,0.44950e-02_r8,0.50204e-02_r8,0.47198e-02_r8,0.22264e-02_r8 /) + kbo(:, 5,40, 7) = (/ & + & 0.16015e-02_r8,0.52867e-02_r8,0.58524e-02_r8,0.54701e-02_r8,0.24538e-02_r8 /) + kbo(:, 1,41, 7) = (/ & + & 0.80888e-03_r8,0.24101e-02_r8,0.27302e-02_r8,0.26250e-02_r8,0.14285e-02_r8 /) + kbo(:, 2,41, 7) = (/ & + & 0.91042e-03_r8,0.28166e-02_r8,0.31895e-02_r8,0.30396e-02_r8,0.15812e-02_r8 /) + kbo(:, 3,41, 7) = (/ & + & 0.10323e-02_r8,0.33144e-02_r8,0.37392e-02_r8,0.35375e-02_r8,0.17482e-02_r8 /) + kbo(:, 4,41, 7) = (/ & + & 0.11757e-02_r8,0.39172e-02_r8,0.43885e-02_r8,0.41290e-02_r8,0.19366e-02_r8 /) + kbo(:, 5,41, 7) = (/ & + & 0.13368e-02_r8,0.46417e-02_r8,0.51571e-02_r8,0.48237e-02_r8,0.21455e-02_r8 /) + kbo(:, 1,42, 7) = (/ & + & 0.66584e-03_r8,0.20506e-02_r8,0.23294e-02_r8,0.22418e-02_r8,0.12147e-02_r8 /) + kbo(:, 2,42, 7) = (/ & + & 0.75117e-03_r8,0.24164e-02_r8,0.27427e-02_r8,0.26163e-02_r8,0.13552e-02_r8 /) + kbo(:, 3,42, 7) = (/ & + & 0.85464e-03_r8,0.28657e-02_r8,0.32419e-02_r8,0.30702e-02_r8,0.15103e-02_r8 /) + kbo(:, 4,42, 7) = (/ & + & 0.97690e-03_r8,0.34148e-02_r8,0.38374e-02_r8,0.36136e-02_r8,0.16836e-02_r8 /) + kbo(:, 5,42, 7) = (/ & + & 0.11154e-02_r8,0.40777e-02_r8,0.45486e-02_r8,0.42564e-02_r8,0.18765e-02_r8 /) + kbo(:, 1,43, 7) = (/ & + & 0.54468e-03_r8,0.17260e-02_r8,0.19662e-02_r8,0.18963e-02_r8,0.10278e-02_r8 /) + kbo(:, 2,43, 7) = (/ & + & 0.61495e-03_r8,0.20517e-02_r8,0.23339e-02_r8,0.22307e-02_r8,0.11544e-02_r8 /) + kbo(:, 3,43, 7) = (/ & + & 0.70090e-03_r8,0.24526e-02_r8,0.27821e-02_r8,0.26393e-02_r8,0.12972e-02_r8 /) + kbo(:, 4,43, 7) = (/ & + & 0.80460e-03_r8,0.29460e-02_r8,0.33228e-02_r8,0.31329e-02_r8,0.14583e-02_r8 /) + kbo(:, 5,43, 7) = (/ & + & 0.92296e-03_r8,0.35462e-02_r8,0.39738e-02_r8,0.37220e-02_r8,0.16369e-02_r8 /) + kbo(:, 1,44, 7) = (/ & + & 0.44364e-03_r8,0.14437e-02_r8,0.16496e-02_r8,0.15952e-02_r8,0.86540e-03_r8 /) + kbo(:, 2,44, 7) = (/ & + & 0.50199e-03_r8,0.17304e-02_r8,0.19739e-02_r8,0.18912e-02_r8,0.97937e-03_r8 /) + kbo(:, 3,44, 7) = (/ & + & 0.57242e-03_r8,0.20860e-02_r8,0.23731e-02_r8,0.22565e-02_r8,0.11106e-02_r8 /) + kbo(:, 4,44, 7) = (/ & + & 0.65930e-03_r8,0.25283e-02_r8,0.28613e-02_r8,0.27024e-02_r8,0.12573e-02_r8 /) + kbo(:, 5,44, 7) = (/ & + & 0.75974e-03_r8,0.30673e-02_r8,0.34531e-02_r8,0.32379e-02_r8,0.14238e-02_r8 /) + kbo(:, 1,45, 7) = (/ & + & 0.36129e-03_r8,0.12055e-02_r8,0.13811e-02_r8,0.13394e-02_r8,0.72668e-03_r8 /) + kbo(:, 2,45, 7) = (/ & + & 0.40925e-03_r8,0.14558e-02_r8,0.16660e-02_r8,0.16003e-02_r8,0.82937e-03_r8 /) + kbo(:, 3,45, 7) = (/ & + & 0.46755e-03_r8,0.17705e-02_r8,0.20201e-02_r8,0.19260e-02_r8,0.94755e-03_r8 /) + kbo(:, 4,45, 7) = (/ & + & 0.53937e-03_r8,0.21654e-02_r8,0.24593e-02_r8,0.23275e-02_r8,0.10822e-02_r8 /) + kbo(:, 5,45, 7) = (/ & + & 0.62400e-03_r8,0.26505e-02_r8,0.29965e-02_r8,0.28141e-02_r8,0.12345e-02_r8 /) + kbo(:, 1,46, 7) = (/ & + & 0.29308e-03_r8,0.99917e-03_r8,0.11483e-02_r8,0.11175e-02_r8,0.60699e-03_r8 /) + kbo(:, 2,46, 7) = (/ & + & 0.33256e-03_r8,0.12167e-02_r8,0.13963e-02_r8,0.13454e-02_r8,0.69810e-03_r8 /) + kbo(:, 3,46, 7) = (/ & + & 0.38031e-03_r8,0.14933e-02_r8,0.17091e-02_r8,0.16341e-02_r8,0.80431e-03_r8 /) + kbo(:, 4,46, 7) = (/ & + & 0.43974e-03_r8,0.18423e-02_r8,0.21003e-02_r8,0.19926e-02_r8,0.92607e-03_r8 /) + kbo(:, 5,46, 7) = (/ & + & 0.51042e-03_r8,0.22760e-02_r8,0.25842e-02_r8,0.24318e-02_r8,0.10656e-02_r8 /) + kbo(:, 1,47, 7) = (/ & + & 0.23621e-03_r8,0.81920e-03_r8,0.94415e-03_r8,0.92230e-03_r8,0.50239e-03_r8 /) + kbo(:, 2,47, 7) = (/ & + & 0.26847e-03_r8,0.10045e-02_r8,0.11560e-02_r8,0.11182e-02_r8,0.58268e-03_r8 /) + kbo(:, 3,47, 7) = (/ & + & 0.30727e-03_r8,0.12442e-02_r8,0.14284e-02_r8,0.13701e-02_r8,0.67654e-03_r8 /) + kbo(:, 4,47, 7) = (/ & + & 0.35565e-03_r8,0.15479e-02_r8,0.17727e-02_r8,0.16866e-02_r8,0.78602e-03_r8 /) + kbo(:, 5,47, 7) = (/ & + & 0.41455e-03_r8,0.19320e-02_r8,0.22031e-02_r8,0.20787e-02_r8,0.91297e-03_r8 /) + kbo(:, 1,48, 7) = (/ & + & 0.19056e-03_r8,0.66912e-03_r8,0.77329e-03_r8,0.75810e-03_r8,0.41434e-03_r8 /) + kbo(:, 2,48, 7) = (/ & + & 0.21662e-03_r8,0.82638e-03_r8,0.95404e-03_r8,0.92602e-03_r8,0.48448e-03_r8 /) + kbo(:, 3,48, 7) = (/ & + & 0.24805e-03_r8,0.10324e-02_r8,0.11883e-02_r8,0.11443e-02_r8,0.56714e-03_r8 /) + kbo(:, 4,48, 7) = (/ & + & 0.28732e-03_r8,0.12967e-02_r8,0.14909e-02_r8,0.14226e-02_r8,0.66465e-03_r8 /) + kbo(:, 5,48, 7) = (/ & + & 0.33598e-03_r8,0.16339e-02_r8,0.18720e-02_r8,0.17712e-02_r8,0.77925e-03_r8 /) + kbo(:, 1,49, 7) = (/ & + & 0.15370e-03_r8,0.54435e-03_r8,0.63072e-03_r8,0.62031e-03_r8,0.34039e-03_r8 /) + kbo(:, 2,49, 7) = (/ & + & 0.17493e-03_r8,0.67703e-03_r8,0.78385e-03_r8,0.76375e-03_r8,0.40110e-03_r8 /) + kbo(:, 3,49, 7) = (/ & + & 0.20006e-03_r8,0.85331e-03_r8,0.98454e-03_r8,0.95185e-03_r8,0.47334e-03_r8 /) + kbo(:, 4,49, 7) = (/ & + & 0.23184e-03_r8,0.10822e-02_r8,0.12482e-02_r8,0.11953e-02_r8,0.56021e-03_r8 /) + kbo(:, 5,49, 7) = (/ & + & 0.27201e-03_r8,0.13761e-02_r8,0.15848e-02_r8,0.15038e-02_r8,0.66336e-03_r8 /) + kbo(:, 1,50, 7) = (/ & + & 0.12445e-03_r8,0.44363e-03_r8,0.51558e-03_r8,0.50858e-03_r8,0.27983e-03_r8 /) + kbo(:, 2,50, 7) = (/ & + & 0.14173e-03_r8,0.55572e-03_r8,0.64516e-03_r8,0.63048e-03_r8,0.33240e-03_r8 /) + kbo(:, 3,50, 7) = (/ & + & 0.16225e-03_r8,0.70658e-03_r8,0.81789e-03_r8,0.79296e-03_r8,0.39601e-03_r8 /) + kbo(:, 4,50, 7) = (/ & + & 0.18768e-03_r8,0.90539e-03_r8,0.10468e-02_r8,0.10060e-02_r8,0.47285e-03_r8 /) + kbo(:, 5,50, 7) = (/ & + & 0.22071e-03_r8,0.11624e-02_r8,0.13446e-02_r8,0.12795e-02_r8,0.56523e-03_r8 /) + kbo(:, 1,51, 7) = (/ & + & 0.10079e-03_r8,0.36142e-03_r8,0.42089e-03_r8,0.41617e-03_r8,0.23042e-03_r8 /) + kbo(:, 2,51, 7) = (/ & + & 0.11508e-03_r8,0.45540e-03_r8,0.53023e-03_r8,0.51983e-03_r8,0.27489e-03_r8 /) + kbo(:, 3,51, 7) = (/ & + & 0.13183e-03_r8,0.58426e-03_r8,0.67873e-03_r8,0.65942e-03_r8,0.33073e-03_r8 /) + kbo(:, 4,51, 7) = (/ & + & 0.15243e-03_r8,0.75694e-03_r8,0.87652e-03_r8,0.84573e-03_r8,0.39869e-03_r8 /) + kbo(:, 5,51, 7) = (/ & + & 0.17921e-03_r8,0.98295e-03_r8,0.11402e-02_r8,0.10885e-02_r8,0.48140e-03_r8 /) + kbo(:, 1,52, 7) = (/ & + & 0.81556e-04_r8,0.29363e-03_r8,0.34244e-03_r8,0.33921e-03_r8,0.18905e-03_r8 /) + kbo(:, 2,52, 7) = (/ & + & 0.93358e-04_r8,0.37204e-03_r8,0.43415e-03_r8,0.42707e-03_r8,0.22730e-03_r8 /) + kbo(:, 3,52, 7) = (/ & + & 0.10711e-03_r8,0.48125e-03_r8,0.56095e-03_r8,0.54625e-03_r8,0.27517e-03_r8 /) + kbo(:, 4,52, 7) = (/ & + & 0.12382e-03_r8,0.62999e-03_r8,0.73195e-03_r8,0.70815e-03_r8,0.33506e-03_r8 /) + kbo(:, 5,52, 7) = (/ & + & 0.14564e-03_r8,0.82786e-03_r8,0.96258e-03_r8,0.92197e-03_r8,0.40847e-03_r8 /) + kbo(:, 1,53, 7) = (/ & + & 0.65849e-04_r8,0.23779e-03_r8,0.27734e-03_r8,0.27519e-03_r8,0.15433e-03_r8 /) + kbo(:, 2,53, 7) = (/ & + & 0.75546e-04_r8,0.30303e-03_r8,0.35410e-03_r8,0.34952e-03_r8,0.18741e-03_r8 /) + kbo(:, 3,53, 7) = (/ & + & 0.86880e-04_r8,0.39464e-03_r8,0.46133e-03_r8,0.45049e-03_r8,0.22844e-03_r8 /) + kbo(:, 4,53, 7) = (/ & + & 0.10061e-03_r8,0.52205e-03_r8,0.60866e-03_r8,0.59002e-03_r8,0.28045e-03_r8 /) + kbo(:, 5,53, 7) = (/ & + & 0.11837e-03_r8,0.69424e-03_r8,0.80911e-03_r8,0.77763e-03_r8,0.34549e-03_r8 /) + kbo(:, 1,54, 7) = (/ & + & 0.53194e-04_r8,0.19358e-03_r8,0.22554e-03_r8,0.22386e-03_r8,0.12634e-03_r8 /) + kbo(:, 2,54, 7) = (/ & + & 0.61356e-04_r8,0.24774e-03_r8,0.28991e-03_r8,0.28698e-03_r8,0.15485e-03_r8 /) + kbo(:, 3,54, 7) = (/ & + & 0.70732e-04_r8,0.32546e-03_r8,0.38104e-03_r8,0.37325e-03_r8,0.19067e-03_r8 /) + kbo(:, 4,54, 7) = (/ & + & 0.81989e-04_r8,0.43475e-03_r8,0.50842e-03_r8,0.49348e-03_r8,0.23573e-03_r8 /) + kbo(:, 5,54, 7) = (/ & + & 0.96606e-04_r8,0.58491e-03_r8,0.68358e-03_r8,0.65848e-03_r8,0.29331e-03_r8 /) + kbo(:, 1,55, 7) = (/ & + & 0.42968e-04_r8,0.15774e-03_r8,0.18351e-03_r8,0.18209e-03_r8,0.10325e-03_r8 /) + kbo(:, 2,55, 7) = (/ & + & 0.49757e-04_r8,0.20300e-03_r8,0.23752e-03_r8,0.23563e-03_r8,0.12786e-03_r8 /) + kbo(:, 3,55, 7) = (/ & + & 0.57602e-04_r8,0.26853e-03_r8,0.31476e-03_r8,0.30938e-03_r8,0.15908e-03_r8 /) + kbo(:, 4,55, 7) = (/ & + & 0.66944e-04_r8,0.36215e-03_r8,0.42458e-03_r8,0.41285e-03_r8,0.19867e-03_r8 /) + kbo(:, 5,55, 7) = (/ & + & 0.78909e-04_r8,0.49332e-03_r8,0.57794e-03_r8,0.55775e-03_r8,0.24929e-03_r8 /) + kbo(:, 1,56, 7) = (/ & + & 0.34572e-04_r8,0.12819e-03_r8,0.14868e-03_r8,0.14747e-03_r8,0.84103e-04_r8 /) + kbo(:, 2,56, 7) = (/ & + & 0.40234e-04_r8,0.16586e-03_r8,0.19409e-03_r8,0.19266e-03_r8,0.10511e-03_r8 /) + kbo(:, 3,56, 7) = (/ & + & 0.46756e-04_r8,0.22079e-03_r8,0.25905e-03_r8,0.25536e-03_r8,0.13228e-03_r8 /) + kbo(:, 4,56, 7) = (/ & + & 0.54583e-04_r8,0.30103e-03_r8,0.35315e-03_r8,0.34421e-03_r8,0.16708e-03_r8 /) + kbo(:, 5,56, 7) = (/ & + & 0.64414e-04_r8,0.41471e-03_r8,0.48701e-03_r8,0.47045e-03_r8,0.21139e-03_r8 /) + kbo(:, 1,57, 7) = (/ & + & 0.27768e-04_r8,0.10391e-03_r8,0.12029e-03_r8,0.11888e-03_r8,0.68178e-04_r8 /) + kbo(:, 2,57, 7) = (/ & + & 0.32463e-04_r8,0.13502e-03_r8,0.15785e-03_r8,0.15684e-03_r8,0.86073e-04_r8 /) + kbo(:, 3,57, 7) = (/ & + & 0.37880e-04_r8,0.18114e-03_r8,0.21255e-03_r8,0.20984e-03_r8,0.10949e-03_r8 /) + kbo(:, 4,57, 7) = (/ & + & 0.44374e-04_r8,0.24914e-03_r8,0.29262e-03_r8,0.28609e-03_r8,0.14004e-03_r8 /) + kbo(:, 5,57, 7) = (/ & + & 0.52560e-04_r8,0.34723e-03_r8,0.40853e-03_r8,0.39531e-03_r8,0.17907e-03_r8 /) + kbo(:, 1,58, 7) = (/ & + & 0.22293e-04_r8,0.84410e-04_r8,0.97318e-04_r8,0.95954e-04_r8,0.55246e-04_r8 /) + kbo(:, 2,58, 7) = (/ & + & 0.26200e-04_r8,0.11013e-03_r8,0.12878e-03_r8,0.12778e-03_r8,0.70434e-04_r8 /) + kbo(:, 3,58, 7) = (/ & + & 0.30694e-04_r8,0.14878e-03_r8,0.17475e-03_r8,0.17269e-03_r8,0.90681e-04_r8 /) + kbo(:, 4,58, 7) = (/ & + & 0.36071e-04_r8,0.20666e-03_r8,0.24284e-03_r8,0.23795e-03_r8,0.11731e-03_r8 /) + kbo(:, 5,58, 7) = (/ & + & 0.42845e-04_r8,0.29161e-03_r8,0.34322e-03_r8,0.33267e-03_r8,0.15208e-03_r8 /) + kbo(:, 1,59, 7) = (/ & + & 0.18430e-04_r8,0.71706e-04_r8,0.82601e-04_r8,0.81289e-04_r8,0.46584e-04_r8 /) + kbo(:, 2,59, 7) = (/ & + & 0.21734e-04_r8,0.94599e-04_r8,0.11060e-03_r8,0.10958e-03_r8,0.60168e-04_r8 /) + kbo(:, 3,59, 7) = (/ & + & 0.25561e-04_r8,0.12924e-03_r8,0.15196e-03_r8,0.15008e-03_r8,0.78430e-04_r8 /) + kbo(:, 4,59, 7) = (/ & + & 0.30185e-04_r8,0.18220e-03_r8,0.21420e-03_r8,0.20980e-03_r8,0.10280e-03_r8 /) + kbo(:, 5,59, 7) = (/ & + & 0.36067e-04_r8,0.26061e-03_r8,0.30710e-03_r8,0.29739e-03_r8,0.13531e-03_r8 /) + kbo(:, 1,13, 8) = (/ & + & 0.32299e+00_r8,0.54760e+00_r8,0.60079e+00_r8,0.58517e+00_r8,0.42276e+00_r8 /) + kbo(:, 2,13, 8) = (/ & + & 0.32594e+00_r8,0.55963e+00_r8,0.61653e+00_r8,0.60147e+00_r8,0.43281e+00_r8 /) + kbo(:, 3,13, 8) = (/ & + & 0.33056e+00_r8,0.57182e+00_r8,0.63236e+00_r8,0.61863e+00_r8,0.44149e+00_r8 /) + kbo(:, 4,13, 8) = (/ & + & 0.33706e+00_r8,0.58426e+00_r8,0.64822e+00_r8,0.63489e+00_r8,0.44893e+00_r8 /) + kbo(:, 5,13, 8) = (/ & + & 0.34635e+00_r8,0.59739e+00_r8,0.66343e+00_r8,0.65003e+00_r8,0.45486e+00_r8 /) + kbo(:, 1,14, 8) = (/ & + & 0.27185e+00_r8,0.47396e+00_r8,0.52087e+00_r8,0.50518e+00_r8,0.35898e+00_r8 /) + kbo(:, 2,14, 8) = (/ & + & 0.27455e+00_r8,0.48454e+00_r8,0.53473e+00_r8,0.52058e+00_r8,0.36725e+00_r8 /) + kbo(:, 3,14, 8) = (/ & + & 0.27878e+00_r8,0.49523e+00_r8,0.54876e+00_r8,0.53556e+00_r8,0.37477e+00_r8 /) + kbo(:, 4,14, 8) = (/ & + & 0.28540e+00_r8,0.50660e+00_r8,0.56244e+00_r8,0.54948e+00_r8,0.38095e+00_r8 /) + kbo(:, 5,14, 8) = (/ & + & 0.29474e+00_r8,0.51876e+00_r8,0.57592e+00_r8,0.56255e+00_r8,0.38660e+00_r8 /) + kbo(:, 1,15, 8) = (/ & + & 0.22818e+00_r8,0.40825e+00_r8,0.45003e+00_r8,0.43582e+00_r8,0.30350e+00_r8 /) + kbo(:, 2,15, 8) = (/ & + & 0.23074e+00_r8,0.41749e+00_r8,0.46220e+00_r8,0.44930e+00_r8,0.31064e+00_r8 /) + kbo(:, 3,15, 8) = (/ & + & 0.23510e+00_r8,0.42737e+00_r8,0.47434e+00_r8,0.46202e+00_r8,0.31696e+00_r8 /) + kbo(:, 4,15, 8) = (/ & + & 0.24186e+00_r8,0.43783e+00_r8,0.48637e+00_r8,0.47387e+00_r8,0.32265e+00_r8 /) + kbo(:, 5,15, 8) = (/ & + & 0.25121e+00_r8,0.44943e+00_r8,0.49855e+00_r8,0.48519e+00_r8,0.32816e+00_r8 /) + kbo(:, 1,16, 8) = (/ & + & 0.19120e+00_r8,0.34975e+00_r8,0.38732e+00_r8,0.37509e+00_r8,0.25617e+00_r8 /) + kbo(:, 2,16, 8) = (/ & + & 0.19385e+00_r8,0.35826e+00_r8,0.39799e+00_r8,0.38666e+00_r8,0.26259e+00_r8 /) + kbo(:, 3,16, 8) = (/ & + & 0.19846e+00_r8,0.36727e+00_r8,0.40872e+00_r8,0.39750e+00_r8,0.26815e+00_r8 /) + kbo(:, 4,16, 8) = (/ & + & 0.20537e+00_r8,0.37712e+00_r8,0.41954e+00_r8,0.40777e+00_r8,0.27330e+00_r8 /) + kbo(:, 5,16, 8) = (/ & + & 0.21427e+00_r8,0.38868e+00_r8,0.43071e+00_r8,0.41784e+00_r8,0.27853e+00_r8 /) + kbo(:, 1,17, 8) = (/ & + & 0.15988e+00_r8,0.29854e+00_r8,0.33180e+00_r8,0.32201e+00_r8,0.21611e+00_r8 /) + kbo(:, 2,17, 8) = (/ & + & 0.16279e+00_r8,0.30628e+00_r8,0.34129e+00_r8,0.33188e+00_r8,0.22162e+00_r8 /) + kbo(:, 3,17, 8) = (/ & + & 0.16763e+00_r8,0.31463e+00_r8,0.35085e+00_r8,0.34122e+00_r8,0.22664e+00_r8 /) + kbo(:, 4,17, 8) = (/ & + & 0.17444e+00_r8,0.32432e+00_r8,0.36068e+00_r8,0.35032e+00_r8,0.23161e+00_r8 /) + kbo(:, 5,17, 8) = (/ & + & 0.18274e+00_r8,0.33609e+00_r8,0.37140e+00_r8,0.35944e+00_r8,0.23665e+00_r8 /) + kbo(:, 1,18, 8) = (/ & + & 0.13352e+00_r8,0.25404e+00_r8,0.28330e+00_r8,0.27577e+00_r8,0.18225e+00_r8 /) + kbo(:, 2,18, 8) = (/ & + & 0.13667e+00_r8,0.26103e+00_r8,0.29171e+00_r8,0.28431e+00_r8,0.18712e+00_r8 /) + kbo(:, 3,18, 8) = (/ & + & 0.14164e+00_r8,0.26910e+00_r8,0.30030e+00_r8,0.29254e+00_r8,0.19176e+00_r8 /) + kbo(:, 4,18, 8) = (/ & + & 0.14809e+00_r8,0.27886e+00_r8,0.30959e+00_r8,0.30073e+00_r8,0.19637e+00_r8 /) + kbo(:, 5,18, 8) = (/ & + & 0.15551e+00_r8,0.29050e+00_r8,0.32020e+00_r8,0.30930e+00_r8,0.20115e+00_r8 /) + kbo(:, 1,19, 8) = (/ & + & 0.11177e+00_r8,0.21580e+00_r8,0.24136e+00_r8,0.23552e+00_r8,0.15392e+00_r8 /) + kbo(:, 2,19, 8) = (/ & + & 0.11504e+00_r8,0.22243e+00_r8,0.24890e+00_r8,0.24304e+00_r8,0.15833e+00_r8 /) + kbo(:, 3,19, 8) = (/ & + & 0.11975e+00_r8,0.23031e+00_r8,0.25687e+00_r8,0.25048e+00_r8,0.16244e+00_r8 /) + kbo(:, 4,19, 8) = (/ & + & 0.12553e+00_r8,0.23994e+00_r8,0.26588e+00_r8,0.25812e+00_r8,0.16671e+00_r8 /) + kbo(:, 5,19, 8) = (/ & + & 0.13204e+00_r8,0.25107e+00_r8,0.27639e+00_r8,0.26629e+00_r8,0.17110e+00_r8 /) + kbo(:, 1,20, 8) = (/ & + & 0.93818e-01_r8,0.18336e+00_r8,0.20533e+00_r8,0.20083e+00_r8,0.13063e+00_r8 /) + kbo(:, 2,20, 8) = (/ & + & 0.97153e-01_r8,0.18975e+00_r8,0.21222e+00_r8,0.20754e+00_r8,0.13445e+00_r8 /) + kbo(:, 3,20, 8) = (/ & + & 0.10157e+00_r8,0.19759e+00_r8,0.21989e+00_r8,0.21439e+00_r8,0.13819e+00_r8 /) + kbo(:, 4,20, 8) = (/ & + & 0.10656e+00_r8,0.20692e+00_r8,0.22885e+00_r8,0.22170e+00_r8,0.14200e+00_r8 /) + kbo(:, 5,20, 8) = (/ & + & 0.11217e+00_r8,0.21741e+00_r8,0.23914e+00_r8,0.22972e+00_r8,0.14595e+00_r8 /) + kbo(:, 1,21, 8) = (/ & + & 0.78864e-01_r8,0.15581e+00_r8,0.17467e+00_r8,0.17111e+00_r8,0.11093e+00_r8 /) + kbo(:, 2,21, 8) = (/ & + & 0.82115e-01_r8,0.16213e+00_r8,0.18114e+00_r8,0.17722e+00_r8,0.11448e+00_r8 /) + kbo(:, 3,21, 8) = (/ & + & 0.86091e-01_r8,0.16989e+00_r8,0.18858e+00_r8,0.18368e+00_r8,0.11795e+00_r8 /) + kbo(:, 4,21, 8) = (/ & + & 0.90544e-01_r8,0.17883e+00_r8,0.19740e+00_r8,0.19075e+00_r8,0.12140e+00_r8 /) + kbo(:, 5,21, 8) = (/ & + & 0.95531e-01_r8,0.18857e+00_r8,0.20719e+00_r8,0.19872e+00_r8,0.12494e+00_r8 /) + kbo(:, 1,22, 8) = (/ & + & 0.66536e-01_r8,0.13293e+00_r8,0.14913e+00_r8,0.14618e+00_r8,0.94429e-01_r8 /) + kbo(:, 2,22, 8) = (/ & + & 0.69639e-01_r8,0.13931e+00_r8,0.15537e+00_r8,0.15187e+00_r8,0.97680e-01_r8 /) + kbo(:, 3,22, 8) = (/ & + & 0.73194e-01_r8,0.14688e+00_r8,0.16282e+00_r8,0.15805e+00_r8,0.10087e+00_r8 /) + kbo(:, 4,22, 8) = (/ & + & 0.77205e-01_r8,0.15536e+00_r8,0.17135e+00_r8,0.16503e+00_r8,0.10414e+00_r8 /) + kbo(:, 5,22, 8) = (/ & + & 0.81667e-01_r8,0.16427e+00_r8,0.18066e+00_r8,0.17291e+00_r8,0.10744e+00_r8 /) + kbo(:, 1,23, 8) = (/ & + & 0.56261e-01_r8,0.11383e+00_r8,0.12760e+00_r8,0.12512e+00_r8,0.80559e-01_r8 /) + kbo(:, 2,23, 8) = (/ & + & 0.59086e-01_r8,0.12014e+00_r8,0.13384e+00_r8,0.13048e+00_r8,0.83485e-01_r8 /) + kbo(:, 3,23, 8) = (/ & + & 0.62281e-01_r8,0.12738e+00_r8,0.14121e+00_r8,0.13648e+00_r8,0.86460e-01_r8 /) + kbo(:, 4,23, 8) = (/ & + & 0.65906e-01_r8,0.13517e+00_r8,0.14937e+00_r8,0.14336e+00_r8,0.89462e-01_r8 /) + kbo(:, 5,23, 8) = (/ & + & 0.69998e-01_r8,0.14335e+00_r8,0.15807e+00_r8,0.15098e+00_r8,0.92588e-01_r8 /) + kbo(:, 1,24, 8) = (/ & + & 0.47642e-01_r8,0.97933e-01_r8,0.10963e+00_r8,0.10742e+00_r8,0.68750e-01_r8 /) + kbo(:, 2,24, 8) = (/ & + & 0.50193e-01_r8,0.10399e+00_r8,0.11587e+00_r8,0.11258e+00_r8,0.71432e-01_r8 /) + kbo(:, 3,24, 8) = (/ & + & 0.53085e-01_r8,0.11077e+00_r8,0.12298e+00_r8,0.11845e+00_r8,0.74194e-01_r8 /) + kbo(:, 4,24, 8) = (/ & + & 0.56384e-01_r8,0.11795e+00_r8,0.13070e+00_r8,0.12512e+00_r8,0.76973e-01_r8 /) + kbo(:, 5,24, 8) = (/ & + & 0.60174e-01_r8,0.12555e+00_r8,0.13879e+00_r8,0.13237e+00_r8,0.79920e-01_r8 /) + kbo(:, 1,25, 8) = (/ & + & 0.40432e-01_r8,0.84645e-01_r8,0.94724e-01_r8,0.92637e-01_r8,0.58805e-01_r8 /) + kbo(:, 2,25, 8) = (/ & + & 0.42748e-01_r8,0.90409e-01_r8,0.10079e+00_r8,0.97654e-01_r8,0.61289e-01_r8 /) + kbo(:, 3,25, 8) = (/ & + & 0.45392e-01_r8,0.96682e-01_r8,0.10756e+00_r8,0.10341e+00_r8,0.63818e-01_r8 /) + kbo(:, 4,25, 8) = (/ & + & 0.48438e-01_r8,0.10335e+00_r8,0.11478e+00_r8,0.10978e+00_r8,0.66481e-01_r8 /) + kbo(:, 5,25, 8) = (/ & + & 0.52019e-01_r8,0.11050e+00_r8,0.12234e+00_r8,0.11664e+00_r8,0.69209e-01_r8 /) + kbo(:, 1,26, 8) = (/ & + & 0.34430e-01_r8,0.73567e-01_r8,0.82349e-01_r8,0.80341e-01_r8,0.50485e-01_r8 /) + kbo(:, 2,26, 8) = (/ & + & 0.36558e-01_r8,0.78997e-01_r8,0.88163e-01_r8,0.85293e-01_r8,0.52835e-01_r8 /) + kbo(:, 3,26, 8) = (/ & + & 0.39009e-01_r8,0.84818e-01_r8,0.94521e-01_r8,0.90851e-01_r8,0.55181e-01_r8 /) + kbo(:, 4,26, 8) = (/ & + & 0.41876e-01_r8,0.91074e-01_r8,0.10127e+00_r8,0.96922e-01_r8,0.57644e-01_r8 /) + kbo(:, 5,26, 8) = (/ & + & 0.45294e-01_r8,0.97874e-01_r8,0.10841e+00_r8,0.10340e+00_r8,0.60258e-01_r8 /) + kbo(:, 1,27, 8) = (/ & + & 0.29418e-01_r8,0.64289e-01_r8,0.71984e-01_r8,0.70112e-01_r8,0.43514e-01_r8 /) + kbo(:, 2,27, 8) = (/ & + & 0.31367e-01_r8,0.69333e-01_r8,0.77500e-01_r8,0.74945e-01_r8,0.45654e-01_r8 /) + kbo(:, 3,27, 8) = (/ & + & 0.33650e-01_r8,0.74779e-01_r8,0.83451e-01_r8,0.80284e-01_r8,0.47838e-01_r8 /) + kbo(:, 4,27, 8) = (/ & + & 0.36373e-01_r8,0.80698e-01_r8,0.89803e-01_r8,0.86035e-01_r8,0.50188e-01_r8 /) + kbo(:, 5,27, 8) = (/ & + & 0.39625e-01_r8,0.87227e-01_r8,0.96605e-01_r8,0.92163e-01_r8,0.52661e-01_r8 /) + kbo(:, 1,28, 8) = (/ & + & 0.25206e-01_r8,0.56436e-01_r8,0.63282e-01_r8,0.61571e-01_r8,0.37602e-01_r8 /) + kbo(:, 2,28, 8) = (/ & + & 0.27009e-01_r8,0.61147e-01_r8,0.68481e-01_r8,0.66237e-01_r8,0.39562e-01_r8 /) + kbo(:, 3,28, 8) = (/ & + & 0.29150e-01_r8,0.66302e-01_r8,0.74074e-01_r8,0.71341e-01_r8,0.41601e-01_r8 /) + kbo(:, 4,28, 8) = (/ & + & 0.31750e-01_r8,0.71955e-01_r8,0.80104e-01_r8,0.76785e-01_r8,0.43794e-01_r8 /) + kbo(:, 5,28, 8) = (/ & + & 0.34834e-01_r8,0.78268e-01_r8,0.86662e-01_r8,0.82632e-01_r8,0.46193e-01_r8 /) + kbo(:, 1,29, 8) = (/ & + & 0.21672e-01_r8,0.49821e-01_r8,0.55985e-01_r8,0.54431e-01_r8,0.32677e-01_r8 /) + kbo(:, 2,29, 8) = (/ & + & 0.23360e-01_r8,0.54257e-01_r8,0.60871e-01_r8,0.58918e-01_r8,0.34453e-01_r8 /) + kbo(:, 3,29, 8) = (/ & + & 0.25420e-01_r8,0.59159e-01_r8,0.66168e-01_r8,0.63765e-01_r8,0.36398e-01_r8 /) + kbo(:, 4,29, 8) = (/ & + & 0.27908e-01_r8,0.64629e-01_r8,0.71935e-01_r8,0.68977e-01_r8,0.38490e-01_r8 /) + kbo(:, 5,29, 8) = (/ & + & 0.30843e-01_r8,0.70791e-01_r8,0.78323e-01_r8,0.74610e-01_r8,0.40747e-01_r8 /) + kbo(:, 1,30, 8) = (/ & + & 0.18703e-01_r8,0.44236e-01_r8,0.49819e-01_r8,0.48423e-01_r8,0.28503e-01_r8 /) + kbo(:, 2,30, 8) = (/ & + & 0.20315e-01_r8,0.48445e-01_r8,0.54425e-01_r8,0.52720e-01_r8,0.30174e-01_r8 /) + kbo(:, 3,30, 8) = (/ & + & 0.22307e-01_r8,0.53163e-01_r8,0.59481e-01_r8,0.57359e-01_r8,0.32018e-01_r8 /) + kbo(:, 4,30, 8) = (/ & + & 0.24687e-01_r8,0.58495e-01_r8,0.65064e-01_r8,0.62368e-01_r8,0.34022e-01_r8 /) + kbo(:, 5,30, 8) = (/ & + & 0.27510e-01_r8,0.64597e-01_r8,0.71352e-01_r8,0.67860e-01_r8,0.36243e-01_r8 /) + kbo(:, 1,31, 8) = (/ & + & 0.16227e-01_r8,0.39546e-01_r8,0.44613e-01_r8,0.43384e-01_r8,0.24947e-01_r8 /) + kbo(:, 2,31, 8) = (/ & + & 0.17791e-01_r8,0.43576e-01_r8,0.49010e-01_r8,0.47501e-01_r8,0.26577e-01_r8 /) + kbo(:, 3,31, 8) = (/ & + & 0.19720e-01_r8,0.48163e-01_r8,0.53877e-01_r8,0.51962e-01_r8,0.28347e-01_r8 /) + kbo(:, 4,31, 8) = (/ & + & 0.22010e-01_r8,0.53419e-01_r8,0.59368e-01_r8,0.56842e-01_r8,0.30326e-01_r8 /) + kbo(:, 5,31, 8) = (/ & + & 0.24778e-01_r8,0.59533e-01_r8,0.65582e-01_r8,0.62279e-01_r8,0.32464e-01_r8 /) + kbo(:, 1,32, 8) = (/ & + & 0.14168e-01_r8,0.35610e-01_r8,0.40228e-01_r8,0.39145e-01_r8,0.21998e-01_r8 /) + kbo(:, 2,32, 8) = (/ & + & 0.15701e-01_r8,0.39518e-01_r8,0.44455e-01_r8,0.43108e-01_r8,0.23551e-01_r8 /) + kbo(:, 3,32, 8) = (/ & + & 0.17568e-01_r8,0.44028e-01_r8,0.49228e-01_r8,0.47442e-01_r8,0.25303e-01_r8 /) + kbo(:, 4,32, 8) = (/ & + & 0.19822e-01_r8,0.49274e-01_r8,0.54644e-01_r8,0.52269e-01_r8,0.27219e-01_r8 /) + kbo(:, 5,32, 8) = (/ & + & 0.22492e-01_r8,0.55429e-01_r8,0.60878e-01_r8,0.57696e-01_r8,0.29289e-01_r8 /) + kbo(:, 1,33, 8) = (/ & + & 0.12469e-01_r8,0.32321e-01_r8,0.36548e-01_r8,0.35586e-01_r8,0.19535e-01_r8 /) + kbo(:, 2,33, 8) = (/ & + & 0.13967e-01_r8,0.36160e-01_r8,0.40670e-01_r8,0.39414e-01_r8,0.21057e-01_r8 /) + kbo(:, 3,33, 8) = (/ & + & 0.15804e-01_r8,0.40646e-01_r8,0.45371e-01_r8,0.43697e-01_r8,0.22748e-01_r8 /) + kbo(:, 4,33, 8) = (/ & + & 0.18007e-01_r8,0.45935e-01_r8,0.50790e-01_r8,0.48504e-01_r8,0.24589e-01_r8 /) + kbo(:, 5,33, 8) = (/ & + & 0.20583e-01_r8,0.52117e-01_r8,0.57083e-01_r8,0.53949e-01_r8,0.26612e-01_r8 /) + kbo(:, 1,34, 8) = (/ & + & 0.11030e-01_r8,0.29462e-01_r8,0.33333e-01_r8,0.32457e-01_r8,0.17441e-01_r8 /) + kbo(:, 2,34, 8) = (/ & + & 0.12485e-01_r8,0.33252e-01_r8,0.37374e-01_r8,0.36203e-01_r8,0.18902e-01_r8 /) + kbo(:, 3,34, 8) = (/ & + & 0.14284e-01_r8,0.37735e-01_r8,0.42039e-01_r8,0.40449e-01_r8,0.20533e-01_r8 /) + kbo(:, 4,34, 8) = (/ & + & 0.16406e-01_r8,0.43050e-01_r8,0.47473e-01_r8,0.45250e-01_r8,0.22315e-01_r8 /) + kbo(:, 5,34, 8) = (/ & + & 0.18889e-01_r8,0.49221e-01_r8,0.53838e-01_r8,0.50709e-01_r8,0.24295e-01_r8 /) + kbo(:, 1,35, 8) = (/ & + & 0.97045e-02_r8,0.26765e-01_r8,0.30294e-01_r8,0.29494e-01_r8,0.15527e-01_r8 /) + kbo(:, 2,35, 8) = (/ & + & 0.11116e-01_r8,0.30471e-01_r8,0.34237e-01_r8,0.33156e-01_r8,0.16936e-01_r8 /) + kbo(:, 3,35, 8) = (/ & + & 0.12833e-01_r8,0.34908e-01_r8,0.38827e-01_r8,0.37335e-01_r8,0.18494e-01_r8 /) + kbo(:, 4,35, 8) = (/ & + & 0.14851e-01_r8,0.40160e-01_r8,0.44228e-01_r8,0.42095e-01_r8,0.20230e-01_r8 /) + kbo(:, 5,35, 8) = (/ & + & 0.17220e-01_r8,0.46275e-01_r8,0.50600e-01_r8,0.47524e-01_r8,0.22137e-01_r8 /) + kbo(:, 1,36, 8) = (/ & + & 0.84787e-02_r8,0.24131e-01_r8,0.27339e-01_r8,0.26619e-01_r8,0.13756e-01_r8 /) + kbo(:, 2,36, 8) = (/ & + & 0.98033e-02_r8,0.27706e-01_r8,0.31147e-01_r8,0.30166e-01_r8,0.15106e-01_r8 /) + kbo(:, 3,36, 8) = (/ & + & 0.11407e-01_r8,0.32015e-01_r8,0.35610e-01_r8,0.34239e-01_r8,0.16593e-01_r8 /) + kbo(:, 4,36, 8) = (/ & + & 0.13302e-01_r8,0.37140e-01_r8,0.40907e-01_r8,0.38904e-01_r8,0.18257e-01_r8 /) + kbo(:, 5,36, 8) = (/ & + & 0.15537e-01_r8,0.43129e-01_r8,0.47182e-01_r8,0.44236e-01_r8,0.20074e-01_r8 /) + kbo(:, 1,37, 8) = (/ & + & 0.72685e-02_r8,0.21392e-01_r8,0.24301e-01_r8,0.23679e-01_r8,0.12087e-01_r8 /) + kbo(:, 2,37, 8) = (/ & + & 0.84733e-02_r8,0.24759e-01_r8,0.27898e-01_r8,0.27046e-01_r8,0.13342e-01_r8 /) + kbo(:, 3,37, 8) = (/ & + & 0.99353e-02_r8,0.28848e-01_r8,0.32152e-01_r8,0.30940e-01_r8,0.14748e-01_r8 /) + kbo(:, 4,37, 8) = (/ & + & 0.11673e-01_r8,0.33734e-01_r8,0.37224e-01_r8,0.35422e-01_r8,0.16319e-01_r8 /) + kbo(:, 5,37, 8) = (/ & + & 0.13740e-01_r8,0.39481e-01_r8,0.43256e-01_r8,0.40566e-01_r8,0.18049e-01_r8 /) + kbo(:, 1,38, 8) = (/ & + & 0.62326e-02_r8,0.18999e-01_r8,0.21644e-01_r8,0.21103e-01_r8,0.10629e-01_r8 /) + kbo(:, 2,38, 8) = (/ & + & 0.73269e-02_r8,0.22170e-01_r8,0.25042e-01_r8,0.24299e-01_r8,0.11807e-01_r8 /) + kbo(:, 3,38, 8) = (/ & + & 0.86586e-02_r8,0.26045e-01_r8,0.29098e-01_r8,0.28019e-01_r8,0.13138e-01_r8 /) + kbo(:, 4,38, 8) = (/ & + & 0.10254e-01_r8,0.30699e-01_r8,0.33952e-01_r8,0.32316e-01_r8,0.14621e-01_r8 /) + kbo(:, 5,38, 8) = (/ & + & 0.12168e-01_r8,0.36211e-01_r8,0.39748e-01_r8,0.37288e-01_r8,0.16263e-01_r8 /) + kbo(:, 1,39, 8) = (/ & + & 0.53522e-02_r8,0.16925e-01_r8,0.19337e-01_r8,0.18863e-01_r8,0.93697e-02_r8 /) + kbo(:, 2,39, 8) = (/ & + & 0.63437e-02_r8,0.19916e-01_r8,0.22555e-01_r8,0.21900e-01_r8,0.10477e-01_r8 /) + kbo(:, 3,39, 8) = (/ & + & 0.75600e-02_r8,0.23590e-01_r8,0.26428e-01_r8,0.25453e-01_r8,0.11732e-01_r8 /) + kbo(:, 4,39, 8) = (/ & + & 0.90277e-02_r8,0.28027e-01_r8,0.31081e-01_r8,0.29581e-01_r8,0.13140e-01_r8 /) + kbo(:, 5,39, 8) = (/ & + & 0.10804e-01_r8,0.33325e-01_r8,0.36655e-01_r8,0.34396e-01_r8,0.14714e-01_r8 /) + kbo(:, 1,40, 8) = (/ & + & 0.45183e-02_r8,0.14862e-01_r8,0.17043e-01_r8,0.16640e-01_r8,0.81906e-02_r8 /) + kbo(:, 2,40, 8) = (/ & + & 0.53964e-02_r8,0.17630e-01_r8,0.20043e-01_r8,0.19482e-01_r8,0.92335e-02_r8 /) + kbo(:, 3,40, 8) = (/ & + & 0.64835e-02_r8,0.21041e-01_r8,0.23674e-01_r8,0.22821e-01_r8,0.10400e-01_r8 /) + kbo(:, 4,40, 8) = (/ & + & 0.78100e-02_r8,0.25197e-01_r8,0.28056e-01_r8,0.26733e-01_r8,0.11718e-01_r8 /) + kbo(:, 5,40, 8) = (/ & + & 0.94310e-02_r8,0.30203e-01_r8,0.33322e-01_r8,0.31321e-01_r8,0.13209e-01_r8 /) + kbo(:, 1,41, 8) = (/ & + & 0.38020e-02_r8,0.13035e-01_r8,0.15007e-01_r8,0.14665e-01_r8,0.71645e-02_r8 /) + kbo(:, 2,41, 8) = (/ & + & 0.45796e-02_r8,0.15592e-01_r8,0.17802e-01_r8,0.17320e-01_r8,0.81332e-02_r8 /) + kbo(:, 3,41, 8) = (/ & + & 0.55464e-02_r8,0.18749e-01_r8,0.21191e-01_r8,0.20448e-01_r8,0.92312e-02_r8 /) + kbo(:, 4,41, 8) = (/ & + & 0.67408e-02_r8,0.22629e-01_r8,0.25309e-01_r8,0.24143e-01_r8,0.10458e-01_r8 /) + kbo(:, 5,41, 8) = (/ & + & 0.82155e-02_r8,0.27347e-01_r8,0.30277e-01_r8,0.28506e-01_r8,0.11871e-01_r8 /) + kbo(:, 1,42, 8) = (/ & + & 0.31962e-02_r8,0.11444e-01_r8,0.13229e-01_r8,0.12937e-01_r8,0.62788e-02_r8 /) + kbo(:, 2,42, 8) = (/ & + & 0.38815e-02_r8,0.13798e-01_r8,0.15822e-01_r8,0.15407e-01_r8,0.71774e-02_r8 /) + kbo(:, 3,42, 8) = (/ & + & 0.47422e-02_r8,0.16722e-01_r8,0.18990e-01_r8,0.18339e-01_r8,0.81986e-02_r8 /) + kbo(:, 4,42, 8) = (/ & + & 0.58154e-02_r8,0.20342e-01_r8,0.22857e-01_r8,0.21830e-01_r8,0.93594e-02_r8 /) + kbo(:, 5,42, 8) = (/ & + & 0.71546e-02_r8,0.24787e-01_r8,0.27545e-01_r8,0.25973e-01_r8,0.10684e-01_r8 /) + kbo(:, 1,43, 8) = (/ & + & 0.26542e-02_r8,0.99421e-02_r8,0.11545e-01_r8,0.11297e-01_r8,0.54681e-02_r8 /) + kbo(:, 2,43, 8) = (/ & + & 0.32467e-02_r8,0.12085e-01_r8,0.13926e-01_r8,0.13575e-01_r8,0.63017e-02_r8 /) + kbo(:, 3,43, 8) = (/ & + & 0.40037e-02_r8,0.14758e-01_r8,0.16848e-01_r8,0.16296e-01_r8,0.72434e-02_r8 /) + kbo(:, 4,43, 8) = (/ & + & 0.49534e-02_r8,0.18094e-01_r8,0.20438e-01_r8,0.19556e-01_r8,0.83354e-02_r8 /) + kbo(:, 5,43, 8) = (/ & + & 0.61525e-02_r8,0.22230e-01_r8,0.24817e-01_r8,0.23450e-01_r8,0.95751e-02_r8 /) + kbo(:, 1,44, 8) = (/ & + & 0.21881e-02_r8,0.85857e-02_r8,0.10019e-01_r8,0.98043e-02_r8,0.47456e-02_r8 /) + kbo(:, 2,44, 8) = (/ & + & 0.26937e-02_r8,0.10525e-01_r8,0.12192e-01_r8,0.11898e-01_r8,0.55168e-02_r8 /) + kbo(:, 3,44, 8) = (/ & + & 0.33531e-02_r8,0.12952e-01_r8,0.14870e-01_r8,0.14408e-01_r8,0.63938e-02_r8 /) + kbo(:, 4,44, 8) = (/ & + & 0.41916e-02_r8,0.16016e-01_r8,0.18187e-01_r8,0.17441e-01_r8,0.73995e-02_r8 /) + kbo(:, 5,44, 8) = (/ & + & 0.52529e-02_r8,0.19825e-01_r8,0.22245e-01_r8,0.21074e-01_r8,0.85693e-02_r8 /) + kbo(:, 1,45, 8) = (/ & + & 0.17974e-02_r8,0.74036e-02_r8,0.86819e-02_r8,0.84949e-02_r8,0.41100e-02_r8 /) + kbo(:, 2,45, 8) = (/ & + & 0.22283e-02_r8,0.91556e-02_r8,0.10664e-01_r8,0.10414e-01_r8,0.48257e-02_r8 /) + kbo(:, 3,45, 8) = (/ & + & 0.27993e-02_r8,0.11360e-01_r8,0.13115e-01_r8,0.12731e-01_r8,0.56423e-02_r8 /) + kbo(:, 4,45, 8) = (/ & + & 0.35358e-02_r8,0.14164e-01_r8,0.16170e-01_r8,0.15543e-01_r8,0.65867e-02_r8 /) + kbo(:, 5,45, 8) = (/ & + & 0.44762e-02_r8,0.17671e-01_r8,0.19928e-01_r8,0.18931e-01_r8,0.76725e-02_r8 /) + kbo(:, 1,46, 8) = (/ & + & 0.14666e-02_r8,0.63443e-02_r8,0.74710e-02_r8,0.73099e-02_r8,0.35540e-02_r8 /) + kbo(:, 2,46, 8) = (/ & + & 0.18286e-02_r8,0.79140e-02_r8,0.92719e-02_r8,0.90588e-02_r8,0.41981e-02_r8 /) + kbo(:, 3,46, 8) = (/ & + & 0.23196e-02_r8,0.99089e-02_r8,0.11508e-01_r8,0.11192e-01_r8,0.49656e-02_r8 /) + kbo(:, 4,46, 8) = (/ & + & 0.29575e-02_r8,0.12451e-01_r8,0.14296e-01_r8,0.13779e-01_r8,0.58441e-02_r8 /) + kbo(:, 5,46, 8) = (/ & + & 0.37842e-02_r8,0.15662e-01_r8,0.17758e-01_r8,0.16921e-01_r8,0.68660e-02_r8 /) + kbo(:, 1,47, 8) = (/ & + & 0.11822e-02_r8,0.53700e-02_r8,0.63483e-02_r8,0.62090e-02_r8,0.30500e-02_r8 /) + kbo(:, 2,47, 8) = (/ & + & 0.14817e-02_r8,0.67616e-02_r8,0.79678e-02_r8,0.77874e-02_r8,0.36317e-02_r8 /) + kbo(:, 3,47, 8) = (/ & + & 0.18918e-02_r8,0.85392e-02_r8,0.99818e-02_r8,0.97254e-02_r8,0.43248e-02_r8 /) + kbo(:, 4,47, 8) = (/ & + & 0.24382e-02_r8,0.10820e-01_r8,0.12503e-01_r8,0.12088e-01_r8,0.51477e-02_r8 /) + kbo(:, 5,47, 8) = (/ & + & 0.31533e-02_r8,0.13725e-01_r8,0.15656e-01_r8,0.14970e-01_r8,0.61000e-02_r8 /) + kbo(:, 1,48, 8) = (/ & + & 0.94906e-03_r8,0.45298e-02_r8,0.53706e-02_r8,0.52506e-02_r8,0.26162e-02_r8 /) + kbo(:, 2,48, 8) = (/ & + & 0.11965e-02_r8,0.57597e-02_r8,0.68213e-02_r8,0.66698e-02_r8,0.31403e-02_r8 /) + kbo(:, 3,48, 8) = (/ & + & 0.15369e-02_r8,0.73380e-02_r8,0.86368e-02_r8,0.84246e-02_r8,0.37687e-02_r8 /) + kbo(:, 4,48, 8) = (/ & + & 0.20008e-02_r8,0.93814e-02_r8,0.10911e-01_r8,0.10580e-01_r8,0.45213e-02_r8 /) + kbo(:, 5,48, 8) = (/ & + & 0.26159e-02_r8,0.12002e-01_r8,0.13774e-01_r8,0.13221e-01_r8,0.54142e-02_r8 /) + kbo(:, 1,49, 8) = (/ & + & 0.75913e-03_r8,0.38043e-02_r8,0.45203e-02_r8,0.44181e-02_r8,0.22379e-02_r8 /) + kbo(:, 2,49, 8) = (/ & + & 0.96097e-03_r8,0.48899e-02_r8,0.58138e-02_r8,0.56878e-02_r8,0.27098e-02_r8 /) + kbo(:, 3,49, 8) = (/ & + & 0.12447e-02_r8,0.62895e-02_r8,0.74501e-02_r8,0.72727e-02_r8,0.32859e-02_r8 /) + kbo(:, 4,49, 8) = (/ & + & 0.16322e-02_r8,0.81122e-02_r8,0.94989e-02_r8,0.92349e-02_r8,0.39720e-02_r8 /) + kbo(:, 5,49, 8) = (/ & + & 0.21597e-02_r8,0.10470e-01_r8,0.12092e-01_r8,0.11650e-01_r8,0.47938e-02_r8 /) + kbo(:, 1,50, 8) = (/ & + & 0.60949e-03_r8,0.32009e-02_r8,0.38080e-02_r8,0.37204e-02_r8,0.19148e-02_r8 /) + kbo(:, 2,50, 8) = (/ & + & 0.77332e-03_r8,0.41637e-02_r8,0.49658e-02_r8,0.48588e-02_r8,0.23498e-02_r8 /) + kbo(:, 3,50, 8) = (/ & + & 0.10099e-02_r8,0.54095e-02_r8,0.64416e-02_r8,0.62938e-02_r8,0.28713e-02_r8 /) + kbo(:, 4,50, 8) = (/ & + & 0.13353e-02_r8,0.70417e-02_r8,0.83004e-02_r8,0.80844e-02_r8,0.35114e-02_r8 /) + kbo(:, 5,50, 8) = (/ & + & 0.17873e-02_r8,0.91691e-02_r8,0.10658e-01_r8,0.10303e-01_r8,0.42641e-02_r8 /) + kbo(:, 1,51, 8) = (/ & + & 0.48960e-03_r8,0.26873e-02_r8,0.32008e-02_r8,0.31259e-02_r8,0.16378e-02_r8 /) + kbo(:, 2,51, 8) = (/ & + & 0.62187e-03_r8,0.35423e-02_r8,0.42349e-02_r8,0.41443e-02_r8,0.20325e-02_r8 /) + kbo(:, 3,51, 8) = (/ & + & 0.81788e-03_r8,0.46529e-02_r8,0.55656e-02_r8,0.54424e-02_r8,0.25164e-02_r8 /) + kbo(:, 4,51, 8) = (/ & + & 0.10935e-02_r8,0.61155e-02_r8,0.72565e-02_r8,0.70765e-02_r8,0.31007e-02_r8 /) + kbo(:, 5,51, 8) = (/ & + & 0.14776e-02_r8,0.80416e-02_r8,0.94087e-02_r8,0.91197e-02_r8,0.38085e-02_r8 /) + kbo(:, 1,52, 8) = (/ & + & 0.39302e-03_r8,0.22435e-02_r8,0.26754e-02_r8,0.26122e-02_r8,0.13898e-02_r8 /) + kbo(:, 2,52, 8) = (/ & + & 0.49889e-03_r8,0.30006e-02_r8,0.35943e-02_r8,0.35172e-02_r8,0.17532e-02_r8 /) + kbo(:, 3,52, 8) = (/ & + & 0.65922e-03_r8,0.39906e-02_r8,0.47901e-02_r8,0.46880e-02_r8,0.21980e-02_r8 /) + kbo(:, 4,52, 8) = (/ & + & 0.89075e-03_r8,0.52980e-02_r8,0.63237e-02_r8,0.61748e-02_r8,0.27412e-02_r8 /) + kbo(:, 5,52, 8) = (/ & + & 0.12150e-02_r8,0.70312e-02_r8,0.82837e-02_r8,0.80497e-02_r8,0.33956e-02_r8 /) + kbo(:, 1,53, 8) = (/ & + & 0.31533e-03_r8,0.18598e-02_r8,0.22216e-02_r8,0.21690e-02_r8,0.11705e-02_r8 /) + kbo(:, 2,53, 8) = (/ & + & 0.39919e-03_r8,0.25290e-02_r8,0.30338e-02_r8,0.29679e-02_r8,0.15051e-02_r8 /) + kbo(:, 3,53, 8) = (/ & + & 0.52958e-03_r8,0.34096e-02_r8,0.41030e-02_r8,0.40189e-02_r8,0.19137e-02_r8 /) + kbo(:, 4,53, 8) = (/ & + & 0.72147e-03_r8,0.45756e-02_r8,0.54894e-02_r8,0.53678e-02_r8,0.24147e-02_r8 /) + kbo(:, 5,53, 8) = (/ & + & 0.99563e-03_r8,0.61321e-02_r8,0.72739e-02_r8,0.70826e-02_r8,0.30286e-02_r8 /) + kbo(:, 1,54, 8) = (/ & + & 0.25434e-03_r8,0.15477e-02_r8,0.18502e-02_r8,0.18075e-02_r8,0.98891e-03_r8 /) + kbo(:, 2,54, 8) = (/ & + & 0.32221e-03_r8,0.21398e-02_r8,0.25708e-02_r8,0.25148e-02_r8,0.12935e-02_r8 /) + kbo(:, 3,54, 8) = (/ & + & 0.42775e-03_r8,0.29272e-02_r8,0.35315e-02_r8,0.34599e-02_r8,0.16741e-02_r8 /) + kbo(:, 4,54, 8) = (/ & + & 0.58762e-03_r8,0.39761e-02_r8,0.47907e-02_r8,0.46896e-02_r8,0.21376e-02_r8 /) + kbo(:, 5,54, 8) = (/ & + & 0.82053e-03_r8,0.53824e-02_r8,0.64244e-02_r8,0.62664e-02_r8,0.27173e-02_r8 /) + kbo(:, 1,55, 8) = (/ & + & 0.20618e-03_r8,0.12866e-02_r8,0.15400e-02_r8,0.15055e-02_r8,0.83572e-03_r8 /) + kbo(:, 2,55, 8) = (/ & + & 0.26059e-03_r8,0.18094e-02_r8,0.21787e-02_r8,0.21302e-02_r8,0.11090e-02_r8 /) + kbo(:, 3,55, 8) = (/ & + & 0.34651e-03_r8,0.25140e-02_r8,0.30392e-02_r8,0.29780e-02_r8,0.14628e-02_r8 /) + kbo(:, 4,55, 8) = (/ & + & 0.47882e-03_r8,0.34608e-02_r8,0.41831e-02_r8,0.41003e-02_r8,0.18992e-02_r8 /) + kbo(:, 5,55, 8) = (/ & + & 0.67671e-03_r8,0.47331e-02_r8,0.56817e-02_r8,0.55503e-02_r8,0.24360e-02_r8 /) + kbo(:, 1,56, 8) = (/ & + & 0.16681e-03_r8,0.10621e-02_r8,0.12728e-02_r8,0.12461e-02_r8,0.70162e-03_r8 /) + kbo(:, 2,56, 8) = (/ & + & 0.21064e-03_r8,0.15213e-02_r8,0.18350e-02_r8,0.17945e-02_r8,0.94828e-03_r8 /) + kbo(:, 3,56, 8) = (/ & + & 0.28028e-03_r8,0.21500e-02_r8,0.26045e-02_r8,0.25521e-02_r8,0.12721e-02_r8 /) + kbo(:, 4,56, 8) = (/ & + & 0.38906e-03_r8,0.30029e-02_r8,0.36387e-02_r8,0.35710e-02_r8,0.16833e-02_r8 /) + kbo(:, 5,56, 8) = (/ & + & 0.55568e-03_r8,0.41534e-02_r8,0.50111e-02_r8,0.49027e-02_r8,0.21849e-02_r8 /) + kbo(:, 1,57, 8) = (/ & + & 0.13484e-03_r8,0.87168e-03_r8,0.10444e-02_r8,0.10248e-02_r8,0.58516e-03_r8 /) + kbo(:, 2,57, 8) = (/ & + & 0.17007e-03_r8,0.12717e-02_r8,0.15360e-02_r8,0.15024e-02_r8,0.80805e-03_r8 /) + kbo(:, 3,57, 8) = (/ & + & 0.22603e-03_r8,0.18296e-02_r8,0.22211e-02_r8,0.21757e-02_r8,0.11006e-02_r8 /) + kbo(:, 4,57, 8) = (/ & + & 0.31565e-03_r8,0.25963e-02_r8,0.31531e-02_r8,0.30959e-02_r8,0.14851e-02_r8 /) + kbo(:, 5,57, 8) = (/ & + & 0.45417e-03_r8,0.36365e-02_r8,0.44058e-02_r8,0.43157e-02_r8,0.19625e-02_r8 /) + kbo(:, 1,58, 8) = (/ & + & 0.10938e-03_r8,0.71449e-03_r8,0.85655e-03_r8,0.84240e-03_r8,0.48772e-03_r8 /) + kbo(:, 2,58, 8) = (/ & + & 0.13752e-03_r8,0.10624e-02_r8,0.12849e-02_r8,0.12583e-02_r8,0.68689e-03_r8 /) + kbo(:, 3,58, 8) = (/ & + & 0.18307e-03_r8,0.15572e-02_r8,0.18954e-02_r8,0.18566e-02_r8,0.95344e-03_r8 /) + kbo(:, 4,58, 8) = (/ & + & 0.25673e-03_r8,0.22481e-02_r8,0.27363e-02_r8,0.26877e-02_r8,0.13079e-02_r8 /) + kbo(:, 5,58, 8) = (/ & + & 0.37230e-03_r8,0.31921e-02_r8,0.38812e-02_r8,0.38070e-02_r8,0.17570e-02_r8 /) + kbo(:, 1,59, 8) = (/ & + & 0.92153e-04_r8,0.62798e-03_r8,0.75374e-03_r8,0.74243e-03_r8,0.43161e-03_r8 /) + kbo(:, 2,59, 8) = (/ & + & 0.11676e-03_r8,0.95019e-03_r8,0.11525e-02_r8,0.11296e-02_r8,0.61959e-03_r8 /) + kbo(:, 3,59, 8) = (/ & + & 0.15687e-03_r8,0.14168e-02_r8,0.17285e-02_r8,0.16938e-02_r8,0.87468e-03_r8 /) + kbo(:, 4,59, 8) = (/ & + & 0.22278e-03_r8,0.20743e-02_r8,0.25302e-02_r8,0.24863e-02_r8,0.12161e-02_r8 /) + kbo(:, 5,59, 8) = (/ & + & 0.32724e-03_r8,0.29797e-02_r8,0.36313e-02_r8,0.35664e-02_r8,0.16577e-02_r8 /) + kbo(:, 1,13, 9) = (/ & + & 0.16403e+01_r8,0.27290e+01_r8,0.31326e+01_r8,0.31890e+01_r8,0.23307e+01_r8 /) + kbo(:, 2,13, 9) = (/ & + & 0.16862e+01_r8,0.27611e+01_r8,0.31617e+01_r8,0.32226e+01_r8,0.23816e+01_r8 /) + kbo(:, 3,13, 9) = (/ & + & 0.17455e+01_r8,0.28101e+01_r8,0.32005e+01_r8,0.32552e+01_r8,0.24291e+01_r8 /) + kbo(:, 4,13, 9) = (/ & + & 0.18100e+01_r8,0.28758e+01_r8,0.32471e+01_r8,0.32901e+01_r8,0.24729e+01_r8 /) + kbo(:, 5,13, 9) = (/ & + & 0.18736e+01_r8,0.29528e+01_r8,0.33027e+01_r8,0.33291e+01_r8,0.25126e+01_r8 /) + kbo(:, 1,14, 9) = (/ & + & 0.14276e+01_r8,0.24116e+01_r8,0.27645e+01_r8,0.28207e+01_r8,0.20786e+01_r8 /) + kbo(:, 2,14, 9) = (/ & + & 0.14761e+01_r8,0.24553e+01_r8,0.28027e+01_r8,0.28564e+01_r8,0.21275e+01_r8 /) + kbo(:, 3,14, 9) = (/ & + & 0.15303e+01_r8,0.25161e+01_r8,0.28501e+01_r8,0.28940e+01_r8,0.21750e+01_r8 /) + kbo(:, 4,14, 9) = (/ & + & 0.15845e+01_r8,0.25879e+01_r8,0.29061e+01_r8,0.29354e+01_r8,0.22167e+01_r8 /) + kbo(:, 5,14, 9) = (/ & + & 0.16378e+01_r8,0.26632e+01_r8,0.29707e+01_r8,0.29827e+01_r8,0.22552e+01_r8 /) + kbo(:, 1,15, 9) = (/ & + & 0.12454e+01_r8,0.21329e+01_r8,0.24382e+01_r8,0.24839e+01_r8,0.18332e+01_r8 /) + kbo(:, 2,15, 9) = (/ & + & 0.12895e+01_r8,0.21869e+01_r8,0.24841e+01_r8,0.25234e+01_r8,0.18816e+01_r8 /) + kbo(:, 3,15, 9) = (/ & + & 0.13344e+01_r8,0.22528e+01_r8,0.25385e+01_r8,0.25663e+01_r8,0.19251e+01_r8 /) + kbo(:, 4,15, 9) = (/ & + & 0.13794e+01_r8,0.23234e+01_r8,0.26021e+01_r8,0.26153e+01_r8,0.19652e+01_r8 /) + kbo(:, 5,15, 9) = (/ & + & 0.14250e+01_r8,0.23931e+01_r8,0.26727e+01_r8,0.26688e+01_r8,0.20043e+01_r8 /) + kbo(:, 1,16, 9) = (/ & + & 0.10848e+01_r8,0.18880e+01_r8,0.21511e+01_r8,0.21813e+01_r8,0.16071e+01_r8 /) + kbo(:, 2,16, 9) = (/ & + & 0.11214e+01_r8,0.19471e+01_r8,0.22027e+01_r8,0.22246e+01_r8,0.16520e+01_r8 /) + kbo(:, 3,16, 9) = (/ & + & 0.11587e+01_r8,0.20122e+01_r8,0.22636e+01_r8,0.22737e+01_r8,0.16924e+01_r8 /) + kbo(:, 4,16, 9) = (/ & + & 0.11968e+01_r8,0.20768e+01_r8,0.23313e+01_r8,0.23282e+01_r8,0.17327e+01_r8 /) + kbo(:, 5,16, 9) = (/ & + & 0.12369e+01_r8,0.21393e+01_r8,0.24028e+01_r8,0.23861e+01_r8,0.17713e+01_r8 /) + kbo(:, 1,17, 9) = (/ & + & 0.94054e+00_r8,0.16727e+01_r8,0.18972e+01_r8,0.19128e+01_r8,0.14046e+01_r8 /) + kbo(:, 2,17, 9) = (/ & + & 0.97101e+00_r8,0.17314e+01_r8,0.19542e+01_r8,0.19610e+01_r8,0.14464e+01_r8 /) + kbo(:, 3,17, 9) = (/ & + & 0.10024e+01_r8,0.17905e+01_r8,0.20183e+01_r8,0.20147e+01_r8,0.14867e+01_r8 /) + kbo(:, 4,17, 9) = (/ & + & 0.10357e+01_r8,0.18485e+01_r8,0.20868e+01_r8,0.20722e+01_r8,0.15247e+01_r8 /) + kbo(:, 5,17, 9) = (/ & + & 0.10722e+01_r8,0.19059e+01_r8,0.21551e+01_r8,0.21344e+01_r8,0.15620e+01_r8 /) + kbo(:, 1,18, 9) = (/ & + & 0.81293e+00_r8,0.14815e+01_r8,0.16736e+01_r8,0.16776e+01_r8,0.12272e+01_r8 /) + kbo(:, 2,18, 9) = (/ & + & 0.83847e+00_r8,0.15352e+01_r8,0.17337e+01_r8,0.17293e+01_r8,0.12665e+01_r8 /) + kbo(:, 3,18, 9) = (/ & + & 0.86557e+00_r8,0.15883e+01_r8,0.17983e+01_r8,0.17854e+01_r8,0.13052e+01_r8 /) + kbo(:, 4,18, 9) = (/ & + & 0.89549e+00_r8,0.16413e+01_r8,0.18633e+01_r8,0.18465e+01_r8,0.13420e+01_r8 /) + kbo(:, 5,18, 9) = (/ & + & 0.92973e+00_r8,0.16952e+01_r8,0.19268e+01_r8,0.19102e+01_r8,0.13778e+01_r8 /) + kbo(:, 1,19, 9) = (/ & + & 0.70038e+00_r8,0.13093e+01_r8,0.14779e+01_r8,0.14733e+01_r8,0.10709e+01_r8 /) + kbo(:, 2,19, 9) = (/ & + & 0.72263e+00_r8,0.13577e+01_r8,0.15381e+01_r8,0.15268e+01_r8,0.11090e+01_r8 /) + kbo(:, 3,19, 9) = (/ & + & 0.74709e+00_r8,0.14065e+01_r8,0.15995e+01_r8,0.15853e+01_r8,0.11457e+01_r8 /) + kbo(:, 4,19, 9) = (/ & + & 0.77505e+00_r8,0.14562e+01_r8,0.16599e+01_r8,0.16467e+01_r8,0.11819e+01_r8 /) + kbo(:, 5,19, 9) = (/ & + & 0.80778e+00_r8,0.15082e+01_r8,0.17205e+01_r8,0.17095e+01_r8,0.12170e+01_r8 /) + kbo(:, 1,20, 9) = (/ & + & 0.60096e+00_r8,0.11549e+01_r8,0.13070e+01_r8,0.12966e+01_r8,0.93504e+00_r8 /) + kbo(:, 2,20, 9) = (/ & + & 0.62117e+00_r8,0.11996e+01_r8,0.13644e+01_r8,0.13518e+01_r8,0.97145e+00_r8 /) + kbo(:, 3,20, 9) = (/ & + & 0.64437e+00_r8,0.12456e+01_r8,0.14215e+01_r8,0.14105e+01_r8,0.10075e+01_r8 /) + kbo(:, 4,20, 9) = (/ & + & 0.67172e+00_r8,0.12935e+01_r8,0.14792e+01_r8,0.14711e+01_r8,0.10425e+01_r8 /) + kbo(:, 5,20, 9) = (/ & + & 0.70425e+00_r8,0.13447e+01_r8,0.15379e+01_r8,0.15320e+01_r8,0.10771e+01_r8 /) + kbo(:, 1,21, 9) = (/ & + & 0.51409e+00_r8,0.10184e+01_r8,0.11562e+01_r8,0.11440e+01_r8,0.81589e+00_r8 /) + kbo(:, 2,21, 9) = (/ & + & 0.53296e+00_r8,0.10604e+01_r8,0.12096e+01_r8,0.11991e+01_r8,0.85095e+00_r8 /) + kbo(:, 3,21, 9) = (/ & + & 0.55527e+00_r8,0.11043e+01_r8,0.12638e+01_r8,0.12567e+01_r8,0.88570e+00_r8 /) + kbo(:, 4,21, 9) = (/ & + & 0.58243e+00_r8,0.11512e+01_r8,0.13194e+01_r8,0.13151e+01_r8,0.92023e+00_r8 /) + kbo(:, 5,21, 9) = (/ & + & 0.61501e+00_r8,0.12017e+01_r8,0.13771e+01_r8,0.13737e+01_r8,0.95470e+00_r8 /) + kbo(:, 1,22, 9) = (/ & + & 0.44038e+00_r8,0.90186e+00_r8,0.10262e+01_r8,0.10153e+01_r8,0.71382e+00_r8 /) + kbo(:, 2,22, 9) = (/ & + & 0.45853e+00_r8,0.94198e+00_r8,0.10770e+01_r8,0.10695e+01_r8,0.74736e+00_r8 /) + kbo(:, 3,22, 9) = (/ & + & 0.48068e+00_r8,0.98449e+00_r8,0.11290e+01_r8,0.11248e+01_r8,0.78150e+00_r8 /) + kbo(:, 4,22, 9) = (/ & + & 0.50812e+00_r8,0.10306e+01_r8,0.11833e+01_r8,0.11809e+01_r8,0.81518e+00_r8 /) + kbo(:, 5,22, 9) = (/ & + & 0.54141e+00_r8,0.10817e+01_r8,0.12405e+01_r8,0.12383e+01_r8,0.84849e+00_r8 /) + kbo(:, 1,23, 9) = (/ & + & 0.37767e+00_r8,0.80078e+00_r8,0.91306e+00_r8,0.90433e+00_r8,0.62612e+00_r8 /) + kbo(:, 2,23, 9) = (/ & + & 0.39558e+00_r8,0.83957e+00_r8,0.96154e+00_r8,0.95658e+00_r8,0.65837e+00_r8 /) + kbo(:, 3,23, 9) = (/ & + & 0.41794e+00_r8,0.88149e+00_r8,0.10123e+01_r8,0.10097e+01_r8,0.69117e+00_r8 /) + kbo(:, 4,23, 9) = (/ & + & 0.44579e+00_r8,0.92784e+00_r8,0.10657e+01_r8,0.10643e+01_r8,0.72352e+00_r8 /) + kbo(:, 5,23, 9) = (/ & + & 0.47930e+00_r8,0.97981e+00_r8,0.11229e+01_r8,0.11209e+01_r8,0.75697e+00_r8 /) + kbo(:, 1,24, 9) = (/ & + & 0.32501e+00_r8,0.71314e+00_r8,0.81551e+00_r8,0.80817e+00_r8,0.55055e+00_r8 /) + kbo(:, 2,24, 9) = (/ & + & 0.34301e+00_r8,0.75171e+00_r8,0.86229e+00_r8,0.85830e+00_r8,0.58144e+00_r8 /) + kbo(:, 3,24, 9) = (/ & + & 0.36572e+00_r8,0.79385e+00_r8,0.91196e+00_r8,0.91014e+00_r8,0.61242e+00_r8 /) + kbo(:, 4,24, 9) = (/ & + & 0.39391e+00_r8,0.84084e+00_r8,0.96525e+00_r8,0.96386e+00_r8,0.64468e+00_r8 /) + kbo(:, 5,24, 9) = (/ & + & 0.42682e+00_r8,0.89378e+00_r8,0.10230e+01_r8,0.10202e+01_r8,0.67755e+00_r8 /) + kbo(:, 1,25, 9) = (/ & + & 0.28120e+00_r8,0.63782e+00_r8,0.73197e+00_r8,0.72532e+00_r8,0.48624e+00_r8 /) + kbo(:, 2,25, 9) = (/ & + & 0.29939e+00_r8,0.67672e+00_r8,0.77772e+00_r8,0.77395e+00_r8,0.51566e+00_r8 /) + kbo(:, 3,25, 9) = (/ & + & 0.32259e+00_r8,0.71969e+00_r8,0.82682e+00_r8,0.82484e+00_r8,0.54562e+00_r8 /) + kbo(:, 4,25, 9) = (/ & + & 0.35054e+00_r8,0.76785e+00_r8,0.88040e+00_r8,0.87836e+00_r8,0.57709e+00_r8 /) + kbo(:, 5,25, 9) = (/ & + & 0.38231e+00_r8,0.82200e+00_r8,0.93896e+00_r8,0.93503e+00_r8,0.60997e+00_r8 /) + kbo(:, 1,26, 9) = (/ & + & 0.24516e+00_r8,0.57415e+00_r8,0.66146e+00_r8,0.65501e+00_r8,0.43198e+00_r8 /) + kbo(:, 2,26, 9) = (/ & + & 0.26380e+00_r8,0.61364e+00_r8,0.70651e+00_r8,0.70261e+00_r8,0.46025e+00_r8 /) + kbo(:, 3,26, 9) = (/ & + & 0.28716e+00_r8,0.65790e+00_r8,0.75577e+00_r8,0.75300e+00_r8,0.48987e+00_r8 /) + kbo(:, 4,26, 9) = (/ & + & 0.31438e+00_r8,0.70747e+00_r8,0.80990e+00_r8,0.80672e+00_r8,0.52086e+00_r8 /) + kbo(:, 5,26, 9) = (/ & + & 0.34509e+00_r8,0.76331e+00_r8,0.86957e+00_r8,0.86437e+00_r8,0.55315e+00_r8 /) + kbo(:, 1,27, 9) = (/ & + & 0.21544e+00_r8,0.52037e+00_r8,0.60144e+00_r8,0.59535e+00_r8,0.38600e+00_r8 /) + kbo(:, 2,27, 9) = (/ & + & 0.23456e+00_r8,0.56067e+00_r8,0.64661e+00_r8,0.64229e+00_r8,0.41342e+00_r8 /) + kbo(:, 3,27, 9) = (/ & + & 0.25766e+00_r8,0.60633e+00_r8,0.69633e+00_r8,0.69257e+00_r8,0.44235e+00_r8 /) + kbo(:, 4,27, 9) = (/ & + & 0.28405e+00_r8,0.65751e+00_r8,0.75133e+00_r8,0.74692e+00_r8,0.47298e+00_r8 /) + kbo(:, 5,27, 9) = (/ & + & 0.31370e+00_r8,0.71529e+00_r8,0.81234e+00_r8,0.80601e+00_r8,0.50534e+00_r8 /) + kbo(:, 1,28, 9) = (/ & + & 0.19107e+00_r8,0.47529e+00_r8,0.55077e+00_r8,0.54503e+00_r8,0.34666e+00_r8 /) + kbo(:, 2,28, 9) = (/ & + & 0.21041e+00_r8,0.51675e+00_r8,0.59653e+00_r8,0.59172e+00_r8,0.37350e+00_r8 /) + kbo(:, 3,28, 9) = (/ & + & 0.23301e+00_r8,0.56364e+00_r8,0.64698e+00_r8,0.64221e+00_r8,0.40186e+00_r8 /) + kbo(:, 4,28, 9) = (/ & + & 0.25866e+00_r8,0.61667e+00_r8,0.70320e+00_r8,0.69763e+00_r8,0.43205e+00_r8 /) + kbo(:, 5,28, 9) = (/ & + & 0.28710e+00_r8,0.67650e+00_r8,0.76586e+00_r8,0.75834e+00_r8,0.46367e+00_r8 /) + kbo(:, 1,29, 9) = (/ & + & 0.17112e+00_r8,0.43830e+00_r8,0.50881e+00_r8,0.50311e+00_r8,0.31371e+00_r8 /) + kbo(:, 2,29, 9) = (/ & + & 0.19046e+00_r8,0.48081e+00_r8,0.55535e+00_r8,0.54996e+00_r8,0.34018e+00_r8 /) + kbo(:, 3,29, 9) = (/ & + & 0.21264e+00_r8,0.52926e+00_r8,0.60692e+00_r8,0.60125e+00_r8,0.36829e+00_r8 /) + kbo(:, 4,29, 9) = (/ & + & 0.23734e+00_r8,0.58428e+00_r8,0.66473e+00_r8,0.65816e+00_r8,0.39807e+00_r8 /) + kbo(:, 5,29, 9) = (/ & + & 0.26483e+00_r8,0.64604e+00_r8,0.72961e+00_r8,0.72085e+00_r8,0.42916e+00_r8 /) + kbo(:, 1,30, 9) = (/ & + & 0.15474e+00_r8,0.40804e+00_r8,0.47416e+00_r8,0.46844e+00_r8,0.28591e+00_r8 /) + kbo(:, 2,30, 9) = (/ & + & 0.17385e+00_r8,0.45175e+00_r8,0.52179e+00_r8,0.51582e+00_r8,0.31208e+00_r8 /) + kbo(:, 3,30, 9) = (/ & + & 0.19550e+00_r8,0.50197e+00_r8,0.57484e+00_r8,0.56852e+00_r8,0.33963e+00_r8 /) + kbo(:, 4,30, 9) = (/ & + & 0.21942e+00_r8,0.55897e+00_r8,0.63459e+00_r8,0.62718e+00_r8,0.36926e+00_r8 /) + kbo(:, 5,30, 9) = (/ & + & 0.24626e+00_r8,0.62254e+00_r8,0.70206e+00_r8,0.69222e+00_r8,0.40317e+00_r8 /) + kbo(:, 1,31, 9) = (/ & + & 0.14123e+00_r8,0.38383e+00_r8,0.44627e+00_r8,0.44042e+00_r8,0.26282e+00_r8 /) + kbo(:, 2,31, 9) = (/ & + & 0.16008e+00_r8,0.42905e+00_r8,0.49523e+00_r8,0.48891e+00_r8,0.28832e+00_r8 /) + kbo(:, 3,31, 9) = (/ & + & 0.18115e+00_r8,0.48120e+00_r8,0.55018e+00_r8,0.54338e+00_r8,0.31669e+00_r8 /) + kbo(:, 4,31, 9) = (/ & + & 0.20456e+00_r8,0.54014e+00_r8,0.61227e+00_r8,0.60422e+00_r8,0.34861e+00_r8 /) + kbo(:, 5,31, 9) = (/ & + & 0.23090e+00_r8,0.60549e+00_r8,0.68253e+00_r8,0.67193e+00_r8,0.38334e+00_r8 /) + kbo(:, 1,32, 9) = (/ & + & 0.13011e+00_r8,0.36494e+00_r8,0.42434e+00_r8,0.41840e+00_r8,0.24343e+00_r8 /) + kbo(:, 2,32, 9) = (/ & + & 0.14859e+00_r8,0.41192e+00_r8,0.47502e+00_r8,0.46846e+00_r8,0.27034e+00_r8 /) + kbo(:, 3,32, 9) = (/ & + & 0.16925e+00_r8,0.46604e+00_r8,0.53210e+00_r8,0.52502e+00_r8,0.30012e+00_r8 /) + kbo(:, 4,32, 9) = (/ & + & 0.19229e+00_r8,0.52692e+00_r8,0.59693e+00_r8,0.58841e+00_r8,0.33258e+00_r8 /) + kbo(:, 5,32, 9) = (/ & + & 0.21839e+00_r8,0.59419e+00_r8,0.67028e+00_r8,0.65920e+00_r8,0.36819e+00_r8 /) + kbo(:, 1,33, 9) = (/ & + & 0.12092e+00_r8,0.35074e+00_r8,0.40776e+00_r8,0.40175e+00_r8,0.22934e+00_r8 /) + kbo(:, 2,33, 9) = (/ & + & 0.13904e+00_r8,0.39967e+00_r8,0.46044e+00_r8,0.45383e+00_r8,0.25698e+00_r8 /) + kbo(:, 3,33, 9) = (/ & + & 0.15944e+00_r8,0.45574e+00_r8,0.51998e+00_r8,0.51285e+00_r8,0.28727e+00_r8 /) + kbo(:, 4,33, 9) = (/ & + & 0.18230e+00_r8,0.51859e+00_r8,0.58782e+00_r8,0.57914e+00_r8,0.32052e+00_r8 /) + kbo(:, 5,33, 9) = (/ & + & 0.20843e+00_r8,0.58793e+00_r8,0.66452e+00_r8,0.65307e+00_r8,0.35723e+00_r8 /) + kbo(:, 1,34, 9) = (/ & + & 0.11270e+00_r8,0.33906e+00_r8,0.39419e+00_r8,0.38828e+00_r8,0.21761e+00_r8 /) + kbo(:, 2,34, 9) = (/ & + & 0.13054e+00_r8,0.38970e+00_r8,0.44887e+00_r8,0.44251e+00_r8,0.24563e+00_r8 /) + kbo(:, 3,34, 9) = (/ & + & 0.15070e+00_r8,0.44751e+00_r8,0.51092e+00_r8,0.50399e+00_r8,0.27652e+00_r8 /) + kbo(:, 4,34, 9) = (/ & + & 0.17349e+00_r8,0.51224e+00_r8,0.58169e+00_r8,0.57301e+00_r8,0.31064e+00_r8 /) + kbo(:, 5,34, 9) = (/ & + & 0.19973e+00_r8,0.58363e+00_r8,0.66163e+00_r8,0.64989e+00_r8,0.34860e+00_r8 /) + kbo(:, 1,35, 9) = (/ & + & 0.10431e+00_r8,0.32621e+00_r8,0.37969e+00_r8,0.37421e+00_r8,0.20589e+00_r8 /) + kbo(:, 2,35, 9) = (/ & + & 0.12172e+00_r8,0.37794e+00_r8,0.43594e+00_r8,0.43005e+00_r8,0.23415e+00_r8 /) + kbo(:, 3,35, 9) = (/ & + & 0.14155e+00_r8,0.43696e+00_r8,0.49993e+00_r8,0.49338e+00_r8,0.26546e+00_r8 /) + kbo(:, 4,35, 9) = (/ & + & 0.16416e+00_r8,0.50303e+00_r8,0.57285e+00_r8,0.56442e+00_r8,0.30031e+00_r8 /) + kbo(:, 5,35, 9) = (/ & + & 0.19033e+00_r8,0.57592e+00_r8,0.65509e+00_r8,0.64342e+00_r8,0.33926e+00_r8 /) + kbo(:, 1,36, 9) = (/ & + & 0.95441e-01_r8,0.31093e+00_r8,0.36283e+00_r8,0.35795e+00_r8,0.19348e+00_r8 /) + kbo(:, 2,36, 9) = (/ & + & 0.11226e+00_r8,0.36299e+00_r8,0.41996e+00_r8,0.41468e+00_r8,0.22173e+00_r8 /) + kbo(:, 3,36, 9) = (/ & + & 0.13160e+00_r8,0.42251e+00_r8,0.48508e+00_r8,0.47906e+00_r8,0.25327e+00_r8 /) + kbo(:, 4,36, 9) = (/ & + & 0.15379e+00_r8,0.48924e+00_r8,0.55909e+00_r8,0.55119e+00_r8,0.28853e+00_r8 /) + kbo(:, 5,36, 9) = (/ & + & 0.17959e+00_r8,0.56298e+00_r8,0.64257e+00_r8,0.63136e+00_r8,0.32808e+00_r8 /) + kbo(:, 1,37, 9) = (/ & + & 0.85477e-01_r8,0.29072e+00_r8,0.34067e+00_r8,0.33658e+00_r8,0.17886e+00_r8 /) + kbo(:, 2,37, 9) = (/ & + & 0.10144e+00_r8,0.34200e+00_r8,0.39763e+00_r8,0.39300e+00_r8,0.20669e+00_r8 /) + kbo(:, 3,37, 9) = (/ & + & 0.11996e+00_r8,0.40095e+00_r8,0.46252e+00_r8,0.45719e+00_r8,0.23796e+00_r8 /) + kbo(:, 4,37, 9) = (/ & + & 0.14137e+00_r8,0.46732e+00_r8,0.53621e+00_r8,0.52913e+00_r8,0.27304e+00_r8 /) + kbo(:, 5,37, 9) = (/ & + & 0.16629e+00_r8,0.54086e+00_r8,0.61939e+00_r8,0.60918e+00_r8,0.31246e+00_r8 /) + kbo(:, 1,38, 9) = (/ & + & 0.76626e-01_r8,0.27223e+00_r8,0.32047e+00_r8,0.31724e+00_r8,0.16576e+00_r8 /) + kbo(:, 2,38, 9) = (/ & + & 0.91774e-01_r8,0.32273e+00_r8,0.37721e+00_r8,0.37319e+00_r8,0.19315e+00_r8 /) + kbo(:, 3,38, 9) = (/ & + & 0.10950e+00_r8,0.38104e+00_r8,0.44177e+00_r8,0.43708e+00_r8,0.22413e+00_r8 /) + kbo(:, 4,38, 9) = (/ & + & 0.13015e+00_r8,0.44697e+00_r8,0.51498e+00_r8,0.50870e+00_r8,0.25903e+00_r8 /) + kbo(:, 5,38, 9) = (/ & + & 0.15424e+00_r8,0.52018e+00_r8,0.59766e+00_r8,0.58842e+00_r8,0.29827e+00_r8 /) + kbo(:, 1,39, 9) = (/ & + & 0.68857e-01_r8,0.25564e+00_r8,0.30247e+00_r8,0.30005e+00_r8,0.15419e+00_r8 /) + kbo(:, 2,39, 9) = (/ & + & 0.83231e-01_r8,0.30541e+00_r8,0.35891e+00_r8,0.35551e+00_r8,0.18117e+00_r8 /) + kbo(:, 3,39, 9) = (/ & + & 0.10022e+00_r8,0.36305e+00_r8,0.42306e+00_r8,0.41901e+00_r8,0.21190e+00_r8 /) + kbo(:, 4,39, 9) = (/ & + & 0.12015e+00_r8,0.42854e+00_r8,0.49574e+00_r8,0.49023e+00_r8,0.24662e+00_r8 /) + kbo(:, 5,39, 9) = (/ & + & 0.14353e+00_r8,0.50140e+00_r8,0.57784e+00_r8,0.56950e+00_r8,0.28564e+00_r8 /) + kbo(:, 1,40, 9) = (/ & + & 0.60721e-01_r8,0.23607e+00_r8,0.28098e+00_r8,0.27949e+00_r8,0.14134e+00_r8 /) + kbo(:, 2,40, 9) = (/ & + & 0.74142e-01_r8,0.28436e+00_r8,0.33629e+00_r8,0.33356e+00_r8,0.16758e+00_r8 /) + kbo(:, 3,40, 9) = (/ & + & 0.90161e-01_r8,0.34051e+00_r8,0.39918e+00_r8,0.39576e+00_r8,0.19765e+00_r8 /) + kbo(:, 4,40, 9) = (/ & + & 0.10909e+00_r8,0.40469e+00_r8,0.47035e+00_r8,0.46571e+00_r8,0.23173e+00_r8 /) + kbo(:, 5,40, 9) = (/ & + & 0.13146e+00_r8,0.47643e+00_r8,0.55083e+00_r8,0.54364e+00_r8,0.27006e+00_r8 /) + kbo(:, 1,41, 9) = (/ & + & 0.53403e-01_r8,0.21760e+00_r8,0.26060e+00_r8,0.26004e+00_r8,0.12944e+00_r8 /) + kbo(:, 2,41, 9) = (/ & + & 0.65918e-01_r8,0.26438e+00_r8,0.31466e+00_r8,0.31265e+00_r8,0.15490e+00_r8 /) + kbo(:, 3,41, 9) = (/ & + & 0.80936e-01_r8,0.31888e+00_r8,0.37609e+00_r8,0.37327e+00_r8,0.18421e+00_r8 /) + kbo(:, 4,41, 9) = (/ & + & 0.98889e-01_r8,0.38155e+00_r8,0.44565e+00_r8,0.44176e+00_r8,0.21756e+00_r8 /) + kbo(:, 5,41, 9) = (/ & + & 0.12024e+00_r8,0.45195e+00_r8,0.52424e+00_r8,0.51812e+00_r8,0.25511e+00_r8 /) + kbo(:, 1,42, 9) = (/ & + & 0.46980e-01_r8,0.20072e+00_r8,0.24188e+00_r8,0.24222e+00_r8,0.11863e+00_r8 /) + kbo(:, 2,42, 9) = (/ & + & 0.58572e-01_r8,0.24586e+00_r8,0.29443e+00_r8,0.29314e+00_r8,0.14330e+00_r8 /) + kbo(:, 3,42, 9) = (/ & + & 0.72653e-01_r8,0.29875e+00_r8,0.35445e+00_r8,0.35212e+00_r8,0.17184e+00_r8 /) + kbo(:, 4,42, 9) = (/ & + & 0.89663e-01_r8,0.35979e+00_r8,0.42236e+00_r8,0.41911e+00_r8,0.20443e+00_r8 /) + kbo(:, 5,42, 9) = (/ & + & 0.11004e+00_r8,0.42873e+00_r8,0.49904e+00_r8,0.49389e+00_r8,0.24118e+00_r8 /) + kbo(:, 1,43, 9) = (/ & + & 0.40748e-01_r8,0.18301e+00_r8,0.22189e+00_r8,0.22309e+00_r8,0.10752e+00_r8 /) + kbo(:, 2,43, 9) = (/ & + & 0.51357e-01_r8,0.22603e+00_r8,0.27246e+00_r8,0.27198e+00_r8,0.13119e+00_r8 /) + kbo(:, 3,43, 9) = (/ & + & 0.64381e-01_r8,0.27684e+00_r8,0.33058e+00_r8,0.32881e+00_r8,0.15875e+00_r8 /) + kbo(:, 4,43, 9) = (/ & + & 0.80299e-01_r8,0.33572e+00_r8,0.39639e+00_r8,0.39376e+00_r8,0.19029e+00_r8 /) + kbo(:, 5,43, 9) = (/ & + & 0.99551e-01_r8,0.40267e+00_r8,0.47065e+00_r8,0.46647e+00_r8,0.22598e+00_r8 /) + kbo(:, 1,44, 9) = (/ & + & 0.35065e-01_r8,0.16586e+00_r8,0.20221e+00_r8,0.20417e+00_r8,0.96831e-01_r8 /) + kbo(:, 2,44, 9) = (/ & + & 0.44686e-01_r8,0.20650e+00_r8,0.25055e+00_r8,0.25097e+00_r8,0.11942e+00_r8 /) + kbo(:, 3,44, 9) = (/ & + & 0.56631e-01_r8,0.25500e+00_r8,0.30652e+00_r8,0.30540e+00_r8,0.14585e+00_r8 /) + kbo(:, 4,44, 9) = (/ & + & 0.71442e-01_r8,0.31160e+00_r8,0.37021e+00_r8,0.36812e+00_r8,0.17630e+00_r8 /) + kbo(:, 5,44, 9) = (/ & + & 0.89487e-01_r8,0.37611e+00_r8,0.44177e+00_r8,0.43843e+00_r8,0.21076e+00_r8 /) + kbo(:, 1,45, 9) = (/ & + & 0.30099e-01_r8,0.15014e+00_r8,0.18399e+00_r8,0.18651e+00_r8,0.87081e-01_r8 /) + kbo(:, 2,45, 9) = (/ & + & 0.38792e-01_r8,0.18842e+00_r8,0.23006e+00_r8,0.23134e+00_r8,0.10857e+00_r8 /) + kbo(:, 3,45, 9) = (/ & + & 0.49706e-01_r8,0.23455e+00_r8,0.28377e+00_r8,0.28337e+00_r8,0.13385e+00_r8 /) + kbo(:, 4,45, 9) = (/ & + & 0.63416e-01_r8,0.28880e+00_r8,0.34526e+00_r8,0.34365e+00_r8,0.16313e+00_r8 /) + kbo(:, 5,45, 9) = (/ & + & 0.80320e-01_r8,0.35087e+00_r8,0.41430e+00_r8,0.41165e+00_r8,0.19641e+00_r8 /) + kbo(:, 1,46, 9) = (/ & + & 0.25615e-01_r8,0.13501e+00_r8,0.16621e+00_r8,0.16909e+00_r8,0.77761e-01_r8 /) + kbo(:, 2,46, 9) = (/ & + & 0.33396e-01_r8,0.17087e+00_r8,0.20986e+00_r8,0.21193e+00_r8,0.98069e-01_r8 /) + kbo(:, 3,46, 9) = (/ & + & 0.43320e-01_r8,0.21451e+00_r8,0.26120e+00_r8,0.26156e+00_r8,0.12212e+00_r8 /) + kbo(:, 4,46, 9) = (/ & + & 0.55857e-01_r8,0.26606e+00_r8,0.32018e+00_r8,0.31908e+00_r8,0.15012e+00_r8 /) + kbo(:, 5,46, 9) = (/ & + & 0.71564e-01_r8,0.32546e+00_r8,0.38657e+00_r8,0.38454e+00_r8,0.18211e+00_r8 /) + kbo(:, 1,47, 9) = (/ & + & 0.21470e-01_r8,0.11984e+00_r8,0.14813e+00_r8,0.15126e+00_r8,0.68564e-01_r8 /) + kbo(:, 2,47, 9) = (/ & + & 0.28327e-01_r8,0.15313e+00_r8,0.18908e+00_r8,0.19182e+00_r8,0.87445e-01_r8 /) + kbo(:, 3,47, 9) = (/ & + & 0.37186e-01_r8,0.19381e+00_r8,0.23756e+00_r8,0.23882e+00_r8,0.11016e+00_r8 /) + kbo(:, 4,47, 9) = (/ & + & 0.48514e-01_r8,0.24239e+00_r8,0.29373e+00_r8,0.29331e+00_r8,0.13670e+00_r8 /) + kbo(:, 5,47, 9) = (/ & + & 0.62915e-01_r8,0.29879e+00_r8,0.35729e+00_r8,0.35580e+00_r8,0.16718e+00_r8 /) + kbo(:, 1,48, 9) = (/ & + & 0.17915e-01_r8,0.10594e+00_r8,0.13153e+00_r8,0.13471e+00_r8,0.60247e-01_r8 /) + kbo(:, 2,48, 9) = (/ & + & 0.23922e-01_r8,0.13687e+00_r8,0.16982e+00_r8,0.17297e+00_r8,0.77702e-01_r8 /) + kbo(:, 3,48, 9) = (/ & + & 0.31789e-01_r8,0.17464e+00_r8,0.21543e+00_r8,0.21754e+00_r8,0.99032e-01_r8 /) + kbo(:, 4,48, 9) = (/ & + & 0.41975e-01_r8,0.22024e+00_r8,0.26872e+00_r8,0.26906e+00_r8,0.12414e+00_r8 /) + kbo(:, 5,48, 9) = (/ & + & 0.55099e-01_r8,0.27366e+00_r8,0.32950e+00_r8,0.32848e+00_r8,0.15313e+00_r8 /) + kbo(:, 1,49, 9) = (/ & + & 0.14883e-01_r8,0.93224e-01_r8,0.11635e+00_r8,0.11939e+00_r8,0.52749e-01_r8 /) + kbo(:, 2,49, 9) = (/ & + & 0.20112e-01_r8,0.12194e+00_r8,0.15191e+00_r8,0.15532e+00_r8,0.68811e-01_r8 /) + kbo(:, 3,49, 9) = (/ & + & 0.27052e-01_r8,0.15700e+00_r8,0.19473e+00_r8,0.19754e+00_r8,0.88692e-01_r8 /) + kbo(:, 4,49, 9) = (/ & + & 0.36170e-01_r8,0.19958e+00_r8,0.24512e+00_r8,0.24626e+00_r8,0.11239e+00_r8 /) + kbo(:, 5,49, 9) = (/ & + & 0.48053e-01_r8,0.24998e+00_r8,0.30305e+00_r8,0.30260e+00_r8,0.13992e+00_r8 /) + kbo(:, 1,50, 9) = (/ & + & 0.12401e-01_r8,0.82224e-01_r8,0.10323e+00_r8,0.10603e+00_r8,0.46388e-01_r8 /) + kbo(:, 2,50, 9) = (/ & + & 0.16961e-01_r8,0.10896e+00_r8,0.13629e+00_r8,0.13978e+00_r8,0.61130e-01_r8 /) + kbo(:, 3,50, 9) = (/ & + & 0.23097e-01_r8,0.14168e+00_r8,0.17654e+00_r8,0.17982e+00_r8,0.79649e-01_r8 /) + kbo(:, 4,50, 9) = (/ & + & 0.31266e-01_r8,0.18143e+00_r8,0.22418e+00_r8,0.22611e+00_r8,0.10201e+00_r8 /) + kbo(:, 5,50, 9) = (/ & + & 0.42049e-01_r8,0.22900e+00_r8,0.27939e+00_r8,0.27959e+00_r8,0.12818e+00_r8 /) + kbo(:, 1,51, 9) = (/ & + & 0.10311e-01_r8,0.72407e-01_r8,0.91543e-01_r8,0.94015e-01_r8,0.40739e-01_r8 /) + kbo(:, 2,51, 9) = (/ & + & 0.14299e-01_r8,0.97301e-01_r8,0.12223e+00_r8,0.12566e+00_r8,0.54336e-01_r8 /) + kbo(:, 3,51, 9) = (/ & + & 0.19709e-01_r8,0.12788e+00_r8,0.16001e+00_r8,0.16354e+00_r8,0.71514e-01_r8 /) + kbo(:, 4,51, 9) = (/ & + & 0.27010e-01_r8,0.16504e+00_r8,0.20502e+00_r8,0.20766e+00_r8,0.92576e-01_r8 /) + kbo(:, 5,51, 9) = (/ & + & 0.36820e-01_r8,0.20996e+00_r8,0.25769e+00_r8,0.25854e+00_r8,0.11743e+00_r8 /) + kbo(:, 1,52, 9) = (/ & + & 0.85238e-02_r8,0.63439e-01_r8,0.80796e-01_r8,0.82950e-01_r8,0.35726e-01_r8 /) + kbo(:, 2,52, 9) = (/ & + & 0.12004e-01_r8,0.86535e-01_r8,0.10929e+00_r8,0.11252e+00_r8,0.48201e-01_r8 /) + kbo(:, 3,52, 9) = (/ & + & 0.16756e-01_r8,0.11511e+00_r8,0.14456e+00_r8,0.14824e+00_r8,0.64036e-01_r8 /) + kbo(:, 4,52, 9) = (/ & + & 0.23247e-01_r8,0.14984e+00_r8,0.18701e+00_r8,0.19020e+00_r8,0.83745e-01_r8 /) + kbo(:, 5,52, 9) = (/ & + & 0.32110e-01_r8,0.19199e+00_r8,0.23699e+00_r8,0.23857e+00_r8,0.10729e+00_r8 /) + kbo(:, 1,53, 9) = (/ & + & 0.70021e-02_r8,0.55279e-01_r8,0.70908e-01_r8,0.72826e-01_r8,0.31267e-01_r8 /) + kbo(:, 2,53, 9) = (/ & + & 0.10022e-01_r8,0.76605e-01_r8,0.97337e-01_r8,0.10026e+00_r8,0.42555e-01_r8 /) + kbo(:, 3,53, 9) = (/ & + & 0.14186e-01_r8,0.10324e+00_r8,0.13015e+00_r8,0.13384e+00_r8,0.57176e-01_r8 /) + kbo(:, 4,53, 9) = (/ & + & 0.19924e-01_r8,0.13568e+00_r8,0.17006e+00_r8,0.17360e+00_r8,0.75508e-01_r8 /) + kbo(:, 5,53, 9) = (/ & + & 0.27873e-01_r8,0.17508e+00_r8,0.21734e+00_r8,0.21965e+00_r8,0.97730e-01_r8 /) + kbo(:, 1,54, 9) = (/ & + & 0.57827e-02_r8,0.48416e-01_r8,0.62508e-01_r8,0.64310e-01_r8,0.27618e-01_r8 /) + kbo(:, 2,54, 9) = (/ & + & 0.84043e-02_r8,0.68151e-01_r8,0.87167e-01_r8,0.89761e-01_r8,0.37874e-01_r8 /) + kbo(:, 3,54, 9) = (/ & + & 0.12088e-01_r8,0.93069e-01_r8,0.11782e+00_r8,0.12138e+00_r8,0.51418e-01_r8 /) + kbo(:, 4,54, 9) = (/ & + & 0.17188e-01_r8,0.12356e+00_r8,0.15542e+00_r8,0.15914e+00_r8,0.68446e-01_r8 /) + kbo(:, 5,54, 9) = (/ & + & 0.24356e-01_r8,0.16057e+00_r8,0.20027e+00_r8,0.20317e+00_r8,0.89427e-01_r8 /) + kbo(:, 1,55, 9) = (/ & + & 0.47829e-02_r8,0.42445e-01_r8,0.55108e-01_r8,0.56879e-01_r8,0.24415e-01_r8 /) + kbo(:, 2,55, 9) = (/ & + & 0.70515e-02_r8,0.60688e-01_r8,0.78130e-01_r8,0.80430e-01_r8,0.33849e-01_r8 /) + kbo(:, 3,55, 9) = (/ & + & 0.10307e-01_r8,0.83954e-01_r8,0.10678e+00_r8,0.11014e+00_r8,0.46263e-01_r8 /) + kbo(:, 4,55, 9) = (/ & + & 0.14854e-01_r8,0.11267e+00_r8,0.14216e+00_r8,0.14598e+00_r8,0.62158e-01_r8 /) + kbo(:, 5,55, 9) = (/ & + & 0.21317e-01_r8,0.14754e+00_r8,0.18474e+00_r8,0.18809e+00_r8,0.81914e-01_r8 /) + kbo(:, 1,56, 9) = (/ & + & 0.39349e-02_r8,0.37013e-01_r8,0.48295e-01_r8,0.50091e-01_r8,0.21529e-01_r8 /) + kbo(:, 2,56, 9) = (/ & + & 0.58808e-02_r8,0.53785e-01_r8,0.69695e-01_r8,0.71776e-01_r8,0.30144e-01_r8 /) + kbo(:, 3,56, 9) = (/ & + & 0.87470e-02_r8,0.75476e-01_r8,0.96519e-01_r8,0.99590e-01_r8,0.41605e-01_r8 /) + kbo(:, 4,56, 9) = (/ & + & 0.12799e-01_r8,0.10247e+00_r8,0.12972e+00_r8,0.13354e+00_r8,0.56396e-01_r8 /) + kbo(:, 5,56, 9) = (/ & + & 0.18597e-01_r8,0.13533e+00_r8,0.17007e+00_r8,0.17370e+00_r8,0.74854e-01_r8 /) + kbo(:, 1,57, 9) = (/ & + & 0.32237e-02_r8,0.32103e-01_r8,0.42068e-01_r8,0.43893e-01_r8,0.18889e-01_r8 /) + kbo(:, 2,57, 9) = (/ & + & 0.48776e-02_r8,0.47453e-01_r8,0.61873e-01_r8,0.63812e-01_r8,0.26899e-01_r8 /) + kbo(:, 3,57, 9) = (/ & + & 0.73816e-02_r8,0.67586e-01_r8,0.86956e-01_r8,0.89701e-01_r8,0.37405e-01_r8 /) + kbo(:, 4,57, 9) = (/ & + & 0.10984e-01_r8,0.92907e-01_r8,0.11806e+00_r8,0.12175e+00_r8,0.51002e-01_r8 /) + kbo(:, 5,57, 9) = (/ & + & 0.16168e-01_r8,0.12385e+00_r8,0.15617e+00_r8,0.15996e+00_r8,0.68253e-01_r8 /) + kbo(:, 1,58, 9) = (/ & + & 0.26462e-02_r8,0.27879e-01_r8,0.36685e-01_r8,0.38484e-01_r8,0.16601e-01_r8 /) + kbo(:, 2,58, 9) = (/ & + & 0.40522e-02_r8,0.41929e-01_r8,0.54967e-01_r8,0.56858e-01_r8,0.24050e-01_r8 /) + kbo(:, 3,58, 9) = (/ & + & 0.62364e-02_r8,0.60609e-01_r8,0.78458e-01_r8,0.80919e-01_r8,0.33657e-01_r8 /) + kbo(:, 4,58, 9) = (/ & + & 0.94512e-02_r8,0.84383e-01_r8,0.10769e+00_r8,0.11117e+00_r8,0.46338e-01_r8 /) + kbo(:, 5,58, 9) = (/ & + & 0.14101e-01_r8,0.11363e+00_r8,0.14367e+00_r8,0.14755e+00_r8,0.62487e-01_r8 /) + kbo(:, 1,59, 9) = (/ & + & 0.23375e-02_r8,0.26104e-01_r8,0.34483e-01_r8,0.36273e-01_r8,0.15643e-01_r8 /) + kbo(:, 2,59, 9) = (/ & + & 0.36353e-02_r8,0.39676e-01_r8,0.52191e-01_r8,0.54098e-01_r8,0.22879e-01_r8 /) + kbo(:, 3,59, 9) = (/ & + & 0.56781e-02_r8,0.57810e-01_r8,0.75085e-01_r8,0.77452e-01_r8,0.32253e-01_r8 /) + kbo(:, 4,59, 9) = (/ & + & 0.87345e-02_r8,0.80998e-01_r8,0.10362e+00_r8,0.10701e+00_r8,0.44587e-01_r8 /) + kbo(:, 5,59, 9) = (/ & + & 0.13202e-01_r8,0.10960e+00_r8,0.13878e+00_r8,0.14268e+00_r8,0.60173e-01_r8 /) + kbo(:, 1,13,10) = (/ & + & 0.68082e+01_r8,0.10647e+02_r8,0.12044e+02_r8,0.12092e+02_r8,0.85097e+01_r8 /) + kbo(:, 2,13,10) = (/ & + & 0.67019e+01_r8,0.10585e+02_r8,0.12055e+02_r8,0.12198e+02_r8,0.87119e+01_r8 /) + kbo(:, 3,13,10) = (/ & + & 0.67137e+01_r8,0.10536e+02_r8,0.12063e+02_r8,0.12312e+02_r8,0.88714e+01_r8 /) + kbo(:, 4,13,10) = (/ & + & 0.68713e+01_r8,0.10489e+02_r8,0.12087e+02_r8,0.12413e+02_r8,0.90170e+01_r8 /) + kbo(:, 5,13,10) = (/ & + & 0.71185e+01_r8,0.10479e+02_r8,0.12121e+02_r8,0.12479e+02_r8,0.91853e+01_r8 /) + kbo(:, 1,14,10) = (/ & + & 0.58410e+01_r8,0.94018e+01_r8,0.10846e+02_r8,0.11035e+02_r8,0.76674e+01_r8 /) + kbo(:, 2,14,10) = (/ & + & 0.58467e+01_r8,0.93735e+01_r8,0.10875e+02_r8,0.11156e+02_r8,0.78256e+01_r8 /) + kbo(:, 3,14,10) = (/ & + & 0.59984e+01_r8,0.93438e+01_r8,0.10908e+02_r8,0.11271e+02_r8,0.79426e+01_r8 /) + kbo(:, 4,14,10) = (/ & + & 0.62373e+01_r8,0.93563e+01_r8,0.10953e+02_r8,0.11364e+02_r8,0.81071e+01_r8 /) + kbo(:, 5,14,10) = (/ & + & 0.65135e+01_r8,0.94809e+01_r8,0.10997e+02_r8,0.11429e+02_r8,0.82861e+01_r8 /) + kbo(:, 1,15,10) = (/ & + & 0.50343e+01_r8,0.83265e+01_r8,0.97137e+01_r8,0.99946e+01_r8,0.69930e+01_r8 /) + kbo(:, 2,15,10) = (/ & + & 0.51660e+01_r8,0.83107e+01_r8,0.97594e+01_r8,0.10123e+02_r8,0.71240e+01_r8 /) + kbo(:, 3,15,10) = (/ & + & 0.53903e+01_r8,0.83316e+01_r8,0.98216e+01_r8,0.10239e+02_r8,0.72628e+01_r8 /) + kbo(:, 4,15,10) = (/ & + & 0.56415e+01_r8,0.84645e+01_r8,0.98856e+01_r8,0.10324e+02_r8,0.74229e+01_r8 /) + kbo(:, 5,15,10) = (/ & + & 0.58842e+01_r8,0.87055e+01_r8,0.99631e+01_r8,0.10400e+02_r8,0.75908e+01_r8 /) + kbo(:, 1,16,10) = (/ & + & 0.44015e+01_r8,0.74103e+01_r8,0.86530e+01_r8,0.90071e+01_r8,0.63301e+01_r8 /) + kbo(:, 2,16,10) = (/ & + & 0.45955e+01_r8,0.74391e+01_r8,0.87237e+01_r8,0.91359e+01_r8,0.64715e+01_r8 /) + kbo(:, 3,16,10) = (/ & + & 0.48140e+01_r8,0.75662e+01_r8,0.88065e+01_r8,0.92379e+01_r8,0.66426e+01_r8 /) + kbo(:, 4,16,10) = (/ & + & 0.50318e+01_r8,0.77981e+01_r8,0.89101e+01_r8,0.93283e+01_r8,0.68095e+01_r8 /) + kbo(:, 5,16,10) = (/ & + & 0.52436e+01_r8,0.80914e+01_r8,0.90522e+01_r8,0.94292e+01_r8,0.69717e+01_r8 /) + kbo(:, 1,17,10) = (/ & + & 0.38938e+01_r8,0.65976e+01_r8,0.77151e+01_r8,0.80672e+01_r8,0.57119e+01_r8 /) + kbo(:, 2,17,10) = (/ & + & 0.40781e+01_r8,0.67171e+01_r8,0.78068e+01_r8,0.81879e+01_r8,0.58706e+01_r8 /) + kbo(:, 3,17,10) = (/ & + & 0.42641e+01_r8,0.69435e+01_r8,0.79191e+01_r8,0.82934e+01_r8,0.60296e+01_r8 /) + kbo(:, 4,17,10) = (/ & + & 0.44480e+01_r8,0.72305e+01_r8,0.80762e+01_r8,0.84106e+01_r8,0.62012e+01_r8 /) + kbo(:, 5,17,10) = (/ & + & 0.46308e+01_r8,0.75237e+01_r8,0.83037e+01_r8,0.85418e+01_r8,0.63775e+01_r8 /) + kbo(:, 1,18,10) = (/ & + & 0.34407e+01_r8,0.58963e+01_r8,0.69001e+01_r8,0.71891e+01_r8,0.51366e+01_r8 /) + kbo(:, 2,18,10) = (/ & + & 0.35988e+01_r8,0.61068e+01_r8,0.70120e+01_r8,0.73051e+01_r8,0.52912e+01_r8 /) + kbo(:, 3,18,10) = (/ & + & 0.37577e+01_r8,0.63853e+01_r8,0.71752e+01_r8,0.74336e+01_r8,0.54376e+01_r8 /) + kbo(:, 4,18,10) = (/ & + & 0.39161e+01_r8,0.66726e+01_r8,0.74020e+01_r8,0.75773e+01_r8,0.56097e+01_r8 /) + kbo(:, 5,18,10) = (/ & + & 0.40711e+01_r8,0.69480e+01_r8,0.76793e+01_r8,0.77395e+01_r8,0.57994e+01_r8 /) + kbo(:, 1,19,10) = (/ & + & 0.30222e+01_r8,0.53136e+01_r8,0.61695e+01_r8,0.63815e+01_r8,0.46248e+01_r8 /) + kbo(:, 2,19,10) = (/ & + & 0.31568e+01_r8,0.55745e+01_r8,0.63303e+01_r8,0.65186e+01_r8,0.47653e+01_r8 /) + kbo(:, 3,19,10) = (/ & + & 0.32936e+01_r8,0.58515e+01_r8,0.65536e+01_r8,0.66691e+01_r8,0.49110e+01_r8 /) + kbo(:, 4,19,10) = (/ & + & 0.34320e+01_r8,0.61200e+01_r8,0.68298e+01_r8,0.68431e+01_r8,0.50671e+01_r8 /) + kbo(:, 5,19,10) = (/ & + & 0.35717e+01_r8,0.63810e+01_r8,0.71341e+01_r8,0.70485e+01_r8,0.52482e+01_r8 /) + kbo(:, 1,20,10) = (/ & + & 0.26646e+01_r8,0.48341e+01_r8,0.55294e+01_r8,0.56818e+01_r8,0.41697e+01_r8 /) + kbo(:, 2,20,10) = (/ & + & 0.27751e+01_r8,0.50933e+01_r8,0.57470e+01_r8,0.58376e+01_r8,0.43064e+01_r8 /) + kbo(:, 3,20,10) = (/ & + & 0.28895e+01_r8,0.53454e+01_r8,0.60203e+01_r8,0.60166e+01_r8,0.44569e+01_r8 /) + kbo(:, 4,20,10) = (/ & + & 0.30071e+01_r8,0.55962e+01_r8,0.63194e+01_r8,0.62235e+01_r8,0.46038e+01_r8 /) + kbo(:, 5,20,10) = (/ & + & 0.31278e+01_r8,0.58505e+01_r8,0.66184e+01_r8,0.64780e+01_r8,0.47569e+01_r8 /) + kbo(:, 1,21,10) = (/ & + & 0.23601e+01_r8,0.44020e+01_r8,0.49905e+01_r8,0.50776e+01_r8,0.37561e+01_r8 /) + kbo(:, 2,21,10) = (/ & + & 0.24527e+01_r8,0.46408e+01_r8,0.52514e+01_r8,0.52563e+01_r8,0.39021e+01_r8 /) + kbo(:, 3,21,10) = (/ & + & 0.25482e+01_r8,0.48775e+01_r8,0.55424e+01_r8,0.54642e+01_r8,0.40531e+01_r8 /) + kbo(:, 4,21,10) = (/ & + & 0.26469e+01_r8,0.51183e+01_r8,0.58389e+01_r8,0.57185e+01_r8,0.42025e+01_r8 /) + kbo(:, 5,21,10) = (/ & + & 0.27509e+01_r8,0.53673e+01_r8,0.61341e+01_r8,0.60025e+01_r8,0.43477e+01_r8 /) + kbo(:, 1,22,10) = (/ & + & 0.20933e+01_r8,0.40130e+01_r8,0.45530e+01_r8,0.45722e+01_r8,0.33997e+01_r8 /) + kbo(:, 2,22,10) = (/ & + & 0.21774e+01_r8,0.42389e+01_r8,0.48339e+01_r8,0.47801e+01_r8,0.35503e+01_r8 /) + kbo(:, 3,22,10) = (/ & + & 0.22636e+01_r8,0.44688e+01_r8,0.51214e+01_r8,0.50286e+01_r8,0.36916e+01_r8 /) + kbo(:, 4,22,10) = (/ & + & 0.23497e+01_r8,0.47085e+01_r8,0.54112e+01_r8,0.53109e+01_r8,0.38464e+01_r8 /) + kbo(:, 5,22,10) = (/ & + & 0.24400e+01_r8,0.49544e+01_r8,0.57104e+01_r8,0.56159e+01_r8,0.40026e+01_r8 /) + kbo(:, 1,23,10) = (/ & + & 0.18483e+01_r8,0.36572e+01_r8,0.41816e+01_r8,0.41476e+01_r8,0.30773e+01_r8 /) + kbo(:, 2,23,10) = (/ & + & 0.19296e+01_r8,0.38779e+01_r8,0.44582e+01_r8,0.43906e+01_r8,0.32324e+01_r8 /) + kbo(:, 3,23,10) = (/ & + & 0.20105e+01_r8,0.41090e+01_r8,0.47398e+01_r8,0.46676e+01_r8,0.33790e+01_r8 /) + kbo(:, 4,23,10) = (/ & + & 0.20922e+01_r8,0.43460e+01_r8,0.50319e+01_r8,0.49689e+01_r8,0.35381e+01_r8 /) + kbo(:, 5,23,10) = (/ & + & 0.21812e+01_r8,0.45942e+01_r8,0.53379e+01_r8,0.52907e+01_r8,0.36872e+01_r8 /) + kbo(:, 1,24,10) = (/ & + & 0.16291e+01_r8,0.33480e+01_r8,0.38514e+01_r8,0.38051e+01_r8,0.27880e+01_r8 /) + kbo(:, 2,24,10) = (/ & + & 0.17053e+01_r8,0.35635e+01_r8,0.41240e+01_r8,0.40716e+01_r8,0.29407e+01_r8 /) + kbo(:, 3,24,10) = (/ & + & 0.17841e+01_r8,0.37930e+01_r8,0.44076e+01_r8,0.43668e+01_r8,0.31035e+01_r8 /) + kbo(:, 4,24,10) = (/ & + & 0.18670e+01_r8,0.40349e+01_r8,0.47044e+01_r8,0.46831e+01_r8,0.32549e+01_r8 /) + kbo(:, 5,24,10) = (/ & + & 0.19687e+01_r8,0.42837e+01_r8,0.50178e+01_r8,0.50123e+01_r8,0.34093e+01_r8 /) + kbo(:, 1,25,10) = (/ & + & 0.14342e+01_r8,0.30870e+01_r8,0.35616e+01_r8,0.35262e+01_r8,0.25309e+01_r8 /) + kbo(:, 2,25,10) = (/ & + & 0.15073e+01_r8,0.32988e+01_r8,0.38348e+01_r8,0.38083e+01_r8,0.26935e+01_r8 /) + kbo(:, 3,25,10) = (/ & + & 0.15855e+01_r8,0.35267e+01_r8,0.41227e+01_r8,0.41156e+01_r8,0.28544e+01_r8 /) + kbo(:, 4,25,10) = (/ & + & 0.16765e+01_r8,0.37674e+01_r8,0.44270e+01_r8,0.44387e+01_r8,0.30112e+01_r8 /) + kbo(:, 5,25,10) = (/ & + & 0.17969e+01_r8,0.40179e+01_r8,0.47482e+01_r8,0.47807e+01_r8,0.31986e+01_r8 /) + kbo(:, 1,26,10) = (/ & + & 0.12644e+01_r8,0.28734e+01_r8,0.33145e+01_r8,0.33023e+01_r8,0.23207e+01_r8 /) + kbo(:, 2,26,10) = (/ & + & 0.13357e+01_r8,0.30796e+01_r8,0.35932e+01_r8,0.35956e+01_r8,0.24777e+01_r8 /) + kbo(:, 3,26,10) = (/ & + & 0.14174e+01_r8,0.33035e+01_r8,0.38863e+01_r8,0.39081e+01_r8,0.26420e+01_r8 /) + kbo(:, 4,26,10) = (/ & + & 0.15234e+01_r8,0.35430e+01_r8,0.41997e+01_r8,0.42431e+01_r8,0.28241e+01_r8 /) + kbo(:, 5,26,10) = (/ & + & 0.16603e+01_r8,0.37959e+01_r8,0.45341e+01_r8,0.45996e+01_r8,0.30401e+01_r8 /) + kbo(:, 1,27,10) = (/ & + & 0.11180e+01_r8,0.26923e+01_r8,0.31092e+01_r8,0.31181e+01_r8,0.21320e+01_r8 /) + kbo(:, 2,27,10) = (/ & + & 0.11893e+01_r8,0.28981e+01_r8,0.33903e+01_r8,0.34176e+01_r8,0.22961e+01_r8 /) + kbo(:, 3,27,10) = (/ & + & 0.12805e+01_r8,0.31184e+01_r8,0.36930e+01_r8,0.37398e+01_r8,0.24775e+01_r8 /) + kbo(:, 4,27,10) = (/ & + & 0.14017e+01_r8,0.33577e+01_r8,0.40190e+01_r8,0.40909e+01_r8,0.26920e+01_r8 /) + kbo(:, 5,27,10) = (/ & + & 0.15494e+01_r8,0.36148e+01_r8,0.43685e+01_r8,0.44626e+01_r8,0.29161e+01_r8 /) + kbo(:, 1,28,10) = (/ & + & 0.99411e+00_r8,0.25422e+01_r8,0.29403e+01_r8,0.29678e+01_r8,0.19736e+01_r8 /) + kbo(:, 2,28,10) = (/ & + & 0.10693e+01_r8,0.27468e+01_r8,0.32278e+01_r8,0.32747e+01_r8,0.21580e+01_r8 /) + kbo(:, 3,28,10) = (/ & + & 0.11727e+01_r8,0.29677e+01_r8,0.35410e+01_r8,0.36136e+01_r8,0.23718e+01_r8 /) + kbo(:, 4,28,10) = (/ & + & 0.13040e+01_r8,0.32092e+01_r8,0.38816e+01_r8,0.39808e+01_r8,0.25959e+01_r8 /) + kbo(:, 5,28,10) = (/ & + & 0.14604e+01_r8,0.34721e+01_r8,0.42472e+01_r8,0.43708e+01_r8,0.28373e+01_r8 /) + kbo(:, 1,29,10) = (/ & + & 0.89294e+00_r8,0.24188e+01_r8,0.28058e+01_r8,0.28515e+01_r8,0.18636e+01_r8 /) + kbo(:, 2,29,10) = (/ & + & 0.97544e+00_r8,0.26259e+01_r8,0.31039e+01_r8,0.31712e+01_r8,0.20699e+01_r8 /) + kbo(:, 3,29,10) = (/ & + & 0.10880e+01_r8,0.28493e+01_r8,0.34305e+01_r8,0.35278e+01_r8,0.22886e+01_r8 /) + kbo(:, 4,29,10) = (/ & + & 0.12277e+01_r8,0.30947e+01_r8,0.37862e+01_r8,0.39124e+01_r8,0.25256e+01_r8 /) + kbo(:, 5,29,10) = (/ & + & 0.13896e+01_r8,0.33676e+01_r8,0.41685e+01_r8,0.43225e+01_r8,0.27864e+01_r8 /) + kbo(:, 1,30,10) = (/ & + & 0.81230e+00_r8,0.23190e+01_r8,0.27059e+01_r8,0.27666e+01_r8,0.17929e+01_r8 /) + kbo(:, 2,30,10) = (/ & + & 0.90285e+00_r8,0.25306e+01_r8,0.30146e+01_r8,0.31051e+01_r8,0.20049e+01_r8 /) + kbo(:, 3,30,10) = (/ & + & 0.10223e+01_r8,0.27572e+01_r8,0.33560e+01_r8,0.34779e+01_r8,0.22359e+01_r8 /) + kbo(:, 4,30,10) = (/ & + & 0.11675e+01_r8,0.30101e+01_r8,0.37284e+01_r8,0.38827e+01_r8,0.24866e+01_r8 /) + kbo(:, 5,30,10) = (/ & + & 0.13337e+01_r8,0.32968e+01_r8,0.41265e+01_r8,0.43099e+01_r8,0.27369e+01_r8 /) + kbo(:, 1,31,10) = (/ & + & 0.75110e+00_r8,0.22419e+01_r8,0.26379e+01_r8,0.27157e+01_r8,0.17433e+01_r8 /) + kbo(:, 2,31,10) = (/ & + & 0.84809e+00_r8,0.24579e+01_r8,0.29592e+01_r8,0.30730e+01_r8,0.19665e+01_r8 /) + kbo(:, 3,31,10) = (/ & + & 0.97252e+00_r8,0.26914e+01_r8,0.33168e+01_r8,0.34645e+01_r8,0.22008e+01_r8 /) + kbo(:, 4,31,10) = (/ & + & 0.11219e+01_r8,0.29550e+01_r8,0.37069e+01_r8,0.38878e+01_r8,0.24456e+01_r8 /) + kbo(:, 5,31,10) = (/ & + & 0.12926e+01_r8,0.32597e+01_r8,0.41224e+01_r8,0.43304e+01_r8,0.27059e+01_r8 /) + kbo(:, 1,32,10) = (/ & + & 0.70499e+00_r8,0.21846e+01_r8,0.25985e+01_r8,0.26966e+01_r8,0.17143e+01_r8 /) + kbo(:, 2,32,10) = (/ & + & 0.80768e+00_r8,0.24067e+01_r8,0.29356e+01_r8,0.30726e+01_r8,0.19337e+01_r8 /) + kbo(:, 3,32,10) = (/ & + & 0.93561e+00_r8,0.26499e+01_r8,0.33107e+01_r8,0.34825e+01_r8,0.21698e+01_r8 /) + kbo(:, 4,32,10) = (/ & + & 0.10894e+01_r8,0.29281e+01_r8,0.37179e+01_r8,0.39220e+01_r8,0.24264e+01_r8 /) + kbo(:, 5,32,10) = (/ & + & 0.12637e+01_r8,0.32525e+01_r8,0.41500e+01_r8,0.43764e+01_r8,0.26992e+01_r8 /) + kbo(:, 1,33,10) = (/ & + & 0.67118e+00_r8,0.21457e+01_r8,0.25854e+01_r8,0.27057e+01_r8,0.16861e+01_r8 /) + kbo(:, 2,33,10) = (/ & + & 0.77795e+00_r8,0.23758e+01_r8,0.29404e+01_r8,0.30997e+01_r8,0.19111e+01_r8 /) + kbo(:, 3,33,10) = (/ & + & 0.91001e+00_r8,0.26325e+01_r8,0.33337e+01_r8,0.35269e+01_r8,0.21600e+01_r8 /) + kbo(:, 4,33,10) = (/ & + & 0.10674e+01_r8,0.29280e+01_r8,0.37566e+01_r8,0.39787e+01_r8,0.24291e+01_r8 /) + kbo(:, 5,33,10) = (/ & + & 0.12452e+01_r8,0.32737e+01_r8,0.42022e+01_r8,0.44428e+01_r8,0.27130e+01_r8 /) + kbo(:, 1,34,10) = (/ & + & 0.64347e+00_r8,0.21163e+01_r8,0.25854e+01_r8,0.27260e+01_r8,0.16632e+01_r8 /) + kbo(:, 2,34,10) = (/ & + & 0.75313e+00_r8,0.23563e+01_r8,0.29579e+01_r8,0.31342e+01_r8,0.18999e+01_r8 /) + kbo(:, 3,34,10) = (/ & + & 0.88833e+00_r8,0.26269e+01_r8,0.33662e+01_r8,0.35749e+01_r8,0.21605e+01_r8 /) + kbo(:, 4,34,10) = (/ & + & 0.10487e+01_r8,0.29401e+01_r8,0.38003e+01_r8,0.40358e+01_r8,0.24405e+01_r8 /) + kbo(:, 5,34,10) = (/ & + & 0.12301e+01_r8,0.33056e+01_r8,0.42553e+01_r8,0.45073e+01_r8,0.27333e+01_r8 /) + kbo(:, 1,35,10) = (/ & + & 0.61333e+00_r8,0.20804e+01_r8,0.25725e+01_r8,0.27255e+01_r8,0.16337e+01_r8 /) + kbo(:, 2,35,10) = (/ & + & 0.72416e+00_r8,0.23301e+01_r8,0.29566e+01_r8,0.31440e+01_r8,0.18805e+01_r8 /) + kbo(:, 3,35,10) = (/ & + & 0.85987e+00_r8,0.26111e+01_r8,0.33740e+01_r8,0.35934e+01_r8,0.21502e+01_r8 /) + kbo(:, 4,35,10) = (/ & + & 0.10212e+01_r8,0.29378e+01_r8,0.38159e+01_r8,0.40603e+01_r8,0.24378e+01_r8 /) + kbo(:, 5,35,10) = (/ & + & 0.12063e+01_r8,0.33167e+01_r8,0.42768e+01_r8,0.45362e+01_r8,0.27369e+01_r8 /) + kbo(:, 1,36,10) = (/ & + & 0.57858e+00_r8,0.20318e+01_r8,0.25343e+01_r8,0.26932e+01_r8,0.15911e+01_r8 /) + kbo(:, 2,36,10) = (/ & + & 0.68823e+00_r8,0.22888e+01_r8,0.29242e+01_r8,0.31171e+01_r8,0.18445e+01_r8 /) + kbo(:, 3,36,10) = (/ & + & 0.82172e+00_r8,0.25765e+01_r8,0.33460e+01_r8,0.35706e+01_r8,0.21205e+01_r8 /) + kbo(:, 4,36,10) = (/ & + & 0.98227e+00_r8,0.29099e+01_r8,0.37920e+01_r8,0.40410e+01_r8,0.24128e+01_r8 /) + kbo(:, 5,36,10) = (/ & + & 0.11693e+01_r8,0.32947e+01_r8,0.42558e+01_r8,0.45198e+01_r8,0.27160e+01_r8 /) + kbo(:, 1,37,10) = (/ & + & 0.53405e+00_r8,0.19558e+01_r8,0.24506e+01_r8,0.26071e+01_r8,0.15218e+01_r8 /) + kbo(:, 2,37,10) = (/ & + & 0.63968e+00_r8,0.22170e+01_r8,0.28388e+01_r8,0.30310e+01_r8,0.17770e+01_r8 /) + kbo(:, 3,37,10) = (/ & + & 0.76779e+00_r8,0.25049e+01_r8,0.32599e+01_r8,0.34842e+01_r8,0.20552e+01_r8 /) + kbo(:, 4,37,10) = (/ & + & 0.92384e+00_r8,0.28358e+01_r8,0.37058e+01_r8,0.39557e+01_r8,0.23490e+01_r8 /) + kbo(:, 5,37,10) = (/ & + & 0.11094e+01_r8,0.32175e+01_r8,0.41691e+01_r8,0.44348e+01_r8,0.26544e+01_r8 /) + kbo(:, 1,38,10) = (/ & + & 0.49328e+00_r8,0.18861e+01_r8,0.23724e+01_r8,0.25236e+01_r8,0.14577e+01_r8 /) + kbo(:, 2,38,10) = (/ & + & 0.59575e+00_r8,0.21506e+01_r8,0.27570e+01_r8,0.29471e+01_r8,0.17138e+01_r8 /) + kbo(:, 3,38,10) = (/ & + & 0.71877e+00_r8,0.24381e+01_r8,0.31760e+01_r8,0.33985e+01_r8,0.19934e+01_r8 /) + kbo(:, 4,38,10) = (/ & + & 0.87044e+00_r8,0.27651e+01_r8,0.36203e+01_r8,0.38701e+01_r8,0.22879e+01_r8 /) + kbo(:, 5,38,10) = (/ & + & 0.10541e+01_r8,0.31424e+01_r8,0.40835e+01_r8,0.43497e+01_r8,0.25942e+01_r8 /) + kbo(:, 1,39,10) = (/ & + & 0.45633e+00_r8,0.18232e+01_r8,0.23004e+01_r8,0.24453e+01_r8,0.13998e+01_r8 /) + kbo(:, 2,39,10) = (/ & + & 0.55664e+00_r8,0.20902e+01_r8,0.26810e+01_r8,0.28682e+01_r8,0.16563e+01_r8 /) + kbo(:, 3,39,10) = (/ & + & 0.67511e+00_r8,0.23775e+01_r8,0.30973e+01_r8,0.33174e+01_r8,0.19363e+01_r8 /) + kbo(:, 4,39,10) = (/ & + & 0.82312e+00_r8,0.27002e+01_r8,0.35399e+01_r8,0.37881e+01_r8,0.22310e+01_r8 /) + kbo(:, 5,39,10) = (/ & + & 0.10047e+01_r8,0.30719e+01_r8,0.40016e+01_r8,0.42681e+01_r8,0.25376e+01_r8 /) + kbo(:, 1,40,10) = (/ & + & 0.41369e+00_r8,0.17392e+01_r8,0.21979e+01_r8,0.23287e+01_r8,0.13226e+01_r8 /) + kbo(:, 2,40,10) = (/ & + & 0.51051e+00_r8,0.20064e+01_r8,0.25693e+01_r8,0.27492e+01_r8,0.15756e+01_r8 /) + kbo(:, 3,40,10) = (/ & + & 0.62337e+00_r8,0.22909e+01_r8,0.29791e+01_r8,0.31928e+01_r8,0.18532e+01_r8 /) + kbo(:, 4,40,10) = (/ & + & 0.76463e+00_r8,0.26052e+01_r8,0.34168e+01_r8,0.36603e+01_r8,0.21464e+01_r8 /) + kbo(:, 5,40,10) = (/ & + & 0.94032e+00_r8,0.29656e+01_r8,0.38751e+01_r8,0.41396e+01_r8,0.24517e+01_r8 /) + kbo(:, 1,41,10) = (/ & + & 0.37354e+00_r8,0.16561e+01_r8,0.20963e+01_r8,0.22111e+01_r8,0.12469e+01_r8 /) + kbo(:, 2,41,10) = (/ & + & 0.46665e+00_r8,0.19239e+01_r8,0.24587e+01_r8,0.26289e+01_r8,0.14959e+01_r8 /) + kbo(:, 3,41,10) = (/ & + & 0.57545e+00_r8,0.22047e+01_r8,0.28597e+01_r8,0.30659e+01_r8,0.17694e+01_r8 /) + kbo(:, 4,41,10) = (/ & + & 0.70985e+00_r8,0.25106e+01_r8,0.32912e+01_r8,0.35291e+01_r8,0.20606e+01_r8 /) + kbo(:, 5,41,10) = (/ & + & 0.87840e+00_r8,0.28591e+01_r8,0.37457e+01_r8,0.40073e+01_r8,0.23640e+01_r8 /) + kbo(:, 1,42,10) = (/ & + & 0.33676e+00_r8,0.15772e+01_r8,0.19999e+01_r8,0.20973e+01_r8,0.11755e+01_r8 /) + kbo(:, 2,42,10) = (/ & + & 0.42603e+00_r8,0.18429e+01_r8,0.23518e+01_r8,0.25105e+01_r8,0.14196e+01_r8 /) + kbo(:, 3,42,10) = (/ & + & 0.53169e+00_r8,0.21211e+01_r8,0.27440e+01_r8,0.29424e+01_r8,0.16886e+01_r8 /) + kbo(:, 4,42,10) = (/ & + & 0.65992e+00_r8,0.24200e+01_r8,0.31691e+01_r8,0.34004e+01_r8,0.19770e+01_r8 /) + kbo(:, 5,42,10) = (/ & + & 0.82123e+00_r8,0.27572e+01_r8,0.36189e+01_r8,0.38764e+01_r8,0.22780e+01_r8 /) + kbo(:, 1,43,10) = (/ & + & 0.29880e+00_r8,0.14855e+01_r8,0.18883e+01_r8,0.19649e+01_r8,0.10947e+01_r8 /) + kbo(:, 2,43,10) = (/ & + & 0.38323e+00_r8,0.17495e+01_r8,0.22289e+01_r8,0.23704e+01_r8,0.13324e+01_r8 /) + kbo(:, 3,43,10) = (/ & + & 0.48519e+00_r8,0.20243e+01_r8,0.26093e+01_r8,0.27970e+01_r8,0.15948e+01_r8 /) + kbo(:, 4,43,10) = (/ & + & 0.60690e+00_r8,0.23164e+01_r8,0.30260e+01_r8,0.32477e+01_r8,0.18788e+01_r8 /) + kbo(:, 5,43,10) = (/ & + & 0.75876e+00_r8,0.26404e+01_r8,0.34692e+01_r8,0.37199e+01_r8,0.21767e+01_r8 /) + kbo(:, 1,44,10) = (/ & + & 0.26234e+00_r8,0.13896e+01_r8,0.17735e+01_r8,0.18283e+01_r8,0.10125e+01_r8 /) + kbo(:, 2,44,10) = (/ & + & 0.34133e+00_r8,0.16516e+01_r8,0.21029e+01_r8,0.22231e+01_r8,0.12426e+01_r8 /) + kbo(:, 3,44,10) = (/ & + & 0.43896e+00_r8,0.19234e+01_r8,0.24698e+01_r8,0.26446e+01_r8,0.14975e+01_r8 /) + kbo(:, 4,44,10) = (/ & + & 0.55556e+00_r8,0.22104e+01_r8,0.28764e+01_r8,0.30872e+01_r8,0.17758e+01_r8 /) + kbo(:, 5,44,10) = (/ & + & 0.69720e+00_r8,0.25211e+01_r8,0.33108e+01_r8,0.35530e+01_r8,0.20699e+01_r8 /) + kbo(:, 1,45,10) = (/ & + & 0.22932e+00_r8,0.12967e+01_r8,0.16617e+01_r8,0.16976e+01_r8,0.93402e+00_r8 /) + kbo(:, 2,45,10) = (/ & + & 0.30290e+00_r8,0.15560e+01_r8,0.19824e+01_r8,0.20804e+01_r8,0.11566e+01_r8 /) + kbo(:, 3,45,10) = (/ & + & 0.39581e+00_r8,0.18251e+01_r8,0.23356e+01_r8,0.24949e+01_r8,0.14039e+01_r8 /) + kbo(:, 4,45,10) = (/ & + & 0.50777e+00_r8,0.21068e+01_r8,0.27305e+01_r8,0.29300e+01_r8,0.16755e+01_r8 /) + kbo(:, 5,45,10) = (/ & + & 0.64060e+00_r8,0.24073e+01_r8,0.31565e+01_r8,0.33892e+01_r8,0.19653e+01_r8 /) + kbo(:, 1,46,10) = (/ & + & 0.19825e+00_r8,0.12020e+01_r8,0.15457e+01_r8,0.15662e+01_r8,0.85464e+00_r8 /) + kbo(:, 2,46,10) = (/ & + & 0.26591e+00_r8,0.14563e+01_r8,0.18595e+01_r8,0.19337e+01_r8,0.10694e+01_r8 /) + kbo(:, 3,46,10) = (/ & + & 0.35343e+00_r8,0.17232e+01_r8,0.22000e+01_r8,0.23390e+01_r8,0.13083e+01_r8 /) + kbo(:, 4,46,10) = (/ & + & 0.46053e+00_r8,0.19999e+01_r8,0.25801e+01_r8,0.27669e+01_r8,0.15716e+01_r8 /) + kbo(:, 5,46,10) = (/ & + & 0.58556e+00_r8,0.22922e+01_r8,0.29962e+01_r8,0.32174e+01_r8,0.18560e+01_r8 /) + kbo(:, 1,47,10) = (/ & + & 0.16836e+00_r8,0.11008e+01_r8,0.14194e+01_r8,0.14270e+01_r8,0.77061e+00_r8 /) + kbo(:, 2,47,10) = (/ & + & 0.22922e+00_r8,0.13473e+01_r8,0.17277e+01_r8,0.17767e+01_r8,0.97668e+00_r8 /) + kbo(:, 3,47,10) = (/ & + & 0.31004e+00_r8,0.16106e+01_r8,0.20551e+01_r8,0.21688e+01_r8,0.12060e+01_r8 /) + kbo(:, 4,47,10) = (/ & + & 0.41110e+00_r8,0.18840e+01_r8,0.24189e+01_r8,0.25893e+01_r8,0.14598e+01_r8 /) + kbo(:, 5,47,10) = (/ & + & 0.52932e+00_r8,0.21690e+01_r8,0.28216e+01_r8,0.30298e+01_r8,0.17368e+01_r8 /) + kbo(:, 1,48,10) = (/ & + & 0.14220e+00_r8,0.10041e+01_r8,0.12957e+01_r8,0.12963e+01_r8,0.69114e+00_r8 /) + kbo(:, 2,48,10) = (/ & + & 0.19626e+00_r8,0.12419e+01_r8,0.15985e+01_r8,0.16273e+01_r8,0.88794e+00_r8 /) + kbo(:, 3,48,10) = (/ & + & 0.27002e+00_r8,0.15006e+01_r8,0.19169e+01_r8,0.20039e+01_r8,0.11083e+01_r8 /) + kbo(:, 4,48,10) = (/ & + & 0.36488e+00_r8,0.17700e+01_r8,0.22644e+01_r8,0.24151e+01_r8,0.13523e+01_r8 /) + kbo(:, 5,48,10) = (/ & + & 0.47701e+00_r8,0.20494e+01_r8,0.26525e+01_r8,0.28466e+01_r8,0.16205e+01_r8 /) + kbo(:, 1,49,10) = (/ & + & 0.11950e+00_r8,0.91234e+00_r8,0.11755e+01_r8,0.11741e+01_r8,0.61611e+00_r8 /) + kbo(:, 2,49,10) = (/ & + & 0.16698e+00_r8,0.11406e+01_r8,0.14723e+01_r8,0.14860e+01_r8,0.80337e+00_r8 /) + kbo(:, 3,49,10) = (/ & + & 0.23352e+00_r8,0.13921e+01_r8,0.17842e+01_r8,0.18450e+01_r8,0.10147e+01_r8 /) + kbo(:, 4,49,10) = (/ & + & 0.32154e+00_r8,0.16580e+01_r8,0.21177e+01_r8,0.22439e+01_r8,0.12490e+01_r8 /) + kbo(:, 5,49,10) = (/ & + & 0.42774e+00_r8,0.19330e+01_r8,0.24891e+01_r8,0.26683e+01_r8,0.15078e+01_r8 /) + kbo(:, 1,50,10) = (/ & + & 0.10087e+00_r8,0.83065e+00_r8,0.10669e+01_r8,0.10674e+01_r8,0.54936e+00_r8 /) + kbo(:, 2,50,10) = (/ & + & 0.14237e+00_r8,0.10490e+01_r8,0.13561e+01_r8,0.13605e+01_r8,0.72778e+00_r8 /) + kbo(:, 3,50,10) = (/ & + & 0.20234e+00_r8,0.12926e+01_r8,0.16630e+01_r8,0.17021e+01_r8,0.93055e+00_r8 /) + kbo(:, 4,50,10) = (/ & + & 0.28362e+00_r8,0.15546e+01_r8,0.19861e+01_r8,0.20879e+01_r8,0.11563e+01_r8 /) + kbo(:, 5,50,10) = (/ & + & 0.38392e+00_r8,0.18265e+01_r8,0.23423e+01_r8,0.25044e+01_r8,0.14058e+01_r8 /) + kbo(:, 1,51,10) = (/ & + & 0.85305e-01_r8,0.75516e+00_r8,0.96600e+00_r8,0.96989e+00_r8,0.48900e+00_r8 /) + kbo(:, 2,51,10) = (/ & + & 0.12119e+00_r8,0.96396e+00_r8,0.12458e+01_r8,0.12458e+01_r8,0.65803e+00_r8 /) + kbo(:, 3,51,10) = (/ & + & 0.17492e+00_r8,0.11993e+01_r8,0.15474e+01_r8,0.15706e+01_r8,0.85222e+00_r8 /) + kbo(:, 4,51,10) = (/ & + & 0.24953e+00_r8,0.14559e+01_r8,0.18635e+01_r8,0.19410e+01_r8,0.10697e+01_r8 /) + kbo(:, 5,51,10) = (/ & + & 0.34420e+00_r8,0.17250e+01_r8,0.22062e+01_r8,0.23483e+01_r8,0.13105e+01_r8 /) + kbo(:, 1,52,10) = (/ & + & 0.72122e-01_r8,0.68398e+00_r8,0.87088e+00_r8,0.87737e+00_r8,0.43154e+00_r8 /) + kbo(:, 2,52,10) = (/ & + & 0.10277e+00_r8,0.88315e+00_r8,0.11388e+01_r8,0.11383e+01_r8,0.59136e+00_r8 /) + kbo(:, 3,52,10) = (/ & + & 0.15043e+00_r8,0.11094e+01_r8,0.14345e+01_r8,0.14453e+01_r8,0.77736e+00_r8 /) + kbo(:, 4,52,10) = (/ & + & 0.21816e+00_r8,0.13587e+01_r8,0.17451e+01_r8,0.17993e+01_r8,0.98663e+00_r8 /) + kbo(:, 5,52,10) = (/ & + & 0.30639e+00_r8,0.16242e+01_r8,0.20759e+01_r8,0.21951e+01_r8,0.12188e+01_r8 /) + kbo(:, 1,53,10) = (/ & + & 0.60992e-01_r8,0.61681e+00_r8,0.78096e+00_r8,0.78801e+00_r8,0.37771e+00_r8 /) + kbo(:, 2,53,10) = (/ & + & 0.86893e-01_r8,0.80591e+00_r8,0.10354e+01_r8,0.10374e+01_r8,0.52892e+00_r8 /) + kbo(:, 3,53,10) = (/ & + & 0.12844e+00_r8,0.10223e+01_r8,0.13228e+01_r8,0.13263e+01_r8,0.70557e+00_r8 /) + kbo(:, 4,53,10) = (/ & + & 0.18962e+00_r8,0.12639e+01_r8,0.16288e+01_r8,0.16633e+01_r8,0.90648e+00_r8 /) + kbo(:, 5,53,10) = (/ & + & 0.27104e+00_r8,0.15253e+01_r8,0.19505e+01_r8,0.20457e+01_r8,0.11304e+01_r8 /) + kbo(:, 1,54,10) = (/ & + & 0.52146e-01_r8,0.55862e+00_r8,0.70341e+00_r8,0.70953e+00_r8,0.33141e+00_r8 /) + kbo(:, 2,54,10) = (/ & + & 0.74252e-01_r8,0.73817e+00_r8,0.94468e+00_r8,0.94968e+00_r8,0.47420e+00_r8 /) + kbo(:, 3,54,10) = (/ & + & 0.11046e+00_r8,0.94583e+00_r8,0.12229e+01_r8,0.12232e+01_r8,0.64224e+00_r8 /) + kbo(:, 4,54,10) = (/ & + & 0.16584e+00_r8,0.11796e+01_r8,0.15239e+01_r8,0.15447e+01_r8,0.83594e+00_r8 /) + kbo(:, 5,54,10) = (/ & + & 0.24084e+00_r8,0.14356e+01_r8,0.18395e+01_r8,0.19125e+01_r8,0.10521e+01_r8 /) + kbo(:, 1,55,10) = (/ & + & 0.44769e-01_r8,0.50580e+00_r8,0.63367e+00_r8,0.63830e+00_r8,0.29171e+00_r8 /) + kbo(:, 2,55,10) = (/ & + & 0.63801e-01_r8,0.67695e+00_r8,0.86251e+00_r8,0.86950e+00_r8,0.42385e+00_r8 /) + kbo(:, 3,55,10) = (/ & + & 0.95281e-01_r8,0.87561e+00_r8,0.11296e+01_r8,0.11298e+01_r8,0.58465e+00_r8 /) + kbo(:, 4,55,10) = (/ & + & 0.14509e+00_r8,0.11012e+01_r8,0.14250e+01_r8,0.14355e+01_r8,0.77056e+00_r8 /) + kbo(:, 5,55,10) = (/ & + & 0.21402e+00_r8,0.13506e+01_r8,0.17360e+01_r8,0.17888e+01_r8,0.97966e+00_r8 /) + kbo(:, 1,56,10) = (/ & + & 0.38303e-01_r8,0.45495e+00_r8,0.56826e+00_r8,0.57046e+00_r8,0.25591e+00_r8 /) + kbo(:, 2,56,10) = (/ & + & 0.54762e-01_r8,0.61846e+00_r8,0.78411e+00_r8,0.79150e+00_r8,0.37700e+00_r8 /) + kbo(:, 3,56,10) = (/ & + & 0.82009e-01_r8,0.80830e+00_r8,0.10394e+01_r8,0.10417e+01_r8,0.52950e+00_r8 /) + kbo(:, 4,56,10) = (/ & + & 0.12621e+00_r8,0.10253e+01_r8,0.13275e+01_r8,0.13316e+01_r8,0.70721e+00_r8 /) + kbo(:, 5,56,10) = (/ & + & 0.18937e+00_r8,0.12680e+01_r8,0.16344e+01_r8,0.16700e+01_r8,0.90979e+00_r8 /) + kbo(:, 1,57,10) = (/ & + & 0.32632e-01_r8,0.40611e+00_r8,0.50731e+00_r8,0.50659e+00_r8,0.22496e+00_r8 /) + kbo(:, 2,57,10) = (/ & + & 0.47019e-01_r8,0.56304e+00_r8,0.71002e+00_r8,0.71651e+00_r8,0.33305e+00_r8 /) + kbo(:, 3,57,10) = (/ & + & 0.70456e-01_r8,0.74361e+00_r8,0.95266e+00_r8,0.95775e+00_r8,0.47635e+00_r8 /) + kbo(:, 4,57,10) = (/ & + & 0.10937e+00_r8,0.95229e+00_r8,0.12322e+01_r8,0.12329e+01_r8,0.64711e+00_r8 /) + kbo(:, 5,57,10) = (/ & + & 0.16675e+00_r8,0.11875e+01_r8,0.15342e+01_r8,0.15565e+01_r8,0.84216e+00_r8 /) + kbo(:, 1,58,10) = (/ & + & 0.27856e-01_r8,0.36188e+00_r8,0.45369e+00_r8,0.45016e+00_r8,0.19835e+00_r8 /) + kbo(:, 2,58,10) = (/ & + & 0.40581e-01_r8,0.51273e+00_r8,0.64353e+00_r8,0.64865e+00_r8,0.29546e+00_r8 /) + kbo(:, 3,58,10) = (/ & + & 0.60914e-01_r8,0.68524e+00_r8,0.87436e+00_r8,0.88146e+00_r8,0.42903e+00_r8 /) + kbo(:, 4,58,10) = (/ & + & 0.95154e-01_r8,0.88582e+00_r8,0.11439e+01_r8,0.11441e+01_r8,0.59161e+00_r8 /) + kbo(:, 5,58,10) = (/ & + & 0.14715e+00_r8,0.11133e+01_r8,0.14407e+01_r8,0.14528e+01_r8,0.77938e+00_r8 /) + kbo(:, 1,59,10) = (/ & + & 0.25371e-01_r8,0.34461e+00_r8,0.43295e+00_r8,0.42860e+00_r8,0.18805e+00_r8 /) + kbo(:, 2,59,10) = (/ & + & 0.37551e-01_r8,0.49296e+00_r8,0.61778e+00_r8,0.62208e+00_r8,0.28092e+00_r8 /) + kbo(:, 3,59,10) = (/ & + & 0.57031e-01_r8,0.66239e+00_r8,0.84380e+00_r8,0.85137e+00_r8,0.40984e+00_r8 /) + kbo(:, 4,59,10) = (/ & + & 0.89730e-01_r8,0.85967e+00_r8,0.11090e+01_r8,0.11096e+01_r8,0.56882e+00_r8 /) + kbo(:, 5,59,10) = (/ & + & 0.13959e+00_r8,0.10839e+01_r8,0.14035e+01_r8,0.14125e+01_r8,0.75487e+00_r8 /) + kbo(:, 1,13,11) = (/ & + & 0.13518e+02_r8,0.19426e+02_r8,0.21368e+02_r8,0.20607e+02_r8,0.15967e+02_r8 /) + kbo(:, 2,13,11) = (/ & + & 0.13249e+02_r8,0.19278e+02_r8,0.21345e+02_r8,0.20725e+02_r8,0.16218e+02_r8 /) + kbo(:, 3,13,11) = (/ & + & 0.12991e+02_r8,0.19106e+02_r8,0.21344e+02_r8,0.20838e+02_r8,0.16493e+02_r8 /) + kbo(:, 4,13,11) = (/ & + & 0.12783e+02_r8,0.18953e+02_r8,0.21337e+02_r8,0.20959e+02_r8,0.16769e+02_r8 /) + kbo(:, 5,13,11) = (/ & + & 0.12735e+02_r8,0.18820e+02_r8,0.21328e+02_r8,0.21104e+02_r8,0.16982e+02_r8 /) + kbo(:, 1,14,11) = (/ & + & 0.11504e+02_r8,0.17534e+02_r8,0.19457e+02_r8,0.19131e+02_r8,0.14625e+02_r8 /) + kbo(:, 2,14,11) = (/ & + & 0.11281e+02_r8,0.17396e+02_r8,0.19491e+02_r8,0.19271e+02_r8,0.14939e+02_r8 /) + kbo(:, 3,14,11) = (/ & + & 0.11112e+02_r8,0.17290e+02_r8,0.19527e+02_r8,0.19415e+02_r8,0.15255e+02_r8 /) + kbo(:, 4,14,11) = (/ & + & 0.11115e+02_r8,0.17213e+02_r8,0.19560e+02_r8,0.19580e+02_r8,0.15504e+02_r8 /) + kbo(:, 5,14,11) = (/ & + & 0.11342e+02_r8,0.17139e+02_r8,0.19615e+02_r8,0.19759e+02_r8,0.15706e+02_r8 /) + kbo(:, 1,15,11) = (/ & + & 0.98170e+01_r8,0.15599e+02_r8,0.17627e+02_r8,0.17666e+02_r8,0.13354e+02_r8 /) + kbo(:, 2,15,11) = (/ & + & 0.96747e+01_r8,0.15533e+02_r8,0.17695e+02_r8,0.17842e+02_r8,0.13687e+02_r8 /) + kbo(:, 3,15,11) = (/ & + & 0.96984e+01_r8,0.15502e+02_r8,0.17755e+02_r8,0.18036e+02_r8,0.14004e+02_r8 /) + kbo(:, 4,15,11) = (/ & + & 0.99522e+01_r8,0.15480e+02_r8,0.17829e+02_r8,0.18235e+02_r8,0.14263e+02_r8 /) + kbo(:, 5,15,11) = (/ & + & 0.10344e+02_r8,0.15525e+02_r8,0.17929e+02_r8,0.18418e+02_r8,0.14475e+02_r8 /) + kbo(:, 1,16,11) = (/ & + & 0.84332e+01_r8,0.13806e+02_r8,0.15926e+02_r8,0.16215e+02_r8,0.12224e+02_r8 /) + kbo(:, 2,16,11) = (/ & + & 0.84583e+01_r8,0.13805e+02_r8,0.16021e+02_r8,0.16437e+02_r8,0.12556e+02_r8 /) + kbo(:, 3,16,11) = (/ & + & 0.87066e+01_r8,0.13823e+02_r8,0.16108e+02_r8,0.16660e+02_r8,0.12834e+02_r8 /) + kbo(:, 4,16,11) = (/ & + & 0.90827e+01_r8,0.13924e+02_r8,0.16226e+02_r8,0.16883e+02_r8,0.13078e+02_r8 /) + kbo(:, 5,16,11) = (/ & + & 0.95263e+01_r8,0.14156e+02_r8,0.16382e+02_r8,0.17079e+02_r8,0.13334e+02_r8 /) + kbo(:, 1,17,11) = (/ & + & 0.73068e+01_r8,0.12252e+02_r8,0.14341e+02_r8,0.14810e+02_r8,0.11129e+02_r8 /) + kbo(:, 2,17,11) = (/ & + & 0.75295e+01_r8,0.12291e+02_r8,0.14463e+02_r8,0.15052e+02_r8,0.11439e+02_r8 /) + kbo(:, 3,17,11) = (/ & + & 0.78853e+01_r8,0.12405e+02_r8,0.14606e+02_r8,0.15309e+02_r8,0.11729e+02_r8 /) + kbo(:, 4,17,11) = (/ & + & 0.83040e+01_r8,0.12643e+02_r8,0.14776e+02_r8,0.15548e+02_r8,0.12006e+02_r8 /) + kbo(:, 5,17,11) = (/ & + & 0.87123e+01_r8,0.13039e+02_r8,0.14982e+02_r8,0.15762e+02_r8,0.12286e+02_r8 /) + kbo(:, 1,18,11) = (/ & + & 0.64287e+01_r8,0.10933e+02_r8,0.12879e+02_r8,0.13451e+02_r8,0.10053e+02_r8 /) + kbo(:, 2,18,11) = (/ & + & 0.67446e+01_r8,0.11039e+02_r8,0.13041e+02_r8,0.13740e+02_r8,0.10377e+02_r8 /) + kbo(:, 3,18,11) = (/ & + & 0.71271e+01_r8,0.11266e+02_r8,0.13222e+02_r8,0.14018e+02_r8,0.10699e+02_r8 /) + kbo(:, 4,18,11) = (/ & + & 0.75067e+01_r8,0.11650e+02_r8,0.13455e+02_r8,0.14263e+02_r8,0.11011e+02_r8 /) + kbo(:, 5,18,11) = (/ & + & 0.78797e+01_r8,0.12144e+02_r8,0.13766e+02_r8,0.14517e+02_r8,0.11323e+02_r8 /) + kbo(:, 1,19,11) = (/ & + & 0.57165e+01_r8,0.98198e+01_r8,0.11563e+02_r8,0.12210e+02_r8,0.90287e+01_r8 /) + kbo(:, 2,19,11) = (/ & + & 0.60504e+01_r8,0.10030e+02_r8,0.11759e+02_r8,0.12511e+02_r8,0.93771e+01_r8 /) + kbo(:, 3,19,11) = (/ & + & 0.63872e+01_r8,0.10390e+02_r8,0.12004e+02_r8,0.12787e+02_r8,0.97382e+01_r8 /) + kbo(:, 4,19,11) = (/ & + & 0.67262e+01_r8,0.10858e+02_r8,0.12325e+02_r8,0.13071e+02_r8,0.10100e+02_r8 /) + kbo(:, 5,19,11) = (/ & + & 0.70630e+01_r8,0.11396e+02_r8,0.12720e+02_r8,0.13371e+02_r8,0.10433e+02_r8 /) + kbo(:, 1,20,11) = (/ & + & 0.51077e+01_r8,0.88680e+01_r8,0.10415e+02_r8,0.11053e+02_r8,0.80963e+01_r8 /) + kbo(:, 2,20,11) = (/ & + & 0.54017e+01_r8,0.92107e+01_r8,0.10662e+02_r8,0.11361e+02_r8,0.84758e+01_r8 /) + kbo(:, 3,20,11) = (/ & + & 0.57015e+01_r8,0.96698e+01_r8,0.10982e+02_r8,0.11668e+02_r8,0.88481e+01_r8 /) + kbo(:, 4,20,11) = (/ & + & 0.60041e+01_r8,0.10196e+02_r8,0.11384e+02_r8,0.12000e+02_r8,0.92376e+01_r8 /) + kbo(:, 5,20,11) = (/ & + & 0.63106e+01_r8,0.10732e+02_r8,0.11884e+02_r8,0.12349e+02_r8,0.96255e+01_r8 /) + kbo(:, 1,21,11) = (/ & + & 0.45414e+01_r8,0.80841e+01_r8,0.94333e+01_r8,0.10001e+02_r8,0.72987e+01_r8 /) + kbo(:, 2,21,11) = (/ & + & 0.48060e+01_r8,0.85169e+01_r8,0.97399e+01_r8,0.10324e+02_r8,0.76799e+01_r8 /) + kbo(:, 3,21,11) = (/ & + & 0.50754e+01_r8,0.90311e+01_r8,0.10134e+02_r8,0.10673e+02_r8,0.80692e+01_r8 /) + kbo(:, 4,21,11) = (/ & + & 0.53489e+01_r8,0.95660e+01_r8,0.10626e+02_r8,0.11046e+02_r8,0.84671e+01_r8 /) + kbo(:, 5,21,11) = (/ & + & 0.56226e+01_r8,0.10100e+02_r8,0.11188e+02_r8,0.11467e+02_r8,0.88878e+01_r8 /) + kbo(:, 1,22,11) = (/ & + & 0.40512e+01_r8,0.74537e+01_r8,0.86113e+01_r8,0.90760e+01_r8,0.66406e+01_r8 /) + kbo(:, 2,22,11) = (/ & + & 0.42861e+01_r8,0.79455e+01_r8,0.89988e+01_r8,0.94326e+01_r8,0.70298e+01_r8 /) + kbo(:, 3,22,11) = (/ & + & 0.45284e+01_r8,0.84723e+01_r8,0.94806e+01_r8,0.98282e+01_r8,0.74365e+01_r8 /) + kbo(:, 4,22,11) = (/ & + & 0.47765e+01_r8,0.90022e+01_r8,0.10036e+02_r8,0.10267e+02_r8,0.78530e+01_r8 /) + kbo(:, 5,22,11) = (/ & + & 0.50273e+01_r8,0.95375e+01_r8,0.10644e+02_r8,0.10762e+02_r8,0.82925e+01_r8 /) + kbo(:, 1,23,11) = (/ & + & 0.36272e+01_r8,0.69345e+01_r8,0.79292e+01_r8,0.82821e+01_r8,0.60862e+01_r8 /) + kbo(:, 2,23,11) = (/ & + & 0.38324e+01_r8,0.74412e+01_r8,0.84058e+01_r8,0.86779e+01_r8,0.64814e+01_r8 /) + kbo(:, 3,23,11) = (/ & + & 0.40496e+01_r8,0.79556e+01_r8,0.89497e+01_r8,0.91277e+01_r8,0.69031e+01_r8 /) + kbo(:, 4,23,11) = (/ & + & 0.42736e+01_r8,0.84881e+01_r8,0.95512e+01_r8,0.96353e+01_r8,0.73423e+01_r8 /) + kbo(:, 5,23,11) = (/ & + & 0.45008e+01_r8,0.90231e+01_r8,0.10199e+02_r8,0.10196e+02_r8,0.78107e+01_r8 /) + kbo(:, 1,24,11) = (/ & + & 0.32617e+01_r8,0.64927e+01_r8,0.73814e+01_r8,0.76204e+01_r8,0.56351e+01_r8 /) + kbo(:, 2,24,11) = (/ & + & 0.34455e+01_r8,0.69864e+01_r8,0.79146e+01_r8,0.80668e+01_r8,0.60482e+01_r8 /) + kbo(:, 3,24,11) = (/ & + & 0.36375e+01_r8,0.74982e+01_r8,0.85124e+01_r8,0.85688e+01_r8,0.64793e+01_r8 /) + kbo(:, 4,24,11) = (/ & + & 0.38361e+01_r8,0.80253e+01_r8,0.91530e+01_r8,0.91384e+01_r8,0.69488e+01_r8 /) + kbo(:, 5,24,11) = (/ & + & 0.40434e+01_r8,0.85770e+01_r8,0.98249e+01_r8,0.97701e+01_r8,0.74392e+01_r8 /) + kbo(:, 1,25,11) = (/ & + & 0.29504e+01_r8,0.60996e+01_r8,0.69378e+01_r8,0.70933e+01_r8,0.52696e+01_r8 /) + kbo(:, 2,25,11) = (/ & + & 0.31134e+01_r8,0.65859e+01_r8,0.75193e+01_r8,0.75874e+01_r8,0.56908e+01_r8 /) + kbo(:, 3,25,11) = (/ & + & 0.32850e+01_r8,0.70991e+01_r8,0.81583e+01_r8,0.81455e+01_r8,0.61504e+01_r8 /) + kbo(:, 4,25,11) = (/ & + & 0.34639e+01_r8,0.76357e+01_r8,0.88289e+01_r8,0.87766e+01_r8,0.66391e+01_r8 /) + kbo(:, 5,25,11) = (/ & + & 0.36575e+01_r8,0.82031e+01_r8,0.95335e+01_r8,0.94728e+01_r8,0.71181e+01_r8 /) + kbo(:, 1,26,11) = (/ & + & 0.26785e+01_r8,0.57592e+01_r8,0.65944e+01_r8,0.66793e+01_r8,0.49659e+01_r8 /) + kbo(:, 2,26,11) = (/ & + & 0.28303e+01_r8,0.62512e+01_r8,0.72180e+01_r8,0.72292e+01_r8,0.54158e+01_r8 /) + kbo(:, 3,26,11) = (/ & + & 0.29845e+01_r8,0.67700e+01_r8,0.78853e+01_r8,0.78517e+01_r8,0.58929e+01_r8 /) + kbo(:, 4,26,11) = (/ & + & 0.31498e+01_r8,0.73218e+01_r8,0.85892e+01_r8,0.85405e+01_r8,0.63779e+01_r8 /) + kbo(:, 5,26,11) = (/ & + & 0.33365e+01_r8,0.79095e+01_r8,0.93260e+01_r8,0.92876e+01_r8,0.68593e+01_r8 /) + kbo(:, 1,27,11) = (/ & + & 0.24381e+01_r8,0.54719e+01_r8,0.63296e+01_r8,0.63699e+01_r8,0.47378e+01_r8 /) + kbo(:, 2,27,11) = (/ & + & 0.25833e+01_r8,0.59706e+01_r8,0.69839e+01_r8,0.69809e+01_r8,0.52024e+01_r8 /) + kbo(:, 3,27,11) = (/ & + & 0.27276e+01_r8,0.65032e+01_r8,0.76823e+01_r8,0.76623e+01_r8,0.56849e+01_r8 /) + kbo(:, 4,27,11) = (/ & + & 0.28843e+01_r8,0.70768e+01_r8,0.84223e+01_r8,0.83973e+01_r8,0.61613e+01_r8 /) + kbo(:, 5,27,11) = (/ & + & 0.30776e+01_r8,0.76837e+01_r8,0.91929e+01_r8,0.91871e+01_r8,0.66697e+01_r8 /) + kbo(:, 1,28,11) = (/ & + & 0.22238e+01_r8,0.52366e+01_r8,0.61335e+01_r8,0.61574e+01_r8,0.45705e+01_r8 /) + kbo(:, 2,28,11) = (/ & + & 0.23648e+01_r8,0.57451e+01_r8,0.68151e+01_r8,0.68266e+01_r8,0.50347e+01_r8 /) + kbo(:, 3,28,11) = (/ & + & 0.25067e+01_r8,0.62980e+01_r8,0.75460e+01_r8,0.75548e+01_r8,0.55064e+01_r8 /) + kbo(:, 4,28,11) = (/ & + & 0.26680e+01_r8,0.68930e+01_r8,0.83223e+01_r8,0.83308e+01_r8,0.60103e+01_r8 /) + kbo(:, 5,28,11) = (/ & + & 0.28763e+01_r8,0.75234e+01_r8,0.91269e+01_r8,0.91547e+01_r8,0.65443e+01_r8 /) + kbo(:, 1,29,11) = (/ & + & 0.20343e+01_r8,0.50540e+01_r8,0.60021e+01_r8,0.60360e+01_r8,0.44306e+01_r8 /) + kbo(:, 2,29,11) = (/ & + & 0.21732e+01_r8,0.55785e+01_r8,0.67134e+01_r8,0.67544e+01_r8,0.48924e+01_r8 /) + kbo(:, 3,29,11) = (/ & + & 0.23217e+01_r8,0.61554e+01_r8,0.74828e+01_r8,0.75217e+01_r8,0.53899e+01_r8 /) + kbo(:, 4,29,11) = (/ & + & 0.24991e+01_r8,0.67727e+01_r8,0.82943e+01_r8,0.83341e+01_r8,0.59211e+01_r8 /) + kbo(:, 5,29,11) = (/ & + & 0.27298e+01_r8,0.74309e+01_r8,0.91294e+01_r8,0.91877e+01_r8,0.64776e+01_r8 /) + kbo(:, 1,30,11) = (/ & + & 0.18678e+01_r8,0.49203e+01_r8,0.59291e+01_r8,0.59875e+01_r8,0.43204e+01_r8 /) + kbo(:, 2,30,11) = (/ & + & 0.20102e+01_r8,0.54667e+01_r8,0.66747e+01_r8,0.67430e+01_r8,0.48026e+01_r8 /) + kbo(:, 3,30,11) = (/ & + & 0.21719e+01_r8,0.60682e+01_r8,0.74827e+01_r8,0.75477e+01_r8,0.53281e+01_r8 /) + kbo(:, 4,30,11) = (/ & + & 0.23720e+01_r8,0.67126e+01_r8,0.83252e+01_r8,0.83910e+01_r8,0.58826e+01_r8 /) + kbo(:, 5,30,11) = (/ & + & 0.26264e+01_r8,0.73977e+01_r8,0.91870e+01_r8,0.92723e+01_r8,0.64598e+01_r8 /) + kbo(:, 1,31,11) = (/ & + & 0.17244e+01_r8,0.48370e+01_r8,0.59156e+01_r8,0.60001e+01_r8,0.42555e+01_r8 /) + kbo(:, 2,31,11) = (/ & + & 0.18755e+01_r8,0.54107e+01_r8,0.66999e+01_r8,0.67904e+01_r8,0.47644e+01_r8 /) + kbo(:, 3,31,11) = (/ & + & 0.20573e+01_r8,0.60363e+01_r8,0.75402e+01_r8,0.76274e+01_r8,0.53155e+01_r8 /) + kbo(:, 4,31,11) = (/ & + & 0.22829e+01_r8,0.67094e+01_r8,0.84079e+01_r8,0.84962e+01_r8,0.58901e+01_r8 /) + kbo(:, 5,31,11) = (/ & + & 0.25590e+01_r8,0.74195e+01_r8,0.92909e+01_r8,0.93994e+01_r8,0.64871e+01_r8 /) + kbo(:, 1,32,11) = (/ & + & 0.16069e+01_r8,0.48030e+01_r8,0.59579e+01_r8,0.60639e+01_r8,0.42356e+01_r8 /) + kbo(:, 2,32,11) = (/ & + & 0.17705e+01_r8,0.54037e+01_r8,0.67788e+01_r8,0.68874e+01_r8,0.47712e+01_r8 /) + kbo(:, 3,32,11) = (/ & + & 0.19742e+01_r8,0.60574e+01_r8,0.76448e+01_r8,0.77491e+01_r8,0.53434e+01_r8 /) + kbo(:, 4,32,11) = (/ & + & 0.22247e+01_r8,0.67560e+01_r8,0.85310e+01_r8,0.86385e+01_r8,0.59381e+01_r8 /) + kbo(:, 5,32,11) = (/ & + & 0.25238e+01_r8,0.74880e+01_r8,0.94292e+01_r8,0.95570e+01_r8,0.65497e+01_r8 /) + kbo(:, 1,33,11) = (/ & + & 0.15128e+01_r8,0.48140e+01_r8,0.60501e+01_r8,0.61714e+01_r8,0.42550e+01_r8 /) + kbo(:, 2,33,11) = (/ & + & 0.16946e+01_r8,0.54417e+01_r8,0.69000e+01_r8,0.70212e+01_r8,0.48155e+01_r8 /) + kbo(:, 3,33,11) = (/ & + & 0.19206e+01_r8,0.61213e+01_r8,0.77839e+01_r8,0.79020e+01_r8,0.54069e+01_r8 /) + kbo(:, 4,33,11) = (/ & + & 0.21946e+01_r8,0.68422e+01_r8,0.86827e+01_r8,0.88075e+01_r8,0.60169e+01_r8 /) + kbo(:, 5,33,11) = (/ & + & 0.25173e+01_r8,0.75913e+01_r8,0.95924e+01_r8,0.97373e+01_r8,0.66398e+01_r8 /) + kbo(:, 1,34,11) = (/ & + & 0.14356e+01_r8,0.48418e+01_r8,0.61495e+01_r8,0.62828e+01_r8,0.42896e+01_r8 /) + kbo(:, 2,34,11) = (/ & + & 0.16357e+01_r8,0.54935e+01_r8,0.70184e+01_r8,0.71516e+01_r8,0.48691e+01_r8 /) + kbo(:, 3,34,11) = (/ & + & 0.18838e+01_r8,0.61957e+01_r8,0.79151e+01_r8,0.80457e+01_r8,0.54742e+01_r8 /) + kbo(:, 4,34,11) = (/ & + & 0.21788e+01_r8,0.69325e+01_r8,0.88256e+01_r8,0.89643e+01_r8,0.60956e+01_r8 /) + kbo(:, 5,34,11) = (/ & + & 0.25238e+01_r8,0.76930e+01_r8,0.97439e+01_r8,0.99021e+01_r8,0.67264e+01_r8 /) + kbo(:, 1,35,11) = (/ & + & 0.13620e+01_r8,0.48400e+01_r8,0.61911e+01_r8,0.63341e+01_r8,0.42950e+01_r8 /) + kbo(:, 2,35,11) = (/ & + & 0.15765e+01_r8,0.55077e+01_r8,0.70717e+01_r8,0.72149e+01_r8,0.48872e+01_r8 /) + kbo(:, 3,35,11) = (/ & + & 0.18416e+01_r8,0.62238e+01_r8,0.79778e+01_r8,0.81173e+01_r8,0.55014e+01_r8 /) + kbo(:, 4,35,11) = (/ & + & 0.21528e+01_r8,0.69694e+01_r8,0.88951e+01_r8,0.90430e+01_r8,0.61304e+01_r8 /) + kbo(:, 5,35,11) = (/ & + & 0.25135e+01_r8,0.77370e+01_r8,0.98191e+01_r8,0.99865e+01_r8,0.67662e+01_r8 /) + kbo(:, 1,36,11) = (/ & + & 0.12836e+01_r8,0.47892e+01_r8,0.61549e+01_r8,0.63050e+01_r8,0.42540e+01_r8 /) + kbo(:, 2,36,11) = (/ & + & 0.15070e+01_r8,0.54649e+01_r8,0.70416e+01_r8,0.71923e+01_r8,0.48536e+01_r8 /) + kbo(:, 3,36,11) = (/ & + & 0.17830e+01_r8,0.61872e+01_r8,0.79531e+01_r8,0.80994e+01_r8,0.54734e+01_r8 /) + kbo(:, 4,36,11) = (/ & + & 0.21055e+01_r8,0.69369e+01_r8,0.88745e+01_r8,0.90288e+01_r8,0.61066e+01_r8 /) + kbo(:, 5,36,11) = (/ & + & 0.24754e+01_r8,0.77090e+01_r8,0.98023e+01_r8,0.99759e+01_r8,0.67459e+01_r8 /) + kbo(:, 1,37,11) = (/ & + & 0.11878e+01_r8,0.46541e+01_r8,0.59975e+01_r8,0.61531e+01_r8,0.41357e+01_r8 /) + kbo(:, 2,37,11) = (/ & + & 0.14114e+01_r8,0.53279e+01_r8,0.68836e+01_r8,0.70407e+01_r8,0.47366e+01_r8 /) + kbo(:, 3,37,11) = (/ & + & 0.16907e+01_r8,0.60488e+01_r8,0.77961e+01_r8,0.79492e+01_r8,0.53587e+01_r8 /) + kbo(:, 4,37,11) = (/ & + & 0.20171e+01_r8,0.67987e+01_r8,0.87214e+01_r8,0.88782e+01_r8,0.59931e+01_r8 /) + kbo(:, 5,37,11) = (/ & + & 0.23879e+01_r8,0.75721e+01_r8,0.96505e+01_r8,0.98263e+01_r8,0.66346e+01_r8 /) + kbo(:, 1,38,11) = (/ & + & 0.11019e+01_r8,0.45241e+01_r8,0.58411e+01_r8,0.60015e+01_r8,0.40206e+01_r8 /) + kbo(:, 2,38,11) = (/ & + & 0.13240e+01_r8,0.51938e+01_r8,0.67248e+01_r8,0.68881e+01_r8,0.46215e+01_r8 /) + kbo(:, 3,38,11) = (/ & + & 0.16050e+01_r8,0.59127e+01_r8,0.76377e+01_r8,0.77969e+01_r8,0.52444e+01_r8 /) + kbo(:, 4,38,11) = (/ & + & 0.19344e+01_r8,0.66614e+01_r8,0.85656e+01_r8,0.87241e+01_r8,0.58797e+01_r8 /) + kbo(:, 5,38,11) = (/ & + & 0.23053e+01_r8,0.74352e+01_r8,0.94961e+01_r8,0.96730e+01_r8,0.65232e+01_r8 /) + kbo(:, 1,39,11) = (/ & + & 0.10261e+01_r8,0.44035e+01_r8,0.56925e+01_r8,0.58571e+01_r8,0.39130e+01_r8 /) + kbo(:, 2,39,11) = (/ & + & 0.12458e+01_r8,0.50694e+01_r8,0.65735e+01_r8,0.67411e+01_r8,0.45130e+01_r8 /) + kbo(:, 3,39,11) = (/ & + & 0.15281e+01_r8,0.57844e+01_r8,0.74853e+01_r8,0.76497e+01_r8,0.51353e+01_r8 /) + kbo(:, 4,39,11) = (/ & + & 0.18590e+01_r8,0.65310e+01_r8,0.84139e+01_r8,0.85752e+01_r8,0.57711e+01_r8 /) + kbo(:, 5,39,11) = (/ & + & 0.22296e+01_r8,0.73031e+01_r8,0.93461e+01_r8,0.95233e+01_r8,0.64155e+01_r8 /) + kbo(:, 1,40,11) = (/ & + & 0.94020e+00_r8,0.42252e+01_r8,0.54618e+01_r8,0.56305e+01_r8,0.37514e+01_r8 /) + kbo(:, 2,40,11) = (/ & + & 0.11510e+01_r8,0.48808e+01_r8,0.63359e+01_r8,0.65051e+01_r8,0.43464e+01_r8 /) + kbo(:, 3,40,11) = (/ & + & 0.14267e+01_r8,0.55865e+01_r8,0.72429e+01_r8,0.74116e+01_r8,0.49659e+01_r8 /) + kbo(:, 4,40,11) = (/ & + & 0.17534e+01_r8,0.63284e+01_r8,0.81706e+01_r8,0.83346e+01_r8,0.56004e+01_r8 /) + kbo(:, 5,40,11) = (/ & + & 0.21196e+01_r8,0.70954e+01_r8,0.91038e+01_r8,0.92790e+01_r8,0.62443e+01_r8 /) + kbo(:, 1,41,11) = (/ & + & 0.86129e+00_r8,0.40457e+01_r8,0.52264e+01_r8,0.53976e+01_r8,0.35879e+01_r8 /) + kbo(:, 2,41,11) = (/ & + & 0.10633e+01_r8,0.46915e+01_r8,0.60924e+01_r8,0.62635e+01_r8,0.41768e+01_r8 /) + kbo(:, 3,41,11) = (/ & + & 0.13283e+01_r8,0.53845e+01_r8,0.69926e+01_r8,0.71649e+01_r8,0.47921e+01_r8 /) + kbo(:, 4,41,11) = (/ & + & 0.16485e+01_r8,0.61201e+01_r8,0.79175e+01_r8,0.80844e+01_r8,0.54240e+01_r8 /) + kbo(:, 5,41,11) = (/ & + & 0.20093e+01_r8,0.68812e+01_r8,0.88522e+01_r8,0.90249e+01_r8,0.60668e+01_r8 /) + kbo(:, 1,42,11) = (/ & + & 0.79123e+00_r8,0.38735e+01_r8,0.49960e+01_r8,0.51699e+01_r8,0.34287e+01_r8 /) + kbo(:, 2,42,11) = (/ & + & 0.98295e+00_r8,0.45072e+01_r8,0.58533e+01_r8,0.60254e+01_r8,0.40109e+01_r8 /) + kbo(:, 3,42,11) = (/ & + & 0.12364e+01_r8,0.51876e+01_r8,0.67459e+01_r8,0.69214e+01_r8,0.46212e+01_r8 /) + kbo(:, 4,42,11) = (/ & + & 0.15484e+01_r8,0.59150e+01_r8,0.76665e+01_r8,0.78373e+01_r8,0.52503e+01_r8 /) + kbo(:, 5,42,11) = (/ & + & 0.19026e+01_r8,0.66716e+01_r8,0.86018e+01_r8,0.87728e+01_r8,0.58915e+01_r8 /) + kbo(:, 1,43,11) = (/ & + & 0.71984e+00_r8,0.36729e+01_r8,0.47235e+01_r8,0.48975e+01_r8,0.32397e+01_r8 /) + kbo(:, 2,43,11) = (/ & + & 0.89808e+00_r8,0.42916e+01_r8,0.55697e+01_r8,0.57443e+01_r8,0.38153e+01_r8 /) + kbo(:, 3,43,11) = (/ & + & 0.11360e+01_r8,0.49574e+01_r8,0.64519e+01_r8,0.66289e+01_r8,0.44184e+01_r8 /) + kbo(:, 4,43,11) = (/ & + & 0.14345e+01_r8,0.56728e+01_r8,0.73660e+01_r8,0.75410e+01_r8,0.50437e+01_r8 /) + kbo(:, 5,43,11) = (/ & + & 0.17793e+01_r8,0.64228e+01_r8,0.82999e+01_r8,0.84705e+01_r8,0.56823e+01_r8 /) + kbo(:, 1,44,11) = (/ & + & 0.65285e+00_r8,0.34667e+01_r8,0.44372e+01_r8,0.46082e+01_r8,0.30399e+01_r8 /) + kbo(:, 2,44,11) = (/ & + & 0.81657e+00_r8,0.40674e+01_r8,0.52701e+01_r8,0.54466e+01_r8,0.36094e+01_r8 /) + kbo(:, 3,44,11) = (/ & + & 0.10370e+01_r8,0.47171e+01_r8,0.61405e+01_r8,0.63175e+01_r8,0.42038e+01_r8 /) + kbo(:, 4,44,11) = (/ & + & 0.13194e+01_r8,0.54184e+01_r8,0.70473e+01_r8,0.72248e+01_r8,0.48237e+01_r8 /) + kbo(:, 5,44,11) = (/ & + & 0.16514e+01_r8,0.61584e+01_r8,0.79760e+01_r8,0.81477e+01_r8,0.54581e+01_r8 /) + kbo(:, 1,45,11) = (/ & + & 0.59324e+00_r8,0.32687e+01_r8,0.41610e+01_r8,0.43270e+01_r8,0.28437e+01_r8 /) + kbo(:, 2,45,11) = (/ & + & 0.74292e+00_r8,0.38502e+01_r8,0.49754e+01_r8,0.51525e+01_r8,0.34081e+01_r8 /) + kbo(:, 3,45,11) = (/ & + & 0.94606e+00_r8,0.44838e+01_r8,0.58347e+01_r8,0.60112e+01_r8,0.39932e+01_r8 /) + kbo(:, 4,45,11) = (/ & + & 0.12103e+01_r8,0.51691e+01_r8,0.67312e+01_r8,0.69113e+01_r8,0.46063e+01_r8 /) + kbo(:, 5,45,11) = (/ & + & 0.15283e+01_r8,0.58970e+01_r8,0.76529e+01_r8,0.78283e+01_r8,0.52365e+01_r8 /) + kbo(:, 1,46,11) = (/ & + & 0.53665e+00_r8,0.30665e+01_r8,0.38788e+01_r8,0.40344e+01_r8,0.26396e+01_r8 /) + kbo(:, 2,46,11) = (/ & + & 0.67326e+00_r8,0.36275e+01_r8,0.46685e+01_r8,0.48445e+01_r8,0.31970e+01_r8 /) + kbo(:, 3,46,11) = (/ & + & 0.85964e+00_r8,0.42450e+01_r8,0.55161e+01_r8,0.56940e+01_r8,0.37742e+01_r8 /) + kbo(:, 4,46,11) = (/ & + & 0.11026e+01_r8,0.49112e+01_r8,0.63992e+01_r8,0.65795e+01_r8,0.43785e+01_r8 /) + kbo(:, 5,46,11) = (/ & + & 0.14030e+01_r8,0.56247e+01_r8,0.73128e+01_r8,0.74918e+01_r8,0.50037e+01_r8 /) + kbo(:, 1,47,11) = (/ & + & 0.47965e+00_r8,0.28512e+01_r8,0.35773e+01_r8,0.37190e+01_r8,0.24179e+01_r8 /) + kbo(:, 2,47,11) = (/ & + & 0.60499e+00_r8,0.33895e+01_r8,0.43353e+01_r8,0.45070e+01_r8,0.29653e+01_r8 /) + kbo(:, 3,47,11) = (/ & + & 0.77211e+00_r8,0.39857e+01_r8,0.51656e+01_r8,0.53439e+01_r8,0.35346e+01_r8 /) + kbo(:, 4,47,11) = (/ & + & 0.99280e+00_r8,0.46320e+01_r8,0.60346e+01_r8,0.62138e+01_r8,0.41278e+01_r8 /) + kbo(:, 5,47,11) = (/ & + & 0.12711e+01_r8,0.53272e+01_r8,0.69377e+01_r8,0.71189e+01_r8,0.47464e+01_r8 /) + kbo(:, 1,48,11) = (/ & + & 0.42651e+00_r8,0.26445e+01_r8,0.32894e+01_r8,0.34148e+01_r8,0.22033e+01_r8 /) + kbo(:, 2,48,11) = (/ & + & 0.54388e+00_r8,0.31611e+01_r8,0.40161e+01_r8,0.41791e+01_r8,0.27373e+01_r8 /) + kbo(:, 3,48,11) = (/ & + & 0.69368e+00_r8,0.37347e+01_r8,0.48206e+01_r8,0.49989e+01_r8,0.32997e+01_r8 /) + kbo(:, 4,48,11) = (/ & + & 0.89279e+00_r8,0.43620e+01_r8,0.56767e+01_r8,0.58554e+01_r8,0.38822e+01_r8 /) + kbo(:, 5,48,11) = (/ & + & 0.11484e+01_r8,0.50369e+01_r8,0.65668e+01_r8,0.67495e+01_r8,0.44918e+01_r8 /) + kbo(:, 1,49,11) = (/ & + & 0.37713e+00_r8,0.24439e+01_r8,0.30160e+01_r8,0.31206e+01_r8,0.19976e+01_r8 /) + kbo(:, 2,49,11) = (/ & + & 0.48766e+00_r8,0.29434e+01_r8,0.37104e+01_r8,0.38599e+01_r8,0.25143e+01_r8 /) + kbo(:, 3,49,11) = (/ & + & 0.62407e+00_r8,0.34939e+01_r8,0.44847e+01_r8,0.46596e+01_r8,0.30680e+01_r8 /) + kbo(:, 4,49,11) = (/ & + & 0.80298e+00_r8,0.41006e+01_r8,0.53255e+01_r8,0.55049e+01_r8,0.36413e+01_r8 /) + kbo(:, 5,49,11) = (/ & + & 0.10353e+01_r8,0.47554e+01_r8,0.62010e+01_r8,0.63820e+01_r8,0.42407e+01_r8 /) + kbo(:, 1,50,11) = (/ & + & 0.33334e+00_r8,0.22573e+01_r8,0.27730e+01_r8,0.28537e+01_r8,0.18141e+01_r8 /) + kbo(:, 2,50,11) = (/ & + & 0.43824e+00_r8,0.27477e+01_r8,0.34359e+01_r8,0.35712e+01_r8,0.23112e+01_r8 /) + kbo(:, 3,50,11) = (/ & + & 0.56555e+00_r8,0.32767e+01_r8,0.41807e+01_r8,0.43497e+01_r8,0.28540e+01_r8 /) + kbo(:, 4,50,11) = (/ & + & 0.72662e+00_r8,0.38631e+01_r8,0.50003e+01_r8,0.51798e+01_r8,0.34206e+01_r8 /) + kbo(:, 5,50,11) = (/ & + & 0.93811e+00_r8,0.44998e+01_r8,0.58635e+01_r8,0.60433e+01_r8,0.40092e+01_r8 /) + kbo(:, 1,51,11) = (/ & + & 0.29344e+00_r8,0.20792e+01_r8,0.25493e+01_r8,0.26045e+01_r8,0.16447e+01_r8 /) + kbo(:, 2,51,11) = (/ & + & 0.39320e+00_r8,0.25633e+01_r8,0.31811e+01_r8,0.32996e+01_r8,0.21202e+01_r8 /) + kbo(:, 3,51,11) = (/ & + & 0.51335e+00_r8,0.30739e+01_r8,0.38968e+01_r8,0.40554e+01_r8,0.26493e+01_r8 /) + kbo(:, 4,51,11) = (/ & + & 0.65991e+00_r8,0.36396e+01_r8,0.46910e+01_r8,0.48692e+01_r8,0.32095e+01_r8 /) + kbo(:, 5,51,11) = (/ & + & 0.85305e+00_r8,0.42602e+01_r8,0.55428e+01_r8,0.57227e+01_r8,0.37890e+01_r8 /) + kbo(:, 1,52,11) = (/ & + & 0.25634e+00_r8,0.19065e+01_r8,0.23373e+01_r8,0.23675e+01_r8,0.14849e+01_r8 /) + kbo(:, 2,52,11) = (/ & + & 0.35085e+00_r8,0.23832e+01_r8,0.29380e+01_r8,0.30363e+01_r8,0.19379e+01_r8 /) + kbo(:, 3,52,11) = (/ & + & 0.46463e+00_r8,0.28806e+01_r8,0.36245e+01_r8,0.37705e+01_r8,0.24499e+01_r8 /) + kbo(:, 4,52,11) = (/ & + & 0.60014e+00_r8,0.34247e+01_r8,0.43901e+01_r8,0.45644e+01_r8,0.30013e+01_r8 /) + kbo(:, 5,52,11) = (/ & + & 0.77502e+00_r8,0.40268e+01_r8,0.52264e+01_r8,0.54064e+01_r8,0.35729e+01_r8 /) + kbo(:, 1,53,11) = (/ & + & 0.22198e+00_r8,0.17382e+01_r8,0.21355e+01_r8,0.21443e+01_r8,0.13321e+01_r8 /) + kbo(:, 2,53,11) = (/ & + & 0.31088e+00_r8,0.22037e+01_r8,0.27070e+01_r8,0.27809e+01_r8,0.17631e+01_r8 /) + kbo(:, 3,53,11) = (/ & + & 0.41868e+00_r8,0.26937e+01_r8,0.33628e+01_r8,0.34937e+01_r8,0.22551e+01_r8 /) + kbo(:, 4,53,11) = (/ & + & 0.54590e+00_r8,0.32172e+01_r8,0.40994e+01_r8,0.42669e+01_r8,0.27950e+01_r8 /) + kbo(:, 5,53,11) = (/ & + & 0.70382e+00_r8,0.37993e+01_r8,0.49134e+01_r8,0.50934e+01_r8,0.33609e+01_r8 /) + kbo(:, 1,54,11) = (/ & + & 0.19279e+00_r8,0.15884e+01_r8,0.19576e+01_r8,0.19516e+01_r8,0.11991e+01_r8 /) + kbo(:, 2,54,11) = (/ & + & 0.27614e+00_r8,0.20423e+01_r8,0.25053e+01_r8,0.25559e+01_r8,0.16106e+01_r8 /) + kbo(:, 3,54,11) = (/ & + & 0.37900e+00_r8,0.25264e+01_r8,0.31323e+01_r8,0.32473e+01_r8,0.20825e+01_r8 /) + kbo(:, 4,54,11) = (/ & + & 0.49954e+00_r8,0.30344e+01_r8,0.38425e+01_r8,0.39994e+01_r8,0.26090e+01_r8 /) + kbo(:, 5,54,11) = (/ & + & 0.64483e+00_r8,0.35967e+01_r8,0.46320e+01_r8,0.48104e+01_r8,0.31683e+01_r8 /) + kbo(:, 1,55,11) = (/ & + & 0.16752e+00_r8,0.14506e+01_r8,0.17924e+01_r8,0.17780e+01_r8,0.10766e+01_r8 /) + kbo(:, 2,55,11) = (/ & + & 0.24546e+00_r8,0.18924e+01_r8,0.23215e+01_r8,0.23502e+01_r8,0.14718e+01_r8 /) + kbo(:, 3,55,11) = (/ & + & 0.34282e+00_r8,0.23686e+01_r8,0.29203e+01_r8,0.30171e+01_r8,0.19238e+01_r8 /) + kbo(:, 4,55,11) = (/ & + & 0.45751e+00_r8,0.28657e+01_r8,0.36048e+01_r8,0.37504e+01_r8,0.24347e+01_r8 /) + kbo(:, 5,55,11) = (/ & + & 0.59345e+00_r8,0.34091e+01_r8,0.43692e+01_r8,0.45436e+01_r8,0.29860e+01_r8 /) + kbo(:, 1,56,11) = (/ & + & 0.14442e+00_r8,0.13191e+01_r8,0.16307e+01_r8,0.16158e+01_r8,0.95966e+00_r8 /) + kbo(:, 2,56,11) = (/ & + & 0.21629e+00_r8,0.17456e+01_r8,0.21454e+01_r8,0.21553e+01_r8,0.13384e+01_r8 /) + kbo(:, 3,56,11) = (/ & + & 0.30838e+00_r8,0.22117e+01_r8,0.27184e+01_r8,0.27939e+01_r8,0.17710e+01_r8 /) + kbo(:, 4,56,11) = (/ & + & 0.41780e+00_r8,0.27024e+01_r8,0.33761e+01_r8,0.35083e+01_r8,0.22647e+01_r8 /) + kbo(:, 5,56,11) = (/ & + & 0.54633e+00_r8,0.32277e+01_r8,0.41153e+01_r8,0.42835e+01_r8,0.28057e+01_r8 /) + kbo(:, 1,57,11) = (/ & + & 0.12369e+00_r8,0.11942e+01_r8,0.14751e+01_r8,0.14660e+01_r8,0.84794e+00_r8 /) + kbo(:, 2,57,11) = (/ & + & 0.18943e+00_r8,0.16025e+01_r8,0.19752e+01_r8,0.19706e+01_r8,0.12104e+01_r8 /) + kbo(:, 3,57,11) = (/ & + & 0.27580e+00_r8,0.20577e+01_r8,0.25253e+01_r8,0.25785e+01_r8,0.16249e+01_r8 /) + kbo(:, 4,57,11) = (/ & + & 0.38015e+00_r8,0.25425e+01_r8,0.31554e+01_r8,0.32724e+01_r8,0.20995e+01_r8 /) + kbo(:, 5,57,11) = (/ & + & 0.50220e+00_r8,0.30528e+01_r8,0.38694e+01_r8,0.40275e+01_r8,0.26279e+01_r8 /) + kbo(:, 1,58,11) = (/ & + & 0.10619e+00_r8,0.10815e+01_r8,0.13338e+01_r8,0.13340e+01_r8,0.74924e+00_r8 /) + kbo(:, 2,58,11) = (/ & + & 0.16586e+00_r8,0.14713e+01_r8,0.18183e+01_r8,0.18047e+01_r8,0.10933e+01_r8 /) + kbo(:, 3,58,11) = (/ & + & 0.24668e+00_r8,0.19150e+01_r8,0.23498e+01_r8,0.23824e+01_r8,0.14931e+01_r8 /) + kbo(:, 4,58,11) = (/ & + & 0.34613e+00_r8,0.23936e+01_r8,0.29542e+01_r8,0.30545e+01_r8,0.19489e+01_r8 /) + kbo(:, 5,58,11) = (/ & + & 0.46251e+00_r8,0.28928e+01_r8,0.36439e+01_r8,0.37914e+01_r8,0.24628e+01_r8 /) + kbo(:, 1,59,11) = (/ & + & 0.98781e-01_r8,0.10374e+01_r8,0.12790e+01_r8,0.12834e+01_r8,0.71091e+00_r8 /) + kbo(:, 2,59,11) = (/ & + & 0.15643e+00_r8,0.14199e+01_r8,0.17560e+01_r8,0.17406e+01_r8,0.10475e+01_r8 /) + kbo(:, 3,59,11) = (/ & + & 0.23512e+00_r8,0.18585e+01_r8,0.22815e+01_r8,0.23061e+01_r8,0.14408e+01_r8 /) + kbo(:, 4,59,11) = (/ & + & 0.33250e+00_r8,0.23338e+01_r8,0.28755e+01_r8,0.29686e+01_r8,0.18898e+01_r8 /) + kbo(:, 5,59,11) = (/ & + & 0.44697e+00_r8,0.28298e+01_r8,0.35555e+01_r8,0.36984e+01_r8,0.23975e+01_r8 /) + kbo(:, 1,13,12) = (/ & + & 0.30998e+02_r8,0.37385e+02_r8,0.40609e+02_r8,0.38100e+02_r8,0.30845e+02_r8 /) + kbo(:, 2,13,12) = (/ & + & 0.30490e+02_r8,0.37042e+02_r8,0.40582e+02_r8,0.38272e+02_r8,0.31245e+02_r8 /) + kbo(:, 3,13,12) = (/ & + & 0.29985e+02_r8,0.36701e+02_r8,0.40520e+02_r8,0.38445e+02_r8,0.31621e+02_r8 /) + kbo(:, 4,13,12) = (/ & + & 0.29490e+02_r8,0.36329e+02_r8,0.40415e+02_r8,0.38594e+02_r8,0.32000e+02_r8 /) + kbo(:, 5,13,12) = (/ & + & 0.29015e+02_r8,0.35959e+02_r8,0.40312e+02_r8,0.38750e+02_r8,0.32433e+02_r8 /) + kbo(:, 1,14,12) = (/ & + & 0.27110e+02_r8,0.35184e+02_r8,0.38617e+02_r8,0.36399e+02_r8,0.28635e+02_r8 /) + kbo(:, 2,14,12) = (/ & + & 0.26641e+02_r8,0.34930e+02_r8,0.38606e+02_r8,0.36649e+02_r8,0.29079e+02_r8 /) + kbo(:, 3,14,12) = (/ & + & 0.26184e+02_r8,0.34642e+02_r8,0.38568e+02_r8,0.36926e+02_r8,0.29498e+02_r8 /) + kbo(:, 4,14,12) = (/ & + & 0.25751e+02_r8,0.34348e+02_r8,0.38555e+02_r8,0.37188e+02_r8,0.29949e+02_r8 /) + kbo(:, 5,14,12) = (/ & + & 0.25340e+02_r8,0.34077e+02_r8,0.38568e+02_r8,0.37453e+02_r8,0.30433e+02_r8 /) + kbo(:, 1,15,12) = (/ & + & 0.23379e+02_r8,0.32658e+02_r8,0.36083e+02_r8,0.34396e+02_r8,0.26632e+02_r8 /) + kbo(:, 2,15,12) = (/ & + & 0.22961e+02_r8,0.32462e+02_r8,0.36143e+02_r8,0.34739e+02_r8,0.27099e+02_r8 /) + kbo(:, 3,15,12) = (/ & + & 0.22574e+02_r8,0.32277e+02_r8,0.36234e+02_r8,0.35089e+02_r8,0.27554e+02_r8 /) + kbo(:, 4,15,12) = (/ & + & 0.22226e+02_r8,0.32107e+02_r8,0.36368e+02_r8,0.35457e+02_r8,0.28061e+02_r8 /) + kbo(:, 5,15,12) = (/ & + & 0.22052e+02_r8,0.31945e+02_r8,0.36473e+02_r8,0.35860e+02_r8,0.28623e+02_r8 /) + kbo(:, 1,16,12) = (/ & + & 0.19977e+02_r8,0.29953e+02_r8,0.33281e+02_r8,0.32282e+02_r8,0.24730e+02_r8 /) + kbo(:, 2,16,12) = (/ & + & 0.19633e+02_r8,0.29859e+02_r8,0.33454e+02_r8,0.32701e+02_r8,0.25245e+02_r8 /) + kbo(:, 3,16,12) = (/ & + & 0.19340e+02_r8,0.29766e+02_r8,0.33693e+02_r8,0.33152e+02_r8,0.25800e+02_r8 /) + kbo(:, 4,16,12) = (/ & + & 0.19247e+02_r8,0.29689e+02_r8,0.33933e+02_r8,0.33616e+02_r8,0.26378e+02_r8 /) + kbo(:, 5,16,12) = (/ & + & 0.19403e+02_r8,0.29623e+02_r8,0.34160e+02_r8,0.34111e+02_r8,0.26924e+02_r8 /) + kbo(:, 1,17,12) = (/ & + & 0.17051e+02_r8,0.27143e+02_r8,0.30473e+02_r8,0.30161e+02_r8,0.22931e+02_r8 /) + kbo(:, 2,17,12) = (/ & + & 0.16797e+02_r8,0.27123e+02_r8,0.30776e+02_r8,0.30670e+02_r8,0.23518e+02_r8 /) + kbo(:, 3,17,12) = (/ & + & 0.16741e+02_r8,0.27141e+02_r8,0.31121e+02_r8,0.31186e+02_r8,0.24127e+02_r8 /) + kbo(:, 4,17,12) = (/ & + & 0.16948e+02_r8,0.27189e+02_r8,0.31472e+02_r8,0.31736e+02_r8,0.24729e+02_r8 /) + kbo(:, 5,17,12) = (/ & + & 0.17485e+02_r8,0.27288e+02_r8,0.31858e+02_r8,0.32324e+02_r8,0.25297e+02_r8 /) + kbo(:, 1,18,12) = (/ & + & 0.14597e+02_r8,0.24342e+02_r8,0.27826e+02_r8,0.28130e+02_r8,0.21245e+02_r8 /) + kbo(:, 2,18,12) = (/ & + & 0.14547e+02_r8,0.24446e+02_r8,0.28237e+02_r8,0.28704e+02_r8,0.21885e+02_r8 /) + kbo(:, 3,18,12) = (/ & + & 0.14765e+02_r8,0.24583e+02_r8,0.28672e+02_r8,0.29288e+02_r8,0.22535e+02_r8 /) + kbo(:, 4,18,12) = (/ & + & 0.15315e+02_r8,0.24794e+02_r8,0.29147e+02_r8,0.29934e+02_r8,0.23159e+02_r8 /) + kbo(:, 5,18,12) = (/ & + & 0.16067e+02_r8,0.25143e+02_r8,0.29634e+02_r8,0.30628e+02_r8,0.23749e+02_r8 /) + kbo(:, 1,19,12) = (/ & + & 0.12640e+02_r8,0.21753e+02_r8,0.25384e+02_r8,0.26151e+02_r8,0.19661e+02_r8 /) + kbo(:, 2,19,12) = (/ & + & 0.12835e+02_r8,0.21949e+02_r8,0.25878e+02_r8,0.26810e+02_r8,0.20358e+02_r8 /) + kbo(:, 3,19,12) = (/ & + & 0.13356e+02_r8,0.22229e+02_r8,0.26410e+02_r8,0.27515e+02_r8,0.21037e+02_r8 /) + kbo(:, 4,19,12) = (/ & + & 0.14056e+02_r8,0.22664e+02_r8,0.26964e+02_r8,0.28265e+02_r8,0.21685e+02_r8 /) + kbo(:, 5,19,12) = (/ & + & 0.14855e+02_r8,0.23244e+02_r8,0.27571e+02_r8,0.29046e+02_r8,0.22336e+02_r8 /) + kbo(:, 1,20,12) = (/ & + & 0.11082e+02_r8,0.19491e+02_r8,0.23194e+02_r8,0.24313e+02_r8,0.18232e+02_r8 /) + kbo(:, 2,20,12) = (/ & + & 0.11562e+02_r8,0.19787e+02_r8,0.23755e+02_r8,0.25073e+02_r8,0.18946e+02_r8 /) + kbo(:, 3,20,12) = (/ & + & 0.12224e+02_r8,0.20238e+02_r8,0.24350e+02_r8,0.25880e+02_r8,0.19650e+02_r8 /) + kbo(:, 4,20,12) = (/ & + & 0.12987e+02_r8,0.20868e+02_r8,0.25012e+02_r8,0.26726e+02_r8,0.20347e+02_r8 /) + kbo(:, 5,20,12) = (/ & + & 0.13788e+02_r8,0.21712e+02_r8,0.25741e+02_r8,0.27588e+02_r8,0.21074e+02_r8 /) + kbo(:, 1,21,12) = (/ & + & 0.98833e+01_r8,0.17574e+02_r8,0.21209e+02_r8,0.22623e+02_r8,0.16925e+02_r8 /) + kbo(:, 2,21,12) = (/ & + & 0.10489e+02_r8,0.18010e+02_r8,0.21858e+02_r8,0.23471e+02_r8,0.17666e+02_r8 /) + kbo(:, 3,21,12) = (/ & + & 0.11209e+02_r8,0.18622e+02_r8,0.22555e+02_r8,0.24382e+02_r8,0.18394e+02_r8 /) + kbo(:, 4,21,12) = (/ & + & 0.11974e+02_r8,0.19474e+02_r8,0.23320e+02_r8,0.25315e+02_r8,0.19156e+02_r8 /) + kbo(:, 5,21,12) = (/ & + & 0.12743e+02_r8,0.20530e+02_r8,0.24213e+02_r8,0.26280e+02_r8,0.19957e+02_r8 /) + kbo(:, 1,22,12) = (/ & + & 0.89432e+01_r8,0.16023e+02_r8,0.19521e+02_r8,0.21142e+02_r8,0.15785e+02_r8 /) + kbo(:, 2,22,12) = (/ & + & 0.96012e+01_r8,0.16615e+02_r8,0.20251e+02_r8,0.22105e+02_r8,0.16565e+02_r8 /) + kbo(:, 3,22,12) = (/ & + & 0.10308e+02_r8,0.17429e+02_r8,0.21053e+02_r8,0.23102e+02_r8,0.17352e+02_r8 /) + kbo(:, 4,22,12) = (/ & + & 0.11034e+02_r8,0.18474e+02_r8,0.21986e+02_r8,0.24140e+02_r8,0.18184e+02_r8 /) + kbo(:, 5,22,12) = (/ & + & 0.11779e+02_r8,0.19675e+02_r8,0.23025e+02_r8,0.25198e+02_r8,0.19053e+02_r8 /) + kbo(:, 1,23,12) = (/ & + & 0.81558e+01_r8,0.14793e+02_r8,0.18088e+02_r8,0.19855e+02_r8,0.14800e+02_r8 /) + kbo(:, 2,23,12) = (/ & + & 0.87957e+01_r8,0.15543e+02_r8,0.18895e+02_r8,0.20923e+02_r8,0.15621e+02_r8 /) + kbo(:, 3,23,12) = (/ & + & 0.94593e+01_r8,0.16540e+02_r8,0.19849e+02_r8,0.22025e+02_r8,0.16480e+02_r8 /) + kbo(:, 4,23,12) = (/ & + & 0.10153e+02_r8,0.17706e+02_r8,0.20923e+02_r8,0.23160e+02_r8,0.17388e+02_r8 /) + kbo(:, 5,23,12) = (/ & + & 0.10876e+02_r8,0.18993e+02_r8,0.22113e+02_r8,0.24310e+02_r8,0.18322e+02_r8 /) + kbo(:, 1,24,12) = (/ & + & 0.74526e+01_r8,0.13830e+02_r8,0.16894e+02_r8,0.18769e+02_r8,0.13959e+02_r8 /) + kbo(:, 2,24,12) = (/ & + & 0.80517e+01_r8,0.14766e+02_r8,0.17833e+02_r8,0.19936e+02_r8,0.14836e+02_r8 /) + kbo(:, 3,24,12) = (/ & + & 0.86841e+01_r8,0.15873e+02_r8,0.18916e+02_r8,0.21150e+02_r8,0.15773e+02_r8 /) + kbo(:, 4,24,12) = (/ & + & 0.93535e+01_r8,0.17122e+02_r8,0.20131e+02_r8,0.22383e+02_r8,0.16742e+02_r8 /) + kbo(:, 5,24,12) = (/ & + & 0.10068e+02_r8,0.18482e+02_r8,0.21482e+02_r8,0.23634e+02_r8,0.17753e+02_r8 /) + kbo(:, 1,25,12) = (/ & + & 0.68105e+01_r8,0.13122e+02_r8,0.15953e+02_r8,0.17890e+02_r8,0.13264e+02_r8 /) + kbo(:, 2,25,12) = (/ & + & 0.73796e+01_r8,0.14193e+02_r8,0.17028e+02_r8,0.19160e+02_r8,0.14211e+02_r8 /) + kbo(:, 3,25,12) = (/ & + & 0.79883e+01_r8,0.15386e+02_r8,0.18237e+02_r8,0.20473e+02_r8,0.15219e+02_r8 /) + kbo(:, 4,25,12) = (/ & + & 0.86473e+01_r8,0.16702e+02_r8,0.19605e+02_r8,0.21810e+02_r8,0.16257e+02_r8 /) + kbo(:, 5,25,12) = (/ & + & 0.93513e+01_r8,0.18139e+02_r8,0.21087e+02_r8,0.23158e+02_r8,0.17339e+02_r8 /) + kbo(:, 1,26,12) = (/ & + & 0.62530e+01_r8,0.12619e+02_r8,0.15260e+02_r8,0.17241e+02_r8,0.12729e+02_r8 /) + kbo(:, 2,26,12) = (/ & + & 0.67955e+01_r8,0.13786e+02_r8,0.16460e+02_r8,0.18602e+02_r8,0.13751e+02_r8 /) + kbo(:, 3,26,12) = (/ & + & 0.73876e+01_r8,0.15061e+02_r8,0.17816e+02_r8,0.20014e+02_r8,0.14821e+02_r8 /) + kbo(:, 4,26,12) = (/ & + & 0.80374e+01_r8,0.16453e+02_r8,0.19314e+02_r8,0.21444e+02_r8,0.15933e+02_r8 /) + kbo(:, 5,26,12) = (/ & + & 0.87427e+01_r8,0.17956e+02_r8,0.20909e+02_r8,0.22878e+02_r8,0.17080e+02_r8 /) + kbo(:, 1,27,12) = (/ & + & 0.57700e+01_r8,0.12257e+02_r8,0.14782e+02_r8,0.16780e+02_r8,0.12335e+02_r8 /) + kbo(:, 2,27,12) = (/ & + & 0.62864e+01_r8,0.13513e+02_r8,0.16114e+02_r8,0.18231e+02_r8,0.13431e+02_r8 /) + kbo(:, 3,27,12) = (/ & + & 0.68675e+01_r8,0.14868e+02_r8,0.17601e+02_r8,0.19730e+02_r8,0.14565e+02_r8 /) + kbo(:, 4,27,12) = (/ & + & 0.75138e+01_r8,0.16329e+02_r8,0.19199e+02_r8,0.21244e+02_r8,0.15742e+02_r8 /) + kbo(:, 5,27,12) = (/ & + & 0.82289e+01_r8,0.17883e+02_r8,0.20886e+02_r8,0.22748e+02_r8,0.16940e+02_r8 /) + kbo(:, 1,28,12) = (/ & + & 0.53548e+01_r8,0.12024e+02_r8,0.14494e+02_r8,0.16490e+02_r8,0.12074e+02_r8 /) + kbo(:, 2,28,12) = (/ & + & 0.58567e+01_r8,0.13364e+02_r8,0.15954e+02_r8,0.18023e+02_r8,0.13231e+02_r8 /) + kbo(:, 3,28,12) = (/ & + & 0.64249e+01_r8,0.14793e+02_r8,0.17548e+02_r8,0.19599e+02_r8,0.14431e+02_r8 /) + kbo(:, 4,28,12) = (/ & + & 0.70763e+01_r8,0.16306e+02_r8,0.19232e+02_r8,0.21185e+02_r8,0.15664e+02_r8 /) + kbo(:, 5,28,12) = (/ & + & 0.78108e+01_r8,0.17913e+02_r8,0.20999e+02_r8,0.22748e+02_r8,0.16904e+02_r8 /) + kbo(:, 1,29,12) = (/ & + & 0.50045e+01_r8,0.11918e+02_r8,0.14389e+02_r8,0.16363e+02_r8,0.11938e+02_r8 /) + kbo(:, 2,29,12) = (/ & + & 0.55030e+01_r8,0.13334e+02_r8,0.15959e+02_r8,0.17970e+02_r8,0.13155e+02_r8 /) + kbo(:, 3,29,12) = (/ & + & 0.60662e+01_r8,0.14820e+02_r8,0.17638e+02_r8,0.19611e+02_r8,0.14408e+02_r8 /) + kbo(:, 4,29,12) = (/ & + & 0.67325e+01_r8,0.16392e+02_r8,0.19392e+02_r8,0.21253e+02_r8,0.15686e+02_r8 /) + kbo(:, 5,29,12) = (/ & + & 0.74925e+01_r8,0.18044e+02_r8,0.21206e+02_r8,0.22856e+02_r8,0.16965e+02_r8 /) + kbo(:, 1,30,12) = (/ & + & 0.47172e+01_r8,0.11917e+02_r8,0.14428e+02_r8,0.16368e+02_r8,0.11903e+02_r8 /) + kbo(:, 2,30,12) = (/ & + & 0.52125e+01_r8,0.13400e+02_r8,0.16089e+02_r8,0.18040e+02_r8,0.13179e+02_r8 /) + kbo(:, 3,30,12) = (/ & + & 0.57884e+01_r8,0.14940e+02_r8,0.17829e+02_r8,0.19728e+02_r8,0.14475e+02_r8 /) + kbo(:, 4,30,12) = (/ & + & 0.64722e+01_r8,0.16556e+02_r8,0.19636e+02_r8,0.21408e+02_r8,0.15787e+02_r8 /) + kbo(:, 5,30,12) = (/ & + & 0.72704e+01_r8,0.18251e+02_r8,0.21479e+02_r8,0.23035e+02_r8,0.17093e+02_r8 /) + kbo(:, 1,31,12) = (/ & + & 0.44858e+01_r8,0.12017e+02_r8,0.14590e+02_r8,0.16495e+02_r8,0.11969e+02_r8 /) + kbo(:, 2,31,12) = (/ & + & 0.49908e+01_r8,0.13550e+02_r8,0.16315e+02_r8,0.18215e+02_r8,0.13287e+02_r8 /) + kbo(:, 3,31,12) = (/ & + & 0.55864e+01_r8,0.15140e+02_r8,0.18101e+02_r8,0.19933e+02_r8,0.14620e+02_r8 /) + kbo(:, 4,31,12) = (/ & + & 0.63024e+01_r8,0.16801e+02_r8,0.19948e+02_r8,0.21636e+02_r8,0.15956e+02_r8 /) + kbo(:, 5,31,12) = (/ & + & 0.71504e+01_r8,0.18530e+02_r8,0.21815e+02_r8,0.23280e+02_r8,0.17277e+02_r8 /) + kbo(:, 1,32,12) = (/ & + & 0.43064e+01_r8,0.12199e+02_r8,0.14841e+02_r8,0.16712e+02_r8,0.12112e+02_r8 /) + kbo(:, 2,32,12) = (/ & + & 0.48346e+01_r8,0.13779e+02_r8,0.16613e+02_r8,0.18463e+02_r8,0.13462e+02_r8 /) + kbo(:, 3,32,12) = (/ & + & 0.54614e+01_r8,0.15404e+02_r8,0.18438e+02_r8,0.20209e+02_r8,0.14821e+02_r8 /) + kbo(:, 4,32,12) = (/ & + & 0.62177e+01_r8,0.17102e+02_r8,0.20311e+02_r8,0.21920e+02_r8,0.16172e+02_r8 /) + kbo(:, 5,32,12) = (/ & + & 0.71259e+01_r8,0.18855e+02_r8,0.22195e+02_r8,0.23574e+02_r8,0.17506e+02_r8 /) + kbo(:, 1,33,12) = (/ & + & 0.41801e+01_r8,0.12450e+02_r8,0.15154e+02_r8,0.16994e+02_r8,0.12315e+02_r8 /) + kbo(:, 2,33,12) = (/ & + & 0.47391e+01_r8,0.14064e+02_r8,0.16963e+02_r8,0.18765e+02_r8,0.13689e+02_r8 /) + kbo(:, 3,33,12) = (/ & + & 0.54061e+01_r8,0.15717e+02_r8,0.18820e+02_r8,0.20527e+02_r8,0.15064e+02_r8 /) + kbo(:, 4,33,12) = (/ & + & 0.62146e+01_r8,0.17442e+02_r8,0.20711e+02_r8,0.22242e+02_r8,0.16420e+02_r8 /) + kbo(:, 5,33,12) = (/ & + & 0.71827e+01_r8,0.19219e+02_r8,0.22608e+02_r8,0.23903e+02_r8,0.17762e+02_r8 /) + kbo(:, 1,34,12) = (/ & + & 0.40887e+01_r8,0.12691e+02_r8,0.15451e+02_r8,0.17259e+02_r8,0.12512e+02_r8 /) + kbo(:, 2,34,12) = (/ & + & 0.46819e+01_r8,0.14330e+02_r8,0.17288e+02_r8,0.19046e+02_r8,0.13902e+02_r8 /) + kbo(:, 3,34,12) = (/ & + & 0.53890e+01_r8,0.16007e+02_r8,0.19166e+02_r8,0.20816e+02_r8,0.15287e+02_r8 /) + kbo(:, 4,34,12) = (/ & + & 0.62486e+01_r8,0.17752e+02_r8,0.21067e+02_r8,0.22532e+02_r8,0.16650e+02_r8 /) + kbo(:, 5,34,12) = (/ & + & 0.72682e+01_r8,0.19545e+02_r8,0.22972e+02_r8,0.24194e+02_r8,0.17995e+02_r8 /) + kbo(:, 1,35,12) = (/ & + & 0.39916e+01_r8,0.12809e+02_r8,0.15601e+02_r8,0.17383e+02_r8,0.12605e+02_r8 /) + kbo(:, 2,35,12) = (/ & + & 0.46112e+01_r8,0.14460e+02_r8,0.17457e+02_r8,0.19181e+02_r8,0.14005e+02_r8 /) + kbo(:, 3,35,12) = (/ & + & 0.53474e+01_r8,0.16154e+02_r8,0.19347e+02_r8,0.20958e+02_r8,0.15398e+02_r8 /) + kbo(:, 4,35,12) = (/ & + & 0.62430e+01_r8,0.17913e+02_r8,0.21258e+02_r8,0.22679e+02_r8,0.16764e+02_r8 /) + kbo(:, 5,35,12) = (/ & + & 0.72953e+01_r8,0.19716e+02_r8,0.23169e+02_r8,0.24345e+02_r8,0.18113e+02_r8 /) + kbo(:, 1,36,12) = (/ & + & 0.38696e+01_r8,0.12768e+02_r8,0.15571e+02_r8,0.17332e+02_r8,0.12565e+02_r8 /) + kbo(:, 2,36,12) = (/ & + & 0.45034e+01_r8,0.14429e+02_r8,0.17436e+02_r8,0.19141e+02_r8,0.13973e+02_r8 /) + kbo(:, 3,36,12) = (/ & + & 0.52555e+01_r8,0.16128e+02_r8,0.19333e+02_r8,0.20927e+02_r8,0.15372e+02_r8 /) + kbo(:, 4,36,12) = (/ & + & 0.61640e+01_r8,0.17893e+02_r8,0.21249e+02_r8,0.22656e+02_r8,0.16743e+02_r8 /) + kbo(:, 5,36,12) = (/ & + & 0.72295e+01_r8,0.19702e+02_r8,0.23168e+02_r8,0.24329e+02_r8,0.18096e+02_r8 /) + kbo(:, 1,37,12) = (/ & + & 0.36883e+01_r8,0.12493e+02_r8,0.15274e+02_r8,0.17021e+02_r8,0.12322e+02_r8 /) + kbo(:, 2,37,12) = (/ & + & 0.43193e+01_r8,0.14156e+02_r8,0.17140e+02_r8,0.18841e+02_r8,0.13739e+02_r8 /) + kbo(:, 3,37,12) = (/ & + & 0.50636e+01_r8,0.15852e+02_r8,0.19039e+02_r8,0.20638e+02_r8,0.15145e+02_r8 /) + kbo(:, 4,37,12) = (/ & + & 0.59573e+01_r8,0.17616e+02_r8,0.20958e+02_r8,0.22386e+02_r8,0.16525e+02_r8 /) + kbo(:, 5,37,12) = (/ & + & 0.70089e+01_r8,0.19421e+02_r8,0.22881e+02_r8,0.24071e+02_r8,0.17883e+02_r8 /) + kbo(:, 1,38,12) = (/ & + & 0.35253e+01_r8,0.12215e+02_r8,0.14971e+02_r8,0.16706e+02_r8,0.12079e+02_r8 /) + kbo(:, 2,38,12) = (/ & + & 0.41507e+01_r8,0.13877e+02_r8,0.16837e+02_r8,0.18535e+02_r8,0.13501e+02_r8 /) + kbo(:, 3,38,12) = (/ & + & 0.48852e+01_r8,0.15572e+02_r8,0.18736e+02_r8,0.20342e+02_r8,0.14913e+02_r8 /) + kbo(:, 4,38,12) = (/ & + & 0.57613e+01_r8,0.17329e+02_r8,0.20656e+02_r8,0.22106e+02_r8,0.16300e+02_r8 /) + kbo(:, 5,38,12) = (/ & + & 0.67957e+01_r8,0.19130e+02_r8,0.22581e+02_r8,0.23804e+02_r8,0.17665e+02_r8 /) + kbo(:, 1,39,12) = (/ & + & 0.33825e+01_r8,0.11947e+02_r8,0.14676e+02_r8,0.16402e+02_r8,0.11843e+02_r8 /) + kbo(:, 2,39,12) = (/ & + & 0.39997e+01_r8,0.13607e+02_r8,0.16542e+02_r8,0.18237e+02_r8,0.13271e+02_r8 /) + kbo(:, 3,39,12) = (/ & + & 0.47242e+01_r8,0.15300e+02_r8,0.18440e+02_r8,0.20053e+02_r8,0.14687e+02_r8 /) + kbo(:, 4,39,12) = (/ & + & 0.55821e+01_r8,0.17050e+02_r8,0.20362e+02_r8,0.21831e+02_r8,0.16081e+02_r8 /) + kbo(:, 5,39,12) = (/ & + & 0.65965e+01_r8,0.18849e+02_r8,0.22289e+02_r8,0.23541e+02_r8,0.17452e+02_r8 /) + kbo(:, 1,40,12) = (/ & + & 0.31990e+01_r8,0.11518e+02_r8,0.14197e+02_r8,0.15916e+02_r8,0.11466e+02_r8 /) + kbo(:, 2,40,12) = (/ & + & 0.37954e+01_r8,0.13171e+02_r8,0.16060e+02_r8,0.17759e+02_r8,0.12898e+02_r8 /) + kbo(:, 3,40,12) = (/ & + & 0.44984e+01_r8,0.14859e+02_r8,0.17955e+02_r8,0.19586e+02_r8,0.14321e+02_r8 /) + kbo(:, 4,40,12) = (/ & + & 0.53220e+01_r8,0.16595e+02_r8,0.19875e+02_r8,0.21381e+02_r8,0.15725e+02_r8 /) + kbo(:, 5,40,12) = (/ & + & 0.62999e+01_r8,0.18387e+02_r8,0.21803e+02_r8,0.23109e+02_r8,0.17102e+02_r8 /) + kbo(:, 1,41,12) = (/ & + & 0.30240e+01_r8,0.11079e+02_r8,0.13703e+02_r8,0.15411e+02_r8,0.11075e+02_r8 /) + kbo(:, 2,41,12) = (/ & + & 0.35998e+01_r8,0.12722e+02_r8,0.15561e+02_r8,0.17259e+02_r8,0.12509e+02_r8 /) + kbo(:, 3,41,12) = (/ & + & 0.42766e+01_r8,0.14402e+02_r8,0.17450e+02_r8,0.19096e+02_r8,0.13938e+02_r8 /) + kbo(:, 4,41,12) = (/ & + & 0.50663e+01_r8,0.16123e+02_r8,0.19365e+02_r8,0.20905e+02_r8,0.15352e+02_r8 /) + kbo(:, 5,41,12) = (/ & + & 0.60051e+01_r8,0.17908e+02_r8,0.21295e+02_r8,0.22653e+02_r8,0.16735e+02_r8 /) + kbo(:, 1,42,12) = (/ & + & 0.28652e+01_r8,0.10648e+02_r8,0.13219e+02_r8,0.14913e+02_r8,0.10689e+02_r8 /) + kbo(:, 2,42,12) = (/ & + & 0.34153e+01_r8,0.12278e+02_r8,0.15063e+02_r8,0.16761e+02_r8,0.12121e+02_r8 /) + kbo(:, 3,42,12) = (/ & + & 0.40672e+01_r8,0.13952e+02_r8,0.16947e+02_r8,0.18606e+02_r8,0.13557e+02_r8 /) + kbo(:, 4,42,12) = (/ & + & 0.48264e+01_r8,0.15661e+02_r8,0.18858e+02_r8,0.20426e+02_r8,0.14977e+02_r8 /) + kbo(:, 5,42,12) = (/ & + & 0.57266e+01_r8,0.17431e+02_r8,0.20787e+02_r8,0.22197e+02_r8,0.16370e+02_r8 /) + kbo(:, 1,43,12) = (/ & + & 0.26870e+01_r8,0.10134e+02_r8,0.12642e+02_r8,0.14316e+02_r8,0.10228e+02_r8 /) + kbo(:, 2,43,12) = (/ & + & 0.32108e+01_r8,0.11745e+02_r8,0.14465e+02_r8,0.16161e+02_r8,0.11657e+02_r8 /) + kbo(:, 3,43,12) = (/ & + & 0.38308e+01_r8,0.13408e+02_r8,0.16340e+02_r8,0.18012e+02_r8,0.13095e+02_r8 /) + kbo(:, 4,43,12) = (/ & + & 0.45569e+01_r8,0.15107e+02_r8,0.18246e+02_r8,0.19843e+02_r8,0.14521e+02_r8 /) + kbo(:, 5,43,12) = (/ & + & 0.54100e+01_r8,0.16859e+02_r8,0.20173e+02_r8,0.21637e+02_r8,0.15927e+02_r8 /) + kbo(:, 1,44,12) = (/ & + & 0.25051e+01_r8,0.95885e+01_r8,0.12032e+02_r8,0.13682e+02_r8,0.97372e+01_r8 /) + kbo(:, 2,44,12) = (/ & + & 0.30054e+01_r8,0.11180e+02_r8,0.13825e+02_r8,0.15517e+02_r8,0.11159e+02_r8 /) + kbo(:, 3,44,12) = (/ & + & 0.35923e+01_r8,0.12828e+02_r8,0.15690e+02_r8,0.17372e+02_r8,0.12597e+02_r8 /) + kbo(:, 4,44,12) = (/ & + & 0.42861e+01_r8,0.14518e+02_r8,0.17591e+02_r8,0.19215e+02_r8,0.14031e+02_r8 /) + kbo(:, 5,44,12) = (/ & + & 0.50891e+01_r8,0.16248e+02_r8,0.19511e+02_r8,0.21026e+02_r8,0.15447e+02_r8 /) + kbo(:, 1,45,12) = (/ & + & 0.23284e+01_r8,0.90519e+01_r8,0.11435e+02_r8,0.13049e+02_r8,0.92487e+01_r8 /) + kbo(:, 2,45,12) = (/ & + & 0.28153e+01_r8,0.10623e+02_r8,0.13197e+02_r8,0.14880e+02_r8,0.10666e+02_r8 /) + kbo(:, 3,45,12) = (/ & + & 0.33686e+01_r8,0.12254e+02_r8,0.15046e+02_r8,0.16733e+02_r8,0.12101e+02_r8 /) + kbo(:, 4,45,12) = (/ & + & 0.40279e+01_r8,0.13936e+02_r8,0.16938e+02_r8,0.18583e+02_r8,0.13540e+02_r8 /) + kbo(:, 5,45,12) = (/ & + & 0.47894e+01_r8,0.15648e+02_r8,0.18852e+02_r8,0.20408e+02_r8,0.14963e+02_r8 /) + kbo(:, 1,46,12) = (/ & + & 0.21477e+01_r8,0.84947e+01_r8,0.10808e+02_r8,0.12382e+02_r8,0.87316e+01_r8 /) + kbo(:, 2,46,12) = (/ & + & 0.26237e+01_r8,0.10040e+02_r8,0.12543e+02_r8,0.14206e+02_r8,0.10145e+02_r8 /) + kbo(:, 3,46,12) = (/ & + & 0.31493e+01_r8,0.11653e+02_r8,0.14367e+02_r8,0.16054e+02_r8,0.11575e+02_r8 /) + kbo(:, 4,46,12) = (/ & + & 0.37687e+01_r8,0.13319e+02_r8,0.16247e+02_r8,0.17910e+02_r8,0.13015e+02_r8 /) + kbo(:, 5,46,12) = (/ & + & 0.44919e+01_r8,0.15018e+02_r8,0.18154e+02_r8,0.19746e+02_r8,0.14446e+02_r8 /) + kbo(:, 1,47,12) = (/ & + & 0.19539e+01_r8,0.78866e+01_r8,0.10121e+02_r8,0.11642e+02_r8,0.81629e+01_r8 /) + kbo(:, 2,47,12) = (/ & + & 0.24188e+01_r8,0.94011e+01_r8,0.11827e+02_r8,0.13461e+02_r8,0.95671e+01_r8 /) + kbo(:, 3,47,12) = (/ & + & 0.29183e+01_r8,0.10990e+02_r8,0.13614e+02_r8,0.15297e+02_r8,0.10990e+02_r8 /) + kbo(:, 4,47,12) = (/ & + & 0.34981e+01_r8,0.12636e+02_r8,0.15480e+02_r8,0.17155e+02_r8,0.12429e+02_r8 /) + kbo(:, 5,47,12) = (/ & + & 0.41787e+01_r8,0.14323e+02_r8,0.17378e+02_r8,0.19005e+02_r8,0.13866e+02_r8 /) + kbo(:, 1,48,12) = (/ & + & 0.17686e+01_r8,0.73016e+01_r8,0.94471e+01_r8,0.10908e+02_r8,0.76062e+01_r8 /) + kbo(:, 2,48,12) = (/ & + & 0.22191e+01_r8,0.87750e+01_r8,0.11125e+02_r8,0.12718e+02_r8,0.89921e+01_r8 /) + kbo(:, 3,48,12) = (/ & + & 0.27045e+01_r8,0.10336e+02_r8,0.12878e+02_r8,0.14548e+02_r8,0.10409e+02_r8 /) + kbo(:, 4,48,12) = (/ & + & 0.32460e+01_r8,0.11962e+02_r8,0.14721e+02_r8,0.16399e+02_r8,0.11843e+02_r8 /) + kbo(:, 5,48,12) = (/ & + & 0.38847e+01_r8,0.13635e+02_r8,0.16605e+02_r8,0.18256e+02_r8,0.13285e+02_r8 /) + kbo(:, 1,49,12) = (/ & + & 0.15926e+01_r8,0.67448e+01_r8,0.87885e+01_r8,0.10183e+02_r8,0.70558e+01_r8 /) + kbo(:, 2,49,12) = (/ & + & 0.20265e+01_r8,0.81616e+01_r8,0.10434e+02_r8,0.11978e+02_r8,0.84210e+01_r8 /) + kbo(:, 3,49,12) = (/ & + & 0.24995e+01_r8,0.96943e+01_r8,0.12158e+02_r8,0.13804e+02_r8,0.98335e+01_r8 /) + kbo(:, 4,49,12) = (/ & + & 0.30106e+01_r8,0.11296e+02_r8,0.13964e+02_r8,0.15645e+02_r8,0.11261e+02_r8 /) + kbo(:, 5,49,12) = (/ & + & 0.36091e+01_r8,0.12953e+02_r8,0.15838e+02_r8,0.17505e+02_r8,0.12701e+02_r8 /) + kbo(:, 1,50,12) = (/ & + & 0.14367e+01_r8,0.62503e+01_r8,0.81839e+01_r8,0.95114e+01_r8,0.65470e+01_r8 /) + kbo(:, 2,50,12) = (/ & + & 0.18513e+01_r8,0.76037e+01_r8,0.97986e+01_r8,0.11290e+02_r8,0.78962e+01_r8 /) + kbo(:, 3,50,12) = (/ & + & 0.23123e+01_r8,0.91032e+01_r8,0.11496e+02_r8,0.13108e+02_r8,0.92947e+01_r8 /) + kbo(:, 4,50,12) = (/ & + & 0.28056e+01_r8,0.10680e+02_r8,0.13267e+02_r8,0.14942e+02_r8,0.10716e+02_r8 /) + kbo(:, 5,50,12) = (/ & + & 0.33664e+01_r8,0.12318e+02_r8,0.15124e+02_r8,0.16800e+02_r8,0.12153e+02_r8 /) + kbo(:, 1,51,12) = (/ & + & 0.12944e+01_r8,0.57936e+01_r8,0.76117e+01_r8,0.88742e+01_r8,0.60642e+01_r8 /) + kbo(:, 2,51,12) = (/ & + & 0.16888e+01_r8,0.70852e+01_r8,0.91933e+01_r8,0.10628e+02_r8,0.73944e+01_r8 /) + kbo(:, 3,51,12) = (/ & + & 0.21353e+01_r8,0.85416e+01_r8,0.10863e+02_r8,0.12436e+02_r8,0.87735e+01_r8 /) + kbo(:, 4,51,12) = (/ & + & 0.26169e+01_r8,0.10093e+02_r8,0.12607e+02_r8,0.14266e+02_r8,0.10192e+02_r8 /) + kbo(:, 5,51,12) = (/ & + & 0.31479e+01_r8,0.11711e+02_r8,0.14438e+02_r8,0.16116e+02_r8,0.11624e+02_r8 /) + kbo(:, 1,52,12) = (/ & + & 0.11616e+01_r8,0.53570e+01_r8,0.70533e+01_r8,0.82560e+01_r8,0.55953e+01_r8 /) + kbo(:, 2,52,12) = (/ & + & 0.15340e+01_r8,0.65899e+01_r8,0.86019e+01_r8,0.99750e+01_r8,0.68982e+01_r8 /) + kbo(:, 3,52,12) = (/ & + & 0.19643e+01_r8,0.79903e+01_r8,0.10241e+02_r8,0.11768e+02_r8,0.82604e+01_r8 /) + kbo(:, 4,52,12) = (/ & + & 0.24347e+01_r8,0.95157e+01_r8,0.11958e+02_r8,0.13593e+02_r8,0.96707e+01_r8 /) + kbo(:, 5,52,12) = (/ & + & 0.29410e+01_r8,0.11112e+02_r8,0.13756e+02_r8,0.15434e+02_r8,0.11097e+02_r8 /) + kbo(:, 1,53,12) = (/ & + & 0.10377e+01_r8,0.49398e+01_r8,0.65141e+01_r8,0.76518e+01_r8,0.51386e+01_r8 /) + kbo(:, 2,53,12) = (/ & + & 0.13876e+01_r8,0.61188e+01_r8,0.80207e+01_r8,0.93291e+01_r8,0.64095e+01_r8 /) + kbo(:, 3,53,12) = (/ & + & 0.17987e+01_r8,0.74567e+01_r8,0.96292e+01_r8,0.11104e+02_r8,0.77562e+01_r8 /) + kbo(:, 4,53,12) = (/ & + & 0.22559e+01_r8,0.89467e+01_r8,0.11320e+02_r8,0.12921e+02_r8,0.91504e+01_r8 /) + kbo(:, 5,53,12) = (/ & + & 0.27477e+01_r8,0.10518e+02_r8,0.13086e+02_r8,0.14756e+02_r8,0.10571e+02_r8 /) + kbo(:, 1,54,12) = (/ & + & 0.93266e+00_r8,0.45754e+01_r8,0.60420e+01_r8,0.71108e+01_r8,0.47321e+01_r8 /) + kbo(:, 2,54,12) = (/ & + & 0.12608e+01_r8,0.57055e+01_r8,0.75003e+01_r8,0.87512e+01_r8,0.59717e+01_r8 /) + kbo(:, 3,54,12) = (/ & + & 0.16525e+01_r8,0.69875e+01_r8,0.90782e+01_r8,0.10501e+02_r8,0.72982e+01_r8 /) + kbo(:, 4,54,12) = (/ & + & 0.20962e+01_r8,0.84351e+01_r8,0.10744e+02_r8,0.12308e+02_r8,0.86747e+01_r8 /) + kbo(:, 5,54,12) = (/ & + & 0.25775e+01_r8,0.99827e+01_r8,0.12485e+02_r8,0.14138e+02_r8,0.10092e+02_r8 /) + kbo(:, 1,55,12) = (/ & + & 0.84048e+00_r8,0.42428e+01_r8,0.56145e+01_r8,0.66054e+01_r8,0.43544e+01_r8 /) + kbo(:, 2,55,12) = (/ & + & 0.11472e+01_r8,0.53270e+01_r8,0.70144e+01_r8,0.82122e+01_r8,0.55615e+01_r8 /) + kbo(:, 3,55,12) = (/ & + & 0.15181e+01_r8,0.65556e+01_r8,0.85601e+01_r8,0.99280e+01_r8,0.68631e+01_r8 /) + kbo(:, 4,55,12) = (/ & + & 0.19474e+01_r8,0.79524e+01_r8,0.10198e+02_r8,0.11721e+02_r8,0.82252e+01_r8 /) + kbo(:, 5,55,12) = (/ & + & 0.24188e+01_r8,0.94776e+01_r8,0.11916e+02_r8,0.13548e+02_r8,0.96351e+01_r8 /) + kbo(:, 1,56,12) = (/ & + & 0.75447e+00_r8,0.39270e+01_r8,0.52064e+01_r8,0.61093e+01_r8,0.39870e+01_r8 /) + kbo(:, 2,56,12) = (/ & + & 0.10395e+01_r8,0.49623e+01_r8,0.65429e+01_r8,0.76840e+01_r8,0.51623e+01_r8 /) + kbo(:, 3,56,12) = (/ & + & 0.13908e+01_r8,0.61440e+01_r8,0.80522e+01_r8,0.93640e+01_r8,0.64360e+01_r8 /) + kbo(:, 4,56,12) = (/ & + & 0.18031e+01_r8,0.74859e+01_r8,0.96627e+01_r8,0.11140e+02_r8,0.77842e+01_r8 /) + kbo(:, 5,56,12) = (/ & + & 0.22626e+01_r8,0.89798e+01_r8,0.11358e+02_r8,0.12960e+02_r8,0.91800e+01_r8 /) + kbo(:, 1,57,12) = (/ & + & 0.67513e+00_r8,0.36336e+01_r8,0.48180e+01_r8,0.56247e+01_r8,0.36284e+01_r8 /) + kbo(:, 2,57,12) = (/ & + & 0.93951e+00_r8,0.46135e+01_r8,0.60910e+01_r8,0.71671e+01_r8,0.47736e+01_r8 /) + kbo(:, 3,57,12) = (/ & + & 0.12699e+01_r8,0.57481e+01_r8,0.75541e+01_r8,0.88107e+01_r8,0.60168e+01_r8 /) + kbo(:, 4,57,12) = (/ & + & 0.16637e+01_r8,0.70362e+01_r8,0.91351e+01_r8,0.10564e+02_r8,0.73465e+01_r8 /) + kbo(:, 5,57,12) = (/ & + & 0.21102e+01_r8,0.84904e+01_r8,0.10807e+02_r8,0.12374e+02_r8,0.87256e+01_r8 /) + kbo(:, 1,58,12) = (/ & + & 0.60371e+00_r8,0.33725e+01_r8,0.44640e+01_r8,0.51801e+01_r8,0.32968e+01_r8 /) + kbo(:, 2,58,12) = (/ & + & 0.85131e+00_r8,0.42951e+01_r8,0.56822e+01_r8,0.66873e+01_r8,0.44155e+01_r8 /) + kbo(:, 3,58,12) = (/ & + & 0.11611e+01_r8,0.53867e+01_r8,0.70919e+01_r8,0.82985e+01_r8,0.56282e+01_r8 /) + kbo(:, 4,58,12) = (/ & + & 0.15366e+01_r8,0.66258e+01_r8,0.86445e+01_r8,0.10022e+02_r8,0.69358e+01_r8 /) + kbo(:, 5,58,12) = (/ & + & 0.19698e+01_r8,0.80329e+01_r8,0.10290e+02_r8,0.11819e+02_r8,0.83004e+01_r8 /) + kbo(:, 1,59,12) = (/ & + & 0.57552e+00_r8,0.32717e+01_r8,0.43250e+01_r8,0.50045e+01_r8,0.31668e+01_r8 /) + kbo(:, 2,59,12) = (/ & + & 0.81716e+00_r8,0.41713e+01_r8,0.55225e+01_r8,0.64964e+01_r8,0.42740e+01_r8 /) + kbo(:, 3,59,12) = (/ & + & 0.11190e+01_r8,0.52446e+01_r8,0.69091e+01_r8,0.80966e+01_r8,0.54744e+01_r8 /) + kbo(:, 4,59,12) = (/ & + & 0.14869e+01_r8,0.64659e+01_r8,0.84502e+01_r8,0.98065e+01_r8,0.67716e+01_r8 /) + kbo(:, 5,59,12) = (/ & + & 0.19139e+01_r8,0.78535e+01_r8,0.10085e+02_r8,0.11598e+02_r8,0.81311e+01_r8 /) + kbo(:, 1,13,13) = (/ & + & 0.79406e+02_r8,0.76977e+02_r8,0.79398e+02_r8,0.72265e+02_r8,0.70608e+02_r8 /) + kbo(:, 2,13,13) = (/ & + & 0.78716e+02_r8,0.76325e+02_r8,0.79145e+02_r8,0.72561e+02_r8,0.71233e+02_r8 /) + kbo(:, 3,13,13) = (/ & + & 0.77960e+02_r8,0.75684e+02_r8,0.78864e+02_r8,0.72811e+02_r8,0.71703e+02_r8 /) + kbo(:, 4,13,13) = (/ & + & 0.77172e+02_r8,0.75038e+02_r8,0.78462e+02_r8,0.73003e+02_r8,0.72067e+02_r8 /) + kbo(:, 5,13,13) = (/ & + & 0.76342e+02_r8,0.74357e+02_r8,0.78015e+02_r8,0.73077e+02_r8,0.72406e+02_r8 /) + kbo(:, 1,14,13) = (/ & + & 0.74002e+02_r8,0.75964e+02_r8,0.80244e+02_r8,0.73931e+02_r8,0.67973e+02_r8 /) + kbo(:, 2,14,13) = (/ & + & 0.73259e+02_r8,0.75350e+02_r8,0.80187e+02_r8,0.74373e+02_r8,0.68671e+02_r8 /) + kbo(:, 3,14,13) = (/ & + & 0.72511e+02_r8,0.74741e+02_r8,0.79998e+02_r8,0.74718e+02_r8,0.69297e+02_r8 /) + kbo(:, 4,14,13) = (/ & + & 0.71760e+02_r8,0.74129e+02_r8,0.79694e+02_r8,0.74933e+02_r8,0.69925e+02_r8 /) + kbo(:, 5,14,13) = (/ & + & 0.70963e+02_r8,0.73482e+02_r8,0.79282e+02_r8,0.75062e+02_r8,0.70592e+02_r8 /) + kbo(:, 1,15,13) = (/ & + & 0.67727e+02_r8,0.74204e+02_r8,0.79973e+02_r8,0.74524e+02_r8,0.64503e+02_r8 /) + kbo(:, 2,15,13) = (/ & + & 0.66995e+02_r8,0.73663e+02_r8,0.80067e+02_r8,0.75070e+02_r8,0.65404e+02_r8 /) + kbo(:, 3,15,13) = (/ & + & 0.66299e+02_r8,0.73080e+02_r8,0.80001e+02_r8,0.75489e+02_r8,0.66341e+02_r8 /) + kbo(:, 4,15,13) = (/ & + & 0.65584e+02_r8,0.72498e+02_r8,0.79808e+02_r8,0.75814e+02_r8,0.67293e+02_r8 /) + kbo(:, 5,15,13) = (/ & + & 0.64881e+02_r8,0.71894e+02_r8,0.79644e+02_r8,0.76073e+02_r8,0.68159e+02_r8 /) + kbo(:, 1,16,13) = (/ & + & 0.60910e+02_r8,0.71706e+02_r8,0.78658e+02_r8,0.73971e+02_r8,0.60740e+02_r8 /) + kbo(:, 2,16,13) = (/ & + & 0.60264e+02_r8,0.71204e+02_r8,0.78897e+02_r8,0.74647e+02_r8,0.61882e+02_r8 /) + kbo(:, 3,16,13) = (/ & + & 0.59646e+02_r8,0.70743e+02_r8,0.78998e+02_r8,0.75253e+02_r8,0.63062e+02_r8 /) + kbo(:, 4,16,13) = (/ & + & 0.59033e+02_r8,0.70274e+02_r8,0.79093e+02_r8,0.75819e+02_r8,0.64263e+02_r8 /) + kbo(:, 5,16,13) = (/ & + & 0.58482e+02_r8,0.69838e+02_r8,0.79175e+02_r8,0.76359e+02_r8,0.65453e+02_r8 /) + kbo(:, 1,17,13) = (/ & + & 0.53962e+02_r8,0.68666e+02_r8,0.76384e+02_r8,0.72467e+02_r8,0.57058e+02_r8 /) + kbo(:, 2,17,13) = (/ & + & 0.53430e+02_r8,0.68393e+02_r8,0.76843e+02_r8,0.73413e+02_r8,0.58438e+02_r8 /) + kbo(:, 3,17,13) = (/ & + & 0.52920e+02_r8,0.68105e+02_r8,0.77273e+02_r8,0.74323e+02_r8,0.59869e+02_r8 /) + kbo(:, 4,17,13) = (/ & + & 0.52483e+02_r8,0.67847e+02_r8,0.77698e+02_r8,0.75214e+02_r8,0.61307e+02_r8 /) + kbo(:, 5,17,13) = (/ & + & 0.52082e+02_r8,0.67535e+02_r8,0.78034e+02_r8,0.76077e+02_r8,0.62785e+02_r8 /) + kbo(:, 1,18,13) = (/ & + & 0.47235e+02_r8,0.65232e+02_r8,0.73440e+02_r8,0.70305e+02_r8,0.53676e+02_r8 /) + kbo(:, 2,18,13) = (/ & + & 0.46798e+02_r8,0.65205e+02_r8,0.74239e+02_r8,0.71589e+02_r8,0.55262e+02_r8 /) + kbo(:, 3,18,13) = (/ & + & 0.46439e+02_r8,0.65179e+02_r8,0.75037e+02_r8,0.72870e+02_r8,0.56922e+02_r8 /) + kbo(:, 4,18,13) = (/ & + & 0.46165e+02_r8,0.65077e+02_r8,0.75787e+02_r8,0.74113e+02_r8,0.58606e+02_r8 /) + kbo(:, 5,18,13) = (/ & + & 0.46076e+02_r8,0.64950e+02_r8,0.76497e+02_r8,0.75319e+02_r8,0.60364e+02_r8 /) + kbo(:, 1,19,13) = (/ & + & 0.40875e+02_r8,0.61443e+02_r8,0.70167e+02_r8,0.67815e+02_r8,0.50666e+02_r8 /) + kbo(:, 2,19,13) = (/ & + & 0.40599e+02_r8,0.61754e+02_r8,0.71348e+02_r8,0.69451e+02_r8,0.52443e+02_r8 /) + kbo(:, 3,19,13) = (/ & + & 0.40423e+02_r8,0.61971e+02_r8,0.72494e+02_r8,0.71103e+02_r8,0.54265e+02_r8 /) + kbo(:, 4,19,13) = (/ & + & 0.40489e+02_r8,0.62135e+02_r8,0.73624e+02_r8,0.72723e+02_r8,0.56176e+02_r8 /) + kbo(:, 5,19,13) = (/ & + & 0.40909e+02_r8,0.62251e+02_r8,0.74691e+02_r8,0.74287e+02_r8,0.58151e+02_r8 /) + kbo(:, 1,20,13) = (/ & + & 0.35203e+02_r8,0.57554e+02_r8,0.66740e+02_r8,0.65266e+02_r8,0.47986e+02_r8 /) + kbo(:, 2,20,13) = (/ & + & 0.35059e+02_r8,0.58164e+02_r8,0.68281e+02_r8,0.67270e+02_r8,0.49928e+02_r8 /) + kbo(:, 3,20,13) = (/ & + & 0.35179e+02_r8,0.58679e+02_r8,0.69865e+02_r8,0.69298e+02_r8,0.51957e+02_r8 /) + kbo(:, 4,20,13) = (/ & + & 0.35687e+02_r8,0.59136e+02_r8,0.71375e+02_r8,0.71295e+02_r8,0.54068e+02_r8 /) + kbo(:, 5,20,13) = (/ & + & 0.36572e+02_r8,0.59563e+02_r8,0.72814e+02_r8,0.73197e+02_r8,0.56184e+02_r8 /) + kbo(:, 1,21,13) = (/ & + & 0.30294e+02_r8,0.53730e+02_r8,0.63335e+02_r8,0.62843e+02_r8,0.45639e+02_r8 /) + kbo(:, 2,21,13) = (/ & + & 0.30407e+02_r8,0.54622e+02_r8,0.65309e+02_r8,0.65230e+02_r8,0.47736e+02_r8 /) + kbo(:, 3,21,13) = (/ & + & 0.30898e+02_r8,0.55470e+02_r8,0.67283e+02_r8,0.67630e+02_r8,0.49955e+02_r8 /) + kbo(:, 4,21,13) = (/ & + & 0.31814e+02_r8,0.56234e+02_r8,0.69205e+02_r8,0.69979e+02_r8,0.52223e+02_r8 /) + kbo(:, 5,21,13) = (/ & + & 0.33171e+02_r8,0.57002e+02_r8,0.70988e+02_r8,0.72170e+02_r8,0.54507e+02_r8 /) + kbo(:, 1,22,13) = (/ & + & 0.26203e+02_r8,0.50178e+02_r8,0.60369e+02_r8,0.60883e+02_r8,0.43752e+02_r8 /) + kbo(:, 2,22,13) = (/ & + & 0.26668e+02_r8,0.51399e+02_r8,0.62731e+02_r8,0.63628e+02_r8,0.46055e+02_r8 /) + kbo(:, 3,22,13) = (/ & + & 0.27573e+02_r8,0.52567e+02_r8,0.65094e+02_r8,0.66337e+02_r8,0.48427e+02_r8 /) + kbo(:, 4,22,13) = (/ & + & 0.28933e+02_r8,0.53710e+02_r8,0.67379e+02_r8,0.68992e+02_r8,0.50840e+02_r8 /) + kbo(:, 5,22,13) = (/ & + & 0.30713e+02_r8,0.54842e+02_r8,0.69500e+02_r8,0.71453e+02_r8,0.53313e+02_r8 /) + kbo(:, 1,23,13) = (/ & + & 0.22949e+02_r8,0.47062e+02_r8,0.57786e+02_r8,0.59287e+02_r8,0.42207e+02_r8 /) + kbo(:, 2,23,13) = (/ & + & 0.23779e+02_r8,0.48563e+02_r8,0.60567e+02_r8,0.62337e+02_r8,0.44709e+02_r8 /) + kbo(:, 3,23,13) = (/ & + & 0.25087e+02_r8,0.50088e+02_r8,0.63282e+02_r8,0.65361e+02_r8,0.47224e+02_r8 /) + kbo(:, 4,23,13) = (/ & + & 0.26833e+02_r8,0.51601e+02_r8,0.65861e+02_r8,0.68253e+02_r8,0.49790e+02_r8 /) + kbo(:, 5,23,13) = (/ & + & 0.28975e+02_r8,0.53148e+02_r8,0.68312e+02_r8,0.70979e+02_r8,0.52442e+02_r8 /) + kbo(:, 1,24,13) = (/ & + & 0.20450e+02_r8,0.44418e+02_r8,0.55719e+02_r8,0.58070e+02_r8,0.41028e+02_r8 /) + kbo(:, 2,24,13) = (/ & + & 0.21647e+02_r8,0.46218e+02_r8,0.58860e+02_r8,0.61413e+02_r8,0.43697e+02_r8 /) + kbo(:, 3,24,13) = (/ & + & 0.23313e+02_r8,0.48082e+02_r8,0.61856e+02_r8,0.64696e+02_r8,0.46357e+02_r8 /) + kbo(:, 4,24,13) = (/ & + & 0.25383e+02_r8,0.49987e+02_r8,0.64735e+02_r8,0.67792e+02_r8,0.49079e+02_r8 /) + kbo(:, 5,24,13) = (/ & + & 0.27788e+02_r8,0.51882e+02_r8,0.67449e+02_r8,0.70725e+02_r8,0.51885e+02_r8 /) + kbo(:, 1,25,13) = (/ & + & 0.18632e+02_r8,0.42267e+02_r8,0.54194e+02_r8,0.57249e+02_r8,0.40189e+02_r8 /) + kbo(:, 2,25,13) = (/ & + & 0.20151e+02_r8,0.44393e+02_r8,0.57583e+02_r8,0.60858e+02_r8,0.43004e+02_r8 /) + kbo(:, 3,25,13) = (/ & + & 0.22101e+02_r8,0.46593e+02_r8,0.60865e+02_r8,0.64337e+02_r8,0.45809e+02_r8 /) + kbo(:, 4,25,13) = (/ & + & 0.24391e+02_r8,0.48836e+02_r8,0.63984e+02_r8,0.67613e+02_r8,0.48696e+02_r8 /) + kbo(:, 5,25,13) = (/ & + & 0.26959e+02_r8,0.50995e+02_r8,0.66882e+02_r8,0.70682e+02_r8,0.51602e+02_r8 /) + kbo(:, 1,26,13) = (/ & + & 0.17370e+02_r8,0.40657e+02_r8,0.53173e+02_r8,0.56858e+02_r8,0.39692e+02_r8 /) + kbo(:, 2,26,13) = (/ & + & 0.19155e+02_r8,0.43087e+02_r8,0.56801e+02_r8,0.60671e+02_r8,0.42632e+02_r8 /) + kbo(:, 3,26,13) = (/ & + & 0.21292e+02_r8,0.45598e+02_r8,0.60302e+02_r8,0.64290e+02_r8,0.45592e+02_r8 /) + kbo(:, 4,26,13) = (/ & + & 0.23727e+02_r8,0.48098e+02_r8,0.63591e+02_r8,0.67690e+02_r8,0.48603e+02_r8 /) + kbo(:, 5,26,13) = (/ & + & 0.26455e+02_r8,0.50493e+02_r8,0.66616e+02_r8,0.70861e+02_r8,0.51588e+02_r8 /) + kbo(:, 1,27,13) = (/ & + & 0.16499e+02_r8,0.39533e+02_r8,0.52563e+02_r8,0.56787e+02_r8,0.39461e+02_r8 /) + kbo(:, 2,27,13) = (/ & + & 0.18462e+02_r8,0.42240e+02_r8,0.56391e+02_r8,0.60738e+02_r8,0.42525e+02_r8 /) + kbo(:, 3,27,13) = (/ & + & 0.20737e+02_r8,0.45009e+02_r8,0.60060e+02_r8,0.64459e+02_r8,0.45612e+02_r8 /) + kbo(:, 4,27,13) = (/ & + & 0.23336e+02_r8,0.47712e+02_r8,0.63452e+02_r8,0.67944e+02_r8,0.48705e+02_r8 /) + kbo(:, 5,27,13) = (/ & + & 0.26215e+02_r8,0.50322e+02_r8,0.66583e+02_r8,0.71174e+02_r8,0.51756e+02_r8 /) + kbo(:, 1,28,13) = (/ & + & 0.15882e+02_r8,0.38845e+02_r8,0.52318e+02_r8,0.56965e+02_r8,0.39468e+02_r8 /) + kbo(:, 2,28,13) = (/ & + & 0.17994e+02_r8,0.41785e+02_r8,0.56289e+02_r8,0.61007e+02_r8,0.42649e+02_r8 /) + kbo(:, 3,28,13) = (/ & + & 0.20424e+02_r8,0.44749e+02_r8,0.60052e+02_r8,0.64808e+02_r8,0.45826e+02_r8 /) + kbo(:, 4,28,13) = (/ & + & 0.23178e+02_r8,0.47630e+02_r8,0.63526e+02_r8,0.68347e+02_r8,0.48967e+02_r8 /) + kbo(:, 5,28,13) = (/ & + & 0.26217e+02_r8,0.50385e+02_r8,0.66714e+02_r8,0.71584e+02_r8,0.52071e+02_r8 /) + kbo(:, 1,29,13) = (/ & + & 0.15496e+02_r8,0.38533e+02_r8,0.52388e+02_r8,0.57377e+02_r8,0.39687e+02_r8 /) + kbo(:, 2,29,13) = (/ & + & 0.17758e+02_r8,0.41667e+02_r8,0.56458e+02_r8,0.61470e+02_r8,0.42963e+02_r8 /) + kbo(:, 3,29,13) = (/ & + & 0.20345e+02_r8,0.44782e+02_r8,0.60267e+02_r8,0.65320e+02_r8,0.46203e+02_r8 /) + kbo(:, 4,29,13) = (/ & + & 0.23257e+02_r8,0.47788e+02_r8,0.63789e+02_r8,0.68865e+02_r8,0.49378e+02_r8 /) + kbo(:, 5,29,13) = (/ & + & 0.26442e+02_r8,0.50623e+02_r8,0.67004e+02_r8,0.72085e+02_r8,0.52513e+02_r8 /) + kbo(:, 1,30,13) = (/ & + & 0.15305e+02_r8,0.38520e+02_r8,0.52687e+02_r8,0.57942e+02_r8,0.40075e+02_r8 /) + kbo(:, 2,30,13) = (/ & + & 0.17725e+02_r8,0.41787e+02_r8,0.56809e+02_r8,0.62069e+02_r8,0.43408e+02_r8 /) + kbo(:, 3,30,13) = (/ & + & 0.20471e+02_r8,0.45011e+02_r8,0.60646e+02_r8,0.65935e+02_r8,0.46678e+02_r8 /) + kbo(:, 4,30,13) = (/ & + & 0.23532e+02_r8,0.48109e+02_r8,0.64191e+02_r8,0.69457e+02_r8,0.49879e+02_r8 /) + kbo(:, 5,30,13) = (/ & + & 0.26835e+02_r8,0.50980e+02_r8,0.67409e+02_r8,0.72648e+02_r8,0.53041e+02_r8 /) + kbo(:, 1,31,13) = (/ & + & 0.15319e+02_r8,0.38759e+02_r8,0.53187e+02_r8,0.58637e+02_r8,0.40597e+02_r8 /) + kbo(:, 2,31,13) = (/ & + & 0.17890e+02_r8,0.42121e+02_r8,0.57326e+02_r8,0.62778e+02_r8,0.43969e+02_r8 /) + kbo(:, 3,31,13) = (/ & + & 0.20784e+02_r8,0.45419e+02_r8,0.61174e+02_r8,0.66627e+02_r8,0.47246e+02_r8 /) + kbo(:, 4,31,13) = (/ & + & 0.23963e+02_r8,0.48555e+02_r8,0.64709e+02_r8,0.70119e+02_r8,0.50470e+02_r8 /) + kbo(:, 5,31,13) = (/ & + & 0.27377e+02_r8,0.51448e+02_r8,0.67912e+02_r8,0.73265e+02_r8,0.53642e+02_r8 /) + kbo(:, 1,32,13) = (/ & + & 0.15518e+02_r8,0.39176e+02_r8,0.53833e+02_r8,0.59441e+02_r8,0.41231e+02_r8 /) + kbo(:, 2,32,13) = (/ & + & 0.18219e+02_r8,0.42608e+02_r8,0.57967e+02_r8,0.63575e+02_r8,0.44614e+02_r8 /) + kbo(:, 3,32,13) = (/ & + & 0.21240e+02_r8,0.45958e+02_r8,0.61807e+02_r8,0.67376e+02_r8,0.47899e+02_r8 /) + kbo(:, 4,32,13) = (/ & + & 0.24535e+02_r8,0.49103e+02_r8,0.65323e+02_r8,0.70819e+02_r8,0.51129e+02_r8 /) + kbo(:, 5,32,13) = (/ & + & 0.28030e+02_r8,0.51991e+02_r8,0.68477e+02_r8,0.73912e+02_r8,0.54297e+02_r8 /) + kbo(:, 1,33,13) = (/ & + & 0.15857e+02_r8,0.39728e+02_r8,0.54587e+02_r8,0.60326e+02_r8,0.41934e+02_r8 /) + kbo(:, 2,33,13) = (/ & + & 0.18681e+02_r8,0.43207e+02_r8,0.58700e+02_r8,0.64428e+02_r8,0.45312e+02_r8 /) + kbo(:, 3,33,13) = (/ & + & 0.21817e+02_r8,0.46584e+02_r8,0.62510e+02_r8,0.68164e+02_r8,0.48601e+02_r8 /) + kbo(:, 4,33,13) = (/ & + & 0.25208e+02_r8,0.49716e+02_r8,0.65986e+02_r8,0.71546e+02_r8,0.51832e+02_r8 /) + kbo(:, 5,33,13) = (/ & + & 0.28769e+02_r8,0.52588e+02_r8,0.69085e+02_r8,0.74576e+02_r8,0.54996e+02_r8 /) + kbo(:, 1,34,13) = (/ & + & 0.16218e+02_r8,0.40255e+02_r8,0.55264e+02_r8,0.61104e+02_r8,0.42563e+02_r8 /) + kbo(:, 2,34,13) = (/ & + & 0.19136e+02_r8,0.43775e+02_r8,0.59363e+02_r8,0.65173e+02_r8,0.45933e+02_r8 /) + kbo(:, 3,34,13) = (/ & + & 0.22367e+02_r8,0.47148e+02_r8,0.63138e+02_r8,0.68848e+02_r8,0.49223e+02_r8 /) + kbo(:, 4,34,13) = (/ & + & 0.25824e+02_r8,0.50264e+02_r8,0.66569e+02_r8,0.72180e+02_r8,0.52454e+02_r8 /) + kbo(:, 5,34,13) = (/ & + & 0.29432e+02_r8,0.53119e+02_r8,0.69617e+02_r8,0.75149e+02_r8,0.55607e+02_r8 /) + kbo(:, 1,35,13) = (/ & + & 0.16382e+02_r8,0.40509e+02_r8,0.55591e+02_r8,0.61512e+02_r8,0.42891e+02_r8 /) + kbo(:, 2,35,13) = (/ & + & 0.19362e+02_r8,0.44056e+02_r8,0.59682e+02_r8,0.65556e+02_r8,0.46259e+02_r8 /) + kbo(:, 3,35,13) = (/ & + & 0.22646e+02_r8,0.47437e+02_r8,0.63450e+02_r8,0.69212e+02_r8,0.49551e+02_r8 /) + kbo(:, 4,35,13) = (/ & + & 0.26140e+02_r8,0.50553e+02_r8,0.66864e+02_r8,0.72519e+02_r8,0.52785e+02_r8 /) + kbo(:, 5,35,13) = (/ & + & 0.29778e+02_r8,0.53403e+02_r8,0.69889e+02_r8,0.75460e+02_r8,0.55937e+02_r8 /) + kbo(:, 1,36,13) = (/ & + & 0.16282e+02_r8,0.40412e+02_r8,0.55499e+02_r8,0.61489e+02_r8,0.42866e+02_r8 /) + kbo(:, 2,36,13) = (/ & + & 0.19286e+02_r8,0.43996e+02_r8,0.59618e+02_r8,0.65550e+02_r8,0.46244e+02_r8 /) + kbo(:, 3,36,13) = (/ & + & 0.22586e+02_r8,0.47399e+02_r8,0.63406e+02_r8,0.69212e+02_r8,0.49542e+02_r8 /) + kbo(:, 4,36,13) = (/ & + & 0.26096e+02_r8,0.50533e+02_r8,0.66829e+02_r8,0.72526e+02_r8,0.52781e+02_r8 /) + kbo(:, 5,36,13) = (/ & + & 0.29750e+02_r8,0.53407e+02_r8,0.69875e+02_r8,0.75478e+02_r8,0.55943e+02_r8 /) + kbo(:, 1,37,13) = (/ & + & 0.15776e+02_r8,0.39797e+02_r8,0.54788e+02_r8,0.60844e+02_r8,0.42332e+02_r8 /) + kbo(:, 2,37,13) = (/ & + & 0.18757e+02_r8,0.43418e+02_r8,0.58970e+02_r8,0.64965e+02_r8,0.45736e+02_r8 /) + kbo(:, 3,37,13) = (/ & + & 0.22032e+02_r8,0.46879e+02_r8,0.62830e+02_r8,0.68697e+02_r8,0.49053e+02_r8 /) + kbo(:, 4,37,13) = (/ & + & 0.25533e+02_r8,0.50076e+02_r8,0.66324e+02_r8,0.72072e+02_r8,0.52311e+02_r8 /) + kbo(:, 5,37,13) = (/ & + & 0.29180e+02_r8,0.52997e+02_r8,0.69437e+02_r8,0.75080e+02_r8,0.55481e+02_r8 /) + kbo(:, 1,38,13) = (/ & + & 0.15271e+02_r8,0.39166e+02_r8,0.54054e+02_r8,0.60165e+02_r8,0.41777e+02_r8 /) + kbo(:, 2,38,13) = (/ & + & 0.18227e+02_r8,0.42823e+02_r8,0.58302e+02_r8,0.64350e+02_r8,0.45207e+02_r8 /) + kbo(:, 3,38,13) = (/ & + & 0.21473e+02_r8,0.46333e+02_r8,0.62224e+02_r8,0.68144e+02_r8,0.48540e+02_r8 /) + kbo(:, 4,38,13) = (/ & + & 0.24954e+02_r8,0.49588e+02_r8,0.65790e+02_r8,0.71578e+02_r8,0.51811e+02_r8 /) + kbo(:, 5,38,13) = (/ & + & 0.28592e+02_r8,0.52564e+02_r8,0.68973e+02_r8,0.74653e+02_r8,0.55000e+02_r8 /) + kbo(:, 1,39,13) = (/ & + & 0.14788e+02_r8,0.38557e+02_r8,0.53339e+02_r8,0.59493e+02_r8,0.41232e+02_r8 /) + kbo(:, 2,39,13) = (/ & + & 0.17725e+02_r8,0.42239e+02_r8,0.57643e+02_r8,0.63735e+02_r8,0.44689e+02_r8 /) + kbo(:, 3,39,13) = (/ & + & 0.20936e+02_r8,0.45800e+02_r8,0.61629e+02_r8,0.67599e+02_r8,0.48036e+02_r8 /) + kbo(:, 4,39,13) = (/ & + & 0.24393e+02_r8,0.49102e+02_r8,0.65258e+02_r8,0.71089e+02_r8,0.51322e+02_r8 /) + kbo(:, 5,39,13) = (/ & + & 0.28020e+02_r8,0.52130e+02_r8,0.68507e+02_r8,0.74225e+02_r8,0.54528e+02_r8 /) + kbo(:, 1,40,13) = (/ & + & 0.14035e+02_r8,0.37576e+02_r8,0.52178e+02_r8,0.58374e+02_r8,0.40328e+02_r8 /) + kbo(:, 2,40,13) = (/ & + & 0.16933e+02_r8,0.41290e+02_r8,0.56557e+02_r8,0.62694e+02_r8,0.43829e+02_r8 /) + kbo(:, 3,40,13) = (/ & + & 0.20073e+02_r8,0.44909e+02_r8,0.60638e+02_r8,0.66668e+02_r8,0.47203e+02_r8 /) + kbo(:, 4,40,13) = (/ & + & 0.23486e+02_r8,0.48287e+02_r8,0.64365e+02_r8,0.70250e+02_r8,0.50504e+02_r8 /) + kbo(:, 5,40,13) = (/ & + & 0.27084e+02_r8,0.51393e+02_r8,0.67719e+02_r8,0.73485e+02_r8,0.53736e+02_r8 /) + kbo(:, 1,41,13) = (/ & + & 0.13270e+02_r8,0.36551e+02_r8,0.50952e+02_r8,0.57187e+02_r8,0.39381e+02_r8 /) + kbo(:, 2,41,13) = (/ & + & 0.16132e+02_r8,0.40293e+02_r8,0.55396e+02_r8,0.61573e+02_r8,0.42921e+02_r8 /) + kbo(:, 3,41,13) = (/ & + & 0.19195e+02_r8,0.43957e+02_r8,0.59575e+02_r8,0.65658e+02_r8,0.46320e+02_r8 /) + kbo(:, 4,41,13) = (/ & + & 0.22552e+02_r8,0.47415e+02_r8,0.63413e+02_r8,0.69340e+02_r8,0.49639e+02_r8 /) + kbo(:, 5,41,13) = (/ & + & 0.26115e+02_r8,0.50603e+02_r8,0.66868e+02_r8,0.72675e+02_r8,0.52897e+02_r8 /) + kbo(:, 1,42,13) = (/ & + & 0.12533e+02_r8,0.35537e+02_r8,0.49715e+02_r8,0.55979e+02_r8,0.38430e+02_r8 /) + kbo(:, 2,42,13) = (/ & + & 0.15340e+02_r8,0.39292e+02_r8,0.54229e+02_r8,0.60445e+02_r8,0.42004e+02_r8 /) + kbo(:, 3,42,13) = (/ & + & 0.18342e+02_r8,0.42991e+02_r8,0.58494e+02_r8,0.64631e+02_r8,0.45437e+02_r8 /) + kbo(:, 4,42,13) = (/ & + & 0.21634e+02_r8,0.46527e+02_r8,0.62435e+02_r8,0.68417e+02_r8,0.48777e+02_r8 /) + kbo(:, 5,42,13) = (/ & + & 0.25154e+02_r8,0.49791e+02_r8,0.65989e+02_r8,0.71836e+02_r8,0.52054e+02_r8 /) + kbo(:, 1,43,13) = (/ & + & 0.11668e+02_r8,0.34309e+02_r8,0.48203e+02_r8,0.54498e+02_r8,0.37270e+02_r8 /) + kbo(:, 2,43,13) = (/ & + & 0.14402e+02_r8,0.38082e+02_r8,0.52797e+02_r8,0.59048e+02_r8,0.40873e+02_r8 /) + kbo(:, 3,43,13) = (/ & + & 0.17344e+02_r8,0.41812e+02_r8,0.57160e+02_r8,0.63341e+02_r8,0.44355e+02_r8 /) + kbo(:, 4,43,13) = (/ & + & 0.20545e+02_r8,0.45427e+02_r8,0.61209e+02_r8,0.67260e+02_r8,0.47724e+02_r8 /) + kbo(:, 5,43,13) = (/ & + & 0.24007e+02_r8,0.48779e+02_r8,0.64893e+02_r8,0.70794e+02_r8,0.51019e+02_r8 /) + kbo(:, 1,44,13) = (/ & + & 0.10777e+02_r8,0.32982e+02_r8,0.46555e+02_r8,0.52865e+02_r8,0.36017e+02_r8 /) + kbo(:, 2,44,13) = (/ & + & 0.13422e+02_r8,0.36774e+02_r8,0.51234e+02_r8,0.57518e+02_r8,0.39647e+02_r8 /) + kbo(:, 3,44,13) = (/ & + & 0.16301e+02_r8,0.40529e+02_r8,0.55688e+02_r8,0.61909e+02_r8,0.43184e+02_r8 /) + kbo(:, 4,44,13) = (/ & + & 0.19410e+02_r8,0.44205e+02_r8,0.59841e+02_r8,0.65956e+02_r8,0.46575e+02_r8 /) + kbo(:, 5,44,13) = (/ & + & 0.22792e+02_r8,0.47657e+02_r8,0.63668e+02_r8,0.69623e+02_r8,0.49898e+02_r8 /) + kbo(:, 1,45,13) = (/ & + & 0.99376e+01_r8,0.31658e+02_r8,0.44891e+02_r8,0.51201e+02_r8,0.34758e+02_r8 /) + kbo(:, 2,45,13) = (/ & + & 0.12468e+02_r8,0.35468e+02_r8,0.49648e+02_r8,0.55955e+02_r8,0.38412e+02_r8 /) + kbo(:, 3,45,13) = (/ & + & 0.15282e+02_r8,0.39240e+02_r8,0.54182e+02_r8,0.60441e+02_r8,0.41991e+02_r8 /) + kbo(:, 4,45,13) = (/ & + & 0.18307e+02_r8,0.42958e+02_r8,0.58447e+02_r8,0.64617e+02_r8,0.45427e+02_r8 /) + kbo(:, 5,45,13) = (/ & + & 0.21602e+02_r8,0.46508e+02_r8,0.62404e+02_r8,0.68417e+02_r8,0.48775e+02_r8 /) + kbo(:, 1,46,13) = (/ & + & 0.90997e+01_r8,0.30250e+02_r8,0.43114e+02_r8,0.49420e+02_r8,0.33417e+02_r8 /) + kbo(:, 2,46,13) = (/ & + & 0.11497e+02_r8,0.34076e+02_r8,0.47932e+02_r8,0.54263e+02_r8,0.37087e+02_r8 /) + kbo(:, 3,46,13) = (/ & + & 0.14229e+02_r8,0.37865e+02_r8,0.52547e+02_r8,0.58836e+02_r8,0.40705e+02_r8 /) + kbo(:, 4,46,13) = (/ & + & 0.17178e+02_r8,0.41613e+02_r8,0.56930e+02_r8,0.63142e+02_r8,0.44193e+02_r8 /) + kbo(:, 5,46,13) = (/ & + & 0.20366e+02_r8,0.45251e+02_r8,0.61008e+02_r8,0.67091e+02_r8,0.47569e+02_r8 /) + kbo(:, 1,47,13) = (/ & + & 0.82326e+01_r8,0.28698e+02_r8,0.41131e+02_r8,0.47406e+02_r8,0.31895e+02_r8 /) + kbo(:, 2,47,13) = (/ & + & 0.10467e+02_r8,0.32516e+02_r8,0.45987e+02_r8,0.52322e+02_r8,0.35605e+02_r8 /) + kbo(:, 3,47,13) = (/ & + & 0.13084e+02_r8,0.36324e+02_r8,0.50700e+02_r8,0.57015e+02_r8,0.39250e+02_r8 /) + kbo(:, 4,47,13) = (/ & + & 0.15956e+02_r8,0.40097e+02_r8,0.55181e+02_r8,0.61437e+02_r8,0.42802e+02_r8 /) + kbo(:, 5,47,13) = (/ & + & 0.19031e+02_r8,0.43799e+02_r8,0.59396e+02_r8,0.65543e+02_r8,0.46212e+02_r8 /) + kbo(:, 1,48,13) = (/ & + & 0.74393e+01_r8,0.27161e+02_r8,0.39157e+02_r8,0.45343e+02_r8,0.30350e+02_r8 /) + kbo(:, 2,48,13) = (/ & + & 0.95049e+01_r8,0.30953e+02_r8,0.44020e+02_r8,0.50347e+02_r8,0.34113e+02_r8 /) + kbo(:, 3,48,13) = (/ & + & 0.11978e+02_r8,0.34782e+02_r8,0.48813e+02_r8,0.55151e+02_r8,0.37782e+02_r8 /) + kbo(:, 4,48,13) = (/ & + & 0.14764e+02_r8,0.38570e+02_r8,0.53387e+02_r8,0.59681e+02_r8,0.41384e+02_r8 /) + kbo(:, 5,48,13) = (/ & + & 0.17748e+02_r8,0.42312e+02_r8,0.57728e+02_r8,0.63933e+02_r8,0.44844e+02_r8 /) + kbo(:, 1,49,13) = (/ & + & 0.67167e+01_r8,0.25650e+02_r8,0.37197e+02_r8,0.43247e+02_r8,0.28796e+02_r8 /) + kbo(:, 2,49,13) = (/ & + & 0.86101e+01_r8,0.29402e+02_r8,0.42045e+02_r8,0.48354e+02_r8,0.32610e+02_r8 /) + kbo(:, 3,49,13) = (/ & + & 0.10926e+02_r8,0.33234e+02_r8,0.46891e+02_r8,0.53243e+02_r8,0.36305e+02_r8 /) + kbo(:, 4,49,13) = (/ & + & 0.13605e+02_r8,0.37035e+02_r8,0.51562e+02_r8,0.57884e+02_r8,0.39936e+02_r8 /) + kbo(:, 5,49,13) = (/ & + & 0.16513e+02_r8,0.40804e+02_r8,0.56010e+02_r8,0.62260e+02_r8,0.43466e+02_r8 /) + kbo(:, 1,50,13) = (/ & + & 0.60927e+01_r8,0.24264e+02_r8,0.35366e+02_r8,0.41271e+02_r8,0.27331e+02_r8 /) + kbo(:, 2,50,13) = (/ & + & 0.78376e+01_r8,0.27958e+02_r8,0.40194e+02_r8,0.46451e+02_r8,0.31176e+02_r8 /) + kbo(:, 3,50,13) = (/ & + & 0.99975e+01_r8,0.31777e+02_r8,0.45061e+02_r8,0.51408e+02_r8,0.34914e+02_r8 /) + kbo(:, 4,50,13) = (/ & + & 0.12552e+02_r8,0.35595e+02_r8,0.49816e+02_r8,0.56159e+02_r8,0.38569e+02_r8 /) + kbo(:, 5,50,13) = (/ & + & 0.15384e+02_r8,0.39379e+02_r8,0.54352e+02_r8,0.60637e+02_r8,0.42153e+02_r8 /) + kbo(:, 1,51,13) = (/ & + & 0.55303e+01_r8,0.22951e+02_r8,0.33599e+02_r8,0.39341e+02_r8,0.25901e+02_r8 /) + kbo(:, 2,51,13) = (/ & + & 0.71468e+01_r8,0.26574e+02_r8,0.38412e+02_r8,0.44565e+02_r8,0.29771e+02_r8 /) + kbo(:, 3,51,13) = (/ & + & 0.91530e+01_r8,0.30360e+02_r8,0.43274e+02_r8,0.49608e+02_r8,0.33559e+02_r8 /) + kbo(:, 4,51,13) = (/ & + & 0.11570e+02_r8,0.34196e+02_r8,0.48091e+02_r8,0.54457e+02_r8,0.37233e+02_r8 /) + kbo(:, 5,51,13) = (/ & + & 0.14322e+02_r8,0.37996e+02_r8,0.52708e+02_r8,0.59018e+02_r8,0.40851e+02_r8 /) + kbo(:, 1,52,13) = (/ & + & 0.50134e+01_r8,0.21673e+02_r8,0.31833e+02_r8,0.37382e+02_r8,0.24463e+02_r8 /) + kbo(:, 2,52,13) = (/ & + & 0.65135e+01_r8,0.25216e+02_r8,0.36639e+02_r8,0.42658e+02_r8,0.28359e+02_r8 /) + kbo(:, 3,52,13) = (/ & + & 0.83642e+01_r8,0.28959e+02_r8,0.41485e+02_r8,0.47797e+02_r8,0.32187e+02_r8 /) + kbo(:, 4,52,13) = (/ & + & 0.10636e+02_r8,0.32789e+02_r8,0.46344e+02_r8,0.52709e+02_r8,0.35895e+02_r8 /) + kbo(:, 5,52,13) = (/ & + & 0.13285e+02_r8,0.36604e+02_r8,0.51047e+02_r8,0.57380e+02_r8,0.39540e+02_r8 /) + kbo(:, 1,53,13) = (/ & + & 0.45376e+01_r8,0.20438e+02_r8,0.30067e+02_r8,0.35396e+02_r8,0.23001e+02_r8 /) + kbo(:, 2,53,13) = (/ & + & 0.59241e+01_r8,0.23884e+02_r8,0.34872e+02_r8,0.40744e+02_r8,0.26941e+02_r8 /) + kbo(:, 3,53,13) = (/ & + & 0.76354e+01_r8,0.27568e+02_r8,0.39698e+02_r8,0.45939e+02_r8,0.30794e+02_r8 /) + kbo(:, 4,53,13) = (/ & + & 0.97536e+01_r8,0.31378e+02_r8,0.44569e+02_r8,0.50924e+02_r8,0.34545e+02_r8 /) + kbo(:, 5,53,13) = (/ & + & 0.12275e+02_r8,0.35210e+02_r8,0.49348e+02_r8,0.55701e+02_r8,0.38212e+02_r8 /) + kbo(:, 1,54,13) = (/ & + & 0.41389e+01_r8,0.19353e+02_r8,0.28454e+02_r8,0.33563e+02_r8,0.21647e+02_r8 /) + kbo(:, 2,54,13) = (/ & + & 0.54194e+01_r8,0.22692e+02_r8,0.33259e+02_r8,0.38976e+02_r8,0.25632e+02_r8 /) + kbo(:, 3,54,13) = (/ & + & 0.70164e+01_r8,0.26307e+02_r8,0.38072e+02_r8,0.44208e+02_r8,0.29508e+02_r8 /) + kbo(:, 4,54,13) = (/ & + & 0.89936e+01_r8,0.30086e+02_r8,0.42934e+02_r8,0.49276e+02_r8,0.33306e+02_r8 /) + kbo(:, 5,54,13) = (/ & + & 0.11387e+02_r8,0.33931e+02_r8,0.47765e+02_r8,0.54132e+02_r8,0.36987e+02_r8 /) + kbo(:, 1,55,13) = (/ & + & 0.37927e+01_r8,0.18358e+02_r8,0.26927e+02_r8,0.31801e+02_r8,0.20350e+02_r8 /) + kbo(:, 2,55,13) = (/ & + & 0.49755e+01_r8,0.21582e+02_r8,0.31711e+02_r8,0.37250e+02_r8,0.24368e+02_r8 /) + kbo(:, 3,55,13) = (/ & + & 0.64669e+01_r8,0.25119e+02_r8,0.36517e+02_r8,0.42532e+02_r8,0.28268e+02_r8 /) + kbo(:, 4,55,13) = (/ & + & 0.83082e+01_r8,0.28857e+02_r8,0.41362e+02_r8,0.47679e+02_r8,0.32095e+02_r8 /) + kbo(:, 5,55,13) = (/ & + & 0.10573e+02_r8,0.32695e+02_r8,0.46225e+02_r8,0.52593e+02_r8,0.35810e+02_r8 /) + kbo(:, 1,56,13) = (/ & + & 0.34680e+01_r8,0.17374e+02_r8,0.25413e+02_r8,0.30039e+02_r8,0.19069e+02_r8 /) + kbo(:, 2,56,13) = (/ & + & 0.45601e+01_r8,0.20503e+02_r8,0.30163e+02_r8,0.35509e+02_r8,0.23088e+02_r8 /) + kbo(:, 3,56,13) = (/ & + & 0.59518e+01_r8,0.23956e+02_r8,0.34971e+02_r8,0.40858e+02_r8,0.27027e+02_r8 /) + kbo(:, 4,56,13) = (/ & + & 0.76711e+01_r8,0.27642e+02_r8,0.39801e+02_r8,0.46057e+02_r8,0.30878e+02_r8 /) + kbo(:, 5,56,13) = (/ & + & 0.98017e+01_r8,0.31462e+02_r8,0.44674e+02_r8,0.51031e+02_r8,0.34630e+02_r8 /) + kbo(:, 1,57,13) = (/ & + & 0.31571e+01_r8,0.16389e+02_r8,0.23903e+02_r8,0.28270e+02_r8,0.17802e+02_r8 /) + kbo(:, 2,57,13) = (/ & + & 0.41775e+01_r8,0.19466e+02_r8,0.28628e+02_r8,0.33765e+02_r8,0.21796e+02_r8 /) + kbo(:, 3,57,13) = (/ & + & 0.54676e+01_r8,0.22817e+02_r8,0.33433e+02_r8,0.39170e+02_r8,0.25777e+02_r8 /) + kbo(:, 4,57,13) = (/ & + & 0.70767e+01_r8,0.26436e+02_r8,0.38248e+02_r8,0.44404e+02_r8,0.29650e+02_r8 /) + kbo(:, 5,57,13) = (/ & + & 0.90728e+01_r8,0.30224e+02_r8,0.43110e+02_r8,0.49455e+02_r8,0.33445e+02_r8 /) + kbo(:, 1,58,13) = (/ & + & 0.28749e+01_r8,0.15464e+02_r8,0.22485e+02_r8,0.26596e+02_r8,0.16612e+02_r8 /) + kbo(:, 2,58,13) = (/ & + & 0.38438e+01_r8,0.18517e+02_r8,0.27179e+02_r8,0.32099e+02_r8,0.20568e+02_r8 /) + kbo(:, 3,58,13) = (/ & + & 0.50410e+01_r8,0.21758e+02_r8,0.31967e+02_r8,0.37546e+02_r8,0.24584e+02_r8 /) + kbo(:, 4,58,13) = (/ & + & 0.65535e+01_r8,0.25311e+02_r8,0.36779e+02_r8,0.42823e+02_r8,0.28478e+02_r8 /) + kbo(:, 5,58,13) = (/ & + & 0.84187e+01_r8,0.29065e+02_r8,0.41628e+02_r8,0.47951e+02_r8,0.32304e+02_r8 /) + kbo(:, 1,59,13) = (/ & + & 0.27657e+01_r8,0.15098e+02_r8,0.21927e+02_r8,0.25930e+02_r8,0.16137e+02_r8 /) + kbo(:, 2,59,13) = (/ & + & 0.37163e+01_r8,0.18141e+02_r8,0.26603e+02_r8,0.31433e+02_r8,0.20078e+02_r8 /) + kbo(:, 3,59,13) = (/ & + & 0.48770e+01_r8,0.21342e+02_r8,0.31379e+02_r8,0.36884e+02_r8,0.24100e+02_r8 /) + kbo(:, 4,59,13) = (/ & + & 0.63518e+01_r8,0.24865e+02_r8,0.36188e+02_r8,0.42182e+02_r8,0.28007e+02_r8 /) + kbo(:, 5,59,13) = (/ & + & 0.81684e+01_r8,0.28600e+02_r8,0.41035e+02_r8,0.47343e+02_r8,0.31847e+02_r8 /) + kbo(:, 1,13,14) = (/ & + & 0.20563e+03_r8,0.16395e+03_r8,0.15131e+03_r8,0.13928e+03_r8,0.17336e+03_r8 /) + kbo(:, 2,13,14) = (/ & + & 0.20583e+03_r8,0.16346e+03_r8,0.15102e+03_r8,0.13867e+03_r8,0.17209e+03_r8 /) + kbo(:, 3,13,14) = (/ & + & 0.20579e+03_r8,0.16282e+03_r8,0.15051e+03_r8,0.13803e+03_r8,0.17119e+03_r8 /) + kbo(:, 4,13,14) = (/ & + & 0.20538e+03_r8,0.16198e+03_r8,0.15005e+03_r8,0.13746e+03_r8,0.17062e+03_r8 /) + kbo(:, 5,13,14) = (/ & + & 0.20471e+03_r8,0.16100e+03_r8,0.14942e+03_r8,0.13685e+03_r8,0.16998e+03_r8 /) + kbo(:, 1,14,14) = (/ & + & 0.21387e+03_r8,0.17486e+03_r8,0.16410e+03_r8,0.14896e+03_r8,0.17926e+03_r8 /) + kbo(:, 2,14,14) = (/ & + & 0.21398e+03_r8,0.17407e+03_r8,0.16354e+03_r8,0.14849e+03_r8,0.17872e+03_r8 /) + kbo(:, 3,14,14) = (/ & + & 0.21371e+03_r8,0.17306e+03_r8,0.16300e+03_r8,0.14796e+03_r8,0.17838e+03_r8 /) + kbo(:, 4,14,14) = (/ & + & 0.21320e+03_r8,0.17193e+03_r8,0.16238e+03_r8,0.14748e+03_r8,0.17807e+03_r8 /) + kbo(:, 5,14,14) = (/ & + & 0.21239e+03_r8,0.17062e+03_r8,0.16158e+03_r8,0.14661e+03_r8,0.17726e+03_r8 /) + kbo(:, 1,15,14) = (/ & + & 0.21868e+03_r8,0.18392e+03_r8,0.17597e+03_r8,0.15877e+03_r8,0.18409e+03_r8 /) + kbo(:, 2,15,14) = (/ & + & 0.21861e+03_r8,0.18285e+03_r8,0.17533e+03_r8,0.15845e+03_r8,0.18413e+03_r8 /) + kbo(:, 3,15,14) = (/ & + & 0.21838e+03_r8,0.18168e+03_r8,0.17469e+03_r8,0.15814e+03_r8,0.18423e+03_r8 /) + kbo(:, 4,15,14) = (/ & + & 0.21785e+03_r8,0.18028e+03_r8,0.17392e+03_r8,0.15747e+03_r8,0.18391e+03_r8 /) + kbo(:, 5,15,14) = (/ & + & 0.21714e+03_r8,0.17881e+03_r8,0.17281e+03_r8,0.15644e+03_r8,0.18337e+03_r8 /) + kbo(:, 1,16,14) = (/ & + & 0.21989e+03_r8,0.19090e+03_r8,0.18666e+03_r8,0.16823e+03_r8,0.18717e+03_r8 /) + kbo(:, 2,16,14) = (/ & + & 0.22000e+03_r8,0.18989e+03_r8,0.18604e+03_r8,0.16822e+03_r8,0.18797e+03_r8 /) + kbo(:, 3,16,14) = (/ & + & 0.21982e+03_r8,0.18856e+03_r8,0.18533e+03_r8,0.16794e+03_r8,0.18851e+03_r8 /) + kbo(:, 4,16,14) = (/ & + & 0.21954e+03_r8,0.18709e+03_r8,0.18432e+03_r8,0.16715e+03_r8,0.18854e+03_r8 /) + kbo(:, 5,16,14) = (/ & + & 0.21898e+03_r8,0.18542e+03_r8,0.18303e+03_r8,0.16600e+03_r8,0.18839e+03_r8 /) + kbo(:, 1,17,14) = (/ & + & 0.21793e+03_r8,0.19596e+03_r8,0.19603e+03_r8,0.17703e+03_r8,0.18857e+03_r8 /) + kbo(:, 2,17,14) = (/ & + & 0.21821e+03_r8,0.19492e+03_r8,0.19548e+03_r8,0.17725e+03_r8,0.19023e+03_r8 /) + kbo(:, 3,17,14) = (/ & + & 0.21850e+03_r8,0.19369e+03_r8,0.19462e+03_r8,0.17701e+03_r8,0.19133e+03_r8 /) + kbo(:, 4,17,14) = (/ & + & 0.21855e+03_r8,0.19221e+03_r8,0.19343e+03_r8,0.17616e+03_r8,0.19194e+03_r8 /) + kbo(:, 5,17,14) = (/ & + & 0.21839e+03_r8,0.19057e+03_r8,0.19206e+03_r8,0.17490e+03_r8,0.19225e+03_r8 /) + kbo(:, 1,18,14) = (/ & + & 0.21311e+03_r8,0.19935e+03_r8,0.20385e+03_r8,0.18492e+03_r8,0.18864e+03_r8 /) + kbo(:, 2,18,14) = (/ & + & 0.21399e+03_r8,0.19838e+03_r8,0.20339e+03_r8,0.18536e+03_r8,0.19117e+03_r8 /) + kbo(:, 3,18,14) = (/ & + & 0.21477e+03_r8,0.19727e+03_r8,0.20251e+03_r8,0.18517e+03_r8,0.19296e+03_r8 /) + kbo(:, 4,18,14) = (/ & + & 0.21537e+03_r8,0.19602e+03_r8,0.20131e+03_r8,0.18433e+03_r8,0.19426e+03_r8 /) + kbo(:, 5,18,14) = (/ & + & 0.21594e+03_r8,0.19460e+03_r8,0.19989e+03_r8,0.18299e+03_r8,0.19511e+03_r8 /) + kbo(:, 1,19,14) = (/ & + & 0.20628e+03_r8,0.20131e+03_r8,0.21018e+03_r8,0.19181e+03_r8,0.18780e+03_r8 /) + kbo(:, 2,19,14) = (/ & + & 0.20786e+03_r8,0.20061e+03_r8,0.20985e+03_r8,0.19249e+03_r8,0.19117e+03_r8 /) + kbo(:, 3,19,14) = (/ & + & 0.20939e+03_r8,0.19978e+03_r8,0.20915e+03_r8,0.19245e+03_r8,0.19379e+03_r8 /) + kbo(:, 4,19,14) = (/ & + & 0.21078e+03_r8,0.19876e+03_r8,0.20808e+03_r8,0.19159e+03_r8,0.19578e+03_r8 /) + kbo(:, 5,19,14) = (/ & + & 0.21196e+03_r8,0.19762e+03_r8,0.20666e+03_r8,0.19020e+03_r8,0.19726e+03_r8 /) + kbo(:, 1,20,14) = (/ & + & 0.19806e+03_r8,0.20215e+03_r8,0.21525e+03_r8,0.19781e+03_r8,0.18646e+03_r8 /) + kbo(:, 2,20,14) = (/ & + & 0.20054e+03_r8,0.20180e+03_r8,0.21527e+03_r8,0.19874e+03_r8,0.19072e+03_r8 /) + kbo(:, 3,20,14) = (/ & + & 0.20298e+03_r8,0.20132e+03_r8,0.21478e+03_r8,0.19877e+03_r8,0.19413e+03_r8 /) + kbo(:, 4,20,14) = (/ & + & 0.20522e+03_r8,0.20070e+03_r8,0.21384e+03_r8,0.19793e+03_r8,0.19681e+03_r8 /) + kbo(:, 5,20,14) = (/ & + & 0.20725e+03_r8,0.19975e+03_r8,0.21249e+03_r8,0.19659e+03_r8,0.19899e+03_r8 /) + kbo(:, 1,21,14) = (/ & + & 0.18919e+03_r8,0.20217e+03_r8,0.21942e+03_r8,0.20291e+03_r8,0.18499e+03_r8 /) + kbo(:, 2,21,14) = (/ & + & 0.19268e+03_r8,0.20239e+03_r8,0.21974e+03_r8,0.20415e+03_r8,0.19012e+03_r8 /) + kbo(:, 3,21,14) = (/ & + & 0.19609e+03_r8,0.20231e+03_r8,0.21947e+03_r8,0.20425e+03_r8,0.19432e+03_r8 /) + kbo(:, 4,21,14) = (/ & + & 0.19926e+03_r8,0.20201e+03_r8,0.21866e+03_r8,0.20346e+03_r8,0.19770e+03_r8 /) + kbo(:, 5,21,14) = (/ & + & 0.20224e+03_r8,0.20136e+03_r8,0.21742e+03_r8,0.20212e+03_r8,0.20044e+03_r8 /) + kbo(:, 1,22,14) = (/ & + & 0.18064e+03_r8,0.20182e+03_r8,0.22276e+03_r8,0.20740e+03_r8,0.18409e+03_r8 /) + kbo(:, 2,22,14) = (/ & + & 0.18513e+03_r8,0.20253e+03_r8,0.22341e+03_r8,0.20876e+03_r8,0.18988e+03_r8 /) + kbo(:, 3,22,14) = (/ & + & 0.18951e+03_r8,0.20287e+03_r8,0.22329e+03_r8,0.20890e+03_r8,0.19474e+03_r8 /) + kbo(:, 4,22,14) = (/ & + & 0.19368e+03_r8,0.20283e+03_r8,0.22259e+03_r8,0.20812e+03_r8,0.19869e+03_r8 /) + kbo(:, 5,22,14) = (/ & + & 0.19752e+03_r8,0.20248e+03_r8,0.22143e+03_r8,0.20676e+03_r8,0.20185e+03_r8 /) + kbo(:, 1,23,14) = (/ & + & 0.17261e+03_r8,0.20129e+03_r8,0.22560e+03_r8,0.21126e+03_r8,0.18360e+03_r8 /) + kbo(:, 2,23,14) = (/ & + & 0.17813e+03_r8,0.20255e+03_r8,0.22645e+03_r8,0.21277e+03_r8,0.18993e+03_r8 /) + kbo(:, 3,23,14) = (/ & + & 0.18347e+03_r8,0.20322e+03_r8,0.22649e+03_r8,0.21288e+03_r8,0.19534e+03_r8 /) + kbo(:, 4,23,14) = (/ & + & 0.18858e+03_r8,0.20345e+03_r8,0.22593e+03_r8,0.21211e+03_r8,0.19972e+03_r8 /) + kbo(:, 5,23,14) = (/ & + & 0.19325e+03_r8,0.20330e+03_r8,0.22470e+03_r8,0.21066e+03_r8,0.20314e+03_r8 /) + kbo(:, 1,24,14) = (/ & + & 0.16550e+03_r8,0.20079e+03_r8,0.22797e+03_r8,0.21459e+03_r8,0.18352e+03_r8 /) + kbo(:, 2,24,14) = (/ & + & 0.17199e+03_r8,0.20247e+03_r8,0.22899e+03_r8,0.21614e+03_r8,0.19031e+03_r8 /) + kbo(:, 3,24,14) = (/ & + & 0.17829e+03_r8,0.20349e+03_r8,0.22920e+03_r8,0.21621e+03_r8,0.19610e+03_r8 /) + kbo(:, 4,24,14) = (/ & + & 0.18424e+03_r8,0.20395e+03_r8,0.22865e+03_r8,0.21544e+03_r8,0.20080e+03_r8 /) + kbo(:, 5,24,14) = (/ & + & 0.18966e+03_r8,0.20393e+03_r8,0.22735e+03_r8,0.21388e+03_r8,0.20437e+03_r8 /) + kbo(:, 1,25,14) = (/ & + & 0.15949e+03_r8,0.20048e+03_r8,0.22999e+03_r8,0.21758e+03_r8,0.18395e+03_r8 /) + kbo(:, 2,25,14) = (/ & + & 0.16698e+03_r8,0.20247e+03_r8,0.23119e+03_r8,0.21903e+03_r8,0.19108e+03_r8 /) + kbo(:, 3,25,14) = (/ & + & 0.17411e+03_r8,0.20370e+03_r8,0.23144e+03_r8,0.21904e+03_r8,0.19711e+03_r8 /) + kbo(:, 4,25,14) = (/ & + & 0.18088e+03_r8,0.20435e+03_r8,0.23082e+03_r8,0.21817e+03_r8,0.20192e+03_r8 /) + kbo(:, 5,25,14) = (/ & + & 0.18710e+03_r8,0.20450e+03_r8,0.22950e+03_r8,0.21648e+03_r8,0.20559e+03_r8 /) + kbo(:, 1,26,14) = (/ & + & 0.15479e+03_r8,0.20038e+03_r8,0.23181e+03_r8,0.22016e+03_r8,0.18490e+03_r8 /) + kbo(:, 2,26,14) = (/ & + & 0.16322e+03_r8,0.20258e+03_r8,0.23307e+03_r8,0.22145e+03_r8,0.19222e+03_r8 /) + kbo(:, 3,26,14) = (/ & + & 0.17119e+03_r8,0.20401e+03_r8,0.23326e+03_r8,0.22140e+03_r8,0.19831e+03_r8 /) + kbo(:, 4,26,14) = (/ & + & 0.17866e+03_r8,0.20478e+03_r8,0.23259e+03_r8,0.22038e+03_r8,0.20315e+03_r8 /) + kbo(:, 5,26,14) = (/ & + & 0.18553e+03_r8,0.20498e+03_r8,0.23122e+03_r8,0.21854e+03_r8,0.20685e+03_r8 /) + kbo(:, 1,27,14) = (/ & + & 0.15143e+03_r8,0.20049e+03_r8,0.23344e+03_r8,0.22241e+03_r8,0.18615e+03_r8 /) + kbo(:, 2,27,14) = (/ & + & 0.16070e+03_r8,0.20279e+03_r8,0.23465e+03_r8,0.22352e+03_r8,0.19353e+03_r8 /) + kbo(:, 3,27,14) = (/ & + & 0.16932e+03_r8,0.20430e+03_r8,0.23473e+03_r8,0.22331e+03_r8,0.19960e+03_r8 /) + kbo(:, 4,27,14) = (/ & + & 0.17737e+03_r8,0.20518e+03_r8,0.23402e+03_r8,0.22212e+03_r8,0.20440e+03_r8 /) + kbo(:, 5,27,14) = (/ & + & 0.18472e+03_r8,0.20537e+03_r8,0.23257e+03_r8,0.22015e+03_r8,0.20807e+03_r8 /) + kbo(:, 1,28,14) = (/ & + & 0.14935e+03_r8,0.20078e+03_r8,0.23487e+03_r8,0.22436e+03_r8,0.18762e+03_r8 /) + kbo(:, 2,28,14) = (/ & + & 0.15926e+03_r8,0.20312e+03_r8,0.23597e+03_r8,0.22523e+03_r8,0.19491e+03_r8 /) + kbo(:, 3,28,14) = (/ & + & 0.16839e+03_r8,0.20467e+03_r8,0.23597e+03_r8,0.22484e+03_r8,0.20092e+03_r8 /) + kbo(:, 4,28,14) = (/ & + & 0.17687e+03_r8,0.20554e+03_r8,0.23516e+03_r8,0.22345e+03_r8,0.20562e+03_r8 /) + kbo(:, 5,28,14) = (/ & + & 0.18453e+03_r8,0.20570e+03_r8,0.23357e+03_r8,0.22135e+03_r8,0.20921e+03_r8 /) + kbo(:, 1,29,14) = (/ & + & 0.14844e+03_r8,0.20117e+03_r8,0.23614e+03_r8,0.22601e+03_r8,0.18927e+03_r8 /) + kbo(:, 2,29,14) = (/ & + & 0.15878e+03_r8,0.20350e+03_r8,0.23707e+03_r8,0.22664e+03_r8,0.19642e+03_r8 /) + kbo(:, 3,29,14) = (/ & + & 0.16829e+03_r8,0.20505e+03_r8,0.23696e+03_r8,0.22601e+03_r8,0.20229e+03_r8 /) + kbo(:, 4,29,14) = (/ & + & 0.17702e+03_r8,0.20585e+03_r8,0.23602e+03_r8,0.22445e+03_r8,0.20685e+03_r8 /) + kbo(:, 5,29,14) = (/ & + & 0.18487e+03_r8,0.20599e+03_r8,0.23430e+03_r8,0.22220e+03_r8,0.21031e+03_r8 /) + kbo(:, 1,30,14) = (/ & + & 0.14841e+03_r8,0.20165e+03_r8,0.23724e+03_r8,0.22742e+03_r8,0.19101e+03_r8 /) + kbo(:, 2,30,14) = (/ & + & 0.15903e+03_r8,0.20395e+03_r8,0.23798e+03_r8,0.22774e+03_r8,0.19796e+03_r8 /) + kbo(:, 3,30,14) = (/ & + & 0.16878e+03_r8,0.20543e+03_r8,0.23774e+03_r8,0.22689e+03_r8,0.20367e+03_r8 /) + kbo(:, 4,30,14) = (/ & + & 0.17765e+03_r8,0.20614e+03_r8,0.23662e+03_r8,0.22515e+03_r8,0.20804e+03_r8 /) + kbo(:, 5,30,14) = (/ & + & 0.18556e+03_r8,0.20626e+03_r8,0.23478e+03_r8,0.22274e+03_r8,0.21133e+03_r8 /) + kbo(:, 1,31,14) = (/ & + & 0.14910e+03_r8,0.20219e+03_r8,0.23816e+03_r8,0.22857e+03_r8,0.19280e+03_r8 /) + kbo(:, 2,31,14) = (/ & + & 0.15987e+03_r8,0.20442e+03_r8,0.23873e+03_r8,0.22860e+03_r8,0.19955e+03_r8 /) + kbo(:, 3,31,14) = (/ & + & 0.16974e+03_r8,0.20578e+03_r8,0.23830e+03_r8,0.22751e+03_r8,0.20503e+03_r8 /) + kbo(:, 4,31,14) = (/ & + & 0.17870e+03_r8,0.20640e+03_r8,0.23703e+03_r8,0.22559e+03_r8,0.20917e+03_r8 /) + kbo(:, 5,31,14) = (/ & + & 0.18656e+03_r8,0.20647e+03_r8,0.23504e+03_r8,0.22303e+03_r8,0.21232e+03_r8 /) + kbo(:, 1,32,14) = (/ & + & 0.15031e+03_r8,0.20279e+03_r8,0.23897e+03_r8,0.22949e+03_r8,0.19459e+03_r8 /) + kbo(:, 2,32,14) = (/ & + & 0.16119e+03_r8,0.20489e+03_r8,0.23931e+03_r8,0.22922e+03_r8,0.20113e+03_r8 /) + kbo(:, 3,32,14) = (/ & + & 0.17110e+03_r8,0.20610e+03_r8,0.23869e+03_r8,0.22791e+03_r8,0.20634e+03_r8 /) + kbo(:, 4,32,14) = (/ & + & 0.18002e+03_r8,0.20662e+03_r8,0.23723e+03_r8,0.22582e+03_r8,0.21029e+03_r8 /) + kbo(:, 5,32,14) = (/ & + & 0.18777e+03_r8,0.20659e+03_r8,0.23510e+03_r8,0.22308e+03_r8,0.21322e+03_r8 /) + kbo(:, 1,33,14) = (/ & + & 0.15197e+03_r8,0.20341e+03_r8,0.23965e+03_r8,0.23019e+03_r8,0.19639e+03_r8 /) + kbo(:, 2,33,14) = (/ & + & 0.16285e+03_r8,0.20534e+03_r8,0.23976e+03_r8,0.22964e+03_r8,0.20267e+03_r8 /) + kbo(:, 3,33,14) = (/ & + & 0.17270e+03_r8,0.20638e+03_r8,0.23893e+03_r8,0.22811e+03_r8,0.20758e+03_r8 /) + kbo(:, 4,33,14) = (/ & + & 0.18151e+03_r8,0.20680e+03_r8,0.23727e+03_r8,0.22584e+03_r8,0.21132e+03_r8 /) + kbo(:, 5,33,14) = (/ & + & 0.18912e+03_r8,0.20665e+03_r8,0.23500e+03_r8,0.22296e+03_r8,0.21406e+03_r8 /) + kbo(:, 1,34,14) = (/ & + & 0.15352e+03_r8,0.20391e+03_r8,0.24014e+03_r8,0.23069e+03_r8,0.19790e+03_r8 /) + kbo(:, 2,34,14) = (/ & + & 0.16437e+03_r8,0.20566e+03_r8,0.24006e+03_r8,0.22992e+03_r8,0.20396e+03_r8 /) + kbo(:, 3,34,14) = (/ & + & 0.17416e+03_r8,0.20662e+03_r8,0.23907e+03_r8,0.22823e+03_r8,0.20863e+03_r8 /) + kbo(:, 4,34,14) = (/ & + & 0.18285e+03_r8,0.20695e+03_r8,0.23728e+03_r8,0.22580e+03_r8,0.21218e+03_r8 /) + kbo(:, 5,34,14) = (/ & + & 0.19033e+03_r8,0.20667e+03_r8,0.23487e+03_r8,0.22280e+03_r8,0.21474e+03_r8 /) + kbo(:, 1,35,14) = (/ & + & 0.15421e+03_r8,0.20418e+03_r8,0.24052e+03_r8,0.23110e+03_r8,0.19876e+03_r8 /) + kbo(:, 2,35,14) = (/ & + & 0.16507e+03_r8,0.20586e+03_r8,0.24033e+03_r8,0.23020e+03_r8,0.20468e+03_r8 /) + kbo(:, 3,35,14) = (/ & + & 0.17486e+03_r8,0.20677e+03_r8,0.23924e+03_r8,0.22841e+03_r8,0.20923e+03_r8 /) + kbo(:, 4,35,14) = (/ & + & 0.18350e+03_r8,0.20705e+03_r8,0.23737e+03_r8,0.22589e+03_r8,0.21269e+03_r8 /) + kbo(:, 5,35,14) = (/ & + & 0.19094e+03_r8,0.20669e+03_r8,0.23489e+03_r8,0.22281e+03_r8,0.21514e+03_r8 /) + kbo(:, 1,36,14) = (/ & + & 0.15381e+03_r8,0.20424e+03_r8,0.24080e+03_r8,0.23145e+03_r8,0.19888e+03_r8 /) + kbo(:, 2,36,14) = (/ & + & 0.16478e+03_r8,0.20592e+03_r8,0.24060e+03_r8,0.23055e+03_r8,0.20484e+03_r8 /) + kbo(:, 3,36,14) = (/ & + & 0.17464e+03_r8,0.20684e+03_r8,0.23950e+03_r8,0.22874e+03_r8,0.20938e+03_r8 /) + kbo(:, 4,36,14) = (/ & + & 0.18336e+03_r8,0.20715e+03_r8,0.23762e+03_r8,0.22618e+03_r8,0.21284e+03_r8 /) + kbo(:, 5,36,14) = (/ & + & 0.19086e+03_r8,0.20678e+03_r8,0.23514e+03_r8,0.22311e+03_r8,0.21532e+03_r8 /) + kbo(:, 1,37,14) = (/ & + & 0.15177e+03_r8,0.20394e+03_r8,0.24096e+03_r8,0.23178e+03_r8,0.19802e+03_r8 /) + kbo(:, 2,37,14) = (/ & + & 0.16298e+03_r8,0.20578e+03_r8,0.24091e+03_r8,0.23102e+03_r8,0.20416e+03_r8 /) + kbo(:, 3,37,14) = (/ & + & 0.17307e+03_r8,0.20681e+03_r8,0.23994e+03_r8,0.22934e+03_r8,0.20893e+03_r8 /) + kbo(:, 4,37,14) = (/ & + & 0.18204e+03_r8,0.20721e+03_r8,0.23818e+03_r8,0.22688e+03_r8,0.21255e+03_r8 /) + kbo(:, 5,37,14) = (/ & + & 0.18973e+03_r8,0.20695e+03_r8,0.23573e+03_r8,0.22383e+03_r8,0.21516e+03_r8 /) + kbo(:, 1,38,14) = (/ & + & 0.14968e+03_r8,0.20359e+03_r8,0.24104e+03_r8,0.23202e+03_r8,0.19703e+03_r8 /) + kbo(:, 2,38,14) = (/ & + & 0.16113e+03_r8,0.20560e+03_r8,0.24116e+03_r8,0.23143e+03_r8,0.20341e+03_r8 /) + kbo(:, 3,38,14) = (/ & + & 0.17144e+03_r8,0.20674e+03_r8,0.24033e+03_r8,0.22988e+03_r8,0.20838e+03_r8 /) + kbo(:, 4,38,14) = (/ & + & 0.18063e+03_r8,0.20724e+03_r8,0.23866e+03_r8,0.22752e+03_r8,0.21216e+03_r8 /) + kbo(:, 5,38,14) = (/ & + & 0.18855e+03_r8,0.20710e+03_r8,0.23632e+03_r8,0.22453e+03_r8,0.21493e+03_r8 /) + kbo(:, 1,39,14) = (/ & + & 0.14764e+03_r8,0.20322e+03_r8,0.24106e+03_r8,0.23220e+03_r8,0.19604e+03_r8 /) + kbo(:, 2,39,14) = (/ & + & 0.15932e+03_r8,0.20540e+03_r8,0.24137e+03_r8,0.23180e+03_r8,0.20262e+03_r8 /) + kbo(:, 3,39,14) = (/ & + & 0.16984e+03_r8,0.20665e+03_r8,0.24065e+03_r8,0.23036e+03_r8,0.20781e+03_r8 /) + kbo(:, 4,39,14) = (/ & + & 0.17923e+03_r8,0.20725e+03_r8,0.23910e+03_r8,0.22810e+03_r8,0.21175e+03_r8 /) + kbo(:, 5,39,14) = (/ & + & 0.18737e+03_r8,0.20722e+03_r8,0.23684e+03_r8,0.22517e+03_r8,0.21467e+03_r8 /) + kbo(:, 1,40,14) = (/ & + & 0.14438e+03_r8,0.20254e+03_r8,0.24092e+03_r8,0.23225e+03_r8,0.19425e+03_r8 /) + kbo(:, 2,40,14) = (/ & + & 0.15633e+03_r8,0.20498e+03_r8,0.24152e+03_r8,0.23217e+03_r8,0.20115e+03_r8 /) + kbo(:, 3,40,14) = (/ & + & 0.16718e+03_r8,0.20642e+03_r8,0.24105e+03_r8,0.23096e+03_r8,0.20672e+03_r8 /) + kbo(:, 4,40,14) = (/ & + & 0.17690e+03_r8,0.20720e+03_r8,0.23969e+03_r8,0.22887e+03_r8,0.21093e+03_r8 /) + kbo(:, 5,40,14) = (/ & + & 0.18539e+03_r8,0.20733e+03_r8,0.23758e+03_r8,0.22609e+03_r8,0.21411e+03_r8 /) + kbo(:, 1,41,14) = (/ & + & 0.14093e+03_r8,0.20170e+03_r8,0.24062e+03_r8,0.23214e+03_r8,0.19226e+03_r8 /) + kbo(:, 2,41,14) = (/ & + & 0.15309e+03_r8,0.20441e+03_r8,0.24155e+03_r8,0.23243e+03_r8,0.19951e+03_r8 /) + kbo(:, 3,41,14) = (/ & + & 0.16434e+03_r8,0.20613e+03_r8,0.24136e+03_r8,0.23149e+03_r8,0.20545e+03_r8 /) + kbo(:, 4,41,14) = (/ & + & 0.17439e+03_r8,0.20709e+03_r8,0.24022e+03_r8,0.22963e+03_r8,0.21000e+03_r8 /) + kbo(:, 5,41,14) = (/ & + & 0.18325e+03_r8,0.20739e+03_r8,0.23829e+03_r8,0.22700e+03_r8,0.21344e+03_r8 /) + kbo(:, 1,42,14) = (/ & + & 0.13742e+03_r8,0.20072e+03_r8,0.24018e+03_r8,0.23188e+03_r8,0.19017e+03_r8 /) + kbo(:, 2,42,14) = (/ & + & 0.14987e+03_r8,0.20381e+03_r8,0.24151e+03_r8,0.23260e+03_r8,0.19778e+03_r8 /) + kbo(:, 3,42,14) = (/ & + & 0.16144e+03_r8,0.20580e+03_r8,0.24159e+03_r8,0.23194e+03_r8,0.20408e+03_r8 /) + kbo(:, 4,42,14) = (/ & + & 0.17182e+03_r8,0.20693e+03_r8,0.24068e+03_r8,0.23030e+03_r8,0.20897e+03_r8 /) + kbo(:, 5,42,14) = (/ & + & 0.18101e+03_r8,0.20739e+03_r8,0.23894e+03_r8,0.22785e+03_r8,0.21269e+03_r8 /) + kbo(:, 1,43,14) = (/ & + & 0.13316e+03_r8,0.19946e+03_r8,0.23952e+03_r8,0.23134e+03_r8,0.18746e+03_r8 /) + kbo(:, 2,43,14) = (/ & + & 0.14590e+03_r8,0.20299e+03_r8,0.24131e+03_r8,0.23265e+03_r8,0.19555e+03_r8 /) + kbo(:, 3,43,14) = (/ & + & 0.15782e+03_r8,0.20531e+03_r8,0.24176e+03_r8,0.23237e+03_r8,0.20228e+03_r8 /) + kbo(:, 4,43,14) = (/ & + & 0.16860e+03_r8,0.20666e+03_r8,0.24113e+03_r8,0.23099e+03_r8,0.20761e+03_r8 /) + kbo(:, 5,43,14) = (/ & + & 0.17818e+03_r8,0.20733e+03_r8,0.23964e+03_r8,0.22878e+03_r8,0.21166e+03_r8 /) + kbo(:, 1,44,14) = (/ & + & 0.12851e+03_r8,0.19793e+03_r8,0.23860e+03_r8,0.23051e+03_r8,0.18440e+03_r8 /) + kbo(:, 2,44,14) = (/ & + & 0.14156e+03_r8,0.20195e+03_r8,0.24092e+03_r8,0.23249e+03_r8,0.19298e+03_r8 /) + kbo(:, 3,44,14) = (/ & + & 0.15381e+03_r8,0.20468e+03_r8,0.24182e+03_r8,0.23268e+03_r8,0.20015e+03_r8 /) + kbo(:, 4,44,14) = (/ & + & 0.16494e+03_r8,0.20625e+03_r8,0.24148e+03_r8,0.23163e+03_r8,0.20597e+03_r8 /) + kbo(:, 5,44,14) = (/ & + & 0.17499e+03_r8,0.20719e+03_r8,0.24029e+03_r8,0.22969e+03_r8,0.21043e+03_r8 /) + kbo(:, 1,45,14) = (/ & + & 0.12377e+03_r8,0.19622e+03_r8,0.23745e+03_r8,0.22938e+03_r8,0.18114e+03_r8 /) + kbo(:, 2,45,14) = (/ & + & 0.13713e+03_r8,0.20074e+03_r8,0.24035e+03_r8,0.23210e+03_r8,0.19024e+03_r8 /) + kbo(:, 3,45,14) = (/ & + & 0.14969e+03_r8,0.20389e+03_r8,0.24171e+03_r8,0.23283e+03_r8,0.19787e+03_r8 /) + kbo(:, 4,45,14) = (/ & + & 0.16122e+03_r8,0.20580e+03_r8,0.24172e+03_r8,0.23215e+03_r8,0.20417e+03_r8 /) + kbo(:, 5,45,14) = (/ & + & 0.17169e+03_r8,0.20697e+03_r8,0.24085e+03_r8,0.23051e+03_r8,0.20907e+03_r8 /) + kbo(:, 1,46,14) = (/ & + & 0.11871e+03_r8,0.19418e+03_r8,0.23600e+03_r8,0.22790e+03_r8,0.17747e+03_r8 /) + kbo(:, 2,46,14) = (/ & + & 0.13231e+03_r8,0.19929e+03_r8,0.23954e+03_r8,0.23143e+03_r8,0.18712e+03_r8 /) + kbo(:, 3,46,14) = (/ & + & 0.14514e+03_r8,0.20288e+03_r8,0.24138e+03_r8,0.23280e+03_r8,0.19526e+03_r8 /) + kbo(:, 4,46,14) = (/ & + & 0.15711e+03_r8,0.20523e+03_r8,0.24187e+03_r8,0.23257e+03_r8,0.20207e+03_r8 /) + kbo(:, 5,46,14) = (/ & + & 0.16802e+03_r8,0.20664e+03_r8,0.24132e+03_r8,0.23126e+03_r8,0.20749e+03_r8 /) + kbo(:, 1,47,14) = (/ & + & 0.11295e+03_r8,0.19159e+03_r8,0.23398e+03_r8,0.22588e+03_r8,0.17313e+03_r8 /) + kbo(:, 2,47,14) = (/ & + & 0.12683e+03_r8,0.19741e+03_r8,0.23835e+03_r8,0.23031e+03_r8,0.18342e+03_r8 /) + kbo(:, 3,47,14) = (/ & + & 0.13999e+03_r8,0.20159e+03_r8,0.24085e+03_r8,0.23253e+03_r8,0.19217e+03_r8 /) + kbo(:, 4,47,14) = (/ & + & 0.15234e+03_r8,0.20442e+03_r8,0.24186e+03_r8,0.23286e+03_r8,0.19949e+03_r8 /) + kbo(:, 5,47,14) = (/ & + & 0.16373e+03_r8,0.20618e+03_r8,0.24169e+03_r8,0.23194e+03_r8,0.20549e+03_r8 /) + kbo(:, 1,48,14) = (/ & + & 0.10712e+03_r8,0.18871e+03_r8,0.23159e+03_r8,0.22347e+03_r8,0.16850e+03_r8 /) + kbo(:, 2,48,14) = (/ & + & 0.12124e+03_r8,0.19529e+03_r8,0.23687e+03_r8,0.22882e+03_r8,0.17946e+03_r8 /) + kbo(:, 3,48,14) = (/ & + & 0.13473e+03_r8,0.20007e+03_r8,0.24005e+03_r8,0.23191e+03_r8,0.18883e+03_r8 /) + kbo(:, 4,48,14) = (/ & + & 0.14742e+03_r8,0.20342e+03_r8,0.24164e+03_r8,0.23294e+03_r8,0.19670e+03_r8 /) + kbo(:, 5,48,14) = (/ & + & 0.15928e+03_r8,0.20562e+03_r8,0.24192e+03_r8,0.23247e+03_r8,0.20325e+03_r8 /) + kbo(:, 1,49,14) = (/ & + & 0.10120e+03_r8,0.18550e+03_r8,0.22880e+03_r8,0.22071e+03_r8,0.16363e+03_r8 /) + kbo(:, 2,49,14) = (/ & + & 0.11556e+03_r8,0.19285e+03_r8,0.23504e+03_r8,0.22697e+03_r8,0.17524e+03_r8 /) + kbo(:, 3,49,14) = (/ & + & 0.12932e+03_r8,0.19832e+03_r8,0.23901e+03_r8,0.23097e+03_r8,0.18524e+03_r8 /) + kbo(:, 4,49,14) = (/ & + & 0.14238e+03_r8,0.20226e+03_r8,0.24120e+03_r8,0.23278e+03_r8,0.19370e+03_r8 /) + kbo(:, 5,49,14) = (/ & + & 0.15460e+03_r8,0.20488e+03_r8,0.24199e+03_r8,0.23283e+03_r8,0.20078e+03_r8 /) + kbo(:, 1,50,14) = (/ & + & 0.95603e+02_r8,0.18216e+03_r8,0.22576e+03_r8,0.21768e+03_r8,0.15878e+03_r8 /) + kbo(:, 2,50,14) = (/ & + & 0.11015e+03_r8,0.19031e+03_r8,0.23298e+03_r8,0.22490e+03_r8,0.17105e+03_r8 /) + kbo(:, 3,50,14) = (/ & + & 0.12415e+03_r8,0.19646e+03_r8,0.23775e+03_r8,0.22975e+03_r8,0.18166e+03_r8 /) + kbo(:, 4,50,14) = (/ & + & 0.13752e+03_r8,0.20094e+03_r8,0.24058e+03_r8,0.23236e+03_r8,0.19069e+03_r8 /) + kbo(:, 5,50,14) = (/ & + & 0.15007e+03_r8,0.20403e+03_r8,0.24187e+03_r8,0.23299e+03_r8,0.19826e+03_r8 /) + kbo(:, 1,51,14) = (/ & + & 0.90137e+02_r8,0.17868e+03_r8,0.22240e+03_r8,0.21442e+03_r8,0.15384e+03_r8 /) + kbo(:, 2,51,14) = (/ & + & 0.10484e+03_r8,0.18757e+03_r8,0.23066e+03_r8,0.22258e+03_r8,0.16677e+03_r8 /) + kbo(:, 3,51,14) = (/ & + & 0.11907e+03_r8,0.19442e+03_r8,0.23628e+03_r8,0.22824e+03_r8,0.17796e+03_r8 /) + kbo(:, 4,51,14) = (/ & + & 0.13269e+03_r8,0.19948e+03_r8,0.23976e+03_r8,0.23167e+03_r8,0.18756e+03_r8 /) + kbo(:, 5,51,14) = (/ & + & 0.14552e+03_r8,0.20302e+03_r8,0.24154e+03_r8,0.23296e+03_r8,0.19565e+03_r8 /) + kbo(:, 1,52,14) = (/ & + & 0.84690e+02_r8,0.17496e+03_r8,0.21864e+03_r8,0.21080e+03_r8,0.14862e+03_r8 /) + kbo(:, 2,52,14) = (/ & + & 0.99471e+02_r8,0.18453e+03_r8,0.22798e+03_r8,0.21992e+03_r8,0.16225e+03_r8 /) + kbo(:, 3,52,14) = (/ & + & 0.11391e+03_r8,0.19213e+03_r8,0.23451e+03_r8,0.22644e+03_r8,0.17406e+03_r8 /) + kbo(:, 4,52,14) = (/ & + & 0.12777e+03_r8,0.19781e+03_r8,0.23872e+03_r8,0.23070e+03_r8,0.18424e+03_r8 /) + kbo(:, 5,52,14) = (/ & + & 0.14091e+03_r8,0.20189e+03_r8,0.24107e+03_r8,0.23273e+03_r8,0.19286e+03_r8 /) + kbo(:, 1,53,14) = (/ & + & 0.79262e+02_r8,0.17095e+03_r8,0.21436e+03_r8,0.20681e+03_r8,0.14317e+03_r8 /) + kbo(:, 2,53,14) = (/ & + & 0.94047e+02_r8,0.18126e+03_r8,0.22494e+03_r8,0.21690e+03_r8,0.15748e+03_r8 /) + kbo(:, 3,53,14) = (/ & + & 0.10865e+03_r8,0.18958e+03_r8,0.23241e+03_r8,0.22434e+03_r8,0.16994e+03_r8 /) + kbo(:, 4,53,14) = (/ & + & 0.12274e+03_r8,0.19595e+03_r8,0.23742e+03_r8,0.22941e+03_r8,0.18070e+03_r8 /) + kbo(:, 5,53,14) = (/ & + & 0.13618e+03_r8,0.20056e+03_r8,0.24040e+03_r8,0.23224e+03_r8,0.18988e+03_r8 /) + kbo(:, 1,54,14) = (/ & + & 0.74312e+02_r8,0.16701e+03_r8,0.21000e+03_r8,0.20283e+03_r8,0.13801e+03_r8 /) + kbo(:, 2,54,14) = (/ & + & 0.89059e+02_r8,0.17802e+03_r8,0.22177e+03_r8,0.21381e+03_r8,0.15289e+03_r8 /) + kbo(:, 3,54,14) = (/ & + & 0.10379e+03_r8,0.18701e+03_r8,0.23021e+03_r8,0.22214e+03_r8,0.16595e+03_r8 /) + kbo(:, 4,54,14) = (/ & + & 0.11808e+03_r8,0.19403e+03_r8,0.23602e+03_r8,0.22797e+03_r8,0.17728e+03_r8 /) + kbo(:, 5,54,14) = (/ & + & 0.13174e+03_r8,0.19918e+03_r8,0.23961e+03_r8,0.23155e+03_r8,0.18697e+03_r8 /) + kbo(:, 1,55,14) = (/ & + & 0.69615e+02_r8,0.16296e+03_r8,0.20540e+03_r8,0.19866e+03_r8,0.13288e+03_r8 /) + kbo(:, 2,55,14) = (/ & + & 0.84276e+02_r8,0.17466e+03_r8,0.21835e+03_r8,0.21056e+03_r8,0.14828e+03_r8 /) + kbo(:, 3,55,14) = (/ & + & 0.99066e+02_r8,0.18433e+03_r8,0.22782e+03_r8,0.21977e+03_r8,0.16197e+03_r8 /) + kbo(:, 4,55,14) = (/ & + & 0.11354e+03_r8,0.19199e+03_r8,0.23442e+03_r8,0.22636e+03_r8,0.17383e+03_r8 /) + kbo(:, 5,55,14) = (/ & + & 0.12741e+03_r8,0.19770e+03_r8,0.23866e+03_r8,0.23065e+03_r8,0.18403e+03_r8 /) + kbo(:, 1,56,14) = (/ & + & 0.64944e+02_r8,0.15877e+03_r8,0.20044e+03_r8,0.19421e+03_r8,0.12762e+03_r8 /) + kbo(:, 2,56,14) = (/ & + & 0.79524e+02_r8,0.17114e+03_r8,0.21461e+03_r8,0.20707e+03_r8,0.14351e+03_r8 /) + kbo(:, 3,56,14) = (/ & + & 0.94323e+02_r8,0.18144e+03_r8,0.22514e+03_r8,0.21711e+03_r8,0.15778e+03_r8 /) + kbo(:, 4,56,14) = (/ & + & 0.10894e+03_r8,0.18976e+03_r8,0.23257e+03_r8,0.22452e+03_r8,0.17022e+03_r8 /) + kbo(:, 5,56,14) = (/ & + & 0.12301e+03_r8,0.19605e+03_r8,0.23752e+03_r8,0.22954e+03_r8,0.18094e+03_r8 /) + kbo(:, 1,57,14) = (/ & + & 0.60353e+02_r8,0.15431e+03_r8,0.19514e+03_r8,0.18945e+03_r8,0.12225e+03_r8 /) + kbo(:, 2,57,14) = (/ & + & 0.74815e+02_r8,0.16742e+03_r8,0.21049e+03_r8,0.20329e+03_r8,0.13860e+03_r8 /) + kbo(:, 3,57,14) = (/ & + & 0.89567e+02_r8,0.17837e+03_r8,0.22214e+03_r8,0.21419e+03_r8,0.15343e+03_r8 /) + kbo(:, 4,57,14) = (/ & + & 0.10431e+03_r8,0.18733e+03_r8,0.23050e+03_r8,0.22244e+03_r8,0.16644e+03_r8 /) + kbo(:, 5,57,14) = (/ & + & 0.11856e+03_r8,0.19423e+03_r8,0.23618e+03_r8,0.22816e+03_r8,0.17767e+03_r8 /) + kbo(:, 1,58,14) = (/ & + & 0.56098e+02_r8,0.14991e+03_r8,0.18980e+03_r8,0.18465e+03_r8,0.11706e+03_r8 /) + kbo(:, 2,58,14) = (/ & + & 0.70377e+02_r8,0.16367e+03_r8,0.20622e+03_r8,0.19942e+03_r8,0.13378e+03_r8 /) + kbo(:, 3,58,14) = (/ & + & 0.85049e+02_r8,0.17528e+03_r8,0.21902e+03_r8,0.21119e+03_r8,0.14910e+03_r8 /) + kbo(:, 4,58,14) = (/ & + & 0.99857e+02_r8,0.18482e+03_r8,0.22827e+03_r8,0.22022e+03_r8,0.16268e+03_r8 /) + kbo(:, 5,58,14) = (/ & + & 0.11428e+03_r8,0.19233e+03_r8,0.23470e+03_r8,0.22666e+03_r8,0.17444e+03_r8 /) + kbo(:, 1,59,14) = (/ & + & 0.54418e+02_r8,0.14809e+03_r8,0.18754e+03_r8,0.18261e+03_r8,0.11495e+03_r8 /) + kbo(:, 2,59,14) = (/ & + & 0.68598e+02_r8,0.16210e+03_r8,0.20441e+03_r8,0.19778e+03_r8,0.13180e+03_r8 /) + kbo(:, 3,59,14) = (/ & + & 0.83246e+02_r8,0.17398e+03_r8,0.21768e+03_r8,0.20993e+03_r8,0.14733e+03_r8 /) + kbo(:, 4,59,14) = (/ & + & 0.98055e+02_r8,0.18375e+03_r8,0.22732e+03_r8,0.21927e+03_r8,0.16113e+03_r8 /) + kbo(:, 5,59,14) = (/ & + & 0.11255e+03_r8,0.19153e+03_r8,0.23406e+03_r8,0.22601e+03_r8,0.17310e+03_r8 /) + kbo(:, 1,13,15) = (/ & + & 0.40932e+03_r8,0.30758e+03_r8,0.26133e+03_r8,0.32395e+03_r8,0.43211e+03_r8 /) + kbo(:, 2,13,15) = (/ & + & 0.41123e+03_r8,0.30908e+03_r8,0.25921e+03_r8,0.31805e+03_r8,0.42431e+03_r8 /) + kbo(:, 3,13,15) = (/ & + & 0.41219e+03_r8,0.30983e+03_r8,0.25685e+03_r8,0.31214e+03_r8,0.41639e+03_r8 /) + kbo(:, 4,13,15) = (/ & + & 0.41228e+03_r8,0.30991e+03_r8,0.25419e+03_r8,0.30614e+03_r8,0.40836e+03_r8 /) + kbo(:, 5,13,15) = (/ & + & 0.41130e+03_r8,0.30917e+03_r8,0.25126e+03_r8,0.30055e+03_r8,0.40088e+03_r8 /) + kbo(:, 1,14,15) = (/ & + & 0.46527e+03_r8,0.34966e+03_r8,0.29823e+03_r8,0.35533e+03_r8,0.47402e+03_r8 /) + kbo(:, 2,14,15) = (/ & + & 0.46656e+03_r8,0.35065e+03_r8,0.29540e+03_r8,0.34864e+03_r8,0.46510e+03_r8 /) + kbo(:, 3,14,15) = (/ & + & 0.46685e+03_r8,0.35090e+03_r8,0.29209e+03_r8,0.34189e+03_r8,0.45610e+03_r8 /) + kbo(:, 4,14,15) = (/ & + & 0.46575e+03_r8,0.35012e+03_r8,0.28845e+03_r8,0.33526e+03_r8,0.44716e+03_r8 /) + kbo(:, 5,14,15) = (/ & + & 0.46388e+03_r8,0.34873e+03_r8,0.28457e+03_r8,0.32965e+03_r8,0.43950e+03_r8 /) + kbo(:, 1,15,15) = (/ & + & 0.52376e+03_r8,0.39388e+03_r8,0.33756e+03_r8,0.38636e+03_r8,0.51543e+03_r8 /) + kbo(:, 2,15,15) = (/ & + & 0.52445e+03_r8,0.39416e+03_r8,0.33368e+03_r8,0.37892e+03_r8,0.50548e+03_r8 /) + kbo(:, 3,15,15) = (/ & + & 0.52345e+03_r8,0.39343e+03_r8,0.32922e+03_r8,0.37141e+03_r8,0.49535e+03_r8 /) + kbo(:, 4,15,15) = (/ & + & 0.52134e+03_r8,0.39188e+03_r8,0.32434e+03_r8,0.36468e+03_r8,0.48621e+03_r8 /) + kbo(:, 5,15,15) = (/ & + & 0.51791e+03_r8,0.38933e+03_r8,0.31931e+03_r8,0.35855e+03_r8,0.47766e+03_r8 /) + kbo(:, 1,16,15) = (/ & + & 0.58401e+03_r8,0.43962e+03_r8,0.37845e+03_r8,0.41772e+03_r8,0.55681e+03_r8 /) + kbo(:, 2,16,15) = (/ & + & 0.58308e+03_r8,0.43844e+03_r8,0.37324e+03_r8,0.40927e+03_r8,0.54538e+03_r8 /) + kbo(:, 3,16,15) = (/ & + & 0.58094e+03_r8,0.43662e+03_r8,0.36730e+03_r8,0.40107e+03_r8,0.53429e+03_r8 /) + kbo(:, 4,16,15) = (/ & + & 0.57721e+03_r8,0.43385e+03_r8,0.36102e+03_r8,0.39367e+03_r8,0.52421e+03_r8 /) + kbo(:, 5,16,15) = (/ & + & 0.57218e+03_r8,0.43010e+03_r8,0.35444e+03_r8,0.38654e+03_r8,0.51433e+03_r8 /) + kbo(:, 1,17,15) = (/ & + & 0.64407e+03_r8,0.48569e+03_r8,0.41994e+03_r8,0.44912e+03_r8,0.59692e+03_r8 /) + kbo(:, 2,17,15) = (/ & + & 0.64180e+03_r8,0.48304e+03_r8,0.41300e+03_r8,0.43957e+03_r8,0.58409e+03_r8 /) + kbo(:, 3,17,15) = (/ & + & 0.63774e+03_r8,0.47951e+03_r8,0.40543e+03_r8,0.43048e+03_r8,0.57188e+03_r8 /) + kbo(:, 4,17,15) = (/ & + & 0.63221e+03_r8,0.47511e+03_r8,0.39752e+03_r8,0.42195e+03_r8,0.56041e+03_r8 /) + kbo(:, 5,17,15) = (/ & + & 0.62531e+03_r8,0.46997e+03_r8,0.38917e+03_r8,0.41353e+03_r8,0.54901e+03_r8 /) + kbo(:, 1,18,15) = (/ & + & 0.70302e+03_r8,0.53125e+03_r8,0.46110e+03_r8,0.48015e+03_r8,0.63499e+03_r8 /) + kbo(:, 2,18,15) = (/ & + & 0.69876e+03_r8,0.52681e+03_r8,0.45218e+03_r8,0.46935e+03_r8,0.62082e+03_r8 /) + kbo(:, 3,18,15) = (/ & + & 0.69273e+03_r8,0.52130e+03_r8,0.44272e+03_r8,0.45897e+03_r8,0.60731e+03_r8 /) + kbo(:, 4,18,15) = (/ & + & 0.68529e+03_r8,0.51514e+03_r8,0.43287e+03_r8,0.44907e+03_r8,0.59416e+03_r8 /) + kbo(:, 5,18,15) = (/ & + & 0.67604e+03_r8,0.50804e+03_r8,0.42255e+03_r8,0.43929e+03_r8,0.58117e+03_r8 /) + kbo(:, 1,19,15) = (/ & + & 0.75927e+03_r8,0.57536e+03_r8,0.50097e+03_r8,0.51007e+03_r8,0.67027e+03_r8 /) + kbo(:, 2,19,15) = (/ & + & 0.75290e+03_r8,0.56864e+03_r8,0.48996e+03_r8,0.49791e+03_r8,0.65476e+03_r8 /) + kbo(:, 3,19,15) = (/ & + & 0.74466e+03_r8,0.56117e+03_r8,0.47832e+03_r8,0.48599e+03_r8,0.63995e+03_r8 /) + kbo(:, 4,19,15) = (/ & + & 0.73483e+03_r8,0.55286e+03_r8,0.46627e+03_r8,0.47459e+03_r8,0.62519e+03_r8 /) + kbo(:, 5,19,15) = (/ & + & 0.72353e+03_r8,0.54375e+03_r8,0.45395e+03_r8,0.46331e+03_r8,0.61054e+03_r8 /) + kbo(:, 1,20,15) = (/ & + & 0.81171e+03_r8,0.61670e+03_r8,0.53858e+03_r8,0.53802e+03_r8,0.70226e+03_r8 /) + kbo(:, 2,20,15) = (/ & + & 0.80307e+03_r8,0.60788e+03_r8,0.52517e+03_r8,0.52417e+03_r8,0.68550e+03_r8 /) + kbo(:, 3,20,15) = (/ & + & 0.79257e+03_r8,0.59823e+03_r8,0.51114e+03_r8,0.51080e+03_r8,0.66917e+03_r8 /) + kbo(:, 4,20,15) = (/ & + & 0.78036e+03_r8,0.58759e+03_r8,0.49687e+03_r8,0.49775e+03_r8,0.65285e+03_r8 /) + kbo(:, 5,20,15) = (/ & + & 0.76671e+03_r8,0.57649e+03_r8,0.48237e+03_r8,0.48486e+03_r8,0.63647e+03_r8 /) + kbo(:, 1,21,15) = (/ & + & 0.85929e+03_r8,0.65464e+03_r8,0.57309e+03_r8,0.56354e+03_r8,0.73074e+03_r8 /) + kbo(:, 2,21,15) = (/ & + & 0.84853e+03_r8,0.64350e+03_r8,0.55721e+03_r8,0.54790e+03_r8,0.71267e+03_r8 /) + kbo(:, 3,21,15) = (/ & + & 0.83578e+03_r8,0.63172e+03_r8,0.54090e+03_r8,0.53299e+03_r8,0.69483e+03_r8 /) + kbo(:, 4,21,15) = (/ & + & 0.82132e+03_r8,0.61900e+03_r8,0.52438e+03_r8,0.51831e+03_r8,0.67689e+03_r8 /) + kbo(:, 5,21,15) = (/ & + & 0.80511e+03_r8,0.60568e+03_r8,0.50774e+03_r8,0.50398e+03_r8,0.65894e+03_r8 /) + kbo(:, 1,22,15) = (/ & + & 0.90088e+03_r8,0.68794e+03_r8,0.60297e+03_r8,0.58517e+03_r8,0.75429e+03_r8 /) + kbo(:, 2,22,15) = (/ & + & 0.88795e+03_r8,0.67453e+03_r8,0.58458e+03_r8,0.56794e+03_r8,0.73512e+03_r8 /) + kbo(:, 3,22,15) = (/ & + & 0.87296e+03_r8,0.66047e+03_r8,0.56607e+03_r8,0.55151e+03_r8,0.71573e+03_r8 /) + kbo(:, 4,22,15) = (/ & + & 0.85602e+03_r8,0.64569e+03_r8,0.54736e+03_r8,0.53534e+03_r8,0.69633e+03_r8 /) + kbo(:, 5,22,15) = (/ & + & 0.83763e+03_r8,0.63042e+03_r8,0.52879e+03_r8,0.51959e+03_r8,0.67694e+03_r8 /) + kbo(:, 1,23,15) = (/ & + & 0.93708e+03_r8,0.71670e+03_r8,0.62868e+03_r8,0.60370e+03_r8,0.77407e+03_r8 /) + kbo(:, 2,23,15) = (/ & + & 0.92204e+03_r8,0.70111e+03_r8,0.60797e+03_r8,0.58479e+03_r8,0.75367e+03_r8 /) + kbo(:, 3,23,15) = (/ & + & 0.90485e+03_r8,0.68501e+03_r8,0.58723e+03_r8,0.56696e+03_r8,0.73284e+03_r8 /) + kbo(:, 4,23,15) = (/ & + & 0.88551e+03_r8,0.66835e+03_r8,0.56656e+03_r8,0.54939e+03_r8,0.71207e+03_r8 /) + kbo(:, 5,23,15) = (/ & + & 0.86499e+03_r8,0.65129e+03_r8,0.54624e+03_r8,0.53240e+03_r8,0.69156e+03_r8 /) + kbo(:, 1,24,15) = (/ & + & 0.96776e+03_r8,0.74092e+03_r8,0.64997e+03_r8,0.61898e+03_r8,0.79010e+03_r8 /) + kbo(:, 2,24,15) = (/ & + & 0.95072e+03_r8,0.72338e+03_r8,0.62717e+03_r8,0.59867e+03_r8,0.76855e+03_r8 /) + kbo(:, 3,24,15) = (/ & + & 0.93122e+03_r8,0.70539e+03_r8,0.60446e+03_r8,0.57944e+03_r8,0.74652e+03_r8 /) + kbo(:, 4,24,15) = (/ & + & 0.90993e+03_r8,0.68704e+03_r8,0.58213e+03_r8,0.56067e+03_r8,0.72451e+03_r8 /) + kbo(:, 5,24,15) = (/ & + & 0.88757e+03_r8,0.66845e+03_r8,0.56030e+03_r8,0.54254e+03_r8,0.70312e+03_r8 /) + kbo(:, 1,25,15) = (/ & + & 0.99329e+03_r8,0.76073e+03_r8,0.66706e+03_r8,0.63101e+03_r8,0.80276e+03_r8 /) + kbo(:, 2,25,15) = (/ & + & 0.97397e+03_r8,0.74138e+03_r8,0.64231e+03_r8,0.60949e+03_r8,0.78003e+03_r8 /) + kbo(:, 3,25,15) = (/ & + & 0.95257e+03_r8,0.72186e+03_r8,0.61798e+03_r8,0.58904e+03_r8,0.75681e+03_r8 /) + kbo(:, 4,25,15) = (/ & + & 0.92942e+03_r8,0.70193e+03_r8,0.59417e+03_r8,0.56923e+03_r8,0.73392e+03_r8 /) + kbo(:, 5,25,15) = (/ & + & 0.90532e+03_r8,0.68191e+03_r8,0.57100e+03_r8,0.55015e+03_r8,0.71169e+03_r8 /) + kbo(:, 1,26,15) = (/ & + & 0.10136e+04_r8,0.77623e+03_r8,0.67983e+03_r8,0.63982e+03_r8,0.81189e+03_r8 /) + kbo(:, 2,26,15) = (/ & + & 0.99212e+03_r8,0.75536e+03_r8,0.65345e+03_r8,0.61726e+03_r8,0.78804e+03_r8 /) + kbo(:, 3,26,15) = (/ & + & 0.96906e+03_r8,0.73441e+03_r8,0.62784e+03_r8,0.59585e+03_r8,0.76400e+03_r8 /) + kbo(:, 4,26,15) = (/ & + & 0.94442e+03_r8,0.71314e+03_r8,0.60278e+03_r8,0.57514e+03_r8,0.74031e+03_r8 /) + kbo(:, 5,26,15) = (/ & + & 0.91870e+03_r8,0.69199e+03_r8,0.57850e+03_r8,0.55532e+03_r8,0.71748e+03_r8 /) + kbo(:, 1,27,15) = (/ & + & 0.10295e+04_r8,0.78816e+03_r8,0.68910e+03_r8,0.64601e+03_r8,0.81822e+03_r8 /) + kbo(:, 2,27,15) = (/ & + & 0.10061e+04_r8,0.76604e+03_r8,0.66144e+03_r8,0.62260e+03_r8,0.79343e+03_r8 /) + kbo(:, 3,27,15) = (/ & + & 0.98153e+03_r8,0.74373e+03_r8,0.63470e+03_r8,0.60041e+03_r8,0.76875e+03_r8 /) + kbo(:, 4,27,15) = (/ & + & 0.95548e+03_r8,0.72130e+03_r8,0.60866e+03_r8,0.57907e+03_r8,0.74456e+03_r8 /) + kbo(:, 5,27,15) = (/ & + & 0.92838e+03_r8,0.69916e+03_r8,0.58347e+03_r8,0.55864e+03_r8,0.72113e+03_r8 /) + kbo(:, 1,28,15) = (/ & + & 0.10413e+04_r8,0.79681e+03_r8,0.69534e+03_r8,0.64995e+03_r8,0.82220e+03_r8 /) + kbo(:, 2,28,15) = (/ & + & 0.10164e+04_r8,0.77357e+03_r8,0.66667e+03_r8,0.62595e+03_r8,0.79680e+03_r8 /) + kbo(:, 3,28,15) = (/ & + & 0.99062e+03_r8,0.75026e+03_r8,0.63903e+03_r8,0.60314e+03_r8,0.77147e+03_r8 /) + kbo(:, 4,28,15) = (/ & + & 0.96323e+03_r8,0.72694e+03_r8,0.61220e+03_r8,0.58130e+03_r8,0.74687e+03_r8 /) + kbo(:, 5,28,15) = (/ & + & 0.93489e+03_r8,0.70393e+03_r8,0.58636e+03_r8,0.56041e+03_r8,0.72308e+03_r8 /) + kbo(:, 1,29,15) = (/ & + & 0.10495e+04_r8,0.80260e+03_r8,0.69878e+03_r8,0.65184e+03_r8,0.82409e+03_r8 /) + kbo(:, 2,29,15) = (/ & + & 0.10235e+04_r8,0.77841e+03_r8,0.66934e+03_r8,0.62739e+03_r8,0.79811e+03_r8 /) + kbo(:, 3,29,15) = (/ & + & 0.99642e+03_r8,0.75425e+03_r8,0.64103e+03_r8,0.60412e+03_r8,0.77230e+03_r8 /) + kbo(:, 4,29,15) = (/ & + & 0.96796e+03_r8,0.73025e+03_r8,0.61357e+03_r8,0.58189e+03_r8,0.74741e+03_r8 /) + kbo(:, 5,29,15) = (/ & + & 0.93857e+03_r8,0.70654e+03_r8,0.58732e+03_r8,0.56077e+03_r8,0.72335e+03_r8 /) + kbo(:, 1,30,15) = (/ & + & 0.10549e+04_r8,0.80614e+03_r8,0.70001e+03_r8,0.65202e+03_r8,0.82418e+03_r8 /) + kbo(:, 2,30,15) = (/ & + & 0.10278e+04_r8,0.78108e+03_r8,0.67004e+03_r8,0.62730e+03_r8,0.79771e+03_r8 /) + kbo(:, 3,30,15) = (/ & + & 0.99966e+03_r8,0.75628e+03_r8,0.64121e+03_r8,0.60374e+03_r8,0.77172e+03_r8 /) + kbo(:, 4,30,15) = (/ & + & 0.97021e+03_r8,0.73170e+03_r8,0.61335e+03_r8,0.58130e+03_r8,0.74664e+03_r8 /) + kbo(:, 5,30,15) = (/ & + & 0.94007e+03_r8,0.70743e+03_r8,0.58676e+03_r8,0.55999e+03_r8,0.72234e+03_r8 /) + kbo(:, 1,31,15) = (/ & + & 0.10577e+04_r8,0.80741e+03_r8,0.69925e+03_r8,0.65081e+03_r8,0.82281e+03_r8 /) + kbo(:, 2,31,15) = (/ & + & 0.10297e+04_r8,0.78182e+03_r8,0.66894e+03_r8,0.62588e+03_r8,0.79605e+03_r8 /) + kbo(:, 3,31,15) = (/ & + & 0.10005e+04_r8,0.75649e+03_r8,0.63976e+03_r8,0.60219e+03_r8,0.76987e+03_r8 /) + kbo(:, 4,31,15) = (/ & + & 0.97028e+03_r8,0.73149e+03_r8,0.61167e+03_r8,0.57962e+03_r8,0.74468e+03_r8 /) + kbo(:, 5,31,15) = (/ & + & 0.93951e+03_r8,0.70673e+03_r8,0.58494e+03_r8,0.55830e+03_r8,0.72033e+03_r8 /) + kbo(:, 1,32,15) = (/ & + & 0.10585e+04_r8,0.80706e+03_r8,0.69697e+03_r8,0.64853e+03_r8,0.82034e+03_r8 /) + kbo(:, 2,32,15) = (/ & + & 0.10295e+04_r8,0.78094e+03_r8,0.66639e+03_r8,0.62348e+03_r8,0.79329e+03_r8 /) + kbo(:, 3,32,15) = (/ & + & 0.99955e+03_r8,0.75528e+03_r8,0.63700e+03_r8,0.59969e+03_r8,0.76700e+03_r8 /) + kbo(:, 4,32,15) = (/ & + & 0.96864e+03_r8,0.72996e+03_r8,0.60885e+03_r8,0.57712e+03_r8,0.74178e+03_r8 /) + kbo(:, 5,32,15) = (/ & + & 0.93737e+03_r8,0.70488e+03_r8,0.58204e+03_r8,0.55579e+03_r8,0.71738e+03_r8 /) + kbo(:, 1,33,15) = (/ & + & 0.10575e+04_r8,0.80530e+03_r8,0.69345e+03_r8,0.64529e+03_r8,0.81678e+03_r8 /) + kbo(:, 2,33,15) = (/ & + & 0.10278e+04_r8,0.77890e+03_r8,0.66278e+03_r8,0.62027e+03_r8,0.78965e+03_r8 /) + kbo(:, 3,33,15) = (/ & + & 0.99704e+03_r8,0.75290e+03_r8,0.63324e+03_r8,0.59645e+03_r8,0.76337e+03_r8 /) + kbo(:, 4,33,15) = (/ & + & 0.96555e+03_r8,0.72726e+03_r8,0.60509e+03_r8,0.57394e+03_r8,0.73813e+03_r8 /) + kbo(:, 5,33,15) = (/ & + & 0.93393e+03_r8,0.70207e+03_r8,0.57839e+03_r8,0.55267e+03_r8,0.71377e+03_r8 /) + kbo(:, 1,34,15) = (/ & + & 0.10561e+04_r8,0.80340e+03_r8,0.69012e+03_r8,0.64228e+03_r8,0.81344e+03_r8 /) + kbo(:, 2,34,15) = (/ & + & 0.10257e+04_r8,0.77677e+03_r8,0.65936e+03_r8,0.61726e+03_r8,0.78628e+03_r8 /) + kbo(:, 3,34,15) = (/ & + & 0.99442e+03_r8,0.75053e+03_r8,0.62978e+03_r8,0.59351e+03_r8,0.76009e+03_r8 /) + kbo(:, 4,34,15) = (/ & + & 0.96258e+03_r8,0.72472e+03_r8,0.60168e+03_r8,0.57104e+03_r8,0.73478e+03_r8 /) + kbo(:, 5,34,15) = (/ & + & 0.93053e+03_r8,0.69938e+03_r8,0.57499e+03_r8,0.54984e+03_r8,0.71051e+03_r8 /) + kbo(:, 1,35,15) = (/ & + & 0.10564e+04_r8,0.80326e+03_r8,0.68907e+03_r8,0.64121e+03_r8,0.81221e+03_r8 /) + kbo(:, 2,35,15) = (/ & + & 0.10257e+04_r8,0.77646e+03_r8,0.65819e+03_r8,0.61612e+03_r8,0.78498e+03_r8 /) + kbo(:, 3,35,15) = (/ & + & 0.99396e+03_r8,0.74998e+03_r8,0.62850e+03_r8,0.59231e+03_r8,0.75874e+03_r8 /) + kbo(:, 4,35,15) = (/ & + & 0.96182e+03_r8,0.72398e+03_r8,0.60037e+03_r8,0.56987e+03_r8,0.73339e+03_r8 /) + kbo(:, 5,35,15) = (/ & + & 0.92945e+03_r8,0.69852e+03_r8,0.57362e+03_r8,0.54864e+03_r8,0.70910e+03_r8 /) + kbo(:, 1,36,15) = (/ & + & 0.10593e+04_r8,0.80545e+03_r8,0.69086e+03_r8,0.64252e+03_r8,0.81357e+03_r8 /) + kbo(:, 2,36,15) = (/ & + & 0.10283e+04_r8,0.77842e+03_r8,0.65978e+03_r8,0.61726e+03_r8,0.78619e+03_r8 /) + kbo(:, 3,36,15) = (/ & + & 0.99627e+03_r8,0.75174e+03_r8,0.62993e+03_r8,0.59335e+03_r8,0.75988e+03_r8 /) + kbo(:, 4,36,15) = (/ & + & 0.96386e+03_r8,0.72553e+03_r8,0.60161e+03_r8,0.57080e+03_r8,0.73443e+03_r8 /) + kbo(:, 5,36,15) = (/ & + & 0.93134e+03_r8,0.69996e+03_r8,0.57477e+03_r8,0.54947e+03_r8,0.71003e+03_r8 /) + kbo(:, 1,37,15) = (/ & + & 0.10662e+04_r8,0.81134e+03_r8,0.69713e+03_r8,0.64751e+03_r8,0.81885e+03_r8 /) + kbo(:, 2,37,15) = (/ & + & 0.10351e+04_r8,0.78402e+03_r8,0.66565e+03_r8,0.62189e+03_r8,0.79122e+03_r8 /) + kbo(:, 3,37,15) = (/ & + & 0.10030e+04_r8,0.75714e+03_r8,0.63542e+03_r8,0.59764e+03_r8,0.76460e+03_r8 /) + kbo(:, 4,37,15) = (/ & + & 0.97042e+03_r8,0.73071e+03_r8,0.60674e+03_r8,0.57477e+03_r8,0.73895e+03_r8 /) + kbo(:, 5,37,15) = (/ & + & 0.93771e+03_r8,0.70485e+03_r8,0.57959e+03_r8,0.55322e+03_r8,0.71431e+03_r8 /) + kbo(:, 1,38,15) = (/ & + & 0.10729e+04_r8,0.81713e+03_r8,0.70342e+03_r8,0.65252e+03_r8,0.82415e+03_r8 /) + kbo(:, 2,38,15) = (/ & + & 0.10416e+04_r8,0.78952e+03_r8,0.67152e+03_r8,0.62655e+03_r8,0.79626e+03_r8 /) + kbo(:, 3,38,15) = (/ & + & 0.10096e+04_r8,0.76249e+03_r8,0.64098e+03_r8,0.60198e+03_r8,0.76937e+03_r8 /) + kbo(:, 4,38,15) = (/ & + & 0.97695e+03_r8,0.73588e+03_r8,0.61197e+03_r8,0.57883e+03_r8,0.74352e+03_r8 /) + kbo(:, 5,38,15) = (/ & + & 0.94411e+03_r8,0.70978e+03_r8,0.58447e+03_r8,0.55704e+03_r8,0.71866e+03_r8 /) + kbo(:, 1,39,15) = (/ & + & 0.10791e+04_r8,0.82257e+03_r8,0.70938e+03_r8,0.65729e+03_r8,0.82913e+03_r8 /) + kbo(:, 2,39,15) = (/ & + & 0.10479e+04_r8,0.79481e+03_r8,0.67717e+03_r8,0.63099e+03_r8,0.80105e+03_r8 /) + kbo(:, 3,39,15) = (/ & + & 0.10158e+04_r8,0.76754e+03_r8,0.64630e+03_r8,0.60614e+03_r8,0.77394e+03_r8 /) + kbo(:, 4,39,15) = (/ & + & 0.98307e+03_r8,0.74076e+03_r8,0.61694e+03_r8,0.58271e+03_r8,0.74789e+03_r8 /) + kbo(:, 5,39,15) = (/ & + & 0.95013e+03_r8,0.71446e+03_r8,0.58917e+03_r8,0.56072e+03_r8,0.72285e+03_r8 /) + kbo(:, 1,40,15) = (/ & + & 0.10882e+04_r8,0.83071e+03_r8,0.71862e+03_r8,0.66478e+03_r8,0.83689e+03_r8 /) + kbo(:, 2,40,15) = (/ & + & 0.10571e+04_r8,0.80265e+03_r8,0.68589e+03_r8,0.63804e+03_r8,0.80862e+03_r8 /) + kbo(:, 3,40,15) = (/ & + & 0.10251e+04_r8,0.77527e+03_r8,0.65462e+03_r8,0.61278e+03_r8,0.78119e+03_r8 /) + kbo(:, 4,40,15) = (/ & + & 0.99232e+03_r8,0.74818e+03_r8,0.62475e+03_r8,0.58893e+03_r8,0.75487e+03_r8 /) + kbo(:, 5,40,15) = (/ & + & 0.95932e+03_r8,0.72168e+03_r8,0.59655e+03_r8,0.56653e+03_r8,0.72946e+03_r8 /) + kbo(:, 1,41,15) = (/ & + & 0.10971e+04_r8,0.83901e+03_r8,0.72823e+03_r8,0.67265e+03_r8,0.84493e+03_r8 /) + kbo(:, 2,41,15) = (/ & + & 0.10663e+04_r8,0.81071e+03_r8,0.69500e+03_r8,0.64543e+03_r8,0.81648e+03_r8 /) + kbo(:, 3,41,15) = (/ & + & 0.10345e+04_r8,0.78315e+03_r8,0.66331e+03_r8,0.61971e+03_r8,0.78878e+03_r8 /) + kbo(:, 4,41,15) = (/ & + & 0.10019e+04_r8,0.75590e+03_r8,0.63295e+03_r8,0.59541e+03_r8,0.76210e+03_r8 /) + kbo(:, 5,41,15) = (/ & + & 0.96878e+03_r8,0.72921e+03_r8,0.60428e+03_r8,0.57260e+03_r8,0.73637e+03_r8 /) + kbo(:, 1,42,15) = (/ & + & 0.11058e+04_r8,0.84736e+03_r8,0.73795e+03_r8,0.68059e+03_r8,0.85278e+03_r8 /) + kbo(:, 2,42,15) = (/ & + & 0.10754e+04_r8,0.81879e+03_r8,0.70412e+03_r8,0.65281e+03_r8,0.82432e+03_r8 /) + kbo(:, 3,42,15) = (/ & + & 0.10438e+04_r8,0.79093e+03_r8,0.67198e+03_r8,0.62664e+03_r8,0.79629e+03_r8 /) + kbo(:, 4,42,15) = (/ & + & 0.10112e+04_r8,0.76353e+03_r8,0.64116e+03_r8,0.60189e+03_r8,0.76925e+03_r8 /) + kbo(:, 5,42,15) = (/ & + & 0.97804e+03_r8,0.73660e+03_r8,0.61202e+03_r8,0.57870e+03_r8,0.74332e+03_r8 /) + kbo(:, 1,43,15) = (/ & + & 0.11158e+04_r8,0.85717e+03_r8,0.74955e+03_r8,0.69024e+03_r8,0.86217e+03_r8 /) + kbo(:, 2,43,15) = (/ & + & 0.10861e+04_r8,0.82836e+03_r8,0.71518e+03_r8,0.66177e+03_r8,0.83370e+03_r8 /) + kbo(:, 3,43,15) = (/ & + & 0.10546e+04_r8,0.80021e+03_r8,0.68243e+03_r8,0.63507e+03_r8,0.80541e+03_r8 /) + kbo(:, 4,43,15) = (/ & + & 0.10222e+04_r8,0.77261e+03_r8,0.65115e+03_r8,0.60984e+03_r8,0.77795e+03_r8 /) + kbo(:, 5,43,15) = (/ & + & 0.98916e+03_r8,0.74551e+03_r8,0.62143e+03_r8,0.58614e+03_r8,0.75171e+03_r8 /) + kbo(:, 1,44,15) = (/ & + & 0.11264e+04_r8,0.86786e+03_r8,0.76217e+03_r8,0.70088e+03_r8,0.87207e+03_r8 /) + kbo(:, 2,44,15) = (/ & + & 0.10970e+04_r8,0.83855e+03_r8,0.72711e+03_r8,0.67158e+03_r8,0.84381e+03_r8 /) + kbo(:, 3,44,15) = (/ & + & 0.10660e+04_r8,0.81015e+03_r8,0.69375e+03_r8,0.64429e+03_r8,0.81530e+03_r8 /) + kbo(:, 4,44,15) = (/ & + & 0.10339e+04_r8,0.78245e+03_r8,0.66207e+03_r8,0.61859e+03_r8,0.78750e+03_r8 /) + kbo(:, 5,44,15) = (/ & + & 0.10010e+04_r8,0.75506e+03_r8,0.63169e+03_r8,0.59432e+03_r8,0.76086e+03_r8 /) + kbo(:, 1,45,15) = (/ & + & 0.11364e+04_r8,0.87855e+03_r8,0.77494e+03_r8,0.71181e+03_r8,0.88191e+03_r8 /) + kbo(:, 2,45,15) = (/ & + & 0.11078e+04_r8,0.84885e+03_r8,0.73921e+03_r8,0.68154e+03_r8,0.85373e+03_r8 /) + kbo(:, 3,45,15) = (/ & + & 0.10773e+04_r8,0.82021e+03_r8,0.70525e+03_r8,0.65361e+03_r8,0.82516e+03_r8 /) + kbo(:, 4,45,15) = (/ & + & 0.10454e+04_r8,0.79218e+03_r8,0.67305e+03_r8,0.62740e+03_r8,0.79708e+03_r8 /) + kbo(:, 5,45,15) = (/ & + & 0.10127e+04_r8,0.76466e+03_r8,0.64208e+03_r8,0.60256e+03_r8,0.76997e+03_r8 /) + kbo(:, 1,46,15) = (/ & + & 0.11465e+04_r8,0.88995e+03_r8,0.78864e+03_r8,0.72357e+03_r8,0.89218e+03_r8 /) + kbo(:, 2,46,15) = (/ & + & 0.11189e+04_r8,0.85981e+03_r8,0.75227e+03_r8,0.69242e+03_r8,0.86430e+03_r8 /) + kbo(:, 3,46,15) = (/ & + & 0.10889e+04_r8,0.83077e+03_r8,0.71764e+03_r8,0.66370e+03_r8,0.83569e+03_r8 /) + kbo(:, 4,46,15) = (/ & + & 0.10574e+04_r8,0.80253e+03_r8,0.68479e+03_r8,0.63689e+03_r8,0.80730e+03_r8 /) + kbo(:, 5,46,15) = (/ & + & 0.10249e+04_r8,0.77483e+03_r8,0.65332e+03_r8,0.61153e+03_r8,0.77982e+03_r8 /) + kbo(:, 1,47,15) = (/ & + & 0.11573e+04_r8,0.90286e+03_r8,0.80421e+03_r8,0.73669e+03_r8,0.90313e+03_r8 /) + kbo(:, 2,47,15) = (/ & + & 0.11308e+04_r8,0.87219e+03_r8,0.76703e+03_r8,0.70495e+03_r8,0.87583e+03_r8 /) + kbo(:, 3,47,15) = (/ & + & 0.11017e+04_r8,0.84272e+03_r8,0.73168e+03_r8,0.67524e+03_r8,0.84747e+03_r8 /) + kbo(:, 4,47,15) = (/ & + & 0.10706e+04_r8,0.81413e+03_r8,0.69808e+03_r8,0.64772e+03_r8,0.81886e+03_r8 /) + kbo(:, 5,47,15) = (/ & + & 0.10385e+04_r8,0.78623e+03_r8,0.66606e+03_r8,0.62176e+03_r8,0.79095e+03_r8 /) + kbo(:, 1,48,15) = (/ & + & 0.11675e+04_r8,0.91580e+03_r8,0.81991e+03_r8,0.74998e+03_r8,0.91375e+03_r8 /) + kbo(:, 2,48,15) = (/ & + & 0.11421e+04_r8,0.88462e+03_r8,0.78203e+03_r8,0.71783e+03_r8,0.88726e+03_r8 /) + kbo(:, 3,48,15) = (/ & + & 0.11139e+04_r8,0.85471e+03_r8,0.74597e+03_r8,0.68710e+03_r8,0.85917e+03_r8 /) + kbo(:, 4,48,15) = (/ & + & 0.10836e+04_r8,0.82582e+03_r8,0.71165e+03_r8,0.65875e+03_r8,0.83052e+03_r8 /) + kbo(:, 5,48,15) = (/ & + & 0.10518e+04_r8,0.79762e+03_r8,0.67897e+03_r8,0.63216e+03_r8,0.80224e+03_r8 /) + kbo(:, 1,49,15) = (/ & + & 0.11770e+04_r8,0.92887e+03_r8,0.83589e+03_r8,0.76347e+03_r8,0.92401e+03_r8 /) + kbo(:, 2,49,15) = (/ & + & 0.11531e+04_r8,0.89735e+03_r8,0.79736e+03_r8,0.73085e+03_r8,0.89839e+03_r8 /) + kbo(:, 3,49,15) = (/ & + & 0.11259e+04_r8,0.86690e+03_r8,0.76049e+03_r8,0.69928e+03_r8,0.87069e+03_r8 /) + kbo(:, 4,49,15) = (/ & + & 0.10963e+04_r8,0.83754e+03_r8,0.72543e+03_r8,0.67003e+03_r8,0.84223e+03_r8 /) + kbo(:, 5,49,15) = (/ & + & 0.10650e+04_r8,0.80903e+03_r8,0.69202e+03_r8,0.64278e+03_r8,0.81363e+03_r8 /) + kbo(:, 1,50,15) = (/ & + & 0.11850e+04_r8,0.94106e+03_r8,0.85114e+03_r8,0.77623e+03_r8,0.93320e+03_r8 /) + kbo(:, 2,50,15) = (/ & + & 0.11628e+04_r8,0.90935e+03_r8,0.81191e+03_r8,0.74315e+03_r8,0.90846e+03_r8 /) + kbo(:, 3,50,15) = (/ & + & 0.11368e+04_r8,0.87848e+03_r8,0.77441e+03_r8,0.71118e+03_r8,0.88145e+03_r8 /) + kbo(:, 4,50,15) = (/ & + & 0.11080e+04_r8,0.84872e+03_r8,0.73862e+03_r8,0.68089e+03_r8,0.85311e+03_r8 /) + kbo(:, 5,50,15) = (/ & + & 0.10771e+04_r8,0.81987e+03_r8,0.70453e+03_r8,0.65297e+03_r8,0.82446e+03_r8 /) + kbo(:, 1,51,15) = (/ & + & 0.11923e+04_r8,0.95283e+03_r8,0.86626e+03_r8,0.78865e+03_r8,0.94170e+03_r8 /) + kbo(:, 2,51,15) = (/ & + & 0.11717e+04_r8,0.92110e+03_r8,0.82616e+03_r8,0.75525e+03_r8,0.91794e+03_r8 /) + kbo(:, 3,51,15) = (/ & + & 0.11468e+04_r8,0.88978e+03_r8,0.78804e+03_r8,0.72292e+03_r8,0.89168e+03_r8 /) + kbo(:, 4,51,15) = (/ & + & 0.11189e+04_r8,0.85951e+03_r8,0.75159e+03_r8,0.69174e+03_r8,0.86368e+03_r8 /) + kbo(:, 5,51,15) = (/ & + & 0.10888e+04_r8,0.83043e+03_r8,0.71698e+03_r8,0.66309e+03_r8,0.83504e+03_r8 /) + kbo(:, 1,52,15) = (/ & + & 0.11987e+04_r8,0.96448e+03_r8,0.88155e+03_r8,0.80101e+03_r8,0.94976e+03_r8 /) + kbo(:, 2,52,15) = (/ & + & 0.11799e+04_r8,0.93288e+03_r8,0.84067e+03_r8,0.76742e+03_r8,0.92694e+03_r8 /) + kbo(:, 3,52,15) = (/ & + & 0.11564e+04_r8,0.90125e+03_r8,0.80189e+03_r8,0.73467e+03_r8,0.90155e+03_r8 /) + kbo(:, 4,52,15) = (/ & + & 0.11296e+04_r8,0.87065e+03_r8,0.76482e+03_r8,0.70289e+03_r8,0.87401e+03_r8 /) + kbo(:, 5,52,15) = (/ & + & 0.11001e+04_r8,0.84107e+03_r8,0.72948e+03_r8,0.67337e+03_r8,0.84559e+03_r8 /) + kbo(:, 1,53,15) = (/ & + & 0.12042e+04_r8,0.97597e+03_r8,0.89729e+03_r8,0.81334e+03_r8,0.95716e+03_r8 /) + kbo(:, 2,53,15) = (/ & + & 0.11876e+04_r8,0.94467e+03_r8,0.85557e+03_r8,0.77990e+03_r8,0.93591e+03_r8 /) + kbo(:, 3,53,15) = (/ & + & 0.11657e+04_r8,0.91285e+03_r8,0.81605e+03_r8,0.74663e+03_r8,0.91125e+03_r8 /) + kbo(:, 4,53,15) = (/ & + & 0.11399e+04_r8,0.88179e+03_r8,0.77830e+03_r8,0.71447e+03_r8,0.88437e+03_r8 /) + kbo(:, 5,53,15) = (/ & + & 0.11113e+04_r8,0.85189e+03_r8,0.74233e+03_r8,0.68396e+03_r8,0.85611e+03_r8 /) + kbo(:, 1,54,15) = (/ & + & 0.12085e+04_r8,0.98643e+03_r8,0.91208e+03_r8,0.82462e+03_r8,0.96332e+03_r8 /) + kbo(:, 2,54,15) = (/ & + & 0.11940e+04_r8,0.95533e+03_r8,0.86934e+03_r8,0.79114e+03_r8,0.94342e+03_r8 /) + kbo(:, 3,54,15) = (/ & + & 0.11737e+04_r8,0.92362e+03_r8,0.82909e+03_r8,0.75767e+03_r8,0.91977e+03_r8 /) + kbo(:, 4,54,15) = (/ & + & 0.11490e+04_r8,0.89214e+03_r8,0.79079e+03_r8,0.72522e+03_r8,0.89369e+03_r8 /) + kbo(:, 5,54,15) = (/ & + & 0.11212e+04_r8,0.86180e+03_r8,0.75420e+03_r8,0.69390e+03_r8,0.86571e+03_r8 /) + kbo(:, 1,55,15) = (/ & + & 0.12111e+04_r8,0.99597e+03_r8,0.92635e+03_r8,0.83534e+03_r8,0.96856e+03_r8 /) + kbo(:, 2,55,15) = (/ & + & 0.11993e+04_r8,0.96550e+03_r8,0.88281e+03_r8,0.80196e+03_r8,0.95029e+03_r8 /) + kbo(:, 3,55,15) = (/ & + & 0.11808e+04_r8,0.93390e+03_r8,0.84185e+03_r8,0.76841e+03_r8,0.92774e+03_r8 /) + kbo(:, 4,55,15) = (/ & + & 0.11574e+04_r8,0.90226e+03_r8,0.80305e+03_r8,0.73557e+03_r8,0.90236e+03_r8 /) + kbo(:, 5,55,15) = (/ & + & 0.11305e+04_r8,0.87151e+03_r8,0.76581e+03_r8,0.70377e+03_r8,0.87482e+03_r8 /) + kbo(:, 1,56,15) = (/ & + & 0.12133e+04_r8,0.10055e+04_r8,0.94091e+03_r8,0.84599e+03_r8,0.97308e+03_r8 /) + kbo(:, 2,56,15) = (/ & + & 0.12041e+04_r8,0.97555e+03_r8,0.89660e+03_r8,0.81280e+03_r8,0.95684e+03_r8 /) + kbo(:, 3,56,15) = (/ & + & 0.11875e+04_r8,0.94422e+03_r8,0.85482e+03_r8,0.77921e+03_r8,0.93538e+03_r8 /) + kbo(:, 4,56,15) = (/ & + & 0.11654e+04_r8,0.91235e+03_r8,0.81536e+03_r8,0.74599e+03_r8,0.91077e+03_r8 /) + kbo(:, 5,56,15) = (/ & + & 0.11395e+04_r8,0.88125e+03_r8,0.77756e+03_r8,0.71383e+03_r8,0.88381e+03_r8 /) + kbo(:, 1,57,15) = (/ & + & 0.12144e+04_r8,0.10149e+04_r8,0.95530e+03_r8,0.85635e+03_r8,0.97654e+03_r8 /) + kbo(:, 2,57,15) = (/ & + & 0.12082e+04_r8,0.98553e+03_r8,0.91069e+03_r8,0.82360e+03_r8,0.96286e+03_r8 /) + kbo(:, 3,57,15) = (/ & + & 0.11936e+04_r8,0.95436e+03_r8,0.86797e+03_r8,0.78997e+03_r8,0.94263e+03_r8 /) + kbo(:, 4,57,15) = (/ & + & 0.11730e+04_r8,0.92261e+03_r8,0.82779e+03_r8,0.75653e+03_r8,0.91896e+03_r8 /) + kbo(:, 5,57,15) = (/ & + & 0.11481e+04_r8,0.89107e+03_r8,0.78949e+03_r8,0.72412e+03_r8,0.89274e+03_r8 /) + kbo(:, 1,58,15) = (/ & + & 0.12146e+04_r8,0.10236e+04_r8,0.96889e+03_r8,0.86606e+03_r8,0.97897e+03_r8 /) + kbo(:, 2,58,15) = (/ & + & 0.12111e+04_r8,0.99468e+03_r8,0.92419e+03_r8,0.83372e+03_r8,0.96790e+03_r8 /) + kbo(:, 3,58,15) = (/ & + & 0.11988e+04_r8,0.96400e+03_r8,0.88060e+03_r8,0.80022e+03_r8,0.94932e+03_r8 /) + kbo(:, 4,58,15) = (/ & + & 0.11798e+04_r8,0.93230e+03_r8,0.83979e+03_r8,0.76663e+03_r8,0.92647e+03_r8 /) + kbo(:, 5,58,15) = (/ & + & 0.11561e+04_r8,0.90059e+03_r8,0.80102e+03_r8,0.73388e+03_r8,0.90094e+03_r8 /) + kbo(:, 1,59,15) = (/ & + & 0.12143e+04_r8,0.10270e+04_r8,0.97431e+03_r8,0.86988e+03_r8,0.97963e+03_r8 /) + kbo(:, 2,59,15) = (/ & + & 0.12120e+04_r8,0.99826e+03_r8,0.92964e+03_r8,0.83774e+03_r8,0.96974e+03_r8 /) + kbo(:, 3,59,15) = (/ & + & 0.12008e+04_r8,0.96785e+03_r8,0.88575e+03_r8,0.80426e+03_r8,0.95182e+03_r8 /) + kbo(:, 4,59,15) = (/ & + & 0.11824e+04_r8,0.93625e+03_r8,0.84468e+03_r8,0.77075e+03_r8,0.92946e+03_r8 /) + kbo(:, 5,59,15) = (/ & + & 0.11592e+04_r8,0.90444e+03_r8,0.80567e+03_r8,0.73781e+03_r8,0.90417e+03_r8 /) + kbo(:, 1,13,16) = (/ & + & 0.60786e+03_r8,0.45592e+03_r8,0.38499e+03_r8,0.57704e+03_r8,0.77025e+03_r8 /) + kbo(:, 2,13,16) = (/ & + & 0.61089e+03_r8,0.45819e+03_r8,0.37289e+03_r8,0.55854e+03_r8,0.74550e+03_r8 /) + kbo(:, 3,13,16) = (/ & + & 0.61169e+03_r8,0.45879e+03_r8,0.36189e+03_r8,0.54102e+03_r8,0.72223e+03_r8 /) + kbo(:, 4,13,16) = (/ & + & 0.61079e+03_r8,0.45811e+03_r8,0.35169e+03_r8,0.52404e+03_r8,0.69950e+03_r8 /) + kbo(:, 5,13,16) = (/ & + & 0.60850e+03_r8,0.45639e+03_r8,0.34199e+03_r8,0.50729e+03_r8,0.67716e+03_r8 /) + kbo(:, 1,14,16) = (/ & + & 0.71905e+03_r8,0.53931e+03_r8,0.44704e+03_r8,0.66948e+03_r8,0.89363e+03_r8 /) + kbo(:, 2,14,16) = (/ & + & 0.71950e+03_r8,0.53965e+03_r8,0.43274e+03_r8,0.64598e+03_r8,0.86230e+03_r8 /) + kbo(:, 3,14,16) = (/ & + & 0.71818e+03_r8,0.53865e+03_r8,0.41969e+03_r8,0.62353e+03_r8,0.83220e+03_r8 /) + kbo(:, 4,14,16) = (/ & + & 0.71532e+03_r8,0.53651e+03_r8,0.40717e+03_r8,0.60193e+03_r8,0.80343e+03_r8 /) + kbo(:, 5,14,16) = (/ & + & 0.71008e+03_r8,0.53258e+03_r8,0.39527e+03_r8,0.58080e+03_r8,0.77521e+03_r8 /) + kbo(:, 1,15,16) = (/ & + & 0.84339e+03_r8,0.63256e+03_r8,0.51534e+03_r8,0.76897e+03_r8,0.10264e+04_r8 /) + kbo(:, 2,15,16) = (/ & + & 0.84056e+03_r8,0.63042e+03_r8,0.49783e+03_r8,0.73927e+03_r8,0.98670e+03_r8 /) + kbo(:, 3,15,16) = (/ & + & 0.83549e+03_r8,0.62663e+03_r8,0.48183e+03_r8,0.71056e+03_r8,0.94836e+03_r8 /) + kbo(:, 4,15,16) = (/ & + & 0.82865e+03_r8,0.62150e+03_r8,0.46649e+03_r8,0.68266e+03_r8,0.91115e+03_r8 /) + kbo(:, 5,15,16) = (/ & + & 0.81975e+03_r8,0.61483e+03_r8,0.45195e+03_r8,0.65670e+03_r8,0.87636e+03_r8 /) + kbo(:, 1,16,16) = (/ & + & 0.97910e+03_r8,0.73434e+03_r8,0.58857e+03_r8,0.87272e+03_r8,0.11648e+04_r8 /) + kbo(:, 2,16,16) = (/ & + & 0.97153e+03_r8,0.72866e+03_r8,0.56721e+03_r8,0.83540e+03_r8,0.11150e+04_r8 /) + kbo(:, 3,16,16) = (/ & + & 0.96129e+03_r8,0.72098e+03_r8,0.54742e+03_r8,0.79937e+03_r8,0.10667e+04_r8 /) + kbo(:, 4,16,16) = (/ & + & 0.94880e+03_r8,0.71161e+03_r8,0.52876e+03_r8,0.76497e+03_r8,0.10209e+04_r8 /) + kbo(:, 5,16,16) = (/ & + & 0.93421e+03_r8,0.70067e+03_r8,0.51082e+03_r8,0.73352e+03_r8,0.97881e+03_r8 /) + kbo(:, 1,17,16) = (/ & + & 0.11229e+04_r8,0.84221e+03_r8,0.66547e+03_r8,0.97911e+03_r8,0.13066e+04_r8 /) + kbo(:, 2,17,16) = (/ & + & 0.11091e+04_r8,0.83187e+03_r8,0.63930e+03_r8,0.93226e+03_r8,0.12440e+04_r8 /) + kbo(:, 3,17,16) = (/ & + & 0.10923e+04_r8,0.81922e+03_r8,0.61539e+03_r8,0.88802e+03_r8,0.11849e+04_r8 /) + kbo(:, 4,17,16) = (/ & + & 0.10728e+04_r8,0.80459e+03_r8,0.59256e+03_r8,0.84691e+03_r8,0.11301e+04_r8 /) + kbo(:, 5,17,16) = (/ & + & 0.10515e+04_r8,0.78865e+03_r8,0.57044e+03_r8,0.80936e+03_r8,0.10799e+04_r8 /) + kbo(:, 1,18,16) = (/ & + & 0.12716e+04_r8,0.95370e+03_r8,0.74447e+03_r8,0.10843e+04_r8,0.14469e+04_r8 /) + kbo(:, 2,18,16) = (/ & + & 0.12500e+04_r8,0.93749e+03_r8,0.71274e+03_r8,0.10272e+04_r8,0.13706e+04_r8 /) + kbo(:, 3,18,16) = (/ & + & 0.12251e+04_r8,0.91883e+03_r8,0.68394e+03_r8,0.97432e+03_r8,0.13000e+04_r8 /) + kbo(:, 4,18,16) = (/ & + & 0.11973e+04_r8,0.89795e+03_r8,0.65609e+03_r8,0.92626e+03_r8,0.12359e+04_r8 /) + kbo(:, 5,18,16) = (/ & + & 0.11679e+04_r8,0.87596e+03_r8,0.62959e+03_r8,0.88232e+03_r8,0.11772e+04_r8 /) + kbo(:, 1,19,16) = (/ & + & 0.14213e+04_r8,0.10659e+04_r8,0.82299e+03_r8,0.11854e+04_r8,0.15817e+04_r8 /) + kbo(:, 2,19,16) = (/ & + & 0.13899e+04_r8,0.10424e+04_r8,0.78536e+03_r8,0.11181e+04_r8,0.14919e+04_r8 /) + kbo(:, 3,19,16) = (/ & + & 0.13555e+04_r8,0.10166e+04_r8,0.75067e+03_r8,0.10563e+04_r8,0.14093e+04_r8 /) + kbo(:, 4,19,16) = (/ & + & 0.13187e+04_r8,0.98902e+03_r8,0.71751e+03_r8,0.10008e+04_r8,0.13351e+04_r8 /) + kbo(:, 5,19,16) = (/ & + & 0.12809e+04_r8,0.96067e+03_r8,0.68653e+03_r8,0.95065e+03_r8,0.12682e+04_r8 /) + kbo(:, 1,20,16) = (/ & + & 0.15671e+04_r8,0.11753e+04_r8,0.89787e+03_r8,0.12782e+04_r8,0.17052e+04_r8 /) + kbo(:, 2,20,16) = (/ & + & 0.15245e+04_r8,0.11434e+04_r8,0.85373e+03_r8,0.12013e+04_r8,0.16026e+04_r8 /) + kbo(:, 3,20,16) = (/ & + & 0.14795e+04_r8,0.11097e+04_r8,0.81323e+03_r8,0.11307e+04_r8,0.15085e+04_r8 /) + kbo(:, 4,20,16) = (/ & + & 0.14333e+04_r8,0.10750e+04_r8,0.77488e+03_r8,0.10684e+04_r8,0.14252e+04_r8 /) + kbo(:, 5,20,16) = (/ & + & 0.13861e+04_r8,0.10396e+04_r8,0.73891e+03_r8,0.10119e+04_r8,0.13498e+04_r8 /) + kbo(:, 1,21,16) = (/ & + & 0.17057e+04_r8,0.12793e+04_r8,0.96840e+03_r8,0.13620e+04_r8,0.18170e+04_r8 /) + kbo(:, 2,21,16) = (/ & + & 0.16509e+04_r8,0.12382e+04_r8,0.91726e+03_r8,0.12758e+04_r8,0.17018e+04_r8 /) + kbo(:, 3,21,16) = (/ & + & 0.15947e+04_r8,0.11960e+04_r8,0.87064e+03_r8,0.11975e+04_r8,0.15973e+04_r8 /) + kbo(:, 4,21,16) = (/ & + & 0.15386e+04_r8,0.11540e+04_r8,0.82723e+03_r8,0.11286e+04_r8,0.15054e+04_r8 /) + kbo(:, 5,21,16) = (/ & + & 0.14823e+04_r8,0.11117e+04_r8,0.78614e+03_r8,0.10661e+04_r8,0.14220e+04_r8 /) + kbo(:, 1,22,16) = (/ & + & 0.18293e+04_r8,0.13720e+04_r8,0.10288e+04_r8,0.14300e+04_r8,0.19074e+04_r8 /) + kbo(:, 2,22,16) = (/ & + & 0.17617e+04_r8,0.13213e+04_r8,0.97120e+03_r8,0.13351e+04_r8,0.17808e+04_r8 /) + kbo(:, 3,22,16) = (/ & + & 0.16944e+04_r8,0.12708e+04_r8,0.91894e+03_r8,0.12506e+04_r8,0.16681e+04_r8 /) + kbo(:, 4,22,16) = (/ & + & 0.16287e+04_r8,0.12215e+04_r8,0.87041e+03_r8,0.11757e+04_r8,0.15681e+04_r8 /) + kbo(:, 5,22,16) = (/ & + & 0.15635e+04_r8,0.11726e+04_r8,0.82499e+03_r8,0.11083e+04_r8,0.14783e+04_r8 /) + kbo(:, 1,23,16) = (/ & + & 0.19373e+04_r8,0.14530e+04_r8,0.10803e+04_r8,0.14855e+04_r8,0.19814e+04_r8 /) + kbo(:, 2,23,16) = (/ & + & 0.18577e+04_r8,0.13933e+04_r8,0.10171e+04_r8,0.13836e+04_r8,0.18455e+04_r8 /) + kbo(:, 3,23,16) = (/ & + & 0.17799e+04_r8,0.13350e+04_r8,0.95955e+03_r8,0.12936e+04_r8,0.17253e+04_r8 /) + kbo(:, 4,23,16) = (/ & + & 0.17053e+04_r8,0.12790e+04_r8,0.90643e+03_r8,0.12138e+04_r8,0.16189e+04_r8 /) + kbo(:, 5,23,16) = (/ & + & 0.16318e+04_r8,0.12239e+04_r8,0.85742e+03_r8,0.11422e+04_r8,0.15233e+04_r8 /) + kbo(:, 1,24,16) = (/ & + & 0.20285e+04_r8,0.15214e+04_r8,0.11229e+04_r8,0.15287e+04_r8,0.20389e+04_r8 /) + kbo(:, 2,24,16) = (/ & + & 0.19379e+04_r8,0.14534e+04_r8,0.10546e+04_r8,0.14215e+04_r8,0.18958e+04_r8 /) + kbo(:, 3,24,16) = (/ & + & 0.18509e+04_r8,0.13882e+04_r8,0.99252e+03_r8,0.13268e+04_r8,0.17696e+04_r8 /) + kbo(:, 4,24,16) = (/ & + & 0.17680e+04_r8,0.13260e+04_r8,0.93542e+03_r8,0.12431e+04_r8,0.16579e+04_r8 /) + kbo(:, 5,24,16) = (/ & + & 0.16872e+04_r8,0.12654e+04_r8,0.88318e+03_r8,0.11679e+04_r8,0.15576e+04_r8 /) + kbo(:, 1,25,16) = (/ & + & 0.21022e+04_r8,0.15767e+04_r8,0.11562e+04_r8,0.15596e+04_r8,0.20800e+04_r8 /) + kbo(:, 2,25,16) = (/ & + & 0.20021e+04_r8,0.15016e+04_r8,0.10837e+04_r8,0.14483e+04_r8,0.19315e+04_r8 /) + kbo(:, 3,25,16) = (/ & + & 0.19072e+04_r8,0.14304e+04_r8,0.10177e+04_r8,0.13507e+04_r8,0.18013e+04_r8 /) + kbo(:, 4,25,16) = (/ & + & 0.18172e+04_r8,0.13629e+04_r8,0.95761e+03_r8,0.12639e+04_r8,0.16854e+04_r8 /) + kbo(:, 5,25,16) = (/ & + & 0.17302e+04_r8,0.12976e+04_r8,0.90262e+03_r8,0.11861e+04_r8,0.15818e+04_r8 /) + kbo(:, 1,26,16) = (/ & + & 0.21584e+04_r8,0.16188e+04_r8,0.11798e+04_r8,0.15785e+04_r8,0.21051e+04_r8 /) + kbo(:, 2,26,16) = (/ & + & 0.20504e+04_r8,0.15378e+04_r8,0.11040e+04_r8,0.14649e+04_r8,0.19536e+04_r8 /) + kbo(:, 3,26,16) = (/ & + & 0.19488e+04_r8,0.14616e+04_r8,0.10351e+04_r8,0.13650e+04_r8,0.18204e+04_r8 /) + kbo(:, 4,26,16) = (/ & + & 0.18527e+04_r8,0.13896e+04_r8,0.97267e+03_r8,0.12762e+04_r8,0.17019e+04_r8 /) + kbo(:, 5,26,16) = (/ & + & 0.17609e+04_r8,0.13206e+04_r8,0.91583e+03_r8,0.11969e+04_r8,0.15961e+04_r8 /) + kbo(:, 1,27,16) = (/ & + & 0.21995e+04_r8,0.16496e+04_r8,0.11960e+04_r8,0.15887e+04_r8,0.21185e+04_r8 /) + kbo(:, 2,27,16) = (/ & + & 0.20852e+04_r8,0.15639e+04_r8,0.11175e+04_r8,0.14736e+04_r8,0.19651e+04_r8 /) + kbo(:, 3,27,16) = (/ & + & 0.19784e+04_r8,0.14838e+04_r8,0.10466e+04_r8,0.13723e+04_r8,0.18300e+04_r8 /) + kbo(:, 4,27,16) = (/ & + & 0.18776e+04_r8,0.14082e+04_r8,0.98231e+03_r8,0.12823e+04_r8,0.17101e+04_r8 /) + kbo(:, 5,27,16) = (/ & + & 0.17820e+04_r8,0.13365e+04_r8,0.92416e+03_r8,0.12022e+04_r8,0.16031e+04_r8 /) + kbo(:, 1,28,16) = (/ & + & 0.22274e+04_r8,0.16706e+04_r8,0.12052e+04_r8,0.15913e+04_r8,0.21220e+04_r8 /) + kbo(:, 2,28,16) = (/ & + & 0.21084e+04_r8,0.15813e+04_r8,0.11251e+04_r8,0.14757e+04_r8,0.19679e+04_r8 /) + kbo(:, 3,28,16) = (/ & + & 0.19974e+04_r8,0.14981e+04_r8,0.10528e+04_r8,0.13738e+04_r8,0.18320e+04_r8 /) + kbo(:, 4,28,16) = (/ & + & 0.18930e+04_r8,0.14198e+04_r8,0.98736e+03_r8,0.12834e+04_r8,0.17114e+04_r8 /) + kbo(:, 5,28,16) = (/ & + & 0.17945e+04_r8,0.13459e+04_r8,0.92826e+03_r8,0.12029e+04_r8,0.16040e+04_r8 /) + kbo(:, 1,29,16) = (/ & + & 0.22434e+04_r8,0.16825e+04_r8,0.12082e+04_r8,0.15868e+04_r8,0.21160e+04_r8 /) + kbo(:, 2,29,16) = (/ & + & 0.21209e+04_r8,0.15907e+04_r8,0.11272e+04_r8,0.14716e+04_r8,0.19623e+04_r8 /) + kbo(:, 3,29,16) = (/ & + & 0.20069e+04_r8,0.15052e+04_r8,0.10541e+04_r8,0.13700e+04_r8,0.18268e+04_r8 /) + kbo(:, 4,29,16) = (/ & + & 0.18999e+04_r8,0.14249e+04_r8,0.98819e+03_r8,0.12798e+04_r8,0.17065e+04_r8 /) + kbo(:, 5,29,16) = (/ & + & 0.17996e+04_r8,0.13497e+04_r8,0.92869e+03_r8,0.11992e+04_r8,0.15991e+04_r8 /) + kbo(:, 1,30,16) = (/ & + & 0.22495e+04_r8,0.16871e+04_r8,0.12065e+04_r8,0.15776e+04_r8,0.21036e+04_r8 /) + kbo(:, 2,30,16) = (/ & + & 0.21251e+04_r8,0.15938e+04_r8,0.11251e+04_r8,0.14633e+04_r8,0.19512e+04_r8 /) + kbo(:, 3,30,16) = (/ & + & 0.20091e+04_r8,0.15068e+04_r8,0.10517e+04_r8,0.13621e+04_r8,0.18163e+04_r8 /) + kbo(:, 4,30,16) = (/ & + & 0.19004e+04_r8,0.14253e+04_r8,0.98584e+03_r8,0.12727e+04_r8,0.16970e+04_r8 /) + kbo(:, 5,30,16) = (/ & + & 0.17984e+04_r8,0.13488e+04_r8,0.92610e+03_r8,0.11928e+04_r8,0.15905e+04_r8 /) + kbo(:, 1,31,16) = (/ & + & 0.22474e+04_r8,0.16855e+04_r8,0.12005e+04_r8,0.15635e+04_r8,0.20848e+04_r8 /) + kbo(:, 2,31,16) = (/ & + & 0.21214e+04_r8,0.15910e+04_r8,0.11192e+04_r8,0.14507e+04_r8,0.19344e+04_r8 /) + kbo(:, 3,31,16) = (/ & + & 0.20043e+04_r8,0.15033e+04_r8,0.10461e+04_r8,0.13510e+04_r8,0.18015e+04_r8 /) + kbo(:, 4,31,16) = (/ & + & 0.18948e+04_r8,0.14211e+04_r8,0.98049e+03_r8,0.12625e+04_r8,0.16835e+04_r8 /) + kbo(:, 5,31,16) = (/ & + & 0.17922e+04_r8,0.13441e+04_r8,0.92102e+03_r8,0.11837e+04_r8,0.15784e+04_r8 /) + kbo(:, 1,32,16) = (/ & + & 0.22387e+04_r8,0.16790e+04_r8,0.11913e+04_r8,0.15463e+04_r8,0.20617e+04_r8 /) + kbo(:, 2,32,16) = (/ & + & 0.21117e+04_r8,0.15838e+04_r8,0.11104e+04_r8,0.14353e+04_r8,0.19138e+04_r8 /) + kbo(:, 3,32,16) = (/ & + & 0.19944e+04_r8,0.14958e+04_r8,0.10381e+04_r8,0.13373e+04_r8,0.17831e+04_r8 /) + kbo(:, 4,32,16) = (/ & + & 0.18846e+04_r8,0.14135e+04_r8,0.97304e+03_r8,0.12502e+04_r8,0.16670e+04_r8 /) + kbo(:, 5,32,16) = (/ & + & 0.17818e+04_r8,0.13363e+04_r8,0.91392e+03_r8,0.11724e+04_r8,0.15633e+04_r8 /) + kbo(:, 1,33,16) = (/ & + & 0.22243e+04_r8,0.16682e+04_r8,0.11793e+04_r8,0.15266e+04_r8,0.20355e+04_r8 /) + kbo(:, 2,33,16) = (/ & + & 0.20975e+04_r8,0.15731e+04_r8,0.10994e+04_r8,0.14177e+04_r8,0.18903e+04_r8 /) + kbo(:, 3,33,16) = (/ & + & 0.19805e+04_r8,0.14854e+04_r8,0.10282e+04_r8,0.13217e+04_r8,0.17623e+04_r8 /) + kbo(:, 4,33,16) = (/ & + & 0.18707e+04_r8,0.14030e+04_r8,0.96384e+03_r8,0.12361e+04_r8,0.16482e+04_r8 /) + kbo(:, 5,33,16) = (/ & + & 0.17684e+04_r8,0.13263e+04_r8,0.90541e+03_r8,0.11600e+04_r8,0.15467e+04_r8 /) + kbo(:, 1,34,16) = (/ & + & 0.22110e+04_r8,0.16582e+04_r8,0.11687e+04_r8,0.15094e+04_r8,0.20126e+04_r8 /) + kbo(:, 2,34,16) = (/ & + & 0.20843e+04_r8,0.15632e+04_r8,0.10894e+04_r8,0.14021e+04_r8,0.18696e+04_r8 /) + kbo(:, 3,34,16) = (/ & + & 0.19675e+04_r8,0.14756e+04_r8,0.10193e+04_r8,0.13079e+04_r8,0.17439e+04_r8 /) + kbo(:, 4,34,16) = (/ & + & 0.18579e+04_r8,0.13934e+04_r8,0.95559e+03_r8,0.12238e+04_r8,0.16318e+04_r8 /) + kbo(:, 5,34,16) = (/ & + & 0.17560e+04_r8,0.13170e+04_r8,0.89776e+03_r8,0.11489e+04_r8,0.15318e+04_r8 /) + kbo(:, 1,35,16) = (/ & + & 0.22070e+04_r8,0.16552e+04_r8,0.11645e+04_r8,0.15017e+04_r8,0.20024e+04_r8 /) + kbo(:, 2,35,16) = (/ & + & 0.20800e+04_r8,0.15600e+04_r8,0.10855e+04_r8,0.13953e+04_r8,0.18605e+04_r8 /) + kbo(:, 3,35,16) = (/ & + & 0.19630e+04_r8,0.14722e+04_r8,0.10157e+04_r8,0.13017e+04_r8,0.17356e+04_r8 /) + kbo(:, 4,35,16) = (/ & + & 0.18532e+04_r8,0.13899e+04_r8,0.95221e+03_r8,0.12182e+04_r8,0.16243e+04_r8 /) + kbo(:, 5,35,16) = (/ & + & 0.17512e+04_r8,0.13134e+04_r8,0.89456e+03_r8,0.11438e+04_r8,0.15251e+04_r8 /) + kbo(:, 1,36,16) = (/ & + & 0.22146e+04_r8,0.16609e+04_r8,0.11681e+04_r8,0.15050e+04_r8,0.20067e+04_r8 /) + kbo(:, 2,36,16) = (/ & + & 0.20867e+04_r8,0.15651e+04_r8,0.10887e+04_r8,0.13982e+04_r8,0.18642e+04_r8 /) + kbo(:, 3,36,16) = (/ & + & 0.19689e+04_r8,0.14767e+04_r8,0.10184e+04_r8,0.13041e+04_r8,0.17389e+04_r8 /) + kbo(:, 4,36,16) = (/ & + & 0.18582e+04_r8,0.13937e+04_r8,0.95458e+03_r8,0.12204e+04_r8,0.16272e+04_r8 /) + kbo(:, 5,36,16) = (/ & + & 0.17557e+04_r8,0.13168e+04_r8,0.89664e+03_r8,0.11458e+04_r8,0.15277e+04_r8 /) + kbo(:, 1,37,16) = (/ & + & 0.22411e+04_r8,0.16809e+04_r8,0.11837e+04_r8,0.15248e+04_r8,0.20331e+04_r8 /) + kbo(:, 2,37,16) = (/ & + & 0.21106e+04_r8,0.15830e+04_r8,0.11025e+04_r8,0.14155e+04_r8,0.18873e+04_r8 /) + kbo(:, 3,37,16) = (/ & + & 0.19909e+04_r8,0.14932e+04_r8,0.10307e+04_r8,0.13195e+04_r8,0.17594e+04_r8 /) + kbo(:, 4,37,16) = (/ & + & 0.18783e+04_r8,0.14088e+04_r8,0.96559e+03_r8,0.12340e+04_r8,0.16453e+04_r8 /) + kbo(:, 5,37,16) = (/ & + & 0.17743e+04_r8,0.13307e+04_r8,0.90666e+03_r8,0.11578e+04_r8,0.15438e+04_r8 /) + kbo(:, 1,38,16) = (/ & + & 0.22677e+04_r8,0.17008e+04_r8,0.11995e+04_r8,0.15451e+04_r8,0.20601e+04_r8 /) + kbo(:, 2,38,16) = (/ & + & 0.21347e+04_r8,0.16010e+04_r8,0.11166e+04_r8,0.14334e+04_r8,0.19112e+04_r8 /) + kbo(:, 3,38,16) = (/ & + & 0.20130e+04_r8,0.15097e+04_r8,0.10432e+04_r8,0.13353e+04_r8,0.17805e+04_r8 /) + kbo(:, 4,38,16) = (/ & + & 0.18989e+04_r8,0.14242e+04_r8,0.97692e+03_r8,0.12480e+04_r8,0.16640e+04_r8 /) + kbo(:, 5,38,16) = (/ & + & 0.17929e+04_r8,0.13447e+04_r8,0.91684e+03_r8,0.11704e+04_r8,0.15605e+04_r8 /) + kbo(:, 1,39,16) = (/ & + & 0.22932e+04_r8,0.17199e+04_r8,0.12149e+04_r8,0.15649e+04_r8,0.20865e+04_r8 /) + kbo(:, 2,39,16) = (/ & + & 0.21580e+04_r8,0.16185e+04_r8,0.11304e+04_r8,0.14510e+04_r8,0.19346e+04_r8 /) + kbo(:, 3,39,16) = (/ & + & 0.20342e+04_r8,0.15257e+04_r8,0.10554e+04_r8,0.13508e+04_r8,0.18011e+04_r8 /) + kbo(:, 4,39,16) = (/ & + & 0.19186e+04_r8,0.14389e+04_r8,0.98789e+03_r8,0.12618e+04_r8,0.16825e+04_r8 /) + kbo(:, 5,39,16) = (/ & + & 0.18110e+04_r8,0.13582e+04_r8,0.92676e+03_r8,0.11826e+04_r8,0.15768e+04_r8 /) + kbo(:, 1,40,16) = (/ & + & 0.23330e+04_r8,0.17497e+04_r8,0.12394e+04_r8,0.15975e+04_r8,0.21300e+04_r8 /) + kbo(:, 2,40,16) = (/ & + & 0.21946e+04_r8,0.16460e+04_r8,0.11524e+04_r8,0.14797e+04_r8,0.19730e+04_r8 /) + kbo(:, 3,40,16) = (/ & + & 0.20673e+04_r8,0.15505e+04_r8,0.10747e+04_r8,0.13759e+04_r8,0.18346e+04_r8 /) + kbo(:, 4,40,16) = (/ & + & 0.19494e+04_r8,0.14621e+04_r8,0.10054e+04_r8,0.12842e+04_r8,0.17123e+04_r8 /) + kbo(:, 5,40,16) = (/ & + & 0.18395e+04_r8,0.13796e+04_r8,0.94264e+03_r8,0.12026e+04_r8,0.16034e+04_r8 /) + kbo(:, 1,41,16) = (/ & + & 0.23748e+04_r8,0.17811e+04_r8,0.12653e+04_r8,0.16323e+04_r8,0.21765e+04_r8 /) + kbo(:, 2,41,16) = (/ & + & 0.22335e+04_r8,0.16751e+04_r8,0.11760e+04_r8,0.15106e+04_r8,0.20142e+04_r8 /) + kbo(:, 3,41,16) = (/ & + & 0.21020e+04_r8,0.15765e+04_r8,0.10953e+04_r8,0.14029e+04_r8,0.18706e+04_r8 /) + kbo(:, 4,41,16) = (/ & + & 0.19818e+04_r8,0.14863e+04_r8,0.10239e+04_r8,0.13082e+04_r8,0.17443e+04_r8 /) + kbo(:, 5,41,16) = (/ & + & 0.18696e+04_r8,0.14022e+04_r8,0.95944e+03_r8,0.12238e+04_r8,0.16317e+04_r8 /) + kbo(:, 1,42,16) = (/ & + & 0.24183e+04_r8,0.18137e+04_r8,0.12922e+04_r8,0.16686e+04_r8,0.22248e+04_r8 /) + kbo(:, 2,42,16) = (/ & + & 0.22718e+04_r8,0.17039e+04_r8,0.11997e+04_r8,0.15420e+04_r8,0.20561e+04_r8 /) + kbo(:, 3,42,16) = (/ & + & 0.21373e+04_r8,0.16030e+04_r8,0.11164e+04_r8,0.14305e+04_r8,0.19073e+04_r8 /) + kbo(:, 4,42,16) = (/ & + & 0.20143e+04_r8,0.15107e+04_r8,0.10428e+04_r8,0.13327e+04_r8,0.17770e+04_r8 /) + kbo(:, 5,42,16) = (/ & + & 0.18998e+04_r8,0.14249e+04_r8,0.97647e+03_r8,0.12457e+04_r8,0.16610e+04_r8 /) + kbo(:, 1,43,16) = (/ & + & 0.24703e+04_r8,0.18528e+04_r8,0.13249e+04_r8,0.17136e+04_r8,0.22848e+04_r8 /) + kbo(:, 2,43,16) = (/ & + & 0.23188e+04_r8,0.17391e+04_r8,0.12289e+04_r8,0.15811e+04_r8,0.21082e+04_r8 /) + kbo(:, 3,43,16) = (/ & + & 0.21803e+04_r8,0.16352e+04_r8,0.11426e+04_r8,0.14651e+04_r8,0.19535e+04_r8 /) + kbo(:, 4,43,16) = (/ & + & 0.20539e+04_r8,0.15404e+04_r8,0.10659e+04_r8,0.13633e+04_r8,0.18177e+04_r8 /) + kbo(:, 5,43,16) = (/ & + & 0.19367e+04_r8,0.14525e+04_r8,0.99744e+03_r8,0.12728e+04_r8,0.16970e+04_r8 /) + kbo(:, 1,44,16) = (/ & + & 0.25274e+04_r8,0.18956e+04_r8,0.13612e+04_r8,0.17642e+04_r8,0.23522e+04_r8 /) + kbo(:, 2,44,16) = (/ & + & 0.23706e+04_r8,0.17780e+04_r8,0.12614e+04_r8,0.16248e+04_r8,0.21664e+04_r8 /) + kbo(:, 3,44,16) = (/ & + & 0.22278e+04_r8,0.16708e+04_r8,0.11717e+04_r8,0.15040e+04_r8,0.20053e+04_r8 /) + kbo(:, 4,44,16) = (/ & + & 0.20979e+04_r8,0.15734e+04_r8,0.10920e+04_r8,0.13972e+04_r8,0.18630e+04_r8 /) + kbo(:, 5,44,16) = (/ & + & 0.19771e+04_r8,0.14828e+04_r8,0.10207e+04_r8,0.13030e+04_r8,0.17374e+04_r8 /) + kbo(:, 1,45,16) = (/ & + & 0.25859e+04_r8,0.19394e+04_r8,0.13990e+04_r8,0.18173e+04_r8,0.24231e+04_r8 /) + kbo(:, 2,45,16) = (/ & + & 0.24239e+04_r8,0.18179e+04_r8,0.12948e+04_r8,0.16708e+04_r8,0.22278e+04_r8 /) + kbo(:, 3,45,16) = (/ & + & 0.22761e+04_r8,0.17071e+04_r8,0.12017e+04_r8,0.15441e+04_r8,0.20588e+04_r8 /) + kbo(:, 4,45,16) = (/ & + & 0.21421e+04_r8,0.16066e+04_r8,0.11186e+04_r8,0.14324e+04_r8,0.19099e+04_r8 /) + kbo(:, 5,45,16) = (/ & + & 0.20183e+04_r8,0.15137e+04_r8,0.10446e+04_r8,0.13343e+04_r8,0.17791e+04_r8 /) + kbo(:, 1,46,16) = (/ & + & 0.26504e+04_r8,0.19878e+04_r8,0.14409e+04_r8,0.18767e+04_r8,0.25023e+04_r8 /) + kbo(:, 2,46,16) = (/ & + & 0.24823e+04_r8,0.18617e+04_r8,0.13316e+04_r8,0.17220e+04_r8,0.22960e+04_r8 /) + kbo(:, 3,46,16) = (/ & + & 0.23297e+04_r8,0.17473e+04_r8,0.12351e+04_r8,0.15885e+04_r8,0.21180e+04_r8 /) + kbo(:, 4,46,16) = (/ & + & 0.21905e+04_r8,0.16429e+04_r8,0.11482e+04_r8,0.14718e+04_r8,0.19624e+04_r8 /) + kbo(:, 5,46,16) = (/ & + & 0.20627e+04_r8,0.15470e+04_r8,0.10708e+04_r8,0.13689e+04_r8,0.18252e+04_r8 /) + kbo(:, 1,47,16) = (/ & + & 0.27247e+04_r8,0.20435e+04_r8,0.14902e+04_r8,0.19477e+04_r8,0.25969e+04_r8 /) + kbo(:, 2,47,16) = (/ & + & 0.25493e+04_r8,0.19120e+04_r8,0.13747e+04_r8,0.17822e+04_r8,0.23763e+04_r8 /) + kbo(:, 3,47,16) = (/ & + & 0.23907e+04_r8,0.17930e+04_r8,0.12733e+04_r8,0.16405e+04_r8,0.21874e+04_r8 /) + kbo(:, 4,47,16) = (/ & + & 0.22466e+04_r8,0.16850e+04_r8,0.11827e+04_r8,0.15177e+04_r8,0.20235e+04_r8 /) + kbo(:, 5,47,16) = (/ & + & 0.21136e+04_r8,0.15852e+04_r8,0.11012e+04_r8,0.14091e+04_r8,0.18788e+04_r8 /) + kbo(:, 1,48,16) = (/ & + & 0.28012e+04_r8,0.21009e+04_r8,0.15426e+04_r8,0.20233e+04_r8,0.26978e+04_r8 /) + kbo(:, 2,48,16) = (/ & + & 0.26190e+04_r8,0.19642e+04_r8,0.14199e+04_r8,0.18460e+04_r8,0.24614e+04_r8 /) + kbo(:, 3,48,16) = (/ & + & 0.24541e+04_r8,0.18406e+04_r8,0.13132e+04_r8,0.16956e+04_r8,0.22609e+04_r8 /) + kbo(:, 4,48,16) = (/ & + & 0.23037e+04_r8,0.17278e+04_r8,0.12184e+04_r8,0.15658e+04_r8,0.20877e+04_r8 /) + kbo(:, 5,48,16) = (/ & + & 0.21661e+04_r8,0.16246e+04_r8,0.11331e+04_r8,0.14514e+04_r8,0.19352e+04_r8 /) + kbo(:, 1,49,16) = (/ & + & 0.28818e+04_r8,0.21613e+04_r8,0.15982e+04_r8,0.21038e+04_r8,0.28050e+04_r8 /) + kbo(:, 2,49,16) = (/ & + & 0.26914e+04_r8,0.20185e+04_r8,0.14674e+04_r8,0.19143e+04_r8,0.25524e+04_r8 /) + kbo(:, 3,49,16) = (/ & + & 0.25196e+04_r8,0.18897e+04_r8,0.13550e+04_r8,0.17541e+04_r8,0.23389e+04_r8 /) + kbo(:, 4,49,16) = (/ & + & 0.23632e+04_r8,0.17724e+04_r8,0.12557e+04_r8,0.16163e+04_r8,0.21550e+04_r8 /) + kbo(:, 5,49,16) = (/ & + & 0.22208e+04_r8,0.16656e+04_r8,0.11666e+04_r8,0.14961e+04_r8,0.19948e+04_r8 /) + kbo(:, 1,50,16) = (/ & + & 0.29612e+04_r8,0.22209e+04_r8,0.16532e+04_r8,0.21839e+04_r8,0.29118e+04_r8 /) + kbo(:, 2,50,16) = (/ & + & 0.27615e+04_r8,0.20712e+04_r8,0.15149e+04_r8,0.19827e+04_r8,0.26437e+04_r8 /) + kbo(:, 3,50,16) = (/ & + & 0.25830e+04_r8,0.19373e+04_r8,0.13961e+04_r8,0.18120e+04_r8,0.24160e+04_r8 /) + kbo(:, 4,50,16) = (/ & + & 0.24210e+04_r8,0.18157e+04_r8,0.12921e+04_r8,0.16664e+04_r8,0.22218e+04_r8 /) + kbo(:, 5,50,16) = (/ & + & 0.22734e+04_r8,0.17051e+04_r8,0.11994e+04_r8,0.15401e+04_r8,0.20534e+04_r8 /) + kbo(:, 1,51,16) = (/ & + & 0.30414e+04_r8,0.22810e+04_r8,0.17098e+04_r8,0.22662e+04_r8,0.30216e+04_r8 /) + kbo(:, 2,51,16) = (/ & + & 0.28321e+04_r8,0.21241e+04_r8,0.15635e+04_r8,0.20530e+04_r8,0.27374e+04_r8 /) + kbo(:, 3,51,16) = (/ & + & 0.26473e+04_r8,0.19855e+04_r8,0.14379e+04_r8,0.18712e+04_r8,0.24950e+04_r8 /) + kbo(:, 4,51,16) = (/ & + & 0.24793e+04_r8,0.18595e+04_r8,0.13289e+04_r8,0.17174e+04_r8,0.22898e+04_r8 /) + kbo(:, 5,51,16) = (/ & + & 0.23268e+04_r8,0.17451e+04_r8,0.12327e+04_r8,0.15846e+04_r8,0.21128e+04_r8 /) + kbo(:, 1,52,16) = (/ & + & 0.31248e+04_r8,0.23436e+04_r8,0.17703e+04_r8,0.23534e+04_r8,0.31379e+04_r8 /) + kbo(:, 2,52,16) = (/ & + & 0.29063e+04_r8,0.21797e+04_r8,0.16147e+04_r8,0.21274e+04_r8,0.28366e+04_r8 /) + kbo(:, 3,52,16) = (/ & + & 0.27134e+04_r8,0.20351e+04_r8,0.14818e+04_r8,0.19344e+04_r8,0.25793e+04_r8 /) + kbo(:, 4,52,16) = (/ & + & 0.25389e+04_r8,0.19042e+04_r8,0.13672e+04_r8,0.17712e+04_r8,0.23616e+04_r8 /) + kbo(:, 5,52,16) = (/ & + & 0.23814e+04_r8,0.17860e+04_r8,0.12669e+04_r8,0.16310e+04_r8,0.21746e+04_r8 /) + kbo(:, 1,53,16) = (/ & + & 0.32126e+04_r8,0.24095e+04_r8,0.18346e+04_r8,0.24459e+04_r8,0.32612e+04_r8 /) + kbo(:, 2,53,16) = (/ & + & 0.29838e+04_r8,0.22378e+04_r8,0.16687e+04_r8,0.22061e+04_r8,0.29415e+04_r8 /) + kbo(:, 3,53,16) = (/ & + & 0.27817e+04_r8,0.20863e+04_r8,0.15283e+04_r8,0.20017e+04_r8,0.26689e+04_r8 /) + kbo(:, 4,53,16) = (/ & + & 0.26009e+04_r8,0.19507e+04_r8,0.14074e+04_r8,0.18280e+04_r8,0.24374e+04_r8 /) + kbo(:, 5,53,16) = (/ & + & 0.24377e+04_r8,0.18283e+04_r8,0.13025e+04_r8,0.16802e+04_r8,0.22403e+04_r8 /) + kbo(:, 1,54,16) = (/ & + & 0.32965e+04_r8,0.24725e+04_r8,0.18972e+04_r8,0.25356e+04_r8,0.33807e+04_r8 /) + kbo(:, 2,54,16) = (/ & + & 0.30576e+04_r8,0.22932e+04_r8,0.17211e+04_r8,0.22822e+04_r8,0.30430e+04_r8 /) + kbo(:, 3,54,16) = (/ & + & 0.28468e+04_r8,0.21351e+04_r8,0.15733e+04_r8,0.20668e+04_r8,0.27558e+04_r8 /) + kbo(:, 4,54,16) = (/ & + & 0.26600e+04_r8,0.19950e+04_r8,0.14459e+04_r8,0.18829e+04_r8,0.25105e+04_r8 /) + kbo(:, 5,54,16) = (/ & + & 0.24912e+04_r8,0.18684e+04_r8,0.13364e+04_r8,0.17275e+04_r8,0.23034e+04_r8 /) + kbo(:, 1,55,16) = (/ & + & 0.33833e+04_r8,0.25376e+04_r8,0.19611e+04_r8,0.26264e+04_r8,0.35019e+04_r8 /) + kbo(:, 2,55,16) = (/ & + & 0.31321e+04_r8,0.23491e+04_r8,0.17750e+04_r8,0.23596e+04_r8,0.31462e+04_r8 /) + kbo(:, 3,55,16) = (/ & + & 0.29119e+04_r8,0.21839e+04_r8,0.16184e+04_r8,0.21327e+04_r8,0.28435e+04_r8 /) + kbo(:, 4,55,16) = (/ & + & 0.27182e+04_r8,0.20386e+04_r8,0.14848e+04_r8,0.19390e+04_r8,0.25853e+04_r8 /) + kbo(:, 5,55,16) = (/ & + & 0.25438e+04_r8,0.19078e+04_r8,0.13702e+04_r8,0.17749e+04_r8,0.23665e+04_r8 /) + kbo(:, 1,56,16) = (/ & + & 0.34732e+04_r8,0.26050e+04_r8,0.20286e+04_r8,0.27221e+04_r8,0.36294e+04_r8 /) + kbo(:, 2,56,16) = (/ & + & 0.32087e+04_r8,0.24066e+04_r8,0.18312e+04_r8,0.24406e+04_r8,0.32540e+04_r8 /) + kbo(:, 3,56,16) = (/ & + & 0.29798e+04_r8,0.22348e+04_r8,0.16657e+04_r8,0.22014e+04_r8,0.29353e+04_r8 /) + kbo(:, 4,56,16) = (/ & + & 0.27779e+04_r8,0.20834e+04_r8,0.15255e+04_r8,0.19978e+04_r8,0.26637e+04_r8 /) + kbo(:, 5,56,16) = (/ & + & 0.25980e+04_r8,0.19485e+04_r8,0.14055e+04_r8,0.18247e+04_r8,0.24330e+04_r8 /) + kbo(:, 1,57,16) = (/ & + & 0.35673e+04_r8,0.26755e+04_r8,0.21006e+04_r8,0.28229e+04_r8,0.37639e+04_r8 /) + kbo(:, 2,57,16) = (/ & + & 0.32883e+04_r8,0.24663e+04_r8,0.18907e+04_r8,0.25257e+04_r8,0.33676e+04_r8 /) + kbo(:, 3,57,16) = (/ & + & 0.30500e+04_r8,0.22875e+04_r8,0.17155e+04_r8,0.22739e+04_r8,0.30319e+04_r8 /) + kbo(:, 4,57,16) = (/ & + & 0.28394e+04_r8,0.21295e+04_r8,0.15682e+04_r8,0.20597e+04_r8,0.27463e+04_r8 /) + kbo(:, 5,57,16) = (/ & + & 0.26543e+04_r8,0.19907e+04_r8,0.14421e+04_r8,0.18768e+04_r8,0.25025e+04_r8 /) + kbo(:, 1,58,16) = (/ & + & 0.36607e+04_r8,0.27457e+04_r8,0.21738e+04_r8,0.29233e+04_r8,0.38978e+04_r8 /) + kbo(:, 2,58,16) = (/ & + & 0.33686e+04_r8,0.25266e+04_r8,0.19501e+04_r8,0.26108e+04_r8,0.34810e+04_r8 /) + kbo(:, 3,58,16) = (/ & + & 0.31191e+04_r8,0.23393e+04_r8,0.17656e+04_r8,0.23462e+04_r8,0.31282e+04_r8 /) + kbo(:, 4,58,16) = (/ & + & 0.29009e+04_r8,0.21757e+04_r8,0.16107e+04_r8,0.21213e+04_r8,0.28285e+04_r8 /) + kbo(:, 5,58,16) = (/ & + & 0.27090e+04_r8,0.20318e+04_r8,0.14784e+04_r8,0.19292e+04_r8,0.25722e+04_r8 /) + kbo(:, 1,59,16) = (/ & + & 0.36992e+04_r8,0.27745e+04_r8,0.22044e+04_r8,0.29651e+04_r8,0.39534e+04_r8 /) + kbo(:, 2,59,16) = (/ & + & 0.34022e+04_r8,0.25517e+04_r8,0.19749e+04_r8,0.26461e+04_r8,0.35281e+04_r8 /) + kbo(:, 3,59,16) = (/ & + & 0.31476e+04_r8,0.23607e+04_r8,0.17864e+04_r8,0.23762e+04_r8,0.31682e+04_r8 /) + kbo(:, 4,59,16) = (/ & + & 0.29259e+04_r8,0.21945e+04_r8,0.16281e+04_r8,0.21469e+04_r8,0.28626e+04_r8 /) + kbo(:, 5,59,16) = (/ & + & 0.27315e+04_r8,0.20486e+04_r8,0.14936e+04_r8,0.19510e+04_r8,0.26013e+04_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.553258e-03_r8, 0.555486e-03_r8, 0.601339e-03_r8, 0.708280e-03_r8 /) + forrefo(:, 2) = (/ 0.158558e-02_r8, 0.162957e-02_r8, 0.204991e-02_r8, 0.475881e-02_r8 /) + forrefo(:, 3) = (/ 0.772542e-02_r8, 0.784562e-02_r8, 0.111979e-01_r8, 0.229016e-01_r8 /) + forrefo(:, 4) = (/ 0.255097e-01_r8, 0.256272e-01_r8, 0.270691e-01_r8, 0.259505e-01_r8 /) + forrefo(:, 5) = (/ 0.323263e-01_r8, 0.324495e-01_r8, 0.305535e-01_r8, 0.263993e-01_r8 /) + forrefo(:, 6) = (/ 0.346920e-01_r8, 0.348255e-01_r8, 0.323586e-01_r8, 0.276357e-01_r8 /) + forrefo(:, 7) = (/ 0.366509e-01_r8, 0.366412e-01_r8, 0.344434e-01_r8, 0.319223e-01_r8 /) + forrefo(:, 8) = (/ 0.378451e-01_r8, 0.375341e-01_r8, 0.374369e-01_r8, 0.320334e-01_r8 /) + forrefo(:, 9) = (/ 0.407348e-01_r8, 0.396203e-01_r8, 0.393988e-01_r8, 0.318343e-01_r8 /) + forrefo(:,10) = (/ 0.433035e-01_r8, 0.426488e-01_r8, 0.408085e-01_r8, 0.332749e-01_r8 /) + forrefo(:,11) = (/ 0.428254e-01_r8, 0.441151e-01_r8, 0.408887e-01_r8, 0.327077e-01_r8 /) + forrefo(:,12) = (/ 0.443226e-01_r8, 0.446690e-01_r8, 0.404676e-01_r8, 0.350492e-01_r8 /) + forrefo(:,13) = (/ 0.466103e-01_r8, 0.460809e-01_r8, 0.401286e-01_r8, 0.370427e-01_r8 /) + forrefo(:,14) = (/ 0.483928e-01_r8, 0.477284e-01_r8, 0.380684e-01_r8, 0.387940e-01_r8 /) + forrefo(:,15) = (/ 0.506987e-01_r8, 0.490016e-01_r8, 0.467069e-01_r8, 0.368998e-01_r8 /) + forrefo(:,16) = (/ 0.510836e-01_r8, 0.522771e-01_r8, 0.500130e-01_r8, 0.483406e-01_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.160537e-01_r8, 0.149038e-01_r8, 0.138363e-01_r8, 0.128452e-01_r8, 0.119251e-01_r8, & + & 0.110709e-01_r8, 0.102779e-01_r8, 0.954175e-02_r8, 0.885829e-02_r8, 0.822379e-02_r8 /) + selfrefo(:, 2) = (/ & + & 0.365753e-01_r8, 0.342267e-01_r8, 0.320288e-01_r8, 0.299720e-01_r8, 0.280474e-01_r8, & + & 0.262463e-01_r8, 0.245609e-01_r8, 0.229837e-01_r8, 0.215078e-01_r8, 0.201267e-01_r8 /) + selfrefo(:, 3) = (/ & + & 0.127419e+00_r8, 0.118553e+00_r8, 0.110304e+00_r8, 0.102629e+00_r8, 0.954883e-01_r8, & + & 0.888442e-01_r8, 0.826624e-01_r8, 0.769107e-01_r8, 0.715593e-01_r8, 0.665802e-01_r8 /) + selfrefo(:, 4) = (/ & + & 0.378687e+00_r8, 0.348961e+00_r8, 0.321568e+00_r8, 0.296325e+00_r8, 0.273064e+00_r8, & + & 0.251629e+00_r8, 0.231876e+00_r8, 0.213674e+00_r8, 0.196901e+00_r8, 0.181444e+00_r8 /) + selfrefo(:, 5) = (/ & + & 0.472822e+00_r8, 0.435018e+00_r8, 0.400236e+00_r8, 0.368236e+00_r8, 0.338794e+00_r8, & + & 0.311706e+00_r8, 0.286783e+00_r8, 0.263854e+00_r8, 0.242757e+00_r8, 0.223348e+00_r8 /) + selfrefo(:, 6) = (/ & + & 0.505620e+00_r8, 0.465050e+00_r8, 0.427736e+00_r8, 0.393416e+00_r8, 0.361849e+00_r8, & + & 0.332815e+00_r8, 0.306111e+00_r8, 0.281550e+00_r8, 0.258959e+00_r8, 0.238181e+00_r8 /) + selfrefo(:, 7) = (/ & + & 0.530488e+00_r8, 0.487993e+00_r8, 0.448902e+00_r8, 0.412943e+00_r8, 0.379864e+00_r8, & + & 0.349434e+00_r8, 0.321443e+00_r8, 0.295694e+00_r8, 0.272007e+00_r8, 0.250218e+00_r8 /) + selfrefo(:, 8) = (/ & + & 0.540222e+00_r8, 0.497746e+00_r8, 0.458610e+00_r8, 0.422551e+00_r8, 0.389327e+00_r8, & + & 0.358716e+00_r8, 0.330511e+00_r8, 0.304524e+00_r8, 0.280580e+00_r8, 0.258519e+00_r8 /) + selfrefo(:, 9) = (/ & + & 0.565727e+00_r8, 0.522899e+00_r8, 0.483313e+00_r8, 0.446724e+00_r8, 0.412905e+00_r8, & + & 0.381646e+00_r8, 0.352753e+00_r8, 0.326048e+00_r8, 0.301365e+00_r8, 0.278550e+00_r8 /) + selfrefo(:,10) = (/ & + & 0.610122e+00_r8, 0.562337e+00_r8, 0.518295e+00_r8, 0.477702e+00_r8, 0.440289e+00_r8, & + & 0.405806e+00_r8, 0.374023e+00_r8, 0.344730e+00_r8, 0.317730e+00_r8, 0.292846e+00_r8 /) + selfrefo(:,11) = (/ & + & 0.645176e+00_r8, 0.588957e+00_r8, 0.537636e+00_r8, 0.490788e+00_r8, 0.448022e+00_r8, & + & 0.408982e+00_r8, 0.373344e+00_r8, 0.340812e+00_r8, 0.311114e+00_r8, 0.284004e+00_r8 /) + selfrefo(:,12) = (/ & + & 0.651737e+00_r8, 0.596547e+00_r8, 0.546031e+00_r8, 0.499792e+00_r8, 0.457469e+00_r8, & + & 0.418730e+00_r8, 0.383272e+00_r8, 0.350816e+00_r8, 0.321108e+00_r8, 0.293916e+00_r8 /) + selfrefo(:,13) = (/ & + & 0.661086e+00_r8, 0.607954e+00_r8, 0.559093e+00_r8, 0.514159e+00_r8, 0.472836e+00_r8, & + & 0.434834e+00_r8, 0.399886e+00_r8, 0.367747e+00_r8, 0.338191e+00_r8, 0.311011e+00_r8 /) + selfrefo(:,14) = (/ & + & 0.692554e+00_r8, 0.635574e+00_r8, 0.583282e+00_r8, 0.535293e+00_r8, 0.491251e+00_r8, & + & 0.450834e+00_r8, 0.413741e+00_r8, 0.379701e+00_r8, 0.348461e+00_r8, 0.319791e+00_r8 /) + selfrefo(:,15) = (/ & + & 0.714646e+00_r8, 0.657179e+00_r8, 0.604334e+00_r8, 0.555737e+00_r8, 0.511049e+00_r8, & + & 0.469954e+00_r8, 0.432164e+00_r8, 0.397412e+00_r8, 0.365455e+00_r8, 0.336068e+00_r8 /) + selfrefo(:,16) = (/ & + & 0.782126e+00_r8, 0.710682e+00_r8, 0.645764e+00_r8, 0.586776e+00_r8, 0.533177e+00_r8, & + & 0.484473e+00_r8, 0.440219e+00_r8, 0.400007e+00_r8, 0.363468e+00_r8, 0.330266e+00_r8 /) + + end subroutine sw_kgb17 + +! ************************************************************************** + subroutine sw_kgb18 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg18, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:,1) = (/ & + & 3.65840_r8 , 3.54375_r8 , 3.34481_r8 , 3.10534_r8 , & + & 2.79879_r8 , 2.42841_r8 , 1.98748_r8 , 1.49377_r8 , & + & 1.00196_r8 , 0.108342_r8 , 8.95099e-02_r8, 7.05199e-02_r8, & + & 5.16432e-02_r8, 3.27635e-02_r8, 1.25133e-02_r8, 1.73001e-03_r8 /) + sfluxrefo(:,2) = (/ & + & 3.86372_r8 , 3.48521_r8 , 3.30790_r8 , 3.08103_r8 , & + & 2.77552_r8 , 2.40722_r8 , 1.97307_r8 , 1.48023_r8 , & + & 0.993055_r8 , 0.107691_r8 , 8.84430e-02_r8, 6.99354e-02_r8, & + & 5.07881e-02_r8, 3.24121e-02_r8, 1.19442e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,3) = (/ & + & 3.90370_r8 , 3.50657_r8 , 3.30629_r8 , 3.06046_r8 , & + & 2.76982_r8 , 2.39907_r8 , 1.96358_r8 , 1.47458_r8 , & + & 0.988475_r8 , 0.106698_r8 , 8.75242e-02_r8, 6.85898e-02_r8, & + & 5.04798e-02_r8, 3.13718e-02_r8, 1.09533e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,4) = (/ & + & 3.93165_r8 , 3.52058_r8 , 3.31346_r8 , 3.04944_r8 , & + & 2.76074_r8 , 2.39433_r8 , 1.95556_r8 , 1.46712_r8 , & + & 0.984056_r8 , 0.105885_r8 , 8.73062e-02_r8, 6.84054e-02_r8, & + & 4.87443e-02_r8, 2.99295e-02_r8, 1.09533e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,5) = (/ & + & 3.94082_r8 , 3.55221_r8 , 3.31863_r8 , 3.04730_r8 , & + & 2.74918_r8 , 2.38328_r8 , 1.95212_r8 , 1.45889_r8 , & + & 0.978888_r8 , 0.105102_r8 , 8.65732e-02_r8, 6.74563e-02_r8, & + & 4.76592e-02_r8, 2.91017e-02_r8, 1.09533e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,6) = (/ & + & 3.94198_r8 , 3.58743_r8 , 3.32106_r8 , 3.05866_r8 , & + & 2.74115_r8 , 2.36939_r8 , 1.94305_r8 , 1.45180_r8 , & + & 0.971784_r8 , 1.04045e-01_r8, 8.53731e-02_r8, 6.60654e-02_r8, & + & 4.63228e-02_r8, 2.91016e-02_r8, 1.09552e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,7) = (/ & + & 3.93596_r8 , 3.63366_r8 , 3.33144_r8 , 3.06252_r8 , & + & 2.74054_r8 , 2.35492_r8 , 1.92769_r8 , 1.44300_r8 , & + & 0.961809_r8 , 1.02867e-01_r8, 8.34164e-02_r8, 6.41005e-02_r8, & + & 4.61826e-02_r8, 2.91006e-02_r8, 1.09553e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,8) = (/ & + & 3.92520_r8 , 3.69078_r8 , 3.35656_r8 , 3.07055_r8 , & + & 2.73862_r8 , 2.34430_r8 , 1.90187_r8 , 1.42242_r8 , & + & 0.946676_r8 , 9.96302e-02_r8, 8.14421e-02_r8, 6.38622e-02_r8, & + & 4.61794e-02_r8, 2.91017e-02_r8, 1.09553e-02_r8, 1.57612e-03_r8 /) + sfluxrefo(:,9) = (/ & + & 3.80721_r8 , 3.74437_r8 , 3.50205_r8 , 3.18009_r8 , & + & 2.75757_r8 , 2.29188_r8 , 1.84382_r8 , 1.35694_r8 , & + & 0.914040_r8 , 9.86811e-02_r8, 8.14321e-02_r8, 6.38541e-02_r8, & + & 4.61795e-02_r8, 2.90960e-02_r8, 1.09613e-02_r8, 1.57612e-03_r8 /) + +! Rayleigh extinction coefficient at v = 4325 cm-1. + rayl = 1.39e-09_r8 + + strrat = 38.9589_r8 + + layreffr = 6 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.14813e-04_r8,0.39842e-04_r8,0.43362e-04_r8,0.43095e-04_r8,0.39811e-04_r8, & + & 0.34994e-04_r8,0.28984e-04_r8,0.20609e-04_r8,0.18845e-05_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.14432e-04_r8,0.38749e-04_r8,0.42119e-04_r8,0.41834e-04_r8,0.38900e-04_r8, & + & 0.34365e-04_r8,0.28571e-04_r8,0.20503e-04_r8,0.14715e-05_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.13969e-04_r8,0.37666e-04_r8,0.40942e-04_r8,0.40703e-04_r8,0.37982e-04_r8, & + & 0.33731e-04_r8,0.28158e-04_r8,0.20351e-04_r8,0.10842e-05_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.13367e-04_r8,0.36605e-04_r8,0.39729e-04_r8,0.39529e-04_r8,0.37033e-04_r8, & + & 0.33096e-04_r8,0.27690e-04_r8,0.20154e-04_r8,0.78702e-06_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.12765e-04_r8,0.35584e-04_r8,0.38536e-04_r8,0.38361e-04_r8,0.36073e-04_r8, & + & 0.32384e-04_r8,0.27242e-04_r8,0.19932e-04_r8,0.58296e-06_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.12299e-04_r8,0.34179e-04_r8,0.37405e-04_r8,0.37535e-04_r8,0.34714e-04_r8, & + & 0.30335e-04_r8,0.24892e-04_r8,0.17524e-04_r8,0.13301e-05_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.12064e-04_r8,0.33225e-04_r8,0.36357e-04_r8,0.36512e-04_r8,0.33870e-04_r8, & + & 0.29789e-04_r8,0.24578e-04_r8,0.17435e-04_r8,0.10217e-05_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.11697e-04_r8,0.32301e-04_r8,0.35316e-04_r8,0.35481e-04_r8,0.33049e-04_r8, & + & 0.29226e-04_r8,0.24233e-04_r8,0.17304e-04_r8,0.72152e-06_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.11209e-04_r8,0.31395e-04_r8,0.34263e-04_r8,0.34436e-04_r8,0.32173e-04_r8, & + & 0.28610e-04_r8,0.23847e-04_r8,0.17161e-04_r8,0.51787e-06_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.10706e-04_r8,0.30496e-04_r8,0.33311e-04_r8,0.33396e-04_r8,0.31295e-04_r8, & + & 0.28002e-04_r8,0.23445e-04_r8,0.16971e-04_r8,0.40230e-06_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.10271e-04_r8,0.29273e-04_r8,0.32049e-04_r8,0.32365e-04_r8,0.29857e-04_r8, & + & 0.26171e-04_r8,0.21352e-04_r8,0.14814e-04_r8,0.80470e-06_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.10058e-04_r8,0.28458e-04_r8,0.31196e-04_r8,0.31440e-04_r8,0.29133e-04_r8, & + & 0.25640e-04_r8,0.21056e-04_r8,0.14756e-04_r8,0.53010e-06_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.98172e-05_r8,0.27651e-04_r8,0.30352e-04_r8,0.30609e-04_r8,0.28396e-04_r8, & + & 0.25110e-04_r8,0.20730e-04_r8,0.14655e-04_r8,0.38652e-06_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.94577e-05_r8,0.26874e-04_r8,0.29475e-04_r8,0.29749e-04_r8,0.27669e-04_r8, & + & 0.24553e-04_r8,0.20400e-04_r8,0.14536e-04_r8,0.33236e-06_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.90508e-05_r8,0.26128e-04_r8,0.28631e-04_r8,0.28834e-04_r8,0.26952e-04_r8, & + & 0.24015e-04_r8,0.20045e-04_r8,0.14382e-04_r8,0.30659e-06_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.86081e-05_r8,0.24897e-04_r8,0.27317e-04_r8,0.27632e-04_r8,0.25465e-04_r8, & + & 0.22328e-04_r8,0.18112e-04_r8,0.12468e-04_r8,0.39286e-06_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.83793e-05_r8,0.24273e-04_r8,0.26590e-04_r8,0.26865e-04_r8,0.24876e-04_r8, & + & 0.21867e-04_r8,0.17849e-04_r8,0.12420e-04_r8,0.32266e-06_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.82296e-05_r8,0.23584e-04_r8,0.25869e-04_r8,0.26155e-04_r8,0.24255e-04_r8, & + & 0.21403e-04_r8,0.17579e-04_r8,0.12338e-04_r8,0.30775e-06_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.79731e-05_r8,0.22915e-04_r8,0.25166e-04_r8,0.25435e-04_r8,0.23627e-04_r8, & + & 0.20917e-04_r8,0.17282e-04_r8,0.12242e-04_r8,0.30418e-06_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.76553e-05_r8,0.22259e-04_r8,0.24440e-04_r8,0.24673e-04_r8,0.23003e-04_r8, & + & 0.20437e-04_r8,0.16984e-04_r8,0.12112e-04_r8,0.30638e-06_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.72259e-05_r8,0.21089e-04_r8,0.23177e-04_r8,0.23419e-04_r8,0.21584e-04_r8, & + & 0.18926e-04_r8,0.15251e-04_r8,0.10417e-04_r8,0.25170e-06_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.70215e-05_r8,0.20567e-04_r8,0.22541e-04_r8,0.22788e-04_r8,0.21102e-04_r8, & + & 0.18526e-04_r8,0.15049e-04_r8,0.10379e-04_r8,0.25958e-06_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.68490e-05_r8,0.20018e-04_r8,0.21938e-04_r8,0.22206e-04_r8,0.20579e-04_r8, & + & 0.18139e-04_r8,0.14806e-04_r8,0.10313e-04_r8,0.26666e-06_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.66973e-05_r8,0.19444e-04_r8,0.21340e-04_r8,0.21615e-04_r8,0.20070e-04_r8, & + & 0.17728e-04_r8,0.14554e-04_r8,0.10239e-04_r8,0.28589e-06_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.64808e-05_r8,0.18883e-04_r8,0.20738e-04_r8,0.20994e-04_r8,0.19546e-04_r8, & + & 0.17304e-04_r8,0.14306e-04_r8,0.10148e-04_r8,0.30886e-06_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.60727e-05_r8,0.17794e-04_r8,0.19609e-04_r8,0.19769e-04_r8,0.18228e-04_r8, & + & 0.15946e-04_r8,0.12793e-04_r8,0.86559e-05_r8,0.18559e-06_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.58949e-05_r8,0.17390e-04_r8,0.19059e-04_r8,0.19244e-04_r8,0.17820e-04_r8, & + & 0.15647e-04_r8,0.12626e-04_r8,0.86354e-05_r8,0.19544e-06_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.57268e-05_r8,0.16935e-04_r8,0.18564e-04_r8,0.18724e-04_r8,0.17402e-04_r8, & + & 0.15304e-04_r8,0.12433e-04_r8,0.85882e-05_r8,0.22033e-06_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.56243e-05_r8,0.16459e-04_r8,0.18054e-04_r8,0.18263e-04_r8,0.16984e-04_r8, & + & 0.14971e-04_r8,0.12215e-04_r8,0.85268e-05_r8,0.25072e-06_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.54584e-05_r8,0.15984e-04_r8,0.17548e-04_r8,0.17773e-04_r8,0.16551e-04_r8, & + & 0.14601e-04_r8,0.12004e-04_r8,0.84568e-05_r8,0.28110e-06_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.50624e-05_r8,0.14963e-04_r8,0.16482e-04_r8,0.16611e-04_r8,0.15339e-04_r8, & + & 0.13333e-04_r8,0.10656e-04_r8,0.71570e-05_r8,0.13453e-06_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.49428e-05_r8,0.14636e-04_r8,0.16040e-04_r8,0.16181e-04_r8,0.14992e-04_r8, & + & 0.13144e-04_r8,0.10533e-04_r8,0.71532e-05_r8,0.15620e-06_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.47955e-05_r8,0.14256e-04_r8,0.15611e-04_r8,0.15735e-04_r8,0.14643e-04_r8, & + & 0.12865e-04_r8,0.10390e-04_r8,0.71248e-05_r8,0.18571e-06_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.46743e-05_r8,0.13876e-04_r8,0.15213e-04_r8,0.15342e-04_r8,0.14293e-04_r8, & + & 0.12576e-04_r8,0.10215e-04_r8,0.70735e-05_r8,0.21382e-06_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.45708e-05_r8,0.13473e-04_r8,0.14782e-04_r8,0.14947e-04_r8,0.13933e-04_r8, & + & 0.12274e-04_r8,0.10036e-04_r8,0.70177e-05_r8,0.24419e-06_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.42289e-05_r8,0.12528e-04_r8,0.13817e-04_r8,0.13922e-04_r8,0.12867e-04_r8, & + & 0.11126e-04_r8,0.88468e-05_r8,0.59010e-05_r8,0.10600e-06_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.41319e-05_r8,0.12286e-04_r8,0.13480e-04_r8,0.13582e-04_r8,0.12584e-04_r8, & + & 0.10973e-04_r8,0.87644e-05_r8,0.59049e-05_r8,0.12951e-06_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.40317e-05_r8,0.11996e-04_r8,0.13116e-04_r8,0.13206e-04_r8,0.12295e-04_r8, & + & 0.10786e-04_r8,0.86537e-05_r8,0.58898e-05_r8,0.15731e-06_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.39107e-05_r8,0.11666e-04_r8,0.12771e-04_r8,0.12870e-04_r8,0.12010e-04_r8, & + & 0.10546e-04_r8,0.85244e-05_r8,0.58536e-05_r8,0.18716e-06_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.38384e-05_r8,0.11346e-04_r8,0.12435e-04_r8,0.12549e-04_r8,0.11706e-04_r8, & + & 0.10289e-04_r8,0.83756e-05_r8,0.58104e-05_r8,0.21679e-06_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.35240e-05_r8,0.10418e-04_r8,0.11558e-04_r8,0.11687e-04_r8,0.10748e-04_r8, & + & 0.92305e-05_r8,0.73198e-05_r8,0.48514e-05_r8,0.10176e-06_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.34478e-05_r8,0.10296e-04_r8,0.11296e-04_r8,0.11369e-04_r8,0.10532e-04_r8, & + & 0.91375e-05_r8,0.72737e-05_r8,0.48639e-05_r8,0.12695e-06_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.33718e-05_r8,0.10068e-04_r8,0.10996e-04_r8,0.11063e-04_r8,0.10290e-04_r8, & + & 0.89957e-05_r8,0.71844e-05_r8,0.48583e-05_r8,0.15482e-06_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.32801e-05_r8,0.97990e-05_r8,0.10712e-04_r8,0.10762e-04_r8,0.10056e-04_r8, & + & 0.88255e-05_r8,0.70907e-05_r8,0.48364e-05_r8,0.18123e-06_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.31960e-05_r8,0.95350e-05_r8,0.10427e-04_r8,0.10501e-04_r8,0.98056e-05_r8, & + & 0.86157e-05_r8,0.69723e-05_r8,0.48010e-05_r8,0.20738e-06_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.29197e-05_r8,0.86183e-05_r8,0.96100e-05_r8,0.97448e-05_r8,0.89187e-05_r8, & + & 0.76354e-05_r8,0.60318e-05_r8,0.39733e-05_r8,0.10310e-06_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.28677e-05_r8,0.85565e-05_r8,0.94191e-05_r8,0.94682e-05_r8,0.87653e-05_r8, & + & 0.75725e-05_r8,0.60089e-05_r8,0.39956e-05_r8,0.12951e-06_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.28036e-05_r8,0.84121e-05_r8,0.91902e-05_r8,0.92251e-05_r8,0.85811e-05_r8, & + & 0.74653e-05_r8,0.59452e-05_r8,0.39967e-05_r8,0.15684e-06_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.27420e-05_r8,0.82035e-05_r8,0.89440e-05_r8,0.89748e-05_r8,0.83817e-05_r8, & + & 0.73422e-05_r8,0.58725e-05_r8,0.39844e-05_r8,0.18564e-06_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.26596e-05_r8,0.79739e-05_r8,0.87074e-05_r8,0.87508e-05_r8,0.81784e-05_r8, & + & 0.71781e-05_r8,0.57815e-05_r8,0.39569e-05_r8,0.21476e-06_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.23988e-05_r8,0.71135e-05_r8,0.79121e-05_r8,0.80118e-05_r8,0.73370e-05_r8, & + & 0.62844e-05_r8,0.49610e-05_r8,0.32641e-05_r8,0.91697e-07_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.23552e-05_r8,0.70587e-05_r8,0.77519e-05_r8,0.77821e-05_r8,0.72113e-05_r8, & + & 0.62297e-05_r8,0.49407e-05_r8,0.32815e-05_r8,0.11307e-06_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.23046e-05_r8,0.69367e-05_r8,0.75662e-05_r8,0.75790e-05_r8,0.70631e-05_r8, & + & 0.61409e-05_r8,0.48867e-05_r8,0.32812e-05_r8,0.13715e-06_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.22557e-05_r8,0.67632e-05_r8,0.73640e-05_r8,0.73772e-05_r8,0.68972e-05_r8, & + & 0.60381e-05_r8,0.48254e-05_r8,0.32705e-05_r8,0.16436e-06_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.21899e-05_r8,0.65748e-05_r8,0.71695e-05_r8,0.71946e-05_r8,0.67295e-05_r8, & + & 0.59022e-05_r8,0.47488e-05_r8,0.32476e-05_r8,0.19025e-06_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.19699e-05_r8,0.58670e-05_r8,0.65075e-05_r8,0.65808e-05_r8,0.60300e-05_r8, & + & 0.51665e-05_r8,0.40749e-05_r8,0.26788e-05_r8,0.77100e-07_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.19348e-05_r8,0.58146e-05_r8,0.63730e-05_r8,0.63891e-05_r8,0.59260e-05_r8, & + & 0.51196e-05_r8,0.40577e-05_r8,0.26926e-05_r8,0.95693e-07_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.18947e-05_r8,0.57134e-05_r8,0.62207e-05_r8,0.62238e-05_r8,0.58090e-05_r8, & + & 0.50459e-05_r8,0.40113e-05_r8,0.26916e-05_r8,0.11572e-06_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.18552e-05_r8,0.55709e-05_r8,0.60522e-05_r8,0.60611e-05_r8,0.56693e-05_r8, & + & 0.49594e-05_r8,0.39606e-05_r8,0.26824e-05_r8,0.13797e-06_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.18040e-05_r8,0.54137e-05_r8,0.58935e-05_r8,0.59096e-05_r8,0.55294e-05_r8, & + & 0.48443e-05_r8,0.38977e-05_r8,0.26633e-05_r8,0.15884e-06_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.16167e-05_r8,0.48272e-05_r8,0.53475e-05_r8,0.53983e-05_r8,0.49503e-05_r8, & + & 0.42413e-05_r8,0.33431e-05_r8,0.21956e-05_r8,0.61381e-07_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.15895e-05_r8,0.47809e-05_r8,0.52342e-05_r8,0.52409e-05_r8,0.48652e-05_r8, & + & 0.42021e-05_r8,0.33263e-05_r8,0.22072e-05_r8,0.76382e-07_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.15582e-05_r8,0.46982e-05_r8,0.51055e-05_r8,0.51058e-05_r8,0.47716e-05_r8, & + & 0.41406e-05_r8,0.32886e-05_r8,0.22058e-05_r8,0.93083e-07_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.15242e-05_r8,0.45831e-05_r8,0.49696e-05_r8,0.49735e-05_r8,0.46534e-05_r8, & + & 0.40678e-05_r8,0.32469e-05_r8,0.21969e-05_r8,0.11211e-06_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.14859e-05_r8,0.44492e-05_r8,0.48392e-05_r8,0.48479e-05_r8,0.45378e-05_r8, & + & 0.39689e-05_r8,0.31933e-05_r8,0.21813e-05_r8,0.12970e-06_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.10138e-03_r8,0.20456e-03_r8,0.22117e-03_r8,0.21948e-03_r8,0.20805e-03_r8, & + & 0.18373e-03_r8,0.14999e-03_r8,0.95382e-04_r8,0.33213e-05_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.10141e-03_r8,0.20889e-03_r8,0.22456e-03_r8,0.22223e-03_r8,0.20912e-03_r8, & + & 0.18467e-03_r8,0.15060e-03_r8,0.95713e-04_r8,0.28479e-05_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.10125e-03_r8,0.21223e-03_r8,0.22712e-03_r8,0.22388e-03_r8,0.20983e-03_r8, & + & 0.18513e-03_r8,0.15100e-03_r8,0.95881e-04_r8,0.26338e-05_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.10105e-03_r8,0.21442e-03_r8,0.22863e-03_r8,0.22421e-03_r8,0.21046e-03_r8, & + & 0.18540e-03_r8,0.15060e-03_r8,0.95798e-04_r8,0.27638e-05_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.10040e-03_r8,0.21612e-03_r8,0.22899e-03_r8,0.22416e-03_r8,0.21046e-03_r8, & + & 0.18570e-03_r8,0.15001e-03_r8,0.95569e-04_r8,0.29313e-05_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.89639e-04_r8,0.17797e-03_r8,0.19284e-03_r8,0.18986e-03_r8,0.17824e-03_r8, & + & 0.15789e-03_r8,0.12906e-03_r8,0.83524e-04_r8,0.23926e-05_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.89499e-04_r8,0.18144e-03_r8,0.19563e-03_r8,0.19227e-03_r8,0.17941e-03_r8, & + & 0.15844e-03_r8,0.12961e-03_r8,0.83632e-04_r8,0.21969e-05_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.89411e-04_r8,0.18401e-03_r8,0.19753e-03_r8,0.19350e-03_r8,0.17999e-03_r8, & + & 0.15883e-03_r8,0.12989e-03_r8,0.83577e-04_r8,0.23158e-05_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.88841e-04_r8,0.18541e-03_r8,0.19872e-03_r8,0.19398e-03_r8,0.18053e-03_r8, & + & 0.15907e-03_r8,0.12972e-03_r8,0.83396e-04_r8,0.23760e-05_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.87949e-04_r8,0.18659e-03_r8,0.19902e-03_r8,0.19407e-03_r8,0.18073e-03_r8, & + & 0.15910e-03_r8,0.12937e-03_r8,0.83120e-04_r8,0.25247e-05_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.77466e-04_r8,0.15264e-03_r8,0.16704e-03_r8,0.16342e-03_r8,0.15300e-03_r8, & + & 0.13499e-03_r8,0.11007e-03_r8,0.71881e-04_r8,0.17839e-05_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.77483e-04_r8,0.15611e-03_r8,0.16950e-03_r8,0.16551e-03_r8,0.15408e-03_r8, & + & 0.13580e-03_r8,0.11055e-03_r8,0.72020e-04_r8,0.18564e-05_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.77142e-04_r8,0.15867e-03_r8,0.17112e-03_r8,0.16672e-03_r8,0.15481e-03_r8, & + & 0.13616e-03_r8,0.11077e-03_r8,0.71922e-04_r8,0.20228e-05_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.76460e-04_r8,0.16058e-03_r8,0.17186e-03_r8,0.16717e-03_r8,0.15519e-03_r8, & + & 0.13641e-03_r8,0.11060e-03_r8,0.71775e-04_r8,0.21717e-05_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.75510e-04_r8,0.16158e-03_r8,0.17210e-03_r8,0.16730e-03_r8,0.15521e-03_r8, & + & 0.13649e-03_r8,0.11022e-03_r8,0.71516e-04_r8,0.23140e-05_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.65931e-04_r8,0.12940e-03_r8,0.14295e-03_r8,0.14005e-03_r8,0.13095e-03_r8, & + & 0.11494e-03_r8,0.93656e-04_r8,0.61167e-04_r8,0.17094e-05_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.66090e-04_r8,0.13269e-03_r8,0.14542e-03_r8,0.14233e-03_r8,0.13201e-03_r8, & + & 0.11558e-03_r8,0.93975e-04_r8,0.61436e-04_r8,0.18527e-05_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.65630e-04_r8,0.13532e-03_r8,0.14717e-03_r8,0.14364e-03_r8,0.13266e-03_r8, & + & 0.11604e-03_r8,0.94126e-04_r8,0.61467e-04_r8,0.19576e-05_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.64971e-04_r8,0.13708e-03_r8,0.14818e-03_r8,0.14427e-03_r8,0.13304e-03_r8, & + & 0.11616e-03_r8,0.94152e-04_r8,0.61334e-04_r8,0.20614e-05_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.64122e-04_r8,0.13834e-03_r8,0.14864e-03_r8,0.14451e-03_r8,0.13312e-03_r8, & + & 0.11638e-03_r8,0.93955e-04_r8,0.61162e-04_r8,0.21640e-05_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.55594e-04_r8,0.10830e-03_r8,0.12068e-03_r8,0.11865e-03_r8,0.11127e-03_r8, & + & 0.97925e-04_r8,0.79208e-04_r8,0.51842e-04_r8,0.15954e-05_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.55669e-04_r8,0.11117e-03_r8,0.12299e-03_r8,0.12091e-03_r8,0.11248e-03_r8, & + & 0.98643e-04_r8,0.79433e-04_r8,0.52127e-04_r8,0.16966e-05_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.55430e-04_r8,0.11345e-03_r8,0.12478e-03_r8,0.12235e-03_r8,0.11332e-03_r8, & + & 0.99117e-04_r8,0.79823e-04_r8,0.52286e-04_r8,0.18304e-05_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.54800e-04_r8,0.11543e-03_r8,0.12601e-03_r8,0.12304e-03_r8,0.11389e-03_r8, & + & 0.99346e-04_r8,0.79935e-04_r8,0.52275e-04_r8,0.19479e-05_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.54027e-04_r8,0.11665e-03_r8,0.12660e-03_r8,0.12339e-03_r8,0.11410e-03_r8, & + & 0.99535e-04_r8,0.79840e-04_r8,0.52168e-04_r8,0.20583e-05_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.46500e-04_r8,0.89887e-04_r8,0.10048e-03_r8,0.99161e-04_r8,0.93136e-04_r8, & + & 0.82279e-04_r8,0.66872e-04_r8,0.43617e-04_r8,0.14730e-05_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.46632e-04_r8,0.92444e-04_r8,0.10271e-03_r8,0.10123e-03_r8,0.94559e-04_r8, & + & 0.83135e-04_r8,0.67204e-04_r8,0.44046e-04_r8,0.16215e-05_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.46490e-04_r8,0.94415e-04_r8,0.10446e-03_r8,0.10269e-03_r8,0.95387e-04_r8, & + & 0.83676e-04_r8,0.67579e-04_r8,0.44279e-04_r8,0.17358e-05_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.46004e-04_r8,0.96190e-04_r8,0.10570e-03_r8,0.10346e-03_r8,0.95883e-04_r8, & + & 0.84038e-04_r8,0.67753e-04_r8,0.44348e-04_r8,0.18096e-05_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.45362e-04_r8,0.97511e-04_r8,0.10645e-03_r8,0.10384e-03_r8,0.96197e-04_r8, & + & 0.84347e-04_r8,0.67758e-04_r8,0.44305e-04_r8,0.18882e-05_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.38597e-04_r8,0.74019e-04_r8,0.82882e-04_r8,0.81807e-04_r8,0.76936e-04_r8, & + & 0.68278e-04_r8,0.55744e-04_r8,0.36507e-04_r8,0.13400e-05_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.38728e-04_r8,0.76353e-04_r8,0.85030e-04_r8,0.83822e-04_r8,0.78523e-04_r8, & + & 0.69221e-04_r8,0.56199e-04_r8,0.36932e-04_r8,0.14766e-05_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.38688e-04_r8,0.78164e-04_r8,0.86691e-04_r8,0.85269e-04_r8,0.79424e-04_r8, & + & 0.69849e-04_r8,0.56507e-04_r8,0.37211e-04_r8,0.16077e-05_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.38399e-04_r8,0.79654e-04_r8,0.87882e-04_r8,0.86145e-04_r8,0.79917e-04_r8, & + & 0.70214e-04_r8,0.56698e-04_r8,0.37302e-04_r8,0.17365e-05_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.37899e-04_r8,0.81012e-04_r8,0.88706e-04_r8,0.86589e-04_r8,0.80259e-04_r8, & + & 0.70429e-04_r8,0.56810e-04_r8,0.37287e-04_r8,0.18595e-05_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.31959e-04_r8,0.60671e-04_r8,0.67963e-04_r8,0.67053e-04_r8,0.63057e-04_r8, & + & 0.56287e-04_r8,0.46187e-04_r8,0.30298e-04_r8,0.12071e-05_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.32062e-04_r8,0.62753e-04_r8,0.69892e-04_r8,0.68941e-04_r8,0.64624e-04_r8, & + & 0.57187e-04_r8,0.46566e-04_r8,0.30687e-04_r8,0.13582e-05_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.32098e-04_r8,0.64435e-04_r8,0.71423e-04_r8,0.70359e-04_r8,0.65646e-04_r8, & + & 0.57882e-04_r8,0.46897e-04_r8,0.30993e-04_r8,0.15217e-05_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.31956e-04_r8,0.65758e-04_r8,0.72650e-04_r8,0.71275e-04_r8,0.66275e-04_r8, & + & 0.58298e-04_r8,0.47100e-04_r8,0.31079e-04_r8,0.16794e-05_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.31584e-04_r8,0.66916e-04_r8,0.73502e-04_r8,0.71819e-04_r8,0.66611e-04_r8, & + & 0.58505e-04_r8,0.47243e-04_r8,0.31088e-04_r8,0.18250e-05_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.26355e-04_r8,0.49472e-04_r8,0.55415e-04_r8,0.54584e-04_r8,0.51361e-04_r8, & + & 0.46135e-04_r8,0.38027e-04_r8,0.24983e-04_r8,0.13549e-05_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.26472e-04_r8,0.51302e-04_r8,0.57165e-04_r8,0.56417e-04_r8,0.52936e-04_r8, & + & 0.47048e-04_r8,0.38417e-04_r8,0.25347e-04_r8,0.14941e-05_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.26545e-04_r8,0.52866e-04_r8,0.58563e-04_r8,0.57776e-04_r8,0.53988e-04_r8, & + & 0.47706e-04_r8,0.38739e-04_r8,0.25638e-04_r8,0.16563e-05_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.26469e-04_r8,0.54105e-04_r8,0.59749e-04_r8,0.58746e-04_r8,0.54668e-04_r8, & + & 0.48161e-04_r8,0.38970e-04_r8,0.25744e-04_r8,0.18262e-05_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.26248e-04_r8,0.55079e-04_r8,0.60619e-04_r8,0.59317e-04_r8,0.55099e-04_r8, & + & 0.48435e-04_r8,0.39115e-04_r8,0.25778e-04_r8,0.20238e-05_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.21631e-04_r8,0.40297e-04_r8,0.45170e-04_r8,0.44298e-04_r8,0.41876e-04_r8, & + & 0.37690e-04_r8,0.31212e-04_r8,0.20552e-04_r8,0.16328e-05_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.21814e-04_r8,0.41896e-04_r8,0.46681e-04_r8,0.46065e-04_r8,0.43227e-04_r8, & + & 0.38608e-04_r8,0.31614e-04_r8,0.20857e-04_r8,0.18610e-05_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.21864e-04_r8,0.43247e-04_r8,0.47945e-04_r8,0.47327e-04_r8,0.44273e-04_r8, & + & 0.39201e-04_r8,0.31894e-04_r8,0.21119e-04_r8,0.20775e-05_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.21835e-04_r8,0.44386e-04_r8,0.48986e-04_r8,0.48228e-04_r8,0.44916e-04_r8, & + & 0.39637e-04_r8,0.32093e-04_r8,0.21228e-04_r8,0.22541e-05_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.21728e-04_r8,0.45263e-04_r8,0.49804e-04_r8,0.48818e-04_r8,0.45409e-04_r8, & + & 0.39950e-04_r8,0.32269e-04_r8,0.21290e-04_r8,0.24525e-05_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.17823e-04_r8,0.33378e-04_r8,0.37337e-04_r8,0.36619e-04_r8,0.34598e-04_r8, & + & 0.31113e-04_r8,0.25761e-04_r8,0.16956e-04_r8,0.15042e-05_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.17970e-04_r8,0.34679e-04_r8,0.38589e-04_r8,0.38065e-04_r8,0.35695e-04_r8, & + & 0.31869e-04_r8,0.26044e-04_r8,0.17214e-04_r8,0.16847e-05_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.17997e-04_r8,0.35791e-04_r8,0.39619e-04_r8,0.39097e-04_r8,0.36539e-04_r8, & + & 0.32374e-04_r8,0.26298e-04_r8,0.17428e-04_r8,0.18887e-05_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.17967e-04_r8,0.36717e-04_r8,0.40463e-04_r8,0.39821e-04_r8,0.37071e-04_r8, & + & 0.32716e-04_r8,0.26461e-04_r8,0.17496e-04_r8,0.20546e-05_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.17868e-04_r8,0.37423e-04_r8,0.41124e-04_r8,0.40304e-04_r8,0.37473e-04_r8, & + & 0.32971e-04_r8,0.26612e-04_r8,0.17532e-04_r8,0.22240e-05_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.14665e-04_r8,0.27605e-04_r8,0.30811e-04_r8,0.30250e-04_r8,0.28525e-04_r8, & + & 0.25644e-04_r8,0.21186e-04_r8,0.13955e-04_r8,0.12588e-05_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.14775e-04_r8,0.28655e-04_r8,0.31851e-04_r8,0.31408e-04_r8,0.29418e-04_r8, & + & 0.26261e-04_r8,0.21430e-04_r8,0.14172e-04_r8,0.14181e-05_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.14799e-04_r8,0.29571e-04_r8,0.32687e-04_r8,0.32242e-04_r8,0.30093e-04_r8, & + & 0.26683e-04_r8,0.21636e-04_r8,0.14338e-04_r8,0.15619e-05_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.14777e-04_r8,0.30325e-04_r8,0.33371e-04_r8,0.32826e-04_r8,0.30553e-04_r8, & + & 0.26945e-04_r8,0.21775e-04_r8,0.14380e-04_r8,0.16917e-05_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.14685e-04_r8,0.30904e-04_r8,0.33907e-04_r8,0.33214e-04_r8,0.30875e-04_r8, & + & 0.27158e-04_r8,0.21883e-04_r8,0.14414e-04_r8,0.18423e-05_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.12044e-04_r8,0.22772e-04_r8,0.25375e-04_r8,0.24926e-04_r8,0.23458e-04_r8, & + & 0.21059e-04_r8,0.17387e-04_r8,0.11457e-04_r8,0.99122e-06_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.12128e-04_r8,0.23637e-04_r8,0.26249e-04_r8,0.25842e-04_r8,0.24187e-04_r8, & + & 0.21582e-04_r8,0.17590e-04_r8,0.11636e-04_r8,0.11037e-05_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.12152e-04_r8,0.24386e-04_r8,0.26910e-04_r8,0.26531e-04_r8,0.24731e-04_r8, & + & 0.21923e-04_r8,0.17760e-04_r8,0.11755e-04_r8,0.12026e-05_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.12130e-04_r8,0.24996e-04_r8,0.27464e-04_r8,0.27006e-04_r8,0.25113e-04_r8, & + & 0.22138e-04_r8,0.17874e-04_r8,0.11797e-04_r8,0.13028e-05_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.12050e-04_r8,0.25474e-04_r8,0.27895e-04_r8,0.27297e-04_r8,0.25373e-04_r8, & + & 0.22302e-04_r8,0.17948e-04_r8,0.11817e-04_r8,0.14010e-05_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.36823e-03_r8,0.49613e-03_r8,0.51817e-03_r8,0.50538e-03_r8,0.45711e-03_r8, & + & 0.39605e-03_r8,0.31486e-03_r8,0.21474e-03_r8,0.10932e-04_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.37008e-03_r8,0.50778e-03_r8,0.53361e-03_r8,0.51778e-03_r8,0.46995e-03_r8, & + & 0.40629e-03_r8,0.32309e-03_r8,0.21878e-03_r8,0.11421e-04_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.36989e-03_r8,0.51812e-03_r8,0.54699e-03_r8,0.52922e-03_r8,0.48036e-03_r8, & + & 0.41559e-03_r8,0.32965e-03_r8,0.22226e-03_r8,0.12395e-04_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.36721e-03_r8,0.52763e-03_r8,0.55746e-03_r8,0.53957e-03_r8,0.48891e-03_r8, & + & 0.42313e-03_r8,0.33545e-03_r8,0.22588e-03_r8,0.13515e-04_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.36313e-03_r8,0.53652e-03_r8,0.56680e-03_r8,0.54791e-03_r8,0.49664e-03_r8, & + & 0.42907e-03_r8,0.34043e-03_r8,0.22916e-03_r8,0.14734e-04_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.32411e-03_r8,0.42815e-03_r8,0.44725e-03_r8,0.43813e-03_r8,0.40150e-03_r8, & + & 0.34871e-03_r8,0.27912e-03_r8,0.18929e-03_r8,0.80741e-05_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.32567e-03_r8,0.43786e-03_r8,0.46069e-03_r8,0.45027e-03_r8,0.41319e-03_r8, & + & 0.35819e-03_r8,0.28635e-03_r8,0.19325e-03_r8,0.87340e-05_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.32429e-03_r8,0.44638e-03_r8,0.47228e-03_r8,0.46074e-03_r8,0.42272e-03_r8, & + & 0.36602e-03_r8,0.29201e-03_r8,0.19653e-03_r8,0.96110e-05_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.32137e-03_r8,0.45531e-03_r8,0.48142e-03_r8,0.46951e-03_r8,0.42996e-03_r8, & + & 0.37250e-03_r8,0.29709e-03_r8,0.19974e-03_r8,0.10697e-04_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.31776e-03_r8,0.46207e-03_r8,0.48880e-03_r8,0.47659e-03_r8,0.43551e-03_r8, & + & 0.37776e-03_r8,0.30138e-03_r8,0.20274e-03_r8,0.11704e-04_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.28488e-03_r8,0.36767e-03_r8,0.38081e-03_r8,0.37438e-03_r8,0.34525e-03_r8, & + & 0.30150e-03_r8,0.24332e-03_r8,0.16415e-03_r8,0.63970e-05_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.28539e-03_r8,0.37509e-03_r8,0.39196e-03_r8,0.38510e-03_r8,0.35566e-03_r8, & + & 0.30998e-03_r8,0.24963e-03_r8,0.16766e-03_r8,0.72006e-05_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.28397e-03_r8,0.38215e-03_r8,0.40156e-03_r8,0.39428e-03_r8,0.36418e-03_r8, & + & 0.31727e-03_r8,0.25446e-03_r8,0.17107e-03_r8,0.79574e-05_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.28134e-03_r8,0.38867e-03_r8,0.40959e-03_r8,0.40230e-03_r8,0.37093e-03_r8, & + & 0.32301e-03_r8,0.25898e-03_r8,0.17447e-03_r8,0.87131e-05_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.27886e-03_r8,0.39360e-03_r8,0.41642e-03_r8,0.40852e-03_r8,0.37609e-03_r8, & + & 0.32740e-03_r8,0.26312e-03_r8,0.17737e-03_r8,0.94704e-05_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.24923e-03_r8,0.31555e-03_r8,0.32423e-03_r8,0.31731e-03_r8,0.29410e-03_r8, & + & 0.25671e-03_r8,0.20762e-03_r8,0.14074e-03_r8,0.55877e-05_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.24977e-03_r8,0.32120e-03_r8,0.33372e-03_r8,0.32657e-03_r8,0.30295e-03_r8, & + & 0.26472e-03_r8,0.21303e-03_r8,0.14396e-03_r8,0.61575e-05_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.24865e-03_r8,0.32668e-03_r8,0.34180e-03_r8,0.33446e-03_r8,0.31033e-03_r8, & + & 0.27144e-03_r8,0.21777e-03_r8,0.14714e-03_r8,0.67916e-05_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.24709e-03_r8,0.33133e-03_r8,0.34841e-03_r8,0.34134e-03_r8,0.31600e-03_r8, & + & 0.27647e-03_r8,0.22179e-03_r8,0.15016e-03_r8,0.74653e-05_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.24455e-03_r8,0.33491e-03_r8,0.35388e-03_r8,0.34708e-03_r8,0.32069e-03_r8, & + & 0.28005e-03_r8,0.22522e-03_r8,0.15242e-03_r8,0.81619e-05_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.21526e-03_r8,0.27115e-03_r8,0.27505e-03_r8,0.26802e-03_r8,0.24968e-03_r8, & + & 0.21690e-03_r8,0.17481e-03_r8,0.11906e-03_r8,0.50850e-05_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.21611e-03_r8,0.27621e-03_r8,0.28298e-03_r8,0.27620e-03_r8,0.25722e-03_r8, & + & 0.22411e-03_r8,0.18004e-03_r8,0.12197e-03_r8,0.55738e-05_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.21583e-03_r8,0.28060e-03_r8,0.28955e-03_r8,0.28282e-03_r8,0.26346e-03_r8, & + & 0.23005e-03_r8,0.18415e-03_r8,0.12451e-03_r8,0.60864e-05_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.21446e-03_r8,0.28363e-03_r8,0.29469e-03_r8,0.28896e-03_r8,0.26860e-03_r8, & + & 0.23435e-03_r8,0.18768e-03_r8,0.12690e-03_r8,0.66417e-05_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.21217e-03_r8,0.28626e-03_r8,0.29929e-03_r8,0.29370e-03_r8,0.27250e-03_r8, & + & 0.23763e-03_r8,0.19073e-03_r8,0.12909e-03_r8,0.72122e-05_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.18262e-03_r8,0.23112e-03_r8,0.23388e-03_r8,0.22681e-03_r8,0.21062e-03_r8, & + & 0.18196e-03_r8,0.14634e-03_r8,0.99707e-04_r8,0.48078e-05_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.18393e-03_r8,0.23591e-03_r8,0.24094e-03_r8,0.23364e-03_r8,0.21663e-03_r8, & + & 0.18814e-03_r8,0.15114e-03_r8,0.10205e-03_r8,0.52252e-05_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.18379e-03_r8,0.23984e-03_r8,0.24676e-03_r8,0.23956e-03_r8,0.22221e-03_r8, & + & 0.19356e-03_r8,0.15489e-03_r8,0.10434e-03_r8,0.56405e-05_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.18270e-03_r8,0.24258e-03_r8,0.25102e-03_r8,0.24458e-03_r8,0.22685e-03_r8, & + & 0.19771e-03_r8,0.15805e-03_r8,0.10655e-03_r8,0.60728e-05_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.18067e-03_r8,0.24446e-03_r8,0.25467e-03_r8,0.24894e-03_r8,0.23051e-03_r8, & + & 0.20056e-03_r8,0.16088e-03_r8,0.10844e-03_r8,0.65160e-05_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.15269e-03_r8,0.19407e-03_r8,0.19640e-03_r8,0.19073e-03_r8,0.17715e-03_r8, & + & 0.15224e-03_r8,0.12181e-03_r8,0.83302e-04_r8,0.45185e-05_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.15450e-03_r8,0.19834e-03_r8,0.20246e-03_r8,0.19675e-03_r8,0.18242e-03_r8, & + & 0.15776e-03_r8,0.12610e-03_r8,0.85306e-04_r8,0.49315e-05_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.15459e-03_r8,0.20178e-03_r8,0.20759e-03_r8,0.20176e-03_r8,0.18737e-03_r8, & + & 0.16233e-03_r8,0.12951e-03_r8,0.87417e-04_r8,0.53491e-05_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.15368e-03_r8,0.20410e-03_r8,0.21160e-03_r8,0.20623e-03_r8,0.19161e-03_r8, & + & 0.16603e-03_r8,0.13246e-03_r8,0.89237e-04_r8,0.57562e-05_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.15207e-03_r8,0.20567e-03_r8,0.21458e-03_r8,0.20991e-03_r8,0.19525e-03_r8, & + & 0.16906e-03_r8,0.13481e-03_r8,0.90932e-04_r8,0.61659e-05_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.12672e-03_r8,0.16159e-03_r8,0.16329e-03_r8,0.15821e-03_r8,0.14746e-03_r8, & + & 0.12624e-03_r8,0.10116e-03_r8,0.69306e-04_r8,0.46652e-05_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.12853e-03_r8,0.16539e-03_r8,0.16859e-03_r8,0.16359e-03_r8,0.15208e-03_r8, & + & 0.13120e-03_r8,0.10513e-03_r8,0.71005e-04_r8,0.51392e-05_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.12901e-03_r8,0.16841e-03_r8,0.17301e-03_r8,0.16813e-03_r8,0.15614e-03_r8, & + & 0.13532e-03_r8,0.10829e-03_r8,0.72863e-04_r8,0.55244e-05_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.12833e-03_r8,0.17058e-03_r8,0.17652e-03_r8,0.17184e-03_r8,0.15971e-03_r8, & + & 0.13867e-03_r8,0.11087e-03_r8,0.74475e-04_r8,0.58193e-05_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.12715e-03_r8,0.17197e-03_r8,0.17918e-03_r8,0.17513e-03_r8,0.16292e-03_r8, & + & 0.14144e-03_r8,0.11301e-03_r8,0.75965e-04_r8,0.61705e-05_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.10428e-03_r8,0.13348e-03_r8,0.13462e-03_r8,0.12995e-03_r8,0.12158e-03_r8, & + & 0.10379e-03_r8,0.83005e-04_r8,0.57371e-04_r8,0.55965e-05_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.10619e-03_r8,0.13710e-03_r8,0.13932e-03_r8,0.13469e-03_r8,0.12538e-03_r8, & + & 0.10800e-03_r8,0.86632e-04_r8,0.58954e-04_r8,0.61961e-05_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.10690e-03_r8,0.13978e-03_r8,0.14315e-03_r8,0.13877e-03_r8,0.12885e-03_r8, & + & 0.11169e-03_r8,0.89643e-04_r8,0.60568e-04_r8,0.68526e-05_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.10668e-03_r8,0.14178e-03_r8,0.14626e-03_r8,0.14213e-03_r8,0.13207e-03_r8, & + & 0.11468e-03_r8,0.91984e-04_r8,0.62070e-04_r8,0.75122e-05_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.10582e-03_r8,0.14316e-03_r8,0.14873e-03_r8,0.14501e-03_r8,0.13471e-03_r8, & + & 0.11704e-03_r8,0.93876e-04_r8,0.63388e-04_r8,0.80761e-05_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.85476e-04_r8,0.10982e-03_r8,0.11034e-03_r8,0.10643e-03_r8,0.99702e-04_r8, & + & 0.84967e-04_r8,0.68008e-04_r8,0.47229e-04_r8,0.66145e-05_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.87242e-04_r8,0.11322e-03_r8,0.11463e-03_r8,0.11045e-03_r8,0.10293e-03_r8, & + & 0.88580e-04_r8,0.71113e-04_r8,0.48631e-04_r8,0.75452e-05_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.88111e-04_r8,0.11563e-03_r8,0.11792e-03_r8,0.11404e-03_r8,0.10587e-03_r8, & + & 0.91877e-04_r8,0.73790e-04_r8,0.50044e-04_r8,0.84881e-05_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.88200e-04_r8,0.11743e-03_r8,0.12065e-03_r8,0.11708e-03_r8,0.10870e-03_r8, & + & 0.94480e-04_r8,0.75897e-04_r8,0.51384e-04_r8,0.95136e-05_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.87583e-04_r8,0.11871e-03_r8,0.12292e-03_r8,0.11954e-03_r8,0.11103e-03_r8, & + & 0.96523e-04_r8,0.77526e-04_r8,0.52518e-04_r8,0.10532e-04_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.70556e-04_r8,0.91428e-04_r8,0.91867e-04_r8,0.88463e-04_r8,0.82846e-04_r8, & + & 0.70774e-04_r8,0.56632e-04_r8,0.39167e-04_r8,0.61872e-05_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.71933e-04_r8,0.94182e-04_r8,0.95269e-04_r8,0.91646e-04_r8,0.85383e-04_r8, & + & 0.73738e-04_r8,0.59219e-04_r8,0.40474e-04_r8,0.69965e-05_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.72567e-04_r8,0.96098e-04_r8,0.97927e-04_r8,0.94606e-04_r8,0.87837e-04_r8, & + & 0.76370e-04_r8,0.61326e-04_r8,0.41633e-04_r8,0.78235e-05_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.72529e-04_r8,0.97532e-04_r8,0.10011e-03_r8,0.97076e-04_r8,0.90134e-04_r8, & + & 0.78428e-04_r8,0.63016e-04_r8,0.42754e-04_r8,0.87904e-05_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.71990e-04_r8,0.98552e-04_r8,0.10193e-03_r8,0.99080e-04_r8,0.92091e-04_r8, & + & 0.80068e-04_r8,0.64349e-04_r8,0.43674e-04_r8,0.98011e-05_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.58072e-04_r8,0.75815e-04_r8,0.76168e-04_r8,0.73252e-04_r8,0.68521e-04_r8, & + & 0.58748e-04_r8,0.47029e-04_r8,0.32430e-04_r8,0.51838e-05_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.59149e-04_r8,0.78005e-04_r8,0.78889e-04_r8,0.75853e-04_r8,0.70691e-04_r8, & + & 0.61160e-04_r8,0.49105e-04_r8,0.33572e-04_r8,0.58669e-05_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.59615e-04_r8,0.79572e-04_r8,0.81043e-04_r8,0.78301e-04_r8,0.72716e-04_r8, & + & 0.63265e-04_r8,0.50777e-04_r8,0.34506e-04_r8,0.66464e-05_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.59506e-04_r8,0.80712e-04_r8,0.82811e-04_r8,0.80321e-04_r8,0.74571e-04_r8, & + & 0.64935e-04_r8,0.52165e-04_r8,0.35447e-04_r8,0.74412e-05_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.59067e-04_r8,0.81520e-04_r8,0.84288e-04_r8,0.81977e-04_r8,0.76172e-04_r8, & + & 0.66259e-04_r8,0.53281e-04_r8,0.36178e-04_r8,0.82465e-05_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.47640e-04_r8,0.62583e-04_r8,0.62887e-04_r8,0.60485e-04_r8,0.56559e-04_r8, & + & 0.48624e-04_r8,0.38904e-04_r8,0.26773e-04_r8,0.40582e-05_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.48498e-04_r8,0.64379e-04_r8,0.65087e-04_r8,0.62641e-04_r8,0.58377e-04_r8, & + & 0.50572e-04_r8,0.40566e-04_r8,0.27717e-04_r8,0.46616e-05_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.48844e-04_r8,0.65656e-04_r8,0.66851e-04_r8,0.64628e-04_r8,0.60042e-04_r8, & + & 0.52254e-04_r8,0.41917e-04_r8,0.28510e-04_r8,0.53204e-05_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.48722e-04_r8,0.66574e-04_r8,0.68303e-04_r8,0.66300e-04_r8,0.61547e-04_r8, & + & 0.53614e-04_r8,0.43058e-04_r8,0.29254e-04_r8,0.59442e-05_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.48355e-04_r8,0.67217e-04_r8,0.69511e-04_r8,0.67651e-04_r8,0.62864e-04_r8, & + & 0.54712e-04_r8,0.43998e-04_r8,0.29875e-04_r8,0.66436e-05_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.85387e-03_r8,0.97268e-03_r8,0.95201e-03_r8,0.89226e-03_r8,0.81465e-03_r8, & + & 0.69707e-03_r8,0.54829e-03_r8,0.35882e-03_r8,0.37920e-04_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.85496e-03_r8,0.98746e-03_r8,0.97188e-03_r8,0.91775e-03_r8,0.83529e-03_r8, & + & 0.71649e-03_r8,0.56376e-03_r8,0.37061e-03_r8,0.43155e-04_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.85154e-03_r8,0.99908e-03_r8,0.98969e-03_r8,0.94014e-03_r8,0.85604e-03_r8, & + & 0.73379e-03_r8,0.57832e-03_r8,0.38183e-03_r8,0.48702e-04_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.84606e-03_r8,0.10090e-02_r8,0.10068e-02_r8,0.95944e-03_r8,0.87434e-03_r8, & + & 0.74975e-03_r8,0.59243e-03_r8,0.39188e-03_r8,0.54022e-04_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.84061e-03_r8,0.10171e-02_r8,0.10218e-02_r8,0.97684e-03_r8,0.88906e-03_r8, & + & 0.76345e-03_r8,0.60471e-03_r8,0.40180e-03_r8,0.59778e-04_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.76106e-03_r8,0.86763e-03_r8,0.84620e-03_r8,0.79337e-03_r8,0.72368e-03_r8, & + & 0.62633e-03_r8,0.49168e-03_r8,0.32346e-03_r8,0.31322e-04_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.76153e-03_r8,0.88148e-03_r8,0.86349e-03_r8,0.81559e-03_r8,0.74480e-03_r8, & + & 0.64448e-03_r8,0.50635e-03_r8,0.33430e-03_r8,0.35566e-04_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.75977e-03_r8,0.89195e-03_r8,0.87871e-03_r8,0.83605e-03_r8,0.76286e-03_r8, & + & 0.66127e-03_r8,0.51959e-03_r8,0.34472e-03_r8,0.39705e-04_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.75771e-03_r8,0.89987e-03_r8,0.89406e-03_r8,0.85530e-03_r8,0.78123e-03_r8, & + & 0.67612e-03_r8,0.53221e-03_r8,0.35447e-03_r8,0.44266e-04_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.75289e-03_r8,0.90657e-03_r8,0.90771e-03_r8,0.87200e-03_r8,0.79715e-03_r8, & + & 0.68926e-03_r8,0.54382e-03_r8,0.36372e-03_r8,0.48708e-04_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.66893e-03_r8,0.76246e-03_r8,0.74334e-03_r8,0.69752e-03_r8,0.63501e-03_r8, & + & 0.55362e-03_r8,0.43455e-03_r8,0.28843e-03_r8,0.24260e-04_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.67118e-03_r8,0.77588e-03_r8,0.75944e-03_r8,0.71710e-03_r8,0.65461e-03_r8, & + & 0.57122e-03_r8,0.44991e-03_r8,0.29906e-03_r8,0.27434e-04_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.67218e-03_r8,0.78505e-03_r8,0.77328e-03_r8,0.73497e-03_r8,0.67286e-03_r8, & + & 0.58718e-03_r8,0.46375e-03_r8,0.30933e-03_r8,0.30808e-04_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.67058e-03_r8,0.79242e-03_r8,0.78627e-03_r8,0.75181e-03_r8,0.68946e-03_r8, & + & 0.60183e-03_r8,0.47532e-03_r8,0.31743e-03_r8,0.34324e-04_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.66467e-03_r8,0.79822e-03_r8,0.79776e-03_r8,0.76779e-03_r8,0.70481e-03_r8, & + & 0.61510e-03_r8,0.48553e-03_r8,0.32526e-03_r8,0.37905e-04_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.58297e-03_r8,0.66020e-03_r8,0.64337e-03_r8,0.60610e-03_r8,0.55222e-03_r8, & + & 0.48338e-03_r8,0.38154e-03_r8,0.25537e-03_r8,0.20054e-04_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.58616e-03_r8,0.67311e-03_r8,0.65764e-03_r8,0.62362e-03_r8,0.56996e-03_r8, & + & 0.49939e-03_r8,0.39657e-03_r8,0.26418e-03_r8,0.22457e-04_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.58719e-03_r8,0.68291e-03_r8,0.67014e-03_r8,0.63926e-03_r8,0.58703e-03_r8, & + & 0.51453e-03_r8,0.40976e-03_r8,0.27280e-03_r8,0.24974e-04_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.58451e-03_r8,0.68925e-03_r8,0.68144e-03_r8,0.65410e-03_r8,0.60312e-03_r8, & + & 0.52903e-03_r8,0.42147e-03_r8,0.28096e-03_r8,0.27613e-04_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.57885e-03_r8,0.69369e-03_r8,0.69153e-03_r8,0.66725e-03_r8,0.61666e-03_r8, & + & 0.54114e-03_r8,0.43123e-03_r8,0.28907e-03_r8,0.30243e-04_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.50639e-03_r8,0.56897e-03_r8,0.55412e-03_r8,0.52127e-03_r8,0.47341e-03_r8, & + & 0.41669e-03_r8,0.33293e-03_r8,0.22215e-03_r8,0.17057e-04_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.51065e-03_r8,0.58111e-03_r8,0.56740e-03_r8,0.53642e-03_r8,0.48970e-03_r8, & + & 0.43166e-03_r8,0.34671e-03_r8,0.23111e-03_r8,0.19191e-04_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.51131e-03_r8,0.58923e-03_r8,0.57802e-03_r8,0.54989e-03_r8,0.50519e-03_r8, & + & 0.44520e-03_r8,0.35867e-03_r8,0.23955e-03_r8,0.21238e-04_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.50888e-03_r8,0.59432e-03_r8,0.58700e-03_r8,0.56238e-03_r8,0.51899e-03_r8, & + & 0.45787e-03_r8,0.36960e-03_r8,0.24733e-03_r8,0.23442e-04_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.50411e-03_r8,0.59804e-03_r8,0.59497e-03_r8,0.57342e-03_r8,0.53158e-03_r8, & + & 0.46924e-03_r8,0.37886e-03_r8,0.25450e-03_r8,0.25756e-04_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.43673e-03_r8,0.48782e-03_r8,0.47499e-03_r8,0.44629e-03_r8,0.40354e-03_r8, & + & 0.35457e-03_r8,0.28605e-03_r8,0.19086e-03_r8,0.14702e-04_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.44102e-03_r8,0.49831e-03_r8,0.48639e-03_r8,0.45943e-03_r8,0.41879e-03_r8, & + & 0.36808e-03_r8,0.29802e-03_r8,0.19985e-03_r8,0.16471e-04_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.44221e-03_r8,0.50518e-03_r8,0.49538e-03_r8,0.47075e-03_r8,0.43183e-03_r8, & + & 0.37995e-03_r8,0.30882e-03_r8,0.20763e-03_r8,0.18420e-04_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.44017e-03_r8,0.50994e-03_r8,0.50323e-03_r8,0.48141e-03_r8,0.44360e-03_r8, & + & 0.39116e-03_r8,0.31844e-03_r8,0.21460e-03_r8,0.20473e-04_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.43656e-03_r8,0.51249e-03_r8,0.51000e-03_r8,0.49068e-03_r8,0.45425e-03_r8, & + & 0.40107e-03_r8,0.32653e-03_r8,0.22109e-03_r8,0.22600e-04_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.37627e-03_r8,0.41525e-03_r8,0.40365e-03_r8,0.37923e-03_r8,0.34257e-03_r8, & + & 0.30147e-03_r8,0.24324e-03_r8,0.16094e-03_r8,0.13400e-04_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.38051e-03_r8,0.42489e-03_r8,0.41400e-03_r8,0.39067e-03_r8,0.35555e-03_r8, & + & 0.31257e-03_r8,0.25353e-03_r8,0.16947e-03_r8,0.14905e-04_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.38196e-03_r8,0.43154e-03_r8,0.42169e-03_r8,0.40035e-03_r8,0.36703e-03_r8, & + & 0.32311e-03_r8,0.26291e-03_r8,0.17672e-03_r8,0.16566e-04_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.38108e-03_r8,0.43587e-03_r8,0.42809e-03_r8,0.40890e-03_r8,0.37694e-03_r8, & + & 0.33246e-03_r8,0.27094e-03_r8,0.18305e-03_r8,0.18352e-04_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.37854e-03_r8,0.43889e-03_r8,0.43402e-03_r8,0.41697e-03_r8,0.38532e-03_r8, & + & 0.34074e-03_r8,0.27816e-03_r8,0.18873e-03_r8,0.20220e-04_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.31968e-03_r8,0.35301e-03_r8,0.34310e-03_r8,0.32206e-03_r8,0.28904e-03_r8, & + & 0.25356e-03_r8,0.20523e-03_r8,0.13432e-03_r8,0.13548e-04_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.32386e-03_r8,0.36229e-03_r8,0.35288e-03_r8,0.33214e-03_r8,0.30033e-03_r8, & + & 0.26345e-03_r8,0.21374e-03_r8,0.14198e-03_r8,0.14966e-04_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.32521e-03_r8,0.36848e-03_r8,0.35986e-03_r8,0.34056e-03_r8,0.31042e-03_r8, & + & 0.27222e-03_r8,0.22115e-03_r8,0.14841e-03_r8,0.16278e-04_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.32527e-03_r8,0.37258e-03_r8,0.36553e-03_r8,0.34811e-03_r8,0.31916e-03_r8, & + & 0.28034e-03_r8,0.22837e-03_r8,0.15443e-03_r8,0.17614e-04_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.32272e-03_r8,0.37533e-03_r8,0.37025e-03_r8,0.35438e-03_r8,0.32632e-03_r8, & + & 0.28740e-03_r8,0.23484e-03_r8,0.15952e-03_r8,0.19075e-04_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.26794e-03_r8,0.29655e-03_r8,0.28851e-03_r8,0.27155e-03_r8,0.24290e-03_r8, & + & 0.21182e-03_r8,0.17187e-03_r8,0.11158e-03_r8,0.16893e-04_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.27215e-03_r8,0.30477e-03_r8,0.29765e-03_r8,0.28075e-03_r8,0.25336e-03_r8, & + & 0.22120e-03_r8,0.17858e-03_r8,0.11794e-03_r8,0.18576e-04_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.27400e-03_r8,0.31061e-03_r8,0.30447e-03_r8,0.28836e-03_r8,0.26224e-03_r8, & + & 0.22886e-03_r8,0.18474e-03_r8,0.12372e-03_r8,0.20056e-04_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.27385e-03_r8,0.31424e-03_r8,0.30923e-03_r8,0.29477e-03_r8,0.26977e-03_r8, & + & 0.23554e-03_r8,0.19093e-03_r8,0.12884e-03_r8,0.21321e-04_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.27196e-03_r8,0.31647e-03_r8,0.31308e-03_r8,0.30006e-03_r8,0.27604e-03_r8, & + & 0.24191e-03_r8,0.19649e-03_r8,0.13352e-03_r8,0.22611e-04_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.22255e-03_r8,0.24716e-03_r8,0.24087e-03_r8,0.22672e-03_r8,0.20216e-03_r8, & + & 0.17582e-03_r8,0.14339e-03_r8,0.92528e-04_r8,0.22471e-04_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.22663e-03_r8,0.25429e-03_r8,0.24908e-03_r8,0.23506e-03_r8,0.21167e-03_r8, & + & 0.18377e-03_r8,0.14910e-03_r8,0.97972e-04_r8,0.24536e-04_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.22867e-03_r8,0.25963e-03_r8,0.25532e-03_r8,0.24169e-03_r8,0.21923e-03_r8, & + & 0.19067e-03_r8,0.15458e-03_r8,0.10293e-03_r8,0.26453e-04_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.22853e-03_r8,0.26273e-03_r8,0.25960e-03_r8,0.24704e-03_r8,0.22549e-03_r8, & + & 0.19679e-03_r8,0.15968e-03_r8,0.10728e-03_r8,0.28383e-04_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.22704e-03_r8,0.26469e-03_r8,0.26259e-03_r8,0.25141e-03_r8,0.23080e-03_r8, & + & 0.20216e-03_r8,0.16433e-03_r8,0.11116e-03_r8,0.30111e-04_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.18570e-03_r8,0.20791e-03_r8,0.20310e-03_r8,0.19106e-03_r8,0.17066e-03_r8, & + & 0.14797e-03_r8,0.12097e-03_r8,0.78704e-04_r8,0.20720e-04_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.18868e-03_r8,0.21356e-03_r8,0.20969e-03_r8,0.19807e-03_r8,0.17821e-03_r8, & + & 0.15434e-03_r8,0.12584e-03_r8,0.83179e-04_r8,0.23268e-04_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.18972e-03_r8,0.21732e-03_r8,0.21447e-03_r8,0.20305e-03_r8,0.18416e-03_r8, & + & 0.15993e-03_r8,0.13006e-03_r8,0.87134e-04_r8,0.25781e-04_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.18929e-03_r8,0.21955e-03_r8,0.21771e-03_r8,0.20711e-03_r8,0.18907e-03_r8, & + & 0.16493e-03_r8,0.13420e-03_r8,0.90699e-04_r8,0.28181e-04_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.18766e-03_r8,0.22095e-03_r8,0.21987e-03_r8,0.21045e-03_r8,0.19312e-03_r8, & + & 0.16934e-03_r8,0.13812e-03_r8,0.93840e-04_r8,0.30489e-04_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.15409e-03_r8,0.17399e-03_r8,0.17010e-03_r8,0.16002e-03_r8,0.14311e-03_r8, & + & 0.12376e-03_r8,0.10121e-03_r8,0.66428e-04_r8,0.17813e-04_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.15599e-03_r8,0.17831e-03_r8,0.17521e-03_r8,0.16554e-03_r8,0.14890e-03_r8, & + & 0.12881e-03_r8,0.10527e-03_r8,0.69964e-04_r8,0.19918e-04_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.15661e-03_r8,0.18119e-03_r8,0.17892e-03_r8,0.16934e-03_r8,0.15365e-03_r8, & + & 0.13338e-03_r8,0.10864e-03_r8,0.73142e-04_r8,0.22121e-04_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.15608e-03_r8,0.18293e-03_r8,0.18145e-03_r8,0.17254e-03_r8,0.15743e-03_r8, & + & 0.13747e-03_r8,0.11209e-03_r8,0.75971e-04_r8,0.24425e-04_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.15453e-03_r8,0.18383e-03_r8,0.18309e-03_r8,0.17510e-03_r8,0.16067e-03_r8, & + & 0.14102e-03_r8,0.11529e-03_r8,0.78607e-04_r8,0.26791e-04_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.12705e-03_r8,0.14485e-03_r8,0.14155e-03_r8,0.13312e-03_r8,0.11914e-03_r8, & + & 0.10299e-03_r8,0.84416e-04_r8,0.55598e-04_r8,0.14429e-04_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.12843e-03_r8,0.14822e-03_r8,0.14555e-03_r8,0.13748e-03_r8,0.12377e-03_r8, & + & 0.10702e-03_r8,0.87520e-04_r8,0.58405e-04_r8,0.16147e-04_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.12875e-03_r8,0.15043e-03_r8,0.14850e-03_r8,0.14053e-03_r8,0.12752e-03_r8, & + & 0.11081e-03_r8,0.90348e-04_r8,0.60934e-04_r8,0.17992e-04_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.12822e-03_r8,0.15175e-03_r8,0.15049e-03_r8,0.14301e-03_r8,0.13059e-03_r8, & + & 0.11413e-03_r8,0.93171e-04_r8,0.63296e-04_r8,0.19888e-04_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.12684e-03_r8,0.15239e-03_r8,0.15179e-03_r8,0.14511e-03_r8,0.13320e-03_r8, & + & 0.11702e-03_r8,0.95786e-04_r8,0.65468e-04_r8,0.21706e-04_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.16451e-02_r8,0.17375e-02_r8,0.16665e-02_r8,0.15396e-02_r8,0.13696e-02_r8, & + & 0.11731e-02_r8,0.92753e-03_r8,0.61159e-03_r8,0.14680e-03_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.16450e-02_r8,0.17591e-02_r8,0.16954e-02_r8,0.15711e-02_r8,0.14087e-02_r8, & + & 0.12092e-02_r8,0.95859e-03_r8,0.63308e-03_r8,0.16131e-03_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.16396e-02_r8,0.17762e-02_r8,0.17200e-02_r8,0.16012e-02_r8,0.14448e-02_r8, & + & 0.12424e-02_r8,0.98862e-03_r8,0.65400e-03_r8,0.17365e-03_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.16299e-02_r8,0.17875e-02_r8,0.17415e-02_r8,0.16313e-02_r8,0.14788e-02_r8, & + & 0.12751e-02_r8,0.10161e-02_r8,0.67524e-03_r8,0.18499e-03_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.16127e-02_r8,0.17946e-02_r8,0.17629e-02_r8,0.16594e-02_r8,0.15119e-02_r8, & + & 0.13059e-02_r8,0.10419e-02_r8,0.69511e-03_r8,0.19999e-03_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.15084e-02_r8,0.15931e-02_r8,0.15186e-02_r8,0.13958e-02_r8,0.12369e-02_r8, & + & 0.10500e-02_r8,0.83688e-03_r8,0.55465e-03_r8,0.11914e-03_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.15115e-02_r8,0.16146e-02_r8,0.15457e-02_r8,0.14241e-02_r8,0.12724e-02_r8, & + & 0.10844e-02_r8,0.86669e-03_r8,0.57603e-03_r8,0.13037e-03_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.15084e-02_r8,0.16309e-02_r8,0.15669e-02_r8,0.14522e-02_r8,0.13074e-02_r8, & + & 0.11181e-02_r8,0.89787e-03_r8,0.59657e-03_r8,0.13918e-03_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.14965e-02_r8,0.16419e-02_r8,0.15861e-02_r8,0.14781e-02_r8,0.13385e-02_r8, & + & 0.11507e-02_r8,0.92569e-03_r8,0.61596e-03_r8,0.15053e-03_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.14804e-02_r8,0.16493e-02_r8,0.16042e-02_r8,0.15021e-02_r8,0.13704e-02_r8, & + & 0.11804e-02_r8,0.95044e-03_r8,0.63472e-03_r8,0.16410e-03_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.13707e-02_r8,0.14436e-02_r8,0.13706e-02_r8,0.12561e-02_r8,0.11093e-02_r8, & + & 0.93534e-03_r8,0.74505e-03_r8,0.49303e-03_r8,0.93388e-04_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.13760e-02_r8,0.14666e-02_r8,0.13986e-02_r8,0.12850e-02_r8,0.11416e-02_r8, & + & 0.96700e-03_r8,0.77192e-03_r8,0.51430e-03_r8,0.10062e-03_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.13732e-02_r8,0.14839e-02_r8,0.14208e-02_r8,0.13112e-02_r8,0.11718e-02_r8, & + & 0.99814e-03_r8,0.79899e-03_r8,0.53404e-03_r8,0.10964e-03_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.13644e-02_r8,0.14939e-02_r8,0.14404e-02_r8,0.13346e-02_r8,0.12002e-02_r8, & + & 0.10295e-02_r8,0.82532e-03_r8,0.55285e-03_r8,0.12023e-03_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.13512e-02_r8,0.15024e-02_r8,0.14568e-02_r8,0.13559e-02_r8,0.12266e-02_r8, & + & 0.10592e-02_r8,0.85085e-03_r8,0.57058e-03_r8,0.13064e-03_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.12336e-02_r8,0.12968e-02_r8,0.12255e-02_r8,0.11189e-02_r8,0.98785e-03_r8, & + & 0.83184e-03_r8,0.66033e-03_r8,0.43467e-03_r8,0.70047e-04_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.12419e-02_r8,0.13192e-02_r8,0.12543e-02_r8,0.11482e-02_r8,0.10189e-02_r8, & + & 0.86315e-03_r8,0.68559e-03_r8,0.45559e-03_r8,0.76629e-04_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.12416e-02_r8,0.13349e-02_r8,0.12771e-02_r8,0.11745e-02_r8,0.10469e-02_r8, & + & 0.89182e-03_r8,0.71110e-03_r8,0.47551e-03_r8,0.84761e-04_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.12342e-02_r8,0.13470e-02_r8,0.12958e-02_r8,0.11964e-02_r8,0.10726e-02_r8, & + & 0.91965e-03_r8,0.73487e-03_r8,0.49419e-03_r8,0.93979e-04_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.12238e-02_r8,0.13566e-02_r8,0.13110e-02_r8,0.12168e-02_r8,0.10976e-02_r8, & + & 0.94731e-03_r8,0.75866e-03_r8,0.51080e-03_r8,0.10249e-03_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.10970e-02_r8,0.11491e-02_r8,0.10850e-02_r8,0.99037e-03_r8,0.87478e-03_r8, & + & 0.73644e-03_r8,0.58168e-03_r8,0.38673e-03_r8,0.55328e-04_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.11051e-02_r8,0.11716e-02_r8,0.11129e-02_r8,0.10196e-02_r8,0.90431e-03_r8, & + & 0.76445e-03_r8,0.60553e-03_r8,0.40600e-03_r8,0.61413e-04_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.11053e-02_r8,0.11877e-02_r8,0.11365e-02_r8,0.10446e-02_r8,0.92981e-03_r8, & + & 0.79114e-03_r8,0.62919e-03_r8,0.42419e-03_r8,0.68340e-04_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.11000e-02_r8,0.12008e-02_r8,0.11557e-02_r8,0.10648e-02_r8,0.95310e-03_r8, & + & 0.81721e-03_r8,0.65273e-03_r8,0.44128e-03_r8,0.75425e-04_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.10930e-02_r8,0.12101e-02_r8,0.11704e-02_r8,0.10855e-02_r8,0.97521e-03_r8, & + & 0.84232e-03_r8,0.67516e-03_r8,0.45733e-03_r8,0.82112e-04_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.96254e-03_r8,0.10041e-02_r8,0.94496e-03_r8,0.86305e-03_r8,0.76515e-03_r8, & + & 0.64666e-03_r8,0.50949e-03_r8,0.34237e-03_r8,0.45743e-04_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.97168e-03_r8,0.10257e-02_r8,0.97306e-03_r8,0.89241e-03_r8,0.79300e-03_r8, & + & 0.67315e-03_r8,0.53212e-03_r8,0.35953e-03_r8,0.50936e-04_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.97307e-03_r8,0.10417e-02_r8,0.99540e-03_r8,0.91663e-03_r8,0.81739e-03_r8, & + & 0.69764e-03_r8,0.55388e-03_r8,0.37625e-03_r8,0.56704e-04_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.97112e-03_r8,0.10538e-02_r8,0.10130e-02_r8,0.93600e-03_r8,0.83875e-03_r8, & + & 0.72048e-03_r8,0.57540e-03_r8,0.39219e-03_r8,0.62214e-04_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.96524e-03_r8,0.10634e-02_r8,0.10272e-02_r8,0.95339e-03_r8,0.85814e-03_r8, & + & 0.74256e-03_r8,0.59649e-03_r8,0.40723e-03_r8,0.68154e-04_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.83977e-03_r8,0.87150e-03_r8,0.81798e-03_r8,0.74510e-03_r8,0.66073e-03_r8, & + & 0.55889e-03_r8,0.44038e-03_r8,0.30023e-03_r8,0.39438e-04_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.84860e-03_r8,0.89183e-03_r8,0.84311e-03_r8,0.77202e-03_r8,0.68677e-03_r8, & + & 0.58412e-03_r8,0.46261e-03_r8,0.31513e-03_r8,0.44026e-04_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.85156e-03_r8,0.90640e-03_r8,0.86357e-03_r8,0.79472e-03_r8,0.70843e-03_r8, & + & 0.60616e-03_r8,0.48333e-03_r8,0.32962e-03_r8,0.48169e-04_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.84996e-03_r8,0.91804e-03_r8,0.88000e-03_r8,0.81332e-03_r8,0.72741e-03_r8, & + & 0.62668e-03_r8,0.50295e-03_r8,0.34425e-03_r8,0.52632e-04_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.84411e-03_r8,0.92502e-03_r8,0.89195e-03_r8,0.82771e-03_r8,0.74479e-03_r8, & + & 0.64630e-03_r8,0.52177e-03_r8,0.35838e-03_r8,0.57490e-04_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.72566e-03_r8,0.75029e-03_r8,0.70410e-03_r8,0.64085e-03_r8,0.56881e-03_r8, & + & 0.48163e-03_r8,0.37585e-03_r8,0.26029e-03_r8,0.35173e-04_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.73526e-03_r8,0.76878e-03_r8,0.72724e-03_r8,0.66569e-03_r8,0.59239e-03_r8, & + & 0.50357e-03_r8,0.39670e-03_r8,0.27234e-03_r8,0.38442e-04_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.73942e-03_r8,0.78240e-03_r8,0.74617e-03_r8,0.68580e-03_r8,0.61175e-03_r8, & + & 0.52308e-03_r8,0.41633e-03_r8,0.28548e-03_r8,0.42620e-04_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.73787e-03_r8,0.79331e-03_r8,0.76108e-03_r8,0.70193e-03_r8,0.62821e-03_r8, & + & 0.54092e-03_r8,0.43381e-03_r8,0.29821e-03_r8,0.47013e-04_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.73365e-03_r8,0.79895e-03_r8,0.77125e-03_r8,0.71463e-03_r8,0.64295e-03_r8, & + & 0.55753e-03_r8,0.45033e-03_r8,0.31091e-03_r8,0.51519e-04_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.62112e-03_r8,0.63900e-03_r8,0.60071e-03_r8,0.54641e-03_r8,0.48585e-03_r8, & + & 0.41219e-03_r8,0.31988e-03_r8,0.22088e-03_r8,0.39225e-04_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.63089e-03_r8,0.65678e-03_r8,0.62144e-03_r8,0.56855e-03_r8,0.50663e-03_r8, & + & 0.43158e-03_r8,0.33912e-03_r8,0.23261e-03_r8,0.43145e-04_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.63630e-03_r8,0.67023e-03_r8,0.63841e-03_r8,0.58635e-03_r8,0.52398e-03_r8, & + & 0.44876e-03_r8,0.35619e-03_r8,0.24341e-03_r8,0.47182e-04_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.63678e-03_r8,0.68001e-03_r8,0.65143e-03_r8,0.60045e-03_r8,0.53807e-03_r8, & + & 0.46446e-03_r8,0.37160e-03_r8,0.25517e-03_r8,0.51310e-04_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.63384e-03_r8,0.68558e-03_r8,0.66049e-03_r8,0.61133e-03_r8,0.55067e-03_r8, & + & 0.47828e-03_r8,0.38622e-03_r8,0.26607e-03_r8,0.55652e-04_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.52818e-03_r8,0.54302e-03_r8,0.51109e-03_r8,0.46524e-03_r8,0.41303e-03_r8, & + & 0.35089e-03_r8,0.27050e-03_r8,0.18719e-03_r8,0.51897e-04_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.53874e-03_r8,0.56000e-03_r8,0.52974e-03_r8,0.48429e-03_r8,0.43151e-03_r8, & + & 0.36826e-03_r8,0.28749e-03_r8,0.19624e-03_r8,0.57480e-04_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.54407e-03_r8,0.57298e-03_r8,0.54499e-03_r8,0.50007e-03_r8,0.44685e-03_r8, & + & 0.38282e-03_r8,0.30218e-03_r8,0.20623e-03_r8,0.63250e-04_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.54510e-03_r8,0.58221e-03_r8,0.55605e-03_r8,0.51259e-03_r8,0.45923e-03_r8, & + & 0.39550e-03_r8,0.31547e-03_r8,0.21632e-03_r8,0.68339e-04_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.54335e-03_r8,0.58744e-03_r8,0.56412e-03_r8,0.52185e-03_r8,0.47008e-03_r8, & + & 0.40728e-03_r8,0.32798e-03_r8,0.22618e-03_r8,0.72964e-04_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.44901e-03_r8,0.46427e-03_r8,0.43915e-03_r8,0.40187e-03_r8,0.35719e-03_r8, & + & 0.30380e-03_r8,0.23427e-03_r8,0.15956e-03_r8,0.52228e-04_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.45685e-03_r8,0.47845e-03_r8,0.45475e-03_r8,0.41772e-03_r8,0.37275e-03_r8, & + & 0.31798e-03_r8,0.24772e-03_r8,0.16817e-03_r8,0.56979e-04_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.46005e-03_r8,0.48879e-03_r8,0.46665e-03_r8,0.43038e-03_r8,0.38526e-03_r8, & + & 0.32982e-03_r8,0.25983e-03_r8,0.17707e-03_r8,0.61788e-04_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.46029e-03_r8,0.49540e-03_r8,0.47547e-03_r8,0.44015e-03_r8,0.39539e-03_r8, & + & 0.34025e-03_r8,0.27087e-03_r8,0.18596e-03_r8,0.66537e-04_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.45760e-03_r8,0.49879e-03_r8,0.48175e-03_r8,0.44812e-03_r8,0.40429e-03_r8, & + & 0.34971e-03_r8,0.28105e-03_r8,0.19422e-03_r8,0.70982e-04_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.37789e-03_r8,0.39359e-03_r8,0.37439e-03_r8,0.34335e-03_r8,0.30516e-03_r8, & + & 0.25987e-03_r8,0.20136e-03_r8,0.13616e-03_r8,0.47471e-04_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.38345e-03_r8,0.40460e-03_r8,0.38678e-03_r8,0.35616e-03_r8,0.31793e-03_r8, & + & 0.27155e-03_r8,0.21219e-03_r8,0.14366e-03_r8,0.51576e-04_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.38556e-03_r8,0.41241e-03_r8,0.39583e-03_r8,0.36622e-03_r8,0.32808e-03_r8, & + & 0.28132e-03_r8,0.22259e-03_r8,0.15133e-03_r8,0.55529e-04_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.38464e-03_r8,0.41687e-03_r8,0.40247e-03_r8,0.37394e-03_r8,0.33650e-03_r8, & + & 0.28994e-03_r8,0.23157e-03_r8,0.15870e-03_r8,0.59557e-04_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.38119e-03_r8,0.41880e-03_r8,0.40725e-03_r8,0.38009e-03_r8,0.34354e-03_r8, & + & 0.29781e-03_r8,0.23974e-03_r8,0.16572e-03_r8,0.63195e-04_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.31518e-03_r8,0.33080e-03_r8,0.31644e-03_r8,0.29051e-03_r8,0.25824e-03_r8, & + & 0.21997e-03_r8,0.17074e-03_r8,0.11585e-03_r8,0.39419e-04_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.31945e-03_r8,0.33947e-03_r8,0.32620e-03_r8,0.30064e-03_r8,0.26839e-03_r8, & + & 0.22968e-03_r8,0.17999e-03_r8,0.12241e-03_r8,0.42717e-04_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.32042e-03_r8,0.34518e-03_r8,0.33311e-03_r8,0.30844e-03_r8,0.27653e-03_r8, & + & 0.23733e-03_r8,0.18840e-03_r8,0.12892e-03_r8,0.45799e-04_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.31877e-03_r8,0.34829e-03_r8,0.33813e-03_r8,0.31466e-03_r8,0.28316e-03_r8, & + & 0.24429e-03_r8,0.19577e-03_r8,0.13500e-03_r8,0.49095e-04_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.31533e-03_r8,0.34943e-03_r8,0.34164e-03_r8,0.31953e-03_r8,0.28883e-03_r8, & + & 0.25064e-03_r8,0.20247e-03_r8,0.14079e-03_r8,0.52225e-04_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.30073e-02_r8,0.30215e-02_r8,0.28549e-02_r8,0.26145e-02_r8,0.23223e-02_r8, & + & 0.19698e-02_r8,0.15631e-02_r8,0.10671e-02_r8,0.34349e-03_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.30045e-02_r8,0.30464e-02_r8,0.29000e-02_r8,0.26682e-02_r8,0.23795e-02_r8, & + & 0.20320e-02_r8,0.16241e-02_r8,0.11180e-02_r8,0.37241e-03_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.29924e-02_r8,0.30694e-02_r8,0.29376e-02_r8,0.27170e-02_r8,0.24327e-02_r8, & + & 0.20955e-02_r8,0.16828e-02_r8,0.11692e-02_r8,0.41183e-03_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.29732e-02_r8,0.30875e-02_r8,0.29723e-02_r8,0.27617e-02_r8,0.24862e-02_r8, & + & 0.21555e-02_r8,0.17426e-02_r8,0.12186e-02_r8,0.45672e-03_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.29511e-02_r8,0.31004e-02_r8,0.30014e-02_r8,0.28043e-02_r8,0.25375e-02_r8, & + & 0.22174e-02_r8,0.18018e-02_r8,0.12656e-02_r8,0.49848e-03_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.28011e-02_r8,0.28061e-02_r8,0.26513e-02_r8,0.24171e-02_r8,0.21391e-02_r8, & + & 0.18145e-02_r8,0.14290e-02_r8,0.97808e-03_r8,0.28283e-03_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.28038e-02_r8,0.28333e-02_r8,0.26971e-02_r8,0.24708e-02_r8,0.21906e-02_r8, & + & 0.18715e-02_r8,0.14859e-02_r8,0.10236e-02_r8,0.31088e-03_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.27978e-02_r8,0.28587e-02_r8,0.27386e-02_r8,0.25159e-02_r8,0.22406e-02_r8, & + & 0.19256e-02_r8,0.15398e-02_r8,0.10695e-02_r8,0.34605e-03_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.27864e-02_r8,0.28782e-02_r8,0.27737e-02_r8,0.25561e-02_r8,0.22888e-02_r8, & + & 0.19778e-02_r8,0.15963e-02_r8,0.11144e-02_r8,0.38043e-03_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.27682e-02_r8,0.28941e-02_r8,0.28027e-02_r8,0.25952e-02_r8,0.23337e-02_r8, & + & 0.20308e-02_r8,0.16518e-02_r8,0.11583e-02_r8,0.41249e-03_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.26013e-02_r8,0.25925e-02_r8,0.24368e-02_r8,0.22059e-02_r8,0.19447e-02_r8, & + & 0.16443e-02_r8,0.12895e-02_r8,0.88356e-03_r8,0.22980e-03_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.26118e-02_r8,0.26228e-02_r8,0.24826e-02_r8,0.22596e-02_r8,0.19971e-02_r8, & + & 0.16971e-02_r8,0.13425e-02_r8,0.92292e-03_r8,0.25666e-03_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.26121e-02_r8,0.26511e-02_r8,0.25221e-02_r8,0.23045e-02_r8,0.20442e-02_r8, & + & 0.17465e-02_r8,0.13937e-02_r8,0.96423e-03_r8,0.28307e-03_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.26050e-02_r8,0.26757e-02_r8,0.25536e-02_r8,0.23446e-02_r8,0.20883e-02_r8, & + & 0.17925e-02_r8,0.14453e-02_r8,0.10074e-02_r8,0.30818e-03_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.25933e-02_r8,0.26944e-02_r8,0.25823e-02_r8,0.23794e-02_r8,0.21318e-02_r8, & + & 0.18378e-02_r8,0.14965e-02_r8,0.10492e-02_r8,0.33812e-03_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.24078e-02_r8,0.23894e-02_r8,0.22370e-02_r8,0.20125e-02_r8,0.17599e-02_r8, & + & 0.14763e-02_r8,0.11554e-02_r8,0.78494e-03_r8,0.18813e-03_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.24225e-02_r8,0.24253e-02_r8,0.22813e-02_r8,0.20638e-02_r8,0.18093e-02_r8, & + & 0.15251e-02_r8,0.12031e-02_r8,0.82373e-03_r8,0.21030e-03_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.24294e-02_r8,0.24564e-02_r8,0.23198e-02_r8,0.21085e-02_r8,0.18532e-02_r8, & + & 0.15708e-02_r8,0.12482e-02_r8,0.86229e-03_r8,0.23129e-03_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.24309e-02_r8,0.24808e-02_r8,0.23546e-02_r8,0.21467e-02_r8,0.18923e-02_r8, & + & 0.16129e-02_r8,0.12944e-02_r8,0.90119e-03_r8,0.25224e-03_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.24223e-02_r8,0.24983e-02_r8,0.23839e-02_r8,0.21783e-02_r8,0.19305e-02_r8, & + & 0.16540e-02_r8,0.13401e-02_r8,0.94049e-03_r8,0.27779e-03_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.22071e-02_r8,0.21851e-02_r8,0.20436e-02_r8,0.18357e-02_r8,0.15952e-02_r8, & + & 0.13304e-02_r8,0.10307e-02_r8,0.69163e-03_r8,0.14983e-03_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.22284e-02_r8,0.22243e-02_r8,0.20887e-02_r8,0.18839e-02_r8,0.16450e-02_r8, & + & 0.13762e-02_r8,0.10736e-02_r8,0.72602e-03_r8,0.16732e-03_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.22426e-02_r8,0.22593e-02_r8,0.21270e-02_r8,0.19281e-02_r8,0.16889e-02_r8, & + & 0.14169e-02_r8,0.11148e-02_r8,0.76201e-03_r8,0.18420e-03_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.22476e-02_r8,0.22863e-02_r8,0.21609e-02_r8,0.19676e-02_r8,0.17258e-02_r8, & + & 0.14525e-02_r8,0.11537e-02_r8,0.79815e-03_r8,0.20325e-03_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.22399e-02_r8,0.23048e-02_r8,0.21912e-02_r8,0.19974e-02_r8,0.17586e-02_r8, & + & 0.14880e-02_r8,0.11934e-02_r8,0.83564e-03_r8,0.22470e-03_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.20075e-02_r8,0.19795e-02_r8,0.18447e-02_r8,0.16541e-02_r8,0.14341e-02_r8, & + & 0.11951e-02_r8,0.92238e-03_r8,0.60660e-03_r8,0.12381e-03_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.20344e-02_r8,0.20227e-02_r8,0.18912e-02_r8,0.17028e-02_r8,0.14828e-02_r8, & + & 0.12404e-02_r8,0.96234e-03_r8,0.63833e-03_r8,0.13822e-03_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.20513e-02_r8,0.20598e-02_r8,0.19311e-02_r8,0.17466e-02_r8,0.15267e-02_r8, & + & 0.12805e-02_r8,0.99815e-03_r8,0.66987e-03_r8,0.15138e-03_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.20576e-02_r8,0.20878e-02_r8,0.19661e-02_r8,0.17857e-02_r8,0.15647e-02_r8, & + & 0.13147e-02_r8,0.10319e-02_r8,0.70266e-03_r8,0.16753e-03_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.20521e-02_r8,0.21067e-02_r8,0.19938e-02_r8,0.18157e-02_r8,0.15969e-02_r8, & + & 0.13475e-02_r8,0.10644e-02_r8,0.73524e-03_r8,0.18430e-03_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.17951e-02_r8,0.17708e-02_r8,0.16476e-02_r8,0.14764e-02_r8,0.12769e-02_r8, & + & 0.10613e-02_r8,0.82141e-03_r8,0.53387e-03_r8,0.10356e-03_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.18257e-02_r8,0.18161e-02_r8,0.16970e-02_r8,0.15264e-02_r8,0.13250e-02_r8, & + & 0.11052e-02_r8,0.85771e-03_r8,0.56341e-03_r8,0.11419e-03_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.18457e-02_r8,0.18541e-02_r8,0.17382e-02_r8,0.15700e-02_r8,0.13685e-02_r8, & + & 0.11444e-02_r8,0.89062e-03_r8,0.59265e-03_r8,0.12737e-03_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.18534e-02_r8,0.18833e-02_r8,0.17713e-02_r8,0.16066e-02_r8,0.14063e-02_r8, & + & 0.11787e-02_r8,0.92220e-03_r8,0.62067e-03_r8,0.14148e-03_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.18508e-02_r8,0.19025e-02_r8,0.17986e-02_r8,0.16377e-02_r8,0.14382e-02_r8, & + & 0.12095e-02_r8,0.95313e-03_r8,0.64883e-03_r8,0.15624e-03_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.15853e-02_r8,0.15606e-02_r8,0.14491e-02_r8,0.13005e-02_r8,0.11253e-02_r8, & + & 0.93388e-03_r8,0.72631e-03_r8,0.46832e-03_r8,0.90402e-04_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.16191e-02_r8,0.16074e-02_r8,0.14980e-02_r8,0.13497e-02_r8,0.11730e-02_r8, & + & 0.97691e-03_r8,0.76027e-03_r8,0.49835e-03_r8,0.10124e-03_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.16393e-02_r8,0.16464e-02_r8,0.15392e-02_r8,0.13927e-02_r8,0.12147e-02_r8, & + & 0.10153e-02_r8,0.79129e-03_r8,0.52537e-03_r8,0.11276e-03_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.16487e-02_r8,0.16729e-02_r8,0.15721e-02_r8,0.14286e-02_r8,0.12504e-02_r8, & + & 0.10480e-02_r8,0.82072e-03_r8,0.55187e-03_r8,0.12515e-03_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.16472e-02_r8,0.16924e-02_r8,0.15977e-02_r8,0.14588e-02_r8,0.12817e-02_r8, & + & 0.10777e-02_r8,0.84873e-03_r8,0.57800e-03_r8,0.13784e-03_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.13936e-02_r8,0.13674e-02_r8,0.12635e-02_r8,0.11331e-02_r8,0.97871e-03_r8, & + & 0.81331e-03_r8,0.63480e-03_r8,0.40910e-03_r8,0.92222e-04_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.14271e-02_r8,0.14126e-02_r8,0.13114e-02_r8,0.11804e-02_r8,0.10248e-02_r8, & + & 0.85405e-03_r8,0.66828e-03_r8,0.43677e-03_r8,0.10207e-03_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.14461e-02_r8,0.14478e-02_r8,0.13500e-02_r8,0.12219e-02_r8,0.10647e-02_r8, & + & 0.89058e-03_r8,0.69816e-03_r8,0.46305e-03_r8,0.11262e-03_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.14547e-02_r8,0.14726e-02_r8,0.13807e-02_r8,0.12557e-02_r8,0.10996e-02_r8, & + & 0.92247e-03_r8,0.72520e-03_r8,0.48654e-03_r8,0.12376e-03_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.14563e-02_r8,0.14902e-02_r8,0.14046e-02_r8,0.12841e-02_r8,0.11288e-02_r8, & + & 0.95105e-03_r8,0.75065e-03_r8,0.51065e-03_r8,0.13556e-03_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.12161e-02_r8,0.11928e-02_r8,0.11004e-02_r8,0.98725e-03_r8,0.85318e-03_r8, & + & 0.70775e-03_r8,0.55081e-03_r8,0.35481e-03_r8,0.12422e-03_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.12463e-02_r8,0.12352e-02_r8,0.11444e-02_r8,0.10316e-02_r8,0.89480e-03_r8, & + & 0.74560e-03_r8,0.58282e-03_r8,0.38195e-03_r8,0.13273e-03_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.12646e-02_r8,0.12662e-02_r8,0.11796e-02_r8,0.10687e-02_r8,0.93096e-03_r8, & + & 0.77883e-03_r8,0.61138e-03_r8,0.40526e-03_r8,0.14193e-03_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.12733e-02_r8,0.12880e-02_r8,0.12074e-02_r8,0.10979e-02_r8,0.96169e-03_r8, & + & 0.80809e-03_r8,0.63689e-03_r8,0.42724e-03_r8,0.15291e-03_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.12740e-02_r8,0.13044e-02_r8,0.12293e-02_r8,0.11231e-02_r8,0.98752e-03_r8, & + & 0.83380e-03_r8,0.66030e-03_r8,0.44847e-03_r8,0.16460e-03_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.10656e-02_r8,0.10497e-02_r8,0.96881e-03_r8,0.87108e-03_r8,0.75627e-03_r8, & + & 0.62893e-03_r8,0.48955e-03_r8,0.31741e-03_r8,0.13016e-03_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.10879e-02_r8,0.10821e-02_r8,0.10046e-02_r8,0.90804e-03_r8,0.79130e-03_r8, & + & 0.66235e-03_r8,0.51807e-03_r8,0.34003e-03_r8,0.13779e-03_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.11001e-02_r8,0.11057e-02_r8,0.10327e-02_r8,0.93770e-03_r8,0.82120e-03_r8, & + & 0.69087e-03_r8,0.54346e-03_r8,0.36047e-03_r8,0.14411e-03_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.11047e-02_r8,0.11226e-02_r8,0.10548e-02_r8,0.96212e-03_r8,0.84667e-03_r8, & + & 0.71575e-03_r8,0.56548e-03_r8,0.37954e-03_r8,0.15311e-03_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.11028e-02_r8,0.11345e-02_r8,0.10715e-02_r8,0.98143e-03_r8,0.86845e-03_r8, & + & 0.73791e-03_r8,0.58600e-03_r8,0.39874e-03_r8,0.16257e-03_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.92541e-03_r8,0.91485e-03_r8,0.84575e-03_r8,0.76287e-03_r8,0.66530e-03_r8, & + & 0.55435e-03_r8,0.43055e-03_r8,0.28106e-03_r8,0.11779e-03_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.94153e-03_r8,0.94015e-03_r8,0.87425e-03_r8,0.79221e-03_r8,0.69422e-03_r8, & + & 0.58249e-03_r8,0.45555e-03_r8,0.30043e-03_r8,0.12541e-03_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.95043e-03_r8,0.95859e-03_r8,0.89645e-03_r8,0.81618e-03_r8,0.71892e-03_r8, & + & 0.60660e-03_r8,0.47691e-03_r8,0.31810e-03_r8,0.13086e-03_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.95300e-03_r8,0.97180e-03_r8,0.91414e-03_r8,0.83540e-03_r8,0.73965e-03_r8, & + & 0.62755e-03_r8,0.49627e-03_r8,0.33494e-03_r8,0.13792e-03_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.94924e-03_r8,0.98033e-03_r8,0.92629e-03_r8,0.85073e-03_r8,0.75722e-03_r8, & + & 0.64562e-03_r8,0.51410e-03_r8,0.35114e-03_r8,0.14650e-03_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.79344e-03_r8,0.78971e-03_r8,0.73267e-03_r8,0.66405e-03_r8,0.58083e-03_r8, & + & 0.48392e-03_r8,0.37549e-03_r8,0.24569e-03_r8,0.97034e-04_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.80574e-03_r8,0.81004e-03_r8,0.75547e-03_r8,0.68809e-03_r8,0.60484e-03_r8, & + & 0.50707e-03_r8,0.39618e-03_r8,0.26227e-03_r8,0.10267e-03_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.81227e-03_r8,0.82486e-03_r8,0.77408e-03_r8,0.70758e-03_r8,0.62511e-03_r8, & + & 0.52731e-03_r8,0.41439e-03_r8,0.27759e-03_r8,0.10742e-03_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.81298e-03_r8,0.83538e-03_r8,0.78743e-03_r8,0.72262e-03_r8,0.64193e-03_r8, & + & 0.54449e-03_r8,0.43080e-03_r8,0.29211e-03_r8,0.11325e-03_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.80893e-03_r8,0.84184e-03_r8,0.79706e-03_r8,0.73516e-03_r8,0.65638e-03_r8, & + & 0.55984e-03_r8,0.44607e-03_r8,0.30621e-03_r8,0.12059e-03_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.54732e-02_r8,0.53034e-02_r8,0.49969e-02_r8,0.45431e-02_r8,0.40134e-02_r8, & + & 0.34010e-02_r8,0.26972e-02_r8,0.18637e-02_r8,0.96692e-03_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.54607e-02_r8,0.53367e-02_r8,0.50546e-02_r8,0.46321e-02_r8,0.41099e-02_r8, & + & 0.34970e-02_r8,0.27999e-02_r8,0.19729e-02_r8,0.11063e-02_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.54405e-02_r8,0.53637e-02_r8,0.51145e-02_r8,0.47117e-02_r8,0.41981e-02_r8, & + & 0.35927e-02_r8,0.29070e-02_r8,0.20850e-02_r8,0.12360e-02_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.54052e-02_r8,0.53858e-02_r8,0.51679e-02_r8,0.47829e-02_r8,0.42844e-02_r8, & + & 0.36942e-02_r8,0.30161e-02_r8,0.22030e-02_r8,0.13785e-02_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.53549e-02_r8,0.54029e-02_r8,0.52131e-02_r8,0.48529e-02_r8,0.43733e-02_r8, & + & 0.37946e-02_r8,0.31262e-02_r8,0.23268e-02_r8,0.15336e-02_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.52482e-02_r8,0.50940e-02_r8,0.47786e-02_r8,0.43454e-02_r8,0.38186e-02_r8, & + & 0.32129e-02_r8,0.25325e-02_r8,0.17227e-02_r8,0.80430e-03_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.52403e-02_r8,0.51313e-02_r8,0.48370e-02_r8,0.44315e-02_r8,0.39109e-02_r8, & + & 0.33052e-02_r8,0.26254e-02_r8,0.18226e-02_r8,0.90614e-03_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.52188e-02_r8,0.51614e-02_r8,0.48948e-02_r8,0.45073e-02_r8,0.39963e-02_r8, & + & 0.33961e-02_r8,0.27198e-02_r8,0.19222e-02_r8,0.10146e-02_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.51826e-02_r8,0.51837e-02_r8,0.49460e-02_r8,0.45770e-02_r8,0.40791e-02_r8, & + & 0.34891e-02_r8,0.28146e-02_r8,0.20278e-02_r8,0.11325e-02_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.51359e-02_r8,0.51960e-02_r8,0.49902e-02_r8,0.46430e-02_r8,0.41602e-02_r8, & + & 0.35811e-02_r8,0.29127e-02_r8,0.21431e-02_r8,0.12633e-02_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.49876e-02_r8,0.48388e-02_r8,0.45133e-02_r8,0.40992e-02_r8,0.35901e-02_r8, & + & 0.30030e-02_r8,0.23527e-02_r8,0.15765e-02_r8,0.64714e-03_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.49850e-02_r8,0.48808e-02_r8,0.45736e-02_r8,0.41821e-02_r8,0.36790e-02_r8, & + & 0.30941e-02_r8,0.24388e-02_r8,0.16655e-02_r8,0.72927e-03_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.49660e-02_r8,0.49117e-02_r8,0.46346e-02_r8,0.42593e-02_r8,0.37631e-02_r8, & + & 0.31820e-02_r8,0.25243e-02_r8,0.17543e-02_r8,0.81771e-03_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.49361e-02_r8,0.49307e-02_r8,0.46909e-02_r8,0.43285e-02_r8,0.38459e-02_r8, & + & 0.32679e-02_r8,0.26083e-02_r8,0.18450e-02_r8,0.91578e-03_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.48943e-02_r8,0.49413e-02_r8,0.47366e-02_r8,0.43959e-02_r8,0.39239e-02_r8, & + & 0.33496e-02_r8,0.26941e-02_r8,0.19416e-02_r8,0.10197e-02_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.46848e-02_r8,0.45423e-02_r8,0.42109e-02_r8,0.38147e-02_r8,0.33318e-02_r8, & + & 0.27806e-02_r8,0.21628e-02_r8,0.14435e-02_r8,0.52019e-03_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.46885e-02_r8,0.45846e-02_r8,0.42767e-02_r8,0.38967e-02_r8,0.34228e-02_r8, & + & 0.28698e-02_r8,0.22469e-02_r8,0.15180e-02_r8,0.58537e-03_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.46784e-02_r8,0.46158e-02_r8,0.43389e-02_r8,0.39718e-02_r8,0.35088e-02_r8, & + & 0.29561e-02_r8,0.23285e-02_r8,0.15932e-02_r8,0.65783e-03_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.46546e-02_r8,0.46379e-02_r8,0.43907e-02_r8,0.40421e-02_r8,0.35928e-02_r8, & + & 0.30394e-02_r8,0.24053e-02_r8,0.16703e-02_r8,0.73788e-03_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.46218e-02_r8,0.46560e-02_r8,0.44359e-02_r8,0.41109e-02_r8,0.36691e-02_r8, & + & 0.31156e-02_r8,0.24821e-02_r8,0.17515e-02_r8,0.82261e-03_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.43680e-02_r8,0.42271e-02_r8,0.38928e-02_r8,0.35080e-02_r8,0.30576e-02_r8, & + & 0.25405e-02_r8,0.19725e-02_r8,0.13117e-02_r8,0.42455e-03_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.43836e-02_r8,0.42742e-02_r8,0.39603e-02_r8,0.35901e-02_r8,0.31440e-02_r8, & + & 0.26294e-02_r8,0.20540e-02_r8,0.13812e-02_r8,0.47676e-03_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.43831e-02_r8,0.43074e-02_r8,0.40201e-02_r8,0.36636e-02_r8,0.32261e-02_r8, & + & 0.27164e-02_r8,0.21330e-02_r8,0.14464e-02_r8,0.53568e-03_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.43690e-02_r8,0.43343e-02_r8,0.40742e-02_r8,0.37289e-02_r8,0.33089e-02_r8, & + & 0.28017e-02_r8,0.22054e-02_r8,0.15130e-02_r8,0.59880e-03_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.43473e-02_r8,0.43575e-02_r8,0.41195e-02_r8,0.37951e-02_r8,0.33885e-02_r8, & + & 0.28774e-02_r8,0.22767e-02_r8,0.15816e-02_r8,0.66710e-03_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.40714e-02_r8,0.39122e-02_r8,0.35777e-02_r8,0.32091e-02_r8,0.27872e-02_r8, & + & 0.22994e-02_r8,0.17735e-02_r8,0.11790e-02_r8,0.33561e-03_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.40973e-02_r8,0.39625e-02_r8,0.36472e-02_r8,0.32877e-02_r8,0.28694e-02_r8, & + & 0.23826e-02_r8,0.18515e-02_r8,0.12426e-02_r8,0.37756e-03_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.41108e-02_r8,0.40033e-02_r8,0.37116e-02_r8,0.33595e-02_r8,0.29464e-02_r8, & + & 0.24646e-02_r8,0.19290e-02_r8,0.13037e-02_r8,0.42584e-03_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.41078e-02_r8,0.40382e-02_r8,0.37677e-02_r8,0.34232e-02_r8,0.30216e-02_r8, & + & 0.25463e-02_r8,0.20016e-02_r8,0.13624e-02_r8,0.47733e-03_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.40964e-02_r8,0.40666e-02_r8,0.38151e-02_r8,0.34890e-02_r8,0.30973e-02_r8, & + & 0.26200e-02_r8,0.20705e-02_r8,0.14239e-02_r8,0.53330e-03_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.37806e-02_r8,0.36256e-02_r8,0.32982e-02_r8,0.29389e-02_r8,0.25345e-02_r8, & + & 0.20760e-02_r8,0.15879e-02_r8,0.10489e-02_r8,0.28018e-03_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.38204e-02_r8,0.36872e-02_r8,0.33713e-02_r8,0.30154e-02_r8,0.26103e-02_r8, & + & 0.21557e-02_r8,0.16619e-02_r8,0.11071e-02_r8,0.31519e-03_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.38460e-02_r8,0.37374e-02_r8,0.34369e-02_r8,0.30817e-02_r8,0.26834e-02_r8, & + & 0.22319e-02_r8,0.17344e-02_r8,0.11636e-02_r8,0.35270e-03_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.38578e-02_r8,0.37771e-02_r8,0.34946e-02_r8,0.31444e-02_r8,0.27541e-02_r8, & + & 0.23067e-02_r8,0.18034e-02_r8,0.12192e-02_r8,0.39298e-03_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.38608e-02_r8,0.38134e-02_r8,0.35421e-02_r8,0.32035e-02_r8,0.28239e-02_r8, & + & 0.23777e-02_r8,0.18670e-02_r8,0.12748e-02_r8,0.43632e-03_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.34769e-02_r8,0.33291e-02_r8,0.30196e-02_r8,0.26781e-02_r8,0.23024e-02_r8, & + & 0.18824e-02_r8,0.14244e-02_r8,0.92897e-03_r8,0.24101e-03_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.35239e-02_r8,0.33972e-02_r8,0.30964e-02_r8,0.27587e-02_r8,0.23816e-02_r8, & + & 0.19578e-02_r8,0.14914e-02_r8,0.98181e-03_r8,0.27130e-03_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.35607e-02_r8,0.34526e-02_r8,0.31656e-02_r8,0.28309e-02_r8,0.24544e-02_r8, & + & 0.20284e-02_r8,0.15562e-02_r8,0.10333e-02_r8,0.30255e-03_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.35844e-02_r8,0.35023e-02_r8,0.32271e-02_r8,0.28968e-02_r8,0.25226e-02_r8, & + & 0.20957e-02_r8,0.16188e-02_r8,0.10830e-02_r8,0.33737e-03_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.35961e-02_r8,0.35446e-02_r8,0.32825e-02_r8,0.29568e-02_r8,0.25866e-02_r8, & + & 0.21594e-02_r8,0.16782e-02_r8,0.11324e-02_r8,0.37448e-03_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.31490e-02_r8,0.30162e-02_r8,0.27350e-02_r8,0.24183e-02_r8,0.20753e-02_r8, & + & 0.16954e-02_r8,0.12750e-02_r8,0.82561e-03_r8,0.24776e-03_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.32098e-02_r8,0.30913e-02_r8,0.28147e-02_r8,0.25006e-02_r8,0.21544e-02_r8, & + & 0.17699e-02_r8,0.13387e-02_r8,0.87243e-03_r8,0.27735e-03_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.32582e-02_r8,0.31563e-02_r8,0.28883e-02_r8,0.25742e-02_r8,0.22278e-02_r8, & + & 0.18394e-02_r8,0.14003e-02_r8,0.91830e-03_r8,0.30712e-03_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.32928e-02_r8,0.32146e-02_r8,0.29543e-02_r8,0.26421e-02_r8,0.22954e-02_r8, & + & 0.19038e-02_r8,0.14592e-02_r8,0.96296e-03_r8,0.33982e-03_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.33113e-02_r8,0.32637e-02_r8,0.30129e-02_r8,0.27034e-02_r8,0.23582e-02_r8, & + & 0.19652e-02_r8,0.15140e-02_r8,0.10071e-02_r8,0.37422e-03_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.28236e-02_r8,0.26993e-02_r8,0.24463e-02_r8,0.21584e-02_r8,0.18515e-02_r8, & + & 0.15144e-02_r8,0.11396e-02_r8,0.73456e-03_r8,0.30599e-03_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.28929e-02_r8,0.27796e-02_r8,0.25302e-02_r8,0.22416e-02_r8,0.19311e-02_r8, & + & 0.15864e-02_r8,0.12002e-02_r8,0.77955e-03_r8,0.32947e-03_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.29497e-02_r8,0.28523e-02_r8,0.26078e-02_r8,0.23174e-02_r8,0.20043e-02_r8, & + & 0.16542e-02_r8,0.12577e-02_r8,0.82291e-03_r8,0.35529e-03_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.29901e-02_r8,0.29165e-02_r8,0.26763e-02_r8,0.23877e-02_r8,0.20731e-02_r8, & + & 0.17177e-02_r8,0.13124e-02_r8,0.86431e-03_r8,0.38167e-03_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.30139e-02_r8,0.29672e-02_r8,0.27348e-02_r8,0.24509e-02_r8,0.21349e-02_r8, & + & 0.17760e-02_r8,0.13646e-02_r8,0.90496e-03_r8,0.40993e-03_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.25422e-02_r8,0.24347e-02_r8,0.22108e-02_r8,0.19505e-02_r8,0.16727e-02_r8, & + & 0.13714e-02_r8,0.10368e-02_r8,0.66936e-03_r8,0.31350e-03_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.26126e-02_r8,0.25184e-02_r8,0.22944e-02_r8,0.20307e-02_r8,0.17483e-02_r8, & + & 0.14377e-02_r8,0.10928e-02_r8,0.71181e-03_r8,0.33782e-03_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.26690e-02_r8,0.25901e-02_r8,0.23690e-02_r8,0.21043e-02_r8,0.18188e-02_r8, & + & 0.15016e-02_r8,0.11462e-02_r8,0.75188e-03_r8,0.35774e-03_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.27048e-02_r8,0.26504e-02_r8,0.24329e-02_r8,0.21704e-02_r8,0.18832e-02_r8, & + & 0.15599e-02_r8,0.11973e-02_r8,0.79054e-03_r8,0.37720e-03_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.27241e-02_r8,0.26964e-02_r8,0.24876e-02_r8,0.22289e-02_r8,0.19396e-02_r8, & + & 0.16131e-02_r8,0.12459e-02_r8,0.82843e-03_r8,0.39980e-03_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.22863e-02_r8,0.21916e-02_r8,0.19903e-02_r8,0.17560e-02_r8,0.15053e-02_r8, & + & 0.12361e-02_r8,0.93929e-03_r8,0.60469e-03_r8,0.28176e-03_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.23519e-02_r8,0.22705e-02_r8,0.20691e-02_r8,0.18315e-02_r8,0.15760e-02_r8, & + & 0.12985e-02_r8,0.99139e-03_r8,0.64462e-03_r8,0.30471e-03_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.23974e-02_r8,0.23352e-02_r8,0.21377e-02_r8,0.19000e-02_r8,0.16408e-02_r8, & + & 0.13574e-02_r8,0.10412e-02_r8,0.68214e-03_r8,0.32553e-03_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.24260e-02_r8,0.23879e-02_r8,0.21943e-02_r8,0.19602e-02_r8,0.16992e-02_r8, & + & 0.14109e-02_r8,0.10885e-02_r8,0.71852e-03_r8,0.34169e-03_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.24412e-02_r8,0.24274e-02_r8,0.22422e-02_r8,0.20116e-02_r8,0.17502e-02_r8, & + & 0.14591e-02_r8,0.11336e-02_r8,0.75474e-03_r8,0.36020e-03_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.20393e-02_r8,0.19603e-02_r8,0.17821e-02_r8,0.15739e-02_r8,0.13509e-02_r8, & + & 0.11133e-02_r8,0.84826e-03_r8,0.54289e-03_r8,0.23248e-03_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.20953e-02_r8,0.20307e-02_r8,0.18542e-02_r8,0.16433e-02_r8,0.14162e-02_r8, & + & 0.11712e-02_r8,0.89683e-03_r8,0.57958e-03_r8,0.25095e-03_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.21323e-02_r8,0.20881e-02_r8,0.19144e-02_r8,0.17046e-02_r8,0.14742e-02_r8, & + & 0.12241e-02_r8,0.94271e-03_r8,0.61480e-03_r8,0.26566e-03_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.21562e-02_r8,0.21324e-02_r8,0.19654e-02_r8,0.17578e-02_r8,0.15256e-02_r8, & + & 0.12715e-02_r8,0.98599e-03_r8,0.64941e-03_r8,0.28144e-03_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.21687e-02_r8,0.21674e-02_r8,0.20081e-02_r8,0.18029e-02_r8,0.15712e-02_r8, & + & 0.13148e-02_r8,0.10270e-02_r8,0.68370e-03_r8,0.29755e-03_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.10084e-01_r8,0.95278e-02_r8,0.88730e-02_r8,0.81189e-02_r8,0.71873e-02_r8, & + & 0.61505e-02_r8,0.50159e-02_r8,0.37383e-02_r8,0.30410e-02_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.10011e-01_r8,0.95195e-02_r8,0.89419e-02_r8,0.82272e-02_r8,0.73508e-02_r8, & + & 0.63699e-02_r8,0.52392e-02_r8,0.39784e-02_r8,0.34237e-02_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.99285e-02_r8,0.95060e-02_r8,0.90107e-02_r8,0.83435e-02_r8,0.75299e-02_r8, & + & 0.65814e-02_r8,0.54661e-02_r8,0.42490e-02_r8,0.38569e-02_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.98396e-02_r8,0.95039e-02_r8,0.90786e-02_r8,0.84657e-02_r8,0.77142e-02_r8, & + & 0.67908e-02_r8,0.57132e-02_r8,0.45510e-02_r8,0.43277e-02_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.97470e-02_r8,0.95073e-02_r8,0.91451e-02_r8,0.85961e-02_r8,0.78983e-02_r8, & + & 0.70134e-02_r8,0.59878e-02_r8,0.48898e-02_r8,0.48367e-02_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.10032e-01_r8,0.95001e-02_r8,0.88015e-02_r8,0.80012e-02_r8,0.70675e-02_r8, & + & 0.59994e-02_r8,0.48088e-02_r8,0.34803e-02_r8,0.24973e-02_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.99727e-02_r8,0.94952e-02_r8,0.88708e-02_r8,0.81052e-02_r8,0.72227e-02_r8, & + & 0.61975e-02_r8,0.50149e-02_r8,0.36876e-02_r8,0.28262e-02_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.99020e-02_r8,0.94876e-02_r8,0.89395e-02_r8,0.82200e-02_r8,0.73884e-02_r8, & + & 0.63917e-02_r8,0.52241e-02_r8,0.39189e-02_r8,0.31881e-02_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.98208e-02_r8,0.94907e-02_r8,0.90072e-02_r8,0.83409e-02_r8,0.75534e-02_r8, & + & 0.65848e-02_r8,0.54476e-02_r8,0.41701e-02_r8,0.35802e-02_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.97350e-02_r8,0.95036e-02_r8,0.90758e-02_r8,0.84664e-02_r8,0.77179e-02_r8, & + & 0.67885e-02_r8,0.56906e-02_r8,0.44399e-02_r8,0.40032e-02_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.99249e-02_r8,0.94002e-02_r8,0.86731e-02_r8,0.78226e-02_r8,0.68627e-02_r8, & + & 0.57870e-02_r8,0.45641e-02_r8,0.32036e-02_r8,0.20068e-02_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.98781e-02_r8,0.94039e-02_r8,0.87415e-02_r8,0.79225e-02_r8,0.70078e-02_r8, & + & 0.59682e-02_r8,0.47504e-02_r8,0.33906e-02_r8,0.22741e-02_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.98245e-02_r8,0.94056e-02_r8,0.88077e-02_r8,0.80290e-02_r8,0.71634e-02_r8, & + & 0.61455e-02_r8,0.49439e-02_r8,0.35923e-02_r8,0.25675e-02_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.97585e-02_r8,0.94181e-02_r8,0.88723e-02_r8,0.81452e-02_r8,0.73134e-02_r8, & + & 0.63196e-02_r8,0.51498e-02_r8,0.38082e-02_r8,0.28828e-02_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.96800e-02_r8,0.94346e-02_r8,0.89400e-02_r8,0.82650e-02_r8,0.74596e-02_r8, & + & 0.65093e-02_r8,0.53613e-02_r8,0.40378e-02_r8,0.32210e-02_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.97390e-02_r8,0.92223e-02_r8,0.84805e-02_r8,0.75962e-02_r8,0.66183e-02_r8, & + & 0.55421e-02_r8,0.43153e-02_r8,0.29439e-02_r8,0.16096e-02_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.97149e-02_r8,0.92440e-02_r8,0.85515e-02_r8,0.76965e-02_r8,0.67525e-02_r8, & + & 0.57037e-02_r8,0.44852e-02_r8,0.31152e-02_r8,0.18298e-02_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.96772e-02_r8,0.92607e-02_r8,0.86210e-02_r8,0.78004e-02_r8,0.68947e-02_r8, & + & 0.58626e-02_r8,0.46601e-02_r8,0.32973e-02_r8,0.20675e-02_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.96222e-02_r8,0.92823e-02_r8,0.86884e-02_r8,0.79077e-02_r8,0.70317e-02_r8, & + & 0.60213e-02_r8,0.48471e-02_r8,0.34874e-02_r8,0.23199e-02_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.95548e-02_r8,0.93032e-02_r8,0.87544e-02_r8,0.80177e-02_r8,0.71673e-02_r8, & + & 0.61924e-02_r8,0.50398e-02_r8,0.36845e-02_r8,0.25914e-02_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.94682e-02_r8,0.89654e-02_r8,0.82210e-02_r8,0.73222e-02_r8,0.63403e-02_r8, & + & 0.52735e-02_r8,0.40692e-02_r8,0.27114e-02_r8,0.12929e-02_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.94609e-02_r8,0.90053e-02_r8,0.83016e-02_r8,0.74278e-02_r8,0.64685e-02_r8, & + & 0.54213e-02_r8,0.42231e-02_r8,0.28638e-02_r8,0.14728e-02_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.94353e-02_r8,0.90391e-02_r8,0.83802e-02_r8,0.75305e-02_r8,0.66027e-02_r8, & + & 0.55646e-02_r8,0.43790e-02_r8,0.30279e-02_r8,0.16663e-02_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.93989e-02_r8,0.90684e-02_r8,0.84481e-02_r8,0.76404e-02_r8,0.67294e-02_r8, & + & 0.57082e-02_r8,0.45495e-02_r8,0.31980e-02_r8,0.18711e-02_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.93472e-02_r8,0.90926e-02_r8,0.85136e-02_r8,0.77442e-02_r8,0.68542e-02_r8, & + & 0.58646e-02_r8,0.47259e-02_r8,0.33701e-02_r8,0.20921e-02_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.90687e-02_r8,0.86083e-02_r8,0.78842e-02_r8,0.69920e-02_r8,0.60171e-02_r8, & + & 0.49784e-02_r8,0.38163e-02_r8,0.24892e-02_r8,0.10375e-02_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.90845e-02_r8,0.86742e-02_r8,0.79759e-02_r8,0.71037e-02_r8,0.61494e-02_r8, & + & 0.51176e-02_r8,0.39577e-02_r8,0.26285e-02_r8,0.11848e-02_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.90836e-02_r8,0.87225e-02_r8,0.80580e-02_r8,0.72119e-02_r8,0.62799e-02_r8, & + & 0.52546e-02_r8,0.41006e-02_r8,0.27750e-02_r8,0.13422e-02_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.90655e-02_r8,0.87611e-02_r8,0.81305e-02_r8,0.73221e-02_r8,0.64054e-02_r8, & + & 0.53892e-02_r8,0.42503e-02_r8,0.29301e-02_r8,0.15078e-02_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.90286e-02_r8,0.87944e-02_r8,0.82022e-02_r8,0.74247e-02_r8,0.65248e-02_r8, & + & 0.55305e-02_r8,0.44113e-02_r8,0.30838e-02_r8,0.16859e-02_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.85850e-02_r8,0.81350e-02_r8,0.74326e-02_r8,0.65794e-02_r8,0.56482e-02_r8, & + & 0.46582e-02_r8,0.35544e-02_r8,0.22844e-02_r8,0.80765e-03_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.86250e-02_r8,0.82179e-02_r8,0.75359e-02_r8,0.67022e-02_r8,0.57899e-02_r8, & + & 0.47962e-02_r8,0.36869e-02_r8,0.24122e-02_r8,0.92682e-03_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.86440e-02_r8,0.82839e-02_r8,0.76315e-02_r8,0.68246e-02_r8,0.59218e-02_r8, & + & 0.49298e-02_r8,0.38219e-02_r8,0.25431e-02_r8,0.10538e-02_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.86410e-02_r8,0.83371e-02_r8,0.77195e-02_r8,0.69421e-02_r8,0.60483e-02_r8, & + & 0.50620e-02_r8,0.39587e-02_r8,0.26818e-02_r8,0.11890e-02_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.86213e-02_r8,0.83816e-02_r8,0.78035e-02_r8,0.70537e-02_r8,0.61695e-02_r8, & + & 0.51947e-02_r8,0.41038e-02_r8,0.28206e-02_r8,0.13358e-02_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.80690e-02_r8,0.76260e-02_r8,0.69398e-02_r8,0.61270e-02_r8,0.52372e-02_r8, & + & 0.42965e-02_r8,0.32695e-02_r8,0.20922e-02_r8,0.69791e-03_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.81346e-02_r8,0.77325e-02_r8,0.70609e-02_r8,0.62554e-02_r8,0.53744e-02_r8, & + & 0.44362e-02_r8,0.34019e-02_r8,0.22104e-02_r8,0.78609e-03_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.81749e-02_r8,0.78188e-02_r8,0.71688e-02_r8,0.63791e-02_r8,0.55086e-02_r8, & + & 0.45702e-02_r8,0.35360e-02_r8,0.23302e-02_r8,0.88068e-03_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.81959e-02_r8,0.78839e-02_r8,0.72650e-02_r8,0.64997e-02_r8,0.56387e-02_r8, & + & 0.47059e-02_r8,0.36681e-02_r8,0.24532e-02_r8,0.97840e-03_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.81937e-02_r8,0.79411e-02_r8,0.73546e-02_r8,0.66134e-02_r8,0.57649e-02_r8, & + & 0.48383e-02_r8,0.38022e-02_r8,0.25773e-02_r8,0.10847e-02_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.75182e-02_r8,0.70907e-02_r8,0.64287e-02_r8,0.56605e-02_r8,0.48216e-02_r8, & + & 0.39323e-02_r8,0.29776e-02_r8,0.18987e-02_r8,0.67472e-03_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.76076e-02_r8,0.72195e-02_r8,0.65653e-02_r8,0.58009e-02_r8,0.49640e-02_r8, & + & 0.40692e-02_r8,0.31049e-02_r8,0.20098e-02_r8,0.74914e-03_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.76735e-02_r8,0.73227e-02_r8,0.66862e-02_r8,0.59346e-02_r8,0.51012e-02_r8, & + & 0.42015e-02_r8,0.32328e-02_r8,0.21222e-02_r8,0.83367e-03_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.77132e-02_r8,0.74045e-02_r8,0.67969e-02_r8,0.60620e-02_r8,0.52309e-02_r8, & + & 0.43347e-02_r8,0.33599e-02_r8,0.22355e-02_r8,0.91964e-03_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.77286e-02_r8,0.74752e-02_r8,0.68965e-02_r8,0.61793e-02_r8,0.53584e-02_r8, & + & 0.44621e-02_r8,0.34884e-02_r8,0.23497e-02_r8,0.10114e-02_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.70149e-02_r8,0.65825e-02_r8,0.59329e-02_r8,0.52017e-02_r8,0.44219e-02_r8, & + & 0.35899e-02_r8,0.27069e-02_r8,0.17187e-02_r8,0.74519e-03_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.71248e-02_r8,0.67269e-02_r8,0.60810e-02_r8,0.53515e-02_r8,0.45670e-02_r8, & + & 0.37282e-02_r8,0.28313e-02_r8,0.18204e-02_r8,0.83494e-03_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.72044e-02_r8,0.68394e-02_r8,0.62076e-02_r8,0.54929e-02_r8,0.47097e-02_r8, & + & 0.38613e-02_r8,0.29540e-02_r8,0.19235e-02_r8,0.93279e-03_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.72597e-02_r8,0.69309e-02_r8,0.63267e-02_r8,0.56269e-02_r8,0.48423e-02_r8, & + & 0.39913e-02_r8,0.30764e-02_r8,0.20273e-02_r8,0.10348e-02_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.72955e-02_r8,0.70104e-02_r8,0.64378e-02_r8,0.57479e-02_r8,0.49695e-02_r8, & + & 0.41180e-02_r8,0.31960e-02_r8,0.21324e-02_r8,0.11387e-02_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.65628e-02_r8,0.61735e-02_r8,0.55551e-02_r8,0.48677e-02_r8,0.41265e-02_r8, & + & 0.33334e-02_r8,0.25028e-02_r8,0.15938e-02_r8,0.74406e-03_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.66786e-02_r8,0.63151e-02_r8,0.57025e-02_r8,0.50172e-02_r8,0.42702e-02_r8, & + & 0.34674e-02_r8,0.26229e-02_r8,0.16875e-02_r8,0.82711e-03_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.67664e-02_r8,0.64350e-02_r8,0.58347e-02_r8,0.51562e-02_r8,0.44059e-02_r8, & + & 0.35945e-02_r8,0.27422e-02_r8,0.17822e-02_r8,0.92379e-03_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.68381e-02_r8,0.65357e-02_r8,0.59597e-02_r8,0.52850e-02_r8,0.45292e-02_r8, & + & 0.37195e-02_r8,0.28585e-02_r8,0.18773e-02_r8,0.10214e-02_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.68910e-02_r8,0.66274e-02_r8,0.60702e-02_r8,0.54014e-02_r8,0.46503e-02_r8, & + & 0.38396e-02_r8,0.29707e-02_r8,0.19733e-02_r8,0.11179e-02_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.60794e-02_r8,0.57316e-02_r8,0.51563e-02_r8,0.45236e-02_r8,0.38371e-02_r8, & + & 0.31013e-02_r8,0.23239e-02_r8,0.14745e-02_r8,0.70212e-03_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.62026e-02_r8,0.58782e-02_r8,0.53110e-02_r8,0.46778e-02_r8,0.39838e-02_r8, & + & 0.32334e-02_r8,0.24368e-02_r8,0.15615e-02_r8,0.77146e-03_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.63087e-02_r8,0.60102e-02_r8,0.54544e-02_r8,0.48220e-02_r8,0.41191e-02_r8, & + & 0.33562e-02_r8,0.25462e-02_r8,0.16493e-02_r8,0.85116e-03_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.63948e-02_r8,0.61265e-02_r8,0.55863e-02_r8,0.49541e-02_r8,0.42453e-02_r8, & + & 0.34753e-02_r8,0.26508e-02_r8,0.17372e-02_r8,0.93862e-03_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.64607e-02_r8,0.62309e-02_r8,0.57052e-02_r8,0.50757e-02_r8,0.43660e-02_r8, & + & 0.35907e-02_r8,0.27548e-02_r8,0.18249e-02_r8,0.10221e-02_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.55937e-02_r8,0.52793e-02_r8,0.47517e-02_r8,0.41692e-02_r8,0.35394e-02_r8, & + & 0.28625e-02_r8,0.21454e-02_r8,0.13668e-02_r8,0.61956e-03_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.57319e-02_r8,0.54374e-02_r8,0.49129e-02_r8,0.43258e-02_r8,0.36843e-02_r8, & + & 0.29907e-02_r8,0.22551e-02_r8,0.14474e-02_r8,0.68007e-03_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.58515e-02_r8,0.55788e-02_r8,0.50622e-02_r8,0.44734e-02_r8,0.38194e-02_r8, & + & 0.31146e-02_r8,0.23600e-02_r8,0.15267e-02_r8,0.75016e-03_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.59483e-02_r8,0.57068e-02_r8,0.51995e-02_r8,0.46068e-02_r8,0.39501e-02_r8, & + & 0.32357e-02_r8,0.24610e-02_r8,0.16061e-02_r8,0.82038e-03_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.60233e-02_r8,0.58195e-02_r8,0.53236e-02_r8,0.47349e-02_r8,0.40732e-02_r8, & + & 0.33509e-02_r8,0.25596e-02_r8,0.16868e-02_r8,0.89122e-03_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.19771e-01_r8,0.18370e-01_r8,0.17356e-01_r8,0.16079e-01_r8,0.14680e-01_r8, & + & 0.13282e-01_r8,0.11980e-01_r8,0.11582e-01_r8,0.12985e-01_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.19636e-01_r8,0.18337e-01_r8,0.17425e-01_r8,0.16276e-01_r8,0.15036e-01_r8, & + & 0.13800e-01_r8,0.12788e-01_r8,0.12799e-01_r8,0.14491e-01_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.19487e-01_r8,0.18291e-01_r8,0.17516e-01_r8,0.16543e-01_r8,0.15458e-01_r8, & + & 0.14398e-01_r8,0.13717e-01_r8,0.14121e-01_r8,0.16094e-01_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.19329e-01_r8,0.18244e-01_r8,0.17665e-01_r8,0.16858e-01_r8,0.15921e-01_r8, & + & 0.15082e-01_r8,0.14738e-01_r8,0.15534e-01_r8,0.17796e-01_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.19162e-01_r8,0.18208e-01_r8,0.17862e-01_r8,0.17203e-01_r8,0.16407e-01_r8, & + & 0.15804e-01_r8,0.15831e-01_r8,0.17016e-01_r8,0.19554e-01_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.20491e-01_r8,0.19041e-01_r8,0.17931e-01_r8,0.16490e-01_r8,0.14871e-01_r8, & + & 0.13204e-01_r8,0.11551e-01_r8,0.10493e-01_r8,0.11370e-01_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.20351e-01_r8,0.19021e-01_r8,0.18003e-01_r8,0.16688e-01_r8,0.15207e-01_r8, & + & 0.13674e-01_r8,0.12228e-01_r8,0.11542e-01_r8,0.12722e-01_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.20205e-01_r8,0.18987e-01_r8,0.18097e-01_r8,0.16946e-01_r8,0.15590e-01_r8, & + & 0.14204e-01_r8,0.13003e-01_r8,0.12703e-01_r8,0.14170e-01_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.20054e-01_r8,0.18946e-01_r8,0.18241e-01_r8,0.17244e-01_r8,0.16012e-01_r8, & + & 0.14800e-01_r8,0.13862e-01_r8,0.13953e-01_r8,0.15702e-01_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.19890e-01_r8,0.18914e-01_r8,0.18431e-01_r8,0.17568e-01_r8,0.16464e-01_r8, & + & 0.15445e-01_r8,0.14813e-01_r8,0.15302e-01_r8,0.17318e-01_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.21143e-01_r8,0.19662e-01_r8,0.18419e-01_r8,0.16811e-01_r8,0.15005e-01_r8, & + & 0.13075e-01_r8,0.11094e-01_r8,0.93893e-02_r8,0.95682e-02_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.21021e-01_r8,0.19658e-01_r8,0.18498e-01_r8,0.17007e-01_r8,0.15312e-01_r8, & + & 0.13491e-01_r8,0.11661e-01_r8,0.10256e-01_r8,0.10742e-01_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.20887e-01_r8,0.19635e-01_r8,0.18594e-01_r8,0.17251e-01_r8,0.15669e-01_r8, & + & 0.13959e-01_r8,0.12304e-01_r8,0.11227e-01_r8,0.12012e-01_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.20742e-01_r8,0.19603e-01_r8,0.18727e-01_r8,0.17530e-01_r8,0.16058e-01_r8, & + & 0.14485e-01_r8,0.13015e-01_r8,0.12294e-01_r8,0.13375e-01_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.20582e-01_r8,0.19578e-01_r8,0.18903e-01_r8,0.17831e-01_r8,0.16483e-01_r8, & + & 0.15047e-01_r8,0.13818e-01_r8,0.13471e-01_r8,0.14836e-01_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.21726e-01_r8,0.20199e-01_r8,0.18812e-01_r8,0.17047e-01_r8,0.15080e-01_r8, & + & 0.12938e-01_r8,0.10693e-01_r8,0.84650e-02_r8,0.79270e-02_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.21624e-01_r8,0.20213e-01_r8,0.18897e-01_r8,0.17238e-01_r8,0.15368e-01_r8, & + & 0.13326e-01_r8,0.11175e-01_r8,0.91656e-02_r8,0.89409e-02_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.21502e-01_r8,0.20207e-01_r8,0.18990e-01_r8,0.17468e-01_r8,0.15708e-01_r8, & + & 0.13755e-01_r8,0.11721e-01_r8,0.99561e-02_r8,0.10044e-01_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.21364e-01_r8,0.20186e-01_r8,0.19114e-01_r8,0.17747e-01_r8,0.16075e-01_r8, & + & 0.14230e-01_r8,0.12327e-01_r8,0.10844e-01_r8,0.11238e-01_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.21208e-01_r8,0.20165e-01_r8,0.19280e-01_r8,0.18035e-01_r8,0.16477e-01_r8, & + & 0.14734e-01_r8,0.13004e-01_r8,0.11837e-01_r8,0.12527e-01_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.22212e-01_r8,0.20643e-01_r8,0.19101e-01_r8,0.17193e-01_r8,0.15094e-01_r8, & + & 0.12790e-01_r8,0.10344e-01_r8,0.77661e-02_r8,0.65292e-02_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.22131e-01_r8,0.20679e-01_r8,0.19192e-01_r8,0.17388e-01_r8,0.15373e-01_r8, & + & 0.13156e-01_r8,0.10779e-01_r8,0.83326e-02_r8,0.74004e-02_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.22024e-01_r8,0.20689e-01_r8,0.19289e-01_r8,0.17614e-01_r8,0.15701e-01_r8, & + & 0.13560e-01_r8,0.11259e-01_r8,0.89716e-02_r8,0.83509e-02_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.21891e-01_r8,0.20674e-01_r8,0.19419e-01_r8,0.17880e-01_r8,0.16055e-01_r8, & + & 0.14002e-01_r8,0.11784e-01_r8,0.96942e-02_r8,0.93863e-02_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.21733e-01_r8,0.20659e-01_r8,0.19581e-01_r8,0.18166e-01_r8,0.16436e-01_r8, & + & 0.14467e-01_r8,0.12356e-01_r8,0.10508e-01_r8,0.10499e-01_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.22561e-01_r8,0.20963e-01_r8,0.19278e-01_r8,0.17248e-01_r8,0.15027e-01_r8, & + & 0.12605e-01_r8,0.99913e-02_r8,0.71998e-02_r8,0.53191e-02_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.22505e-01_r8,0.21027e-01_r8,0.19391e-01_r8,0.17451e-01_r8,0.15296e-01_r8, & + & 0.12947e-01_r8,0.10394e-01_r8,0.76719e-02_r8,0.60628e-02_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.22407e-01_r8,0.21057e-01_r8,0.19505e-01_r8,0.17673e-01_r8,0.15617e-01_r8, & + & 0.13330e-01_r8,0.10834e-01_r8,0.82004e-02_r8,0.68698e-02_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.22287e-01_r8,0.21061e-01_r8,0.19636e-01_r8,0.17933e-01_r8,0.15963e-01_r8, & + & 0.13742e-01_r8,0.11312e-01_r8,0.87854e-02_r8,0.77488e-02_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.22148e-01_r8,0.21053e-01_r8,0.19794e-01_r8,0.18212e-01_r8,0.16329e-01_r8, & + & 0.14180e-01_r8,0.11816e-01_r8,0.94417e-02_r8,0.86993e-02_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.22745e-01_r8,0.21135e-01_r8,0.19327e-01_r8,0.17197e-01_r8,0.14893e-01_r8, & + & 0.12374e-01_r8,0.96536e-02_r8,0.67256e-02_r8,0.43127e-02_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.22707e-01_r8,0.21230e-01_r8,0.19474e-01_r8,0.17423e-01_r8,0.15162e-01_r8, & + & 0.12700e-01_r8,0.10030e-01_r8,0.71370e-02_r8,0.49389e-02_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.22632e-01_r8,0.21281e-01_r8,0.19608e-01_r8,0.17649e-01_r8,0.15471e-01_r8, & + & 0.13070e-01_r8,0.10436e-01_r8,0.75822e-02_r8,0.56174e-02_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.22537e-01_r8,0.21307e-01_r8,0.19744e-01_r8,0.17903e-01_r8,0.15813e-01_r8, & + & 0.13461e-01_r8,0.10872e-01_r8,0.80682e-02_r8,0.63562e-02_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.22420e-01_r8,0.21314e-01_r8,0.19904e-01_r8,0.18182e-01_r8,0.16160e-01_r8, & + & 0.13874e-01_r8,0.11331e-01_r8,0.86088e-02_r8,0.71565e-02_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.22742e-01_r8,0.21141e-01_r8,0.19244e-01_r8,0.17036e-01_r8,0.14667e-01_r8, & + & 0.12093e-01_r8,0.93194e-02_r8,0.63016e-02_r8,0.33604e-02_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.22738e-01_r8,0.21267e-01_r8,0.19420e-01_r8,0.17289e-01_r8,0.14951e-01_r8, & + & 0.12414e-01_r8,0.96717e-02_r8,0.66654e-02_r8,0.38903e-02_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.22699e-01_r8,0.21347e-01_r8,0.19574e-01_r8,0.17525e-01_r8,0.15260e-01_r8, & + & 0.12775e-01_r8,0.10048e-01_r8,0.70608e-02_r8,0.44626e-02_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.22634e-01_r8,0.21402e-01_r8,0.19725e-01_r8,0.17775e-01_r8,0.15596e-01_r8, & + & 0.13150e-01_r8,0.10455e-01_r8,0.74847e-02_r8,0.50904e-02_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.22550e-01_r8,0.21432e-01_r8,0.19888e-01_r8,0.18059e-01_r8,0.15936e-01_r8, & + & 0.13540e-01_r8,0.10879e-01_r8,0.79454e-02_r8,0.57754e-02_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.22571e-01_r8,0.20980e-01_r8,0.19017e-01_r8,0.16764e-01_r8,0.14350e-01_r8, & + & 0.11743e-01_r8,0.89583e-02_r8,0.59107e-02_r8,0.27753e-02_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.22607e-01_r8,0.21147e-01_r8,0.19231e-01_r8,0.17040e-01_r8,0.14648e-01_r8, & + & 0.12069e-01_r8,0.92988e-02_r8,0.62425e-02_r8,0.31527e-02_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.22609e-01_r8,0.21268e-01_r8,0.19413e-01_r8,0.17284e-01_r8,0.14954e-01_r8, & + & 0.12424e-01_r8,0.96568e-02_r8,0.66010e-02_r8,0.35387e-02_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.22589e-01_r8,0.21355e-01_r8,0.19582e-01_r8,0.17535e-01_r8,0.15285e-01_r8, & + & 0.12790e-01_r8,0.10038e-01_r8,0.69765e-02_r8,0.39766e-02_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.22546e-01_r8,0.21413e-01_r8,0.19758e-01_r8,0.17821e-01_r8,0.15622e-01_r8, & + & 0.13166e-01_r8,0.10432e-01_r8,0.73821e-02_r8,0.44450e-02_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.22137e-01_r8,0.20618e-01_r8,0.18650e-01_r8,0.16403e-01_r8,0.13972e-01_r8, & + & 0.11364e-01_r8,0.85848e-02_r8,0.55632e-02_r8,0.31593e-02_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.22231e-01_r8,0.20835e-01_r8,0.18905e-01_r8,0.16706e-01_r8,0.14289e-01_r8, & + & 0.11695e-01_r8,0.89167e-02_r8,0.58739e-02_r8,0.35325e-02_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.22295e-01_r8,0.21010e-01_r8,0.19131e-01_r8,0.16972e-01_r8,0.14595e-01_r8, & + & 0.12040e-01_r8,0.92665e-02_r8,0.62059e-02_r8,0.39315e-02_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.22331e-01_r8,0.21144e-01_r8,0.19334e-01_r8,0.17233e-01_r8,0.14916e-01_r8, & + & 0.12396e-01_r8,0.96355e-02_r8,0.65507e-02_r8,0.43409e-02_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.22332e-01_r8,0.21248e-01_r8,0.19527e-01_r8,0.17517e-01_r8,0.15252e-01_r8, & + & 0.12765e-01_r8,0.10012e-01_r8,0.69176e-02_r8,0.47851e-02_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.21611e-01_r8,0.20177e-01_r8,0.18220e-01_r8,0.16014e-01_r8,0.13625e-01_r8, & + & 0.11072e-01_r8,0.83376e-02_r8,0.53526e-02_r8,0.32967e-02_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.21754e-01_r8,0.20431e-01_r8,0.18507e-01_r8,0.16333e-01_r8,0.13954e-01_r8, & + & 0.11415e-01_r8,0.86702e-02_r8,0.56558e-02_r8,0.36779e-02_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.21862e-01_r8,0.20634e-01_r8,0.18769e-01_r8,0.16624e-01_r8,0.14280e-01_r8, & + & 0.11762e-01_r8,0.90145e-02_r8,0.59759e-02_r8,0.40891e-02_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.21929e-01_r8,0.20796e-01_r8,0.18995e-01_r8,0.16914e-01_r8,0.14621e-01_r8, & + & 0.12122e-01_r8,0.93752e-02_r8,0.63026e-02_r8,0.45492e-02_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.21956e-01_r8,0.20925e-01_r8,0.19222e-01_r8,0.17218e-01_r8,0.14974e-01_r8, & + & 0.12492e-01_r8,0.97406e-02_r8,0.66508e-02_r8,0.50324e-02_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.20989e-01_r8,0.19649e-01_r8,0.17719e-01_r8,0.15554e-01_r8,0.13207e-01_r8, & + & 0.10709e-01_r8,0.80423e-02_r8,0.51308e-02_r8,0.32152e-02_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.21187e-01_r8,0.19941e-01_r8,0.18042e-01_r8,0.15892e-01_r8,0.13549e-01_r8, & + & 0.11055e-01_r8,0.83766e-02_r8,0.54250e-02_r8,0.35851e-02_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.21336e-01_r8,0.20173e-01_r8,0.18327e-01_r8,0.16203e-01_r8,0.13894e-01_r8, & + & 0.11411e-01_r8,0.87228e-02_r8,0.57329e-02_r8,0.40006e-02_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.21440e-01_r8,0.20364e-01_r8,0.18584e-01_r8,0.16516e-01_r8,0.14243e-01_r8, & + & 0.11781e-01_r8,0.90825e-02_r8,0.60483e-02_r8,0.44327e-02_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.21509e-01_r8,0.20531e-01_r8,0.18841e-01_r8,0.16838e-01_r8,0.14607e-01_r8, & + & 0.12155e-01_r8,0.94413e-02_r8,0.63798e-02_r8,0.48628e-02_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.20300e-01_r8,0.19036e-01_r8,0.17142e-01_r8,0.15033e-01_r8,0.12745e-01_r8, & + & 0.10318e-01_r8,0.77330e-02_r8,0.48977e-02_r8,0.29186e-02_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.20539e-01_r8,0.19361e-01_r8,0.17504e-01_r8,0.15398e-01_r8,0.13114e-01_r8, & + & 0.10679e-01_r8,0.80651e-02_r8,0.51844e-02_r8,0.32743e-02_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.20734e-01_r8,0.19633e-01_r8,0.17821e-01_r8,0.15739e-01_r8,0.13481e-01_r8, & + & 0.11044e-01_r8,0.84099e-02_r8,0.54812e-02_r8,0.36601e-02_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.20892e-01_r8,0.19871e-01_r8,0.18120e-01_r8,0.16090e-01_r8,0.13847e-01_r8, & + & 0.11415e-01_r8,0.87615e-02_r8,0.57863e-02_r8,0.40403e-02_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.21016e-01_r8,0.20092e-01_r8,0.18420e-01_r8,0.16433e-01_r8,0.14220e-01_r8, & + & 0.11787e-01_r8,0.91177e-02_r8,0.61020e-02_r8,0.44775e-02_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.32077e-01_r8,0.29717e-01_r8,0.27957e-01_r8,0.27088e-01_r8,0.26148e-01_r8, & + & 0.25463e-01_r8,0.27887e-01_r8,0.32409e-01_r8,0.37623e-01_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.31656e-01_r8,0.29512e-01_r8,0.28047e-01_r8,0.27317e-01_r8,0.26667e-01_r8, & + & 0.26788e-01_r8,0.30344e-01_r8,0.35248e-01_r8,0.40533e-01_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.31222e-01_r8,0.29398e-01_r8,0.28183e-01_r8,0.27633e-01_r8,0.27598e-01_r8, & + & 0.28788e-01_r8,0.33344e-01_r8,0.38694e-01_r8,0.44458e-01_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.30838e-01_r8,0.29185e-01_r8,0.28219e-01_r8,0.28269e-01_r8,0.28900e-01_r8, & + & 0.31215e-01_r8,0.36765e-01_r8,0.42659e-01_r8,0.48710e-01_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.30476e-01_r8,0.28982e-01_r8,0.28435e-01_r8,0.29011e-01_r8,0.30822e-01_r8, & + & 0.34422e-01_r8,0.40770e-01_r8,0.47309e-01_r8,0.54027e-01_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.34215e-01_r8,0.31859e-01_r8,0.30015e-01_r8,0.28551e-01_r8,0.26684e-01_r8, & + & 0.25243e-01_r8,0.25874e-01_r8,0.29803e-01_r8,0.34327e-01_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.33819e-01_r8,0.31701e-01_r8,0.30099e-01_r8,0.28712e-01_r8,0.27156e-01_r8, & + & 0.26446e-01_r8,0.28380e-01_r8,0.32886e-01_r8,0.37685e-01_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.33393e-01_r8,0.31477e-01_r8,0.30146e-01_r8,0.28931e-01_r8,0.28112e-01_r8, & + & 0.28308e-01_r8,0.31383e-01_r8,0.36360e-01_r8,0.41605e-01_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.33012e-01_r8,0.31222e-01_r8,0.30110e-01_r8,0.29460e-01_r8,0.29343e-01_r8, & + & 0.30463e-01_r8,0.34829e-01_r8,0.40350e-01_r8,0.46115e-01_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.32618e-01_r8,0.30977e-01_r8,0.30249e-01_r8,0.30140e-01_r8,0.31029e-01_r8, & + & 0.33086e-01_r8,0.38518e-01_r8,0.44611e-01_r8,0.51063e-01_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.36609e-01_r8,0.34016e-01_r8,0.32008e-01_r8,0.30013e-01_r8,0.27528e-01_r8, & + & 0.25143e-01_r8,0.24092e-01_r8,0.26746e-01_r8,0.30590e-01_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.36187e-01_r8,0.33816e-01_r8,0.32068e-01_r8,0.30121e-01_r8,0.27943e-01_r8, & + & 0.26137e-01_r8,0.26190e-01_r8,0.29769e-01_r8,0.34003e-01_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.35755e-01_r8,0.33555e-01_r8,0.32022e-01_r8,0.30354e-01_r8,0.28696e-01_r8, & + & 0.27732e-01_r8,0.28744e-01_r8,0.33056e-01_r8,0.37754e-01_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.35304e-01_r8,0.33277e-01_r8,0.31985e-01_r8,0.30856e-01_r8,0.29759e-01_r8, & + & 0.29582e-01_r8,0.31793e-01_r8,0.36769e-01_r8,0.41965e-01_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.34895e-01_r8,0.32987e-01_r8,0.32094e-01_r8,0.31490e-01_r8,0.31100e-01_r8, & + & 0.31735e-01_r8,0.35104e-01_r8,0.40646e-01_r8,0.46442e-01_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.38977e-01_r8,0.36120e-01_r8,0.33897e-01_r8,0.31410e-01_r8,0.28525e-01_r8, & + & 0.25373e-01_r8,0.22918e-01_r8,0.23596e-01_r8,0.26905e-01_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.38508e-01_r8,0.35924e-01_r8,0.33917e-01_r8,0.31530e-01_r8,0.28933e-01_r8, & + & 0.26161e-01_r8,0.24652e-01_r8,0.26430e-01_r8,0.30108e-01_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.38014e-01_r8,0.35658e-01_r8,0.33872e-01_r8,0.31757e-01_r8,0.29547e-01_r8, & + & 0.27436e-01_r8,0.26616e-01_r8,0.29450e-01_r8,0.33541e-01_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.37555e-01_r8,0.35363e-01_r8,0.33895e-01_r8,0.32125e-01_r8,0.30540e-01_r8, & + & 0.28878e-01_r8,0.28956e-01_r8,0.32793e-01_r8,0.37351e-01_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.37151e-01_r8,0.35088e-01_r8,0.33984e-01_r8,0.32788e-01_r8,0.31573e-01_r8, & + & 0.30633e-01_r8,0.31627e-01_r8,0.36308e-01_r8,0.41371e-01_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.41153e-01_r8,0.38034e-01_r8,0.35706e-01_r8,0.32805e-01_r8,0.29387e-01_r8, & + & 0.25927e-01_r8,0.22231e-01_r8,0.20561e-01_r8,0.23186e-01_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.40611e-01_r8,0.37835e-01_r8,0.35759e-01_r8,0.32923e-01_r8,0.29781e-01_r8, & + & 0.26577e-01_r8,0.23565e-01_r8,0.23003e-01_r8,0.26110e-01_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.40174e-01_r8,0.37589e-01_r8,0.35747e-01_r8,0.33131e-01_r8,0.30334e-01_r8, & + & 0.27648e-01_r8,0.25145e-01_r8,0.25696e-01_r8,0.29208e-01_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.39802e-01_r8,0.37389e-01_r8,0.35760e-01_r8,0.33447e-01_r8,0.31294e-01_r8, & + & 0.28785e-01_r8,0.27005e-01_r8,0.28729e-01_r8,0.32665e-01_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.39471e-01_r8,0.37195e-01_r8,0.35872e-01_r8,0.34084e-01_r8,0.32227e-01_r8, & + & 0.30087e-01_r8,0.29177e-01_r8,0.32029e-01_r8,0.36449e-01_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.43370e-01_r8,0.39997e-01_r8,0.37440e-01_r8,0.34118e-01_r8,0.30345e-01_r8, & + & 0.26246e-01_r8,0.21955e-01_r8,0.18231e-01_r8,0.19573e-01_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.42801e-01_r8,0.39763e-01_r8,0.37480e-01_r8,0.34252e-01_r8,0.30723e-01_r8, & + & 0.26892e-01_r8,0.22943e-01_r8,0.20080e-01_r8,0.22108e-01_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.42453e-01_r8,0.39592e-01_r8,0.37449e-01_r8,0.34486e-01_r8,0.31160e-01_r8, & + & 0.27853e-01_r8,0.24129e-01_r8,0.22254e-01_r8,0.24945e-01_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.42151e-01_r8,0.39446e-01_r8,0.37500e-01_r8,0.34777e-01_r8,0.31970e-01_r8, & + & 0.28872e-01_r8,0.25539e-01_r8,0.24809e-01_r8,0.28086e-01_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.41833e-01_r8,0.39344e-01_r8,0.37631e-01_r8,0.35392e-01_r8,0.32810e-01_r8, & + & 0.29983e-01_r8,0.27309e-01_r8,0.27744e-01_r8,0.31535e-01_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.45445e-01_r8,0.41961e-01_r8,0.39238e-01_r8,0.35426e-01_r8,0.31192e-01_r8, & + & 0.26649e-01_r8,0.21695e-01_r8,0.16623e-01_r8,0.16293e-01_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.45078e-01_r8,0.41797e-01_r8,0.39225e-01_r8,0.35507e-01_r8,0.31562e-01_r8, & + & 0.27229e-01_r8,0.22532e-01_r8,0.18019e-01_r8,0.18534e-01_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.44870e-01_r8,0.41785e-01_r8,0.39209e-01_r8,0.35749e-01_r8,0.31958e-01_r8, & + & 0.27976e-01_r8,0.23572e-01_r8,0.19783e-01_r8,0.21105e-01_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.44638e-01_r8,0.41726e-01_r8,0.39301e-01_r8,0.35989e-01_r8,0.32614e-01_r8, & + & 0.28887e-01_r8,0.24743e-01_r8,0.21842e-01_r8,0.23947e-01_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.44319e-01_r8,0.41703e-01_r8,0.39403e-01_r8,0.36491e-01_r8,0.33461e-01_r8, & + & 0.29864e-01_r8,0.26133e-01_r8,0.24238e-01_r8,0.27063e-01_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.47338e-01_r8,0.43694e-01_r8,0.40795e-01_r8,0.36657e-01_r8,0.31991e-01_r8, & + & 0.26976e-01_r8,0.21436e-01_r8,0.15589e-01_r8,0.13371e-01_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.47172e-01_r8,0.43681e-01_r8,0.40850e-01_r8,0.36728e-01_r8,0.32341e-01_r8, & + & 0.27474e-01_r8,0.22184e-01_r8,0.16691e-01_r8,0.15337e-01_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.47077e-01_r8,0.43885e-01_r8,0.40965e-01_r8,0.37016e-01_r8,0.32654e-01_r8, & + & 0.28038e-01_r8,0.23084e-01_r8,0.18052e-01_r8,0.17670e-01_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.46877e-01_r8,0.43984e-01_r8,0.41138e-01_r8,0.37264e-01_r8,0.33142e-01_r8, & + & 0.28868e-01_r8,0.24126e-01_r8,0.19696e-01_r8,0.20174e-01_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.46627e-01_r8,0.44042e-01_r8,0.41218e-01_r8,0.37582e-01_r8,0.33931e-01_r8, & + & 0.29818e-01_r8,0.25367e-01_r8,0.21590e-01_r8,0.22899e-01_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.49069e-01_r8,0.45230e-01_r8,0.41949e-01_r8,0.37482e-01_r8,0.32547e-01_r8, & + & 0.27221e-01_r8,0.21190e-01_r8,0.14771e-01_r8,0.82104e-02_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.48982e-01_r8,0.45358e-01_r8,0.42113e-01_r8,0.37642e-01_r8,0.32970e-01_r8, & + & 0.27650e-01_r8,0.21850e-01_r8,0.15738e-01_r8,0.94586e-02_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.48934e-01_r8,0.45677e-01_r8,0.42390e-01_r8,0.38084e-01_r8,0.33301e-01_r8, & + & 0.28097e-01_r8,0.22664e-01_r8,0.16844e-01_r8,0.11686e-01_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.48760e-01_r8,0.45876e-01_r8,0.42614e-01_r8,0.38405e-01_r8,0.33732e-01_r8, & + & 0.28793e-01_r8,0.23625e-01_r8,0.18186e-01_r8,0.14417e-01_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.48535e-01_r8,0.45946e-01_r8,0.42722e-01_r8,0.38669e-01_r8,0.34439e-01_r8, & + & 0.29718e-01_r8,0.24746e-01_r8,0.19636e-01_r8,0.17490e-01_r8 /) + kao(:, 1,10,10) = (/ & + & 0.50581e-01_r8,0.46588e-01_r8,0.42861e-01_r8,0.37978e-01_r8,0.32756e-01_r8, & + & 0.27218e-01_r8,0.20963e-01_r8,0.14152e-01_r8,0.94977e-02_r8 /) + kao(:, 2,10,10) = (/ & + & 0.50552e-01_r8,0.46832e-01_r8,0.43092e-01_r8,0.38231e-01_r8,0.33230e-01_r8, & + & 0.27672e-01_r8,0.21597e-01_r8,0.15000e-01_r8,0.11069e-01_r8 /) + kao(:, 3,10,10) = (/ & + & 0.50470e-01_r8,0.47126e-01_r8,0.43390e-01_r8,0.38763e-01_r8,0.33692e-01_r8, & + & 0.28191e-01_r8,0.22303e-01_r8,0.15932e-01_r8,0.12529e-01_r8 /) + kao(:, 4,10,10) = (/ & + & 0.50251e-01_r8,0.47290e-01_r8,0.43621e-01_r8,0.39150e-01_r8,0.34250e-01_r8, & + & 0.28907e-01_r8,0.23153e-01_r8,0.17091e-01_r8,0.14647e-01_r8 /) + kao(:, 5,10,10) = (/ & + & 0.50025e-01_r8,0.47335e-01_r8,0.43789e-01_r8,0.39526e-01_r8,0.34961e-01_r8, & + & 0.29783e-01_r8,0.24207e-01_r8,0.18303e-01_r8,0.16505e-01_r8 /) + kao(:, 1,11,10) = (/ & + & 0.51775e-01_r8,0.47733e-01_r8,0.43604e-01_r8,0.38377e-01_r8,0.33010e-01_r8, & + & 0.27211e-01_r8,0.20853e-01_r8,0.13952e-01_r8,0.10099e-01_r8 /) + kao(:, 2,11,10) = (/ & + & 0.51722e-01_r8,0.48082e-01_r8,0.43912e-01_r8,0.38859e-01_r8,0.33550e-01_r8, & + & 0.27720e-01_r8,0.21535e-01_r8,0.14746e-01_r8,0.11460e-01_r8 /) + kao(:, 3,11,10) = (/ & + & 0.51577e-01_r8,0.48309e-01_r8,0.44107e-01_r8,0.39371e-01_r8,0.34132e-01_r8, & + & 0.28431e-01_r8,0.22288e-01_r8,0.15640e-01_r8,0.12761e-01_r8 /) + kao(:, 4,11,10) = (/ & + & 0.51367e-01_r8,0.48474e-01_r8,0.44409e-01_r8,0.39819e-01_r8,0.34807e-01_r8, & + & 0.29240e-01_r8,0.23192e-01_r8,0.16707e-01_r8,0.14096e-01_r8 /) + kao(:, 5,11,10) = (/ & + & 0.51186e-01_r8,0.48565e-01_r8,0.44658e-01_r8,0.40350e-01_r8,0.35545e-01_r8, & + & 0.30221e-01_r8,0.24214e-01_r8,0.17744e-01_r8,0.15290e-01_r8 /) + kao(:, 1,12,10) = (/ & + & 0.52731e-01_r8,0.48681e-01_r8,0.44186e-01_r8,0.38733e-01_r8,0.33169e-01_r8, & + & 0.27108e-01_r8,0.20634e-01_r8,0.13723e-01_r8,0.97949e-02_r8 /) + kao(:, 2,12,10) = (/ & + & 0.52654e-01_r8,0.49001e-01_r8,0.44433e-01_r8,0.39315e-01_r8,0.33776e-01_r8, & + & 0.27772e-01_r8,0.21363e-01_r8,0.14506e-01_r8,0.11186e-01_r8 /) + kao(:, 3,12,10) = (/ & + & 0.52581e-01_r8,0.49321e-01_r8,0.44768e-01_r8,0.39827e-01_r8,0.34382e-01_r8, & + & 0.28565e-01_r8,0.22205e-01_r8,0.15366e-01_r8,0.12310e-01_r8 /) + kao(:, 4,12,10) = (/ & + & 0.52474e-01_r8,0.49527e-01_r8,0.45170e-01_r8,0.40364e-01_r8,0.35120e-01_r8, & + & 0.29376e-01_r8,0.23174e-01_r8,0.16305e-01_r8,0.14325e-01_r8 /) + kao(:, 5,12,10) = (/ & + & 0.52313e-01_r8,0.49659e-01_r8,0.45526e-01_r8,0.41026e-01_r8,0.35905e-01_r8, & + & 0.30399e-01_r8,0.24222e-01_r8,0.17291e-01_r8,0.16045e-01_r8 /) + kao(:, 1,13,10) = (/ & + & 0.53347e-01_r8,0.49460e-01_r8,0.44667e-01_r8,0.39102e-01_r8,0.33300e-01_r8, & + & 0.27005e-01_r8,0.20373e-01_r8,0.13403e-01_r8,0.88882e-02_r8 /) + kao(:, 2,13,10) = (/ & + & 0.53473e-01_r8,0.49893e-01_r8,0.44992e-01_r8,0.39672e-01_r8,0.33886e-01_r8, & + & 0.27737e-01_r8,0.21157e-01_r8,0.14194e-01_r8,0.99472e-02_r8 /) + kao(:, 3,13,10) = (/ & + & 0.53543e-01_r8,0.50285e-01_r8,0.45484e-01_r8,0.40250e-01_r8,0.34541e-01_r8, & + & 0.28510e-01_r8,0.22035e-01_r8,0.15061e-01_r8,0.11235e-01_r8 /) + kao(:, 4,13,10) = (/ & + & 0.53461e-01_r8,0.50524e-01_r8,0.45912e-01_r8,0.40827e-01_r8,0.35322e-01_r8, & + & 0.29374e-01_r8,0.23048e-01_r8,0.15925e-01_r8,0.12822e-01_r8 /) + kao(:, 5,13,10) = (/ & + & 0.53278e-01_r8,0.50624e-01_r8,0.46303e-01_r8,0.41556e-01_r8,0.36186e-01_r8, & + & 0.30414e-01_r8,0.24058e-01_r8,0.16868e-01_r8,0.14203e-01_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.37171e-01_r8,0.34434e-01_r8,0.32644e-01_r8,0.32703e-01_r8,0.33235e-01_r8, & + & 0.36611e-01_r8,0.43526e-01_r8,0.50696e-01_r8,0.58297e-01_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.36741e-01_r8,0.34071e-01_r8,0.32455e-01_r8,0.33094e-01_r8,0.34229e-01_r8, & + & 0.38792e-01_r8,0.46364e-01_r8,0.53998e-01_r8,0.61977e-01_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.36310e-01_r8,0.33795e-01_r8,0.32514e-01_r8,0.33548e-01_r8,0.35414e-01_r8, & + & 0.41445e-01_r8,0.49627e-01_r8,0.57817e-01_r8,0.66049e-01_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.35845e-01_r8,0.33632e-01_r8,0.32631e-01_r8,0.34397e-01_r8,0.37428e-01_r8, & + & 0.44985e-01_r8,0.53868e-01_r8,0.62763e-01_r8,0.71579e-01_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.35331e-01_r8,0.33379e-01_r8,0.32910e-01_r8,0.35528e-01_r8,0.39783e-01_r8, & + & 0.48705e-01_r8,0.58316e-01_r8,0.67942e-01_r8,0.77160e-01_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.40448e-01_r8,0.37395e-01_r8,0.35029e-01_r8,0.34305e-01_r8,0.33991e-01_r8, & + & 0.35316e-01_r8,0.40968e-01_r8,0.47712e-01_r8,0.54932e-01_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.39920e-01_r8,0.36968e-01_r8,0.34927e-01_r8,0.34599e-01_r8,0.34841e-01_r8, & + & 0.37250e-01_r8,0.43923e-01_r8,0.51161e-01_r8,0.58827e-01_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.39405e-01_r8,0.36691e-01_r8,0.34999e-01_r8,0.35076e-01_r8,0.35924e-01_r8, & + & 0.39772e-01_r8,0.47443e-01_r8,0.55253e-01_r8,0.63303e-01_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.38792e-01_r8,0.36414e-01_r8,0.35121e-01_r8,0.35787e-01_r8,0.37790e-01_r8, & + & 0.43290e-01_r8,0.51773e-01_r8,0.60284e-01_r8,0.68983e-01_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.38190e-01_r8,0.36098e-01_r8,0.35328e-01_r8,0.36844e-01_r8,0.39952e-01_r8, & + & 0.47291e-01_r8,0.56573e-01_r8,0.65870e-01_r8,0.75177e-01_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.43810e-01_r8,0.40500e-01_r8,0.37754e-01_r8,0.36293e-01_r8,0.34676e-01_r8, & + & 0.34367e-01_r8,0.37493e-01_r8,0.43650e-01_r8,0.50087e-01_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.43199e-01_r8,0.40018e-01_r8,0.37716e-01_r8,0.36450e-01_r8,0.35395e-01_r8, & + & 0.35866e-01_r8,0.40426e-01_r8,0.47076e-01_r8,0.53958e-01_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.42538e-01_r8,0.39757e-01_r8,0.37868e-01_r8,0.36772e-01_r8,0.36302e-01_r8, & + & 0.37914e-01_r8,0.44070e-01_r8,0.51299e-01_r8,0.58670e-01_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.41856e-01_r8,0.39457e-01_r8,0.37979e-01_r8,0.37163e-01_r8,0.37947e-01_r8, & + & 0.40970e-01_r8,0.48419e-01_r8,0.56334e-01_r8,0.64404e-01_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.41250e-01_r8,0.39154e-01_r8,0.38065e-01_r8,0.38049e-01_r8,0.39929e-01_r8, & + & 0.44658e-01_r8,0.53223e-01_r8,0.61909e-01_r8,0.70665e-01_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.47088e-01_r8,0.43589e-01_r8,0.40605e-01_r8,0.38686e-01_r8,0.35713e-01_r8, & + & 0.33942e-01_r8,0.34171e-01_r8,0.39143e-01_r8,0.44787e-01_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.46380e-01_r8,0.43081e-01_r8,0.40678e-01_r8,0.38772e-01_r8,0.36271e-01_r8, & + & 0.35115e-01_r8,0.36728e-01_r8,0.42523e-01_r8,0.48625e-01_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.45787e-01_r8,0.42889e-01_r8,0.40853e-01_r8,0.39000e-01_r8,0.36901e-01_r8, & + & 0.36794e-01_r8,0.40276e-01_r8,0.46812e-01_r8,0.53448e-01_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.45216e-01_r8,0.42628e-01_r8,0.40916e-01_r8,0.39286e-01_r8,0.38129e-01_r8, & + & 0.39329e-01_r8,0.44499e-01_r8,0.51734e-01_r8,0.59041e-01_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.44698e-01_r8,0.42312e-01_r8,0.40992e-01_r8,0.39909e-01_r8,0.39896e-01_r8, & + & 0.42322e-01_r8,0.49157e-01_r8,0.57134e-01_r8,0.65206e-01_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.50564e-01_r8,0.46864e-01_r8,0.43550e-01_r8,0.41145e-01_r8,0.37282e-01_r8, & + & 0.33847e-01_r8,0.31921e-01_r8,0.34655e-01_r8,0.39581e-01_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.49853e-01_r8,0.46324e-01_r8,0.43735e-01_r8,0.41212e-01_r8,0.37826e-01_r8, & + & 0.34760e-01_r8,0.33939e-01_r8,0.37988e-01_r8,0.43340e-01_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.49277e-01_r8,0.46142e-01_r8,0.43937e-01_r8,0.41409e-01_r8,0.38245e-01_r8, & + & 0.36079e-01_r8,0.36891e-01_r8,0.42172e-01_r8,0.48104e-01_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.48731e-01_r8,0.45921e-01_r8,0.43964e-01_r8,0.41658e-01_r8,0.39073e-01_r8, & + & 0.38270e-01_r8,0.40535e-01_r8,0.46833e-01_r8,0.53415e-01_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.48265e-01_r8,0.45648e-01_r8,0.43993e-01_r8,0.42096e-01_r8,0.40473e-01_r8, & + & 0.40846e-01_r8,0.44703e-01_r8,0.51860e-01_r8,0.59120e-01_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.54155e-01_r8,0.50312e-01_r8,0.46699e-01_r8,0.43479e-01_r8,0.38935e-01_r8, & + & 0.34460e-01_r8,0.30470e-01_r8,0.30214e-01_r8,0.34389e-01_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.53396e-01_r8,0.49741e-01_r8,0.46925e-01_r8,0.43573e-01_r8,0.39485e-01_r8, & + & 0.35160e-01_r8,0.32122e-01_r8,0.33415e-01_r8,0.38087e-01_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.52823e-01_r8,0.49548e-01_r8,0.47130e-01_r8,0.43740e-01_r8,0.39828e-01_r8, & + & 0.36044e-01_r8,0.34474e-01_r8,0.37304e-01_r8,0.42510e-01_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.52327e-01_r8,0.49384e-01_r8,0.47097e-01_r8,0.43937e-01_r8,0.40452e-01_r8, & + & 0.37736e-01_r8,0.37393e-01_r8,0.41655e-01_r8,0.47452e-01_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.51903e-01_r8,0.49131e-01_r8,0.47026e-01_r8,0.44222e-01_r8,0.41687e-01_r8, & + & 0.39818e-01_r8,0.40660e-01_r8,0.46275e-01_r8,0.52724e-01_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.58007e-01_r8,0.53733e-01_r8,0.49779e-01_r8,0.45887e-01_r8,0.40462e-01_r8, & + & 0.35176e-01_r8,0.29765e-01_r8,0.26441e-01_r8,0.29320e-01_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.57151e-01_r8,0.53110e-01_r8,0.50041e-01_r8,0.45960e-01_r8,0.40973e-01_r8, & + & 0.35887e-01_r8,0.31026e-01_r8,0.29123e-01_r8,0.32803e-01_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.56502e-01_r8,0.52846e-01_r8,0.50182e-01_r8,0.46056e-01_r8,0.41337e-01_r8, & + & 0.36666e-01_r8,0.32781e-01_r8,0.32480e-01_r8,0.36858e-01_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.55999e-01_r8,0.52671e-01_r8,0.50072e-01_r8,0.46217e-01_r8,0.41835e-01_r8, & + & 0.38000e-01_r8,0.35109e-01_r8,0.36308e-01_r8,0.41318e-01_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.55573e-01_r8,0.52382e-01_r8,0.49967e-01_r8,0.46401e-01_r8,0.42955e-01_r8, & + & 0.39677e-01_r8,0.37716e-01_r8,0.40481e-01_r8,0.46095e-01_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.61929e-01_r8,0.57176e-01_r8,0.52730e-01_r8,0.48103e-01_r8,0.42015e-01_r8, & + & 0.35869e-01_r8,0.29499e-01_r8,0.23665e-01_r8,0.24549e-01_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.61013e-01_r8,0.56553e-01_r8,0.52930e-01_r8,0.48080e-01_r8,0.42522e-01_r8, & + & 0.36573e-01_r8,0.30581e-01_r8,0.25834e-01_r8,0.27791e-01_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.60303e-01_r8,0.56131e-01_r8,0.52872e-01_r8,0.48123e-01_r8,0.42911e-01_r8, & + & 0.37343e-01_r8,0.31938e-01_r8,0.28446e-01_r8,0.31375e-01_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.59783e-01_r8,0.55843e-01_r8,0.52678e-01_r8,0.48331e-01_r8,0.43398e-01_r8, & + & 0.38468e-01_r8,0.33698e-01_r8,0.31535e-01_r8,0.35398e-01_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.59221e-01_r8,0.55525e-01_r8,0.52626e-01_r8,0.48547e-01_r8,0.44309e-01_r8, & + & 0.39969e-01_r8,0.35748e-01_r8,0.35119e-01_r8,0.39791e-01_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.65420e-01_r8,0.60290e-01_r8,0.55521e-01_r8,0.50117e-01_r8,0.43421e-01_r8, & + & 0.36608e-01_r8,0.29349e-01_r8,0.21841e-01_r8,0.18774e-01_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.64534e-01_r8,0.59710e-01_r8,0.55627e-01_r8,0.50054e-01_r8,0.43842e-01_r8, & + & 0.37357e-01_r8,0.30337e-01_r8,0.23525e-01_r8,0.22756e-01_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.63805e-01_r8,0.59237e-01_r8,0.55452e-01_r8,0.50019e-01_r8,0.44319e-01_r8, & + & 0.38089e-01_r8,0.31491e-01_r8,0.25524e-01_r8,0.26401e-01_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.63315e-01_r8,0.59001e-01_r8,0.55252e-01_r8,0.50261e-01_r8,0.44802e-01_r8, & + & 0.39006e-01_r8,0.32915e-01_r8,0.27972e-01_r8,0.30021e-01_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.62781e-01_r8,0.58825e-01_r8,0.55257e-01_r8,0.50524e-01_r8,0.45567e-01_r8, & + & 0.40297e-01_r8,0.34643e-01_r8,0.30888e-01_r8,0.34021e-01_r8 /) + kao(:, 1,10,11) = (/ & + & 0.68132e-01_r8,0.62682e-01_r8,0.57743e-01_r8,0.51836e-01_r8,0.44670e-01_r8, & + & 0.37300e-01_r8,0.29365e-01_r8,0.20724e-01_r8,0.15957e-01_r8 /) + kao(:, 2,10,11) = (/ & + & 0.67210e-01_r8,0.62151e-01_r8,0.57960e-01_r8,0.51867e-01_r8,0.45128e-01_r8, & + & 0.38064e-01_r8,0.30245e-01_r8,0.22146e-01_r8,0.17704e-01_r8 /) + kao(:, 3,10,11) = (/ & + & 0.66632e-01_r8,0.61949e-01_r8,0.57882e-01_r8,0.51878e-01_r8,0.45637e-01_r8, & + & 0.38758e-01_r8,0.31283e-01_r8,0.23744e-01_r8,0.20098e-01_r8 /) + kao(:, 4,10,11) = (/ & + & 0.66350e-01_r8,0.62044e-01_r8,0.57835e-01_r8,0.52180e-01_r8,0.46090e-01_r8, & + & 0.39573e-01_r8,0.32509e-01_r8,0.25642e-01_r8,0.22076e-01_r8 /) + kao(:, 5,10,11) = (/ & + & 0.65965e-01_r8,0.62105e-01_r8,0.57959e-01_r8,0.52489e-01_r8,0.46765e-01_r8, & + & 0.40717e-01_r8,0.34057e-01_r8,0.28015e-01_r8,0.24829e-01_r8 /) + kao(:, 1,11,11) = (/ & + & 0.69905e-01_r8,0.64410e-01_r8,0.59589e-01_r8,0.53150e-01_r8,0.45760e-01_r8, & + & 0.38179e-01_r8,0.29785e-01_r8,0.20444e-01_r8,0.16092e-01_r8 /) + kao(:, 2,11,11) = (/ & + & 0.69271e-01_r8,0.64175e-01_r8,0.59782e-01_r8,0.53281e-01_r8,0.46486e-01_r8, & + & 0.38949e-01_r8,0.30645e-01_r8,0.21725e-01_r8,0.17857e-01_r8 /) + kao(:, 3,11,11) = (/ & + & 0.69073e-01_r8,0.64491e-01_r8,0.59955e-01_r8,0.53684e-01_r8,0.46981e-01_r8, & + & 0.39609e-01_r8,0.31674e-01_r8,0.23165e-01_r8,0.20394e-01_r8 /) + kao(:, 4,11,11) = (/ & + & 0.68904e-01_r8,0.64793e-01_r8,0.60179e-01_r8,0.54162e-01_r8,0.47530e-01_r8, & + & 0.40495e-01_r8,0.32809e-01_r8,0.24930e-01_r8,0.23016e-01_r8 /) + kao(:, 5,11,11) = (/ & + & 0.68639e-01_r8,0.65010e-01_r8,0.60484e-01_r8,0.54605e-01_r8,0.48370e-01_r8, & + & 0.41561e-01_r8,0.34350e-01_r8,0.26933e-01_r8,0.26488e-01_r8 /) + kao(:, 1,12,11) = (/ & + & 0.71529e-01_r8,0.66044e-01_r8,0.61072e-01_r8,0.54140e-01_r8,0.46654e-01_r8, & + & 0.38794e-01_r8,0.29996e-01_r8,0.20236e-01_r8,0.16124e-01_r8 /) + kao(:, 2,12,11) = (/ & + & 0.71291e-01_r8,0.66315e-01_r8,0.61418e-01_r8,0.54500e-01_r8,0.47446e-01_r8, & + & 0.39590e-01_r8,0.30905e-01_r8,0.21401e-01_r8,0.17542e-01_r8 /) + kao(:, 3,12,11) = (/ & + & 0.71222e-01_r8,0.66826e-01_r8,0.61770e-01_r8,0.55219e-01_r8,0.48148e-01_r8, & + & 0.40334e-01_r8,0.31908e-01_r8,0.22727e-01_r8,0.19804e-01_r8 /) + kao(:, 4,12,11) = (/ & + & 0.71079e-01_r8,0.67236e-01_r8,0.62161e-01_r8,0.55849e-01_r8,0.48917e-01_r8, & + & 0.41311e-01_r8,0.33042e-01_r8,0.24356e-01_r8,0.21082e-01_r8 /) + kao(:, 5,12,11) = (/ & + & 0.70901e-01_r8,0.67518e-01_r8,0.62549e-01_r8,0.56439e-01_r8,0.49900e-01_r8, & + & 0.42406e-01_r8,0.34548e-01_r8,0.26106e-01_r8,0.23666e-01_r8 /) + kao(:, 1,13,11) = (/ & + & 0.73149e-01_r8,0.67708e-01_r8,0.62294e-01_r8,0.54947e-01_r8,0.47337e-01_r8, & + & 0.39165e-01_r8,0.30053e-01_r8,0.20069e-01_r8,0.15304e-01_r8 /) + kao(:, 2,13,11) = (/ & + & 0.73122e-01_r8,0.68287e-01_r8,0.62803e-01_r8,0.55664e-01_r8,0.48241e-01_r8, & + & 0.39986e-01_r8,0.31044e-01_r8,0.21133e-01_r8,0.17384e-01_r8 /) + kao(:, 3,13,11) = (/ & + & 0.73057e-01_r8,0.68826e-01_r8,0.63303e-01_r8,0.56536e-01_r8,0.49104e-01_r8, & + & 0.40926e-01_r8,0.32050e-01_r8,0.22349e-01_r8,0.18964e-01_r8 /) + kao(:, 4,13,11) = (/ & + & 0.73037e-01_r8,0.69286e-01_r8,0.63846e-01_r8,0.57252e-01_r8,0.50018e-01_r8, & + & 0.42025e-01_r8,0.33217e-01_r8,0.23850e-01_r8,0.20572e-01_r8 /) + kao(:, 5,13,11) = (/ & + & 0.73013e-01_r8,0.69604e-01_r8,0.64290e-01_r8,0.57954e-01_r8,0.51076e-01_r8, & + & 0.43212e-01_r8,0.34653e-01_r8,0.25391e-01_r8,0.23448e-01_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.43248e-01_r8,0.41017e-01_r8,0.40213e-01_r8,0.39821e-01_r8,0.45256e-01_r8, & + & 0.55821e-01_r8,0.66932e-01_r8,0.78037e-01_r8,0.88086e-01_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.42407e-01_r8,0.40307e-01_r8,0.40078e-01_r8,0.40681e-01_r8,0.47543e-01_r8, & + & 0.59099e-01_r8,0.70845e-01_r8,0.82585e-01_r8,0.93228e-01_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.41692e-01_r8,0.39727e-01_r8,0.39865e-01_r8,0.41830e-01_r8,0.50093e-01_r8, & + & 0.62450e-01_r8,0.74841e-01_r8,0.87232e-01_r8,0.98476e-01_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.41002e-01_r8,0.39248e-01_r8,0.39945e-01_r8,0.42942e-01_r8,0.52768e-01_r8, & + & 0.65829e-01_r8,0.78890e-01_r8,0.91937e-01_r8,0.10362e+00_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.40428e-01_r8,0.39045e-01_r8,0.40116e-01_r8,0.44981e-01_r8,0.56655e-01_r8, & + & 0.70681e-01_r8,0.84705e-01_r8,0.98731e-01_r8,0.11111e+00_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.47227e-01_r8,0.44198e-01_r8,0.42698e-01_r8,0.42511e-01_r8,0.46394e-01_r8, & + & 0.55784e-01_r8,0.66888e-01_r8,0.77989e-01_r8,0.88812e-01_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.46375e-01_r8,0.43473e-01_r8,0.42428e-01_r8,0.43299e-01_r8,0.48252e-01_r8, & + & 0.59000e-01_r8,0.70708e-01_r8,0.82423e-01_r8,0.93885e-01_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.45650e-01_r8,0.42988e-01_r8,0.42307e-01_r8,0.44252e-01_r8,0.50414e-01_r8, & + & 0.62373e-01_r8,0.74750e-01_r8,0.87127e-01_r8,0.99197e-01_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.44980e-01_r8,0.42686e-01_r8,0.42476e-01_r8,0.45355e-01_r8,0.53027e-01_r8, & + & 0.66067e-01_r8,0.79179e-01_r8,0.92288e-01_r8,0.10480e+00_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.44383e-01_r8,0.42475e-01_r8,0.42723e-01_r8,0.47155e-01_r8,0.57007e-01_r8, & + & 0.71138e-01_r8,0.85276e-01_r8,0.99396e-01_r8,0.11272e+00_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.51829e-01_r8,0.48303e-01_r8,0.45805e-01_r8,0.45348e-01_r8,0.47474e-01_r8, & + & 0.53773e-01_r8,0.64381e-01_r8,0.75065e-01_r8,0.85879e-01_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.50945e-01_r8,0.47626e-01_r8,0.45531e-01_r8,0.46104e-01_r8,0.48805e-01_r8, & + & 0.57008e-01_r8,0.68342e-01_r8,0.79675e-01_r8,0.91103e-01_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.50329e-01_r8,0.47163e-01_r8,0.45393e-01_r8,0.46795e-01_r8,0.50514e-01_r8, & + & 0.60488e-01_r8,0.72503e-01_r8,0.84519e-01_r8,0.96625e-01_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.49725e-01_r8,0.46894e-01_r8,0.45600e-01_r8,0.47784e-01_r8,0.52670e-01_r8, & + & 0.64382e-01_r8,0.77172e-01_r8,0.89966e-01_r8,0.10271e+00_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.49109e-01_r8,0.46633e-01_r8,0.45896e-01_r8,0.49191e-01_r8,0.56129e-01_r8, & + & 0.69438e-01_r8,0.83245e-01_r8,0.97061e-01_r8,0.11071e+00_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.57082e-01_r8,0.53110e-01_r8,0.49763e-01_r8,0.48460e-01_r8,0.48719e-01_r8, & + & 0.51181e-01_r8,0.59984e-01_r8,0.69952e-01_r8,0.80045e-01_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.56133e-01_r8,0.52450e-01_r8,0.49568e-01_r8,0.49064e-01_r8,0.49725e-01_r8, & + & 0.54041e-01_r8,0.64091e-01_r8,0.74728e-01_r8,0.85496e-01_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.55439e-01_r8,0.51866e-01_r8,0.49497e-01_r8,0.49475e-01_r8,0.51076e-01_r8, & + & 0.57243e-01_r8,0.68327e-01_r8,0.79652e-01_r8,0.91098e-01_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.54777e-01_r8,0.51575e-01_r8,0.49681e-01_r8,0.50221e-01_r8,0.52765e-01_r8, & + & 0.61084e-01_r8,0.73197e-01_r8,0.85337e-01_r8,0.97552e-01_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.54098e-01_r8,0.51233e-01_r8,0.49878e-01_r8,0.51295e-01_r8,0.55484e-01_r8, & + & 0.66162e-01_r8,0.79298e-01_r8,0.92434e-01_r8,0.10558e+00_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.62544e-01_r8,0.58281e-01_r8,0.54351e-01_r8,0.52107e-01_r8,0.50211e-01_r8, & + & 0.49416e-01_r8,0.54519e-01_r8,0.63528e-01_r8,0.72634e-01_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.61658e-01_r8,0.57644e-01_r8,0.54210e-01_r8,0.52563e-01_r8,0.50949e-01_r8, & + & 0.51794e-01_r8,0.58802e-01_r8,0.68560e-01_r8,0.78383e-01_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.60918e-01_r8,0.57016e-01_r8,0.54117e-01_r8,0.52719e-01_r8,0.52074e-01_r8, & + & 0.54457e-01_r8,0.63161e-01_r8,0.73629e-01_r8,0.84158e-01_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.60164e-01_r8,0.56692e-01_r8,0.54302e-01_r8,0.53086e-01_r8,0.53404e-01_r8, & + & 0.57689e-01_r8,0.68126e-01_r8,0.79422e-01_r8,0.90757e-01_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.59366e-01_r8,0.56267e-01_r8,0.54377e-01_r8,0.53811e-01_r8,0.55627e-01_r8, & + & 0.62331e-01_r8,0.74295e-01_r8,0.86596e-01_r8,0.98923e-01_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.68500e-01_r8,0.63504e-01_r8,0.59102e-01_r8,0.56112e-01_r8,0.52198e-01_r8, & + & 0.48725e-01_r8,0.49458e-01_r8,0.56540e-01_r8,0.64611e-01_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.67642e-01_r8,0.62951e-01_r8,0.59010e-01_r8,0.56509e-01_r8,0.52640e-01_r8, & + & 0.50781e-01_r8,0.53492e-01_r8,0.61845e-01_r8,0.70650e-01_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.66730e-01_r8,0.62270e-01_r8,0.58880e-01_r8,0.56541e-01_r8,0.53578e-01_r8, & + & 0.52912e-01_r8,0.57553e-01_r8,0.66900e-01_r8,0.76420e-01_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.65853e-01_r8,0.61851e-01_r8,0.59079e-01_r8,0.56674e-01_r8,0.54628e-01_r8, & + & 0.55405e-01_r8,0.62327e-01_r8,0.72621e-01_r8,0.82946e-01_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.64917e-01_r8,0.61395e-01_r8,0.59088e-01_r8,0.57140e-01_r8,0.56317e-01_r8, & + & 0.59242e-01_r8,0.68519e-01_r8,0.79819e-01_r8,0.91147e-01_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.74814e-01_r8,0.69115e-01_r8,0.63783e-01_r8,0.59970e-01_r8,0.54833e-01_r8, & + & 0.49011e-01_r8,0.46051e-01_r8,0.49756e-01_r8,0.56816e-01_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.73755e-01_r8,0.68509e-01_r8,0.63672e-01_r8,0.60441e-01_r8,0.55205e-01_r8, & + & 0.50759e-01_r8,0.49447e-01_r8,0.55044e-01_r8,0.62843e-01_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.72664e-01_r8,0.67698e-01_r8,0.63630e-01_r8,0.60499e-01_r8,0.55993e-01_r8, & + & 0.52467e-01_r8,0.52809e-01_r8,0.59966e-01_r8,0.68463e-01_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.71633e-01_r8,0.67174e-01_r8,0.63866e-01_r8,0.60581e-01_r8,0.56744e-01_r8, & + & 0.54377e-01_r8,0.56941e-01_r8,0.65640e-01_r8,0.74923e-01_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.70621e-01_r8,0.66745e-01_r8,0.63972e-01_r8,0.60930e-01_r8,0.57801e-01_r8, & + & 0.57488e-01_r8,0.62631e-01_r8,0.72711e-01_r8,0.82984e-01_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.81108e-01_r8,0.74731e-01_r8,0.68669e-01_r8,0.63699e-01_r8,0.57482e-01_r8, & + & 0.50207e-01_r8,0.44226e-01_r8,0.43565e-01_r8,0.49479e-01_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.79714e-01_r8,0.73898e-01_r8,0.68659e-01_r8,0.64276e-01_r8,0.57881e-01_r8, & + & 0.51786e-01_r8,0.46974e-01_r8,0.48378e-01_r8,0.55162e-01_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.78456e-01_r8,0.73135e-01_r8,0.68758e-01_r8,0.64370e-01_r8,0.58662e-01_r8, & + & 0.53164e-01_r8,0.49684e-01_r8,0.53168e-01_r8,0.60666e-01_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.77309e-01_r8,0.72680e-01_r8,0.69000e-01_r8,0.64433e-01_r8,0.59353e-01_r8, & + & 0.54540e-01_r8,0.53042e-01_r8,0.58717e-01_r8,0.66992e-01_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.76406e-01_r8,0.72288e-01_r8,0.69084e-01_r8,0.64775e-01_r8,0.60105e-01_r8, & + & 0.56876e-01_r8,0.57740e-01_r8,0.65467e-01_r8,0.74695e-01_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.87281e-01_r8,0.80336e-01_r8,0.73586e-01_r8,0.67589e-01_r8,0.60164e-01_r8, & + & 0.51553e-01_r8,0.43512e-01_r8,0.38366e-01_r8,0.42260e-01_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.85638e-01_r8,0.79229e-01_r8,0.73710e-01_r8,0.68169e-01_r8,0.60640e-01_r8, & + & 0.53028e-01_r8,0.45744e-01_r8,0.42413e-01_r8,0.47570e-01_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.84292e-01_r8,0.78481e-01_r8,0.73900e-01_r8,0.68269e-01_r8,0.61342e-01_r8, & + & 0.54381e-01_r8,0.47902e-01_r8,0.46760e-01_r8,0.52980e-01_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.83115e-01_r8,0.77996e-01_r8,0.74142e-01_r8,0.68304e-01_r8,0.62073e-01_r8, & + & 0.55597e-01_r8,0.50525e-01_r8,0.51779e-01_r8,0.58954e-01_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.82186e-01_r8,0.77706e-01_r8,0.74161e-01_r8,0.68663e-01_r8,0.62685e-01_r8, & + & 0.57315e-01_r8,0.54189e-01_r8,0.58003e-01_r8,0.66142e-01_r8 /) + kao(:, 1,10,12) = (/ & + & 0.93285e-01_r8,0.85813e-01_r8,0.78575e-01_r8,0.71552e-01_r8,0.62937e-01_r8, & + & 0.53130e-01_r8,0.43544e-01_r8,0.34852e-01_r8,0.25971e-01_r8 /) + kao(:, 2,10,12) = (/ & + & 0.91673e-01_r8,0.84652e-01_r8,0.78625e-01_r8,0.72093e-01_r8,0.63376e-01_r8, & + & 0.54541e-01_r8,0.45576e-01_r8,0.38102e-01_r8,0.28356e-01_r8 /) + kao(:, 3,10,12) = (/ & + & 0.90273e-01_r8,0.83828e-01_r8,0.78840e-01_r8,0.72190e-01_r8,0.64026e-01_r8, & + & 0.55889e-01_r8,0.47404e-01_r8,0.41695e-01_r8,0.31456e-01_r8 /) + kao(:, 4,10,12) = (/ & + & 0.88982e-01_r8,0.83233e-01_r8,0.79026e-01_r8,0.72231e-01_r8,0.64765e-01_r8, & + & 0.57025e-01_r8,0.49463e-01_r8,0.46003e-01_r8,0.35501e-01_r8 /) + kao(:, 5,10,12) = (/ & + & 0.88015e-01_r8,0.82954e-01_r8,0.78987e-01_r8,0.72605e-01_r8,0.65378e-01_r8, & + & 0.58432e-01_r8,0.52293e-01_r8,0.51371e-01_r8,0.39951e-01_r8 /) + kao(:, 1,11,12) = (/ & + & 0.98224e-01_r8,0.90470e-01_r8,0.83283e-01_r8,0.75729e-01_r8,0.65953e-01_r8, & + & 0.55333e-01_r8,0.44607e-01_r8,0.33712e-01_r8,0.29825e-01_r8 /) + kao(:, 2,11,12) = (/ & + & 0.96868e-01_r8,0.89565e-01_r8,0.83537e-01_r8,0.76001e-01_r8,0.66302e-01_r8, & + & 0.56711e-01_r8,0.46387e-01_r8,0.36339e-01_r8,0.33228e-01_r8 /) + kao(:, 3,11,12) = (/ & + & 0.95464e-01_r8,0.88759e-01_r8,0.83774e-01_r8,0.75894e-01_r8,0.67115e-01_r8, & + & 0.57847e-01_r8,0.48034e-01_r8,0.39456e-01_r8,0.36088e-01_r8 /) + kao(:, 4,11,12) = (/ & + & 0.94340e-01_r8,0.88366e-01_r8,0.83721e-01_r8,0.76044e-01_r8,0.67766e-01_r8, & + & 0.58947e-01_r8,0.50010e-01_r8,0.43247e-01_r8,0.40125e-01_r8 /) + kao(:, 5,11,12) = (/ & + & 0.93518e-01_r8,0.88039e-01_r8,0.83475e-01_r8,0.76422e-01_r8,0.68414e-01_r8, & + & 0.60495e-01_r8,0.52431e-01_r8,0.48069e-01_r8,0.44798e-01_r8 /) + kao(:, 1,12,12) = (/ & + & 0.10275e+00_r8,0.94729e-01_r8,0.87688e-01_r8,0.79394e-01_r8,0.68734e-01_r8, & + & 0.57476e-01_r8,0.45697e-01_r8,0.32943e-01_r8,0.29614e-01_r8 /) + kao(:, 2,12,12) = (/ & + & 0.10159e+00_r8,0.94167e-01_r8,0.88202e-01_r8,0.79488e-01_r8,0.69232e-01_r8, & + & 0.58694e-01_r8,0.47208e-01_r8,0.35215e-01_r8,0.33437e-01_r8 /) + kao(:, 3,12,12) = (/ & + & 0.10046e+00_r8,0.93671e-01_r8,0.88347e-01_r8,0.79409e-01_r8,0.69985e-01_r8, & + & 0.59703e-01_r8,0.48739e-01_r8,0.37920e-01_r8,0.36670e-01_r8 /) + kao(:, 4,12,12) = (/ & + & 0.99712e-01_r8,0.93473e-01_r8,0.88135e-01_r8,0.79671e-01_r8,0.70541e-01_r8, & + & 0.60786e-01_r8,0.50658e-01_r8,0.41158e-01_r8,0.41155e-01_r8 /) + kao(:, 5,12,12) = (/ & + & 0.99052e-01_r8,0.93236e-01_r8,0.87897e-01_r8,0.79933e-01_r8,0.71310e-01_r8, & + & 0.62364e-01_r8,0.52850e-01_r8,0.45390e-01_r8,0.47055e-01_r8 /) + kao(:, 1,13,12) = (/ & + & 0.10693e+00_r8,0.98594e-01_r8,0.91730e-01_r8,0.82575e-01_r8,0.71131e-01_r8, & + & 0.59390e-01_r8,0.46621e-01_r8,0.32428e-01_r8,0.26794e-01_r8 /) + kao(:, 2,13,12) = (/ & + & 0.10593e+00_r8,0.98329e-01_r8,0.92368e-01_r8,0.82651e-01_r8,0.71827e-01_r8, & + & 0.60538e-01_r8,0.47868e-01_r8,0.34468e-01_r8,0.29114e-01_r8 /) + kao(:, 3,13,12) = (/ & + & 0.10521e+00_r8,0.98305e-01_r8,0.92444e-01_r8,0.82725e-01_r8,0.72549e-01_r8, & + & 0.61456e-01_r8,0.49349e-01_r8,0.36800e-01_r8,0.32781e-01_r8 /) + kao(:, 4,13,12) = (/ & + & 0.10471e+00_r8,0.98393e-01_r8,0.92240e-01_r8,0.83082e-01_r8,0.73117e-01_r8, & + & 0.62504e-01_r8,0.51152e-01_r8,0.39616e-01_r8,0.37780e-01_r8 /) + kao(:, 5,13,12) = (/ & + & 0.10409e+00_r8,0.98364e-01_r8,0.92131e-01_r8,0.83350e-01_r8,0.73995e-01_r8, & + & 0.64047e-01_r8,0.53327e-01_r8,0.43375e-01_r8,0.42285e-01_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.52810e-01_r8,0.49450e-01_r8,0.49647e-01_r8,0.57104e-01_r8,0.73433e-01_r8, & + & 0.91743e-01_r8,0.11005e+00_r8,0.12834e+00_r8,0.14491e+00_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.51653e-01_r8,0.48971e-01_r8,0.50186e-01_r8,0.59440e-01_r8,0.77723e-01_r8, & + & 0.97098e-01_r8,0.11647e+00_r8,0.13583e+00_r8,0.15375e+00_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.50696e-01_r8,0.48582e-01_r8,0.50737e-01_r8,0.61667e-01_r8,0.81568e-01_r8, & + & 0.10190e+00_r8,0.12223e+00_r8,0.14254e+00_r8,0.16133e+00_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.49759e-01_r8,0.48321e-01_r8,0.51484e-01_r8,0.64441e-01_r8,0.85673e-01_r8, & + & 0.10703e+00_r8,0.12837e+00_r8,0.14971e+00_r8,0.16936e+00_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.48804e-01_r8,0.48067e-01_r8,0.52560e-01_r8,0.67354e-01_r8,0.89656e-01_r8, & + & 0.11200e+00_r8,0.13434e+00_r8,0.15666e+00_r8,0.17718e+00_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.57042e-01_r8,0.54069e-01_r8,0.53905e-01_r8,0.58729e-01_r8,0.73592e-01_r8, & + & 0.91941e-01_r8,0.11029e+00_r8,0.12863e+00_r8,0.14602e+00_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.55841e-01_r8,0.53550e-01_r8,0.54566e-01_r8,0.60781e-01_r8,0.78168e-01_r8, & + & 0.97652e-01_r8,0.11714e+00_r8,0.13661e+00_r8,0.15506e+00_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.54920e-01_r8,0.52981e-01_r8,0.54943e-01_r8,0.62919e-01_r8,0.82379e-01_r8, & + & 0.10292e+00_r8,0.12345e+00_r8,0.14397e+00_r8,0.16344e+00_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.54055e-01_r8,0.52591e-01_r8,0.55488e-01_r8,0.65511e-01_r8,0.86681e-01_r8, & + & 0.10829e+00_r8,0.12990e+00_r8,0.15147e+00_r8,0.17196e+00_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.53226e-01_r8,0.52334e-01_r8,0.56238e-01_r8,0.68429e-01_r8,0.90830e-01_r8, & + & 0.11345e+00_r8,0.13607e+00_r8,0.15868e+00_r8,0.17998e+00_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.62670e-01_r8,0.59309e-01_r8,0.58772e-01_r8,0.61122e-01_r8,0.72960e-01_r8, & + & 0.91113e-01_r8,0.10930e+00_r8,0.12747e+00_r8,0.14514e+00_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.61411e-01_r8,0.58632e-01_r8,0.59230e-01_r8,0.62688e-01_r8,0.77748e-01_r8, & + & 0.97139e-01_r8,0.11652e+00_r8,0.13590e+00_r8,0.15479e+00_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.60334e-01_r8,0.57923e-01_r8,0.59411e-01_r8,0.64539e-01_r8,0.82093e-01_r8, & + & 0.10257e+00_r8,0.12305e+00_r8,0.14350e+00_r8,0.16343e+00_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.59451e-01_r8,0.57416e-01_r8,0.59633e-01_r8,0.66820e-01_r8,0.86494e-01_r8, & + & 0.10804e+00_r8,0.12960e+00_r8,0.15112e+00_r8,0.17209e+00_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.58597e-01_r8,0.57143e-01_r8,0.60240e-01_r8,0.69594e-01_r8,0.91059e-01_r8, & + & 0.11373e+00_r8,0.13640e+00_r8,0.15905e+00_r8,0.18103e+00_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.69822e-01_r8,0.65601e-01_r8,0.63945e-01_r8,0.64755e-01_r8,0.73038e-01_r8, & + & 0.90165e-01_r8,0.10817e+00_r8,0.12616e+00_r8,0.14389e+00_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.68507e-01_r8,0.64727e-01_r8,0.64234e-01_r8,0.66213e-01_r8,0.77749e-01_r8, & + & 0.96668e-01_r8,0.11597e+00_r8,0.13524e+00_r8,0.15427e+00_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.67276e-01_r8,0.63962e-01_r8,0.64238e-01_r8,0.67909e-01_r8,0.82185e-01_r8, & + & 0.10254e+00_r8,0.12301e+00_r8,0.14345e+00_r8,0.16365e+00_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.66381e-01_r8,0.63334e-01_r8,0.64220e-01_r8,0.69770e-01_r8,0.86724e-01_r8, & + & 0.10832e+00_r8,0.12994e+00_r8,0.15151e+00_r8,0.17282e+00_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.65437e-01_r8,0.62972e-01_r8,0.64673e-01_r8,0.72222e-01_r8,0.91630e-01_r8, & + & 0.11445e+00_r8,0.13728e+00_r8,0.16006e+00_r8,0.18257e+00_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.78344e-01_r8,0.73091e-01_r8,0.69713e-01_r8,0.69214e-01_r8,0.74668e-01_r8, & + & 0.88915e-01_r8,0.10667e+00_r8,0.12441e+00_r8,0.14209e+00_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.76773e-01_r8,0.71981e-01_r8,0.69752e-01_r8,0.70736e-01_r8,0.78904e-01_r8, & + & 0.95797e-01_r8,0.11493e+00_r8,0.13406e+00_r8,0.15311e+00_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.75310e-01_r8,0.71068e-01_r8,0.69651e-01_r8,0.72503e-01_r8,0.83070e-01_r8, & + & 0.10214e+00_r8,0.12251e+00_r8,0.14289e+00_r8,0.16320e+00_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.74250e-01_r8,0.70202e-01_r8,0.69499e-01_r8,0.74333e-01_r8,0.87301e-01_r8, & + & 0.10818e+00_r8,0.12976e+00_r8,0.15132e+00_r8,0.17281e+00_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.73209e-01_r8,0.69739e-01_r8,0.69847e-01_r8,0.76315e-01_r8,0.91870e-01_r8, & + & 0.11438e+00_r8,0.13720e+00_r8,0.16000e+00_r8,0.18274e+00_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.87696e-01_r8,0.81522e-01_r8,0.76509e-01_r8,0.74345e-01_r8,0.77107e-01_r8, & + & 0.86456e-01_r8,0.10266e+00_r8,0.11975e+00_r8,0.13684e+00_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.85834e-01_r8,0.80104e-01_r8,0.76319e-01_r8,0.75879e-01_r8,0.80970e-01_r8, & + & 0.93234e-01_r8,0.11135e+00_r8,0.12988e+00_r8,0.14843e+00_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.84103e-01_r8,0.79034e-01_r8,0.76204e-01_r8,0.77685e-01_r8,0.84459e-01_r8, & + & 0.99600e-01_r8,0.11936e+00_r8,0.13921e+00_r8,0.15907e+00_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.82699e-01_r8,0.78102e-01_r8,0.75915e-01_r8,0.79277e-01_r8,0.87923e-01_r8, & + & 0.10572e+00_r8,0.12681e+00_r8,0.14791e+00_r8,0.16901e+00_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.81604e-01_r8,0.77529e-01_r8,0.76175e-01_r8,0.80727e-01_r8,0.91640e-01_r8, & + & 0.11182e+00_r8,0.13414e+00_r8,0.15644e+00_r8,0.17875e+00_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.97322e-01_r8,0.90329e-01_r8,0.84313e-01_r8,0.80452e-01_r8,0.80118e-01_r8, & + & 0.84204e-01_r8,0.96138e-01_r8,0.11212e+00_r8,0.12812e+00_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.95378e-01_r8,0.88856e-01_r8,0.83999e-01_r8,0.81744e-01_r8,0.83529e-01_r8, & + & 0.90072e-01_r8,0.10504e+00_r8,0.12254e+00_r8,0.14003e+00_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.93471e-01_r8,0.87725e-01_r8,0.83968e-01_r8,0.83424e-01_r8,0.86362e-01_r8, & + & 0.95913e-01_r8,0.11338e+00_r8,0.13227e+00_r8,0.15114e+00_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.91861e-01_r8,0.86679e-01_r8,0.83638e-01_r8,0.84829e-01_r8,0.89126e-01_r8, & + & 0.10167e+00_r8,0.12111e+00_r8,0.14127e+00_r8,0.16142e+00_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.90669e-01_r8,0.86079e-01_r8,0.83677e-01_r8,0.85955e-01_r8,0.92165e-01_r8, & + & 0.10751e+00_r8,0.12862e+00_r8,0.15005e+00_r8,0.17145e+00_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.10748e+00_r8,0.99760e-01_r8,0.92641e-01_r8,0.87386e-01_r8,0.83918e-01_r8, & + & 0.82807e-01_r8,0.88461e-01_r8,0.10199e+00_r8,0.11655e+00_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.10548e+00_r8,0.98347e-01_r8,0.92153e-01_r8,0.88724e-01_r8,0.86807e-01_r8, & + & 0.87435e-01_r8,0.96918e-01_r8,0.11262e+00_r8,0.12866e+00_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.10345e+00_r8,0.96941e-01_r8,0.92269e-01_r8,0.90148e-01_r8,0.89023e-01_r8, & + & 0.92390e-01_r8,0.10517e+00_r8,0.12260e+00_r8,0.14006e+00_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.10168e+00_r8,0.95648e-01_r8,0.92050e-01_r8,0.91217e-01_r8,0.91169e-01_r8, & + & 0.97530e-01_r8,0.11302e+00_r8,0.13185e+00_r8,0.15061e+00_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.10031e+00_r8,0.94918e-01_r8,0.92030e-01_r8,0.91944e-01_r8,0.93599e-01_r8, & + & 0.10280e+00_r8,0.12083e+00_r8,0.14095e+00_r8,0.16101e+00_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.11850e+00_r8,0.10963e+00_r8,0.10118e+00_r8,0.94592e-01_r8,0.88496e-01_r8, & + & 0.82777e-01_r8,0.81368e-01_r8,0.90482e-01_r8,0.10334e+00_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.11636e+00_r8,0.10836e+00_r8,0.10080e+00_r8,0.96151e-01_r8,0.90961e-01_r8, & + & 0.86437e-01_r8,0.88759e-01_r8,0.10103e+00_r8,0.11540e+00_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.11416e+00_r8,0.10675e+00_r8,0.10109e+00_r8,0.97591e-01_r8,0.92676e-01_r8, & + & 0.90148e-01_r8,0.96288e-01_r8,0.11094e+00_r8,0.12669e+00_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.11214e+00_r8,0.10527e+00_r8,0.10096e+00_r8,0.98437e-01_r8,0.94256e-01_r8, & + & 0.94326e-01_r8,0.10386e+00_r8,0.12050e+00_r8,0.13763e+00_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.11054e+00_r8,0.10425e+00_r8,0.10085e+00_r8,0.98717e-01_r8,0.96200e-01_r8, & + & 0.98935e-01_r8,0.11173e+00_r8,0.13010e+00_r8,0.14859e+00_r8 /) + kao(:, 1,10,13) = (/ & + & 0.13016e+00_r8,0.11986e+00_r8,0.10995e+00_r8,0.10196e+00_r8,0.93774e-01_r8, & + & 0.84360e-01_r8,0.76878e-01_r8,0.79680e-01_r8,0.67359e-01_r8 /) + kao(:, 2,10,13) = (/ & + & 0.12774e+00_r8,0.11853e+00_r8,0.10979e+00_r8,0.10367e+00_r8,0.96160e-01_r8, & + & 0.87173e-01_r8,0.82710e-01_r8,0.89689e-01_r8,0.82456e-01_r8 /) + kao(:, 3,10,13) = (/ & + & 0.12531e+00_r8,0.11685e+00_r8,0.11022e+00_r8,0.10509e+00_r8,0.97450e-01_r8, & + & 0.90061e-01_r8,0.89222e-01_r8,0.99588e-01_r8,0.96338e-01_r8 /) + kao(:, 4,10,13) = (/ & + & 0.12312e+00_r8,0.11523e+00_r8,0.11015e+00_r8,0.10584e+00_r8,0.98534e-01_r8, & + & 0.93531e-01_r8,0.96262e-01_r8,0.10942e+00_r8,0.11043e+00_r8 /) + kao(:, 5,10,13) = (/ & + & 0.12128e+00_r8,0.11400e+00_r8,0.10998e+00_r8,0.10588e+00_r8,0.10008e+00_r8, & + & 0.97359e-01_r8,0.10364e+00_r8,0.11932e+00_r8,0.12582e+00_r8 /) + kao(:, 1,11,13) = (/ & + & 0.14105e+00_r8,0.12987e+00_r8,0.11910e+00_r8,0.11026e+00_r8,0.10035e+00_r8, & + & 0.88081e-01_r8,0.76687e-01_r8,0.74205e-01_r8,0.50899e-01_r8 /) + kao(:, 2,11,13) = (/ & + & 0.13825e+00_r8,0.12810e+00_r8,0.11908e+00_r8,0.11198e+00_r8,0.10215e+00_r8, & + & 0.90197e-01_r8,0.81650e-01_r8,0.83605e-01_r8,0.56975e-01_r8 /) + kao(:, 3,11,13) = (/ & + & 0.13566e+00_r8,0.12624e+00_r8,0.11939e+00_r8,0.11316e+00_r8,0.10299e+00_r8, & + & 0.92874e-01_r8,0.87279e-01_r8,0.93203e-01_r8,0.64736e-01_r8 /) + kao(:, 4,11,13) = (/ & + & 0.13334e+00_r8,0.12460e+00_r8,0.11935e+00_r8,0.11337e+00_r8,0.10395e+00_r8, & + & 0.95956e-01_r8,0.93410e-01_r8,0.10293e+00_r8,0.71284e-01_r8 /) + kao(:, 5,11,13) = (/ & + & 0.13131e+00_r8,0.12363e+00_r8,0.11937e+00_r8,0.11314e+00_r8,0.10517e+00_r8, & + & 0.98969e-01_r8,0.10016e+00_r8,0.11304e+00_r8,0.78587e-01_r8 /) + kao(:, 1,12,13) = (/ & + & 0.15212e+00_r8,0.13991e+00_r8,0.12851e+00_r8,0.11872e+00_r8,0.10663e+00_r8, & + & 0.91867e-01_r8,0.77350e-01_r8,0.69757e-01_r8,0.57657e-01_r8 /) + kao(:, 2,12,13) = (/ & + & 0.14895e+00_r8,0.13760e+00_r8,0.12846e+00_r8,0.12032e+00_r8,0.10790e+00_r8, & + & 0.93798e-01_r8,0.81816e-01_r8,0.78361e-01_r8,0.63811e-01_r8 /) + kao(:, 3,12,13) = (/ & + & 0.14609e+00_r8,0.13558e+00_r8,0.12854e+00_r8,0.12100e+00_r8,0.10856e+00_r8, & + & 0.96260e-01_r8,0.86684e-01_r8,0.87192e-01_r8,0.72200e-01_r8 /) + kao(:, 4,12,13) = (/ & + & 0.14343e+00_r8,0.13400e+00_r8,0.12849e+00_r8,0.12073e+00_r8,0.10951e+00_r8, & + & 0.98753e-01_r8,0.91530e-01_r8,0.96391e-01_r8,0.79517e-01_r8 /) + kao(:, 5,12,13) = (/ & + & 0.14120e+00_r8,0.13303e+00_r8,0.12833e+00_r8,0.12041e+00_r8,0.11038e+00_r8, & + & 0.10129e+00_r8,0.97562e-01_r8,0.10658e+00_r8,0.84371e-01_r8 /) + kao(:, 1,13,13) = (/ & + & 0.16284e+00_r8,0.14976e+00_r8,0.13792e+00_r8,0.12684e+00_r8,0.11275e+00_r8, & + & 0.95645e-01_r8,0.78767e-01_r8,0.66366e-01_r8,0.59038e-01_r8 /) + kao(:, 2,13,13) = (/ & + & 0.15947e+00_r8,0.14721e+00_r8,0.13779e+00_r8,0.12800e+00_r8,0.11359e+00_r8, & + & 0.97597e-01_r8,0.82782e-01_r8,0.73753e-01_r8,0.67374e-01_r8 /) + kao(:, 3,13,13) = (/ & + & 0.15626e+00_r8,0.14498e+00_r8,0.13763e+00_r8,0.12811e+00_r8,0.11414e+00_r8, & + & 0.99826e-01_r8,0.86643e-01_r8,0.81525e-01_r8,0.75874e-01_r8 /) + kao(:, 4,13,13) = (/ & + & 0.15335e+00_r8,0.14330e+00_r8,0.13746e+00_r8,0.12758e+00_r8,0.11501e+00_r8, & + & 0.10172e+00_r8,0.90750e-01_r8,0.90246e-01_r8,0.81744e-01_r8 /) + kao(:, 5,13,13) = (/ & + & 0.15088e+00_r8,0.14217e+00_r8,0.13690e+00_r8,0.12723e+00_r8,0.11557e+00_r8, & + & 0.10388e+00_r8,0.96218e-01_r8,0.10042e+00_r8,0.88529e-01_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.62837e-01_r8,0.60695e-01_r8,0.77720e-01_r8,0.11279e+00_r8,0.15033e+00_r8, & + & 0.18788e+00_r8,0.22539e+00_r8,0.26284e+00_r8,0.29421e+00_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.61599e-01_r8,0.60148e-01_r8,0.79591e-01_r8,0.11750e+00_r8,0.15661e+00_r8, & + & 0.19570e+00_r8,0.23478e+00_r8,0.27378e+00_r8,0.30578e+00_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.60827e-01_r8,0.59792e-01_r8,0.82175e-01_r8,0.12253e+00_r8,0.16330e+00_r8, & + & 0.20407e+00_r8,0.24482e+00_r8,0.28548e+00_r8,0.31829e+00_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.60773e-01_r8,0.59852e-01_r8,0.85295e-01_r8,0.12765e+00_r8,0.17012e+00_r8, & + & 0.21258e+00_r8,0.25502e+00_r8,0.29736e+00_r8,0.33114e+00_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.60579e-01_r8,0.60436e-01_r8,0.88993e-01_r8,0.13334e+00_r8,0.17771e+00_r8, & + & 0.22206e+00_r8,0.26642e+00_r8,0.31066e+00_r8,0.34557e+00_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.70150e-01_r8,0.67933e-01_r8,0.82763e-01_r8,0.11770e+00_r8,0.15687e+00_r8, & + & 0.19605e+00_r8,0.23520e+00_r8,0.27426e+00_r8,0.30923e+00_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.68737e-01_r8,0.67168e-01_r8,0.84453e-01_r8,0.12329e+00_r8,0.16434e+00_r8, & + & 0.20537e+00_r8,0.24638e+00_r8,0.28735e+00_r8,0.32358e+00_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.67693e-01_r8,0.66713e-01_r8,0.87076e-01_r8,0.12893e+00_r8,0.17184e+00_r8, & + & 0.21474e+00_r8,0.25764e+00_r8,0.30044e+00_r8,0.33811e+00_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.67352e-01_r8,0.66652e-01_r8,0.90088e-01_r8,0.13441e+00_r8,0.17914e+00_r8, & + & 0.22388e+00_r8,0.26860e+00_r8,0.31321e+00_r8,0.35245e+00_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.66923e-01_r8,0.67069e-01_r8,0.93870e-01_r8,0.14034e+00_r8,0.18704e+00_r8, & + & 0.23374e+00_r8,0.28042e+00_r8,0.32702e+00_r8,0.36794e+00_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.79385e-01_r8,0.76263e-01_r8,0.87808e-01_r8,0.12001e+00_r8,0.15997e+00_r8, & + & 0.19992e+00_r8,0.23984e+00_r8,0.27971e+00_r8,0.31814e+00_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.77666e-01_r8,0.75357e-01_r8,0.89439e-01_r8,0.12673e+00_r8,0.16892e+00_r8, & + & 0.21110e+00_r8,0.25327e+00_r8,0.29539e+00_r8,0.33569e+00_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.76193e-01_r8,0.74694e-01_r8,0.92082e-01_r8,0.13335e+00_r8,0.17774e+00_r8, & + & 0.22213e+00_r8,0.26651e+00_r8,0.31084e+00_r8,0.35313e+00_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.75335e-01_r8,0.74405e-01_r8,0.95067e-01_r8,0.13953e+00_r8,0.18597e+00_r8, & + & 0.23241e+00_r8,0.27884e+00_r8,0.32518e+00_r8,0.36942e+00_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.74635e-01_r8,0.74698e-01_r8,0.98457e-01_r8,0.14565e+00_r8,0.19414e+00_r8, & + & 0.24262e+00_r8,0.29108e+00_r8,0.33947e+00_r8,0.38555e+00_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.89595e-01_r8,0.85781e-01_r8,0.93997e-01_r8,0.12072e+00_r8,0.16001e+00_r8, & + & 0.19998e+00_r8,0.23994e+00_r8,0.27984e+00_r8,0.31934e+00_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.87421e-01_r8,0.84747e-01_r8,0.95233e-01_r8,0.12788e+00_r8,0.17024e+00_r8, & + & 0.21274e+00_r8,0.25525e+00_r8,0.29772e+00_r8,0.33967e+00_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.85503e-01_r8,0.83808e-01_r8,0.97531e-01_r8,0.13512e+00_r8,0.18009e+00_r8, & + & 0.22508e+00_r8,0.27005e+00_r8,0.31493e+00_r8,0.35929e+00_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.84061e-01_r8,0.83216e-01_r8,0.10039e+00_r8,0.14194e+00_r8,0.18919e+00_r8, & + & 0.23644e+00_r8,0.28372e+00_r8,0.33088e+00_r8,0.37743e+00_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.83141e-01_r8,0.83249e-01_r8,0.10352e+00_r8,0.14853e+00_r8,0.19798e+00_r8, & + & 0.24744e+00_r8,0.29688e+00_r8,0.34622e+00_r8,0.39491e+00_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.10093e+00_r8,0.96180e-01_r8,0.10202e+00_r8,0.12191e+00_r8,0.15810e+00_r8, & + & 0.19761e+00_r8,0.23710e+00_r8,0.27651e+00_r8,0.31584e+00_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.98348e-01_r8,0.95154e-01_r8,0.10279e+00_r8,0.12897e+00_r8,0.16954e+00_r8, & + & 0.21190e+00_r8,0.25425e+00_r8,0.29655e+00_r8,0.33869e+00_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.96078e-01_r8,0.94065e-01_r8,0.10459e+00_r8,0.13623e+00_r8,0.18035e+00_r8, & + & 0.22539e+00_r8,0.27041e+00_r8,0.31537e+00_r8,0.36019e+00_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.94202e-01_r8,0.93296e-01_r8,0.10703e+00_r8,0.14326e+00_r8,0.19057e+00_r8, & + & 0.23817e+00_r8,0.28575e+00_r8,0.33330e+00_r8,0.38060e+00_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.93055e-01_r8,0.92935e-01_r8,0.10982e+00_r8,0.15042e+00_r8,0.20048e+00_r8, & + & 0.25056e+00_r8,0.30061e+00_r8,0.35061e+00_r8,0.40035e+00_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.11421e+00_r8,0.10796e+00_r8,0.11173e+00_r8,0.12476e+00_r8,0.15549e+00_r8, & + & 0.19408e+00_r8,0.23286e+00_r8,0.27161e+00_r8,0.31032e+00_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.11123e+00_r8,0.10718e+00_r8,0.11218e+00_r8,0.13121e+00_r8,0.16775e+00_r8, & + & 0.20966e+00_r8,0.25155e+00_r8,0.29340e+00_r8,0.33523e+00_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.10875e+00_r8,0.10588e+00_r8,0.11334e+00_r8,0.13798e+00_r8,0.17972e+00_r8, & + & 0.22462e+00_r8,0.26950e+00_r8,0.31433e+00_r8,0.35914e+00_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.10666e+00_r8,0.10458e+00_r8,0.11529e+00_r8,0.14519e+00_r8,0.19132e+00_r8, & + & 0.23911e+00_r8,0.28688e+00_r8,0.33463e+00_r8,0.38232e+00_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.10502e+00_r8,0.10381e+00_r8,0.11770e+00_r8,0.15287e+00_r8,0.20267e+00_r8, & + & 0.25329e+00_r8,0.30392e+00_r8,0.35446e+00_r8,0.40496e+00_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.12988e+00_r8,0.12138e+00_r8,0.12291e+00_r8,0.12930e+00_r8,0.15315e+00_r8, & + & 0.18907e+00_r8,0.22686e+00_r8,0.26460e+00_r8,0.30239e+00_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.12649e+00_r8,0.12054e+00_r8,0.12314e+00_r8,0.13530e+00_r8,0.16601e+00_r8, & + & 0.20667e+00_r8,0.24798e+00_r8,0.28925e+00_r8,0.33056e+00_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.12370e+00_r8,0.11924e+00_r8,0.12400e+00_r8,0.14174e+00_r8,0.17907e+00_r8, & + & 0.22369e+00_r8,0.26838e+00_r8,0.31304e+00_r8,0.35775e+00_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.12121e+00_r8,0.11770e+00_r8,0.12551e+00_r8,0.14889e+00_r8,0.19207e+00_r8, & + & 0.24005e+00_r8,0.28802e+00_r8,0.33592e+00_r8,0.38391e+00_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.11892e+00_r8,0.11635e+00_r8,0.12739e+00_r8,0.15666e+00_r8,0.20470e+00_r8, & + & 0.25583e+00_r8,0.30694e+00_r8,0.35802e+00_r8,0.40917e+00_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.14795e+00_r8,0.13669e+00_r8,0.13564e+00_r8,0.13646e+00_r8,0.15231e+00_r8, & + & 0.18310e+00_r8,0.21966e+00_r8,0.25622e+00_r8,0.29284e+00_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.14430e+00_r8,0.13540e+00_r8,0.13550e+00_r8,0.14118e+00_r8,0.16490e+00_r8, & + & 0.20238e+00_r8,0.24284e+00_r8,0.28324e+00_r8,0.32374e+00_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.14109e+00_r8,0.13403e+00_r8,0.13585e+00_r8,0.14713e+00_r8,0.17836e+00_r8, & + & 0.22126e+00_r8,0.26548e+00_r8,0.30963e+00_r8,0.35392e+00_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.13807e+00_r8,0.13250e+00_r8,0.13707e+00_r8,0.15422e+00_r8,0.19232e+00_r8, & + & 0.23967e+00_r8,0.28757e+00_r8,0.33540e+00_r8,0.38338e+00_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.13514e+00_r8,0.13080e+00_r8,0.13878e+00_r8,0.16197e+00_r8,0.20594e+00_r8, & + & 0.25719e+00_r8,0.30860e+00_r8,0.35994e+00_r8,0.41142e+00_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.16812e+00_r8,0.15406e+00_r8,0.15051e+00_r8,0.14632e+00_r8,0.15371e+00_r8, & + & 0.17730e+00_r8,0.21108e+00_r8,0.24622e+00_r8,0.28143e+00_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.16420e+00_r8,0.15230e+00_r8,0.14950e+00_r8,0.14998e+00_r8,0.16549e+00_r8, & + & 0.19706e+00_r8,0.23609e+00_r8,0.27539e+00_r8,0.31477e+00_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.16053e+00_r8,0.15077e+00_r8,0.14903e+00_r8,0.15488e+00_r8,0.17883e+00_r8, & + & 0.21740e+00_r8,0.26082e+00_r8,0.30423e+00_r8,0.34775e+00_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.15694e+00_r8,0.14891e+00_r8,0.14991e+00_r8,0.16140e+00_r8,0.19301e+00_r8, & + & 0.23753e+00_r8,0.28500e+00_r8,0.33244e+00_r8,0.37999e+00_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.15342e+00_r8,0.14670e+00_r8,0.15145e+00_r8,0.16838e+00_r8,0.20634e+00_r8, & + & 0.25567e+00_r8,0.30677e+00_r8,0.35784e+00_r8,0.40903e+00_r8 /) + kao(:, 1,10,14) = (/ & + & 0.18962e+00_r8,0.17319e+00_r8,0.16709e+00_r8,0.15817e+00_r8,0.15908e+00_r8, & + & 0.17425e+00_r8,0.20287e+00_r8,0.23665e+00_r8,0.27049e+00_r8 /) + kao(:, 2,10,14) = (/ & + & 0.18536e+00_r8,0.17110e+00_r8,0.16526e+00_r8,0.16124e+00_r8,0.16946e+00_r8, & + & 0.19394e+00_r8,0.22959e+00_r8,0.26781e+00_r8,0.30611e+00_r8 /) + kao(:, 3,10,14) = (/ & + & 0.18117e+00_r8,0.16910e+00_r8,0.16400e+00_r8,0.16579e+00_r8,0.18236e+00_r8, & + & 0.21466e+00_r8,0.25610e+00_r8,0.29874e+00_r8,0.34146e+00_r8 /) + kao(:, 4,10,14) = (/ & + & 0.17697e+00_r8,0.16677e+00_r8,0.16446e+00_r8,0.17161e+00_r8,0.19589e+00_r8, & + & 0.23479e+00_r8,0.28114e+00_r8,0.32796e+00_r8,0.37484e+00_r8 /) + kao(:, 5,10,14) = (/ & + & 0.17281e+00_r8,0.16399e+00_r8,0.16565e+00_r8,0.17716e+00_r8,0.20808e+00_r8, & + & 0.25277e+00_r8,0.30323e+00_r8,0.35372e+00_r8,0.40429e+00_r8 /) + kao(:, 1,11,14) = (/ & + & 0.21055e+00_r8,0.19254e+00_r8,0.18359e+00_r8,0.17274e+00_r8,0.17137e+00_r8, & + & 0.18167e+00_r8,0.20669e+00_r8,0.24044e+00_r8,0.24447e+00_r8 /) + kao(:, 2,11,14) = (/ & + & 0.20570e+00_r8,0.19011e+00_r8,0.18168e+00_r8,0.17577e+00_r8,0.18167e+00_r8, & + & 0.20144e+00_r8,0.23412e+00_r8,0.27305e+00_r8,0.28987e+00_r8 /) + kao(:, 3,11,14) = (/ & + & 0.20088e+00_r8,0.18755e+00_r8,0.18057e+00_r8,0.18058e+00_r8,0.19347e+00_r8, & + & 0.22124e+00_r8,0.26062e+00_r8,0.30406e+00_r8,0.33203e+00_r8 /) + kao(:, 4,11,14) = (/ & + & 0.19608e+00_r8,0.18439e+00_r8,0.18082e+00_r8,0.18569e+00_r8,0.20488e+00_r8, & + & 0.23927e+00_r8,0.28460e+00_r8,0.33201e+00_r8,0.37191e+00_r8 /) + kao(:, 5,11,14) = (/ & + & 0.19134e+00_r8,0.18083e+00_r8,0.18137e+00_r8,0.19023e+00_r8,0.21563e+00_r8, & + & 0.25670e+00_r8,0.30697e+00_r8,0.35809e+00_r8,0.40924e+00_r8 /) + kao(:, 1,12,14) = (/ & + & 0.23222e+00_r8,0.21282e+00_r8,0.20059e+00_r8,0.18856e+00_r8,0.18455e+00_r8, & + & 0.18954e+00_r8,0.20921e+00_r8,0.24116e+00_r8,0.20678e+00_r8 /) + kao(:, 2,12,14) = (/ & + & 0.22666e+00_r8,0.20982e+00_r8,0.19853e+00_r8,0.19166e+00_r8,0.19460e+00_r8, & + & 0.20805e+00_r8,0.23602e+00_r8,0.27405e+00_r8,0.24947e+00_r8 /) + kao(:, 3,12,14) = (/ & + & 0.22121e+00_r8,0.20649e+00_r8,0.19756e+00_r8,0.19621e+00_r8,0.20452e+00_r8, & + & 0.22597e+00_r8,0.26146e+00_r8,0.30478e+00_r8,0.28725e+00_r8 /) + kao(:, 4,12,14) = (/ & + & 0.21578e+00_r8,0.20240e+00_r8,0.19746e+00_r8,0.20035e+00_r8,0.21392e+00_r8, & + & 0.24302e+00_r8,0.28559e+00_r8,0.33317e+00_r8,0.32415e+00_r8 /) + kao(:, 5,12,14) = (/ & + & 0.21026e+00_r8,0.19816e+00_r8,0.19729e+00_r8,0.20402e+00_r8,0.22339e+00_r8, & + & 0.25983e+00_r8,0.30840e+00_r8,0.35980e+00_r8,0.36272e+00_r8 /) + kao(:, 1,13,14) = (/ & + & 0.25447e+00_r8,0.23356e+00_r8,0.21785e+00_r8,0.20504e+00_r8,0.19797e+00_r8, & + & 0.19705e+00_r8,0.20967e+00_r8,0.23794e+00_r8,0.19657e+00_r8 /) + kao(:, 2,13,14) = (/ & + & 0.24820e+00_r8,0.22981e+00_r8,0.21561e+00_r8,0.20828e+00_r8,0.20711e+00_r8, & + & 0.21347e+00_r8,0.23520e+00_r8,0.27088e+00_r8,0.23547e+00_r8 /) + kao(:, 3,13,14) = (/ & + & 0.24206e+00_r8,0.22556e+00_r8,0.21467e+00_r8,0.21216e+00_r8,0.21525e+00_r8, & + & 0.22938e+00_r8,0.25994e+00_r8,0.30180e+00_r8,0.27108e+00_r8 /) + kao(:, 4,13,14) = (/ & + & 0.23572e+00_r8,0.22056e+00_r8,0.21408e+00_r8,0.21517e+00_r8,0.22293e+00_r8, & + & 0.24576e+00_r8,0.28399e+00_r8,0.33091e+00_r8,0.30909e+00_r8 /) + kao(:, 5,13,14) = (/ & + & 0.22932e+00_r8,0.21557e+00_r8,0.21287e+00_r8,0.21778e+00_r8,0.23130e+00_r8, & + & 0.26208e+00_r8,0.30701e+00_r8,0.35815e+00_r8,0.34602e+00_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.79223e-01_r8,0.75104e-01_r8,0.13846e+00_r8,0.20766e+00_r8,0.27685e+00_r8, & + & 0.34601e+00_r8,0.41512e+00_r8,0.48397e+00_r8,0.52564e+00_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.76682e-01_r8,0.76450e-01_r8,0.14571e+00_r8,0.21854e+00_r8,0.29137e+00_r8, & + & 0.36417e+00_r8,0.43689e+00_r8,0.50929e+00_r8,0.55383e+00_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.74345e-01_r8,0.78213e-01_r8,0.15207e+00_r8,0.22808e+00_r8,0.30407e+00_r8, & + & 0.38004e+00_r8,0.45593e+00_r8,0.53155e+00_r8,0.57851e+00_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.72607e-01_r8,0.80130e-01_r8,0.15758e+00_r8,0.23638e+00_r8,0.31513e+00_r8, & + & 0.39385e+00_r8,0.47252e+00_r8,0.55092e+00_r8,0.60005e+00_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.72847e-01_r8,0.82433e-01_r8,0.16249e+00_r8,0.24371e+00_r8,0.32491e+00_r8, & + & 0.40606e+00_r8,0.48713e+00_r8,0.56790e+00_r8,0.61880e+00_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.89010e-01_r8,0.84748e-01_r8,0.15528e+00_r8,0.23291e+00_r8,0.31052e+00_r8, & + & 0.38812e+00_r8,0.46559e+00_r8,0.54282e+00_r8,0.60189e+00_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.86286e-01_r8,0.86390e-01_r8,0.16350e+00_r8,0.24523e+00_r8,0.32694e+00_r8, & + & 0.40865e+00_r8,0.49029e+00_r8,0.57166e+00_r8,0.63436e+00_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.83865e-01_r8,0.88469e-01_r8,0.17076e+00_r8,0.25611e+00_r8,0.34145e+00_r8, & + & 0.42675e+00_r8,0.51202e+00_r8,0.59693e+00_r8,0.66276e+00_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.81971e-01_r8,0.90581e-01_r8,0.17733e+00_r8,0.26595e+00_r8,0.35459e+00_r8, & + & 0.44319e+00_r8,0.53165e+00_r8,0.61981e+00_r8,0.68802e+00_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.81826e-01_r8,0.93085e-01_r8,0.18319e+00_r8,0.27476e+00_r8,0.36629e+00_r8, & + & 0.45781e+00_r8,0.54921e+00_r8,0.64033e+00_r8,0.71080e+00_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.10078e+00_r8,0.96469e-01_r8,0.17126e+00_r8,0.25687e+00_r8,0.34247e+00_r8, & + & 0.42804e+00_r8,0.51357e+00_r8,0.59868e+00_r8,0.67473e+00_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.97698e-01_r8,0.98193e-01_r8,0.18058e+00_r8,0.27084e+00_r8,0.36108e+00_r8, & + & 0.45128e+00_r8,0.54134e+00_r8,0.63128e+00_r8,0.71182e+00_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.95186e-01_r8,0.10027e+00_r8,0.18871e+00_r8,0.28303e+00_r8,0.37733e+00_r8, & + & 0.47160e+00_r8,0.56577e+00_r8,0.65972e+00_r8,0.74408e+00_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.93223e-01_r8,0.10231e+00_r8,0.19621e+00_r8,0.29427e+00_r8,0.39234e+00_r8, & + & 0.49035e+00_r8,0.58829e+00_r8,0.68586e+00_r8,0.77383e+00_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.93003e-01_r8,0.10431e+00_r8,0.20302e+00_r8,0.30448e+00_r8,0.40592e+00_r8, & + & 0.50734e+00_r8,0.60870e+00_r8,0.70970e+00_r8,0.80084e+00_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.11556e+00_r8,0.11007e+00_r8,0.18689e+00_r8,0.28032e+00_r8,0.37373e+00_r8, & + & 0.46710e+00_r8,0.56044e+00_r8,0.65346e+00_r8,0.74264e+00_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.11235e+00_r8,0.11167e+00_r8,0.19754e+00_r8,0.29630e+00_r8,0.39502e+00_r8, & + & 0.49371e+00_r8,0.59235e+00_r8,0.69064e+00_r8,0.78516e+00_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.10972e+00_r8,0.11355e+00_r8,0.20696e+00_r8,0.31040e+00_r8,0.41383e+00_r8, & + & 0.51721e+00_r8,0.62053e+00_r8,0.72352e+00_r8,0.82248e+00_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.10741e+00_r8,0.11554e+00_r8,0.21557e+00_r8,0.32331e+00_r8,0.43105e+00_r8, & + & 0.53874e+00_r8,0.64632e+00_r8,0.75359e+00_r8,0.85679e+00_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.10619e+00_r8,0.11745e+00_r8,0.22327e+00_r8,0.33487e+00_r8,0.44646e+00_r8, & + & 0.55799e+00_r8,0.66944e+00_r8,0.78056e+00_r8,0.88741e+00_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.13422e+00_r8,0.12619e+00_r8,0.20125e+00_r8,0.30186e+00_r8,0.40245e+00_r8, & + & 0.50302e+00_r8,0.60348e+00_r8,0.70372e+00_r8,0.80253e+00_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.13052e+00_r8,0.12743e+00_r8,0.21345e+00_r8,0.32016e+00_r8,0.42685e+00_r8, & + & 0.53351e+00_r8,0.64011e+00_r8,0.74634e+00_r8,0.85136e+00_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.12741e+00_r8,0.12876e+00_r8,0.22450e+00_r8,0.33672e+00_r8,0.44894e+00_r8, & + & 0.56113e+00_r8,0.67322e+00_r8,0.78494e+00_r8,0.89542e+00_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.12456e+00_r8,0.13045e+00_r8,0.23454e+00_r8,0.35177e+00_r8,0.46901e+00_r8, & + & 0.58622e+00_r8,0.70332e+00_r8,0.82004e+00_r8,0.93535e+00_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.12240e+00_r8,0.13234e+00_r8,0.24346e+00_r8,0.36515e+00_r8,0.48682e+00_r8, & + & 0.60842e+00_r8,0.72992e+00_r8,0.85105e+00_r8,0.97074e+00_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.15641e+00_r8,0.14549e+00_r8,0.21406e+00_r8,0.31903e+00_r8,0.42534e+00_r8, & + & 0.53165e+00_r8,0.63788e+00_r8,0.74385e+00_r8,0.84964e+00_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.15207e+00_r8,0.14574e+00_r8,0.22708e+00_r8,0.34022e+00_r8,0.45360e+00_r8, & + & 0.56697e+00_r8,0.68027e+00_r8,0.79322e+00_r8,0.90603e+00_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.14825e+00_r8,0.14665e+00_r8,0.23979e+00_r8,0.35965e+00_r8,0.47950e+00_r8, & + & 0.59932e+00_r8,0.71907e+00_r8,0.83857e+00_r8,0.95773e+00_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.14482e+00_r8,0.14790e+00_r8,0.25144e+00_r8,0.37711e+00_r8,0.50278e+00_r8, & + & 0.62841e+00_r8,0.75400e+00_r8,0.87926e+00_r8,0.10043e+01_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.14196e+00_r8,0.14929e+00_r8,0.26158e+00_r8,0.39235e+00_r8,0.52312e+00_r8, & + & 0.65390e+00_r8,0.78460e+00_r8,0.91489e+00_r8,0.10450e+01_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.18245e+00_r8,0.16813e+00_r8,0.22831e+00_r8,0.33360e+00_r8,0.44476e+00_r8, & + & 0.55591e+00_r8,0.66702e+00_r8,0.77783e+00_r8,0.88903e+00_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.17706e+00_r8,0.16763e+00_r8,0.24144e+00_r8,0.35719e+00_r8,0.47625e+00_r8, & + & 0.59524e+00_r8,0.71422e+00_r8,0.83295e+00_r8,0.95194e+00_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.17236e+00_r8,0.16756e+00_r8,0.25360e+00_r8,0.37892e+00_r8,0.50520e+00_r8, & + & 0.63143e+00_r8,0.75766e+00_r8,0.88351e+00_r8,0.10099e+01_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.16823e+00_r8,0.16816e+00_r8,0.26586e+00_r8,0.39858e+00_r8,0.53141e+00_r8, & + & 0.66420e+00_r8,0.79692e+00_r8,0.92941e+00_r8,0.10623e+01_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.16468e+00_r8,0.16894e+00_r8,0.27725e+00_r8,0.41585e+00_r8,0.55445e+00_r8, & + & 0.69298e+00_r8,0.83146e+00_r8,0.96971e+00_r8,0.11082e+01_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.21221e+00_r8,0.19366e+00_r8,0.24501e+00_r8,0.34518e+00_r8,0.46022e+00_r8, & + & 0.57522e+00_r8,0.69013e+00_r8,0.80500e+00_r8,0.92024e+00_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.20558e+00_r8,0.19344e+00_r8,0.25798e+00_r8,0.37195e+00_r8,0.49597e+00_r8, & + & 0.61989e+00_r8,0.74379e+00_r8,0.86737e+00_r8,0.99166e+00_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.19977e+00_r8,0.19260e+00_r8,0.26963e+00_r8,0.39624e+00_r8,0.52829e+00_r8, & + & 0.66032e+00_r8,0.79227e+00_r8,0.92396e+00_r8,0.10564e+01_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.19471e+00_r8,0.19196e+00_r8,0.28135e+00_r8,0.41773e+00_r8,0.55693e+00_r8, & + & 0.69614e+00_r8,0.83525e+00_r8,0.97412e+00_r8,0.11137e+01_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.19023e+00_r8,0.19149e+00_r8,0.29229e+00_r8,0.43683e+00_r8,0.58243e+00_r8, & + & 0.72800e+00_r8,0.87352e+00_r8,0.10186e+01_r8,0.11647e+01_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.24675e+00_r8,0.22274e+00_r8,0.26456e+00_r8,0.35496e+00_r8,0.47007e+00_r8, & + & 0.58755e+00_r8,0.70496e+00_r8,0.82216e+00_r8,0.94015e+00_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.23844e+00_r8,0.22223e+00_r8,0.27692e+00_r8,0.38304e+00_r8,0.51028e+00_r8, & + & 0.63780e+00_r8,0.76534e+00_r8,0.89259e+00_r8,0.10206e+01_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.23115e+00_r8,0.22076e+00_r8,0.28808e+00_r8,0.40973e+00_r8,0.54629e+00_r8, & + & 0.68281e+00_r8,0.81930e+00_r8,0.95554e+00_r8,0.10926e+01_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.22487e+00_r8,0.21935e+00_r8,0.29872e+00_r8,0.43339e+00_r8,0.57783e+00_r8, & + & 0.72230e+00_r8,0.86661e+00_r8,0.10108e+01_r8,0.11557e+01_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.21911e+00_r8,0.21807e+00_r8,0.30914e+00_r8,0.45602e+00_r8,0.60799e+00_r8, & + & 0.75991e+00_r8,0.91189e+00_r8,0.10634e+01_r8,0.12161e+01_r8 /) + kao(:, 1,10,15) = (/ & + & 0.28580e+00_r8,0.25610e+00_r8,0.28839e+00_r8,0.36810e+00_r8,0.47645e+00_r8, & + & 0.59554e+00_r8,0.71455e+00_r8,0.83348e+00_r8,0.95290e+00_r8 /) + kao(:, 2,10,15) = (/ & + & 0.27554e+00_r8,0.25438e+00_r8,0.29985e+00_r8,0.39603e+00_r8,0.52141e+00_r8, & + & 0.65175e+00_r8,0.78205e+00_r8,0.91212e+00_r8,0.10429e+01_r8 /) + kao(:, 3,10,15) = (/ & + & 0.26639e+00_r8,0.25230e+00_r8,0.31000e+00_r8,0.42263e+00_r8,0.56074e+00_r8, & + & 0.70092e+00_r8,0.84101e+00_r8,0.98094e+00_r8,0.11215e+01_r8 /) + kao(:, 4,10,15) = (/ & + & 0.25840e+00_r8,0.24961e+00_r8,0.31933e+00_r8,0.44762e+00_r8,0.59663e+00_r8, & + & 0.74572e+00_r8,0.89477e+00_r8,0.10436e+01_r8,0.11932e+01_r8 /) + kao(:, 5,10,15) = (/ & + & 0.25110e+00_r8,0.24738e+00_r8,0.32882e+00_r8,0.47409e+00_r8,0.63208e+00_r8, & + & 0.79011e+00_r8,0.94801e+00_r8,0.11055e+01_r8,0.12642e+01_r8 /) + kao(:, 1,11,15) = (/ & + & 0.32402e+00_r8,0.29231e+00_r8,0.32114e+00_r8,0.39449e+00_r8,0.49965e+00_r8, & + & 0.62359e+00_r8,0.74830e+00_r8,0.87279e+00_r8,0.99780e+00_r8 /) + kao(:, 2,11,15) = (/ & + & 0.31203e+00_r8,0.28940e+00_r8,0.33009e+00_r8,0.42179e+00_r8,0.54573e+00_r8, & + & 0.68214e+00_r8,0.81856e+00_r8,0.95481e+00_r8,0.10916e+01_r8 /) + kao(:, 3,11,15) = (/ & + & 0.30125e+00_r8,0.28556e+00_r8,0.33820e+00_r8,0.44749e+00_r8,0.58870e+00_r8, & + & 0.73583e+00_r8,0.88295e+00_r8,0.10298e+01_r8,0.11773e+01_r8 /) + kao(:, 4,11,15) = (/ & + & 0.29153e+00_r8,0.28159e+00_r8,0.34632e+00_r8,0.47427e+00_r8,0.63035e+00_r8, & + & 0.78788e+00_r8,0.94537e+00_r8,0.11027e+01_r8,0.12607e+01_r8 /) + kao(:, 5,11,15) = (/ & + & 0.28247e+00_r8,0.27799e+00_r8,0.35496e+00_r8,0.50259e+00_r8,0.66996e+00_r8, & + & 0.83740e+00_r8,0.10047e+01_r8,0.11720e+01_r8,0.13400e+01_r8 /) + kao(:, 1,12,15) = (/ & + & 0.36545e+00_r8,0.33140e+00_r8,0.35636e+00_r8,0.42085e+00_r8,0.52250e+00_r8, & + & 0.64898e+00_r8,0.77872e+00_r8,0.90834e+00_r8,0.10384e+01_r8 /) + kao(:, 2,12,15) = (/ & + & 0.35131e+00_r8,0.32685e+00_r8,0.36231e+00_r8,0.44658e+00_r8,0.56903e+00_r8, & + & 0.71087e+00_r8,0.85304e+00_r8,0.99503e+00_r8,0.11374e+01_r8 /) + kao(:, 3,12,15) = (/ & + & 0.33841e+00_r8,0.32098e+00_r8,0.36825e+00_r8,0.47208e+00_r8,0.61613e+00_r8, & + & 0.77016e+00_r8,0.92410e+00_r8,0.10779e+01_r8,0.12323e+01_r8 /) + kao(:, 4,12,15) = (/ & + & 0.32642e+00_r8,0.31543e+00_r8,0.37504e+00_r8,0.50058e+00_r8,0.66195e+00_r8, & + & 0.82736e+00_r8,0.99279e+00_r8,0.11580e+01_r8,0.13239e+01_r8 /) + kao(:, 5,12,15) = (/ & + & 0.31541e+00_r8,0.31006e+00_r8,0.38358e+00_r8,0.53015e+00_r8,0.70512e+00_r8, & + & 0.88131e+00_r8,0.10574e+01_r8,0.12335e+01_r8,0.14101e+01_r8 /) + kao(:, 1,13,15) = (/ & + & 0.40964e+00_r8,0.37314e+00_r8,0.39372e+00_r8,0.44813e+00_r8,0.54521e+00_r8, & + & 0.67332e+00_r8,0.80793e+00_r8,0.94247e+00_r8,0.10773e+01_r8 /) + kao(:, 2,13,15) = (/ & + & 0.39277e+00_r8,0.36624e+00_r8,0.39629e+00_r8,0.47194e+00_r8,0.59295e+00_r8, & + & 0.73949e+00_r8,0.88734e+00_r8,0.10350e+01_r8,0.11832e+01_r8 /) + kao(:, 3,13,15) = (/ & + & 0.37714e+00_r8,0.35816e+00_r8,0.39962e+00_r8,0.49769e+00_r8,0.64296e+00_r8, & + & 0.80367e+00_r8,0.96435e+00_r8,0.11249e+01_r8,0.12860e+01_r8 /) + kao(:, 4,13,15) = (/ & + & 0.36268e+00_r8,0.35049e+00_r8,0.40459e+00_r8,0.52725e+00_r8,0.69174e+00_r8, & + & 0.86463e+00_r8,0.10374e+01_r8,0.12101e+01_r8,0.13834e+01_r8 /) + kao(:, 5,13,15) = (/ & + & 0.34948e+00_r8,0.34295e+00_r8,0.41358e+00_r8,0.55736e+00_r8,0.73767e+00_r8, & + & 0.92205e+00_r8,0.11064e+01_r8,0.12905e+01_r8,0.14753e+01_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.90320e-01_r8,0.86361e-01_r8,0.17271e+00_r8,0.25905e+00_r8,0.34536e+00_r8, & + & 0.43163e+00_r8,0.51777e+00_r8,0.60344e+00_r8,0.64541e+00_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.88026e-01_r8,0.92415e-01_r8,0.18482e+00_r8,0.27721e+00_r8,0.36957e+00_r8, & + & 0.46188e+00_r8,0.55406e+00_r8,0.64572e+00_r8,0.69076e+00_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.85829e-01_r8,0.97954e-01_r8,0.19590e+00_r8,0.29382e+00_r8,0.39172e+00_r8, & + & 0.48957e+00_r8,0.58728e+00_r8,0.68449e+00_r8,0.73223e+00_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.83674e-01_r8,0.10298e+00_r8,0.20595e+00_r8,0.30890e+00_r8,0.41183e+00_r8, & + & 0.51469e+00_r8,0.61741e+00_r8,0.71956e+00_r8,0.77014e+00_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.84304e-01_r8,0.10756e+00_r8,0.21511e+00_r8,0.32264e+00_r8,0.43014e+00_r8, & + & 0.53758e+00_r8,0.64487e+00_r8,0.75164e+00_r8,0.80439e+00_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.99611e-01_r8,0.10121e+00_r8,0.20241e+00_r8,0.30359e+00_r8,0.40479e+00_r8, & + & 0.50590e+00_r8,0.60686e+00_r8,0.70732e+00_r8,0.77453e+00_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.97224e-01_r8,0.10870e+00_r8,0.21739e+00_r8,0.32607e+00_r8,0.43471e+00_r8, & + & 0.54336e+00_r8,0.65181e+00_r8,0.75967e+00_r8,0.83199e+00_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.94894e-01_r8,0.11558e+00_r8,0.23114e+00_r8,0.34669e+00_r8,0.46220e+00_r8, & + & 0.57772e+00_r8,0.69302e+00_r8,0.80771e+00_r8,0.88476e+00_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.92656e-01_r8,0.12184e+00_r8,0.24366e+00_r8,0.36546e+00_r8,0.48723e+00_r8, & + & 0.60893e+00_r8,0.73046e+00_r8,0.85132e+00_r8,0.93269e+00_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.93593e-01_r8,0.12749e+00_r8,0.25497e+00_r8,0.38243e+00_r8,0.50985e+00_r8, & + & 0.63721e+00_r8,0.76438e+00_r8,0.89083e+00_r8,0.97622e+00_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.11521e+00_r8,0.11614e+00_r8,0.23226e+00_r8,0.34836e+00_r8,0.46443e+00_r8, & + & 0.58044e+00_r8,0.69629e+00_r8,0.81149e+00_r8,0.90951e+00_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.11222e+00_r8,0.12555e+00_r8,0.25108e+00_r8,0.37659e+00_r8,0.50206e+00_r8, & + & 0.62747e+00_r8,0.75258e+00_r8,0.87709e+00_r8,0.98316e+00_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.10948e+00_r8,0.13410e+00_r8,0.26819e+00_r8,0.40226e+00_r8,0.53629e+00_r8, & + & 0.67035e+00_r8,0.80421e+00_r8,0.93726e+00_r8,0.10505e+01_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.10697e+00_r8,0.14195e+00_r8,0.28389e+00_r8,0.42580e+00_r8,0.56768e+00_r8, & + & 0.70947e+00_r8,0.85107e+00_r8,0.99187e+00_r8,0.11120e+01_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.10462e+00_r8,0.14901e+00_r8,0.29800e+00_r8,0.44697e+00_r8,0.59590e+00_r8, & + & 0.74474e+00_r8,0.89338e+00_r8,0.10415e+01_r8,0.11678e+01_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.13825e+00_r8,0.13238e+00_r8,0.26314e+00_r8,0.39468e+00_r8,0.52618e+00_r8, & + & 0.65761e+00_r8,0.78893e+00_r8,0.91946e+00_r8,0.10423e+01_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.13437e+00_r8,0.14320e+00_r8,0.28638e+00_r8,0.42954e+00_r8,0.57266e+00_r8, & + & 0.71574e+00_r8,0.85868e+00_r8,0.10008e+01_r8,0.11347e+01_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.13067e+00_r8,0.15392e+00_r8,0.30782e+00_r8,0.46170e+00_r8,0.61554e+00_r8, & + & 0.76929e+00_r8,0.92283e+00_r8,0.10757e+01_r8,0.12195e+01_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.12733e+00_r8,0.16364e+00_r8,0.32725e+00_r8,0.49085e+00_r8,0.65439e+00_r8, & + & 0.81785e+00_r8,0.98125e+00_r8,0.11437e+01_r8,0.12968e+01_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.12429e+00_r8,0.17242e+00_r8,0.34483e+00_r8,0.51721e+00_r8,0.68954e+00_r8, & + & 0.86178e+00_r8,0.10339e+01_r8,0.12053e+01_r8,0.13667e+01_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.16714e+00_r8,0.15294e+00_r8,0.29770e+00_r8,0.44651e+00_r8,0.59528e+00_r8, & + & 0.74397e+00_r8,0.89246e+00_r8,0.10402e+01_r8,0.11846e+01_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.16248e+00_r8,0.16289e+00_r8,0.32569e+00_r8,0.48850e+00_r8,0.65127e+00_r8, & + & 0.81396e+00_r8,0.97625e+00_r8,0.11381e+01_r8,0.12962e+01_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.15803e+00_r8,0.17580e+00_r8,0.35158e+00_r8,0.52733e+00_r8,0.70303e+00_r8, & + & 0.87864e+00_r8,0.10540e+01_r8,0.12284e+01_r8,0.13993e+01_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.15368e+00_r8,0.18757e+00_r8,0.37512e+00_r8,0.56264e+00_r8,0.75011e+00_r8, & + & 0.93747e+00_r8,0.11247e+01_r8,0.13108e+01_r8,0.14933e+01_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.14943e+00_r8,0.19824e+00_r8,0.39645e+00_r8,0.59477e+00_r8,0.79303e+00_r8, & + & 0.99112e+00_r8,0.11890e+01_r8,0.13858e+01_r8,0.15783e+01_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.20217e+00_r8,0.17926e+00_r8,0.33507e+00_r8,0.50257e+00_r8,0.67002e+00_r8, & + & 0.83741e+00_r8,0.10046e+01_r8,0.11708e+01_r8,0.13365e+01_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.19655e+00_r8,0.18668e+00_r8,0.36910e+00_r8,0.55360e+00_r8,0.73806e+00_r8, & + & 0.92245e+00_r8,0.11065e+01_r8,0.12896e+01_r8,0.14724e+01_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.19100e+00_r8,0.20029e+00_r8,0.40054e+00_r8,0.60077e+00_r8,0.80095e+00_r8, & + & 0.10010e+01_r8,0.12008e+01_r8,0.13997e+01_r8,0.15979e+01_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.18556e+00_r8,0.21465e+00_r8,0.42926e+00_r8,0.64385e+00_r8,0.85838e+00_r8, & + & 0.10728e+01_r8,0.12869e+01_r8,0.15000e+01_r8,0.17126e+01_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.18024e+00_r8,0.22760e+00_r8,0.45517e+00_r8,0.68271e+00_r8,0.91019e+00_r8, & + & 0.11375e+01_r8,0.13647e+01_r8,0.15907e+01_r8,0.18161e+01_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.24417e+00_r8,0.21368e+00_r8,0.37507e+00_r8,0.56256e+00_r8,0.75006e+00_r8, & + & 0.93742e+00_r8,0.11245e+01_r8,0.13107e+01_r8,0.14982e+01_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.23715e+00_r8,0.21661e+00_r8,0.41650e+00_r8,0.62470e+00_r8,0.83285e+00_r8, & + & 0.10409e+01_r8,0.12487e+01_r8,0.14555e+01_r8,0.16638e+01_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.23022e+00_r8,0.22856e+00_r8,0.45485e+00_r8,0.68222e+00_r8,0.90954e+00_r8, & + & 0.11367e+01_r8,0.13637e+01_r8,0.15896e+01_r8,0.18170e+01_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.22335e+00_r8,0.24491e+00_r8,0.48979e+00_r8,0.73464e+00_r8,0.97947e+00_r8, & + & 0.12241e+01_r8,0.14686e+01_r8,0.17118e+01_r8,0.19566e+01_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.21655e+00_r8,0.26068e+00_r8,0.52133e+00_r8,0.78194e+00_r8,0.10425e+01_r8, & + & 0.13029e+01_r8,0.15630e+01_r8,0.18220e+01_r8,0.20827e+01_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.29541e+00_r8,0.25848e+00_r8,0.41687e+00_r8,0.62527e+00_r8,0.83361e+00_r8, & + & 0.10419e+01_r8,0.12499e+01_r8,0.14571e+01_r8,0.16668e+01_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.28549e+00_r8,0.25449e+00_r8,0.46724e+00_r8,0.70082e+00_r8,0.93434e+00_r8, & + & 0.11678e+01_r8,0.14009e+01_r8,0.16328e+01_r8,0.18680e+01_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.27625e+00_r8,0.26285e+00_r8,0.51364e+00_r8,0.77040e+00_r8,0.10271e+01_r8, & + & 0.12838e+01_r8,0.15402e+01_r8,0.17956e+01_r8,0.20538e+01_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.26742e+00_r8,0.27883e+00_r8,0.55601e+00_r8,0.83395e+00_r8,0.11118e+01_r8, & + & 0.13896e+01_r8,0.16670e+01_r8,0.19436e+01_r8,0.22230e+01_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.25873e+00_r8,0.29706e+00_r8,0.59410e+00_r8,0.89109e+00_r8,0.11880e+01_r8, & + & 0.14848e+01_r8,0.17812e+01_r8,0.20764e+01_r8,0.23753e+01_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.35727e+00_r8,0.31262e+00_r8,0.45859e+00_r8,0.68783e+00_r8,0.91710e+00_r8, & + & 0.11462e+01_r8,0.13749e+01_r8,0.16027e+01_r8,0.18342e+01_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.34378e+00_r8,0.30157e+00_r8,0.51912e+00_r8,0.77863e+00_r8,0.10382e+01_r8, & + & 0.12975e+01_r8,0.15566e+01_r8,0.18147e+01_r8,0.20764e+01_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.33111e+00_r8,0.30494e+00_r8,0.57506e+00_r8,0.86254e+00_r8,0.11500e+01_r8, & + & 0.14374e+01_r8,0.17244e+01_r8,0.20104e+01_r8,0.23002e+01_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.31901e+00_r8,0.31860e+00_r8,0.62597e+00_r8,0.93889e+00_r8,0.12519e+01_r8, & + & 0.15648e+01_r8,0.18772e+01_r8,0.21885e+01_r8,0.25042e+01_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.30738e+00_r8,0.33686e+00_r8,0.67173e+00_r8,0.10075e+01_r8,0.13433e+01_r8, & + & 0.16788e+01_r8,0.20142e+01_r8,0.23482e+01_r8,0.26866e+01_r8 /) + kao(:, 1,10,16) = (/ & + & 0.42900e+00_r8,0.37537e+00_r8,0.50742e+00_r8,0.76107e+00_r8,0.10147e+01_r8, & + & 0.12682e+01_r8,0.15216e+01_r8,0.17737e+01_r8,0.20298e+01_r8 /) + kao(:, 2,10,16) = (/ & + & 0.41120e+00_r8,0.35980e+00_r8,0.57626e+00_r8,0.86440e+00_r8,0.11524e+01_r8, & + & 0.14403e+01_r8,0.17281e+01_r8,0.20148e+01_r8,0.23052e+01_r8 /) + kao(:, 3,10,16) = (/ & + & 0.39435e+00_r8,0.35582e+00_r8,0.64201e+00_r8,0.96295e+00_r8,0.12838e+01_r8, & + & 0.16046e+01_r8,0.19250e+01_r8,0.22444e+01_r8,0.25680e+01_r8 /) + kao(:, 4,10,16) = (/ & + & 0.37835e+00_r8,0.36721e+00_r8,0.70220e+00_r8,0.10532e+01_r8,0.14042e+01_r8, & + & 0.17550e+01_r8,0.21055e+01_r8,0.24551e+01_r8,0.28089e+01_r8 /) + kao(:, 5,10,16) = (/ & + & 0.36302e+00_r8,0.38402e+00_r8,0.75599e+00_r8,0.11339e+01_r8,0.15118e+01_r8, & + & 0.18894e+01_r8,0.22669e+01_r8,0.26429e+01_r8,0.30243e+01_r8 /) + kao(:, 1,11,16) = (/ & + & 0.50130e+00_r8,0.43864e+00_r8,0.59754e+00_r8,0.89626e+00_r8,0.11949e+01_r8, & + & 0.14934e+01_r8,0.17919e+01_r8,0.20890e+01_r8,0.23902e+01_r8 /) + kao(:, 2,11,16) = (/ & + & 0.47862e+00_r8,0.41971e+00_r8,0.67375e+00_r8,0.10106e+01_r8,0.13473e+01_r8, & + & 0.16840e+01_r8,0.20203e+01_r8,0.23553e+01_r8,0.26950e+01_r8 /) + kao(:, 3,11,16) = (/ & + & 0.45729e+00_r8,0.41739e+00_r8,0.74475e+00_r8,0.11171e+01_r8,0.14893e+01_r8, & + & 0.18615e+01_r8,0.22335e+01_r8,0.26038e+01_r8,0.29786e+01_r8 /) + kao(:, 4,11,16) = (/ & + & 0.43691e+00_r8,0.42957e+00_r8,0.80967e+00_r8,0.12144e+01_r8,0.16191e+01_r8, & + & 0.20236e+01_r8,0.24280e+01_r8,0.28308e+01_r8,0.32389e+01_r8 /) + kao(:, 5,11,16) = (/ & + & 0.41748e+00_r8,0.44621e+00_r8,0.86800e+00_r8,0.13019e+01_r8,0.17360e+01_r8, & + & 0.21698e+01_r8,0.26031e+01_r8,0.30355e+01_r8,0.34723e+01_r8 /) + kao(:, 1,12,16) = (/ & + & 0.58052e+00_r8,0.50796e+00_r8,0.69775e+00_r8,0.10466e+01_r8,0.13954e+01_r8, & + & 0.17440e+01_r8,0.20924e+01_r8,0.24394e+01_r8,0.27908e+01_r8 /) + kao(:, 2,12,16) = (/ & + & 0.55207e+00_r8,0.48627e+00_r8,0.78177e+00_r8,0.11726e+01_r8,0.15635e+01_r8, & + & 0.19543e+01_r8,0.23447e+01_r8,0.27336e+01_r8,0.31273e+01_r8 /) + kao(:, 3,12,16) = (/ & + & 0.52503e+00_r8,0.48543e+00_r8,0.85881e+00_r8,0.12881e+01_r8,0.17174e+01_r8, & + & 0.21467e+01_r8,0.25754e+01_r8,0.30027e+01_r8,0.34355e+01_r8 /) + kao(:, 4,12,16) = (/ & + & 0.49945e+00_r8,0.49746e+00_r8,0.92780e+00_r8,0.13917e+01_r8,0.18554e+01_r8, & + & 0.23191e+01_r8,0.27823e+01_r8,0.32446e+01_r8,0.37108e+01_r8 /) + kao(:, 5,12,16) = (/ & + & 0.47536e+00_r8,0.51344e+00_r8,0.98885e+00_r8,0.14832e+01_r8,0.19776e+01_r8, & + & 0.24717e+01_r8,0.29655e+01_r8,0.34576e+01_r8,0.39563e+01_r8 /) + kao(:, 1,13,16) = (/ & + & 0.66560e+00_r8,0.58240e+00_r8,0.80598e+00_r8,0.12089e+01_r8,0.16118e+01_r8, & + & 0.20145e+01_r8,0.24172e+01_r8,0.28183e+01_r8,0.32240e+01_r8 /) + kao(:, 2,13,16) = (/ & + & 0.62986e+00_r8,0.55885e+00_r8,0.89794e+00_r8,0.13468e+01_r8,0.17957e+01_r8, & + & 0.22443e+01_r8,0.26925e+01_r8,0.31396e+01_r8,0.35914e+01_r8 /) + kao(:, 3,13,16) = (/ & + & 0.59613e+00_r8,0.55868e+00_r8,0.98065e+00_r8,0.14709e+01_r8,0.19611e+01_r8, & + & 0.24513e+01_r8,0.29409e+01_r8,0.34293e+01_r8,0.39230e+01_r8 /) + kao(:, 4,13,16) = (/ & + & 0.56427e+00_r8,0.56950e+00_r8,0.10539e+01_r8,0.15808e+01_r8,0.21076e+01_r8, & + & 0.26342e+01_r8,0.31605e+01_r8,0.36850e+01_r8,0.42159e+01_r8 /) + kao(:, 5,13,16) = (/ & + & 0.53530e+00_r8,0.58425e+00_r8,0.11174e+01_r8,0.16761e+01_r8,0.22346e+01_r8, & + & 0.27933e+01_r8,0.33512e+01_r8,0.39078e+01_r8,0.44703e+01_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.12810e-03_r8,0.12891e-03_r8,0.12890e-03_r8,0.12713e-03_r8,0.12477e-03_r8 /) + kbo(:,14, 1) = (/ & + & 0.10653e-03_r8,0.10667e-03_r8,0.10648e-03_r8,0.10473e-03_r8,0.10293e-03_r8 /) + kbo(:,15, 1) = (/ & + & 0.90176e-04_r8,0.90077e-04_r8,0.89286e-04_r8,0.87879e-04_r8,0.85987e-04_r8 /) + kbo(:,16, 1) = (/ & + & 0.77704e-04_r8,0.77304e-04_r8,0.75879e-04_r8,0.74246e-04_r8,0.72070e-04_r8 /) + kbo(:,17, 1) = (/ & + & 0.67183e-04_r8,0.65906e-04_r8,0.64619e-04_r8,0.63000e-04_r8,0.61056e-04_r8 /) + kbo(:,18, 1) = (/ & + & 0.58741e-04_r8,0.57649e-04_r8,0.56028e-04_r8,0.54293e-04_r8,0.52506e-04_r8 /) + kbo(:,19, 1) = (/ & + & 0.51839e-04_r8,0.50715e-04_r8,0.49053e-04_r8,0.47195e-04_r8,0.45368e-04_r8 /) + kbo(:,20, 1) = (/ & + & 0.44321e-04_r8,0.43297e-04_r8,0.41923e-04_r8,0.40298e-04_r8,0.38744e-04_r8 /) + kbo(:,21, 1) = (/ & + & 0.37527e-04_r8,0.36516e-04_r8,0.35380e-04_r8,0.34037e-04_r8,0.32951e-04_r8 /) + kbo(:,22, 1) = (/ & + & 0.31752e-04_r8,0.30703e-04_r8,0.29586e-04_r8,0.28499e-04_r8,0.27519e-04_r8 /) + kbo(:,23, 1) = (/ & + & 0.26638e-04_r8,0.25643e-04_r8,0.24693e-04_r8,0.23832e-04_r8,0.22913e-04_r8 /) + kbo(:,24, 1) = (/ & + & 0.22325e-04_r8,0.21480e-04_r8,0.20621e-04_r8,0.19867e-04_r8,0.19066e-04_r8 /) + kbo(:,25, 1) = (/ & + & 0.18764e-04_r8,0.17998e-04_r8,0.17269e-04_r8,0.16527e-04_r8,0.15821e-04_r8 /) + kbo(:,26, 1) = (/ & + & 0.15650e-04_r8,0.14992e-04_r8,0.14356e-04_r8,0.13710e-04_r8,0.13119e-04_r8 /) + kbo(:,27, 1) = (/ & + & 0.13054e-04_r8,0.12477e-04_r8,0.11929e-04_r8,0.11393e-04_r8,0.10948e-04_r8 /) + kbo(:,28, 1) = (/ & + & 0.10852e-04_r8,0.10390e-04_r8,0.99195e-05_r8,0.95020e-05_r8,0.91993e-05_r8 /) + kbo(:,29, 1) = (/ & + & 0.90990e-05_r8,0.87209e-05_r8,0.83384e-05_r8,0.80029e-05_r8,0.77245e-05_r8 /) + kbo(:,30, 1) = (/ & + & 0.77169e-05_r8,0.73662e-05_r8,0.70552e-05_r8,0.68029e-05_r8,0.65749e-05_r8 /) + kbo(:,31, 1) = (/ & + & 0.65250e-05_r8,0.62364e-05_r8,0.60172e-05_r8,0.57804e-05_r8,0.55504e-05_r8 /) + kbo(:,32, 1) = (/ & + & 0.55167e-05_r8,0.53021e-05_r8,0.51088e-05_r8,0.49113e-05_r8,0.47150e-05_r8 /) + kbo(:,33, 1) = (/ & + & 0.47261e-05_r8,0.45530e-05_r8,0.43641e-05_r8,0.41725e-05_r8,0.40077e-05_r8 /) + kbo(:,34, 1) = (/ & + & 0.40646e-05_r8,0.39062e-05_r8,0.37472e-05_r8,0.36009e-05_r8,0.34549e-05_r8 /) + kbo(:,35, 1) = (/ & + & 0.35479e-05_r8,0.34057e-05_r8,0.32704e-05_r8,0.31420e-05_r8,0.30219e-05_r8 /) + kbo(:,36, 1) = (/ & + & 0.31353e-05_r8,0.30270e-05_r8,0.29024e-05_r8,0.27776e-05_r8,0.26600e-05_r8 /) + kbo(:,37, 1) = (/ & + & 0.26595e-05_r8,0.25621e-05_r8,0.24646e-05_r8,0.23582e-05_r8,0.22563e-05_r8 /) + kbo(:,38, 1) = (/ & + & 0.22468e-05_r8,0.21651e-05_r8,0.20812e-05_r8,0.20043e-05_r8,0.19221e-05_r8 /) + kbo(:,39, 1) = (/ & + & 0.19009e-05_r8,0.18335e-05_r8,0.17685e-05_r8,0.17039e-05_r8,0.16406e-05_r8 /) + kbo(:,40, 1) = (/ & + & 0.15746e-05_r8,0.15188e-05_r8,0.14669e-05_r8,0.14148e-05_r8,0.13668e-05_r8 /) + kbo(:,41, 1) = (/ & + & 0.13001e-05_r8,0.12561e-05_r8,0.12122e-05_r8,0.11718e-05_r8,0.11306e-05_r8 /) + kbo(:,42, 1) = (/ & + & 0.10716e-05_r8,0.10380e-05_r8,0.10018e-05_r8,0.96745e-06_r8,0.93475e-06_r8 /) + kbo(:,43, 1) = (/ & + & 0.87651e-06_r8,0.85172e-06_r8,0.82453e-06_r8,0.79560e-06_r8,0.77011e-06_r8 /) + kbo(:,44, 1) = (/ & + & 0.71565e-06_r8,0.69699e-06_r8,0.67699e-06_r8,0.65403e-06_r8,0.63202e-06_r8 /) + kbo(:,45, 1) = (/ & + & 0.58391e-06_r8,0.56946e-06_r8,0.55318e-06_r8,0.53575e-06_r8,0.51774e-06_r8 /) + kbo(:,46, 1) = (/ & + & 0.47490e-06_r8,0.46531e-06_r8,0.45175e-06_r8,0.43686e-06_r8,0.42260e-06_r8 /) + kbo(:,47, 1) = (/ & + & 0.38718e-06_r8,0.37610e-06_r8,0.36650e-06_r8,0.35580e-06_r8,0.34417e-06_r8 /) + kbo(:,48, 1) = (/ & + & 0.31464e-06_r8,0.30494e-06_r8,0.29872e-06_r8,0.29096e-06_r8,0.28230e-06_r8 /) + kbo(:,49, 1) = (/ & + & 0.25542e-06_r8,0.24885e-06_r8,0.24314e-06_r8,0.23745e-06_r8,0.23092e-06_r8 /) + kbo(:,50, 1) = (/ & + & 0.20741e-06_r8,0.20175e-06_r8,0.19699e-06_r8,0.19305e-06_r8,0.18791e-06_r8 /) + kbo(:,51, 1) = (/ & + & 0.16760e-06_r8,0.16406e-06_r8,0.15993e-06_r8,0.15631e-06_r8,0.15327e-06_r8 /) + kbo(:,52, 1) = (/ & + & 0.13579e-06_r8,0.13287e-06_r8,0.12985e-06_r8,0.12725e-06_r8,0.12470e-06_r8 /) + kbo(:,53, 1) = (/ & + & 0.11006e-06_r8,0.10757e-06_r8,0.10568e-06_r8,0.10314e-06_r8,0.10101e-06_r8 /) + kbo(:,54, 1) = (/ & + & 0.88711e-07_r8,0.87131e-07_r8,0.85162e-07_r8,0.83405e-07_r8,0.81585e-07_r8 /) + kbo(:,55, 1) = (/ & + & 0.70889e-07_r8,0.69917e-07_r8,0.68692e-07_r8,0.67463e-07_r8,0.66047e-07_r8 /) + kbo(:,56, 1) = (/ & + & 0.56659e-07_r8,0.56077e-07_r8,0.55518e-07_r8,0.54462e-07_r8,0.53563e-07_r8 /) + kbo(:,57, 1) = (/ & + & 0.45380e-07_r8,0.45159e-07_r8,0.44718e-07_r8,0.44063e-07_r8,0.43116e-07_r8 /) + kbo(:,58, 1) = (/ & + & 0.35962e-07_r8,0.36177e-07_r8,0.35997e-07_r8,0.35600e-07_r8,0.34340e-07_r8 /) + kbo(:,59, 1) = (/ & + & 0.28578e-07_r8,0.28924e-07_r8,0.28901e-07_r8,0.28176e-07_r8,0.27246e-07_r8 /) + kbo(:,13, 2) = (/ & + & 0.63215e-03_r8,0.64756e-03_r8,0.65734e-03_r8,0.66515e-03_r8,0.67077e-03_r8 /) + kbo(:,14, 2) = (/ & + & 0.52378e-03_r8,0.53631e-03_r8,0.54485e-03_r8,0.55071e-03_r8,0.55605e-03_r8 /) + kbo(:,15, 2) = (/ & + & 0.43777e-03_r8,0.44814e-03_r8,0.45521e-03_r8,0.46124e-03_r8,0.46700e-03_r8 /) + kbo(:,16, 2) = (/ & + & 0.37023e-03_r8,0.37869e-03_r8,0.38568e-03_r8,0.39070e-03_r8,0.39760e-03_r8 /) + kbo(:,17, 2) = (/ & + & 0.31753e-03_r8,0.32632e-03_r8,0.33254e-03_r8,0.33817e-03_r8,0.34312e-03_r8 /) + kbo(:,18, 2) = (/ & + & 0.27580e-03_r8,0.28310e-03_r8,0.28915e-03_r8,0.29488e-03_r8,0.29855e-03_r8 /) + kbo(:,19, 2) = (/ & + & 0.24129e-03_r8,0.24697e-03_r8,0.25302e-03_r8,0.25785e-03_r8,0.26137e-03_r8 /) + kbo(:,20, 2) = (/ & + & 0.20470e-03_r8,0.21040e-03_r8,0.21552e-03_r8,0.21963e-03_r8,0.22260e-03_r8 /) + kbo(:,21, 2) = (/ & + & 0.17290e-03_r8,0.17782e-03_r8,0.18188e-03_r8,0.18513e-03_r8,0.18794e-03_r8 /) + kbo(:,22, 2) = (/ & + & 0.14599e-03_r8,0.15063e-03_r8,0.15389e-03_r8,0.15682e-03_r8,0.15965e-03_r8 /) + kbo(:,23, 2) = (/ & + & 0.12390e-03_r8,0.12797e-03_r8,0.13071e-03_r8,0.13347e-03_r8,0.13571e-03_r8 /) + kbo(:,24, 2) = (/ & + & 0.10553e-03_r8,0.10875e-03_r8,0.11134e-03_r8,0.11351e-03_r8,0.11513e-03_r8 /) + kbo(:,25, 2) = (/ & + & 0.90263e-04_r8,0.92560e-04_r8,0.94667e-04_r8,0.96225e-04_r8,0.97041e-04_r8 /) + kbo(:,26, 2) = (/ & + & 0.76542e-04_r8,0.78227e-04_r8,0.79755e-04_r8,0.80768e-04_r8,0.81412e-04_r8 /) + kbo(:,27, 2) = (/ & + & 0.64562e-04_r8,0.66024e-04_r8,0.67121e-04_r8,0.67878e-04_r8,0.67992e-04_r8 /) + kbo(:,28, 2) = (/ & + & 0.54587e-04_r8,0.55668e-04_r8,0.56439e-04_r8,0.56778e-04_r8,0.56649e-04_r8 /) + kbo(:,29, 2) = (/ & + & 0.46248e-04_r8,0.46885e-04_r8,0.47469e-04_r8,0.47476e-04_r8,0.47464e-04_r8 /) + kbo(:,30, 2) = (/ & + & 0.39084e-04_r8,0.39701e-04_r8,0.39836e-04_r8,0.39919e-04_r8,0.39762e-04_r8 /) + kbo(:,31, 2) = (/ & + & 0.33297e-04_r8,0.33670e-04_r8,0.33781e-04_r8,0.33571e-04_r8,0.33418e-04_r8 /) + kbo(:,32, 2) = (/ & + & 0.28475e-04_r8,0.28479e-04_r8,0.28352e-04_r8,0.28202e-04_r8,0.28107e-04_r8 /) + kbo(:,33, 2) = (/ & + & 0.24023e-04_r8,0.23977e-04_r8,0.23874e-04_r8,0.23858e-04_r8,0.23729e-04_r8 /) + kbo(:,34, 2) = (/ & + & 0.20276e-04_r8,0.20314e-04_r8,0.20262e-04_r8,0.20205e-04_r8,0.20013e-04_r8 /) + kbo(:,35, 2) = (/ & + & 0.17177e-04_r8,0.17179e-04_r8,0.17181e-04_r8,0.17048e-04_r8,0.16915e-04_r8 /) + kbo(:,36, 2) = (/ & + & 0.14586e-04_r8,0.14632e-04_r8,0.14569e-04_r8,0.14465e-04_r8,0.14404e-04_r8 /) + kbo(:,37, 2) = (/ & + & 0.12165e-04_r8,0.12220e-04_r8,0.12164e-04_r8,0.12099e-04_r8,0.12036e-04_r8 /) + kbo(:,38, 2) = (/ & + & 0.10178e-04_r8,0.10224e-04_r8,0.10201e-04_r8,0.10134e-04_r8,0.10060e-04_r8 /) + kbo(:,39, 2) = (/ & + & 0.85622e-05_r8,0.85826e-05_r8,0.85520e-05_r8,0.85109e-05_r8,0.84378e-05_r8 /) + kbo(:,40, 2) = (/ & + & 0.70263e-05_r8,0.70549e-05_r8,0.70334e-05_r8,0.70000e-05_r8,0.69500e-05_r8 /) + kbo(:,41, 2) = (/ & + & 0.57510e-05_r8,0.57749e-05_r8,0.57692e-05_r8,0.57384e-05_r8,0.57121e-05_r8 /) + kbo(:,42, 2) = (/ & + & 0.47038e-05_r8,0.47261e-05_r8,0.47278e-05_r8,0.47023e-05_r8,0.46867e-05_r8 /) + kbo(:,43, 2) = (/ & + & 0.38249e-05_r8,0.38339e-05_r8,0.38498e-05_r8,0.38364e-05_r8,0.38125e-05_r8 /) + kbo(:,44, 2) = (/ & + & 0.30973e-05_r8,0.31120e-05_r8,0.31166e-05_r8,0.31203e-05_r8,0.31022e-05_r8 /) + kbo(:,45, 2) = (/ & + & 0.25085e-05_r8,0.25263e-05_r8,0.25293e-05_r8,0.25328e-05_r8,0.25249e-05_r8 /) + kbo(:,46, 2) = (/ & + & 0.20261e-05_r8,0.20479e-05_r8,0.20565e-05_r8,0.20575e-05_r8,0.20588e-05_r8 /) + kbo(:,47, 2) = (/ & + & 0.16319e-05_r8,0.16639e-05_r8,0.16745e-05_r8,0.16740e-05_r8,0.16759e-05_r8 /) + kbo(:,48, 2) = (/ & + & 0.13097e-05_r8,0.13449e-05_r8,0.13611e-05_r8,0.13624e-05_r8,0.13589e-05_r8 /) + kbo(:,49, 2) = (/ & + & 0.10521e-05_r8,0.10847e-05_r8,0.11052e-05_r8,0.11102e-05_r8,0.11085e-05_r8 /) + kbo(:,50, 2) = (/ & + & 0.84668e-06_r8,0.87235e-06_r8,0.89544e-06_r8,0.90607e-06_r8,0.90616e-06_r8 /) + kbo(:,51, 2) = (/ & + & 0.68060e-06_r8,0.70180e-06_r8,0.72187e-06_r8,0.73562e-06_r8,0.73800e-06_r8 /) + kbo(:,52, 2) = (/ & + & 0.54634e-06_r8,0.56481e-06_r8,0.58256e-06_r8,0.59543e-06_r8,0.60122e-06_r8 /) + kbo(:,53, 2) = (/ & + & 0.43866e-06_r8,0.45577e-06_r8,0.46957e-06_r8,0.48176e-06_r8,0.48940e-06_r8 /) + kbo(:,54, 2) = (/ & + & 0.35062e-06_r8,0.36647e-06_r8,0.37935e-06_r8,0.38978e-06_r8,0.39697e-06_r8 /) + kbo(:,55, 2) = (/ & + & 0.27883e-06_r8,0.29514e-06_r8,0.30397e-06_r8,0.31251e-06_r8,0.32004e-06_r8 /) + kbo(:,56, 2) = (/ & + & 0.22098e-06_r8,0.23550e-06_r8,0.24289e-06_r8,0.25018e-06_r8,0.25708e-06_r8 /) + kbo(:,57, 2) = (/ & + & 0.17295e-06_r8,0.18624e-06_r8,0.19332e-06_r8,0.19934e-06_r8,0.20587e-06_r8 /) + kbo(:,58, 2) = (/ & + & 0.13623e-06_r8,0.14680e-06_r8,0.15403e-06_r8,0.15912e-06_r8,0.16499e-06_r8 /) + kbo(:,59, 2) = (/ & + & 0.10864e-06_r8,0.11680e-06_r8,0.12353e-06_r8,0.12840e-06_r8,0.13352e-06_r8 /) + kbo(:,13, 3) = (/ & + & 0.21069e-02_r8,0.21571e-02_r8,0.21943e-02_r8,0.22061e-02_r8,0.22124e-02_r8 /) + kbo(:,14, 3) = (/ & + & 0.17411e-02_r8,0.17833e-02_r8,0.18097e-02_r8,0.18225e-02_r8,0.18251e-02_r8 /) + kbo(:,15, 3) = (/ & + & 0.14440e-02_r8,0.14790e-02_r8,0.14963e-02_r8,0.15066e-02_r8,0.15066e-02_r8 /) + kbo(:,16, 3) = (/ & + & 0.11998e-02_r8,0.12261e-02_r8,0.12398e-02_r8,0.12500e-02_r8,0.12487e-02_r8 /) + kbo(:,17, 3) = (/ & + & 0.99980e-03_r8,0.10202e-02_r8,0.10332e-02_r8,0.10399e-02_r8,0.10392e-02_r8 /) + kbo(:,18, 3) = (/ & + & 0.83805e-03_r8,0.85629e-03_r8,0.86827e-03_r8,0.87303e-03_r8,0.87540e-03_r8 /) + kbo(:,19, 3) = (/ & + & 0.70743e-03_r8,0.72381e-03_r8,0.73251e-03_r8,0.73550e-03_r8,0.73931e-03_r8 /) + kbo(:,20, 3) = (/ & + & 0.59348e-03_r8,0.60572e-03_r8,0.61137e-03_r8,0.61496e-03_r8,0.61761e-03_r8 /) + kbo(:,21, 3) = (/ & + & 0.49556e-03_r8,0.50488e-03_r8,0.50987e-03_r8,0.51421e-03_r8,0.51581e-03_r8 /) + kbo(:,22, 3) = (/ & + & 0.41461e-03_r8,0.42145e-03_r8,0.42584e-03_r8,0.42969e-03_r8,0.43055e-03_r8 /) + kbo(:,23, 3) = (/ & + & 0.34683e-03_r8,0.35181e-03_r8,0.35660e-03_r8,0.35911e-03_r8,0.35958e-03_r8 /) + kbo(:,24, 3) = (/ & + & 0.29004e-03_r8,0.29383e-03_r8,0.29787e-03_r8,0.29964e-03_r8,0.30042e-03_r8 /) + kbo(:,25, 3) = (/ & + & 0.24146e-03_r8,0.24561e-03_r8,0.24879e-03_r8,0.25053e-03_r8,0.25134e-03_r8 /) + kbo(:,26, 3) = (/ & + & 0.20160e-03_r8,0.20537e-03_r8,0.20774e-03_r8,0.20928e-03_r8,0.21023e-03_r8 /) + kbo(:,27, 3) = (/ & + & 0.16916e-03_r8,0.17226e-03_r8,0.17386e-03_r8,0.17529e-03_r8,0.17634e-03_r8 /) + kbo(:,28, 3) = (/ & + & 0.14183e-03_r8,0.14414e-03_r8,0.14604e-03_r8,0.14741e-03_r8,0.14844e-03_r8 /) + kbo(:,29, 3) = (/ & + & 0.11954e-03_r8,0.12161e-03_r8,0.12286e-03_r8,0.12386e-03_r8,0.12448e-03_r8 /) + kbo(:,30, 3) = (/ & + & 0.10067e-03_r8,0.10205e-03_r8,0.10331e-03_r8,0.10409e-03_r8,0.10476e-03_r8 /) + kbo(:,31, 3) = (/ & + & 0.85014e-04_r8,0.86248e-04_r8,0.87024e-04_r8,0.87958e-04_r8,0.88579e-04_r8 /) + kbo(:,32, 3) = (/ & + & 0.71930e-04_r8,0.73074e-04_r8,0.73985e-04_r8,0.74934e-04_r8,0.74848e-04_r8 /) + kbo(:,33, 3) = (/ & + & 0.61205e-04_r8,0.62259e-04_r8,0.63209e-04_r8,0.63383e-04_r8,0.63466e-04_r8 /) + kbo(:,34, 3) = (/ & + & 0.52046e-04_r8,0.52896e-04_r8,0.53420e-04_r8,0.53516e-04_r8,0.53755e-04_r8 /) + kbo(:,35, 3) = (/ & + & 0.44380e-04_r8,0.45121e-04_r8,0.45277e-04_r8,0.45604e-04_r8,0.45761e-04_r8 /) + kbo(:,36, 3) = (/ & + & 0.38058e-04_r8,0.38409e-04_r8,0.38657e-04_r8,0.38813e-04_r8,0.38628e-04_r8 /) + kbo(:,37, 3) = (/ & + & 0.31735e-04_r8,0.31990e-04_r8,0.32199e-04_r8,0.32288e-04_r8,0.32179e-04_r8 /) + kbo(:,38, 3) = (/ & + & 0.26378e-04_r8,0.26667e-04_r8,0.26778e-04_r8,0.26840e-04_r8,0.26760e-04_r8 /) + kbo(:,39, 3) = (/ & + & 0.21949e-04_r8,0.22195e-04_r8,0.22340e-04_r8,0.22330e-04_r8,0.22281e-04_r8 /) + kbo(:,40, 3) = (/ & + & 0.18001e-04_r8,0.18209e-04_r8,0.18338e-04_r8,0.18376e-04_r8,0.18309e-04_r8 /) + kbo(:,41, 3) = (/ & + & 0.14715e-04_r8,0.14906e-04_r8,0.15025e-04_r8,0.15098e-04_r8,0.15026e-04_r8 /) + kbo(:,42, 3) = (/ & + & 0.12019e-04_r8,0.12197e-04_r8,0.12312e-04_r8,0.12380e-04_r8,0.12346e-04_r8 /) + kbo(:,43, 3) = (/ & + & 0.97566e-05_r8,0.99318e-05_r8,0.10036e-04_r8,0.10096e-04_r8,0.10118e-04_r8 /) + kbo(:,44, 3) = (/ & + & 0.78810e-05_r8,0.80716e-05_r8,0.81637e-05_r8,0.82202e-05_r8,0.82608e-05_r8 /) + kbo(:,45, 3) = (/ & + & 0.63541e-05_r8,0.65171e-05_r8,0.66330e-05_r8,0.66977e-05_r8,0.67239e-05_r8 /) + kbo(:,46, 3) = (/ & + & 0.51077e-05_r8,0.52428e-05_r8,0.53636e-05_r8,0.54363e-05_r8,0.54693e-05_r8 /) + kbo(:,47, 3) = (/ & + & 0.40883e-05_r8,0.42196e-05_r8,0.43199e-05_r8,0.44074e-05_r8,0.44462e-05_r8 /) + kbo(:,48, 3) = (/ & + & 0.32909e-05_r8,0.33941e-05_r8,0.34746e-05_r8,0.35546e-05_r8,0.36089e-05_r8 /) + kbo(:,49, 3) = (/ & + & 0.26401e-05_r8,0.27269e-05_r8,0.28003e-05_r8,0.28616e-05_r8,0.29188e-05_r8 /) + kbo(:,50, 3) = (/ & + & 0.21222e-05_r8,0.22032e-05_r8,0.22638e-05_r8,0.23127e-05_r8,0.23603e-05_r8 /) + kbo(:,51, 3) = (/ & + & 0.17056e-05_r8,0.17838e-05_r8,0.18386e-05_r8,0.18804e-05_r8,0.19134e-05_r8 /) + kbo(:,52, 3) = (/ & + & 0.13662e-05_r8,0.14333e-05_r8,0.14855e-05_r8,0.15238e-05_r8,0.15521e-05_r8 /) + kbo(:,53, 3) = (/ & + & 0.10889e-05_r8,0.11445e-05_r8,0.11955e-05_r8,0.12300e-05_r8,0.12560e-05_r8 /) + kbo(:,54, 3) = (/ & + & 0.86251e-06_r8,0.91556e-06_r8,0.95999e-06_r8,0.99454e-06_r8,0.10171e-05_r8 /) + kbo(:,55, 3) = (/ & + & 0.68640e-06_r8,0.72868e-06_r8,0.77389e-06_r8,0.80627e-06_r8,0.82696e-06_r8 /) + kbo(:,56, 3) = (/ & + & 0.54334e-06_r8,0.58339e-06_r8,0.61953e-06_r8,0.65190e-06_r8,0.67285e-06_r8 /) + kbo(:,57, 3) = (/ & + & 0.43336e-06_r8,0.46511e-06_r8,0.49561e-06_r8,0.52337e-06_r8,0.54491e-06_r8 /) + kbo(:,58, 3) = (/ & + & 0.34428e-06_r8,0.37236e-06_r8,0.39687e-06_r8,0.42017e-06_r8,0.43790e-06_r8 /) + kbo(:,59, 3) = (/ & + & 0.27883e-06_r8,0.30237e-06_r8,0.32096e-06_r8,0.33978e-06_r8,0.35485e-06_r8 /) + kbo(:,13, 4) = (/ & + & 0.52806e-02_r8,0.53551e-02_r8,0.53836e-02_r8,0.53810e-02_r8,0.53413e-02_r8 /) + kbo(:,14, 4) = (/ & + & 0.43594e-02_r8,0.44114e-02_r8,0.44268e-02_r8,0.44183e-02_r8,0.43877e-02_r8 /) + kbo(:,15, 4) = (/ & + & 0.36080e-02_r8,0.36421e-02_r8,0.36603e-02_r8,0.36540e-02_r8,0.36307e-02_r8 /) + kbo(:,16, 4) = (/ & + & 0.30007e-02_r8,0.30324e-02_r8,0.30479e-02_r8,0.30377e-02_r8,0.30175e-02_r8 /) + kbo(:,17, 4) = (/ & + & 0.25113e-02_r8,0.25415e-02_r8,0.25489e-02_r8,0.25428e-02_r8,0.25281e-02_r8 /) + kbo(:,18, 4) = (/ & + & 0.21119e-02_r8,0.21340e-02_r8,0.21396e-02_r8,0.21381e-02_r8,0.21232e-02_r8 /) + kbo(:,19, 4) = (/ & + & 0.17705e-02_r8,0.17884e-02_r8,0.17942e-02_r8,0.17931e-02_r8,0.17819e-02_r8 /) + kbo(:,20, 4) = (/ & + & 0.14714e-02_r8,0.14854e-02_r8,0.14921e-02_r8,0.14920e-02_r8,0.14874e-02_r8 /) + kbo(:,21, 4) = (/ & + & 0.12224e-02_r8,0.12349e-02_r8,0.12432e-02_r8,0.12411e-02_r8,0.12395e-02_r8 /) + kbo(:,22, 4) = (/ & + & 0.10170e-02_r8,0.10281e-02_r8,0.10319e-02_r8,0.10310e-02_r8,0.10286e-02_r8 /) + kbo(:,23, 4) = (/ & + & 0.84681e-03_r8,0.85484e-03_r8,0.85517e-03_r8,0.85545e-03_r8,0.85571e-03_r8 /) + kbo(:,24, 4) = (/ & + & 0.70330e-03_r8,0.70875e-03_r8,0.71078e-03_r8,0.71261e-03_r8,0.71112e-03_r8 /) + kbo(:,25, 4) = (/ & + & 0.58481e-03_r8,0.58870e-03_r8,0.59157e-03_r8,0.59305e-03_r8,0.59234e-03_r8 /) + kbo(:,26, 4) = (/ & + & 0.48640e-03_r8,0.49044e-03_r8,0.49395e-03_r8,0.49468e-03_r8,0.49466e-03_r8 /) + kbo(:,27, 4) = (/ & + & 0.40472e-03_r8,0.40915e-03_r8,0.41235e-03_r8,0.41278e-03_r8,0.41345e-03_r8 /) + kbo(:,28, 4) = (/ & + & 0.33826e-03_r8,0.34205e-03_r8,0.34364e-03_r8,0.34480e-03_r8,0.34528e-03_r8 /) + kbo(:,29, 4) = (/ & + & 0.28308e-03_r8,0.28627e-03_r8,0.28792e-03_r8,0.28910e-03_r8,0.28958e-03_r8 /) + kbo(:,30, 4) = (/ & + & 0.23759e-03_r8,0.23994e-03_r8,0.24196e-03_r8,0.24295e-03_r8,0.24270e-03_r8 /) + kbo(:,31, 4) = (/ & + & 0.19993e-03_r8,0.20202e-03_r8,0.20390e-03_r8,0.20456e-03_r8,0.20411e-03_r8 /) + kbo(:,32, 4) = (/ & + & 0.16851e-03_r8,0.17060e-03_r8,0.17151e-03_r8,0.17169e-03_r8,0.17133e-03_r8 /) + kbo(:,33, 4) = (/ & + & 0.14275e-03_r8,0.14392e-03_r8,0.14445e-03_r8,0.14452e-03_r8,0.14399e-03_r8 /) + kbo(:,34, 4) = (/ & + & 0.12060e-03_r8,0.12142e-03_r8,0.12181e-03_r8,0.12165e-03_r8,0.12105e-03_r8 /) + kbo(:,35, 4) = (/ & + & 0.10168e-03_r8,0.10240e-03_r8,0.10276e-03_r8,0.10261e-03_r8,0.10202e-03_r8 /) + kbo(:,36, 4) = (/ & + & 0.85780e-04_r8,0.86636e-04_r8,0.86815e-04_r8,0.86780e-04_r8,0.86722e-04_r8 /) + kbo(:,37, 4) = (/ & + & 0.71540e-04_r8,0.72201e-04_r8,0.72422e-04_r8,0.72501e-04_r8,0.72398e-04_r8 /) + kbo(:,38, 4) = (/ & + & 0.59609e-04_r8,0.60152e-04_r8,0.60443e-04_r8,0.60540e-04_r8,0.60534e-04_r8 /) + kbo(:,39, 4) = (/ & + & 0.49681e-04_r8,0.50194e-04_r8,0.50481e-04_r8,0.50649e-04_r8,0.50643e-04_r8 /) + kbo(:,40, 4) = (/ & + & 0.40815e-04_r8,0.41335e-04_r8,0.41565e-04_r8,0.41729e-04_r8,0.41776e-04_r8 /) + kbo(:,41, 4) = (/ & + & 0.33476e-04_r8,0.33932e-04_r8,0.34171e-04_r8,0.34301e-04_r8,0.34397e-04_r8 /) + kbo(:,42, 4) = (/ & + & 0.27419e-04_r8,0.27824e-04_r8,0.28083e-04_r8,0.28221e-04_r8,0.28296e-04_r8 /) + kbo(:,43, 4) = (/ & + & 0.22349e-04_r8,0.22753e-04_r8,0.22975e-04_r8,0.23100e-04_r8,0.23164e-04_r8 /) + kbo(:,44, 4) = (/ & + & 0.18197e-04_r8,0.18488e-04_r8,0.18747e-04_r8,0.18878e-04_r8,0.18943e-04_r8 /) + kbo(:,45, 4) = (/ & + & 0.14815e-04_r8,0.15081e-04_r8,0.15284e-04_r8,0.15408e-04_r8,0.15493e-04_r8 /) + kbo(:,46, 4) = (/ & + & 0.12046e-04_r8,0.12304e-04_r8,0.12476e-04_r8,0.12590e-04_r8,0.12654e-04_r8 /) + kbo(:,47, 4) = (/ & + & 0.97834e-05_r8,0.10018e-04_r8,0.10187e-04_r8,0.10295e-04_r8,0.10365e-04_r8 /) + kbo(:,48, 4) = (/ & + & 0.79058e-05_r8,0.81583e-05_r8,0.83158e-05_r8,0.84259e-05_r8,0.84791e-05_r8 /) + kbo(:,49, 4) = (/ & + & 0.63847e-05_r8,0.66212e-05_r8,0.67735e-05_r8,0.68818e-05_r8,0.69382e-05_r8 /) + kbo(:,50, 4) = (/ & + & 0.51619e-05_r8,0.53698e-05_r8,0.55239e-05_r8,0.56230e-05_r8,0.56931e-05_r8 /) + kbo(:,51, 4) = (/ & + & 0.41764e-05_r8,0.43546e-05_r8,0.45018e-05_r8,0.45927e-05_r8,0.46609e-05_r8 /) + kbo(:,52, 4) = (/ & + & 0.33696e-05_r8,0.35302e-05_r8,0.36585e-05_r8,0.37548e-05_r8,0.38091e-05_r8 /) + kbo(:,53, 4) = (/ & + & 0.27142e-05_r8,0.28585e-05_r8,0.29700e-05_r8,0.30632e-05_r8,0.31163e-05_r8 /) + kbo(:,54, 4) = (/ & + & 0.21974e-05_r8,0.23176e-05_r8,0.24169e-05_r8,0.24980e-05_r8,0.25555e-05_r8 /) + kbo(:,55, 4) = (/ & + & 0.17820e-05_r8,0.18827e-05_r8,0.19647e-05_r8,0.20347e-05_r8,0.20895e-05_r8 /) + kbo(:,56, 4) = (/ & + & 0.14445e-05_r8,0.15274e-05_r8,0.15999e-05_r8,0.16558e-05_r8,0.17004e-05_r8 /) + kbo(:,57, 4) = (/ & + & 0.11612e-05_r8,0.12390e-05_r8,0.13020e-05_r8,0.13508e-05_r8,0.13881e-05_r8 /) + kbo(:,58, 4) = (/ & + & 0.93606e-06_r8,0.10017e-05_r8,0.10598e-05_r8,0.11016e-05_r8,0.11367e-05_r8 /) + kbo(:,59, 4) = (/ & + & 0.76682e-06_r8,0.82318e-06_r8,0.87281e-06_r8,0.91208e-06_r8,0.94037e-06_r8 /) + kbo(:,13, 5) = (/ & + & 0.12856e-01_r8,0.13079e-01_r8,0.13167e-01_r8,0.13177e-01_r8,0.13097e-01_r8 /) + kbo(:,14, 5) = (/ & + & 0.10708e-01_r8,0.10853e-01_r8,0.10911e-01_r8,0.10898e-01_r8,0.10814e-01_r8 /) + kbo(:,15, 5) = (/ & + & 0.88690e-02_r8,0.89759e-02_r8,0.90116e-02_r8,0.89730e-02_r8,0.88895e-02_r8 /) + kbo(:,16, 5) = (/ & + & 0.73377e-02_r8,0.74116e-02_r8,0.74224e-02_r8,0.73845e-02_r8,0.73097e-02_r8 /) + kbo(:,17, 5) = (/ & + & 0.61050e-02_r8,0.61465e-02_r8,0.61522e-02_r8,0.61190e-02_r8,0.60607e-02_r8 /) + kbo(:,18, 5) = (/ & + & 0.51170e-02_r8,0.51524e-02_r8,0.51567e-02_r8,0.51299e-02_r8,0.50853e-02_r8 /) + kbo(:,19, 5) = (/ & + & 0.42872e-02_r8,0.43210e-02_r8,0.43249e-02_r8,0.43090e-02_r8,0.42772e-02_r8 /) + kbo(:,20, 5) = (/ & + & 0.35726e-02_r8,0.35987e-02_r8,0.36030e-02_r8,0.35888e-02_r8,0.35606e-02_r8 /) + kbo(:,21, 5) = (/ & + & 0.29687e-02_r8,0.29865e-02_r8,0.29887e-02_r8,0.29805e-02_r8,0.29536e-02_r8 /) + kbo(:,22, 5) = (/ & + & 0.24631e-02_r8,0.24766e-02_r8,0.24818e-02_r8,0.24706e-02_r8,0.24511e-02_r8 /) + kbo(:,23, 5) = (/ & + & 0.20423e-02_r8,0.20574e-02_r8,0.20622e-02_r8,0.20550e-02_r8,0.20390e-02_r8 /) + kbo(:,24, 5) = (/ & + & 0.17009e-02_r8,0.17137e-02_r8,0.17151e-02_r8,0.17066e-02_r8,0.16944e-02_r8 /) + kbo(:,25, 5) = (/ & + & 0.14175e-02_r8,0.14281e-02_r8,0.14264e-02_r8,0.14202e-02_r8,0.14101e-02_r8 /) + kbo(:,26, 5) = (/ & + & 0.11824e-02_r8,0.11879e-02_r8,0.11852e-02_r8,0.11799e-02_r8,0.11727e-02_r8 /) + kbo(:,27, 5) = (/ & + & 0.98538e-03_r8,0.98799e-03_r8,0.98648e-03_r8,0.98258e-03_r8,0.97798e-03_r8 /) + kbo(:,28, 5) = (/ & + & 0.82156e-03_r8,0.82317e-03_r8,0.82299e-03_r8,0.82154e-03_r8,0.81913e-03_r8 /) + kbo(:,29, 5) = (/ & + & 0.68689e-03_r8,0.68935e-03_r8,0.68992e-03_r8,0.69010e-03_r8,0.68854e-03_r8 /) + kbo(:,30, 5) = (/ & + & 0.57658e-03_r8,0.57999e-03_r8,0.58178e-03_r8,0.58209e-03_r8,0.58220e-03_r8 /) + kbo(:,31, 5) = (/ & + & 0.48638e-03_r8,0.49049e-03_r8,0.49261e-03_r8,0.49405e-03_r8,0.49565e-03_r8 /) + kbo(:,32, 5) = (/ & + & 0.41128e-03_r8,0.41527e-03_r8,0.41847e-03_r8,0.42111e-03_r8,0.42278e-03_r8 /) + kbo(:,33, 5) = (/ & + & 0.34942e-03_r8,0.35347e-03_r8,0.35669e-03_r8,0.35970e-03_r8,0.36033e-03_r8 /) + kbo(:,34, 5) = (/ & + & 0.29778e-03_r8,0.30183e-03_r8,0.30543e-03_r8,0.30722e-03_r8,0.30756e-03_r8 /) + kbo(:,35, 5) = (/ & + & 0.25439e-03_r8,0.25855e-03_r8,0.26145e-03_r8,0.26279e-03_r8,0.26328e-03_r8 /) + kbo(:,36, 5) = (/ & + & 0.21688e-03_r8,0.22055e-03_r8,0.22366e-03_r8,0.22472e-03_r8,0.22545e-03_r8 /) + kbo(:,37, 5) = (/ & + & 0.18184e-03_r8,0.18525e-03_r8,0.18789e-03_r8,0.18888e-03_r8,0.18981e-03_r8 /) + kbo(:,38, 5) = (/ & + & 0.15217e-03_r8,0.15529e-03_r8,0.15752e-03_r8,0.15878e-03_r8,0.15947e-03_r8 /) + kbo(:,39, 5) = (/ & + & 0.12738e-03_r8,0.13010e-03_r8,0.13202e-03_r8,0.13325e-03_r8,0.13405e-03_r8 /) + kbo(:,40, 5) = (/ & + & 0.10533e-03_r8,0.10771e-03_r8,0.10944e-03_r8,0.11063e-03_r8,0.11132e-03_r8 /) + kbo(:,41, 5) = (/ & + & 0.86935e-04_r8,0.89079e-04_r8,0.90576e-04_r8,0.91599e-04_r8,0.92136e-04_r8 /) + kbo(:,42, 5) = (/ & + & 0.71757e-04_r8,0.73600e-04_r8,0.74913e-04_r8,0.75823e-04_r8,0.76332e-04_r8 /) + kbo(:,43, 5) = (/ & + & 0.58933e-04_r8,0.60448e-04_r8,0.61689e-04_r8,0.62502e-04_r8,0.62968e-04_r8 /) + kbo(:,44, 5) = (/ & + & 0.48240e-04_r8,0.49626e-04_r8,0.50671e-04_r8,0.51353e-04_r8,0.51808e-04_r8 /) + kbo(:,45, 5) = (/ & + & 0.39365e-04_r8,0.40603e-04_r8,0.41556e-04_r8,0.42201e-04_r8,0.42661e-04_r8 /) + kbo(:,46, 5) = (/ & + & 0.32140e-04_r8,0.33199e-04_r8,0.34102e-04_r8,0.34681e-04_r8,0.35122e-04_r8 /) + kbo(:,47, 5) = (/ & + & 0.26212e-04_r8,0.27122e-04_r8,0.27914e-04_r8,0.28482e-04_r8,0.28883e-04_r8 /) + kbo(:,48, 5) = (/ & + & 0.21367e-04_r8,0.22132e-04_r8,0.22808e-04_r8,0.23366e-04_r8,0.23750e-04_r8 /) + kbo(:,49, 5) = (/ & + & 0.17366e-04_r8,0.18036e-04_r8,0.18610e-04_r8,0.19128e-04_r8,0.19501e-04_r8 /) + kbo(:,50, 5) = (/ & + & 0.14166e-04_r8,0.14744e-04_r8,0.15227e-04_r8,0.15695e-04_r8,0.16033e-04_r8 /) + kbo(:,51, 5) = (/ & + & 0.11520e-04_r8,0.12036e-04_r8,0.12466e-04_r8,0.12850e-04_r8,0.13177e-04_r8 /) + kbo(:,52, 5) = (/ & + & 0.93545e-05_r8,0.97967e-05_r8,0.10185e-04_r8,0.10504e-04_r8,0.10808e-04_r8 /) + kbo(:,53, 5) = (/ & + & 0.75900e-05_r8,0.79775e-05_r8,0.83066e-05_r8,0.85876e-05_r8,0.88446e-05_r8 /) + kbo(:,54, 5) = (/ & + & 0.61841e-05_r8,0.65213e-05_r8,0.67983e-05_r8,0.70299e-05_r8,0.72479e-05_r8 /) + kbo(:,55, 5) = (/ & + & 0.50267e-05_r8,0.53142e-05_r8,0.55644e-05_r8,0.57696e-05_r8,0.59449e-05_r8 /) + kbo(:,56, 5) = (/ & + & 0.40664e-05_r8,0.43169e-05_r8,0.45344e-05_r8,0.47274e-05_r8,0.48783e-05_r8 /) + kbo(:,57, 5) = (/ & + & 0.32881e-05_r8,0.34993e-05_r8,0.36900e-05_r8,0.38580e-05_r8,0.39983e-05_r8 /) + kbo(:,58, 5) = (/ & + & 0.26562e-05_r8,0.28386e-05_r8,0.30033e-05_r8,0.31435e-05_r8,0.32655e-05_r8 /) + kbo(:,59, 5) = (/ & + & 0.21842e-05_r8,0.23355e-05_r8,0.24742e-05_r8,0.25918e-05_r8,0.26979e-05_r8 /) + kbo(:,13, 6) = (/ & + & 0.31802e-01_r8,0.32385e-01_r8,0.32761e-01_r8,0.32924e-01_r8,0.32887e-01_r8 /) + kbo(:,14, 6) = (/ & + & 0.27075e-01_r8,0.27526e-01_r8,0.27777e-01_r8,0.27825e-01_r8,0.27714e-01_r8 /) + kbo(:,15, 6) = (/ & + & 0.22867e-01_r8,0.23213e-01_r8,0.23346e-01_r8,0.23326e-01_r8,0.23192e-01_r8 /) + kbo(:,16, 6) = (/ & + & 0.19243e-01_r8,0.19469e-01_r8,0.19534e-01_r8,0.19508e-01_r8,0.19374e-01_r8 /) + kbo(:,17, 6) = (/ & + & 0.16143e-01_r8,0.16291e-01_r8,0.16340e-01_r8,0.16286e-01_r8,0.16140e-01_r8 /) + kbo(:,18, 6) = (/ & + & 0.13508e-01_r8,0.13619e-01_r8,0.13632e-01_r8,0.13563e-01_r8,0.13444e-01_r8 /) + kbo(:,19, 6) = (/ & + & 0.11360e-01_r8,0.11423e-01_r8,0.11418e-01_r8,0.11354e-01_r8,0.11254e-01_r8 /) + kbo(:,20, 6) = (/ & + & 0.95257e-02_r8,0.95677e-02_r8,0.95569e-02_r8,0.94993e-02_r8,0.94147e-02_r8 /) + kbo(:,21, 6) = (/ & + & 0.79688e-02_r8,0.80079e-02_r8,0.79930e-02_r8,0.79576e-02_r8,0.78976e-02_r8 /) + kbo(:,22, 6) = (/ & + & 0.66527e-02_r8,0.66824e-02_r8,0.66717e-02_r8,0.66442e-02_r8,0.65988e-02_r8 /) + kbo(:,23, 6) = (/ & + & 0.55583e-02_r8,0.55741e-02_r8,0.55685e-02_r8,0.55458e-02_r8,0.55136e-02_r8 /) + kbo(:,24, 6) = (/ & + & 0.46281e-02_r8,0.46404e-02_r8,0.46354e-02_r8,0.46240e-02_r8,0.46070e-02_r8 /) + kbo(:,25, 6) = (/ & + & 0.38479e-02_r8,0.38586e-02_r8,0.38647e-02_r8,0.38587e-02_r8,0.38482e-02_r8 /) + kbo(:,26, 6) = (/ & + & 0.31996e-02_r8,0.32113e-02_r8,0.32185e-02_r8,0.32206e-02_r8,0.32221e-02_r8 /) + kbo(:,27, 6) = (/ & + & 0.26655e-02_r8,0.26804e-02_r8,0.26909e-02_r8,0.27001e-02_r8,0.27000e-02_r8 /) + kbo(:,28, 6) = (/ & + & 0.22269e-02_r8,0.22430e-02_r8,0.22546e-02_r8,0.22636e-02_r8,0.22685e-02_r8 /) + kbo(:,29, 6) = (/ & + & 0.18711e-02_r8,0.18853e-02_r8,0.19010e-02_r8,0.19079e-02_r8,0.19146e-02_r8 /) + kbo(:,30, 6) = (/ & + & 0.15792e-02_r8,0.15950e-02_r8,0.16049e-02_r8,0.16149e-02_r8,0.16250e-02_r8 /) + kbo(:,31, 6) = (/ & + & 0.13390e-02_r8,0.13523e-02_r8,0.13631e-02_r8,0.13762e-02_r8,0.13899e-02_r8 /) + kbo(:,32, 6) = (/ & + & 0.11423e-02_r8,0.11552e-02_r8,0.11689e-02_r8,0.11828e-02_r8,0.12002e-02_r8 /) + kbo(:,33, 6) = (/ & + & 0.97837e-03_r8,0.99414e-03_r8,0.10078e-02_r8,0.10254e-02_r8,0.10445e-02_r8 /) + kbo(:,34, 6) = (/ & + & 0.84508e-03_r8,0.85961e-03_r8,0.87553e-03_r8,0.89474e-03_r8,0.91454e-03_r8 /) + kbo(:,35, 6) = (/ & + & 0.73067e-03_r8,0.74643e-03_r8,0.76522e-03_r8,0.78433e-03_r8,0.80547e-03_r8 /) + kbo(:,36, 6) = (/ & + & 0.63501e-03_r8,0.65286e-03_r8,0.67124e-03_r8,0.69177e-03_r8,0.71245e-03_r8 /) + kbo(:,37, 6) = (/ & + & 0.54302e-03_r8,0.56011e-03_r8,0.57838e-03_r8,0.59932e-03_r8,0.61930e-03_r8 /) + kbo(:,38, 6) = (/ & + & 0.46413e-03_r8,0.48141e-03_r8,0.49888e-03_r8,0.51888e-03_r8,0.53851e-03_r8 /) + kbo(:,39, 6) = (/ & + & 0.39787e-03_r8,0.41416e-03_r8,0.43137e-03_r8,0.45076e-03_r8,0.46884e-03_r8 /) + kbo(:,40, 6) = (/ & + & 0.33542e-03_r8,0.35026e-03_r8,0.36640e-03_r8,0.38421e-03_r8,0.40074e-03_r8 /) + kbo(:,41, 6) = (/ & + & 0.28198e-03_r8,0.29533e-03_r8,0.31033e-03_r8,0.32658e-03_r8,0.34246e-03_r8 /) + kbo(:,42, 6) = (/ & + & 0.23644e-03_r8,0.24877e-03_r8,0.26248e-03_r8,0.27695e-03_r8,0.29184e-03_r8 /) + kbo(:,43, 6) = (/ & + & 0.19698e-03_r8,0.20826e-03_r8,0.22042e-03_r8,0.23357e-03_r8,0.24697e-03_r8 /) + kbo(:,44, 6) = (/ & + & 0.16338e-03_r8,0.17334e-03_r8,0.18409e-03_r8,0.19557e-03_r8,0.20792e-03_r8 /) + kbo(:,45, 6) = (/ & + & 0.13558e-03_r8,0.14397e-03_r8,0.15333e-03_r8,0.16359e-03_r8,0.17463e-03_r8 /) + kbo(:,46, 6) = (/ & + & 0.11191e-03_r8,0.11919e-03_r8,0.12729e-03_r8,0.13624e-03_r8,0.14629e-03_r8 /) + kbo(:,47, 6) = (/ & + & 0.91906e-04_r8,0.98189e-04_r8,0.10520e-03_r8,0.11302e-03_r8,0.12177e-03_r8 /) + kbo(:,48, 6) = (/ & + & 0.75087e-04_r8,0.80743e-04_r8,0.86708e-04_r8,0.93427e-04_r8,0.10110e-03_r8 /) + kbo(:,49, 6) = (/ & + & 0.61186e-04_r8,0.66125e-04_r8,0.71313e-04_r8,0.77107e-04_r8,0.83777e-04_r8 /) + kbo(:,50, 6) = (/ & + & 0.49938e-04_r8,0.54303e-04_r8,0.58807e-04_r8,0.63705e-04_r8,0.69474e-04_r8 /) + kbo(:,51, 6) = (/ & + & 0.40809e-04_r8,0.44513e-04_r8,0.48369e-04_r8,0.52594e-04_r8,0.57525e-04_r8 /) + kbo(:,52, 6) = (/ & + & 0.33309e-04_r8,0.36401e-04_r8,0.39694e-04_r8,0.43295e-04_r8,0.47517e-04_r8 /) + kbo(:,53, 6) = (/ & + & 0.27001e-04_r8,0.29637e-04_r8,0.32443e-04_r8,0.35515e-04_r8,0.39073e-04_r8 /) + kbo(:,54, 6) = (/ & + & 0.21920e-04_r8,0.24176e-04_r8,0.26587e-04_r8,0.29204e-04_r8,0.32173e-04_r8 /) + kbo(:,55, 6) = (/ & + & 0.17840e-04_r8,0.19707e-04_r8,0.21784e-04_r8,0.24000e-04_r8,0.26498e-04_r8 /) + kbo(:,56, 6) = (/ & + & 0.14500e-04_r8,0.16042e-04_r8,0.17779e-04_r8,0.19655e-04_r8,0.21743e-04_r8 /) + kbo(:,57, 6) = (/ & + & 0.11756e-04_r8,0.13018e-04_r8,0.14458e-04_r8,0.16053e-04_r8,0.17779e-04_r8 /) + kbo(:,58, 6) = (/ & + & 0.95229e-05_r8,0.10574e-04_r8,0.11760e-04_r8,0.13107e-04_r8,0.14585e-04_r8 /) + kbo(:,59, 6) = (/ & + & 0.78970e-05_r8,0.87821e-05_r8,0.97860e-05_r8,0.10919e-04_r8,0.12187e-04_r8 /) + kbo(:,13, 7) = (/ & + & 0.81347e-01_r8,0.83688e-01_r8,0.85307e-01_r8,0.86283e-01_r8,0.87010e-01_r8 /) + kbo(:,14, 7) = (/ & + & 0.72041e-01_r8,0.73994e-01_r8,0.75287e-01_r8,0.76180e-01_r8,0.76714e-01_r8 /) + kbo(:,15, 7) = (/ & + & 0.63278e-01_r8,0.64818e-01_r8,0.65954e-01_r8,0.66651e-01_r8,0.67143e-01_r8 /) + kbo(:,16, 7) = (/ & + & 0.55139e-01_r8,0.56478e-01_r8,0.57384e-01_r8,0.58076e-01_r8,0.58539e-01_r8 /) + kbo(:,17, 7) = (/ & + & 0.47894e-01_r8,0.48966e-01_r8,0.49829e-01_r8,0.50447e-01_r8,0.50916e-01_r8 /) + kbo(:,18, 7) = (/ & + & 0.41499e-01_r8,0.42507e-01_r8,0.43240e-01_r8,0.43755e-01_r8,0.44135e-01_r8 /) + kbo(:,19, 7) = (/ & + & 0.35885e-01_r8,0.36754e-01_r8,0.37403e-01_r8,0.37954e-01_r8,0.38313e-01_r8 /) + kbo(:,20, 7) = (/ & + & 0.30699e-01_r8,0.31463e-01_r8,0.32108e-01_r8,0.32586e-01_r8,0.32972e-01_r8 /) + kbo(:,21, 7) = (/ & + & 0.26192e-01_r8,0.26846e-01_r8,0.27409e-01_r8,0.27839e-01_r8,0.28217e-01_r8 /) + kbo(:,22, 7) = (/ & + & 0.22340e-01_r8,0.22929e-01_r8,0.23404e-01_r8,0.23811e-01_r8,0.24187e-01_r8 /) + kbo(:,23, 7) = (/ & + & 0.19095e-01_r8,0.19575e-01_r8,0.20007e-01_r8,0.20410e-01_r8,0.20766e-01_r8 /) + kbo(:,24, 7) = (/ & + & 0.16366e-01_r8,0.16771e-01_r8,0.17186e-01_r8,0.17542e-01_r8,0.17949e-01_r8 /) + kbo(:,25, 7) = (/ & + & 0.14069e-01_r8,0.14481e-01_r8,0.14832e-01_r8,0.15200e-01_r8,0.15580e-01_r8 /) + kbo(:,26, 7) = (/ & + & 0.12162e-01_r8,0.12539e-01_r8,0.12888e-01_r8,0.13247e-01_r8,0.13615e-01_r8 /) + kbo(:,27, 7) = (/ & + & 0.10528e-01_r8,0.10892e-01_r8,0.11265e-01_r8,0.11631e-01_r8,0.12012e-01_r8 /) + kbo(:,28, 7) = (/ & + & 0.91441e-02_r8,0.95086e-02_r8,0.98896e-02_r8,0.10282e-01_r8,0.10687e-01_r8 /) + kbo(:,29, 7) = (/ & + & 0.79938e-02_r8,0.83641e-02_r8,0.87511e-02_r8,0.91674e-02_r8,0.96121e-02_r8 /) + kbo(:,30, 7) = (/ & + & 0.70400e-02_r8,0.74172e-02_r8,0.78125e-02_r8,0.82611e-02_r8,0.87532e-02_r8 /) + kbo(:,31, 7) = (/ & + & 0.62612e-02_r8,0.66491e-02_r8,0.70836e-02_r8,0.75546e-02_r8,0.80730e-02_r8 /) + kbo(:,32, 7) = (/ & + & 0.56090e-02_r8,0.60373e-02_r8,0.65021e-02_r8,0.70140e-02_r8,0.75729e-02_r8 /) + kbo(:,33, 7) = (/ & + & 0.51011e-02_r8,0.55473e-02_r8,0.60429e-02_r8,0.66026e-02_r8,0.72780e-02_r8 /) + kbo(:,34, 7) = (/ & + & 0.46990e-02_r8,0.51673e-02_r8,0.57072e-02_r8,0.63464e-02_r8,0.71159e-02_r8 /) + kbo(:,35, 7) = (/ & + & 0.43314e-02_r8,0.48384e-02_r8,0.54243e-02_r8,0.61639e-02_r8,0.69924e-02_r8 /) + kbo(:,36, 7) = (/ & + & 0.39886e-02_r8,0.45262e-02_r8,0.51941e-02_r8,0.59985e-02_r8,0.68708e-02_r8 /) + kbo(:,37, 7) = (/ & + & 0.36017e-02_r8,0.41399e-02_r8,0.48219e-02_r8,0.56481e-02_r8,0.65560e-02_r8 /) + kbo(:,38, 7) = (/ & + & 0.32617e-02_r8,0.38037e-02_r8,0.45057e-02_r8,0.53485e-02_r8,0.62708e-02_r8 /) + kbo(:,39, 7) = (/ & + & 0.29777e-02_r8,0.35364e-02_r8,0.42387e-02_r8,0.50890e-02_r8,0.60544e-02_r8 /) + kbo(:,40, 7) = (/ & + & 0.26397e-02_r8,0.31715e-02_r8,0.38573e-02_r8,0.46880e-02_r8,0.56335e-02_r8 /) + kbo(:,41, 7) = (/ & + & 0.23227e-02_r8,0.28385e-02_r8,0.34927e-02_r8,0.42880e-02_r8,0.52154e-02_r8 /) + kbo(:,42, 7) = (/ & + & 0.20486e-02_r8,0.25378e-02_r8,0.31647e-02_r8,0.39312e-02_r8,0.48261e-02_r8 /) + kbo(:,43, 7) = (/ & + & 0.17755e-02_r8,0.22226e-02_r8,0.28140e-02_r8,0.35274e-02_r8,0.43895e-02_r8 /) + kbo(:,44, 7) = (/ & + & 0.15269e-02_r8,0.19274e-02_r8,0.24688e-02_r8,0.31407e-02_r8,0.39517e-02_r8 /) + kbo(:,45, 7) = (/ & + & 0.13050e-02_r8,0.16697e-02_r8,0.21647e-02_r8,0.27916e-02_r8,0.35423e-02_r8 /) + kbo(:,46, 7) = (/ & + & 0.11057e-02_r8,0.14327e-02_r8,0.18777e-02_r8,0.24513e-02_r8,0.31448e-02_r8 /) + kbo(:,47, 7) = (/ & + & 0.92448e-03_r8,0.12134e-02_r8,0.16064e-02_r8,0.21237e-02_r8,0.27575e-02_r8 /) + kbo(:,48, 7) = (/ & + & 0.76618e-03_r8,0.10179e-02_r8,0.13627e-02_r8,0.18254e-02_r8,0.24067e-02_r8 /) + kbo(:,49, 7) = (/ & + & 0.62940e-03_r8,0.85036e-03_r8,0.11489e-02_r8,0.15623e-02_r8,0.20896e-02_r8 /) + kbo(:,50, 7) = (/ & + & 0.51855e-03_r8,0.71067e-03_r8,0.97602e-03_r8,0.13414e-02_r8,0.18179e-02_r8 /) + kbo(:,51, 7) = (/ & + & 0.42590e-03_r8,0.59305e-03_r8,0.82548e-03_r8,0.11486e-02_r8,0.15798e-02_r8 /) + kbo(:,52, 7) = (/ & + & 0.34697e-03_r8,0.49059e-03_r8,0.69535e-03_r8,0.97532e-03_r8,0.13630e-02_r8 /) + kbo(:,53, 7) = (/ & + & 0.28092e-03_r8,0.40191e-03_r8,0.57931e-03_r8,0.82673e-03_r8,0.11685e-02_r8 /) + kbo(:,54, 7) = (/ & + & 0.22883e-03_r8,0.33102e-03_r8,0.48584e-03_r8,0.70577e-03_r8,0.10069e-02_r8 /) + kbo(:,55, 7) = (/ & + & 0.18567e-03_r8,0.27212e-03_r8,0.40629e-03_r8,0.59966e-03_r8,0.86643e-03_r8 /) + kbo(:,56, 7) = (/ & + & 0.14981e-03_r8,0.22158e-03_r8,0.33702e-03_r8,0.50672e-03_r8,0.74022e-03_r8 /) + kbo(:,57, 7) = (/ & + & 0.11956e-03_r8,0.17899e-03_r8,0.27717e-03_r8,0.42406e-03_r8,0.63003e-03_r8 /) + kbo(:,58, 7) = (/ & + & 0.95581e-04_r8,0.14413e-03_r8,0.22637e-03_r8,0.35457e-03_r8,0.53700e-03_r8 /) + kbo(:,59, 7) = (/ & + & 0.81967e-04_r8,0.12578e-03_r8,0.20146e-03_r8,0.32061e-03_r8,0.49099e-03_r8 /) + kbo(:,13, 8) = (/ & + & 0.22107e+00_r8,0.22673e+00_r8,0.23188e+00_r8,0.23626e+00_r8,0.23937e+00_r8 /) + kbo(:,14, 8) = (/ & + & 0.20348e+00_r8,0.20983e+00_r8,0.21521e+00_r8,0.21960e+00_r8,0.22328e+00_r8 /) + kbo(:,15, 8) = (/ & + & 0.18724e+00_r8,0.19358e+00_r8,0.19903e+00_r8,0.20382e+00_r8,0.20780e+00_r8 /) + kbo(:,16, 8) = (/ & + & 0.17271e+00_r8,0.17902e+00_r8,0.18466e+00_r8,0.18949e+00_r8,0.19358e+00_r8 /) + kbo(:,17, 8) = (/ & + & 0.15881e+00_r8,0.16550e+00_r8,0.17139e+00_r8,0.17656e+00_r8,0.18127e+00_r8 /) + kbo(:,18, 8) = (/ & + & 0.14632e+00_r8,0.15311e+00_r8,0.15937e+00_r8,0.16532e+00_r8,0.17049e+00_r8 /) + kbo(:,19, 8) = (/ & + & 0.13481e+00_r8,0.14215e+00_r8,0.14899e+00_r8,0.15502e+00_r8,0.16068e+00_r8 /) + kbo(:,20, 8) = (/ & + & 0.12437e+00_r8,0.13191e+00_r8,0.13890e+00_r8,0.14560e+00_r8,0.15188e+00_r8 /) + kbo(:,21, 8) = (/ & + & 0.11481e+00_r8,0.12252e+00_r8,0.12982e+00_r8,0.13710e+00_r8,0.14374e+00_r8 /) + kbo(:,22, 8) = (/ & + & 0.10661e+00_r8,0.11453e+00_r8,0.12244e+00_r8,0.12996e+00_r8,0.13720e+00_r8 /) + kbo(:,23, 8) = (/ & + & 0.99573e-01_r8,0.10782e+00_r8,0.11598e+00_r8,0.12384e+00_r8,0.13154e+00_r8 /) + kbo(:,24, 8) = (/ & + & 0.93585e-01_r8,0.10212e+00_r8,0.11044e+00_r8,0.11870e+00_r8,0.12683e+00_r8 /) + kbo(:,25, 8) = (/ & + & 0.88642e-01_r8,0.97342e-01_r8,0.10600e+00_r8,0.11474e+00_r8,0.12338e+00_r8 /) + kbo(:,26, 8) = (/ & + & 0.84783e-01_r8,0.93706e-01_r8,0.10275e+00_r8,0.11190e+00_r8,0.12089e+00_r8 /) + kbo(:,27, 8) = (/ & + & 0.81924e-01_r8,0.91085e-01_r8,0.10043e+00_r8,0.11011e+00_r8,0.11942e+00_r8 /) + kbo(:,28, 8) = (/ & + & 0.79898e-01_r8,0.89495e-01_r8,0.99246e-01_r8,0.10903e+00_r8,0.11866e+00_r8 /) + kbo(:,29, 8) = (/ & + & 0.78843e-01_r8,0.88816e-01_r8,0.99112e-01_r8,0.10908e+00_r8,0.11873e+00_r8 /) + kbo(:,30, 8) = (/ & + & 0.78672e-01_r8,0.89175e-01_r8,0.99763e-01_r8,0.10991e+00_r8,0.11974e+00_r8 /) + kbo(:,31, 8) = (/ & + & 0.79471e-01_r8,0.90393e-01_r8,0.10090e+00_r8,0.11134e+00_r8,0.12148e+00_r8 /) + kbo(:,32, 8) = (/ & + & 0.81097e-01_r8,0.92118e-01_r8,0.10299e+00_r8,0.11352e+00_r8,0.12362e+00_r8 /) + kbo(:,33, 8) = (/ & + & 0.83219e-01_r8,0.94430e-01_r8,0.10536e+00_r8,0.11619e+00_r8,0.12656e+00_r8 /) + kbo(:,34, 8) = (/ & + & 0.85363e-01_r8,0.96707e-01_r8,0.10798e+00_r8,0.11904e+00_r8,0.12986e+00_r8 /) + kbo(:,35, 8) = (/ & + & 0.86741e-01_r8,0.98297e-01_r8,0.11004e+00_r8,0.12158e+00_r8,0.13234e+00_r8 /) + kbo(:,36, 8) = (/ & + & 0.87017e-01_r8,0.99113e-01_r8,0.11121e+00_r8,0.12302e+00_r8,0.13390e+00_r8 /) + kbo(:,37, 8) = (/ & + & 0.85258e-01_r8,0.97671e-01_r8,0.10985e+00_r8,0.12188e+00_r8,0.13289e+00_r8 /) + kbo(:,38, 8) = (/ & + & 0.83622e-01_r8,0.96133e-01_r8,0.10847e+00_r8,0.12060e+00_r8,0.13189e+00_r8 /) + kbo(:,39, 8) = (/ & + & 0.82148e-01_r8,0.94689e-01_r8,0.10723e+00_r8,0.11944e+00_r8,0.13102e+00_r8 /) + kbo(:,40, 8) = (/ & + & 0.78933e-01_r8,0.91494e-01_r8,0.10410e+00_r8,0.11650e+00_r8,0.12816e+00_r8 /) + kbo(:,41, 8) = (/ & + & 0.75553e-01_r8,0.88087e-01_r8,0.10066e+00_r8,0.11319e+00_r8,0.12513e+00_r8 /) + kbo(:,42, 8) = (/ & + & 0.72215e-01_r8,0.84600e-01_r8,0.97314e-01_r8,0.10990e+00_r8,0.12202e+00_r8 /) + kbo(:,43, 8) = (/ & + & 0.68050e-01_r8,0.80392e-01_r8,0.93038e-01_r8,0.10568e+00_r8,0.11811e+00_r8 /) + kbo(:,44, 8) = (/ & + & 0.63504e-01_r8,0.75885e-01_r8,0.88427e-01_r8,0.10109e+00_r8,0.11352e+00_r8 /) + kbo(:,45, 8) = (/ & + & 0.59117e-01_r8,0.71359e-01_r8,0.83835e-01_r8,0.96461e-01_r8,0.10897e+00_r8 /) + kbo(:,46, 8) = (/ & + & 0.54516e-01_r8,0.66547e-01_r8,0.79117e-01_r8,0.91745e-01_r8,0.10426e+00_r8 /) + kbo(:,47, 8) = (/ & + & 0.49520e-01_r8,0.61408e-01_r8,0.73788e-01_r8,0.86383e-01_r8,0.98886e-01_r8 /) + kbo(:,48, 8) = (/ & + & 0.44727e-01_r8,0.56224e-01_r8,0.68415e-01_r8,0.81094e-01_r8,0.93621e-01_r8 /) + kbo(:,49, 8) = (/ & + & 0.40177e-01_r8,0.51146e-01_r8,0.63191e-01_r8,0.75749e-01_r8,0.88249e-01_r8 /) + kbo(:,50, 8) = (/ & + & 0.36081e-01_r8,0.46596e-01_r8,0.58341e-01_r8,0.70769e-01_r8,0.83353e-01_r8 /) + kbo(:,51, 8) = (/ & + & 0.32278e-01_r8,0.42393e-01_r8,0.53717e-01_r8,0.65898e-01_r8,0.78578e-01_r8 /) + kbo(:,52, 8) = (/ & + & 0.28586e-01_r8,0.38352e-01_r8,0.49175e-01_r8,0.61145e-01_r8,0.73682e-01_r8 /) + kbo(:,53, 8) = (/ & + & 0.25090e-01_r8,0.34439e-01_r8,0.44807e-01_r8,0.56352e-01_r8,0.68823e-01_r8 /) + kbo(:,54, 8) = (/ & + & 0.22080e-01_r8,0.30938e-01_r8,0.40952e-01_r8,0.52101e-01_r8,0.64364e-01_r8 /) + kbo(:,55, 8) = (/ & + & 0.19382e-01_r8,0.27719e-01_r8,0.37405e-01_r8,0.48197e-01_r8,0.60044e-01_r8 /) + kbo(:,56, 8) = (/ & + & 0.16835e-01_r8,0.24689e-01_r8,0.33908e-01_r8,0.44390e-01_r8,0.55911e-01_r8 /) + kbo(:,57, 8) = (/ & + & 0.14459e-01_r8,0.21799e-01_r8,0.30531e-01_r8,0.40642e-01_r8,0.51808e-01_r8 /) + kbo(:,58, 8) = (/ & + & 0.12380e-01_r8,0.19213e-01_r8,0.27475e-01_r8,0.37204e-01_r8,0.48065e-01_r8 /) + kbo(:,59, 8) = (/ & + & 0.11536e-01_r8,0.18115e-01_r8,0.26160e-01_r8,0.35756e-01_r8,0.46501e-01_r8 /) + kbo(:,13, 9) = (/ & + & 0.79231e+00_r8,0.80247e+00_r8,0.81169e+00_r8,0.81859e+00_r8,0.82469e+00_r8 /) + kbo(:,14, 9) = (/ & + & 0.76567e+00_r8,0.77861e+00_r8,0.78976e+00_r8,0.79966e+00_r8,0.80754e+00_r8 /) + kbo(:,15, 9) = (/ & + & 0.73926e+00_r8,0.75515e+00_r8,0.76982e+00_r8,0.78244e+00_r8,0.79228e+00_r8 /) + kbo(:,16, 9) = (/ & + & 0.71308e+00_r8,0.73273e+00_r8,0.74955e+00_r8,0.76355e+00_r8,0.77553e+00_r8 /) + kbo(:,17, 9) = (/ & + & 0.68845e+00_r8,0.70973e+00_r8,0.72813e+00_r8,0.74466e+00_r8,0.75909e+00_r8 /) + kbo(:,18, 9) = (/ & + & 0.66397e+00_r8,0.68720e+00_r8,0.70872e+00_r8,0.72756e+00_r8,0.74467e+00_r8 /) + kbo(:,19, 9) = (/ & + & 0.64097e+00_r8,0.66723e+00_r8,0.69155e+00_r8,0.71362e+00_r8,0.73339e+00_r8 /) + kbo(:,20, 9) = (/ & + & 0.62162e+00_r8,0.65070e+00_r8,0.67764e+00_r8,0.70183e+00_r8,0.72348e+00_r8 /) + kbo(:,21, 9) = (/ & + & 0.60571e+00_r8,0.63800e+00_r8,0.66649e+00_r8,0.69291e+00_r8,0.71712e+00_r8 /) + kbo(:,22, 9) = (/ & + & 0.59651e+00_r8,0.62972e+00_r8,0.66058e+00_r8,0.68832e+00_r8,0.71517e+00_r8 /) + kbo(:,23, 9) = (/ & + & 0.58974e+00_r8,0.62545e+00_r8,0.65753e+00_r8,0.68785e+00_r8,0.71519e+00_r8 /) + kbo(:,24, 9) = (/ & + & 0.58721e+00_r8,0.62395e+00_r8,0.65801e+00_r8,0.68952e+00_r8,0.71705e+00_r8 /) + kbo(:,25, 9) = (/ & + & 0.58931e+00_r8,0.62554e+00_r8,0.66080e+00_r8,0.69275e+00_r8,0.72212e+00_r8 /) + kbo(:,26, 9) = (/ & + & 0.59392e+00_r8,0.63108e+00_r8,0.66576e+00_r8,0.69831e+00_r8,0.72831e+00_r8 /) + kbo(:,27, 9) = (/ & + & 0.60088e+00_r8,0.63911e+00_r8,0.67310e+00_r8,0.70594e+00_r8,0.73492e+00_r8 /) + kbo(:,28, 9) = (/ & + & 0.61058e+00_r8,0.64827e+00_r8,0.68351e+00_r8,0.71436e+00_r8,0.74248e+00_r8 /) + kbo(:,29, 9) = (/ & + & 0.62259e+00_r8,0.66086e+00_r8,0.69462e+00_r8,0.72450e+00_r8,0.75205e+00_r8 /) + kbo(:,30, 9) = (/ & + & 0.63547e+00_r8,0.67373e+00_r8,0.70715e+00_r8,0.73642e+00_r8,0.76277e+00_r8 /) + kbo(:,31, 9) = (/ & + & 0.65060e+00_r8,0.68811e+00_r8,0.72216e+00_r8,0.75104e+00_r8,0.77730e+00_r8 /) + kbo(:,32, 9) = (/ & + & 0.66635e+00_r8,0.70367e+00_r8,0.73703e+00_r8,0.76712e+00_r8,0.79450e+00_r8 /) + kbo(:,33, 9) = (/ & + & 0.68330e+00_r8,0.72114e+00_r8,0.75529e+00_r8,0.78560e+00_r8,0.81251e+00_r8 /) + kbo(:,34, 9) = (/ & + & 0.69895e+00_r8,0.73787e+00_r8,0.77209e+00_r8,0.80355e+00_r8,0.82948e+00_r8 /) + kbo(:,35, 9) = (/ & + & 0.71249e+00_r8,0.75244e+00_r8,0.78786e+00_r8,0.82021e+00_r8,0.84807e+00_r8 /) + kbo(:,36, 9) = (/ & + & 0.72352e+00_r8,0.76491e+00_r8,0.80192e+00_r8,0.83419e+00_r8,0.86330e+00_r8 /) + kbo(:,37, 9) = (/ & + & 0.72315e+00_r8,0.76487e+00_r8,0.80310e+00_r8,0.83637e+00_r8,0.86732e+00_r8 /) + kbo(:,38, 9) = (/ & + & 0.72144e+00_r8,0.76571e+00_r8,0.80444e+00_r8,0.83852e+00_r8,0.86991e+00_r8 /) + kbo(:,39, 9) = (/ & + & 0.72061e+00_r8,0.76655e+00_r8,0.80661e+00_r8,0.84238e+00_r8,0.87357e+00_r8 /) + kbo(:,40, 9) = (/ & + & 0.71071e+00_r8,0.75799e+00_r8,0.79882e+00_r8,0.83566e+00_r8,0.86813e+00_r8 /) + kbo(:,41, 9) = (/ & + & 0.69960e+00_r8,0.74652e+00_r8,0.79034e+00_r8,0.82858e+00_r8,0.86201e+00_r8 /) + kbo(:,42, 9) = (/ & + & 0.68767e+00_r8,0.73584e+00_r8,0.78080e+00_r8,0.82018e+00_r8,0.85505e+00_r8 /) + kbo(:,43, 9) = (/ & + & 0.67181e+00_r8,0.72136e+00_r8,0.76709e+00_r8,0.80803e+00_r8,0.84449e+00_r8 /) + kbo(:,44, 9) = (/ & + & 0.65485e+00_r8,0.70505e+00_r8,0.75190e+00_r8,0.79482e+00_r8,0.83260e+00_r8 /) + kbo(:,45, 9) = (/ & + & 0.63639e+00_r8,0.68756e+00_r8,0.73541e+00_r8,0.78029e+00_r8,0.82060e+00_r8 /) + kbo(:,46, 9) = (/ & + & 0.61610e+00_r8,0.67008e+00_r8,0.71893e+00_r8,0.76424e+00_r8,0.80647e+00_r8 /) + kbo(:,47, 9) = (/ & + & 0.59373e+00_r8,0.64972e+00_r8,0.69969e+00_r8,0.74707e+00_r8,0.79068e+00_r8 /) + kbo(:,48, 9) = (/ & + & 0.56865e+00_r8,0.62791e+00_r8,0.68069e+00_r8,0.72878e+00_r8,0.77390e+00_r8 /) + kbo(:,49, 9) = (/ & + & 0.54350e+00_r8,0.60516e+00_r8,0.66027e+00_r8,0.71007e+00_r8,0.75592e+00_r8 /) + kbo(:,50, 9) = (/ & + & 0.51991e+00_r8,0.58375e+00_r8,0.64136e+00_r8,0.69342e+00_r8,0.74093e+00_r8 /) + kbo(:,51, 9) = (/ & + & 0.49673e+00_r8,0.56229e+00_r8,0.62200e+00_r8,0.67685e+00_r8,0.72556e+00_r8 /) + kbo(:,52, 9) = (/ & + & 0.47256e+00_r8,0.53950e+00_r8,0.60133e+00_r8,0.65838e+00_r8,0.70926e+00_r8 /) + kbo(:,53, 9) = (/ & + & 0.44771e+00_r8,0.51552e+00_r8,0.57980e+00_r8,0.63854e+00_r8,0.69202e+00_r8 /) + kbo(:,54, 9) = (/ & + & 0.42506e+00_r8,0.49358e+00_r8,0.56009e+00_r8,0.62090e+00_r8,0.67547e+00_r8 /) + kbo(:,55, 9) = (/ & + & 0.40218e+00_r8,0.47240e+00_r8,0.53999e+00_r8,0.60216e+00_r8,0.65925e+00_r8 /) + kbo(:,56, 9) = (/ & + & 0.37888e+00_r8,0.45101e+00_r8,0.51913e+00_r8,0.58357e+00_r8,0.64216e+00_r8 /) + kbo(:,57, 9) = (/ & + & 0.35513e+00_r8,0.42824e+00_r8,0.49765e+00_r8,0.56376e+00_r8,0.62409e+00_r8 /) + kbo(:,58, 9) = (/ & + & 0.33174e+00_r8,0.40632e+00_r8,0.47713e+00_r8,0.54453e+00_r8,0.60605e+00_r8 /) + kbo(:,59, 9) = (/ & + & 0.32315e+00_r8,0.39758e+00_r8,0.46935e+00_r8,0.53732e+00_r8,0.59942e+00_r8 /) + kbo(:,13,10) = (/ & + & 0.20814e+01_r8,0.20759e+01_r8,0.20660e+01_r8,0.20703e+01_r8,0.20598e+01_r8 /) + kbo(:,14,10) = (/ & + & 0.20861e+01_r8,0.20862e+01_r8,0.20902e+01_r8,0.20921e+01_r8,0.20850e+01_r8 /) + kbo(:,15,10) = (/ & + & 0.20793e+01_r8,0.20969e+01_r8,0.21057e+01_r8,0.21014e+01_r8,0.21089e+01_r8 /) + kbo(:,16,10) = (/ & + & 0.20801e+01_r8,0.20948e+01_r8,0.21151e+01_r8,0.21351e+01_r8,0.21560e+01_r8 /) + kbo(:,17,10) = (/ & + & 0.20802e+01_r8,0.21249e+01_r8,0.21608e+01_r8,0.21842e+01_r8,0.21924e+01_r8 /) + kbo(:,18,10) = (/ & + & 0.20972e+01_r8,0.21483e+01_r8,0.21814e+01_r8,0.21999e+01_r8,0.22088e+01_r8 /) + kbo(:,19,10) = (/ & + & 0.21086e+01_r8,0.21513e+01_r8,0.21845e+01_r8,0.22099e+01_r8,0.22261e+01_r8 /) + kbo(:,20,10) = (/ & + & 0.21001e+01_r8,0.21488e+01_r8,0.21917e+01_r8,0.22212e+01_r8,0.22394e+01_r8 /) + kbo(:,21,10) = (/ & + & 0.20945e+01_r8,0.21494e+01_r8,0.22004e+01_r8,0.22330e+01_r8,0.22537e+01_r8 /) + kbo(:,22,10) = (/ & + & 0.20951e+01_r8,0.21635e+01_r8,0.22151e+01_r8,0.22483e+01_r8,0.22658e+01_r8 /) + kbo(:,23,10) = (/ & + & 0.21106e+01_r8,0.21802e+01_r8,0.22288e+01_r8,0.22593e+01_r8,0.22769e+01_r8 /) + kbo(:,24,10) = (/ & + & 0.21251e+01_r8,0.21978e+01_r8,0.22479e+01_r8,0.22750e+01_r8,0.23069e+01_r8 /) + kbo(:,25,10) = (/ & + & 0.21350e+01_r8,0.22127e+01_r8,0.22620e+01_r8,0.22919e+01_r8,0.23205e+01_r8 /) + kbo(:,26,10) = (/ & + & 0.21397e+01_r8,0.22248e+01_r8,0.22778e+01_r8,0.23148e+01_r8,0.23338e+01_r8 /) + kbo(:,27,10) = (/ & + & 0.21476e+01_r8,0.22244e+01_r8,0.22911e+01_r8,0.23271e+01_r8,0.23529e+01_r8 /) + kbo(:,28,10) = (/ & + & 0.21502e+01_r8,0.22263e+01_r8,0.22854e+01_r8,0.23382e+01_r8,0.23803e+01_r8 /) + kbo(:,29,10) = (/ & + & 0.21444e+01_r8,0.22159e+01_r8,0.22839e+01_r8,0.23447e+01_r8,0.24026e+01_r8 /) + kbo(:,30,10) = (/ & + & 0.21459e+01_r8,0.22135e+01_r8,0.22803e+01_r8,0.23564e+01_r8,0.24114e+01_r8 /) + kbo(:,31,10) = (/ & + & 0.21548e+01_r8,0.22131e+01_r8,0.22785e+01_r8,0.23559e+01_r8,0.23993e+01_r8 /) + kbo(:,32,10) = (/ & + & 0.21820e+01_r8,0.22366e+01_r8,0.23010e+01_r8,0.23445e+01_r8,0.23808e+01_r8 /) + kbo(:,33,10) = (/ & + & 0.22356e+01_r8,0.22739e+01_r8,0.22923e+01_r8,0.23386e+01_r8,0.23842e+01_r8 /) + kbo(:,34,10) = (/ & + & 0.22861e+01_r8,0.23162e+01_r8,0.23352e+01_r8,0.23408e+01_r8,0.23839e+01_r8 /) + kbo(:,35,10) = (/ & + & 0.23385e+01_r8,0.23680e+01_r8,0.23728e+01_r8,0.23741e+01_r8,0.23938e+01_r8 /) + kbo(:,36,10) = (/ & + & 0.23851e+01_r8,0.24072e+01_r8,0.24258e+01_r8,0.24337e+01_r8,0.24446e+01_r8 /) + kbo(:,37,10) = (/ & + & 0.23954e+01_r8,0.24271e+01_r8,0.24525e+01_r8,0.24638e+01_r8,0.24744e+01_r8 /) + kbo(:,38,10) = (/ & + & 0.24138e+01_r8,0.24360e+01_r8,0.24658e+01_r8,0.24931e+01_r8,0.25112e+01_r8 /) + kbo(:,39,10) = (/ & + & 0.24207e+01_r8,0.24415e+01_r8,0.24747e+01_r8,0.25054e+01_r8,0.25446e+01_r8 /) + kbo(:,40,10) = (/ & + & 0.24183e+01_r8,0.24401e+01_r8,0.24836e+01_r8,0.25135e+01_r8,0.25532e+01_r8 /) + kbo(:,41,10) = (/ & + & 0.24046e+01_r8,0.24486e+01_r8,0.24788e+01_r8,0.25037e+01_r8,0.25503e+01_r8 /) + kbo(:,42,10) = (/ & + & 0.23965e+01_r8,0.24448e+01_r8,0.24659e+01_r8,0.25035e+01_r8,0.25440e+01_r8 /) + kbo(:,43,10) = (/ & + & 0.23757e+01_r8,0.24456e+01_r8,0.24672e+01_r8,0.25043e+01_r8,0.25340e+01_r8 /) + kbo(:,44,10) = (/ & + & 0.23417e+01_r8,0.24271e+01_r8,0.24708e+01_r8,0.24891e+01_r8,0.25157e+01_r8 /) + kbo(:,45,10) = (/ & + & 0.23140e+01_r8,0.24224e+01_r8,0.24648e+01_r8,0.24895e+01_r8,0.25109e+01_r8 /) + kbo(:,46,10) = (/ & + & 0.22839e+01_r8,0.23815e+01_r8,0.24548e+01_r8,0.24874e+01_r8,0.24983e+01_r8 /) + kbo(:,47,10) = (/ & + & 0.22509e+01_r8,0.23585e+01_r8,0.24548e+01_r8,0.24976e+01_r8,0.25158e+01_r8 /) + kbo(:,48,10) = (/ & + & 0.22243e+01_r8,0.23182e+01_r8,0.24167e+01_r8,0.24851e+01_r8,0.25144e+01_r8 /) + kbo(:,49,10) = (/ & + & 0.21934e+01_r8,0.22838e+01_r8,0.23882e+01_r8,0.24694e+01_r8,0.25145e+01_r8 /) + kbo(:,50,10) = (/ & + & 0.21637e+01_r8,0.22591e+01_r8,0.23593e+01_r8,0.24450e+01_r8,0.25097e+01_r8 /) + kbo(:,51,10) = (/ & + & 0.21256e+01_r8,0.22383e+01_r8,0.23340e+01_r8,0.24239e+01_r8,0.25025e+01_r8 /) + kbo(:,52,10) = (/ & + & 0.20804e+01_r8,0.22090e+01_r8,0.23144e+01_r8,0.24005e+01_r8,0.24803e+01_r8 /) + kbo(:,53,10) = (/ & + & 0.20229e+01_r8,0.21712e+01_r8,0.22790e+01_r8,0.23709e+01_r8,0.24497e+01_r8 /) + kbo(:,54,10) = (/ & + & 0.19647e+01_r8,0.21430e+01_r8,0.22514e+01_r8,0.23430e+01_r8,0.24343e+01_r8 /) + kbo(:,55,10) = (/ & + & 0.19094e+01_r8,0.20990e+01_r8,0.22287e+01_r8,0.23283e+01_r8,0.24126e+01_r8 /) + kbo(:,56,10) = (/ & + & 0.18499e+01_r8,0.20432e+01_r8,0.21961e+01_r8,0.22965e+01_r8,0.23921e+01_r8 /) + kbo(:,57,10) = (/ & + & 0.17845e+01_r8,0.19868e+01_r8,0.21557e+01_r8,0.22661e+01_r8,0.23666e+01_r8 /) + kbo(:,58,10) = (/ & + & 0.17304e+01_r8,0.19324e+01_r8,0.21130e+01_r8,0.22379e+01_r8,0.23344e+01_r8 /) + kbo(:,59,10) = (/ & + & 0.17036e+01_r8,0.19129e+01_r8,0.20925e+01_r8,0.22299e+01_r8,0.23291e+01_r8 /) + kbo(:,13,11) = (/ & + & 0.28487e+01_r8,0.28532e+01_r8,0.28392e+01_r8,0.28113e+01_r8,0.28077e+01_r8 /) + kbo(:,14,11) = (/ & + & 0.29217e+01_r8,0.29135e+01_r8,0.28970e+01_r8,0.28895e+01_r8,0.29104e+01_r8 /) + kbo(:,15,11) = (/ & + & 0.29720e+01_r8,0.29567e+01_r8,0.29515e+01_r8,0.29771e+01_r8,0.29749e+01_r8 /) + kbo(:,16,11) = (/ & + & 0.29934e+01_r8,0.30029e+01_r8,0.30226e+01_r8,0.30339e+01_r8,0.30204e+01_r8 /) + kbo(:,17,11) = (/ & + & 0.30408e+01_r8,0.30652e+01_r8,0.30797e+01_r8,0.30959e+01_r8,0.31120e+01_r8 /) + kbo(:,18,11) = (/ & + & 0.31059e+01_r8,0.31457e+01_r8,0.31893e+01_r8,0.32154e+01_r8,0.32284e+01_r8 /) + kbo(:,19,11) = (/ & + & 0.31895e+01_r8,0.32505e+01_r8,0.32863e+01_r8,0.32994e+01_r8,0.32949e+01_r8 /) + kbo(:,20,11) = (/ & + & 0.32605e+01_r8,0.33203e+01_r8,0.33389e+01_r8,0.33469e+01_r8,0.33350e+01_r8 /) + kbo(:,21,11) = (/ & + & 0.33097e+01_r8,0.33567e+01_r8,0.33762e+01_r8,0.33842e+01_r8,0.33798e+01_r8 /) + kbo(:,22,11) = (/ & + & 0.33482e+01_r8,0.33901e+01_r8,0.34068e+01_r8,0.34227e+01_r8,0.34010e+01_r8 /) + kbo(:,23,11) = (/ & + & 0.33722e+01_r8,0.34154e+01_r8,0.34438e+01_r8,0.34434e+01_r8,0.34235e+01_r8 /) + kbo(:,24,11) = (/ & + & 0.33951e+01_r8,0.34377e+01_r8,0.34659e+01_r8,0.34658e+01_r8,0.34557e+01_r8 /) + kbo(:,25,11) = (/ & + & 0.34209e+01_r8,0.34720e+01_r8,0.34904e+01_r8,0.34950e+01_r8,0.34725e+01_r8 /) + kbo(:,26,11) = (/ & + & 0.34497e+01_r8,0.34967e+01_r8,0.35233e+01_r8,0.35072e+01_r8,0.34967e+01_r8 /) + kbo(:,27,11) = (/ & + & 0.34791e+01_r8,0.35327e+01_r8,0.35370e+01_r8,0.35122e+01_r8,0.35139e+01_r8 /) + kbo(:,28,11) = (/ & + & 0.35134e+01_r8,0.35471e+01_r8,0.35465e+01_r8,0.35405e+01_r8,0.35525e+01_r8 /) + kbo(:,29,11) = (/ & + & 0.35424e+01_r8,0.35704e+01_r8,0.35632e+01_r8,0.35824e+01_r8,0.35567e+01_r8 /) + kbo(:,30,11) = (/ & + & 0.35629e+01_r8,0.35947e+01_r8,0.35992e+01_r8,0.36011e+01_r8,0.36027e+01_r8 /) + kbo(:,31,11) = (/ & + & 0.35753e+01_r8,0.36045e+01_r8,0.36365e+01_r8,0.36213e+01_r8,0.36310e+01_r8 /) + kbo(:,32,11) = (/ & + & 0.35596e+01_r8,0.36100e+01_r8,0.36333e+01_r8,0.36490e+01_r8,0.36651e+01_r8 /) + kbo(:,33,11) = (/ & + & 0.35241e+01_r8,0.35883e+01_r8,0.36383e+01_r8,0.36740e+01_r8,0.36685e+01_r8 /) + kbo(:,34,11) = (/ & + & 0.35027e+01_r8,0.35491e+01_r8,0.36249e+01_r8,0.36739e+01_r8,0.36810e+01_r8 /) + kbo(:,35,11) = (/ & + & 0.34699e+01_r8,0.35289e+01_r8,0.35926e+01_r8,0.36193e+01_r8,0.36411e+01_r8 /) + kbo(:,36,11) = (/ & + & 0.35153e+01_r8,0.35225e+01_r8,0.35498e+01_r8,0.35989e+01_r8,0.36429e+01_r8 /) + kbo(:,37,11) = (/ & + & 0.35644e+01_r8,0.35488e+01_r8,0.35358e+01_r8,0.35755e+01_r8,0.36247e+01_r8 /) + kbo(:,38,11) = (/ & + & 0.35952e+01_r8,0.35902e+01_r8,0.35685e+01_r8,0.35598e+01_r8,0.35995e+01_r8 /) + kbo(:,39,11) = (/ & + & 0.36371e+01_r8,0.36388e+01_r8,0.36159e+01_r8,0.35751e+01_r8,0.35930e+01_r8 /) + kbo(:,40,11) = (/ & + & 0.36530e+01_r8,0.36611e+01_r8,0.36495e+01_r8,0.35923e+01_r8,0.35985e+01_r8 /) + kbo(:,41,11) = (/ & + & 0.36431e+01_r8,0.36852e+01_r8,0.36606e+01_r8,0.36324e+01_r8,0.35949e+01_r8 /) + kbo(:,42,11) = (/ & + & 0.36510e+01_r8,0.36940e+01_r8,0.36905e+01_r8,0.36729e+01_r8,0.36122e+01_r8 /) + kbo(:,43,11) = (/ & + & 0.36633e+01_r8,0.36955e+01_r8,0.37103e+01_r8,0.36924e+01_r8,0.36526e+01_r8 /) + kbo(:,44,11) = (/ & + & 0.36584e+01_r8,0.36852e+01_r8,0.37131e+01_r8,0.37219e+01_r8,0.36946e+01_r8 /) + kbo(:,45,11) = (/ & + & 0.36636e+01_r8,0.36530e+01_r8,0.37160e+01_r8,0.37197e+01_r8,0.37150e+01_r8 /) + kbo(:,46,11) = (/ & + & 0.36713e+01_r8,0.36779e+01_r8,0.37130e+01_r8,0.37408e+01_r8,0.37431e+01_r8 /) + kbo(:,47,11) = (/ & + & 0.36885e+01_r8,0.36889e+01_r8,0.37012e+01_r8,0.37377e+01_r8,0.37538e+01_r8 /) + kbo(:,48,11) = (/ & + & 0.36735e+01_r8,0.37253e+01_r8,0.37092e+01_r8,0.37311e+01_r8,0.37444e+01_r8 /) + kbo(:,49,11) = (/ & + & 0.36543e+01_r8,0.37300e+01_r8,0.37306e+01_r8,0.37311e+01_r8,0.37688e+01_r8 /) + kbo(:,50,11) = (/ & + & 0.36397e+01_r8,0.37435e+01_r8,0.37659e+01_r8,0.37491e+01_r8,0.37600e+01_r8 /) + kbo(:,51,11) = (/ & + & 0.36124e+01_r8,0.37293e+01_r8,0.37963e+01_r8,0.37839e+01_r8,0.37789e+01_r8 /) + kbo(:,52,11) = (/ & + & 0.35636e+01_r8,0.37078e+01_r8,0.37818e+01_r8,0.38114e+01_r8,0.37775e+01_r8 /) + kbo(:,53,11) = (/ & + & 0.34978e+01_r8,0.36691e+01_r8,0.37922e+01_r8,0.38152e+01_r8,0.38092e+01_r8 /) + kbo(:,54,11) = (/ & + & 0.34749e+01_r8,0.36230e+01_r8,0.37686e+01_r8,0.38328e+01_r8,0.38292e+01_r8 /) + kbo(:,55,11) = (/ & + & 0.34238e+01_r8,0.35883e+01_r8,0.37261e+01_r8,0.38299e+01_r8,0.38488e+01_r8 /) + kbo(:,56,11) = (/ & + & 0.33568e+01_r8,0.35597e+01_r8,0.37073e+01_r8,0.38247e+01_r8,0.38591e+01_r8 /) + kbo(:,57,11) = (/ & + & 0.32794e+01_r8,0.35193e+01_r8,0.36712e+01_r8,0.37875e+01_r8,0.38581e+01_r8 /) + kbo(:,58,11) = (/ & + & 0.31971e+01_r8,0.34544e+01_r8,0.36268e+01_r8,0.37609e+01_r8,0.38393e+01_r8 /) + kbo(:,59,11) = (/ & + & 0.31680e+01_r8,0.34441e+01_r8,0.36338e+01_r8,0.37596e+01_r8,0.38510e+01_r8 /) + kbo(:,13,12) = (/ & + & 0.40944e+01_r8,0.40706e+01_r8,0.40738e+01_r8,0.40615e+01_r8,0.40255e+01_r8 /) + kbo(:,14,12) = (/ & + & 0.42568e+01_r8,0.42640e+01_r8,0.42578e+01_r8,0.42281e+01_r8,0.41677e+01_r8 /) + kbo(:,15,12) = (/ & + & 0.44471e+01_r8,0.44460e+01_r8,0.44235e+01_r8,0.43647e+01_r8,0.43107e+01_r8 /) + kbo(:,16,12) = (/ & + & 0.45971e+01_r8,0.45776e+01_r8,0.45277e+01_r8,0.44905e+01_r8,0.45101e+01_r8 /) + kbo(:,17,12) = (/ & + & 0.46780e+01_r8,0.46358e+01_r8,0.46311e+01_r8,0.46380e+01_r8,0.46103e+01_r8 /) + kbo(:,18,12) = (/ & + & 0.47294e+01_r8,0.47444e+01_r8,0.47418e+01_r8,0.47299e+01_r8,0.47059e+01_r8 /) + kbo(:,19,12) = (/ & + & 0.48604e+01_r8,0.48842e+01_r8,0.48819e+01_r8,0.49000e+01_r8,0.48969e+01_r8 /) + kbo(:,20,12) = (/ & + & 0.49979e+01_r8,0.50271e+01_r8,0.50614e+01_r8,0.50783e+01_r8,0.50637e+01_r8 /) + kbo(:,21,12) = (/ & + & 0.51216e+01_r8,0.51841e+01_r8,0.52155e+01_r8,0.52098e+01_r8,0.51706e+01_r8 /) + kbo(:,22,12) = (/ & + & 0.52796e+01_r8,0.53177e+01_r8,0.53275e+01_r8,0.53003e+01_r8,0.52540e+01_r8 /) + kbo(:,23,12) = (/ & + & 0.54021e+01_r8,0.54214e+01_r8,0.54107e+01_r8,0.53770e+01_r8,0.53308e+01_r8 /) + kbo(:,24,12) = (/ & + & 0.54951e+01_r8,0.54954e+01_r8,0.54655e+01_r8,0.54275e+01_r8,0.53548e+01_r8 /) + kbo(:,25,12) = (/ & + & 0.55606e+01_r8,0.55401e+01_r8,0.55126e+01_r8,0.54611e+01_r8,0.53900e+01_r8 /) + kbo(:,26,12) = (/ & + & 0.56084e+01_r8,0.55775e+01_r8,0.55344e+01_r8,0.54935e+01_r8,0.53765e+01_r8 /) + kbo(:,27,12) = (/ & + & 0.56424e+01_r8,0.55975e+01_r8,0.55674e+01_r8,0.55057e+01_r8,0.54137e+01_r8 /) + kbo(:,28,12) = (/ & + & 0.56582e+01_r8,0.56350e+01_r8,0.55811e+01_r8,0.55009e+01_r8,0.54160e+01_r8 /) + kbo(:,29,12) = (/ & + & 0.56833e+01_r8,0.56401e+01_r8,0.55975e+01_r8,0.55109e+01_r8,0.54249e+01_r8 /) + kbo(:,30,12) = (/ & + & 0.57003e+01_r8,0.56620e+01_r8,0.55904e+01_r8,0.55121e+01_r8,0.54542e+01_r8 /) + kbo(:,31,12) = (/ & + & 0.57132e+01_r8,0.56848e+01_r8,0.56091e+01_r8,0.55447e+01_r8,0.55236e+01_r8 /) + kbo(:,32,12) = (/ & + & 0.57800e+01_r8,0.57027e+01_r8,0.56220e+01_r8,0.56024e+01_r8,0.55523e+01_r8 /) + kbo(:,33,12) = (/ & + & 0.57668e+01_r8,0.57069e+01_r8,0.56826e+01_r8,0.56406e+01_r8,0.56224e+01_r8 /) + kbo(:,34,12) = (/ & + & 0.57877e+01_r8,0.57628e+01_r8,0.57465e+01_r8,0.57131e+01_r8,0.56752e+01_r8 /) + kbo(:,35,12) = (/ & + & 0.58053e+01_r8,0.58032e+01_r8,0.57814e+01_r8,0.58008e+01_r8,0.57412e+01_r8 /) + kbo(:,36,12) = (/ & + & 0.57386e+01_r8,0.58034e+01_r8,0.57934e+01_r8,0.57973e+01_r8,0.57760e+01_r8 /) + kbo(:,37,12) = (/ & + & 0.56650e+01_r8,0.57400e+01_r8,0.57795e+01_r8,0.58096e+01_r8,0.57723e+01_r8 /) + kbo(:,38,12) = (/ & + & 0.56068e+01_r8,0.56512e+01_r8,0.57137e+01_r8,0.58154e+01_r8,0.57795e+01_r8 /) + kbo(:,39,12) = (/ & + & 0.55712e+01_r8,0.56156e+01_r8,0.56456e+01_r8,0.57952e+01_r8,0.57768e+01_r8 /) + kbo(:,40,12) = (/ & + & 0.55331e+01_r8,0.55774e+01_r8,0.56049e+01_r8,0.57462e+01_r8,0.57382e+01_r8 /) + kbo(:,41,12) = (/ & + & 0.55579e+01_r8,0.55330e+01_r8,0.55754e+01_r8,0.56805e+01_r8,0.57245e+01_r8 /) + kbo(:,42,12) = (/ & + & 0.55684e+01_r8,0.55372e+01_r8,0.55455e+01_r8,0.56019e+01_r8,0.57291e+01_r8 /) + kbo(:,43,12) = (/ & + & 0.56282e+01_r8,0.55547e+01_r8,0.55863e+01_r8,0.55852e+01_r8,0.56892e+01_r8 /) + kbo(:,44,12) = (/ & + & 0.56429e+01_r8,0.55998e+01_r8,0.55663e+01_r8,0.55662e+01_r8,0.56522e+01_r8 /) + kbo(:,45,12) = (/ & + & 0.56488e+01_r8,0.56642e+01_r8,0.55915e+01_r8,0.56136e+01_r8,0.56176e+01_r8 /) + kbo(:,46,12) = (/ & + & 0.57246e+01_r8,0.57165e+01_r8,0.56557e+01_r8,0.56271e+01_r8,0.56227e+01_r8 /) + kbo(:,47,12) = (/ & + & 0.57406e+01_r8,0.57550e+01_r8,0.57336e+01_r8,0.56616e+01_r8,0.56928e+01_r8 /) + kbo(:,48,12) = (/ & + & 0.57616e+01_r8,0.57715e+01_r8,0.57765e+01_r8,0.57429e+01_r8,0.57151e+01_r8 /) + kbo(:,49,12) = (/ & + & 0.58013e+01_r8,0.57807e+01_r8,0.58014e+01_r8,0.57796e+01_r8,0.57022e+01_r8 /) + kbo(:,50,12) = (/ & + & 0.58611e+01_r8,0.58307e+01_r8,0.58954e+01_r8,0.58904e+01_r8,0.58254e+01_r8 /) + kbo(:,51,12) = (/ & + & 0.59182e+01_r8,0.59013e+01_r8,0.59353e+01_r8,0.59746e+01_r8,0.59215e+01_r8 /) + kbo(:,52,12) = (/ & + & 0.59636e+01_r8,0.59631e+01_r8,0.59638e+01_r8,0.60147e+01_r8,0.60288e+01_r8 /) + kbo(:,53,12) = (/ & + & 0.60261e+01_r8,0.59972e+01_r8,0.59771e+01_r8,0.60154e+01_r8,0.60632e+01_r8 /) + kbo(:,54,12) = (/ & + & 0.60204e+01_r8,0.60805e+01_r8,0.60002e+01_r8,0.60580e+01_r8,0.60854e+01_r8 /) + kbo(:,55,12) = (/ & + & 0.60584e+01_r8,0.61138e+01_r8,0.60917e+01_r8,0.60710e+01_r8,0.61237e+01_r8 /) + kbo(:,56,12) = (/ & + & 0.60402e+01_r8,0.61059e+01_r8,0.61154e+01_r8,0.61008e+01_r8,0.61463e+01_r8 /) + kbo(:,57,12) = (/ & + & 0.60080e+01_r8,0.61076e+01_r8,0.61306e+01_r8,0.61548e+01_r8,0.61892e+01_r8 /) + kbo(:,58,12) = (/ & + & 0.59781e+01_r8,0.61168e+01_r8,0.61621e+01_r8,0.61680e+01_r8,0.62246e+01_r8 /) + kbo(:,59,12) = (/ & + & 0.59824e+01_r8,0.60878e+01_r8,0.61825e+01_r8,0.62179e+01_r8,0.62658e+01_r8 /) + kbo(:,13,13) = (/ & + & 0.62252e+01_r8,0.61003e+01_r8,0.59711e+01_r8,0.58641e+01_r8,0.57820e+01_r8 /) + kbo(:,14,13) = (/ & + & 0.66429e+01_r8,0.64784e+01_r8,0.63526e+01_r8,0.62330e+01_r8,0.61644e+01_r8 /) + kbo(:,15,13) = (/ & + & 0.69743e+01_r8,0.68232e+01_r8,0.67077e+01_r8,0.66230e+01_r8,0.65438e+01_r8 /) + kbo(:,16,13) = (/ & + & 0.72971e+01_r8,0.72050e+01_r8,0.71016e+01_r8,0.69747e+01_r8,0.67726e+01_r8 /) + kbo(:,17,13) = (/ & + & 0.77109e+01_r8,0.75892e+01_r8,0.74253e+01_r8,0.72127e+01_r8,0.70341e+01_r8 /) + kbo(:,18,13) = (/ & + & 0.80450e+01_r8,0.78275e+01_r8,0.75988e+01_r8,0.74227e+01_r8,0.73977e+01_r8 /) + kbo(:,19,13) = (/ & + & 0.81727e+01_r8,0.79248e+01_r8,0.78355e+01_r8,0.77125e+01_r8,0.75391e+01_r8 /) + kbo(:,20,13) = (/ & + & 0.82796e+01_r8,0.81265e+01_r8,0.80271e+01_r8,0.78599e+01_r8,0.77204e+01_r8 /) + kbo(:,21,13) = (/ & + & 0.84685e+01_r8,0.83415e+01_r8,0.82106e+01_r8,0.80317e+01_r8,0.78896e+01_r8 /) + kbo(:,22,13) = (/ & + & 0.86169e+01_r8,0.85255e+01_r8,0.83779e+01_r8,0.82528e+01_r8,0.81573e+01_r8 /) + kbo(:,23,13) = (/ & + & 0.88276e+01_r8,0.86892e+01_r8,0.86001e+01_r8,0.84644e+01_r8,0.83125e+01_r8 /) + kbo(:,24,13) = (/ & + & 0.89834e+01_r8,0.88963e+01_r8,0.87866e+01_r8,0.86675e+01_r8,0.84751e+01_r8 /) + kbo(:,25,13) = (/ & + & 0.91971e+01_r8,0.90977e+01_r8,0.89941e+01_r8,0.88254e+01_r8,0.85750e+01_r8 /) + kbo(:,26,13) = (/ & + & 0.93611e+01_r8,0.92762e+01_r8,0.91306e+01_r8,0.88795e+01_r8,0.86828e+01_r8 /) + kbo(:,27,13) = (/ & + & 0.95231e+01_r8,0.94096e+01_r8,0.91709e+01_r8,0.89786e+01_r8,0.86968e+01_r8 /) + kbo(:,28,13) = (/ & + & 0.96495e+01_r8,0.94564e+01_r8,0.92347e+01_r8,0.89785e+01_r8,0.86180e+01_r8 /) + kbo(:,29,13) = (/ & + & 0.97336e+01_r8,0.94935e+01_r8,0.92561e+01_r8,0.89137e+01_r8,0.86661e+01_r8 /) + kbo(:,30,13) = (/ & + & 0.97605e+01_r8,0.95111e+01_r8,0.92200e+01_r8,0.89355e+01_r8,0.85920e+01_r8 /) + kbo(:,31,13) = (/ & + & 0.97562e+01_r8,0.95167e+01_r8,0.91771e+01_r8,0.88618e+01_r8,0.85414e+01_r8 /) + kbo(:,32,13) = (/ & + & 0.97192e+01_r8,0.94434e+01_r8,0.91403e+01_r8,0.87870e+01_r8,0.85159e+01_r8 /) + kbo(:,33,13) = (/ & + & 0.97162e+01_r8,0.94370e+01_r8,0.90971e+01_r8,0.88239e+01_r8,0.85528e+01_r8 /) + kbo(:,34,13) = (/ & + & 0.96997e+01_r8,0.93448e+01_r8,0.90783e+01_r8,0.87958e+01_r8,0.87225e+01_r8 /) + kbo(:,35,13) = (/ & + & 0.97261e+01_r8,0.93769e+01_r8,0.90457e+01_r8,0.89061e+01_r8,0.87695e+01_r8 /) + kbo(:,36,13) = (/ & + & 0.97573e+01_r8,0.94639e+01_r8,0.92105e+01_r8,0.90277e+01_r8,0.88187e+01_r8 /) + kbo(:,37,13) = (/ & + & 0.98297e+01_r8,0.95424e+01_r8,0.93169e+01_r8,0.90796e+01_r8,0.89104e+01_r8 /) + kbo(:,38,13) = (/ & + & 0.99015e+01_r8,0.96432e+01_r8,0.94039e+01_r8,0.91616e+01_r8,0.89941e+01_r8 /) + kbo(:,39,13) = (/ & + & 0.99137e+01_r8,0.96714e+01_r8,0.94790e+01_r8,0.92092e+01_r8,0.90352e+01_r8 /) + kbo(:,40,13) = (/ & + & 0.99728e+01_r8,0.96872e+01_r8,0.94263e+01_r8,0.92759e+01_r8,0.90690e+01_r8 /) + kbo(:,41,13) = (/ & + & 0.10009e+02_r8,0.96720e+01_r8,0.94529e+01_r8,0.92520e+01_r8,0.90775e+01_r8 /) + kbo(:,42,13) = (/ & + & 0.99394e+01_r8,0.96947e+01_r8,0.94735e+01_r8,0.92670e+01_r8,0.90312e+01_r8 /) + kbo(:,43,13) = (/ & + & 0.98412e+01_r8,0.96685e+01_r8,0.93802e+01_r8,0.91747e+01_r8,0.90019e+01_r8 /) + kbo(:,44,13) = (/ & + & 0.98284e+01_r8,0.96419e+01_r8,0.93576e+01_r8,0.91166e+01_r8,0.88968e+01_r8 /) + kbo(:,45,13) = (/ & + & 0.98765e+01_r8,0.96737e+01_r8,0.94176e+01_r8,0.90811e+01_r8,0.88300e+01_r8 /) + kbo(:,46,13) = (/ & + & 0.99370e+01_r8,0.96739e+01_r8,0.94534e+01_r8,0.91692e+01_r8,0.88574e+01_r8 /) + kbo(:,47,13) = (/ & + & 0.10145e+02_r8,0.99712e+01_r8,0.96675e+01_r8,0.93530e+01_r8,0.89895e+01_r8 /) + kbo(:,48,13) = (/ & + & 0.10395e+02_r8,0.10167e+02_r8,0.99330e+01_r8,0.95943e+01_r8,0.92927e+01_r8 /) + kbo(:,49,13) = (/ & + & 0.10580e+02_r8,0.10365e+02_r8,0.10114e+02_r8,0.98197e+01_r8,0.95303e+01_r8 /) + kbo(:,50,13) = (/ & + & 0.10794e+02_r8,0.10715e+02_r8,0.10421e+02_r8,0.10154e+02_r8,0.98629e+01_r8 /) + kbo(:,51,13) = (/ & + & 0.10946e+02_r8,0.10939e+02_r8,0.10689e+02_r8,0.10427e+02_r8,0.10145e+02_r8 /) + kbo(:,52,13) = (/ & + & 0.11156e+02_r8,0.11126e+02_r8,0.10973e+02_r8,0.10622e+02_r8,0.10371e+02_r8 /) + kbo(:,53,13) = (/ & + & 0.11165e+02_r8,0.11308e+02_r8,0.11212e+02_r8,0.10985e+02_r8,0.10624e+02_r8 /) + kbo(:,54,13) = (/ & + & 0.11221e+02_r8,0.11354e+02_r8,0.11431e+02_r8,0.11243e+02_r8,0.10959e+02_r8 /) + kbo(:,55,13) = (/ & + & 0.11238e+02_r8,0.11406e+02_r8,0.11591e+02_r8,0.11479e+02_r8,0.11275e+02_r8 /) + kbo(:,56,13) = (/ & + & 0.11335e+02_r8,0.11405e+02_r8,0.11662e+02_r8,0.11637e+02_r8,0.11480e+02_r8 /) + kbo(:,57,13) = (/ & + & 0.11355e+02_r8,0.11451e+02_r8,0.11592e+02_r8,0.11670e+02_r8,0.11515e+02_r8 /) + kbo(:,58,13) = (/ & + & 0.11389e+02_r8,0.11476e+02_r8,0.11586e+02_r8,0.11657e+02_r8,0.11618e+02_r8 /) + kbo(:,59,13) = (/ & + & 0.11480e+02_r8,0.11599e+02_r8,0.11673e+02_r8,0.11677e+02_r8,0.11653e+02_r8 /) + kbo(:,13,14) = (/ & + & 0.97590e+01_r8,0.94275e+01_r8,0.91020e+01_r8,0.89149e+01_r8,0.87289e+01_r8 /) + kbo(:,14,14) = (/ & + & 0.10505e+02_r8,0.10164e+02_r8,0.99232e+01_r8,0.97321e+01_r8,0.94201e+01_r8 /) + kbo(:,15,14) = (/ & + & 0.11237e+02_r8,0.10955e+02_r8,0.10714e+02_r8,0.10370e+02_r8,0.10019e+02_r8 /) + kbo(:,16,14) = (/ & + & 0.12124e+02_r8,0.11740e+02_r8,0.11352e+02_r8,0.10992e+02_r8,0.10632e+02_r8 /) + kbo(:,17,14) = (/ & + & 0.12886e+02_r8,0.12429e+02_r8,0.12001e+02_r8,0.11642e+02_r8,0.11273e+02_r8 /) + kbo(:,18,14) = (/ & + & 0.13556e+02_r8,0.13047e+02_r8,0.12733e+02_r8,0.12297e+02_r8,0.11616e+02_r8 /) + kbo(:,19,14) = (/ & + & 0.14349e+02_r8,0.13901e+02_r8,0.13193e+02_r8,0.12562e+02_r8,0.12015e+02_r8 /) + kbo(:,20,14) = (/ & + & 0.15084e+02_r8,0.14361e+02_r8,0.13567e+02_r8,0.12903e+02_r8,0.12393e+02_r8 /) + kbo(:,21,14) = (/ & + & 0.15509e+02_r8,0.14641e+02_r8,0.13824e+02_r8,0.13136e+02_r8,0.12832e+02_r8 /) + kbo(:,22,14) = (/ & + & 0.15737e+02_r8,0.14756e+02_r8,0.13944e+02_r8,0.13493e+02_r8,0.13014e+02_r8 /) + kbo(:,23,14) = (/ & + & 0.15733e+02_r8,0.14806e+02_r8,0.14130e+02_r8,0.13708e+02_r8,0.13129e+02_r8 /) + kbo(:,24,14) = (/ & + & 0.15735e+02_r8,0.14832e+02_r8,0.14382e+02_r8,0.13702e+02_r8,0.13090e+02_r8 /) + kbo(:,25,14) = (/ & + & 0.15596e+02_r8,0.15046e+02_r8,0.14369e+02_r8,0.13676e+02_r8,0.13207e+02_r8 /) + kbo(:,26,14) = (/ & + & 0.15679e+02_r8,0.15085e+02_r8,0.14382e+02_r8,0.13864e+02_r8,0.13243e+02_r8 /) + kbo(:,27,14) = (/ & + & 0.15773e+02_r8,0.15051e+02_r8,0.14458e+02_r8,0.13792e+02_r8,0.13309e+02_r8 /) + kbo(:,28,14) = (/ & + & 0.15791e+02_r8,0.15118e+02_r8,0.14520e+02_r8,0.13908e+02_r8,0.13506e+02_r8 /) + kbo(:,29,14) = (/ & + & 0.15907e+02_r8,0.15282e+02_r8,0.14696e+02_r8,0.14168e+02_r8,0.13591e+02_r8 /) + kbo(:,30,14) = (/ & + & 0.15997e+02_r8,0.15426e+02_r8,0.14908e+02_r8,0.14325e+02_r8,0.13655e+02_r8 /) + kbo(:,31,14) = (/ & + & 0.16254e+02_r8,0.15640e+02_r8,0.15053e+02_r8,0.14410e+02_r8,0.13542e+02_r8 /) + kbo(:,32,14) = (/ & + & 0.16522e+02_r8,0.15885e+02_r8,0.15194e+02_r8,0.14363e+02_r8,0.13365e+02_r8 /) + kbo(:,33,14) = (/ & + & 0.16844e+02_r8,0.16068e+02_r8,0.15151e+02_r8,0.14109e+02_r8,0.13003e+02_r8 /) + kbo(:,34,14) = (/ & + & 0.16915e+02_r8,0.16003e+02_r8,0.14953e+02_r8,0.13814e+02_r8,0.12608e+02_r8 /) + kbo(:,35,14) = (/ & + & 0.16922e+02_r8,0.15890e+02_r8,0.14756e+02_r8,0.13405e+02_r8,0.12281e+02_r8 /) + kbo(:,36,14) = (/ & + & 0.16966e+02_r8,0.15773e+02_r8,0.14522e+02_r8,0.13240e+02_r8,0.11917e+02_r8 /) + kbo(:,37,14) = (/ & + & 0.17142e+02_r8,0.15897e+02_r8,0.14564e+02_r8,0.13378e+02_r8,0.11953e+02_r8 /) + kbo(:,38,14) = (/ & + & 0.17346e+02_r8,0.16051e+02_r8,0.14752e+02_r8,0.13439e+02_r8,0.11971e+02_r8 /) + kbo(:,39,14) = (/ & + & 0.17475e+02_r8,0.16210e+02_r8,0.14948e+02_r8,0.13510e+02_r8,0.12056e+02_r8 /) + kbo(:,40,14) = (/ & + & 0.17754e+02_r8,0.16503e+02_r8,0.15328e+02_r8,0.13801e+02_r8,0.12328e+02_r8 /) + kbo(:,41,14) = (/ & + & 0.18031e+02_r8,0.16909e+02_r8,0.15619e+02_r8,0.14276e+02_r8,0.12740e+02_r8 /) + kbo(:,42,14) = (/ & + & 0.18386e+02_r8,0.17235e+02_r8,0.15966e+02_r8,0.14652e+02_r8,0.13194e+02_r8 /) + kbo(:,43,14) = (/ & + & 0.18710e+02_r8,0.17591e+02_r8,0.16361e+02_r8,0.15070e+02_r8,0.13707e+02_r8 /) + kbo(:,44,14) = (/ & + & 0.19098e+02_r8,0.17898e+02_r8,0.16845e+02_r8,0.15582e+02_r8,0.14265e+02_r8 /) + kbo(:,45,14) = (/ & + & 0.19252e+02_r8,0.18167e+02_r8,0.17135e+02_r8,0.15969e+02_r8,0.14652e+02_r8 /) + kbo(:,46,14) = (/ & + & 0.19041e+02_r8,0.18357e+02_r8,0.17265e+02_r8,0.16200e+02_r8,0.15002e+02_r8 /) + kbo(:,47,14) = (/ & + & 0.18766e+02_r8,0.18032e+02_r8,0.17152e+02_r8,0.16208e+02_r8,0.15088e+02_r8 /) + kbo(:,48,14) = (/ & + & 0.18411e+02_r8,0.17740e+02_r8,0.16984e+02_r8,0.16085e+02_r8,0.15089e+02_r8 /) + kbo(:,49,14) = (/ & + & 0.18291e+02_r8,0.17667e+02_r8,0.16941e+02_r8,0.16014e+02_r8,0.14979e+02_r8 /) + kbo(:,50,14) = (/ & + & 0.18624e+02_r8,0.17786e+02_r8,0.17174e+02_r8,0.16136e+02_r8,0.15128e+02_r8 /) + kbo(:,51,14) = (/ & + & 0.19430e+02_r8,0.18470e+02_r8,0.17722e+02_r8,0.16775e+02_r8,0.15711e+02_r8 /) + kbo(:,52,14) = (/ & + & 0.20123e+02_r8,0.18895e+02_r8,0.18060e+02_r8,0.17255e+02_r8,0.16173e+02_r8 /) + kbo(:,53,14) = (/ & + & 0.20744e+02_r8,0.19415e+02_r8,0.18626e+02_r8,0.17397e+02_r8,0.16465e+02_r8 /) + kbo(:,54,14) = (/ & + & 0.21714e+02_r8,0.20093e+02_r8,0.19173e+02_r8,0.18078e+02_r8,0.16884e+02_r8 /) + kbo(:,55,14) = (/ & + & 0.22731e+02_r8,0.21068e+02_r8,0.19674e+02_r8,0.18569e+02_r8,0.17315e+02_r8 /) + kbo(:,56,14) = (/ & + & 0.23924e+02_r8,0.22190e+02_r8,0.20317e+02_r8,0.18891e+02_r8,0.17603e+02_r8 /) + kbo(:,57,14) = (/ & + & 0.24940e+02_r8,0.23270e+02_r8,0.21498e+02_r8,0.19833e+02_r8,0.18265e+02_r8 /) + kbo(:,58,14) = (/ & + & 0.25828e+02_r8,0.24271e+02_r8,0.22518e+02_r8,0.20827e+02_r8,0.19003e+02_r8 /) + kbo(:,59,14) = (/ & + & 0.26483e+02_r8,0.24983e+02_r8,0.23453e+02_r8,0.21676e+02_r8,0.19755e+02_r8 /) + kbo(:,13,15) = (/ & + & 0.15960e+02_r8,0.15303e+02_r8,0.14694e+02_r8,0.13842e+02_r8,0.13008e+02_r8 /) + kbo(:,14,15) = (/ & + & 0.17675e+02_r8,0.16896e+02_r8,0.15925e+02_r8,0.14915e+02_r8,0.14133e+02_r8 /) + kbo(:,15,15) = (/ & + & 0.19385e+02_r8,0.18234e+02_r8,0.16959e+02_r8,0.15987e+02_r8,0.15180e+02_r8 /) + kbo(:,16,15) = (/ & + & 0.20552e+02_r8,0.19165e+02_r8,0.17982e+02_r8,0.16927e+02_r8,0.16368e+02_r8 /) + kbo(:,17,15) = (/ & + & 0.21349e+02_r8,0.19954e+02_r8,0.19023e+02_r8,0.18091e+02_r8,0.17398e+02_r8 /) + kbo(:,18,15) = (/ & + & 0.22160e+02_r8,0.21597e+02_r8,0.20213e+02_r8,0.19055e+02_r8,0.18102e+02_r8 /) + kbo(:,19,15) = (/ & + & 0.23816e+02_r8,0.22303e+02_r8,0.21008e+02_r8,0.19912e+02_r8,0.18903e+02_r8 /) + kbo(:,20,15) = (/ & + & 0.24810e+02_r8,0.23381e+02_r8,0.21933e+02_r8,0.20846e+02_r8,0.19540e+02_r8 /) + kbo(:,21,15) = (/ & + & 0.25893e+02_r8,0.24250e+02_r8,0.22750e+02_r8,0.21616e+02_r8,0.19627e+02_r8 /) + kbo(:,22,15) = (/ & + & 0.26542e+02_r8,0.24773e+02_r8,0.23600e+02_r8,0.21309e+02_r8,0.19278e+02_r8 /) + kbo(:,23,15) = (/ & + & 0.27270e+02_r8,0.25621e+02_r8,0.23587e+02_r8,0.21255e+02_r8,0.19478e+02_r8 /) + kbo(:,24,15) = (/ & + & 0.27744e+02_r8,0.26088e+02_r8,0.23254e+02_r8,0.21242e+02_r8,0.19100e+02_r8 /) + kbo(:,25,15) = (/ & + & 0.28557e+02_r8,0.25575e+02_r8,0.23098e+02_r8,0.20631e+02_r8,0.18206e+02_r8 /) + kbo(:,26,15) = (/ & + & 0.28140e+02_r8,0.25135e+02_r8,0.22210e+02_r8,0.19496e+02_r8,0.17366e+02_r8 /) + kbo(:,27,15) = (/ & + & 0.27284e+02_r8,0.24232e+02_r8,0.21249e+02_r8,0.18720e+02_r8,0.16279e+02_r8 /) + kbo(:,28,15) = (/ & + & 0.26494e+02_r8,0.23076e+02_r8,0.20060e+02_r8,0.17566e+02_r8,0.14956e+02_r8 /) + kbo(:,29,15) = (/ & + & 0.24773e+02_r8,0.21460e+02_r8,0.18370e+02_r8,0.15793e+02_r8,0.13302e+02_r8 /) + kbo(:,30,15) = (/ & + & 0.23157e+02_r8,0.19587e+02_r8,0.16563e+02_r8,0.13805e+02_r8,0.11647e+02_r8 /) + kbo(:,31,15) = (/ & + & 0.20881e+02_r8,0.17370e+02_r8,0.14460e+02_r8,0.11958e+02_r8,0.99808e+01_r8 /) + kbo(:,32,15) = (/ & + & 0.18247e+02_r8,0.15035e+02_r8,0.12296e+02_r8,0.10101e+02_r8,0.83032e+01_r8 /) + kbo(:,33,15) = (/ & + & 0.15492e+02_r8,0.12470e+02_r8,0.10235e+02_r8,0.81131e+01_r8,0.64390e+01_r8 /) + kbo(:,34,15) = (/ & + & 0.13284e+02_r8,0.10782e+02_r8,0.82553e+01_r8,0.64597e+01_r8,0.42402e+01_r8 /) + kbo(:,35,15) = (/ & + & 0.11520e+02_r8,0.89534e+01_r8,0.69691e+01_r8,0.48753e+01_r8,0.27443e+01_r8 /) + kbo(:,36,15) = (/ & + & 0.10067e+02_r8,0.75650e+01_r8,0.54572e+01_r8,0.31866e+01_r8,0.14626e+01_r8 /) + kbo(:,37,15) = (/ & + & 0.97744e+01_r8,0.73767e+01_r8,0.52433e+01_r8,0.27509e+01_r8,0.10380e+01_r8 /) + kbo(:,38,15) = (/ & + & 0.94733e+01_r8,0.70859e+01_r8,0.47807e+01_r8,0.23954e+01_r8,0.74468e+00_r8 /) + kbo(:,39,15) = (/ & + & 0.94041e+01_r8,0.67286e+01_r8,0.41966e+01_r8,0.20683e+01_r8,0.27939e+00_r8 /) + kbo(:,40,15) = (/ & + & 0.10076e+02_r8,0.74414e+01_r8,0.47964e+01_r8,0.25258e+01_r8,0.87689e+00_r8 /) + kbo(:,41,15) = (/ & + & 0.10878e+02_r8,0.81759e+01_r8,0.56173e+01_r8,0.30416e+01_r8,0.13231e+01_r8 /) + kbo(:,42,15) = (/ & + & 0.11858e+02_r8,0.88284e+01_r8,0.63009e+01_r8,0.37211e+01_r8,0.17214e+01_r8 /) + kbo(:,43,15) = (/ & + & 0.13284e+02_r8,0.99847e+01_r8,0.73905e+01_r8,0.50291e+01_r8,0.24940e+01_r8 /) + kbo(:,44,15) = (/ & + & 0.14796e+02_r8,0.11545e+02_r8,0.85671e+01_r8,0.61687e+01_r8,0.37136e+01_r8 /) + kbo(:,45,15) = (/ & + & 0.16662e+02_r8,0.12949e+02_r8,0.98033e+01_r8,0.73353e+01_r8,0.52329e+01_r8 /) + kbo(:,46,15) = (/ & + & 0.19200e+02_r8,0.14684e+02_r8,0.11434e+02_r8,0.85867e+01_r8,0.64428e+01_r8 /) + kbo(:,47,15) = (/ & + & 0.21780e+02_r8,0.16837e+02_r8,0.13158e+02_r8,0.10165e+02_r8,0.76608e+01_r8 /) + kbo(:,48,15) = (/ & + & 0.24689e+02_r8,0.19487e+02_r8,0.15145e+02_r8,0.11845e+02_r8,0.89940e+01_r8 /) + kbo(:,49,15) = (/ & + & 0.27130e+02_r8,0.21775e+02_r8,0.17116e+02_r8,0.13679e+02_r8,0.10905e+02_r8 /) + kbo(:,50,15) = (/ & + & 0.27854e+02_r8,0.22306e+02_r8,0.17103e+02_r8,0.13783e+02_r8,0.10863e+02_r8 /) + kbo(:,51,15) = (/ & + & 0.27653e+02_r8,0.21825e+02_r8,0.16692e+02_r8,0.12707e+02_r8,0.98148e+01_r8 /) + kbo(:,52,15) = (/ & + & 0.27815e+02_r8,0.22411e+02_r8,0.17151e+02_r8,0.12787e+02_r8,0.95823e+01_r8 /) + kbo(:,53,15) = (/ & + & 0.29119e+02_r8,0.23144e+02_r8,0.17252e+02_r8,0.13594e+02_r8,0.99767e+01_r8 /) + kbo(:,54,15) = (/ & + & 0.29129e+02_r8,0.23469e+02_r8,0.17342e+02_r8,0.12745e+02_r8,0.95359e+01_r8 /) + kbo(:,55,15) = (/ & + & 0.29058e+02_r8,0.23190e+02_r8,0.17458e+02_r8,0.12690e+02_r8,0.90099e+01_r8 /) + kbo(:,56,15) = (/ & + & 0.28657e+02_r8,0.23001e+02_r8,0.17896e+02_r8,0.13433e+02_r8,0.94907e+01_r8 /) + kbo(:,57,15) = (/ & + & 0.29240e+02_r8,0.22830e+02_r8,0.17734e+02_r8,0.13185e+02_r8,0.97411e+01_r8 /) + kbo(:,58,15) = (/ & + & 0.29947e+02_r8,0.22946e+02_r8,0.17582e+02_r8,0.13008e+02_r8,0.96489e+01_r8 /) + kbo(:,59,15) = (/ & + & 0.28976e+02_r8,0.21746e+02_r8,0.15522e+02_r8,0.11254e+02_r8,0.80222e+01_r8 /) + kbo(:,13,16) = (/ & + & 0.25931e+02_r8,0.24537e+02_r8,0.23224e+02_r8,0.21983e+02_r8,0.20855e+02_r8 /) + kbo(:,14,16) = (/ & + & 0.29220e+02_r8,0.27507e+02_r8,0.25899e+02_r8,0.24431e+02_r8,0.23088e+02_r8 /) + kbo(:,15,16) = (/ & + & 0.32471e+02_r8,0.30409e+02_r8,0.28502e+02_r8,0.26794e+02_r8,0.25226e+02_r8 /) + kbo(:,16,16) = (/ & + & 0.35624e+02_r8,0.33186e+02_r8,0.30989e+02_r8,0.28748e+02_r8,0.24479e+02_r8 /) + kbo(:,17,16) = (/ & + & 0.38605e+02_r8,0.35797e+02_r8,0.30613e+02_r8,0.25949e+02_r8,0.21171e+02_r8 /) + kbo(:,18,16) = (/ & + & 0.41350e+02_r8,0.31676e+02_r8,0.25965e+02_r8,0.21818e+02_r8,0.18145e+02_r8 /) + kbo(:,19,16) = (/ & + & 0.34377e+02_r8,0.28144e+02_r8,0.23342e+02_r8,0.17735e+02_r8,0.13818e+02_r8 /) + kbo(:,20,16) = (/ & + & 0.31245e+02_r8,0.24408e+02_r8,0.19618e+02_r8,0.13984e+02_r8,0.93171e+01_r8 /) + kbo(:,21,16) = (/ & + & 0.28216e+02_r8,0.21711e+02_r8,0.16938e+02_r8,0.11225e+02_r8,0.60954e+01_r8 /) + kbo(:,22,16) = (/ & + & 0.25410e+02_r8,0.20320e+02_r8,0.12451e+02_r8,0.80509e+01_r8,0.41742e+01_r8 /) + kbo(:,23,16) = (/ & + & 0.22191e+02_r8,0.15284e+02_r8,0.84334e+01_r8,0.32443e+01_r8,0.10236e-04_r8 /) + kbo(:,24,16) = (/ & + & 0.19170e+02_r8,0.98429e+01_r8,0.40822e+01_r8,0.90070e-05_r8,0.84964e-05_r8 /) + kbo(:,25,16) = (/ & + & 0.11441e+02_r8,0.50508e+01_r8,0.77316e-05_r8,0.71796e-05_r8,0.66473e-05_r8 /) + kbo(:,26,16) = (/ & + & 0.73617e+01_r8,0.56953e+00_r8,0.62155e-05_r8,0.57759e-05_r8,0.53447e-05_r8 /) + kbo(:,27,16) = (/ & + & 0.37038e+01_r8,0.54098e-05_r8,0.49933e-05_r8,0.45180e-05_r8,0.42997e-05_r8 /) + kbo(:,28,16) = (/ & + & 0.47094e-05_r8,0.43472e-05_r8,0.40149e-05_r8,0.36332e-05_r8,0.34550e-05_r8 /) + kbo(:,29,16) = (/ & + & 0.37812e-05_r8,0.34885e-05_r8,0.32238e-05_r8,0.29187e-05_r8,0.27779e-05_r8 /) + kbo(:,30,16) = (/ & + & 0.30339e-05_r8,0.28004e-05_r8,0.25314e-05_r8,0.23451e-05_r8,0.22313e-05_r8 /) + kbo(:,31,16) = (/ & + & 0.24328e-05_r8,0.22460e-05_r8,0.20326e-05_r8,0.18813e-05_r8,0.17930e-05_r8 /) + kbo(:,32,16) = (/ & + & 0.18939e-05_r8,0.18012e-05_r8,0.16316e-05_r8,0.15109e-05_r8,0.14395e-05_r8 /) + kbo(:,33,16) = (/ & + & 0.15657e-05_r8,0.14309e-05_r8,0.13083e-05_r8,0.12124e-05_r8,0.15795e-05_r8 /) + kbo(:,34,16) = (/ & + & 0.12582e-05_r8,0.11508e-05_r8,0.10527e-05_r8,0.97625e-06_r8,0.19757e-05_r8 /) + kbo(:,35,16) = (/ & + & 0.10197e-05_r8,0.93275e-06_r8,0.85375e-06_r8,0.79153e-06_r8,0.21668e-05_r8 /) + kbo(:,36,16) = (/ & + & 0.83336e-06_r8,0.76274e-06_r8,0.69805e-06_r8,0.64735e-06_r8,0.17739e-05_r8 /) + kbo(:,37,16) = (/ & + & 0.68945e-06_r8,0.63022e-06_r8,0.57702e-06_r8,0.53486e-06_r8,0.10843e-05_r8 /) + kbo(:,38,16) = (/ & + & 0.55406e-06_r8,0.52180e-06_r8,0.47760e-06_r8,0.44282e-06_r8,0.89395e-06_r8 /) + kbo(:,39,16) = (/ & + & 0.45861e-06_r8,0.43223e-06_r8,0.39548e-06_r8,0.36639e-06_r8,0.47718e-06_r8 /) + kbo(:,40,16) = (/ & + & 0.38297e-06_r8,0.36441e-06_r8,0.32989e-06_r8,0.30551e-06_r8,0.28352e-06_r8 /) + kbo(:,41,16) = (/ & + & 0.31987e-06_r8,0.30430e-06_r8,0.27838e-06_r8,0.25513e-06_r8,0.23647e-06_r8 /) + kbo(:,42,16) = (/ & + & 0.26734e-06_r8,0.24677e-06_r8,0.23264e-06_r8,0.21290e-06_r8,0.19743e-06_r8 /) + kbo(:,43,16) = (/ & + & 0.22458e-06_r8,0.20712e-06_r8,0.19517e-06_r8,0.17853e-06_r8,0.16551e-06_r8 /) + kbo(:,44,16) = (/ & + & 0.18898e-06_r8,0.17429e-06_r8,0.16587e-06_r8,0.15173e-06_r8,0.13895e-06_r8 /) + kbo(:,45,16) = (/ & + & 0.15450e-06_r8,0.14658e-06_r8,0.13533e-06_r8,0.12759e-06_r8,0.11679e-06_r8 /) + kbo(:,46,16) = (/ & + & 0.13028e-06_r8,0.12362e-06_r8,0.11400e-06_r8,0.10744e-06_r8,0.98279e-07_r8 /) + kbo(:,47,16) = (/ & + & 0.11024e-06_r8,0.10159e-06_r8,0.96435e-07_r8,0.91711e-07_r8,0.83972e-07_r8 /) + kbo(:,48,16) = (/ & + & 0.93198e-07_r8,0.85906e-07_r8,0.81590e-07_r8,0.75279e-07_r8,0.70931e-07_r8 /) + kbo(:,49,16) = (/ & + & 0.76236e-07_r8,0.72626e-07_r8,0.68995e-07_r8,0.63641e-07_r8,0.60530e-07_r8 /) + kbo(:,50,16) = (/ & + & 0.64328e-07_r8,0.61369e-07_r8,0.56594e-07_r8,0.53672e-07_r8,0.49555e-07_r8 /) + kbo(:,51,16) = (/ & + & 0.54169e-07_r8,0.51722e-07_r8,0.47685e-07_r8,0.45298e-07_r8,0.41770e-07_r8 /) + kbo(:,52,16) = (/ & + & 0.46180e-07_r8,0.42221e-07_r8,0.40251e-07_r8,0.37120e-07_r8,0.35204e-07_r8 /) + kbo(:,53,16) = (/ & + & 0.33194e-01_r8,0.35538e-07_r8,0.33930e-07_r8,0.31297e-07_r8,0.29712e-07_r8 /) + kbo(:,54,16) = (/ & + & 0.63212e-01_r8,0.54132e-01_r8,0.36437e-01_r8,0.71353e-02_r8,0.24978e-07_r8 /) + kbo(:,55,16) = (/ & + & 0.62321e-01_r8,0.69163e-01_r8,0.76899e-01_r8,0.64692e-01_r8,0.42869e-01_r8 /) + kbo(:,56,16) = (/ & + & 0.73050e-01_r8,0.83118e-01_r8,0.74962e-01_r8,0.82540e-01_r8,0.91058e-01_r8 /) + kbo(:,57,16) = (/ & + & 0.71162e-01_r8,0.79898e-01_r8,0.89953e-01_r8,0.10014e+00_r8,0.10382e+00_r8 /) + kbo(:,58,16) = (/ & + & 0.67770e-01_r8,0.78960e-01_r8,0.86882e-01_r8,0.97002e-01_r8,0.10740e+00_r8 /) + kbo(:,59,16) = (/ & + & 0.66421e-01_r8,0.77608e-01_r8,0.10426e+00_r8,0.10063e+00_r8,0.10735e+00_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.860560e-06_r8, 0.130439e-05_r8, 0.382378e-05_r8 /) + forrefo(:, 2) = (/ 0.817926e-06_r8, 0.158599e-05_r8, 0.658771e-04_r8 /) + forrefo(:, 3) = (/ 0.129369e-05_r8, 0.824406e-05_r8, 0.952778e-04_r8 /) + forrefo(:, 4) = (/ 0.438918e-05_r8, 0.375356e-04_r8, 0.119111e-03_r8 /) + forrefo(:, 5) = (/ 0.306057e-04_r8, 0.622798e-04_r8, 0.100740e-03_r8 /) + forrefo(:, 6) = (/ 0.891934e-04_r8, 0.856393e-04_r8, 0.635583e-04_r8 /) + forrefo(:, 7) = (/ 0.171959e-03_r8, 0.173431e-03_r8, 0.611721e-04_r8 /) + forrefo(:, 8) = (/ 0.357795e-03_r8, 0.247261e-03_r8, 0.488864e-04_r8 /) + forrefo(:, 9) = (/ 0.326623e-03_r8, 0.289471e-03_r8, 0.548834e-04_r8 /) + forrefo(:,10) = (/ 0.345103e-03_r8, 0.320898e-03_r8, 0.633214e-04_r8 /) + forrefo(:,11) = (/ 0.392567e-03_r8, 0.325153e-03_r8, 0.744479e-04_r8 /) + forrefo(:,12) = (/ 0.349277e-03_r8, 0.345610e-03_r8, 0.916479e-04_r8 /) + forrefo(:,13) = (/ 0.425161e-03_r8, 0.348452e-03_r8, 0.125788e-03_r8 /) + forrefo(:,14) = (/ 0.407594e-03_r8, 0.435836e-03_r8, 0.287583e-03_r8 /) + forrefo(:,15) = (/ 0.521605e-03_r8, 0.486596e-03_r8, 0.483511e-03_r8 /) + forrefo(:,16) = (/ 0.773790e-03_r8, 0.737247e-03_r8, 0.665939e-03_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.750370e-03_r8, 0.644938e-03_r8, 0.554321e-03_r8, 0.476436e-03_r8, 0.409494e-03_r8, & + & 0.351957e-03_r8, 0.302505e-03_r8, 0.260002e-03_r8, 0.223470e-03_r8, 0.192071e-03_r8 /) + selfrefo(:, 2) = (/ & + & 0.136135e-02_r8, 0.113187e-02_r8, 0.941076e-03_r8, 0.782440e-03_r8, 0.650546e-03_r8, & + & 0.540885e-03_r8, 0.449709e-03_r8, 0.373902e-03_r8, 0.310874e-03_r8, 0.258471e-03_r8 /) + selfrefo(:, 3) = (/ & + & 0.333950e-02_r8, 0.256391e-02_r8, 0.196845e-02_r8, 0.151129e-02_r8, 0.116030e-02_r8, & + & 0.890824e-03_r8, 0.683934e-03_r8, 0.525093e-03_r8, 0.403143e-03_r8, 0.309515e-03_r8 /) + selfrefo(:, 4) = (/ & + & 0.793392e-02_r8, 0.589865e-02_r8, 0.438548e-02_r8, 0.326048e-02_r8, 0.242408e-02_r8, & + & 0.180223e-02_r8, 0.133991e-02_r8, 0.996186e-03_r8, 0.740636e-03_r8, 0.550642e-03_r8 /) + selfrefo(:, 5) = (/ & + & 0.828169e-02_r8, 0.703139e-02_r8, 0.596984e-02_r8, 0.506856e-02_r8, 0.430335e-02_r8, & + & 0.365366e-02_r8, 0.310206e-02_r8, 0.263374e-02_r8, 0.223612e-02_r8, 0.189852e-02_r8 /) + selfrefo(:, 6) = (/ & + & 0.834190e-02_r8, 0.780225e-02_r8, 0.729750e-02_r8, 0.682541e-02_r8, 0.638386e-02_r8, & + & 0.597087e-02_r8, 0.558460e-02_r8, 0.522332e-02_r8, 0.488541e-02_r8, 0.456936e-02_r8 /) + selfrefo(:, 7) = (/ & + & 0.119082e-01_r8, 0.112566e-01_r8, 0.106406e-01_r8, 0.100583e-01_r8, 0.950785e-02_r8, & + & 0.898755e-02_r8, 0.849571e-02_r8, 0.803080e-02_r8, 0.759132e-02_r8, 0.717590e-02_r8 /) + selfrefo(:, 8) = (/ & + & 0.144004e-01_r8, 0.141762e-01_r8, 0.139554e-01_r8, 0.137381e-01_r8, 0.135241e-01_r8, & + & 0.133135e-01_r8, 0.131062e-01_r8, 0.129021e-01_r8, 0.127011e-01_r8, 0.125033e-01_r8 /) + selfrefo(:, 9) = (/ & + & 0.186171e-01_r8, 0.175281e-01_r8, 0.165027e-01_r8, 0.155373e-01_r8, 0.146284e-01_r8, & + & 0.137726e-01_r8, 0.129670e-01_r8, 0.122084e-01_r8, 0.114942e-01_r8, 0.108218e-01_r8 /) + selfrefo(:,10) = (/ & + & 0.209396e-01_r8, 0.195077e-01_r8, 0.181737e-01_r8, 0.169309e-01_r8, 0.157731e-01_r8, & + & 0.146945e-01_r8, 0.136897e-01_r8, 0.127535e-01_r8, 0.118814e-01_r8, 0.110689e-01_r8 /) + selfrefo(:,11) = (/ & + & 0.203661e-01_r8, 0.193311e-01_r8, 0.183487e-01_r8, 0.174163e-01_r8, 0.165312e-01_r8, & + & 0.156911e-01_r8, 0.148937e-01_r8, 0.141368e-01_r8, 0.134184e-01_r8, 0.127365e-01_r8 /) + selfrefo(:,12) = (/ & + & 0.226784e-01_r8, 0.210210e-01_r8, 0.194848e-01_r8, 0.180608e-01_r8, 0.167409e-01_r8, & + & 0.155174e-01_r8, 0.143834e-01_r8, 0.133322e-01_r8, 0.123579e-01_r8, 0.114547e-01_r8 /) + selfrefo(:,13) = (/ & + & 0.221773e-01_r8, 0.210306e-01_r8, 0.199433e-01_r8, 0.189122e-01_r8, 0.179344e-01_r8, & + & 0.170071e-01_r8, 0.161278e-01_r8, 0.152939e-01_r8, 0.145032e-01_r8, 0.137533e-01_r8 /) + selfrefo(:,14) = (/ & + & 0.275920e-01_r8, 0.252595e-01_r8, 0.231241e-01_r8, 0.211693e-01_r8, 0.193797e-01_r8, & + & 0.177415e-01_r8, 0.162417e-01_r8, 0.148687e-01_r8, 0.136117e-01_r8, 0.124610e-01_r8 /) + selfrefo(:,15) = (/ & + & 0.288687e-01_r8, 0.269968e-01_r8, 0.252462e-01_r8, 0.236092e-01_r8, 0.220783e-01_r8, & + & 0.206466e-01_r8, 0.193078e-01_r8, 0.180559e-01_r8, 0.168851e-01_r8, 0.157902e-01_r8 /) + selfrefo(:,16) = (/ & + & 0.371842e-01_r8, 0.347595e-01_r8, 0.324929e-01_r8, 0.303741e-01_r8, 0.283934e-01_r8, & + & 0.265419e-01_r8, 0.248112e-01_r8, 0.231933e-01_r8, 0.216809e-01_r8, 0.202671e-01_r8 /) + + end subroutine sw_kgb18 + +! ************************************************************************** + subroutine sw_kgb19 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg19, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:,1) = (/ & + & 3.25791_r8 , 3.29697_r8 , 3.16031_r8 , 2.96115_r8 , & + & 2.69238_r8 , 2.33819_r8 , 1.92760_r8 , 1.44918_r8 , & + & 0.979764_r8 , 0.107336_r8 , 8.94523e-02_r8, 6.98325e-02_r8, & + & 5.12051e-02_r8, 3.23645e-02_r8, 1.23401e-02_r8, 1.71339e-03_r8 /) + sfluxrefo(:,2) = (/ & + & 3.22769_r8 , 3.28817_r8 , 3.16687_r8 , 2.97662_r8 , & + & 2.69495_r8 , 2.34392_r8 , 1.92900_r8 , 1.45391_r8 , & + & 0.982522_r8 , 0.107638_r8 , 8.92458e-02_r8, 6.99885e-02_r8, & + & 5.09679e-02_r8, 3.23789e-02_r8, 1.22673e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,3) = (/ & + & 3.22294_r8 , 3.27780_r8 , 3.17424_r8 , 2.97143_r8 , & + & 2.69785_r8 , 2.34993_r8 , 1.93155_r8 , 1.45196_r8 , & + & 0.985329_r8 , 0.108027_r8 , 8.93552e-02_r8, 6.99937e-02_r8, & + & 5.11678e-02_r8, 3.24846e-02_r8, 1.20636e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,4) = (/ & + & 3.22445_r8 , 3.26113_r8 , 3.18438_r8 , 2.96921_r8 , & + & 2.69579_r8 , 2.35586_r8 , 1.93454_r8 , 1.44949_r8 , & + & 0.987347_r8 , 0.108611_r8 , 8.91643e-02_r8, 7.02236e-02_r8, & + & 5.12980e-02_r8, 3.25282e-02_r8, 1.21189e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,5) = (/ & + & 3.22497_r8 , 3.25109_r8 , 3.18741_r8 , 2.96970_r8 , & + & 2.69460_r8 , 2.36020_r8 , 1.93301_r8 , 1.45224_r8 , & + & 0.988564_r8 , 0.108255_r8 , 8.93830e-02_r8, 7.03655e-02_r8, & + & 5.13017e-02_r8, 3.29414e-02_r8, 1.21189e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,6) = (/ & + & 3.22632_r8 , 3.24174_r8 , 3.18524_r8 , 2.97402_r8 , & + & 2.69807_r8 , 2.35742_r8 , 1.93377_r8 , 1.45621_r8 , & + & 0.988132_r8 , 0.108344_r8 , 8.93188e-02_r8, 7.04907e-02_r8, & + & 5.17938e-02_r8, 3.31465e-02_r8, 1.21155e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,7) = (/ & + & 3.22793_r8 , 3.23589_r8 , 3.17720_r8 , 2.97869_r8 , & + & 2.70293_r8 , 2.35436_r8 , 1.93557_r8 , 1.45868_r8 , & + & 0.988654_r8 , 0.108198_r8 , 8.93375e-02_r8, 7.09790e-02_r8, & + & 5.24733e-02_r8, 3.31298e-02_r8, 1.21126e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,8) = (/ & + & 3.22966_r8 , 3.24087_r8 , 3.15676_r8 , 2.98171_r8 , & + & 2.70894_r8 , 2.34975_r8 , 1.93855_r8 , 1.46354_r8 , & + & 0.988544_r8 , 0.108574_r8 , 9.02522e-02_r8, 7.12908e-02_r8, & + & 5.24844e-02_r8, 3.31084e-02_r8, 1.21060e-02_r8, 1.56040e-03_r8 /) + sfluxrefo(:,9) = (/ & + & 3.27240_r8 , 3.24666_r8 , 3.13886_r8 , 2.95238_r8 , & + & 2.70190_r8 , 2.34460_r8 , 1.93948_r8 , 1.47111_r8 , & + & 0.990821_r8 , 0.108730_r8 , 9.01625e-02_r8, 7.13261e-02_r8, & + & 5.24813e-02_r8, 3.31083e-02_r8, 1.21126e-02_r8, 1.56040e-03_r8 /) + +! Rayleigh extinction coefficient at v = 4900 cm-1. + rayl = 2.29e-09_r8 + + strrat = 5.49281_r8 + + layreffr = 3 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.14981e-05_r8,0.26659e-05_r8,0.31874e-05_r8,0.35509e-05_r8,0.37593e-05_r8, & + & 0.38514e-05_r8,0.37369e-05_r8,0.35011e-05_r8,0.23894e-05_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.15103e-05_r8,0.27348e-05_r8,0.32692e-05_r8,0.36558e-05_r8,0.38926e-05_r8, & + & 0.39737e-05_r8,0.38798e-05_r8,0.36565e-05_r8,0.24072e-05_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.15233e-05_r8,0.28090e-05_r8,0.33744e-05_r8,0.37729e-05_r8,0.40258e-05_r8, & + & 0.41107e-05_r8,0.40389e-05_r8,0.38226e-05_r8,0.24704e-05_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.15219e-05_r8,0.28978e-05_r8,0.35015e-05_r8,0.38984e-05_r8,0.41569e-05_r8, & + & 0.42771e-05_r8,0.42110e-05_r8,0.39963e-05_r8,0.25504e-05_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.15254e-05_r8,0.29633e-05_r8,0.36224e-05_r8,0.40435e-05_r8,0.42975e-05_r8, & + & 0.44410e-05_r8,0.43849e-05_r8,0.41847e-05_r8,0.26420e-05_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.13024e-05_r8,0.23699e-05_r8,0.28370e-05_r8,0.31443e-05_r8,0.33326e-05_r8, & + & 0.33798e-05_r8,0.32797e-05_r8,0.30078e-05_r8,0.18819e-05_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.13249e-05_r8,0.24299e-05_r8,0.29103e-05_r8,0.32336e-05_r8,0.34308e-05_r8, & + & 0.35019e-05_r8,0.34046e-05_r8,0.31323e-05_r8,0.19511e-05_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.13241e-05_r8,0.25059e-05_r8,0.30019e-05_r8,0.33317e-05_r8,0.35516e-05_r8, & + & 0.36333e-05_r8,0.35372e-05_r8,0.32615e-05_r8,0.20254e-05_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.13325e-05_r8,0.25840e-05_r8,0.31009e-05_r8,0.34399e-05_r8,0.36699e-05_r8, & + & 0.37727e-05_r8,0.36811e-05_r8,0.34016e-05_r8,0.20611e-05_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.13321e-05_r8,0.26601e-05_r8,0.32189e-05_r8,0.35640e-05_r8,0.38012e-05_r8, & + & 0.39113e-05_r8,0.38271e-05_r8,0.35499e-05_r8,0.21368e-05_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.11079e-05_r8,0.20757e-05_r8,0.24846e-05_r8,0.27511e-05_r8,0.28883e-05_r8, & + & 0.29142e-05_r8,0.28203e-05_r8,0.25706e-05_r8,0.15124e-05_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.11298e-05_r8,0.21278e-05_r8,0.25551e-05_r8,0.28306e-05_r8,0.29814e-05_r8, & + & 0.30126e-05_r8,0.29328e-05_r8,0.26721e-05_r8,0.15784e-05_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.11405e-05_r8,0.21812e-05_r8,0.26237e-05_r8,0.29130e-05_r8,0.30816e-05_r8, & + & 0.31265e-05_r8,0.30480e-05_r8,0.27784e-05_r8,0.16468e-05_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.11347e-05_r8,0.22472e-05_r8,0.27094e-05_r8,0.30057e-05_r8,0.31821e-05_r8, & + & 0.32536e-05_r8,0.31714e-05_r8,0.28837e-05_r8,0.17189e-05_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.11383e-05_r8,0.23152e-05_r8,0.28016e-05_r8,0.31126e-05_r8,0.33051e-05_r8, & + & 0.33759e-05_r8,0.32961e-05_r8,0.29993e-05_r8,0.17919e-05_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.93104e-06_r8,0.18005e-05_r8,0.21693e-05_r8,0.23819e-05_r8,0.24829e-05_r8, & + & 0.24860e-05_r8,0.23860e-05_r8,0.21586e-05_r8,0.12198e-05_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.94591e-06_r8,0.18309e-05_r8,0.22153e-05_r8,0.24487e-05_r8,0.25574e-05_r8, & + & 0.25721e-05_r8,0.24802e-05_r8,0.22458e-05_r8,0.13105e-05_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.95638e-06_r8,0.18753e-05_r8,0.22788e-05_r8,0.25149e-05_r8,0.26499e-05_r8, & + & 0.26671e-05_r8,0.25797e-05_r8,0.23335e-05_r8,0.14017e-05_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.95763e-06_r8,0.19379e-05_r8,0.23271e-05_r8,0.25858e-05_r8,0.27437e-05_r8, & + & 0.27792e-05_r8,0.26790e-05_r8,0.24268e-05_r8,0.14872e-05_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.95668e-06_r8,0.19877e-05_r8,0.23997e-05_r8,0.26721e-05_r8,0.28382e-05_r8, & + & 0.28806e-05_r8,0.27857e-05_r8,0.25225e-05_r8,0.15698e-05_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.77329e-06_r8,0.15354e-05_r8,0.18723e-05_r8,0.20411e-05_r8,0.21095e-05_r8, & + & 0.21017e-05_r8,0.19998e-05_r8,0.18017e-05_r8,0.97629e-06_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.78241e-06_r8,0.15660e-05_r8,0.19091e-05_r8,0.20970e-05_r8,0.21786e-05_r8, & + & 0.21730e-05_r8,0.20794e-05_r8,0.18731e-05_r8,0.10645e-05_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.79463e-06_r8,0.15948e-05_r8,0.19458e-05_r8,0.21529e-05_r8,0.22557e-05_r8, & + & 0.22576e-05_r8,0.21631e-05_r8,0.19462e-05_r8,0.11507e-05_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.79779e-06_r8,0.16389e-05_r8,0.19877e-05_r8,0.22087e-05_r8,0.23274e-05_r8, & + & 0.23462e-05_r8,0.22501e-05_r8,0.20204e-05_r8,0.12366e-05_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.79875e-06_r8,0.16865e-05_r8,0.20410e-05_r8,0.22789e-05_r8,0.24049e-05_r8, & + & 0.24283e-05_r8,0.23388e-05_r8,0.21006e-05_r8,0.13155e-05_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.63799e-06_r8,0.13079e-05_r8,0.15873e-05_r8,0.17187e-05_r8,0.17689e-05_r8, & + & 0.17509e-05_r8,0.16625e-05_r8,0.14950e-05_r8,0.77624e-06_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.64423e-06_r8,0.13180e-05_r8,0.16173e-05_r8,0.17648e-05_r8,0.18253e-05_r8, & + & 0.18152e-05_r8,0.17299e-05_r8,0.15482e-05_r8,0.85457e-06_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.65214e-06_r8,0.13481e-05_r8,0.16476e-05_r8,0.18158e-05_r8,0.18867e-05_r8, & + & 0.18859e-05_r8,0.17999e-05_r8,0.16080e-05_r8,0.93968e-06_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.65949e-06_r8,0.13728e-05_r8,0.16795e-05_r8,0.18618e-05_r8,0.19507e-05_r8, & + & 0.19568e-05_r8,0.18693e-05_r8,0.16710e-05_r8,0.10256e-05_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.66012e-06_r8,0.14051e-05_r8,0.17174e-05_r8,0.19154e-05_r8,0.20111e-05_r8, & + & 0.20230e-05_r8,0.19421e-05_r8,0.17361e-05_r8,0.11072e-05_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.52652e-06_r8,0.10995e-05_r8,0.13221e-05_r8,0.14282e-05_r8,0.14627e-05_r8, & + & 0.14494e-05_r8,0.13754e-05_r8,0.12359e-05_r8,0.62399e-06_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.52631e-06_r8,0.11047e-05_r8,0.13498e-05_r8,0.14646e-05_r8,0.15094e-05_r8, & + & 0.14961e-05_r8,0.14272e-05_r8,0.12791e-05_r8,0.69692e-06_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.53263e-06_r8,0.11231e-05_r8,0.13763e-05_r8,0.15059e-05_r8,0.15602e-05_r8, & + & 0.15533e-05_r8,0.14827e-05_r8,0.13257e-05_r8,0.76959e-06_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.53788e-06_r8,0.11448e-05_r8,0.14026e-05_r8,0.15478e-05_r8,0.16122e-05_r8, & + & 0.16137e-05_r8,0.15398e-05_r8,0.13748e-05_r8,0.84488e-06_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.54243e-06_r8,0.11660e-05_r8,0.14288e-05_r8,0.15891e-05_r8,0.16619e-05_r8, & + & 0.16672e-05_r8,0.15978e-05_r8,0.14265e-05_r8,0.92439e-06_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.42860e-06_r8,0.91208e-06_r8,0.10887e-05_r8,0.11732e-05_r8,0.12000e-05_r8, & + & 0.11901e-05_r8,0.11300e-05_r8,0.10181e-05_r8,0.51360e-06_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.42605e-06_r8,0.91355e-06_r8,0.11105e-05_r8,0.12004e-05_r8,0.12359e-05_r8, & + & 0.12238e-05_r8,0.11674e-05_r8,0.10496e-05_r8,0.58593e-06_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.42910e-06_r8,0.92458e-06_r8,0.11341e-05_r8,0.12355e-05_r8,0.12754e-05_r8, & + & 0.12667e-05_r8,0.12100e-05_r8,0.10877e-05_r8,0.65209e-06_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.43345e-06_r8,0.94024e-06_r8,0.11540e-05_r8,0.12669e-05_r8,0.13186e-05_r8, & + & 0.13163e-05_r8,0.12567e-05_r8,0.11280e-05_r8,0.72051e-06_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.43744e-06_r8,0.95845e-06_r8,0.11764e-05_r8,0.13022e-05_r8,0.13595e-05_r8, & + & 0.13618e-05_r8,0.13034e-05_r8,0.11671e-05_r8,0.79373e-06_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.34458e-06_r8,0.74844e-06_r8,0.89217e-06_r8,0.95875e-06_r8,0.98243e-06_r8, & + & 0.97566e-06_r8,0.92936e-06_r8,0.83611e-06_r8,0.44181e-06_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.34797e-06_r8,0.75304e-06_r8,0.90816e-06_r8,0.98264e-06_r8,0.10080e-05_r8, & + & 0.99889e-06_r8,0.95318e-06_r8,0.86041e-06_r8,0.51013e-06_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.34593e-06_r8,0.76020e-06_r8,0.92707e-06_r8,0.10062e-05_r8,0.10391e-05_r8, & + & 0.10296e-05_r8,0.98530e-06_r8,0.89011e-06_r8,0.58070e-06_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.34971e-06_r8,0.77088e-06_r8,0.94623e-06_r8,0.10342e-05_r8,0.10726e-05_r8, & + & 0.10689e-05_r8,0.10210e-05_r8,0.92020e-06_r8,0.65697e-06_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.35282e-06_r8,0.78517e-06_r8,0.96245e-06_r8,0.10609e-05_r8,0.11071e-05_r8, & + & 0.11073e-05_r8,0.10583e-05_r8,0.95054e-06_r8,0.72956e-06_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.27840e-06_r8,0.61035e-06_r8,0.72930e-06_r8,0.78415e-06_r8,0.80451e-06_r8, & + & 0.79924e-06_r8,0.76231e-06_r8,0.68727e-06_r8,0.40208e-06_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.28171e-06_r8,0.61798e-06_r8,0.74197e-06_r8,0.80115e-06_r8,0.82183e-06_r8, & + & 0.81621e-06_r8,0.78030e-06_r8,0.70425e-06_r8,0.46700e-06_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.28023e-06_r8,0.62269e-06_r8,0.75685e-06_r8,0.82101e-06_r8,0.84538e-06_r8, & + & 0.83821e-06_r8,0.80301e-06_r8,0.72663e-06_r8,0.53781e-06_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.28163e-06_r8,0.63156e-06_r8,0.77214e-06_r8,0.84244e-06_r8,0.87184e-06_r8, & + & 0.86752e-06_r8,0.83024e-06_r8,0.75000e-06_r8,0.60478e-06_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.28518e-06_r8,0.64070e-06_r8,0.78628e-06_r8,0.86439e-06_r8,0.89969e-06_r8, & + & 0.89910e-06_r8,0.85933e-06_r8,0.77376e-06_r8,0.67016e-06_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.22555e-06_r8,0.50042e-06_r8,0.59960e-06_r8,0.64537e-06_r8,0.66324e-06_r8, & + & 0.65924e-06_r8,0.63003e-06_r8,0.56890e-06_r8,0.34466e-06_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.22858e-06_r8,0.50705e-06_r8,0.60997e-06_r8,0.65948e-06_r8,0.67688e-06_r8, & + & 0.67311e-06_r8,0.64462e-06_r8,0.58333e-06_r8,0.40300e-06_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.22677e-06_r8,0.51178e-06_r8,0.62299e-06_r8,0.67572e-06_r8,0.69624e-06_r8, & + & 0.69126e-06_r8,0.66285e-06_r8,0.60090e-06_r8,0.46066e-06_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.22825e-06_r8,0.51907e-06_r8,0.63500e-06_r8,0.69311e-06_r8,0.71796e-06_r8, & + & 0.71484e-06_r8,0.68416e-06_r8,0.61859e-06_r8,0.51966e-06_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.23122e-06_r8,0.52598e-06_r8,0.64574e-06_r8,0.71116e-06_r8,0.74046e-06_r8, & + & 0.73979e-06_r8,0.70672e-06_r8,0.63708e-06_r8,0.58196e-06_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.18149e-06_r8,0.40829e-06_r8,0.49022e-06_r8,0.52910e-06_r8,0.54408e-06_r8, & + & 0.54163e-06_r8,0.51867e-06_r8,0.46933e-06_r8,0.28496e-06_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.18433e-06_r8,0.41378e-06_r8,0.49908e-06_r8,0.54027e-06_r8,0.55522e-06_r8, & + & 0.55286e-06_r8,0.53038e-06_r8,0.48103e-06_r8,0.33336e-06_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.18246e-06_r8,0.41799e-06_r8,0.50965e-06_r8,0.55347e-06_r8,0.57134e-06_r8, & + & 0.56787e-06_r8,0.54477e-06_r8,0.49462e-06_r8,0.38023e-06_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.18409e-06_r8,0.42347e-06_r8,0.51936e-06_r8,0.56749e-06_r8,0.58877e-06_r8, & + & 0.58648e-06_r8,0.56149e-06_r8,0.50825e-06_r8,0.43081e-06_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.18582e-06_r8,0.42888e-06_r8,0.52830e-06_r8,0.58240e-06_r8,0.60647e-06_r8, & + & 0.60598e-06_r8,0.57933e-06_r8,0.52277e-06_r8,0.48565e-06_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.14345e-06_r8,0.32927e-06_r8,0.39750e-06_r8,0.43000e-06_r8,0.44318e-06_r8, & + & 0.44201e-06_r8,0.42469e-06_r8,0.38538e-06_r8,0.23377e-06_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.14571e-06_r8,0.33355e-06_r8,0.40430e-06_r8,0.43954e-06_r8,0.45256e-06_r8, & + & 0.45159e-06_r8,0.43399e-06_r8,0.39467e-06_r8,0.27338e-06_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.14442e-06_r8,0.33719e-06_r8,0.41316e-06_r8,0.44996e-06_r8,0.46575e-06_r8, & + & 0.46364e-06_r8,0.44528e-06_r8,0.40510e-06_r8,0.31154e-06_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.14600e-06_r8,0.34141e-06_r8,0.42136e-06_r8,0.46096e-06_r8,0.47937e-06_r8, & + & 0.47817e-06_r8,0.45850e-06_r8,0.41598e-06_r8,0.35289e-06_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.14667e-06_r8,0.34608e-06_r8,0.42853e-06_r8,0.47296e-06_r8,0.49300e-06_r8, & + & 0.49352e-06_r8,0.47280e-06_r8,0.42757e-06_r8,0.39752e-06_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.16288e-04_r8,0.25817e-04_r8,0.29597e-04_r8,0.31319e-04_r8,0.31220e-04_r8, & + & 0.29539e-04_r8,0.25627e-04_r8,0.19758e-04_r8,0.72944e-05_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.18123e-04_r8,0.28565e-04_r8,0.32633e-04_r8,0.34427e-04_r8,0.34219e-04_r8, & + & 0.32223e-04_r8,0.27987e-04_r8,0.21485e-04_r8,0.79554e-05_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.19957e-04_r8,0.31607e-04_r8,0.36033e-04_r8,0.37887e-04_r8,0.37694e-04_r8, & + & 0.35399e-04_r8,0.30718e-04_r8,0.23412e-04_r8,0.85293e-05_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.22005e-04_r8,0.35064e-04_r8,0.39763e-04_r8,0.41694e-04_r8,0.41490e-04_r8, & + & 0.38891e-04_r8,0.33715e-04_r8,0.25512e-04_r8,0.91232e-05_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.24240e-04_r8,0.38906e-04_r8,0.43899e-04_r8,0.45870e-04_r8,0.45580e-04_r8, & + & 0.42616e-04_r8,0.36912e-04_r8,0.27728e-04_r8,0.97792e-05_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.14944e-04_r8,0.23223e-04_r8,0.25792e-04_r8,0.27019e-04_r8,0.26963e-04_r8, & + & 0.25431e-04_r8,0.22069e-04_r8,0.16933e-04_r8,0.59071e-05_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.16615e-04_r8,0.25452e-04_r8,0.28322e-04_r8,0.29800e-04_r8,0.29593e-04_r8, & + & 0.27776e-04_r8,0.24123e-04_r8,0.18444e-04_r8,0.63142e-05_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.18355e-04_r8,0.27996e-04_r8,0.31338e-04_r8,0.32892e-04_r8,0.32575e-04_r8, & + & 0.30478e-04_r8,0.26504e-04_r8,0.20132e-04_r8,0.67898e-05_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.20092e-04_r8,0.30938e-04_r8,0.34680e-04_r8,0.36255e-04_r8,0.35836e-04_r8, & + & 0.33500e-04_r8,0.29106e-04_r8,0.21950e-04_r8,0.73343e-05_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.21897e-04_r8,0.34150e-04_r8,0.38274e-04_r8,0.39931e-04_r8,0.39337e-04_r8, & + & 0.36752e-04_r8,0.31831e-04_r8,0.23882e-04_r8,0.78705e-05_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.13130e-04_r8,0.20363e-04_r8,0.22377e-04_r8,0.23003e-04_r8,0.22683e-04_r8, & + & 0.21429e-04_r8,0.18621e-04_r8,0.14177e-04_r8,0.47892e-05_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.14610e-04_r8,0.22299e-04_r8,0.24486e-04_r8,0.25140e-04_r8,0.24842e-04_r8, & + & 0.23413e-04_r8,0.20361e-04_r8,0.15469e-04_r8,0.52250e-05_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.16133e-04_r8,0.24482e-04_r8,0.26876e-04_r8,0.27653e-04_r8,0.27357e-04_r8, & + & 0.25669e-04_r8,0.22341e-04_r8,0.16897e-04_r8,0.56647e-05_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.17708e-04_r8,0.26887e-04_r8,0.29522e-04_r8,0.30577e-04_r8,0.30151e-04_r8, & + & 0.28221e-04_r8,0.24545e-04_r8,0.18455e-04_r8,0.60735e-05_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.19305e-04_r8,0.29364e-04_r8,0.32520e-04_r8,0.33741e-04_r8,0.33162e-04_r8, & + & 0.30976e-04_r8,0.26800e-04_r8,0.20103e-04_r8,0.64864e-05_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.11163e-04_r8,0.17498e-04_r8,0.19069e-04_r8,0.19561e-04_r8,0.19154e-04_r8, & + & 0.17906e-04_r8,0.15522e-04_r8,0.11778e-04_r8,0.40461e-05_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.12505e-04_r8,0.19238e-04_r8,0.20917e-04_r8,0.21365e-04_r8,0.20913e-04_r8, & + & 0.19471e-04_r8,0.16986e-04_r8,0.12856e-04_r8,0.43935e-05_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.13848e-04_r8,0.21132e-04_r8,0.22975e-04_r8,0.23433e-04_r8,0.22893e-04_r8, & + & 0.21327e-04_r8,0.18662e-04_r8,0.14056e-04_r8,0.47015e-05_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.15219e-04_r8,0.23159e-04_r8,0.25250e-04_r8,0.25753e-04_r8,0.25088e-04_r8, & + & 0.23437e-04_r8,0.20455e-04_r8,0.15366e-04_r8,0.50239e-05_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.16631e-04_r8,0.25311e-04_r8,0.27651e-04_r8,0.28243e-04_r8,0.27566e-04_r8, & + & 0.25775e-04_r8,0.22344e-04_r8,0.16758e-04_r8,0.53594e-05_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.92688e-05_r8,0.14829e-04_r8,0.16036e-04_r8,0.16388e-04_r8,0.16087e-04_r8, & + & 0.15049e-04_r8,0.12939e-04_r8,0.97243e-05_r8,0.35064e-05_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.10428e-04_r8,0.16289e-04_r8,0.17596e-04_r8,0.17928e-04_r8,0.17547e-04_r8, & + & 0.16347e-04_r8,0.14108e-04_r8,0.10621e-04_r8,0.37893e-05_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.11600e-04_r8,0.17922e-04_r8,0.19403e-04_r8,0.19701e-04_r8,0.19227e-04_r8, & + & 0.17835e-04_r8,0.15439e-04_r8,0.11627e-04_r8,0.40426e-05_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.12795e-04_r8,0.19672e-04_r8,0.21360e-04_r8,0.21677e-04_r8,0.21078e-04_r8, & + & 0.19535e-04_r8,0.16919e-04_r8,0.12746e-04_r8,0.43015e-05_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.14029e-04_r8,0.21551e-04_r8,0.23410e-04_r8,0.23746e-04_r8,0.23106e-04_r8, & + & 0.21397e-04_r8,0.18500e-04_r8,0.13918e-04_r8,0.45663e-05_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.75358e-05_r8,0.12284e-04_r8,0.13321e-04_r8,0.13580e-04_r8,0.13322e-04_r8, & + & 0.12459e-04_r8,0.10757e-04_r8,0.80012e-05_r8,0.28595e-05_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.84801e-05_r8,0.13541e-04_r8,0.14600e-04_r8,0.14857e-04_r8,0.14519e-04_r8, & + & 0.13528e-04_r8,0.11747e-04_r8,0.87199e-05_r8,0.31250e-05_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.94797e-05_r8,0.14898e-04_r8,0.16088e-04_r8,0.16329e-04_r8,0.15922e-04_r8, & + & 0.14786e-04_r8,0.12839e-04_r8,0.95406e-05_r8,0.33925e-05_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.10510e-04_r8,0.16387e-04_r8,0.17709e-04_r8,0.17968e-04_r8,0.17465e-04_r8, & + & 0.16205e-04_r8,0.13999e-04_r8,0.10465e-04_r8,0.36786e-05_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.11554e-04_r8,0.17973e-04_r8,0.19442e-04_r8,0.19736e-04_r8,0.19170e-04_r8, & + & 0.17751e-04_r8,0.15288e-04_r8,0.11441e-04_r8,0.39618e-05_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.59994e-05_r8,0.10068e-04_r8,0.10903e-04_r8,0.11100e-04_r8,0.10910e-04_r8, & + & 0.10207e-04_r8,0.88301e-05_r8,0.65755e-05_r8,0.23537e-05_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.67911e-05_r8,0.11098e-04_r8,0.11964e-04_r8,0.12161e-04_r8,0.11910e-04_r8, & + & 0.11113e-04_r8,0.96475e-05_r8,0.71733e-05_r8,0.26021e-05_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.76012e-05_r8,0.12205e-04_r8,0.13167e-04_r8,0.13368e-04_r8,0.13058e-04_r8, & + & 0.12136e-04_r8,0.10571e-04_r8,0.78452e-05_r8,0.28416e-05_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.84582e-05_r8,0.13412e-04_r8,0.14518e-04_r8,0.14721e-04_r8,0.14328e-04_r8, & + & 0.13323e-04_r8,0.11527e-04_r8,0.85995e-05_r8,0.30925e-05_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.93346e-05_r8,0.14749e-04_r8,0.15973e-04_r8,0.16180e-04_r8,0.15730e-04_r8, & + & 0.14597e-04_r8,0.12601e-04_r8,0.93973e-05_r8,0.33285e-05_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.47174e-05_r8,0.81367e-05_r8,0.88184e-05_r8,0.90007e-05_r8,0.88363e-05_r8, & + & 0.83059e-05_r8,0.72101e-05_r8,0.53496e-05_r8,0.18862e-05_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.53543e-05_r8,0.89852e-05_r8,0.96904e-05_r8,0.98666e-05_r8,0.96509e-05_r8, & + & 0.90368e-05_r8,0.78700e-05_r8,0.58341e-05_r8,0.21147e-05_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.60088e-05_r8,0.98855e-05_r8,0.10666e-04_r8,0.10849e-04_r8,0.10597e-04_r8, & + & 0.98826e-05_r8,0.86243e-05_r8,0.63949e-05_r8,0.23672e-05_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.66958e-05_r8,0.10873e-04_r8,0.11751e-04_r8,0.11945e-04_r8,0.11636e-04_r8, & + & 0.10852e-04_r8,0.94101e-05_r8,0.70262e-05_r8,0.26329e-05_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.74191e-05_r8,0.11960e-04_r8,0.12943e-04_r8,0.13152e-04_r8,0.12788e-04_r8, & + & 0.11889e-04_r8,0.10297e-04_r8,0.76977e-05_r8,0.29019e-05_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.36886e-05_r8,0.65140e-05_r8,0.70684e-05_r8,0.72377e-05_r8,0.71080e-05_r8, & + & 0.67076e-05_r8,0.58353e-05_r8,0.43297e-05_r8,0.16419e-05_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.41772e-05_r8,0.72104e-05_r8,0.77793e-05_r8,0.79335e-05_r8,0.77682e-05_r8, & + & 0.72903e-05_r8,0.63640e-05_r8,0.47210e-05_r8,0.18721e-05_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.47123e-05_r8,0.79471e-05_r8,0.85662e-05_r8,0.87396e-05_r8,0.85319e-05_r8, & + & 0.79769e-05_r8,0.69694e-05_r8,0.51793e-05_r8,0.21015e-05_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.52612e-05_r8,0.87319e-05_r8,0.94365e-05_r8,0.96191e-05_r8,0.93783e-05_r8, & + & 0.87581e-05_r8,0.76277e-05_r8,0.56974e-05_r8,0.23505e-05_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.58401e-05_r8,0.96106e-05_r8,0.10404e-04_r8,0.10594e-04_r8,0.10308e-04_r8, & + & 0.96030e-05_r8,0.83402e-05_r8,0.62627e-05_r8,0.26170e-05_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.29023e-05_r8,0.52230e-05_r8,0.56669e-05_r8,0.58158e-05_r8,0.57137e-05_r8, & + & 0.54241e-05_r8,0.47416e-05_r8,0.35098e-05_r8,0.14223e-05_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.32752e-05_r8,0.57903e-05_r8,0.62548e-05_r8,0.63859e-05_r8,0.62528e-05_r8, & + & 0.58881e-05_r8,0.51542e-05_r8,0.38257e-05_r8,0.16559e-05_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.37047e-05_r8,0.63892e-05_r8,0.68928e-05_r8,0.70312e-05_r8,0.68734e-05_r8, & + & 0.64357e-05_r8,0.56361e-05_r8,0.42003e-05_r8,0.19248e-05_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.41471e-05_r8,0.70179e-05_r8,0.75920e-05_r8,0.77496e-05_r8,0.75508e-05_r8, & + & 0.70624e-05_r8,0.61778e-05_r8,0.46271e-05_r8,0.22074e-05_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.46061e-05_r8,0.77215e-05_r8,0.83699e-05_r8,0.85300e-05_r8,0.83121e-05_r8, & + & 0.77493e-05_r8,0.67551e-05_r8,0.50931e-05_r8,0.25043e-05_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.24060e-05_r8,0.43752e-05_r8,0.47372e-05_r8,0.48598e-05_r8,0.47689e-05_r8, & + & 0.45290e-05_r8,0.39653e-05_r8,0.29444e-05_r8,0.12255e-05_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.27123e-05_r8,0.48479e-05_r8,0.52339e-05_r8,0.53482e-05_r8,0.52342e-05_r8, & + & 0.49275e-05_r8,0.43239e-05_r8,0.32196e-05_r8,0.14282e-05_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.30632e-05_r8,0.53402e-05_r8,0.57660e-05_r8,0.58936e-05_r8,0.57515e-05_r8, & + & 0.53873e-05_r8,0.47344e-05_r8,0.35410e-05_r8,0.16636e-05_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.34245e-05_r8,0.58653e-05_r8,0.63554e-05_r8,0.64878e-05_r8,0.63244e-05_r8, & + & 0.59147e-05_r8,0.51855e-05_r8,0.39068e-05_r8,0.18858e-05_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.37984e-05_r8,0.64557e-05_r8,0.70032e-05_r8,0.71432e-05_r8,0.69591e-05_r8, & + & 0.64936e-05_r8,0.56748e-05_r8,0.42889e-05_r8,0.21529e-05_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.19822e-05_r8,0.36438e-05_r8,0.39439e-05_r8,0.40428e-05_r8,0.39656e-05_r8, & + & 0.37627e-05_r8,0.33048e-05_r8,0.24620e-05_r8,0.10349e-05_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.22347e-05_r8,0.40329e-05_r8,0.43559e-05_r8,0.44535e-05_r8,0.43556e-05_r8, & + & 0.41018e-05_r8,0.36156e-05_r8,0.26976e-05_r8,0.12078e-05_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.25196e-05_r8,0.44405e-05_r8,0.47965e-05_r8,0.49025e-05_r8,0.47850e-05_r8, & + & 0.44854e-05_r8,0.39542e-05_r8,0.29734e-05_r8,0.13908e-05_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.28142e-05_r8,0.48792e-05_r8,0.52882e-05_r8,0.53962e-05_r8,0.52646e-05_r8, & + & 0.49202e-05_r8,0.43229e-05_r8,0.32817e-05_r8,0.15895e-05_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.31182e-05_r8,0.53684e-05_r8,0.58256e-05_r8,0.59413e-05_r8,0.57855e-05_r8, & + & 0.54043e-05_r8,0.47298e-05_r8,0.35925e-05_r8,0.18050e-05_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.16206e-05_r8,0.30122e-05_r8,0.32612e-05_r8,0.33451e-05_r8,0.32794e-05_r8, & + & 0.31144e-05_r8,0.27430e-05_r8,0.20488e-05_r8,0.85267e-06_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.18267e-05_r8,0.33331e-05_r8,0.36002e-05_r8,0.36816e-05_r8,0.36054e-05_r8, & + & 0.33950e-05_r8,0.30021e-05_r8,0.22487e-05_r8,0.99490e-06_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.20587e-05_r8,0.36681e-05_r8,0.39651e-05_r8,0.40531e-05_r8,0.39564e-05_r8, & + & 0.37127e-05_r8,0.32815e-05_r8,0.24795e-05_r8,0.11422e-05_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.22973e-05_r8,0.40325e-05_r8,0.43728e-05_r8,0.44600e-05_r8,0.43540e-05_r8, & + & 0.40718e-05_r8,0.35848e-05_r8,0.27366e-05_r8,0.13051e-05_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.25452e-05_r8,0.44379e-05_r8,0.48164e-05_r8,0.49100e-05_r8,0.47833e-05_r8, & + & 0.44674e-05_r8,0.39194e-05_r8,0.29904e-05_r8,0.14817e-05_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.66641e-04_r8,0.92990e-04_r8,0.96277e-04_r8,0.95182e-04_r8,0.91424e-04_r8, & + & 0.85445e-04_r8,0.77014e-04_r8,0.62091e-04_r8,0.18284e-04_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.75350e-04_r8,0.10391e-03_r8,0.10751e-03_r8,0.10606e-03_r8,0.10174e-03_r8, & + & 0.94756e-04_r8,0.84487e-04_r8,0.67267e-04_r8,0.20037e-04_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.85286e-04_r8,0.11563e-03_r8,0.11966e-03_r8,0.11777e-03_r8,0.11259e-03_r8, & + & 0.10435e-03_r8,0.92076e-04_r8,0.72492e-04_r8,0.22229e-04_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.96137e-04_r8,0.12836e-03_r8,0.13265e-03_r8,0.13031e-03_r8,0.12404e-03_r8, & + & 0.11409e-03_r8,0.99756e-04_r8,0.77897e-04_r8,0.24656e-04_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.10739e-03_r8,0.14209e-03_r8,0.14652e-03_r8,0.14363e-03_r8,0.13579e-03_r8, & + & 0.12408e-03_r8,0.10749e-03_r8,0.83273e-04_r8,0.26998e-04_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.57005e-04_r8,0.80688e-04_r8,0.84199e-04_r8,0.83067e-04_r8,0.79480e-04_r8, & + & 0.74096e-04_r8,0.66328e-04_r8,0.53532e-04_r8,0.14534e-04_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.64518e-04_r8,0.90274e-04_r8,0.94149e-04_r8,0.92496e-04_r8,0.88374e-04_r8, & + & 0.82048e-04_r8,0.72698e-04_r8,0.57871e-04_r8,0.16202e-04_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.73014e-04_r8,0.10065e-03_r8,0.10466e-03_r8,0.10271e-03_r8,0.97880e-04_r8, & + & 0.90372e-04_r8,0.79361e-04_r8,0.62357e-04_r8,0.18056e-04_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.82297e-04_r8,0.11195e-03_r8,0.11586e-03_r8,0.11365e-03_r8,0.10799e-03_r8, & + & 0.98829e-04_r8,0.85923e-04_r8,0.66891e-04_r8,0.19890e-04_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.92175e-04_r8,0.12399e-03_r8,0.12794e-03_r8,0.12531e-03_r8,0.11825e-03_r8, & + & 0.10764e-03_r8,0.92744e-04_r8,0.71608e-04_r8,0.21968e-04_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.47324e-04_r8,0.68167e-04_r8,0.71069e-04_r8,0.70293e-04_r8,0.67313e-04_r8, & + & 0.62456e-04_r8,0.55646e-04_r8,0.44933e-04_r8,0.11374e-04_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.53658e-04_r8,0.76342e-04_r8,0.79560e-04_r8,0.78547e-04_r8,0.74997e-04_r8, & + & 0.69264e-04_r8,0.61119e-04_r8,0.48587e-04_r8,0.12639e-04_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.60905e-04_r8,0.85247e-04_r8,0.88738e-04_r8,0.87387e-04_r8,0.83098e-04_r8, & + & 0.76432e-04_r8,0.66733e-04_r8,0.52275e-04_r8,0.13871e-04_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.68831e-04_r8,0.94960e-04_r8,0.98638e-04_r8,0.96778e-04_r8,0.91816e-04_r8, & + & 0.83747e-04_r8,0.72403e-04_r8,0.56165e-04_r8,0.15423e-04_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.77259e-04_r8,0.10549e-03_r8,0.10909e-03_r8,0.10672e-03_r8,0.10065e-03_r8, & + & 0.91320e-04_r8,0.78406e-04_r8,0.60157e-04_r8,0.17141e-04_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.40102e-04_r8,0.56990e-04_r8,0.59444e-04_r8,0.58732e-04_r8,0.56091e-04_r8, & + & 0.51902e-04_r8,0.46247e-04_r8,0.37442e-04_r8,0.94022e-05_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.44930e-04_r8,0.63893e-04_r8,0.66629e-04_r8,0.65694e-04_r8,0.62627e-04_r8, & + & 0.57822e-04_r8,0.50819e-04_r8,0.40421e-04_r8,0.10475e-04_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.50532e-04_r8,0.71424e-04_r8,0.74352e-04_r8,0.73221e-04_r8,0.69651e-04_r8, & + & 0.64034e-04_r8,0.55430e-04_r8,0.43529e-04_r8,0.11728e-04_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.56953e-04_r8,0.79740e-04_r8,0.82769e-04_r8,0.81314e-04_r8,0.77278e-04_r8, & + & 0.70324e-04_r8,0.60396e-04_r8,0.46747e-04_r8,0.13063e-04_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.64019e-04_r8,0.88647e-04_r8,0.91768e-04_r8,0.89926e-04_r8,0.84958e-04_r8, & + & 0.76740e-04_r8,0.65561e-04_r8,0.50066e-04_r8,0.14435e-04_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.33806e-04_r8,0.47826e-04_r8,0.49443e-04_r8,0.48775e-04_r8,0.46477e-04_r8, & + & 0.42791e-04_r8,0.38155e-04_r8,0.31175e-04_r8,0.77886e-05_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.37973e-04_r8,0.53392e-04_r8,0.55526e-04_r8,0.54719e-04_r8,0.52062e-04_r8, & + & 0.47763e-04_r8,0.42021e-04_r8,0.33510e-04_r8,0.87404e-05_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.42758e-04_r8,0.59666e-04_r8,0.62058e-04_r8,0.61127e-04_r8,0.58012e-04_r8, & + & 0.53071e-04_r8,0.45971e-04_r8,0.36114e-04_r8,0.98499e-05_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.48006e-04_r8,0.66679e-04_r8,0.69230e-04_r8,0.67989e-04_r8,0.64400e-04_r8, & + & 0.58521e-04_r8,0.50196e-04_r8,0.38710e-04_r8,0.11022e-04_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.53657e-04_r8,0.74244e-04_r8,0.76813e-04_r8,0.75303e-04_r8,0.71011e-04_r8, & + & 0.64092e-04_r8,0.54599e-04_r8,0.41481e-04_r8,0.12225e-04_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.27953e-04_r8,0.40223e-04_r8,0.41331e-04_r8,0.40332e-04_r8,0.38114e-04_r8, & + & 0.34967e-04_r8,0.31158e-04_r8,0.25701e-04_r8,0.67604e-05_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.31595e-04_r8,0.44975e-04_r8,0.46374e-04_r8,0.45229e-04_r8,0.42775e-04_r8, & + & 0.39162e-04_r8,0.34373e-04_r8,0.27616e-04_r8,0.75558e-05_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.35649e-04_r8,0.50263e-04_r8,0.51713e-04_r8,0.50516e-04_r8,0.47855e-04_r8, & + & 0.43605e-04_r8,0.37705e-04_r8,0.29800e-04_r8,0.84063e-05_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.40086e-04_r8,0.55905e-04_r8,0.57584e-04_r8,0.56348e-04_r8,0.53200e-04_r8, & + & 0.48283e-04_r8,0.41331e-04_r8,0.31936e-04_r8,0.92686e-05_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.44931e-04_r8,0.62025e-04_r8,0.63942e-04_r8,0.62498e-04_r8,0.58788e-04_r8, & + & 0.53032e-04_r8,0.45085e-04_r8,0.34229e-04_r8,0.10175e-04_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.22829e-04_r8,0.33278e-04_r8,0.34196e-04_r8,0.33381e-04_r8,0.31444e-04_r8, & + & 0.28615e-04_r8,0.25331e-04_r8,0.21096e-04_r8,0.60732e-05_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.25917e-04_r8,0.37424e-04_r8,0.38527e-04_r8,0.37580e-04_r8,0.35302e-04_r8, & + & 0.32020e-04_r8,0.27957e-04_r8,0.22660e-04_r8,0.68180e-05_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.29386e-04_r8,0.41933e-04_r8,0.43213e-04_r8,0.42039e-04_r8,0.39445e-04_r8, & + & 0.35659e-04_r8,0.30780e-04_r8,0.24432e-04_r8,0.76296e-05_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.33186e-04_r8,0.46811e-04_r8,0.48218e-04_r8,0.46849e-04_r8,0.43848e-04_r8, & + & 0.39567e-04_r8,0.33858e-04_r8,0.26257e-04_r8,0.82634e-05_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.37227e-04_r8,0.52060e-04_r8,0.53592e-04_r8,0.51948e-04_r8,0.48471e-04_r8, & + & 0.43595e-04_r8,0.37022e-04_r8,0.28130e-04_r8,0.90053e-05_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.18333e-04_r8,0.27259e-04_r8,0.27929e-04_r8,0.27230e-04_r8,0.25672e-04_r8, & + & 0.23374e-04_r8,0.20571e-04_r8,0.17333e-04_r8,0.54157e-05_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.20948e-04_r8,0.30774e-04_r8,0.31604e-04_r8,0.30823e-04_r8,0.29002e-04_r8, & + & 0.26292e-04_r8,0.22734e-04_r8,0.18593e-04_r8,0.61669e-05_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.23883e-04_r8,0.34642e-04_r8,0.35656e-04_r8,0.34670e-04_r8,0.32507e-04_r8, & + & 0.29303e-04_r8,0.25111e-04_r8,0.19985e-04_r8,0.69048e-05_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.27098e-04_r8,0.38802e-04_r8,0.40013e-04_r8,0.38777e-04_r8,0.36214e-04_r8, & + & 0.32542e-04_r8,0.27674e-04_r8,0.21526e-04_r8,0.76591e-05_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.30462e-04_r8,0.43307e-04_r8,0.44596e-04_r8,0.43127e-04_r8,0.40142e-04_r8, & + & 0.35890e-04_r8,0.30276e-04_r8,0.23065e-04_r8,0.84480e-05_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.14510e-04_r8,0.22049e-04_r8,0.22596e-04_r8,0.22021e-04_r8,0.20750e-04_r8, & + & 0.18895e-04_r8,0.16685e-04_r8,0.14158e-04_r8,0.50284e-05_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.16710e-04_r8,0.25012e-04_r8,0.25686e-04_r8,0.25017e-04_r8,0.23537e-04_r8, & + & 0.21350e-04_r8,0.18517e-04_r8,0.15170e-04_r8,0.59016e-05_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.19138e-04_r8,0.28271e-04_r8,0.29104e-04_r8,0.28272e-04_r8,0.26493e-04_r8, & + & 0.23916e-04_r8,0.20530e-04_r8,0.16297e-04_r8,0.68413e-05_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.21798e-04_r8,0.31859e-04_r8,0.32802e-04_r8,0.31762e-04_r8,0.29603e-04_r8, & + & 0.26643e-04_r8,0.22650e-04_r8,0.17559e-04_r8,0.78093e-05_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.24599e-04_r8,0.35618e-04_r8,0.36736e-04_r8,0.35456e-04_r8,0.32981e-04_r8, & + & 0.29459e-04_r8,0.24877e-04_r8,0.18821e-04_r8,0.88149e-05_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.11455e-04_r8,0.17796e-04_r8,0.18282e-04_r8,0.17833e-04_r8,0.16814e-04_r8, & + & 0.15305e-04_r8,0.13526e-04_r8,0.11628e-04_r8,0.47637e-05_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.13295e-04_r8,0.20290e-04_r8,0.20862e-04_r8,0.20316e-04_r8,0.19125e-04_r8, & + & 0.17348e-04_r8,0.15042e-04_r8,0.12455e-04_r8,0.56495e-05_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.15297e-04_r8,0.22994e-04_r8,0.23740e-04_r8,0.23076e-04_r8,0.21626e-04_r8, & + & 0.19529e-04_r8,0.16766e-04_r8,0.13399e-04_r8,0.65988e-05_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.17488e-04_r8,0.25986e-04_r8,0.26882e-04_r8,0.26021e-04_r8,0.24246e-04_r8, & + & 0.21820e-04_r8,0.18554e-04_r8,0.14427e-04_r8,0.74644e-05_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.19800e-04_r8,0.29160e-04_r8,0.30208e-04_r8,0.29161e-04_r8,0.27086e-04_r8, & + & 0.24189e-04_r8,0.20462e-04_r8,0.15474e-04_r8,0.84395e-05_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.96366e-05_r8,0.15168e-04_r8,0.15611e-04_r8,0.15230e-04_r8,0.14381e-04_r8, & + & 0.13058e-04_r8,0.11457e-04_r8,0.98195e-05_r8,0.43210e-05_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.11221e-04_r8,0.17304e-04_r8,0.17859e-04_r8,0.17390e-04_r8,0.16383e-04_r8, & + & 0.14837e-04_r8,0.12820e-04_r8,0.10541e-04_r8,0.50915e-05_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.12922e-04_r8,0.19611e-04_r8,0.20376e-04_r8,0.19769e-04_r8,0.18510e-04_r8, & + & 0.16733e-04_r8,0.14297e-04_r8,0.11375e-04_r8,0.59349e-05_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.14759e-04_r8,0.22226e-04_r8,0.23087e-04_r8,0.22319e-04_r8,0.20789e-04_r8, & + & 0.18677e-04_r8,0.15854e-04_r8,0.12233e-04_r8,0.68646e-05_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.16687e-04_r8,0.24901e-04_r8,0.25894e-04_r8,0.25020e-04_r8,0.23234e-04_r8, & + & 0.20746e-04_r8,0.17450e-04_r8,0.13143e-04_r8,0.77945e-05_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.80728e-05_r8,0.12833e-04_r8,0.13241e-04_r8,0.12930e-04_r8,0.12209e-04_r8, & + & 0.11077e-04_r8,0.96874e-05_r8,0.82518e-05_r8,0.36987e-05_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.94096e-05_r8,0.14647e-04_r8,0.15179e-04_r8,0.14789e-04_r8,0.13929e-04_r8, & + & 0.12614e-04_r8,0.10863e-04_r8,0.88839e-05_r8,0.43642e-05_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.10827e-04_r8,0.16625e-04_r8,0.17336e-04_r8,0.16825e-04_r8,0.15757e-04_r8, & + & 0.14215e-04_r8,0.12135e-04_r8,0.95702e-05_r8,0.51276e-05_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.12346e-04_r8,0.18823e-04_r8,0.19626e-04_r8,0.19011e-04_r8,0.17715e-04_r8, & + & 0.15891e-04_r8,0.13472e-04_r8,0.10297e-04_r8,0.58818e-05_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.13954e-04_r8,0.21071e-04_r8,0.21985e-04_r8,0.21278e-04_r8,0.19773e-04_r8, & + & 0.17642e-04_r8,0.14813e-04_r8,0.11109e-04_r8,0.66485e-05_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.67198e-05_r8,0.10777e-04_r8,0.11153e-04_r8,0.10900e-04_r8,0.10301e-04_r8, & + & 0.93345e-05_r8,0.81433e-05_r8,0.69156e-05_r8,0.30498e-05_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.78283e-05_r8,0.12283e-04_r8,0.12805e-04_r8,0.12492e-04_r8,0.11757e-04_r8, & + & 0.10649e-04_r8,0.91519e-05_r8,0.74495e-05_r8,0.36028e-05_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.89966e-05_r8,0.13983e-04_r8,0.14629e-04_r8,0.14218e-04_r8,0.13315e-04_r8, & + & 0.11990e-04_r8,0.10230e-04_r8,0.80237e-05_r8,0.42382e-05_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.10250e-04_r8,0.15794e-04_r8,0.16536e-04_r8,0.16055e-04_r8,0.14979e-04_r8, & + & 0.13421e-04_r8,0.11355e-04_r8,0.86371e-05_r8,0.48511e-05_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.11575e-04_r8,0.17689e-04_r8,0.18502e-04_r8,0.17950e-04_r8,0.16689e-04_r8, & + & 0.14883e-04_r8,0.12476e-04_r8,0.93537e-05_r8,0.54799e-05_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.20313e-03_r8,0.26410e-03_r8,0.27054e-03_r8,0.25842e-03_r8,0.23794e-03_r8, & + & 0.21033e-03_r8,0.17730e-03_r8,0.13831e-03_r8,0.52995e-04_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.22722e-03_r8,0.29058e-03_r8,0.29572e-03_r8,0.28200e-03_r8,0.25898e-03_r8, & + & 0.22814e-03_r8,0.19209e-03_r8,0.14957e-03_r8,0.59096e-04_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.25054e-03_r8,0.31580e-03_r8,0.31991e-03_r8,0.30486e-03_r8,0.27955e-03_r8, & + & 0.24634e-03_r8,0.20787e-03_r8,0.16179e-03_r8,0.65118e-04_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.27197e-03_r8,0.33971e-03_r8,0.34310e-03_r8,0.32677e-03_r8,0.30002e-03_r8, & + & 0.26574e-03_r8,0.22502e-03_r8,0.17520e-03_r8,0.71711e-04_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.29178e-03_r8,0.36213e-03_r8,0.36503e-03_r8,0.34815e-03_r8,0.32114e-03_r8, & + & 0.28599e-03_r8,0.24328e-03_r8,0.18958e-03_r8,0.78523e-04_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.17547e-03_r8,0.23012e-03_r8,0.23639e-03_r8,0.22606e-03_r8,0.20799e-03_r8, & + & 0.18326e-03_r8,0.15385e-03_r8,0.11888e-03_r8,0.43633e-04_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.19601e-03_r8,0.25269e-03_r8,0.25751e-03_r8,0.24629e-03_r8,0.22623e-03_r8, & + & 0.19926e-03_r8,0.16712e-03_r8,0.12877e-03_r8,0.48382e-04_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.21598e-03_r8,0.27423e-03_r8,0.27812e-03_r8,0.26576e-03_r8,0.24403e-03_r8, & + & 0.21552e-03_r8,0.18141e-03_r8,0.13982e-03_r8,0.53560e-04_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.23449e-03_r8,0.29482e-03_r8,0.29820e-03_r8,0.28454e-03_r8,0.26171e-03_r8, & + & 0.23254e-03_r8,0.19681e-03_r8,0.15192e-03_r8,0.59054e-04_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.25198e-03_r8,0.31408e-03_r8,0.31723e-03_r8,0.30341e-03_r8,0.28040e-03_r8, & + & 0.25022e-03_r8,0.21333e-03_r8,0.16487e-03_r8,0.64779e-04_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.14736e-03_r8,0.19483e-03_r8,0.20065e-03_r8,0.19242e-03_r8,0.17728e-03_r8, & + & 0.15627e-03_r8,0.13078e-03_r8,0.10037e-03_r8,0.34217e-04_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.16492e-03_r8,0.21441e-03_r8,0.21892e-03_r8,0.20980e-03_r8,0.19289e-03_r8, & + & 0.17000e-03_r8,0.14249e-03_r8,0.10902e-03_r8,0.38352e-04_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.18200e-03_r8,0.23294e-03_r8,0.23658e-03_r8,0.22658e-03_r8,0.20822e-03_r8, & + & 0.18391e-03_r8,0.15484e-03_r8,0.11888e-03_r8,0.42700e-04_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.19811e-03_r8,0.25094e-03_r8,0.25385e-03_r8,0.24276e-03_r8,0.22338e-03_r8, & + & 0.19841e-03_r8,0.16822e-03_r8,0.12943e-03_r8,0.47257e-04_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.21352e-03_r8,0.26784e-03_r8,0.27027e-03_r8,0.25917e-03_r8,0.23966e-03_r8, & + & 0.21399e-03_r8,0.18239e-03_r8,0.14058e-03_r8,0.51997e-04_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.12070e-03_r8,0.16282e-03_r8,0.16870e-03_r8,0.16215e-03_r8,0.14966e-03_r8, & + & 0.13195e-03_r8,0.11003e-03_r8,0.83743e-04_r8,0.26841e-04_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.13616e-03_r8,0.17979e-03_r8,0.18420e-03_r8,0.17692e-03_r8,0.16288e-03_r8, & + & 0.14351e-03_r8,0.12000e-03_r8,0.91324e-04_r8,0.29956e-04_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.15142e-03_r8,0.19606e-03_r8,0.19933e-03_r8,0.19132e-03_r8,0.17582e-03_r8, & + & 0.15506e-03_r8,0.13061e-03_r8,0.99881e-04_r8,0.33175e-04_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.16591e-03_r8,0.21170e-03_r8,0.21421e-03_r8,0.20525e-03_r8,0.18888e-03_r8, & + & 0.16747e-03_r8,0.14192e-03_r8,0.10907e-03_r8,0.36625e-04_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.17956e-03_r8,0.22655e-03_r8,0.22833e-03_r8,0.21949e-03_r8,0.20283e-03_r8, & + & 0.18086e-03_r8,0.15393e-03_r8,0.11865e-03_r8,0.40513e-04_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.98625e-04_r8,0.13480e-03_r8,0.14099e-03_r8,0.13653e-03_r8,0.12600e-03_r8, & + & 0.11107e-03_r8,0.92102e-04_r8,0.69414e-04_r8,0.22597e-04_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.11165e-03_r8,0.14975e-03_r8,0.15429e-03_r8,0.14886e-03_r8,0.13710e-03_r8, & + & 0.12076e-03_r8,0.10051e-03_r8,0.76046e-04_r8,0.25265e-04_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.12461e-03_r8,0.16391e-03_r8,0.16725e-03_r8,0.16091e-03_r8,0.14796e-03_r8, & + & 0.13047e-03_r8,0.10941e-03_r8,0.83193e-04_r8,0.27962e-04_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.13738e-03_r8,0.17761e-03_r8,0.17982e-03_r8,0.17281e-03_r8,0.15916e-03_r8, & + & 0.14087e-03_r8,0.11892e-03_r8,0.90972e-04_r8,0.30855e-04_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.14967e-03_r8,0.19066e-03_r8,0.19231e-03_r8,0.18509e-03_r8,0.17109e-03_r8, & + & 0.15227e-03_r8,0.12906e-03_r8,0.99136e-04_r8,0.34017e-04_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.79863e-04_r8,0.11034e-03_r8,0.11622e-03_r8,0.11400e-03_r8,0.10532e-03_r8, & + & 0.92978e-04_r8,0.76661e-04_r8,0.57287e-04_r8,0.18664e-04_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.90753e-04_r8,0.12318e-03_r8,0.12766e-03_r8,0.12440e-03_r8,0.11482e-03_r8, & + & 0.10110e-03_r8,0.83697e-04_r8,0.62663e-04_r8,0.20928e-04_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.10183e-03_r8,0.13532e-03_r8,0.13907e-03_r8,0.13464e-03_r8,0.12396e-03_r8, & + & 0.10925e-03_r8,0.90984e-04_r8,0.68513e-04_r8,0.23264e-04_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.11293e-03_r8,0.14742e-03_r8,0.14995e-03_r8,0.14481e-03_r8,0.13354e-03_r8, & + & 0.11797e-03_r8,0.98845e-04_r8,0.74965e-04_r8,0.25850e-04_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.12360e-03_r8,0.15914e-03_r8,0.16090e-03_r8,0.15521e-03_r8,0.14361e-03_r8, & + & 0.12755e-03_r8,0.10739e-03_r8,0.81915e-04_r8,0.28635e-04_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.65679e-04_r8,0.90084e-04_r8,0.95681e-04_r8,0.94567e-04_r8,0.87338e-04_r8, & + & 0.77275e-04_r8,0.63642e-04_r8,0.47097e-04_r8,0.15508e-04_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.74551e-04_r8,0.10089e-03_r8,0.10531e-03_r8,0.10327e-03_r8,0.95364e-04_r8, & + & 0.84154e-04_r8,0.69569e-04_r8,0.51426e-04_r8,0.17234e-04_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.83584e-04_r8,0.11137e-03_r8,0.11469e-03_r8,0.11193e-03_r8,0.10325e-03_r8, & + & 0.91075e-04_r8,0.75479e-04_r8,0.56228e-04_r8,0.19127e-04_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.92762e-04_r8,0.12171e-03_r8,0.12420e-03_r8,0.12060e-03_r8,0.11147e-03_r8, & + & 0.98465e-04_r8,0.81969e-04_r8,0.61529e-04_r8,0.21452e-04_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.10189e-03_r8,0.13182e-03_r8,0.13364e-03_r8,0.12960e-03_r8,0.12008e-03_r8, & + & 0.10652e-03_r8,0.89045e-04_r8,0.67334e-04_r8,0.23711e-04_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.53656e-04_r8,0.74109e-04_r8,0.78629e-04_r8,0.78245e-04_r8,0.72322e-04_r8, & + & 0.63915e-04_r8,0.52625e-04_r8,0.38591e-04_r8,0.14416e-04_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.61163e-04_r8,0.83104e-04_r8,0.86832e-04_r8,0.85562e-04_r8,0.78992e-04_r8, & + & 0.69666e-04_r8,0.57574e-04_r8,0.42098e-04_r8,0.15921e-04_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.68914e-04_r8,0.91909e-04_r8,0.94594e-04_r8,0.92816e-04_r8,0.85590e-04_r8, & + & 0.75491e-04_r8,0.62445e-04_r8,0.46109e-04_r8,0.17209e-04_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.76847e-04_r8,0.10059e-03_r8,0.10256e-03_r8,0.10019e-03_r8,0.92496e-04_r8, & + & 0.81729e-04_r8,0.67763e-04_r8,0.50445e-04_r8,0.18589e-04_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.84847e-04_r8,0.10902e-03_r8,0.11071e-03_r8,0.10784e-03_r8,0.99812e-04_r8, & + & 0.88516e-04_r8,0.73718e-04_r8,0.55250e-04_r8,0.20194e-04_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.43346e-04_r8,0.60608e-04_r8,0.64818e-04_r8,0.64681e-04_r8,0.59655e-04_r8, & + & 0.52617e-04_r8,0.43206e-04_r8,0.31573e-04_r8,0.14696e-04_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.49669e-04_r8,0.68380e-04_r8,0.71800e-04_r8,0.70860e-04_r8,0.65260e-04_r8, & + & 0.57496e-04_r8,0.47313e-04_r8,0.34405e-04_r8,0.16164e-04_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.56274e-04_r8,0.76040e-04_r8,0.78454e-04_r8,0.76944e-04_r8,0.70665e-04_r8, & + & 0.62347e-04_r8,0.51383e-04_r8,0.37665e-04_r8,0.17841e-04_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.63127e-04_r8,0.83451e-04_r8,0.85178e-04_r8,0.83082e-04_r8,0.76437e-04_r8, & + & 0.67538e-04_r8,0.55797e-04_r8,0.41264e-04_r8,0.19504e-04_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.70124e-04_r8,0.90807e-04_r8,0.91960e-04_r8,0.89432e-04_r8,0.82527e-04_r8, & + & 0.73176e-04_r8,0.60668e-04_r8,0.45179e-04_r8,0.20992e-04_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.35059e-04_r8,0.49531e-04_r8,0.53376e-04_r8,0.53665e-04_r8,0.49644e-04_r8, & + & 0.43592e-04_r8,0.35609e-04_r8,0.25845e-04_r8,0.13231e-04_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.40376e-04_r8,0.56174e-04_r8,0.59502e-04_r8,0.59040e-04_r8,0.54399e-04_r8, & + & 0.47687e-04_r8,0.39007e-04_r8,0.28189e-04_r8,0.15223e-04_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.46006e-04_r8,0.62899e-04_r8,0.65214e-04_r8,0.64178e-04_r8,0.58976e-04_r8, & + & 0.51726e-04_r8,0.42386e-04_r8,0.30843e-04_r8,0.17241e-04_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.51905e-04_r8,0.69395e-04_r8,0.70988e-04_r8,0.69461e-04_r8,0.63801e-04_r8, & + & 0.56040e-04_r8,0.46059e-04_r8,0.33831e-04_r8,0.19714e-04_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.57990e-04_r8,0.75737e-04_r8,0.76826e-04_r8,0.74718e-04_r8,0.68839e-04_r8, & + & 0.60664e-04_r8,0.50105e-04_r8,0.37049e-04_r8,0.22308e-04_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.30150e-04_r8,0.42738e-04_r8,0.46011e-04_r8,0.46330e-04_r8,0.42907e-04_r8, & + & 0.37605e-04_r8,0.30702e-04_r8,0.21962e-04_r8,0.11791e-04_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.34714e-04_r8,0.48516e-04_r8,0.51120e-04_r8,0.50726e-04_r8,0.46912e-04_r8, & + & 0.41033e-04_r8,0.33505e-04_r8,0.23952e-04_r8,0.13242e-04_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.39649e-04_r8,0.54325e-04_r8,0.56146e-04_r8,0.55270e-04_r8,0.50902e-04_r8, & + & 0.44559e-04_r8,0.36351e-04_r8,0.26266e-04_r8,0.15075e-04_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.44779e-04_r8,0.59893e-04_r8,0.61166e-04_r8,0.59766e-04_r8,0.55070e-04_r8, & + & 0.48303e-04_r8,0.39491e-04_r8,0.28847e-04_r8,0.17164e-04_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.49946e-04_r8,0.65411e-04_r8,0.66256e-04_r8,0.64345e-04_r8,0.59474e-04_r8, & + & 0.52287e-04_r8,0.43003e-04_r8,0.31612e-04_r8,0.19542e-04_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.25681e-04_r8,0.36622e-04_r8,0.39428e-04_r8,0.39582e-04_r8,0.36786e-04_r8, & + & 0.32210e-04_r8,0.26270e-04_r8,0.18629e-04_r8,0.10035e-04_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.29636e-04_r8,0.41620e-04_r8,0.43701e-04_r8,0.43425e-04_r8,0.40150e-04_r8, & + & 0.35105e-04_r8,0.28637e-04_r8,0.20365e-04_r8,0.11416e-04_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.33921e-04_r8,0.46628e-04_r8,0.48062e-04_r8,0.47301e-04_r8,0.43633e-04_r8, & + & 0.38189e-04_r8,0.31133e-04_r8,0.22405e-04_r8,0.12946e-04_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.38341e-04_r8,0.51401e-04_r8,0.52457e-04_r8,0.51129e-04_r8,0.47238e-04_r8, & + & 0.41429e-04_r8,0.33905e-04_r8,0.24546e-04_r8,0.14770e-04_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.42576e-04_r8,0.56153e-04_r8,0.56863e-04_r8,0.55182e-04_r8,0.51113e-04_r8, & + & 0.44940e-04_r8,0.36987e-04_r8,0.26898e-04_r8,0.16865e-04_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.21707e-04_r8,0.31142e-04_r8,0.33487e-04_r8,0.33650e-04_r8,0.31301e-04_r8, & + & 0.27396e-04_r8,0.22352e-04_r8,0.15744e-04_r8,0.83005e-05_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.25112e-04_r8,0.35474e-04_r8,0.37158e-04_r8,0.36970e-04_r8,0.34170e-04_r8, & + & 0.29871e-04_r8,0.24361e-04_r8,0.17312e-04_r8,0.93559e-05_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.28762e-04_r8,0.39712e-04_r8,0.40924e-04_r8,0.40199e-04_r8,0.37169e-04_r8, & + & 0.32565e-04_r8,0.26566e-04_r8,0.19074e-04_r8,0.10670e-04_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.32448e-04_r8,0.43808e-04_r8,0.44734e-04_r8,0.43534e-04_r8,0.40323e-04_r8, & + & 0.35367e-04_r8,0.29011e-04_r8,0.20897e-04_r8,0.12240e-04_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.35905e-04_r8,0.47771e-04_r8,0.48482e-04_r8,0.47094e-04_r8,0.43703e-04_r8, & + & 0.38474e-04_r8,0.31715e-04_r8,0.22899e-04_r8,0.13958e-04_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.50328e-03_r8,0.59028e-03_r8,0.59973e-03_r8,0.58955e-03_r8,0.56685e-03_r8, & + & 0.50893e-03_r8,0.43098e-03_r8,0.31518e-03_r8,0.12599e-03_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.53454e-03_r8,0.62581e-03_r8,0.63729e-03_r8,0.62588e-03_r8,0.59902e-03_r8, & + & 0.54179e-03_r8,0.45928e-03_r8,0.33824e-03_r8,0.13937e-03_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.56216e-03_r8,0.66315e-03_r8,0.67707e-03_r8,0.66553e-03_r8,0.63545e-03_r8, & + & 0.57719e-03_r8,0.48913e-03_r8,0.36332e-03_r8,0.15548e-03_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.58821e-03_r8,0.70231e-03_r8,0.71934e-03_r8,0.70828e-03_r8,0.67637e-03_r8, & + & 0.61438e-03_r8,0.52042e-03_r8,0.38978e-03_r8,0.17254e-03_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.61349e-03_r8,0.74309e-03_r8,0.76503e-03_r8,0.75486e-03_r8,0.71943e-03_r8, & + & 0.65213e-03_r8,0.55331e-03_r8,0.41818e-03_r8,0.19176e-03_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.43720e-03_r8,0.51117e-03_r8,0.51919e-03_r8,0.50988e-03_r8,0.48875e-03_r8, & + & 0.44138e-03_r8,0.37418e-03_r8,0.27478e-03_r8,0.10374e-03_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.46400e-03_r8,0.54460e-03_r8,0.55429e-03_r8,0.54395e-03_r8,0.52067e-03_r8, & + & 0.47118e-03_r8,0.39949e-03_r8,0.29546e-03_r8,0.11585e-03_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.48798e-03_r8,0.57940e-03_r8,0.59177e-03_r8,0.58113e-03_r8,0.55553e-03_r8, & + & 0.50290e-03_r8,0.42588e-03_r8,0.31727e-03_r8,0.12872e-03_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.51088e-03_r8,0.61529e-03_r8,0.63115e-03_r8,0.62163e-03_r8,0.59296e-03_r8, & + & 0.53614e-03_r8,0.45317e-03_r8,0.34070e-03_r8,0.14334e-03_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.53331e-03_r8,0.65233e-03_r8,0.67270e-03_r8,0.66363e-03_r8,0.63091e-03_r8, & + & 0.57023e-03_r8,0.48253e-03_r8,0.36597e-03_r8,0.15947e-03_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.37168e-03_r8,0.43544e-03_r8,0.44351e-03_r8,0.43496e-03_r8,0.41418e-03_r8, & + & 0.37673e-03_r8,0.31849e-03_r8,0.23373e-03_r8,0.83035e-04_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.39476e-03_r8,0.46532e-03_r8,0.47527e-03_r8,0.46587e-03_r8,0.44394e-03_r8, & + & 0.40288e-03_r8,0.34052e-03_r8,0.25172e-03_r8,0.92363e-04_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.41559e-03_r8,0.49597e-03_r8,0.50880e-03_r8,0.49944e-03_r8,0.47605e-03_r8, & + & 0.43138e-03_r8,0.36384e-03_r8,0.27063e-03_r8,0.10327e-03_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.43551e-03_r8,0.52738e-03_r8,0.54357e-03_r8,0.53553e-03_r8,0.50924e-03_r8, & + & 0.46069e-03_r8,0.38844e-03_r8,0.29089e-03_r8,0.11548e-03_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.45509e-03_r8,0.56036e-03_r8,0.58045e-03_r8,0.57279e-03_r8,0.54320e-03_r8, & + & 0.49088e-03_r8,0.41461e-03_r8,0.31304e-03_r8,0.12901e-03_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.31353e-03_r8,0.36800e-03_r8,0.37478e-03_r8,0.36628e-03_r8,0.34818e-03_r8, & + & 0.31938e-03_r8,0.26882e-03_r8,0.19725e-03_r8,0.65143e-04_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.33327e-03_r8,0.39347e-03_r8,0.40240e-03_r8,0.39421e-03_r8,0.37500e-03_r8, & + & 0.34245e-03_r8,0.28782e-03_r8,0.21247e-03_r8,0.72911e-04_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.35116e-03_r8,0.41935e-03_r8,0.43125e-03_r8,0.42396e-03_r8,0.40374e-03_r8, & + & 0.36745e-03_r8,0.30851e-03_r8,0.22861e-03_r8,0.82223e-04_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.36817e-03_r8,0.44654e-03_r8,0.46141e-03_r8,0.45505e-03_r8,0.43257e-03_r8, & + & 0.39339e-03_r8,0.33051e-03_r8,0.24594e-03_r8,0.92524e-04_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.38502e-03_r8,0.47537e-03_r8,0.49387e-03_r8,0.48730e-03_r8,0.46233e-03_r8, & + & 0.42007e-03_r8,0.35374e-03_r8,0.26504e-03_r8,0.10363e-03_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.26371e-03_r8,0.30958e-03_r8,0.31480e-03_r8,0.30643e-03_r8,0.29119e-03_r8, & + & 0.26781e-03_r8,0.22601e-03_r8,0.16580e-03_r8,0.51526e-04_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.28046e-03_r8,0.33149e-03_r8,0.33831e-03_r8,0.33074e-03_r8,0.31455e-03_r8, & + & 0.28912e-03_r8,0.24254e-03_r8,0.17884e-03_r8,0.57544e-04_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.29571e-03_r8,0.35368e-03_r8,0.36281e-03_r8,0.35630e-03_r8,0.33882e-03_r8, & + & 0.31097e-03_r8,0.26070e-03_r8,0.19272e-03_r8,0.64519e-04_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.31016e-03_r8,0.37666e-03_r8,0.38893e-03_r8,0.38273e-03_r8,0.36412e-03_r8, & + & 0.33364e-03_r8,0.28016e-03_r8,0.20757e-03_r8,0.72363e-04_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.32452e-03_r8,0.40122e-03_r8,0.41666e-03_r8,0.41046e-03_r8,0.39013e-03_r8, & + & 0.35668e-03_r8,0.30056e-03_r8,0.22388e-03_r8,0.80981e-04_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.22069e-03_r8,0.25888e-03_r8,0.26323e-03_r8,0.25479e-03_r8,0.24246e-03_r8, & + & 0.22303e-03_r8,0.18865e-03_r8,0.13826e-03_r8,0.42586e-04_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.23505e-03_r8,0.27730e-03_r8,0.28289e-03_r8,0.27510e-03_r8,0.26179e-03_r8, & + & 0.24147e-03_r8,0.20303e-03_r8,0.14956e-03_r8,0.47728e-04_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.24799e-03_r8,0.29644e-03_r8,0.30324e-03_r8,0.29696e-03_r8,0.28190e-03_r8, & + & 0.26059e-03_r8,0.21889e-03_r8,0.16173e-03_r8,0.53804e-04_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.26027e-03_r8,0.31607e-03_r8,0.32548e-03_r8,0.31928e-03_r8,0.30338e-03_r8, & + & 0.27984e-03_r8,0.23536e-03_r8,0.17457e-03_r8,0.60579e-04_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.27261e-03_r8,0.33682e-03_r8,0.34889e-03_r8,0.34299e-03_r8,0.32589e-03_r8, & + & 0.29875e-03_r8,0.25286e-03_r8,0.18852e-03_r8,0.67802e-04_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.18284e-03_r8,0.21563e-03_r8,0.21874e-03_r8,0.21147e-03_r8,0.20158e-03_r8, & + & 0.18535e-03_r8,0.15699e-03_r8,0.11455e-03_r8,0.35095e-04_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.19537e-03_r8,0.23122e-03_r8,0.23571e-03_r8,0.22829e-03_r8,0.21760e-03_r8, & + & 0.20013e-03_r8,0.16934e-03_r8,0.12429e-03_r8,0.39853e-04_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.20672e-03_r8,0.24731e-03_r8,0.25313e-03_r8,0.24636e-03_r8,0.23401e-03_r8, & + & 0.21622e-03_r8,0.18276e-03_r8,0.13469e-03_r8,0.45173e-04_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.21741e-03_r8,0.26399e-03_r8,0.27153e-03_r8,0.26539e-03_r8,0.25198e-03_r8, & + & 0.23212e-03_r8,0.19655e-03_r8,0.14593e-03_r8,0.50910e-04_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.22822e-03_r8,0.28170e-03_r8,0.29118e-03_r8,0.28544e-03_r8,0.27112e-03_r8, & + & 0.24842e-03_r8,0.21129e-03_r8,0.15803e-03_r8,0.57288e-04_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.15136e-03_r8,0.17854e-03_r8,0.18119e-03_r8,0.17535e-03_r8,0.16721e-03_r8, & + & 0.15392e-03_r8,0.13041e-03_r8,0.94463e-04_r8,0.29176e-04_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.16197e-03_r8,0.19183e-03_r8,0.19544e-03_r8,0.18940e-03_r8,0.18045e-03_r8, & + & 0.16606e-03_r8,0.14094e-03_r8,0.10292e-03_r8,0.33234e-04_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.17149e-03_r8,0.20540e-03_r8,0.21055e-03_r8,0.20432e-03_r8,0.19421e-03_r8, & + & 0.17914e-03_r8,0.15214e-03_r8,0.11170e-03_r8,0.37987e-04_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.18048e-03_r8,0.21966e-03_r8,0.22618e-03_r8,0.22017e-03_r8,0.20926e-03_r8, & + & 0.19215e-03_r8,0.16364e-03_r8,0.12118e-03_r8,0.43249e-04_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.18968e-03_r8,0.23496e-03_r8,0.24258e-03_r8,0.23712e-03_r8,0.22524e-03_r8, & + & 0.20589e-03_r8,0.17598e-03_r8,0.13139e-03_r8,0.48772e-04_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.12535e-03_r8,0.14733e-03_r8,0.14911e-03_r8,0.14464e-03_r8,0.13810e-03_r8, & + & 0.12766e-03_r8,0.10804e-03_r8,0.77667e-04_r8,0.31607e-04_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.13428e-03_r8,0.15826e-03_r8,0.16122e-03_r8,0.15658e-03_r8,0.14914e-03_r8, & + & 0.13752e-03_r8,0.11655e-03_r8,0.84956e-04_r8,0.35832e-04_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.14212e-03_r8,0.16949e-03_r8,0.17392e-03_r8,0.16905e-03_r8,0.16073e-03_r8, & + & 0.14802e-03_r8,0.12582e-03_r8,0.92269e-04_r8,0.39990e-04_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.14955e-03_r8,0.18151e-03_r8,0.18720e-03_r8,0.18233e-03_r8,0.17343e-03_r8, & + & 0.15845e-03_r8,0.13559e-03_r8,0.99998e-04_r8,0.44405e-04_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.15720e-03_r8,0.19441e-03_r8,0.20115e-03_r8,0.19658e-03_r8,0.18679e-03_r8, & + & 0.17045e-03_r8,0.14597e-03_r8,0.10853e-03_r8,0.48354e-04_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.10518e-03_r8,0.12283e-03_r8,0.12342e-03_r8,0.11933e-03_r8,0.11376e-03_r8, & + & 0.10615e-03_r8,0.89610e-04_r8,0.64322e-04_r8,0.38897e-04_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.11277e-03_r8,0.13167e-03_r8,0.13319e-03_r8,0.12937e-03_r8,0.12328e-03_r8, & + & 0.11434e-03_r8,0.96637e-04_r8,0.70434e-04_r8,0.44697e-04_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.11946e-03_r8,0.14071e-03_r8,0.14389e-03_r8,0.14002e-03_r8,0.13292e-03_r8, & + & 0.12246e-03_r8,0.10436e-03_r8,0.76473e-04_r8,0.50672e-04_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.12573e-03_r8,0.15045e-03_r8,0.15515e-03_r8,0.15121e-03_r8,0.14368e-03_r8, & + & 0.13136e-03_r8,0.11260e-03_r8,0.82864e-04_r8,0.56090e-04_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.13210e-03_r8,0.16128e-03_r8,0.16701e-03_r8,0.16339e-03_r8,0.15508e-03_r8, & + & 0.14154e-03_r8,0.12132e-03_r8,0.89973e-04_r8,0.61017e-04_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.90693e-04_r8,0.10606e-03_r8,0.10639e-03_r8,0.10214e-03_r8,0.97041e-04_r8, & + & 0.90929e-04_r8,0.76654e-04_r8,0.55448e-04_r8,0.34971e-04_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.96878e-04_r8,0.11346e-03_r8,0.11478e-03_r8,0.11094e-03_r8,0.10496e-03_r8, & + & 0.97427e-04_r8,0.82680e-04_r8,0.60468e-04_r8,0.41599e-04_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.10232e-03_r8,0.12125e-03_r8,0.12365e-03_r8,0.11979e-03_r8,0.11346e-03_r8, & + & 0.10430e-03_r8,0.89390e-04_r8,0.65549e-04_r8,0.48186e-04_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.10772e-03_r8,0.12969e-03_r8,0.13316e-03_r8,0.12963e-03_r8,0.12290e-03_r8, & + & 0.11234e-03_r8,0.96526e-04_r8,0.71097e-04_r8,0.54537e-04_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.11345e-03_r8,0.13912e-03_r8,0.14339e-03_r8,0.14025e-03_r8,0.13275e-03_r8, & + & 0.12106e-03_r8,0.10412e-03_r8,0.77240e-04_r8,0.60238e-04_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.77577e-04_r8,0.91005e-04_r8,0.91202e-04_r8,0.87618e-04_r8,0.82974e-04_r8, & + & 0.77488e-04_r8,0.65261e-04_r8,0.47539e-04_r8,0.30516e-04_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.82612e-04_r8,0.97349e-04_r8,0.98497e-04_r8,0.95069e-04_r8,0.89699e-04_r8, & + & 0.82714e-04_r8,0.70478e-04_r8,0.51645e-04_r8,0.35968e-04_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.87206e-04_r8,0.10402e-03_r8,0.10625e-03_r8,0.10294e-03_r8,0.97013e-04_r8, & + & 0.88723e-04_r8,0.76259e-04_r8,0.55960e-04_r8,0.41899e-04_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.91929e-04_r8,0.11153e-03_r8,0.11462e-03_r8,0.11153e-03_r8,0.10500e-03_r8, & + & 0.95633e-04_r8,0.82267e-04_r8,0.60868e-04_r8,0.48100e-04_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.97101e-04_r8,0.11996e-03_r8,0.12377e-03_r8,0.12058e-03_r8,0.11342e-03_r8, & + & 0.10316e-03_r8,0.88884e-04_r8,0.66077e-04_r8,0.53563e-04_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.65838e-04_r8,0.77620e-04_r8,0.77829e-04_r8,0.74661e-04_r8,0.70473e-04_r8, & + & 0.65575e-04_r8,0.55474e-04_r8,0.40441e-04_r8,0.25521e-04_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.69998e-04_r8,0.83015e-04_r8,0.84103e-04_r8,0.81066e-04_r8,0.76507e-04_r8, & + & 0.70172e-04_r8,0.59914e-04_r8,0.43882e-04_r8,0.30126e-04_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.74003e-04_r8,0.88878e-04_r8,0.90840e-04_r8,0.88139e-04_r8,0.82951e-04_r8, & + & 0.75471e-04_r8,0.64689e-04_r8,0.47652e-04_r8,0.35171e-04_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.78234e-04_r8,0.95561e-04_r8,0.98237e-04_r8,0.95653e-04_r8,0.89770e-04_r8, & + & 0.81434e-04_r8,0.69913e-04_r8,0.51882e-04_r8,0.40221e-04_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.82825e-04_r8,0.10313e-03_r8,0.10644e-03_r8,0.10352e-03_r8,0.97040e-04_r8, & + & 0.87602e-04_r8,0.75532e-04_r8,0.56387e-04_r8,0.44675e-04_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.10615e-02_r8,0.12529e-02_r8,0.13083e-02_r8,0.12764e-02_r8,0.11881e-02_r8, & + & 0.10853e-02_r8,0.93421e-03_r8,0.71644e-03_r8,0.30757e-03_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.10918e-02_r8,0.13136e-02_r8,0.13677e-02_r8,0.13350e-02_r8,0.12522e-02_r8, & + & 0.11402e-02_r8,0.98392e-03_r8,0.76040e-03_r8,0.35125e-03_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.11297e-02_r8,0.13742e-02_r8,0.14266e-02_r8,0.13956e-02_r8,0.13143e-02_r8, & + & 0.11951e-02_r8,0.10359e-02_r8,0.81032e-03_r8,0.39829e-03_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.11716e-02_r8,0.14330e-02_r8,0.14865e-02_r8,0.14580e-02_r8,0.13738e-02_r8, & + & 0.12536e-02_r8,0.10931e-02_r8,0.86605e-03_r8,0.44907e-03_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.12137e-02_r8,0.14919e-02_r8,0.15477e-02_r8,0.15196e-02_r8,0.14358e-02_r8, & + & 0.13166e-02_r8,0.11546e-02_r8,0.92748e-03_r8,0.50593e-03_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.92435e-03_r8,0.10874e-02_r8,0.11275e-02_r8,0.11015e-02_r8,0.10311e-02_r8, & + & 0.94231e-03_r8,0.80960e-03_r8,0.63033e-03_r8,0.26663e-03_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.95885e-03_r8,0.11428e-02_r8,0.11829e-02_r8,0.11541e-02_r8,0.10849e-02_r8, & + & 0.98930e-03_r8,0.85567e-03_r8,0.67200e-03_r8,0.30230e-03_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.99776e-03_r8,0.11978e-02_r8,0.12376e-02_r8,0.12093e-02_r8,0.11390e-02_r8, & + & 0.10392e-02_r8,0.90558e-03_r8,0.71833e-03_r8,0.34245e-03_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.10380e-02_r8,0.12537e-02_r8,0.12935e-02_r8,0.12652e-02_r8,0.11933e-02_r8, & + & 0.10921e-02_r8,0.95939e-03_r8,0.76948e-03_r8,0.38641e-03_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.10779e-02_r8,0.13105e-02_r8,0.13515e-02_r8,0.13214e-02_r8,0.12497e-02_r8, & + & 0.11514e-02_r8,0.10182e-02_r8,0.82552e-03_r8,0.43428e-03_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.79958e-03_r8,0.93053e-03_r8,0.95669e-03_r8,0.93720e-03_r8,0.88165e-03_r8, & + & 0.80178e-03_r8,0.69131e-03_r8,0.54027e-03_r8,0.22082e-03_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.83354e-03_r8,0.98064e-03_r8,0.10079e-02_r8,0.98484e-03_r8,0.92834e-03_r8, & + & 0.84387e-03_r8,0.73304e-03_r8,0.57932e-03_r8,0.25149e-03_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.87012e-03_r8,0.10320e-02_r8,0.10600e-02_r8,0.10346e-02_r8,0.97491e-03_r8, & + & 0.88683e-03_r8,0.77649e-03_r8,0.62208e-03_r8,0.28527e-03_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.90759e-03_r8,0.10841e-02_r8,0.11129e-02_r8,0.10858e-02_r8,0.10238e-02_r8, & + & 0.93520e-03_r8,0.82494e-03_r8,0.66854e-03_r8,0.32199e-03_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.94443e-03_r8,0.11378e-02_r8,0.11668e-02_r8,0.11369e-02_r8,0.10746e-02_r8, & + & 0.98835e-03_r8,0.87764e-03_r8,0.71868e-03_r8,0.36165e-03_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.68628e-03_r8,0.79104e-03_r8,0.80863e-03_r8,0.79421e-03_r8,0.74681e-03_r8, & + & 0.67391e-03_r8,0.58210e-03_r8,0.45790e-03_r8,0.18137e-03_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.71790e-03_r8,0.83686e-03_r8,0.85591e-03_r8,0.83705e-03_r8,0.78808e-03_r8, & + & 0.71172e-03_r8,0.61822e-03_r8,0.49245e-03_r8,0.20729e-03_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.75117e-03_r8,0.88426e-03_r8,0.90462e-03_r8,0.88167e-03_r8,0.82945e-03_r8, & + & 0.75050e-03_r8,0.65652e-03_r8,0.53019e-03_r8,0.23455e-03_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.78430e-03_r8,0.93252e-03_r8,0.95418e-03_r8,0.92872e-03_r8,0.87301e-03_r8, & + & 0.79337e-03_r8,0.69871e-03_r8,0.57160e-03_r8,0.26520e-03_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.81683e-03_r8,0.98168e-03_r8,0.10045e-02_r8,0.97638e-03_r8,0.92000e-03_r8, & + & 0.84034e-03_r8,0.74480e-03_r8,0.61518e-03_r8,0.29808e-03_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.58497e-03_r8,0.66935e-03_r8,0.68301e-03_r8,0.66951e-03_r8,0.62962e-03_r8, & + & 0.56579e-03_r8,0.48826e-03_r8,0.38379e-03_r8,0.14576e-03_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.61310e-03_r8,0.71031e-03_r8,0.72592e-03_r8,0.70978e-03_r8,0.66652e-03_r8, & + & 0.59753e-03_r8,0.51826e-03_r8,0.41385e-03_r8,0.16772e-03_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.64179e-03_r8,0.75306e-03_r8,0.77095e-03_r8,0.75074e-03_r8,0.70458e-03_r8, & + & 0.63276e-03_r8,0.55157e-03_r8,0.44695e-03_r8,0.19067e-03_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.67039e-03_r8,0.79634e-03_r8,0.81655e-03_r8,0.79420e-03_r8,0.74416e-03_r8, & + & 0.67043e-03_r8,0.58781e-03_r8,0.48223e-03_r8,0.21651e-03_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.69870e-03_r8,0.83972e-03_r8,0.86240e-03_r8,0.83794e-03_r8,0.78674e-03_r8, & + & 0.71204e-03_r8,0.62768e-03_r8,0.51780e-03_r8,0.24414e-03_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.49594e-03_r8,0.56319e-03_r8,0.57248e-03_r8,0.55950e-03_r8,0.52657e-03_r8, & + & 0.47274e-03_r8,0.40631e-03_r8,0.31914e-03_r8,0.11737e-03_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.51946e-03_r8,0.59932e-03_r8,0.61091e-03_r8,0.59626e-03_r8,0.56011e-03_r8, & + & 0.50076e-03_r8,0.43158e-03_r8,0.34422e-03_r8,0.13452e-03_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.54355e-03_r8,0.63601e-03_r8,0.65111e-03_r8,0.63466e-03_r8,0.59552e-03_r8, & + & 0.53122e-03_r8,0.45996e-03_r8,0.37172e-03_r8,0.15179e-03_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.56762e-03_r8,0.67321e-03_r8,0.69130e-03_r8,0.67433e-03_r8,0.63164e-03_r8, & + & 0.56508e-03_r8,0.49145e-03_r8,0.39979e-03_r8,0.17118e-03_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.59180e-03_r8,0.71065e-03_r8,0.73195e-03_r8,0.71355e-03_r8,0.66898e-03_r8, & + & 0.60268e-03_r8,0.52617e-03_r8,0.43141e-03_r8,0.19263e-03_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.41932e-03_r8,0.47346e-03_r8,0.47850e-03_r8,0.46519e-03_r8,0.43628e-03_r8, & + & 0.39132e-03_r8,0.33641e-03_r8,0.26485e-03_r8,0.10000e-03_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.43848e-03_r8,0.50411e-03_r8,0.51171e-03_r8,0.49803e-03_r8,0.46737e-03_r8, & + & 0.41801e-03_r8,0.35878e-03_r8,0.28532e-03_r8,0.11408e-03_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.45836e-03_r8,0.53506e-03_r8,0.54578e-03_r8,0.53230e-03_r8,0.49970e-03_r8, & + & 0.44506e-03_r8,0.38306e-03_r8,0.30828e-03_r8,0.13001e-03_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.47855e-03_r8,0.56639e-03_r8,0.58020e-03_r8,0.56722e-03_r8,0.53202e-03_r8, & + & 0.47546e-03_r8,0.41064e-03_r8,0.33104e-03_r8,0.14676e-03_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.49885e-03_r8,0.59805e-03_r8,0.61555e-03_r8,0.60152e-03_r8,0.56466e-03_r8, & + & 0.50884e-03_r8,0.44071e-03_r8,0.35766e-03_r8,0.16471e-03_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.35434e-03_r8,0.39784e-03_r8,0.40003e-03_r8,0.38643e-03_r8,0.36029e-03_r8, & + & 0.32228e-03_r8,0.27705e-03_r8,0.21936e-03_r8,0.85304e-04_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.36972e-03_r8,0.42325e-03_r8,0.42802e-03_r8,0.41467e-03_r8,0.38745e-03_r8, & + & 0.34637e-03_r8,0.29590e-03_r8,0.23622e-03_r8,0.97535e-04_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.38589e-03_r8,0.44905e-03_r8,0.45611e-03_r8,0.44402e-03_r8,0.41681e-03_r8, & + & 0.37125e-03_r8,0.31793e-03_r8,0.25523e-03_r8,0.11156e-03_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.40282e-03_r8,0.47505e-03_r8,0.48489e-03_r8,0.47391e-03_r8,0.44440e-03_r8, & + & 0.39797e-03_r8,0.34220e-03_r8,0.27395e-03_r8,0.12650e-03_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.41971e-03_r8,0.50175e-03_r8,0.51511e-03_r8,0.50365e-03_r8,0.47246e-03_r8, & + & 0.42646e-03_r8,0.36852e-03_r8,0.29705e-03_r8,0.14272e-03_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.29829e-03_r8,0.33364e-03_r8,0.33392e-03_r8,0.32092e-03_r8,0.29738e-03_r8, & + & 0.26469e-03_r8,0.22642e-03_r8,0.18017e-03_r8,0.77064e-04_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.31054e-03_r8,0.35463e-03_r8,0.35704e-03_r8,0.34432e-03_r8,0.32083e-03_r8, & + & 0.28575e-03_r8,0.24402e-03_r8,0.19441e-03_r8,0.87743e-04_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.32389e-03_r8,0.37581e-03_r8,0.38023e-03_r8,0.36873e-03_r8,0.34562e-03_r8, & + & 0.30799e-03_r8,0.26274e-03_r8,0.21037e-03_r8,0.99662e-04_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.33808e-03_r8,0.39748e-03_r8,0.40404e-03_r8,0.39387e-03_r8,0.36968e-03_r8, & + & 0.33141e-03_r8,0.28405e-03_r8,0.22647e-03_r8,0.11282e-03_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.35231e-03_r8,0.41983e-03_r8,0.42961e-03_r8,0.41951e-03_r8,0.39352e-03_r8, & + & 0.35528e-03_r8,0.30599e-03_r8,0.24648e-03_r8,0.12841e-03_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.25036e-03_r8,0.27999e-03_r8,0.27949e-03_r8,0.26793e-03_r8,0.24735e-03_r8, & + & 0.21800e-03_r8,0.18604e-03_r8,0.14807e-03_r8,0.93146e-04_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.26009e-03_r8,0.29745e-03_r8,0.29870e-03_r8,0.28727e-03_r8,0.26656e-03_r8, & + & 0.23674e-03_r8,0.20160e-03_r8,0.16012e-03_r8,0.10408e-03_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.27084e-03_r8,0.31508e-03_r8,0.31779e-03_r8,0.30720e-03_r8,0.28751e-03_r8, & + & 0.25636e-03_r8,0.21818e-03_r8,0.17357e-03_r8,0.11611e-03_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.28251e-03_r8,0.33335e-03_r8,0.33759e-03_r8,0.32814e-03_r8,0.30785e-03_r8, & + & 0.27625e-03_r8,0.23573e-03_r8,0.18761e-03_r8,0.12959e-03_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.29455e-03_r8,0.35211e-03_r8,0.35903e-03_r8,0.34997e-03_r8,0.32871e-03_r8, & + & 0.29658e-03_r8,0.25454e-03_r8,0.20476e-03_r8,0.14404e-03_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.21327e-03_r8,0.24042e-03_r8,0.24026e-03_r8,0.23068e-03_r8,0.21276e-03_r8, & + & 0.18665e-03_r8,0.15901e-03_r8,0.12570e-03_r8,0.94295e-04_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.22127e-03_r8,0.25493e-03_r8,0.25609e-03_r8,0.24693e-03_r8,0.22931e-03_r8, & + & 0.20329e-03_r8,0.17265e-03_r8,0.13686e-03_r8,0.10535e-03_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.23042e-03_r8,0.26962e-03_r8,0.27233e-03_r8,0.26383e-03_r8,0.24677e-03_r8, & + & 0.22030e-03_r8,0.18718e-03_r8,0.14788e-03_r8,0.11369e-03_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.24025e-03_r8,0.28500e-03_r8,0.28961e-03_r8,0.28171e-03_r8,0.26402e-03_r8, & + & 0.23726e-03_r8,0.20232e-03_r8,0.16110e-03_r8,0.12526e-03_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.25035e-03_r8,0.30139e-03_r8,0.30818e-03_r8,0.30033e-03_r8,0.28246e-03_r8, & + & 0.25541e-03_r8,0.21869e-03_r8,0.17592e-03_r8,0.13806e-03_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.18213e-03_r8,0.20563e-03_r8,0.20558e-03_r8,0.19744e-03_r8,0.18197e-03_r8, & + & 0.15967e-03_r8,0.13562e-03_r8,0.10709e-03_r8,0.84300e-04_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.18873e-03_r8,0.21755e-03_r8,0.21877e-03_r8,0.21098e-03_r8,0.19617e-03_r8, & + & 0.17419e-03_r8,0.14735e-03_r8,0.11726e-03_r8,0.96090e-04_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.19633e-03_r8,0.22994e-03_r8,0.23250e-03_r8,0.22538e-03_r8,0.21092e-03_r8, & + & 0.18881e-03_r8,0.15987e-03_r8,0.12650e-03_r8,0.10477e-03_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.20445e-03_r8,0.24309e-03_r8,0.24729e-03_r8,0.24084e-03_r8,0.22613e-03_r8, & + & 0.20371e-03_r8,0.17330e-03_r8,0.13785e-03_r8,0.11268e-03_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.21299e-03_r8,0.25719e-03_r8,0.26315e-03_r8,0.25711e-03_r8,0.24260e-03_r8, & + & 0.21944e-03_r8,0.18764e-03_r8,0.15038e-03_r8,0.12367e-03_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.15527e-03_r8,0.17641e-03_r8,0.17566e-03_r8,0.16836e-03_r8,0.15534e-03_r8, & + & 0.13636e-03_r8,0.11530e-03_r8,0.91307e-04_r8,0.70205e-04_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.16096e-03_r8,0.18612e-03_r8,0.18657e-03_r8,0.17973e-03_r8,0.16702e-03_r8, & + & 0.14851e-03_r8,0.12550e-03_r8,0.99145e-04_r8,0.79984e-04_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.16748e-03_r8,0.19648e-03_r8,0.19822e-03_r8,0.19209e-03_r8,0.17957e-03_r8, & + & 0.16107e-03_r8,0.13652e-03_r8,0.10753e-03_r8,0.86067e-04_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.17450e-03_r8,0.20751e-03_r8,0.21098e-03_r8,0.20534e-03_r8,0.19295e-03_r8, & + & 0.17420e-03_r8,0.14816e-03_r8,0.11772e-03_r8,0.93252e-04_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.18233e-03_r8,0.21950e-03_r8,0.22442e-03_r8,0.21958e-03_r8,0.20754e-03_r8, & + & 0.18842e-03_r8,0.16097e-03_r8,0.12851e-03_r8,0.10278e-03_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.23852e-02_r8,0.24955e-02_r8,0.25247e-02_r8,0.24784e-02_r8,0.23525e-02_r8, & + & 0.21437e-02_r8,0.18704e-02_r8,0.15353e-02_r8,0.99116e-03_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.23950e-02_r8,0.25560e-02_r8,0.26150e-02_r8,0.25851e-02_r8,0.24612e-02_r8, & + & 0.22632e-02_r8,0.20004e-02_r8,0.16585e-02_r8,0.11087e-02_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.24020e-02_r8,0.26226e-02_r8,0.27112e-02_r8,0.26940e-02_r8,0.25772e-02_r8, & + & 0.23915e-02_r8,0.21332e-02_r8,0.17859e-02_r8,0.12435e-02_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.24093e-02_r8,0.26930e-02_r8,0.28096e-02_r8,0.28038e-02_r8,0.27017e-02_r8, & + & 0.25227e-02_r8,0.22696e-02_r8,0.19198e-02_r8,0.13912e-02_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.24224e-02_r8,0.27647e-02_r8,0.29093e-02_r8,0.29173e-02_r8,0.28299e-02_r8, & + & 0.26579e-02_r8,0.24103e-02_r8,0.20612e-02_r8,0.15535e-02_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.20974e-02_r8,0.22118e-02_r8,0.22296e-02_r8,0.21778e-02_r8,0.20625e-02_r8, & + & 0.18815e-02_r8,0.16530e-02_r8,0.13562e-02_r8,0.82141e-03_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.21046e-02_r8,0.22702e-02_r8,0.23143e-02_r8,0.22813e-02_r8,0.21720e-02_r8, & + & 0.19971e-02_r8,0.17712e-02_r8,0.14678e-02_r8,0.93003e-03_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.21127e-02_r8,0.23326e-02_r8,0.24062e-02_r8,0.23885e-02_r8,0.22861e-02_r8, & + & 0.21193e-02_r8,0.18939e-02_r8,0.15834e-02_r8,0.10463e-02_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.21272e-02_r8,0.23971e-02_r8,0.25002e-02_r8,0.24977e-02_r8,0.24074e-02_r8, & + & 0.22461e-02_r8,0.20177e-02_r8,0.17030e-02_r8,0.11732e-02_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.21483e-02_r8,0.24652e-02_r8,0.25947e-02_r8,0.26138e-02_r8,0.25341e-02_r8, & + & 0.23755e-02_r8,0.21449e-02_r8,0.18299e-02_r8,0.13107e-02_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.18244e-02_r8,0.19320e-02_r8,0.19387e-02_r8,0.18795e-02_r8,0.17712e-02_r8, & + & 0.16188e-02_r8,0.14258e-02_r8,0.11664e-02_r8,0.66404e-03_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.18322e-02_r8,0.19846e-02_r8,0.20150e-02_r8,0.19741e-02_r8,0.18746e-02_r8, & + & 0.17292e-02_r8,0.15311e-02_r8,0.12668e-02_r8,0.75772e-03_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.18451e-02_r8,0.20412e-02_r8,0.20960e-02_r8,0.20746e-02_r8,0.19871e-02_r8, & + & 0.18444e-02_r8,0.16430e-02_r8,0.13711e-02_r8,0.85470e-03_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.18657e-02_r8,0.21020e-02_r8,0.21815e-02_r8,0.21798e-02_r8,0.21034e-02_r8, & + & 0.19629e-02_r8,0.17571e-02_r8,0.14786e-02_r8,0.95834e-03_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.18943e-02_r8,0.21674e-02_r8,0.22717e-02_r8,0.22915e-02_r8,0.22239e-02_r8, & + & 0.20844e-02_r8,0.18739e-02_r8,0.15906e-02_r8,0.10775e-02_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.15758e-02_r8,0.16711e-02_r8,0.16675e-02_r8,0.16043e-02_r8,0.15088e-02_r8, & + & 0.13785e-02_r8,0.12140e-02_r8,0.98780e-03_r8,0.53258e-03_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.15867e-02_r8,0.17169e-02_r8,0.17338e-02_r8,0.16891e-02_r8,0.16022e-02_r8, & + & 0.14807e-02_r8,0.13108e-02_r8,0.10774e-02_r8,0.61127e-03_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.16043e-02_r8,0.17687e-02_r8,0.18047e-02_r8,0.17788e-02_r8,0.17054e-02_r8, & + & 0.15869e-02_r8,0.14121e-02_r8,0.11700e-02_r8,0.69092e-03_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.16308e-02_r8,0.18263e-02_r8,0.18817e-02_r8,0.18741e-02_r8,0.18139e-02_r8, & + & 0.16955e-02_r8,0.15162e-02_r8,0.12673e-02_r8,0.77859e-03_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.16631e-02_r8,0.18894e-02_r8,0.19653e-02_r8,0.19764e-02_r8,0.19240e-02_r8, & + & 0.18069e-02_r8,0.16237e-02_r8,0.13697e-02_r8,0.87657e-03_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.13575e-02_r8,0.14376e-02_r8,0.14238e-02_r8,0.13660e-02_r8,0.12806e-02_r8, & + & 0.11664e-02_r8,0.10231e-02_r8,0.82794e-03_r8,0.42595e-03_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.13711e-02_r8,0.14787e-02_r8,0.14807e-02_r8,0.14369e-02_r8,0.13637e-02_r8, & + & 0.12570e-02_r8,0.11125e-02_r8,0.90729e-03_r8,0.48990e-03_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.13932e-02_r8,0.15262e-02_r8,0.15434e-02_r8,0.15158e-02_r8,0.14536e-02_r8, & + & 0.13534e-02_r8,0.12033e-02_r8,0.99132e-03_r8,0.55848e-03_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.14217e-02_r8,0.15804e-02_r8,0.16130e-02_r8,0.16009e-02_r8,0.15482e-02_r8, & + & 0.14537e-02_r8,0.12991e-02_r8,0.10796e-02_r8,0.63246e-03_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.14548e-02_r8,0.16406e-02_r8,0.16899e-02_r8,0.16924e-02_r8,0.16473e-02_r8, & + & 0.15538e-02_r8,0.13988e-02_r8,0.11736e-02_r8,0.71422e-03_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.11657e-02_r8,0.12310e-02_r8,0.12114e-02_r8,0.11593e-02_r8,0.10807e-02_r8, & + & 0.97870e-03_r8,0.85220e-03_r8,0.68679e-03_r8,0.33278e-03_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.11817e-02_r8,0.12689e-02_r8,0.12606e-02_r8,0.12200e-02_r8,0.11515e-02_r8, & + & 0.10575e-02_r8,0.93300e-03_r8,0.75653e-03_r8,0.38390e-03_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.12052e-02_r8,0.13132e-02_r8,0.13166e-02_r8,0.12868e-02_r8,0.12281e-02_r8, & + & 0.11419e-02_r8,0.10150e-02_r8,0.83054e-03_r8,0.44291e-03_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.12337e-02_r8,0.13638e-02_r8,0.13800e-02_r8,0.13608e-02_r8,0.13105e-02_r8, & + & 0.12294e-02_r8,0.11010e-02_r8,0.91218e-03_r8,0.50714e-03_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.12657e-02_r8,0.14200e-02_r8,0.14498e-02_r8,0.14421e-02_r8,0.13994e-02_r8, & + & 0.13201e-02_r8,0.11915e-02_r8,0.99447e-03_r8,0.57759e-03_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.99495e-03_r8,0.10489e-02_r8,0.10293e-02_r8,0.98184e-03_r8,0.91156e-03_r8, & + & 0.82083e-03_r8,0.70758e-03_r8,0.56387e-03_r8,0.26025e-03_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.10122e-02_r8,0.10837e-02_r8,0.10724e-02_r8,0.10344e-02_r8,0.96982e-03_r8, & + & 0.88589e-03_r8,0.77530e-03_r8,0.62605e-03_r8,0.29914e-03_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.10351e-02_r8,0.11253e-02_r8,0.11236e-02_r8,0.10922e-02_r8,0.10352e-02_r8, & + & 0.95724e-03_r8,0.84889e-03_r8,0.69076e-03_r8,0.34305e-03_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.10622e-02_r8,0.11721e-02_r8,0.11813e-02_r8,0.11564e-02_r8,0.11065e-02_r8, & + & 0.10331e-02_r8,0.92494e-03_r8,0.76297e-03_r8,0.39175e-03_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.10903e-02_r8,0.12244e-02_r8,0.12441e-02_r8,0.12287e-02_r8,0.11845e-02_r8, & + & 0.11129e-02_r8,0.10035e-02_r8,0.83648e-03_r8,0.44712e-03_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.84532e-03_r8,0.88892e-03_r8,0.86965e-03_r8,0.82727e-03_r8,0.76674e-03_r8, & + & 0.68807e-03_r8,0.58679e-03_r8,0.46179e-03_r8,0.21931e-03_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.86227e-03_r8,0.92051e-03_r8,0.90826e-03_r8,0.87315e-03_r8,0.81675e-03_r8, & + & 0.74173e-03_r8,0.64502e-03_r8,0.51436e-03_r8,0.25538e-03_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.88387e-03_r8,0.95827e-03_r8,0.95473e-03_r8,0.92480e-03_r8,0.87135e-03_r8, & + & 0.80090e-03_r8,0.70594e-03_r8,0.57141e-03_r8,0.29275e-03_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.90659e-03_r8,0.10014e-02_r8,0.10072e-02_r8,0.98186e-03_r8,0.93348e-03_r8, & + & 0.86582e-03_r8,0.77148e-03_r8,0.63431e-03_r8,0.33522e-03_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.93066e-03_r8,0.10477e-02_r8,0.10640e-02_r8,0.10456e-02_r8,0.10022e-02_r8, & + & 0.93597e-03_r8,0.84005e-03_r8,0.69831e-03_r8,0.38214e-03_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.71681e-03_r8,0.75151e-03_r8,0.73165e-03_r8,0.69303e-03_r8,0.64106e-03_r8, & + & 0.57326e-03_r8,0.48762e-03_r8,0.37724e-03_r8,0.19963e-03_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.73278e-03_r8,0.77936e-03_r8,0.76580e-03_r8,0.73272e-03_r8,0.68369e-03_r8, & + & 0.61851e-03_r8,0.53463e-03_r8,0.42190e-03_r8,0.23258e-03_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.75147e-03_r8,0.81327e-03_r8,0.80692e-03_r8,0.77827e-03_r8,0.73101e-03_r8, & + & 0.66869e-03_r8,0.58582e-03_r8,0.47030e-03_r8,0.26770e-03_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.77011e-03_r8,0.85035e-03_r8,0.85331e-03_r8,0.82912e-03_r8,0.78414e-03_r8, & + & 0.72425e-03_r8,0.64047e-03_r8,0.52434e-03_r8,0.30603e-03_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.79031e-03_r8,0.89033e-03_r8,0.90223e-03_r8,0.88462e-03_r8,0.84489e-03_r8, & + & 0.78478e-03_r8,0.70032e-03_r8,0.57826e-03_r8,0.34848e-03_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.60860e-03_r8,0.63631e-03_r8,0.61722e-03_r8,0.58182e-03_r8,0.53631e-03_r8, & + & 0.47875e-03_r8,0.40598e-03_r8,0.31001e-03_r8,0.21716e-03_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.62300e-03_r8,0.66096e-03_r8,0.64723e-03_r8,0.61624e-03_r8,0.57283e-03_r8, & + & 0.51614e-03_r8,0.44515e-03_r8,0.34783e-03_r8,0.24030e-03_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.63811e-03_r8,0.69041e-03_r8,0.68320e-03_r8,0.65609e-03_r8,0.61386e-03_r8, & + & 0.55902e-03_r8,0.48770e-03_r8,0.38933e-03_r8,0.26729e-03_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.65360e-03_r8,0.72213e-03_r8,0.72254e-03_r8,0.70011e-03_r8,0.66034e-03_r8, & + & 0.60659e-03_r8,0.53507e-03_r8,0.43477e-03_r8,0.29849e-03_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.67038e-03_r8,0.75665e-03_r8,0.76418e-03_r8,0.74727e-03_r8,0.71207e-03_r8, & + & 0.65924e-03_r8,0.58660e-03_r8,0.48108e-03_r8,0.33464e-03_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.52185e-03_r8,0.54797e-03_r8,0.53190e-03_r8,0.50128e-03_r8,0.46230e-03_r8, & + & 0.41291e-03_r8,0.35086e-03_r8,0.26843e-03_r8,0.22407e-03_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.53416e-03_r8,0.57111e-03_r8,0.56029e-03_r8,0.53286e-03_r8,0.49524e-03_r8, & + & 0.44633e-03_r8,0.38530e-03_r8,0.30138e-03_r8,0.24793e-03_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.54635e-03_r8,0.59685e-03_r8,0.59183e-03_r8,0.56852e-03_r8,0.53236e-03_r8, & + & 0.48455e-03_r8,0.42287e-03_r8,0.33910e-03_r8,0.27073e-03_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.55941e-03_r8,0.62493e-03_r8,0.62582e-03_r8,0.60673e-03_r8,0.57348e-03_r8, & + & 0.52713e-03_r8,0.46523e-03_r8,0.37861e-03_r8,0.29520e-03_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.57459e-03_r8,0.65537e-03_r8,0.66217e-03_r8,0.64854e-03_r8,0.61857e-03_r8, & + & 0.57343e-03_r8,0.51159e-03_r8,0.41997e-03_r8,0.32408e-03_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.44547e-03_r8,0.47205e-03_r8,0.45856e-03_r8,0.43259e-03_r8,0.39885e-03_r8, & + & 0.35629e-03_r8,0.30273e-03_r8,0.23099e-03_r8,0.20507e-03_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.45530e-03_r8,0.49200e-03_r8,0.48355e-03_r8,0.46058e-03_r8,0.42831e-03_r8, & + & 0.38615e-03_r8,0.33301e-03_r8,0.25970e-03_r8,0.22582e-03_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.46565e-03_r8,0.51443e-03_r8,0.51077e-03_r8,0.49108e-03_r8,0.46067e-03_r8, & + & 0.41962e-03_r8,0.36657e-03_r8,0.29355e-03_r8,0.24853e-03_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.47732e-03_r8,0.53905e-03_r8,0.54027e-03_r8,0.52415e-03_r8,0.49634e-03_r8, & + & 0.45650e-03_r8,0.40422e-03_r8,0.32887e-03_r8,0.26943e-03_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.49131e-03_r8,0.56624e-03_r8,0.57259e-03_r8,0.56091e-03_r8,0.53532e-03_r8, & + & 0.49724e-03_r8,0.44494e-03_r8,0.36671e-03_r8,0.29370e-03_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.37861e-03_r8,0.40433e-03_r8,0.39425e-03_r8,0.37277e-03_r8,0.34384e-03_r8, & + & 0.30718e-03_r8,0.26082e-03_r8,0.19813e-03_r8,0.17021e-03_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.38646e-03_r8,0.42180e-03_r8,0.41569e-03_r8,0.39676e-03_r8,0.36941e-03_r8, & + & 0.33370e-03_r8,0.28746e-03_r8,0.22445e-03_r8,0.18768e-03_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.39522e-03_r8,0.44150e-03_r8,0.43928e-03_r8,0.42293e-03_r8,0.39746e-03_r8, & + & 0.36268e-03_r8,0.31709e-03_r8,0.25391e-03_r8,0.20463e-03_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.40576e-03_r8,0.46362e-03_r8,0.46497e-03_r8,0.45178e-03_r8,0.42852e-03_r8, & + & 0.39486e-03_r8,0.34992e-03_r8,0.28472e-03_r8,0.22430e-03_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.41810e-03_r8,0.48813e-03_r8,0.49424e-03_r8,0.48434e-03_r8,0.46280e-03_r8, & + & 0.43027e-03_r8,0.38540e-03_r8,0.31863e-03_r8,0.24541e-03_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.52571e-02_r8,0.51649e-02_r8,0.50998e-02_r8,0.49978e-02_r8,0.48299e-02_r8, & + & 0.45478e-02_r8,0.41071e-02_r8,0.34884e-02_r8,0.27402e-02_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.51967e-02_r8,0.52277e-02_r8,0.52437e-02_r8,0.52099e-02_r8,0.50894e-02_r8, & + & 0.48424e-02_r8,0.44165e-02_r8,0.38421e-02_r8,0.31643e-02_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.51548e-02_r8,0.53047e-02_r8,0.54023e-02_r8,0.54271e-02_r8,0.53544e-02_r8, & + & 0.51370e-02_r8,0.47457e-02_r8,0.42178e-02_r8,0.36142e-02_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.51293e-02_r8,0.53942e-02_r8,0.55672e-02_r8,0.56512e-02_r8,0.56201e-02_r8, & + & 0.54409e-02_r8,0.50927e-02_r8,0.46186e-02_r8,0.40998e-02_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.51178e-02_r8,0.54996e-02_r8,0.57406e-02_r8,0.58798e-02_r8,0.58932e-02_r8, & + & 0.57606e-02_r8,0.54613e-02_r8,0.50399e-02_r8,0.46100e-02_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.47778e-02_r8,0.47398e-02_r8,0.47115e-02_r8,0.46169e-02_r8,0.44426e-02_r8, & + & 0.41630e-02_r8,0.37511e-02_r8,0.31426e-02_r8,0.23122e-02_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.47384e-02_r8,0.48111e-02_r8,0.48532e-02_r8,0.48144e-02_r8,0.46755e-02_r8, & + & 0.44342e-02_r8,0.40397e-02_r8,0.34599e-02_r8,0.26698e-02_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.47181e-02_r8,0.49025e-02_r8,0.50071e-02_r8,0.50151e-02_r8,0.49194e-02_r8, & + & 0.47085e-02_r8,0.43402e-02_r8,0.37956e-02_r8,0.30630e-02_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.47137e-02_r8,0.50070e-02_r8,0.51691e-02_r8,0.52245e-02_r8,0.51706e-02_r8, & + & 0.49959e-02_r8,0.46583e-02_r8,0.41574e-02_r8,0.34865e-02_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.47212e-02_r8,0.51234e-02_r8,0.53397e-02_r8,0.54379e-02_r8,0.54276e-02_r8, & + & 0.52983e-02_r8,0.49978e-02_r8,0.45412e-02_r8,0.39357e-02_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.42971e-02_r8,0.42851e-02_r8,0.42729e-02_r8,0.41707e-02_r8,0.39926e-02_r8, & + & 0.37146e-02_r8,0.33264e-02_r8,0.27717e-02_r8,0.18852e-02_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.42740e-02_r8,0.43647e-02_r8,0.44079e-02_r8,0.43562e-02_r8,0.42040e-02_r8, & + & 0.39559e-02_r8,0.35908e-02_r8,0.30443e-02_r8,0.21816e-02_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.42703e-02_r8,0.44650e-02_r8,0.45616e-02_r8,0.45425e-02_r8,0.44233e-02_r8, & + & 0.42066e-02_r8,0.38676e-02_r8,0.33396e-02_r8,0.25126e-02_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.42812e-02_r8,0.45806e-02_r8,0.47230e-02_r8,0.47371e-02_r8,0.46519e-02_r8, & + & 0.44691e-02_r8,0.41620e-02_r8,0.36586e-02_r8,0.28704e-02_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.43030e-02_r8,0.47042e-02_r8,0.48922e-02_r8,0.49377e-02_r8,0.48939e-02_r8, & + & 0.47477e-02_r8,0.44742e-02_r8,0.39985e-02_r8,0.32501e-02_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.38233e-02_r8,0.38279e-02_r8,0.38143e-02_r8,0.37097e-02_r8,0.35270e-02_r8, & + & 0.32658e-02_r8,0.29019e-02_r8,0.24142e-02_r8,0.15291e-02_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.38114e-02_r8,0.39122e-02_r8,0.39475e-02_r8,0.38778e-02_r8,0.37194e-02_r8, & + & 0.34777e-02_r8,0.31357e-02_r8,0.26541e-02_r8,0.17758e-02_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.38202e-02_r8,0.40186e-02_r8,0.40970e-02_r8,0.40542e-02_r8,0.39201e-02_r8, & + & 0.37024e-02_r8,0.33826e-02_r8,0.29146e-02_r8,0.20543e-02_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.38442e-02_r8,0.41385e-02_r8,0.42569e-02_r8,0.42394e-02_r8,0.41310e-02_r8, & + & 0.39403e-02_r8,0.36479e-02_r8,0.31917e-02_r8,0.23538e-02_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.38788e-02_r8,0.42695e-02_r8,0.44229e-02_r8,0.44328e-02_r8,0.43540e-02_r8, & + & 0.41948e-02_r8,0.39317e-02_r8,0.34895e-02_r8,0.26724e-02_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.33660e-02_r8,0.33879e-02_r8,0.33669e-02_r8,0.32570e-02_r8,0.30787e-02_r8, & + & 0.28362e-02_r8,0.25094e-02_r8,0.20819e-02_r8,0.12376e-02_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.33649e-02_r8,0.34740e-02_r8,0.34949e-02_r8,0.34119e-02_r8,0.32508e-02_r8, & + & 0.30247e-02_r8,0.27121e-02_r8,0.22949e-02_r8,0.14462e-02_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.33839e-02_r8,0.35821e-02_r8,0.36398e-02_r8,0.35762e-02_r8,0.34359e-02_r8, & + & 0.32230e-02_r8,0.29317e-02_r8,0.25218e-02_r8,0.16788e-02_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.34188e-02_r8,0.37047e-02_r8,0.37932e-02_r8,0.37524e-02_r8,0.36321e-02_r8, & + & 0.34359e-02_r8,0.31677e-02_r8,0.27663e-02_r8,0.19299e-02_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.34572e-02_r8,0.38382e-02_r8,0.39563e-02_r8,0.39381e-02_r8,0.38416e-02_r8, & + & 0.36710e-02_r8,0.34185e-02_r8,0.30298e-02_r8,0.21985e-02_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.29383e-02_r8,0.29689e-02_r8,0.29375e-02_r8,0.28254e-02_r8,0.26571e-02_r8, & + & 0.24356e-02_r8,0.21491e-02_r8,0.17706e-02_r8,0.99284e-03_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.29460e-02_r8,0.30526e-02_r8,0.30576e-02_r8,0.29676e-02_r8,0.28114e-02_r8, & + & 0.25995e-02_r8,0.23244e-02_r8,0.19573e-02_r8,0.11692e-02_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.29740e-02_r8,0.31582e-02_r8,0.31942e-02_r8,0.31202e-02_r8,0.29785e-02_r8, & + & 0.27771e-02_r8,0.25160e-02_r8,0.21565e-02_r8,0.13616e-02_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.30101e-02_r8,0.32807e-02_r8,0.33417e-02_r8,0.32855e-02_r8,0.31583e-02_r8, & + & 0.29708e-02_r8,0.27234e-02_r8,0.23688e-02_r8,0.15696e-02_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.30525e-02_r8,0.34071e-02_r8,0.34999e-02_r8,0.34618e-02_r8,0.33518e-02_r8, & + & 0.31829e-02_r8,0.29437e-02_r8,0.25986e-02_r8,0.17941e-02_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.25527e-02_r8,0.25837e-02_r8,0.25415e-02_r8,0.24332e-02_r8,0.22747e-02_r8, & + & 0.20758e-02_r8,0.18231e-02_r8,0.14951e-02_r8,0.78066e-03_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.25661e-02_r8,0.26638e-02_r8,0.26497e-02_r8,0.25583e-02_r8,0.24134e-02_r8, & + & 0.22212e-02_r8,0.19774e-02_r8,0.16540e-02_r8,0.92809e-03_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.25966e-02_r8,0.27642e-02_r8,0.27764e-02_r8,0.26998e-02_r8,0.25630e-02_r8, & + & 0.23812e-02_r8,0.21449e-02_r8,0.18264e-02_r8,0.10893e-02_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.26340e-02_r8,0.28771e-02_r8,0.29165e-02_r8,0.28538e-02_r8,0.27279e-02_r8, & + & 0.25553e-02_r8,0.23260e-02_r8,0.20107e-02_r8,0.12665e-02_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.26829e-02_r8,0.29939e-02_r8,0.30639e-02_r8,0.30192e-02_r8,0.29089e-02_r8, & + & 0.27450e-02_r8,0.25219e-02_r8,0.22101e-02_r8,0.14584e-02_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.22109e-02_r8,0.22392e-02_r8,0.21909e-02_r8,0.20870e-02_r8,0.19391e-02_r8, & + & 0.17569e-02_r8,0.15368e-02_r8,0.12514e-02_r8,0.62879e-03_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.22276e-02_r8,0.23140e-02_r8,0.22874e-02_r8,0.21965e-02_r8,0.20609e-02_r8, & + & 0.18868e-02_r8,0.16711e-02_r8,0.13887e-02_r8,0.73533e-03_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.22565e-02_r8,0.24065e-02_r8,0.24031e-02_r8,0.23233e-02_r8,0.21969e-02_r8, & + & 0.20302e-02_r8,0.18188e-02_r8,0.15365e-02_r8,0.85609e-03_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.22974e-02_r8,0.25072e-02_r8,0.25290e-02_r8,0.24653e-02_r8,0.23482e-02_r8, & + & 0.21882e-02_r8,0.19777e-02_r8,0.16966e-02_r8,0.98553e-03_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.23517e-02_r8,0.26173e-02_r8,0.26619e-02_r8,0.26145e-02_r8,0.25139e-02_r8, & + & 0.23587e-02_r8,0.21497e-02_r8,0.18671e-02_r8,0.11277e-02_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.19109e-02_r8,0.19351e-02_r8,0.18847e-02_r8,0.17853e-02_r8,0.16484e-02_r8, & + & 0.14828e-02_r8,0.12861e-02_r8,0.10403e-02_r8,0.59847e-03_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.19272e-02_r8,0.20031e-02_r8,0.19691e-02_r8,0.18817e-02_r8,0.17540e-02_r8, & + & 0.15965e-02_r8,0.14036e-02_r8,0.11571e-02_r8,0.69475e-03_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.19559e-02_r8,0.20842e-02_r8,0.20709e-02_r8,0.19954e-02_r8,0.18765e-02_r8, & + & 0.17233e-02_r8,0.15331e-02_r8,0.12839e-02_r8,0.80150e-03_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.19994e-02_r8,0.21761e-02_r8,0.21815e-02_r8,0.21203e-02_r8,0.20143e-02_r8, & + & 0.18645e-02_r8,0.16732e-02_r8,0.14206e-02_r8,0.91777e-03_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.20550e-02_r8,0.22788e-02_r8,0.23027e-02_r8,0.22546e-02_r8,0.21605e-02_r8, & + & 0.20175e-02_r8,0.18247e-02_r8,0.15687e-02_r8,0.10450e-02_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.16445e-02_r8,0.16716e-02_r8,0.16238e-02_r8,0.15300e-02_r8,0.14061e-02_r8, & + & 0.12566e-02_r8,0.10807e-02_r8,0.86738e-03_r8,0.60827e-03_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.16600e-02_r8,0.17327e-02_r8,0.16984e-02_r8,0.16154e-02_r8,0.14994e-02_r8, & + & 0.13556e-02_r8,0.11827e-02_r8,0.96695e-03_r8,0.70548e-03_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.16905e-02_r8,0.18053e-02_r8,0.17869e-02_r8,0.17163e-02_r8,0.16090e-02_r8, & + & 0.14689e-02_r8,0.12961e-02_r8,0.10754e-02_r8,0.80786e-03_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.17354e-02_r8,0.18905e-02_r8,0.18865e-02_r8,0.18272e-02_r8,0.17299e-02_r8, & + & 0.15951e-02_r8,0.14192e-02_r8,0.11936e-02_r8,0.91620e-03_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.17884e-02_r8,0.19860e-02_r8,0.19977e-02_r8,0.19501e-02_r8,0.18596e-02_r8, & + & 0.17298e-02_r8,0.15525e-02_r8,0.13217e-02_r8,0.10338e-02_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.14133e-02_r8,0.14603e-02_r8,0.14202e-02_r8,0.13407e-02_r8,0.12334e-02_r8, & + & 0.11026e-02_r8,0.94643e-03_r8,0.75979e-03_r8,0.57405e-03_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.14357e-02_r8,0.15193e-02_r8,0.14916e-02_r8,0.14232e-02_r8,0.13232e-02_r8, & + & 0.11950e-02_r8,0.10392e-02_r8,0.84686e-03_r8,0.65471e-03_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.14730e-02_r8,0.15907e-02_r8,0.15765e-02_r8,0.15172e-02_r8,0.14237e-02_r8, & + & 0.12997e-02_r8,0.11424e-02_r8,0.94298e-03_r8,0.75212e-03_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.15188e-02_r8,0.16737e-02_r8,0.16734e-02_r8,0.16227e-02_r8,0.15348e-02_r8, & + & 0.14132e-02_r8,0.12544e-02_r8,0.10476e-02_r8,0.85445e-03_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.15705e-02_r8,0.17634e-02_r8,0.17799e-02_r8,0.17387e-02_r8,0.16551e-02_r8, & + & 0.15344e-02_r8,0.13744e-02_r8,0.11635e-02_r8,0.96358e-03_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.12145e-02_r8,0.12721e-02_r8,0.12387e-02_r8,0.11722e-02_r8,0.10815e-02_r8, & + & 0.96748e-03_r8,0.83052e-03_r8,0.66461e-03_r8,0.51952e-03_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.12432e-02_r8,0.13303e-02_r8,0.13076e-02_r8,0.12500e-02_r8,0.11644e-02_r8, & + & 0.10531e-02_r8,0.91410e-03_r8,0.74198e-03_r8,0.58718e-03_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.12811e-02_r8,0.13998e-02_r8,0.13897e-02_r8,0.13394e-02_r8,0.12574e-02_r8, & + & 0.11474e-02_r8,0.10067e-02_r8,0.82675e-03_r8,0.66821e-03_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.13251e-02_r8,0.14771e-02_r8,0.14813e-02_r8,0.14393e-02_r8,0.13610e-02_r8, & + & 0.12504e-02_r8,0.11057e-02_r8,0.91975e-03_r8,0.76078e-03_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.13700e-02_r8,0.15597e-02_r8,0.15807e-02_r8,0.15467e-02_r8,0.14716e-02_r8, & + & 0.13608e-02_r8,0.12138e-02_r8,0.10232e-02_r8,0.85832e-03_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.10471e-02_r8,0.11076e-02_r8,0.10790e-02_r8,0.10231e-02_r8,0.94527e-03_r8, & + & 0.84789e-03_r8,0.72861e-03_r8,0.58068e-03_r8,0.44361e-03_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.10765e-02_r8,0.11637e-02_r8,0.11461e-02_r8,0.10966e-02_r8,0.10221e-02_r8, & + & 0.92418e-03_r8,0.80364e-03_r8,0.64949e-03_r8,0.50409e-03_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.11121e-02_r8,0.12288e-02_r8,0.12232e-02_r8,0.11802e-02_r8,0.11084e-02_r8, & + & 0.10099e-02_r8,0.88562e-03_r8,0.72467e-03_r8,0.57688e-03_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.11491e-02_r8,0.12989e-02_r8,0.13080e-02_r8,0.12720e-02_r8,0.12030e-02_r8, & + & 0.11037e-02_r8,0.97404e-03_r8,0.80781e-03_r8,0.65303e-03_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.11880e-02_r8,0.13724e-02_r8,0.13975e-02_r8,0.13701e-02_r8,0.13034e-02_r8, & + & 0.12049e-02_r8,0.10715e-02_r8,0.89944e-03_r8,0.73687e-03_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.14418e-01_r8,0.13406e-01_r8,0.12605e-01_r8,0.11857e-01_r8,0.11091e-01_r8, & + & 0.10336e-01_r8,0.95691e-02_r8,0.87036e-02_r8,0.88524e-02_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.14296e-01_r8,0.13450e-01_r8,0.12870e-01_r8,0.12297e-01_r8,0.11684e-01_r8, & + & 0.11070e-01_r8,0.10452e-01_r8,0.97477e-02_r8,0.10154e-01_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.14166e-01_r8,0.13524e-01_r8,0.13158e-01_r8,0.12768e-01_r8,0.12317e-01_r8, & + & 0.11876e-01_r8,0.11397e-01_r8,0.10864e-01_r8,0.11523e-01_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.14022e-01_r8,0.13622e-01_r8,0.13487e-01_r8,0.13264e-01_r8,0.13003e-01_r8, & + & 0.12732e-01_r8,0.12371e-01_r8,0.12050e-01_r8,0.12968e-01_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.13872e-01_r8,0.13730e-01_r8,0.13820e-01_r8,0.13802e-01_r8,0.13718e-01_r8, & + & 0.13604e-01_r8,0.13373e-01_r8,0.13315e-01_r8,0.14498e-01_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.14547e-01_r8,0.13535e-01_r8,0.12726e-01_r8,0.11955e-01_r8,0.11121e-01_r8, & + & 0.10242e-01_r8,0.92998e-02_r8,0.82716e-02_r8,0.79571e-02_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.14415e-01_r8,0.13577e-01_r8,0.12984e-01_r8,0.12377e-01_r8,0.11698e-01_r8, & + & 0.10932e-01_r8,0.10129e-01_r8,0.92199e-02_r8,0.91565e-02_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.14274e-01_r8,0.13649e-01_r8,0.13264e-01_r8,0.12845e-01_r8,0.12290e-01_r8, & + & 0.11686e-01_r8,0.11026e-01_r8,0.10231e-01_r8,0.10415e-01_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.14122e-01_r8,0.13744e-01_r8,0.13589e-01_r8,0.13325e-01_r8,0.12935e-01_r8, & + & 0.12484e-01_r8,0.11950e-01_r8,0.11311e-01_r8,0.11744e-01_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.13965e-01_r8,0.13855e-01_r8,0.13924e-01_r8,0.13828e-01_r8,0.13608e-01_r8, & + & 0.13305e-01_r8,0.12905e-01_r8,0.12457e-01_r8,0.13151e-01_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.14475e-01_r8,0.13482e-01_r8,0.12654e-01_r8,0.11861e-01_r8,0.10971e-01_r8, & + & 0.99930e-02_r8,0.88735e-02_r8,0.76595e-02_r8,0.68509e-02_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.14335e-01_r8,0.13514e-01_r8,0.12906e-01_r8,0.12263e-01_r8,0.11533e-01_r8, & + & 0.10637e-01_r8,0.96386e-02_r8,0.85394e-02_r8,0.79297e-02_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.14181e-01_r8,0.13576e-01_r8,0.13177e-01_r8,0.12719e-01_r8,0.12099e-01_r8, & + & 0.11329e-01_r8,0.10466e-01_r8,0.94601e-02_r8,0.90731e-02_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.14024e-01_r8,0.13665e-01_r8,0.13491e-01_r8,0.13188e-01_r8,0.12703e-01_r8, & + & 0.12072e-01_r8,0.11323e-01_r8,0.10433e-01_r8,0.10295e-01_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.13862e-01_r8,0.13772e-01_r8,0.13824e-01_r8,0.13679e-01_r8,0.13333e-01_r8, & + & 0.12836e-01_r8,0.12214e-01_r8,0.11468e-01_r8,0.11588e-01_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.14153e-01_r8,0.13216e-01_r8,0.12406e-01_r8,0.11612e-01_r8,0.10690e-01_r8, & + & 0.96495e-02_r8,0.84088e-02_r8,0.70121e-02_r8,0.57874e-02_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.14005e-01_r8,0.13241e-01_r8,0.12647e-01_r8,0.11995e-01_r8,0.11231e-01_r8, & + & 0.10266e-01_r8,0.91127e-02_r8,0.78123e-02_r8,0.67372e-02_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.13845e-01_r8,0.13290e-01_r8,0.12907e-01_r8,0.12438e-01_r8,0.11783e-01_r8, & + & 0.10918e-01_r8,0.98730e-02_r8,0.86646e-02_r8,0.77601e-02_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.13685e-01_r8,0.13375e-01_r8,0.13206e-01_r8,0.12899e-01_r8,0.12360e-01_r8, & + & 0.11608e-01_r8,0.10665e-01_r8,0.95624e-02_r8,0.88628e-02_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.13529e-01_r8,0.13472e-01_r8,0.13531e-01_r8,0.13371e-01_r8,0.12964e-01_r8, & + & 0.12311e-01_r8,0.11491e-01_r8,0.10508e-01_r8,0.10039e-01_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.13587e-01_r8,0.12730e-01_r8,0.11973e-01_r8,0.11204e-01_r8,0.10282e-01_r8, & + & 0.92218e-02_r8,0.79316e-02_r8,0.64044e-02_r8,0.48583e-02_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.13430e-01_r8,0.12751e-01_r8,0.12205e-01_r8,0.11567e-01_r8,0.10798e-01_r8, & + & 0.98163e-02_r8,0.85810e-02_r8,0.71221e-02_r8,0.56837e-02_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.13271e-01_r8,0.12793e-01_r8,0.12448e-01_r8,0.11993e-01_r8,0.11338e-01_r8, & + & 0.10437e-01_r8,0.92786e-02_r8,0.78957e-02_r8,0.65802e-02_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.13115e-01_r8,0.12874e-01_r8,0.12735e-01_r8,0.12440e-01_r8,0.11897e-01_r8, & + & 0.11094e-01_r8,0.10003e-01_r8,0.87146e-02_r8,0.75565e-02_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.12984e-01_r8,0.12973e-01_r8,0.13053e-01_r8,0.12899e-01_r8,0.12481e-01_r8, & + & 0.11759e-01_r8,0.10765e-01_r8,0.95850e-02_r8,0.86117e-02_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.12817e-01_r8,0.12050e-01_r8,0.11369e-01_r8,0.10622e-01_r8,0.97180e-02_r8, & + & 0.86745e-02_r8,0.73942e-02_r8,0.58154e-02_r8,0.40318e-02_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.12656e-01_r8,0.12077e-01_r8,0.11582e-01_r8,0.10960e-01_r8,0.10205e-01_r8, & + & 0.92477e-02_r8,0.80000e-02_r8,0.64500e-02_r8,0.47452e-02_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.12499e-01_r8,0.12115e-01_r8,0.11810e-01_r8,0.11361e-01_r8,0.10734e-01_r8, & + & 0.98374e-02_r8,0.86412e-02_r8,0.71467e-02_r8,0.55214e-02_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.12364e-01_r8,0.12194e-01_r8,0.12081e-01_r8,0.11798e-01_r8,0.11270e-01_r8, & + & 0.10459e-01_r8,0.93144e-02_r8,0.78844e-02_r8,0.63718e-02_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.12255e-01_r8,0.12311e-01_r8,0.12390e-01_r8,0.12242e-01_r8,0.11833e-01_r8, & + & 0.11093e-01_r8,0.10016e-01_r8,0.86730e-02_r8,0.72984e-02_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.11891e-01_r8,0.11226e-01_r8,0.10633e-01_r8,0.99134e-02_r8,0.90439e-02_r8, & + & 0.80297e-02_r8,0.68136e-02_r8,0.52756e-02_r8,0.33216e-02_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.11730e-01_r8,0.11250e-01_r8,0.10822e-01_r8,0.10230e-01_r8,0.94903e-02_r8, & + & 0.85683e-02_r8,0.73765e-02_r8,0.58347e-02_r8,0.39310e-02_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.11586e-01_r8,0.11299e-01_r8,0.11036e-01_r8,0.10599e-01_r8,0.99917e-02_r8, & + & 0.91260e-02_r8,0.79645e-02_r8,0.64502e-02_r8,0.46031e-02_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.11473e-01_r8,0.11391e-01_r8,0.11290e-01_r8,0.11015e-01_r8,0.10500e-01_r8, & + & 0.97132e-02_r8,0.85920e-02_r8,0.71112e-02_r8,0.53403e-02_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.11384e-01_r8,0.11524e-01_r8,0.11598e-01_r8,0.11442e-01_r8,0.11036e-01_r8, & + & 0.10317e-01_r8,0.92441e-02_r8,0.78209e-02_r8,0.61457e-02_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.10852e-01_r8,0.10302e-01_r8,0.97896e-02_r8,0.91138e-02_r8,0.83000e-02_r8, & + & 0.73373e-02_r8,0.61956e-02_r8,0.47644e-02_r8,0.26652e-02_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.10699e-01_r8,0.10325e-01_r8,0.99631e-02_r8,0.94045e-02_r8,0.87025e-02_r8, & + & 0.78255e-02_r8,0.67137e-02_r8,0.52638e-02_r8,0.31922e-02_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.10574e-01_r8,0.10385e-01_r8,0.10163e-01_r8,0.97460e-02_r8,0.91609e-02_r8, & + & 0.83418e-02_r8,0.72560e-02_r8,0.58143e-02_r8,0.37766e-02_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.10480e-01_r8,0.10499e-01_r8,0.10413e-01_r8,0.10139e-01_r8,0.96342e-02_r8, & + & 0.88826e-02_r8,0.78405e-02_r8,0.64037e-02_r8,0.44295e-02_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.10415e-01_r8,0.10646e-01_r8,0.10720e-01_r8,0.10553e-01_r8,0.10134e-01_r8, & + & 0.94529e-02_r8,0.84471e-02_r8,0.70384e-02_r8,0.51485e-02_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.97587e-02_r8,0.93185e-02_r8,0.88694e-02_r8,0.82517e-02_r8,0.75094e-02_r8, & + & 0.66177e-02_r8,0.55658e-02_r8,0.42591e-02_r8,0.21931e-02_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.96183e-02_r8,0.93436e-02_r8,0.90329e-02_r8,0.85198e-02_r8,0.78654e-02_r8, & + & 0.70507e-02_r8,0.60316e-02_r8,0.47067e-02_r8,0.25691e-02_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.95112e-02_r8,0.94166e-02_r8,0.92325e-02_r8,0.88355e-02_r8,0.82791e-02_r8, & + & 0.75194e-02_r8,0.65208e-02_r8,0.52003e-02_r8,0.29789e-02_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.94373e-02_r8,0.95446e-02_r8,0.94815e-02_r8,0.92092e-02_r8,0.87140e-02_r8, & + & 0.80091e-02_r8,0.70556e-02_r8,0.57344e-02_r8,0.34284e-02_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.93945e-02_r8,0.97041e-02_r8,0.97866e-02_r8,0.96055e-02_r8,0.91834e-02_r8, & + & 0.85358e-02_r8,0.76199e-02_r8,0.63067e-02_r8,0.39360e-02_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.86571e-02_r8,0.83282e-02_r8,0.79327e-02_r8,0.73862e-02_r8,0.67217e-02_r8, & + & 0.59210e-02_r8,0.49777e-02_r8,0.37950e-02_r8,0.25161e-02_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.85351e-02_r8,0.83629e-02_r8,0.80910e-02_r8,0.76400e-02_r8,0.70398e-02_r8, & + & 0.63068e-02_r8,0.53903e-02_r8,0.41966e-02_r8,0.29067e-02_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.84483e-02_r8,0.84483e-02_r8,0.82944e-02_r8,0.79338e-02_r8,0.74159e-02_r8, & + & 0.67272e-02_r8,0.58285e-02_r8,0.46411e-02_r8,0.33599e-02_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.83941e-02_r8,0.85821e-02_r8,0.85440e-02_r8,0.82866e-02_r8,0.78214e-02_r8, & + & 0.71692e-02_r8,0.63103e-02_r8,0.51290e-02_r8,0.38620e-02_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.83806e-02_r8,0.87510e-02_r8,0.88459e-02_r8,0.86620e-02_r8,0.82607e-02_r8, & + & 0.76554e-02_r8,0.68267e-02_r8,0.56504e-02_r8,0.44001e-02_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.75570e-02_r8,0.73902e-02_r8,0.70826e-02_r8,0.66405e-02_r8,0.60731e-02_r8, & + & 0.53892e-02_r8,0.45656e-02_r8,0.35050e-02_r8,0.26164e-02_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.74683e-02_r8,0.74501e-02_r8,0.72578e-02_r8,0.68886e-02_r8,0.63823e-02_r8, & + & 0.57485e-02_r8,0.49402e-02_r8,0.38790e-02_r8,0.30097e-02_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.74153e-02_r8,0.75630e-02_r8,0.74762e-02_r8,0.71912e-02_r8,0.67425e-02_r8, & + & 0.61326e-02_r8,0.53447e-02_r8,0.42990e-02_r8,0.34771e-02_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.74057e-02_r8,0.77202e-02_r8,0.77477e-02_r8,0.75330e-02_r8,0.71268e-02_r8, & + & 0.65549e-02_r8,0.57951e-02_r8,0.47555e-02_r8,0.39884e-02_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.74391e-02_r8,0.79220e-02_r8,0.80561e-02_r8,0.79014e-02_r8,0.75514e-02_r8, & + & 0.70214e-02_r8,0.62779e-02_r8,0.52483e-02_r8,0.45376e-02_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.65546e-02_r8,0.65200e-02_r8,0.62910e-02_r8,0.59243e-02_r8,0.54454e-02_r8, & + & 0.48623e-02_r8,0.41386e-02_r8,0.32013e-02_r8,0.25137e-02_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.64987e-02_r8,0.66047e-02_r8,0.64774e-02_r8,0.61754e-02_r8,0.57483e-02_r8, & + & 0.51910e-02_r8,0.44799e-02_r8,0.35500e-02_r8,0.28998e-02_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.64867e-02_r8,0.67439e-02_r8,0.67077e-02_r8,0.64758e-02_r8,0.60840e-02_r8, & + & 0.55472e-02_r8,0.48582e-02_r8,0.39433e-02_r8,0.33472e-02_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.65214e-02_r8,0.69269e-02_r8,0.69913e-02_r8,0.68034e-02_r8,0.64480e-02_r8, & + & 0.59497e-02_r8,0.52811e-02_r8,0.43712e-02_r8,0.38283e-02_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.66068e-02_r8,0.71634e-02_r8,0.73032e-02_r8,0.71670e-02_r8,0.68605e-02_r8, & + & 0.63896e-02_r8,0.57387e-02_r8,0.48340e-02_r8,0.43614e-02_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.56598e-02_r8,0.57241e-02_r8,0.55653e-02_r8,0.52616e-02_r8,0.48615e-02_r8, & + & 0.43534e-02_r8,0.37143e-02_r8,0.28975e-02_r8,0.22483e-02_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.56408e-02_r8,0.58364e-02_r8,0.57539e-02_r8,0.55120e-02_r8,0.51475e-02_r8, & + & 0.46559e-02_r8,0.40284e-02_r8,0.32222e-02_r8,0.26111e-02_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.56697e-02_r8,0.59982e-02_r8,0.59981e-02_r8,0.58053e-02_r8,0.54583e-02_r8, & + & 0.49917e-02_r8,0.43867e-02_r8,0.35862e-02_r8,0.30268e-02_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.57519e-02_r8,0.62108e-02_r8,0.62874e-02_r8,0.61219e-02_r8,0.58111e-02_r8, & + & 0.53715e-02_r8,0.47851e-02_r8,0.39858e-02_r8,0.34700e-02_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.58830e-02_r8,0.64813e-02_r8,0.66064e-02_r8,0.64830e-02_r8,0.62068e-02_r8, & + & 0.57872e-02_r8,0.52185e-02_r8,0.44205e-02_r8,0.39619e-02_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.28544e-01_r8,0.26155e-01_r8,0.24149e-01_r8,0.22667e-01_r8,0.21632e-01_r8, & + & 0.20279e-01_r8,0.18489e-01_r8,0.17580e-01_r8,0.19616e-01_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.28363e-01_r8,0.26242e-01_r8,0.24669e-01_r8,0.23473e-01_r8,0.22995e-01_r8, & + & 0.21803e-01_r8,0.19985e-01_r8,0.19915e-01_r8,0.22325e-01_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.28168e-01_r8,0.26278e-01_r8,0.25280e-01_r8,0.24624e-01_r8,0.24316e-01_r8, & + & 0.23197e-01_r8,0.21657e-01_r8,0.22779e-01_r8,0.25626e-01_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.27980e-01_r8,0.26431e-01_r8,0.25828e-01_r8,0.25920e-01_r8,0.25669e-01_r8, & + & 0.24755e-01_r8,0.23686e-01_r8,0.25934e-01_r8,0.29281e-01_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.27732e-01_r8,0.26646e-01_r8,0.26660e-01_r8,0.27009e-01_r8,0.27233e-01_r8, & + & 0.26525e-01_r8,0.25997e-01_r8,0.29201e-01_r8,0.33040e-01_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.30271e-01_r8,0.27672e-01_r8,0.25272e-01_r8,0.23430e-01_r8,0.22043e-01_r8, & + & 0.20727e-01_r8,0.19083e-01_r8,0.16913e-01_r8,0.18728e-01_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.30091e-01_r8,0.27720e-01_r8,0.25820e-01_r8,0.24222e-01_r8,0.23409e-01_r8, & + & 0.22468e-01_r8,0.20609e-01_r8,0.19148e-01_r8,0.21375e-01_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.29914e-01_r8,0.27750e-01_r8,0.26375e-01_r8,0.25267e-01_r8,0.24987e-01_r8, & + & 0.23926e-01_r8,0.22306e-01_r8,0.21932e-01_r8,0.24591e-01_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.29701e-01_r8,0.27873e-01_r8,0.26877e-01_r8,0.26535e-01_r8,0.26327e-01_r8, & + & 0.25568e-01_r8,0.24303e-01_r8,0.24920e-01_r8,0.28049e-01_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.29422e-01_r8,0.28052e-01_r8,0.27653e-01_r8,0.27818e-01_r8,0.27831e-01_r8, & + & 0.27375e-01_r8,0.26338e-01_r8,0.28129e-01_r8,0.31777e-01_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.32089e-01_r8,0.29221e-01_r8,0.26504e-01_r8,0.24372e-01_r8,0.22322e-01_r8, & + & 0.20541e-01_r8,0.19063e-01_r8,0.16413e-01_r8,0.17368e-01_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.31950e-01_r8,0.29299e-01_r8,0.26979e-01_r8,0.25078e-01_r8,0.23422e-01_r8, & + & 0.22454e-01_r8,0.20735e-01_r8,0.18244e-01_r8,0.19956e-01_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.31786e-01_r8,0.29316e-01_r8,0.27496e-01_r8,0.25889e-01_r8,0.24965e-01_r8, & + & 0.24089e-01_r8,0.22376e-01_r8,0.20693e-01_r8,0.22993e-01_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.31564e-01_r8,0.29393e-01_r8,0.27942e-01_r8,0.27000e-01_r8,0.26402e-01_r8, & + & 0.25715e-01_r8,0.24406e-01_r8,0.23371e-01_r8,0.26093e-01_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.31295e-01_r8,0.29526e-01_r8,0.28627e-01_r8,0.28150e-01_r8,0.27951e-01_r8, & + & 0.27569e-01_r8,0.26423e-01_r8,0.26332e-01_r8,0.29505e-01_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.33998e-01_r8,0.30694e-01_r8,0.27710e-01_r8,0.25291e-01_r8,0.22809e-01_r8, & + & 0.20329e-01_r8,0.18660e-01_r8,0.16131e-01_r8,0.15800e-01_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.33852e-01_r8,0.30861e-01_r8,0.28097e-01_r8,0.25930e-01_r8,0.23654e-01_r8, & + & 0.22029e-01_r8,0.20474e-01_r8,0.17896e-01_r8,0.18339e-01_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.33685e-01_r8,0.30889e-01_r8,0.28668e-01_r8,0.26585e-01_r8,0.25018e-01_r8, & + & 0.23681e-01_r8,0.22215e-01_r8,0.19897e-01_r8,0.21224e-01_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.33431e-01_r8,0.30933e-01_r8,0.29107e-01_r8,0.27570e-01_r8,0.26341e-01_r8, & + & 0.25360e-01_r8,0.24234e-01_r8,0.22138e-01_r8,0.24217e-01_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.33153e-01_r8,0.31115e-01_r8,0.29708e-01_r8,0.28626e-01_r8,0.27757e-01_r8, & + & 0.27318e-01_r8,0.26191e-01_r8,0.24666e-01_r8,0.27426e-01_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.35630e-01_r8,0.31962e-01_r8,0.28969e-01_r8,0.26191e-01_r8,0.23359e-01_r8, & + & 0.20419e-01_r8,0.18025e-01_r8,0.15529e-01_r8,0.14046e-01_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.35465e-01_r8,0.32227e-01_r8,0.29248e-01_r8,0.26845e-01_r8,0.24076e-01_r8, & + & 0.21854e-01_r8,0.19842e-01_r8,0.17371e-01_r8,0.16514e-01_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.35239e-01_r8,0.32283e-01_r8,0.29869e-01_r8,0.27436e-01_r8,0.25256e-01_r8, & + & 0.23352e-01_r8,0.21638e-01_r8,0.19381e-01_r8,0.19322e-01_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.34959e-01_r8,0.32275e-01_r8,0.30321e-01_r8,0.28325e-01_r8,0.26494e-01_r8, & + & 0.24825e-01_r8,0.23722e-01_r8,0.21526e-01_r8,0.22221e-01_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.34633e-01_r8,0.32463e-01_r8,0.30867e-01_r8,0.29345e-01_r8,0.27730e-01_r8, & + & 0.26661e-01_r8,0.25760e-01_r8,0.23698e-01_r8,0.25325e-01_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.36611e-01_r8,0.32766e-01_r8,0.29862e-01_r8,0.26964e-01_r8,0.23985e-01_r8, & + & 0.20572e-01_r8,0.17499e-01_r8,0.14612e-01_r8,0.12200e-01_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.36404e-01_r8,0.32931e-01_r8,0.30135e-01_r8,0.27680e-01_r8,0.24618e-01_r8, & + & 0.21792e-01_r8,0.19087e-01_r8,0.16488e-01_r8,0.14408e-01_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.36151e-01_r8,0.33151e-01_r8,0.30783e-01_r8,0.28229e-01_r8,0.25608e-01_r8, & + & 0.23215e-01_r8,0.20762e-01_r8,0.18415e-01_r8,0.17025e-01_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.35835e-01_r8,0.33169e-01_r8,0.31261e-01_r8,0.29020e-01_r8,0.26813e-01_r8, & + & 0.24559e-01_r8,0.22662e-01_r8,0.20622e-01_r8,0.19846e-01_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.35491e-01_r8,0.33330e-01_r8,0.31756e-01_r8,0.30047e-01_r8,0.27916e-01_r8, & + & 0.26189e-01_r8,0.24713e-01_r8,0.22859e-01_r8,0.22839e-01_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.36793e-01_r8,0.32943e-01_r8,0.30074e-01_r8,0.27299e-01_r8,0.24319e-01_r8, & + & 0.20802e-01_r8,0.17113e-01_r8,0.13465e-01_r8,0.10508e-01_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.36572e-01_r8,0.33074e-01_r8,0.30511e-01_r8,0.28032e-01_r8,0.24986e-01_r8, & + & 0.21844e-01_r8,0.18570e-01_r8,0.15283e-01_r8,0.12467e-01_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.36275e-01_r8,0.33234e-01_r8,0.31161e-01_r8,0.28602e-01_r8,0.25904e-01_r8, & + & 0.23164e-01_r8,0.20091e-01_r8,0.17151e-01_r8,0.14775e-01_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.35925e-01_r8,0.33332e-01_r8,0.31658e-01_r8,0.29367e-01_r8,0.27125e-01_r8, & + & 0.24431e-01_r8,0.21734e-01_r8,0.19261e-01_r8,0.17350e-01_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.35558e-01_r8,0.33506e-01_r8,0.32097e-01_r8,0.30412e-01_r8,0.28219e-01_r8, & + & 0.25923e-01_r8,0.23598e-01_r8,0.21456e-01_r8,0.20114e-01_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.36293e-01_r8,0.32550e-01_r8,0.29721e-01_r8,0.27154e-01_r8,0.24076e-01_r8, & + & 0.20693e-01_r8,0.16829e-01_r8,0.12555e-01_r8,0.89579e-02_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.35985e-01_r8,0.32624e-01_r8,0.30270e-01_r8,0.27879e-01_r8,0.24830e-01_r8, & + & 0.21669e-01_r8,0.18126e-01_r8,0.14126e-01_r8,0.10649e-01_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.35646e-01_r8,0.32730e-01_r8,0.30946e-01_r8,0.28474e-01_r8,0.25750e-01_r8, & + & 0.23017e-01_r8,0.19564e-01_r8,0.15741e-01_r8,0.12721e-01_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.35279e-01_r8,0.32754e-01_r8,0.31424e-01_r8,0.29187e-01_r8,0.27070e-01_r8, & + & 0.24316e-01_r8,0.21018e-01_r8,0.17682e-01_r8,0.15011e-01_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.34858e-01_r8,0.32947e-01_r8,0.31835e-01_r8,0.30265e-01_r8,0.28236e-01_r8, & + & 0.25710e-01_r8,0.22721e-01_r8,0.19777e-01_r8,0.17474e-01_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.35060e-01_r8,0.31556e-01_r8,0.29012e-01_r8,0.26469e-01_r8,0.23391e-01_r8, & + & 0.20141e-01_r8,0.16295e-01_r8,0.11885e-01_r8,0.58937e-02_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.34721e-01_r8,0.31589e-01_r8,0.29506e-01_r8,0.27211e-01_r8,0.24267e-01_r8, & + & 0.21055e-01_r8,0.17547e-01_r8,0.13263e-01_r8,0.69908e-02_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.34339e-01_r8,0.31609e-01_r8,0.30075e-01_r8,0.27841e-01_r8,0.25163e-01_r8, & + & 0.22398e-01_r8,0.18997e-01_r8,0.14640e-01_r8,0.92447e-02_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.33936e-01_r8,0.31619e-01_r8,0.30603e-01_r8,0.28503e-01_r8,0.26490e-01_r8, & + & 0.23804e-01_r8,0.20342e-01_r8,0.16280e-01_r8,0.11993e-01_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.33530e-01_r8,0.31821e-01_r8,0.30991e-01_r8,0.29578e-01_r8,0.27714e-01_r8, & + & 0.25218e-01_r8,0.21886e-01_r8,0.18137e-01_r8,0.14941e-01_r8 /) + kao(:, 1,10,10) = (/ & + & 0.33129e-01_r8,0.29964e-01_r8,0.27856e-01_r8,0.25331e-01_r8,0.22401e-01_r8, & + & 0.19295e-01_r8,0.15555e-01_r8,0.11348e-01_r8,0.74286e-02_r8 /) + kao(:, 2,10,10) = (/ & + & 0.32749e-01_r8,0.29950e-01_r8,0.28249e-01_r8,0.25998e-01_r8,0.23402e-01_r8, & + & 0.20209e-01_r8,0.16757e-01_r8,0.12616e-01_r8,0.86653e-02_r8 /) + kao(:, 3,10,10) = (/ & + & 0.32344e-01_r8,0.29933e-01_r8,0.28722e-01_r8,0.26736e-01_r8,0.24275e-01_r8, & + & 0.21508e-01_r8,0.18229e-01_r8,0.13852e-01_r8,0.98082e-02_r8 /) + kao(:, 4,10,10) = (/ & + & 0.31944e-01_r8,0.30002e-01_r8,0.29235e-01_r8,0.27435e-01_r8,0.25548e-01_r8, & + & 0.22964e-01_r8,0.19579e-01_r8,0.15278e-01_r8,0.11352e-01_r8 /) + kao(:, 5,10,10) = (/ & + & 0.31533e-01_r8,0.30276e-01_r8,0.29685e-01_r8,0.28539e-01_r8,0.26795e-01_r8, & + & 0.24358e-01_r8,0.21106e-01_r8,0.16900e-01_r8,0.12858e-01_r8 /) + kao(:, 1,11,10) = (/ & + & 0.30476e-01_r8,0.27848e-01_r8,0.26383e-01_r8,0.23991e-01_r8,0.21505e-01_r8, & + & 0.18546e-01_r8,0.15127e-01_r8,0.11242e-01_r8,0.84064e-02_r8 /) + kao(:, 2,11,10) = (/ & + & 0.30069e-01_r8,0.27873e-01_r8,0.26695e-01_r8,0.24743e-01_r8,0.22441e-01_r8, & + & 0.19591e-01_r8,0.16445e-01_r8,0.12465e-01_r8,0.99520e-02_r8 /) + kao(:, 3,11,10) = (/ & + & 0.29683e-01_r8,0.27938e-01_r8,0.27199e-01_r8,0.25464e-01_r8,0.23474e-01_r8, & + & 0.21008e-01_r8,0.17841e-01_r8,0.13636e-01_r8,0.11012e-01_r8 /) + kao(:, 4,11,10) = (/ & + & 0.29281e-01_r8,0.28147e-01_r8,0.27612e-01_r8,0.26457e-01_r8,0.24810e-01_r8, & + & 0.22367e-01_r8,0.19198e-01_r8,0.15026e-01_r8,0.12764e-01_r8 /) + kao(:, 5,11,10) = (/ & + & 0.28878e-01_r8,0.28450e-01_r8,0.28275e-01_r8,0.27607e-01_r8,0.26039e-01_r8, & + & 0.23769e-01_r8,0.20798e-01_r8,0.16479e-01_r8,0.14486e-01_r8 /) + kao(:, 1,12,10) = (/ & + & 0.27483e-01_r8,0.25515e-01_r8,0.24398e-01_r8,0.22423e-01_r8,0.20204e-01_r8, & + & 0.17532e-01_r8,0.14597e-01_r8,0.10977e-01_r8,0.89256e-02_r8 /) + kao(:, 2,12,10) = (/ & + & 0.27095e-01_r8,0.25634e-01_r8,0.24782e-01_r8,0.23175e-01_r8,0.21102e-01_r8, & + & 0.18740e-01_r8,0.15902e-01_r8,0.12114e-01_r8,0.10252e-01_r8 /) + kao(:, 3,12,10) = (/ & + & 0.26727e-01_r8,0.25761e-01_r8,0.25266e-01_r8,0.23974e-01_r8,0.22361e-01_r8, & + & 0.20171e-01_r8,0.17193e-01_r8,0.13275e-01_r8,0.11451e-01_r8 /) + kao(:, 4,12,10) = (/ & + & 0.26341e-01_r8,0.26039e-01_r8,0.25768e-01_r8,0.25146e-01_r8,0.23693e-01_r8, & + & 0.21452e-01_r8,0.18566e-01_r8,0.14626e-01_r8,0.13159e-01_r8 /) + kao(:, 5,12,10) = (/ & + & 0.25958e-01_r8,0.26232e-01_r8,0.26607e-01_r8,0.26277e-01_r8,0.24926e-01_r8, & + & 0.22906e-01_r8,0.20118e-01_r8,0.16018e-01_r8,0.14784e-01_r8 /) + kao(:, 1,13,10) = (/ & + & 0.24404e-01_r8,0.23195e-01_r8,0.22191e-01_r8,0.20664e-01_r8,0.18645e-01_r8, & + & 0.16397e-01_r8,0.13889e-01_r8,0.10532e-01_r8,0.85762e-02_r8 /) + kao(:, 2,13,10) = (/ & + & 0.24045e-01_r8,0.23274e-01_r8,0.22704e-01_r8,0.21382e-01_r8,0.19651e-01_r8, & + & 0.17693e-01_r8,0.15133e-01_r8,0.11576e-01_r8,0.96068e-02_r8 /) + kao(:, 3,13,10) = (/ & + & 0.23688e-01_r8,0.23458e-01_r8,0.23185e-01_r8,0.22281e-01_r8,0.21010e-01_r8, & + & 0.19021e-01_r8,0.16312e-01_r8,0.12755e-01_r8,0.10813e-01_r8 /) + kao(:, 4,13,10) = (/ & + & 0.23340e-01_r8,0.23719e-01_r8,0.23835e-01_r8,0.23529e-01_r8,0.22269e-01_r8, & + & 0.20297e-01_r8,0.17677e-01_r8,0.14063e-01_r8,0.12469e-01_r8 /) + kao(:, 5,13,10) = (/ & + & 0.23007e-01_r8,0.23887e-01_r8,0.24745e-01_r8,0.24636e-01_r8,0.23538e-01_r8, & + & 0.21795e-01_r8,0.19163e-01_r8,0.15452e-01_r8,0.13866e-01_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.38207e-01_r8,0.35023e-01_r8,0.31764e-01_r8,0.29513e-01_r8,0.27148e-01_r8, & + & 0.25121e-01_r8,0.22678e-01_r8,0.23928e-01_r8,0.26899e-01_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.37930e-01_r8,0.35272e-01_r8,0.32250e-01_r8,0.30760e-01_r8,0.28557e-01_r8, & + & 0.27105e-01_r8,0.25089e-01_r8,0.27604e-01_r8,0.31070e-01_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.37611e-01_r8,0.35491e-01_r8,0.32949e-01_r8,0.31869e-01_r8,0.30632e-01_r8, & + & 0.29068e-01_r8,0.27897e-01_r8,0.31369e-01_r8,0.35419e-01_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.37244e-01_r8,0.35566e-01_r8,0.33874e-01_r8,0.33253e-01_r8,0.32466e-01_r8, & + & 0.31095e-01_r8,0.31358e-01_r8,0.35716e-01_r8,0.40368e-01_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.36895e-01_r8,0.35750e-01_r8,0.34817e-01_r8,0.35038e-01_r8,0.34265e-01_r8, & + & 0.33428e-01_r8,0.35709e-01_r8,0.40899e-01_r8,0.46337e-01_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.39640e-01_r8,0.36208e-01_r8,0.33140e-01_r8,0.30731e-01_r8,0.28621e-01_r8, & + & 0.26451e-01_r8,0.23824e-01_r8,0.23418e-01_r8,0.26401e-01_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.39384e-01_r8,0.36543e-01_r8,0.33542e-01_r8,0.32043e-01_r8,0.30032e-01_r8, & + & 0.28484e-01_r8,0.26191e-01_r8,0.27027e-01_r8,0.30540e-01_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.39069e-01_r8,0.36650e-01_r8,0.34340e-01_r8,0.33119e-01_r8,0.32037e-01_r8, & + & 0.30787e-01_r8,0.28410e-01_r8,0.30659e-01_r8,0.34733e-01_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.38756e-01_r8,0.36738e-01_r8,0.35220e-01_r8,0.34547e-01_r8,0.34264e-01_r8, & + & 0.32872e-01_r8,0.31204e-01_r8,0.34827e-01_r8,0.39529e-01_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.38432e-01_r8,0.36958e-01_r8,0.36077e-01_r8,0.36343e-01_r8,0.36389e-01_r8, & + & 0.35222e-01_r8,0.34916e-01_r8,0.39622e-01_r8,0.45018e-01_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.41762e-01_r8,0.37801e-01_r8,0.34598e-01_r8,0.31385e-01_r8,0.29542e-01_r8, & + & 0.27120e-01_r8,0.24296e-01_r8,0.22163e-01_r8,0.24873e-01_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.41521e-01_r8,0.38107e-01_r8,0.34885e-01_r8,0.32740e-01_r8,0.30892e-01_r8, & + & 0.28927e-01_r8,0.26874e-01_r8,0.25608e-01_r8,0.28828e-01_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.41284e-01_r8,0.38250e-01_r8,0.35590e-01_r8,0.33929e-01_r8,0.32637e-01_r8, & + & 0.31412e-01_r8,0.29268e-01_r8,0.29038e-01_r8,0.32851e-01_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.40996e-01_r8,0.38286e-01_r8,0.36402e-01_r8,0.35356e-01_r8,0.34868e-01_r8, & + & 0.33799e-01_r8,0.31619e-01_r8,0.33158e-01_r8,0.37659e-01_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.40710e-01_r8,0.38497e-01_r8,0.37108e-01_r8,0.37161e-01_r8,0.37098e-01_r8, & + & 0.36226e-01_r8,0.34568e-01_r8,0.37733e-01_r8,0.42953e-01_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.44432e-01_r8,0.39911e-01_r8,0.36533e-01_r8,0.32358e-01_r8,0.30116e-01_r8, & + & 0.27425e-01_r8,0.24391e-01_r8,0.21003e-01_r8,0.22873e-01_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.44241e-01_r8,0.40248e-01_r8,0.36750e-01_r8,0.33734e-01_r8,0.31371e-01_r8, & + & 0.29050e-01_r8,0.26929e-01_r8,0.23993e-01_r8,0.26696e-01_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.43986e-01_r8,0.40474e-01_r8,0.37358e-01_r8,0.34847e-01_r8,0.32894e-01_r8, & + & 0.31475e-01_r8,0.29486e-01_r8,0.27256e-01_r8,0.30632e-01_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.43750e-01_r8,0.40487e-01_r8,0.38107e-01_r8,0.36115e-01_r8,0.35063e-01_r8, & + & 0.33924e-01_r8,0.31967e-01_r8,0.31144e-01_r8,0.35198e-01_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.43427e-01_r8,0.40610e-01_r8,0.38702e-01_r8,0.37867e-01_r8,0.37251e-01_r8, & + & 0.36357e-01_r8,0.34995e-01_r8,0.35502e-01_r8,0.40197e-01_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.47176e-01_r8,0.42142e-01_r8,0.38550e-01_r8,0.33884e-01_r8,0.30889e-01_r8, & + & 0.27516e-01_r8,0.24267e-01_r8,0.20680e-01_r8,0.20851e-01_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.47021e-01_r8,0.42363e-01_r8,0.38770e-01_r8,0.35164e-01_r8,0.32104e-01_r8, & + & 0.29005e-01_r8,0.26645e-01_r8,0.23247e-01_r8,0.24505e-01_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.46797e-01_r8,0.42763e-01_r8,0.39235e-01_r8,0.36269e-01_r8,0.33395e-01_r8, & + & 0.31307e-01_r8,0.29249e-01_r8,0.25924e-01_r8,0.28324e-01_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.46572e-01_r8,0.42912e-01_r8,0.40018e-01_r8,0.37361e-01_r8,0.35308e-01_r8, & + & 0.33789e-01_r8,0.31702e-01_r8,0.29304e-01_r8,0.32735e-01_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.46255e-01_r8,0.42923e-01_r8,0.40617e-01_r8,0.38829e-01_r8,0.37399e-01_r8, & + & 0.36167e-01_r8,0.34686e-01_r8,0.33312e-01_r8,0.37380e-01_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.49975e-01_r8,0.44361e-01_r8,0.40341e-01_r8,0.35539e-01_r8,0.31829e-01_r8, & + & 0.27816e-01_r8,0.23845e-01_r8,0.20093e-01_r8,0.18543e-01_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.49828e-01_r8,0.44558e-01_r8,0.40763e-01_r8,0.36628e-01_r8,0.33050e-01_r8, & + & 0.29095e-01_r8,0.26117e-01_r8,0.22673e-01_r8,0.22099e-01_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.49608e-01_r8,0.44841e-01_r8,0.41085e-01_r8,0.37793e-01_r8,0.34135e-01_r8, & + & 0.31097e-01_r8,0.28755e-01_r8,0.25283e-01_r8,0.25831e-01_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.49365e-01_r8,0.45144e-01_r8,0.41922e-01_r8,0.38723e-01_r8,0.35845e-01_r8, & + & 0.33431e-01_r8,0.31237e-01_r8,0.28118e-01_r8,0.29954e-01_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.49026e-01_r8,0.45249e-01_r8,0.42535e-01_r8,0.39993e-01_r8,0.37821e-01_r8, & + & 0.35671e-01_r8,0.34099e-01_r8,0.31399e-01_r8,0.34366e-01_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.52410e-01_r8,0.46362e-01_r8,0.41901e-01_r8,0.37210e-01_r8,0.32800e-01_r8, & + & 0.28263e-01_r8,0.23499e-01_r8,0.19230e-01_r8,0.16237e-01_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.52214e-01_r8,0.46505e-01_r8,0.42451e-01_r8,0.38113e-01_r8,0.34021e-01_r8, & + & 0.29480e-01_r8,0.25464e-01_r8,0.21812e-01_r8,0.19595e-01_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.51982e-01_r8,0.46700e-01_r8,0.42867e-01_r8,0.39292e-01_r8,0.35048e-01_r8, & + & 0.31222e-01_r8,0.27987e-01_r8,0.24489e-01_r8,0.23138e-01_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.51660e-01_r8,0.46904e-01_r8,0.43697e-01_r8,0.40172e-01_r8,0.36555e-01_r8, & + & 0.33390e-01_r8,0.30506e-01_r8,0.27287e-01_r8,0.27036e-01_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.51284e-01_r8,0.47053e-01_r8,0.44408e-01_r8,0.41338e-01_r8,0.38429e-01_r8, & + & 0.35446e-01_r8,0.33297e-01_r8,0.30383e-01_r8,0.31263e-01_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.53849e-01_r8,0.47597e-01_r8,0.43012e-01_r8,0.38373e-01_r8,0.33860e-01_r8, & + & 0.28679e-01_r8,0.23391e-01_r8,0.18151e-01_r8,0.14106e-01_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.53641e-01_r8,0.47671e-01_r8,0.43475e-01_r8,0.39445e-01_r8,0.35042e-01_r8, & + & 0.29924e-01_r8,0.25055e-01_r8,0.20655e-01_r8,0.17171e-01_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.53375e-01_r8,0.47826e-01_r8,0.44020e-01_r8,0.40653e-01_r8,0.36059e-01_r8, & + & 0.31447e-01_r8,0.27345e-01_r8,0.23357e-01_r8,0.20383e-01_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.53001e-01_r8,0.48011e-01_r8,0.44999e-01_r8,0.41558e-01_r8,0.37354e-01_r8, & + & 0.33601e-01_r8,0.29695e-01_r8,0.26106e-01_r8,0.24004e-01_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.52592e-01_r8,0.48152e-01_r8,0.45845e-01_r8,0.42585e-01_r8,0.39198e-01_r8, & + & 0.35588e-01_r8,0.32287e-01_r8,0.29155e-01_r8,0.27991e-01_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.54223e-01_r8,0.47973e-01_r8,0.43289e-01_r8,0.38882e-01_r8,0.34299e-01_r8, & + & 0.28946e-01_r8,0.23303e-01_r8,0.17068e-01_r8,0.11192e-01_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.53940e-01_r8,0.47929e-01_r8,0.43759e-01_r8,0.39916e-01_r8,0.35622e-01_r8, & + & 0.30345e-01_r8,0.24752e-01_r8,0.19298e-01_r8,0.14778e-01_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.53642e-01_r8,0.48095e-01_r8,0.44399e-01_r8,0.41241e-01_r8,0.36768e-01_r8, & + & 0.31745e-01_r8,0.26845e-01_r8,0.21914e-01_r8,0.17754e-01_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.53257e-01_r8,0.48243e-01_r8,0.45322e-01_r8,0.42327e-01_r8,0.37988e-01_r8, & + & 0.33799e-01_r8,0.29109e-01_r8,0.24533e-01_r8,0.21056e-01_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.52778e-01_r8,0.48340e-01_r8,0.46365e-01_r8,0.43326e-01_r8,0.39837e-01_r8, & + & 0.35758e-01_r8,0.31465e-01_r8,0.27467e-01_r8,0.24721e-01_r8 /) + kao(:, 1,10,11) = (/ & + & 0.53564e-01_r8,0.47520e-01_r8,0.42897e-01_r8,0.38870e-01_r8,0.34096e-01_r8, & + & 0.28762e-01_r8,0.23161e-01_r8,0.16420e-01_r8,0.10403e-01_r8 /) + kao(:, 2,10,11) = (/ & + & 0.53200e-01_r8,0.47370e-01_r8,0.43390e-01_r8,0.39812e-01_r8,0.35374e-01_r8, & + & 0.30449e-01_r8,0.24605e-01_r8,0.18329e-01_r8,0.12727e-01_r8 /) + kao(:, 3,10,11) = (/ & + & 0.52804e-01_r8,0.47486e-01_r8,0.44077e-01_r8,0.41029e-01_r8,0.36828e-01_r8, & + & 0.31909e-01_r8,0.26518e-01_r8,0.20700e-01_r8,0.14792e-01_r8 /) + kao(:, 4,10,11) = (/ & + & 0.52379e-01_r8,0.47585e-01_r8,0.44997e-01_r8,0.42270e-01_r8,0.38168e-01_r8, & + & 0.33930e-01_r8,0.28762e-01_r8,0.23052e-01_r8,0.16495e-01_r8 /) + kao(:, 5,10,11) = (/ & + & 0.51859e-01_r8,0.47629e-01_r8,0.45989e-01_r8,0.43387e-01_r8,0.40080e-01_r8, & + & 0.36007e-01_r8,0.30957e-01_r8,0.25773e-01_r8,0.18898e-01_r8 /) + kao(:, 1,11,11) = (/ & + & 0.51622e-01_r8,0.46074e-01_r8,0.42057e-01_r8,0.38618e-01_r8,0.33808e-01_r8, & + & 0.28847e-01_r8,0.23288e-01_r8,0.16620e-01_r8,0.11907e-01_r8 /) + kao(:, 2,11,11) = (/ & + & 0.51193e-01_r8,0.45980e-01_r8,0.42719e-01_r8,0.39541e-01_r8,0.35253e-01_r8, & + & 0.30566e-01_r8,0.24931e-01_r8,0.18565e-01_r8,0.13988e-01_r8 /) + kao(:, 3,11,11) = (/ & + & 0.50740e-01_r8,0.46089e-01_r8,0.43457e-01_r8,0.40804e-01_r8,0.36736e-01_r8, & + & 0.32310e-01_r8,0.27095e-01_r8,0.20684e-01_r8,0.16681e-01_r8 /) + kao(:, 4,11,11) = (/ & + & 0.50228e-01_r8,0.46105e-01_r8,0.44454e-01_r8,0.41838e-01_r8,0.38478e-01_r8, & + & 0.34580e-01_r8,0.29293e-01_r8,0.22846e-01_r8,0.18301e-01_r8 /) + kao(:, 5,11,11) = (/ & + & 0.49697e-01_r8,0.46259e-01_r8,0.45191e-01_r8,0.43198e-01_r8,0.40635e-01_r8, & + & 0.36709e-01_r8,0.31434e-01_r8,0.25478e-01_r8,0.20947e-01_r8 /) + kao(:, 1,12,11) = (/ & + & 0.48647e-01_r8,0.43752e-01_r8,0.40707e-01_r8,0.37500e-01_r8,0.33089e-01_r8, & + & 0.28489e-01_r8,0.23000e-01_r8,0.16785e-01_r8,0.12627e-01_r8 /) + kao(:, 2,12,11) = (/ & + & 0.48181e-01_r8,0.43711e-01_r8,0.41312e-01_r8,0.38500e-01_r8,0.34693e-01_r8, & + & 0.30128e-01_r8,0.24939e-01_r8,0.18673e-01_r8,0.15167e-01_r8 /) + kao(:, 3,12,11) = (/ & + & 0.47678e-01_r8,0.43812e-01_r8,0.42104e-01_r8,0.39699e-01_r8,0.36175e-01_r8, & + & 0.32199e-01_r8,0.27269e-01_r8,0.20637e-01_r8,0.17826e-01_r8 /) + kao(:, 4,12,11) = (/ & + & 0.47181e-01_r8,0.43914e-01_r8,0.43002e-01_r8,0.40767e-01_r8,0.38218e-01_r8, & + & 0.34662e-01_r8,0.29455e-01_r8,0.22728e-01_r8,0.19785e-01_r8 /) + kao(:, 5,12,11) = (/ & + & 0.46685e-01_r8,0.44343e-01_r8,0.43686e-01_r8,0.42426e-01_r8,0.40422e-01_r8, & + & 0.36842e-01_r8,0.31692e-01_r8,0.25217e-01_r8,0.22679e-01_r8 /) + kao(:, 1,13,11) = (/ & + & 0.44854e-01_r8,0.40724e-01_r8,0.38672e-01_r8,0.35614e-01_r8,0.31949e-01_r8, & + & 0.27602e-01_r8,0.22498e-01_r8,0.16720e-01_r8,0.12798e-01_r8 /) + kao(:, 2,13,11) = (/ & + & 0.44381e-01_r8,0.40833e-01_r8,0.39190e-01_r8,0.36792e-01_r8,0.33534e-01_r8, & + & 0.29330e-01_r8,0.24604e-01_r8,0.18629e-01_r8,0.15661e-01_r8 /) + kao(:, 3,13,11) = (/ & + & 0.43916e-01_r8,0.40995e-01_r8,0.40051e-01_r8,0.37975e-01_r8,0.35149e-01_r8, & + & 0.31642e-01_r8,0.27046e-01_r8,0.20453e-01_r8,0.17792e-01_r8 /) + kao(:, 4,13,11) = (/ & + & 0.43441e-01_r8,0.41288e-01_r8,0.40871e-01_r8,0.39278e-01_r8,0.37365e-01_r8, & + & 0.34126e-01_r8,0.29213e-01_r8,0.22513e-01_r8,0.19591e-01_r8 /) + kao(:, 5,13,11) = (/ & + & 0.42963e-01_r8,0.41916e-01_r8,0.41758e-01_r8,0.41144e-01_r8,0.39580e-01_r8, & + & 0.36327e-01_r8,0.31558e-01_r8,0.24885e-01_r8,0.22715e-01_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.52315e-01_r8,0.47505e-01_r8,0.42884e-01_r8,0.38287e-01_r8,0.34721e-01_r8, & + & 0.30888e-01_r8,0.29687e-01_r8,0.33559e-01_r8,0.37791e-01_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.52132e-01_r8,0.47869e-01_r8,0.43358e-01_r8,0.39519e-01_r8,0.36490e-01_r8, & + & 0.33059e-01_r8,0.34560e-01_r8,0.39434e-01_r8,0.44537e-01_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.51859e-01_r8,0.48259e-01_r8,0.44108e-01_r8,0.41053e-01_r8,0.38159e-01_r8, & + & 0.36325e-01_r8,0.40345e-01_r8,0.46345e-01_r8,0.52382e-01_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.51556e-01_r8,0.48650e-01_r8,0.44992e-01_r8,0.42544e-01_r8,0.40704e-01_r8, & + & 0.40160e-01_r8,0.46427e-01_r8,0.53431e-01_r8,0.60544e-01_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.51137e-01_r8,0.48860e-01_r8,0.46168e-01_r8,0.44111e-01_r8,0.43209e-01_r8, & + & 0.44827e-01_r8,0.52800e-01_r8,0.60972e-01_r8,0.69216e-01_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.56434e-01_r8,0.51118e-01_r8,0.46217e-01_r8,0.41561e-01_r8,0.37505e-01_r8, & + & 0.33646e-01_r8,0.30189e-01_r8,0.33085e-01_r8,0.37424e-01_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.56174e-01_r8,0.51590e-01_r8,0.46758e-01_r8,0.42838e-01_r8,0.39459e-01_r8, & + & 0.35755e-01_r8,0.34261e-01_r8,0.38732e-01_r8,0.43938e-01_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.55870e-01_r8,0.52113e-01_r8,0.47459e-01_r8,0.44557e-01_r8,0.41223e-01_r8, & + & 0.38732e-01_r8,0.39807e-01_r8,0.45508e-01_r8,0.51693e-01_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.55457e-01_r8,0.52524e-01_r8,0.48507e-01_r8,0.46112e-01_r8,0.43732e-01_r8, & + & 0.42045e-01_r8,0.45811e-01_r8,0.52732e-01_r8,0.60004e-01_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.54996e-01_r8,0.52680e-01_r8,0.49849e-01_r8,0.47721e-01_r8,0.46514e-01_r8, & + & 0.45961e-01_r8,0.52270e-01_r8,0.60294e-01_r8,0.68714e-01_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.59831e-01_r8,0.53764e-01_r8,0.48883e-01_r8,0.44361e-01_r8,0.39553e-01_r8, & + & 0.35958e-01_r8,0.31293e-01_r8,0.31467e-01_r8,0.35795e-01_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.59532e-01_r8,0.54423e-01_r8,0.49485e-01_r8,0.45554e-01_r8,0.41889e-01_r8, & + & 0.38044e-01_r8,0.34149e-01_r8,0.36846e-01_r8,0.42078e-01_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.59134e-01_r8,0.55152e-01_r8,0.50116e-01_r8,0.47410e-01_r8,0.43907e-01_r8, & + & 0.40732e-01_r8,0.38444e-01_r8,0.43145e-01_r8,0.49218e-01_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.58672e-01_r8,0.55655e-01_r8,0.51271e-01_r8,0.49059e-01_r8,0.46360e-01_r8, & + & 0.44063e-01_r8,0.43633e-01_r8,0.49781e-01_r8,0.56746e-01_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.58134e-01_r8,0.55813e-01_r8,0.52716e-01_r8,0.50709e-01_r8,0.49278e-01_r8, & + & 0.47427e-01_r8,0.49630e-01_r8,0.57031e-01_r8,0.65034e-01_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.62624e-01_r8,0.55864e-01_r8,0.50884e-01_r8,0.46641e-01_r8,0.41202e-01_r8, & + & 0.37808e-01_r8,0.32728e-01_r8,0.29634e-01_r8,0.33571e-01_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.62339e-01_r8,0.56365e-01_r8,0.51618e-01_r8,0.47600e-01_r8,0.43888e-01_r8, & + & 0.40000e-01_r8,0.35145e-01_r8,0.34591e-01_r8,0.39469e-01_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.61969e-01_r8,0.57107e-01_r8,0.52103e-01_r8,0.49599e-01_r8,0.46112e-01_r8, & + & 0.42482e-01_r8,0.38680e-01_r8,0.40578e-01_r8,0.46387e-01_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.61515e-01_r8,0.57939e-01_r8,0.53160e-01_r8,0.51347e-01_r8,0.48544e-01_r8, & + & 0.45843e-01_r8,0.42689e-01_r8,0.46767e-01_r8,0.53378e-01_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.60986e-01_r8,0.58238e-01_r8,0.54658e-01_r8,0.53027e-01_r8,0.51696e-01_r8, & + & 0.49388e-01_r8,0.47217e-01_r8,0.53278e-01_r8,0.60785e-01_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.65795e-01_r8,0.58347e-01_r8,0.52585e-01_r8,0.48437e-01_r8,0.42714e-01_r8, & + & 0.39265e-01_r8,0.34039e-01_r8,0.28235e-01_r8,0.31421e-01_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.65486e-01_r8,0.58633e-01_r8,0.53696e-01_r8,0.49213e-01_r8,0.45420e-01_r8, & + & 0.41668e-01_r8,0.36378e-01_r8,0.32647e-01_r8,0.37055e-01_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.65183e-01_r8,0.59134e-01_r8,0.54134e-01_r8,0.51097e-01_r8,0.47829e-01_r8, & + & 0.44052e-01_r8,0.39727e-01_r8,0.38129e-01_r8,0.43417e-01_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.64717e-01_r8,0.59894e-01_r8,0.54954e-01_r8,0.53041e-01_r8,0.50294e-01_r8, & + & 0.47344e-01_r8,0.43654e-01_r8,0.43889e-01_r8,0.49916e-01_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.64255e-01_r8,0.60489e-01_r8,0.56373e-01_r8,0.54824e-01_r8,0.53472e-01_r8, & + & 0.51112e-01_r8,0.47282e-01_r8,0.50031e-01_r8,0.57102e-01_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.69615e-01_r8,0.61594e-01_r8,0.54882e-01_r8,0.50187e-01_r8,0.44074e-01_r8, & + & 0.39997e-01_r8,0.34871e-01_r8,0.27743e-01_r8,0.29013e-01_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.69442e-01_r8,0.61757e-01_r8,0.55910e-01_r8,0.50997e-01_r8,0.46497e-01_r8, & + & 0.42613e-01_r8,0.37188e-01_r8,0.31216e-01_r8,0.34347e-01_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.69156e-01_r8,0.62106e-01_r8,0.56750e-01_r8,0.52515e-01_r8,0.49101e-01_r8, & + & 0.44986e-01_r8,0.40395e-01_r8,0.35961e-01_r8,0.40369e-01_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.68816e-01_r8,0.62627e-01_r8,0.57231e-01_r8,0.54601e-01_r8,0.51362e-01_r8, & + & 0.48280e-01_r8,0.44442e-01_r8,0.41156e-01_r8,0.46554e-01_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.68355e-01_r8,0.63113e-01_r8,0.58516e-01_r8,0.56347e-01_r8,0.54360e-01_r8, & + & 0.52199e-01_r8,0.48222e-01_r8,0.46871e-01_r8,0.53241e-01_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.74032e-01_r8,0.65393e-01_r8,0.58013e-01_r8,0.51965e-01_r8,0.45915e-01_r8, & + & 0.40526e-01_r8,0.35125e-01_r8,0.27883e-01_r8,0.26586e-01_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.73937e-01_r8,0.65493e-01_r8,0.58738e-01_r8,0.53263e-01_r8,0.47941e-01_r8, & + & 0.43149e-01_r8,0.37585e-01_r8,0.30874e-01_r8,0.31614e-01_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.73662e-01_r8,0.65759e-01_r8,0.59591e-01_r8,0.54630e-01_r8,0.50354e-01_r8, & + & 0.45514e-01_r8,0.40708e-01_r8,0.34889e-01_r8,0.37383e-01_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.73359e-01_r8,0.66187e-01_r8,0.60275e-01_r8,0.56599e-01_r8,0.52392e-01_r8, & + & 0.48574e-01_r8,0.44791e-01_r8,0.39333e-01_r8,0.43356e-01_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.72923e-01_r8,0.66589e-01_r8,0.61432e-01_r8,0.58168e-01_r8,0.55043e-01_r8, & + & 0.52561e-01_r8,0.48755e-01_r8,0.44300e-01_r8,0.49765e-01_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.78458e-01_r8,0.69177e-01_r8,0.61142e-01_r8,0.54247e-01_r8,0.47727e-01_r8, & + & 0.41456e-01_r8,0.34819e-01_r8,0.27717e-01_r8,0.23941e-01_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.78410e-01_r8,0.69294e-01_r8,0.61857e-01_r8,0.55492e-01_r8,0.49764e-01_r8, & + & 0.43844e-01_r8,0.37501e-01_r8,0.30644e-01_r8,0.28737e-01_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.78162e-01_r8,0.69463e-01_r8,0.62578e-01_r8,0.57026e-01_r8,0.52068e-01_r8, & + & 0.46044e-01_r8,0.40472e-01_r8,0.34561e-01_r8,0.34380e-01_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.77871e-01_r8,0.69834e-01_r8,0.63268e-01_r8,0.59074e-01_r8,0.53918e-01_r8, & + & 0.48672e-01_r8,0.44601e-01_r8,0.38671e-01_r8,0.40158e-01_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.77487e-01_r8,0.70209e-01_r8,0.64405e-01_r8,0.60632e-01_r8,0.56120e-01_r8, & + & 0.52504e-01_r8,0.48787e-01_r8,0.42980e-01_r8,0.46410e-01_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.82666e-01_r8,0.72734e-01_r8,0.64105e-01_r8,0.56594e-01_r8,0.49561e-01_r8, & + & 0.42281e-01_r8,0.34472e-01_r8,0.27105e-01_r8,0.21191e-01_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.82602e-01_r8,0.72866e-01_r8,0.64825e-01_r8,0.57780e-01_r8,0.51415e-01_r8, & + & 0.44682e-01_r8,0.37233e-01_r8,0.30003e-01_r8,0.25697e-01_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.82349e-01_r8,0.72898e-01_r8,0.65478e-01_r8,0.59213e-01_r8,0.53844e-01_r8, & + & 0.46925e-01_r8,0.39994e-01_r8,0.33830e-01_r8,0.31116e-01_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.82004e-01_r8,0.73222e-01_r8,0.66214e-01_r8,0.61303e-01_r8,0.55771e-01_r8, & + & 0.49206e-01_r8,0.43963e-01_r8,0.38199e-01_r8,0.36759e-01_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.81608e-01_r8,0.73612e-01_r8,0.67180e-01_r8,0.63056e-01_r8,0.57653e-01_r8, & + & 0.52653e-01_r8,0.48283e-01_r8,0.42441e-01_r8,0.42846e-01_r8 /) + kao(:, 1,10,12) = (/ & + & 0.85880e-01_r8,0.75430e-01_r8,0.66656e-01_r8,0.58773e-01_r8,0.51658e-01_r8, & + & 0.43336e-01_r8,0.34393e-01_r8,0.26157e-01_r8,0.14663e-01_r8 /) + kao(:, 2,10,12) = (/ & + & 0.85756e-01_r8,0.75590e-01_r8,0.67337e-01_r8,0.60049e-01_r8,0.53266e-01_r8, & + & 0.45473e-01_r8,0.37278e-01_r8,0.29125e-01_r8,0.16193e-01_r8 /) + kao(:, 3,10,12) = (/ & + & 0.85530e-01_r8,0.75588e-01_r8,0.67995e-01_r8,0.61462e-01_r8,0.55345e-01_r8, & + & 0.48001e-01_r8,0.39939e-01_r8,0.32883e-01_r8,0.20331e-01_r8 /) + kao(:, 4,10,12) = (/ & + & 0.85095e-01_r8,0.75810e-01_r8,0.68684e-01_r8,0.63320e-01_r8,0.57485e-01_r8, & + & 0.50257e-01_r8,0.43559e-01_r8,0.37443e-01_r8,0.23682e-01_r8 /) + kao(:, 5,10,12) = (/ & + & 0.84667e-01_r8,0.76211e-01_r8,0.69733e-01_r8,0.65095e-01_r8,0.59445e-01_r8, & + & 0.53380e-01_r8,0.47785e-01_r8,0.41863e-01_r8,0.26616e-01_r8 /) + kao(:, 1,11,12) = (/ & + & 0.87471e-01_r8,0.76929e-01_r8,0.68322e-01_r8,0.60781e-01_r8,0.53951e-01_r8, & + & 0.45056e-01_r8,0.35758e-01_r8,0.26371e-01_r8,0.18858e-01_r8 /) + kao(:, 2,11,12) = (/ & + & 0.87208e-01_r8,0.76940e-01_r8,0.68996e-01_r8,0.62212e-01_r8,0.55582e-01_r8, & + & 0.47319e-01_r8,0.38590e-01_r8,0.29478e-01_r8,0.21575e-01_r8 /) + kao(:, 3,11,12) = (/ & + & 0.86835e-01_r8,0.76905e-01_r8,0.69723e-01_r8,0.63816e-01_r8,0.57699e-01_r8, & + & 0.49745e-01_r8,0.41432e-01_r8,0.33605e-01_r8,0.25460e-01_r8 /) + kao(:, 4,11,12) = (/ & + & 0.86430e-01_r8,0.77295e-01_r8,0.70629e-01_r8,0.65834e-01_r8,0.59545e-01_r8, & + & 0.52341e-01_r8,0.45178e-01_r8,0.38243e-01_r8,0.30364e-01_r8 /) + kao(:, 5,11,12) = (/ & + & 0.85874e-01_r8,0.77597e-01_r8,0.72138e-01_r8,0.67497e-01_r8,0.61709e-01_r8, & + & 0.55855e-01_r8,0.49191e-01_r8,0.42789e-01_r8,0.33235e-01_r8 /) + kao(:, 1,12,12) = (/ & + & 0.87248e-01_r8,0.76929e-01_r8,0.68689e-01_r8,0.62001e-01_r8,0.55189e-01_r8, & + & 0.46282e-01_r8,0.37018e-01_r8,0.26535e-01_r8,0.20617e-01_r8 /) + kao(:, 2,12,12) = (/ & + & 0.86938e-01_r8,0.76894e-01_r8,0.69591e-01_r8,0.63473e-01_r8,0.56879e-01_r8, & + & 0.48866e-01_r8,0.39681e-01_r8,0.29869e-01_r8,0.23753e-01_r8 /) + kao(:, 3,12,12) = (/ & + & 0.86505e-01_r8,0.76936e-01_r8,0.70473e-01_r8,0.65213e-01_r8,0.59161e-01_r8, & + & 0.51227e-01_r8,0.42751e-01_r8,0.34068e-01_r8,0.28028e-01_r8 /) + kao(:, 4,12,12) = (/ & + & 0.86014e-01_r8,0.77389e-01_r8,0.71734e-01_r8,0.67391e-01_r8,0.61041e-01_r8, & + & 0.54172e-01_r8,0.46740e-01_r8,0.38524e-01_r8,0.33947e-01_r8 /) + kao(:, 5,12,12) = (/ & + & 0.85424e-01_r8,0.77682e-01_r8,0.73622e-01_r8,0.69056e-01_r8,0.63676e-01_r8, & + & 0.57877e-01_r8,0.50578e-01_r8,0.43087e-01_r8,0.36933e-01_r8 /) + kao(:, 1,13,12) = (/ & + & 0.85419e-01_r8,0.75627e-01_r8,0.68076e-01_r8,0.62306e-01_r8,0.55288e-01_r8, & + & 0.46939e-01_r8,0.37782e-01_r8,0.26869e-01_r8,0.20535e-01_r8 /) + kao(:, 2,13,12) = (/ & + & 0.84985e-01_r8,0.75524e-01_r8,0.69213e-01_r8,0.63729e-01_r8,0.57271e-01_r8, & + & 0.49714e-01_r8,0.40473e-01_r8,0.30181e-01_r8,0.22959e-01_r8 /) + kao(:, 3,13,12) = (/ & + & 0.84529e-01_r8,0.75748e-01_r8,0.70315e-01_r8,0.65749e-01_r8,0.59660e-01_r8, & + & 0.52260e-01_r8,0.43766e-01_r8,0.34359e-01_r8,0.28707e-01_r8 /) + kao(:, 4,13,12) = (/ & + & 0.84038e-01_r8,0.76252e-01_r8,0.71947e-01_r8,0.67890e-01_r8,0.61874e-01_r8, & + & 0.55511e-01_r8,0.47935e-01_r8,0.38594e-01_r8,0.34330e-01_r8 /) + kao(:, 5,13,12) = (/ & + & 0.83450e-01_r8,0.76542e-01_r8,0.73924e-01_r8,0.69752e-01_r8,0.64960e-01_r8, & + & 0.59356e-01_r8,0.51789e-01_r8,0.43079e-01_r8,0.38051e-01_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.68561e-01_r8,0.61393e-01_r8,0.55377e-01_r8,0.48367e-01_r8,0.42682e-01_r8, & + & 0.39908e-01_r8,0.45275e-01_r8,0.51909e-01_r8,0.58629e-01_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.68429e-01_r8,0.62258e-01_r8,0.56444e-01_r8,0.49529e-01_r8,0.45167e-01_r8, & + & 0.45643e-01_r8,0.53469e-01_r8,0.61626e-01_r8,0.69870e-01_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.68224e-01_r8,0.62810e-01_r8,0.57169e-01_r8,0.51186e-01_r8,0.48224e-01_r8, & + & 0.52899e-01_r8,0.62764e-01_r8,0.72521e-01_r8,0.82353e-01_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.67917e-01_r8,0.63314e-01_r8,0.58187e-01_r8,0.53334e-01_r8,0.52038e-01_r8, & + & 0.61434e-01_r8,0.73273e-01_r8,0.84850e-01_r8,0.96479e-01_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.67553e-01_r8,0.63903e-01_r8,0.59193e-01_r8,0.55737e-01_r8,0.58351e-01_r8, & + & 0.71682e-01_r8,0.85665e-01_r8,0.99285e-01_r8,0.11295e+00_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.77509e-01_r8,0.69079e-01_r8,0.62486e-01_r8,0.54626e-01_r8,0.48075e-01_r8, & + & 0.42537e-01_r8,0.44950e-01_r8,0.51477e-01_r8,0.58558e-01_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.77430e-01_r8,0.69950e-01_r8,0.63742e-01_r8,0.55764e-01_r8,0.50627e-01_r8, & + & 0.46853e-01_r8,0.52532e-01_r8,0.60374e-01_r8,0.68733e-01_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.77189e-01_r8,0.70882e-01_r8,0.64573e-01_r8,0.57536e-01_r8,0.53311e-01_r8, & + & 0.52406e-01_r8,0.61244e-01_r8,0.70634e-01_r8,0.80523e-01_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.76847e-01_r8,0.71588e-01_r8,0.65635e-01_r8,0.59928e-01_r8,0.56064e-01_r8, & + & 0.60283e-01_r8,0.71500e-01_r8,0.82577e-01_r8,0.94220e-01_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.76386e-01_r8,0.72289e-01_r8,0.66796e-01_r8,0.62420e-01_r8,0.60016e-01_r8, & + & 0.69350e-01_r8,0.82634e-01_r8,0.95798e-01_r8,0.10925e+00_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.86533e-01_r8,0.76872e-01_r8,0.69252e-01_r8,0.60999e-01_r8,0.53444e-01_r8, & + & 0.46117e-01_r8,0.43982e-01_r8,0.49772e-01_r8,0.56991e-01_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.86412e-01_r8,0.77388e-01_r8,0.71047e-01_r8,0.62031e-01_r8,0.55847e-01_r8, & + & 0.49560e-01_r8,0.50601e-01_r8,0.57831e-01_r8,0.66136e-01_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.86175e-01_r8,0.78253e-01_r8,0.72126e-01_r8,0.63678e-01_r8,0.58875e-01_r8, & + & 0.53556e-01_r8,0.58645e-01_r8,0.67397e-01_r8,0.77181e-01_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.85802e-01_r8,0.79483e-01_r8,0.72991e-01_r8,0.66186e-01_r8,0.61530e-01_r8, & + & 0.59229e-01_r8,0.68328e-01_r8,0.78749e-01_r8,0.90335e-01_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.85328e-01_r8,0.80671e-01_r8,0.74346e-01_r8,0.68871e-01_r8,0.64555e-01_r8, & + & 0.67267e-01_r8,0.79478e-01_r8,0.91684e-01_r8,0.10533e+00_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.95394e-01_r8,0.84557e-01_r8,0.75442e-01_r8,0.67038e-01_r8,0.59073e-01_r8, & + & 0.49886e-01_r8,0.44642e-01_r8,0.48508e-01_r8,0.55658e-01_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.95223e-01_r8,0.84873e-01_r8,0.77588e-01_r8,0.68316e-01_r8,0.60993e-01_r8, & + & 0.53907e-01_r8,0.49824e-01_r8,0.55820e-01_r8,0.64074e-01_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.94965e-01_r8,0.85575e-01_r8,0.79290e-01_r8,0.69694e-01_r8,0.64420e-01_r8, & + & 0.57295e-01_r8,0.56440e-01_r8,0.64306e-01_r8,0.73964e-01_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.94509e-01_r8,0.86370e-01_r8,0.80294e-01_r8,0.72257e-01_r8,0.67415e-01_r8, & + & 0.61388e-01_r8,0.65357e-01_r8,0.74991e-01_r8,0.86332e-01_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.94009e-01_r8,0.87806e-01_r8,0.81595e-01_r8,0.75171e-01_r8,0.70245e-01_r8, & + & 0.67536e-01_r8,0.76274e-01_r8,0.87845e-01_r8,0.10132e+00_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.10343e+00_r8,0.91525e-01_r8,0.80861e-01_r8,0.72378e-01_r8,0.64406e-01_r8, & + & 0.53983e-01_r8,0.47036e-01_r8,0.47125e-01_r8,0.54095e-01_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.10334e+00_r8,0.91907e-01_r8,0.82762e-01_r8,0.74349e-01_r8,0.66049e-01_r8, & + & 0.58213e-01_r8,0.51290e-01_r8,0.53990e-01_r8,0.61913e-01_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.10297e+00_r8,0.92357e-01_r8,0.85393e-01_r8,0.75564e-01_r8,0.69527e-01_r8, & + & 0.62165e-01_r8,0.56265e-01_r8,0.62011e-01_r8,0.71236e-01_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.10256e+00_r8,0.93114e-01_r8,0.87093e-01_r8,0.77935e-01_r8,0.73042e-01_r8, & + & 0.65986e-01_r8,0.63498e-01_r8,0.72109e-01_r8,0.83127e-01_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.10189e+00_r8,0.94299e-01_r8,0.88282e-01_r8,0.81218e-01_r8,0.76035e-01_r8, & + & 0.70876e-01_r8,0.73640e-01_r8,0.84406e-01_r8,0.97393e-01_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.11045e+00_r8,0.97454e-01_r8,0.85408e-01_r8,0.76244e-01_r8,0.68972e-01_r8, & + & 0.58251e-01_r8,0.49930e-01_r8,0.45374e-01_r8,0.51875e-01_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.11019e+00_r8,0.97819e-01_r8,0.87148e-01_r8,0.79069e-01_r8,0.71021e-01_r8, & + & 0.62071e-01_r8,0.54179e-01_r8,0.52124e-01_r8,0.59618e-01_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.10981e+00_r8,0.98088e-01_r8,0.89384e-01_r8,0.81156e-01_r8,0.73973e-01_r8, & + & 0.66762e-01_r8,0.58141e-01_r8,0.59499e-01_r8,0.68391e-01_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.10923e+00_r8,0.98741e-01_r8,0.91856e-01_r8,0.83093e-01_r8,0.78121e-01_r8, & + & 0.70717e-01_r8,0.63590e-01_r8,0.68985e-01_r8,0.79490e-01_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.10855e+00_r8,0.99728e-01_r8,0.93768e-01_r8,0.86485e-01_r8,0.81499e-01_r8, & + & 0.75384e-01_r8,0.71738e-01_r8,0.80634e-01_r8,0.92951e-01_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.11652e+00_r8,0.10245e+00_r8,0.89345e-01_r8,0.79831e-01_r8,0.71546e-01_r8, & + & 0.62110e-01_r8,0.52889e-01_r8,0.43937e-01_r8,0.49094e-01_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.11624e+00_r8,0.10291e+00_r8,0.90769e-01_r8,0.82143e-01_r8,0.74705e-01_r8, & + & 0.65752e-01_r8,0.57383e-01_r8,0.50125e-01_r8,0.56751e-01_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.11594e+00_r8,0.10317e+00_r8,0.92734e-01_r8,0.84722e-01_r8,0.77935e-01_r8, & + & 0.70772e-01_r8,0.61416e-01_r8,0.57153e-01_r8,0.65344e-01_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.11535e+00_r8,0.10356e+00_r8,0.95024e-01_r8,0.87242e-01_r8,0.82357e-01_r8, & + & 0.75212e-01_r8,0.65866e-01_r8,0.66110e-01_r8,0.76048e-01_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.11474e+00_r8,0.10447e+00_r8,0.97059e-01_r8,0.90869e-01_r8,0.86343e-01_r8, & + & 0.79806e-01_r8,0.72467e-01_r8,0.77014e-01_r8,0.88751e-01_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.12265e+00_r8,0.10756e+00_r8,0.93593e-01_r8,0.82964e-01_r8,0.73576e-01_r8, & + & 0.64374e-01_r8,0.55605e-01_r8,0.43559e-01_r8,0.46060e-01_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.12249e+00_r8,0.10812e+00_r8,0.94575e-01_r8,0.84973e-01_r8,0.76683e-01_r8, & + & 0.68823e-01_r8,0.60052e-01_r8,0.49117e-01_r8,0.53798e-01_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.12216e+00_r8,0.10834e+00_r8,0.96338e-01_r8,0.87360e-01_r8,0.80349e-01_r8, & + & 0.74206e-01_r8,0.64654e-01_r8,0.55074e-01_r8,0.62031e-01_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.12168e+00_r8,0.10860e+00_r8,0.98251e-01_r8,0.89888e-01_r8,0.85251e-01_r8, & + & 0.79126e-01_r8,0.69120e-01_r8,0.63252e-01_r8,0.72334e-01_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.12099e+00_r8,0.10931e+00_r8,0.10017e+00_r8,0.93685e-01_r8,0.90048e-01_r8, & + & 0.83711e-01_r8,0.75096e-01_r8,0.73779e-01_r8,0.84712e-01_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.12914e+00_r8,0.11313e+00_r8,0.98462e-01_r8,0.86441e-01_r8,0.75875e-01_r8, & + & 0.66332e-01_r8,0.57013e-01_r8,0.43839e-01_r8,0.42411e-01_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.12911e+00_r8,0.11365e+00_r8,0.99113e-01_r8,0.88386e-01_r8,0.78651e-01_r8, & + & 0.70676e-01_r8,0.61767e-01_r8,0.49076e-01_r8,0.50412e-01_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.12886e+00_r8,0.11401e+00_r8,0.10056e+00_r8,0.90400e-01_r8,0.82030e-01_r8, & + & 0.75969e-01_r8,0.67212e-01_r8,0.54346e-01_r8,0.58598e-01_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.12844e+00_r8,0.11410e+00_r8,0.10221e+00_r8,0.92662e-01_r8,0.86791e-01_r8, & + & 0.81685e-01_r8,0.71813e-01_r8,0.61251e-01_r8,0.68599e-01_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.12781e+00_r8,0.11455e+00_r8,0.10390e+00_r8,0.96184e-01_r8,0.92217e-01_r8, & + & 0.86557e-01_r8,0.77640e-01_r8,0.70636e-01_r8,0.80447e-01_r8 /) + kao(:, 1,10,13) = (/ & + & 0.13661e+00_r8,0.11963e+00_r8,0.10401e+00_r8,0.90612e-01_r8,0.78552e-01_r8, & + & 0.68665e-01_r8,0.58042e-01_r8,0.44182e-01_r8,0.20623e-01_r8 /) + kao(:, 2,10,13) = (/ & + & 0.13663e+00_r8,0.12000e+00_r8,0.10449e+00_r8,0.92427e-01_r8,0.81459e-01_r8, & + & 0.72606e-01_r8,0.62588e-01_r8,0.49634e-01_r8,0.27517e-01_r8 /) + kao(:, 3,10,13) = (/ & + & 0.13648e+00_r8,0.12048e+00_r8,0.10572e+00_r8,0.94344e-01_r8,0.84635e-01_r8, & + & 0.77264e-01_r8,0.68466e-01_r8,0.54964e-01_r8,0.37460e-01_r8 /) + kao(:, 4,10,13) = (/ & + & 0.13615e+00_r8,0.12055e+00_r8,0.10724e+00_r8,0.96538e-01_r8,0.88921e-01_r8, & + & 0.82919e-01_r8,0.73837e-01_r8,0.61121e-01_r8,0.51408e-01_r8 /) + kao(:, 5,10,13) = (/ & + & 0.13560e+00_r8,0.12083e+00_r8,0.10867e+00_r8,0.99719e-01_r8,0.94157e-01_r8, & + & 0.88097e-01_r8,0.79982e-01_r8,0.69630e-01_r8,0.68524e-01_r8 /) + kao(:, 1,11,13) = (/ & + & 0.14486e+00_r8,0.12685e+00_r8,0.11053e+00_r8,0.96215e-01_r8,0.83198e-01_r8, & + & 0.72790e-01_r8,0.60483e-01_r8,0.46368e-01_r8,0.23123e-01_r8 /) + kao(:, 2,11,13) = (/ & + & 0.14497e+00_r8,0.12740e+00_r8,0.11115e+00_r8,0.98058e-01_r8,0.86138e-01_r8, & + & 0.76317e-01_r8,0.65283e-01_r8,0.52226e-01_r8,0.29160e-01_r8 /) + kao(:, 3,11,13) = (/ & + & 0.14473e+00_r8,0.12775e+00_r8,0.11243e+00_r8,0.99891e-01_r8,0.89493e-01_r8, & + & 0.80996e-01_r8,0.71303e-01_r8,0.57950e-01_r8,0.32977e-01_r8 /) + kao(:, 4,11,13) = (/ & + & 0.14430e+00_r8,0.12774e+00_r8,0.11386e+00_r8,0.10223e+00_r8,0.94098e-01_r8, & + & 0.86252e-01_r8,0.77087e-01_r8,0.64785e-01_r8,0.38714e-01_r8 /) + kao(:, 5,11,13) = (/ & + & 0.14365e+00_r8,0.12806e+00_r8,0.11504e+00_r8,0.10578e+00_r8,0.98766e-01_r8, & + & 0.91283e-01_r8,0.84242e-01_r8,0.73581e-01_r8,0.47497e-01_r8 /) + kao(:, 1,12,13) = (/ & + & 0.15269e+00_r8,0.13372e+00_r8,0.11691e+00_r8,0.10167e+00_r8,0.88459e-01_r8, & + & 0.76634e-01_r8,0.62620e-01_r8,0.48153e-01_r8,0.27858e-01_r8 /) + kao(:, 2,12,13) = (/ & + & 0.15257e+00_r8,0.13415e+00_r8,0.11750e+00_r8,0.10380e+00_r8,0.91589e-01_r8, & + & 0.79898e-01_r8,0.67862e-01_r8,0.54271e-01_r8,0.35587e-01_r8 /) + kao(:, 3,12,13) = (/ & + & 0.15233e+00_r8,0.13449e+00_r8,0.11899e+00_r8,0.10589e+00_r8,0.94966e-01_r8, & + & 0.84666e-01_r8,0.73653e-01_r8,0.60551e-01_r8,0.39809e-01_r8 /) + kao(:, 4,12,13) = (/ & + & 0.15175e+00_r8,0.13439e+00_r8,0.12031e+00_r8,0.10854e+00_r8,0.99506e-01_r8, & + & 0.89389e-01_r8,0.79517e-01_r8,0.68401e-01_r8,0.45578e-01_r8 /) + kao(:, 5,12,13) = (/ & + & 0.15105e+00_r8,0.13484e+00_r8,0.12149e+00_r8,0.11242e+00_r8,0.10353e+00_r8, & + & 0.94548e-01_r8,0.87485e-01_r8,0.77323e-01_r8,0.55990e-01_r8 /) + kao(:, 1,13,13) = (/ & + & 0.15929e+00_r8,0.13953e+00_r8,0.12252e+00_r8,0.10682e+00_r8,0.93710e-01_r8, & + & 0.80318e-01_r8,0.64679e-01_r8,0.49483e-01_r8,0.31231e-01_r8 /) + kao(:, 2,13,13) = (/ & + & 0.15914e+00_r8,0.14001e+00_r8,0.12322e+00_r8,0.10931e+00_r8,0.96798e-01_r8, & + & 0.83533e-01_r8,0.70039e-01_r8,0.55928e-01_r8,0.39440e-01_r8 /) + kao(:, 3,13,13) = (/ & + & 0.15875e+00_r8,0.14019e+00_r8,0.12484e+00_r8,0.11161e+00_r8,0.10034e+00_r8, & + & 0.88309e-01_r8,0.75681e-01_r8,0.62757e-01_r8,0.43280e-01_r8 /) + kao(:, 4,13,13) = (/ & + & 0.15815e+00_r8,0.14019e+00_r8,0.12619e+00_r8,0.11467e+00_r8,0.10492e+00_r8, & + & 0.92849e-01_r8,0.81796e-01_r8,0.71221e-01_r8,0.50343e-01_r8 /) + kao(:, 5,13,13) = (/ & + & 0.15737e+00_r8,0.14077e+00_r8,0.12756e+00_r8,0.11888e+00_r8,0.10868e+00_r8, & + & 0.98192e-01_r8,0.90106e-01_r8,0.80417e-01_r8,0.60332e-01_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.83965e-01_r8,0.74725e-01_r8,0.67262e-01_r8,0.61439e-01_r8,0.63569e-01_r8, & + & 0.76568e-01_r8,0.91505e-01_r8,0.10604e+00_r8,0.12066e+00_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.84124e-01_r8,0.75639e-01_r8,0.69121e-01_r8,0.66761e-01_r8,0.75177e-01_r8, & + & 0.93190e-01_r8,0.11140e+00_r8,0.12912e+00_r8,0.14697e+00_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.84208e-01_r8,0.76821e-01_r8,0.71401e-01_r8,0.74638e-01_r8,0.90938e-01_r8, & + & 0.11330e+00_r8,0.13555e+00_r8,0.15732e+00_r8,0.17919e+00_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.84082e-01_r8,0.77722e-01_r8,0.74753e-01_r8,0.85505e-01_r8,0.11037e+00_r8, & + & 0.13754e+00_r8,0.16460e+00_r8,0.19114e+00_r8,0.21779e+00_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.83810e-01_r8,0.78431e-01_r8,0.79767e-01_r8,0.99722e-01_r8,0.13195e+00_r8, & + & 0.16448e+00_r8,0.19691e+00_r8,0.22867e+00_r8,0.26057e+00_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.98728e-01_r8,0.87584e-01_r8,0.78635e-01_r8,0.69559e-01_r8,0.65625e-01_r8, & + & 0.74022e-01_r8,0.88098e-01_r8,0.10177e+00_r8,0.11620e+00_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.98895e-01_r8,0.88195e-01_r8,0.80583e-01_r8,0.73010e-01_r8,0.73981e-01_r8, & + & 0.89007e-01_r8,0.10638e+00_r8,0.12319e+00_r8,0.14079e+00_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.98911e-01_r8,0.89265e-01_r8,0.82581e-01_r8,0.78421e-01_r8,0.87111e-01_r8, & + & 0.10783e+00_r8,0.12893e+00_r8,0.14951e+00_r8,0.17084e+00_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.98795e-01_r8,0.90737e-01_r8,0.84451e-01_r8,0.86623e-01_r8,0.10466e+00_r8, & + & 0.13034e+00_r8,0.15592e+00_r8,0.18094e+00_r8,0.20669e+00_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.98517e-01_r8,0.92027e-01_r8,0.87783e-01_r8,0.98306e-01_r8,0.12592e+00_r8, & + & 0.15706e+00_r8,0.18794e+00_r8,0.21816e+00_r8,0.24934e+00_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.11536e+00_r8,0.10204e+00_r8,0.91076e-01_r8,0.79879e-01_r8,0.70411e-01_r8, & + & 0.71590e-01_r8,0.83610e-01_r8,0.96241e-01_r8,0.11049e+00_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.11565e+00_r8,0.10277e+00_r8,0.93049e-01_r8,0.82303e-01_r8,0.75267e-01_r8, & + & 0.83499e-01_r8,0.99323e-01_r8,0.11472e+00_r8,0.13181e+00_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.11566e+00_r8,0.10353e+00_r8,0.95697e-01_r8,0.85227e-01_r8,0.84157e-01_r8, & + & 0.99917e-01_r8,0.11933e+00_r8,0.13815e+00_r8,0.15865e+00_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.11554e+00_r8,0.10447e+00_r8,0.97554e-01_r8,0.90504e-01_r8,0.97960e-01_r8, & + & 0.12029e+00_r8,0.14386e+00_r8,0.16671e+00_r8,0.19135e+00_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.11515e+00_r8,0.10586e+00_r8,0.99141e-01_r8,0.99110e-01_r8,0.11626e+00_r8, & + & 0.14432e+00_r8,0.17265e+00_r8,0.20040e+00_r8,0.22976e+00_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.13374e+00_r8,0.11777e+00_r8,0.10356e+00_r8,0.90948e-01_r8,0.79121e-01_r8, & + & 0.73845e-01_r8,0.80790e-01_r8,0.92777e-01_r8,0.10713e+00_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.13413e+00_r8,0.11892e+00_r8,0.10607e+00_r8,0.94460e-01_r8,0.81628e-01_r8, & + & 0.80960e-01_r8,0.93972e-01_r8,0.10817e+00_r8,0.12489e+00_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.13429e+00_r8,0.11957e+00_r8,0.10936e+00_r8,0.96737e-01_r8,0.86452e-01_r8, & + & 0.93977e-01_r8,0.11135e+00_r8,0.12854e+00_r8,0.14815e+00_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.13415e+00_r8,0.12054e+00_r8,0.11264e+00_r8,0.99496e-01_r8,0.96100e-01_r8, & + & 0.11145e+00_r8,0.13299e+00_r8,0.15385e+00_r8,0.17718e+00_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.13374e+00_r8,0.12142e+00_r8,0.11440e+00_r8,0.10500e+00_r8,0.11046e+00_r8, & + & 0.13295e+00_r8,0.15886e+00_r8,0.18424e+00_r8,0.21188e+00_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.15386e+00_r8,0.13491e+00_r8,0.11798e+00_r8,0.10225e+00_r8,0.89703e-01_r8, & + & 0.79220e-01_r8,0.79340e-01_r8,0.90595e-01_r8,0.10482e+00_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.15427e+00_r8,0.13635e+00_r8,0.12030e+00_r8,0.10668e+00_r8,0.92323e-01_r8, & + & 0.84157e-01_r8,0.91777e-01_r8,0.10537e+00_r8,0.12216e+00_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.15452e+00_r8,0.13729e+00_r8,0.12299e+00_r8,0.11079e+00_r8,0.94730e-01_r8, & + & 0.92840e-01_r8,0.10677e+00_r8,0.12287e+00_r8,0.14246e+00_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.15437e+00_r8,0.13801e+00_r8,0.12683e+00_r8,0.11313e+00_r8,0.10059e+00_r8, & + & 0.10648e+00_r8,0.12562e+00_r8,0.14488e+00_r8,0.16770e+00_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.15403e+00_r8,0.13896e+00_r8,0.13053e+00_r8,0.11647e+00_r8,0.11129e+00_r8, & + & 0.12495e+00_r8,0.14877e+00_r8,0.17193e+00_r8,0.19866e+00_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.17516e+00_r8,0.15332e+00_r8,0.13386e+00_r8,0.11461e+00_r8,0.98998e-01_r8, & + & 0.86199e-01_r8,0.78839e-01_r8,0.88239e-01_r8,0.10212e+00_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.17578e+00_r8,0.15465e+00_r8,0.13554e+00_r8,0.11810e+00_r8,0.10372e+00_r8, & + & 0.90966e-01_r8,0.90397e-01_r8,0.10318e+00_r8,0.11979e+00_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.17603e+00_r8,0.15606e+00_r8,0.13830e+00_r8,0.12297e+00_r8,0.10694e+00_r8, & + & 0.96886e-01_r8,0.10455e+00_r8,0.12004e+00_r8,0.13936e+00_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.17594e+00_r8,0.15671e+00_r8,0.14175e+00_r8,0.12765e+00_r8,0.11049e+00_r8, & + & 0.10701e+00_r8,0.12142e+00_r8,0.13971e+00_r8,0.16228e+00_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.17559e+00_r8,0.15762e+00_r8,0.14567e+00_r8,0.13124e+00_r8,0.11784e+00_r8, & + & 0.12121e+00_r8,0.14182e+00_r8,0.16360e+00_r8,0.18966e+00_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.19714e+00_r8,0.17254e+00_r8,0.15016e+00_r8,0.12718e+00_r8,0.10949e+00_r8, & + & 0.93814e-01_r8,0.79465e-01_r8,0.85103e-01_r8,0.98359e-01_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.19796e+00_r8,0.17362e+00_r8,0.15183e+00_r8,0.13102e+00_r8,0.11370e+00_r8, & + & 0.99479e-01_r8,0.90483e-01_r8,0.10125e+00_r8,0.11726e+00_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.19829e+00_r8,0.17522e+00_r8,0.15424e+00_r8,0.13545e+00_r8,0.11863e+00_r8, & + & 0.10457e+00_r8,0.10363e+00_r8,0.11810e+00_r8,0.13724e+00_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.19826e+00_r8,0.17625e+00_r8,0.15748e+00_r8,0.14049e+00_r8,0.12307e+00_r8, & + & 0.11254e+00_r8,0.11942e+00_r8,0.13698e+00_r8,0.15920e+00_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.19780e+00_r8,0.17685e+00_r8,0.16171e+00_r8,0.14510e+00_r8,0.12933e+00_r8, & + & 0.12368e+00_r8,0.13790e+00_r8,0.15875e+00_r8,0.18443e+00_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.21950e+00_r8,0.19210e+00_r8,0.16641e+00_r8,0.14074e+00_r8,0.12030e+00_r8, & + & 0.10245e+00_r8,0.82539e-01_r8,0.82181e-01_r8,0.95126e-01_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.22029e+00_r8,0.19287e+00_r8,0.16845e+00_r8,0.14392e+00_r8,0.12476e+00_r8, & + & 0.10750e+00_r8,0.92052e-01_r8,0.97622e-01_r8,0.11306e+00_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.22070e+00_r8,0.19423e+00_r8,0.17032e+00_r8,0.14847e+00_r8,0.12971e+00_r8, & + & 0.11297e+00_r8,0.10375e+00_r8,0.11522e+00_r8,0.13338e+00_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.22058e+00_r8,0.19569e+00_r8,0.17355e+00_r8,0.15354e+00_r8,0.13473e+00_r8, & + & 0.12044e+00_r8,0.11859e+00_r8,0.13469e+00_r8,0.15609e+00_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.22021e+00_r8,0.19640e+00_r8,0.17762e+00_r8,0.15857e+00_r8,0.14102e+00_r8, & + & 0.13035e+00_r8,0.13566e+00_r8,0.15573e+00_r8,0.18054e+00_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.24109e+00_r8,0.21099e+00_r8,0.18179e+00_r8,0.15454e+00_r8,0.13112e+00_r8, & + & 0.11092e+00_r8,0.89296e-01_r8,0.80506e-01_r8,0.93157e-01_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.24188e+00_r8,0.21170e+00_r8,0.18440e+00_r8,0.15693e+00_r8,0.13589e+00_r8, & + & 0.11596e+00_r8,0.96808e-01_r8,0.94330e-01_r8,0.10941e+00_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.24228e+00_r8,0.21270e+00_r8,0.18618e+00_r8,0.16137e+00_r8,0.14099e+00_r8, & + & 0.12182e+00_r8,0.10601e+00_r8,0.11139e+00_r8,0.12901e+00_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.24222e+00_r8,0.21416e+00_r8,0.18881e+00_r8,0.16653e+00_r8,0.14643e+00_r8, & + & 0.12886e+00_r8,0.11898e+00_r8,0.13037e+00_r8,0.15086e+00_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.24175e+00_r8,0.21527e+00_r8,0.19303e+00_r8,0.17188e+00_r8,0.15251e+00_r8, & + & 0.13886e+00_r8,0.13479e+00_r8,0.15182e+00_r8,0.17551e+00_r8 /) + kao(:, 1,10,14) = (/ & + & 0.26096e+00_r8,0.22837e+00_r8,0.19625e+00_r8,0.16743e+00_r8,0.14218e+00_r8, & + & 0.11905e+00_r8,0.97365e-01_r8,0.81466e-01_r8,0.86743e-01_r8 /) + kao(:, 2,10,14) = (/ & + & 0.26197e+00_r8,0.22928e+00_r8,0.19902e+00_r8,0.16970e+00_r8,0.14641e+00_r8, & + & 0.12483e+00_r8,0.10472e+00_r8,0.93843e-01_r8,0.10806e+00_r8 /) + kao(:, 3,10,14) = (/ & + & 0.26221e+00_r8,0.22989e+00_r8,0.20102e+00_r8,0.17345e+00_r8,0.15221e+00_r8, & + & 0.13116e+00_r8,0.11273e+00_r8,0.10943e+00_r8,0.12658e+00_r8 /) + kao(:, 4,10,14) = (/ & + & 0.26216e+00_r8,0.23120e+00_r8,0.20343e+00_r8,0.17903e+00_r8,0.15795e+00_r8, & + & 0.13876e+00_r8,0.12342e+00_r8,0.12756e+00_r8,0.14743e+00_r8 /) + kao(:, 5,10,14) = (/ & + & 0.26155e+00_r8,0.23254e+00_r8,0.20744e+00_r8,0.18479e+00_r8,0.16453e+00_r8, & + & 0.14894e+00_r8,0.13716e+00_r8,0.14827e+00_r8,0.17117e+00_r8 /) + kao(:, 1,11,14) = (/ & + & 0.28000e+00_r8,0.24504e+00_r8,0.21069e+00_r8,0.18024e+00_r8,0.15374e+00_r8, & + & 0.12937e+00_r8,0.10819e+00_r8,0.88668e-01_r8,0.55926e-01_r8 /) + kao(:, 2,11,14) = (/ & + & 0.28047e+00_r8,0.24546e+00_r8,0.21318e+00_r8,0.18272e+00_r8,0.15865e+00_r8, & + & 0.13663e+00_r8,0.11594e+00_r8,0.10024e+00_r8,0.74129e-01_r8 /) + kao(:, 3,11,14) = (/ & + & 0.28078e+00_r8,0.24627e+00_r8,0.21537e+00_r8,0.18699e+00_r8,0.16514e+00_r8, & + & 0.14391e+00_r8,0.12463e+00_r8,0.11566e+00_r8,0.10008e+00_r8 /) + kao(:, 4,11,14) = (/ & + & 0.28041e+00_r8,0.24739e+00_r8,0.21799e+00_r8,0.19316e+00_r8,0.17153e+00_r8, & + & 0.15296e+00_r8,0.13573e+00_r8,0.13384e+00_r8,0.12903e+00_r8 /) + kao(:, 5,11,14) = (/ & + & 0.27974e+00_r8,0.24878e+00_r8,0.22235e+00_r8,0.19924e+00_r8,0.17976e+00_r8, & + & 0.16447e+00_r8,0.14857e+00_r8,0.15437e+00_r8,0.16255e+00_r8 /) + kao(:, 1,12,14) = (/ & + & 0.29848e+00_r8,0.26121e+00_r8,0.22470e+00_r8,0.19300e+00_r8,0.16476e+00_r8, & + & 0.13979e+00_r8,0.11858e+00_r8,0.95361e-01_r8,0.54706e-01_r8 /) + kao(:, 2,12,14) = (/ & + & 0.29901e+00_r8,0.26167e+00_r8,0.22733e+00_r8,0.19555e+00_r8,0.17000e+00_r8, & + & 0.14834e+00_r8,0.12686e+00_r8,0.10640e+00_r8,0.56924e-01_r8 /) + kao(:, 3,12,14) = (/ & + & 0.29886e+00_r8,0.26222e+00_r8,0.22932e+00_r8,0.20008e+00_r8,0.17736e+00_r8, & + & 0.15653e+00_r8,0.13669e+00_r8,0.12173e+00_r8,0.76097e-01_r8 /) + kao(:, 4,12,14) = (/ & + & 0.29840e+00_r8,0.26333e+00_r8,0.23210e+00_r8,0.20641e+00_r8,0.18472e+00_r8, & + & 0.16716e+00_r8,0.14883e+00_r8,0.13980e+00_r8,0.10268e+00_r8 /) + kao(:, 5,12,14) = (/ & + & 0.29738e+00_r8,0.26451e+00_r8,0.23656e+00_r8,0.21275e+00_r8,0.19460e+00_r8, & + & 0.18005e+00_r8,0.16102e+00_r8,0.16046e+00_r8,0.13219e+00_r8 /) + kao(:, 1,13,14) = (/ & + & 0.31629e+00_r8,0.27681e+00_r8,0.23838e+00_r8,0.20550e+00_r8,0.17561e+00_r8, & + & 0.15005e+00_r8,0.12855e+00_r8,0.10141e+00_r8,0.58394e-01_r8 /) + kao(:, 2,13,14) = (/ & + & 0.31664e+00_r8,0.27713e+00_r8,0.24100e+00_r8,0.20827e+00_r8,0.18155e+00_r8, & + & 0.15952e+00_r8,0.13765e+00_r8,0.11247e+00_r8,0.60995e-01_r8 /) + kao(:, 3,13,14) = (/ & + & 0.31646e+00_r8,0.27774e+00_r8,0.24298e+00_r8,0.21292e+00_r8,0.18963e+00_r8, & + & 0.16861e+00_r8,0.14853e+00_r8,0.12785e+00_r8,0.75808e-01_r8 /) + kao(:, 4,13,14) = (/ & + & 0.31577e+00_r8,0.27872e+00_r8,0.24590e+00_r8,0.21953e+00_r8,0.19753e+00_r8, & + & 0.18064e+00_r8,0.16179e+00_r8,0.14607e+00_r8,0.10217e+00_r8 /) + kao(:, 5,13,14) = (/ & + & 0.31458e+00_r8,0.27978e+00_r8,0.25030e+00_r8,0.22598e+00_r8,0.20858e+00_r8, & + & 0.19488e+00_r8,0.17415e+00_r8,0.16696e+00_r8,0.13138e+00_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.94898e-01_r8,0.85055e-01_r8,0.10490e+00_r8,0.15201e+00_r8,0.20225e+00_r8, & + & 0.25227e+00_r8,0.30184e+00_r8,0.34935e+00_r8,0.39726e+00_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.95143e-01_r8,0.87211e-01_r8,0.12685e+00_r8,0.18956e+00_r8,0.25226e+00_r8, & + & 0.31465e+00_r8,0.37635e+00_r8,0.43547e+00_r8,0.49508e+00_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.95189e-01_r8,0.92182e-01_r8,0.15432e+00_r8,0.23093e+00_r8,0.30732e+00_r8, & + & 0.38333e+00_r8,0.45850e+00_r8,0.53039e+00_r8,0.60271e+00_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.95231e-01_r8,0.10069e+00_r8,0.18420e+00_r8,0.27567e+00_r8,0.36689e+00_r8, & + & 0.45778e+00_r8,0.54750e+00_r8,0.63309e+00_r8,0.71941e+00_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.95218e-01_r8,0.11224e+00_r8,0.21607e+00_r8,0.32340e+00_r8,0.43052e+00_r8, & + & 0.53710e+00_r8,0.64228e+00_r8,0.74267e+00_r8,0.84389e+00_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.11396e+00_r8,0.10141e+00_r8,0.10674e+00_r8,0.14459e+00_r8,0.19233e+00_r8, & + & 0.23999e+00_r8,0.28714e+00_r8,0.33260e+00_r8,0.38043e+00_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.11432e+00_r8,0.10261e+00_r8,0.12520e+00_r8,0.18276e+00_r8,0.24324e+00_r8, & + & 0.30342e+00_r8,0.36297e+00_r8,0.42016e+00_r8,0.48074e+00_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.11451e+00_r8,0.10490e+00_r8,0.15054e+00_r8,0.22514e+00_r8,0.29969e+00_r8, & + & 0.37388e+00_r8,0.44723e+00_r8,0.51774e+00_r8,0.59231e+00_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.11456e+00_r8,0.10971e+00_r8,0.18129e+00_r8,0.27136e+00_r8,0.36114e+00_r8, & + & 0.45069e+00_r8,0.53922e+00_r8,0.62384e+00_r8,0.71399e+00_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.11453e+00_r8,0.11800e+00_r8,0.21439e+00_r8,0.32093e+00_r8,0.42721e+00_r8, & + & 0.53302e+00_r8,0.63780e+00_r8,0.73784e+00_r8,0.84437e+00_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.13655e+00_r8,0.12054e+00_r8,0.11124e+00_r8,0.13153e+00_r8,0.17207e+00_r8, & + & 0.21470e+00_r8,0.25693e+00_r8,0.29779e+00_r8,0.34231e+00_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.13707e+00_r8,0.12216e+00_r8,0.12413e+00_r8,0.16670e+00_r8,0.22186e+00_r8, & + & 0.27683e+00_r8,0.33137e+00_r8,0.38384e+00_r8,0.44145e+00_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.13747e+00_r8,0.12319e+00_r8,0.14360e+00_r8,0.20888e+00_r8,0.27797e+00_r8, & + & 0.34687e+00_r8,0.41517e+00_r8,0.48101e+00_r8,0.55322e+00_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.13768e+00_r8,0.12546e+00_r8,0.17113e+00_r8,0.25534e+00_r8,0.33989e+00_r8, & + & 0.42417e+00_r8,0.50744e+00_r8,0.58796e+00_r8,0.67649e+00_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.13772e+00_r8,0.12983e+00_r8,0.20407e+00_r8,0.30559e+00_r8,0.40688e+00_r8, & + & 0.50779e+00_r8,0.60773e+00_r8,0.70383e+00_r8,0.80998e+00_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.16353e+00_r8,0.14321e+00_r8,0.12667e+00_r8,0.12562e+00_r8,0.14945e+00_r8, & + & 0.18589e+00_r8,0.22262e+00_r8,0.25813e+00_r8,0.29728e+00_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.16418e+00_r8,0.14525e+00_r8,0.13251e+00_r8,0.15131e+00_r8,0.19654e+00_r8, & + & 0.24525e+00_r8,0.29354e+00_r8,0.34060e+00_r8,0.39212e+00_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.16461e+00_r8,0.14670e+00_r8,0.14414e+00_r8,0.18897e+00_r8,0.25116e+00_r8, & + & 0.31348e+00_r8,0.37525e+00_r8,0.43507e+00_r8,0.50121e+00_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.16491e+00_r8,0.14777e+00_r8,0.16361e+00_r8,0.23441e+00_r8,0.31211e+00_r8, & + & 0.38952e+00_r8,0.46648e+00_r8,0.54097e+00_r8,0.62321e+00_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.16511e+00_r8,0.15008e+00_r8,0.19240e+00_r8,0.28461e+00_r8,0.37902e+00_r8, & + & 0.47310e+00_r8,0.56644e+00_r8,0.65651e+00_r8,0.75672e+00_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.19509e+00_r8,0.17082e+00_r8,0.14980e+00_r8,0.13204e+00_r8,0.13395e+00_r8, & + & 0.16269e+00_r8,0.19465e+00_r8,0.22562e+00_r8,0.26041e+00_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.19619e+00_r8,0.17214e+00_r8,0.15205e+00_r8,0.14710e+00_r8,0.17263e+00_r8, & + & 0.21401e+00_r8,0.25633e+00_r8,0.29729e+00_r8,0.34247e+00_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.19681e+00_r8,0.17444e+00_r8,0.15815e+00_r8,0.17421e+00_r8,0.22342e+00_r8, & + & 0.27889e+00_r8,0.33405e+00_r8,0.38778e+00_r8,0.44627e+00_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.19721e+00_r8,0.17581e+00_r8,0.16979e+00_r8,0.21414e+00_r8,0.28278e+00_r8, & + & 0.35302e+00_r8,0.42274e+00_r8,0.49080e+00_r8,0.56501e+00_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.19732e+00_r8,0.17699e+00_r8,0.18956e+00_r8,0.26168e+00_r8,0.34842e+00_r8, & + & 0.43503e+00_r8,0.52113e+00_r8,0.60494e+00_r8,0.69634e+00_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.23167e+00_r8,0.20281e+00_r8,0.17680e+00_r8,0.14997e+00_r8,0.13324e+00_r8, & + & 0.14585e+00_r8,0.17450e+00_r8,0.20194e+00_r8,0.23383e+00_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.23317e+00_r8,0.20416e+00_r8,0.17934e+00_r8,0.15819e+00_r8,0.15707e+00_r8, & + & 0.18679e+00_r8,0.22357e+00_r8,0.25924e+00_r8,0.29921e+00_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.23428e+00_r8,0.20631e+00_r8,0.18228e+00_r8,0.17432e+00_r8,0.19753e+00_r8, & + & 0.24343e+00_r8,0.29156e+00_r8,0.33836e+00_r8,0.38981e+00_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.23494e+00_r8,0.20857e+00_r8,0.18851e+00_r8,0.20211e+00_r8,0.25104e+00_r8, & + & 0.31278e+00_r8,0.37475e+00_r8,0.43549e+00_r8,0.50069e+00_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.23514e+00_r8,0.20988e+00_r8,0.20063e+00_r8,0.24116e+00_r8,0.31413e+00_r8, & + & 0.39227e+00_r8,0.47006e+00_r8,0.54611e+00_r8,0.62816e+00_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.27443e+00_r8,0.24019e+00_r8,0.20758e+00_r8,0.17610e+00_r8,0.14566e+00_r8, & + & 0.14000e+00_r8,0.16506e+00_r8,0.19019e+00_r8,0.22128e+00_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.27620e+00_r8,0.24179e+00_r8,0.21121e+00_r8,0.17965e+00_r8,0.15984e+00_r8, & + & 0.16864e+00_r8,0.20104e+00_r8,0.23213e+00_r8,0.26949e+00_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.27747e+00_r8,0.24292e+00_r8,0.21364e+00_r8,0.18907e+00_r8,0.18625e+00_r8, & + & 0.21432e+00_r8,0.25652e+00_r8,0.29760e+00_r8,0.34338e+00_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.27840e+00_r8,0.24591e+00_r8,0.21750e+00_r8,0.20704e+00_r8,0.22722e+00_r8, & + & 0.27512e+00_r8,0.32963e+00_r8,0.38304e+00_r8,0.44058e+00_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.27872e+00_r8,0.24790e+00_r8,0.22377e+00_r8,0.23568e+00_r8,0.28140e+00_r8, & + & 0.34919e+00_r8,0.41848e+00_r8,0.48672e+00_r8,0.55917e+00_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.32341e+00_r8,0.28305e+00_r8,0.24270e+00_r8,0.20626e+00_r8,0.16778e+00_r8, & + & 0.14644e+00_r8,0.16206e+00_r8,0.18656e+00_r8,0.21702e+00_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.32568e+00_r8,0.28506e+00_r8,0.24756e+00_r8,0.20963e+00_r8,0.17522e+00_r8, & + & 0.16516e+00_r8,0.19045e+00_r8,0.21956e+00_r8,0.25530e+00_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.32734e+00_r8,0.28654e+00_r8,0.25088e+00_r8,0.21479e+00_r8,0.19195e+00_r8, & + & 0.19819e+00_r8,0.23472e+00_r8,0.27107e+00_r8,0.31461e+00_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.32837e+00_r8,0.28793e+00_r8,0.25332e+00_r8,0.22544e+00_r8,0.22100e+00_r8, & + & 0.24722e+00_r8,0.29529e+00_r8,0.34210e+00_r8,0.39526e+00_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.32863e+00_r8,0.29096e+00_r8,0.25794e+00_r8,0.24543e+00_r8,0.26342e+00_r8, & + & 0.31218e+00_r8,0.37382e+00_r8,0.43401e+00_r8,0.50027e+00_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.37878e+00_r8,0.33149e+00_r8,0.28420e+00_r8,0.23973e+00_r8,0.19541e+00_r8, & + & 0.16103e+00_r8,0.16029e+00_r8,0.18365e+00_r8,0.21308e+00_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.38160e+00_r8,0.33397e+00_r8,0.28731e+00_r8,0.24432e+00_r8,0.19953e+00_r8, & + & 0.17386e+00_r8,0.18539e+00_r8,0.21378e+00_r8,0.24833e+00_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.38370e+00_r8,0.33584e+00_r8,0.29267e+00_r8,0.24777e+00_r8,0.20961e+00_r8, & + & 0.19622e+00_r8,0.22137e+00_r8,0.25542e+00_r8,0.29676e+00_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.38483e+00_r8,0.33686e+00_r8,0.29593e+00_r8,0.25505e+00_r8,0.22908e+00_r8, & + & 0.23318e+00_r8,0.27287e+00_r8,0.31549e+00_r8,0.36559e+00_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.38520e+00_r8,0.33870e+00_r8,0.29863e+00_r8,0.26759e+00_r8,0.26094e+00_r8, & + & 0.28563e+00_r8,0.34036e+00_r8,0.39396e+00_r8,0.45596e+00_r8 /) + kao(:, 1,10,15) = (/ & + & 0.44139e+00_r8,0.38627e+00_r8,0.33114e+00_r8,0.27661e+00_r8,0.22671e+00_r8, & + & 0.18314e+00_r8,0.16439e+00_r8,0.18365e+00_r8,0.21302e+00_r8 /) + kao(:, 2,10,15) = (/ & + & 0.44442e+00_r8,0.38894e+00_r8,0.33346e+00_r8,0.28317e+00_r8,0.23077e+00_r8, & + & 0.19173e+00_r8,0.18540e+00_r8,0.21159e+00_r8,0.24601e+00_r8 /) + kao(:, 3,10,15) = (/ & + & 0.44688e+00_r8,0.39111e+00_r8,0.33884e+00_r8,0.28735e+00_r8,0.23759e+00_r8, & + & 0.20864e+00_r8,0.21693e+00_r8,0.24969e+00_r8,0.29058e+00_r8 /) + kao(:, 4,10,15) = (/ & + & 0.44794e+00_r8,0.39207e+00_r8,0.34326e+00_r8,0.29193e+00_r8,0.25105e+00_r8, & + & 0.23562e+00_r8,0.26192e+00_r8,0.30247e+00_r8,0.35138e+00_r8 /) + kao(:, 5,10,15) = (/ & + & 0.44820e+00_r8,0.39253e+00_r8,0.34576e+00_r8,0.30181e+00_r8,0.27401e+00_r8, & + & 0.27758e+00_r8,0.32230e+00_r8,0.37259e+00_r8,0.43225e+00_r8 /) + kao(:, 1,11,15) = (/ & + & 0.51225e+00_r8,0.44827e+00_r8,0.38430e+00_r8,0.32096e+00_r8,0.26380e+00_r8, & + & 0.21204e+00_r8,0.18122e+00_r8,0.19575e+00_r8,0.22762e+00_r8 /) + kao(:, 2,11,15) = (/ & + & 0.51551e+00_r8,0.45114e+00_r8,0.38677e+00_r8,0.32842e+00_r8,0.26803e+00_r8, & + & 0.22031e+00_r8,0.20295e+00_r8,0.22783e+00_r8,0.26563e+00_r8 /) + kao(:, 3,11,15) = (/ & + & 0.51720e+00_r8,0.45265e+00_r8,0.39154e+00_r8,0.33278e+00_r8,0.27451e+00_r8, & + & 0.23732e+00_r8,0.23493e+00_r8,0.26904e+00_r8,0.31377e+00_r8 /) + kao(:, 4,11,15) = (/ & + & 0.51766e+00_r8,0.45307e+00_r8,0.39664e+00_r8,0.33683e+00_r8,0.28805e+00_r8, & + & 0.26198e+00_r8,0.27963e+00_r8,0.32252e+00_r8,0.37505e+00_r8 /) + kao(:, 5,11,15) = (/ & + & 0.51687e+00_r8,0.45253e+00_r8,0.39906e+00_r8,0.34713e+00_r8,0.30874e+00_r8, & + & 0.30122e+00_r8,0.34231e+00_r8,0.39543e+00_r8,0.45934e+00_r8 /) + kao(:, 1,12,15) = (/ & + & 0.58922e+00_r8,0.51562e+00_r8,0.44203e+00_r8,0.36905e+00_r8,0.30406e+00_r8, & + & 0.24465e+00_r8,0.20183e+00_r8,0.21102e+00_r8,0.20343e+00_r8 /) + kao(:, 2,12,15) = (/ & + & 0.59167e+00_r8,0.51780e+00_r8,0.44391e+00_r8,0.37709e+00_r8,0.30888e+00_r8, & + & 0.25236e+00_r8,0.22396e+00_r8,0.24700e+00_r8,0.27515e+00_r8 /) + kao(:, 3,12,15) = (/ & + & 0.59289e+00_r8,0.51887e+00_r8,0.44833e+00_r8,0.38190e+00_r8,0.31478e+00_r8, & + & 0.26966e+00_r8,0.25708e+00_r8,0.29183e+00_r8,0.34036e+00_r8 /) + kao(:, 4,12,15) = (/ & + & 0.59238e+00_r8,0.51846e+00_r8,0.45409e+00_r8,0.38554e+00_r8,0.32896e+00_r8, & + & 0.29236e+00_r8,0.30023e+00_r8,0.34558e+00_r8,0.40217e+00_r8 /) + kao(:, 5,12,15) = (/ & + & 0.59040e+00_r8,0.51681e+00_r8,0.45607e+00_r8,0.39582e+00_r8,0.34740e+00_r8, & + & 0.32863e+00_r8,0.36471e+00_r8,0.42134e+00_r8,0.48947e+00_r8 /) + kao(:, 1,13,15) = (/ & + & 0.67101e+00_r8,0.58718e+00_r8,0.50336e+00_r8,0.42031e+00_r8,0.34716e+00_r8, & + & 0.27980e+00_r8,0.22553e+00_r8,0.22887e+00_r8,0.21243e+00_r8 /) + kao(:, 2,13,15) = (/ & + & 0.67268e+00_r8,0.58864e+00_r8,0.50464e+00_r8,0.42832e+00_r8,0.35207e+00_r8, & + & 0.28740e+00_r8,0.24801e+00_r8,0.26765e+00_r8,0.28879e+00_r8 /) + kao(:, 3,13,15) = (/ & + & 0.67256e+00_r8,0.58859e+00_r8,0.50813e+00_r8,0.43372e+00_r8,0.35764e+00_r8, & + & 0.30459e+00_r8,0.28195e+00_r8,0.31558e+00_r8,0.36763e+00_r8 /) + kao(:, 4,13,15) = (/ & + & 0.67050e+00_r8,0.58682e+00_r8,0.51379e+00_r8,0.43676e+00_r8,0.37243e+00_r8, & + & 0.32590e+00_r8,0.32370e+00_r8,0.37117e+00_r8,0.43203e+00_r8 /) + kao(:, 5,13,15) = (/ & + & 0.66719e+00_r8,0.58400e+00_r8,0.51581e+00_r8,0.44632e+00_r8,0.38956e+00_r8, & + & 0.35928e+00_r8,0.38845e+00_r8,0.44876e+00_r8,0.52114e+00_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.10138e+00_r8,0.11271e+00_r8,0.22512e+00_r8,0.33705e+00_r8,0.44854e+00_r8, & + & 0.55854e+00_r8,0.66519e+00_r8,0.75942e+00_r8,0.85612e+00_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.10145e+00_r8,0.13913e+00_r8,0.27783e+00_r8,0.41606e+00_r8,0.55341e+00_r8, & + & 0.68935e+00_r8,0.82123e+00_r8,0.93793e+00_r8,0.10573e+01_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.10144e+00_r8,0.16758e+00_r8,0.33464e+00_r8,0.50118e+00_r8,0.66683e+00_r8, & + & 0.83041e+00_r8,0.98914e+00_r8,0.11301e+01_r8,0.12744e+01_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.10142e+00_r8,0.19759e+00_r8,0.39475e+00_r8,0.59125e+00_r8,0.78644e+00_r8, & + & 0.97913e+00_r8,0.11666e+01_r8,0.13327e+01_r8,0.15036e+01_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.10117e+00_r8,0.22893e+00_r8,0.45719e+00_r8,0.68491e+00_r8,0.91083e+00_r8, & + & 0.11348e+01_r8,0.13522e+01_r8,0.15448e+01_r8,0.17423e+01_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.12283e+00_r8,0.11939e+00_r8,0.23586e+00_r8,0.35344e+00_r8,0.46995e+00_r8, & + & 0.58562e+00_r8,0.69771e+00_r8,0.79719e+00_r8,0.91456e+00_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.12300e+00_r8,0.14726e+00_r8,0.29424e+00_r8,0.44061e+00_r8,0.58626e+00_r8, & + & 0.73031e+00_r8,0.87019e+00_r8,0.99468e+00_r8,0.11413e+01_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.12308e+00_r8,0.17880e+00_r8,0.35729e+00_r8,0.53471e+00_r8,0.71190e+00_r8, & + & 0.88678e+00_r8,0.10560e+01_r8,0.12083e+01_r8,0.13858e+01_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.12303e+00_r8,0.21231e+00_r8,0.42408e+00_r8,0.63552e+00_r8,0.84482e+00_r8, & + & 0.10530e+01_r8,0.12550e+01_r8,0.14355e+01_r8,0.16461e+01_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.12277e+00_r8,0.24738e+00_r8,0.49418e+00_r8,0.74021e+00_r8,0.98480e+00_r8, & + & 0.12263e+01_r8,0.14622e+01_r8,0.16712e+01_r8,0.19192e+01_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.14866e+00_r8,0.13122e+00_r8,0.23281e+00_r8,0.34894e+00_r8,0.46454e+00_r8, & + & 0.57840e+00_r8,0.68947e+00_r8,0.78868e+00_r8,0.91936e+00_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.14909e+00_r8,0.15020e+00_r8,0.29535e+00_r8,0.44246e+00_r8,0.58879e+00_r8, & + & 0.73298e+00_r8,0.87446e+00_r8,0.10004e+01_r8,0.11652e+01_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.14932e+00_r8,0.18193e+00_r8,0.36339e+00_r8,0.54464e+00_r8,0.72472e+00_r8, & + & 0.90302e+00_r8,0.10769e+01_r8,0.12326e+01_r8,0.14351e+01_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.14936e+00_r8,0.21850e+00_r8,0.43638e+00_r8,0.65369e+00_r8,0.87034e+00_r8, & + & 0.10842e+01_r8,0.12925e+01_r8,0.14807e+01_r8,0.17238e+01_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.14913e+00_r8,0.25689e+00_r8,0.51319e+00_r8,0.76884e+00_r8,0.10226e+01_r8, & + & 0.12750e+01_r8,0.15205e+01_r8,0.17418e+01_r8,0.20260e+01_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.17957e+00_r8,0.15775e+00_r8,0.22276e+00_r8,0.33390e+00_r8,0.44423e+00_r8, & + & 0.55367e+00_r8,0.66019e+00_r8,0.75611e+00_r8,0.88680e+00_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.18040e+00_r8,0.16246e+00_r8,0.28812e+00_r8,0.43146e+00_r8,0.57438e+00_r8, & + & 0.71573e+00_r8,0.85374e+00_r8,0.97839e+00_r8,0.11468e+01_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.18097e+00_r8,0.18562e+00_r8,0.36044e+00_r8,0.53994e+00_r8,0.71844e+00_r8, & + & 0.89550e+00_r8,0.10683e+01_r8,0.12247e+01_r8,0.14347e+01_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.18121e+00_r8,0.21975e+00_r8,0.43861e+00_r8,0.65714e+00_r8,0.87443e+00_r8, & + & 0.10900e+01_r8,0.13008e+01_r8,0.14906e+01_r8,0.17458e+01_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.18106e+00_r8,0.26092e+00_r8,0.52133e+00_r8,0.78101e+00_r8,0.10395e+01_r8, & + & 0.12958e+01_r8,0.15460e+01_r8,0.17735e+01_r8,0.20757e+01_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.21697e+00_r8,0.19036e+00_r8,0.21215e+00_r8,0.31312e+00_r8,0.41669e+00_r8, & + & 0.51939e+00_r8,0.61996e+00_r8,0.71133e+00_r8,0.83486e+00_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.21794e+00_r8,0.19137e+00_r8,0.27611e+00_r8,0.41368e+00_r8,0.55071e+00_r8, & + & 0.68646e+00_r8,0.81902e+00_r8,0.94006e+00_r8,0.11028e+01_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.21886e+00_r8,0.20114e+00_r8,0.35159e+00_r8,0.52668e+00_r8,0.70100e+00_r8, & + & 0.87403e+00_r8,0.10428e+01_r8,0.11973e+01_r8,0.14036e+01_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.21947e+00_r8,0.22776e+00_r8,0.43385e+00_r8,0.64994e+00_r8,0.86545e+00_r8, & + & 0.10790e+01_r8,0.12882e+01_r8,0.14795e+01_r8,0.17328e+01_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.21950e+00_r8,0.26410e+00_r8,0.52266e+00_r8,0.78311e+00_r8,0.10422e+01_r8, & + & 0.12993e+01_r8,0.15508e+01_r8,0.17813e+01_r8,0.20867e+01_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.26192e+00_r8,0.22964e+00_r8,0.21396e+00_r8,0.28442e+00_r8,0.37859e+00_r8, & + & 0.47209e+00_r8,0.56361e+00_r8,0.64772e+00_r8,0.75904e+00_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.26327e+00_r8,0.23094e+00_r8,0.26427e+00_r8,0.38535e+00_r8,0.51302e+00_r8, & + & 0.63961e+00_r8,0.76380e+00_r8,0.87816e+00_r8,0.10282e+01_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.26410e+00_r8,0.23177e+00_r8,0.33446e+00_r8,0.50065e+00_r8,0.66671e+00_r8, & + & 0.83097e+00_r8,0.99257e+00_r8,0.11416e+01_r8,0.13361e+01_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.26501e+00_r8,0.24670e+00_r8,0.42047e+00_r8,0.62999e+00_r8,0.83846e+00_r8, & + & 0.10456e+01_r8,0.12484e+01_r8,0.14350e+01_r8,0.16802e+01_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.26533e+00_r8,0.27595e+00_r8,0.51477e+00_r8,0.77155e+00_r8,0.10272e+01_r8, & + & 0.12802e+01_r8,0.15288e+01_r8,0.17573e+01_r8,0.20585e+01_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.31548e+00_r8,0.27644e+00_r8,0.23749e+00_r8,0.26350e+00_r8,0.33563e+00_r8, & + & 0.41860e+00_r8,0.50000e+00_r8,0.57557e+00_r8,0.67307e+00_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.31747e+00_r8,0.27830e+00_r8,0.26813e+00_r8,0.35238e+00_r8,0.46780e+00_r8, & + & 0.58337e+00_r8,0.69695e+00_r8,0.80281e+00_r8,0.93825e+00_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.31845e+00_r8,0.27929e+00_r8,0.32577e+00_r8,0.46831e+00_r8,0.62377e+00_r8, & + & 0.77768e+00_r8,0.92868e+00_r8,0.10691e+01_r8,0.12510e+01_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.31933e+00_r8,0.28093e+00_r8,0.40219e+00_r8,0.60218e+00_r8,0.80124e+00_r8, & + & 0.99953e+00_r8,0.11938e+01_r8,0.13738e+01_r8,0.16072e+01_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.31962e+00_r8,0.30041e+00_r8,0.50060e+00_r8,0.75020e+00_r8,0.99895e+00_r8, & + & 0.12457e+01_r8,0.14877e+01_r8,0.17119e+01_r8,0.20030e+01_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.37865e+00_r8,0.33167e+00_r8,0.28471e+00_r8,0.26304e+00_r8,0.29883e+00_r8, & + & 0.36478e+00_r8,0.43575e+00_r8,0.50177e+00_r8,0.58698e+00_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.38151e+00_r8,0.33434e+00_r8,0.29226e+00_r8,0.33286e+00_r8,0.42010e+00_r8, & + & 0.52397e+00_r8,0.62612e+00_r8,0.72153e+00_r8,0.84257e+00_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.38305e+00_r8,0.33575e+00_r8,0.33335e+00_r8,0.43312e+00_r8,0.57580e+00_r8, & + & 0.71815e+00_r8,0.85781e+00_r8,0.98826e+00_r8,0.11549e+01_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.38418e+00_r8,0.33683e+00_r8,0.39821e+00_r8,0.56836e+00_r8,0.75670e+00_r8, & + & 0.94382e+00_r8,0.11276e+01_r8,0.12990e+01_r8,0.15179e+01_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.38435e+00_r8,0.34032e+00_r8,0.48169e+00_r8,0.72105e+00_r8,0.95979e+00_r8, & + & 0.11976e+01_r8,0.14311e+01_r8,0.16484e+01_r8,0.19256e+01_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.45391e+00_r8,0.39745e+00_r8,0.34100e+00_r8,0.28597e+00_r8,0.28236e+00_r8, & + & 0.32683e+00_r8,0.39003e+00_r8,0.44780e+00_r8,0.52646e+00_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.45720e+00_r8,0.40042e+00_r8,0.34369e+00_r8,0.33249e+00_r8,0.37993e+00_r8, & + & 0.46180e+00_r8,0.55195e+00_r8,0.63669e+00_r8,0.74252e+00_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.45930e+00_r8,0.40241e+00_r8,0.35995e+00_r8,0.41477e+00_r8,0.52224e+00_r8, & + & 0.65162e+00_r8,0.77908e+00_r8,0.89846e+00_r8,0.10481e+01_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.46056e+00_r8,0.40360e+00_r8,0.40974e+00_r8,0.52851e+00_r8,0.70308e+00_r8, & + & 0.87703e+00_r8,0.10485e+01_r8,0.12091e+01_r8,0.14102e+01_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.46097e+00_r8,0.40408e+00_r8,0.48083e+00_r8,0.68278e+00_r8,0.90959e+00_r8, & + & 0.11347e+01_r8,0.13562e+01_r8,0.15644e+01_r8,0.18239e+01_r8 /) + kao(:, 1,10,16) = (/ & + & 0.54348e+00_r8,0.47578e+00_r8,0.40808e+00_r8,0.34039e+00_r8,0.29202e+00_r8, & + & 0.31463e+00_r8,0.37530e+00_r8,0.43003e+00_r8,0.50713e+00_r8 /) + kao(:, 2,10,16) = (/ & + & 0.54726e+00_r8,0.47923e+00_r8,0.41116e+00_r8,0.35738e+00_r8,0.36873e+00_r8, & + & 0.42815e+00_r8,0.51125e+00_r8,0.58827e+00_r8,0.68902e+00_r8 /) + kao(:, 3,10,16) = (/ & + & 0.54904e+00_r8,0.48087e+00_r8,0.41270e+00_r8,0.42187e+00_r8,0.48592e+00_r8, & + & 0.59834e+00_r8,0.71541e+00_r8,0.82550e+00_r8,0.96166e+00_r8 /) + kao(:, 4,10,16) = (/ & + & 0.55066e+00_r8,0.48237e+00_r8,0.44342e+00_r8,0.51829e+00_r8,0.65846e+00_r8, & + & 0.82163e+00_r8,0.98259e+00_r8,0.11344e+01_r8,0.13209e+01_r8 /) + kao(:, 5,10,16) = (/ & + & 0.55078e+00_r8,0.48256e+00_r8,0.50243e+00_r8,0.65112e+00_r8,0.86662e+00_r8, & + & 0.10813e+01_r8,0.12932e+01_r8,0.14933e+01_r8,0.17377e+01_r8 /) + kao(:, 1,11,16) = (/ & + & 0.65114e+00_r8,0.56997e+00_r8,0.48880e+00_r8,0.40765e+00_r8,0.34114e+00_r8, & + & 0.35299e+00_r8,0.42114e+00_r8,0.48311e+00_r8,0.56879e+00_r8 /) + kao(:, 2,11,16) = (/ & + & 0.65409e+00_r8,0.57269e+00_r8,0.49126e+00_r8,0.41893e+00_r8,0.41551e+00_r8, & + & 0.46863e+00_r8,0.55986e+00_r8,0.64427e+00_r8,0.75415e+00_r8 /) + kao(:, 3,11,16) = (/ & + & 0.65488e+00_r8,0.57345e+00_r8,0.49197e+00_r8,0.47947e+00_r8,0.53169e+00_r8, & + & 0.64034e+00_r8,0.76581e+00_r8,0.88450e+00_r8,0.10287e+01_r8 /) + kao(:, 4,11,16) = (/ & + & 0.65537e+00_r8,0.57398e+00_r8,0.51344e+00_r8,0.57405e+00_r8,0.70306e+00_r8, & + & 0.87735e+00_r8,0.10495e+01_r8,0.12127e+01_r8,0.14094e+01_r8 /) + kao(:, 5,11,16) = (/ & + & 0.65395e+00_r8,0.57279e+00_r8,0.56858e+00_r8,0.69997e+00_r8,0.92273e+00_r8, & + & 0.11516e+01_r8,0.13780e+01_r8,0.15930e+01_r8,0.18499e+01_r8 /) + kao(:, 1,12,16) = (/ & + & 0.77619e+00_r8,0.67938e+00_r8,0.58258e+00_r8,0.48578e+00_r8,0.39872e+00_r8, & + & 0.39471e+00_r8,0.47009e+00_r8,0.53992e+00_r8,0.63430e+00_r8 /) + kao(:, 2,12,16) = (/ & + & 0.77753e+00_r8,0.68052e+00_r8,0.58367e+00_r8,0.49090e+00_r8,0.46899e+00_r8, & + & 0.51194e+00_r8,0.61162e+00_r8,0.70447e+00_r8,0.82357e+00_r8 /) + kao(:, 3,12,16) = (/ & + & 0.77638e+00_r8,0.67972e+00_r8,0.58318e+00_r8,0.54530e+00_r8,0.58387e+00_r8, & + & 0.68245e+00_r8,0.81638e+00_r8,0.94341e+00_r8,0.10965e+01_r8 /) + kao(:, 4,12,16) = (/ & + & 0.77440e+00_r8,0.67810e+00_r8,0.59462e+00_r8,0.63695e+00_r8,0.74739e+00_r8, & + & 0.93197e+00_r8,0.11153e+01_r8,0.12903e+01_r8,0.14970e+01_r8 /) + kao(:, 5,12,16) = (/ & + & 0.77021e+00_r8,0.67464e+00_r8,0.64357e+00_r8,0.75637e+00_r8,0.97798e+00_r8, & + & 0.12207e+01_r8,0.14609e+01_r8,0.16904e+01_r8,0.19598e+01_r8 /) + kao(:, 1,13,16) = (/ & + & 0.91895e+00_r8,0.80429e+00_r8,0.68964e+00_r8,0.57498e+00_r8,0.46528e+00_r8, & + & 0.44199e+00_r8,0.52028e+00_r8,0.59834e+00_r8,0.70141e+00_r8 /) + kao(:, 2,13,16) = (/ & + & 0.91759e+00_r8,0.80320e+00_r8,0.68881e+00_r8,0.57463e+00_r8,0.52956e+00_r8, & + & 0.55768e+00_r8,0.66492e+00_r8,0.76644e+00_r8,0.89471e+00_r8 /) + kao(:, 3,13,16) = (/ & + & 0.91361e+00_r8,0.79979e+00_r8,0.68598e+00_r8,0.61940e+00_r8,0.64101e+00_r8, & + & 0.72712e+00_r8,0.86969e+00_r8,0.10053e+01_r8,0.11679e+01_r8 /) + kao(:, 4,13,16) = (/ & + & 0.90733e+00_r8,0.79439e+00_r8,0.68655e+00_r8,0.70603e+00_r8,0.79560e+00_r8, & + & 0.98356e+00_r8,0.11773e+01_r8,0.13631e+01_r8,0.15788e+01_r8 /) + kao(:, 5,13,16) = (/ & + & 0.89862e+00_r8,0.78697e+00_r8,0.72670e+00_r8,0.82187e+00_r8,0.10292e+01_r8, & + & 0.12848e+01_r8,0.15381e+01_r8,0.17818e+01_r8,0.20623e+01_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.80849e-06_r8,0.81362e-06_r8,0.81391e-06_r8,0.81832e-06_r8,0.81000e-06_r8 /) + kbo(:,14, 1) = (/ & + & 0.62593e-06_r8,0.63090e-06_r8,0.63158e-06_r8,0.62821e-06_r8,0.62502e-06_r8 /) + kbo(:,15, 1) = (/ & + & 0.47825e-06_r8,0.47852e-06_r8,0.47713e-06_r8,0.47688e-06_r8,0.47989e-06_r8 /) + kbo(:,16, 1) = (/ & + & 0.36039e-06_r8,0.35905e-06_r8,0.36064e-06_r8,0.36298e-06_r8,0.36860e-06_r8 /) + kbo(:,17, 1) = (/ & + & 0.27679e-06_r8,0.27608e-06_r8,0.27742e-06_r8,0.28112e-06_r8,0.28759e-06_r8 /) + kbo(:,18, 1) = (/ & + & 0.21771e-06_r8,0.21826e-06_r8,0.22019e-06_r8,0.22429e-06_r8,0.22996e-06_r8 /) + kbo(:,19, 1) = (/ & + & 0.17334e-06_r8,0.17441e-06_r8,0.17681e-06_r8,0.18055e-06_r8,0.18537e-06_r8 /) + kbo(:,20, 1) = (/ & + & 0.13974e-06_r8,0.14076e-06_r8,0.14326e-06_r8,0.14694e-06_r8,0.15070e-06_r8 /) + kbo(:,21, 1) = (/ & + & 0.11289e-06_r8,0.11394e-06_r8,0.11631e-06_r8,0.11963e-06_r8,0.12284e-06_r8 /) + kbo(:,22, 1) = (/ & + & 0.90574e-07_r8,0.91914e-07_r8,0.94046e-07_r8,0.96998e-07_r8,0.99841e-07_r8 /) + kbo(:,23, 1) = (/ & + & 0.72483e-07_r8,0.74069e-07_r8,0.76186e-07_r8,0.78482e-07_r8,0.80964e-07_r8 /) + kbo(:,24, 1) = (/ & + & 0.57463e-07_r8,0.59130e-07_r8,0.60802e-07_r8,0.62903e-07_r8,0.65218e-07_r8 /) + kbo(:,25, 1) = (/ & + & 0.45767e-07_r8,0.47184e-07_r8,0.48696e-07_r8,0.50494e-07_r8,0.52527e-07_r8 /) + kbo(:,26, 1) = (/ & + & 0.36636e-07_r8,0.37794e-07_r8,0.39217e-07_r8,0.40768e-07_r8,0.42465e-07_r8 /) + kbo(:,27, 1) = (/ & + & 0.29173e-07_r8,0.30183e-07_r8,0.31469e-07_r8,0.32834e-07_r8,0.34213e-07_r8 /) + kbo(:,28, 1) = (/ & + & 0.23225e-07_r8,0.24137e-07_r8,0.25167e-07_r8,0.26378e-07_r8,0.27534e-07_r8 /) + kbo(:,29, 1) = (/ & + & 0.18675e-07_r8,0.19472e-07_r8,0.20340e-07_r8,0.21340e-07_r8,0.22286e-07_r8 /) + kbo(:,30, 1) = (/ & + & 0.15020e-07_r8,0.15690e-07_r8,0.16468e-07_r8,0.17258e-07_r8,0.18060e-07_r8 /) + kbo(:,31, 1) = (/ & + & 0.12149e-07_r8,0.12728e-07_r8,0.13375e-07_r8,0.14035e-07_r8,0.14711e-07_r8 /) + kbo(:,32, 1) = (/ & + & 0.98596e-08_r8,0.10344e-07_r8,0.10879e-07_r8,0.11427e-07_r8,0.12003e-07_r8 /) + kbo(:,33, 1) = (/ & + & 0.80127e-08_r8,0.84199e-08_r8,0.88610e-08_r8,0.93188e-08_r8,0.98102e-08_r8 /) + kbo(:,34, 1) = (/ & + & 0.65473e-08_r8,0.68850e-08_r8,0.72470e-08_r8,0.76379e-08_r8,0.80329e-08_r8 /) + kbo(:,35, 1) = (/ & + & 0.53107e-08_r8,0.55930e-08_r8,0.58984e-08_r8,0.62161e-08_r8,0.65511e-08_r8 /) + kbo(:,36, 1) = (/ & + & 0.42749e-08_r8,0.45072e-08_r8,0.47592e-08_r8,0.50244e-08_r8,0.53034e-08_r8 /) + kbo(:,37, 1) = (/ & + & 0.34593e-08_r8,0.36479e-08_r8,0.38557e-08_r8,0.40714e-08_r8,0.43031e-08_r8 /) + kbo(:,38, 1) = (/ & + & 0.27981e-08_r8,0.29525e-08_r8,0.31212e-08_r8,0.32984e-08_r8,0.34890e-08_r8 /) + kbo(:,39, 1) = (/ & + & 0.22616e-08_r8,0.23879e-08_r8,0.25266e-08_r8,0.26716e-08_r8,0.28295e-08_r8 /) + kbo(:,40, 1) = (/ & + & 0.18232e-08_r8,0.19245e-08_r8,0.20362e-08_r8,0.21554e-08_r8,0.22831e-08_r8 /) + kbo(:,41, 1) = (/ & + & 0.14679e-08_r8,0.15511e-08_r8,0.16402e-08_r8,0.17376e-08_r8,0.18413e-08_r8 /) + kbo(:,42, 1) = (/ & + & 0.11828e-08_r8,0.12488e-08_r8,0.13200e-08_r8,0.14008e-08_r8,0.14841e-08_r8 /) + kbo(:,43, 1) = (/ & + & 0.94970e-09_r8,0.10028e-08_r8,0.10610e-08_r8,0.11254e-08_r8,0.11933e-08_r8 /) + kbo(:,44, 1) = (/ & + & 0.76210e-09_r8,0.80401e-09_r8,0.85098e-09_r8,0.90203e-09_r8,0.95794e-09_r8 /) + kbo(:,45, 1) = (/ & + & 0.61242e-09_r8,0.64471e-09_r8,0.68205e-09_r8,0.72336e-09_r8,0.76846e-09_r8 /) + kbo(:,46, 1) = (/ & + & 0.49214e-09_r8,0.51642e-09_r8,0.54633e-09_r8,0.57916e-09_r8,0.61506e-09_r8 /) + kbo(:,47, 1) = (/ & + & 0.39552e-09_r8,0.41343e-09_r8,0.43658e-09_r8,0.46266e-09_r8,0.49121e-09_r8 /) + kbo(:,48, 1) = (/ & + & 0.31773e-09_r8,0.33161e-09_r8,0.34878e-09_r8,0.36970e-09_r8,0.39231e-09_r8 /) + kbo(:,49, 1) = (/ & + & 0.25526e-09_r8,0.26613e-09_r8,0.27906e-09_r8,0.29510e-09_r8,0.31346e-09_r8 /) + kbo(:,50, 1) = (/ & + & 0.20571e-09_r8,0.21419e-09_r8,0.22379e-09_r8,0.23622e-09_r8,0.25076e-09_r8 /) + kbo(:,51, 1) = (/ & + & 0.16573e-09_r8,0.17251e-09_r8,0.18002e-09_r8,0.18925e-09_r8,0.20074e-09_r8 /) + kbo(:,52, 1) = (/ & + & 0.13312e-09_r8,0.13888e-09_r8,0.14480e-09_r8,0.15170e-09_r8,0.16067e-09_r8 /) + kbo(:,53, 1) = (/ & + & 0.10717e-09_r8,0.11200e-09_r8,0.11653e-09_r8,0.12187e-09_r8,0.12864e-09_r8 /) + kbo(:,54, 1) = (/ & + & 0.85395e-10_r8,0.90190e-10_r8,0.93978e-10_r8,0.98115e-10_r8,0.10324e-09_r8 /) + kbo(:,55, 1) = (/ & + & 0.67933e-10_r8,0.72682e-10_r8,0.75857e-10_r8,0.79079e-10_r8,0.82942e-10_r8 /) + kbo(:,56, 1) = (/ & + & 0.53572e-10_r8,0.58095e-10_r8,0.61231e-10_r8,0.63738e-10_r8,0.66738e-10_r8 /) + kbo(:,57, 1) = (/ & + & 0.41729e-10_r8,0.46380e-10_r8,0.49357e-10_r8,0.51409e-10_r8,0.53743e-10_r8 /) + kbo(:,58, 1) = (/ & + & 0.32319e-10_r8,0.36737e-10_r8,0.39572e-10_r8,0.41487e-10_r8,0.43327e-10_r8 /) + kbo(:,59, 1) = (/ & + & 0.25820e-10_r8,0.29541e-10_r8,0.32107e-10_r8,0.33762e-10_r8,0.35250e-10_r8 /) + kbo(:,13, 2) = (/ & + & 0.93809e-05_r8,0.10536e-04_r8,0.11777e-04_r8,0.13098e-04_r8,0.14486e-04_r8 /) + kbo(:,14, 2) = (/ & + & 0.77050e-05_r8,0.86520e-05_r8,0.96745e-05_r8,0.10759e-04_r8,0.11891e-04_r8 /) + kbo(:,15, 2) = (/ & + & 0.63112e-05_r8,0.70914e-05_r8,0.79320e-05_r8,0.88179e-05_r8,0.97344e-05_r8 /) + kbo(:,16, 2) = (/ & + & 0.51672e-05_r8,0.58172e-05_r8,0.64961e-05_r8,0.72133e-05_r8,0.79595e-05_r8 /) + kbo(:,17, 2) = (/ & + & 0.42470e-05_r8,0.47817e-05_r8,0.53396e-05_r8,0.59229e-05_r8,0.65385e-05_r8 /) + kbo(:,18, 2) = (/ & + & 0.35105e-05_r8,0.39513e-05_r8,0.44042e-05_r8,0.48865e-05_r8,0.53983e-05_r8 /) + kbo(:,19, 2) = (/ & + & 0.29057e-05_r8,0.32680e-05_r8,0.36409e-05_r8,0.40419e-05_r8,0.44646e-05_r8 /) + kbo(:,20, 2) = (/ & + & 0.24132e-05_r8,0.27111e-05_r8,0.30192e-05_r8,0.33498e-05_r8,0.36985e-05_r8 /) + kbo(:,21, 2) = (/ & + & 0.20041e-05_r8,0.22484e-05_r8,0.25052e-05_r8,0.27770e-05_r8,0.30661e-05_r8 /) + kbo(:,22, 2) = (/ & + & 0.16762e-05_r8,0.18775e-05_r8,0.20900e-05_r8,0.23158e-05_r8,0.25543e-05_r8 /) + kbo(:,23, 2) = (/ & + & 0.14013e-05_r8,0.15665e-05_r8,0.17433e-05_r8,0.19308e-05_r8,0.21290e-05_r8 /) + kbo(:,24, 2) = (/ & + & 0.11680e-05_r8,0.13039e-05_r8,0.14515e-05_r8,0.16085e-05_r8,0.17733e-05_r8 /) + kbo(:,25, 2) = (/ & + & 0.97491e-06_r8,0.10886e-05_r8,0.12114e-05_r8,0.13428e-05_r8,0.14806e-05_r8 /) + kbo(:,26, 2) = (/ & + & 0.81608e-06_r8,0.91198e-06_r8,0.10148e-05_r8,0.11244e-05_r8,0.12392e-05_r8 /) + kbo(:,27, 2) = (/ & + & 0.68407e-06_r8,0.76432e-06_r8,0.85048e-06_r8,0.94210e-06_r8,0.10393e-05_r8 /) + kbo(:,28, 2) = (/ & + & 0.57340e-06_r8,0.64071e-06_r8,0.71311e-06_r8,0.78988e-06_r8,0.87304e-06_r8 /) + kbo(:,29, 2) = (/ & + & 0.48234e-06_r8,0.53886e-06_r8,0.59992e-06_r8,0.66557e-06_r8,0.73565e-06_r8 /) + kbo(:,30, 2) = (/ & + & 0.40628e-06_r8,0.45384e-06_r8,0.50638e-06_r8,0.56175e-06_r8,0.62086e-06_r8 /) + kbo(:,31, 2) = (/ & + & 0.34276e-06_r8,0.38409e-06_r8,0.42817e-06_r8,0.47551e-06_r8,0.52508e-06_r8 /) + kbo(:,32, 2) = (/ & + & 0.29024e-06_r8,0.32548e-06_r8,0.36291e-06_r8,0.40263e-06_r8,0.44423e-06_r8 /) + kbo(:,33, 2) = (/ & + & 0.24623e-06_r8,0.27596e-06_r8,0.30748e-06_r8,0.34104e-06_r8,0.37571e-06_r8 /) + kbo(:,34, 2) = (/ & + & 0.20814e-06_r8,0.23318e-06_r8,0.25975e-06_r8,0.28746e-06_r8,0.31674e-06_r8 /) + kbo(:,35, 2) = (/ & + & 0.17399e-06_r8,0.19476e-06_r8,0.21698e-06_r8,0.24021e-06_r8,0.26463e-06_r8 /) + kbo(:,36, 2) = (/ & + & 0.14352e-06_r8,0.16079e-06_r8,0.17920e-06_r8,0.19838e-06_r8,0.21852e-06_r8 /) + kbo(:,37, 2) = (/ & + & 0.11644e-06_r8,0.13061e-06_r8,0.14569e-06_r8,0.16148e-06_r8,0.17794e-06_r8 /) + kbo(:,38, 2) = (/ & + & 0.94327e-07_r8,0.10597e-06_r8,0.11827e-06_r8,0.13121e-06_r8,0.14471e-06_r8 /) + kbo(:,39, 2) = (/ & + & 0.76386e-07_r8,0.85932e-07_r8,0.96004e-07_r8,0.10675e-06_r8,0.11785e-06_r8 /) + kbo(:,40, 2) = (/ & + & 0.61093e-07_r8,0.68856e-07_r8,0.77088e-07_r8,0.85831e-07_r8,0.94878e-07_r8 /) + kbo(:,41, 2) = (/ & + & 0.48781e-07_r8,0.55058e-07_r8,0.61725e-07_r8,0.68852e-07_r8,0.76234e-07_r8 /) + kbo(:,42, 2) = (/ & + & 0.38909e-07_r8,0.43987e-07_r8,0.49391e-07_r8,0.55161e-07_r8,0.61197e-07_r8 /) + kbo(:,43, 2) = (/ & + & 0.30779e-07_r8,0.34866e-07_r8,0.39222e-07_r8,0.43870e-07_r8,0.48785e-07_r8 /) + kbo(:,44, 2) = (/ & + & 0.24249e-07_r8,0.27514e-07_r8,0.31014e-07_r8,0.34774e-07_r8,0.38772e-07_r8 /) + kbo(:,45, 2) = (/ & + & 0.19076e-07_r8,0.21693e-07_r8,0.24514e-07_r8,0.27522e-07_r8,0.30756e-07_r8 /) + kbo(:,46, 2) = (/ & + & 0.14949e-07_r8,0.17046e-07_r8,0.19303e-07_r8,0.21721e-07_r8,0.24320e-07_r8 /) + kbo(:,47, 2) = (/ & + & 0.11627e-07_r8,0.13294e-07_r8,0.15102e-07_r8,0.17040e-07_r8,0.19115e-07_r8 /) + kbo(:,48, 2) = (/ & + & 0.90208e-08_r8,0.10359e-07_r8,0.11803e-07_r8,0.13349e-07_r8,0.15003e-07_r8 /) + kbo(:,49, 2) = (/ & + & 0.69979e-08_r8,0.80625e-08_r8,0.92075e-08_r8,0.10445e-07_r8,0.11768e-07_r8 /) + kbo(:,50, 2) = (/ & + & 0.54507e-08_r8,0.62777e-08_r8,0.72004e-08_r8,0.81899e-08_r8,0.92488e-08_r8 /) + kbo(:,51, 2) = (/ & + & 0.42541e-08_r8,0.48933e-08_r8,0.56304e-08_r8,0.64214e-08_r8,0.72725e-08_r8 /) + kbo(:,52, 2) = (/ & + & 0.33161e-08_r8,0.38121e-08_r8,0.43976e-08_r8,0.50301e-08_r8,0.57140e-08_r8 /) + kbo(:,53, 2) = (/ & + & 0.25817e-08_r8,0.29691e-08_r8,0.34291e-08_r8,0.39368e-08_r8,0.44836e-08_r8 /) + kbo(:,54, 2) = (/ & + & 0.20203e-08_r8,0.23228e-08_r8,0.26823e-08_r8,0.30900e-08_r8,0.35285e-08_r8 /) + kbo(:,55, 2) = (/ & + & 0.15833e-08_r8,0.18196e-08_r8,0.21023e-08_r8,0.24276e-08_r8,0.27787e-08_r8 /) + kbo(:,56, 2) = (/ & + & 0.12403e-08_r8,0.14250e-08_r8,0.16461e-08_r8,0.19045e-08_r8,0.21855e-08_r8 /) + kbo(:,57, 2) = (/ & + & 0.97249e-09_r8,0.11164e-08_r8,0.12881e-08_r8,0.14923e-08_r8,0.17175e-08_r8 /) + kbo(:,58, 2) = (/ & + & 0.76431e-09_r8,0.87699e-09_r8,0.10108e-08_r8,0.11709e-08_r8,0.13516e-08_r8 /) + kbo(:,59, 2) = (/ & + & 0.61553e-09_r8,0.70649e-09_r8,0.81463e-09_r8,0.94315e-09_r8,0.10907e-08_r8 /) + kbo(:,13, 3) = (/ & + & 0.37708e-04_r8,0.43942e-04_r8,0.50586e-04_r8,0.57656e-04_r8,0.65139e-04_r8 /) + kbo(:,14, 3) = (/ & + & 0.31694e-04_r8,0.36862e-04_r8,0.42350e-04_r8,0.48197e-04_r8,0.54341e-04_r8 /) + kbo(:,15, 3) = (/ & + & 0.26564e-04_r8,0.30824e-04_r8,0.35372e-04_r8,0.40180e-04_r8,0.45231e-04_r8 /) + kbo(:,16, 3) = (/ & + & 0.22232e-04_r8,0.25740e-04_r8,0.29512e-04_r8,0.33447e-04_r8,0.37588e-04_r8 /) + kbo(:,17, 3) = (/ & + & 0.18578e-04_r8,0.21467e-04_r8,0.24582e-04_r8,0.27832e-04_r8,0.31221e-04_r8 /) + kbo(:,18, 3) = (/ & + & 0.15530e-04_r8,0.17922e-04_r8,0.20498e-04_r8,0.23170e-04_r8,0.25973e-04_r8 /) + kbo(:,19, 3) = (/ & + & 0.12972e-04_r8,0.14952e-04_r8,0.17059e-04_r8,0.19270e-04_r8,0.21580e-04_r8 /) + kbo(:,20, 3) = (/ & + & 0.10858e-04_r8,0.12498e-04_r8,0.14228e-04_r8,0.16061e-04_r8,0.17958e-04_r8 /) + kbo(:,21, 3) = (/ & + & 0.90819e-05_r8,0.10446e-04_r8,0.11880e-04_r8,0.13394e-04_r8,0.14951e-04_r8 /) + kbo(:,22, 3) = (/ & + & 0.76648e-05_r8,0.87979e-05_r8,0.99931e-05_r8,0.11255e-04_r8,0.12542e-04_r8 /) + kbo(:,23, 3) = (/ & + & 0.64634e-05_r8,0.74140e-05_r8,0.84086e-05_r8,0.94546e-05_r8,0.10527e-04_r8 /) + kbo(:,24, 3) = (/ & + & 0.54523e-05_r8,0.62464e-05_r8,0.70809e-05_r8,0.79508e-05_r8,0.88446e-05_r8 /) + kbo(:,25, 3) = (/ & + & 0.46110e-05_r8,0.52716e-05_r8,0.59693e-05_r8,0.66904e-05_r8,0.74322e-05_r8 /) + kbo(:,26, 3) = (/ & + & 0.39134e-05_r8,0.44620e-05_r8,0.50425e-05_r8,0.56439e-05_r8,0.62577e-05_r8 /) + kbo(:,27, 3) = (/ & + & 0.33208e-05_r8,0.37777e-05_r8,0.42629e-05_r8,0.47607e-05_r8,0.52714e-05_r8 /) + kbo(:,28, 3) = (/ & + & 0.28177e-05_r8,0.32008e-05_r8,0.36031e-05_r8,0.40187e-05_r8,0.44358e-05_r8 /) + kbo(:,29, 3) = (/ & + & 0.23932e-05_r8,0.27158e-05_r8,0.30516e-05_r8,0.33945e-05_r8,0.37416e-05_r8 /) + kbo(:,30, 3) = (/ & + & 0.20340e-05_r8,0.23035e-05_r8,0.25827e-05_r8,0.28672e-05_r8,0.31559e-05_r8 /) + kbo(:,31, 3) = (/ & + & 0.17308e-05_r8,0.19547e-05_r8,0.21869e-05_r8,0.24243e-05_r8,0.26649e-05_r8 /) + kbo(:,32, 3) = (/ & + & 0.14734e-05_r8,0.16593e-05_r8,0.18536e-05_r8,0.20518e-05_r8,0.22514e-05_r8 /) + kbo(:,33, 3) = (/ & + & 0.12538e-05_r8,0.14097e-05_r8,0.15718e-05_r8,0.17369e-05_r8,0.19013e-05_r8 /) + kbo(:,34, 3) = (/ & + & 0.10626e-05_r8,0.11932e-05_r8,0.13290e-05_r8,0.14662e-05_r8,0.16025e-05_r8 /) + kbo(:,35, 3) = (/ & + & 0.88990e-06_r8,0.99878e-06_r8,0.11122e-05_r8,0.12266e-05_r8,0.13395e-05_r8 /) + kbo(:,36, 3) = (/ & + & 0.73535e-06_r8,0.82690e-06_r8,0.92099e-06_r8,0.10159e-05_r8,0.11099e-05_r8 /) + kbo(:,37, 3) = (/ & + & 0.59728e-06_r8,0.67301e-06_r8,0.75127e-06_r8,0.83021e-06_r8,0.90845e-06_r8 /) + kbo(:,38, 3) = (/ & + & 0.48484e-06_r8,0.54737e-06_r8,0.61229e-06_r8,0.67762e-06_r8,0.74258e-06_r8 /) + kbo(:,39, 3) = (/ & + & 0.39347e-06_r8,0.44485e-06_r8,0.49886e-06_r8,0.55290e-06_r8,0.60674e-06_r8 /) + kbo(:,40, 3) = (/ & + & 0.31488e-06_r8,0.35703e-06_r8,0.40148e-06_r8,0.44640e-06_r8,0.49091e-06_r8 /) + kbo(:,41, 3) = (/ & + & 0.25130e-06_r8,0.28561e-06_r8,0.32224e-06_r8,0.35953e-06_r8,0.39618e-06_r8 /) + kbo(:,42, 3) = (/ & + & 0.20030e-06_r8,0.22840e-06_r8,0.25834e-06_r8,0.28930e-06_r8,0.31965e-06_r8 /) + kbo(:,43, 3) = (/ & + & 0.15807e-06_r8,0.18109e-06_r8,0.20542e-06_r8,0.23094e-06_r8,0.25635e-06_r8 /) + kbo(:,44, 3) = (/ & + & 0.12418e-06_r8,0.14282e-06_r8,0.16261e-06_r8,0.18364e-06_r8,0.20465e-06_r8 /) + kbo(:,45, 3) = (/ & + & 0.97383e-07_r8,0.11245e-06_r8,0.12855e-06_r8,0.14572e-06_r8,0.16307e-06_r8 /) + kbo(:,46, 3) = (/ & + & 0.76015e-07_r8,0.88067e-07_r8,0.10120e-06_r8,0.11510e-06_r8,0.12935e-06_r8 /) + kbo(:,47, 3) = (/ & + & 0.58813e-07_r8,0.68493e-07_r8,0.79102e-07_r8,0.90273e-07_r8,0.10200e-06_r8 /) + kbo(:,48, 3) = (/ & + & 0.45440e-07_r8,0.53144e-07_r8,0.61597e-07_r8,0.70639e-07_r8,0.80255e-07_r8 /) + kbo(:,49, 3) = (/ & + & 0.35015e-07_r8,0.41136e-07_r8,0.47869e-07_r8,0.55216e-07_r8,0.62994e-07_r8 /) + kbo(:,50, 3) = (/ & + & 0.27056e-07_r8,0.31910e-07_r8,0.37267e-07_r8,0.43210e-07_r8,0.49522e-07_r8 /) + kbo(:,51, 3) = (/ & + & 0.20908e-07_r8,0.24756e-07_r8,0.29044e-07_r8,0.33791e-07_r8,0.38904e-07_r8 /) + kbo(:,52, 3) = (/ & + & 0.16131e-07_r8,0.19181e-07_r8,0.22589e-07_r8,0.26378e-07_r8,0.30504e-07_r8 /) + kbo(:,53, 3) = (/ & + & 0.12418e-07_r8,0.14835e-07_r8,0.17537e-07_r8,0.20547e-07_r8,0.23860e-07_r8 /) + kbo(:,54, 3) = (/ & + & 0.95994e-08_r8,0.11514e-07_r8,0.13662e-07_r8,0.16065e-07_r8,0.18717e-07_r8 /) + kbo(:,55, 3) = (/ & + & 0.74239e-08_r8,0.89453e-08_r8,0.10656e-07_r8,0.12569e-07_r8,0.14693e-07_r8 /) + kbo(:,56, 3) = (/ & + & 0.57300e-08_r8,0.69441e-08_r8,0.83030e-08_r8,0.98193e-08_r8,0.11523e-07_r8 /) + kbo(:,57, 3) = (/ & + & 0.44152e-08_r8,0.53811e-08_r8,0.64581e-08_r8,0.76610e-08_r8,0.90201e-08_r8 /) + kbo(:,58, 3) = (/ & + & 0.34072e-08_r8,0.41708e-08_r8,0.50297e-08_r8,0.59876e-08_r8,0.70684e-08_r8 /) + kbo(:,59, 3) = (/ & + & 0.27302e-08_r8,0.33492e-08_r8,0.40481e-08_r8,0.48266e-08_r8,0.57046e-08_r8 /) + kbo(:,13, 4) = (/ & + & 0.12015e-03_r8,0.13920e-03_r8,0.15937e-03_r8,0.18001e-03_r8,0.19929e-03_r8 /) + kbo(:,14, 4) = (/ & + & 0.10256e-03_r8,0.11883e-03_r8,0.13587e-03_r8,0.15259e-03_r8,0.16812e-03_r8 /) + kbo(:,15, 4) = (/ & + & 0.87203e-04_r8,0.10099e-03_r8,0.11498e-03_r8,0.12847e-03_r8,0.14114e-03_r8 /) + kbo(:,16, 4) = (/ & + & 0.73859e-04_r8,0.85304e-04_r8,0.96816e-04_r8,0.10774e-03_r8,0.11805e-03_r8 /) + kbo(:,17, 4) = (/ & + & 0.62334e-04_r8,0.71786e-04_r8,0.81225e-04_r8,0.90091e-04_r8,0.98454e-04_r8 /) + kbo(:,18, 4) = (/ & + & 0.52581e-04_r8,0.60344e-04_r8,0.68018e-04_r8,0.75237e-04_r8,0.81903e-04_r8 /) + kbo(:,19, 4) = (/ & + & 0.44197e-04_r8,0.50573e-04_r8,0.56840e-04_r8,0.62656e-04_r8,0.67968e-04_r8 /) + kbo(:,20, 4) = (/ & + & 0.37151e-04_r8,0.42384e-04_r8,0.47494e-04_r8,0.52193e-04_r8,0.56467e-04_r8 /) + kbo(:,21, 4) = (/ & + & 0.31193e-04_r8,0.35480e-04_r8,0.39600e-04_r8,0.43427e-04_r8,0.46870e-04_r8 /) + kbo(:,22, 4) = (/ & + & 0.26374e-04_r8,0.29925e-04_r8,0.33224e-04_r8,0.36261e-04_r8,0.39040e-04_r8 /) + kbo(:,23, 4) = (/ & + & 0.22315e-04_r8,0.25198e-04_r8,0.27833e-04_r8,0.30290e-04_r8,0.32509e-04_r8 /) + kbo(:,24, 4) = (/ & + & 0.18883e-04_r8,0.21184e-04_r8,0.23291e-04_r8,0.25268e-04_r8,0.27046e-04_r8 /) + kbo(:,25, 4) = (/ & + & 0.15977e-04_r8,0.17808e-04_r8,0.19529e-04_r8,0.21106e-04_r8,0.22533e-04_r8 /) + kbo(:,26, 4) = (/ & + & 0.13524e-04_r8,0.14996e-04_r8,0.16391e-04_r8,0.17658e-04_r8,0.18796e-04_r8 /) + kbo(:,27, 4) = (/ & + & 0.11433e-04_r8,0.12631e-04_r8,0.13757e-04_r8,0.14769e-04_r8,0.15677e-04_r8 /) + kbo(:,28, 4) = (/ & + & 0.96558e-05_r8,0.10640e-04_r8,0.11537e-04_r8,0.12357e-04_r8,0.13086e-04_r8 /) + kbo(:,29, 4) = (/ & + & 0.81632e-05_r8,0.89560e-05_r8,0.96801e-05_r8,0.10339e-04_r8,0.10919e-04_r8 /) + kbo(:,30, 4) = (/ & + & 0.68972e-05_r8,0.75321e-05_r8,0.81189e-05_r8,0.86418e-05_r8,0.91120e-05_r8 /) + kbo(:,31, 4) = (/ & + & 0.58255e-05_r8,0.63427e-05_r8,0.68115e-05_r8,0.72291e-05_r8,0.76088e-05_r8 /) + kbo(:,32, 4) = (/ & + & 0.49235e-05_r8,0.53404e-05_r8,0.57128e-05_r8,0.60450e-05_r8,0.63540e-05_r8 /) + kbo(:,33, 4) = (/ & + & 0.41602e-05_r8,0.44904e-05_r8,0.47873e-05_r8,0.50567e-05_r8,0.53085e-05_r8 /) + kbo(:,34, 4) = (/ & + & 0.34993e-05_r8,0.37640e-05_r8,0.40033e-05_r8,0.42217e-05_r8,0.44321e-05_r8 /) + kbo(:,35, 4) = (/ & + & 0.29168e-05_r8,0.31331e-05_r8,0.33264e-05_r8,0.35072e-05_r8,0.36808e-05_r8 /) + kbo(:,36, 4) = (/ & + & 0.24105e-05_r8,0.25863e-05_r8,0.27459e-05_r8,0.28969e-05_r8,0.30433e-05_r8 /) + kbo(:,37, 4) = (/ & + & 0.19699e-05_r8,0.21167e-05_r8,0.22499e-05_r8,0.23751e-05_r8,0.24984e-05_r8 /) + kbo(:,38, 4) = (/ & + & 0.16085e-05_r8,0.17316e-05_r8,0.18431e-05_r8,0.19482e-05_r8,0.20520e-05_r8 /) + kbo(:,39, 4) = (/ & + & 0.13140e-05_r8,0.14172e-05_r8,0.15102e-05_r8,0.15989e-05_r8,0.16862e-05_r8 /) + kbo(:,40, 4) = (/ & + & 0.10643e-05_r8,0.11518e-05_r8,0.12300e-05_r8,0.13052e-05_r8,0.13789e-05_r8 /) + kbo(:,41, 4) = (/ & + & 0.86103e-06_r8,0.93494e-06_r8,0.10013e-05_r8,0.10648e-05_r8,0.11275e-05_r8 /) + kbo(:,42, 4) = (/ & + & 0.69566e-06_r8,0.75803e-06_r8,0.81468e-06_r8,0.86817e-06_r8,0.92113e-06_r8 /) + kbo(:,43, 4) = (/ & + & 0.55856e-06_r8,0.61135e-06_r8,0.65992e-06_r8,0.70501e-06_r8,0.74915e-06_r8 /) + kbo(:,44, 4) = (/ & + & 0.44644e-06_r8,0.49113e-06_r8,0.53284e-06_r8,0.57066e-06_r8,0.60776e-06_r8 /) + kbo(:,45, 4) = (/ & + & 0.35638e-06_r8,0.39386e-06_r8,0.42947e-06_r8,0.46192e-06_r8,0.49295e-06_r8 /) + kbo(:,46, 4) = (/ & + & 0.28317e-06_r8,0.31490e-06_r8,0.34503e-06_r8,0.37276e-06_r8,0.39894e-06_r8 /) + kbo(:,47, 4) = (/ & + & 0.22341e-06_r8,0.25002e-06_r8,0.27560e-06_r8,0.29957e-06_r8,0.32144e-06_r8 /) + kbo(:,48, 4) = (/ & + & 0.17554e-06_r8,0.19798e-06_r8,0.21962e-06_r8,0.24010e-06_r8,0.25876e-06_r8 /) + kbo(:,49, 4) = (/ & + & 0.13737e-06_r8,0.15642e-06_r8,0.17451e-06_r8,0.19192e-06_r8,0.20795e-06_r8 /) + kbo(:,50, 4) = (/ & + & 0.10754e-06_r8,0.12357e-06_r8,0.13879e-06_r8,0.15343e-06_r8,0.16712e-06_r8 /) + kbo(:,51, 4) = (/ & + & 0.84121e-07_r8,0.97441e-07_r8,0.11018e-06_r8,0.12256e-06_r8,0.13419e-06_r8 /) + kbo(:,52, 4) = (/ & + & 0.65604e-07_r8,0.76564e-07_r8,0.87356e-07_r8,0.97703e-07_r8,0.10745e-06_r8 /) + kbo(:,53, 4) = (/ & + & 0.50943e-07_r8,0.59988e-07_r8,0.69048e-07_r8,0.77629e-07_r8,0.85933e-07_r8 /) + kbo(:,54, 4) = (/ & + & 0.39679e-07_r8,0.47121e-07_r8,0.54614e-07_r8,0.61766e-07_r8,0.68783e-07_r8 /) + kbo(:,55, 4) = (/ & + & 0.30934e-07_r8,0.36980e-07_r8,0.43113e-07_r8,0.49142e-07_r8,0.55005e-07_r8 /) + kbo(:,56, 4) = (/ & + & 0.24050e-07_r8,0.28923e-07_r8,0.33993e-07_r8,0.39047e-07_r8,0.43928e-07_r8 /) + kbo(:,57, 4) = (/ & + & 0.18660e-07_r8,0.22557e-07_r8,0.26748e-07_r8,0.30951e-07_r8,0.35000e-07_r8 /) + kbo(:,58, 4) = (/ & + & 0.14488e-07_r8,0.17625e-07_r8,0.21043e-07_r8,0.24511e-07_r8,0.27884e-07_r8 /) + kbo(:,59, 4) = (/ & + & 0.11674e-07_r8,0.14234e-07_r8,0.17044e-07_r8,0.19902e-07_r8,0.22702e-07_r8 /) + kbo(:,13, 5) = (/ & + & 0.36288e-03_r8,0.38577e-03_r8,0.40824e-03_r8,0.43207e-03_r8,0.45772e-03_r8 /) + kbo(:,14, 5) = (/ & + & 0.30781e-03_r8,0.32754e-03_r8,0.34745e-03_r8,0.36873e-03_r8,0.39050e-03_r8 /) + kbo(:,15, 5) = (/ & + & 0.26023e-03_r8,0.27734e-03_r8,0.29481e-03_r8,0.31288e-03_r8,0.33087e-03_r8 /) + kbo(:,16, 5) = (/ & + & 0.21963e-03_r8,0.23414e-03_r8,0.24882e-03_r8,0.26383e-03_r8,0.27866e-03_r8 /) + kbo(:,17, 5) = (/ & + & 0.18486e-03_r8,0.19716e-03_r8,0.20932e-03_r8,0.22139e-03_r8,0.23350e-03_r8 /) + kbo(:,18, 5) = (/ & + & 0.15516e-03_r8,0.16534e-03_r8,0.17526e-03_r8,0.18520e-03_r8,0.19528e-03_r8 /) + kbo(:,19, 5) = (/ & + & 0.12986e-03_r8,0.13820e-03_r8,0.14634e-03_r8,0.15465e-03_r8,0.16304e-03_r8 /) + kbo(:,20, 5) = (/ & + & 0.10854e-03_r8,0.11542e-03_r8,0.12213e-03_r8,0.12898e-03_r8,0.13583e-03_r8 /) + kbo(:,21, 5) = (/ & + & 0.90628e-04_r8,0.96255e-04_r8,0.10177e-03_r8,0.10738e-03_r8,0.11299e-03_r8 /) + kbo(:,22, 5) = (/ & + & 0.75891e-04_r8,0.80410e-04_r8,0.85018e-04_r8,0.89561e-04_r8,0.94064e-04_r8 /) + kbo(:,23, 5) = (/ & + & 0.63476e-04_r8,0.67177e-04_r8,0.70959e-04_r8,0.74590e-04_r8,0.78334e-04_r8 /) + kbo(:,24, 5) = (/ & + & 0.52999e-04_r8,0.56057e-04_r8,0.59157e-04_r8,0.62167e-04_r8,0.65272e-04_r8 /) + kbo(:,25, 5) = (/ & + & 0.44256e-04_r8,0.46783e-04_r8,0.49281e-04_r8,0.51789e-04_r8,0.54376e-04_r8 /) + kbo(:,26, 5) = (/ & + & 0.37011e-04_r8,0.39100e-04_r8,0.41098e-04_r8,0.43198e-04_r8,0.45322e-04_r8 /) + kbo(:,27, 5) = (/ & + & 0.30966e-04_r8,0.32635e-04_r8,0.34289e-04_r8,0.36026e-04_r8,0.37776e-04_r8 /) + kbo(:,28, 5) = (/ & + & 0.25866e-04_r8,0.27210e-04_r8,0.28616e-04_r8,0.30009e-04_r8,0.31487e-04_r8 /) + kbo(:,29, 5) = (/ & + & 0.21609e-04_r8,0.22715e-04_r8,0.23863e-04_r8,0.25052e-04_r8,0.26299e-04_r8 /) + kbo(:,30, 5) = (/ & + & 0.18055e-04_r8,0.18981e-04_r8,0.19946e-04_r8,0.20948e-04_r8,0.21978e-04_r8 /) + kbo(:,31, 5) = (/ & + & 0.15103e-04_r8,0.15890e-04_r8,0.16699e-04_r8,0.17556e-04_r8,0.18410e-04_r8 /) + kbo(:,32, 5) = (/ & + & 0.12647e-04_r8,0.13313e-04_r8,0.14001e-04_r8,0.14715e-04_r8,0.15427e-04_r8 /) + kbo(:,33, 5) = (/ & + & 0.10601e-04_r8,0.11164e-04_r8,0.11755e-04_r8,0.12351e-04_r8,0.12931e-04_r8 /) + kbo(:,34, 5) = (/ & + & 0.88699e-05_r8,0.93482e-05_r8,0.98481e-05_r8,0.10351e-04_r8,0.10829e-04_r8 /) + kbo(:,35, 5) = (/ & + & 0.73864e-05_r8,0.77932e-05_r8,0.82148e-05_r8,0.86289e-05_r8,0.90270e-05_r8 /) + kbo(:,36, 5) = (/ & + & 0.61189e-05_r8,0.64631e-05_r8,0.68137e-05_r8,0.71535e-05_r8,0.74761e-05_r8 /) + kbo(:,37, 5) = (/ & + & 0.50349e-05_r8,0.53216e-05_r8,0.56110e-05_r8,0.58984e-05_r8,0.61738e-05_r8 /) + kbo(:,38, 5) = (/ & + & 0.41408e-05_r8,0.43804e-05_r8,0.46209e-05_r8,0.48585e-05_r8,0.50962e-05_r8 /) + kbo(:,39, 5) = (/ & + & 0.34100e-05_r8,0.36097e-05_r8,0.38105e-05_r8,0.40114e-05_r8,0.42081e-05_r8 /) + kbo(:,40, 5) = (/ & + & 0.27924e-05_r8,0.29567e-05_r8,0.31274e-05_r8,0.32925e-05_r8,0.34580e-05_r8 /) + kbo(:,41, 5) = (/ & + & 0.22821e-05_r8,0.24196e-05_r8,0.25613e-05_r8,0.27009e-05_r8,0.28413e-05_r8 /) + kbo(:,42, 5) = (/ & + & 0.18665e-05_r8,0.19799e-05_r8,0.20975e-05_r8,0.22150e-05_r8,0.23326e-05_r8 /) + kbo(:,43, 5) = (/ & + & 0.15195e-05_r8,0.16130e-05_r8,0.17109e-05_r8,0.18095e-05_r8,0.19094e-05_r8 /) + kbo(:,44, 5) = (/ & + & 0.12351e-05_r8,0.13129e-05_r8,0.13926e-05_r8,0.14756e-05_r8,0.15593e-05_r8 /) + kbo(:,45, 5) = (/ & + & 0.10023e-05_r8,0.10671e-05_r8,0.11334e-05_r8,0.12033e-05_r8,0.12728e-05_r8 /) + kbo(:,46, 5) = (/ & + & 0.81269e-06_r8,0.86595e-06_r8,0.92094e-06_r8,0.97875e-06_r8,0.10378e-05_r8 /) + kbo(:,47, 5) = (/ & + & 0.65647e-06_r8,0.70081e-06_r8,0.74604e-06_r8,0.79395e-06_r8,0.84339e-06_r8 /) + kbo(:,48, 5) = (/ & + & 0.53019e-06_r8,0.56638e-06_r8,0.60399e-06_r8,0.64368e-06_r8,0.68472e-06_r8 /) + kbo(:,49, 5) = (/ & + & 0.42776e-06_r8,0.45739e-06_r8,0.48880e-06_r8,0.52108e-06_r8,0.55567e-06_r8 /) + kbo(:,50, 5) = (/ & + & 0.34556e-06_r8,0.36989e-06_r8,0.39599e-06_r8,0.42284e-06_r8,0.45123e-06_r8 /) + kbo(:,51, 5) = (/ & + & 0.27905e-06_r8,0.29932e-06_r8,0.32065e-06_r8,0.34295e-06_r8,0.36646e-06_r8 /) + kbo(:,52, 5) = (/ & + & 0.22522e-06_r8,0.24196e-06_r8,0.25940e-06_r8,0.27788e-06_r8,0.29753e-06_r8 /) + kbo(:,53, 5) = (/ & + & 0.18137e-06_r8,0.19527e-06_r8,0.20965e-06_r8,0.22512e-06_r8,0.24112e-06_r8 /) + kbo(:,54, 5) = (/ & + & 0.14606e-06_r8,0.15795e-06_r8,0.16971e-06_r8,0.18256e-06_r8,0.19571e-06_r8 /) + kbo(:,55, 5) = (/ & + & 0.11745e-06_r8,0.12764e-06_r8,0.13751e-06_r8,0.14796e-06_r8,0.15891e-06_r8 /) + kbo(:,56, 5) = (/ & + & 0.94319e-07_r8,0.10301e-06_r8,0.11131e-06_r8,0.11979e-06_r8,0.12892e-06_r8 /) + kbo(:,57, 5) = (/ & + & 0.75512e-07_r8,0.83064e-07_r8,0.90010e-07_r8,0.96928e-07_r8,0.10441e-06_r8 /) + kbo(:,58, 5) = (/ & + & 0.60409e-07_r8,0.66900e-07_r8,0.72712e-07_r8,0.78451e-07_r8,0.84657e-07_r8 /) + kbo(:,59, 5) = (/ & + & 0.49299e-07_r8,0.54731e-07_r8,0.59628e-07_r8,0.64415e-07_r8,0.69585e-07_r8 /) + kbo(:,13, 6) = (/ & + & 0.85498e-03_r8,0.88654e-03_r8,0.92216e-03_r8,0.96018e-03_r8,0.10038e-02_r8 /) + kbo(:,14, 6) = (/ & + & 0.72755e-03_r8,0.75503e-03_r8,0.78615e-03_r8,0.82104e-03_r8,0.86252e-03_r8 /) + kbo(:,15, 6) = (/ & + & 0.61644e-03_r8,0.64130e-03_r8,0.66934e-03_r8,0.70298e-03_r8,0.74077e-03_r8 /) + kbo(:,16, 6) = (/ & + & 0.52100e-03_r8,0.54364e-03_r8,0.57046e-03_r8,0.60137e-03_r8,0.63388e-03_r8 /) + kbo(:,17, 6) = (/ & + & 0.43945e-03_r8,0.46060e-03_r8,0.48533e-03_r8,0.51276e-03_r8,0.54036e-03_r8 /) + kbo(:,18, 6) = (/ & + & 0.37082e-03_r8,0.39025e-03_r8,0.41242e-03_r8,0.43532e-03_r8,0.45905e-03_r8 /) + kbo(:,19, 6) = (/ & + & 0.31280e-03_r8,0.33005e-03_r8,0.34867e-03_r8,0.36806e-03_r8,0.38776e-03_r8 /) + kbo(:,20, 6) = (/ & + & 0.26373e-03_r8,0.27881e-03_r8,0.29445e-03_r8,0.31046e-03_r8,0.32667e-03_r8 /) + kbo(:,21, 6) = (/ & + & 0.22211e-03_r8,0.23470e-03_r8,0.24766e-03_r8,0.26115e-03_r8,0.27459e-03_r8 /) + kbo(:,22, 6) = (/ & + & 0.18729e-03_r8,0.19773e-03_r8,0.20869e-03_r8,0.22010e-03_r8,0.23102e-03_r8 /) + kbo(:,23, 6) = (/ & + & 0.15755e-03_r8,0.16634e-03_r8,0.17574e-03_r8,0.18527e-03_r8,0.19396e-03_r8 /) + kbo(:,24, 6) = (/ & + & 0.13244e-03_r8,0.14003e-03_r8,0.14791e-03_r8,0.15556e-03_r8,0.16235e-03_r8 /) + kbo(:,25, 6) = (/ & + & 0.11137e-03_r8,0.11779e-03_r8,0.12437e-03_r8,0.13036e-03_r8,0.13579e-03_r8 /) + kbo(:,26, 6) = (/ & + & 0.93817e-04_r8,0.99206e-04_r8,0.10452e-03_r8,0.10918e-03_r8,0.11356e-03_r8 /) + kbo(:,27, 6) = (/ & + & 0.79006e-04_r8,0.83531e-04_r8,0.87717e-04_r8,0.91355e-04_r8,0.95066e-04_r8 /) + kbo(:,28, 6) = (/ & + & 0.66464e-04_r8,0.70180e-04_r8,0.73412e-04_r8,0.76548e-04_r8,0.79673e-04_r8 /) + kbo(:,29, 6) = (/ & + & 0.55955e-04_r8,0.58876e-04_r8,0.61539e-04_r8,0.64161e-04_r8,0.66744e-04_r8 /) + kbo(:,30, 6) = (/ & + & 0.47057e-04_r8,0.49392e-04_r8,0.51539e-04_r8,0.53762e-04_r8,0.55883e-04_r8 /) + kbo(:,31, 6) = (/ & + & 0.39571e-04_r8,0.41398e-04_r8,0.43230e-04_r8,0.45052e-04_r8,0.46859e-04_r8 /) + kbo(:,32, 6) = (/ & + & 0.33232e-04_r8,0.34753e-04_r8,0.36306e-04_r8,0.37802e-04_r8,0.39368e-04_r8 /) + kbo(:,33, 6) = (/ & + & 0.27886e-04_r8,0.29183e-04_r8,0.30428e-04_r8,0.31753e-04_r8,0.33114e-04_r8 /) + kbo(:,34, 6) = (/ & + & 0.23408e-04_r8,0.24477e-04_r8,0.25555e-04_r8,0.26683e-04_r8,0.27811e-04_r8 /) + kbo(:,35, 6) = (/ & + & 0.19576e-04_r8,0.20476e-04_r8,0.21380e-04_r8,0.22323e-04_r8,0.23289e-04_r8 /) + kbo(:,36, 6) = (/ & + & 0.16284e-04_r8,0.17049e-04_r8,0.17816e-04_r8,0.18626e-04_r8,0.19444e-04_r8 /) + kbo(:,37, 6) = (/ & + & 0.13488e-04_r8,0.14134e-04_r8,0.14781e-04_r8,0.15488e-04_r8,0.16173e-04_r8 /) + kbo(:,38, 6) = (/ & + & 0.11176e-04_r8,0.11721e-04_r8,0.12278e-04_r8,0.12866e-04_r8,0.13450e-04_r8 /) + kbo(:,39, 6) = (/ & + & 0.92494e-05_r8,0.97155e-05_r8,0.10200e-04_r8,0.10699e-04_r8,0.11199e-04_r8 /) + kbo(:,40, 6) = (/ & + & 0.76168e-05_r8,0.80109e-05_r8,0.84197e-05_r8,0.88496e-05_r8,0.92853e-05_r8 /) + kbo(:,41, 6) = (/ & + & 0.62645e-05_r8,0.66003e-05_r8,0.69472e-05_r8,0.73123e-05_r8,0.76881e-05_r8 /) + kbo(:,42, 6) = (/ & + & 0.51581e-05_r8,0.54373e-05_r8,0.57325e-05_r8,0.60421e-05_r8,0.63612e-05_r8 /) + kbo(:,43, 6) = (/ & + & 0.42336e-05_r8,0.44705e-05_r8,0.47241e-05_r8,0.49790e-05_r8,0.52554e-05_r8 /) + kbo(:,44, 6) = (/ & + & 0.34635e-05_r8,0.36643e-05_r8,0.38777e-05_r8,0.40942e-05_r8,0.43335e-05_r8 /) + kbo(:,45, 6) = (/ & + & 0.28355e-05_r8,0.30041e-05_r8,0.31829e-05_r8,0.33678e-05_r8,0.35664e-05_r8 /) + kbo(:,46, 6) = (/ & + & 0.23151e-05_r8,0.24589e-05_r8,0.26085e-05_r8,0.27655e-05_r8,0.29287e-05_r8 /) + kbo(:,47, 6) = (/ & + & 0.18832e-05_r8,0.20045e-05_r8,0.21306e-05_r8,0.22633e-05_r8,0.24025e-05_r8 /) + kbo(:,48, 6) = (/ & + & 0.15291e-05_r8,0.16326e-05_r8,0.17368e-05_r8,0.18516e-05_r8,0.19681e-05_r8 /) + kbo(:,49, 6) = (/ & + & 0.12403e-05_r8,0.13270e-05_r8,0.14154e-05_r8,0.15108e-05_r8,0.16100e-05_r8 /) + kbo(:,50, 6) = (/ & + & 0.10056e-05_r8,0.10792e-05_r8,0.11542e-05_r8,0.12335e-05_r8,0.13173e-05_r8 /) + kbo(:,51, 6) = (/ & + & 0.81549e-06_r8,0.87791e-06_r8,0.94116e-06_r8,0.10080e-05_r8,0.10781e-05_r8 /) + kbo(:,52, 6) = (/ & + & 0.66029e-06_r8,0.71307e-06_r8,0.76617e-06_r8,0.82179e-06_r8,0.88107e-06_r8 /) + kbo(:,53, 6) = (/ & + & 0.53353e-06_r8,0.57858e-06_r8,0.62276e-06_r8,0.66919e-06_r8,0.71931e-06_r8 /) + kbo(:,54, 6) = (/ & + & 0.43199e-06_r8,0.46970e-06_r8,0.50695e-06_r8,0.54584e-06_r8,0.58793e-06_r8 /) + kbo(:,55, 6) = (/ & + & 0.34966e-06_r8,0.38119e-06_r8,0.41298e-06_r8,0.44530e-06_r8,0.48058e-06_r8 /) + kbo(:,56, 6) = (/ & + & 0.28227e-06_r8,0.30903e-06_r8,0.33563e-06_r8,0.36285e-06_r8,0.39216e-06_r8 /) + kbo(:,57, 6) = (/ & + & 0.22764e-06_r8,0.25006e-06_r8,0.27265e-06_r8,0.29503e-06_r8,0.31940e-06_r8 /) + kbo(:,58, 6) = (/ & + & 0.18380e-06_r8,0.20248e-06_r8,0.22144e-06_r8,0.24002e-06_r8,0.25999e-06_r8 /) + kbo(:,59, 6) = (/ & + & 0.15102e-06_r8,0.16680e-06_r8,0.18267e-06_r8,0.19825e-06_r8,0.21512e-06_r8 /) + kbo(:,13, 7) = (/ & + & 0.20763e-02_r8,0.21202e-02_r8,0.21697e-02_r8,0.22297e-02_r8,0.22985e-02_r8 /) + kbo(:,14, 7) = (/ & + & 0.17631e-02_r8,0.18004e-02_r8,0.18452e-02_r8,0.18998e-02_r8,0.19604e-02_r8 /) + kbo(:,15, 7) = (/ & + & 0.14970e-02_r8,0.15286e-02_r8,0.15695e-02_r8,0.16172e-02_r8,0.16748e-02_r8 /) + kbo(:,16, 7) = (/ & + & 0.12672e-02_r8,0.12965e-02_r8,0.13340e-02_r8,0.13795e-02_r8,0.14367e-02_r8 /) + kbo(:,17, 7) = (/ & + & 0.10695e-02_r8,0.10974e-02_r8,0.11329e-02_r8,0.11783e-02_r8,0.12365e-02_r8 /) + kbo(:,18, 7) = (/ & + & 0.90477e-03_r8,0.93070e-03_r8,0.96470e-03_r8,0.10105e-02_r8,0.10654e-02_r8 /) + kbo(:,19, 7) = (/ & + & 0.76431e-03_r8,0.79078e-03_r8,0.82660e-03_r8,0.86991e-03_r8,0.91843e-03_r8 /) + kbo(:,20, 7) = (/ & + & 0.64676e-03_r8,0.67404e-03_r8,0.70901e-03_r8,0.74996e-03_r8,0.79243e-03_r8 /) + kbo(:,21, 7) = (/ & + & 0.54776e-03_r8,0.57523e-03_r8,0.60880e-03_r8,0.64511e-03_r8,0.68243e-03_r8 /) + kbo(:,22, 7) = (/ & + & 0.46614e-03_r8,0.49254e-03_r8,0.52330e-03_r8,0.55502e-03_r8,0.58894e-03_r8 /) + kbo(:,23, 7) = (/ & + & 0.39726e-03_r8,0.42201e-03_r8,0.44841e-03_r8,0.47653e-03_r8,0.50717e-03_r8 /) + kbo(:,24, 7) = (/ & + & 0.33898e-03_r8,0.36121e-03_r8,0.38421e-03_r8,0.40924e-03_r8,0.43694e-03_r8 /) + kbo(:,25, 7) = (/ & + & 0.28981e-03_r8,0.30891e-03_r8,0.32925e-03_r8,0.35185e-03_r8,0.37616e-03_r8 /) + kbo(:,26, 7) = (/ & + & 0.24765e-03_r8,0.26436e-03_r8,0.28268e-03_r8,0.30306e-03_r8,0.32381e-03_r8 /) + kbo(:,27, 7) = (/ & + & 0.21161e-03_r8,0.22639e-03_r8,0.24293e-03_r8,0.26080e-03_r8,0.27811e-03_r8 /) + kbo(:,28, 7) = (/ & + & 0.18103e-03_r8,0.19425e-03_r8,0.20911e-03_r8,0.22426e-03_r8,0.23882e-03_r8 /) + kbo(:,29, 7) = (/ & + & 0.15524e-03_r8,0.16726e-03_r8,0.18025e-03_r8,0.19313e-03_r8,0.20539e-03_r8 /) + kbo(:,30, 7) = (/ & + & 0.13346e-03_r8,0.14432e-03_r8,0.15555e-03_r8,0.16625e-03_r8,0.17682e-03_r8 /) + kbo(:,31, 7) = (/ & + & 0.11513e-03_r8,0.12466e-03_r8,0.13417e-03_r8,0.14329e-03_r8,0.15286e-03_r8 /) + kbo(:,32, 7) = (/ & + & 0.99437e-04_r8,0.10768e-03_r8,0.11569e-03_r8,0.12397e-03_r8,0.13224e-03_r8 /) + kbo(:,33, 7) = (/ & + & 0.85975e-04_r8,0.92901e-04_r8,0.10007e-03_r8,0.10742e-03_r8,0.11487e-03_r8 /) + kbo(:,34, 7) = (/ & + & 0.74186e-04_r8,0.80283e-04_r8,0.86524e-04_r8,0.92965e-04_r8,0.99720e-04_r8 /) + kbo(:,35, 7) = (/ & + & 0.63518e-04_r8,0.68833e-04_r8,0.74348e-04_r8,0.80205e-04_r8,0.86286e-04_r8 /) + kbo(:,36, 7) = (/ & + & 0.53971e-04_r8,0.58710e-04_r8,0.63581e-04_r8,0.68731e-04_r8,0.74066e-04_r8 /) + kbo(:,37, 7) = (/ & + & 0.45287e-04_r8,0.49433e-04_r8,0.53695e-04_r8,0.58207e-04_r8,0.62933e-04_r8 /) + kbo(:,38, 7) = (/ & + & 0.37993e-04_r8,0.41562e-04_r8,0.45327e-04_r8,0.49315e-04_r8,0.53437e-04_r8 /) + kbo(:,39, 7) = (/ & + & 0.31889e-04_r8,0.34954e-04_r8,0.38268e-04_r8,0.41760e-04_r8,0.45472e-04_r8 /) + kbo(:,40, 7) = (/ & + & 0.26490e-04_r8,0.29130e-04_r8,0.31995e-04_r8,0.35094e-04_r8,0.38302e-04_r8 /) + kbo(:,41, 7) = (/ & + & 0.21977e-04_r8,0.24258e-04_r8,0.26702e-04_r8,0.29405e-04_r8,0.32254e-04_r8 /) + kbo(:,42, 7) = (/ & + & 0.18218e-04_r8,0.20180e-04_r8,0.22299e-04_r8,0.24616e-04_r8,0.27154e-04_r8 /) + kbo(:,43, 7) = (/ & + & 0.15034e-04_r8,0.16668e-04_r8,0.18493e-04_r8,0.20514e-04_r8,0.22747e-04_r8 /) + kbo(:,44, 7) = (/ & + & 0.12376e-04_r8,0.13730e-04_r8,0.15276e-04_r8,0.16983e-04_r8,0.18913e-04_r8 /) + kbo(:,45, 7) = (/ & + & 0.10149e-04_r8,0.11314e-04_r8,0.12590e-04_r8,0.14099e-04_r8,0.15742e-04_r8 /) + kbo(:,46, 7) = (/ & + & 0.82889e-05_r8,0.92859e-05_r8,0.10354e-04_r8,0.11603e-04_r8,0.13042e-04_r8 /) + kbo(:,47, 7) = (/ & + & 0.67264e-05_r8,0.75707e-05_r8,0.84748e-05_r8,0.95081e-05_r8,0.10721e-04_r8 /) + kbo(:,48, 7) = (/ & + & 0.54454e-05_r8,0.61678e-05_r8,0.69329e-05_r8,0.77845e-05_r8,0.87984e-05_r8 /) + kbo(:,49, 7) = (/ & + & 0.43942e-05_r8,0.50075e-05_r8,0.56558e-05_r8,0.63802e-05_r8,0.72168e-05_r8 /) + kbo(:,50, 7) = (/ & + & 0.35518e-05_r8,0.40682e-05_r8,0.46246e-05_r8,0.52318e-05_r8,0.59289e-05_r8 /) + kbo(:,51, 7) = (/ & + & 0.28695e-05_r8,0.33032e-05_r8,0.37766e-05_r8,0.42938e-05_r8,0.48871e-05_r8 /) + kbo(:,52, 7) = (/ & + & 0.23151e-05_r8,0.26733e-05_r8,0.30760e-05_r8,0.35184e-05_r8,0.40216e-05_r8 /) + kbo(:,53, 7) = (/ & + & 0.18635e-05_r8,0.21569e-05_r8,0.24979e-05_r8,0.28705e-05_r8,0.33004e-05_r8 /) + kbo(:,54, 7) = (/ & + & 0.15043e-05_r8,0.17492e-05_r8,0.20309e-05_r8,0.23469e-05_r8,0.27129e-05_r8 /) + kbo(:,55, 7) = (/ & + & 0.12156e-05_r8,0.14170e-05_r8,0.16506e-05_r8,0.19188e-05_r8,0.22303e-05_r8 /) + kbo(:,56, 7) = (/ & + & 0.98090e-06_r8,0.11440e-05_r8,0.13395e-05_r8,0.15647e-05_r8,0.18280e-05_r8 /) + kbo(:,57, 7) = (/ & + & 0.79029e-06_r8,0.92216e-06_r8,0.10880e-05_r8,0.12732e-05_r8,0.14934e-05_r8 /) + kbo(:,58, 7) = (/ & + & 0.63691e-06_r8,0.74365e-06_r8,0.88187e-06_r8,0.10375e-05_r8,0.12193e-05_r8 /) + kbo(:,59, 7) = (/ & + & 0.52696e-06_r8,0.61783e-06_r8,0.73672e-06_r8,0.87054e-06_r8,0.10284e-05_r8 /) + kbo(:,13, 8) = (/ & + & 0.57453e-02_r8,0.59077e-02_r8,0.61032e-02_r8,0.63038e-02_r8,0.65156e-02_r8 /) + kbo(:,14, 8) = (/ & + & 0.49738e-02_r8,0.51301e-02_r8,0.52927e-02_r8,0.54623e-02_r8,0.56575e-02_r8 /) + kbo(:,15, 8) = (/ & + & 0.43017e-02_r8,0.44326e-02_r8,0.45703e-02_r8,0.47292e-02_r8,0.49039e-02_r8 /) + kbo(:,16, 8) = (/ & + & 0.37082e-02_r8,0.38170e-02_r8,0.39427e-02_r8,0.40844e-02_r8,0.42438e-02_r8 /) + kbo(:,17, 8) = (/ & + & 0.31847e-02_r8,0.32833e-02_r8,0.33960e-02_r8,0.35252e-02_r8,0.36740e-02_r8 /) + kbo(:,18, 8) = (/ & + & 0.27225e-02_r8,0.28155e-02_r8,0.29216e-02_r8,0.30449e-02_r8,0.31911e-02_r8 /) + kbo(:,19, 8) = (/ & + & 0.23309e-02_r8,0.24127e-02_r8,0.25113e-02_r8,0.26325e-02_r8,0.27748e-02_r8 /) + kbo(:,20, 8) = (/ & + & 0.19939e-02_r8,0.20703e-02_r8,0.21659e-02_r8,0.22816e-02_r8,0.24232e-02_r8 /) + kbo(:,21, 8) = (/ & + & 0.17051e-02_r8,0.17809e-02_r8,0.18754e-02_r8,0.19919e-02_r8,0.21299e-02_r8 /) + kbo(:,22, 8) = (/ & + & 0.14632e-02_r8,0.15412e-02_r8,0.16376e-02_r8,0.17554e-02_r8,0.18936e-02_r8 /) + kbo(:,23, 8) = (/ & + & 0.12639e-02_r8,0.13422e-02_r8,0.14407e-02_r8,0.15575e-02_r8,0.16941e-02_r8 /) + kbo(:,24, 8) = (/ & + & 0.10971e-02_r8,0.11767e-02_r8,0.12764e-02_r8,0.13939e-02_r8,0.15238e-02_r8 /) + kbo(:,25, 8) = (/ & + & 0.95870e-03_r8,0.10413e-02_r8,0.11414e-02_r8,0.12556e-02_r8,0.13798e-02_r8 /) + kbo(:,26, 8) = (/ & + & 0.84686e-03_r8,0.93021e-03_r8,0.10287e-02_r8,0.11374e-02_r8,0.12572e-02_r8 /) + kbo(:,27, 8) = (/ & + & 0.75447e-03_r8,0.83724e-03_r8,0.93234e-03_r8,0.10369e-02_r8,0.11513e-02_r8 /) + kbo(:,28, 8) = (/ & + & 0.67798e-03_r8,0.75937e-03_r8,0.85009e-03_r8,0.95072e-03_r8,0.10606e-02_r8 /) + kbo(:,29, 8) = (/ & + & 0.61364e-03_r8,0.69262e-03_r8,0.77994e-03_r8,0.87674e-03_r8,0.98252e-03_r8 /) + kbo(:,30, 8) = (/ & + & 0.55903e-03_r8,0.63520e-03_r8,0.71974e-03_r8,0.81322e-03_r8,0.91554e-03_r8 /) + kbo(:,31, 8) = (/ & + & 0.51301e-03_r8,0.58698e-03_r8,0.66923e-03_r8,0.75972e-03_r8,0.85851e-03_r8 /) + kbo(:,32, 8) = (/ & + & 0.47350e-03_r8,0.54617e-03_r8,0.62663e-03_r8,0.71470e-03_r8,0.81105e-03_r8 /) + kbo(:,33, 8) = (/ & + & 0.44016e-03_r8,0.51136e-03_r8,0.58994e-03_r8,0.67638e-03_r8,0.77061e-03_r8 /) + kbo(:,34, 8) = (/ & + & 0.40944e-03_r8,0.47900e-03_r8,0.55611e-03_r8,0.64143e-03_r8,0.73316e-03_r8 /) + kbo(:,35, 8) = (/ & + & 0.37741e-03_r8,0.44487e-03_r8,0.52031e-03_r8,0.60323e-03_r8,0.69243e-03_r8 /) + kbo(:,36, 8) = (/ & + & 0.34297e-03_r8,0.40766e-03_r8,0.48086e-03_r8,0.56132e-03_r8,0.64787e-03_r8 /) + kbo(:,37, 8) = (/ & + & 0.30431e-03_r8,0.36499e-03_r8,0.43465e-03_r8,0.51167e-03_r8,0.59496e-03_r8 /) + kbo(:,38, 8) = (/ & + & 0.26970e-03_r8,0.32665e-03_r8,0.39267e-03_r8,0.46706e-03_r8,0.54760e-03_r8 /) + kbo(:,39, 8) = (/ & + & 0.23923e-03_r8,0.29254e-03_r8,0.35537e-03_r8,0.42706e-03_r8,0.50543e-03_r8 /) + kbo(:,40, 8) = (/ & + & 0.20758e-03_r8,0.25688e-03_r8,0.31519e-03_r8,0.38349e-03_r8,0.45925e-03_r8 /) + kbo(:,41, 8) = (/ & + & 0.17937e-03_r8,0.22435e-03_r8,0.27886e-03_r8,0.34337e-03_r8,0.41641e-03_r8 /) + kbo(:,42, 8) = (/ & + & 0.15469e-03_r8,0.19589e-03_r8,0.24606e-03_r8,0.30674e-03_r8,0.37723e-03_r8 /) + kbo(:,43, 8) = (/ & + & 0.13101e-03_r8,0.16796e-03_r8,0.21371e-03_r8,0.26992e-03_r8,0.33751e-03_r8 /) + kbo(:,44, 8) = (/ & + & 0.10980e-03_r8,0.14260e-03_r8,0.18396e-03_r8,0.23557e-03_r8,0.29905e-03_r8 /) + kbo(:,45, 8) = (/ & + & 0.91682e-04_r8,0.12045e-03_r8,0.15770e-03_r8,0.20472e-03_r8,0.26370e-03_r8 /) + kbo(:,46, 8) = (/ & + & 0.75628e-04_r8,0.10059e-03_r8,0.13347e-03_r8,0.17595e-03_r8,0.22995e-03_r8 /) + kbo(:,47, 8) = (/ & + & 0.61269e-04_r8,0.82597e-04_r8,0.11115e-03_r8,0.14863e-03_r8,0.19734e-03_r8 /) + kbo(:,48, 8) = (/ & + & 0.49295e-04_r8,0.67304e-04_r8,0.91698e-04_r8,0.12475e-03_r8,0.16838e-03_r8 /) + kbo(:,49, 8) = (/ & + & 0.39400e-04_r8,0.54424e-04_r8,0.75252e-04_r8,0.10388e-03_r8,0.14254e-03_r8 /) + kbo(:,50, 8) = (/ & + & 0.31621e-04_r8,0.44130e-04_r8,0.61905e-04_r8,0.86583e-04_r8,0.12082e-03_r8 /) + kbo(:,51, 8) = (/ & + & 0.25214e-04_r8,0.35613e-04_r8,0.50609e-04_r8,0.71998e-04_r8,0.10219e-03_r8 /) + kbo(:,52, 8) = (/ & + & 0.20045e-04_r8,0.28626e-04_r8,0.41171e-04_r8,0.59458e-04_r8,0.85829e-04_r8 /) + kbo(:,53, 8) = (/ & + & 0.15795e-04_r8,0.22859e-04_r8,0.33218e-04_r8,0.48810e-04_r8,0.71516e-04_r8 /) + kbo(:,54, 8) = (/ & + & 0.12537e-04_r8,0.18343e-04_r8,0.26979e-04_r8,0.40183e-04_r8,0.59926e-04_r8 /) + kbo(:,55, 8) = (/ & + & 0.99418e-05_r8,0.14675e-04_r8,0.21893e-04_r8,0.33017e-04_r8,0.50138e-04_r8 /) + kbo(:,56, 8) = (/ & + & 0.78293e-05_r8,0.11672e-04_r8,0.17663e-04_r8,0.26975e-04_r8,0.41690e-04_r8 /) + kbo(:,57, 8) = (/ & + & 0.61519e-05_r8,0.92383e-05_r8,0.14184e-04_r8,0.21901e-04_r8,0.34420e-04_r8 /) + kbo(:,58, 8) = (/ & + & 0.48509e-05_r8,0.73119e-05_r8,0.11341e-04_r8,0.17783e-04_r8,0.28416e-04_r8 /) + kbo(:,59, 8) = (/ & + & 0.41003e-05_r8,0.62461e-05_r8,0.98307e-05_r8,0.15678e-04_r8,0.25521e-04_r8 /) + kbo(:,13, 9) = (/ & + & 0.31088e-01_r8,0.30978e-01_r8,0.31134e-01_r8,0.31580e-01_r8,0.32297e-01_r8 /) + kbo(:,14, 9) = (/ & + & 0.26804e-01_r8,0.26913e-01_r8,0.27323e-01_r8,0.28019e-01_r8,0.28853e-01_r8 /) + kbo(:,15, 9) = (/ & + & 0.23192e-01_r8,0.23530e-01_r8,0.24156e-01_r8,0.24918e-01_r8,0.25770e-01_r8 /) + kbo(:,16, 9) = (/ & + & 0.20205e-01_r8,0.20738e-01_r8,0.21411e-01_r8,0.22189e-01_r8,0.23073e-01_r8 /) + kbo(:,17, 9) = (/ & + & 0.17721e-01_r8,0.18309e-01_r8,0.19005e-01_r8,0.19816e-01_r8,0.20712e-01_r8 /) + kbo(:,18, 9) = (/ & + & 0.15569e-01_r8,0.16175e-01_r8,0.16902e-01_r8,0.17717e-01_r8,0.18588e-01_r8 /) + kbo(:,19, 9) = (/ & + & 0.13679e-01_r8,0.14314e-01_r8,0.15046e-01_r8,0.15840e-01_r8,0.16695e-01_r8 /) + kbo(:,20, 9) = (/ & + & 0.12060e-01_r8,0.12704e-01_r8,0.13416e-01_r8,0.14184e-01_r8,0.14994e-01_r8 /) + kbo(:,21, 9) = (/ & + & 0.10678e-01_r8,0.11296e-01_r8,0.11975e-01_r8,0.12694e-01_r8,0.13474e-01_r8 /) + kbo(:,22, 9) = (/ & + & 0.95206e-02_r8,0.10114e-01_r8,0.10744e-01_r8,0.11429e-01_r8,0.12190e-01_r8 /) + kbo(:,23, 9) = (/ & + & 0.85244e-02_r8,0.90705e-02_r8,0.96690e-02_r8,0.10334e-01_r8,0.11084e-01_r8 /) + kbo(:,24, 9) = (/ & + & 0.76472e-02_r8,0.81682e-02_r8,0.87428e-02_r8,0.93948e-02_r8,0.10155e-01_r8 /) + kbo(:,25, 9) = (/ & + & 0.68906e-02_r8,0.73887e-02_r8,0.79555e-02_r8,0.86116e-02_r8,0.93920e-02_r8 /) + kbo(:,26, 9) = (/ & + & 0.62406e-02_r8,0.67330e-02_r8,0.73033e-02_r8,0.79807e-02_r8,0.87803e-02_r8 /) + kbo(:,27, 9) = (/ & + & 0.56879e-02_r8,0.61818e-02_r8,0.67732e-02_r8,0.74721e-02_r8,0.82924e-02_r8 /) + kbo(:,28, 9) = (/ & + & 0.52214e-02_r8,0.57290e-02_r8,0.63416e-02_r8,0.70614e-02_r8,0.79109e-02_r8 /) + kbo(:,29, 9) = (/ & + & 0.48396e-02_r8,0.53718e-02_r8,0.60023e-02_r8,0.67493e-02_r8,0.76290e-02_r8 /) + kbo(:,30, 9) = (/ & + & 0.45394e-02_r8,0.50868e-02_r8,0.57419e-02_r8,0.65213e-02_r8,0.74390e-02_r8 /) + kbo(:,31, 9) = (/ & + & 0.42997e-02_r8,0.48721e-02_r8,0.55579e-02_r8,0.63736e-02_r8,0.73370e-02_r8 /) + kbo(:,32, 9) = (/ & + & 0.41212e-02_r8,0.47209e-02_r8,0.54422e-02_r8,0.62987e-02_r8,0.73128e-02_r8 /) + kbo(:,33, 9) = (/ & + & 0.39976e-02_r8,0.46295e-02_r8,0.53893e-02_r8,0.62949e-02_r8,0.73658e-02_r8 /) + kbo(:,34, 9) = (/ & + & 0.39007e-02_r8,0.45672e-02_r8,0.53672e-02_r8,0.63167e-02_r8,0.74374e-02_r8 /) + kbo(:,35, 9) = (/ & + & 0.37869e-02_r8,0.44770e-02_r8,0.53019e-02_r8,0.62849e-02_r8,0.74424e-02_r8 /) + kbo(:,36, 9) = (/ & + & 0.36393e-02_r8,0.43376e-02_r8,0.51746e-02_r8,0.61726e-02_r8,0.73435e-02_r8 /) + kbo(:,37, 9) = (/ & + & 0.34235e-02_r8,0.41098e-02_r8,0.49353e-02_r8,0.59226e-02_r8,0.70781e-02_r8 /) + kbo(:,38, 9) = (/ & + & 0.32247e-02_r8,0.38981e-02_r8,0.47125e-02_r8,0.56849e-02_r8,0.68251e-02_r8 /) + kbo(:,39, 9) = (/ & + & 0.30456e-02_r8,0.37107e-02_r8,0.45116e-02_r8,0.54683e-02_r8,0.65906e-02_r8 /) + kbo(:,40, 9) = (/ & + & 0.28232e-02_r8,0.34654e-02_r8,0.42389e-02_r8,0.51610e-02_r8,0.62484e-02_r8 /) + kbo(:,41, 9) = (/ & + & 0.26119e-02_r8,0.32290e-02_r8,0.39730e-02_r8,0.48613e-02_r8,0.59121e-02_r8 /) + kbo(:,42, 9) = (/ & + & 0.24180e-02_r8,0.30088e-02_r8,0.37246e-02_r8,0.45813e-02_r8,0.55929e-02_r8 /) + kbo(:,43, 9) = (/ & + & 0.22093e-02_r8,0.27691e-02_r8,0.34494e-02_r8,0.42630e-02_r8,0.52317e-02_r8 /) + kbo(:,44, 9) = (/ & + & 0.20033e-02_r8,0.25304e-02_r8,0.31741e-02_r8,0.39439e-02_r8,0.48637e-02_r8 /) + kbo(:,45, 9) = (/ & + & 0.18130e-02_r8,0.23086e-02_r8,0.29181e-02_r8,0.36487e-02_r8,0.45175e-02_r8 /) + kbo(:,46, 9) = (/ & + & 0.16283e-02_r8,0.20910e-02_r8,0.26646e-02_r8,0.33526e-02_r8,0.41695e-02_r8 /) + kbo(:,47, 9) = (/ & + & 0.14435e-02_r8,0.18702e-02_r8,0.24020e-02_r8,0.30439e-02_r8,0.38103e-02_r8 /) + kbo(:,48, 9) = (/ & + & 0.12773e-02_r8,0.16671e-02_r8,0.21576e-02_r8,0.27587e-02_r8,0.34731e-02_r8 /) + kbo(:,49, 9) = (/ & + & 0.11238e-02_r8,0.14806e-02_r8,0.19320e-02_r8,0.24920e-02_r8,0.31602e-02_r8 /) + kbo(:,50, 9) = (/ & + & 0.99065e-03_r8,0.13211e-02_r8,0.17354e-02_r8,0.22582e-02_r8,0.28857e-02_r8 /) + kbo(:,51, 9) = (/ & + & 0.87220e-03_r8,0.11790e-02_r8,0.15607e-02_r8,0.20453e-02_r8,0.26367e-02_r8 /) + kbo(:,52, 9) = (/ & + & 0.76443e-03_r8,0.10482e-02_r8,0.13992e-02_r8,0.18469e-02_r8,0.24023e-02_r8 /) + kbo(:,53, 9) = (/ & + & 0.66506e-03_r8,0.92645e-03_r8,0.12548e-02_r8,0.16624e-02_r8,0.21789e-02_r8 /) + kbo(:,54, 9) = (/ & + & 0.58147e-03_r8,0.82449e-03_r8,0.11302e-02_r8,0.15093e-02_r8,0.19886e-02_r8 /) + kbo(:,55, 9) = (/ & + & 0.50762e-03_r8,0.73235e-03_r8,0.10182e-02_r8,0.13732e-02_r8,0.18200e-02_r8 /) + kbo(:,56, 9) = (/ & + & 0.44063e-03_r8,0.64710e-03_r8,0.91345e-03_r8,0.12471e-02_r8,0.16632e-02_r8 /) + kbo(:,57, 9) = (/ & + & 0.37891e-03_r8,0.56859e-03_r8,0.81680e-03_r8,0.11290e-02_r8,0.15165e-02_r8 /) + kbo(:,58, 9) = (/ & + & 0.32563e-03_r8,0.50022e-03_r8,0.73037e-03_r8,0.10236e-02_r8,0.13873e-02_r8 /) + kbo(:,59, 9) = (/ & + & 0.30307e-03_r8,0.47208e-03_r8,0.69548e-03_r8,0.98198e-03_r8,0.13371e-02_r8 /) + kbo(:,13,10) = (/ & + & 0.13405e+00_r8,0.13208e+00_r8,0.13012e+00_r8,0.12819e+00_r8,0.12637e+00_r8 /) + kbo(:,14,10) = (/ & + & 0.11726e+00_r8,0.11549e+00_r8,0.11376e+00_r8,0.11219e+00_r8,0.11171e+00_r8 /) + kbo(:,15,10) = (/ & + & 0.10125e+00_r8,0.99749e-01_r8,0.98394e-01_r8,0.98385e-01_r8,0.99981e-01_r8 /) + kbo(:,16,10) = (/ & + & 0.86553e-01_r8,0.85383e-01_r8,0.85602e-01_r8,0.87440e-01_r8,0.89929e-01_r8 /) + kbo(:,17,10) = (/ & + & 0.73963e-01_r8,0.74028e-01_r8,0.75744e-01_r8,0.77969e-01_r8,0.80306e-01_r8 /) + kbo(:,18,10) = (/ & + & 0.64249e-01_r8,0.65620e-01_r8,0.67504e-01_r8,0.69584e-01_r8,0.72235e-01_r8 /) + kbo(:,19,10) = (/ & + & 0.56934e-01_r8,0.58613e-01_r8,0.60462e-01_r8,0.62855e-01_r8,0.65899e-01_r8 /) + kbo(:,20,10) = (/ & + & 0.50721e-01_r8,0.52418e-01_r8,0.54615e-01_r8,0.57565e-01_r8,0.61049e-01_r8 /) + kbo(:,21,10) = (/ & + & 0.45027e-01_r8,0.47161e-01_r8,0.49911e-01_r8,0.53249e-01_r8,0.56950e-01_r8 /) + kbo(:,22,10) = (/ & + & 0.40301e-01_r8,0.42891e-01_r8,0.46164e-01_r8,0.49801e-01_r8,0.53839e-01_r8 /) + kbo(:,23,10) = (/ & + & 0.36438e-01_r8,0.39487e-01_r8,0.43011e-01_r8,0.46965e-01_r8,0.50969e-01_r8 /) + kbo(:,24,10) = (/ & + & 0.33455e-01_r8,0.36675e-01_r8,0.40451e-01_r8,0.44369e-01_r8,0.48399e-01_r8 /) + kbo(:,25,10) = (/ & + & 0.31038e-01_r8,0.34461e-01_r8,0.38146e-01_r8,0.42075e-01_r8,0.46138e-01_r8 /) + kbo(:,26,10) = (/ & + & 0.29184e-01_r8,0.32533e-01_r8,0.36194e-01_r8,0.40134e-01_r8,0.44371e-01_r8 /) + kbo(:,27,10) = (/ & + & 0.27607e-01_r8,0.30907e-01_r8,0.34540e-01_r8,0.38584e-01_r8,0.43101e-01_r8 /) + kbo(:,28,10) = (/ & + & 0.26262e-01_r8,0.29536e-01_r8,0.33259e-01_r8,0.37529e-01_r8,0.42311e-01_r8 /) + kbo(:,29,10) = (/ & + & 0.25199e-01_r8,0.28472e-01_r8,0.32405e-01_r8,0.36927e-01_r8,0.42052e-01_r8 /) + kbo(:,30,10) = (/ & + & 0.24317e-01_r8,0.27783e-01_r8,0.31948e-01_r8,0.36772e-01_r8,0.42176e-01_r8 /) + kbo(:,31,10) = (/ & + & 0.23777e-01_r8,0.27457e-01_r8,0.31879e-01_r8,0.37001e-01_r8,0.42663e-01_r8 /) + kbo(:,32,10) = (/ & + & 0.23540e-01_r8,0.27481e-01_r8,0.32177e-01_r8,0.37596e-01_r8,0.43567e-01_r8 /) + kbo(:,33,10) = (/ & + & 0.23597e-01_r8,0.27797e-01_r8,0.32792e-01_r8,0.38465e-01_r8,0.44641e-01_r8 /) + kbo(:,34,10) = (/ & + & 0.23769e-01_r8,0.28231e-01_r8,0.33430e-01_r8,0.39373e-01_r8,0.45740e-01_r8 /) + kbo(:,35,10) = (/ & + & 0.23751e-01_r8,0.28376e-01_r8,0.33764e-01_r8,0.39814e-01_r8,0.46255e-01_r8 /) + kbo(:,36,10) = (/ & + & 0.23409e-01_r8,0.28117e-01_r8,0.33564e-01_r8,0.39651e-01_r8,0.46138e-01_r8 /) + kbo(:,37,10) = (/ & + & 0.22508e-01_r8,0.27169e-01_r8,0.32556e-01_r8,0.38592e-01_r8,0.45071e-01_r8 /) + kbo(:,38,10) = (/ & + & 0.21655e-01_r8,0.26262e-01_r8,0.31543e-01_r8,0.37540e-01_r8,0.43984e-01_r8 /) + kbo(:,39,10) = (/ & + & 0.20895e-01_r8,0.25391e-01_r8,0.30600e-01_r8,0.36519e-01_r8,0.42890e-01_r8 /) + kbo(:,40,10) = (/ & + & 0.19794e-01_r8,0.24108e-01_r8,0.29157e-01_r8,0.34891e-01_r8,0.41215e-01_r8 /) + kbo(:,41,10) = (/ & + & 0.18688e-01_r8,0.22822e-01_r8,0.27713e-01_r8,0.33302e-01_r8,0.39460e-01_r8 /) + kbo(:,42,10) = (/ & + & 0.17627e-01_r8,0.21623e-01_r8,0.26302e-01_r8,0.31747e-01_r8,0.37731e-01_r8 /) + kbo(:,43,10) = (/ & + & 0.16446e-01_r8,0.20270e-01_r8,0.24738e-01_r8,0.29940e-01_r8,0.35800e-01_r8 /) + kbo(:,44,10) = (/ & + & 0.15234e-01_r8,0.18876e-01_r8,0.23100e-01_r8,0.28072e-01_r8,0.33725e-01_r8 /) + kbo(:,45,10) = (/ & + & 0.14095e-01_r8,0.17542e-01_r8,0.21553e-01_r8,0.26276e-01_r8,0.31735e-01_r8 /) + kbo(:,46,10) = (/ & + & 0.12980e-01_r8,0.16215e-01_r8,0.20030e-01_r8,0.24474e-01_r8,0.29695e-01_r8 /) + kbo(:,47,10) = (/ & + & 0.11800e-01_r8,0.14839e-01_r8,0.18423e-01_r8,0.22582e-01_r8,0.27493e-01_r8 /) + kbo(:,48,10) = (/ & + & 0.10669e-01_r8,0.13547e-01_r8,0.16901e-01_r8,0.20822e-01_r8,0.25431e-01_r8 /) + kbo(:,49,10) = (/ & + & 0.96515e-02_r8,0.12347e-01_r8,0.15476e-01_r8,0.19181e-01_r8,0.23474e-01_r8 /) + kbo(:,50,10) = (/ & + & 0.87302e-02_r8,0.11282e-01_r8,0.14230e-01_r8,0.17719e-01_r8,0.21773e-01_r8 /) + kbo(:,51,10) = (/ & + & 0.78879e-02_r8,0.10297e-01_r8,0.13106e-01_r8,0.16387e-01_r8,0.20218e-01_r8 /) + kbo(:,52,10) = (/ & + & 0.71141e-02_r8,0.93631e-02_r8,0.12059e-01_r8,0.15140e-01_r8,0.18761e-01_r8 /) + kbo(:,53,10) = (/ & + & 0.64033e-02_r8,0.84706e-02_r8,0.11019e-01_r8,0.13962e-01_r8,0.17391e-01_r8 /) + kbo(:,54,10) = (/ & + & 0.58003e-02_r8,0.77325e-02_r8,0.10121e-01_r8,0.12913e-01_r8,0.16185e-01_r8 /) + kbo(:,55,10) = (/ & + & 0.52567e-02_r8,0.70672e-02_r8,0.93006e-02_r8,0.11949e-01_r8,0.15064e-01_r8 /) + kbo(:,56,10) = (/ & + & 0.47304e-02_r8,0.64466e-02_r8,0.85460e-02_r8,0.11037e-01_r8,0.13988e-01_r8 /) + kbo(:,57,10) = (/ & + & 0.42280e-02_r8,0.58745e-02_r8,0.78453e-02_r8,0.10192e-01_r8,0.12992e-01_r8 /) + kbo(:,58,10) = (/ & + & 0.37744e-02_r8,0.53584e-02_r8,0.72089e-02_r8,0.94309e-02_r8,0.12101e-01_r8 /) + kbo(:,59,10) = (/ & + & 0.36027e-02_r8,0.51588e-02_r8,0.69694e-02_r8,0.91382e-02_r8,0.11759e-01_r8 /) + kbo(:,13,11) = (/ & + & 0.24636e+00_r8,0.24379e+00_r8,0.24122e+00_r8,0.23863e+00_r8,0.23598e+00_r8 /) + kbo(:,14,11) = (/ & + & 0.22272e+00_r8,0.22032e+00_r8,0.21794e+00_r8,0.21559e+00_r8,0.21334e+00_r8 /) + kbo(:,15,11) = (/ & + & 0.19844e+00_r8,0.19619e+00_r8,0.19411e+00_r8,0.19222e+00_r8,0.19047e+00_r8 /) + kbo(:,16,11) = (/ & + & 0.17439e+00_r8,0.17254e+00_r8,0.17092e+00_r8,0.16946e+00_r8,0.16916e+00_r8 /) + kbo(:,17,11) = (/ & + & 0.15164e+00_r8,0.15027e+00_r8,0.14912e+00_r8,0.14939e+00_r8,0.15176e+00_r8 /) + kbo(:,18,11) = (/ & + & 0.13063e+00_r8,0.12971e+00_r8,0.13029e+00_r8,0.13302e+00_r8,0.13748e+00_r8 /) + kbo(:,19,11) = (/ & + & 0.11203e+00_r8,0.11247e+00_r8,0.11508e+00_r8,0.11959e+00_r8,0.12521e+00_r8 /) + kbo(:,20,11) = (/ & + & 0.96916e-01_r8,0.99041e-01_r8,0.10318e+00_r8,0.10837e+00_r8,0.11414e+00_r8 /) + kbo(:,21,11) = (/ & + & 0.85382e-01_r8,0.88824e-01_r8,0.93367e-01_r8,0.98603e-01_r8,0.10483e+00_r8 /) + kbo(:,22,11) = (/ & + & 0.76943e-01_r8,0.80844e-01_r8,0.85377e-01_r8,0.90964e-01_r8,0.97503e-01_r8 /) + kbo(:,23,11) = (/ & + & 0.70041e-01_r8,0.74136e-01_r8,0.79065e-01_r8,0.84905e-01_r8,0.92247e-01_r8 /) + kbo(:,24,11) = (/ & + & 0.64133e-01_r8,0.68708e-01_r8,0.74135e-01_r8,0.80762e-01_r8,0.88658e-01_r8 /) + kbo(:,25,11) = (/ & + & 0.59352e-01_r8,0.64474e-01_r8,0.70718e-01_r8,0.78064e-01_r8,0.86394e-01_r8 /) + kbo(:,26,11) = (/ & + & 0.55652e-01_r8,0.61613e-01_r8,0.68607e-01_r8,0.76451e-01_r8,0.85230e-01_r8 /) + kbo(:,27,11) = (/ & + & 0.53058e-01_r8,0.59792e-01_r8,0.67298e-01_r8,0.75623e-01_r8,0.84830e-01_r8 /) + kbo(:,28,11) = (/ & + & 0.51454e-01_r8,0.58747e-01_r8,0.66709e-01_r8,0.75478e-01_r8,0.85111e-01_r8 /) + kbo(:,29,11) = (/ & + & 0.50601e-01_r8,0.58412e-01_r8,0.66813e-01_r8,0.76014e-01_r8,0.86051e-01_r8 /) + kbo(:,30,11) = (/ & + & 0.50412e-01_r8,0.58677e-01_r8,0.67503e-01_r8,0.77079e-01_r8,0.87490e-01_r8 /) + kbo(:,31,11) = (/ & + & 0.50833e-01_r8,0.59491e-01_r8,0.68713e-01_r8,0.78659e-01_r8,0.89405e-01_r8 /) + kbo(:,32,11) = (/ & + & 0.51770e-01_r8,0.60792e-01_r8,0.70497e-01_r8,0.80769e-01_r8,0.91778e-01_r8 /) + kbo(:,33,11) = (/ & + & 0.53128e-01_r8,0.62590e-01_r8,0.72506e-01_r8,0.83033e-01_r8,0.94354e-01_r8 /) + kbo(:,34,11) = (/ & + & 0.54518e-01_r8,0.64238e-01_r8,0.74390e-01_r8,0.85011e-01_r8,0.96530e-01_r8 /) + kbo(:,35,11) = (/ & + & 0.55323e-01_r8,0.65129e-01_r8,0.75324e-01_r8,0.86085e-01_r8,0.97742e-01_r8 /) + kbo(:,36,11) = (/ & + & 0.55103e-01_r8,0.64989e-01_r8,0.75282e-01_r8,0.86060e-01_r8,0.97722e-01_r8 /) + kbo(:,37,11) = (/ & + & 0.53513e-01_r8,0.63398e-01_r8,0.73617e-01_r8,0.84326e-01_r8,0.95934e-01_r8 /) + kbo(:,38,11) = (/ & + & 0.51839e-01_r8,0.61729e-01_r8,0.71975e-01_r8,0.82585e-01_r8,0.94078e-01_r8 /) + kbo(:,39,11) = (/ & + & 0.50239e-01_r8,0.60161e-01_r8,0.70354e-01_r8,0.80923e-01_r8,0.92345e-01_r8 /) + kbo(:,40,11) = (/ & + & 0.47749e-01_r8,0.57519e-01_r8,0.67663e-01_r8,0.78238e-01_r8,0.89341e-01_r8 /) + kbo(:,41,11) = (/ & + & 0.45220e-01_r8,0.54835e-01_r8,0.64881e-01_r8,0.75369e-01_r8,0.86308e-01_r8 /) + kbo(:,42,11) = (/ & + & 0.42768e-01_r8,0.52225e-01_r8,0.62107e-01_r8,0.72467e-01_r8,0.83297e-01_r8 /) + kbo(:,43,11) = (/ & + & 0.39884e-01_r8,0.49090e-01_r8,0.58932e-01_r8,0.69072e-01_r8,0.79690e-01_r8 /) + kbo(:,44,11) = (/ & + & 0.36935e-01_r8,0.45822e-01_r8,0.55523e-01_r8,0.65525e-01_r8,0.76019e-01_r8 /) + kbo(:,45,11) = (/ & + & 0.34132e-01_r8,0.42684e-01_r8,0.52151e-01_r8,0.62095e-01_r8,0.72392e-01_r8 /) + kbo(:,46,11) = (/ & + & 0.31296e-01_r8,0.39456e-01_r8,0.48596e-01_r8,0.58446e-01_r8,0.68612e-01_r8 /) + kbo(:,47,11) = (/ & + & 0.28352e-01_r8,0.35994e-01_r8,0.44764e-01_r8,0.54432e-01_r8,0.64443e-01_r8 /) + kbo(:,48,11) = (/ & + & 0.25659e-01_r8,0.32738e-01_r8,0.41113e-01_r8,0.50437e-01_r8,0.60364e-01_r8 /) + kbo(:,49,11) = (/ & + & 0.23119e-01_r8,0.29700e-01_r8,0.37617e-01_r8,0.46554e-01_r8,0.56334e-01_r8 /) + kbo(:,50,11) = (/ & + & 0.20913e-01_r8,0.27063e-01_r8,0.34504e-01_r8,0.43055e-01_r8,0.52582e-01_r8 /) + kbo(:,51,11) = (/ & + & 0.18909e-01_r8,0.24701e-01_r8,0.31626e-01_r8,0.39797e-01_r8,0.48997e-01_r8 /) + kbo(:,52,11) = (/ & + & 0.17085e-01_r8,0.22478e-01_r8,0.28924e-01_r8,0.36689e-01_r8,0.45522e-01_r8 /) + kbo(:,53,11) = (/ & + & 0.15363e-01_r8,0.20405e-01_r8,0.26432e-01_r8,0.33725e-01_r8,0.42180e-01_r8 /) + kbo(:,54,11) = (/ & + & 0.13901e-01_r8,0.18604e-01_r8,0.24309e-01_r8,0.31149e-01_r8,0.39236e-01_r8 /) + kbo(:,55,11) = (/ & + & 0.12627e-01_r8,0.16988e-01_r8,0.22381e-01_r8,0.28834e-01_r8,0.36535e-01_r8 /) + kbo(:,56,11) = (/ & + & 0.11410e-01_r8,0.15484e-01_r8,0.20536e-01_r8,0.26668e-01_r8,0.33955e-01_r8 /) + kbo(:,57,11) = (/ & + & 0.10296e-01_r8,0.14074e-01_r8,0.18805e-01_r8,0.24610e-01_r8,0.31477e-01_r8 /) + kbo(:,58,11) = (/ & + & 0.93246e-02_r8,0.12835e-01_r8,0.17266e-01_r8,0.22752e-01_r8,0.29238e-01_r8 /) + kbo(:,59,11) = (/ & + & 0.89562e-02_r8,0.12359e-01_r8,0.16676e-01_r8,0.22030e-01_r8,0.28380e-01_r8 /) + kbo(:,13,12) = (/ & + & 0.46920e+00_r8,0.46679e+00_r8,0.46431e+00_r8,0.46162e+00_r8,0.45841e+00_r8 /) + kbo(:,14,12) = (/ & + & 0.44978e+00_r8,0.44747e+00_r8,0.44532e+00_r8,0.44273e+00_r8,0.44032e+00_r8 /) + kbo(:,15,12) = (/ & + & 0.42273e+00_r8,0.42112e+00_r8,0.41952e+00_r8,0.41793e+00_r8,0.41621e+00_r8 /) + kbo(:,16,12) = (/ & + & 0.39050e+00_r8,0.38973e+00_r8,0.38909e+00_r8,0.38861e+00_r8,0.38845e+00_r8 /) + kbo(:,17,12) = (/ & + & 0.35567e+00_r8,0.35584e+00_r8,0.35648e+00_r8,0.35743e+00_r8,0.35846e+00_r8 /) + kbo(:,18,12) = (/ & + & 0.32023e+00_r8,0.32164e+00_r8,0.32356e+00_r8,0.32582e+00_r8,0.32854e+00_r8 /) + kbo(:,19,12) = (/ & + & 0.28599e+00_r8,0.28851e+00_r8,0.29173e+00_r8,0.29552e+00_r8,0.30048e+00_r8 /) + kbo(:,20,12) = (/ & + & 0.25381e+00_r8,0.25750e+00_r8,0.26208e+00_r8,0.26822e+00_r8,0.27683e+00_r8 /) + kbo(:,21,12) = (/ & + & 0.22440e+00_r8,0.22938e+00_r8,0.23617e+00_r8,0.24559e+00_r8,0.25713e+00_r8 /) + kbo(:,22,12) = (/ & + & 0.19852e+00_r8,0.20554e+00_r8,0.21550e+00_r8,0.22788e+00_r8,0.24207e+00_r8 /) + kbo(:,23,12) = (/ & + & 0.17693e+00_r8,0.18660e+00_r8,0.19922e+00_r8,0.21410e+00_r8,0.23064e+00_r8 /) + kbo(:,24,12) = (/ & + & 0.16009e+00_r8,0.17209e+00_r8,0.18673e+00_r8,0.20389e+00_r8,0.22257e+00_r8 /) + kbo(:,25,12) = (/ & + & 0.14745e+00_r8,0.16127e+00_r8,0.17793e+00_r8,0.19685e+00_r8,0.21752e+00_r8 /) + kbo(:,26,12) = (/ & + & 0.13842e+00_r8,0.15401e+00_r8,0.17237e+00_r8,0.19313e+00_r8,0.21550e+00_r8 /) + kbo(:,27,12) = (/ & + & 0.13240e+00_r8,0.14962e+00_r8,0.16961e+00_r8,0.19199e+00_r8,0.21568e+00_r8 /) + kbo(:,28,12) = (/ & + & 0.12889e+00_r8,0.14761e+00_r8,0.16917e+00_r8,0.19286e+00_r8,0.21743e+00_r8 /) + kbo(:,29,12) = (/ & + & 0.12765e+00_r8,0.14781e+00_r8,0.17068e+00_r8,0.19527e+00_r8,0.22046e+00_r8 /) + kbo(:,30,12) = (/ & + & 0.12821e+00_r8,0.14964e+00_r8,0.17352e+00_r8,0.19873e+00_r8,0.22436e+00_r8 /) + kbo(:,31,12) = (/ & + & 0.13031e+00_r8,0.15282e+00_r8,0.17742e+00_r8,0.20308e+00_r8,0.22902e+00_r8 /) + kbo(:,32,12) = (/ & + & 0.13354e+00_r8,0.15691e+00_r8,0.18189e+00_r8,0.20791e+00_r8,0.23394e+00_r8 /) + kbo(:,33,12) = (/ & + & 0.13759e+00_r8,0.16158e+00_r8,0.18710e+00_r8,0.21336e+00_r8,0.23934e+00_r8 /) + kbo(:,34,12) = (/ & + & 0.14143e+00_r8,0.16592e+00_r8,0.19181e+00_r8,0.21830e+00_r8,0.24425e+00_r8 /) + kbo(:,35,12) = (/ & + & 0.14328e+00_r8,0.16813e+00_r8,0.19433e+00_r8,0.22092e+00_r8,0.24688e+00_r8 /) + kbo(:,36,12) = (/ & + & 0.14288e+00_r8,0.16783e+00_r8,0.19405e+00_r8,0.22076e+00_r8,0.24684e+00_r8 /) + kbo(:,37,12) = (/ & + & 0.13900e+00_r8,0.16377e+00_r8,0.19000e+00_r8,0.21677e+00_r8,0.24302e+00_r8 /) + kbo(:,38,12) = (/ & + & 0.13517e+00_r8,0.15969e+00_r8,0.18575e+00_r8,0.21259e+00_r8,0.23902e+00_r8 /) + kbo(:,39,12) = (/ & + & 0.13148e+00_r8,0.15568e+00_r8,0.18162e+00_r8,0.20849e+00_r8,0.23507e+00_r8 /) + kbo(:,40,12) = (/ & + & 0.12553e+00_r8,0.14932e+00_r8,0.17494e+00_r8,0.20171e+00_r8,0.22853e+00_r8 /) + kbo(:,41,12) = (/ & + & 0.11952e+00_r8,0.14280e+00_r8,0.16803e+00_r8,0.19459e+00_r8,0.22156e+00_r8 /) + kbo(:,42,12) = (/ & + & 0.11373e+00_r8,0.13636e+00_r8,0.16129e+00_r8,0.18763e+00_r8,0.21464e+00_r8 /) + kbo(:,43,12) = (/ & + & 0.10701e+00_r8,0.12880e+00_r8,0.15312e+00_r8,0.17916e+00_r8,0.20617e+00_r8 /) + kbo(:,44,12) = (/ & + & 0.10010e+00_r8,0.12097e+00_r8,0.14449e+00_r8,0.17006e+00_r8,0.19689e+00_r8 /) + kbo(:,45,12) = (/ & + & 0.93559e-01_r8,0.11347e+00_r8,0.13614e+00_r8,0.16117e+00_r8,0.18764e+00_r8 /) + kbo(:,46,12) = (/ & + & 0.86985e-01_r8,0.10587e+00_r8,0.12759e+00_r8,0.15183e+00_r8,0.17790e+00_r8 /) + kbo(:,47,12) = (/ & + & 0.79918e-01_r8,0.97829e-01_r8,0.11842e+00_r8,0.14172e+00_r8,0.16718e+00_r8 /) + kbo(:,48,12) = (/ & + & 0.73127e-01_r8,0.90284e-01_r8,0.10972e+00_r8,0.13198e+00_r8,0.15666e+00_r8 /) + kbo(:,49,12) = (/ & + & 0.66713e-01_r8,0.83137e-01_r8,0.10149e+00_r8,0.12264e+00_r8,0.14642e+00_r8 /) + kbo(:,50,12) = (/ & + & 0.61017e-01_r8,0.76653e-01_r8,0.94210e-01_r8,0.11429e+00_r8,0.13713e+00_r8 /) + kbo(:,51,12) = (/ & + & 0.55806e-01_r8,0.70628e-01_r8,0.87552e-01_r8,0.10658e+00_r8,0.12844e+00_r8 /) + kbo(:,52,12) = (/ & + & 0.50954e-01_r8,0.64939e-01_r8,0.81159e-01_r8,0.99264e-01_r8,0.12011e+00_r8 /) + kbo(:,53,12) = (/ & + & 0.46354e-01_r8,0.59512e-01_r8,0.74951e-01_r8,0.92338e-01_r8,0.11214e+00_r8 /) + kbo(:,54,12) = (/ & + & 0.42433e-01_r8,0.54851e-01_r8,0.69504e-01_r8,0.86317e-01_r8,0.10517e+00_r8 /) + kbo(:,55,12) = (/ & + & 0.38912e-01_r8,0.50588e-01_r8,0.64547e-01_r8,0.80719e-01_r8,0.98779e-01_r8 /) + kbo(:,56,12) = (/ & + & 0.35756e-01_r8,0.46572e-01_r8,0.59794e-01_r8,0.75289e-01_r8,0.92719e-01_r8 /) + kbo(:,57,12) = (/ & + & 0.32896e-01_r8,0.42811e-01_r8,0.55328e-01_r8,0.70070e-01_r8,0.86950e-01_r8 /) + kbo(:,58,12) = (/ & + & 0.30447e-01_r8,0.39485e-01_r8,0.51269e-01_r8,0.65351e-01_r8,0.81643e-01_r8 /) + kbo(:,59,12) = (/ & + & 0.29531e-01_r8,0.38222e-01_r8,0.49696e-01_r8,0.63514e-01_r8,0.79546e-01_r8 /) + kbo(:,13,13) = (/ & + & 0.87498e+00_r8,0.87414e+00_r8,0.87195e+00_r8,0.86869e+00_r8,0.86437e+00_r8 /) + kbo(:,14,13) = (/ & + & 0.90060e+00_r8,0.89974e+00_r8,0.89734e+00_r8,0.89423e+00_r8,0.88971e+00_r8 /) + kbo(:,15,13) = (/ & + & 0.91305e+00_r8,0.91211e+00_r8,0.91072e+00_r8,0.90792e+00_r8,0.90457e+00_r8 /) + kbo(:,16,13) = (/ & + & 0.91218e+00_r8,0.91265e+00_r8,0.91216e+00_r8,0.91150e+00_r8,0.90908e+00_r8 /) + kbo(:,17,13) = (/ & + & 0.89877e+00_r8,0.90187e+00_r8,0.90414e+00_r8,0.90531e+00_r8,0.90588e+00_r8 /) + kbo(:,18,13) = (/ & + & 0.87718e+00_r8,0.88256e+00_r8,0.88815e+00_r8,0.89271e+00_r8,0.89636e+00_r8 /) + kbo(:,19,13) = (/ & + & 0.84784e+00_r8,0.85815e+00_r8,0.86718e+00_r8,0.87552e+00_r8,0.88267e+00_r8 /) + kbo(:,20,13) = (/ & + & 0.81552e+00_r8,0.83012e+00_r8,0.84379e+00_r8,0.85649e+00_r8,0.86736e+00_r8 /) + kbo(:,21,13) = (/ & + & 0.78216e+00_r8,0.80141e+00_r8,0.82018e+00_r8,0.83708e+00_r8,0.85197e+00_r8 /) + kbo(:,22,13) = (/ & + & 0.75119e+00_r8,0.77590e+00_r8,0.79904e+00_r8,0.81994e+00_r8,0.83870e+00_r8 /) + kbo(:,23,13) = (/ & + & 0.72390e+00_r8,0.75373e+00_r8,0.78079e+00_r8,0.80579e+00_r8,0.82760e+00_r8 /) + kbo(:,24,13) = (/ & + & 0.70145e+00_r8,0.73523e+00_r8,0.76640e+00_r8,0.79456e+00_r8,0.81899e+00_r8 /) + kbo(:,25,13) = (/ & + & 0.68406e+00_r8,0.72159e+00_r8,0.75604e+00_r8,0.78669e+00_r8,0.81321e+00_r8 /) + kbo(:,26,13) = (/ & + & 0.67200e+00_r8,0.71253e+00_r8,0.74968e+00_r8,0.78214e+00_r8,0.81015e+00_r8 /) + kbo(:,27,13) = (/ & + & 0.66447e+00_r8,0.70740e+00_r8,0.74639e+00_r8,0.77996e+00_r8,0.80903e+00_r8 /) + kbo(:,28,13) = (/ & + & 0.66095e+00_r8,0.70586e+00_r8,0.74565e+00_r8,0.77995e+00_r8,0.80973e+00_r8 /) + kbo(:,29,13) = (/ & + & 0.66138e+00_r8,0.70727e+00_r8,0.74725e+00_r8,0.78204e+00_r8,0.81205e+00_r8 /) + kbo(:,30,13) = (/ & + & 0.66437e+00_r8,0.71055e+00_r8,0.75066e+00_r8,0.78572e+00_r8,0.81538e+00_r8 /) + kbo(:,31,13) = (/ & + & 0.66969e+00_r8,0.71558e+00_r8,0.75561e+00_r8,0.79049e+00_r8,0.81954e+00_r8 /) + kbo(:,32,13) = (/ & + & 0.67664e+00_r8,0.72206e+00_r8,0.76182e+00_r8,0.79609e+00_r8,0.82431e+00_r8 /) + kbo(:,33,13) = (/ & + & 0.68486e+00_r8,0.72960e+00_r8,0.76872e+00_r8,0.80214e+00_r8,0.82949e+00_r8 /) + kbo(:,34,13) = (/ & + & 0.69234e+00_r8,0.73624e+00_r8,0.77485e+00_r8,0.80729e+00_r8,0.83397e+00_r8 /) + kbo(:,35,13) = (/ & + & 0.69580e+00_r8,0.73958e+00_r8,0.77791e+00_r8,0.80990e+00_r8,0.83618e+00_r8 /) + kbo(:,36,13) = (/ & + & 0.69461e+00_r8,0.73878e+00_r8,0.77738e+00_r8,0.80959e+00_r8,0.83608e+00_r8 /) + kbo(:,37,13) = (/ & + & 0.68652e+00_r8,0.73194e+00_r8,0.77165e+00_r8,0.80500e+00_r8,0.83229e+00_r8 /) + kbo(:,38,13) = (/ & + & 0.67804e+00_r8,0.72484e+00_r8,0.76560e+00_r8,0.80009e+00_r8,0.82834e+00_r8 /) + kbo(:,39,13) = (/ & + & 0.66970e+00_r8,0.71778e+00_r8,0.75963e+00_r8,0.79504e+00_r8,0.82429e+00_r8 /) + kbo(:,40,13) = (/ & + & 0.65605e+00_r8,0.70590e+00_r8,0.74946e+00_r8,0.78658e+00_r8,0.81742e+00_r8 /) + kbo(:,41,13) = (/ & + & 0.64137e+00_r8,0.69306e+00_r8,0.73837e+00_r8,0.77717e+00_r8,0.80985e+00_r8 /) + kbo(:,42,13) = (/ & + & 0.62638e+00_r8,0.67987e+00_r8,0.72699e+00_r8,0.76756e+00_r8,0.80186e+00_r8 /) + kbo(:,43,13) = (/ & + & 0.60761e+00_r8,0.66320e+00_r8,0.71239e+00_r8,0.75526e+00_r8,0.79130e+00_r8 /) + kbo(:,44,13) = (/ & + & 0.58682e+00_r8,0.64468e+00_r8,0.69616e+00_r8,0.74131e+00_r8,0.77948e+00_r8 /) + kbo(:,45,13) = (/ & + & 0.56554e+00_r8,0.62545e+00_r8,0.67917e+00_r8,0.72630e+00_r8,0.76697e+00_r8 /) + kbo(:,46,13) = (/ & + & 0.54212e+00_r8,0.60419e+00_r8,0.66020e+00_r8,0.70997e+00_r8,0.75300e+00_r8 /) + kbo(:,47,13) = (/ & + & 0.51537e+00_r8,0.57955e+00_r8,0.63814e+00_r8,0.69060e+00_r8,0.73632e+00_r8 /) + kbo(:,48,13) = (/ & + & 0.48823e+00_r8,0.55406e+00_r8,0.61515e+00_r8,0.67007e+00_r8,0.71851e+00_r8 /) + kbo(:,49,13) = (/ & + & 0.46082e+00_r8,0.52769e+00_r8,0.59101e+00_r8,0.64854e+00_r8,0.69978e+00_r8 /) + kbo(:,50,13) = (/ & + & 0.43478e+00_r8,0.50249e+00_r8,0.56761e+00_r8,0.62745e+00_r8,0.68113e+00_r8 /) + kbo(:,51,13) = (/ & + & 0.40951e+00_r8,0.47777e+00_r8,0.54418e+00_r8,0.60613e+00_r8,0.66212e+00_r8 /) + kbo(:,52,13) = (/ & + & 0.38439e+00_r8,0.45288e+00_r8,0.52007e+00_r8,0.58405e+00_r8,0.64238e+00_r8 /) + kbo(:,53,13) = (/ & + & 0.35936e+00_r8,0.42773e+00_r8,0.49564e+00_r8,0.56121e+00_r8,0.62177e+00_r8 /) + kbo(:,54,13) = (/ & + & 0.33659e+00_r8,0.40461e+00_r8,0.47296e+00_r8,0.53959e+00_r8,0.60208e+00_r8 /) + kbo(:,55,13) = (/ & + & 0.31505e+00_r8,0.38259e+00_r8,0.45108e+00_r8,0.51845e+00_r8,0.58256e+00_r8 /) + kbo(:,56,13) = (/ & + & 0.29381e+00_r8,0.36074e+00_r8,0.42910e+00_r8,0.49702e+00_r8,0.56263e+00_r8 /) + kbo(:,57,13) = (/ & + & 0.27284e+00_r8,0.33897e+00_r8,0.40701e+00_r8,0.47542e+00_r8,0.54206e+00_r8 /) + kbo(:,58,13) = (/ & + & 0.25321e+00_r8,0.31859e+00_r8,0.38622e+00_r8,0.45477e+00_r8,0.52205e+00_r8 /) + kbo(:,59,13) = (/ & + & 0.24543e+00_r8,0.31049e+00_r8,0.37793e+00_r8,0.44646e+00_r8,0.51396e+00_r8 /) + kbo(:,13,14) = (/ & + & 0.17373e+01_r8,0.17393e+01_r8,0.17383e+01_r8,0.17344e+01_r8,0.17279e+01_r8 /) + kbo(:,14,14) = (/ & + & 0.18339e+01_r8,0.18343e+01_r8,0.18325e+01_r8,0.18267e+01_r8,0.18189e+01_r8 /) + kbo(:,15,14) = (/ & + & 0.19299e+01_r8,0.19296e+01_r8,0.19248e+01_r8,0.19184e+01_r8,0.19080e+01_r8 /) + kbo(:,16,14) = (/ & + & 0.20259e+01_r8,0.20224e+01_r8,0.20169e+01_r8,0.20066e+01_r8,0.19945e+01_r8 /) + kbo(:,17,14) = (/ & + & 0.21175e+01_r8,0.21127e+01_r8,0.21039e+01_r8,0.20921e+01_r8,0.20768e+01_r8 /) + kbo(:,18,14) = (/ & + & 0.22042e+01_r8,0.21972e+01_r8,0.21859e+01_r8,0.21721e+01_r8,0.21537e+01_r8 /) + kbo(:,19,14) = (/ & + & 0.22848e+01_r8,0.22747e+01_r8,0.22622e+01_r8,0.22448e+01_r8,0.22240e+01_r8 /) + kbo(:,20,14) = (/ & + & 0.23560e+01_r8,0.23462e+01_r8,0.23302e+01_r8,0.23098e+01_r8,0.22867e+01_r8 /) + kbo(:,21,14) = (/ & + & 0.24183e+01_r8,0.24082e+01_r8,0.23905e+01_r8,0.23680e+01_r8,0.23418e+01_r8 /) + kbo(:,22,14) = (/ & + & 0.24717e+01_r8,0.24598e+01_r8,0.24413e+01_r8,0.24169e+01_r8,0.23867e+01_r8 /) + kbo(:,23,14) = (/ & + & 0.25171e+01_r8,0.25034e+01_r8,0.24840e+01_r8,0.24570e+01_r8,0.24242e+01_r8 /) + kbo(:,24,14) = (/ & + & 0.25547e+01_r8,0.25403e+01_r8,0.25194e+01_r8,0.24898e+01_r8,0.24547e+01_r8 /) + kbo(:,25,14) = (/ & + & 0.25855e+01_r8,0.25703e+01_r8,0.25468e+01_r8,0.25156e+01_r8,0.24784e+01_r8 /) + kbo(:,26,14) = (/ & + & 0.26110e+01_r8,0.25944e+01_r8,0.25683e+01_r8,0.25352e+01_r8,0.24957e+01_r8 /) + kbo(:,27,14) = (/ & + & 0.26319e+01_r8,0.26130e+01_r8,0.25843e+01_r8,0.25495e+01_r8,0.25077e+01_r8 /) + kbo(:,28,14) = (/ & + & 0.26480e+01_r8,0.26264e+01_r8,0.25959e+01_r8,0.25590e+01_r8,0.25150e+01_r8 /) + kbo(:,29,14) = (/ & + & 0.26603e+01_r8,0.26355e+01_r8,0.26036e+01_r8,0.25644e+01_r8,0.25186e+01_r8 /) + kbo(:,30,14) = (/ & + & 0.26690e+01_r8,0.26417e+01_r8,0.26076e+01_r8,0.25661e+01_r8,0.25188e+01_r8 /) + kbo(:,31,14) = (/ & + & 0.26742e+01_r8,0.26446e+01_r8,0.26086e+01_r8,0.25648e+01_r8,0.25163e+01_r8 /) + kbo(:,32,14) = (/ & + & 0.26768e+01_r8,0.26452e+01_r8,0.26068e+01_r8,0.25609e+01_r8,0.25113e+01_r8 /) + kbo(:,33,14) = (/ & + & 0.26771e+01_r8,0.26434e+01_r8,0.26028e+01_r8,0.25551e+01_r8,0.25044e+01_r8 /) + kbo(:,34,14) = (/ & + & 0.26762e+01_r8,0.26409e+01_r8,0.25981e+01_r8,0.25494e+01_r8,0.24981e+01_r8 /) + kbo(:,35,14) = (/ & + & 0.26773e+01_r8,0.26407e+01_r8,0.25970e+01_r8,0.25475e+01_r8,0.24957e+01_r8 /) + kbo(:,36,14) = (/ & + & 0.26808e+01_r8,0.26440e+01_r8,0.25999e+01_r8,0.25501e+01_r8,0.24981e+01_r8 /) + kbo(:,37,14) = (/ & + & 0.26888e+01_r8,0.26526e+01_r8,0.26095e+01_r8,0.25599e+01_r8,0.25079e+01_r8 /) + kbo(:,38,14) = (/ & + & 0.26963e+01_r8,0.26609e+01_r8,0.26186e+01_r8,0.25695e+01_r8,0.25177e+01_r8 /) + kbo(:,39,14) = (/ & + & 0.27030e+01_r8,0.26686e+01_r8,0.26272e+01_r8,0.25787e+01_r8,0.25269e+01_r8 /) + kbo(:,40,14) = (/ & + & 0.27118e+01_r8,0.26792e+01_r8,0.26399e+01_r8,0.25927e+01_r8,0.25414e+01_r8 /) + kbo(:,41,14) = (/ & + & 0.27201e+01_r8,0.26898e+01_r8,0.26520e+01_r8,0.26068e+01_r8,0.25561e+01_r8 /) + kbo(:,42,14) = (/ & + & 0.27274e+01_r8,0.27000e+01_r8,0.26636e+01_r8,0.26203e+01_r8,0.25704e+01_r8 /) + kbo(:,43,14) = (/ & + & 0.27341e+01_r8,0.27108e+01_r8,0.26767e+01_r8,0.26357e+01_r8,0.25871e+01_r8 /) + kbo(:,44,14) = (/ & + & 0.27398e+01_r8,0.27209e+01_r8,0.26898e+01_r8,0.26513e+01_r8,0.26050e+01_r8 /) + kbo(:,45,14) = (/ & + & 0.27435e+01_r8,0.27298e+01_r8,0.27021e+01_r8,0.26655e+01_r8,0.26220e+01_r8 /) + kbo(:,46,14) = (/ & + & 0.27454e+01_r8,0.27371e+01_r8,0.27139e+01_r8,0.26799e+01_r8,0.26391e+01_r8 /) + kbo(:,47,14) = (/ & + & 0.27460e+01_r8,0.27424e+01_r8,0.27253e+01_r8,0.26950e+01_r8,0.26569e+01_r8 /) + kbo(:,48,14) = (/ & + & 0.27436e+01_r8,0.27457e+01_r8,0.27342e+01_r8,0.27088e+01_r8,0.26736e+01_r8 /) + kbo(:,49,14) = (/ & + & 0.27370e+01_r8,0.27470e+01_r8,0.27411e+01_r8,0.27207e+01_r8,0.26888e+01_r8 /) + kbo(:,50,14) = (/ & + & 0.27269e+01_r8,0.27459e+01_r8,0.27451e+01_r8,0.27305e+01_r8,0.27022e+01_r8 /) + kbo(:,51,14) = (/ & + & 0.27139e+01_r8,0.27424e+01_r8,0.27470e+01_r8,0.27377e+01_r8,0.27140e+01_r8 /) + kbo(:,52,14) = (/ & + & 0.26965e+01_r8,0.27350e+01_r8,0.27474e+01_r8,0.27429e+01_r8,0.27243e+01_r8 /) + kbo(:,53,14) = (/ & + & 0.26758e+01_r8,0.27241e+01_r8,0.27457e+01_r8,0.27461e+01_r8,0.27331e+01_r8 /) + kbo(:,54,14) = (/ & + & 0.26529e+01_r8,0.27108e+01_r8,0.27417e+01_r8,0.27475e+01_r8,0.27393e+01_r8 /) + kbo(:,55,14) = (/ & + & 0.26271e+01_r8,0.26955e+01_r8,0.27349e+01_r8,0.27476e+01_r8,0.27437e+01_r8 /) + kbo(:,56,14) = (/ & + & 0.25970e+01_r8,0.26775e+01_r8,0.27251e+01_r8,0.27462e+01_r8,0.27464e+01_r8 /) + kbo(:,57,14) = (/ & + & 0.25617e+01_r8,0.26559e+01_r8,0.27125e+01_r8,0.27426e+01_r8,0.27477e+01_r8 /) + kbo(:,58,14) = (/ & + & 0.25247e+01_r8,0.26320e+01_r8,0.26988e+01_r8,0.27363e+01_r8,0.27482e+01_r8 /) + kbo(:,59,14) = (/ & + & 0.25089e+01_r8,0.26212e+01_r8,0.26923e+01_r8,0.27333e+01_r8,0.27480e+01_r8 /) + kbo(:,13,15) = (/ & + & 0.36859e+01_r8,0.36950e+01_r8,0.36942e+01_r8,0.36830e+01_r8,0.36649e+01_r8 /) + kbo(:,14,15) = (/ & + & 0.41563e+01_r8,0.41556e+01_r8,0.41430e+01_r8,0.41233e+01_r8,0.40913e+01_r8 /) + kbo(:,15,15) = (/ & + & 0.46342e+01_r8,0.46206e+01_r8,0.45970e+01_r8,0.45604e+01_r8,0.45153e+01_r8 /) + kbo(:,16,15) = (/ & + & 0.51044e+01_r8,0.50788e+01_r8,0.50384e+01_r8,0.49882e+01_r8,0.49250e+01_r8 /) + kbo(:,17,15) = (/ & + & 0.55612e+01_r8,0.55175e+01_r8,0.54618e+01_r8,0.53932e+01_r8,0.53123e+01_r8 /) + kbo(:,18,15) = (/ & + & 0.59883e+01_r8,0.59323e+01_r8,0.58578e+01_r8,0.57682e+01_r8,0.56700e+01_r8 /) + kbo(:,19,15) = (/ & + & 0.63852e+01_r8,0.63106e+01_r8,0.62177e+01_r8,0.61123e+01_r8,0.59947e+01_r8 /) + kbo(:,20,15) = (/ & + & 0.67473e+01_r8,0.66496e+01_r8,0.65407e+01_r8,0.64159e+01_r8,0.62789e+01_r8 /) + kbo(:,21,15) = (/ & + & 0.70720e+01_r8,0.69522e+01_r8,0.68220e+01_r8,0.66792e+01_r8,0.65258e+01_r8 /) + kbo(:,22,15) = (/ & + & 0.73512e+01_r8,0.72082e+01_r8,0.70565e+01_r8,0.68942e+01_r8,0.67258e+01_r8 /) + kbo(:,23,15) = (/ & + & 0.75866e+01_r8,0.74239e+01_r8,0.72515e+01_r8,0.70718e+01_r8,0.68886e+01_r8 /) + kbo(:,24,15) = (/ & + & 0.77818e+01_r8,0.75993e+01_r8,0.74076e+01_r8,0.72128e+01_r8,0.70154e+01_r8 /) + kbo(:,25,15) = (/ & + & 0.79381e+01_r8,0.77379e+01_r8,0.75298e+01_r8,0.73205e+01_r8,0.71111e+01_r8 /) + kbo(:,26,15) = (/ & + & 0.80556e+01_r8,0.78384e+01_r8,0.76185e+01_r8,0.73961e+01_r8,0.71755e+01_r8 /) + kbo(:,27,15) = (/ & + & 0.81409e+01_r8,0.79095e+01_r8,0.76795e+01_r8,0.74472e+01_r8,0.72174e+01_r8 /) + kbo(:,28,15) = (/ & + & 0.81987e+01_r8,0.79569e+01_r8,0.77176e+01_r8,0.74766e+01_r8,0.72412e+01_r8 /) + kbo(:,29,15) = (/ & + & 0.82302e+01_r8,0.79809e+01_r8,0.77337e+01_r8,0.74875e+01_r8,0.72468e+01_r8 /) + kbo(:,30,15) = (/ & + & 0.82419e+01_r8,0.79875e+01_r8,0.77343e+01_r8,0.74825e+01_r8,0.72390e+01_r8 /) + kbo(:,31,15) = (/ & + & 0.82369e+01_r8,0.79780e+01_r8,0.77201e+01_r8,0.74661e+01_r8,0.72183e+01_r8 /) + kbo(:,32,15) = (/ & + & 0.82187e+01_r8,0.79550e+01_r8,0.76944e+01_r8,0.74386e+01_r8,0.71874e+01_r8 /) + kbo(:,33,15) = (/ & + & 0.81889e+01_r8,0.79220e+01_r8,0.76592e+01_r8,0.74026e+01_r8,0.71493e+01_r8 /) + kbo(:,34,15) = (/ & + & 0.81602e+01_r8,0.78912e+01_r8,0.76262e+01_r8,0.73693e+01_r8,0.71134e+01_r8 /) + kbo(:,35,15) = (/ & + & 0.81506e+01_r8,0.78799e+01_r8,0.76144e+01_r8,0.73562e+01_r8,0.70988e+01_r8 /) + kbo(:,36,15) = (/ & + & 0.81664e+01_r8,0.78930e+01_r8,0.76263e+01_r8,0.73664e+01_r8,0.71072e+01_r8 /) + kbo(:,37,15) = (/ & + & 0.82200e+01_r8,0.79452e+01_r8,0.76751e+01_r8,0.74132e+01_r8,0.71537e+01_r8 /) + kbo(:,38,15) = (/ & + & 0.82730e+01_r8,0.79962e+01_r8,0.77251e+01_r8,0.74606e+01_r8,0.72002e+01_r8 /) + kbo(:,39,15) = (/ & + & 0.83243e+01_r8,0.80459e+01_r8,0.77713e+01_r8,0.75063e+01_r8,0.72452e+01_r8 /) + kbo(:,40,15) = (/ & + & 0.84027e+01_r8,0.81225e+01_r8,0.78456e+01_r8,0.75775e+01_r8,0.73152e+01_r8 /) + kbo(:,41,15) = (/ & + & 0.84834e+01_r8,0.82013e+01_r8,0.79233e+01_r8,0.76507e+01_r8,0.73874e+01_r8 /) + kbo(:,42,15) = (/ & + & 0.85638e+01_r8,0.82794e+01_r8,0.79999e+01_r8,0.77248e+01_r8,0.74594e+01_r8 /) + kbo(:,43,15) = (/ & + & 0.86608e+01_r8,0.83728e+01_r8,0.80910e+01_r8,0.78137e+01_r8,0.75464e+01_r8 /) + kbo(:,44,15) = (/ & + & 0.87658e+01_r8,0.84741e+01_r8,0.81903e+01_r8,0.79102e+01_r8,0.76390e+01_r8 /) + kbo(:,45,15) = (/ & + & 0.88709e+01_r8,0.85747e+01_r8,0.82886e+01_r8,0.80079e+01_r8,0.77318e+01_r8 /) + kbo(:,46,15) = (/ & + & 0.89828e+01_r8,0.86839e+01_r8,0.83945e+01_r8,0.81115e+01_r8,0.78321e+01_r8 /) + kbo(:,47,15) = (/ & + & 0.91067e+01_r8,0.88066e+01_r8,0.85118e+01_r8,0.82270e+01_r8,0.79459e+01_r8 /) + kbo(:,48,15) = (/ & + & 0.92318e+01_r8,0.89292e+01_r8,0.86312e+01_r8,0.83427e+01_r8,0.80595e+01_r8 /) + kbo(:,49,15) = (/ & + & 0.93597e+01_r8,0.90533e+01_r8,0.87516e+01_r8,0.84602e+01_r8,0.81749e+01_r8 /) + kbo(:,50,15) = (/ & + & 0.94828e+01_r8,0.91681e+01_r8,0.88667e+01_r8,0.85700e+01_r8,0.82833e+01_r8 /) + kbo(:,51,15) = (/ & + & 0.96031e+01_r8,0.92821e+01_r8,0.89785e+01_r8,0.86778e+01_r8,0.83878e+01_r8 /) + kbo(:,52,15) = (/ & + & 0.97227e+01_r8,0.93978e+01_r8,0.90892e+01_r8,0.87879e+01_r8,0.84938e+01_r8 /) + kbo(:,53,15) = (/ & + & 0.98436e+01_r8,0.95182e+01_r8,0.92014e+01_r8,0.88988e+01_r8,0.86011e+01_r8 /) + kbo(:,54,15) = (/ & + & 0.99573e+01_r8,0.96274e+01_r8,0.93049e+01_r8,0.90008e+01_r8,0.87001e+01_r8 /) + kbo(:,55,15) = (/ & + & 0.10066e+02_r8,0.97327e+01_r8,0.94075e+01_r8,0.90983e+01_r8,0.87962e+01_r8 /) + kbo(:,56,15) = (/ & + & 0.10177e+02_r8,0.98378e+01_r8,0.95127e+01_r8,0.91960e+01_r8,0.88926e+01_r8 /) + kbo(:,57,15) = (/ & + & 0.10293e+02_r8,0.99462e+01_r8,0.96173e+01_r8,0.92949e+01_r8,0.89909e+01_r8 /) + kbo(:,58,15) = (/ & + & 0.10405e+02_r8,0.10049e+02_r8,0.97160e+01_r8,0.93909e+01_r8,0.90821e+01_r8 /) + kbo(:,59,15) = (/ & + & 0.10450e+02_r8,0.10090e+02_r8,0.97556e+01_r8,0.94305e+01_r8,0.91193e+01_r8 /) + kbo(:,13,16) = (/ & + & 0.50473e+01_r8,0.50398e+01_r8,0.50183e+01_r8,0.49834e+01_r8,0.49369e+01_r8 /) + kbo(:,14,16) = (/ & + & 0.59220e+01_r8,0.58911e+01_r8,0.58423e+01_r8,0.57748e+01_r8,0.56924e+01_r8 /) + kbo(:,15,16) = (/ & + & 0.68737e+01_r8,0.68078e+01_r8,0.67189e+01_r8,0.66072e+01_r8,0.64839e+01_r8 /) + kbo(:,16,16) = (/ & + & 0.78824e+01_r8,0.77694e+01_r8,0.76268e+01_r8,0.74643e+01_r8,0.72894e+01_r8 /) + kbo(:,17,16) = (/ & + & 0.89270e+01_r8,0.87413e+01_r8,0.85370e+01_r8,0.83130e+01_r8,0.80798e+01_r8 /) + kbo(:,18,16) = (/ & + & 0.99711e+01_r8,0.97011e+01_r8,0.94250e+01_r8,0.91345e+01_r8,0.88363e+01_r8 /) + kbo(:,19,16) = (/ & + & 0.10989e+02_r8,0.10627e+02_r8,0.10268e+02_r8,0.99076e+01_r8,0.95430e+01_r8 /) + kbo(:,20,16) = (/ & + & 0.11944e+02_r8,0.11487e+02_r8,0.11042e+02_r8,0.10609e+02_r8,0.10177e+02_r8 /) + kbo(:,21,16) = (/ & + & 0.12817e+02_r8,0.12265e+02_r8,0.11737e+02_r8,0.11232e+02_r8,0.10736e+02_r8 /) + kbo(:,22,16) = (/ & + & 0.13548e+02_r8,0.12914e+02_r8,0.12305e+02_r8,0.11734e+02_r8,0.11183e+02_r8 /) + kbo(:,23,16) = (/ & + & 0.14162e+02_r8,0.13448e+02_r8,0.12773e+02_r8,0.12143e+02_r8,0.11545e+02_r8 /) + kbo(:,24,16) = (/ & + & 0.14655e+02_r8,0.13870e+02_r8,0.13141e+02_r8,0.12464e+02_r8,0.11822e+02_r8 /) + kbo(:,25,16) = (/ & + & 0.15031e+02_r8,0.14189e+02_r8,0.13415e+02_r8,0.12699e+02_r8,0.12023e+02_r8 /) + kbo(:,26,16) = (/ & + & 0.15288e+02_r8,0.14405e+02_r8,0.13595e+02_r8,0.12850e+02_r8,0.12149e+02_r8 /) + kbo(:,27,16) = (/ & + & 0.15452e+02_r8,0.14541e+02_r8,0.13705e+02_r8,0.12937e+02_r8,0.12216e+02_r8 /) + kbo(:,28,16) = (/ & + & 0.15538e+02_r8,0.14608e+02_r8,0.13754e+02_r8,0.12971e+02_r8,0.12237e+02_r8 /) + kbo(:,29,16) = (/ & + & 0.15553e+02_r8,0.14613e+02_r8,0.13748e+02_r8,0.12957e+02_r8,0.12214e+02_r8 /) + kbo(:,30,16) = (/ & + & 0.15516e+02_r8,0.14571e+02_r8,0.13703e+02_r8,0.12907e+02_r8,0.12159e+02_r8 /) + kbo(:,31,16) = (/ & + & 0.15433e+02_r8,0.14488e+02_r8,0.13621e+02_r8,0.12822e+02_r8,0.12076e+02_r8 /) + kbo(:,32,16) = (/ & + & 0.15312e+02_r8,0.14373e+02_r8,0.13511e+02_r8,0.12712e+02_r8,0.11970e+02_r8 /) + kbo(:,33,16) = (/ & + & 0.15164e+02_r8,0.14234e+02_r8,0.13378e+02_r8,0.12584e+02_r8,0.11848e+02_r8 /) + kbo(:,34,16) = (/ & + & 0.15029e+02_r8,0.14108e+02_r8,0.13258e+02_r8,0.12470e+02_r8,0.11741e+02_r8 /) + kbo(:,35,16) = (/ & + & 0.14974e+02_r8,0.14055e+02_r8,0.13205e+02_r8,0.12418e+02_r8,0.11691e+02_r8 /) + kbo(:,36,16) = (/ & + & 0.15011e+02_r8,0.14086e+02_r8,0.13232e+02_r8,0.12441e+02_r8,0.11710e+02_r8 /) + kbo(:,37,16) = (/ & + & 0.15186e+02_r8,0.14243e+02_r8,0.13376e+02_r8,0.12573e+02_r8,0.11831e+02_r8 /) + kbo(:,38,16) = (/ & + & 0.15364e+02_r8,0.14405e+02_r8,0.13523e+02_r8,0.12708e+02_r8,0.11955e+02_r8 /) + kbo(:,39,16) = (/ & + & 0.15541e+02_r8,0.14562e+02_r8,0.13666e+02_r8,0.12840e+02_r8,0.12075e+02_r8 /) + kbo(:,40,16) = (/ & + & 0.15818e+02_r8,0.14814e+02_r8,0.13896e+02_r8,0.13052e+02_r8,0.12271e+02_r8 /) + kbo(:,41,16) = (/ & + & 0.16115e+02_r8,0.15082e+02_r8,0.14138e+02_r8,0.13278e+02_r8,0.12478e+02_r8 /) + kbo(:,42,16) = (/ & + & 0.16420e+02_r8,0.15352e+02_r8,0.14384e+02_r8,0.13504e+02_r8,0.12687e+02_r8 /) + kbo(:,43,16) = (/ & + & 0.16793e+02_r8,0.15690e+02_r8,0.14694e+02_r8,0.13784e+02_r8,0.12952e+02_r8 /) + kbo(:,44,16) = (/ & + & 0.17211e+02_r8,0.16062e+02_r8,0.15031e+02_r8,0.14091e+02_r8,0.13236e+02_r8 /) + kbo(:,45,16) = (/ & + & 0.17640e+02_r8,0.16447e+02_r8,0.15376e+02_r8,0.14411e+02_r8,0.13526e+02_r8 /) + kbo(:,46,16) = (/ & + & 0.18112e+02_r8,0.16870e+02_r8,0.15758e+02_r8,0.14754e+02_r8,0.13842e+02_r8 /) + kbo(:,47,16) = (/ & + & 0.18658e+02_r8,0.17363e+02_r8,0.16197e+02_r8,0.15151e+02_r8,0.14204e+02_r8 /) + kbo(:,48,16) = (/ & + & 0.19225e+02_r8,0.17876e+02_r8,0.16658e+02_r8,0.15564e+02_r8,0.14577e+02_r8 /) + kbo(:,49,16) = (/ & + & 0.19824e+02_r8,0.18409e+02_r8,0.17136e+02_r8,0.15993e+02_r8,0.14967e+02_r8 /) + kbo(:,50,16) = (/ & + & 0.20411e+02_r8,0.18926e+02_r8,0.17606e+02_r8,0.16414e+02_r8,0.15344e+02_r8 /) + kbo(:,51,16) = (/ & + & 0.21005e+02_r8,0.19452e+02_r8,0.18077e+02_r8,0.16838e+02_r8,0.15725e+02_r8 /) + kbo(:,52,16) = (/ & + & 0.21646e+02_r8,0.20001e+02_r8,0.18565e+02_r8,0.17278e+02_r8,0.16117e+02_r8 /) + kbo(:,53,16) = (/ & + & 0.22315e+02_r8,0.20576e+02_r8,0.19072e+02_r8,0.17736e+02_r8,0.16529e+02_r8 /) + kbo(:,54,16) = (/ & + & 0.22958e+02_r8,0.21134e+02_r8,0.19557e+02_r8,0.18172e+02_r8,0.16919e+02_r8 /) + kbo(:,55,16) = (/ & + & 0.23603e+02_r8,0.21694e+02_r8,0.20042e+02_r8,0.18600e+02_r8,0.17305e+02_r8 /) + kbo(:,56,16) = (/ & + & 0.24285e+02_r8,0.22278e+02_r8,0.20543e+02_r8,0.19044e+02_r8,0.17707e+02_r8 /) + kbo(:,57,16) = (/ & + & 0.24997e+02_r8,0.22887e+02_r8,0.21074e+02_r8,0.19504e+02_r8,0.18121e+02_r8 /) + kbo(:,58,16) = (/ & + & 0.25697e+02_r8,0.23494e+02_r8,0.21600e+02_r8,0.19961e+02_r8,0.18525e+02_r8 /) + kbo(:,59,16) = (/ & + & 0.25984e+02_r8,0.23748e+02_r8,0.21819e+02_r8,0.20147e+02_r8,0.18689e+02_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.106275e-05_r8, 0.104185e-05_r8, 0.420154e-05_r8 /) + forrefo(:, 2) = (/ 0.154343e-05_r8, 0.653193e-05_r8, 0.174596e-04_r8 /) + forrefo(:, 3) = (/ 0.348917e-05_r8, 0.108420e-04_r8, 0.540849e-04_r8 /) + forrefo(:, 4) = (/ 0.145822e-04_r8, 0.156027e-04_r8, 0.881263e-04_r8 /) + forrefo(:, 5) = (/ 0.220204e-04_r8, 0.819892e-04_r8, 0.817937e-04_r8 /) + forrefo(:, 6) = (/ 0.447840e-04_r8, 0.121116e-03_r8, 0.932635e-04_r8 /) + forrefo(:, 7) = (/ 0.166516e-03_r8, 0.147640e-03_r8, 0.754029e-04_r8 /) + forrefo(:, 8) = (/ 0.234756e-03_r8, 0.145934e-03_r8, 0.771734e-04_r8 /) + forrefo(:, 9) = (/ 0.289207e-03_r8, 0.146768e-03_r8, 0.677806e-04_r8 /) + forrefo(:,10) = (/ 0.334959e-03_r8, 0.125513e-03_r8, 0.636648e-04_r8 /) + forrefo(:,11) = (/ 0.333755e-03_r8, 0.136575e-03_r8, 0.593651e-04_r8 /) + forrefo(:,12) = (/ 0.340042e-03_r8, 0.116259e-03_r8, 0.595192e-04_r8 /) + forrefo(:,13) = (/ 0.422470e-03_r8, 0.148691e-03_r8, 0.630266e-04_r8 /) + forrefo(:,14) = (/ 0.440655e-03_r8, 0.461917e-04_r8, 0.108222e-04_r8 /) + forrefo(:,15) = (/ 0.486207e-03_r8, 0.428458e-03_r8, 0.108086e-04_r8 /) + forrefo(:,16) = (/ 0.657463e-03_r8, 0.657446e-03_r8, 0.126190e-04_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.331728e-03_r8, 0.287480e-03_r8, 0.249135e-03_r8, 0.215904e-03_r8, 0.187106e-03_r8, & + & 0.162149e-03_r8, 0.140520e-03_r8, 0.121777e-03_r8, 0.105534e-03_r8, 0.914573e-04_r8 /) + selfrefo(:, 2) = (/ & + & 0.882628e-03_r8, 0.698914e-03_r8, 0.553439e-03_r8, 0.438244e-03_r8, 0.347026e-03_r8, & + & 0.274795e-03_r8, 0.217598e-03_r8, 0.172306e-03_r8, 0.136442e-03_r8, 0.108042e-03_r8 /) + selfrefo(:, 3) = (/ & + & 0.115461e-02_r8, 0.937203e-03_r8, 0.760730e-03_r8, 0.617486e-03_r8, 0.501215e-03_r8, & + & 0.406837e-03_r8, 0.330231e-03_r8, 0.268049e-03_r8, 0.217576e-03_r8, 0.176607e-03_r8 /) + selfrefo(:, 4) = (/ & + & 0.103450e-02_r8, 0.960268e-03_r8, 0.891360e-03_r8, 0.827397e-03_r8, 0.768024e-03_r8, & + & 0.712911e-03_r8, 0.661754e-03_r8, 0.614267e-03_r8, 0.570188e-03_r8, 0.529272e-03_r8 /) + selfrefo(:, 5) = (/ & + & 0.289040e-02_r8, 0.240129e-02_r8, 0.199495e-02_r8, 0.165737e-02_r8, 0.137692e-02_r8, & + & 0.114392e-02_r8, 0.950351e-03_r8, 0.789535e-03_r8, 0.655933e-03_r8, 0.544938e-03_r8 /) + selfrefo(:, 6) = (/ & + & 0.361772e-02_r8, 0.306611e-02_r8, 0.259861e-02_r8, 0.220239e-02_r8, 0.186659e-02_r8, & + & 0.158198e-02_r8, 0.134077e-02_r8, 0.113634e-02_r8, 0.963078e-03_r8, 0.816234e-03_r8 /) + selfrefo(:, 7) = (/ & + & 0.329878e-02_r8, 0.318245e-02_r8, 0.307021e-02_r8, 0.296194e-02_r8, 0.285749e-02_r8, & + & 0.275671e-02_r8, 0.265950e-02_r8, 0.256571e-02_r8, 0.247522e-02_r8, 0.238793e-02_r8 /) + selfrefo(:, 8) = (/ & + & 0.293562e-02_r8, 0.300077e-02_r8, 0.306737e-02_r8, 0.313544e-02_r8, 0.320503e-02_r8, & + & 0.327615e-02_r8, 0.334886e-02_r8, 0.342318e-02_r8, 0.349915e-02_r8, 0.357680e-02_r8 /) + selfrefo(:, 9) = (/ & + & 0.281453e-02_r8, 0.295894e-02_r8, 0.311076e-02_r8, 0.327038e-02_r8, 0.343818e-02_r8, & + & 0.361459e-02_r8, 0.380006e-02_r8, 0.399504e-02_r8, 0.420002e-02_r8, 0.441553e-02_r8 /) + selfrefo(:,10) = (/ & + & 0.239488e-02_r8, 0.262487e-02_r8, 0.287696e-02_r8, 0.315325e-02_r8, 0.345607e-02_r8, & + & 0.378798e-02_r8, 0.415176e-02_r8, 0.455048e-02_r8, 0.498749e-02_r8, 0.546647e-02_r8 /) + selfrefo(:,11) = (/ & + & 0.271001e-02_r8, 0.292235e-02_r8, 0.315134e-02_r8, 0.339826e-02_r8, 0.366453e-02_r8, & + & 0.395167e-02_r8, 0.426131e-02_r8, 0.459521e-02_r8, 0.495527e-02_r8, 0.534354e-02_r8 /) + selfrefo(:,12) = (/ & + & 0.206702e-02_r8, 0.232254e-02_r8, 0.260966e-02_r8, 0.293226e-02_r8, 0.329475e-02_r8, & + & 0.370204e-02_r8, 0.415969e-02_r8, 0.467391e-02_r8, 0.525169e-02_r8, 0.590090e-02_r8 /) + selfrefo(:,13) = (/ & + & 0.227023e-02_r8, 0.257331e-02_r8, 0.291685e-02_r8, 0.330626e-02_r8, 0.374766e-02_r8, & + & 0.424799e-02_r8, 0.481511e-02_r8, 0.545794e-02_r8, 0.618660e-02_r8, 0.701253e-02_r8 /) + selfrefo(:,14) = (/ & + & 0.851078e-03_r8, 0.111512e-02_r8, 0.146109e-02_r8, 0.191439e-02_r8, 0.250832e-02_r8, & + & 0.328653e-02_r8, 0.430617e-02_r8, 0.564215e-02_r8, 0.739261e-02_r8, 0.968616e-02_r8 /) + selfrefo(:,15) = (/ & + & 0.742711e-02_r8, 0.721347e-02_r8, 0.700598e-02_r8, 0.680446e-02_r8, 0.660873e-02_r8, & + & 0.641863e-02_r8, 0.623400e-02_r8, 0.605468e-02_r8, 0.588052e-02_r8, 0.571137e-02_r8 /) + selfrefo(:,16) = (/ & + & 0.107170e-01_r8, 0.101913e-01_r8, 0.969138e-02_r8, 0.921599e-02_r8, 0.876392e-02_r8, & + & 0.833402e-02_r8, 0.792521e-02_r8, 0.753646e-02_r8, 0.716677e-02_r8, 0.681522e-02_r8 /) + + end subroutine sw_kgb19 + +! ************************************************************************** + subroutine sw_kgb20 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg20, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + absch4o, rayl, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & + & 9.34081_r8 , 8.93720_r8 , 8.19346_r8 , 7.39196_r8 , & + & 6.12127_r8 , 5.23956_r8 , 4.24941_r8 , 3.20013_r8 , & + & 2.16047_r8 , 0.234509_r8 , 0.194593_r8 , 0.151512_r8 , & + & 0.110315_r8, 7.09959e-02_r8, 2.70573e-02_r8, 3.36042e-03_r8 /) + + absch4o(:) = (/ & + & 1.01381e-03_r8,6.33692e-03_r8,1.94185e-02_r8,4.83210e-02_r8, & + & 2.36574e-03_r8,6.61973e-04_r8,5.64552e-04_r8,2.83183e-04_r8, & + & 7.43623e-05_r8,8.90159e-07_r8,6.98728e-07_r8,6.51832e-08_r8, & + & 2.96619e-08_r8, 0._r8, 0._r8, 0._r8 /) + +! Rayleigh extinction coefficient at v = 5670 cm-1. + rayl = 4.12e-09_r8 + + layreffr = 3 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1) = (/ & + & 0.78383e-06_r8,0.86220e-06_r8,0.95359e-06_r8,0.10590e-05_r8,0.11782e-05_r8 /) + kao(:, 2, 1) = (/ & + & 0.65040e-06_r8,0.72510e-06_r8,0.81318e-06_r8,0.90059e-06_r8,0.99786e-06_r8 /) + kao(:, 3, 1) = (/ & + & 0.58072e-06_r8,0.65888e-06_r8,0.74265e-06_r8,0.81854e-06_r8,0.90645e-06_r8 /) + kao(:, 4, 1) = (/ & + & 0.53601e-06_r8,0.60765e-06_r8,0.68088e-06_r8,0.75741e-06_r8,0.83801e-06_r8 /) + kao(:, 5, 1) = (/ & + & 0.50142e-06_r8,0.56951e-06_r8,0.64028e-06_r8,0.71944e-06_r8,0.79813e-06_r8 /) + kao(:, 6, 1) = (/ & + & 0.47164e-06_r8,0.54008e-06_r8,0.61040e-06_r8,0.68006e-06_r8,0.75034e-06_r8 /) + kao(:, 7, 1) = (/ & + & 0.49337e-06_r8,0.56178e-06_r8,0.62215e-06_r8,0.69127e-06_r8,0.76060e-06_r8 /) + kao(:, 8, 1) = (/ & + & 0.61581e-06_r8,0.70117e-06_r8,0.78942e-06_r8,0.87145e-06_r8,0.94647e-06_r8 /) + kao(:, 9, 1) = (/ & + & 0.14154e-05_r8,0.15754e-05_r8,0.17261e-05_r8,0.18739e-05_r8,0.19774e-05_r8 /) + kao(:,10, 1) = (/ & + & 0.34186e-05_r8,0.37012e-05_r8,0.39602e-05_r8,0.42235e-05_r8,0.44256e-05_r8 /) + kao(:,11, 1) = (/ & + & 0.38574e-05_r8,0.42080e-05_r8,0.44701e-05_r8,0.47454e-05_r8,0.50002e-05_r8 /) + kao(:,12, 1) = (/ & + & 0.35794e-05_r8,0.38686e-05_r8,0.41443e-05_r8,0.43939e-05_r8,0.46500e-05_r8 /) + kao(:,13, 1) = (/ & + & 0.29586e-05_r8,0.31938e-05_r8,0.34167e-05_r8,0.36253e-05_r8,0.38250e-05_r8 /) + kao(:, 1, 2) = (/ & + & 0.57098e-05_r8,0.64630e-05_r8,0.73117e-05_r8,0.82436e-05_r8,0.91947e-05_r8 /) + kao(:, 2, 2) = (/ & + & 0.46384e-05_r8,0.53125e-05_r8,0.60301e-05_r8,0.68028e-05_r8,0.75824e-05_r8 /) + kao(:, 3, 2) = (/ & + & 0.40657e-05_r8,0.46486e-05_r8,0.52459e-05_r8,0.58955e-05_r8,0.65546e-05_r8 /) + kao(:, 4, 2) = (/ & + & 0.38895e-05_r8,0.44258e-05_r8,0.49759e-05_r8,0.55663e-05_r8,0.61702e-05_r8 /) + kao(:, 5, 2) = (/ & + & 0.38971e-05_r8,0.44359e-05_r8,0.49933e-05_r8,0.55523e-05_r8,0.61234e-05_r8 /) + kao(:, 6, 2) = (/ & + & 0.39532e-05_r8,0.44644e-05_r8,0.49734e-05_r8,0.54875e-05_r8,0.60102e-05_r8 /) + kao(:, 7, 2) = (/ & + & 0.41068e-05_r8,0.45832e-05_r8,0.50698e-05_r8,0.55521e-05_r8,0.60175e-05_r8 /) + kao(:, 8, 2) = (/ & + & 0.47922e-05_r8,0.52156e-05_r8,0.56817e-05_r8,0.61576e-05_r8,0.66313e-05_r8 /) + kao(:, 9, 2) = (/ & + & 0.83199e-05_r8,0.88317e-05_r8,0.93688e-05_r8,0.99754e-05_r8,0.10620e-04_r8 /) + kao(:,10, 2) = (/ & + & 0.16836e-04_r8,0.18526e-04_r8,0.19887e-04_r8,0.21168e-04_r8,0.22104e-04_r8 /) + kao(:,11, 2) = (/ & + & 0.18882e-04_r8,0.21005e-04_r8,0.22896e-04_r8,0.24777e-04_r8,0.26115e-04_r8 /) + kao(:,12, 2) = (/ & + & 0.17744e-04_r8,0.19780e-04_r8,0.21600e-04_r8,0.23523e-04_r8,0.25128e-04_r8 /) + kao(:,13, 2) = (/ & + & 0.14736e-04_r8,0.16356e-04_r8,0.17955e-04_r8,0.19533e-04_r8,0.20861e-04_r8 /) + kao(:, 1, 3) = (/ & + & 0.41776e-04_r8,0.48150e-04_r8,0.55097e-04_r8,0.62661e-04_r8,0.70920e-04_r8 /) + kao(:, 2, 3) = (/ & + & 0.33909e-04_r8,0.39176e-04_r8,0.44622e-04_r8,0.50754e-04_r8,0.57336e-04_r8 /) + kao(:, 3, 3) = (/ & + & 0.27438e-04_r8,0.31473e-04_r8,0.36122e-04_r8,0.41134e-04_r8,0.46456e-04_r8 /) + kao(:, 4, 3) = (/ & + & 0.23222e-04_r8,0.26535e-04_r8,0.30141e-04_r8,0.34099e-04_r8,0.38416e-04_r8 /) + kao(:, 5, 3) = (/ & + & 0.21114e-04_r8,0.23888e-04_r8,0.26883e-04_r8,0.30340e-04_r8,0.33785e-04_r8 /) + kao(:, 6, 3) = (/ & + & 0.20750e-04_r8,0.22926e-04_r8,0.25536e-04_r8,0.28492e-04_r8,0.31676e-04_r8 /) + kao(:, 7, 3) = (/ & + & 0.21584e-04_r8,0.24112e-04_r8,0.26872e-04_r8,0.29794e-04_r8,0.32940e-04_r8 /) + kao(:, 8, 3) = (/ & + & 0.24194e-04_r8,0.26981e-04_r8,0.30137e-04_r8,0.33546e-04_r8,0.37182e-04_r8 /) + kao(:, 9, 3) = (/ & + & 0.37461e-04_r8,0.42158e-04_r8,0.46718e-04_r8,0.51048e-04_r8,0.55154e-04_r8 /) + kao(:,10, 3) = (/ & + & 0.72391e-04_r8,0.77164e-04_r8,0.84016e-04_r8,0.89658e-04_r8,0.95511e-04_r8 /) + kao(:,11, 3) = (/ & + & 0.91736e-04_r8,0.99107e-04_r8,0.10463e-03_r8,0.10952e-03_r8,0.11549e-03_r8 /) + kao(:,12, 3) = (/ & + & 0.91200e-04_r8,0.98812e-04_r8,0.10432e-03_r8,0.10893e-03_r8,0.11349e-03_r8 /) + kao(:,13, 3) = (/ & + & 0.76217e-04_r8,0.82702e-04_r8,0.87500e-04_r8,0.91349e-04_r8,0.95349e-04_r8 /) + kao(:, 1, 4) = (/ & + & 0.71705e-03_r8,0.82743e-03_r8,0.94700e-03_r8,0.10670e-02_r8,0.11902e-02_r8 /) + kao(:, 2, 4) = (/ & + & 0.57909e-03_r8,0.67096e-03_r8,0.76724e-03_r8,0.86582e-03_r8,0.97167e-03_r8 /) + kao(:, 3, 4) = (/ & + & 0.44771e-03_r8,0.51997e-03_r8,0.59861e-03_r8,0.67967e-03_r8,0.76676e-03_r8 /) + kao(:, 4, 4) = (/ & + & 0.34085e-03_r8,0.39833e-03_r8,0.46226e-03_r8,0.52889e-03_r8,0.60008e-03_r8 /) + kao(:, 5, 4) = (/ & + & 0.26678e-03_r8,0.31234e-03_r8,0.36341e-03_r8,0.41663e-03_r8,0.47418e-03_r8 /) + kao(:, 6, 4) = (/ & + & 0.20903e-03_r8,0.24718e-03_r8,0.28922e-03_r8,0.33353e-03_r8,0.38176e-03_r8 /) + kao(:, 7, 4) = (/ & + & 0.17173e-03_r8,0.20330e-03_r8,0.23711e-03_r8,0.27401e-03_r8,0.31445e-03_r8 /) + kao(:, 8, 4) = (/ & + & 0.16722e-03_r8,0.19396e-03_r8,0.22307e-03_r8,0.25347e-03_r8,0.28561e-03_r8 /) + kao(:, 9, 4) = (/ & + & 0.25043e-03_r8,0.28824e-03_r8,0.32547e-03_r8,0.36193e-03_r8,0.39806e-03_r8 /) + kao(:,10, 4) = (/ & + & 0.43323e-03_r8,0.48667e-03_r8,0.53462e-03_r8,0.57879e-03_r8,0.62040e-03_r8 /) + kao(:,11, 4) = (/ & + & 0.47719e-03_r8,0.52271e-03_r8,0.56402e-03_r8,0.60388e-03_r8,0.63520e-03_r8 /) + kao(:,12, 4) = (/ & + & 0.45061e-03_r8,0.49014e-03_r8,0.52391e-03_r8,0.55276e-03_r8,0.57760e-03_r8 /) + kao(:,13, 4) = (/ & + & 0.37664e-03_r8,0.40952e-03_r8,0.43690e-03_r8,0.46055e-03_r8,0.48018e-03_r8 /) + kao(:, 1, 5) = (/ & + & 0.66466e-02_r8,0.68686e-02_r8,0.70897e-02_r8,0.73019e-02_r8,0.74914e-02_r8 /) + kao(:, 2, 5) = (/ & + & 0.54023e-02_r8,0.56010e-02_r8,0.58008e-02_r8,0.59987e-02_r8,0.61685e-02_r8 /) + kao(:, 3, 5) = (/ & + & 0.43218e-02_r8,0.45127e-02_r8,0.46848e-02_r8,0.48647e-02_r8,0.50267e-02_r8 /) + kao(:, 4, 5) = (/ & + & 0.34639e-02_r8,0.36473e-02_r8,0.37951e-02_r8,0.39570e-02_r8,0.41049e-02_r8 /) + kao(:, 5, 5) = (/ & + & 0.27745e-02_r8,0.29370e-02_r8,0.30754e-02_r8,0.32148e-02_r8,0.33492e-02_r8 /) + kao(:, 6, 5) = (/ & + & 0.22020e-02_r8,0.23520e-02_r8,0.24836e-02_r8,0.25965e-02_r8,0.27119e-02_r8 /) + kao(:, 7, 5) = (/ & + & 0.17624e-02_r8,0.18963e-02_r8,0.20161e-02_r8,0.21153e-02_r8,0.22116e-02_r8 /) + kao(:, 8, 5) = (/ & + & 0.14169e-02_r8,0.15332e-02_r8,0.16350e-02_r8,0.17231e-02_r8,0.18121e-02_r8 /) + kao(:, 9, 5) = (/ & + & 0.13030e-02_r8,0.13904e-02_r8,0.14690e-02_r8,0.15500e-02_r8,0.16275e-02_r8 /) + kao(:,10, 5) = (/ & + & 0.17155e-02_r8,0.18169e-02_r8,0.18943e-02_r8,0.19620e-02_r8,0.20215e-02_r8 /) + kao(:,11, 5) = (/ & + & 0.17156e-02_r8,0.17808e-02_r8,0.18419e-02_r8,0.18925e-02_r8,0.19313e-02_r8 /) + kao(:,12, 5) = (/ & + & 0.15269e-02_r8,0.15811e-02_r8,0.16283e-02_r8,0.16686e-02_r8,0.17061e-02_r8 /) + kao(:,13, 5) = (/ & + & 0.12768e-02_r8,0.13207e-02_r8,0.13555e-02_r8,0.13924e-02_r8,0.14234e-02_r8 /) + kao(:, 1, 6) = (/ & + & 0.19191e-01_r8,0.19463e-01_r8,0.19692e-01_r8,0.19900e-01_r8,0.20112e-01_r8 /) + kao(:, 2, 6) = (/ & + & 0.15967e-01_r8,0.16219e-01_r8,0.16426e-01_r8,0.16613e-01_r8,0.16805e-01_r8 /) + kao(:, 3, 6) = (/ & + & 0.13186e-01_r8,0.13411e-01_r8,0.13614e-01_r8,0.13785e-01_r8,0.13944e-01_r8 /) + kao(:, 4, 6) = (/ & + & 0.10935e-01_r8,0.11131e-01_r8,0.11318e-01_r8,0.11475e-01_r8,0.11620e-01_r8 /) + kao(:, 5, 6) = (/ & + & 0.90541e-02_r8,0.92344e-02_r8,0.94035e-02_r8,0.95537e-02_r8,0.96862e-02_r8 /) + kao(:, 6, 6) = (/ & + & 0.74724e-02_r8,0.76320e-02_r8,0.77794e-02_r8,0.79294e-02_r8,0.80528e-02_r8 /) + kao(:, 7, 6) = (/ & + & 0.61183e-02_r8,0.62644e-02_r8,0.63961e-02_r8,0.65303e-02_r8,0.66478e-02_r8 /) + kao(:, 8, 6) = (/ & + & 0.50638e-02_r8,0.51984e-02_r8,0.53222e-02_r8,0.54412e-02_r8,0.55465e-02_r8 /) + kao(:, 9, 6) = (/ & + & 0.42870e-02_r8,0.44009e-02_r8,0.45109e-02_r8,0.45976e-02_r8,0.46796e-02_r8 /) + kao(:,10, 6) = (/ & + & 0.45239e-02_r8,0.46073e-02_r8,0.46968e-02_r8,0.47979e-02_r8,0.48956e-02_r8 /) + kao(:,11, 6) = (/ & + & 0.44089e-02_r8,0.45006e-02_r8,0.45881e-02_r8,0.46721e-02_r8,0.48015e-02_r8 /) + kao(:,12, 6) = (/ & + & 0.39598e-02_r8,0.40290e-02_r8,0.41108e-02_r8,0.41899e-02_r8,0.42672e-02_r8 /) + kao(:,13, 6) = (/ & + & 0.33425e-02_r8,0.34148e-02_r8,0.34808e-02_r8,0.35405e-02_r8,0.35983e-02_r8 /) + kao(:, 1, 7) = (/ & + & 0.50165e-01_r8,0.50343e-01_r8,0.50452e-01_r8,0.50424e-01_r8,0.50329e-01_r8 /) + kao(:, 2, 7) = (/ & + & 0.42723e-01_r8,0.42880e-01_r8,0.42939e-01_r8,0.42910e-01_r8,0.42861e-01_r8 /) + kao(:, 3, 7) = (/ & + & 0.36117e-01_r8,0.36255e-01_r8,0.36301e-01_r8,0.36294e-01_r8,0.36288e-01_r8 /) + kao(:, 4, 7) = (/ & + & 0.30585e-01_r8,0.30720e-01_r8,0.30787e-01_r8,0.30816e-01_r8,0.30842e-01_r8 /) + kao(:, 5, 7) = (/ & + & 0.25879e-01_r8,0.26029e-01_r8,0.26116e-01_r8,0.26179e-01_r8,0.26225e-01_r8 /) + kao(:, 6, 7) = (/ & + & 0.21822e-01_r8,0.21978e-01_r8,0.22094e-01_r8,0.22178e-01_r8,0.22244e-01_r8 /) + kao(:, 7, 7) = (/ & + & 0.18304e-01_r8,0.18476e-01_r8,0.18606e-01_r8,0.18705e-01_r8,0.18780e-01_r8 /) + kao(:, 8, 7) = (/ & + & 0.15224e-01_r8,0.15394e-01_r8,0.15519e-01_r8,0.15619e-01_r8,0.15690e-01_r8 /) + kao(:, 9, 7) = (/ & + & 0.12835e-01_r8,0.13029e-01_r8,0.13169e-01_r8,0.13281e-01_r8,0.13369e-01_r8 /) + kao(:,10, 7) = (/ & + & 0.11632e-01_r8,0.11714e-01_r8,0.11760e-01_r8,0.11776e-01_r8,0.11806e-01_r8 /) + kao(:,11, 7) = (/ & + & 0.11170e-01_r8,0.11252e-01_r8,0.11288e-01_r8,0.11357e-01_r8,0.11397e-01_r8 /) + kao(:,12, 7) = (/ & + & 0.10404e-01_r8,0.10533e-01_r8,0.10705e-01_r8,0.10833e-01_r8,0.10947e-01_r8 /) + kao(:,13, 7) = (/ & + & 0.91041e-02_r8,0.92674e-02_r8,0.94068e-02_r8,0.95412e-02_r8,0.96769e-02_r8 /) + kao(:, 1, 8) = (/ & + & 0.14527e+00_r8,0.14483e+00_r8,0.14432e+00_r8,0.14389e+00_r8,0.14349e+00_r8 /) + kao(:, 2, 8) = (/ & + & 0.12739e+00_r8,0.12702e+00_r8,0.12661e+00_r8,0.12624e+00_r8,0.12584e+00_r8 /) + kao(:, 3, 8) = (/ & + & 0.11091e+00_r8,0.11058e+00_r8,0.11024e+00_r8,0.10990e+00_r8,0.10953e+00_r8 /) + kao(:, 4, 8) = (/ & + & 0.96590e-01_r8,0.96335e-01_r8,0.96105e-01_r8,0.95818e-01_r8,0.95530e-01_r8 /) + kao(:, 5, 8) = (/ & + & 0.83799e-01_r8,0.83708e-01_r8,0.83572e-01_r8,0.83347e-01_r8,0.83126e-01_r8 /) + kao(:, 6, 8) = (/ & + & 0.72369e-01_r8,0.72388e-01_r8,0.72289e-01_r8,0.72143e-01_r8,0.71981e-01_r8 /) + kao(:, 7, 8) = (/ & + & 0.62158e-01_r8,0.62247e-01_r8,0.62185e-01_r8,0.62111e-01_r8,0.62007e-01_r8 /) + kao(:, 8, 8) = (/ & + & 0.52998e-01_r8,0.53142e-01_r8,0.53162e-01_r8,0.53154e-01_r8,0.53101e-01_r8 /) + kao(:, 9, 8) = (/ & + & 0.44776e-01_r8,0.44873e-01_r8,0.44920e-01_r8,0.44946e-01_r8,0.44885e-01_r8 /) + kao(:,10, 8) = (/ & + & 0.38237e-01_r8,0.38514e-01_r8,0.38716e-01_r8,0.38877e-01_r8,0.38966e-01_r8 /) + kao(:,11, 8) = (/ & + & 0.33511e-01_r8,0.33721e-01_r8,0.33843e-01_r8,0.33840e-01_r8,0.33839e-01_r8 /) + kao(:,12, 8) = (/ & + & 0.29704e-01_r8,0.29825e-01_r8,0.29808e-01_r8,0.29787e-01_r8,0.29794e-01_r8 /) + kao(:,13, 8) = (/ & + & 0.25973e-01_r8,0.26004e-01_r8,0.26032e-01_r8,0.26023e-01_r8,0.26107e-01_r8 /) + kao(:, 1, 9) = (/ & + & 0.56699e+00_r8,0.56615e+00_r8,0.56479e+00_r8,0.56318e+00_r8,0.56135e+00_r8 /) + kao(:, 2, 9) = (/ & + & 0.53130e+00_r8,0.53096e+00_r8,0.53038e+00_r8,0.52953e+00_r8,0.52828e+00_r8 /) + kao(:, 3, 9) = (/ & + & 0.48947e+00_r8,0.48989e+00_r8,0.48991e+00_r8,0.48970e+00_r8,0.48916e+00_r8 /) + kao(:, 4, 9) = (/ & + & 0.44646e+00_r8,0.44756e+00_r8,0.44841e+00_r8,0.44893e+00_r8,0.44859e+00_r8 /) + kao(:, 5, 9) = (/ & + & 0.40428e+00_r8,0.40594e+00_r8,0.40746e+00_r8,0.40811e+00_r8,0.40825e+00_r8 /) + kao(:, 6, 9) = (/ & + & 0.36305e+00_r8,0.36545e+00_r8,0.36730e+00_r8,0.36814e+00_r8,0.36854e+00_r8 /) + kao(:, 7, 9) = (/ & + & 0.32383e+00_r8,0.32659e+00_r8,0.32849e+00_r8,0.32954e+00_r8,0.33028e+00_r8 /) + kao(:, 8, 9) = (/ & + & 0.28691e+00_r8,0.28966e+00_r8,0.29156e+00_r8,0.29286e+00_r8,0.29379e+00_r8 /) + kao(:, 9, 9) = (/ & + & 0.25109e+00_r8,0.25404e+00_r8,0.25607e+00_r8,0.25752e+00_r8,0.25870e+00_r8 /) + kao(:,10, 9) = (/ & + & 0.21600e+00_r8,0.21860e+00_r8,0.22047e+00_r8,0.22164e+00_r8,0.22251e+00_r8 /) + kao(:,11, 9) = (/ & + & 0.19149e+00_r8,0.19387e+00_r8,0.19567e+00_r8,0.19725e+00_r8,0.19809e+00_r8 /) + kao(:,12, 9) = (/ & + & 0.16914e+00_r8,0.17134e+00_r8,0.17303e+00_r8,0.17407e+00_r8,0.17494e+00_r8 /) + kao(:,13, 9) = (/ & + & 0.14841e+00_r8,0.15027e+00_r8,0.15244e+00_r8,0.15403e+00_r8,0.15523e+00_r8 /) + kao(:, 1,10) = (/ & + & 0.14885e+01_r8,0.14756e+01_r8,0.14663e+01_r8,0.14567e+01_r8,0.14479e+01_r8 /) + kao(:, 2,10) = (/ & + & 0.14911e+01_r8,0.14850e+01_r8,0.14762e+01_r8,0.14677e+01_r8,0.14597e+01_r8 /) + kao(:, 3,10) = (/ & + & 0.14749e+01_r8,0.14716e+01_r8,0.14663e+01_r8,0.14579e+01_r8,0.14502e+01_r8 /) + kao(:, 4,10) = (/ & + & 0.14314e+01_r8,0.14303e+01_r8,0.14232e+01_r8,0.14150e+01_r8,0.14115e+01_r8 /) + kao(:, 5,10) = (/ & + & 0.13616e+01_r8,0.13604e+01_r8,0.13539e+01_r8,0.13506e+01_r8,0.13501e+01_r8 /) + kao(:, 6,10) = (/ & + & 0.12710e+01_r8,0.12700e+01_r8,0.12670e+01_r8,0.12702e+01_r8,0.12745e+01_r8 /) + kao(:, 7,10) = (/ & + & 0.11674e+01_r8,0.11690e+01_r8,0.11727e+01_r8,0.11812e+01_r8,0.11854e+01_r8 /) + kao(:, 8,10) = (/ & + & 0.10584e+01_r8,0.10652e+01_r8,0.10757e+01_r8,0.10857e+01_r8,0.10906e+01_r8 /) + kao(:, 9,10) = (/ & + & 0.95450e+00_r8,0.96414e+00_r8,0.97673e+00_r8,0.98621e+00_r8,0.99187e+00_r8 /) + kao(:,10,10) = (/ & + & 0.83626e+00_r8,0.84690e+00_r8,0.85901e+00_r8,0.86824e+00_r8,0.87535e+00_r8 /) + kao(:,11,10) = (/ & + & 0.73738e+00_r8,0.74729e+00_r8,0.75610e+00_r8,0.75994e+00_r8,0.76481e+00_r8 /) + kao(:,12,10) = (/ & + & 0.66891e+00_r8,0.67622e+00_r8,0.68092e+00_r8,0.68498e+00_r8,0.68877e+00_r8 /) + kao(:,13,10) = (/ & + & 0.58616e+00_r8,0.59614e+00_r8,0.59749e+00_r8,0.60310e+00_r8,0.60445e+00_r8 /) + kao(:, 1,11) = (/ & + & 0.20080e+01_r8,0.19998e+01_r8,0.19844e+01_r8,0.19679e+01_r8,0.19504e+01_r8 /) + kao(:, 2,11) = (/ & + & 0.20896e+01_r8,0.20752e+01_r8,0.20596e+01_r8,0.20445e+01_r8,0.20293e+01_r8 /) + kao(:, 3,11) = (/ & + & 0.21262e+01_r8,0.21143e+01_r8,0.21043e+01_r8,0.20968e+01_r8,0.20862e+01_r8 /) + kao(:, 4,11) = (/ & + & 0.21310e+01_r8,0.21263e+01_r8,0.21243e+01_r8,0.21203e+01_r8,0.21144e+01_r8 /) + kao(:, 5,11) = (/ & + & 0.21041e+01_r8,0.21063e+01_r8,0.21071e+01_r8,0.21077e+01_r8,0.21021e+01_r8 /) + kao(:, 6,11) = (/ & + & 0.20447e+01_r8,0.20491e+01_r8,0.20534e+01_r8,0.20532e+01_r8,0.20477e+01_r8 /) + kao(:, 7,11) = (/ & + & 0.19487e+01_r8,0.19563e+01_r8,0.19608e+01_r8,0.19593e+01_r8,0.19591e+01_r8 /) + kao(:, 8,11) = (/ & + & 0.18239e+01_r8,0.18317e+01_r8,0.18359e+01_r8,0.18391e+01_r8,0.18451e+01_r8 /) + kao(:, 9,11) = (/ & + & 0.16772e+01_r8,0.16879e+01_r8,0.16955e+01_r8,0.17047e+01_r8,0.17179e+01_r8 /) + kao(:,10,11) = (/ & + & 0.15007e+01_r8,0.15184e+01_r8,0.15343e+01_r8,0.15540e+01_r8,0.15756e+01_r8 /) + kao(:,11,11) = (/ & + & 0.13041e+01_r8,0.13245e+01_r8,0.13445e+01_r8,0.13685e+01_r8,0.13888e+01_r8 /) + kao(:,12,11) = (/ & + & 0.11590e+01_r8,0.11749e+01_r8,0.11906e+01_r8,0.12046e+01_r8,0.12212e+01_r8 /) + kao(:,13,11) = (/ & + & 0.10681e+01_r8,0.10905e+01_r8,0.11017e+01_r8,0.10997e+01_r8,0.11116e+01_r8 /) + kao(:, 1,12) = (/ & + & 0.26762e+01_r8,0.26701e+01_r8,0.26710e+01_r8,0.26742e+01_r8,0.26733e+01_r8 /) + kao(:, 2,12) = (/ & + & 0.28804e+01_r8,0.28775e+01_r8,0.28798e+01_r8,0.28773e+01_r8,0.28700e+01_r8 /) + kao(:, 3,12) = (/ & + & 0.30825e+01_r8,0.30790e+01_r8,0.30757e+01_r8,0.30631e+01_r8,0.30471e+01_r8 /) + kao(:, 4,12) = (/ & + & 0.32355e+01_r8,0.32278e+01_r8,0.32144e+01_r8,0.31959e+01_r8,0.31753e+01_r8 /) + kao(:, 5,12) = (/ & + & 0.33271e+01_r8,0.33191e+01_r8,0.33073e+01_r8,0.32879e+01_r8,0.32714e+01_r8 /) + kao(:, 6,12) = (/ & + & 0.33604e+01_r8,0.33571e+01_r8,0.33478e+01_r8,0.33355e+01_r8,0.33272e+01_r8 /) + kao(:, 7,12) = (/ & + & 0.33406e+01_r8,0.33436e+01_r8,0.33436e+01_r8,0.33435e+01_r8,0.33409e+01_r8 /) + kao(:, 8,12) = (/ & + & 0.32648e+01_r8,0.32808e+01_r8,0.32919e+01_r8,0.32976e+01_r8,0.32999e+01_r8 /) + kao(:, 9,12) = (/ & + & 0.31373e+01_r8,0.31630e+01_r8,0.31816e+01_r8,0.31936e+01_r8,0.31991e+01_r8 /) + kao(:,10,12) = (/ & + & 0.29678e+01_r8,0.29982e+01_r8,0.30244e+01_r8,0.30412e+01_r8,0.30500e+01_r8 /) + kao(:,11,12) = (/ & + & 0.27380e+01_r8,0.27731e+01_r8,0.28013e+01_r8,0.28227e+01_r8,0.28455e+01_r8 /) + kao(:,12,12) = (/ & + & 0.24616e+01_r8,0.24905e+01_r8,0.25348e+01_r8,0.25805e+01_r8,0.26155e+01_r8 /) + kao(:,13,12) = (/ & + & 0.22251e+01_r8,0.22562e+01_r8,0.22966e+01_r8,0.23312e+01_r8,0.23811e+01_r8 /) + kao(:, 1,13) = (/ & + & 0.38031e+01_r8,0.37992e+01_r8,0.37926e+01_r8,0.37822e+01_r8,0.37755e+01_r8 /) + kao(:, 2,13) = (/ & + & 0.41542e+01_r8,0.41473e+01_r8,0.41391e+01_r8,0.41329e+01_r8,0.41296e+01_r8 /) + kao(:, 3,13) = (/ & + & 0.44998e+01_r8,0.44963e+01_r8,0.44896e+01_r8,0.44914e+01_r8,0.44937e+01_r8 /) + kao(:, 4,13) = (/ & + & 0.48464e+01_r8,0.48445e+01_r8,0.48485e+01_r8,0.48565e+01_r8,0.48598e+01_r8 /) + kao(:, 5,13) = (/ & + & 0.52074e+01_r8,0.52112e+01_r8,0.52168e+01_r8,0.52231e+01_r8,0.52210e+01_r8 /) + kao(:, 6,13) = (/ & + & 0.55492e+01_r8,0.55575e+01_r8,0.55655e+01_r8,0.55693e+01_r8,0.55642e+01_r8 /) + kao(:, 7,13) = (/ & + & 0.58380e+01_r8,0.58479e+01_r8,0.58509e+01_r8,0.58482e+01_r8,0.58453e+01_r8 /) + kao(:, 8,13) = (/ & + & 0.60377e+01_r8,0.60538e+01_r8,0.60594e+01_r8,0.60647e+01_r8,0.60640e+01_r8 /) + kao(:, 9,13) = (/ & + & 0.61268e+01_r8,0.61532e+01_r8,0.61730e+01_r8,0.61888e+01_r8,0.61993e+01_r8 /) + kao(:,10,13) = (/ & + & 0.61216e+01_r8,0.61612e+01_r8,0.61936e+01_r8,0.62230e+01_r8,0.62454e+01_r8 /) + kao(:,11,13) = (/ & + & 0.60409e+01_r8,0.60960e+01_r8,0.61462e+01_r8,0.61882e+01_r8,0.62219e+01_r8 /) + kao(:,12,13) = (/ & + & 0.58645e+01_r8,0.59597e+01_r8,0.60234e+01_r8,0.60826e+01_r8,0.61390e+01_r8 /) + kao(:,13,13) = (/ & + & 0.56001e+01_r8,0.57009e+01_r8,0.58017e+01_r8,0.59181e+01_r8,0.59860e+01_r8 /) + kao(:, 1,14) = (/ & + & 0.53647e+01_r8,0.53127e+01_r8,0.52736e+01_r8,0.52471e+01_r8,0.52264e+01_r8 /) + kao(:, 2,14) = (/ & + & 0.62359e+01_r8,0.61753e+01_r8,0.61253e+01_r8,0.60847e+01_r8,0.60573e+01_r8 /) + kao(:, 3,14) = (/ & + & 0.72065e+01_r8,0.71249e+01_r8,0.70556e+01_r8,0.69965e+01_r8,0.69559e+01_r8 /) + kao(:, 4,14) = (/ & + & 0.81631e+01_r8,0.80714e+01_r8,0.79828e+01_r8,0.79081e+01_r8,0.78545e+01_r8 /) + kao(:, 5,14) = (/ & + & 0.90691e+01_r8,0.89602e+01_r8,0.88621e+01_r8,0.87858e+01_r8,0.87314e+01_r8 /) + kao(:, 6,14) = (/ & + & 0.99707e+01_r8,0.98474e+01_r8,0.97395e+01_r8,0.96541e+01_r8,0.95904e+01_r8 /) + kao(:, 7,14) = (/ & + & 0.10852e+02_r8,0.10724e+02_r8,0.10620e+02_r8,0.10536e+02_r8,0.10469e+02_r8 /) + kao(:, 8,14) = (/ & + & 0.11716e+02_r8,0.11588e+02_r8,0.11487e+02_r8,0.11403e+02_r8,0.11337e+02_r8 /) + kao(:, 9,14) = (/ & + & 0.12572e+02_r8,0.12448e+02_r8,0.12341e+02_r8,0.12260e+02_r8,0.12188e+02_r8 /) + kao(:,10,14) = (/ & + & 0.13374e+02_r8,0.13256e+02_r8,0.13159e+02_r8,0.13080e+02_r8,0.13010e+02_r8 /) + kao(:,11,14) = (/ & + & 0.14046e+02_r8,0.13957e+02_r8,0.13888e+02_r8,0.13824e+02_r8,0.13769e+02_r8 /) + kao(:,12,14) = (/ & + & 0.14644e+02_r8,0.14592e+02_r8,0.14548e+02_r8,0.14504e+02_r8,0.14461e+02_r8 /) + kao(:,13,14) = (/ & + & 0.15144e+02_r8,0.15129e+02_r8,0.15111e+02_r8,0.15095e+02_r8,0.15074e+02_r8 /) + kao(:, 1,15) = (/ & + & 0.72019e+01_r8,0.71097e+01_r8,0.70236e+01_r8,0.69449e+01_r8,0.68844e+01_r8 /) + kao(:, 2,15) = (/ & + & 0.87604e+01_r8,0.86468e+01_r8,0.85349e+01_r8,0.84375e+01_r8,0.83491e+01_r8 /) + kao(:, 3,15) = (/ & + & 0.10615e+02_r8,0.10469e+02_r8,0.10333e+02_r8,0.10214e+02_r8,0.10099e+02_r8 /) + kao(:, 4,15) = (/ & + & 0.12669e+02_r8,0.12473e+02_r8,0.12305e+02_r8,0.12161e+02_r8,0.12026e+02_r8 /) + kao(:, 5,15) = (/ & + & 0.14978e+02_r8,0.14741e+02_r8,0.14530e+02_r8,0.14329e+02_r8,0.14143e+02_r8 /) + kao(:, 6,15) = (/ & + & 0.17562e+02_r8,0.17282e+02_r8,0.17031e+02_r8,0.16791e+02_r8,0.16552e+02_r8 /) + kao(:, 7,15) = (/ & + & 0.20480e+02_r8,0.20136e+02_r8,0.19827e+02_r8,0.19524e+02_r8,0.19223e+02_r8 /) + kao(:, 8,15) = (/ & + & 0.23734e+02_r8,0.23307e+02_r8,0.22908e+02_r8,0.22521e+02_r8,0.22160e+02_r8 /) + kao(:, 9,15) = (/ & + & 0.27249e+02_r8,0.26733e+02_r8,0.26255e+02_r8,0.25787e+02_r8,0.25354e+02_r8 /) + kao(:,10,15) = (/ & + & 0.30889e+02_r8,0.30311e+02_r8,0.29740e+02_r8,0.29192e+02_r8,0.28690e+02_r8 /) + kao(:,11,15) = (/ & + & 0.34366e+02_r8,0.33687e+02_r8,0.33035e+02_r8,0.32430e+02_r8,0.31843e+02_r8 /) + kao(:,12,15) = (/ & + & 0.37839e+02_r8,0.37085e+02_r8,0.36360e+02_r8,0.35655e+02_r8,0.34957e+02_r8 /) + kao(:,13,15) = (/ & + & 0.41323e+02_r8,0.40503e+02_r8,0.39673e+02_r8,0.38847e+02_r8,0.38049e+02_r8 /) + kao(:, 1,16) = (/ & + & 0.82631e+01_r8,0.81761e+01_r8,0.80809e+01_r8,0.79778e+01_r8,0.79010e+01_r8 /) + kao(:, 2,16) = (/ & + & 0.10258e+02_r8,0.10128e+02_r8,0.10005e+02_r8,0.98803e+01_r8,0.97700e+01_r8 /) + kao(:, 3,16) = (/ & + & 0.12786e+02_r8,0.12614e+02_r8,0.12441e+02_r8,0.12267e+02_r8,0.12120e+02_r8 /) + kao(:, 4,16) = (/ & + & 0.15843e+02_r8,0.15549e+02_r8,0.15326e+02_r8,0.15095e+02_r8,0.14871e+02_r8 /) + kao(:, 5,16) = (/ & + & 0.19543e+02_r8,0.19089e+02_r8,0.18733e+02_r8,0.18430e+02_r8,0.18134e+02_r8 /) + kao(:, 6,16) = (/ & + & 0.24038e+02_r8,0.23415e+02_r8,0.22893e+02_r8,0.22427e+02_r8,0.22005e+02_r8 /) + kao(:, 7,16) = (/ & + & 0.29445e+02_r8,0.28630e+02_r8,0.27921e+02_r8,0.27268e+02_r8,0.26654e+02_r8 /) + kao(:, 8,16) = (/ & + & 0.35889e+02_r8,0.34849e+02_r8,0.33913e+02_r8,0.33036e+02_r8,0.32194e+02_r8 /) + kao(:, 9,16) = (/ & + & 0.43512e+02_r8,0.42175e+02_r8,0.40956e+02_r8,0.39809e+02_r8,0.38685e+02_r8 /) + kao(:,10,16) = (/ & + & 0.52253e+02_r8,0.50582e+02_r8,0.49011e+02_r8,0.47508e+02_r8,0.46037e+02_r8 /) + kao(:,11,16) = (/ & + & 0.61290e+02_r8,0.59240e+02_r8,0.57269e+02_r8,0.55343e+02_r8,0.53572e+02_r8 /) + kao(:,12,16) = (/ & + & 0.71193e+02_r8,0.68607e+02_r8,0.66135e+02_r8,0.63828e+02_r8,0.61720e+02_r8 /) + kao(:,13,16) = (/ & + & 0.81988e+02_r8,0.78665e+02_r8,0.75707e+02_r8,0.72932e+02_r8,0.70347e+02_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.29597e-05_r8,0.31929e-05_r8,0.34159e-05_r8,0.36256e-05_r8,0.38264e-05_r8 /) + kbo(:,14, 1) = (/ & + & 0.24233e-05_r8,0.26151e-05_r8,0.27866e-05_r8,0.29502e-05_r8,0.31170e-05_r8 /) + kbo(:,15, 1) = (/ & + & 0.19206e-05_r8,0.20789e-05_r8,0.22099e-05_r8,0.23383e-05_r8,0.24505e-05_r8 /) + kbo(:,16, 1) = (/ & + & 0.14933e-05_r8,0.16071e-05_r8,0.17039e-05_r8,0.17994e-05_r8,0.18816e-05_r8 /) + kbo(:,17, 1) = (/ & + & 0.11429e-05_r8,0.12144e-05_r8,0.12895e-05_r8,0.13503e-05_r8,0.14174e-05_r8 /) + kbo(:,18, 1) = (/ & + & 0.84134e-06_r8,0.89264e-06_r8,0.94260e-06_r8,0.99003e-06_r8,0.10391e-05_r8 /) + kbo(:,19, 1) = (/ & + & 0.60683e-06_r8,0.64142e-06_r8,0.68018e-06_r8,0.72042e-06_r8,0.75479e-06_r8 /) + kbo(:,20, 1) = (/ & + & 0.45809e-06_r8,0.48813e-06_r8,0.51934e-06_r8,0.54823e-06_r8,0.57261e-06_r8 /) + kbo(:,21, 1) = (/ & + & 0.35219e-06_r8,0.37835e-06_r8,0.40322e-06_r8,0.42772e-06_r8,0.44736e-06_r8 /) + kbo(:,22, 1) = (/ & + & 0.27419e-06_r8,0.29542e-06_r8,0.31617e-06_r8,0.33398e-06_r8,0.34932e-06_r8 /) + kbo(:,23, 1) = (/ & + & 0.21385e-06_r8,0.23127e-06_r8,0.24670e-06_r8,0.25951e-06_r8,0.26952e-06_r8 /) + kbo(:,24, 1) = (/ & + & 0.16767e-06_r8,0.18179e-06_r8,0.19282e-06_r8,0.20136e-06_r8,0.21113e-06_r8 /) + kbo(:,25, 1) = (/ & + & 0.13361e-06_r8,0.14301e-06_r8,0.14980e-06_r8,0.15778e-06_r8,0.16615e-06_r8 /) + kbo(:,26, 1) = (/ & + & 0.10615e-06_r8,0.11218e-06_r8,0.11889e-06_r8,0.12574e-06_r8,0.13111e-06_r8 /) + kbo(:,27, 1) = (/ & + & 0.83660e-07_r8,0.89296e-07_r8,0.95019e-07_r8,0.10007e-06_r8,0.10397e-06_r8 /) + kbo(:,28, 1) = (/ & + & 0.66667e-07_r8,0.71217e-07_r8,0.75615e-07_r8,0.79237e-07_r8,0.82239e-07_r8 /) + kbo(:,29, 1) = (/ & + & 0.52776e-07_r8,0.56086e-07_r8,0.59828e-07_r8,0.62513e-07_r8,0.64218e-07_r8 /) + kbo(:,30, 1) = (/ & + & 0.41429e-07_r8,0.44370e-07_r8,0.46731e-07_r8,0.48553e-07_r8,0.50143e-07_r8 /) + kbo(:,31, 1) = (/ & + & 0.32437e-07_r8,0.34523e-07_r8,0.36208e-07_r8,0.37500e-07_r8,0.38571e-07_r8 /) + kbo(:,32, 1) = (/ & + & 0.25237e-07_r8,0.26730e-07_r8,0.27868e-07_r8,0.28829e-07_r8,0.29943e-07_r8 /) + kbo(:,33, 1) = (/ & + & 0.19545e-07_r8,0.20614e-07_r8,0.21467e-07_r8,0.22280e-07_r8,0.23141e-07_r8 /) + kbo(:,34, 1) = (/ & + & 0.15146e-07_r8,0.15869e-07_r8,0.16509e-07_r8,0.17179e-07_r8,0.17980e-07_r8 /) + kbo(:,35, 1) = (/ & + & 0.11482e-07_r8,0.12039e-07_r8,0.12547e-07_r8,0.13255e-07_r8,0.13874e-07_r8 /) + kbo(:,36, 1) = (/ & + & 0.86172e-08_r8,0.90023e-08_r8,0.95607e-08_r8,0.10106e-07_r8,0.10595e-07_r8 /) + kbo(:,37, 1) = (/ & + & 0.67411e-08_r8,0.70781e-08_r8,0.75553e-08_r8,0.79739e-08_r8,0.84011e-08_r8 /) + kbo(:,38, 1) = (/ & + & 0.52604e-08_r8,0.55743e-08_r8,0.59410e-08_r8,0.63031e-08_r8,0.66516e-08_r8 /) + kbo(:,39, 1) = (/ & + & 0.41129e-08_r8,0.43854e-08_r8,0.46851e-08_r8,0.49771e-08_r8,0.52463e-08_r8 /) + kbo(:,40, 1) = (/ & + & 0.33089e-08_r8,0.35289e-08_r8,0.37702e-08_r8,0.40125e-08_r8,0.42415e-08_r8 /) + kbo(:,41, 1) = (/ & + & 0.26794e-08_r8,0.28488e-08_r8,0.30428e-08_r8,0.32437e-08_r8,0.34420e-08_r8 /) + kbo(:,42, 1) = (/ & + & 0.21670e-08_r8,0.23030e-08_r8,0.24589e-08_r8,0.26252e-08_r8,0.27867e-08_r8 /) + kbo(:,43, 1) = (/ & + & 0.17699e-08_r8,0.18853e-08_r8,0.20001e-08_r8,0.21330e-08_r8,0.22657e-08_r8 /) + kbo(:,44, 1) = (/ & + & 0.14446e-08_r8,0.15471e-08_r8,0.16397e-08_r8,0.17423e-08_r8,0.18526e-08_r8 /) + kbo(:,45, 1) = (/ & + & 0.11734e-08_r8,0.12754e-08_r8,0.13542e-08_r8,0.14242e-08_r8,0.15193e-08_r8 /) + kbo(:,46, 1) = (/ & + & 0.95743e-09_r8,0.10470e-08_r8,0.11183e-08_r8,0.11726e-08_r8,0.12389e-08_r8 /) + kbo(:,47, 1) = (/ & + & 0.77345e-09_r8,0.85197e-09_r8,0.92184e-09_r8,0.97368e-09_r8,0.10149e-08_r8 /) + kbo(:,48, 1) = (/ & + & 0.62500e-09_r8,0.69288e-09_r8,0.75548e-09_r8,0.80446e-09_r8,0.84428e-09_r8 /) + kbo(:,49, 1) = (/ & + & 0.50095e-09_r8,0.55967e-09_r8,0.61904e-09_r8,0.66441e-09_r8,0.70339e-09_r8 /) + kbo(:,50, 1) = (/ & + & 0.40806e-09_r8,0.45712e-09_r8,0.50530e-09_r8,0.54974e-09_r8,0.58246e-09_r8 /) + kbo(:,51, 1) = (/ & + & 0.33102e-09_r8,0.37130e-09_r8,0.41121e-09_r8,0.45024e-09_r8,0.48436e-09_r8 /) + kbo(:,52, 1) = (/ & + & 0.26906e-09_r8,0.30739e-09_r8,0.33845e-09_r8,0.36884e-09_r8,0.40024e-09_r8 /) + kbo(:,53, 1) = (/ & + & 0.22202e-09_r8,0.25108e-09_r8,0.27937e-09_r8,0.30592e-09_r8,0.33012e-09_r8 /) + kbo(:,54, 1) = (/ & + & 0.18662e-09_r8,0.20761e-09_r8,0.23072e-09_r8,0.25342e-09_r8,0.27445e-09_r8 /) + kbo(:,55, 1) = (/ & + & 0.15741e-09_r8,0.17147e-09_r8,0.19146e-09_r8,0.21029e-09_r8,0.22857e-09_r8 /) + kbo(:,56, 1) = (/ & + & 0.13151e-09_r8,0.14637e-09_r8,0.15977e-09_r8,0.17547e-09_r8,0.18974e-09_r8 /) + kbo(:,57, 1) = (/ & + & 0.10874e-09_r8,0.12447e-09_r8,0.13634e-09_r8,0.14752e-09_r8,0.16022e-09_r8 /) + kbo(:,58, 1) = (/ & + & 0.90206e-10_r8,0.10484e-09_r8,0.11617e-09_r8,0.12545e-09_r8,0.13474e-09_r8 /) + kbo(:,59, 1) = (/ & + & 0.76759e-10_r8,0.88866e-10_r8,0.99340e-10_r8,0.10706e-09_r8,0.11444e-09_r8 /) + kbo(:,13, 2) = (/ & + & 0.14727e-04_r8,0.16357e-04_r8,0.17961e-04_r8,0.19530e-04_r8,0.20852e-04_r8 /) + kbo(:,14, 2) = (/ & + & 0.12148e-04_r8,0.13478e-04_r8,0.14818e-04_r8,0.16049e-04_r8,0.17100e-04_r8 /) + kbo(:,15, 2) = (/ & + & 0.96902e-05_r8,0.10787e-04_r8,0.11835e-04_r8,0.12770e-04_r8,0.13515e-04_r8 /) + kbo(:,16, 2) = (/ & + & 0.76235e-05_r8,0.84575e-05_r8,0.92217e-05_r8,0.98526e-05_r8,0.10449e-04_r8 /) + kbo(:,17, 2) = (/ & + & 0.58049e-05_r8,0.64239e-05_r8,0.69733e-05_r8,0.74131e-05_r8,0.78082e-05_r8 /) + kbo(:,18, 2) = (/ & + & 0.43204e-05_r8,0.47510e-05_r8,0.51165e-05_r8,0.54579e-05_r8,0.57434e-05_r8 /) + kbo(:,19, 2) = (/ & + & 0.32211e-05_r8,0.35327e-05_r8,0.38175e-05_r8,0.40535e-05_r8,0.42245e-05_r8 /) + kbo(:,20, 2) = (/ & + & 0.25265e-05_r8,0.27652e-05_r8,0.29644e-05_r8,0.31331e-05_r8,0.32730e-05_r8 /) + kbo(:,21, 2) = (/ & + & 0.19921e-05_r8,0.21749e-05_r8,0.23343e-05_r8,0.24377e-05_r8,0.25458e-05_r8 /) + kbo(:,22, 2) = (/ & + & 0.15859e-05_r8,0.17259e-05_r8,0.18236e-05_r8,0.19124e-05_r8,0.19942e-05_r8 /) + kbo(:,23, 2) = (/ & + & 0.12591e-05_r8,0.13565e-05_r8,0.14309e-05_r8,0.15032e-05_r8,0.15642e-05_r8 /) + kbo(:,24, 2) = (/ & + & 0.10012e-05_r8,0.10701e-05_r8,0.11246e-05_r8,0.11819e-05_r8,0.12279e-05_r8 /) + kbo(:,25, 2) = (/ & + & 0.78985e-06_r8,0.84074e-06_r8,0.89029e-06_r8,0.93145e-06_r8,0.97085e-06_r8 /) + kbo(:,26, 2) = (/ & + & 0.62996e-06_r8,0.66847e-06_r8,0.70637e-06_r8,0.73513e-06_r8,0.77135e-06_r8 /) + kbo(:,27, 2) = (/ & + & 0.50283e-06_r8,0.53111e-06_r8,0.55653e-06_r8,0.58306e-06_r8,0.61799e-06_r8 /) + kbo(:,28, 2) = (/ & + & 0.39962e-06_r8,0.42320e-06_r8,0.44265e-06_r8,0.46715e-06_r8,0.49516e-06_r8 /) + kbo(:,29, 2) = (/ & + & 0.31810e-06_r8,0.33597e-06_r8,0.35191e-06_r8,0.37448e-06_r8,0.39768e-06_r8 /) + kbo(:,30, 2) = (/ & + & 0.25242e-06_r8,0.26447e-06_r8,0.28109e-06_r8,0.30089e-06_r8,0.31543e-06_r8 /) + kbo(:,31, 2) = (/ & + & 0.19837e-06_r8,0.20954e-06_r8,0.22442e-06_r8,0.23762e-06_r8,0.25183e-06_r8 /) + kbo(:,32, 2) = (/ & + & 0.15599e-06_r8,0.16701e-06_r8,0.17789e-06_r8,0.18880e-06_r8,0.20030e-06_r8 /) + kbo(:,33, 2) = (/ & + & 0.12307e-06_r8,0.13211e-06_r8,0.14046e-06_r8,0.15111e-06_r8,0.15988e-06_r8 /) + kbo(:,34, 2) = (/ & + & 0.98429e-07_r8,0.10498e-06_r8,0.11326e-06_r8,0.12074e-06_r8,0.12779e-06_r8 /) + kbo(:,35, 2) = (/ & + & 0.77743e-07_r8,0.83951e-07_r8,0.90473e-07_r8,0.96277e-07_r8,0.10204e-06_r8 /) + kbo(:,36, 2) = (/ & + & 0.61220e-07_r8,0.66399e-07_r8,0.71102e-07_r8,0.75946e-07_r8,0.80803e-07_r8 /) + kbo(:,37, 2) = (/ & + & 0.48819e-07_r8,0.52962e-07_r8,0.56669e-07_r8,0.60817e-07_r8,0.64709e-07_r8 /) + kbo(:,38, 2) = (/ & + & 0.38871e-07_r8,0.42226e-07_r8,0.45376e-07_r8,0.48641e-07_r8,0.51855e-07_r8 /) + kbo(:,39, 2) = (/ & + & 0.30869e-07_r8,0.33485e-07_r8,0.36233e-07_r8,0.38868e-07_r8,0.41523e-07_r8 /) + kbo(:,40, 2) = (/ & + & 0.24798e-07_r8,0.26983e-07_r8,0.29180e-07_r8,0.31437e-07_r8,0.33600e-07_r8 /) + kbo(:,41, 2) = (/ & + & 0.19951e-07_r8,0.21784e-07_r8,0.23518e-07_r8,0.25460e-07_r8,0.27219e-07_r8 /) + kbo(:,42, 2) = (/ & + & 0.16098e-07_r8,0.17542e-07_r8,0.18979e-07_r8,0.20547e-07_r8,0.22016e-07_r8 /) + kbo(:,43, 2) = (/ & + & 0.13020e-07_r8,0.14144e-07_r8,0.15414e-07_r8,0.16610e-07_r8,0.17870e-07_r8 /) + kbo(:,44, 2) = (/ & + & 0.10548e-07_r8,0.11500e-07_r8,0.12492e-07_r8,0.13520e-07_r8,0.14524e-07_r8 /) + kbo(:,45, 2) = (/ & + & 0.85602e-08_r8,0.93245e-08_r8,0.10096e-07_r8,0.10978e-07_r8,0.11819e-07_r8 /) + kbo(:,46, 2) = (/ & + & 0.69149e-08_r8,0.75653e-08_r8,0.82154e-08_r8,0.88822e-08_r8,0.96002e-08_r8 /) + kbo(:,47, 2) = (/ & + & 0.55708e-08_r8,0.61164e-08_r8,0.66678e-08_r8,0.71922e-08_r8,0.77633e-08_r8 /) + kbo(:,48, 2) = (/ & + & 0.44804e-08_r8,0.49312e-08_r8,0.53967e-08_r8,0.58662e-08_r8,0.62780e-08_r8 /) + kbo(:,49, 2) = (/ & + & 0.36467e-08_r8,0.39866e-08_r8,0.43628e-08_r8,0.47589e-08_r8,0.51208e-08_r8 /) + kbo(:,50, 2) = (/ & + & 0.29524e-08_r8,0.32540e-08_r8,0.35471e-08_r8,0.38638e-08_r8,0.41887e-08_r8 /) + kbo(:,51, 2) = (/ & + & 0.23887e-08_r8,0.26526e-08_r8,0.28959e-08_r8,0.31504e-08_r8,0.34112e-08_r8 /) + kbo(:,52, 2) = (/ & + & 0.19321e-08_r8,0.21648e-08_r8,0.23625e-08_r8,0.25839e-08_r8,0.28173e-08_r8 /) + kbo(:,53, 2) = (/ & + & 0.15684e-08_r8,0.17725e-08_r8,0.19476e-08_r8,0.21240e-08_r8,0.23118e-08_r8 /) + kbo(:,54, 2) = (/ & + & 0.12799e-08_r8,0.14467e-08_r8,0.16073e-08_r8,0.17494e-08_r8,0.19160e-08_r8 /) + kbo(:,55, 2) = (/ & + & 0.10442e-08_r8,0.11911e-08_r8,0.13216e-08_r8,0.14537e-08_r8,0.15771e-08_r8 /) + kbo(:,56, 2) = (/ & + & 0.85741e-09_r8,0.97937e-09_r8,0.10936e-08_r8,0.12056e-08_r8,0.13167e-08_r8 /) + kbo(:,57, 2) = (/ & + & 0.70358e-09_r8,0.80334e-09_r8,0.90824e-09_r8,0.10056e-08_r8,0.11010e-08_r8 /) + kbo(:,58, 2) = (/ & + & 0.57428e-09_r8,0.66441e-09_r8,0.75420e-09_r8,0.83627e-09_r8,0.92485e-09_r8 /) + kbo(:,59, 2) = (/ & + & 0.47922e-09_r8,0.55592e-09_r8,0.63499e-09_r8,0.70731e-09_r8,0.78678e-09_r8 /) + kbo(:,13, 3) = (/ & + & 0.76201e-04_r8,0.82699e-04_r8,0.87499e-04_r8,0.91352e-04_r8,0.95348e-04_r8 /) + kbo(:,14, 3) = (/ & + & 0.62821e-04_r8,0.67861e-04_r8,0.71868e-04_r8,0.75108e-04_r8,0.78557e-04_r8 /) + kbo(:,15, 3) = (/ & + & 0.49775e-04_r8,0.53367e-04_r8,0.56639e-04_r8,0.59001e-04_r8,0.62303e-04_r8 /) + kbo(:,16, 3) = (/ & + & 0.38005e-04_r8,0.40883e-04_r8,0.43269e-04_r8,0.45403e-04_r8,0.48139e-04_r8 /) + kbo(:,17, 3) = (/ & + & 0.28550e-04_r8,0.30750e-04_r8,0.32331e-04_r8,0.34489e-04_r8,0.36687e-04_r8 /) + kbo(:,18, 3) = (/ & + & 0.20976e-04_r8,0.22322e-04_r8,0.23743e-04_r8,0.25554e-04_r8,0.27223e-04_r8 /) + kbo(:,19, 3) = (/ & + & 0.15389e-04_r8,0.16422e-04_r8,0.17792e-04_r8,0.19127e-04_r8,0.20295e-04_r8 /) + kbo(:,20, 3) = (/ & + & 0.11883e-04_r8,0.12816e-04_r8,0.13962e-04_r8,0.14872e-04_r8,0.15725e-04_r8 /) + kbo(:,21, 3) = (/ & + & 0.92948e-05_r8,0.10187e-04_r8,0.10986e-04_r8,0.11713e-04_r8,0.12426e-04_r8 /) + kbo(:,22, 3) = (/ & + & 0.73969e-05_r8,0.80840e-05_r8,0.87263e-05_r8,0.93856e-05_r8,0.99533e-05_r8 /) + kbo(:,23, 3) = (/ & + & 0.58961e-05_r8,0.64591e-05_r8,0.69648e-05_r8,0.74494e-05_r8,0.79385e-05_r8 /) + kbo(:,24, 3) = (/ & + & 0.47445e-05_r8,0.51742e-05_r8,0.56036e-05_r8,0.59758e-05_r8,0.63724e-05_r8 /) + kbo(:,25, 3) = (/ & + & 0.38442e-05_r8,0.41791e-05_r8,0.44837e-05_r8,0.48078e-05_r8,0.51294e-05_r8 /) + kbo(:,26, 3) = (/ & + & 0.31335e-05_r8,0.33923e-05_r8,0.36400e-05_r8,0.38961e-05_r8,0.41487e-05_r8 /) + kbo(:,27, 3) = (/ & + & 0.25499e-05_r8,0.27432e-05_r8,0.29560e-05_r8,0.31545e-05_r8,0.33433e-05_r8 /) + kbo(:,28, 3) = (/ & + & 0.20635e-05_r8,0.22231e-05_r8,0.23897e-05_r8,0.25516e-05_r8,0.26938e-05_r8 /) + kbo(:,29, 3) = (/ & + & 0.16635e-05_r8,0.18024e-05_r8,0.19279e-05_r8,0.20498e-05_r8,0.21627e-05_r8 /) + kbo(:,30, 3) = (/ & + & 0.13359e-05_r8,0.14474e-05_r8,0.15470e-05_r8,0.16346e-05_r8,0.17457e-05_r8 /) + kbo(:,31, 3) = (/ & + & 0.10697e-05_r8,0.11477e-05_r8,0.12254e-05_r8,0.13097e-05_r8,0.13914e-05_r8 /) + kbo(:,32, 3) = (/ & + & 0.84958e-06_r8,0.91464e-06_r8,0.98189e-06_r8,0.10489e-05_r8,0.11150e-05_r8 /) + kbo(:,33, 3) = (/ & + & 0.68178e-06_r8,0.73356e-06_r8,0.78905e-06_r8,0.84226e-06_r8,0.89476e-06_r8 /) + kbo(:,34, 3) = (/ & + & 0.54737e-06_r8,0.58995e-06_r8,0.63374e-06_r8,0.67732e-06_r8,0.72182e-06_r8 /) + kbo(:,35, 3) = (/ & + & 0.43680e-06_r8,0.47086e-06_r8,0.50771e-06_r8,0.54209e-06_r8,0.57687e-06_r8 /) + kbo(:,36, 3) = (/ & + & 0.34612e-06_r8,0.37466e-06_r8,0.40370e-06_r8,0.43073e-06_r8,0.45979e-06_r8 /) + kbo(:,37, 3) = (/ & + & 0.27725e-06_r8,0.30048e-06_r8,0.32451e-06_r8,0.34638e-06_r8,0.37105e-06_r8 /) + kbo(:,38, 3) = (/ & + & 0.22228e-06_r8,0.24114e-06_r8,0.26049e-06_r8,0.27871e-06_r8,0.29935e-06_r8 /) + kbo(:,39, 3) = (/ & + & 0.17797e-06_r8,0.19317e-06_r8,0.20878e-06_r8,0.22411e-06_r8,0.24102e-06_r8 /) + kbo(:,40, 3) = (/ & + & 0.14346e-06_r8,0.15601e-06_r8,0.16913e-06_r8,0.18197e-06_r8,0.19566e-06_r8 /) + kbo(:,41, 3) = (/ & + & 0.11559e-06_r8,0.12615e-06_r8,0.13697e-06_r8,0.14785e-06_r8,0.15874e-06_r8 /) + kbo(:,42, 3) = (/ & + & 0.93358e-07_r8,0.10214e-06_r8,0.11089e-06_r8,0.11998e-06_r8,0.12904e-06_r8 /) + kbo(:,43, 3) = (/ & + & 0.75599e-07_r8,0.82690e-07_r8,0.89808e-07_r8,0.97524e-07_r8,0.10511e-06_r8 /) + kbo(:,44, 3) = (/ & + & 0.61285e-07_r8,0.66786e-07_r8,0.72937e-07_r8,0.79087e-07_r8,0.85525e-07_r8 /) + kbo(:,45, 3) = (/ & + & 0.49725e-07_r8,0.54294e-07_r8,0.59263e-07_r8,0.64213e-07_r8,0.69583e-07_r8 /) + kbo(:,46, 3) = (/ & + & 0.40336e-07_r8,0.44186e-07_r8,0.48034e-07_r8,0.52184e-07_r8,0.56534e-07_r8 /) + kbo(:,47, 3) = (/ & + & 0.32904e-07_r8,0.35633e-07_r8,0.38959e-07_r8,0.42402e-07_r8,0.45883e-07_r8 /) + kbo(:,48, 3) = (/ & + & 0.26725e-07_r8,0.29104e-07_r8,0.31693e-07_r8,0.34312e-07_r8,0.37304e-07_r8 /) + kbo(:,49, 3) = (/ & + & 0.21751e-07_r8,0.23849e-07_r8,0.25803e-07_r8,0.28024e-07_r8,0.30356e-07_r8 /) + kbo(:,50, 3) = (/ & + & 0.17587e-07_r8,0.19609e-07_r8,0.21216e-07_r8,0.23022e-07_r8,0.24942e-07_r8 /) + kbo(:,51, 3) = (/ & + & 0.14376e-07_r8,0.15990e-07_r8,0.17493e-07_r8,0.18872e-07_r8,0.20463e-07_r8 /) + kbo(:,52, 3) = (/ & + & 0.11811e-07_r8,0.13106e-07_r8,0.14489e-07_r8,0.15615e-07_r8,0.16832e-07_r8 /) + kbo(:,53, 3) = (/ & + & 0.96001e-08_r8,0.10788e-07_r8,0.11921e-07_r8,0.12985e-07_r8,0.13904e-07_r8 /) + kbo(:,54, 3) = (/ & + & 0.78243e-08_r8,0.89178e-08_r8,0.98430e-08_r8,0.10840e-07_r8,0.11619e-07_r8 /) + kbo(:,55, 3) = (/ & + & 0.63638e-08_r8,0.73678e-08_r8,0.82214e-08_r8,0.89997e-08_r8,0.97565e-08_r8 /) + kbo(:,56, 3) = (/ & + & 0.51753e-08_r8,0.60497e-08_r8,0.68419e-08_r8,0.74560e-08_r8,0.82362e-08_r8 /) + kbo(:,57, 3) = (/ & + & 0.42164e-08_r8,0.49916e-08_r8,0.57066e-08_r8,0.63308e-08_r8,0.68950e-08_r8 /) + kbo(:,58, 3) = (/ & + & 0.34618e-08_r8,0.41424e-08_r8,0.48054e-08_r8,0.53757e-08_r8,0.58095e-08_r8 /) + kbo(:,59, 3) = (/ & + & 0.29083e-08_r8,0.35291e-08_r8,0.40932e-08_r8,0.46285e-08_r8,0.49865e-08_r8 /) + kbo(:,13, 4) = (/ & + & 0.37674e-03_r8,0.40953e-03_r8,0.43690e-03_r8,0.46059e-03_r8,0.48007e-03_r8 /) + kbo(:,14, 4) = (/ & + & 0.31202e-03_r8,0.33906e-03_r8,0.36066e-03_r8,0.38003e-03_r8,0.39627e-03_r8 /) + kbo(:,15, 4) = (/ & + & 0.25135e-03_r8,0.27271e-03_r8,0.29069e-03_r8,0.30661e-03_r8,0.32005e-03_r8 /) + kbo(:,16, 4) = (/ & + & 0.19797e-03_r8,0.21527e-03_r8,0.22955e-03_r8,0.24328e-03_r8,0.25456e-03_r8 /) + kbo(:,17, 4) = (/ & + & 0.15354e-03_r8,0.16679e-03_r8,0.17933e-03_r8,0.19101e-03_r8,0.20041e-03_r8 /) + kbo(:,18, 4) = (/ & + & 0.11742e-03_r8,0.12797e-03_r8,0.13923e-03_r8,0.14836e-03_r8,0.15654e-03_r8 /) + kbo(:,19, 4) = (/ & + & 0.90519e-04_r8,0.99386e-04_r8,0.10819e-03_r8,0.11601e-03_r8,0.12319e-03_r8 /) + kbo(:,20, 4) = (/ & + & 0.72579e-04_r8,0.79910e-04_r8,0.87075e-04_r8,0.93728e-04_r8,0.99656e-04_r8 /) + kbo(:,21, 4) = (/ & + & 0.58866e-04_r8,0.64805e-04_r8,0.70705e-04_r8,0.76153e-04_r8,0.80996e-04_r8 /) + kbo(:,22, 4) = (/ & + & 0.48157e-04_r8,0.52883e-04_r8,0.57740e-04_r8,0.62130e-04_r8,0.66100e-04_r8 /) + kbo(:,23, 4) = (/ & + & 0.39337e-04_r8,0.43289e-04_r8,0.47275e-04_r8,0.50906e-04_r8,0.54161e-04_r8 /) + kbo(:,24, 4) = (/ & + & 0.32289e-04_r8,0.35577e-04_r8,0.38808e-04_r8,0.41814e-04_r8,0.44433e-04_r8 /) + kbo(:,25, 4) = (/ & + & 0.26615e-04_r8,0.29301e-04_r8,0.31984e-04_r8,0.34396e-04_r8,0.36509e-04_r8 /) + kbo(:,26, 4) = (/ & + & 0.22060e-04_r8,0.24270e-04_r8,0.26460e-04_r8,0.28450e-04_r8,0.30203e-04_r8 /) + kbo(:,27, 4) = (/ & + & 0.18344e-04_r8,0.20177e-04_r8,0.21948e-04_r8,0.23595e-04_r8,0.25001e-04_r8 /) + kbo(:,28, 4) = (/ & + & 0.15256e-04_r8,0.16787e-04_r8,0.18242e-04_r8,0.19561e-04_r8,0.20696e-04_r8 /) + kbo(:,29, 4) = (/ & + & 0.12679e-04_r8,0.13952e-04_r8,0.15170e-04_r8,0.16211e-04_r8,0.17163e-04_r8 /) + kbo(:,30, 4) = (/ & + & 0.10550e-04_r8,0.11605e-04_r8,0.12579e-04_r8,0.13451e-04_r8,0.14210e-04_r8 /) + kbo(:,31, 4) = (/ & + & 0.87512e-05_r8,0.96322e-05_r8,0.10433e-04_r8,0.11133e-04_r8,0.11762e-04_r8 /) + kbo(:,32, 4) = (/ & + & 0.73001e-05_r8,0.80203e-05_r8,0.86745e-05_r8,0.92292e-05_r8,0.97295e-05_r8 /) + kbo(:,33, 4) = (/ & + & 0.60958e-05_r8,0.66862e-05_r8,0.72006e-05_r8,0.76359e-05_r8,0.80576e-05_r8 /) + kbo(:,34, 4) = (/ & + & 0.50855e-05_r8,0.55671e-05_r8,0.59670e-05_r8,0.63392e-05_r8,0.66869e-05_r8 /) + kbo(:,35, 4) = (/ & + & 0.42033e-05_r8,0.45905e-05_r8,0.49250e-05_r8,0.52384e-05_r8,0.55369e-05_r8 /) + kbo(:,36, 4) = (/ & + & 0.34384e-05_r8,0.37618e-05_r8,0.40430e-05_r8,0.43060e-05_r8,0.45577e-05_r8 /) + kbo(:,37, 4) = (/ & + & 0.28039e-05_r8,0.30749e-05_r8,0.33135e-05_r8,0.35344e-05_r8,0.37458e-05_r8 /) + kbo(:,38, 4) = (/ & + & 0.22842e-05_r8,0.25104e-05_r8,0.27126e-05_r8,0.28966e-05_r8,0.30768e-05_r8 /) + kbo(:,39, 4) = (/ & + & 0.18585e-05_r8,0.20510e-05_r8,0.22194e-05_r8,0.23731e-05_r8,0.25249e-05_r8 /) + kbo(:,40, 4) = (/ & + & 0.15041e-05_r8,0.16676e-05_r8,0.18097e-05_r8,0.19402e-05_r8,0.20681e-05_r8 /) + kbo(:,41, 4) = (/ & + & 0.12154e-05_r8,0.13541e-05_r8,0.14749e-05_r8,0.15852e-05_r8,0.16934e-05_r8 /) + kbo(:,42, 4) = (/ & + & 0.98033e-06_r8,0.10975e-05_r8,0.12011e-05_r8,0.12945e-05_r8,0.13859e-05_r8 /) + kbo(:,43, 4) = (/ & + & 0.78724e-06_r8,0.88625e-06_r8,0.97486e-06_r8,0.10554e-05_r8,0.11307e-05_r8 /) + kbo(:,44, 4) = (/ & + & 0.63059e-06_r8,0.71382e-06_r8,0.78948e-06_r8,0.85755e-06_r8,0.92044e-06_r8 /) + kbo(:,45, 4) = (/ & + & 0.50426e-06_r8,0.57391e-06_r8,0.63808e-06_r8,0.69718e-06_r8,0.74972e-06_r8 /) + kbo(:,46, 4) = (/ & + & 0.40133e-06_r8,0.45858e-06_r8,0.51414e-06_r8,0.56400e-06_r8,0.60964e-06_r8 /) + kbo(:,47, 4) = (/ & + & 0.31580e-06_r8,0.36440e-06_r8,0.41120e-06_r8,0.45433e-06_r8,0.49348e-06_r8 /) + kbo(:,48, 4) = (/ & + & 0.24847e-06_r8,0.28907e-06_r8,0.32879e-06_r8,0.36537e-06_r8,0.39903e-06_r8 /) + kbo(:,49, 4) = (/ & + & 0.19530e-06_r8,0.22858e-06_r8,0.26247e-06_r8,0.29331e-06_r8,0.32217e-06_r8 /) + kbo(:,50, 4) = (/ & + & 0.15364e-06_r8,0.18113e-06_r8,0.20911e-06_r8,0.23589e-06_r8,0.25994e-06_r8 /) + kbo(:,51, 4) = (/ & + & 0.12072e-06_r8,0.14413e-06_r8,0.16656e-06_r8,0.18952e-06_r8,0.20983e-06_r8 /) + kbo(:,52, 4) = (/ & + & 0.94925e-07_r8,0.11397e-06_r8,0.13255e-06_r8,0.15193e-06_r8,0.16960e-06_r8 /) + kbo(:,53, 4) = (/ & + & 0.74473e-07_r8,0.90197e-07_r8,0.10574e-06_r8,0.12153e-06_r8,0.13661e-06_r8 /) + kbo(:,54, 4) = (/ & + & 0.59009e-07_r8,0.71594e-07_r8,0.84781e-07_r8,0.97758e-07_r8,0.11018e-06_r8 /) + kbo(:,55, 4) = (/ & + & 0.47008e-07_r8,0.56997e-07_r8,0.67838e-07_r8,0.78753e-07_r8,0.89116e-07_r8 /) + kbo(:,56, 4) = (/ & + & 0.37415e-07_r8,0.45642e-07_r8,0.54420e-07_r8,0.63466e-07_r8,0.71910e-07_r8 /) + kbo(:,57, 4) = (/ & + & 0.29896e-07_r8,0.36635e-07_r8,0.43697e-07_r8,0.51036e-07_r8,0.58267e-07_r8 /) + kbo(:,58, 4) = (/ & + & 0.23946e-07_r8,0.29523e-07_r8,0.35316e-07_r8,0.41183e-07_r8,0.47391e-07_r8 /) + kbo(:,59, 4) = (/ & + & 0.19881e-07_r8,0.24642e-07_r8,0.29390e-07_r8,0.34099e-07_r8,0.39234e-07_r8 /) + kbo(:,13, 5) = (/ & + & 0.12771e-02_r8,0.13202e-02_r8,0.13557e-02_r8,0.13927e-02_r8,0.14233e-02_r8 /) + kbo(:,14, 5) = (/ & + & 0.10608e-02_r8,0.10951e-02_r8,0.11249e-02_r8,0.11549e-02_r8,0.11788e-02_r8 /) + kbo(:,15, 5) = (/ & + & 0.86750e-03_r8,0.89679e-03_r8,0.91986e-03_r8,0.94399e-03_r8,0.96405e-03_r8 /) + kbo(:,16, 5) = (/ & + & 0.70073e-03_r8,0.72504e-03_r8,0.74630e-03_r8,0.76495e-03_r8,0.78165e-03_r8 /) + kbo(:,17, 5) = (/ & + & 0.56280e-03_r8,0.58321e-03_r8,0.60153e-03_r8,0.61544e-03_r8,0.62885e-03_r8 /) + kbo(:,18, 5) = (/ & + & 0.44940e-03_r8,0.46598e-03_r8,0.47887e-03_r8,0.49058e-03_r8,0.50223e-03_r8 /) + kbo(:,19, 5) = (/ & + & 0.35753e-03_r8,0.37064e-03_r8,0.38290e-03_r8,0.39390e-03_r8,0.40387e-03_r8 /) + kbo(:,20, 5) = (/ & + & 0.29013e-03_r8,0.30099e-03_r8,0.31179e-03_r8,0.32117e-03_r8,0.33011e-03_r8 /) + kbo(:,21, 5) = (/ & + & 0.23657e-03_r8,0.24602e-03_r8,0.25504e-03_r8,0.26340e-03_r8,0.27145e-03_r8 /) + kbo(:,22, 5) = (/ & + & 0.19423e-03_r8,0.20224e-03_r8,0.20987e-03_r8,0.21711e-03_r8,0.22439e-03_r8 /) + kbo(:,23, 5) = (/ & + & 0.15963e-03_r8,0.16643e-03_r8,0.17308e-03_r8,0.17949e-03_r8,0.18580e-03_r8 /) + kbo(:,24, 5) = (/ & + & 0.13166e-03_r8,0.13745e-03_r8,0.14332e-03_r8,0.14871e-03_r8,0.15428e-03_r8 /) + kbo(:,25, 5) = (/ & + & 0.10885e-03_r8,0.11394e-03_r8,0.11896e-03_r8,0.12371e-03_r8,0.12846e-03_r8 /) + kbo(:,26, 5) = (/ & + & 0.90403e-04_r8,0.94914e-04_r8,0.99157e-04_r8,0.10310e-03_r8,0.10729e-03_r8 /) + kbo(:,27, 5) = (/ & + & 0.75265e-04_r8,0.79166e-04_r8,0.82648e-04_r8,0.86209e-04_r8,0.89882e-04_r8 /) + kbo(:,28, 5) = (/ & + & 0.62870e-04_r8,0.66050e-04_r8,0.69111e-04_r8,0.72289e-04_r8,0.75451e-04_r8 /) + kbo(:,29, 5) = (/ & + & 0.52465e-04_r8,0.55192e-04_r8,0.57887e-04_r8,0.60660e-04_r8,0.63367e-04_r8 /) + kbo(:,30, 5) = (/ & + & 0.43887e-04_r8,0.46191e-04_r8,0.48588e-04_r8,0.50910e-04_r8,0.53278e-04_r8 /) + kbo(:,31, 5) = (/ & + & 0.36760e-04_r8,0.38766e-04_r8,0.40783e-04_r8,0.42783e-04_r8,0.44780e-04_r8 /) + kbo(:,32, 5) = (/ & + & 0.30831e-04_r8,0.32561e-04_r8,0.34267e-04_r8,0.36000e-04_r8,0.37594e-04_r8 /) + kbo(:,33, 5) = (/ & + & 0.25908e-04_r8,0.27389e-04_r8,0.28832e-04_r8,0.30290e-04_r8,0.31581e-04_r8 /) + kbo(:,34, 5) = (/ & + & 0.21776e-04_r8,0.23026e-04_r8,0.24266e-04_r8,0.25444e-04_r8,0.26510e-04_r8 /) + kbo(:,35, 5) = (/ & + & 0.18233e-04_r8,0.19280e-04_r8,0.20324e-04_r8,0.21266e-04_r8,0.22141e-04_r8 /) + kbo(:,36, 5) = (/ & + & 0.15160e-04_r8,0.16042e-04_r8,0.16918e-04_r8,0.17686e-04_r8,0.18406e-04_r8 /) + kbo(:,37, 5) = (/ & + & 0.12538e-04_r8,0.13285e-04_r8,0.14015e-04_r8,0.14657e-04_r8,0.15269e-04_r8 /) + kbo(:,38, 5) = (/ & + & 0.10357e-04_r8,0.10990e-04_r8,0.11595e-04_r8,0.12148e-04_r8,0.12651e-04_r8 /) + kbo(:,39, 5) = (/ & + & 0.85566e-05_r8,0.90856e-05_r8,0.95986e-05_r8,0.10057e-04_r8,0.10478e-04_r8 /) + kbo(:,40, 5) = (/ & + & 0.70390e-05_r8,0.74826e-05_r8,0.79200e-05_r8,0.83061e-05_r8,0.86634e-05_r8 /) + kbo(:,41, 5) = (/ & + & 0.57827e-05_r8,0.61572e-05_r8,0.65269e-05_r8,0.68528e-05_r8,0.71595e-05_r8 /) + kbo(:,42, 5) = (/ & + & 0.47477e-05_r8,0.50656e-05_r8,0.53705e-05_r8,0.56486e-05_r8,0.59100e-05_r8 /) + kbo(:,43, 5) = (/ & + & 0.38802e-05_r8,0.41533e-05_r8,0.44089e-05_r8,0.46515e-05_r8,0.48719e-05_r8 /) + kbo(:,44, 5) = (/ & + & 0.31658e-05_r8,0.33971e-05_r8,0.36177e-05_r8,0.38205e-05_r8,0.40089e-05_r8 /) + kbo(:,45, 5) = (/ & + & 0.25796e-05_r8,0.27740e-05_r8,0.29635e-05_r8,0.31336e-05_r8,0.32986e-05_r8 /) + kbo(:,46, 5) = (/ & + & 0.20945e-05_r8,0.22636e-05_r8,0.24214e-05_r8,0.25698e-05_r8,0.27077e-05_r8 /) + kbo(:,47, 5) = (/ & + & 0.16931e-05_r8,0.18383e-05_r8,0.19729e-05_r8,0.20996e-05_r8,0.22172e-05_r8 /) + kbo(:,48, 5) = (/ & + & 0.13650e-05_r8,0.14889e-05_r8,0.16043e-05_r8,0.17139e-05_r8,0.18136e-05_r8 /) + kbo(:,49, 5) = (/ & + & 0.10981e-05_r8,0.12042e-05_r8,0.13028e-05_r8,0.13963e-05_r8,0.14824e-05_r8 /) + kbo(:,50, 5) = (/ & + & 0.88407e-06_r8,0.97370e-06_r8,0.10589e-05_r8,0.11383e-05_r8,0.12124e-05_r8 /) + kbo(:,51, 5) = (/ & + & 0.71150e-06_r8,0.78682e-06_r8,0.86048e-06_r8,0.92711e-06_r8,0.99128e-06_r8 /) + kbo(:,52, 5) = (/ & + & 0.57140e-06_r8,0.63513e-06_r8,0.69790e-06_r8,0.75466e-06_r8,0.80946e-06_r8 /) + kbo(:,53, 5) = (/ & + & 0.45871e-06_r8,0.51183e-06_r8,0.56494e-06_r8,0.61376e-06_r8,0.66022e-06_r8 /) + kbo(:,54, 5) = (/ & + & 0.36889e-06_r8,0.41319e-06_r8,0.45759e-06_r8,0.49973e-06_r8,0.53933e-06_r8 /) + kbo(:,55, 5) = (/ & + & 0.29683e-06_r8,0.33396e-06_r8,0.37110e-06_r8,0.40671e-06_r8,0.44026e-06_r8 /) + kbo(:,56, 5) = (/ & + & 0.23828e-06_r8,0.26973e-06_r8,0.30048e-06_r8,0.33099e-06_r8,0.35949e-06_r8 /) + kbo(:,57, 5) = (/ & + & 0.19083e-06_r8,0.21782e-06_r8,0.24350e-06_r8,0.26883e-06_r8,0.29309e-06_r8 /) + kbo(:,58, 5) = (/ & + & 0.15334e-06_r8,0.17592e-06_r8,0.19753e-06_r8,0.21869e-06_r8,0.23903e-06_r8 /) + kbo(:,59, 5) = (/ & + & 0.12635e-06_r8,0.14504e-06_r8,0.16321e-06_r8,0.18074e-06_r8,0.19759e-06_r8 /) + kbo(:,13, 6) = (/ & + & 0.33433e-02_r8,0.34159e-02_r8,0.34798e-02_r8,0.35397e-02_r8,0.35995e-02_r8 /) + kbo(:,14, 6) = (/ & + & 0.28039e-02_r8,0.28589e-02_r8,0.29090e-02_r8,0.29595e-02_r8,0.30108e-02_r8 /) + kbo(:,15, 6) = (/ & + & 0.23135e-02_r8,0.23579e-02_r8,0.24012e-02_r8,0.24470e-02_r8,0.24900e-02_r8 /) + kbo(:,16, 6) = (/ & + & 0.18925e-02_r8,0.19281e-02_r8,0.19671e-02_r8,0.20090e-02_r8,0.20445e-02_r8 /) + kbo(:,17, 6) = (/ & + & 0.15365e-02_r8,0.15703e-02_r8,0.16039e-02_r8,0.16424e-02_r8,0.16760e-02_r8 /) + kbo(:,18, 6) = (/ & + & 0.12424e-02_r8,0.12746e-02_r8,0.13067e-02_r8,0.13397e-02_r8,0.13687e-02_r8 /) + kbo(:,19, 6) = (/ & + & 0.10113e-02_r8,0.10417e-02_r8,0.10664e-02_r8,0.10958e-02_r8,0.11231e-02_r8 /) + kbo(:,20, 6) = (/ & + & 0.83375e-03_r8,0.85863e-03_r8,0.88098e-03_r8,0.90680e-03_r8,0.93093e-03_r8 /) + kbo(:,21, 6) = (/ & + & 0.68849e-03_r8,0.71056e-03_r8,0.73161e-03_r8,0.75402e-03_r8,0.77432e-03_r8 /) + kbo(:,22, 6) = (/ & + & 0.57076e-03_r8,0.59001e-03_r8,0.60925e-03_r8,0.62816e-03_r8,0.64531e-03_r8 /) + kbo(:,23, 6) = (/ & + & 0.47462e-03_r8,0.49138e-03_r8,0.50818e-03_r8,0.52421e-03_r8,0.53930e-03_r8 /) + kbo(:,24, 6) = (/ & + & 0.39552e-03_r8,0.41011e-03_r8,0.42460e-03_r8,0.43865e-03_r8,0.45206e-03_r8 /) + kbo(:,25, 6) = (/ & + & 0.33041e-03_r8,0.34317e-03_r8,0.35573e-03_r8,0.36800e-03_r8,0.38005e-03_r8 /) + kbo(:,26, 6) = (/ & + & 0.27699e-03_r8,0.28806e-03_r8,0.29892e-03_r8,0.30983e-03_r8,0.32038e-03_r8 /) + kbo(:,27, 6) = (/ & + & 0.23253e-03_r8,0.24229e-03_r8,0.25208e-03_r8,0.26144e-03_r8,0.27039e-03_r8 /) + kbo(:,28, 6) = (/ & + & 0.19573e-03_r8,0.20442e-03_r8,0.21276e-03_r8,0.22087e-03_r8,0.22869e-03_r8 /) + kbo(:,29, 6) = (/ & + & 0.16528e-03_r8,0.17271e-03_r8,0.17974e-03_r8,0.18681e-03_r8,0.19373e-03_r8 /) + kbo(:,30, 6) = (/ & + & 0.13949e-03_r8,0.14599e-03_r8,0.15214e-03_r8,0.15834e-03_r8,0.16448e-03_r8 /) + kbo(:,31, 6) = (/ & + & 0.11793e-03_r8,0.12345e-03_r8,0.12891e-03_r8,0.13432e-03_r8,0.13975e-03_r8 /) + kbo(:,32, 6) = (/ & + & 0.99845e-04_r8,0.10464e-03_r8,0.10941e-03_r8,0.11425e-03_r8,0.11896e-03_r8 /) + kbo(:,33, 6) = (/ & + & 0.84723e-04_r8,0.88808e-04_r8,0.93054e-04_r8,0.97257e-04_r8,0.10144e-03_r8 /) + kbo(:,34, 6) = (/ & + & 0.71857e-04_r8,0.75478e-04_r8,0.79245e-04_r8,0.82878e-04_r8,0.86527e-04_r8 /) + kbo(:,35, 6) = (/ & + & 0.60741e-04_r8,0.63987e-04_r8,0.67190e-04_r8,0.70445e-04_r8,0.73634e-04_r8 /) + kbo(:,36, 6) = (/ & + & 0.51094e-04_r8,0.53953e-04_r8,0.56787e-04_r8,0.59644e-04_r8,0.62421e-04_r8 /) + kbo(:,37, 6) = (/ & + & 0.42809e-04_r8,0.45324e-04_r8,0.47805e-04_r8,0.50314e-04_r8,0.52797e-04_r8 /) + kbo(:,38, 6) = (/ & + & 0.35862e-04_r8,0.38082e-04_r8,0.40249e-04_r8,0.42459e-04_r8,0.44691e-04_r8 /) + kbo(:,39, 6) = (/ & + & 0.30047e-04_r8,0.31970e-04_r8,0.33877e-04_r8,0.35841e-04_r8,0.37792e-04_r8 /) + kbo(:,40, 6) = (/ & + & 0.25051e-04_r8,0.26734e-04_r8,0.28429e-04_r8,0.30177e-04_r8,0.31859e-04_r8 /) + kbo(:,41, 6) = (/ & + & 0.20858e-04_r8,0.22337e-04_r8,0.23837e-04_r8,0.25348e-04_r8,0.26845e-04_r8 /) + kbo(:,42, 6) = (/ & + & 0.17358e-04_r8,0.18653e-04_r8,0.19947e-04_r8,0.21279e-04_r8,0.22614e-04_r8 /) + kbo(:,43, 6) = (/ & + & 0.14382e-04_r8,0.15507e-04_r8,0.16637e-04_r8,0.17808e-04_r8,0.18975e-04_r8 /) + kbo(:,44, 6) = (/ & + & 0.11875e-04_r8,0.12851e-04_r8,0.13847e-04_r8,0.14865e-04_r8,0.15886e-04_r8 /) + kbo(:,45, 6) = (/ & + & 0.97824e-05_r8,0.10641e-04_r8,0.11497e-04_r8,0.12386e-04_r8,0.13288e-04_r8 /) + kbo(:,46, 6) = (/ & + & 0.80305e-05_r8,0.87712e-05_r8,0.95170e-05_r8,0.10282e-04_r8,0.11073e-04_r8 /) + kbo(:,47, 6) = (/ & + & 0.65554e-05_r8,0.71881e-05_r8,0.78331e-05_r8,0.85022e-05_r8,0.91799e-05_r8 /) + kbo(:,48, 6) = (/ & + & 0.53399e-05_r8,0.58818e-05_r8,0.64364e-05_r8,0.70093e-05_r8,0.75992e-05_r8 /) + kbo(:,49, 6) = (/ & + & 0.43396e-05_r8,0.47990e-05_r8,0.52727e-05_r8,0.57633e-05_r8,0.62785e-05_r8 /) + kbo(:,50, 6) = (/ & + & 0.35272e-05_r8,0.39139e-05_r8,0.43230e-05_r8,0.47423e-05_r8,0.51819e-05_r8 /) + kbo(:,51, 6) = (/ & + & 0.28624e-05_r8,0.31913e-05_r8,0.35379e-05_r8,0.38979e-05_r8,0.42744e-05_r8 /) + kbo(:,52, 6) = (/ & + & 0.23189e-05_r8,0.25961e-05_r8,0.28907e-05_r8,0.31976e-05_r8,0.35200e-05_r8 /) + kbo(:,53, 6) = (/ & + & 0.18736e-05_r8,0.21072e-05_r8,0.23576e-05_r8,0.26179e-05_r8,0.28943e-05_r8 /) + kbo(:,54, 6) = (/ & + & 0.15155e-05_r8,0.17135e-05_r8,0.19245e-05_r8,0.21451e-05_r8,0.23808e-05_r8 /) + kbo(:,55, 6) = (/ & + & 0.12250e-05_r8,0.13923e-05_r8,0.15714e-05_r8,0.17578e-05_r8,0.19597e-05_r8 /) + kbo(:,56, 6) = (/ & + & 0.99012e-06_r8,0.11296e-05_r8,0.12801e-05_r8,0.14395e-05_r8,0.16107e-05_r8 /) + kbo(:,57, 6) = (/ & + & 0.79875e-06_r8,0.91418e-06_r8,0.10408e-05_r8,0.11777e-05_r8,0.13212e-05_r8 /) + kbo(:,58, 6) = (/ & + & 0.64474e-06_r8,0.74109e-06_r8,0.84664e-06_r8,0.96328e-06_r8,0.10849e-05_r8 /) + kbo(:,59, 6) = (/ & + & 0.53296e-06_r8,0.61427e-06_r8,0.70385e-06_r8,0.80375e-06_r8,0.90863e-06_r8 /) + kbo(:,13, 7) = (/ & + & 0.91063e-02_r8,0.92681e-02_r8,0.94045e-02_r8,0.95388e-02_r8,0.96735e-02_r8 /) + kbo(:,14, 7) = (/ & + & 0.78483e-02_r8,0.79806e-02_r8,0.81238e-02_r8,0.82528e-02_r8,0.83603e-02_r8 /) + kbo(:,15, 7) = (/ & + & 0.66269e-02_r8,0.67445e-02_r8,0.68845e-02_r8,0.69911e-02_r8,0.70854e-02_r8 /) + kbo(:,16, 7) = (/ & + & 0.55183e-02_r8,0.56414e-02_r8,0.57574e-02_r8,0.58487e-02_r8,0.59407e-02_r8 /) + kbo(:,17, 7) = (/ & + & 0.45693e-02_r8,0.46780e-02_r8,0.47743e-02_r8,0.48625e-02_r8,0.49467e-02_r8 /) + kbo(:,18, 7) = (/ & + & 0.37611e-02_r8,0.38535e-02_r8,0.39408e-02_r8,0.40234e-02_r8,0.41007e-02_r8 /) + kbo(:,19, 7) = (/ & + & 0.30991e-02_r8,0.31809e-02_r8,0.32647e-02_r8,0.33388e-02_r8,0.34042e-02_r8 /) + kbo(:,20, 7) = (/ & + & 0.25858e-02_r8,0.26585e-02_r8,0.27347e-02_r8,0.27990e-02_r8,0.28579e-02_r8 /) + kbo(:,21, 7) = (/ & + & 0.21672e-02_r8,0.22326e-02_r8,0.22973e-02_r8,0.23547e-02_r8,0.24058e-02_r8 /) + kbo(:,22, 7) = (/ & + & 0.18211e-02_r8,0.18809e-02_r8,0.19364e-02_r8,0.19859e-02_r8,0.20352e-02_r8 /) + kbo(:,23, 7) = (/ & + & 0.15314e-02_r8,0.15844e-02_r8,0.16332e-02_r8,0.16760e-02_r8,0.17243e-02_r8 /) + kbo(:,24, 7) = (/ & + & 0.12924e-02_r8,0.13385e-02_r8,0.13793e-02_r8,0.14209e-02_r8,0.14659e-02_r8 /) + kbo(:,25, 7) = (/ & + & 0.10926e-02_r8,0.11322e-02_r8,0.11689e-02_r8,0.12081e-02_r8,0.12493e-02_r8 /) + kbo(:,26, 7) = (/ & + & 0.92756e-03_r8,0.96136e-03_r8,0.99601e-03_r8,0.10324e-02_r8,0.10695e-02_r8 /) + kbo(:,27, 7) = (/ & + & 0.78832e-03_r8,0.81893e-03_r8,0.85137e-03_r8,0.88465e-03_r8,0.91885e-03_r8 /) + kbo(:,28, 7) = (/ & + & 0.67097e-03_r8,0.69979e-03_r8,0.72985e-03_r8,0.76038e-03_r8,0.79213e-03_r8 /) + kbo(:,29, 7) = (/ & + & 0.57231e-03_r8,0.59934e-03_r8,0.62727e-03_r8,0.65471e-03_r8,0.68389e-03_r8 /) + kbo(:,30, 7) = (/ & + & 0.48996e-03_r8,0.51441e-03_r8,0.53945e-03_r8,0.56564e-03_r8,0.59164e-03_r8 /) + kbo(:,31, 7) = (/ & + & 0.41998e-03_r8,0.44237e-03_r8,0.46551e-03_r8,0.48924e-03_r8,0.51322e-03_r8 /) + kbo(:,32, 7) = (/ & + & 0.36133e-03_r8,0.38168e-03_r8,0.40297e-03_r8,0.42441e-03_r8,0.44722e-03_r8 /) + kbo(:,33, 7) = (/ & + & 0.31153e-03_r8,0.33055e-03_r8,0.34980e-03_r8,0.36972e-03_r8,0.39086e-03_r8 /) + kbo(:,34, 7) = (/ & + & 0.26941e-03_r8,0.28657e-03_r8,0.30436e-03_r8,0.32295e-03_r8,0.34256e-03_r8 /) + kbo(:,35, 7) = (/ & + & 0.23210e-03_r8,0.24782e-03_r8,0.26411e-03_r8,0.28121e-03_r8,0.29930e-03_r8 /) + kbo(:,36, 7) = (/ & + & 0.19904e-03_r8,0.21311e-03_r8,0.22797e-03_r8,0.24380e-03_r8,0.26030e-03_r8 /) + kbo(:,37, 7) = (/ & + & 0.17000e-03_r8,0.18300e-03_r8,0.19666e-03_r8,0.21128e-03_r8,0.22641e-03_r8 /) + kbo(:,38, 7) = (/ & + & 0.14528e-03_r8,0.15704e-03_r8,0.16975e-03_r8,0.18320e-03_r8,0.19735e-03_r8 /) + kbo(:,39, 7) = (/ & + & 0.12414e-03_r8,0.13496e-03_r8,0.14654e-03_r8,0.15899e-03_r8,0.17211e-03_r8 /) + kbo(:,40, 7) = (/ & + & 0.10567e-03_r8,0.11547e-03_r8,0.12618e-03_r8,0.13765e-03_r8,0.14994e-03_r8 /) + kbo(:,41, 7) = (/ & + & 0.89774e-04_r8,0.98751e-04_r8,0.10852e-03_r8,0.11918e-03_r8,0.13057e-03_r8 /) + kbo(:,42, 7) = (/ & + & 0.76232e-04_r8,0.84383e-04_r8,0.93336e-04_r8,0.10314e-03_r8,0.11381e-03_r8 /) + kbo(:,43, 7) = (/ & + & 0.64370e-04_r8,0.71684e-04_r8,0.79797e-04_r8,0.88850e-04_r8,0.98733e-04_r8 /) + kbo(:,44, 7) = (/ & + & 0.54125e-04_r8,0.60680e-04_r8,0.68042e-04_r8,0.76313e-04_r8,0.85432e-04_r8 /) + kbo(:,45, 7) = (/ & + & 0.45374e-04_r8,0.51280e-04_r8,0.57932e-04_r8,0.65429e-04_r8,0.73852e-04_r8 /) + kbo(:,46, 7) = (/ & + & 0.37861e-04_r8,0.43078e-04_r8,0.49016e-04_r8,0.55844e-04_r8,0.63538e-04_r8 /) + kbo(:,47, 7) = (/ & + & 0.31342e-04_r8,0.35879e-04_r8,0.41175e-04_r8,0.47252e-04_r8,0.54286e-04_r8 /) + kbo(:,48, 7) = (/ & + & 0.25821e-04_r8,0.29777e-04_r8,0.34458e-04_r8,0.39880e-04_r8,0.46218e-04_r8 /) + kbo(:,49, 7) = (/ & + & 0.21180e-04_r8,0.24617e-04_r8,0.28719e-04_r8,0.33507e-04_r8,0.39184e-04_r8 /) + kbo(:,50, 7) = (/ & + & 0.17377e-04_r8,0.20345e-04_r8,0.23916e-04_r8,0.28177e-04_r8,0.33237e-04_r8 /) + kbo(:,51, 7) = (/ & + & 0.14223e-04_r8,0.16790e-04_r8,0.19868e-04_r8,0.23656e-04_r8,0.28163e-04_r8 /) + kbo(:,52, 7) = (/ & + & 0.11593e-04_r8,0.13788e-04_r8,0.16479e-04_r8,0.19773e-04_r8,0.23765e-04_r8 /) + kbo(:,53, 7) = (/ & + & 0.94141e-05_r8,0.11279e-04_r8,0.13591e-04_r8,0.16447e-04_r8,0.19969e-04_r8 /) + kbo(:,54, 7) = (/ & + & 0.76622e-05_r8,0.92417e-05_r8,0.11233e-04_r8,0.13709e-04_r8,0.16819e-04_r8 /) + kbo(:,55, 7) = (/ & + & 0.62315e-05_r8,0.75671e-05_r8,0.92699e-05_r8,0.11429e-04_r8,0.14186e-04_r8 /) + kbo(:,56, 7) = (/ & + & 0.50473e-05_r8,0.61766e-05_r8,0.76316e-05_r8,0.94979e-05_r8,0.11890e-04_r8 /) + kbo(:,57, 7) = (/ & + & 0.40773e-05_r8,0.50242e-05_r8,0.62540e-05_r8,0.78594e-05_r8,0.99378e-05_r8 /) + kbo(:,58, 7) = (/ & + & 0.32937e-05_r8,0.40862e-05_r8,0.51228e-05_r8,0.64992e-05_r8,0.83112e-05_r8 /) + kbo(:,59, 7) = (/ & + & 0.27593e-05_r8,0.34505e-05_r8,0.43716e-05_r8,0.56035e-05_r8,0.72609e-05_r8 /) + kbo(:,13, 8) = (/ & + & 0.25990e-01_r8,0.25997e-01_r8,0.26024e-01_r8,0.26038e-01_r8,0.26132e-01_r8 /) + kbo(:,14, 8) = (/ & + & 0.22648e-01_r8,0.22731e-01_r8,0.22803e-01_r8,0.22861e-01_r8,0.23020e-01_r8 /) + kbo(:,15, 8) = (/ & + & 0.19641e-01_r8,0.19812e-01_r8,0.19880e-01_r8,0.19998e-01_r8,0.20141e-01_r8 /) + kbo(:,16, 8) = (/ & + & 0.16909e-01_r8,0.17030e-01_r8,0.17148e-01_r8,0.17296e-01_r8,0.17502e-01_r8 /) + kbo(:,17, 8) = (/ & + & 0.14365e-01_r8,0.14504e-01_r8,0.14643e-01_r8,0.14808e-01_r8,0.14996e-01_r8 /) + kbo(:,18, 8) = (/ & + & 0.12072e-01_r8,0.12207e-01_r8,0.12346e-01_r8,0.12513e-01_r8,0.12742e-01_r8 /) + kbo(:,19, 8) = (/ & + & 0.10135e-01_r8,0.10263e-01_r8,0.10402e-01_r8,0.10602e-01_r8,0.10794e-01_r8 /) + kbo(:,20, 8) = (/ & + & 0.86508e-02_r8,0.87951e-02_r8,0.89765e-02_r8,0.91530e-02_r8,0.93447e-02_r8 /) + kbo(:,21, 8) = (/ & + & 0.74228e-02_r8,0.75964e-02_r8,0.77805e-02_r8,0.79441e-02_r8,0.81266e-02_r8 /) + kbo(:,22, 8) = (/ & + & 0.63949e-02_r8,0.65920e-02_r8,0.67584e-02_r8,0.69298e-02_r8,0.70968e-02_r8 /) + kbo(:,23, 8) = (/ & + & 0.55389e-02_r8,0.57165e-02_r8,0.58834e-02_r8,0.60490e-02_r8,0.62163e-02_r8 /) + kbo(:,24, 8) = (/ & + & 0.47980e-02_r8,0.49696e-02_r8,0.51333e-02_r8,0.53055e-02_r8,0.54695e-02_r8 /) + kbo(:,25, 8) = (/ & + & 0.41676e-02_r8,0.43357e-02_r8,0.44999e-02_r8,0.46749e-02_r8,0.48179e-02_r8 /) + kbo(:,26, 8) = (/ & + & 0.36391e-02_r8,0.38079e-02_r8,0.39834e-02_r8,0.41374e-02_r8,0.42754e-02_r8 /) + kbo(:,27, 8) = (/ & + & 0.31917e-02_r8,0.33580e-02_r8,0.35237e-02_r8,0.36737e-02_r8,0.37982e-02_r8 /) + kbo(:,28, 8) = (/ & + & 0.28096e-02_r8,0.29709e-02_r8,0.31242e-02_r8,0.32613e-02_r8,0.33829e-02_r8 /) + kbo(:,29, 8) = (/ & + & 0.24786e-02_r8,0.26272e-02_r8,0.27706e-02_r8,0.28986e-02_r8,0.30130e-02_r8 /) + kbo(:,30, 8) = (/ & + & 0.21907e-02_r8,0.23282e-02_r8,0.24574e-02_r8,0.25778e-02_r8,0.26806e-02_r8 /) + kbo(:,31, 8) = (/ & + & 0.19346e-02_r8,0.20569e-02_r8,0.21757e-02_r8,0.22805e-02_r8,0.23742e-02_r8 /) + kbo(:,32, 8) = (/ & + & 0.17101e-02_r8,0.18247e-02_r8,0.19308e-02_r8,0.20256e-02_r8,0.21176e-02_r8 /) + kbo(:,33, 8) = (/ & + & 0.15171e-02_r8,0.16168e-02_r8,0.17121e-02_r8,0.18035e-02_r8,0.18911e-02_r8 /) + kbo(:,34, 8) = (/ & + & 0.13466e-02_r8,0.14390e-02_r8,0.15246e-02_r8,0.16083e-02_r8,0.16921e-02_r8 /) + kbo(:,35, 8) = (/ & + & 0.11871e-02_r8,0.12698e-02_r8,0.13534e-02_r8,0.14320e-02_r8,0.15071e-02_r8 /) + kbo(:,36, 8) = (/ & + & 0.10388e-02_r8,0.11179e-02_r8,0.11934e-02_r8,0.12647e-02_r8,0.13391e-02_r8 /) + kbo(:,37, 8) = (/ & + & 0.92233e-03_r8,0.99854e-03_r8,0.10722e-02_r8,0.11426e-02_r8,0.12118e-02_r8 /) + kbo(:,38, 8) = (/ & + & 0.81843e-03_r8,0.89236e-03_r8,0.96605e-03_r8,0.10340e-02_r8,0.11003e-02_r8 /) + kbo(:,39, 8) = (/ & + & 0.72738e-03_r8,0.79777e-03_r8,0.86997e-03_r8,0.93496e-03_r8,0.99852e-03_r8 /) + kbo(:,40, 8) = (/ & + & 0.65149e-03_r8,0.72098e-03_r8,0.79235e-03_r8,0.86116e-03_r8,0.92474e-03_r8 /) + kbo(:,41, 8) = (/ & + & 0.58318e-03_r8,0.65154e-03_r8,0.72160e-03_r8,0.79400e-03_r8,0.85973e-03_r8 /) + kbo(:,42, 8) = (/ & + & 0.52127e-03_r8,0.58770e-03_r8,0.65781e-03_r8,0.73110e-03_r8,0.80165e-03_r8 /) + kbo(:,43, 8) = (/ & + & 0.46404e-03_r8,0.52960e-03_r8,0.59886e-03_r8,0.67366e-03_r8,0.74727e-03_r8 /) + kbo(:,44, 8) = (/ & + & 0.41229e-03_r8,0.47609e-03_r8,0.54424e-03_r8,0.61918e-03_r8,0.69366e-03_r8 /) + kbo(:,45, 8) = (/ & + & 0.36534e-03_r8,0.42624e-03_r8,0.49374e-03_r8,0.56668e-03_r8,0.64364e-03_r8 /) + kbo(:,46, 8) = (/ & + & 0.32134e-03_r8,0.37987e-03_r8,0.44597e-03_r8,0.51669e-03_r8,0.59469e-03_r8 /) + kbo(:,47, 8) = (/ & + & 0.27855e-03_r8,0.33531e-03_r8,0.39855e-03_r8,0.46832e-03_r8,0.54562e-03_r8 /) + kbo(:,48, 8) = (/ & + & 0.24094e-03_r8,0.29440e-03_r8,0.35477e-03_r8,0.42284e-03_r8,0.49767e-03_r8 /) + kbo(:,49, 8) = (/ & + & 0.20710e-03_r8,0.25712e-03_r8,0.31425e-03_r8,0.38098e-03_r8,0.45465e-03_r8 /) + kbo(:,50, 8) = (/ & + & 0.17757e-03_r8,0.22422e-03_r8,0.27906e-03_r8,0.34231e-03_r8,0.41419e-03_r8 /) + kbo(:,51, 8) = (/ & + & 0.15198e-03_r8,0.19538e-03_r8,0.24758e-03_r8,0.30796e-03_r8,0.37765e-03_r8 /) + kbo(:,52, 8) = (/ & + & 0.12943e-03_r8,0.16907e-03_r8,0.21812e-03_r8,0.27585e-03_r8,0.34284e-03_r8 /) + kbo(:,53, 8) = (/ & + & 0.10946e-03_r8,0.14560e-03_r8,0.19103e-03_r8,0.24633e-03_r8,0.31049e-03_r8 /) + kbo(:,54, 8) = (/ & + & 0.92950e-04_r8,0.12599e-03_r8,0.16848e-03_r8,0.22109e-03_r8,0.28266e-03_r8 /) + kbo(:,55, 8) = (/ & + & 0.78722e-04_r8,0.10883e-03_r8,0.14831e-03_r8,0.19790e-03_r8,0.25770e-03_r8 /) + kbo(:,56, 8) = (/ & + & 0.66323e-04_r8,0.93651e-04_r8,0.12983e-03_r8,0.17638e-03_r8,0.23393e-03_r8 /) + kbo(:,57, 8) = (/ & + & 0.55644e-04_r8,0.80085e-04_r8,0.11349e-03_r8,0.15741e-03_r8,0.21274e-03_r8 /) + kbo(:,58, 8) = (/ & + & 0.46537e-04_r8,0.68442e-04_r8,0.99190e-04_r8,0.14045e-03_r8,0.19327e-03_r8 /) + kbo(:,59, 8) = (/ & + & 0.41558e-04_r8,0.62503e-04_r8,0.92377e-04_r8,0.13258e-03_r8,0.18528e-03_r8 /) + kbo(:,13, 9) = (/ & + & 0.14836e+00_r8,0.15039e+00_r8,0.15239e+00_r8,0.15389e+00_r8,0.15517e+00_r8 /) + kbo(:,14, 9) = (/ & + & 0.12935e+00_r8,0.13183e+00_r8,0.13366e+00_r8,0.13551e+00_r8,0.13674e+00_r8 /) + kbo(:,15, 9) = (/ & + & 0.11269e+00_r8,0.11456e+00_r8,0.11672e+00_r8,0.11824e+00_r8,0.11951e+00_r8 /) + kbo(:,16, 9) = (/ & + & 0.97577e-01_r8,0.99647e-01_r8,0.10140e+00_r8,0.10272e+00_r8,0.10390e+00_r8 /) + kbo(:,17, 9) = (/ & + & 0.84601e-01_r8,0.86370e-01_r8,0.87860e-01_r8,0.89144e-01_r8,0.90341e-01_r8 /) + kbo(:,18, 9) = (/ & + & 0.72851e-01_r8,0.74498e-01_r8,0.75924e-01_r8,0.77220e-01_r8,0.78434e-01_r8 /) + kbo(:,19, 9) = (/ & + & 0.62688e-01_r8,0.64121e-01_r8,0.65574e-01_r8,0.66965e-01_r8,0.68243e-01_r8 /) + kbo(:,20, 9) = (/ & + & 0.54382e-01_r8,0.55704e-01_r8,0.57013e-01_r8,0.58303e-01_r8,0.59763e-01_r8 /) + kbo(:,21, 9) = (/ & + & 0.47190e-01_r8,0.48469e-01_r8,0.49752e-01_r8,0.51138e-01_r8,0.52452e-01_r8 /) + kbo(:,22, 9) = (/ & + & 0.41104e-01_r8,0.42378e-01_r8,0.43684e-01_r8,0.45035e-01_r8,0.46495e-01_r8 /) + kbo(:,23, 9) = (/ & + & 0.35910e-01_r8,0.37220e-01_r8,0.38484e-01_r8,0.39789e-01_r8,0.41443e-01_r8 /) + kbo(:,24, 9) = (/ & + & 0.31558e-01_r8,0.32836e-01_r8,0.34085e-01_r8,0.35462e-01_r8,0.37160e-01_r8 /) + kbo(:,25, 9) = (/ & + & 0.27861e-01_r8,0.29090e-01_r8,0.30363e-01_r8,0.31857e-01_r8,0.33566e-01_r8 /) + kbo(:,26, 9) = (/ & + & 0.24743e-01_r8,0.26003e-01_r8,0.27311e-01_r8,0.28788e-01_r8,0.30553e-01_r8 /) + kbo(:,27, 9) = (/ & + & 0.22141e-01_r8,0.23397e-01_r8,0.24754e-01_r8,0.26282e-01_r8,0.28040e-01_r8 /) + kbo(:,28, 9) = (/ & + & 0.19941e-01_r8,0.21165e-01_r8,0.22565e-01_r8,0.24131e-01_r8,0.25980e-01_r8 /) + kbo(:,29, 9) = (/ & + & 0.18046e-01_r8,0.19353e-01_r8,0.20736e-01_r8,0.22375e-01_r8,0.24248e-01_r8 /) + kbo(:,30, 9) = (/ & + & 0.16429e-01_r8,0.17775e-01_r8,0.19238e-01_r8,0.20907e-01_r8,0.22847e-01_r8 /) + kbo(:,31, 9) = (/ & + & 0.15094e-01_r8,0.16450e-01_r8,0.17992e-01_r8,0.19741e-01_r8,0.21608e-01_r8 /) + kbo(:,32, 9) = (/ & + & 0.13975e-01_r8,0.15315e-01_r8,0.16950e-01_r8,0.18741e-01_r8,0.20564e-01_r8 /) + kbo(:,33, 9) = (/ & + & 0.13026e-01_r8,0.14475e-01_r8,0.16113e-01_r8,0.17903e-01_r8,0.19794e-01_r8 /) + kbo(:,34, 9) = (/ & + & 0.12248e-01_r8,0.13747e-01_r8,0.15391e-01_r8,0.17142e-01_r8,0.19155e-01_r8 /) + kbo(:,35, 9) = (/ & + & 0.11491e-01_r8,0.12979e-01_r8,0.14611e-01_r8,0.16423e-01_r8,0.18475e-01_r8 /) + kbo(:,36, 9) = (/ & + & 0.10695e-01_r8,0.12142e-01_r8,0.13822e-01_r8,0.15678e-01_r8,0.17729e-01_r8 /) + kbo(:,37, 9) = (/ & + & 0.98761e-02_r8,0.11300e-01_r8,0.13000e-01_r8,0.14808e-01_r8,0.16848e-01_r8 /) + kbo(:,38, 9) = (/ & + & 0.91358e-02_r8,0.10538e-01_r8,0.12200e-01_r8,0.13999e-01_r8,0.16082e-01_r8 /) + kbo(:,39, 9) = (/ & + & 0.84558e-02_r8,0.98580e-02_r8,0.11508e-01_r8,0.13321e-01_r8,0.15372e-01_r8 /) + kbo(:,40, 9) = (/ & + & 0.78020e-02_r8,0.91740e-02_r8,0.10778e-01_r8,0.12588e-01_r8,0.14594e-01_r8 /) + kbo(:,41, 9) = (/ & + & 0.72028e-02_r8,0.85294e-02_r8,0.10093e-01_r8,0.11887e-01_r8,0.13872e-01_r8 /) + kbo(:,42, 9) = (/ & + & 0.66335e-02_r8,0.79299e-02_r8,0.94524e-02_r8,0.11233e-01_r8,0.13162e-01_r8 /) + kbo(:,43, 9) = (/ & + & 0.60936e-02_r8,0.73819e-02_r8,0.88361e-02_r8,0.10555e-01_r8,0.12456e-01_r8 /) + kbo(:,44, 9) = (/ & + & 0.55851e-02_r8,0.68018e-02_r8,0.82487e-02_r8,0.98836e-02_r8,0.11744e-01_r8 /) + kbo(:,45, 9) = (/ & + & 0.51361e-02_r8,0.62783e-02_r8,0.76910e-02_r8,0.92631e-02_r8,0.11096e-01_r8 /) + kbo(:,46, 9) = (/ & + & 0.46789e-02_r8,0.57877e-02_r8,0.71257e-02_r8,0.86688e-02_r8,0.10399e-01_r8 /) + kbo(:,47, 9) = (/ & + & 0.42434e-02_r8,0.53043e-02_r8,0.65448e-02_r8,0.80300e-02_r8,0.97286e-02_r8 /) + kbo(:,48, 9) = (/ & + & 0.38917e-02_r8,0.48269e-02_r8,0.60283e-02_r8,0.74378e-02_r8,0.90783e-02_r8 /) + kbo(:,49, 9) = (/ & + & 0.35823e-02_r8,0.43988e-02_r8,0.55409e-02_r8,0.68845e-02_r8,0.84495e-02_r8 /) + kbo(:,50, 9) = (/ & + & 0.33116e-02_r8,0.40852e-02_r8,0.51044e-02_r8,0.63885e-02_r8,0.78773e-02_r8 /) + kbo(:,51, 9) = (/ & + & 0.30752e-02_r8,0.38103e-02_r8,0.47346e-02_r8,0.59580e-02_r8,0.73779e-02_r8 /) + kbo(:,52, 9) = (/ & + & 0.28626e-02_r8,0.35553e-02_r8,0.44430e-02_r8,0.55409e-02_r8,0.69343e-02_r8 /) + kbo(:,53, 9) = (/ & + & 0.26485e-02_r8,0.33392e-02_r8,0.41695e-02_r8,0.51739e-02_r8,0.64753e-02_r8 /) + kbo(:,54, 9) = (/ & + & 0.24736e-02_r8,0.31489e-02_r8,0.39367e-02_r8,0.48954e-02_r8,0.61401e-02_r8 /) + kbo(:,55, 9) = (/ & + & 0.23362e-02_r8,0.29819e-02_r8,0.37593e-02_r8,0.46985e-02_r8,0.58363e-02_r8 /) + kbo(:,56, 9) = (/ & + & 0.22243e-02_r8,0.28447e-02_r8,0.35827e-02_r8,0.44762e-02_r8,0.55720e-02_r8 /) + kbo(:,57, 9) = (/ & + & 0.21389e-02_r8,0.27081e-02_r8,0.34315e-02_r8,0.43182e-02_r8,0.53898e-02_r8 /) + kbo(:,58, 9) = (/ & + & 0.20428e-02_r8,0.25997e-02_r8,0.33047e-02_r8,0.41726e-02_r8,0.52071e-02_r8 /) + kbo(:,59, 9) = (/ & + & 0.20538e-02_r8,0.26323e-02_r8,0.33247e-02_r8,0.41770e-02_r8,0.52496e-02_r8 /) + kbo(:,13,10) = (/ & + & 0.58637e+00_r8,0.59481e+00_r8,0.59811e+00_r8,0.60451e+00_r8,0.60418e+00_r8 /) + kbo(:,14,10) = (/ & + & 0.53191e+00_r8,0.53363e+00_r8,0.53861e+00_r8,0.53976e+00_r8,0.53933e+00_r8 /) + kbo(:,15,10) = (/ & + & 0.47845e+00_r8,0.48447e+00_r8,0.48498e+00_r8,0.48691e+00_r8,0.48935e+00_r8 /) + kbo(:,16,10) = (/ & + & 0.42695e+00_r8,0.43265e+00_r8,0.43442e+00_r8,0.43949e+00_r8,0.44244e+00_r8 /) + kbo(:,17,10) = (/ & + & 0.37796e+00_r8,0.38437e+00_r8,0.38958e+00_r8,0.39367e+00_r8,0.39802e+00_r8 /) + kbo(:,18,10) = (/ & + & 0.33399e+00_r8,0.33971e+00_r8,0.34517e+00_r8,0.35032e+00_r8,0.35265e+00_r8 /) + kbo(:,19,10) = (/ & + & 0.29538e+00_r8,0.30247e+00_r8,0.30713e+00_r8,0.30943e+00_r8,0.31544e+00_r8 /) + kbo(:,20,10) = (/ & + & 0.26154e+00_r8,0.26955e+00_r8,0.27264e+00_r8,0.27778e+00_r8,0.28167e+00_r8 /) + kbo(:,21,10) = (/ & + & 0.23200e+00_r8,0.23896e+00_r8,0.24468e+00_r8,0.24838e+00_r8,0.25453e+00_r8 /) + kbo(:,22,10) = (/ & + & 0.20714e+00_r8,0.21368e+00_r8,0.21959e+00_r8,0.22402e+00_r8,0.22934e+00_r8 /) + kbo(:,23,10) = (/ & + & 0.18514e+00_r8,0.19070e+00_r8,0.19771e+00_r8,0.20426e+00_r8,0.20794e+00_r8 /) + kbo(:,24,10) = (/ & + & 0.16629e+00_r8,0.17247e+00_r8,0.17943e+00_r8,0.18543e+00_r8,0.19044e+00_r8 /) + kbo(:,25,10) = (/ & + & 0.15103e+00_r8,0.15758e+00_r8,0.16440e+00_r8,0.16947e+00_r8,0.17504e+00_r8 /) + kbo(:,26,10) = (/ & + & 0.13782e+00_r8,0.14448e+00_r8,0.15050e+00_r8,0.15723e+00_r8,0.16403e+00_r8 /) + kbo(:,27,10) = (/ & + & 0.12675e+00_r8,0.13284e+00_r8,0.13902e+00_r8,0.14547e+00_r8,0.15299e+00_r8 /) + kbo(:,28,10) = (/ & + & 0.11700e+00_r8,0.12400e+00_r8,0.13029e+00_r8,0.13779e+00_r8,0.14535e+00_r8 /) + kbo(:,29,10) = (/ & + & 0.10975e+00_r8,0.11580e+00_r8,0.12300e+00_r8,0.13106e+00_r8,0.13981e+00_r8 /) + kbo(:,30,10) = (/ & + & 0.10326e+00_r8,0.10877e+00_r8,0.11694e+00_r8,0.12523e+00_r8,0.13409e+00_r8 /) + kbo(:,31,10) = (/ & + & 0.97072e-01_r8,0.10392e+00_r8,0.11191e+00_r8,0.12092e+00_r8,0.13156e+00_r8 /) + kbo(:,32,10) = (/ & + & 0.92483e-01_r8,0.10003e+00_r8,0.10847e+00_r8,0.11777e+00_r8,0.12978e+00_r8 /) + kbo(:,33,10) = (/ & + & 0.89436e-01_r8,0.96549e-01_r8,0.10550e+00_r8,0.11582e+00_r8,0.12938e+00_r8 /) + kbo(:,34,10) = (/ & + & 0.86605e-01_r8,0.93852e-01_r8,0.10437e+00_r8,0.11565e+00_r8,0.13025e+00_r8 /) + kbo(:,35,10) = (/ & + & 0.83755e-01_r8,0.92443e-01_r8,0.10318e+00_r8,0.11569e+00_r8,0.13035e+00_r8 /) + kbo(:,36,10) = (/ & + & 0.80159e-01_r8,0.90106e-01_r8,0.10185e+00_r8,0.11331e+00_r8,0.13105e+00_r8 /) + kbo(:,37,10) = (/ & + & 0.76863e-01_r8,0.86981e-01_r8,0.98816e-01_r8,0.11094e+00_r8,0.12837e+00_r8 /) + kbo(:,38,10) = (/ & + & 0.73911e-01_r8,0.84640e-01_r8,0.95988e-01_r8,0.10951e+00_r8,0.12524e+00_r8 /) + kbo(:,39,10) = (/ & + & 0.71484e-01_r8,0.82465e-01_r8,0.93807e-01_r8,0.10732e+00_r8,0.12288e+00_r8 /) + kbo(:,40,10) = (/ & + & 0.68367e-01_r8,0.78553e-01_r8,0.90288e-01_r8,0.10290e+00_r8,0.11884e+00_r8 /) + kbo(:,41,10) = (/ & + & 0.65972e-01_r8,0.75367e-01_r8,0.87331e-01_r8,0.98979e-01_r8,0.11479e+00_r8 /) + kbo(:,42,10) = (/ & + & 0.63899e-01_r8,0.72995e-01_r8,0.84392e-01_r8,0.96170e-01_r8,0.11066e+00_r8 /) + kbo(:,43,10) = (/ & + & 0.61601e-01_r8,0.69361e-01_r8,0.80265e-01_r8,0.92296e-01_r8,0.10575e+00_r8 /) + kbo(:,44,10) = (/ & + & 0.58053e-01_r8,0.67236e-01_r8,0.77057e-01_r8,0.88848e-01_r8,0.10118e+00_r8 /) + kbo(:,45,10) = (/ & + & 0.55041e-01_r8,0.64788e-01_r8,0.73479e-01_r8,0.85189e-01_r8,0.97294e-01_r8 /) + kbo(:,46,10) = (/ & + & 0.51538e-01_r8,0.61359e-01_r8,0.70493e-01_r8,0.81342e-01_r8,0.93711e-01_r8 /) + kbo(:,47,10) = (/ & + & 0.48229e-01_r8,0.57754e-01_r8,0.67703e-01_r8,0.77712e-01_r8,0.88779e-01_r8 /) + kbo(:,48,10) = (/ & + & 0.44328e-01_r8,0.53953e-01_r8,0.64327e-01_r8,0.74186e-01_r8,0.85354e-01_r8 /) + kbo(:,49,10) = (/ & + & 0.40181e-01_r8,0.50939e-01_r8,0.60544e-01_r8,0.71079e-01_r8,0.81883e-01_r8 /) + kbo(:,50,10) = (/ & + & 0.36327e-01_r8,0.47243e-01_r8,0.57625e-01_r8,0.67925e-01_r8,0.78806e-01_r8 /) + kbo(:,51,10) = (/ & + & 0.33026e-01_r8,0.43278e-01_r8,0.54464e-01_r8,0.64411e-01_r8,0.75916e-01_r8 /) + kbo(:,52,10) = (/ & + & 0.29600e-01_r8,0.39888e-01_r8,0.50913e-01_r8,0.61457e-01_r8,0.72719e-01_r8 /) + kbo(:,53,10) = (/ & + & 0.26994e-01_r8,0.36264e-01_r8,0.46926e-01_r8,0.58631e-01_r8,0.68972e-01_r8 /) + kbo(:,54,10) = (/ & + & 0.24928e-01_r8,0.33245e-01_r8,0.43870e-01_r8,0.55481e-01_r8,0.66121e-01_r8 /) + kbo(:,55,10) = (/ & + & 0.23329e-01_r8,0.30647e-01_r8,0.40729e-01_r8,0.52051e-01_r8,0.63960e-01_r8 /) + kbo(:,56,10) = (/ & + & 0.21581e-01_r8,0.28578e-01_r8,0.37651e-01_r8,0.48828e-01_r8,0.60673e-01_r8 /) + kbo(:,57,10) = (/ & + & 0.20121e-01_r8,0.27060e-01_r8,0.35152e-01_r8,0.45854e-01_r8,0.57152e-01_r8 /) + kbo(:,58,10) = (/ & + & 0.18692e-01_r8,0.25639e-01_r8,0.32995e-01_r8,0.42657e-01_r8,0.54655e-01_r8 /) + kbo(:,59,10) = (/ & + & 0.18277e-01_r8,0.25273e-01_r8,0.32791e-01_r8,0.42508e-01_r8,0.53680e-01_r8 /) + kbo(:,13,11) = (/ & + & 0.10693e+01_r8,0.10902e+01_r8,0.11032e+01_r8,0.10991e+01_r8,0.11118e+01_r8 /) + kbo(:,14,11) = (/ & + & 0.95953e+00_r8,0.97384e+00_r8,0.98577e+00_r8,0.99728e+00_r8,0.10070e+01_r8 /) + kbo(:,15,11) = (/ & + & 0.85940e+00_r8,0.86781e+00_r8,0.87766e+00_r8,0.88834e+00_r8,0.89855e+00_r8 /) + kbo(:,16,11) = (/ & + & 0.76187e+00_r8,0.76651e+00_r8,0.78116e+00_r8,0.79605e+00_r8,0.80429e+00_r8 /) + kbo(:,17,11) = (/ & + & 0.67627e+00_r8,0.68377e+00_r8,0.69734e+00_r8,0.70867e+00_r8,0.71758e+00_r8 /) + kbo(:,18,11) = (/ & + & 0.60442e+00_r8,0.61462e+00_r8,0.62319e+00_r8,0.63477e+00_r8,0.64696e+00_r8 /) + kbo(:,19,11) = (/ & + & 0.54250e+00_r8,0.55180e+00_r8,0.56132e+00_r8,0.57649e+00_r8,0.58604e+00_r8 /) + kbo(:,20,11) = (/ & + & 0.49000e+00_r8,0.49922e+00_r8,0.51229e+00_r8,0.52536e+00_r8,0.53903e+00_r8 /) + kbo(:,21,11) = (/ & + & 0.44362e+00_r8,0.45018e+00_r8,0.46523e+00_r8,0.48212e+00_r8,0.49590e+00_r8 /) + kbo(:,22,11) = (/ & + & 0.40390e+00_r8,0.41136e+00_r8,0.42554e+00_r8,0.44299e+00_r8,0.45956e+00_r8 /) + kbo(:,23,11) = (/ & + & 0.36600e+00_r8,0.37646e+00_r8,0.39144e+00_r8,0.40936e+00_r8,0.42622e+00_r8 /) + kbo(:,24,11) = (/ & + & 0.33488e+00_r8,0.34802e+00_r8,0.36259e+00_r8,0.38089e+00_r8,0.39832e+00_r8 /) + kbo(:,25,11) = (/ & + & 0.30569e+00_r8,0.32099e+00_r8,0.33730e+00_r8,0.35716e+00_r8,0.37447e+00_r8 /) + kbo(:,26,11) = (/ & + & 0.28345e+00_r8,0.29933e+00_r8,0.31861e+00_r8,0.33716e+00_r8,0.35400e+00_r8 /) + kbo(:,27,11) = (/ & + & 0.26524e+00_r8,0.28116e+00_r8,0.30310e+00_r8,0.32398e+00_r8,0.34341e+00_r8 /) + kbo(:,28,11) = (/ & + & 0.25036e+00_r8,0.26748e+00_r8,0.29040e+00_r8,0.31038e+00_r8,0.33527e+00_r8 /) + kbo(:,29,11) = (/ & + & 0.23678e+00_r8,0.25759e+00_r8,0.27958e+00_r8,0.30373e+00_r8,0.33097e+00_r8 /) + kbo(:,30,11) = (/ & + & 0.22835e+00_r8,0.25043e+00_r8,0.27298e+00_r8,0.30247e+00_r8,0.33069e+00_r8 /) + kbo(:,31,11) = (/ & + & 0.22381e+00_r8,0.24448e+00_r8,0.27386e+00_r8,0.30198e+00_r8,0.33135e+00_r8 /) + kbo(:,32,11) = (/ & + & 0.21945e+00_r8,0.24581e+00_r8,0.27557e+00_r8,0.30488e+00_r8,0.33817e+00_r8 /) + kbo(:,33,11) = (/ & + & 0.22020e+00_r8,0.24997e+00_r8,0.27933e+00_r8,0.31199e+00_r8,0.34537e+00_r8 /) + kbo(:,34,11) = (/ & + & 0.22328e+00_r8,0.25315e+00_r8,0.28560e+00_r8,0.31999e+00_r8,0.35204e+00_r8 /) + kbo(:,35,11) = (/ & + & 0.22463e+00_r8,0.25599e+00_r8,0.29016e+00_r8,0.32472e+00_r8,0.35705e+00_r8 /) + kbo(:,36,11) = (/ & + & 0.22454e+00_r8,0.25719e+00_r8,0.29064e+00_r8,0.32676e+00_r8,0.35643e+00_r8 /) + kbo(:,37,11) = (/ & + & 0.21917e+00_r8,0.25146e+00_r8,0.28533e+00_r8,0.32018e+00_r8,0.35207e+00_r8 /) + kbo(:,38,11) = (/ & + & 0.21431e+00_r8,0.24593e+00_r8,0.28070e+00_r8,0.31440e+00_r8,0.34740e+00_r8 /) + kbo(:,39,11) = (/ & + & 0.20995e+00_r8,0.24107e+00_r8,0.27540e+00_r8,0.30795e+00_r8,0.34247e+00_r8 /) + kbo(:,40,11) = (/ & + & 0.20148e+00_r8,0.23319e+00_r8,0.26577e+00_r8,0.30086e+00_r8,0.33366e+00_r8 /) + kbo(:,41,11) = (/ & + & 0.19132e+00_r8,0.22478e+00_r8,0.25632e+00_r8,0.29251e+00_r8,0.32436e+00_r8 /) + kbo(:,42,11) = (/ & + & 0.18231e+00_r8,0.21584e+00_r8,0.24724e+00_r8,0.28164e+00_r8,0.31641e+00_r8 /) + kbo(:,43,11) = (/ & + & 0.17273e+00_r8,0.20475e+00_r8,0.23702e+00_r8,0.26984e+00_r8,0.30535e+00_r8 /) + kbo(:,44,11) = (/ & + & 0.16365e+00_r8,0.19313e+00_r8,0.22566e+00_r8,0.25812e+00_r8,0.29340e+00_r8 /) + kbo(:,45,11) = (/ & + & 0.15471e+00_r8,0.18278e+00_r8,0.21464e+00_r8,0.24686e+00_r8,0.28060e+00_r8 /) + kbo(:,46,11) = (/ & + & 0.14477e+00_r8,0.17256e+00_r8,0.20328e+00_r8,0.23515e+00_r8,0.26753e+00_r8 /) + kbo(:,47,11) = (/ & + & 0.13513e+00_r8,0.16209e+00_r8,0.19092e+00_r8,0.22162e+00_r8,0.25481e+00_r8 /) + kbo(:,48,11) = (/ & + & 0.12632e+00_r8,0.15056e+00_r8,0.17900e+00_r8,0.20905e+00_r8,0.24085e+00_r8 /) + kbo(:,49,11) = (/ & + & 0.11846e+00_r8,0.14059e+00_r8,0.16812e+00_r8,0.19759e+00_r8,0.22701e+00_r8 /) + kbo(:,50,11) = (/ & + & 0.11278e+00_r8,0.13341e+00_r8,0.15756e+00_r8,0.18662e+00_r8,0.21629e+00_r8 /) + kbo(:,51,11) = (/ & + & 0.10711e+00_r8,0.12752e+00_r8,0.14951e+00_r8,0.17651e+00_r8,0.20555e+00_r8 /) + kbo(:,52,11) = (/ & + & 0.10062e+00_r8,0.12140e+00_r8,0.14273e+00_r8,0.16677e+00_r8,0.19594e+00_r8 /) + kbo(:,53,11) = (/ & + & 0.93686e-01_r8,0.11587e+00_r8,0.13705e+00_r8,0.15900e+00_r8,0.18673e+00_r8 /) + kbo(:,54,11) = (/ & + & 0.88183e-01_r8,0.10986e+00_r8,0.13159e+00_r8,0.15362e+00_r8,0.17808e+00_r8 /) + kbo(:,55,11) = (/ & + & 0.81924e-01_r8,0.10428e+00_r8,0.12662e+00_r8,0.14862e+00_r8,0.17143e+00_r8 /) + kbo(:,56,11) = (/ & + & 0.75991e-01_r8,0.98633e-01_r8,0.12219e+00_r8,0.14408e+00_r8,0.16698e+00_r8 /) + kbo(:,57,11) = (/ & + & 0.69399e-01_r8,0.92760e-01_r8,0.11664e+00_r8,0.14040e+00_r8,0.16308e+00_r8 /) + kbo(:,58,11) = (/ & + & 0.64018e-01_r8,0.88343e-01_r8,0.11169e+00_r8,0.13686e+00_r8,0.15969e+00_r8 /) + kbo(:,59,11) = (/ & + & 0.63145e-01_r8,0.86273e-01_r8,0.11143e+00_r8,0.13565e+00_r8,0.16187e+00_r8 /) + kbo(:,13,12) = (/ & + & 0.22241e+01_r8,0.22556e+01_r8,0.22932e+01_r8,0.23316e+01_r8,0.23817e+01_r8 /) + kbo(:,14,12) = (/ & + & 0.20015e+01_r8,0.20535e+01_r8,0.20976e+01_r8,0.21411e+01_r8,0.21895e+01_r8 /) + kbo(:,15,12) = (/ & + & 0.18111e+01_r8,0.18671e+01_r8,0.19196e+01_r8,0.19734e+01_r8,0.20226e+01_r8 /) + kbo(:,16,12) = (/ & + & 0.16513e+01_r8,0.17114e+01_r8,0.17632e+01_r8,0.18132e+01_r8,0.18623e+01_r8 /) + kbo(:,17,12) = (/ & + & 0.15041e+01_r8,0.15648e+01_r8,0.16197e+01_r8,0.16720e+01_r8,0.17169e+01_r8 /) + kbo(:,18,12) = (/ & + & 0.13731e+01_r8,0.14345e+01_r8,0.14937e+01_r8,0.15386e+01_r8,0.16052e+01_r8 /) + kbo(:,19,12) = (/ & + & 0.12478e+01_r8,0.13115e+01_r8,0.13641e+01_r8,0.14279e+01_r8,0.14977e+01_r8 /) + kbo(:,20,12) = (/ & + & 0.11298e+01_r8,0.11910e+01_r8,0.12495e+01_r8,0.13186e+01_r8,0.13914e+01_r8 /) + kbo(:,21,12) = (/ & + & 0.10266e+01_r8,0.10915e+01_r8,0.11508e+01_r8,0.12227e+01_r8,0.13004e+01_r8 /) + kbo(:,22,12) = (/ & + & 0.93959e+00_r8,0.10027e+01_r8,0.10735e+01_r8,0.11507e+01_r8,0.12312e+01_r8 /) + kbo(:,23,12) = (/ & + & 0.87016e+00_r8,0.93486e+00_r8,0.10125e+01_r8,0.10930e+01_r8,0.11794e+01_r8 /) + kbo(:,24,12) = (/ & + & 0.81213e+00_r8,0.88017e+00_r8,0.96483e+00_r8,0.10508e+01_r8,0.11396e+01_r8 /) + kbo(:,25,12) = (/ & + & 0.77134e+00_r8,0.84295e+00_r8,0.93081e+00_r8,0.10201e+01_r8,0.11152e+01_r8 /) + kbo(:,26,12) = (/ & + & 0.73832e+00_r8,0.81743e+00_r8,0.90746e+00_r8,0.10024e+01_r8,0.11020e+01_r8 /) + kbo(:,27,12) = (/ & + & 0.71831e+00_r8,0.80328e+00_r8,0.89505e+00_r8,0.99247e+00_r8,0.10943e+01_r8 /) + kbo(:,28,12) = (/ & + & 0.70848e+00_r8,0.79592e+00_r8,0.89143e+00_r8,0.99432e+00_r8,0.10940e+01_r8 /) + kbo(:,29,12) = (/ & + & 0.70725e+00_r8,0.79781e+00_r8,0.89906e+00_r8,0.10007e+01_r8,0.11009e+01_r8 /) + kbo(:,30,12) = (/ & + & 0.71125e+00_r8,0.80824e+00_r8,0.91144e+00_r8,0.10109e+01_r8,0.11144e+01_r8 /) + kbo(:,31,12) = (/ & + & 0.72057e+00_r8,0.82548e+00_r8,0.92423e+00_r8,0.10285e+01_r8,0.11338e+01_r8 /) + kbo(:,32,12) = (/ & + & 0.73855e+00_r8,0.84223e+00_r8,0.94322e+00_r8,0.10495e+01_r8,0.11523e+01_r8 /) + kbo(:,33,12) = (/ & + & 0.75860e+00_r8,0.86137e+00_r8,0.96653e+00_r8,0.10709e+01_r8,0.11736e+01_r8 /) + kbo(:,34,12) = (/ & + & 0.77584e+00_r8,0.88104e+00_r8,0.98358e+00_r8,0.10881e+01_r8,0.11928e+01_r8 /) + kbo(:,35,12) = (/ & + & 0.78526e+00_r8,0.88915e+00_r8,0.99181e+00_r8,0.10955e+01_r8,0.12024e+01_r8 /) + kbo(:,36,12) = (/ & + & 0.78420e+00_r8,0.88679e+00_r8,0.98962e+00_r8,0.10938e+01_r8,0.12013e+01_r8 /) + kbo(:,37,12) = (/ & + & 0.76619e+00_r8,0.86975e+00_r8,0.97162e+00_r8,0.10774e+01_r8,0.11823e+01_r8 /) + kbo(:,38,12) = (/ & + & 0.74778e+00_r8,0.85168e+00_r8,0.95355e+00_r8,0.10588e+01_r8,0.11642e+01_r8 /) + kbo(:,39,12) = (/ & + & 0.73003e+00_r8,0.83397e+00_r8,0.93638e+00_r8,0.10427e+01_r8,0.11461e+01_r8 /) + kbo(:,40,12) = (/ & + & 0.70694e+00_r8,0.80603e+00_r8,0.90951e+00_r8,0.10129e+01_r8,0.11179e+01_r8 /) + kbo(:,41,12) = (/ & + & 0.68380e+00_r8,0.77629e+00_r8,0.88021e+00_r8,0.98263e+00_r8,0.10876e+01_r8 /) + kbo(:,42,12) = (/ & + & 0.66231e+00_r8,0.74849e+00_r8,0.85130e+00_r8,0.95458e+00_r8,0.10576e+01_r8 /) + kbo(:,43,12) = (/ & + & 0.63688e+00_r8,0.72048e+00_r8,0.81634e+00_r8,0.92017e+00_r8,0.10227e+01_r8 /) + kbo(:,44,12) = (/ & + & 0.60858e+00_r8,0.69178e+00_r8,0.77940e+00_r8,0.88149e+00_r8,0.98460e+00_r8 /) + kbo(:,45,12) = (/ & + & 0.58153e+00_r8,0.66520e+00_r8,0.74925e+00_r8,0.84319e+00_r8,0.94694e+00_r8 /) + kbo(:,46,12) = (/ & + & 0.55197e+00_r8,0.63412e+00_r8,0.71872e+00_r8,0.80664e+00_r8,0.90684e+00_r8 /) + kbo(:,47,12) = (/ & + & 0.51844e+00_r8,0.60273e+00_r8,0.68769e+00_r8,0.77076e+00_r8,0.86117e+00_r8 /) + kbo(:,48,12) = (/ & + & 0.48120e+00_r8,0.57148e+00_r8,0.65491e+00_r8,0.74197e+00_r8,0.82485e+00_r8 /) + kbo(:,49,12) = (/ & + & 0.44584e+00_r8,0.53846e+00_r8,0.62079e+00_r8,0.70603e+00_r8,0.79220e+00_r8 /) + kbo(:,50,12) = (/ & + & 0.41289e+00_r8,0.50133e+00_r8,0.59314e+00_r8,0.67773e+00_r8,0.76297e+00_r8 /) + kbo(:,51,12) = (/ & + & 0.38263e+00_r8,0.46808e+00_r8,0.55994e+00_r8,0.64654e+00_r8,0.73545e+00_r8 /) + kbo(:,52,12) = (/ & + & 0.35216e+00_r8,0.43713e+00_r8,0.52781e+00_r8,0.61897e+00_r8,0.70212e+00_r8 /) + kbo(:,53,12) = (/ & + & 0.33102e+00_r8,0.40477e+00_r8,0.49059e+00_r8,0.58472e+00_r8,0.67270e+00_r8 /) + kbo(:,54,12) = (/ & + & 0.31146e+00_r8,0.37834e+00_r8,0.46271e+00_r8,0.55353e+00_r8,0.64596e+00_r8 /) + kbo(:,55,12) = (/ & + & 0.29087e+00_r8,0.35982e+00_r8,0.43598e+00_r8,0.52416e+00_r8,0.61765e+00_r8 /) + kbo(:,56,12) = (/ & + & 0.27304e+00_r8,0.34098e+00_r8,0.41224e+00_r8,0.49775e+00_r8,0.58771e+00_r8 /) + kbo(:,57,12) = (/ & + & 0.25824e+00_r8,0.32066e+00_r8,0.39085e+00_r8,0.46641e+00_r8,0.55829e+00_r8 /) + kbo(:,58,12) = (/ & + & 0.24548e+00_r8,0.30081e+00_r8,0.37338e+00_r8,0.44708e+00_r8,0.53062e+00_r8 /) + kbo(:,59,12) = (/ & + & 0.24212e+00_r8,0.29858e+00_r8,0.36550e+00_r8,0.44064e+00_r8,0.51789e+00_r8 /) + kbo(:,13,13) = (/ & + & 0.55998e+01_r8,0.57039e+01_r8,0.58049e+01_r8,0.59180e+01_r8,0.59854e+01_r8 /) + kbo(:,14,13) = (/ & + & 0.53275e+01_r8,0.54387e+01_r8,0.55543e+01_r8,0.56621e+01_r8,0.57635e+01_r8 /) + kbo(:,15,13) = (/ & + & 0.50203e+01_r8,0.51578e+01_r8,0.52898e+01_r8,0.54130e+01_r8,0.55373e+01_r8 /) + kbo(:,16,13) = (/ & + & 0.47246e+01_r8,0.48786e+01_r8,0.50266e+01_r8,0.51689e+01_r8,0.53242e+01_r8 /) + kbo(:,17,13) = (/ & + & 0.44403e+01_r8,0.46027e+01_r8,0.47680e+01_r8,0.49455e+01_r8,0.51299e+01_r8 /) + kbo(:,18,13) = (/ & + & 0.41648e+01_r8,0.43473e+01_r8,0.45415e+01_r8,0.47508e+01_r8,0.49298e+01_r8 /) + kbo(:,19,13) = (/ & + & 0.39134e+01_r8,0.41196e+01_r8,0.43493e+01_r8,0.45520e+01_r8,0.47522e+01_r8 /) + kbo(:,20,13) = (/ & + & 0.36873e+01_r8,0.39195e+01_r8,0.41603e+01_r8,0.43826e+01_r8,0.46005e+01_r8 /) + kbo(:,21,13) = (/ & + & 0.34974e+01_r8,0.37507e+01_r8,0.40010e+01_r8,0.42413e+01_r8,0.44759e+01_r8 /) + kbo(:,22,13) = (/ & + & 0.33605e+01_r8,0.36305e+01_r8,0.38873e+01_r8,0.41404e+01_r8,0.43929e+01_r8 /) + kbo(:,23,13) = (/ & + & 0.32571e+01_r8,0.35388e+01_r8,0.38042e+01_r8,0.40702e+01_r8,0.43353e+01_r8 /) + kbo(:,24,13) = (/ & + & 0.31836e+01_r8,0.34721e+01_r8,0.37495e+01_r8,0.40277e+01_r8,0.43044e+01_r8 /) + kbo(:,25,13) = (/ & + & 0.31346e+01_r8,0.34329e+01_r8,0.37222e+01_r8,0.40107e+01_r8,0.42953e+01_r8 /) + kbo(:,26,13) = (/ & + & 0.31155e+01_r8,0.34221e+01_r8,0.37222e+01_r8,0.40178e+01_r8,0.43079e+01_r8 /) + kbo(:,27,13) = (/ & + & 0.31157e+01_r8,0.34328e+01_r8,0.37392e+01_r8,0.40396e+01_r8,0.43346e+01_r8 /) + kbo(:,28,13) = (/ & + & 0.31335e+01_r8,0.34580e+01_r8,0.37695e+01_r8,0.40734e+01_r8,0.43720e+01_r8 /) + kbo(:,29,13) = (/ & + & 0.31697e+01_r8,0.34978e+01_r8,0.38120e+01_r8,0.41186e+01_r8,0.44189e+01_r8 /) + kbo(:,30,13) = (/ & + & 0.32194e+01_r8,0.35475e+01_r8,0.38638e+01_r8,0.41720e+01_r8,0.44722e+01_r8 /) + kbo(:,31,13) = (/ & + & 0.32811e+01_r8,0.36069e+01_r8,0.39241e+01_r8,0.42325e+01_r8,0.45314e+01_r8 /) + kbo(:,32,13) = (/ & + & 0.33484e+01_r8,0.36727e+01_r8,0.39897e+01_r8,0.42974e+01_r8,0.45949e+01_r8 /) + kbo(:,33,13) = (/ & + & 0.34186e+01_r8,0.37430e+01_r8,0.40586e+01_r8,0.43658e+01_r8,0.46602e+01_r8 /) + kbo(:,34,13) = (/ & + & 0.34801e+01_r8,0.38048e+01_r8,0.41197e+01_r8,0.44255e+01_r8,0.47156e+01_r8 /) + kbo(:,35,13) = (/ & + & 0.35126e+01_r8,0.38375e+01_r8,0.41525e+01_r8,0.44577e+01_r8,0.47454e+01_r8 /) + kbo(:,36,13) = (/ & + & 0.35115e+01_r8,0.38370e+01_r8,0.41529e+01_r8,0.44584e+01_r8,0.47449e+01_r8 /) + kbo(:,37,13) = (/ & + & 0.34620e+01_r8,0.37892e+01_r8,0.41066e+01_r8,0.44144e+01_r8,0.47052e+01_r8 /) + kbo(:,38,13) = (/ & + & 0.34108e+01_r8,0.37391e+01_r8,0.40587e+01_r8,0.43685e+01_r8,0.46624e+01_r8 /) + kbo(:,39,13) = (/ & + & 0.33603e+01_r8,0.36896e+01_r8,0.40114e+01_r8,0.43229e+01_r8,0.46208e+01_r8 /) + kbo(:,40,13) = (/ & + & 0.32696e+01_r8,0.36068e+01_r8,0.39317e+01_r8,0.42460e+01_r8,0.45479e+01_r8 /) + kbo(:,41,13) = (/ & + & 0.31746e+01_r8,0.35197e+01_r8,0.38475e+01_r8,0.41644e+01_r8,0.44716e+01_r8 /) + kbo(:,42,13) = (/ & + & 0.30768e+01_r8,0.34312e+01_r8,0.37630e+01_r8,0.40826e+01_r8,0.43924e+01_r8 /) + kbo(:,43,13) = (/ & + & 0.29558e+01_r8,0.33178e+01_r8,0.36587e+01_r8,0.39822e+01_r8,0.42959e+01_r8 /) + kbo(:,44,13) = (/ & + & 0.28280e+01_r8,0.31906e+01_r8,0.35435e+01_r8,0.38727e+01_r8,0.41899e+01_r8 /) + kbo(:,45,13) = (/ & + & 0.26988e+01_r8,0.30597e+01_r8,0.34201e+01_r8,0.37628e+01_r8,0.40831e+01_r8 /) + kbo(:,46,13) = (/ & + & 0.25661e+01_r8,0.29262e+01_r8,0.32865e+01_r8,0.36383e+01_r8,0.39682e+01_r8 /) + kbo(:,47,13) = (/ & + & 0.24176e+01_r8,0.27716e+01_r8,0.31308e+01_r8,0.34925e+01_r8,0.38381e+01_r8 /) + kbo(:,48,13) = (/ & + & 0.22754e+01_r8,0.26218e+01_r8,0.29793e+01_r8,0.33363e+01_r8,0.36948e+01_r8 /) + kbo(:,49,13) = (/ & + & 0.21329e+01_r8,0.24724e+01_r8,0.28302e+01_r8,0.31874e+01_r8,0.35454e+01_r8 /) + kbo(:,50,13) = (/ & + & 0.20005e+01_r8,0.23398e+01_r8,0.26856e+01_r8,0.30422e+01_r8,0.34002e+01_r8 /) + kbo(:,51,13) = (/ & + & 0.18713e+01_r8,0.22087e+01_r8,0.25515e+01_r8,0.29067e+01_r8,0.32588e+01_r8 /) + kbo(:,52,13) = (/ & + & 0.17459e+01_r8,0.20772e+01_r8,0.24169e+01_r8,0.27666e+01_r8,0.31241e+01_r8 /) + kbo(:,53,13) = (/ & + & 0.16095e+01_r8,0.19502e+01_r8,0.22895e+01_r8,0.26325e+01_r8,0.29855e+01_r8 /) + kbo(:,54,13) = (/ & + & 0.15066e+01_r8,0.18320e+01_r8,0.21659e+01_r8,0.25081e+01_r8,0.28569e+01_r8 /) + kbo(:,55,13) = (/ & + & 0.14318e+01_r8,0.17117e+01_r8,0.20491e+01_r8,0.23896e+01_r8,0.27343e+01_r8 /) + kbo(:,56,13) = (/ & + & 0.13449e+01_r8,0.16235e+01_r8,0.19309e+01_r8,0.22682e+01_r8,0.26139e+01_r8 /) + kbo(:,57,13) = (/ & + & 0.12667e+01_r8,0.15514e+01_r8,0.18274e+01_r8,0.21528e+01_r8,0.24919e+01_r8 /) + kbo(:,58,13) = (/ & + & 0.11763e+01_r8,0.14696e+01_r8,0.17445e+01_r8,0.20345e+01_r8,0.23757e+01_r8 /) + kbo(:,59,13) = (/ & + & 0.11472e+01_r8,0.14428e+01_r8,0.17312e+01_r8,0.20031e+01_r8,0.23234e+01_r8 /) + kbo(:,13,14) = (/ & + & 0.15147e+02_r8,0.15130e+02_r8,0.15113e+02_r8,0.15099e+02_r8,0.15078e+02_r8 /) + kbo(:,14,14) = (/ & + & 0.15510e+02_r8,0.15546e+02_r8,0.15567e+02_r8,0.15587e+02_r8,0.15585e+02_r8 /) + kbo(:,15,14) = (/ & + & 0.15739e+02_r8,0.15841e+02_r8,0.15930e+02_r8,0.15986e+02_r8,0.16004e+02_r8 /) + kbo(:,16,14) = (/ & + & 0.15858e+02_r8,0.16042e+02_r8,0.16196e+02_r8,0.16295e+02_r8,0.16347e+02_r8 /) + kbo(:,17,14) = (/ & + & 0.15892e+02_r8,0.16168e+02_r8,0.16375e+02_r8,0.16519e+02_r8,0.16620e+02_r8 /) + kbo(:,18,14) = (/ & + & 0.15890e+02_r8,0.16233e+02_r8,0.16495e+02_r8,0.16687e+02_r8,0.16843e+02_r8 /) + kbo(:,19,14) = (/ & + & 0.15860e+02_r8,0.16260e+02_r8,0.16572e+02_r8,0.16822e+02_r8,0.17016e+02_r8 /) + kbo(:,20,14) = (/ & + & 0.15821e+02_r8,0.16274e+02_r8,0.16642e+02_r8,0.16937e+02_r8,0.17165e+02_r8 /) + kbo(:,21,14) = (/ & + & 0.15778e+02_r8,0.16284e+02_r8,0.16705e+02_r8,0.17036e+02_r8,0.17293e+02_r8 /) + kbo(:,22,14) = (/ & + & 0.15777e+02_r8,0.16337e+02_r8,0.16794e+02_r8,0.17151e+02_r8,0.17417e+02_r8 /) + kbo(:,23,14) = (/ & + & 0.15815e+02_r8,0.16408e+02_r8,0.16883e+02_r8,0.17258e+02_r8,0.17537e+02_r8 /) + kbo(:,24,14) = (/ & + & 0.15884e+02_r8,0.16493e+02_r8,0.16982e+02_r8,0.17365e+02_r8,0.17648e+02_r8 /) + kbo(:,25,14) = (/ & + & 0.15973e+02_r8,0.16594e+02_r8,0.17087e+02_r8,0.17470e+02_r8,0.17753e+02_r8 /) + kbo(:,26,14) = (/ & + & 0.16098e+02_r8,0.16711e+02_r8,0.17198e+02_r8,0.17574e+02_r8,0.17853e+02_r8 /) + kbo(:,27,14) = (/ & + & 0.16232e+02_r8,0.16836e+02_r8,0.17310e+02_r8,0.17676e+02_r8,0.17946e+02_r8 /) + kbo(:,28,14) = (/ & + & 0.16376e+02_r8,0.16966e+02_r8,0.17425e+02_r8,0.17775e+02_r8,0.18032e+02_r8 /) + kbo(:,29,14) = (/ & + & 0.16527e+02_r8,0.17096e+02_r8,0.17538e+02_r8,0.17871e+02_r8,0.18111e+02_r8 /) + kbo(:,30,14) = (/ & + & 0.16681e+02_r8,0.17223e+02_r8,0.17646e+02_r8,0.17959e+02_r8,0.18183e+02_r8 /) + kbo(:,31,14) = (/ & + & 0.16832e+02_r8,0.17348e+02_r8,0.17747e+02_r8,0.18041e+02_r8,0.18247e+02_r8 /) + kbo(:,32,14) = (/ & + & 0.16982e+02_r8,0.17470e+02_r8,0.17844e+02_r8,0.18116e+02_r8,0.18304e+02_r8 /) + kbo(:,33,14) = (/ & + & 0.17125e+02_r8,0.17586e+02_r8,0.17935e+02_r8,0.18187e+02_r8,0.18356e+02_r8 /) + kbo(:,34,14) = (/ & + & 0.17243e+02_r8,0.17681e+02_r8,0.18009e+02_r8,0.18243e+02_r8,0.18396e+02_r8 /) + kbo(:,35,14) = (/ & + & 0.17308e+02_r8,0.17736e+02_r8,0.18053e+02_r8,0.18277e+02_r8,0.18422e+02_r8 /) + kbo(:,36,14) = (/ & + & 0.17321e+02_r8,0.17747e+02_r8,0.18064e+02_r8,0.18289e+02_r8,0.18431e+02_r8 /) + kbo(:,37,14) = (/ & + & 0.17259e+02_r8,0.17701e+02_r8,0.18033e+02_r8,0.18270e+02_r8,0.18425e+02_r8 /) + kbo(:,38,14) = (/ & + & 0.17190e+02_r8,0.17649e+02_r8,0.17997e+02_r8,0.18247e+02_r8,0.18415e+02_r8 /) + kbo(:,39,14) = (/ & + & 0.17116e+02_r8,0.17594e+02_r8,0.17957e+02_r8,0.18221e+02_r8,0.18401e+02_r8 /) + kbo(:,40,14) = (/ & + & 0.16981e+02_r8,0.17491e+02_r8,0.17882e+02_r8,0.18168e+02_r8,0.18367e+02_r8 /) + kbo(:,41,14) = (/ & + & 0.16829e+02_r8,0.17375e+02_r8,0.17795e+02_r8,0.18107e+02_r8,0.18328e+02_r8 /) + kbo(:,42,14) = (/ & + & 0.16667e+02_r8,0.17250e+02_r8,0.17700e+02_r8,0.18038e+02_r8,0.18281e+02_r8 /) + kbo(:,43,14) = (/ & + & 0.16452e+02_r8,0.17082e+02_r8,0.17573e+02_r8,0.17944e+02_r8,0.18214e+02_r8 /) + kbo(:,44,14) = (/ & + & 0.16203e+02_r8,0.16887e+02_r8,0.17421e+02_r8,0.17833e+02_r8,0.18135e+02_r8 /) + kbo(:,45,14) = (/ & + & 0.15935e+02_r8,0.16673e+02_r8,0.17257e+02_r8,0.17708e+02_r8,0.18046e+02_r8 /) + kbo(:,46,14) = (/ & + & 0.15628e+02_r8,0.16427e+02_r8,0.17064e+02_r8,0.17560e+02_r8,0.17936e+02_r8 /) + kbo(:,47,14) = (/ & + & 0.15258e+02_r8,0.16126e+02_r8,0.16827e+02_r8,0.17377e+02_r8,0.17799e+02_r8 /) + kbo(:,48,14) = (/ & + & 0.14864e+02_r8,0.15798e+02_r8,0.16564e+02_r8,0.17174e+02_r8,0.17643e+02_r8 /) + kbo(:,49,14) = (/ & + & 0.14439e+02_r8,0.15441e+02_r8,0.16276e+02_r8,0.16946e+02_r8,0.17469e+02_r8 /) + kbo(:,50,14) = (/ & + & 0.14012e+02_r8,0.15084e+02_r8,0.15980e+02_r8,0.16711e+02_r8,0.17289e+02_r8 /) + kbo(:,51,14) = (/ & + & 0.13576e+02_r8,0.14715e+02_r8,0.15671e+02_r8,0.16463e+02_r8,0.17096e+02_r8 /) + kbo(:,52,14) = (/ & + & 0.13120e+02_r8,0.14320e+02_r8,0.15341e+02_r8,0.16194e+02_r8,0.16882e+02_r8 /) + kbo(:,53,14) = (/ & + & 0.12642e+02_r8,0.13899e+02_r8,0.14988e+02_r8,0.15902e+02_r8,0.16649e+02_r8 /) + kbo(:,54,14) = (/ & + & 0.12147e+02_r8,0.13496e+02_r8,0.14645e+02_r8,0.15614e+02_r8,0.16418e+02_r8 /) + kbo(:,55,14) = (/ & + & 0.11626e+02_r8,0.13090e+02_r8,0.14295e+02_r8,0.15320e+02_r8,0.16178e+02_r8 /) + kbo(:,56,14) = (/ & + & 0.11110e+02_r8,0.12619e+02_r8,0.13926e+02_r8,0.15012e+02_r8,0.15922e+02_r8 /) + kbo(:,57,14) = (/ & + & 0.10565e+02_r8,0.12110e+02_r8,0.13518e+02_r8,0.14685e+02_r8,0.15649e+02_r8 /) + kbo(:,58,14) = (/ & + & 0.10061e+02_r8,0.11633e+02_r8,0.13084e+02_r8,0.14356e+02_r8,0.15374e+02_r8 /) + kbo(:,59,14) = (/ & + & 0.98377e+01_r8,0.11416e+02_r8,0.12868e+02_r8,0.14184e+02_r8,0.15259e+02_r8 /) + kbo(:,13,15) = (/ & + & 0.41304e+02_r8,0.40483e+02_r8,0.39654e+02_r8,0.38829e+02_r8,0.38029e+02_r8 /) + kbo(:,14,15) = (/ & + & 0.44686e+02_r8,0.43762e+02_r8,0.42836e+02_r8,0.41888e+02_r8,0.41004e+02_r8 /) + kbo(:,15,15) = (/ & + & 0.48004e+02_r8,0.46942e+02_r8,0.45864e+02_r8,0.44813e+02_r8,0.43844e+02_r8 /) + kbo(:,16,15) = (/ & + & 0.51150e+02_r8,0.49938e+02_r8,0.48734e+02_r8,0.47591e+02_r8,0.46512e+02_r8 /) + kbo(:,17,15) = (/ & + & 0.54100e+02_r8,0.52729e+02_r8,0.51435e+02_r8,0.50180e+02_r8,0.48962e+02_r8 /) + kbo(:,18,15) = (/ & + & 0.56777e+02_r8,0.55306e+02_r8,0.53894e+02_r8,0.52525e+02_r8,0.51164e+02_r8 /) + kbo(:,19,15) = (/ & + & 0.59186e+02_r8,0.57635e+02_r8,0.56100e+02_r8,0.54603e+02_r8,0.53129e+02_r8 /) + kbo(:,20,15) = (/ & + & 0.61293e+02_r8,0.59648e+02_r8,0.58005e+02_r8,0.56388e+02_r8,0.54798e+02_r8 /) + kbo(:,21,15) = (/ & + & 0.63124e+02_r8,0.61368e+02_r8,0.59613e+02_r8,0.57895e+02_r8,0.56204e+02_r8 /) + kbo(:,22,15) = (/ & + & 0.64562e+02_r8,0.62695e+02_r8,0.60841e+02_r8,0.59040e+02_r8,0.57268e+02_r8 /) + kbo(:,23,15) = (/ & + & 0.65690e+02_r8,0.63742e+02_r8,0.61820e+02_r8,0.59937e+02_r8,0.58087e+02_r8 /) + kbo(:,24,15) = (/ & + & 0.66548e+02_r8,0.64535e+02_r8,0.62550e+02_r8,0.60597e+02_r8,0.58690e+02_r8 /) + kbo(:,25,15) = (/ & + & 0.67194e+02_r8,0.65115e+02_r8,0.63062e+02_r8,0.61050e+02_r8,0.59091e+02_r8 /) + kbo(:,26,15) = (/ & + & 0.67597e+02_r8,0.65466e+02_r8,0.63369e+02_r8,0.61312e+02_r8,0.59309e+02_r8 /) + kbo(:,27,15) = (/ & + & 0.67831e+02_r8,0.65647e+02_r8,0.63518e+02_r8,0.61430e+02_r8,0.59393e+02_r8 /) + kbo(:,28,15) = (/ & + & 0.67908e+02_r8,0.65687e+02_r8,0.63527e+02_r8,0.61427e+02_r8,0.59357e+02_r8 /) + kbo(:,29,15) = (/ & + & 0.67845e+02_r8,0.65603e+02_r8,0.63419e+02_r8,0.61304e+02_r8,0.59222e+02_r8 /) + kbo(:,30,15) = (/ & + & 0.67682e+02_r8,0.65422e+02_r8,0.63225e+02_r8,0.61094e+02_r8,0.59010e+02_r8 /) + kbo(:,31,15) = (/ & + & 0.67415e+02_r8,0.65154e+02_r8,0.62953e+02_r8,0.60816e+02_r8,0.58721e+02_r8 /) + kbo(:,32,15) = (/ & + & 0.67084e+02_r8,0.64817e+02_r8,0.62622e+02_r8,0.60477e+02_r8,0.58393e+02_r8 /) + kbo(:,33,15) = (/ & + & 0.66692e+02_r8,0.64428e+02_r8,0.62242e+02_r8,0.60092e+02_r8,0.58024e+02_r8 /) + kbo(:,34,15) = (/ & + & 0.66346e+02_r8,0.64077e+02_r8,0.61890e+02_r8,0.59745e+02_r8,0.57700e+02_r8 /) + kbo(:,35,15) = (/ & + & 0.66188e+02_r8,0.63920e+02_r8,0.61727e+02_r8,0.59582e+02_r8,0.57542e+02_r8 /) + kbo(:,36,15) = (/ & + & 0.66248e+02_r8,0.63978e+02_r8,0.61782e+02_r8,0.59625e+02_r8,0.57587e+02_r8 /) + kbo(:,37,15) = (/ & + & 0.66642e+02_r8,0.64358e+02_r8,0.62144e+02_r8,0.59978e+02_r8,0.57911e+02_r8 /) + kbo(:,38,15) = (/ & + & 0.67048e+02_r8,0.64747e+02_r8,0.62516e+02_r8,0.60340e+02_r8,0.58249e+02_r8 /) + kbo(:,39,15) = (/ & + & 0.67435e+02_r8,0.65122e+02_r8,0.62879e+02_r8,0.60689e+02_r8,0.58578e+02_r8 /) + kbo(:,40,15) = (/ & + & 0.68061e+02_r8,0.65724e+02_r8,0.63462e+02_r8,0.61257e+02_r8,0.59113e+02_r8 /) + kbo(:,41,15) = (/ & + & 0.68702e+02_r8,0.66354e+02_r8,0.64067e+02_r8,0.61847e+02_r8,0.59682e+02_r8 /) + kbo(:,42,15) = (/ & + & 0.69355e+02_r8,0.66983e+02_r8,0.64678e+02_r8,0.62437e+02_r8,0.60259e+02_r8 /) + kbo(:,43,15) = (/ & + & 0.70142e+02_r8,0.67744e+02_r8,0.65416e+02_r8,0.63159e+02_r8,0.60959e+02_r8 /) + kbo(:,44,15) = (/ & + & 0.70991e+02_r8,0.68567e+02_r8,0.66218e+02_r8,0.63930e+02_r8,0.61713e+02_r8 /) + kbo(:,45,15) = (/ & + & 0.71837e+02_r8,0.69401e+02_r8,0.67026e+02_r8,0.64713e+02_r8,0.62473e+02_r8 /) + kbo(:,46,15) = (/ & + & 0.72733e+02_r8,0.70287e+02_r8,0.67885e+02_r8,0.65552e+02_r8,0.63292e+02_r8 /) + kbo(:,47,15) = (/ & + & 0.73741e+02_r8,0.71285e+02_r8,0.68859e+02_r8,0.66493e+02_r8,0.64198e+02_r8 /) + kbo(:,48,15) = (/ & + & 0.74725e+02_r8,0.72283e+02_r8,0.69840e+02_r8,0.67442e+02_r8,0.65125e+02_r8 /) + kbo(:,49,15) = (/ & + & 0.75665e+02_r8,0.73280e+02_r8,0.70828e+02_r8,0.68404e+02_r8,0.66060e+02_r8 /) + kbo(:,50,15) = (/ & + & 0.76534e+02_r8,0.74218e+02_r8,0.71764e+02_r8,0.69323e+02_r8,0.66942e+02_r8 /) + kbo(:,51,15) = (/ & + & 0.77333e+02_r8,0.75093e+02_r8,0.72664e+02_r8,0.70214e+02_r8,0.67806e+02_r8 /) + kbo(:,52,15) = (/ & + & 0.78102e+02_r8,0.75935e+02_r8,0.73563e+02_r8,0.71111e+02_r8,0.68683e+02_r8 /) + kbo(:,53,15) = (/ & + & 0.78815e+02_r8,0.76761e+02_r8,0.74462e+02_r8,0.72010e+02_r8,0.69568e+02_r8 /) + kbo(:,54,15) = (/ & + & 0.79431e+02_r8,0.77488e+02_r8,0.75258e+02_r8,0.72840e+02_r8,0.70386e+02_r8 /) + kbo(:,55,15) = (/ & + & 0.79987e+02_r8,0.78156e+02_r8,0.75999e+02_r8,0.73628e+02_r8,0.71177e+02_r8 /) + kbo(:,56,15) = (/ & + & 0.80478e+02_r8,0.78776e+02_r8,0.76714e+02_r8,0.74415e+02_r8,0.71963e+02_r8 /) + kbo(:,57,15) = (/ & + & 0.80898e+02_r8,0.79365e+02_r8,0.77410e+02_r8,0.75181e+02_r8,0.72750e+02_r8 /) + kbo(:,58,15) = (/ & + & 0.81210e+02_r8,0.79894e+02_r8,0.78053e+02_r8,0.75880e+02_r8,0.73498e+02_r8 /) + kbo(:,59,15) = (/ & + & 0.81312e+02_r8,0.80086e+02_r8,0.78299e+02_r8,0.76156e+02_r8,0.73801e+02_r8 /) + kbo(:,13,16) = (/ & + & 0.81866e+02_r8,0.78569e+02_r8,0.75624e+02_r8,0.72854e+02_r8,0.70288e+02_r8 /) + kbo(:,14,16) = (/ & + & 0.93095e+02_r8,0.88986e+02_r8,0.85351e+02_r8,0.82051e+02_r8,0.78936e+02_r8 /) + kbo(:,15,16) = (/ & + & 0.10470e+03_r8,0.99738e+02_r8,0.95227e+02_r8,0.91249e+02_r8,0.87478e+02_r8 /) + kbo(:,16,16) = (/ & + & 0.11635e+03_r8,0.11037e+03_r8,0.10495e+03_r8,0.10011e+03_r8,0.95646e+02_r8 /) + kbo(:,17,16) = (/ & + & 0.12769e+03_r8,0.12074e+03_r8,0.11431e+03_r8,0.10856e+03_r8,0.10332e+03_r8 /) + kbo(:,18,16) = (/ & + & 0.13851e+03_r8,0.13038e+03_r8,0.12299e+03_r8,0.11635e+03_r8,0.11033e+03_r8 /) + kbo(:,19,16) = (/ & + & 0.14848e+03_r8,0.13912e+03_r8,0.13084e+03_r8,0.12336e+03_r8,0.11656e+03_r8 /) + kbo(:,20,16) = (/ & + & 0.15718e+03_r8,0.14679e+03_r8,0.13761e+03_r8,0.12934e+03_r8,0.12188e+03_r8 /) + kbo(:,21,16) = (/ & + & 0.16462e+03_r8,0.15341e+03_r8,0.14345e+03_r8,0.13443e+03_r8,0.12636e+03_r8 /) + kbo(:,22,16) = (/ & + & 0.17012e+03_r8,0.15822e+03_r8,0.14760e+03_r8,0.13801e+03_r8,0.12950e+03_r8 /) + kbo(:,23,16) = (/ & + & 0.17437e+03_r8,0.16184e+03_r8,0.15069e+03_r8,0.14069e+03_r8,0.13184e+03_r8 /) + kbo(:,24,16) = (/ & + & 0.17733e+03_r8,0.16436e+03_r8,0.15282e+03_r8,0.14251e+03_r8,0.13340e+03_r8 /) + kbo(:,25,16) = (/ & + & 0.17910e+03_r8,0.16583e+03_r8,0.15401e+03_r8,0.14354e+03_r8,0.13426e+03_r8 /) + kbo(:,26,16) = (/ & + & 0.17968e+03_r8,0.16627e+03_r8,0.15433e+03_r8,0.14378e+03_r8,0.13445e+03_r8 /) + kbo(:,27,16) = (/ & + & 0.17946e+03_r8,0.16602e+03_r8,0.15406e+03_r8,0.14351e+03_r8,0.13417e+03_r8 /) + kbo(:,28,16) = (/ & + & 0.17860e+03_r8,0.16522e+03_r8,0.15334e+03_r8,0.14282e+03_r8,0.13355e+03_r8 /) + kbo(:,29,16) = (/ & + & 0.17717e+03_r8,0.16389e+03_r8,0.15216e+03_r8,0.14174e+03_r8,0.13260e+03_r8 /) + kbo(:,30,16) = (/ & + & 0.17533e+03_r8,0.16225e+03_r8,0.15066e+03_r8,0.14043e+03_r8,0.13143e+03_r8 /) + kbo(:,31,16) = (/ & + & 0.17313e+03_r8,0.16029e+03_r8,0.14890e+03_r8,0.13886e+03_r8,0.13004e+03_r8 /) + kbo(:,32,16) = (/ & + & 0.17069e+03_r8,0.15811e+03_r8,0.14694e+03_r8,0.13716e+03_r8,0.12847e+03_r8 /) + kbo(:,33,16) = (/ & + & 0.16804e+03_r8,0.15577e+03_r8,0.14487e+03_r8,0.13533e+03_r8,0.12682e+03_r8 /) + kbo(:,34,16) = (/ & + & 0.16580e+03_r8,0.15376e+03_r8,0.14309e+03_r8,0.13376e+03_r8,0.12539e+03_r8 /) + kbo(:,35,16) = (/ & + & 0.16467e+03_r8,0.15275e+03_r8,0.14221e+03_r8,0.13298e+03_r8,0.12468e+03_r8 /) + kbo(:,36,16) = (/ & + & 0.16486e+03_r8,0.15289e+03_r8,0.14233e+03_r8,0.13308e+03_r8,0.12477e+03_r8 /) + kbo(:,37,16) = (/ & + & 0.16688e+03_r8,0.15469e+03_r8,0.14392e+03_r8,0.13446e+03_r8,0.12602e+03_r8 /) + kbo(:,38,16) = (/ & + & 0.16902e+03_r8,0.15657e+03_r8,0.14555e+03_r8,0.13592e+03_r8,0.12732e+03_r8 /) + kbo(:,39,16) = (/ & + & 0.17110e+03_r8,0.15844e+03_r8,0.14718e+03_r8,0.13734e+03_r8,0.12861e+03_r8 /) + kbo(:,40,16) = (/ & + & 0.17468e+03_r8,0.16155e+03_r8,0.14992e+03_r8,0.13976e+03_r8,0.13077e+03_r8 /) + kbo(:,41,16) = (/ & + & 0.17848e+03_r8,0.16489e+03_r8,0.15289e+03_r8,0.14236e+03_r8,0.13307e+03_r8 /) + kbo(:,42,16) = (/ & + & 0.18237e+03_r8,0.16833e+03_r8,0.15592e+03_r8,0.14501e+03_r8,0.13541e+03_r8 /) + kbo(:,43,16) = (/ & + & 0.18726e+03_r8,0.17263e+03_r8,0.15975e+03_r8,0.14834e+03_r8,0.13835e+03_r8 /) + kbo(:,44,16) = (/ & + & 0.19275e+03_r8,0.17748e+03_r8,0.16403e+03_r8,0.15210e+03_r8,0.14166e+03_r8 /) + kbo(:,45,16) = (/ & + & 0.19851e+03_r8,0.18250e+03_r8,0.16844e+03_r8,0.15602e+03_r8,0.14507e+03_r8 /) + kbo(:,46,16) = (/ & + & 0.20490e+03_r8,0.18806e+03_r8,0.17333e+03_r8,0.16038e+03_r8,0.14888e+03_r8 /) + kbo(:,47,16) = (/ & + & 0.21238e+03_r8,0.19462e+03_r8,0.17910e+03_r8,0.16545e+03_r8,0.15337e+03_r8 /) + kbo(:,48,16) = (/ & + & 0.22029e+03_r8,0.20156e+03_r8,0.18514e+03_r8,0.17074e+03_r8,0.15806e+03_r8 /) + kbo(:,49,16) = (/ & + & 0.22889e+03_r8,0.20882e+03_r8,0.19150e+03_r8,0.17637e+03_r8,0.16304e+03_r8 /) + kbo(:,50,16) = (/ & + & 0.23745e+03_r8,0.21596e+03_r8,0.19782e+03_r8,0.18187e+03_r8,0.16787e+03_r8 /) + kbo(:,51,16) = (/ & + & 0.24629e+03_r8,0.22340e+03_r8,0.20422e+03_r8,0.18747e+03_r8,0.17280e+03_r8 /) + kbo(:,52,16) = (/ & + & 0.25553e+03_r8,0.23136e+03_r8,0.21090e+03_r8,0.19335e+03_r8,0.17798e+03_r8 /) + kbo(:,53,16) = (/ & + & 0.26553e+03_r8,0.23980e+03_r8,0.21793e+03_r8,0.19951e+03_r8,0.18336e+03_r8 /) + kbo(:,54,16) = (/ & + & 0.27524e+03_r8,0.24799e+03_r8,0.22485e+03_r8,0.20544e+03_r8,0.18854e+03_r8 /) + kbo(:,55,16) = (/ & + & 0.28502e+03_r8,0.25615e+03_r8,0.23188e+03_r8,0.21133e+03_r8,0.19372e+03_r8 /) + kbo(:,56,16) = (/ & + & 0.29529e+03_r8,0.26491e+03_r8,0.23927e+03_r8,0.21749e+03_r8,0.19913e+03_r8 /) + kbo(:,57,16) = (/ & + & 0.30624e+03_r8,0.27413e+03_r8,0.24703e+03_r8,0.22404e+03_r8,0.20478e+03_r8 /) + kbo(:,58,16) = (/ & + & 0.31727e+03_r8,0.28329e+03_r8,0.25471e+03_r8,0.23065e+03_r8,0.21031e+03_r8 /) + kbo(:,59,16) = (/ & + & 0.32188e+03_r8,0.28710e+03_r8,0.25796e+03_r8,0.23341e+03_r8,0.21261e+03_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.214504e-06_r8, 0.460418e-06_r8, 0.357608e-05_r8, 0.192037e-05_r8 /) + forrefo(:, 2) = (/ 0.142576e-05_r8, 0.364463e-05_r8, 0.117033e-04_r8, 0.112085e-04_r8 /) + forrefo(:, 3) = (/ 0.101536e-04_r8, 0.124096e-04_r8, 0.509190e-04_r8, 0.565282e-04_r8 /) + forrefo(:, 4) = (/ 0.143394e-03_r8, 0.154700e-03_r8, 0.466498e-03_r8, 0.918829e-03_r8 /) + forrefo(:, 5) = (/ 0.251631e-02_r8, 0.241729e-02_r8, 0.240057e-02_r8, 0.350408e-02_r8 /) + forrefo(:, 6) = (/ 0.410309e-02_r8, 0.416851e-02_r8, 0.390925e-02_r8, 0.383694e-02_r8 /) + forrefo(:, 7) = (/ 0.445387e-02_r8, 0.448657e-02_r8, 0.432310e-02_r8, 0.370739e-02_r8 /) + forrefo(:, 8) = (/ 0.458150e-02_r8, 0.460014e-02_r8, 0.450245e-02_r8, 0.336718e-02_r8 /) + forrefo(:, 9) = (/ 0.465423e-02_r8, 0.465595e-02_r8, 0.467006e-02_r8, 0.368061e-02_r8 /) + forrefo(:,10) = (/ 0.493955e-02_r8, 0.490181e-02_r8, 0.481941e-02_r8, 0.367577e-02_r8 /) + forrefo(:,11) = (/ 0.511876e-02_r8, 0.490981e-02_r8, 0.493303e-02_r8, 0.357423e-02_r8 /) + forrefo(:,12) = (/ 0.509845e-02_r8, 0.511556e-02_r8, 0.504031e-02_r8, 0.355915e-02_r8 /) + forrefo(:,13) = (/ 0.523822e-02_r8, 0.530473e-02_r8, 0.523811e-02_r8, 0.414259e-02_r8 /) + forrefo(:,14) = (/ 0.551133e-02_r8, 0.535831e-02_r8, 0.546702e-02_r8, 0.473875e-02_r8 /) + forrefo(:,15) = (/ 0.609781e-02_r8, 0.589859e-02_r8, 0.561187e-02_r8, 0.528981e-02_r8 /) + forrefo(:,16) = (/ 0.644958e-02_r8, 0.631718e-02_r8, 0.625201e-02_r8, 0.600448e-02_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.217058e-03_r8, 0.176391e-03_r8, 0.143342e-03_r8, 0.116486e-03_r8, 0.946614e-04_r8, & + & 0.769257e-04_r8, 0.625131e-04_r8, 0.508007e-04_r8, 0.412828e-04_r8, 0.335481e-04_r8 /) + selfrefo(:, 2) = (/ & + & 0.598055e-03_r8, 0.484805e-03_r8, 0.393000e-03_r8, 0.318580e-03_r8, 0.258252e-03_r8, & + & 0.209348e-03_r8, 0.169705e-03_r8, 0.137569e-03_r8, 0.111518e-03_r8, 0.904008e-04_r8 /) + selfrefo(:, 3) = (/ & + & 0.102691e-02_r8, 0.930281e-03_r8, 0.842740e-03_r8, 0.763437e-03_r8, 0.691596e-03_r8, & + & 0.626516e-03_r8, 0.567560e-03_r8, 0.514152e-03_r8, 0.465769e-03_r8, 0.421940e-03_r8 /) + selfrefo(:, 4) = (/ & + & 0.388569e-02_r8, 0.365098e-02_r8, 0.343045e-02_r8, 0.322324e-02_r8, 0.302854e-02_r8, & + & 0.284561e-02_r8, 0.267372e-02_r8, 0.251222e-02_r8, 0.236047e-02_r8, 0.221789e-02_r8 /) + selfrefo(:, 5) = (/ & + & 0.349845e-01_r8, 0.326678e-01_r8, 0.305045e-01_r8, 0.284845e-01_r8, 0.265982e-01_r8, & + & 0.248369e-01_r8, 0.231921e-01_r8, 0.216563e-01_r8, 0.202222e-01_r8, 0.188831e-01_r8 /) + selfrefo(:, 6) = (/ & + & 0.613705e-01_r8, 0.562676e-01_r8, 0.515890e-01_r8, 0.472994e-01_r8, 0.433665e-01_r8, & + & 0.397606e-01_r8, 0.364545e-01_r8, 0.334233e-01_r8, 0.306442e-01_r8, 0.280961e-01_r8 /) + selfrefo(:, 7) = (/ & + & 0.656981e-01_r8, 0.602660e-01_r8, 0.552830e-01_r8, 0.507120e-01_r8, 0.465190e-01_r8, & + & 0.426726e-01_r8, 0.391443e-01_r8, 0.359077e-01_r8, 0.329387e-01_r8, 0.302153e-01_r8 /) + selfrefo(:, 8) = (/ & + & 0.671782e-01_r8, 0.616461e-01_r8, 0.565695e-01_r8, 0.519110e-01_r8, 0.476361e-01_r8, & + & 0.437132e-01_r8, 0.401134e-01_r8, 0.368100e-01_r8, 0.337787e-01_r8, 0.309970e-01_r8 /) + selfrefo(:, 9) = (/ & + & 0.675902e-01_r8, 0.620888e-01_r8, 0.570351e-01_r8, 0.523928e-01_r8, 0.481284e-01_r8, & + & 0.442110e-01_r8, 0.406125e-01_r8, 0.373069e-01_r8, 0.342703e-01_r8, 0.314809e-01_r8 /) + selfrefo(:,10) = (/ & + & 0.708308e-01_r8, 0.651419e-01_r8, 0.599099e-01_r8, 0.550981e-01_r8, 0.506728e-01_r8, & + & 0.466030e-01_r8, 0.428600e-01_r8, 0.394176e-01_r8, 0.362517e-01_r8, 0.333401e-01_r8 /) + selfrefo(:,11) = (/ & + & 0.698445e-01_r8, 0.646584e-01_r8, 0.598573e-01_r8, 0.554128e-01_r8, 0.512982e-01_r8, & + & 0.474892e-01_r8, 0.439630e-01_r8, 0.406986e-01_r8, 0.376766e-01_r8, 0.348791e-01_r8 /) + selfrefo(:,12) = (/ & + & 0.743921e-01_r8, 0.682057e-01_r8, 0.625337e-01_r8, 0.573334e-01_r8, 0.525655e-01_r8, & + & 0.481942e-01_r8, 0.441863e-01_r8, 0.405118e-01_r8, 0.371428e-01_r8, 0.340540e-01_r8 /) + selfrefo(:,13) = (/ & + & 0.775758e-01_r8, 0.709818e-01_r8, 0.649484e-01_r8, 0.594277e-01_r8, 0.543764e-01_r8, & + & 0.497544e-01_r8, 0.455253e-01_r8, 0.416556e-01_r8, 0.381149e-01_r8, 0.348751e-01_r8 /) + selfrefo(:,14) = (/ & + & 0.776545e-01_r8, 0.714761e-01_r8, 0.657894e-01_r8, 0.605550e-01_r8, 0.557372e-01_r8, & + & 0.513026e-01_r8, 0.472209e-01_r8, 0.434639e-01_r8, 0.400058e-01_r8, 0.368229e-01_r8 /) + selfrefo(:,15) = (/ & + & 0.855675e-01_r8, 0.787337e-01_r8, 0.724456e-01_r8, 0.666598e-01_r8, 0.613360e-01_r8, & + & 0.564374e-01_r8, 0.519301e-01_r8, 0.477827e-01_r8, 0.439666e-01_r8, 0.404552e-01_r8 /) + selfrefo(:,16) = (/ & + & 0.934781e-01_r8, 0.855190e-01_r8, 0.782376e-01_r8, 0.715761e-01_r8, 0.654819e-01_r8, & + & 0.599065e-01_r8, 0.548058e-01_r8, 0.501394e-01_r8, 0.458704e-01_r8, 0.419648e-01_r8 /) + + end subroutine sw_kgb20 + +! ************************************************************************** + subroutine sw_kgb21 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg21, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:, 1) = (/ & + & 16.1643_r8 , 15.5806_r8, 14.7254_r8 , 13.5541_r8 , & + & 11.9519_r8 ,10.44410_r8, 8.37884_r8 , 6.26384_r8 , & + & 4.28435_r8 ,0.465228_r8, 0.385095_r8 ,0.304226_r8 , & + & 0.222479_r8,0.143286_r8, 5.58046e-02_r8, 7.84856e-03_r8 /) + sfluxrefo(:, 2) = (/ & + & 15.6451_r8 , 15.3170_r8, 14.6987_r8 , 13.7350_r8 , & + & 12.2267_r8 ,10.51646_r8, 8.47150_r8 , 6.38873_r8 , & + & 4.33536_r8 ,0.470610_r8,0.389426_r8 ,0.306461_r8 , & + & 0.223537_r8,0.143273_r8, 5.58179e-02_r8, 7.84856e-03_r8 /) + sfluxrefo(:, 3) = (/ & + & 15.6092_r8 , 15.3293_r8, 14.6881_r8 , 13.6693_r8 , & + & 12.2342_r8 ,10.52010_r8, 8.49442_r8 , 6.42138_r8 , & + & 4.35865_r8 ,0.473349_r8,0.391349_r8 ,0.308861_r8 , & + & 0.224666_r8,0.144799_r8, 5.58176e-02_r8, 7.84881e-03_r8 /) + sfluxrefo(:, 4) = (/ & + & 15.5786_r8 , 15.3422_r8, 14.6894_r8 , 13.6040_r8 , & + & 12.2567_r8 ,10.49400_r8, 8.53521_r8 , 6.44427_r8 , & + & 4.37208_r8 ,0.475709_r8,0.392956_r8 ,0.309737_r8 , & + & 0.226274_r8,0.146483_r8, 5.59325e-02_r8, 7.84881e-03_r8 /) + sfluxrefo(:, 5) = (/ & + & 15.5380_r8 , 15.3826_r8, 14.6575_r8 , 13.5722_r8 , & + & 12.2646_r8 ,10.47672_r8, 8.57158_r8 , 6.46343_r8 , & + & 4.38259_r8 ,0.477647_r8,0.393982_r8 ,0.310686_r8 , & + & 0.227620_r8,0.148376_r8, 5.60398e-02_r8, 7.83925e-03_r8 /) + sfluxrefo(:, 6) = (/ & + & 15.5124_r8 , 15.3986_r8, 14.6240_r8 , 13.5535_r8 , & + & 12.2468_r8 ,10.48891_r8, 8.60434_r8 , 6.47985_r8 , & + & 4.39448_r8 ,0.478267_r8,0.395618_r8 ,0.311043_r8 , & + & 0.230927_r8,0.148774_r8, 5.61189e-02_r8, 7.83925e-03_r8 /) + sfluxrefo(:, 7) = (/ & + & 15.4910_r8 , 15.4028_r8, 14.5772_r8 , 13.5507_r8 , & + & 12.2122_r8 ,10.52735_r8, 8.62650_r8 , 6.49644_r8 , & + & 4.41173_r8 ,0.478627_r8,0.396433_r8 ,0.314199_r8 , & + & 0.233125_r8,0.149052_r8, 5.62309e-02_r8, 7.83925e-03_r8 /) + sfluxrefo(:, 8) = (/ & + & 15.4562_r8 , 15.3928_r8, 14.5510_r8 , 13.5122_r8 , & + & 12.1890_r8 , 10.5826_r8, 8.65842_r8 , 6.51558_r8 , & + & 4.42747_r8 ,0.480669_r8,0.400143_r8 ,0.318144_r8 , & + & 0.233937_r8,0.149119_r8, 5.62309e-02_r8, 7.83925e-03_r8 /) + sfluxrefo(:, 9) = (/ & + & 15.0069_r8 , 15.1479_r8, 14.7802_r8 , 13.6085_r8 , & + & 12.2793_r8 , 10.6929_r8, 8.72723_r8 , 6.57114_r8 , & + & 4.46330_r8 ,0.486724_r8,0.401446_r8 ,0.318879_r8 , & + & 0.233959_r8,0.149119_r8, 5.62309e-02_r8, 7.83925e-03_r8 /) + +! Rayleigh extinction coefficient at v = 6925 cm-1. + rayl = 9.41e-09_r8 + + strrat = 0.0045321_r8 + + layreffr = 8 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.31482e-07_r8,0.64010e-05_r8,0.95017e-05_r8,0.11735e-04_r8,0.13561e-04_r8, & + & 0.15077e-04_r8,0.16121e-04_r8,0.16138e-04_r8,0.41687e-06_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.29791e-07_r8,0.68206e-05_r8,0.10260e-04_r8,0.12764e-04_r8,0.14880e-04_r8, & + & 0.16665e-04_r8,0.17944e-04_r8,0.18170e-04_r8,0.44246e-06_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.28272e-07_r8,0.72448e-05_r8,0.11083e-04_r8,0.13866e-04_r8,0.16256e-04_r8, & + & 0.18323e-04_r8,0.19886e-04_r8,0.20229e-04_r8,0.47472e-06_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.26900e-07_r8,0.76935e-05_r8,0.11934e-04_r8,0.15015e-04_r8,0.17657e-04_r8, & + & 0.20038e-04_r8,0.21902e-04_r8,0.22361e-04_r8,0.50770e-06_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.25656e-07_r8,0.81661e-05_r8,0.12769e-04_r8,0.16181e-04_r8,0.19127e-04_r8, & + & 0.21755e-04_r8,0.23963e-04_r8,0.24421e-04_r8,0.54205e-06_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.26396e-07_r8,0.52225e-05_r8,0.77221e-05_r8,0.95150e-05_r8,0.11004e-04_r8, & + & 0.12195e-04_r8,0.13037e-04_r8,0.12985e-04_r8,0.32097e-06_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.24945e-07_r8,0.55737e-05_r8,0.83612e-05_r8,0.10375e-04_r8,0.12116e-04_r8, & + & 0.13569e-04_r8,0.14561e-04_r8,0.14711e-04_r8,0.34579e-06_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.23646e-07_r8,0.59333e-05_r8,0.90531e-05_r8,0.11301e-04_r8,0.13247e-04_r8, & + & 0.14956e-04_r8,0.16193e-04_r8,0.16396e-04_r8,0.37200e-06_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.22476e-07_r8,0.63144e-05_r8,0.97732e-05_r8,0.12274e-04_r8,0.14436e-04_r8, & + & 0.16377e-04_r8,0.17879e-04_r8,0.18223e-04_r8,0.40051e-06_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.21415e-07_r8,0.67133e-05_r8,0.10471e-04_r8,0.13264e-04_r8,0.15681e-04_r8, & + & 0.17843e-04_r8,0.19627e-04_r8,0.19954e-04_r8,0.42929e-06_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.22397e-07_r8,0.41930e-05_r8,0.61559e-05_r8,0.75544e-05_r8,0.86902e-05_r8, & + & 0.95896e-05_r8,0.10269e-04_r8,0.10114e-04_r8,0.24148e-06_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.21124e-07_r8,0.44837e-05_r8,0.66786e-05_r8,0.82475e-05_r8,0.96353e-05_r8, & + & 0.10742e-04_r8,0.11469e-04_r8,0.11556e-04_r8,0.26304e-06_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.19988e-07_r8,0.47839e-05_r8,0.72499e-05_r8,0.90229e-05_r8,0.10560e-04_r8, & + & 0.11900e-04_r8,0.12859e-04_r8,0.12935e-04_r8,0.28618e-06_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.18968e-07_r8,0.51040e-05_r8,0.78586e-05_r8,0.98308e-05_r8,0.11551e-04_r8, & + & 0.13094e-04_r8,0.14240e-04_r8,0.14455e-04_r8,0.30983e-06_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.18047e-07_r8,0.54366e-05_r8,0.84462e-05_r8,0.10670e-04_r8,0.12585e-04_r8, & + & 0.14313e-04_r8,0.15695e-04_r8,0.15934e-04_r8,0.33255e-06_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.19080e-07_r8,0.33409e-05_r8,0.48738e-05_r8,0.59354e-05_r8,0.67877e-05_r8, & + & 0.74900e-05_r8,0.79142e-05_r8,0.77200e-05_r8,0.18466e-06_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.17954e-07_r8,0.35910e-05_r8,0.52960e-05_r8,0.65037e-05_r8,0.75744e-05_r8, & + & 0.84082e-05_r8,0.89422e-05_r8,0.89302e-05_r8,0.20292e-06_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.16954e-07_r8,0.38317e-05_r8,0.57536e-05_r8,0.71322e-05_r8,0.83424e-05_r8, & + & 0.93788e-05_r8,0.10063e-04_r8,0.10098e-04_r8,0.22173e-06_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.16059e-07_r8,0.40932e-05_r8,0.62586e-05_r8,0.77961e-05_r8,0.91475e-05_r8, & + & 0.10347e-04_r8,0.11222e-04_r8,0.11312e-04_r8,0.24005e-06_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.15254e-07_r8,0.43678e-05_r8,0.67525e-05_r8,0.84873e-05_r8,0.99995e-05_r8, & + & 0.11353e-04_r8,0.12416e-04_r8,0.12586e-04_r8,0.25939e-06_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.16261e-07_r8,0.26540e-05_r8,0.38541e-05_r8,0.46443e-05_r8,0.52961e-05_r8, & + & 0.58054e-05_r8,0.60718e-05_r8,0.58540e-05_r8,0.14274e-06_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.15265e-07_r8,0.28598e-05_r8,0.41831e-05_r8,0.51221e-05_r8,0.59110e-05_r8, & + & 0.65207e-05_r8,0.69761e-05_r8,0.68685e-05_r8,0.15725e-06_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.14384e-07_r8,0.30623e-05_r8,0.45528e-05_r8,0.56124e-05_r8,0.65650e-05_r8, & + & 0.73436e-05_r8,0.78208e-05_r8,0.78523e-05_r8,0.17271e-06_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.13599e-07_r8,0.32720e-05_r8,0.49622e-05_r8,0.61605e-05_r8,0.72244e-05_r8, & + & 0.81582e-05_r8,0.87971e-05_r8,0.88096e-05_r8,0.18766e-06_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.12895e-07_r8,0.34985e-05_r8,0.53833e-05_r8,0.67240e-05_r8,0.79091e-05_r8, & + & 0.89688e-05_r8,0.97698e-05_r8,0.98639e-05_r8,0.20375e-06_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.13898e-07_r8,0.20981e-05_r8,0.30384e-05_r8,0.36041e-05_r8,0.41040e-05_r8, & + & 0.44334e-05_r8,0.45761e-05_r8,0.43950e-05_r8,0.11025e-06_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.13011e-07_r8,0.22645e-05_r8,0.32890e-05_r8,0.40042e-05_r8,0.45851e-05_r8, & + & 0.50473e-05_r8,0.53250e-05_r8,0.51854e-05_r8,0.12227e-06_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.12231e-07_r8,0.24322e-05_r8,0.35842e-05_r8,0.43915e-05_r8,0.51259e-05_r8, & + & 0.56903e-05_r8,0.60343e-05_r8,0.60166e-05_r8,0.13506e-06_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.11539e-07_r8,0.26032e-05_r8,0.39107e-05_r8,0.48321e-05_r8,0.56525e-05_r8, & + & 0.63625e-05_r8,0.68078e-05_r8,0.68024e-05_r8,0.14719e-06_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.10921e-07_r8,0.27866e-05_r8,0.42578e-05_r8,0.52919e-05_r8,0.62181e-05_r8, & + & 0.70362e-05_r8,0.76140e-05_r8,0.76519e-05_r8,0.16052e-06_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.11886e-07_r8,0.16563e-05_r8,0.23860e-05_r8,0.28276e-05_r8,0.31449e-05_r8, & + & 0.33771e-05_r8,0.34305e-05_r8,0.32824e-05_r8,0.84943e-07_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.11096e-07_r8,0.17874e-05_r8,0.25861e-05_r8,0.31100e-05_r8,0.35425e-05_r8, & + & 0.38737e-05_r8,0.40468e-05_r8,0.38933e-05_r8,0.94734e-07_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.10405e-07_r8,0.19286e-05_r8,0.28166e-05_r8,0.34417e-05_r8,0.39786e-05_r8, & + & 0.43804e-05_r8,0.46759e-05_r8,0.45835e-05_r8,0.10531e-06_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.97948e-08_r8,0.20680e-05_r8,0.30741e-05_r8,0.37803e-05_r8,0.44163e-05_r8, & + & 0.49420e-05_r8,0.52477e-05_r8,0.52509e-05_r8,0.11517e-06_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.92522e-08_r8,0.22140e-05_r8,0.33558e-05_r8,0.41544e-05_r8,0.48719e-05_r8, & + & 0.54968e-05_r8,0.59225e-05_r8,0.59027e-05_r8,0.12618e-06_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.10164e-07_r8,0.13056e-05_r8,0.18690e-05_r8,0.21940e-05_r8,0.24210e-05_r8, & + & 0.25504e-05_r8,0.25676e-05_r8,0.24444e-05_r8,0.66021e-07_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.94612e-08_r8,0.14106e-05_r8,0.20398e-05_r8,0.24136e-05_r8,0.27424e-05_r8, & + & 0.29578e-05_r8,0.30446e-05_r8,0.29182e-05_r8,0.73985e-07_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.88489e-08_r8,0.15256e-05_r8,0.22123e-05_r8,0.26894e-05_r8,0.30704e-05_r8, & + & 0.33808e-05_r8,0.35521e-05_r8,0.34526e-05_r8,0.82666e-07_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.83111e-08_r8,0.16396e-05_r8,0.24159e-05_r8,0.29563e-05_r8,0.34504e-05_r8, & + & 0.38196e-05_r8,0.40425e-05_r8,0.40093e-05_r8,0.90940e-07_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.78349e-08_r8,0.17570e-05_r8,0.26398e-05_r8,0.32547e-05_r8,0.38060e-05_r8, & + & 0.42813e-05_r8,0.45732e-05_r8,0.45465e-05_r8,0.10022e-06_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.86983e-08_r8,0.10284e-05_r8,0.14734e-05_r8,0.16973e-05_r8,0.18551e-05_r8, & + & 0.19223e-05_r8,0.19222e-05_r8,0.18289e-05_r8,0.53460e-07_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.80712e-08_r8,0.11141e-05_r8,0.16016e-05_r8,0.18902e-05_r8,0.21027e-05_r8, & + & 0.22504e-05_r8,0.22800e-05_r8,0.21749e-05_r8,0.60180e-07_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.75284e-08_r8,0.12033e-05_r8,0.17376e-05_r8,0.20849e-05_r8,0.23719e-05_r8, & + & 0.25906e-05_r8,0.26977e-05_r8,0.25910e-05_r8,0.66886e-07_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.70541e-08_r8,0.12979e-05_r8,0.18959e-05_r8,0.23090e-05_r8,0.26695e-05_r8, & + & 0.29367e-05_r8,0.31239e-05_r8,0.30574e-05_r8,0.73978e-07_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.66359e-08_r8,0.13937e-05_r8,0.20720e-05_r8,0.25448e-05_r8,0.29680e-05_r8, & + & 0.33208e-05_r8,0.35191e-05_r8,0.35097e-05_r8,0.81724e-07_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.74006e-08_r8,0.81705e-06_r8,0.11610e-05_r8,0.13325e-05_r8,0.14305e-05_r8, & + & 0.14668e-05_r8,0.14642e-05_r8,0.13765e-05_r8,0.44724e-07_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.68477e-08_r8,0.88306e-06_r8,0.12640e-05_r8,0.14768e-05_r8,0.16329e-05_r8, & + & 0.17209e-05_r8,0.17306e-05_r8,0.16441e-05_r8,0.50688e-07_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.63717e-08_r8,0.95522e-06_r8,0.13783e-05_r8,0.16303e-05_r8,0.18546e-05_r8, & + & 0.19963e-05_r8,0.20570e-05_r8,0.19678e-05_r8,0.56052e-07_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.59576e-08_r8,0.10331e-05_r8,0.14975e-05_r8,0.18180e-05_r8,0.20770e-05_r8, & + & 0.22813e-05_r8,0.24021e-05_r8,0.23350e-05_r8,0.62412e-07_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.55940e-08_r8,0.11102e-05_r8,0.16370e-05_r8,0.19999e-05_r8,0.23349e-05_r8, & + & 0.25900e-05_r8,0.27328e-05_r8,0.27057e-05_r8,0.69466e-07_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.60617e-08_r8,0.67167e-06_r8,0.95594e-06_r8,0.10939e-05_r8,0.11767e-05_r8, & + & 0.12059e-05_r8,0.12032e-05_r8,0.11314e-05_r8,0.37093e-07_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.56087e-08_r8,0.72704e-06_r8,0.10406e-05_r8,0.12137e-05_r8,0.13434e-05_r8, & + & 0.14171e-05_r8,0.14246e-05_r8,0.13521e-05_r8,0.41918e-07_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.52187e-08_r8,0.78681e-06_r8,0.11338e-05_r8,0.13419e-05_r8,0.15254e-05_r8, & + & 0.16426e-05_r8,0.16950e-05_r8,0.16203e-05_r8,0.46339e-07_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.48793e-08_r8,0.85013e-06_r8,0.12327e-05_r8,0.14971e-05_r8,0.17109e-05_r8, & + & 0.18776e-05_r8,0.19784e-05_r8,0.19240e-05_r8,0.51725e-07_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.45815e-08_r8,0.91420e-06_r8,0.13427e-05_r8,0.16458e-05_r8,0.19221e-05_r8, & + & 0.21323e-05_r8,0.22490e-05_r8,0.22263e-05_r8,0.57555e-07_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.49629e-08_r8,0.55223e-06_r8,0.78677e-06_r8,0.89789e-06_r8,0.96778e-06_r8, & + & 0.99148e-06_r8,0.98883e-06_r8,0.93028e-06_r8,0.30610e-07_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.45920e-08_r8,0.59832e-06_r8,0.85632e-06_r8,0.99730e-06_r8,0.11052e-05_r8, & + & 0.11665e-05_r8,0.11729e-05_r8,0.11125e-05_r8,0.34553e-07_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.42727e-08_r8,0.64760e-06_r8,0.93315e-06_r8,0.11041e-05_r8,0.12552e-05_r8, & + & 0.13521e-05_r8,0.13956e-05_r8,0.13333e-05_r8,0.38176e-07_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.39949e-08_r8,0.69926e-06_r8,0.10110e-05_r8,0.12304e-05_r8,0.14083e-05_r8, & + & 0.15442e-05_r8,0.16283e-05_r8,0.15837e-05_r8,0.42648e-07_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.37510e-08_r8,0.75239e-06_r8,0.11006e-05_r8,0.13535e-05_r8,0.15785e-05_r8, & + & 0.17547e-05_r8,0.18501e-05_r8,0.18298e-05_r8,0.47452e-07_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.40633e-08_r8,0.45378e-06_r8,0.64719e-06_r8,0.73637e-06_r8,0.79571e-06_r8, & + & 0.81503e-06_r8,0.81264e-06_r8,0.76488e-06_r8,0.25080e-07_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.37596e-08_r8,0.49208e-06_r8,0.70430e-06_r8,0.81894e-06_r8,0.90856e-06_r8, & + & 0.95919e-06_r8,0.96435e-06_r8,0.91411e-06_r8,0.28293e-07_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.34982e-08_r8,0.53259e-06_r8,0.76370e-06_r8,0.90761e-06_r8,0.10316e-05_r8, & + & 0.11116e-05_r8,0.11472e-05_r8,0.10956e-05_r8,0.31267e-07_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.32707e-08_r8,0.57488e-06_r8,0.82833e-06_r8,0.10096e-05_r8,0.11577e-05_r8, & + & 0.12688e-05_r8,0.13388e-05_r8,0.13015e-05_r8,0.34930e-07_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.30710e-08_r8,0.61832e-06_r8,0.90250e-06_r8,0.11120e-05_r8,0.12962e-05_r8, & + & 0.14424e-05_r8,0.15206e-05_r8,0.15032e-05_r8,0.38861e-07_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.14215e-06_r8,0.65726e-04_r8,0.11327e-03_r8,0.15324e-03_r8,0.18473e-03_r8, & + & 0.20658e-03_r8,0.21603e-03_r8,0.20617e-03_r8,0.13252e-04_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.13452e-06_r8,0.69521e-04_r8,0.12059e-03_r8,0.16342e-03_r8,0.19613e-03_r8, & + & 0.21987e-03_r8,0.22946e-03_r8,0.21879e-03_r8,0.14816e-04_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.12766e-06_r8,0.73313e-04_r8,0.12786e-03_r8,0.17303e-03_r8,0.20754e-03_r8, & + & 0.23326e-03_r8,0.24324e-03_r8,0.22956e-03_r8,0.16536e-04_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.12147e-06_r8,0.77087e-04_r8,0.13521e-03_r8,0.18263e-03_r8,0.21904e-03_r8, & + & 0.24614e-03_r8,0.25637e-03_r8,0.24060e-03_r8,0.18092e-04_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.11584e-06_r8,0.80946e-04_r8,0.14233e-03_r8,0.19230e-03_r8,0.23047e-03_r8, & + & 0.25869e-03_r8,0.26904e-03_r8,0.25139e-03_r8,0.19768e-04_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.11918e-06_r8,0.55167e-04_r8,0.94557e-04_r8,0.12760e-03_r8,0.15322e-03_r8, & + & 0.17148e-03_r8,0.17894e-03_r8,0.17049e-03_r8,0.10710e-04_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.11264e-06_r8,0.58581e-04_r8,0.10113e-03_r8,0.13648e-03_r8,0.16335e-03_r8, & + & 0.18288e-03_r8,0.19059e-03_r8,0.18131e-03_r8,0.12067e-04_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.10678e-06_r8,0.61935e-04_r8,0.10756e-03_r8,0.14497e-03_r8,0.17335e-03_r8, & + & 0.19437e-03_r8,0.20245e-03_r8,0.19070e-03_r8,0.13553e-04_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.10149e-06_r8,0.65261e-04_r8,0.11404e-03_r8,0.15331e-03_r8,0.18323e-03_r8, & + & 0.20559e-03_r8,0.21385e-03_r8,0.20024e-03_r8,0.14801e-04_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.96699e-07_r8,0.68698e-04_r8,0.12038e-03_r8,0.16167e-03_r8,0.19308e-03_r8, & + & 0.21635e-03_r8,0.22479e-03_r8,0.20964e-03_r8,0.16245e-04_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.10112e-06_r8,0.45399e-04_r8,0.77226e-04_r8,0.10397e-03_r8,0.12462e-03_r8, & + & 0.13956e-03_r8,0.14531e-03_r8,0.13816e-03_r8,0.83635e-05_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.95381e-07_r8,0.48357e-04_r8,0.82986e-04_r8,0.11173e-03_r8,0.13338e-03_r8, & + & 0.14898e-03_r8,0.15534e-03_r8,0.14786e-03_r8,0.94915e-05_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.90257e-07_r8,0.51355e-04_r8,0.88727e-04_r8,0.11920e-03_r8,0.14215e-03_r8, & + & 0.15859e-03_r8,0.16541e-03_r8,0.15622e-03_r8,0.10683e-04_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.85653e-07_r8,0.54322e-04_r8,0.94369e-04_r8,0.12646e-03_r8,0.15072e-03_r8, & + & 0.16838e-03_r8,0.17536e-03_r8,0.16433e-03_r8,0.11764e-04_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.81492e-07_r8,0.57300e-04_r8,0.99940e-04_r8,0.13355e-03_r8,0.15929e-03_r8, & + & 0.17800e-03_r8,0.18496e-03_r8,0.17234e-03_r8,0.12979e-04_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.86132e-07_r8,0.36910e-04_r8,0.62346e-04_r8,0.83628e-04_r8,0.10025e-03_r8, & + & 0.11224e-03_r8,0.11706e-03_r8,0.11109e-03_r8,0.64715e-05_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.81062e-07_r8,0.39490e-04_r8,0.67274e-04_r8,0.90384e-04_r8,0.10785e-03_r8, & + & 0.12026e-03_r8,0.12543e-03_r8,0.11944e-03_r8,0.73991e-05_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.76553e-07_r8,0.42055e-04_r8,0.72269e-04_r8,0.96956e-04_r8,0.11528e-03_r8, & + & 0.12833e-03_r8,0.13396e-03_r8,0.12697e-03_r8,0.83899e-05_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.72516e-07_r8,0.44696e-04_r8,0.77235e-04_r8,0.10321e-03_r8,0.12276e-03_r8, & + & 0.13674e-03_r8,0.14260e-03_r8,0.13384e-03_r8,0.93052e-05_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.68881e-07_r8,0.47273e-04_r8,0.82118e-04_r8,0.10935e-03_r8,0.13016e-03_r8, & + & 0.14506e-03_r8,0.15080e-03_r8,0.14062e-03_r8,0.10314e-04_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.73401e-07_r8,0.29772e-04_r8,0.49957e-04_r8,0.66720e-04_r8,0.80104e-04_r8, & + & 0.89761e-04_r8,0.93853e-04_r8,0.88953e-04_r8,0.50171e-05_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.68916e-07_r8,0.31976e-04_r8,0.54217e-04_r8,0.72570e-04_r8,0.86671e-04_r8, & + & 0.96653e-04_r8,0.10073e-03_r8,0.95875e-04_r8,0.57746e-05_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.64945e-07_r8,0.34219e-04_r8,0.58417e-04_r8,0.78327e-04_r8,0.92950e-04_r8, & + & 0.10358e-03_r8,0.10803e-03_r8,0.10274e-03_r8,0.66197e-05_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.61405e-07_r8,0.36457e-04_r8,0.62694e-04_r8,0.83756e-04_r8,0.99356e-04_r8, & + & 0.11058e-03_r8,0.11542e-03_r8,0.10858e-03_r8,0.73729e-05_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.58229e-07_r8,0.38713e-04_r8,0.67059e-04_r8,0.89033e-04_r8,0.10573e-03_r8, & + & 0.11764e-03_r8,0.12243e-03_r8,0.11440e-03_r8,0.82149e-05_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.62723e-07_r8,0.23750e-04_r8,0.39643e-04_r8,0.52796e-04_r8,0.63478e-04_r8, & + & 0.71151e-04_r8,0.74640e-04_r8,0.70193e-04_r8,0.38899e-05_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.58735e-07_r8,0.25657e-04_r8,0.43274e-04_r8,0.57719e-04_r8,0.69124e-04_r8, & + & 0.77375e-04_r8,0.80498e-04_r8,0.76543e-04_r8,0.44833e-05_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.55222e-07_r8,0.27563e-04_r8,0.46866e-04_r8,0.62699e-04_r8,0.74494e-04_r8, & + & 0.82946e-04_r8,0.86653e-04_r8,0.82509e-04_r8,0.51635e-05_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.52103e-07_r8,0.29528e-04_r8,0.50470e-04_r8,0.67473e-04_r8,0.79899e-04_r8, & + & 0.89004e-04_r8,0.92786e-04_r8,0.87628e-04_r8,0.58104e-05_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.49317e-07_r8,0.31444e-04_r8,0.54175e-04_r8,0.72000e-04_r8,0.85322e-04_r8, & + & 0.94885e-04_r8,0.98826e-04_r8,0.92648e-04_r8,0.64997e-05_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.53634e-07_r8,0.18862e-04_r8,0.31325e-04_r8,0.41575e-04_r8,0.50141e-04_r8, & + & 0.56190e-04_r8,0.58882e-04_r8,0.55026e-04_r8,0.29795e-05_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.50084e-07_r8,0.20474e-04_r8,0.34342e-04_r8,0.45732e-04_r8,0.54884e-04_r8, & + & 0.61494e-04_r8,0.64187e-04_r8,0.60857e-04_r8,0.34589e-05_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.46973e-07_r8,0.22063e-04_r8,0.37411e-04_r8,0.49893e-04_r8,0.59475e-04_r8, & + & 0.66279e-04_r8,0.69129e-04_r8,0.65758e-04_r8,0.39983e-05_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.44224e-07_r8,0.23764e-04_r8,0.40481e-04_r8,0.54107e-04_r8,0.64026e-04_r8, & + & 0.71350e-04_r8,0.74328e-04_r8,0.70513e-04_r8,0.45526e-05_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.41777e-07_r8,0.25434e-04_r8,0.43555e-04_r8,0.57958e-04_r8,0.68599e-04_r8, & + & 0.76304e-04_r8,0.79456e-04_r8,0.74649e-04_r8,0.51046e-05_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.45857e-07_r8,0.14945e-04_r8,0.24594e-04_r8,0.32696e-04_r8,0.39571e-04_r8, & + & 0.44348e-04_r8,0.46090e-04_r8,0.43034e-04_r8,0.22833e-05_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.42697e-07_r8,0.16265e-04_r8,0.27198e-04_r8,0.36108e-04_r8,0.43381e-04_r8, & + & 0.48642e-04_r8,0.50943e-04_r8,0.47848e-04_r8,0.26669e-05_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.39944e-07_r8,0.17616e-04_r8,0.29775e-04_r8,0.39577e-04_r8,0.47366e-04_r8, & + & 0.52791e-04_r8,0.54992e-04_r8,0.52236e-04_r8,0.30932e-05_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.37522e-07_r8,0.19042e-04_r8,0.32351e-04_r8,0.43126e-04_r8,0.51153e-04_r8, & + & 0.56987e-04_r8,0.59316e-04_r8,0.56438e-04_r8,0.35666e-05_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.35376e-07_r8,0.20476e-04_r8,0.34946e-04_r8,0.46521e-04_r8,0.55009e-04_r8, & + & 0.61221e-04_r8,0.63714e-04_r8,0.60035e-04_r8,0.40037e-05_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.39233e-07_r8,0.11817e-04_r8,0.19254e-04_r8,0.25596e-04_r8,0.30843e-04_r8, & + & 0.34574e-04_r8,0.36035e-04_r8,0.33425e-04_r8,0.17673e-05_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.36418e-07_r8,0.12914e-04_r8,0.21404e-04_r8,0.28372e-04_r8,0.34161e-04_r8, & + & 0.38321e-04_r8,0.40053e-04_r8,0.37435e-04_r8,0.20751e-05_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.33979e-07_r8,0.14026e-04_r8,0.23574e-04_r8,0.31316e-04_r8,0.37514e-04_r8, & + & 0.41977e-04_r8,0.43747e-04_r8,0.41346e-04_r8,0.24151e-05_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.31844e-07_r8,0.15205e-04_r8,0.25770e-04_r8,0.34231e-04_r8,0.40723e-04_r8, & + & 0.45315e-04_r8,0.47202e-04_r8,0.44869e-04_r8,0.28151e-05_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.29961e-07_r8,0.16420e-04_r8,0.27955e-04_r8,0.37187e-04_r8,0.43941e-04_r8, & + & 0.48873e-04_r8,0.50856e-04_r8,0.48170e-04_r8,0.31733e-05_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.33373e-07_r8,0.93505e-05_r8,0.15216e-04_r8,0.20198e-04_r8,0.24244e-04_r8, & + & 0.27077e-04_r8,0.28186e-04_r8,0.25996e-04_r8,0.13941e-05_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.30893e-07_r8,0.10284e-04_r8,0.16902e-04_r8,0.22468e-04_r8,0.27072e-04_r8, & + & 0.30382e-04_r8,0.31603e-04_r8,0.29456e-04_r8,0.16352e-05_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.28754e-07_r8,0.11207e-04_r8,0.18715e-04_r8,0.24849e-04_r8,0.29815e-04_r8, & + & 0.33379e-04_r8,0.34901e-04_r8,0.32836e-04_r8,0.19188e-05_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.26892e-07_r8,0.12172e-04_r8,0.20578e-04_r8,0.27269e-04_r8,0.32536e-04_r8, & + & 0.36182e-04_r8,0.37703e-04_r8,0.35750e-04_r8,0.22467e-05_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.25255e-07_r8,0.13195e-04_r8,0.22422e-04_r8,0.29781e-04_r8,0.35220e-04_r8, & + & 0.39157e-04_r8,0.40719e-04_r8,0.38729e-04_r8,0.25535e-05_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.27335e-07_r8,0.77491e-05_r8,0.12607e-04_r8,0.16695e-04_r8,0.20093e-04_r8, & + & 0.22431e-04_r8,0.23345e-04_r8,0.21522e-04_r8,0.11569e-05_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.25303e-07_r8,0.85322e-05_r8,0.14022e-04_r8,0.18593e-04_r8,0.22378e-04_r8, & + & 0.25133e-04_r8,0.26161e-04_r8,0.24379e-04_r8,0.13709e-05_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.23551e-07_r8,0.92912e-05_r8,0.15536e-04_r8,0.20618e-04_r8,0.24722e-04_r8, & + & 0.27647e-04_r8,0.28874e-04_r8,0.27196e-04_r8,0.16099e-05_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.22025e-07_r8,0.10117e-04_r8,0.17115e-04_r8,0.22645e-04_r8,0.26974e-04_r8, & + & 0.29947e-04_r8,0.31210e-04_r8,0.29581e-04_r8,0.18845e-05_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.20684e-07_r8,0.10977e-04_r8,0.18645e-04_r8,0.24734e-04_r8,0.29203e-04_r8, & + & 0.32453e-04_r8,0.33733e-04_r8,0.32056e-04_r8,0.21326e-05_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.22380e-07_r8,0.64144e-05_r8,0.10436e-04_r8,0.13802e-04_r8,0.16622e-04_r8, & + & 0.18557e-04_r8,0.19314e-04_r8,0.17793e-04_r8,0.95906e-06_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.20716e-07_r8,0.70603e-05_r8,0.11625e-04_r8,0.15385e-04_r8,0.18503e-04_r8, & + & 0.20776e-04_r8,0.21630e-04_r8,0.20152e-04_r8,0.11363e-05_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.19282e-07_r8,0.76960e-05_r8,0.12886e-04_r8,0.17087e-04_r8,0.20475e-04_r8, & + & 0.22867e-04_r8,0.23856e-04_r8,0.22506e-04_r8,0.13400e-05_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.18032e-07_r8,0.83983e-05_r8,0.14206e-04_r8,0.18783e-04_r8,0.22334e-04_r8, & + & 0.24764e-04_r8,0.25815e-04_r8,0.24461e-04_r8,0.15637e-05_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.16934e-07_r8,0.91186e-05_r8,0.15491e-04_r8,0.20513e-04_r8,0.24201e-04_r8, & + & 0.26864e-04_r8,0.27917e-04_r8,0.26491e-04_r8,0.17707e-05_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.18323e-07_r8,0.53022e-05_r8,0.86273e-05_r8,0.11385e-04_r8,0.13729e-04_r8, & + & 0.15318e-04_r8,0.15952e-04_r8,0.14693e-04_r8,0.78927e-06_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.16961e-07_r8,0.58316e-05_r8,0.96204e-05_r8,0.12717e-04_r8,0.15275e-04_r8, & + & 0.17141e-04_r8,0.17863e-04_r8,0.16639e-04_r8,0.93659e-06_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.15787e-07_r8,0.63710e-05_r8,0.10675e-04_r8,0.14140e-04_r8,0.16925e-04_r8, & + & 0.18881e-04_r8,0.19675e-04_r8,0.18564e-04_r8,0.11050e-05_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.14764e-07_r8,0.69607e-05_r8,0.11779e-04_r8,0.15554e-04_r8,0.18475e-04_r8, & + & 0.20461e-04_r8,0.21320e-04_r8,0.20207e-04_r8,0.12868e-05_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.13865e-07_r8,0.75611e-05_r8,0.12843e-04_r8,0.16991e-04_r8,0.20029e-04_r8, & + & 0.22208e-04_r8,0.23079e-04_r8,0.21838e-04_r8,0.14565e-05_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.55948e-06_r8,0.43472e-03_r8,0.65689e-03_r8,0.80237e-03_r8,0.90326e-03_r8, & + & 0.95995e-03_r8,0.94242e-03_r8,0.81801e-03_r8,0.18380e-03_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.53175e-06_r8,0.45395e-03_r8,0.68779e-03_r8,0.84040e-03_r8,0.94598e-03_r8, & + & 0.10011e-02_r8,0.98481e-03_r8,0.85748e-03_r8,0.19567e-03_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.50648e-06_r8,0.46835e-03_r8,0.71403e-03_r8,0.87684e-03_r8,0.98520e-03_r8, & + & 0.10393e-02_r8,0.10233e-02_r8,0.89729e-03_r8,0.20725e-03_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.48330e-06_r8,0.48143e-03_r8,0.73979e-03_r8,0.91063e-03_r8,0.10212e-02_r8, & + & 0.10762e-02_r8,0.10600e-02_r8,0.93507e-03_r8,0.21814e-03_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.46195e-06_r8,0.49413e-03_r8,0.76470e-03_r8,0.94208e-03_r8,0.10547e-02_r8, & + & 0.11099e-02_r8,0.10960e-02_r8,0.97164e-03_r8,0.23056e-03_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.46813e-06_r8,0.36711e-03_r8,0.55743e-03_r8,0.68070e-03_r8,0.76614e-03_r8, & + & 0.81442e-03_r8,0.79940e-03_r8,0.69691e-03_r8,0.14988e-03_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.44450e-06_r8,0.38413e-03_r8,0.58502e-03_r8,0.71506e-03_r8,0.80409e-03_r8, & + & 0.85191e-03_r8,0.83722e-03_r8,0.73231e-03_r8,0.15985e-03_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.42301e-06_r8,0.39744e-03_r8,0.60852e-03_r8,0.74741e-03_r8,0.83920e-03_r8, & + & 0.88588e-03_r8,0.87206e-03_r8,0.76677e-03_r8,0.16968e-03_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.40335e-06_r8,0.40927e-03_r8,0.63200e-03_r8,0.77835e-03_r8,0.87190e-03_r8, & + & 0.91843e-03_r8,0.90467e-03_r8,0.79859e-03_r8,0.17948e-03_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.38529e-06_r8,0.42034e-03_r8,0.65353e-03_r8,0.80758e-03_r8,0.90248e-03_r8, & + & 0.94929e-03_r8,0.93715e-03_r8,0.83136e-03_r8,0.19018e-03_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.39591e-06_r8,0.30459e-03_r8,0.46364e-03_r8,0.56590e-03_r8,0.63680e-03_r8, & + & 0.67681e-03_r8,0.66517e-03_r8,0.58106e-03_r8,0.11936e-03_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.37538e-06_r8,0.32036e-03_r8,0.48874e-03_r8,0.59649e-03_r8,0.67170e-03_r8, & + & 0.71161e-03_r8,0.69943e-03_r8,0.61159e-03_r8,0.12804e-03_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.35675e-06_r8,0.33321e-03_r8,0.50999e-03_r8,0.62591e-03_r8,0.70319e-03_r8, & + & 0.74333e-03_r8,0.73015e-03_r8,0.64070e-03_r8,0.13642e-03_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.33978e-06_r8,0.34382e-03_r8,0.53102e-03_r8,0.65391e-03_r8,0.73278e-03_r8, & + & 0.77303e-03_r8,0.75990e-03_r8,0.66979e-03_r8,0.14477e-03_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.32422e-06_r8,0.35416e-03_r8,0.55071e-03_r8,0.68042e-03_r8,0.76041e-03_r8, & + & 0.80118e-03_r8,0.78914e-03_r8,0.69923e-03_r8,0.15365e-03_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.33598e-06_r8,0.24970e-03_r8,0.38053e-03_r8,0.46464e-03_r8,0.52234e-03_r8, & + & 0.55488e-03_r8,0.54675e-03_r8,0.47794e-03_r8,0.95275e-04_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.31800e-06_r8,0.26415e-03_r8,0.40313e-03_r8,0.49210e-03_r8,0.55359e-03_r8, & + & 0.58661e-03_r8,0.57694e-03_r8,0.50393e-03_r8,0.10292e-03_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.30177e-06_r8,0.27638e-03_r8,0.42268e-03_r8,0.51823e-03_r8,0.58348e-03_r8, & + & 0.61591e-03_r8,0.60497e-03_r8,0.52947e-03_r8,0.11016e-03_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.28703e-06_r8,0.28612e-03_r8,0.44165e-03_r8,0.54326e-03_r8,0.61010e-03_r8, & + & 0.64299e-03_r8,0.63151e-03_r8,0.55558e-03_r8,0.11708e-03_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.27356e-06_r8,0.29550e-03_r8,0.45903e-03_r8,0.56703e-03_r8,0.63522e-03_r8, & + & 0.66839e-03_r8,0.65812e-03_r8,0.58142e-03_r8,0.12444e-03_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.28517e-06_r8,0.20305e-03_r8,0.30940e-03_r8,0.37854e-03_r8,0.42516e-03_r8, & + & 0.45167e-03_r8,0.44617e-03_r8,0.39006e-03_r8,0.76394e-04_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.26943e-06_r8,0.21631e-03_r8,0.32942e-03_r8,0.40279e-03_r8,0.45281e-03_r8, & + & 0.47959e-03_r8,0.47274e-03_r8,0.41219e-03_r8,0.83093e-04_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.25526e-06_r8,0.22760e-03_r8,0.34736e-03_r8,0.42603e-03_r8,0.47928e-03_r8, & + & 0.50573e-03_r8,0.49753e-03_r8,0.43423e-03_r8,0.89137e-04_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.24245e-06_r8,0.23661e-03_r8,0.36423e-03_r8,0.44832e-03_r8,0.50373e-03_r8, & + & 0.53021e-03_r8,0.52092e-03_r8,0.45715e-03_r8,0.95026e-04_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.23079e-06_r8,0.24490e-03_r8,0.37979e-03_r8,0.46958e-03_r8,0.52671e-03_r8, & + & 0.55360e-03_r8,0.54422e-03_r8,0.47982e-03_r8,0.10100e-03_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.24258e-06_r8,0.16374e-03_r8,0.24889e-03_r8,0.30526e-03_r8,0.34256e-03_r8, & + & 0.36437e-03_r8,0.36054e-03_r8,0.31643e-03_r8,0.60983e-04_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.22873e-06_r8,0.17557e-03_r8,0.26674e-03_r8,0.32662e-03_r8,0.36698e-03_r8, & + & 0.38862e-03_r8,0.38395e-03_r8,0.33481e-03_r8,0.66717e-04_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.21632e-06_r8,0.18596e-03_r8,0.28315e-03_r8,0.34710e-03_r8,0.39032e-03_r8, & + & 0.41186e-03_r8,0.40597e-03_r8,0.35347e-03_r8,0.71805e-04_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.20515e-06_r8,0.19412e-03_r8,0.29825e-03_r8,0.36672e-03_r8,0.41223e-03_r8, & + & 0.43370e-03_r8,0.42654e-03_r8,0.37308e-03_r8,0.76950e-04_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.19500e-06_r8,0.20163e-03_r8,0.31177e-03_r8,0.38573e-03_r8,0.43298e-03_r8, & + & 0.45474e-03_r8,0.44659e-03_r8,0.39273e-03_r8,0.81854e-04_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.20644e-06_r8,0.13088e-03_r8,0.19883e-03_r8,0.24453e-03_r8,0.27379e-03_r8, & + & 0.29133e-03_r8,0.28972e-03_r8,0.25527e-03_r8,0.48483e-04_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.19422e-06_r8,0.14123e-03_r8,0.21464e-03_r8,0.26307e-03_r8,0.29520e-03_r8, & + & 0.31262e-03_r8,0.30976e-03_r8,0.27057e-03_r8,0.53189e-04_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.18334e-06_r8,0.15056e-03_r8,0.22945e-03_r8,0.28102e-03_r8,0.31570e-03_r8, & + & 0.33336e-03_r8,0.32921e-03_r8,0.28657e-03_r8,0.57664e-04_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.17359e-06_r8,0.15845e-03_r8,0.24254e-03_r8,0.29812e-03_r8,0.33533e-03_r8, & + & 0.35273e-03_r8,0.34737e-03_r8,0.30290e-03_r8,0.62080e-04_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.16476e-06_r8,0.16515e-03_r8,0.25472e-03_r8,0.31492e-03_r8,0.35368e-03_r8, & + & 0.37134e-03_r8,0.36466e-03_r8,0.31971e-03_r8,0.66283e-04_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.17564e-06_r8,0.10377e-03_r8,0.15799e-03_r8,0.19443e-03_r8,0.21775e-03_r8, & + & 0.23221e-03_r8,0.23178e-03_r8,0.20518e-03_r8,0.38613e-04_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.16486e-06_r8,0.11291e-03_r8,0.17177e-03_r8,0.21060e-03_r8,0.23605e-03_r8, & + & 0.25023e-03_r8,0.24860e-03_r8,0.21840e-03_r8,0.42574e-04_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.15532e-06_r8,0.12160e-03_r8,0.18472e-03_r8,0.22613e-03_r8,0.25383e-03_r8, & + & 0.26813e-03_r8,0.26569e-03_r8,0.23149e-03_r8,0.46438e-04_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.14679e-06_r8,0.12871e-03_r8,0.19629e-03_r8,0.24117e-03_r8,0.27101e-03_r8, & + & 0.28546e-03_r8,0.28148e-03_r8,0.24511e-03_r8,0.50132e-04_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.13913e-06_r8,0.13470e-03_r8,0.20711e-03_r8,0.25583e-03_r8,0.28735e-03_r8, & + & 0.30171e-03_r8,0.29653e-03_r8,0.25931e-03_r8,0.53892e-04_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.14950e-06_r8,0.81941e-04_r8,0.12473e-03_r8,0.15363e-03_r8,0.17257e-03_r8, & + & 0.18409e-03_r8,0.18424e-03_r8,0.16439e-03_r8,0.30772e-04_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.13998e-06_r8,0.89702e-04_r8,0.13655e-03_r8,0.16763e-03_r8,0.18779e-03_r8, & + & 0.19919e-03_r8,0.19877e-03_r8,0.17581e-03_r8,0.34022e-04_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.13160e-06_r8,0.97263e-04_r8,0.14776e-03_r8,0.18089e-03_r8,0.20292e-03_r8, & + & 0.21451e-03_r8,0.21317e-03_r8,0.18640e-03_r8,0.37381e-04_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.12415e-06_r8,0.10389e-03_r8,0.15817e-03_r8,0.19404e-03_r8,0.21794e-03_r8, & + & 0.22980e-03_r8,0.22715e-03_r8,0.19784e-03_r8,0.40457e-04_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.11749e-06_r8,0.10934e-03_r8,0.16768e-03_r8,0.20680e-03_r8,0.23234e-03_r8, & + & 0.24414e-03_r8,0.24026e-03_r8,0.20959e-03_r8,0.43586e-04_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.12658e-06_r8,0.64763e-04_r8,0.98690e-04_r8,0.12170e-03_r8,0.13709e-03_r8, & + & 0.14644e-03_r8,0.14709e-03_r8,0.13215e-03_r8,0.24737e-04_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.11826e-06_r8,0.71405e-04_r8,0.10875e-03_r8,0.13368e-03_r8,0.14978e-03_r8, & + & 0.15901e-03_r8,0.15937e-03_r8,0.14153e-03_r8,0.27487e-04_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.11097e-06_r8,0.77857e-04_r8,0.11842e-03_r8,0.14510e-03_r8,0.16261e-03_r8, & + & 0.17204e-03_r8,0.17129e-03_r8,0.15041e-03_r8,0.30250e-04_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.10451e-06_r8,0.83764e-04_r8,0.12762e-03_r8,0.15625e-03_r8,0.17544e-03_r8, & + & 0.18516e-03_r8,0.18345e-03_r8,0.16010e-03_r8,0.32891e-04_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.98767e-07_r8,0.88833e-04_r8,0.13595e-03_r8,0.16723e-03_r8,0.18798e-03_r8, & + & 0.19766e-03_r8,0.19477e-03_r8,0.16979e-03_r8,0.35547e-04_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.10368e-06_r8,0.53714e-04_r8,0.81748e-04_r8,0.10085e-03_r8,0.11349e-03_r8, & + & 0.12126e-03_r8,0.12180e-03_r8,0.10950e-03_r8,0.20787e-04_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.96854e-07_r8,0.59175e-04_r8,0.90131e-04_r8,0.11085e-03_r8,0.12425e-03_r8, & + & 0.13166e-03_r8,0.13207e-03_r8,0.11733e-03_r8,0.23028e-04_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.90882e-07_r8,0.64593e-04_r8,0.98275e-04_r8,0.12041e-03_r8,0.13497e-03_r8, & + & 0.14273e-03_r8,0.14215e-03_r8,0.12479e-03_r8,0.25362e-04_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.85602e-07_r8,0.69545e-04_r8,0.10592e-03_r8,0.12982e-03_r8,0.14583e-03_r8, & + & 0.15388e-03_r8,0.15228e-03_r8,0.13297e-03_r8,0.27585e-04_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.80889e-07_r8,0.73731e-04_r8,0.11290e-03_r8,0.13914e-03_r8,0.15637e-03_r8, & + & 0.16431e-03_r8,0.16189e-03_r8,0.14116e-03_r8,0.29828e-04_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.84886e-07_r8,0.44418e-04_r8,0.67641e-04_r8,0.83490e-04_r8,0.93906e-04_r8, & + & 0.10034e-03_r8,0.10075e-03_r8,0.90614e-04_r8,0.17350e-04_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.79297e-07_r8,0.48981e-04_r8,0.74656e-04_r8,0.91821e-04_r8,0.10299e-03_r8, & + & 0.10891e-03_r8,0.10933e-03_r8,0.97221e-04_r8,0.19237e-04_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.74408e-07_r8,0.53553e-04_r8,0.81503e-04_r8,0.99872e-04_r8,0.11196e-03_r8, & + & 0.11832e-03_r8,0.11782e-03_r8,0.10341e-03_r8,0.21189e-04_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.70085e-07_r8,0.57698e-04_r8,0.87887e-04_r8,0.10781e-03_r8,0.12107e-03_r8, & + & 0.12775e-03_r8,0.12624e-03_r8,0.11034e-03_r8,0.23038e-04_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.66226e-07_r8,0.61177e-04_r8,0.93694e-04_r8,0.11567e-03_r8,0.12995e-03_r8, & + & 0.13645e-03_r8,0.13436e-03_r8,0.11726e-03_r8,0.24913e-04_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.69499e-07_r8,0.36716e-04_r8,0.55902e-04_r8,0.69067e-04_r8,0.77635e-04_r8, & + & 0.82934e-04_r8,0.83302e-04_r8,0.74905e-04_r8,0.14419e-04_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.64923e-07_r8,0.40511e-04_r8,0.61779e-04_r8,0.75984e-04_r8,0.85239e-04_r8, & + & 0.90090e-04_r8,0.90456e-04_r8,0.80264e-04_r8,0.15996e-04_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.60920e-07_r8,0.44356e-04_r8,0.67533e-04_r8,0.82746e-04_r8,0.92816e-04_r8, & + & 0.98017e-04_r8,0.97590e-04_r8,0.85621e-04_r8,0.17623e-04_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.57381e-07_r8,0.47826e-04_r8,0.72874e-04_r8,0.89443e-04_r8,0.10040e-03_r8, & + & 0.10588e-03_r8,0.10456e-03_r8,0.91429e-04_r8,0.19144e-04_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.54221e-07_r8,0.50750e-04_r8,0.77698e-04_r8,0.96005e-04_r8,0.10784e-03_r8, & + & 0.11318e-03_r8,0.11139e-03_r8,0.97258e-04_r8,0.20671e-04_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.36654e-05_r8,0.13689e-02_r8,0.21108e-02_r8,0.26314e-02_r8,0.29458e-02_r8, & + & 0.30831e-02_r8,0.30207e-02_r8,0.26003e-02_r8,0.93689e-03_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.35304e-05_r8,0.14025e-02_r8,0.21716e-02_r8,0.27078e-02_r8,0.30551e-02_r8, & + & 0.31948e-02_r8,0.31649e-02_r8,0.27258e-02_r8,0.97983e-03_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.34059e-05_r8,0.14340e-02_r8,0.22214e-02_r8,0.27773e-02_r8,0.31348e-02_r8, & + & 0.33049e-02_r8,0.32835e-02_r8,0.28461e-02_r8,0.10251e-02_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.32895e-05_r8,0.14610e-02_r8,0.22596e-02_r8,0.28314e-02_r8,0.32113e-02_r8, & + & 0.34131e-02_r8,0.33921e-02_r8,0.29508e-02_r8,0.10730e-02_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.31814e-05_r8,0.14814e-02_r8,0.22905e-02_r8,0.28789e-02_r8,0.32785e-02_r8, & + & 0.34996e-02_r8,0.34952e-02_r8,0.30528e-02_r8,0.11205e-02_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.30293e-05_r8,0.11600e-02_r8,0.17946e-02_r8,0.22370e-02_r8,0.25205e-02_r8, & + & 0.26432e-02_r8,0.26172e-02_r8,0.22691e-02_r8,0.78466e-03_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.29173e-05_r8,0.11916e-02_r8,0.18468e-02_r8,0.23072e-02_r8,0.26094e-02_r8, & + & 0.27477e-02_r8,0.27388e-02_r8,0.23809e-02_r8,0.82356e-03_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.28152e-05_r8,0.12203e-02_r8,0.18939e-02_r8,0.23691e-02_r8,0.26814e-02_r8, & + & 0.28506e-02_r8,0.28414e-02_r8,0.24825e-02_r8,0.86161e-03_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.27207e-05_r8,0.12454e-02_r8,0.19291e-02_r8,0.24180e-02_r8,0.27489e-02_r8, & + & 0.29380e-02_r8,0.29345e-02_r8,0.25808e-02_r8,0.90328e-03_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.26316e-05_r8,0.12644e-02_r8,0.19586e-02_r8,0.24624e-02_r8,0.28146e-02_r8, & + & 0.30125e-02_r8,0.30237e-02_r8,0.26695e-02_r8,0.94678e-03_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.25288e-05_r8,0.97348e-03_r8,0.15070e-02_r8,0.18795e-02_r8,0.21206e-02_r8, & + & 0.22362e-02_r8,0.22210e-02_r8,0.19369e-02_r8,0.64308e-03_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.24353e-05_r8,0.10031e-02_r8,0.15552e-02_r8,0.19441e-02_r8,0.22013e-02_r8, & + & 0.23257e-02_r8,0.23286e-02_r8,0.20362e-02_r8,0.67529e-03_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.23495e-05_r8,0.10295e-02_r8,0.15986e-02_r8,0.20019e-02_r8,0.22663e-02_r8, & + & 0.24160e-02_r8,0.24204e-02_r8,0.21276e-02_r8,0.70991e-03_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.22699e-05_r8,0.10533e-02_r8,0.16337e-02_r8,0.20489e-02_r8,0.23288e-02_r8, & + & 0.24911e-02_r8,0.25016e-02_r8,0.22148e-02_r8,0.74635e-03_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.21951e-05_r8,0.10724e-02_r8,0.16625e-02_r8,0.20891e-02_r8,0.23896e-02_r8, & + & 0.25582e-02_r8,0.25812e-02_r8,0.22925e-02_r8,0.78432e-03_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.21169e-05_r8,0.81053e-03_r8,0.12568e-02_r8,0.15647e-02_r8,0.17654e-02_r8, & + & 0.18662e-02_r8,0.18568e-02_r8,0.16269e-02_r8,0.52608e-03_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.20407e-05_r8,0.83875e-03_r8,0.13019e-02_r8,0.16252e-02_r8,0.18383e-02_r8, & + & 0.19441e-02_r8,0.19538e-02_r8,0.17139e-02_r8,0.55325e-03_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.19674e-05_r8,0.86329e-03_r8,0.13417e-02_r8,0.16788e-02_r8,0.18985e-02_r8, & + & 0.20246e-02_r8,0.20315e-02_r8,0.17978e-02_r8,0.58253e-03_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.18994e-05_r8,0.88551e-03_r8,0.13753e-02_r8,0.17238e-02_r8,0.19566e-02_r8, & + & 0.20923e-02_r8,0.21035e-02_r8,0.18724e-02_r8,0.61438e-03_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.18358e-05_r8,0.90442e-03_r8,0.14042e-02_r8,0.17619e-02_r8,0.20119e-02_r8, & + & 0.21542e-02_r8,0.21749e-02_r8,0.19425e-02_r8,0.64762e-03_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.17725e-05_r8,0.67146e-03_r8,0.10396e-02_r8,0.12935e-02_r8,0.14576e-02_r8, & + & 0.15437e-02_r8,0.15341e-02_r8,0.13532e-02_r8,0.42981e-03_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.17095e-05_r8,0.69774e-03_r8,0.10823e-02_r8,0.13477e-02_r8,0.15227e-02_r8, & + & 0.16117e-02_r8,0.16222e-02_r8,0.14302e-02_r8,0.45286e-03_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.16478e-05_r8,0.72044e-03_r8,0.11190e-02_r8,0.13967e-02_r8,0.15783e-02_r8, & + & 0.16817e-02_r8,0.16897e-02_r8,0.15040e-02_r8,0.47782e-03_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.15896e-05_r8,0.74136e-03_r8,0.11512e-02_r8,0.14394e-02_r8,0.16307e-02_r8, & + & 0.17435e-02_r8,0.17536e-02_r8,0.15687e-02_r8,0.50468e-03_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.15353e-05_r8,0.75977e-03_r8,0.11790e-02_r8,0.14755e-02_r8,0.16811e-02_r8, & + & 0.17990e-02_r8,0.18175e-02_r8,0.16279e-02_r8,0.53353e-03_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.14856e-05_r8,0.55163e-03_r8,0.85182e-03_r8,0.10583e-02_r8,0.11933e-02_r8, & + & 0.12633e-02_r8,0.12519e-02_r8,0.11126e-02_r8,0.34969e-03_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.14323e-05_r8,0.57534e-03_r8,0.89211e-03_r8,0.11084e-02_r8,0.12510e-02_r8, & + & 0.13248e-02_r8,0.13302e-02_r8,0.11815e-02_r8,0.36893e-03_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.13818e-05_r8,0.59705e-03_r8,0.92552e-03_r8,0.11530e-02_r8,0.13018e-02_r8, & + & 0.13860e-02_r8,0.13942e-02_r8,0.12437e-02_r8,0.38991e-03_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.13317e-05_r8,0.61671e-03_r8,0.95568e-03_r8,0.11922e-02_r8,0.13481e-02_r8, & + & 0.14426e-02_r8,0.14508e-02_r8,0.13001e-02_r8,0.41248e-03_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.12851e-05_r8,0.63414e-03_r8,0.98227e-03_r8,0.12265e-02_r8,0.13936e-02_r8, & + & 0.14913e-02_r8,0.15064e-02_r8,0.13512e-02_r8,0.43696e-03_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.12453e-05_r8,0.44982e-03_r8,0.69286e-03_r8,0.85857e-03_r8,0.97115e-03_r8, & + & 0.10268e-02_r8,0.10132e-02_r8,0.90661e-03_r8,0.28333e-03_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.11997e-05_r8,0.47163e-03_r8,0.72984e-03_r8,0.90525e-03_r8,0.10209e-02_r8, & + & 0.10830e-02_r8,0.10815e-02_r8,0.96820e-03_r8,0.29991e-03_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.11571e-05_r8,0.49170e-03_r8,0.76064e-03_r8,0.94597e-03_r8,0.10683e-02_r8, & + & 0.11337e-02_r8,0.11418e-02_r8,0.10210e-02_r8,0.31738e-03_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.11157e-05_r8,0.50964e-03_r8,0.78859e-03_r8,0.98236e-03_r8,0.11088e-02_r8, & + & 0.11859e-02_r8,0.11920e-02_r8,0.10690e-02_r8,0.33600e-03_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.10757e-05_r8,0.52578e-03_r8,0.81330e-03_r8,0.10141e-02_r8,0.11493e-02_r8, & + & 0.12285e-02_r8,0.12399e-02_r8,0.11151e-02_r8,0.35631e-03_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.10436e-05_r8,0.36475e-03_r8,0.55948e-03_r8,0.69399e-03_r8,0.78699e-03_r8, & + & 0.82733e-03_r8,0.81546e-03_r8,0.73443e-03_r8,0.22874e-03_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.10043e-05_r8,0.38461e-03_r8,0.59365e-03_r8,0.73631e-03_r8,0.82902e-03_r8, & + & 0.87996e-03_r8,0.87589e-03_r8,0.78745e-03_r8,0.24281e-03_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.96785e-06_r8,0.40227e-03_r8,0.62191e-03_r8,0.77183e-03_r8,0.87067e-03_r8, & + & 0.92338e-03_r8,0.93116e-03_r8,0.83334e-03_r8,0.25735e-03_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.93367e-06_r8,0.41881e-03_r8,0.64697e-03_r8,0.80474e-03_r8,0.90754e-03_r8, & + & 0.96806e-03_r8,0.97434e-03_r8,0.87439e-03_r8,0.27286e-03_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.90017e-06_r8,0.43377e-03_r8,0.67026e-03_r8,0.83398e-03_r8,0.94269e-03_r8, & + & 0.10080e-02_r8,0.10154e-02_r8,0.91479e-03_r8,0.28948e-03_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.87469e-06_r8,0.29345e-03_r8,0.44857e-03_r8,0.55653e-03_r8,0.63371e-03_r8, & + & 0.66253e-03_r8,0.65229e-03_r8,0.59009e-03_r8,0.18475e-03_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.84062e-06_r8,0.31152e-03_r8,0.47975e-03_r8,0.59422e-03_r8,0.67077e-03_r8, & + & 0.71168e-03_r8,0.70550e-03_r8,0.63674e-03_r8,0.19669e-03_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.80947e-06_r8,0.32779e-03_r8,0.50582e-03_r8,0.62707e-03_r8,0.70705e-03_r8, & + & 0.74936e-03_r8,0.75252e-03_r8,0.67682e-03_r8,0.20896e-03_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.78052e-06_r8,0.34262e-03_r8,0.52820e-03_r8,0.65631e-03_r8,0.74002e-03_r8, & + & 0.78731e-03_r8,0.79257e-03_r8,0.71155e-03_r8,0.22197e-03_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.75300e-06_r8,0.35618e-03_r8,0.54940e-03_r8,0.68236e-03_r8,0.76978e-03_r8, & + & 0.82271e-03_r8,0.82806e-03_r8,0.74658e-03_r8,0.23588e-03_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.73080e-06_r8,0.23619e-03_r8,0.36002e-03_r8,0.44769e-03_r8,0.51001e-03_r8, & + & 0.53294e-03_r8,0.52319e-03_r8,0.47492e-03_r8,0.15005e-03_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.70142e-06_r8,0.25225e-03_r8,0.38742e-03_r8,0.48039e-03_r8,0.54285e-03_r8, & + & 0.57407e-03_r8,0.56765e-03_r8,0.51444e-03_r8,0.16000e-03_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.67484e-06_r8,0.26687e-03_r8,0.41119e-03_r8,0.50924e-03_r8,0.57372e-03_r8, & + & 0.60912e-03_r8,0.60813e-03_r8,0.54945e-03_r8,0.17036e-03_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.65032e-06_r8,0.28002e-03_r8,0.43104e-03_r8,0.53513e-03_r8,0.60294e-03_r8, & + & 0.63998e-03_r8,0.64485e-03_r8,0.57888e-03_r8,0.18120e-03_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.62752e-06_r8,0.29182e-03_r8,0.44950e-03_r8,0.55836e-03_r8,0.62849e-03_r8, & + & 0.67148e-03_r8,0.67570e-03_r8,0.60918e-03_r8,0.19271e-03_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.59846e-06_r8,0.19603e-03_r8,0.29902e-03_r8,0.37159e-03_r8,0.42367e-03_r8, & + & 0.44241e-03_r8,0.43550e-03_r8,0.39618e-03_r8,0.12498e-03_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.57447e-06_r8,0.20953e-03_r8,0.32187e-03_r8,0.39882e-03_r8,0.45021e-03_r8, & + & 0.47717e-03_r8,0.47240e-03_r8,0.42894e-03_r8,0.13362e-03_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.55265e-06_r8,0.22185e-03_r8,0.34133e-03_r8,0.42283e-03_r8,0.47616e-03_r8, & + & 0.50481e-03_r8,0.50553e-03_r8,0.45654e-03_r8,0.14246e-03_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.53259e-06_r8,0.23301e-03_r8,0.35816e-03_r8,0.44448e-03_r8,0.50048e-03_r8, & + & 0.53147e-03_r8,0.53574e-03_r8,0.48169e-03_r8,0.15168e-03_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.51379e-06_r8,0.24302e-03_r8,0.37383e-03_r8,0.46352e-03_r8,0.52203e-03_r8, & + & 0.55783e-03_r8,0.56175e-03_r8,0.50737e-03_r8,0.16153e-03_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.49006e-06_r8,0.16259e-03_r8,0.24802e-03_r8,0.30804e-03_r8,0.35111e-03_r8, & + & 0.36672e-03_r8,0.36166e-03_r8,0.32968e-03_r8,0.10401e-03_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.47033e-06_r8,0.17379e-03_r8,0.26697e-03_r8,0.33069e-03_r8,0.37292e-03_r8, & + & 0.39587e-03_r8,0.39239e-03_r8,0.35672e-03_r8,0.11138e-03_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.45247e-06_r8,0.18417e-03_r8,0.28295e-03_r8,0.35045e-03_r8,0.39465e-03_r8, & + & 0.41825e-03_r8,0.41984e-03_r8,0.37867e-03_r8,0.11882e-03_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.43605e-06_r8,0.19351e-03_r8,0.29716e-03_r8,0.36850e-03_r8,0.41489e-03_r8, & + & 0.44074e-03_r8,0.44460e-03_r8,0.40031e-03_r8,0.12667e-03_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.42066e-06_r8,0.20206e-03_r8,0.31038e-03_r8,0.38464e-03_r8,0.43337e-03_r8, & + & 0.46297e-03_r8,0.46667e-03_r8,0.42202e-03_r8,0.13498e-03_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.40122e-06_r8,0.13465e-03_r8,0.20541e-03_r8,0.25488e-03_r8,0.29006e-03_r8, & + & 0.30358e-03_r8,0.29984e-03_r8,0.27375e-03_r8,0.86406e-04_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.38502e-06_r8,0.14398e-03_r8,0.22086e-03_r8,0.27376e-03_r8,0.30832e-03_r8, & + & 0.32794e-03_r8,0.32517e-03_r8,0.29562e-03_r8,0.92614e-04_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.37045e-06_r8,0.15266e-03_r8,0.23416e-03_r8,0.29013e-03_r8,0.32675e-03_r8, & + & 0.34622e-03_r8,0.34816e-03_r8,0.31401e-03_r8,0.98880e-04_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.35702e-06_r8,0.16050e-03_r8,0.24608e-03_r8,0.30521e-03_r8,0.34336e-03_r8, & + & 0.36522e-03_r8,0.36857e-03_r8,0.33246e-03_r8,0.10559e-03_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.34440e-06_r8,0.16771e-03_r8,0.25742e-03_r8,0.31904e-03_r8,0.35943e-03_r8, & + & 0.38405e-03_r8,0.38715e-03_r8,0.35087e-03_r8,0.11262e-03_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.15583e-03_r8,0.37546e-02_r8,0.53536e-02_r8,0.64161e-02_r8,0.71223e-02_r8, & + & 0.74982e-02_r8,0.73596e-02_r8,0.65135e-02_r8,0.35175e-02_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.16148e-03_r8,0.38569e-02_r8,0.55256e-02_r8,0.66461e-02_r8,0.73757e-02_r8, & + & 0.77530e-02_r8,0.75665e-02_r8,0.66496e-02_r8,0.36840e-02_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.16484e-03_r8,0.39353e-02_r8,0.56745e-02_r8,0.68364e-02_r8,0.76166e-02_r8, & + & 0.79711e-02_r8,0.77717e-02_r8,0.67846e-02_r8,0.38485e-02_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.16621e-03_r8,0.39946e-02_r8,0.57947e-02_r8,0.70071e-02_r8,0.78193e-02_r8, & + & 0.81581e-02_r8,0.79592e-02_r8,0.69132e-02_r8,0.39769e-02_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.16518e-03_r8,0.40386e-02_r8,0.58925e-02_r8,0.71530e-02_r8,0.79946e-02_r8, & + & 0.83258e-02_r8,0.81107e-02_r8,0.70226e-02_r8,0.41134e-02_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.12482e-03_r8,0.32204e-02_r8,0.46102e-02_r8,0.55475e-02_r8,0.61730e-02_r8, & + & 0.65000e-02_r8,0.63942e-02_r8,0.56394e-02_r8,0.30002e-02_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.13027e-03_r8,0.33099e-02_r8,0.47617e-02_r8,0.57497e-02_r8,0.64031e-02_r8, & + & 0.67184e-02_r8,0.65829e-02_r8,0.57721e-02_r8,0.31442e-02_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.13370e-03_r8,0.33808e-02_r8,0.48845e-02_r8,0.59235e-02_r8,0.66074e-02_r8, & + & 0.69048e-02_r8,0.67660e-02_r8,0.59018e-02_r8,0.32788e-02_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.13549e-03_r8,0.34340e-02_r8,0.49885e-02_r8,0.60745e-02_r8,0.67877e-02_r8, & + & 0.70780e-02_r8,0.69202e-02_r8,0.60131e-02_r8,0.33946e-02_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.13543e-03_r8,0.34778e-02_r8,0.50745e-02_r8,0.61981e-02_r8,0.69282e-02_r8, & + & 0.72229e-02_r8,0.70521e-02_r8,0.61218e-02_r8,0.35097e-02_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.98437e-04_r8,0.27209e-02_r8,0.39035e-02_r8,0.47185e-02_r8,0.52706e-02_r8, & + & 0.55579e-02_r8,0.54846e-02_r8,0.48469e-02_r8,0.25077e-02_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.10396e-03_r8,0.28031e-02_r8,0.40384e-02_r8,0.48993e-02_r8,0.54753e-02_r8, & + & 0.57575e-02_r8,0.56525e-02_r8,0.49684e-02_r8,0.26366e-02_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.10770e-03_r8,0.28702e-02_r8,0.41513e-02_r8,0.50504e-02_r8,0.56640e-02_r8, & + & 0.59245e-02_r8,0.58125e-02_r8,0.50922e-02_r8,0.27478e-02_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.10996e-03_r8,0.29232e-02_r8,0.42451e-02_r8,0.51838e-02_r8,0.58257e-02_r8, & + & 0.60793e-02_r8,0.59498e-02_r8,0.51949e-02_r8,0.28490e-02_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.11088e-03_r8,0.29645e-02_r8,0.43251e-02_r8,0.52992e-02_r8,0.59468e-02_r8, & + & 0.62096e-02_r8,0.60648e-02_r8,0.52904e-02_r8,0.29495e-02_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.76587e-04_r8,0.22792e-02_r8,0.32731e-02_r8,0.39724e-02_r8,0.44561e-02_r8, & + & 0.47109e-02_r8,0.46706e-02_r8,0.41444e-02_r8,0.20810e-02_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.82225e-04_r8,0.23548e-02_r8,0.33943e-02_r8,0.41325e-02_r8,0.46415e-02_r8, & + & 0.48939e-02_r8,0.48200e-02_r8,0.42591e-02_r8,0.21925e-02_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.86203e-04_r8,0.24180e-02_r8,0.34991e-02_r8,0.42684e-02_r8,0.48074e-02_r8, & + & 0.50416e-02_r8,0.49651e-02_r8,0.43643e-02_r8,0.22938e-02_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.88766e-04_r8,0.24694e-02_r8,0.35874e-02_r8,0.43875e-02_r8,0.49469e-02_r8, & + & 0.51810e-02_r8,0.50850e-02_r8,0.44606e-02_r8,0.23791e-02_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.90218e-04_r8,0.25110e-02_r8,0.36613e-02_r8,0.44937e-02_r8,0.50548e-02_r8, & + & 0.52982e-02_r8,0.51883e-02_r8,0.45498e-02_r8,0.24658e-02_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.59080e-04_r8,0.18972e-02_r8,0.27294e-02_r8,0.33195e-02_r8,0.37395e-02_r8, & + & 0.39683e-02_r8,0.39523e-02_r8,0.35161e-02_r8,0.17195e-02_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.64508e-04_r8,0.19673e-02_r8,0.28376e-02_r8,0.34632e-02_r8,0.39033e-02_r8, & + & 0.41343e-02_r8,0.40826e-02_r8,0.36195e-02_r8,0.18173e-02_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.68538e-04_r8,0.20264e-02_r8,0.29342e-02_r8,0.35856e-02_r8,0.40488e-02_r8, & + & 0.42664e-02_r8,0.42141e-02_r8,0.37144e-02_r8,0.19081e-02_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.71328e-04_r8,0.20750e-02_r8,0.30165e-02_r8,0.36933e-02_r8,0.41719e-02_r8, & + & 0.43880e-02_r8,0.43221e-02_r8,0.38006e-02_r8,0.19818e-02_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.73073e-04_r8,0.21155e-02_r8,0.30861e-02_r8,0.37892e-02_r8,0.42690e-02_r8, & + & 0.44901e-02_r8,0.44161e-02_r8,0.38864e-02_r8,0.20583e-02_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.45069e-04_r8,0.15673e-02_r8,0.22596e-02_r8,0.27566e-02_r8,0.31117e-02_r8, & + & 0.33162e-02_r8,0.33135e-02_r8,0.29574e-02_r8,0.14089e-02_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.49959e-04_r8,0.16342e-02_r8,0.23577e-02_r8,0.28828e-02_r8,0.32572e-02_r8, & + & 0.34626e-02_r8,0.34302e-02_r8,0.30476e-02_r8,0.14955e-02_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.54013e-04_r8,0.16891e-02_r8,0.24457e-02_r8,0.29926e-02_r8,0.33865e-02_r8, & + & 0.35809e-02_r8,0.35427e-02_r8,0.31358e-02_r8,0.15763e-02_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.56910e-04_r8,0.17356e-02_r8,0.25220e-02_r8,0.30903e-02_r8,0.34968e-02_r8, & + & 0.36853e-02_r8,0.36443e-02_r8,0.32140e-02_r8,0.16428e-02_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.58852e-04_r8,0.17743e-02_r8,0.25868e-02_r8,0.31771e-02_r8,0.35857e-02_r8, & + & 0.37782e-02_r8,0.37284e-02_r8,0.32905e-02_r8,0.17079e-02_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.34131e-04_r8,0.12873e-02_r8,0.18619e-02_r8,0.22745e-02_r8,0.25688e-02_r8, & + & 0.27494e-02_r8,0.27574e-02_r8,0.24658e-02_r8,0.11444e-02_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.38379e-04_r8,0.13503e-02_r8,0.19490e-02_r8,0.23869e-02_r8,0.26985e-02_r8, & + & 0.28761e-02_r8,0.28607e-02_r8,0.25443e-02_r8,0.12242e-02_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.42146e-04_r8,0.14018e-02_r8,0.20287e-02_r8,0.24843e-02_r8,0.28119e-02_r8, & + & 0.29848e-02_r8,0.29569e-02_r8,0.26258e-02_r8,0.12956e-02_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.45116e-04_r8,0.14454e-02_r8,0.20989e-02_r8,0.25718e-02_r8,0.29115e-02_r8, & + & 0.30740e-02_r8,0.30482e-02_r8,0.26967e-02_r8,0.13537e-02_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.47178e-04_r8,0.14818e-02_r8,0.21591e-02_r8,0.26509e-02_r8,0.29945e-02_r8, & + & 0.31590e-02_r8,0.31235e-02_r8,0.27641e-02_r8,0.14100e-02_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.25656e-04_r8,0.10525e-02_r8,0.15266e-02_r8,0.18648e-02_r8,0.21060e-02_r8, & + & 0.22660e-02_r8,0.22807e-02_r8,0.20415e-02_r8,0.92482e-03_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.29313e-04_r8,0.11096e-02_r8,0.16027e-02_r8,0.19628e-02_r8,0.22224e-02_r8, & + & 0.23730e-02_r8,0.23683e-02_r8,0.21111e-02_r8,0.99366e-03_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.32643e-04_r8,0.11579e-02_r8,0.16732e-02_r8,0.20503e-02_r8,0.23231e-02_r8, & + & 0.24721e-02_r8,0.24512e-02_r8,0.21842e-02_r8,0.10570e-02_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.35509e-04_r8,0.11985e-02_r8,0.17379e-02_r8,0.21284e-02_r8,0.24110e-02_r8, & + & 0.25519e-02_r8,0.25339e-02_r8,0.22496e-02_r8,0.11116e-02_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.37616e-04_r8,0.12327e-02_r8,0.17933e-02_r8,0.21996e-02_r8,0.24880e-02_r8, & + & 0.26258e-02_r8,0.26029e-02_r8,0.23088e-02_r8,0.11595e-02_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.19166e-04_r8,0.85559e-03_r8,0.12446e-02_r8,0.15213e-02_r8,0.17160e-02_r8, & + & 0.18527e-02_r8,0.18723e-02_r8,0.16794e-02_r8,0.74316e-03_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.22251e-04_r8,0.90701e-03_r8,0.13107e-02_r8,0.16061e-02_r8,0.18177e-02_r8, & + & 0.19452e-02_r8,0.19496e-02_r8,0.17420e-02_r8,0.80168e-03_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.25123e-04_r8,0.95106e-03_r8,0.13724e-02_r8,0.16826e-02_r8,0.19064e-02_r8, & + & 0.20352e-02_r8,0.20241e-02_r8,0.18064e-02_r8,0.85659e-03_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.27713e-04_r8,0.98903e-03_r8,0.14301e-02_r8,0.17523e-02_r8,0.19862e-02_r8, & + & 0.21079e-02_r8,0.20944e-02_r8,0.18656e-02_r8,0.90655e-03_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.29821e-04_r8,0.10207e-02_r8,0.14813e-02_r8,0.18163e-02_r8,0.20570e-02_r8, & + & 0.21737e-02_r8,0.21574e-02_r8,0.19153e-02_r8,0.94882e-03_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.14455e-04_r8,0.69508e-03_r8,0.10143e-02_r8,0.12382e-02_r8,0.13977e-02_r8, & + & 0.15101e-02_r8,0.15339e-02_r8,0.13794e-02_r8,0.60064e-03_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.16975e-04_r8,0.74055e-03_r8,0.10715e-02_r8,0.13117e-02_r8,0.14851e-02_r8, & + & 0.15938e-02_r8,0.16026e-02_r8,0.14354e-02_r8,0.65034e-03_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.19421e-04_r8,0.77996e-03_r8,0.11243e-02_r8,0.13791e-02_r8,0.15636e-02_r8, & + & 0.16707e-02_r8,0.16678e-02_r8,0.14908e-02_r8,0.69875e-03_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.21659e-04_r8,0.81369e-03_r8,0.11746e-02_r8,0.14408e-02_r8,0.16340e-02_r8, & + & 0.17376e-02_r8,0.17267e-02_r8,0.15418e-02_r8,0.74336e-03_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.23616e-04_r8,0.84316e-03_r8,0.12215e-02_r8,0.14972e-02_r8,0.16971e-02_r8, & + & 0.17945e-02_r8,0.17834e-02_r8,0.15844e-02_r8,0.78045e-03_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.11812e-04_r8,0.58067e-03_r8,0.84658e-03_r8,0.10349e-02_r8,0.11681e-02_r8, & + & 0.12622e-02_r8,0.12806e-02_r8,0.11518e-02_r8,0.50197e-03_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.13870e-04_r8,0.61870e-03_r8,0.89364e-03_r8,0.10957e-02_r8,0.12411e-02_r8, & + & 0.13307e-02_r8,0.13366e-02_r8,0.11990e-02_r8,0.54419e-03_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.15872e-04_r8,0.65131e-03_r8,0.93843e-03_r8,0.11520e-02_r8,0.13068e-02_r8, & + & 0.13966e-02_r8,0.13927e-02_r8,0.12459e-02_r8,0.58412e-03_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.17706e-04_r8,0.67957e-03_r8,0.98128e-03_r8,0.12037e-02_r8,0.13653e-02_r8, & + & 0.14510e-02_r8,0.14423e-02_r8,0.12873e-02_r8,0.62086e-03_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.19307e-04_r8,0.70477e-03_r8,0.10208e-02_r8,0.12522e-02_r8,0.14187e-02_r8, & + & 0.15000e-02_r8,0.14882e-02_r8,0.13223e-02_r8,0.65273e-03_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.96633e-05_r8,0.48384e-03_r8,0.70464e-03_r8,0.86214e-03_r8,0.97325e-03_r8, & + & 0.10525e-02_r8,0.10661e-02_r8,0.95818e-03_r8,0.41838e-03_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.11346e-04_r8,0.51544e-03_r8,0.74375e-03_r8,0.91255e-03_r8,0.10346e-02_r8, & + & 0.11088e-02_r8,0.11124e-02_r8,0.99787e-03_r8,0.45436e-03_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.12983e-04_r8,0.54258e-03_r8,0.78191e-03_r8,0.95994e-03_r8,0.10893e-02_r8, & + & 0.11636e-02_r8,0.11595e-02_r8,0.10379e-02_r8,0.48767e-03_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.14483e-04_r8,0.56662e-03_r8,0.81795e-03_r8,0.10036e-02_r8,0.11385e-02_r8, & + & 0.12091e-02_r8,0.12012e-02_r8,0.10707e-02_r8,0.51810e-03_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.15790e-04_r8,0.58805e-03_r8,0.85165e-03_r8,0.10447e-02_r8,0.11830e-02_r8, & + & 0.12500e-02_r8,0.12389e-02_r8,0.11012e-02_r8,0.54508e-03_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.79057e-05_r8,0.40215e-03_r8,0.58516e-03_r8,0.71666e-03_r8,0.80969e-03_r8, & + & 0.87518e-03_r8,0.88581e-03_r8,0.79569e-03_r8,0.34825e-03_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.92808e-05_r8,0.42853e-03_r8,0.61818e-03_r8,0.75847e-03_r8,0.86082e-03_r8, & + & 0.92160e-03_r8,0.92436e-03_r8,0.82894e-03_r8,0.37871e-03_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.10621e-04_r8,0.45134e-03_r8,0.65028e-03_r8,0.79815e-03_r8,0.90622e-03_r8, & + & 0.96752e-03_r8,0.96291e-03_r8,0.86177e-03_r8,0.40642e-03_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.11849e-04_r8,0.47161e-03_r8,0.68090e-03_r8,0.83530e-03_r8,0.94770e-03_r8, & + & 0.10054e-02_r8,0.99815e-03_r8,0.88908e-03_r8,0.43149e-03_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.12897e-04_r8,0.49000e-03_r8,0.70944e-03_r8,0.86982e-03_r8,0.98430e-03_r8, & + & 0.10398e-02_r8,0.10297e-02_r8,0.91483e-03_r8,0.45459e-03_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.23575e-02_r8,0.96457e-02_r8,0.13128e-01_r8,0.15361e-01_r8,0.16662e-01_r8, & + & 0.16999e-01_r8,0.16303e-01_r8,0.14368e-01_r8,0.10185e-01_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.24508e-02_r8,0.99768e-02_r8,0.13562e-01_r8,0.15786e-01_r8,0.17046e-01_r8, & + & 0.17316e-01_r8,0.16539e-01_r8,0.14627e-01_r8,0.10447e-01_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.25176e-02_r8,0.10262e-01_r8,0.13947e-01_r8,0.16182e-01_r8,0.17390e-01_r8, & + & 0.17588e-01_r8,0.16752e-01_r8,0.14857e-01_r8,0.10699e-01_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.25627e-02_r8,0.10510e-01_r8,0.14271e-01_r8,0.16517e-01_r8,0.17678e-01_r8, & + & 0.17815e-01_r8,0.16941e-01_r8,0.15073e-01_r8,0.10970e-01_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.25904e-02_r8,0.10712e-01_r8,0.14528e-01_r8,0.16788e-01_r8,0.17912e-01_r8, & + & 0.18013e-01_r8,0.17126e-01_r8,0.15282e-01_r8,0.11215e-01_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.19422e-02_r8,0.85179e-02_r8,0.11603e-01_r8,0.13561e-01_r8,0.14694e-01_r8, & + & 0.14952e-01_r8,0.14274e-01_r8,0.12616e-01_r8,0.86910e-02_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.20231e-02_r8,0.88208e-02_r8,0.11992e-01_r8,0.13942e-01_r8,0.15043e-01_r8, & + & 0.15241e-01_r8,0.14503e-01_r8,0.12849e-01_r8,0.89203e-02_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.20824e-02_r8,0.90892e-02_r8,0.12333e-01_r8,0.14283e-01_r8,0.15343e-01_r8, & + & 0.15493e-01_r8,0.14704e-01_r8,0.13065e-01_r8,0.91412e-02_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.21235e-02_r8,0.93193e-02_r8,0.12613e-01_r8,0.14573e-01_r8,0.15586e-01_r8, & + & 0.15696e-01_r8,0.14900e-01_r8,0.13269e-01_r8,0.93731e-02_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.21501e-02_r8,0.95064e-02_r8,0.12844e-01_r8,0.14802e-01_r8,0.15789e-01_r8, & + & 0.15872e-01_r8,0.15079e-01_r8,0.13459e-01_r8,0.95922e-02_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.15710e-02_r8,0.73739e-02_r8,0.10084e-01_r8,0.11795e-01_r8,0.12791e-01_r8, & + & 0.13002e-01_r8,0.12408e-01_r8,0.10948e-01_r8,0.73256e-02_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.16445e-02_r8,0.76603e-02_r8,0.10441e-01_r8,0.12136e-01_r8,0.13098e-01_r8, & + & 0.13272e-01_r8,0.12629e-01_r8,0.11169e-01_r8,0.75277e-02_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.17016e-02_r8,0.79120e-02_r8,0.10738e-01_r8,0.12444e-01_r8,0.13365e-01_r8, & + & 0.13502e-01_r8,0.12827e-01_r8,0.11365e-01_r8,0.77275e-02_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.17419e-02_r8,0.81204e-02_r8,0.10992e-01_r8,0.12704e-01_r8,0.13579e-01_r8, & + & 0.13687e-01_r8,0.13022e-01_r8,0.11565e-01_r8,0.79327e-02_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.17693e-02_r8,0.82896e-02_r8,0.11201e-01_r8,0.12903e-01_r8,0.13761e-01_r8, & + & 0.13854e-01_r8,0.13193e-01_r8,0.11760e-01_r8,0.81324e-02_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.12568e-02_r8,0.62925e-02_r8,0.86570e-02_r8,0.10156e-01_r8,0.11020e-01_r8, & + & 0.11220e-01_r8,0.10710e-01_r8,0.94329e-02_r8,0.61812e-02_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.13242e-02_r8,0.65532e-02_r8,0.89756e-02_r8,0.10460e-01_r8,0.11292e-01_r8, & + & 0.11463e-01_r8,0.10924e-01_r8,0.96449e-02_r8,0.63620e-02_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.13782e-02_r8,0.67807e-02_r8,0.92447e-02_r8,0.10739e-01_r8,0.11531e-01_r8, & + & 0.11676e-01_r8,0.11115e-01_r8,0.98384e-02_r8,0.65417e-02_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.14185e-02_r8,0.69728e-02_r8,0.94724e-02_r8,0.10967e-01_r8,0.11732e-01_r8, & + & 0.11853e-01_r8,0.11299e-01_r8,0.10029e-01_r8,0.67314e-02_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.14466e-02_r8,0.71294e-02_r8,0.96551e-02_r8,0.11150e-01_r8,0.11897e-01_r8, & + & 0.12003e-01_r8,0.11457e-01_r8,0.10212e-01_r8,0.69134e-02_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.99815e-03_r8,0.53184e-02_r8,0.73668e-02_r8,0.86661e-02_r8,0.94189e-02_r8, & + & 0.96088e-02_r8,0.91860e-02_r8,0.80854e-02_r8,0.52147e-02_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.10594e-02_r8,0.55502e-02_r8,0.76480e-02_r8,0.89382e-02_r8,0.96675e-02_r8, & + & 0.98281e-02_r8,0.93908e-02_r8,0.82904e-02_r8,0.53805e-02_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.11093e-02_r8,0.57534e-02_r8,0.78820e-02_r8,0.91873e-02_r8,0.98860e-02_r8, & + & 0.10027e-01_r8,0.95739e-02_r8,0.84774e-02_r8,0.55398e-02_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.11487e-02_r8,0.59264e-02_r8,0.80746e-02_r8,0.93952e-02_r8,0.10070e-01_r8, & + & 0.10196e-01_r8,0.97460e-02_r8,0.86586e-02_r8,0.57118e-02_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.11770e-02_r8,0.60715e-02_r8,0.82322e-02_r8,0.95590e-02_r8,0.10225e-01_r8, & + & 0.10337e-01_r8,0.98891e-02_r8,0.88282e-02_r8,0.58756e-02_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.78484e-03_r8,0.44557e-02_r8,0.62088e-02_r8,0.73238e-02_r8,0.79758e-02_r8, & + & 0.81565e-02_r8,0.78234e-02_r8,0.68949e-02_r8,0.43721e-02_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.84104e-03_r8,0.46584e-02_r8,0.64548e-02_r8,0.75720e-02_r8,0.82049e-02_r8, & + & 0.83603e-02_r8,0.80139e-02_r8,0.70912e-02_r8,0.45208e-02_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.88703e-03_r8,0.48386e-02_r8,0.66585e-02_r8,0.77939e-02_r8,0.84077e-02_r8, & + & 0.85494e-02_r8,0.81878e-02_r8,0.72673e-02_r8,0.46664e-02_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.92429e-03_r8,0.49939e-02_r8,0.68255e-02_r8,0.79793e-02_r8,0.85811e-02_r8, & + & 0.87123e-02_r8,0.83423e-02_r8,0.74324e-02_r8,0.48193e-02_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.95287e-03_r8,0.51269e-02_r8,0.69664e-02_r8,0.81216e-02_r8,0.87256e-02_r8, & + & 0.88404e-02_r8,0.84793e-02_r8,0.75885e-02_r8,0.49684e-02_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.61176e-03_r8,0.37105e-02_r8,0.51921e-02_r8,0.61495e-02_r8,0.67086e-02_r8, & + & 0.68737e-02_r8,0.66196e-02_r8,0.58499e-02_r8,0.36398e-02_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.66355e-03_r8,0.38845e-02_r8,0.54092e-02_r8,0.63684e-02_r8,0.69191e-02_r8, & + & 0.70638e-02_r8,0.67967e-02_r8,0.60329e-02_r8,0.37725e-02_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.70584e-03_r8,0.40429e-02_r8,0.55891e-02_r8,0.65665e-02_r8,0.71061e-02_r8, & + & 0.72392e-02_r8,0.69566e-02_r8,0.61958e-02_r8,0.39040e-02_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.74016e-03_r8,0.41804e-02_r8,0.57362e-02_r8,0.67306e-02_r8,0.72656e-02_r8, & + & 0.73939e-02_r8,0.71002e-02_r8,0.63458e-02_r8,0.40422e-02_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.76793e-03_r8,0.43013e-02_r8,0.58634e-02_r8,0.68605e-02_r8,0.73917e-02_r8, & + & 0.75160e-02_r8,0.72292e-02_r8,0.64867e-02_r8,0.41753e-02_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.47383e-03_r8,0.30719e-02_r8,0.43157e-02_r8,0.51299e-02_r8,0.56113e-02_r8, & + & 0.57604e-02_r8,0.55584e-02_r8,0.49263e-02_r8,0.30099e-02_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.52030e-03_r8,0.32224e-02_r8,0.45088e-02_r8,0.53256e-02_r8,0.58049e-02_r8, & + & 0.59369e-02_r8,0.57249e-02_r8,0.50950e-02_r8,0.31335e-02_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.55897e-03_r8,0.33601e-02_r8,0.46690e-02_r8,0.55008e-02_r8,0.59733e-02_r8, & + & 0.60982e-02_r8,0.58703e-02_r8,0.52416e-02_r8,0.32505e-02_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.59051e-03_r8,0.34823e-02_r8,0.48003e-02_r8,0.56492e-02_r8,0.61147e-02_r8, & + & 0.62407e-02_r8,0.60011e-02_r8,0.53776e-02_r8,0.33691e-02_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.61638e-03_r8,0.35908e-02_r8,0.49151e-02_r8,0.57682e-02_r8,0.62269e-02_r8, & + & 0.63505e-02_r8,0.61226e-02_r8,0.55061e-02_r8,0.34893e-02_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.36452e-03_r8,0.25301e-02_r8,0.35655e-02_r8,0.42558e-02_r8,0.46668e-02_r8, & + & 0.47995e-02_r8,0.46391e-02_r8,0.41176e-02_r8,0.24723e-02_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.40521e-03_r8,0.26609e-02_r8,0.37368e-02_r8,0.44313e-02_r8,0.48422e-02_r8, & + & 0.49605e-02_r8,0.47876e-02_r8,0.42682e-02_r8,0.25854e-02_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.44042e-03_r8,0.27811e-02_r8,0.38822e-02_r8,0.45871e-02_r8,0.49951e-02_r8, & + & 0.51048e-02_r8,0.49189e-02_r8,0.43988e-02_r8,0.26922e-02_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.46934e-03_r8,0.28890e-02_r8,0.40015e-02_r8,0.47204e-02_r8,0.51195e-02_r8, & + & 0.52329e-02_r8,0.50398e-02_r8,0.45211e-02_r8,0.27947e-02_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.49296e-03_r8,0.29863e-02_r8,0.41052e-02_r8,0.48296e-02_r8,0.52212e-02_r8, & + & 0.53320e-02_r8,0.51516e-02_r8,0.46410e-02_r8,0.29014e-02_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.28141e-03_r8,0.20839e-02_r8,0.29434e-02_r8,0.35250e-02_r8,0.38705e-02_r8, & + & 0.39907e-02_r8,0.38574e-02_r8,0.34280e-02_r8,0.20276e-02_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.31642e-03_r8,0.21962e-02_r8,0.30947e-02_r8,0.36798e-02_r8,0.40279e-02_r8, & + & 0.41317e-02_r8,0.39905e-02_r8,0.35591e-02_r8,0.21304e-02_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.34743e-03_r8,0.23002e-02_r8,0.32251e-02_r8,0.38167e-02_r8,0.41632e-02_r8, & + & 0.42588e-02_r8,0.41077e-02_r8,0.36737e-02_r8,0.22246e-02_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.37337e-03_r8,0.23958e-02_r8,0.33326e-02_r8,0.39351e-02_r8,0.42727e-02_r8, & + & 0.43699e-02_r8,0.42167e-02_r8,0.37850e-02_r8,0.23171e-02_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.39464e-03_r8,0.24818e-02_r8,0.34245e-02_r8,0.40341e-02_r8,0.43635e-02_r8, & + & 0.44592e-02_r8,0.43133e-02_r8,0.38931e-02_r8,0.24123e-02_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.23046e-03_r8,0.17561e-02_r8,0.24821e-02_r8,0.29697e-02_r8,0.32603e-02_r8, & + & 0.33590e-02_r8,0.32465e-02_r8,0.28911e-02_r8,0.17000e-02_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.25900e-03_r8,0.18499e-02_r8,0.26079e-02_r8,0.30983e-02_r8,0.33914e-02_r8, & + & 0.34790e-02_r8,0.33598e-02_r8,0.30000e-02_r8,0.17879e-02_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.28431e-03_r8,0.19371e-02_r8,0.27154e-02_r8,0.32123e-02_r8,0.35009e-02_r8, & + & 0.35810e-02_r8,0.34582e-02_r8,0.30989e-02_r8,0.18709e-02_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.30554e-03_r8,0.20175e-02_r8,0.28047e-02_r8,0.33094e-02_r8,0.35897e-02_r8, & + & 0.36708e-02_r8,0.35500e-02_r8,0.31964e-02_r8,0.19524e-02_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.32290e-03_r8,0.20906e-02_r8,0.28827e-02_r8,0.33907e-02_r8,0.36638e-02_r8, & + & 0.37448e-02_r8,0.36322e-02_r8,0.32921e-02_r8,0.20342e-02_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.18873e-03_r8,0.14753e-02_r8,0.20859e-02_r8,0.24932e-02_r8,0.27362e-02_r8, & + & 0.28163e-02_r8,0.27231e-02_r8,0.24287e-02_r8,0.14226e-02_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.21206e-03_r8,0.15542e-02_r8,0.21905e-02_r8,0.25997e-02_r8,0.28436e-02_r8, & + & 0.29146e-02_r8,0.28182e-02_r8,0.25196e-02_r8,0.14964e-02_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.23271e-03_r8,0.16282e-02_r8,0.22789e-02_r8,0.26937e-02_r8,0.29320e-02_r8, & + & 0.29995e-02_r8,0.29004e-02_r8,0.26063e-02_r8,0.15684e-02_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.25005e-03_r8,0.16959e-02_r8,0.23539e-02_r8,0.27739e-02_r8,0.30052e-02_r8, & + & 0.30738e-02_r8,0.29781e-02_r8,0.26924e-02_r8,0.16388e-02_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.26424e-03_r8,0.17579e-02_r8,0.24198e-02_r8,0.28418e-02_r8,0.30688e-02_r8, & + & 0.31370e-02_r8,0.30478e-02_r8,0.27734e-02_r8,0.17090e-02_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.15451e-03_r8,0.12362e-02_r8,0.17471e-02_r8,0.20856e-02_r8,0.22870e-02_r8, & + & 0.23530e-02_r8,0.22758e-02_r8,0.20318e-02_r8,0.11868e-02_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.17357e-03_r8,0.13027e-02_r8,0.18337e-02_r8,0.21736e-02_r8,0.23752e-02_r8, & + & 0.24339e-02_r8,0.23549e-02_r8,0.21104e-02_r8,0.12492e-02_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.19045e-03_r8,0.13651e-02_r8,0.19071e-02_r8,0.22520e-02_r8,0.24479e-02_r8, & + & 0.25052e-02_r8,0.24255e-02_r8,0.21862e-02_r8,0.13114e-02_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.20459e-03_r8,0.14225e-02_r8,0.19702e-02_r8,0.23195e-02_r8,0.25109e-02_r8, & + & 0.25680e-02_r8,0.24906e-02_r8,0.22592e-02_r8,0.13717e-02_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.21621e-03_r8,0.14751e-02_r8,0.20267e-02_r8,0.23775e-02_r8,0.25654e-02_r8, & + & 0.26221e-02_r8,0.25513e-02_r8,0.23283e-02_r8,0.14321e-02_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.14551e-01_r8,0.26282e-01_r8,0.32053e-01_r8,0.35189e-01_r8,0.36600e-01_r8, & + & 0.36646e-01_r8,0.35552e-01_r8,0.33215e-01_r8,0.27309e-01_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.15360e-01_r8,0.26847e-01_r8,0.32411e-01_r8,0.35426e-01_r8,0.36803e-01_r8, & + & 0.36994e-01_r8,0.36037e-01_r8,0.33674e-01_r8,0.27881e-01_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.16052e-01_r8,0.27358e-01_r8,0.32711e-01_r8,0.35602e-01_r8,0.37002e-01_r8, & + & 0.37322e-01_r8,0.36495e-01_r8,0.34092e-01_r8,0.28365e-01_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.16634e-01_r8,0.27765e-01_r8,0.32975e-01_r8,0.35757e-01_r8,0.37198e-01_r8, & + & 0.37629e-01_r8,0.36871e-01_r8,0.34489e-01_r8,0.28817e-01_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.17092e-01_r8,0.28088e-01_r8,0.33173e-01_r8,0.35899e-01_r8,0.37369e-01_r8, & + & 0.37894e-01_r8,0.37206e-01_r8,0.34856e-01_r8,0.29236e-01_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.12675e-01_r8,0.23757e-01_r8,0.28827e-01_r8,0.31475e-01_r8,0.32647e-01_r8, & + & 0.32779e-01_r8,0.31874e-01_r8,0.29659e-01_r8,0.23735e-01_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.13363e-01_r8,0.24261e-01_r8,0.29165e-01_r8,0.31734e-01_r8,0.32905e-01_r8, & + & 0.33137e-01_r8,0.32357e-01_r8,0.30114e-01_r8,0.24241e-01_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.13952e-01_r8,0.24673e-01_r8,0.29458e-01_r8,0.31940e-01_r8,0.33167e-01_r8, & + & 0.33486e-01_r8,0.32794e-01_r8,0.30540e-01_r8,0.24704e-01_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.14440e-01_r8,0.25010e-01_r8,0.29692e-01_r8,0.32131e-01_r8,0.33402e-01_r8, & + & 0.33816e-01_r8,0.33185e-01_r8,0.30944e-01_r8,0.25123e-01_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.14810e-01_r8,0.25246e-01_r8,0.29865e-01_r8,0.32323e-01_r8,0.33624e-01_r8, & + & 0.34125e-01_r8,0.33530e-01_r8,0.31299e-01_r8,0.25501e-01_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.10764e-01_r8,0.21180e-01_r8,0.25645e-01_r8,0.27934e-01_r8,0.28891e-01_r8, & + & 0.28978e-01_r8,0.28215e-01_r8,0.26250e-01_r8,0.20340e-01_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.11371e-01_r8,0.21611e-01_r8,0.25976e-01_r8,0.28221e-01_r8,0.29204e-01_r8, & + & 0.29347e-01_r8,0.28689e-01_r8,0.26687e-01_r8,0.20803e-01_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.11882e-01_r8,0.21977e-01_r8,0.26258e-01_r8,0.28467e-01_r8,0.29498e-01_r8, & + & 0.29730e-01_r8,0.29113e-01_r8,0.27115e-01_r8,0.21241e-01_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.12302e-01_r8,0.22273e-01_r8,0.26477e-01_r8,0.28696e-01_r8,0.29766e-01_r8, & + & 0.30099e-01_r8,0.29507e-01_r8,0.27503e-01_r8,0.21620e-01_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.12624e-01_r8,0.22481e-01_r8,0.26631e-01_r8,0.28900e-01_r8,0.30032e-01_r8, & + & 0.30425e-01_r8,0.29859e-01_r8,0.27842e-01_r8,0.21966e-01_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.89860e-02_r8,0.18659e-01_r8,0.22605e-01_r8,0.24580e-01_r8,0.25383e-01_r8, & + & 0.25435e-01_r8,0.24761e-01_r8,0.23037e-01_r8,0.17414e-01_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.95207e-02_r8,0.19048e-01_r8,0.22924e-01_r8,0.24888e-01_r8,0.25739e-01_r8, & + & 0.25823e-01_r8,0.25200e-01_r8,0.23450e-01_r8,0.17847e-01_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.99723e-02_r8,0.19380e-01_r8,0.23182e-01_r8,0.25155e-01_r8,0.26061e-01_r8, & + & 0.26209e-01_r8,0.25611e-01_r8,0.23862e-01_r8,0.18251e-01_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.10354e-01_r8,0.19644e-01_r8,0.23397e-01_r8,0.25401e-01_r8,0.26345e-01_r8, & + & 0.26580e-01_r8,0.26000e-01_r8,0.24233e-01_r8,0.18600e-01_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.10637e-01_r8,0.19822e-01_r8,0.23556e-01_r8,0.25605e-01_r8,0.26619e-01_r8, & + & 0.26913e-01_r8,0.26359e-01_r8,0.24562e-01_r8,0.18925e-01_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.74104e-02_r8,0.16264e-01_r8,0.19717e-01_r8,0.21452e-01_r8,0.22172e-01_r8, & + & 0.22207e-01_r8,0.21598e-01_r8,0.20075e-01_r8,0.14880e-01_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.78778e-02_r8,0.16624e-01_r8,0.20022e-01_r8,0.21765e-01_r8,0.22531e-01_r8, & + & 0.22596e-01_r8,0.21999e-01_r8,0.20458e-01_r8,0.15279e-01_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.82694e-02_r8,0.16928e-01_r8,0.20277e-01_r8,0.22036e-01_r8,0.22859e-01_r8, & + & 0.22978e-01_r8,0.22384e-01_r8,0.20834e-01_r8,0.15650e-01_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.85919e-02_r8,0.17168e-01_r8,0.20498e-01_r8,0.22274e-01_r8,0.23143e-01_r8, & + & 0.23326e-01_r8,0.22754e-01_r8,0.21189e-01_r8,0.15980e-01_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.88337e-02_r8,0.17332e-01_r8,0.20664e-01_r8,0.22477e-01_r8,0.23407e-01_r8, & + & 0.23648e-01_r8,0.23111e-01_r8,0.21509e-01_r8,0.16283e-01_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.60305e-02_r8,0.14008e-01_r8,0.17028e-01_r8,0.18574e-01_r8,0.19236e-01_r8, & + & 0.19269e-01_r8,0.18720e-01_r8,0.17347e-01_r8,0.12656e-01_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.64356e-02_r8,0.14339e-01_r8,0.17318e-01_r8,0.18872e-01_r8,0.19580e-01_r8, & + & 0.19645e-01_r8,0.19095e-01_r8,0.17705e-01_r8,0.13025e-01_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.67708e-02_r8,0.14626e-01_r8,0.17575e-01_r8,0.19135e-01_r8,0.19883e-01_r8, & + & 0.20004e-01_r8,0.19454e-01_r8,0.18055e-01_r8,0.13366e-01_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.70449e-02_r8,0.14853e-01_r8,0.17795e-01_r8,0.19363e-01_r8,0.20156e-01_r8, & + & 0.20324e-01_r8,0.19811e-01_r8,0.18392e-01_r8,0.13679e-01_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.72586e-02_r8,0.15014e-01_r8,0.17954e-01_r8,0.19569e-01_r8,0.20401e-01_r8, & + & 0.20622e-01_r8,0.20155e-01_r8,0.18706e-01_r8,0.13963e-01_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.48615e-02_r8,0.11936e-01_r8,0.14574e-01_r8,0.15963e-01_r8,0.16578e-01_r8, & + & 0.16615e-01_r8,0.16125e-01_r8,0.14904e-01_r8,0.10718e-01_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.52093e-02_r8,0.12247e-01_r8,0.14845e-01_r8,0.16239e-01_r8,0.16890e-01_r8, & + & 0.16965e-01_r8,0.16477e-01_r8,0.15238e-01_r8,0.11050e-01_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.54981e-02_r8,0.12520e-01_r8,0.15089e-01_r8,0.16485e-01_r8,0.17163e-01_r8, & + & 0.17296e-01_r8,0.16823e-01_r8,0.15561e-01_r8,0.11367e-01_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.57341e-02_r8,0.12732e-01_r8,0.15302e-01_r8,0.16709e-01_r8,0.17412e-01_r8, & + & 0.17587e-01_r8,0.17156e-01_r8,0.15882e-01_r8,0.11657e-01_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.59245e-02_r8,0.12879e-01_r8,0.15460e-01_r8,0.16900e-01_r8,0.17646e-01_r8, & + & 0.17862e-01_r8,0.17475e-01_r8,0.16189e-01_r8,0.11924e-01_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.38903e-02_r8,0.10086e-01_r8,0.12393e-01_r8,0.13617e-01_r8,0.14179e-01_r8, & + & 0.14230e-01_r8,0.13810e-01_r8,0.12741e-01_r8,0.90402e-02_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.41883e-02_r8,0.10379e-01_r8,0.12642e-01_r8,0.13866e-01_r8,0.14454e-01_r8, & + & 0.14549e-01_r8,0.14140e-01_r8,0.13050e-01_r8,0.93407e-02_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.44374e-02_r8,0.10628e-01_r8,0.12866e-01_r8,0.14093e-01_r8,0.14702e-01_r8, & + & 0.14847e-01_r8,0.14466e-01_r8,0.13354e-01_r8,0.96289e-02_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.46417e-02_r8,0.10823e-01_r8,0.13067e-01_r8,0.14297e-01_r8,0.14936e-01_r8, & + & 0.15113e-01_r8,0.14777e-01_r8,0.13659e-01_r8,0.98946e-02_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.48106e-02_r8,0.10958e-01_r8,0.13212e-01_r8,0.14477e-01_r8,0.15155e-01_r8, & + & 0.15369e-01_r8,0.15065e-01_r8,0.13954e-01_r8,0.10137e-01_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.30906e-02_r8,0.84716e-02_r8,0.10475e-01_r8,0.11533e-01_r8,0.12037e-01_r8, & + & 0.12102e-01_r8,0.11757e-01_r8,0.10840e-01_r8,0.75790e-02_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.33456e-02_r8,0.87380e-02_r8,0.10698e-01_r8,0.11759e-01_r8,0.12281e-01_r8, & + & 0.12384e-01_r8,0.12063e-01_r8,0.11124e-01_r8,0.78524e-02_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.35624e-02_r8,0.89636e-02_r8,0.10908e-01_r8,0.11964e-01_r8,0.12503e-01_r8, & + & 0.12651e-01_r8,0.12366e-01_r8,0.11413e-01_r8,0.81116e-02_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.37409e-02_r8,0.91394e-02_r8,0.11085e-01_r8,0.12156e-01_r8,0.12717e-01_r8, & + & 0.12895e-01_r8,0.12646e-01_r8,0.11703e-01_r8,0.83543e-02_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.38899e-02_r8,0.92663e-02_r8,0.11210e-01_r8,0.12323e-01_r8,0.12923e-01_r8, & + & 0.13135e-01_r8,0.12909e-01_r8,0.11979e-01_r8,0.85748e-02_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.24588e-02_r8,0.70997e-02_r8,0.88156e-02_r8,0.97280e-02_r8,0.10175e-01_r8, & + & 0.10246e-01_r8,0.99712e-02_r8,0.91951e-02_r8,0.63324e-02_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.26743e-02_r8,0.73393e-02_r8,0.90183e-02_r8,0.99289e-02_r8,0.10387e-01_r8, & + & 0.10496e-01_r8,0.10249e-01_r8,0.94566e-02_r8,0.65770e-02_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.28610e-02_r8,0.75352e-02_r8,0.92028e-02_r8,0.10117e-01_r8,0.10586e-01_r8, & + & 0.10730e-01_r8,0.10524e-01_r8,0.97307e-02_r8,0.68077e-02_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.30147e-02_r8,0.76899e-02_r8,0.93550e-02_r8,0.10291e-01_r8,0.10781e-01_r8, & + & 0.10954e-01_r8,0.10778e-01_r8,0.10001e-01_r8,0.70201e-02_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.31444e-02_r8,0.78050e-02_r8,0.94668e-02_r8,0.10433e-01_r8,0.10974e-01_r8, & + & 0.11173e-01_r8,0.11019e-01_r8,0.10253e-01_r8,0.72189e-02_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.20345e-02_r8,0.60249e-02_r8,0.74716e-02_r8,0.82496e-02_r8,0.86458e-02_r8, & + & 0.87340e-02_r8,0.85222e-02_r8,0.78657e-02_r8,0.53714e-02_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.22071e-02_r8,0.62176e-02_r8,0.76440e-02_r8,0.84251e-02_r8,0.88273e-02_r8, & + & 0.89461e-02_r8,0.87689e-02_r8,0.81125e-02_r8,0.55835e-02_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.23554e-02_r8,0.63729e-02_r8,0.77932e-02_r8,0.85868e-02_r8,0.90058e-02_r8, & + & 0.91548e-02_r8,0.90075e-02_r8,0.83660e-02_r8,0.57827e-02_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.24780e-02_r8,0.64944e-02_r8,0.79106e-02_r8,0.87291e-02_r8,0.91857e-02_r8, & + & 0.93565e-02_r8,0.92302e-02_r8,0.86036e-02_r8,0.59695e-02_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.25820e-02_r8,0.65802e-02_r8,0.79974e-02_r8,0.88427e-02_r8,0.93482e-02_r8, & + & 0.95539e-02_r8,0.94443e-02_r8,0.88180e-02_r8,0.61512e-02_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.16789e-02_r8,0.50906e-02_r8,0.63078e-02_r8,0.69750e-02_r8,0.73172e-02_r8, & + & 0.74078e-02_r8,0.72504e-02_r8,0.67015e-02_r8,0.45394e-02_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.18170e-02_r8,0.52437e-02_r8,0.64512e-02_r8,0.71255e-02_r8,0.74790e-02_r8, & + & 0.75959e-02_r8,0.74655e-02_r8,0.69307e-02_r8,0.47237e-02_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.19356e-02_r8,0.53689e-02_r8,0.65701e-02_r8,0.72610e-02_r8,0.76415e-02_r8, & + & 0.77811e-02_r8,0.76703e-02_r8,0.71508e-02_r8,0.48953e-02_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.20342e-02_r8,0.54644e-02_r8,0.66640e-02_r8,0.73792e-02_r8,0.77929e-02_r8, & + & 0.79635e-02_r8,0.78660e-02_r8,0.73532e-02_r8,0.50607e-02_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.21182e-02_r8,0.55328e-02_r8,0.67352e-02_r8,0.74736e-02_r8,0.79282e-02_r8, & + & 0.81307e-02_r8,0.80542e-02_r8,0.75407e-02_r8,0.52234e-02_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.13819e-02_r8,0.42823e-02_r8,0.53096e-02_r8,0.58771e-02_r8,0.61745e-02_r8, & + & 0.62601e-02_r8,0.61411e-02_r8,0.56893e-02_r8,0.38201e-02_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.14927e-02_r8,0.44078e-02_r8,0.54261e-02_r8,0.60055e-02_r8,0.63167e-02_r8, & + & 0.64278e-02_r8,0.63268e-02_r8,0.58891e-02_r8,0.39789e-02_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.15884e-02_r8,0.45090e-02_r8,0.55246e-02_r8,0.61217e-02_r8,0.64577e-02_r8, & + & 0.65903e-02_r8,0.65044e-02_r8,0.60758e-02_r8,0.41288e-02_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.16683e-02_r8,0.45858e-02_r8,0.56029e-02_r8,0.62193e-02_r8,0.65859e-02_r8, & + & 0.67454e-02_r8,0.66768e-02_r8,0.62506e-02_r8,0.42765e-02_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.17364e-02_r8,0.46419e-02_r8,0.56644e-02_r8,0.62996e-02_r8,0.66998e-02_r8, & + & 0.68888e-02_r8,0.68404e-02_r8,0.64188e-02_r8,0.44198e-02_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.57760e-01_r8,0.69432e-01_r8,0.76402e-01_r8,0.81517e-01_r8,0.85125e-01_r8, & + & 0.87289e-01_r8,0.87408e-01_r8,0.83317e-01_r8,0.74720e-01_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.58256e-01_r8,0.69667e-01_r8,0.76723e-01_r8,0.81911e-01_r8,0.85362e-01_r8, & + & 0.87289e-01_r8,0.87306e-01_r8,0.83357e-01_r8,0.75177e-01_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.58710e-01_r8,0.69859e-01_r8,0.76973e-01_r8,0.82328e-01_r8,0.85690e-01_r8, & + & 0.87420e-01_r8,0.87264e-01_r8,0.83435e-01_r8,0.75701e-01_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.59052e-01_r8,0.70050e-01_r8,0.77176e-01_r8,0.82642e-01_r8,0.86071e-01_r8, & + & 0.87660e-01_r8,0.87341e-01_r8,0.83544e-01_r8,0.76230e-01_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.59298e-01_r8,0.70198e-01_r8,0.77374e-01_r8,0.82883e-01_r8,0.86469e-01_r8, & + & 0.87977e-01_r8,0.87473e-01_r8,0.83691e-01_r8,0.76769e-01_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.50908e-01_r8,0.62848e-01_r8,0.70003e-01_r8,0.75263e-01_r8,0.78670e-01_r8, & + & 0.80594e-01_r8,0.80694e-01_r8,0.77048e-01_r8,0.67048e-01_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.51469e-01_r8,0.63178e-01_r8,0.70395e-01_r8,0.75763e-01_r8,0.79033e-01_r8, & + & 0.80775e-01_r8,0.80686e-01_r8,0.77199e-01_r8,0.67605e-01_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.51956e-01_r8,0.63519e-01_r8,0.70748e-01_r8,0.76221e-01_r8,0.79512e-01_r8, & + & 0.81067e-01_r8,0.80797e-01_r8,0.77370e-01_r8,0.68182e-01_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.52329e-01_r8,0.63831e-01_r8,0.71115e-01_r8,0.76591e-01_r8,0.80032e-01_r8, & + & 0.81445e-01_r8,0.81001e-01_r8,0.77568e-01_r8,0.68768e-01_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.52648e-01_r8,0.64108e-01_r8,0.71441e-01_r8,0.76941e-01_r8,0.80464e-01_r8, & + & 0.81866e-01_r8,0.81282e-01_r8,0.77796e-01_r8,0.69377e-01_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.44636e-01_r8,0.56575e-01_r8,0.63667e-01_r8,0.68804e-01_r8,0.72146e-01_r8, & + & 0.73940e-01_r8,0.73756e-01_r8,0.70359e-01_r8,0.59446e-01_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.45216e-01_r8,0.57005e-01_r8,0.64111e-01_r8,0.69328e-01_r8,0.72620e-01_r8, & + & 0.74228e-01_r8,0.73854e-01_r8,0.70600e-01_r8,0.60086e-01_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.45716e-01_r8,0.57448e-01_r8,0.64591e-01_r8,0.69816e-01_r8,0.73178e-01_r8, & + & 0.74616e-01_r8,0.74093e-01_r8,0.70843e-01_r8,0.60738e-01_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.46137e-01_r8,0.57862e-01_r8,0.65060e-01_r8,0.70283e-01_r8,0.73724e-01_r8, & + & 0.75067e-01_r8,0.74408e-01_r8,0.71130e-01_r8,0.61385e-01_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.46490e-01_r8,0.58240e-01_r8,0.65537e-01_r8,0.70752e-01_r8,0.74187e-01_r8, & + & 0.75545e-01_r8,0.74817e-01_r8,0.71479e-01_r8,0.61998e-01_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.38910e-01_r8,0.50823e-01_r8,0.57505e-01_r8,0.62364e-01_r8,0.65559e-01_r8, & + & 0.67154e-01_r8,0.66798e-01_r8,0.63531e-01_r8,0.52401e-01_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.39488e-01_r8,0.51307e-01_r8,0.58022e-01_r8,0.62912e-01_r8,0.66074e-01_r8, & + & 0.67518e-01_r8,0.67025e-01_r8,0.63840e-01_r8,0.53093e-01_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.39991e-01_r8,0.51812e-01_r8,0.58566e-01_r8,0.63451e-01_r8,0.66632e-01_r8, & + & 0.68010e-01_r8,0.67348e-01_r8,0.64169e-01_r8,0.53782e-01_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.40387e-01_r8,0.52291e-01_r8,0.59117e-01_r8,0.64001e-01_r8,0.67196e-01_r8, & + & 0.68514e-01_r8,0.67789e-01_r8,0.64555e-01_r8,0.54470e-01_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.40719e-01_r8,0.52739e-01_r8,0.59691e-01_r8,0.64572e-01_r8,0.67725e-01_r8, & + & 0.69031e-01_r8,0.68307e-01_r8,0.64985e-01_r8,0.55091e-01_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.33692e-01_r8,0.45459e-01_r8,0.51705e-01_r8,0.56111e-01_r8,0.58984e-01_r8, & + & 0.60384e-01_r8,0.59951e-01_r8,0.56770e-01_r8,0.45939e-01_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.34254e-01_r8,0.45979e-01_r8,0.52252e-01_r8,0.56664e-01_r8,0.59515e-01_r8, & + & 0.60816e-01_r8,0.60273e-01_r8,0.57146e-01_r8,0.46647e-01_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.34738e-01_r8,0.46532e-01_r8,0.52846e-01_r8,0.57238e-01_r8,0.60077e-01_r8, & + & 0.61352e-01_r8,0.60714e-01_r8,0.57566e-01_r8,0.47359e-01_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.35117e-01_r8,0.47047e-01_r8,0.53459e-01_r8,0.57849e-01_r8,0.60668e-01_r8, & + & 0.61902e-01_r8,0.61259e-01_r8,0.58030e-01_r8,0.48036e-01_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.35428e-01_r8,0.47508e-01_r8,0.54083e-01_r8,0.58493e-01_r8,0.61253e-01_r8, & + & 0.62481e-01_r8,0.61851e-01_r8,0.58523e-01_r8,0.48648e-01_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.28910e-01_r8,0.40429e-01_r8,0.46176e-01_r8,0.50108e-01_r8,0.52609e-01_r8, & + & 0.53750e-01_r8,0.53289e-01_r8,0.50286e-01_r8,0.40061e-01_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.29433e-01_r8,0.40967e-01_r8,0.46731e-01_r8,0.50653e-01_r8,0.53149e-01_r8, & + & 0.54232e-01_r8,0.53687e-01_r8,0.50714e-01_r8,0.40756e-01_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.29883e-01_r8,0.41520e-01_r8,0.47349e-01_r8,0.51251e-01_r8,0.53731e-01_r8, & + & 0.54796e-01_r8,0.54207e-01_r8,0.51188e-01_r8,0.41443e-01_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.30252e-01_r8,0.42024e-01_r8,0.47998e-01_r8,0.51918e-01_r8,0.54339e-01_r8, & + & 0.55387e-01_r8,0.54820e-01_r8,0.51711e-01_r8,0.42085e-01_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.30542e-01_r8,0.42447e-01_r8,0.48635e-01_r8,0.52598e-01_r8,0.54986e-01_r8, & + & 0.56038e-01_r8,0.55430e-01_r8,0.52236e-01_r8,0.42675e-01_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.24600e-01_r8,0.35725e-01_r8,0.40952e-01_r8,0.44398e-01_r8,0.46558e-01_r8, & + & 0.47462e-01_r8,0.46950e-01_r8,0.44227e-01_r8,0.34751e-01_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.25060e-01_r8,0.36250e-01_r8,0.41498e-01_r8,0.44950e-01_r8,0.47097e-01_r8, & + & 0.47977e-01_r8,0.47399e-01_r8,0.44690e-01_r8,0.35410e-01_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.25466e-01_r8,0.36769e-01_r8,0.42119e-01_r8,0.45572e-01_r8,0.47696e-01_r8, & + & 0.48548e-01_r8,0.47965e-01_r8,0.45198e-01_r8,0.36050e-01_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.25804e-01_r8,0.37232e-01_r8,0.42764e-01_r8,0.46249e-01_r8,0.48349e-01_r8, & + & 0.49173e-01_r8,0.48603e-01_r8,0.45737e-01_r8,0.36649e-01_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.26075e-01_r8,0.37645e-01_r8,0.43371e-01_r8,0.46950e-01_r8,0.49045e-01_r8, & + & 0.49856e-01_r8,0.49223e-01_r8,0.46279e-01_r8,0.37198e-01_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.20747e-01_r8,0.31325e-01_r8,0.36016e-01_r8,0.39047e-01_r8,0.40921e-01_r8, & + & 0.41656e-01_r8,0.41097e-01_r8,0.38682e-01_r8,0.29955e-01_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.21145e-01_r8,0.31811e-01_r8,0.36541e-01_r8,0.39597e-01_r8,0.41455e-01_r8, & + & 0.42169e-01_r8,0.41575e-01_r8,0.39145e-01_r8,0.30577e-01_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.21497e-01_r8,0.32290e-01_r8,0.37155e-01_r8,0.40238e-01_r8,0.42067e-01_r8, & + & 0.42744e-01_r8,0.42154e-01_r8,0.39648e-01_r8,0.31178e-01_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.21796e-01_r8,0.32717e-01_r8,0.37766e-01_r8,0.40923e-01_r8,0.42738e-01_r8, & + & 0.43394e-01_r8,0.42768e-01_r8,0.40185e-01_r8,0.31733e-01_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.22044e-01_r8,0.33112e-01_r8,0.38338e-01_r8,0.41597e-01_r8,0.43462e-01_r8, & + & 0.44087e-01_r8,0.43385e-01_r8,0.40740e-01_r8,0.32254e-01_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.17360e-01_r8,0.27218e-01_r8,0.31401e-01_r8,0.34084e-01_r8,0.35741e-01_r8, & + & 0.36373e-01_r8,0.35798e-01_r8,0.33594e-01_r8,0.25664e-01_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.17693e-01_r8,0.27662e-01_r8,0.31908e-01_r8,0.34622e-01_r8,0.36264e-01_r8, & + & 0.36877e-01_r8,0.36285e-01_r8,0.34049e-01_r8,0.26251e-01_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.17992e-01_r8,0.28089e-01_r8,0.32477e-01_r8,0.35255e-01_r8,0.36874e-01_r8, & + & 0.37444e-01_r8,0.36831e-01_r8,0.34544e-01_r8,0.26814e-01_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.18258e-01_r8,0.28481e-01_r8,0.33050e-01_r8,0.35909e-01_r8,0.37552e-01_r8, & + & 0.38078e-01_r8,0.37421e-01_r8,0.35073e-01_r8,0.27335e-01_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.18484e-01_r8,0.28849e-01_r8,0.33601e-01_r8,0.36536e-01_r8,0.38254e-01_r8, & + & 0.38756e-01_r8,0.38026e-01_r8,0.35616e-01_r8,0.27829e-01_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.14462e-01_r8,0.23463e-01_r8,0.27186e-01_r8,0.29588e-01_r8,0.31079e-01_r8, & + & 0.31625e-01_r8,0.31053e-01_r8,0.29012e-01_r8,0.21916e-01_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.14737e-01_r8,0.23853e-01_r8,0.27662e-01_r8,0.30109e-01_r8,0.31581e-01_r8, & + & 0.32116e-01_r8,0.31527e-01_r8,0.29461e-01_r8,0.22460e-01_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.14983e-01_r8,0.24238e-01_r8,0.28187e-01_r8,0.30710e-01_r8,0.32176e-01_r8, & + & 0.32664e-01_r8,0.32044e-01_r8,0.29948e-01_r8,0.22987e-01_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.15228e-01_r8,0.24593e-01_r8,0.28718e-01_r8,0.31312e-01_r8,0.32826e-01_r8, & + & 0.33282e-01_r8,0.32615e-01_r8,0.30467e-01_r8,0.23478e-01_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.15411e-01_r8,0.24932e-01_r8,0.29228e-01_r8,0.31903e-01_r8,0.33455e-01_r8, & + & 0.33943e-01_r8,0.33207e-01_r8,0.30994e-01_r8,0.23939e-01_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.12097e-01_r8,0.20230e-01_r8,0.23554e-01_r8,0.25737e-01_r8,0.27070e-01_r8, & + & 0.27526e-01_r8,0.26987e-01_r8,0.25125e-01_r8,0.18843e-01_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.12316e-01_r8,0.20564e-01_r8,0.24014e-01_r8,0.26265e-01_r8,0.27589e-01_r8, & + & 0.28021e-01_r8,0.27462e-01_r8,0.25580e-01_r8,0.19341e-01_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.12525e-01_r8,0.20893e-01_r8,0.24494e-01_r8,0.26817e-01_r8,0.28172e-01_r8, & + & 0.28578e-01_r8,0.27985e-01_r8,0.26073e-01_r8,0.19811e-01_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.12698e-01_r8,0.21212e-01_r8,0.24971e-01_r8,0.27358e-01_r8,0.28752e-01_r8, & + & 0.29196e-01_r8,0.28554e-01_r8,0.26575e-01_r8,0.20254e-01_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.12813e-01_r8,0.21527e-01_r8,0.25428e-01_r8,0.27886e-01_r8,0.29316e-01_r8, & + & 0.29794e-01_r8,0.29144e-01_r8,0.27095e-01_r8,0.20669e-01_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.10079e-01_r8,0.17332e-01_r8,0.20326e-01_r8,0.22283e-01_r8,0.23452e-01_r8, & + & 0.23840e-01_r8,0.23351e-01_r8,0.21701e-01_r8,0.16150e-01_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.10253e-01_r8,0.17624e-01_r8,0.20738e-01_r8,0.22772e-01_r8,0.23963e-01_r8, & + & 0.24343e-01_r8,0.23830e-01_r8,0.22159e-01_r8,0.16605e-01_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.10412e-01_r8,0.17914e-01_r8,0.21165e-01_r8,0.23257e-01_r8,0.24491e-01_r8, & + & 0.24907e-01_r8,0.24364e-01_r8,0.22633e-01_r8,0.17031e-01_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.10528e-01_r8,0.18203e-01_r8,0.21585e-01_r8,0.23732e-01_r8,0.25019e-01_r8, & + & 0.25466e-01_r8,0.24925e-01_r8,0.23123e-01_r8,0.17440e-01_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.10595e-01_r8,0.18491e-01_r8,0.21987e-01_r8,0.24205e-01_r8,0.25526e-01_r8, & + & 0.26013e-01_r8,0.25497e-01_r8,0.23633e-01_r8,0.17825e-01_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.83675e-02_r8,0.14778e-01_r8,0.17455e-01_r8,0.19201e-01_r8,0.20214e-01_r8, & + & 0.20545e-01_r8,0.20133e-01_r8,0.18703e-01_r8,0.13810e-01_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.85037e-02_r8,0.15033e-01_r8,0.17824e-01_r8,0.19621e-01_r8,0.20684e-01_r8, & + & 0.21052e-01_r8,0.20616e-01_r8,0.19145e-01_r8,0.14218e-01_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.86129e-02_r8,0.15303e-01_r8,0.18197e-01_r8,0.20043e-01_r8,0.21163e-01_r8, & + & 0.21577e-01_r8,0.21143e-01_r8,0.19600e-01_r8,0.14617e-01_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.86912e-02_r8,0.15568e-01_r8,0.18565e-01_r8,0.20472e-01_r8,0.21636e-01_r8, & + & 0.22091e-01_r8,0.21674e-01_r8,0.20090e-01_r8,0.14991e-01_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.87302e-02_r8,0.15800e-01_r8,0.18917e-01_r8,0.20887e-01_r8,0.22103e-01_r8, & + & 0.22594e-01_r8,0.22198e-01_r8,0.20586e-01_r8,0.15351e-01_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.23898e+00_r8,0.24353e+00_r8,0.26297e+00_r8,0.27410e+00_r8,0.27635e+00_r8, & + & 0.27151e+00_r8,0.26001e+00_r8,0.24536e+00_r8,0.24840e+00_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.23703e+00_r8,0.24151e+00_r8,0.26057e+00_r8,0.27148e+00_r8,0.27415e+00_r8, & + & 0.26993e+00_r8,0.25912e+00_r8,0.24520e+00_r8,0.24830e+00_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.23567e+00_r8,0.23998e+00_r8,0.25868e+00_r8,0.26917e+00_r8,0.27195e+00_r8, & + & 0.26833e+00_r8,0.25809e+00_r8,0.24488e+00_r8,0.24801e+00_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.23478e+00_r8,0.23885e+00_r8,0.25713e+00_r8,0.26729e+00_r8,0.26990e+00_r8, & + & 0.26662e+00_r8,0.25696e+00_r8,0.24453e+00_r8,0.24772e+00_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.23430e+00_r8,0.23810e+00_r8,0.25588e+00_r8,0.26568e+00_r8,0.26809e+00_r8, & + & 0.26490e+00_r8,0.25575e+00_r8,0.24412e+00_r8,0.24745e+00_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.22071e+00_r8,0.23189e+00_r8,0.25280e+00_r8,0.26428e+00_r8,0.26846e+00_r8, & + & 0.26544e+00_r8,0.25423e+00_r8,0.23818e+00_r8,0.23526e+00_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.21924e+00_r8,0.23025e+00_r8,0.25076e+00_r8,0.26194e+00_r8,0.26631e+00_r8, & + & 0.26393e+00_r8,0.25356e+00_r8,0.23803e+00_r8,0.23534e+00_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.21843e+00_r8,0.22915e+00_r8,0.24919e+00_r8,0.26005e+00_r8,0.26425e+00_r8, & + & 0.26237e+00_r8,0.25262e+00_r8,0.23788e+00_r8,0.23535e+00_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.21819e+00_r8,0.22852e+00_r8,0.24801e+00_r8,0.25855e+00_r8,0.26247e+00_r8, & + & 0.26079e+00_r8,0.25163e+00_r8,0.23767e+00_r8,0.23532e+00_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.21836e+00_r8,0.22826e+00_r8,0.24718e+00_r8,0.25726e+00_r8,0.26101e+00_r8, & + & 0.25924e+00_r8,0.25059e+00_r8,0.23733e+00_r8,0.23520e+00_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.20172e+00_r8,0.21909e+00_r8,0.24049e+00_r8,0.25259e+00_r8,0.25809e+00_r8, & + & 0.25661e+00_r8,0.24776e+00_r8,0.23048e+00_r8,0.22176e+00_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.20072e+00_r8,0.21779e+00_r8,0.23872e+00_r8,0.25058e+00_r8,0.25610e+00_r8, & + & 0.25527e+00_r8,0.24712e+00_r8,0.23055e+00_r8,0.22209e+00_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.20047e+00_r8,0.21708e+00_r8,0.23748e+00_r8,0.24902e+00_r8,0.25438e+00_r8, & + & 0.25391e+00_r8,0.24629e+00_r8,0.23063e+00_r8,0.22233e+00_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.20080e+00_r8,0.21687e+00_r8,0.23670e+00_r8,0.24777e+00_r8,0.25298e+00_r8, & + & 0.25252e+00_r8,0.24542e+00_r8,0.23053e+00_r8,0.22249e+00_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.20160e+00_r8,0.21710e+00_r8,0.23623e+00_r8,0.24683e+00_r8,0.25186e+00_r8, & + & 0.25126e+00_r8,0.24453e+00_r8,0.23018e+00_r8,0.22257e+00_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.18271e+00_r8,0.20499e+00_r8,0.22645e+00_r8,0.23921e+00_r8,0.24553e+00_r8, & + & 0.24573e+00_r8,0.23916e+00_r8,0.22190e+00_r8,0.20803e+00_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.18212e+00_r8,0.20407e+00_r8,0.22500e+00_r8,0.23755e+00_r8,0.24385e+00_r8, & + & 0.24460e+00_r8,0.23866e+00_r8,0.22223e+00_r8,0.20862e+00_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.18234e+00_r8,0.20374e+00_r8,0.22412e+00_r8,0.23625e+00_r8,0.24249e+00_r8, & + & 0.24341e+00_r8,0.23801e+00_r8,0.22245e+00_r8,0.20916e+00_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.18327e+00_r8,0.20396e+00_r8,0.22372e+00_r8,0.23535e+00_r8,0.24149e+00_r8, & + & 0.24231e+00_r8,0.23730e+00_r8,0.22248e+00_r8,0.20951e+00_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.18465e+00_r8,0.20466e+00_r8,0.22368e+00_r8,0.23479e+00_r8,0.24072e+00_r8, & + & 0.24142e+00_r8,0.23656e+00_r8,0.22226e+00_r8,0.20975e+00_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.16429e+00_r8,0.19018e+00_r8,0.21120e+00_r8,0.22440e+00_r8,0.23155e+00_r8, & + & 0.23328e+00_r8,0.22834e+00_r8,0.21231e+00_r8,0.19389e+00_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.16411e+00_r8,0.18954e+00_r8,0.21010e+00_r8,0.22306e+00_r8,0.23026e+00_r8, & + & 0.23235e+00_r8,0.22803e+00_r8,0.21280e+00_r8,0.19477e+00_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.16481e+00_r8,0.18955e+00_r8,0.20958e+00_r8,0.22215e+00_r8,0.22928e+00_r8, & + & 0.23142e+00_r8,0.22762e+00_r8,0.21318e+00_r8,0.19549e+00_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.16626e+00_r8,0.19018e+00_r8,0.20952e+00_r8,0.22166e+00_r8,0.22860e+00_r8, & + & 0.23069e+00_r8,0.22713e+00_r8,0.21333e+00_r8,0.19598e+00_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.16812e+00_r8,0.19134e+00_r8,0.20988e+00_r8,0.22152e+00_r8,0.22816e+00_r8, & + & 0.23013e+00_r8,0.22663e+00_r8,0.21325e+00_r8,0.19645e+00_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.14677e+00_r8,0.17503e+00_r8,0.19553e+00_r8,0.20871e+00_r8,0.21680e+00_r8, & + & 0.21948e+00_r8,0.21556e+00_r8,0.20158e+00_r8,0.17922e+00_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.14688e+00_r8,0.17460e+00_r8,0.19479e+00_r8,0.20777e+00_r8,0.21582e+00_r8, & + & 0.21883e+00_r8,0.21549e+00_r8,0.20223e+00_r8,0.18038e+00_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.14791e+00_r8,0.17490e+00_r8,0.19459e+00_r8,0.20727e+00_r8,0.21519e+00_r8, & + & 0.21822e+00_r8,0.21533e+00_r8,0.20278e+00_r8,0.18127e+00_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.14970e+00_r8,0.17592e+00_r8,0.19488e+00_r8,0.20713e+00_r8,0.21485e+00_r8, & + & 0.21785e+00_r8,0.21514e+00_r8,0.20305e+00_r8,0.18200e+00_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.15169e+00_r8,0.17756e+00_r8,0.19568e+00_r8,0.20736e+00_r8,0.21479e+00_r8, & + & 0.21766e+00_r8,0.21494e+00_r8,0.20315e+00_r8,0.18271e+00_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.13000e+00_r8,0.15987e+00_r8,0.17978e+00_r8,0.19301e+00_r8,0.20129e+00_r8, & + & 0.20436e+00_r8,0.20140e+00_r8,0.18919e+00_r8,0.16414e+00_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.13035e+00_r8,0.15964e+00_r8,0.17934e+00_r8,0.19244e+00_r8,0.20068e+00_r8, & + & 0.20402e+00_r8,0.20156e+00_r8,0.19006e+00_r8,0.16551e+00_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.13166e+00_r8,0.16021e+00_r8,0.17944e+00_r8,0.19225e+00_r8,0.20040e+00_r8, & + & 0.20381e+00_r8,0.20166e+00_r8,0.19078e+00_r8,0.16662e+00_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.13361e+00_r8,0.16157e+00_r8,0.18010e+00_r8,0.19248e+00_r8,0.20041e+00_r8, & + & 0.20379e+00_r8,0.20172e+00_r8,0.19125e+00_r8,0.16758e+00_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.13554e+00_r8,0.16344e+00_r8,0.18132e+00_r8,0.19308e+00_r8,0.20075e+00_r8, & + & 0.20397e+00_r8,0.20182e+00_r8,0.19159e+00_r8,0.16855e+00_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.11433e+00_r8,0.14488e+00_r8,0.16431e+00_r8,0.17738e+00_r8,0.18527e+00_r8, & + & 0.18841e+00_r8,0.18617e+00_r8,0.17535e+00_r8,0.14893e+00_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.11487e+00_r8,0.14487e+00_r8,0.16414e+00_r8,0.17713e+00_r8,0.18501e+00_r8, & + & 0.18837e+00_r8,0.18658e+00_r8,0.17646e+00_r8,0.15049e+00_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.11635e+00_r8,0.14571e+00_r8,0.16452e+00_r8,0.17724e+00_r8,0.18506e+00_r8, & + & 0.18853e+00_r8,0.18695e+00_r8,0.17741e+00_r8,0.15180e+00_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.11822e+00_r8,0.14733e+00_r8,0.16549e+00_r8,0.17782e+00_r8,0.18544e+00_r8, & + & 0.18888e+00_r8,0.18734e+00_r8,0.17811e+00_r8,0.15295e+00_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.12009e+00_r8,0.14924e+00_r8,0.16704e+00_r8,0.17887e+00_r8,0.18614e+00_r8, & + & 0.18940e+00_r8,0.18775e+00_r8,0.17867e+00_r8,0.15411e+00_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.10002e+00_r8,0.13043e+00_r8,0.14919e+00_r8,0.16171e+00_r8,0.16913e+00_r8, & + & 0.17211e+00_r8,0.17023e+00_r8,0.16067e+00_r8,0.13380e+00_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.10070e+00_r8,0.13063e+00_r8,0.14927e+00_r8,0.16171e+00_r8,0.16923e+00_r8, & + & 0.17237e+00_r8,0.17091e+00_r8,0.16202e+00_r8,0.13552e+00_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.10219e+00_r8,0.13166e+00_r8,0.14990e+00_r8,0.16210e+00_r8,0.16959e+00_r8, & + & 0.17285e+00_r8,0.17161e+00_r8,0.16316e+00_r8,0.13700e+00_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.10390e+00_r8,0.13341e+00_r8,0.15118e+00_r8,0.16299e+00_r8,0.17031e+00_r8, & + & 0.17358e+00_r8,0.17229e+00_r8,0.16405e+00_r8,0.13837e+00_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.10569e+00_r8,0.13530e+00_r8,0.15298e+00_r8,0.16444e+00_r8,0.17139e+00_r8, & + & 0.17443e+00_r8,0.17301e+00_r8,0.16481e+00_r8,0.13976e+00_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.87148e-01_r8,0.11690e+00_r8,0.13450e+00_r8,0.14609e+00_r8,0.15307e+00_r8, & + & 0.15588e+00_r8,0.15420e+00_r8,0.14572e+00_r8,0.11917e+00_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.87948e-01_r8,0.11730e+00_r8,0.13485e+00_r8,0.14637e+00_r8,0.15348e+00_r8, & + & 0.15645e+00_r8,0.15513e+00_r8,0.14723e+00_r8,0.12103e+00_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.89341e-01_r8,0.11856e+00_r8,0.13575e+00_r8,0.14709e+00_r8,0.15418e+00_r8, & + & 0.15726e+00_r8,0.15609e+00_r8,0.14852e+00_r8,0.12266e+00_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.90912e-01_r8,0.12032e+00_r8,0.13733e+00_r8,0.14835e+00_r8,0.15527e+00_r8, & + & 0.15827e+00_r8,0.15702e+00_r8,0.14960e+00_r8,0.12424e+00_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.92651e-01_r8,0.12218e+00_r8,0.13930e+00_r8,0.15018e+00_r8,0.15676e+00_r8, & + & 0.15942e+00_r8,0.15802e+00_r8,0.15063e+00_r8,0.12583e+00_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.75810e-01_r8,0.10456e+00_r8,0.12069e+00_r8,0.13117e+00_r8,0.13761e+00_r8, & + & 0.14039e+00_r8,0.13895e+00_r8,0.13157e+00_r8,0.10610e+00_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.76895e-01_r8,0.10557e+00_r8,0.12151e+00_r8,0.13190e+00_r8,0.13842e+00_r8, & + & 0.14134e+00_r8,0.14014e+00_r8,0.13312e+00_r8,0.10796e+00_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.78244e-01_r8,0.10718e+00_r8,0.12298e+00_r8,0.13318e+00_r8,0.13962e+00_r8, & + & 0.14250e+00_r8,0.14130e+00_r8,0.13446e+00_r8,0.10971e+00_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.79823e-01_r8,0.10896e+00_r8,0.12491e+00_r8,0.13508e+00_r8,0.14123e+00_r8, & + & 0.14382e+00_r8,0.14250e+00_r8,0.13575e+00_r8,0.11145e+00_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.81587e-01_r8,0.11081e+00_r8,0.12696e+00_r8,0.13729e+00_r8,0.14323e+00_r8, & + & 0.14541e+00_r8,0.14385e+00_r8,0.13708e+00_r8,0.11322e+00_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.65751e-01_r8,0.93358e-01_r8,0.10793e+00_r8,0.11727e+00_r8,0.12307e+00_r8, & + & 0.12565e+00_r8,0.12447e+00_r8,0.11782e+00_r8,0.93944e-01_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.66851e-01_r8,0.94791e-01_r8,0.10927e+00_r8,0.11849e+00_r8,0.12430e+00_r8, & + & 0.12692e+00_r8,0.12584e+00_r8,0.11940e+00_r8,0.95825e-01_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.68215e-01_r8,0.96468e-01_r8,0.11113e+00_r8,0.12035e+00_r8,0.12596e+00_r8, & + & 0.12837e+00_r8,0.12723e+00_r8,0.12088e+00_r8,0.97697e-01_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.69822e-01_r8,0.98288e-01_r8,0.11318e+00_r8,0.12260e+00_r8,0.12800e+00_r8, & + & 0.13009e+00_r8,0.12875e+00_r8,0.12246e+00_r8,0.99558e-01_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.71562e-01_r8,0.10021e+00_r8,0.11536e+00_r8,0.12491e+00_r8,0.13035e+00_r8, & + & 0.13218e+00_r8,0.13049e+00_r8,0.12412e+00_r8,0.10142e+00_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.56716e-01_r8,0.83175e-01_r8,0.96227e-01_r8,0.10452e+00_r8,0.10961e+00_r8, & + & 0.11186e+00_r8,0.11078e+00_r8,0.10487e+00_r8,0.82822e-01_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.57829e-01_r8,0.84711e-01_r8,0.97973e-01_r8,0.10625e+00_r8,0.11123e+00_r8, & + & 0.11339e+00_r8,0.11236e+00_r8,0.10648e+00_r8,0.84781e-01_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.59231e-01_r8,0.86426e-01_r8,0.99996e-01_r8,0.10847e+00_r8,0.11329e+00_r8, & + & 0.11518e+00_r8,0.11401e+00_r8,0.10821e+00_r8,0.86727e-01_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.60793e-01_r8,0.88335e-01_r8,0.10220e+00_r8,0.11080e+00_r8,0.11568e+00_r8, & + & 0.11734e+00_r8,0.11592e+00_r8,0.11003e+00_r8,0.88652e-01_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.62288e-01_r8,0.90379e-01_r8,0.10449e+00_r8,0.11321e+00_r8,0.11819e+00_r8, & + & 0.11985e+00_r8,0.11808e+00_r8,0.11193e+00_r8,0.90608e-01_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.73370e+00_r8,0.66239e+00_r8,0.64754e+00_r8,0.65671e+00_r8,0.64798e+00_r8, & + & 0.62443e+00_r8,0.62156e+00_r8,0.59642e+00_r8,0.65694e+00_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.72227e+00_r8,0.65245e+00_r8,0.64115e+00_r8,0.65244e+00_r8,0.64519e+00_r8, & + & 0.62272e+00_r8,0.62178e+00_r8,0.59807e+00_r8,0.65734e+00_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.71096e+00_r8,0.64287e+00_r8,0.63490e+00_r8,0.64719e+00_r8,0.64246e+00_r8, & + & 0.61928e+00_r8,0.62164e+00_r8,0.59971e+00_r8,0.65975e+00_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.69997e+00_r8,0.63340e+00_r8,0.62893e+00_r8,0.64188e+00_r8,0.63859e+00_r8, & + & 0.61601e+00_r8,0.62127e+00_r8,0.59924e+00_r8,0.66003e+00_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.68921e+00_r8,0.62412e+00_r8,0.62274e+00_r8,0.63660e+00_r8,0.63341e+00_r8, & + & 0.61371e+00_r8,0.61976e+00_r8,0.59796e+00_r8,0.65874e+00_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.71435e+00_r8,0.65898e+00_r8,0.65791e+00_r8,0.67621e+00_r8,0.66803e+00_r8, & + & 0.63952e+00_r8,0.62227e+00_r8,0.60345e+00_r8,0.64341e+00_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.70295e+00_r8,0.64927e+00_r8,0.65209e+00_r8,0.67168e+00_r8,0.66601e+00_r8, & + & 0.63761e+00_r8,0.62183e+00_r8,0.60472e+00_r8,0.64489e+00_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.69214e+00_r8,0.64012e+00_r8,0.64637e+00_r8,0.66639e+00_r8,0.66353e+00_r8, & + & 0.63487e+00_r8,0.62217e+00_r8,0.60467e+00_r8,0.64521e+00_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.68145e+00_r8,0.63089e+00_r8,0.64022e+00_r8,0.66099e+00_r8,0.65898e+00_r8, & + & 0.63312e+00_r8,0.62106e+00_r8,0.60298e+00_r8,0.64380e+00_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.67068e+00_r8,0.62208e+00_r8,0.63390e+00_r8,0.65546e+00_r8,0.65376e+00_r8, & + & 0.63122e+00_r8,0.61818e+00_r8,0.60158e+00_r8,0.64256e+00_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.68340e+00_r8,0.64482e+00_r8,0.66290e+00_r8,0.68284e+00_r8,0.67896e+00_r8, & + & 0.65800e+00_r8,0.61589e+00_r8,0.60026e+00_r8,0.62209e+00_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.67251e+00_r8,0.63550e+00_r8,0.65818e+00_r8,0.67891e+00_r8,0.67722e+00_r8, & + & 0.65575e+00_r8,0.61745e+00_r8,0.60017e+00_r8,0.62247e+00_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.66182e+00_r8,0.62604e+00_r8,0.65231e+00_r8,0.67447e+00_r8,0.67369e+00_r8, & + & 0.65314e+00_r8,0.61804e+00_r8,0.59851e+00_r8,0.62084e+00_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.65114e+00_r8,0.61727e+00_r8,0.64569e+00_r8,0.67007e+00_r8,0.66854e+00_r8, & + & 0.65146e+00_r8,0.61713e+00_r8,0.59641e+00_r8,0.61922e+00_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.64110e+00_r8,0.60881e+00_r8,0.63926e+00_r8,0.66468e+00_r8,0.66347e+00_r8, & + & 0.64931e+00_r8,0.61433e+00_r8,0.59600e+00_r8,0.61885e+00_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.64233e+00_r8,0.62207e+00_r8,0.65747e+00_r8,0.67845e+00_r8,0.68170e+00_r8, & + & 0.66374e+00_r8,0.61548e+00_r8,0.59270e+00_r8,0.60473e+00_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.63185e+00_r8,0.61324e+00_r8,0.65237e+00_r8,0.67473e+00_r8,0.67959e+00_r8, & + & 0.66215e+00_r8,0.61741e+00_r8,0.59134e+00_r8,0.60361e+00_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.62122e+00_r8,0.60440e+00_r8,0.64660e+00_r8,0.67096e+00_r8,0.67570e+00_r8, & + & 0.66004e+00_r8,0.61834e+00_r8,0.58886e+00_r8,0.60079e+00_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.61111e+00_r8,0.59616e+00_r8,0.64034e+00_r8,0.66675e+00_r8,0.67073e+00_r8, & + & 0.65786e+00_r8,0.61721e+00_r8,0.58692e+00_r8,0.59978e+00_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.60223e+00_r8,0.58851e+00_r8,0.63401e+00_r8,0.66136e+00_r8,0.66631e+00_r8, & + & 0.65503e+00_r8,0.61469e+00_r8,0.58697e+00_r8,0.60040e+00_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.59185e+00_r8,0.59370e+00_r8,0.63992e+00_r8,0.66463e+00_r8,0.67279e+00_r8, & + & 0.65610e+00_r8,0.61852e+00_r8,0.58331e+00_r8,0.58763e+00_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.58158e+00_r8,0.58584e+00_r8,0.63500e+00_r8,0.66123e+00_r8,0.67045e+00_r8, & + & 0.65504e+00_r8,0.62015e+00_r8,0.58225e+00_r8,0.58623e+00_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.57197e+00_r8,0.57827e+00_r8,0.62932e+00_r8,0.65791e+00_r8,0.66630e+00_r8, & + & 0.65353e+00_r8,0.61959e+00_r8,0.58025e+00_r8,0.58483e+00_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.56277e+00_r8,0.57099e+00_r8,0.62369e+00_r8,0.65326e+00_r8,0.66229e+00_r8, & + & 0.65156e+00_r8,0.61745e+00_r8,0.57913e+00_r8,0.58544e+00_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.55581e+00_r8,0.56431e+00_r8,0.61807e+00_r8,0.64784e+00_r8,0.65855e+00_r8, & + & 0.64845e+00_r8,0.61479e+00_r8,0.57987e+00_r8,0.58646e+00_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.53954e+00_r8,0.56255e+00_r8,0.61290e+00_r8,0.64303e+00_r8,0.64974e+00_r8, & + & 0.64176e+00_r8,0.61714e+00_r8,0.56940e+00_r8,0.56484e+00_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.53060e+00_r8,0.55651e+00_r8,0.60789e+00_r8,0.63988e+00_r8,0.64820e+00_r8, & + & 0.64042e+00_r8,0.61834e+00_r8,0.56932e+00_r8,0.56418e+00_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.52216e+00_r8,0.54988e+00_r8,0.60294e+00_r8,0.63619e+00_r8,0.64521e+00_r8, & + & 0.63878e+00_r8,0.61726e+00_r8,0.56850e+00_r8,0.56474e+00_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.51474e+00_r8,0.54331e+00_r8,0.59815e+00_r8,0.63165e+00_r8,0.64200e+00_r8, & + & 0.63625e+00_r8,0.61431e+00_r8,0.56860e+00_r8,0.56684e+00_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.51206e+00_r8,0.53704e+00_r8,0.59303e+00_r8,0.62695e+00_r8,0.63853e+00_r8, & + & 0.63290e+00_r8,0.61169e+00_r8,0.57018e+00_r8,0.56804e+00_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.49102e+00_r8,0.52896e+00_r8,0.58005e+00_r8,0.60940e+00_r8,0.62179e+00_r8, & + & 0.62452e+00_r8,0.60693e+00_r8,0.55666e+00_r8,0.53830e+00_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.48351e+00_r8,0.52394e+00_r8,0.57551e+00_r8,0.60647e+00_r8,0.62043e+00_r8, & + & 0.62318e+00_r8,0.60808e+00_r8,0.55693e+00_r8,0.53902e+00_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.47604e+00_r8,0.51848e+00_r8,0.57124e+00_r8,0.60324e+00_r8,0.61835e+00_r8, & + & 0.62080e+00_r8,0.60698e+00_r8,0.55691e+00_r8,0.54116e+00_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.47121e+00_r8,0.51294e+00_r8,0.56659e+00_r8,0.59937e+00_r8,0.61527e+00_r8, & + & 0.61807e+00_r8,0.60502e+00_r8,0.55819e+00_r8,0.54361e+00_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.47306e+00_r8,0.50884e+00_r8,0.56199e+00_r8,0.59548e+00_r8,0.61135e+00_r8, & + & 0.61474e+00_r8,0.60372e+00_r8,0.56024e+00_r8,0.54444e+00_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.44396e+00_r8,0.49532e+00_r8,0.54249e+00_r8,0.57145e+00_r8,0.59186e+00_r8, & + & 0.60060e+00_r8,0.58785e+00_r8,0.54441e+00_r8,0.50913e+00_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.43707e+00_r8,0.49048e+00_r8,0.53914e+00_r8,0.56868e+00_r8,0.59107e+00_r8, & + & 0.60049e+00_r8,0.58883e+00_r8,0.54507e+00_r8,0.51101e+00_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.43098e+00_r8,0.48531e+00_r8,0.53541e+00_r8,0.56592e+00_r8,0.58911e+00_r8, & + & 0.59846e+00_r8,0.58812e+00_r8,0.54578e+00_r8,0.51441e+00_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.42957e+00_r8,0.48093e+00_r8,0.53173e+00_r8,0.56262e+00_r8,0.58636e+00_r8, & + & 0.59589e+00_r8,0.58708e+00_r8,0.54776e+00_r8,0.51773e+00_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.43487e+00_r8,0.48035e+00_r8,0.52822e+00_r8,0.55903e+00_r8,0.58272e+00_r8, & + & 0.59353e+00_r8,0.58697e+00_r8,0.54985e+00_r8,0.51918e+00_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.39531e+00_r8,0.46021e+00_r8,0.50510e+00_r8,0.53588e+00_r8,0.55895e+00_r8, & + & 0.56979e+00_r8,0.56191e+00_r8,0.52659e+00_r8,0.47758e+00_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.38905e+00_r8,0.45517e+00_r8,0.50180e+00_r8,0.53416e+00_r8,0.55846e+00_r8, & + & 0.57047e+00_r8,0.56355e+00_r8,0.52717e+00_r8,0.48088e+00_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.38493e+00_r8,0.45067e+00_r8,0.49854e+00_r8,0.53220e+00_r8,0.55699e+00_r8, & + & 0.56934e+00_r8,0.56332e+00_r8,0.52868e+00_r8,0.48536e+00_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.38723e+00_r8,0.44786e+00_r8,0.49546e+00_r8,0.52928e+00_r8,0.55471e+00_r8, & + & 0.56730e+00_r8,0.56372e+00_r8,0.53178e+00_r8,0.48902e+00_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.39433e+00_r8,0.45054e+00_r8,0.49350e+00_r8,0.52621e+00_r8,0.55192e+00_r8, & + & 0.56604e+00_r8,0.56481e+00_r8,0.53491e+00_r8,0.49067e+00_r8 /) + kao(:, 1,10,10) = (/ & + & 0.34716e+00_r8,0.41992e+00_r8,0.46841e+00_r8,0.50264e+00_r8,0.52377e+00_r8, & + & 0.53462e+00_r8,0.53096e+00_r8,0.50215e+00_r8,0.44481e+00_r8 /) + kao(:, 2,10,10) = (/ & + & 0.34195e+00_r8,0.41601e+00_r8,0.46506e+00_r8,0.50165e+00_r8,0.52385e+00_r8, & + & 0.53574e+00_r8,0.53310e+00_r8,0.50401e+00_r8,0.44924e+00_r8 /) + kao(:, 3,10,10) = (/ & + & 0.34072e+00_r8,0.41255e+00_r8,0.46265e+00_r8,0.50007e+00_r8,0.52273e+00_r8, & + & 0.53553e+00_r8,0.53434e+00_r8,0.50668e+00_r8,0.45414e+00_r8 /) + kao(:, 4,10,10) = (/ & + & 0.34572e+00_r8,0.41258e+00_r8,0.46029e+00_r8,0.49770e+00_r8,0.52100e+00_r8, & + & 0.53482e+00_r8,0.53633e+00_r8,0.51056e+00_r8,0.45768e+00_r8 /) + kao(:, 5,10,10) = (/ & + & 0.35242e+00_r8,0.41826e+00_r8,0.46028e+00_r8,0.49520e+00_r8,0.51927e+00_r8, & + & 0.53500e+00_r8,0.53892e+00_r8,0.51405e+00_r8,0.45947e+00_r8 /) + kao(:, 1,11,10) = (/ & + & 0.30160e+00_r8,0.37714e+00_r8,0.42971e+00_r8,0.46717e+00_r8,0.48926e+00_r8, & + & 0.49871e+00_r8,0.49756e+00_r8,0.47436e+00_r8,0.41261e+00_r8 /) + kao(:, 2,11,10) = (/ & + & 0.29962e+00_r8,0.37395e+00_r8,0.42779e+00_r8,0.46654e+00_r8,0.48929e+00_r8, & + & 0.49998e+00_r8,0.50016e+00_r8,0.47769e+00_r8,0.41819e+00_r8 /) + kao(:, 3,11,10) = (/ & + & 0.30371e+00_r8,0.37339e+00_r8,0.42611e+00_r8,0.46502e+00_r8,0.48821e+00_r8, & + & 0.50080e+00_r8,0.50323e+00_r8,0.48215e+00_r8,0.42266e+00_r8 /) + kao(:, 4,11,10) = (/ & + & 0.30955e+00_r8,0.37857e+00_r8,0.42639e+00_r8,0.46320e+00_r8,0.48745e+00_r8, & + & 0.50213e+00_r8,0.50694e+00_r8,0.48639e+00_r8,0.42570e+00_r8 /) + kao(:, 5,11,10) = (/ & + & 0.31511e+00_r8,0.38606e+00_r8,0.43107e+00_r8,0.46346e+00_r8,0.48731e+00_r8, & + & 0.50398e+00_r8,0.50975e+00_r8,0.48945e+00_r8,0.42790e+00_r8 /) + kao(:, 1,12,10) = (/ & + & 0.26311e+00_r8,0.33847e+00_r8,0.39159e+00_r8,0.42993e+00_r8,0.45370e+00_r8, & + & 0.46372e+00_r8,0.46279e+00_r8,0.44427e+00_r8,0.37907e+00_r8 /) + kao(:, 2,12,10) = (/ & + & 0.26583e+00_r8,0.33679e+00_r8,0.39073e+00_r8,0.42938e+00_r8,0.45415e+00_r8, & + & 0.46569e+00_r8,0.46639e+00_r8,0.44945e+00_r8,0.38485e+00_r8 /) + kao(:, 3,12,10) = (/ & + & 0.27082e+00_r8,0.34071e+00_r8,0.39077e+00_r8,0.42842e+00_r8,0.45412e+00_r8, & + & 0.46820e+00_r8,0.47089e+00_r8,0.45477e+00_r8,0.38900e+00_r8 /) + kao(:, 4,12,10) = (/ & + & 0.27574e+00_r8,0.34733e+00_r8,0.39532e+00_r8,0.42923e+00_r8,0.45504e+00_r8, & + & 0.47097e+00_r8,0.47486e+00_r8,0.45848e+00_r8,0.39247e+00_r8 /) + kao(:, 5,12,10) = (/ & + & 0.28099e+00_r8,0.35386e+00_r8,0.40190e+00_r8,0.43447e+00_r8,0.45757e+00_r8, & + & 0.47294e+00_r8,0.47760e+00_r8,0.46125e+00_r8,0.39629e+00_r8 /) + kao(:, 1,13,10) = (/ & + & 0.23133e+00_r8,0.30448e+00_r8,0.35592e+00_r8,0.39245e+00_r8,0.41703e+00_r8, & + & 0.42944e+00_r8,0.42838e+00_r8,0.41191e+00_r8,0.34405e+00_r8 /) + kao(:, 2,13,10) = (/ & + & 0.23569e+00_r8,0.30675e+00_r8,0.35574e+00_r8,0.39238e+00_r8,0.41854e+00_r8, & + & 0.43261e+00_r8,0.43319e+00_r8,0.41851e+00_r8,0.34979e+00_r8 /) + kao(:, 3,13,10) = (/ & + & 0.23995e+00_r8,0.31287e+00_r8,0.35958e+00_r8,0.39339e+00_r8,0.42025e+00_r8, & + & 0.43649e+00_r8,0.43814e+00_r8,0.42387e+00_r8,0.35427e+00_r8 /) + kao(:, 4,13,10) = (/ & + & 0.24491e+00_r8,0.31868e+00_r8,0.36597e+00_r8,0.39887e+00_r8,0.42348e+00_r8, & + & 0.43960e+00_r8,0.44180e+00_r8,0.42781e+00_r8,0.35946e+00_r8 /) + kao(:, 5,13,10) = (/ & + & 0.25204e+00_r8,0.32443e+00_r8,0.37244e+00_r8,0.40709e+00_r8,0.42924e+00_r8, & + & 0.44176e+00_r8,0.44465e+00_r8,0.43196e+00_r8,0.36481e+00_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.10293e+01_r8,0.90445e+00_r8,0.86137e+00_r8,0.83022e+00_r8,0.84086e+00_r8, & + & 0.86548e+00_r8,0.85587e+00_r8,0.85325e+00_r8,0.97261e+00_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.10191e+01_r8,0.89556e+00_r8,0.85472e+00_r8,0.82839e+00_r8,0.83827e+00_r8, & + & 0.86712e+00_r8,0.85626e+00_r8,0.85096e+00_r8,0.97088e+00_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.10070e+01_r8,0.88513e+00_r8,0.84750e+00_r8,0.82570e+00_r8,0.83354e+00_r8, & + & 0.86668e+00_r8,0.85692e+00_r8,0.84837e+00_r8,0.96710e+00_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.99477e+00_r8,0.87449e+00_r8,0.83958e+00_r8,0.82146e+00_r8,0.82897e+00_r8, & + & 0.86436e+00_r8,0.85744e+00_r8,0.84703e+00_r8,0.96450e+00_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.98126e+00_r8,0.86272e+00_r8,0.83128e+00_r8,0.81555e+00_r8,0.82401e+00_r8, & + & 0.85929e+00_r8,0.85825e+00_r8,0.84707e+00_r8,0.96358e+00_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.10475e+01_r8,0.93151e+00_r8,0.89830e+00_r8,0.88420e+00_r8,0.87933e+00_r8, & + & 0.87846e+00_r8,0.87987e+00_r8,0.86086e+00_r8,0.97265e+00_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.10370e+01_r8,0.92196e+00_r8,0.89215e+00_r8,0.88284e+00_r8,0.87783e+00_r8, & + & 0.88073e+00_r8,0.88059e+00_r8,0.85882e+00_r8,0.96972e+00_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.10244e+01_r8,0.91082e+00_r8,0.88511e+00_r8,0.87976e+00_r8,0.87455e+00_r8, & + & 0.88046e+00_r8,0.88070e+00_r8,0.85623e+00_r8,0.96599e+00_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.10111e+01_r8,0.89911e+00_r8,0.87761e+00_r8,0.87481e+00_r8,0.87132e+00_r8, & + & 0.87692e+00_r8,0.88074e+00_r8,0.85652e+00_r8,0.96500e+00_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.99734e+00_r8,0.88696e+00_r8,0.86940e+00_r8,0.86908e+00_r8,0.86706e+00_r8, & + & 0.87191e+00_r8,0.88156e+00_r8,0.85742e+00_r8,0.96567e+00_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.10481e+01_r8,0.94949e+00_r8,0.92754e+00_r8,0.93134e+00_r8,0.92020e+00_r8, & + & 0.88963e+00_r8,0.89353e+00_r8,0.87368e+00_r8,0.96341e+00_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.10364e+01_r8,0.93961e+00_r8,0.92141e+00_r8,0.92962e+00_r8,0.91951e+00_r8, & + & 0.89266e+00_r8,0.89347e+00_r8,0.87218e+00_r8,0.95995e+00_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.10237e+01_r8,0.92877e+00_r8,0.91434e+00_r8,0.92574e+00_r8,0.91740e+00_r8, & + & 0.89302e+00_r8,0.89281e+00_r8,0.87167e+00_r8,0.95907e+00_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.10107e+01_r8,0.91711e+00_r8,0.90716e+00_r8,0.92023e+00_r8,0.91517e+00_r8, & + & 0.89037e+00_r8,0.89222e+00_r8,0.87266e+00_r8,0.95928e+00_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.99633e+00_r8,0.90470e+00_r8,0.89927e+00_r8,0.91439e+00_r8,0.91120e+00_r8, & + & 0.88600e+00_r8,0.89266e+00_r8,0.87273e+00_r8,0.95886e+00_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.10264e+01_r8,0.95071e+00_r8,0.94674e+00_r8,0.96322e+00_r8,0.95099e+00_r8, & + & 0.91374e+00_r8,0.89446e+00_r8,0.87855e+00_r8,0.93628e+00_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.10149e+01_r8,0.94036e+00_r8,0.94196e+00_r8,0.96089e+00_r8,0.95153e+00_r8, & + & 0.91752e+00_r8,0.89401e+00_r8,0.87842e+00_r8,0.93496e+00_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.10022e+01_r8,0.92957e+00_r8,0.93566e+00_r8,0.95688e+00_r8,0.95066e+00_r8, & + & 0.91784e+00_r8,0.89284e+00_r8,0.87926e+00_r8,0.93586e+00_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.98847e+00_r8,0.91773e+00_r8,0.92854e+00_r8,0.95134e+00_r8,0.94862e+00_r8, & + & 0.91547e+00_r8,0.89366e+00_r8,0.87951e+00_r8,0.93591e+00_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.97390e+00_r8,0.90550e+00_r8,0.92045e+00_r8,0.94604e+00_r8,0.94431e+00_r8, & + & 0.91218e+00_r8,0.89395e+00_r8,0.87858e+00_r8,0.93476e+00_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.98609e+00_r8,0.93424e+00_r8,0.95643e+00_r8,0.97684e+00_r8,0.96999e+00_r8, & + & 0.93774e+00_r8,0.88693e+00_r8,0.86915e+00_r8,0.90145e+00_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.97412e+00_r8,0.92401e+00_r8,0.95137e+00_r8,0.97507e+00_r8,0.97005e+00_r8, & + & 0.94299e+00_r8,0.88698e+00_r8,0.86947e+00_r8,0.90218e+00_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.96114e+00_r8,0.91242e+00_r8,0.94531e+00_r8,0.97096e+00_r8,0.96958e+00_r8, & + & 0.94325e+00_r8,0.88812e+00_r8,0.86965e+00_r8,0.90220e+00_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.94742e+00_r8,0.90067e+00_r8,0.93796e+00_r8,0.96622e+00_r8,0.96802e+00_r8, & + & 0.94082e+00_r8,0.89013e+00_r8,0.86974e+00_r8,0.90156e+00_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.93336e+00_r8,0.88866e+00_r8,0.92975e+00_r8,0.96102e+00_r8,0.96365e+00_r8, & + & 0.93814e+00_r8,0.89133e+00_r8,0.86813e+00_r8,0.89955e+00_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.92984e+00_r8,0.90494e+00_r8,0.94972e+00_r8,0.97425e+00_r8,0.97662e+00_r8, & + & 0.94556e+00_r8,0.88351e+00_r8,0.85584e+00_r8,0.87463e+00_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.91725e+00_r8,0.89370e+00_r8,0.94535e+00_r8,0.97222e+00_r8,0.97680e+00_r8, & + & 0.95110e+00_r8,0.88518e+00_r8,0.85597e+00_r8,0.87435e+00_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.90427e+00_r8,0.88250e+00_r8,0.93903e+00_r8,0.96844e+00_r8,0.97606e+00_r8, & + & 0.95304e+00_r8,0.88753e+00_r8,0.85497e+00_r8,0.87307e+00_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.89063e+00_r8,0.87150e+00_r8,0.93110e+00_r8,0.96495e+00_r8,0.97386e+00_r8, & + & 0.95208e+00_r8,0.89056e+00_r8,0.85380e+00_r8,0.87067e+00_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.87675e+00_r8,0.86027e+00_r8,0.92261e+00_r8,0.96002e+00_r8,0.96930e+00_r8, & + & 0.94959e+00_r8,0.89201e+00_r8,0.85155e+00_r8,0.86905e+00_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.85919e+00_r8,0.86562e+00_r8,0.92649e+00_r8,0.95965e+00_r8,0.96523e+00_r8, & + & 0.93650e+00_r8,0.88529e+00_r8,0.84057e+00_r8,0.84722e+00_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.84717e+00_r8,0.85599e+00_r8,0.92166e+00_r8,0.95676e+00_r8,0.96677e+00_r8, & + & 0.94156e+00_r8,0.88807e+00_r8,0.84087e+00_r8,0.84785e+00_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.83473e+00_r8,0.84556e+00_r8,0.91525e+00_r8,0.95342e+00_r8,0.96579e+00_r8, & + & 0.94506e+00_r8,0.89084e+00_r8,0.83990e+00_r8,0.84680e+00_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.82211e+00_r8,0.83508e+00_r8,0.90782e+00_r8,0.94944e+00_r8,0.96296e+00_r8, & + & 0.94530e+00_r8,0.89295e+00_r8,0.83822e+00_r8,0.84533e+00_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.80945e+00_r8,0.82542e+00_r8,0.90011e+00_r8,0.94513e+00_r8,0.95957e+00_r8, & + & 0.94356e+00_r8,0.89326e+00_r8,0.83636e+00_r8,0.84582e+00_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.78535e+00_r8,0.81958e+00_r8,0.89069e+00_r8,0.92943e+00_r8,0.93702e+00_r8, & + & 0.91895e+00_r8,0.88182e+00_r8,0.81942e+00_r8,0.81355e+00_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.77455e+00_r8,0.81120e+00_r8,0.88449e+00_r8,0.92737e+00_r8,0.93847e+00_r8, & + & 0.92275e+00_r8,0.88568e+00_r8,0.82187e+00_r8,0.81529e+00_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.76320e+00_r8,0.80325e+00_r8,0.87799e+00_r8,0.92413e+00_r8,0.93785e+00_r8, & + & 0.92584e+00_r8,0.88848e+00_r8,0.82246e+00_r8,0.81526e+00_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.75209e+00_r8,0.79461e+00_r8,0.87173e+00_r8,0.92037e+00_r8,0.93562e+00_r8, & + & 0.92659e+00_r8,0.89042e+00_r8,0.82203e+00_r8,0.81583e+00_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.74191e+00_r8,0.78569e+00_r8,0.86500e+00_r8,0.91565e+00_r8,0.93275e+00_r8, & + & 0.92508e+00_r8,0.89021e+00_r8,0.82215e+00_r8,0.81833e+00_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.71539e+00_r8,0.77045e+00_r8,0.84442e+00_r8,0.88339e+00_r8,0.89968e+00_r8, & + & 0.89536e+00_r8,0.86841e+00_r8,0.79955e+00_r8,0.77318e+00_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.70564e+00_r8,0.76424e+00_r8,0.83867e+00_r8,0.88222e+00_r8,0.90019e+00_r8, & + & 0.89929e+00_r8,0.87308e+00_r8,0.80390e+00_r8,0.77664e+00_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.69566e+00_r8,0.75811e+00_r8,0.83280e+00_r8,0.87940e+00_r8,0.90026e+00_r8, & + & 0.90222e+00_r8,0.87663e+00_r8,0.80593e+00_r8,0.77834e+00_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.68611e+00_r8,0.75067e+00_r8,0.82727e+00_r8,0.87623e+00_r8,0.89845e+00_r8, & + & 0.90248e+00_r8,0.87886e+00_r8,0.80698e+00_r8,0.78085e+00_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.67924e+00_r8,0.74336e+00_r8,0.82173e+00_r8,0.87192e+00_r8,0.89575e+00_r8, & + & 0.90118e+00_r8,0.87929e+00_r8,0.80840e+00_r8,0.78556e+00_r8 /) + kao(:, 1,10,11) = (/ & + & 0.64750e+00_r8,0.72291e+00_r8,0.79049e+00_r8,0.83093e+00_r8,0.85723e+00_r8, & + & 0.86420e+00_r8,0.84410e+00_r8,0.78062e+00_r8,0.72995e+00_r8 /) + kao(:, 2,10,11) = (/ & + & 0.63786e+00_r8,0.71701e+00_r8,0.78689e+00_r8,0.82920e+00_r8,0.85838e+00_r8, & + & 0.86903e+00_r8,0.84994e+00_r8,0.78581e+00_r8,0.73484e+00_r8 /) + kao(:, 3,10,11) = (/ & + & 0.62879e+00_r8,0.71055e+00_r8,0.78212e+00_r8,0.82630e+00_r8,0.85919e+00_r8, & + & 0.87234e+00_r8,0.85358e+00_r8,0.78925e+00_r8,0.73873e+00_r8 /) + kao(:, 4,10,11) = (/ & + & 0.62087e+00_r8,0.70389e+00_r8,0.77761e+00_r8,0.82356e+00_r8,0.85812e+00_r8, & + & 0.87281e+00_r8,0.85602e+00_r8,0.79174e+00_r8,0.74394e+00_r8 /) + kao(:, 5,10,11) = (/ & + & 0.61947e+00_r8,0.69759e+00_r8,0.77360e+00_r8,0.82013e+00_r8,0.85542e+00_r8, & + & 0.87157e+00_r8,0.85709e+00_r8,0.79529e+00_r8,0.75052e+00_r8 /) + kao(:, 1,11,11) = (/ & + & 0.57317e+00_r8,0.67082e+00_r8,0.73559e+00_r8,0.77934e+00_r8,0.81170e+00_r8, & + & 0.82582e+00_r8,0.81431e+00_r8,0.75887e+00_r8,0.68710e+00_r8 /) + kao(:, 2,11,11) = (/ & + & 0.56447e+00_r8,0.66437e+00_r8,0.73216e+00_r8,0.77740e+00_r8,0.81370e+00_r8, & + & 0.83183e+00_r8,0.81926e+00_r8,0.76438e+00_r8,0.69316e+00_r8 /) + kao(:, 3,11,11) = (/ & + & 0.55710e+00_r8,0.65798e+00_r8,0.72792e+00_r8,0.77609e+00_r8,0.81480e+00_r8, & + & 0.83377e+00_r8,0.82304e+00_r8,0.76833e+00_r8,0.70018e+00_r8 /) + kao(:, 4,11,11) = (/ & + & 0.55630e+00_r8,0.65257e+00_r8,0.72437e+00_r8,0.77329e+00_r8,0.81397e+00_r8, & + & 0.83437e+00_r8,0.82566e+00_r8,0.77320e+00_r8,0.70886e+00_r8 /) + kao(:, 5,11,11) = (/ & + & 0.56411e+00_r8,0.65194e+00_r8,0.72119e+00_r8,0.77017e+00_r8,0.81118e+00_r8, & + & 0.83405e+00_r8,0.82785e+00_r8,0.77913e+00_r8,0.71658e+00_r8 /) + kao(:, 1,12,11) = (/ & + & 0.50093e+00_r8,0.61265e+00_r8,0.68222e+00_r8,0.73081e+00_r8,0.76376e+00_r8, & + & 0.78196e+00_r8,0.77611e+00_r8,0.73046e+00_r8,0.64374e+00_r8 /) + kao(:, 2,12,11) = (/ & + & 0.49374e+00_r8,0.60693e+00_r8,0.67860e+00_r8,0.73087e+00_r8,0.76701e+00_r8, & + & 0.78657e+00_r8,0.78196e+00_r8,0.73646e+00_r8,0.65183e+00_r8 /) + kao(:, 3,12,11) = (/ & + & 0.49262e+00_r8,0.60232e+00_r8,0.67517e+00_r8,0.73017e+00_r8,0.76805e+00_r8, & + & 0.78863e+00_r8,0.78651e+00_r8,0.74261e+00_r8,0.66205e+00_r8 /) + kao(:, 4,12,11) = (/ & + & 0.49989e+00_r8,0.60234e+00_r8,0.67259e+00_r8,0.72790e+00_r8,0.76753e+00_r8, & + & 0.79017e+00_r8,0.79054e+00_r8,0.75027e+00_r8,0.67174e+00_r8 /) + kao(:, 5,12,11) = (/ & + & 0.51177e+00_r8,0.60963e+00_r8,0.67313e+00_r8,0.72489e+00_r8,0.76606e+00_r8, & + & 0.79187e+00_r8,0.79524e+00_r8,0.75809e+00_r8,0.67955e+00_r8 /) + kao(:, 1,13,11) = (/ & + & 0.43610e+00_r8,0.55280e+00_r8,0.62805e+00_r8,0.68236e+00_r8,0.71726e+00_r8, & + & 0.73439e+00_r8,0.73316e+00_r8,0.69581e+00_r8,0.60098e+00_r8 /) + kao(:, 2,13,11) = (/ & + & 0.43332e+00_r8,0.54879e+00_r8,0.62602e+00_r8,0.68387e+00_r8,0.71981e+00_r8, & + & 0.73863e+00_r8,0.74004e+00_r8,0.70395e+00_r8,0.61188e+00_r8 /) + kao(:, 3,13,11) = (/ & + & 0.43938e+00_r8,0.54819e+00_r8,0.62420e+00_r8,0.68392e+00_r8,0.72120e+00_r8, & + & 0.74159e+00_r8,0.74634e+00_r8,0.71286e+00_r8,0.62343e+00_r8 /) + kao(:, 4,13,11) = (/ & + & 0.44997e+00_r8,0.55515e+00_r8,0.62479e+00_r8,0.68255e+00_r8,0.72173e+00_r8, & + & 0.74510e+00_r8,0.75297e+00_r8,0.72278e+00_r8,0.63265e+00_r8 /) + kao(:, 5,13,11) = (/ & + & 0.46055e+00_r8,0.56787e+00_r8,0.63110e+00_r8,0.68248e+00_r8,0.72225e+00_r8, & + & 0.74921e+00_r8,0.75987e+00_r8,0.73098e+00_r8,0.64026e+00_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.14171e+01_r8,0.12412e+01_r8,0.11453e+01_r8,0.11122e+01_r8,0.11253e+01_r8, & + & 0.11573e+01_r8,0.11791e+01_r8,0.12973e+01_r8,0.14638e+01_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.14090e+01_r8,0.12342e+01_r8,0.11388e+01_r8,0.11095e+01_r8,0.11322e+01_r8, & + & 0.11607e+01_r8,0.11781e+01_r8,0.12938e+01_r8,0.14611e+01_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.13994e+01_r8,0.12258e+01_r8,0.11299e+01_r8,0.11046e+01_r8,0.11339e+01_r8, & + & 0.11641e+01_r8,0.11762e+01_r8,0.12907e+01_r8,0.14569e+01_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.13872e+01_r8,0.12151e+01_r8,0.11205e+01_r8,0.10983e+01_r8,0.11321e+01_r8, & + & 0.11655e+01_r8,0.11746e+01_r8,0.12884e+01_r8,0.14537e+01_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.13737e+01_r8,0.12034e+01_r8,0.11101e+01_r8,0.10915e+01_r8,0.11280e+01_r8, & + & 0.11664e+01_r8,0.11724e+01_r8,0.12834e+01_r8,0.14491e+01_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.15051e+01_r8,0.13181e+01_r8,0.12304e+01_r8,0.11719e+01_r8,0.11855e+01_r8, & + & 0.12309e+01_r8,0.12496e+01_r8,0.13203e+01_r8,0.15049e+01_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.14984e+01_r8,0.13123e+01_r8,0.12250e+01_r8,0.11699e+01_r8,0.11925e+01_r8, & + & 0.12340e+01_r8,0.12487e+01_r8,0.13193e+01_r8,0.15024e+01_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.14884e+01_r8,0.13036e+01_r8,0.12176e+01_r8,0.11665e+01_r8,0.11942e+01_r8, & + & 0.12376e+01_r8,0.12478e+01_r8,0.13196e+01_r8,0.15020e+01_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.14762e+01_r8,0.12929e+01_r8,0.12082e+01_r8,0.11628e+01_r8,0.11911e+01_r8, & + & 0.12406e+01_r8,0.12476e+01_r8,0.13168e+01_r8,0.15001e+01_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.14614e+01_r8,0.12800e+01_r8,0.11975e+01_r8,0.11575e+01_r8,0.11857e+01_r8, & + & 0.12414e+01_r8,0.12460e+01_r8,0.13124e+01_r8,0.14945e+01_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.15822e+01_r8,0.13890e+01_r8,0.13182e+01_r8,0.12547e+01_r8,0.12476e+01_r8, & + & 0.12873e+01_r8,0.13056e+01_r8,0.13300e+01_r8,0.15181e+01_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.15752e+01_r8,0.13826e+01_r8,0.13120e+01_r8,0.12557e+01_r8,0.12556e+01_r8, & + & 0.12906e+01_r8,0.13067e+01_r8,0.13310e+01_r8,0.15193e+01_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.15647e+01_r8,0.13732e+01_r8,0.13046e+01_r8,0.12538e+01_r8,0.12575e+01_r8, & + & 0.12941e+01_r8,0.13084e+01_r8,0.13307e+01_r8,0.15193e+01_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.15514e+01_r8,0.13616e+01_r8,0.12950e+01_r8,0.12500e+01_r8,0.12556e+01_r8, & + & 0.12989e+01_r8,0.13088e+01_r8,0.13292e+01_r8,0.15174e+01_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.15358e+01_r8,0.13480e+01_r8,0.12843e+01_r8,0.12443e+01_r8,0.12517e+01_r8, & + & 0.13009e+01_r8,0.13074e+01_r8,0.13265e+01_r8,0.15142e+01_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.16350e+01_r8,0.14490e+01_r8,0.13916e+01_r8,0.13443e+01_r8,0.13174e+01_r8, & + & 0.13244e+01_r8,0.13476e+01_r8,0.13365e+01_r8,0.15180e+01_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.16281e+01_r8,0.14425e+01_r8,0.13866e+01_r8,0.13479e+01_r8,0.13260e+01_r8, & + & 0.13268e+01_r8,0.13503e+01_r8,0.13390e+01_r8,0.15205e+01_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.16161e+01_r8,0.14310e+01_r8,0.13789e+01_r8,0.13476e+01_r8,0.13293e+01_r8, & + & 0.13314e+01_r8,0.13532e+01_r8,0.13408e+01_r8,0.15220e+01_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.16014e+01_r8,0.14178e+01_r8,0.13691e+01_r8,0.13444e+01_r8,0.13282e+01_r8, & + & 0.13379e+01_r8,0.13534e+01_r8,0.13410e+01_r8,0.15212e+01_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.15848e+01_r8,0.14026e+01_r8,0.13577e+01_r8,0.13378e+01_r8,0.13257e+01_r8, & + & 0.13408e+01_r8,0.13534e+01_r8,0.13387e+01_r8,0.15183e+01_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.16591e+01_r8,0.14947e+01_r8,0.14480e+01_r8,0.14262e+01_r8,0.13903e+01_r8, & + & 0.13587e+01_r8,0.13777e+01_r8,0.13491e+01_r8,0.15046e+01_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.16509e+01_r8,0.14862e+01_r8,0.14440e+01_r8,0.14316e+01_r8,0.13991e+01_r8, & + & 0.13598e+01_r8,0.13805e+01_r8,0.13541e+01_r8,0.15083e+01_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.16386e+01_r8,0.14750e+01_r8,0.14364e+01_r8,0.14307e+01_r8,0.14045e+01_r8, & + & 0.13655e+01_r8,0.13826e+01_r8,0.13579e+01_r8,0.15118e+01_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.16229e+01_r8,0.14605e+01_r8,0.14277e+01_r8,0.14269e+01_r8,0.14036e+01_r8, & + & 0.13722e+01_r8,0.13840e+01_r8,0.13579e+01_r8,0.15115e+01_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.16043e+01_r8,0.14439e+01_r8,0.14169e+01_r8,0.14203e+01_r8,0.14024e+01_r8, & + & 0.13765e+01_r8,0.13831e+01_r8,0.13575e+01_r8,0.15115e+01_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.16482e+01_r8,0.15147e+01_r8,0.14918e+01_r8,0.14883e+01_r8,0.14555e+01_r8, & + & 0.14030e+01_r8,0.13913e+01_r8,0.13585e+01_r8,0.14685e+01_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.16385e+01_r8,0.15059e+01_r8,0.14880e+01_r8,0.14958e+01_r8,0.14629e+01_r8, & + & 0.14056e+01_r8,0.13940e+01_r8,0.13659e+01_r8,0.14762e+01_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.16253e+01_r8,0.14941e+01_r8,0.14803e+01_r8,0.14965e+01_r8,0.14689e+01_r8, & + & 0.14106e+01_r8,0.13970e+01_r8,0.13717e+01_r8,0.14817e+01_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.16089e+01_r8,0.14791e+01_r8,0.14713e+01_r8,0.14908e+01_r8,0.14702e+01_r8, & + & 0.14165e+01_r8,0.13983e+01_r8,0.13748e+01_r8,0.14851e+01_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.15910e+01_r8,0.14633e+01_r8,0.14618e+01_r8,0.14838e+01_r8,0.14693e+01_r8, & + & 0.14213e+01_r8,0.13976e+01_r8,0.13770e+01_r8,0.14876e+01_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.16064e+01_r8,0.15086e+01_r8,0.15144e+01_r8,0.15268e+01_r8,0.15040e+01_r8, & + & 0.14507e+01_r8,0.13904e+01_r8,0.13521e+01_r8,0.14179e+01_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.15953e+01_r8,0.14985e+01_r8,0.15140e+01_r8,0.15345e+01_r8,0.15085e+01_r8, & + & 0.14549e+01_r8,0.13952e+01_r8,0.13604e+01_r8,0.14259e+01_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.15801e+01_r8,0.14851e+01_r8,0.15073e+01_r8,0.15363e+01_r8,0.15134e+01_r8, & + & 0.14598e+01_r8,0.13998e+01_r8,0.13678e+01_r8,0.14328e+01_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.15629e+01_r8,0.14703e+01_r8,0.14995e+01_r8,0.15318e+01_r8,0.15172e+01_r8, & + & 0.14656e+01_r8,0.14020e+01_r8,0.13732e+01_r8,0.14388e+01_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.15443e+01_r8,0.14531e+01_r8,0.14892e+01_r8,0.15236e+01_r8,0.15169e+01_r8, & + & 0.14692e+01_r8,0.14038e+01_r8,0.13766e+01_r8,0.14425e+01_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.15344e+01_r8,0.14766e+01_r8,0.15157e+01_r8,0.15423e+01_r8,0.15330e+01_r8, & + & 0.14811e+01_r8,0.13889e+01_r8,0.13373e+01_r8,0.13698e+01_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.15222e+01_r8,0.14679e+01_r8,0.15175e+01_r8,0.15473e+01_r8,0.15363e+01_r8, & + & 0.14872e+01_r8,0.13948e+01_r8,0.13442e+01_r8,0.13786e+01_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.15059e+01_r8,0.14533e+01_r8,0.15144e+01_r8,0.15489e+01_r8,0.15409e+01_r8, & + & 0.14932e+01_r8,0.14005e+01_r8,0.13518e+01_r8,0.13861e+01_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.14877e+01_r8,0.14368e+01_r8,0.15058e+01_r8,0.15451e+01_r8,0.15445e+01_r8, & + & 0.14989e+01_r8,0.14044e+01_r8,0.13574e+01_r8,0.13922e+01_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.14686e+01_r8,0.14200e+01_r8,0.14953e+01_r8,0.15388e+01_r8,0.15447e+01_r8, & + & 0.15024e+01_r8,0.14082e+01_r8,0.13605e+01_r8,0.13964e+01_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.14373e+01_r8,0.14266e+01_r8,0.14938e+01_r8,0.15367e+01_r8,0.15341e+01_r8, & + & 0.14871e+01_r8,0.13939e+01_r8,0.13173e+01_r8,0.13285e+01_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.14250e+01_r8,0.14168e+01_r8,0.14968e+01_r8,0.15390e+01_r8,0.15386e+01_r8, & + & 0.14934e+01_r8,0.13987e+01_r8,0.13260e+01_r8,0.13388e+01_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.14085e+01_r8,0.14020e+01_r8,0.14946e+01_r8,0.15393e+01_r8,0.15430e+01_r8, & + & 0.14996e+01_r8,0.14050e+01_r8,0.13340e+01_r8,0.13471e+01_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.13898e+01_r8,0.13862e+01_r8,0.14874e+01_r8,0.15365e+01_r8,0.15469e+01_r8, & + & 0.15061e+01_r8,0.14095e+01_r8,0.13387e+01_r8,0.13529e+01_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.13711e+01_r8,0.13694e+01_r8,0.14772e+01_r8,0.15321e+01_r8,0.15481e+01_r8, & + & 0.15103e+01_r8,0.14136e+01_r8,0.13413e+01_r8,0.13557e+01_r8 /) + kao(:, 1,10,12) = (/ & + & 0.13234e+01_r8,0.13585e+01_r8,0.14531e+01_r8,0.15073e+01_r8,0.15094e+01_r8, & + & 0.14728e+01_r8,0.13972e+01_r8,0.12936e+01_r8,0.12835e+01_r8 /) + kao(:, 2,10,12) = (/ & + & 0.13109e+01_r8,0.13494e+01_r8,0.14540e+01_r8,0.15085e+01_r8,0.15139e+01_r8, & + & 0.14784e+01_r8,0.14019e+01_r8,0.13047e+01_r8,0.12968e+01_r8 /) + kao(:, 3,10,12) = (/ & + & 0.12956e+01_r8,0.13371e+01_r8,0.14504e+01_r8,0.15092e+01_r8,0.15192e+01_r8, & + & 0.14835e+01_r8,0.14094e+01_r8,0.13136e+01_r8,0.13076e+01_r8 /) + kao(:, 4,10,12) = (/ & + & 0.12784e+01_r8,0.13237e+01_r8,0.14435e+01_r8,0.15071e+01_r8,0.15234e+01_r8, & + & 0.14905e+01_r8,0.14145e+01_r8,0.13190e+01_r8,0.13139e+01_r8 /) + kao(:, 5,10,12) = (/ & + & 0.12607e+01_r8,0.13090e+01_r8,0.14344e+01_r8,0.15038e+01_r8,0.15261e+01_r8, & + & 0.14956e+01_r8,0.14181e+01_r8,0.13210e+01_r8,0.13178e+01_r8 /) + kao(:, 1,11,12) = (/ & + & 0.12047e+01_r8,0.12789e+01_r8,0.13923e+01_r8,0.14530e+01_r8,0.14659e+01_r8, & + & 0.14483e+01_r8,0.13898e+01_r8,0.12749e+01_r8,0.12386e+01_r8 /) + kao(:, 2,11,12) = (/ & + & 0.11911e+01_r8,0.12701e+01_r8,0.13902e+01_r8,0.14549e+01_r8,0.14710e+01_r8, & + & 0.14517e+01_r8,0.13981e+01_r8,0.12874e+01_r8,0.12546e+01_r8 /) + kao(:, 3,11,12) = (/ & + & 0.11768e+01_r8,0.12599e+01_r8,0.13852e+01_r8,0.14552e+01_r8,0.14760e+01_r8, & + & 0.14581e+01_r8,0.14056e+01_r8,0.12968e+01_r8,0.12644e+01_r8 /) + kao(:, 4,11,12) = (/ & + & 0.11609e+01_r8,0.12491e+01_r8,0.13785e+01_r8,0.14542e+01_r8,0.14794e+01_r8, & + & 0.14643e+01_r8,0.14106e+01_r8,0.13015e+01_r8,0.12707e+01_r8 /) + kao(:, 5,11,12) = (/ & + & 0.11453e+01_r8,0.12370e+01_r8,0.13722e+01_r8,0.14526e+01_r8,0.14820e+01_r8, & + & 0.14680e+01_r8,0.14139e+01_r8,0.13041e+01_r8,0.12775e+01_r8 /) + kao(:, 1,12,12) = (/ & + & 0.10892e+01_r8,0.11978e+01_r8,0.13175e+01_r8,0.13800e+01_r8,0.14113e+01_r8, & + & 0.14104e+01_r8,0.13697e+01_r8,0.12563e+01_r8,0.11895e+01_r8 /) + kao(:, 2,12,12) = (/ & + & 0.10764e+01_r8,0.11912e+01_r8,0.13142e+01_r8,0.13828e+01_r8,0.14151e+01_r8, & + & 0.14161e+01_r8,0.13800e+01_r8,0.12704e+01_r8,0.12046e+01_r8 /) + kao(:, 3,12,12) = (/ & + & 0.10634e+01_r8,0.11835e+01_r8,0.13099e+01_r8,0.13835e+01_r8,0.14196e+01_r8, & + & 0.14241e+01_r8,0.13887e+01_r8,0.12786e+01_r8,0.12148e+01_r8 /) + kao(:, 4,12,12) = (/ & + & 0.10495e+01_r8,0.11751e+01_r8,0.13057e+01_r8,0.13846e+01_r8,0.14230e+01_r8, & + & 0.14300e+01_r8,0.13945e+01_r8,0.12836e+01_r8,0.12244e+01_r8 /) + kao(:, 5,12,12) = (/ & + & 0.10406e+01_r8,0.11650e+01_r8,0.13011e+01_r8,0.13864e+01_r8,0.14254e+01_r8, & + & 0.14322e+01_r8,0.13980e+01_r8,0.12878e+01_r8,0.12342e+01_r8 /) + kao(:, 1,13,12) = (/ & + & 0.97671e+00_r8,0.11194e+01_r8,0.12352e+01_r8,0.13029e+01_r8,0.13468e+01_r8, & + & 0.13623e+01_r8,0.13355e+01_r8,0.12363e+01_r8,0.11351e+01_r8 /) + kao(:, 2,13,12) = (/ & + & 0.96514e+00_r8,0.11135e+01_r8,0.12326e+01_r8,0.13049e+01_r8,0.13523e+01_r8, & + & 0.13721e+01_r8,0.13488e+01_r8,0.12496e+01_r8,0.11500e+01_r8 /) + kao(:, 3,13,12) = (/ & + & 0.95350e+00_r8,0.11073e+01_r8,0.12308e+01_r8,0.13063e+01_r8,0.13575e+01_r8, & + & 0.13815e+01_r8,0.13588e+01_r8,0.12584e+01_r8,0.11629e+01_r8 /) + kao(:, 4,13,12) = (/ & + & 0.94648e+00_r8,0.11002e+01_r8,0.12294e+01_r8,0.13087e+01_r8,0.13617e+01_r8, & + & 0.13873e+01_r8,0.13660e+01_r8,0.12653e+01_r8,0.11761e+01_r8 /) + kao(:, 5,13,12) = (/ & + & 0.94953e+00_r8,0.10941e+01_r8,0.12277e+01_r8,0.13116e+01_r8,0.13645e+01_r8, & + & 0.13901e+01_r8,0.13713e+01_r8,0.12717e+01_r8,0.11896e+01_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.21877e+01_r8,0.19168e+01_r8,0.16830e+01_r8,0.16306e+01_r8,0.15763e+01_r8, & + & 0.15398e+01_r8,0.15859e+01_r8,0.18468e+01_r8,0.20593e+01_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.22022e+01_r8,0.19296e+01_r8,0.16916e+01_r8,0.16400e+01_r8,0.15796e+01_r8, & + & 0.15432e+01_r8,0.15912e+01_r8,0.18534e+01_r8,0.20655e+01_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.22022e+01_r8,0.19297e+01_r8,0.16911e+01_r8,0.16436e+01_r8,0.15885e+01_r8, & + & 0.15469e+01_r8,0.15941e+01_r8,0.18569e+01_r8,0.20695e+01_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.21895e+01_r8,0.19186e+01_r8,0.16803e+01_r8,0.16425e+01_r8,0.15962e+01_r8, & + & 0.15525e+01_r8,0.15947e+01_r8,0.18575e+01_r8,0.20703e+01_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.21697e+01_r8,0.19013e+01_r8,0.16648e+01_r8,0.16344e+01_r8,0.16003e+01_r8, & + & 0.15574e+01_r8,0.15941e+01_r8,0.18572e+01_r8,0.20709e+01_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.22550e+01_r8,0.19753e+01_r8,0.17734e+01_r8,0.17443e+01_r8,0.17102e+01_r8, & + & 0.16986e+01_r8,0.17217e+01_r8,0.19863e+01_r8,0.22329e+01_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.22679e+01_r8,0.19867e+01_r8,0.17791e+01_r8,0.17520e+01_r8,0.17112e+01_r8, & + & 0.17026e+01_r8,0.17283e+01_r8,0.19934e+01_r8,0.22409e+01_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.22698e+01_r8,0.19883e+01_r8,0.17767e+01_r8,0.17568e+01_r8,0.17174e+01_r8, & + & 0.17053e+01_r8,0.17318e+01_r8,0.19966e+01_r8,0.22448e+01_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.22597e+01_r8,0.19796e+01_r8,0.17668e+01_r8,0.17548e+01_r8,0.17261e+01_r8, & + & 0.17073e+01_r8,0.17314e+01_r8,0.19968e+01_r8,0.22451e+01_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.22409e+01_r8,0.19632e+01_r8,0.17511e+01_r8,0.17475e+01_r8,0.17318e+01_r8, & + & 0.17099e+01_r8,0.17295e+01_r8,0.19947e+01_r8,0.22431e+01_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.23526e+01_r8,0.20603e+01_r8,0.18829e+01_r8,0.18493e+01_r8,0.18420e+01_r8, & + & 0.18637e+01_r8,0.18729e+01_r8,0.21122e+01_r8,0.23977e+01_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.23692e+01_r8,0.20749e+01_r8,0.18925e+01_r8,0.18515e+01_r8,0.18400e+01_r8, & + & 0.18683e+01_r8,0.18793e+01_r8,0.21211e+01_r8,0.24079e+01_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.23722e+01_r8,0.20775e+01_r8,0.18924e+01_r8,0.18562e+01_r8,0.18451e+01_r8, & + & 0.18704e+01_r8,0.18820e+01_r8,0.21249e+01_r8,0.24125e+01_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.23635e+01_r8,0.20699e+01_r8,0.18842e+01_r8,0.18555e+01_r8,0.18524e+01_r8, & + & 0.18695e+01_r8,0.18827e+01_r8,0.21252e+01_r8,0.24130e+01_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.23480e+01_r8,0.20564e+01_r8,0.18701e+01_r8,0.18499e+01_r8,0.18587e+01_r8, & + & 0.18689e+01_r8,0.18824e+01_r8,0.21250e+01_r8,0.24123e+01_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.24939e+01_r8,0.21837e+01_r8,0.20232e+01_r8,0.19589e+01_r8,0.19737e+01_r8, & + & 0.20251e+01_r8,0.20263e+01_r8,0.22145e+01_r8,0.25248e+01_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.25110e+01_r8,0.21986e+01_r8,0.20314e+01_r8,0.19589e+01_r8,0.19697e+01_r8, & + & 0.20307e+01_r8,0.20352e+01_r8,0.22253e+01_r8,0.25374e+01_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.25161e+01_r8,0.22032e+01_r8,0.20346e+01_r8,0.19625e+01_r8,0.19727e+01_r8, & + & 0.20334e+01_r8,0.20403e+01_r8,0.22301e+01_r8,0.25429e+01_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.25095e+01_r8,0.21974e+01_r8,0.20283e+01_r8,0.19657e+01_r8,0.19780e+01_r8, & + & 0.20313e+01_r8,0.20420e+01_r8,0.22330e+01_r8,0.25458e+01_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.24957e+01_r8,0.21853e+01_r8,0.20162e+01_r8,0.19613e+01_r8,0.19825e+01_r8, & + & 0.20289e+01_r8,0.20423e+01_r8,0.22370e+01_r8,0.25500e+01_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.26637e+01_r8,0.23330e+01_r8,0.21864e+01_r8,0.20904e+01_r8,0.21013e+01_r8, & + & 0.21699e+01_r8,0.21691e+01_r8,0.22859e+01_r8,0.26102e+01_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.26795e+01_r8,0.23466e+01_r8,0.21930e+01_r8,0.20883e+01_r8,0.21007e+01_r8, & + & 0.21775e+01_r8,0.21807e+01_r8,0.22957e+01_r8,0.26216e+01_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.26872e+01_r8,0.23531e+01_r8,0.22001e+01_r8,0.20926e+01_r8,0.21029e+01_r8, & + & 0.21797e+01_r8,0.21879e+01_r8,0.23020e+01_r8,0.26289e+01_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.26803e+01_r8,0.23471e+01_r8,0.21948e+01_r8,0.20970e+01_r8,0.21069e+01_r8, & + & 0.21770e+01_r8,0.21901e+01_r8,0.23087e+01_r8,0.26364e+01_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.26667e+01_r8,0.23351e+01_r8,0.21832e+01_r8,0.20959e+01_r8,0.21091e+01_r8, & + & 0.21729e+01_r8,0.21936e+01_r8,0.23158e+01_r8,0.26444e+01_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.28246e+01_r8,0.24844e+01_r8,0.23554e+01_r8,0.22494e+01_r8,0.22325e+01_r8, & + & 0.22877e+01_r8,0.22925e+01_r8,0.23319e+01_r8,0.26619e+01_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.28376e+01_r8,0.24941e+01_r8,0.23589e+01_r8,0.22458e+01_r8,0.22369e+01_r8, & + & 0.22959e+01_r8,0.23048e+01_r8,0.23408e+01_r8,0.26720e+01_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.28468e+01_r8,0.25010e+01_r8,0.23646e+01_r8,0.22473e+01_r8,0.22379e+01_r8, & + & 0.22992e+01_r8,0.23116e+01_r8,0.23486e+01_r8,0.26812e+01_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.28432e+01_r8,0.24967e+01_r8,0.23643e+01_r8,0.22531e+01_r8,0.22409e+01_r8, & + & 0.22981e+01_r8,0.23157e+01_r8,0.23572e+01_r8,0.26911e+01_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.28266e+01_r8,0.24816e+01_r8,0.23521e+01_r8,0.22549e+01_r8,0.22433e+01_r8, & + & 0.22953e+01_r8,0.23213e+01_r8,0.23655e+01_r8,0.27010e+01_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.29507e+01_r8,0.26186e+01_r8,0.25154e+01_r8,0.24214e+01_r8,0.23698e+01_r8, & + & 0.23809e+01_r8,0.23936e+01_r8,0.23723e+01_r8,0.26904e+01_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.29579e+01_r8,0.26218e+01_r8,0.25131e+01_r8,0.24179e+01_r8,0.23791e+01_r8, & + & 0.23895e+01_r8,0.24036e+01_r8,0.23830e+01_r8,0.27026e+01_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.29645e+01_r8,0.26250e+01_r8,0.25156e+01_r8,0.24180e+01_r8,0.23828e+01_r8, & + & 0.23929e+01_r8,0.24104e+01_r8,0.23923e+01_r8,0.27131e+01_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.29630e+01_r8,0.26222e+01_r8,0.25142e+01_r8,0.24231e+01_r8,0.23851e+01_r8, & + & 0.23923e+01_r8,0.24170e+01_r8,0.24017e+01_r8,0.27241e+01_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.29476e+01_r8,0.26071e+01_r8,0.25053e+01_r8,0.24267e+01_r8,0.23855e+01_r8, & + & 0.23922e+01_r8,0.24228e+01_r8,0.24116e+01_r8,0.27361e+01_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.30283e+01_r8,0.27271e+01_r8,0.26499e+01_r8,0.25812e+01_r8,0.25068e+01_r8, & + & 0.24674e+01_r8,0.24700e+01_r8,0.24088e+01_r8,0.26873e+01_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.30302e+01_r8,0.27229e+01_r8,0.26429e+01_r8,0.25805e+01_r8,0.25199e+01_r8, & + & 0.24758e+01_r8,0.24797e+01_r8,0.24223e+01_r8,0.27017e+01_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.30313e+01_r8,0.27198e+01_r8,0.26386e+01_r8,0.25814e+01_r8,0.25257e+01_r8, & + & 0.24788e+01_r8,0.24874e+01_r8,0.24335e+01_r8,0.27156e+01_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.30296e+01_r8,0.27153e+01_r8,0.26358e+01_r8,0.25865e+01_r8,0.25285e+01_r8, & + & 0.24798e+01_r8,0.24941e+01_r8,0.24451e+01_r8,0.27296e+01_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.30139e+01_r8,0.26994e+01_r8,0.26290e+01_r8,0.25893e+01_r8,0.25296e+01_r8, & + & 0.24809e+01_r8,0.25004e+01_r8,0.24568e+01_r8,0.27436e+01_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.30493e+01_r8,0.27941e+01_r8,0.27550e+01_r8,0.27119e+01_r8,0.26405e+01_r8, & + & 0.25561e+01_r8,0.25144e+01_r8,0.24302e+01_r8,0.26456e+01_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.30457e+01_r8,0.27865e+01_r8,0.27445e+01_r8,0.27145e+01_r8,0.26540e+01_r8, & + & 0.25649e+01_r8,0.25264e+01_r8,0.24468e+01_r8,0.26636e+01_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.30433e+01_r8,0.27809e+01_r8,0.27367e+01_r8,0.27179e+01_r8,0.26606e+01_r8, & + & 0.25683e+01_r8,0.25354e+01_r8,0.24613e+01_r8,0.26815e+01_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.30389e+01_r8,0.27734e+01_r8,0.27309e+01_r8,0.27229e+01_r8,0.26627e+01_r8, & + & 0.25715e+01_r8,0.25441e+01_r8,0.24765e+01_r8,0.27005e+01_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.30246e+01_r8,0.27583e+01_r8,0.27239e+01_r8,0.27244e+01_r8,0.26642e+01_r8, & + & 0.25740e+01_r8,0.25518e+01_r8,0.24921e+01_r8,0.27199e+01_r8 /) + kao(:, 1,10,13) = (/ & + & 0.30121e+01_r8,0.28154e+01_r8,0.28201e+01_r8,0.28057e+01_r8,0.27531e+01_r8, & + & 0.26438e+01_r8,0.25360e+01_r8,0.24395e+01_r8,0.25814e+01_r8 /) + kao(:, 2,10,13) = (/ & + & 0.30058e+01_r8,0.28055e+01_r8,0.28091e+01_r8,0.28117e+01_r8,0.27659e+01_r8, & + & 0.26536e+01_r8,0.25505e+01_r8,0.24578e+01_r8,0.26020e+01_r8 /) + kao(:, 3,10,13) = (/ & + & 0.29984e+01_r8,0.27957e+01_r8,0.28033e+01_r8,0.28172e+01_r8,0.27717e+01_r8, & + & 0.26597e+01_r8,0.25631e+01_r8,0.24765e+01_r8,0.26239e+01_r8 /) + kao(:, 4,10,13) = (/ & + & 0.29909e+01_r8,0.27859e+01_r8,0.27980e+01_r8,0.28231e+01_r8,0.27737e+01_r8, & + & 0.26641e+01_r8,0.25752e+01_r8,0.24953e+01_r8,0.26473e+01_r8 /) + kao(:, 5,10,13) = (/ & + & 0.29757e+01_r8,0.27703e+01_r8,0.27906e+01_r8,0.28248e+01_r8,0.27751e+01_r8, & + & 0.26687e+01_r8,0.25862e+01_r8,0.25141e+01_r8,0.26704e+01_r8 /) + kao(:, 1,11,13) = (/ & + & 0.29105e+01_r8,0.27849e+01_r8,0.28418e+01_r8,0.28641e+01_r8,0.28368e+01_r8, & + & 0.27205e+01_r8,0.25555e+01_r8,0.24401e+01_r8,0.25196e+01_r8 /) + kao(:, 2,11,13) = (/ & + & 0.29013e+01_r8,0.27742e+01_r8,0.28363e+01_r8,0.28719e+01_r8,0.28460e+01_r8, & + & 0.27321e+01_r8,0.25730e+01_r8,0.24607e+01_r8,0.25412e+01_r8 /) + kao(:, 3,11,13) = (/ & + & 0.28911e+01_r8,0.27633e+01_r8,0.28321e+01_r8,0.28799e+01_r8,0.28506e+01_r8, & + & 0.27417e+01_r8,0.25892e+01_r8,0.24813e+01_r8,0.25665e+01_r8 /) + kao(:, 4,11,13) = (/ & + & 0.28805e+01_r8,0.27495e+01_r8,0.28275e+01_r8,0.28852e+01_r8,0.28551e+01_r8, & + & 0.27503e+01_r8,0.26048e+01_r8,0.25023e+01_r8,0.25905e+01_r8 /) + kao(:, 5,11,13) = (/ & + & 0.28607e+01_r8,0.27299e+01_r8,0.28179e+01_r8,0.28868e+01_r8,0.28597e+01_r8, & + & 0.27578e+01_r8,0.26198e+01_r8,0.25207e+01_r8,0.26120e+01_r8 /) + kao(:, 1,12,13) = (/ & + & 0.27583e+01_r8,0.27145e+01_r8,0.28231e+01_r8,0.28871e+01_r8,0.28764e+01_r8, & + & 0.27674e+01_r8,0.25743e+01_r8,0.24278e+01_r8,0.24570e+01_r8 /) + kao(:, 2,12,13) = (/ & + & 0.27477e+01_r8,0.27023e+01_r8,0.28226e+01_r8,0.28962e+01_r8,0.28884e+01_r8, & + & 0.27832e+01_r8,0.25939e+01_r8,0.24483e+01_r8,0.24817e+01_r8 /) + kao(:, 3,12,13) = (/ & + & 0.27363e+01_r8,0.26890e+01_r8,0.28229e+01_r8,0.29041e+01_r8,0.28966e+01_r8, & + & 0.27972e+01_r8,0.26117e+01_r8,0.24706e+01_r8,0.25053e+01_r8 /) + kao(:, 4,12,13) = (/ & + & 0.27215e+01_r8,0.26719e+01_r8,0.28199e+01_r8,0.29098e+01_r8,0.29044e+01_r8, & + & 0.28097e+01_r8,0.26305e+01_r8,0.24926e+01_r8,0.25297e+01_r8 /) + kao(:, 5,12,13) = (/ & + & 0.27019e+01_r8,0.26521e+01_r8,0.28123e+01_r8,0.29106e+01_r8,0.29127e+01_r8, & + & 0.28234e+01_r8,0.26485e+01_r8,0.25112e+01_r8,0.25512e+01_r8 /) + kao(:, 1,13,13) = (/ & + & 0.25703e+01_r8,0.26073e+01_r8,0.27736e+01_r8,0.28686e+01_r8,0.28762e+01_r8, & + & 0.27819e+01_r8,0.25967e+01_r8,0.24069e+01_r8,0.23967e+01_r8 /) + kao(:, 2,13,13) = (/ & + & 0.25597e+01_r8,0.25968e+01_r8,0.27777e+01_r8,0.28810e+01_r8,0.28904e+01_r8, & + & 0.28011e+01_r8,0.26158e+01_r8,0.24298e+01_r8,0.24224e+01_r8 /) + kao(:, 3,13,13) = (/ & + & 0.25492e+01_r8,0.25857e+01_r8,0.27800e+01_r8,0.28929e+01_r8,0.29040e+01_r8, & + & 0.28202e+01_r8,0.26351e+01_r8,0.24527e+01_r8,0.24494e+01_r8 /) + kao(:, 4,13,13) = (/ & + & 0.25336e+01_r8,0.25705e+01_r8,0.27801e+01_r8,0.29008e+01_r8,0.29182e+01_r8, & + & 0.28403e+01_r8,0.26542e+01_r8,0.24758e+01_r8,0.24745e+01_r8 /) + kao(:, 5,13,13) = (/ & + & 0.25174e+01_r8,0.25538e+01_r8,0.27760e+01_r8,0.29061e+01_r8,0.29321e+01_r8, & + & 0.28592e+01_r8,0.26728e+01_r8,0.24954e+01_r8,0.24962e+01_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.34915e+01_r8,0.30588e+01_r8,0.26262e+01_r8,0.23144e+01_r8,0.22122e+01_r8, & + & 0.21892e+01_r8,0.25558e+01_r8,0.29818e+01_r8,0.32991e+01_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.35009e+01_r8,0.30672e+01_r8,0.26335e+01_r8,0.23059e+01_r8,0.22071e+01_r8, & + & 0.21796e+01_r8,0.25444e+01_r8,0.29683e+01_r8,0.32820e+01_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.35192e+01_r8,0.30832e+01_r8,0.26472e+01_r8,0.23037e+01_r8,0.22014e+01_r8, & + & 0.21706e+01_r8,0.25342e+01_r8,0.29565e+01_r8,0.32692e+01_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.35462e+01_r8,0.31069e+01_r8,0.26676e+01_r8,0.23054e+01_r8,0.21967e+01_r8, & + & 0.21619e+01_r8,0.25265e+01_r8,0.29475e+01_r8,0.32591e+01_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.35714e+01_r8,0.31290e+01_r8,0.26866e+01_r8,0.23141e+01_r8,0.21952e+01_r8, & + & 0.21552e+01_r8,0.25228e+01_r8,0.29432e+01_r8,0.32501e+01_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.38742e+01_r8,0.33939e+01_r8,0.29135e+01_r8,0.26368e+01_r8,0.25318e+01_r8, & + & 0.24566e+01_r8,0.27984e+01_r8,0.32648e+01_r8,0.36583e+01_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.38780e+01_r8,0.33972e+01_r8,0.29165e+01_r8,0.26245e+01_r8,0.25266e+01_r8, & + & 0.24447e+01_r8,0.27836e+01_r8,0.32475e+01_r8,0.36397e+01_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.38887e+01_r8,0.34066e+01_r8,0.29246e+01_r8,0.26139e+01_r8,0.25181e+01_r8, & + & 0.24355e+01_r8,0.27726e+01_r8,0.32346e+01_r8,0.36242e+01_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.39063e+01_r8,0.34220e+01_r8,0.29378e+01_r8,0.26094e+01_r8,0.25085e+01_r8, & + & 0.24291e+01_r8,0.27676e+01_r8,0.32288e+01_r8,0.36150e+01_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.39241e+01_r8,0.34376e+01_r8,0.29511e+01_r8,0.26073e+01_r8,0.25021e+01_r8, & + & 0.24243e+01_r8,0.27677e+01_r8,0.32289e+01_r8,0.36134e+01_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.42487e+01_r8,0.37216e+01_r8,0.32039e+01_r8,0.29799e+01_r8,0.28758e+01_r8, & + & 0.27551e+01_r8,0.30498e+01_r8,0.35581e+01_r8,0.40304e+01_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.42439e+01_r8,0.37174e+01_r8,0.31977e+01_r8,0.29675e+01_r8,0.28698e+01_r8, & + & 0.27440e+01_r8,0.30347e+01_r8,0.35405e+01_r8,0.40101e+01_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.42511e+01_r8,0.37238e+01_r8,0.32007e+01_r8,0.29528e+01_r8,0.28598e+01_r8, & + & 0.27364e+01_r8,0.30269e+01_r8,0.35313e+01_r8,0.39978e+01_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.42624e+01_r8,0.37337e+01_r8,0.32078e+01_r8,0.29428e+01_r8,0.28469e+01_r8, & + & 0.27311e+01_r8,0.30242e+01_r8,0.35281e+01_r8,0.39928e+01_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.42720e+01_r8,0.37420e+01_r8,0.32138e+01_r8,0.29343e+01_r8,0.28324e+01_r8, & + & 0.27276e+01_r8,0.30224e+01_r8,0.35261e+01_r8,0.39910e+01_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.45954e+01_r8,0.40249e+01_r8,0.35022e+01_r8,0.33403e+01_r8,0.32328e+01_r8, & + & 0.30833e+01_r8,0.33112e+01_r8,0.38621e+01_r8,0.43957e+01_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.45847e+01_r8,0.40157e+01_r8,0.34904e+01_r8,0.33265e+01_r8,0.32256e+01_r8, & + & 0.30748e+01_r8,0.32975e+01_r8,0.38466e+01_r8,0.43773e+01_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.45864e+01_r8,0.40172e+01_r8,0.34822e+01_r8,0.33081e+01_r8,0.32132e+01_r8, & + & 0.30693e+01_r8,0.32915e+01_r8,0.38399e+01_r8,0.43696e+01_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.45919e+01_r8,0.40220e+01_r8,0.34808e+01_r8,0.32873e+01_r8,0.31989e+01_r8, & + & 0.30656e+01_r8,0.32892e+01_r8,0.38374e+01_r8,0.43666e+01_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.45961e+01_r8,0.40254e+01_r8,0.34809e+01_r8,0.32746e+01_r8,0.31817e+01_r8, & + & 0.30639e+01_r8,0.32889e+01_r8,0.38370e+01_r8,0.43660e+01_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.49114e+01_r8,0.43012e+01_r8,0.38001e+01_r8,0.37007e+01_r8,0.36023e+01_r8, & + & 0.34476e+01_r8,0.35973e+01_r8,0.41814e+01_r8,0.47692e+01_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.49023e+01_r8,0.42934e+01_r8,0.37862e+01_r8,0.36850e+01_r8,0.35912e+01_r8, & + & 0.34412e+01_r8,0.35890e+01_r8,0.41727e+01_r8,0.47592e+01_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.48929e+01_r8,0.42852e+01_r8,0.37666e+01_r8,0.36647e+01_r8,0.35739e+01_r8, & + & 0.34368e+01_r8,0.35843e+01_r8,0.41678e+01_r8,0.47530e+01_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.48957e+01_r8,0.42875e+01_r8,0.37577e+01_r8,0.36399e+01_r8,0.35570e+01_r8, & + & 0.34352e+01_r8,0.35822e+01_r8,0.41658e+01_r8,0.47507e+01_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.48955e+01_r8,0.42870e+01_r8,0.37502e+01_r8,0.36181e+01_r8,0.35379e+01_r8, & + & 0.34333e+01_r8,0.35807e+01_r8,0.41639e+01_r8,0.47483e+01_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.52336e+01_r8,0.45828e+01_r8,0.41059e+01_r8,0.40455e+01_r8,0.39709e+01_r8, & + & 0.38438e+01_r8,0.39195e+01_r8,0.45101e+01_r8,0.51488e+01_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.52264e+01_r8,0.45766e+01_r8,0.40903e+01_r8,0.40272e+01_r8,0.39556e+01_r8, & + & 0.38368e+01_r8,0.39154e+01_r8,0.45074e+01_r8,0.51460e+01_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.52116e+01_r8,0.45637e+01_r8,0.40682e+01_r8,0.40069e+01_r8,0.39387e+01_r8, & + & 0.38311e+01_r8,0.39117e+01_r8,0.45034e+01_r8,0.51413e+01_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.52061e+01_r8,0.45585e+01_r8,0.40484e+01_r8,0.39793e+01_r8,0.39195e+01_r8, & + & 0.38275e+01_r8,0.39110e+01_r8,0.45018e+01_r8,0.51396e+01_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.52033e+01_r8,0.45559e+01_r8,0.40356e+01_r8,0.39520e+01_r8,0.38983e+01_r8, & + & 0.38238e+01_r8,0.39105e+01_r8,0.45008e+01_r8,0.51385e+01_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.55789e+01_r8,0.48845e+01_r8,0.44392e+01_r8,0.43787e+01_r8,0.43341e+01_r8, & + & 0.42496e+01_r8,0.42580e+01_r8,0.48177e+01_r8,0.55034e+01_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.55750e+01_r8,0.48811e+01_r8,0.44216e+01_r8,0.43602e+01_r8,0.43147e+01_r8, & + & 0.42460e+01_r8,0.42594e+01_r8,0.48202e+01_r8,0.55064e+01_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.55641e+01_r8,0.48716e+01_r8,0.43996e+01_r8,0.43387e+01_r8,0.42975e+01_r8, & + & 0.42414e+01_r8,0.42613e+01_r8,0.48234e+01_r8,0.55098e+01_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.55497e+01_r8,0.48588e+01_r8,0.43740e+01_r8,0.43098e+01_r8,0.42767e+01_r8, & + & 0.42365e+01_r8,0.42657e+01_r8,0.48283e+01_r8,0.55153e+01_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.55426e+01_r8,0.48524e+01_r8,0.43530e+01_r8,0.42800e+01_r8,0.42577e+01_r8, & + & 0.42309e+01_r8,0.42668e+01_r8,0.48295e+01_r8,0.55168e+01_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.59399e+01_r8,0.51999e+01_r8,0.48042e+01_r8,0.47185e+01_r8,0.46865e+01_r8, & + & 0.46496e+01_r8,0.46000e+01_r8,0.50897e+01_r8,0.58161e+01_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.59397e+01_r8,0.51999e+01_r8,0.47874e+01_r8,0.46998e+01_r8,0.46665e+01_r8, & + & 0.46493e+01_r8,0.46097e+01_r8,0.50997e+01_r8,0.58275e+01_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.59349e+01_r8,0.51955e+01_r8,0.47656e+01_r8,0.46767e+01_r8,0.46485e+01_r8, & + & 0.46473e+01_r8,0.46203e+01_r8,0.51120e+01_r8,0.58414e+01_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.59186e+01_r8,0.51811e+01_r8,0.47381e+01_r8,0.46470e+01_r8,0.46283e+01_r8, & + & 0.46432e+01_r8,0.46335e+01_r8,0.51262e+01_r8,0.58574e+01_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.59097e+01_r8,0.51733e+01_r8,0.47110e+01_r8,0.46158e+01_r8,0.46095e+01_r8, & + & 0.46379e+01_r8,0.46369e+01_r8,0.51321e+01_r8,0.58644e+01_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.63127e+01_r8,0.55322e+01_r8,0.51834e+01_r8,0.50691e+01_r8,0.50247e+01_r8, & + & 0.50209e+01_r8,0.49367e+01_r8,0.53236e+01_r8,0.60842e+01_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.63183e+01_r8,0.55346e+01_r8,0.51727e+01_r8,0.50532e+01_r8,0.50080e+01_r8, & + & 0.50274e+01_r8,0.49592e+01_r8,0.53436e+01_r8,0.61069e+01_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.63124e+01_r8,0.55272e+01_r8,0.51546e+01_r8,0.50297e+01_r8,0.49909e+01_r8, & + & 0.50310e+01_r8,0.49812e+01_r8,0.53668e+01_r8,0.61332e+01_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.63001e+01_r8,0.55154e+01_r8,0.51286e+01_r8,0.50009e+01_r8,0.49750e+01_r8, & + & 0.50299e+01_r8,0.49995e+01_r8,0.53888e+01_r8,0.61587e+01_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.62858e+01_r8,0.55023e+01_r8,0.50977e+01_r8,0.49708e+01_r8,0.49573e+01_r8, & + & 0.50270e+01_r8,0.50058e+01_r8,0.53988e+01_r8,0.61697e+01_r8 /) + kao(:, 1,10,14) = (/ & + & 0.66894e+01_r8,0.58832e+01_r8,0.55701e+01_r8,0.54237e+01_r8,0.53594e+01_r8, & + & 0.53556e+01_r8,0.52686e+01_r8,0.55192e+01_r8,0.63037e+01_r8 /) + kao(:, 2,10,14) = (/ & + & 0.66981e+01_r8,0.58851e+01_r8,0.55643e+01_r8,0.54120e+01_r8,0.53500e+01_r8, & + & 0.53705e+01_r8,0.53019e+01_r8,0.55500e+01_r8,0.63389e+01_r8 /) + kao(:, 3,10,14) = (/ & + & 0.66967e+01_r8,0.58795e+01_r8,0.55464e+01_r8,0.53921e+01_r8,0.53372e+01_r8, & + & 0.53796e+01_r8,0.53288e+01_r8,0.55798e+01_r8,0.63734e+01_r8 /) + kao(:, 4,10,14) = (/ & + & 0.66854e+01_r8,0.58646e+01_r8,0.55228e+01_r8,0.53676e+01_r8,0.53254e+01_r8, & + & 0.53837e+01_r8,0.53529e+01_r8,0.56104e+01_r8,0.64086e+01_r8 /) + kao(:, 5,10,14) = (/ & + & 0.66717e+01_r8,0.58486e+01_r8,0.54914e+01_r8,0.53392e+01_r8,0.53082e+01_r8, & + & 0.53849e+01_r8,0.53627e+01_r8,0.56270e+01_r8,0.64281e+01_r8 /) + kao(:, 1,11,14) = (/ & + & 0.70715e+01_r8,0.62495e+01_r8,0.59582e+01_r8,0.57869e+01_r8,0.56930e+01_r8, & + & 0.56655e+01_r8,0.56036e+01_r8,0.57057e+01_r8,0.64838e+01_r8 /) + kao(:, 2,11,14) = (/ & + & 0.70771e+01_r8,0.62459e+01_r8,0.59461e+01_r8,0.57734e+01_r8,0.56903e+01_r8, & + & 0.56860e+01_r8,0.56380e+01_r8,0.57455e+01_r8,0.65310e+01_r8 /) + kao(:, 3,11,14) = (/ & + & 0.70723e+01_r8,0.62337e+01_r8,0.59291e+01_r8,0.57507e+01_r8,0.56859e+01_r8, & + & 0.56988e+01_r8,0.56691e+01_r8,0.57882e+01_r8,0.65837e+01_r8 /) + kao(:, 4,11,14) = (/ & + & 0.70579e+01_r8,0.62141e+01_r8,0.59017e+01_r8,0.57243e+01_r8,0.56747e+01_r8, & + & 0.57061e+01_r8,0.56917e+01_r8,0.58206e+01_r8,0.66248e+01_r8 /) + kao(:, 5,11,14) = (/ & + & 0.70436e+01_r8,0.61942e+01_r8,0.58711e+01_r8,0.56953e+01_r8,0.56563e+01_r8, & + & 0.57095e+01_r8,0.57007e+01_r8,0.58439e+01_r8,0.66547e+01_r8 /) + kao(:, 1,12,14) = (/ & + & 0.73996e+01_r8,0.65875e+01_r8,0.63444e+01_r8,0.61468e+01_r8,0.60255e+01_r8, & + & 0.59627e+01_r8,0.59009e+01_r8,0.58767e+01_r8,0.66113e+01_r8 /) + kao(:, 2,12,14) = (/ & + & 0.74059e+01_r8,0.65818e+01_r8,0.63297e+01_r8,0.61319e+01_r8,0.60289e+01_r8, & + & 0.59857e+01_r8,0.59393e+01_r8,0.59291e+01_r8,0.66795e+01_r8 /) + kao(:, 3,12,14) = (/ & + & 0.73985e+01_r8,0.65639e+01_r8,0.63058e+01_r8,0.61104e+01_r8,0.60278e+01_r8, & + & 0.60017e+01_r8,0.59765e+01_r8,0.59805e+01_r8,0.67466e+01_r8 /) + kao(:, 4,12,14) = (/ & + & 0.73888e+01_r8,0.65439e+01_r8,0.62733e+01_r8,0.60850e+01_r8,0.60189e+01_r8, & + & 0.60123e+01_r8,0.59968e+01_r8,0.60157e+01_r8,0.67935e+01_r8 /) + kao(:, 5,12,14) = (/ & + & 0.73717e+01_r8,0.65185e+01_r8,0.62375e+01_r8,0.60536e+01_r8,0.59983e+01_r8, & + & 0.60180e+01_r8,0.60067e+01_r8,0.60456e+01_r8,0.68365e+01_r8 /) + kao(:, 1,13,14) = (/ & + & 0.76469e+01_r8,0.68731e+01_r8,0.66871e+01_r8,0.64997e+01_r8,0.63502e+01_r8, & + & 0.62466e+01_r8,0.61469e+01_r8,0.60253e+01_r8,0.66908e+01_r8 /) + kao(:, 2,13,14) = (/ & + & 0.76513e+01_r8,0.68603e+01_r8,0.66717e+01_r8,0.64853e+01_r8,0.63628e+01_r8, & + & 0.62754e+01_r8,0.61942e+01_r8,0.60911e+01_r8,0.67781e+01_r8 /) + kao(:, 3,13,14) = (/ & + & 0.76480e+01_r8,0.68404e+01_r8,0.66430e+01_r8,0.64664e+01_r8,0.63629e+01_r8, & + & 0.62938e+01_r8,0.62370e+01_r8,0.61432e+01_r8,0.68460e+01_r8 /) + kao(:, 4,13,14) = (/ & + & 0.76417e+01_r8,0.68180e+01_r8,0.66082e+01_r8,0.64389e+01_r8,0.63512e+01_r8, & + & 0.63082e+01_r8,0.62633e+01_r8,0.61842e+01_r8,0.69071e+01_r8 /) + kao(:, 5,13,14) = (/ & + & 0.76283e+01_r8,0.67918e+01_r8,0.65683e+01_r8,0.64071e+01_r8,0.63329e+01_r8, & + & 0.63131e+01_r8,0.62779e+01_r8,0.62184e+01_r8,0.69616e+01_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.48056e+01_r8,0.42094e+01_r8,0.36132e+01_r8,0.30171e+01_r8,0.28404e+01_r8, & + & 0.34490e+01_r8,0.41388e+01_r8,0.48284e+01_r8,0.52314e+01_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.48171e+01_r8,0.42194e+01_r8,0.36219e+01_r8,0.30243e+01_r8,0.28141e+01_r8, & + & 0.34073e+01_r8,0.40887e+01_r8,0.47701e+01_r8,0.51637e+01_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.48231e+01_r8,0.42245e+01_r8,0.36259e+01_r8,0.30275e+01_r8,0.27871e+01_r8, & + & 0.33709e+01_r8,0.40450e+01_r8,0.47190e+01_r8,0.51029e+01_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.48223e+01_r8,0.42236e+01_r8,0.36250e+01_r8,0.30265e+01_r8,0.27616e+01_r8, & + & 0.33346e+01_r8,0.40014e+01_r8,0.46682e+01_r8,0.50473e+01_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.48164e+01_r8,0.42183e+01_r8,0.36202e+01_r8,0.30224e+01_r8,0.27378e+01_r8, & + & 0.32980e+01_r8,0.39575e+01_r8,0.46170e+01_r8,0.49922e+01_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.56696e+01_r8,0.49649e+01_r8,0.42601e+01_r8,0.35603e+01_r8,0.33660e+01_r8, & + & 0.40230e+01_r8,0.48275e+01_r8,0.56320e+01_r8,0.62204e+01_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.56853e+01_r8,0.49788e+01_r8,0.42721e+01_r8,0.35690e+01_r8,0.33370e+01_r8, & + & 0.39815e+01_r8,0.47778e+01_r8,0.55740e+01_r8,0.61522e+01_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.56912e+01_r8,0.49841e+01_r8,0.42769e+01_r8,0.35723e+01_r8,0.33088e+01_r8, & + & 0.39404e+01_r8,0.47285e+01_r8,0.55164e+01_r8,0.60886e+01_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.56900e+01_r8,0.49829e+01_r8,0.42759e+01_r8,0.35705e+01_r8,0.32819e+01_r8, & + & 0.38975e+01_r8,0.46769e+01_r8,0.54563e+01_r8,0.60227e+01_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.56828e+01_r8,0.49765e+01_r8,0.42703e+01_r8,0.35653e+01_r8,0.32552e+01_r8, & + & 0.38520e+01_r8,0.46223e+01_r8,0.53926e+01_r8,0.59537e+01_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.66640e+01_r8,0.58345e+01_r8,0.50050e+01_r8,0.41960e+01_r8,0.39837e+01_r8, & + & 0.46765e+01_r8,0.56117e+01_r8,0.65468e+01_r8,0.73624e+01_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.66851e+01_r8,0.58530e+01_r8,0.50209e+01_r8,0.42035e+01_r8,0.39538e+01_r8, & + & 0.46274e+01_r8,0.55528e+01_r8,0.64781e+01_r8,0.72849e+01_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.66916e+01_r8,0.58588e+01_r8,0.50261e+01_r8,0.42046e+01_r8,0.39240e+01_r8, & + & 0.45763e+01_r8,0.54915e+01_r8,0.64066e+01_r8,0.72060e+01_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.66884e+01_r8,0.58563e+01_r8,0.50241e+01_r8,0.42004e+01_r8,0.38957e+01_r8, & + & 0.45225e+01_r8,0.54270e+01_r8,0.63313e+01_r8,0.71219e+01_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.66766e+01_r8,0.58462e+01_r8,0.50163e+01_r8,0.41933e+01_r8,0.38675e+01_r8, & + & 0.44702e+01_r8,0.53642e+01_r8,0.62581e+01_r8,0.70387e+01_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.77848e+01_r8,0.68149e+01_r8,0.58451e+01_r8,0.49331e+01_r8,0.46977e+01_r8, & + & 0.54033e+01_r8,0.64839e+01_r8,0.75644e+01_r8,0.85830e+01_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.78108e+01_r8,0.68377e+01_r8,0.58646e+01_r8,0.49375e+01_r8,0.46695e+01_r8, & + & 0.53453e+01_r8,0.64143e+01_r8,0.74831e+01_r8,0.84915e+01_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.78236e+01_r8,0.68489e+01_r8,0.58743e+01_r8,0.49373e+01_r8,0.46417e+01_r8, & + & 0.52821e+01_r8,0.63384e+01_r8,0.73947e+01_r8,0.83915e+01_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.78238e+01_r8,0.68493e+01_r8,0.58748e+01_r8,0.49301e+01_r8,0.46103e+01_r8, & + & 0.52166e+01_r8,0.62599e+01_r8,0.73031e+01_r8,0.82871e+01_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.78090e+01_r8,0.68373e+01_r8,0.58658e+01_r8,0.49180e+01_r8,0.45786e+01_r8, & + & 0.51516e+01_r8,0.61819e+01_r8,0.72121e+01_r8,0.81837e+01_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.90367e+01_r8,0.79101e+01_r8,0.67835e+01_r8,0.57840e+01_r8,0.55090e+01_r8, & + & 0.61816e+01_r8,0.74174e+01_r8,0.86536e+01_r8,0.98560e+01_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.90658e+01_r8,0.79355e+01_r8,0.68052e+01_r8,0.57840e+01_r8,0.54825e+01_r8, & + & 0.61122e+01_r8,0.73329e+01_r8,0.85548e+01_r8,0.97452e+01_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.90837e+01_r8,0.79512e+01_r8,0.68188e+01_r8,0.57766e+01_r8,0.54581e+01_r8, & + & 0.60426e+01_r8,0.72485e+01_r8,0.84564e+01_r8,0.96328e+01_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.90830e+01_r8,0.79510e+01_r8,0.68192e+01_r8,0.57645e+01_r8,0.54297e+01_r8, & + & 0.59729e+01_r8,0.71644e+01_r8,0.83583e+01_r8,0.95205e+01_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.90677e+01_r8,0.79386e+01_r8,0.68094e+01_r8,0.57479e+01_r8,0.53962e+01_r8, & + & 0.58998e+01_r8,0.70740e+01_r8,0.82528e+01_r8,0.94008e+01_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.10412e+02_r8,0.91128e+01_r8,0.78140e+01_r8,0.67504e+01_r8,0.64389e+01_r8, & + & 0.70217e+01_r8,0.83899e+01_r8,0.97882e+01_r8,0.11168e+02_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.10449e+02_r8,0.91451e+01_r8,0.78417e+01_r8,0.67466e+01_r8,0.64110e+01_r8, & + & 0.69507e+01_r8,0.82964e+01_r8,0.96789e+01_r8,0.11043e+02_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.10469e+02_r8,0.91634e+01_r8,0.78574e+01_r8,0.67323e+01_r8,0.63834e+01_r8, & + & 0.68804e+01_r8,0.82097e+01_r8,0.95778e+01_r8,0.10928e+02_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.10466e+02_r8,0.91614e+01_r8,0.78568e+01_r8,0.67135e+01_r8,0.63530e+01_r8, & + & 0.68083e+01_r8,0.81167e+01_r8,0.94694e+01_r8,0.10805e+02_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.10450e+02_r8,0.91481e+01_r8,0.78461e+01_r8,0.66866e+01_r8,0.63182e+01_r8, & + & 0.67317e+01_r8,0.80175e+01_r8,0.93536e+01_r8,0.10671e+02_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.11882e+02_r8,0.10399e+02_r8,0.89166e+01_r8,0.78253e+01_r8,0.74792e+01_r8, & + & 0.79512e+01_r8,0.94202e+01_r8,0.10990e+02_r8,0.12550e+02_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.11932e+02_r8,0.10443e+02_r8,0.89541e+01_r8,0.78202e+01_r8,0.74549e+01_r8, & + & 0.78754e+01_r8,0.93207e+01_r8,0.10874e+02_r8,0.12417e+02_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.11956e+02_r8,0.10464e+02_r8,0.89727e+01_r8,0.78020e+01_r8,0.74258e+01_r8, & + & 0.78051e+01_r8,0.92218e+01_r8,0.10758e+02_r8,0.12285e+02_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.11956e+02_r8,0.10465e+02_r8,0.89740e+01_r8,0.77736e+01_r8,0.73912e+01_r8, & + & 0.77319e+01_r8,0.91108e+01_r8,0.10629e+02_r8,0.12138e+02_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.11934e+02_r8,0.10446e+02_r8,0.89587e+01_r8,0.77346e+01_r8,0.73464e+01_r8, & + & 0.76503e+01_r8,0.90007e+01_r8,0.10501e+02_r8,0.11991e+02_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.13440e+02_r8,0.11762e+02_r8,0.10084e+02_r8,0.90134e+01_r8,0.86298e+01_r8, & + & 0.89787e+01_r8,0.10509e+02_r8,0.12260e+02_r8,0.14008e+02_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.13496e+02_r8,0.11811e+02_r8,0.10127e+02_r8,0.90042e+01_r8,0.86075e+01_r8, & + & 0.89016e+01_r8,0.10401e+02_r8,0.12134e+02_r8,0.13863e+02_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.13522e+02_r8,0.11835e+02_r8,0.10148e+02_r8,0.89806e+01_r8,0.85777e+01_r8, & + & 0.88306e+01_r8,0.10284e+02_r8,0.11998e+02_r8,0.13707e+02_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.13526e+02_r8,0.11839e+02_r8,0.10151e+02_r8,0.89422e+01_r8,0.85378e+01_r8, & + & 0.87510e+01_r8,0.10150e+02_r8,0.11842e+02_r8,0.13529e+02_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.13498e+02_r8,0.11814e+02_r8,0.10131e+02_r8,0.88918e+01_r8,0.84819e+01_r8, & + & 0.86621e+01_r8,0.10028e+02_r8,0.11700e+02_r8,0.13367e+02_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.15050e+02_r8,0.13171e+02_r8,0.11325e+02_r8,0.10314e+02_r8,0.98844e+01_r8, & + & 0.10113e+02_r8,0.11655e+02_r8,0.13598e+02_r8,0.15538e+02_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.15110e+02_r8,0.13224e+02_r8,0.11358e+02_r8,0.10290e+02_r8,0.98636e+01_r8, & + & 0.10034e+02_r8,0.11528e+02_r8,0.13449e+02_r8,0.15369e+02_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.15142e+02_r8,0.13253e+02_r8,0.11372e+02_r8,0.10253e+02_r8,0.98329e+01_r8, & + & 0.99565e+01_r8,0.11387e+02_r8,0.13285e+02_r8,0.15182e+02_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.15140e+02_r8,0.13251e+02_r8,0.11368e+02_r8,0.10200e+02_r8,0.97822e+01_r8, & + & 0.98656e+01_r8,0.11236e+02_r8,0.13109e+02_r8,0.14981e+02_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.15112e+02_r8,0.13227e+02_r8,0.11344e+02_r8,0.10134e+02_r8,0.97132e+01_r8, & + & 0.97634e+01_r8,0.11104e+02_r8,0.12955e+02_r8,0.14806e+02_r8 /) + kao(:, 1,10,15) = (/ & + & 0.16679e+02_r8,0.14596e+02_r8,0.12639e+02_r8,0.11713e+02_r8,0.11234e+02_r8, & + & 0.11344e+02_r8,0.12833e+02_r8,0.14972e+02_r8,0.17110e+02_r8 /) + kao(:, 2,10,15) = (/ & + & 0.16740e+02_r8,0.14649e+02_r8,0.12658e+02_r8,0.11669e+02_r8,0.11203e+02_r8, & + & 0.11257e+02_r8,0.12688e+02_r8,0.14803e+02_r8,0.16918e+02_r8 /) + kao(:, 3,10,15) = (/ & + & 0.16768e+02_r8,0.14675e+02_r8,0.12658e+02_r8,0.11609e+02_r8,0.11161e+02_r8, & + & 0.11169e+02_r8,0.12530e+02_r8,0.14619e+02_r8,0.16708e+02_r8 /) + kao(:, 4,10,15) = (/ & + & 0.16761e+02_r8,0.14669e+02_r8,0.12632e+02_r8,0.11528e+02_r8,0.11096e+02_r8, & + & 0.11064e+02_r8,0.12360e+02_r8,0.14420e+02_r8,0.16480e+02_r8 /) + kao(:, 5,10,15) = (/ & + & 0.16723e+02_r8,0.14636e+02_r8,0.12592e+02_r8,0.11437e+02_r8,0.11017e+02_r8, & + & 0.10938e+02_r8,0.12210e+02_r8,0.14245e+02_r8,0.16279e+02_r8 /) + kao(:, 1,11,15) = (/ & + & 0.18294e+02_r8,0.16009e+02_r8,0.13989e+02_r8,0.13135e+02_r8,0.12643e+02_r8, & + & 0.12628e+02_r8,0.13972e+02_r8,0.16290e+02_r8,0.18616e+02_r8 /) + kao(:, 2,11,15) = (/ & + & 0.18347e+02_r8,0.16056e+02_r8,0.13990e+02_r8,0.13069e+02_r8,0.12593e+02_r8, & + & 0.12524e+02_r8,0.13808e+02_r8,0.16097e+02_r8,0.18396e+02_r8 /) + kao(:, 3,11,15) = (/ & + & 0.18360e+02_r8,0.16067e+02_r8,0.13961e+02_r8,0.12977e+02_r8,0.12519e+02_r8, & + & 0.12404e+02_r8,0.13621e+02_r8,0.15875e+02_r8,0.18143e+02_r8 /) + kao(:, 4,11,15) = (/ & + & 0.18335e+02_r8,0.16046e+02_r8,0.13912e+02_r8,0.12870e+02_r8,0.12428e+02_r8, & + & 0.12262e+02_r8,0.13438e+02_r8,0.15668e+02_r8,0.17906e+02_r8 /) + kao(:, 5,11,15) = (/ & + & 0.18275e+02_r8,0.15994e+02_r8,0.13835e+02_r8,0.12741e+02_r8,0.12318e+02_r8, & + & 0.12107e+02_r8,0.13269e+02_r8,0.15473e+02_r8,0.17684e+02_r8 /) + kao(:, 1,12,15) = (/ & + & 0.19924e+02_r8,0.17435e+02_r8,0.15328e+02_r8,0.14570e+02_r8,0.14103e+02_r8, & + & 0.13966e+02_r8,0.15137e+02_r8,0.17574e+02_r8,0.20085e+02_r8 /) + kao(:, 2,12,15) = (/ & + & 0.19952e+02_r8,0.17460e+02_r8,0.15303e+02_r8,0.14472e+02_r8,0.14016e+02_r8, & + & 0.13836e+02_r8,0.14951e+02_r8,0.17356e+02_r8,0.19836e+02_r8 /) + kao(:, 3,12,15) = (/ & + & 0.19950e+02_r8,0.17459e+02_r8,0.15252e+02_r8,0.14354e+02_r8,0.13911e+02_r8, & + & 0.13674e+02_r8,0.14736e+02_r8,0.17121e+02_r8,0.19567e+02_r8 /) + kao(:, 4,12,15) = (/ & + & 0.19898e+02_r8,0.17414e+02_r8,0.15172e+02_r8,0.14207e+02_r8,0.13782e+02_r8, & + & 0.13496e+02_r8,0.14540e+02_r8,0.16905e+02_r8,0.19321e+02_r8 /) + kao(:, 5,12,15) = (/ & + & 0.19813e+02_r8,0.17339e+02_r8,0.15067e+02_r8,0.14045e+02_r8,0.13635e+02_r8, & + & 0.13302e+02_r8,0.14349e+02_r8,0.16691e+02_r8,0.19076e+02_r8 /) + kao(:, 1,13,15) = (/ & + & 0.21582e+02_r8,0.18886e+02_r8,0.16708e+02_r8,0.15984e+02_r8,0.15578e+02_r8, & + & 0.15338e+02_r8,0.16324e+02_r8,0.18812e+02_r8,0.21500e+02_r8 /) + kao(:, 2,13,15) = (/ & + & 0.21595e+02_r8,0.18898e+02_r8,0.16645e+02_r8,0.15860e+02_r8,0.15448e+02_r8, & + & 0.15169e+02_r8,0.16117e+02_r8,0.18583e+02_r8,0.21237e+02_r8 /) + kao(:, 3,13,15) = (/ & + & 0.21561e+02_r8,0.18868e+02_r8,0.16562e+02_r8,0.15696e+02_r8,0.15303e+02_r8, & + & 0.14968e+02_r8,0.15881e+02_r8,0.18352e+02_r8,0.20974e+02_r8 /) + kao(:, 4,13,15) = (/ & + & 0.21483e+02_r8,0.18800e+02_r8,0.16445e+02_r8,0.15517e+02_r8,0.15132e+02_r8, & + & 0.14742e+02_r8,0.15661e+02_r8,0.18119e+02_r8,0.20709e+02_r8 /) + kao(:, 5,13,15) = (/ & + & 0.21359e+02_r8,0.18692e+02_r8,0.16307e+02_r8,0.15310e+02_r8,0.14932e+02_r8, & + & 0.14513e+02_r8,0.15442e+02_r8,0.17892e+02_r8,0.20448e+02_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.54900e+01_r8,0.48060e+01_r8,0.41232e+01_r8,0.34422e+01_r8,0.34870e+01_r8, & + & 0.43588e+01_r8,0.52305e+01_r8,0.61020e+01_r8,0.65047e+01_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.54959e+01_r8,0.48102e+01_r8,0.41246e+01_r8,0.34396e+01_r8,0.34389e+01_r8, & + & 0.42986e+01_r8,0.51583e+01_r8,0.60178e+01_r8,0.64181e+01_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.54964e+01_r8,0.48111e+01_r8,0.41257e+01_r8,0.34404e+01_r8,0.33906e+01_r8, & + & 0.42383e+01_r8,0.50859e+01_r8,0.59334e+01_r8,0.63255e+01_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.54872e+01_r8,0.48032e+01_r8,0.41193e+01_r8,0.34354e+01_r8,0.33485e+01_r8, & + & 0.41856e+01_r8,0.50227e+01_r8,0.58596e+01_r8,0.62437e+01_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.54677e+01_r8,0.47864e+01_r8,0.41051e+01_r8,0.34238e+01_r8,0.33099e+01_r8, & + & 0.41373e+01_r8,0.49647e+01_r8,0.57920e+01_r8,0.61726e+01_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.65993e+01_r8,0.57796e+01_r8,0.49604e+01_r8,0.41421e+01_r8,0.42011e+01_r8, & + & 0.52514e+01_r8,0.63014e+01_r8,0.73516e+01_r8,0.80279e+01_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.66032e+01_r8,0.57810e+01_r8,0.49597e+01_r8,0.41395e+01_r8,0.41430e+01_r8, & + & 0.51787e+01_r8,0.62144e+01_r8,0.72499e+01_r8,0.79170e+01_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.66114e+01_r8,0.57864e+01_r8,0.49618e+01_r8,0.41380e+01_r8,0.40849e+01_r8, & + & 0.51061e+01_r8,0.61273e+01_r8,0.71483e+01_r8,0.78058e+01_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.66055e+01_r8,0.57814e+01_r8,0.49573e+01_r8,0.41341e+01_r8,0.40341e+01_r8, & + & 0.50426e+01_r8,0.60510e+01_r8,0.70593e+01_r8,0.77043e+01_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.65867e+01_r8,0.57651e+01_r8,0.49435e+01_r8,0.41221e+01_r8,0.39863e+01_r8, & + & 0.49829e+01_r8,0.59794e+01_r8,0.69758e+01_r8,0.76124e+01_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.79380e+01_r8,0.69526e+01_r8,0.59676e+01_r8,0.49832e+01_r8,0.50788e+01_r8, & + & 0.63485e+01_r8,0.76181e+01_r8,0.88875e+01_r8,0.99377e+01_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.79519e+01_r8,0.69640e+01_r8,0.59765e+01_r8,0.49895e+01_r8,0.50033e+01_r8, & + & 0.62541e+01_r8,0.75048e+01_r8,0.87554e+01_r8,0.97869e+01_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.79564e+01_r8,0.69660e+01_r8,0.59762e+01_r8,0.49871e+01_r8,0.49341e+01_r8, & + & 0.61676e+01_r8,0.74011e+01_r8,0.86343e+01_r8,0.96531e+01_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.79604e+01_r8,0.69678e+01_r8,0.59753e+01_r8,0.49833e+01_r8,0.48716e+01_r8, & + & 0.60895e+01_r8,0.73073e+01_r8,0.85250e+01_r8,0.95280e+01_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.79454e+01_r8,0.69546e+01_r8,0.59641e+01_r8,0.49739e+01_r8,0.48117e+01_r8, & + & 0.60146e+01_r8,0.72174e+01_r8,0.84201e+01_r8,0.94106e+01_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.95482e+01_r8,0.83619e+01_r8,0.71758e+01_r8,0.59904e+01_r8,0.61617e+01_r8, & + & 0.77021e+01_r8,0.92425e+01_r8,0.10783e+02_r8,0.12199e+02_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.95751e+01_r8,0.83849e+01_r8,0.71952e+01_r8,0.60057e+01_r8,0.60507e+01_r8, & + & 0.75634e+01_r8,0.90760e+01_r8,0.10588e+02_r8,0.11979e+02_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.95851e+01_r8,0.83928e+01_r8,0.72008e+01_r8,0.60093e+01_r8,0.59519e+01_r8, & + & 0.74398e+01_r8,0.89277e+01_r8,0.10415e+02_r8,0.11784e+02_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.95899e+01_r8,0.83956e+01_r8,0.72016e+01_r8,0.60083e+01_r8,0.58751e+01_r8, & + & 0.73438e+01_r8,0.88125e+01_r8,0.10281e+02_r8,0.11628e+02_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.95802e+01_r8,0.83858e+01_r8,0.71919e+01_r8,0.59984e+01_r8,0.58004e+01_r8, & + & 0.72505e+01_r8,0.87005e+01_r8,0.10150e+02_r8,0.11482e+02_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.11467e+02_r8,0.10041e+02_r8,0.86153e+01_r8,0.71899e+01_r8,0.74662e+01_r8, & + & 0.93327e+01_r8,0.11199e+02_r8,0.13065e+02_r8,0.14858e+02_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.11518e+02_r8,0.10085e+02_r8,0.86526e+01_r8,0.72201e+01_r8,0.73208e+01_r8, & + & 0.91509e+01_r8,0.10981e+02_r8,0.12811e+02_r8,0.14568e+02_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.11535e+02_r8,0.10099e+02_r8,0.86636e+01_r8,0.72282e+01_r8,0.71844e+01_r8, & + & 0.89805e+01_r8,0.10776e+02_r8,0.12572e+02_r8,0.14298e+02_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.11542e+02_r8,0.10105e+02_r8,0.86677e+01_r8,0.72309e+01_r8,0.70636e+01_r8, & + & 0.88295e+01_r8,0.10595e+02_r8,0.12361e+02_r8,0.14056e+02_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.11528e+02_r8,0.10092e+02_r8,0.86561e+01_r8,0.72209e+01_r8,0.69634e+01_r8, & + & 0.87042e+01_r8,0.10445e+02_r8,0.12185e+02_r8,0.13857e+02_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.13743e+02_r8,0.12032e+02_r8,0.10321e+02_r8,0.86104e+01_r8,0.90301e+01_r8, & + & 0.11288e+02_r8,0.13545e+02_r8,0.15802e+02_r8,0.18010e+02_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.13809e+02_r8,0.12090e+02_r8,0.10370e+02_r8,0.86513e+01_r8,0.88422e+01_r8, & + & 0.11053e+02_r8,0.13263e+02_r8,0.15473e+02_r8,0.17638e+02_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.13850e+02_r8,0.12125e+02_r8,0.10400e+02_r8,0.86753e+01_r8,0.86607e+01_r8, & + & 0.10826e+02_r8,0.12991e+02_r8,0.15156e+02_r8,0.17275e+02_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.13866e+02_r8,0.12138e+02_r8,0.10411e+02_r8,0.86837e+01_r8,0.84930e+01_r8, & + & 0.10616e+02_r8,0.12739e+02_r8,0.14862e+02_r8,0.16940e+02_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.13850e+02_r8,0.12124e+02_r8,0.10399e+02_r8,0.86732e+01_r8,0.83442e+01_r8, & + & 0.10430e+02_r8,0.12516e+02_r8,0.14602e+02_r8,0.16644e+02_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.16450e+02_r8,0.14400e+02_r8,0.12350e+02_r8,0.10300e+02_r8,0.10874e+02_r8, & + & 0.13593e+02_r8,0.16311e+02_r8,0.19030e+02_r8,0.21722e+02_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.16525e+02_r8,0.14465e+02_r8,0.12405e+02_r8,0.10346e+02_r8,0.10632e+02_r8, & + & 0.13290e+02_r8,0.15948e+02_r8,0.18606e+02_r8,0.21239e+02_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.16563e+02_r8,0.14499e+02_r8,0.12434e+02_r8,0.10370e+02_r8,0.10395e+02_r8, & + & 0.12994e+02_r8,0.15592e+02_r8,0.18191e+02_r8,0.20762e+02_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.16590e+02_r8,0.14522e+02_r8,0.12454e+02_r8,0.10386e+02_r8,0.10172e+02_r8, & + & 0.12715e+02_r8,0.15258e+02_r8,0.17801e+02_r8,0.20317e+02_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.16576e+02_r8,0.14509e+02_r8,0.12443e+02_r8,0.10377e+02_r8,0.99688e+01_r8, & + & 0.12461e+02_r8,0.14953e+02_r8,0.17445e+02_r8,0.19913e+02_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.19629e+02_r8,0.17181e+02_r8,0.14733e+02_r8,0.12285e+02_r8,0.13022e+02_r8, & + & 0.16277e+02_r8,0.19532e+02_r8,0.22787e+02_r8,0.26029e+02_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.19728e+02_r8,0.17267e+02_r8,0.14807e+02_r8,0.12346e+02_r8,0.12711e+02_r8, & + & 0.15888e+02_r8,0.19066e+02_r8,0.22243e+02_r8,0.25406e+02_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.19768e+02_r8,0.17302e+02_r8,0.14837e+02_r8,0.12371e+02_r8,0.12399e+02_r8, & + & 0.15499e+02_r8,0.18599e+02_r8,0.21698e+02_r8,0.24782e+02_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.19773e+02_r8,0.17307e+02_r8,0.14840e+02_r8,0.12374e+02_r8,0.12111e+02_r8, & + & 0.15139e+02_r8,0.18167e+02_r8,0.21194e+02_r8,0.24210e+02_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.19744e+02_r8,0.17281e+02_r8,0.14818e+02_r8,0.12356e+02_r8,0.11840e+02_r8, & + & 0.14800e+02_r8,0.17760e+02_r8,0.20720e+02_r8,0.23667e+02_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.23312e+02_r8,0.20403e+02_r8,0.17494e+02_r8,0.14584e+02_r8,0.15488e+02_r8, & + & 0.19360e+02_r8,0.23231e+02_r8,0.27103e+02_r8,0.30970e+02_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.23439e+02_r8,0.20514e+02_r8,0.17588e+02_r8,0.14663e+02_r8,0.15085e+02_r8, & + & 0.18856e+02_r8,0.22627e+02_r8,0.26397e+02_r8,0.30166e+02_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.23492e+02_r8,0.20560e+02_r8,0.17628e+02_r8,0.14696e+02_r8,0.14687e+02_r8, & + & 0.18356e+02_r8,0.22027e+02_r8,0.25697e+02_r8,0.29367e+02_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.23479e+02_r8,0.20549e+02_r8,0.17619e+02_r8,0.14689e+02_r8,0.14321e+02_r8, & + & 0.17895e+02_r8,0.21474e+02_r8,0.25052e+02_r8,0.28629e+02_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.23411e+02_r8,0.20489e+02_r8,0.17567e+02_r8,0.14646e+02_r8,0.13982e+02_r8, & + & 0.17451e+02_r8,0.20941e+02_r8,0.24431e+02_r8,0.27917e+02_r8 /) + kao(:, 1,10,16) = (/ & + & 0.27592e+02_r8,0.24147e+02_r8,0.20702e+02_r8,0.17264e+02_r8,0.18240e+02_r8, & + & 0.22793e+02_r8,0.27352e+02_r8,0.31910e+02_r8,0.36473e+02_r8 /) + kao(:, 2,10,16) = (/ & + & 0.27703e+02_r8,0.24245e+02_r8,0.20786e+02_r8,0.17327e+02_r8,0.17749e+02_r8, & + & 0.22147e+02_r8,0.26577e+02_r8,0.31006e+02_r8,0.35436e+02_r8 /) + kao(:, 3,10,16) = (/ & + & 0.27743e+02_r8,0.24279e+02_r8,0.20816e+02_r8,0.17352e+02_r8,0.17266e+02_r8, & + & 0.21525e+02_r8,0.25830e+02_r8,0.30134e+02_r8,0.34441e+02_r8 /) + kao(:, 4,10,16) = (/ & + & 0.27709e+02_r8,0.24250e+02_r8,0.20790e+02_r8,0.17331e+02_r8,0.16811e+02_r8, & + & 0.20946e+02_r8,0.25135e+02_r8,0.29324e+02_r8,0.33510e+02_r8 /) + kao(:, 5,10,16) = (/ & + & 0.27598e+02_r8,0.24153e+02_r8,0.20707e+02_r8,0.17262e+02_r8,0.16378e+02_r8, & + & 0.20388e+02_r8,0.24466e+02_r8,0.28543e+02_r8,0.32622e+02_r8 /) + kao(:, 1,11,16) = (/ & + & 0.32570e+02_r8,0.28502e+02_r8,0.24434e+02_r8,0.20393e+02_r8,0.21083e+02_r8, & + & 0.26245e+02_r8,0.31494e+02_r8,0.36742e+02_r8,0.41994e+02_r8 /) + kao(:, 2,11,16) = (/ & + & 0.32601e+02_r8,0.28529e+02_r8,0.24458e+02_r8,0.20386e+02_r8,0.20492e+02_r8, & + & 0.25469e+02_r8,0.30563e+02_r8,0.35657e+02_r8,0.40747e+02_r8 /) + kao(:, 3,11,16) = (/ & + & 0.32535e+02_r8,0.28472e+02_r8,0.24408e+02_r8,0.20345e+02_r8,0.19916e+02_r8, & + & 0.24733e+02_r8,0.29679e+02_r8,0.34625e+02_r8,0.39568e+02_r8 /) + kao(:, 4,11,16) = (/ & + & 0.32390e+02_r8,0.28345e+02_r8,0.24301e+02_r8,0.20256e+02_r8,0.19358e+02_r8, & + & 0.24023e+02_r8,0.28827e+02_r8,0.33631e+02_r8,0.38435e+02_r8 /) + kao(:, 5,11,16) = (/ & + & 0.32175e+02_r8,0.28157e+02_r8,0.24140e+02_r8,0.20122e+02_r8,0.18819e+02_r8, & + & 0.23330e+02_r8,0.27996e+02_r8,0.32661e+02_r8,0.37328e+02_r8 /) + kao(:, 1,12,16) = (/ & + & 0.38135e+02_r8,0.33371e+02_r8,0.28607e+02_r8,0.23891e+02_r8,0.24203e+02_r8, & + & 0.29981e+02_r8,0.35977e+02_r8,0.41973e+02_r8,0.47971e+02_r8 /) + kao(:, 2,12,16) = (/ & + & 0.38033e+02_r8,0.33282e+02_r8,0.28531e+02_r8,0.23779e+02_r8,0.23491e+02_r8, & + & 0.29038e+02_r8,0.34845e+02_r8,0.40652e+02_r8,0.46464e+02_r8 /) + kao(:, 3,12,16) = (/ & + & 0.37806e+02_r8,0.33084e+02_r8,0.28361e+02_r8,0.23639e+02_r8,0.22788e+02_r8, & + & 0.28150e+02_r8,0.33780e+02_r8,0.39409e+02_r8,0.45036e+02_r8 /) + kao(:, 4,12,16) = (/ & + & 0.37497e+02_r8,0.32813e+02_r8,0.28129e+02_r8,0.23446e+02_r8,0.22100e+02_r8, & + & 0.27270e+02_r8,0.32724e+02_r8,0.38179e+02_r8,0.43632e+02_r8 /) + kao(:, 5,12,16) = (/ & + & 0.37099e+02_r8,0.32465e+02_r8,0.27831e+02_r8,0.23198e+02_r8,0.21440e+02_r8, & + & 0.26398e+02_r8,0.31678e+02_r8,0.36957e+02_r8,0.42237e+02_r8 /) + kao(:, 1,13,16) = (/ & + & 0.44217e+02_r8,0.38692e+02_r8,0.33167e+02_r8,0.27730e+02_r8,0.27605e+02_r8, & + & 0.33969e+02_r8,0.40763e+02_r8,0.47556e+02_r8,0.54352e+02_r8 /) + kao(:, 2,13,16) = (/ & + & 0.43915e+02_r8,0.38428e+02_r8,0.32941e+02_r8,0.27455e+02_r8,0.26738e+02_r8, & + & 0.32787e+02_r8,0.39345e+02_r8,0.45901e+02_r8,0.52455e+02_r8 /) + kao(:, 3,13,16) = (/ & + & 0.43489e+02_r8,0.38055e+02_r8,0.32622e+02_r8,0.27188e+02_r8,0.25861e+02_r8, & + & 0.31686e+02_r8,0.38022e+02_r8,0.44359e+02_r8,0.50700e+02_r8 /) + kao(:, 4,13,16) = (/ & + & 0.42951e+02_r8,0.37585e+02_r8,0.32219e+02_r8,0.26853e+02_r8,0.25006e+02_r8, & + & 0.30590e+02_r8,0.36708e+02_r8,0.42826e+02_r8,0.48946e+02_r8 /) + kao(:, 5,13,16) = (/ & + & 0.42298e+02_r8,0.37013e+02_r8,0.31729e+02_r8,0.26445e+02_r8,0.24180e+02_r8, & + & 0.29511e+02_r8,0.35413e+02_r8,0.41314e+02_r8,0.47218e+02_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:, 1,13, 1) = (/ & + & 0.40633e-08_r8,0.64718e-06_r8,0.79567e-06_r8,0.81264e-06_r8,0.25080e-07_r8 /) + kbo(:, 2,13, 1) = (/ & + & 0.37596e-08_r8,0.70429e-06_r8,0.90855e-06_r8,0.96432e-06_r8,0.28292e-07_r8 /) + kbo(:, 3,13, 1) = (/ & + & 0.34982e-08_r8,0.76370e-06_r8,0.10316e-05_r8,0.11472e-05_r8,0.31265e-07_r8 /) + kbo(:, 4,13, 1) = (/ & + & 0.32707e-08_r8,0.82834e-06_r8,0.11577e-05_r8,0.13387e-05_r8,0.34928e-07_r8 /) + kbo(:, 5,13, 1) = (/ & + & 0.30710e-08_r8,0.90252e-06_r8,0.12962e-05_r8,0.15206e-05_r8,0.38859e-07_r8 /) + kbo(:, 1,14, 1) = (/ & + & 0.33026e-08_r8,0.53592e-06_r8,0.66171e-06_r8,0.67633e-06_r8,0.20767e-07_r8 /) + kbo(:, 2,14, 1) = (/ & + & 0.30574e-08_r8,0.57959e-06_r8,0.75386e-06_r8,0.80395e-06_r8,0.23334e-07_r8 /) + kbo(:, 3,14, 1) = (/ & + & 0.28461e-08_r8,0.62897e-06_r8,0.85486e-06_r8,0.95745e-06_r8,0.25841e-07_r8 /) + kbo(:, 4,14, 1) = (/ & + & 0.26621e-08_r8,0.68352e-06_r8,0.96132e-06_r8,0.11148e-05_r8,0.28862e-07_r8 /) + kbo(:, 5,14, 1) = (/ & + & 0.25005e-08_r8,0.74517e-06_r8,0.10739e-05_r8,0.12632e-05_r8,0.32093e-07_r8 /) + kbo(:, 1,15, 1) = (/ & + & 0.26821e-08_r8,0.44081e-06_r8,0.55093e-06_r8,0.56465e-06_r8,0.17186e-07_r8 /) + kbo(:, 2,15, 1) = (/ & + & 0.24845e-08_r8,0.47773e-06_r8,0.62636e-06_r8,0.67180e-06_r8,0.19234e-07_r8 /) + kbo(:, 3,15, 1) = (/ & + & 0.23140e-08_r8,0.51811e-06_r8,0.70791e-06_r8,0.79658e-06_r8,0.21348e-07_r8 /) + kbo(:, 4,15, 1) = (/ & + & 0.21654e-08_r8,0.56416e-06_r8,0.79893e-06_r8,0.92873e-06_r8,0.23832e-07_r8 /) + kbo(:, 5,15, 1) = (/ & + & 0.20347e-08_r8,0.61535e-06_r8,0.88985e-06_r8,0.10499e-05_r8,0.26485e-07_r8 /) + kbo(:, 1,16, 1) = (/ & + & 0.21775e-08_r8,0.36254e-06_r8,0.45870e-06_r8,0.47125e-06_r8,0.14211e-07_r8 /) + kbo(:, 2,16, 1) = (/ & + & 0.20183e-08_r8,0.39376e-06_r8,0.52053e-06_r8,0.56163e-06_r8,0.15869e-07_r8 /) + kbo(:, 3,16, 1) = (/ & + & 0.18808e-08_r8,0.42687e-06_r8,0.58699e-06_r8,0.66386e-06_r8,0.17627e-07_r8 /) + kbo(:, 4,16, 1) = (/ & + & 0.17608e-08_r8,0.46559e-06_r8,0.66388e-06_r8,0.77063e-06_r8,0.19664e-07_r8 /) + kbo(:, 5,16, 1) = (/ & + & 0.16552e-08_r8,0.50747e-06_r8,0.73699e-06_r8,0.87249e-06_r8,0.21844e-07_r8 /) + kbo(:, 1,17, 1) = (/ & + & 0.17682e-08_r8,0.29836e-06_r8,0.38104e-06_r8,0.39314e-06_r8,0.11735e-07_r8 /) + kbo(:, 2,17, 1) = (/ & + & 0.16399e-08_r8,0.32493e-06_r8,0.43215e-06_r8,0.46897e-06_r8,0.13077e-07_r8 /) + kbo(:, 3,17, 1) = (/ & + & 0.15290e-08_r8,0.35203e-06_r8,0.48665e-06_r8,0.55328e-06_r8,0.14535e-07_r8 /) + kbo(:, 4,17, 1) = (/ & + & 0.14321e-08_r8,0.38383e-06_r8,0.55033e-06_r8,0.63844e-06_r8,0.16208e-07_r8 /) + kbo(:, 5,17, 1) = (/ & + & 0.13468e-08_r8,0.41822e-06_r8,0.60950e-06_r8,0.72376e-06_r8,0.17995e-07_r8 /) + kbo(:, 1,18, 1) = (/ & + & 0.14362e-08_r8,0.24560e-06_r8,0.31667e-06_r8,0.32797e-06_r8,0.96831e-08_r8 /) + kbo(:, 2,18, 1) = (/ & + & 0.13327e-08_r8,0.26784e-06_r8,0.35872e-06_r8,0.39134e-06_r8,0.10773e-07_r8 /) + kbo(:, 3,18, 1) = (/ & + & 0.12432e-08_r8,0.29008e-06_r8,0.40334e-06_r8,0.46026e-06_r8,0.11980e-07_r8 /) + kbo(:, 4,18, 1) = (/ & + & 0.11650e-08_r8,0.31637e-06_r8,0.45583e-06_r8,0.52880e-06_r8,0.13350e-07_r8 /) + kbo(:, 5,18, 1) = (/ & + & 0.10960e-08_r8,0.34503e-06_r8,0.50363e-06_r8,0.59967e-06_r8,0.14815e-07_r8 /) + kbo(:, 1,19, 1) = (/ & + & 0.11667e-08_r8,0.20231e-06_r8,0.26313e-06_r8,0.27359e-06_r8,0.79934e-08_r8 /) + kbo(:, 2,19, 1) = (/ & + & 0.10833e-08_r8,0.22085e-06_r8,0.29760e-06_r8,0.32620e-06_r8,0.88807e-08_r8 /) + kbo(:, 3,19, 1) = (/ & + & 0.10110e-08_r8,0.23912e-06_r8,0.33423e-06_r8,0.38271e-06_r8,0.98771e-08_r8 /) + kbo(:, 4,19, 1) = (/ & + & 0.94778e-09_r8,0.26073e-06_r8,0.37685e-06_r8,0.43791e-06_r8,0.11002e-07_r8 /) + kbo(:, 5,19, 1) = (/ & + & 0.89198e-09_r8,0.28425e-06_r8,0.41589e-06_r8,0.49682e-06_r8,0.12204e-07_r8 /) + kbo(:, 1,20, 1) = (/ & + & 0.94668e-09_r8,0.16735e-06_r8,0.21822e-06_r8,0.22914e-06_r8,0.66237e-08_r8 /) + kbo(:, 2,20, 1) = (/ & + & 0.87956e-09_r8,0.18255e-06_r8,0.24770e-06_r8,0.27290e-06_r8,0.73470e-08_r8 /) + kbo(:, 3,20, 1) = (/ & + & 0.82132e-09_r8,0.19776e-06_r8,0.27786e-06_r8,0.31913e-06_r8,0.81732e-08_r8 /) + kbo(:, 4,20, 1) = (/ & + & 0.77032e-09_r8,0.21557e-06_r8,0.31197e-06_r8,0.36380e-06_r8,0.91019e-08_r8 /) + kbo(:, 5,20, 1) = (/ & + & 0.72528e-09_r8,0.23458e-06_r8,0.34449e-06_r8,0.41257e-06_r8,0.10084e-07_r8 /) + kbo(:, 1,21, 1) = (/ & + & 0.76809e-09_r8,0.13858e-06_r8,0.18138e-06_r8,0.19188e-06_r8,0.54929e-08_r8 /) + kbo(:, 2,21, 1) = (/ & + & 0.71408e-09_r8,0.15088e-06_r8,0.20614e-06_r8,0.22835e-06_r8,0.60825e-08_r8 /) + kbo(:, 3,21, 1) = (/ & + & 0.66717e-09_r8,0.16366e-06_r8,0.23111e-06_r8,0.26622e-06_r8,0.67680e-08_r8 /) + kbo(:, 4,21, 1) = (/ & + & 0.62605e-09_r8,0.17816e-06_r8,0.25834e-06_r8,0.30242e-06_r8,0.75344e-08_r8 /) + kbo(:, 5,21, 1) = (/ & + & 0.58970e-09_r8,0.19374e-06_r8,0.28542e-06_r8,0.34222e-06_r8,0.83394e-08_r8 /) + kbo(:, 1,22, 1) = (/ & + & 0.62013e-09_r8,0.11547e-06_r8,0.15212e-06_r8,0.16227e-06_r8,0.45926e-08_r8 /) + kbo(:, 2,22, 1) = (/ & + & 0.57709e-09_r8,0.12552e-06_r8,0.17211e-06_r8,0.19265e-06_r8,0.50728e-08_r8 /) + kbo(:, 3,22, 1) = (/ & + & 0.53964e-09_r8,0.13619e-06_r8,0.19363e-06_r8,0.22402e-06_r8,0.56454e-08_r8 /) + kbo(:, 4,22, 1) = (/ & + & 0.50675e-09_r8,0.14805e-06_r8,0.21557e-06_r8,0.25320e-06_r8,0.62805e-08_r8 /) + kbo(:, 5,22, 1) = (/ & + & 0.47764e-09_r8,0.16097e-06_r8,0.23799e-06_r8,0.28574e-06_r8,0.69414e-08_r8 /) + kbo(:, 1,23, 1) = (/ & + & 0.50055e-09_r8,0.96165e-07_r8,0.12776e-06_r8,0.13752e-06_r8,0.37933e-08_r8 /) + kbo(:, 2,23, 1) = (/ & + & 0.46627e-09_r8,0.10421e-06_r8,0.14387e-06_r8,0.16226e-06_r8,0.42154e-08_r8 /) + kbo(:, 3,23, 1) = (/ & + & 0.43638e-09_r8,0.11320e-06_r8,0.16240e-06_r8,0.18806e-06_r8,0.46761e-08_r8 /) + kbo(:, 4,23, 1) = (/ & + & 0.41009e-09_r8,0.12312e-06_r8,0.18002e-06_r8,0.21214e-06_r8,0.51724e-08_r8 /) + kbo(:, 5,23, 1) = (/ & + & 0.38679e-09_r8,0.13380e-06_r8,0.19835e-06_r8,0.23836e-06_r8,0.56863e-08_r8 /) + kbo(:, 1,24, 1) = (/ & + & 0.40384e-09_r8,0.80174e-07_r8,0.10742e-06_r8,0.11665e-06_r8,0.31435e-08_r8 /) + kbo(:, 2,24, 1) = (/ & + & 0.37656e-09_r8,0.86611e-07_r8,0.12062e-06_r8,0.13694e-06_r8,0.34746e-08_r8 /) + kbo(:, 3,24, 1) = (/ & + & 0.35273e-09_r8,0.94203e-07_r8,0.13610e-06_r8,0.15729e-06_r8,0.38586e-08_r8 /) + kbo(:, 4,24, 1) = (/ & + & 0.33174e-09_r8,0.10246e-06_r8,0.15035e-06_r8,0.17775e-06_r8,0.42707e-08_r8 /) + kbo(:, 5,24, 1) = (/ & + & 0.31310e-09_r8,0.11122e-06_r8,0.16543e-06_r8,0.19917e-06_r8,0.47020e-08_r8 /) + kbo(:, 1,25, 1) = (/ & + & 0.32562e-09_r8,0.66785e-07_r8,0.90447e-07_r8,0.99059e-07_r8,0.26134e-08_r8 /) + kbo(:, 2,25, 1) = (/ & + & 0.30393e-09_r8,0.72133e-07_r8,0.10139e-06_r8,0.11571e-06_r8,0.28872e-08_r8 /) + kbo(:, 3,25, 1) = (/ & + & 0.28495e-09_r8,0.78448e-07_r8,0.11385e-06_r8,0.13178e-06_r8,0.32061e-08_r8 /) + kbo(:, 4,25, 1) = (/ & + & 0.26821e-09_r8,0.85339e-07_r8,0.12563e-06_r8,0.14914e-06_r8,0.35489e-08_r8 /) + kbo(:, 5,25, 1) = (/ & + & 0.25332e-09_r8,0.92445e-07_r8,0.13814e-06_r8,0.16674e-06_r8,0.39060e-08_r8 /) + kbo(:, 1,26, 1) = (/ & + & 0.26224e-09_r8,0.55680e-07_r8,0.76369e-07_r8,0.84400e-07_r8,0.21759e-08_r8 /) + kbo(:, 2,26, 1) = (/ & + & 0.24504e-09_r8,0.60204e-07_r8,0.85423e-07_r8,0.97885e-07_r8,0.24118e-08_r8 /) + kbo(:, 3,26, 1) = (/ & + & 0.22996e-09_r8,0.65477e-07_r8,0.95321e-07_r8,0.11093e-06_r8,0.26774e-08_r8 /) + kbo(:, 4,26, 1) = (/ & + & 0.21663e-09_r8,0.71188e-07_r8,0.10529e-06_r8,0.12544e-06_r8,0.29615e-08_r8 /) + kbo(:, 5,26, 1) = (/ & + & 0.20475e-09_r8,0.76940e-07_r8,0.11556e-06_r8,0.13977e-06_r8,0.32569e-08_r8 /) + kbo(:, 1,27, 1) = (/ & + & 0.21120e-09_r8,0.46382e-07_r8,0.63894e-07_r8,0.71379e-07_r8,0.18178e-08_r8 /) + kbo(:, 2,27, 1) = (/ & + & 0.19756e-09_r8,0.50278e-07_r8,0.72033e-07_r8,0.82909e-07_r8,0.20181e-08_r8 /) + kbo(:, 3,27, 1) = (/ & + & 0.18557e-09_r8,0.54670e-07_r8,0.79953e-07_r8,0.93505e-07_r8,0.22396e-08_r8 /) + kbo(:, 4,27, 1) = (/ & + & 0.17496e-09_r8,0.59408e-07_r8,0.88179e-07_r8,0.10553e-06_r8,0.24737e-08_r8 /) + kbo(:, 5,27, 1) = (/ & + & 0.16549e-09_r8,0.64025e-07_r8,0.96696e-07_r8,0.11704e-06_r8,0.27092e-08_r8 /) + kbo(:, 1,28, 1) = (/ & + & 0.17010e-09_r8,0.38631e-07_r8,0.53773e-07_r8,0.60579e-07_r8,0.15220e-08_r8 /) + kbo(:, 2,28, 1) = (/ & + & 0.15928e-09_r8,0.42001e-07_r8,0.60660e-07_r8,0.69727e-07_r8,0.16901e-08_r8 /) + kbo(:, 3,28, 1) = (/ & + & 0.14976e-09_r8,0.45661e-07_r8,0.67065e-07_r8,0.78845e-07_r8,0.18696e-08_r8 /) + kbo(:, 4,28, 1) = (/ & + & 0.14131e-09_r8,0.49571e-07_r8,0.73809e-07_r8,0.88481e-07_r8,0.20611e-08_r8 /) + kbo(:, 5,28, 1) = (/ & + & 0.13376e-09_r8,0.53304e-07_r8,0.80910e-07_r8,0.98017e-07_r8,0.22565e-08_r8 /) + kbo(:, 1,29, 1) = (/ & + & 0.13696e-09_r8,0.32270e-07_r8,0.45392e-07_r8,0.51438e-07_r8,0.12721e-08_r8 /) + kbo(:, 2,29, 1) = (/ & + & 0.12839e-09_r8,0.35079e-07_r8,0.50946e-07_r8,0.58726e-07_r8,0.14118e-08_r8 /) + kbo(:, 3,29, 1) = (/ & + & 0.12082e-09_r8,0.38150e-07_r8,0.56258e-07_r8,0.66493e-07_r8,0.15628e-08_r8 /) + kbo(:, 4,29, 1) = (/ & + & 0.11410e-09_r8,0.41324e-07_r8,0.61843e-07_r8,0.74387e-07_r8,0.17205e-08_r8 /) + kbo(:, 5,29, 1) = (/ & + & 0.10808e-09_r8,0.44387e-07_r8,0.67739e-07_r8,0.82216e-07_r8,0.18745e-08_r8 /) + kbo(:, 1,30, 1) = (/ & + & 0.11029e-09_r8,0.26970e-07_r8,0.38330e-07_r8,0.43698e-07_r8,0.10655e-08_r8 /) + kbo(:, 2,30, 1) = (/ & + & 0.10349e-09_r8,0.29319e-07_r8,0.42739e-07_r8,0.49552e-07_r8,0.11823e-08_r8 /) + kbo(:, 3,30, 1) = (/ & + & 0.97483e-10_r8,0.31869e-07_r8,0.47210e-07_r8,0.56057e-07_r8,0.13038e-08_r8 /) + kbo(:, 4,30, 1) = (/ & + & 0.92133e-10_r8,0.34436e-07_r8,0.51812e-07_r8,0.62485e-07_r8,0.14285e-08_r8 /) + kbo(:, 5,30, 1) = (/ & + & 0.87340e-10_r8,0.36953e-07_r8,0.56709e-07_r8,0.68921e-07_r8,0.15563e-08_r8 /) + kbo(:, 1,31, 1) = (/ & + & 0.88806e-10_r8,0.22555e-07_r8,0.32386e-07_r8,0.37129e-07_r8,0.89029e-09_r8 /) + kbo(:, 2,31, 1) = (/ & + & 0.83417e-10_r8,0.24519e-07_r8,0.35921e-07_r8,0.41870e-07_r8,0.98548e-09_r8 /) + kbo(:, 3,31, 1) = (/ & + & 0.78644e-10_r8,0.26638e-07_r8,0.39609e-07_r8,0.47273e-07_r8,0.10854e-08_r8 /) + kbo(:, 4,31, 1) = (/ & + & 0.74388e-10_r8,0.28694e-07_r8,0.43423e-07_r8,0.52435e-07_r8,0.11880e-08_r8 /) + kbo(:, 5,31, 1) = (/ & + & 0.70568e-10_r8,0.30776e-07_r8,0.47411e-07_r8,0.57750e-07_r8,0.12931e-08_r8 /) + kbo(:, 1,32, 1) = (/ & + & 0.71507e-10_r8,0.18870e-07_r8,0.27332e-07_r8,0.31309e-07_r8,0.74436e-09_r8 /) + kbo(:, 2,32, 1) = (/ & + & 0.67235e-10_r8,0.20512e-07_r8,0.30189e-07_r8,0.35407e-07_r8,0.82294e-09_r8 /) + kbo(:, 3,32, 1) = (/ & + & 0.63444e-10_r8,0.22259e-07_r8,0.33218e-07_r8,0.39730e-07_r8,0.90483e-09_r8 /) + kbo(:, 4,32, 1) = (/ & + & 0.60058e-10_r8,0.23923e-07_r8,0.36405e-07_r8,0.43976e-07_r8,0.98908e-09_r8 /) + kbo(:, 5,32, 1) = (/ & + & 0.57015e-10_r8,0.25634e-07_r8,0.39548e-07_r8,0.48346e-07_r8,0.10750e-08_r8 /) + kbo(:, 1,33, 1) = (/ & + & 0.57586e-10_r8,0.15779e-07_r8,0.22950e-07_r8,0.26415e-07_r8,0.62256e-09_r8 /) + kbo(:, 2,33, 1) = (/ & + & 0.54199e-10_r8,0.17153e-07_r8,0.25354e-07_r8,0.29904e-07_r8,0.68734e-09_r8 /) + kbo(:, 3,33, 1) = (/ & + & 0.51188e-10_r8,0.18569e-07_r8,0.27869e-07_r8,0.33404e-07_r8,0.75467e-09_r8 /) + kbo(:, 4,33, 1) = (/ & + & 0.48493e-10_r8,0.19935e-07_r8,0.30437e-07_r8,0.36856e-07_r8,0.82369e-09_r8 /) + kbo(:, 5,33, 1) = (/ & + & 0.46069e-10_r8,0.21345e-07_r8,0.32988e-07_r8,0.40478e-07_r8,0.89402e-09_r8 /) + kbo(:, 1,34, 1) = (/ & + & 0.46487e-10_r8,0.13161e-07_r8,0.19216e-07_r8,0.22212e-07_r8,0.51910e-09_r8 /) + kbo(:, 2,34, 1) = (/ & + & 0.43789e-10_r8,0.14301e-07_r8,0.21182e-07_r8,0.25090e-07_r8,0.57247e-09_r8 /) + kbo(:, 3,34, 1) = (/ & + & 0.41386e-10_r8,0.15447e-07_r8,0.23208e-07_r8,0.27938e-07_r8,0.62767e-09_r8 /) + kbo(:, 4,34, 1) = (/ & + & 0.39234e-10_r8,0.16571e-07_r8,0.25347e-07_r8,0.30795e-07_r8,0.68426e-09_r8 /) + kbo(:, 5,34, 1) = (/ & + & 0.37294e-10_r8,0.17725e-07_r8,0.27392e-07_r8,0.33781e-07_r8,0.74179e-09_r8 /) + kbo(:, 1,35, 1) = (/ & + & 0.37756e-10_r8,0.10890e-07_r8,0.15882e-07_r8,0.18441e-07_r8,0.42871e-09_r8 /) + kbo(:, 2,35, 1) = (/ & + & 0.35581e-10_r8,0.11830e-07_r8,0.17514e-07_r8,0.20810e-07_r8,0.47251e-09_r8 /) + kbo(:, 3,35, 1) = (/ & + & 0.33643e-10_r8,0.12757e-07_r8,0.19184e-07_r8,0.23148e-07_r8,0.51769e-09_r8 /) + kbo(:, 4,35, 1) = (/ & + & 0.31905e-10_r8,0.13682e-07_r8,0.20941e-07_r8,0.25477e-07_r8,0.56394e-09_r8 /) + kbo(:, 5,35, 1) = (/ & + & 0.30338e-10_r8,0.14628e-07_r8,0.22613e-07_r8,0.27948e-07_r8,0.61100e-09_r8 /) + kbo(:, 1,36, 1) = (/ & + & 0.30872e-10_r8,0.89290e-08_r8,0.13007e-07_r8,0.15108e-07_r8,0.35034e-09_r8 /) + kbo(:, 2,36, 1) = (/ & + & 0.29096e-10_r8,0.96995e-08_r8,0.14343e-07_r8,0.17051e-07_r8,0.38609e-09_r8 /) + kbo(:, 3,36, 1) = (/ & + & 0.27513e-10_r8,0.10456e-07_r8,0.15713e-07_r8,0.18968e-07_r8,0.42296e-09_r8 /) + kbo(:, 4,36, 1) = (/ & + & 0.26093e-10_r8,0.11213e-07_r8,0.17153e-07_r8,0.20875e-07_r8,0.46073e-09_r8 /) + kbo(:, 5,36, 1) = (/ & + & 0.24812e-10_r8,0.11987e-07_r8,0.18522e-07_r8,0.22899e-07_r8,0.49916e-09_r8 /) + kbo(:, 1,37, 1) = (/ & + & 0.25479e-10_r8,0.72338e-08_r8,0.10508e-07_r8,0.12165e-07_r8,0.28268e-09_r8 /) + kbo(:, 2,37, 1) = (/ & + & 0.24002e-10_r8,0.78593e-08_r8,0.11594e-07_r8,0.13747e-07_r8,0.31173e-09_r8 /) + kbo(:, 3,37, 1) = (/ & + & 0.22687e-10_r8,0.84845e-08_r8,0.12712e-07_r8,0.15315e-07_r8,0.34178e-09_r8 /) + kbo(:, 4,37, 1) = (/ & + & 0.21508e-10_r8,0.90997e-08_r8,0.13892e-07_r8,0.16886e-07_r8,0.37260e-09_r8 /) + kbo(:, 5,37, 1) = (/ & + & 0.20446e-10_r8,0.97322e-08_r8,0.15012e-07_r8,0.18526e-07_r8,0.40398e-09_r8 /) + kbo(:, 1,38, 1) = (/ & + & 0.21041e-10_r8,0.58565e-08_r8,0.84831e-08_r8,0.97892e-08_r8,0.22791e-09_r8 /) + kbo(:, 2,38, 1) = (/ & + & 0.19811e-10_r8,0.63636e-08_r8,0.93619e-08_r8,0.11072e-07_r8,0.25148e-09_r8 /) + kbo(:, 3,38, 1) = (/ & + & 0.18717e-10_r8,0.68784e-08_r8,0.10276e-07_r8,0.12360e-07_r8,0.27595e-09_r8 /) + kbo(:, 4,38, 1) = (/ & + & 0.17738e-10_r8,0.73792e-08_r8,0.11234e-07_r8,0.13638e-07_r8,0.30109e-09_r8 /) + kbo(:, 5,38, 1) = (/ & + & 0.16856e-10_r8,0.78971e-08_r8,0.12166e-07_r8,0.14977e-07_r8,0.32671e-09_r8 /) + kbo(:, 1,39, 1) = (/ & + & 0.17377e-10_r8,0.47418e-08_r8,0.68561e-08_r8,0.78795e-08_r8,0.18373e-09_r8 /) + kbo(:, 2,39, 1) = (/ & + & 0.16353e-10_r8,0.51532e-08_r8,0.75620e-08_r8,0.89128e-08_r8,0.20284e-09_r8 /) + kbo(:, 3,39, 1) = (/ & + & 0.15443e-10_r8,0.55752e-08_r8,0.83069e-08_r8,0.99666e-08_r8,0.22279e-09_r8 /) + kbo(:, 4,39, 1) = (/ & + & 0.14629e-10_r8,0.59857e-08_r8,0.90872e-08_r8,0.11011e-07_r8,0.24327e-09_r8 /) + kbo(:, 5,39, 1) = (/ & + & 0.13896e-10_r8,0.64086e-08_r8,0.98616e-08_r8,0.12104e-07_r8,0.26420e-09_r8 /) + kbo(:, 1,40, 1) = (/ & + & 0.14445e-10_r8,0.38091e-08_r8,0.54799e-08_r8,0.62754e-08_r8,0.14679e-09_r8 /) + kbo(:, 2,40, 1) = (/ & + & 0.13581e-10_r8,0.41391e-08_r8,0.60530e-08_r8,0.70909e-08_r8,0.16220e-09_r8 /) + kbo(:, 3,40, 1) = (/ & + & 0.12815e-10_r8,0.44888e-08_r8,0.66555e-08_r8,0.79532e-08_r8,0.17842e-09_r8 /) + kbo(:, 4,40, 1) = (/ & + & 0.12131e-10_r8,0.48207e-08_r8,0.72855e-08_r8,0.88071e-08_r8,0.19509e-09_r8 /) + kbo(:, 5,40, 1) = (/ & + & 0.11516e-10_r8,0.51646e-08_r8,0.79268e-08_r8,0.96932e-08_r8,0.21214e-09_r8 /) + kbo(:, 1,41, 1) = (/ & + & 0.12021e-10_r8,0.30566e-08_r8,0.43606e-08_r8,0.49921e-08_r8,0.11713e-09_r8 /) + kbo(:, 2,41, 1) = (/ & + & 0.11291e-10_r8,0.33205e-08_r8,0.48340e-08_r8,0.56256e-08_r8,0.12954e-09_r8 /) + kbo(:, 3,41, 1) = (/ & + & 0.10645e-10_r8,0.36053e-08_r8,0.53261e-08_r8,0.63473e-08_r8,0.14269e-09_r8 /) + kbo(:, 4,41, 1) = (/ & + & 0.10069e-10_r8,0.38782e-08_r8,0.58347e-08_r8,0.70386e-08_r8,0.15624e-09_r8 /) + kbo(:, 5,41, 1) = (/ & + & 0.95520e-11_r8,0.41580e-08_r8,0.63647e-08_r8,0.77515e-08_r8,0.17013e-09_r8 /) + kbo(:, 1,42, 1) = (/ & + & 0.10007e-10_r8,0.24516e-08_r8,0.34653e-08_r8,0.39398e-08_r8,0.93475e-10_r8 /) + kbo(:, 2,42, 1) = (/ & + & 0.93902e-11_r8,0.26631e-08_r8,0.38588e-08_r8,0.44635e-08_r8,0.10342e-09_r8 /) + kbo(:, 3,42, 1) = (/ & + & 0.88449e-11_r8,0.28926e-08_r8,0.42600e-08_r8,0.50466e-08_r8,0.11406e-09_r8 /) + kbo(:, 4,42, 1) = (/ & + & 0.83594e-11_r8,0.31198e-08_r8,0.46719e-08_r8,0.56218e-08_r8,0.12507e-09_r8 /) + kbo(:, 5,42, 1) = (/ & + & 0.79244e-11_r8,0.33465e-08_r8,0.51065e-08_r8,0.61999e-08_r8,0.13640e-09_r8 /) + kbo(:, 1,43, 1) = (/ & + & 0.83647e-11_r8,0.19578e-08_r8,0.27341e-08_r8,0.30827e-08_r8,0.74277e-10_r8 /) + kbo(:, 2,43, 1) = (/ & + & 0.78389e-11_r8,0.21263e-08_r8,0.30690e-08_r8,0.35212e-08_r8,0.82118e-10_r8 /) + kbo(:, 3,43, 1) = (/ & + & 0.73752e-11_r8,0.23103e-08_r8,0.33865e-08_r8,0.39836e-08_r8,0.90672e-10_r8 /) + kbo(:, 4,43, 1) = (/ & + & 0.69633e-11_r8,0.24984e-08_r8,0.37198e-08_r8,0.44569e-08_r8,0.99628e-10_r8 /) + kbo(:, 5,43, 1) = (/ & + & 0.65950e-11_r8,0.26833e-08_r8,0.40709e-08_r8,0.49265e-08_r8,0.10883e-09_r8 /) + kbo(:, 1,44, 1) = (/ & + & 0.70070e-11_r8,0.15628e-08_r8,0.21521e-08_r8,0.24017e-08_r8,0.59116e-10_r8 /) + kbo(:, 2,44, 1) = (/ & + & 0.65570e-11_r8,0.16954e-08_r8,0.24254e-08_r8,0.27772e-08_r8,0.65027e-10_r8 /) + kbo(:, 3,44, 1) = (/ & + & 0.61612e-11_r8,0.18413e-08_r8,0.26845e-08_r8,0.31310e-08_r8,0.71892e-10_r8 /) + kbo(:, 4,44, 1) = (/ & + & 0.58106e-11_r8,0.19977e-08_r8,0.29542e-08_r8,0.35211e-08_r8,0.79144e-10_r8 /) + kbo(:, 5,44, 1) = (/ & + & 0.54976e-11_r8,0.21464e-08_r8,0.32360e-08_r8,0.39045e-08_r8,0.86629e-10_r8 /) + kbo(:, 1,45, 1) = (/ & + & 0.58728e-11_r8,0.12500e-08_r8,0.17079e-08_r8,0.18743e-08_r8,0.46646e-10_r8 /) + kbo(:, 2,45, 1) = (/ & + & 0.54873e-11_r8,0.13505e-08_r8,0.19105e-08_r8,0.21719e-08_r8,0.51499e-10_r8 /) + kbo(:, 3,45, 1) = (/ & + & 0.51492e-11_r8,0.14670e-08_r8,0.21250e-08_r8,0.24590e-08_r8,0.56982e-10_r8 /) + kbo(:, 4,45, 1) = (/ & + & 0.48504e-11_r8,0.15931e-08_r8,0.23464e-08_r8,0.27802e-08_r8,0.62839e-10_r8 /) + kbo(:, 5,45, 1) = (/ & + & 0.45844e-11_r8,0.17167e-08_r8,0.25731e-08_r8,0.30954e-08_r8,0.68908e-10_r8 /) + kbo(:, 1,46, 1) = (/ & + & 0.49328e-11_r8,0.99811e-09_r8,0.13397e-08_r8,0.14457e-08_r8,0.36694e-10_r8 /) + kbo(:, 2,46, 1) = (/ & + & 0.46012e-11_r8,0.10742e-08_r8,0.14986e-08_r8,0.16875e-08_r8,0.40742e-10_r8 /) + kbo(:, 3,46, 1) = (/ & + & 0.43113e-11_r8,0.11665e-08_r8,0.16813e-08_r8,0.19281e-08_r8,0.45049e-10_r8 /) + kbo(:, 4,46, 1) = (/ & + & 0.40558e-11_r8,0.12673e-08_r8,0.18567e-08_r8,0.21817e-08_r8,0.49751e-10_r8 /) + kbo(:, 5,46, 1) = (/ & + & 0.38288e-11_r8,0.13702e-08_r8,0.20399e-08_r8,0.24419e-08_r8,0.54679e-10_r8 /) + kbo(:, 1,47, 1) = (/ & + & 0.41592e-11_r8,0.79205e-09_r8,0.10438e-08_r8,0.11055e-08_r8,0.28709e-10_r8 /) + kbo(:, 2,47, 1) = (/ & + & 0.38717e-11_r8,0.85357e-09_r8,0.11710e-08_r8,0.13015e-08_r8,0.32198e-10_r8 /) + kbo(:, 3,47, 1) = (/ & + & 0.36215e-11_r8,0.92515e-09_r8,0.13196e-08_r8,0.15103e-08_r8,0.35448e-10_r8 /) + kbo(:, 4,47, 1) = (/ & + & 0.34016e-11_r8,0.10046e-08_r8,0.14619e-08_r8,0.17010e-08_r8,0.39203e-10_r8 /) + kbo(:, 5,47, 1) = (/ & + & 0.32069e-11_r8,0.10904e-08_r8,0.16100e-08_r8,0.19168e-08_r8,0.43187e-10_r8 /) + kbo(:, 1,48, 1) = (/ & + & 0.35100e-11_r8,0.62849e-09_r8,0.81319e-09_r8,0.84567e-09_r8,0.22456e-10_r8 /) + kbo(:, 2,48, 1) = (/ & + & 0.32605e-11_r8,0.68021e-09_r8,0.92169e-09_r8,0.10040e-08_r8,0.25229e-10_r8 /) + kbo(:, 3,48, 1) = (/ & + & 0.30441e-11_r8,0.73294e-09_r8,0.10314e-08_r8,0.11665e-08_r8,0.27903e-10_r8 /) + kbo(:, 4,48, 1) = (/ & + & 0.28547e-11_r8,0.79615e-09_r8,0.11495e-08_r8,0.13251e-08_r8,0.30879e-10_r8 /) + kbo(:, 5,48, 1) = (/ & + & 0.26874e-11_r8,0.86463e-09_r8,0.12703e-08_r8,0.14994e-08_r8,0.34082e-10_r8 /) + kbo(:, 1,49, 1) = (/ & + & 0.29649e-11_r8,0.49867e-09_r8,0.63572e-09_r8,0.64557e-09_r8,0.17554e-10_r8 /) + kbo(:, 2,49, 1) = (/ & + & 0.27480e-11_r8,0.54124e-09_r8,0.71871e-09_r8,0.76840e-09_r8,0.19749e-10_r8 /) + kbo(:, 3,49, 1) = (/ & + & 0.25606e-11_r8,0.58140e-09_r8,0.80413e-09_r8,0.90054e-09_r8,0.22012e-10_r8 /) + kbo(:, 4,49, 1) = (/ & + & 0.23972e-11_r8,0.63097e-09_r8,0.90637e-09_r8,0.10349e-08_r8,0.24308e-10_r8 /) + kbo(:, 5,49, 1) = (/ & + & 0.22534e-11_r8,0.68545e-09_r8,0.10006e-08_r8,0.11704e-08_r8,0.26872e-10_r8 /) + kbo(:, 1,50, 1) = (/ & + & 0.25019e-11_r8,0.39853e-09_r8,0.49374e-09_r8,0.49615e-09_r8,0.13762e-10_r8 /) + kbo(:, 2,50, 1) = (/ & + & 0.23136e-11_r8,0.42952e-09_r8,0.56141e-09_r8,0.58980e-09_r8,0.15500e-10_r8 /) + kbo(:, 3,50, 1) = (/ & + & 0.21517e-11_r8,0.46334e-09_r8,0.63284e-09_r8,0.69788e-09_r8,0.17390e-10_r8 /) + kbo(:, 4,50, 1) = (/ & + & 0.20110e-11_r8,0.50130e-09_r8,0.71124e-09_r8,0.80903e-09_r8,0.19184e-10_r8 /) + kbo(:, 5,50, 1) = (/ & + & 0.18875e-11_r8,0.54446e-09_r8,0.78908e-09_r8,0.91435e-09_r8,0.21230e-10_r8 /) + kbo(:, 1,51, 1) = (/ & + & 0.21111e-11_r8,0.31534e-09_r8,0.38552e-09_r8,0.38324e-09_r8,0.10851e-10_r8 /) + kbo(:, 2,51, 1) = (/ & + & 0.19478e-11_r8,0.34179e-09_r8,0.43986e-09_r8,0.45355e-09_r8,0.12176e-10_r8 /) + kbo(:, 3,51, 1) = (/ & + & 0.18079e-11_r8,0.37016e-09_r8,0.49835e-09_r8,0.53919e-09_r8,0.13683e-10_r8 /) + kbo(:, 4,51, 1) = (/ & + & 0.16868e-11_r8,0.39846e-09_r8,0.55746e-09_r8,0.62805e-09_r8,0.15164e-10_r8 /) + kbo(:, 5,51, 1) = (/ & + & 0.15809e-11_r8,0.43272e-09_r8,0.62310e-09_r8,0.71587e-09_r8,0.16785e-10_r8 /) + kbo(:, 1,52, 1) = (/ & + & 0.17830e-11_r8,0.24939e-09_r8,0.30033e-09_r8,0.29708e-09_r8,0.85480e-11_r8 /) + kbo(:, 2,52, 1) = (/ & + & 0.16410e-11_r8,0.27244e-09_r8,0.34467e-09_r8,0.34870e-09_r8,0.95642e-11_r8 /) + kbo(:, 3,52, 1) = (/ & + & 0.15200e-11_r8,0.29507e-09_r8,0.39020e-09_r8,0.41505e-09_r8,0.10764e-10_r8 /) + kbo(:, 4,52, 1) = (/ & + & 0.14156e-11_r8,0.31736e-09_r8,0.43693e-09_r8,0.48758e-09_r8,0.12016e-10_r8 /) + kbo(:, 5,52, 1) = (/ & + & 0.13246e-11_r8,0.34409e-09_r8,0.49243e-09_r8,0.56181e-09_r8,0.13267e-10_r8 /) + kbo(:, 1,53, 1) = (/ & + & 0.15074e-11_r8,0.19746e-09_r8,0.23442e-09_r8,0.23027e-09_r8,0.66942e-11_r8 /) + kbo(:, 2,53, 1) = (/ & + & 0.13838e-11_r8,0.21754e-09_r8,0.26812e-09_r8,0.26865e-09_r8,0.75095e-11_r8 /) + kbo(:, 3,53, 1) = (/ & + & 0.12789e-11_r8,0.23445e-09_r8,0.30510e-09_r8,0.31916e-09_r8,0.84626e-11_r8 /) + kbo(:, 4,53, 1) = (/ & + & 0.11888e-11_r8,0.25305e-09_r8,0.34496e-09_r8,0.37906e-09_r8,0.94963e-11_r8 /) + kbo(:, 5,53, 1) = (/ & + & 0.11106e-11_r8,0.27355e-09_r8,0.38680e-09_r8,0.43882e-09_r8,0.10486e-10_r8 /) + kbo(:, 1,54, 1) = (/ & + & 0.12722e-11_r8,0.15676e-09_r8,0.18436e-09_r8,0.18188e-09_r8,0.52601e-11_r8 /) + kbo(:, 2,54, 1) = (/ & + & 0.11649e-11_r8,0.17256e-09_r8,0.21030e-09_r8,0.20876e-09_r8,0.59465e-11_r8 /) + kbo(:, 3,54, 1) = (/ & + & 0.10743e-11_r8,0.18706e-09_r8,0.24022e-09_r8,0.24657e-09_r8,0.66750e-11_r8 /) + kbo(:, 4,54, 1) = (/ & + & 0.99683e-12_r8,0.20263e-09_r8,0.27206e-09_r8,0.29337e-09_r8,0.75016e-11_r8 /) + kbo(:, 5,54, 1) = (/ & + & 0.92975e-12_r8,0.21798e-09_r8,0.30420e-09_r8,0.34203e-09_r8,0.83182e-11_r8 /) + kbo(:, 1,55, 1) = (/ & + & 0.10733e-11_r8,0.12552e-09_r8,0.14668e-09_r8,0.14477e-09_r8,0.41440e-11_r8 /) + kbo(:, 2,55, 1) = (/ & + & 0.98027e-12_r8,0.13705e-09_r8,0.16480e-09_r8,0.16298e-09_r8,0.47137e-11_r8 /) + kbo(:, 3,55, 1) = (/ & + & 0.90209e-12_r8,0.14966e-09_r8,0.18911e-09_r8,0.19117e-09_r8,0.52730e-11_r8 /) + kbo(:, 4,55, 1) = (/ & + & 0.83546e-12_r8,0.16210e-09_r8,0.21410e-09_r8,0.22758e-09_r8,0.59349e-11_r8 /) + kbo(:, 5,55, 1) = (/ & + & 0.77800e-12_r8,0.17423e-09_r8,0.23972e-09_r8,0.26725e-09_r8,0.66163e-11_r8 /) + kbo(:, 1,56, 1) = (/ & + & 0.90624e-12_r8,0.99786e-10_r8,0.11674e-09_r8,0.11286e-09_r8,0.32776e-11_r8 /) + kbo(:, 2,56, 1) = (/ & + & 0.82547e-12_r8,0.10897e-09_r8,0.12938e-09_r8,0.12705e-09_r8,0.37161e-11_r8 /) + kbo(:, 3,56, 1) = (/ & + & 0.75791e-12_r8,0.12009e-09_r8,0.14804e-09_r8,0.14827e-09_r8,0.41646e-11_r8 /) + kbo(:, 4,56, 1) = (/ & + & 0.70058e-12_r8,0.12925e-09_r8,0.16837e-09_r8,0.17630e-09_r8,0.46957e-11_r8 /) + kbo(:, 5,56, 1) = (/ & + & 0.65131e-12_r8,0.13937e-09_r8,0.18999e-09_r8,0.20899e-09_r8,0.52742e-11_r8 /) + kbo(:, 1,57, 1) = (/ & + & 0.76595e-12_r8,0.78822e-10_r8,0.93863e-10_r8,0.87529e-10_r8,0.26033e-11_r8 /) + kbo(:, 2,57, 1) = (/ & + & 0.69568e-12_r8,0.86555e-10_r8,0.10190e-09_r8,0.10022e-09_r8,0.29288e-11_r8 /) + kbo(:, 3,57, 1) = (/ & + & 0.63721e-12_r8,0.95385e-10_r8,0.11640e-09_r8,0.11533e-09_r8,0.32994e-11_r8 /) + kbo(:, 4,57, 1) = (/ & + & 0.58782e-12_r8,0.10325e-09_r8,0.13264e-09_r8,0.13663e-09_r8,0.37186e-11_r8 /) + kbo(:, 5,57, 1) = (/ & + & 0.54552e-12_r8,0.11173e-09_r8,0.15042e-09_r8,0.16253e-09_r8,0.41819e-11_r8 /) + kbo(:, 1,58, 1) = (/ & + & 0.64693e-12_r8,0.62421e-10_r8,0.76174e-10_r8,0.68324e-10_r8,0.20833e-11_r8 /) + kbo(:, 2,58, 1) = (/ & + & 0.58588e-12_r8,0.69278e-10_r8,0.81197e-10_r8,0.79691e-10_r8,0.23130e-11_r8 /) + kbo(:, 3,58, 1) = (/ & + & 0.53535e-12_r8,0.75873e-10_r8,0.91414e-10_r8,0.90398e-10_r8,0.26350e-11_r8 /) + kbo(:, 4,58, 1) = (/ & + & 0.49285e-12_r8,0.82653e-10_r8,0.10493e-09_r8,0.10617e-09_r8,0.29473e-11_r8 /) + kbo(:, 5,58, 1) = (/ & + & 0.45660e-12_r8,0.89643e-10_r8,0.11861e-09_r8,0.12647e-09_r8,0.33231e-11_r8 /) + kbo(:, 1,59, 1) = (/ & + & 0.53645e-12_r8,0.50557e-10_r8,0.62240e-10_r8,0.54854e-10_r8,0.16930e-11_r8 /) + kbo(:, 2,59, 1) = (/ & + & 0.48523e-12_r8,0.56468e-10_r8,0.65604e-10_r8,0.64827e-10_r8,0.18702e-11_r8 /) + kbo(:, 3,59, 1) = (/ & + & 0.44294e-12_r8,0.61442e-10_r8,0.73667e-10_r8,0.72688e-10_r8,0.21292e-11_r8 /) + kbo(:, 4,59, 1) = (/ & + & 0.40744e-12_r8,0.67184e-10_r8,0.84490e-10_r8,0.85217e-10_r8,0.23832e-11_r8 /) + kbo(:, 5,59, 1) = (/ & + & 0.37720e-12_r8,0.72657e-10_r8,0.95692e-10_r8,0.10144e-09_r8,0.26852e-11_r8 /) + kbo(:, 1,13, 2) = (/ & + & 0.18323e-07_r8,0.86266e-05_r8,0.13728e-04_r8,0.15952e-04_r8,0.78927e-06_r8 /) + kbo(:, 2,13, 2) = (/ & + & 0.16961e-07_r8,0.96203e-05_r8,0.15275e-04_r8,0.17863e-04_r8,0.93659e-06_r8 /) + kbo(:, 3,13, 2) = (/ & + & 0.15787e-07_r8,0.10675e-04_r8,0.16924e-04_r8,0.19675e-04_r8,0.11050e-05_r8 /) + kbo(:, 4,13, 2) = (/ & + & 0.14764e-07_r8,0.11779e-04_r8,0.18474e-04_r8,0.21320e-04_r8,0.12868e-05_r8 /) + kbo(:, 5,13, 2) = (/ & + & 0.13865e-07_r8,0.12843e-04_r8,0.20029e-04_r8,0.23080e-04_r8,0.14565e-05_r8 /) + kbo(:, 1,14, 2) = (/ & + & 0.14893e-07_r8,0.71882e-05_r8,0.11443e-04_r8,0.13271e-04_r8,0.65835e-06_r8 /) + kbo(:, 2,14, 2) = (/ & + & 0.13793e-07_r8,0.80276e-05_r8,0.12732e-04_r8,0.14890e-04_r8,0.78132e-06_r8 /) + kbo(:, 3,14, 2) = (/ & + & 0.12844e-07_r8,0.89189e-05_r8,0.14101e-04_r8,0.16339e-04_r8,0.92233e-06_r8 /) + kbo(:, 4,14, 2) = (/ & + & 0.12017e-07_r8,0.98309e-05_r8,0.15384e-04_r8,0.17721e-04_r8,0.10676e-05_r8 /) + kbo(:, 5,14, 2) = (/ & + & 0.11289e-07_r8,0.10704e-04_r8,0.16679e-04_r8,0.19194e-04_r8,0.12091e-05_r8 /) + kbo(:, 1,15, 2) = (/ & + & 0.12096e-07_r8,0.59934e-05_r8,0.95449e-05_r8,0.11058e-04_r8,0.54969e-06_r8 /) + kbo(:, 2,15, 2) = (/ & + & 0.11209e-07_r8,0.66932e-05_r8,0.10623e-04_r8,0.12407e-04_r8,0.65197e-06_r8 /) + kbo(:, 3,15, 2) = (/ & + & 0.10443e-07_r8,0.74449e-05_r8,0.11746e-04_r8,0.13571e-04_r8,0.76940e-06_r8 /) + kbo(:, 4,15, 2) = (/ & + & 0.97747e-08_r8,0.81948e-05_r8,0.12814e-04_r8,0.14732e-04_r8,0.88496e-06_r8 /) + kbo(:, 5,15, 2) = (/ & + & 0.91864e-08_r8,0.89188e-05_r8,0.13883e-04_r8,0.15946e-04_r8,0.10023e-05_r8 /) + kbo(:, 1,16, 2) = (/ & + & 0.98205e-08_r8,0.50027e-05_r8,0.79644e-05_r8,0.92248e-05_r8,0.45876e-06_r8 /) + kbo(:, 2,16, 2) = (/ & + & 0.91061e-08_r8,0.55846e-05_r8,0.88593e-05_r8,0.10331e-04_r8,0.54334e-06_r8 /) + kbo(:, 3,16, 2) = (/ & + & 0.84882e-08_r8,0.62183e-05_r8,0.97757e-05_r8,0.11279e-04_r8,0.64050e-06_r8 /) + kbo(:, 4,16, 2) = (/ & + & 0.79486e-08_r8,0.68276e-05_r8,0.10664e-04_r8,0.12244e-04_r8,0.73344e-06_r8 /) + kbo(:, 5,16, 2) = (/ & + & 0.74732e-08_r8,0.74268e-05_r8,0.11545e-04_r8,0.13224e-04_r8,0.82955e-06_r8 /) + kbo(:, 1,17, 2) = (/ & + & 0.79753e-08_r8,0.41713e-05_r8,0.66153e-05_r8,0.76892e-05_r8,0.38247e-06_r8 /) + kbo(:, 2,17, 2) = (/ & + & 0.73994e-08_r8,0.46562e-05_r8,0.73753e-05_r8,0.85922e-05_r8,0.45188e-06_r8 /) + kbo(:, 3,17, 2) = (/ & + & 0.69008e-08_r8,0.51829e-05_r8,0.81280e-05_r8,0.93638e-05_r8,0.53211e-06_r8 /) + kbo(:, 4,17, 2) = (/ & + & 0.64650e-08_r8,0.56765e-05_r8,0.88560e-05_r8,0.10168e-04_r8,0.60647e-06_r8 /) + kbo(:, 5,17, 2) = (/ & + & 0.60807e-08_r8,0.61758e-05_r8,0.95894e-05_r8,0.10949e-04_r8,0.68549e-06_r8 /) + kbo(:, 1,18, 2) = (/ & + & 0.64779e-08_r8,0.34727e-05_r8,0.54875e-05_r8,0.64000e-05_r8,0.31851e-06_r8 /) + kbo(:, 2,18, 2) = (/ & + & 0.60135e-08_r8,0.38751e-05_r8,0.61308e-05_r8,0.71372e-05_r8,0.37552e-06_r8 /) + kbo(:, 3,18, 2) = (/ & + & 0.56111e-08_r8,0.43132e-05_r8,0.67478e-05_r8,0.77698e-05_r8,0.44141e-06_r8 /) + kbo(:, 4,18, 2) = (/ & + & 0.52590e-08_r8,0.47150e-05_r8,0.73444e-05_r8,0.84370e-05_r8,0.50075e-06_r8 /) + kbo(:, 5,18, 2) = (/ & + & 0.49483e-08_r8,0.51345e-05_r8,0.79495e-05_r8,0.90637e-05_r8,0.56601e-06_r8 /) + kbo(:, 1,19, 2) = (/ & + & 0.52627e-08_r8,0.28908e-05_r8,0.45586e-05_r8,0.53260e-05_r8,0.26516e-06_r8 /) + kbo(:, 2,19, 2) = (/ & + & 0.48882e-08_r8,0.32260e-05_r8,0.50940e-05_r8,0.59200e-05_r8,0.31190e-06_r8 /) + kbo(:, 3,19, 2) = (/ & + & 0.45632e-08_r8,0.35843e-05_r8,0.55992e-05_r8,0.64397e-05_r8,0.36608e-06_r8 /) + kbo(:, 4,19, 2) = (/ & + & 0.42786e-08_r8,0.39167e-05_r8,0.60923e-05_r8,0.69972e-05_r8,0.41361e-06_r8 /) + kbo(:, 5,19, 2) = (/ & + & 0.40273e-08_r8,0.42667e-05_r8,0.65904e-05_r8,0.75021e-05_r8,0.46741e-06_r8 /) + kbo(:, 1,20, 2) = (/ & + & 0.42704e-08_r8,0.24074e-05_r8,0.37990e-05_r8,0.44458e-05_r8,0.22103e-06_r8 /) + kbo(:, 2,20, 2) = (/ & + & 0.39690e-08_r8,0.26942e-05_r8,0.42393e-05_r8,0.49120e-05_r8,0.26014e-06_r8 /) + kbo(:, 3,20, 2) = (/ & + & 0.37071e-08_r8,0.29827e-05_r8,0.46574e-05_r8,0.53487e-05_r8,0.30416e-06_r8 /) + kbo(:, 4,20, 2) = (/ & + & 0.34776e-08_r8,0.32601e-05_r8,0.50635e-05_r8,0.58076e-05_r8,0.34304e-06_r8 /) + kbo(:, 5,20, 2) = (/ & + & 0.32747e-08_r8,0.35518e-05_r8,0.54700e-05_r8,0.62197e-05_r8,0.38752e-06_r8 /) + kbo(:, 1,21, 2) = (/ & + & 0.34649e-08_r8,0.20096e-05_r8,0.31689e-05_r8,0.37070e-05_r8,0.18424e-06_r8 /) + kbo(:, 2,21, 2) = (/ & + & 0.32224e-08_r8,0.22503e-05_r8,0.35271e-05_r8,0.40784e-05_r8,0.21705e-06_r8 /) + kbo(:, 3,21, 2) = (/ & + & 0.30114e-08_r8,0.24834e-05_r8,0.38737e-05_r8,0.44436e-05_r8,0.25229e-06_r8 /) + kbo(:, 4,21, 2) = (/ & + & 0.28263e-08_r8,0.27149e-05_r8,0.42083e-05_r8,0.48061e-05_r8,0.28464e-06_r8 /) + kbo(:, 5,21, 2) = (/ & + & 0.26626e-08_r8,0.29556e-05_r8,0.45394e-05_r8,0.51565e-05_r8,0.32148e-06_r8 /) + kbo(:, 1,22, 2) = (/ & + & 0.27976e-08_r8,0.16913e-05_r8,0.26632e-05_r8,0.31108e-05_r8,0.15537e-06_r8 /) + kbo(:, 2,22, 2) = (/ & + & 0.26043e-08_r8,0.18908e-05_r8,0.29553e-05_r8,0.34067e-05_r8,0.18311e-06_r8 /) + kbo(:, 3,22, 2) = (/ & + & 0.24359e-08_r8,0.20811e-05_r8,0.32390e-05_r8,0.37110e-05_r8,0.21094e-06_r8 /) + kbo(:, 4,22, 2) = (/ & + & 0.22878e-08_r8,0.22746e-05_r8,0.35144e-05_r8,0.40009e-05_r8,0.23816e-06_r8 /) + kbo(:, 5,22, 2) = (/ & + & 0.21567e-08_r8,0.24714e-05_r8,0.37839e-05_r8,0.42910e-05_r8,0.26886e-06_r8 /) + kbo(:, 1,23, 2) = (/ & + & 0.22583e-08_r8,0.14234e-05_r8,0.22388e-05_r8,0.26088e-05_r8,0.13143e-06_r8 /) + kbo(:, 2,23, 2) = (/ & + & 0.21043e-08_r8,0.15864e-05_r8,0.24776e-05_r8,0.28493e-05_r8,0.15460e-06_r8 /) + kbo(:, 3,23, 2) = (/ & + & 0.19699e-08_r8,0.17436e-05_r8,0.27072e-05_r8,0.31009e-05_r8,0.17669e-06_r8 /) + kbo(:, 4,23, 2) = (/ & + & 0.18515e-08_r8,0.19057e-05_r8,0.29355e-05_r8,0.33308e-05_r8,0.19953e-06_r8 /) + kbo(:, 5,23, 2) = (/ & + & 0.17465e-08_r8,0.20653e-05_r8,0.31542e-05_r8,0.35663e-05_r8,0.22501e-06_r8 /) + kbo(:, 1,24, 2) = (/ & + & 0.18221e-08_r8,0.12001e-05_r8,0.18808e-05_r8,0.21868e-05_r8,0.11138e-06_r8 /) + kbo(:, 2,24, 2) = (/ & + & 0.16995e-08_r8,0.13315e-05_r8,0.20779e-05_r8,0.23825e-05_r8,0.13068e-06_r8 /) + kbo(:, 3,24, 2) = (/ & + & 0.15923e-08_r8,0.14625e-05_r8,0.22647e-05_r8,0.25884e-05_r8,0.14820e-06_r8 /) + kbo(:, 4,24, 2) = (/ & + & 0.14978e-08_r8,0.15972e-05_r8,0.24512e-05_r8,0.27771e-05_r8,0.16734e-06_r8 /) + kbo(:, 5,24, 2) = (/ & + & 0.14138e-08_r8,0.17254e-05_r8,0.26296e-05_r8,0.29649e-05_r8,0.18848e-06_r8 /) + kbo(:, 1,25, 2) = (/ & + & 0.14693e-08_r8,0.10111e-05_r8,0.15809e-05_r8,0.18286e-05_r8,0.94366e-07_r8 /) + kbo(:, 2,25, 2) = (/ & + & 0.13718e-08_r8,0.11199e-05_r8,0.17430e-05_r8,0.19952e-05_r8,0.11045e-06_r8 /) + kbo(:, 3,25, 2) = (/ & + & 0.12864e-08_r8,0.12273e-05_r8,0.18957e-05_r8,0.21572e-05_r8,0.12445e-06_r8 /) + kbo(:, 4,25, 2) = (/ & + & 0.12110e-08_r8,0.13373e-05_r8,0.20462e-05_r8,0.23162e-05_r8,0.14042e-06_r8 /) + kbo(:, 5,25, 2) = (/ & + & 0.11438e-08_r8,0.14410e-05_r8,0.21916e-05_r8,0.24648e-05_r8,0.15767e-06_r8 /) + kbo(:, 1,26, 2) = (/ & + & 0.11834e-08_r8,0.85331e-06_r8,0.13316e-05_r8,0.15329e-05_r8,0.80212e-07_r8 /) + kbo(:, 2,26, 2) = (/ & + & 0.11061e-08_r8,0.94192e-06_r8,0.14626e-05_r8,0.16729e-05_r8,0.92775e-07_r8 /) + kbo(:, 3,26, 2) = (/ & + & 0.10382e-08_r8,0.10317e-05_r8,0.15890e-05_r8,0.18006e-05_r8,0.10462e-06_r8 /) + kbo(:, 4,26, 2) = (/ & + & 0.97810e-09_r8,0.11205e-05_r8,0.17099e-05_r8,0.19314e-05_r8,0.11800e-06_r8 /) + kbo(:, 5,26, 2) = (/ & + & 0.92457e-09_r8,0.12034e-05_r8,0.18276e-05_r8,0.20504e-05_r8,0.13209e-06_r8 /) + kbo(:, 1,27, 2) = (/ & + & 0.95311e-09_r8,0.71890e-06_r8,0.11218e-05_r8,0.12867e-05_r8,0.68084e-07_r8 /) + kbo(:, 2,27, 2) = (/ & + & 0.89177e-09_r8,0.79258e-06_r8,0.12275e-05_r8,0.14019e-05_r8,0.77999e-07_r8 /) + kbo(:, 3,27, 2) = (/ & + & 0.83781e-09_r8,0.86605e-06_r8,0.13308e-05_r8,0.15040e-05_r8,0.88027e-07_r8 /) + kbo(:, 4,27, 2) = (/ & + & 0.78998e-09_r8,0.93815e-06_r8,0.14285e-05_r8,0.16091e-05_r8,0.99057e-07_r8 /) + kbo(:, 5,27, 2) = (/ & + & 0.74729e-09_r8,0.10046e-05_r8,0.15236e-05_r8,0.17059e-05_r8,0.11074e-06_r8 /) + kbo(:, 1,28, 2) = (/ & + & 0.76771e-09_r8,0.60623e-06_r8,0.94427e-06_r8,0.10796e-05_r8,0.57844e-07_r8 /) + kbo(:, 2,28, 2) = (/ & + & 0.71904e-09_r8,0.66653e-06_r8,0.10298e-05_r8,0.11699e-05_r8,0.65726e-07_r8 /) + kbo(:, 3,28, 2) = (/ & + & 0.67614e-09_r8,0.72689e-06_r8,0.11131e-05_r8,0.12568e-05_r8,0.74009e-07_r8 /) + kbo(:, 4,28, 2) = (/ & + & 0.63806e-09_r8,0.78482e-06_r8,0.11927e-05_r8,0.13406e-05_r8,0.83200e-07_r8 /) + kbo(:, 5,28, 2) = (/ & + & 0.60401e-09_r8,0.83806e-06_r8,0.12695e-05_r8,0.14186e-05_r8,0.92306e-07_r8 /) + kbo(:, 1,29, 2) = (/ & + & 0.61817e-09_r8,0.51053e-06_r8,0.79450e-06_r8,0.90687e-06_r8,0.49078e-07_r8 /) + kbo(:, 2,29, 2) = (/ & + & 0.57958e-09_r8,0.56071e-06_r8,0.86403e-06_r8,0.97690e-06_r8,0.55257e-07_r8 /) + kbo(:, 3,29, 2) = (/ & + & 0.54551e-09_r8,0.61009e-06_r8,0.93077e-06_r8,0.10495e-05_r8,0.62286e-07_r8 /) + kbo(:, 4,29, 2) = (/ & + & 0.51520e-09_r8,0.65631e-06_r8,0.99567e-06_r8,0.11159e-05_r8,0.69954e-07_r8 /) + kbo(:, 5,29, 2) = (/ & + & 0.48806e-09_r8,0.69830e-06_r8,0.10576e-05_r8,0.11790e-05_r8,0.77228e-07_r8 /) + kbo(:, 1,30, 2) = (/ & + & 0.49783e-09_r8,0.43014e-06_r8,0.66732e-06_r8,0.76058e-06_r8,0.41306e-07_r8 /) + kbo(:, 2,30, 2) = (/ & + & 0.46723e-09_r8,0.47148e-06_r8,0.72434e-06_r8,0.81682e-06_r8,0.46537e-07_r8 /) + kbo(:, 3,30, 2) = (/ & + & 0.44015e-09_r8,0.51146e-06_r8,0.77809e-06_r8,0.87537e-06_r8,0.52451e-07_r8 /) + kbo(:, 4,30, 2) = (/ & + & 0.41603e-09_r8,0.54877e-06_r8,0.83073e-06_r8,0.92884e-06_r8,0.58793e-07_r8 /) + kbo(:, 5,30, 2) = (/ & + & 0.39440e-09_r8,0.58159e-06_r8,0.88054e-06_r8,0.98030e-06_r8,0.64630e-07_r8 /) + kbo(:, 1,31, 2) = (/ & + & 0.40087e-09_r8,0.36256e-06_r8,0.56062e-06_r8,0.63549e-06_r8,0.34778e-07_r8 /) + kbo(:, 2,31, 2) = (/ & + & 0.37660e-09_r8,0.39620e-06_r8,0.60674e-06_r8,0.68313e-06_r8,0.39213e-07_r8 /) + kbo(:, 3,31, 2) = (/ & + & 0.35510e-09_r8,0.42855e-06_r8,0.65037e-06_r8,0.72999e-06_r8,0.44176e-07_r8 /) + kbo(:, 4,31, 2) = (/ & + & 0.33590e-09_r8,0.45852e-06_r8,0.69308e-06_r8,0.77338e-06_r8,0.49424e-07_r8 /) + kbo(:, 5,31, 2) = (/ & + & 0.31866e-09_r8,0.48459e-06_r8,0.73297e-06_r8,0.81484e-06_r8,0.54137e-07_r8 /) + kbo(:, 1,32, 2) = (/ & + & 0.32280e-09_r8,0.30547e-06_r8,0.47083e-06_r8,0.53147e-06_r8,0.29353e-07_r8 /) + kbo(:, 2,32, 2) = (/ & + & 0.30356e-09_r8,0.33271e-06_r8,0.50770e-06_r8,0.57112e-06_r8,0.33078e-07_r8 /) + kbo(:, 3,32, 2) = (/ & + & 0.28647e-09_r8,0.35876e-06_r8,0.54339e-06_r8,0.60852e-06_r8,0.37211e-07_r8 /) + kbo(:, 4,32, 2) = (/ & + & 0.27120e-09_r8,0.38214e-06_r8,0.57781e-06_r8,0.64354e-06_r8,0.41295e-07_r8 /) + kbo(:, 5,32, 2) = (/ & + & 0.25746e-09_r8,0.40374e-06_r8,0.60990e-06_r8,0.67711e-06_r8,0.45362e-07_r8 /) + kbo(:, 1,33, 2) = (/ & + & 0.25997e-09_r8,0.25723e-06_r8,0.39505e-06_r8,0.44467e-06_r8,0.24754e-07_r8 /) + kbo(:, 2,33, 2) = (/ & + & 0.24471e-09_r8,0.27926e-06_r8,0.42469e-06_r8,0.47702e-06_r8,0.27907e-07_r8 /) + kbo(:, 3,33, 2) = (/ & + & 0.23113e-09_r8,0.30024e-06_r8,0.45384e-06_r8,0.50672e-06_r8,0.31344e-07_r8 /) + kbo(:, 4,33, 2) = (/ & + & 0.21898e-09_r8,0.31862e-06_r8,0.48142e-06_r8,0.53515e-06_r8,0.34590e-07_r8 /) + kbo(:, 5,33, 2) = (/ & + & 0.20803e-09_r8,0.33624e-06_r8,0.50721e-06_r8,0.56242e-06_r8,0.37957e-07_r8 /) + kbo(:, 1,34, 2) = (/ & + & 0.20987e-09_r8,0.21561e-06_r8,0.33035e-06_r8,0.37093e-06_r8,0.20801e-07_r8 /) + kbo(:, 2,34, 2) = (/ & + & 0.19771e-09_r8,0.23356e-06_r8,0.35433e-06_r8,0.39723e-06_r8,0.23443e-07_r8 /) + kbo(:, 3,34, 2) = (/ & + & 0.18688e-09_r8,0.25042e-06_r8,0.37804e-06_r8,0.42127e-06_r8,0.26271e-07_r8 /) + kbo(:, 4,34, 2) = (/ & + & 0.17716e-09_r8,0.26514e-06_r8,0.40029e-06_r8,0.44433e-06_r8,0.28867e-07_r8 /) + kbo(:, 5,34, 2) = (/ & + & 0.16840e-09_r8,0.27949e-06_r8,0.42102e-06_r8,0.46612e-06_r8,0.31620e-07_r8 /) + kbo(:, 1,35, 2) = (/ & + & 0.17046e-09_r8,0.17909e-06_r8,0.27397e-06_r8,0.30730e-06_r8,0.17283e-07_r8 /) + kbo(:, 2,35, 2) = (/ & + & 0.16066e-09_r8,0.19378e-06_r8,0.29367e-06_r8,0.32869e-06_r8,0.19456e-07_r8 /) + kbo(:, 3,35, 2) = (/ & + & 0.15191e-09_r8,0.20716e-06_r8,0.31287e-06_r8,0.34820e-06_r8,0.21759e-07_r8 /) + kbo(:, 4,35, 2) = (/ & + & 0.14407e-09_r8,0.21938e-06_r8,0.33090e-06_r8,0.36703e-06_r8,0.23854e-07_r8 /) + kbo(:, 5,35, 2) = (/ & + & 0.13699e-09_r8,0.23115e-06_r8,0.34779e-06_r8,0.38459e-06_r8,0.26128e-07_r8 /) + kbo(:, 1,36, 2) = (/ & + & 0.13938e-09_r8,0.14742e-06_r8,0.22535e-06_r8,0.25261e-06_r8,0.14145e-07_r8 /) + kbo(:, 2,36, 2) = (/ & + & 0.13137e-09_r8,0.15949e-06_r8,0.24155e-06_r8,0.27011e-06_r8,0.15917e-07_r8 /) + kbo(:, 3,36, 2) = (/ & + & 0.12423e-09_r8,0.17037e-06_r8,0.25721e-06_r8,0.28606e-06_r8,0.17809e-07_r8 /) + kbo(:, 4,36, 2) = (/ & + & 0.11782e-09_r8,0.18044e-06_r8,0.27200e-06_r8,0.30149e-06_r8,0.19530e-07_r8 /) + kbo(:, 5,36, 2) = (/ & + & 0.11204e-09_r8,0.19011e-06_r8,0.28582e-06_r8,0.31581e-06_r8,0.21391e-07_r8 /) + kbo(:, 1,37, 2) = (/ & + & 0.11503e-09_r8,0.11991e-06_r8,0.18339e-06_r8,0.20540e-06_r8,0.11398e-07_r8 /) + kbo(:, 2,37, 2) = (/ & + & 0.10837e-09_r8,0.12985e-06_r8,0.19670e-06_r8,0.21991e-06_r8,0.12829e-07_r8 /) + kbo(:, 3,37, 2) = (/ & + & 0.10244e-09_r8,0.13895e-06_r8,0.20964e-06_r8,0.23310e-06_r8,0.14370e-07_r8 /) + kbo(:, 4,37, 2) = (/ & + & 0.97122e-10_r8,0.14725e-06_r8,0.22183e-06_r8,0.24582e-06_r8,0.15790e-07_r8 /) + kbo(:, 5,37, 2) = (/ & + & 0.92325e-10_r8,0.15526e-06_r8,0.23327e-06_r8,0.25767e-06_r8,0.17308e-07_r8 /) + kbo(:, 1,38, 2) = (/ & + & 0.94990e-10_r8,0.97434e-07_r8,0.14912e-06_r8,0.16699e-06_r8,0.91745e-08_r8 /) + kbo(:, 2,38, 2) = (/ & + & 0.89449e-10_r8,0.10563e-06_r8,0.16007e-06_r8,0.17890e-06_r8,0.10330e-07_r8 /) + kbo(:, 3,38, 2) = (/ & + & 0.84516e-10_r8,0.11322e-06_r8,0.17071e-06_r8,0.18982e-06_r8,0.11585e-07_r8 /) + kbo(:, 4,38, 2) = (/ & + & 0.80096e-10_r8,0.12009e-06_r8,0.18084e-06_r8,0.20030e-06_r8,0.12759e-07_r8 /) + kbo(:, 5,38, 2) = (/ & + & 0.76113e-10_r8,0.12672e-06_r8,0.19028e-06_r8,0.21012e-06_r8,0.13992e-07_r8 /) + kbo(:, 1,39, 2) = (/ & + & 0.78444e-10_r8,0.79147e-07_r8,0.12122e-06_r8,0.13573e-06_r8,0.73846e-08_r8 /) + kbo(:, 2,39, 2) = (/ & + & 0.73832e-10_r8,0.85901e-07_r8,0.13022e-06_r8,0.14552e-06_r8,0.83180e-08_r8 /) + kbo(:, 3,39, 2) = (/ & + & 0.69729e-10_r8,0.92230e-07_r8,0.13899e-06_r8,0.15459e-06_r8,0.93374e-08_r8 /) + kbo(:, 4,39, 2) = (/ & + & 0.66056e-10_r8,0.97919e-07_r8,0.14737e-06_r8,0.16325e-06_r8,0.10307e-07_r8 /) + kbo(:, 5,39, 2) = (/ & + & 0.62749e-10_r8,0.10341e-06_r8,0.15518e-06_r8,0.17133e-06_r8,0.11312e-07_r8 /) + kbo(:, 1,40, 2) = (/ & + & 0.65207e-10_r8,0.63715e-07_r8,0.97755e-07_r8,0.10945e-06_r8,0.58831e-08_r8 /) + kbo(:, 2,40, 2) = (/ & + & 0.61319e-10_r8,0.69289e-07_r8,0.10524e-06_r8,0.11757e-06_r8,0.66237e-08_r8 /) + kbo(:, 3,40, 2) = (/ & + & 0.57866e-10_r8,0.74694e-07_r8,0.11245e-06_r8,0.12515e-06_r8,0.74455e-08_r8 /) + kbo(:, 4,40, 2) = (/ & + & 0.54779e-10_r8,0.79359e-07_r8,0.11941e-06_r8,0.13229e-06_r8,0.82595e-08_r8 /) + kbo(:, 5,40, 2) = (/ & + & 0.52003e-10_r8,0.83957e-07_r8,0.12593e-06_r8,0.13909e-06_r8,0.90698e-08_r8 /) + kbo(:, 1,41, 2) = (/ & + & 0.54263e-10_r8,0.51172e-07_r8,0.78714e-07_r8,0.88183e-07_r8,0.46740e-08_r8 /) + kbo(:, 2,41, 2) = (/ & + & 0.50978e-10_r8,0.55838e-07_r8,0.84939e-07_r8,0.94828e-07_r8,0.52655e-08_r8 /) + kbo(:, 3,41, 2) = (/ & + & 0.48066e-10_r8,0.60328e-07_r8,0.90859e-07_r8,0.10118e-06_r8,0.59273e-08_r8 /) + kbo(:, 4,41, 2) = (/ & + & 0.45467e-10_r8,0.64260e-07_r8,0.96667e-07_r8,0.10710e-06_r8,0.66279e-08_r8 /) + kbo(:, 5,41, 2) = (/ & + & 0.43134e-10_r8,0.68089e-07_r8,0.10208e-06_r8,0.11279e-06_r8,0.72560e-08_r8 /) + kbo(:, 1,42, 2) = (/ & + & 0.45170e-10_r8,0.41073e-07_r8,0.63333e-07_r8,0.71067e-07_r8,0.37185e-08_r8 /) + kbo(:, 2,42, 2) = (/ & + & 0.42393e-10_r8,0.44964e-07_r8,0.68507e-07_r8,0.76455e-07_r8,0.41864e-08_r8 /) + kbo(:, 3,42, 2) = (/ & + & 0.39936e-10_r8,0.48667e-07_r8,0.73382e-07_r8,0.81772e-07_r8,0.47157e-08_r8 /) + kbo(:, 4,42, 2) = (/ & + & 0.37747e-10_r8,0.51996e-07_r8,0.78220e-07_r8,0.86689e-07_r8,0.52834e-08_r8 /) + kbo(:, 5,42, 2) = (/ & + & 0.35784e-10_r8,0.55178e-07_r8,0.82739e-07_r8,0.91434e-07_r8,0.58040e-08_r8 /) + kbo(:, 1,43, 2) = (/ & + & 0.37754e-10_r8,0.32770e-07_r8,0.50662e-07_r8,0.56979e-07_r8,0.29405e-08_r8 /) + kbo(:, 2,43, 2) = (/ & + & 0.35387e-10_r8,0.35997e-07_r8,0.54993e-07_r8,0.61357e-07_r8,0.33066e-08_r8 /) + kbo(:, 3,43, 2) = (/ & + & 0.33299e-10_r8,0.39073e-07_r8,0.59036e-07_r8,0.65793e-07_r8,0.37265e-08_r8 /) + kbo(:, 4,43, 2) = (/ & + & 0.31442e-10_r8,0.41903e-07_r8,0.63014e-07_r8,0.69920e-07_r8,0.41848e-08_r8 /) + kbo(:, 5,43, 2) = (/ & + & 0.29781e-10_r8,0.44546e-07_r8,0.66822e-07_r8,0.73849e-07_r8,0.46204e-08_r8 /) + kbo(:, 1,44, 2) = (/ & + & 0.31623e-10_r8,0.26054e-07_r8,0.40405e-07_r8,0.45692e-07_r8,0.22918e-08_r8 /) + kbo(:, 2,44, 2) = (/ & + & 0.29599e-10_r8,0.28713e-07_r8,0.44010e-07_r8,0.49122e-07_r8,0.26053e-08_r8 /) + kbo(:, 3,44, 2) = (/ & + & 0.27817e-10_r8,0.31296e-07_r8,0.47391e-07_r8,0.52815e-07_r8,0.29353e-08_r8 /) + kbo(:, 4,44, 2) = (/ & + & 0.26236e-10_r8,0.33677e-07_r8,0.50655e-07_r8,0.56264e-07_r8,0.33023e-08_r8 /) + kbo(:, 5,44, 2) = (/ & + & 0.24825e-10_r8,0.35896e-07_r8,0.53863e-07_r8,0.59538e-07_r8,0.36730e-08_r8 /) + kbo(:, 1,45, 2) = (/ & + & 0.26502e-10_r8,0.20705e-07_r8,0.32152e-07_r8,0.36448e-07_r8,0.17841e-08_r8 /) + kbo(:, 2,45, 2) = (/ & + & 0.24768e-10_r8,0.22868e-07_r8,0.35185e-07_r8,0.39329e-07_r8,0.20515e-08_r8 /) + kbo(:, 3,45, 2) = (/ & + & 0.23247e-10_r8,0.25027e-07_r8,0.37999e-07_r8,0.42338e-07_r8,0.23118e-08_r8 /) + kbo(:, 4,45, 2) = (/ & + & 0.21900e-10_r8,0.27063e-07_r8,0.40694e-07_r8,0.45258e-07_r8,0.26048e-08_r8 /) + kbo(:, 5,45, 2) = (/ & + & 0.20701e-10_r8,0.28901e-07_r8,0.43361e-07_r8,0.47969e-07_r8,0.29174e-08_r8 /) + kbo(:, 1,46, 2) = (/ & + & 0.22258e-10_r8,0.16422e-07_r8,0.25480e-07_r8,0.28991e-07_r8,0.13830e-08_r8 /) + kbo(:, 2,46, 2) = (/ & + & 0.20767e-10_r8,0.18158e-07_r8,0.28033e-07_r8,0.31442e-07_r8,0.16144e-08_r8 /) + kbo(:, 3,46, 2) = (/ & + & 0.19462e-10_r8,0.19953e-07_r8,0.30402e-07_r8,0.33850e-07_r8,0.18162e-08_r8 /) + kbo(:, 4,46, 2) = (/ & + & 0.18312e-10_r8,0.21658e-07_r8,0.32639e-07_r8,0.36308e-07_r8,0.20475e-08_r8 /) + kbo(:, 5,46, 2) = (/ & + & 0.17289e-10_r8,0.23211e-07_r8,0.34839e-07_r8,0.38583e-07_r8,0.22994e-08_r8 /) + kbo(:, 1,47, 2) = (/ & + & 0.18764e-10_r8,0.12951e-07_r8,0.20072e-07_r8,0.22982e-07_r8,0.10645e-08_r8 /) + kbo(:, 2,47, 2) = (/ & + & 0.17473e-10_r8,0.14335e-07_r8,0.22214e-07_r8,0.25085e-07_r8,0.12479e-08_r8 /) + kbo(:, 3,47, 2) = (/ & + & 0.16347e-10_r8,0.15813e-07_r8,0.24205e-07_r8,0.26971e-07_r8,0.14207e-08_r8 /) + kbo(:, 4,47, 2) = (/ & + & 0.15357e-10_r8,0.17255e-07_r8,0.26075e-07_r8,0.29015e-07_r8,0.16008e-08_r8 /) + kbo(:, 5,47, 2) = (/ & + & 0.14480e-10_r8,0.18558e-07_r8,0.27885e-07_r8,0.30922e-07_r8,0.18018e-08_r8 /) + kbo(:, 1,48, 2) = (/ & + & 0.15833e-10_r8,0.10186e-07_r8,0.15782e-07_r8,0.18174e-07_r8,0.81718e-09_r8 /) + kbo(:, 2,48, 2) = (/ & + & 0.14713e-10_r8,0.11312e-07_r8,0.17555e-07_r8,0.19891e-07_r8,0.96098e-09_r8 /) + kbo(:, 3,48, 2) = (/ & + & 0.13740e-10_r8,0.12509e-07_r8,0.19248e-07_r8,0.21482e-07_r8,0.11112e-08_r8 /) + kbo(:, 4,48, 2) = (/ & + & 0.12887e-10_r8,0.13719e-07_r8,0.20811e-07_r8,0.23140e-07_r8,0.12515e-08_r8 /) + kbo(:, 5,48, 2) = (/ & + & 0.12134e-10_r8,0.14840e-07_r8,0.22313e-07_r8,0.24769e-07_r8,0.14105e-08_r8 /) + kbo(:, 1,49, 2) = (/ & + & 0.13372e-10_r8,0.80050e-08_r8,0.12403e-07_r8,0.14283e-07_r8,0.63117e-09_r8 /) + kbo(:, 2,49, 2) = (/ & + & 0.12398e-10_r8,0.89393e-08_r8,0.13840e-07_r8,0.15751e-07_r8,0.73907e-09_r8 /) + kbo(:, 3,49, 2) = (/ & + & 0.11556e-10_r8,0.98821e-08_r8,0.15261e-07_r8,0.17104e-07_r8,0.86645e-09_r8 /) + kbo(:, 4,49, 2) = (/ & + & 0.10821e-10_r8,0.10884e-07_r8,0.16582e-07_r8,0.18441e-07_r8,0.97829e-09_r8 /) + kbo(:, 5,49, 2) = (/ & + & 0.10174e-10_r8,0.11841e-07_r8,0.17828e-07_r8,0.19804e-07_r8,0.11034e-08_r8 /) + kbo(:, 1,50, 2) = (/ & + & 0.11282e-10_r8,0.62726e-08_r8,0.97478e-08_r8,0.11226e-07_r8,0.48398e-09_r8 /) + kbo(:, 2,50, 2) = (/ & + & 0.10437e-10_r8,0.70546e-08_r8,0.10932e-07_r8,0.12518e-07_r8,0.57051e-09_r8 /) + kbo(:, 3,50, 2) = (/ & + & 0.97101e-11_r8,0.78193e-08_r8,0.12114e-07_r8,0.13671e-07_r8,0.66997e-09_r8 /) + kbo(:, 4,50, 2) = (/ & + & 0.90772e-11_r8,0.86379e-08_r8,0.13218e-07_r8,0.14712e-07_r8,0.76625e-09_r8 /) + kbo(:, 5,50, 2) = (/ & + & 0.85216e-11_r8,0.94405e-08_r8,0.14258e-07_r8,0.15844e-07_r8,0.86488e-09_r8 /) + kbo(:, 1,51, 2) = (/ & + & 0.95179e-11_r8,0.49251e-08_r8,0.76356e-08_r8,0.87761e-08_r8,0.37213e-09_r8 /) + kbo(:, 2,51, 2) = (/ & + & 0.87856e-11_r8,0.55681e-08_r8,0.86220e-08_r8,0.99159e-08_r8,0.44074e-09_r8 /) + kbo(:, 3,51, 2) = (/ & + & 0.81576e-11_r8,0.61930e-08_r8,0.95989e-08_r8,0.10865e-07_r8,0.51843e-09_r8 /) + kbo(:, 4,51, 2) = (/ & + & 0.76131e-11_r8,0.68518e-08_r8,0.10539e-07_r8,0.11746e-07_r8,0.60210e-09_r8 /) + kbo(:, 5,51, 2) = (/ & + & 0.71366e-11_r8,0.75206e-08_r8,0.11403e-07_r8,0.12659e-07_r8,0.67841e-09_r8 /) + kbo(:, 1,52, 2) = (/ & + & 0.80368e-11_r8,0.38608e-08_r8,0.60010e-08_r8,0.68441e-08_r8,0.28848e-09_r8 /) + kbo(:, 2,52, 2) = (/ & + & 0.74007e-11_r8,0.43903e-08_r8,0.67974e-08_r8,0.78127e-08_r8,0.34245e-09_r8 /) + kbo(:, 3,52, 2) = (/ & + & 0.68577e-11_r8,0.49086e-08_r8,0.75959e-08_r8,0.86279e-08_r8,0.40106e-09_r8 /) + kbo(:, 4,52, 2) = (/ & + & 0.63886e-11_r8,0.54297e-08_r8,0.83801e-08_r8,0.93778e-08_r8,0.47058e-09_r8 /) + kbo(:, 5,52, 2) = (/ & + & 0.59795e-11_r8,0.59829e-08_r8,0.91103e-08_r8,0.10111e-07_r8,0.53218e-09_r8 /) + kbo(:, 1,53, 2) = (/ & + & 0.67932e-11_r8,0.30102e-08_r8,0.47269e-08_r8,0.53395e-08_r8,0.22432e-09_r8 /) + kbo(:, 2,53, 2) = (/ & + & 0.62397e-11_r8,0.34450e-08_r8,0.53458e-08_r8,0.61449e-08_r8,0.26282e-09_r8 /) + kbo(:, 3,53, 2) = (/ & + & 0.57693e-11_r8,0.38768e-08_r8,0.60006e-08_r8,0.68613e-08_r8,0.31020e-09_r8 /) + kbo(:, 4,53, 2) = (/ & + & 0.53647e-11_r8,0.43002e-08_r8,0.66533e-08_r8,0.74990e-08_r8,0.36446e-09_r8 /) + kbo(:, 5,53, 2) = (/ & + & 0.50129e-11_r8,0.47527e-08_r8,0.72638e-08_r8,0.80717e-08_r8,0.41759e-09_r8 /) + kbo(:, 1,54, 2) = (/ & + & 0.57320e-11_r8,0.23582e-08_r8,0.36837e-08_r8,0.41317e-08_r8,0.17477e-09_r8 /) + kbo(:, 2,54, 2) = (/ & + & 0.52518e-11_r8,0.27163e-08_r8,0.42048e-08_r8,0.48208e-08_r8,0.20321e-09_r8 /) + kbo(:, 3,54, 2) = (/ & + & 0.48457e-11_r8,0.30678e-08_r8,0.47472e-08_r8,0.54472e-08_r8,0.24081e-09_r8 /) + kbo(:, 4,54, 2) = (/ & + & 0.44978e-11_r8,0.34148e-08_r8,0.52851e-08_r8,0.59735e-08_r8,0.28345e-09_r8 /) + kbo(:, 5,54, 2) = (/ & + & 0.41963e-11_r8,0.37804e-08_r8,0.58001e-08_r8,0.64570e-08_r8,0.32923e-09_r8 /) + kbo(:, 1,55, 2) = (/ & + & 0.48347e-11_r8,0.18534e-08_r8,0.28539e-08_r8,0.31828e-08_r8,0.13492e-09_r8 /) + kbo(:, 2,55, 2) = (/ & + & 0.44186e-11_r8,0.21392e-08_r8,0.33190e-08_r8,0.37817e-08_r8,0.15848e-09_r8 /) + kbo(:, 3,55, 2) = (/ & + & 0.40683e-11_r8,0.24320e-08_r8,0.37592e-08_r8,0.43156e-08_r8,0.18835e-09_r8 /) + kbo(:, 4,55, 2) = (/ & + & 0.37693e-11_r8,0.27150e-08_r8,0.41999e-08_r8,0.47625e-08_r8,0.22076e-09_r8 /) + kbo(:, 5,55, 2) = (/ & + & 0.35111e-11_r8,0.30082e-08_r8,0.46345e-08_r8,0.51736e-08_r8,0.25916e-09_r8 /) + kbo(:, 1,56, 2) = (/ & + & 0.40813e-11_r8,0.14543e-08_r8,0.22038e-08_r8,0.24488e-08_r8,0.10328e-09_r8 /) + kbo(:, 2,56, 2) = (/ & + & 0.37201e-11_r8,0.16813e-08_r8,0.26371e-08_r8,0.29640e-08_r8,0.12446e-09_r8 /) + kbo(:, 3,56, 2) = (/ & + & 0.34175e-11_r8,0.19191e-08_r8,0.29747e-08_r8,0.34115e-08_r8,0.14604e-09_r8 /) + kbo(:, 4,56, 2) = (/ & + & 0.31604e-11_r8,0.21575e-08_r8,0.33348e-08_r8,0.38018e-08_r8,0.17202e-09_r8 /) + kbo(:, 5,56, 2) = (/ & + & 0.29391e-11_r8,0.23932e-08_r8,0.36930e-08_r8,0.41472e-08_r8,0.20235e-09_r8 /) + kbo(:, 1,57, 2) = (/ & + & 0.34486e-11_r8,0.11480e-08_r8,0.17032e-08_r8,0.18771e-08_r8,0.78787e-10_r8 /) + kbo(:, 2,57, 2) = (/ & + & 0.31345e-11_r8,0.13189e-08_r8,0.20615e-08_r8,0.23121e-08_r8,0.96832e-10_r8 /) + kbo(:, 3,57, 2) = (/ & + & 0.28728e-11_r8,0.15144e-08_r8,0.23440e-08_r8,0.26863e-08_r8,0.11317e-09_r8 /) + kbo(:, 4,57, 2) = (/ & + & 0.26513e-11_r8,0.17102e-08_r8,0.26436e-08_r8,0.30246e-08_r8,0.13393e-09_r8 /) + kbo(:, 5,57, 2) = (/ & + & 0.24615e-11_r8,0.19022e-08_r8,0.29394e-08_r8,0.33135e-08_r8,0.15772e-09_r8 /) + kbo(:, 1,58, 2) = (/ & + & 0.29119e-11_r8,0.89500e-09_r8,0.13020e-08_r8,0.14383e-08_r8,0.60253e-10_r8 /) + kbo(:, 2,58, 2) = (/ & + & 0.26392e-11_r8,0.10369e-08_r8,0.16036e-08_r8,0.17891e-08_r8,0.75765e-10_r8 /) + kbo(:, 3,58, 2) = (/ & + & 0.24132e-11_r8,0.11975e-08_r8,0.18523e-08_r8,0.21114e-08_r8,0.88260e-10_r8 /) + kbo(:, 4,58, 2) = (/ & + & 0.22227e-11_r8,0.13570e-08_r8,0.20959e-08_r8,0.24045e-08_r8,0.10478e-09_r8 /) + kbo(:, 5,58, 2) = (/ & + & 0.20601e-11_r8,0.15139e-08_r8,0.23406e-08_r8,0.26456e-08_r8,0.12331e-09_r8 /) + kbo(:, 1,59, 2) = (/ & + & 0.24143e-11_r8,0.71851e-09_r8,0.10362e-08_r8,0.11516e-08_r8,0.48086e-10_r8 /) + kbo(:, 2,59, 2) = (/ & + & 0.21857e-11_r8,0.83732e-09_r8,0.12892e-08_r8,0.14335e-08_r8,0.60630e-10_r8 /) + kbo(:, 3,59, 2) = (/ & + & 0.19965e-11_r8,0.96815e-09_r8,0.14990e-08_r8,0.17039e-08_r8,0.71208e-10_r8 /) + kbo(:, 4,59, 2) = (/ & + & 0.18374e-11_r8,0.10982e-08_r8,0.16973e-08_r8,0.19455e-08_r8,0.84514e-10_r8 /) + kbo(:, 5,59, 2) = (/ & + & 0.17017e-11_r8,0.12277e-08_r8,0.18981e-08_r8,0.21472e-08_r8,0.99289e-10_r8 /) + kbo(:, 1,13, 3) = (/ & + & 0.69497e-07_r8,0.55900e-04_r8,0.77634e-04_r8,0.83300e-04_r8,0.14419e-04_r8 /) + kbo(:, 2,13, 3) = (/ & + & 0.64923e-07_r8,0.61779e-04_r8,0.85238e-04_r8,0.90458e-04_r8,0.15996e-04_r8 /) + kbo(:, 3,13, 3) = (/ & + & 0.60920e-07_r8,0.67532e-04_r8,0.92811e-04_r8,0.97588e-04_r8,0.17622e-04_r8 /) + kbo(:, 4,13, 3) = (/ & + & 0.57379e-07_r8,0.72876e-04_r8,0.10040e-03_r8,0.10455e-03_r8,0.19144e-04_r8 /) + kbo(:, 5,13, 3) = (/ & + & 0.54220e-07_r8,0.77699e-04_r8,0.10784e-03_r8,0.11139e-03_r8,0.20671e-04_r8 /) + kbo(:, 1,14, 3) = (/ & + & 0.56538e-07_r8,0.46627e-04_r8,0.64678e-04_r8,0.69399e-04_r8,0.12086e-04_r8 /) + kbo(:, 2,14, 3) = (/ & + & 0.52839e-07_r8,0.51536e-04_r8,0.71080e-04_r8,0.75292e-04_r8,0.13414e-04_r8 /) + kbo(:, 3,14, 3) = (/ & + & 0.49600e-07_r8,0.56334e-04_r8,0.77384e-04_r8,0.81277e-04_r8,0.14732e-04_r8 /) + kbo(:, 4,14, 3) = (/ & + & 0.46731e-07_r8,0.60751e-04_r8,0.83753e-04_r8,0.87067e-04_r8,0.15973e-04_r8 /) + kbo(:, 5,14, 3) = (/ & + & 0.44171e-07_r8,0.64792e-04_r8,0.89963e-04_r8,0.92617e-04_r8,0.17214e-04_r8 /) + kbo(:, 1,15, 3) = (/ & + & 0.45963e-07_r8,0.38920e-04_r8,0.53921e-04_r8,0.57824e-04_r8,0.10089e-04_r8 /) + kbo(:, 2,15, 3) = (/ & + & 0.42976e-07_r8,0.42987e-04_r8,0.59286e-04_r8,0.62615e-04_r8,0.11238e-04_r8 /) + kbo(:, 3,15, 3) = (/ & + & 0.40358e-07_r8,0.47014e-04_r8,0.64557e-04_r8,0.67658e-04_r8,0.12293e-04_r8 /) + kbo(:, 4,15, 3) = (/ & + & 0.38037e-07_r8,0.50641e-04_r8,0.69879e-04_r8,0.72487e-04_r8,0.13317e-04_r8 /) + kbo(:, 5,15, 3) = (/ & + & 0.35964e-07_r8,0.54003e-04_r8,0.75064e-04_r8,0.77083e-04_r8,0.14321e-04_r8 /) + kbo(:, 1,16, 3) = (/ & + & 0.37354e-07_r8,0.32479e-04_r8,0.44953e-04_r8,0.48146e-04_r8,0.84079e-05_r8 /) + kbo(:, 2,16, 3) = (/ & + & 0.34944e-07_r8,0.35873e-04_r8,0.49454e-04_r8,0.52120e-04_r8,0.93405e-05_r8 /) + kbo(:, 3,16, 3) = (/ & + & 0.32829e-07_r8,0.39220e-04_r8,0.53861e-04_r8,0.56293e-04_r8,0.10209e-04_r8 /) + kbo(:, 4,16, 3) = (/ & + & 0.30952e-07_r8,0.42155e-04_r8,0.58309e-04_r8,0.60268e-04_r8,0.11080e-04_r8 /) + kbo(:, 5,16, 3) = (/ & + & 0.29274e-07_r8,0.45014e-04_r8,0.62610e-04_r8,0.64184e-04_r8,0.11887e-04_r8 /) + kbo(:, 1,17, 3) = (/ & + & 0.30364e-07_r8,0.27086e-04_r8,0.37451e-04_r8,0.39995e-04_r8,0.70049e-05_r8 /) + kbo(:, 2,17, 3) = (/ & + & 0.28420e-07_r8,0.29919e-04_r8,0.41194e-04_r8,0.43367e-04_r8,0.77736e-05_r8 /) + kbo(:, 3,17, 3) = (/ & + & 0.26710e-07_r8,0.32650e-04_r8,0.44902e-04_r8,0.46817e-04_r8,0.84838e-05_r8 /) + kbo(:, 4,17, 3) = (/ & + & 0.25192e-07_r8,0.35098e-04_r8,0.48605e-04_r8,0.50103e-04_r8,0.92038e-05_r8 /) + kbo(:, 5,17, 3) = (/ & + & 0.23833e-07_r8,0.37507e-04_r8,0.52188e-04_r8,0.53413e-04_r8,0.98607e-05_r8 /) + kbo(:, 1,18, 3) = (/ & + & 0.24687e-07_r8,0.22581e-04_r8,0.31211e-04_r8,0.33220e-04_r8,0.58361e-05_r8 /) + kbo(:, 2,18, 3) = (/ & + & 0.23116e-07_r8,0.24940e-04_r8,0.34308e-04_r8,0.36078e-04_r8,0.64640e-05_r8 /) + kbo(:, 3,18, 3) = (/ & + & 0.21734e-07_r8,0.27181e-04_r8,0.37414e-04_r8,0.38933e-04_r8,0.70344e-05_r8 /) + kbo(:, 4,18, 3) = (/ & + & 0.20506e-07_r8,0.29216e-04_r8,0.40517e-04_r8,0.41653e-04_r8,0.76276e-05_r8 /) + kbo(:, 5,18, 3) = (/ & + & 0.19406e-07_r8,0.31237e-04_r8,0.43490e-04_r8,0.44397e-04_r8,0.81753e-05_r8 /) + kbo(:, 1,19, 3) = (/ & + & 0.20074e-07_r8,0.18818e-04_r8,0.25999e-04_r8,0.27597e-04_r8,0.48662e-05_r8 /) + kbo(:, 2,19, 3) = (/ & + & 0.18805e-07_r8,0.20784e-04_r8,0.28562e-04_r8,0.29993e-04_r8,0.53723e-05_r8 /) + kbo(:, 3,19, 3) = (/ & + & 0.17688e-07_r8,0.22626e-04_r8,0.31151e-04_r8,0.32363e-04_r8,0.58377e-05_r8 /) + kbo(:, 4,19, 3) = (/ & + & 0.16693e-07_r8,0.24300e-04_r8,0.33760e-04_r8,0.34629e-04_r8,0.63177e-05_r8 /) + kbo(:, 5,19, 3) = (/ & + & 0.15802e-07_r8,0.25985e-04_r8,0.36226e-04_r8,0.36903e-04_r8,0.67742e-05_r8 /) + kbo(:, 1,20, 3) = (/ & + & 0.16306e-07_r8,0.15717e-04_r8,0.21686e-04_r8,0.22959e-04_r8,0.40680e-05_r8 /) + kbo(:, 2,20, 3) = (/ & + & 0.15283e-07_r8,0.17355e-04_r8,0.23826e-04_r8,0.24969e-04_r8,0.44706e-05_r8 /) + kbo(:, 3,20, 3) = (/ & + & 0.14381e-07_r8,0.18856e-04_r8,0.25992e-04_r8,0.26912e-04_r8,0.48550e-05_r8 /) + kbo(:, 4,20, 3) = (/ & + & 0.13578e-07_r8,0.20265e-04_r8,0.28162e-04_r8,0.28817e-04_r8,0.52355e-05_r8 /) + kbo(:, 5,20, 3) = (/ & + & 0.12857e-07_r8,0.21638e-04_r8,0.30215e-04_r8,0.30707e-04_r8,0.56224e-05_r8 /) + kbo(:, 1,21, 3) = (/ & + & 0.13245e-07_r8,0.13128e-04_r8,0.18091e-04_r8,0.19107e-04_r8,0.33880e-05_r8 /) + kbo(:, 2,21, 3) = (/ & + & 0.12420e-07_r8,0.14495e-04_r8,0.19887e-04_r8,0.20794e-04_r8,0.37144e-05_r8 /) + kbo(:, 3,21, 3) = (/ & + & 0.11692e-07_r8,0.15704e-04_r8,0.21703e-04_r8,0.22397e-04_r8,0.40415e-05_r8 /) + kbo(:, 4,21, 3) = (/ & + & 0.11043e-07_r8,0.16904e-04_r8,0.23489e-04_r8,0.23984e-04_r8,0.43455e-05_r8 /) + kbo(:, 5,21, 3) = (/ & + & 0.10460e-07_r8,0.18037e-04_r8,0.25197e-04_r8,0.25558e-04_r8,0.46662e-05_r8 /) + kbo(:, 1,22, 3) = (/ & + & 0.10711e-07_r8,0.11044e-04_r8,0.15199e-04_r8,0.16008e-04_r8,0.28409e-05_r8 /) + kbo(:, 2,22, 3) = (/ & + & 0.10052e-07_r8,0.12165e-04_r8,0.16699e-04_r8,0.17419e-04_r8,0.31041e-05_r8 /) + kbo(:, 3,22, 3) = (/ & + & 0.94690e-08_r8,0.13158e-04_r8,0.18224e-04_r8,0.18733e-04_r8,0.33768e-05_r8 /) + kbo(:, 4,22, 3) = (/ & + & 0.89484e-08_r8,0.14166e-04_r8,0.19691e-04_r8,0.20050e-04_r8,0.36237e-05_r8 /) + kbo(:, 5,22, 3) = (/ & + & 0.84804e-08_r8,0.15085e-04_r8,0.21105e-04_r8,0.21356e-04_r8,0.38876e-05_r8 /) + kbo(:, 1,23, 3) = (/ & + & 0.86606e-08_r8,0.93002e-05_r8,0.12775e-04_r8,0.13420e-04_r8,0.23815e-05_r8 /) + kbo(:, 2,23, 3) = (/ & + & 0.81340e-08_r8,0.10210e-04_r8,0.14034e-04_r8,0.14552e-04_r8,0.25955e-05_r8 /) + kbo(:, 3,23, 3) = (/ & + & 0.76671e-08_r8,0.11035e-04_r8,0.15302e-04_r8,0.15657e-04_r8,0.28150e-05_r8 /) + kbo(:, 4,23, 3) = (/ & + & 0.72497e-08_r8,0.11863e-04_r8,0.16513e-04_r8,0.16770e-04_r8,0.30198e-05_r8 /) + kbo(:, 5,23, 3) = (/ & + & 0.68739e-08_r8,0.12616e-04_r8,0.17664e-04_r8,0.17848e-04_r8,0.32387e-05_r8 /) + kbo(:, 1,24, 3) = (/ & + & 0.69995e-08_r8,0.78392e-05_r8,0.10754e-04_r8,0.11250e-04_r8,0.19986e-05_r8 /) + kbo(:, 2,24, 3) = (/ & + & 0.65790e-08_r8,0.85674e-05_r8,0.11806e-04_r8,0.12186e-04_r8,0.21738e-05_r8 /) + kbo(:, 3,24, 3) = (/ & + & 0.62055e-08_r8,0.92664e-05_r8,0.12850e-04_r8,0.13103e-04_r8,0.23469e-05_r8 /) + kbo(:, 4,24, 3) = (/ & + & 0.58710e-08_r8,0.99376e-05_r8,0.13854e-04_r8,0.14027e-04_r8,0.25195e-05_r8 /) + kbo(:, 5,24, 3) = (/ & + & 0.55696e-08_r8,0.10527e-04_r8,0.14795e-04_r8,0.14917e-04_r8,0.26988e-05_r8 /) + kbo(:, 1,25, 3) = (/ & + & 0.56538e-08_r8,0.66118e-05_r8,0.90610e-05_r8,0.94422e-05_r8,0.16753e-05_r8 /) + kbo(:, 2,25, 3) = (/ & + & 0.53184e-08_r8,0.71986e-05_r8,0.99389e-05_r8,0.10209e-04_r8,0.18223e-05_r8 /) + kbo(:, 3,25, 3) = (/ & + & 0.50199e-08_r8,0.77863e-05_r8,0.10800e-04_r8,0.10981e-04_r8,0.19590e-05_r8 /) + kbo(:, 4,25, 3) = (/ & + & 0.47522e-08_r8,0.83415e-05_r8,0.11626e-04_r8,0.11737e-04_r8,0.21020e-05_r8 /) + kbo(:, 5,25, 3) = (/ & + & 0.45105e-08_r8,0.88017e-05_r8,0.12373e-04_r8,0.12468e-04_r8,0.22498e-05_r8 /) + kbo(:, 1,26, 3) = (/ & + & 0.45620e-08_r8,0.55749e-05_r8,0.76463e-05_r8,0.79285e-05_r8,0.14032e-05_r8 /) + kbo(:, 2,26, 3) = (/ & + & 0.42950e-08_r8,0.60590e-05_r8,0.83822e-05_r8,0.85652e-05_r8,0.15255e-05_r8 /) + kbo(:, 3,26, 3) = (/ & + & 0.40569e-08_r8,0.65510e-05_r8,0.90888e-05_r8,0.92116e-05_r8,0.16373e-05_r8 /) + kbo(:, 4,26, 3) = (/ & + & 0.38429e-08_r8,0.69918e-05_r8,0.97604e-05_r8,0.98329e-05_r8,0.17561e-05_r8 /) + kbo(:, 5,26, 3) = (/ & + & 0.36495e-08_r8,0.73566e-05_r8,0.10367e-04_r8,0.10429e-04_r8,0.18769e-05_r8 /) + kbo(:, 1,27, 3) = (/ & + & 0.36809e-08_r8,0.46967e-05_r8,0.64580e-05_r8,0.66649e-05_r8,0.11786e-05_r8 /) + kbo(:, 2,27, 3) = (/ & + & 0.34683e-08_r8,0.51072e-05_r8,0.70661e-05_r8,0.71902e-05_r8,0.12759e-05_r8 /) + kbo(:, 3,27, 3) = (/ & + & 0.32784e-08_r8,0.55053e-05_r8,0.76470e-05_r8,0.77250e-05_r8,0.13691e-05_r8 /) + kbo(:, 4,27, 3) = (/ & + & 0.31074e-08_r8,0.58474e-05_r8,0.81898e-05_r8,0.82340e-05_r8,0.14666e-05_r8 /) + kbo(:, 5,27, 3) = (/ & + & 0.29526e-08_r8,0.61493e-05_r8,0.86815e-05_r8,0.87199e-05_r8,0.15650e-05_r8 /) + kbo(:, 1,28, 3) = (/ & + & 0.29701e-08_r8,0.39582e-05_r8,0.54573e-05_r8,0.55959e-05_r8,0.99037e-06_r8 /) + kbo(:, 2,28, 3) = (/ & + & 0.28008e-08_r8,0.43048e-05_r8,0.59546e-05_r8,0.60406e-05_r8,0.10659e-05_r8 /) + kbo(:, 3,28, 3) = (/ & + & 0.26493e-08_r8,0.46277e-05_r8,0.64286e-05_r8,0.64745e-05_r8,0.11442e-05_r8 /) + kbo(:, 4,28, 3) = (/ & + & 0.25127e-08_r8,0.48940e-05_r8,0.68612e-05_r8,0.68918e-05_r8,0.12250e-05_r8 /) + kbo(:, 5,28, 3) = (/ & + & 0.23888e-08_r8,0.51428e-05_r8,0.72654e-05_r8,0.72865e-05_r8,0.13046e-05_r8 /) + kbo(:, 1,29, 3) = (/ & + & 0.23958e-08_r8,0.33409e-05_r8,0.46115e-05_r8,0.47054e-05_r8,0.83021e-06_r8 /) + kbo(:, 2,29, 3) = (/ & + & 0.22611e-08_r8,0.36267e-05_r8,0.50192e-05_r8,0.50754e-05_r8,0.89157e-06_r8 /) + kbo(:, 3,29, 3) = (/ & + & 0.21402e-08_r8,0.38805e-05_r8,0.54053e-05_r8,0.54291e-05_r8,0.95663e-06_r8 /) + kbo(:, 4,29, 3) = (/ & + & 0.20311e-08_r8,0.40929e-05_r8,0.57529e-05_r8,0.57685e-05_r8,0.10232e-05_r8 /) + kbo(:, 5,29, 3) = (/ & + & 0.19320e-08_r8,0.43014e-05_r8,0.60684e-05_r8,0.60868e-05_r8,0.10874e-05_r8 /) + kbo(:, 1,30, 3) = (/ & + & 0.19328e-08_r8,0.28217e-05_r8,0.38955e-05_r8,0.39562e-05_r8,0.69464e-06_r8 /) + kbo(:, 2,30, 3) = (/ & + & 0.18255e-08_r8,0.30515e-05_r8,0.42293e-05_r8,0.42605e-05_r8,0.74588e-06_r8 /) + kbo(:, 3,30, 3) = (/ & + & 0.17291e-08_r8,0.32496e-05_r8,0.45390e-05_r8,0.45501e-05_r8,0.79957e-06_r8 /) + kbo(:, 4,30, 3) = (/ & + & 0.16419e-08_r8,0.34235e-05_r8,0.48191e-05_r8,0.48249e-05_r8,0.85373e-06_r8 /) + kbo(:, 5,30, 3) = (/ & + & 0.15626e-08_r8,0.35992e-05_r8,0.50632e-05_r8,0.50805e-05_r8,0.90582e-06_r8 /) + kbo(:, 1,31, 3) = (/ & + & 0.15590e-08_r8,0.23841e-05_r8,0.32890e-05_r8,0.33282e-05_r8,0.58108e-06_r8 /) + kbo(:, 2,31, 3) = (/ & + & 0.14736e-08_r8,0.25683e-05_r8,0.35605e-05_r8,0.35756e-05_r8,0.62401e-06_r8 /) + kbo(:, 3,31, 3) = (/ & + & 0.13967e-08_r8,0.27223e-05_r8,0.38055e-05_r8,0.38110e-05_r8,0.66862e-06_r8 /) + kbo(:, 4,31, 3) = (/ & + & 0.13271e-08_r8,0.28652e-05_r8,0.40295e-05_r8,0.40331e-05_r8,0.71216e-06_r8 /) + kbo(:, 5,31, 3) = (/ & + & 0.12637e-08_r8,0.30069e-05_r8,0.42257e-05_r8,0.42393e-05_r8,0.75527e-06_r8 /) + kbo(:, 1,32, 3) = (/ & + & 0.12575e-08_r8,0.20099e-05_r8,0.27764e-05_r8,0.27988e-05_r8,0.48614e-06_r8 /) + kbo(:, 2,32, 3) = (/ & + & 0.11895e-08_r8,0.21551e-05_r8,0.29961e-05_r8,0.29996e-05_r8,0.52199e-06_r8 /) + kbo(:, 3,32, 3) = (/ & + & 0.11282e-08_r8,0.22771e-05_r8,0.31901e-05_r8,0.31897e-05_r8,0.55867e-06_r8 /) + kbo(:, 4,32, 3) = (/ & + & 0.10726e-08_r8,0.23969e-05_r8,0.33657e-05_r8,0.33696e-05_r8,0.59410e-06_r8 /) + kbo(:, 5,32, 3) = (/ & + & 0.10218e-08_r8,0.25076e-05_r8,0.35232e-05_r8,0.35366e-05_r8,0.62965e-06_r8 /) + kbo(:, 1,33, 3) = (/ & + & 0.10144e-08_r8,0.16940e-05_r8,0.23421e-05_r8,0.23519e-05_r8,0.40701e-06_r8 /) + kbo(:, 2,33, 3) = (/ & + & 0.96024e-09_r8,0.18066e-05_r8,0.25146e-05_r8,0.25148e-05_r8,0.43657e-06_r8 /) + kbo(:, 3,33, 3) = (/ & + & 0.91134e-09_r8,0.19053e-05_r8,0.26738e-05_r8,0.26690e-05_r8,0.46656e-06_r8 /) + kbo(:, 4,33, 3) = (/ & + & 0.86689e-09_r8,0.20038e-05_r8,0.28104e-05_r8,0.28139e-05_r8,0.49516e-06_r8 /) + kbo(:, 5,33, 3) = (/ & + & 0.82630e-09_r8,0.20860e-05_r8,0.29294e-05_r8,0.29485e-05_r8,0.52462e-06_r8 /) + kbo(:, 1,34, 3) = (/ & + & 0.82000e-09_r8,0.14231e-05_r8,0.19661e-05_r8,0.19700e-05_r8,0.33996e-06_r8 /) + kbo(:, 2,34, 3) = (/ & + & 0.77672e-09_r8,0.15105e-05_r8,0.21047e-05_r8,0.21018e-05_r8,0.36435e-06_r8 /) + kbo(:, 3,34, 3) = (/ & + & 0.73757e-09_r8,0.15908e-05_r8,0.22307e-05_r8,0.22272e-05_r8,0.38851e-06_r8 /) + kbo(:, 4,34, 3) = (/ & + & 0.70193e-09_r8,0.16706e-05_r8,0.23421e-05_r8,0.23448e-05_r8,0.41219e-06_r8 /) + kbo(:, 5,34, 3) = (/ & + & 0.66936e-09_r8,0.17330e-05_r8,0.24342e-05_r8,0.24538e-05_r8,0.43607e-06_r8 /) + kbo(:, 1,35, 3) = (/ & + & 0.66652e-09_r8,0.11842e-05_r8,0.16383e-05_r8,0.16382e-05_r8,0.28183e-06_r8 /) + kbo(:, 2,35, 3) = (/ & + & 0.63156e-09_r8,0.12541e-05_r8,0.17499e-05_r8,0.17457e-05_r8,0.30195e-06_r8 /) + kbo(:, 3,35, 3) = (/ & + & 0.59990e-09_r8,0.13209e-05_r8,0.18504e-05_r8,0.18484e-05_r8,0.32174e-06_r8 /) + kbo(:, 4,35, 3) = (/ & + & 0.57107e-09_r8,0.13850e-05_r8,0.19418e-05_r8,0.19438e-05_r8,0.34124e-06_r8 /) + kbo(:, 5,35, 3) = (/ & + & 0.54470e-09_r8,0.14348e-05_r8,0.20135e-05_r8,0.20335e-05_r8,0.36050e-06_r8 /) + kbo(:, 1,36, 3) = (/ & + & 0.54506e-09_r8,0.97870e-06_r8,0.13541e-05_r8,0.13520e-05_r8,0.23190e-06_r8 /) + kbo(:, 2,36, 3) = (/ & + & 0.51650e-09_r8,0.10354e-05_r8,0.14455e-05_r8,0.14404e-05_r8,0.24845e-06_r8 /) + kbo(:, 3,36, 3) = (/ & + & 0.49063e-09_r8,0.10910e-05_r8,0.15270e-05_r8,0.15247e-05_r8,0.26464e-06_r8 /) + kbo(:, 4,36, 3) = (/ & + & 0.46707e-09_r8,0.11427e-05_r8,0.16012e-05_r8,0.16033e-05_r8,0.28072e-06_r8 /) + kbo(:, 5,36, 3) = (/ & + & 0.44553e-09_r8,0.11833e-05_r8,0.16604e-05_r8,0.16774e-05_r8,0.29643e-06_r8 /) + kbo(:, 1,37, 3) = (/ & + & 0.44949e-09_r8,0.80104e-06_r8,0.11066e-05_r8,0.11045e-05_r8,0.18888e-06_r8 /) + kbo(:, 2,37, 3) = (/ & + & 0.42579e-09_r8,0.84810e-06_r8,0.11826e-05_r8,0.11777e-05_r8,0.20242e-06_r8 /) + kbo(:, 3,37, 3) = (/ & + & 0.40435e-09_r8,0.89404e-06_r8,0.12504e-05_r8,0.12477e-05_r8,0.21578e-06_r8 /) + kbo(:, 4,37, 3) = (/ & + & 0.38483e-09_r8,0.93737e-06_r8,0.13124e-05_r8,0.13129e-05_r8,0.22892e-06_r8 /) + kbo(:, 5,37, 3) = (/ & + & 0.36699e-09_r8,0.97118e-06_r8,0.13617e-05_r8,0.13744e-05_r8,0.24190e-06_r8 /) + kbo(:, 1,38, 3) = (/ & + & 0.37088e-09_r8,0.65468e-06_r8,0.90347e-06_r8,0.90140e-06_r8,0.15371e-06_r8 /) + kbo(:, 2,38, 3) = (/ & + & 0.35120e-09_r8,0.69421e-06_r8,0.96676e-06_r8,0.96222e-06_r8,0.16484e-06_r8 /) + kbo(:, 3,38, 3) = (/ & + & 0.33340e-09_r8,0.73211e-06_r8,0.10233e-05_r8,0.10203e-05_r8,0.17578e-06_r8 /) + kbo(:, 4,38, 3) = (/ & + & 0.31721e-09_r8,0.76838e-06_r8,0.10750e-05_r8,0.10745e-05_r8,0.18656e-06_r8 /) + kbo(:, 5,38, 3) = (/ & + & 0.30242e-09_r8,0.79676e-06_r8,0.11164e-05_r8,0.11256e-05_r8,0.19730e-06_r8 /) + kbo(:, 1,39, 3) = (/ & + & 0.30603e-09_r8,0.53518e-06_r8,0.73755e-06_r8,0.73560e-06_r8,0.12509e-06_r8 /) + kbo(:, 2,39, 3) = (/ & + & 0.28967e-09_r8,0.56827e-06_r8,0.79017e-06_r8,0.78607e-06_r8,0.13420e-06_r8 /) + kbo(:, 3,39, 3) = (/ & + & 0.27490e-09_r8,0.59946e-06_r8,0.83729e-06_r8,0.83418e-06_r8,0.14320e-06_r8 /) + kbo(:, 4,39, 3) = (/ & + & 0.26148e-09_r8,0.62968e-06_r8,0.88045e-06_r8,0.87919e-06_r8,0.15206e-06_r8 /) + kbo(:, 5,39, 3) = (/ & + & 0.24922e-09_r8,0.65358e-06_r8,0.91511e-06_r8,0.92187e-06_r8,0.16092e-06_r8 /) + kbo(:, 1,40, 3) = (/ & + & 0.25401e-09_r8,0.43491e-06_r8,0.59706e-06_r8,0.59583e-06_r8,0.10103e-06_r8 /) + kbo(:, 2,40, 3) = (/ & + & 0.24027e-09_r8,0.46243e-06_r8,0.64127e-06_r8,0.63780e-06_r8,0.10854e-06_r8 /) + kbo(:, 3,40, 3) = (/ & + & 0.22788e-09_r8,0.48789e-06_r8,0.68111e-06_r8,0.67785e-06_r8,0.11596e-06_r8 /) + kbo(:, 4,40, 3) = (/ & + & 0.21664e-09_r8,0.51370e-06_r8,0.71776e-06_r8,0.71557e-06_r8,0.12318e-06_r8 /) + kbo(:, 5,40, 3) = (/ & + & 0.20639e-09_r8,0.53413e-06_r8,0.74738e-06_r8,0.75116e-06_r8,0.13055e-06_r8 /) + kbo(:, 1,41, 3) = (/ & + & 0.21103e-09_r8,0.35162e-06_r8,0.48245e-06_r8,0.48181e-06_r8,0.81551e-07_r8 /) + kbo(:, 2,41, 3) = (/ & + & 0.19947e-09_r8,0.37577e-06_r8,0.51975e-06_r8,0.51683e-06_r8,0.87624e-07_r8 /) + kbo(:, 3,41, 3) = (/ & + & 0.18906e-09_r8,0.39681e-06_r8,0.55372e-06_r8,0.55016e-06_r8,0.93775e-07_r8 /) + kbo(:, 4,41, 3) = (/ & + & 0.17963e-09_r8,0.41856e-06_r8,0.58405e-06_r8,0.58177e-06_r8,0.99677e-07_r8 /) + kbo(:, 5,41, 3) = (/ & + & 0.17105e-09_r8,0.43610e-06_r8,0.60957e-06_r8,0.61150e-06_r8,0.10578e-06_r8 /) + kbo(:, 1,42, 3) = (/ & + & 0.17536e-09_r8,0.28412e-06_r8,0.38948e-06_r8,0.38933e-06_r8,0.65791e-07_r8 /) + kbo(:, 2,42, 3) = (/ & + & 0.16563e-09_r8,0.30504e-06_r8,0.42097e-06_r8,0.41854e-06_r8,0.70752e-07_r8 /) + kbo(:, 3,42, 3) = (/ & + & 0.15688e-09_r8,0.32265e-06_r8,0.44957e-06_r8,0.44624e-06_r8,0.75790e-07_r8 /) + kbo(:, 4,42, 3) = (/ & + & 0.14897e-09_r8,0.34080e-06_r8,0.47502e-06_r8,0.47268e-06_r8,0.80648e-07_r8 /) + kbo(:, 5,42, 3) = (/ & + & 0.14178e-09_r8,0.35584e-06_r8,0.49696e-06_r8,0.49747e-06_r8,0.85685e-07_r8 /) + kbo(:, 1,43, 3) = (/ & + & 0.14625e-09_r8,0.22828e-06_r8,0.31269e-06_r8,0.31301e-06_r8,0.52858e-07_r8 /) + kbo(:, 2,43, 3) = (/ & + & 0.13800e-09_r8,0.24660e-06_r8,0.33945e-06_r8,0.33736e-06_r8,0.56872e-07_r8 /) + kbo(:, 3,43, 3) = (/ & + & 0.13060e-09_r8,0.26150e-06_r8,0.36382e-06_r8,0.36052e-06_r8,0.61005e-07_r8 /) + kbo(:, 4,43, 3) = (/ & + & 0.12392e-09_r8,0.27637e-06_r8,0.38496e-06_r8,0.38262e-06_r8,0.65064e-07_r8 /) + kbo(:, 5,43, 3) = (/ & + & 0.11786e-09_r8,0.28960e-06_r8,0.40432e-06_r8,0.40346e-06_r8,0.69134e-07_r8 /) + kbo(:, 1,44, 3) = (/ & + & 0.12220e-09_r8,0.18299e-06_r8,0.25003e-06_r8,0.25075e-06_r8,0.42426e-07_r8 /) + kbo(:, 2,44, 3) = (/ & + & 0.11518e-09_r8,0.19858e-06_r8,0.27271e-06_r8,0.27124e-06_r8,0.45605e-07_r8 /) + kbo(:, 3,44, 3) = (/ & + & 0.10890e-09_r8,0.21149e-06_r8,0.29306e-06_r8,0.29059e-06_r8,0.48989e-07_r8 /) + kbo(:, 4,44, 3) = (/ & + & 0.10324e-09_r8,0.22361e-06_r8,0.31128e-06_r8,0.30909e-06_r8,0.52357e-07_r8 /) + kbo(:, 5,44, 3) = (/ & + & 0.98119e-10_r8,0.23540e-06_r8,0.32782e-06_r8,0.32657e-06_r8,0.55650e-07_r8 /) + kbo(:, 1,45, 3) = (/ & + & 0.10215e-09_r8,0.14604e-06_r8,0.19957e-06_r8,0.20079e-06_r8,0.34009e-07_r8 /) + kbo(:, 2,45, 3) = (/ & + & 0.96168e-10_r8,0.15976e-06_r8,0.21859e-06_r8,0.21782e-06_r8,0.36565e-07_r8 /) + kbo(:, 3,45, 3) = (/ & + & 0.90832e-10_r8,0.17092e-06_r8,0.23594e-06_r8,0.23403e-06_r8,0.39336e-07_r8 /) + kbo(:, 4,45, 3) = (/ & + & 0.86039e-10_r8,0.18076e-06_r8,0.25148e-06_r8,0.24940e-06_r8,0.42120e-07_r8 /) + kbo(:, 5,45, 3) = (/ & + & 0.81705e-10_r8,0.19091e-06_r8,0.26579e-06_r8,0.26417e-06_r8,0.44806e-07_r8 /) + kbo(:, 1,46, 3) = (/ & + & 0.85548e-10_r8,0.11606e-06_r8,0.15858e-06_r8,0.16025e-06_r8,0.27138e-07_r8 /) + kbo(:, 2,46, 3) = (/ & + & 0.80430e-10_r8,0.12777e-06_r8,0.17465e-06_r8,0.17439e-06_r8,0.29260e-07_r8 /) + kbo(:, 3,46, 3) = (/ & + & 0.75882e-10_r8,0.13771e-06_r8,0.18956e-06_r8,0.18801e-06_r8,0.31519e-07_r8 /) + kbo(:, 4,46, 3) = (/ & + & 0.71807e-10_r8,0.14597e-06_r8,0.20282e-06_r8,0.20085e-06_r8,0.33790e-07_r8 /) + kbo(:, 5,46, 3) = (/ & + & 0.68131e-10_r8,0.15454e-06_r8,0.21485e-06_r8,0.21321e-06_r8,0.36016e-07_r8 /) + kbo(:, 1,47, 3) = (/ & + & 0.71880e-10_r8,0.91677e-07_r8,0.12518e-06_r8,0.12717e-06_r8,0.21548e-07_r8 /) + kbo(:, 2,47, 3) = (/ & + & 0.67474e-10_r8,0.10182e-06_r8,0.13885e-06_r8,0.13887e-06_r8,0.23366e-07_r8 /) + kbo(:, 3,47, 3) = (/ & + & 0.63573e-10_r8,0.11037e-06_r8,0.15155e-06_r8,0.15037e-06_r8,0.25140e-07_r8 /) + kbo(:, 4,47, 3) = (/ & + & 0.60089e-10_r8,0.11757e-06_r8,0.16292e-06_r8,0.16115e-06_r8,0.27023e-07_r8 /) + kbo(:, 5,47, 3) = (/ & + & 0.56955e-10_r8,0.12460e-06_r8,0.17303e-06_r8,0.17150e-06_r8,0.28886e-07_r8 /) + kbo(:, 1,48, 3) = (/ & + & 0.60438e-10_r8,0.72378e-07_r8,0.98586e-07_r8,0.10075e-06_r8,0.17068e-07_r8 /) + kbo(:, 2,48, 3) = (/ & + & 0.56639e-10_r8,0.80662e-07_r8,0.11003e-06_r8,0.11052e-06_r8,0.18643e-07_r8 /) + kbo(:, 3,48, 3) = (/ & + & 0.53288e-10_r8,0.88391e-07_r8,0.12069e-06_r8,0.12007e-06_r8,0.20050e-07_r8 /) + kbo(:, 4,48, 3) = (/ & + & 0.50306e-10_r8,0.94624e-07_r8,0.13045e-06_r8,0.12916e-06_r8,0.21587e-07_r8 /) + kbo(:, 5,48, 3) = (/ & + & 0.47632e-10_r8,0.10026e-06_r8,0.13914e-06_r8,0.13778e-06_r8,0.23136e-07_r8 /) + kbo(:, 1,49, 3) = (/ & + & 0.50856e-10_r8,0.57046e-07_r8,0.77565e-07_r8,0.79741e-07_r8,0.13510e-07_r8 /) + kbo(:, 2,49, 3) = (/ & + & 0.47574e-10_r8,0.63730e-07_r8,0.86939e-07_r8,0.87826e-07_r8,0.14811e-07_r8 /) + kbo(:, 3,49, 3) = (/ & + & 0.44692e-10_r8,0.70367e-07_r8,0.95974e-07_r8,0.95707e-07_r8,0.15992e-07_r8 /) + kbo(:, 4,49, 3) = (/ & + & 0.42136e-10_r8,0.75959e-07_r8,0.10441e-06_r8,0.10336e-06_r8,0.17235e-07_r8 /) + kbo(:, 5,49, 3) = (/ & + & 0.39851e-10_r8,0.80662e-07_r8,0.11179e-06_r8,0.11061e-06_r8,0.18501e-07_r8 /) + kbo(:, 1,50, 3) = (/ & + & 0.42752e-10_r8,0.44994e-07_r8,0.60933e-07_r8,0.63170e-07_r8,0.10733e-07_r8 /) + kbo(:, 2,50, 3) = (/ & + & 0.39920e-10_r8,0.50417e-07_r8,0.68695e-07_r8,0.69776e-07_r8,0.11778e-07_r8 /) + kbo(:, 3,50, 3) = (/ & + & 0.37445e-10_r8,0.56129e-07_r8,0.76381e-07_r8,0.76292e-07_r8,0.12796e-07_r8 /) + kbo(:, 4,50, 3) = (/ & + & 0.35258e-10_r8,0.60916e-07_r8,0.83533e-07_r8,0.82746e-07_r8,0.13770e-07_r8 /) + kbo(:, 5,50, 3) = (/ & + & 0.33309e-10_r8,0.65010e-07_r8,0.89933e-07_r8,0.88828e-07_r8,0.14809e-07_r8 /) + kbo(:, 1,51, 3) = (/ & + & 0.35935e-10_r8,0.35278e-07_r8,0.47901e-07_r8,0.50056e-07_r8,0.85239e-08_r8 /) + kbo(:, 2,51, 3) = (/ & + & 0.33494e-10_r8,0.39897e-07_r8,0.54245e-07_r8,0.55439e-07_r8,0.93562e-08_r8 /) + kbo(:, 3,51, 3) = (/ & + & 0.31368e-10_r8,0.44577e-07_r8,0.60687e-07_r8,0.60854e-07_r8,0.10229e-07_r8 /) + kbo(:, 4,51, 3) = (/ & + & 0.29497e-10_r8,0.48906e-07_r8,0.66668e-07_r8,0.66217e-07_r8,0.11009e-07_r8 /) + kbo(:, 5,51, 3) = (/ & + & 0.27834e-10_r8,0.52348e-07_r8,0.72154e-07_r8,0.71322e-07_r8,0.11856e-07_r8 /) + kbo(:, 1,52, 3) = (/ & + & 0.30227e-10_r8,0.27572e-07_r8,0.37524e-07_r8,0.39754e-07_r8,0.67198e-08_r8 /) + kbo(:, 2,52, 3) = (/ & + & 0.28118e-10_r8,0.31560e-07_r8,0.42810e-07_r8,0.44031e-07_r8,0.74267e-08_r8 /) + kbo(:, 3,52, 3) = (/ & + & 0.26290e-10_r8,0.35319e-07_r8,0.48079e-07_r8,0.48486e-07_r8,0.81511e-08_r8 /) + kbo(:, 4,52, 3) = (/ & + & 0.24687e-10_r8,0.39041e-07_r8,0.53141e-07_r8,0.52898e-07_r8,0.88044e-08_r8 /) + kbo(:, 5,52, 3) = (/ & + & 0.23267e-10_r8,0.42123e-07_r8,0.57835e-07_r8,0.57177e-07_r8,0.94934e-08_r8 /) + kbo(:, 1,53, 3) = (/ & + & 0.25448e-10_r8,0.21456e-07_r8,0.29324e-07_r8,0.31450e-07_r8,0.53035e-08_r8 /) + kbo(:, 2,53, 3) = (/ & + & 0.23623e-10_r8,0.24922e-07_r8,0.33706e-07_r8,0.34903e-07_r8,0.59025e-08_r8 /) + kbo(:, 3,53, 3) = (/ & + & 0.22048e-10_r8,0.27931e-07_r8,0.38009e-07_r8,0.38548e-07_r8,0.64842e-08_r8 /) + kbo(:, 4,53, 3) = (/ & + & 0.20673e-10_r8,0.31117e-07_r8,0.42293e-07_r8,0.42180e-07_r8,0.70454e-08_r8 /) + kbo(:, 5,53, 3) = (/ & + & 0.19459e-10_r8,0.33800e-07_r8,0.46316e-07_r8,0.45776e-07_r8,0.75886e-08_r8 /) + kbo(:, 1,54, 3) = (/ & + & 0.21390e-10_r8,0.16743e-07_r8,0.23031e-07_r8,0.24877e-07_r8,0.41777e-08_r8 /) + kbo(:, 2,54, 3) = (/ & + & 0.19815e-10_r8,0.19619e-07_r8,0.26556e-07_r8,0.27722e-07_r8,0.47031e-08_r8 /) + kbo(:, 3,54, 3) = (/ & + & 0.18463e-10_r8,0.22167e-07_r8,0.30101e-07_r8,0.30708e-07_r8,0.51646e-08_r8 /) + kbo(:, 4,54, 3) = (/ & + & 0.17286e-10_r8,0.24804e-07_r8,0.33704e-07_r8,0.33716e-07_r8,0.56448e-08_r8 /) + kbo(:, 5,54, 3) = (/ & + & 0.16251e-10_r8,0.27183e-07_r8,0.37049e-07_r8,0.36696e-07_r8,0.60788e-08_r8 /) + kbo(:, 1,55, 3) = (/ & + & 0.17973e-10_r8,0.13037e-07_r8,0.18115e-07_r8,0.19727e-07_r8,0.32912e-08_r8 /) + kbo(:, 2,55, 3) = (/ & + & 0.16615e-10_r8,0.15402e-07_r8,0.20942e-07_r8,0.22043e-07_r8,0.37301e-08_r8 /) + kbo(:, 3,55, 3) = (/ & + & 0.15454e-10_r8,0.17592e-07_r8,0.23848e-07_r8,0.24485e-07_r8,0.41129e-08_r8 /) + kbo(:, 4,55, 3) = (/ & + & 0.14448e-10_r8,0.19733e-07_r8,0.26815e-07_r8,0.26954e-07_r8,0.45146e-08_r8 /) + kbo(:, 5,55, 3) = (/ & + & 0.13565e-10_r8,0.21785e-07_r8,0.29633e-07_r8,0.29414e-07_r8,0.48762e-08_r8 /) + kbo(:, 1,56, 3) = (/ & + & 0.15112e-10_r8,0.10127e-07_r8,0.14262e-07_r8,0.15637e-07_r8,0.25986e-08_r8 /) + kbo(:, 2,56, 3) = (/ & + & 0.13939e-10_r8,0.12082e-07_r8,0.16458e-07_r8,0.17567e-07_r8,0.29510e-08_r8 /) + kbo(:, 3,56, 3) = (/ & + & 0.12942e-10_r8,0.13980e-07_r8,0.18876e-07_r8,0.19499e-07_r8,0.32803e-08_r8 /) + kbo(:, 4,56, 3) = (/ & + & 0.12080e-10_r8,0.15677e-07_r8,0.21298e-07_r8,0.21516e-07_r8,0.36078e-08_r8 /) + kbo(:, 5,56, 3) = (/ & + & 0.11328e-10_r8,0.17421e-07_r8,0.23674e-07_r8,0.23552e-07_r8,0.39142e-08_r8 /) + kbo(:, 1,57, 3) = (/ & + & 0.12716e-10_r8,0.78423e-08_r8,0.11218e-07_r8,0.12368e-07_r8,0.20572e-08_r8 /) + kbo(:, 2,57, 3) = (/ & + & 0.11703e-10_r8,0.94468e-08_r8,0.12944e-07_r8,0.13939e-07_r8,0.23449e-08_r8 /) + kbo(:, 3,57, 3) = (/ & + & 0.10844e-10_r8,0.11054e-07_r8,0.14933e-07_r8,0.15504e-07_r8,0.26161e-08_r8 /) + kbo(:, 4,57, 3) = (/ & + & 0.10105e-10_r8,0.12445e-07_r8,0.16895e-07_r8,0.17167e-07_r8,0.28789e-08_r8 /) + kbo(:, 5,57, 3) = (/ & + & 0.94629e-11_r8,0.13929e-07_r8,0.18884e-07_r8,0.18837e-07_r8,0.31391e-08_r8 /) + kbo(:, 1,58, 3) = (/ & + & 0.10694e-10_r8,0.61084e-08_r8,0.88278e-08_r8,0.97801e-08_r8,0.16192e-08_r8 /) + kbo(:, 2,58, 3) = (/ & + & 0.98180e-11_r8,0.73859e-08_r8,0.10206e-07_r8,0.11064e-07_r8,0.18486e-08_r8 /) + kbo(:, 3,58, 3) = (/ & + & 0.90797e-11_r8,0.87113e-08_r8,0.11801e-07_r8,0.12348e-07_r8,0.20872e-08_r8 /) + kbo(:, 4,58, 3) = (/ & + & 0.84478e-11_r8,0.99003e-08_r8,0.13409e-07_r8,0.13707e-07_r8,0.22967e-08_r8 /) + kbo(:, 5,58, 3) = (/ & + & 0.78998e-11_r8,0.11108e-07_r8,0.15069e-07_r8,0.15082e-07_r8,0.25182e-08_r8 /) + kbo(:, 1,59, 3) = (/ & + & 0.88513e-11_r8,0.49239e-08_r8,0.71386e-08_r8,0.79170e-08_r8,0.13089e-08_r8 /) + kbo(:, 2,59, 3) = (/ & + & 0.81187e-11_r8,0.59541e-08_r8,0.82539e-08_r8,0.89758e-08_r8,0.14952e-08_r8 /) + kbo(:, 3,59, 3) = (/ & + & 0.75021e-11_r8,0.70450e-08_r8,0.95567e-08_r8,0.10024e-07_r8,0.16919e-08_r8 /) + kbo(:, 4,59, 3) = (/ & + & 0.69753e-11_r8,0.80391e-08_r8,0.10874e-07_r8,0.11143e-07_r8,0.18646e-08_r8 /) + kbo(:, 5,59, 3) = (/ & + & 0.65191e-11_r8,0.90265e-08_r8,0.12240e-07_r8,0.12268e-07_r8,0.20471e-08_r8 /) + kbo(:, 1,13, 4) = (/ & + & 0.40115e-06_r8,0.20542e-03_r8,0.29006e-03_r8,0.29983e-03_r8,0.86404e-04_r8 /) + kbo(:, 2,13, 4) = (/ & + & 0.38503e-06_r8,0.22086e-03_r8,0.30833e-03_r8,0.32518e-03_r8,0.92611e-04_r8 /) + kbo(:, 3,13, 4) = (/ & + & 0.37042e-06_r8,0.23415e-03_r8,0.32674e-03_r8,0.34814e-03_r8,0.98878e-04_r8 /) + kbo(:, 4,13, 4) = (/ & + & 0.35699e-06_r8,0.24607e-03_r8,0.34335e-03_r8,0.36858e-03_r8,0.10559e-03_r8 /) + kbo(:, 5,13, 4) = (/ & + & 0.34439e-06_r8,0.25741e-03_r8,0.35943e-03_r8,0.38716e-03_r8,0.11262e-03_r8 /) + kbo(:, 1,14, 4) = (/ & + & 0.32717e-06_r8,0.17086e-03_r8,0.24121e-03_r8,0.25001e-03_r8,0.72120e-04_r8 /) + kbo(:, 2,14, 4) = (/ & + & 0.31411e-06_r8,0.18358e-03_r8,0.25599e-03_r8,0.27089e-03_r8,0.77351e-04_r8 /) + kbo(:, 3,14, 4) = (/ & + & 0.30225e-06_r8,0.19456e-03_r8,0.27149e-03_r8,0.29002e-03_r8,0.82676e-04_r8 /) + kbo(:, 4,14, 4) = (/ & + & 0.29132e-06_r8,0.20460e-03_r8,0.28544e-03_r8,0.30678e-03_r8,0.88331e-04_r8 /) + kbo(:, 5,14, 4) = (/ & + & 0.28105e-06_r8,0.21410e-03_r8,0.29919e-03_r8,0.32271e-03_r8,0.94451e-04_r8 /) + kbo(:, 1,15, 4) = (/ & + & 0.26673e-06_r8,0.14221e-03_r8,0.20048e-03_r8,0.20843e-03_r8,0.60213e-04_r8 /) + kbo(:, 2,15, 4) = (/ & + & 0.25615e-06_r8,0.15268e-03_r8,0.21264e-03_r8,0.22531e-03_r8,0.64531e-04_r8 /) + kbo(:, 3,15, 4) = (/ & + & 0.24652e-06_r8,0.16170e-03_r8,0.22567e-03_r8,0.24157e-03_r8,0.69102e-04_r8 /) + kbo(:, 4,15, 4) = (/ & + & 0.23764e-06_r8,0.17023e-03_r8,0.23750e-03_r8,0.25543e-03_r8,0.73891e-04_r8 /) + kbo(:, 5,15, 4) = (/ & + & 0.22926e-06_r8,0.17815e-03_r8,0.24912e-03_r8,0.26892e-03_r8,0.79167e-04_r8 /) + kbo(:, 1,16, 4) = (/ & + & 0.21740e-06_r8,0.11824e-03_r8,0.16644e-03_r8,0.17381e-03_r8,0.50227e-04_r8 /) + kbo(:, 2,16, 4) = (/ & + & 0.20884e-06_r8,0.12696e-03_r8,0.17683e-03_r8,0.18780e-03_r8,0.53903e-04_r8 /) + kbo(:, 3,16, 4) = (/ & + & 0.20104e-06_r8,0.13434e-03_r8,0.18764e-03_r8,0.20094e-03_r8,0.57777e-04_r8 /) + kbo(:, 4,16, 4) = (/ & + & 0.19381e-06_r8,0.14177e-03_r8,0.19757e-03_r8,0.21259e-03_r8,0.61821e-04_r8 /) + kbo(:, 5,16, 4) = (/ & + & 0.18698e-06_r8,0.14828e-03_r8,0.20747e-03_r8,0.22416e-03_r8,0.66326e-04_r8 /) + kbo(:, 1,17, 4) = (/ & + & 0.17724e-06_r8,0.98287e-04_r8,0.13813e-03_r8,0.14496e-03_r8,0.41851e-04_r8 /) + kbo(:, 2,17, 4) = (/ & + & 0.17029e-06_r8,0.10548e-03_r8,0.14701e-03_r8,0.15636e-03_r8,0.44943e-04_r8 /) + kbo(:, 3,17, 4) = (/ & + & 0.16396e-06_r8,0.11169e-03_r8,0.15605e-03_r8,0.16727e-03_r8,0.48176e-04_r8 /) + kbo(:, 4,17, 4) = (/ & + & 0.15809e-06_r8,0.11795e-03_r8,0.16435e-03_r8,0.17684e-03_r8,0.51716e-04_r8 /) + kbo(:, 5,17, 4) = (/ & + & 0.15251e-06_r8,0.12332e-03_r8,0.17265e-03_r8,0.18683e-03_r8,0.55480e-04_r8 /) + kbo(:, 1,18, 4) = (/ & + & 0.14450e-06_r8,0.81703e-04_r8,0.11464e-03_r8,0.12079e-03_r8,0.34849e-04_r8 /) + kbo(:, 2,18, 4) = (/ & + & 0.13887e-06_r8,0.87580e-04_r8,0.12224e-03_r8,0.13028e-03_r8,0.37465e-04_r8 /) + kbo(:, 3,18, 4) = (/ & + & 0.13373e-06_r8,0.92869e-04_r8,0.12966e-03_r8,0.13906e-03_r8,0.40225e-04_r8 /) + kbo(:, 4,18, 4) = (/ & + & 0.12896e-06_r8,0.98034e-04_r8,0.13668e-03_r8,0.14712e-03_r8,0.43227e-04_r8 /) + kbo(:, 5,18, 4) = (/ & + & 0.12439e-06_r8,0.10250e-03_r8,0.14367e-03_r8,0.15557e-03_r8,0.46383e-04_r8 /) + kbo(:, 1,19, 4) = (/ & + & 0.11782e-06_r8,0.67922e-04_r8,0.95121e-04_r8,0.10059e-03_r8,0.29014e-04_r8 /) + kbo(:, 2,19, 4) = (/ & + & 0.11325e-06_r8,0.72759e-04_r8,0.10166e-03_r8,0.10843e-03_r8,0.31239e-04_r8 /) + kbo(:, 3,19, 4) = (/ & + & 0.10909e-06_r8,0.77213e-04_r8,0.10769e-03_r8,0.11563e-03_r8,0.33594e-04_r8 /) + kbo(:, 4,19, 4) = (/ & + & 0.10521e-06_r8,0.81507e-04_r8,0.11367e-03_r8,0.12244e-03_r8,0.36087e-04_r8 /) + kbo(:, 5,19, 4) = (/ & + & 0.10146e-06_r8,0.85229e-04_r8,0.11951e-03_r8,0.12955e-03_r8,0.38760e-04_r8 /) + kbo(:, 1,20, 4) = (/ & + & 0.96005e-07_r8,0.56539e-04_r8,0.79048e-04_r8,0.83638e-04_r8,0.24182e-04_r8 /) + kbo(:, 2,20, 4) = (/ & + & 0.92311e-07_r8,0.60522e-04_r8,0.84506e-04_r8,0.90308e-04_r8,0.26052e-04_r8 /) + kbo(:, 3,20, 4) = (/ & + & 0.88927e-07_r8,0.64305e-04_r8,0.89608e-04_r8,0.96229e-04_r8,0.28071e-04_r8 /) + kbo(:, 4,20, 4) = (/ & + & 0.85775e-07_r8,0.67811e-04_r8,0.94659e-04_r8,0.10203e-03_r8,0.30185e-04_r8 /) + kbo(:, 5,20, 4) = (/ & + & 0.82709e-07_r8,0.70967e-04_r8,0.99551e-04_r8,0.10796e-03_r8,0.32438e-04_r8 /) + kbo(:, 1,21, 4) = (/ & + & 0.78225e-07_r8,0.47094e-04_r8,0.65736e-04_r8,0.69706e-04_r8,0.20168e-04_r8 /) + kbo(:, 2,21, 4) = (/ & + & 0.75235e-07_r8,0.50383e-04_r8,0.70309e-04_r8,0.75210e-04_r8,0.21748e-04_r8 /) + kbo(:, 3,21, 4) = (/ & + & 0.72491e-07_r8,0.53581e-04_r8,0.74579e-04_r8,0.80106e-04_r8,0.23442e-04_r8 /) + kbo(:, 4,21, 4) = (/ & + & 0.69929e-07_r8,0.56448e-04_r8,0.78864e-04_r8,0.85108e-04_r8,0.25248e-04_r8 /) + kbo(:, 5,21, 4) = (/ & + & 0.67419e-07_r8,0.59090e-04_r8,0.82932e-04_r8,0.89870e-04_r8,0.27098e-04_r8 /) + kbo(:, 1,22, 4) = (/ & + & 0.63572e-07_r8,0.39426e-04_r8,0.54979e-04_r8,0.58443e-04_r8,0.16913e-04_r8 /) + kbo(:, 2,22, 4) = (/ & + & 0.61166e-07_r8,0.42097e-04_r8,0.58779e-04_r8,0.62933e-04_r8,0.18259e-04_r8 /) + kbo(:, 3,22, 4) = (/ & + & 0.58951e-07_r8,0.44794e-04_r8,0.62330e-04_r8,0.66952e-04_r8,0.19670e-04_r8 /) + kbo(:, 4,22, 4) = (/ & + & 0.56872e-07_r8,0.47147e-04_r8,0.65961e-04_r8,0.71230e-04_r8,0.21221e-04_r8 /) + kbo(:, 5,22, 4) = (/ & + & 0.54822e-07_r8,0.49377e-04_r8,0.69234e-04_r8,0.75038e-04_r8,0.22743e-04_r8 /) + kbo(:, 1,23, 4) = (/ & + & 0.51656e-07_r8,0.32950e-04_r8,0.46052e-04_r8,0.49084e-04_r8,0.14181e-04_r8 /) + kbo(:, 2,23, 4) = (/ & + & 0.49721e-07_r8,0.35250e-04_r8,0.49106e-04_r8,0.52675e-04_r8,0.15330e-04_r8 /) + kbo(:, 3,23, 4) = (/ & + & 0.47930e-07_r8,0.37438e-04_r8,0.52152e-04_r8,0.56097e-04_r8,0.16532e-04_r8 /) + kbo(:, 4,23, 4) = (/ & + & 0.46242e-07_r8,0.39418e-04_r8,0.55160e-04_r8,0.59674e-04_r8,0.17811e-04_r8 /) + kbo(:, 5,23, 4) = (/ & + & 0.44570e-07_r8,0.41280e-04_r8,0.57899e-04_r8,0.62654e-04_r8,0.19100e-04_r8 /) + kbo(:, 1,24, 4) = (/ & + & 0.41962e-07_r8,0.27608e-04_r8,0.38527e-04_r8,0.41167e-04_r8,0.11908e-04_r8 /) + kbo(:, 2,24, 4) = (/ & + & 0.40405e-07_r8,0.29547e-04_r8,0.41099e-04_r8,0.44081e-04_r8,0.12880e-04_r8 /) + kbo(:, 3,24, 4) = (/ & + & 0.38959e-07_r8,0.31321e-04_r8,0.43687e-04_r8,0.47051e-04_r8,0.13912e-04_r8 /) + kbo(:, 4,24, 4) = (/ & + & 0.37583e-07_r8,0.32994e-04_r8,0.46190e-04_r8,0.49890e-04_r8,0.14961e-04_r8 /) + kbo(:, 5,24, 4) = (/ & + & 0.36227e-07_r8,0.34560e-04_r8,0.48473e-04_r8,0.52358e-04_r8,0.16039e-04_r8 /) + kbo(:, 1,25, 4) = (/ & + & 0.34075e-07_r8,0.23153e-04_r8,0.32305e-04_r8,0.34566e-04_r8,0.10014e-04_r8 /) + kbo(:, 2,25, 4) = (/ & + & 0.32822e-07_r8,0.24769e-04_r8,0.34435e-04_r8,0.36968e-04_r8,0.10822e-04_r8 /) + kbo(:, 3,25, 4) = (/ & + & 0.31655e-07_r8,0.26242e-04_r8,0.36635e-04_r8,0.39484e-04_r8,0.11699e-04_r8 /) + kbo(:, 4,25, 4) = (/ & + & 0.30528e-07_r8,0.27624e-04_r8,0.38648e-04_r8,0.41770e-04_r8,0.12588e-04_r8 /) + kbo(:, 5,25, 4) = (/ & + & 0.29434e-07_r8,0.28951e-04_r8,0.40632e-04_r8,0.43774e-04_r8,0.13479e-04_r8 /) + kbo(:, 1,26, 4) = (/ & + & 0.27652e-07_r8,0.19460e-04_r8,0.27114e-04_r8,0.29052e-04_r8,0.84372e-05_r8 /) + kbo(:, 2,26, 4) = (/ & + & 0.26645e-07_r8,0.20785e-04_r8,0.28933e-04_r8,0.31091e-04_r8,0.91305e-05_r8 /) + kbo(:, 3,26, 4) = (/ & + & 0.25703e-07_r8,0.22018e-04_r8,0.30749e-04_r8,0.33173e-04_r8,0.98560e-05_r8 /) + kbo(:, 4,26, 4) = (/ & + & 0.24780e-07_r8,0.23166e-04_r8,0.32405e-04_r8,0.34971e-04_r8,0.10593e-04_r8 /) + kbo(:, 5,26, 4) = (/ & + & 0.23900e-07_r8,0.24286e-04_r8,0.34048e-04_r8,0.36663e-04_r8,0.11346e-04_r8 /) + kbo(:, 1,27, 4) = (/ & + & 0.22439e-07_r8,0.16370e-04_r8,0.22763e-04_r8,0.24397e-04_r8,0.71084e-05_r8 /) + kbo(:, 2,27, 4) = (/ & + & 0.21628e-07_r8,0.17461e-04_r8,0.24318e-04_r8,0.26140e-04_r8,0.76961e-05_r8 /) + kbo(:, 3,27, 4) = (/ & + & 0.20865e-07_r8,0.18493e-04_r8,0.25826e-04_r8,0.27824e-04_r8,0.83080e-05_r8 /) + kbo(:, 4,27, 4) = (/ & + & 0.20113e-07_r8,0.19452e-04_r8,0.27215e-04_r8,0.29287e-04_r8,0.89207e-05_r8 /) + kbo(:, 5,27, 4) = (/ & + & 0.19405e-07_r8,0.20376e-04_r8,0.28543e-04_r8,0.30710e-04_r8,0.95477e-05_r8 /) + kbo(:, 1,28, 4) = (/ & + & 0.18208e-07_r8,0.13777e-04_r8,0.19138e-04_r8,0.20524e-04_r8,0.59952e-05_r8 /) + kbo(:, 2,28, 4) = (/ & + & 0.17555e-07_r8,0.14679e-04_r8,0.20448e-04_r8,0.21996e-04_r8,0.64907e-05_r8 /) + kbo(:, 3,28, 4) = (/ & + & 0.16936e-07_r8,0.15522e-04_r8,0.21661e-04_r8,0.23357e-04_r8,0.69966e-05_r8 /) + kbo(:, 4,28, 4) = (/ & + & 0.16325e-07_r8,0.16334e-04_r8,0.22846e-04_r8,0.24537e-04_r8,0.75124e-05_r8 /) + kbo(:, 5,28, 4) = (/ & + & 0.15755e-07_r8,0.17088e-04_r8,0.23931e-04_r8,0.25722e-04_r8,0.80305e-05_r8 /) + kbo(:, 1,29, 4) = (/ & + & 0.14772e-07_r8,0.11598e-04_r8,0.16117e-04_r8,0.17294e-04_r8,0.50602e-05_r8 /) + kbo(:, 2,29, 4) = (/ & + & 0.14246e-07_r8,0.12346e-04_r8,0.17198e-04_r8,0.18521e-04_r8,0.54799e-05_r8 /) + kbo(:, 3,29, 4) = (/ & + & 0.13739e-07_r8,0.13047e-04_r8,0.18205e-04_r8,0.19566e-04_r8,0.58992e-05_r8 /) + kbo(:, 4,29, 4) = (/ & + & 0.13247e-07_r8,0.13729e-04_r8,0.19173e-04_r8,0.20574e-04_r8,0.63251e-05_r8 /) + kbo(:, 5,29, 4) = (/ & + & 0.12789e-07_r8,0.14341e-04_r8,0.20068e-04_r8,0.21536e-04_r8,0.67496e-05_r8 /) + kbo(:, 1,30, 4) = (/ & + & 0.11984e-07_r8,0.97679e-05_r8,0.13568e-04_r8,0.14565e-04_r8,0.42721e-05_r8 /) + kbo(:, 2,30, 4) = (/ & + & 0.11560e-07_r8,0.10389e-04_r8,0.14461e-04_r8,0.15560e-04_r8,0.46182e-05_r8 /) + kbo(:, 3,30, 4) = (/ & + & 0.11144e-07_r8,0.10973e-04_r8,0.15302e-04_r8,0.16410e-04_r8,0.49715e-05_r8 /) + kbo(:, 4,30, 4) = (/ & + & 0.10750e-07_r8,0.11532e-04_r8,0.16091e-04_r8,0.17244e-04_r8,0.53212e-05_r8 /) + kbo(:, 5,30, 4) = (/ & + & 0.10381e-07_r8,0.12034e-04_r8,0.16821e-04_r8,0.18023e-04_r8,0.56712e-05_r8 /) + kbo(:, 1,31, 4) = (/ & + & 0.97205e-08_r8,0.82296e-05_r8,0.11440e-04_r8,0.12288e-04_r8,0.36079e-05_r8 /) + kbo(:, 2,31, 4) = (/ & + & 0.93777e-08_r8,0.87431e-05_r8,0.12158e-04_r8,0.13067e-04_r8,0.38974e-05_r8 /) + kbo(:, 3,31, 4) = (/ & + & 0.90391e-08_r8,0.92300e-05_r8,0.12862e-04_r8,0.13769e-04_r8,0.41885e-05_r8 /) + kbo(:, 4,31, 4) = (/ & + & 0.87219e-08_r8,0.96854e-05_r8,0.13508e-04_r8,0.14454e-04_r8,0.44756e-05_r8 /) + kbo(:, 5,31, 4) = (/ & + & 0.84251e-08_r8,0.10101e-04_r8,0.14090e-04_r8,0.15064e-04_r8,0.47643e-05_r8 /) + kbo(:, 1,32, 4) = (/ & + & 0.78842e-08_r8,0.69379e-05_r8,0.96378e-05_r8,0.10350e-04_r8,0.30462e-05_r8 /) + kbo(:, 2,32, 4) = (/ & + & 0.76058e-08_r8,0.73605e-05_r8,0.10230e-04_r8,0.10964e-04_r8,0.32879e-05_r8 /) + kbo(:, 3,32, 4) = (/ & + & 0.73312e-08_r8,0.77685e-05_r8,0.10806e-04_r8,0.11552e-04_r8,0.35258e-05_r8 /) + kbo(:, 4,32, 4) = (/ & + & 0.70761e-08_r8,0.81393e-05_r8,0.11329e-04_r8,0.12109e-04_r8,0.37642e-05_r8 /) + kbo(:, 5,32, 4) = (/ & + & 0.68375e-08_r8,0.84723e-05_r8,0.11806e-04_r8,0.12582e-04_r8,0.40027e-05_r8 /) + kbo(:, 1,33, 4) = (/ & + & 0.63946e-08_r8,0.58484e-05_r8,0.81132e-05_r8,0.87138e-05_r8,0.25722e-05_r8 /) + kbo(:, 2,33, 4) = (/ & + & 0.61668e-08_r8,0.61985e-05_r8,0.86152e-05_r8,0.92043e-05_r8,0.27716e-05_r8 /) + kbo(:, 3,33, 4) = (/ & + & 0.59460e-08_r8,0.65329e-05_r8,0.90761e-05_r8,0.96914e-05_r8,0.29672e-05_r8 /) + kbo(:, 4,33, 4) = (/ & + & 0.57410e-08_r8,0.68349e-05_r8,0.94991e-05_r8,0.10128e-04_r8,0.31649e-05_r8 /) + kbo(:, 5,33, 4) = (/ & + & 0.55490e-08_r8,0.71098e-05_r8,0.98972e-05_r8,0.10494e-04_r8,0.33613e-05_r8 /) + kbo(:, 1,34, 4) = (/ & + & 0.51931e-08_r8,0.49155e-05_r8,0.68122e-05_r8,0.73003e-05_r8,0.21648e-05_r8 /) + kbo(:, 2,34, 4) = (/ & + & 0.50066e-08_r8,0.52108e-05_r8,0.72299e-05_r8,0.77128e-05_r8,0.23280e-05_r8 /) + kbo(:, 3,34, 4) = (/ & + & 0.48289e-08_r8,0.54838e-05_r8,0.76076e-05_r8,0.81077e-05_r8,0.24906e-05_r8 /) + kbo(:, 4,34, 4) = (/ & + & 0.46636e-08_r8,0.57271e-05_r8,0.79460e-05_r8,0.84494e-05_r8,0.26534e-05_r8 /) + kbo(:, 5,34, 4) = (/ & + & 0.45089e-08_r8,0.59543e-05_r8,0.82751e-05_r8,0.87422e-05_r8,0.28159e-05_r8 /) + kbo(:, 1,35, 4) = (/ & + & 0.42177e-08_r8,0.41104e-05_r8,0.56914e-05_r8,0.60852e-05_r8,0.18078e-05_r8 /) + kbo(:, 2,35, 4) = (/ & + & 0.40795e-08_r8,0.43580e-05_r8,0.60334e-05_r8,0.64274e-05_r8,0.19421e-05_r8 /) + kbo(:, 3,35, 4) = (/ & + & 0.39353e-08_r8,0.45814e-05_r8,0.63407e-05_r8,0.67443e-05_r8,0.20767e-05_r8 /) + kbo(:, 4,35, 4) = (/ & + & 0.38012e-08_r8,0.47803e-05_r8,0.66196e-05_r8,0.70144e-05_r8,0.22114e-05_r8 /) + kbo(:, 5,35, 4) = (/ & + & 0.36756e-08_r8,0.49682e-05_r8,0.68884e-05_r8,0.72539e-05_r8,0.23458e-05_r8 /) + kbo(:, 1,36, 4) = (/ & + & 0.34162e-08_r8,0.34141e-05_r8,0.47224e-05_r8,0.50412e-05_r8,0.14965e-05_r8 /) + kbo(:, 2,36, 4) = (/ & + & 0.33196e-08_r8,0.36215e-05_r8,0.50037e-05_r8,0.53241e-05_r8,0.16078e-05_r8 /) + kbo(:, 3,36, 4) = (/ & + & 0.32195e-08_r8,0.38064e-05_r8,0.52583e-05_r8,0.55817e-05_r8,0.17188e-05_r8 /) + kbo(:, 4,36, 4) = (/ & + & 0.31099e-08_r8,0.39715e-05_r8,0.54881e-05_r8,0.58006e-05_r8,0.18307e-05_r8 /) + kbo(:, 5,36, 4) = (/ & + & 0.30072e-08_r8,0.41270e-05_r8,0.57065e-05_r8,0.59974e-05_r8,0.19419e-05_r8 /) + kbo(:, 1,37, 4) = (/ & + & 0.28008e-08_r8,0.28094e-05_r8,0.38801e-05_r8,0.41393e-05_r8,0.12248e-05_r8 /) + kbo(:, 2,37, 4) = (/ & + & 0.27121e-08_r8,0.29836e-05_r8,0.41155e-05_r8,0.43748e-05_r8,0.13168e-05_r8 /) + kbo(:, 3,37, 4) = (/ & + & 0.26482e-08_r8,0.31397e-05_r8,0.43282e-05_r8,0.45885e-05_r8,0.14087e-05_r8 /) + kbo(:, 4,37, 4) = (/ & + & 0.25576e-08_r8,0.32779e-05_r8,0.45200e-05_r8,0.47706e-05_r8,0.15013e-05_r8 /) + kbo(:, 5,37, 4) = (/ & + & 0.24727e-08_r8,0.34082e-05_r8,0.47023e-05_r8,0.49354e-05_r8,0.15935e-05_r8 /) + kbo(:, 1,38, 4) = (/ & + & 0.22984e-08_r8,0.23106e-05_r8,0.31856e-05_r8,0.33961e-05_r8,0.10016e-05_r8 /) + kbo(:, 2,38, 4) = (/ & + & 0.22220e-08_r8,0.24563e-05_r8,0.33826e-05_r8,0.35915e-05_r8,0.10776e-05_r8 /) + kbo(:, 3,38, 4) = (/ & + & 0.21588e-08_r8,0.25882e-05_r8,0.35600e-05_r8,0.37696e-05_r8,0.11538e-05_r8 /) + kbo(:, 4,38, 4) = (/ & + & 0.21040e-08_r8,0.27033e-05_r8,0.37199e-05_r8,0.39213e-05_r8,0.12304e-05_r8 /) + kbo(:, 5,38, 4) = (/ & + & 0.20339e-08_r8,0.28122e-05_r8,0.38728e-05_r8,0.40597e-05_r8,0.13067e-05_r8 /) + kbo(:, 1,39, 4) = (/ & + & 0.18867e-08_r8,0.18990e-05_r8,0.26147e-05_r8,0.27855e-05_r8,0.81895e-06_r8 /) + kbo(:, 2,39, 4) = (/ & + & 0.18219e-08_r8,0.20211e-05_r8,0.27789e-05_r8,0.29482e-05_r8,0.88168e-06_r8 /) + kbo(:, 3,39, 4) = (/ & + & 0.17671e-08_r8,0.21324e-05_r8,0.29272e-05_r8,0.30962e-05_r8,0.94475e-06_r8 /) + kbo(:, 4,39, 4) = (/ & + & 0.17201e-08_r8,0.22287e-05_r8,0.30607e-05_r8,0.32231e-05_r8,0.10080e-05_r8 /) + kbo(:, 5,39, 4) = (/ & + & 0.16729e-08_r8,0.23197e-05_r8,0.31885e-05_r8,0.33389e-05_r8,0.10713e-05_r8 /) + kbo(:, 1,40, 4) = (/ & + & 0.15567e-08_r8,0.15486e-05_r8,0.21299e-05_r8,0.22697e-05_r8,0.66418e-06_r8 /) + kbo(:, 2,40, 4) = (/ & + & 0.15030e-08_r8,0.16525e-05_r8,0.22686e-05_r8,0.24063e-05_r8,0.71591e-06_r8 /) + kbo(:, 3,40, 4) = (/ & + & 0.14559e-08_r8,0.17468e-05_r8,0.23938e-05_r8,0.25304e-05_r8,0.76804e-06_r8 /) + kbo(:, 4,40, 4) = (/ & + & 0.14147e-08_r8,0.18284e-05_r8,0.25062e-05_r8,0.26377e-05_r8,0.82053e-06_r8 /) + kbo(:, 5,40, 4) = (/ & + & 0.13808e-08_r8,0.19051e-05_r8,0.26142e-05_r8,0.27362e-05_r8,0.87282e-06_r8 /) + kbo(:, 1,41, 4) = (/ & + & 0.12855e-08_r8,0.12622e-05_r8,0.17326e-05_r8,0.18472e-05_r8,0.53778e-06_r8 /) + kbo(:, 2,41, 4) = (/ & + & 0.12414e-08_r8,0.13486e-05_r8,0.18494e-05_r8,0.19612e-05_r8,0.58062e-06_r8 /) + kbo(:, 3,41, 4) = (/ & + & 0.12006e-08_r8,0.14290e-05_r8,0.19551e-05_r8,0.20665e-05_r8,0.62365e-06_r8 /) + kbo(:, 4,41, 4) = (/ & + & 0.11655e-08_r8,0.14984e-05_r8,0.20506e-05_r8,0.21570e-05_r8,0.66707e-06_r8 /) + kbo(:, 5,41, 4) = (/ & + & 0.11366e-08_r8,0.15630e-05_r8,0.21416e-05_r8,0.22404e-05_r8,0.71035e-06_r8 /) + kbo(:, 1,42, 4) = (/ & + & 0.10616e-08_r8,0.10273e-05_r8,0.14085e-05_r8,0.15034e-05_r8,0.43514e-06_r8 /) + kbo(:, 2,42, 4) = (/ & + & 0.10250e-08_r8,0.10997e-05_r8,0.15070e-05_r8,0.15973e-05_r8,0.47061e-06_r8 /) + kbo(:, 3,42, 4) = (/ & + & 0.99030e-09_r8,0.11679e-05_r8,0.15953e-05_r8,0.16861e-05_r8,0.50613e-06_r8 /) + kbo(:, 4,42, 4) = (/ & + & 0.96062e-09_r8,0.12272e-05_r8,0.16766e-05_r8,0.17642e-05_r8,0.54216e-06_r8 /) + kbo(:, 5,42, 4) = (/ & + & 0.93443e-09_r8,0.12817e-05_r8,0.17529e-05_r8,0.18333e-05_r8,0.57784e-06_r8 /) + kbo(:, 1,43, 4) = (/ & + & 0.87883e-09_r8,0.83199e-06_r8,0.11402e-05_r8,0.12168e-05_r8,0.35025e-06_r8 /) + kbo(:, 2,43, 4) = (/ & + & 0.84829e-09_r8,0.89254e-06_r8,0.12225e-05_r8,0.12958e-05_r8,0.37960e-06_r8 /) + kbo(:, 3,43, 4) = (/ & + & 0.81903e-09_r8,0.95072e-06_r8,0.12966e-05_r8,0.13708e-05_r8,0.40893e-06_r8 /) + kbo(:, 4,43, 4) = (/ & + & 0.79369e-09_r8,0.10020e-05_r8,0.13665e-05_r8,0.14379e-05_r8,0.43862e-06_r8 /) + kbo(:, 5,43, 4) = (/ & + & 0.77108e-09_r8,0.10478e-05_r8,0.14302e-05_r8,0.14962e-05_r8,0.46817e-06_r8 /) + kbo(:, 1,44, 4) = (/ & + & 0.72838e-09_r8,0.67080e-06_r8,0.91962e-06_r8,0.98102e-06_r8,0.28107e-06_r8 /) + kbo(:, 2,44, 4) = (/ & + & 0.70279e-09_r8,0.72271e-06_r8,0.98853e-06_r8,0.10491e-05_r8,0.30540e-06_r8 /) + kbo(:, 3,44, 4) = (/ & + & 0.67858e-09_r8,0.77203e-06_r8,0.10522e-05_r8,0.11122e-05_r8,0.32958e-06_r8 /) + kbo(:, 4,44, 4) = (/ & + & 0.65651e-09_r8,0.81625e-06_r8,0.11115e-05_r8,0.11697e-05_r8,0.35407e-06_r8 /) + kbo(:, 5,44, 4) = (/ & + & 0.63727e-09_r8,0.85495e-06_r8,0.11651e-05_r8,0.12192e-05_r8,0.37850e-06_r8 /) + kbo(:, 1,45, 4) = (/ & + & 0.60379e-09_r8,0.54047e-06_r8,0.74128e-06_r8,0.79100e-06_r8,0.22535e-06_r8 /) + kbo(:, 2,45, 4) = (/ & + & 0.58228e-09_r8,0.58429e-06_r8,0.79854e-06_r8,0.84841e-06_r8,0.24548e-06_r8 /) + kbo(:, 3,45, 4) = (/ & + & 0.56220e-09_r8,0.62606e-06_r8,0.85283e-06_r8,0.90157e-06_r8,0.26541e-06_r8 /) + kbo(:, 4,45, 4) = (/ & + & 0.54320e-09_r8,0.66423e-06_r8,0.90296e-06_r8,0.95015e-06_r8,0.28558e-06_r8 /) + kbo(:, 5,45, 4) = (/ & + & 0.52686e-09_r8,0.69719e-06_r8,0.94830e-06_r8,0.99254e-06_r8,0.30580e-06_r8 /) + kbo(:, 1,46, 4) = (/ & + & 0.50108e-09_r8,0.43361e-06_r8,0.59554e-06_r8,0.63432e-06_r8,0.18023e-06_r8 /) + kbo(:, 2,46, 4) = (/ & + & 0.48291e-09_r8,0.47127e-06_r8,0.64349e-06_r8,0.68510e-06_r8,0.19677e-06_r8 /) + kbo(:, 3,46, 4) = (/ & + & 0.46612e-09_r8,0.50621e-06_r8,0.68942e-06_r8,0.72929e-06_r8,0.21325e-06_r8 /) + kbo(:, 4,46, 4) = (/ & + & 0.45004e-09_r8,0.53903e-06_r8,0.73169e-06_r8,0.77095e-06_r8,0.22986e-06_r8 /) + kbo(:, 5,46, 4) = (/ & + & 0.43600e-09_r8,0.56740e-06_r8,0.77081e-06_r8,0.80714e-06_r8,0.24654e-06_r8 /) + kbo(:, 1,47, 4) = (/ & + & 0.41665e-09_r8,0.34614e-06_r8,0.47565e-06_r8,0.50598e-06_r8,0.14345e-06_r8 /) + kbo(:, 2,47, 4) = (/ & + & 0.40119e-09_r8,0.37779e-06_r8,0.51642e-06_r8,0.55015e-06_r8,0.15697e-06_r8 /) + kbo(:, 3,47, 4) = (/ & + & 0.38702e-09_r8,0.40752e-06_r8,0.55525e-06_r8,0.58759e-06_r8,0.17064e-06_r8 /) + kbo(:, 4,47, 4) = (/ & + & 0.37372e-09_r8,0.43563e-06_r8,0.59076e-06_r8,0.62318e-06_r8,0.18430e-06_r8 /) + kbo(:, 5,47, 4) = (/ & + & 0.36139e-09_r8,0.46041e-06_r8,0.62474e-06_r8,0.65515e-06_r8,0.19800e-06_r8 /) + kbo(:, 1,48, 4) = (/ & + & 0.34658e-09_r8,0.27494e-06_r8,0.37924e-06_r8,0.40349e-06_r8,0.11407e-06_r8 /) + kbo(:, 2,48, 4) = (/ & + & 0.33340e-09_r8,0.30243e-06_r8,0.41340e-06_r8,0.44066e-06_r8,0.12508e-06_r8 /) + kbo(:, 3,48, 4) = (/ & + & 0.32143e-09_r8,0.32756e-06_r8,0.44635e-06_r8,0.47308e-06_r8,0.13636e-06_r8 /) + kbo(:, 4,48, 4) = (/ & + & 0.31032e-09_r8,0.35149e-06_r8,0.47669e-06_r8,0.50309e-06_r8,0.14763e-06_r8 /) + kbo(:, 5,48, 4) = (/ & + & 0.29969e-09_r8,0.37323e-06_r8,0.50542e-06_r8,0.53062e-06_r8,0.15892e-06_r8 /) + kbo(:, 1,49, 4) = (/ & + & 0.28846e-09_r8,0.21778e-06_r8,0.30168e-06_r8,0.32158e-06_r8,0.90607e-07_r8 /) + kbo(:, 2,49, 4) = (/ & + & 0.27716e-09_r8,0.24139e-06_r8,0.33071e-06_r8,0.35214e-06_r8,0.99577e-07_r8 /) + kbo(:, 3,49, 4) = (/ & + & 0.26700e-09_r8,0.26304e-06_r8,0.35804e-06_r8,0.38049e-06_r8,0.10881e-06_r8 /) + kbo(:, 4,49, 4) = (/ & + & 0.25767e-09_r8,0.28313e-06_r8,0.38394e-06_r8,0.40566e-06_r8,0.11814e-06_r8 /) + kbo(:, 5,49, 4) = (/ & + & 0.24875e-09_r8,0.30183e-06_r8,0.40832e-06_r8,0.42906e-06_r8,0.12742e-06_r8 /) + kbo(:, 1,50, 4) = (/ & + & 0.23994e-09_r8,0.17276e-06_r8,0.24039e-06_r8,0.25644e-06_r8,0.72124e-07_r8 /) + kbo(:, 2,50, 4) = (/ & + & 0.23028e-09_r8,0.19275e-06_r8,0.26429e-06_r8,0.28117e-06_r8,0.79388e-07_r8 /) + kbo(:, 3,50, 4) = (/ & + & 0.22162e-09_r8,0.21106e-06_r8,0.28758e-06_r8,0.30606e-06_r8,0.86922e-07_r8 /) + kbo(:, 4,50, 4) = (/ & + & 0.21377e-09_r8,0.22807e-06_r8,0.30947e-06_r8,0.32714e-06_r8,0.94628e-07_r8 /) + kbo(:, 5,50, 4) = (/ & + & 0.20641e-09_r8,0.24400e-06_r8,0.32962e-06_r8,0.34715e-06_r8,0.10228e-06_r8 /) + kbo(:, 1,51, 4) = (/ & + & 0.19960e-09_r8,0.13709e-06_r8,0.19101e-06_r8,0.20407e-06_r8,0.57566e-07_r8 /) + kbo(:, 2,51, 4) = (/ & + & 0.19132e-09_r8,0.15352e-06_r8,0.21120e-06_r8,0.22455e-06_r8,0.63308e-07_r8 /) + kbo(:, 3,51, 4) = (/ & + & 0.18395e-09_r8,0.16924e-06_r8,0.23068e-06_r8,0.24563e-06_r8,0.69421e-07_r8 /) + kbo(:, 4,51, 4) = (/ & + & 0.17732e-09_r8,0.18352e-06_r8,0.24926e-06_r8,0.26383e-06_r8,0.75773e-07_r8 /) + kbo(:, 5,51, 4) = (/ & + & 0.17117e-09_r8,0.19715e-06_r8,0.26630e-06_r8,0.28068e-06_r8,0.82097e-07_r8 /) + kbo(:, 1,52, 4) = (/ & + & 0.16616e-09_r8,0.10852e-06_r8,0.15191e-06_r8,0.16137e-06_r8,0.45975e-07_r8 /) + kbo(:, 2,52, 4) = (/ & + & 0.15901e-09_r8,0.12188e-06_r8,0.16855e-06_r8,0.17943e-06_r8,0.50454e-07_r8 /) + kbo(:, 3,52, 4) = (/ & + & 0.15272e-09_r8,0.13535e-06_r8,0.18502e-06_r8,0.19705e-06_r8,0.55424e-07_r8 /) + kbo(:, 4,52, 4) = (/ & + & 0.14711e-09_r8,0.14765e-06_r8,0.20042e-06_r8,0.21252e-06_r8,0.60616e-07_r8 /) + kbo(:, 5,52, 4) = (/ & + & 0.14194e-09_r8,0.15907e-06_r8,0.21484e-06_r8,0.22673e-06_r8,0.65826e-07_r8 /) + kbo(:, 1,53, 4) = (/ & + & 0.13839e-09_r8,0.85704e-07_r8,0.12023e-06_r8,0.12744e-06_r8,0.36523e-07_r8 /) + kbo(:, 2,53, 4) = (/ & + & 0.13223e-09_r8,0.96600e-07_r8,0.13438e-06_r8,0.14312e-06_r8,0.40152e-07_r8 /) + kbo(:, 3,53, 4) = (/ & + & 0.12684e-09_r8,0.10804e-06_r8,0.14784e-06_r8,0.15735e-06_r8,0.44207e-07_r8 /) + kbo(:, 4,53, 4) = (/ & + & 0.12208e-09_r8,0.11851e-06_r8,0.16093e-06_r8,0.17108e-06_r8,0.48435e-07_r8 /) + kbo(:, 5,53, 4) = (/ & + & 0.11772e-09_r8,0.12811e-06_r8,0.17313e-06_r8,0.18293e-06_r8,0.52733e-07_r8 /) + kbo(:, 1,54, 4) = (/ & + & 0.11516e-09_r8,0.67802e-07_r8,0.95400e-07_r8,0.10065e-06_r8,0.29040e-07_r8 /) + kbo(:, 2,54, 4) = (/ & + & 0.10986e-09_r8,0.76927e-07_r8,0.10712e-06_r8,0.11428e-06_r8,0.32044e-07_r8 /) + kbo(:, 3,54, 4) = (/ & + & 0.10526e-09_r8,0.86295e-07_r8,0.11833e-06_r8,0.12580e-06_r8,0.35335e-07_r8 /) + kbo(:, 4,54, 4) = (/ & + & 0.10122e-09_r8,0.95190e-07_r8,0.12936e-06_r8,0.13763e-06_r8,0.38764e-07_r8 /) + kbo(:, 5,54, 4) = (/ & + & 0.97545e-10_r8,0.10324e-06_r8,0.13969e-06_r8,0.14768e-06_r8,0.42312e-07_r8 /) + kbo(:, 1,55, 4) = (/ & + & 0.95832e-10_r8,0.53610e-07_r8,0.75981e-07_r8,0.79667e-07_r8,0.23117e-07_r8 /) + kbo(:, 2,55, 4) = (/ & + & 0.91281e-10_r8,0.61130e-07_r8,0.85329e-07_r8,0.91005e-07_r8,0.25657e-07_r8 /) + kbo(:, 3,55, 4) = (/ & + & 0.87335e-10_r8,0.68825e-07_r8,0.94736e-07_r8,0.10075e-06_r8,0.28264e-07_r8 /) + kbo(:, 4,55, 4) = (/ & + & 0.83897e-10_r8,0.76435e-07_r8,0.10396e-06_r8,0.11070e-06_r8,0.31057e-07_r8 /) + kbo(:, 5,55, 4) = (/ & + & 0.80810e-10_r8,0.83278e-07_r8,0.11269e-06_r8,0.11928e-06_r8,0.33972e-07_r8 /) + kbo(:, 1,56, 4) = (/ & + & 0.79810e-10_r8,0.42322e-07_r8,0.60374e-07_r8,0.62926e-07_r8,0.18404e-07_r8 /) + kbo(:, 2,56, 4) = (/ & + & 0.75864e-10_r8,0.48559e-07_r8,0.68039e-07_r8,0.72241e-07_r8,0.20548e-07_r8 /) + kbo(:, 3,56, 4) = (/ & + & 0.72485e-10_r8,0.54773e-07_r8,0.75799e-07_r8,0.80757e-07_r8,0.22581e-07_r8 /) + kbo(:, 4,56, 4) = (/ & + & 0.69560e-10_r8,0.61224e-07_r8,0.83554e-07_r8,0.88967e-07_r8,0.24859e-07_r8 /) + kbo(:, 5,56, 4) = (/ & + & 0.66951e-10_r8,0.67084e-07_r8,0.90797e-07_r8,0.96246e-07_r8,0.27245e-07_r8 /) + kbo(:, 1,57, 4) = (/ & + & 0.66524e-10_r8,0.33320e-07_r8,0.47516e-07_r8,0.49541e-07_r8,0.14620e-07_r8 /) + kbo(:, 2,57, 4) = (/ & + & 0.63081e-10_r8,0.38443e-07_r8,0.54027e-07_r8,0.57142e-07_r8,0.16370e-07_r8 /) + kbo(:, 3,57, 4) = (/ & + & 0.60187e-10_r8,0.43587e-07_r8,0.60611e-07_r8,0.64608e-07_r8,0.18036e-07_r8 /) + kbo(:, 4,57, 4) = (/ & + & 0.57689e-10_r8,0.48970e-07_r8,0.66915e-07_r8,0.71233e-07_r8,0.19895e-07_r8 /) + kbo(:, 5,57, 4) = (/ & + & 0.55478e-10_r8,0.53925e-07_r8,0.73045e-07_r8,0.77618e-07_r8,0.21831e-07_r8 /) + kbo(:, 1,58, 4) = (/ & + & 0.55447e-10_r8,0.26240e-07_r8,0.37435e-07_r8,0.38989e-07_r8,0.11606e-07_r8 /) + kbo(:, 2,58, 4) = (/ & + & 0.52442e-10_r8,0.30460e-07_r8,0.42955e-07_r8,0.45233e-07_r8,0.13047e-07_r8 /) + kbo(:, 3,58, 4) = (/ & + & 0.49962e-10_r8,0.34761e-07_r8,0.48418e-07_r8,0.51680e-07_r8,0.14431e-07_r8 /) + kbo(:, 4,58, 4) = (/ & + & 0.47826e-10_r8,0.39152e-07_r8,0.53626e-07_r8,0.57047e-07_r8,0.15934e-07_r8 /) + kbo(:, 5,58, 4) = (/ & + & 0.45954e-10_r8,0.43380e-07_r8,0.58786e-07_r8,0.62538e-07_r8,0.17511e-07_r8 /) + kbo(:, 1,59, 4) = (/ & + & 0.45740e-10_r8,0.21248e-07_r8,0.30261e-07_r8,0.31577e-07_r8,0.94221e-08_r8 /) + kbo(:, 2,59, 4) = (/ & + & 0.43210e-10_r8,0.24730e-07_r8,0.34948e-07_r8,0.36722e-07_r8,0.10608e-07_r8 /) + kbo(:, 3,59, 4) = (/ & + & 0.41141e-10_r8,0.28288e-07_r8,0.39410e-07_r8,0.42052e-07_r8,0.11754e-07_r8 /) + kbo(:, 4,59, 4) = (/ & + & 0.39361e-10_r8,0.31904e-07_r8,0.43740e-07_r8,0.46527e-07_r8,0.12986e-07_r8 /) + kbo(:, 5,59, 4) = (/ & + & 0.37805e-10_r8,0.35442e-07_r8,0.48020e-07_r8,0.51083e-07_r8,0.14278e-07_r8 /) + kbo(:, 1,13, 5) = (/ & + & 0.79045e-05_r8,0.58512e-03_r8,0.80967e-03_r8,0.88578e-03_r8,0.34824e-03_r8 /) + kbo(:, 2,13, 5) = (/ & + & 0.92807e-05_r8,0.61818e-03_r8,0.86083e-03_r8,0.92437e-03_r8,0.37870e-03_r8 /) + kbo(:, 3,13, 5) = (/ & + & 0.10620e-04_r8,0.65025e-03_r8,0.90617e-03_r8,0.96290e-03_r8,0.40639e-03_r8 /) + kbo(:, 4,13, 5) = (/ & + & 0.11847e-04_r8,0.68086e-03_r8,0.94767e-03_r8,0.99815e-03_r8,0.43149e-03_r8 /) + kbo(:, 5,13, 5) = (/ & + & 0.12897e-04_r8,0.70941e-03_r8,0.98426e-03_r8,0.10296e-02_r8,0.45459e-03_r8 /) + kbo(:, 1,14, 5) = (/ & + & 0.65683e-05_r8,0.48798e-03_r8,0.67570e-03_r8,0.73755e-03_r8,0.29172e-03_r8 /) + kbo(:, 2,14, 5) = (/ & + & 0.76957e-05_r8,0.51555e-03_r8,0.71856e-03_r8,0.76978e-03_r8,0.31709e-03_r8 /) + kbo(:, 3,14, 5) = (/ & + & 0.87852e-05_r8,0.54243e-03_r8,0.75604e-03_r8,0.80142e-03_r8,0.34064e-03_r8 /) + kbo(:, 4,14, 5) = (/ & + & 0.97622e-05_r8,0.56817e-03_r8,0.79038e-03_r8,0.83091e-03_r8,0.36095e-03_r8 /) + kbo(:, 5,14, 5) = (/ & + & 0.10614e-04_r8,0.59208e-03_r8,0.82018e-03_r8,0.85691e-03_r8,0.38095e-03_r8 /) + kbo(:, 1,15, 5) = (/ & + & 0.54643e-05_r8,0.40660e-03_r8,0.56371e-03_r8,0.61286e-03_r8,0.24435e-03_r8 /) + kbo(:, 2,15, 5) = (/ & + & 0.63883e-05_r8,0.42973e-03_r8,0.59914e-03_r8,0.64093e-03_r8,0.26475e-03_r8 /) + kbo(:, 3,15, 5) = (/ & + & 0.72593e-05_r8,0.45218e-03_r8,0.63004e-03_r8,0.66659e-03_r8,0.28486e-03_r8 /) + kbo(:, 4,15, 5) = (/ & + & 0.80526e-05_r8,0.47373e-03_r8,0.65847e-03_r8,0.69128e-03_r8,0.30200e-03_r8 /) + kbo(:, 5,15, 5) = (/ & + & 0.87364e-05_r8,0.49393e-03_r8,0.68318e-03_r8,0.71321e-03_r8,0.31930e-03_r8 /) + kbo(:, 1,16, 5) = (/ & + & 0.45482e-05_r8,0.33872e-03_r8,0.47003e-03_r8,0.50920e-03_r8,0.20473e-03_r8 /) + kbo(:, 2,16, 5) = (/ & + & 0.52893e-05_r8,0.35785e-03_r8,0.49898e-03_r8,0.53306e-03_r8,0.22171e-03_r8 /) + kbo(:, 3,16, 5) = (/ & + & 0.59989e-05_r8,0.37673e-03_r8,0.52467e-03_r8,0.55461e-03_r8,0.23803e-03_r8 /) + kbo(:, 4,16, 5) = (/ & + & 0.66426e-05_r8,0.39470e-03_r8,0.54827e-03_r8,0.57515e-03_r8,0.25244e-03_r8 /) + kbo(:, 5,16, 5) = (/ & + & 0.71759e-05_r8,0.41193e-03_r8,0.56909e-03_r8,0.59361e-03_r8,0.26773e-03_r8 /) + kbo(:, 1,17, 5) = (/ & + & 0.37690e-05_r8,0.28177e-03_r8,0.39153e-03_r8,0.42265e-03_r8,0.17155e-03_r8 /) + kbo(:, 2,17, 5) = (/ & + & 0.43790e-05_r8,0.29778e-03_r8,0.41535e-03_r8,0.44288e-03_r8,0.18563e-03_r8 /) + kbo(:, 3,17, 5) = (/ & + & 0.49545e-05_r8,0.31371e-03_r8,0.43664e-03_r8,0.46090e-03_r8,0.19908e-03_r8 /) + kbo(:, 4,17, 5) = (/ & + & 0.54563e-05_r8,0.32886e-03_r8,0.45637e-03_r8,0.47854e-03_r8,0.21097e-03_r8 /) + kbo(:, 5,17, 5) = (/ & + & 0.58879e-05_r8,0.34359e-03_r8,0.47416e-03_r8,0.49387e-03_r8,0.22440e-03_r8 /) + kbo(:, 1,18, 5) = (/ & + & 0.31260e-05_r8,0.23432e-03_r8,0.32596e-03_r8,0.35082e-03_r8,0.14348e-03_r8 /) + kbo(:, 2,18, 5) = (/ & + & 0.36185e-05_r8,0.24786e-03_r8,0.34561e-03_r8,0.36765e-03_r8,0.15546e-03_r8 /) + kbo(:, 3,18, 5) = (/ & + & 0.40732e-05_r8,0.26120e-03_r8,0.36343e-03_r8,0.38325e-03_r8,0.16623e-03_r8 /) + kbo(:, 4,18, 5) = (/ & + & 0.44839e-05_r8,0.27403e-03_r8,0.37997e-03_r8,0.39811e-03_r8,0.17659e-03_r8 /) + kbo(:, 5,18, 5) = (/ & + & 0.48304e-05_r8,0.28674e-03_r8,0.39513e-03_r8,0.41114e-03_r8,0.18813e-03_r8 /) + kbo(:, 1,19, 5) = (/ & + & 0.25853e-05_r8,0.19483e-03_r8,0.27128e-03_r8,0.29126e-03_r8,0.11969e-03_r8 /) + kbo(:, 2,19, 5) = (/ & + & 0.29834e-05_r8,0.20623e-03_r8,0.28749e-03_r8,0.30541e-03_r8,0.12978e-03_r8 /) + kbo(:, 3,19, 5) = (/ & + & 0.33546e-05_r8,0.21750e-03_r8,0.30267e-03_r8,0.31871e-03_r8,0.13874e-03_r8 /) + kbo(:, 4,19, 5) = (/ & + & 0.36863e-05_r8,0.22842e-03_r8,0.31656e-03_r8,0.33115e-03_r8,0.14789e-03_r8 /) + kbo(:, 5,19, 5) = (/ & + & 0.39634e-05_r8,0.23942e-03_r8,0.32944e-03_r8,0.34220e-03_r8,0.15742e-03_r8 /) + kbo(:, 1,20, 5) = (/ & + & 0.21486e-05_r8,0.16221e-03_r8,0.22609e-03_r8,0.24236e-03_r8,0.10014e-03_r8 /) + kbo(:, 2,20, 5) = (/ & + & 0.24735e-05_r8,0.17178e-03_r8,0.23949e-03_r8,0.25399e-03_r8,0.10857e-03_r8 /) + kbo(:, 3,20, 5) = (/ & + & 0.27744e-05_r8,0.18136e-03_r8,0.25226e-03_r8,0.26535e-03_r8,0.11604e-03_r8 /) + kbo(:, 4,20, 5) = (/ & + & 0.30414e-05_r8,0.19076e-03_r8,0.26397e-03_r8,0.27566e-03_r8,0.12398e-03_r8 /) + kbo(:, 5,20, 5) = (/ & + & 0.32610e-05_r8,0.20019e-03_r8,0.27488e-03_r8,0.28510e-03_r8,0.13199e-03_r8 /) + kbo(:, 1,21, 5) = (/ & + & 0.17877e-05_r8,0.13507e-03_r8,0.18845e-03_r8,0.20163e-03_r8,0.83879e-04_r8 /) + kbo(:, 2,21, 5) = (/ & + & 0.20518e-05_r8,0.14319e-03_r8,0.19968e-03_r8,0.21134e-03_r8,0.90858e-04_r8 /) + kbo(:, 3,21, 5) = (/ & + & 0.22953e-05_r8,0.15137e-03_r8,0.21038e-03_r8,0.22094e-03_r8,0.97098e-04_r8 /) + kbo(:, 4,21, 5) = (/ & + & 0.25098e-05_r8,0.15947e-03_r8,0.22019e-03_r8,0.22948e-03_r8,0.10402e-03_r8 /) + kbo(:, 5,21, 5) = (/ & + & 0.26830e-05_r8,0.16749e-03_r8,0.22950e-03_r8,0.23761e-03_r8,0.11069e-03_r8 /) + kbo(:, 1,22, 5) = (/ & + & 0.15022e-05_r8,0.11297e-03_r8,0.15773e-03_r8,0.16819e-03_r8,0.70808e-04_r8 /) + kbo(:, 2,22, 5) = (/ & + & 0.17157e-05_r8,0.11998e-03_r8,0.16714e-03_r8,0.17644e-03_r8,0.76345e-04_r8 /) + kbo(:, 3,22, 5) = (/ & + & 0.19111e-05_r8,0.12690e-03_r8,0.17611e-03_r8,0.18454e-03_r8,0.81804e-04_r8 /) + kbo(:, 4,22, 5) = (/ & + & 0.20812e-05_r8,0.13385e-03_r8,0.18425e-03_r8,0.19164e-03_r8,0.87591e-04_r8 /) + kbo(:, 5,22, 5) = (/ & + & 0.22144e-05_r8,0.14066e-03_r8,0.19235e-03_r8,0.19867e-03_r8,0.93228e-04_r8 /) + kbo(:, 1,23, 5) = (/ & + & 0.12621e-05_r8,0.94681e-04_r8,0.13210e-03_r8,0.14032e-03_r8,0.59630e-04_r8 /) + kbo(:, 2,23, 5) = (/ & + & 0.14346e-05_r8,0.10061e-03_r8,0.14009e-03_r8,0.14751e-03_r8,0.64142e-04_r8 /) + kbo(:, 3,23, 5) = (/ & + & 0.15908e-05_r8,0.10655e-03_r8,0.14749e-03_r8,0.15413e-03_r8,0.68988e-04_r8 /) + kbo(:, 4,23, 5) = (/ & + & 0.17253e-05_r8,0.11246e-03_r8,0.15437e-03_r8,0.16013e-03_r8,0.73893e-04_r8 /) + kbo(:, 5,23, 5) = (/ & + & 0.18272e-05_r8,0.11825e-03_r8,0.16130e-03_r8,0.16627e-03_r8,0.78649e-04_r8 /) + kbo(:, 1,24, 5) = (/ & + & 0.10611e-05_r8,0.79419e-04_r8,0.11079e-03_r8,0.11736e-03_r8,0.50244e-04_r8 /) + kbo(:, 2,24, 5) = (/ & + & 0.11996e-05_r8,0.84486e-04_r8,0.11749e-03_r8,0.12345e-03_r8,0.54054e-04_r8 /) + kbo(:, 3,24, 5) = (/ & + & 0.13241e-05_r8,0.89565e-04_r8,0.12364e-03_r8,0.12883e-03_r8,0.58259e-04_r8 /) + kbo(:, 4,24, 5) = (/ & + & 0.14300e-05_r8,0.94592e-04_r8,0.12949e-03_r8,0.13406e-03_r8,0.62300e-04_r8 /) + kbo(:, 5,24, 5) = (/ & + & 0.15070e-05_r8,0.99545e-04_r8,0.13538e-03_r8,0.13928e-03_r8,0.66485e-04_r8 /) + kbo(:, 1,25, 5) = (/ & + & 0.89248e-06_r8,0.66757e-04_r8,0.93043e-04_r8,0.98269e-04_r8,0.42396e-04_r8 /) + kbo(:, 2,25, 5) = (/ & + & 0.10034e-05_r8,0.71082e-04_r8,0.98652e-04_r8,0.10332e-03_r8,0.45719e-04_r8 /) + kbo(:, 3,25, 5) = (/ & + & 0.11024e-05_r8,0.75404e-04_r8,0.10375e-03_r8,0.10782e-03_r8,0.49228e-04_r8 /) + kbo(:, 4,25, 5) = (/ & + & 0.11835e-05_r8,0.79694e-04_r8,0.10882e-03_r8,0.11234e-03_r8,0.52649e-04_r8 /) + kbo(:, 5,25, 5) = (/ & + & 0.12406e-05_r8,0.83915e-04_r8,0.11376e-03_r8,0.11677e-03_r8,0.56264e-04_r8 /) + kbo(:, 1,26, 5) = (/ & + & 0.75147e-06_r8,0.56248e-04_r8,0.78291e-04_r8,0.82441e-04_r8,0.35781e-04_r8 /) + kbo(:, 2,26, 5) = (/ & + & 0.84025e-06_r8,0.59929e-04_r8,0.82917e-04_r8,0.86562e-04_r8,0.38715e-04_r8 /) + kbo(:, 3,26, 5) = (/ & + & 0.91728e-06_r8,0.63618e-04_r8,0.87231e-04_r8,0.90442e-04_r8,0.41682e-04_r8 /) + kbo(:, 4,26, 5) = (/ & + & 0.97947e-06_r8,0.67285e-04_r8,0.91606e-04_r8,0.94311e-04_r8,0.44610e-04_r8 /) + kbo(:, 5,26, 5) = (/ & + & 0.10222e-05_r8,0.70879e-04_r8,0.95759e-04_r8,0.97954e-04_r8,0.47678e-04_r8 /) + kbo(:, 1,27, 5) = (/ & + & 0.63228e-06_r8,0.47448e-04_r8,0.65926e-04_r8,0.69211e-04_r8,0.30312e-04_r8 /) + kbo(:, 2,27, 5) = (/ & + & 0.70187e-06_r8,0.50583e-04_r8,0.69752e-04_r8,0.72622e-04_r8,0.32844e-04_r8 /) + kbo(:, 3,27, 5) = (/ & + & 0.76263e-06_r8,0.53723e-04_r8,0.73431e-04_r8,0.75943e-04_r8,0.35283e-04_r8 /) + kbo(:, 4,27, 5) = (/ & + & 0.80975e-06_r8,0.56884e-04_r8,0.77139e-04_r8,0.79235e-04_r8,0.37837e-04_r8 /) + kbo(:, 5,27, 5) = (/ & + & 0.84099e-06_r8,0.59937e-04_r8,0.80670e-04_r8,0.82198e-04_r8,0.40398e-04_r8 /) + kbo(:, 1,28, 5) = (/ & + & 0.53062e-06_r8,0.40054e-04_r8,0.55536e-04_r8,0.58105e-04_r8,0.25683e-04_r8 /) + kbo(:, 2,28, 5) = (/ & + & 0.58581e-06_r8,0.42748e-04_r8,0.58719e-04_r8,0.60988e-04_r8,0.27829e-04_r8 /) + kbo(:, 3,28, 5) = (/ & + & 0.63283e-06_r8,0.45445e-04_r8,0.61927e-04_r8,0.63808e-04_r8,0.29914e-04_r8 /) + kbo(:, 4,28, 5) = (/ & + & 0.66841e-06_r8,0.48141e-04_r8,0.65033e-04_r8,0.66567e-04_r8,0.32101e-04_r8 /) + kbo(:, 5,28, 5) = (/ & + & 0.69132e-06_r8,0.50744e-04_r8,0.68002e-04_r8,0.69024e-04_r8,0.34196e-04_r8 /) + kbo(:, 1,29, 5) = (/ & + & 0.44482e-06_r8,0.33876e-04_r8,0.46813e-04_r8,0.48820e-04_r8,0.21822e-04_r8 /) + kbo(:, 2,29, 5) = (/ & + & 0.48830e-06_r8,0.36173e-04_r8,0.49534e-04_r8,0.51267e-04_r8,0.23598e-04_r8 /) + kbo(:, 3,29, 5) = (/ & + & 0.52520e-06_r8,0.38507e-04_r8,0.52264e-04_r8,0.53700e-04_r8,0.25407e-04_r8 /) + kbo(:, 4,29, 5) = (/ & + & 0.55142e-06_r8,0.40790e-04_r8,0.54879e-04_r8,0.55934e-04_r8,0.27233e-04_r8 /) + kbo(:, 5,29, 5) = (/ & + & 0.56821e-06_r8,0.43005e-04_r8,0.57374e-04_r8,0.57995e-04_r8,0.28939e-04_r8 /) + kbo(:, 1,30, 5) = (/ & + & 0.37240e-06_r8,0.28688e-04_r8,0.39498e-04_r8,0.41082e-04_r8,0.18542e-04_r8 /) + kbo(:, 2,30, 5) = (/ & + & 0.40697e-06_r8,0.30662e-04_r8,0.41832e-04_r8,0.43139e-04_r8,0.20037e-04_r8 /) + kbo(:, 3,30, 5) = (/ & + & 0.43518e-06_r8,0.32657e-04_r8,0.44137e-04_r8,0.45198e-04_r8,0.21592e-04_r8 /) + kbo(:, 4,30, 5) = (/ & + & 0.45459e-06_r8,0.34600e-04_r8,0.46342e-04_r8,0.47030e-04_r8,0.23099e-04_r8 /) + kbo(:, 5,30, 5) = (/ & + & 0.46674e-06_r8,0.36468e-04_r8,0.48427e-04_r8,0.48752e-04_r8,0.24524e-04_r8 /) + kbo(:, 1,31, 5) = (/ & + & 0.31167e-06_r8,0.24328e-04_r8,0.33365e-04_r8,0.34577e-04_r8,0.15775e-04_r8 /) + kbo(:, 2,31, 5) = (/ & + & 0.33880e-06_r8,0.26033e-04_r8,0.35376e-04_r8,0.36343e-04_r8,0.17037e-04_r8 /) + kbo(:, 3,31, 5) = (/ & + & 0.36022e-06_r8,0.27728e-04_r8,0.37306e-04_r8,0.38025e-04_r8,0.18334e-04_r8 /) + kbo(:, 4,31, 5) = (/ & + & 0.37443e-06_r8,0.29381e-04_r8,0.39153e-04_r8,0.39551e-04_r8,0.19559e-04_r8 /) + kbo(:, 5,31, 5) = (/ & + & 0.38304e-06_r8,0.30940e-04_r8,0.40888e-04_r8,0.41012e-04_r8,0.20735e-04_r8 /) + kbo(:, 1,32, 5) = (/ & + & 0.26065e-06_r8,0.20666e-04_r8,0.28226e-04_r8,0.29128e-04_r8,0.13403e-04_r8 /) + kbo(:, 2,32, 5) = (/ & + & 0.28179e-06_r8,0.22130e-04_r8,0.29934e-04_r8,0.30642e-04_r8,0.14495e-04_r8 /) + kbo(:, 3,32, 5) = (/ & + & 0.29791e-06_r8,0.23572e-04_r8,0.31554e-04_r8,0.32005e-04_r8,0.15576e-04_r8 /) + kbo(:, 4,32, 5) = (/ & + & 0.30813e-06_r8,0.24963e-04_r8,0.33101e-04_r8,0.33278e-04_r8,0.16582e-04_r8 /) + kbo(:, 5,32, 5) = (/ & + & 0.31412e-06_r8,0.26261e-04_r8,0.34510e-04_r8,0.34497e-04_r8,0.17533e-04_r8 /) + kbo(:, 1,33, 5) = (/ & + & 0.21768e-06_r8,0.17581e-04_r8,0.23903e-04_r8,0.24558e-04_r8,0.11405e-04_r8 /) + kbo(:, 2,33, 5) = (/ & + & 0.23409e-06_r8,0.18827e-04_r8,0.25333e-04_r8,0.25812e-04_r8,0.12331e-04_r8 /) + kbo(:, 3,33, 5) = (/ & + & 0.24596e-06_r8,0.20053e-04_r8,0.26696e-04_r8,0.26942e-04_r8,0.13200e-04_r8 /) + kbo(:, 4,33, 5) = (/ & + & 0.25338e-06_r8,0.21211e-04_r8,0.27978e-04_r8,0.28012e-04_r8,0.14037e-04_r8 /) + kbo(:, 5,33, 5) = (/ & + & 0.25735e-06_r8,0.22292e-04_r8,0.29113e-04_r8,0.29019e-04_r8,0.14789e-04_r8 /) + kbo(:, 1,34, 5) = (/ & + & 0.18111e-06_r8,0.14933e-04_r8,0.20221e-04_r8,0.20691e-04_r8,0.96853e-05_r8 /) + kbo(:, 2,34, 5) = (/ & + & 0.19373e-06_r8,0.15993e-04_r8,0.21413e-04_r8,0.21708e-04_r8,0.10459e-04_r8 /) + kbo(:, 3,34, 5) = (/ & + & 0.20262e-06_r8,0.17025e-04_r8,0.22551e-04_r8,0.22651e-04_r8,0.11170e-04_r8 /) + kbo(:, 4,34, 5) = (/ & + & 0.20802e-06_r8,0.17992e-04_r8,0.23603e-04_r8,0.23540e-04_r8,0.11847e-04_r8 /) + kbo(:, 5,34, 5) = (/ & + & 0.21068e-06_r8,0.18892e-04_r8,0.24522e-04_r8,0.24370e-04_r8,0.12444e-04_r8 /) + kbo(:, 1,35, 5) = (/ & + & 0.14940e-06_r8,0.12604e-04_r8,0.17001e-04_r8,0.17339e-04_r8,0.81630e-05_r8 /) + kbo(:, 2,35, 5) = (/ & + & 0.15934e-06_r8,0.13505e-04_r8,0.18008e-04_r8,0.18183e-04_r8,0.87890e-05_r8 /) + kbo(:, 3,35, 5) = (/ & + & 0.16626e-06_r8,0.14374e-04_r8,0.18963e-04_r8,0.18976e-04_r8,0.93838e-05_r8 /) + kbo(:, 4,35, 5) = (/ & + & 0.17040e-06_r8,0.15187e-04_r8,0.19824e-04_r8,0.19720e-04_r8,0.99229e-05_r8 /) + kbo(:, 5,35, 5) = (/ & + & 0.17229e-06_r8,0.15939e-04_r8,0.20582e-04_r8,0.20394e-04_r8,0.10412e-04_r8 /) + kbo(:, 1,36, 5) = (/ & + & 0.12224e-06_r8,0.10560e-04_r8,0.14203e-04_r8,0.14447e-04_r8,0.68196e-05_r8 /) + kbo(:, 2,36, 5) = (/ & + & 0.13030e-06_r8,0.11326e-04_r8,0.15055e-04_r8,0.15156e-04_r8,0.73321e-05_r8 /) + kbo(:, 3,36, 5) = (/ & + & 0.13590e-06_r8,0.12062e-04_r8,0.15856e-04_r8,0.15823e-04_r8,0.78230e-05_r8 /) + kbo(:, 4,36, 5) = (/ & + & 0.13929e-06_r8,0.12750e-04_r8,0.16573e-04_r8,0.16449e-04_r8,0.82632e-05_r8 /) + kbo(:, 5,36, 5) = (/ & + & 0.14081e-06_r8,0.13384e-04_r8,0.17208e-04_r8,0.17006e-04_r8,0.86656e-05_r8 /) + kbo(:, 1,37, 5) = (/ & + & 0.98979e-07_r8,0.87500e-05_r8,0.11755e-04_r8,0.11943e-04_r8,0.56269e-05_r8 /) + kbo(:, 2,37, 5) = (/ & + & 0.10583e-06_r8,0.94035e-05_r8,0.12480e-04_r8,0.12544e-04_r8,0.60528e-05_r8 /) + kbo(:, 3,37, 5) = (/ & + & 0.11068e-06_r8,0.10031e-04_r8,0.13161e-04_r8,0.13110e-04_r8,0.64604e-05_r8 /) + kbo(:, 4,37, 5) = (/ & + & 0.11365e-06_r8,0.10619e-04_r8,0.13767e-04_r8,0.13642e-04_r8,0.68253e-05_r8 /) + kbo(:, 5,37, 5) = (/ & + & 0.11510e-06_r8,0.11162e-04_r8,0.14306e-04_r8,0.14108e-04_r8,0.71615e-05_r8 /) + kbo(:, 1,38, 5) = (/ & + & 0.80050e-07_r8,0.72436e-05_r8,0.97225e-05_r8,0.98657e-05_r8,0.46375e-05_r8 /) + kbo(:, 2,38, 5) = (/ & + & 0.85886e-07_r8,0.78006e-05_r8,0.10338e-04_r8,0.10378e-04_r8,0.49919e-05_r8 /) + kbo(:, 3,38, 5) = (/ & + & 0.90108e-07_r8,0.83355e-05_r8,0.10916e-04_r8,0.10856e-04_r8,0.53303e-05_r8 /) + kbo(:, 4,38, 5) = (/ & + & 0.92690e-07_r8,0.88380e-05_r8,0.11429e-04_r8,0.11306e-04_r8,0.56349e-05_r8 /) + kbo(:, 5,38, 5) = (/ & + & 0.94046e-07_r8,0.93019e-05_r8,0.11885e-04_r8,0.11696e-04_r8,0.59152e-05_r8 /) + kbo(:, 1,39, 5) = (/ & + & 0.64720e-07_r8,0.59955e-05_r8,0.80389e-05_r8,0.81488e-05_r8,0.38192e-05_r8 /) + kbo(:, 2,39, 5) = (/ & + & 0.69663e-07_r8,0.64699e-05_r8,0.85613e-05_r8,0.85818e-05_r8,0.41159e-05_r8 /) + kbo(:, 3,39, 5) = (/ & + & 0.73305e-07_r8,0.69246e-05_r8,0.90506e-05_r8,0.89861e-05_r8,0.43968e-05_r8 /) + kbo(:, 4,39, 5) = (/ & + & 0.75588e-07_r8,0.73530e-05_r8,0.94857e-05_r8,0.93637e-05_r8,0.46505e-05_r8 /) + kbo(:, 5,39, 5) = (/ & + & 0.76825e-07_r8,0.77492e-05_r8,0.98708e-05_r8,0.96898e-05_r8,0.48841e-05_r8 /) + kbo(:, 1,40, 5) = (/ & + & 0.51871e-07_r8,0.49191e-05_r8,0.65994e-05_r8,0.66890e-05_r8,0.31186e-05_r8 /) + kbo(:, 2,40, 5) = (/ & + & 0.56127e-07_r8,0.53227e-05_r8,0.70435e-05_r8,0.70578e-05_r8,0.33678e-05_r8 /) + kbo(:, 3,40, 5) = (/ & + & 0.59395e-07_r8,0.57124e-05_r8,0.74609e-05_r8,0.74018e-05_r8,0.36025e-05_r8 /) + kbo(:, 4,40, 5) = (/ & + & 0.61501e-07_r8,0.60790e-05_r8,0.78333e-05_r8,0.77210e-05_r8,0.38164e-05_r8 /) + kbo(:, 5,40, 5) = (/ & + & 0.62710e-07_r8,0.64194e-05_r8,0.81613e-05_r8,0.79980e-05_r8,0.40122e-05_r8 /) + kbo(:, 1,41, 5) = (/ & + & 0.41471e-07_r8,0.40276e-05_r8,0.54076e-05_r8,0.54815e-05_r8,0.25402e-05_r8 /) + kbo(:, 2,41, 5) = (/ & + & 0.45127e-07_r8,0.43711e-05_r8,0.57847e-05_r8,0.57971e-05_r8,0.27507e-05_r8 /) + kbo(:, 3,41, 5) = (/ & + & 0.48018e-07_r8,0.47040e-05_r8,0.61407e-05_r8,0.60883e-05_r8,0.29479e-05_r8 /) + kbo(:, 4,41, 5) = (/ & + & 0.49983e-07_r8,0.50177e-05_r8,0.64595e-05_r8,0.63587e-05_r8,0.31286e-05_r8 /) + kbo(:, 5,41, 5) = (/ & + & 0.51153e-07_r8,0.53098e-05_r8,0.67389e-05_r8,0.65950e-05_r8,0.32928e-05_r8 /) + kbo(:, 1,42, 5) = (/ & + & 0.33108e-07_r8,0.32945e-05_r8,0.44261e-05_r8,0.44871e-05_r8,0.20674e-05_r8 /) + kbo(:, 2,42, 5) = (/ & + & 0.36228e-07_r8,0.35861e-05_r8,0.47462e-05_r8,0.47571e-05_r8,0.22452e-05_r8 /) + kbo(:, 3,42, 5) = (/ & + & 0.38776e-07_r8,0.38701e-05_r8,0.50505e-05_r8,0.50046e-05_r8,0.24106e-05_r8 /) + kbo(:, 4,42, 5) = (/ & + & 0.40580e-07_r8,0.41378e-05_r8,0.53219e-05_r8,0.52323e-05_r8,0.25622e-05_r8 /) + kbo(:, 5,42, 5) = (/ & + & 0.41689e-07_r8,0.43881e-05_r8,0.55607e-05_r8,0.54356e-05_r8,0.27015e-05_r8 /) + kbo(:, 1,43, 5) = (/ & + & 0.26243e-07_r8,0.26780e-05_r8,0.36021e-05_r8,0.36578e-05_r8,0.16722e-05_r8 /) + kbo(:, 2,43, 5) = (/ & + & 0.28903e-07_r8,0.29254e-05_r8,0.38754e-05_r8,0.38886e-05_r8,0.18235e-05_r8 /) + kbo(:, 3,43, 5) = (/ & + & 0.31158e-07_r8,0.31674e-05_r8,0.41363e-05_r8,0.40998e-05_r8,0.19628e-05_r8 /) + kbo(:, 4,43, 5) = (/ & + & 0.32828e-07_r8,0.33966e-05_r8,0.43687e-05_r8,0.42935e-05_r8,0.20906e-05_r8 /) + kbo(:, 5,43, 5) = (/ & + & 0.33896e-07_r8,0.36112e-05_r8,0.45745e-05_r8,0.44680e-05_r8,0.22088e-05_r8 /) + kbo(:, 1,44, 5) = (/ & + & 0.20692e-07_r8,0.21688e-05_r8,0.29226e-05_r8,0.29738e-05_r8,0.13486e-05_r8 /) + kbo(:, 2,44, 5) = (/ & + & 0.22961e-07_r8,0.23776e-05_r8,0.31556e-05_r8,0.31699e-05_r8,0.14759e-05_r8 /) + kbo(:, 3,44, 5) = (/ & + & 0.24934e-07_r8,0.25834e-05_r8,0.33779e-05_r8,0.33507e-05_r8,0.15926e-05_r8 /) + kbo(:, 4,44, 5) = (/ & + & 0.26472e-07_r8,0.27800e-05_r8,0.35779e-05_r8,0.35162e-05_r8,0.17017e-05_r8 /) + kbo(:, 5,44, 5) = (/ & + & 0.27504e-07_r8,0.29637e-05_r8,0.37558e-05_r8,0.36666e-05_r8,0.18017e-05_r8 /) + kbo(:, 1,45, 5) = (/ & + & 0.16269e-07_r8,0.17537e-05_r8,0.23672e-05_r8,0.24133e-05_r8,0.10856e-05_r8 /) + kbo(:, 2,45, 5) = (/ & + & 0.18194e-07_r8,0.19291e-05_r8,0.25663e-05_r8,0.25809e-05_r8,0.11927e-05_r8 /) + kbo(:, 3,45, 5) = (/ & + & 0.19903e-07_r8,0.21039e-05_r8,0.27552e-05_r8,0.27360e-05_r8,0.12909e-05_r8 /) + kbo(:, 4,45, 5) = (/ & + & 0.21293e-07_r8,0.22721e-05_r8,0.29270e-05_r8,0.28775e-05_r8,0.13839e-05_r8 /) + kbo(:, 5,45, 5) = (/ & + & 0.22283e-07_r8,0.24292e-05_r8,0.30802e-05_r8,0.30067e-05_r8,0.14686e-05_r8 /) + kbo(:, 1,46, 5) = (/ & + & 0.12712e-07_r8,0.14128e-05_r8,0.19113e-05_r8,0.19548e-05_r8,0.87114e-06_r8 /) + kbo(:, 2,46, 5) = (/ & + & 0.14351e-07_r8,0.15596e-05_r8,0.20802e-05_r8,0.20949e-05_r8,0.96118e-06_r8 /) + kbo(:, 3,46, 5) = (/ & + & 0.15815e-07_r8,0.17076e-05_r8,0.22404e-05_r8,0.22289e-05_r8,0.10436e-05_r8 /) + kbo(:, 4,46, 5) = (/ & + & 0.17062e-07_r8,0.18511e-05_r8,0.23889e-05_r8,0.23492e-05_r8,0.11225e-05_r8 /) + kbo(:, 5,46, 5) = (/ & + & 0.17993e-07_r8,0.19855e-05_r8,0.25206e-05_r8,0.24609e-05_r8,0.11948e-05_r8 /) + kbo(:, 1,47, 5) = (/ & + & 0.98364e-08_r8,0.11306e-05_r8,0.15353e-05_r8,0.15746e-05_r8,0.69554e-06_r8 /) + kbo(:, 2,47, 5) = (/ & + & 0.11226e-07_r8,0.12534e-05_r8,0.16765e-05_r8,0.16944e-05_r8,0.76925e-06_r8 /) + kbo(:, 3,47, 5) = (/ & + & 0.12483e-07_r8,0.13784e-05_r8,0.18130e-05_r8,0.18087e-05_r8,0.84036e-06_r8 /) + kbo(:, 4,47, 5) = (/ & + & 0.13587e-07_r8,0.15007e-05_r8,0.19418e-05_r8,0.19122e-05_r8,0.90712e-06_r8 /) + kbo(:, 5,47, 5) = (/ & + & 0.14457e-07_r8,0.16158e-05_r8,0.20557e-05_r8,0.20073e-05_r8,0.96847e-06_r8 /) + kbo(:, 1,48, 5) = (/ & + & 0.75824e-08_r8,0.90329e-06_r8,0.12307e-05_r8,0.12653e-05_r8,0.55346e-06_r8 /) + kbo(:, 2,48, 5) = (/ & + & 0.87453e-08_r8,0.10050e-05_r8,0.13490e-05_r8,0.13676e-05_r8,0.61470e-06_r8 /) + kbo(:, 3,48, 5) = (/ & + & 0.98194e-08_r8,0.11101e-05_r8,0.14650e-05_r8,0.14651e-05_r8,0.67492e-06_r8 /) + kbo(:, 4,48, 5) = (/ & + & 0.10779e-07_r8,0.12141e-05_r8,0.15756e-05_r8,0.15544e-05_r8,0.73163e-06_r8 /) + kbo(:, 5,48, 5) = (/ & + & 0.11579e-07_r8,0.13125e-05_r8,0.16743e-05_r8,0.16359e-05_r8,0.78405e-06_r8 /) + kbo(:, 1,49, 5) = (/ & + & 0.58219e-08_r8,0.72015e-06_r8,0.98379e-06_r8,0.10143e-05_r8,0.43933e-06_r8 /) + kbo(:, 2,49, 5) = (/ & + & 0.67817e-08_r8,0.80423e-06_r8,0.10832e-05_r8,0.11023e-05_r8,0.49018e-06_r8 /) + kbo(:, 3,49, 5) = (/ & + & 0.76966e-08_r8,0.89205e-06_r8,0.11819e-05_r8,0.11846e-05_r8,0.54131e-06_r8 /) + kbo(:, 4,49, 5) = (/ & + & 0.85224e-08_r8,0.98005e-06_r8,0.12760e-05_r8,0.12617e-05_r8,0.58858e-06_r8 /) + kbo(:, 5,49, 5) = (/ & + & 0.92350e-08_r8,0.10644e-05_r8,0.13615e-05_r8,0.13319e-05_r8,0.63358e-06_r8 /) + kbo(:, 1,50, 5) = (/ & + & 0.44790e-08_r8,0.57418e-06_r8,0.78635e-06_r8,0.81296e-06_r8,0.34881e-06_r8 /) + kbo(:, 2,50, 5) = (/ & + & 0.52579e-08_r8,0.64388e-06_r8,0.87056e-06_r8,0.88896e-06_r8,0.39135e-06_r8 /) + kbo(:, 3,50, 5) = (/ & + & 0.60279e-08_r8,0.71722e-06_r8,0.95348e-06_r8,0.95809e-06_r8,0.43444e-06_r8 /) + kbo(:, 4,50, 5) = (/ & + & 0.67324e-08_r8,0.79134e-06_r8,0.10331e-05_r8,0.10243e-05_r8,0.47391e-06_r8 /) + kbo(:, 5,50, 5) = (/ & + & 0.73551e-08_r8,0.86330e-06_r8,0.11073e-05_r8,0.10842e-05_r8,0.51234e-06_r8 /) + kbo(:, 1,51, 5) = (/ & + & 0.34450e-08_r8,0.45753e-06_r8,0.62814e-06_r8,0.65158e-06_r8,0.27625e-06_r8 /) + kbo(:, 2,51, 5) = (/ & + & 0.40690e-08_r8,0.51530e-06_r8,0.69892e-06_r8,0.71555e-06_r8,0.31260e-06_r8 /) + kbo(:, 3,51, 5) = (/ & + & 0.47087e-08_r8,0.57624e-06_r8,0.76840e-06_r8,0.77477e-06_r8,0.34804e-06_r8 /) + kbo(:, 4,51, 5) = (/ & + & 0.53086e-08_r8,0.63843e-06_r8,0.83580e-06_r8,0.83092e-06_r8,0.38181e-06_r8 /) + kbo(:, 5,51, 5) = (/ & + & 0.58439e-08_r8,0.69956e-06_r8,0.89962e-06_r8,0.88225e-06_r8,0.41412e-06_r8 /) + kbo(:, 1,52, 5) = (/ & + & 0.26454e-08_r8,0.36387e-06_r8,0.50007e-06_r8,0.52179e-06_r8,0.21894e-06_r8 /) + kbo(:, 2,52, 5) = (/ & + & 0.31403e-08_r8,0.41173e-06_r8,0.55997e-06_r8,0.57479e-06_r8,0.24870e-06_r8 /) + kbo(:, 3,52, 5) = (/ & + & 0.36655e-08_r8,0.46211e-06_r8,0.61819e-06_r8,0.62511e-06_r8,0.27840e-06_r8 /) + kbo(:, 4,52, 5) = (/ & + & 0.41730e-08_r8,0.51415e-06_r8,0.67546e-06_r8,0.67307e-06_r8,0.30695e-06_r8 /) + kbo(:, 5,52, 5) = (/ & + & 0.46311e-08_r8,0.56582e-06_r8,0.72973e-06_r8,0.71697e-06_r8,0.33407e-06_r8 /) + kbo(:, 1,53, 5) = (/ & + & 0.20275e-08_r8,0.28873e-06_r8,0.39749e-06_r8,0.41647e-06_r8,0.17355e-06_r8 /) + kbo(:, 2,53, 5) = (/ & + & 0.24190e-08_r8,0.32821e-06_r8,0.44730e-06_r8,0.46063e-06_r8,0.19774e-06_r8 /) + kbo(:, 3,53, 5) = (/ & + & 0.28440e-08_r8,0.36981e-06_r8,0.49677e-06_r8,0.50411e-06_r8,0.22218e-06_r8 /) + kbo(:, 4,53, 5) = (/ & + & 0.32690e-08_r8,0.41315e-06_r8,0.54488e-06_r8,0.54408e-06_r8,0.24647e-06_r8 /) + kbo(:, 5,53, 5) = (/ & + & 0.36592e-08_r8,0.45680e-06_r8,0.59090e-06_r8,0.58189e-06_r8,0.26902e-06_r8 /) + kbo(:, 1,54, 5) = (/ & + & 0.15611e-08_r8,0.22962e-06_r8,0.31613e-06_r8,0.33300e-06_r8,0.13730e-06_r8 /) + kbo(:, 2,54, 5) = (/ & + & 0.18696e-08_r8,0.26187e-06_r8,0.35802e-06_r8,0.36954e-06_r8,0.15701e-06_r8 /) + kbo(:, 3,54, 5) = (/ & + & 0.22100e-08_r8,0.29641e-06_r8,0.39970e-06_r8,0.40683e-06_r8,0.17764e-06_r8 /) + kbo(:, 4,54, 5) = (/ & + & 0.25619e-08_r8,0.33255e-06_r8,0.44009e-06_r8,0.44063e-06_r8,0.19808e-06_r8 /) + kbo(:, 5,54, 5) = (/ & + & 0.28928e-08_r8,0.36908e-06_r8,0.47892e-06_r8,0.47270e-06_r8,0.21696e-06_r8 /) + kbo(:, 1,55, 5) = (/ & + & 0.12041e-08_r8,0.18259e-06_r8,0.25108e-06_r8,0.26608e-06_r8,0.10842e-06_r8 /) + kbo(:, 2,55, 5) = (/ & + & 0.14466e-08_r8,0.20918e-06_r8,0.28633e-06_r8,0.29677e-06_r8,0.12468e-06_r8 /) + kbo(:, 3,55, 5) = (/ & + & 0.17176e-08_r8,0.23765e-06_r8,0.32139e-06_r8,0.32799e-06_r8,0.14213e-06_r8 /) + kbo(:, 4,55, 5) = (/ & + & 0.20058e-08_r8,0.26766e-06_r8,0.35523e-06_r8,0.35664e-06_r8,0.15907e-06_r8 /) + kbo(:, 5,55, 5) = (/ & + & 0.22852e-08_r8,0.29818e-06_r8,0.38806e-06_r8,0.38381e-06_r8,0.17512e-06_r8 /) + kbo(:, 1,56, 5) = (/ & + & 0.92934e-09_r8,0.14496e-06_r8,0.19887e-06_r8,0.21215e-06_r8,0.85185e-07_r8 /) + kbo(:, 2,56, 5) = (/ & + & 0.11180e-08_r8,0.16668e-06_r8,0.22841e-06_r8,0.23799e-06_r8,0.99172e-07_r8 /) + kbo(:, 3,56, 5) = (/ & + & 0.13333e-08_r8,0.19024e-06_r8,0.25790e-06_r8,0.26385e-06_r8,0.11331e-06_r8 /) + kbo(:, 4,56, 5) = (/ & + & 0.15668e-08_r8,0.21512e-06_r8,0.28626e-06_r8,0.28820e-06_r8,0.12758e-06_r8 /) + kbo(:, 5,56, 5) = (/ & + & 0.18000e-08_r8,0.24055e-06_r8,0.31405e-06_r8,0.31134e-06_r8,0.14106e-06_r8 /) + kbo(:, 1,57, 5) = (/ & + & 0.71747e-09_r8,0.11491e-06_r8,0.15760e-06_r8,0.16907e-06_r8,0.66762e-07_r8 /) + kbo(:, 2,57, 5) = (/ & + & 0.86318e-09_r8,0.13266e-06_r8,0.18198e-06_r8,0.19051e-06_r8,0.78844e-07_r8 /) + kbo(:, 3,57, 5) = (/ & + & 0.10332e-08_r8,0.15199e-06_r8,0.20646e-06_r8,0.21185e-06_r8,0.90317e-07_r8 /) + kbo(:, 4,57, 5) = (/ & + & 0.12205e-08_r8,0.17255e-06_r8,0.23049e-06_r8,0.23280e-06_r8,0.10211e-06_r8 /) + kbo(:, 5,57, 5) = (/ & + & 0.14137e-08_r8,0.19374e-06_r8,0.25377e-06_r8,0.25209e-06_r8,0.11347e-06_r8 /) + kbo(:, 1,58, 5) = (/ & + & 0.55534e-09_r8,0.91161e-07_r8,0.12495e-06_r8,0.13481e-06_r8,0.52524e-07_r8 /) + kbo(:, 2,58, 5) = (/ & + & 0.66796e-09_r8,0.10564e-06_r8,0.14490e-06_r8,0.15246e-06_r8,0.62491e-07_r8 /) + kbo(:, 3,58, 5) = (/ & + & 0.80208e-09_r8,0.12142e-06_r8,0.16540e-06_r8,0.17013e-06_r8,0.71923e-07_r8 /) + kbo(:, 4,58, 5) = (/ & + & 0.95155e-09_r8,0.13846e-06_r8,0.18562e-06_r8,0.18803e-06_r8,0.81760e-07_r8 /) + kbo(:, 5,58, 5) = (/ & + & 0.11100e-08_r8,0.15608e-06_r8,0.20513e-06_r8,0.20425e-06_r8,0.91405e-07_r8 /) + kbo(:, 1,59, 5) = (/ & + & 0.44483e-09_r8,0.74201e-07_r8,0.10175e-06_r8,0.10986e-06_r8,0.42626e-07_r8 /) + kbo(:, 2,59, 5) = (/ & + & 0.53478e-09_r8,0.86257e-07_r8,0.11818e-06_r8,0.12453e-06_r8,0.50816e-07_r8 /) + kbo(:, 3,59, 5) = (/ & + & 0.64265e-09_r8,0.99390e-07_r8,0.13535e-06_r8,0.13928e-06_r8,0.58658e-07_r8 /) + kbo(:, 4,59, 5) = (/ & + & 0.76369e-09_r8,0.11360e-06_r8,0.15224e-06_r8,0.15417e-06_r8,0.66845e-07_r8 /) + kbo(:, 5,59, 5) = (/ & + & 0.89316e-09_r8,0.12826e-06_r8,0.16850e-06_r8,0.16775e-06_r8,0.74841e-07_r8 /) + kbo(:, 1,13, 6) = (/ & + & 0.15452e-03_r8,0.17471e-02_r8,0.22870e-02_r8,0.22757e-02_r8,0.11868e-02_r8 /) + kbo(:, 2,13, 6) = (/ & + & 0.17358e-03_r8,0.18337e-02_r8,0.23752e-02_r8,0.23549e-02_r8,0.12492e-02_r8 /) + kbo(:, 3,13, 6) = (/ & + & 0.19043e-03_r8,0.19070e-02_r8,0.24479e-02_r8,0.24255e-02_r8,0.13114e-02_r8 /) + kbo(:, 4,13, 6) = (/ & + & 0.20459e-03_r8,0.19702e-02_r8,0.25109e-02_r8,0.24905e-02_r8,0.13717e-02_r8 /) + kbo(:, 5,13, 6) = (/ & + & 0.21621e-03_r8,0.20266e-02_r8,0.25653e-02_r8,0.25512e-02_r8,0.14320e-02_r8 /) + kbo(:, 1,14, 6) = (/ & + & 0.12793e-03_r8,0.14662e-02_r8,0.19141e-02_r8,0.19032e-02_r8,0.99404e-03_r8 /) + kbo(:, 2,14, 6) = (/ & + & 0.14335e-03_r8,0.15367e-02_r8,0.19852e-02_r8,0.19691e-02_r8,0.10462e-02_r8 /) + kbo(:, 3,14, 6) = (/ & + & 0.15698e-03_r8,0.15974e-02_r8,0.20454e-02_r8,0.20285e-02_r8,0.10986e-02_r8 /) + kbo(:, 4,14, 6) = (/ & + & 0.16837e-03_r8,0.16505e-02_r8,0.20982e-02_r8,0.20828e-02_r8,0.11509e-02_r8 /) + kbo(:, 5,14, 6) = (/ & + & 0.17765e-03_r8,0.16990e-02_r8,0.21452e-02_r8,0.21357e-02_r8,0.12020e-02_r8 /) + kbo(:, 1,15, 6) = (/ & + & 0.10600e-03_r8,0.12280e-02_r8,0.15987e-02_r8,0.15899e-02_r8,0.83160e-03_r8 /) + kbo(:, 2,15, 6) = (/ & + & 0.11846e-03_r8,0.12858e-02_r8,0.16570e-02_r8,0.16438e-02_r8,0.87641e-03_r8 /) + kbo(:, 3,15, 6) = (/ & + & 0.12947e-03_r8,0.13362e-02_r8,0.17073e-02_r8,0.16937e-02_r8,0.92037e-03_r8 /) + kbo(:, 4,15, 6) = (/ & + & 0.13860e-03_r8,0.13818e-02_r8,0.17519e-02_r8,0.17401e-02_r8,0.96514e-03_r8 /) + kbo(:, 5,15, 6) = (/ & + & 0.14605e-03_r8,0.14231e-02_r8,0.17922e-02_r8,0.17849e-02_r8,0.10088e-02_r8 /) + kbo(:, 1,16, 6) = (/ & + & 0.87844e-04_r8,0.10268e-02_r8,0.13337e-02_r8,0.13258e-02_r8,0.69471e-03_r8 /) + kbo(:, 2,16, 6) = (/ & + & 0.97921e-04_r8,0.10747e-02_r8,0.13816e-02_r8,0.13704e-02_r8,0.73309e-03_r8 /) + kbo(:, 3,16, 6) = (/ & + & 0.10678e-03_r8,0.11173e-02_r8,0.14240e-02_r8,0.14122e-02_r8,0.77126e-03_r8 /) + kbo(:, 4,16, 6) = (/ & + & 0.11410e-03_r8,0.11561e-02_r8,0.14619e-02_r8,0.14525e-02_r8,0.80983e-03_r8 /) + kbo(:, 5,16, 6) = (/ & + & 0.12008e-03_r8,0.11913e-02_r8,0.14957e-02_r8,0.14904e-02_r8,0.84685e-03_r8 /) + kbo(:, 1,17, 6) = (/ & + & 0.72736e-04_r8,0.85770e-03_r8,0.11110e-02_r8,0.11043e-02_r8,0.57988e-03_r8 /) + kbo(:, 2,17, 6) = (/ & + & 0.80870e-04_r8,0.89737e-03_r8,0.11508e-02_r8,0.11412e-02_r8,0.61310e-03_r8 /) + kbo(:, 3,17, 6) = (/ & + & 0.87984e-04_r8,0.93334e-03_r8,0.11865e-02_r8,0.11769e-02_r8,0.64563e-03_r8 /) + kbo(:, 4,17, 6) = (/ & + & 0.93900e-04_r8,0.96637e-03_r8,0.12188e-02_r8,0.12115e-02_r8,0.67946e-03_r8 /) + kbo(:, 5,17, 6) = (/ & + & 0.98669e-04_r8,0.99682e-03_r8,0.12477e-02_r8,0.12444e-02_r8,0.71129e-03_r8 /) + kbo(:, 1,18, 6) = (/ & + & 0.60196e-04_r8,0.71585e-03_r8,0.92484e-03_r8,0.91885e-03_r8,0.48428e-03_r8 /) + kbo(:, 2,18, 6) = (/ & + & 0.66759e-04_r8,0.74902e-03_r8,0.95806e-03_r8,0.95007e-03_r8,0.51254e-03_r8 /) + kbo(:, 3,18, 6) = (/ & + & 0.72486e-04_r8,0.77936e-03_r8,0.98828e-03_r8,0.98036e-03_r8,0.54118e-03_r8 /) + kbo(:, 4,18, 6) = (/ & + & 0.77210e-04_r8,0.80757e-03_r8,0.10157e-02_r8,0.10101e-02_r8,0.56995e-03_r8 /) + kbo(:, 5,18, 6) = (/ & + & 0.81046e-04_r8,0.83344e-03_r8,0.10405e-02_r8,0.10390e-02_r8,0.59762e-03_r8 /) + kbo(:, 1,19, 6) = (/ & + & 0.49797e-04_r8,0.59714e-03_r8,0.76951e-03_r8,0.76408e-03_r8,0.40487e-03_r8 /) + kbo(:, 2,19, 6) = (/ & + & 0.55098e-04_r8,0.62505e-03_r8,0.79728e-03_r8,0.79071e-03_r8,0.42904e-03_r8 /) + kbo(:, 3,19, 6) = (/ & + & 0.59690e-04_r8,0.65071e-03_r8,0.82294e-03_r8,0.81671e-03_r8,0.45375e-03_r8 /) + kbo(:, 4,19, 6) = (/ & + & 0.63457e-04_r8,0.67490e-03_r8,0.84635e-03_r8,0.84245e-03_r8,0.47833e-03_r8 /) + kbo(:, 5,19, 6) = (/ & + & 0.66538e-04_r8,0.69683e-03_r8,0.86805e-03_r8,0.86812e-03_r8,0.50238e-03_r8 /) + kbo(:, 1,20, 6) = (/ & + & 0.41277e-04_r8,0.49854e-03_r8,0.64043e-03_r8,0.63582e-03_r8,0.33885e-03_r8 /) + kbo(:, 2,20, 6) = (/ & + & 0.45557e-04_r8,0.52197e-03_r8,0.66408e-03_r8,0.65859e-03_r8,0.35960e-03_r8 /) + kbo(:, 3,20, 6) = (/ & + & 0.49226e-04_r8,0.54380e-03_r8,0.68582e-03_r8,0.68111e-03_r8,0.38108e-03_r8 /) + kbo(:, 4,20, 6) = (/ & + & 0.52238e-04_r8,0.56442e-03_r8,0.70598e-03_r8,0.70364e-03_r8,0.40199e-03_r8 /) + kbo(:, 5,20, 6) = (/ & + & 0.54694e-04_r8,0.58320e-03_r8,0.72504e-03_r8,0.72645e-03_r8,0.42282e-03_r8 /) + kbo(:, 1,21, 6) = (/ & + & 0.34218e-04_r8,0.41624e-03_r8,0.53312e-03_r8,0.52912e-03_r8,0.28376e-03_r8 /) + kbo(:, 2,21, 6) = (/ & + & 0.37670e-04_r8,0.43597e-03_r8,0.55316e-03_r8,0.54893e-03_r8,0.30161e-03_r8 /) + kbo(:, 3,21, 6) = (/ & + & 0.40602e-04_r8,0.45467e-03_r8,0.57178e-03_r8,0.56861e-03_r8,0.32023e-03_r8 /) + kbo(:, 4,21, 6) = (/ & + & 0.43009e-04_r8,0.47220e-03_r8,0.58931e-03_r8,0.58850e-03_r8,0.33805e-03_r8 /) + kbo(:, 5,21, 6) = (/ & + & 0.44968e-04_r8,0.48850e-03_r8,0.60624e-03_r8,0.60867e-03_r8,0.35633e-03_r8 /) + kbo(:, 1,22, 6) = (/ & + & 0.28554e-04_r8,0.34872e-03_r8,0.44519e-03_r8,0.44203e-03_r8,0.23865e-03_r8 /) + kbo(:, 2,22, 6) = (/ & + & 0.31312e-04_r8,0.36543e-03_r8,0.46215e-03_r8,0.45896e-03_r8,0.25429e-03_r8 /) + kbo(:, 3,22, 6) = (/ & + & 0.33623e-04_r8,0.38136e-03_r8,0.47808e-03_r8,0.47625e-03_r8,0.27020e-03_r8 /) + kbo(:, 4,22, 6) = (/ & + & 0.35518e-04_r8,0.39638e-03_r8,0.49352e-03_r8,0.49393e-03_r8,0.28567e-03_r8 /) + kbo(:, 5,22, 6) = (/ & + & 0.37060e-04_r8,0.41046e-03_r8,0.50833e-03_r8,0.51152e-03_r8,0.30169e-03_r8 /) + kbo(:, 1,23, 6) = (/ & + & 0.23825e-04_r8,0.29241e-03_r8,0.37202e-03_r8,0.36957e-03_r8,0.20120e-03_r8 /) + kbo(:, 2,23, 6) = (/ & + & 0.26019e-04_r8,0.30664e-03_r8,0.38650e-03_r8,0.38433e-03_r8,0.21484e-03_r8 /) + kbo(:, 3,23, 6) = (/ & + & 0.27840e-04_r8,0.32027e-03_r8,0.40038e-03_r8,0.39957e-03_r8,0.22829e-03_r8 /) + kbo(:, 4,23, 6) = (/ & + & 0.29329e-04_r8,0.33317e-03_r8,0.41396e-03_r8,0.41498e-03_r8,0.24169e-03_r8 /) + kbo(:, 5,23, 6) = (/ & + & 0.30542e-04_r8,0.34547e-03_r8,0.42681e-03_r8,0.43048e-03_r8,0.25568e-03_r8 /) + kbo(:, 1,24, 6) = (/ & + & 0.19879e-04_r8,0.24552e-03_r8,0.31135e-03_r8,0.30936e-03_r8,0.16986e-03_r8 /) + kbo(:, 2,24, 6) = (/ & + & 0.21617e-04_r8,0.25767e-03_r8,0.32376e-03_r8,0.32228e-03_r8,0.18173e-03_r8 /) + kbo(:, 3,24, 6) = (/ & + & 0.23050e-04_r8,0.26937e-03_r8,0.33590e-03_r8,0.33579e-03_r8,0.19320e-03_r8 /) + kbo(:, 4,24, 6) = (/ & + & 0.24217e-04_r8,0.28054e-03_r8,0.34772e-03_r8,0.34922e-03_r8,0.20501e-03_r8 /) + kbo(:, 5,24, 6) = (/ & + & 0.25164e-04_r8,0.29121e-03_r8,0.35883e-03_r8,0.36286e-03_r8,0.21708e-03_r8 /) + kbo(:, 1,25, 6) = (/ & + & 0.16589e-04_r8,0.20645e-03_r8,0.26087e-03_r8,0.25944e-03_r8,0.14369e-03_r8 /) + kbo(:, 2,25, 6) = (/ & + & 0.17961e-04_r8,0.21688e-03_r8,0.27162e-03_r8,0.27083e-03_r8,0.15386e-03_r8 /) + kbo(:, 3,25, 6) = (/ & + & 0.19083e-04_r8,0.22697e-03_r8,0.28229e-03_r8,0.28258e-03_r8,0.16383e-03_r8 /) + kbo(:, 4,25, 6) = (/ & + & 0.19998e-04_r8,0.23668e-03_r8,0.29245e-03_r8,0.29438e-03_r8,0.17418e-03_r8 /) + kbo(:, 5,25, 6) = (/ & + & 0.20737e-04_r8,0.24589e-03_r8,0.30216e-03_r8,0.30647e-03_r8,0.18465e-03_r8 /) + kbo(:, 1,26, 6) = (/ & + & 0.13858e-04_r8,0.17402e-03_r8,0.21906e-03_r8,0.21804e-03_r8,0.12205e-03_r8 /) + kbo(:, 2,26, 6) = (/ & + & 0.14930e-04_r8,0.18300e-03_r8,0.22843e-03_r8,0.22813e-03_r8,0.13065e-03_r8 /) + kbo(:, 3,26, 6) = (/ & + & 0.15807e-04_r8,0.19174e-03_r8,0.23770e-03_r8,0.23830e-03_r8,0.13933e-03_r8 /) + kbo(:, 4,26, 6) = (/ & + & 0.16522e-04_r8,0.20010e-03_r8,0.24640e-03_r8,0.24876e-03_r8,0.14837e-03_r8 /) + kbo(:, 5,26, 6) = (/ & + & 0.17090e-04_r8,0.20798e-03_r8,0.25500e-03_r8,0.25943e-03_r8,0.15748e-03_r8 /) + kbo(:, 1,27, 6) = (/ & + & 0.11565e-04_r8,0.14689e-03_r8,0.18423e-03_r8,0.18358e-03_r8,0.10372e-03_r8 /) + kbo(:, 2,27, 6) = (/ & + & 0.12404e-04_r8,0.15466e-03_r8,0.19242e-03_r8,0.19242e-03_r8,0.11104e-03_r8 /) + kbo(:, 3,27, 6) = (/ & + & 0.13088e-04_r8,0.16225e-03_r8,0.20035e-03_r8,0.20136e-03_r8,0.11877e-03_r8 /) + kbo(:, 4,27, 6) = (/ & + & 0.13644e-04_r8,0.16938e-03_r8,0.20793e-03_r8,0.21054e-03_r8,0.12658e-03_r8 /) + kbo(:, 5,27, 6) = (/ & + & 0.14079e-04_r8,0.17614e-03_r8,0.21553e-03_r8,0.22004e-03_r8,0.13455e-03_r8 /) + kbo(:, 1,28, 6) = (/ & + & 0.96429e-05_r8,0.12422e-03_r8,0.15518e-03_r8,0.15486e-03_r8,0.88240e-04_r8 /) + kbo(:, 2,28, 6) = (/ & + & 0.10297e-04_r8,0.13093e-03_r8,0.16229e-03_r8,0.16255e-03_r8,0.94664e-04_r8 /) + kbo(:, 3,28, 6) = (/ & + & 0.10829e-04_r8,0.13744e-03_r8,0.16911e-03_r8,0.17043e-03_r8,0.10137e-03_r8 /) + kbo(:, 4,28, 6) = (/ & + & 0.11263e-04_r8,0.14355e-03_r8,0.17577e-03_r8,0.17861e-03_r8,0.10818e-03_r8 /) + kbo(:, 5,28, 6) = (/ & + & 0.11593e-04_r8,0.14936e-03_r8,0.18245e-03_r8,0.18698e-03_r8,0.11517e-03_r8 /) + kbo(:, 1,29, 6) = (/ & + & 0.80357e-05_r8,0.10525e-03_r8,0.13098e-03_r8,0.13087e-03_r8,0.75199e-04_r8 /) + kbo(:, 2,29, 6) = (/ & + & 0.85457e-05_r8,0.11106e-03_r8,0.13709e-03_r8,0.13756e-03_r8,0.80877e-04_r8 /) + kbo(:, 3,29, 6) = (/ & + & 0.89585e-05_r8,0.11659e-03_r8,0.14298e-03_r8,0.14458e-03_r8,0.86703e-04_r8 /) + kbo(:, 4,29, 6) = (/ & + & 0.92936e-05_r8,0.12185e-03_r8,0.14887e-03_r8,0.15184e-03_r8,0.92679e-04_r8 /) + kbo(:, 5,29, 6) = (/ & + & 0.95413e-05_r8,0.12685e-03_r8,0.15476e-03_r8,0.15926e-03_r8,0.98770e-04_r8 /) + kbo(:, 1,30, 6) = (/ & + & 0.66891e-05_r8,0.89326e-04_r8,0.11070e-03_r8,0.11075e-03_r8,0.64254e-04_r8 /) + kbo(:, 2,30, 6) = (/ & + & 0.70855e-05_r8,0.94280e-04_r8,0.11595e-03_r8,0.11668e-03_r8,0.69215e-04_r8 /) + kbo(:, 3,30, 6) = (/ & + & 0.74068e-05_r8,0.99029e-04_r8,0.12112e-03_r8,0.12290e-03_r8,0.74278e-04_r8 /) + kbo(:, 4,30, 6) = (/ & + & 0.76634e-05_r8,0.10356e-03_r8,0.12631e-03_r8,0.12933e-03_r8,0.79489e-04_r8 /) + kbo(:, 5,30, 6) = (/ & + & 0.78499e-05_r8,0.10785e-03_r8,0.13152e-03_r8,0.13588e-03_r8,0.84762e-04_r8 /) + kbo(:, 1,31, 6) = (/ & + & 0.55647e-05_r8,0.75943e-04_r8,0.93695e-04_r8,0.93906e-04_r8,0.55002e-04_r8 /) + kbo(:, 2,31, 6) = (/ & + & 0.58719e-05_r8,0.80167e-04_r8,0.98229e-04_r8,0.99204e-04_r8,0.59329e-04_r8 /) + kbo(:, 3,31, 6) = (/ & + & 0.61212e-05_r8,0.84249e-04_r8,0.10281e-03_r8,0.10471e-03_r8,0.63778e-04_r8 /) + kbo(:, 4,31, 6) = (/ & + & 0.63162e-05_r8,0.88122e-04_r8,0.10738e-03_r8,0.11041e-03_r8,0.68318e-04_r8 /) + kbo(:, 5,31, 6) = (/ & + & 0.64553e-05_r8,0.91835e-04_r8,0.11204e-03_r8,0.11614e-03_r8,0.72907e-04_r8 /) + kbo(:, 1,32, 6) = (/ & + & 0.46246e-05_r8,0.64633e-04_r8,0.79398e-04_r8,0.79831e-04_r8,0.47190e-04_r8 /) + kbo(:, 2,32, 6) = (/ & + & 0.48628e-05_r8,0.68258e-04_r8,0.83383e-04_r8,0.84521e-04_r8,0.50953e-04_r8 /) + kbo(:, 3,32, 6) = (/ & + & 0.50557e-05_r8,0.71758e-04_r8,0.87418e-04_r8,0.89417e-04_r8,0.54823e-04_r8 /) + kbo(:, 4,32, 6) = (/ & + & 0.52035e-05_r8,0.75099e-04_r8,0.91481e-04_r8,0.94423e-04_r8,0.58785e-04_r8 /) + kbo(:, 5,32, 6) = (/ & + & 0.53068e-05_r8,0.78317e-04_r8,0.95646e-04_r8,0.99452e-04_r8,0.62766e-04_r8 /) + kbo(:, 1,33, 6) = (/ & + & 0.38403e-05_r8,0.55077e-04_r8,0.67410e-04_r8,0.68024e-04_r8,0.40538e-04_r8 /) + kbo(:, 2,33, 6) = (/ & + & 0.40244e-05_r8,0.58199e-04_r8,0.70924e-04_r8,0.72180e-04_r8,0.43839e-04_r8 /) + kbo(:, 3,33, 6) = (/ & + & 0.41730e-05_r8,0.61206e-04_r8,0.74475e-04_r8,0.76502e-04_r8,0.47222e-04_r8 /) + kbo(:, 4,33, 6) = (/ & + & 0.42835e-05_r8,0.64091e-04_r8,0.78114e-04_r8,0.80883e-04_r8,0.50652e-04_r8 /) + kbo(:, 5,33, 6) = (/ & + & 0.43604e-05_r8,0.66898e-04_r8,0.81798e-04_r8,0.85293e-04_r8,0.54102e-04_r8 /) + kbo(:, 1,34, 6) = (/ & + & 0.31801e-05_r8,0.46888e-04_r8,0.57233e-04_r8,0.57945e-04_r8,0.34781e-04_r8 /) + kbo(:, 2,34, 6) = (/ & + & 0.33244e-05_r8,0.49586e-04_r8,0.60319e-04_r8,0.61625e-04_r8,0.37646e-04_r8 /) + kbo(:, 3,34, 6) = (/ & + & 0.34389e-05_r8,0.52183e-04_r8,0.63465e-04_r8,0.65422e-04_r8,0.40606e-04_r8 /) + kbo(:, 4,34, 6) = (/ & + & 0.35228e-05_r8,0.54696e-04_r8,0.66697e-04_r8,0.69266e-04_r8,0.43571e-04_r8 /) + kbo(:, 5,34, 6) = (/ & + & 0.35804e-05_r8,0.57162e-04_r8,0.69964e-04_r8,0.73120e-04_r8,0.46562e-04_r8 /) + kbo(:, 1,35, 6) = (/ & + & 0.26200e-05_r8,0.39742e-04_r8,0.48410e-04_r8,0.49141e-04_r8,0.29639e-04_r8 /) + kbo(:, 2,35, 6) = (/ & + & 0.27351e-05_r8,0.42075e-04_r8,0.51122e-04_r8,0.52382e-04_r8,0.32146e-04_r8 /) + kbo(:, 3,35, 6) = (/ & + & 0.28253e-05_r8,0.44325e-04_r8,0.53916e-04_r8,0.55698e-04_r8,0.34701e-04_r8 /) + kbo(:, 4,35, 6) = (/ & + & 0.28907e-05_r8,0.46530e-04_r8,0.56769e-04_r8,0.59068e-04_r8,0.37280e-04_r8 /) + kbo(:, 5,35, 6) = (/ & + & 0.29354e-05_r8,0.48707e-04_r8,0.59649e-04_r8,0.62461e-04_r8,0.39864e-04_r8 /) + kbo(:, 1,36, 6) = (/ & + & 0.21469e-05_r8,0.33498e-04_r8,0.40744e-04_r8,0.41427e-04_r8,0.25045e-04_r8 /) + kbo(:, 2,36, 6) = (/ & + & 0.22407e-05_r8,0.35513e-04_r8,0.43124e-04_r8,0.44262e-04_r8,0.27227e-04_r8 /) + kbo(:, 3,36, 6) = (/ & + & 0.23140e-05_r8,0.37481e-04_r8,0.45588e-04_r8,0.47157e-04_r8,0.29433e-04_r8 /) + kbo(:, 4,36, 6) = (/ & + & 0.23673e-05_r8,0.39419e-04_r8,0.48109e-04_r8,0.50107e-04_r8,0.31672e-04_r8 /) + kbo(:, 5,36, 6) = (/ & + & 0.24035e-05_r8,0.41345e-04_r8,0.50640e-04_r8,0.53089e-04_r8,0.33911e-04_r8 /) + kbo(:, 1,37, 6) = (/ & + & 0.17464e-05_r8,0.27984e-04_r8,0.34007e-04_r8,0.34584e-04_r8,0.20899e-04_r8 /) + kbo(:, 2,37, 6) = (/ & + & 0.18252e-05_r8,0.29737e-04_r8,0.36088e-04_r8,0.37051e-04_r8,0.22785e-04_r8 /) + kbo(:, 3,37, 6) = (/ & + & 0.18877e-05_r8,0.31460e-04_r8,0.38247e-04_r8,0.39573e-04_r8,0.24687e-04_r8 /) + kbo(:, 4,37, 6) = (/ & + & 0.19333e-05_r8,0.33165e-04_r8,0.40460e-04_r8,0.42146e-04_r8,0.26626e-04_r8 /) + kbo(:, 5,37, 6) = (/ & + & 0.19647e-05_r8,0.34869e-04_r8,0.42691e-04_r8,0.44765e-04_r8,0.28561e-04_r8 /) + kbo(:, 1,38, 6) = (/ & + & 0.14198e-05_r8,0.23364e-04_r8,0.28367e-04_r8,0.28854e-04_r8,0.17422e-04_r8 /) + kbo(:, 2,38, 6) = (/ & + & 0.14862e-05_r8,0.24892e-04_r8,0.30186e-04_r8,0.30994e-04_r8,0.19047e-04_r8 /) + kbo(:, 3,38, 6) = (/ & + & 0.15394e-05_r8,0.26399e-04_r8,0.32076e-04_r8,0.33192e-04_r8,0.20688e-04_r8 /) + kbo(:, 4,38, 6) = (/ & + & 0.15786e-05_r8,0.27898e-04_r8,0.34020e-04_r8,0.35441e-04_r8,0.22360e-04_r8 /) + kbo(:, 5,38, 6) = (/ & + & 0.16058e-05_r8,0.29401e-04_r8,0.35983e-04_r8,0.37735e-04_r8,0.24033e-04_r8 /) + kbo(:, 1,39, 6) = (/ & + & 0.11541e-05_r8,0.19509e-04_r8,0.23663e-04_r8,0.24072e-04_r8,0.14521e-04_r8 /) + kbo(:, 2,39, 6) = (/ & + & 0.12100e-05_r8,0.20837e-04_r8,0.25252e-04_r8,0.25929e-04_r8,0.15915e-04_r8 /) + kbo(:, 3,39, 6) = (/ & + & 0.12551e-05_r8,0.22155e-04_r8,0.26902e-04_r8,0.27842e-04_r8,0.17331e-04_r8 /) + kbo(:, 4,39, 6) = (/ & + & 0.12888e-05_r8,0.23470e-04_r8,0.28603e-04_r8,0.29806e-04_r8,0.18773e-04_r8 /) + kbo(:, 5,39, 6) = (/ & + & 0.13123e-05_r8,0.24794e-04_r8,0.30331e-04_r8,0.31815e-04_r8,0.20216e-04_r8 /) + kbo(:, 1,40, 6) = (/ & + & 0.93244e-06_r8,0.16171e-04_r8,0.19599e-04_r8,0.19918e-04_r8,0.11977e-04_r8 /) + kbo(:, 2,40, 6) = (/ & + & 0.98059e-06_r8,0.17324e-04_r8,0.20976e-04_r8,0.21519e-04_r8,0.13169e-04_r8 /) + kbo(:, 3,40, 6) = (/ & + & 0.10196e-05_r8,0.18475e-04_r8,0.22411e-04_r8,0.23178e-04_r8,0.14387e-04_r8 /) + kbo(:, 4,40, 6) = (/ & + & 0.10496e-05_r8,0.19626e-04_r8,0.23897e-04_r8,0.24887e-04_r8,0.15625e-04_r8 /) + kbo(:, 5,40, 6) = (/ & + & 0.10706e-05_r8,0.20792e-04_r8,0.25411e-04_r8,0.26641e-04_r8,0.16871e-04_r8 /) + kbo(:, 1,41, 6) = (/ & + & 0.75206e-06_r8,0.13381e-04_r8,0.16204e-04_r8,0.16448e-04_r8,0.98582e-05_r8 /) + kbo(:, 2,41, 6) = (/ & + & 0.79368e-06_r8,0.14380e-04_r8,0.17395e-04_r8,0.17824e-04_r8,0.10873e-04_r8 /) + kbo(:, 3,41, 6) = (/ & + & 0.82742e-06_r8,0.15382e-04_r8,0.18640e-04_r8,0.19259e-04_r8,0.11916e-04_r8 /) + kbo(:, 4,41, 6) = (/ & + & 0.85390e-06_r8,0.16388e-04_r8,0.19935e-04_r8,0.20745e-04_r8,0.12979e-04_r8 /) + kbo(:, 5,41, 6) = (/ & + & 0.87281e-06_r8,0.17412e-04_r8,0.21261e-04_r8,0.22271e-04_r8,0.14053e-04_r8 /) + kbo(:, 1,42, 6) = (/ & + & 0.60591e-06_r8,0.11061e-04_r8,0.13385e-04_r8,0.13568e-04_r8,0.81045e-05_r8 /) + kbo(:, 2,42, 6) = (/ & + & 0.64182e-06_r8,0.11926e-04_r8,0.14412e-04_r8,0.14751e-04_r8,0.89661e-05_r8 /) + kbo(:, 3,42, 6) = (/ & + & 0.67101e-06_r8,0.12797e-04_r8,0.15489e-04_r8,0.15987e-04_r8,0.98578e-05_r8 /) + kbo(:, 4,42, 6) = (/ & + & 0.69427e-06_r8,0.13675e-04_r8,0.16616e-04_r8,0.17274e-04_r8,0.10770e-04_r8 /) + kbo(:, 5,42, 6) = (/ & + & 0.71122e-06_r8,0.14573e-04_r8,0.17774e-04_r8,0.18601e-04_r8,0.11690e-04_r8 /) + kbo(:, 1,43, 6) = (/ & + & 0.48565e-06_r8,0.90929e-05_r8,0.10998e-04_r8,0.11127e-04_r8,0.66136e-05_r8 /) + kbo(:, 2,43, 6) = (/ & + & 0.51703e-06_r8,0.98401e-05_r8,0.11878e-04_r8,0.12136e-04_r8,0.73431e-05_r8 /) + kbo(:, 3,43, 6) = (/ & + & 0.54246e-06_r8,0.10594e-04_r8,0.12807e-04_r8,0.13197e-04_r8,0.81019e-05_r8 /) + kbo(:, 4,43, 6) = (/ & + & 0.56309e-06_r8,0.11359e-04_r8,0.13782e-04_r8,0.14306e-04_r8,0.88812e-05_r8 /) + kbo(:, 5,43, 6) = (/ & + & 0.57854e-06_r8,0.12144e-04_r8,0.14791e-04_r8,0.15456e-04_r8,0.96685e-05_r8 /) + kbo(:, 1,44, 6) = (/ & + & 0.38777e-06_r8,0.74478e-05_r8,0.90062e-05_r8,0.90921e-05_r8,0.53709e-05_r8 /) + kbo(:, 2,44, 6) = (/ & + & 0.41522e-06_r8,0.80919e-05_r8,0.97570e-05_r8,0.99478e-05_r8,0.59889e-05_r8 /) + kbo(:, 3,44, 6) = (/ & + & 0.43761e-06_r8,0.87433e-05_r8,0.10555e-04_r8,0.10856e-04_r8,0.66332e-05_r8 /) + kbo(:, 4,44, 6) = (/ & + & 0.45584e-06_r8,0.94063e-05_r8,0.11395e-04_r8,0.11808e-04_r8,0.72955e-05_r8 /) + kbo(:, 5,44, 6) = (/ & + & 0.46990e-06_r8,0.10091e-04_r8,0.12269e-04_r8,0.12799e-04_r8,0.79696e-05_r8 /) + kbo(:, 1,45, 6) = (/ & + & 0.30888e-06_r8,0.60898e-05_r8,0.73632e-05_r8,0.74181e-05_r8,0.43535e-05_r8 /) + kbo(:, 2,45, 6) = (/ & + & 0.33291e-06_r8,0.66440e-05_r8,0.80023e-05_r8,0.81416e-05_r8,0.48741e-05_r8 /) + kbo(:, 3,45, 6) = (/ & + & 0.35255e-06_r8,0.72052e-05_r8,0.86855e-05_r8,0.89154e-05_r8,0.54207e-05_r8 /) + kbo(:, 4,45, 6) = (/ & + & 0.36854e-06_r8,0.77787e-05_r8,0.94068e-05_r8,0.97308e-05_r8,0.59833e-05_r8 /) + kbo(:, 5,45, 6) = (/ & + & 0.38125e-06_r8,0.83745e-05_r8,0.10163e-04_r8,0.10583e-04_r8,0.65578e-05_r8 /) + kbo(:, 1,46, 6) = (/ & + & 0.24494e-06_r8,0.49598e-05_r8,0.59987e-05_r8,0.60289e-05_r8,0.35123e-05_r8 /) + kbo(:, 2,46, 6) = (/ & + & 0.26595e-06_r8,0.54355e-05_r8,0.65411e-05_r8,0.66383e-05_r8,0.39494e-05_r8 /) + kbo(:, 3,46, 6) = (/ & + & 0.28328e-06_r8,0.59173e-05_r8,0.71233e-05_r8,0.72943e-05_r8,0.44113e-05_r8 /) + kbo(:, 4,46, 6) = (/ & + & 0.29735e-06_r8,0.64123e-05_r8,0.77406e-05_r8,0.79904e-05_r8,0.48883e-05_r8 /) + kbo(:, 5,46, 6) = (/ & + & 0.30876e-06_r8,0.69283e-05_r8,0.83913e-05_r8,0.87211e-05_r8,0.53766e-05_r8 /) + kbo(:, 1,47, 6) = (/ & + & 0.19287e-06_r8,0.40134e-05_r8,0.48586e-05_r8,0.48718e-05_r8,0.28114e-05_r8 /) + kbo(:, 2,47, 6) = (/ & + & 0.21123e-06_r8,0.44208e-05_r8,0.53178e-05_r8,0.53794e-05_r8,0.31781e-05_r8 /) + kbo(:, 3,47, 6) = (/ & + & 0.22658e-06_r8,0.48332e-05_r8,0.58104e-05_r8,0.59335e-05_r8,0.35646e-05_r8 /) + kbo(:, 4,47, 6) = (/ & + & 0.23912e-06_r8,0.52582e-05_r8,0.63354e-05_r8,0.65230e-05_r8,0.39676e-05_r8 /) + kbo(:, 5,47, 6) = (/ & + & 0.24931e-06_r8,0.57025e-05_r8,0.68920e-05_r8,0.71458e-05_r8,0.43826e-05_r8 /) + kbo(:, 1,48, 6) = (/ & + & 0.15132e-06_r8,0.32395e-05_r8,0.39269e-05_r8,0.39289e-05_r8,0.22458e-05_r8 /) + kbo(:, 2,48, 6) = (/ & + & 0.16716e-06_r8,0.35866e-05_r8,0.43144e-05_r8,0.43511e-05_r8,0.25512e-05_r8 /) + kbo(:, 3,48, 6) = (/ & + & 0.18076e-06_r8,0.39391e-05_r8,0.47294e-05_r8,0.48161e-05_r8,0.28746e-05_r8 /) + kbo(:, 4,48, 6) = (/ & + & 0.19194e-06_r8,0.43030e-05_r8,0.51748e-05_r8,0.53142e-05_r8,0.32135e-05_r8 /) + kbo(:, 5,48, 6) = (/ & + & 0.20099e-06_r8,0.46842e-05_r8,0.56488e-05_r8,0.58430e-05_r8,0.35644e-05_r8 /) + kbo(:, 1,49, 6) = (/ & + & 0.11828e-06_r8,0.26078e-05_r8,0.31672e-05_r8,0.31617e-05_r8,0.17894e-05_r8 /) + kbo(:, 2,49, 6) = (/ & + & 0.13185e-06_r8,0.29029e-05_r8,0.34929e-05_r8,0.35125e-05_r8,0.20423e-05_r8 /) + kbo(:, 3,49, 6) = (/ & + & 0.14378e-06_r8,0.32030e-05_r8,0.38409e-05_r8,0.39000e-05_r8,0.23121e-05_r8 /) + kbo(:, 4,49, 6) = (/ & + & 0.15369e-06_r8,0.35139e-05_r8,0.42179e-05_r8,0.43198e-05_r8,0.25971e-05_r8 /) + kbo(:, 5,49, 6) = (/ & + & 0.16176e-06_r8,0.38391e-05_r8,0.46198e-05_r8,0.47667e-05_r8,0.28929e-05_r8 /) + kbo(:, 1,50, 6) = (/ & + & 0.92362e-07_r8,0.20997e-05_r8,0.25556e-05_r8,0.25471e-05_r8,0.14267e-05_r8 /) + kbo(:, 2,50, 6) = (/ & + & 0.10390e-06_r8,0.23496e-05_r8,0.28286e-05_r8,0.28368e-05_r8,0.16356e-05_r8 /) + kbo(:, 3,50, 6) = (/ & + & 0.11421e-06_r8,0.26049e-05_r8,0.31213e-05_r8,0.31606e-05_r8,0.18609e-05_r8 /) + kbo(:, 4,50, 6) = (/ & + & 0.12297e-06_r8,0.28694e-05_r8,0.34392e-05_r8,0.35125e-05_r8,0.20996e-05_r8 /) + kbo(:, 5,50, 6) = (/ & + & 0.13012e-06_r8,0.31471e-05_r8,0.37794e-05_r8,0.38900e-05_r8,0.23486e-05_r8 /) + kbo(:, 1,51, 6) = (/ & + & 0.72029e-07_r8,0.16879e-05_r8,0.20606e-05_r8,0.20506e-05_r8,0.11365e-05_r8 /) + kbo(:, 2,51, 6) = (/ & + & 0.81717e-07_r8,0.18994e-05_r8,0.22886e-05_r8,0.22902e-05_r8,0.13081e-05_r8 /) + kbo(:, 3,51, 6) = (/ & + & 0.90547e-07_r8,0.21162e-05_r8,0.25347e-05_r8,0.25588e-05_r8,0.14964e-05_r8 /) + kbo(:, 4,51, 6) = (/ & + & 0.98231e-07_r8,0.23407e-05_r8,0.28017e-05_r8,0.28537e-05_r8,0.16958e-05_r8 /) + kbo(:, 5,51, 6) = (/ & + & 0.10454e-06_r8,0.25770e-05_r8,0.30891e-05_r8,0.31719e-05_r8,0.19053e-05_r8 /) + kbo(:, 1,52, 6) = (/ & + & 0.55994e-07_r8,0.13535e-05_r8,0.16583e-05_r8,0.16483e-05_r8,0.90215e-06_r8 /) + kbo(:, 2,52, 6) = (/ & + & 0.64065e-07_r8,0.15318e-05_r8,0.18483e-05_r8,0.18452e-05_r8,0.10447e-05_r8 /) + kbo(:, 3,52, 6) = (/ & + & 0.71601e-07_r8,0.17156e-05_r8,0.20541e-05_r8,0.20679e-05_r8,0.12005e-05_r8 /) + kbo(:, 4,52, 6) = (/ & + & 0.78265e-07_r8,0.19055e-05_r8,0.22786e-05_r8,0.23151e-05_r8,0.13673e-05_r8 /) + kbo(:, 5,52, 6) = (/ & + & 0.83827e-07_r8,0.21062e-05_r8,0.25201e-05_r8,0.25812e-05_r8,0.15426e-05_r8 /) + kbo(:, 1,53, 6) = (/ & + & 0.43376e-07_r8,0.10823e-05_r8,0.13316e-05_r8,0.13229e-05_r8,0.71387e-06_r8 /) + kbo(:, 2,53, 6) = (/ & + & 0.50078e-07_r8,0.12320e-05_r8,0.14898e-05_r8,0.14843e-05_r8,0.83196e-06_r8 /) + kbo(:, 3,53, 6) = (/ & + & 0.56440e-07_r8,0.13873e-05_r8,0.16612e-05_r8,0.16678e-05_r8,0.96085e-06_r8 /) + kbo(:, 4,53, 6) = (/ & + & 0.62188e-07_r8,0.15481e-05_r8,0.18489e-05_r8,0.18736e-05_r8,0.10995e-05_r8 /) + kbo(:, 5,53, 6) = (/ & + & 0.67072e-07_r8,0.17179e-05_r8,0.20520e-05_r8,0.20964e-05_r8,0.12465e-05_r8 /) + kbo(:, 1,54, 6) = (/ & + & 0.33662e-07_r8,0.86685e-06_r8,0.10712e-05_r8,0.10638e-05_r8,0.56675e-06_r8 /) + kbo(:, 2,54, 6) = (/ & + & 0.39188e-07_r8,0.99237e-06_r8,0.12024e-05_r8,0.11965e-05_r8,0.66407e-06_r8 /) + kbo(:, 3,54, 6) = (/ & + & 0.44517e-07_r8,0.11234e-05_r8,0.13453e-05_r8,0.13477e-05_r8,0.77015e-06_r8 /) + kbo(:, 4,54, 6) = (/ & + & 0.49410e-07_r8,0.12591e-05_r8,0.15022e-05_r8,0.15186e-05_r8,0.88568e-06_r8 /) + kbo(:, 5,54, 6) = (/ & + & 0.53662e-07_r8,0.14028e-05_r8,0.16732e-05_r8,0.17054e-05_r8,0.10088e-05_r8 /) + kbo(:, 1,55, 6) = (/ & + & 0.26107e-07_r8,0.69409e-06_r8,0.86148e-06_r8,0.85535e-06_r8,0.44993e-06_r8 /) + kbo(:, 2,55, 6) = (/ & + & 0.30648e-07_r8,0.79874e-06_r8,0.97050e-06_r8,0.96432e-06_r8,0.52987e-06_r8 /) + kbo(:, 3,55, 6) = (/ & + & 0.35070e-07_r8,0.90919e-06_r8,0.10893e-05_r8,0.10889e-05_r8,0.61727e-06_r8 /) + kbo(:, 4,55, 6) = (/ & + & 0.39223e-07_r8,0.10237e-05_r8,0.12206e-05_r8,0.12308e-05_r8,0.71345e-06_r8 /) + kbo(:, 5,55, 6) = (/ & + & 0.42897e-07_r8,0.11450e-05_r8,0.13641e-05_r8,0.13878e-05_r8,0.81614e-06_r8 /) + kbo(:, 1,56, 6) = (/ & + & 0.20183e-07_r8,0.55461e-06_r8,0.69187e-06_r8,0.68686e-06_r8,0.35634e-06_r8 /) + kbo(:, 2,56, 6) = (/ & + & 0.23906e-07_r8,0.64143e-06_r8,0.78193e-06_r8,0.77615e-06_r8,0.42133e-06_r8 /) + kbo(:, 3,56, 6) = (/ & + & 0.27573e-07_r8,0.73422e-06_r8,0.88059e-06_r8,0.87848e-06_r8,0.49387e-06_r8 /) + kbo(:, 4,56, 6) = (/ & + & 0.31066e-07_r8,0.83083e-06_r8,0.99001e-06_r8,0.99604e-06_r8,0.57362e-06_r8 /) + kbo(:, 5,56, 6) = (/ & + & 0.34213e-07_r8,0.93302e-06_r8,0.11103e-05_r8,0.11271e-05_r8,0.65906e-06_r8 /) + kbo(:, 1,57, 6) = (/ & + & 0.15553e-07_r8,0.44221e-06_r8,0.55475e-06_r8,0.55051e-06_r8,0.28158e-06_r8 /) + kbo(:, 2,57, 6) = (/ & + & 0.18597e-07_r8,0.51387e-06_r8,0.62883e-06_r8,0.62381e-06_r8,0.33432e-06_r8 /) + kbo(:, 3,57, 6) = (/ & + & 0.21627e-07_r8,0.59165e-06_r8,0.71079e-06_r8,0.70768e-06_r8,0.39423e-06_r8 /) + kbo(:, 4,57, 6) = (/ & + & 0.24548e-07_r8,0.67286e-06_r8,0.80159e-06_r8,0.80451e-06_r8,0.46009e-06_r8 /) + kbo(:, 5,57, 6) = (/ & + & 0.27223e-07_r8,0.75870e-06_r8,0.90196e-06_r8,0.91372e-06_r8,0.53126e-06_r8 /) + kbo(:, 1,58, 6) = (/ & + & 0.11989e-07_r8,0.35271e-06_r8,0.44504e-06_r8,0.44164e-06_r8,0.22247e-06_r8 /) + kbo(:, 2,58, 6) = (/ & + & 0.14473e-07_r8,0.41167e-06_r8,0.50593e-06_r8,0.50179e-06_r8,0.26557e-06_r8 /) + kbo(:, 3,58, 6) = (/ & + & 0.16959e-07_r8,0.47681e-06_r8,0.57389e-06_r8,0.57055e-06_r8,0.31488e-06_r8 /) + kbo(:, 4,58, 6) = (/ & + & 0.19386e-07_r8,0.54503e-06_r8,0.64933e-06_r8,0.65043e-06_r8,0.36927e-06_r8 /) + kbo(:, 5,58, 6) = (/ & + & 0.21655e-07_r8,0.61705e-06_r8,0.73285e-06_r8,0.74092e-06_r8,0.42823e-06_r8 /) + kbo(:, 1,59, 6) = (/ & + & 0.95745e-08_r8,0.28909e-06_r8,0.36504e-06_r8,0.36221e-06_r8,0.18143e-06_r8 /) + kbo(:, 2,59, 6) = (/ & + & 0.11602e-07_r8,0.33869e-06_r8,0.41625e-06_r8,0.41267e-06_r8,0.21754e-06_r8 /) + kbo(:, 3,59, 6) = (/ & + & 0.13639e-07_r8,0.39363e-06_r8,0.47345e-06_r8,0.47053e-06_r8,0.25873e-06_r8 /) + kbo(:, 4,59, 6) = (/ & + & 0.15635e-07_r8,0.45132e-06_r8,0.53722e-06_r8,0.53779e-06_r8,0.30436e-06_r8 /) + kbo(:, 5,59, 6) = (/ & + & 0.17515e-07_r8,0.51255e-06_r8,0.60804e-06_r8,0.61445e-06_r8,0.35395e-06_r8 /) + kbo(:, 1,13, 7) = (/ & + & 0.13818e-02_r8,0.53095e-02_r8,0.61744e-02_r8,0.61409e-02_r8,0.38201e-02_r8 /) + kbo(:, 2,13, 7) = (/ & + & 0.14927e-02_r8,0.54262e-02_r8,0.63169e-02_r8,0.63268e-02_r8,0.39787e-02_r8 /) + kbo(:, 3,13, 7) = (/ & + & 0.15882e-02_r8,0.55245e-02_r8,0.64575e-02_r8,0.65042e-02_r8,0.41285e-02_r8 /) + kbo(:, 4,13, 7) = (/ & + & 0.16683e-02_r8,0.56028e-02_r8,0.65859e-02_r8,0.66764e-02_r8,0.42766e-02_r8 /) + kbo(:, 5,13, 7) = (/ & + & 0.17364e-02_r8,0.56642e-02_r8,0.66996e-02_r8,0.68400e-02_r8,0.44196e-02_r8 /) + kbo(:, 1,14, 7) = (/ & + & 0.11439e-02_r8,0.44642e-02_r8,0.52052e-02_r8,0.51954e-02_r8,0.32185e-02_r8 /) + kbo(:, 2,14, 7) = (/ & + & 0.12322e-02_r8,0.45612e-02_r8,0.53295e-02_r8,0.53554e-02_r8,0.33544e-02_r8 /) + kbo(:, 3,14, 7) = (/ & + & 0.13082e-02_r8,0.46425e-02_r8,0.54474e-02_r8,0.55111e-02_r8,0.34869e-02_r8 /) + kbo(:, 4,14, 7) = (/ & + & 0.13723e-02_r8,0.47078e-02_r8,0.55568e-02_r8,0.56605e-02_r8,0.36178e-02_r8 /) + kbo(:, 5,14, 7) = (/ & + & 0.14273e-02_r8,0.47614e-02_r8,0.56536e-02_r8,0.58004e-02_r8,0.37445e-02_r8 /) + kbo(:, 1,15, 7) = (/ & + & 0.94600e-03_r8,0.37452e-02_r8,0.43786e-02_r8,0.43839e-02_r8,0.27064e-02_r8 /) + kbo(:, 2,15, 7) = (/ & + & 0.10166e-02_r8,0.38272e-02_r8,0.44845e-02_r8,0.45238e-02_r8,0.28259e-02_r8 /) + kbo(:, 3,15, 7) = (/ & + & 0.10772e-02_r8,0.38951e-02_r8,0.45852e-02_r8,0.46569e-02_r8,0.29424e-02_r8 /) + kbo(:, 4,15, 7) = (/ & + & 0.11287e-02_r8,0.39508e-02_r8,0.46776e-02_r8,0.47856e-02_r8,0.30573e-02_r8 /) + kbo(:, 5,15, 7) = (/ & + & 0.11727e-02_r8,0.39984e-02_r8,0.47639e-02_r8,0.49094e-02_r8,0.31707e-02_r8 /) + kbo(:, 1,16, 7) = (/ & + & 0.78170e-03_r8,0.31386e-02_r8,0.36753e-02_r8,0.36925e-02_r8,0.22749e-02_r8 /) + kbo(:, 2,16, 7) = (/ & + & 0.83828e-03_r8,0.32067e-02_r8,0.37655e-02_r8,0.38108e-02_r8,0.23791e-02_r8 /) + kbo(:, 3,16, 7) = (/ & + & 0.88677e-03_r8,0.32636e-02_r8,0.38524e-02_r8,0.39267e-02_r8,0.24809e-02_r8 /) + kbo(:, 4,16, 7) = (/ & + & 0.92814e-03_r8,0.33127e-02_r8,0.39332e-02_r8,0.40389e-02_r8,0.25819e-02_r8 /) + kbo(:, 5,16, 7) = (/ & + & 0.96342e-03_r8,0.33561e-02_r8,0.40123e-02_r8,0.41493e-02_r8,0.26825e-02_r8 /) + kbo(:, 1,17, 7) = (/ & + & 0.64513e-03_r8,0.26258e-02_r8,0.30792e-02_r8,0.31027e-02_r8,0.19109e-02_r8 /) + kbo(:, 2,17, 7) = (/ & + & 0.69065e-03_r8,0.26830e-02_r8,0.31573e-02_r8,0.32056e-02_r8,0.20013e-02_r8 /) + kbo(:, 3,17, 7) = (/ & + & 0.72951e-03_r8,0.27321e-02_r8,0.32326e-02_r8,0.33061e-02_r8,0.20905e-02_r8 /) + kbo(:, 4,17, 7) = (/ & + & 0.76279e-03_r8,0.27759e-02_r8,0.33057e-02_r8,0.34049e-02_r8,0.21791e-02_r8 /) + kbo(:, 5,17, 7) = (/ & + & 0.79127e-03_r8,0.28164e-02_r8,0.33776e-02_r8,0.35037e-02_r8,0.22680e-02_r8 /) + kbo(:, 1,18, 7) = (/ & + & 0.53216e-03_r8,0.21945e-02_r8,0.25768e-02_r8,0.26041e-02_r8,0.16047e-02_r8 /) + kbo(:, 2,18, 7) = (/ & + & 0.56878e-03_r8,0.22431e-02_r8,0.26453e-02_r8,0.26934e-02_r8,0.16829e-02_r8 /) + kbo(:, 3,18, 7) = (/ & + & 0.60002e-03_r8,0.22864e-02_r8,0.27121e-02_r8,0.27812e-02_r8,0.17605e-02_r8 /) + kbo(:, 4,18, 7) = (/ & + & 0.62666e-03_r8,0.23265e-02_r8,0.27778e-02_r8,0.28689e-02_r8,0.18389e-02_r8 /) + kbo(:, 5,18, 7) = (/ & + & 0.64956e-03_r8,0.23645e-02_r8,0.28436e-02_r8,0.29587e-02_r8,0.19175e-02_r8 /) + kbo(:, 1,19, 7) = (/ & + & 0.43878e-03_r8,0.18328e-02_r8,0.21555e-02_r8,0.21844e-02_r8,0.13470e-02_r8 /) + kbo(:, 2,19, 7) = (/ & + & 0.46832e-03_r8,0.18749e-02_r8,0.22160e-02_r8,0.22619e-02_r8,0.14147e-02_r8 /) + kbo(:, 3,19, 7) = (/ & + & 0.49337e-03_r8,0.19136e-02_r8,0.22752e-02_r8,0.23395e-02_r8,0.14834e-02_r8 /) + kbo(:, 4,19, 7) = (/ & + & 0.51483e-03_r8,0.19509e-02_r8,0.23344e-02_r8,0.24177e-02_r8,0.15526e-02_r8 /) + kbo(:, 5,19, 7) = (/ & + & 0.53321e-03_r8,0.19863e-02_r8,0.23950e-02_r8,0.24983e-02_r8,0.16228e-02_r8 /) + kbo(:, 1,20, 7) = (/ & + & 0.36218e-03_r8,0.15310e-02_r8,0.18044e-02_r8,0.18333e-02_r8,0.11320e-02_r8 /) + kbo(:, 2,20, 7) = (/ & + & 0.38587e-03_r8,0.15681e-02_r8,0.18573e-02_r8,0.19010e-02_r8,0.11911e-02_r8 /) + kbo(:, 3,20, 7) = (/ & + & 0.40599e-03_r8,0.16034e-02_r8,0.19105e-02_r8,0.19693e-02_r8,0.12516e-02_r8 /) + kbo(:, 4,20, 7) = (/ & + & 0.42327e-03_r8,0.16372e-02_r8,0.19642e-02_r8,0.20400e-02_r8,0.13133e-02_r8 /) + kbo(:, 5,20, 7) = (/ & + & 0.43800e-03_r8,0.16702e-02_r8,0.20196e-02_r8,0.21120e-02_r8,0.13760e-02_r8 /) + kbo(:, 1,21, 7) = (/ & + & 0.29894e-03_r8,0.12794e-02_r8,0.15109e-02_r8,0.15392e-02_r8,0.95196e-03_r8 /) + kbo(:, 2,21, 7) = (/ & + & 0.31795e-03_r8,0.13126e-02_r8,0.15578e-02_r8,0.15985e-02_r8,0.10041e-02_r8 /) + kbo(:, 3,21, 7) = (/ & + & 0.33409e-03_r8,0.13444e-02_r8,0.16054e-02_r8,0.16590e-02_r8,0.10575e-02_r8 /) + kbo(:, 4,21, 7) = (/ & + & 0.34798e-03_r8,0.13752e-02_r8,0.16542e-02_r8,0.17228e-02_r8,0.11124e-02_r8 /) + kbo(:, 5,21, 7) = (/ & + & 0.35982e-03_r8,0.14062e-02_r8,0.17046e-02_r8,0.17872e-02_r8,0.11688e-02_r8 /) + kbo(:, 1,22, 7) = (/ & + & 0.24779e-03_r8,0.10720e-02_r8,0.12687e-02_r8,0.12959e-02_r8,0.80428e-03_r8 /) + kbo(:, 2,22, 7) = (/ & + & 0.26287e-03_r8,0.11012e-02_r8,0.13104e-02_r8,0.13483e-02_r8,0.85046e-03_r8 /) + kbo(:, 3,22, 7) = (/ & + & 0.27570e-03_r8,0.11300e-02_r8,0.13532e-02_r8,0.14032e-02_r8,0.89796e-03_r8 /) + kbo(:, 4,22, 7) = (/ & + & 0.28676e-03_r8,0.11583e-02_r8,0.13978e-02_r8,0.14602e-02_r8,0.94722e-03_r8 /) + kbo(:, 5,22, 7) = (/ & + & 0.29612e-03_r8,0.11873e-02_r8,0.14439e-02_r8,0.15185e-02_r8,0.99812e-03_r8 /) + kbo(:, 1,23, 7) = (/ & + & 0.20536e-03_r8,0.89901e-03_r8,0.10666e-02_r8,0.10925e-02_r8,0.68077e-03_r8 /) + kbo(:, 2,23, 7) = (/ & + & 0.21732e-03_r8,0.92514e-03_r8,0.11037e-02_r8,0.11394e-02_r8,0.72189e-03_r8 /) + kbo(:, 3,23, 7) = (/ & + & 0.22752e-03_r8,0.95109e-03_r8,0.11426e-02_r8,0.11888e-02_r8,0.76437e-03_r8 /) + kbo(:, 4,23, 7) = (/ & + & 0.23632e-03_r8,0.97728e-03_r8,0.11832e-02_r8,0.12403e-02_r8,0.80877e-03_r8 /) + kbo(:, 5,23, 7) = (/ & + & 0.24369e-03_r8,0.10040e-02_r8,0.12260e-02_r8,0.12934e-02_r8,0.85489e-03_r8 /) + kbo(:, 1,24, 7) = (/ & + & 0.17021e-03_r8,0.75506e-03_r8,0.89800e-03_r8,0.92265e-03_r8,0.57788e-03_r8 /) + kbo(:, 2,24, 7) = (/ & + & 0.17969e-03_r8,0.77853e-03_r8,0.93149e-03_r8,0.96497e-03_r8,0.61443e-03_r8 /) + kbo(:, 3,24, 7) = (/ & + & 0.18778e-03_r8,0.80207e-03_r8,0.96680e-03_r8,0.10097e-02_r8,0.65278e-03_r8 /) + kbo(:, 4,24, 7) = (/ & + & 0.19477e-03_r8,0.82622e-03_r8,0.10041e-02_r8,0.10564e-02_r8,0.69293e-03_r8 /) + kbo(:, 5,24, 7) = (/ & + & 0.20055e-03_r8,0.85104e-03_r8,0.10439e-02_r8,0.11053e-02_r8,0.73424e-03_r8 /) + kbo(:, 1,25, 7) = (/ & + & 0.14110e-03_r8,0.63531e-03_r8,0.75746e-03_r8,0.78109e-03_r8,0.49195e-03_r8 /) + kbo(:, 2,25, 7) = (/ & + & 0.14860e-03_r8,0.65629e-03_r8,0.78801e-03_r8,0.81951e-03_r8,0.52472e-03_r8 /) + kbo(:, 3,25, 7) = (/ & + & 0.15502e-03_r8,0.67802e-03_r8,0.82018e-03_r8,0.86005e-03_r8,0.55929e-03_r8 /) + kbo(:, 4,25, 7) = (/ & + & 0.16054e-03_r8,0.70023e-03_r8,0.85487e-03_r8,0.90270e-03_r8,0.59546e-03_r8 /) + kbo(:, 5,25, 7) = (/ & + & 0.16506e-03_r8,0.72333e-03_r8,0.89213e-03_r8,0.94794e-03_r8,0.63296e-03_r8 /) + kbo(:, 1,26, 7) = (/ & + & 0.11704e-03_r8,0.53563e-03_r8,0.64089e-03_r8,0.66348e-03_r8,0.42036e-03_r8 /) + kbo(:, 2,26, 7) = (/ & + & 0.12296e-03_r8,0.55482e-03_r8,0.66859e-03_r8,0.69842e-03_r8,0.44986e-03_r8 /) + kbo(:, 3,26, 7) = (/ & + & 0.12804e-03_r8,0.57460e-03_r8,0.69838e-03_r8,0.73532e-03_r8,0.48115e-03_r8 /) + kbo(:, 4,26, 7) = (/ & + & 0.13237e-03_r8,0.59528e-03_r8,0.73081e-03_r8,0.77472e-03_r8,0.51371e-03_r8 /) + kbo(:, 5,26, 7) = (/ & + & 0.13587e-03_r8,0.61708e-03_r8,0.76562e-03_r8,0.81649e-03_r8,0.54800e-03_r8 /) + kbo(:, 1,27, 7) = (/ & + & 0.97037e-04_r8,0.45263e-03_r8,0.54353e-03_r8,0.56528e-03_r8,0.36031e-03_r8 /) + kbo(:, 2,27, 7) = (/ & + & 0.10171e-03_r8,0.47018e-03_r8,0.56899e-03_r8,0.59710e-03_r8,0.38698e-03_r8 /) + kbo(:, 3,27, 7) = (/ & + & 0.10572e-03_r8,0.48833e-03_r8,0.59675e-03_r8,0.63096e-03_r8,0.41505e-03_r8 /) + kbo(:, 4,27, 7) = (/ & + & 0.10911e-03_r8,0.50767e-03_r8,0.62713e-03_r8,0.66736e-03_r8,0.44466e-03_r8 /) + kbo(:, 5,27, 7) = (/ & + & 0.11182e-03_r8,0.52830e-03_r8,0.65949e-03_r8,0.70600e-03_r8,0.47625e-03_r8 /) + kbo(:, 1,28, 7) = (/ & + & 0.80419e-04_r8,0.38349e-03_r8,0.46224e-03_r8,0.48308e-03_r8,0.30982e-03_r8 /) + kbo(:, 2,28, 7) = (/ & + & 0.84110e-04_r8,0.39943e-03_r8,0.48584e-03_r8,0.51214e-03_r8,0.33386e-03_r8 /) + kbo(:, 3,28, 7) = (/ & + & 0.87283e-04_r8,0.41636e-03_r8,0.51189e-03_r8,0.54353e-03_r8,0.35924e-03_r8 /) + kbo(:, 4,28, 7) = (/ & + & 0.89914e-04_r8,0.43456e-03_r8,0.54020e-03_r8,0.57698e-03_r8,0.38635e-03_r8 /) + kbo(:, 5,28, 7) = (/ & + & 0.92003e-04_r8,0.45406e-03_r8,0.57030e-03_r8,0.61286e-03_r8,0.41553e-03_r8 /) + kbo(:, 1,29, 7) = (/ & + & 0.66637e-04_r8,0.32580e-03_r8,0.39453e-03_r8,0.41439e-03_r8,0.26738e-03_r8 /) + kbo(:, 2,29, 7) = (/ & + & 0.69552e-04_r8,0.34052e-03_r8,0.41660e-03_r8,0.44116e-03_r8,0.28904e-03_r8 /) + kbo(:, 3,29, 7) = (/ & + & 0.72042e-04_r8,0.35633e-03_r8,0.44102e-03_r8,0.47005e-03_r8,0.31218e-03_r8 /) + kbo(:, 4,29, 7) = (/ & + & 0.74082e-04_r8,0.37351e-03_r8,0.46731e-03_r8,0.50108e-03_r8,0.33714e-03_r8 /) + kbo(:, 5,29, 7) = (/ & + & 0.75692e-04_r8,0.39190e-03_r8,0.49529e-03_r8,0.53447e-03_r8,0.36421e-03_r8 /) + kbo(:, 1,30, 7) = (/ & + & 0.55194e-04_r8,0.27757e-03_r8,0.33804e-03_r8,0.35670e-03_r8,0.23148e-03_r8 /) + kbo(:, 2,30, 7) = (/ & + & 0.57489e-04_r8,0.29130e-03_r8,0.35876e-03_r8,0.38143e-03_r8,0.25115e-03_r8 /) + kbo(:, 3,30, 7) = (/ & + & 0.59445e-04_r8,0.30619e-03_r8,0.38148e-03_r8,0.40810e-03_r8,0.27242e-03_r8 /) + kbo(:, 4,30, 7) = (/ & + & 0.61024e-04_r8,0.32233e-03_r8,0.40578e-03_r8,0.43698e-03_r8,0.29552e-03_r8 /) + kbo(:, 5,30, 7) = (/ & + & 0.62251e-04_r8,0.33969e-03_r8,0.43185e-03_r8,0.46830e-03_r8,0.32052e-03_r8 /) + kbo(:, 1,31, 7) = (/ & + & 0.45701e-04_r8,0.23736e-03_r8,0.29086e-03_r8,0.30834e-03_r8,0.20114e-03_r8 /) + kbo(:, 2,31, 7) = (/ & + & 0.47516e-04_r8,0.25020e-03_r8,0.31032e-03_r8,0.33113e-03_r8,0.21916e-03_r8 /) + kbo(:, 3,31, 7) = (/ & + & 0.49034e-04_r8,0.26424e-03_r8,0.33131e-03_r8,0.35593e-03_r8,0.23874e-03_r8 /) + kbo(:, 4,31, 7) = (/ & + & 0.50247e-04_r8,0.27943e-03_r8,0.35395e-03_r8,0.38299e-03_r8,0.26024e-03_r8 /) + kbo(:, 5,31, 7) = (/ & + & 0.51186e-04_r8,0.29578e-03_r8,0.37829e-03_r8,0.41250e-03_r8,0.28341e-03_r8 /) + kbo(:, 1,32, 7) = (/ & + & 0.37829e-04_r8,0.20379e-03_r8,0.25145e-03_r8,0.26761e-03_r8,0.17549e-03_r8 /) + kbo(:, 2,32, 7) = (/ & + & 0.39256e-04_r8,0.21585e-03_r8,0.26951e-03_r8,0.28871e-03_r8,0.19207e-03_r8 /) + kbo(:, 3,32, 7) = (/ & + & 0.40434e-04_r8,0.22904e-03_r8,0.28903e-03_r8,0.31192e-03_r8,0.21034e-03_r8 /) + kbo(:, 4,32, 7) = (/ & + & 0.41367e-04_r8,0.24332e-03_r8,0.31020e-03_r8,0.33744e-03_r8,0.23024e-03_r8 /) + kbo(:, 5,32, 7) = (/ & + & 0.42072e-04_r8,0.25873e-03_r8,0.33309e-03_r8,0.36527e-03_r8,0.25179e-03_r8 /) + kbo(:, 1,33, 7) = (/ & + & 0.31302e-04_r8,0.17572e-03_r8,0.21830e-03_r8,0.23321e-03_r8,0.15375e-03_r8 /) + kbo(:, 2,33, 7) = (/ & + & 0.32419e-04_r8,0.18706e-03_r8,0.23504e-03_r8,0.25291e-03_r8,0.16915e-03_r8 /) + kbo(:, 3,33, 7) = (/ & + & 0.33327e-04_r8,0.19940e-03_r8,0.25328e-03_r8,0.27479e-03_r8,0.18617e-03_r8 /) + kbo(:, 4,33, 7) = (/ & + & 0.34039e-04_r8,0.21283e-03_r8,0.27315e-03_r8,0.29887e-03_r8,0.20465e-03_r8 /) + kbo(:, 5,33, 7) = (/ & + & 0.34568e-04_r8,0.22731e-03_r8,0.29474e-03_r8,0.32519e-03_r8,0.22485e-03_r8 /) + kbo(:, 1,34, 7) = (/ & + & 0.25851e-04_r8,0.15182e-03_r8,0.18976e-03_r8,0.20353e-03_r8,0.13483e-03_r8 /) + kbo(:, 2,34, 7) = (/ & + & 0.26731e-04_r8,0.16241e-03_r8,0.20531e-03_r8,0.22199e-03_r8,0.14918e-03_r8 /) + kbo(:, 3,34, 7) = (/ & + & 0.27437e-04_r8,0.17395e-03_r8,0.22237e-03_r8,0.24258e-03_r8,0.16491e-03_r8 /) + kbo(:, 4,34, 7) = (/ & + & 0.27988e-04_r8,0.18656e-03_r8,0.24113e-03_r8,0.26529e-03_r8,0.18217e-03_r8 /) + kbo(:, 5,34, 7) = (/ & + & 0.28384e-04_r8,0.20017e-03_r8,0.26144e-03_r8,0.29020e-03_r8,0.20116e-03_r8 /) + kbo(:, 1,35, 7) = (/ & + & 0.21271e-04_r8,0.13078e-03_r8,0.16426e-03_r8,0.17685e-03_r8,0.11756e-03_r8 /) + kbo(:, 2,35, 7) = (/ & + & 0.21975e-04_r8,0.14058e-03_r8,0.17865e-03_r8,0.19403e-03_r8,0.13072e-03_r8 /) + kbo(:, 3,35, 7) = (/ & + & 0.22533e-04_r8,0.15132e-03_r8,0.19456e-03_r8,0.21323e-03_r8,0.14523e-03_r8 /) + kbo(:, 4,35, 7) = (/ & + & 0.22966e-04_r8,0.16307e-03_r8,0.21206e-03_r8,0.23454e-03_r8,0.16133e-03_r8 /) + kbo(:, 5,35, 7) = (/ & + & 0.23274e-04_r8,0.17579e-03_r8,0.23112e-03_r8,0.25800e-03_r8,0.17911e-03_r8 /) + kbo(:, 1,36, 7) = (/ & + & 0.17431e-04_r8,0.11205e-03_r8,0.14128e-03_r8,0.15260e-03_r8,0.10161e-03_r8 /) + kbo(:, 2,36, 7) = (/ & + & 0.18004e-04_r8,0.12103e-03_r8,0.15448e-03_r8,0.16840e-03_r8,0.11356e-03_r8 /) + kbo(:, 3,36, 7) = (/ & + & 0.18458e-04_r8,0.13095e-03_r8,0.16918e-03_r8,0.18616e-03_r8,0.12687e-03_r8 /) + kbo(:, 4,36, 7) = (/ & + & 0.18810e-04_r8,0.14182e-03_r8,0.18539e-03_r8,0.20596e-03_r8,0.14179e-03_r8 /) + kbo(:, 5,36, 7) = (/ & + & 0.19059e-04_r8,0.15363e-03_r8,0.20317e-03_r8,0.22788e-03_r8,0.15831e-03_r8 /) + kbo(:, 1,37, 7) = (/ & + & 0.14204e-04_r8,0.95010e-04_r8,0.12008e-03_r8,0.12996e-03_r8,0.86482e-04_r8 /) + kbo(:, 2,37, 7) = (/ & + & 0.14685e-04_r8,0.10313e-03_r8,0.13200e-03_r8,0.14426e-03_r8,0.97179e-04_r8 /) + kbo(:, 3,37, 7) = (/ & + & 0.15069e-04_r8,0.11214e-03_r8,0.14536e-03_r8,0.16042e-03_r8,0.10922e-03_r8 /) + kbo(:, 4,37, 7) = (/ & + & 0.15369e-04_r8,0.12211e-03_r8,0.16020e-03_r8,0.17855e-03_r8,0.12282e-03_r8 /) + kbo(:, 5,37, 7) = (/ & + & 0.15586e-04_r8,0.13296e-03_r8,0.17661e-03_r8,0.19876e-03_r8,0.13797e-03_r8 /) + kbo(:, 1,38, 7) = (/ & + & 0.11571e-04_r8,0.80545e-04_r8,0.10206e-03_r8,0.11063e-03_r8,0.73563e-04_r8 /) + kbo(:, 2,38, 7) = (/ & + & 0.11976e-04_r8,0.87875e-04_r8,0.11281e-03_r8,0.12357e-03_r8,0.83149e-04_r8 /) + kbo(:, 3,38, 7) = (/ & + & 0.12301e-04_r8,0.96063e-04_r8,0.12495e-03_r8,0.13829e-03_r8,0.94026e-04_r8 /) + kbo(:, 4,38, 7) = (/ & + & 0.12557e-04_r8,0.10518e-03_r8,0.13851e-03_r8,0.15487e-03_r8,0.10642e-03_r8 /) + kbo(:, 5,38, 7) = (/ & + & 0.12744e-04_r8,0.11515e-03_r8,0.15364e-03_r8,0.17352e-03_r8,0.12029e-03_r8 /) + kbo(:, 1,39, 7) = (/ & + & 0.94254e-05_r8,0.68333e-04_r8,0.86798e-04_r8,0.94247e-04_r8,0.62604e-04_r8 /) + kbo(:, 2,39, 7) = (/ & + & 0.97657e-05_r8,0.74945e-04_r8,0.96495e-04_r8,0.10595e-03_r8,0.71185e-04_r8 /) + kbo(:, 3,39, 7) = (/ & + & 0.10041e-04_r8,0.82376e-04_r8,0.10752e-03_r8,0.11934e-03_r8,0.81022e-04_r8 /) + kbo(:, 4,39, 7) = (/ & + & 0.10258e-04_r8,0.90687e-04_r8,0.11992e-03_r8,0.13453e-03_r8,0.92315e-04_r8 /) + kbo(:, 5,39, 7) = (/ & + & 0.10419e-04_r8,0.99852e-04_r8,0.13387e-03_r8,0.15177e-03_r8,0.10504e-03_r8 /) + kbo(:, 1,40, 7) = (/ & + & 0.76452e-05_r8,0.57428e-04_r8,0.73021e-04_r8,0.79333e-04_r8,0.52568e-04_r8 /) + kbo(:, 2,40, 7) = (/ & + & 0.79354e-05_r8,0.63315e-04_r8,0.81650e-04_r8,0.89752e-04_r8,0.60144e-04_r8 /) + kbo(:, 3,40, 7) = (/ & + & 0.81739e-05_r8,0.69961e-04_r8,0.91542e-04_r8,0.10176e-03_r8,0.68905e-04_r8 /) + kbo(:, 4,40, 7) = (/ & + & 0.83626e-05_r8,0.77456e-04_r8,0.10275e-03_r8,0.11552e-03_r8,0.79059e-04_r8 /) + kbo(:, 5,40, 7) = (/ & + & 0.85064e-05_r8,0.85795e-04_r8,0.11542e-03_r8,0.13128e-03_r8,0.90578e-04_r8 /) + kbo(:, 1,41, 7) = (/ & + & 0.61953e-05_r8,0.48163e-04_r8,0.61287e-04_r8,0.66616e-04_r8,0.44011e-04_r8 /) + kbo(:, 2,41, 7) = (/ & + & 0.64418e-05_r8,0.53383e-04_r8,0.68934e-04_r8,0.75842e-04_r8,0.50670e-04_r8 /) + kbo(:, 3,41, 7) = (/ & + & 0.66484e-05_r8,0.59312e-04_r8,0.77785e-04_r8,0.86580e-04_r8,0.58448e-04_r8 /) + kbo(:, 4,41, 7) = (/ & + & 0.68134e-05_r8,0.66054e-04_r8,0.87876e-04_r8,0.98995e-04_r8,0.67543e-04_r8 /) + kbo(:, 5,41, 7) = (/ & + & 0.69402e-05_r8,0.73614e-04_r8,0.99378e-04_r8,0.11337e-03_r8,0.77942e-04_r8 /) + kbo(:, 1,42, 7) = (/ & + & 0.50170e-05_r8,0.40358e-04_r8,0.51378e-04_r8,0.55875e-04_r8,0.36794e-04_r8 /) + kbo(:, 2,42, 7) = (/ & + & 0.52266e-05_r8,0.44971e-04_r8,0.58141e-04_r8,0.64024e-04_r8,0.42639e-04_r8 /) + kbo(:, 3,42, 7) = (/ & + & 0.54046e-05_r8,0.50250e-04_r8,0.66034e-04_r8,0.73601e-04_r8,0.49527e-04_r8 /) + kbo(:, 4,42, 7) = (/ & + & 0.55484e-05_r8,0.56302e-04_r8,0.75111e-04_r8,0.84788e-04_r8,0.57654e-04_r8 /) + kbo(:, 5,42, 7) = (/ & + & 0.56600e-05_r8,0.63153e-04_r8,0.85551e-04_r8,0.97898e-04_r8,0.67040e-04_r8 /) + kbo(:, 1,43, 7) = (/ & + & 0.40498e-05_r8,0.33563e-04_r8,0.42716e-04_r8,0.46433e-04_r8,0.30447e-04_r8 /) + kbo(:, 2,43, 7) = (/ & + & 0.42291e-05_r8,0.37603e-04_r8,0.48619e-04_r8,0.53551e-04_r8,0.35516e-04_r8 /) + kbo(:, 3,43, 7) = (/ & + & 0.43833e-05_r8,0.42260e-04_r8,0.55585e-04_r8,0.61999e-04_r8,0.41549e-04_r8 /) + kbo(:, 4,43, 7) = (/ & + & 0.45099e-05_r8,0.47650e-04_r8,0.63668e-04_r8,0.71964e-04_r8,0.48728e-04_r8 /) + kbo(:, 5,43, 7) = (/ & + & 0.46096e-05_r8,0.53790e-04_r8,0.73053e-04_r8,0.83779e-04_r8,0.57105e-04_r8 /) + kbo(:, 1,44, 7) = (/ & + & 0.32616e-05_r8,0.27781e-04_r8,0.35335e-04_r8,0.38366e-04_r8,0.25032e-04_r8 /) + kbo(:, 2,44, 7) = (/ & + & 0.34164e-05_r8,0.31296e-04_r8,0.40444e-04_r8,0.44531e-04_r8,0.29399e-04_r8 /) + kbo(:, 3,44, 7) = (/ & + & 0.35491e-05_r8,0.35375e-04_r8,0.46540e-04_r8,0.51925e-04_r8,0.34633e-04_r8 /) + kbo(:, 4,44, 7) = (/ & + & 0.36610e-05_r8,0.40146e-04_r8,0.53687e-04_r8,0.60738e-04_r8,0.40935e-04_r8 /) + kbo(:, 5,44, 7) = (/ & + & 0.37500e-05_r8,0.45618e-04_r8,0.62061e-04_r8,0.71298e-04_r8,0.48356e-04_r8 /) + kbo(:, 1,45, 7) = (/ & + & 0.26238e-05_r8,0.22952e-04_r8,0.29162e-04_r8,0.31630e-04_r8,0.20522e-04_r8 /) + kbo(:, 2,45, 7) = (/ & + & 0.27571e-05_r8,0.25992e-04_r8,0.33567e-04_r8,0.36938e-04_r8,0.24268e-04_r8 /) + kbo(:, 3,45, 7) = (/ & + & 0.28713e-05_r8,0.29549e-04_r8,0.38881e-04_r8,0.43383e-04_r8,0.28792e-04_r8 /) + kbo(:, 4,45, 7) = (/ & + & 0.29693e-05_r8,0.33760e-04_r8,0.45177e-04_r8,0.51149e-04_r8,0.34303e-04_r8 /) + kbo(:, 5,45, 7) = (/ & + & 0.30482e-05_r8,0.38627e-04_r8,0.52624e-04_r8,0.60551e-04_r8,0.40857e-04_r8 /) + kbo(:, 1,46, 7) = (/ & + & 0.21051e-05_r8,0.18867e-04_r8,0.23935e-04_r8,0.25917e-04_r8,0.16710e-04_r8 /) + kbo(:, 2,46, 7) = (/ & + & 0.22206e-05_r8,0.21480e-04_r8,0.27705e-04_r8,0.30449e-04_r8,0.19893e-04_r8 /) + kbo(:, 3,46, 7) = (/ & + & 0.23191e-05_r8,0.24557e-04_r8,0.32298e-04_r8,0.36019e-04_r8,0.23769e-04_r8 /) + kbo(:, 4,46, 7) = (/ & + & 0.24046e-05_r8,0.28239e-04_r8,0.37798e-04_r8,0.42807e-04_r8,0.28545e-04_r8 /) + kbo(:, 5,46, 7) = (/ & + & 0.24746e-05_r8,0.32543e-04_r8,0.44374e-04_r8,0.51109e-04_r8,0.34299e-04_r8 /) + kbo(:, 1,47, 7) = (/ & + & 0.16817e-05_r8,0.15386e-04_r8,0.19464e-04_r8,0.21024e-04_r8,0.13455e-04_r8 /) + kbo(:, 2,47, 7) = (/ & + & 0.17822e-05_r8,0.17605e-04_r8,0.22652e-04_r8,0.24840e-04_r8,0.16124e-04_r8 /) + kbo(:, 3,47, 7) = (/ & + & 0.18680e-05_r8,0.20236e-04_r8,0.26567e-04_r8,0.29585e-04_r8,0.19401e-04_r8 /) + kbo(:, 4,47, 7) = (/ & + & 0.19423e-05_r8,0.23413e-04_r8,0.31317e-04_r8,0.35433e-04_r8,0.23476e-04_r8 /) + kbo(:, 5,47, 7) = (/ & + & 0.20049e-05_r8,0.27181e-04_r8,0.37054e-04_r8,0.42668e-04_r8,0.28466e-04_r8 /) + kbo(:, 1,48, 7) = (/ & + & 0.13405e-05_r8,0.12514e-04_r8,0.15779e-04_r8,0.16993e-04_r8,0.10791e-04_r8 /) + kbo(:, 2,48, 7) = (/ & + & 0.14280e-05_r8,0.14385e-04_r8,0.18460e-04_r8,0.20187e-04_r8,0.13017e-04_r8 /) + kbo(:, 3,48, 7) = (/ & + & 0.15026e-05_r8,0.16623e-04_r8,0.21773e-04_r8,0.24205e-04_r8,0.15768e-04_r8 /) + kbo(:, 4,48, 7) = (/ & + & 0.15671e-05_r8,0.19354e-04_r8,0.25854e-04_r8,0.29218e-04_r8,0.19227e-04_r8 /) + kbo(:, 5,48, 7) = (/ & + & 0.16224e-05_r8,0.22629e-04_r8,0.30833e-04_r8,0.35479e-04_r8,0.23525e-04_r8 /) + kbo(:, 1,49, 7) = (/ & + & 0.10664e-05_r8,0.10149e-04_r8,0.12751e-04_r8,0.13684e-04_r8,0.86188e-05_r8 /) + kbo(:, 2,49, 7) = (/ & + & 0.11418e-05_r8,0.11720e-04_r8,0.14999e-04_r8,0.16352e-04_r8,0.10467e-04_r8 /) + kbo(:, 3,49, 7) = (/ & + & 0.12069e-05_r8,0.13612e-04_r8,0.17780e-04_r8,0.19716e-04_r8,0.12759e-04_r8 /) + kbo(:, 4,49, 7) = (/ & + & 0.12630e-05_r8,0.15945e-04_r8,0.21262e-04_r8,0.23990e-04_r8,0.15676e-04_r8 /) + kbo(:, 5,49, 7) = (/ & + & 0.13113e-05_r8,0.18775e-04_r8,0.25560e-04_r8,0.29382e-04_r8,0.19352e-04_r8 /) + kbo(:, 1,50, 7) = (/ & + & 0.84808e-06_r8,0.82401e-05_r8,0.10318e-04_r8,0.11036e-04_r8,0.68939e-05_r8 /) + kbo(:, 2,50, 7) = (/ & + & 0.91269e-06_r8,0.95513e-05_r8,0.12189e-04_r8,0.13247e-04_r8,0.84209e-05_r8 /) + kbo(:, 3,50, 7) = (/ & + & 0.96928e-06_r8,0.11160e-04_r8,0.14539e-04_r8,0.16084e-04_r8,0.10336e-04_r8 /) + kbo(:, 4,50, 7) = (/ & + & 0.10177e-05_r8,0.13146e-04_r8,0.17498e-04_r8,0.19711e-04_r8,0.12790e-04_r8 /) + kbo(:, 5,50, 7) = (/ & + & 0.10595e-05_r8,0.15592e-04_r8,0.21207e-04_r8,0.24356e-04_r8,0.15929e-04_r8 /) + kbo(:, 1,51, 7) = (/ & + & 0.67378e-06_r8,0.66826e-05_r8,0.83381e-05_r8,0.88828e-05_r8,0.55052e-05_r8 /) + kbo(:, 2,51, 7) = (/ & + & 0.72873e-06_r8,0.77753e-05_r8,0.98905e-05_r8,0.10714e-04_r8,0.67636e-05_r8 /) + kbo(:, 3,51, 7) = (/ & + & 0.77763e-06_r8,0.91368e-05_r8,0.11866e-04_r8,0.13091e-04_r8,0.83559e-05_r8 /) + kbo(:, 4,51, 7) = (/ & + & 0.81953e-06_r8,0.10824e-04_r8,0.14378e-04_r8,0.16168e-04_r8,0.10417e-04_r8 /) + kbo(:, 5,51, 7) = (/ & + & 0.85561e-06_r8,0.12933e-04_r8,0.17571e-04_r8,0.20159e-04_r8,0.13087e-04_r8 /) + kbo(:, 1,52, 7) = (/ & + & 0.53444e-06_r8,0.54066e-05_r8,0.67197e-05_r8,0.71297e-05_r8,0.43814e-05_r8 /) + kbo(:, 2,52, 7) = (/ & + & 0.58095e-06_r8,0.63124e-05_r8,0.79989e-05_r8,0.86346e-05_r8,0.54122e-05_r8 /) + kbo(:, 3,52, 7) = (/ & + & 0.62282e-06_r8,0.74561e-05_r8,0.96489e-05_r8,0.10614e-04_r8,0.67289e-05_r8 /) + kbo(:, 4,52, 7) = (/ & + & 0.65913e-06_r8,0.88917e-05_r8,0.11780e-04_r8,0.13220e-04_r8,0.84497e-05_r8 /) + kbo(:, 5,52, 7) = (/ & + & 0.69032e-06_r8,0.10691e-04_r8,0.14504e-04_r8,0.16615e-04_r8,0.10706e-04_r8 /) + kbo(:, 1,53, 7) = (/ & + & 0.42309e-06_r8,0.43635e-05_r8,0.54017e-05_r8,0.57047e-05_r8,0.34733e-05_r8 /) + kbo(:, 2,53, 7) = (/ & + & 0.46223e-06_r8,0.51097e-05_r8,0.64465e-05_r8,0.69322e-05_r8,0.43120e-05_r8 /) + kbo(:, 3,53, 7) = (/ & + & 0.49791e-06_r8,0.60643e-05_r8,0.78166e-05_r8,0.85690e-05_r8,0.53948e-05_r8 /) + kbo(:, 4,53, 7) = (/ & + & 0.52942e-06_r8,0.72726e-05_r8,0.96042e-05_r8,0.10748e-04_r8,0.68211e-05_r8 /) + kbo(:, 5,53, 7) = (/ & + & 0.55635e-06_r8,0.88074e-05_r8,0.11924e-04_r8,0.13632e-04_r8,0.87176e-05_r8 /) + kbo(:, 1,54, 7) = (/ & + & 0.33525e-06_r8,0.35291e-05_r8,0.43533e-05_r8,0.45783e-05_r8,0.27618e-05_r8 /) + kbo(:, 2,54, 7) = (/ & + & 0.36801e-06_r8,0.41464e-05_r8,0.52098e-05_r8,0.55821e-05_r8,0.34468e-05_r8 /) + kbo(:, 3,54, 7) = (/ & + & 0.39830e-06_r8,0.49442e-05_r8,0.63495e-05_r8,0.69393e-05_r8,0.43390e-05_r8 /) + kbo(:, 4,54, 7) = (/ & + & 0.42530e-06_r8,0.59638e-05_r8,0.78520e-05_r8,0.87652e-05_r8,0.55238e-05_r8 /) + kbo(:, 5,54, 7) = (/ & + & 0.44850e-06_r8,0.72711e-05_r8,0.98256e-05_r8,0.11213e-04_r8,0.71180e-05_r8 /) + kbo(:, 1,55, 7) = (/ & + & 0.26561e-06_r8,0.28535e-05_r8,0.35091e-05_r8,0.36747e-05_r8,0.21953e-05_r8 /) + kbo(:, 2,55, 7) = (/ & + & 0.29299e-06_r8,0.33630e-05_r8,0.42093e-05_r8,0.44935e-05_r8,0.27543e-05_r8 /) + kbo(:, 3,55, 7) = (/ & + & 0.31855e-06_r8,0.40286e-05_r8,0.51555e-05_r8,0.56160e-05_r8,0.34885e-05_r8 /) + kbo(:, 4,55, 7) = (/ & + & 0.34149e-06_r8,0.48884e-05_r8,0.64166e-05_r8,0.71432e-05_r8,0.44712e-05_r8 /) + kbo(:, 5,55, 7) = (/ & + & 0.36149e-06_r8,0.60082e-05_r8,0.81053e-05_r8,0.92338e-05_r8,0.58114e-05_r8 /) + kbo(:, 1,56, 7) = (/ & + & 0.21017e-06_r8,0.23019e-05_r8,0.28217e-05_r8,0.29420e-05_r8,0.17403e-05_r8 /) + kbo(:, 2,56, 7) = (/ & + & 0.23294e-06_r8,0.27215e-05_r8,0.33922e-05_r8,0.36070e-05_r8,0.21943e-05_r8 /) + kbo(:, 3,56, 7) = (/ & + & 0.25436e-06_r8,0.32732e-05_r8,0.41720e-05_r8,0.45291e-05_r8,0.27950e-05_r8 /) + kbo(:, 4,56, 7) = (/ & + & 0.27383e-06_r8,0.39951e-05_r8,0.52252e-05_r8,0.57990e-05_r8,0.36054e-05_r8 /) + kbo(:, 5,56, 7) = (/ & + & 0.29106e-06_r8,0.49429e-05_r8,0.66518e-05_r8,0.75613e-05_r8,0.47246e-05_r8 /) + kbo(:, 1,57, 7) = (/ & + & 0.16608e-06_r8,0.18531e-05_r8,0.22639e-05_r8,0.23504e-05_r8,0.13760e-05_r8 /) + kbo(:, 2,57, 7) = (/ & + & 0.18488e-06_r8,0.21971e-05_r8,0.27271e-05_r8,0.28870e-05_r8,0.17421e-05_r8 /) + kbo(:, 3,57, 7) = (/ & + & 0.20279e-06_r8,0.26520e-05_r8,0.33659e-05_r8,0.36392e-05_r8,0.22316e-05_r8 /) + kbo(:, 4,57, 7) = (/ & + & 0.21931e-06_r8,0.32543e-05_r8,0.42391e-05_r8,0.46891e-05_r8,0.28949e-05_r8 /) + kbo(:, 5,57, 7) = (/ & + & 0.23404e-06_r8,0.40527e-05_r8,0.54380e-05_r8,0.61649e-05_r8,0.38234e-05_r8 /) + kbo(:, 1,58, 7) = (/ & + & 0.13131e-06_r8,0.14927e-05_r8,0.18179e-05_r8,0.18787e-05_r8,0.10893e-05_r8 /) + kbo(:, 2,58, 7) = (/ & + & 0.14677e-06_r8,0.17748e-05_r8,0.21946e-05_r8,0.23122e-05_r8,0.13839e-05_r8 /) + kbo(:, 3,58, 7) = (/ & + & 0.16171e-06_r8,0.21494e-05_r8,0.27171e-05_r8,0.29256e-05_r8,0.17827e-05_r8 /) + kbo(:, 4,58, 7) = (/ & + & 0.17567e-06_r8,0.26514e-05_r8,0.34407e-05_r8,0.37923e-05_r8,0.23269e-05_r8 /) + kbo(:, 5,58, 7) = (/ & + & 0.18816e-06_r8,0.33237e-05_r8,0.44466e-05_r8,0.50280e-05_r8,0.30958e-05_r8 /) + kbo(:, 1,59, 7) = (/ & + & 0.10599e-06_r8,0.12374e-05_r8,0.15060e-05_r8,0.15543e-05_r8,0.89750e-06_r8 /) + kbo(:, 2,59, 7) = (/ & + & 0.11868e-06_r8,0.14795e-05_r8,0.18285e-05_r8,0.19251e-05_r8,0.11479e-05_r8 /) + kbo(:, 3,59, 7) = (/ & + & 0.13098e-06_r8,0.18042e-05_r8,0.22807e-05_r8,0.24552e-05_r8,0.14897e-05_r8 /) + kbo(:, 4,59, 7) = (/ & + & 0.14252e-06_r8,0.22439e-05_r8,0.29152e-05_r8,0.32163e-05_r8,0.19622e-05_r8 /) + kbo(:, 5,59, 7) = (/ & + & 0.15291e-06_r8,0.28396e-05_r8,0.38087e-05_r8,0.43138e-05_r8,0.26387e-05_r8 /) + kbo(:, 1,13, 8) = (/ & + & 0.83673e-02_r8,0.17454e-01_r8,0.20213e-01_r8,0.20132e-01_r8,0.13810e-01_r8 /) + kbo(:, 2,13, 8) = (/ & + & 0.85039e-02_r8,0.17824e-01_r8,0.20684e-01_r8,0.20616e-01_r8,0.14219e-01_r8 /) + kbo(:, 3,13, 8) = (/ & + & 0.86129e-02_r8,0.18196e-01_r8,0.21163e-01_r8,0.21143e-01_r8,0.14616e-01_r8 /) + kbo(:, 4,13, 8) = (/ & + & 0.86913e-02_r8,0.18563e-01_r8,0.21635e-01_r8,0.21674e-01_r8,0.14991e-01_r8 /) + kbo(:, 5,13, 8) = (/ & + & 0.87301e-02_r8,0.18916e-01_r8,0.22103e-01_r8,0.22198e-01_r8,0.15351e-01_r8 /) + kbo(:, 1,14, 8) = (/ & + & 0.69346e-02_r8,0.14952e-01_r8,0.17380e-01_r8,0.17342e-01_r8,0.11803e-01_r8 /) + kbo(:, 2,14, 8) = (/ & + & 0.70328e-02_r8,0.15276e-01_r8,0.17808e-01_r8,0.17830e-01_r8,0.12181e-01_r8 /) + kbo(:, 3,14, 8) = (/ & + & 0.71113e-02_r8,0.15604e-01_r8,0.18240e-01_r8,0.18321e-01_r8,0.12544e-01_r8 /) + kbo(:, 4,14, 8) = (/ & + & 0.71580e-02_r8,0.15937e-01_r8,0.18667e-01_r8,0.18814e-01_r8,0.12884e-01_r8 /) + kbo(:, 5,14, 8) = (/ & + & 0.71785e-02_r8,0.16228e-01_r8,0.19093e-01_r8,0.19299e-01_r8,0.13230e-01_r8 /) + kbo(:, 1,15, 8) = (/ & + & 0.57307e-02_r8,0.12763e-01_r8,0.14890e-01_r8,0.14912e-01_r8,0.10073e-01_r8 /) + kbo(:, 2,15, 8) = (/ & + & 0.58017e-02_r8,0.13052e-01_r8,0.15278e-01_r8,0.15370e-01_r8,0.10417e-01_r8 /) + kbo(:, 3,15, 8) = (/ & + & 0.58533e-02_r8,0.13347e-01_r8,0.15666e-01_r8,0.15828e-01_r8,0.10742e-01_r8 /) + kbo(:, 4,15, 8) = (/ & + & 0.58826e-02_r8,0.13628e-01_r8,0.16057e-01_r8,0.16289e-01_r8,0.11066e-01_r8 /) + kbo(:, 5,15, 8) = (/ & + & 0.58933e-02_r8,0.13873e-01_r8,0.16444e-01_r8,0.16739e-01_r8,0.11388e-01_r8 /) + kbo(:, 1,16, 8) = (/ & + & 0.47247e-02_r8,0.10863e-01_r8,0.12723e-01_r8,0.12788e-01_r8,0.85822e-02_r8 /) + kbo(:, 2,16, 8) = (/ & + & 0.47755e-02_r8,0.11124e-01_r8,0.13076e-01_r8,0.13211e-01_r8,0.88907e-02_r8 /) + kbo(:, 3,16, 8) = (/ & + & 0.48095e-02_r8,0.11385e-01_r8,0.13431e-01_r8,0.13641e-01_r8,0.91903e-02_r8 /) + kbo(:, 4,16, 8) = (/ & + & 0.48283e-02_r8,0.11622e-01_r8,0.13790e-01_r8,0.14066e-01_r8,0.94912e-02_r8 /) + kbo(:, 5,16, 8) = (/ & + & 0.48333e-02_r8,0.11841e-01_r8,0.14135e-01_r8,0.14487e-01_r8,0.97938e-02_r8 /) + kbo(:, 1,17, 8) = (/ & + & 0.38881e-02_r8,0.92313e-02_r8,0.10848e-01_r8,0.10942e-01_r8,0.73006e-02_r8 /) + kbo(:, 2,17, 8) = (/ & + & 0.39238e-02_r8,0.94601e-02_r8,0.11171e-01_r8,0.11333e-01_r8,0.75792e-02_r8 /) + kbo(:, 3,17, 8) = (/ & + & 0.39468e-02_r8,0.96874e-02_r8,0.11500e-01_r8,0.11732e-01_r8,0.78560e-02_r8 /) + kbo(:, 4,17, 8) = (/ & + & 0.39590e-02_r8,0.98962e-02_r8,0.11826e-01_r8,0.12129e-01_r8,0.81376e-02_r8 /) + kbo(:, 5,17, 8) = (/ & + & 0.39612e-02_r8,0.10094e-01_r8,0.12144e-01_r8,0.12521e-01_r8,0.84293e-02_r8 /) + kbo(:, 1,18, 8) = (/ & + & 0.31953e-02_r8,0.78309e-02_r8,0.92361e-02_r8,0.93523e-02_r8,0.62048e-02_r8 /) + kbo(:, 2,18, 8) = (/ & + & 0.32208e-02_r8,0.80372e-02_r8,0.95350e-02_r8,0.97148e-02_r8,0.64590e-02_r8 /) + kbo(:, 3,18, 8) = (/ & + & 0.32365e-02_r8,0.82342e-02_r8,0.98382e-02_r8,0.10082e-01_r8,0.67154e-02_r8 /) + kbo(:, 4,18, 8) = (/ & + & 0.32447e-02_r8,0.84229e-02_r8,0.10138e-01_r8,0.10450e-01_r8,0.69838e-02_r8 /) + kbo(:, 5,18, 8) = (/ & + & 0.32450e-02_r8,0.86061e-02_r8,0.10427e-01_r8,0.10814e-01_r8,0.72626e-02_r8 /) + kbo(:, 1,19, 8) = (/ & + & 0.26235e-02_r8,0.66399e-02_r8,0.78599e-02_r8,0.79875e-02_r8,0.52728e-02_r8 /) + kbo(:, 2,19, 8) = (/ & + & 0.26414e-02_r8,0.68231e-02_r8,0.81351e-02_r8,0.83230e-02_r8,0.55070e-02_r8 /) + kbo(:, 3,19, 8) = (/ & + & 0.26530e-02_r8,0.70004e-02_r8,0.84138e-02_r8,0.86629e-02_r8,0.57468e-02_r8 /) + kbo(:, 4,19, 8) = (/ & + & 0.26583e-02_r8,0.71756e-02_r8,0.86887e-02_r8,0.90029e-02_r8,0.60006e-02_r8 /) + kbo(:, 5,19, 8) = (/ & + & 0.26573e-02_r8,0.73457e-02_r8,0.89549e-02_r8,0.93422e-02_r8,0.62658e-02_r8 /) + kbo(:, 1,20, 8) = (/ & + & 0.21528e-02_r8,0.56300e-02_r8,0.66928e-02_r8,0.68275e-02_r8,0.44887e-02_r8 /) + kbo(:, 2,20, 8) = (/ & + & 0.21659e-02_r8,0.57965e-02_r8,0.69483e-02_r8,0.71374e-02_r8,0.47044e-02_r8 /) + kbo(:, 3,20, 8) = (/ & + & 0.21742e-02_r8,0.59617e-02_r8,0.72036e-02_r8,0.74503e-02_r8,0.49314e-02_r8 /) + kbo(:, 4,20, 8) = (/ & + & 0.21777e-02_r8,0.61251e-02_r8,0.74562e-02_r8,0.77657e-02_r8,0.51700e-02_r8 /) + kbo(:, 5,20, 8) = (/ & + & 0.21757e-02_r8,0.62850e-02_r8,0.77065e-02_r8,0.80891e-02_r8,0.54225e-02_r8 /) + kbo(:, 1,21, 8) = (/ & + & 0.17659e-02_r8,0.47778e-02_r8,0.57054e-02_r8,0.58417e-02_r8,0.38271e-02_r8 /) + kbo(:, 2,21, 8) = (/ & + & 0.17754e-02_r8,0.49299e-02_r8,0.59393e-02_r8,0.61257e-02_r8,0.40264e-02_r8 /) + kbo(:, 3,21, 8) = (/ & + & 0.17817e-02_r8,0.50836e-02_r8,0.61750e-02_r8,0.64148e-02_r8,0.42397e-02_r8 /) + kbo(:, 4,21, 8) = (/ & + & 0.17836e-02_r8,0.52370e-02_r8,0.64083e-02_r8,0.67125e-02_r8,0.44647e-02_r8 /) + kbo(:, 5,21, 8) = (/ & + & 0.17811e-02_r8,0.53876e-02_r8,0.66480e-02_r8,0.70201e-02_r8,0.47076e-02_r8 /) + kbo(:, 1,22, 8) = (/ & + & 0.14486e-02_r8,0.40679e-02_r8,0.48826e-02_r8,0.50205e-02_r8,0.32805e-02_r8 /) + kbo(:, 2,22, 8) = (/ & + & 0.14554e-02_r8,0.42085e-02_r8,0.50980e-02_r8,0.52827e-02_r8,0.34669e-02_r8 /) + kbo(:, 3,22, 8) = (/ & + & 0.14597e-02_r8,0.43515e-02_r8,0.53153e-02_r8,0.55535e-02_r8,0.36674e-02_r8 /) + kbo(:, 4,22, 8) = (/ & + & 0.14606e-02_r8,0.44957e-02_r8,0.55353e-02_r8,0.58376e-02_r8,0.38816e-02_r8 /) + kbo(:, 5,22, 8) = (/ & + & 0.14577e-02_r8,0.46383e-02_r8,0.57672e-02_r8,0.61302e-02_r8,0.41156e-02_r8 /) + kbo(:, 1,23, 8) = (/ & + & 0.11880e-02_r8,0.34698e-02_r8,0.41861e-02_r8,0.43248e-02_r8,0.28199e-02_r8 /) + kbo(:, 2,23, 8) = (/ & + & 0.11929e-02_r8,0.36010e-02_r8,0.43862e-02_r8,0.45689e-02_r8,0.29956e-02_r8 /) + kbo(:, 3,23, 8) = (/ & + & 0.11958e-02_r8,0.37344e-02_r8,0.45877e-02_r8,0.48273e-02_r8,0.31843e-02_r8 /) + kbo(:, 4,23, 8) = (/ & + & 0.11959e-02_r8,0.38697e-02_r8,0.48007e-02_r8,0.50965e-02_r8,0.33903e-02_r8 /) + kbo(:, 5,23, 8) = (/ & + & 0.11929e-02_r8,0.40068e-02_r8,0.50232e-02_r8,0.53791e-02_r8,0.36136e-02_r8 /) + kbo(:, 1,24, 8) = (/ & + & 0.97406e-03_r8,0.29675e-02_r8,0.36006e-02_r8,0.37379e-02_r8,0.24344e-02_r8 /) + kbo(:, 2,24, 8) = (/ & + & 0.97756e-03_r8,0.30896e-02_r8,0.37850e-02_r8,0.39686e-02_r8,0.25994e-02_r8 /) + kbo(:, 3,24, 8) = (/ & + & 0.97946e-03_r8,0.32150e-02_r8,0.39775e-02_r8,0.42135e-02_r8,0.27776e-02_r8 /) + kbo(:, 4,24, 8) = (/ & + & 0.97899e-03_r8,0.33430e-02_r8,0.41825e-02_r8,0.44708e-02_r8,0.29753e-02_r8 /) + kbo(:, 5,24, 8) = (/ & + & 0.97615e-03_r8,0.34761e-02_r8,0.43966e-02_r8,0.47457e-02_r8,0.31900e-02_r8 /) + kbo(:, 1,25, 8) = (/ & + & 0.79856e-03_r8,0.25459e-02_r8,0.31077e-02_r8,0.32447e-02_r8,0.21114e-02_r8 /) + kbo(:, 2,25, 8) = (/ & + & 0.80110e-03_r8,0.26605e-02_r8,0.32805e-02_r8,0.34640e-02_r8,0.22664e-02_r8 /) + kbo(:, 3,25, 8) = (/ & + & 0.80222e-03_r8,0.27778e-02_r8,0.34666e-02_r8,0.36958e-02_r8,0.24376e-02_r8 /) + kbo(:, 4,25, 8) = (/ & + & 0.80129e-03_r8,0.29014e-02_r8,0.36623e-02_r8,0.39444e-02_r8,0.26269e-02_r8 /) + kbo(:, 5,25, 8) = (/ & + & 0.79857e-03_r8,0.30302e-02_r8,0.38698e-02_r8,0.42126e-02_r8,0.28335e-02_r8 /) + kbo(:, 1,26, 8) = (/ & + & 0.65460e-03_r8,0.21933e-02_r8,0.26944e-02_r8,0.28334e-02_r8,0.18417e-02_r8 /) + kbo(:, 2,26, 8) = (/ & + & 0.65639e-03_r8,0.23003e-02_r8,0.28599e-02_r8,0.30409e-02_r8,0.19886e-02_r8 /) + kbo(:, 3,26, 8) = (/ & + & 0.65685e-03_r8,0.24132e-02_r8,0.30384e-02_r8,0.32639e-02_r8,0.21545e-02_r8 /) + kbo(:, 4,26, 8) = (/ & + & 0.65577e-03_r8,0.25323e-02_r8,0.32275e-02_r8,0.35055e-02_r8,0.23366e-02_r8 /) + kbo(:, 5,26, 8) = (/ & + & 0.65325e-03_r8,0.26572e-02_r8,0.34294e-02_r8,0.37687e-02_r8,0.25365e-02_r8 /) + kbo(:, 1,27, 8) = (/ & + & 0.53655e-03_r8,0.18966e-02_r8,0.23474e-02_r8,0.24873e-02_r8,0.16142e-02_r8 /) + kbo(:, 2,27, 8) = (/ & + & 0.53777e-03_r8,0.19979e-02_r8,0.25069e-02_r8,0.26849e-02_r8,0.17570e-02_r8 /) + kbo(:, 3,27, 8) = (/ & + & 0.53783e-03_r8,0.21070e-02_r8,0.26778e-02_r8,0.29010e-02_r8,0.19163e-02_r8 /) + kbo(:, 4,27, 8) = (/ & + & 0.53661e-03_r8,0.22218e-02_r8,0.28609e-02_r8,0.31373e-02_r8,0.20925e-02_r8 /) + kbo(:, 5,27, 8) = (/ & + & 0.53426e-03_r8,0.23437e-02_r8,0.30591e-02_r8,0.33953e-02_r8,0.22871e-02_r8 /) + kbo(:, 1,28, 8) = (/ & + & 0.43973e-03_r8,0.16467e-02_r8,0.20564e-02_r8,0.21950e-02_r8,0.14243e-02_r8 /) + kbo(:, 2,28, 8) = (/ & + & 0.44046e-03_r8,0.17445e-02_r8,0.22094e-02_r8,0.23854e-02_r8,0.15622e-02_r8 /) + kbo(:, 3,28, 8) = (/ & + & 0.44027e-03_r8,0.18495e-02_r8,0.23737e-02_r8,0.25954e-02_r8,0.17160e-02_r8 /) + kbo(:, 4,28, 8) = (/ & + & 0.43902e-03_r8,0.19607e-02_r8,0.25527e-02_r8,0.28280e-02_r8,0.18875e-02_r8 /) + kbo(:, 5,28, 8) = (/ & + & 0.43690e-03_r8,0.20797e-02_r8,0.27483e-02_r8,0.30809e-02_r8,0.20783e-02_r8 /) + kbo(:, 1,29, 8) = (/ & + & 0.36035e-03_r8,0.14377e-02_r8,0.18129e-02_r8,0.19502e-02_r8,0.12665e-02_r8 /) + kbo(:, 2,29, 8) = (/ & + & 0.36078e-03_r8,0.15322e-02_r8,0.19593e-02_r8,0.21346e-02_r8,0.13993e-02_r8 /) + kbo(:, 3,29, 8) = (/ & + & 0.36035e-03_r8,0.16333e-02_r8,0.21194e-02_r8,0.23407e-02_r8,0.15489e-02_r8 /) + kbo(:, 4,29, 8) = (/ & + & 0.35917e-03_r8,0.17416e-02_r8,0.22958e-02_r8,0.25693e-02_r8,0.17169e-02_r8 /) + kbo(:, 5,29, 8) = (/ & + & 0.35722e-03_r8,0.18583e-02_r8,0.24893e-02_r8,0.28199e-02_r8,0.19058e-02_r8 /) + kbo(:, 1,30, 8) = (/ & + & 0.29522e-03_r8,0.12625e-02_r8,0.16073e-02_r8,0.17444e-02_r8,0.11337e-02_r8 /) + kbo(:, 2,30, 8) = (/ & + & 0.29544e-03_r8,0.13534e-02_r8,0.17493e-02_r8,0.19248e-02_r8,0.12629e-02_r8 /) + kbo(:, 3,30, 8) = (/ & + & 0.29489e-03_r8,0.14513e-02_r8,0.19064e-02_r8,0.21281e-02_r8,0.14093e-02_r8 /) + kbo(:, 4,30, 8) = (/ & + & 0.29377e-03_r8,0.15575e-02_r8,0.20813e-02_r8,0.23536e-02_r8,0.15751e-02_r8 /) + kbo(:, 5,30, 8) = (/ & + & 0.29201e-03_r8,0.16725e-02_r8,0.22728e-02_r8,0.26031e-02_r8,0.17633e-02_r8 /) + kbo(:, 1,31, 8) = (/ & + & 0.24186e-03_r8,0.11155e-02_r8,0.14353e-02_r8,0.15729e-02_r8,0.10232e-02_r8 /) + kbo(:, 2,31, 8) = (/ & + & 0.24189e-03_r8,0.12032e-02_r8,0.15739e-02_r8,0.17508e-02_r8,0.11498e-02_r8 /) + kbo(:, 3,31, 8) = (/ & + & 0.24130e-03_r8,0.12988e-02_r8,0.17296e-02_r8,0.19516e-02_r8,0.12942e-02_r8 /) + kbo(:, 4,31, 8) = (/ & + & 0.24025e-03_r8,0.14034e-02_r8,0.19030e-02_r8,0.21764e-02_r8,0.14594e-02_r8 /) + kbo(:, 5,31, 8) = (/ & + & 0.23866e-03_r8,0.15170e-02_r8,0.20940e-02_r8,0.24270e-02_r8,0.16471e-02_r8 /) + kbo(:, 1,32, 8) = (/ & + & 0.19811e-03_r8,0.99188e-03_r8,0.12914e-02_r8,0.14311e-02_r8,0.93157e-03_r8 /) + kbo(:, 2,32, 8) = (/ & + & 0.19799e-03_r8,0.10771e-02_r8,0.14282e-02_r8,0.16073e-02_r8,0.10562e-02_r8 /) + kbo(:, 3,32, 8) = (/ & + & 0.19741e-03_r8,0.11711e-02_r8,0.15828e-02_r8,0.18068e-02_r8,0.11999e-02_r8 /) + kbo(:, 4,32, 8) = (/ & + & 0.19645e-03_r8,0.12746e-02_r8,0.17559e-02_r8,0.20320e-02_r8,0.13654e-02_r8 /) + kbo(:, 5,32, 8) = (/ & + & 0.19503e-03_r8,0.13871e-02_r8,0.19473e-02_r8,0.22851e-02_r8,0.15533e-02_r8 /) + kbo(:, 1,33, 8) = (/ & + & 0.16225e-03_r8,0.88803e-03_r8,0.11717e-02_r8,0.13138e-02_r8,0.85556e-03_r8 /) + kbo(:, 2,33, 8) = (/ & + & 0.16205e-03_r8,0.97174e-03_r8,0.13077e-02_r8,0.14890e-02_r8,0.97930e-03_r8 /) + kbo(:, 3,33, 8) = (/ & + & 0.16148e-03_r8,0.10648e-02_r8,0.14621e-02_r8,0.16891e-02_r8,0.11237e-02_r8 /) + kbo(:, 4,33, 8) = (/ & + & 0.16059e-03_r8,0.11673e-02_r8,0.16357e-02_r8,0.19165e-02_r8,0.12896e-02_r8 /) + kbo(:, 5,33, 8) = (/ & + & 0.15934e-03_r8,0.12795e-02_r8,0.18288e-02_r8,0.21736e-02_r8,0.14791e-02_r8 /) + kbo(:, 1,34, 8) = (/ & + & 0.13286e-03_r8,0.79835e-03_r8,0.10683e-02_r8,0.12117e-02_r8,0.78908e-03_r8 /) + kbo(:, 2,34, 8) = (/ & + & 0.13261e-03_r8,0.88066e-03_r8,0.12036e-02_r8,0.13865e-02_r8,0.91252e-03_r8 /) + kbo(:, 3,34, 8) = (/ & + & 0.13209e-03_r8,0.97270e-03_r8,0.13580e-02_r8,0.15871e-02_r8,0.10570e-02_r8 /) + kbo(:, 4,34, 8) = (/ & + & 0.13130e-03_r8,0.10748e-02_r8,0.15318e-02_r8,0.18171e-02_r8,0.12236e-02_r8 /) + kbo(:, 5,34, 8) = (/ & + & 0.13022e-03_r8,0.11866e-02_r8,0.17264e-02_r8,0.20786e-02_r8,0.14148e-02_r8 /) + kbo(:, 1,35, 8) = (/ & + & 0.10879e-03_r8,0.71567e-03_r8,0.97075e-03_r8,0.11118e-02_r8,0.72353e-03_r8 /) + kbo(:, 2,35, 8) = (/ & + & 0.10855e-03_r8,0.79625e-03_r8,0.11041e-02_r8,0.12845e-02_r8,0.84540e-03_r8 /) + kbo(:, 3,35, 8) = (/ & + & 0.10811e-03_r8,0.88686e-03_r8,0.12569e-02_r8,0.14847e-02_r8,0.98831e-03_r8 /) + kbo(:, 4,35, 8) = (/ & + & 0.10743e-03_r8,0.98761e-03_r8,0.14300e-02_r8,0.17157e-02_r8,0.11541e-02_r8 /) + kbo(:, 5,35, 8) = (/ & + & 0.10650e-03_r8,0.10987e-02_r8,0.16251e-02_r8,0.19799e-02_r8,0.13460e-02_r8 /) + kbo(:, 1,36, 8) = (/ & + & 0.89091e-04_r8,0.63773e-03_r8,0.87525e-03_r8,0.10106e-02_r8,0.65643e-03_r8 /) + kbo(:, 2,36, 8) = (/ & + & 0.88892e-04_r8,0.71572e-03_r8,0.10050e-02_r8,0.11794e-02_r8,0.77482e-03_r8 /) + kbo(:, 3,36, 8) = (/ & + & 0.88510e-04_r8,0.80390e-03_r8,0.11544e-02_r8,0.13768e-02_r8,0.91437e-03_r8 /) + kbo(:, 4,36, 8) = (/ & + & 0.87951e-04_r8,0.90253e-03_r8,0.13255e-02_r8,0.16063e-02_r8,0.10779e-02_r8 /) + kbo(:, 5,36, 8) = (/ & + & 0.87175e-04_r8,0.10120e-02_r8,0.15187e-02_r8,0.18703e-02_r8,0.12677e-02_r8 /) + kbo(:, 1,37, 8) = (/ & + & 0.72967e-04_r8,0.56051e-03_r8,0.77586e-03_r8,0.90139e-03_r8,0.58319e-03_r8 /) + kbo(:, 2,37, 8) = (/ & + & 0.72818e-04_r8,0.63459e-03_r8,0.89962e-03_r8,0.10627e-02_r8,0.69545e-03_r8 /) + kbo(:, 3,37, 8) = (/ & + & 0.72523e-04_r8,0.71909e-03_r8,0.10433e-02_r8,0.12533e-02_r8,0.82896e-03_r8 /) + kbo(:, 4,37, 8) = (/ & + & 0.72087e-04_r8,0.81427e-03_r8,0.12092e-02_r8,0.14766e-02_r8,0.98671e-03_r8 /) + kbo(:, 5,37, 8) = (/ & + & 0.71486e-04_r8,0.92093e-03_r8,0.13977e-02_r8,0.17355e-02_r8,0.11708e-02_r8 /) + kbo(:, 1,38, 8) = (/ & + & 0.59765e-04_r8,0.49320e-03_r8,0.68844e-03_r8,0.80478e-03_r8,0.51849e-03_r8 /) + kbo(:, 2,38, 8) = (/ & + & 0.59660e-04_r8,0.56354e-03_r8,0.80640e-03_r8,0.95876e-03_r8,0.62466e-03_r8 /) + kbo(:, 3,38, 8) = (/ & + & 0.59436e-04_r8,0.64440e-03_r8,0.94454e-03_r8,0.11426e-02_r8,0.75236e-03_r8 /) + kbo(:, 4,38, 8) = (/ & + & 0.59102e-04_r8,0.73631e-03_r8,0.11052e-02_r8,0.13599e-02_r8,0.90433e-03_r8 /) + kbo(:, 5,38, 8) = (/ & + & 0.58635e-04_r8,0.84009e-03_r8,0.12891e-02_r8,0.16134e-02_r8,0.10829e-02_r8 /) + kbo(:, 1,39, 8) = (/ & + & 0.48956e-04_r8,0.43499e-03_r8,0.61231e-03_r8,0.72017e-03_r8,0.46189e-03_r8 /) + kbo(:, 2,39, 8) = (/ & + & 0.48890e-04_r8,0.50181e-03_r8,0.72478e-03_r8,0.86730e-03_r8,0.56244e-03_r8 /) + kbo(:, 3,39, 8) = (/ & + & 0.48717e-04_r8,0.57923e-03_r8,0.85778e-03_r8,0.10448e-02_r8,0.68464e-03_r8 /) + kbo(:, 4,39, 8) = (/ & + & 0.48451e-04_r8,0.66799e-03_r8,0.10132e-02_r8,0.12563e-02_r8,0.83112e-03_r8 /) + kbo(:, 5,39, 8) = (/ & + & 0.48085e-04_r8,0.76898e-03_r8,0.11928e-02_r8,0.15047e-02_r8,0.10044e-02_r8 /) + kbo(:, 1,40, 8) = (/ & + & 0.40107e-04_r8,0.37860e-03_r8,0.53596e-03_r8,0.63302e-03_r8,0.40350e-03_r8 /) + kbo(:, 2,40, 8) = (/ & + & 0.40068e-04_r8,0.44099e-03_r8,0.64126e-03_r8,0.77105e-03_r8,0.49697e-03_r8 /) + kbo(:, 3,40, 8) = (/ & + & 0.39945e-04_r8,0.51399e-03_r8,0.76694e-03_r8,0.93934e-03_r8,0.61166e-03_r8 /) + kbo(:, 4,40, 8) = (/ & + & 0.39752e-04_r8,0.59851e-03_r8,0.91528e-03_r8,0.11416e-02_r8,0.75037e-03_r8 /) + kbo(:, 5,40, 8) = (/ & + & 0.39469e-04_r8,0.69544e-03_r8,0.10880e-02_r8,0.13809e-02_r8,0.91593e-03_r8 /) + kbo(:, 1,41, 8) = (/ & + & 0.32851e-04_r8,0.32878e-03_r8,0.46786e-03_r8,0.55469e-03_r8,0.35120e-03_r8 /) + kbo(:, 2,41, 8) = (/ & + & 0.32839e-04_r8,0.38683e-03_r8,0.56607e-03_r8,0.68394e-03_r8,0.43769e-03_r8 /) + kbo(:, 3,41, 8) = (/ & + & 0.32749e-04_r8,0.45542e-03_r8,0.68444e-03_r8,0.84259e-03_r8,0.54490e-03_r8 /) + kbo(:, 4,41, 8) = (/ & + & 0.32607e-04_r8,0.53564e-03_r8,0.82547e-03_r8,0.10352e-02_r8,0.67585e-03_r8 /) + kbo(:, 5,41, 8) = (/ & + & 0.32395e-04_r8,0.62841e-03_r8,0.99133e-03_r8,0.12652e-02_r8,0.83332e-03_r8 /) + kbo(:, 1,42, 8) = (/ & + & 0.26906e-04_r8,0.28534e-03_r8,0.40805e-03_r8,0.48535e-03_r8,0.30526e-03_r8 /) + kbo(:, 2,42, 8) = (/ & + & 0.26908e-04_r8,0.33922e-03_r8,0.49950e-03_r8,0.60603e-03_r8,0.38505e-03_r8 /) + kbo(:, 3,42, 8) = (/ & + & 0.26846e-04_r8,0.40361e-03_r8,0.61076e-03_r8,0.75564e-03_r8,0.48524e-03_r8 /) + kbo(:, 4,42, 8) = (/ & + & 0.26739e-04_r8,0.47953e-03_r8,0.74454e-03_r8,0.93882e-03_r8,0.60861e-03_r8 /) + kbo(:, 5,42, 8) = (/ & + & 0.26585e-04_r8,0.56816e-03_r8,0.90363e-03_r8,0.11597e-02_r8,0.75829e-03_r8 /) + kbo(:, 1,43, 8) = (/ & + & 0.22034e-04_r8,0.24494e-03_r8,0.35126e-03_r8,0.41862e-03_r8,0.26133e-03_r8 /) + kbo(:, 2,43, 8) = (/ & + & 0.22045e-04_r8,0.29428e-03_r8,0.43526e-03_r8,0.52960e-03_r8,0.33379e-03_r8 /) + kbo(:, 3,43, 8) = (/ & + & 0.22009e-04_r8,0.35394e-03_r8,0.53838e-03_r8,0.66893e-03_r8,0.42599e-03_r8 /) + kbo(:, 4,43, 8) = (/ & + & 0.21933e-04_r8,0.42510e-03_r8,0.66392e-03_r8,0.84090e-03_r8,0.54061e-03_r8 /) + kbo(:, 5,43, 8) = (/ & + & 0.21820e-04_r8,0.50878e-03_r8,0.81474e-03_r8,0.10503e-02_r8,0.68139e-03_r8 /) + kbo(:, 1,44, 8) = (/ & + & 0.18042e-04_r8,0.20878e-03_r8,0.29988e-03_r8,0.35782e-03_r8,0.22160e-03_r8 /) + kbo(:, 2,44, 8) = (/ & + & 0.18058e-04_r8,0.25360e-03_r8,0.37621e-03_r8,0.45875e-03_r8,0.28670e-03_r8 /) + kbo(:, 3,44, 8) = (/ & + & 0.18041e-04_r8,0.30845e-03_r8,0.47123e-03_r8,0.58727e-03_r8,0.37070e-03_r8 /) + kbo(:, 4,44, 8) = (/ & + & 0.17989e-04_r8,0.37459e-03_r8,0.58804e-03_r8,0.74739e-03_r8,0.47650e-03_r8 /) + kbo(:, 5,44, 8) = (/ & + & 0.17906e-04_r8,0.45317e-03_r8,0.73003e-03_r8,0.94454e-03_r8,0.60768e-03_r8 /) + kbo(:, 1,45, 8) = (/ & + & 0.14770e-04_r8,0.17743e-03_r8,0.25518e-03_r8,0.30461e-03_r8,0.18718e-03_r8 /) + kbo(:, 2,45, 8) = (/ & + & 0.14790e-04_r8,0.21794e-03_r8,0.32424e-03_r8,0.39603e-03_r8,0.24534e-03_r8 /) + kbo(:, 3,45, 8) = (/ & + & 0.14785e-04_r8,0.26822e-03_r8,0.41132e-03_r8,0.51406e-03_r8,0.32158e-03_r8 /) + kbo(:, 4,45, 8) = (/ & + & 0.14751e-04_r8,0.32948e-03_r8,0.51968e-03_r8,0.66288e-03_r8,0.41889e-03_r8 /) + kbo(:, 5,45, 8) = (/ & + & 0.14692e-04_r8,0.40309e-03_r8,0.65298e-03_r8,0.84795e-03_r8,0.54078e-03_r8 /) + kbo(:, 1,46, 8) = (/ & + & 0.12091e-04_r8,0.14956e-03_r8,0.21507e-03_r8,0.25664e-03_r8,0.15641e-03_r8 /) + kbo(:, 2,46, 8) = (/ & + & 0.12112e-04_r8,0.18585e-03_r8,0.27689e-03_r8,0.33853e-03_r8,0.20778e-03_r8 /) + kbo(:, 3,46, 8) = (/ & + & 0.12113e-04_r8,0.23156e-03_r8,0.35597e-03_r8,0.44575e-03_r8,0.27619e-03_r8 /) + kbo(:, 4,46, 8) = (/ & + & 0.12094e-04_r8,0.28789e-03_r8,0.45576e-03_r8,0.58313e-03_r8,0.36492e-03_r8 /) + kbo(:, 5,46, 8) = (/ & + & 0.12054e-04_r8,0.35628e-03_r8,0.57980e-03_r8,0.75523e-03_r8,0.47721e-03_r8 /) + kbo(:, 1,47, 8) = (/ & + & 0.98958e-05_r8,0.12436e-03_r8,0.17838e-03_r8,0.21241e-03_r8,0.12841e-03_r8 /) + kbo(:, 2,47, 8) = (/ & + & 0.99157e-05_r8,0.15633e-03_r8,0.23279e-03_r8,0.28443e-03_r8,0.17291e-03_r8 /) + kbo(:, 3,47, 8) = (/ & + & 0.99224e-05_r8,0.19724e-03_r8,0.30350e-03_r8,0.38017e-03_r8,0.23323e-03_r8 /) + kbo(:, 4,47, 8) = (/ & + & 0.99150e-05_r8,0.24831e-03_r8,0.39396e-03_r8,0.50488e-03_r8,0.31274e-03_r8 /) + kbo(:, 5,47, 8) = (/ & + & 0.98881e-05_r8,0.31110e-03_r8,0.50788e-03_r8,0.66304e-03_r8,0.41485e-03_r8 /) + kbo(:, 1,48, 8) = (/ & + & 0.80981e-05_r8,0.10284e-03_r8,0.14701e-03_r8,0.17457e-03_r8,0.10464e-03_r8 /) + kbo(:, 2,48, 8) = (/ & + & 0.81170e-05_r8,0.13083e-03_r8,0.19452e-03_r8,0.23734e-03_r8,0.14298e-03_r8 /) + kbo(:, 3,48, 8) = (/ & + & 0.81254e-05_r8,0.16716e-03_r8,0.25727e-03_r8,0.32230e-03_r8,0.19565e-03_r8 /) + kbo(:, 4,48, 8) = (/ & + & 0.81253e-05_r8,0.21328e-03_r8,0.33887e-03_r8,0.43475e-03_r8,0.26652e-03_r8 /) + kbo(:, 5,48, 8) = (/ & + & 0.81092e-05_r8,0.27062e-03_r8,0.44301e-03_r8,0.57972e-03_r8,0.35887e-03_r8 /) + kbo(:, 1,49, 8) = (/ & + & 0.66262e-05_r8,0.84542e-04_r8,0.12034e-03_r8,0.14245e-03_r8,0.84636e-04_r8 /) + kbo(:, 2,49, 8) = (/ & + & 0.66435e-05_r8,0.10903e-03_r8,0.16168e-03_r8,0.19686e-03_r8,0.11740e-03_r8 /) + kbo(:, 3,49, 8) = (/ & + & 0.66527e-05_r8,0.14092e-03_r8,0.21685e-03_r8,0.27156e-03_r8,0.16309e-03_r8 /) + kbo(:, 4,49, 8) = (/ & + & 0.66567e-05_r8,0.18229e-03_r8,0.28989e-03_r8,0.37214e-03_r8,0.22572e-03_r8 /) + kbo(:, 5,49, 8) = (/ & + & 0.66489e-05_r8,0.23443e-03_r8,0.38461e-03_r8,0.50418e-03_r8,0.30883e-03_r8 /) + kbo(:, 1,50, 8) = (/ & + & 0.54202e-05_r8,0.69608e-04_r8,0.98680e-04_r8,0.11646e-03_r8,0.68510e-04_r8 /) + kbo(:, 2,50, 8) = (/ & + & 0.54374e-05_r8,0.90802e-04_r8,0.13434e-03_r8,0.16330e-03_r8,0.96499e-04_r8 /) + kbo(:, 3,50, 8) = (/ & + & 0.54475e-05_r8,0.11916e-03_r8,0.18327e-03_r8,0.22932e-03_r8,0.13620e-03_r8 /) + kbo(:, 4,50, 8) = (/ & + & 0.54521e-05_r8,0.15608e-03_r8,0.24845e-03_r8,0.31928e-03_r8,0.19154e-03_r8 /) + kbo(:, 5,50, 8) = (/ & + & 0.54498e-05_r8,0.20348e-03_r8,0.33466e-03_r8,0.43937e-03_r8,0.26626e-03_r8 /) + kbo(:, 1,51, 8) = (/ & + & 0.44351e-05_r8,0.57088e-04_r8,0.80582e-04_r8,0.94790e-04_r8,0.55250e-04_r8 /) + kbo(:, 2,51, 8) = (/ & + & 0.44504e-05_r8,0.75435e-04_r8,0.11131e-03_r8,0.13503e-03_r8,0.79024e-04_r8 /) + kbo(:, 3,51, 8) = (/ & + & 0.44599e-05_r8,0.10037e-03_r8,0.15428e-03_r8,0.19291e-03_r8,0.11343e-03_r8 /) + kbo(:, 4,51, 8) = (/ & + & 0.44651e-05_r8,0.13336e-03_r8,0.21252e-03_r8,0.27335e-03_r8,0.16218e-03_r8 /) + kbo(:, 5,51, 8) = (/ & + & 0.44653e-05_r8,0.17640e-03_r8,0.29075e-03_r8,0.38229e-03_r8,0.22923e-03_r8 /) + kbo(:, 1,52, 8) = (/ & + & 0.36290e-05_r8,0.46565e-04_r8,0.65364e-04_r8,0.76598e-04_r8,0.44240e-04_r8 /) + kbo(:, 2,52, 8) = (/ & + & 0.36420e-05_r8,0.62314e-04_r8,0.91644e-04_r8,0.11090e-03_r8,0.64234e-04_r8 /) + kbo(:, 3,52, 8) = (/ & + & 0.36509e-05_r8,0.84102e-04_r8,0.12910e-03_r8,0.16125e-03_r8,0.93833e-04_r8 /) + kbo(:, 4,52, 8) = (/ & + & 0.36555e-05_r8,0.11362e-03_r8,0.18115e-03_r8,0.23297e-03_r8,0.13657e-03_r8 /) + kbo(:, 5,52, 8) = (/ & + & 0.36579e-05_r8,0.15226e-03_r8,0.25136e-03_r8,0.33099e-03_r8,0.19621e-03_r8 /) + kbo(:, 1,53, 8) = (/ & + & 0.29692e-05_r8,0.37746e-04_r8,0.52632e-04_r8,0.61397e-04_r8,0.35165e-04_r8 /) + kbo(:, 2,53, 8) = (/ & + & 0.29808e-05_r8,0.51149e-04_r8,0.74879e-04_r8,0.90335e-04_r8,0.51807e-04_r8 /) + kbo(:, 3,53, 8) = (/ & + & 0.29880e-05_r8,0.70028e-04_r8,0.10724e-03_r8,0.13375e-03_r8,0.77010e-04_r8 /) + kbo(:, 4,53, 8) = (/ & + & 0.29931e-05_r8,0.96105e-04_r8,0.15314e-03_r8,0.19689e-03_r8,0.11417e-03_r8 /) + kbo(:, 5,53, 8) = (/ & + & 0.29959e-05_r8,0.13074e-03_r8,0.21612e-03_r8,0.28492e-03_r8,0.16697e-03_r8 /) + kbo(:, 1,54, 8) = (/ & + & 0.24296e-05_r8,0.30698e-04_r8,0.42544e-04_r8,0.49406e-04_r8,0.28072e-04_r8 /) + kbo(:, 2,54, 8) = (/ & + & 0.24393e-05_r8,0.42122e-04_r8,0.61454e-04_r8,0.73927e-04_r8,0.41964e-04_r8 /) + kbo(:, 3,54, 8) = (/ & + & 0.24460e-05_r8,0.58528e-04_r8,0.89500e-04_r8,0.11146e-03_r8,0.63503e-04_r8 /) + kbo(:, 4,54, 8) = (/ & + & 0.24507e-05_r8,0.81611e-04_r8,0.13009e-03_r8,0.16728e-03_r8,0.95947e-04_r8 /) + kbo(:, 5,54, 8) = (/ & + & 0.24535e-05_r8,0.11276e-03_r8,0.18682e-03_r8,0.24654e-03_r8,0.14286e-03_r8 /) + kbo(:, 1,55, 8) = (/ & + & 0.19883e-05_r8,0.24921e-04_r8,0.34312e-04_r8,0.39666e-04_r8,0.22375e-04_r8 /) + kbo(:, 2,55, 8) = (/ & + & 0.19963e-05_r8,0.34641e-04_r8,0.50344e-04_r8,0.60381e-04_r8,0.33942e-04_r8 /) + kbo(:, 3,55, 8) = (/ & + & 0.20020e-05_r8,0.48868e-04_r8,0.74618e-04_r8,0.92809e-04_r8,0.52280e-04_r8 /) + kbo(:, 4,55, 8) = (/ & + & 0.20065e-05_r8,0.69255e-04_r8,0.11042e-03_r8,0.14203e-03_r8,0.80566e-04_r8 /) + kbo(:, 5,55, 8) = (/ & + & 0.20089e-05_r8,0.97527e-04_r8,0.16182e-03_r8,0.21373e-03_r8,0.12228e-03_r8 /) + kbo(:, 1,56, 8) = (/ & + & 0.16268e-05_r8,0.20122e-04_r8,0.27506e-04_r8,0.31629e-04_r8,0.17718e-04_r8 /) + kbo(:, 2,56, 8) = (/ & + & 0.16337e-05_r8,0.28321e-04_r8,0.40966e-04_r8,0.48960e-04_r8,0.27271e-04_r8 /) + kbo(:, 3,56, 8) = (/ & + & 0.16385e-05_r8,0.40579e-04_r8,0.61828e-04_r8,0.76747e-04_r8,0.42739e-04_r8 /) + kbo(:, 4,56, 8) = (/ & + & 0.16424e-05_r8,0.58490e-04_r8,0.93220e-04_r8,0.11991e-03_r8,0.67232e-04_r8 /) + kbo(:, 5,56, 8) = (/ & + & 0.16450e-05_r8,0.83776e-04_r8,0.13917e-03_r8,0.18401e-03_r8,0.10406e-03_r8 /) + kbo(:, 1,57, 8) = (/ & + & 0.13311e-05_r8,0.16151e-04_r8,0.21901e-04_r8,0.25044e-04_r8,0.13934e-04_r8 /) + kbo(:, 2,57, 8) = (/ & + & 0.13369e-05_r8,0.23005e-04_r8,0.33083e-04_r8,0.39377e-04_r8,0.21751e-04_r8 /) + kbo(:, 3,57, 8) = (/ & + & 0.13411e-05_r8,0.33501e-04_r8,0.50888e-04_r8,0.63014e-04_r8,0.34696e-04_r8 /) + kbo(:, 4,57, 8) = (/ & + & 0.13443e-05_r8,0.49111e-04_r8,0.78191e-04_r8,0.10051e-03_r8,0.55711e-04_r8 /) + kbo(:, 5,57, 8) = (/ & + & 0.13467e-05_r8,0.71586e-04_r8,0.11902e-03_r8,0.15744e-03_r8,0.88025e-04_r8 /) + kbo(:, 1,58, 8) = (/ & + & 0.10892e-05_r8,0.12962e-04_r8,0.17443e-04_r8,0.19825e-04_r8,0.10955e-04_r8 /) + kbo(:, 2,58, 8) = (/ & + & 0.10942e-05_r8,0.18688e-04_r8,0.26716e-04_r8,0.31664e-04_r8,0.17348e-04_r8 /) + kbo(:, 3,58, 8) = (/ & + & 0.10976e-05_r8,0.27650e-04_r8,0.41864e-04_r8,0.51716e-04_r8,0.28159e-04_r8 /) + kbo(:, 4,58, 8) = (/ & + & 0.11004e-05_r8,0.41251e-04_r8,0.65630e-04_r8,0.84299e-04_r8,0.46156e-04_r8 /) + kbo(:, 5,58, 8) = (/ & + & 0.11025e-05_r8,0.61261e-04_r8,0.10196e-03_r8,0.13496e-03_r8,0.74536e-04_r8 /) + kbo(:, 1,59, 8) = (/ & + & 0.89197e-06_r8,0.11047e-04_r8,0.14899e-04_r8,0.16964e-04_r8,0.92999e-05_r8 /) + kbo(:, 2,59, 8) = (/ & + & 0.89605e-06_r8,0.16215e-04_r8,0.23291e-04_r8,0.27686e-04_r8,0.15019e-04_r8 /) + kbo(:, 3,59, 8) = (/ & + & 0.89875e-06_r8,0.24462e-04_r8,0.37267e-04_r8,0.46243e-04_r8,0.24905e-04_r8 /) + kbo(:, 4,59, 8) = (/ & + & 0.90117e-06_r8,0.37175e-04_r8,0.59594e-04_r8,0.76969e-04_r8,0.41672e-04_r8 /) + kbo(:, 5,59, 8) = (/ & + & 0.90310e-06_r8,0.56115e-04_r8,0.94187e-04_r8,0.12528e-03_r8,0.68497e-04_r8 /) + kbo(:, 1,13, 9) = (/ & + & 0.56714e-01_r8,0.96228e-01_r8,0.10961e+00_r8,0.11078e+00_r8,0.82822e-01_r8 /) + kbo(:, 2,13, 9) = (/ & + & 0.57828e-01_r8,0.97972e-01_r8,0.11123e+00_r8,0.11236e+00_r8,0.84782e-01_r8 /) + kbo(:, 3,13, 9) = (/ & + & 0.59232e-01_r8,0.99998e-01_r8,0.11329e+00_r8,0.11400e+00_r8,0.86728e-01_r8 /) + kbo(:, 4,13, 9) = (/ & + & 0.60790e-01_r8,0.10219e+00_r8,0.11568e+00_r8,0.11591e+00_r8,0.88651e-01_r8 /) + kbo(:, 5,13, 9) = (/ & + & 0.62290e-01_r8,0.10448e+00_r8,0.11818e+00_r8,0.11808e+00_r8,0.90606e-01_r8 /) + kbo(:, 1,14, 9) = (/ & + & 0.48757e-01_r8,0.85742e-01_r8,0.97473e-01_r8,0.98306e-01_r8,0.73073e-01_r8 /) + kbo(:, 2,14, 9) = (/ & + & 0.49942e-01_r8,0.87692e-01_r8,0.99489e-01_r8,0.10004e+00_r8,0.75064e-01_r8 /) + kbo(:, 3,14, 9) = (/ & + & 0.51318e-01_r8,0.89856e-01_r8,0.10188e+00_r8,0.10205e+00_r8,0.77018e-01_r8 /) + kbo(:, 4,14, 9) = (/ & + & 0.52660e-01_r8,0.92153e-01_r8,0.10444e+00_r8,0.10434e+00_r8,0.78996e-01_r8 /) + kbo(:, 5,14, 9) = (/ & + & 0.53901e-01_r8,0.94584e-01_r8,0.10712e+00_r8,0.10687e+00_r8,0.81028e-01_r8 /) + kbo(:, 1,15, 9) = (/ & + & 0.41752e-01_r8,0.76198e-01_r8,0.86593e-01_r8,0.87037e-01_r8,0.64464e-01_r8 /) + kbo(:, 2,15, 9) = (/ & + & 0.42945e-01_r8,0.78277e-01_r8,0.88919e-01_r8,0.89055e-01_r8,0.66440e-01_r8 /) + kbo(:, 3,15, 9) = (/ & + & 0.44132e-01_r8,0.80544e-01_r8,0.91468e-01_r8,0.91397e-01_r8,0.68401e-01_r8 /) + kbo(:, 4,15, 9) = (/ & + & 0.45260e-01_r8,0.82968e-01_r8,0.94189e-01_r8,0.93993e-01_r8,0.70410e-01_r8 /) + kbo(:, 5,15, 9) = (/ & + & 0.46298e-01_r8,0.85502e-01_r8,0.97029e-01_r8,0.96802e-01_r8,0.72466e-01_r8 /) + kbo(:, 1,16, 9) = (/ & + & 0.35640e-01_r8,0.67555e-01_r8,0.76928e-01_r8,0.77126e-01_r8,0.56847e-01_r8 /) + kbo(:, 2,16, 9) = (/ & + & 0.36668e-01_r8,0.69730e-01_r8,0.79394e-01_r8,0.79411e-01_r8,0.58796e-01_r8 /) + kbo(:, 3,16, 9) = (/ & + & 0.37665e-01_r8,0.72105e-01_r8,0.82070e-01_r8,0.81996e-01_r8,0.60763e-01_r8 /) + kbo(:, 4,16, 9) = (/ & + & 0.38606e-01_r8,0.74641e-01_r8,0.84920e-01_r8,0.84810e-01_r8,0.62792e-01_r8 /) + kbo(:, 5,16, 9) = (/ & + & 0.39473e-01_r8,0.77118e-01_r8,0.87904e-01_r8,0.87777e-01_r8,0.64884e-01_r8 /) + kbo(:, 1,17, 9) = (/ & + & 0.30249e-01_r8,0.59768e-01_r8,0.68325e-01_r8,0.68492e-01_r8,0.50101e-01_r8 /) + kbo(:, 2,17, 9) = (/ & + & 0.31103e-01_r8,0.62060e-01_r8,0.70903e-01_r8,0.70988e-01_r8,0.52022e-01_r8 /) + kbo(:, 3,17, 9) = (/ & + & 0.31936e-01_r8,0.64534e-01_r8,0.73696e-01_r8,0.73735e-01_r8,0.54005e-01_r8 /) + kbo(:, 4,17, 9) = (/ & + & 0.32730e-01_r8,0.67029e-01_r8,0.76655e-01_r8,0.76665e-01_r8,0.56059e-01_r8 /) + kbo(:, 5,17, 9) = (/ & + & 0.33443e-01_r8,0.69449e-01_r8,0.79757e-01_r8,0.79742e-01_r8,0.58173e-01_r8 /) + kbo(:, 1,18, 9) = (/ & + & 0.25545e-01_r8,0.52871e-01_r8,0.60740e-01_r8,0.60992e-01_r8,0.44172e-01_r8 /) + kbo(:, 2,18, 9) = (/ & + & 0.26254e-01_r8,0.55233e-01_r8,0.63406e-01_r8,0.63637e-01_r8,0.46086e-01_r8 /) + kbo(:, 3,18, 9) = (/ & + & 0.26956e-01_r8,0.57692e-01_r8,0.66286e-01_r8,0.66462e-01_r8,0.48089e-01_r8 /) + kbo(:, 4,18, 9) = (/ & + & 0.27612e-01_r8,0.60136e-01_r8,0.69343e-01_r8,0.69465e-01_r8,0.50154e-01_r8 /) + kbo(:, 5,18, 9) = (/ & + & 0.28200e-01_r8,0.62534e-01_r8,0.72542e-01_r8,0.72608e-01_r8,0.52275e-01_r8 /) + kbo(:, 1,19, 9) = (/ & + & 0.21487e-01_r8,0.46786e-01_r8,0.54092e-01_r8,0.54451e-01_r8,0.38986e-01_r8 /) + kbo(:, 2,19, 9) = (/ & + & 0.22086e-01_r8,0.49151e-01_r8,0.56837e-01_r8,0.57167e-01_r8,0.40916e-01_r8 /) + kbo(:, 3,19, 9) = (/ & + & 0.22671e-01_r8,0.51565e-01_r8,0.59787e-01_r8,0.60059e-01_r8,0.42916e-01_r8 /) + kbo(:, 4,19, 9) = (/ & + & 0.23212e-01_r8,0.53966e-01_r8,0.62913e-01_r8,0.63134e-01_r8,0.44993e-01_r8 /) + kbo(:, 5,19, 9) = (/ & + & 0.23674e-01_r8,0.56335e-01_r8,0.66121e-01_r8,0.66362e-01_r8,0.47140e-01_r8 /) + kbo(:, 1,20, 9) = (/ & + & 0.18039e-01_r8,0.41493e-01_r8,0.48348e-01_r8,0.48783e-01_r8,0.34522e-01_r8 /) + kbo(:, 2,20, 9) = (/ & + & 0.18543e-01_r8,0.43801e-01_r8,0.51155e-01_r8,0.51541e-01_r8,0.36457e-01_r8 /) + kbo(:, 3,20, 9) = (/ & + & 0.19027e-01_r8,0.46166e-01_r8,0.54164e-01_r8,0.54503e-01_r8,0.38468e-01_r8 /) + kbo(:, 4,20, 9) = (/ & + & 0.19452e-01_r8,0.48538e-01_r8,0.57292e-01_r8,0.57654e-01_r8,0.40551e-01_r8 /) + kbo(:, 5,20, 9) = (/ & + & 0.19805e-01_r8,0.50879e-01_r8,0.60490e-01_r8,0.60969e-01_r8,0.42726e-01_r8 /) + kbo(:, 1,21, 9) = (/ & + & 0.15116e-01_r8,0.36867e-01_r8,0.43373e-01_r8,0.43860e-01_r8,0.30692e-01_r8 /) + kbo(:, 2,21, 9) = (/ & + & 0.15537e-01_r8,0.39121e-01_r8,0.46234e-01_r8,0.46663e-01_r8,0.32616e-01_r8 /) + kbo(:, 3,21, 9) = (/ & + & 0.15924e-01_r8,0.41438e-01_r8,0.49238e-01_r8,0.49692e-01_r8,0.34628e-01_r8 /) + kbo(:, 4,21, 9) = (/ & + & 0.16258e-01_r8,0.43774e-01_r8,0.52361e-01_r8,0.52910e-01_r8,0.36736e-01_r8 /) + kbo(:, 5,21, 9) = (/ & + & 0.16525e-01_r8,0.46101e-01_r8,0.55542e-01_r8,0.56309e-01_r8,0.38934e-01_r8 /) + kbo(:, 1,22, 9) = (/ & + & 0.12675e-01_r8,0.32993e-01_r8,0.39256e-01_r8,0.39779e-01_r8,0.27529e-01_r8 /) + kbo(:, 2,22, 9) = (/ & + & 0.13009e-01_r8,0.35201e-01_r8,0.42138e-01_r8,0.42658e-01_r8,0.29453e-01_r8 /) + kbo(:, 3,22, 9) = (/ & + & 0.13317e-01_r8,0.37474e-01_r8,0.45144e-01_r8,0.45756e-01_r8,0.31474e-01_r8 /) + kbo(:, 4,22, 9) = (/ & + & 0.13574e-01_r8,0.39784e-01_r8,0.48260e-01_r8,0.49049e-01_r8,0.33608e-01_r8 /) + kbo(:, 5,22, 9) = (/ & + & 0.13778e-01_r8,0.42099e-01_r8,0.51448e-01_r8,0.52529e-01_r8,0.35844e-01_r8 /) + kbo(:, 1,23, 9) = (/ & + & 0.10608e-01_r8,0.29677e-01_r8,0.35736e-01_r8,0.36323e-01_r8,0.24847e-01_r8 /) + kbo(:, 2,23, 9) = (/ & + & 0.10880e-01_r8,0.31843e-01_r8,0.38613e-01_r8,0.39274e-01_r8,0.26772e-01_r8 /) + kbo(:, 3,23, 9) = (/ & + & 0.11120e-01_r8,0.34081e-01_r8,0.41634e-01_r8,0.42440e-01_r8,0.28816e-01_r8 /) + kbo(:, 4,23, 9) = (/ & + & 0.11313e-01_r8,0.36372e-01_r8,0.44754e-01_r8,0.45808e-01_r8,0.30978e-01_r8 /) + kbo(:, 5,23, 9) = (/ & + & 0.11474e-01_r8,0.38689e-01_r8,0.47973e-01_r8,0.49367e-01_r8,0.33255e-01_r8 /) + kbo(:, 1,24, 9) = (/ & + & 0.88685e-02_r8,0.26862e-01_r8,0.32736e-01_r8,0.33437e-01_r8,0.22600e-01_r8 /) + kbo(:, 2,24, 9) = (/ & + & 0.90884e-02_r8,0.28994e-01_r8,0.35625e-01_r8,0.36451e-01_r8,0.24532e-01_r8 /) + kbo(:, 3,24, 9) = (/ & + & 0.92759e-02_r8,0.31210e-01_r8,0.38663e-01_r8,0.39696e-01_r8,0.26600e-01_r8 /) + kbo(:, 4,24, 9) = (/ & + & 0.94299e-02_r8,0.33488e-01_r8,0.41810e-01_r8,0.43137e-01_r8,0.28795e-01_r8 /) + kbo(:, 5,24, 9) = (/ & + & 0.95655e-02_r8,0.35810e-01_r8,0.45067e-01_r8,0.46765e-01_r8,0.31119e-01_r8 /) + kbo(:, 1,25, 9) = (/ & + & 0.74112e-02_r8,0.24493e-01_r8,0.30220e-01_r8,0.31056e-01_r8,0.20732e-01_r8 /) + kbo(:, 2,25, 9) = (/ & + & 0.75852e-02_r8,0.26600e-01_r8,0.33130e-01_r8,0.34139e-01_r8,0.22685e-01_r8 /) + kbo(:, 3,25, 9) = (/ & + & 0.77307e-02_r8,0.28805e-01_r8,0.36194e-01_r8,0.37461e-01_r8,0.24778e-01_r8 /) + kbo(:, 4,25, 9) = (/ & + & 0.78603e-02_r8,0.31085e-01_r8,0.39384e-01_r8,0.40978e-01_r8,0.27016e-01_r8 /) + kbo(:, 5,25, 9) = (/ & + & 0.79718e-02_r8,0.33416e-01_r8,0.42696e-01_r8,0.44682e-01_r8,0.29393e-01_r8 /) + kbo(:, 1,26, 9) = (/ & + & 0.61902e-02_r8,0.22538e-01_r8,0.28170e-01_r8,0.29154e-01_r8,0.19220e-01_r8 /) + kbo(:, 2,26, 9) = (/ & + & 0.63276e-02_r8,0.24632e-01_r8,0.31111e-01_r8,0.32321e-01_r8,0.21200e-01_r8 /) + kbo(:, 3,26, 9) = (/ & + & 0.64499e-02_r8,0.26835e-01_r8,0.34213e-01_r8,0.35713e-01_r8,0.23332e-01_r8 /) + kbo(:, 4,26, 9) = (/ & + & 0.65597e-02_r8,0.29126e-01_r8,0.37461e-01_r8,0.39319e-01_r8,0.25615e-01_r8 /) + kbo(:, 5,26, 9) = (/ & + & 0.66551e-02_r8,0.31472e-01_r8,0.40844e-01_r8,0.43117e-01_r8,0.28057e-01_r8 /) + kbo(:, 1,27, 9) = (/ & + & 0.51713e-02_r8,0.20911e-01_r8,0.26500e-01_r8,0.27639e-01_r8,0.17995e-01_r8 /) + kbo(:, 2,27, 9) = (/ & + & 0.52848e-02_r8,0.23004e-01_r8,0.29475e-01_r8,0.30887e-01_r8,0.20007e-01_r8 /) + kbo(:, 3,27, 9) = (/ & + & 0.53879e-02_r8,0.25219e-01_r8,0.32635e-01_r8,0.34364e-01_r8,0.22181e-01_r8 /) + kbo(:, 4,27, 9) = (/ & + & 0.54763e-02_r8,0.27525e-01_r8,0.35956e-01_r8,0.38064e-01_r8,0.24520e-01_r8 /) + kbo(:, 5,27, 9) = (/ & + & 0.55573e-02_r8,0.29889e-01_r8,0.39426e-01_r8,0.41977e-01_r8,0.27035e-01_r8 /) + kbo(:, 1,28, 9) = (/ & + & 0.43195e-02_r8,0.19576e-01_r8,0.25160e-01_r8,0.26468e-01_r8,0.17016e-01_r8 /) + kbo(:, 2,28, 9) = (/ & + & 0.44139e-02_r8,0.21680e-01_r8,0.28188e-01_r8,0.29800e-01_r8,0.19070e-01_r8 /) + kbo(:, 3,28, 9) = (/ & + & 0.44969e-02_r8,0.23912e-01_r8,0.31420e-01_r8,0.33375e-01_r8,0.21294e-01_r8 /) + kbo(:, 4,28, 9) = (/ & + & 0.45726e-02_r8,0.26235e-01_r8,0.34830e-01_r8,0.37186e-01_r8,0.23695e-01_r8 /) + kbo(:, 5,28, 9) = (/ & + & 0.46426e-02_r8,0.28627e-01_r8,0.38395e-01_r8,0.41222e-01_r8,0.26282e-01_r8 /) + kbo(:, 1,29, 9) = (/ & + & 0.36095e-02_r8,0.18508e-01_r8,0.24142e-01_r8,0.25625e-01_r8,0.16268e-01_r8 /) + kbo(:, 2,29, 9) = (/ & + & 0.36856e-02_r8,0.20634e-01_r8,0.27243e-01_r8,0.29053e-01_r8,0.18372e-01_r8 /) + kbo(:, 3,29, 9) = (/ & + & 0.37545e-02_r8,0.22890e-01_r8,0.30565e-01_r8,0.32742e-01_r8,0.20653e-01_r8 /) + kbo(:, 4,29, 9) = (/ & + & 0.38219e-02_r8,0.25246e-01_r8,0.34070e-01_r8,0.36676e-01_r8,0.23125e-01_r8 /) + kbo(:, 5,29, 9) = (/ & + & 0.38805e-02_r8,0.27676e-01_r8,0.37739e-01_r8,0.40837e-01_r8,0.25787e-01_r8 /) + kbo(:, 1,30, 9) = (/ & + & 0.30149e-02_r8,0.17668e-01_r8,0.23401e-01_r8,0.25061e-01_r8,0.15717e-01_r8 /) + kbo(:, 2,30, 9) = (/ & + & 0.30780e-02_r8,0.19823e-01_r8,0.26594e-01_r8,0.28602e-01_r8,0.17873e-01_r8 /) + kbo(:, 3,30, 9) = (/ & + & 0.31391e-02_r8,0.22111e-01_r8,0.30012e-01_r8,0.32409e-01_r8,0.20220e-01_r8 /) + kbo(:, 4,30, 9) = (/ & + & 0.31952e-02_r8,0.24511e-01_r8,0.33620e-01_r8,0.36467e-01_r8,0.22768e-01_r8 /) + kbo(:, 5,30, 9) = (/ & + & 0.32462e-02_r8,0.26992e-01_r8,0.37393e-01_r8,0.40756e-01_r8,0.25513e-01_r8 /) + kbo(:, 1,31, 9) = (/ & + & 0.25190e-02_r8,0.17039e-01_r8,0.22932e-01_r8,0.24769e-01_r8,0.15346e-01_r8 /) + kbo(:, 2,31, 9) = (/ & + & 0.25729e-02_r8,0.19232e-01_r8,0.26227e-01_r8,0.28432e-01_r8,0.17564e-01_r8 /) + kbo(:, 3,31, 9) = (/ & + & 0.26259e-02_r8,0.21567e-01_r8,0.29750e-01_r8,0.32369e-01_r8,0.19984e-01_r8 /) + kbo(:, 4,31, 9) = (/ & + & 0.26746e-02_r8,0.24020e-01_r8,0.33463e-01_r8,0.36549e-01_r8,0.22614e-01_r8 /) + kbo(:, 5,31, 9) = (/ & + & 0.27170e-02_r8,0.26556e-01_r8,0.37338e-01_r8,0.40957e-01_r8,0.25451e-01_r8 /) + kbo(:, 1,32, 9) = (/ & + & 0.21057e-02_r8,0.16597e-01_r8,0.22710e-01_r8,0.24723e-01_r8,0.15137e-01_r8 /) + kbo(:, 2,32, 9) = (/ & + & 0.21537e-02_r8,0.18840e-01_r8,0.26112e-01_r8,0.28512e-01_r8,0.17424e-01_r8 /) + kbo(:, 3,32, 9) = (/ & + & 0.21983e-02_r8,0.21233e-01_r8,0.29743e-01_r8,0.32575e-01_r8,0.19926e-01_r8 /) + kbo(:, 4,32, 9) = (/ & + & 0.22397e-02_r8,0.23745e-01_r8,0.33557e-01_r8,0.36873e-01_r8,0.22643e-01_r8 /) + kbo(:, 5,32, 9) = (/ & + & 0.22779e-02_r8,0.26339e-01_r8,0.37525e-01_r8,0.41395e-01_r8,0.25571e-01_r8 /) + kbo(:, 1,33, 9) = (/ & + & 0.17621e-02_r8,0.16326e-01_r8,0.22706e-01_r8,0.24894e-01_r8,0.15071e-01_r8 /) + kbo(:, 2,33, 9) = (/ & + & 0.18037e-02_r8,0.18626e-01_r8,0.26218e-01_r8,0.28807e-01_r8,0.17434e-01_r8 /) + kbo(:, 3,33, 9) = (/ & + & 0.18413e-02_r8,0.21083e-01_r8,0.29952e-01_r8,0.32989e-01_r8,0.20023e-01_r8 /) + kbo(:, 4,33, 9) = (/ & + & 0.18774e-02_r8,0.23655e-01_r8,0.33863e-01_r8,0.37400e-01_r8,0.22833e-01_r8 /) + kbo(:, 5,33, 9) = (/ & + & 0.19114e-02_r8,0.26308e-01_r8,0.37916e-01_r8,0.42025e-01_r8,0.25847e-01_r8 /) + kbo(:, 1,34, 9) = (/ & + & 0.14751e-02_r8,0.16125e-01_r8,0.22769e-01_r8,0.25117e-01_r8,0.15050e-01_r8 /) + kbo(:, 2,34, 9) = (/ & + & 0.15101e-02_r8,0.18488e-01_r8,0.26381e-01_r8,0.29139e-01_r8,0.17489e-01_r8 /) + kbo(:, 3,34, 9) = (/ & + & 0.15432e-02_r8,0.21005e-01_r8,0.30205e-01_r8,0.33424e-01_r8,0.20158e-01_r8 /) + kbo(:, 4,34, 9) = (/ & + & 0.15747e-02_r8,0.23633e-01_r8,0.34198e-01_r8,0.37931e-01_r8,0.23050e-01_r8 /) + kbo(:, 5,34, 9) = (/ & + & 0.16051e-02_r8,0.26339e-01_r8,0.38321e-01_r8,0.42642e-01_r8,0.26140e-01_r8 /) + kbo(:, 1,35, 9) = (/ & + & 0.12323e-02_r8,0.15834e-01_r8,0.22646e-01_r8,0.25106e-01_r8,0.14908e-01_r8 /) + kbo(:, 2,35, 9) = (/ & + & 0.12626e-02_r8,0.18245e-01_r8,0.26331e-01_r8,0.29206e-01_r8,0.17403e-01_r8 /) + kbo(:, 3,35, 9) = (/ & + & 0.12919e-02_r8,0.20808e-01_r8,0.30221e-01_r8,0.33562e-01_r8,0.20132e-01_r8 /) + kbo(:, 4,35, 9) = (/ & + & 0.13197e-02_r8,0.23481e-01_r8,0.34270e-01_r8,0.38136e-01_r8,0.23081e-01_r8 /) + kbo(:, 5,35, 9) = (/ & + & 0.13470e-02_r8,0.26228e-01_r8,0.38442e-01_r8,0.42907e-01_r8,0.26222e-01_r8 /) + kbo(:, 1,36, 9) = (/ & + & 0.10273e-02_r8,0.15393e-01_r8,0.22247e-01_r8,0.24766e-01_r8,0.14589e-01_r8 /) + kbo(:, 2,36, 9) = (/ & + & 0.10537e-02_r8,0.17833e-01_r8,0.25974e-01_r8,0.28911e-01_r8,0.17115e-01_r8 /) + kbo(:, 3,36, 9) = (/ & + & 0.10795e-02_r8,0.20426e-01_r8,0.29904e-01_r8,0.33307e-01_r8,0.19875e-01_r8 /) + kbo(:, 4,36, 9) = (/ & + & 0.11043e-02_r8,0.23131e-01_r8,0.33989e-01_r8,0.37917e-01_r8,0.22855e-01_r8 /) + kbo(:, 5,36, 9) = (/ & + & 0.11288e-02_r8,0.25909e-01_r8,0.38197e-01_r8,0.42722e-01_r8,0.26026e-01_r8 /) + kbo(:, 1,37, 9) = (/ & + & 0.85383e-03_r8,0.14679e-01_r8,0.21388e-01_r8,0.23897e-01_r8,0.13970e-01_r8 /) + kbo(:, 2,37, 9) = (/ & + & 0.87682e-03_r8,0.17120e-01_r8,0.25115e-01_r8,0.28039e-01_r8,0.16489e-01_r8 /) + kbo(:, 3,37, 9) = (/ & + & 0.89996e-03_r8,0.19721e-01_r8,0.29054e-01_r8,0.32436e-01_r8,0.19242e-01_r8 /) + kbo(:, 4,37, 9) = (/ & + & 0.92246e-03_r8,0.22439e-01_r8,0.33150e-01_r8,0.37047e-01_r8,0.22217e-01_r8 /) + kbo(:, 5,37, 9) = (/ & + & 0.94506e-03_r8,0.25234e-01_r8,0.37369e-01_r8,0.41852e-01_r8,0.25386e-01_r8 /) + kbo(:, 1,38, 9) = (/ & + & 0.70953e-03_r8,0.14014e-01_r8,0.20566e-01_r8,0.23058e-01_r8,0.13383e-01_r8 /) + kbo(:, 2,38, 9) = (/ & + & 0.73008e-03_r8,0.16455e-01_r8,0.24289e-01_r8,0.27191e-01_r8,0.15892e-01_r8 /) + kbo(:, 3,38, 9) = (/ & + & 0.75050e-03_r8,0.19058e-01_r8,0.28230e-01_r8,0.31581e-01_r8,0.18633e-01_r8 /) + kbo(:, 4,38, 9) = (/ & + & 0.77107e-03_r8,0.21784e-01_r8,0.32331e-01_r8,0.36184e-01_r8,0.21597e-01_r8 /) + kbo(:, 5,38, 9) = (/ & + & 0.79117e-03_r8,0.24590e-01_r8,0.36557e-01_r8,0.40986e-01_r8,0.24760e-01_r8 /) + kbo(:, 1,39, 9) = (/ & + & 0.58982e-03_r8,0.13410e-01_r8,0.19807e-01_r8,0.22275e-01_r8,0.12843e-01_r8 /) + kbo(:, 2,39, 9) = (/ & + & 0.60777e-03_r8,0.15847e-01_r8,0.23520e-01_r8,0.26395e-01_r8,0.15340e-01_r8 /) + kbo(:, 3,39, 9) = (/ & + & 0.62607e-03_r8,0.18449e-01_r8,0.27458e-01_r8,0.30773e-01_r8,0.18067e-01_r8 /) + kbo(:, 4,39, 9) = (/ & + & 0.64471e-03_r8,0.21179e-01_r8,0.31559e-01_r8,0.35367e-01_r8,0.21018e-01_r8 /) + kbo(:, 5,39, 9) = (/ & + & 0.66285e-03_r8,0.23994e-01_r8,0.35788e-01_r8,0.40160e-01_r8,0.24170e-01_r8 /) + kbo(:, 1,40, 9) = (/ & + & 0.48914e-03_r8,0.12617e-01_r8,0.18733e-01_r8,0.21131e-01_r8,0.12100e-01_r8 /) + kbo(:, 2,40, 9) = (/ & + & 0.50499e-03_r8,0.15028e-01_r8,0.22406e-01_r8,0.25206e-01_r8,0.14559e-01_r8 /) + kbo(:, 3,40, 9) = (/ & + & 0.52119e-03_r8,0.17611e-01_r8,0.26314e-01_r8,0.29544e-01_r8,0.17245e-01_r8 /) + kbo(:, 4,40, 9) = (/ & + & 0.53770e-03_r8,0.20330e-01_r8,0.30397e-01_r8,0.34103e-01_r8,0.20159e-01_r8 /) + kbo(:, 5,40, 9) = (/ & + & 0.55398e-03_r8,0.23142e-01_r8,0.34616e-01_r8,0.38867e-01_r8,0.23278e-01_r8 /) + kbo(:, 1,41, 9) = (/ & + & 0.40532e-03_r8,0.11840e-01_r8,0.17661e-01_r8,0.19981e-01_r8,0.11365e-01_r8 /) + kbo(:, 2,41, 9) = (/ & + & 0.41916e-03_r8,0.14219e-01_r8,0.21285e-01_r8,0.24002e-01_r8,0.13782e-01_r8 /) + kbo(:, 3,41, 9) = (/ & + & 0.43354e-03_r8,0.16775e-01_r8,0.25154e-01_r8,0.28292e-01_r8,0.16423e-01_r8 /) + kbo(:, 4,41, 9) = (/ & + & 0.44807e-03_r8,0.19478e-01_r8,0.29214e-01_r8,0.32812e-01_r8,0.19291e-01_r8 /) + kbo(:, 5,41, 9) = (/ & + & 0.46282e-03_r8,0.22283e-01_r8,0.33415e-01_r8,0.37538e-01_r8,0.22373e-01_r8 /) + kbo(:, 1,42, 9) = (/ & + & 0.33573e-03_r8,0.11104e-01_r8,0.16634e-01_r8,0.18873e-01_r8,0.10664e-01_r8 /) + kbo(:, 2,42, 9) = (/ & + & 0.34776e-03_r8,0.13446e-01_r8,0.20201e-01_r8,0.22835e-01_r8,0.13037e-01_r8 /) + kbo(:, 3,42, 9) = (/ & + & 0.36046e-03_r8,0.15973e-01_r8,0.24027e-01_r8,0.27071e-01_r8,0.15631e-01_r8 /) + kbo(:, 4,42, 9) = (/ & + & 0.37344e-03_r8,0.18654e-01_r8,0.28057e-01_r8,0.31550e-01_r8,0.18451e-01_r8 /) + kbo(:, 5,42, 9) = (/ & + & 0.38663e-03_r8,0.21448e-01_r8,0.32235e-01_r8,0.36231e-01_r8,0.21492e-01_r8 /) + kbo(:, 1,43, 9) = (/ & + & 0.27733e-03_r8,0.10283e-01_r8,0.15460e-01_r8,0.17597e-01_r8,0.98707e-02_r8 /) + kbo(:, 2,43, 9) = (/ & + & 0.28779e-03_r8,0.12571e-01_r8,0.18947e-01_r8,0.21473e-01_r8,0.12183e-01_r8 /) + kbo(:, 3,43, 9) = (/ & + & 0.29891e-03_r8,0.15054e-01_r8,0.22712e-01_r8,0.25638e-01_r8,0.14718e-01_r8 /) + kbo(:, 4,43, 9) = (/ & + & 0.31033e-03_r8,0.17702e-01_r8,0.26696e-01_r8,0.30055e-01_r8,0.17477e-01_r8 /) + kbo(:, 5,43, 9) = (/ & + & 0.32200e-03_r8,0.20476e-01_r8,0.30841e-01_r8,0.34682e-01_r8,0.20459e-01_r8 /) + kbo(:, 1,44, 9) = (/ & + & 0.22878e-03_r8,0.94499e-02_r8,0.14251e-01_r8,0.16276e-01_r8,0.90607e-02_r8 /) + kbo(:, 2,44, 9) = (/ & + & 0.23775e-03_r8,0.11673e-01_r8,0.17646e-01_r8,0.20049e-01_r8,0.11303e-01_r8 /) + kbo(:, 3,44, 9) = (/ & + & 0.24747e-03_r8,0.14106e-01_r8,0.21336e-01_r8,0.24135e-01_r8,0.13772e-01_r8 /) + kbo(:, 4,44, 9) = (/ & + & 0.25755e-03_r8,0.16710e-01_r8,0.25261e-01_r8,0.28479e-01_r8,0.16464e-01_r8 /) + kbo(:, 5,44, 9) = (/ & + & 0.26798e-03_r8,0.19454e-01_r8,0.29363e-01_r8,0.33046e-01_r8,0.19378e-01_r8 /) + kbo(:, 1,45, 9) = (/ & + & 0.18849e-03_r8,0.86584e-02_r8,0.13096e-01_r8,0.15007e-01_r8,0.82904e-02_r8 /) + kbo(:, 2,45, 9) = (/ & + & 0.19636e-03_r8,0.10814e-01_r8,0.16390e-01_r8,0.18672e-01_r8,0.10458e-01_r8 /) + kbo(:, 3,45, 9) = (/ & + & 0.20470e-03_r8,0.13189e-01_r8,0.19995e-01_r8,0.22671e-01_r8,0.12861e-01_r8 /) + kbo(:, 4,45, 9) = (/ & + & 0.21344e-03_r8,0.15746e-01_r8,0.23854e-01_r8,0.26936e-01_r8,0.15483e-01_r8 /) + kbo(:, 5,45, 9) = (/ & + & 0.22266e-03_r8,0.18454e-01_r8,0.27912e-01_r8,0.31439e-01_r8,0.18328e-01_r8 /) + kbo(:, 1,46, 9) = (/ & + & 0.15507e-03_r8,0.78632e-02_r8,0.11928e-01_r8,0.13712e-01_r8,0.75164e-02_r8 /) + kbo(:, 2,46, 9) = (/ & + & 0.16179e-03_r8,0.99413e-02_r8,0.15104e-01_r8,0.17260e-01_r8,0.95985e-02_r8 /) + kbo(:, 3,46, 9) = (/ & + & 0.16890e-03_r8,0.12249e-01_r8,0.18612e-01_r8,0.21154e-01_r8,0.11927e-01_r8 /) + kbo(:, 4,46, 9) = (/ & + & 0.17659e-03_r8,0.14751e-01_r8,0.22394e-01_r8,0.25333e-01_r8,0.14476e-01_r8 /) + kbo(:, 5,46, 9) = (/ & + & 0.18474e-03_r8,0.17415e-01_r8,0.26393e-01_r8,0.29761e-01_r8,0.17246e-01_r8 /) + kbo(:, 1,47, 9) = (/ & + & 0.12726e-03_r8,0.70304e-02_r8,0.10696e-01_r8,0.12336e-01_r8,0.67029e-02_r8 /) + kbo(:, 2,47, 9) = (/ & + & 0.13291e-03_r8,0.90171e-02_r8,0.13730e-01_r8,0.15745e-01_r8,0.86863e-02_r8 /) + kbo(:, 3,47, 9) = (/ & + & 0.13906e-03_r8,0.11243e-01_r8,0.17120e-01_r8,0.19510e-01_r8,0.10925e-01_r8 /) + kbo(:, 4,47, 9) = (/ & + & 0.14561e-03_r8,0.13678e-01_r8,0.20805e-01_r8,0.23588e-01_r8,0.13392e-01_r8 /) + kbo(:, 5,47, 9) = (/ & + & 0.15268e-03_r8,0.16286e-01_r8,0.24728e-01_r8,0.27924e-01_r8,0.16077e-01_r8 /) + kbo(:, 1,48, 9) = (/ & + & 0.10430e-03_r8,0.62479e-02_r8,0.95325e-02_r8,0.11029e-01_r8,0.59380e-02_r8 /) + kbo(:, 2,48, 9) = (/ & + & 0.10909e-03_r8,0.81380e-02_r8,0.12419e-01_r8,0.14291e-01_r8,0.78205e-02_r8 /) + kbo(:, 3,48, 9) = (/ & + & 0.11429e-03_r8,0.10277e-01_r8,0.15680e-01_r8,0.17922e-01_r8,0.99641e-02_r8 /) + kbo(:, 4,48, 9) = (/ & + & 0.11996e-03_r8,0.12637e-01_r8,0.19259e-01_r8,0.21888e-01_r8,0.12347e-01_r8 /) + kbo(:, 5,48, 9) = (/ & + & 0.12611e-03_r8,0.15183e-01_r8,0.23095e-01_r8,0.26125e-01_r8,0.14947e-01_r8 /) + kbo(:, 1,49, 9) = (/ & + & 0.85361e-04_r8,0.55178e-02_r8,0.84413e-02_r8,0.97939e-02_r8,0.52224e-02_r8 /) + kbo(:, 2,49, 9) = (/ & + & 0.89682e-04_r8,0.73124e-02_r8,0.11182e-01_r8,0.12906e-01_r8,0.70024e-02_r8 /) + kbo(:, 3,49, 9) = (/ & + & 0.93818e-04_r8,0.93518e-02_r8,0.14295e-01_r8,0.16393e-01_r8,0.90454e-02_r8 /) + kbo(:, 4,49, 9) = (/ & + & 0.98731e-04_r8,0.11631e-01_r8,0.17758e-01_r8,0.20234e-01_r8,0.11339e-01_r8 /) + kbo(:, 5,49, 9) = (/ & + & 0.10398e-03_r8,0.14111e-01_r8,0.21502e-01_r8,0.24370e-01_r8,0.13856e-01_r8 /) + kbo(:, 1,50, 9) = (/ & + & 0.70068e-04_r8,0.48843e-02_r8,0.74862e-02_r8,0.87029e-02_r8,0.45961e-02_r8 /) + kbo(:, 2,50, 9) = (/ & + & 0.73528e-04_r8,0.65706e-02_r8,0.10074e-01_r8,0.11661e-01_r8,0.62737e-02_r8 /) + kbo(:, 3,50, 9) = (/ & + & 0.77377e-04_r8,0.85288e-02_r8,0.13057e-01_r8,0.15019e-01_r8,0.82236e-02_r8 /) + kbo(:, 4,50, 9) = (/ & + & 0.81195e-04_r8,0.10720e-01_r8,0.16396e-01_r8,0.18728e-01_r8,0.10428e-01_r8 /) + kbo(:, 5,50, 9) = (/ & + & 0.85703e-04_r8,0.13133e-01_r8,0.20042e-01_r8,0.22765e-01_r8,0.12867e-01_r8 /) + kbo(:, 1,51, 9) = (/ & + & 0.57383e-04_r8,0.43058e-02_r8,0.66126e-02_r8,0.77023e-02_r8,0.40299e-02_r8 /) + kbo(:, 2,51, 9) = (/ & + & 0.60290e-04_r8,0.58916e-02_r8,0.90543e-02_r8,0.10509e-01_r8,0.56057e-02_r8 /) + kbo(:, 3,51, 9) = (/ & + & 0.63513e-04_r8,0.77586e-02_r8,0.11901e-01_r8,0.13729e-01_r8,0.74620e-02_r8 /) + kbo(:, 4,51, 9) = (/ & + & 0.66727e-04_r8,0.98672e-02_r8,0.15116e-01_r8,0.17314e-01_r8,0.95779e-02_r8 /) + kbo(:, 5,51, 9) = (/ & + & 0.70598e-04_r8,0.12209e-01_r8,0.18661e-01_r8,0.21244e-01_r8,0.11938e-01_r8 /) + kbo(:, 1,52, 9) = (/ & + & 0.46933e-04_r8,0.37683e-02_r8,0.57987e-02_r8,0.67684e-02_r8,0.35066e-02_r8 /) + kbo(:, 2,52, 9) = (/ & + & 0.49374e-04_r8,0.52554e-02_r8,0.80944e-02_r8,0.94163e-02_r8,0.49785e-02_r8 /) + kbo(:, 3,52, 9) = (/ & + & 0.52069e-04_r8,0.70251e-02_r8,0.10799e-01_r8,0.12493e-01_r8,0.67384e-02_r8 /) + kbo(:, 4,52, 9) = (/ & + & 0.55066e-04_r8,0.90579e-02_r8,0.13892e-01_r8,0.15957e-01_r8,0.87644e-02_r8 /) + kbo(:, 5,52, 9) = (/ & + & 0.58094e-04_r8,0.11314e-01_r8,0.17321e-01_r8,0.19762e-01_r8,0.11039e-01_r8 /) + kbo(:, 1,53, 9) = (/ & + & 0.38369e-04_r8,0.32705e-02_r8,0.50428e-02_r8,0.58997e-02_r8,0.30250e-02_r8 /) + kbo(:, 2,53, 9) = (/ & + & 0.40389e-04_r8,0.46579e-02_r8,0.71882e-02_r8,0.83794e-02_r8,0.43908e-02_r8 /) + kbo(:, 3,53, 9) = (/ & + & 0.42656e-04_r8,0.63275e-02_r8,0.97486e-02_r8,0.11308e-01_r8,0.60500e-02_r8 /) + kbo(:, 4,53, 9) = (/ & + & 0.45173e-04_r8,0.82714e-02_r8,0.12706e-01_r8,0.14639e-01_r8,0.79824e-02_r8 /) + kbo(:, 5,53, 9) = (/ & + & 0.47733e-04_r8,0.10447e-01_r8,0.16018e-01_r8,0.18320e-01_r8,0.10170e-01_r8 /) + kbo(:, 1,54, 9) = (/ & + & 0.31373e-04_r8,0.28489e-02_r8,0.44023e-02_r8,0.51602e-02_r8,0.26198e-02_r8 /) + kbo(:, 2,54, 9) = (/ & + & 0.33072e-04_r8,0.41448e-02_r8,0.64072e-02_r8,0.74821e-02_r8,0.38868e-02_r8 /) + kbo(:, 3,54, 9) = (/ & + & 0.34962e-04_r8,0.57219e-02_r8,0.88331e-02_r8,0.10271e-01_r8,0.54518e-02_r8 /) + kbo(:, 4,54, 9) = (/ & + & 0.37073e-04_r8,0.75801e-02_r8,0.11663e-01_r8,0.13472e-01_r8,0.72975e-02_r8 /) + kbo(:, 5,54, 9) = (/ & + & 0.39224e-04_r8,0.96795e-02_r8,0.14861e-01_r8,0.17039e-01_r8,0.94030e-02_r8 /) + kbo(:, 1,55, 9) = (/ & + & 0.25649e-04_r8,0.24774e-02_r8,0.38358e-02_r8,0.45027e-02_r8,0.22635e-02_r8 /) + kbo(:, 2,55, 9) = (/ & + & 0.27065e-04_r8,0.36831e-02_r8,0.57040e-02_r8,0.66733e-02_r8,0.34361e-02_r8 /) + kbo(:, 3,55, 9) = (/ & + & 0.28649e-04_r8,0.51728e-02_r8,0.80003e-02_r8,0.93199e-02_r8,0.49087e-02_r8 /) + kbo(:, 4,55, 9) = (/ & + & 0.30419e-04_r8,0.69443e-02_r8,0.10704e-01_r8,0.12395e-01_r8,0.66688e-02_r8 /) + kbo(:, 5,55, 9) = (/ & + & 0.32478e-04_r8,0.89781e-02_r8,0.13794e-01_r8,0.15856e-01_r8,0.86947e-02_r8 /) + kbo(:, 1,56, 9) = (/ & + & 0.20960e-04_r8,0.21374e-02_r8,0.33161e-02_r8,0.38972e-02_r8,0.19394e-02_r8 /) + kbo(:, 2,56, 9) = (/ & + & 0.22130e-04_r8,0.32530e-02_r8,0.50471e-02_r8,0.59166e-02_r8,0.30185e-02_r8 /) + kbo(:, 3,56, 9) = (/ & + & 0.23455e-04_r8,0.46545e-02_r8,0.72105e-02_r8,0.84156e-02_r8,0.43975e-02_r8 /) + kbo(:, 4,56, 9) = (/ & + & 0.24958e-04_r8,0.63377e-02_r8,0.97876e-02_r8,0.11360e-01_r8,0.60688e-02_r8 /) + kbo(:, 5,56, 9) = (/ & + & 0.26672e-04_r8,0.82933e-02_r8,0.12759e-01_r8,0.14704e-01_r8,0.80123e-02_r8 /) + kbo(:, 1,57, 9) = (/ & + & 0.17108e-04_r8,0.18275e-02_r8,0.28407e-02_r8,0.33429e-02_r8,0.16463e-02_r8 /) + kbo(:, 2,57, 9) = (/ & + & 0.18082e-04_r8,0.28535e-02_r8,0.44360e-02_r8,0.52097e-02_r8,0.26326e-02_r8 /) + kbo(:, 3,57, 9) = (/ & + & 0.19184e-04_r8,0.41668e-02_r8,0.64646e-02_r8,0.75572e-02_r8,0.39170e-02_r8 /) + kbo(:, 4,57, 9) = (/ & + & 0.20446e-04_r8,0.57610e-02_r8,0.89128e-02_r8,0.10368e-01_r8,0.54979e-02_r8 /) + kbo(:, 5,57, 9) = (/ & + & 0.21854e-04_r8,0.76342e-02_r8,0.11762e-01_r8,0.13588e-01_r8,0.73577e-02_r8 /) + kbo(:, 1,58, 9) = (/ & + & 0.13963e-04_r8,0.15602e-02_r8,0.24292e-02_r8,0.28638e-02_r8,0.13965e-02_r8 /) + kbo(:, 2,58, 9) = (/ & + & 0.14773e-04_r8,0.25031e-02_r8,0.38984e-02_r8,0.45849e-02_r8,0.22957e-02_r8 /) + kbo(:, 3,58, 9) = (/ & + & 0.15698e-04_r8,0.37311e-02_r8,0.57975e-02_r8,0.67885e-02_r8,0.34899e-02_r8 /) + kbo(:, 4,58, 9) = (/ & + & 0.16731e-04_r8,0.52413e-02_r8,0.81221e-02_r8,0.94657e-02_r8,0.49831e-02_r8 /) + kbo(:, 5,58, 9) = (/ & + & 0.17926e-04_r8,0.70329e-02_r8,0.10852e-01_r8,0.12566e-01_r8,0.67622e-02_r8 /) + kbo(:, 1,59, 9) = (/ & + & 0.11515e-04_r8,0.14557e-02_r8,0.22712e-02_r8,0.26808e-02_r8,0.13001e-02_r8 /) + kbo(:, 2,59, 9) = (/ & + & 0.12194e-04_r8,0.23665e-02_r8,0.36913e-02_r8,0.43444e-02_r8,0.21654e-02_r8 /) + kbo(:, 3,59, 9) = (/ & + & 0.12975e-04_r8,0.35608e-02_r8,0.55385e-02_r8,0.64911e-02_r8,0.33241e-02_r8 /) + kbo(:, 4,59, 9) = (/ & + & 0.13854e-04_r8,0.50382e-02_r8,0.78142e-02_r8,0.91137e-02_r8,0.47825e-02_r8 /) + kbo(:, 5,59, 9) = (/ & + & 0.14890e-04_r8,0.67966e-02_r8,0.10497e-01_r8,0.12166e-01_r8,0.65291e-02_r8 /) + kbo(:, 1,13,10) = (/ & + & 0.23136e+00_r8,0.35590e+00_r8,0.41705e+00_r8,0.42838e+00_r8,0.34405e+00_r8 /) + kbo(:, 2,13,10) = (/ & + & 0.23570e+00_r8,0.35573e+00_r8,0.41855e+00_r8,0.43318e+00_r8,0.34979e+00_r8 /) + kbo(:, 3,13,10) = (/ & + & 0.23997e+00_r8,0.35949e+00_r8,0.42029e+00_r8,0.43813e+00_r8,0.35426e+00_r8 /) + kbo(:, 4,13,10) = (/ & + & 0.24492e+00_r8,0.36590e+00_r8,0.42350e+00_r8,0.44177e+00_r8,0.35947e+00_r8 /) + kbo(:, 5,13,10) = (/ & + & 0.25202e+00_r8,0.37242e+00_r8,0.42924e+00_r8,0.44467e+00_r8,0.36481e+00_r8 /) + kbo(:, 1,14,10) = (/ & + & 0.20433e+00_r8,0.32280e+00_r8,0.38114e+00_r8,0.39530e+00_r8,0.30987e+00_r8 /) + kbo(:, 2,14,10) = (/ & + & 0.20812e+00_r8,0.32580e+00_r8,0.38400e+00_r8,0.40099e+00_r8,0.31521e+00_r8 /) + kbo(:, 3,14,10) = (/ & + & 0.21260e+00_r8,0.33207e+00_r8,0.38794e+00_r8,0.40573e+00_r8,0.32135e+00_r8 /) + kbo(:, 4,14,10) = (/ & + & 0.21971e+00_r8,0.33857e+00_r8,0.39426e+00_r8,0.40959e+00_r8,0.32811e+00_r8 /) + kbo(:, 5,14,10) = (/ & + & 0.22862e+00_r8,0.34522e+00_r8,0.40235e+00_r8,0.41376e+00_r8,0.33439e+00_r8 /) + kbo(:, 1,15,10) = (/ & + & 0.17974e+00_r8,0.29385e+00_r8,0.34710e+00_r8,0.36214e+00_r8,0.27698e+00_r8 /) + kbo(:, 2,15,10) = (/ & + & 0.18361e+00_r8,0.29985e+00_r8,0.35176e+00_r8,0.36835e+00_r8,0.28361e+00_r8 /) + kbo(:, 3,15,10) = (/ & + & 0.19011e+00_r8,0.30650e+00_r8,0.35844e+00_r8,0.37336e+00_r8,0.29140e+00_r8 /) + kbo(:, 4,15,10) = (/ & + & 0.19870e+00_r8,0.31340e+00_r8,0.36676e+00_r8,0.37856e+00_r8,0.29913e+00_r8 /) + kbo(:, 5,15,10) = (/ & + & 0.20713e+00_r8,0.32067e+00_r8,0.37517e+00_r8,0.38452e+00_r8,0.30673e+00_r8 /) + kbo(:, 1,16,10) = (/ & + & 0.15768e+00_r8,0.26909e+00_r8,0.31566e+00_r8,0.32905e+00_r8,0.24795e+00_r8 /) + kbo(:, 2,16,10) = (/ & + & 0.16341e+00_r8,0.27579e+00_r8,0.32257e+00_r8,0.33542e+00_r8,0.25593e+00_r8 /) + kbo(:, 3,16,10) = (/ & + & 0.17143e+00_r8,0.28283e+00_r8,0.33152e+00_r8,0.34164e+00_r8,0.26468e+00_r8 /) + kbo(:, 4,16,10) = (/ & + & 0.17943e+00_r8,0.29026e+00_r8,0.34054e+00_r8,0.34897e+00_r8,0.27328e+00_r8 /) + kbo(:, 5,16,10) = (/ & + & 0.18690e+00_r8,0.29935e+00_r8,0.34954e+00_r8,0.35767e+00_r8,0.28225e+00_r8 /) + kbo(:, 1,17,10) = (/ & + & 0.13875e+00_r8,0.24652e+00_r8,0.28696e+00_r8,0.29693e+00_r8,0.22321e+00_r8 /) + kbo(:, 2,17,10) = (/ & + & 0.14611e+00_r8,0.25366e+00_r8,0.29630e+00_r8,0.30411e+00_r8,0.23216e+00_r8 /) + kbo(:, 3,17,10) = (/ & + & 0.15377e+00_r8,0.26122e+00_r8,0.30597e+00_r8,0.31229e+00_r8,0.24127e+00_r8 /) + kbo(:, 4,17,10) = (/ & + & 0.16099e+00_r8,0.27029e+00_r8,0.31565e+00_r8,0.32218e+00_r8,0.25077e+00_r8 /) + kbo(:, 5,17,10) = (/ & + & 0.16791e+00_r8,0.28100e+00_r8,0.32533e+00_r8,0.33316e+00_r8,0.26091e+00_r8 /) + kbo(:, 1,18,10) = (/ & + & 0.12258e+00_r8,0.22568e+00_r8,0.26154e+00_r8,0.26746e+00_r8,0.20208e+00_r8 /) + kbo(:, 2,18,10) = (/ & + & 0.12972e+00_r8,0.23340e+00_r8,0.27183e+00_r8,0.27607e+00_r8,0.21144e+00_r8 /) + kbo(:, 3,18,10) = (/ & + & 0.13673e+00_r8,0.24228e+00_r8,0.28202e+00_r8,0.28661e+00_r8,0.22093e+00_r8 /) + kbo(:, 4,18,10) = (/ & + & 0.14352e+00_r8,0.25285e+00_r8,0.29256e+00_r8,0.29859e+00_r8,0.23121e+00_r8 /) + kbo(:, 5,18,10) = (/ & + & 0.14999e+00_r8,0.26447e+00_r8,0.30340e+00_r8,0.31163e+00_r8,0.24203e+00_r8 /) + kbo(:, 1,19,10) = (/ & + & 0.10785e+00_r8,0.20667e+00_r8,0.23879e+00_r8,0.24194e+00_r8,0.18368e+00_r8 /) + kbo(:, 2,19,10) = (/ & + & 0.11429e+00_r8,0.21546e+00_r8,0.24926e+00_r8,0.25235e+00_r8,0.19325e+00_r8 /) + kbo(:, 3,19,10) = (/ & + & 0.12064e+00_r8,0.22577e+00_r8,0.26022e+00_r8,0.26472e+00_r8,0.20338e+00_r8 /) + kbo(:, 4,19,10) = (/ & + & 0.12700e+00_r8,0.23751e+00_r8,0.27175e+00_r8,0.27823e+00_r8,0.21416e+00_r8 /) + kbo(:, 5,19,10) = (/ & + & 0.13335e+00_r8,0.24924e+00_r8,0.28423e+00_r8,0.29239e+00_r8,0.22548e+00_r8 /) + kbo(:, 1,20,10) = (/ & + & 0.94314e-01_r8,0.18969e+00_r8,0.21843e+00_r8,0.22089e+00_r8,0.16767e+00_r8 /) + kbo(:, 2,20,10) = (/ & + & 0.10011e+00_r8,0.20009e+00_r8,0.22938e+00_r8,0.23290e+00_r8,0.17759e+00_r8 /) + kbo(:, 3,20,10) = (/ & + & 0.10602e+00_r8,0.21171e+00_r8,0.24114e+00_r8,0.24650e+00_r8,0.18815e+00_r8 /) + kbo(:, 4,20,10) = (/ & + & 0.11212e+00_r8,0.22366e+00_r8,0.25410e+00_r8,0.26076e+00_r8,0.19951e+00_r8 /) + kbo(:, 5,20,10) = (/ & + & 0.11820e+00_r8,0.23566e+00_r8,0.26816e+00_r8,0.27572e+00_r8,0.21140e+00_r8 /) + kbo(:, 1,21,10) = (/ & + & 0.82096e-01_r8,0.17498e+00_r8,0.20057e+00_r8,0.20349e+00_r8,0.15368e+00_r8 /) + kbo(:, 2,21,10) = (/ & + & 0.87376e-01_r8,0.18671e+00_r8,0.21217e+00_r8,0.21678e+00_r8,0.16394e+00_r8 /) + kbo(:, 3,21,10) = (/ & + & 0.92996e-01_r8,0.19901e+00_r8,0.22527e+00_r8,0.23088e+00_r8,0.17505e+00_r8 /) + kbo(:, 4,21,10) = (/ & + & 0.98752e-01_r8,0.21131e+00_r8,0.23942e+00_r8,0.24575e+00_r8,0.18685e+00_r8 /) + kbo(:, 5,21,10) = (/ & + & 0.10451e+00_r8,0.22356e+00_r8,0.25490e+00_r8,0.26152e+00_r8,0.19924e+00_r8 /) + kbo(:, 1,22,10) = (/ & + & 0.71578e-01_r8,0.16309e+00_r8,0.18609e+00_r8,0.19018e+00_r8,0.14217e+00_r8 /) + kbo(:, 2,22,10) = (/ & + & 0.76626e-01_r8,0.17564e+00_r8,0.19884e+00_r8,0.20398e+00_r8,0.15291e+00_r8 /) + kbo(:, 3,22,10) = (/ & + & 0.81885e-01_r8,0.18840e+00_r8,0.21309e+00_r8,0.21858e+00_r8,0.16461e+00_r8 /) + kbo(:, 4,22,10) = (/ & + & 0.87223e-01_r8,0.20113e+00_r8,0.22859e+00_r8,0.23430e+00_r8,0.17688e+00_r8 /) + kbo(:, 5,22,10) = (/ & + & 0.92500e-01_r8,0.21374e+00_r8,0.24532e+00_r8,0.25104e+00_r8,0.18976e+00_r8 /) + kbo(:, 1,23,10) = (/ & + & 0.62506e-01_r8,0.15298e+00_r8,0.17442e+00_r8,0.17913e+00_r8,0.13258e+00_r8 /) + kbo(:, 2,23,10) = (/ & + & 0.67194e-01_r8,0.16597e+00_r8,0.18829e+00_r8,0.19340e+00_r8,0.14391e+00_r8 /) + kbo(:, 3,23,10) = (/ & + & 0.72099e-01_r8,0.17922e+00_r8,0.20360e+00_r8,0.20869e+00_r8,0.15600e+00_r8 /) + kbo(:, 4,23,10) = (/ & + & 0.77023e-01_r8,0.19243e+00_r8,0.22032e+00_r8,0.22532e+00_r8,0.16873e+00_r8 /) + kbo(:, 5,23,10) = (/ & + & 0.81629e-01_r8,0.20537e+00_r8,0.23792e+00_r8,0.24291e+00_r8,0.18203e+00_r8 /) + kbo(:, 1,24,10) = (/ & + & 0.54705e-01_r8,0.14435e+00_r8,0.16539e+00_r8,0.17004e+00_r8,0.12479e+00_r8 /) + kbo(:, 2,24,10) = (/ & + & 0.59055e-01_r8,0.15781e+00_r8,0.18024e+00_r8,0.18505e+00_r8,0.13663e+00_r8 /) + kbo(:, 3,24,10) = (/ & + & 0.63456e-01_r8,0.17157e+00_r8,0.19662e+00_r8,0.20113e+00_r8,0.14915e+00_r8 /) + kbo(:, 4,24,10) = (/ & + & 0.67778e-01_r8,0.18520e+00_r8,0.21409e+00_r8,0.21860e+00_r8,0.16222e+00_r8 /) + kbo(:, 5,24,10) = (/ & + & 0.71741e-01_r8,0.19852e+00_r8,0.23252e+00_r8,0.23726e+00_r8,0.17594e+00_r8 /) + kbo(:, 1,25,10) = (/ & + & 0.47972e-01_r8,0.13725e+00_r8,0.15860e+00_r8,0.16297e+00_r8,0.11866e+00_r8 /) + kbo(:, 2,25,10) = (/ & + & 0.51893e-01_r8,0.15121e+00_r8,0.17443e+00_r8,0.17877e+00_r8,0.13085e+00_r8 /) + kbo(:, 3,25,10) = (/ & + & 0.55832e-01_r8,0.16535e+00_r8,0.19157e+00_r8,0.19578e+00_r8,0.14380e+00_r8 /) + kbo(:, 4,25,10) = (/ & + & 0.59570e-01_r8,0.17943e+00_r8,0.20993e+00_r8,0.21423e+00_r8,0.15728e+00_r8 /) + kbo(:, 5,25,10) = (/ & + & 0.62996e-01_r8,0.19323e+00_r8,0.22909e+00_r8,0.23401e+00_r8,0.17147e+00_r8 /) + kbo(:, 1,26,10) = (/ & + & 0.42166e-01_r8,0.13173e+00_r8,0.15395e+00_r8,0.15801e+00_r8,0.11401e+00_r8 /) + kbo(:, 2,26,10) = (/ & + & 0.45660e-01_r8,0.14616e+00_r8,0.17062e+00_r8,0.17468e+00_r8,0.12664e+00_r8 /) + kbo(:, 3,26,10) = (/ & + & 0.49079e-01_r8,0.16071e+00_r8,0.18859e+00_r8,0.19278e+00_r8,0.14002e+00_r8 /) + kbo(:, 4,26,10) = (/ & + & 0.52306e-01_r8,0.17521e+00_r8,0.20782e+00_r8,0.21223e+00_r8,0.15402e+00_r8 /) + kbo(:, 5,26,10) = (/ & + & 0.55285e-01_r8,0.18955e+00_r8,0.22765e+00_r8,0.23299e+00_r8,0.16864e+00_r8 /) + kbo(:, 1,27,10) = (/ & + & 0.37040e-01_r8,0.12755e+00_r8,0.15088e+00_r8,0.15474e+00_r8,0.11059e+00_r8 /) + kbo(:, 2,27,10) = (/ & + & 0.40121e-01_r8,0.14241e+00_r8,0.16845e+00_r8,0.17243e+00_r8,0.12369e+00_r8 /) + kbo(:, 3,27,10) = (/ & + & 0.43101e-01_r8,0.15742e+00_r8,0.18726e+00_r8,0.19156e+00_r8,0.13753e+00_r8 /) + kbo(:, 4,27,10) = (/ & + & 0.45931e-01_r8,0.17241e+00_r8,0.20722e+00_r8,0.21200e+00_r8,0.15204e+00_r8 /) + kbo(:, 5,27,10) = (/ & + & 0.48598e-01_r8,0.18733e+00_r8,0.22772e+00_r8,0.23361e+00_r8,0.16711e+00_r8 /) + kbo(:, 1,28,10) = (/ & + & 0.32582e-01_r8,0.12457e+00_r8,0.14931e+00_r8,0.15310e+00_r8,0.10829e+00_r8 /) + kbo(:, 2,28,10) = (/ & + & 0.35269e-01_r8,0.13987e+00_r8,0.16776e+00_r8,0.17185e+00_r8,0.12185e+00_r8 /) + kbo(:, 3,28,10) = (/ & + & 0.37905e-01_r8,0.15538e+00_r8,0.18740e+00_r8,0.19192e+00_r8,0.13621e+00_r8 /) + kbo(:, 4,28,10) = (/ & + & 0.40411e-01_r8,0.17101e+00_r8,0.20797e+00_r8,0.21319e+00_r8,0.15122e+00_r8 /) + kbo(:, 5,28,10) = (/ & + & 0.42843e-01_r8,0.18643e+00_r8,0.22906e+00_r8,0.23551e+00_r8,0.16683e+00_r8 /) + kbo(:, 1,29,10) = (/ & + & 0.28694e-01_r8,0.12285e+00_r8,0.14922e+00_r8,0.15309e+00_r8,0.10715e+00_r8 /) + kbo(:, 2,29,10) = (/ & + & 0.31078e-01_r8,0.13867e+00_r8,0.16851e+00_r8,0.17281e+00_r8,0.12115e+00_r8 /) + kbo(:, 3,29,10) = (/ & + & 0.33398e-01_r8,0.15475e+00_r8,0.18886e+00_r8,0.19373e+00_r8,0.13609e+00_r8 /) + kbo(:, 4,29,10) = (/ & + & 0.35655e-01_r8,0.17087e+00_r8,0.21002e+00_r8,0.21569e+00_r8,0.15161e+00_r8 /) + kbo(:, 5,29,10) = (/ & + & 0.37934e-01_r8,0.18672e+00_r8,0.23156e+00_r8,0.23855e+00_r8,0.16767e+00_r8 /) + kbo(:, 1,30,10) = (/ & + & 0.25318e-01_r8,0.12223e+00_r8,0.15038e+00_r8,0.15442e+00_r8,0.10692e+00_r8 /) + kbo(:, 2,30,10) = (/ & + & 0.27416e-01_r8,0.13863e+00_r8,0.17040e+00_r8,0.17493e+00_r8,0.12146e+00_r8 /) + kbo(:, 3,30,10) = (/ & + & 0.29487e-01_r8,0.15524e+00_r8,0.19136e+00_r8,0.19656e+00_r8,0.13693e+00_r8 /) + kbo(:, 4,30,10) = (/ & + & 0.31585e-01_r8,0.17178e+00_r8,0.21298e+00_r8,0.21911e+00_r8,0.15294e+00_r8 /) + kbo(:, 5,30,10) = (/ & + & 0.33743e-01_r8,0.18794e+00_r8,0.23489e+00_r8,0.24234e+00_r8,0.16937e+00_r8 /) + kbo(:, 1,31,10) = (/ & + & 0.22384e-01_r8,0.12276e+00_r8,0.15268e+00_r8,0.15694e+00_r8,0.10764e+00_r8 /) + kbo(:, 2,31,10) = (/ & + & 0.24241e-01_r8,0.13972e+00_r8,0.17333e+00_r8,0.17809e+00_r8,0.12275e+00_r8 /) + kbo(:, 3,31,10) = (/ & + & 0.26155e-01_r8,0.15678e+00_r8,0.19481e+00_r8,0.20028e+00_r8,0.13870e+00_r8 /) + kbo(:, 4,31,10) = (/ & + & 0.28119e-01_r8,0.17362e+00_r8,0.21675e+00_r8,0.22330e+00_r8,0.15510e+00_r8 /) + kbo(:, 5,31,10) = (/ & + & 0.30218e-01_r8,0.19000e+00_r8,0.23891e+00_r8,0.24680e+00_r8,0.17182e+00_r8 /) + kbo(:, 1,32,10) = (/ & + & 0.19818e-01_r8,0.12431e+00_r8,0.15590e+00_r8,0.16037e+00_r8,0.10919e+00_r8 /) + kbo(:, 2,32,10) = (/ & + & 0.21499e-01_r8,0.14174e+00_r8,0.17710e+00_r8,0.18207e+00_r8,0.12484e+00_r8 /) + kbo(:, 3,32,10) = (/ & + & 0.23289e-01_r8,0.15910e+00_r8,0.19892e+00_r8,0.20468e+00_r8,0.14116e+00_r8 /) + kbo(:, 4,32,10) = (/ & + & 0.25197e-01_r8,0.17612e+00_r8,0.22110e+00_r8,0.22808e+00_r8,0.15787e+00_r8 /) + kbo(:, 5,32,10) = (/ & + & 0.27257e-01_r8,0.19267e+00_r8,0.24341e+00_r8,0.25172e+00_r8,0.17483e+00_r8 /) + kbo(:, 1,33,10) = (/ & + & 0.17588e-01_r8,0.12670e+00_r8,0.15984e+00_r8,0.16448e+00_r8,0.11147e+00_r8 /) + kbo(:, 2,33,10) = (/ & + & 0.19157e-01_r8,0.14450e+00_r8,0.18143e+00_r8,0.18665e+00_r8,0.12758e+00_r8 /) + kbo(:, 3,33,10) = (/ & + & 0.20859e-01_r8,0.16204e+00_r8,0.20353e+00_r8,0.20957e+00_r8,0.14421e+00_r8 /) + kbo(:, 4,33,10) = (/ & + & 0.22735e-01_r8,0.17915e+00_r8,0.22585e+00_r8,0.23324e+00_r8,0.16113e+00_r8 /) + kbo(:, 5,33,10) = (/ & + & 0.24799e-01_r8,0.19574e+00_r8,0.24826e+00_r8,0.25697e+00_r8,0.17829e+00_r8 /) + kbo(:, 1,34,10) = (/ & + & 0.15617e-01_r8,0.12913e+00_r8,0.16354e+00_r8,0.16830e+00_r8,0.11378e+00_r8 /) + kbo(:, 2,34,10) = (/ & + & 0.17096e-01_r8,0.14716e+00_r8,0.18538e+00_r8,0.19084e+00_r8,0.13021e+00_r8 /) + kbo(:, 3,34,10) = (/ & + & 0.18753e-01_r8,0.16482e+00_r8,0.20769e+00_r8,0.21402e+00_r8,0.14705e+00_r8 /) + kbo(:, 4,34,10) = (/ & + & 0.20625e-01_r8,0.18194e+00_r8,0.23012e+00_r8,0.23784e+00_r8,0.16411e+00_r8 /) + kbo(:, 5,34,10) = (/ & + & 0.22709e-01_r8,0.19848e+00_r8,0.25256e+00_r8,0.26160e+00_r8,0.18143e+00_r8 /) + kbo(:, 1,35,10) = (/ & + & 0.13789e-01_r8,0.13026e+00_r8,0.16543e+00_r8,0.17032e+00_r8,0.11490e+00_r8 /) + kbo(:, 2,35,10) = (/ & + & 0.15216e-01_r8,0.14846e+00_r8,0.18743e+00_r8,0.19307e+00_r8,0.13153e+00_r8 /) + kbo(:, 3,35,10) = (/ & + & 0.16842e-01_r8,0.16621e+00_r8,0.20987e+00_r8,0.21641e+00_r8,0.14851e+00_r8 /) + kbo(:, 4,35,10) = (/ & + & 0.18686e-01_r8,0.18333e+00_r8,0.23239e+00_r8,0.24032e+00_r8,0.16565e+00_r8 /) + kbo(:, 5,35,10) = (/ & + & 0.20799e-01_r8,0.19983e+00_r8,0.25487e+00_r8,0.26409e+00_r8,0.18307e+00_r8 /) + kbo(:, 1,36,10) = (/ & + & 0.12099e-01_r8,0.12969e+00_r8,0.16517e+00_r8,0.17011e+00_r8,0.11448e+00_r8 /) + kbo(:, 2,36,10) = (/ & + & 0.13456e-01_r8,0.14803e+00_r8,0.18723e+00_r8,0.19293e+00_r8,0.13120e+00_r8 /) + kbo(:, 3,36,10) = (/ & + & 0.15032e-01_r8,0.16587e+00_r8,0.20973e+00_r8,0.21635e+00_r8,0.14826e+00_r8 /) + kbo(:, 4,36,10) = (/ & + & 0.16854e-01_r8,0.18305e+00_r8,0.23232e+00_r8,0.24032e+00_r8,0.16546e+00_r8 /) + kbo(:, 5,36,10) = (/ & + & 0.18993e-01_r8,0.19959e+00_r8,0.25485e+00_r8,0.26414e+00_r8,0.18292e+00_r8 /) + kbo(:, 1,37,10) = (/ & + & 0.10461e-01_r8,0.12652e+00_r8,0.16173e+00_r8,0.16663e+00_r8,0.11173e+00_r8 /) + kbo(:, 2,37,10) = (/ & + & 0.11729e-01_r8,0.14498e+00_r8,0.18379e+00_r8,0.18940e+00_r8,0.12844e+00_r8 /) + kbo(:, 3,37,10) = (/ & + & 0.13230e-01_r8,0.16298e+00_r8,0.20628e+00_r8,0.21278e+00_r8,0.14553e+00_r8 /) + kbo(:, 4,37,10) = (/ & + & 0.15005e-01_r8,0.18033e+00_r8,0.22891e+00_r8,0.23679e+00_r8,0.16275e+00_r8 /) + kbo(:, 5,37,10) = (/ & + & 0.17126e-01_r8,0.19699e+00_r8,0.25151e+00_r8,0.26065e+00_r8,0.18019e+00_r8 /) + kbo(:, 1,38,10) = (/ & + & 0.90496e-02_r8,0.12333e+00_r8,0.15823e+00_r8,0.16307e+00_r8,0.10897e+00_r8 /) + kbo(:, 2,38,10) = (/ & + & 0.10227e-01_r8,0.14188e+00_r8,0.18026e+00_r8,0.18578e+00_r8,0.12565e+00_r8 /) + kbo(:, 3,38,10) = (/ & + & 0.11665e-01_r8,0.16002e+00_r8,0.20273e+00_r8,0.20911e+00_r8,0.14274e+00_r8 /) + kbo(:, 4,38,10) = (/ & + & 0.13392e-01_r8,0.17754e+00_r8,0.22537e+00_r8,0.23309e+00_r8,0.15996e+00_r8 /) + kbo(:, 5,38,10) = (/ & + & 0.15506e-01_r8,0.19433e+00_r8,0.24804e+00_r8,0.25702e+00_r8,0.17741e+00_r8 /) + kbo(:, 1,39,10) = (/ & + & 0.78338e-02_r8,0.12027e+00_r8,0.15482e+00_r8,0.15961e+00_r8,0.10632e+00_r8 /) + kbo(:, 2,39,10) = (/ & + & 0.89378e-02_r8,0.13888e+00_r8,0.17682e+00_r8,0.18224e+00_r8,0.12295e+00_r8 /) + kbo(:, 3,39,10) = (/ & + & 0.10310e-01_r8,0.15714e+00_r8,0.19926e+00_r8,0.20553e+00_r8,0.14003e+00_r8 /) + kbo(:, 4,39,10) = (/ & + & 0.12002e-01_r8,0.17480e+00_r8,0.22192e+00_r8,0.22947e+00_r8,0.15725e+00_r8 /) + kbo(:, 5,39,10) = (/ & + & 0.14105e-01_r8,0.19172e+00_r8,0.24464e+00_r8,0.25344e+00_r8,0.17470e+00_r8 /) + kbo(:, 1,40,10) = (/ & + & 0.66914e-02_r8,0.11542e+00_r8,0.14925e+00_r8,0.15395e+00_r8,0.10210e+00_r8 /) + kbo(:, 2,40,10) = (/ & + & 0.77047e-02_r8,0.13403e+00_r8,0.17118e+00_r8,0.17643e+00_r8,0.11860e+00_r8 /) + kbo(:, 3,40,10) = (/ & + & 0.89835e-02_r8,0.15246e+00_r8,0.19353e+00_r8,0.19961e+00_r8,0.13564e+00_r8 /) + kbo(:, 4,40,10) = (/ & + & 0.10606e-01_r8,0.17030e+00_r8,0.21619e+00_r8,0.22340e+00_r8,0.15283e+00_r8 /) + kbo(:, 5,40,10) = (/ & + & 0.12648e-01_r8,0.18743e+00_r8,0.23893e+00_r8,0.24746e+00_r8,0.17023e+00_r8 /) + kbo(:, 1,41,10) = (/ & + & 0.57043e-02_r8,0.11041e+00_r8,0.14350e+00_r8,0.14812e+00_r8,0.97770e-01_r8 /) + kbo(:, 2,41,10) = (/ & + & 0.66329e-02_r8,0.12897e+00_r8,0.16532e+00_r8,0.17041e+00_r8,0.11409e+00_r8 /) + kbo(:, 3,41,10) = (/ & + & 0.78105e-02_r8,0.14755e+00_r8,0.18757e+00_r8,0.19344e+00_r8,0.13104e+00_r8 /) + kbo(:, 4,41,10) = (/ & + & 0.93536e-02_r8,0.16558e+00_r8,0.21020e+00_r8,0.21707e+00_r8,0.14824e+00_r8 /) + kbo(:, 5,41,10) = (/ & + & 0.11328e-01_r8,0.18290e+00_r8,0.23295e+00_r8,0.24119e+00_r8,0.16557e+00_r8 /) + kbo(:, 1,42,10) = (/ & + & 0.48607e-02_r8,0.10547e+00_r8,0.13783e+00_r8,0.14238e+00_r8,0.93542e-01_r8 /) + kbo(:, 2,42,10) = (/ & + & 0.56953e-02_r8,0.12396e+00_r8,0.15948e+00_r8,0.16442e+00_r8,0.10965e+00_r8 /) + kbo(:, 3,42,10) = (/ & + & 0.67857e-02_r8,0.14262e+00_r8,0.18165e+00_r8,0.18732e+00_r8,0.12648e+00_r8 /) + kbo(:, 4,42,10) = (/ & + & 0.82516e-02_r8,0.16083e+00_r8,0.20424e+00_r8,0.21080e+00_r8,0.14367e+00_r8 /) + kbo(:, 5,42,10) = (/ & + & 0.10149e-01_r8,0.17836e+00_r8,0.22696e+00_r8,0.23490e+00_r8,0.16095e+00_r8 /) + kbo(:, 1,43,10) = (/ & + & 0.40934e-02_r8,0.99600e-01_r8,0.13106e+00_r8,0.13554e+00_r8,0.88531e-01_r8 /) + kbo(:, 2,43,10) = (/ & + & 0.48473e-02_r8,0.11796e+00_r8,0.15249e+00_r8,0.15728e+00_r8,0.10438e+00_r8 /) + kbo(:, 3,43,10) = (/ & + & 0.58407e-02_r8,0.13665e+00_r8,0.17453e+00_r8,0.17995e+00_r8,0.12102e+00_r8 /) + kbo(:, 4,43,10) = (/ & + & 0.71922e-02_r8,0.15505e+00_r8,0.19702e+00_r8,0.20328e+00_r8,0.13817e+00_r8 /) + kbo(:, 5,43,10) = (/ & + & 0.89819e-02_r8,0.17282e+00_r8,0.21974e+00_r8,0.22722e+00_r8,0.15541e+00_r8 /) + kbo(:, 1,44,10) = (/ & + & 0.34279e-02_r8,0.93376e-01_r8,0.12386e+00_r8,0.12828e+00_r8,0.83256e-01_r8 /) + kbo(:, 2,44,10) = (/ & + & 0.40981e-02_r8,0.11153e+00_r8,0.14501e+00_r8,0.14969e+00_r8,0.98786e-01_r8 /) + kbo(:, 3,44,10) = (/ & + & 0.49801e-02_r8,0.13017e+00_r8,0.16691e+00_r8,0.17209e+00_r8,0.11523e+00_r8 /) + kbo(:, 4,44,10) = (/ & + & 0.62140e-02_r8,0.14877e+00_r8,0.18924e+00_r8,0.19525e+00_r8,0.13223e+00_r8 /) + kbo(:, 5,44,10) = (/ & + & 0.78865e-02_r8,0.16678e+00_r8,0.21196e+00_r8,0.21896e+00_r8,0.14947e+00_r8 /) + kbo(:, 1,45,10) = (/ & + & 0.28724e-02_r8,0.87295e-01_r8,0.11671e+00_r8,0.12114e+00_r8,0.78089e-01_r8 /) + kbo(:, 2,45,10) = (/ & + & 0.34468e-02_r8,0.10517e+00_r8,0.13765e+00_r8,0.14225e+00_r8,0.93322e-01_r8 /) + kbo(:, 3,45,10) = (/ & + & 0.42450e-02_r8,0.12371e+00_r8,0.15937e+00_r8,0.16431e+00_r8,0.10950e+00_r8 /) + kbo(:, 4,45,10) = (/ & + & 0.53608e-02_r8,0.14242e+00_r8,0.18156e+00_r8,0.18727e+00_r8,0.12633e+00_r8 /) + kbo(:, 5,45,10) = (/ & + & 0.69069e-02_r8,0.16067e+00_r8,0.20420e+00_r8,0.21079e+00_r8,0.14356e+00_r8 /) + kbo(:, 1,46,10) = (/ & + & 0.23836e-02_r8,0.81023e-01_r8,0.10917e+00_r8,0.11375e+00_r8,0.72722e-01_r8 /) + kbo(:, 2,46,10) = (/ & + & 0.28929e-02_r8,0.98528e-01_r8,0.12997e+00_r8,0.13446e+00_r8,0.87653e-01_r8 /) + kbo(:, 3,46,10) = (/ & + & 0.35850e-02_r8,0.11690e+00_r8,0.15139e+00_r8,0.15617e+00_r8,0.10350e+00_r8 /) + kbo(:, 4,46,10) = (/ & + & 0.45850e-02_r8,0.13564e+00_r8,0.17345e+00_r8,0.17887e+00_r8,0.12014e+00_r8 /) + kbo(:, 5,46,10) = (/ & + & 0.59899e-02_r8,0.15409e+00_r8,0.19595e+00_r8,0.20220e+00_r8,0.13729e+00_r8 /) + kbo(:, 1,47,10) = (/ & + & 0.19470e-02_r8,0.74238e-01_r8,0.10082e+00_r8,0.10569e+00_r8,0.66936e-01_r8 /) + kbo(:, 2,47,10) = (/ & + & 0.23890e-02_r8,0.91244e-01_r8,0.12148e+00_r8,0.12591e+00_r8,0.81479e-01_r8 /) + kbo(:, 3,47,10) = (/ & + & 0.29827e-02_r8,0.10934e+00_r8,0.14258e+00_r8,0.14724e+00_r8,0.96940e-01_r8 /) + kbo(:, 4,47,10) = (/ & + & 0.38583e-02_r8,0.12800e+00_r8,0.16447e+00_r8,0.16958e+00_r8,0.11333e+00_r8 /) + kbo(:, 5,47,10) = (/ & + & 0.51142e-02_r8,0.14666e+00_r8,0.18678e+00_r8,0.19270e+00_r8,0.13028e+00_r8 /) + kbo(:, 1,48,10) = (/ & + & 0.15861e-02_r8,0.67739e-01_r8,0.92637e-01_r8,0.97854e-01_r8,0.61349e-01_r8 /) + kbo(:, 2,48,10) = (/ & + & 0.19649e-02_r8,0.84157e-01_r8,0.11305e+00_r8,0.11755e+00_r8,0.75432e-01_r8 /) + kbo(:, 3,48,10) = (/ & + & 0.24852e-02_r8,0.10189e+00_r8,0.13395e+00_r8,0.13849e+00_r8,0.90556e-01_r8 /) + kbo(:, 4,48,10) = (/ & + & 0.32371e-02_r8,0.12039e+00_r8,0.15554e+00_r8,0.16041e+00_r8,0.10658e+00_r8 /) + kbo(:, 5,48,10) = (/ & + & 0.43439e-02_r8,0.13914e+00_r8,0.17770e+00_r8,0.18327e+00_r8,0.12334e+00_r8 /) + kbo(:, 1,49,10) = (/ & + & 0.12857e-02_r8,0.61441e-01_r8,0.84638e-01_r8,0.90184e-01_r8,0.55928e-01_r8 /) + kbo(:, 2,49,10) = (/ & + & 0.16127e-02_r8,0.77337e-01_r8,0.10472e+00_r8,0.10945e+00_r8,0.69577e-01_r8 /) + kbo(:, 3,49,10) = (/ & + & 0.20537e-02_r8,0.94575e-01_r8,0.12545e+00_r8,0.12989e+00_r8,0.84331e-01_r8 /) + kbo(:, 4,49,10) = (/ & + & 0.26910e-02_r8,0.11284e+00_r8,0.14670e+00_r8,0.15143e+00_r8,0.99981e-01_r8 /) + kbo(:, 5,49,10) = (/ & + & 0.36640e-02_r8,0.13156e+00_r8,0.16870e+00_r8,0.17395e+00_r8,0.11651e+00_r8 /) + kbo(:, 1,50,10) = (/ & + & 0.10457e-02_r8,0.55773e-01_r8,0.77388e-01_r8,0.83215e-01_r8,0.51035e-01_r8 /) + kbo(:, 2,50,10) = (/ & + & 0.13145e-02_r8,0.71139e-01_r8,0.96987e-01_r8,0.10202e+00_r8,0.64279e-01_r8 /) + kbo(:, 3,50,10) = (/ & + & 0.17051e-02_r8,0.87902e-01_r8,0.11756e+00_r8,0.12199e+00_r8,0.78626e-01_r8 /) + kbo(:, 4,50,10) = (/ & + & 0.22648e-02_r8,0.10582e+00_r8,0.13854e+00_r8,0.14317e+00_r8,0.93933e-01_r8 /) + kbo(:, 5,50,10) = (/ & + & 0.31061e-02_r8,0.12442e+00_r8,0.16033e+00_r8,0.16532e+00_r8,0.11017e+00_r8 /) + kbo(:, 1,51,10) = (/ & + & 0.84549e-03_r8,0.50472e-01_r8,0.70528e-01_r8,0.76615e-01_r8,0.46420e-01_r8 /) + kbo(:, 2,51,10) = (/ & + & 0.10690e-02_r8,0.65329e-01_r8,0.89631e-01_r8,0.94967e-01_r8,0.59271e-01_r8 /) + kbo(:, 3,51,10) = (/ & + & 0.14006e-02_r8,0.81572e-01_r8,0.10994e+00_r8,0.11450e+00_r8,0.73207e-01_r8 /) + kbo(:, 4,51,10) = (/ & + & 0.18893e-02_r8,0.99123e-01_r8,0.13077e+00_r8,0.13529e+00_r8,0.88203e-01_r8 /) + kbo(:, 5,51,10) = (/ & + & 0.26211e-02_r8,0.11756e+00_r8,0.15226e+00_r8,0.15707e+00_r8,0.10410e+00_r8 /) + kbo(:, 1,52,10) = (/ & + & 0.67948e-03_r8,0.45452e-01_r8,0.63925e-01_r8,0.70191e-01_r8,0.41984e-01_r8 /) + kbo(:, 2,52,10) = (/ & + & 0.86532e-03_r8,0.59697e-01_r8,0.82454e-01_r8,0.88085e-01_r8,0.54427e-01_r8 /) + kbo(:, 3,52,10) = (/ & + & 0.11431e-02_r8,0.75434e-01_r8,0.10239e+00_r8,0.10721e+00_r8,0.67964e-01_r8 /) + kbo(:, 4,52,10) = (/ & + & 0.15771e-02_r8,0.92585e-01_r8,0.12313e+00_r8,0.12757e+00_r8,0.82618e-01_r8 /) + kbo(:, 5,52,10) = (/ & + & 0.22169e-02_r8,0.11074e+00_r8,0.14429e+00_r8,0.14899e+00_r8,0.98166e-01_r8 /) + kbo(:, 1,53,10) = (/ & + & 0.54404e-03_r8,0.40689e-01_r8,0.57565e-01_r8,0.63870e-01_r8,0.37709e-01_r8 /) + kbo(:, 2,53,10) = (/ & + & 0.69516e-03_r8,0.54249e-01_r8,0.75469e-01_r8,0.81366e-01_r8,0.49728e-01_r8 /) + kbo(:, 3,53,10) = (/ & + & 0.92495e-03_r8,0.69505e-01_r8,0.94951e-01_r8,0.10007e+00_r8,0.62880e-01_r8 /) + kbo(:, 4,53,10) = (/ & + & 0.12935e-02_r8,0.86139e-01_r8,0.11548e+00_r8,0.11993e+00_r8,0.77126e-01_r8 /) + kbo(:, 5,53,10) = (/ & + & 0.18603e-02_r8,0.10397e+00_r8,0.13641e+00_r8,0.14102e+00_r8,0.92352e-01_r8 /) + kbo(:, 1,54,10) = (/ & + & 0.43618e-03_r8,0.36557e-01_r8,0.51984e-01_r8,0.58236e-01_r8,0.33960e-01_r8 /) + kbo(:, 2,54,10) = (/ & + & 0.56166e-03_r8,0.49456e-01_r8,0.69241e-01_r8,0.75371e-01_r8,0.45540e-01_r8 /) + kbo(:, 3,54,10) = (/ & + & 0.75035e-03_r8,0.64217e-01_r8,0.88252e-01_r8,0.93648e-01_r8,0.58325e-01_r8 /) + kbo(:, 4,54,10) = (/ & + & 0.10628e-02_r8,0.80385e-01_r8,0.10853e+00_r8,0.11313e+00_r8,0.72201e-01_r8 /) + kbo(:, 5,54,10) = (/ & + & 0.15600e-02_r8,0.97867e-01_r8,0.12933e+00_r8,0.13384e+00_r8,0.87138e-01_r8 /) + kbo(:, 1,55,10) = (/ & + & 0.34930e-03_r8,0.32793e-01_r8,0.46881e-01_r8,0.52981e-01_r8,0.30517e-01_r8 /) + kbo(:, 2,55,10) = (/ & + & 0.45330e-03_r8,0.45087e-01_r8,0.63469e-01_r8,0.69744e-01_r8,0.41669e-01_r8 /) + kbo(:, 3,55,10) = (/ & + & 0.61016e-03_r8,0.59300e-01_r8,0.81969e-01_r8,0.87622e-01_r8,0.54097e-01_r8 /) + kbo(:, 4,55,10) = (/ & + & 0.87186e-03_r8,0.75017e-01_r8,0.10190e+00_r8,0.10674e+00_r8,0.67613e-01_r8 /) + kbo(:, 5,55,10) = (/ & + & 0.13255e-02_r8,0.92144e-01_r8,0.12263e+00_r8,0.12707e+00_r8,0.82251e-01_r8 /) + kbo(:, 1,56,10) = (/ & + & 0.27869e-03_r8,0.29255e-01_r8,0.42021e-01_r8,0.47895e-01_r8,0.27250e-01_r8 /) + kbo(:, 2,56,10) = (/ & + & 0.36450e-03_r8,0.40920e-01_r8,0.57903e-01_r8,0.64209e-01_r8,0.37931e-01_r8 /) + kbo(:, 3,56,10) = (/ & + & 0.49136e-03_r8,0.54534e-01_r8,0.75862e-01_r8,0.81747e-01_r8,0.49990e-01_r8 /) + kbo(:, 4,56,10) = (/ & + & 0.71172e-03_r8,0.69828e-01_r8,0.95390e-01_r8,0.10049e+00_r8,0.63168e-01_r8 /) + kbo(:, 5,56,10) = (/ & + & 0.11017e-02_r8,0.86502e-01_r8,0.11594e+00_r8,0.12039e+00_r8,0.77442e-01_r8 /) + kbo(:, 1,57,10) = (/ & + & 0.22107e-03_r8,0.25925e-01_r8,0.37436e-01_r8,0.42992e-01_r8,0.24134e-01_r8 /) + kbo(:, 2,57,10) = (/ & + & 0.29170e-03_r8,0.36963e-01_r8,0.52553e-01_r8,0.58819e-01_r8,0.34341e-01_r8 /) + kbo(:, 3,57,10) = (/ & + & 0.39477e-03_r8,0.49943e-01_r8,0.69900e-01_r8,0.76011e-01_r8,0.45979e-01_r8 /) + kbo(:, 4,57,10) = (/ & + & 0.57598e-03_r8,0.64771e-01_r8,0.88986e-01_r8,0.94351e-01_r8,0.58814e-01_r8 /) + kbo(:, 5,57,10) = (/ & + & 0.90995e-03_r8,0.80998e-01_r8,0.10929e+00_r8,0.11387e+00_r8,0.72731e-01_r8 /) + kbo(:, 1,58,10) = (/ & + & 0.17561e-03_r8,0.22952e-01_r8,0.33334e-01_r8,0.38531e-01_r8,0.21328e-01_r8 /) + kbo(:, 2,58,10) = (/ & + & 0.23328e-03_r8,0.33378e-01_r8,0.47700e-01_r8,0.53835e-01_r8,0.31067e-01_r8 /) + kbo(:, 3,58,10) = (/ & + & 0.31697e-03_r8,0.45784e-01_r8,0.64416e-01_r8,0.70683e-01_r8,0.42303e-01_r8 /) + kbo(:, 4,58,10) = (/ & + & 0.46537e-03_r8,0.60108e-01_r8,0.83029e-01_r8,0.88636e-01_r8,0.54797e-01_r8 /) + kbo(:, 5,58,10) = (/ & + & 0.74786e-03_r8,0.75908e-01_r8,0.10302e+00_r8,0.10782e+00_r8,0.68377e-01_r8 /) + kbo(:, 1,59,10) = (/ & + & 0.14648e-03_r8,0.21806e-01_r8,0.31752e-01_r8,0.36796e-01_r8,0.20240e-01_r8 /) + kbo(:, 2,59,10) = (/ & + & 0.19618e-03_r8,0.31995e-01_r8,0.45805e-01_r8,0.51875e-01_r8,0.29797e-01_r8 /) + kbo(:, 3,59,10) = (/ & + & 0.27063e-03_r8,0.44166e-01_r8,0.62268e-01_r8,0.68564e-01_r8,0.40859e-01_r8 /) + kbo(:, 4,59,10) = (/ & + & 0.40629e-03_r8,0.58271e-01_r8,0.80681e-01_r8,0.86380e-01_r8,0.53223e-01_r8 /) + kbo(:, 5,59,10) = (/ & + & 0.67143e-03_r8,0.73904e-01_r8,0.10053e+00_r8,0.10542e+00_r8,0.66665e-01_r8 /) + kbo(:, 1,13,11) = (/ & + & 0.43607e+00_r8,0.62808e+00_r8,0.71724e+00_r8,0.73315e+00_r8,0.60101e+00_r8 /) + kbo(:, 2,13,11) = (/ & + & 0.43332e+00_r8,0.62604e+00_r8,0.71980e+00_r8,0.74002e+00_r8,0.61186e+00_r8 /) + kbo(:, 3,13,11) = (/ & + & 0.43924e+00_r8,0.62431e+00_r8,0.72116e+00_r8,0.74635e+00_r8,0.62343e+00_r8 /) + kbo(:, 4,13,11) = (/ & + & 0.44984e+00_r8,0.62482e+00_r8,0.72168e+00_r8,0.75298e+00_r8,0.63261e+00_r8 /) + kbo(:, 5,13,11) = (/ & + & 0.46047e+00_r8,0.63112e+00_r8,0.72222e+00_r8,0.75987e+00_r8,0.64021e+00_r8 /) + kbo(:, 1,14,11) = (/ & + & 0.38105e+00_r8,0.57533e+00_r8,0.67001e+00_r8,0.68808e+00_r8,0.55899e+00_r8 /) + kbo(:, 2,14,11) = (/ & + & 0.38509e+00_r8,0.57518e+00_r8,0.67285e+00_r8,0.69660e+00_r8,0.57227e+00_r8 /) + kbo(:, 3,14,11) = (/ & + & 0.39449e+00_r8,0.57649e+00_r8,0.67532e+00_r8,0.70510e+00_r8,0.58361e+00_r8 /) + kbo(:, 4,14,11) = (/ & + & 0.40382e+00_r8,0.58297e+00_r8,0.67784e+00_r8,0.71417e+00_r8,0.59305e+00_r8 /) + kbo(:, 5,14,11) = (/ & + & 0.41367e+00_r8,0.59430e+00_r8,0.68136e+00_r8,0.72200e+00_r8,0.60202e+00_r8 /) + kbo(:, 1,15,11) = (/ & + & 0.33634e+00_r8,0.52577e+00_r8,0.62172e+00_r8,0.64383e+00_r8,0.51752e+00_r8 /) + kbo(:, 2,15,11) = (/ & + & 0.34434e+00_r8,0.52795e+00_r8,0.62601e+00_r8,0.65389e+00_r8,0.53138e+00_r8 /) + kbo(:, 3,15,11) = (/ & + & 0.35278e+00_r8,0.53440e+00_r8,0.63064e+00_r8,0.66483e+00_r8,0.54288e+00_r8 /) + kbo(:, 4,15,11) = (/ & + & 0.36194e+00_r8,0.54564e+00_r8,0.63643e+00_r8,0.67473e+00_r8,0.55371e+00_r8 /) + kbo(:, 5,15,11) = (/ & + & 0.37392e+00_r8,0.55836e+00_r8,0.64562e+00_r8,0.68317e+00_r8,0.56497e+00_r8 /) + kbo(:, 1,16,11) = (/ & + & 0.29938e+00_r8,0.48063e+00_r8,0.57442e+00_r8,0.60090e+00_r8,0.47563e+00_r8 /) + kbo(:, 2,16,11) = (/ & + & 0.30677e+00_r8,0.48684e+00_r8,0.58100e+00_r8,0.61362e+00_r8,0.49008e+00_r8 /) + kbo(:, 3,16,11) = (/ & + & 0.31495e+00_r8,0.49797e+00_r8,0.58852e+00_r8,0.62578e+00_r8,0.50309e+00_r8 /) + kbo(:, 4,16,11) = (/ & + & 0.32635e+00_r8,0.51101e+00_r8,0.59933e+00_r8,0.63613e+00_r8,0.51641e+00_r8 /) + kbo(:, 5,16,11) = (/ & + & 0.34098e+00_r8,0.52383e+00_r8,0.61318e+00_r8,0.64534e+00_r8,0.52976e+00_r8 /) + kbo(:, 1,17,11) = (/ & + & 0.26573e+00_r8,0.44123e+00_r8,0.53003e+00_r8,0.56054e+00_r8,0.43533e+00_r8 /) + kbo(:, 2,17,11) = (/ & + & 0.27295e+00_r8,0.45155e+00_r8,0.53872e+00_r8,0.57479e+00_r8,0.45023e+00_r8 /) + kbo(:, 3,17,11) = (/ & + & 0.28334e+00_r8,0.46499e+00_r8,0.55060e+00_r8,0.58775e+00_r8,0.46535e+00_r8 /) + kbo(:, 4,17,11) = (/ & + & 0.29718e+00_r8,0.47854e+00_r8,0.56610e+00_r8,0.59925e+00_r8,0.48105e+00_r8 /) + kbo(:, 5,17,11) = (/ & + & 0.31347e+00_r8,0.49215e+00_r8,0.58364e+00_r8,0.61031e+00_r8,0.49645e+00_r8 /) + kbo(:, 1,18,11) = (/ & + & 0.23548e+00_r8,0.40722e+00_r8,0.48899e+00_r8,0.52175e+00_r8,0.39754e+00_r8 /) + kbo(:, 2,18,11) = (/ & + & 0.24465e+00_r8,0.42091e+00_r8,0.50155e+00_r8,0.53754e+00_r8,0.41400e+00_r8 /) + kbo(:, 3,18,11) = (/ & + & 0.25717e+00_r8,0.43494e+00_r8,0.51756e+00_r8,0.55168e+00_r8,0.43132e+00_r8 /) + kbo(:, 4,18,11) = (/ & + & 0.27241e+00_r8,0.44915e+00_r8,0.53619e+00_r8,0.56524e+00_r8,0.44875e+00_r8 /) + kbo(:, 5,18,11) = (/ & + & 0.28792e+00_r8,0.46398e+00_r8,0.55551e+00_r8,0.57930e+00_r8,0.46590e+00_r8 /) + kbo(:, 1,19,11) = (/ & + & 0.20944e+00_r8,0.37826e+00_r8,0.45234e+00_r8,0.48406e+00_r8,0.36392e+00_r8 /) + kbo(:, 2,19,11) = (/ & + & 0.22089e+00_r8,0.39288e+00_r8,0.46903e+00_r8,0.50178e+00_r8,0.38211e+00_r8 /) + kbo(:, 3,19,11) = (/ & + & 0.23514e+00_r8,0.40761e+00_r8,0.48827e+00_r8,0.51821e+00_r8,0.40103e+00_r8 /) + kbo(:, 4,19,11) = (/ & + & 0.24973e+00_r8,0.42303e+00_r8,0.50894e+00_r8,0.53472e+00_r8,0.42003e+00_r8 /) + kbo(:, 5,19,11) = (/ & + & 0.26400e+00_r8,0.44033e+00_r8,0.52950e+00_r8,0.55236e+00_r8,0.43892e+00_r8 /) + kbo(:, 1,20,11) = (/ & + & 0.18773e+00_r8,0.35288e+00_r8,0.42094e+00_r8,0.44918e+00_r8,0.33536e+00_r8 /) + kbo(:, 2,20,11) = (/ & + & 0.20090e+00_r8,0.36792e+00_r8,0.44069e+00_r8,0.46887e+00_r8,0.35493e+00_r8 /) + kbo(:, 3,20,11) = (/ & + & 0.21482e+00_r8,0.38362e+00_r8,0.46266e+00_r8,0.48831e+00_r8,0.37530e+00_r8 /) + kbo(:, 4,20,11) = (/ & + & 0.22865e+00_r8,0.40117e+00_r8,0.48452e+00_r8,0.50881e+00_r8,0.39557e+00_r8 /) + kbo(:, 5,20,11) = (/ & + & 0.24234e+00_r8,0.42087e+00_r8,0.50657e+00_r8,0.53012e+00_r8,0.41595e+00_r8 /) + kbo(:, 1,21,11) = (/ & + & 0.16913e+00_r8,0.33019e+00_r8,0.39388e+00_r8,0.41795e+00_r8,0.31127e+00_r8 /) + kbo(:, 2,21,11) = (/ & + & 0.18253e+00_r8,0.34600e+00_r8,0.41645e+00_r8,0.43947e+00_r8,0.33210e+00_r8 /) + kbo(:, 3,21,11) = (/ & + & 0.19592e+00_r8,0.36350e+00_r8,0.43977e+00_r8,0.46279e+00_r8,0.35347e+00_r8 /) + kbo(:, 4,21,11) = (/ & + & 0.20921e+00_r8,0.38317e+00_r8,0.46337e+00_r8,0.48719e+00_r8,0.37483e+00_r8 /) + kbo(:, 5,21,11) = (/ & + & 0.22258e+00_r8,0.40476e+00_r8,0.48708e+00_r8,0.51206e+00_r8,0.39691e+00_r8 /) + kbo(:, 1,22,11) = (/ & + & 0.15329e+00_r8,0.31121e+00_r8,0.37219e+00_r8,0.39211e+00_r8,0.29266e+00_r8 /) + kbo(:, 2,22,11) = (/ & + & 0.16615e+00_r8,0.32878e+00_r8,0.39682e+00_r8,0.41672e+00_r8,0.31445e+00_r8 /) + kbo(:, 3,22,11) = (/ & + & 0.17924e+00_r8,0.34835e+00_r8,0.42167e+00_r8,0.44342e+00_r8,0.33660e+00_r8 /) + kbo(:, 4,22,11) = (/ & + & 0.19225e+00_r8,0.36990e+00_r8,0.44699e+00_r8,0.47133e+00_r8,0.35944e+00_r8 /) + kbo(:, 5,22,11) = (/ & + & 0.20541e+00_r8,0.39323e+00_r8,0.47271e+00_r8,0.49943e+00_r8,0.38308e+00_r8 /) + kbo(:, 1,23,11) = (/ & + & 0.13887e+00_r8,0.29534e+00_r8,0.35451e+00_r8,0.37144e+00_r8,0.27763e+00_r8 /) + kbo(:, 2,23,11) = (/ & + & 0.15131e+00_r8,0.31502e+00_r8,0.38068e+00_r8,0.39927e+00_r8,0.30013e+00_r8 /) + kbo(:, 3,23,11) = (/ & + & 0.16398e+00_r8,0.33651e+00_r8,0.40726e+00_r8,0.42913e+00_r8,0.32331e+00_r8 /) + kbo(:, 4,23,11) = (/ & + & 0.17699e+00_r8,0.35967e+00_r8,0.43436e+00_r8,0.45990e+00_r8,0.34758e+00_r8 /) + kbo(:, 5,23,11) = (/ & + & 0.19026e+00_r8,0.38467e+00_r8,0.46223e+00_r8,0.49074e+00_r8,0.37282e+00_r8 /) + kbo(:, 1,24,11) = (/ & + & 0.12585e+00_r8,0.28281e+00_r8,0.34015e+00_r8,0.35619e+00_r8,0.26580e+00_r8 /) + kbo(:, 2,24,11) = (/ & + & 0.13791e+00_r8,0.30436e+00_r8,0.36812e+00_r8,0.38675e+00_r8,0.28903e+00_r8 /) + kbo(:, 3,24,11) = (/ & + & 0.15049e+00_r8,0.32769e+00_r8,0.39648e+00_r8,0.41925e+00_r8,0.31342e+00_r8 /) + kbo(:, 4,24,11) = (/ & + & 0.16367e+00_r8,0.35256e+00_r8,0.42575e+00_r8,0.45270e+00_r8,0.33923e+00_r8 /) + kbo(:, 5,24,11) = (/ & + & 0.17705e+00_r8,0.37855e+00_r8,0.45558e+00_r8,0.48562e+00_r8,0.36598e+00_r8 /) + kbo(:, 1,25,11) = (/ & + & 0.11440e+00_r8,0.27340e+00_r8,0.32939e+00_r8,0.34570e+00_r8,0.25676e+00_r8 /) + kbo(:, 2,25,11) = (/ & + & 0.12619e+00_r8,0.29667e+00_r8,0.35918e+00_r8,0.37882e+00_r8,0.28103e+00_r8 /) + kbo(:, 3,25,11) = (/ & + & 0.13880e+00_r8,0.32182e+00_r8,0.38965e+00_r8,0.41370e+00_r8,0.30678e+00_r8 /) + kbo(:, 4,25,11) = (/ & + & 0.15209e+00_r8,0.34806e+00_r8,0.42076e+00_r8,0.44907e+00_r8,0.33404e+00_r8 /) + kbo(:, 5,25,11) = (/ & + & 0.16564e+00_r8,0.37478e+00_r8,0.45238e+00_r8,0.48364e+00_r8,0.36209e+00_r8 /) + kbo(:, 1,26,11) = (/ & + & 0.10459e+00_r8,0.26698e+00_r8,0.32246e+00_r8,0.33976e+00_r8,0.25076e+00_r8 /) + kbo(:, 2,26,11) = (/ & + & 0.11626e+00_r8,0.29209e+00_r8,0.35422e+00_r8,0.37512e+00_r8,0.27618e+00_r8 /) + kbo(:, 3,26,11) = (/ & + & 0.12895e+00_r8,0.31885e+00_r8,0.38669e+00_r8,0.41203e+00_r8,0.30332e+00_r8 /) + kbo(:, 4,26,11) = (/ & + & 0.14230e+00_r8,0.34607e+00_r8,0.41933e+00_r8,0.44889e+00_r8,0.33190e+00_r8 /) + kbo(:, 5,26,11) = (/ & + & 0.15605e+00_r8,0.37346e+00_r8,0.45243e+00_r8,0.48462e+00_r8,0.36103e+00_r8 /) + kbo(:, 1,27,11) = (/ & + & 0.96118e-01_r8,0.26319e+00_r8,0.31888e+00_r8,0.33748e+00_r8,0.24718e+00_r8 /) + kbo(:, 2,27,11) = (/ & + & 0.10777e+00_r8,0.29006e+00_r8,0.35247e+00_r8,0.37471e+00_r8,0.27379e+00_r8 /) + kbo(:, 3,27,11) = (/ & + & 0.12054e+00_r8,0.31789e+00_r8,0.38657e+00_r8,0.41315e+00_r8,0.30239e+00_r8 /) + kbo(:, 4,27,11) = (/ & + & 0.13403e+00_r8,0.34597e+00_r8,0.42050e+00_r8,0.45108e+00_r8,0.33196e+00_r8 /) + kbo(:, 5,27,11) = (/ & + & 0.14803e+00_r8,0.37409e+00_r8,0.45469e+00_r8,0.48753e+00_r8,0.36202e+00_r8 /) + kbo(:, 1,28,11) = (/ & + & 0.88934e-01_r8,0.26189e+00_r8,0.31824e+00_r8,0.33815e+00_r8,0.24575e+00_r8 /) + kbo(:, 2,28,11) = (/ & + & 0.10066e+00_r8,0.29004e+00_r8,0.35339e+00_r8,0.37699e+00_r8,0.27368e+00_r8 /) + kbo(:, 3,28,11) = (/ & + & 0.11346e+00_r8,0.31878e+00_r8,0.38868e+00_r8,0.41646e+00_r8,0.30334e+00_r8 /) + kbo(:, 4,28,11) = (/ & + & 0.12719e+00_r8,0.34746e+00_r8,0.42368e+00_r8,0.45510e+00_r8,0.33384e+00_r8 /) + kbo(:, 5,28,11) = (/ & + & 0.14149e+00_r8,0.37622e+00_r8,0.45856e+00_r8,0.49189e+00_r8,0.36458e+00_r8 /) + kbo(:, 1,29,11) = (/ & + & 0.82953e-01_r8,0.26276e+00_r8,0.32032e+00_r8,0.34153e+00_r8,0.24649e+00_r8 /) + kbo(:, 2,29,11) = (/ & + & 0.94812e-01_r8,0.29186e+00_r8,0.35678e+00_r8,0.38153e+00_r8,0.27563e+00_r8 /) + kbo(:, 3,29,11) = (/ & + & 0.10778e+00_r8,0.32138e+00_r8,0.39278e+00_r8,0.42163e+00_r8,0.30623e+00_r8 /) + kbo(:, 4,29,11) = (/ & + & 0.12182e+00_r8,0.35053e+00_r8,0.42853e+00_r8,0.46064e+00_r8,0.33743e+00_r8 /) + kbo(:, 5,29,11) = (/ & + & 0.13655e+00_r8,0.37990e+00_r8,0.46387e+00_r8,0.49754e+00_r8,0.36866e+00_r8 /) + kbo(:, 1,30,11) = (/ & + & 0.78111e-01_r8,0.26530e+00_r8,0.32451e+00_r8,0.34680e+00_r8,0.24893e+00_r8 /) + kbo(:, 2,30,11) = (/ & + & 0.90075e-01_r8,0.29517e+00_r8,0.36183e+00_r8,0.38763e+00_r8,0.27915e+00_r8 /) + kbo(:, 3,30,11) = (/ & + & 0.10336e+00_r8,0.32522e+00_r8,0.39838e+00_r8,0.42809e+00_r8,0.31046e+00_r8 /) + kbo(:, 4,30,11) = (/ & + & 0.11787e+00_r8,0.35483e+00_r8,0.43455e+00_r8,0.46718e+00_r8,0.34218e+00_r8 /) + kbo(:, 5,30,11) = (/ & + & 0.13307e+00_r8,0.38452e+00_r8,0.47003e+00_r8,0.50395e+00_r8,0.37368e+00_r8 /) + kbo(:, 1,31,11) = (/ & + & 0.74235e-01_r8,0.26927e+00_r8,0.33033e+00_r8,0.35368e+00_r8,0.25294e+00_r8 /) + kbo(:, 2,31,11) = (/ & + & 0.86475e-01_r8,0.29980e+00_r8,0.36814e+00_r8,0.39505e+00_r8,0.28398e+00_r8 /) + kbo(:, 3,31,11) = (/ & + & 0.10025e+00_r8,0.33020e+00_r8,0.40500e+00_r8,0.43563e+00_r8,0.31586e+00_r8 /) + kbo(:, 4,31,11) = (/ & + & 0.11530e+00_r8,0.36008e+00_r8,0.44151e+00_r8,0.47461e+00_r8,0.34790e+00_r8 /) + kbo(:, 5,31,11) = (/ & + & 0.13103e+00_r8,0.38989e+00_r8,0.47695e+00_r8,0.51108e+00_r8,0.37953e+00_r8 /) + kbo(:, 1,32,11) = (/ & + & 0.71362e-01_r8,0.27445e+00_r8,0.33748e+00_r8,0.36171e+00_r8,0.25820e+00_r8 /) + kbo(:, 2,32,11) = (/ & + & 0.84060e-01_r8,0.30547e+00_r8,0.37545e+00_r8,0.40335e+00_r8,0.28988e+00_r8 /) + kbo(:, 3,32,11) = (/ & + & 0.98456e-01_r8,0.33600e+00_r8,0.41253e+00_r8,0.44393e+00_r8,0.32217e+00_r8 /) + kbo(:, 4,32,11) = (/ & + & 0.11408e+00_r8,0.36612e+00_r8,0.44914e+00_r8,0.48266e+00_r8,0.35443e+00_r8 /) + kbo(:, 5,32,11) = (/ & + & 0.13035e+00_r8,0.39590e+00_r8,0.48448e+00_r8,0.51873e+00_r8,0.38602e+00_r8 /) + kbo(:, 1,33,11) = (/ & + & 0.69437e-01_r8,0.28056e+00_r8,0.34548e+00_r8,0.37055e+00_r8,0.26439e+00_r8 /) + kbo(:, 2,33,11) = (/ & + & 0.82778e-01_r8,0.31179e+00_r8,0.38345e+00_r8,0.41222e+00_r8,0.29653e+00_r8 /) + kbo(:, 3,33,11) = (/ & + & 0.97818e-01_r8,0.34234e+00_r8,0.42058e+00_r8,0.45271e+00_r8,0.32902e+00_r8 /) + kbo(:, 4,33,11) = (/ & + & 0.11406e+00_r8,0.37264e+00_r8,0.45719e+00_r8,0.49102e+00_r8,0.36138e+00_r8 /) + kbo(:, 5,33,11) = (/ & + & 0.13083e+00_r8,0.40228e+00_r8,0.49234e+00_r8,0.52669e+00_r8,0.39293e+00_r8 /) + kbo(:, 1,34,11) = (/ & + & 0.68001e-01_r8,0.28611e+00_r8,0.35258e+00_r8,0.37843e+00_r8,0.27007e+00_r8 /) + kbo(:, 2,34,11) = (/ & + & 0.82015e-01_r8,0.31742e+00_r8,0.39059e+00_r8,0.42007e+00_r8,0.30253e+00_r8 /) + kbo(:, 3,34,11) = (/ & + & 0.97684e-01_r8,0.34800e+00_r8,0.42777e+00_r8,0.46038e+00_r8,0.33518e+00_r8 /) + kbo(:, 4,34,11) = (/ & + & 0.11453e+00_r8,0.37836e+00_r8,0.46423e+00_r8,0.49832e+00_r8,0.36754e+00_r8 /) + kbo(:, 5,34,11) = (/ & + & 0.13165e+00_r8,0.40799e+00_r8,0.49927e+00_r8,0.53358e+00_r8,0.39902e+00_r8 /) + kbo(:, 1,35,11) = (/ & + & 0.66173e-01_r8,0.28901e+00_r8,0.35634e+00_r8,0.38261e+00_r8,0.27305e+00_r8 /) + kbo(:, 2,35,11) = (/ & + & 0.80679e-01_r8,0.32036e+00_r8,0.39443e+00_r8,0.42428e+00_r8,0.30572e+00_r8 /) + kbo(:, 3,35,11) = (/ & + & 0.96839e-01_r8,0.35097e+00_r8,0.43164e+00_r8,0.46448e+00_r8,0.33845e+00_r8 /) + kbo(:, 4,35,11) = (/ & + & 0.11412e+00_r8,0.38139e+00_r8,0.46804e+00_r8,0.50225e+00_r8,0.37079e+00_r8 /) + kbo(:, 5,35,11) = (/ & + & 0.13154e+00_r8,0.41104e+00_r8,0.50302e+00_r8,0.53730e+00_r8,0.40230e+00_r8 /) + kbo(:, 1,36,11) = (/ & + & 0.63512e-01_r8,0.28876e+00_r8,0.35615e+00_r8,0.38246e+00_r8,0.27277e+00_r8 /) + kbo(:, 2,36,11) = (/ & + & 0.78322e-01_r8,0.32017e+00_r8,0.39440e+00_r8,0.42423e+00_r8,0.30554e+00_r8 /) + kbo(:, 3,36,11) = (/ & + & 0.94792e-01_r8,0.35084e+00_r8,0.43169e+00_r8,0.46451e+00_r8,0.33835e+00_r8 /) + kbo(:, 4,36,11) = (/ & + & 0.11239e+00_r8,0.38129e+00_r8,0.46814e+00_r8,0.50234e+00_r8,0.37075e+00_r8 /) + kbo(:, 5,36,11) = (/ & + & 0.13007e+00_r8,0.41105e+00_r8,0.50318e+00_r8,0.53745e+00_r8,0.40235e+00_r8 /) + kbo(:, 1,37,11) = (/ & + & 0.59276e-01_r8,0.28388e+00_r8,0.35018e+00_r8,0.37605e+00_r8,0.26777e+00_r8 /) + kbo(:, 2,37,11) = (/ & + & 0.74070e-01_r8,0.31543e+00_r8,0.38877e+00_r8,0.41809e+00_r8,0.30055e+00_r8 /) + kbo(:, 3,37,11) = (/ & + & 0.90621e-01_r8,0.34621e+00_r8,0.42622e+00_r8,0.45870e+00_r8,0.33345e+00_r8 /) + kbo(:, 4,37,11) = (/ & + & 0.10838e+00_r8,0.37677e+00_r8,0.46291e+00_r8,0.49695e+00_r8,0.36598e+00_r8 /) + kbo(:, 5,37,11) = (/ & + & 0.12629e+00_r8,0.40664e+00_r8,0.49817e+00_r8,0.53255e+00_r8,0.39771e+00_r8 /) + kbo(:, 1,38,11) = (/ & + & 0.55352e-01_r8,0.27885e+00_r8,0.34399e+00_r8,0.36943e+00_r8,0.26263e+00_r8 /) + kbo(:, 2,38,11) = (/ & + & 0.70099e-01_r8,0.31053e+00_r8,0.38289e+00_r8,0.41165e+00_r8,0.29537e+00_r8 /) + kbo(:, 3,38,11) = (/ & + & 0.86674e-01_r8,0.34144e+00_r8,0.42052e+00_r8,0.45261e+00_r8,0.32834e+00_r8 /) + kbo(:, 4,38,11) = (/ & + & 0.10451e+00_r8,0.37207e+00_r8,0.45745e+00_r8,0.49130e+00_r8,0.36103e+00_r8 /) + kbo(:, 5,38,11) = (/ & + & 0.12261e+00_r8,0.40208e+00_r8,0.49291e+00_r8,0.52735e+00_r8,0.39288e+00_r8 /) + kbo(:, 1,39,11) = (/ & + & 0.51830e-01_r8,0.27388e+00_r8,0.33795e+00_r8,0.36294e+00_r8,0.25765e+00_r8 /) + kbo(:, 2,39,11) = (/ & + & 0.66473e-01_r8,0.30570e+00_r8,0.37709e+00_r8,0.40534e+00_r8,0.29029e+00_r8 /) + kbo(:, 3,39,11) = (/ & + & 0.83032e-01_r8,0.33678e+00_r8,0.41490e+00_r8,0.44656e+00_r8,0.32332e+00_r8 /) + kbo(:, 4,39,11) = (/ & + & 0.10089e+00_r8,0.36746e+00_r8,0.45203e+00_r8,0.48569e+00_r8,0.35615e+00_r8 /) + kbo(:, 5,39,11) = (/ & + & 0.11914e+00_r8,0.39759e+00_r8,0.48773e+00_r8,0.52218e+00_r8,0.38813e+00_r8 /) + kbo(:, 1,40,11) = (/ & + & 0.47273e-01_r8,0.26566e+00_r8,0.32789e+00_r8,0.35219e+00_r8,0.24948e+00_r8 /) + kbo(:, 2,40,11) = (/ & + & 0.61538e-01_r8,0.29768e+00_r8,0.36730e+00_r8,0.39473e+00_r8,0.28193e+00_r8 /) + kbo(:, 3,40,11) = (/ & + & 0.77858e-01_r8,0.32903e+00_r8,0.40551e+00_r8,0.43635e+00_r8,0.31499e+00_r8 /) + kbo(:, 4,40,11) = (/ & + & 0.95580e-01_r8,0.35975e+00_r8,0.44288e+00_r8,0.47617e+00_r8,0.34794e+00_r8 /) + kbo(:, 5,40,11) = (/ & + & 0.11394e+00_r8,0.39008e+00_r8,0.47900e+00_r8,0.51333e+00_r8,0.38020e+00_r8 /) + kbo(:, 1,41,11) = (/ & + & 0.42888e-01_r8,0.25708e+00_r8,0.31732e+00_r8,0.34096e+00_r8,0.24098e+00_r8 /) + kbo(:, 2,41,11) = (/ & + & 0.56697e-01_r8,0.28927e+00_r8,0.35696e+00_r8,0.38355e+00_r8,0.27327e+00_r8 /) + kbo(:, 3,41,11) = (/ & + & 0.72702e-01_r8,0.32083e+00_r8,0.39561e+00_r8,0.42555e+00_r8,0.30626e+00_r8 /) + kbo(:, 4,41,11) = (/ & + & 0.90227e-01_r8,0.35164e+00_r8,0.43315e+00_r8,0.46599e+00_r8,0.33930e+00_r8 /) + kbo(:, 5,41,11) = (/ & + & 0.10861e+00_r8,0.38219e+00_r8,0.46971e+00_r8,0.50385e+00_r8,0.37183e+00_r8 /) + kbo(:, 1,42,11) = (/ & + & 0.38819e-01_r8,0.24850e+00_r8,0.30677e+00_r8,0.32968e+00_r8,0.23256e+00_r8 /) + kbo(:, 2,42,11) = (/ & + & 0.52147e-01_r8,0.28080e+00_r8,0.34660e+00_r8,0.37239e+00_r8,0.26466e+00_r8 /) + kbo(:, 3,42,11) = (/ & + & 0.67768e-01_r8,0.31263e+00_r8,0.38564e+00_r8,0.41466e+00_r8,0.29758e+00_r8 /) + kbo(:, 4,42,11) = (/ & + & 0.85041e-01_r8,0.34356e+00_r8,0.42336e+00_r8,0.45563e+00_r8,0.33065e+00_r8 /) + kbo(:, 5,42,11) = (/ & + & 0.10335e+00_r8,0.37426e+00_r8,0.46032e+00_r8,0.49419e+00_r8,0.36339e+00_r8 /) + kbo(:, 1,43,11) = (/ & + & 0.34406e-01_r8,0.23801e+00_r8,0.29406e+00_r8,0.31601e+00_r8,0.22240e+00_r8 /) + kbo(:, 2,43,11) = (/ & + & 0.47048e-01_r8,0.27050e+00_r8,0.33401e+00_r8,0.35883e+00_r8,0.25435e+00_r8 /) + kbo(:, 3,43,11) = (/ & + & 0.62114e-01_r8,0.30257e+00_r8,0.37337e+00_r8,0.40135e+00_r8,0.28701e+00_r8 /) + kbo(:, 4,43,11) = (/ & + & 0.79018e-01_r8,0.33381e+00_r8,0.41146e+00_r8,0.44285e+00_r8,0.32012e+00_r8 /) + kbo(:, 5,43,11) = (/ & + & 0.97123e-01_r8,0.36459e+00_r8,0.44877e+00_r8,0.48229e+00_r8,0.35311e+00_r8 /) + kbo(:, 1,44,11) = (/ & + & 0.30068e-01_r8,0.22661e+00_r8,0.28047e+00_r8,0.30141e+00_r8,0.21157e+00_r8 /) + kbo(:, 2,44,11) = (/ & + & 0.41934e-01_r8,0.25939e+00_r8,0.32031e+00_r8,0.34420e+00_r8,0.24331e+00_r8 /) + kbo(:, 3,44,11) = (/ & + & 0.56334e-01_r8,0.29165e+00_r8,0.35997e+00_r8,0.38686e+00_r8,0.27569e+00_r8 /) + kbo(:, 4,44,11) = (/ & + & 0.72738e-01_r8,0.32319e+00_r8,0.39860e+00_r8,0.42881e+00_r8,0.30880e+00_r8 /) + kbo(:, 5,44,11) = (/ & + & 0.90538e-01_r8,0.35407e+00_r8,0.43616e+00_r8,0.46913e+00_r8,0.34187e+00_r8 /) + kbo(:, 1,45,11) = (/ & + & 0.26090e-01_r8,0.21511e+00_r8,0.26705e+00_r8,0.28701e+00_r8,0.20089e+00_r8 /) + kbo(:, 2,45,11) = (/ & + & 0.37182e-01_r8,0.24828e+00_r8,0.30662e+00_r8,0.32954e+00_r8,0.23239e+00_r8 /) + kbo(:, 3,45,11) = (/ & + & 0.50828e-01_r8,0.28069e+00_r8,0.34649e+00_r8,0.37235e+00_r8,0.26452e+00_r8 /) + kbo(:, 4,45,11) = (/ & + & 0.66683e-01_r8,0.31254e+00_r8,0.38562e+00_r8,0.41465e+00_r8,0.29751e+00_r8 /) + kbo(:, 5,45,11) = (/ & + & 0.84110e-01_r8,0.34354e+00_r8,0.42341e+00_r8,0.45565e+00_r8,0.33061e+00_r8 /) + kbo(:, 1,46,11) = (/ & + & 0.22282e-01_r8,0.20276e+00_r8,0.25300e+00_r8,0.27194e+00_r8,0.18966e+00_r8 /) + kbo(:, 2,46,11) = (/ & + & 0.32494e-01_r8,0.23634e+00_r8,0.29212e+00_r8,0.31397e+00_r8,0.22083e+00_r8 /) + kbo(:, 3,46,11) = (/ & + & 0.45322e-01_r8,0.26893e+00_r8,0.33209e+00_r8,0.35685e+00_r8,0.25276e+00_r8 /) + kbo(:, 4,46,11) = (/ & + & 0.60492e-01_r8,0.30105e+00_r8,0.37160e+00_r8,0.39945e+00_r8,0.28546e+00_r8 /) + kbo(:, 5,46,11) = (/ & + & 0.77449e-01_r8,0.33241e+00_r8,0.40979e+00_r8,0.44100e+00_r8,0.31859e+00_r8 /) + kbo(:, 1,47,11) = (/ & + & 0.18534e-01_r8,0.18898e+00_r8,0.23758e+00_r8,0.25552e+00_r8,0.17724e+00_r8 /) + kbo(:, 2,47,11) = (/ & + & 0.27732e-01_r8,0.22283e+00_r8,0.27608e+00_r8,0.29673e+00_r8,0.20806e+00_r8 /) + kbo(:, 3,47,11) = (/ & + & 0.39604e-01_r8,0.25581e+00_r8,0.31589e+00_r8,0.33953e+00_r8,0.23975e+00_r8 /) + kbo(:, 4,47,11) = (/ & + & 0.53911e-01_r8,0.28814e+00_r8,0.35568e+00_r8,0.38226e+00_r8,0.27210e+00_r8 /) + kbo(:, 5,47,11) = (/ & + & 0.70242e-01_r8,0.31982e+00_r8,0.39452e+00_r8,0.42435e+00_r8,0.30521e+00_r8 /) + kbo(:, 1,48,11) = (/ & + & 0.15230e-01_r8,0.17512e+00_r8,0.22238e+00_r8,0.23953e+00_r8,0.16496e+00_r8 /) + kbo(:, 2,48,11) = (/ & + & 0.23424e-01_r8,0.20917e+00_r8,0.26028e+00_r8,0.27977e+00_r8,0.19549e+00_r8 /) + kbo(:, 3,48,11) = (/ & + & 0.34289e-01_r8,0.24261e+00_r8,0.29967e+00_r8,0.32213e+00_r8,0.22686e+00_r8 /) + kbo(:, 4,48,11) = (/ & + & 0.47677e-01_r8,0.27510e+00_r8,0.33967e+00_r8,0.36502e+00_r8,0.25892e+00_r8 /) + kbo(:, 5,48,11) = (/ & + & 0.63303e-01_r8,0.30711e+00_r8,0.37902e+00_r8,0.40749e+00_r8,0.29180e+00_r8 /) + kbo(:, 1,49,11) = (/ & + & 0.12348e-01_r8,0.16145e+00_r8,0.20748e+00_r8,0.22396e+00_r8,0.15290e+00_r8 /) + kbo(:, 2,49,11) = (/ & + & 0.19656e-01_r8,0.19547e+00_r8,0.24481e+00_r8,0.26319e+00_r8,0.18304e+00_r8 /) + kbo(:, 3,49,11) = (/ & + & 0.29411e-01_r8,0.22922e+00_r8,0.28358e+00_r8,0.30484e+00_r8,0.21403e+00_r8 /) + kbo(:, 4,49,11) = (/ & + & 0.41852e-01_r8,0.26199e+00_r8,0.32356e+00_r8,0.34774e+00_r8,0.24589e+00_r8 /) + kbo(:, 5,49,11) = (/ & + & 0.56641e-01_r8,0.29425e+00_r8,0.36325e+00_r8,0.39043e+00_r8,0.27839e+00_r8 /) + kbo(:, 1,50,11) = (/ & + & 0.10059e-01_r8,0.14901e+00_r8,0.19385e+00_r8,0.20977e+00_r8,0.14182e+00_r8 /) + kbo(:, 2,50,11) = (/ & + & 0.16439e-01_r8,0.18255e+00_r8,0.23049e+00_r8,0.24806e+00_r8,0.17150e+00_r8 /) + kbo(:, 3,50,11) = (/ & + & 0.25328e-01_r8,0.21656e+00_r8,0.26875e+00_r8,0.28888e+00_r8,0.20219e+00_r8 /) + kbo(:, 4,50,11) = (/ & + & 0.36730e-01_r8,0.24971e+00_r8,0.30839e+00_r8,0.33151e+00_r8,0.23378e+00_r8 /) + kbo(:, 5,50,11) = (/ & + & 0.50682e-01_r8,0.28213e+00_r8,0.34832e+00_r8,0.37432e+00_r8,0.26599e+00_r8 /) + kbo(:, 1,51,11) = (/ & + & 0.81000e-02_r8,0.13718e+00_r8,0.18086e+00_r8,0.19633e+00_r8,0.13125e+00_r8 /) + kbo(:, 2,51,11) = (/ & + & 0.13663e-01_r8,0.17002e+00_r8,0.21682e+00_r8,0.23372e+00_r8,0.16044e+00_r8 /) + kbo(:, 3,51,11) = (/ & + & 0.21646e-01_r8,0.20410e+00_r8,0.25452e+00_r8,0.27362e+00_r8,0.19085e+00_r8 /) + kbo(:, 4,51,11) = (/ & + & 0.32117e-01_r8,0.23766e+00_r8,0.29370e+00_r8,0.31573e+00_r8,0.22210e+00_r8 /) + kbo(:, 5,51,11) = (/ & + & 0.45217e-01_r8,0.27026e+00_r8,0.33377e+00_r8,0.35865e+00_r8,0.25409e+00_r8 /) + kbo(:, 1,52,11) = (/ & + & 0.64392e-02_r8,0.12568e+00_r8,0.16814e+00_r8,0.18321e+00_r8,0.12091e+00_r8 /) + kbo(:, 2,52,11) = (/ & + & 0.11223e-01_r8,0.15773e+00_r8,0.20341e+00_r8,0.21973e+00_r8,0.14959e+00_r8 /) + kbo(:, 3,52,11) = (/ & + & 0.18327e-01_r8,0.19165e+00_r8,0.24057e+00_r8,0.25870e+00_r8,0.17960e+00_r8 /) + kbo(:, 4,52,11) = (/ & + & 0.27978e-01_r8,0.22553e+00_r8,0.27924e+00_r8,0.30015e+00_r8,0.21055e+00_r8 /) + kbo(:, 5,52,11) = (/ & + & 0.40066e-01_r8,0.25840e+00_r8,0.31913e+00_r8,0.34300e+00_r8,0.24233e+00_r8 /) + kbo(:, 1,53,11) = (/ & + & 0.50582e-02_r8,0.11452e+00_r8,0.15565e+00_r8,0.17040e+00_r8,0.11082e+00_r8 /) + kbo(:, 2,53,11) = (/ & + & 0.90986e-02_r8,0.14571e+00_r8,0.19026e+00_r8,0.20608e+00_r8,0.13891e+00_r8 /) + kbo(:, 3,53,11) = (/ & + & 0.15360e-01_r8,0.17911e+00_r8,0.22674e+00_r8,0.24415e+00_r8,0.16845e+00_r8 /) + kbo(:, 4,53,11) = (/ & + & 0.24079e-01_r8,0.21320e+00_r8,0.26488e+00_r8,0.28473e+00_r8,0.19911e+00_r8 /) + kbo(:, 5,53,11) = (/ & + & 0.35249e-01_r8,0.24647e+00_r8,0.30443e+00_r8,0.32725e+00_r8,0.23061e+00_r8 /) + kbo(:, 1,54,11) = (/ & + & 0.39947e-02_r8,0.10467e+00_r8,0.14438e+00_r8,0.15895e+00_r8,0.10183e+00_r8 /) + kbo(:, 2,54,11) = (/ & + & 0.74123e-02_r8,0.13495e+00_r8,0.17842e+00_r8,0.19384e+00_r8,0.12928e+00_r8 /) + kbo(:, 3,54,11) = (/ & + & 0.12928e-01_r8,0.16768e+00_r8,0.21428e+00_r8,0.23108e+00_r8,0.15838e+00_r8 /) + kbo(:, 4,54,11) = (/ & + & 0.20817e-01_r8,0.20178e+00_r8,0.25191e+00_r8,0.27082e+00_r8,0.18875e+00_r8 /) + kbo(:, 5,54,11) = (/ & + & 0.31131e-01_r8,0.23540e+00_r8,0.29100e+00_r8,0.31283e+00_r8,0.21994e+00_r8 /) + kbo(:, 1,55,11) = (/ & + & 0.31444e-02_r8,0.95645e-01_r8,0.13357e+00_r8,0.14821e+00_r8,0.93456e-01_r8 /) + kbo(:, 2,55,11) = (/ & + & 0.60192e-02_r8,0.12488e+00_r8,0.16728e+00_r8,0.18235e+00_r8,0.12022e+00_r8 /) + kbo(:, 3,55,11) = (/ & + & 0.10844e-01_r8,0.15692e+00_r8,0.20255e+00_r8,0.21884e+00_r8,0.14887e+00_r8 /) + kbo(:, 4,55,11) = (/ & + & 0.17966e-01_r8,0.19085e+00_r8,0.23968e+00_r8,0.25776e+00_r8,0.17889e+00_r8 /) + kbo(:, 5,55,11) = (/ & + & 0.27575e-01_r8,0.22475e+00_r8,0.27833e+00_r8,0.29920e+00_r8,0.20981e+00_r8 /) + kbo(:, 1,56,11) = (/ & + & 0.24408e-02_r8,0.87042e-01_r8,0.12294e+00_r8,0.13774e+00_r8,0.85384e-01_r8 /) + kbo(:, 2,56,11) = (/ & + & 0.48425e-02_r8,0.11512e+00_r8,0.15634e+00_r8,0.17115e+00_r8,0.11140e+00_r8 /) + kbo(:, 3,56,11) = (/ & + & 0.90070e-02_r8,0.14641e+00_r8,0.19103e+00_r8,0.20689e+00_r8,0.13953e+00_r8 /) + kbo(:, 4,56,11) = (/ & + & 0.15384e-01_r8,0.17987e+00_r8,0.22757e+00_r8,0.24502e+00_r8,0.16913e+00_r8 /) + kbo(:, 5,56,11) = (/ & + & 0.24183e-01_r8,0.21396e+00_r8,0.26576e+00_r8,0.28569e+00_r8,0.19980e+00_r8 /) + kbo(:, 1,57,11) = (/ & + & 0.18661e-02_r8,0.78869e-01_r8,0.11259e+00_r8,0.12744e+00_r8,0.77594e-01_r8 /) + kbo(:, 2,57,11) = (/ & + & 0.38393e-02_r8,0.10567e+00_r8,0.14558e+00_r8,0.16018e+00_r8,0.10279e+00_r8 /) + kbo(:, 3,57,11) = (/ & + & 0.73986e-02_r8,0.13611e+00_r8,0.17972e+00_r8,0.19518e+00_r8,0.13032e+00_r8 /) + kbo(:, 4,57,11) = (/ & + & 0.13057e-01_r8,0.16895e+00_r8,0.21565e+00_r8,0.23253e+00_r8,0.15951e+00_r8 /) + kbo(:, 5,57,11) = (/ & + & 0.21059e-01_r8,0.20305e+00_r8,0.25335e+00_r8,0.27238e+00_r8,0.18989e+00_r8 /) + kbo(:, 1,58,11) = (/ & + & 0.14289e-02_r8,0.71481e-01_r8,0.10314e+00_r8,0.11789e+00_r8,0.70461e-01_r8 /) + kbo(:, 2,58,11) = (/ & + & 0.30447e-02_r8,0.97100e-01_r8,0.13537e+00_r8,0.15001e+00_r8,0.94840e-01_r8 /) + kbo(:, 3,58,11) = (/ & + & 0.60785e-02_r8,0.12656e+00_r8,0.16917e+00_r8,0.18428e+00_r8,0.12173e+00_r8 /) + kbo(:, 4,58,11) = (/ & + & 0.11073e-01_r8,0.15875e+00_r8,0.20453e+00_r8,0.22090e+00_r8,0.15049e+00_r8 /) + kbo(:, 5,58,11) = (/ & + & 0.18344e-01_r8,0.19271e+00_r8,0.24175e+00_r8,0.25997e+00_r8,0.18056e+00_r8 /) + kbo(:, 1,59,11) = (/ & + & 0.12466e-02_r8,0.68608e-01_r8,0.99449e-01_r8,0.11409e+00_r8,0.67679e-01_r8 /) + kbo(:, 2,59,11) = (/ & + & 0.27400e-02_r8,0.93756e-01_r8,0.13130e+00_r8,0.14598e+00_r8,0.91727e-01_r8 /) + kbo(:, 3,59,11) = (/ & + & 0.55829e-02_r8,0.12280e+00_r8,0.16498e+00_r8,0.17997e+00_r8,0.11835e+00_r8 /) + kbo(:, 4,59,11) = (/ & + & 0.10327e-01_r8,0.15471e+00_r8,0.20012e+00_r8,0.21632e+00_r8,0.14691e+00_r8 /) + kbo(:, 5,59,11) = (/ & + & 0.17312e-01_r8,0.18856e+00_r8,0.23714e+00_r8,0.25511e+00_r8,0.17685e+00_r8 /) + kbo(:, 1,13,12) = (/ & + & 0.97672e+00_r8,0.12351e+01_r8,0.13467e+01_r8,0.13355e+01_r8,0.11350e+01_r8 /) + kbo(:, 2,13,12) = (/ & + & 0.96517e+00_r8,0.12326e+01_r8,0.13523e+01_r8,0.13488e+01_r8,0.11500e+01_r8 /) + kbo(:, 3,13,12) = (/ & + & 0.95359e+00_r8,0.12308e+01_r8,0.13576e+01_r8,0.13588e+01_r8,0.11629e+01_r8 /) + kbo(:, 4,13,12) = (/ & + & 0.94644e+00_r8,0.12294e+01_r8,0.13618e+01_r8,0.13660e+01_r8,0.11761e+01_r8 /) + kbo(:, 5,13,12) = (/ & + & 0.94938e+00_r8,0.12277e+01_r8,0.13647e+01_r8,0.13713e+01_r8,0.11895e+01_r8 /) + kbo(:, 1,14,12) = (/ & + & 0.86287e+00_r8,0.11528e+01_r8,0.12800e+01_r8,0.12931e+01_r8,0.10793e+01_r8 /) + kbo(:, 2,14,12) = (/ & + & 0.85328e+00_r8,0.11519e+01_r8,0.12878e+01_r8,0.13082e+01_r8,0.10960e+01_r8 /) + kbo(:, 3,14,12) = (/ & + & 0.84776e+00_r8,0.11522e+01_r8,0.12944e+01_r8,0.13193e+01_r8,0.11122e+01_r8 /) + kbo(:, 4,14,12) = (/ & + & 0.85264e+00_r8,0.11532e+01_r8,0.12995e+01_r8,0.13287e+01_r8,0.11288e+01_r8 /) + kbo(:, 5,14,12) = (/ & + & 0.86761e+00_r8,0.11556e+01_r8,0.13039e+01_r8,0.13378e+01_r8,0.11458e+01_r8 /) + kbo(:, 1,15,12) = (/ & + & 0.75595e+00_r8,0.10736e+01_r8,0.12146e+01_r8,0.12437e+01_r8,0.10230e+01_r8 /) + kbo(:, 2,15,12) = (/ & + & 0.75063e+00_r8,0.10744e+01_r8,0.12248e+01_r8,0.12603e+01_r8,0.10430e+01_r8 /) + kbo(:, 3,15,12) = (/ & + & 0.75594e+00_r8,0.10769e+01_r8,0.12334e+01_r8,0.12743e+01_r8,0.10635e+01_r8 /) + kbo(:, 4,15,12) = (/ & + & 0.77107e+00_r8,0.10807e+01_r8,0.12402e+01_r8,0.12881e+01_r8,0.10841e+01_r8 /) + kbo(:, 5,15,12) = (/ & + & 0.79469e+00_r8,0.10902e+01_r8,0.12461e+01_r8,0.13012e+01_r8,0.11031e+01_r8 /) + kbo(:, 1,16,12) = (/ & + & 0.66063e+00_r8,0.99640e+00_r8,0.11502e+01_r8,0.11902e+01_r8,0.96912e+00_r8 /) + kbo(:, 2,16,12) = (/ & + & 0.66454e+00_r8,0.10001e+01_r8,0.11634e+01_r8,0.12095e+01_r8,0.99257e+00_r8 /) + kbo(:, 3,16,12) = (/ & + & 0.67895e+00_r8,0.10049e+01_r8,0.11739e+01_r8,0.12282e+01_r8,0.10170e+01_r8 /) + kbo(:, 4,16,12) = (/ & + & 0.70145e+00_r8,0.10153e+01_r8,0.11833e+01_r8,0.12469e+01_r8,0.10404e+01_r8 /) + kbo(:, 5,16,12) = (/ & + & 0.72525e+00_r8,0.10330e+01_r8,0.11925e+01_r8,0.12646e+01_r8,0.10610e+01_r8 /) + kbo(:, 1,17,12) = (/ & + & 0.58214e+00_r8,0.92297e+00_r8,0.10896e+01_r8,0.11346e+01_r8,0.91647e+00_r8 /) + kbo(:, 2,17,12) = (/ & + & 0.59400e+00_r8,0.92929e+00_r8,0.11045e+01_r8,0.11590e+01_r8,0.94550e+00_r8 /) + kbo(:, 3,17,12) = (/ & + & 0.61460e+00_r8,0.94000e+00_r8,0.11172e+01_r8,0.11832e+01_r8,0.97371e+00_r8 /) + kbo(:, 4,17,12) = (/ & + & 0.63691e+00_r8,0.95830e+00_r8,0.11303e+01_r8,0.12071e+01_r8,0.99891e+00_r8 /) + kbo(:, 5,17,12) = (/ & + & 0.66003e+00_r8,0.98295e+00_r8,0.11440e+01_r8,0.12298e+01_r8,0.10215e+01_r8 /) + kbo(:, 1,18,12) = (/ & + & 0.51831e+00_r8,0.85586e+00_r8,0.10313e+01_r8,0.10823e+01_r8,0.86734e+00_r8 /) + kbo(:, 2,18,12) = (/ & + & 0.53638e+00_r8,0.86645e+00_r8,0.10487e+01_r8,0.11114e+01_r8,0.90071e+00_r8 /) + kbo(:, 3,18,12) = (/ & + & 0.55679e+00_r8,0.88410e+00_r8,0.10657e+01_r8,0.11407e+01_r8,0.93149e+00_r8 /) + kbo(:, 4,18,12) = (/ & + & 0.57819e+00_r8,0.90902e+00_r8,0.10831e+01_r8,0.11693e+01_r8,0.95937e+00_r8 /) + kbo(:, 5,18,12) = (/ & + & 0.60387e+00_r8,0.94010e+00_r8,0.11032e+01_r8,0.11966e+01_r8,0.98550e+00_r8 /) + kbo(:, 1,19,12) = (/ & + & 0.46547e+00_r8,0.79533e+00_r8,0.97579e+00_r8,0.10353e+01_r8,0.82208e+00_r8 /) + kbo(:, 2,19,12) = (/ & + & 0.48441e+00_r8,0.81281e+00_r8,0.99768e+00_r8,0.10690e+01_r8,0.85858e+00_r8 /) + kbo(:, 3,19,12) = (/ & + & 0.50438e+00_r8,0.83723e+00_r8,0.10197e+01_r8,0.11027e+01_r8,0.89202e+00_r8 /) + kbo(:, 4,19,12) = (/ & + & 0.52861e+00_r8,0.86772e+00_r8,0.10433e+01_r8,0.11355e+01_r8,0.92298e+00_r8 /) + kbo(:, 5,19,12) = (/ & + & 0.55711e+00_r8,0.90301e+00_r8,0.10701e+01_r8,0.11672e+01_r8,0.95266e+00_r8 /) + kbo(:, 1,20,12) = (/ & + & 0.41965e+00_r8,0.74319e+00_r8,0.92508e+00_r8,0.99412e+00_r8,0.78089e+00_r8 /) + kbo(:, 2,20,12) = (/ & + & 0.43802e+00_r8,0.76766e+00_r8,0.95235e+00_r8,0.10327e+01_r8,0.82017e+00_r8 /) + kbo(:, 3,20,12) = (/ & + & 0.46025e+00_r8,0.79818e+00_r8,0.98022e+00_r8,0.10706e+01_r8,0.85677e+00_r8 /) + kbo(:, 4,20,12) = (/ & + & 0.48727e+00_r8,0.83370e+00_r8,0.10109e+01_r8,0.11072e+01_r8,0.89127e+00_r8 /) + kbo(:, 5,20,12) = (/ & + & 0.51863e+00_r8,0.87091e+00_r8,0.10440e+01_r8,0.11423e+01_r8,0.92433e+00_r8 /) + kbo(:, 1,21,12) = (/ & + & 0.37915e+00_r8,0.69998e+00_r8,0.88069e+00_r8,0.95835e+00_r8,0.74387e+00_r8 /) + kbo(:, 2,21,12) = (/ & + & 0.39885e+00_r8,0.72965e+00_r8,0.91291e+00_r8,0.10022e+01_r8,0.78645e+00_r8 /) + kbo(:, 3,21,12) = (/ & + & 0.42350e+00_r8,0.76561e+00_r8,0.94765e+00_r8,0.10443e+01_r8,0.82639e+00_r8 /) + kbo(:, 4,21,12) = (/ & + & 0.45298e+00_r8,0.80432e+00_r8,0.98473e+00_r8,0.10842e+01_r8,0.86477e+00_r8 /) + kbo(:, 5,21,12) = (/ & + & 0.48674e+00_r8,0.84344e+00_r8,0.10236e+01_r8,0.11221e+01_r8,0.90082e+00_r8 /) + kbo(:, 1,22,12) = (/ & + & 0.34554e+00_r8,0.66631e+00_r8,0.84565e+00_r8,0.93193e+00_r8,0.71462e+00_r8 /) + kbo(:, 2,22,12) = (/ & + & 0.36807e+00_r8,0.70096e+00_r8,0.88353e+00_r8,0.98021e+00_r8,0.76038e+00_r8 /) + kbo(:, 3,22,12) = (/ & + & 0.39520e+00_r8,0.74099e+00_r8,0.92460e+00_r8,0.10260e+01_r8,0.80381e+00_r8 /) + kbo(:, 4,22,12) = (/ & + & 0.42700e+00_r8,0.78213e+00_r8,0.96750e+00_r8,0.10688e+01_r8,0.84544e+00_r8 /) + kbo(:, 5,22,12) = (/ & + & 0.46306e+00_r8,0.82357e+00_r8,0.10116e+01_r8,0.11089e+01_r8,0.88444e+00_r8 /) + kbo(:, 1,23,12) = (/ & + & 0.31790e+00_r8,0.64007e+00_r8,0.81825e+00_r8,0.91240e+00_r8,0.69117e+00_r8 /) + kbo(:, 2,23,12) = (/ & + & 0.34313e+00_r8,0.67943e+00_r8,0.86200e+00_r8,0.96400e+00_r8,0.74026e+00_r8 /) + kbo(:, 3,23,12) = (/ & + & 0.37292e+00_r8,0.72179e+00_r8,0.90853e+00_r8,0.10128e+01_r8,0.78692e+00_r8 /) + kbo(:, 4,23,12) = (/ & + & 0.40683e+00_r8,0.76528e+00_r8,0.95638e+00_r8,0.10584e+01_r8,0.83132e+00_r8 /) + kbo(:, 5,23,12) = (/ & + & 0.44434e+00_r8,0.80906e+00_r8,0.10049e+01_r8,0.11007e+01_r8,0.87324e+00_r8 /) + kbo(:, 1,24,12) = (/ & + & 0.29587e+00_r8,0.62091e+00_r8,0.79898e+00_r8,0.89859e+00_r8,0.67383e+00_r8 /) + kbo(:, 2,24,12) = (/ & + & 0.32356e+00_r8,0.66370e+00_r8,0.84800e+00_r8,0.95354e+00_r8,0.72591e+00_r8 /) + kbo(:, 3,24,12) = (/ & + & 0.35587e+00_r8,0.70805e+00_r8,0.89882e+00_r8,0.10049e+01_r8,0.77551e+00_r8 /) + kbo(:, 4,24,12) = (/ & + & 0.39090e+00_r8,0.75345e+00_r8,0.95073e+00_r8,0.10524e+01_r8,0.82233e+00_r8 /) + kbo(:, 5,24,12) = (/ & + & 0.42938e+00_r8,0.80019e+00_r8,0.10026e+01_r8,0.10965e+01_r8,0.86634e+00_r8 /) + kbo(:, 1,25,12) = (/ & + & 0.27857e+00_r8,0.60799e+00_r8,0.78705e+00_r8,0.89081e+00_r8,0.66256e+00_r8 /) + kbo(:, 2,25,12) = (/ & + & 0.30889e+00_r8,0.65303e+00_r8,0.84032e+00_r8,0.94841e+00_r8,0.71733e+00_r8 /) + kbo(:, 3,25,12) = (/ & + & 0.34245e+00_r8,0.69924e+00_r8,0.89488e+00_r8,0.10015e+01_r8,0.76917e+00_r8 /) + kbo(:, 4,25,12) = (/ & + & 0.37871e+00_r8,0.74693e+00_r8,0.95015e+00_r8,0.10506e+01_r8,0.81807e+00_r8 /) + kbo(:, 5,25,12) = (/ & + & 0.41833e+00_r8,0.79644e+00_r8,0.10044e+01_r8,0.10958e+01_r8,0.86374e+00_r8 /) + kbo(:, 1,26,12) = (/ & + & 0.26580e+00_r8,0.60063e+00_r8,0.78228e+00_r8,0.88879e+00_r8,0.65720e+00_r8 /) + kbo(:, 2,26,12) = (/ & + & 0.29790e+00_r8,0.64759e+00_r8,0.83895e+00_r8,0.94821e+00_r8,0.71439e+00_r8 /) + kbo(:, 3,26,12) = (/ & + & 0.33261e+00_r8,0.69574e+00_r8,0.89642e+00_r8,0.10025e+01_r8,0.76782e+00_r8 /) + kbo(:, 4,26,12) = (/ & + & 0.37054e+00_r8,0.74591e+00_r8,0.95396e+00_r8,0.10524e+01_r8,0.81818e+00_r8 /) + kbo(:, 5,26,12) = (/ & + & 0.41158e+00_r8,0.79751e+00_r8,0.10099e+01_r8,0.10981e+01_r8,0.86507e+00_r8 /) + kbo(:, 1,27,12) = (/ & + & 0.25628e+00_r8,0.59727e+00_r8,0.78261e+00_r8,0.89115e+00_r8,0.65648e+00_r8 /) + kbo(:, 2,27,12) = (/ & + & 0.28973e+00_r8,0.64617e+00_r8,0.84187e+00_r8,0.95137e+00_r8,0.71531e+00_r8 /) + kbo(:, 3,27,12) = (/ & + & 0.32602e+00_r8,0.69640e+00_r8,0.90149e+00_r8,0.10062e+01_r8,0.76992e+00_r8 /) + kbo(:, 4,27,12) = (/ & + & 0.36566e+00_r8,0.74858e+00_r8,0.96067e+00_r8,0.10565e+01_r8,0.82130e+00_r8 /) + kbo(:, 5,27,12) = (/ & + & 0.40839e+00_r8,0.80160e+00_r8,0.10174e+01_r8,0.11025e+01_r8,0.86892e+00_r8 /) + kbo(:, 1,28,12) = (/ & + & 0.24931e+00_r8,0.59767e+00_r8,0.78703e+00_r8,0.89664e+00_r8,0.65970e+00_r8 /) + kbo(:, 2,28,12) = (/ & + & 0.28438e+00_r8,0.64828e+00_r8,0.84808e+00_r8,0.95711e+00_r8,0.71948e+00_r8 /) + kbo(:, 3,28,12) = (/ & + & 0.32259e+00_r8,0.70046e+00_r8,0.90930e+00_r8,0.10123e+01_r8,0.77494e+00_r8 /) + kbo(:, 4,28,12) = (/ & + & 0.36394e+00_r8,0.75423e+00_r8,0.96943e+00_r8,0.10625e+01_r8,0.82683e+00_r8 /) + kbo(:, 5,28,12) = (/ & + & 0.40857e+00_r8,0.80828e+00_r8,0.10265e+01_r8,0.11085e+01_r8,0.87457e+00_r8 /) + kbo(:, 1,29,12) = (/ & + & 0.24529e+00_r8,0.60153e+00_r8,0.79470e+00_r8,0.90469e+00_r8,0.66635e+00_r8 /) + kbo(:, 2,29,12) = (/ & + & 0.28215e+00_r8,0.65374e+00_r8,0.85707e+00_r8,0.96518e+00_r8,0.72659e+00_r8 /) + kbo(:, 3,29,12) = (/ & + & 0.32237e+00_r8,0.70744e+00_r8,0.91955e+00_r8,0.10202e+01_r8,0.78233e+00_r8 /) + kbo(:, 4,29,12) = (/ & + & 0.36548e+00_r8,0.76246e+00_r8,0.98006e+00_r8,0.10704e+01_r8,0.83435e+00_r8 /) + kbo(:, 5,29,12) = (/ & + & 0.41179e+00_r8,0.81715e+00_r8,0.10368e+01_r8,0.11160e+01_r8,0.88198e+00_r8 /) + kbo(:, 1,30,12) = (/ & + & 0.24386e+00_r8,0.60816e+00_r8,0.80473e+00_r8,0.91460e+00_r8,0.67543e+00_r8 /) + kbo(:, 2,30,12) = (/ & + & 0.28279e+00_r8,0.66165e+00_r8,0.86804e+00_r8,0.97470e+00_r8,0.73566e+00_r8 /) + kbo(:, 3,30,12) = (/ & + & 0.32483e+00_r8,0.71650e+00_r8,0.93115e+00_r8,0.10292e+01_r8,0.79124e+00_r8 /) + kbo(:, 4,30,12) = (/ & + & 0.36954e+00_r8,0.77208e+00_r8,0.99158e+00_r8,0.10790e+01_r8,0.84299e+00_r8 /) + kbo(:, 5,30,12) = (/ & + & 0.41749e+00_r8,0.82738e+00_r8,0.10478e+01_r8,0.11245e+01_r8,0.89039e+00_r8 /) + kbo(:, 1,31,12) = (/ & + & 0.24525e+00_r8,0.61702e+00_r8,0.81682e+00_r8,0.92621e+00_r8,0.68640e+00_r8 /) + kbo(:, 2,31,12) = (/ & + & 0.28616e+00_r8,0.67142e+00_r8,0.88072e+00_r8,0.98550e+00_r8,0.74643e+00_r8 /) + kbo(:, 3,31,12) = (/ & + & 0.32989e+00_r8,0.72710e+00_r8,0.94409e+00_r8,0.10393e+01_r8,0.80152e+00_r8 /) + kbo(:, 4,31,12) = (/ & + & 0.37609e+00_r8,0.78314e+00_r8,0.10041e+01_r8,0.10886e+01_r8,0.85269e+00_r8 /) + kbo(:, 5,31,12) = (/ & + & 0.42530e+00_r8,0.83896e+00_r8,0.10596e+01_r8,0.11338e+01_r8,0.89957e+00_r8 /) + kbo(:, 1,32,12) = (/ & + & 0.24917e+00_r8,0.62738e+00_r8,0.83018e+00_r8,0.93886e+00_r8,0.69870e+00_r8 /) + kbo(:, 2,32,12) = (/ & + & 0.29180e+00_r8,0.68257e+00_r8,0.89466e+00_r8,0.99723e+00_r8,0.75819e+00_r8 /) + kbo(:, 3,32,12) = (/ & + & 0.33695e+00_r8,0.73898e+00_r8,0.95783e+00_r8,0.10503e+01_r8,0.81270e+00_r8 /) + kbo(:, 4,32,12) = (/ & + & 0.38441e+00_r8,0.79527e+00_r8,0.10172e+01_r8,0.10987e+01_r8,0.86313e+00_r8 /) + kbo(:, 5,32,12) = (/ & + & 0.43473e+00_r8,0.85145e+00_r8,0.10718e+01_r8,0.11436e+01_r8,0.90933e+00_r8 /) + kbo(:, 1,33,12) = (/ & + & 0.25524e+00_r8,0.63888e+00_r8,0.84456e+00_r8,0.95208e+00_r8,0.71177e+00_r8 /) + kbo(:, 2,33,12) = (/ & + & 0.29923e+00_r8,0.69477e+00_r8,0.90943e+00_r8,0.10094e+01_r8,0.77043e+00_r8 /) + kbo(:, 3,33,12) = (/ & + & 0.34555e+00_r8,0.75166e+00_r8,0.97211e+00_r8,0.10616e+01_r8,0.82442e+00_r8 /) + kbo(:, 4,33,12) = (/ & + & 0.39409e+00_r8,0.80804e+00_r8,0.10306e+01_r8,0.11094e+01_r8,0.87396e+00_r8 /) + kbo(:, 5,33,12) = (/ & + & 0.44532e+00_r8,0.86454e+00_r8,0.10842e+01_r8,0.11536e+01_r8,0.91947e+00_r8 /) + kbo(:, 1,34,12) = (/ & + & 0.26139e+00_r8,0.64937e+00_r8,0.85738e+00_r8,0.96358e+00_r8,0.72330e+00_r8 /) + kbo(:, 2,34,12) = (/ & + & 0.30644e+00_r8,0.70578e+00_r8,0.92238e+00_r8,0.10200e+01_r8,0.78117e+00_r8 /) + kbo(:, 3,34,12) = (/ & + & 0.35368e+00_r8,0.76284e+00_r8,0.98445e+00_r8,0.10715e+01_r8,0.83457e+00_r8 /) + kbo(:, 4,34,12) = (/ & + & 0.40294e+00_r8,0.81944e+00_r8,0.10421e+01_r8,0.11185e+01_r8,0.88331e+00_r8 /) + kbo(:, 5,34,12) = (/ & + & 0.45497e+00_r8,0.87610e+00_r8,0.10949e+01_r8,0.11623e+01_r8,0.92821e+00_r8 /) + kbo(:, 1,35,12) = (/ & + & 0.26429e+00_r8,0.65495e+00_r8,0.86437e+00_r8,0.96967e+00_r8,0.72944e+00_r8 /) + kbo(:, 2,35,12) = (/ & + & 0.31003e+00_r8,0.71171e+00_r8,0.92940e+00_r8,0.10257e+01_r8,0.78687e+00_r8 /) + kbo(:, 3,35,12) = (/ & + & 0.35779e+00_r8,0.76892e+00_r8,0.99113e+00_r8,0.10767e+01_r8,0.83993e+00_r8 /) + kbo(:, 4,35,12) = (/ & + & 0.40757e+00_r8,0.82572e+00_r8,0.10483e+01_r8,0.11235e+01_r8,0.88834e+00_r8 /) + kbo(:, 5,35,12) = (/ & + & 0.46005e+00_r8,0.88243e+00_r8,0.11007e+01_r8,0.11671e+01_r8,0.93291e+00_r8 /) + kbo(:, 1,36,12) = (/ & + & 0.26301e+00_r8,0.65478e+00_r8,0.86458e+00_r8,0.96965e+00_r8,0.72937e+00_r8 /) + kbo(:, 2,36,12) = (/ & + & 0.30906e+00_r8,0.71167e+00_r8,0.92967e+00_r8,0.10257e+01_r8,0.78687e+00_r8 /) + kbo(:, 3,36,12) = (/ & + & 0.35709e+00_r8,0.76907e+00_r8,0.99151e+00_r8,0.10769e+01_r8,0.84005e+00_r8 /) + kbo(:, 4,36,12) = (/ & + & 0.40702e+00_r8,0.82602e+00_r8,0.10488e+01_r8,0.11238e+01_r8,0.88850e+00_r8 /) + kbo(:, 5,36,12) = (/ & + & 0.45966e+00_r8,0.88282e+00_r8,0.11012e+01_r8,0.11674e+01_r8,0.93315e+00_r8 /) + kbo(:, 1,37,12) = (/ & + & 0.25532e+00_r8,0.64621e+00_r8,0.85496e+00_r8,0.96073e+00_r8,0.72018e+00_r8 /) + kbo(:, 2,37,12) = (/ & + & 0.30133e+00_r8,0.70315e+00_r8,0.92046e+00_r8,0.10178e+01_r8,0.77861e+00_r8 /) + kbo(:, 3,37,12) = (/ & + & 0.34928e+00_r8,0.76070e+00_r8,0.98300e+00_r8,0.10697e+01_r8,0.83253e+00_r8 /) + kbo(:, 4,37,12) = (/ & + & 0.39901e+00_r8,0.81782e+00_r8,0.10410e+01_r8,0.11173e+01_r8,0.88173e+00_r8 /) + kbo(:, 5,37,12) = (/ & + & 0.45136e+00_r8,0.87470e+00_r8,0.10942e+01_r8,0.11614e+01_r8,0.92694e+00_r8 /) + kbo(:, 1,38,12) = (/ & + & 0.24761e+00_r8,0.63742e+00_r8,0.84491e+00_r8,0.95139e+00_r8,0.71066e+00_r8 /) + kbo(:, 2,38,12) = (/ & + & 0.29353e+00_r8,0.69428e+00_r8,0.91068e+00_r8,0.10095e+01_r8,0.76992e+00_r8 /) + kbo(:, 3,38,12) = (/ & + & 0.34135e+00_r8,0.75196e+00_r8,0.97396e+00_r8,0.10621e+01_r8,0.82461e+00_r8 /) + kbo(:, 4,38,12) = (/ & + & 0.39084e+00_r8,0.80925e+00_r8,0.10327e+01_r8,0.11104e+01_r8,0.87459e+00_r8 /) + kbo(:, 5,38,12) = (/ & + & 0.44289e+00_r8,0.86617e+00_r8,0.10866e+01_r8,0.11550e+01_r8,0.92038e+00_r8 /) + kbo(:, 1,39,12) = (/ & + & 0.24017e+00_r8,0.62886e+00_r8,0.83503e+00_r8,0.94210e+00_r8,0.70124e+00_r8 /) + kbo(:, 2,39,12) = (/ & + & 0.28601e+00_r8,0.68569e+00_r8,0.90106e+00_r8,0.10011e+01_r8,0.76142e+00_r8 /) + kbo(:, 3,39,12) = (/ & + & 0.33368e+00_r8,0.74335e+00_r8,0.96490e+00_r8,0.10546e+01_r8,0.81673e+00_r8 /) + kbo(:, 4,39,12) = (/ & + & 0.38296e+00_r8,0.80081e+00_r8,0.10243e+01_r8,0.11035e+01_r8,0.86747e+00_r8 /) + kbo(:, 5,39,12) = (/ & + & 0.43465e+00_r8,0.85778e+00_r8,0.10791e+01_r8,0.11488e+01_r8,0.91385e+00_r8 /) + kbo(:, 1,40,12) = (/ & + & 0.22833e+00_r8,0.61463e+00_r8,0.81821e+00_r8,0.92620e+00_r8,0.68530e+00_r8 /) + kbo(:, 2,40,12) = (/ & + & 0.27395e+00_r8,0.67134e+00_r8,0.88467e+00_r8,0.98686e+00_r8,0.74688e+00_r8 /) + kbo(:, 3,40,12) = (/ & + & 0.32124e+00_r8,0.72890e+00_r8,0.94943e+00_r8,0.10418e+01_r8,0.80324e+00_r8 /) + kbo(:, 4,40,12) = (/ & + & 0.37015e+00_r8,0.78652e+00_r8,0.10100e+01_r8,0.10918e+01_r8,0.85523e+00_r8 /) + kbo(:, 5,40,12) = (/ & + & 0.42126e+00_r8,0.84372e+00_r8,0.10660e+01_r8,0.11379e+01_r8,0.90264e+00_r8 /) + kbo(:, 1,41,12) = (/ & + & 0.21612e+00_r8,0.59971e+00_r8,0.80041e+00_r8,0.90904e+00_r8,0.66824e+00_r8 /) + kbo(:, 2,41,12) = (/ & + & 0.26150e+00_r8,0.65630e+00_r8,0.86743e+00_r8,0.97155e+00_r8,0.73120e+00_r8 /) + kbo(:, 3,41,12) = (/ & + & 0.30837e+00_r8,0.71376e+00_r8,0.93288e+00_r8,0.10279e+01_r8,0.78880e+00_r8 /) + kbo(:, 4,41,12) = (/ & + & 0.35698e+00_r8,0.77150e+00_r8,0.99473e+00_r8,0.10791e+01_r8,0.84209e+00_r8 /) + kbo(:, 5,41,12) = (/ & + & 0.40745e+00_r8,0.82887e+00_r8,0.10519e+01_r8,0.11261e+01_r8,0.89062e+00_r8 /) + kbo(:, 1,42,12) = (/ & + & 0.20417e+00_r8,0.58472e+00_r8,0.78237e+00_r8,0.89154e+00_r8,0.65066e+00_r8 /) + kbo(:, 2,42,12) = (/ & + & 0.24921e+00_r8,0.64136e+00_r8,0.85007e+00_r8,0.95580e+00_r8,0.71510e+00_r8 /) + kbo(:, 3,42,12) = (/ & + & 0.29566e+00_r8,0.69861e+00_r8,0.91611e+00_r8,0.10137e+01_r8,0.77414e+00_r8 /) + kbo(:, 4,42,12) = (/ & + & 0.34395e+00_r8,0.75651e+00_r8,0.97922e+00_r8,0.10662e+01_r8,0.82865e+00_r8 /) + kbo(:, 5,42,12) = (/ & + & 0.39383e+00_r8,0.81397e+00_r8,0.10376e+01_r8,0.11142e+01_r8,0.87842e+00_r8 /) + kbo(:, 1,43,12) = (/ & + & 0.18997e+00_r8,0.56647e+00_r8,0.76032e+00_r8,0.86976e+00_r8,0.62901e+00_r8 /) + kbo(:, 2,43,12) = (/ & + & 0.23447e+00_r8,0.62342e+00_r8,0.82892e+00_r8,0.93617e+00_r8,0.69524e+00_r8 /) + kbo(:, 3,43,12) = (/ & + & 0.28050e+00_r8,0.68037e+00_r8,0.89544e+00_r8,0.99597e+00_r8,0.75607e+00_r8 /) + kbo(:, 4,43,12) = (/ & + & 0.32830e+00_r8,0.73817e+00_r8,0.95981e+00_r8,0.10502e+01_r8,0.81194e+00_r8 /) + kbo(:, 5,43,12) = (/ & + & 0.37763e+00_r8,0.79580e+00_r8,0.10196e+01_r8,0.10995e+01_r8,0.86317e+00_r8 /) + kbo(:, 1,44,12) = (/ & + & 0.17494e+00_r8,0.54678e+00_r8,0.73637e+00_r8,0.84544e+00_r8,0.60542e+00_r8 /) + kbo(:, 2,44,12) = (/ & + & 0.21877e+00_r8,0.60406e+00_r8,0.80575e+00_r8,0.91415e+00_r8,0.67322e+00_r8 /) + kbo(:, 3,44,12) = (/ & + & 0.26445e+00_r8,0.66075e+00_r8,0.87287e+00_r8,0.97625e+00_r8,0.73598e+00_r8 /) + kbo(:, 4,44,12) = (/ & + & 0.31161e+00_r8,0.71841e+00_r8,0.93827e+00_r8,0.10322e+01_r8,0.79326e+00_r8 /) + kbo(:, 5,44,12) = (/ & + & 0.36052e+00_r8,0.77622e+00_r8,0.99972e+00_r8,0.10831e+01_r8,0.84620e+00_r8 /) + kbo(:, 1,45,12) = (/ & + & 0.16016e+00_r8,0.52729e+00_r8,0.71224e+00_r8,0.82038e+00_r8,0.58172e+00_r8 /) + kbo(:, 2,45,12) = (/ & + & 0.20336e+00_r8,0.58455e+00_r8,0.78227e+00_r8,0.89144e+00_r8,0.65050e+00_r8 /) + kbo(:, 3,45,12) = (/ & + & 0.24861e+00_r8,0.64128e+00_r8,0.85023e+00_r8,0.95584e+00_r8,0.71509e+00_r8 /) + kbo(:, 4,45,12) = (/ & + & 0.29518e+00_r8,0.69870e+00_r8,0.91640e+00_r8,0.10138e+01_r8,0.77417e+00_r8 /) + kbo(:, 5,45,12) = (/ & + & 0.34361e+00_r8,0.75661e+00_r8,0.97947e+00_r8,0.10663e+01_r8,0.82874e+00_r8 /) + kbo(:, 1,46,12) = (/ & + & 0.14495e+00_r8,0.50668e+00_r8,0.68614e+00_r8,0.79268e+00_r8,0.55619e+00_r8 /) + kbo(:, 2,46,12) = (/ & + & 0.18729e+00_r8,0.56366e+00_r8,0.75707e+00_r8,0.86650e+00_r8,0.62580e+00_r8 /) + kbo(:, 3,46,12) = (/ & + & 0.23189e+00_r8,0.62077e+00_r8,0.82600e+00_r8,0.93336e+00_r8,0.69232e+00_r8 /) + kbo(:, 4,46,12) = (/ & + & 0.27798e+00_r8,0.67784e+00_r8,0.89269e+00_r8,0.99345e+00_r8,0.75352e+00_r8 /) + kbo(:, 5,46,12) = (/ & + & 0.32583e+00_r8,0.73560e+00_r8,0.95715e+00_r8,0.10480e+01_r8,0.80957e+00_r8 /) + kbo(:, 1,47,12) = (/ & + & 0.12858e+00_r8,0.48369e+00_r8,0.65638e+00_r8,0.76017e+00_r8,0.52730e+00_r8 /) + kbo(:, 2,47,12) = (/ & + & 0.16969e+00_r8,0.54041e+00_r8,0.72859e+00_r8,0.83745e+00_r8,0.59783e+00_r8 /) + kbo(:, 3,47,12) = (/ & + & 0.21344e+00_r8,0.59783e+00_r8,0.79837e+00_r8,0.90704e+00_r8,0.66606e+00_r8 /) + kbo(:, 4,47,12) = (/ & + & 0.25910e+00_r8,0.65455e+00_r8,0.86586e+00_r8,0.96989e+00_r8,0.72949e+00_r8 /) + kbo(:, 5,47,12) = (/ & + & 0.30618e+00_r8,0.71222e+00_r8,0.93155e+00_r8,0.10265e+01_r8,0.78728e+00_r8 /) + kbo(:, 1,48,12) = (/ & + & 0.11298e+00_r8,0.46082e+00_r8,0.62642e+00_r8,0.72640e+00_r8,0.49809e+00_r8 /) + kbo(:, 2,48,12) = (/ & + & 0.15246e+00_r8,0.51740e+00_r8,0.69983e+00_r8,0.80735e+00_r8,0.56961e+00_r8 /) + kbo(:, 3,48,12) = (/ & + & 0.19539e+00_r8,0.57459e+00_r8,0.77041e+00_r8,0.87978e+00_r8,0.63885e+00_r8 /) + kbo(:, 4,48,12) = (/ & + & 0.24045e+00_r8,0.63157e+00_r8,0.83892e+00_r8,0.94534e+00_r8,0.70441e+00_r8 /) + kbo(:, 5,48,12) = (/ & + & 0.28683e+00_r8,0.68881e+00_r8,0.90534e+00_r8,0.10043e+01_r8,0.76449e+00_r8 /) + kbo(:, 1,49,12) = (/ & + & 0.98247e-01_r8,0.43787e+00_r8,0.59630e+00_r8,0.69142e+00_r8,0.46886e+00_r8 /) + kbo(:, 2,49,12) = (/ & + & 0.13602e+00_r8,0.49453e+00_r8,0.67051e+00_r8,0.77567e+00_r8,0.54098e+00_r8 /) + kbo(:, 3,49,12) = (/ & + & 0.17773e+00_r8,0.55136e+00_r8,0.74221e+00_r8,0.85142e+00_r8,0.61109e+00_r8 /) + kbo(:, 4,49,12) = (/ & + & 0.22196e+00_r8,0.60876e+00_r8,0.81162e+00_r8,0.91969e+00_r8,0.67863e+00_r8 /) + kbo(:, 5,49,12) = (/ & + & 0.26789e+00_r8,0.66564e+00_r8,0.87866e+00_r8,0.98128e+00_r8,0.74108e+00_r8 /) + kbo(:, 1,50,12) = (/ & + & 0.85448e-01_r8,0.41621e+00_r8,0.56763e+00_r8,0.65757e+00_r8,0.44117e+00_r8 /) + kbo(:, 2,50,12) = (/ & + & 0.12109e+00_r8,0.47310e+00_r8,0.64247e+00_r8,0.74462e+00_r8,0.51379e+00_r8 /) + kbo(:, 3,50,12) = (/ & + & 0.16156e+00_r8,0.52985e+00_r8,0.71554e+00_r8,0.82373e+00_r8,0.58488e+00_r8 /) + kbo(:, 4,50,12) = (/ & + & 0.20488e+00_r8,0.58711e+00_r8,0.78559e+00_r8,0.89468e+00_r8,0.65362e+00_r8 /) + kbo(:, 5,50,12) = (/ & + & 0.25037e+00_r8,0.64398e+00_r8,0.85353e+00_r8,0.95880e+00_r8,0.71804e+00_r8 /) + kbo(:, 1,51,12) = (/ & + & 0.73759e-01_r8,0.39485e+00_r8,0.53977e+00_r8,0.62407e+00_r8,0.41437e+00_r8 /) + kbo(:, 2,51,12) = (/ & + & 0.10727e+00_r8,0.45237e+00_r8,0.61531e+00_r8,0.71353e+00_r8,0.48727e+00_r8 /) + kbo(:, 3,51,12) = (/ & + & 0.14620e+00_r8,0.50899e+00_r8,0.68916e+00_r8,0.79586e+00_r8,0.55909e+00_r8 /) + kbo(:, 4,51,12) = (/ & + & 0.18867e+00_r8,0.56597e+00_r8,0.76009e+00_r8,0.86950e+00_r8,0.62868e+00_r8 /) + kbo(:, 5,51,12) = (/ & + & 0.23351e+00_r8,0.62321e+00_r8,0.82900e+00_r8,0.93613e+00_r8,0.69507e+00_r8 /) + kbo(:, 1,52,12) = (/ & + & 0.62975e-01_r8,0.37352e+00_r8,0.51168e+00_r8,0.59007e+00_r8,0.38790e+00_r8 /) + kbo(:, 2,52,12) = (/ & + & 0.94238e-01_r8,0.43155e+00_r8,0.58786e+00_r8,0.68153e+00_r8,0.46072e+00_r8 /) + kbo(:, 3,52,12) = (/ & + & 0.13138e+00_r8,0.48824e+00_r8,0.66233e+00_r8,0.76673e+00_r8,0.53305e+00_r8 /) + kbo(:, 4,52,12) = (/ & + & 0.17291e+00_r8,0.54507e+00_r8,0.73444e+00_r8,0.84335e+00_r8,0.60343e+00_r8 /) + kbo(:, 5,52,12) = (/ & + & 0.21681e+00_r8,0.60245e+00_r8,0.80402e+00_r8,0.91249e+00_r8,0.67147e+00_r8 /) + kbo(:, 1,53,12) = (/ & + & 0.53060e-01_r8,0.35230e+00_r8,0.48353e+00_r8,0.55561e+00_r8,0.36178e+00_r8 /) + kbo(:, 2,53,12) = (/ & + & 0.81984e-01_r8,0.41041e+00_r8,0.56005e+00_r8,0.64855e+00_r8,0.43393e+00_r8 /) + kbo(:, 3,53,12) = (/ & + & 0.11713e+00_r8,0.46754e+00_r8,0.63518e+00_r8,0.73640e+00_r8,0.50665e+00_r8 /) + kbo(:, 4,53,12) = (/ & + & 0.15723e+00_r8,0.52417e+00_r8,0.70847e+00_r8,0.81636e+00_r8,0.57800e+00_r8 /) + kbo(:, 5,53,12) = (/ & + & 0.20038e+00_r8,0.58144e+00_r8,0.77877e+00_r8,0.88807e+00_r8,0.64700e+00_r8 /) + kbo(:, 1,54,12) = (/ & + & 0.44825e-01_r8,0.33285e+00_r8,0.45764e+00_r8,0.52392e+00_r8,0.33821e+00_r8 /) + kbo(:, 2,54,12) = (/ & + & 0.71480e-01_r8,0.39083e+00_r8,0.53456e+00_r8,0.61778e+00_r8,0.40943e+00_r8 /) + kbo(:, 3,54,12) = (/ & + & 0.10463e+00_r8,0.44857e+00_r8,0.61031e+00_r8,0.70773e+00_r8,0.48234e+00_r8 /) + kbo(:, 4,54,12) = (/ & + & 0.14329e+00_r8,0.50511e+00_r8,0.68427e+00_r8,0.79060e+00_r8,0.55433e+00_r8 /) + kbo(:, 5,54,12) = (/ & + & 0.18561e+00_r8,0.56209e+00_r8,0.75543e+00_r8,0.86487e+00_r8,0.62409e+00_r8 /) + kbo(:, 1,55,12) = (/ & + & 0.37713e-01_r8,0.31417e+00_r8,0.43292e+00_r8,0.49354e+00_r8,0.31617e+00_r8 /) + kbo(:, 2,55,12) = (/ & + & 0.62120e-01_r8,0.37210e+00_r8,0.50985e+00_r8,0.58786e+00_r8,0.38623e+00_r8 /) + kbo(:, 3,55,12) = (/ & + & 0.93283e-01_r8,0.43021e+00_r8,0.58608e+00_r8,0.67950e+00_r8,0.45902e+00_r8 /) + kbo(:, 4,55,12) = (/ & + & 0.13035e+00_r8,0.48690e+00_r8,0.66064e+00_r8,0.76487e+00_r8,0.53142e+00_r8 /) + kbo(:, 5,55,12) = (/ & + & 0.17183e+00_r8,0.54374e+00_r8,0.73284e+00_r8,0.84168e+00_r8,0.60189e+00_r8 /) + kbo(:, 1,56,12) = (/ & + & 0.31364e-01_r8,0.29533e+00_r8,0.40826e+00_r8,0.46346e+00_r8,0.29456e+00_r8 /) + kbo(:, 2,56,12) = (/ & + & 0.53447e-01_r8,0.35352e+00_r8,0.48522e+00_r8,0.55771e+00_r8,0.36336e+00_r8 /) + kbo(:, 3,56,12) = (/ & + & 0.82579e-01_r8,0.41171e+00_r8,0.56173e+00_r8,0.65061e+00_r8,0.43556e+00_r8 /) + kbo(:, 4,56,12) = (/ & + & 0.11788e+00_r8,0.46877e+00_r8,0.63683e+00_r8,0.73828e+00_r8,0.50830e+00_r8 /) + kbo(:, 5,56,12) = (/ & + & 0.15810e+00_r8,0.52547e+00_r8,0.71011e+00_r8,0.81806e+00_r8,0.57961e+00_r8 /) + kbo(:, 1,57,12) = (/ & + & 0.25728e-01_r8,0.27641e+00_r8,0.38366e+00_r8,0.43364e+00_r8,0.27324e+00_r8 /) + kbo(:, 2,57,12) = (/ & + & 0.45538e-01_r8,0.33495e+00_r8,0.46047e+00_r8,0.52741e+00_r8,0.34078e+00_r8 /) + kbo(:, 3,57,12) = (/ & + & 0.72492e-01_r8,0.39302e+00_r8,0.53741e+00_r8,0.62128e+00_r8,0.41216e+00_r8 /) + kbo(:, 4,57,12) = (/ & + & 0.10590e+00_r8,0.45065e+00_r8,0.61311e+00_r8,0.71103e+00_r8,0.48510e+00_r8 /) + kbo(:, 5,57,12) = (/ & + & 0.14476e+00_r8,0.50725e+00_r8,0.68700e+00_r8,0.79354e+00_r8,0.55702e+00_r8 /) + kbo(:, 1,58,12) = (/ & + & 0.21034e-01_r8,0.25862e+00_r8,0.36035e+00_r8,0.40559e+00_r8,0.25327e+00_r8 /) + kbo(:, 2,58,12) = (/ & + & 0.38718e-01_r8,0.31732e+00_r8,0.43714e+00_r8,0.49876e+00_r8,0.31992e+00_r8 /) + kbo(:, 3,58,12) = (/ & + & 0.63552e-01_r8,0.37529e+00_r8,0.51407e+00_r8,0.59305e+00_r8,0.39018e+00_r8 /) + kbo(:, 4,58,12) = (/ & + & 0.95105e-01_r8,0.43334e+00_r8,0.59030e+00_r8,0.68443e+00_r8,0.46307e+00_r8 /) + kbo(:, 5,58,12) = (/ & + & 0.13248e+00_r8,0.49002e+00_r8,0.66471e+00_r8,0.76934e+00_r8,0.53538e+00_r8 /) + kbo(:, 1,59,12) = (/ & + & 0.19312e-01_r8,0.25156e+00_r8,0.35103e+00_r8,0.39450e+00_r8,0.24538e+00_r8 /) + kbo(:, 2,59,12) = (/ & + & 0.36163e-01_r8,0.31020e+00_r8,0.42773e+00_r8,0.48723e+00_r8,0.31163e+00_r8 /) + kbo(:, 3,59,12) = (/ & + & 0.60143e-01_r8,0.36820e+00_r8,0.50471e+00_r8,0.58164e+00_r8,0.38146e+00_r8 /) + kbo(:, 4,59,12) = (/ & + & 0.90924e-01_r8,0.42637e+00_r8,0.58105e+00_r8,0.67358e+00_r8,0.45417e+00_r8 /) + kbo(:, 5,59,12) = (/ & + & 0.12765e+00_r8,0.48313e+00_r8,0.65572e+00_r8,0.75941e+00_r8,0.52665e+00_r8 /) + kbo(:, 1,13,13) = (/ & + & 0.25702e+01_r8,0.27735e+01_r8,0.28760e+01_r8,0.25966e+01_r8,0.23968e+01_r8 /) + kbo(:, 2,13,13) = (/ & + & 0.25597e+01_r8,0.27776e+01_r8,0.28903e+01_r8,0.26158e+01_r8,0.24224e+01_r8 /) + kbo(:, 3,13,13) = (/ & + & 0.25494e+01_r8,0.27801e+01_r8,0.29040e+01_r8,0.26351e+01_r8,0.24494e+01_r8 /) + kbo(:, 4,13,13) = (/ & + & 0.25338e+01_r8,0.27802e+01_r8,0.29182e+01_r8,0.26543e+01_r8,0.24747e+01_r8 /) + kbo(:, 5,13,13) = (/ & + & 0.25177e+01_r8,0.27760e+01_r8,0.29320e+01_r8,0.26728e+01_r8,0.24963e+01_r8 /) + kbo(:, 1,14,13) = (/ & + & 0.23659e+01_r8,0.26936e+01_r8,0.28410e+01_r8,0.26130e+01_r8,0.23363e+01_r8 /) + kbo(:, 2,14,13) = (/ & + & 0.23577e+01_r8,0.27024e+01_r8,0.28615e+01_r8,0.26344e+01_r8,0.23684e+01_r8 /) + kbo(:, 3,14,13) = (/ & + & 0.23468e+01_r8,0.27102e+01_r8,0.28819e+01_r8,0.26565e+01_r8,0.24004e+01_r8 /) + kbo(:, 4,14,13) = (/ & + & 0.23350e+01_r8,0.27153e+01_r8,0.29051e+01_r8,0.26785e+01_r8,0.24267e+01_r8 /) + kbo(:, 5,14,13) = (/ & + & 0.23244e+01_r8,0.27141e+01_r8,0.29262e+01_r8,0.26967e+01_r8,0.24480e+01_r8 /) + kbo(:, 1,15,13) = (/ & + & 0.21606e+01_r8,0.25927e+01_r8,0.27805e+01_r8,0.26146e+01_r8,0.22773e+01_r8 /) + kbo(:, 2,15,13) = (/ & + & 0.21537e+01_r8,0.26084e+01_r8,0.28087e+01_r8,0.26417e+01_r8,0.23162e+01_r8 /) + kbo(:, 3,15,13) = (/ & + & 0.21448e+01_r8,0.26237e+01_r8,0.28408e+01_r8,0.26683e+01_r8,0.23515e+01_r8 /) + kbo(:, 4,15,13) = (/ & + & 0.21380e+01_r8,0.26327e+01_r8,0.28720e+01_r8,0.26931e+01_r8,0.23792e+01_r8 /) + kbo(:, 5,15,13) = (/ & + & 0.21347e+01_r8,0.26387e+01_r8,0.29018e+01_r8,0.27159e+01_r8,0.24036e+01_r8 /) + kbo(:, 1,16,13) = (/ & + & 0.19588e+01_r8,0.24824e+01_r8,0.27086e+01_r8,0.26036e+01_r8,0.22170e+01_r8 /) + kbo(:, 2,16,13) = (/ & + & 0.19544e+01_r8,0.25053e+01_r8,0.27466e+01_r8,0.26370e+01_r8,0.22638e+01_r8 /) + kbo(:, 3,16,13) = (/ & + & 0.19508e+01_r8,0.25256e+01_r8,0.27882e+01_r8,0.26694e+01_r8,0.23023e+01_r8 /) + kbo(:, 4,16,13) = (/ & + & 0.19522e+01_r8,0.25422e+01_r8,0.28288e+01_r8,0.26997e+01_r8,0.23338e+01_r8 /) + kbo(:, 5,16,13) = (/ & + & 0.19669e+01_r8,0.25568e+01_r8,0.28660e+01_r8,0.27268e+01_r8,0.23639e+01_r8 /) + kbo(:, 1,17,13) = (/ & + & 0.17683e+01_r8,0.23717e+01_r8,0.26296e+01_r8,0.25828e+01_r8,0.21586e+01_r8 /) + kbo(:, 2,17,13) = (/ & + & 0.17670e+01_r8,0.24002e+01_r8,0.26798e+01_r8,0.26243e+01_r8,0.22104e+01_r8 /) + kbo(:, 3,17,13) = (/ & + & 0.17705e+01_r8,0.24261e+01_r8,0.27313e+01_r8,0.26643e+01_r8,0.22525e+01_r8 /) + kbo(:, 4,17,13) = (/ & + & 0.17889e+01_r8,0.24495e+01_r8,0.27802e+01_r8,0.27001e+01_r8,0.22912e+01_r8 /) + kbo(:, 5,17,13) = (/ & + & 0.18206e+01_r8,0.24734e+01_r8,0.28261e+01_r8,0.27304e+01_r8,0.23278e+01_r8 /) + kbo(:, 1,18,13) = (/ & + & 0.15903e+01_r8,0.22606e+01_r8,0.25530e+01_r8,0.25561e+01_r8,0.21033e+01_r8 /) + kbo(:, 2,18,13) = (/ & + & 0.15961e+01_r8,0.22974e+01_r8,0.26139e+01_r8,0.26069e+01_r8,0.21585e+01_r8 /) + kbo(:, 3,18,13) = (/ & + & 0.16151e+01_r8,0.23303e+01_r8,0.26738e+01_r8,0.26546e+01_r8,0.22069e+01_r8 /) + kbo(:, 4,18,13) = (/ & + & 0.16495e+01_r8,0.23625e+01_r8,0.27316e+01_r8,0.26970e+01_r8,0.22532e+01_r8 /) + kbo(:, 5,18,13) = (/ & + & 0.16970e+01_r8,0.23957e+01_r8,0.27859e+01_r8,0.27320e+01_r8,0.22970e+01_r8 /) + kbo(:, 1,19,13) = (/ & + & 0.14257e+01_r8,0.21563e+01_r8,0.24826e+01_r8,0.25271e+01_r8,0.20500e+01_r8 /) + kbo(:, 2,19,13) = (/ & + & 0.14448e+01_r8,0.21999e+01_r8,0.25521e+01_r8,0.25882e+01_r8,0.21113e+01_r8 /) + kbo(:, 3,19,13) = (/ & + & 0.14809e+01_r8,0.22420e+01_r8,0.26202e+01_r8,0.26436e+01_r8,0.21676e+01_r8 /) + kbo(:, 4,19,13) = (/ & + & 0.15301e+01_r8,0.22839e+01_r8,0.26861e+01_r8,0.26918e+01_r8,0.22215e+01_r8 /) + kbo(:, 5,19,13) = (/ & + & 0.15917e+01_r8,0.23278e+01_r8,0.27486e+01_r8,0.27324e+01_r8,0.22720e+01_r8 /) + kbo(:, 1,20,13) = (/ & + & 0.12800e+01_r8,0.20626e+01_r8,0.24230e+01_r8,0.25008e+01_r8,0.20040e+01_r8 /) + kbo(:, 2,20,13) = (/ & + & 0.13152e+01_r8,0.21132e+01_r8,0.24996e+01_r8,0.25711e+01_r8,0.20725e+01_r8 /) + kbo(:, 3,20,13) = (/ & + & 0.13653e+01_r8,0.21643e+01_r8,0.25750e+01_r8,0.26341e+01_r8,0.21362e+01_r8 /) + kbo(:, 4,20,13) = (/ & + & 0.14290e+01_r8,0.22166e+01_r8,0.26493e+01_r8,0.26871e+01_r8,0.21969e+01_r8 /) + kbo(:, 5,20,13) = (/ & + & 0.15047e+01_r8,0.22739e+01_r8,0.27186e+01_r8,0.27332e+01_r8,0.22536e+01_r8 /) + kbo(:, 1,21,13) = (/ & + & 0.11565e+01_r8,0.19804e+01_r8,0.23723e+01_r8,0.24790e+01_r8,0.19652e+01_r8 /) + kbo(:, 2,21,13) = (/ & + & 0.12043e+01_r8,0.20401e+01_r8,0.24563e+01_r8,0.25572e+01_r8,0.20406e+01_r8 /) + kbo(:, 3,21,13) = (/ & + & 0.12682e+01_r8,0.20995e+01_r8,0.25386e+01_r8,0.26265e+01_r8,0.21117e+01_r8 /) + kbo(:, 4,21,13) = (/ & + & 0.13446e+01_r8,0.21634e+01_r8,0.26197e+01_r8,0.26846e+01_r8,0.21783e+01_r8 /) + kbo(:, 5,21,13) = (/ & + & 0.14328e+01_r8,0.22322e+01_r8,0.26943e+01_r8,0.27351e+01_r8,0.22400e+01_r8 /) + kbo(:, 1,22,13) = (/ & + & 0.10567e+01_r8,0.19161e+01_r8,0.23380e+01_r8,0.24675e+01_r8,0.19394e+01_r8 /) + kbo(:, 2,22,13) = (/ & + & 0.11171e+01_r8,0.19843e+01_r8,0.24279e+01_r8,0.25525e+01_r8,0.20217e+01_r8 /) + kbo(:, 3,22,13) = (/ & + & 0.11926e+01_r8,0.20529e+01_r8,0.25167e+01_r8,0.26264e+01_r8,0.20987e+01_r8 /) + kbo(:, 4,22,13) = (/ & + & 0.12819e+01_r8,0.21280e+01_r8,0.26028e+01_r8,0.26881e+01_r8,0.21696e+01_r8 /) + kbo(:, 5,22,13) = (/ & + & 0.13818e+01_r8,0.22069e+01_r8,0.26807e+01_r8,0.27417e+01_r8,0.22350e+01_r8 /) + kbo(:, 1,23,13) = (/ & + & 0.97722e+00_r8,0.18665e+01_r8,0.23140e+01_r8,0.24623e+01_r8,0.19226e+01_r8 /) + kbo(:, 2,23,13) = (/ & + & 0.10487e+01_r8,0.19424e+01_r8,0.24103e+01_r8,0.25530e+01_r8,0.20109e+01_r8 /) + kbo(:, 3,23,13) = (/ & + & 0.11351e+01_r8,0.20216e+01_r8,0.25035e+01_r8,0.26294e+01_r8,0.20926e+01_r8 /) + kbo(:, 4,23,13) = (/ & + & 0.12356e+01_r8,0.21056e+01_r8,0.25931e+01_r8,0.26937e+01_r8,0.21670e+01_r8 /) + kbo(:, 5,23,13) = (/ & + & 0.13470e+01_r8,0.21926e+01_r8,0.26734e+01_r8,0.27495e+01_r8,0.22345e+01_r8 /) + kbo(:, 1,24,13) = (/ & + & 0.91609e+00_r8,0.18302e+01_r8,0.23004e+01_r8,0.24641e+01_r8,0.19149e+01_r8 /) + kbo(:, 2,24,13) = (/ & + & 0.99757e+00_r8,0.19150e+01_r8,0.24014e+01_r8,0.25579e+01_r8,0.20076e+01_r8 /) + kbo(:, 3,24,13) = (/ & + & 0.10945e+01_r8,0.20031e+01_r8,0.24987e+01_r8,0.26360e+01_r8,0.20926e+01_r8 /) + kbo(:, 4,24,13) = (/ & + & 0.12058e+01_r8,0.20942e+01_r8,0.25896e+01_r8,0.27020e+01_r8,0.21691e+01_r8 /) + kbo(:, 5,24,13) = (/ & + & 0.13269e+01_r8,0.21869e+01_r8,0.26718e+01_r8,0.27594e+01_r8,0.22381e+01_r8 /) + kbo(:, 1,25,13) = (/ & + & 0.87183e+00_r8,0.18068e+01_r8,0.22964e+01_r8,0.24719e+01_r8,0.19153e+01_r8 /) + kbo(:, 2,25,13) = (/ & + & 0.96269e+00_r8,0.19004e+01_r8,0.24012e+01_r8,0.25669e+01_r8,0.20109e+01_r8 /) + kbo(:, 3,25,13) = (/ & + & 0.10701e+01_r8,0.19953e+01_r8,0.24998e+01_r8,0.26458e+01_r8,0.20980e+01_r8 /) + kbo(:, 4,25,13) = (/ & + & 0.11910e+01_r8,0.20919e+01_r8,0.25913e+01_r8,0.27126e+01_r8,0.21754e+01_r8 /) + kbo(:, 5,25,13) = (/ & + & 0.13188e+01_r8,0.21891e+01_r8,0.26749e+01_r8,0.27711e+01_r8,0.22449e+01_r8 /) + kbo(:, 1,26,13) = (/ & + & 0.84313e+00_r8,0.17965e+01_r8,0.23011e+01_r8,0.24858e+01_r8,0.19238e+01_r8 /) + kbo(:, 2,26,13) = (/ & + & 0.94434e+00_r8,0.18970e+01_r8,0.24073e+01_r8,0.25798e+01_r8,0.20205e+01_r8 /) + kbo(:, 3,26,13) = (/ & + & 0.10612e+01_r8,0.19972e+01_r8,0.25069e+01_r8,0.26589e+01_r8,0.21080e+01_r8 /) + kbo(:, 4,26,13) = (/ & + & 0.11887e+01_r8,0.20979e+01_r8,0.25988e+01_r8,0.27257e+01_r8,0.21853e+01_r8 /) + kbo(:, 5,26,13) = (/ & + & 0.13225e+01_r8,0.21985e+01_r8,0.26831e+01_r8,0.27841e+01_r8,0.22550e+01_r8 /) + kbo(:, 1,27,13) = (/ & + & 0.82783e+00_r8,0.17960e+01_r8,0.23110e+01_r8,0.25019e+01_r8,0.19363e+01_r8 /) + kbo(:, 2,27,13) = (/ & + & 0.93873e+00_r8,0.19014e+01_r8,0.24182e+01_r8,0.25950e+01_r8,0.20338e+01_r8 /) + kbo(:, 3,27,13) = (/ & + & 0.10628e+01_r8,0.20052e+01_r8,0.25176e+01_r8,0.26735e+01_r8,0.21206e+01_r8 /) + kbo(:, 4,27,13) = (/ & + & 0.11961e+01_r8,0.21092e+01_r8,0.26097e+01_r8,0.27398e+01_r8,0.21974e+01_r8 /) + kbo(:, 5,27,13) = (/ & + & 0.13342e+01_r8,0.22123e+01_r8,0.26944e+01_r8,0.27973e+01_r8,0.22665e+01_r8 /) + kbo(:, 1,28,13) = (/ & + & 0.82452e+00_r8,0.18027e+01_r8,0.23247e+01_r8,0.25200e+01_r8,0.19523e+01_r8 /) + kbo(:, 2,28,13) = (/ & + & 0.94277e+00_r8,0.19121e+01_r8,0.24323e+01_r8,0.26114e+01_r8,0.20494e+01_r8 /) + kbo(:, 3,28,13) = (/ & + & 0.10725e+01_r8,0.20183e+01_r8,0.25313e+01_r8,0.26888e+01_r8,0.21352e+01_r8 /) + kbo(:, 4,28,13) = (/ & + & 0.12107e+01_r8,0.21244e+01_r8,0.26233e+01_r8,0.27544e+01_r8,0.22110e+01_r8 /) + kbo(:, 5,28,13) = (/ & + & 0.13516e+01_r8,0.22292e+01_r8,0.27078e+01_r8,0.28106e+01_r8,0.22794e+01_r8 /) + kbo(:, 1,29,13) = (/ & + & 0.83075e+00_r8,0.18160e+01_r8,0.23425e+01_r8,0.25401e+01_r8,0.19712e+01_r8 /) + kbo(:, 2,29,13) = (/ & + & 0.95513e+00_r8,0.19278e+01_r8,0.24494e+01_r8,0.26294e+01_r8,0.20669e+01_r8 /) + kbo(:, 3,29,13) = (/ & + & 0.10900e+01_r8,0.20358e+01_r8,0.25478e+01_r8,0.27053e+01_r8,0.21513e+01_r8 /) + kbo(:, 4,29,13) = (/ & + & 0.12315e+01_r8,0.21431e+01_r8,0.26391e+01_r8,0.27692e+01_r8,0.22259e+01_r8 /) + kbo(:, 5,29,13) = (/ & + & 0.13745e+01_r8,0.22488e+01_r8,0.27235e+01_r8,0.28240e+01_r8,0.22934e+01_r8 /) + kbo(:, 1,30,13) = (/ & + & 0.84416e+00_r8,0.18336e+01_r8,0.23624e+01_r8,0.25609e+01_r8,0.19916e+01_r8 /) + kbo(:, 2,30,13) = (/ & + & 0.97368e+00_r8,0.19464e+01_r8,0.24682e+01_r8,0.26481e+01_r8,0.20854e+01_r8 /) + kbo(:, 3,30,13) = (/ & + & 0.11126e+01_r8,0.20559e+01_r8,0.25658e+01_r8,0.27219e+01_r8,0.21680e+01_r8 /) + kbo(:, 4,30,13) = (/ & + & 0.12564e+01_r8,0.21643e+01_r8,0.26566e+01_r8,0.27840e+01_r8,0.22414e+01_r8 /) + kbo(:, 5,30,13) = (/ & + & 0.14008e+01_r8,0.22700e+01_r8,0.27405e+01_r8,0.28371e+01_r8,0.23076e+01_r8 /) + kbo(:, 1,31,13) = (/ & + & 0.86384e+00_r8,0.18548e+01_r8,0.23844e+01_r8,0.25824e+01_r8,0.20133e+01_r8 /) + kbo(:, 2,31,13) = (/ & + & 0.99753e+00_r8,0.19681e+01_r8,0.24888e+01_r8,0.26671e+01_r8,0.21046e+01_r8 /) + kbo(:, 3,31,13) = (/ & + & 0.11394e+01_r8,0.20787e+01_r8,0.25856e+01_r8,0.27387e+01_r8,0.21855e+01_r8 /) + kbo(:, 4,31,13) = (/ & + & 0.12850e+01_r8,0.21876e+01_r8,0.26758e+01_r8,0.27988e+01_r8,0.22577e+01_r8 /) + kbo(:, 5,31,13) = (/ & + & 0.14304e+01_r8,0.22931e+01_r8,0.27584e+01_r8,0.28498e+01_r8,0.23225e+01_r8 /) + kbo(:, 1,32,13) = (/ & + & 0.88808e+00_r8,0.18788e+01_r8,0.24078e+01_r8,0.26044e+01_r8,0.20359e+01_r8 /) + kbo(:, 2,32,13) = (/ & + & 0.10254e+01_r8,0.19921e+01_r8,0.25106e+01_r8,0.26862e+01_r8,0.21246e+01_r8 /) + kbo(:, 3,32,13) = (/ & + & 0.11696e+01_r8,0.21031e+01_r8,0.26064e+01_r8,0.27554e+01_r8,0.22034e+01_r8 /) + kbo(:, 4,32,13) = (/ & + & 0.13164e+01_r8,0.22122e+01_r8,0.26955e+01_r8,0.28135e+01_r8,0.22742e+01_r8 /) + kbo(:, 5,32,13) = (/ & + & 0.14621e+01_r8,0.23175e+01_r8,0.27772e+01_r8,0.28624e+01_r8,0.23376e+01_r8 /) + kbo(:, 1,33,13) = (/ & + & 0.91576e+00_r8,0.19044e+01_r8,0.24318e+01_r8,0.26262e+01_r8,0.20585e+01_r8 /) + kbo(:, 2,33,13) = (/ & + & 0.10563e+01_r8,0.20178e+01_r8,0.25332e+01_r8,0.27053e+01_r8,0.21448e+01_r8 /) + kbo(:, 3,33,13) = (/ & + & 0.12022e+01_r8,0.21286e+01_r8,0.26280e+01_r8,0.27719e+01_r8,0.22216e+01_r8 /) + kbo(:, 4,33,13) = (/ & + & 0.13498e+01_r8,0.22379e+01_r8,0.27158e+01_r8,0.28276e+01_r8,0.22909e+01_r8 /) + kbo(:, 5,33,13) = (/ & + & 0.14952e+01_r8,0.23427e+01_r8,0.27963e+01_r8,0.28748e+01_r8,0.23524e+01_r8 /) + kbo(:, 1,34,13) = (/ & + & 0.94113e+00_r8,0.19270e+01_r8,0.24527e+01_r8,0.26448e+01_r8,0.20775e+01_r8 /) + kbo(:, 2,34,13) = (/ & + & 0.10840e+01_r8,0.20405e+01_r8,0.25528e+01_r8,0.27213e+01_r8,0.21619e+01_r8 /) + kbo(:, 3,34,13) = (/ & + & 0.12311e+01_r8,0.21512e+01_r8,0.26466e+01_r8,0.27855e+01_r8,0.22370e+01_r8 /) + kbo(:, 4,34,13) = (/ & + & 0.13793e+01_r8,0.22602e+01_r8,0.27333e+01_r8,0.28395e+01_r8,0.23050e+01_r8 /) + kbo(:, 5,34,13) = (/ & + & 0.15242e+01_r8,0.23644e+01_r8,0.28128e+01_r8,0.28850e+01_r8,0.23650e+01_r8 /) + kbo(:, 1,35,13) = (/ & + & 0.95467e+00_r8,0.19391e+01_r8,0.24637e+01_r8,0.26549e+01_r8,0.20879e+01_r8 /) + kbo(:, 2,35,13) = (/ & + & 0.10989e+01_r8,0.20529e+01_r8,0.25635e+01_r8,0.27301e+01_r8,0.21712e+01_r8 /) + kbo(:, 3,35,13) = (/ & + & 0.12468e+01_r8,0.21638e+01_r8,0.26569e+01_r8,0.27931e+01_r8,0.22456e+01_r8 /) + kbo(:, 4,35,13) = (/ & + & 0.13953e+01_r8,0.22726e+01_r8,0.27430e+01_r8,0.28463e+01_r8,0.23128e+01_r8 /) + kbo(:, 5,35,13) = (/ & + & 0.15401e+01_r8,0.23764e+01_r8,0.28219e+01_r8,0.28908e+01_r8,0.23721e+01_r8 /) + kbo(:, 1,36,13) = (/ & + & 0.95401e+00_r8,0.19393e+01_r8,0.24641e+01_r8,0.26563e+01_r8,0.20890e+01_r8 /) + kbo(:, 2,36,13) = (/ & + & 0.10986e+01_r8,0.20534e+01_r8,0.25640e+01_r8,0.27314e+01_r8,0.21722e+01_r8 /) + kbo(:, 3,36,13) = (/ & + & 0.12470e+01_r8,0.21646e+01_r8,0.26577e+01_r8,0.27946e+01_r8,0.22466e+01_r8 /) + kbo(:, 4,36,13) = (/ & + & 0.13959e+01_r8,0.22738e+01_r8,0.27440e+01_r8,0.28477e+01_r8,0.23138e+01_r8 /) + kbo(:, 5,36,13) = (/ & + & 0.15410e+01_r8,0.23778e+01_r8,0.28230e+01_r8,0.28922e+01_r8,0.23732e+01_r8 /) + kbo(:, 1,37,13) = (/ & + & 0.93269e+00_r8,0.19221e+01_r8,0.24490e+01_r8,0.26452e+01_r8,0.20765e+01_r8 /) + kbo(:, 2,37,13) = (/ & + & 0.10767e+01_r8,0.20372e+01_r8,0.25499e+01_r8,0.27223e+01_r8,0.21614e+01_r8 /) + kbo(:, 3,37,13) = (/ & + & 0.12250e+01_r8,0.21490e+01_r8,0.26449e+01_r8,0.27873e+01_r8,0.22369e+01_r8 /) + kbo(:, 4,37,13) = (/ & + & 0.13744e+01_r8,0.22588e+01_r8,0.27324e+01_r8,0.28416e+01_r8,0.23053e+01_r8 /) + kbo(:, 5,37,13) = (/ & + & 0.15205e+01_r8,0.23639e+01_r8,0.28124e+01_r8,0.28871e+01_r8,0.23656e+01_r8 /) + kbo(:, 1,38,13) = (/ & + & 0.91080e+00_r8,0.19040e+01_r8,0.24332e+01_r8,0.26332e+01_r8,0.20631e+01_r8 /) + kbo(:, 2,38,13) = (/ & + & 0.10540e+01_r8,0.20201e+01_r8,0.25351e+01_r8,0.27123e+01_r8,0.21497e+01_r8 /) + kbo(:, 3,38,13) = (/ & + & 0.12022e+01_r8,0.21326e+01_r8,0.26310e+01_r8,0.27790e+01_r8,0.22264e+01_r8 /) + kbo(:, 4,38,13) = (/ & + & 0.13520e+01_r8,0.22432e+01_r8,0.27202e+01_r8,0.28347e+01_r8,0.22959e+01_r8 /) + kbo(:, 5,38,13) = (/ & + & 0.14989e+01_r8,0.23490e+01_r8,0.28012e+01_r8,0.28815e+01_r8,0.23575e+01_r8 /) + kbo(:, 1,39,13) = (/ & + & 0.88956e+00_r8,0.18861e+01_r8,0.24173e+01_r8,0.26207e+01_r8,0.20495e+01_r8 /) + kbo(:, 2,39,13) = (/ & + & 0.10319e+01_r8,0.20032e+01_r8,0.25205e+01_r8,0.27021e+01_r8,0.21379e+01_r8 /) + kbo(:, 3,39,13) = (/ & + & 0.11798e+01_r8,0.21163e+01_r8,0.26173e+01_r8,0.27704e+01_r8,0.22159e+01_r8 /) + kbo(:, 4,39,13) = (/ & + & 0.13298e+01_r8,0.22272e+01_r8,0.27078e+01_r8,0.28277e+01_r8,0.22865e+01_r8 /) + kbo(:, 5,39,13) = (/ & + & 0.14775e+01_r8,0.23341e+01_r8,0.27901e+01_r8,0.28757e+01_r8,0.23493e+01_r8 /) + kbo(:, 1,40,13) = (/ & + & 0.85494e+00_r8,0.18558e+01_r8,0.23904e+01_r8,0.25985e+01_r8,0.20255e+01_r8 /) + kbo(:, 2,40,13) = (/ & + & 0.99514e+00_r8,0.19745e+01_r8,0.24954e+01_r8,0.26836e+01_r8,0.21170e+01_r8 /) + kbo(:, 3,40,13) = (/ & + & 0.11424e+01_r8,0.20885e+01_r8,0.25938e+01_r8,0.27547e+01_r8,0.21975e+01_r8 /) + kbo(:, 4,40,13) = (/ & + & 0.12924e+01_r8,0.22001e+01_r8,0.26861e+01_r8,0.28148e+01_r8,0.22700e+01_r8 /) + kbo(:, 5,40,13) = (/ & + & 0.14413e+01_r8,0.23083e+01_r8,0.27705e+01_r8,0.28664e+01_r8,0.23349e+01_r8 /) + kbo(:, 1,41,13) = (/ & + & 0.81957e+00_r8,0.18237e+01_r8,0.23613e+01_r8,0.25741e+01_r8,0.19997e+01_r8 /) + kbo(:, 2,41,13) = (/ & + & 0.95728e+00_r8,0.19441e+01_r8,0.24688e+01_r8,0.26632e+01_r8,0.20945e+01_r8 /) + kbo(:, 3,41,13) = (/ & + & 0.11034e+01_r8,0.20591e+01_r8,0.25687e+01_r8,0.27378e+01_r8,0.21777e+01_r8 /) + kbo(:, 4,41,13) = (/ & + & 0.12530e+01_r8,0.21714e+01_r8,0.26630e+01_r8,0.28005e+01_r8,0.22519e+01_r8 /) + kbo(:, 5,41,13) = (/ & + & 0.14027e+01_r8,0.22807e+01_r8,0.27494e+01_r8,0.28533e+01_r8,0.23190e+01_r8 /) + kbo(:, 1,42,13) = (/ & + & 0.78503e+00_r8,0.17918e+01_r8,0.23317e+01_r8,0.25487e+01_r8,0.19734e+01_r8 /) + kbo(:, 2,42,13) = (/ & + & 0.92016e+00_r8,0.19132e+01_r8,0.24418e+01_r8,0.26418e+01_r8,0.20712e+01_r8 /) + kbo(:, 3,42,13) = (/ & + & 0.10646e+01_r8,0.20294e+01_r8,0.25432e+01_r8,0.27200e+01_r8,0.21575e+01_r8 /) + kbo(:, 4,42,13) = (/ & + & 0.12137e+01_r8,0.21426e+01_r8,0.26392e+01_r8,0.27859e+01_r8,0.22336e+01_r8 /) + kbo(:, 5,42,13) = (/ & + & 0.13639e+01_r8,0.22528e+01_r8,0.27279e+01_r8,0.28411e+01_r8,0.23026e+01_r8 /) + kbo(:, 1,43,13) = (/ & + & 0.74423e+00_r8,0.17527e+01_r8,0.22949e+01_r8,0.25159e+01_r8,0.19403e+01_r8 /) + kbo(:, 2,43,13) = (/ & + & 0.87589e+00_r8,0.18750e+01_r8,0.24080e+01_r8,0.26143e+01_r8,0.20417e+01_r8 /) + kbo(:, 3,43,13) = (/ & + & 0.10179e+01_r8,0.19932e+01_r8,0.25118e+01_r8,0.26972e+01_r8,0.21315e+01_r8 /) + kbo(:, 4,43,13) = (/ & + & 0.11661e+01_r8,0.21073e+01_r8,0.26096e+01_r8,0.27665e+01_r8,0.22105e+01_r8 /) + kbo(:, 5,43,13) = (/ & + & 0.13165e+01_r8,0.22185e+01_r8,0.27008e+01_r8,0.28247e+01_r8,0.22817e+01_r8 /) + kbo(:, 1,44,13) = (/ & + & 0.70183e+00_r8,0.17101e+01_r8,0.22539e+01_r8,0.24783e+01_r8,0.19029e+01_r8 /) + kbo(:, 2,44,13) = (/ & + & 0.82940e+00_r8,0.18334e+01_r8,0.23707e+01_r8,0.25829e+01_r8,0.20083e+01_r8 /) + kbo(:, 3,44,13) = (/ & + & 0.96829e+00_r8,0.19537e+01_r8,0.24774e+01_r8,0.26707e+01_r8,0.21022e+01_r8 /) + kbo(:, 4,44,13) = (/ & + & 0.11151e+01_r8,0.20687e+01_r8,0.25770e+01_r8,0.27443e+01_r8,0.21846e+01_r8 /) + kbo(:, 5,44,13) = (/ & + & 0.12651e+01_r8,0.21808e+01_r8,0.26707e+01_r8,0.28061e+01_r8,0.22584e+01_r8 /) + kbo(:, 1,45,13) = (/ & + & 0.66118e+00_r8,0.16676e+01_r8,0.22119e+01_r8,0.24384e+01_r8,0.18634e+01_r8 /) + kbo(:, 2,45,13) = (/ & + & 0.78445e+00_r8,0.17917e+01_r8,0.23321e+01_r8,0.25495e+01_r8,0.19739e+01_r8 /) + kbo(:, 3,45,13) = (/ & + & 0.91984e+00_r8,0.19133e+01_r8,0.24421e+01_r8,0.26427e+01_r8,0.20718e+01_r8 /) + kbo(:, 4,45,13) = (/ & + & 0.10646e+01_r8,0.20301e+01_r8,0.25439e+01_r8,0.27211e+01_r8,0.21582e+01_r8 /) + kbo(:, 5,45,13) = (/ & + & 0.12138e+01_r8,0.21430e+01_r8,0.26395e+01_r8,0.27867e+01_r8,0.22343e+01_r8 /) + kbo(:, 1,46,13) = (/ & + & 0.61933e+00_r8,0.16221e+01_r8,0.21659e+01_r8,0.23935e+01_r8,0.18196e+01_r8 /) + kbo(:, 2,46,13) = (/ & + & 0.73807e+00_r8,0.17470e+01_r8,0.22898e+01_r8,0.25118e+01_r8,0.19358e+01_r8 /) + kbo(:, 3,46,13) = (/ & + & 0.86934e+00_r8,0.18696e+01_r8,0.24034e+01_r8,0.26109e+01_r8,0.20379e+01_r8 /) + kbo(:, 4,46,13) = (/ & + & 0.10113e+01_r8,0.19884e+01_r8,0.25076e+01_r8,0.26946e+01_r8,0.21283e+01_r8 /) + kbo(:, 5,46,13) = (/ & + & 0.11593e+01_r8,0.21025e+01_r8,0.26055e+01_r8,0.27643e+01_r8,0.22076e+01_r8 /) + kbo(:, 1,47,13) = (/ & + & 0.57374e+00_r8,0.15709e+01_r8,0.21131e+01_r8,0.23400e+01_r8,0.17680e+01_r8 /) + kbo(:, 2,47,13) = (/ & + & 0.68838e+00_r8,0.16965e+01_r8,0.22409e+01_r8,0.24665e+01_r8,0.18907e+01_r8 /) + kbo(:, 3,47,13) = (/ & + & 0.81478e+00_r8,0.18201e+01_r8,0.23589e+01_r8,0.25731e+01_r8,0.19980e+01_r8 /) + kbo(:, 4,47,13) = (/ & + & 0.95278e+00_r8,0.19412e+01_r8,0.24665e+01_r8,0.26626e+01_r8,0.20931e+01_r8 /) + kbo(:, 5,47,13) = (/ & + & 0.10991e+01_r8,0.20567e+01_r8,0.25667e+01_r8,0.27376e+01_r8,0.21769e+01_r8 /) + kbo(:, 1,48,13) = (/ & + & 0.52946e+00_r8,0.15198e+01_r8,0.20592e+01_r8,0.22834e+01_r8,0.17136e+01_r8 /) + kbo(:, 2,48,13) = (/ & + & 0.64089e+00_r8,0.16459e+01_r8,0.21904e+01_r8,0.24180e+01_r8,0.18431e+01_r8 /) + kbo(:, 3,48,13) = (/ & + & 0.76211e+00_r8,0.17708e+01_r8,0.23126e+01_r8,0.25324e+01_r8,0.19565e+01_r8 /) + kbo(:, 4,48,13) = (/ & + & 0.89568e+00_r8,0.18928e+01_r8,0.24241e+01_r8,0.26284e+01_r8,0.20564e+01_r8 /) + kbo(:, 5,48,13) = (/ & + & 0.10393e+01_r8,0.20105e+01_r8,0.25268e+01_r8,0.27091e+01_r8,0.21445e+01_r8 /) + kbo(:, 1,49,13) = (/ & + & 0.48708e+00_r8,0.14681e+01_r8,0.20029e+01_r8,0.22232e+01_r8,0.16566e+01_r8 /) + kbo(:, 2,49,13) = (/ & + & 0.59510e+00_r8,0.15951e+01_r8,0.21382e+01_r8,0.23660e+01_r8,0.17928e+01_r8 /) + kbo(:, 3,49,13) = (/ & + & 0.71141e+00_r8,0.17205e+01_r8,0.22646e+01_r8,0.24889e+01_r8,0.19130e+01_r8 /) + kbo(:, 4,49,13) = (/ & + & 0.84034e+00_r8,0.18437e+01_r8,0.23804e+01_r8,0.25917e+01_r8,0.20174e+01_r8 /) + kbo(:, 5,49,13) = (/ & + & 0.98023e+00_r8,0.19637e+01_r8,0.24863e+01_r8,0.26785e+01_r8,0.21102e+01_r8 /) + kbo(:, 1,50,13) = (/ & + & 0.44946e+00_r8,0.14198e+01_r8,0.19480e+01_r8,0.21639e+01_r8,0.16005e+01_r8 /) + kbo(:, 2,50,13) = (/ & + & 0.55308e+00_r8,0.15472e+01_r8,0.20885e+01_r8,0.23146e+01_r8,0.17433e+01_r8 /) + kbo(:, 3,50,13) = (/ & + & 0.66640e+00_r8,0.16732e+01_r8,0.22179e+01_r8,0.24447e+01_r8,0.18693e+01_r8 /) + kbo(:, 4,50,13) = (/ & + & 0.79021e+00_r8,0.17975e+01_r8,0.23380e+01_r8,0.25550e+01_r8,0.19794e+01_r8 /) + kbo(:, 5,50,13) = (/ & + & 0.92626e+00_r8,0.19191e+01_r8,0.24474e+01_r8,0.26476e+01_r8,0.20768e+01_r8 /) + kbo(:, 1,51,13) = (/ & + & 0.41452e+00_r8,0.13727e+01_r8,0.18922e+01_r8,0.21038e+01_r8,0.15428e+01_r8 /) + kbo(:, 2,51,13) = (/ & + & 0.51362e+00_r8,0.15005e+01_r8,0.20385e+01_r8,0.22616e+01_r8,0.16930e+01_r8 /) + kbo(:, 3,51,13) = (/ & + & 0.62394e+00_r8,0.16272e+01_r8,0.21714e+01_r8,0.23993e+01_r8,0.18251e+01_r8 /) + kbo(:, 4,51,13) = (/ & + & 0.74304e+00_r8,0.17523e+01_r8,0.22953e+01_r8,0.25171e+01_r8,0.19410e+01_r8 /) + kbo(:, 5,51,13) = (/ & + & 0.87505e+00_r8,0.18748e+01_r8,0.24082e+01_r8,0.26155e+01_r8,0.20426e+01_r8 /) + kbo(:, 1,52,13) = (/ & + & 0.38121e+00_r8,0.13250e+01_r8,0.18350e+01_r8,0.20413e+01_r8,0.14822e+01_r8 /) + kbo(:, 2,52,13) = (/ & + & 0.47581e+00_r8,0.14538e+01_r8,0.19870e+01_r8,0.22062e+01_r8,0.16405e+01_r8 /) + kbo(:, 3,52,13) = (/ & + & 0.58258e+00_r8,0.15810e+01_r8,0.21239e+01_r8,0.23514e+01_r8,0.17789e+01_r8 /) + kbo(:, 4,52,13) = (/ & + & 0.69813e+00_r8,0.17065e+01_r8,0.22509e+01_r8,0.24762e+01_r8,0.19005e+01_r8 /) + kbo(:, 5,52,13) = (/ & + & 0.82543e+00_r8,0.18301e+01_r8,0.23683e+01_r8,0.25815e+01_r8,0.20067e+01_r8 /) + kbo(:, 1,53,13) = (/ & + & 0.34902e+00_r8,0.12769e+01_r8,0.17751e+01_r8,0.19762e+01_r8,0.14178e+01_r8 /) + kbo(:, 2,53,13) = (/ & + & 0.43953e+00_r8,0.14068e+01_r8,0.19332e+01_r8,0.21485e+01_r8,0.15854e+01_r8 /) + kbo(:, 3,53,13) = (/ & + & 0.54216e+00_r8,0.15348e+01_r8,0.20756e+01_r8,0.23010e+01_r8,0.17302e+01_r8 /) + kbo(:, 4,53,13) = (/ & + & 0.65469e+00_r8,0.16608e+01_r8,0.22054e+01_r8,0.24328e+01_r8,0.18578e+01_r8 /) + kbo(:, 5,53,13) = (/ & + & 0.77730e+00_r8,0.17854e+01_r8,0.23267e+01_r8,0.25453e+01_r8,0.19695e+01_r8 /) + kbo(:, 1,54,13) = (/ & + & 0.32058e+00_r8,0.12324e+01_r8,0.17175e+01_r8,0.19140e+01_r8,0.13553e+01_r8 /) + kbo(:, 2,54,13) = (/ & + & 0.40795e+00_r8,0.13637e+01_r8,0.18819e+01_r8,0.20929e+01_r8,0.15321e+01_r8 /) + kbo(:, 3,54,13) = (/ & + & 0.50645e+00_r8,0.14920e+01_r8,0.20295e+01_r8,0.22518e+01_r8,0.16837e+01_r8 /) + kbo(:, 4,54,13) = (/ & + & 0.61609e+00_r8,0.16187e+01_r8,0.21628e+01_r8,0.23909e+01_r8,0.18169e+01_r8 /) + kbo(:, 5,54,13) = (/ & + & 0.73448e+00_r8,0.17439e+01_r8,0.22873e+01_r8,0.25101e+01_r8,0.19340e+01_r8 /) + kbo(:, 1,55,13) = (/ & + & 0.29443e+00_r8,0.11892e+01_r8,0.16600e+01_r8,0.18513e+01_r8,0.12929e+01_r8 /) + kbo(:, 2,55,13) = (/ & + & 0.37883e+00_r8,0.13219e+01_r8,0.18314e+01_r8,0.20376e+01_r8,0.14784e+01_r8 /) + kbo(:, 3,55,13) = (/ & + & 0.47335e+00_r8,0.14508e+01_r8,0.19839e+01_r8,0.22027e+01_r8,0.16372e+01_r8 /) + kbo(:, 4,55,13) = (/ & + & 0.57989e+00_r8,0.15780e+01_r8,0.21210e+01_r8,0.23485e+01_r8,0.17761e+01_r8 /) + kbo(:, 5,55,13) = (/ & + & 0.69533e+00_r8,0.17037e+01_r8,0.22482e+01_r8,0.24738e+01_r8,0.18980e+01_r8 /) + kbo(:, 1,56,13) = (/ & + & 0.26936e+00_r8,0.11459e+01_r8,0.16007e+01_r8,0.17863e+01_r8,0.12289e+01_r8 /) + kbo(:, 2,56,13) = (/ & + & 0.35065e+00_r8,0.12797e+01_r8,0.17789e+01_r8,0.19807e+01_r8,0.14221e+01_r8 /) + kbo(:, 3,56,13) = (/ & + & 0.44158e+00_r8,0.14097e+01_r8,0.19368e+01_r8,0.21523e+01_r8,0.15891e+01_r8 /) + kbo(:, 4,56,13) = (/ & + & 0.54448e+00_r8,0.15375e+01_r8,0.20786e+01_r8,0.23043e+01_r8,0.17334e+01_r8 /) + kbo(:, 5,56,13) = (/ & + & 0.65732e+00_r8,0.16637e+01_r8,0.22084e+01_r8,0.24358e+01_r8,0.18606e+01_r8 /) + kbo(:, 1,57,13) = (/ & + & 0.24515e+00_r8,0.11022e+01_r8,0.15388e+01_r8,0.17186e+01_r8,0.11645e+01_r8 /) + kbo(:, 2,57,13) = (/ & + & 0.32341e+00_r8,0.12372e+01_r8,0.17241e+01_r8,0.19215e+01_r8,0.13626e+01_r8 /) + kbo(:, 3,57,13) = (/ & + & 0.41131e+00_r8,0.13686e+01_r8,0.18879e+01_r8,0.20994e+01_r8,0.15383e+01_r8 /) + kbo(:, 4,57,13) = (/ & + & 0.51026e+00_r8,0.14967e+01_r8,0.20347e+01_r8,0.22575e+01_r8,0.16892e+01_r8 /) + kbo(:, 5,57,13) = (/ & + & 0.62036e+00_r8,0.16234e+01_r8,0.21677e+01_r8,0.23959e+01_r8,0.18217e+01_r8 /) + kbo(:, 1,58,13) = (/ & + & 0.22298e+00_r8,0.10601e+01_r8,0.14788e+01_r8,0.16521e+01_r8,0.11024e+01_r8 /) + kbo(:, 2,58,13) = (/ & + & 0.29857e+00_r8,0.11965e+01_r8,0.16700e+01_r8,0.18625e+01_r8,0.13039e+01_r8 /) + kbo(:, 3,58,13) = (/ & + & 0.38366e+00_r8,0.13291e+01_r8,0.18404e+01_r8,0.20474e+01_r8,0.14880e+01_r8 /) + kbo(:, 4,58,13) = (/ & + & 0.47882e+00_r8,0.14579e+01_r8,0.19918e+01_r8,0.22114e+01_r8,0.16455e+01_r8 /) + kbo(:, 5,58,13) = (/ & + & 0.58601e+00_r8,0.15850e+01_r8,0.21282e+01_r8,0.23561e+01_r8,0.17833e+01_r8 /) + kbo(:, 1,59,13) = (/ & + & 0.21427e+00_r8,0.10429e+01_r8,0.14544e+01_r8,0.16247e+01_r8,0.10771e+01_r8 /) + kbo(:, 2,59,13) = (/ & + & 0.28885e+00_r8,0.11801e+01_r8,0.16480e+01_r8,0.18384e+01_r8,0.12798e+01_r8 /) + kbo(:, 3,59,13) = (/ & + & 0.37281e+00_r8,0.13132e+01_r8,0.18209e+01_r8,0.20260e+01_r8,0.14670e+01_r8 /) + kbo(:, 4,59,13) = (/ & + & 0.46652e+00_r8,0.14422e+01_r8,0.19743e+01_r8,0.21926e+01_r8,0.16276e+01_r8 /) + kbo(:, 5,59,13) = (/ & + & 0.57246e+00_r8,0.15697e+01_r8,0.21123e+01_r8,0.23397e+01_r8,0.17674e+01_r8 /) + kbo(:, 1,13,14) = (/ & + & 0.76467e+01_r8,0.66870e+01_r8,0.63502e+01_r8,0.61468e+01_r8,0.66906e+01_r8 /) + kbo(:, 2,13,14) = (/ & + & 0.76514e+01_r8,0.66716e+01_r8,0.63627e+01_r8,0.61942e+01_r8,0.67780e+01_r8 /) + kbo(:, 3,13,14) = (/ & + & 0.76475e+01_r8,0.66428e+01_r8,0.63628e+01_r8,0.62371e+01_r8,0.68460e+01_r8 /) + kbo(:, 4,13,14) = (/ & + & 0.76415e+01_r8,0.66083e+01_r8,0.63514e+01_r8,0.62630e+01_r8,0.69072e+01_r8 /) + kbo(:, 5,13,14) = (/ & + & 0.76283e+01_r8,0.65686e+01_r8,0.63330e+01_r8,0.62779e+01_r8,0.69614e+01_r8 /) + kbo(:, 1,14,14) = (/ & + & 0.77958e+01_r8,0.69779e+01_r8,0.66658e+01_r8,0.63591e+01_r8,0.67479e+01_r8 /) + kbo(:, 2,14,14) = (/ & + & 0.78014e+01_r8,0.69599e+01_r8,0.66792e+01_r8,0.64167e+01_r8,0.68357e+01_r8 /) + kbo(:, 3,14,14) = (/ & + & 0.78100e+01_r8,0.69314e+01_r8,0.66809e+01_r8,0.64627e+01_r8,0.69109e+01_r8 /) + kbo(:, 4,14,14) = (/ & + & 0.78098e+01_r8,0.68950e+01_r8,0.66685e+01_r8,0.64923e+01_r8,0.69838e+01_r8 /) + kbo(:, 5,14,14) = (/ & + & 0.77999e+01_r8,0.68585e+01_r8,0.66494e+01_r8,0.65137e+01_r8,0.70531e+01_r8 /) + kbo(:, 1,15,14) = (/ & + & 0.78397e+01_r8,0.72065e+01_r8,0.69626e+01_r8,0.65521e+01_r8,0.67717e+01_r8 /) + kbo(:, 2,15,14) = (/ & + & 0.78630e+01_r8,0.71900e+01_r8,0.69770e+01_r8,0.66166e+01_r8,0.68639e+01_r8 /) + kbo(:, 3,15,14) = (/ & + & 0.78829e+01_r8,0.71661e+01_r8,0.69761e+01_r8,0.66643e+01_r8,0.69508e+01_r8 /) + kbo(:, 4,15,14) = (/ & + & 0.78961e+01_r8,0.71374e+01_r8,0.69668e+01_r8,0.66987e+01_r8,0.70374e+01_r8 /) + kbo(:, 5,15,14) = (/ & + & 0.78984e+01_r8,0.71026e+01_r8,0.69440e+01_r8,0.67207e+01_r8,0.71207e+01_r8 /) + kbo(:, 1,16,14) = (/ & + & 0.77976e+01_r8,0.73768e+01_r8,0.72331e+01_r8,0.67309e+01_r8,0.67735e+01_r8 /) + kbo(:, 2,16,14) = (/ & + & 0.78456e+01_r8,0.73704e+01_r8,0.72485e+01_r8,0.67988e+01_r8,0.68801e+01_r8 /) + kbo(:, 3,16,14) = (/ & + & 0.78840e+01_r8,0.73590e+01_r8,0.72505e+01_r8,0.68482e+01_r8,0.69801e+01_r8 /) + kbo(:, 4,16,14) = (/ & + & 0.79146e+01_r8,0.73379e+01_r8,0.72385e+01_r8,0.68847e+01_r8,0.70795e+01_r8 /) + kbo(:, 5,16,14) = (/ & + & 0.79322e+01_r8,0.73060e+01_r8,0.72179e+01_r8,0.69099e+01_r8,0.71779e+01_r8 /) + kbo(:, 1,17,14) = (/ & + & 0.76851e+01_r8,0.74978e+01_r8,0.74681e+01_r8,0.68923e+01_r8,0.67646e+01_r8 /) + kbo(:, 2,17,14) = (/ & + & 0.77622e+01_r8,0.75112e+01_r8,0.74909e+01_r8,0.69618e+01_r8,0.68880e+01_r8 /) + kbo(:, 3,17,14) = (/ & + & 0.78293e+01_r8,0.75089e+01_r8,0.74964e+01_r8,0.70134e+01_r8,0.70063e+01_r8 /) + kbo(:, 4,17,14) = (/ & + & 0.78832e+01_r8,0.75014e+01_r8,0.74883e+01_r8,0.70540e+01_r8,0.71204e+01_r8 /) + kbo(:, 5,17,14) = (/ & + & 0.79237e+01_r8,0.74752e+01_r8,0.74629e+01_r8,0.70833e+01_r8,0.72311e+01_r8 /) + kbo(:, 1,18,14) = (/ & + & 0.75343e+01_r8,0.75844e+01_r8,0.76679e+01_r8,0.70369e+01_r8,0.67530e+01_r8 /) + kbo(:, 2,18,14) = (/ & + & 0.76372e+01_r8,0.76127e+01_r8,0.76999e+01_r8,0.71100e+01_r8,0.68939e+01_r8 /) + kbo(:, 3,18,14) = (/ & + & 0.77344e+01_r8,0.76293e+01_r8,0.77123e+01_r8,0.71649e+01_r8,0.70305e+01_r8 /) + kbo(:, 4,18,14) = (/ & + & 0.78168e+01_r8,0.76302e+01_r8,0.77077e+01_r8,0.72057e+01_r8,0.71594e+01_r8 /) + kbo(:, 5,18,14) = (/ & + & 0.78848e+01_r8,0.76120e+01_r8,0.76799e+01_r8,0.72369e+01_r8,0.72819e+01_r8 /) + kbo(:, 1,19,14) = (/ & + & 0.73642e+01_r8,0.76427e+01_r8,0.78392e+01_r8,0.71673e+01_r8,0.67426e+01_r8 /) + kbo(:, 2,19,14) = (/ & + & 0.75027e+01_r8,0.76890e+01_r8,0.78792e+01_r8,0.72411e+01_r8,0.69029e+01_r8 /) + kbo(:, 3,19,14) = (/ & + & 0.76261e+01_r8,0.77218e+01_r8,0.78995e+01_r8,0.72995e+01_r8,0.70551e+01_r8 /) + kbo(:, 4,19,14) = (/ & + & 0.77358e+01_r8,0.77317e+01_r8,0.78972e+01_r8,0.73431e+01_r8,0.71976e+01_r8 /) + kbo(:, 5,19,14) = (/ & + & 0.78306e+01_r8,0.77206e+01_r8,0.78669e+01_r8,0.73734e+01_r8,0.73288e+01_r8 /) + kbo(:, 1,20,14) = (/ & + & 0.71989e+01_r8,0.76856e+01_r8,0.79830e+01_r8,0.72835e+01_r8,0.67408e+01_r8 /) + kbo(:, 2,20,14) = (/ & + & 0.73691e+01_r8,0.77492e+01_r8,0.80344e+01_r8,0.73623e+01_r8,0.69200e+01_r8 /) + kbo(:, 3,20,14) = (/ & + & 0.75204e+01_r8,0.77952e+01_r8,0.80604e+01_r8,0.74206e+01_r8,0.70842e+01_r8 /) + kbo(:, 4,20,14) = (/ & + & 0.76560e+01_r8,0.78150e+01_r8,0.80567e+01_r8,0.74651e+01_r8,0.72381e+01_r8 /) + kbo(:, 5,20,14) = (/ & + & 0.77736e+01_r8,0.78108e+01_r8,0.80255e+01_r8,0.74944e+01_r8,0.73772e+01_r8 /) + kbo(:, 1,21,14) = (/ & + & 0.70426e+01_r8,0.77166e+01_r8,0.81049e+01_r8,0.73883e+01_r8,0.67480e+01_r8 /) + kbo(:, 2,21,14) = (/ & + & 0.72474e+01_r8,0.77946e+01_r8,0.81668e+01_r8,0.74708e+01_r8,0.69410e+01_r8 /) + kbo(:, 3,21,14) = (/ & + & 0.74271e+01_r8,0.78518e+01_r8,0.81976e+01_r8,0.75283e+01_r8,0.71153e+01_r8 /) + kbo(:, 4,21,14) = (/ & + & 0.75881e+01_r8,0.78806e+01_r8,0.81926e+01_r8,0.75722e+01_r8,0.72765e+01_r8 /) + kbo(:, 5,21,14) = (/ & + & 0.77244e+01_r8,0.78840e+01_r8,0.81605e+01_r8,0.76005e+01_r8,0.74219e+01_r8 /) + kbo(:, 1,22,14) = (/ & + & 0.69208e+01_r8,0.77467e+01_r8,0.82134e+01_r8,0.74892e+01_r8,0.67760e+01_r8 /) + kbo(:, 2,22,14) = (/ & + & 0.71527e+01_r8,0.78380e+01_r8,0.82825e+01_r8,0.75703e+01_r8,0.69788e+01_r8 /) + kbo(:, 3,22,14) = (/ & + & 0.73591e+01_r8,0.79026e+01_r8,0.83138e+01_r8,0.76265e+01_r8,0.71614e+01_r8 /) + kbo(:, 4,22,14) = (/ & + & 0.75412e+01_r8,0.79369e+01_r8,0.83052e+01_r8,0.76676e+01_r8,0.73269e+01_r8 /) + kbo(:, 5,22,14) = (/ & + & 0.76931e+01_r8,0.79423e+01_r8,0.82705e+01_r8,0.76932e+01_r8,0.74734e+01_r8 /) + kbo(:, 1,23,14) = (/ & + & 0.68264e+01_r8,0.77768e+01_r8,0.83085e+01_r8,0.75813e+01_r8,0.68129e+01_r8 /) + kbo(:, 2,23,14) = (/ & + & 0.70814e+01_r8,0.78791e+01_r8,0.83807e+01_r8,0.76573e+01_r8,0.70223e+01_r8 /) + kbo(:, 3,23,14) = (/ & + & 0.73108e+01_r8,0.79473e+01_r8,0.84103e+01_r8,0.77115e+01_r8,0.72087e+01_r8 /) + kbo(:, 4,23,14) = (/ & + & 0.75083e+01_r8,0.79850e+01_r8,0.83989e+01_r8,0.77500e+01_r8,0.73762e+01_r8 /) + kbo(:, 5,23,14) = (/ & + & 0.76738e+01_r8,0.79912e+01_r8,0.83608e+01_r8,0.77715e+01_r8,0.75218e+01_r8 /) + kbo(:, 1,24,14) = (/ & + & 0.67597e+01_r8,0.78092e+01_r8,0.83929e+01_r8,0.76639e+01_r8,0.68571e+01_r8 /) + kbo(:, 2,24,14) = (/ & + & 0.70359e+01_r8,0.79159e+01_r8,0.84653e+01_r8,0.77347e+01_r8,0.70700e+01_r8 /) + kbo(:, 3,24,14) = (/ & + & 0.72818e+01_r8,0.79869e+01_r8,0.84905e+01_r8,0.77860e+01_r8,0.72578e+01_r8 /) + kbo(:, 4,24,14) = (/ & + & 0.74908e+01_r8,0.80269e+01_r8,0.84765e+01_r8,0.78202e+01_r8,0.74248e+01_r8 /) + kbo(:, 5,24,14) = (/ & + & 0.76673e+01_r8,0.80324e+01_r8,0.84337e+01_r8,0.78375e+01_r8,0.75690e+01_r8 /) + kbo(:, 1,25,14) = (/ & + & 0.67209e+01_r8,0.78436e+01_r8,0.84676e+01_r8,0.77356e+01_r8,0.69066e+01_r8 /) + kbo(:, 2,25,14) = (/ & + & 0.70147e+01_r8,0.79506e+01_r8,0.85366e+01_r8,0.78027e+01_r8,0.71216e+01_r8 /) + kbo(:, 3,25,14) = (/ & + & 0.72710e+01_r8,0.80222e+01_r8,0.85567e+01_r8,0.78495e+01_r8,0.73079e+01_r8 /) + kbo(:, 4,25,14) = (/ & + & 0.74891e+01_r8,0.80627e+01_r8,0.85388e+01_r8,0.78803e+01_r8,0.74736e+01_r8 /) + kbo(:, 5,25,14) = (/ & + & 0.76763e+01_r8,0.80663e+01_r8,0.84908e+01_r8,0.78920e+01_r8,0.76152e+01_r8 /) + kbo(:, 1,26,14) = (/ & + & 0.67117e+01_r8,0.78809e+01_r8,0.85346e+01_r8,0.77996e+01_r8,0.69621e+01_r8 /) + kbo(:, 2,26,14) = (/ & + & 0.70163e+01_r8,0.79848e+01_r8,0.85977e+01_r8,0.78624e+01_r8,0.71766e+01_r8 /) + kbo(:, 3,26,14) = (/ & + & 0.72800e+01_r8,0.80555e+01_r8,0.86111e+01_r8,0.79043e+01_r8,0.73612e+01_r8 /) + kbo(:, 4,26,14) = (/ & + & 0.75048e+01_r8,0.80927e+01_r8,0.85874e+01_r8,0.79312e+01_r8,0.75235e+01_r8 /) + kbo(:, 5,26,14) = (/ & + & 0.76969e+01_r8,0.80929e+01_r8,0.85318e+01_r8,0.79367e+01_r8,0.76615e+01_r8 /) + kbo(:, 1,27,14) = (/ & + & 0.67222e+01_r8,0.79165e+01_r8,0.85935e+01_r8,0.78553e+01_r8,0.70208e+01_r8 /) + kbo(:, 2,27,14) = (/ & + & 0.70339e+01_r8,0.80174e+01_r8,0.86486e+01_r8,0.79134e+01_r8,0.72318e+01_r8 /) + kbo(:, 3,27,14) = (/ & + & 0.73021e+01_r8,0.80859e+01_r8,0.86549e+01_r8,0.79502e+01_r8,0.74127e+01_r8 /) + kbo(:, 4,27,14) = (/ & + & 0.75298e+01_r8,0.81175e+01_r8,0.86239e+01_r8,0.79721e+01_r8,0.75702e+01_r8 /) + kbo(:, 5,27,14) = (/ & + & 0.77246e+01_r8,0.81143e+01_r8,0.85613e+01_r8,0.79734e+01_r8,0.77047e+01_r8 /) + kbo(:, 1,28,14) = (/ & + & 0.67490e+01_r8,0.79508e+01_r8,0.86448e+01_r8,0.79039e+01_r8,0.70793e+01_r8 /) + kbo(:, 2,28,14) = (/ & + & 0.70641e+01_r8,0.80481e+01_r8,0.86903e+01_r8,0.79567e+01_r8,0.72853e+01_r8 /) + kbo(:, 3,28,14) = (/ & + & 0.73339e+01_r8,0.81119e+01_r8,0.86890e+01_r8,0.79886e+01_r8,0.74622e+01_r8 /) + kbo(:, 4,28,14) = (/ & + & 0.75625e+01_r8,0.81383e+01_r8,0.86502e+01_r8,0.80049e+01_r8,0.76145e+01_r8 /) + kbo(:, 5,28,14) = (/ & + & 0.77567e+01_r8,0.81304e+01_r8,0.85806e+01_r8,0.80023e+01_r8,0.77455e+01_r8 /) + kbo(:, 1,29,14) = (/ & + & 0.67914e+01_r8,0.79845e+01_r8,0.86886e+01_r8,0.79462e+01_r8,0.71386e+01_r8 /) + kbo(:, 2,29,14) = (/ & + & 0.71068e+01_r8,0.80770e+01_r8,0.87239e+01_r8,0.79933e+01_r8,0.73389e+01_r8 /) + kbo(:, 3,29,14) = (/ & + & 0.73751e+01_r8,0.81344e+01_r8,0.87144e+01_r8,0.80208e+01_r8,0.75104e+01_r8 /) + kbo(:, 4,29,14) = (/ & + & 0.76020e+01_r8,0.81550e+01_r8,0.86676e+01_r8,0.80316e+01_r8,0.76575e+01_r8 /) + kbo(:, 5,29,14) = (/ & + & 0.77937e+01_r8,0.81425e+01_r8,0.85914e+01_r8,0.80248e+01_r8,0.77840e+01_r8 /) + kbo(:, 1,30,14) = (/ & + & 0.68445e+01_r8,0.80166e+01_r8,0.87256e+01_r8,0.79827e+01_r8,0.71970e+01_r8 /) + kbo(:, 2,30,14) = (/ & + & 0.71563e+01_r8,0.81037e+01_r8,0.87505e+01_r8,0.80234e+01_r8,0.73900e+01_r8 /) + kbo(:, 3,30,14) = (/ & + & 0.74214e+01_r8,0.81535e+01_r8,0.87321e+01_r8,0.80469e+01_r8,0.75564e+01_r8 /) + kbo(:, 4,30,14) = (/ & + & 0.76455e+01_r8,0.81683e+01_r8,0.86770e+01_r8,0.80524e+01_r8,0.76986e+01_r8 /) + kbo(:, 5,30,14) = (/ & + & 0.78317e+01_r8,0.81499e+01_r8,0.85949e+01_r8,0.80416e+01_r8,0.78203e+01_r8 /) + kbo(:, 1,31,14) = (/ & + & 0.69054e+01_r8,0.80478e+01_r8,0.87566e+01_r8,0.80136e+01_r8,0.72537e+01_r8 /) + kbo(:, 2,31,14) = (/ & + & 0.72125e+01_r8,0.81281e+01_r8,0.87710e+01_r8,0.80494e+01_r8,0.74404e+01_r8 /) + kbo(:, 3,31,14) = (/ & + & 0.74718e+01_r8,0.81700e+01_r8,0.87427e+01_r8,0.80677e+01_r8,0.76003e+01_r8 /) + kbo(:, 4,31,14) = (/ & + & 0.76912e+01_r8,0.81779e+01_r8,0.86791e+01_r8,0.80682e+01_r8,0.77384e+01_r8 /) + kbo(:, 5,31,14) = (/ & + & 0.78715e+01_r8,0.81532e+01_r8,0.85914e+01_r8,0.80538e+01_r8,0.78547e+01_r8 /) + kbo(:, 1,32,14) = (/ & + & 0.69718e+01_r8,0.80767e+01_r8,0.87812e+01_r8,0.80405e+01_r8,0.73093e+01_r8 /) + kbo(:, 2,32,14) = (/ & + & 0.72714e+01_r8,0.81493e+01_r8,0.87845e+01_r8,0.80705e+01_r8,0.74889e+01_r8 /) + kbo(:, 3,32,14) = (/ & + & 0.75255e+01_r8,0.81843e+01_r8,0.87476e+01_r8,0.80843e+01_r8,0.76427e+01_r8 /) + kbo(:, 4,32,14) = (/ & + & 0.77373e+01_r8,0.81836e+01_r8,0.86757e+01_r8,0.80798e+01_r8,0.77759e+01_r8 /) + kbo(:, 5,32,14) = (/ & + & 0.79115e+01_r8,0.81523e+01_r8,0.85821e+01_r8,0.80611e+01_r8,0.78870e+01_r8 /) + kbo(:, 1,33,14) = (/ & + & 0.70424e+01_r8,0.81041e+01_r8,0.88003e+01_r8,0.80631e+01_r8,0.73621e+01_r8 /) + kbo(:, 2,33,14) = (/ & + & 0.73332e+01_r8,0.81674e+01_r8,0.87934e+01_r8,0.80887e+01_r8,0.75359e+01_r8 /) + kbo(:, 3,33,14) = (/ & + & 0.75797e+01_r8,0.81949e+01_r8,0.87467e+01_r8,0.80962e+01_r8,0.76832e+01_r8 /) + kbo(:, 4,33,14) = (/ & + & 0.77832e+01_r8,0.81860e+01_r8,0.86679e+01_r8,0.80880e+01_r8,0.78112e+01_r8 /) + kbo(:, 5,33,14) = (/ & + & 0.79514e+01_r8,0.81480e+01_r8,0.85688e+01_r8,0.80650e+01_r8,0.79176e+01_r8 /) + kbo(:, 1,34,14) = (/ & + & 0.71032e+01_r8,0.81256e+01_r8,0.88135e+01_r8,0.80801e+01_r8,0.74073e+01_r8 /) + kbo(:, 2,34,14) = (/ & + & 0.73864e+01_r8,0.81812e+01_r8,0.87981e+01_r8,0.81025e+01_r8,0.75752e+01_r8 /) + kbo(:, 3,34,14) = (/ & + & 0.76257e+01_r8,0.82022e+01_r8,0.87428e+01_r8,0.81055e+01_r8,0.77177e+01_r8 /) + kbo(:, 4,34,14) = (/ & + & 0.78229e+01_r8,0.81866e+01_r8,0.86595e+01_r8,0.80934e+01_r8,0.78409e+01_r8 /) + kbo(:, 5,34,14) = (/ & + & 0.79841e+01_r8,0.81428e+01_r8,0.85553e+01_r8,0.80663e+01_r8,0.79427e+01_r8 /) + kbo(:, 1,35,14) = (/ & + & 0.71357e+01_r8,0.81386e+01_r8,0.88238e+01_r8,0.80923e+01_r8,0.74328e+01_r8 /) + kbo(:, 2,35,14) = (/ & + & 0.74155e+01_r8,0.81901e+01_r8,0.88028e+01_r8,0.81125e+01_r8,0.75980e+01_r8 /) + kbo(:, 3,35,14) = (/ & + & 0.76506e+01_r8,0.82068e+01_r8,0.87428e+01_r8,0.81128e+01_r8,0.77381e+01_r8 /) + kbo(:, 4,35,14) = (/ & + & 0.78446e+01_r8,0.81876e+01_r8,0.86563e+01_r8,0.80980e+01_r8,0.78583e+01_r8 /) + kbo(:, 5,35,14) = (/ & + & 0.80022e+01_r8,0.81408e+01_r8,0.85492e+01_r8,0.80683e+01_r8,0.79574e+01_r8 /) + kbo(:, 1,36,14) = (/ & + & 0.71358e+01_r8,0.81426e+01_r8,0.88312e+01_r8,0.80996e+01_r8,0.74385e+01_r8 /) + kbo(:, 2,36,14) = (/ & + & 0.74168e+01_r8,0.81942e+01_r8,0.88101e+01_r8,0.81195e+01_r8,0.76033e+01_r8 /) + kbo(:, 3,36,14) = (/ & + & 0.76530e+01_r8,0.82111e+01_r8,0.87491e+01_r8,0.81189e+01_r8,0.77431e+01_r8 /) + kbo(:, 4,36,14) = (/ & + & 0.78475e+01_r8,0.81916e+01_r8,0.86625e+01_r8,0.81041e+01_r8,0.78633e+01_r8 /) + kbo(:, 5,36,14) = (/ & + & 0.80053e+01_r8,0.81444e+01_r8,0.85549e+01_r8,0.80739e+01_r8,0.79624e+01_r8 /) + kbo(:, 1,37,14) = (/ & + & 0.70898e+01_r8,0.81353e+01_r8,0.88375e+01_r8,0.81022e+01_r8,0.74173e+01_r8 /) + kbo(:, 2,37,14) = (/ & + & 0.73792e+01_r8,0.81923e+01_r8,0.88220e+01_r8,0.81236e+01_r8,0.75852e+01_r8 /) + kbo(:, 3,37,14) = (/ & + & 0.76229e+01_r8,0.82146e+01_r8,0.87658e+01_r8,0.81255e+01_r8,0.77281e+01_r8 /) + kbo(:, 4,37,14) = (/ & + & 0.78232e+01_r8,0.81996e+01_r8,0.86818e+01_r8,0.81120e+01_r8,0.78508e+01_r8 /) + kbo(:, 5,37,14) = (/ & + & 0.79866e+01_r8,0.81554e+01_r8,0.85764e+01_r8,0.80843e+01_r8,0.79525e+01_r8 /) + kbo(:, 1,38,14) = (/ & + & 0.70419e+01_r8,0.81271e+01_r8,0.88418e+01_r8,0.81031e+01_r8,0.73933e+01_r8 /) + kbo(:, 2,38,14) = (/ & + & 0.73389e+01_r8,0.81889e+01_r8,0.88323e+01_r8,0.81261e+01_r8,0.75648e+01_r8 /) + kbo(:, 3,38,14) = (/ & + & 0.75899e+01_r8,0.82161e+01_r8,0.87808e+01_r8,0.81301e+01_r8,0.77105e+01_r8 /) + kbo(:, 4,38,14) = (/ & + & 0.77971e+01_r8,0.82068e+01_r8,0.87000e+01_r8,0.81195e+01_r8,0.78368e+01_r8 /) + kbo(:, 5,38,14) = (/ & + & 0.79663e+01_r8,0.81665e+01_r8,0.85976e+01_r8,0.80935e+01_r8,0.79412e+01_r8 /) + kbo(:, 1,39,14) = (/ & + & 0.69923e+01_r8,0.81165e+01_r8,0.88435e+01_r8,0.81024e+01_r8,0.73685e+01_r8 /) + kbo(:, 2,39,14) = (/ & + & 0.72982e+01_r8,0.81845e+01_r8,0.88409e+01_r8,0.81277e+01_r8,0.75441e+01_r8 /) + kbo(:, 3,39,14) = (/ & + & 0.75563e+01_r8,0.82164e+01_r8,0.87952e+01_r8,0.81347e+01_r8,0.76928e+01_r8 /) + kbo(:, 4,39,14) = (/ & + & 0.77695e+01_r8,0.82122e+01_r8,0.87165e+01_r8,0.81250e+01_r8,0.78216e+01_r8 /) + kbo(:, 5,39,14) = (/ & + & 0.79452e+01_r8,0.81762e+01_r8,0.86172e+01_r8,0.81015e+01_r8,0.79291e+01_r8 /) + kbo(:, 1,40,14) = (/ & + & 0.69080e+01_r8,0.80958e+01_r8,0.88413e+01_r8,0.80965e+01_r8,0.73229e+01_r8 /) + kbo(:, 2,40,14) = (/ & + & 0.72277e+01_r8,0.81734e+01_r8,0.88495e+01_r8,0.81259e+01_r8,0.75046e+01_r8 /) + kbo(:, 3,40,14) = (/ & + & 0.74967e+01_r8,0.82131e+01_r8,0.88131e+01_r8,0.81381e+01_r8,0.76600e+01_r8 /) + kbo(:, 4,40,14) = (/ & + & 0.77214e+01_r8,0.82184e+01_r8,0.87413e+01_r8,0.81320e+01_r8,0.77938e+01_r8 /) + kbo(:, 5,40,14) = (/ & + & 0.79055e+01_r8,0.81894e+01_r8,0.86471e+01_r8,0.81094e+01_r8,0.79066e+01_r8 /) + kbo(:, 1,41,14) = (/ & + & 0.68155e+01_r8,0.80708e+01_r8,0.88352e+01_r8,0.80885e+01_r8,0.72719e+01_r8 /) + kbo(:, 2,41,14) = (/ & + & 0.71495e+01_r8,0.81585e+01_r8,0.88545e+01_r8,0.81224e+01_r8,0.74618e+01_r8 /) + kbo(:, 3,41,14) = (/ & + & 0.74308e+01_r8,0.82074e+01_r8,0.88291e+01_r8,0.81392e+01_r8,0.76238e+01_r8 /) + kbo(:, 4,41,14) = (/ & + & 0.76675e+01_r8,0.82222e+01_r8,0.87650e+01_r8,0.81374e+01_r8,0.77629e+01_r8 /) + kbo(:, 5,41,14) = (/ & + & 0.78621e+01_r8,0.82014e+01_r8,0.86761e+01_r8,0.81197e+01_r8,0.78805e+01_r8 /) + kbo(:, 1,42,14) = (/ & + & 0.67210e+01_r8,0.80436e+01_r8,0.88257e+01_r8,0.80787e+01_r8,0.72181e+01_r8 /) + kbo(:, 2,42,14) = (/ & + & 0.70672e+01_r8,0.81413e+01_r8,0.88562e+01_r8,0.81177e+01_r8,0.74171e+01_r8 /) + kbo(:, 3,42,14) = (/ & + & 0.73618e+01_r8,0.81993e+01_r8,0.88420e+01_r8,0.81387e+01_r8,0.75853e+01_r8 /) + kbo(:, 4,42,14) = (/ & + & 0.76110e+01_r8,0.82240e+01_r8,0.87872e+01_r8,0.81416e+01_r8,0.77301e+01_r8 /) + kbo(:, 5,42,14) = (/ & + & 0.78157e+01_r8,0.82114e+01_r8,0.87034e+01_r8,0.81275e+01_r8,0.78533e+01_r8 /) + kbo(:, 1,43,14) = (/ & + & 0.66012e+01_r8,0.80077e+01_r8,0.88083e+01_r8,0.80639e+01_r8,0.71482e+01_r8 /) + kbo(:, 2,43,14) = (/ & + & 0.69627e+01_r8,0.81158e+01_r8,0.88532e+01_r8,0.81101e+01_r8,0.73596e+01_r8 /) + kbo(:, 3,43,14) = (/ & + & 0.72743e+01_r8,0.81862e+01_r8,0.88533e+01_r8,0.81352e+01_r8,0.75360e+01_r8 /) + kbo(:, 4,43,14) = (/ & + & 0.75376e+01_r8,0.82203e+01_r8,0.88101e+01_r8,0.81444e+01_r8,0.76876e+01_r8 /) + kbo(:, 5,43,14) = (/ & + & 0.77560e+01_r8,0.82200e+01_r8,0.87338e+01_r8,0.81353e+01_r8,0.78176e+01_r8 /) + kbo(:, 1,44,14) = (/ & + & 0.64654e+01_r8,0.79624e+01_r8,0.87841e+01_r8,0.80450e+01_r8,0.70696e+01_r8 /) + kbo(:, 2,44,14) = (/ & + & 0.68452e+01_r8,0.80842e+01_r8,0.88456e+01_r8,0.80985e+01_r8,0.72931e+01_r8 /) + kbo(:, 3,44,14) = (/ & + & 0.71736e+01_r8,0.81668e+01_r8,0.88594e+01_r8,0.81294e+01_r8,0.74799e+01_r8 /) + kbo(:, 4,44,14) = (/ & + & 0.74536e+01_r8,0.82135e+01_r8,0.88309e+01_r8,0.81455e+01_r8,0.76398e+01_r8 /) + kbo(:, 5,44,14) = (/ & + & 0.76864e+01_r8,0.82252e+01_r8,0.87641e+01_r8,0.81417e+01_r8,0.77771e+01_r8 /) + kbo(:, 1,45,14) = (/ & + & 0.63246e+01_r8,0.79121e+01_r8,0.87529e+01_r8,0.80227e+01_r8,0.69872e+01_r8 /) + kbo(:, 2,45,14) = (/ & + & 0.67215e+01_r8,0.80478e+01_r8,0.88314e+01_r8,0.80840e+01_r8,0.72219e+01_r8 /) + kbo(:, 3,45,14) = (/ & + & 0.70680e+01_r8,0.81447e+01_r8,0.88609e+01_r8,0.81218e+01_r8,0.74205e+01_r8 /) + kbo(:, 4,45,14) = (/ & + & 0.73633e+01_r8,0.82020e+01_r8,0.88464e+01_r8,0.81437e+01_r8,0.75896e+01_r8 /) + kbo(:, 5,45,14) = (/ & + & 0.76123e+01_r8,0.82264e+01_r8,0.87913e+01_r8,0.81458e+01_r8,0.77333e+01_r8 /) + kbo(:, 1,46,14) = (/ & + & 0.61677e+01_r8,0.78522e+01_r8,0.87120e+01_r8,0.79958e+01_r8,0.68962e+01_r8 /) + kbo(:, 2,46,14) = (/ & + & 0.65843e+01_r8,0.80056e+01_r8,0.88106e+01_r8,0.80659e+01_r8,0.71413e+01_r8 /) + kbo(:, 3,46,14) = (/ & + & 0.69482e+01_r8,0.81147e+01_r8,0.88565e+01_r8,0.81122e+01_r8,0.73539e+01_r8 /) + kbo(:, 4,46,14) = (/ & + & 0.72620e+01_r8,0.81857e+01_r8,0.88581e+01_r8,0.81382e+01_r8,0.75320e+01_r8 /) + kbo(:, 5,46,14) = (/ & + & 0.75285e+01_r8,0.82222e+01_r8,0.88171e+01_r8,0.81482e+01_r8,0.76841e+01_r8 /) + kbo(:, 1,47,14) = (/ & + & 0.59872e+01_r8,0.77759e+01_r8,0.86581e+01_r8,0.79599e+01_r8,0.67904e+01_r8 /) + kbo(:, 2,47,14) = (/ & + & 0.64227e+01_r8,0.79505e+01_r8,0.87794e+01_r8,0.80417e+01_r8,0.70463e+01_r8 /) + kbo(:, 3,47,14) = (/ & + & 0.68067e+01_r8,0.80750e+01_r8,0.88445e+01_r8,0.80966e+01_r8,0.72732e+01_r8 /) + kbo(:, 4,47,14) = (/ & + & 0.71415e+01_r8,0.81619e+01_r8,0.88634e+01_r8,0.81302e+01_r8,0.74640e+01_r8 /) + kbo(:, 5,47,14) = (/ & + & 0.74259e+01_r8,0.82118e+01_r8,0.88390e+01_r8,0.81478e+01_r8,0.76260e+01_r8 /) + kbo(:, 1,48,14) = (/ & + & 0.57999e+01_r8,0.76897e+01_r8,0.85924e+01_r8,0.79165e+01_r8,0.66812e+01_r8 /) + kbo(:, 2,48,14) = (/ & + & 0.62523e+01_r8,0.78878e+01_r8,0.87384e+01_r8,0.80135e+01_r8,0.69471e+01_r8 /) + kbo(:, 3,48,14) = (/ & + & 0.66581e+01_r8,0.80303e+01_r8,0.88250e+01_r8,0.80783e+01_r8,0.71862e+01_r8 /) + kbo(:, 4,48,14) = (/ & + & 0.70120e+01_r8,0.81321e+01_r8,0.88616e+01_r8,0.81203e+01_r8,0.73915e+01_r8 /) + kbo(:, 5,48,14) = (/ & + & 0.73167e+01_r8,0.81963e+01_r8,0.88550e+01_r8,0.81433e+01_r8,0.75640e+01_r8 /) + kbo(:, 1,49,14) = (/ & + & 0.56056e+01_r8,0.75967e+01_r8,0.85186e+01_r8,0.78664e+01_r8,0.65684e+01_r8 /) + kbo(:, 2,49,14) = (/ & + & 0.60725e+01_r8,0.78139e+01_r8,0.86868e+01_r8,0.79799e+01_r8,0.68428e+01_r8 /) + kbo(:, 3,49,14) = (/ & + & 0.65005e+01_r8,0.79789e+01_r8,0.87970e+01_r8,0.80551e+01_r8,0.70936e+01_r8 /) + kbo(:, 4,49,14) = (/ & + & 0.68750e+01_r8,0.80955e+01_r8,0.88532e+01_r8,0.81069e+01_r8,0.73141e+01_r8 /) + kbo(:, 5,49,14) = (/ & + & 0.72008e+01_r8,0.81753e+01_r8,0.88640e+01_r8,0.81362e+01_r8,0.74980e+01_r8 /) + kbo(:, 1,50,14) = (/ & + & 0.54125e+01_r8,0.74991e+01_r8,0.84401e+01_r8,0.78123e+01_r8,0.64595e+01_r8 /) + kbo(:, 2,50,14) = (/ & + & 0.59003e+01_r8,0.77375e+01_r8,0.86301e+01_r8,0.79423e+01_r8,0.67420e+01_r8 /) + kbo(:, 3,50,14) = (/ & + & 0.63429e+01_r8,0.79215e+01_r8,0.87619e+01_r8,0.80304e+01_r8,0.70024e+01_r8 /) + kbo(:, 4,50,14) = (/ & + & 0.67393e+01_r8,0.80557e+01_r8,0.88380e+01_r8,0.80904e+01_r8,0.72354e+01_r8 /) + kbo(:, 5,50,14) = (/ & + & 0.70838e+01_r8,0.81507e+01_r8,0.88659e+01_r8,0.81277e+01_r8,0.74327e+01_r8 /) + kbo(:, 1,51,14) = (/ & + & 0.52191e+01_r8,0.73982e+01_r8,0.83585e+01_r8,0.77548e+01_r8,0.63504e+01_r8 /) + kbo(:, 2,51,14) = (/ & + & 0.57281e+01_r8,0.76566e+01_r8,0.85673e+01_r8,0.79002e+01_r8,0.66408e+01_r8 /) + kbo(:, 3,51,14) = (/ & + & 0.61850e+01_r8,0.78612e+01_r8,0.87206e+01_r8,0.80029e+01_r8,0.69102e+01_r8 /) + kbo(:, 4,51,14) = (/ & + & 0.66013e+01_r8,0.80131e+01_r8,0.88169e+01_r8,0.80719e+01_r8,0.71542e+01_r8 /) + kbo(:, 5,51,14) = (/ & + & 0.69630e+01_r8,0.81207e+01_r8,0.88611e+01_r8,0.81171e+01_r8,0.73645e+01_r8 /) + kbo(:, 1,52,14) = (/ & + & 0.50203e+01_r8,0.72853e+01_r8,0.82659e+01_r8,0.76900e+01_r8,0.62362e+01_r8 /) + kbo(:, 2,52,14) = (/ & + & 0.55489e+01_r8,0.75692e+01_r8,0.84974e+01_r8,0.78525e+01_r8,0.65380e+01_r8 /) + kbo(:, 3,52,14) = (/ & + & 0.60223e+01_r8,0.77933e+01_r8,0.86726e+01_r8,0.79710e+01_r8,0.68148e+01_r8 /) + kbo(:, 4,52,14) = (/ & + & 0.64533e+01_r8,0.79619e+01_r8,0.87883e+01_r8,0.80495e+01_r8,0.70682e+01_r8 /) + kbo(:, 5,52,14) = (/ & + & 0.68363e+01_r8,0.80853e+01_r8,0.88509e+01_r8,0.81034e+01_r8,0.72926e+01_r8 /) + kbo(:, 1,53,14) = (/ & + & 0.48171e+01_r8,0.71626e+01_r8,0.81646e+01_r8,0.76188e+01_r8,0.61179e+01_r8 /) + kbo(:, 2,53,14) = (/ & + & 0.53620e+01_r8,0.74745e+01_r8,0.84206e+01_r8,0.77982e+01_r8,0.64310e+01_r8 /) + kbo(:, 3,53,14) = (/ & + & 0.58544e+01_r8,0.77168e+01_r8,0.86150e+01_r8,0.79329e+01_r8,0.67166e+01_r8 /) + kbo(:, 4,53,14) = (/ & + & 0.63007e+01_r8,0.79064e+01_r8,0.87527e+01_r8,0.80244e+01_r8,0.69787e+01_r8 /) + kbo(:, 5,53,14) = (/ & + & 0.67036e+01_r8,0.80457e+01_r8,0.88348e+01_r8,0.80870e+01_r8,0.72150e+01_r8 /) + kbo(:, 1,54,14) = (/ & + & 0.46268e+01_r8,0.70415e+01_r8,0.80643e+01_r8,0.75453e+01_r8,0.60051e+01_r8 /) + kbo(:, 2,54,14) = (/ & + & 0.51834e+01_r8,0.73793e+01_r8,0.83436e+01_r8,0.77439e+01_r8,0.63304e+01_r8 /) + kbo(:, 3,54,14) = (/ & + & 0.56952e+01_r8,0.76416e+01_r8,0.85557e+01_r8,0.78930e+01_r8,0.66233e+01_r8 /) + kbo(:, 4,54,14) = (/ & + & 0.61555e+01_r8,0.78501e+01_r8,0.87136e+01_r8,0.79986e+01_r8,0.68935e+01_r8 /) + kbo(:, 5,54,14) = (/ & + & 0.65754e+01_r8,0.80055e+01_r8,0.88139e+01_r8,0.80689e+01_r8,0.71391e+01_r8 /) + kbo(:, 1,55,14) = (/ & + & 0.44418e+01_r8,0.69152e+01_r8,0.79589e+01_r8,0.74683e+01_r8,0.58909e+01_r8 /) + kbo(:, 2,55,14) = (/ & + & 0.50082e+01_r8,0.72786e+01_r8,0.82608e+01_r8,0.76866e+01_r8,0.62296e+01_r8 /) + kbo(:, 3,55,14) = (/ & + & 0.55372e+01_r8,0.75641e+01_r8,0.84935e+01_r8,0.78502e+01_r8,0.65324e+01_r8 /) + kbo(:, 4,55,14) = (/ & + & 0.60119e+01_r8,0.77891e+01_r8,0.86705e+01_r8,0.79700e+01_r8,0.68094e+01_r8 /) + kbo(:, 5,55,14) = (/ & + & 0.64443e+01_r8,0.79596e+01_r8,0.87874e+01_r8,0.80489e+01_r8,0.70636e+01_r8 /) + kbo(:, 1,56,14) = (/ & + & 0.42552e+01_r8,0.67816e+01_r8,0.78463e+01_r8,0.73861e+01_r8,0.57693e+01_r8 /) + kbo(:, 2,56,14) = (/ & + & 0.48302e+01_r8,0.71710e+01_r8,0.81721e+01_r8,0.76241e+01_r8,0.61259e+01_r8 /) + kbo(:, 3,56,14) = (/ & + & 0.53736e+01_r8,0.74812e+01_r8,0.84261e+01_r8,0.78026e+01_r8,0.64389e+01_r8 /) + kbo(:, 4,56,14) = (/ & + & 0.58648e+01_r8,0.77223e+01_r8,0.86198e+01_r8,0.79361e+01_r8,0.67232e+01_r8 /) + kbo(:, 5,56,14) = (/ & + & 0.63103e+01_r8,0.79105e+01_r8,0.87564e+01_r8,0.80271e+01_r8,0.69853e+01_r8 /) + kbo(:, 1,57,14) = (/ & + & 0.40639e+01_r8,0.66394e+01_r8,0.77238e+01_r8,0.72954e+01_r8,0.56390e+01_r8 /) + kbo(:, 2,57,14) = (/ & + & 0.46488e+01_r8,0.70563e+01_r8,0.80768e+01_r8,0.75544e+01_r8,0.60187e+01_r8 /) + kbo(:, 3,57,14) = (/ & + & 0.52035e+01_r8,0.73909e+01_r8,0.83529e+01_r8,0.77510e+01_r8,0.63425e+01_r8 /) + kbo(:, 4,57,14) = (/ & + & 0.57137e+01_r8,0.76510e+01_r8,0.85638e+01_r8,0.78985e+01_r8,0.66342e+01_r8 /) + kbo(:, 5,57,14) = (/ & + & 0.61722e+01_r8,0.78574e+01_r8,0.87192e+01_r8,0.80023e+01_r8,0.69038e+01_r8 /) + kbo(:, 1,58,14) = (/ & + & 0.38805e+01_r8,0.64976e+01_r8,0.75961e+01_r8,0.72010e+01_r8,0.55107e+01_r8 /) + kbo(:, 2,58,14) = (/ & + & 0.44745e+01_r8,0.69383e+01_r8,0.79787e+01_r8,0.74825e+01_r8,0.59115e+01_r8 /) + kbo(:, 3,58,14) = (/ & + & 0.50386e+01_r8,0.72976e+01_r8,0.82763e+01_r8,0.76973e+01_r8,0.62480e+01_r8 /) + kbo(:, 4,58,14) = (/ & + & 0.55648e+01_r8,0.75780e+01_r8,0.85055e+01_r8,0.78586e+01_r8,0.65486e+01_r8 /) + kbo(:, 5,58,14) = (/ & + & 0.60366e+01_r8,0.78002e+01_r8,0.86790e+01_r8,0.79756e+01_r8,0.68245e+01_r8 /) + kbo(:, 1,59,14) = (/ & + & 0.38057e+01_r8,0.64388e+01_r8,0.75416e+01_r8,0.71615e+01_r8,0.54582e+01_r8 /) + kbo(:, 2,59,14) = (/ & + & 0.44044e+01_r8,0.68893e+01_r8,0.79374e+01_r8,0.74528e+01_r8,0.58671e+01_r8 /) + kbo(:, 3,59,14) = (/ & + & 0.49711e+01_r8,0.72574e+01_r8,0.82432e+01_r8,0.76750e+01_r8,0.62091e+01_r8 /) + kbo(:, 4,59,14) = (/ & + & 0.55038e+01_r8,0.75476e+01_r8,0.84809e+01_r8,0.78415e+01_r8,0.65137e+01_r8 /) + kbo(:, 5,59,14) = (/ & + & 0.59820e+01_r8,0.77764e+01_r8,0.86612e+01_r8,0.79636e+01_r8,0.67922e+01_r8 /) + kbo(:, 1,13,15) = (/ & + & 0.21583e+02_r8,0.16708e+02_r8,0.15578e+02_r8,0.16324e+02_r8,0.21499e+02_r8 /) + kbo(:, 2,13,15) = (/ & + & 0.21596e+02_r8,0.16646e+02_r8,0.15448e+02_r8,0.16116e+02_r8,0.21237e+02_r8 /) + kbo(:, 3,13,15) = (/ & + & 0.21561e+02_r8,0.16562e+02_r8,0.15303e+02_r8,0.15881e+02_r8,0.20975e+02_r8 /) + kbo(:, 4,13,15) = (/ & + & 0.21482e+02_r8,0.16444e+02_r8,0.15131e+02_r8,0.15663e+02_r8,0.20709e+02_r8 /) + kbo(:, 5,13,15) = (/ & + & 0.21360e+02_r8,0.16308e+02_r8,0.14933e+02_r8,0.15443e+02_r8,0.20449e+02_r8 /) + kbo(:, 1,14,15) = (/ & + & 0.23286e+02_r8,0.18105e+02_r8,0.17022e+02_r8,0.17494e+02_r8,0.22811e+02_r8 /) + kbo(:, 2,14,15) = (/ & + & 0.23268e+02_r8,0.18001e+02_r8,0.16845e+02_r8,0.17259e+02_r8,0.22563e+02_r8 /) + kbo(:, 3,14,15) = (/ & + & 0.23185e+02_r8,0.17865e+02_r8,0.16645e+02_r8,0.17010e+02_r8,0.22295e+02_r8 /) + kbo(:, 4,14,15) = (/ & + & 0.23065e+02_r8,0.17707e+02_r8,0.16417e+02_r8,0.16757e+02_r8,0.22015e+02_r8 /) + kbo(:, 5,14,15) = (/ & + & 0.22894e+02_r8,0.17515e+02_r8,0.16163e+02_r8,0.16504e+02_r8,0.21733e+02_r8 /) + kbo(:, 1,15,15) = (/ & + & 0.24991e+02_r8,0.19505e+02_r8,0.18411e+02_r8,0.18638e+02_r8,0.24057e+02_r8 /) + kbo(:, 2,15,15) = (/ & + & 0.24920e+02_r8,0.19349e+02_r8,0.18180e+02_r8,0.18374e+02_r8,0.23810e+02_r8 /) + kbo(:, 3,15,15) = (/ & + & 0.24797e+02_r8,0.19155e+02_r8,0.17917e+02_r8,0.18103e+02_r8,0.23536e+02_r8 /) + kbo(:, 4,15,15) = (/ & + & 0.24619e+02_r8,0.18942e+02_r8,0.17624e+02_r8,0.17814e+02_r8,0.23238e+02_r8 /) + kbo(:, 5,15,15) = (/ & + & 0.24389e+02_r8,0.18694e+02_r8,0.17313e+02_r8,0.17524e+02_r8,0.22925e+02_r8 /) + kbo(:, 1,16,15) = (/ & + & 0.26656e+02_r8,0.20879e+02_r8,0.19716e+02_r8,0.19730e+02_r8,0.25227e+02_r8 /) + kbo(:, 2,16,15) = (/ & + & 0.26523e+02_r8,0.20660e+02_r8,0.19424e+02_r8,0.19442e+02_r8,0.24961e+02_r8 /) + kbo(:, 3,16,15) = (/ & + & 0.26348e+02_r8,0.20405e+02_r8,0.19093e+02_r8,0.19135e+02_r8,0.24671e+02_r8 /) + kbo(:, 4,16,15) = (/ & + & 0.26107e+02_r8,0.20124e+02_r8,0.18741e+02_r8,0.18812e+02_r8,0.24357e+02_r8 /) + kbo(:, 5,16,15) = (/ & + & 0.25816e+02_r8,0.19816e+02_r8,0.18364e+02_r8,0.18476e+02_r8,0.24001e+02_r8 /) + kbo(:, 1,17,15) = (/ & + & 0.28242e+02_r8,0.22184e+02_r8,0.20936e+02_r8,0.20769e+02_r8,0.26307e+02_r8 /) + kbo(:, 2,17,15) = (/ & + & 0.28053e+02_r8,0.21895e+02_r8,0.20570e+02_r8,0.20444e+02_r8,0.26016e+02_r8 /) + kbo(:, 3,17,15) = (/ & + & 0.27803e+02_r8,0.21584e+02_r8,0.20174e+02_r8,0.20096e+02_r8,0.25702e+02_r8 /) + kbo(:, 4,17,15) = (/ & + & 0.27499e+02_r8,0.21233e+02_r8,0.19753e+02_r8,0.19726e+02_r8,0.25351e+02_r8 /) + kbo(:, 5,17,15) = (/ & + & 0.27139e+02_r8,0.20859e+02_r8,0.19319e+02_r8,0.19342e+02_r8,0.24955e+02_r8 /) + kbo(:, 1,18,15) = (/ & + & 0.29720e+02_r8,0.23411e+02_r8,0.22065e+02_r8,0.21731e+02_r8,0.27280e+02_r8 /) + kbo(:, 2,18,15) = (/ & + & 0.29480e+02_r8,0.23053e+02_r8,0.21624e+02_r8,0.21360e+02_r8,0.26972e+02_r8 /) + kbo(:, 3,18,15) = (/ & + & 0.29159e+02_r8,0.22667e+02_r8,0.21156e+02_r8,0.20967e+02_r8,0.26625e+02_r8 /) + kbo(:, 4,18,15) = (/ & + & 0.28776e+02_r8,0.22248e+02_r8,0.20663e+02_r8,0.20553e+02_r8,0.26229e+02_r8 /) + kbo(:, 5,18,15) = (/ & + & 0.28340e+02_r8,0.21810e+02_r8,0.20170e+02_r8,0.20119e+02_r8,0.25790e+02_r8 /) + kbo(:, 1,19,15) = (/ & + & 0.31079e+02_r8,0.24533e+02_r8,0.23084e+02_r8,0.22601e+02_r8,0.28156e+02_r8 /) + kbo(:, 2,19,15) = (/ & + & 0.30766e+02_r8,0.24108e+02_r8,0.22572e+02_r8,0.22185e+02_r8,0.27815e+02_r8 /) + kbo(:, 3,19,15) = (/ & + & 0.30376e+02_r8,0.23641e+02_r8,0.22030e+02_r8,0.21741e+02_r8,0.27429e+02_r8 /) + kbo(:, 4,19,15) = (/ & + & 0.29923e+02_r8,0.23160e+02_r8,0.21471e+02_r8,0.21280e+02_r8,0.26992e+02_r8 /) + kbo(:, 5,19,15) = (/ & + & 0.29415e+02_r8,0.22660e+02_r8,0.20920e+02_r8,0.20797e+02_r8,0.26511e+02_r8 /) + kbo(:, 1,20,15) = (/ & + & 0.32290e+02_r8,0.25527e+02_r8,0.23984e+02_r8,0.23373e+02_r8,0.28918e+02_r8 /) + kbo(:, 2,20,15) = (/ & + & 0.31907e+02_r8,0.25035e+02_r8,0.23397e+02_r8,0.22899e+02_r8,0.28537e+02_r8 /) + kbo(:, 3,20,15) = (/ & + & 0.31450e+02_r8,0.24496e+02_r8,0.22784e+02_r8,0.22408e+02_r8,0.28112e+02_r8 /) + kbo(:, 4,20,15) = (/ & + & 0.30926e+02_r8,0.23946e+02_r8,0.22166e+02_r8,0.21898e+02_r8,0.27628e+02_r8 /) + kbo(:, 5,20,15) = (/ & + & 0.30351e+02_r8,0.23384e+02_r8,0.21559e+02_r8,0.21369e+02_r8,0.27109e+02_r8 /) + kbo(:, 1,21,15) = (/ & + & 0.33354e+02_r8,0.26397e+02_r8,0.24768e+02_r8,0.24040e+02_r8,0.29575e+02_r8 /) + kbo(:, 2,21,15) = (/ & + & 0.32901e+02_r8,0.25842e+02_r8,0.24107e+02_r8,0.23511e+02_r8,0.29153e+02_r8 /) + kbo(:, 3,21,15) = (/ & + & 0.32374e+02_r8,0.25240e+02_r8,0.23426e+02_r8,0.22972e+02_r8,0.28686e+02_r8 /) + kbo(:, 4,21,15) = (/ & + & 0.31781e+02_r8,0.24624e+02_r8,0.22754e+02_r8,0.22416e+02_r8,0.28162e+02_r8 /) + kbo(:, 5,21,15) = (/ & + & 0.31147e+02_r8,0.24003e+02_r8,0.22095e+02_r8,0.21845e+02_r8,0.27608e+02_r8 /) + kbo(:, 1,22,15) = (/ & + & 0.34245e+02_r8,0.27109e+02_r8,0.25388e+02_r8,0.24566e+02_r8,0.30099e+02_r8 /) + kbo(:, 2,22,15) = (/ & + & 0.33719e+02_r8,0.26481e+02_r8,0.24655e+02_r8,0.23987e+02_r8,0.29635e+02_r8 /) + kbo(:, 3,22,15) = (/ & + & 0.33121e+02_r8,0.25821e+02_r8,0.23916e+02_r8,0.23403e+02_r8,0.29124e+02_r8 /) + kbo(:, 4,22,15) = (/ & + & 0.32461e+02_r8,0.25147e+02_r8,0.23196e+02_r8,0.22805e+02_r8,0.28562e+02_r8 /) + kbo(:, 5,22,15) = (/ & + & 0.31774e+02_r8,0.24482e+02_r8,0.22495e+02_r8,0.22197e+02_r8,0.27979e+02_r8 /) + kbo(:, 1,23,15) = (/ & + & 0.34979e+02_r8,0.27686e+02_r8,0.25885e+02_r8,0.24985e+02_r8,0.30523e+02_r8 /) + kbo(:, 2,23,15) = (/ & + & 0.34390e+02_r8,0.26989e+02_r8,0.25088e+02_r8,0.24366e+02_r8,0.30015e+02_r8 /) + kbo(:, 3,23,15) = (/ & + & 0.33724e+02_r8,0.26279e+02_r8,0.24300e+02_r8,0.23742e+02_r8,0.29464e+02_r8 /) + kbo(:, 4,23,15) = (/ & + & 0.33013e+02_r8,0.25562e+02_r8,0.23538e+02_r8,0.23108e+02_r8,0.28875e+02_r8 /) + kbo(:, 5,23,15) = (/ & + & 0.32269e+02_r8,0.24853e+02_r8,0.22796e+02_r8,0.22467e+02_r8,0.28265e+02_r8 /) + kbo(:, 1,24,15) = (/ & + & 0.35573e+02_r8,0.28136e+02_r8,0.26264e+02_r8,0.25305e+02_r8,0.30849e+02_r8 /) + kbo(:, 2,24,15) = (/ & + & 0.34922e+02_r8,0.27387e+02_r8,0.25413e+02_r8,0.24653e+02_r8,0.30308e+02_r8 /) + kbo(:, 3,24,15) = (/ & + & 0.34200e+02_r8,0.26632e+02_r8,0.24587e+02_r8,0.23994e+02_r8,0.29723e+02_r8 /) + kbo(:, 4,24,15) = (/ & + & 0.33439e+02_r8,0.25872e+02_r8,0.23787e+02_r8,0.23329e+02_r8,0.29105e+02_r8 /) + kbo(:, 5,24,15) = (/ & + & 0.32647e+02_r8,0.25128e+02_r8,0.23014e+02_r8,0.22661e+02_r8,0.28477e+02_r8 /) + kbo(:, 1,25,15) = (/ & + & 0.36033e+02_r8,0.28469e+02_r8,0.26533e+02_r8,0.25539e+02_r8,0.31091e+02_r8 /) + kbo(:, 2,25,15) = (/ & + & 0.35324e+02_r8,0.27679e+02_r8,0.25640e+02_r8,0.24852e+02_r8,0.30512e+02_r8 /) + kbo(:, 3,25,15) = (/ & + & 0.34555e+02_r8,0.26887e+02_r8,0.24782e+02_r8,0.24167e+02_r8,0.29902e+02_r8 /) + kbo(:, 4,25,15) = (/ & + & 0.33752e+02_r8,0.26092e+02_r8,0.23953e+02_r8,0.23474e+02_r8,0.29262e+02_r8 /) + kbo(:, 5,25,15) = (/ & + & 0.32915e+02_r8,0.25319e+02_r8,0.23155e+02_r8,0.22787e+02_r8,0.28617e+02_r8 /) + kbo(:, 1,26,15) = (/ & + & 0.36371e+02_r8,0.28696e+02_r8,0.26697e+02_r8,0.25688e+02_r8,0.31254e+02_r8 /) + kbo(:, 2,26,15) = (/ & + & 0.35607e+02_r8,0.27872e+02_r8,0.25775e+02_r8,0.24975e+02_r8,0.30642e+02_r8 /) + kbo(:, 3,26,15) = (/ & + & 0.34798e+02_r8,0.27047e+02_r8,0.24890e+02_r8,0.24264e+02_r8,0.30007e+02_r8 /) + kbo(:, 4,26,15) = (/ & + & 0.33956e+02_r8,0.26227e+02_r8,0.24040e+02_r8,0.23549e+02_r8,0.29351e+02_r8 /) + kbo(:, 5,26,15) = (/ & + & 0.33076e+02_r8,0.25425e+02_r8,0.23222e+02_r8,0.22845e+02_r8,0.28688e+02_r8 /) + kbo(:, 1,27,15) = (/ & + & 0.36605e+02_r8,0.28839e+02_r8,0.26780e+02_r8,0.25770e+02_r8,0.31349e+02_r8 /) + kbo(:, 2,27,15) = (/ & + & 0.35796e+02_r8,0.27987e+02_r8,0.25836e+02_r8,0.25037e+02_r8,0.30713e+02_r8 /) + kbo(:, 3,27,15) = (/ & + & 0.34952e+02_r8,0.27136e+02_r8,0.24934e+02_r8,0.24306e+02_r8,0.30059e+02_r8 /) + kbo(:, 4,27,15) = (/ & + & 0.34075e+02_r8,0.26294e+02_r8,0.24068e+02_r8,0.23575e+02_r8,0.29392e+02_r8 /) + kbo(:, 5,27,15) = (/ & + & 0.33166e+02_r8,0.25473e+02_r8,0.23238e+02_r8,0.22856e+02_r8,0.28711e+02_r8 /) + kbo(:, 1,28,15) = (/ & + & 0.36758e+02_r8,0.28917e+02_r8,0.26804e+02_r8,0.25803e+02_r8,0.31396e+02_r8 /) + kbo(:, 2,28,15) = (/ & + & 0.35910e+02_r8,0.28037e+02_r8,0.25842e+02_r8,0.25051e+02_r8,0.30739e+02_r8 /) + kbo(:, 3,28,15) = (/ & + & 0.35033e+02_r8,0.27165e+02_r8,0.24925e+02_r8,0.24304e+02_r8,0.30070e+02_r8 /) + kbo(:, 4,28,15) = (/ & + & 0.34125e+02_r8,0.26307e+02_r8,0.24049e+02_r8,0.23563e+02_r8,0.29393e+02_r8 /) + kbo(:, 5,28,15) = (/ & + & 0.33188e+02_r8,0.25468e+02_r8,0.23210e+02_r8,0.22829e+02_r8,0.28695e+02_r8 /) + kbo(:, 1,29,15) = (/ & + & 0.36829e+02_r8,0.28926e+02_r8,0.26766e+02_r8,0.25785e+02_r8,0.31393e+02_r8 /) + kbo(:, 2,29,15) = (/ & + & 0.35949e+02_r8,0.28025e+02_r8,0.25792e+02_r8,0.25019e+02_r8,0.30723e+02_r8 /) + kbo(:, 3,29,15) = (/ & + & 0.35045e+02_r8,0.27141e+02_r8,0.24868e+02_r8,0.24260e+02_r8,0.30042e+02_r8 /) + kbo(:, 4,29,15) = (/ & + & 0.34114e+02_r8,0.26272e+02_r8,0.23986e+02_r8,0.23509e+02_r8,0.29353e+02_r8 /) + kbo(:, 5,29,15) = (/ & + & 0.33154e+02_r8,0.25419e+02_r8,0.23142e+02_r8,0.22765e+02_r8,0.28643e+02_r8 /) + kbo(:, 1,30,15) = (/ & + & 0.36836e+02_r8,0.28884e+02_r8,0.26681e+02_r8,0.25729e+02_r8,0.31353e+02_r8 /) + kbo(:, 2,30,15) = (/ & + & 0.35935e+02_r8,0.27972e+02_r8,0.25704e+02_r8,0.24955e+02_r8,0.30675e+02_r8 /) + kbo(:, 3,30,15) = (/ & + & 0.35002e+02_r8,0.27075e+02_r8,0.24775e+02_r8,0.24184e+02_r8,0.29984e+02_r8 /) + kbo(:, 4,30,15) = (/ & + & 0.34050e+02_r8,0.26196e+02_r8,0.23891e+02_r8,0.23427e+02_r8,0.29283e+02_r8 /) + kbo(:, 5,30,15) = (/ & + & 0.33076e+02_r8,0.25337e+02_r8,0.23046e+02_r8,0.22676e+02_r8,0.28566e+02_r8 /) + kbo(:, 1,31,15) = (/ & + & 0.36791e+02_r8,0.28797e+02_r8,0.26557e+02_r8,0.25640e+02_r8,0.31284e+02_r8 /) + kbo(:, 2,31,15) = (/ & + & 0.35869e+02_r8,0.27877e+02_r8,0.25582e+02_r8,0.24857e+02_r8,0.30596e+02_r8 /) + kbo(:, 3,31,15) = (/ & + & 0.34914e+02_r8,0.26971e+02_r8,0.24653e+02_r8,0.24083e+02_r8,0.29901e+02_r8 /) + kbo(:, 4,31,15) = (/ & + & 0.33941e+02_r8,0.26084e+02_r8,0.23767e+02_r8,0.23319e+02_r8,0.29185e+02_r8 /) + kbo(:, 5,31,15) = (/ & + & 0.32958e+02_r8,0.25224e+02_r8,0.22924e+02_r8,0.22563e+02_r8,0.28464e+02_r8 /) + kbo(:, 1,32,15) = (/ & + & 0.36704e+02_r8,0.28676e+02_r8,0.26402e+02_r8,0.25521e+02_r8,0.31186e+02_r8 /) + kbo(:, 2,32,15) = (/ & + & 0.35759e+02_r8,0.27748e+02_r8,0.25429e+02_r8,0.24734e+02_r8,0.30492e+02_r8 /) + kbo(:, 3,32,15) = (/ & + & 0.34789e+02_r8,0.26839e+02_r8,0.24504e+02_r8,0.23956e+02_r8,0.29792e+02_r8 /) + kbo(:, 4,32,15) = (/ & + & 0.33799e+02_r8,0.25947e+02_r8,0.23622e+02_r8,0.23189e+02_r8,0.29067e+02_r8 /) + kbo(:, 5,32,15) = (/ & + & 0.32807e+02_r8,0.25086e+02_r8,0.22780e+02_r8,0.22431e+02_r8,0.28343e+02_r8 /) + kbo(:, 1,33,15) = (/ & + & 0.36581e+02_r8,0.28529e+02_r8,0.26229e+02_r8,0.25386e+02_r8,0.31076e+02_r8 /) + kbo(:, 2,33,15) = (/ & + & 0.35618e+02_r8,0.27597e+02_r8,0.25258e+02_r8,0.24592e+02_r8,0.30373e+02_r8 /) + kbo(:, 3,33,15) = (/ & + & 0.34634e+02_r8,0.26685e+02_r8,0.24337e+02_r8,0.23815e+02_r8,0.29666e+02_r8 /) + kbo(:, 4,33,15) = (/ & + & 0.33632e+02_r8,0.25791e+02_r8,0.23459e+02_r8,0.23042e+02_r8,0.28931e+02_r8 /) + kbo(:, 5,33,15) = (/ & + & 0.32632e+02_r8,0.24931e+02_r8,0.22622e+02_r8,0.22288e+02_r8,0.28210e+02_r8 /) + kbo(:, 1,34,15) = (/ & + & 0.36458e+02_r8,0.28392e+02_r8,0.26072e+02_r8,0.25264e+02_r8,0.30972e+02_r8 /) + kbo(:, 2,34,15) = (/ & + & 0.35483e+02_r8,0.27459e+02_r8,0.25106e+02_r8,0.24467e+02_r8,0.30265e+02_r8 /) + kbo(:, 3,34,15) = (/ & + & 0.34486e+02_r8,0.26542e+02_r8,0.24189e+02_r8,0.23688e+02_r8,0.29550e+02_r8 /) + kbo(:, 4,34,15) = (/ & + & 0.33480e+02_r8,0.25653e+02_r8,0.23315e+02_r8,0.22913e+02_r8,0.28811e+02_r8 /) + kbo(:, 5,34,15) = (/ & + & 0.32478e+02_r8,0.24793e+02_r8,0.22484e+02_r8,0.22163e+02_r8,0.28094e+02_r8 /) + kbo(:, 1,35,15) = (/ & + & 0.36414e+02_r8,0.28334e+02_r8,0.25999e+02_r8,0.25206e+02_r8,0.30923e+02_r8 /) + kbo(:, 2,35,15) = (/ & + & 0.35425e+02_r8,0.27395e+02_r8,0.25033e+02_r8,0.24406e+02_r8,0.30215e+02_r8 /) + kbo(:, 3,35,15) = (/ & + & 0.34420e+02_r8,0.26476e+02_r8,0.24117e+02_r8,0.23624e+02_r8,0.29493e+02_r8 /) + kbo(:, 4,35,15) = (/ & + & 0.33407e+02_r8,0.25585e+02_r8,0.23243e+02_r8,0.22849e+02_r8,0.28753e+02_r8 /) + kbo(:, 5,35,15) = (/ & + & 0.32403e+02_r8,0.24726e+02_r8,0.22415e+02_r8,0.22101e+02_r8,0.28034e+02_r8 /) + kbo(:, 1,36,15) = (/ & + & 0.36456e+02_r8,0.28365e+02_r8,0.26023e+02_r8,0.25227e+02_r8,0.30947e+02_r8 /) + kbo(:, 2,36,15) = (/ & + & 0.35465e+02_r8,0.27424e+02_r8,0.25054e+02_r8,0.24425e+02_r8,0.30235e+02_r8 /) + kbo(:, 3,36,15) = (/ & + & 0.34451e+02_r8,0.26498e+02_r8,0.24134e+02_r8,0.23640e+02_r8,0.29510e+02_r8 /) + kbo(:, 4,36,15) = (/ & + & 0.33436e+02_r8,0.25606e+02_r8,0.23259e+02_r8,0.22862e+02_r8,0.28768e+02_r8 /) + kbo(:, 5,36,15) = (/ & + & 0.32427e+02_r8,0.24743e+02_r8,0.22427e+02_r8,0.22112e+02_r8,0.28048e+02_r8 /) + kbo(:, 1,37,15) = (/ & + & 0.36638e+02_r8,0.28533e+02_r8,0.26191e+02_r8,0.25363e+02_r8,0.31069e+02_r8 /) + kbo(:, 2,37,15) = (/ & + & 0.35645e+02_r8,0.27585e+02_r8,0.25212e+02_r8,0.24557e+02_r8,0.30356e+02_r8 /) + kbo(:, 3,37,15) = (/ & + & 0.34632e+02_r8,0.26655e+02_r8,0.24283e+02_r8,0.23768e+02_r8,0.29633e+02_r8 /) + kbo(:, 4,37,15) = (/ & + & 0.33611e+02_r8,0.25753e+02_r8,0.23398e+02_r8,0.22987e+02_r8,0.28889e+02_r8 /) + kbo(:, 5,37,15) = (/ & + & 0.32597e+02_r8,0.24885e+02_r8,0.22559e+02_r8,0.22230e+02_r8,0.28165e+02_r8 /) + kbo(:, 1,38,15) = (/ & + & 0.36818e+02_r8,0.28702e+02_r8,0.26363e+02_r8,0.25503e+02_r8,0.31194e+02_r8 /) + kbo(:, 2,38,15) = (/ & + & 0.35825e+02_r8,0.27749e+02_r8,0.25373e+02_r8,0.24692e+02_r8,0.30479e+02_r8 /) + kbo(:, 3,38,15) = (/ & + & 0.34809e+02_r8,0.26811e+02_r8,0.24434e+02_r8,0.23900e+02_r8,0.29757e+02_r8 /) + kbo(:, 4,38,15) = (/ & + & 0.33789e+02_r8,0.25904e+02_r8,0.23543e+02_r8,0.23114e+02_r8,0.29012e+02_r8 /) + kbo(:, 5,38,15) = (/ & + & 0.32767e+02_r8,0.25028e+02_r8,0.22694e+02_r8,0.22351e+02_r8,0.28285e+02_r8 /) + kbo(:, 1,39,15) = (/ & + & 0.36989e+02_r8,0.28865e+02_r8,0.26530e+02_r8,0.25636e+02_r8,0.31312e+02_r8 /) + kbo(:, 2,39,15) = (/ & + & 0.35999e+02_r8,0.27907e+02_r8,0.25529e+02_r8,0.24823e+02_r8,0.30597e+02_r8 /) + kbo(:, 3,39,15) = (/ & + & 0.34983e+02_r8,0.26966e+02_r8,0.24583e+02_r8,0.24027e+02_r8,0.29878e+02_r8 /) + kbo(:, 4,39,15) = (/ & + & 0.33957e+02_r8,0.26048e+02_r8,0.23683e+02_r8,0.23240e+02_r8,0.29134e+02_r8 /) + kbo(:, 5,39,15) = (/ & + & 0.32935e+02_r8,0.25169e+02_r8,0.22826e+02_r8,0.22468e+02_r8,0.28398e+02_r8 /) + kbo(:, 1,40,15) = (/ & + & 0.37254e+02_r8,0.29125e+02_r8,0.26800e+02_r8,0.25853e+02_r8,0.31502e+02_r8 /) + kbo(:, 2,40,15) = (/ & + & 0.36269e+02_r8,0.28159e+02_r8,0.25786e+02_r8,0.25036e+02_r8,0.30787e+02_r8 /) + kbo(:, 3,40,15) = (/ & + & 0.35253e+02_r8,0.27211e+02_r8,0.24825e+02_r8,0.24233e+02_r8,0.30069e+02_r8 /) + kbo(:, 4,40,15) = (/ & + & 0.34229e+02_r8,0.26287e+02_r8,0.23913e+02_r8,0.23442e+02_r8,0.29327e+02_r8 /) + kbo(:, 5,40,15) = (/ & + & 0.33202e+02_r8,0.25396e+02_r8,0.23042e+02_r8,0.22665e+02_r8,0.28587e+02_r8 /) + kbo(:, 1,41,15) = (/ & + & 0.37526e+02_r8,0.29396e+02_r8,0.27087e+02_r8,0.26081e+02_r8,0.31701e+02_r8 /) + kbo(:, 2,41,15) = (/ & + & 0.36546e+02_r8,0.28422e+02_r8,0.26056e+02_r8,0.25257e+02_r8,0.30982e+02_r8 /) + kbo(:, 3,41,15) = (/ & + & 0.35534e+02_r8,0.27467e+02_r8,0.25079e+02_r8,0.24448e+02_r8,0.30265e+02_r8 /) + kbo(:, 4,41,15) = (/ & + & 0.34510e+02_r8,0.26534e+02_r8,0.24153e+02_r8,0.23654e+02_r8,0.29528e+02_r8 /) + kbo(:, 5,41,15) = (/ & + & 0.33481e+02_r8,0.25633e+02_r8,0.23271e+02_r8,0.22872e+02_r8,0.28783e+02_r8 /) + kbo(:, 1,42,15) = (/ & + & 0.37791e+02_r8,0.29665e+02_r8,0.27375e+02_r8,0.26306e+02_r8,0.31897e+02_r8 /) + kbo(:, 2,42,15) = (/ & + & 0.36818e+02_r8,0.28682e+02_r8,0.26328e+02_r8,0.25479e+02_r8,0.31179e+02_r8 /) + kbo(:, 3,42,15) = (/ & + & 0.35814e+02_r8,0.27725e+02_r8,0.25336e+02_r8,0.24663e+02_r8,0.30459e+02_r8 /) + kbo(:, 4,42,15) = (/ & + & 0.34792e+02_r8,0.26784e+02_r8,0.24397e+02_r8,0.23867e+02_r8,0.29730e+02_r8 /) + kbo(:, 5,42,15) = (/ & + & 0.33761e+02_r8,0.25873e+02_r8,0.23504e+02_r8,0.23079e+02_r8,0.28983e+02_r8 /) + kbo(:, 1,43,15) = (/ & + & 0.38102e+02_r8,0.29987e+02_r8,0.27726e+02_r8,0.26579e+02_r8,0.32132e+02_r8 /) + kbo(:, 2,43,15) = (/ & + & 0.37142e+02_r8,0.29000e+02_r8,0.26660e+02_r8,0.25743e+02_r8,0.31410e+02_r8 /) + kbo(:, 3,43,15) = (/ & + & 0.36146e+02_r8,0.28034e+02_r8,0.25651e+02_r8,0.24927e+02_r8,0.30694e+02_r8 /) + kbo(:, 4,43,15) = (/ & + & 0.35125e+02_r8,0.27087e+02_r8,0.24694e+02_r8,0.24121e+02_r8,0.29968e+02_r8 /) + kbo(:, 5,43,15) = (/ & + & 0.34093e+02_r8,0.26161e+02_r8,0.23786e+02_r8,0.23330e+02_r8,0.29223e+02_r8 /) + kbo(:, 1,44,15) = (/ & + & 0.38433e+02_r8,0.30339e+02_r8,0.28106e+02_r8,0.26874e+02_r8,0.32381e+02_r8 /) + kbo(:, 2,44,15) = (/ & + & 0.37485e+02_r8,0.29344e+02_r8,0.27023e+02_r8,0.26033e+02_r8,0.31664e+02_r8 /) + kbo(:, 3,44,15) = (/ & + & 0.36497e+02_r8,0.28368e+02_r8,0.25996e+02_r8,0.25211e+02_r8,0.30945e+02_r8 /) + kbo(:, 4,44,15) = (/ & + & 0.35483e+02_r8,0.27414e+02_r8,0.25019e+02_r8,0.24397e+02_r8,0.30221e+02_r8 /) + kbo(:, 5,44,15) = (/ & + & 0.34454e+02_r8,0.26480e+02_r8,0.24095e+02_r8,0.23603e+02_r8,0.29482e+02_r8 /) + kbo(:, 1,45,15) = (/ & + & 0.38755e+02_r8,0.30690e+02_r8,0.28491e+02_r8,0.27169e+02_r8,0.32624e+02_r8 /) + kbo(:, 2,45,15) = (/ & + & 0.37819e+02_r8,0.29686e+02_r8,0.27393e+02_r8,0.26324e+02_r8,0.31916e+02_r8 /) + kbo(:, 3,45,15) = (/ & + & 0.36842e+02_r8,0.28700e+02_r8,0.26343e+02_r8,0.25494e+02_r8,0.31195e+02_r8 /) + kbo(:, 4,45,15) = (/ & + & 0.35840e+02_r8,0.27743e+02_r8,0.25350e+02_r8,0.24674e+02_r8,0.30470e+02_r8 /) + kbo(:, 5,45,15) = (/ & + & 0.34814e+02_r8,0.26800e+02_r8,0.24408e+02_r8,0.23874e+02_r8,0.29739e+02_r8 /) + kbo(:, 1,46,15) = (/ & + & 0.39090e+02_r8,0.31065e+02_r8,0.28908e+02_r8,0.27486e+02_r8,0.32877e+02_r8 /) + kbo(:, 2,46,15) = (/ & + & 0.38170e+02_r8,0.30050e+02_r8,0.27790e+02_r8,0.26631e+02_r8,0.32180e+02_r8 /) + kbo(:, 3,46,15) = (/ & + & 0.37208e+02_r8,0.29060e+02_r8,0.26719e+02_r8,0.25793e+02_r8,0.31457e+02_r8 /) + kbo(:, 4,46,15) = (/ & + & 0.36211e+02_r8,0.28091e+02_r8,0.25705e+02_r8,0.24972e+02_r8,0.30735e+02_r8 /) + kbo(:, 5,46,15) = (/ & + & 0.35190e+02_r8,0.27143e+02_r8,0.24746e+02_r8,0.24165e+02_r8,0.30011e+02_r8 /) + kbo(:, 1,47,15) = (/ & + & 0.39451e+02_r8,0.31490e+02_r8,0.29378e+02_r8,0.27842e+02_r8,0.33145e+02_r8 /) + kbo(:, 2,47,15) = (/ & + & 0.38554e+02_r8,0.30463e+02_r8,0.28238e+02_r8,0.26977e+02_r8,0.32470e+02_r8 /) + kbo(:, 3,47,15) = (/ & + & 0.37608e+02_r8,0.29464e+02_r8,0.27149e+02_r8,0.26134e+02_r8,0.31753e+02_r8 /) + kbo(:, 4,47,15) = (/ & + & 0.36624e+02_r8,0.28485e+02_r8,0.26114e+02_r8,0.25307e+02_r8,0.31030e+02_r8 /) + kbo(:, 5,47,15) = (/ & + & 0.35612e+02_r8,0.27529e+02_r8,0.25131e+02_r8,0.24491e+02_r8,0.30307e+02_r8 /) + kbo(:, 1,48,15) = (/ & + & 0.39789e+02_r8,0.31912e+02_r8,0.29855e+02_r8,0.28207e+02_r8,0.33402e+02_r8 /) + kbo(:, 2,48,15) = (/ & + & 0.38929e+02_r8,0.30877e+02_r8,0.28697e+02_r8,0.27328e+02_r8,0.32755e+02_r8 /) + kbo(:, 3,48,15) = (/ & + & 0.38000e+02_r8,0.29868e+02_r8,0.27588e+02_r8,0.26477e+02_r8,0.32050e+02_r8 /) + kbo(:, 4,48,15) = (/ & + & 0.37030e+02_r8,0.28879e+02_r8,0.26527e+02_r8,0.25639e+02_r8,0.31322e+02_r8 /) + kbo(:, 5,48,15) = (/ & + & 0.36027e+02_r8,0.27916e+02_r8,0.25523e+02_r8,0.24819e+02_r8,0.30601e+02_r8 /) + kbo(:, 1,49,15) = (/ & + & 0.40116e+02_r8,0.32336e+02_r8,0.30332e+02_r8,0.28574e+02_r8,0.33637e+02_r8 /) + kbo(:, 2,49,15) = (/ & + & 0.39295e+02_r8,0.31299e+02_r8,0.29164e+02_r8,0.27682e+02_r8,0.33028e+02_r8 /) + kbo(:, 3,49,15) = (/ & + & 0.38385e+02_r8,0.30275e+02_r8,0.28033e+02_r8,0.26821e+02_r8,0.32341e+02_r8 /) + kbo(:, 4,49,15) = (/ & + & 0.37432e+02_r8,0.29281e+02_r8,0.26949e+02_r8,0.25975e+02_r8,0.31615e+02_r8 /) + kbo(:, 5,49,15) = (/ & + & 0.36440e+02_r8,0.28306e+02_r8,0.25923e+02_r8,0.25151e+02_r8,0.30893e+02_r8 /) + kbo(:, 1,50,15) = (/ & + & 0.40414e+02_r8,0.32736e+02_r8,0.30783e+02_r8,0.28924e+02_r8,0.33845e+02_r8 /) + kbo(:, 2,50,15) = (/ & + & 0.39619e+02_r8,0.31694e+02_r8,0.29608e+02_r8,0.28020e+02_r8,0.33276e+02_r8 /) + kbo(:, 3,50,15) = (/ & + & 0.38737e+02_r8,0.30661e+02_r8,0.28456e+02_r8,0.27146e+02_r8,0.32609e+02_r8 /) + kbo(:, 4,50,15) = (/ & + & 0.37800e+02_r8,0.29658e+02_r8,0.27356e+02_r8,0.26296e+02_r8,0.31894e+02_r8 /) + kbo(:, 5,50,15) = (/ & + & 0.36822e+02_r8,0.28673e+02_r8,0.26306e+02_r8,0.25463e+02_r8,0.31168e+02_r8 /) + kbo(:, 1,51,15) = (/ & + & 0.40689e+02_r8,0.33123e+02_r8,0.31211e+02_r8,0.29252e+02_r8,0.34023e+02_r8 /) + kbo(:, 2,51,15) = (/ & + & 0.39919e+02_r8,0.32076e+02_r8,0.30039e+02_r8,0.28350e+02_r8,0.33499e+02_r8 /) + kbo(:, 3,51,15) = (/ & + & 0.39075e+02_r8,0.31039e+02_r8,0.28875e+02_r8,0.27462e+02_r8,0.32860e+02_r8 /) + kbo(:, 4,51,15) = (/ & + & 0.38151e+02_r8,0.30023e+02_r8,0.27755e+02_r8,0.26605e+02_r8,0.32160e+02_r8 /) + kbo(:, 5,51,15) = (/ & + & 0.37189e+02_r8,0.29033e+02_r8,0.26685e+02_r8,0.25765e+02_r8,0.31432e+02_r8 /) + kbo(:, 1,52,15) = (/ & + & 0.40936e+02_r8,0.33510e+02_r8,0.31640e+02_r8,0.29576e+02_r8,0.34183e+02_r8 /) + kbo(:, 2,52,15) = (/ & + & 0.40210e+02_r8,0.32459e+02_r8,0.30471e+02_r8,0.28683e+02_r8,0.33706e+02_r8 /) + kbo(:, 3,52,15) = (/ & + & 0.39397e+02_r8,0.31418e+02_r8,0.29296e+02_r8,0.27784e+02_r8,0.33107e+02_r8 /) + kbo(:, 4,52,15) = (/ & + & 0.38495e+02_r8,0.30394e+02_r8,0.28160e+02_r8,0.26919e+02_r8,0.32422e+02_r8 /) + kbo(:, 5,52,15) = (/ & + & 0.37548e+02_r8,0.29397e+02_r8,0.27070e+02_r8,0.26070e+02_r8,0.31697e+02_r8 /) + kbo(:, 1,53,15) = (/ & + & 0.41161e+02_r8,0.33900e+02_r8,0.32075e+02_r8,0.29895e+02_r8,0.34325e+02_r8 /) + kbo(:, 2,53,15) = (/ & + & 0.40494e+02_r8,0.32844e+02_r8,0.30901e+02_r8,0.29015e+02_r8,0.33898e+02_r8 /) + kbo(:, 3,53,15) = (/ & + & 0.39709e+02_r8,0.31802e+02_r8,0.29726e+02_r8,0.28110e+02_r8,0.33339e+02_r8 /) + kbo(:, 4,53,15) = (/ & + & 0.38833e+02_r8,0.30766e+02_r8,0.28570e+02_r8,0.27234e+02_r8,0.32680e+02_r8 /) + kbo(:, 5,53,15) = (/ & + & 0.37902e+02_r8,0.29761e+02_r8,0.27465e+02_r8,0.26380e+02_r8,0.31966e+02_r8 /) + kbo(:, 1,54,15) = (/ & + & 0.41350e+02_r8,0.34259e+02_r8,0.32468e+02_r8,0.30182e+02_r8,0.34433e+02_r8 /) + kbo(:, 2,54,15) = (/ & + & 0.40740e+02_r8,0.33197e+02_r8,0.31292e+02_r8,0.29316e+02_r8,0.34057e+02_r8 /) + kbo(:, 3,54,15) = (/ & + & 0.39978e+02_r8,0.32149e+02_r8,0.30122e+02_r8,0.28414e+02_r8,0.33542e+02_r8 /) + kbo(:, 4,54,15) = (/ & + & 0.39139e+02_r8,0.31111e+02_r8,0.28955e+02_r8,0.27524e+02_r8,0.32911e+02_r8 /) + kbo(:, 5,54,15) = (/ & + & 0.38222e+02_r8,0.30095e+02_r8,0.27832e+02_r8,0.26664e+02_r8,0.32209e+02_r8 /) + kbo(:, 1,55,15) = (/ & + & 0.41508e+02_r8,0.34608e+02_r8,0.32849e+02_r8,0.30454e+02_r8,0.34522e+02_r8 /) + kbo(:, 2,55,15) = (/ & + & 0.40955e+02_r8,0.33539e+02_r8,0.31671e+02_r8,0.29598e+02_r8,0.34194e+02_r8 /) + kbo(:, 3,55,15) = (/ & + & 0.40232e+02_r8,0.32485e+02_r8,0.30501e+02_r8,0.28707e+02_r8,0.33722e+02_r8 /) + kbo(:, 4,55,15) = (/ & + & 0.39425e+02_r8,0.31448e+02_r8,0.29326e+02_r8,0.27805e+02_r8,0.33122e+02_r8 /) + kbo(:, 5,55,15) = (/ & + & 0.38521e+02_r8,0.30419e+02_r8,0.28187e+02_r8,0.26941e+02_r8,0.32441e+02_r8 /) + kbo(:, 1,56,15) = (/ & + & 0.41645e+02_r8,0.34957e+02_r8,0.33233e+02_r8,0.30720e+02_r8,0.34599e+02_r8 /) + kbo(:, 2,56,15) = (/ & + & 0.41152e+02_r8,0.33880e+02_r8,0.32050e+02_r8,0.29874e+02_r8,0.34316e+02_r8 /) + kbo(:, 3,56,15) = (/ & + & 0.40482e+02_r8,0.32823e+02_r8,0.30877e+02_r8,0.28999e+02_r8,0.33890e+02_r8 /) + kbo(:, 4,56,15) = (/ & + & 0.39696e+02_r8,0.31783e+02_r8,0.29704e+02_r8,0.28093e+02_r8,0.33329e+02_r8 /) + kbo(:, 5,56,15) = (/ & + & 0.38819e+02_r8,0.30747e+02_r8,0.28547e+02_r8,0.27216e+02_r8,0.32666e+02_r8 /) + kbo(:, 1,57,15) = (/ & + & 0.41772e+02_r8,0.35313e+02_r8,0.33621e+02_r8,0.30980e+02_r8,0.34653e+02_r8 /) + kbo(:, 2,57,15) = (/ & + & 0.41335e+02_r8,0.34223e+02_r8,0.32428e+02_r8,0.30152e+02_r8,0.34423e+02_r8 /) + kbo(:, 3,57,15) = (/ & + & 0.40717e+02_r8,0.33158e+02_r8,0.31249e+02_r8,0.29283e+02_r8,0.34041e+02_r8 /) + kbo(:, 4,57,15) = (/ & + & 0.39952e+02_r8,0.32113e+02_r8,0.30080e+02_r8,0.28382e+02_r8,0.33523e+02_r8 /) + kbo(:, 5,57,15) = (/ & + & 0.39110e+02_r8,0.31075e+02_r8,0.28913e+02_r8,0.27492e+02_r8,0.32886e+02_r8 /) + kbo(:, 1,58,15) = (/ & + & 0.41872e+02_r8,0.35648e+02_r8,0.33990e+02_r8,0.31215e+02_r8,0.34668e+02_r8 /) + kbo(:, 2,58,15) = (/ & + & 0.41486e+02_r8,0.34551e+02_r8,0.32786e+02_r8,0.30408e+02_r8,0.34507e+02_r8 /) + kbo(:, 3,58,15) = (/ & + & 0.40923e+02_r8,0.33481e+02_r8,0.31606e+02_r8,0.29553e+02_r8,0.34175e+02_r8 /) + kbo(:, 4,58,15) = (/ & + & 0.40193e+02_r8,0.32431e+02_r8,0.30438e+02_r8,0.28657e+02_r8,0.33692e+02_r8 /) + kbo(:, 5,58,15) = (/ & + & 0.39381e+02_r8,0.31393e+02_r8,0.29263e+02_r8,0.27758e+02_r8,0.33088e+02_r8 /) + kbo(:, 1,59,15) = (/ & + & 0.41905e+02_r8,0.35780e+02_r8,0.34140e+02_r8,0.31306e+02_r8,0.34668e+02_r8 /) + kbo(:, 2,59,15) = (/ & + & 0.41541e+02_r8,0.34683e+02_r8,0.32931e+02_r8,0.30509e+02_r8,0.34539e+02_r8 /) + kbo(:, 3,59,15) = (/ & + & 0.41000e+02_r8,0.33610e+02_r8,0.31751e+02_r8,0.29658e+02_r8,0.34225e+02_r8 /) + kbo(:, 4,59,15) = (/ & + & 0.40289e+02_r8,0.32559e+02_r8,0.30582e+02_r8,0.28769e+02_r8,0.33760e+02_r8 /) + kbo(:, 5,59,15) = (/ & + & 0.39484e+02_r8,0.31518e+02_r8,0.29405e+02_r8,0.27867e+02_r8,0.33169e+02_r8 /) + kbo(:, 1,13,16) = (/ & + & 0.44218e+02_r8,0.33168e+02_r8,0.27605e+02_r8,0.40761e+02_r8,0.54348e+02_r8 /) + kbo(:, 2,13,16) = (/ & + & 0.43915e+02_r8,0.32941e+02_r8,0.26738e+02_r8,0.39342e+02_r8,0.52457e+02_r8 /) + kbo(:, 3,13,16) = (/ & + & 0.43491e+02_r8,0.32624e+02_r8,0.25861e+02_r8,0.38022e+02_r8,0.50696e+02_r8 /) + kbo(:, 4,13,16) = (/ & + & 0.42952e+02_r8,0.32220e+02_r8,0.25010e+02_r8,0.36713e+02_r8,0.48951e+02_r8 /) + kbo(:, 5,13,16) = (/ & + & 0.42305e+02_r8,0.31735e+02_r8,0.24184e+02_r8,0.35417e+02_r8,0.47222e+02_r8 /) + kbo(:, 1,14,16) = (/ & + & 0.50640e+02_r8,0.37984e+02_r8,0.31138e+02_r8,0.45571e+02_r8,0.60761e+02_r8 /) + kbo(:, 2,14,16) = (/ & + & 0.50072e+02_r8,0.37558e+02_r8,0.30053e+02_r8,0.43809e+02_r8,0.58413e+02_r8 /) + kbo(:, 3,14,16) = (/ & + & 0.49384e+02_r8,0.37043e+02_r8,0.28981e+02_r8,0.42162e+02_r8,0.56216e+02_r8 /) + kbo(:, 4,14,16) = (/ & + & 0.48531e+02_r8,0.36404e+02_r8,0.27924e+02_r8,0.40555e+02_r8,0.54074e+02_r8 /) + kbo(:, 5,14,16) = (/ & + & 0.47588e+02_r8,0.35696e+02_r8,0.26896e+02_r8,0.38961e+02_r8,0.51948e+02_r8 /) + kbo(:, 1,15,16) = (/ & + & 0.57280e+02_r8,0.42964e+02_r8,0.34740e+02_r8,0.50323e+02_r8,0.67098e+02_r8 /) + kbo(:, 2,15,16) = (/ & + & 0.56367e+02_r8,0.42280e+02_r8,0.33407e+02_r8,0.48191e+02_r8,0.64255e+02_r8 /) + kbo(:, 3,15,16) = (/ & + & 0.55318e+02_r8,0.41493e+02_r8,0.32092e+02_r8,0.46141e+02_r8,0.61520e+02_r8 /) + kbo(:, 4,15,16) = (/ & + & 0.54108e+02_r8,0.40586e+02_r8,0.30808e+02_r8,0.44198e+02_r8,0.58930e+02_r8 /) + kbo(:, 5,15,16) = (/ & + & 0.52826e+02_r8,0.39625e+02_r8,0.29570e+02_r8,0.42303e+02_r8,0.56404e+02_r8 /) + kbo(:, 1,16,16) = (/ & + & 0.63967e+02_r8,0.47979e+02_r8,0.38312e+02_r8,0.54909e+02_r8,0.73213e+02_r8 /) + kbo(:, 2,16,16) = (/ & + & 0.62626e+02_r8,0.46973e+02_r8,0.36695e+02_r8,0.52345e+02_r8,0.69794e+02_r8 /) + kbo(:, 3,16,16) = (/ & + & 0.61112e+02_r8,0.45838e+02_r8,0.35123e+02_r8,0.49904e+02_r8,0.66539e+02_r8 /) + kbo(:, 4,16,16) = (/ & + & 0.59503e+02_r8,0.44632e+02_r8,0.33592e+02_r8,0.47568e+02_r8,0.63425e+02_r8 /) + kbo(:, 5,16,16) = (/ & + & 0.57855e+02_r8,0.43396e+02_r8,0.32125e+02_r8,0.45372e+02_r8,0.60497e+02_r8 /) + kbo(:, 1,17,16) = (/ & + & 0.70540e+02_r8,0.52908e+02_r8,0.41791e+02_r8,0.59184e+02_r8,0.78912e+02_r8 /) + kbo(:, 2,17,16) = (/ & + & 0.68668e+02_r8,0.51504e+02_r8,0.39850e+02_r8,0.56189e+02_r8,0.74919e+02_r8 /) + kbo(:, 3,17,16) = (/ & + & 0.66662e+02_r8,0.50000e+02_r8,0.37983e+02_r8,0.53339e+02_r8,0.71119e+02_r8 /) + kbo(:, 4,17,16) = (/ & + & 0.64633e+02_r8,0.48479e+02_r8,0.36199e+02_r8,0.50655e+02_r8,0.67541e+02_r8 /) + kbo(:, 5,17,16) = (/ & + & 0.62569e+02_r8,0.46932e+02_r8,0.34500e+02_r8,0.48144e+02_r8,0.64192e+02_r8 /) + kbo(:, 1,18,16) = (/ & + & 0.76762e+02_r8,0.57574e+02_r8,0.45062e+02_r8,0.63079e+02_r8,0.84105e+02_r8 /) + kbo(:, 2,18,16) = (/ & + & 0.74320e+02_r8,0.55743e+02_r8,0.42789e+02_r8,0.59653e+02_r8,0.79537e+02_r8 /) + kbo(:, 3,18,16) = (/ & + & 0.71820e+02_r8,0.53869e+02_r8,0.40630e+02_r8,0.56414e+02_r8,0.75219e+02_r8 /) + kbo(:, 4,18,16) = (/ & + & 0.69367e+02_r8,0.52029e+02_r8,0.38584e+02_r8,0.53391e+02_r8,0.71188e+02_r8 /) + kbo(:, 5,18,16) = (/ & + & 0.66895e+02_r8,0.50176e+02_r8,0.36663e+02_r8,0.50596e+02_r8,0.67461e+02_r8 /) + kbo(:, 1,19,16) = (/ & + & 0.82534e+02_r8,0.61903e+02_r8,0.48066e+02_r8,0.66533e+02_r8,0.88711e+02_r8 /) + kbo(:, 2,19,16) = (/ & + & 0.79500e+02_r8,0.59627e+02_r8,0.45463e+02_r8,0.62698e+02_r8,0.83597e+02_r8 /) + kbo(:, 3,19,16) = (/ & + & 0.76531e+02_r8,0.57402e+02_r8,0.43003e+02_r8,0.59107e+02_r8,0.78810e+02_r8 /) + kbo(:, 4,19,16) = (/ & + & 0.73621e+02_r8,0.55219e+02_r8,0.40714e+02_r8,0.55776e+02_r8,0.74368e+02_r8 /) + kbo(:, 5,19,16) = (/ & + & 0.70758e+02_r8,0.53072e+02_r8,0.38580e+02_r8,0.52720e+02_r8,0.70294e+02_r8 /) + kbo(:, 1,20,16) = (/ & + & 0.87685e+02_r8,0.65766e+02_r8,0.50694e+02_r8,0.69445e+02_r8,0.92594e+02_r8 /) + kbo(:, 2,20,16) = (/ & + & 0.84090e+02_r8,0.63070e+02_r8,0.47778e+02_r8,0.65259e+02_r8,0.87012e+02_r8 /) + kbo(:, 3,20,16) = (/ & + & 0.80661e+02_r8,0.60499e+02_r8,0.45053e+02_r8,0.61350e+02_r8,0.81800e+02_r8 /) + kbo(:, 4,20,16) = (/ & + & 0.77340e+02_r8,0.58008e+02_r8,0.42537e+02_r8,0.57756e+02_r8,0.77009e+02_r8 /) + kbo(:, 5,20,16) = (/ & + & 0.74079e+02_r8,0.55564e+02_r8,0.40201e+02_r8,0.54475e+02_r8,0.72633e+02_r8 /) + kbo(:, 1,21,16) = (/ & + & 0.92165e+02_r8,0.69126e+02_r8,0.52960e+02_r8,0.71872e+02_r8,0.95829e+02_r8 /) + kbo(:, 2,21,16) = (/ & + & 0.88084e+02_r8,0.66065e+02_r8,0.49750e+02_r8,0.67363e+02_r8,0.89818e+02_r8 /) + kbo(:, 3,21,16) = (/ & + & 0.84210e+02_r8,0.63159e+02_r8,0.46796e+02_r8,0.63194e+02_r8,0.84259e+02_r8 /) + kbo(:, 4,21,16) = (/ & + & 0.80508e+02_r8,0.60384e+02_r8,0.44071e+02_r8,0.59388e+02_r8,0.79185e+02_r8 /) + kbo(:, 5,21,16) = (/ & + & 0.76889e+02_r8,0.57670e+02_r8,0.41555e+02_r8,0.55904e+02_r8,0.74538e+02_r8 /) + kbo(:, 1,22,16) = (/ & + & 0.95696e+02_r8,0.71774e+02_r8,0.54631e+02_r8,0.73526e+02_r8,0.98034e+02_r8 /) + kbo(:, 2,22,16) = (/ & + & 0.91190e+02_r8,0.68395e+02_r8,0.51188e+02_r8,0.68768e+02_r8,0.91690e+02_r8 /) + kbo(:, 3,22,16) = (/ & + & 0.86939e+02_r8,0.65206e+02_r8,0.48040e+02_r8,0.64409e+02_r8,0.85879e+02_r8 /) + kbo(:, 4,22,16) = (/ & + & 0.82890e+02_r8,0.62171e+02_r8,0.45151e+02_r8,0.60441e+02_r8,0.80589e+02_r8 /) + kbo(:, 5,22,16) = (/ & + & 0.78983e+02_r8,0.59241e+02_r8,0.42494e+02_r8,0.56811e+02_r8,0.75748e+02_r8 /) + kbo(:, 1,23,16) = (/ & + & 0.98505e+02_r8,0.73881e+02_r8,0.55897e+02_r8,0.74690e+02_r8,0.99587e+02_r8 /) + kbo(:, 2,23,16) = (/ & + & 0.93651e+02_r8,0.70240e+02_r8,0.52277e+02_r8,0.69755e+02_r8,0.93007e+02_r8 /) + kbo(:, 3,23,16) = (/ & + & 0.89065e+02_r8,0.66801e+02_r8,0.48963e+02_r8,0.65256e+02_r8,0.87008e+02_r8 /) + kbo(:, 4,23,16) = (/ & + & 0.84725e+02_r8,0.63546e+02_r8,0.45949e+02_r8,0.61155e+02_r8,0.81540e+02_r8 /) + kbo(:, 5,23,16) = (/ & + & 0.80582e+02_r8,0.60440e+02_r8,0.43182e+02_r8,0.57417e+02_r8,0.76556e+02_r8 /) + kbo(:, 1,24,16) = (/ & + & 0.10064e+03_r8,0.75484e+02_r8,0.56783e+02_r8,0.75422e+02_r8,0.10056e+03_r8 /) + kbo(:, 2,24,16) = (/ & + & 0.95486e+02_r8,0.71616e+02_r8,0.53021e+02_r8,0.70355e+02_r8,0.93807e+02_r8 /) + kbo(:, 3,24,16) = (/ & + & 0.90630e+02_r8,0.67975e+02_r8,0.49592e+02_r8,0.65751e+02_r8,0.87668e+02_r8 /) + kbo(:, 4,24,16) = (/ & + & 0.86059e+02_r8,0.64548e+02_r8,0.46483e+02_r8,0.61565e+02_r8,0.82086e+02_r8 /) + kbo(:, 5,24,16) = (/ & + & 0.81718e+02_r8,0.61292e+02_r8,0.43631e+02_r8,0.57753e+02_r8,0.77003e+02_r8 /) + kbo(:, 1,25,16) = (/ & + & 0.10215e+03_r8,0.76618e+02_r8,0.57324e+02_r8,0.75759e+02_r8,0.10101e+03_r8 /) + kbo(:, 2,25,16) = (/ & + & 0.96743e+02_r8,0.72560e+02_r8,0.53446e+02_r8,0.70607e+02_r8,0.94143e+02_r8 /) + kbo(:, 3,25,16) = (/ & + & 0.91681e+02_r8,0.68763e+02_r8,0.49955e+02_r8,0.65940e+02_r8,0.87921e+02_r8 /) + kbo(:, 4,25,16) = (/ & + & 0.86919e+02_r8,0.65192e+02_r8,0.46773e+02_r8,0.61703e+02_r8,0.82270e+02_r8 /) + kbo(:, 5,25,16) = (/ & + & 0.82440e+02_r8,0.61834e+02_r8,0.43873e+02_r8,0.57842e+02_r8,0.77123e+02_r8 /) + kbo(:, 1,26,16) = (/ & + & 0.10303e+03_r8,0.77274e+02_r8,0.57519e+02_r8,0.75701e+02_r8,0.10093e+03_r8 /) + kbo(:, 2,26,16) = (/ & + & 0.97444e+02_r8,0.73085e+02_r8,0.53575e+02_r8,0.70525e+02_r8,0.94033e+02_r8 /) + kbo(:, 3,26,16) = (/ & + & 0.92222e+02_r8,0.69170e+02_r8,0.50048e+02_r8,0.65828e+02_r8,0.87771e+02_r8 /) + kbo(:, 4,26,16) = (/ & + & 0.87336e+02_r8,0.65505e+02_r8,0.46824e+02_r8,0.61566e+02_r8,0.82088e+02_r8 /) + kbo(:, 5,26,16) = (/ & + & 0.82771e+02_r8,0.62082e+02_r8,0.43909e+02_r8,0.57710e+02_r8,0.76947e+02_r8 /) + kbo(:, 1,27,16) = (/ & + & 0.10345e+03_r8,0.77590e+02_r8,0.57467e+02_r8,0.75392e+02_r8,0.10052e+03_r8 /) + kbo(:, 2,27,16) = (/ & + & 0.97739e+02_r8,0.73306e+02_r8,0.53511e+02_r8,0.70214e+02_r8,0.93619e+02_r8 /) + kbo(:, 3,27,16) = (/ & + & 0.92406e+02_r8,0.69307e+02_r8,0.49956e+02_r8,0.65525e+02_r8,0.87366e+02_r8 /) + kbo(:, 4,27,16) = (/ & + & 0.87439e+02_r8,0.65583e+02_r8,0.46715e+02_r8,0.61255e+02_r8,0.81674e+02_r8 /) + kbo(:, 5,27,16) = (/ & + & 0.82826e+02_r8,0.62123e+02_r8,0.43807e+02_r8,0.57432e+02_r8,0.76576e+02_r8 /) + kbo(:, 1,28,16) = (/ & + & 0.10350e+03_r8,0.77625e+02_r8,0.57222e+02_r8,0.74881e+02_r8,0.99841e+02_r8 /) + kbo(:, 2,28,16) = (/ & + & 0.97691e+02_r8,0.73271e+02_r8,0.53275e+02_r8,0.69730e+02_r8,0.92974e+02_r8 /) + kbo(:, 3,28,16) = (/ & + & 0.92289e+02_r8,0.69219e+02_r8,0.49719e+02_r8,0.65057e+02_r8,0.86743e+02_r8 /) + kbo(:, 4,28,16) = (/ & + & 0.87284e+02_r8,0.65466e+02_r8,0.46485e+02_r8,0.60817e+02_r8,0.81090e+02_r8 /) + kbo(:, 5,28,16) = (/ & + & 0.82640e+02_r8,0.61984e+02_r8,0.43588e+02_r8,0.57042e+02_r8,0.76055e+02_r8 /) + kbo(:, 1,29,16) = (/ & + & 0.10319e+03_r8,0.77394e+02_r8,0.56799e+02_r8,0.74179e+02_r8,0.98906e+02_r8 /) + kbo(:, 2,29,16) = (/ & + & 0.97340e+02_r8,0.73008e+02_r8,0.52885e+02_r8,0.69064e+02_r8,0.92086e+02_r8 /) + kbo(:, 3,29,16) = (/ & + & 0.91909e+02_r8,0.68935e+02_r8,0.49342e+02_r8,0.64439e+02_r8,0.85918e+02_r8 /) + kbo(:, 4,29,16) = (/ & + & 0.86890e+02_r8,0.65171e+02_r8,0.46144e+02_r8,0.60253e+02_r8,0.80337e+02_r8 /) + kbo(:, 5,29,16) = (/ & + & 0.82249e+02_r8,0.61690e+02_r8,0.43266e+02_r8,0.56539e+02_r8,0.75385e+02_r8 /) + kbo(:, 1,30,16) = (/ & + & 0.10264e+03_r8,0.76981e+02_r8,0.56267e+02_r8,0.73352e+02_r8,0.97803e+02_r8 /) + kbo(:, 2,30,16) = (/ & + & 0.96761e+02_r8,0.72573e+02_r8,0.52390e+02_r8,0.68302e+02_r8,0.91070e+02_r8 /) + kbo(:, 3,30,16) = (/ & + & 0.91349e+02_r8,0.68515e+02_r8,0.48877e+02_r8,0.63734e+02_r8,0.84978e+02_r8 /) + kbo(:, 4,30,16) = (/ & + & 0.86346e+02_r8,0.64763e+02_r8,0.45722e+02_r8,0.59615e+02_r8,0.79487e+02_r8 /) + kbo(:, 5,30,16) = (/ & + & 0.81701e+02_r8,0.61280e+02_r8,0.42874e+02_r8,0.55973e+02_r8,0.74631e+02_r8 /) + kbo(:, 1,31,16) = (/ & + & 0.10185e+03_r8,0.76389e+02_r8,0.55624e+02_r8,0.72410e+02_r8,0.96547e+02_r8 /) + kbo(:, 2,31,16) = (/ & + & 0.95999e+02_r8,0.72002e+02_r8,0.51796e+02_r8,0.67443e+02_r8,0.89924e+02_r8 /) + kbo(:, 3,31,16) = (/ & + & 0.90614e+02_r8,0.67963e+02_r8,0.48327e+02_r8,0.62938e+02_r8,0.83917e+02_r8 /) + kbo(:, 4,31,16) = (/ & + & 0.85645e+02_r8,0.64237e+02_r8,0.45228e+02_r8,0.58906e+02_r8,0.78542e+02_r8 /) + kbo(:, 5,31,16) = (/ & + & 0.81007e+02_r8,0.60759e+02_r8,0.42414e+02_r8,0.55328e+02_r8,0.73771e+02_r8 /) + kbo(:, 1,32,16) = (/ & + & 0.10089e+03_r8,0.75672e+02_r8,0.54904e+02_r8,0.71387e+02_r8,0.95183e+02_r8 /) + kbo(:, 2,32,16) = (/ & + & 0.95077e+02_r8,0.71310e+02_r8,0.51129e+02_r8,0.66501e+02_r8,0.88668e+02_r8 /) + kbo(:, 3,32,16) = (/ & + & 0.89743e+02_r8,0.67310e+02_r8,0.47720e+02_r8,0.62089e+02_r8,0.82785e+02_r8 /) + kbo(:, 4,32,16) = (/ & + & 0.84830e+02_r8,0.63626e+02_r8,0.44676e+02_r8,0.58147e+02_r8,0.77529e+02_r8 /) + kbo(:, 5,32,16) = (/ & + & 0.80208e+02_r8,0.60160e+02_r8,0.41909e+02_r8,0.54638e+02_r8,0.72851e+02_r8 /) + kbo(:, 1,33,16) = (/ & + & 0.99806e+02_r8,0.74857e+02_r8,0.54124e+02_r8,0.70307e+02_r8,0.93742e+02_r8 /) + kbo(:, 2,33,16) = (/ & + & 0.94060e+02_r8,0.70548e+02_r8,0.50418e+02_r8,0.65525e+02_r8,0.87366e+02_r8 /) + kbo(:, 3,33,16) = (/ & + & 0.88780e+02_r8,0.66588e+02_r8,0.47080e+02_r8,0.61195e+02_r8,0.81594e+02_r8 /) + kbo(:, 4,33,16) = (/ & + & 0.83926e+02_r8,0.62948e+02_r8,0.44091e+02_r8,0.57369e+02_r8,0.76493e+02_r8 /) + kbo(:, 5,33,16) = (/ & + & 0.79342e+02_r8,0.59511e+02_r8,0.41372e+02_r8,0.53910e+02_r8,0.71880e+02_r8 /) + kbo(:, 1,34,16) = (/ & + & 0.98842e+02_r8,0.74134e+02_r8,0.53446e+02_r8,0.69373e+02_r8,0.92498e+02_r8 /) + kbo(:, 2,34,16) = (/ & + & 0.93169e+02_r8,0.69879e+02_r8,0.49796e+02_r8,0.64672e+02_r8,0.86229e+02_r8 /) + kbo(:, 3,34,16) = (/ & + & 0.87940e+02_r8,0.65958e+02_r8,0.46525e+02_r8,0.60437e+02_r8,0.80583e+02_r8 /) + kbo(:, 4,34,16) = (/ & + & 0.83124e+02_r8,0.62347e+02_r8,0.43581e+02_r8,0.56689e+02_r8,0.75585e+02_r8 /) + kbo(:, 5,34,16) = (/ & + & 0.78566e+02_r8,0.58929e+02_r8,0.40900e+02_r8,0.53287e+02_r8,0.71049e+02_r8 /) + kbo(:, 1,35,16) = (/ & + & 0.98383e+02_r8,0.73790e+02_r8,0.53104e+02_r8,0.68893e+02_r8,0.91857e+02_r8 /) + kbo(:, 2,35,16) = (/ & + & 0.92731e+02_r8,0.69551e+02_r8,0.49484e+02_r8,0.64233e+02_r8,0.85643e+02_r8 /) + kbo(:, 3,35,16) = (/ & + & 0.87537e+02_r8,0.65656e+02_r8,0.46247e+02_r8,0.60050e+02_r8,0.80067e+02_r8 /) + kbo(:, 4,35,16) = (/ & + & 0.82730e+02_r8,0.62051e+02_r8,0.43325e+02_r8,0.56336e+02_r8,0.75115e+02_r8 /) + kbo(:, 5,35,16) = (/ & + & 0.78184e+02_r8,0.58642e+02_r8,0.40664e+02_r8,0.52959e+02_r8,0.70611e+02_r8 /) + kbo(:, 1,36,16) = (/ & + & 0.98510e+02_r8,0.73885e+02_r8,0.53153e+02_r8,0.68921e+02_r8,0.91895e+02_r8 /) + kbo(:, 2,36,16) = (/ & + & 0.92845e+02_r8,0.69637e+02_r8,0.49525e+02_r8,0.64248e+02_r8,0.85664e+02_r8 /) + kbo(:, 3,36,16) = (/ & + & 0.87626e+02_r8,0.65723e+02_r8,0.46281e+02_r8,0.60067e+02_r8,0.80090e+02_r8 /) + kbo(:, 4,36,16) = (/ & + & 0.82805e+02_r8,0.62108e+02_r8,0.43352e+02_r8,0.56351e+02_r8,0.75135e+02_r8 /) + kbo(:, 5,36,16) = (/ & + & 0.78246e+02_r8,0.58689e+02_r8,0.40687e+02_r8,0.52970e+02_r8,0.70627e+02_r8 /) + kbo(:, 1,37,16) = (/ & + & 0.99499e+02_r8,0.74626e+02_r8,0.53765e+02_r8,0.69681e+02_r8,0.92907e+02_r8 /) + kbo(:, 2,37,16) = (/ & + & 0.93737e+02_r8,0.70305e+02_r8,0.50072e+02_r8,0.64938e+02_r8,0.86584e+02_r8 /) + kbo(:, 3,37,16) = (/ & + & 0.88443e+02_r8,0.66336e+02_r8,0.46765e+02_r8,0.60669e+02_r8,0.80892e+02_r8 /) + kbo(:, 4,37,16) = (/ & + & 0.83569e+02_r8,0.62680e+02_r8,0.43792e+02_r8,0.56887e+02_r8,0.75849e+02_r8 /) + kbo(:, 5,37,16) = (/ & + & 0.78959e+02_r8,0.59223e+02_r8,0.41087e+02_r8,0.53464e+02_r8,0.71286e+02_r8 /) + kbo(:, 1,38,16) = (/ & + & 0.10053e+03_r8,0.75401e+02_r8,0.54401e+02_r8,0.70469e+02_r8,0.93958e+02_r8 /) + kbo(:, 2,38,16) = (/ & + & 0.94665e+02_r8,0.71001e+02_r8,0.50643e+02_r8,0.65651e+02_r8,0.87535e+02_r8 /) + kbo(:, 3,38,16) = (/ & + & 0.89287e+02_r8,0.66968e+02_r8,0.47272e+02_r8,0.61298e+02_r8,0.81730e+02_r8 /) + kbo(:, 4,38,16) = (/ & + & 0.84354e+02_r8,0.63269e+02_r8,0.44250e+02_r8,0.57455e+02_r8,0.76607e+02_r8 /) + kbo(:, 5,38,16) = (/ & + & 0.79688e+02_r8,0.59770e+02_r8,0.41502e+02_r8,0.53978e+02_r8,0.71970e+02_r8 /) + kbo(:, 1,39,16) = (/ & + & 0.10152e+03_r8,0.76145e+02_r8,0.55030e+02_r8,0.71266e+02_r8,0.95022e+02_r8 /) + kbo(:, 2,39,16) = (/ & + & 0.95574e+02_r8,0.71683e+02_r8,0.51208e+02_r8,0.66359e+02_r8,0.88479e+02_r8 /) + kbo(:, 3,39,16) = (/ & + & 0.90127e+02_r8,0.67598e+02_r8,0.47776e+02_r8,0.61934e+02_r8,0.82579e+02_r8 /) + kbo(:, 4,39,16) = (/ & + & 0.85122e+02_r8,0.63845e+02_r8,0.44704e+02_r8,0.58015e+02_r8,0.77353e+02_r8 /) + kbo(:, 5,39,16) = (/ & + & 0.80410e+02_r8,0.60311e+02_r8,0.41916e+02_r8,0.54486e+02_r8,0.72649e+02_r8 /) + kbo(:, 1,40,16) = (/ & + & 0.10316e+03_r8,0.77371e+02_r8,0.56077e+02_r8,0.72600e+02_r8,0.96800e+02_r8 /) + kbo(:, 2,40,16) = (/ & + & 0.97060e+02_r8,0.72797e+02_r8,0.52149e+02_r8,0.67558e+02_r8,0.90077e+02_r8 /) + kbo(:, 3,40,16) = (/ & + & 0.91509e+02_r8,0.68635e+02_r8,0.48618e+02_r8,0.63010e+02_r8,0.84013e+02_r8 /) + kbo(:, 4,40,16) = (/ & + & 0.86384e+02_r8,0.64791e+02_r8,0.45460e+02_r8,0.58959e+02_r8,0.78612e+02_r8 /) + kbo(:, 5,40,16) = (/ & + & 0.81600e+02_r8,0.61204e+02_r8,0.42605e+02_r8,0.55349e+02_r8,0.73798e+02_r8 /) + kbo(:, 1,41,16) = (/ & + & 0.10490e+03_r8,0.78677e+02_r8,0.57202e+02_r8,0.74030e+02_r8,0.98707e+02_r8 /) + kbo(:, 2,41,16) = (/ & + & 0.98655e+02_r8,0.73994e+02_r8,0.53155e+02_r8,0.68836e+02_r8,0.91782e+02_r8 /) + kbo(:, 3,41,16) = (/ & + & 0.92964e+02_r8,0.69726e+02_r8,0.49517e+02_r8,0.64156e+02_r8,0.85541e+02_r8 /) + kbo(:, 4,41,16) = (/ & + & 0.87720e+02_r8,0.65793e+02_r8,0.46275e+02_r8,0.59984e+02_r8,0.79978e+02_r8 /) + kbo(:, 5,41,16) = (/ & + & 0.82858e+02_r8,0.62147e+02_r8,0.43340e+02_r8,0.56275e+02_r8,0.75033e+02_r8 /) + kbo(:, 1,42,16) = (/ & + & 0.10666e+03_r8,0.79997e+02_r8,0.58340e+02_r8,0.75485e+02_r8,0.10065e+03_r8 /) + kbo(:, 2,42,16) = (/ & + & 0.10028e+03_r8,0.75211e+02_r8,0.54189e+02_r8,0.70153e+02_r8,0.93537e+02_r8 /) + kbo(:, 3,42,16) = (/ & + & 0.94432e+02_r8,0.70827e+02_r8,0.50443e+02_r8,0.65340e+02_r8,0.87121e+02_r8 /) + kbo(:, 4,42,16) = (/ & + & 0.89075e+02_r8,0.66809e+02_r8,0.47102e+02_r8,0.61032e+02_r8,0.81376e+02_r8 /) + kbo(:, 5,42,16) = (/ & + & 0.84125e+02_r8,0.63097e+02_r8,0.44086e+02_r8,0.57211e+02_r8,0.76281e+02_r8 /) + kbo(:, 1,43,16) = (/ & + & 0.10883e+03_r8,0.81624e+02_r8,0.59771e+02_r8,0.77309e+02_r8,0.10308e+03_r8 /) + kbo(:, 2,43,16) = (/ & + & 0.10228e+03_r8,0.76711e+02_r8,0.55476e+02_r8,0.71797e+02_r8,0.95729e+02_r8 /) + kbo(:, 3,43,16) = (/ & + & 0.96257e+02_r8,0.72196e+02_r8,0.51599e+02_r8,0.66824e+02_r8,0.89098e+02_r8 /) + kbo(:, 4,43,16) = (/ & + & 0.90745e+02_r8,0.68062e+02_r8,0.48126e+02_r8,0.62350e+02_r8,0.83134e+02_r8 /) + kbo(:, 5,43,16) = (/ & + & 0.85682e+02_r8,0.64265e+02_r8,0.45017e+02_r8,0.58380e+02_r8,0.77840e+02_r8 /) + kbo(:, 1,44,16) = (/ & + & 0.11122e+03_r8,0.83416e+02_r8,0.61378e+02_r8,0.79350e+02_r8,0.10580e+03_r8 /) + kbo(:, 2,44,16) = (/ & + & 0.10448e+03_r8,0.78362e+02_r8,0.56905e+02_r8,0.73629e+02_r8,0.98171e+02_r8 /) + kbo(:, 3,44,16) = (/ & + & 0.98280e+02_r8,0.73712e+02_r8,0.52886e+02_r8,0.68474e+02_r8,0.91299e+02_r8 /) + kbo(:, 4,44,16) = (/ & + & 0.92614e+02_r8,0.69464e+02_r8,0.49277e+02_r8,0.63819e+02_r8,0.85092e+02_r8 /) + kbo(:, 5,44,16) = (/ & + & 0.87390e+02_r8,0.65546e+02_r8,0.46054e+02_r8,0.59688e+02_r8,0.79585e+02_r8 /) + kbo(:, 1,45,16) = (/ & + & 0.11367e+03_r8,0.85251e+02_r8,0.63043e+02_r8,0.81458e+02_r8,0.10861e+03_r8 /) + kbo(:, 2,45,16) = (/ & + & 0.10674e+03_r8,0.80056e+02_r8,0.58377e+02_r8,0.75516e+02_r8,0.10069e+03_r8 /) + kbo(:, 3,45,16) = (/ & + & 0.10036e+03_r8,0.75271e+02_r8,0.54217e+02_r8,0.70172e+02_r8,0.93562e+02_r8 /) + kbo(:, 4,45,16) = (/ & + & 0.94507e+02_r8,0.70883e+02_r8,0.50472e+02_r8,0.65352e+02_r8,0.87137e+02_r8 /) + kbo(:, 5,45,16) = (/ & + & 0.89124e+02_r8,0.66846e+02_r8,0.47119e+02_r8,0.61044e+02_r8,0.81393e+02_r8 /) + kbo(:, 1,46,16) = (/ & + & 0.11634e+03_r8,0.87256e+02_r8,0.64886e+02_r8,0.83772e+02_r8,0.11170e+03_r8 /) + kbo(:, 2,46,16) = (/ & + & 0.10921e+03_r8,0.81909e+02_r8,0.60009e+02_r8,0.77600e+02_r8,0.10347e+03_r8 /) + kbo(:, 3,46,16) = (/ & + & 0.10262e+03_r8,0.76969e+02_r8,0.55682e+02_r8,0.72046e+02_r8,0.96062e+02_r8 /) + kbo(:, 4,46,16) = (/ & + & 0.96578e+02_r8,0.72436e+02_r8,0.51790e+02_r8,0.67050e+02_r8,0.89399e+02_r8 /) + kbo(:, 5,46,16) = (/ & + & 0.91036e+02_r8,0.68280e+02_r8,0.48293e+02_r8,0.62556e+02_r8,0.83408e+02_r8 /) + kbo(:, 1,47,16) = (/ & + & 0.11944e+03_r8,0.89580e+02_r8,0.67039e+02_r8,0.86470e+02_r8,0.11529e+03_r8 /) + kbo(:, 2,47,16) = (/ & + & 0.11203e+03_r8,0.84025e+02_r8,0.61916e+02_r8,0.80032e+02_r8,0.10671e+03_r8 /) + kbo(:, 3,47,16) = (/ & + & 0.10523e+03_r8,0.78928e+02_r8,0.57378e+02_r8,0.74229e+02_r8,0.98972e+02_r8 /) + kbo(:, 4,47,16) = (/ & + & 0.98975e+02_r8,0.74234e+02_r8,0.53317e+02_r8,0.69003e+02_r8,0.92005e+02_r8 /) + kbo(:, 5,47,16) = (/ & + & 0.93247e+02_r8,0.69938e+02_r8,0.49666e+02_r8,0.64309e+02_r8,0.85745e+02_r8 /) + kbo(:, 1,48,16) = (/ & + & 0.12267e+03_r8,0.92006e+02_r8,0.69290e+02_r8,0.89280e+02_r8,0.11904e+03_r8 /) + kbo(:, 2,48,16) = (/ & + & 0.11495e+03_r8,0.86215e+02_r8,0.63917e+02_r8,0.82556e+02_r8,0.11008e+03_r8 /) + kbo(:, 3,48,16) = (/ & + & 0.10793e+03_r8,0.80951e+02_r8,0.59146e+02_r8,0.76493e+02_r8,0.10199e+03_r8 /) + kbo(:, 4,48,16) = (/ & + & 0.10147e+03_r8,0.76101e+02_r8,0.54918e+02_r8,0.71050e+02_r8,0.94733e+02_r8 /) + kbo(:, 5,48,16) = (/ & + & 0.95498e+02_r8,0.71626e+02_r8,0.51095e+02_r8,0.66155e+02_r8,0.88207e+02_r8 /) + kbo(:, 1,49,16) = (/ & + & 0.12603e+03_r8,0.94521e+02_r8,0.71680e+02_r8,0.92236e+02_r8,0.12298e+03_r8 /) + kbo(:, 2,49,16) = (/ & + & 0.11801e+03_r8,0.88509e+02_r8,0.66027e+02_r8,0.85192e+02_r8,0.11359e+03_r8 /) + kbo(:, 3,49,16) = (/ & + & 0.11070e+03_r8,0.83029e+02_r8,0.61003e+02_r8,0.78868e+02_r8,0.10516e+03_r8 /) + kbo(:, 4,49,16) = (/ & + & 0.10402e+03_r8,0.78016e+02_r8,0.56578e+02_r8,0.73185e+02_r8,0.97580e+02_r8 /) + kbo(:, 5,49,16) = (/ & + & 0.97847e+02_r8,0.73387e+02_r8,0.52593e+02_r8,0.68075e+02_r8,0.90767e+02_r8 /) + kbo(:, 1,50,16) = (/ & + & 0.12933e+03_r8,0.96996e+02_r8,0.74078e+02_r8,0.95132e+02_r8,0.12684e+03_r8 /) + kbo(:, 2,50,16) = (/ & + & 0.12097e+03_r8,0.90726e+02_r8,0.68085e+02_r8,0.87768e+02_r8,0.11702e+03_r8 /) + kbo(:, 3,50,16) = (/ & + & 0.11343e+03_r8,0.85073e+02_r8,0.62849e+02_r8,0.81185e+02_r8,0.10825e+03_r8 /) + kbo(:, 4,50,16) = (/ & + & 0.10650e+03_r8,0.79879e+02_r8,0.58193e+02_r8,0.75257e+02_r8,0.10034e+03_r8 /) + kbo(:, 5,50,16) = (/ & + & 0.10012e+03_r8,0.75094e+02_r8,0.54050e+02_r8,0.69940e+02_r8,0.93253e+02_r8 /) + kbo(:, 1,51,16) = (/ & + & 0.13262e+03_r8,0.99463e+02_r8,0.76537e+02_r8,0.98089e+02_r8,0.13079e+03_r8 /) + kbo(:, 2,51,16) = (/ & + & 0.12396e+03_r8,0.92972e+02_r8,0.70180e+02_r8,0.90371e+02_r8,0.12049e+03_r8 /) + kbo(:, 3,51,16) = (/ & + & 0.11611e+03_r8,0.87085e+02_r8,0.64700e+02_r8,0.83525e+02_r8,0.11137e+03_r8 /) + kbo(:, 4,51,16) = (/ & + & 0.10897e+03_r8,0.81728e+02_r8,0.59829e+02_r8,0.77356e+02_r8,0.10314e+03_r8 /) + kbo(:, 5,51,16) = (/ & + & 0.10241e+03_r8,0.76807e+02_r8,0.55526e+02_r8,0.71828e+02_r8,0.95771e+02_r8 /) + kbo(:, 1,52,16) = (/ & + & 0.13607e+03_r8,0.10205e+03_r8,0.79117e+02_r8,0.10117e+03_r8,0.13489e+03_r8 /) + kbo(:, 2,52,16) = (/ & + & 0.12703e+03_r8,0.95276e+02_r8,0.72382e+02_r8,0.93082e+02_r8,0.12411e+03_r8 /) + kbo(:, 3,52,16) = (/ & + & 0.11888e+03_r8,0.89162e+02_r8,0.66631e+02_r8,0.85943e+02_r8,0.11459e+03_r8 /) + kbo(:, 4,52,16) = (/ & + & 0.11155e+03_r8,0.83666e+02_r8,0.61557e+02_r8,0.79542e+02_r8,0.10606e+03_r8 /) + kbo(:, 5,52,16) = (/ & + & 0.10475e+03_r8,0.78563e+02_r8,0.57053e+02_r8,0.73794e+02_r8,0.98392e+02_r8 /) + kbo(:, 1,53,16) = (/ & + & 0.13969e+03_r8,0.10477e+03_r8,0.81852e+02_r8,0.10445e+03_r8,0.13926e+03_r8 /) + kbo(:, 2,53,16) = (/ & + & 0.13021e+03_r8,0.97660e+02_r8,0.74731e+02_r8,0.95923e+02_r8,0.12790e+03_r8 /) + kbo(:, 3,53,16) = (/ & + & 0.12178e+03_r8,0.91333e+02_r8,0.68644e+02_r8,0.88461e+02_r8,0.11795e+03_r8 /) + kbo(:, 4,53,16) = (/ & + & 0.11417e+03_r8,0.85628e+02_r8,0.63346e+02_r8,0.81812e+02_r8,0.10908e+03_r8 /) + kbo(:, 5,53,16) = (/ & + & 0.10716e+03_r8,0.80376e+02_r8,0.58630e+02_r8,0.75816e+02_r8,0.10109e+03_r8 /) + kbo(:, 1,54,16) = (/ & + & 0.14312e+03_r8,0.10734e+03_r8,0.84505e+02_r8,0.10757e+03_r8,0.14343e+03_r8 /) + kbo(:, 2,54,16) = (/ & + & 0.13326e+03_r8,0.99943e+02_r8,0.77008e+02_r8,0.98653e+02_r8,0.13154e+03_r8 /) + kbo(:, 3,54,16) = (/ & + & 0.12453e+03_r8,0.93400e+02_r8,0.70583e+02_r8,0.90867e+02_r8,0.12116e+03_r8 /) + kbo(:, 4,54,16) = (/ & + & 0.11663e+03_r8,0.87472e+02_r8,0.65055e+02_r8,0.83971e+02_r8,0.11196e+03_r8 /) + kbo(:, 5,54,16) = (/ & + & 0.10944e+03_r8,0.82085e+02_r8,0.60143e+02_r8,0.77761e+02_r8,0.10368e+03_r8 /) + kbo(:, 1,55,16) = (/ & + & 0.14652e+03_r8,0.10989e+03_r8,0.87185e+02_r8,0.11072e+03_r8,0.14762e+03_r8 /) + kbo(:, 2,55,16) = (/ & + & 0.13631e+03_r8,0.10223e+03_r8,0.79292e+02_r8,0.10139e+03_r8,0.13518e+03_r8 /) + kbo(:, 3,55,16) = (/ & + & 0.12725e+03_r8,0.95436e+02_r8,0.72534e+02_r8,0.93260e+02_r8,0.12435e+03_r8 /) + kbo(:, 4,55,16) = (/ & + & 0.11908e+03_r8,0.89315e+02_r8,0.66761e+02_r8,0.86100e+02_r8,0.11480e+03_r8 /) + kbo(:, 5,55,16) = (/ & + & 0.11172e+03_r8,0.83789e+02_r8,0.61666e+02_r8,0.79683e+02_r8,0.10624e+03_r8 /) + kbo(:, 1,56,16) = (/ & + & 0.15005e+03_r8,0.11254e+03_r8,0.89964e+02_r8,0.11399e+03_r8,0.15199e+03_r8 /) + kbo(:, 2,56,16) = (/ & + & 0.13946e+03_r8,0.10459e+03_r8,0.81673e+02_r8,0.10424e+03_r8,0.13899e+03_r8 /) + kbo(:, 3,56,16) = (/ & + & 0.13002e+03_r8,0.97512e+02_r8,0.74583e+02_r8,0.95730e+02_r8,0.12764e+03_r8 /) + kbo(:, 4,56,16) = (/ & + & 0.12160e+03_r8,0.91205e+02_r8,0.68519e+02_r8,0.88312e+02_r8,0.11775e+03_r8 /) + kbo(:, 5,56,16) = (/ & + & 0.11401e+03_r8,0.85509e+02_r8,0.63233e+02_r8,0.81665e+02_r8,0.10889e+03_r8 /) + kbo(:, 1,57,16) = (/ & + & 0.15367e+03_r8,0.11525e+03_r8,0.92893e+02_r8,0.11745e+03_r8,0.15659e+03_r8 /) + kbo(:, 2,57,16) = (/ & + & 0.14273e+03_r8,0.10705e+03_r8,0.84201e+02_r8,0.10722e+03_r8,0.14296e+03_r8 /) + kbo(:, 3,57,16) = (/ & + & 0.13291e+03_r8,0.99681e+02_r8,0.76750e+02_r8,0.98336e+02_r8,0.13111e+03_r8 /) + kbo(:, 4,57,16) = (/ & + & 0.12423e+03_r8,0.93171e+02_r8,0.70357e+02_r8,0.90589e+02_r8,0.12079e+03_r8 /) + kbo(:, 5,57,16) = (/ & + & 0.11636e+03_r8,0.87269e+02_r8,0.64859e+02_r8,0.83719e+02_r8,0.11162e+03_r8 /) + kbo(:, 1,58,16) = (/ & + & 0.15720e+03_r8,0.11790e+03_r8,0.95809e+02_r8,0.12090e+03_r8,0.16121e+03_r8 /) + kbo(:, 2,58,16) = (/ & + & 0.14594e+03_r8,0.10946e+03_r8,0.86713e+02_r8,0.11017e+03_r8,0.14690e+03_r8 /) + kbo(:, 3,58,16) = (/ & + & 0.13577e+03_r8,0.10183e+03_r8,0.78898e+02_r8,0.10090e+03_r8,0.13454e+03_r8 /) + kbo(:, 4,58,16) = (/ & + & 0.12678e+03_r8,0.95087e+02_r8,0.72188e+02_r8,0.92844e+02_r8,0.12379e+03_r8 /) + kbo(:, 5,58,16) = (/ & + & 0.11865e+03_r8,0.88989e+02_r8,0.66460e+02_r8,0.85728e+02_r8,0.11430e+03_r8 /) + kbo(:, 1,59,16) = (/ & + & 0.15867e+03_r8,0.11900e+03_r8,0.97023e+02_r8,0.12235e+03_r8,0.16313e+03_r8 /) + kbo(:, 2,59,16) = (/ & + & 0.14725e+03_r8,0.11044e+03_r8,0.87747e+02_r8,0.11139e+03_r8,0.14852e+03_r8 /) + kbo(:, 3,59,16) = (/ & + & 0.13696e+03_r8,0.10272e+03_r8,0.79780e+02_r8,0.10196e+03_r8,0.13595e+03_r8 /) + kbo(:, 4,59,16) = (/ & + & 0.12782e+03_r8,0.95865e+02_r8,0.72946e+02_r8,0.93765e+02_r8,0.12502e+03_r8 /) + kbo(:, 5,59,16) = (/ & + & 0.11961e+03_r8,0.89706e+02_r8,0.67116e+02_r8,0.86544e+02_r8,0.11539e+03_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.110008e-06_r8, 0.630912e-06_r8, 0.363159e-05_r8, 0.616892e-05_r8 /) + forrefo(:, 2) = (/ 0.429709e-05_r8, 0.789174e-05_r8, 0.217416e-04_r8, 0.639393e-04_r8 /) + forrefo(:, 3) = (/ 0.436283e-04_r8, 0.526247e-04_r8, 0.116341e-03_r8, 0.205616e-03_r8 /) + forrefo(:, 4) = (/ 0.215627e-03_r8, 0.234522e-03_r8, 0.280497e-03_r8, 0.838668e-03_r8 /) + forrefo(:, 5) = (/ 0.529283e-03_r8, 0.620848e-03_r8, 0.935561e-03_r8, 0.171252e-02_r8 /) + forrefo(:, 6) = (/ 0.212267e-02_r8, 0.218564e-02_r8, 0.222227e-02_r8, 0.199650e-02_r8 /) + forrefo(:, 7) = (/ 0.291120e-02_r8, 0.281168e-02_r8, 0.259543e-02_r8, 0.210159e-02_r8 /) + forrefo(:, 8) = (/ 0.316249e-02_r8, 0.310695e-02_r8, 0.279501e-02_r8, 0.208076e-02_r8 /) + forrefo(:, 9) = (/ 0.354993e-02_r8, 0.336989e-02_r8, 0.298930e-02_r8, 0.180424e-02_r8 /) + forrefo(:,10) = (/ 0.397729e-02_r8, 0.367409e-02_r8, 0.328982e-02_r8, 0.177807e-02_r8 /) + forrefo(:,11) = (/ 0.408831e-02_r8, 0.398792e-02_r8, 0.352727e-02_r8, 0.192470e-02_r8 /) + forrefo(:,12) = (/ 0.433926e-02_r8, 0.420667e-02_r8, 0.383894e-02_r8, 0.220836e-02_r8 /) + forrefo(:,13) = (/ 0.436397e-02_r8, 0.433769e-02_r8, 0.425752e-02_r8, 0.237343e-02_r8 /) + forrefo(:,14) = (/ 0.440525e-02_r8, 0.449018e-02_r8, 0.451881e-02_r8, 0.269169e-02_r8 /) + forrefo(:,15) = (/ 0.491350e-02_r8, 0.481760e-02_r8, 0.475799e-02_r8, 0.362666e-02_r8 /) + forrefo(:,16) = (/ 0.561641e-02_r8, 0.524553e-02_r8, 0.512473e-02_r8, 0.493802e-02_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.115887e-03_r8, 0.926537e-04_r8, 0.740783e-04_r8, 0.592270e-04_r8, 0.473530e-04_r8, & + & 0.378596e-04_r8, 0.302694e-04_r8, 0.242010e-04_r8, 0.193491e-04_r8, 0.154700e-04_r8 /) + selfrefo(:, 2) = (/ & + & 0.459557e-03_r8, 0.381962e-03_r8, 0.317469e-03_r8, 0.263866e-03_r8, 0.219313e-03_r8, & + & 0.182283e-03_r8, 0.151505e-03_r8, 0.125924e-03_r8, 0.104662e-03_r8, 0.869904e-04_r8 /) + selfrefo(:, 3) = (/ & + & 0.166821e-02_r8, 0.151103e-02_r8, 0.136866e-02_r8, 0.123970e-02_r8, 0.112290e-02_r8, & + & 0.101710e-02_r8, 0.921266e-03_r8, 0.834463e-03_r8, 0.755839e-03_r8, 0.684623e-03_r8 /) + selfrefo(:, 4) = (/ & + & 0.460175e-02_r8, 0.421372e-02_r8, 0.385842e-02_r8, 0.353307e-02_r8, 0.323516e-02_r8, & + & 0.296236e-02_r8, 0.271257e-02_r8, 0.248385e-02_r8, 0.227440e-02_r8, 0.208262e-02_r8 /) + selfrefo(:, 5) = (/ & + & 0.101589e-01_r8, 0.924742e-02_r8, 0.841772e-02_r8, 0.766247e-02_r8, 0.697497e-02_r8, & + & 0.634917e-02_r8, 0.577951e-02_r8, 0.526096e-02_r8, 0.478893e-02_r8, 0.435926e-02_r8 /) + selfrefo(:, 6) = (/ & + & 0.328043e-01_r8, 0.300853e-01_r8, 0.275917e-01_r8, 0.253048e-01_r8, 0.232075e-01_r8, & + & 0.212839e-01_r8, 0.195198e-01_r8, 0.179020e-01_r8, 0.164182e-01_r8, 0.150574e-01_r8 /) + selfrefo(:, 7) = (/ & + & 0.405936e-01_r8, 0.376032e-01_r8, 0.348331e-01_r8, 0.322671e-01_r8, 0.298901e-01_r8, & + & 0.276883e-01_r8, 0.256486e-01_r8, 0.237591e-01_r8, 0.220089e-01_r8, 0.203876e-01_r8 /) + selfrefo(:, 8) = (/ & + & 0.448362e-01_r8, 0.413811e-01_r8, 0.381923e-01_r8, 0.352492e-01_r8, 0.325329e-01_r8, & + & 0.300259e-01_r8, 0.277121e-01_r8, 0.255766e-01_r8, 0.236056e-01_r8, 0.217866e-01_r8 /) + selfrefo(:, 9) = (/ & + & 0.479741e-01_r8, 0.445389e-01_r8, 0.413497e-01_r8, 0.383889e-01_r8, 0.356400e-01_r8, & + & 0.330880e-01_r8, 0.307188e-01_r8, 0.285191e-01_r8, 0.264770e-01_r8, 0.245812e-01_r8 /) + selfrefo(:,10) = (/ & + & 0.519308e-01_r8, 0.484130e-01_r8, 0.451335e-01_r8, 0.420761e-01_r8, 0.392259e-01_r8, & + & 0.365687e-01_r8, 0.340916e-01_r8, 0.317822e-01_r8, 0.296293e-01_r8, 0.276222e-01_r8 /) + selfrefo(:,11) = (/ & + & 0.572039e-01_r8, 0.527780e-01_r8, 0.486945e-01_r8, 0.449270e-01_r8, 0.414510e-01_r8, & + & 0.382439e-01_r8, 0.352849e-01_r8, 0.325549e-01_r8, 0.300361e-01_r8, 0.277122e-01_r8 /) + selfrefo(:,12) = (/ & + & 0.601046e-01_r8, 0.554411e-01_r8, 0.511395e-01_r8, 0.471716e-01_r8, 0.435116e-01_r8, & + & 0.401356e-01_r8, 0.370215e-01_r8, 0.341490e-01_r8, 0.314994e-01_r8, 0.290554e-01_r8 /) + selfrefo(:,13) = (/ & + & 0.616595e-01_r8, 0.567145e-01_r8, 0.521662e-01_r8, 0.479826e-01_r8, 0.441346e-01_r8, & + & 0.405951e-01_r8, 0.373395e-01_r8, 0.343450e-01_r8, 0.315906e-01_r8, 0.290571e-01_r8 /) + selfrefo(:,14) = (/ & + & 0.647916e-01_r8, 0.592493e-01_r8, 0.541811e-01_r8, 0.495465e-01_r8, 0.453083e-01_r8, & + & 0.414326e-01_r8, 0.378885e-01_r8, 0.346475e-01_r8, 0.316837e-01_r8, 0.289735e-01_r8 /) + selfrefo(:,15) = (/ & + & 0.694231e-01_r8, 0.637703e-01_r8, 0.585777e-01_r8, 0.538079e-01_r8, 0.494265e-01_r8, & + & 0.454019e-01_r8, 0.417050e-01_r8, 0.383091e-01_r8, 0.351897e-01_r8, 0.323244e-01_r8 /) + selfrefo(:,16) = (/ & + & 0.761764e-01_r8, 0.701815e-01_r8, 0.646584e-01_r8, 0.595700e-01_r8, 0.548820e-01_r8, & + & 0.505629e-01_r8, 0.465838e-01_r8, 0.429178e-01_r8, 0.395403e-01_r8, 0.364286e-01_r8 /) + + end subroutine sw_kgb21 + +! ************************************************************************** + subroutine sw_kgb22 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg22, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:, 1) = (/ & + & 3.71641_r8 ,3.63190_r8 ,3.44795_r8 ,3.17936_r8 , & + & 2.86071_r8 ,2.48490_r8 ,2.02471_r8 ,1.52475_r8 , & + & 1.03811_r8 ,0.113272_r8 ,9.37115e-02_r8,7.38969e-02_r8, & + & 5.44713e-02_r8,3.45905e-02_r8,1.30293e-02_r8,1.84198e-03_r8 /) + sfluxrefo(:, 2) = (/ & + & 3.73933_r8 ,3.60360_r8 ,3.43370_r8 ,3.19749_r8 , & + & 2.87747_r8 ,2.47926_r8 ,2.02175_r8 ,1.52010_r8 , & + & 1.03612_r8 ,0.113265_r8 ,9.37145e-02_r8,7.38951e-02_r8, & + & 5.44714e-02_r8,3.45906e-02_r8,1.30293e-02_r8,1.84198e-03_r8 /) + sfluxrefo(:, 3) = (/ & + & 3.73889_r8 ,3.60279_r8 ,3.43404_r8 ,3.20560_r8 , & + & 2.87367_r8 ,2.47515_r8 ,2.02412_r8 ,1.52315_r8 , & + & 1.03146_r8 ,0.113272_r8 ,9.36707e-02_r8,7.39080e-02_r8, & + & 5.44598e-02_r8,3.45906e-02_r8,1.30293e-02_r8,1.84198e-03_r8 /) + sfluxrefo(:, 4) = (/ & + & 3.73801_r8 ,3.60530_r8 ,3.43659_r8 ,3.20640_r8 , & + & 2.87039_r8 ,2.47330_r8 ,2.02428_r8 ,1.52509_r8 , & + & 1.03037_r8 ,0.112553_r8 ,9.35352e-02_r8,7.39675e-02_r8, & + & 5.43951e-02_r8,3.45669e-02_r8,1.30292e-02_r8,1.84198e-03_r8 /) + sfluxrefo(:, 5) = (/ & + & 3.73809_r8 ,3.60996_r8 ,3.43602_r8 ,3.20364_r8 , & + & 2.87005_r8 ,2.47343_r8 ,2.02353_r8 ,1.52617_r8 , & + & 1.03138_r8 ,0.111172_r8 ,9.29885e-02_r8,7.35034e-02_r8, & + & 5.42427e-02_r8,3.45732e-02_r8,1.30169e-02_r8,1.84550e-03_r8 /) + sfluxrefo(:, 6) = (/ & + & 3.73872_r8 ,3.62054_r8 ,3.42934_r8 ,3.20110_r8 , & + & 2.86886_r8 ,2.47379_r8 ,2.02237_r8 ,1.52754_r8 , & + & 1.03228_r8 ,0.111597_r8 ,9.12252e-02_r8,7.33115e-02_r8, & + & 5.35600e-02_r8,3.45187e-02_r8,1.30184e-02_r8,1.84551e-03_r8 /) + sfluxrefo(:, 7) = (/ & + & 3.73969_r8 ,3.65461_r8 ,3.40646_r8 ,3.19082_r8 , & + & 2.86919_r8 ,2.47289_r8 ,2.02312_r8 ,1.52629_r8 , & + & 1.03329_r8 ,0.111611_r8 ,9.16275e-02_r8,7.14731e-02_r8, & + & 5.31771e-02_r8,3.44980e-02_r8,1.30190e-02_r8,1.84551e-03_r8 /) + sfluxrefo(:, 8) = (/ & + & 3.73995_r8 ,3.65348_r8 ,3.43707_r8 ,3.16351_r8 , & + & 2.87003_r8 ,2.47392_r8 ,2.02114_r8 ,1.52548_r8 , & + & 1.03306_r8 ,0.111088_r8 ,9.12422e-02_r8,7.11146e-02_r8, & + & 5.31333e-02_r8,3.45302e-02_r8,1.30209e-02_r8,1.84554e-03_r8 /) + sfluxrefo(:, 9) = (/ & + & 3.73788_r8 ,3.65004_r8 ,3.46938_r8 ,3.15236_r8 , & + & 2.86381_r8 ,2.47393_r8 ,2.01715_r8 ,1.52134_r8 , & + & 1.03163_r8 ,0.111259_r8 ,9.12948e-02_r8,7.09999e-02_r8, & + & 5.31792e-02_r8,3.44955e-02_r8,1.30189e-02_r8,1.84551e-03_r8 /) + +! Rayleigh extinction coefficient at v = 8000 cm-1. + rayl = 1.54e-08_r8 + + strrat = 0.022708_r8 + + layreffr = 2 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.14658e-08_r8,0.32044e-07_r8,0.36289e-07_r8,0.38717e-07_r8,0.40590e-07_r8, & + & 0.43330e-07_r8,0.46916e-07_r8,0.56519e-07_r8,0.42446e-07_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.17883e-08_r8,0.36129e-07_r8,0.40724e-07_r8,0.43498e-07_r8,0.45371e-07_r8, & + & 0.47093e-07_r8,0.51195e-07_r8,0.58562e-07_r8,0.44474e-07_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.21286e-08_r8,0.46092e-07_r8,0.53991e-07_r8,0.59439e-07_r8,0.63497e-07_r8, & + & 0.66730e-07_r8,0.70296e-07_r8,0.83990e-07_r8,0.65058e-07_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.24816e-08_r8,0.43399e-07_r8,0.49167e-07_r8,0.52969e-07_r8,0.55586e-07_r8, & + & 0.57260e-07_r8,0.58809e-07_r8,0.64046e-07_r8,0.48780e-07_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.28409e-08_r8,0.46683e-07_r8,0.53128e-07_r8,0.57526e-07_r8,0.60605e-07_r8, & + & 0.62715e-07_r8,0.64284e-07_r8,0.67579e-07_r8,0.52346e-07_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.10965e-08_r8,0.24934e-07_r8,0.28268e-07_r8,0.30156e-07_r8,0.31820e-07_r8, & + & 0.34498e-07_r8,0.36563e-07_r8,0.46609e-07_r8,0.30202e-07_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.13538e-08_r8,0.28338e-07_r8,0.31923e-07_r8,0.34048e-07_r8,0.35529e-07_r8, & + & 0.37136e-07_r8,0.41583e-07_r8,0.46831e-07_r8,0.32817e-07_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.16260e-08_r8,0.36648e-07_r8,0.42882e-07_r8,0.47128e-07_r8,0.50288e-07_r8, & + & 0.52851e-07_r8,0.56093e-07_r8,0.70511e-07_r8,0.48182e-07_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.19102e-08_r8,0.39471e-07_r8,0.46225e-07_r8,0.50974e-07_r8,0.54565e-07_r8, & + & 0.57380e-07_r8,0.60079e-07_r8,0.67707e-07_r8,0.50168e-07_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.22030e-08_r8,0.37203e-07_r8,0.42234e-07_r8,0.45622e-07_r8,0.47990e-07_r8, & + & 0.49546e-07_r8,0.50777e-07_r8,0.53867e-07_r8,0.39769e-07_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.77844e-09_r8,0.18777e-07_r8,0.21347e-07_r8,0.22946e-07_r8,0.24368e-07_r8, & + & 0.25870e-07_r8,0.28084e-07_r8,0.39197e-07_r8,0.20196e-07_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.97891e-09_r8,0.21591e-07_r8,0.24379e-07_r8,0.25974e-07_r8,0.27213e-07_r8, & + & 0.29039e-07_r8,0.31487e-07_r8,0.37725e-07_r8,0.23228e-07_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.11949e-08_r8,0.24305e-07_r8,0.27342e-07_r8,0.29177e-07_r8,0.30428e-07_r8, & + & 0.31562e-07_r8,0.34299e-07_r8,0.39267e-07_r8,0.23943e-07_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.14225e-08_r8,0.30991e-07_r8,0.36244e-07_r8,0.39880e-07_r8,0.42596e-07_r8, & + & 0.44752e-07_r8,0.47132e-07_r8,0.56253e-07_r8,0.37250e-07_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.16586e-08_r8,0.29152e-07_r8,0.32988e-07_r8,0.35508e-07_r8,0.37264e-07_r8, & + & 0.38387e-07_r8,0.39417e-07_r8,0.42936e-07_r8,0.29439e-07_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.53935e-09_r8,0.13922e-07_r8,0.15779e-07_r8,0.16979e-07_r8,0.18157e-07_r8, & + & 0.19199e-07_r8,0.22168e-07_r8,0.31060e-07_r8,0.13772e-07_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.69404e-09_r8,0.16220e-07_r8,0.18381e-07_r8,0.19646e-07_r8,0.20841e-07_r8, & + & 0.22407e-07_r8,0.23846e-07_r8,0.31992e-07_r8,0.15532e-07_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.86327e-09_r8,0.18514e-07_r8,0.20845e-07_r8,0.22209e-07_r8,0.23196e-07_r8, & + & 0.24396e-07_r8,0.27026e-07_r8,0.31067e-07_r8,0.17116e-07_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.10436e-08_r8,0.20666e-07_r8,0.23248e-07_r8,0.24835e-07_r8,0.25904e-07_r8, & + & 0.26757e-07_r8,0.28384e-07_r8,0.33085e-07_r8,0.19320e-07_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.12327e-08_r8,0.26056e-07_r8,0.30481e-07_r8,0.33580e-07_r8,0.35908e-07_r8, & + & 0.37744e-07_r8,0.39586e-07_r8,0.45434e-07_r8,0.29787e-07_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.36905e-09_r8,0.10245e-07_r8,0.11596e-07_r8,0.12576e-07_r8,0.13293e-07_r8, & + & 0.14477e-07_r8,0.18355e-07_r8,0.25395e-07_r8,0.95950e-08_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.48708e-09_r8,0.12119e-07_r8,0.13746e-07_r8,0.14791e-07_r8,0.15718e-07_r8, & + & 0.16646e-07_r8,0.18396e-07_r8,0.25737e-07_r8,0.10793e-07_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.61847e-09_r8,0.13998e-07_r8,0.15813e-07_r8,0.16851e-07_r8,0.17722e-07_r8, & + & 0.19232e-07_r8,0.20414e-07_r8,0.25223e-07_r8,0.12354e-07_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.76052e-09_r8,0.15846e-07_r8,0.17816e-07_r8,0.18991e-07_r8,0.19806e-07_r8, & + & 0.20628e-07_r8,0.23016e-07_r8,0.25874e-07_r8,0.14269e-07_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.91109e-09_r8,0.20382e-07_r8,0.23823e-07_r8,0.26180e-07_r8,0.27929e-07_r8, & + & 0.29345e-07_r8,0.31039e-07_r8,0.38471e-07_r8,0.22626e-07_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.24637e-09_r8,0.74144e-08_r8,0.83997e-08_r8,0.90789e-08_r8,0.97769e-08_r8, & + & 0.11308e-07_r8,0.14223e-07_r8,0.20837e-07_r8,0.66398e-08_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.33527e-09_r8,0.89450e-08_r8,0.10119e-07_r8,0.10892e-07_r8,0.11613e-07_r8, & + & 0.12382e-07_r8,0.14900e-07_r8,0.20638e-07_r8,0.76422e-08_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.43587e-09_r8,0.10479e-07_r8,0.11902e-07_r8,0.12737e-07_r8,0.13564e-07_r8, & + & 0.14416e-07_r8,0.15545e-07_r8,0.21677e-07_r8,0.89455e-08_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.54672e-09_r8,0.12017e-07_r8,0.13540e-07_r8,0.14423e-07_r8,0.15090e-07_r8, & + & 0.16030e-07_r8,0.17496e-07_r8,0.20678e-07_r8,0.10490e-07_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.66579e-09_r8,0.13493e-07_r8,0.15163e-07_r8,0.16178e-07_r8,0.16873e-07_r8, & + & 0.17474e-07_r8,0.18852e-07_r8,0.21699e-07_r8,0.12216e-07_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.16149e-09_r8,0.53201e-08_r8,0.60079e-08_r8,0.65349e-08_r8,0.72837e-08_r8, & + & 0.90792e-08_r8,0.11028e-07_r8,0.15917e-07_r8,0.45574e-08_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.22765e-09_r8,0.65457e-08_r8,0.74143e-08_r8,0.80126e-08_r8,0.85152e-08_r8, & + & 0.94934e-08_r8,0.12210e-07_r8,0.16917e-07_r8,0.54301e-08_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.30418e-09_r8,0.77971e-08_r8,0.88287e-08_r8,0.94927e-08_r8,0.10154e-07_r8, & + & 0.10712e-07_r8,0.12099e-07_r8,0.16996e-07_r8,0.64594e-08_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.38990e-09_r8,0.90563e-08_r8,0.10243e-07_r8,0.10928e-07_r8,0.11554e-07_r8, & + & 0.12512e-07_r8,0.13254e-07_r8,0.17320e-07_r8,0.76835e-08_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.48334e-09_r8,0.10307e-07_r8,0.11588e-07_r8,0.12345e-07_r8,0.12884e-07_r8, & + & 0.13512e-07_r8,0.15051e-07_r8,0.17108e-07_r8,0.90662e-08_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.10442e-09_r8,0.37895e-08_r8,0.42781e-08_r8,0.47285e-08_r8,0.55672e-08_r8, & + & 0.67246e-08_r8,0.87615e-08_r8,0.12496e-07_r8,0.31063e-08_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.15294e-09_r8,0.47545e-08_r8,0.53771e-08_r8,0.58176e-08_r8,0.63249e-08_r8, & + & 0.74935e-08_r8,0.93024e-08_r8,0.13484e-07_r8,0.38514e-08_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.21056e-09_r8,0.57727e-08_r8,0.65270e-08_r8,0.70416e-08_r8,0.74786e-08_r8, & + & 0.80475e-08_r8,0.10012e-07_r8,0.13784e-07_r8,0.46496e-08_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.27636e-09_r8,0.67987e-08_r8,0.77111e-08_r8,0.82983e-08_r8,0.87947e-08_r8, & + & 0.93313e-08_r8,0.10204e-07_r8,0.14244e-07_r8,0.56141e-08_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.34924e-09_r8,0.78297e-08_r8,0.88319e-08_r8,0.94055e-08_r8,0.98667e-08_r8, & + & 0.10620e-07_r8,0.11396e-07_r8,0.13825e-07_r8,0.67139e-08_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.66385e-10_r8,0.26743e-08_r8,0.30313e-08_r8,0.34595e-08_r8,0.42156e-08_r8, & + & 0.50940e-08_r8,0.66728e-08_r8,0.10021e-07_r8,0.20965e-08_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.10109e-09_r8,0.34278e-08_r8,0.38685e-08_r8,0.42217e-08_r8,0.47673e-08_r8, & + & 0.59120e-08_r8,0.72992e-08_r8,0.10438e-07_r8,0.27321e-08_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.14405e-09_r8,0.42386e-08_r8,0.48029e-08_r8,0.51840e-08_r8,0.55416e-08_r8, & + & 0.62759e-08_r8,0.79851e-08_r8,0.11314e-07_r8,0.33332e-08_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.19414e-09_r8,0.50774e-08_r8,0.57440e-08_r8,0.61764e-08_r8,0.66005e-08_r8, & + & 0.69887e-08_r8,0.81552e-08_r8,0.11319e-07_r8,0.40828e-08_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.25056e-09_r8,0.59198e-08_r8,0.67025e-08_r8,0.71627e-08_r8,0.76155e-08_r8, & + & 0.81557e-08_r8,0.87035e-08_r8,0.11788e-07_r8,0.49512e-08_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.43147e-10_r8,0.19136e-08_r8,0.21883e-08_r8,0.26153e-08_r8,0.31055e-08_r8, & + & 0.39720e-08_r8,0.51107e-08_r8,0.84498e-08_r8,0.15100e-08_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.68069e-10_r8,0.25012e-08_r8,0.28230e-08_r8,0.31278e-08_r8,0.37084e-08_r8, & + & 0.44577e-08_r8,0.58316e-08_r8,0.82732e-08_r8,0.20294e-08_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.10013e-09_r8,0.31445e-08_r8,0.35530e-08_r8,0.38466e-08_r8,0.41961e-08_r8, & + & 0.50063e-08_r8,0.61960e-08_r8,0.89421e-08_r8,0.24447e-08_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.13837e-09_r8,0.38258e-08_r8,0.43236e-08_r8,0.46732e-08_r8,0.49545e-08_r8, & + & 0.53447e-08_r8,0.67172e-08_r8,0.92217e-08_r8,0.30274e-08_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.18212e-09_r8,0.45123e-08_r8,0.51146e-08_r8,0.55026e-08_r8,0.58368e-08_r8, & + & 0.61896e-08_r8,0.67974e-08_r8,0.94910e-08_r8,0.36975e-08_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.35238e-10_r8,0.15650e-08_r8,0.17900e-08_r8,0.21398e-08_r8,0.25395e-08_r8, & + & 0.32442e-08_r8,0.41684e-08_r8,0.68456e-08_r8,0.12890e-08_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.55588e-10_r8,0.20451e-08_r8,0.23079e-08_r8,0.25570e-08_r8,0.30342e-08_r8, & + & 0.36465e-08_r8,0.47717e-08_r8,0.67353e-08_r8,0.16499e-08_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.81825e-10_r8,0.25719e-08_r8,0.29058e-08_r8,0.31458e-08_r8,0.34324e-08_r8, & + & 0.40982e-08_r8,0.50669e-08_r8,0.73083e-08_r8,0.20031e-08_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.11311e-09_r8,0.31293e-08_r8,0.35365e-08_r8,0.38229e-08_r8,0.40518e-08_r8, & + & 0.43730e-08_r8,0.54993e-08_r8,0.75470e-08_r8,0.24754e-08_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.14891e-09_r8,0.36915e-08_r8,0.41839e-08_r8,0.45010e-08_r8,0.47744e-08_r8, & + & 0.50622e-08_r8,0.55621e-08_r8,0.77689e-08_r8,0.30237e-08_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.28851e-10_r8,0.12816e-08_r8,0.14656e-08_r8,0.17508e-08_r8,0.20791e-08_r8, & + & 0.26542e-08_r8,0.34061e-08_r8,0.55940e-08_r8,0.10876e-08_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.45511e-10_r8,0.16747e-08_r8,0.18898e-08_r8,0.20935e-08_r8,0.24841e-08_r8, & + & 0.29844e-08_r8,0.39040e-08_r8,0.54988e-08_r8,0.13569e-08_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.66972e-10_r8,0.21053e-08_r8,0.23788e-08_r8,0.25750e-08_r8,0.28091e-08_r8, & + & 0.33541e-08_r8,0.41474e-08_r8,0.59783e-08_r8,0.16488e-08_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.92606e-10_r8,0.25620e-08_r8,0.28952e-08_r8,0.31304e-08_r8,0.33162e-08_r8, & + & 0.35801e-08_r8,0.45003e-08_r8,0.61789e-08_r8,0.20293e-08_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.12192e-09_r8,0.30226e-08_r8,0.34255e-08_r8,0.36843e-08_r8,0.39084e-08_r8, & + & 0.41445e-08_r8,0.45524e-08_r8,0.63605e-08_r8,0.24756e-08_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.23621e-10_r8,0.10494e-08_r8,0.11996e-08_r8,0.14331e-08_r8,0.17023e-08_r8, & + & 0.21711e-08_r8,0.27844e-08_r8,0.45532e-08_r8,0.89489e-09_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.37261e-10_r8,0.13712e-08_r8,0.15471e-08_r8,0.17138e-08_r8,0.20333e-08_r8, & + & 0.24433e-08_r8,0.31958e-08_r8,0.44925e-08_r8,0.11124e-08_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.54831e-10_r8,0.17238e-08_r8,0.19475e-08_r8,0.21082e-08_r8,0.23003e-08_r8, & + & 0.27446e-08_r8,0.33959e-08_r8,0.48947e-08_r8,0.13514e-08_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.75799e-10_r8,0.20971e-08_r8,0.23698e-08_r8,0.25624e-08_r8,0.27143e-08_r8, & + & 0.29304e-08_r8,0.36822e-08_r8,0.50589e-08_r8,0.16628e-08_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.99820e-10_r8,0.24745e-08_r8,0.28041e-08_r8,0.30159e-08_r8,0.31995e-08_r8, & + & 0.33924e-08_r8,0.37279e-08_r8,0.52074e-08_r8,0.20270e-08_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.13785e-07_r8,0.24738e-06_r8,0.32984e-06_r8,0.38970e-06_r8,0.43737e-06_r8, & + & 0.50889e-06_r8,0.56985e-06_r8,0.52821e-06_r8,0.22857e-06_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.15768e-07_r8,0.27583e-06_r8,0.36371e-06_r8,0.42333e-06_r8,0.46175e-06_r8, & + & 0.50608e-06_r8,0.57108e-06_r8,0.57199e-06_r8,0.21992e-06_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.17740e-07_r8,0.31295e-06_r8,0.41668e-06_r8,0.48111e-06_r8,0.52105e-06_r8, & + & 0.56257e-06_r8,0.61638e-06_r8,0.64253e-06_r8,0.25630e-06_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.19676e-07_r8,0.33378e-06_r8,0.43874e-06_r8,0.50021e-06_r8,0.53506e-06_r8, & + & 0.56909e-06_r8,0.60800e-06_r8,0.63155e-06_r8,0.24206e-06_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.21537e-07_r8,0.36160e-06_r8,0.47596e-06_r8,0.54056e-06_r8,0.57557e-06_r8, & + & 0.60002e-06_r8,0.61606e-06_r8,0.61827e-06_r8,0.25207e-06_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.10621e-07_r8,0.19636e-06_r8,0.26336e-06_r8,0.31062e-06_r8,0.35012e-06_r8, & + & 0.41219e-06_r8,0.46827e-06_r8,0.42345e-06_r8,0.16044e-06_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.12238e-07_r8,0.21970e-06_r8,0.28920e-06_r8,0.33755e-06_r8,0.37073e-06_r8, & + & 0.41004e-06_r8,0.46315e-06_r8,0.45777e-06_r8,0.15877e-06_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.13863e-07_r8,0.24955e-06_r8,0.33252e-06_r8,0.38359e-06_r8,0.41679e-06_r8, & + & 0.45237e-06_r8,0.50277e-06_r8,0.51752e-06_r8,0.18617e-06_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.15467e-07_r8,0.27294e-06_r8,0.36292e-06_r8,0.41560e-06_r8,0.44818e-06_r8, & + & 0.47909e-06_r8,0.51811e-06_r8,0.54528e-06_r8,0.19311e-06_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.17013e-07_r8,0.28946e-06_r8,0.38040e-06_r8,0.43177e-06_r8,0.46055e-06_r8, & + & 0.48627e-06_r8,0.50036e-06_r8,0.50711e-06_r8,0.19056e-06_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.79041e-08_r8,0.15193e-06_r8,0.20367e-06_r8,0.24255e-06_r8,0.27584e-06_r8, & + & 0.33106e-06_r8,0.39018e-06_r8,0.33367e-06_r8,0.10147e-06_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.92256e-08_r8,0.17005e-06_r8,0.22457e-06_r8,0.26442e-06_r8,0.29755e-06_r8, & + & 0.33937e-06_r8,0.38659e-06_r8,0.36019e-06_r8,0.10982e-06_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.10548e-07_r8,0.18874e-06_r8,0.24827e-06_r8,0.28648e-06_r8,0.31109e-06_r8, & + & 0.33996e-06_r8,0.38319e-06_r8,0.38934e-06_r8,0.11953e-06_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.11869e-07_r8,0.21314e-06_r8,0.28402e-06_r8,0.32565e-06_r8,0.35249e-06_r8, & + & 0.38039e-06_r8,0.41637e-06_r8,0.43423e-06_r8,0.13779e-06_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.13170e-07_r8,0.22682e-06_r8,0.29805e-06_r8,0.33849e-06_r8,0.36193e-06_r8, & + & 0.38387e-06_r8,0.41078e-06_r8,0.42298e-06_r8,0.13819e-06_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.57872e-08_r8,0.11704e-06_r8,0.15599e-06_r8,0.19092e-06_r8,0.22043e-06_r8, & + & 0.26778e-06_r8,0.30128e-06_r8,0.25769e-06_r8,0.68111e-07_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.68505e-08_r8,0.13037e-06_r8,0.17389e-06_r8,0.20556e-06_r8,0.23194e-06_r8, & + & 0.27485e-06_r8,0.31447e-06_r8,0.28139e-06_r8,0.78259e-07_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.79353e-08_r8,0.14574e-06_r8,0.19135e-06_r8,0.22328e-06_r8,0.24623e-06_r8, & + & 0.27497e-06_r8,0.31125e-06_r8,0.30440e-06_r8,0.85397e-07_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.90207e-08_r8,0.16075e-06_r8,0.21140e-06_r8,0.24210e-06_r8,0.26199e-06_r8, & + & 0.28412e-06_r8,0.31832e-06_r8,0.32424e-06_r8,0.93374e-07_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.10099e-07_r8,0.18068e-06_r8,0.24072e-06_r8,0.27515e-06_r8,0.29704e-06_r8, & + & 0.31830e-06_r8,0.34575e-06_r8,0.36301e-06_r8,0.10959e-06_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.42071e-08_r8,0.88799e-07_r8,0.11974e-06_r8,0.15503e-06_r8,0.18473e-06_r8, & + & 0.21750e-06_r8,0.23111e-06_r8,0.19568e-06_r8,0.47645e-07_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.50589e-08_r8,0.10003e-06_r8,0.13353e-06_r8,0.15994e-06_r8,0.18265e-06_r8, & + & 0.22030e-06_r8,0.25851e-06_r8,0.22196e-06_r8,0.56400e-07_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.59363e-08_r8,0.11183e-06_r8,0.14743e-06_r8,0.17446e-06_r8,0.19617e-06_r8, & + & 0.22887e-06_r8,0.25813e-06_r8,0.23893e-06_r8,0.62471e-07_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.68265e-08_r8,0.12408e-06_r8,0.16316e-06_r8,0.18879e-06_r8,0.20540e-06_r8, & + & 0.22681e-06_r8,0.25640e-06_r8,0.25817e-06_r8,0.69233e-07_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.77164e-08_r8,0.14022e-06_r8,0.18715e-06_r8,0.21470e-06_r8,0.23265e-06_r8, & + & 0.25223e-06_r8,0.27783e-06_r8,0.28837e-06_r8,0.82855e-07_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.30108e-08_r8,0.66997e-07_r8,0.92811e-07_r8,0.12074e-06_r8,0.15295e-06_r8, & + & 0.17839e-06_r8,0.17246e-06_r8,0.14892e-06_r8,0.33739e-07_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.36900e-08_r8,0.76605e-07_r8,0.10196e-06_r8,0.12672e-06_r8,0.14857e-06_r8, & + & 0.17805e-06_r8,0.19825e-06_r8,0.16899e-06_r8,0.40438e-07_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.43974e-08_r8,0.85358e-07_r8,0.11411e-06_r8,0.13507e-06_r8,0.15283e-06_r8, & + & 0.18257e-06_r8,0.21172e-06_r8,0.18597e-06_r8,0.46134e-07_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.51213e-08_r8,0.95538e-07_r8,0.12544e-06_r8,0.14691e-06_r8,0.16455e-06_r8, & + & 0.18481e-06_r8,0.20979e-06_r8,0.20070e-06_r8,0.51618e-07_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.58500e-08_r8,0.10543e-06_r8,0.13870e-06_r8,0.15918e-06_r8,0.17259e-06_r8, & + & 0.18830e-06_r8,0.21165e-06_r8,0.21507e-06_r8,0.58184e-07_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.21343e-08_r8,0.50731e-07_r8,0.73677e-07_r8,0.95876e-07_r8,0.12180e-06_r8, & + & 0.14539e-06_r8,0.12792e-06_r8,0.11548e-06_r8,0.24049e-07_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.26695e-08_r8,0.57886e-07_r8,0.78431e-07_r8,0.10179e-06_r8,0.12404e-06_r8, & + & 0.14498e-06_r8,0.15075e-06_r8,0.12789e-06_r8,0.28929e-07_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.32350e-08_r8,0.65356e-07_r8,0.87120e-07_r8,0.10537e-06_r8,0.12108e-06_r8, & + & 0.14722e-06_r8,0.16980e-06_r8,0.14529e-06_r8,0.34426e-07_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.38202e-08_r8,0.73009e-07_r8,0.96634e-07_r8,0.11454e-06_r8,0.12893e-06_r8, & + & 0.15239e-06_r8,0.17280e-06_r8,0.15699e-06_r8,0.38936e-07_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.44151e-08_r8,0.81203e-07_r8,0.10676e-06_r8,0.12425e-06_r8,0.13576e-06_r8, & + & 0.15119e-06_r8,0.17122e-06_r8,0.16974e-06_r8,0.43692e-07_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.15010e-08_r8,0.38595e-07_r8,0.58295e-07_r8,0.77729e-07_r8,0.98683e-07_r8, & + & 0.10992e-06_r8,0.95145e-07_r8,0.92252e-07_r8,0.17319e-07_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.19201e-08_r8,0.43791e-07_r8,0.61750e-07_r8,0.79921e-07_r8,0.10136e-06_r8, & + & 0.11894e-06_r8,0.11276e-06_r8,0.97846e-07_r8,0.20720e-07_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.23693e-08_r8,0.50071e-07_r8,0.66873e-07_r8,0.85063e-07_r8,0.10052e-06_r8, & + & 0.11892e-06_r8,0.13009e-06_r8,0.11045e-06_r8,0.25527e-07_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.28395e-08_r8,0.55947e-07_r8,0.74757e-07_r8,0.88934e-07_r8,0.10114e-06_r8, & + & 0.12142e-06_r8,0.14341e-06_r8,0.12281e-06_r8,0.28938e-07_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.33227e-08_r8,0.62620e-07_r8,0.82343e-07_r8,0.96807e-07_r8,0.10922e-06_r8, & + & 0.12542e-06_r8,0.14247e-06_r8,0.13252e-06_r8,0.32804e-07_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.10437e-08_r8,0.30107e-07_r8,0.47694e-07_r8,0.63218e-07_r8,0.80199e-07_r8, & + & 0.81465e-07_r8,0.70748e-07_r8,0.72461e-07_r8,0.12620e-07_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.13691e-08_r8,0.33315e-07_r8,0.48674e-07_r8,0.63756e-07_r8,0.81165e-07_r8, & + & 0.96892e-07_r8,0.83814e-07_r8,0.76311e-07_r8,0.14799e-07_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.17229e-08_r8,0.37985e-07_r8,0.51777e-07_r8,0.67272e-07_r8,0.83770e-07_r8, & + & 0.97220e-07_r8,0.98951e-07_r8,0.84136e-07_r8,0.18369e-07_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.20990e-08_r8,0.43091e-07_r8,0.57320e-07_r8,0.69933e-07_r8,0.81214e-07_r8, & + & 0.98518e-07_r8,0.11188e-06_r8,0.95453e-07_r8,0.21724e-07_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.24895e-08_r8,0.48030e-07_r8,0.63808e-07_r8,0.75595e-07_r8,0.85237e-07_r8, & + & 0.10122e-06_r8,0.11598e-06_r8,0.10350e-06_r8,0.24792e-07_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.73565e-09_r8,0.23201e-07_r8,0.38192e-07_r8,0.51890e-07_r8,0.66677e-07_r8, & + & 0.60941e-07_r8,0.53794e-07_r8,0.57060e-07_r8,0.95538e-08_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.98838e-09_r8,0.25706e-07_r8,0.38945e-07_r8,0.51950e-07_r8,0.65881e-07_r8, & + & 0.73501e-07_r8,0.63459e-07_r8,0.61276e-07_r8,0.10909e-07_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.12675e-08_r8,0.29153e-07_r8,0.41180e-07_r8,0.53354e-07_r8,0.67729e-07_r8, & + & 0.79616e-07_r8,0.75117e-07_r8,0.65122e-07_r8,0.13531e-07_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.15675e-08_r8,0.33329e-07_r8,0.44560e-07_r8,0.57066e-07_r8,0.67627e-07_r8, & + & 0.79638e-07_r8,0.86678e-07_r8,0.73448e-07_r8,0.16804e-07_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.18817e-08_r8,0.37257e-07_r8,0.49746e-07_r8,0.59306e-07_r8,0.67554e-07_r8, & + & 0.81218e-07_r8,0.96337e-07_r8,0.82154e-07_r8,0.18958e-07_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.60140e-09_r8,0.19007e-07_r8,0.31253e-07_r8,0.42433e-07_r8,0.54566e-07_r8, & + & 0.50044e-07_r8,0.44177e-07_r8,0.46695e-07_r8,0.77009e-08_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.80782e-09_r8,0.21033e-07_r8,0.31865e-07_r8,0.42505e-07_r8,0.53930e-07_r8, & + & 0.60271e-07_r8,0.51969e-07_r8,0.49836e-07_r8,0.88971e-08_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.10365e-08_r8,0.23860e-07_r8,0.33711e-07_r8,0.43668e-07_r8,0.55447e-07_r8, & + & 0.65129e-07_r8,0.61514e-07_r8,0.53242e-07_r8,0.11044e-07_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.12819e-08_r8,0.27278e-07_r8,0.36477e-07_r8,0.46671e-07_r8,0.55334e-07_r8, & + & 0.65191e-07_r8,0.70955e-07_r8,0.60123e-07_r8,0.13732e-07_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.15394e-08_r8,0.30488e-07_r8,0.40723e-07_r8,0.48551e-07_r8,0.55301e-07_r8, & + & 0.66490e-07_r8,0.78877e-07_r8,0.67264e-07_r8,0.15488e-07_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.49234e-09_r8,0.15554e-07_r8,0.25575e-07_r8,0.34616e-07_r8,0.44615e-07_r8, & + & 0.41056e-07_r8,0.36097e-07_r8,0.38091e-07_r8,0.62448e-08_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.66141e-09_r8,0.17225e-07_r8,0.26080e-07_r8,0.34787e-07_r8,0.44118e-07_r8, & + & 0.49432e-07_r8,0.42531e-07_r8,0.40718e-07_r8,0.72624e-08_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.84839e-09_r8,0.19539e-07_r8,0.27604e-07_r8,0.35754e-07_r8,0.45370e-07_r8, & + & 0.53306e-07_r8,0.50418e-07_r8,0.43565e-07_r8,0.90256e-08_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.10495e-08_r8,0.22342e-07_r8,0.29867e-07_r8,0.38196e-07_r8,0.45322e-07_r8, & + & 0.53368e-07_r8,0.58112e-07_r8,0.49244e-07_r8,0.11197e-07_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.12604e-08_r8,0.24969e-07_r8,0.33348e-07_r8,0.39742e-07_r8,0.45269e-07_r8, & + & 0.54454e-07_r8,0.64580e-07_r8,0.55079e-07_r8,0.12657e-07_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.40306e-09_r8,0.12738e-07_r8,0.20936e-07_r8,0.28312e-07_r8,0.36505e-07_r8, & + & 0.33674e-07_r8,0.29525e-07_r8,0.31139e-07_r8,0.51040e-08_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.54151e-09_r8,0.14106e-07_r8,0.21346e-07_r8,0.28471e-07_r8,0.36139e-07_r8, & + & 0.40516e-07_r8,0.34830e-07_r8,0.33325e-07_r8,0.59425e-08_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.69468e-09_r8,0.15999e-07_r8,0.22600e-07_r8,0.29268e-07_r8,0.37150e-07_r8, & + & 0.43635e-07_r8,0.41297e-07_r8,0.35646e-07_r8,0.73862e-08_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.85913e-09_r8,0.18290e-07_r8,0.24452e-07_r8,0.31282e-07_r8,0.37096e-07_r8, & + & 0.43709e-07_r8,0.47585e-07_r8,0.40319e-07_r8,0.91581e-08_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.10319e-08_r8,0.20440e-07_r8,0.27299e-07_r8,0.32532e-07_r8,0.37047e-07_r8, & + & 0.44575e-07_r8,0.52880e-07_r8,0.45086e-07_r8,0.10367e-07_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.77542e-07_r8,0.72331e-06_r8,0.98561e-06_r8,0.11860e-05_r8,0.13497e-05_r8, & + & 0.13448e-05_r8,0.13214e-05_r8,0.14401e-05_r8,0.51217e-06_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.83965e-07_r8,0.81202e-06_r8,0.11096e-05_r8,0.13150e-05_r8,0.14966e-05_r8, & + & 0.14837e-05_r8,0.13715e-05_r8,0.14446e-05_r8,0.53558e-06_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.89893e-07_r8,0.91147e-06_r8,0.12494e-05_r8,0.14817e-05_r8,0.16581e-05_r8, & + & 0.16379e-05_r8,0.14913e-05_r8,0.13540e-05_r8,0.57527e-06_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.95336e-07_r8,0.98977e-06_r8,0.13580e-05_r8,0.16044e-05_r8,0.17602e-05_r8, & + & 0.17289e-05_r8,0.15601e-05_r8,0.13435e-05_r8,0.60153e-06_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.10024e-06_r8,0.10817e-05_r8,0.14820e-05_r8,0.17354e-05_r8,0.18806e-05_r8, & + & 0.18468e-05_r8,0.16817e-05_r8,0.14550e-05_r8,0.63092e-06_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.61222e-07_r8,0.57382e-06_r8,0.78272e-06_r8,0.94950e-06_r8,0.10796e-05_r8, & + & 0.10829e-05_r8,0.10794e-05_r8,0.12292e-05_r8,0.35440e-06_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.66652e-07_r8,0.64604e-06_r8,0.88511e-06_r8,0.10523e-05_r8,0.12028e-05_r8, & + & 0.11924e-05_r8,0.11103e-05_r8,0.11987e-05_r8,0.38232e-06_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.71672e-07_r8,0.73084e-06_r8,0.10012e-05_r8,0.11880e-05_r8,0.13384e-05_r8, & + & 0.13220e-05_r8,0.12030e-05_r8,0.11381e-05_r8,0.43262e-06_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.76301e-07_r8,0.80259e-06_r8,0.11033e-05_r8,0.13071e-05_r8,0.14343e-05_r8, & + & 0.14171e-05_r8,0.12785e-05_r8,0.11080e-05_r8,0.46030e-06_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.80500e-07_r8,0.87105e-06_r8,0.11939e-05_r8,0.14005e-05_r8,0.15153e-05_r8, & + & 0.14864e-05_r8,0.13529e-05_r8,0.11688e-05_r8,0.48117e-06_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.47304e-07_r8,0.44051e-06_r8,0.60584e-06_r8,0.74769e-06_r8,0.84468e-06_r8, & + & 0.85077e-06_r8,0.85665e-06_r8,0.10494e-05_r8,0.24668e-06_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.51943e-07_r8,0.50181e-06_r8,0.68762e-06_r8,0.82034e-06_r8,0.93657e-06_r8, & + & 0.92789e-06_r8,0.88766e-06_r8,0.99297e-06_r8,0.26836e-06_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.56252e-07_r8,0.56363e-06_r8,0.77259e-06_r8,0.91469e-06_r8,0.10403e-05_r8, & + & 0.10243e-05_r8,0.93713e-06_r8,0.99098e-06_r8,0.29882e-06_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.60224e-07_r8,0.63130e-06_r8,0.86724e-06_r8,0.10288e-05_r8,0.11344e-05_r8, & + & 0.11222e-05_r8,0.10162e-05_r8,0.91320e-06_r8,0.33854e-06_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.63868e-07_r8,0.68673e-06_r8,0.94084e-06_r8,0.11069e-05_r8,0.12001e-05_r8, & + & 0.11819e-05_r8,0.10625e-05_r8,0.91639e-06_r8,0.36042e-06_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.36151e-07_r8,0.33292e-06_r8,0.46957e-06_r8,0.57176e-06_r8,0.64965e-06_r8, & + & 0.66578e-06_r8,0.71030e-06_r8,0.90686e-06_r8,0.17407e-06_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.40107e-07_r8,0.38424e-06_r8,0.52571e-06_r8,0.63554e-06_r8,0.72553e-06_r8, & + & 0.72856e-06_r8,0.72697e-06_r8,0.84339e-06_r8,0.19253e-06_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.43816e-07_r8,0.43401e-06_r8,0.59546e-06_r8,0.70644e-06_r8,0.80752e-06_r8, & + & 0.79519e-06_r8,0.74520e-06_r8,0.81506e-06_r8,0.21830e-06_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.47242e-07_r8,0.48695e-06_r8,0.66577e-06_r8,0.78531e-06_r8,0.87970e-06_r8, & + & 0.86799e-06_r8,0.78705e-06_r8,0.76812e-06_r8,0.24161e-06_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.50394e-07_r8,0.54183e-06_r8,0.74240e-06_r8,0.87572e-06_r8,0.95669e-06_r8, & + & 0.94640e-06_r8,0.85379e-06_r8,0.74722e-06_r8,0.28102e-06_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.27462e-07_r8,0.25134e-06_r8,0.35698e-06_r8,0.43146e-06_r8,0.48552e-06_r8, & + & 0.53177e-06_r8,0.62976e-06_r8,0.75904e-06_r8,0.12452e-06_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.30835e-07_r8,0.29261e-06_r8,0.40164e-06_r8,0.49701e-06_r8,0.56250e-06_r8, & + & 0.56722e-06_r8,0.57761e-06_r8,0.72004e-06_r8,0.13996e-06_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.33997e-07_r8,0.33394e-06_r8,0.45684e-06_r8,0.54380e-06_r8,0.62140e-06_r8, & + & 0.61241e-06_r8,0.60037e-06_r8,0.67265e-06_r8,0.16106e-06_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.36946e-07_r8,0.37590e-06_r8,0.51390e-06_r8,0.60628e-06_r8,0.69027e-06_r8, & + & 0.67692e-06_r8,0.62237e-06_r8,0.67035e-06_r8,0.18128e-06_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.39670e-07_r8,0.42211e-06_r8,0.57710e-06_r8,0.68190e-06_r8,0.75209e-06_r8, & + & 0.74450e-06_r8,0.67496e-06_r8,0.61709e-06_r8,0.21416e-06_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.20602e-07_r8,0.18703e-06_r8,0.26972e-06_r8,0.33456e-06_r8,0.36532e-06_r8, & + & 0.42767e-06_r8,0.56721e-06_r8,0.66482e-06_r8,0.87936e-07_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.23484e-07_r8,0.21971e-06_r8,0.30953e-06_r8,0.37643e-06_r8,0.42627e-06_r8, & + & 0.44517e-06_r8,0.48560e-06_r8,0.61604e-06_r8,0.10185e-06_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.26181e-07_r8,0.25382e-06_r8,0.34607e-06_r8,0.41971e-06_r8,0.47851e-06_r8, & + & 0.48129e-06_r8,0.48156e-06_r8,0.56916e-06_r8,0.11864e-06_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.28705e-07_r8,0.28735e-06_r8,0.39181e-06_r8,0.46499e-06_r8,0.52971e-06_r8, & + & 0.52262e-06_r8,0.49397e-06_r8,0.54792e-06_r8,0.13605e-06_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.31065e-07_r8,0.32265e-06_r8,0.43948e-06_r8,0.51712e-06_r8,0.58131e-06_r8, & + & 0.57275e-06_r8,0.52154e-06_r8,0.53300e-06_r8,0.15326e-06_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.15315e-07_r8,0.13867e-06_r8,0.20497e-06_r8,0.25791e-06_r8,0.28251e-06_r8, & + & 0.36209e-06_r8,0.48615e-06_r8,0.57617e-06_r8,0.62083e-07_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.17770e-07_r8,0.16467e-06_r8,0.23430e-06_r8,0.28445e-06_r8,0.31749e-06_r8, & + & 0.35373e-06_r8,0.43530e-06_r8,0.51750e-06_r8,0.74598e-07_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.20071e-07_r8,0.19194e-06_r8,0.26349e-06_r8,0.32575e-06_r8,0.37090e-06_r8, & + & 0.37391e-06_r8,0.38838e-06_r8,0.49613e-06_r8,0.88392e-07_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.22230e-07_r8,0.21953e-06_r8,0.29840e-06_r8,0.35680e-06_r8,0.40841e-06_r8, & + & 0.40516e-06_r8,0.40513e-06_r8,0.45518e-06_r8,0.10149e-06_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.24244e-07_r8,0.24730e-06_r8,0.33583e-06_r8,0.39740e-06_r8,0.45364e-06_r8, & + & 0.44496e-06_r8,0.41471e-06_r8,0.45022e-06_r8,0.11554e-06_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.11318e-07_r8,0.10309e-06_r8,0.15679e-06_r8,0.19765e-06_r8,0.22300e-06_r8, & + & 0.30242e-06_r8,0.40824e-06_r8,0.49442e-06_r8,0.44061e-07_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.13358e-07_r8,0.12273e-06_r8,0.17705e-06_r8,0.22062e-06_r8,0.24115e-06_r8, & + & 0.28999e-06_r8,0.39012e-06_r8,0.45451e-06_r8,0.54847e-07_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.15323e-07_r8,0.14448e-06_r8,0.20316e-06_r8,0.24566e-06_r8,0.27787e-06_r8, & + & 0.29655e-06_r8,0.33237e-06_r8,0.41480e-06_r8,0.64157e-07_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.17158e-07_r8,0.16673e-06_r8,0.22673e-06_r8,0.27760e-06_r8,0.31491e-06_r8, & + & 0.31778e-06_r8,0.31818e-06_r8,0.38422e-06_r8,0.75698e-07_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.18880e-07_r8,0.18905e-06_r8,0.25711e-06_r8,0.30558e-06_r8,0.34820e-06_r8, & + & 0.34226e-06_r8,0.32757e-06_r8,0.36903e-06_r8,0.87559e-07_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.83060e-08_r8,0.76710e-07_r8,0.11565e-06_r8,0.14764e-06_r8,0.17329e-06_r8, & + & 0.25783e-06_r8,0.35957e-06_r8,0.41243e-06_r8,0.31797e-07_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.99651e-08_r8,0.91242e-07_r8,0.13632e-06_r8,0.17065e-06_r8,0.18967e-06_r8, & + & 0.24393e-06_r8,0.32914e-06_r8,0.39160e-06_r8,0.39225e-07_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.11621e-07_r8,0.10845e-06_r8,0.15426e-06_r8,0.18813e-06_r8,0.20803e-06_r8, & + & 0.23565e-06_r8,0.29600e-06_r8,0.35083e-06_r8,0.47417e-07_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.13182e-07_r8,0.12617e-06_r8,0.17363e-06_r8,0.21434e-06_r8,0.24338e-06_r8, & + & 0.24767e-06_r8,0.26174e-06_r8,0.33967e-06_r8,0.56851e-07_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.14647e-07_r8,0.14462e-06_r8,0.19609e-06_r8,0.23554e-06_r8,0.26966e-06_r8, & + & 0.27000e-06_r8,0.26860e-06_r8,0.30941e-06_r8,0.65848e-07_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.61513e-08_r8,0.59201e-07_r8,0.89564e-07_r8,0.11096e-06_r8,0.13963e-06_r8, & + & 0.22868e-06_r8,0.30519e-06_r8,0.34949e-06_r8,0.23910e-07_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.74969e-08_r8,0.68921e-07_r8,0.10513e-06_r8,0.13256e-06_r8,0.14959e-06_r8, & + & 0.20339e-06_r8,0.27500e-06_r8,0.33281e-06_r8,0.28611e-07_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.88625e-08_r8,0.82016e-07_r8,0.11818e-06_r8,0.14725e-06_r8,0.16097e-06_r8, & + & 0.19608e-06_r8,0.26185e-06_r8,0.30530e-06_r8,0.35935e-07_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.10184e-07_r8,0.96432e-07_r8,0.13542e-06_r8,0.16348e-06_r8,0.18477e-06_r8, & + & 0.19886e-06_r8,0.22449e-06_r8,0.27787e-06_r8,0.42133e-07_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.11421e-07_r8,0.11117e-06_r8,0.15107e-06_r8,0.18528e-06_r8,0.21005e-06_r8, & + & 0.21209e-06_r8,0.21257e-06_r8,0.25796e-06_r8,0.49988e-07_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.50310e-08_r8,0.48563e-07_r8,0.73473e-07_r8,0.91094e-07_r8,0.11455e-06_r8, & + & 0.18734e-06_r8,0.24995e-06_r8,0.28620e-06_r8,0.19440e-07_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.61304e-08_r8,0.56532e-07_r8,0.86340e-07_r8,0.10878e-06_r8,0.12244e-06_r8, & + & 0.16646e-06_r8,0.22541e-06_r8,0.27316e-06_r8,0.23338e-07_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.72491e-08_r8,0.67226e-07_r8,0.96798e-07_r8,0.12061e-06_r8,0.13181e-06_r8, & + & 0.16043e-06_r8,0.21436e-06_r8,0.24928e-06_r8,0.29352e-07_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.83326e-08_r8,0.78998e-07_r8,0.11085e-06_r8,0.13391e-06_r8,0.15135e-06_r8, & + & 0.16281e-06_r8,0.18360e-06_r8,0.22741e-06_r8,0.34425e-07_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.93458e-08_r8,0.91055e-07_r8,0.12364e-06_r8,0.15181e-06_r8,0.17196e-06_r8, & + & 0.17367e-06_r8,0.17400e-06_r8,0.21108e-06_r8,0.40855e-07_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.41189e-08_r8,0.39856e-07_r8,0.60140e-07_r8,0.74963e-07_r8,0.94012e-07_r8, & + & 0.15333e-06_r8,0.20441e-06_r8,0.23474e-06_r8,0.15853e-07_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.50193e-08_r8,0.46348e-07_r8,0.70855e-07_r8,0.89301e-07_r8,0.10040e-06_r8, & + & 0.13626e-06_r8,0.18429e-06_r8,0.22399e-06_r8,0.19078e-07_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.59344e-08_r8,0.55100e-07_r8,0.79255e-07_r8,0.98783e-07_r8,0.10799e-06_r8, & + & 0.13125e-06_r8,0.17544e-06_r8,0.20357e-06_r8,0.24013e-07_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.68228e-08_r8,0.64743e-07_r8,0.90843e-07_r8,0.10971e-06_r8,0.12396e-06_r8, & + & 0.13321e-06_r8,0.15026e-06_r8,0.18611e-06_r8,0.28198e-07_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.76512e-08_r8,0.74591e-07_r8,0.10123e-06_r8,0.12433e-06_r8,0.14085e-06_r8, & + & 0.14222e-06_r8,0.14246e-06_r8,0.17276e-06_r8,0.33441e-07_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.33724e-08_r8,0.32680e-07_r8,0.49222e-07_r8,0.61513e-07_r8,0.77133e-07_r8, & + & 0.12555e-06_r8,0.16713e-06_r8,0.19233e-06_r8,0.12966e-07_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.41100e-08_r8,0.37987e-07_r8,0.58121e-07_r8,0.73233e-07_r8,0.82218e-07_r8, & + & 0.11156e-06_r8,0.15077e-06_r8,0.18269e-06_r8,0.15614e-07_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.48589e-08_r8,0.45157e-07_r8,0.64912e-07_r8,0.80902e-07_r8,0.88466e-07_r8, & + & 0.10747e-06_r8,0.14360e-06_r8,0.16616e-06_r8,0.19653e-07_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.55845e-08_r8,0.53032e-07_r8,0.74357e-07_r8,0.89835e-07_r8,0.10150e-06_r8, & + & 0.10902e-06_r8,0.12309e-06_r8,0.15231e-06_r8,0.23083e-07_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.62642e-08_r8,0.61086e-07_r8,0.82886e-07_r8,0.10172e-06_r8,0.11529e-06_r8, & + & 0.11645e-06_r8,0.11667e-06_r8,0.14140e-06_r8,0.27368e-07_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.38523e-06_r8,0.18405e-05_r8,0.24561e-05_r8,0.26688e-05_r8,0.26627e-05_r8, & + & 0.26678e-05_r8,0.26221e-05_r8,0.23434e-05_r8,0.10243e-05_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.41258e-06_r8,0.20340e-05_r8,0.26799e-05_r8,0.29289e-05_r8,0.29138e-05_r8, & + & 0.29293e-05_r8,0.29106e-05_r8,0.25138e-05_r8,0.11179e-05_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.43826e-06_r8,0.22391e-05_r8,0.29055e-05_r8,0.31733e-05_r8,0.31848e-05_r8, & + & 0.32210e-05_r8,0.31726e-05_r8,0.29277e-05_r8,0.13122e-05_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.46214e-06_r8,0.24098e-05_r8,0.30735e-05_r8,0.33543e-05_r8,0.34157e-05_r8, & + & 0.34436e-05_r8,0.34008e-05_r8,0.32157e-05_r8,0.14111e-05_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.48360e-06_r8,0.25684e-05_r8,0.32470e-05_r8,0.35527e-05_r8,0.36650e-05_r8, & + & 0.37054e-05_r8,0.36463e-05_r8,0.35130e-05_r8,0.16128e-05_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.30632e-06_r8,0.14811e-05_r8,0.19813e-05_r8,0.21525e-05_r8,0.21480e-05_r8, & + & 0.21651e-05_r8,0.21352e-05_r8,0.19097e-05_r8,0.76078e-06_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.32924e-06_r8,0.16454e-05_r8,0.21736e-05_r8,0.23701e-05_r8,0.23496e-05_r8, & + & 0.23721e-05_r8,0.23664e-05_r8,0.20501e-05_r8,0.85884e-06_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.35084e-06_r8,0.18164e-05_r8,0.23625e-05_r8,0.25754e-05_r8,0.25799e-05_r8, & + & 0.26089e-05_r8,0.25758e-05_r8,0.23569e-05_r8,0.98156e-06_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.37092e-06_r8,0.19724e-05_r8,0.25182e-05_r8,0.27461e-05_r8,0.27987e-05_r8, & + & 0.28122e-05_r8,0.27766e-05_r8,0.26535e-05_r8,0.11297e-05_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.38936e-06_r8,0.20952e-05_r8,0.26519e-05_r8,0.29005e-05_r8,0.29889e-05_r8, & + & 0.30120e-05_r8,0.29564e-05_r8,0.28641e-05_r8,0.12488e-05_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.23924e-06_r8,0.11590e-05_r8,0.15536e-05_r8,0.16834e-05_r8,0.16891e-05_r8, & + & 0.17668e-05_r8,0.16904e-05_r8,0.15951e-05_r8,0.52632e-06_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.25864e-06_r8,0.12971e-05_r8,0.17221e-05_r8,0.18731e-05_r8,0.18563e-05_r8, & + & 0.18804e-05_r8,0.18628e-05_r8,0.16576e-05_r8,0.62738e-06_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.27696e-06_r8,0.14325e-05_r8,0.18710e-05_r8,0.20345e-05_r8,0.20276e-05_r8, & + & 0.20548e-05_r8,0.20259e-05_r8,0.17837e-05_r8,0.70461e-06_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.29413e-06_r8,0.15757e-05_r8,0.20191e-05_r8,0.22050e-05_r8,0.22319e-05_r8, & + & 0.22354e-05_r8,0.22195e-05_r8,0.20885e-05_r8,0.84521e-06_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.31013e-06_r8,0.16829e-05_r8,0.21333e-05_r8,0.23274e-05_r8,0.23871e-05_r8, & + & 0.23939e-05_r8,0.23475e-05_r8,0.22805e-05_r8,0.93762e-06_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.18537e-06_r8,0.89469e-06_r8,0.11953e-05_r8,0.13099e-05_r8,0.13271e-05_r8, & + & 0.13910e-05_r8,0.13233e-05_r8,0.12842e-05_r8,0.37595e-06_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.20178e-06_r8,0.10096e-05_r8,0.13476e-05_r8,0.14636e-05_r8,0.14567e-05_r8, & + & 0.14730e-05_r8,0.14642e-05_r8,0.13131e-05_r8,0.45273e-06_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.21732e-06_r8,0.11251e-05_r8,0.14779e-05_r8,0.16107e-05_r8,0.15945e-05_r8, & + & 0.16194e-05_r8,0.16016e-05_r8,0.14026e-05_r8,0.52023e-06_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.23198e-06_r8,0.12348e-05_r8,0.15955e-05_r8,0.17391e-05_r8,0.17432e-05_r8, & + & 0.17515e-05_r8,0.17226e-05_r8,0.15707e-05_r8,0.60921e-06_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.24566e-06_r8,0.13471e-05_r8,0.17138e-05_r8,0.18677e-05_r8,0.19071e-05_r8, & + & 0.19021e-05_r8,0.18647e-05_r8,0.18054e-05_r8,0.72437e-06_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.14315e-06_r8,0.68654e-06_r8,0.91703e-06_r8,0.10136e-05_r8,0.10640e-05_r8, & + & 0.10899e-05_r8,0.10066e-05_r8,0.10387e-05_r8,0.27115e-06_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.15693e-06_r8,0.78124e-06_r8,0.10460e-05_r8,0.11319e-05_r8,0.11350e-05_r8, & + & 0.11836e-05_r8,0.11463e-05_r8,0.10954e-05_r8,0.33462e-06_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.17013e-06_r8,0.87619e-06_r8,0.11607e-05_r8,0.12633e-05_r8,0.12502e-05_r8, & + & 0.12683e-05_r8,0.12476e-05_r8,0.11184e-05_r8,0.38421e-06_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.18255e-06_r8,0.96990e-06_r8,0.12617e-05_r8,0.13726e-05_r8,0.13641e-05_r8, & + & 0.13787e-05_r8,0.13521e-05_r8,0.11952e-05_r8,0.45446e-06_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.19427e-06_r8,0.10668e-05_r8,0.13642e-05_r8,0.14869e-05_r8,0.15021e-05_r8, & + & 0.14945e-05_r8,0.14801e-05_r8,0.13920e-05_r8,0.54371e-06_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.10978e-06_r8,0.52395e-06_r8,0.69476e-06_r8,0.76850e-06_r8,0.83675e-06_r8, & + & 0.86491e-06_r8,0.77625e-06_r8,0.85871e-06_r8,0.19533e-06_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.12132e-06_r8,0.59825e-06_r8,0.79672e-06_r8,0.87685e-06_r8,0.88945e-06_r8, & + & 0.93176e-06_r8,0.88241e-06_r8,0.87959e-06_r8,0.24185e-06_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.13245e-06_r8,0.67730e-06_r8,0.90458e-06_r8,0.97978e-06_r8,0.97457e-06_r8, & + & 0.98659e-06_r8,0.98199e-06_r8,0.88654e-06_r8,0.28188e-06_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.14304e-06_r8,0.75520e-06_r8,0.99285e-06_r8,0.10803e-05_r8,0.10647e-05_r8, & + & 0.10764e-05_r8,0.10623e-05_r8,0.93315e-06_r8,0.33738e-06_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.15298e-06_r8,0.83133e-06_r8,0.10714e-05_r8,0.11654e-05_r8,0.11612e-05_r8, & + & 0.11628e-05_r8,0.11409e-05_r8,0.10211e-05_r8,0.39343e-06_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.83795e-07_r8,0.39583e-06_r8,0.52221e-06_r8,0.57623e-06_r8,0.66801e-06_r8, & + & 0.68350e-06_r8,0.61427e-06_r8,0.74508e-06_r8,0.14027e-06_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.93456e-07_r8,0.45651e-06_r8,0.60707e-06_r8,0.67267e-06_r8,0.70886e-06_r8, & + & 0.72875e-06_r8,0.66655e-06_r8,0.70837e-06_r8,0.17333e-06_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.10278e-06_r8,0.52065e-06_r8,0.69548e-06_r8,0.75346e-06_r8,0.75243e-06_r8, & + & 0.79752e-06_r8,0.76130e-06_r8,0.73768e-06_r8,0.20746e-06_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.11172e-06_r8,0.58539e-06_r8,0.77614e-06_r8,0.84147e-06_r8,0.82956e-06_r8, & + & 0.83892e-06_r8,0.81830e-06_r8,0.74649e-06_r8,0.24711e-06_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.12020e-06_r8,0.64890e-06_r8,0.84430e-06_r8,0.91375e-06_r8,0.90365e-06_r8, & + & 0.91211e-06_r8,0.89073e-06_r8,0.78796e-06_r8,0.29290e-06_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.63771e-07_r8,0.29724e-06_r8,0.38901e-06_r8,0.42952e-06_r8,0.53569e-06_r8, & + & 0.52739e-06_r8,0.51421e-06_r8,0.65416e-06_r8,0.10106e-06_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.71835e-07_r8,0.34855e-06_r8,0.45895e-06_r8,0.50927e-06_r8,0.55878e-06_r8, & + & 0.57413e-06_r8,0.51386e-06_r8,0.58703e-06_r8,0.12396e-06_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.79626e-07_r8,0.39836e-06_r8,0.52930e-06_r8,0.58238e-06_r8,0.59321e-06_r8, & + & 0.61917e-06_r8,0.58275e-06_r8,0.59574e-06_r8,0.15556e-06_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.87141e-07_r8,0.45236e-06_r8,0.60287e-06_r8,0.64978e-06_r8,0.64621e-06_r8, & + & 0.65548e-06_r8,0.65037e-06_r8,0.59243e-06_r8,0.18170e-06_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.94308e-07_r8,0.50478e-06_r8,0.66216e-06_r8,0.71791e-06_r8,0.70542e-06_r8, & + & 0.71265e-06_r8,0.70440e-06_r8,0.61750e-06_r8,0.21806e-06_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.48334e-07_r8,0.22150e-06_r8,0.29066e-06_r8,0.32650e-06_r8,0.41774e-06_r8, & + & 0.40737e-06_r8,0.44502e-06_r8,0.56524e-06_r8,0.72879e-07_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.54994e-07_r8,0.26340e-06_r8,0.34441e-06_r8,0.38160e-06_r8,0.44410e-06_r8, & + & 0.45746e-06_r8,0.41390e-06_r8,0.50482e-06_r8,0.89924e-07_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.61501e-07_r8,0.30416e-06_r8,0.40299e-06_r8,0.44693e-06_r8,0.47253e-06_r8, & + & 0.48623e-06_r8,0.44624e-06_r8,0.47646e-06_r8,0.11220e-06_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.67792e-07_r8,0.34758e-06_r8,0.46191e-06_r8,0.50102e-06_r8,0.50055e-06_r8, & + & 0.52975e-06_r8,0.50335e-06_r8,0.48665e-06_r8,0.13456e-06_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.73830e-07_r8,0.39095e-06_r8,0.51738e-06_r8,0.55894e-06_r8,0.55048e-06_r8, & + & 0.55492e-06_r8,0.54317e-06_r8,0.49144e-06_r8,0.16088e-06_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.36931e-07_r8,0.16614e-06_r8,0.21895e-06_r8,0.26116e-06_r8,0.33023e-06_r8, & + & 0.31438e-06_r8,0.35810e-06_r8,0.46819e-06_r8,0.53649e-07_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.42386e-07_r8,0.20028e-06_r8,0.26120e-06_r8,0.28858e-06_r8,0.36090e-06_r8, & + & 0.35506e-06_r8,0.34639e-06_r8,0.43640e-06_r8,0.66551e-07_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.47801e-07_r8,0.23474e-06_r8,0.30842e-06_r8,0.34242e-06_r8,0.37552e-06_r8, & + & 0.38348e-06_r8,0.34637e-06_r8,0.39519e-06_r8,0.81897e-07_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.53030e-07_r8,0.26856e-06_r8,0.35532e-06_r8,0.39019e-06_r8,0.39727e-06_r8, & + & 0.41391e-06_r8,0.38815e-06_r8,0.39845e-06_r8,0.10316e-06_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.58073e-07_r8,0.30468e-06_r8,0.40415e-06_r8,0.43508e-06_r8,0.43212e-06_r8, & + & 0.43860e-06_r8,0.43462e-06_r8,0.39513e-06_r8,0.12065e-06_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.30210e-07_r8,0.13672e-06_r8,0.18028e-06_r8,0.21388e-06_r8,0.27067e-06_r8, & + & 0.25748e-06_r8,0.29347e-06_r8,0.38486e-06_r8,0.43992e-07_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.34676e-07_r8,0.16480e-06_r8,0.21447e-06_r8,0.23703e-06_r8,0.29658e-06_r8, & + & 0.29189e-06_r8,0.28346e-06_r8,0.35425e-06_r8,0.54558e-07_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.39112e-07_r8,0.19301e-06_r8,0.25343e-06_r8,0.28112e-06_r8,0.30767e-06_r8, & + & 0.31424e-06_r8,0.28354e-06_r8,0.32323e-06_r8,0.67060e-07_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.43392e-07_r8,0.22069e-06_r8,0.29158e-06_r8,0.31987e-06_r8,0.32514e-06_r8, & + & 0.33920e-06_r8,0.31782e-06_r8,0.32572e-06_r8,0.84444e-07_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.47520e-07_r8,0.25011e-06_r8,0.33134e-06_r8,0.35641e-06_r8,0.35390e-06_r8, & + & 0.35921e-06_r8,0.35594e-06_r8,0.32298e-06_r8,0.98845e-07_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.24733e-07_r8,0.11230e-06_r8,0.14856e-06_r8,0.17472e-06_r8,0.22197e-06_r8, & + & 0.21118e-06_r8,0.24122e-06_r8,0.31477e-06_r8,0.36119e-07_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.28389e-07_r8,0.13551e-06_r8,0.17612e-06_r8,0.19468e-06_r8,0.24363e-06_r8, & + & 0.23963e-06_r8,0.23290e-06_r8,0.28830e-06_r8,0.44709e-07_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.32017e-07_r8,0.15859e-06_r8,0.20791e-06_r8,0.23074e-06_r8,0.25230e-06_r8, & + & 0.25771e-06_r8,0.23238e-06_r8,0.26334e-06_r8,0.54941e-07_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.35526e-07_r8,0.18123e-06_r8,0.23912e-06_r8,0.26228e-06_r8,0.26637e-06_r8, & + & 0.27804e-06_r8,0.26039e-06_r8,0.26652e-06_r8,0.69162e-07_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.38912e-07_r8,0.20524e-06_r8,0.27165e-06_r8,0.29207e-06_r8,0.28991e-06_r8, & + & 0.29419e-06_r8,0.29154e-06_r8,0.26412e-06_r8,0.80995e-07_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.20250e-07_r8,0.92231e-07_r8,0.12203e-06_r8,0.14275e-06_r8,0.18179e-06_r8, & + & 0.17279e-06_r8,0.19796e-06_r8,0.25817e-06_r8,0.29574e-07_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.23243e-07_r8,0.11133e-06_r8,0.14442e-06_r8,0.15980e-06_r8,0.20001e-06_r8, & + & 0.19638e-06_r8,0.19075e-06_r8,0.23541e-06_r8,0.36618e-07_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.26215e-07_r8,0.13018e-06_r8,0.17053e-06_r8,0.18925e-06_r8,0.20654e-06_r8, & + & 0.21104e-06_r8,0.19040e-06_r8,0.21495e-06_r8,0.44987e-07_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.29082e-07_r8,0.14865e-06_r8,0.19601e-06_r8,0.21490e-06_r8,0.21820e-06_r8, & + & 0.22779e-06_r8,0.21313e-06_r8,0.21809e-06_r8,0.56635e-07_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.31856e-07_r8,0.16826e-06_r8,0.22260e-06_r8,0.23930e-06_r8,0.23753e-06_r8, & + & 0.24098e-06_r8,0.23875e-06_r8,0.21605e-06_r8,0.66316e-07_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.17059e-05_r8,0.38862e-05_r8,0.46330e-05_r8,0.51258e-05_r8,0.53516e-05_r8, & + & 0.52890e-05_r8,0.49050e-05_r8,0.49561e-05_r8,0.24914e-05_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.17702e-05_r8,0.41613e-05_r8,0.49979e-05_r8,0.55352e-05_r8,0.58535e-05_r8, & + & 0.58620e-05_r8,0.55540e-05_r8,0.53944e-05_r8,0.30111e-05_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.18268e-05_r8,0.44218e-05_r8,0.53631e-05_r8,0.59894e-05_r8,0.63892e-05_r8, & + & 0.64888e-05_r8,0.63488e-05_r8,0.59957e-05_r8,0.35253e-05_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.18763e-05_r8,0.46467e-05_r8,0.56969e-05_r8,0.64112e-05_r8,0.68701e-05_r8, & + & 0.70687e-05_r8,0.69575e-05_r8,0.65330e-05_r8,0.40117e-05_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.19168e-05_r8,0.48702e-05_r8,0.60413e-05_r8,0.68595e-05_r8,0.73828e-05_r8, & + & 0.76555e-05_r8,0.76620e-05_r8,0.72236e-05_r8,0.44814e-05_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.13807e-05_r8,0.32052e-05_r8,0.37981e-05_r8,0.41868e-05_r8,0.43666e-05_r8, & + & 0.42966e-05_r8,0.39397e-05_r8,0.40523e-05_r8,0.19972e-05_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.14355e-05_r8,0.34375e-05_r8,0.40968e-05_r8,0.45345e-05_r8,0.47869e-05_r8, & + & 0.47900e-05_r8,0.45121e-05_r8,0.44176e-05_r8,0.23759e-05_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.14839e-05_r8,0.36628e-05_r8,0.44128e-05_r8,0.49223e-05_r8,0.52399e-05_r8, & + & 0.53302e-05_r8,0.51982e-05_r8,0.49130e-05_r8,0.28052e-05_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.15261e-05_r8,0.38551e-05_r8,0.47116e-05_r8,0.52947e-05_r8,0.56758e-05_r8, & + & 0.58601e-05_r8,0.57606e-05_r8,0.54224e-05_r8,0.31665e-05_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.15621e-05_r8,0.40345e-05_r8,0.49797e-05_r8,0.56344e-05_r8,0.60672e-05_r8, & + & 0.63079e-05_r8,0.63076e-05_r8,0.59671e-05_r8,0.35368e-05_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.11048e-05_r8,0.25908e-05_r8,0.30458e-05_r8,0.33480e-05_r8,0.34767e-05_r8, & + & 0.33444e-05_r8,0.30982e-05_r8,0.31520e-05_r8,0.14943e-05_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.11526e-05_r8,0.27857e-05_r8,0.32915e-05_r8,0.36364e-05_r8,0.38272e-05_r8, & + & 0.38169e-05_r8,0.35492e-05_r8,0.35141e-05_r8,0.17575e-05_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.11948e-05_r8,0.29688e-05_r8,0.35427e-05_r8,0.39401e-05_r8,0.41747e-05_r8, & + & 0.42239e-05_r8,0.40766e-05_r8,0.39111e-05_r8,0.20688e-05_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.12319e-05_r8,0.31426e-05_r8,0.38135e-05_r8,0.42625e-05_r8,0.45635e-05_r8, & + & 0.47062e-05_r8,0.46027e-05_r8,0.43389e-05_r8,0.23873e-05_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.12642e-05_r8,0.32923e-05_r8,0.40402e-05_r8,0.45497e-05_r8,0.48934e-05_r8, & + & 0.50814e-05_r8,0.50577e-05_r8,0.47614e-05_r8,0.26860e-05_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.87810e-06_r8,0.20726e-05_r8,0.24188e-05_r8,0.26498e-05_r8,0.27201e-05_r8, & + & 0.25966e-05_r8,0.24215e-05_r8,0.25596e-05_r8,0.10910e-05_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.92113e-06_r8,0.22378e-05_r8,0.26243e-05_r8,0.28859e-05_r8,0.30228e-05_r8, & + & 0.29855e-05_r8,0.27257e-05_r8,0.28497e-05_r8,0.12952e-05_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.95847e-06_r8,0.23927e-05_r8,0.28323e-05_r8,0.31308e-05_r8,0.33238e-05_r8, & + & 0.33287e-05_r8,0.31597e-05_r8,0.31032e-05_r8,0.15368e-05_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.99115e-06_r8,0.25350e-05_r8,0.30423e-05_r8,0.33883e-05_r8,0.36085e-05_r8, & + & 0.36829e-05_r8,0.35850e-05_r8,0.33993e-05_r8,0.17502e-05_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.10199e-05_r8,0.26768e-05_r8,0.32656e-05_r8,0.36641e-05_r8,0.39303e-05_r8, & + & 0.40820e-05_r8,0.40444e-05_r8,0.38038e-05_r8,0.20588e-05_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.69521e-06_r8,0.16480e-05_r8,0.19136e-05_r8,0.20758e-05_r8,0.21053e-05_r8, & + & 0.19983e-05_r8,0.19384e-05_r8,0.21119e-05_r8,0.79759e-06_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.73399e-06_r8,0.17885e-05_r8,0.20863e-05_r8,0.22802e-05_r8,0.23681e-05_r8, & + & 0.23078e-05_r8,0.21093e-05_r8,0.21684e-05_r8,0.95048e-06_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.76704e-06_r8,0.19210e-05_r8,0.22551e-05_r8,0.24823e-05_r8,0.26201e-05_r8, & + & 0.26181e-05_r8,0.24369e-05_r8,0.24387e-05_r8,0.11396e-05_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.79598e-06_r8,0.20422e-05_r8,0.24305e-05_r8,0.26936e-05_r8,0.28610e-05_r8, & + & 0.28938e-05_r8,0.28032e-05_r8,0.26848e-05_r8,0.13054e-05_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.82146e-06_r8,0.21630e-05_r8,0.26149e-05_r8,0.29202e-05_r8,0.31281e-05_r8, & + & 0.32364e-05_r8,0.31639e-05_r8,0.29903e-05_r8,0.15503e-05_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.54790e-06_r8,0.12968e-05_r8,0.14998e-05_r8,0.16199e-05_r8,0.16168e-05_r8, & + & 0.15151e-05_r8,0.14932e-05_r8,0.16380e-05_r8,0.58437e-06_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.58180e-06_r8,0.14204e-05_r8,0.16474e-05_r8,0.17877e-05_r8,0.18382e-05_r8, & + & 0.17645e-05_r8,0.16359e-05_r8,0.17414e-05_r8,0.70191e-06_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.61169e-06_r8,0.15332e-05_r8,0.17837e-05_r8,0.19554e-05_r8,0.20462e-05_r8, & + & 0.20343e-05_r8,0.18483e-05_r8,0.19670e-05_r8,0.83824e-06_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.63729e-06_r8,0.16375e-05_r8,0.19280e-05_r8,0.21247e-05_r8,0.22559e-05_r8, & + & 0.22588e-05_r8,0.21468e-05_r8,0.21190e-05_r8,0.96829e-06_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.65987e-06_r8,0.17326e-05_r8,0.20710e-05_r8,0.23017e-05_r8,0.24525e-05_r8, & + & 0.25042e-05_r8,0.24377e-05_r8,0.23029e-05_r8,0.11330e-05_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.43067e-06_r8,0.10147e-05_r8,0.11663e-05_r8,0.12622e-05_r8,0.12316e-05_r8, & + & 0.11186e-05_r8,0.12227e-05_r8,0.12153e-05_r8,0.41960e-06_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.45965e-06_r8,0.11216e-05_r8,0.12929e-05_r8,0.13935e-05_r8,0.14129e-05_r8, & + & 0.13426e-05_r8,0.12944e-05_r8,0.14463e-05_r8,0.51416e-06_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.48636e-06_r8,0.12186e-05_r8,0.14109e-05_r8,0.15331e-05_r8,0.15936e-05_r8, & + & 0.15473e-05_r8,0.14164e-05_r8,0.14707e-05_r8,0.61314e-06_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.50928e-06_r8,0.13071e-05_r8,0.15237e-05_r8,0.16740e-05_r8,0.17644e-05_r8, & + & 0.17562e-05_r8,0.16373e-05_r8,0.16431e-05_r8,0.72862e-06_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.52919e-06_r8,0.13890e-05_r8,0.16443e-05_r8,0.18186e-05_r8,0.19296e-05_r8, & + & 0.19451e-05_r8,0.18786e-05_r8,0.17942e-05_r8,0.84235e-06_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.33792e-06_r8,0.78856e-06_r8,0.90464e-06_r8,0.98317e-06_r8,0.92848e-06_r8, & + & 0.86387e-06_r8,0.95438e-06_r8,0.90887e-06_r8,0.29529e-06_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.36263e-06_r8,0.88071e-06_r8,0.10121e-05_r8,0.10878e-05_r8,0.10817e-05_r8, & + & 0.10133e-05_r8,0.10031e-05_r8,0.11161e-05_r8,0.37413e-06_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.38563e-06_r8,0.96560e-06_r8,0.11116e-05_r8,0.12011e-05_r8,0.12324e-05_r8, & + & 0.11848e-05_r8,0.10927e-05_r8,0.11776e-05_r8,0.44987e-06_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.40622e-06_r8,0.10407e-05_r8,0.12047e-05_r8,0.13138e-05_r8,0.13745e-05_r8, & + & 0.13598e-05_r8,0.12356e-05_r8,0.13203e-05_r8,0.54288e-06_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.42386e-06_r8,0.11111e-05_r8,0.13019e-05_r8,0.14302e-05_r8,0.15146e-05_r8, & + & 0.15112e-05_r8,0.14255e-05_r8,0.14090e-05_r8,0.62729e-06_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.26432e-06_r8,0.60726e-06_r8,0.70036e-06_r8,0.76229e-06_r8,0.71577e-06_r8, & + & 0.69749e-06_r8,0.70164e-06_r8,0.72668e-06_r8,0.20659e-06_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.28549e-06_r8,0.68848e-06_r8,0.78705e-06_r8,0.84862e-06_r8,0.82241e-06_r8, & + & 0.74707e-06_r8,0.82519e-06_r8,0.82938e-06_r8,0.27449e-06_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.30511e-06_r8,0.76168e-06_r8,0.87199e-06_r8,0.93359e-06_r8,0.94531e-06_r8, & + & 0.89794e-06_r8,0.85947e-06_r8,0.97111e-06_r8,0.33410e-06_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.32329e-06_r8,0.82660e-06_r8,0.95163e-06_r8,0.10287e-05_r8,0.10680e-05_r8, & + & 0.10381e-05_r8,0.94558e-06_r8,0.98374e-06_r8,0.39896e-06_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.33897e-06_r8,0.88614e-06_r8,0.10276e-05_r8,0.11239e-05_r8,0.11817e-05_r8, & + & 0.11723e-05_r8,0.10892e-05_r8,0.10943e-05_r8,0.47438e-06_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.20748e-06_r8,0.47023e-06_r8,0.54165e-06_r8,0.58159e-06_r8,0.54422e-06_r8, & + & 0.55116e-06_r8,0.57712e-06_r8,0.60571e-06_r8,0.14752e-06_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.22561e-06_r8,0.54027e-06_r8,0.61555e-06_r8,0.66550e-06_r8,0.62550e-06_r8, & + & 0.58306e-06_r8,0.64781e-06_r8,0.63365e-06_r8,0.19821e-06_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.24219e-06_r8,0.60251e-06_r8,0.68703e-06_r8,0.73412e-06_r8,0.72965e-06_r8, & + & 0.68255e-06_r8,0.67291e-06_r8,0.76422e-06_r8,0.24874e-06_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.25766e-06_r8,0.65861e-06_r8,0.75375e-06_r8,0.81214e-06_r8,0.83171e-06_r8, & + & 0.80129e-06_r8,0.73385e-06_r8,0.78864e-06_r8,0.29867e-06_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.27157e-06_r8,0.70870e-06_r8,0.81638e-06_r8,0.88593e-06_r8,0.92651e-06_r8, & + & 0.91449e-06_r8,0.83048e-06_r8,0.88651e-06_r8,0.36087e-06_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.16984e-06_r8,0.38981e-06_r8,0.44742e-06_r8,0.48022e-06_r8,0.44950e-06_r8, & + & 0.45173e-06_r8,0.47333e-06_r8,0.50203e-06_r8,0.12166e-06_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.18466e-06_r8,0.44753e-06_r8,0.50754e-06_r8,0.54744e-06_r8,0.51342e-06_r8, & + & 0.47893e-06_r8,0.53296e-06_r8,0.51992e-06_r8,0.16283e-06_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.19826e-06_r8,0.49803e-06_r8,0.56578e-06_r8,0.60333e-06_r8,0.60031e-06_r8, & + & 0.56085e-06_r8,0.55152e-06_r8,0.63442e-06_r8,0.20412e-06_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.21087e-06_r8,0.54349e-06_r8,0.62058e-06_r8,0.66722e-06_r8,0.68339e-06_r8, & + & 0.65819e-06_r8,0.60140e-06_r8,0.64555e-06_r8,0.24501e-06_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.22228e-06_r8,0.58430e-06_r8,0.67139e-06_r8,0.72733e-06_r8,0.76067e-06_r8, & + & 0.75025e-06_r8,0.68133e-06_r8,0.72307e-06_r8,0.29566e-06_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.13908e-06_r8,0.32322e-06_r8,0.36926e-06_r8,0.39668e-06_r8,0.37094e-06_r8, & + & 0.37104e-06_r8,0.38736e-06_r8,0.41059e-06_r8,0.10018e-06_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.15119e-06_r8,0.37037e-06_r8,0.41804e-06_r8,0.44988e-06_r8,0.42138e-06_r8, & + & 0.39334e-06_r8,0.43800e-06_r8,0.42649e-06_r8,0.13384e-06_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.16232e-06_r8,0.41107e-06_r8,0.46554e-06_r8,0.49568e-06_r8,0.49349e-06_r8, & + & 0.46062e-06_r8,0.45205e-06_r8,0.52165e-06_r8,0.16749e-06_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.17268e-06_r8,0.44802e-06_r8,0.51028e-06_r8,0.54757e-06_r8,0.56096e-06_r8, & + & 0.54041e-06_r8,0.49303e-06_r8,0.52723e-06_r8,0.20095e-06_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.18199e-06_r8,0.48092e-06_r8,0.55149e-06_r8,0.59694e-06_r8,0.62405e-06_r8, & + & 0.61534e-06_r8,0.55851e-06_r8,0.58926e-06_r8,0.24228e-06_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.11387e-06_r8,0.26741e-06_r8,0.30441e-06_r8,0.32687e-06_r8,0.30479e-06_r8, & + & 0.30477e-06_r8,0.31768e-06_r8,0.33316e-06_r8,0.82090e-07_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.12381e-06_r8,0.30579e-06_r8,0.34391e-06_r8,0.36935e-06_r8,0.34578e-06_r8, & + & 0.32317e-06_r8,0.35995e-06_r8,0.35099e-06_r8,0.10981e-06_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.13290e-06_r8,0.33871e-06_r8,0.38265e-06_r8,0.40672e-06_r8,0.40511e-06_r8, & + & 0.37796e-06_r8,0.36986e-06_r8,0.42813e-06_r8,0.13721e-06_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.14135e-06_r8,0.36878e-06_r8,0.41898e-06_r8,0.44916e-06_r8,0.46012e-06_r8, & + & 0.44348e-06_r8,0.40383e-06_r8,0.43087e-06_r8,0.16460e-06_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.14898e-06_r8,0.39524e-06_r8,0.45245e-06_r8,0.48939e-06_r8,0.51148e-06_r8, & + & 0.50420e-06_r8,0.45753e-06_r8,0.48088e-06_r8,0.19843e-06_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.49835e-05_r8,0.73512e-05_r8,0.88016e-05_r8,0.97115e-05_r8,0.10342e-04_r8, & + & 0.10688e-04_r8,0.10747e-04_r8,0.97587e-05_r8,0.57353e-05_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.49823e-05_r8,0.77944e-05_r8,0.95403e-05_r8,0.10739e-04_r8,0.11522e-04_r8, & + & 0.11974e-04_r8,0.12019e-04_r8,0.11200e-04_r8,0.69362e-05_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.49638e-05_r8,0.82513e-05_r8,0.10343e-04_r8,0.11836e-04_r8,0.12804e-04_r8, & + & 0.13375e-04_r8,0.13427e-04_r8,0.12807e-04_r8,0.83325e-05_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.49300e-05_r8,0.87230e-05_r8,0.11131e-04_r8,0.12834e-04_r8,0.13980e-04_r8, & + & 0.14660e-04_r8,0.14790e-04_r8,0.14186e-04_r8,0.94893e-05_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.48886e-05_r8,0.92046e-05_r8,0.11933e-04_r8,0.13885e-04_r8,0.15255e-04_r8, & + & 0.16071e-04_r8,0.16239e-04_r8,0.15605e-04_r8,0.10917e-04_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.41174e-05_r8,0.62362e-05_r8,0.73897e-05_r8,0.81161e-05_r8,0.86061e-05_r8, & + & 0.88364e-05_r8,0.89272e-05_r8,0.81534e-05_r8,0.45187e-05_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.41154e-05_r8,0.66112e-05_r8,0.80274e-05_r8,0.90030e-05_r8,0.96264e-05_r8, & + & 0.99529e-05_r8,0.10004e-04_r8,0.93836e-05_r8,0.55300e-05_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.40999e-05_r8,0.69972e-05_r8,0.87232e-05_r8,0.99464e-05_r8,0.10738e-04_r8, & + & 0.11186e-04_r8,0.11235e-04_r8,0.10760e-04_r8,0.66656e-05_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.40728e-05_r8,0.73933e-05_r8,0.94032e-05_r8,0.10842e-04_r8,0.11807e-04_r8, & + & 0.12371e-04_r8,0.12495e-04_r8,0.12016e-04_r8,0.78073e-05_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.40371e-05_r8,0.77954e-05_r8,0.10060e-04_r8,0.11710e-04_r8,0.12855e-04_r8, & + & 0.13529e-04_r8,0.13658e-04_r8,0.13169e-04_r8,0.88462e-05_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.33911e-05_r8,0.51807e-05_r8,0.60524e-05_r8,0.65745e-05_r8,0.69209e-05_r8, & + & 0.70496e-05_r8,0.71376e-05_r8,0.64864e-05_r8,0.34232e-05_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.33916e-05_r8,0.54910e-05_r8,0.65875e-05_r8,0.73243e-05_r8,0.77878e-05_r8, & + & 0.79847e-05_r8,0.80332e-05_r8,0.75309e-05_r8,0.42228e-05_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.33813e-05_r8,0.58057e-05_r8,0.71503e-05_r8,0.80869e-05_r8,0.86798e-05_r8, & + & 0.89845e-05_r8,0.90042e-05_r8,0.85938e-05_r8,0.50519e-05_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.33618e-05_r8,0.61503e-05_r8,0.77470e-05_r8,0.88947e-05_r8,0.96421e-05_r8, & + & 0.10056e-04_r8,0.10131e-04_r8,0.97836e-05_r8,0.60817e-05_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.33346e-05_r8,0.64834e-05_r8,0.82992e-05_r8,0.96266e-05_r8,0.10527e-04_r8, & + & 0.11042e-04_r8,0.11154e-04_r8,0.10788e-04_r8,0.69208e-05_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.27862e-05_r8,0.42534e-05_r8,0.48987e-05_r8,0.52435e-05_r8,0.54733e-05_r8, & + & 0.55364e-05_r8,0.55872e-05_r8,0.49226e-05_r8,0.25436e-05_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.27893e-05_r8,0.45093e-05_r8,0.53394e-05_r8,0.58691e-05_r8,0.61855e-05_r8, & + & 0.63070e-05_r8,0.63399e-05_r8,0.58599e-05_r8,0.31726e-05_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.27843e-05_r8,0.47714e-05_r8,0.58075e-05_r8,0.65048e-05_r8,0.69158e-05_r8, & + & 0.71341e-05_r8,0.71529e-05_r8,0.67578e-05_r8,0.38485e-05_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.27713e-05_r8,0.50491e-05_r8,0.62824e-05_r8,0.71451e-05_r8,0.76931e-05_r8, & + & 0.79968e-05_r8,0.80403e-05_r8,0.77391e-05_r8,0.46093e-05_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.27517e-05_r8,0.53526e-05_r8,0.67897e-05_r8,0.78357e-05_r8,0.85357e-05_r8, & + & 0.89260e-05_r8,0.90160e-05_r8,0.87287e-05_r8,0.54226e-05_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.22852e-05_r8,0.34704e-05_r8,0.39351e-05_r8,0.41626e-05_r8,0.42797e-05_r8, & + & 0.43078e-05_r8,0.42289e-05_r8,0.36572e-05_r8,0.18725e-05_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.22904e-05_r8,0.36828e-05_r8,0.42969e-05_r8,0.46636e-05_r8,0.48818e-05_r8, & + & 0.49227e-05_r8,0.49640e-05_r8,0.45776e-05_r8,0.23620e-05_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.22883e-05_r8,0.38995e-05_r8,0.46830e-05_r8,0.51887e-05_r8,0.54814e-05_r8, & + & 0.56039e-05_r8,0.56350e-05_r8,0.52624e-05_r8,0.29139e-05_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.22808e-05_r8,0.41317e-05_r8,0.50763e-05_r8,0.57196e-05_r8,0.61208e-05_r8, & + & 0.63389e-05_r8,0.63549e-05_r8,0.60859e-05_r8,0.35219e-05_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.22671e-05_r8,0.43851e-05_r8,0.54991e-05_r8,0.62948e-05_r8,0.68249e-05_r8, & + & 0.71098e-05_r8,0.71755e-05_r8,0.69558e-05_r8,0.41900e-05_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.18699e-05_r8,0.28114e-05_r8,0.31400e-05_r8,0.32683e-05_r8,0.33153e-05_r8, & + & 0.33008e-05_r8,0.31920e-05_r8,0.27860e-05_r8,0.13420e-05_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.18773e-05_r8,0.29859e-05_r8,0.34309e-05_r8,0.36695e-05_r8,0.38007e-05_r8, & + & 0.38091e-05_r8,0.38180e-05_r8,0.34314e-05_r8,0.17179e-05_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.18783e-05_r8,0.31642e-05_r8,0.37448e-05_r8,0.40997e-05_r8,0.43019e-05_r8, & + & 0.43546e-05_r8,0.43740e-05_r8,0.40084e-05_r8,0.21605e-05_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.18743e-05_r8,0.33566e-05_r8,0.40684e-05_r8,0.45371e-05_r8,0.48151e-05_r8, & + & 0.49624e-05_r8,0.49624e-05_r8,0.47228e-05_r8,0.26431e-05_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.18657e-05_r8,0.35541e-05_r8,0.43955e-05_r8,0.49826e-05_r8,0.53649e-05_r8, & + & 0.55694e-05_r8,0.55990e-05_r8,0.54328e-05_r8,0.31359e-05_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.15270e-05_r8,0.22681e-05_r8,0.24953e-05_r8,0.25538e-05_r8,0.25397e-05_r8, & + & 0.25315e-05_r8,0.23299e-05_r8,0.21035e-05_r8,0.95748e-06_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.15365e-05_r8,0.24113e-05_r8,0.27304e-05_r8,0.28767e-05_r8,0.29339e-05_r8, & + & 0.29290e-05_r8,0.28728e-05_r8,0.24852e-05_r8,0.12383e-05_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.15398e-05_r8,0.25576e-05_r8,0.29821e-05_r8,0.32226e-05_r8,0.33508e-05_r8, & + & 0.33584e-05_r8,0.33733e-05_r8,0.31044e-05_r8,0.15900e-05_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.15385e-05_r8,0.27150e-05_r8,0.32458e-05_r8,0.35802e-05_r8,0.37697e-05_r8, & + & 0.38500e-05_r8,0.38510e-05_r8,0.36169e-05_r8,0.19605e-05_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.15336e-05_r8,0.28792e-05_r8,0.35139e-05_r8,0.39460e-05_r8,0.42149e-05_r8, & + & 0.43622e-05_r8,0.43664e-05_r8,0.42187e-05_r8,0.23523e-05_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.12444e-05_r8,0.18266e-05_r8,0.19784e-05_r8,0.19900e-05_r8,0.19390e-05_r8, & + & 0.19235e-05_r8,0.17231e-05_r8,0.16995e-05_r8,0.68590e-06_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.12557e-05_r8,0.19427e-05_r8,0.21667e-05_r8,0.22465e-05_r8,0.22625e-05_r8, & + & 0.22377e-05_r8,0.21596e-05_r8,0.18759e-05_r8,0.89490e-06_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.12608e-05_r8,0.20627e-05_r8,0.23694e-05_r8,0.25224e-05_r8,0.25961e-05_r8, & + & 0.25892e-05_r8,0.25887e-05_r8,0.23400e-05_r8,0.11490e-05_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.12616e-05_r8,0.21916e-05_r8,0.25816e-05_r8,0.28156e-05_r8,0.29418e-05_r8, & + & 0.29759e-05_r8,0.29788e-05_r8,0.27379e-05_r8,0.14416e-05_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.12590e-05_r8,0.23261e-05_r8,0.28013e-05_r8,0.31131e-05_r8,0.32990e-05_r8, & + & 0.33976e-05_r8,0.33946e-05_r8,0.32600e-05_r8,0.17529e-05_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.10123e-05_r8,0.14681e-05_r8,0.15612e-05_r8,0.15411e-05_r8,0.14778e-05_r8, & + & 0.14343e-05_r8,0.12992e-05_r8,0.13172e-05_r8,0.49290e-06_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.10245e-05_r8,0.15617e-05_r8,0.17149e-05_r8,0.17499e-05_r8,0.17312e-05_r8, & + & 0.17144e-05_r8,0.15772e-05_r8,0.14382e-05_r8,0.63132e-06_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.10311e-05_r8,0.16600e-05_r8,0.18786e-05_r8,0.19738e-05_r8,0.20017e-05_r8, & + & 0.19859e-05_r8,0.19416e-05_r8,0.17139e-05_r8,0.82278e-06_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.10334e-05_r8,0.17639e-05_r8,0.20493e-05_r8,0.22069e-05_r8,0.22845e-05_r8, & + & 0.22769e-05_r8,0.22855e-05_r8,0.21115e-05_r8,0.10531e-05_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.10328e-05_r8,0.18738e-05_r8,0.22265e-05_r8,0.24495e-05_r8,0.25737e-05_r8, & + & 0.26232e-05_r8,0.26173e-05_r8,0.24699e-05_r8,0.12950e-05_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.82261e-06_r8,0.11811e-05_r8,0.12403e-05_r8,0.12060e-05_r8,0.11493e-05_r8, & + & 0.10907e-05_r8,0.98035e-06_r8,0.10980e-05_r8,0.37316e-06_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.83528e-06_r8,0.12595e-05_r8,0.13646e-05_r8,0.13745e-05_r8,0.13365e-05_r8, & + & 0.13172e-05_r8,0.11846e-05_r8,0.11491e-05_r8,0.46158e-06_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.84255e-06_r8,0.13392e-05_r8,0.14968e-05_r8,0.15528e-05_r8,0.15573e-05_r8, & + & 0.15339e-05_r8,0.14802e-05_r8,0.12811e-05_r8,0.60300e-06_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.84587e-06_r8,0.14245e-05_r8,0.16355e-05_r8,0.17381e-05_r8,0.17835e-05_r8, & + & 0.17693e-05_r8,0.17683e-05_r8,0.16097e-05_r8,0.77730e-06_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.84627e-06_r8,0.15137e-05_r8,0.17779e-05_r8,0.19378e-05_r8,0.20192e-05_r8, & + & 0.20387e-05_r8,0.20340e-05_r8,0.18636e-05_r8,0.96863e-06_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.67388e-06_r8,0.97942e-06_r8,0.10286e-05_r8,0.10023e-05_r8,0.95317e-06_r8, & + & 0.90847e-06_r8,0.81776e-06_r8,0.89345e-06_r8,0.30408e-06_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.68407e-06_r8,0.10438e-05_r8,0.11334e-05_r8,0.11425e-05_r8,0.11096e-05_r8, & + & 0.10886e-05_r8,0.98240e-06_r8,0.94798e-06_r8,0.38086e-06_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.69000e-06_r8,0.11106e-05_r8,0.12435e-05_r8,0.12890e-05_r8,0.12895e-05_r8, & + & 0.12679e-05_r8,0.12202e-05_r8,0.10522e-05_r8,0.49623e-06_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.69276e-06_r8,0.11824e-05_r8,0.13564e-05_r8,0.14402e-05_r8,0.14763e-05_r8, & + & 0.14628e-05_r8,0.14599e-05_r8,0.13328e-05_r8,0.63979e-06_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.69302e-06_r8,0.12555e-05_r8,0.14740e-05_r8,0.16049e-05_r8,0.16694e-05_r8, & + & 0.16839e-05_r8,0.16772e-05_r8,0.15421e-05_r8,0.79514e-06_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.55214e-06_r8,0.81079e-06_r8,0.85249e-06_r8,0.83175e-06_r8,0.78783e-06_r8, & + & 0.75281e-06_r8,0.67567e-06_r8,0.74075e-06_r8,0.24910e-06_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.56029e-06_r8,0.86391e-06_r8,0.94032e-06_r8,0.94758e-06_r8,0.91883e-06_r8, & + & 0.89834e-06_r8,0.81189e-06_r8,0.77883e-06_r8,0.31399e-06_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.56504e-06_r8,0.92066e-06_r8,0.10308e-05_r8,0.10667e-05_r8,0.10655e-05_r8, & + & 0.10460e-05_r8,0.10067e-05_r8,0.87150e-06_r8,0.40815e-06_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.56721e-06_r8,0.97985e-06_r8,0.11224e-05_r8,0.11915e-05_r8,0.12197e-05_r8, & + & 0.12063e-05_r8,0.12014e-05_r8,0.10950e-05_r8,0.52630e-06_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.56742e-06_r8,0.10399e-05_r8,0.12195e-05_r8,0.13255e-05_r8,0.13771e-05_r8, & + & 0.13876e-05_r8,0.13807e-05_r8,0.12724e-05_r8,0.65264e-06_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.45223e-06_r8,0.67006e-06_r8,0.70582e-06_r8,0.68873e-06_r8,0.65038e-06_r8, & + & 0.62084e-06_r8,0.55442e-06_r8,0.60996e-06_r8,0.20428e-06_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.45880e-06_r8,0.71490e-06_r8,0.77859e-06_r8,0.78376e-06_r8,0.75834e-06_r8, & + & 0.73987e-06_r8,0.66959e-06_r8,0.63711e-06_r8,0.25817e-06_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.46276e-06_r8,0.76231e-06_r8,0.85214e-06_r8,0.88098e-06_r8,0.87867e-06_r8, & + & 0.86188e-06_r8,0.83033e-06_r8,0.72166e-06_r8,0.33548e-06_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.46442e-06_r8,0.81043e-06_r8,0.92714e-06_r8,0.98329e-06_r8,0.10050e-05_r8, & + & 0.99247e-06_r8,0.98770e-06_r8,0.89931e-06_r8,0.43220e-06_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.46456e-06_r8,0.86048e-06_r8,0.10065e-05_r8,0.10920e-05_r8,0.11333e-05_r8, & + & 0.11411e-05_r8,0.11342e-05_r8,0.10473e-05_r8,0.53527e-06_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.12335e-04_r8,0.15987e-04_r8,0.18565e-04_r8,0.20406e-04_r8,0.21636e-04_r8, & + & 0.22077e-04_r8,0.21364e-04_r8,0.19544e-04_r8,0.14733e-04_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.12351e-04_r8,0.17014e-04_r8,0.20216e-04_r8,0.22480e-04_r8,0.24098e-04_r8, & + & 0.24791e-04_r8,0.24379e-04_r8,0.22600e-04_r8,0.17292e-04_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.12364e-04_r8,0.18152e-04_r8,0.21907e-04_r8,0.24643e-04_r8,0.26659e-04_r8, & + & 0.27630e-04_r8,0.27512e-04_r8,0.25730e-04_r8,0.20236e-04_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.12365e-04_r8,0.19320e-04_r8,0.23679e-04_r8,0.26885e-04_r8,0.29225e-04_r8, & + & 0.30430e-04_r8,0.30461e-04_r8,0.28726e-04_r8,0.23208e-04_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.12355e-04_r8,0.20495e-04_r8,0.25505e-04_r8,0.29189e-04_r8,0.31816e-04_r8, & + & 0.33308e-04_r8,0.33478e-04_r8,0.31898e-04_r8,0.26469e-04_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.10350e-04_r8,0.13753e-04_r8,0.16101e-04_r8,0.17726e-04_r8,0.18733e-04_r8, & + & 0.19034e-04_r8,0.18319e-04_r8,0.16594e-04_r8,0.11961e-04_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.10365e-04_r8,0.14706e-04_r8,0.17542e-04_r8,0.19561e-04_r8,0.20895e-04_r8, & + & 0.21420e-04_r8,0.21012e-04_r8,0.19409e-04_r8,0.14130e-04_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.10364e-04_r8,0.15733e-04_r8,0.19081e-04_r8,0.21505e-04_r8,0.23181e-04_r8, & + & 0.23958e-04_r8,0.23844e-04_r8,0.22334e-04_r8,0.16750e-04_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.10354e-04_r8,0.16759e-04_r8,0.20670e-04_r8,0.23471e-04_r8,0.25440e-04_r8, & + & 0.26474e-04_r8,0.26560e-04_r8,0.25188e-04_r8,0.19386e-04_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.10329e-04_r8,0.17823e-04_r8,0.22292e-04_r8,0.25488e-04_r8,0.27703e-04_r8, & + & 0.28957e-04_r8,0.29205e-04_r8,0.27936e-04_r8,0.22026e-04_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.86408e-05_r8,0.11607e-04_r8,0.13624e-04_r8,0.14928e-04_r8,0.15622e-04_r8, & + & 0.15768e-04_r8,0.15034e-04_r8,0.13540e-04_r8,0.91950e-05_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.86478e-05_r8,0.12463e-04_r8,0.14889e-04_r8,0.16508e-04_r8,0.17482e-04_r8, & + & 0.17819e-04_r8,0.17439e-04_r8,0.15994e-04_r8,0.11026e-04_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.86444e-05_r8,0.13354e-04_r8,0.16234e-04_r8,0.18159e-04_r8,0.19394e-04_r8, & + & 0.19962e-04_r8,0.19837e-04_r8,0.18485e-04_r8,0.13087e-04_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.86273e-05_r8,0.14262e-04_r8,0.17647e-04_r8,0.19921e-04_r8,0.21457e-04_r8, & + & 0.22290e-04_r8,0.22338e-04_r8,0.21203e-04_r8,0.15397e-04_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.85960e-05_r8,0.15200e-04_r8,0.19031e-04_r8,0.21649e-04_r8,0.23415e-04_r8, & + & 0.24453e-04_r8,0.24660e-04_r8,0.23666e-04_r8,0.17582e-04_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.71803e-05_r8,0.97101e-05_r8,0.11373e-04_r8,0.12321e-04_r8,0.12789e-04_r8, & + & 0.12803e-04_r8,0.12062e-04_r8,0.10784e-04_r8,0.69624e-05_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.71855e-05_r8,0.10459e-04_r8,0.12456e-04_r8,0.13673e-04_r8,0.14371e-04_r8, & + & 0.14569e-04_r8,0.14153e-04_r8,0.12788e-04_r8,0.84564e-05_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.71795e-05_r8,0.11229e-04_r8,0.13608e-04_r8,0.15091e-04_r8,0.16013e-04_r8, & + & 0.16409e-04_r8,0.16232e-04_r8,0.15085e-04_r8,0.10120e-04_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.71584e-05_r8,0.12023e-04_r8,0.14800e-04_r8,0.16568e-04_r8,0.17732e-04_r8, & + & 0.18336e-04_r8,0.18317e-04_r8,0.17347e-04_r8,0.11917e-04_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.71267e-05_r8,0.12845e-04_r8,0.16058e-04_r8,0.18162e-04_r8,0.19580e-04_r8, & + & 0.20399e-04_r8,0.20543e-04_r8,0.19767e-04_r8,0.13958e-04_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.59442e-05_r8,0.80861e-05_r8,0.93878e-05_r8,0.10066e-04_r8,0.10362e-04_r8, & + & 0.10281e-04_r8,0.95734e-05_r8,0.84778e-05_r8,0.52204e-05_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.59498e-05_r8,0.87281e-05_r8,0.10301e-04_r8,0.11210e-04_r8,0.11702e-04_r8, & + & 0.11782e-04_r8,0.11315e-04_r8,0.10068e-04_r8,0.64302e-05_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.59430e-05_r8,0.93925e-05_r8,0.11277e-04_r8,0.12419e-04_r8,0.13099e-04_r8, & + & 0.13351e-04_r8,0.13104e-04_r8,0.12095e-04_r8,0.77633e-05_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.59217e-05_r8,0.10078e-04_r8,0.12288e-04_r8,0.13686e-04_r8,0.14573e-04_r8, & + & 0.14994e-04_r8,0.14908e-04_r8,0.14023e-04_r8,0.92337e-05_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.58935e-05_r8,0.10789e-04_r8,0.13390e-04_r8,0.15066e-04_r8,0.16172e-04_r8, & + & 0.16788e-04_r8,0.16832e-04_r8,0.16140e-04_r8,0.10913e-04_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.49077e-05_r8,0.66672e-05_r8,0.76412e-05_r8,0.81181e-05_r8,0.82831e-05_r8, & + & 0.81137e-05_r8,0.74381e-05_r8,0.64600e-05_r8,0.38540e-05_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.49136e-05_r8,0.72093e-05_r8,0.84100e-05_r8,0.90761e-05_r8,0.94026e-05_r8, & + & 0.93849e-05_r8,0.88761e-05_r8,0.77852e-05_r8,0.48097e-05_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.49088e-05_r8,0.77732e-05_r8,0.92304e-05_r8,0.10089e-04_r8,0.10581e-04_r8, & + & 0.10707e-04_r8,0.10412e-04_r8,0.94217e-05_r8,0.58741e-05_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.48919e-05_r8,0.83551e-05_r8,0.10086e-04_r8,0.11166e-04_r8,0.11831e-04_r8, & + & 0.12095e-04_r8,0.11941e-04_r8,0.11106e-04_r8,0.70559e-05_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.48652e-05_r8,0.89412e-05_r8,0.10983e-04_r8,0.12289e-04_r8,0.13118e-04_r8, & + & 0.13538e-04_r8,0.13477e-04_r8,0.12811e-04_r8,0.83378e-05_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.40428e-05_r8,0.54588e-05_r8,0.61687e-05_r8,0.64926e-05_r8,0.65568e-05_r8, & + & 0.63259e-05_r8,0.56948e-05_r8,0.49607e-05_r8,0.28237e-05_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.40484e-05_r8,0.59019e-05_r8,0.68052e-05_r8,0.72891e-05_r8,0.74881e-05_r8, & + & 0.73951e-05_r8,0.68736e-05_r8,0.59771e-05_r8,0.35700e-05_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.40443e-05_r8,0.63719e-05_r8,0.74936e-05_r8,0.81309e-05_r8,0.84699e-05_r8, & + & 0.84975e-05_r8,0.81643e-05_r8,0.72224e-05_r8,0.43995e-05_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.40304e-05_r8,0.68636e-05_r8,0.82100e-05_r8,0.90329e-05_r8,0.95142e-05_r8, & + & 0.96616e-05_r8,0.94576e-05_r8,0.86932e-05_r8,0.53385e-05_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.40097e-05_r8,0.73587e-05_r8,0.89665e-05_r8,0.99825e-05_r8,0.10592e-04_r8, & + & 0.10860e-04_r8,0.10751e-04_r8,0.10114e-04_r8,0.63905e-05_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.33247e-05_r8,0.44437e-05_r8,0.49476e-05_r8,0.51623e-05_r8,0.51521e-05_r8, & + & 0.48927e-05_r8,0.43130e-05_r8,0.36508e-05_r8,0.20433e-05_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.33302e-05_r8,0.48035e-05_r8,0.54757e-05_r8,0.58129e-05_r8,0.59219e-05_r8, & + & 0.57796e-05_r8,0.52788e-05_r8,0.45081e-05_r8,0.26233e-05_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.33275e-05_r8,0.51944e-05_r8,0.60436e-05_r8,0.65119e-05_r8,0.67329e-05_r8, & + & 0.66992e-05_r8,0.63336e-05_r8,0.54989e-05_r8,0.32839e-05_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.33167e-05_r8,0.56042e-05_r8,0.66425e-05_r8,0.72606e-05_r8,0.75965e-05_r8, & + & 0.76619e-05_r8,0.74319e-05_r8,0.66922e-05_r8,0.40228e-05_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.33014e-05_r8,0.60212e-05_r8,0.72748e-05_r8,0.80496e-05_r8,0.84940e-05_r8, & + & 0.86532e-05_r8,0.85181e-05_r8,0.78992e-05_r8,0.48672e-05_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.27310e-05_r8,0.35992e-05_r8,0.39468e-05_r8,0.40831e-05_r8,0.40161e-05_r8, & + & 0.37266e-05_r8,0.32070e-05_r8,0.27591e-05_r8,0.14628e-05_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.27361e-05_r8,0.38904e-05_r8,0.43781e-05_r8,0.46075e-05_r8,0.46475e-05_r8, & + & 0.44710e-05_r8,0.39993e-05_r8,0.33922e-05_r8,0.19203e-05_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.27349e-05_r8,0.42103e-05_r8,0.48448e-05_r8,0.51814e-05_r8,0.53150e-05_r8, & + & 0.52403e-05_r8,0.48712e-05_r8,0.41669e-05_r8,0.24268e-05_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.27270e-05_r8,0.45504e-05_r8,0.53414e-05_r8,0.57970e-05_r8,0.60255e-05_r8, & + & 0.60359e-05_r8,0.57915e-05_r8,0.51016e-05_r8,0.30070e-05_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.27146e-05_r8,0.48994e-05_r8,0.58660e-05_r8,0.64467e-05_r8,0.67684e-05_r8, & + & 0.68529e-05_r8,0.66981e-05_r8,0.61431e-05_r8,0.36677e-05_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.22419e-05_r8,0.29237e-05_r8,0.31619e-05_r8,0.32419e-05_r8,0.31445e-05_r8, & + & 0.28618e-05_r8,0.23945e-05_r8,0.20454e-05_r8,0.10493e-05_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.22458e-05_r8,0.31578e-05_r8,0.35134e-05_r8,0.36703e-05_r8,0.36665e-05_r8, & + & 0.34835e-05_r8,0.30593e-05_r8,0.25559e-05_r8,0.14125e-05_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.22450e-05_r8,0.34192e-05_r8,0.38967e-05_r8,0.41378e-05_r8,0.42160e-05_r8, & + & 0.41184e-05_r8,0.37724e-05_r8,0.31954e-05_r8,0.18099e-05_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.22393e-05_r8,0.36988e-05_r8,0.43039e-05_r8,0.46449e-05_r8,0.48027e-05_r8, & + & 0.47756e-05_r8,0.45281e-05_r8,0.39284e-05_r8,0.22652e-05_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.22295e-05_r8,0.39888e-05_r8,0.47391e-05_r8,0.51827e-05_r8,0.54135e-05_r8, & + & 0.54517e-05_r8,0.52919e-05_r8,0.47894e-05_r8,0.27859e-05_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.18412e-05_r8,0.24512e-05_r8,0.26550e-05_r8,0.27210e-05_r8,0.26438e-05_r8, & + & 0.24068e-05_r8,0.20134e-05_r8,0.16980e-05_r8,0.87310e-06_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.18429e-05_r8,0.26525e-05_r8,0.29507e-05_r8,0.30835e-05_r8,0.30829e-05_r8, & + & 0.29354e-05_r8,0.25810e-05_r8,0.21539e-05_r8,0.11715e-05_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.18405e-05_r8,0.28725e-05_r8,0.32735e-05_r8,0.34815e-05_r8,0.35507e-05_r8, & + & 0.34733e-05_r8,0.31901e-05_r8,0.26957e-05_r8,0.15018e-05_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.18348e-05_r8,0.31060e-05_r8,0.36191e-05_r8,0.39123e-05_r8,0.40426e-05_r8, & + & 0.40206e-05_r8,0.38184e-05_r8,0.33125e-05_r8,0.18804e-05_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.18263e-05_r8,0.33539e-05_r8,0.39862e-05_r8,0.43590e-05_r8,0.45516e-05_r8, & + & 0.45841e-05_r8,0.44525e-05_r8,0.40371e-05_r8,0.23130e-05_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.15111e-05_r8,0.20512e-05_r8,0.22220e-05_r8,0.22783e-05_r8,0.22181e-05_r8, & + & 0.20219e-05_r8,0.16992e-05_r8,0.14085e-05_r8,0.72438e-06_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.15111e-05_r8,0.22209e-05_r8,0.24719e-05_r8,0.25841e-05_r8,0.25877e-05_r8, & + & 0.24700e-05_r8,0.21742e-05_r8,0.18087e-05_r8,0.96963e-06_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.15082e-05_r8,0.24051e-05_r8,0.27419e-05_r8,0.29223e-05_r8,0.29832e-05_r8, & + & 0.29201e-05_r8,0.26833e-05_r8,0.22609e-05_r8,0.12444e-05_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.15029e-05_r8,0.26018e-05_r8,0.30364e-05_r8,0.32843e-05_r8,0.33933e-05_r8, & + & 0.33730e-05_r8,0.32057e-05_r8,0.27875e-05_r8,0.15571e-05_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.14954e-05_r8,0.28127e-05_r8,0.33443e-05_r8,0.36551e-05_r8,0.38145e-05_r8, & + & 0.38425e-05_r8,0.37317e-05_r8,0.33866e-05_r8,0.19133e-05_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.12390e-05_r8,0.17127e-05_r8,0.18553e-05_r8,0.19025e-05_r8,0.18568e-05_r8, & + & 0.16968e-05_r8,0.14297e-05_r8,0.11813e-05_r8,0.59950e-06_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.12381e-05_r8,0.18537e-05_r8,0.20641e-05_r8,0.21603e-05_r8,0.21689e-05_r8, & + & 0.20712e-05_r8,0.18216e-05_r8,0.15132e-05_r8,0.80096e-06_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.12352e-05_r8,0.20080e-05_r8,0.22929e-05_r8,0.24467e-05_r8,0.24992e-05_r8, & + & 0.24434e-05_r8,0.22447e-05_r8,0.18839e-05_r8,0.10290e-05_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.12307e-05_r8,0.21754e-05_r8,0.25409e-05_r8,0.27489e-05_r8,0.28366e-05_r8, & + & 0.28171e-05_r8,0.26776e-05_r8,0.23303e-05_r8,0.12853e-05_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.12246e-05_r8,0.23532e-05_r8,0.27977e-05_r8,0.30556e-05_r8,0.31857e-05_r8, & + & 0.32077e-05_r8,0.31127e-05_r8,0.28260e-05_r8,0.15788e-05_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.43566e-04_r8,0.45402e-04_r8,0.48829e-04_r8,0.50194e-04_r8,0.49978e-04_r8, & + & 0.48581e-04_r8,0.45902e-04_r8,0.40781e-04_r8,0.34170e-04_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.43974e-04_r8,0.47415e-04_r8,0.52012e-04_r8,0.54325e-04_r8,0.54921e-04_r8, & + & 0.53975e-04_r8,0.51279e-04_r8,0.46650e-04_r8,0.40945e-04_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.44333e-04_r8,0.49545e-04_r8,0.55453e-04_r8,0.58909e-04_r8,0.60094e-04_r8, & + & 0.59376e-04_r8,0.56940e-04_r8,0.52843e-04_r8,0.48266e-04_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.44647e-04_r8,0.51771e-04_r8,0.59155e-04_r8,0.63607e-04_r8,0.65306e-04_r8, & + & 0.64935e-04_r8,0.62961e-04_r8,0.59262e-04_r8,0.55812e-04_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.44938e-04_r8,0.54202e-04_r8,0.63063e-04_r8,0.68229e-04_r8,0.70615e-04_r8, & + & 0.70683e-04_r8,0.69315e-04_r8,0.65992e-04_r8,0.63855e-04_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.37849e-04_r8,0.40606e-04_r8,0.43836e-04_r8,0.45171e-04_r8,0.45318e-04_r8, & + & 0.44251e-04_r8,0.41853e-04_r8,0.37247e-04_r8,0.29303e-04_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.38202e-04_r8,0.42545e-04_r8,0.46901e-04_r8,0.49156e-04_r8,0.50002e-04_r8, & + & 0.49256e-04_r8,0.46845e-04_r8,0.42755e-04_r8,0.35187e-04_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.38525e-04_r8,0.44570e-04_r8,0.50219e-04_r8,0.53465e-04_r8,0.54833e-04_r8, & + & 0.54348e-04_r8,0.52176e-04_r8,0.48578e-04_r8,0.41697e-04_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.38828e-04_r8,0.46787e-04_r8,0.53767e-04_r8,0.57818e-04_r8,0.59705e-04_r8, & + & 0.59611e-04_r8,0.57787e-04_r8,0.54523e-04_r8,0.48350e-04_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.39076e-04_r8,0.49105e-04_r8,0.57380e-04_r8,0.62144e-04_r8,0.64743e-04_r8, & + & 0.65049e-04_r8,0.63700e-04_r8,0.60747e-04_r8,0.55348e-04_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.32392e-04_r8,0.35504e-04_r8,0.38232e-04_r8,0.39483e-04_r8,0.39809e-04_r8, & + & 0.39031e-04_r8,0.36901e-04_r8,0.32585e-04_r8,0.23735e-04_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.32715e-04_r8,0.37303e-04_r8,0.41039e-04_r8,0.43202e-04_r8,0.44102e-04_r8, & + & 0.43582e-04_r8,0.41484e-04_r8,0.37593e-04_r8,0.28689e-04_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.33011e-04_r8,0.39216e-04_r8,0.44127e-04_r8,0.47180e-04_r8,0.48515e-04_r8, & + & 0.48269e-04_r8,0.46352e-04_r8,0.42866e-04_r8,0.34062e-04_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.33271e-04_r8,0.41283e-04_r8,0.47451e-04_r8,0.51158e-04_r8,0.53031e-04_r8, & + & 0.53191e-04_r8,0.51599e-04_r8,0.48489e-04_r8,0.40122e-04_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.33495e-04_r8,0.43439e-04_r8,0.50779e-04_r8,0.55143e-04_r8,0.57687e-04_r8, & + & 0.58208e-04_r8,0.56935e-04_r8,0.54138e-04_r8,0.46109e-04_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.27415e-04_r8,0.30543e-04_r8,0.32764e-04_r8,0.33940e-04_r8,0.34340e-04_r8, & + & 0.33775e-04_r8,0.31812e-04_r8,0.27722e-04_r8,0.18770e-04_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.27715e-04_r8,0.32169e-04_r8,0.35304e-04_r8,0.37332e-04_r8,0.38224e-04_r8, & + & 0.37868e-04_r8,0.35986e-04_r8,0.32265e-04_r8,0.22928e-04_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.27982e-04_r8,0.33932e-04_r8,0.38141e-04_r8,0.40925e-04_r8,0.42223e-04_r8, & + & 0.42122e-04_r8,0.40409e-04_r8,0.37026e-04_r8,0.27474e-04_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.28215e-04_r8,0.35808e-04_r8,0.41184e-04_r8,0.44532e-04_r8,0.46320e-04_r8, & + & 0.46554e-04_r8,0.45091e-04_r8,0.41998e-04_r8,0.32462e-04_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.28437e-04_r8,0.37809e-04_r8,0.44202e-04_r8,0.48199e-04_r8,0.50577e-04_r8, & + & 0.51211e-04_r8,0.50186e-04_r8,0.47427e-04_r8,0.38088e-04_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.23010e-04_r8,0.25978e-04_r8,0.27838e-04_r8,0.28899e-04_r8,0.29286e-04_r8, & + & 0.28721e-04_r8,0.26945e-04_r8,0.23196e-04_r8,0.14687e-04_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.23283e-04_r8,0.27434e-04_r8,0.30115e-04_r8,0.31931e-04_r8,0.32743e-04_r8, & + & 0.32398e-04_r8,0.30674e-04_r8,0.27269e-04_r8,0.18140e-04_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.23522e-04_r8,0.29002e-04_r8,0.32686e-04_r8,0.35125e-04_r8,0.36325e-04_r8, & + & 0.36232e-04_r8,0.34626e-04_r8,0.31511e-04_r8,0.21987e-04_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.23738e-04_r8,0.30687e-04_r8,0.35404e-04_r8,0.38366e-04_r8,0.40013e-04_r8, & + & 0.40198e-04_r8,0.38830e-04_r8,0.35973e-04_r8,0.26236e-04_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.23936e-04_r8,0.32534e-04_r8,0.38093e-04_r8,0.41748e-04_r8,0.43875e-04_r8, & + & 0.44440e-04_r8,0.43519e-04_r8,0.40954e-04_r8,0.31086e-04_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.19172e-04_r8,0.21867e-04_r8,0.23409e-04_r8,0.24321e-04_r8,0.24529e-04_r8, & + & 0.23927e-04_r8,0.22333e-04_r8,0.18955e-04_r8,0.11218e-04_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.19419e-04_r8,0.23150e-04_r8,0.25412e-04_r8,0.26974e-04_r8,0.27574e-04_r8, & + & 0.27129e-04_r8,0.25625e-04_r8,0.22590e-04_r8,0.14082e-04_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.19636e-04_r8,0.24533e-04_r8,0.27708e-04_r8,0.29785e-04_r8,0.30733e-04_r8, & + & 0.30517e-04_r8,0.29114e-04_r8,0.26329e-04_r8,0.17293e-04_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.19836e-04_r8,0.26054e-04_r8,0.30093e-04_r8,0.32660e-04_r8,0.34002e-04_r8, & + & 0.34049e-04_r8,0.32819e-04_r8,0.30271e-04_r8,0.20869e-04_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.20002e-04_r8,0.27734e-04_r8,0.32461e-04_r8,0.35638e-04_r8,0.37355e-04_r8, & + & 0.37686e-04_r8,0.36788e-04_r8,0.34519e-04_r8,0.24769e-04_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.15886e-04_r8,0.18280e-04_r8,0.19557e-04_r8,0.20235e-04_r8,0.20297e-04_r8, & + & 0.19642e-04_r8,0.18202e-04_r8,0.15130e-04_r8,0.84335e-05_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.16105e-04_r8,0.19408e-04_r8,0.21322e-04_r8,0.22532e-04_r8,0.22888e-04_r8, & + & 0.22409e-04_r8,0.21064e-04_r8,0.18396e-04_r8,0.10766e-04_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.16304e-04_r8,0.20629e-04_r8,0.23329e-04_r8,0.24999e-04_r8,0.25612e-04_r8, & + & 0.25350e-04_r8,0.24115e-04_r8,0.21685e-04_r8,0.13408e-04_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.16482e-04_r8,0.21985e-04_r8,0.25409e-04_r8,0.27506e-04_r8,0.28475e-04_r8, & + & 0.28447e-04_r8,0.27347e-04_r8,0.25116e-04_r8,0.16377e-04_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.16621e-04_r8,0.23483e-04_r8,0.27507e-04_r8,0.30111e-04_r8,0.31449e-04_r8, & + & 0.31651e-04_r8,0.30823e-04_r8,0.28853e-04_r8,0.19647e-04_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.13104e-04_r8,0.15202e-04_r8,0.16227e-04_r8,0.16675e-04_r8,0.16618e-04_r8, & + & 0.15949e-04_r8,0.14642e-04_r8,0.11862e-04_r8,0.62741e-05_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.13296e-04_r8,0.16183e-04_r8,0.17762e-04_r8,0.18645e-04_r8,0.18799e-04_r8, & + & 0.18302e-04_r8,0.17108e-04_r8,0.14749e-04_r8,0.81431e-05_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.13475e-04_r8,0.17250e-04_r8,0.19501e-04_r8,0.20748e-04_r8,0.21144e-04_r8, & + & 0.20825e-04_r8,0.19726e-04_r8,0.17623e-04_r8,0.10291e-04_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.13631e-04_r8,0.18462e-04_r8,0.21319e-04_r8,0.22916e-04_r8,0.23622e-04_r8, & + & 0.23509e-04_r8,0.22509e-04_r8,0.20604e-04_r8,0.12727e-04_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.13752e-04_r8,0.19773e-04_r8,0.23162e-04_r8,0.25182e-04_r8,0.26210e-04_r8, & + & 0.26298e-04_r8,0.25526e-04_r8,0.23837e-04_r8,0.15433e-04_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.10771e-04_r8,0.12580e-04_r8,0.13349e-04_r8,0.13617e-04_r8,0.13459e-04_r8, & + & 0.12816e-04_r8,0.11635e-04_r8,0.90636e-05_r8,0.45849e-05_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.10937e-04_r8,0.13431e-04_r8,0.14667e-04_r8,0.15270e-04_r8,0.15289e-04_r8, & + & 0.14786e-04_r8,0.13720e-04_r8,0.11614e-04_r8,0.60707e-05_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.11095e-04_r8,0.14367e-04_r8,0.16153e-04_r8,0.17055e-04_r8,0.17287e-04_r8, & + & 0.16925e-04_r8,0.15948e-04_r8,0.14098e-04_r8,0.78037e-05_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.11230e-04_r8,0.15436e-04_r8,0.17715e-04_r8,0.18921e-04_r8,0.19404e-04_r8, & + & 0.19208e-04_r8,0.18318e-04_r8,0.16668e-04_r8,0.97810e-05_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.11337e-04_r8,0.16572e-04_r8,0.19310e-04_r8,0.20882e-04_r8,0.21623e-04_r8, & + & 0.21621e-04_r8,0.20902e-04_r8,0.19439e-04_r8,0.11994e-04_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.88397e-05_r8,0.10407e-04_r8,0.10992e-04_r8,0.11130e-04_r8,0.10914e-04_r8, & + & 0.10319e-04_r8,0.92746e-05_r8,0.69230e-05_r8,0.33878e-05_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.89820e-05_r8,0.11148e-04_r8,0.12114e-04_r8,0.12509e-04_r8,0.12455e-04_r8, & + & 0.11973e-04_r8,0.11026e-04_r8,0.91303e-05_r8,0.45777e-05_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.91201e-05_r8,0.11975e-04_r8,0.13369e-04_r8,0.14032e-04_r8,0.14150e-04_r8, & + & 0.13774e-04_r8,0.12899e-04_r8,0.11289e-04_r8,0.59718e-05_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.92338e-05_r8,0.12910e-04_r8,0.14708e-04_r8,0.15633e-04_r8,0.15947e-04_r8, & + & 0.15711e-04_r8,0.14916e-04_r8,0.13483e-04_r8,0.75778e-05_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.93270e-05_r8,0.13899e-04_r8,0.16089e-04_r8,0.17313e-04_r8,0.17838e-04_r8, & + & 0.17779e-04_r8,0.17126e-04_r8,0.15852e-04_r8,0.93849e-05_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.72957e-05_r8,0.88518e-05_r8,0.94180e-05_r8,0.95477e-05_r8,0.93627e-05_r8, & + & 0.88681e-05_r8,0.79846e-05_r8,0.60665e-05_r8,0.28938e-05_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.74164e-05_r8,0.95244e-05_r8,0.10413e-04_r8,0.10760e-04_r8,0.10725e-04_r8, & + & 0.10300e-04_r8,0.94914e-05_r8,0.79265e-05_r8,0.39145e-05_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.75267e-05_r8,0.10290e-04_r8,0.11516e-04_r8,0.12091e-04_r8,0.12186e-04_r8, & + & 0.11866e-04_r8,0.11116e-04_r8,0.97843e-05_r8,0.51152e-05_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.76165e-05_r8,0.11127e-04_r8,0.12682e-04_r8,0.13483e-04_r8,0.13746e-04_r8, & + & 0.13546e-04_r8,0.12885e-04_r8,0.11704e-04_r8,0.64876e-05_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.76866e-05_r8,0.11972e-04_r8,0.13896e-04_r8,0.14938e-04_r8,0.15405e-04_r8, & + & 0.15374e-04_r8,0.14838e-04_r8,0.13790e-04_r8,0.80319e-05_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.60137e-05_r8,0.75193e-05_r8,0.80348e-05_r8,0.81538e-05_r8,0.80064e-05_r8, & + & 0.75822e-05_r8,0.68354e-05_r8,0.52502e-05_r8,0.24674e-05_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.61150e-05_r8,0.81325e-05_r8,0.89089e-05_r8,0.92208e-05_r8,0.91831e-05_r8, & + & 0.88171e-05_r8,0.81283e-05_r8,0.68396e-05_r8,0.33429e-05_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.62020e-05_r8,0.88113e-05_r8,0.98818e-05_r8,0.10369e-04_r8,0.10440e-04_r8, & + & 0.10164e-04_r8,0.95355e-05_r8,0.84372e-05_r8,0.43683e-05_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.62729e-05_r8,0.95382e-05_r8,0.10890e-04_r8,0.11569e-04_r8,0.11793e-04_r8, & + & 0.11630e-04_r8,0.11082e-04_r8,0.10108e-04_r8,0.55358e-05_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.63199e-05_r8,0.10271e-04_r8,0.11934e-04_r8,0.12838e-04_r8,0.13254e-04_r8, & + & 0.13231e-04_r8,0.12796e-04_r8,0.11934e-04_r8,0.68492e-05_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.49517e-05_r8,0.63774e-05_r8,0.68261e-05_r8,0.69411e-05_r8,0.68151e-05_r8, & + & 0.64513e-05_r8,0.58220e-05_r8,0.45056e-05_r8,0.20980e-05_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.50331e-05_r8,0.69207e-05_r8,0.75990e-05_r8,0.78660e-05_r8,0.78231e-05_r8, & + & 0.75119e-05_r8,0.69333e-05_r8,0.58688e-05_r8,0.28426e-05_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.51036e-05_r8,0.75155e-05_r8,0.84393e-05_r8,0.88490e-05_r8,0.89047e-05_r8, & + & 0.86720e-05_r8,0.81449e-05_r8,0.72410e-05_r8,0.37114e-05_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.51548e-05_r8,0.81445e-05_r8,0.93105e-05_r8,0.98793e-05_r8,0.10078e-04_r8, & + & 0.99535e-05_r8,0.94951e-05_r8,0.86973e-05_r8,0.47002e-05_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.51867e-05_r8,0.87857e-05_r8,0.10211e-04_r8,0.10992e-04_r8,0.11352e-04_r8, & + & 0.11351e-04_r8,0.10990e-04_r8,0.10277e-04_r8,0.58153e-05_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.18292e-03_r8,0.16357e-03_r8,0.15341e-03_r8,0.14585e-03_r8,0.13797e-03_r8, & + & 0.12826e-03_r8,0.11477e-03_r8,0.99322e-04_r8,0.99311e-04_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.18277e-03_r8,0.16502e-03_r8,0.15805e-03_r8,0.15290e-03_r8,0.14696e-03_r8, & + & 0.13850e-03_r8,0.12664e-03_r8,0.11419e-03_r8,0.11887e-03_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.18261e-03_r8,0.16694e-03_r8,0.16322e-03_r8,0.16061e-03_r8,0.15658e-03_r8, & + & 0.14997e-03_r8,0.14010e-03_r8,0.13154e-03_r8,0.14123e-03_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.18244e-03_r8,0.16952e-03_r8,0.16897e-03_r8,0.16909e-03_r8,0.16740e-03_r8, & + & 0.16268e-03_r8,0.15556e-03_r8,0.15163e-03_r8,0.16610e-03_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.18218e-03_r8,0.17247e-03_r8,0.17521e-03_r8,0.17844e-03_r8,0.17911e-03_r8, & + & 0.17696e-03_r8,0.17241e-03_r8,0.17370e-03_r8,0.19290e-03_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.17473e-03_r8,0.15735e-03_r8,0.14910e-03_r8,0.14227e-03_r8,0.13471e-03_r8, & + & 0.12515e-03_r8,0.11200e-03_r8,0.94986e-04_r8,0.89520e-04_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.17467e-03_r8,0.15907e-03_r8,0.15401e-03_r8,0.14953e-03_r8,0.14402e-03_r8, & + & 0.13581e-03_r8,0.12401e-03_r8,0.10893e-03_r8,0.10811e-03_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.17463e-03_r8,0.16142e-03_r8,0.15942e-03_r8,0.15773e-03_r8,0.15417e-03_r8, & + & 0.14769e-03_r8,0.13747e-03_r8,0.12528e-03_r8,0.12924e-03_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.17449e-03_r8,0.16426e-03_r8,0.16549e-03_r8,0.16671e-03_r8,0.16541e-03_r8, & + & 0.16085e-03_r8,0.15263e-03_r8,0.14389e-03_r8,0.15270e-03_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.17439e-03_r8,0.16753e-03_r8,0.17238e-03_r8,0.17658e-03_r8,0.17759e-03_r8, & + & 0.17537e-03_r8,0.16910e-03_r8,0.16442e-03_r8,0.17796e-03_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.16429e-03_r8,0.14895e-03_r8,0.14201e-03_r8,0.13557e-03_r8,0.12797e-03_r8, & + & 0.11829e-03_r8,0.10548e-03_r8,0.88188e-04_r8,0.77280e-04_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.16436e-03_r8,0.15092e-03_r8,0.14708e-03_r8,0.14277e-03_r8,0.13731e-03_r8, & + & 0.12899e-03_r8,0.11719e-03_r8,0.10108e-03_r8,0.94071e-04_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.16438e-03_r8,0.15344e-03_r8,0.15259e-03_r8,0.15105e-03_r8,0.14760e-03_r8, & + & 0.14078e-03_r8,0.13037e-03_r8,0.11602e-03_r8,0.11331e-03_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.16440e-03_r8,0.15651e-03_r8,0.15877e-03_r8,0.16021e-03_r8,0.15883e-03_r8, & + & 0.15394e-03_r8,0.14519e-03_r8,0.13303e-03_r8,0.13463e-03_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.16444e-03_r8,0.16001e-03_r8,0.16595e-03_r8,0.17023e-03_r8,0.17105e-03_r8, & + & 0.16855e-03_r8,0.16116e-03_r8,0.15159e-03_r8,0.15764e-03_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.15195e-03_r8,0.13883e-03_r8,0.13294e-03_r8,0.12699e-03_r8,0.11928e-03_r8, & + & 0.10948e-03_r8,0.97355e-04_r8,0.80985e-04_r8,0.65303e-04_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.15212e-03_r8,0.14097e-03_r8,0.13802e-03_r8,0.13404e-03_r8,0.12836e-03_r8, & + & 0.11996e-03_r8,0.10855e-03_r8,0.92884e-04_r8,0.80285e-04_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.15229e-03_r8,0.14364e-03_r8,0.14356e-03_r8,0.14222e-03_r8,0.13844e-03_r8, & + & 0.13147e-03_r8,0.12124e-03_r8,0.10661e-03_r8,0.97473e-04_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.15247e-03_r8,0.14694e-03_r8,0.14987e-03_r8,0.15132e-03_r8,0.14947e-03_r8, & + & 0.14428e-03_r8,0.13562e-03_r8,0.12218e-03_r8,0.11647e-03_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.15268e-03_r8,0.15064e-03_r8,0.15719e-03_r8,0.16126e-03_r8,0.16162e-03_r8, & + & 0.15869e-03_r8,0.15101e-03_r8,0.13904e-03_r8,0.13733e-03_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.13846e-03_r8,0.12761e-03_r8,0.12265e-03_r8,0.11713e-03_r8,0.10945e-03_r8, & + & 0.10011e-03_r8,0.88713e-04_r8,0.73647e-04_r8,0.54834e-04_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.13872e-03_r8,0.12987e-03_r8,0.12766e-03_r8,0.12392e-03_r8,0.11814e-03_r8, & + & 0.11013e-03_r8,0.99375e-04_r8,0.84759e-04_r8,0.68007e-04_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.13899e-03_r8,0.13272e-03_r8,0.13319e-03_r8,0.13187e-03_r8,0.12795e-03_r8, & + & 0.12108e-03_r8,0.11145e-03_r8,0.97499e-04_r8,0.83096e-04_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.13930e-03_r8,0.13617e-03_r8,0.13955e-03_r8,0.14081e-03_r8,0.13862e-03_r8, & + & 0.13340e-03_r8,0.12522e-03_r8,0.11183e-03_r8,0.99891e-04_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.13961e-03_r8,0.13997e-03_r8,0.14692e-03_r8,0.15049e-03_r8,0.15045e-03_r8, & + & 0.14736e-03_r8,0.14024e-03_r8,0.12733e-03_r8,0.11865e-03_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.12419e-03_r8,0.11551e-03_r8,0.11132e-03_r8,0.10604e-03_r8,0.98912e-04_r8, & + & 0.90174e-04_r8,0.79553e-04_r8,0.65781e-04_r8,0.45228e-04_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.12454e-03_r8,0.11786e-03_r8,0.11619e-03_r8,0.11259e-03_r8,0.10704e-03_r8, & + & 0.99552e-04_r8,0.89546e-04_r8,0.76061e-04_r8,0.56748e-04_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.12490e-03_r8,0.12081e-03_r8,0.12161e-03_r8,0.12024e-03_r8,0.11632e-03_r8, & + & 0.10988e-03_r8,0.10081e-03_r8,0.87950e-04_r8,0.69901e-04_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.12528e-03_r8,0.12425e-03_r8,0.12796e-03_r8,0.12887e-03_r8,0.12649e-03_r8, & + & 0.12150e-03_r8,0.11381e-03_r8,0.10130e-03_r8,0.84575e-04_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.12568e-03_r8,0.12811e-03_r8,0.13519e-03_r8,0.13816e-03_r8,0.13780e-03_r8, & + & 0.13476e-03_r8,0.12819e-03_r8,0.11553e-03_r8,0.10091e-03_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.10978e-03_r8,0.10308e-03_r8,0.99508e-04_r8,0.94571e-04_r8,0.88120e-04_r8, & + & 0.80226e-04_r8,0.70492e-04_r8,0.57993e-04_r8,0.36699e-04_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.11018e-03_r8,0.10544e-03_r8,0.10415e-03_r8,0.10080e-03_r8,0.95769e-04_r8, & + & 0.88865e-04_r8,0.79698e-04_r8,0.67450e-04_r8,0.46683e-04_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.11058e-03_r8,0.10837e-03_r8,0.10936e-03_r8,0.10807e-03_r8,0.10453e-03_r8, & + & 0.98497e-04_r8,0.90104e-04_r8,0.78443e-04_r8,0.58212e-04_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.11104e-03_r8,0.11179e-03_r8,0.11551e-03_r8,0.11629e-03_r8,0.11409e-03_r8, & + & 0.10934e-03_r8,0.10217e-03_r8,0.90913e-04_r8,0.71131e-04_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.11149e-03_r8,0.11560e-03_r8,0.12257e-03_r8,0.12521e-03_r8,0.12472e-03_r8, & + & 0.12180e-03_r8,0.11572e-03_r8,0.10421e-03_r8,0.85542e-04_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.95759e-04_r8,0.90773e-04_r8,0.87806e-04_r8,0.83290e-04_r8,0.77515e-04_r8, & + & 0.70528e-04_r8,0.61795e-04_r8,0.50465e-04_r8,0.29380e-04_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.96189e-04_r8,0.93120e-04_r8,0.92132e-04_r8,0.89103e-04_r8,0.84653e-04_r8, & + & 0.78456e-04_r8,0.70159e-04_r8,0.59177e-04_r8,0.37867e-04_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.96665e-04_r8,0.96018e-04_r8,0.97008e-04_r8,0.95975e-04_r8,0.92760e-04_r8, & + & 0.87379e-04_r8,0.79687e-04_r8,0.69248e-04_r8,0.47855e-04_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.97168e-04_r8,0.99322e-04_r8,0.10289e-03_r8,0.10373e-03_r8,0.10169e-03_r8, & + & 0.97397e-04_r8,0.90796e-04_r8,0.80805e-04_r8,0.59240e-04_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.97641e-04_r8,0.10302e-03_r8,0.10967e-03_r8,0.11218e-03_r8,0.11166e-03_r8, & + & 0.10896e-03_r8,0.10343e-03_r8,0.93210e-04_r8,0.71998e-04_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.82482e-04_r8,0.78941e-04_r8,0.76398e-04_r8,0.72429e-04_r8,0.67369e-04_r8, & + & 0.61188e-04_r8,0.53486e-04_r8,0.43219e-04_r8,0.23144e-04_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.82941e-04_r8,0.81194e-04_r8,0.80391e-04_r8,0.77783e-04_r8,0.73924e-04_r8, & + & 0.68383e-04_r8,0.61055e-04_r8,0.51145e-04_r8,0.30235e-04_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.83462e-04_r8,0.83998e-04_r8,0.84977e-04_r8,0.84161e-04_r8,0.81323e-04_r8, & + & 0.76538e-04_r8,0.69739e-04_r8,0.60350e-04_r8,0.38714e-04_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.83976e-04_r8,0.87153e-04_r8,0.90583e-04_r8,0.91413e-04_r8,0.89589e-04_r8, & + & 0.85741e-04_r8,0.79900e-04_r8,0.70947e-04_r8,0.48553e-04_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.84461e-04_r8,0.90734e-04_r8,0.96938e-04_r8,0.99296e-04_r8,0.98864e-04_r8, & + & 0.96399e-04_r8,0.91511e-04_r8,0.82490e-04_r8,0.59777e-04_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.70371e-04_r8,0.68110e-04_r8,0.65986e-04_r8,0.62636e-04_r8,0.58303e-04_r8, & + & 0.52961e-04_r8,0.46122e-04_r8,0.37036e-04_r8,0.18341e-04_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.70853e-04_r8,0.70288e-04_r8,0.69669e-04_r8,0.67543e-04_r8,0.64271e-04_r8, & + & 0.59496e-04_r8,0.53052e-04_r8,0.44224e-04_r8,0.24306e-04_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.71373e-04_r8,0.72956e-04_r8,0.74034e-04_r8,0.73423e-04_r8,0.71076e-04_r8, & + & 0.66934e-04_r8,0.61048e-04_r8,0.52623e-04_r8,0.31537e-04_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.71862e-04_r8,0.75946e-04_r8,0.79283e-04_r8,0.80149e-04_r8,0.78712e-04_r8, & + & 0.75412e-04_r8,0.70399e-04_r8,0.62323e-04_r8,0.40041e-04_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.72376e-04_r8,0.79405e-04_r8,0.85220e-04_r8,0.87544e-04_r8,0.87332e-04_r8, & + & 0.85268e-04_r8,0.81104e-04_r8,0.73085e-04_r8,0.49845e-04_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.59776e-04_r8,0.59155e-04_r8,0.57996e-04_r8,0.55642e-04_r8,0.52323e-04_r8, & + & 0.47930e-04_r8,0.42036e-04_r8,0.34179e-04_r8,0.16514e-04_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.60275e-04_r8,0.61436e-04_r8,0.61654e-04_r8,0.60490e-04_r8,0.58055e-04_r8, & + & 0.54242e-04_r8,0.48750e-04_r8,0.41144e-04_r8,0.21987e-04_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.60746e-04_r8,0.64075e-04_r8,0.66078e-04_r8,0.66233e-04_r8,0.64629e-04_r8, & + & 0.61455e-04_r8,0.56611e-04_r8,0.49290e-04_r8,0.28648e-04_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.61244e-04_r8,0.67066e-04_r8,0.71217e-04_r8,0.72696e-04_r8,0.72050e-04_r8, & + & 0.69816e-04_r8,0.65797e-04_r8,0.58590e-04_r8,0.36515e-04_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.61769e-04_r8,0.70693e-04_r8,0.76979e-04_r8,0.79872e-04_r8,0.80561e-04_r8, & + & 0.79478e-04_r8,0.76089e-04_r8,0.68898e-04_r8,0.45628e-04_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.50518e-04_r8,0.51187e-04_r8,0.50822e-04_r8,0.49284e-04_r8,0.46769e-04_r8, & + & 0.43097e-04_r8,0.38110e-04_r8,0.31379e-04_r8,0.14783e-04_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.50964e-04_r8,0.53463e-04_r8,0.54457e-04_r8,0.54020e-04_r8,0.52266e-04_r8, & + & 0.49174e-04_r8,0.44595e-04_r8,0.38042e-04_r8,0.19796e-04_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.51421e-04_r8,0.56033e-04_r8,0.58762e-04_r8,0.59481e-04_r8,0.58578e-04_r8, & + & 0.56207e-04_r8,0.52260e-04_r8,0.45820e-04_r8,0.25919e-04_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.51920e-04_r8,0.59121e-04_r8,0.63731e-04_r8,0.65674e-04_r8,0.65806e-04_r8, & + & 0.64464e-04_r8,0.61120e-04_r8,0.54677e-04_r8,0.33164e-04_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.52396e-04_r8,0.62780e-04_r8,0.69274e-04_r8,0.72637e-04_r8,0.74145e-04_r8, & + & 0.73831e-04_r8,0.71039e-04_r8,0.64514e-04_r8,0.41597e-04_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.42486e-04_r8,0.44174e-04_r8,0.44463e-04_r8,0.43555e-04_r8,0.41568e-04_r8, & + & 0.38563e-04_r8,0.34384e-04_r8,0.28625e-04_r8,0.13171e-04_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.42904e-04_r8,0.46376e-04_r8,0.47979e-04_r8,0.48065e-04_r8,0.46867e-04_r8, & + & 0.44391e-04_r8,0.40615e-04_r8,0.34938e-04_r8,0.17746e-04_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.43349e-04_r8,0.48965e-04_r8,0.52137e-04_r8,0.53262e-04_r8,0.52962e-04_r8, & + & 0.51246e-04_r8,0.47996e-04_r8,0.42282e-04_r8,0.23342e-04_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.43790e-04_r8,0.52076e-04_r8,0.56889e-04_r8,0.59186e-04_r8,0.60002e-04_r8, & + & 0.59254e-04_r8,0.56460e-04_r8,0.50705e-04_r8,0.29999e-04_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.44254e-04_r8,0.55629e-04_r8,0.62209e-04_r8,0.65993e-04_r8,0.68105e-04_r8, & + & 0.68270e-04_r8,0.65941e-04_r8,0.60145e-04_r8,0.37728e-04_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.42864e-03_r8,0.37538e-03_r8,0.32907e-03_r8,0.29701e-03_r8,0.26399e-03_r8, & + & 0.23587e-03_r8,0.21519e-03_r8,0.20736e-03_r8,0.23690e-03_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.42770e-03_r8,0.37463e-03_r8,0.33468e-03_r8,0.30443e-03_r8,0.27635e-03_r8, & + & 0.25424e-03_r8,0.24068e-03_r8,0.24289e-03_r8,0.27885e-03_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.42742e-03_r8,0.37444e-03_r8,0.34109e-03_r8,0.31378e-03_r8,0.29265e-03_r8, & + & 0.27618e-03_r8,0.26729e-03_r8,0.27967e-03_r8,0.32090e-03_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.42756e-03_r8,0.37461e-03_r8,0.34714e-03_r8,0.32647e-03_r8,0.30721e-03_r8, & + & 0.29888e-03_r8,0.29503e-03_r8,0.31853e-03_r8,0.36629e-03_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.42817e-03_r8,0.37676e-03_r8,0.35506e-03_r8,0.34027e-03_r8,0.32593e-03_r8, & + & 0.32117e-03_r8,0.33159e-03_r8,0.36650e-03_r8,0.42307e-03_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.44647e-03_r8,0.39099e-03_r8,0.34399e-03_r8,0.31315e-03_r8,0.27681e-03_r8, & + & 0.24757e-03_r8,0.21977e-03_r8,0.20260e-03_r8,0.22465e-03_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.44675e-03_r8,0.39126e-03_r8,0.35094e-03_r8,0.32069e-03_r8,0.29009e-03_r8, & + & 0.26696e-03_r8,0.24338e-03_r8,0.23431e-03_r8,0.26448e-03_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.44728e-03_r8,0.39176e-03_r8,0.35848e-03_r8,0.33002e-03_r8,0.30752e-03_r8, & + & 0.28763e-03_r8,0.26835e-03_r8,0.26923e-03_r8,0.30805e-03_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.44805e-03_r8,0.39321e-03_r8,0.36547e-03_r8,0.34473e-03_r8,0.32431e-03_r8, & + & 0.30833e-03_r8,0.29659e-03_r8,0.31021e-03_r8,0.35789e-03_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.44833e-03_r8,0.39641e-03_r8,0.37373e-03_r8,0.35955e-03_r8,0.34286e-03_r8, & + & 0.33059e-03_r8,0.33253e-03_r8,0.36056e-03_r8,0.41785e-03_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.45575e-03_r8,0.39903e-03_r8,0.35239e-03_r8,0.32061e-03_r8,0.28610e-03_r8, & + & 0.25358e-03_r8,0.22160e-03_r8,0.19044e-03_r8,0.19754e-03_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.45658e-03_r8,0.39983e-03_r8,0.35980e-03_r8,0.32984e-03_r8,0.29898e-03_r8, & + & 0.27505e-03_r8,0.24328e-03_r8,0.21905e-03_r8,0.23515e-03_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.45737e-03_r8,0.40126e-03_r8,0.36866e-03_r8,0.34025e-03_r8,0.31808e-03_r8, & + & 0.29648e-03_r8,0.26565e-03_r8,0.25100e-03_r8,0.27824e-03_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.45822e-03_r8,0.40344e-03_r8,0.37727e-03_r8,0.35639e-03_r8,0.33753e-03_r8, & + & 0.31544e-03_r8,0.29107e-03_r8,0.29011e-03_r8,0.33040e-03_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.45803e-03_r8,0.40724e-03_r8,0.38685e-03_r8,0.37303e-03_r8,0.35804e-03_r8, & + & 0.33477e-03_r8,0.32542e-03_r8,0.34063e-03_r8,0.39188e-03_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.45696e-03_r8,0.40009e-03_r8,0.35533e-03_r8,0.32134e-03_r8,0.28977e-03_r8, & + & 0.25642e-03_r8,0.22005e-03_r8,0.17825e-03_r8,0.16960e-03_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.45799e-03_r8,0.40164e-03_r8,0.36303e-03_r8,0.33235e-03_r8,0.30343e-03_r8, & + & 0.27796e-03_r8,0.24341e-03_r8,0.20303e-03_r8,0.20347e-03_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.45889e-03_r8,0.40391e-03_r8,0.37251e-03_r8,0.34409e-03_r8,0.32396e-03_r8, & + & 0.30068e-03_r8,0.26403e-03_r8,0.23112e-03_r8,0.24434e-03_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.45955e-03_r8,0.40640e-03_r8,0.38203e-03_r8,0.36158e-03_r8,0.34561e-03_r8, & + & 0.32162e-03_r8,0.28613e-03_r8,0.26715e-03_r8,0.29513e-03_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.45899e-03_r8,0.41016e-03_r8,0.39290e-03_r8,0.38024e-03_r8,0.36719e-03_r8, & + & 0.34183e-03_r8,0.31736e-03_r8,0.31348e-03_r8,0.35430e-03_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.44860e-03_r8,0.39309e-03_r8,0.35143e-03_r8,0.31765e-03_r8,0.28887e-03_r8, & + & 0.25439e-03_r8,0.21652e-03_r8,0.16876e-03_r8,0.14333e-03_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.45003e-03_r8,0.39579e-03_r8,0.35959e-03_r8,0.33075e-03_r8,0.30371e-03_r8, & + & 0.27559e-03_r8,0.24058e-03_r8,0.19058e-03_r8,0.17442e-03_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.45146e-03_r8,0.39890e-03_r8,0.36951e-03_r8,0.34437e-03_r8,0.32442e-03_r8, & + & 0.30040e-03_r8,0.26223e-03_r8,0.21520e-03_r8,0.21295e-03_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.45218e-03_r8,0.40151e-03_r8,0.38022e-03_r8,0.36228e-03_r8,0.34802e-03_r8, & + & 0.32336e-03_r8,0.28327e-03_r8,0.24766e-03_r8,0.26132e-03_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.45207e-03_r8,0.40582e-03_r8,0.39175e-03_r8,0.38293e-03_r8,0.37072e-03_r8, & + & 0.34500e-03_r8,0.31037e-03_r8,0.29012e-03_r8,0.31661e-03_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.43374e-03_r8,0.38081e-03_r8,0.34182e-03_r8,0.31060e-03_r8,0.28045e-03_r8, & + & 0.24697e-03_r8,0.20889e-03_r8,0.16055e-03_r8,0.12036e-03_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.43531e-03_r8,0.38407e-03_r8,0.35000e-03_r8,0.32358e-03_r8,0.29721e-03_r8, & + & 0.26821e-03_r8,0.23298e-03_r8,0.18104e-03_r8,0.14668e-03_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.43706e-03_r8,0.38738e-03_r8,0.35982e-03_r8,0.33840e-03_r8,0.31879e-03_r8, & + & 0.29390e-03_r8,0.25605e-03_r8,0.20200e-03_r8,0.18191e-03_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.43807e-03_r8,0.39050e-03_r8,0.37037e-03_r8,0.35740e-03_r8,0.34372e-03_r8, & + & 0.31863e-03_r8,0.27734e-03_r8,0.23003e-03_r8,0.22665e-03_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.43877e-03_r8,0.39551e-03_r8,0.38302e-03_r8,0.38004e-03_r8,0.36796e-03_r8, & + & 0.34140e-03_r8,0.30328e-03_r8,0.26832e-03_r8,0.27676e-03_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.41256e-03_r8,0.36341e-03_r8,0.32806e-03_r8,0.30023e-03_r8,0.26855e-03_r8, & + & 0.23444e-03_r8,0.19788e-03_r8,0.15062e-03_r8,0.10262e-03_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.41482e-03_r8,0.36772e-03_r8,0.33624e-03_r8,0.31297e-03_r8,0.28556e-03_r8, & + & 0.25627e-03_r8,0.22127e-03_r8,0.17072e-03_r8,0.12601e-03_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.41718e-03_r8,0.37142e-03_r8,0.34661e-03_r8,0.32744e-03_r8,0.30719e-03_r8, & + & 0.28254e-03_r8,0.24553e-03_r8,0.19044e-03_r8,0.15628e-03_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.41872e-03_r8,0.37555e-03_r8,0.35755e-03_r8,0.34713e-03_r8,0.33306e-03_r8, & + & 0.30832e-03_r8,0.26791e-03_r8,0.21481e-03_r8,0.19464e-03_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.42048e-03_r8,0.38195e-03_r8,0.37042e-03_r8,0.37076e-03_r8,0.35893e-03_r8, & + & 0.33177e-03_r8,0.29351e-03_r8,0.24858e-03_r8,0.23890e-03_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.38528e-03_r8,0.34132e-03_r8,0.30950e-03_r8,0.28435e-03_r8,0.25387e-03_r8, & + & 0.21998e-03_r8,0.18381e-03_r8,0.13995e-03_r8,0.86291e-04_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.38813e-03_r8,0.34604e-03_r8,0.31840e-03_r8,0.29716e-03_r8,0.26994e-03_r8, & + & 0.24125e-03_r8,0.20696e-03_r8,0.15919e-03_r8,0.10863e-03_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.39073e-03_r8,0.35038e-03_r8,0.33010e-03_r8,0.31128e-03_r8,0.29227e-03_r8, & + & 0.26641e-03_r8,0.23195e-03_r8,0.17813e-03_r8,0.13616e-03_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.39281e-03_r8,0.35556e-03_r8,0.34140e-03_r8,0.33132e-03_r8,0.31814e-03_r8, & + & 0.29308e-03_r8,0.25493e-03_r8,0.20064e-03_r8,0.16931e-03_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.39565e-03_r8,0.36362e-03_r8,0.35480e-03_r8,0.35632e-03_r8,0.34483e-03_r8, & + & 0.31779e-03_r8,0.27994e-03_r8,0.23183e-03_r8,0.20721e-03_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.35353e-03_r8,0.31534e-03_r8,0.28844e-03_r8,0.26382e-03_r8,0.23534e-03_r8, & + & 0.20347e-03_r8,0.16850e-03_r8,0.12923e-03_r8,0.71856e-04_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.35704e-03_r8,0.32078e-03_r8,0.29797e-03_r8,0.27689e-03_r8,0.25047e-03_r8, & + & 0.22397e-03_r8,0.19066e-03_r8,0.14773e-03_r8,0.92561e-04_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.36000e-03_r8,0.32561e-03_r8,0.31012e-03_r8,0.29082e-03_r8,0.27253e-03_r8, & + & 0.24851e-03_r8,0.21457e-03_r8,0.16607e-03_r8,0.11811e-03_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.36298e-03_r8,0.33189e-03_r8,0.32100e-03_r8,0.31077e-03_r8,0.29911e-03_r8, & + & 0.27480e-03_r8,0.23785e-03_r8,0.18730e-03_r8,0.14849e-03_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.36645e-03_r8,0.34041e-03_r8,0.33535e-03_r8,0.33583e-03_r8,0.32646e-03_r8, & + & 0.29975e-03_r8,0.26277e-03_r8,0.21618e-03_r8,0.18220e-03_r8 /) + kao(:, 1,10,10) = (/ & + & 0.31882e-03_r8,0.28657e-03_r8,0.26462e-03_r8,0.24132e-03_r8,0.21534e-03_r8, & + & 0.18636e-03_r8,0.15549e-03_r8,0.11817e-03_r8,0.60706e-04_r8 /) + kao(:, 2,10,10) = (/ & + & 0.32301e-03_r8,0.29267e-03_r8,0.27519e-03_r8,0.25478e-03_r8,0.23046e-03_r8, & + & 0.20560e-03_r8,0.17582e-03_r8,0.13638e-03_r8,0.79531e-04_r8 /) + kao(:, 3,10,10) = (/ & + & 0.32639e-03_r8,0.29816e-03_r8,0.28709e-03_r8,0.26927e-03_r8,0.25170e-03_r8, & + & 0.23027e-03_r8,0.19794e-03_r8,0.15520e-03_r8,0.10253e-03_r8 /) + kao(:, 4,10,10) = (/ & + & 0.33008e-03_r8,0.30559e-03_r8,0.29823e-03_r8,0.28948e-03_r8,0.27786e-03_r8, & + & 0.25639e-03_r8,0.22020e-03_r8,0.17621e-03_r8,0.13035e-03_r8 /) + kao(:, 5,10,10) = (/ & + & 0.33429e-03_r8,0.31481e-03_r8,0.31383e-03_r8,0.31396e-03_r8,0.30544e-03_r8, & + & 0.28143e-03_r8,0.24487e-03_r8,0.20336e-03_r8,0.16246e-03_r8 /) + kao(:, 1,11,10) = (/ & + & 0.28433e-03_r8,0.25922e-03_r8,0.24227e-03_r8,0.22327e-03_r8,0.20067e-03_r8, & + & 0.17618e-03_r8,0.15050e-03_r8,0.11425e-03_r8,0.57921e-04_r8 /) + kao(:, 2,11,10) = (/ & + & 0.28828e-03_r8,0.26532e-03_r8,0.25425e-03_r8,0.23723e-03_r8,0.21797e-03_r8, & + & 0.19695e-03_r8,0.17056e-03_r8,0.13252e-03_r8,0.76361e-04_r8 /) + kao(:, 3,11,10) = (/ & + & 0.29236e-03_r8,0.27228e-03_r8,0.26588e-03_r8,0.25415e-03_r8,0.24099e-03_r8, & + & 0.22135e-03_r8,0.19174e-03_r8,0.15232e-03_r8,0.98360e-04_r8 /) + kao(:, 4,11,10) = (/ & + & 0.29717e-03_r8,0.28209e-03_r8,0.27970e-03_r8,0.27650e-03_r8,0.26714e-03_r8, & + & 0.24681e-03_r8,0.21371e-03_r8,0.17631e-03_r8,0.12518e-03_r8 /) + kao(:, 5,11,10) = (/ & + & 0.30177e-03_r8,0.29180e-03_r8,0.29905e-03_r8,0.30274e-03_r8,0.29362e-03_r8, & + & 0.27208e-03_r8,0.24087e-03_r8,0.20461e-03_r8,0.15616e-03_r8 /) + kao(:, 1,12,10) = (/ & + & 0.24998e-03_r8,0.23220e-03_r8,0.21962e-03_r8,0.20418e-03_r8,0.18598e-03_r8, & + & 0.16635e-03_r8,0.14319e-03_r8,0.11002e-03_r8,0.54657e-04_r8 /) + kao(:, 2,12,10) = (/ & + & 0.25422e-03_r8,0.23880e-03_r8,0.23171e-03_r8,0.21907e-03_r8,0.20484e-03_r8, & + & 0.18724e-03_r8,0.16371e-03_r8,0.12837e-03_r8,0.72183e-04_r8 /) + kao(:, 3,12,10) = (/ & + & 0.25909e-03_r8,0.24827e-03_r8,0.24443e-03_r8,0.23867e-03_r8,0.22868e-03_r8, & + & 0.21084e-03_r8,0.18482e-03_r8,0.14974e-03_r8,0.93395e-04_r8 /) + kao(:, 4,12,10) = (/ & + & 0.26399e-03_r8,0.25851e-03_r8,0.26208e-03_r8,0.26298e-03_r8,0.25438e-03_r8, & + & 0.23482e-03_r8,0.20834e-03_r8,0.17589e-03_r8,0.11924e-03_r8 /) + kao(:, 5,12,10) = (/ & + & 0.26914e-03_r8,0.26866e-03_r8,0.28401e-03_r8,0.28945e-03_r8,0.28022e-03_r8, & + & 0.26150e-03_r8,0.23750e-03_r8,0.20542e-03_r8,0.14923e-03_r8 /) + kao(:, 1,13,10) = (/ & + & 0.21751e-03_r8,0.20608e-03_r8,0.19731e-03_r8,0.18540e-03_r8,0.17208e-03_r8, & + & 0.15624e-03_r8,0.13474e-03_r8,0.10527e-03_r8,0.50953e-04_r8 /) + kao(:, 2,13,10) = (/ & + & 0.22228e-03_r8,0.21439e-03_r8,0.20968e-03_r8,0.20158e-03_r8,0.19151e-03_r8, & + & 0.17720e-03_r8,0.15564e-03_r8,0.12461e-03_r8,0.67516e-04_r8 /) + kao(:, 3,13,10) = (/ & + & 0.22727e-03_r8,0.22462e-03_r8,0.22474e-03_r8,0.22318e-03_r8,0.21469e-03_r8, & + & 0.19989e-03_r8,0.17790e-03_r8,0.14782e-03_r8,0.88180e-04_r8 /) + kao(:, 4,13,10) = (/ & + & 0.23242e-03_r8,0.23488e-03_r8,0.24462e-03_r8,0.24805e-03_r8,0.24003e-03_r8, & + & 0.22364e-03_r8,0.20382e-03_r8,0.17470e-03_r8,0.11335e-03_r8 /) + kao(:, 5,13,10) = (/ & + & 0.23819e-03_r8,0.24692e-03_r8,0.26797e-03_r8,0.27413e-03_r8,0.26611e-03_r8, & + & 0.25207e-03_r8,0.23456e-03_r8,0.20493e-03_r8,0.14302e-03_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.54188e-03_r8,0.47438e-03_r8,0.41220e-03_r8,0.36319e-03_r8,0.32177e-03_r8, & + & 0.28178e-03_r8,0.26195e-03_r8,0.26768e-03_r8,0.30988e-03_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.53863e-03_r8,0.47157e-03_r8,0.41235e-03_r8,0.37142e-03_r8,0.33314e-03_r8, & + & 0.30667e-03_r8,0.29622e-03_r8,0.31573e-03_r8,0.36594e-03_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.53537e-03_r8,0.46873e-03_r8,0.41881e-03_r8,0.37881e-03_r8,0.35190e-03_r8, & + & 0.33275e-03_r8,0.33720e-03_r8,0.36928e-03_r8,0.42810e-03_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.53255e-03_r8,0.46630e-03_r8,0.42443e-03_r8,0.38945e-03_r8,0.37640e-03_r8, & + & 0.36424e-03_r8,0.38086e-03_r8,0.42782e-03_r8,0.49486e-03_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.53016e-03_r8,0.46423e-03_r8,0.43029e-03_r8,0.40524e-03_r8,0.39835e-03_r8, & + & 0.40134e-03_r8,0.42785e-03_r8,0.48998e-03_r8,0.56469e-03_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.58031e-03_r8,0.50799e-03_r8,0.44209e-03_r8,0.39038e-03_r8,0.34592e-03_r8, & + & 0.30091e-03_r8,0.27060e-03_r8,0.26179e-03_r8,0.30262e-03_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.57783e-03_r8,0.50583e-03_r8,0.44303e-03_r8,0.40158e-03_r8,0.35771e-03_r8, & + & 0.32458e-03_r8,0.30412e-03_r8,0.31051e-03_r8,0.36041e-03_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.57540e-03_r8,0.50373e-03_r8,0.45070e-03_r8,0.41078e-03_r8,0.37604e-03_r8, & + & 0.34973e-03_r8,0.34205e-03_r8,0.36376e-03_r8,0.42111e-03_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.57390e-03_r8,0.50246e-03_r8,0.45850e-03_r8,0.42273e-03_r8,0.40005e-03_r8, & + & 0.37925e-03_r8,0.38380e-03_r8,0.42075e-03_r8,0.48570e-03_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.57251e-03_r8,0.50128e-03_r8,0.46686e-03_r8,0.44000e-03_r8,0.42177e-03_r8, & + & 0.41338e-03_r8,0.42764e-03_r8,0.47996e-03_r8,0.55489e-03_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.61606e-03_r8,0.53921e-03_r8,0.46963e-03_r8,0.41409e-03_r8,0.36561e-03_r8, & + & 0.31888e-03_r8,0.27397e-03_r8,0.24837e-03_r8,0.28056e-03_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.61406e-03_r8,0.53752e-03_r8,0.47091e-03_r8,0.42713e-03_r8,0.37975e-03_r8, & + & 0.33844e-03_r8,0.30659e-03_r8,0.29320e-03_r8,0.33782e-03_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.61257e-03_r8,0.53626e-03_r8,0.47829e-03_r8,0.43902e-03_r8,0.39761e-03_r8, & + & 0.36364e-03_r8,0.34206e-03_r8,0.34371e-03_r8,0.39648e-03_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.61154e-03_r8,0.53538e-03_r8,0.48822e-03_r8,0.45223e-03_r8,0.42130e-03_r8, & + & 0.39347e-03_r8,0.37907e-03_r8,0.39708e-03_r8,0.45765e-03_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.61140e-03_r8,0.53529e-03_r8,0.49797e-03_r8,0.47117e-03_r8,0.44115e-03_r8, & + & 0.42497e-03_r8,0.41979e-03_r8,0.45564e-03_r8,0.52659e-03_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.64443e-03_r8,0.56411e-03_r8,0.49232e-03_r8,0.43467e-03_r8,0.38190e-03_r8, & + & 0.33277e-03_r8,0.27825e-03_r8,0.23501e-03_r8,0.25182e-03_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.64292e-03_r8,0.56277e-03_r8,0.49409e-03_r8,0.44787e-03_r8,0.39817e-03_r8, & + & 0.35161e-03_r8,0.30747e-03_r8,0.27717e-03_r8,0.30629e-03_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.64243e-03_r8,0.56236e-03_r8,0.50119e-03_r8,0.46200e-03_r8,0.41580e-03_r8, & + & 0.37809e-03_r8,0.34162e-03_r8,0.32168e-03_r8,0.36251e-03_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.64248e-03_r8,0.56245e-03_r8,0.51257e-03_r8,0.47612e-03_r8,0.44107e-03_r8, & + & 0.40610e-03_r8,0.37659e-03_r8,0.36992e-03_r8,0.42339e-03_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.64345e-03_r8,0.56414e-03_r8,0.52333e-03_r8,0.49621e-03_r8,0.46345e-03_r8, & + & 0.43530e-03_r8,0.41388e-03_r8,0.42704e-03_r8,0.49356e-03_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.66205e-03_r8,0.57941e-03_r8,0.50732e-03_r8,0.44788e-03_r8,0.39504e-03_r8, & + & 0.34261e-03_r8,0.28274e-03_r8,0.22440e-03_r8,0.22048e-03_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.66163e-03_r8,0.57912e-03_r8,0.51033e-03_r8,0.46104e-03_r8,0.41289e-03_r8, & + & 0.36220e-03_r8,0.30969e-03_r8,0.26291e-03_r8,0.27073e-03_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.66197e-03_r8,0.57946e-03_r8,0.51799e-03_r8,0.47594e-03_r8,0.43132e-03_r8, & + & 0.39012e-03_r8,0.34192e-03_r8,0.30335e-03_r8,0.32369e-03_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.66310e-03_r8,0.58124e-03_r8,0.52962e-03_r8,0.49191e-03_r8,0.45677e-03_r8, & + & 0.42022e-03_r8,0.37529e-03_r8,0.34603e-03_r8,0.38247e-03_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.66411e-03_r8,0.58365e-03_r8,0.54225e-03_r8,0.51373e-03_r8,0.48391e-03_r8, & + & 0.44802e-03_r8,0.41016e-03_r8,0.39855e-03_r8,0.45388e-03_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.66761e-03_r8,0.58431e-03_r8,0.51405e-03_r8,0.45280e-03_r8,0.40155e-03_r8, & + & 0.34610e-03_r8,0.28249e-03_r8,0.21395e-03_r8,0.18888e-03_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.66804e-03_r8,0.58472e-03_r8,0.51807e-03_r8,0.46619e-03_r8,0.41922e-03_r8, & + & 0.36797e-03_r8,0.30908e-03_r8,0.24851e-03_r8,0.23408e-03_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.66946e-03_r8,0.58664e-03_r8,0.52673e-03_r8,0.48103e-03_r8,0.43940e-03_r8, & + & 0.39605e-03_r8,0.34204e-03_r8,0.28507e-03_r8,0.28224e-03_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.67150e-03_r8,0.59004e-03_r8,0.53959e-03_r8,0.49825e-03_r8,0.46612e-03_r8, & + & 0.42814e-03_r8,0.37432e-03_r8,0.32325e-03_r8,0.33817e-03_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.67315e-03_r8,0.59352e-03_r8,0.55351e-03_r8,0.52125e-03_r8,0.49748e-03_r8, & + & 0.45943e-03_r8,0.40603e-03_r8,0.37064e-03_r8,0.40786e-03_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.65825e-03_r8,0.57610e-03_r8,0.50973e-03_r8,0.44919e-03_r8,0.40091e-03_r8, & + & 0.34393e-03_r8,0.27863e-03_r8,0.20584e-03_r8,0.15896e-03_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.66067e-03_r8,0.57854e-03_r8,0.51604e-03_r8,0.46345e-03_r8,0.41921e-03_r8, & + & 0.36628e-03_r8,0.30597e-03_r8,0.23625e-03_r8,0.19866e-03_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.66419e-03_r8,0.58318e-03_r8,0.52599e-03_r8,0.48043e-03_r8,0.43994e-03_r8, & + & 0.39562e-03_r8,0.33865e-03_r8,0.26970e-03_r8,0.24286e-03_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.66717e-03_r8,0.58792e-03_r8,0.54016e-03_r8,0.49893e-03_r8,0.46857e-03_r8, & + & 0.43005e-03_r8,0.37266e-03_r8,0.30411e-03_r8,0.29541e-03_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.67024e-03_r8,0.59309e-03_r8,0.55482e-03_r8,0.52246e-03_r8,0.50380e-03_r8, & + & 0.46446e-03_r8,0.40297e-03_r8,0.34641e-03_r8,0.36121e-03_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.63858e-03_r8,0.55888e-03_r8,0.49736e-03_r8,0.43942e-03_r8,0.39082e-03_r8, & + & 0.33512e-03_r8,0.27058e-03_r8,0.19736e-03_r8,0.13589e-03_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.64324e-03_r8,0.56410e-03_r8,0.50530e-03_r8,0.45504e-03_r8,0.41149e-03_r8, & + & 0.35701e-03_r8,0.29879e-03_r8,0.22618e-03_r8,0.16884e-03_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.64790e-03_r8,0.57033e-03_r8,0.51640e-03_r8,0.47474e-03_r8,0.43226e-03_r8, & + & 0.38846e-03_r8,0.33154e-03_r8,0.25769e-03_r8,0.20679e-03_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.65242e-03_r8,0.57688e-03_r8,0.53191e-03_r8,0.49447e-03_r8,0.46234e-03_r8, & + & 0.42468e-03_r8,0.36669e-03_r8,0.28907e-03_r8,0.25449e-03_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.65716e-03_r8,0.58346e-03_r8,0.54799e-03_r8,0.51859e-03_r8,0.49982e-03_r8, & + & 0.46218e-03_r8,0.39875e-03_r8,0.32573e-03_r8,0.31655e-03_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.61155e-03_r8,0.53549e-03_r8,0.47878e-03_r8,0.42579e-03_r8,0.37499e-03_r8, & + & 0.31961e-03_r8,0.25793e-03_r8,0.18655e-03_r8,0.11490e-03_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.61794e-03_r8,0.54314e-03_r8,0.48878e-03_r8,0.44250e-03_r8,0.39687e-03_r8, & + & 0.34151e-03_r8,0.28569e-03_r8,0.21436e-03_r8,0.14511e-03_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.62338e-03_r8,0.55078e-03_r8,0.50083e-03_r8,0.46354e-03_r8,0.41796e-03_r8, & + & 0.37306e-03_r8,0.31954e-03_r8,0.24508e-03_r8,0.17854e-03_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.62936e-03_r8,0.55894e-03_r8,0.51722e-03_r8,0.48335e-03_r8,0.44775e-03_r8, & + & 0.41130e-03_r8,0.35579e-03_r8,0.27533e-03_r8,0.21988e-03_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.63545e-03_r8,0.56698e-03_r8,0.53473e-03_r8,0.50887e-03_r8,0.48603e-03_r8, & + & 0.45259e-03_r8,0.39001e-03_r8,0.30792e-03_r8,0.27464e-03_r8 /) + kao(:, 1,10,11) = (/ & + & 0.57726e-03_r8,0.50676e-03_r8,0.45606e-03_r8,0.40779e-03_r8,0.35629e-03_r8, & + & 0.30220e-03_r8,0.24273e-03_r8,0.17731e-03_r8,0.97262e-04_r8 /) + kao(:, 2,10,11) = (/ & + & 0.58382e-03_r8,0.51548e-03_r8,0.46729e-03_r8,0.42570e-03_r8,0.37915e-03_r8, & + & 0.32497e-03_r8,0.26965e-03_r8,0.20381e-03_r8,0.12529e-03_r8 /) + kao(:, 3,10,11) = (/ & + & 0.59071e-03_r8,0.52512e-03_r8,0.48044e-03_r8,0.44753e-03_r8,0.40142e-03_r8, & + & 0.35504e-03_r8,0.30526e-03_r8,0.23284e-03_r8,0.15783e-03_r8 /) + kao(:, 4,10,11) = (/ & + & 0.59829e-03_r8,0.53444e-03_r8,0.49886e-03_r8,0.46810e-03_r8,0.43172e-03_r8, & + & 0.39380e-03_r8,0.34313e-03_r8,0.26284e-03_r8,0.19647e-03_r8 /) + kao(:, 5,10,11) = (/ & + & 0.60558e-03_r8,0.54444e-03_r8,0.51788e-03_r8,0.49497e-03_r8,0.47022e-03_r8, & + & 0.43733e-03_r8,0.37954e-03_r8,0.29404e-03_r8,0.24439e-03_r8 /) + kao(:, 1,11,11) = (/ & + & 0.53880e-03_r8,0.47669e-03_r8,0.43422e-03_r8,0.39066e-03_r8,0.34441e-03_r8, & + & 0.29300e-03_r8,0.23722e-03_r8,0.17846e-03_r8,0.93053e-04_r8 /) + kao(:, 2,11,11) = (/ & + & 0.54672e-03_r8,0.48762e-03_r8,0.44694e-03_r8,0.41155e-03_r8,0.36791e-03_r8, & + & 0.31854e-03_r8,0.26663e-03_r8,0.20551e-03_r8,0.12100e-03_r8 /) + kao(:, 3,11,11) = (/ & + & 0.55543e-03_r8,0.49853e-03_r8,0.46450e-03_r8,0.43411e-03_r8,0.39364e-03_r8, & + & 0.35233e-03_r8,0.30378e-03_r8,0.23442e-03_r8,0.15474e-03_r8 /) + kao(:, 4,11,11) = (/ & + & 0.56418e-03_r8,0.50955e-03_r8,0.48543e-03_r8,0.45785e-03_r8,0.42947e-03_r8, & + & 0.39274e-03_r8,0.34329e-03_r8,0.26304e-03_r8,0.19545e-03_r8 /) + kao(:, 5,11,11) = (/ & + & 0.57281e-03_r8,0.52221e-03_r8,0.50507e-03_r8,0.49044e-03_r8,0.47093e-03_r8, & + & 0.43647e-03_r8,0.38057e-03_r8,0.29685e-03_r8,0.24345e-03_r8 /) + kao(:, 1,12,11) = (/ & + & 0.49534e-03_r8,0.44336e-03_r8,0.40843e-03_r8,0.37029e-03_r8,0.32924e-03_r8, & + & 0.28268e-03_r8,0.23204e-03_r8,0.17692e-03_r8,0.89557e-04_r8 /) + kao(:, 2,12,11) = (/ & + & 0.50529e-03_r8,0.45586e-03_r8,0.42428e-03_r8,0.39360e-03_r8,0.35384e-03_r8, & + & 0.31099e-03_r8,0.26296e-03_r8,0.20575e-03_r8,0.11779e-03_r8 /) + kao(:, 3,12,11) = (/ & + & 0.51591e-03_r8,0.46841e-03_r8,0.44557e-03_r8,0.41710e-03_r8,0.38396e-03_r8, & + & 0.34779e-03_r8,0.29981e-03_r8,0.23475e-03_r8,0.15231e-03_r8 /) + kao(:, 4,12,11) = (/ & + & 0.52638e-03_r8,0.48189e-03_r8,0.46689e-03_r8,0.44567e-03_r8,0.42354e-03_r8, & + & 0.38951e-03_r8,0.33959e-03_r8,0.26406e-03_r8,0.19354e-03_r8 /) + kao(:, 5,12,11) = (/ & + & 0.53740e-03_r8,0.49847e-03_r8,0.48961e-03_r8,0.48352e-03_r8,0.46848e-03_r8, & + & 0.43322e-03_r8,0.37807e-03_r8,0.30031e-03_r8,0.24179e-03_r8 /) + kao(:, 1,13,11) = (/ & + & 0.44967e-03_r8,0.40765e-03_r8,0.37964e-03_r8,0.34767e-03_r8,0.31190e-03_r8, & + & 0.27110e-03_r8,0.22687e-03_r8,0.17331e-03_r8,0.86456e-04_r8 /) + kao(:, 2,13,11) = (/ & + & 0.46197e-03_r8,0.42196e-03_r8,0.40010e-03_r8,0.37282e-03_r8,0.33881e-03_r8, & + & 0.30170e-03_r8,0.25812e-03_r8,0.20314e-03_r8,0.11471e-03_r8 /) + kao(:, 3,13,11) = (/ & + & 0.47416e-03_r8,0.43662e-03_r8,0.42347e-03_r8,0.39902e-03_r8,0.37341e-03_r8, & + & 0.34073e-03_r8,0.29426e-03_r8,0.23321e-03_r8,0.14921e-03_r8 /) + kao(:, 4,13,11) = (/ & + & 0.48670e-03_r8,0.45348e-03_r8,0.44656e-03_r8,0.43321e-03_r8,0.41603e-03_r8, & + & 0.38366e-03_r8,0.33328e-03_r8,0.26489e-03_r8,0.19032e-03_r8 /) + kao(:, 5,13,11) = (/ & + & 0.49941e-03_r8,0.47298e-03_r8,0.47361e-03_r8,0.47457e-03_r8,0.46263e-03_r8, & + & 0.42791e-03_r8,0.37404e-03_r8,0.30319e-03_r8,0.23864e-03_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.67194e-03_r8,0.58821e-03_r8,0.50483e-03_r8,0.44022e-03_r8,0.39428e-03_r8, & + & 0.35001e-03_r8,0.32802e-03_r8,0.34712e-03_r8,0.40424e-03_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.66779e-03_r8,0.58462e-03_r8,0.50560e-03_r8,0.45370e-03_r8,0.41018e-03_r8, & + & 0.37788e-03_r8,0.37804e-03_r8,0.41641e-03_r8,0.48433e-03_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.66375e-03_r8,0.58112e-03_r8,0.50831e-03_r8,0.46547e-03_r8,0.43045e-03_r8, & + & 0.42028e-03_r8,0.43766e-03_r8,0.49681e-03_r8,0.57585e-03_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.65976e-03_r8,0.57768e-03_r8,0.51951e-03_r8,0.47941e-03_r8,0.45883e-03_r8, & + & 0.47280e-03_r8,0.50926e-03_r8,0.58385e-03_r8,0.67578e-03_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.65493e-03_r8,0.57349e-03_r8,0.52976e-03_r8,0.49649e-03_r8,0.49872e-03_r8, & + & 0.52477e-03_r8,0.58910e-03_r8,0.67477e-03_r8,0.78177e-03_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.74429e-03_r8,0.65147e-03_r8,0.55958e-03_r8,0.48439e-03_r8,0.43163e-03_r8, & + & 0.37450e-03_r8,0.34047e-03_r8,0.34702e-03_r8,0.40780e-03_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.73897e-03_r8,0.64685e-03_r8,0.56004e-03_r8,0.49710e-03_r8,0.44831e-03_r8, & + & 0.39986e-03_r8,0.38897e-03_r8,0.41601e-03_r8,0.48800e-03_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.73423e-03_r8,0.64274e-03_r8,0.56120e-03_r8,0.51084e-03_r8,0.46668e-03_r8, & + & 0.44211e-03_r8,0.44391e-03_r8,0.49187e-03_r8,0.57573e-03_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.72906e-03_r8,0.63825e-03_r8,0.57090e-03_r8,0.52414e-03_r8,0.49429e-03_r8, & + & 0.48962e-03_r8,0.50615e-03_r8,0.57487e-03_r8,0.67078e-03_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.72487e-03_r8,0.63461e-03_r8,0.58043e-03_r8,0.54078e-03_r8,0.53373e-03_r8, & + & 0.54010e-03_r8,0.58187e-03_r8,0.66737e-03_r8,0.77655e-03_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.81958e-03_r8,0.71735e-03_r8,0.61664e-03_r8,0.53266e-03_r8,0.46619e-03_r8, & + & 0.39818e-03_r8,0.35035e-03_r8,0.33455e-03_r8,0.39417e-03_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.81517e-03_r8,0.71349e-03_r8,0.61778e-03_r8,0.54292e-03_r8,0.48245e-03_r8, & + & 0.42187e-03_r8,0.39187e-03_r8,0.40203e-03_r8,0.47500e-03_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.81131e-03_r8,0.71014e-03_r8,0.61887e-03_r8,0.55563e-03_r8,0.49928e-03_r8, & + & 0.45852e-03_r8,0.44599e-03_r8,0.47656e-03_r8,0.56304e-03_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.80684e-03_r8,0.70624e-03_r8,0.62502e-03_r8,0.56854e-03_r8,0.52516e-03_r8, & + & 0.50282e-03_r8,0.50405e-03_r8,0.55674e-03_r8,0.65701e-03_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.80277e-03_r8,0.70271e-03_r8,0.63387e-03_r8,0.58439e-03_r8,0.56394e-03_r8, & + & 0.54984e-03_r8,0.57036e-03_r8,0.64435e-03_r8,0.75883e-03_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.88962e-03_r8,0.77859e-03_r8,0.66931e-03_r8,0.57740e-03_r8,0.50138e-03_r8, & + & 0.42396e-03_r8,0.36076e-03_r8,0.31901e-03_r8,0.36723e-03_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.88665e-03_r8,0.77601e-03_r8,0.67190e-03_r8,0.58651e-03_r8,0.51766e-03_r8, & + & 0.44641e-03_r8,0.39755e-03_r8,0.38137e-03_r8,0.44921e-03_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.88362e-03_r8,0.77338e-03_r8,0.67394e-03_r8,0.60034e-03_r8,0.53406e-03_r8, & + & 0.47716e-03_r8,0.44855e-03_r8,0.45695e-03_r8,0.53953e-03_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.87936e-03_r8,0.76967e-03_r8,0.67789e-03_r8,0.61530e-03_r8,0.55605e-03_r8, & + & 0.52026e-03_r8,0.50535e-03_r8,0.53746e-03_r8,0.63432e-03_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.87542e-03_r8,0.76625e-03_r8,0.68901e-03_r8,0.63085e-03_r8,0.59283e-03_r8, & + & 0.56499e-03_r8,0.56855e-03_r8,0.62330e-03_r8,0.73477e-03_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.95206e-03_r8,0.83319e-03_r8,0.71670e-03_r8,0.61887e-03_r8,0.53098e-03_r8, & + & 0.45065e-03_r8,0.37161e-03_r8,0.30790e-03_r8,0.33661e-03_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.95024e-03_r8,0.83163e-03_r8,0.72052e-03_r8,0.62686e-03_r8,0.54899e-03_r8, & + & 0.47363e-03_r8,0.40570e-03_r8,0.36303e-03_r8,0.41611e-03_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.94830e-03_r8,0.82995e-03_r8,0.72350e-03_r8,0.64294e-03_r8,0.56882e-03_r8, & + & 0.49923e-03_r8,0.45370e-03_r8,0.43446e-03_r8,0.50740e-03_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.94590e-03_r8,0.82788e-03_r8,0.72796e-03_r8,0.66075e-03_r8,0.59106e-03_r8, & + & 0.53960e-03_r8,0.50922e-03_r8,0.51449e-03_r8,0.60347e-03_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.94431e-03_r8,0.82652e-03_r8,0.73985e-03_r8,0.67685e-03_r8,0.62406e-03_r8, & + & 0.58535e-03_r8,0.56960e-03_r8,0.60003e-03_r8,0.70205e-03_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.10063e-02_r8,0.88067e-03_r8,0.75816e-03_r8,0.65590e-03_r8,0.55704e-03_r8, & + & 0.47312e-03_r8,0.38218e-03_r8,0.29812e-03_r8,0.29923e-03_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.10075e-02_r8,0.88171e-03_r8,0.76490e-03_r8,0.66447e-03_r8,0.57639e-03_r8, & + & 0.49685e-03_r8,0.41345e-03_r8,0.34724e-03_r8,0.37557e-03_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.10072e-02_r8,0.88152e-03_r8,0.76915e-03_r8,0.68176e-03_r8,0.59750e-03_r8, & + & 0.52339e-03_r8,0.45689e-03_r8,0.41130e-03_r8,0.46505e-03_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.10060e-02_r8,0.88049e-03_r8,0.77394e-03_r8,0.69974e-03_r8,0.62189e-03_r8, & + & 0.55958e-03_r8,0.51188e-03_r8,0.48580e-03_r8,0.55924e-03_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.10051e-02_r8,0.87967e-03_r8,0.78569e-03_r8,0.71720e-03_r8,0.65527e-03_r8, & + & 0.60501e-03_r8,0.57082e-03_r8,0.56756e-03_r8,0.65737e-03_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.10487e-02_r8,0.91773e-03_r8,0.79062e-03_r8,0.68516e-03_r8,0.57878e-03_r8, & + & 0.49035e-03_r8,0.39066e-03_r8,0.28990e-03_r8,0.26192e-03_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.10509e-02_r8,0.91972e-03_r8,0.79894e-03_r8,0.69452e-03_r8,0.59953e-03_r8, & + & 0.51487e-03_r8,0.42128e-03_r8,0.33451e-03_r8,0.33284e-03_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.10507e-02_r8,0.91957e-03_r8,0.80398e-03_r8,0.71157e-03_r8,0.62221e-03_r8, & + & 0.54150e-03_r8,0.46197e-03_r8,0.39208e-03_r8,0.41685e-03_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.10509e-02_r8,0.91973e-03_r8,0.80950e-03_r8,0.73042e-03_r8,0.64659e-03_r8, & + & 0.57916e-03_r8,0.51360e-03_r8,0.46065e-03_r8,0.50813e-03_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.10509e-02_r8,0.91978e-03_r8,0.82196e-03_r8,0.75027e-03_r8,0.67740e-03_r8, & + & 0.62606e-03_r8,0.57168e-03_r8,0.53418e-03_r8,0.60461e-03_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.10710e-02_r8,0.93729e-03_r8,0.80929e-03_r8,0.70366e-03_r8,0.59621e-03_r8, & + & 0.50074e-03_r8,0.39602e-03_r8,0.28309e-03_r8,0.22630e-03_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.10749e-02_r8,0.94069e-03_r8,0.82032e-03_r8,0.71447e-03_r8,0.61694e-03_r8, & + & 0.52833e-03_r8,0.42406e-03_r8,0.32400e-03_r8,0.29100e-03_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.10773e-02_r8,0.94281e-03_r8,0.82736e-03_r8,0.73051e-03_r8,0.64296e-03_r8, & + & 0.55298e-03_r8,0.46605e-03_r8,0.37591e-03_r8,0.36869e-03_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.10796e-02_r8,0.94487e-03_r8,0.83459e-03_r8,0.75111e-03_r8,0.66786e-03_r8, & + & 0.59048e-03_r8,0.51603e-03_r8,0.43920e-03_r8,0.45502e-03_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.10814e-02_r8,0.94726e-03_r8,0.84809e-03_r8,0.77185e-03_r8,0.69811e-03_r8, & + & 0.64090e-03_r8,0.57338e-03_r8,0.50692e-03_r8,0.54643e-03_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.10730e-02_r8,0.93903e-03_r8,0.81373e-03_r8,0.70878e-03_r8,0.60523e-03_r8, & + & 0.50463e-03_r8,0.39690e-03_r8,0.27640e-03_r8,0.19492e-03_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.10796e-02_r8,0.94482e-03_r8,0.82740e-03_r8,0.72216e-03_r8,0.62667e-03_r8, & + & 0.53533e-03_r8,0.42406e-03_r8,0.31368e-03_r8,0.25100e-03_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.10853e-02_r8,0.94982e-03_r8,0.83742e-03_r8,0.73904e-03_r8,0.65592e-03_r8, & + & 0.56092e-03_r8,0.46365e-03_r8,0.36183e-03_r8,0.32022e-03_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.10900e-02_r8,0.95441e-03_r8,0.84774e-03_r8,0.76272e-03_r8,0.68162e-03_r8, & + & 0.59735e-03_r8,0.51414e-03_r8,0.41927e-03_r8,0.39972e-03_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.10952e-02_r8,0.96081e-03_r8,0.86364e-03_r8,0.78596e-03_r8,0.71341e-03_r8, & + & 0.64539e-03_r8,0.57286e-03_r8,0.48249e-03_r8,0.48653e-03_r8 /) + kao(:, 1,10,12) = (/ & + & 0.10558e-02_r8,0.92391e-03_r8,0.80426e-03_r8,0.70294e-03_r8,0.60555e-03_r8, & + & 0.50218e-03_r8,0.39384e-03_r8,0.27052e-03_r8,0.17175e-03_r8 /) + kao(:, 2,10,12) = (/ & + & 0.10672e-02_r8,0.93391e-03_r8,0.82187e-03_r8,0.72055e-03_r8,0.62861e-03_r8, & + & 0.53517e-03_r8,0.42394e-03_r8,0.30520e-03_r8,0.22066e-03_r8 /) + kao(:, 3,10,12) = (/ & + & 0.10767e-02_r8,0.94234e-03_r8,0.83636e-03_r8,0.73971e-03_r8,0.66074e-03_r8, & + & 0.56459e-03_r8,0.46058e-03_r8,0.35232e-03_r8,0.28101e-03_r8 /) + kao(:, 4,10,12) = (/ & + & 0.10858e-02_r8,0.95208e-03_r8,0.85075e-03_r8,0.76653e-03_r8,0.68963e-03_r8, & + & 0.60125e-03_r8,0.51089e-03_r8,0.40664e-03_r8,0.35284e-03_r8 /) + kao(:, 5,10,12) = (/ & + & 0.10953e-02_r8,0.96285e-03_r8,0.86971e-03_r8,0.79369e-03_r8,0.72347e-03_r8, & + & 0.65043e-03_r8,0.57028e-03_r8,0.46529e-03_r8,0.43428e-03_r8 /) + kao(:, 1,11,12) = (/ & + & 0.10314e-02_r8,0.90258e-03_r8,0.79467e-03_r8,0.69943e-03_r8,0.60546e-03_r8, & + & 0.50625e-03_r8,0.39977e-03_r8,0.27736e-03_r8,0.16855e-03_r8 /) + kao(:, 2,11,12) = (/ & + & 0.10451e-02_r8,0.91471e-03_r8,0.81404e-03_r8,0.71994e-03_r8,0.63569e-03_r8, & + & 0.54231e-03_r8,0.43348e-03_r8,0.31480e-03_r8,0.21751e-03_r8 /) + kao(:, 3,11,12) = (/ & + & 0.10591e-02_r8,0.92888e-03_r8,0.83171e-03_r8,0.74582e-03_r8,0.67129e-03_r8, & + & 0.57545e-03_r8,0.47649e-03_r8,0.36327e-03_r8,0.27482e-03_r8 /) + kao(:, 4,11,12) = (/ & + & 0.10732e-02_r8,0.94400e-03_r8,0.85133e-03_r8,0.77904e-03_r8,0.70324e-03_r8, & + & 0.62021e-03_r8,0.53030e-03_r8,0.41771e-03_r8,0.34284e-03_r8 /) + kao(:, 5,11,12) = (/ & + & 0.10880e-02_r8,0.96010e-03_r8,0.87843e-03_r8,0.80902e-03_r8,0.74479e-03_r8, & + & 0.67711e-03_r8,0.59146e-03_r8,0.47518e-03_r8,0.42405e-03_r8 /) + kao(:, 1,12,12) = (/ & + & 0.99800e-03_r8,0.87344e-03_r8,0.77838e-03_r8,0.69077e-03_r8,0.60021e-03_r8, & + & 0.50540e-03_r8,0.40237e-03_r8,0.28326e-03_r8,0.16340e-03_r8 /) + kao(:, 2,12,12) = (/ & + & 0.10163e-02_r8,0.89149e-03_r8,0.80050e-03_r8,0.71513e-03_r8,0.63616e-03_r8, & + & 0.54455e-03_r8,0.44056e-03_r8,0.32235e-03_r8,0.21276e-03_r8 /) + kao(:, 3,12,12) = (/ & + & 0.10345e-02_r8,0.91067e-03_r8,0.82237e-03_r8,0.74899e-03_r8,0.67503e-03_r8, & + & 0.58381e-03_r8,0.48916e-03_r8,0.37171e-03_r8,0.26817e-03_r8 /) + kao(:, 4,12,12) = (/ & + & 0.10541e-02_r8,0.93146e-03_r8,0.84943e-03_r8,0.78581e-03_r8,0.71327e-03_r8, & + & 0.63724e-03_r8,0.54703e-03_r8,0.42621e-03_r8,0.33361e-03_r8 /) + kao(:, 5,12,12) = (/ & + & 0.10724e-02_r8,0.95127e-03_r8,0.88178e-03_r8,0.82065e-03_r8,0.76248e-03_r8, & + & 0.70028e-03_r8,0.60892e-03_r8,0.48179e-03_r8,0.41458e-03_r8 /) + kao(:, 1,13,12) = (/ & + & 0.95912e-03_r8,0.84178e-03_r8,0.75778e-03_r8,0.67765e-03_r8,0.59123e-03_r8, & + & 0.50112e-03_r8,0.40170e-03_r8,0.28784e-03_r8,0.15761e-03_r8 /) + kao(:, 2,13,12) = (/ & + & 0.98187e-03_r8,0.86541e-03_r8,0.78344e-03_r8,0.70851e-03_r8,0.63200e-03_r8, & + & 0.54351e-03_r8,0.44541e-03_r8,0.32864e-03_r8,0.20682e-03_r8 /) + kao(:, 3,13,12) = (/ & + & 0.10063e-02_r8,0.89078e-03_r8,0.81111e-03_r8,0.74766e-03_r8,0.67473e-03_r8, & + & 0.58963e-03_r8,0.49872e-03_r8,0.37736e-03_r8,0.26208e-03_r8 /) + kao(:, 4,13,12) = (/ & + & 0.10299e-02_r8,0.91565e-03_r8,0.84455e-03_r8,0.78769e-03_r8,0.71894e-03_r8, & + & 0.65012e-03_r8,0.55995e-03_r8,0.43170e-03_r8,0.32660e-03_r8 /) + kao(:, 5,13,12) = (/ & + & 0.10525e-02_r8,0.93912e-03_r8,0.88061e-03_r8,0.82863e-03_r8,0.77810e-03_r8, & + & 0.71766e-03_r8,0.62330e-03_r8,0.48589e-03_r8,0.40661e-03_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.84224e-03_r8,0.73740e-03_r8,0.63257e-03_r8,0.54853e-03_r8,0.48911e-03_r8, & + & 0.46139e-03_r8,0.45309e-03_r8,0.51018e-03_r8,0.59300e-03_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.83841e-03_r8,0.73411e-03_r8,0.62983e-03_r8,0.55802e-03_r8,0.51855e-03_r8, & + & 0.50261e-03_r8,0.52209e-03_r8,0.59394e-03_r8,0.69158e-03_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.83593e-03_r8,0.73202e-03_r8,0.62914e-03_r8,0.58596e-03_r8,0.54957e-03_r8, & + & 0.55151e-03_r8,0.60969e-03_r8,0.69097e-03_r8,0.80707e-03_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.83246e-03_r8,0.72902e-03_r8,0.63274e-03_r8,0.60961e-03_r8,0.59022e-03_r8, & + & 0.61063e-03_r8,0.70961e-03_r8,0.80207e-03_r8,0.93855e-03_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.82958e-03_r8,0.72654e-03_r8,0.65011e-03_r8,0.63711e-03_r8,0.63941e-03_r8, & + & 0.69313e-03_r8,0.82070e-03_r8,0.92941e-03_r8,0.10860e-02_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.94737e-03_r8,0.82928e-03_r8,0.71121e-03_r8,0.61292e-03_r8,0.53888e-03_r8, & + & 0.49608e-03_r8,0.46449e-03_r8,0.50895e-03_r8,0.59638e-03_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.94309e-03_r8,0.82559e-03_r8,0.70809e-03_r8,0.61981e-03_r8,0.56880e-03_r8, & + & 0.53738e-03_r8,0.52906e-03_r8,0.59714e-03_r8,0.70098e-03_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.93813e-03_r8,0.82131e-03_r8,0.70667e-03_r8,0.64442e-03_r8,0.60095e-03_r8, & + & 0.58581e-03_r8,0.62140e-03_r8,0.70455e-03_r8,0.83109e-03_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.93357e-03_r8,0.81735e-03_r8,0.70879e-03_r8,0.66885e-03_r8,0.63704e-03_r8, & + & 0.64975e-03_r8,0.73250e-03_r8,0.82836e-03_r8,0.97995e-03_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.92926e-03_r8,0.81362e-03_r8,0.72487e-03_r8,0.69759e-03_r8,0.68443e-03_r8, & + & 0.72989e-03_r8,0.85114e-03_r8,0.96045e-03_r8,0.11390e-02_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.10589e-02_r8,0.92685e-03_r8,0.79478e-03_r8,0.68185e-03_r8,0.58961e-03_r8, & + & 0.52592e-03_r8,0.47382e-03_r8,0.49304e-03_r8,0.58474e-03_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.10532e-02_r8,0.92189e-03_r8,0.79057e-03_r8,0.68536e-03_r8,0.61794e-03_r8, & + & 0.56535e-03_r8,0.53040e-03_r8,0.57934e-03_r8,0.68761e-03_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.10466e-02_r8,0.91613e-03_r8,0.78805e-03_r8,0.70517e-03_r8,0.65240e-03_r8, & + & 0.61071e-03_r8,0.61067e-03_r8,0.68776e-03_r8,0.81827e-03_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.10406e-02_r8,0.91088e-03_r8,0.78949e-03_r8,0.73011e-03_r8,0.68643e-03_r8, & + & 0.67486e-03_r8,0.72316e-03_r8,0.82048e-03_r8,0.97591e-03_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.10350e-02_r8,0.90609e-03_r8,0.80184e-03_r8,0.75651e-03_r8,0.73102e-03_r8, & + & 0.75672e-03_r8,0.85035e-03_r8,0.96398e-03_r8,0.11483e-02_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.11788e-02_r8,0.10317e-02_r8,0.88462e-03_r8,0.75562e-03_r8,0.64370e-03_r8, & + & 0.55868e-03_r8,0.48899e-03_r8,0.48008e-03_r8,0.57112e-03_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.11725e-02_r8,0.10263e-02_r8,0.87998e-03_r8,0.75781e-03_r8,0.66989e-03_r8, & + & 0.59814e-03_r8,0.54177e-03_r8,0.56164e-03_r8,0.66999e-03_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.11654e-02_r8,0.10201e-02_r8,0.87720e-03_r8,0.76990e-03_r8,0.70381e-03_r8, & + & 0.63928e-03_r8,0.60787e-03_r8,0.66447e-03_r8,0.79300e-03_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.11592e-02_r8,0.10147e-02_r8,0.87854e-03_r8,0.79340e-03_r8,0.73787e-03_r8, & + & 0.69602e-03_r8,0.70539e-03_r8,0.79266e-03_r8,0.94522e-03_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.11532e-02_r8,0.10094e-02_r8,0.88452e-03_r8,0.81797e-03_r8,0.78065e-03_r8, & + & 0.77762e-03_r8,0.82734e-03_r8,0.94053e-03_r8,0.11199e-02_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.13090e-02_r8,0.11455e-02_r8,0.98213e-03_r8,0.83571e-03_r8,0.70447e-03_r8, & + & 0.59736e-03_r8,0.51100e-03_r8,0.46541e-03_r8,0.54756e-03_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.13011e-02_r8,0.11387e-02_r8,0.97633e-03_r8,0.83818e-03_r8,0.72563e-03_r8, & + & 0.63146e-03_r8,0.56040e-03_r8,0.54671e-03_r8,0.65045e-03_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.12919e-02_r8,0.11307e-02_r8,0.97249e-03_r8,0.84355e-03_r8,0.75615e-03_r8, & + & 0.67456e-03_r8,0.62106e-03_r8,0.64503e-03_r8,0.77294e-03_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.12834e-02_r8,0.11233e-02_r8,0.97228e-03_r8,0.86290e-03_r8,0.79001e-03_r8, & + & 0.72644e-03_r8,0.70406e-03_r8,0.76742e-03_r8,0.92034e-03_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.12754e-02_r8,0.11163e-02_r8,0.97447e-03_r8,0.88787e-03_r8,0.82956e-03_r8, & + & 0.80041e-03_r8,0.81433e-03_r8,0.91302e-03_r8,0.10923e-02_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.14384e-02_r8,0.12588e-02_r8,0.10791e-02_r8,0.91745e-03_r8,0.77222e-03_r8, & + & 0.63777e-03_r8,0.53552e-03_r8,0.44917e-03_r8,0.50804e-03_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.14296e-02_r8,0.12511e-02_r8,0.10726e-02_r8,0.92106e-03_r8,0.78721e-03_r8, & + & 0.67056e-03_r8,0.58135e-03_r8,0.52600e-03_r8,0.61657e-03_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.14197e-02_r8,0.12425e-02_r8,0.10687e-02_r8,0.92311e-03_r8,0.81466e-03_r8, & + & 0.70925e-03_r8,0.63651e-03_r8,0.62263e-03_r8,0.74116e-03_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.14113e-02_r8,0.12351e-02_r8,0.10686e-02_r8,0.93888e-03_r8,0.84557e-03_r8, & + & 0.75721e-03_r8,0.71295e-03_r8,0.74435e-03_r8,0.88914e-03_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.14033e-02_r8,0.12282e-02_r8,0.10694e-02_r8,0.96147e-03_r8,0.87768e-03_r8, & + & 0.82519e-03_r8,0.81219e-03_r8,0.88552e-03_r8,0.10599e-02_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.15646e-02_r8,0.13692e-02_r8,0.11737e-02_r8,0.99670e-03_r8,0.83910e-03_r8, & + & 0.68337e-03_r8,0.56133e-03_r8,0.43784e-03_r8,0.46053e-03_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.15575e-02_r8,0.13630e-02_r8,0.11685e-02_r8,0.10035e-02_r8,0.85062e-03_r8, & + & 0.71436e-03_r8,0.60284e-03_r8,0.50378e-03_r8,0.56665e-03_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.15495e-02_r8,0.13560e-02_r8,0.11666e-02_r8,0.10059e-02_r8,0.87670e-03_r8, & + & 0.74963e-03_r8,0.65339e-03_r8,0.59583e-03_r8,0.69467e-03_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.15420e-02_r8,0.13494e-02_r8,0.11678e-02_r8,0.10189e-02_r8,0.90417e-03_r8, & + & 0.79237e-03_r8,0.72265e-03_r8,0.71412e-03_r8,0.84581e-03_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.15345e-02_r8,0.13429e-02_r8,0.11695e-02_r8,0.10414e-02_r8,0.93588e-03_r8, & + & 0.84978e-03_r8,0.81799e-03_r8,0.85682e-03_r8,0.10184e-02_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.16856e-02_r8,0.14750e-02_r8,0.12645e-02_r8,0.10725e-02_r8,0.90201e-03_r8, & + & 0.73159e-03_r8,0.58478e-03_r8,0.43268e-03_r8,0.41101e-03_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.16806e-02_r8,0.14706e-02_r8,0.12609e-02_r8,0.10836e-02_r8,0.91363e-03_r8, & + & 0.76033e-03_r8,0.62810e-03_r8,0.48786e-03_r8,0.51346e-03_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.16744e-02_r8,0.14652e-02_r8,0.12612e-02_r8,0.10887e-02_r8,0.93599e-03_r8, & + & 0.79815e-03_r8,0.66916e-03_r8,0.56926e-03_r8,0.63978e-03_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.16684e-02_r8,0.14601e-02_r8,0.12641e-02_r8,0.11000e-02_r8,0.96490e-03_r8, & + & 0.83543e-03_r8,0.73243e-03_r8,0.67845e-03_r8,0.78892e-03_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.16618e-02_r8,0.14543e-02_r8,0.12671e-02_r8,0.11238e-02_r8,0.99451e-03_r8, & + & 0.88426e-03_r8,0.81935e-03_r8,0.81741e-03_r8,0.96330e-03_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.17934e-02_r8,0.15694e-02_r8,0.13453e-02_r8,0.11410e-02_r8,0.95885e-03_r8, & + & 0.77818e-03_r8,0.60653e-03_r8,0.43079e-03_r8,0.36156e-03_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.17902e-02_r8,0.15666e-02_r8,0.13435e-02_r8,0.11557e-02_r8,0.97291e-03_r8, & + & 0.80328e-03_r8,0.65101e-03_r8,0.47930e-03_r8,0.45791e-03_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.17870e-02_r8,0.15637e-02_r8,0.13465e-02_r8,0.11644e-02_r8,0.99290e-03_r8, & + & 0.84365e-03_r8,0.69043e-03_r8,0.54887e-03_r8,0.58027e-03_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.17836e-02_r8,0.15608e-02_r8,0.13520e-02_r8,0.11761e-02_r8,0.10245e-02_r8, & + & 0.87956e-03_r8,0.74487e-03_r8,0.64626e-03_r8,0.72649e-03_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.17784e-02_r8,0.15563e-02_r8,0.13567e-02_r8,0.11994e-02_r8,0.10543e-02_r8, & + & 0.92517e-03_r8,0.82194e-03_r8,0.77306e-03_r8,0.89652e-03_r8 /) + kao(:, 1,10,13) = (/ & + & 0.18870e-02_r8,0.16513e-02_r8,0.14155e-02_r8,0.12026e-02_r8,0.10094e-02_r8, & + & 0.82157e-03_r8,0.62812e-03_r8,0.43279e-03_r8,0.32100e-03_r8 /) + kao(:, 2,10,13) = (/ & + & 0.18874e-02_r8,0.16516e-02_r8,0.14168e-02_r8,0.12199e-02_r8,0.10267e-02_r8, & + & 0.84527e-03_r8,0.67192e-03_r8,0.47951e-03_r8,0.41207e-03_r8 /) + kao(:, 3,10,13) = (/ & + & 0.18869e-02_r8,0.16512e-02_r8,0.14226e-02_r8,0.12326e-02_r8,0.10456e-02_r8, & + & 0.88603e-03_r8,0.71450e-03_r8,0.53998e-03_r8,0.52708e-03_r8 /) + kao(:, 4,10,13) = (/ & + & 0.18844e-02_r8,0.16490e-02_r8,0.14297e-02_r8,0.12452e-02_r8,0.10784e-02_r8, & + & 0.92565e-03_r8,0.76291e-03_r8,0.62910e-03_r8,0.66842e-03_r8 /) + kao(:, 5,10,13) = (/ & + & 0.18812e-02_r8,0.16463e-02_r8,0.14369e-02_r8,0.12677e-02_r8,0.11133e-02_r8, & + & 0.96733e-03_r8,0.83676e-03_r8,0.74378e-03_r8,0.83514e-03_r8 /) + kao(:, 1,11,13) = (/ & + & 0.19652e-02_r8,0.17197e-02_r8,0.14741e-02_r8,0.12638e-02_r8,0.10628e-02_r8, & + & 0.86832e-03_r8,0.66314e-03_r8,0.45418e-03_r8,0.32052e-03_r8 /) + kao(:, 2,11,13) = (/ & + & 0.19706e-02_r8,0.17244e-02_r8,0.14828e-02_r8,0.12836e-02_r8,0.10826e-02_r8, & + & 0.89693e-03_r8,0.71120e-03_r8,0.50274e-03_r8,0.41269e-03_r8 /) + kao(:, 3,11,13) = (/ & + & 0.19727e-02_r8,0.17263e-02_r8,0.14935e-02_r8,0.12979e-02_r8,0.11060e-02_r8, & + & 0.94341e-03_r8,0.75411e-03_r8,0.56772e-03_r8,0.53374e-03_r8 /) + kao(:, 4,11,13) = (/ & + & 0.19726e-02_r8,0.17262e-02_r8,0.15047e-02_r8,0.13132e-02_r8,0.11439e-02_r8, & + & 0.98450e-03_r8,0.80814e-03_r8,0.66163e-03_r8,0.68012e-03_r8 /) + kao(:, 5,11,13) = (/ & + & 0.19717e-02_r8,0.17254e-02_r8,0.15111e-02_r8,0.13415e-02_r8,0.11812e-02_r8, & + & 0.10302e-02_r8,0.88976e-03_r8,0.77856e-03_r8,0.85217e-03_r8 /) + kao(:, 1,12,13) = (/ & + & 0.20238e-02_r8,0.17709e-02_r8,0.15209e-02_r8,0.13140e-02_r8,0.11103e-02_r8, & + & 0.90805e-03_r8,0.69487e-03_r8,0.47365e-03_r8,0.32170e-03_r8 /) + kao(:, 2,12,13) = (/ & + & 0.20339e-02_r8,0.17798e-02_r8,0.15376e-02_r8,0.13369e-02_r8,0.11339e-02_r8, & + & 0.94414e-03_r8,0.74487e-03_r8,0.52470e-03_r8,0.41340e-03_r8 /) + kao(:, 3,12,13) = (/ & + & 0.20400e-02_r8,0.17851e-02_r8,0.15537e-02_r8,0.13538e-02_r8,0.11634e-02_r8, & + & 0.99316e-03_r8,0.79139e-03_r8,0.59483e-03_r8,0.53800e-03_r8 /) + kao(:, 4,12,13) = (/ & + & 0.20440e-02_r8,0.17887e-02_r8,0.15672e-02_r8,0.13751e-02_r8,0.12054e-02_r8, & + & 0.10358e-02_r8,0.85239e-03_r8,0.69118e-03_r8,0.69062e-03_r8 /) + kao(:, 5,12,13) = (/ & + & 0.20478e-02_r8,0.17920e-02_r8,0.15770e-02_r8,0.14084e-02_r8,0.12434e-02_r8, & + & 0.10883e-02_r8,0.94102e-03_r8,0.81111e-03_r8,0.86624e-03_r8 /) + kao(:, 1,13,13) = (/ & + & 0.20618e-02_r8,0.18042e-02_r8,0.15564e-02_r8,0.13520e-02_r8,0.11495e-02_r8, & + & 0.94146e-03_r8,0.72197e-03_r8,0.49143e-03_r8,0.32080e-03_r8 /) + kao(:, 2,13,13) = (/ & + & 0.20769e-02_r8,0.18174e-02_r8,0.15793e-02_r8,0.13781e-02_r8,0.11781e-02_r8, & + & 0.98504e-03_r8,0.77410e-03_r8,0.54584e-03_r8,0.41409e-03_r8 /) + kao(:, 3,13,13) = (/ & + & 0.20884e-02_r8,0.18274e-02_r8,0.16007e-02_r8,0.14008e-02_r8,0.12152e-02_r8, & + & 0.10359e-02_r8,0.82528e-03_r8,0.62085e-03_r8,0.53970e-03_r8 /) + kao(:, 4,13,13) = (/ & + & 0.21000e-02_r8,0.18376e-02_r8,0.16180e-02_r8,0.14292e-02_r8,0.12615e-02_r8, & + & 0.10817e-02_r8,0.89457e-03_r8,0.71909e-03_r8,0.69474e-03_r8 /) + kao(:, 5,13,13) = (/ & + & 0.21077e-02_r8,0.18456e-02_r8,0.16335e-02_r8,0.14673e-02_r8,0.12995e-02_r8, & + & 0.11413e-02_r8,0.98821e-03_r8,0.84127e-03_r8,0.87402e-03_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.11199e-02_r8,0.98039e-03_r8,0.84084e-03_r8,0.70943e-03_r8,0.63603e-03_r8, & + & 0.60649e-03_r8,0.68312e-03_r8,0.76350e-03_r8,0.90110e-03_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.11157e-02_r8,0.97670e-03_r8,0.83773e-03_r8,0.72395e-03_r8,0.68641e-03_r8, & + & 0.69858e-03_r8,0.81907e-03_r8,0.92056e-03_r8,0.10823e-02_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.11108e-02_r8,0.97243e-03_r8,0.83426e-03_r8,0.74791e-03_r8,0.75340e-03_r8, & + & 0.82026e-03_r8,0.97233e-03_r8,0.10968e-02_r8,0.12857e-02_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.11077e-02_r8,0.96981e-03_r8,0.83196e-03_r8,0.80006e-03_r8,0.82593e-03_r8, & + & 0.96481e-03_r8,0.11451e-02_r8,0.12942e-02_r8,0.15153e-02_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.11057e-02_r8,0.96811e-03_r8,0.83287e-03_r8,0.85771e-03_r8,0.92243e-03_r8, & + & 0.11291e-02_r8,0.13401e-02_r8,0.15139e-02_r8,0.17730e-02_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.12618e-02_r8,0.11045e-02_r8,0.94731e-03_r8,0.80059e-03_r8,0.70460e-03_r8, & + & 0.66164e-03_r8,0.71798e-03_r8,0.80280e-03_r8,0.96182e-03_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.12573e-02_r8,0.11007e-02_r8,0.94415e-03_r8,0.81463e-03_r8,0.74844e-03_r8, & + & 0.74157e-03_r8,0.85097e-03_r8,0.95625e-03_r8,0.11395e-02_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.12537e-02_r8,0.10976e-02_r8,0.94166e-03_r8,0.83421e-03_r8,0.81760e-03_r8, & + & 0.85124e-03_r8,0.10029e-02_r8,0.11319e-02_r8,0.13421e-02_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.12517e-02_r8,0.10959e-02_r8,0.94019e-03_r8,0.88029e-03_r8,0.88890e-03_r8, & + & 0.98937e-03_r8,0.11747e-02_r8,0.13301e-02_r8,0.15715e-02_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.12484e-02_r8,0.10932e-02_r8,0.93873e-03_r8,0.93946e-03_r8,0.97784e-03_r8, & + & 0.11555e-02_r8,0.13735e-02_r8,0.15606e-02_r8,0.18367e-02_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.14334e-02_r8,0.12547e-02_r8,0.10760e-02_r8,0.90369e-03_r8,0.78163e-03_r8, & + & 0.71064e-03_r8,0.72074e-03_r8,0.81006e-03_r8,0.97636e-03_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.14266e-02_r8,0.12488e-02_r8,0.10711e-02_r8,0.91657e-03_r8,0.81392e-03_r8, & + & 0.78379e-03_r8,0.85758e-03_r8,0.96540e-03_r8,0.11622e-02_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.14223e-02_r8,0.12452e-02_r8,0.10680e-02_r8,0.93146e-03_r8,0.87510e-03_r8, & + & 0.87756e-03_r8,0.10059e-02_r8,0.11359e-02_r8,0.13619e-02_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.14175e-02_r8,0.12411e-02_r8,0.10646e-02_r8,0.96483e-03_r8,0.94572e-03_r8, & + & 0.99384e-03_r8,0.11710e-02_r8,0.13256e-02_r8,0.15838e-02_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.14120e-02_r8,0.12363e-02_r8,0.10614e-02_r8,0.10223e-02_r8,0.10225e-02_r8, & + & 0.11461e-02_r8,0.13616e-02_r8,0.15455e-02_r8,0.18394e-02_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.16334e-02_r8,0.14296e-02_r8,0.12259e-02_r8,0.10262e-02_r8,0.87529e-03_r8, & + & 0.76396e-03_r8,0.72119e-03_r8,0.79306e-03_r8,0.95651e-03_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.16232e-02_r8,0.14208e-02_r8,0.12185e-02_r8,0.10348e-02_r8,0.89367e-03_r8, & + & 0.83199e-03_r8,0.84657e-03_r8,0.95561e-03_r8,0.11474e-02_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.16152e-02_r8,0.14140e-02_r8,0.12127e-02_r8,0.10485e-02_r8,0.94236e-03_r8, & + & 0.91572e-03_r8,0.99902e-03_r8,0.11299e-02_r8,0.13583e-02_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.16069e-02_r8,0.14067e-02_r8,0.12065e-02_r8,0.10685e-02_r8,0.10126e-02_r8, & + & 0.10172e-02_r8,0.11639e-02_r8,0.13179e-02_r8,0.15822e-02_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.15986e-02_r8,0.13996e-02_r8,0.12009e-02_r8,0.11161e-02_r8,0.10822e-02_r8, & + & 0.11448e-02_r8,0.13482e-02_r8,0.15289e-02_r8,0.18307e-02_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.18523e-02_r8,0.16211e-02_r8,0.13900e-02_r8,0.11617e-02_r8,0.98609e-03_r8, & + & 0.83071e-03_r8,0.73506e-03_r8,0.77421e-03_r8,0.93359e-03_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.18399e-02_r8,0.16104e-02_r8,0.13808e-02_r8,0.11680e-02_r8,0.99824e-03_r8, & + & 0.89112e-03_r8,0.84383e-03_r8,0.93250e-03_r8,0.11210e-02_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.18296e-02_r8,0.16015e-02_r8,0.13734e-02_r8,0.11806e-02_r8,0.10315e-02_r8, & + & 0.96812e-03_r8,0.98130e-03_r8,0.11095e-02_r8,0.13275e-02_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.18179e-02_r8,0.15913e-02_r8,0.13647e-02_r8,0.11924e-02_r8,0.10905e-02_r8, & + & 0.10578e-02_r8,0.11513e-02_r8,0.13088e-02_r8,0.15638e-02_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.18067e-02_r8,0.15816e-02_r8,0.13575e-02_r8,0.12252e-02_r8,0.11627e-02_r8, & + & 0.11690e-02_r8,0.13357e-02_r8,0.15168e-02_r8,0.18162e-02_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.20925e-02_r8,0.18312e-02_r8,0.15700e-02_r8,0.13095e-02_r8,0.11041e-02_r8, & + & 0.91669e-03_r8,0.76437e-03_r8,0.75155e-03_r8,0.90862e-03_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.20749e-02_r8,0.18159e-02_r8,0.15569e-02_r8,0.13117e-02_r8,0.11170e-02_r8, & + & 0.95740e-03_r8,0.85349e-03_r8,0.90211e-03_r8,0.10843e-02_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.20605e-02_r8,0.18034e-02_r8,0.15463e-02_r8,0.13221e-02_r8,0.11384e-02_r8, & + & 0.10293e-02_r8,0.97333e-03_r8,0.10765e-02_r8,0.12853e-02_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.20459e-02_r8,0.17907e-02_r8,0.15355e-02_r8,0.13321e-02_r8,0.11878e-02_r8, & + & 0.11138e-02_r8,0.11236e-02_r8,0.12716e-02_r8,0.15170e-02_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.20310e-02_r8,0.17778e-02_r8,0.15259e-02_r8,0.13542e-02_r8,0.12517e-02_r8, & + & 0.12095e-02_r8,0.13081e-02_r8,0.14898e-02_r8,0.17755e-02_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.23595e-02_r8,0.20648e-02_r8,0.17701e-02_r8,0.14754e-02_r8,0.12323e-02_r8, & + & 0.10132e-02_r8,0.80835e-03_r8,0.73377e-03_r8,0.88458e-03_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.23333e-02_r8,0.20420e-02_r8,0.17506e-02_r8,0.14700e-02_r8,0.12449e-02_r8, & + & 0.10427e-02_r8,0.88482e-03_r8,0.87865e-03_r8,0.10548e-02_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.23118e-02_r8,0.20232e-02_r8,0.17345e-02_r8,0.14754e-02_r8,0.12581e-02_r8, & + & 0.11040e-02_r8,0.98425e-03_r8,0.10425e-02_r8,0.12451e-02_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.22911e-02_r8,0.20052e-02_r8,0.17193e-02_r8,0.14831e-02_r8,0.12996e-02_r8, & + & 0.11778e-02_r8,0.11137e-02_r8,0.12310e-02_r8,0.14656e-02_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.22715e-02_r8,0.19881e-02_r8,0.17061e-02_r8,0.14949e-02_r8,0.13595e-02_r8, & + & 0.12702e-02_r8,0.12792e-02_r8,0.14480e-02_r8,0.17220e-02_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.26465e-02_r8,0.23159e-02_r8,0.19853e-02_r8,0.16547e-02_r8,0.13704e-02_r8, & + & 0.11161e-02_r8,0.87227e-03_r8,0.72579e-03_r8,0.85316e-03_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.26139e-02_r8,0.22874e-02_r8,0.19609e-02_r8,0.16420e-02_r8,0.13837e-02_r8, & + & 0.11377e-02_r8,0.93183e-03_r8,0.85926e-03_r8,0.10245e-02_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.25857e-02_r8,0.22628e-02_r8,0.19400e-02_r8,0.16425e-02_r8,0.13917e-02_r8, & + & 0.11859e-02_r8,0.10228e-02_r8,0.10157e-02_r8,0.12103e-02_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.25573e-02_r8,0.22380e-02_r8,0.19187e-02_r8,0.16463e-02_r8,0.14196e-02_r8, & + & 0.12582e-02_r8,0.11286e-02_r8,0.11958e-02_r8,0.14229e-02_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.25310e-02_r8,0.22151e-02_r8,0.19006e-02_r8,0.16478e-02_r8,0.14771e-02_r8, & + & 0.13382e-02_r8,0.12711e-02_r8,0.14043e-02_r8,0.16688e-02_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.29437e-02_r8,0.25759e-02_r8,0.22081e-02_r8,0.18403e-02_r8,0.15126e-02_r8, & + & 0.12266e-02_r8,0.94502e-03_r8,0.72553e-03_r8,0.80872e-03_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.29059e-02_r8,0.25428e-02_r8,0.21798e-02_r8,0.18221e-02_r8,0.15299e-02_r8, & + & 0.12446e-02_r8,0.99114e-03_r8,0.84495e-03_r8,0.98123e-03_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.28735e-02_r8,0.25146e-02_r8,0.21557e-02_r8,0.18193e-02_r8,0.15373e-02_r8, & + & 0.12770e-02_r8,0.10730e-02_r8,0.99151e-03_r8,0.11701e-02_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.28399e-02_r8,0.24853e-02_r8,0.21306e-02_r8,0.18209e-02_r8,0.15526e-02_r8, & + & 0.13434e-02_r8,0.11682e-02_r8,0.11617e-02_r8,0.13773e-02_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.28070e-02_r8,0.24565e-02_r8,0.21073e-02_r8,0.18175e-02_r8,0.15973e-02_r8, & + & 0.14179e-02_r8,0.12830e-02_r8,0.13638e-02_r8,0.16173e-02_r8 /) + kao(:, 1,10,14) = (/ & + & 0.32399e-02_r8,0.28350e-02_r8,0.24302e-02_r8,0.20252e-02_r8,0.16589e-02_r8, & + & 0.13407e-02_r8,0.10274e-02_r8,0.73986e-03_r8,0.76203e-03_r8 /) + kao(:, 2,10,14) = (/ & + & 0.31965e-02_r8,0.27971e-02_r8,0.23977e-02_r8,0.20029e-02_r8,0.16776e-02_r8, & + & 0.13600e-02_r8,0.10652e-02_r8,0.84551e-03_r8,0.93841e-03_r8 /) + kao(:, 3,10,14) = (/ & + & 0.31601e-02_r8,0.27653e-02_r8,0.23707e-02_r8,0.19975e-02_r8,0.16883e-02_r8, & + & 0.13843e-02_r8,0.11385e-02_r8,0.98230e-03_r8,0.11352e-02_r8 /) + kao(:, 4,10,14) = (/ & + & 0.31230e-02_r8,0.27329e-02_r8,0.23428e-02_r8,0.19986e-02_r8,0.16986e-02_r8, & + & 0.14381e-02_r8,0.12318e-02_r8,0.11431e-02_r8,0.13466e-02_r8 /) + kao(:, 5,10,14) = (/ & + & 0.30838e-02_r8,0.26986e-02_r8,0.23157e-02_r8,0.19957e-02_r8,0.17285e-02_r8, & + & 0.15111e-02_r8,0.13270e-02_r8,0.13396e-02_r8,0.15853e-02_r8 /) + kao(:, 1,11,14) = (/ & + & 0.35110e-02_r8,0.30722e-02_r8,0.26335e-02_r8,0.21948e-02_r8,0.18129e-02_r8, & + & 0.14641e-02_r8,0.11256e-02_r8,0.79561e-03_r8,0.78300e-03_r8 /) + kao(:, 2,11,14) = (/ & + & 0.34682e-02_r8,0.30349e-02_r8,0.26015e-02_r8,0.21788e-02_r8,0.18300e-02_r8, & + & 0.14846e-02_r8,0.11655e-02_r8,0.90541e-03_r8,0.97352e-03_r8 /) + kao(:, 3,11,14) = (/ & + & 0.34263e-02_r8,0.29982e-02_r8,0.25700e-02_r8,0.21750e-02_r8,0.18411e-02_r8, & + & 0.15104e-02_r8,0.12444e-02_r8,0.10462e-02_r8,0.11863e-02_r8 /) + kao(:, 4,11,14) = (/ & + & 0.33817e-02_r8,0.29592e-02_r8,0.25369e-02_r8,0.21760e-02_r8,0.18525e-02_r8, & + & 0.15666e-02_r8,0.13382e-02_r8,0.12088e-02_r8,0.14124e-02_r8 /) + kao(:, 5,11,14) = (/ & + & 0.33351e-02_r8,0.29184e-02_r8,0.25088e-02_r8,0.21673e-02_r8,0.18858e-02_r8, & + & 0.16404e-02_r8,0.14339e-02_r8,0.14160e-02_r8,0.16713e-02_r8 /) + kao(:, 1,12,14) = (/ & + & 0.37813e-02_r8,0.33087e-02_r8,0.28362e-02_r8,0.23654e-02_r8,0.19642e-02_r8, & + & 0.15868e-02_r8,0.12220e-02_r8,0.85134e-03_r8,0.79810e-03_r8 /) + kao(:, 2,12,14) = (/ & + & 0.37337e-02_r8,0.32671e-02_r8,0.28006e-02_r8,0.23535e-02_r8,0.19812e-02_r8, & + & 0.16073e-02_r8,0.12646e-02_r8,0.96230e-03_r8,0.10021e-02_r8 /) + kao(:, 3,12,14) = (/ & + & 0.36838e-02_r8,0.32235e-02_r8,0.27633e-02_r8,0.23494e-02_r8,0.19898e-02_r8, & + & 0.16363e-02_r8,0.13472e-02_r8,0.11056e-02_r8,0.12297e-02_r8 /) + kao(:, 4,12,14) = (/ & + & 0.36315e-02_r8,0.31778e-02_r8,0.27268e-02_r8,0.23457e-02_r8,0.20010e-02_r8, & + & 0.16953e-02_r8,0.14396e-02_r8,0.12736e-02_r8,0.14737e-02_r8 /) + kao(:, 5,12,14) = (/ & + & 0.35780e-02_r8,0.31310e-02_r8,0.26962e-02_r8,0.23324e-02_r8,0.20383e-02_r8, & + & 0.17680e-02_r8,0.15379e-02_r8,0.14913e-02_r8,0.17515e-02_r8 /) + kao(:, 1,13,14) = (/ & + & 0.40401e-02_r8,0.35352e-02_r8,0.30303e-02_r8,0.25331e-02_r8,0.21125e-02_r8, & + & 0.17061e-02_r8,0.13144e-02_r8,0.90469e-03_r8,0.81129e-03_r8 /) + kao(:, 2,13,14) = (/ & + & 0.39897e-02_r8,0.34912e-02_r8,0.29926e-02_r8,0.25245e-02_r8,0.21272e-02_r8, & + & 0.17273e-02_r8,0.13608e-02_r8,0.10148e-02_r8,0.10248e-02_r8 /) + kao(:, 3,13,14) = (/ & + & 0.39313e-02_r8,0.34401e-02_r8,0.29487e-02_r8,0.25178e-02_r8,0.21303e-02_r8, & + & 0.17587e-02_r8,0.14454e-02_r8,0.11592e-02_r8,0.12656e-02_r8 /) + kao(:, 4,13,14) = (/ & + & 0.38694e-02_r8,0.33859e-02_r8,0.29093e-02_r8,0.25068e-02_r8,0.21412e-02_r8, & + & 0.18203e-02_r8,0.15361e-02_r8,0.13357e-02_r8,0.15298e-02_r8 /) + kao(:, 5,13,14) = (/ & + & 0.38109e-02_r8,0.33347e-02_r8,0.28761e-02_r8,0.24907e-02_r8,0.21821e-02_r8, & + & 0.18916e-02_r8,0.16371e-02_r8,0.15629e-02_r8,0.18275e-02_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.15071e-02_r8,0.13191e-02_r8,0.11311e-02_r8,0.94313e-03_r8,0.82178e-03_r8, & + & 0.90230e-03_r8,0.10652e-02_r8,0.11879e-02_r8,0.14045e-02_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.15053e-02_r8,0.13176e-02_r8,0.11298e-02_r8,0.94210e-03_r8,0.87562e-03_r8, & + & 0.10432e-02_r8,0.12302e-02_r8,0.13664e-02_r8,0.16201e-02_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.15019e-02_r8,0.13147e-02_r8,0.11275e-02_r8,0.94187e-03_r8,0.97652e-03_r8, & + & 0.12093e-02_r8,0.14252e-02_r8,0.15816e-02_r8,0.18766e-02_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.14976e-02_r8,0.13109e-02_r8,0.11243e-02_r8,0.96063e-03_r8,0.11391e-02_r8, & + & 0.14106e-02_r8,0.16622e-02_r8,0.18446e-02_r8,0.21889e-02_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.14918e-02_r8,0.13060e-02_r8,0.11201e-02_r8,0.10256e-02_r8,0.13135e-02_r8, & + & 0.16256e-02_r8,0.19138e-02_r8,0.21174e-02_r8,0.25177e-02_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.17368e-02_r8,0.15199e-02_r8,0.13031e-02_r8,0.10865e-02_r8,0.93589e-03_r8, & + & 0.95913e-03_r8,0.11327e-02_r8,0.12643e-02_r8,0.15179e-02_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.17347e-02_r8,0.15183e-02_r8,0.13018e-02_r8,0.10853e-02_r8,0.98162e-03_r8, & + & 0.11204e-02_r8,0.13214e-02_r8,0.14695e-02_r8,0.17719e-02_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.17301e-02_r8,0.15143e-02_r8,0.12982e-02_r8,0.10867e-02_r8,0.10624e-02_r8, & + & 0.13058e-02_r8,0.15388e-02_r8,0.17088e-02_r8,0.20640e-02_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.17235e-02_r8,0.15085e-02_r8,0.12935e-02_r8,0.11059e-02_r8,0.12337e-02_r8, & + & 0.15285e-02_r8,0.18009e-02_r8,0.19982e-02_r8,0.24152e-02_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.17181e-02_r8,0.15038e-02_r8,0.12895e-02_r8,0.11598e-02_r8,0.14379e-02_r8, & + & 0.17807e-02_r8,0.20976e-02_r8,0.23230e-02_r8,0.28132e-02_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.19949e-02_r8,0.17458e-02_r8,0.14967e-02_r8,0.12475e-02_r8,0.10641e-02_r8, & + & 0.10100e-02_r8,0.11774e-02_r8,0.13116e-02_r8,0.16051e-02_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.19910e-02_r8,0.17424e-02_r8,0.14939e-02_r8,0.12453e-02_r8,0.11049e-02_r8, & + & 0.11564e-02_r8,0.13657e-02_r8,0.15222e-02_r8,0.18601e-02_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.19848e-02_r8,0.17370e-02_r8,0.14892e-02_r8,0.12476e-02_r8,0.11571e-02_r8, & + & 0.13573e-02_r8,0.16014e-02_r8,0.17817e-02_r8,0.21839e-02_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.19813e-02_r8,0.17340e-02_r8,0.14867e-02_r8,0.12671e-02_r8,0.12941e-02_r8, & + & 0.15954e-02_r8,0.18821e-02_r8,0.20919e-02_r8,0.25670e-02_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.19771e-02_r8,0.17304e-02_r8,0.14836e-02_r8,0.13013e-02_r8,0.15091e-02_r8, & + & 0.18697e-02_r8,0.22058e-02_r8,0.24525e-02_r8,0.30084e-02_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.23002e-02_r8,0.20126e-02_r8,0.17253e-02_r8,0.14382e-02_r8,0.12005e-02_r8, & + & 0.10932e-02_r8,0.12228e-02_r8,0.13639e-02_r8,0.16798e-02_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.22929e-02_r8,0.20065e-02_r8,0.17201e-02_r8,0.14337e-02_r8,0.12491e-02_r8, & + & 0.11967e-02_r8,0.14046e-02_r8,0.15632e-02_r8,0.19322e-02_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.22828e-02_r8,0.19977e-02_r8,0.17127e-02_r8,0.14287e-02_r8,0.12914e-02_r8, & + & 0.13860e-02_r8,0.16360e-02_r8,0.18240e-02_r8,0.22487e-02_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.22757e-02_r8,0.19915e-02_r8,0.17074e-02_r8,0.14457e-02_r8,0.13800e-02_r8, & + & 0.16339e-02_r8,0.19297e-02_r8,0.21519e-02_r8,0.26493e-02_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.22684e-02_r8,0.19852e-02_r8,0.17019e-02_r8,0.14754e-02_r8,0.15614e-02_r8, & + & 0.19242e-02_r8,0.22727e-02_r8,0.25341e-02_r8,0.31196e-02_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.26562e-02_r8,0.23246e-02_r8,0.19929e-02_r8,0.16611e-02_r8,0.13598e-02_r8, & + & 0.11996e-02_r8,0.12698e-02_r8,0.14174e-02_r8,0.17501e-02_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.26415e-02_r8,0.23116e-02_r8,0.19818e-02_r8,0.16521e-02_r8,0.14129e-02_r8, & + & 0.12866e-02_r8,0.14524e-02_r8,0.16197e-02_r8,0.20022e-02_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.26277e-02_r8,0.22994e-02_r8,0.19710e-02_r8,0.16428e-02_r8,0.14513e-02_r8, & + & 0.14339e-02_r8,0.16856e-02_r8,0.18777e-02_r8,0.23236e-02_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.26179e-02_r8,0.22909e-02_r8,0.19639e-02_r8,0.16526e-02_r8,0.15154e-02_r8, & + & 0.16607e-02_r8,0.19618e-02_r8,0.21909e-02_r8,0.27021e-02_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.26074e-02_r8,0.22818e-02_r8,0.19561e-02_r8,0.16780e-02_r8,0.16497e-02_r8, & + & 0.19592e-02_r8,0.23163e-02_r8,0.25915e-02_r8,0.31846e-02_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.30676e-02_r8,0.26845e-02_r8,0.23014e-02_r8,0.19182e-02_r8,0.15508e-02_r8, & + & 0.13265e-02_r8,0.13165e-02_r8,0.14712e-02_r8,0.18123e-02_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.30472e-02_r8,0.26667e-02_r8,0.22862e-02_r8,0.19057e-02_r8,0.15947e-02_r8, & + & 0.14067e-02_r8,0.15004e-02_r8,0.16750e-02_r8,0.20695e-02_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.30255e-02_r8,0.26477e-02_r8,0.22705e-02_r8,0.18926e-02_r8,0.16408e-02_r8, & + & 0.15149e-02_r8,0.17276e-02_r8,0.19275e-02_r8,0.23847e-02_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.30083e-02_r8,0.26326e-02_r8,0.22569e-02_r8,0.18906e-02_r8,0.16765e-02_r8, & + & 0.17066e-02_r8,0.20035e-02_r8,0.22386e-02_r8,0.27616e-02_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.29915e-02_r8,0.26179e-02_r8,0.22443e-02_r8,0.19114e-02_r8,0.17836e-02_r8, & + & 0.19800e-02_r8,0.23411e-02_r8,0.26194e-02_r8,0.32234e-02_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.35311e-02_r8,0.30900e-02_r8,0.26490e-02_r8,0.22082e-02_r8,0.17722e-02_r8, & + & 0.14850e-02_r8,0.13781e-02_r8,0.15158e-02_r8,0.18578e-02_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.35031e-02_r8,0.30656e-02_r8,0.26281e-02_r8,0.21907e-02_r8,0.18048e-02_r8, & + & 0.15528e-02_r8,0.15481e-02_r8,0.17322e-02_r8,0.21307e-02_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.34762e-02_r8,0.30421e-02_r8,0.26077e-02_r8,0.21737e-02_r8,0.18550e-02_r8, & + & 0.16362e-02_r8,0.17771e-02_r8,0.19863e-02_r8,0.24506e-02_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.34506e-02_r8,0.30197e-02_r8,0.25888e-02_r8,0.21628e-02_r8,0.18864e-02_r8, & + & 0.17891e-02_r8,0.20527e-02_r8,0.22948e-02_r8,0.28308e-02_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.34242e-02_r8,0.29966e-02_r8,0.25690e-02_r8,0.21752e-02_r8,0.19463e-02_r8, & + & 0.20224e-02_r8,0.23798e-02_r8,0.26659e-02_r8,0.32785e-02_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.40545e-02_r8,0.35480e-02_r8,0.30415e-02_r8,0.25348e-02_r8,0.20284e-02_r8, & + & 0.16698e-02_r8,0.14585e-02_r8,0.15473e-02_r8,0.18938e-02_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.40094e-02_r8,0.35086e-02_r8,0.30078e-02_r8,0.25070e-02_r8,0.20421e-02_r8, & + & 0.17325e-02_r8,0.16159e-02_r8,0.17783e-02_r8,0.21732e-02_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.39679e-02_r8,0.34723e-02_r8,0.29772e-02_r8,0.24816e-02_r8,0.20882e-02_r8, & + & 0.17972e-02_r8,0.18217e-02_r8,0.20430e-02_r8,0.25042e-02_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.39321e-02_r8,0.34411e-02_r8,0.29500e-02_r8,0.24630e-02_r8,0.21284e-02_r8, & + & 0.19080e-02_r8,0.21043e-02_r8,0.23586e-02_r8,0.28966e-02_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.38953e-02_r8,0.34088e-02_r8,0.29224e-02_r8,0.24683e-02_r8,0.21576e-02_r8, & + & 0.21070e-02_r8,0.24382e-02_r8,0.27335e-02_r8,0.33549e-02_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.46508e-02_r8,0.40697e-02_r8,0.34886e-02_r8,0.29075e-02_r8,0.23264e-02_r8, & + & 0.18591e-02_r8,0.15578e-02_r8,0.15738e-02_r8,0.19224e-02_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.45823e-02_r8,0.40098e-02_r8,0.34374e-02_r8,0.28649e-02_r8,0.23092e-02_r8, & + & 0.19366e-02_r8,0.17051e-02_r8,0.18133e-02_r8,0.22104e-02_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.45166e-02_r8,0.39524e-02_r8,0.33880e-02_r8,0.28238e-02_r8,0.23394e-02_r8, & + & 0.19917e-02_r8,0.18843e-02_r8,0.20815e-02_r8,0.25365e-02_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.44602e-02_r8,0.39031e-02_r8,0.33460e-02_r8,0.27890e-02_r8,0.23856e-02_r8, & + & 0.20682e-02_r8,0.21419e-02_r8,0.24093e-02_r8,0.29396e-02_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.44050e-02_r8,0.38549e-02_r8,0.33047e-02_r8,0.27817e-02_r8,0.24123e-02_r8, & + & 0.22258e-02_r8,0.24850e-02_r8,0.27956e-02_r8,0.34119e-02_r8 /) + kao(:, 1,10,15) = (/ & + & 0.53098e-02_r8,0.46463e-02_r8,0.39828e-02_r8,0.33194e-02_r8,0.26559e-02_r8, & + & 0.20766e-02_r8,0.16840e-02_r8,0.16129e-02_r8,0.19635e-02_r8 /) + kao(:, 2,10,15) = (/ & + & 0.52134e-02_r8,0.45620e-02_r8,0.39106e-02_r8,0.32592e-02_r8,0.26145e-02_r8, & + & 0.21601e-02_r8,0.18269e-02_r8,0.18690e-02_r8,0.22681e-02_r8 /) + kao(:, 3,10,15) = (/ & + & 0.51182e-02_r8,0.44788e-02_r8,0.38392e-02_r8,0.31998e-02_r8,0.26226e-02_r8, & + & 0.22138e-02_r8,0.19824e-02_r8,0.21416e-02_r8,0.25956e-02_r8 /) + kao(:, 4,10,15) = (/ & + & 0.50344e-02_r8,0.44054e-02_r8,0.37765e-02_r8,0.31477e-02_r8,0.26616e-02_r8, & + & 0.22709e-02_r8,0.22099e-02_r8,0.24682e-02_r8,0.29962e-02_r8 /) + kao(:, 5,10,15) = (/ & + & 0.49550e-02_r8,0.43361e-02_r8,0.37172e-02_r8,0.31183e-02_r8,0.26883e-02_r8, & + & 0.23873e-02_r8,0.25425e-02_r8,0.28708e-02_r8,0.34790e-02_r8 /) + kao(:, 1,11,15) = (/ & + & 0.59619e-02_r8,0.52169e-02_r8,0.44719e-02_r8,0.37267e-02_r8,0.29817e-02_r8, & + & 0.23525e-02_r8,0.18854e-02_r8,0.17723e-02_r8,0.21445e-02_r8 /) + kao(:, 2,11,15) = (/ & + & 0.58318e-02_r8,0.51031e-02_r8,0.43744e-02_r8,0.36457e-02_r8,0.29351e-02_r8, & + & 0.24253e-02_r8,0.20278e-02_r8,0.20449e-02_r8,0.24715e-02_r8 /) + kao(:, 3,11,15) = (/ & + & 0.57112e-02_r8,0.49976e-02_r8,0.42840e-02_r8,0.35704e-02_r8,0.29381e-02_r8, & + & 0.24724e-02_r8,0.21871e-02_r8,0.23372e-02_r8,0.28231e-02_r8 /) + kao(:, 4,11,15) = (/ & + & 0.56008e-02_r8,0.49010e-02_r8,0.42013e-02_r8,0.35025e-02_r8,0.29677e-02_r8, & + & 0.25269e-02_r8,0.24222e-02_r8,0.27009e-02_r8,0.32614e-02_r8 /) + kao(:, 5,11,15) = (/ & + & 0.54961e-02_r8,0.48096e-02_r8,0.41230e-02_r8,0.34666e-02_r8,0.29811e-02_r8, & + & 0.26438e-02_r8,0.27691e-02_r8,0.31324e-02_r8,0.37747e-02_r8 /) + kao(:, 1,12,15) = (/ & + & 0.66218e-02_r8,0.57942e-02_r8,0.49667e-02_r8,0.41391e-02_r8,0.33116e-02_r8, & + & 0.26382e-02_r8,0.20922e-02_r8,0.19344e-02_r8,0.23267e-02_r8 /) + kao(:, 2,12,15) = (/ & + & 0.64584e-02_r8,0.56513e-02_r8,0.48443e-02_r8,0.40372e-02_r8,0.32618e-02_r8, & + & 0.26974e-02_r8,0.22343e-02_r8,0.22270e-02_r8,0.26783e-02_r8 /) + kao(:, 3,12,15) = (/ & + & 0.63097e-02_r8,0.55213e-02_r8,0.47331e-02_r8,0.39445e-02_r8,0.32599e-02_r8, & + & 0.27357e-02_r8,0.23983e-02_r8,0.25418e-02_r8,0.30577e-02_r8 /) + kao(:, 4,12,15) = (/ & + & 0.61694e-02_r8,0.53986e-02_r8,0.46278e-02_r8,0.38631e-02_r8,0.32772e-02_r8, & + & 0.27857e-02_r8,0.26412e-02_r8,0.29352e-02_r8,0.35233e-02_r8 /) + kao(:, 5,12,15) = (/ & + & 0.60360e-02_r8,0.52820e-02_r8,0.45279e-02_r8,0.38177e-02_r8,0.32735e-02_r8, & + & 0.29011e-02_r8,0.29998e-02_r8,0.33948e-02_r8,0.40685e-02_r8 /) + kao(:, 1,13,15) = (/ & + & 0.72856e-02_r8,0.63751e-02_r8,0.54646e-02_r8,0.45539e-02_r8,0.36434e-02_r8, & + & 0.29246e-02_r8,0.23024e-02_r8,0.20968e-02_r8,0.25004e-02_r8 /) + kao(:, 2,13,15) = (/ & + & 0.70792e-02_r8,0.61945e-02_r8,0.53099e-02_r8,0.44252e-02_r8,0.35875e-02_r8, & + & 0.29681e-02_r8,0.24397e-02_r8,0.24073e-02_r8,0.28787e-02_r8 /) + kao(:, 3,13,15) = (/ & + & 0.68966e-02_r8,0.60348e-02_r8,0.51733e-02_r8,0.43112e-02_r8,0.35811e-02_r8, & + & 0.29976e-02_r8,0.26071e-02_r8,0.27479e-02_r8,0.32886e-02_r8 /) + kao(:, 4,13,15) = (/ & + & 0.67258e-02_r8,0.58855e-02_r8,0.50451e-02_r8,0.42204e-02_r8,0.35830e-02_r8, & + & 0.30400e-02_r8,0.28573e-02_r8,0.31625e-02_r8,0.37791e-02_r8 /) + kao(:, 5,13,15) = (/ & + & 0.65607e-02_r8,0.57411e-02_r8,0.49214e-02_r8,0.41617e-02_r8,0.35593e-02_r8, & + & 0.31530e-02_r8,0.32258e-02_r8,0.36487e-02_r8,0.43508e-02_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.16712e-02_r8,0.14631e-02_r8,0.12550e-02_r8,0.10468e-02_r8,0.92082e-03_r8, & + & 0.11371e-02_r8,0.13321e-02_r8,0.14544e-02_r8,0.17472e-02_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.16787e-02_r8,0.14701e-02_r8,0.12615e-02_r8,0.10530e-02_r8,0.10440e-02_r8, & + & 0.12893e-02_r8,0.15114e-02_r8,0.16524e-02_r8,0.19826e-02_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.16875e-02_r8,0.14779e-02_r8,0.12683e-02_r8,0.10588e-02_r8,0.11676e-02_r8, & + & 0.14424e-02_r8,0.16914e-02_r8,0.18523e-02_r8,0.22202e-02_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.16926e-02_r8,0.14826e-02_r8,0.12725e-02_r8,0.10626e-02_r8,0.12909e-02_r8, & + & 0.15950e-02_r8,0.18720e-02_r8,0.20532e-02_r8,0.24579e-02_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.16942e-02_r8,0.14841e-02_r8,0.12739e-02_r8,0.11419e-02_r8,0.15149e-02_r8, & + & 0.18796e-02_r8,0.22246e-02_r8,0.24968e-02_r8,0.29379e-02_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.19607e-02_r8,0.17158e-02_r8,0.14714e-02_r8,0.12274e-02_r8,0.10440e-02_r8, & + & 0.12890e-02_r8,0.15097e-02_r8,0.16471e-02_r8,0.20285e-02_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.19666e-02_r8,0.17216e-02_r8,0.14767e-02_r8,0.12314e-02_r8,0.11872e-02_r8, & + & 0.14659e-02_r8,0.17177e-02_r8,0.18761e-02_r8,0.23077e-02_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.19740e-02_r8,0.17284e-02_r8,0.14830e-02_r8,0.12374e-02_r8,0.13301e-02_r8, & + & 0.16429e-02_r8,0.19255e-02_r8,0.21058e-02_r8,0.25866e-02_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.19796e-02_r8,0.17334e-02_r8,0.14872e-02_r8,0.12416e-02_r8,0.14717e-02_r8, & + & 0.18182e-02_r8,0.21321e-02_r8,0.23342e-02_r8,0.28637e-02_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.19818e-02_r8,0.17354e-02_r8,0.14891e-02_r8,0.12544e-02_r8,0.16318e-02_r8, & + & 0.20217e-02_r8,0.23832e-02_r8,0.26470e-02_r8,0.31951e-02_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.23039e-02_r8,0.20168e-02_r8,0.17292e-02_r8,0.14410e-02_r8,0.11614e-02_r8, & + & 0.14213e-02_r8,0.16646e-02_r8,0.18149e-02_r8,0.22923e-02_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.23064e-02_r8,0.20187e-02_r8,0.17311e-02_r8,0.14440e-02_r8,0.13190e-02_r8, & + & 0.16288e-02_r8,0.19083e-02_r8,0.20825e-02_r8,0.26267e-02_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.23119e-02_r8,0.20237e-02_r8,0.17351e-02_r8,0.14470e-02_r8,0.14864e-02_r8, & + & 0.18354e-02_r8,0.21515e-02_r8,0.23501e-02_r8,0.29596e-02_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.23154e-02_r8,0.20269e-02_r8,0.17385e-02_r8,0.14496e-02_r8,0.16513e-02_r8, & + & 0.20395e-02_r8,0.23915e-02_r8,0.26154e-02_r8,0.32883e-02_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.23212e-02_r8,0.20321e-02_r8,0.17430e-02_r8,0.14536e-02_r8,0.18129e-02_r8, & + & 0.22398e-02_r8,0.26272e-02_r8,0.28760e-02_r8,0.36101e-02_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.27129e-02_r8,0.23736e-02_r8,0.20348e-02_r8,0.16965e-02_r8,0.13577e-02_r8, & + & 0.15487e-02_r8,0.18138e-02_r8,0.19776e-02_r8,0.25289e-02_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.27133e-02_r8,0.23745e-02_r8,0.20358e-02_r8,0.16966e-02_r8,0.14516e-02_r8, & + & 0.17925e-02_r8,0.21002e-02_r8,0.22917e-02_r8,0.29262e-02_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.27155e-02_r8,0.23766e-02_r8,0.20379e-02_r8,0.16990e-02_r8,0.16483e-02_r8, & + & 0.20360e-02_r8,0.23858e-02_r8,0.26061e-02_r8,0.33224e-02_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.27175e-02_r8,0.23784e-02_r8,0.20394e-02_r8,0.17007e-02_r8,0.18426e-02_r8, & + & 0.22757e-02_r8,0.26681e-02_r8,0.29171e-02_r8,0.37132e-02_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.27186e-02_r8,0.23796e-02_r8,0.20406e-02_r8,0.17019e-02_r8,0.20320e-02_r8, & + & 0.25101e-02_r8,0.29443e-02_r8,0.32220e-02_r8,0.40947e-02_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.32119e-02_r8,0.28114e-02_r8,0.24099e-02_r8,0.20078e-02_r8,0.16065e-02_r8, & + & 0.16767e-02_r8,0.19643e-02_r8,0.21431e-02_r8,0.27523e-02_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.32085e-02_r8,0.28077e-02_r8,0.24069e-02_r8,0.20064e-02_r8,0.16195e-02_r8, & + & 0.19633e-02_r8,0.23007e-02_r8,0.25120e-02_r8,0.32215e-02_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.32085e-02_r8,0.28078e-02_r8,0.24068e-02_r8,0.20061e-02_r8,0.18214e-02_r8, & + & 0.22501e-02_r8,0.26375e-02_r8,0.28827e-02_r8,0.36897e-02_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.32059e-02_r8,0.28056e-02_r8,0.24053e-02_r8,0.20050e-02_r8,0.20501e-02_r8, & + & 0.25321e-02_r8,0.29699e-02_r8,0.32491e-02_r8,0.41521e-02_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.31984e-02_r8,0.27990e-02_r8,0.23997e-02_r8,0.20000e-02_r8,0.22727e-02_r8, & + & 0.28084e-02_r8,0.32949e-02_r8,0.36079e-02_r8,0.46028e-02_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.38076e-02_r8,0.33317e-02_r8,0.28559e-02_r8,0.23799e-02_r8,0.19041e-02_r8, & + & 0.17889e-02_r8,0.20969e-02_r8,0.22903e-02_r8,0.29420e-02_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.37964e-02_r8,0.33220e-02_r8,0.28476e-02_r8,0.23732e-02_r8,0.18989e-02_r8, & + & 0.21234e-02_r8,0.24900e-02_r8,0.27226e-02_r8,0.34908e-02_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.37877e-02_r8,0.33145e-02_r8,0.28416e-02_r8,0.23683e-02_r8,0.19985e-02_r8, & + & 0.24600e-02_r8,0.28851e-02_r8,0.31576e-02_r8,0.40421e-02_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.37785e-02_r8,0.33065e-02_r8,0.28344e-02_r8,0.23627e-02_r8,0.22594e-02_r8, & + & 0.27919e-02_r8,0.32761e-02_r8,0.35889e-02_r8,0.45855e-02_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.37630e-02_r8,0.32929e-02_r8,0.28229e-02_r8,0.23532e-02_r8,0.25213e-02_r8, & + & 0.31161e-02_r8,0.36579e-02_r8,0.40115e-02_r8,0.51155e-02_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.45014e-02_r8,0.39388e-02_r8,0.33762e-02_r8,0.28135e-02_r8,0.22509e-02_r8, & + & 0.18859e-02_r8,0.22117e-02_r8,0.24208e-02_r8,0.31038e-02_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.44788e-02_r8,0.39190e-02_r8,0.33593e-02_r8,0.27996e-02_r8,0.22399e-02_r8, & + & 0.22735e-02_r8,0.26677e-02_r8,0.29222e-02_r8,0.37394e-02_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.44593e-02_r8,0.39020e-02_r8,0.33439e-02_r8,0.27867e-02_r8,0.22518e-02_r8, & + & 0.26648e-02_r8,0.31283e-02_r8,0.34304e-02_r8,0.43806e-02_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.44374e-02_r8,0.38829e-02_r8,0.33284e-02_r8,0.27732e-02_r8,0.24705e-02_r8, & + & 0.30533e-02_r8,0.35850e-02_r8,0.39361e-02_r8,0.50160e-02_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.44113e-02_r8,0.38601e-02_r8,0.33089e-02_r8,0.27567e-02_r8,0.27756e-02_r8, & + & 0.34321e-02_r8,0.40324e-02_r8,0.44314e-02_r8,0.56359e-02_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.53031e-02_r8,0.46403e-02_r8,0.39774e-02_r8,0.33149e-02_r8,0.26520e-02_r8, & + & 0.20316e-02_r8,0.23080e-02_r8,0.25314e-02_r8,0.32334e-02_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.52648e-02_r8,0.46067e-02_r8,0.39487e-02_r8,0.32907e-02_r8,0.26325e-02_r8, & + & 0.24096e-02_r8,0.28298e-02_r8,0.31081e-02_r8,0.39611e-02_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.52246e-02_r8,0.45716e-02_r8,0.39189e-02_r8,0.32659e-02_r8,0.26125e-02_r8, & + & 0.28611e-02_r8,0.33614e-02_r8,0.36958e-02_r8,0.47006e-02_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.51821e-02_r8,0.45344e-02_r8,0.38868e-02_r8,0.32390e-02_r8,0.27289e-02_r8, & + & 0.33103e-02_r8,0.38912e-02_r8,0.42829e-02_r8,0.54355e-02_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.51356e-02_r8,0.44938e-02_r8,0.38520e-02_r8,0.32108e-02_r8,0.30299e-02_r8, & + & 0.37493e-02_r8,0.44090e-02_r8,0.48604e-02_r8,0.61537e-02_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.62116e-02_r8,0.54352e-02_r8,0.46587e-02_r8,0.38825e-02_r8,0.31060e-02_r8, & + & 0.23296e-02_r8,0.23830e-02_r8,0.26152e-02_r8,0.33400e-02_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.61510e-02_r8,0.53822e-02_r8,0.46134e-02_r8,0.38445e-02_r8,0.30756e-02_r8, & + & 0.25421e-02_r8,0.29622e-02_r8,0.32625e-02_r8,0.41372e-02_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.60862e-02_r8,0.53255e-02_r8,0.45651e-02_r8,0.38044e-02_r8,0.30427e-02_r8, & + & 0.30332e-02_r8,0.35680e-02_r8,0.39355e-02_r8,0.49777e-02_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.60169e-02_r8,0.52649e-02_r8,0.45129e-02_r8,0.37608e-02_r8,0.30629e-02_r8, & + & 0.35468e-02_r8,0.41747e-02_r8,0.46107e-02_r8,0.58172e-02_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.59428e-02_r8,0.52001e-02_r8,0.44573e-02_r8,0.37148e-02_r8,0.33039e-02_r8, & + & 0.40510e-02_r8,0.47683e-02_r8,0.52747e-02_r8,0.66403e-02_r8 /) + kao(:, 1,10,16) = (/ & + & 0.72226e-02_r8,0.63198e-02_r8,0.54170e-02_r8,0.45138e-02_r8,0.36111e-02_r8, & + & 0.27087e-02_r8,0.25246e-02_r8,0.27733e-02_r8,0.35348e-02_r8 /) + kao(:, 2,10,16) = (/ & + & 0.71308e-02_r8,0.62395e-02_r8,0.53482e-02_r8,0.44569e-02_r8,0.35656e-02_r8, & + & 0.27737e-02_r8,0.31148e-02_r8,0.34380e-02_r8,0.43453e-02_r8 /) + kao(:, 3,10,16) = (/ & + & 0.70337e-02_r8,0.61546e-02_r8,0.52755e-02_r8,0.43963e-02_r8,0.35178e-02_r8, & + & 0.32195e-02_r8,0.37898e-02_r8,0.41956e-02_r8,0.52718e-02_r8 /) + kao(:, 4,10,16) = (/ & + & 0.69308e-02_r8,0.60645e-02_r8,0.51982e-02_r8,0.43312e-02_r8,0.34725e-02_r8, & + & 0.37977e-02_r8,0.44773e-02_r8,0.49627e-02_r8,0.62190e-02_r8 /) + kao(:, 5,10,16) = (/ & + & 0.68213e-02_r8,0.59687e-02_r8,0.51162e-02_r8,0.42630e-02_r8,0.36577e-02_r8, & + & 0.43690e-02_r8,0.51523e-02_r8,0.57195e-02_r8,0.71486e-02_r8 /) + kao(:, 1,11,16) = (/ & + & 0.82729e-02_r8,0.72388e-02_r8,0.62047e-02_r8,0.51704e-02_r8,0.41364e-02_r8, & + & 0.31022e-02_r8,0.29450e-02_r8,0.32481e-02_r8,0.41092e-02_r8 /) + kao(:, 2,11,16) = (/ & + & 0.81377e-02_r8,0.71207e-02_r8,0.61034e-02_r8,0.50862e-02_r8,0.40694e-02_r8, & + & 0.32023e-02_r8,0.35972e-02_r8,0.39817e-02_r8,0.50045e-02_r8 /) + kao(:, 3,11,16) = (/ & + & 0.79927e-02_r8,0.69937e-02_r8,0.59945e-02_r8,0.49955e-02_r8,0.39980e-02_r8, & + & 0.36849e-02_r8,0.43305e-02_r8,0.48162e-02_r8,0.60016e-02_r8 /) + kao(:, 4,11,16) = (/ & + & 0.78435e-02_r8,0.68631e-02_r8,0.58827e-02_r8,0.49014e-02_r8,0.39530e-02_r8, & + & 0.43152e-02_r8,0.50942e-02_r8,0.56750e-02_r8,0.70494e-02_r8 /) + kao(:, 5,11,16) = (/ & + & 0.76868e-02_r8,0.67260e-02_r8,0.57653e-02_r8,0.48045e-02_r8,0.41698e-02_r8, & + & 0.49442e-02_r8,0.58408e-02_r8,0.65151e-02_r8,0.80731e-02_r8 /) + kao(:, 1,12,16) = (/ & + & 0.93677e-02_r8,0.81967e-02_r8,0.70258e-02_r8,0.58546e-02_r8,0.46837e-02_r8, & + & 0.35124e-02_r8,0.33991e-02_r8,0.37659e-02_r8,0.47255e-02_r8 /) + kao(:, 2,12,16) = (/ & + & 0.91725e-02_r8,0.80259e-02_r8,0.68794e-02_r8,0.57329e-02_r8,0.45871e-02_r8, & + & 0.36555e-02_r8,0.41158e-02_r8,0.45739e-02_r8,0.57058e-02_r8 /) + kao(:, 3,12,16) = (/ & + & 0.89743e-02_r8,0.78526e-02_r8,0.67312e-02_r8,0.56083e-02_r8,0.44874e-02_r8, & + & 0.41738e-02_r8,0.49000e-02_r8,0.54681e-02_r8,0.67707e-02_r8 /) + kao(:, 4,12,16) = (/ & + & 0.87651e-02_r8,0.76695e-02_r8,0.65740e-02_r8,0.54780e-02_r8,0.44541e-02_r8, & + & 0.48422e-02_r8,0.57276e-02_r8,0.64103e-02_r8,0.78928e-02_r8 /) + kao(:, 5,12,16) = (/ & + & 0.85557e-02_r8,0.74863e-02_r8,0.64169e-02_r8,0.53471e-02_r8,0.46965e-02_r8, & + & 0.55261e-02_r8,0.65398e-02_r8,0.73300e-02_r8,0.90026e-02_r8 /) + kao(:, 1,13,16) = (/ & + & 0.10484e-01_r8,0.91737e-02_r8,0.78632e-02_r8,0.65525e-02_r8,0.52420e-02_r8, & + & 0.39330e-02_r8,0.38753e-02_r8,0.43130e-02_r8,0.53655e-02_r8 /) + kao(:, 2,13,16) = (/ & + & 0.10212e-01_r8,0.89352e-02_r8,0.76588e-02_r8,0.63823e-02_r8,0.51063e-02_r8, & + & 0.41214e-02_r8,0.46538e-02_r8,0.51962e-02_r8,0.64287e-02_r8 /) + kao(:, 3,13,16) = (/ & + & 0.99472e-02_r8,0.87039e-02_r8,0.74620e-02_r8,0.62164e-02_r8,0.49733e-02_r8, & + & 0.46683e-02_r8,0.54886e-02_r8,0.61482e-02_r8,0.75590e-02_r8 /) + kao(:, 4,13,16) = (/ & + & 0.96776e-02_r8,0.84679e-02_r8,0.72583e-02_r8,0.60495e-02_r8,0.49611e-02_r8, & + & 0.53643e-02_r8,0.63558e-02_r8,0.71458e-02_r8,0.87290e-02_r8 /) + kao(:, 5,13,16) = (/ & + & 0.94084e-02_r8,0.82324e-02_r8,0.70564e-02_r8,0.58807e-02_r8,0.52210e-02_r8, & + & 0.60971e-02_r8,0.72271e-02_r8,0.81397e-02_r8,0.99102e-02_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.33062e-11_r8,0.42306e-11_r8,0.53172e-11_r8,0.65673e-11_r8,0.78335e-11_r8 /) + kbo(:,14, 1) = (/ & + & 0.27467e-11_r8,0.35252e-11_r8,0.44160e-11_r8,0.54171e-11_r8,0.64630e-11_r8 /) + kbo(:,15, 1) = (/ & + & 0.23431e-11_r8,0.29962e-11_r8,0.37507e-11_r8,0.46179e-11_r8,0.54790e-11_r8 /) + kbo(:,16, 1) = (/ & + & 0.20178e-11_r8,0.25698e-11_r8,0.32330e-11_r8,0.40024e-11_r8,0.46899e-11_r8 /) + kbo(:,17, 1) = (/ & + & 0.17389e-11_r8,0.22126e-11_r8,0.27864e-11_r8,0.34615e-11_r8,0.40184e-11_r8 /) + kbo(:,18, 1) = (/ & + & 0.15164e-11_r8,0.19304e-11_r8,0.24263e-11_r8,0.29918e-11_r8,0.34734e-11_r8 /) + kbo(:,19, 1) = (/ & + & 0.13194e-11_r8,0.16684e-11_r8,0.20851e-11_r8,0.25471e-11_r8,0.29992e-11_r8 /) + kbo(:,20, 1) = (/ & + & 0.11345e-11_r8,0.14317e-11_r8,0.17813e-11_r8,0.21686e-11_r8,0.25523e-11_r8 /) + kbo(:,21, 1) = (/ & + & 0.97614e-12_r8,0.12233e-11_r8,0.15124e-11_r8,0.18436e-11_r8,0.21624e-11_r8 /) + kbo(:,22, 1) = (/ & + & 0.84972e-12_r8,0.10604e-11_r8,0.13001e-11_r8,0.15853e-11_r8,0.18511e-11_r8 /) + kbo(:,23, 1) = (/ & + & 0.73919e-12_r8,0.91863e-12_r8,0.11179e-11_r8,0.13612e-11_r8,0.15791e-11_r8 /) + kbo(:,24, 1) = (/ & + & 0.63952e-12_r8,0.79203e-12_r8,0.96272e-12_r8,0.11643e-11_r8,0.13384e-11_r8 /) + kbo(:,25, 1) = (/ & + & 0.55198e-12_r8,0.68176e-12_r8,0.82782e-12_r8,0.99347e-12_r8,0.11342e-11_r8 /) + kbo(:,26, 1) = (/ & + & 0.47648e-12_r8,0.58395e-12_r8,0.71214e-12_r8,0.84565e-12_r8,0.96146e-12_r8 /) + kbo(:,27, 1) = (/ & + & 0.41185e-12_r8,0.50403e-12_r8,0.61156e-12_r8,0.71539e-12_r8,0.81410e-12_r8 /) + kbo(:,28, 1) = (/ & + & 0.35568e-12_r8,0.43404e-12_r8,0.52441e-12_r8,0.60652e-12_r8,0.68860e-12_r8 /) + kbo(:,29, 1) = (/ & + & 0.30863e-12_r8,0.37487e-12_r8,0.45120e-12_r8,0.51591e-12_r8,0.58367e-12_r8 /) + kbo(:,30, 1) = (/ & + & 0.26804e-12_r8,0.32390e-12_r8,0.38615e-12_r8,0.43956e-12_r8,0.49890e-12_r8 /) + kbo(:,31, 1) = (/ & + & 0.23316e-12_r8,0.28106e-12_r8,0.33068e-12_r8,0.37478e-12_r8,0.42377e-12_r8 /) + kbo(:,32, 1) = (/ & + & 0.20255e-12_r8,0.24397e-12_r8,0.28293e-12_r8,0.31878e-12_r8,0.36224e-12_r8 /) + kbo(:,33, 1) = (/ & + & 0.17541e-12_r8,0.21018e-12_r8,0.24052e-12_r8,0.27083e-12_r8,0.30963e-12_r8 /) + kbo(:,34, 1) = (/ & + & 0.15014e-12_r8,0.17890e-12_r8,0.20293e-12_r8,0.23058e-12_r8,0.26131e-12_r8 /) + kbo(:,35, 1) = (/ & + & 0.12610e-12_r8,0.14972e-12_r8,0.16906e-12_r8,0.19250e-12_r8,0.21752e-12_r8 /) + kbo(:,36, 1) = (/ & + & 0.10365e-12_r8,0.12301e-12_r8,0.13878e-12_r8,0.15810e-12_r8,0.17856e-12_r8 /) + kbo(:,37, 1) = (/ & + & 0.82572e-13_r8,0.98388e-13_r8,0.11143e-12_r8,0.12645e-12_r8,0.14343e-12_r8 /) + kbo(:,38, 1) = (/ & + & 0.65632e-13_r8,0.78531e-13_r8,0.89359e-13_r8,0.10135e-12_r8,0.11495e-12_r8 /) + kbo(:,39, 1) = (/ & + & 0.52174e-13_r8,0.62607e-13_r8,0.71650e-13_r8,0.80738e-13_r8,0.92112e-13_r8 /) + kbo(:,40, 1) = (/ & + & 0.40434e-13_r8,0.48683e-13_r8,0.56479e-13_r8,0.63806e-13_r8,0.72155e-13_r8 /) + kbo(:,41, 1) = (/ & + & 0.31179e-13_r8,0.37691e-13_r8,0.44339e-13_r8,0.50247e-13_r8,0.56982e-13_r8 /) + kbo(:,42, 1) = (/ & + & 0.24040e-13_r8,0.29161e-13_r8,0.34731e-13_r8,0.39467e-13_r8,0.44922e-13_r8 /) + kbo(:,43, 1) = (/ & + & 0.18259e-13_r8,0.22185e-13_r8,0.26753e-13_r8,0.30617e-13_r8,0.34721e-13_r8 /) + kbo(:,44, 1) = (/ & + & 0.13667e-13_r8,0.16662e-13_r8,0.20308e-13_r8,0.23577e-13_r8,0.26865e-13_r8 /) + kbo(:,45, 1) = (/ & + & 0.10182e-13_r8,0.12571e-13_r8,0.15345e-13_r8,0.18028e-13_r8,0.20725e-13_r8 /) + kbo(:,46, 1) = (/ & + & 0.75196e-14_r8,0.94092e-14_r8,0.11475e-13_r8,0.13704e-13_r8,0.15878e-13_r8 /) + kbo(:,47, 1) = (/ & + & 0.54721e-14_r8,0.69523e-14_r8,0.85280e-14_r8,0.10311e-13_r8,0.11952e-13_r8 /) + kbo(:,48, 1) = (/ & + & 0.39619e-14_r8,0.50439e-14_r8,0.62896e-14_r8,0.77193e-14_r8,0.89282e-14_r8 /) + kbo(:,49, 1) = (/ & + & 0.28508e-14_r8,0.36419e-14_r8,0.46044e-14_r8,0.57276e-14_r8,0.66866e-14_r8 /) + kbo(:,50, 1) = (/ & + & 0.20973e-14_r8,0.26588e-14_r8,0.33754e-14_r8,0.42404e-14_r8,0.50338e-14_r8 /) + kbo(:,51, 1) = (/ & + & 0.15010e-14_r8,0.19461e-14_r8,0.24807e-14_r8,0.31095e-14_r8,0.37789e-14_r8 /) + kbo(:,52, 1) = (/ & + & 0.10686e-14_r8,0.14205e-14_r8,0.18164e-14_r8,0.22651e-14_r8,0.27790e-14_r8 /) + kbo(:,53, 1) = (/ & + & 0.75469e-15_r8,0.10279e-14_r8,0.13211e-14_r8,0.16657e-14_r8,0.20344e-14_r8 /) + kbo(:,54, 1) = (/ & + & 0.53837e-15_r8,0.75440e-15_r8,0.97064e-15_r8,0.12260e-14_r8,0.15156e-14_r8 /) + kbo(:,55, 1) = (/ & + & 0.38620e-15_r8,0.54750e-15_r8,0.71223e-15_r8,0.90921e-15_r8,0.11265e-14_r8 /) + kbo(:,56, 1) = (/ & + & 0.27852e-15_r8,0.39135e-15_r8,0.51858e-15_r8,0.66760e-15_r8,0.83486e-15_r8 /) + kbo(:,57, 1) = (/ & + & 0.20280e-15_r8,0.27940e-15_r8,0.37558e-15_r8,0.48656e-15_r8,0.61658e-15_r8 /) + kbo(:,58, 1) = (/ & + & 0.14586e-15_r8,0.19788e-15_r8,0.27273e-15_r8,0.35391e-15_r8,0.45250e-15_r8 /) + kbo(:,59, 1) = (/ & + & 0.11164e-15_r8,0.15082e-15_r8,0.20804e-15_r8,0.27081e-15_r8,0.49339e-15_r8 /) + kbo(:,13, 2) = (/ & + & 0.15800e-10_r8,0.20781e-10_r8,0.26154e-10_r8,0.31936e-10_r8,0.38062e-10_r8 /) + kbo(:,14, 2) = (/ & + & 0.13333e-10_r8,0.17459e-10_r8,0.21881e-10_r8,0.26666e-10_r8,0.31696e-10_r8 /) + kbo(:,15, 2) = (/ & + & 0.11381e-10_r8,0.14784e-10_r8,0.18449e-10_r8,0.22397e-10_r8,0.26533e-10_r8 /) + kbo(:,16, 2) = (/ & + & 0.97593e-11_r8,0.12591e-10_r8,0.15641e-10_r8,0.18845e-10_r8,0.22503e-10_r8 /) + kbo(:,17, 2) = (/ & + & 0.83473e-11_r8,0.10709e-10_r8,0.13261e-10_r8,0.15857e-10_r8,0.19052e-10_r8 /) + kbo(:,18, 2) = (/ & + & 0.71523e-11_r8,0.91255e-11_r8,0.11229e-10_r8,0.13436e-10_r8,0.16145e-10_r8 /) + kbo(:,19, 2) = (/ & + & 0.60777e-11_r8,0.77489e-11_r8,0.94796e-11_r8,0.11415e-10_r8,0.13591e-10_r8 /) + kbo(:,20, 2) = (/ & + & 0.51693e-11_r8,0.65609e-11_r8,0.80124e-11_r8,0.96944e-11_r8,0.11427e-10_r8 /) + kbo(:,21, 2) = (/ & + & 0.43931e-11_r8,0.55492e-11_r8,0.67698e-11_r8,0.81825e-11_r8,0.95836e-11_r8 /) + kbo(:,22, 2) = (/ & + & 0.37967e-11_r8,0.47515e-11_r8,0.57759e-11_r8,0.69676e-11_r8,0.81090e-11_r8 /) + kbo(:,23, 2) = (/ & + & 0.32747e-11_r8,0.40830e-11_r8,0.49616e-11_r8,0.59280e-11_r8,0.68614e-11_r8 /) + kbo(:,24, 2) = (/ & + & 0.28215e-11_r8,0.34976e-11_r8,0.42532e-11_r8,0.50228e-11_r8,0.57971e-11_r8 /) + kbo(:,25, 2) = (/ & + & 0.24334e-11_r8,0.29960e-11_r8,0.36396e-11_r8,0.42606e-11_r8,0.49056e-11_r8 /) + kbo(:,26, 2) = (/ & + & 0.21117e-11_r8,0.25752e-11_r8,0.31134e-11_r8,0.36244e-11_r8,0.41489e-11_r8 /) + kbo(:,27, 2) = (/ & + & 0.18253e-11_r8,0.22243e-11_r8,0.26576e-11_r8,0.30793e-11_r8,0.35048e-11_r8 /) + kbo(:,28, 2) = (/ & + & 0.15682e-11_r8,0.19141e-11_r8,0.22636e-11_r8,0.26109e-11_r8,0.29589e-11_r8 /) + kbo(:,29, 2) = (/ & + & 0.13535e-11_r8,0.16466e-11_r8,0.19296e-11_r8,0.22145e-11_r8,0.25005e-11_r8 /) + kbo(:,30, 2) = (/ & + & 0.11709e-11_r8,0.14136e-11_r8,0.16432e-11_r8,0.18792e-11_r8,0.21240e-11_r8 /) + kbo(:,31, 2) = (/ & + & 0.10216e-11_r8,0.12142e-11_r8,0.14045e-11_r8,0.15978e-11_r8,0.18001e-11_r8 /) + kbo(:,32, 2) = (/ & + & 0.88417e-12_r8,0.10400e-11_r8,0.11973e-11_r8,0.13566e-11_r8,0.15303e-11_r8 /) + kbo(:,33, 2) = (/ & + & 0.76210e-12_r8,0.89004e-12_r8,0.10199e-11_r8,0.11509e-11_r8,0.12984e-11_r8 /) + kbo(:,34, 2) = (/ & + & 0.64910e-12_r8,0.75460e-12_r8,0.86122e-12_r8,0.97227e-12_r8,0.10908e-11_r8 /) + kbo(:,35, 2) = (/ & + & 0.54374e-12_r8,0.63015e-12_r8,0.71745e-12_r8,0.80944e-12_r8,0.90628e-12_r8 /) + kbo(:,36, 2) = (/ & + & 0.44718e-12_r8,0.51791e-12_r8,0.58946e-12_r8,0.66527e-12_r8,0.74411e-12_r8 /) + kbo(:,37, 2) = (/ & + & 0.35793e-12_r8,0.41591e-12_r8,0.47443e-12_r8,0.53549e-12_r8,0.60041e-12_r8 /) + kbo(:,38, 2) = (/ & + & 0.28618e-12_r8,0.33345e-12_r8,0.38124e-12_r8,0.43139e-12_r8,0.48394e-12_r8 /) + kbo(:,39, 2) = (/ & + & 0.22858e-12_r8,0.26729e-12_r8,0.30628e-12_r8,0.34554e-12_r8,0.38998e-12_r8 /) + kbo(:,40, 2) = (/ & + & 0.17867e-12_r8,0.21032e-12_r8,0.24207e-12_r8,0.27407e-12_r8,0.30925e-12_r8 /) + kbo(:,41, 2) = (/ & + & 0.13875e-12_r8,0.16498e-12_r8,0.19072e-12_r8,0.21688e-12_r8,0.24410e-12_r8 /) + kbo(:,42, 2) = (/ & + & 0.10714e-12_r8,0.12915e-12_r8,0.14999e-12_r8,0.17156e-12_r8,0.19364e-12_r8 /) + kbo(:,43, 2) = (/ & + & 0.81856e-13_r8,0.99592e-13_r8,0.11661e-12_r8,0.13414e-12_r8,0.15145e-12_r8 /) + kbo(:,44, 2) = (/ & + & 0.62221e-13_r8,0.75886e-13_r8,0.90106e-13_r8,0.10425e-12_r8,0.11838e-12_r8 /) + kbo(:,45, 2) = (/ & + & 0.47139e-13_r8,0.57421e-13_r8,0.69401e-13_r8,0.80830e-13_r8,0.92462e-13_r8 /) + kbo(:,46, 2) = (/ & + & 0.35469e-13_r8,0.43603e-13_r8,0.52913e-13_r8,0.62345e-13_r8,0.71769e-13_r8 /) + kbo(:,47, 2) = (/ & + & 0.26308e-13_r8,0.32606e-13_r8,0.39610e-13_r8,0.47505e-13_r8,0.55354e-13_r8 /) + kbo(:,48, 2) = (/ & + & 0.19388e-13_r8,0.24430e-13_r8,0.29903e-13_r8,0.35902e-13_r8,0.42540e-13_r8 /) + kbo(:,49, 2) = (/ & + & 0.14144e-13_r8,0.18180e-13_r8,0.22467e-13_r8,0.26985e-13_r8,0.32471e-13_r8 /) + kbo(:,50, 2) = (/ & + & 0.10280e-13_r8,0.13471e-13_r8,0.16900e-13_r8,0.20465e-13_r8,0.24665e-13_r8 /) + kbo(:,51, 2) = (/ & + & 0.74898e-14_r8,0.99392e-14_r8,0.12674e-13_r8,0.15571e-13_r8,0.18663e-13_r8 /) + kbo(:,52, 2) = (/ & + & 0.54214e-14_r8,0.72917e-14_r8,0.94517e-14_r8,0.11816e-13_r8,0.14256e-13_r8 /) + kbo(:,53, 2) = (/ & + & 0.38970e-14_r8,0.53165e-14_r8,0.69989e-14_r8,0.88828e-14_r8,0.10862e-13_r8 /) + kbo(:,54, 2) = (/ & + & 0.27972e-14_r8,0.38775e-14_r8,0.51927e-14_r8,0.66775e-14_r8,0.82659e-14_r8 /) + kbo(:,55, 2) = (/ & + & 0.19962e-14_r8,0.28257e-14_r8,0.38491e-14_r8,0.50059e-14_r8,0.62864e-14_r8 /) + kbo(:,56, 2) = (/ & + & 0.14049e-14_r8,0.20447e-14_r8,0.28389e-14_r8,0.37444e-14_r8,0.47474e-14_r8 /) + kbo(:,57, 2) = (/ & + & 0.97467e-15_r8,0.14635e-14_r8,0.20787e-14_r8,0.27878e-14_r8,0.35737e-14_r8 /) + kbo(:,58, 2) = (/ & + & 0.67770e-15_r8,0.10398e-14_r8,0.15169e-14_r8,0.20739e-14_r8,0.26951e-14_r8 /) + kbo(:,59, 2) = (/ & + & 0.50857e-15_r8,0.79496e-15_r8,0.11749e-14_r8,0.16262e-14_r8,0.21270e-14_r8 /) + kbo(:,13, 3) = (/ & + & 0.93671e-10_r8,0.11591e-09_r8,0.13715e-09_r8,0.15779e-09_r8,0.17870e-09_r8 /) + kbo(:,14, 3) = (/ & + & 0.78883e-10_r8,0.96971e-10_r8,0.11437e-09_r8,0.13160e-09_r8,0.14863e-09_r8 /) + kbo(:,15, 3) = (/ & + & 0.66900e-10_r8,0.81568e-10_r8,0.96052e-10_r8,0.11028e-09_r8,0.12439e-09_r8 /) + kbo(:,16, 3) = (/ & + & 0.56737e-10_r8,0.68853e-10_r8,0.80870e-10_r8,0.92769e-10_r8,0.10422e-09_r8 /) + kbo(:,17, 3) = (/ & + & 0.48148e-10_r8,0.58209e-10_r8,0.68168e-10_r8,0.78006e-10_r8,0.87308e-10_r8 /) + kbo(:,18, 3) = (/ & + & 0.40874e-10_r8,0.49268e-10_r8,0.57591e-10_r8,0.65627e-10_r8,0.73296e-10_r8 /) + kbo(:,19, 3) = (/ & + & 0.34619e-10_r8,0.41578e-10_r8,0.48414e-10_r8,0.55049e-10_r8,0.61235e-10_r8 /) + kbo(:,20, 3) = (/ & + & 0.29370e-10_r8,0.35034e-10_r8,0.40682e-10_r8,0.46014e-10_r8,0.51115e-10_r8 /) + kbo(:,21, 3) = (/ & + & 0.24821e-10_r8,0.29490e-10_r8,0.34141e-10_r8,0.38423e-10_r8,0.42621e-10_r8 /) + kbo(:,22, 3) = (/ & + & 0.21204e-10_r8,0.25041e-10_r8,0.28846e-10_r8,0.32305e-10_r8,0.35757e-10_r8 /) + kbo(:,23, 3) = (/ & + & 0.18107e-10_r8,0.21244e-10_r8,0.24304e-10_r8,0.27144e-10_r8,0.30005e-10_r8 /) + kbo(:,24, 3) = (/ & + & 0.15432e-10_r8,0.18015e-10_r8,0.20470e-10_r8,0.22803e-10_r8,0.25180e-10_r8 /) + kbo(:,25, 3) = (/ & + & 0.13155e-10_r8,0.15266e-10_r8,0.17234e-10_r8,0.19170e-10_r8,0.21096e-10_r8 /) + kbo(:,26, 3) = (/ & + & 0.11220e-10_r8,0.12944e-10_r8,0.14527e-10_r8,0.16132e-10_r8,0.17690e-10_r8 /) + kbo(:,27, 3) = (/ & + & 0.95562e-11_r8,0.10942e-10_r8,0.12242e-10_r8,0.13560e-10_r8,0.14820e-10_r8 /) + kbo(:,28, 3) = (/ & + & 0.81359e-11_r8,0.92394e-11_r8,0.10309e-10_r8,0.11386e-10_r8,0.12407e-10_r8 /) + kbo(:,29, 3) = (/ & + & 0.69193e-11_r8,0.78077e-11_r8,0.87009e-11_r8,0.95682e-11_r8,0.10386e-10_r8 /) + kbo(:,30, 3) = (/ & + & 0.58737e-11_r8,0.65956e-11_r8,0.73381e-11_r8,0.80325e-11_r8,0.87147e-11_r8 /) + kbo(:,31, 3) = (/ & + & 0.49782e-11_r8,0.55816e-11_r8,0.61826e-11_r8,0.67463e-11_r8,0.73000e-11_r8 /) + kbo(:,32, 3) = (/ & + & 0.42202e-11_r8,0.47232e-11_r8,0.52043e-11_r8,0.56623e-11_r8,0.61016e-11_r8 /) + kbo(:,33, 3) = (/ & + & 0.35744e-11_r8,0.39897e-11_r8,0.43757e-11_r8,0.47465e-11_r8,0.50931e-11_r8 /) + kbo(:,34, 3) = (/ & + & 0.30127e-11_r8,0.33496e-11_r8,0.36630e-11_r8,0.39738e-11_r8,0.42413e-11_r8 /) + kbo(:,35, 3) = (/ & + & 0.25098e-11_r8,0.27837e-11_r8,0.30393e-11_r8,0.32916e-11_r8,0.35093e-11_r8 /) + kbo(:,36, 3) = (/ & + & 0.20644e-11_r8,0.22886e-11_r8,0.24982e-11_r8,0.27043e-11_r8,0.28833e-11_r8 /) + kbo(:,37, 3) = (/ & + & 0.16684e-11_r8,0.18536e-11_r8,0.20259e-11_r8,0.21979e-11_r8,0.23456e-11_r8 /) + kbo(:,38, 3) = (/ & + & 0.13466e-11_r8,0.14996e-11_r8,0.16425e-11_r8,0.17834e-11_r8,0.19065e-11_r8 /) + kbo(:,39, 3) = (/ & + & 0.10861e-11_r8,0.12130e-11_r8,0.13309e-11_r8,0.14440e-11_r8,0.15498e-11_r8 /) + kbo(:,40, 3) = (/ & + & 0.86498e-12_r8,0.96921e-12_r8,0.10678e-11_r8,0.11601e-11_r8,0.12509e-11_r8 /) + kbo(:,41, 3) = (/ & + & 0.68788e-12_r8,0.77191e-12_r8,0.85472e-12_r8,0.93133e-12_r8,0.10084e-11_r8 /) + kbo(:,42, 3) = (/ & + & 0.54661e-12_r8,0.61437e-12_r8,0.68360e-12_r8,0.74699e-12_r8,0.81088e-12_r8 /) + kbo(:,43, 3) = (/ & + & 0.42920e-12_r8,0.48515e-12_r8,0.54174e-12_r8,0.59564e-12_r8,0.64658e-12_r8 /) + kbo(:,44, 3) = (/ & + & 0.33491e-12_r8,0.38198e-12_r8,0.42756e-12_r8,0.47274e-12_r8,0.51490e-12_r8 /) + kbo(:,45, 3) = (/ & + & 0.26072e-12_r8,0.29981e-12_r8,0.33699e-12_r8,0.37442e-12_r8,0.40968e-12_r8 /) + kbo(:,46, 3) = (/ & + & 0.20167e-12_r8,0.23370e-12_r8,0.26473e-12_r8,0.29535e-12_r8,0.32495e-12_r8 /) + kbo(:,47, 3) = (/ & + & 0.15427e-12_r8,0.18070e-12_r8,0.20644e-12_r8,0.23129e-12_r8,0.25612e-12_r8 /) + kbo(:,48, 3) = (/ & + & 0.11746e-12_r8,0.13905e-12_r8,0.16032e-12_r8,0.18088e-12_r8,0.20125e-12_r8 /) + kbo(:,49, 3) = (/ & + & 0.88976e-13_r8,0.10661e-12_r8,0.12415e-12_r8,0.14128e-12_r8,0.15777e-12_r8 /) + kbo(:,50, 3) = (/ & + & 0.67378e-13_r8,0.81791e-13_r8,0.96162e-13_r8,0.11029e-12_r8,0.12384e-12_r8 /) + kbo(:,51, 3) = (/ & + & 0.50786e-13_r8,0.62576e-13_r8,0.74348e-13_r8,0.85995e-13_r8,0.97345e-13_r8 /) + kbo(:,52, 3) = (/ & + & 0.37951e-13_r8,0.47645e-13_r8,0.57250e-13_r8,0.66805e-13_r8,0.76257e-13_r8 /) + kbo(:,53, 3) = (/ & + & 0.28159e-13_r8,0.36102e-13_r8,0.43964e-13_r8,0.51774e-13_r8,0.59583e-13_r8 /) + kbo(:,54, 3) = (/ & + & 0.21004e-13_r8,0.27366e-13_r8,0.33776e-13_r8,0.40177e-13_r8,0.46583e-13_r8 /) + kbo(:,55, 3) = (/ & + & 0.15637e-13_r8,0.20632e-13_r8,0.25941e-13_r8,0.31184e-13_r8,0.36409e-13_r8 /) + kbo(:,56, 3) = (/ & + & 0.11581e-13_r8,0.15522e-13_r8,0.19844e-13_r8,0.24130e-13_r8,0.28399e-13_r8 /) + kbo(:,57, 3) = (/ & + & 0.85125e-14_r8,0.11631e-13_r8,0.15093e-13_r8,0.18610e-13_r8,0.22102e-13_r8 /) + kbo(:,58, 3) = (/ & + & 0.62435e-14_r8,0.87193e-14_r8,0.11437e-13_r8,0.14347e-13_r8,0.17208e-13_r8 /) + kbo(:,59, 3) = (/ & + & 0.48886e-14_r8,0.68810e-14_r8,0.90777e-14_r8,0.11450e-13_r8,0.13800e-13_r8 /) + kbo(:,13, 4) = (/ & + & 0.49769e-09_r8,0.57573e-09_r8,0.65456e-09_r8,0.73233e-09_r8,0.81030e-09_r8 /) + kbo(:,14, 4) = (/ & + & 0.41687e-09_r8,0.48070e-09_r8,0.54629e-09_r8,0.61156e-09_r8,0.67509e-09_r8 /) + kbo(:,15, 4) = (/ & + & 0.35004e-09_r8,0.40346e-09_r8,0.45778e-09_r8,0.51155e-09_r8,0.56442e-09_r8 /) + kbo(:,16, 4) = (/ & + & 0.29428e-09_r8,0.33893e-09_r8,0.38370e-09_r8,0.42831e-09_r8,0.47172e-09_r8 /) + kbo(:,17, 4) = (/ & + & 0.24736e-09_r8,0.28447e-09_r8,0.32184e-09_r8,0.35882e-09_r8,0.39576e-09_r8 /) + kbo(:,18, 4) = (/ & + & 0.20799e-09_r8,0.23913e-09_r8,0.26980e-09_r8,0.30118e-09_r8,0.33239e-09_r8 /) + kbo(:,19, 4) = (/ & + & 0.17474e-09_r8,0.20037e-09_r8,0.22650e-09_r8,0.25275e-09_r8,0.27848e-09_r8 /) + kbo(:,20, 4) = (/ & + & 0.14678e-09_r8,0.16826e-09_r8,0.19015e-09_r8,0.21182e-09_r8,0.23321e-09_r8 /) + kbo(:,21, 4) = (/ & + & 0.12329e-09_r8,0.14137e-09_r8,0.15951e-09_r8,0.17762e-09_r8,0.19539e-09_r8 /) + kbo(:,22, 4) = (/ & + & 0.10475e-09_r8,0.11989e-09_r8,0.13488e-09_r8,0.14993e-09_r8,0.16481e-09_r8 /) + kbo(:,23, 4) = (/ & + & 0.89090e-10_r8,0.10156e-09_r8,0.11416e-09_r8,0.12661e-09_r8,0.13928e-09_r8 /) + kbo(:,24, 4) = (/ & + & 0.75648e-10_r8,0.86094e-10_r8,0.96530e-10_r8,0.10692e-09_r8,0.11716e-09_r8 /) + kbo(:,25, 4) = (/ & + & 0.64419e-10_r8,0.73036e-10_r8,0.81659e-10_r8,0.90142e-10_r8,0.98524e-10_r8 /) + kbo(:,26, 4) = (/ & + & 0.54857e-10_r8,0.61972e-10_r8,0.69147e-10_r8,0.76125e-10_r8,0.82778e-10_r8 /) + kbo(:,27, 4) = (/ & + & 0.46656e-10_r8,0.52591e-10_r8,0.58413e-10_r8,0.64168e-10_r8,0.69451e-10_r8 /) + kbo(:,28, 4) = (/ & + & 0.39665e-10_r8,0.44561e-10_r8,0.49317e-10_r8,0.53971e-10_r8,0.58228e-10_r8 /) + kbo(:,29, 4) = (/ & + & 0.33755e-10_r8,0.37736e-10_r8,0.41652e-10_r8,0.45382e-10_r8,0.48825e-10_r8 /) + kbo(:,30, 4) = (/ & + & 0.28671e-10_r8,0.31949e-10_r8,0.35144e-10_r8,0.38141e-10_r8,0.41003e-10_r8 /) + kbo(:,31, 4) = (/ & + & 0.24360e-10_r8,0.27027e-10_r8,0.29632e-10_r8,0.32038e-10_r8,0.34391e-10_r8 /) + kbo(:,32, 4) = (/ & + & 0.20671e-10_r8,0.22852e-10_r8,0.24963e-10_r8,0.26903e-10_r8,0.28818e-10_r8 /) + kbo(:,33, 4) = (/ & + & 0.17515e-10_r8,0.19306e-10_r8,0.20998e-10_r8,0.22562e-10_r8,0.24113e-10_r8 /) + kbo(:,34, 4) = (/ & + & 0.14755e-10_r8,0.16223e-10_r8,0.17588e-10_r8,0.18905e-10_r8,0.20105e-10_r8 /) + kbo(:,35, 4) = (/ & + & 0.12305e-10_r8,0.13505e-10_r8,0.14616e-10_r8,0.15703e-10_r8,0.16661e-10_r8 /) + kbo(:,36, 4) = (/ & + & 0.10152e-10_r8,0.11132e-10_r8,0.12046e-10_r8,0.12938e-10_r8,0.13718e-10_r8 /) + kbo(:,37, 4) = (/ & + & 0.82437e-11_r8,0.90546e-11_r8,0.98101e-11_r8,0.10549e-10_r8,0.11200e-10_r8 /) + kbo(:,38, 4) = (/ & + & 0.66891e-11_r8,0.73572e-11_r8,0.79832e-11_r8,0.85923e-11_r8,0.91388e-11_r8 /) + kbo(:,39, 4) = (/ & + & 0.54271e-11_r8,0.59789e-11_r8,0.64946e-11_r8,0.69804e-11_r8,0.74536e-11_r8 /) + kbo(:,40, 4) = (/ & + & 0.43504e-11_r8,0.48077e-11_r8,0.52359e-11_r8,0.56420e-11_r8,0.60390e-11_r8 /) + kbo(:,41, 4) = (/ & + & 0.34805e-11_r8,0.38570e-11_r8,0.42158e-11_r8,0.45532e-11_r8,0.48856e-11_r8 /) + kbo(:,42, 4) = (/ & + & 0.27817e-11_r8,0.30896e-11_r8,0.33906e-11_r8,0.36712e-11_r8,0.39504e-11_r8 /) + kbo(:,43, 4) = (/ & + & 0.22059e-11_r8,0.24603e-11_r8,0.27112e-11_r8,0.29449e-11_r8,0.31673e-11_r8 /) + kbo(:,44, 4) = (/ & + & 0.17407e-11_r8,0.19508e-11_r8,0.21593e-11_r8,0.23549e-11_r8,0.25394e-11_r8 /) + kbo(:,45, 4) = (/ & + & 0.13717e-11_r8,0.15444e-11_r8,0.17149e-11_r8,0.18808e-11_r8,0.20349e-11_r8 /) + kbo(:,46, 4) = (/ & + & 0.10758e-11_r8,0.12178e-11_r8,0.13582e-11_r8,0.14973e-11_r8,0.16264e-11_r8 /) + kbo(:,47, 4) = (/ & + & 0.83623e-12_r8,0.95326e-12_r8,0.10692e-11_r8,0.11850e-11_r8,0.12934e-11_r8 /) + kbo(:,48, 4) = (/ & + & 0.64811e-12_r8,0.74426e-12_r8,0.84002e-12_r8,0.93446e-12_r8,0.10270e-11_r8 /) + kbo(:,49, 4) = (/ & + & 0.50093e-12_r8,0.57976e-12_r8,0.65824e-12_r8,0.73652e-12_r8,0.81364e-12_r8 /) + kbo(:,50, 4) = (/ & + & 0.38740e-12_r8,0.45167e-12_r8,0.51620e-12_r8,0.58084e-12_r8,0.64495e-12_r8 /) + kbo(:,51, 4) = (/ & + & 0.29910e-12_r8,0.35149e-12_r8,0.40454e-12_r8,0.45768e-12_r8,0.51010e-12_r8 /) + kbo(:,52, 4) = (/ & + & 0.23004e-12_r8,0.27291e-12_r8,0.31637e-12_r8,0.35993e-12_r8,0.40313e-12_r8 /) + kbo(:,53, 4) = (/ & + & 0.17654e-12_r8,0.21129e-12_r8,0.24667e-12_r8,0.28251e-12_r8,0.31798e-12_r8 /) + kbo(:,54, 4) = (/ & + & 0.13566e-12_r8,0.16388e-12_r8,0.19277e-12_r8,0.22203e-12_r8,0.25140e-12_r8 /) + kbo(:,55, 4) = (/ & + & 0.10414e-12_r8,0.12705e-12_r8,0.15062e-12_r8,0.17458e-12_r8,0.19863e-12_r8 /) + kbo(:,56, 4) = (/ & + & 0.79695e-13_r8,0.98154e-13_r8,0.11737e-12_r8,0.13696e-12_r8,0.15674e-12_r8 /) + kbo(:,57, 4) = (/ & + & 0.60735e-13_r8,0.75667e-13_r8,0.91265e-13_r8,0.10718e-12_r8,0.12346e-12_r8 /) + kbo(:,58, 4) = (/ & + & 0.46331e-13_r8,0.58316e-13_r8,0.71018e-13_r8,0.83950e-13_r8,0.97215e-13_r8 /) + kbo(:,59, 4) = (/ & + & 0.36896e-13_r8,0.46643e-13_r8,0.57036e-13_r8,0.67613e-13_r8,0.78545e-13_r8 /) + kbo(:,13, 5) = (/ & + & 0.26254e-08_r8,0.28627e-08_r8,0.30909e-08_r8,0.33000e-08_r8,0.34892e-08_r8 /) + kbo(:,14, 5) = (/ & + & 0.21830e-08_r8,0.23794e-08_r8,0.25635e-08_r8,0.27354e-08_r8,0.28987e-08_r8 /) + kbo(:,15, 5) = (/ & + & 0.18164e-08_r8,0.19772e-08_r8,0.21299e-08_r8,0.22819e-08_r8,0.24177e-08_r8 /) + kbo(:,16, 5) = (/ & + & 0.15141e-08_r8,0.16500e-08_r8,0.17819e-08_r8,0.19057e-08_r8,0.20139e-08_r8 /) + kbo(:,17, 5) = (/ & + & 0.12644e-08_r8,0.13791e-08_r8,0.14854e-08_r8,0.15868e-08_r8,0.16779e-08_r8 /) + kbo(:,18, 5) = (/ & + & 0.10569e-08_r8,0.11490e-08_r8,0.12387e-08_r8,0.13249e-08_r8,0.14004e-08_r8 /) + kbo(:,19, 5) = (/ & + & 0.88077e-09_r8,0.95771e-09_r8,0.10342e-08_r8,0.11045e-08_r8,0.11654e-08_r8 /) + kbo(:,20, 5) = (/ & + & 0.73433e-09_r8,0.79954e-09_r8,0.86343e-09_r8,0.92049e-09_r8,0.97111e-09_r8 /) + kbo(:,21, 5) = (/ & + & 0.61317e-09_r8,0.66751e-09_r8,0.72065e-09_r8,0.76613e-09_r8,0.80891e-09_r8 /) + kbo(:,22, 5) = (/ & + & 0.51519e-09_r8,0.56066e-09_r8,0.60290e-09_r8,0.64113e-09_r8,0.67719e-09_r8 /) + kbo(:,23, 5) = (/ & + & 0.43331e-09_r8,0.47103e-09_r8,0.50532e-09_r8,0.53747e-09_r8,0.56589e-09_r8 /) + kbo(:,24, 5) = (/ & + & 0.36478e-09_r8,0.39531e-09_r8,0.42421e-09_r8,0.45023e-09_r8,0.47333e-09_r8 /) + kbo(:,25, 5) = (/ & + & 0.30661e-09_r8,0.33249e-09_r8,0.35642e-09_r8,0.37711e-09_r8,0.39645e-09_r8 /) + kbo(:,26, 5) = (/ & + & 0.25851e-09_r8,0.28030e-09_r8,0.29893e-09_r8,0.31621e-09_r8,0.33249e-09_r8 /) + kbo(:,27, 5) = (/ & + & 0.21849e-09_r8,0.23581e-09_r8,0.25124e-09_r8,0.26548e-09_r8,0.27889e-09_r8 /) + kbo(:,28, 5) = (/ & + & 0.18476e-09_r8,0.19866e-09_r8,0.21115e-09_r8,0.22285e-09_r8,0.23419e-09_r8 /) + kbo(:,29, 5) = (/ & + & 0.15608e-09_r8,0.16725e-09_r8,0.17764e-09_r8,0.18744e-09_r8,0.19627e-09_r8 /) + kbo(:,30, 5) = (/ & + & 0.13180e-09_r8,0.14084e-09_r8,0.14944e-09_r8,0.15734e-09_r8,0.16419e-09_r8 /) + kbo(:,31, 5) = (/ & + & 0.11122e-09_r8,0.11878e-09_r8,0.12548e-09_r8,0.13183e-09_r8,0.13690e-09_r8 /) + kbo(:,32, 5) = (/ & + & 0.93806e-10_r8,0.99909e-10_r8,0.10547e-09_r8,0.11013e-09_r8,0.11393e-09_r8 /) + kbo(:,33, 5) = (/ & + & 0.79057e-10_r8,0.83869e-10_r8,0.88337e-10_r8,0.91833e-10_r8,0.94728e-10_r8 /) + kbo(:,34, 5) = (/ & + & 0.66383e-10_r8,0.70216e-10_r8,0.73644e-10_r8,0.76467e-10_r8,0.78589e-10_r8 /) + kbo(:,35, 5) = (/ & + & 0.55303e-10_r8,0.58435e-10_r8,0.61122e-10_r8,0.63317e-10_r8,0.64984e-10_r8 /) + kbo(:,36, 5) = (/ & + & 0.45788e-10_r8,0.48318e-10_r8,0.50463e-10_r8,0.52237e-10_r8,0.53589e-10_r8 /) + kbo(:,37, 5) = (/ & + & 0.37517e-10_r8,0.39593e-10_r8,0.41407e-10_r8,0.42883e-10_r8,0.44012e-10_r8 /) + kbo(:,38, 5) = (/ & + & 0.30717e-10_r8,0.32436e-10_r8,0.33950e-10_r8,0.35197e-10_r8,0.36146e-10_r8 /) + kbo(:,39, 5) = (/ & + & 0.25129e-10_r8,0.26560e-10_r8,0.27827e-10_r8,0.28835e-10_r8,0.29676e-10_r8 /) + kbo(:,40, 5) = (/ & + & 0.20420e-10_r8,0.21620e-10_r8,0.22699e-10_r8,0.23564e-10_r8,0.24290e-10_r8 /) + kbo(:,41, 5) = (/ & + & 0.16561e-10_r8,0.17583e-10_r8,0.18496e-10_r8,0.19245e-10_r8,0.19868e-10_r8 /) + kbo(:,42, 5) = (/ & + & 0.13418e-10_r8,0.14291e-10_r8,0.15059e-10_r8,0.15706e-10_r8,0.16243e-10_r8 /) + kbo(:,43, 5) = (/ & + & 0.10810e-10_r8,0.11562e-10_r8,0.12210e-10_r8,0.12774e-10_r8,0.13223e-10_r8 /) + kbo(:,44, 5) = (/ & + & 0.86843e-11_r8,0.93265e-11_r8,0.98789e-11_r8,0.10369e-10_r8,0.10770e-10_r8 /) + kbo(:,45, 5) = (/ & + & 0.69593e-11_r8,0.75111e-11_r8,0.79891e-11_r8,0.84084e-11_r8,0.87638e-11_r8 /) + kbo(:,46, 5) = (/ & + & 0.55576e-11_r8,0.60308e-11_r8,0.64400e-11_r8,0.68030e-11_r8,0.71149e-11_r8 /) + kbo(:,47, 5) = (/ & + & 0.44097e-11_r8,0.48155e-11_r8,0.51709e-11_r8,0.54794e-11_r8,0.57570e-11_r8 /) + kbo(:,48, 5) = (/ & + & 0.34877e-11_r8,0.38384e-11_r8,0.41433e-11_r8,0.44120e-11_r8,0.46521e-11_r8 /) + kbo(:,49, 5) = (/ & + & 0.27512e-11_r8,0.30491e-11_r8,0.33123e-11_r8,0.35456e-11_r8,0.37509e-11_r8 /) + kbo(:,50, 5) = (/ & + & 0.21734e-11_r8,0.24185e-11_r8,0.26481e-11_r8,0.28485e-11_r8,0.30236e-11_r8 /) + kbo(:,51, 5) = (/ & + & 0.17150e-11_r8,0.19185e-11_r8,0.21147e-11_r8,0.22857e-11_r8,0.24371e-11_r8 /) + kbo(:,52, 5) = (/ & + & 0.13499e-11_r8,0.15196e-11_r8,0.16853e-11_r8,0.18315e-11_r8,0.19613e-11_r8 /) + kbo(:,53, 5) = (/ & + & 0.10590e-11_r8,0.11989e-11_r8,0.13374e-11_r8,0.14641e-11_r8,0.15756e-11_r8 /) + kbo(:,54, 5) = (/ & + & 0.83182e-12_r8,0.94832e-12_r8,0.10625e-11_r8,0.11713e-11_r8,0.12669e-11_r8 /) + kbo(:,55, 5) = (/ & + & 0.65257e-12_r8,0.74992e-12_r8,0.84445e-12_r8,0.93664e-12_r8,0.10175e-11_r8 /) + kbo(:,56, 5) = (/ & + & 0.51109e-12_r8,0.59162e-12_r8,0.67030e-12_r8,0.74706e-12_r8,0.81634e-12_r8 /) + kbo(:,57, 5) = (/ & + & 0.39868e-12_r8,0.46532e-12_r8,0.53042e-12_r8,0.59449e-12_r8,0.65374e-12_r8 /) + kbo(:,58, 5) = (/ & + & 0.31062e-12_r8,0.36629e-12_r8,0.42009e-12_r8,0.47298e-12_r8,0.52357e-12_r8 /) + kbo(:,59, 5) = (/ & + & 0.24996e-12_r8,0.29597e-12_r8,0.34052e-12_r8,0.38403e-12_r8,0.42584e-12_r8 /) + kbo(:,13, 6) = (/ & + & 0.10275e-07_r8,0.10425e-07_r8,0.10505e-07_r8,0.10571e-07_r8,0.10619e-07_r8 /) + kbo(:,14, 6) = (/ & + & 0.84309e-08_r8,0.85528e-08_r8,0.86280e-08_r8,0.86935e-08_r8,0.87236e-08_r8 /) + kbo(:,15, 6) = (/ & + & 0.69259e-08_r8,0.70218e-08_r8,0.71031e-08_r8,0.71419e-08_r8,0.71430e-08_r8 /) + kbo(:,16, 6) = (/ & + & 0.56933e-08_r8,0.57765e-08_r8,0.58298e-08_r8,0.58527e-08_r8,0.58704e-08_r8 /) + kbo(:,17, 6) = (/ & + & 0.46880e-08_r8,0.47555e-08_r8,0.47985e-08_r8,0.48270e-08_r8,0.48471e-08_r8 /) + kbo(:,18, 6) = (/ & + & 0.38628e-08_r8,0.39183e-08_r8,0.39591e-08_r8,0.39923e-08_r8,0.40106e-08_r8 /) + kbo(:,19, 6) = (/ & + & 0.31833e-08_r8,0.32370e-08_r8,0.32750e-08_r8,0.32992e-08_r8,0.33139e-08_r8 /) + kbo(:,20, 6) = (/ & + & 0.26315e-08_r8,0.26765e-08_r8,0.27033e-08_r8,0.27208e-08_r8,0.27412e-08_r8 /) + kbo(:,21, 6) = (/ & + & 0.21768e-08_r8,0.22074e-08_r8,0.22281e-08_r8,0.22492e-08_r8,0.22648e-08_r8 /) + kbo(:,22, 6) = (/ & + & 0.17970e-08_r8,0.18204e-08_r8,0.18421e-08_r8,0.18603e-08_r8,0.18697e-08_r8 /) + kbo(:,23, 6) = (/ & + & 0.14828e-08_r8,0.15043e-08_r8,0.15235e-08_r8,0.15373e-08_r8,0.15469e-08_r8 /) + kbo(:,24, 6) = (/ & + & 0.12265e-08_r8,0.12457e-08_r8,0.12602e-08_r8,0.12704e-08_r8,0.12795e-08_r8 /) + kbo(:,25, 6) = (/ & + & 0.10153e-08_r8,0.10303e-08_r8,0.10406e-08_r8,0.10511e-08_r8,0.10591e-08_r8 /) + kbo(:,26, 6) = (/ & + & 0.84067e-09_r8,0.85220e-09_r8,0.86139e-09_r8,0.87145e-09_r8,0.87606e-09_r8 /) + kbo(:,27, 6) = (/ & + & 0.69556e-09_r8,0.70441e-09_r8,0.71396e-09_r8,0.72098e-09_r8,0.72486e-09_r8 /) + kbo(:,28, 6) = (/ & + & 0.57505e-09_r8,0.58326e-09_r8,0.59186e-09_r8,0.59662e-09_r8,0.60056e-09_r8 /) + kbo(:,29, 6) = (/ & + & 0.47621e-09_r8,0.48459e-09_r8,0.49079e-09_r8,0.49432e-09_r8,0.49717e-09_r8 /) + kbo(:,30, 6) = (/ & + & 0.39513e-09_r8,0.40232e-09_r8,0.40640e-09_r8,0.40995e-09_r8,0.41263e-09_r8 /) + kbo(:,31, 6) = (/ & + & 0.32890e-09_r8,0.33390e-09_r8,0.33797e-09_r8,0.34036e-09_r8,0.34440e-09_r8 /) + kbo(:,32, 6) = (/ & + & 0.27372e-09_r8,0.27757e-09_r8,0.28057e-09_r8,0.28360e-09_r8,0.28668e-09_r8 /) + kbo(:,33, 6) = (/ & + & 0.22771e-09_r8,0.23074e-09_r8,0.23349e-09_r8,0.23595e-09_r8,0.23797e-09_r8 /) + kbo(:,34, 6) = (/ & + & 0.18899e-09_r8,0.19179e-09_r8,0.19391e-09_r8,0.19591e-09_r8,0.19720e-09_r8 /) + kbo(:,35, 6) = (/ & + & 0.15677e-09_r8,0.15897e-09_r8,0.16075e-09_r8,0.16219e-09_r8,0.16318e-09_r8 /) + kbo(:,36, 6) = (/ & + & 0.12972e-09_r8,0.13147e-09_r8,0.13291e-09_r8,0.13412e-09_r8,0.13484e-09_r8 /) + kbo(:,37, 6) = (/ & + & 0.10704e-09_r8,0.10855e-09_r8,0.10970e-09_r8,0.11065e-09_r8,0.11129e-09_r8 /) + kbo(:,38, 6) = (/ & + & 0.88219e-10_r8,0.89571e-10_r8,0.90489e-10_r8,0.91263e-10_r8,0.91821e-10_r8 /) + kbo(:,39, 6) = (/ & + & 0.72709e-10_r8,0.73884e-10_r8,0.74615e-10_r8,0.75144e-10_r8,0.75719e-10_r8 /) + kbo(:,40, 6) = (/ & + & 0.59779e-10_r8,0.60793e-10_r8,0.61424e-10_r8,0.61873e-10_r8,0.62379e-10_r8 /) + kbo(:,41, 6) = (/ & + & 0.49104e-10_r8,0.49999e-10_r8,0.50541e-10_r8,0.50924e-10_r8,0.51369e-10_r8 /) + kbo(:,42, 6) = (/ & + & 0.40324e-10_r8,0.41079e-10_r8,0.41584e-10_r8,0.41914e-10_r8,0.42279e-10_r8 /) + kbo(:,43, 6) = (/ & + & 0.33050e-10_r8,0.33695e-10_r8,0.34173e-10_r8,0.34462e-10_r8,0.34716e-10_r8 /) + kbo(:,44, 6) = (/ & + & 0.27054e-10_r8,0.27604e-10_r8,0.28056e-10_r8,0.28313e-10_r8,0.28542e-10_r8 /) + kbo(:,45, 6) = (/ & + & 0.22112e-10_r8,0.22613e-10_r8,0.23018e-10_r8,0.23255e-10_r8,0.23441e-10_r8 /) + kbo(:,46, 6) = (/ & + & 0.18060e-10_r8,0.18501e-10_r8,0.18867e-10_r8,0.19082e-10_r8,0.19252e-10_r8 /) + kbo(:,47, 6) = (/ & + & 0.14722e-10_r8,0.15111e-10_r8,0.15432e-10_r8,0.15658e-10_r8,0.15802e-10_r8 /) + kbo(:,48, 6) = (/ & + & 0.11985e-10_r8,0.12318e-10_r8,0.12624e-10_r8,0.12826e-10_r8,0.12965e-10_r8 /) + kbo(:,49, 6) = (/ & + & 0.97421e-11_r8,0.10040e-10_r8,0.10306e-10_r8,0.10499e-10_r8,0.10630e-10_r8 /) + kbo(:,50, 6) = (/ & + & 0.79055e-11_r8,0.81823e-11_r8,0.84121e-11_r8,0.85902e-11_r8,0.87163e-11_r8 /) + kbo(:,51, 6) = (/ & + & 0.64164e-11_r8,0.66612e-11_r8,0.68621e-11_r8,0.70240e-11_r8,0.71428e-11_r8 /) + kbo(:,52, 6) = (/ & + & 0.51935e-11_r8,0.54159e-11_r8,0.55861e-11_r8,0.57406e-11_r8,0.58465e-11_r8 /) + kbo(:,53, 6) = (/ & + & 0.42017e-11_r8,0.43985e-11_r8,0.45525e-11_r8,0.46862e-11_r8,0.47817e-11_r8 /) + kbo(:,54, 6) = (/ & + & 0.33953e-11_r8,0.35701e-11_r8,0.37080e-11_r8,0.38204e-11_r8,0.39118e-11_r8 /) + kbo(:,55, 6) = (/ & + & 0.27420e-11_r8,0.28948e-11_r8,0.30166e-11_r8,0.31148e-11_r8,0.31981e-11_r8 /) + kbo(:,56, 6) = (/ & + & 0.22097e-11_r8,0.23440e-11_r8,0.24518e-11_r8,0.25378e-11_r8,0.26122e-11_r8 /) + kbo(:,57, 6) = (/ & + & 0.17765e-11_r8,0.18968e-11_r8,0.19913e-11_r8,0.20659e-11_r8,0.21319e-11_r8 /) + kbo(:,58, 6) = (/ & + & 0.14264e-11_r8,0.15324e-11_r8,0.16166e-11_r8,0.16816e-11_r8,0.17374e-11_r8 /) + kbo(:,59, 6) = (/ & + & 0.11621e-11_r8,0.12515e-11_r8,0.13230e-11_r8,0.13773e-11_r8,0.14240e-11_r8 /) + kbo(:,13, 7) = (/ & + & 0.28079e-07_r8,0.28035e-07_r8,0.27949e-07_r8,0.27835e-07_r8,0.27661e-07_r8 /) + kbo(:,14, 7) = (/ & + & 0.23041e-07_r8,0.22982e-07_r8,0.22914e-07_r8,0.22814e-07_r8,0.22653e-07_r8 /) + kbo(:,15, 7) = (/ & + & 0.18899e-07_r8,0.18860e-07_r8,0.18790e-07_r8,0.18675e-07_r8,0.18596e-07_r8 /) + kbo(:,16, 7) = (/ & + & 0.15489e-07_r8,0.15457e-07_r8,0.15389e-07_r8,0.15337e-07_r8,0.15329e-07_r8 /) + kbo(:,17, 7) = (/ & + & 0.12699e-07_r8,0.12665e-07_r8,0.12634e-07_r8,0.12640e-07_r8,0.12612e-07_r8 /) + kbo(:,18, 7) = (/ & + & 0.10409e-07_r8,0.10397e-07_r8,0.10401e-07_r8,0.10391e-07_r8,0.10368e-07_r8 /) + kbo(:,19, 7) = (/ & + & 0.85482e-08_r8,0.85403e-08_r8,0.85408e-08_r8,0.85379e-08_r8,0.85325e-08_r8 /) + kbo(:,20, 7) = (/ & + & 0.70183e-08_r8,0.70212e-08_r8,0.70225e-08_r8,0.70232e-08_r8,0.70243e-08_r8 /) + kbo(:,21, 7) = (/ & + & 0.57704e-08_r8,0.57836e-08_r8,0.57919e-08_r8,0.57990e-08_r8,0.58135e-08_r8 /) + kbo(:,22, 7) = (/ & + & 0.47522e-08_r8,0.47673e-08_r8,0.47834e-08_r8,0.48084e-08_r8,0.48239e-08_r8 /) + kbo(:,23, 7) = (/ & + & 0.39186e-08_r8,0.39439e-08_r8,0.39679e-08_r8,0.39863e-08_r8,0.40063e-08_r8 /) + kbo(:,24, 7) = (/ & + & 0.32407e-08_r8,0.32645e-08_r8,0.32840e-08_r8,0.33039e-08_r8,0.33353e-08_r8 /) + kbo(:,25, 7) = (/ & + & 0.26846e-08_r8,0.27012e-08_r8,0.27199e-08_r8,0.27477e-08_r8,0.27761e-08_r8 /) + kbo(:,26, 7) = (/ & + & 0.22196e-08_r8,0.22367e-08_r8,0.22646e-08_r8,0.22896e-08_r8,0.23141e-08_r8 /) + kbo(:,27, 7) = (/ & + & 0.18370e-08_r8,0.18616e-08_r8,0.18864e-08_r8,0.19087e-08_r8,0.19319e-08_r8 /) + kbo(:,28, 7) = (/ & + & 0.15259e-08_r8,0.15495e-08_r8,0.15695e-08_r8,0.15912e-08_r8,0.16152e-08_r8 /) + kbo(:,29, 7) = (/ & + & 0.12717e-08_r8,0.12907e-08_r8,0.13087e-08_r8,0.13304e-08_r8,0.13523e-08_r8 /) + kbo(:,30, 7) = (/ & + & 0.10599e-08_r8,0.10765e-08_r8,0.10939e-08_r8,0.11139e-08_r8,0.11374e-08_r8 /) + kbo(:,31, 7) = (/ & + & 0.88411e-09_r8,0.89833e-09_r8,0.91628e-09_r8,0.93662e-09_r8,0.95540e-09_r8 /) + kbo(:,32, 7) = (/ & + & 0.73723e-09_r8,0.75198e-09_r8,0.77042e-09_r8,0.78608e-09_r8,0.80601e-09_r8 /) + kbo(:,33, 7) = (/ & + & 0.61511e-09_r8,0.63161e-09_r8,0.64646e-09_r8,0.66232e-09_r8,0.68095e-09_r8 /) + kbo(:,34, 7) = (/ & + & 0.51621e-09_r8,0.53001e-09_r8,0.54332e-09_r8,0.55986e-09_r8,0.57326e-09_r8 /) + kbo(:,35, 7) = (/ & + & 0.43217e-09_r8,0.44439e-09_r8,0.45713e-09_r8,0.47103e-09_r8,0.48242e-09_r8 /) + kbo(:,36, 7) = (/ & + & 0.36090e-09_r8,0.37166e-09_r8,0.38311e-09_r8,0.39461e-09_r8,0.40545e-09_r8 /) + kbo(:,37, 7) = (/ & + & 0.29990e-09_r8,0.30916e-09_r8,0.31937e-09_r8,0.32943e-09_r8,0.34038e-09_r8 /) + kbo(:,38, 7) = (/ & + & 0.24927e-09_r8,0.25737e-09_r8,0.26638e-09_r8,0.27543e-09_r8,0.28596e-09_r8 /) + kbo(:,39, 7) = (/ & + & 0.20718e-09_r8,0.21434e-09_r8,0.22203e-09_r8,0.23026e-09_r8,0.23966e-09_r8 /) + kbo(:,40, 7) = (/ & + & 0.17122e-09_r8,0.17745e-09_r8,0.18425e-09_r8,0.19138e-09_r8,0.19937e-09_r8 /) + kbo(:,41, 7) = (/ & + & 0.14145e-09_r8,0.14673e-09_r8,0.15273e-09_r8,0.15885e-09_r8,0.16544e-09_r8 /) + kbo(:,42, 7) = (/ & + & 0.11673e-09_r8,0.12130e-09_r8,0.12626e-09_r8,0.13156e-09_r8,0.13718e-09_r8 /) + kbo(:,43, 7) = (/ & + & 0.95979e-10_r8,0.99773e-10_r8,0.10407e-09_r8,0.10848e-09_r8,0.11289e-09_r8 /) + kbo(:,44, 7) = (/ & + & 0.78684e-10_r8,0.81894e-10_r8,0.85476e-10_r8,0.89249e-10_r8,0.92971e-10_r8 /) + kbo(:,45, 7) = (/ & + & 0.64482e-10_r8,0.67161e-10_r8,0.70163e-10_r8,0.73315e-10_r8,0.76486e-10_r8 /) + kbo(:,46, 7) = (/ & + & 0.52720e-10_r8,0.54998e-10_r8,0.57509e-10_r8,0.60128e-10_r8,0.62787e-10_r8 /) + kbo(:,47, 7) = (/ & + & 0.42902e-10_r8,0.44887e-10_r8,0.46948e-10_r8,0.49098e-10_r8,0.51392e-10_r8 /) + kbo(:,48, 7) = (/ & + & 0.34914e-10_r8,0.36612e-10_r8,0.38268e-10_r8,0.40114e-10_r8,0.41998e-10_r8 /) + kbo(:,49, 7) = (/ & + & 0.28363e-10_r8,0.29830e-10_r8,0.31160e-10_r8,0.32712e-10_r8,0.34278e-10_r8 /) + kbo(:,50, 7) = (/ & + & 0.23044e-10_r8,0.24298e-10_r8,0.25411e-10_r8,0.26663e-10_r8,0.27956e-10_r8 /) + kbo(:,51, 7) = (/ & + & 0.18719e-10_r8,0.19762e-10_r8,0.20717e-10_r8,0.21748e-10_r8,0.22834e-10_r8 /) + kbo(:,52, 7) = (/ & + & 0.15214e-10_r8,0.16060e-10_r8,0.16882e-10_r8,0.17722e-10_r8,0.18609e-10_r8 /) + kbo(:,53, 7) = (/ & + & 0.12339e-10_r8,0.13039e-10_r8,0.13738e-10_r8,0.14413e-10_r8,0.15144e-10_r8 /) + kbo(:,54, 7) = (/ & + & 0.10028e-10_r8,0.10589e-10_r8,0.11176e-10_r8,0.11743e-10_r8,0.12340e-10_r8 /) + kbo(:,55, 7) = (/ & + & 0.81332e-11_r8,0.85988e-11_r8,0.90904e-11_r8,0.95545e-11_r8,0.10057e-10_r8 /) + kbo(:,56, 7) = (/ & + & 0.66047e-11_r8,0.69777e-11_r8,0.73796e-11_r8,0.77755e-11_r8,0.81880e-11_r8 /) + kbo(:,57, 7) = (/ & + & 0.53536e-11_r8,0.56554e-11_r8,0.59940e-11_r8,0.63232e-11_r8,0.66612e-11_r8 /) + kbo(:,58, 7) = (/ & + & 0.43329e-11_r8,0.45903e-11_r8,0.48661e-11_r8,0.51412e-11_r8,0.54200e-11_r8 /) + kbo(:,59, 7) = (/ & + & 0.35522e-11_r8,0.37646e-11_r8,0.39940e-11_r8,0.42211e-11_r8,0.44525e-11_r8 /) + kbo(:,13, 8) = (/ & + & 0.11230e-06_r8,0.11409e-06_r8,0.11566e-06_r8,0.11672e-06_r8,0.11734e-06_r8 /) + kbo(:,14, 8) = (/ & + & 0.92428e-07_r8,0.93878e-07_r8,0.95014e-07_r8,0.95711e-07_r8,0.96110e-07_r8 /) + kbo(:,15, 8) = (/ & + & 0.76021e-07_r8,0.77148e-07_r8,0.77913e-07_r8,0.78505e-07_r8,0.78756e-07_r8 /) + kbo(:,16, 8) = (/ & + & 0.62512e-07_r8,0.63402e-07_r8,0.63979e-07_r8,0.64292e-07_r8,0.64352e-07_r8 /) + kbo(:,17, 8) = (/ & + & 0.51480e-07_r8,0.52099e-07_r8,0.52465e-07_r8,0.52634e-07_r8,0.52753e-07_r8 /) + kbo(:,18, 8) = (/ & + & 0.42336e-07_r8,0.42773e-07_r8,0.43015e-07_r8,0.43145e-07_r8,0.43290e-07_r8 /) + kbo(:,19, 8) = (/ & + & 0.34820e-07_r8,0.35138e-07_r8,0.35326e-07_r8,0.35465e-07_r8,0.35546e-07_r8 /) + kbo(:,20, 8) = (/ & + & 0.28634e-07_r8,0.28882e-07_r8,0.29099e-07_r8,0.29190e-07_r8,0.29248e-07_r8 /) + kbo(:,21, 8) = (/ & + & 0.23527e-07_r8,0.23767e-07_r8,0.23879e-07_r8,0.24001e-07_r8,0.24136e-07_r8 /) + kbo(:,22, 8) = (/ & + & 0.19380e-07_r8,0.19526e-07_r8,0.19668e-07_r8,0.19823e-07_r8,0.20000e-07_r8 /) + kbo(:,23, 8) = (/ & + & 0.15955e-07_r8,0.16103e-07_r8,0.16252e-07_r8,0.16425e-07_r8,0.16561e-07_r8 /) + kbo(:,24, 8) = (/ & + & 0.13163e-07_r8,0.13294e-07_r8,0.13466e-07_r8,0.13609e-07_r8,0.13701e-07_r8 /) + kbo(:,25, 8) = (/ & + & 0.10863e-07_r8,0.11029e-07_r8,0.11155e-07_r8,0.11256e-07_r8,0.11368e-07_r8 /) + kbo(:,26, 8) = (/ & + & 0.90043e-08_r8,0.91173e-08_r8,0.92226e-08_r8,0.93261e-08_r8,0.94322e-08_r8 /) + kbo(:,27, 8) = (/ & + & 0.74604e-08_r8,0.75548e-08_r8,0.76410e-08_r8,0.77390e-08_r8,0.78488e-08_r8 /) + kbo(:,28, 8) = (/ & + & 0.61944e-08_r8,0.62754e-08_r8,0.63658e-08_r8,0.64728e-08_r8,0.65523e-08_r8 /) + kbo(:,29, 8) = (/ & + & 0.51553e-08_r8,0.52390e-08_r8,0.53444e-08_r8,0.54244e-08_r8,0.55104e-08_r8 /) + kbo(:,30, 8) = (/ & + & 0.43022e-08_r8,0.44056e-08_r8,0.44906e-08_r8,0.45753e-08_r8,0.46815e-08_r8 /) + kbo(:,31, 8) = (/ & + & 0.36260e-08_r8,0.37147e-08_r8,0.37854e-08_r8,0.38857e-08_r8,0.39725e-08_r8 /) + kbo(:,32, 8) = (/ & + & 0.30574e-08_r8,0.31222e-08_r8,0.32149e-08_r8,0.32959e-08_r8,0.33679e-08_r8 /) + kbo(:,33, 8) = (/ & + & 0.25690e-08_r8,0.26475e-08_r8,0.27306e-08_r8,0.27942e-08_r8,0.28607e-08_r8 /) + kbo(:,34, 8) = (/ & + & 0.21739e-08_r8,0.22522e-08_r8,0.23131e-08_r8,0.23724e-08_r8,0.24398e-08_r8 /) + kbo(:,35, 8) = (/ & + & 0.18403e-08_r8,0.19033e-08_r8,0.19580e-08_r8,0.20191e-08_r8,0.20792e-08_r8 /) + kbo(:,36, 8) = (/ & + & 0.15538e-08_r8,0.16068e-08_r8,0.16535e-08_r8,0.17159e-08_r8,0.17681e-08_r8 /) + kbo(:,37, 8) = (/ & + & 0.13002e-08_r8,0.13483e-08_r8,0.13923e-08_r8,0.14493e-08_r8,0.14927e-08_r8 /) + kbo(:,38, 8) = (/ & + & 0.10893e-08_r8,0.11319e-08_r8,0.11765e-08_r8,0.12253e-08_r8,0.12624e-08_r8 /) + kbo(:,39, 8) = (/ & + & 0.91348e-09_r8,0.95067e-09_r8,0.99134e-09_r8,0.10293e-08_r8,0.10668e-08_r8 /) + kbo(:,40, 8) = (/ & + & 0.76170e-09_r8,0.79404e-09_r8,0.82953e-09_r8,0.86548e-09_r8,0.90041e-09_r8 /) + kbo(:,41, 8) = (/ & + & 0.63292e-09_r8,0.66170e-09_r8,0.69363e-09_r8,0.72573e-09_r8,0.75710e-09_r8 /) + kbo(:,42, 8) = (/ & + & 0.52609e-09_r8,0.55120e-09_r8,0.57974e-09_r8,0.60803e-09_r8,0.63636e-09_r8 /) + kbo(:,43, 8) = (/ & + & 0.43444e-09_r8,0.45674e-09_r8,0.48206e-09_r8,0.50747e-09_r8,0.53053e-09_r8 /) + kbo(:,44, 8) = (/ & + & 0.35755e-09_r8,0.37758e-09_r8,0.39965e-09_r8,0.42169e-09_r8,0.44276e-09_r8 /) + kbo(:,45, 8) = (/ & + & 0.29410e-09_r8,0.31126e-09_r8,0.33079e-09_r8,0.35014e-09_r8,0.36874e-09_r8 /) + kbo(:,46, 8) = (/ & + & 0.24113e-09_r8,0.25605e-09_r8,0.27273e-09_r8,0.28962e-09_r8,0.30646e-09_r8 /) + kbo(:,47, 8) = (/ & + & 0.19675e-09_r8,0.20937e-09_r8,0.22390e-09_r8,0.23865e-09_r8,0.25330e-09_r8 /) + kbo(:,48, 8) = (/ & + & 0.16029e-09_r8,0.17125e-09_r8,0.18339e-09_r8,0.19620e-09_r8,0.20918e-09_r8 /) + kbo(:,49, 8) = (/ & + & 0.13018e-09_r8,0.13961e-09_r8,0.15020e-09_r8,0.16108e-09_r8,0.17231e-09_r8 /) + kbo(:,50, 8) = (/ & + & 0.10559e-09_r8,0.11394e-09_r8,0.12271e-09_r8,0.13208e-09_r8,0.14200e-09_r8 /) + kbo(:,51, 8) = (/ & + & 0.85569e-10_r8,0.92775e-10_r8,0.10011e-09_r8,0.10818e-09_r8,0.11665e-09_r8 /) + kbo(:,52, 8) = (/ & + & 0.69342e-10_r8,0.75341e-10_r8,0.81596e-10_r8,0.88527e-10_r8,0.95876e-10_r8 /) + kbo(:,53, 8) = (/ & + & 0.56003e-10_r8,0.61203e-10_r8,0.66389e-10_r8,0.72376e-10_r8,0.78642e-10_r8 /) + kbo(:,54, 8) = (/ & + & 0.45380e-10_r8,0.49599e-10_r8,0.54006e-10_r8,0.59069e-10_r8,0.64380e-10_r8 /) + kbo(:,55, 8) = (/ & + & 0.36637e-10_r8,0.40078e-10_r8,0.43990e-10_r8,0.48279e-10_r8,0.52815e-10_r8 /) + kbo(:,56, 8) = (/ & + & 0.29596e-10_r8,0.32455e-10_r8,0.35694e-10_r8,0.39315e-10_r8,0.43169e-10_r8 /) + kbo(:,57, 8) = (/ & + & 0.23911e-10_r8,0.26268e-10_r8,0.28916e-10_r8,0.31929e-10_r8,0.35182e-10_r8 /) + kbo(:,58, 8) = (/ & + & 0.19299e-10_r8,0.21198e-10_r8,0.23407e-10_r8,0.25936e-10_r8,0.28689e-10_r8 /) + kbo(:,59, 8) = (/ & + & 0.15839e-10_r8,0.17448e-10_r8,0.19334e-10_r8,0.21469e-10_r8,0.23829e-10_r8 /) + kbo(:,13, 9) = (/ & + & 0.96471e-06_r8,0.97408e-06_r8,0.98436e-06_r8,0.99439e-06_r8,0.10050e-05_r8 /) + kbo(:,14, 9) = (/ & + & 0.80904e-06_r8,0.81838e-06_r8,0.82742e-06_r8,0.83703e-06_r8,0.84742e-06_r8 /) + kbo(:,15, 9) = (/ & + & 0.67733e-06_r8,0.68563e-06_r8,0.69403e-06_r8,0.70345e-06_r8,0.71287e-06_r8 /) + kbo(:,16, 9) = (/ & + & 0.56582e-06_r8,0.57313e-06_r8,0.58159e-06_r8,0.59012e-06_r8,0.59880e-06_r8 /) + kbo(:,17, 9) = (/ & + & 0.47164e-06_r8,0.47892e-06_r8,0.48671e-06_r8,0.49436e-06_r8,0.50258e-06_r8 /) + kbo(:,18, 9) = (/ & + & 0.39308e-06_r8,0.39992e-06_r8,0.40685e-06_r8,0.41415e-06_r8,0.42143e-06_r8 /) + kbo(:,19, 9) = (/ & + & 0.32764e-06_r8,0.33370e-06_r8,0.34000e-06_r8,0.34660e-06_r8,0.35294e-06_r8 /) + kbo(:,20, 9) = (/ & + & 0.27304e-06_r8,0.27855e-06_r8,0.28433e-06_r8,0.29002e-06_r8,0.29550e-06_r8 /) + kbo(:,21, 9) = (/ & + & 0.22762e-06_r8,0.23263e-06_r8,0.23776e-06_r8,0.24264e-06_r8,0.24751e-06_r8 /) + kbo(:,22, 9) = (/ & + & 0.19016e-06_r8,0.19467e-06_r8,0.19902e-06_r8,0.20331e-06_r8,0.20743e-06_r8 /) + kbo(:,23, 9) = (/ & + & 0.15902e-06_r8,0.16285e-06_r8,0.16664e-06_r8,0.17032e-06_r8,0.17381e-06_r8 /) + kbo(:,24, 9) = (/ & + & 0.13300e-06_r8,0.13639e-06_r8,0.13965e-06_r8,0.14271e-06_r8,0.14575e-06_r8 /) + kbo(:,25, 9) = (/ & + & 0.11136e-06_r8,0.11428e-06_r8,0.11705e-06_r8,0.11966e-06_r8,0.12234e-06_r8 /) + kbo(:,26, 9) = (/ & + & 0.93355e-07_r8,0.95870e-07_r8,0.98179e-07_r8,0.10046e-06_r8,0.10295e-06_r8 /) + kbo(:,27, 9) = (/ & + & 0.78546e-07_r8,0.80656e-07_r8,0.82694e-07_r8,0.84793e-07_r8,0.87129e-07_r8 /) + kbo(:,28, 9) = (/ & + & 0.65991e-07_r8,0.67786e-07_r8,0.69602e-07_r8,0.71624e-07_r8,0.74063e-07_r8 /) + kbo(:,29, 9) = (/ & + & 0.55459e-07_r8,0.56995e-07_r8,0.58695e-07_r8,0.60741e-07_r8,0.63281e-07_r8 /) + kbo(:,30, 9) = (/ & + & 0.46750e-07_r8,0.48054e-07_r8,0.49703e-07_r8,0.51793e-07_r8,0.54403e-07_r8 /) + kbo(:,31, 9) = (/ & + & 0.39452e-07_r8,0.40727e-07_r8,0.42319e-07_r8,0.44486e-07_r8,0.47323e-07_r8 /) + kbo(:,32, 9) = (/ & + & 0.33473e-07_r8,0.34884e-07_r8,0.36502e-07_r8,0.38781e-07_r8,0.41735e-07_r8 /) + kbo(:,33, 9) = (/ & + & 0.28581e-07_r8,0.30008e-07_r8,0.31748e-07_r8,0.34217e-07_r8,0.37511e-07_r8 /) + kbo(:,34, 9) = (/ & + & 0.24450e-07_r8,0.25951e-07_r8,0.27867e-07_r8,0.30565e-07_r8,0.34125e-07_r8 /) + kbo(:,35, 9) = (/ & + & 0.20942e-07_r8,0.22554e-07_r8,0.24574e-07_r8,0.27409e-07_r8,0.31159e-07_r8 /) + kbo(:,36, 9) = (/ & + & 0.18081e-07_r8,0.19648e-07_r8,0.21657e-07_r8,0.24573e-07_r8,0.28429e-07_r8 /) + kbo(:,37, 9) = (/ & + & 0.15436e-07_r8,0.16978e-07_r8,0.19037e-07_r8,0.21710e-07_r8,0.25509e-07_r8 /) + kbo(:,38, 9) = (/ & + & 0.13187e-07_r8,0.14690e-07_r8,0.16738e-07_r8,0.19257e-07_r8,0.22992e-07_r8 /) + kbo(:,39, 9) = (/ & + & 0.11282e-07_r8,0.12751e-07_r8,0.14794e-07_r8,0.17292e-07_r8,0.20852e-07_r8 /) + kbo(:,40, 9) = (/ & + & 0.96293e-08_r8,0.10973e-07_r8,0.12917e-07_r8,0.15272e-07_r8,0.18582e-07_r8 /) + kbo(:,41, 9) = (/ & + & 0.81770e-08_r8,0.94352e-08_r8,0.11220e-07_r8,0.13516e-07_r8,0.16546e-07_r8 /) + kbo(:,42, 9) = (/ & + & 0.69323e-08_r8,0.80750e-08_r8,0.97479e-08_r8,0.11964e-07_r8,0.14736e-07_r8 /) + kbo(:,43, 9) = (/ & + & 0.58312e-08_r8,0.68571e-08_r8,0.83595e-08_r8,0.10414e-07_r8,0.12928e-07_r8 /) + kbo(:,44, 9) = (/ & + & 0.48754e-08_r8,0.58128e-08_r8,0.71504e-08_r8,0.90270e-08_r8,0.11362e-07_r8 /) + kbo(:,45, 9) = (/ & + & 0.40522e-08_r8,0.48841e-08_r8,0.60765e-08_r8,0.77697e-08_r8,0.99439e-08_r8 /) + kbo(:,46, 9) = (/ & + & 0.33429e-08_r8,0.40820e-08_r8,0.51038e-08_r8,0.66237e-08_r8,0.86427e-08_r8 /) + kbo(:,47, 9) = (/ & + & 0.27297e-08_r8,0.33571e-08_r8,0.42806e-08_r8,0.55863e-08_r8,0.73605e-08_r8 /) + kbo(:,48, 9) = (/ & + & 0.22143e-08_r8,0.27445e-08_r8,0.35414e-08_r8,0.46711e-08_r8,0.62204e-08_r8 /) + kbo(:,49, 9) = (/ & + & 0.18030e-08_r8,0.22208e-08_r8,0.28995e-08_r8,0.38639e-08_r8,0.52216e-08_r8 /) + kbo(:,50, 9) = (/ & + & 0.14670e-08_r8,0.18085e-08_r8,0.23853e-08_r8,0.32522e-08_r8,0.44284e-08_r8 /) + kbo(:,51, 9) = (/ & + & 0.11873e-08_r8,0.14637e-08_r8,0.19592e-08_r8,0.27073e-08_r8,0.37306e-08_r8 /) + kbo(:,52, 9) = (/ & + & 0.96876e-09_r8,0.11883e-08_r8,0.15881e-08_r8,0.22316e-08_r8,0.31252e-08_r8 /) + kbo(:,53, 9) = (/ & + & 0.79526e-09_r8,0.95443e-09_r8,0.12843e-08_r8,0.18180e-08_r8,0.25992e-08_r8 /) + kbo(:,54, 9) = (/ & + & 0.65045e-09_r8,0.77197e-09_r8,0.10500e-08_r8,0.14963e-08_r8,0.21953e-08_r8 /) + kbo(:,55, 9) = (/ & + & 0.53001e-09_r8,0.62144e-09_r8,0.84441e-09_r8,0.12265e-08_r8,0.18415e-08_r8 /) + kbo(:,56, 9) = (/ & + & 0.43274e-09_r8,0.50433e-09_r8,0.67633e-09_r8,0.10051e-08_r8,0.15294e-08_r8 /) + kbo(:,57, 9) = (/ & + & 0.35151e-09_r8,0.40652e-09_r8,0.53819e-09_r8,0.80840e-09_r8,0.12530e-08_r8 /) + kbo(:,58, 9) = (/ & + & 0.28511e-09_r8,0.33047e-09_r8,0.42809e-09_r8,0.65584e-09_r8,0.10383e-08_r8 /) + kbo(:,59, 9) = (/ & + & 0.23557e-09_r8,0.27695e-09_r8,0.36588e-09_r8,0.57468e-09_r8,0.92796e-09_r8 /) + kbo(:,13,10) = (/ & + & 0.49379e-05_r8,0.50469e-05_r8,0.51595e-05_r8,0.52778e-05_r8,0.54099e-05_r8 /) + kbo(:,14,10) = (/ & + & 0.42812e-05_r8,0.43888e-05_r8,0.45022e-05_r8,0.46302e-05_r8,0.47669e-05_r8 /) + kbo(:,15,10) = (/ & + & 0.36929e-05_r8,0.37965e-05_r8,0.39164e-05_r8,0.40454e-05_r8,0.41827e-05_r8 /) + kbo(:,16,10) = (/ & + & 0.31721e-05_r8,0.32791e-05_r8,0.33975e-05_r8,0.35246e-05_r8,0.36634e-05_r8 /) + kbo(:,17,10) = (/ & + & 0.27212e-05_r8,0.28264e-05_r8,0.29414e-05_r8,0.30666e-05_r8,0.32085e-05_r8 /) + kbo(:,18,10) = (/ & + & 0.23339e-05_r8,0.24330e-05_r8,0.25438e-05_r8,0.26711e-05_r8,0.28184e-05_r8 /) + kbo(:,19,10) = (/ & + & 0.19987e-05_r8,0.20932e-05_r8,0.22036e-05_r8,0.23332e-05_r8,0.24834e-05_r8 /) + kbo(:,20,10) = (/ & + & 0.17132e-05_r8,0.18061e-05_r8,0.19176e-05_r8,0.20491e-05_r8,0.21989e-05_r8 /) + kbo(:,21,10) = (/ & + & 0.14710e-05_r8,0.15640e-05_r8,0.16759e-05_r8,0.18061e-05_r8,0.19600e-05_r8 /) + kbo(:,22,10) = (/ & + & 0.12737e-05_r8,0.13668e-05_r8,0.14788e-05_r8,0.16132e-05_r8,0.17763e-05_r8 /) + kbo(:,23,10) = (/ & + & 0.11088e-05_r8,0.12015e-05_r8,0.13166e-05_r8,0.14583e-05_r8,0.16304e-05_r8 /) + kbo(:,24,10) = (/ & + & 0.97145e-06_r8,0.10662e-05_r8,0.11867e-05_r8,0.13370e-05_r8,0.15170e-05_r8 /) + kbo(:,25,10) = (/ & + & 0.85857e-06_r8,0.95791e-06_r8,0.10855e-05_r8,0.12438e-05_r8,0.14327e-05_r8 /) + kbo(:,26,10) = (/ & + & 0.76914e-06_r8,0.87488e-06_r8,0.10107e-05_r8,0.11782e-05_r8,0.13762e-05_r8 /) + kbo(:,27,10) = (/ & + & 0.69709e-06_r8,0.81000e-06_r8,0.95427e-06_r8,0.11311e-05_r8,0.13395e-05_r8 /) + kbo(:,28,10) = (/ & + & 0.64352e-06_r8,0.76453e-06_r8,0.91846e-06_r8,0.11047e-05_r8,0.13225e-05_r8 /) + kbo(:,29,10) = (/ & + & 0.60601e-06_r8,0.73668e-06_r8,0.90033e-06_r8,0.10967e-05_r8,0.13241e-05_r8 /) + kbo(:,30,10) = (/ & + & 0.58144e-06_r8,0.72277e-06_r8,0.89681e-06_r8,0.11031e-05_r8,0.13400e-05_r8 /) + kbo(:,31,10) = (/ & + & 0.57013e-06_r8,0.72161e-06_r8,0.90691e-06_r8,0.11230e-05_r8,0.13684e-05_r8 /) + kbo(:,32,10) = (/ & + & 0.57021e-06_r8,0.73098e-06_r8,0.92629e-06_r8,0.11521e-05_r8,0.14071e-05_r8 /) + kbo(:,33,10) = (/ & + & 0.58025e-06_r8,0.75106e-06_r8,0.95601e-06_r8,0.11909e-05_r8,0.14530e-05_r8 /) + kbo(:,34,10) = (/ & + & 0.59352e-06_r8,0.77298e-06_r8,0.98581e-06_r8,0.12280e-05_r8,0.14964e-05_r8 /) + kbo(:,35,10) = (/ & + & 0.59731e-06_r8,0.78147e-06_r8,0.99919e-06_r8,0.12457e-05_r8,0.15176e-05_r8 /) + kbo(:,36,10) = (/ & + & 0.58516e-06_r8,0.77138e-06_r8,0.99076e-06_r8,0.12378e-05_r8,0.15105e-05_r8 /) + kbo(:,37,10) = (/ & + & 0.55140e-06_r8,0.73346e-06_r8,0.94817e-06_r8,0.11937e-05_r8,0.14631e-05_r8 /) + kbo(:,38,10) = (/ & + & 0.51916e-06_r8,0.69705e-06_r8,0.90723e-06_r8,0.11496e-05_r8,0.14156e-05_r8 /) + kbo(:,39,10) = (/ & + & 0.48960e-06_r8,0.66318e-06_r8,0.86863e-06_r8,0.11068e-05_r8,0.13701e-05_r8 /) + kbo(:,40,10) = (/ & + & 0.44595e-06_r8,0.61209e-06_r8,0.81011e-06_r8,0.10412e-05_r8,0.12987e-05_r8 /) + kbo(:,41,10) = (/ & + & 0.40399e-06_r8,0.56185e-06_r8,0.75199e-06_r8,0.97449e-06_r8,0.12265e-05_r8 /) + kbo(:,42,10) = (/ & + & 0.36503e-06_r8,0.51494e-06_r8,0.69685e-06_r8,0.91108e-06_r8,0.11565e-05_r8 /) + kbo(:,43,10) = (/ & + & 0.32174e-06_r8,0.46170e-06_r8,0.63377e-06_r8,0.83820e-06_r8,0.10749e-05_r8 /) + kbo(:,44,10) = (/ & + & 0.27930e-06_r8,0.40829e-06_r8,0.56968e-06_r8,0.76331e-06_r8,0.98961e-06_r8 /) + kbo(:,45,10) = (/ & + & 0.24096e-06_r8,0.35938e-06_r8,0.50997e-06_r8,0.69291e-06_r8,0.90837e-06_r8 /) + kbo(:,46,10) = (/ & + & 0.20431e-06_r8,0.31166e-06_r8,0.45096e-06_r8,0.62224e-06_r8,0.82595e-06_r8 /) + kbo(:,47,10) = (/ & + & 0.16816e-06_r8,0.26359e-06_r8,0.38972e-06_r8,0.54827e-06_r8,0.73938e-06_r8 /) + kbo(:,48,10) = (/ & + & 0.13670e-06_r8,0.22070e-06_r8,0.33435e-06_r8,0.47996e-06_r8,0.65830e-06_r8 /) + kbo(:,49,10) = (/ & + & 0.10953e-06_r8,0.18282e-06_r8,0.28430e-06_r8,0.41725e-06_r8,0.58243e-06_r8 /) + kbo(:,50,10) = (/ & + & 0.88267e-07_r8,0.15143e-06_r8,0.24199e-06_r8,0.36271e-06_r8,0.51595e-06_r8 /) + kbo(:,51,10) = (/ & + & 0.70298e-07_r8,0.12484e-06_r8,0.20511e-06_r8,0.31462e-06_r8,0.45605e-06_r8 /) + kbo(:,52,10) = (/ & + & 0.55131e-07_r8,0.10217e-06_r8,0.17234e-06_r8,0.27088e-06_r8,0.40072e-06_r8 /) + kbo(:,53,10) = (/ & + & 0.43153e-07_r8,0.82195e-07_r8,0.14318e-06_r8,0.23139e-06_r8,0.34955e-06_r8 /) + kbo(:,54,10) = (/ & + & 0.33903e-07_r8,0.66466e-07_r8,0.12020e-06_r8,0.19856e-06_r8,0.30630e-06_r8 /) + kbo(:,55,10) = (/ & + & 0.26416e-07_r8,0.53605e-07_r8,0.10034e-06_r8,0.17017e-06_r8,0.26833e-06_r8 /) + kbo(:,56,10) = (/ & + & 0.20206e-07_r8,0.42611e-07_r8,0.82928e-07_r8,0.14532e-06_r8,0.23365e-06_r8 /) + kbo(:,57,10) = (/ & + & 0.15310e-07_r8,0.33413e-07_r8,0.67820e-07_r8,0.12262e-06_r8,0.20213e-06_r8 /) + kbo(:,58,10) = (/ & + & 0.11722e-07_r8,0.26420e-07_r8,0.55414e-07_r8,0.10347e-06_r8,0.17567e-06_r8 /) + kbo(:,59,10) = (/ & + & 0.10312e-07_r8,0.23851e-07_r8,0.50918e-07_r8,0.96421e-07_r8,0.16547e-06_r8 /) + kbo(:,13,11) = (/ & + & 0.10213e-04_r8,0.10492e-04_r8,0.10768e-04_r8,0.11052e-04_r8,0.11341e-04_r8 /) + kbo(:,14,11) = (/ & + & 0.92065e-05_r8,0.95170e-05_r8,0.98374e-05_r8,0.10166e-04_r8,0.10515e-04_r8 /) + kbo(:,15,11) = (/ & + & 0.82447e-05_r8,0.85845e-05_r8,0.89388e-05_r8,0.93243e-05_r8,0.97313e-05_r8 /) + kbo(:,16,11) = (/ & + & 0.73562e-05_r8,0.77204e-05_r8,0.81177e-05_r8,0.85472e-05_r8,0.89941e-05_r8 /) + kbo(:,17,11) = (/ & + & 0.65534e-05_r8,0.69440e-05_r8,0.73753e-05_r8,0.78408e-05_r8,0.83202e-05_r8 /) + kbo(:,18,11) = (/ & + & 0.58421e-05_r8,0.62603e-05_r8,0.67231e-05_r8,0.72105e-05_r8,0.77276e-05_r8 /) + kbo(:,19,11) = (/ & + & 0.52249e-05_r8,0.56681e-05_r8,0.61484e-05_r8,0.66668e-05_r8,0.72285e-05_r8 /) + kbo(:,20,11) = (/ & + & 0.47032e-05_r8,0.51617e-05_r8,0.56660e-05_r8,0.62226e-05_r8,0.68302e-05_r8 /) + kbo(:,21,11) = (/ & + & 0.42601e-05_r8,0.47338e-05_r8,0.52698e-05_r8,0.58670e-05_r8,0.65065e-05_r8 /) + kbo(:,22,11) = (/ & + & 0.39167e-05_r8,0.44205e-05_r8,0.49953e-05_r8,0.56267e-05_r8,0.62956e-05_r8 /) + kbo(:,23,11) = (/ & + & 0.36499e-05_r8,0.41883e-05_r8,0.47965e-05_r8,0.54568e-05_r8,0.61529e-05_r8 /) + kbo(:,24,11) = (/ & + & 0.34565e-05_r8,0.40283e-05_r8,0.46653e-05_r8,0.53526e-05_r8,0.60723e-05_r8 /) + kbo(:,25,11) = (/ & + & 0.33292e-05_r8,0.39315e-05_r8,0.45958e-05_r8,0.53082e-05_r8,0.60473e-05_r8 /) + kbo(:,26,11) = (/ & + & 0.32653e-05_r8,0.38970e-05_r8,0.45879e-05_r8,0.53204e-05_r8,0.60776e-05_r8 /) + kbo(:,27,11) = (/ & + & 0.32497e-05_r8,0.39083e-05_r8,0.46221e-05_r8,0.53722e-05_r8,0.61437e-05_r8 /) + kbo(:,28,11) = (/ & + & 0.32741e-05_r8,0.39580e-05_r8,0.46902e-05_r8,0.54541e-05_r8,0.62354e-05_r8 /) + kbo(:,29,11) = (/ & + & 0.33369e-05_r8,0.40429e-05_r8,0.47902e-05_r8,0.55664e-05_r8,0.63553e-05_r8 /) + kbo(:,30,11) = (/ & + & 0.34283e-05_r8,0.41504e-05_r8,0.49124e-05_r8,0.56972e-05_r8,0.64922e-05_r8 /) + kbo(:,31,11) = (/ & + & 0.35444e-05_r8,0.42823e-05_r8,0.50547e-05_r8,0.58477e-05_r8,0.66477e-05_r8 /) + kbo(:,32,11) = (/ & + & 0.36801e-05_r8,0.44317e-05_r8,0.52138e-05_r8,0.60136e-05_r8,0.68176e-05_r8 /) + kbo(:,33,11) = (/ & + & 0.38318e-05_r8,0.45951e-05_r8,0.53855e-05_r8,0.61901e-05_r8,0.69963e-05_r8 /) + kbo(:,34,11) = (/ & + & 0.39692e-05_r8,0.47416e-05_r8,0.55387e-05_r8,0.63463e-05_r8,0.71529e-05_r8 /) + kbo(:,35,11) = (/ & + & 0.40413e-05_r8,0.48197e-05_r8,0.56200e-05_r8,0.64302e-05_r8,0.72378e-05_r8 /) + kbo(:,36,11) = (/ & + & 0.40356e-05_r8,0.48162e-05_r8,0.56178e-05_r8,0.64290e-05_r8,0.72385e-05_r8 /) + kbo(:,37,11) = (/ & + & 0.39181e-05_r8,0.46953e-05_r8,0.54967e-05_r8,0.63083e-05_r8,0.71198e-05_r8 /) + kbo(:,38,11) = (/ & + & 0.37977e-05_r8,0.45715e-05_r8,0.53704e-05_r8,0.61820e-05_r8,0.69964e-05_r8 /) + kbo(:,39,11) = (/ & + & 0.36811e-05_r8,0.44507e-05_r8,0.52481e-05_r8,0.60593e-05_r8,0.68739e-05_r8 /) + kbo(:,40,11) = (/ & + & 0.34909e-05_r8,0.42522e-05_r8,0.50444e-05_r8,0.58543e-05_r8,0.66697e-05_r8 /) + kbo(:,41,11) = (/ & + & 0.32953e-05_r8,0.40465e-05_r8,0.48326e-05_r8,0.56401e-05_r8,0.64551e-05_r8 /) + kbo(:,42,11) = (/ & + & 0.31040e-05_r8,0.38444e-05_r8,0.46230e-05_r8,0.54267e-05_r8,0.62419e-05_r8 /) + kbo(:,43,11) = (/ & + & 0.28773e-05_r8,0.36028e-05_r8,0.43716e-05_r8,0.51693e-05_r8,0.59825e-05_r8 /) + kbo(:,44,11) = (/ & + & 0.26404e-05_r8,0.33480e-05_r8,0.41036e-05_r8,0.48939e-05_r8,0.57034e-05_r8 /) + kbo(:,45,11) = (/ & + & 0.24120e-05_r8,0.30991e-05_r8,0.38405e-05_r8,0.46208e-05_r8,0.54260e-05_r8 /) + kbo(:,46,11) = (/ & + & 0.21786e-05_r8,0.28418e-05_r8,0.35659e-05_r8,0.43343e-05_r8,0.51318e-05_r8 /) + kbo(:,47,11) = (/ & + & 0.19311e-05_r8,0.25641e-05_r8,0.32660e-05_r8,0.40180e-05_r8,0.48060e-05_r8 /) + kbo(:,48,11) = (/ & + & 0.16967e-05_r8,0.22980e-05_r8,0.29746e-05_r8,0.37093e-05_r8,0.44842e-05_r8 /) + kbo(:,49,11) = (/ & + & 0.14774e-05_r8,0.20448e-05_r8,0.26926e-05_r8,0.34064e-05_r8,0.41668e-05_r8 /) + kbo(:,50,11) = (/ & + & 0.12873e-05_r8,0.18193e-05_r8,0.24384e-05_r8,0.31296e-05_r8,0.38742e-05_r8 /) + kbo(:,51,11) = (/ & + & 0.11146e-05_r8,0.16126e-05_r8,0.22020e-05_r8,0.28686e-05_r8,0.35959e-05_r8 /) + kbo(:,52,11) = (/ & + & 0.95604e-06_r8,0.14200e-05_r8,0.19761e-05_r8,0.26163e-05_r8,0.33236e-05_r8 /) + kbo(:,53,11) = (/ & + & 0.80966e-06_r8,0.12381e-05_r8,0.17610e-05_r8,0.23732e-05_r8,0.30580e-05_r8 /) + kbo(:,54,11) = (/ & + & 0.68766e-06_r8,0.10830e-05_r8,0.15763e-05_r8,0.21583e-05_r8,0.28207e-05_r8 /) + kbo(:,55,11) = (/ & + & 0.58212e-06_r8,0.94518e-06_r8,0.14071e-05_r8,0.19616e-05_r8,0.26001e-05_r8 /) + kbo(:,56,11) = (/ & + & 0.48769e-06_r8,0.81784e-06_r8,0.12480e-05_r8,0.17754e-05_r8,0.23872e-05_r8 /) + kbo(:,57,11) = (/ & + & 0.40334e-06_r8,0.70099e-06_r8,0.10993e-05_r8,0.15960e-05_r8,0.21818e-05_r8 /) + kbo(:,58,11) = (/ & + & 0.33254e-06_r8,0.59979e-06_r8,0.96749e-06_r8,0.14348e-05_r8,0.19961e-05_r8 /) + kbo(:,59,11) = (/ & + & 0.30667e-06_r8,0.56182e-06_r8,0.91722e-06_r8,0.13728e-05_r8,0.19233e-05_r8 /) + kbo(:,13,12) = (/ & + & 0.21780e-04_r8,0.22297e-04_r8,0.22851e-04_r8,0.23387e-04_r8,0.23897e-04_r8 /) + kbo(:,14,12) = (/ & + & 0.20875e-04_r8,0.21531e-04_r8,0.22189e-04_r8,0.22823e-04_r8,0.23424e-04_r8 /) + kbo(:,15,12) = (/ & + & 0.19941e-04_r8,0.20728e-04_r8,0.21492e-04_r8,0.22225e-04_r8,0.22948e-04_r8 /) + kbo(:,16,12) = (/ & + & 0.19013e-04_r8,0.19918e-04_r8,0.20796e-04_r8,0.21654e-04_r8,0.22503e-04_r8 /) + kbo(:,17,12) = (/ & + & 0.18129e-04_r8,0.19150e-04_r8,0.20149e-04_r8,0.21144e-04_r8,0.22094e-04_r8 /) + kbo(:,18,12) = (/ & + & 0.17308e-04_r8,0.18451e-04_r8,0.19578e-04_r8,0.20689e-04_r8,0.21728e-04_r8 /) + kbo(:,19,12) = (/ & + & 0.16581e-04_r8,0.17835e-04_r8,0.19087e-04_r8,0.20285e-04_r8,0.21402e-04_r8 /) + kbo(:,20,12) = (/ & + & 0.15978e-04_r8,0.17349e-04_r8,0.18704e-04_r8,0.19972e-04_r8,0.21143e-04_r8 /) + kbo(:,21,12) = (/ & + & 0.15496e-04_r8,0.16976e-04_r8,0.18403e-04_r8,0.19724e-04_r8,0.20952e-04_r8 /) + kbo(:,22,12) = (/ & + & 0.15240e-04_r8,0.16798e-04_r8,0.18272e-04_r8,0.19635e-04_r8,0.20901e-04_r8 /) + kbo(:,23,12) = (/ & + & 0.15105e-04_r8,0.16716e-04_r8,0.18220e-04_r8,0.19617e-04_r8,0.20916e-04_r8 /) + kbo(:,24,12) = (/ & + & 0.15076e-04_r8,0.16719e-04_r8,0.18249e-04_r8,0.19672e-04_r8,0.20991e-04_r8 /) + kbo(:,25,12) = (/ & + & 0.15141e-04_r8,0.16802e-04_r8,0.18352e-04_r8,0.19786e-04_r8,0.21116e-04_r8 /) + kbo(:,26,12) = (/ & + & 0.15306e-04_r8,0.16974e-04_r8,0.18529e-04_r8,0.19965e-04_r8,0.21296e-04_r8 /) + kbo(:,27,12) = (/ & + & 0.15522e-04_r8,0.17192e-04_r8,0.18747e-04_r8,0.20182e-04_r8,0.21501e-04_r8 /) + kbo(:,28,12) = (/ & + & 0.15784e-04_r8,0.17449e-04_r8,0.18996e-04_r8,0.20419e-04_r8,0.21733e-04_r8 /) + kbo(:,29,12) = (/ & + & 0.16090e-04_r8,0.17744e-04_r8,0.19276e-04_r8,0.20687e-04_r8,0.21987e-04_r8 /) + kbo(:,30,12) = (/ & + & 0.16419e-04_r8,0.18062e-04_r8,0.19575e-04_r8,0.20970e-04_r8,0.22248e-04_r8 /) + kbo(:,31,12) = (/ & + & 0.16777e-04_r8,0.18399e-04_r8,0.19892e-04_r8,0.21268e-04_r8,0.22521e-04_r8 /) + kbo(:,32,12) = (/ & + & 0.17152e-04_r8,0.18750e-04_r8,0.20222e-04_r8,0.21573e-04_r8,0.22802e-04_r8 /) + kbo(:,33,12) = (/ & + & 0.17537e-04_r8,0.19109e-04_r8,0.20556e-04_r8,0.21883e-04_r8,0.23082e-04_r8 /) + kbo(:,34,12) = (/ & + & 0.17871e-04_r8,0.19418e-04_r8,0.20844e-04_r8,0.22147e-04_r8,0.23322e-04_r8 /) + kbo(:,35,12) = (/ & + & 0.18052e-04_r8,0.19587e-04_r8,0.21002e-04_r8,0.22291e-04_r8,0.23455e-04_r8 /) + kbo(:,36,12) = (/ & + & 0.18063e-04_r8,0.19601e-04_r8,0.21016e-04_r8,0.22306e-04_r8,0.23468e-04_r8 /) + kbo(:,37,12) = (/ & + & 0.17833e-04_r8,0.19389e-04_r8,0.20824e-04_r8,0.22132e-04_r8,0.23314e-04_r8 /) + kbo(:,38,12) = (/ & + & 0.17587e-04_r8,0.19167e-04_r8,0.20623e-04_r8,0.21950e-04_r8,0.23152e-04_r8 /) + kbo(:,39,12) = (/ & + & 0.17343e-04_r8,0.18945e-04_r8,0.20418e-04_r8,0.21765e-04_r8,0.22984e-04_r8 /) + kbo(:,40,12) = (/ & + & 0.16926e-04_r8,0.18563e-04_r8,0.20065e-04_r8,0.21446e-04_r8,0.22697e-04_r8 /) + kbo(:,41,12) = (/ & + & 0.16478e-04_r8,0.18152e-04_r8,0.19687e-04_r8,0.21101e-04_r8,0.22388e-04_r8 /) + kbo(:,42,12) = (/ & + & 0.16023e-04_r8,0.17729e-04_r8,0.19301e-04_r8,0.20748e-04_r8,0.22068e-04_r8 /) + kbo(:,43,12) = (/ & + & 0.15458e-04_r8,0.17203e-04_r8,0.18821e-04_r8,0.20305e-04_r8,0.21667e-04_r8 /) + kbo(:,44,12) = (/ & + & 0.14831e-04_r8,0.16623e-04_r8,0.18287e-04_r8,0.19814e-04_r8,0.21219e-04_r8 /) + kbo(:,45,12) = (/ & + & 0.14192e-04_r8,0.16029e-04_r8,0.17735e-04_r8,0.19308e-04_r8,0.20757e-04_r8 /) + kbo(:,46,12) = (/ & + & 0.13493e-04_r8,0.15380e-04_r8,0.17134e-04_r8,0.18756e-04_r8,0.20247e-04_r8 /) + kbo(:,47,12) = (/ & + & 0.12693e-04_r8,0.14634e-04_r8,0.16440e-04_r8,0.18118e-04_r8,0.19661e-04_r8 /) + kbo(:,48,12) = (/ & + & 0.11878e-04_r8,0.13868e-04_r8,0.15729e-04_r8,0.17458e-04_r8,0.19054e-04_r8 /) + kbo(:,49,12) = (/ & + & 0.11052e-04_r8,0.13077e-04_r8,0.14993e-04_r8,0.16776e-04_r8,0.18429e-04_r8 /) + kbo(:,50,12) = (/ & + & 0.10274e-04_r8,0.12322e-04_r8,0.14286e-04_r8,0.16119e-04_r8,0.17820e-04_r8 /) + kbo(:,51,12) = (/ & + & 0.95165e-05_r8,0.11577e-04_r8,0.13581e-04_r8,0.15463e-04_r8,0.17211e-04_r8 /) + kbo(:,52,12) = (/ & + & 0.87654e-05_r8,0.10825e-04_r8,0.12859e-04_r8,0.14791e-04_r8,0.16589e-04_r8 /) + kbo(:,53,12) = (/ & + & 0.80213e-05_r8,0.10071e-04_r8,0.12124e-04_r8,0.14102e-04_r8,0.15949e-04_r8 /) + kbo(:,54,12) = (/ & + & 0.73473e-05_r8,0.93776e-05_r8,0.11439e-04_r8,0.13452e-04_r8,0.15344e-04_r8 /) + kbo(:,55,12) = (/ & + & 0.67127e-05_r8,0.87188e-05_r8,0.10780e-04_r8,0.12816e-04_r8,0.14751e-04_r8 /) + kbo(:,56,12) = (/ & + & 0.60935e-05_r8,0.80668e-05_r8,0.10118e-04_r8,0.12169e-04_r8,0.14148e-04_r8 /) + kbo(:,57,12) = (/ & + & 0.54908e-05_r8,0.74223e-05_r8,0.94571e-05_r8,0.11517e-04_r8,0.13528e-04_r8 /) + kbo(:,58,12) = (/ & + & 0.49372e-05_r8,0.68201e-05_r8,0.88324e-05_r8,0.10894e-04_r8,0.12926e-04_r8 /) + kbo(:,59,12) = (/ & + & 0.47213e-05_r8,0.65842e-05_r8,0.85835e-05_r8,0.10644e-04_r8,0.12683e-04_r8 /) + kbo(:,13,13) = (/ & + & 0.46820e-04_r8,0.47158e-04_r8,0.47420e-04_r8,0.47688e-04_r8,0.47860e-04_r8 /) + kbo(:,14,13) = (/ & + & 0.47343e-04_r8,0.47824e-04_r8,0.48275e-04_r8,0.48677e-04_r8,0.48937e-04_r8 /) + kbo(:,15,13) = (/ & + & 0.47643e-04_r8,0.48345e-04_r8,0.48980e-04_r8,0.49469e-04_r8,0.49813e-04_r8 /) + kbo(:,16,13) = (/ & + & 0.47844e-04_r8,0.48762e-04_r8,0.49536e-04_r8,0.50120e-04_r8,0.50548e-04_r8 /) + kbo(:,17,13) = (/ & + & 0.47956e-04_r8,0.49079e-04_r8,0.49982e-04_r8,0.50640e-04_r8,0.51155e-04_r8 /) + kbo(:,18,13) = (/ & + & 0.48046e-04_r8,0.49334e-04_r8,0.50343e-04_r8,0.51068e-04_r8,0.51673e-04_r8 /) + kbo(:,19,13) = (/ & + & 0.48132e-04_r8,0.49550e-04_r8,0.50630e-04_r8,0.51453e-04_r8,0.52124e-04_r8 /) + kbo(:,20,13) = (/ & + & 0.48262e-04_r8,0.49765e-04_r8,0.50907e-04_r8,0.51808e-04_r8,0.52533e-04_r8 /) + kbo(:,21,13) = (/ & + & 0.48402e-04_r8,0.49959e-04_r8,0.51170e-04_r8,0.52136e-04_r8,0.52894e-04_r8 /) + kbo(:,22,13) = (/ & + & 0.48671e-04_r8,0.50243e-04_r8,0.51485e-04_r8,0.52481e-04_r8,0.53256e-04_r8 /) + kbo(:,23,13) = (/ & + & 0.48954e-04_r8,0.50544e-04_r8,0.51806e-04_r8,0.52811e-04_r8,0.53587e-04_r8 /) + kbo(:,24,13) = (/ & + & 0.49272e-04_r8,0.50858e-04_r8,0.52128e-04_r8,0.53125e-04_r8,0.53892e-04_r8 /) + kbo(:,25,13) = (/ & + & 0.49616e-04_r8,0.51186e-04_r8,0.52450e-04_r8,0.53425e-04_r8,0.54174e-04_r8 /) + kbo(:,26,13) = (/ & + & 0.50001e-04_r8,0.51551e-04_r8,0.52773e-04_r8,0.53723e-04_r8,0.54445e-04_r8 /) + kbo(:,27,13) = (/ & + & 0.50406e-04_r8,0.51904e-04_r8,0.53086e-04_r8,0.54001e-04_r8,0.54687e-04_r8 /) + kbo(:,28,13) = (/ & + & 0.50802e-04_r8,0.52248e-04_r8,0.53391e-04_r8,0.54260e-04_r8,0.54906e-04_r8 /) + kbo(:,29,13) = (/ & + & 0.51204e-04_r8,0.52593e-04_r8,0.53683e-04_r8,0.54507e-04_r8,0.55109e-04_r8 /) + kbo(:,30,13) = (/ & + & 0.51608e-04_r8,0.52928e-04_r8,0.53956e-04_r8,0.54730e-04_r8,0.55285e-04_r8 /) + kbo(:,31,13) = (/ & + & 0.51993e-04_r8,0.53249e-04_r8,0.54213e-04_r8,0.54939e-04_r8,0.55442e-04_r8 /) + kbo(:,32,13) = (/ & + & 0.52364e-04_r8,0.53549e-04_r8,0.54461e-04_r8,0.55127e-04_r8,0.55583e-04_r8 /) + kbo(:,33,13) = (/ & + & 0.52722e-04_r8,0.53841e-04_r8,0.54688e-04_r8,0.55301e-04_r8,0.55705e-04_r8 /) + kbo(:,34,13) = (/ & + & 0.53018e-04_r8,0.54074e-04_r8,0.54867e-04_r8,0.55434e-04_r8,0.55799e-04_r8 /) + kbo(:,35,13) = (/ & + & 0.53187e-04_r8,0.54211e-04_r8,0.54980e-04_r8,0.55515e-04_r8,0.55855e-04_r8 /) + kbo(:,36,13) = (/ & + & 0.53222e-04_r8,0.54242e-04_r8,0.55009e-04_r8,0.55544e-04_r8,0.55878e-04_r8 /) + kbo(:,37,13) = (/ & + & 0.53077e-04_r8,0.54137e-04_r8,0.54934e-04_r8,0.55495e-04_r8,0.55862e-04_r8 /) + kbo(:,38,13) = (/ & + & 0.52907e-04_r8,0.54013e-04_r8,0.54850e-04_r8,0.55445e-04_r8,0.55837e-04_r8 /) + kbo(:,39,13) = (/ & + & 0.52736e-04_r8,0.53884e-04_r8,0.54754e-04_r8,0.55383e-04_r8,0.55805e-04_r8 /) + kbo(:,40,13) = (/ & + & 0.52415e-04_r8,0.53638e-04_r8,0.54576e-04_r8,0.55258e-04_r8,0.55727e-04_r8 /) + kbo(:,41,13) = (/ & + & 0.52053e-04_r8,0.53364e-04_r8,0.54368e-04_r8,0.55117e-04_r8,0.55636e-04_r8 /) + kbo(:,42,13) = (/ & + & 0.51661e-04_r8,0.53061e-04_r8,0.54142e-04_r8,0.54952e-04_r8,0.55527e-04_r8 /) + kbo(:,43,13) = (/ & + & 0.51150e-04_r8,0.52667e-04_r8,0.53836e-04_r8,0.54732e-04_r8,0.55377e-04_r8 /) + kbo(:,44,13) = (/ & + & 0.50559e-04_r8,0.52194e-04_r8,0.53480e-04_r8,0.54465e-04_r8,0.55186e-04_r8 /) + kbo(:,45,13) = (/ & + & 0.49921e-04_r8,0.51684e-04_r8,0.53086e-04_r8,0.54162e-04_r8,0.54971e-04_r8 /) + kbo(:,46,13) = (/ & + & 0.49197e-04_r8,0.51093e-04_r8,0.52628e-04_r8,0.53809e-04_r8,0.54714e-04_r8 /) + kbo(:,47,13) = (/ & + & 0.48328e-04_r8,0.50372e-04_r8,0.52058e-04_r8,0.53374e-04_r8,0.54380e-04_r8 /) + kbo(:,48,13) = (/ & + & 0.47381e-04_r8,0.49603e-04_r8,0.51420e-04_r8,0.52887e-04_r8,0.54013e-04_r8 /) + kbo(:,49,13) = (/ & + & 0.46342e-04_r8,0.48755e-04_r8,0.50735e-04_r8,0.52347e-04_r8,0.53594e-04_r8 /) + kbo(:,50,13) = (/ & + & 0.45266e-04_r8,0.47911e-04_r8,0.50033e-04_r8,0.51782e-04_r8,0.53163e-04_r8 /) + kbo(:,51,13) = (/ & + & 0.44139e-04_r8,0.47021e-04_r8,0.49310e-04_r8,0.51184e-04_r8,0.52699e-04_r8 /) + kbo(:,52,13) = (/ & + & 0.42930e-04_r8,0.46044e-04_r8,0.48523e-04_r8,0.50540e-04_r8,0.52191e-04_r8 /) + kbo(:,53,13) = (/ & + & 0.41632e-04_r8,0.44983e-04_r8,0.47688e-04_r8,0.49847e-04_r8,0.51629e-04_r8 /) + kbo(:,54,13) = (/ & + & 0.40359e-04_r8,0.43928e-04_r8,0.46843e-04_r8,0.49172e-04_r8,0.51075e-04_r8 /) + kbo(:,55,13) = (/ & + & 0.39074e-04_r8,0.42858e-04_r8,0.45984e-04_r8,0.48480e-04_r8,0.50508e-04_r8 /) + kbo(:,56,13) = (/ & + & 0.37728e-04_r8,0.41722e-04_r8,0.45056e-04_r8,0.47740e-04_r8,0.49900e-04_r8 /) + kbo(:,57,13) = (/ & + & 0.36320e-04_r8,0.40515e-04_r8,0.44055e-04_r8,0.46942e-04_r8,0.49258e-04_r8 /) + kbo(:,58,13) = (/ & + & 0.34927e-04_r8,0.39308e-04_r8,0.43052e-04_r8,0.46141e-04_r8,0.48596e-04_r8 /) + kbo(:,59,13) = (/ & + & 0.34349e-04_r8,0.38808e-04_r8,0.42631e-04_r8,0.45802e-04_r8,0.48325e-04_r8 /) + kbo(:,13,14) = (/ & + & 0.91739e-04_r8,0.90588e-04_r8,0.89270e-04_r8,0.87862e-04_r8,0.86541e-04_r8 /) + kbo(:,14,14) = (/ & + & 0.97111e-04_r8,0.95879e-04_r8,0.94382e-04_r8,0.92799e-04_r8,0.91344e-04_r8 /) + kbo(:,15,14) = (/ & + & 0.10201e-03_r8,0.10059e-03_r8,0.98963e-04_r8,0.97297e-04_r8,0.95661e-04_r8 /) + kbo(:,16,14) = (/ & + & 0.10632e-03_r8,0.10477e-03_r8,0.10303e-03_r8,0.10127e-03_r8,0.99489e-04_r8 /) + kbo(:,17,14) = (/ & + & 0.11011e-03_r8,0.10842e-03_r8,0.10659e-03_r8,0.10474e-03_r8,0.10285e-03_r8 /) + kbo(:,18,14) = (/ & + & 0.11338e-03_r8,0.11158e-03_r8,0.10968e-03_r8,0.10773e-03_r8,0.10569e-03_r8 /) + kbo(:,19,14) = (/ & + & 0.11615e-03_r8,0.11428e-03_r8,0.11231e-03_r8,0.11026e-03_r8,0.10810e-03_r8 /) + kbo(:,20,14) = (/ & + & 0.11847e-03_r8,0.11653e-03_r8,0.11450e-03_r8,0.11235e-03_r8,0.11005e-03_r8 /) + kbo(:,21,14) = (/ & + & 0.12039e-03_r8,0.11839e-03_r8,0.11628e-03_r8,0.11404e-03_r8,0.11166e-03_r8 /) + kbo(:,22,14) = (/ & + & 0.12185e-03_r8,0.11978e-03_r8,0.11759e-03_r8,0.11525e-03_r8,0.11275e-03_r8 /) + kbo(:,23,14) = (/ & + & 0.12298e-03_r8,0.12085e-03_r8,0.11858e-03_r8,0.11615e-03_r8,0.11356e-03_r8 /) + kbo(:,24,14) = (/ & + & 0.12384e-03_r8,0.12163e-03_r8,0.11927e-03_r8,0.11676e-03_r8,0.11410e-03_r8 /) + kbo(:,25,14) = (/ & + & 0.12445e-03_r8,0.12216e-03_r8,0.11972e-03_r8,0.11712e-03_r8,0.11440e-03_r8 /) + kbo(:,26,14) = (/ & + & 0.12480e-03_r8,0.12244e-03_r8,0.11993e-03_r8,0.11725e-03_r8,0.11449e-03_r8 /) + kbo(:,27,14) = (/ & + & 0.12497e-03_r8,0.12254e-03_r8,0.11997e-03_r8,0.11723e-03_r8,0.11442e-03_r8 /) + kbo(:,28,14) = (/ & + & 0.12498e-03_r8,0.12249e-03_r8,0.11986e-03_r8,0.11707e-03_r8,0.11425e-03_r8 /) + kbo(:,29,14) = (/ & + & 0.12486e-03_r8,0.12231e-03_r8,0.11961e-03_r8,0.11677e-03_r8,0.11393e-03_r8 /) + kbo(:,30,14) = (/ & + & 0.12462e-03_r8,0.12202e-03_r8,0.11925e-03_r8,0.11640e-03_r8,0.11355e-03_r8 /) + kbo(:,31,14) = (/ & + & 0.12428e-03_r8,0.12163e-03_r8,0.11882e-03_r8,0.11594e-03_r8,0.11310e-03_r8 /) + kbo(:,32,14) = (/ & + & 0.12387e-03_r8,0.12116e-03_r8,0.11831e-03_r8,0.11542e-03_r8,0.11260e-03_r8 /) + kbo(:,33,14) = (/ & + & 0.12338e-03_r8,0.12061e-03_r8,0.11773e-03_r8,0.11485e-03_r8,0.11205e-03_r8 /) + kbo(:,34,14) = (/ & + & 0.12293e-03_r8,0.12013e-03_r8,0.11722e-03_r8,0.11434e-03_r8,0.11156e-03_r8 /) + kbo(:,35,14) = (/ & + & 0.12271e-03_r8,0.11987e-03_r8,0.11696e-03_r8,0.11408e-03_r8,0.11132e-03_r8 /) + kbo(:,36,14) = (/ & + & 0.12276e-03_r8,0.11992e-03_r8,0.11700e-03_r8,0.11412e-03_r8,0.11135e-03_r8 /) + kbo(:,37,14) = (/ & + & 0.12321e-03_r8,0.12039e-03_r8,0.11748e-03_r8,0.11457e-03_r8,0.11178e-03_r8 /) + kbo(:,38,14) = (/ & + & 0.12368e-03_r8,0.12086e-03_r8,0.11795e-03_r8,0.11504e-03_r8,0.11223e-03_r8 /) + kbo(:,39,14) = (/ & + & 0.12412e-03_r8,0.12132e-03_r8,0.11841e-03_r8,0.11549e-03_r8,0.11266e-03_r8 /) + kbo(:,40,14) = (/ & + & 0.12481e-03_r8,0.12205e-03_r8,0.11917e-03_r8,0.11624e-03_r8,0.11338e-03_r8 /) + kbo(:,41,14) = (/ & + & 0.12552e-03_r8,0.12282e-03_r8,0.11995e-03_r8,0.11701e-03_r8,0.11413e-03_r8 /) + kbo(:,42,14) = (/ & + & 0.12624e-03_r8,0.12356e-03_r8,0.12073e-03_r8,0.11779e-03_r8,0.11489e-03_r8 /) + kbo(:,43,14) = (/ & + & 0.12708e-03_r8,0.12444e-03_r8,0.12166e-03_r8,0.11873e-03_r8,0.11581e-03_r8 /) + kbo(:,44,14) = (/ & + & 0.12796e-03_r8,0.12537e-03_r8,0.12263e-03_r8,0.11974e-03_r8,0.11681e-03_r8 /) + kbo(:,45,14) = (/ & + & 0.12882e-03_r8,0.12627e-03_r8,0.12360e-03_r8,0.12075e-03_r8,0.11782e-03_r8 /) + kbo(:,46,14) = (/ & + & 0.12968e-03_r8,0.12723e-03_r8,0.12459e-03_r8,0.12181e-03_r8,0.11889e-03_r8 /) + kbo(:,47,14) = (/ & + & 0.13062e-03_r8,0.12827e-03_r8,0.12567e-03_r8,0.12295e-03_r8,0.12008e-03_r8 /) + kbo(:,48,14) = (/ & + & 0.13150e-03_r8,0.12926e-03_r8,0.12675e-03_r8,0.12408e-03_r8,0.12126e-03_r8 /) + kbo(:,49,14) = (/ & + & 0.13233e-03_r8,0.13021e-03_r8,0.12780e-03_r8,0.12517e-03_r8,0.12242e-03_r8 /) + kbo(:,50,14) = (/ & + & 0.13307e-03_r8,0.13105e-03_r8,0.12874e-03_r8,0.12618e-03_r8,0.12349e-03_r8 /) + kbo(:,51,14) = (/ & + & 0.13374e-03_r8,0.13183e-03_r8,0.12963e-03_r8,0.12715e-03_r8,0.12449e-03_r8 /) + kbo(:,52,14) = (/ & + & 0.13431e-03_r8,0.13255e-03_r8,0.13046e-03_r8,0.12807e-03_r8,0.12548e-03_r8 /) + kbo(:,53,14) = (/ & + & 0.13479e-03_r8,0.13325e-03_r8,0.13127e-03_r8,0.12898e-03_r8,0.12645e-03_r8 /) + kbo(:,54,14) = (/ & + & 0.13511e-03_r8,0.13385e-03_r8,0.13196e-03_r8,0.12979e-03_r8,0.12732e-03_r8 /) + kbo(:,55,14) = (/ & + & 0.13533e-03_r8,0.13436e-03_r8,0.13261e-03_r8,0.13052e-03_r8,0.12814e-03_r8 /) + kbo(:,56,14) = (/ & + & 0.13543e-03_r8,0.13477e-03_r8,0.13321e-03_r8,0.13121e-03_r8,0.12893e-03_r8 /) + kbo(:,57,14) = (/ & + & 0.13540e-03_r8,0.13509e-03_r8,0.13379e-03_r8,0.13190e-03_r8,0.12969e-03_r8 /) + kbo(:,58,14) = (/ & + & 0.13520e-03_r8,0.13532e-03_r8,0.13428e-03_r8,0.13250e-03_r8,0.13039e-03_r8 /) + kbo(:,59,14) = (/ & + & 0.13510e-03_r8,0.13536e-03_r8,0.13445e-03_r8,0.13273e-03_r8,0.13066e-03_r8 /) + kbo(:,13,15) = (/ & + & 0.16545e-03_r8,0.16076e-03_r8,0.15662e-03_r8,0.15273e-03_r8,0.14899e-03_r8 /) + kbo(:,14,15) = (/ & + & 0.17968e-03_r8,0.17402e-03_r8,0.16899e-03_r8,0.16434e-03_r8,0.15984e-03_r8 /) + kbo(:,15,15) = (/ & + & 0.19299e-03_r8,0.18634e-03_r8,0.18041e-03_r8,0.17491e-03_r8,0.16965e-03_r8 /) + kbo(:,16,15) = (/ & + & 0.20519e-03_r8,0.19756e-03_r8,0.19072e-03_r8,0.18435e-03_r8,0.17834e-03_r8 /) + kbo(:,17,15) = (/ & + & 0.21616e-03_r8,0.20753e-03_r8,0.19981e-03_r8,0.19268e-03_r8,0.18599e-03_r8 /) + kbo(:,18,15) = (/ & + & 0.22578e-03_r8,0.21627e-03_r8,0.20768e-03_r8,0.19983e-03_r8,0.19254e-03_r8 /) + kbo(:,19,15) = (/ & + & 0.23404e-03_r8,0.22371e-03_r8,0.21439e-03_r8,0.20593e-03_r8,0.19813e-03_r8 /) + kbo(:,20,15) = (/ & + & 0.24079e-03_r8,0.22975e-03_r8,0.21986e-03_r8,0.21084e-03_r8,0.20261e-03_r8 /) + kbo(:,21,15) = (/ & + & 0.24629e-03_r8,0.23467e-03_r8,0.22423e-03_r8,0.21475e-03_r8,0.20622e-03_r8 /) + kbo(:,22,15) = (/ & + & 0.24979e-03_r8,0.23775e-03_r8,0.22702e-03_r8,0.21724e-03_r8,0.20849e-03_r8 /) + kbo(:,23,15) = (/ & + & 0.25216e-03_r8,0.23989e-03_r8,0.22890e-03_r8,0.21892e-03_r8,0.21005e-03_r8 /) + kbo(:,24,15) = (/ & + & 0.25355e-03_r8,0.24109e-03_r8,0.22997e-03_r8,0.21990e-03_r8,0.21094e-03_r8 /) + kbo(:,25,15) = (/ & + & 0.25401e-03_r8,0.24151e-03_r8,0.23030e-03_r8,0.22024e-03_r8,0.21125e-03_r8 /) + kbo(:,26,15) = (/ & + & 0.25359e-03_r8,0.24114e-03_r8,0.22993e-03_r8,0.21995e-03_r8,0.21097e-03_r8 /) + kbo(:,27,15) = (/ & + & 0.25262e-03_r8,0.24030e-03_r8,0.22913e-03_r8,0.21926e-03_r8,0.21037e-03_r8 /) + kbo(:,28,15) = (/ & + & 0.25126e-03_r8,0.23904e-03_r8,0.22801e-03_r8,0.21831e-03_r8,0.20948e-03_r8 /) + kbo(:,29,15) = (/ & + & 0.24948e-03_r8,0.23745e-03_r8,0.22663e-03_r8,0.21704e-03_r8,0.20834e-03_r8 /) + kbo(:,30,15) = (/ & + & 0.24748e-03_r8,0.23558e-03_r8,0.22502e-03_r8,0.21558e-03_r8,0.20699e-03_r8 /) + kbo(:,31,15) = (/ & + & 0.24521e-03_r8,0.23353e-03_r8,0.22323e-03_r8,0.21394e-03_r8,0.20549e-03_r8 /) + kbo(:,32,15) = (/ & + & 0.24273e-03_r8,0.23132e-03_r8,0.22129e-03_r8,0.21221e-03_r8,0.20387e-03_r8 /) + kbo(:,33,15) = (/ & + & 0.24020e-03_r8,0.22911e-03_r8,0.21929e-03_r8,0.21039e-03_r8,0.20217e-03_r8 /) + kbo(:,34,15) = (/ & + & 0.23799e-03_r8,0.22719e-03_r8,0.21754e-03_r8,0.20880e-03_r8,0.20071e-03_r8 /) + kbo(:,35,15) = (/ & + & 0.23687e-03_r8,0.22619e-03_r8,0.21668e-03_r8,0.20798e-03_r8,0.19994e-03_r8 /) + kbo(:,36,15) = (/ & + & 0.23693e-03_r8,0.22624e-03_r8,0.21673e-03_r8,0.20802e-03_r8,0.19997e-03_r8 /) + kbo(:,37,15) = (/ & + & 0.23866e-03_r8,0.22780e-03_r8,0.21810e-03_r8,0.20930e-03_r8,0.20116e-03_r8 /) + kbo(:,38,15) = (/ & + & 0.24049e-03_r8,0.22941e-03_r8,0.21958e-03_r8,0.21064e-03_r8,0.20240e-03_r8 /) + kbo(:,39,15) = (/ & + & 0.24235e-03_r8,0.23100e-03_r8,0.22101e-03_r8,0.21195e-03_r8,0.20362e-03_r8 /) + kbo(:,40,15) = (/ & + & 0.24544e-03_r8,0.23374e-03_r8,0.22344e-03_r8,0.21416e-03_r8,0.20567e-03_r8 /) + kbo(:,41,15) = (/ & + & 0.24874e-03_r8,0.23671e-03_r8,0.22606e-03_r8,0.21653e-03_r8,0.20786e-03_r8 /) + kbo(:,42,15) = (/ & + & 0.25214e-03_r8,0.23974e-03_r8,0.22874e-03_r8,0.21892e-03_r8,0.21007e-03_r8 /) + kbo(:,43,15) = (/ & + & 0.25633e-03_r8,0.24355e-03_r8,0.23207e-03_r8,0.22195e-03_r8,0.21281e-03_r8 /) + kbo(:,44,15) = (/ & + & 0.26108e-03_r8,0.24779e-03_r8,0.23584e-03_r8,0.22529e-03_r8,0.21581e-03_r8 /) + kbo(:,45,15) = (/ & + & 0.26596e-03_r8,0.25216e-03_r8,0.23977e-03_r8,0.22875e-03_r8,0.21897e-03_r8 /) + kbo(:,46,15) = (/ & + & 0.27137e-03_r8,0.25699e-03_r8,0.24413e-03_r8,0.23258e-03_r8,0.22240e-03_r8 /) + kbo(:,47,15) = (/ & + & 0.27767e-03_r8,0.26264e-03_r8,0.24919e-03_r8,0.23707e-03_r8,0.22639e-03_r8 /) + kbo(:,48,15) = (/ & + & 0.28422e-03_r8,0.26851e-03_r8,0.25443e-03_r8,0.24179e-03_r8,0.23054e-03_r8 /) + kbo(:,49,15) = (/ & + & 0.29109e-03_r8,0.27465e-03_r8,0.25993e-03_r8,0.24676e-03_r8,0.23489e-03_r8 /) + kbo(:,50,15) = (/ & + & 0.29784e-03_r8,0.28066e-03_r8,0.26532e-03_r8,0.25156e-03_r8,0.23921e-03_r8 /) + kbo(:,51,15) = (/ & + & 0.30464e-03_r8,0.28674e-03_r8,0.27072e-03_r8,0.25642e-03_r8,0.24358e-03_r8 /) + kbo(:,52,15) = (/ & + & 0.31175e-03_r8,0.29305e-03_r8,0.27640e-03_r8,0.26149e-03_r8,0.24813e-03_r8 /) + kbo(:,53,15) = (/ & + & 0.31921e-03_r8,0.29964e-03_r8,0.28229e-03_r8,0.26674e-03_r8,0.25282e-03_r8 /) + kbo(:,54,15) = (/ & + & 0.32632e-03_r8,0.30596e-03_r8,0.28789e-03_r8,0.27174e-03_r8,0.25731e-03_r8 /) + kbo(:,55,15) = (/ & + & 0.33342e-03_r8,0.31218e-03_r8,0.29344e-03_r8,0.27674e-03_r8,0.26179e-03_r8 /) + kbo(:,56,15) = (/ & + & 0.34053e-03_r8,0.31870e-03_r8,0.29920e-03_r8,0.28191e-03_r8,0.26637e-03_r8 /) + kbo(:,57,15) = (/ & + & 0.34801e-03_r8,0.32554e-03_r8,0.30518e-03_r8,0.28726e-03_r8,0.27114e-03_r8 /) + kbo(:,58,15) = (/ & + & 0.35537e-03_r8,0.33214e-03_r8,0.31109e-03_r8,0.29248e-03_r8,0.27588e-03_r8 /) + kbo(:,59,15) = (/ & + & 0.35841e-03_r8,0.33487e-03_r8,0.31352e-03_r8,0.29463e-03_r8,0.27781e-03_r8 /) + kbo(:,13,16) = (/ & + & 0.23817e-03_r8,0.23193e-03_r8,0.22589e-03_r8,0.21979e-03_r8,0.21365e-03_r8 /) + kbo(:,14,16) = (/ & + & 0.26266e-03_r8,0.25442e-03_r8,0.24663e-03_r8,0.23897e-03_r8,0.23152e-03_r8 /) + kbo(:,15,16) = (/ & + & 0.28586e-03_r8,0.27559e-03_r8,0.26587e-03_r8,0.25663e-03_r8,0.24800e-03_r8 /) + kbo(:,16,16) = (/ & + & 0.30726e-03_r8,0.29496e-03_r8,0.28337e-03_r8,0.27251e-03_r8,0.26278e-03_r8 /) + kbo(:,17,16) = (/ & + & 0.32665e-03_r8,0.31224e-03_r8,0.29895e-03_r8,0.28665e-03_r8,0.27581e-03_r8 /) + kbo(:,18,16) = (/ & + & 0.34367e-03_r8,0.32749e-03_r8,0.31249e-03_r8,0.29896e-03_r8,0.28707e-03_r8 /) + kbo(:,19,16) = (/ & + & 0.35833e-03_r8,0.34046e-03_r8,0.32413e-03_r8,0.30949e-03_r8,0.29662e-03_r8 /) + kbo(:,20,16) = (/ & + & 0.37032e-03_r8,0.35107e-03_r8,0.33355e-03_r8,0.31795e-03_r8,0.30443e-03_r8 /) + kbo(:,21,16) = (/ & + & 0.38004e-03_r8,0.35962e-03_r8,0.34106e-03_r8,0.32482e-03_r8,0.31071e-03_r8 /) + kbo(:,22,16) = (/ & + & 0.38628e-03_r8,0.36502e-03_r8,0.34582e-03_r8,0.32929e-03_r8,0.31473e-03_r8 /) + kbo(:,23,16) = (/ & + & 0.39046e-03_r8,0.36870e-03_r8,0.34902e-03_r8,0.33239e-03_r8,0.31753e-03_r8 /) + kbo(:,24,16) = (/ & + & 0.39290e-03_r8,0.37079e-03_r8,0.35085e-03_r8,0.33417e-03_r8,0.31909e-03_r8 /) + kbo(:,25,16) = (/ & + & 0.39368e-03_r8,0.37132e-03_r8,0.35155e-03_r8,0.33489e-03_r8,0.31974e-03_r8 /) + kbo(:,26,16) = (/ & + & 0.39288e-03_r8,0.37052e-03_r8,0.35111e-03_r8,0.33452e-03_r8,0.31938e-03_r8 /) + kbo(:,27,16) = (/ & + & 0.39120e-03_r8,0.36896e-03_r8,0.34999e-03_r8,0.33347e-03_r8,0.31836e-03_r8 /) + kbo(:,28,16) = (/ & + & 0.38862e-03_r8,0.36669e-03_r8,0.34828e-03_r8,0.33189e-03_r8,0.31693e-03_r8 /) + kbo(:,29,16) = (/ & + & 0.38540e-03_r8,0.36396e-03_r8,0.34596e-03_r8,0.32975e-03_r8,0.31502e-03_r8 /) + kbo(:,30,16) = (/ & + & 0.38165e-03_r8,0.36095e-03_r8,0.34333e-03_r8,0.32738e-03_r8,0.31277e-03_r8 /) + kbo(:,31,16) = (/ & + & 0.37756e-03_r8,0.35762e-03_r8,0.34034e-03_r8,0.32467e-03_r8,0.31030e-03_r8 /) + kbo(:,32,16) = (/ & + & 0.37323e-03_r8,0.35410e-03_r8,0.33709e-03_r8,0.32164e-03_r8,0.30764e-03_r8 /) + kbo(:,33,16) = (/ & + & 0.36881e-03_r8,0.35033e-03_r8,0.33368e-03_r8,0.31855e-03_r8,0.30481e-03_r8 /) + kbo(:,34,16) = (/ & + & 0.36518e-03_r8,0.34710e-03_r8,0.33080e-03_r8,0.31589e-03_r8,0.30241e-03_r8 /) + kbo(:,35,16) = (/ & + & 0.36331e-03_r8,0.34548e-03_r8,0.32924e-03_r8,0.31455e-03_r8,0.30119e-03_r8 /) + kbo(:,36,16) = (/ & + & 0.36345e-03_r8,0.34559e-03_r8,0.32934e-03_r8,0.31463e-03_r8,0.30125e-03_r8 /) + kbo(:,37,16) = (/ & + & 0.36636e-03_r8,0.34821e-03_r8,0.33175e-03_r8,0.31676e-03_r8,0.30324e-03_r8 /) + kbo(:,38,16) = (/ & + & 0.36948e-03_r8,0.35092e-03_r8,0.33423e-03_r8,0.31902e-03_r8,0.30527e-03_r8 /) + kbo(:,39,16) = (/ & + & 0.37259e-03_r8,0.35368e-03_r8,0.33668e-03_r8,0.32128e-03_r8,0.30727e-03_r8 /) + kbo(:,40,16) = (/ & + & 0.37795e-03_r8,0.35829e-03_r8,0.34085e-03_r8,0.32505e-03_r8,0.31069e-03_r8 /) + kbo(:,41,16) = (/ & + & 0.38379e-03_r8,0.36312e-03_r8,0.34529e-03_r8,0.32908e-03_r8,0.31437e-03_r8 /) + kbo(:,42,16) = (/ & + & 0.38990e-03_r8,0.36819e-03_r8,0.34980e-03_r8,0.33322e-03_r8,0.31806e-03_r8 /) + kbo(:,43,16) = (/ & + & 0.39755e-03_r8,0.37469e-03_r8,0.35548e-03_r8,0.33833e-03_r8,0.32274e-03_r8 /) + kbo(:,44,16) = (/ & + & 0.40604e-03_r8,0.38206e-03_r8,0.36178e-03_r8,0.34404e-03_r8,0.32793e-03_r8 /) + kbo(:,45,16) = (/ & + & 0.41497e-03_r8,0.38998e-03_r8,0.36828e-03_r8,0.34986e-03_r8,0.33329e-03_r8 /) + kbo(:,46,16) = (/ & + & 0.42497e-03_r8,0.39871e-03_r8,0.37566e-03_r8,0.35633e-03_r8,0.33909e-03_r8 /) + kbo(:,47,16) = (/ & + & 0.43684e-03_r8,0.40880e-03_r8,0.38451e-03_r8,0.36380e-03_r8,0.34586e-03_r8 /) + kbo(:,48,16) = (/ & + & 0.44932e-03_r8,0.41960e-03_r8,0.39404e-03_r8,0.37171e-03_r8,0.35286e-03_r8 /) + kbo(:,49,16) = (/ & + & 0.46270e-03_r8,0.43113e-03_r8,0.40397e-03_r8,0.38027e-03_r8,0.36021e-03_r8 /) + kbo(:,50,16) = (/ & + & 0.47605e-03_r8,0.44249e-03_r8,0.41370e-03_r8,0.38887e-03_r8,0.36733e-03_r8 /) + kbo(:,51,16) = (/ & + & 0.48981e-03_r8,0.45414e-03_r8,0.42376e-03_r8,0.39765e-03_r8,0.37477e-03_r8 /) + kbo(:,52,16) = (/ & + & 0.50430e-03_r8,0.46661e-03_r8,0.43437e-03_r8,0.40673e-03_r8,0.38268e-03_r8 /) + kbo(:,53,16) = (/ & + & 0.51980e-03_r8,0.47970e-03_r8,0.44558e-03_r8,0.41639e-03_r8,0.39115e-03_r8 /) + kbo(:,54,16) = (/ & + & 0.53506e-03_r8,0.49244e-03_r8,0.45647e-03_r8,0.42564e-03_r8,0.39926e-03_r8 /) + kbo(:,55,16) = (/ & + & 0.55131e-03_r8,0.50528e-03_r8,0.46739e-03_r8,0.43505e-03_r8,0.40730e-03_r8 /) + kbo(:,56,16) = (/ & + & 0.56909e-03_r8,0.51883e-03_r8,0.47884e-03_r8,0.44497e-03_r8,0.41571e-03_r8 /) + kbo(:,57,16) = (/ & + & 0.58824e-03_r8,0.53334e-03_r8,0.49097e-03_r8,0.45523e-03_r8,0.42457e-03_r8 /) + kbo(:,58,16) = (/ & + & 0.60745e-03_r8,0.54837e-03_r8,0.50301e-03_r8,0.46546e-03_r8,0.43352e-03_r8 /) + kbo(:,59,16) = (/ & + & 0.61557e-03_r8,0.55493e-03_r8,0.50805e-03_r8,0.46962e-03_r8,0.43716e-03_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.351362e-07_r8, 0.341136e-07_r8, 0.181317e-06_r8 /) + forrefo(:, 2) = (/ 0.109648e-06_r8, 0.344240e-06_r8, 0.139709e-05_r8 /) + forrefo(:, 3) = (/ 0.374823e-06_r8, 0.103424e-05_r8, 0.188717e-05_r8 /) + forrefo(:, 4) = (/ 0.580041e-06_r8, 0.116876e-05_r8, 0.121183e-05_r8 /) + forrefo(:, 5) = (/ 0.115608e-05_r8, 0.148110e-05_r8, 0.836083e-06_r8 /) + forrefo(:, 6) = (/ 0.181460e-05_r8, 0.133313e-05_r8, 0.500167e-06_r8 /) + forrefo(:, 7) = (/ 0.199096e-05_r8, 0.115276e-05_r8, 0.432994e-06_r8 /) + forrefo(:, 8) = (/ 0.183730e-05_r8, 0.122260e-05_r8, 0.433248e-06_r8 /) + forrefo(:, 9) = (/ 0.198386e-05_r8, 0.100130e-05_r8, 0.269712e-06_r8 /) + forrefo(:,10) = (/ 0.276382e-05_r8, 0.749215e-06_r8, 0.236919e-06_r8 /) + forrefo(:,11) = (/ 0.298202e-05_r8, 0.629688e-06_r8, 0.228388e-06_r8 /) + forrefo(:,12) = (/ 0.364604e-05_r8, 0.455336e-06_r8, 0.206130e-06_r8 /) + forrefo(:,13) = (/ 0.373339e-05_r8, 0.245210e-06_r8, 0.201987e-06_r8 /) + forrefo(:,14) = (/ 0.480378e-05_r8, 0.177591e-06_r8, 0.171458e-06_r8 /) + forrefo(:,15) = (/ 0.521700e-05_r8, 0.203358e-06_r8, 0.189559e-06_r8 /) + forrefo(:,16) = (/ 0.542717e-05_r8, 0.219022e-06_r8, 0.218271e-06_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.538526e-04_r8, 0.464603e-04_r8, 0.400828e-04_r8, 0.345807e-04_r8, 0.298339e-04_r8, & + & 0.257386e-04_r8, 0.222055e-04_r8, 0.191574e-04_r8, 0.165277e-04_r8, 0.142590e-04_r8 /) + selfrefo(:, 2) = (/ & + & 0.162409e-03_r8, 0.128347e-03_r8, 0.101430e-03_r8, 0.801571e-04_r8, 0.633460e-04_r8, & + & 0.500607e-04_r8, 0.395616e-04_r8, 0.312645e-04_r8, 0.247075e-04_r8, 0.195257e-04_r8 /) + selfrefo(:, 3) = (/ & + & 0.262882e-03_r8, 0.212793e-03_r8, 0.172247e-03_r8, 0.139427e-03_r8, 0.112860e-03_r8, & + & 0.913557e-04_r8, 0.739487e-04_r8, 0.598584e-04_r8, 0.484529e-04_r8, 0.392206e-04_r8 /) + selfrefo(:, 4) = (/ & + & 0.242873e-03_r8, 0.204225e-03_r8, 0.171726e-03_r8, 0.144399e-03_r8, 0.121421e-03_r8, & + & 0.102099e-03_r8, 0.858516e-04_r8, 0.721899e-04_r8, 0.607022e-04_r8, 0.510426e-04_r8 /) + selfrefo(:, 5) = (/ & + & 0.235614e-03_r8, 0.207814e-03_r8, 0.183293e-03_r8, 0.161666e-03_r8, 0.142591e-03_r8, & + & 0.125766e-03_r8, 0.110927e-03_r8, 0.978381e-04_r8, 0.862939e-04_r8, 0.761119e-04_r8 /) + selfrefo(:, 6) = (/ & + & 0.205508e-03_r8, 0.190174e-03_r8, 0.175985e-03_r8, 0.162854e-03_r8, 0.150702e-03_r8, & + & 0.139458e-03_r8, 0.129052e-03_r8, 0.119423e-03_r8, 0.110513e-03_r8, 0.102267e-03_r8 /) + selfrefo(:, 7) = (/ & + & 0.185027e-03_r8, 0.175148e-03_r8, 0.165796e-03_r8, 0.156944e-03_r8, 0.148565e-03_r8, & + & 0.140633e-03_r8, 0.133124e-03_r8, 0.126016e-03_r8, 0.119288e-03_r8, 0.112919e-03_r8 /) + selfrefo(:, 8) = (/ & + & 0.192634e-03_r8, 0.180192e-03_r8, 0.168554e-03_r8, 0.157668e-03_r8, 0.147484e-03_r8, & + & 0.137959e-03_r8, 0.129048e-03_r8, 0.120713e-03_r8, 0.112917e-03_r8, 0.105624e-03_r8 /) + selfrefo(:, 9) = (/ & + & 0.161632e-03_r8, 0.155919e-03_r8, 0.150408e-03_r8, 0.145092e-03_r8, 0.139963e-03_r8, & + & 0.135016e-03_r8, 0.130244e-03_r8, 0.125640e-03_r8, 0.121199e-03_r8, 0.116915e-03_r8 /) + selfrefo(:,10) = (/ & + & 0.120880e-03_r8, 0.125265e-03_r8, 0.129810e-03_r8, 0.134520e-03_r8, 0.139400e-03_r8, & + & 0.144458e-03_r8, 0.149699e-03_r8, 0.155130e-03_r8, 0.160758e-03_r8, 0.166591e-03_r8 /) + selfrefo(:,11) = (/ & + & 0.104705e-03_r8, 0.111761e-03_r8, 0.119291e-03_r8, 0.127330e-03_r8, 0.135910e-03_r8, & + & 0.145068e-03_r8, 0.154843e-03_r8, 0.165277e-03_r8, 0.176414e-03_r8, 0.188302e-03_r8 /) + selfrefo(:,12) = (/ & + & 0.846335e-04_r8, 0.951236e-04_r8, 0.106914e-03_r8, 0.120166e-03_r8, 0.135060e-03_r8, & + & 0.151800e-03_r8, 0.170616e-03_r8, 0.191763e-03_r8, 0.215532e-03_r8, 0.242246e-03_r8 /) + selfrefo(:,13) = (/ & + & 0.669754e-04_r8, 0.781902e-04_r8, 0.912829e-04_r8, 0.106568e-03_r8, 0.124413e-03_r8, & + & 0.145245e-03_r8, 0.169566e-03_r8, 0.197959e-03_r8, 0.231107e-03_r8, 0.269805e-03_r8 /) + selfrefo(:,14) = (/ & + & 0.597091e-04_r8, 0.722265e-04_r8, 0.873679e-04_r8, 0.105684e-03_r8, 0.127839e-03_r8, & + & 0.154639e-03_r8, 0.187057e-03_r8, 0.226272e-03_r8, 0.273707e-03_r8, 0.331087e-03_r8 /) + selfrefo(:,15) = (/ & + & 0.640410e-04_r8, 0.771879e-04_r8, 0.930338e-04_r8, 0.112133e-03_r8, 0.135152e-03_r8, & + & 0.162897e-03_r8, 0.196338e-03_r8, 0.236644e-03_r8, 0.285225e-03_r8, 0.343778e-03_r8 /) + selfrefo(:,16) = (/ & + & 0.666420e-04_r8, 0.801056e-04_r8, 0.962892e-04_r8, 0.115742e-03_r8, 0.139126e-03_r8, & + & 0.167233e-03_r8, 0.201019e-03_r8, 0.241630e-03_r8, 0.290446e-03_r8, 0.349125e-03_r8 /) + + end subroutine sw_kgb22 + +! ************************************************************************** + subroutine sw_kgb23 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg23, only : kao, selfrefo, forrefo, sfluxrefo, & + raylo, givfac, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & + & 53.2101_r8 , 51.4143_r8, 49.3348_r8, 45.4612_r8 , & + & 40.8294_r8 , 35.1801_r8, 28.6947_r8, 21.5751_r8 , & + & 14.6388_r8 , 1.59111_r8, 1.31860_r8, 1.04018_r8 , & + & 0.762140_r8,0.484214_r8,0.182275_r8, 2.54948e-02_r8 /) + +! Rayleigh extinction coefficient at all v + raylo(:) = (/ & + & 5.94837e-08_r8,5.70593e-08_r8,6.27845e-08_r8,5.56602e-08_r8, & + & 5.25571e-08_r8,4.73388e-08_r8,4.17466e-08_r8,3.98097e-08_r8, & + & 4.00786e-08_r8,3.67478e-08_r8,3.45186e-08_r8,3.46156e-08_r8, & + & 3.32155e-08_r8,3.23642e-08_r8,2.72590e-08_r8,2.96813e-08_r8 /) + +! Average Giver et al. correction factor for this band. + givfac = 1.029_r8 + + layreffr = 6 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1) = (/ & + & 0.33078e-07_r8,0.34034e-07_r8,0.35124e-07_r8,0.34187e-07_r8,0.34744e-07_r8 /) + kao(:, 2, 1) = (/ & + & 0.25544e-07_r8,0.25873e-07_r8,0.26742e-07_r8,0.27512e-07_r8,0.27504e-07_r8 /) + kao(:, 3, 1) = (/ & + & 0.18549e-07_r8,0.19611e-07_r8,0.20840e-07_r8,0.22548e-07_r8,0.23069e-07_r8 /) + kao(:, 4, 1) = (/ & + & 0.28794e-07_r8,0.30837e-07_r8,0.32679e-07_r8,0.34307e-07_r8,0.36901e-07_r8 /) + kao(:, 5, 1) = (/ & + & 0.36776e-07_r8,0.39144e-07_r8,0.41300e-07_r8,0.43264e-07_r8,0.46626e-07_r8 /) + kao(:, 6, 1) = (/ & + & 0.59710e-07_r8,0.62941e-07_r8,0.65500e-07_r8,0.67353e-07_r8,0.68774e-07_r8 /) + kao(:, 7, 1) = (/ & + & 0.12143e-06_r8,0.12932e-06_r8,0.13250e-06_r8,0.13526e-06_r8,0.13849e-06_r8 /) + kao(:, 8, 1) = (/ & + & 0.12531e-06_r8,0.13241e-06_r8,0.13939e-06_r8,0.14705e-06_r8,0.15465e-06_r8 /) + kao(:, 9, 1) = (/ & + & 0.20209e-06_r8,0.21134e-06_r8,0.22163e-06_r8,0.23098e-06_r8,0.24004e-06_r8 /) + kao(:,10, 1) = (/ & + & 0.10750e-05_r8,0.11204e-05_r8,0.11575e-05_r8,0.11923e-05_r8,0.12227e-05_r8 /) + kao(:,11, 1) = (/ & + & 0.27782e-05_r8,0.28204e-05_r8,0.28406e-05_r8,0.28380e-05_r8,0.28440e-05_r8 /) + kao(:,12, 1) = (/ & + & 0.38510e-05_r8,0.39934e-05_r8,0.40697e-05_r8,0.41102e-05_r8,0.41571e-05_r8 /) + kao(:,13, 1) = (/ & + & 0.43157e-05_r8,0.44488e-05_r8,0.45799e-05_r8,0.46585e-05_r8,0.47223e-05_r8 /) + kao(:, 1, 2) = (/ & + & 0.84637e-06_r8,0.86989e-06_r8,0.90697e-06_r8,0.90000e-06_r8,0.91373e-06_r8 /) + kao(:, 2, 2) = (/ & + & 0.67062e-06_r8,0.68649e-06_r8,0.72334e-06_r8,0.73645e-06_r8,0.72978e-06_r8 /) + kao(:, 3, 2) = (/ & + & 0.52317e-06_r8,0.53924e-06_r8,0.55425e-06_r8,0.58347e-06_r8,0.57813e-06_r8 /) + kao(:, 4, 2) = (/ & + & 0.39868e-06_r8,0.41431e-06_r8,0.42761e-06_r8,0.43892e-06_r8,0.45982e-06_r8 /) + kao(:, 5, 2) = (/ & + & 0.32074e-06_r8,0.33452e-06_r8,0.34754e-06_r8,0.35582e-06_r8,0.37378e-06_r8 /) + kao(:, 6, 2) = (/ & + & 0.42465e-06_r8,0.44058e-06_r8,0.45605e-06_r8,0.47192e-06_r8,0.48493e-06_r8 /) + kao(:, 7, 2) = (/ & + & 0.47581e-06_r8,0.50000e-06_r8,0.52487e-06_r8,0.54192e-06_r8,0.55955e-06_r8 /) + kao(:, 8, 2) = (/ & + & 0.10592e-05_r8,0.11093e-05_r8,0.11483e-05_r8,0.11923e-05_r8,0.12169e-05_r8 /) + kao(:, 9, 2) = (/ & + & 0.50835e-05_r8,0.51710e-05_r8,0.52329e-05_r8,0.52644e-05_r8,0.52818e-05_r8 /) + kao(:,10, 2) = (/ & + & 0.77867e-05_r8,0.82156e-05_r8,0.86002e-05_r8,0.89664e-05_r8,0.92394e-05_r8 /) + kao(:,11, 2) = (/ & + & 0.89031e-05_r8,0.93573e-05_r8,0.97686e-05_r8,0.10236e-04_r8,0.10591e-04_r8 /) + kao(:,12, 2) = (/ & + & 0.98068e-05_r8,0.10238e-04_r8,0.10700e-04_r8,0.11108e-04_r8,0.11471e-04_r8 /) + kao(:,13, 2) = (/ & + & 0.11145e-04_r8,0.11697e-04_r8,0.12123e-04_r8,0.12482e-04_r8,0.12856e-04_r8 /) + kao(:, 1, 3) = (/ & + & 0.66049e-05_r8,0.67547e-05_r8,0.70104e-05_r8,0.69745e-05_r8,0.70687e-05_r8 /) + kao(:, 2, 3) = (/ & + & 0.54104e-05_r8,0.55245e-05_r8,0.57623e-05_r8,0.58532e-05_r8,0.58099e-05_r8 /) + kao(:, 3, 3) = (/ & + & 0.43608e-05_r8,0.44784e-05_r8,0.45778e-05_r8,0.47665e-05_r8,0.47295e-05_r8 /) + kao(:, 4, 3) = (/ & + & 0.35399e-05_r8,0.36454e-05_r8,0.37356e-05_r8,0.38107e-05_r8,0.39586e-05_r8 /) + kao(:, 5, 3) = (/ & + & 0.28576e-05_r8,0.29552e-05_r8,0.30325e-05_r8,0.31028e-05_r8,0.32276e-05_r8 /) + kao(:, 6, 3) = (/ & + & 0.21017e-05_r8,0.21836e-05_r8,0.22554e-05_r8,0.23121e-05_r8,0.23486e-05_r8 /) + kao(:, 7, 3) = (/ & + & 0.19384e-05_r8,0.19914e-05_r8,0.20428e-05_r8,0.20879e-05_r8,0.21191e-05_r8 /) + kao(:, 8, 3) = (/ & + & 0.32672e-05_r8,0.33753e-05_r8,0.34694e-05_r8,0.35273e-05_r8,0.35984e-05_r8 /) + kao(:, 9, 3) = (/ & + & 0.82257e-05_r8,0.84975e-05_r8,0.86969e-05_r8,0.88995e-05_r8,0.90123e-05_r8 /) + kao(:,10, 3) = (/ & + & 0.35363e-04_r8,0.36204e-04_r8,0.36916e-04_r8,0.37708e-04_r8,0.38294e-04_r8 /) + kao(:,11, 3) = (/ & + & 0.48837e-04_r8,0.50952e-04_r8,0.52710e-04_r8,0.54347e-04_r8,0.55976e-04_r8 /) + kao(:,12, 3) = (/ & + & 0.56059e-04_r8,0.58301e-04_r8,0.60100e-04_r8,0.61776e-04_r8,0.63179e-04_r8 /) + kao(:,13, 3) = (/ & + & 0.57871e-04_r8,0.59505e-04_r8,0.60930e-04_r8,0.62289e-04_r8,0.63278e-04_r8 /) + kao(:, 1, 4) = (/ & + & 0.27624e-04_r8,0.28017e-04_r8,0.29078e-04_r8,0.28567e-04_r8,0.28724e-04_r8 /) + kao(:, 2, 4) = (/ & + & 0.23107e-04_r8,0.23464e-04_r8,0.24357e-04_r8,0.24519e-04_r8,0.24024e-04_r8 /) + kao(:, 3, 4) = (/ & + & 0.19113e-04_r8,0.19400e-04_r8,0.19615e-04_r8,0.20420e-04_r8,0.19962e-04_r8 /) + kao(:, 4, 4) = (/ & + & 0.15873e-04_r8,0.16138e-04_r8,0.16349e-04_r8,0.16528e-04_r8,0.17176e-04_r8 /) + kao(:, 5, 4) = (/ & + & 0.13198e-04_r8,0.13437e-04_r8,0.13641e-04_r8,0.13810e-04_r8,0.14393e-04_r8 /) + kao(:, 6, 4) = (/ & + & 0.10951e-04_r8,0.11172e-04_r8,0.11352e-04_r8,0.11506e-04_r8,0.11631e-04_r8 /) + kao(:, 7, 4) = (/ & + & 0.86121e-05_r8,0.88300e-05_r8,0.90149e-05_r8,0.91565e-05_r8,0.92594e-05_r8 /) + kao(:, 8, 4) = (/ & + & 0.71478e-05_r8,0.72918e-05_r8,0.74035e-05_r8,0.74959e-05_r8,0.75566e-05_r8 /) + kao(:, 9, 4) = (/ & + & 0.16458e-04_r8,0.17092e-04_r8,0.17686e-04_r8,0.17967e-04_r8,0.18273e-04_r8 /) + kao(:,10, 4) = (/ & + & 0.47953e-04_r8,0.49663e-04_r8,0.51524e-04_r8,0.52800e-04_r8,0.54192e-04_r8 /) + kao(:,11, 4) = (/ & + & 0.94263e-04_r8,0.95557e-04_r8,0.96513e-04_r8,0.97430e-04_r8,0.97733e-04_r8 /) + kao(:,12, 4) = (/ & + & 0.12087e-03_r8,0.12152e-03_r8,0.12240e-03_r8,0.12318e-03_r8,0.12403e-03_r8 /) + kao(:,13, 4) = (/ & + & 0.12781e-03_r8,0.12897e-03_r8,0.13049e-03_r8,0.13171e-03_r8,0.13337e-03_r8 /) + kao(:, 1, 5) = (/ & + & 0.82859e-04_r8,0.84817e-04_r8,0.89056e-04_r8,0.88057e-04_r8,0.89410e-04_r8 /) + kao(:, 2, 5) = (/ & + & 0.70937e-04_r8,0.72685e-04_r8,0.76796e-04_r8,0.77955e-04_r8,0.76735e-04_r8 /) + kao(:, 3, 5) = (/ & + & 0.59876e-04_r8,0.61448e-04_r8,0.62837e-04_r8,0.66293e-04_r8,0.64996e-04_r8 /) + kao(:, 4, 5) = (/ & + & 0.50598e-04_r8,0.52054e-04_r8,0.53293e-04_r8,0.54332e-04_r8,0.57333e-04_r8 /) + kao(:, 5, 5) = (/ & + & 0.42742e-04_r8,0.44035e-04_r8,0.45164e-04_r8,0.46134e-04_r8,0.48935e-04_r8 /) + kao(:, 6, 5) = (/ & + & 0.35769e-04_r8,0.36975e-04_r8,0.38038e-04_r8,0.38917e-04_r8,0.39681e-04_r8 /) + kao(:, 7, 5) = (/ & + & 0.29747e-04_r8,0.30824e-04_r8,0.31756e-04_r8,0.32589e-04_r8,0.33314e-04_r8 /) + kao(:, 8, 5) = (/ & + & 0.21994e-04_r8,0.22945e-04_r8,0.23786e-04_r8,0.24517e-04_r8,0.25155e-04_r8 /) + kao(:, 9, 5) = (/ & + & 0.22298e-04_r8,0.22688e-04_r8,0.23127e-04_r8,0.23803e-04_r8,0.24335e-04_r8 /) + kao(:,10, 5) = (/ & + & 0.88898e-04_r8,0.91280e-04_r8,0.93333e-04_r8,0.95224e-04_r8,0.96298e-04_r8 /) + kao(:,11, 5) = (/ & + & 0.12299e-03_r8,0.12407e-03_r8,0.12536e-03_r8,0.12642e-03_r8,0.12813e-03_r8 /) + kao(:,12, 5) = (/ & + & 0.14539e-03_r8,0.14851e-03_r8,0.15022e-03_r8,0.15157e-03_r8,0.15204e-03_r8 /) + kao(:,13, 5) = (/ & + & 0.15949e-03_r8,0.16239e-03_r8,0.16467e-03_r8,0.16667e-03_r8,0.16801e-03_r8 /) + kao(:, 1, 6) = (/ & + & 0.25339e-03_r8,0.25995e-03_r8,0.27170e-03_r8,0.26963e-03_r8,0.27413e-03_r8 /) + kao(:, 2, 6) = (/ & + & 0.21908e-03_r8,0.22404e-03_r8,0.23522e-03_r8,0.23902e-03_r8,0.23717e-03_r8 /) + kao(:, 3, 6) = (/ & + & 0.18611e-03_r8,0.19076e-03_r8,0.19518e-03_r8,0.20503e-03_r8,0.20222e-03_r8 /) + kao(:, 4, 6) = (/ & + & 0.15769e-03_r8,0.16210e-03_r8,0.16597e-03_r8,0.16948e-03_r8,0.17817e-03_r8 /) + kao(:, 5, 6) = (/ & + & 0.13402e-03_r8,0.13792e-03_r8,0.14153e-03_r8,0.14434e-03_r8,0.15267e-03_r8 /) + kao(:, 6, 6) = (/ & + & 0.11390e-03_r8,0.11743e-03_r8,0.12065e-03_r8,0.12316e-03_r8,0.12543e-03_r8 /) + kao(:, 7, 6) = (/ & + & 0.96417e-04_r8,0.99612e-04_r8,0.10233e-03_r8,0.10453e-03_r8,0.10652e-03_r8 /) + kao(:, 8, 6) = (/ & + & 0.81395e-04_r8,0.84205e-04_r8,0.86346e-04_r8,0.88406e-04_r8,0.90122e-04_r8 /) + kao(:, 9, 6) = (/ & + & 0.47776e-04_r8,0.48971e-04_r8,0.49736e-04_r8,0.49917e-04_r8,0.50289e-04_r8 /) + kao(:,10, 6) = (/ & + & 0.10698e-03_r8,0.10815e-03_r8,0.10817e-03_r8,0.10799e-03_r8,0.10851e-03_r8 /) + kao(:,11, 6) = (/ & + & 0.20220e-03_r8,0.20727e-03_r8,0.21241e-03_r8,0.21675e-03_r8,0.21989e-03_r8 /) + kao(:,12, 6) = (/ & + & 0.23474e-03_r8,0.23601e-03_r8,0.23974e-03_r8,0.24383e-03_r8,0.24876e-03_r8 /) + kao(:,13, 6) = (/ & + & 0.23410e-03_r8,0.23809e-03_r8,0.24185e-03_r8,0.24554e-03_r8,0.24952e-03_r8 /) + kao(:, 1, 7) = (/ & + & 0.67024e-03_r8,0.68026e-03_r8,0.70419e-03_r8,0.70159e-03_r8,0.71089e-03_r8 /) + kao(:, 2, 7) = (/ & + & 0.58729e-03_r8,0.59778e-03_r8,0.62097e-03_r8,0.62912e-03_r8,0.62423e-03_r8 /) + kao(:, 3, 7) = (/ & + & 0.50967e-03_r8,0.51900e-03_r8,0.52765e-03_r8,0.54794e-03_r8,0.54266e-03_r8 /) + kao(:, 4, 7) = (/ & + & 0.44167e-03_r8,0.45006e-03_r8,0.45793e-03_r8,0.46469e-03_r8,0.48335e-03_r8 /) + kao(:, 5, 7) = (/ & + & 0.38096e-03_r8,0.38881e-03_r8,0.39576e-03_r8,0.40259e-03_r8,0.42086e-03_r8 /) + kao(:, 6, 7) = (/ & + & 0.32818e-03_r8,0.33539e-03_r8,0.34192e-03_r8,0.34829e-03_r8,0.35405e-03_r8 /) + kao(:, 7, 7) = (/ & + & 0.28259e-03_r8,0.28946e-03_r8,0.29584e-03_r8,0.30203e-03_r8,0.30742e-03_r8 /) + kao(:, 8, 7) = (/ & + & 0.24273e-03_r8,0.24912e-03_r8,0.25546e-03_r8,0.26110e-03_r8,0.26607e-03_r8 /) + kao(:, 9, 7) = (/ & + & 0.19937e-03_r8,0.20653e-03_r8,0.21314e-03_r8,0.21968e-03_r8,0.22520e-03_r8 /) + kao(:,10, 7) = (/ & + & 0.13306e-03_r8,0.13331e-03_r8,0.13393e-03_r8,0.13538e-03_r8,0.13616e-03_r8 /) + kao(:,11, 7) = (/ & + & 0.16236e-03_r8,0.16154e-03_r8,0.16187e-03_r8,0.16113e-03_r8,0.16209e-03_r8 /) + kao(:,12, 7) = (/ & + & 0.17872e-03_r8,0.18355e-03_r8,0.18612e-03_r8,0.18792e-03_r8,0.18745e-03_r8 /) + kao(:,13, 7) = (/ & + & 0.18970e-03_r8,0.19384e-03_r8,0.19773e-03_r8,0.20261e-03_r8,0.20377e-03_r8 /) + kao(:, 1, 8) = (/ & + & 0.18130e-02_r8,0.18305e-02_r8,0.18716e-02_r8,0.18655e-02_r8,0.18814e-02_r8 /) + kao(:, 2, 8) = (/ & + & 0.16420e-02_r8,0.16600e-02_r8,0.17006e-02_r8,0.17156e-02_r8,0.17108e-02_r8 /) + kao(:, 3, 8) = (/ & + & 0.14687e-02_r8,0.14870e-02_r8,0.15042e-02_r8,0.15423e-02_r8,0.15376e-02_r8 /) + kao(:, 4, 8) = (/ & + & 0.13068e-02_r8,0.13248e-02_r8,0.13421e-02_r8,0.13592e-02_r8,0.13960e-02_r8 /) + kao(:, 5, 8) = (/ & + & 0.11574e-02_r8,0.11753e-02_r8,0.11928e-02_r8,0.12097e-02_r8,0.12467e-02_r8 /) + kao(:, 6, 8) = (/ & + & 0.10167e-02_r8,0.10342e-02_r8,0.10515e-02_r8,0.10681e-02_r8,0.10840e-02_r8 /) + kao(:, 7, 8) = (/ & + & 0.88992e-03_r8,0.90662e-03_r8,0.92299e-03_r8,0.93844e-03_r8,0.95347e-03_r8 /) + kao(:, 8, 8) = (/ & + & 0.78445e-03_r8,0.80031e-03_r8,0.81639e-03_r8,0.83131e-03_r8,0.84631e-03_r8 /) + kao(:, 9, 8) = (/ & + & 0.69812e-03_r8,0.71312e-03_r8,0.72801e-03_r8,0.74222e-03_r8,0.75605e-03_r8 /) + kao(:,10, 8) = (/ & + & 0.32521e-03_r8,0.33835e-03_r8,0.35194e-03_r8,0.36381e-03_r8,0.37594e-03_r8 /) + kao(:,11, 8) = (/ & + & 0.31406e-03_r8,0.32013e-03_r8,0.32456e-03_r8,0.33261e-03_r8,0.33741e-03_r8 /) + kao(:,12, 8) = (/ & + & 0.28132e-03_r8,0.28732e-03_r8,0.29674e-03_r8,0.30509e-03_r8,0.31393e-03_r8 /) + kao(:,13, 8) = (/ & + & 0.25704e-03_r8,0.26316e-03_r8,0.27195e-03_r8,0.27732e-03_r8,0.28905e-03_r8 /) + kao(:, 1, 9) = (/ & + & 0.67370e-02_r8,0.67873e-02_r8,0.68896e-02_r8,0.68819e-02_r8,0.69268e-02_r8 /) + kao(:, 2, 9) = (/ & + & 0.63111e-02_r8,0.63622e-02_r8,0.64623e-02_r8,0.65060e-02_r8,0.65027e-02_r8 /) + kao(:, 3, 9) = (/ & + & 0.58834e-02_r8,0.59361e-02_r8,0.59858e-02_r8,0.60811e-02_r8,0.60806e-02_r8 /) + kao(:, 4, 9) = (/ & + & 0.54753e-02_r8,0.55309e-02_r8,0.55823e-02_r8,0.56306e-02_r8,0.57229e-02_r8 /) + kao(:, 5, 9) = (/ & + & 0.50781e-02_r8,0.51373e-02_r8,0.51895e-02_r8,0.52391e-02_r8,0.53328e-02_r8 /) + kao(:, 6, 9) = (/ & + & 0.46791e-02_r8,0.47408e-02_r8,0.47949e-02_r8,0.48470e-02_r8,0.48993e-02_r8 /) + kao(:, 7, 9) = (/ & + & 0.42724e-02_r8,0.43381e-02_r8,0.43951e-02_r8,0.44503e-02_r8,0.45061e-02_r8 /) + kao(:, 8, 9) = (/ & + & 0.38568e-02_r8,0.39254e-02_r8,0.39848e-02_r8,0.40431e-02_r8,0.41005e-02_r8 /) + kao(:, 9, 9) = (/ & + & 0.35657e-02_r8,0.36362e-02_r8,0.36994e-02_r8,0.37608e-02_r8,0.38215e-02_r8 /) + kao(:,10, 9) = (/ & + & 0.33774e-02_r8,0.34501e-02_r8,0.35171e-02_r8,0.35811e-02_r8,0.36450e-02_r8 /) + kao(:,11, 9) = (/ & + & 0.23923e-02_r8,0.24623e-02_r8,0.25263e-02_r8,0.25890e-02_r8,0.26517e-02_r8 /) + kao(:,12, 9) = (/ & + & 0.16959e-02_r8,0.17542e-02_r8,0.18077e-02_r8,0.18614e-02_r8,0.19187e-02_r8 /) + kao(:,13, 9) = (/ & + & 0.11732e-02_r8,0.12232e-02_r8,0.12712e-02_r8,0.13221e-02_r8,0.13677e-02_r8 /) + kao(:, 1,10) = (/ & + & 0.19604e-01_r8,0.19698e-01_r8,0.19938e-01_r8,0.19854e-01_r8,0.19950e-01_r8 /) + kao(:, 2,10) = (/ & + & 0.18714e-01_r8,0.18803e-01_r8,0.19035e-01_r8,0.19131e-01_r8,0.19102e-01_r8 /) + kao(:, 3,10) = (/ & + & 0.17676e-01_r8,0.17785e-01_r8,0.17904e-01_r8,0.18189e-01_r8,0.18156e-01_r8 /) + kao(:, 4,10) = (/ & + & 0.16662e-01_r8,0.16773e-01_r8,0.16908e-01_r8,0.17056e-01_r8,0.17303e-01_r8 /) + kao(:, 5,10) = (/ & + & 0.15655e-01_r8,0.15775e-01_r8,0.15942e-01_r8,0.16103e-01_r8,0.16359e-01_r8 /) + kao(:, 6,10) = (/ & + & 0.14694e-01_r8,0.14838e-01_r8,0.15029e-01_r8,0.15200e-01_r8,0.15320e-01_r8 /) + kao(:, 7,10) = (/ & + & 0.13797e-01_r8,0.13959e-01_r8,0.14174e-01_r8,0.14350e-01_r8,0.14471e-01_r8 /) + kao(:, 8,10) = (/ & + & 0.12902e-01_r8,0.13089e-01_r8,0.13313e-01_r8,0.13489e-01_r8,0.13626e-01_r8 /) + kao(:, 9,10) = (/ & + & 0.11897e-01_r8,0.12105e-01_r8,0.12333e-01_r8,0.12512e-01_r8,0.12656e-01_r8 /) + kao(:,10,10) = (/ & + & 0.11834e-01_r8,0.12072e-01_r8,0.12331e-01_r8,0.12548e-01_r8,0.12721e-01_r8 /) + kao(:,11,10) = (/ & + & 0.11416e-01_r8,0.11699e-01_r8,0.11968e-01_r8,0.12141e-01_r8,0.12311e-01_r8 /) + kao(:,12,10) = (/ & + & 0.10776e-01_r8,0.11070e-01_r8,0.11309e-01_r8,0.11507e-01_r8,0.11702e-01_r8 /) + kao(:,13,10) = (/ & + & 0.99577e-02_r8,0.10263e-01_r8,0.10492e-01_r8,0.10719e-01_r8,0.10951e-01_r8 /) + kao(:, 1,11) = (/ & + & 0.29783e-01_r8,0.29883e-01_r8,0.30210e-01_r8,0.30141e-01_r8,0.30248e-01_r8 /) + kao(:, 2,11) = (/ & + & 0.28562e-01_r8,0.28743e-01_r8,0.29186e-01_r8,0.29339e-01_r8,0.29258e-01_r8 /) + kao(:, 3,11) = (/ & + & 0.27212e-01_r8,0.27429e-01_r8,0.27654e-01_r8,0.28083e-01_r8,0.28023e-01_r8 /) + kao(:, 4,11) = (/ & + & 0.25949e-01_r8,0.26197e-01_r8,0.26424e-01_r8,0.26623e-01_r8,0.27069e-01_r8 /) + kao(:, 5,11) = (/ & + & 0.24686e-01_r8,0.24942e-01_r8,0.25176e-01_r8,0.25403e-01_r8,0.25908e-01_r8 /) + kao(:, 6,11) = (/ & + & 0.23430e-01_r8,0.23686e-01_r8,0.23923e-01_r8,0.24158e-01_r8,0.24433e-01_r8 /) + kao(:, 7,11) = (/ & + & 0.22171e-01_r8,0.22424e-01_r8,0.22653e-01_r8,0.22909e-01_r8,0.23203e-01_r8 /) + kao(:, 8,11) = (/ & + & 0.20928e-01_r8,0.21171e-01_r8,0.21407e-01_r8,0.21699e-01_r8,0.22018e-01_r8 /) + kao(:, 9,11) = (/ & + & 0.19076e-01_r8,0.19320e-01_r8,0.19548e-01_r8,0.19858e-01_r8,0.20150e-01_r8 /) + kao(:,10,11) = (/ & + & 0.19537e-01_r8,0.19788e-01_r8,0.20064e-01_r8,0.20391e-01_r8,0.20843e-01_r8 /) + kao(:,11,11) = (/ & + & 0.19137e-01_r8,0.19444e-01_r8,0.19793e-01_r8,0.20268e-01_r8,0.20695e-01_r8 /) + kao(:,12,11) = (/ & + & 0.18393e-01_r8,0.18715e-01_r8,0.19143e-01_r8,0.19652e-01_r8,0.20037e-01_r8 /) + kao(:,13,11) = (/ & + & 0.17255e-01_r8,0.17680e-01_r8,0.18170e-01_r8,0.18641e-01_r8,0.19010e-01_r8 /) + kao(:, 1,12) = (/ & + & 0.46641e-01_r8,0.46796e-01_r8,0.47107e-01_r8,0.46977e-01_r8,0.47093e-01_r8 /) + kao(:, 2,12) = (/ & + & 0.46819e-01_r8,0.46956e-01_r8,0.47337e-01_r8,0.47426e-01_r8,0.47339e-01_r8 /) + kao(:, 3,12) = (/ & + & 0.46276e-01_r8,0.46366e-01_r8,0.46462e-01_r8,0.46935e-01_r8,0.46862e-01_r8 /) + kao(:, 4,12) = (/ & + & 0.44986e-01_r8,0.45103e-01_r8,0.45287e-01_r8,0.45535e-01_r8,0.46152e-01_r8 /) + kao(:, 5,12) = (/ & + & 0.43367e-01_r8,0.43552e-01_r8,0.43761e-01_r8,0.44035e-01_r8,0.44674e-01_r8 /) + kao(:, 6,12) = (/ & + & 0.41584e-01_r8,0.41793e-01_r8,0.42020e-01_r8,0.42344e-01_r8,0.42701e-01_r8 /) + kao(:, 7,12) = (/ & + & 0.39785e-01_r8,0.40007e-01_r8,0.40269e-01_r8,0.40635e-01_r8,0.41003e-01_r8 /) + kao(:, 8,12) = (/ & + & 0.37918e-01_r8,0.38155e-01_r8,0.38468e-01_r8,0.38839e-01_r8,0.39210e-01_r8 /) + kao(:, 9,12) = (/ & + & 0.35060e-01_r8,0.35328e-01_r8,0.35698e-01_r8,0.36105e-01_r8,0.36551e-01_r8 /) + kao(:,10,12) = (/ & + & 0.35216e-01_r8,0.35547e-01_r8,0.35872e-01_r8,0.36327e-01_r8,0.36542e-01_r8 /) + kao(:,11,12) = (/ & + & 0.35158e-01_r8,0.35374e-01_r8,0.35869e-01_r8,0.36242e-01_r8,0.36691e-01_r8 /) + kao(:,12,12) = (/ & + & 0.34264e-01_r8,0.34598e-01_r8,0.35106e-01_r8,0.35505e-01_r8,0.36021e-01_r8 /) + kao(:,13,12) = (/ & + & 0.32716e-01_r8,0.33195e-01_r8,0.33830e-01_r8,0.34228e-01_r8,0.34925e-01_r8 /) + kao(:, 1,13) = (/ & + & 0.76084e-01_r8,0.76052e-01_r8,0.76051e-01_r8,0.75851e-01_r8,0.75753e-01_r8 /) + kao(:, 2,13) = (/ & + & 0.79580e-01_r8,0.79564e-01_r8,0.79664e-01_r8,0.79619e-01_r8,0.79414e-01_r8 /) + kao(:, 3,13) = (/ & + & 0.82218e-01_r8,0.82302e-01_r8,0.82367e-01_r8,0.82543e-01_r8,0.82246e-01_r8 /) + kao(:, 4,13) = (/ & + & 0.83613e-01_r8,0.83740e-01_r8,0.83824e-01_r8,0.83866e-01_r8,0.84103e-01_r8 /) + kao(:, 5,13) = (/ & + & 0.83913e-01_r8,0.84123e-01_r8,0.84289e-01_r8,0.84403e-01_r8,0.84840e-01_r8 /) + kao(:, 6,13) = (/ & + & 0.83159e-01_r8,0.83442e-01_r8,0.83718e-01_r8,0.83891e-01_r8,0.83993e-01_r8 /) + kao(:, 7,13) = (/ & + & 0.81401e-01_r8,0.81826e-01_r8,0.82202e-01_r8,0.82451e-01_r8,0.82656e-01_r8 /) + kao(:, 8,13) = (/ & + & 0.78949e-01_r8,0.79505e-01_r8,0.79978e-01_r8,0.80351e-01_r8,0.80690e-01_r8 /) + kao(:, 9,13) = (/ & + & 0.76002e-01_r8,0.76671e-01_r8,0.77279e-01_r8,0.77752e-01_r8,0.78257e-01_r8 /) + kao(:,10,13) = (/ & + & 0.69777e-01_r8,0.70425e-01_r8,0.71054e-01_r8,0.71706e-01_r8,0.72167e-01_r8 /) + kao(:,11,13) = (/ & + & 0.72929e-01_r8,0.73732e-01_r8,0.74323e-01_r8,0.75246e-01_r8,0.75786e-01_r8 /) + kao(:,12,13) = (/ & + & 0.73007e-01_r8,0.74429e-01_r8,0.74922e-01_r8,0.75916e-01_r8,0.76947e-01_r8 /) + kao(:,13,13) = (/ & + & 0.71376e-01_r8,0.72507e-01_r8,0.73710e-01_r8,0.74716e-01_r8,0.75702e-01_r8 /) + kao(:, 1,14) = (/ & + & 0.12585e+00_r8,0.12569e+00_r8,0.12576e+00_r8,0.12571e+00_r8,0.12570e+00_r8 /) + kao(:, 2,14) = (/ & + & 0.13868e+00_r8,0.13853e+00_r8,0.13849e+00_r8,0.13824e+00_r8,0.13803e+00_r8 /) + kao(:, 3,14) = (/ & + & 0.15142e+00_r8,0.15135e+00_r8,0.15112e+00_r8,0.15093e+00_r8,0.15074e+00_r8 /) + kao(:, 4,14) = (/ & + & 0.16359e+00_r8,0.16359e+00_r8,0.16339e+00_r8,0.16311e+00_r8,0.16285e+00_r8 /) + kao(:, 5,14) = (/ & + & 0.17462e+00_r8,0.17472e+00_r8,0.17456e+00_r8,0.17421e+00_r8,0.17393e+00_r8 /) + kao(:, 6,14) = (/ & + & 0.18403e+00_r8,0.18447e+00_r8,0.18450e+00_r8,0.18424e+00_r8,0.18395e+00_r8 /) + kao(:, 7,14) = (/ & + & 0.19179e+00_r8,0.19239e+00_r8,0.19256e+00_r8,0.19253e+00_r8,0.19252e+00_r8 /) + kao(:, 8,14) = (/ & + & 0.19772e+00_r8,0.19863e+00_r8,0.19901e+00_r8,0.19923e+00_r8,0.19947e+00_r8 /) + kao(:, 9,14) = (/ & + & 0.20154e+00_r8,0.20279e+00_r8,0.20355e+00_r8,0.20417e+00_r8,0.20473e+00_r8 /) + kao(:,10,14) = (/ & + & 0.18853e+00_r8,0.19028e+00_r8,0.19160e+00_r8,0.19253e+00_r8,0.19393e+00_r8 /) + kao(:,11,14) = (/ & + & 0.18013e+00_r8,0.18167e+00_r8,0.18320e+00_r8,0.18375e+00_r8,0.18507e+00_r8 /) + kao(:,12,14) = (/ & + & 0.19011e+00_r8,0.19027e+00_r8,0.19283e+00_r8,0.19402e+00_r8,0.19478e+00_r8 /) + kao(:,13,14) = (/ & + & 0.19594e+00_r8,0.19738e+00_r8,0.19911e+00_r8,0.20124e+00_r8,0.20282e+00_r8 /) + kao(:, 1,15) = (/ & + & 0.22369e+00_r8,0.22259e+00_r8,0.22155e+00_r8,0.22059e+00_r8,0.21997e+00_r8 /) + kao(:, 2,15) = (/ & + & 0.25602e+00_r8,0.25478e+00_r8,0.25377e+00_r8,0.25306e+00_r8,0.25237e+00_r8 /) + kao(:, 3,15) = (/ & + & 0.29258e+00_r8,0.29107e+00_r8,0.28998e+00_r8,0.28920e+00_r8,0.28830e+00_r8 /) + kao(:, 4,15) = (/ & + & 0.33067e+00_r8,0.32888e+00_r8,0.32753e+00_r8,0.32646e+00_r8,0.32566e+00_r8 /) + kao(:, 5,15) = (/ & + & 0.37114e+00_r8,0.36880e+00_r8,0.36713e+00_r8,0.36598e+00_r8,0.36499e+00_r8 /) + kao(:, 6,15) = (/ & + & 0.41494e+00_r8,0.41167e+00_r8,0.40935e+00_r8,0.40779e+00_r8,0.40636e+00_r8 /) + kao(:, 7,15) = (/ & + & 0.46115e+00_r8,0.45729e+00_r8,0.45455e+00_r8,0.45230e+00_r8,0.45004e+00_r8 /) + kao(:, 8,15) = (/ & + & 0.50906e+00_r8,0.50463e+00_r8,0.50137e+00_r8,0.49843e+00_r8,0.49550e+00_r8 /) + kao(:, 9,15) = (/ & + & 0.55829e+00_r8,0.55330e+00_r8,0.54936e+00_r8,0.54557e+00_r8,0.54168e+00_r8 /) + kao(:,10,15) = (/ & + & 0.60814e+00_r8,0.60274e+00_r8,0.59806e+00_r8,0.59326e+00_r8,0.58833e+00_r8 /) + kao(:,11,15) = (/ & + & 0.62954e+00_r8,0.62588e+00_r8,0.62076e+00_r8,0.61665e+00_r8,0.61184e+00_r8 /) + kao(:,12,15) = (/ & + & 0.62585e+00_r8,0.62437e+00_r8,0.61807e+00_r8,0.61303e+00_r8,0.60869e+00_r8 /) + kao(:,13,15) = (/ & + & 0.64856e+00_r8,0.64505e+00_r8,0.63861e+00_r8,0.63277e+00_r8,0.62702e+00_r8 /) + kao(:, 1,16) = (/ & + & 0.33327e+00_r8,0.33385e+00_r8,0.33538e+00_r8,0.33638e+00_r8,0.33736e+00_r8 /) + kao(:, 2,16) = (/ & + & 0.40916e+00_r8,0.40842e+00_r8,0.40848e+00_r8,0.40865e+00_r8,0.40854e+00_r8 /) + kao(:, 3,16) = (/ & + & 0.50099e+00_r8,0.49888e+00_r8,0.49727e+00_r8,0.49588e+00_r8,0.49422e+00_r8 /) + kao(:, 4,16) = (/ & + & 0.60389e+00_r8,0.60029e+00_r8,0.59704e+00_r8,0.59367e+00_r8,0.59071e+00_r8 /) + kao(:, 5,16) = (/ & + & 0.71868e+00_r8,0.71337e+00_r8,0.70835e+00_r8,0.70318e+00_r8,0.69852e+00_r8 /) + kao(:, 6,16) = (/ & + & 0.84815e+00_r8,0.84138e+00_r8,0.83446e+00_r8,0.82728e+00_r8,0.82023e+00_r8 /) + kao(:, 7,16) = (/ & + & 0.99512e+00_r8,0.98644e+00_r8,0.97698e+00_r8,0.96695e+00_r8,0.95712e+00_r8 /) + kao(:, 8,16) = (/ & + & 0.11606e+01_r8,0.11485e+01_r8,0.11354e+01_r8,0.11218e+01_r8,0.11077e+01_r8 /) + kao(:, 9,16) = (/ & + & 0.13444e+01_r8,0.13282e+01_r8,0.13102e+01_r8,0.12917e+01_r8,0.12735e+01_r8 /) + kao(:,10,16) = (/ & + & 0.15423e+01_r8,0.15207e+01_r8,0.14970e+01_r8,0.14733e+01_r8,0.14494e+01_r8 /) + kao(:,11,16) = (/ & + & 0.17462e+01_r8,0.17138e+01_r8,0.16827e+01_r8,0.16518e+01_r8,0.16199e+01_r8 /) + kao(:,12,16) = (/ & + & 0.19577e+01_r8,0.19145e+01_r8,0.18728e+01_r8,0.18320e+01_r8,0.17910e+01_r8 /) + kao(:,13,16) = (/ & + & 0.21716e+01_r8,0.21171e+01_r8,0.20639e+01_r8,0.20113e+01_r8,0.19587e+01_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.315770e-07_r8, 0.671978e-07_r8, 0.440649e-06_r8 /) + forrefo(:, 2) = (/ 0.313674e-06_r8, 0.285252e-06_r8, 0.421024e-05_r8 /) + forrefo(:, 3) = (/ 0.135818e-05_r8, 0.145071e-05_r8, 0.611285e-05_r8 /) + forrefo(:, 4) = (/ 0.534065e-05_r8, 0.586268e-05_r8, 0.933970e-05_r8 /) + forrefo(:, 5) = (/ 0.964007e-05_r8, 0.107110e-04_r8, 0.104486e-04_r8 /) + forrefo(:, 6) = (/ 0.302775e-04_r8, 0.357530e-04_r8, 0.340724e-04_r8 /) + forrefo(:, 7) = (/ 0.102437e-03_r8, 0.108475e-03_r8, 0.105245e-03_r8 /) + forrefo(:, 8) = (/ 0.146054e-03_r8, 0.141490e-03_r8, 0.133071e-03_r8 /) + forrefo(:, 9) = (/ 0.163978e-03_r8, 0.150208e-03_r8, 0.142864e-03_r8 /) + forrefo(:,10) = (/ 0.220412e-03_r8, 0.182943e-03_r8, 0.150941e-03_r8 /) + forrefo(:,11) = (/ 0.228877e-03_r8, 0.197679e-03_r8, 0.163220e-03_r8 /) + forrefo(:,12) = (/ 0.234177e-03_r8, 0.217734e-03_r8, 0.185038e-03_r8 /) + forrefo(:,13) = (/ 0.257187e-03_r8, 0.241570e-03_r8, 0.221178e-03_r8 /) + forrefo(:,14) = (/ 0.272455e-03_r8, 0.270637e-03_r8, 0.256269e-03_r8 /) + forrefo(:,15) = (/ 0.339445e-03_r8, 0.300268e-03_r8, 0.286574e-03_r8 /) + forrefo(:,16) = (/ 0.338841e-03_r8, 0.355428e-03_r8, 0.353794e-03_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.100945e-04_r8, 0.801113e-05_r8, 0.635771e-05_r8, 0.504554e-05_r8, 0.400419e-05_r8, & + & 0.317777e-05_r8, 0.252191e-05_r8, 0.200141e-05_r8, 0.158834e-05_r8, 0.126052e-05_r8 /) + selfrefo(:, 2) = (/ & + & 0.107573e-04_r8, 0.999809e-05_r8, 0.929245e-05_r8, 0.863661e-05_r8, 0.802706e-05_r8, & + & 0.746053e-05_r8, 0.693399e-05_r8, 0.644460e-05_r8, 0.598976e-05_r8, 0.556702e-05_r8 /) + selfrefo(:, 3) = (/ & + & 0.350389e-04_r8, 0.319234e-04_r8, 0.290850e-04_r8, 0.264989e-04_r8, 0.241428e-04_r8, & + & 0.219962e-04_r8, 0.200404e-04_r8, 0.182586e-04_r8, 0.166351e-04_r8, 0.151560e-04_r8 /) + selfrefo(:, 4) = (/ & + & 0.122993e-03_r8, 0.110885e-03_r8, 0.999691e-04_r8, 0.901277e-04_r8, 0.812551e-04_r8, & + & 0.732559e-04_r8, 0.660443e-04_r8, 0.595426e-04_r8, 0.536809e-04_r8, 0.483963e-04_r8 /) + selfrefo(:, 5) = (/ & + & 0.206434e-03_r8, 0.187435e-03_r8, 0.170185e-03_r8, 0.154522e-03_r8, 0.140301e-03_r8, & + & 0.127388e-03_r8, 0.115664e-03_r8, 0.105019e-03_r8, 0.953540e-04_r8, 0.865783e-04_r8 /) + selfrefo(:, 6) = (/ & + & 0.590645e-03_r8, 0.533109e-03_r8, 0.481177e-03_r8, 0.434305e-03_r8, 0.391998e-03_r8, & + & 0.353812e-03_r8, 0.319346e-03_r8, 0.288238e-03_r8, 0.260160e-03_r8, 0.234817e-03_r8 /) + selfrefo(:, 7) = (/ & + & 0.163029e-02_r8, 0.148773e-02_r8, 0.135763e-02_r8, 0.123891e-02_r8, 0.113057e-02_r8, & + & 0.103170e-02_r8, 0.941483e-03_r8, 0.859153e-03_r8, 0.784023e-03_r8, 0.715462e-03_r8 /) + selfrefo(:, 8) = (/ & + & 0.204528e-02_r8, 0.189258e-02_r8, 0.175128e-02_r8, 0.162053e-02_r8, 0.149954e-02_r8, & + & 0.138758e-02_r8, 0.128398e-02_r8, 0.118812e-02_r8, 0.109941e-02_r8, 0.101733e-02_r8 /) + selfrefo(:, 9) = (/ & + & 0.210589e-02_r8, 0.197078e-02_r8, 0.184434e-02_r8, 0.172601e-02_r8, 0.161528e-02_r8, & + & 0.151164e-02_r8, 0.141466e-02_r8, 0.132390e-02_r8, 0.123896e-02_r8, 0.115947e-02_r8 /) + selfrefo(:,10) = (/ & + & 0.245098e-02_r8, 0.233745e-02_r8, 0.222918e-02_r8, 0.212592e-02_r8, 0.202745e-02_r8, & + & 0.193353e-02_r8, 0.184397e-02_r8, 0.175856e-02_r8, 0.167710e-02_r8, 0.159941e-02_r8 /) + selfrefo(:,11) = (/ & + & 0.267460e-02_r8, 0.253325e-02_r8, 0.239936e-02_r8, 0.227255e-02_r8, 0.215244e-02_r8, & + & 0.203868e-02_r8, 0.193093e-02_r8, 0.182888e-02_r8, 0.173222e-02_r8, 0.164067e-02_r8 /) + selfrefo(:,12) = (/ & + & 0.304510e-02_r8, 0.283919e-02_r8, 0.264720e-02_r8, 0.246820e-02_r8, 0.230130e-02_r8, & + & 0.214568e-02_r8, 0.200059e-02_r8, 0.186531e-02_r8, 0.173918e-02_r8, 0.162157e-02_r8 /) + selfrefo(:,13) = (/ & + & 0.338445e-02_r8, 0.314719e-02_r8, 0.292655e-02_r8, 0.272139e-02_r8, 0.253060e-02_r8, & + & 0.235319e-02_r8, 0.218822e-02_r8, 0.203482e-02_r8, 0.189217e-02_r8, 0.175952e-02_r8 /) + selfrefo(:,14) = (/ & + & 0.388649e-02_r8, 0.357018e-02_r8, 0.327961e-02_r8, 0.301269e-02_r8, 0.276750e-02_r8, & + & 0.254226e-02_r8, 0.233535e-02_r8, 0.214528e-02_r8, 0.197068e-02_r8, 0.181029e-02_r8 /) + selfrefo(:,15) = (/ & + & 0.412547e-02_r8, 0.387413e-02_r8, 0.363810e-02_r8, 0.341646e-02_r8, 0.320831e-02_r8, & + & 0.301285e-02_r8, 0.282930e-02_r8, 0.265693e-02_r8, 0.249506e-02_r8, 0.234305e-02_r8 /) + selfrefo(:,16) = (/ & + & 0.534327e-02_r8, 0.482967e-02_r8, 0.436544e-02_r8, 0.394583e-02_r8, 0.356655e-02_r8, & + & 0.322373e-02_r8, 0.291387e-02_r8, 0.263378e-02_r8, 0.238062e-02_r8, 0.215179e-02_r8 /) + + end subroutine sw_kgb23 + +! ************************************************************************** + subroutine sw_kgb24 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg24, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + raylao, raylbo, abso3ao, abso3bo, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:,1) = (/ & + & 34.3610_r8 , 33.1240_r8, 31.3948_r8, 28.7248_r8, & + & 24.7884_r8 , 21.4892_r8, 17.3972_r8, 13.7928_r8, & + & 9.54462_r8 , 1.05002_r8,0.867332_r8,0.685753_r8, & + & 0.504718_r8,0.323112_r8,0.122183_r8, 1.70288e-02_r8 /) + sfluxrefo(:,2) = (/ & + & 34.2367_r8 , 32.4327_r8, 30.0863_r8, 28.2085_r8, & + & 25.6533_r8 , 22.3412_r8, 18.3112_r8, 13.8521_r8, & + & 9.51035_r8 , 1.04138_r8,0.863493_r8,0.682790_r8, & + & 0.504721_r8,0.323102_r8,0.122193_r8, 1.70288e-02_r8 /) + sfluxrefo(:,3) = (/ & + & 34.1883_r8 , 32.2479_r8, 30.2650_r8, 28.2914_r8, & + & 25.6626_r8 , 22.3163_r8, 18.3327_r8, 13.8508_r8, & + & 9.49190_r8 , 1.03672_r8,0.858272_r8,0.681485_r8, & + & 0.501363_r8,0.323110_r8,0.122183_r8, 1.70288e-02_r8 /) + sfluxrefo(:,4) = (/ & + & 34.1365_r8 , 32.2316_r8, 30.3325_r8, 28.3305_r8, & + & 25.6420_r8 , 22.3223_r8, 18.3411_r8, 13.8471_r8, & + & 9.47492_r8 , 1.03376_r8,0.855380_r8,0.679085_r8, & + & 0.497998_r8,0.323053_r8,0.122183_r8, 1.70288e-02_r8 /) + sfluxrefo(:,5) = (/ & + & 34.0460_r8 , 32.2795_r8, 30.4147_r8, 28.3123_r8, & + & 25.6438_r8 , 22.3238_r8, 18.3441_r8, 13.8528_r8, & + & 9.45222_r8 , 1.03058_r8,0.854037_r8,0.675554_r8, & + & 0.498344_r8,0.320072_r8,0.122193_r8, 1.70288e-02_r8 /) + sfluxrefo(:,6) = (/ & + & 33.9909_r8 , 32.3127_r8, 30.4854_r8, 28.3005_r8, & + & 25.6310_r8 , 22.3294_r8, 18.3459_r8, 13.8488_r8, & + & 9.43336_r8 , 1.02901_r8,0.852728_r8,0.672322_r8, & + & 0.498056_r8,0.317753_r8,0.122183_r8, 1.70288e-02_r8 /) + sfluxrefo(:,7) = (/ & + & 33.9225_r8 , 32.4097_r8, 30.5125_r8, 28.2810_r8, & + & 25.6387_r8 , 22.3080_r8, 18.3715_r8, 13.8248_r8, & + & 9.41834_r8 , 1.02735_r8,0.850807_r8,0.671379_r8, & + & 0.496975_r8,0.317158_r8,0.119297_r8, 1.70207e-02_r8 /) + sfluxrefo(:,8) = (/ & + & 33.8940_r8 , 32.4951_r8, 30.5494_r8, 28.2788_r8, & + & 25.5975_r8 , 22.3225_r8, 18.3358_r8, 13.8199_r8, & + & 9.40283_r8 , 1.02751_r8,0.850729_r8,0.670152_r8, & + & 0.494294_r8,0.315829_r8,0.116195_r8, 1.64138e-02_r8 /) + sfluxrefo(:,9) = (/ & + & 34.6501_r8 , 32.6690_r8, 30.2872_r8, 28.0955_r8, & + & 25.4662_r8 , 22.1446_r8, 18.2754_r8, 13.7573_r8, & + & 9.36645_r8 , 1.02356_r8,0.847154_r8,0.668519_r8, & + & 0.489186_r8,0.313790_r8,0.117074_r8, 1.60943e-02_r8 /) + +! Rayleigh extinction coefficient at all v + raylao(:,1) = (/ & + & 1.28405e-07_r8,1.45501e-07_r8,1.67272e-07_r8,1.94856e-07_r8, & + & 2.15248e-07_r8,2.34920e-07_r8,2.48558e-07_r8,1.80004e-07_r8, & + & 1.46504e-07_r8,1.31355e-07_r8,1.33562e-07_r8,1.35618e-07_r8, & + & 1.22412e-07_r8,1.19842e-07_r8,1.19924e-07_r8,1.20264e-07_r8 /) + raylao(:,2) = (/ & + & 1.41622e-07_r8,1.93436e-07_r8,2.25057e-07_r8,2.01025e-07_r8, & + & 1.85138e-07_r8,1.72672e-07_r8,1.64771e-07_r8,1.59312e-07_r8, & + & 1.44961e-07_r8,1.37448e-07_r8,1.37506e-07_r8,1.38081e-07_r8, & + & 1.22432e-07_r8,1.19844e-07_r8,1.19921e-07_r8,1.20287e-07_r8 /) + raylao(:,3) = (/ & + & 1.45382e-07_r8,1.97020e-07_r8,2.22781e-07_r8,1.96062e-07_r8, & + & 1.83495e-07_r8,1.72495e-07_r8,1.64910e-07_r8,1.58797e-07_r8, & + & 1.46208e-07_r8,1.42274e-07_r8,1.40445e-07_r8,1.39496e-07_r8, & + & 1.26940e-07_r8,1.19844e-07_r8,1.19921e-07_r8,1.20287e-07_r8 /) + raylao(:,4) = (/ & + & 1.48247e-07_r8,1.99958e-07_r8,2.18048e-07_r8,1.93896e-07_r8, & + & 1.83125e-07_r8,1.73244e-07_r8,1.64320e-07_r8,1.58298e-07_r8, & + & 1.48428e-07_r8,1.44769e-07_r8,1.43704e-07_r8,1.38498e-07_r8, & + & 1.31732e-07_r8,1.22299e-07_r8,1.19921e-07_r8,1.20287e-07_r8 /) + raylao(:,5) = (/ & + & 1.51343e-07_r8,1.99621e-07_r8,2.14563e-07_r8,1.93824e-07_r8, & + & 1.82992e-07_r8,1.73143e-07_r8,1.64587e-07_r8,1.57355e-07_r8, & + & 1.51198e-07_r8,1.46373e-07_r8,1.45438e-07_r8,1.38095e-07_r8, & + & 1.35026e-07_r8,1.27504e-07_r8,1.19921e-07_r8,1.20287e-07_r8 /) + raylao(:,6) = (/ & + & 1.54462e-07_r8,1.97610e-07_r8,2.11992e-07_r8,1.93831e-07_r8, & + & 1.83900e-07_r8,1.73125e-07_r8,1.64093e-07_r8,1.57651e-07_r8, & + & 1.53158e-07_r8,1.46843e-07_r8,1.44733e-07_r8,1.40611e-07_r8, & + & 1.37320e-07_r8,1.33932e-07_r8,1.20423e-07_r8,1.20287e-07_r8 /) + raylao(:,7) = (/ & + & 1.59068e-07_r8,1.92757e-07_r8,2.09865e-07_r8,1.95132e-07_r8, & + & 1.83641e-07_r8,1.73778e-07_r8,1.63215e-07_r8,1.59462e-07_r8, & + & 1.54331e-07_r8,1.46177e-07_r8,1.45819e-07_r8,1.43177e-07_r8, & + & 1.39797e-07_r8,1.36780e-07_r8,1.33385e-07_r8,1.20287e-07_r8 /) + raylao(:,8) = (/ & + & 1.62066e-07_r8,1.87529e-07_r8,2.07191e-07_r8,1.97788e-07_r8, & + & 1.84920e-07_r8,1.72951e-07_r8,1.65450e-07_r8,1.60344e-07_r8, & + & 1.54403e-07_r8,1.47679e-07_r8,1.47287e-07_r8,1.44951e-07_r8, & + & 1.42517e-07_r8,1.41107e-07_r8,1.48688e-07_r8,1.51127e-07_r8 /) + raylao(:,9) = (/ & + & 1.19177e-07_r8,1.86522e-07_r8,2.20324e-07_r8,2.13543e-07_r8, & + & 1.92198e-07_r8,1.81641e-07_r8,1.70092e-07_r8,1.65072e-07_r8, & + & 1.59804e-07_r8,1.56745e-07_r8,1.51235e-07_r8,1.51400e-07_r8, & + & 1.49635e-07_r8,1.48056e-07_r8,1.49046e-07_r8,1.51010e-07_r8 /) + + raylbo(:) = (/ & + & 1.23766e-07_r8,1.40524e-07_r8,1.61610e-07_r8,1.83232e-07_r8, & + & 2.02951e-07_r8,2.21367e-07_r8,2.38367e-07_r8,2.53019e-07_r8, & + & 2.12202e-07_r8,1.36977e-07_r8,1.39118e-07_r8,1.37097e-07_r8, & + & 1.33223e-07_r8,1.38695e-07_r8,1.19868e-07_r8,1.20062e-07_r8 /) + + abso3ao(:) = (/ & + & 8.03067e-02_r8,0.180926_r8 ,0.227484_r8 ,0.168015_r8 , & + & 0.138284_r8 ,0.114537_r8 ,9.50114e-02_r8,8.06816e-02_r8, & + & 6.76406e-02_r8,5.69802e-02_r8,5.63283e-02_r8,4.57592e-02_r8, & + & 4.21862e-02_r8,3.47949e-02_r8,2.65731e-02_r8,2.67628e-02_r8 /) + + abso3bo(:) = (/ & + & 2.94848e-02_r8,4.33642e-02_r8,6.70197e-02_r8,0.104990_r8 , & + & 0.156180_r8 ,0.214638_r8 ,0.266281_r8 ,0.317941_r8 , & + & 0.355327_r8 ,0.371241_r8 ,0.374396_r8 ,0.326847_r8 , & + & 0.126497_r8 ,6.95264e-02_r8,2.58175e-02_r8,2.52862e-02_r8 /) + + strrat = 0.124692_r8 + + layreffr = 1 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.73110e-09_r8,0.95257e-08_r8,0.84454e-08_r8,0.69367e-08_r8,0.55267e-08_r8, & + & 0.41107e-08_r8,0.32800e-08_r8,0.33548e-08_r8,0.22111e-08_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.71850e-09_r8,0.98856e-08_r8,0.88084e-08_r8,0.72442e-08_r8,0.57586e-08_r8, & + & 0.43475e-08_r8,0.34021e-08_r8,0.32425e-08_r8,0.21911e-08_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.57048e-09_r8,0.11944e-07_r8,0.10693e-07_r8,0.91787e-08_r8,0.75423e-08_r8, & + & 0.56949e-08_r8,0.43124e-08_r8,0.42335e-08_r8,0.57788e-08_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.45283e-09_r8,0.10517e-07_r8,0.93142e-08_r8,0.77267e-08_r8,0.61927e-08_r8, & + & 0.47485e-08_r8,0.34557e-08_r8,0.32691e-08_r8,0.21836e-08_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.40037e-09_r8,0.10599e-07_r8,0.93529e-08_r8,0.78411e-08_r8,0.63421e-08_r8, & + & 0.49082e-08_r8,0.36312e-08_r8,0.32874e-08_r8,0.21861e-08_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.77671e-09_r8,0.11163e-07_r8,0.95032e-08_r8,0.79805e-08_r8,0.60721e-08_r8, & + & 0.45440e-08_r8,0.31263e-08_r8,0.28631e-08_r8,0.19430e-08_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.85527e-09_r8,0.11271e-07_r8,0.97269e-08_r8,0.82280e-08_r8,0.62706e-08_r8, & + & 0.47926e-08_r8,0.32802e-08_r8,0.28152e-08_r8,0.19155e-08_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.85773e-09_r8,0.13292e-07_r8,0.11943e-07_r8,0.10177e-07_r8,0.81637e-08_r8, & + & 0.62054e-08_r8,0.44045e-08_r8,0.35504e-08_r8,0.48274e-08_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.76956e-09_r8,0.13343e-07_r8,0.12140e-07_r8,0.10403e-07_r8,0.83916e-08_r8, & + & 0.64414e-08_r8,0.46212e-08_r8,0.36611e-08_r8,0.46523e-08_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.53187e-09_r8,0.11759e-07_r8,0.10564e-07_r8,0.89416e-08_r8,0.69566e-08_r8, & + & 0.54336e-08_r8,0.36797e-08_r8,0.28238e-08_r8,0.18838e-08_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.99065e-09_r8,0.13223e-07_r8,0.11222e-07_r8,0.94282e-08_r8,0.74664e-08_r8, & + & 0.54084e-08_r8,0.35205e-08_r8,0.24806e-08_r8,0.20205e-08_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.98793e-09_r8,0.13673e-07_r8,0.11444e-07_r8,0.96735e-08_r8,0.76364e-08_r8, & + & 0.55809e-08_r8,0.37259e-08_r8,0.25419e-08_r8,0.20086e-08_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.10274e-08_r8,0.14243e-07_r8,0.12051e-07_r8,0.10168e-07_r8,0.80110e-08_r8, & + & 0.59129e-08_r8,0.38720e-08_r8,0.26806e-08_r8,0.19959e-08_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.10879e-08_r8,0.15991e-07_r8,0.14290e-07_r8,0.12193e-07_r8,0.99943e-08_r8, & + & 0.76411e-08_r8,0.49949e-08_r8,0.32117e-08_r8,0.45196e-08_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.10733e-08_r8,0.14460e-07_r8,0.12483e-07_r8,0.10703e-07_r8,0.84924e-08_r8, & + & 0.62896e-08_r8,0.42753e-08_r8,0.27408e-08_r8,0.19679e-08_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.11948e-08_r8,0.15804e-07_r8,0.13423e-07_r8,0.10964e-07_r8,0.86345e-08_r8, & + & 0.61421e-08_r8,0.39130e-08_r8,0.24271e-08_r8,0.26282e-08_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.12796e-08_r8,0.16985e-07_r8,0.14121e-07_r8,0.11784e-07_r8,0.93415e-08_r8, & + & 0.67310e-08_r8,0.43124e-08_r8,0.25170e-08_r8,0.26033e-08_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.12903e-08_r8,0.17863e-07_r8,0.14703e-07_r8,0.12387e-07_r8,0.99243e-08_r8, & + & 0.72283e-08_r8,0.46892e-08_r8,0.26092e-08_r8,0.25739e-08_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.13030e-08_r8,0.17982e-07_r8,0.14488e-07_r8,0.12389e-07_r8,0.10284e-07_r8, & + & 0.76192e-08_r8,0.50049e-08_r8,0.27184e-08_r8,0.25450e-08_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.13295e-08_r8,0.20084e-07_r8,0.17213e-07_r8,0.15086e-07_r8,0.12255e-07_r8, & + & 0.93192e-08_r8,0.61747e-08_r8,0.34151e-08_r8,0.50409e-08_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.14930e-08_r8,0.19740e-07_r8,0.16353e-07_r8,0.13382e-07_r8,0.10370e-07_r8, & + & 0.76167e-08_r8,0.46913e-08_r8,0.23740e-08_r8,0.37254e-08_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.15750e-08_r8,0.20826e-07_r8,0.17352e-07_r8,0.14080e-07_r8,0.11109e-07_r8, & + & 0.82293e-08_r8,0.51142e-08_r8,0.25900e-08_r8,0.36977e-08_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.16427e-08_r8,0.22313e-07_r8,0.18005e-07_r8,0.14545e-07_r8,0.11545e-07_r8, & + & 0.85987e-08_r8,0.53849e-08_r8,0.27523e-08_r8,0.36628e-08_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.17106e-08_r8,0.23821e-07_r8,0.18882e-07_r8,0.15226e-07_r8,0.12313e-07_r8, & + & 0.92367e-08_r8,0.58646e-08_r8,0.29020e-08_r8,0.36336e-08_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.17465e-08_r8,0.26750e-07_r8,0.22103e-07_r8,0.18690e-07_r8,0.15320e-07_r8, & + & 0.11508e-07_r8,0.77281e-08_r8,0.34929e-08_r8,0.69801e-08_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.17561e-08_r8,0.17298e-07_r8,0.18888e-07_r8,0.16164e-07_r8,0.12676e-07_r8, & + & 0.91128e-08_r8,0.57292e-08_r8,0.25945e-08_r8,0.52718e-08_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.19997e-08_r8,0.20866e-07_r8,0.20612e-07_r8,0.17467e-07_r8,0.13431e-07_r8, & + & 0.96178e-08_r8,0.60009e-08_r8,0.28959e-08_r8,0.52609e-08_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.21808e-08_r8,0.24689e-07_r8,0.22590e-07_r8,0.18672e-07_r8,0.14573e-07_r8, & + & 0.10599e-07_r8,0.66802e-08_r8,0.31104e-08_r8,0.52649e-08_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.22321e-08_r8,0.28043e-07_r8,0.23802e-07_r8,0.19473e-07_r8,0.15182e-07_r8, & + & 0.11372e-07_r8,0.73223e-08_r8,0.34820e-08_r8,0.52977e-08_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.23033e-08_r8,0.30784e-07_r8,0.25188e-07_r8,0.20376e-07_r8,0.16019e-07_r8, & + & 0.12009e-07_r8,0.77933e-08_r8,0.37322e-08_r8,0.52777e-08_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.22679e-08_r8,0.13507e-07_r8,0.20320e-07_r8,0.19549e-07_r8,0.15905e-07_r8, & + & 0.11277e-07_r8,0.68710e-08_r8,0.29328e-08_r8,0.79703e-08_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.25718e-08_r8,0.16957e-07_r8,0.24375e-07_r8,0.21175e-07_r8,0.17080e-07_r8, & + & 0.12233e-07_r8,0.77114e-08_r8,0.34113e-08_r8,0.79963e-08_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.27598e-08_r8,0.19896e-07_r8,0.28092e-07_r8,0.23059e-07_r8,0.18272e-07_r8, & + & 0.13117e-07_r8,0.84449e-08_r8,0.37817e-08_r8,0.79824e-08_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.28979e-08_r8,0.22997e-07_r8,0.29556e-07_r8,0.24211e-07_r8,0.19134e-07_r8, & + & 0.13799e-07_r8,0.90980e-08_r8,0.41849e-08_r8,0.79622e-08_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.31158e-08_r8,0.26193e-07_r8,0.32426e-07_r8,0.25685e-07_r8,0.19970e-07_r8, & + & 0.14504e-07_r8,0.96379e-08_r8,0.45034e-08_r8,0.78914e-08_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.27286e-08_r8,0.10085e-07_r8,0.15014e-07_r8,0.19090e-07_r8,0.19831e-07_r8, & + & 0.15054e-07_r8,0.91059e-08_r8,0.39324e-08_r8,0.14155e-07_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.30146e-08_r8,0.12680e-07_r8,0.19259e-07_r8,0.23896e-07_r8,0.21584e-07_r8, & + & 0.16217e-07_r8,0.99712e-08_r8,0.44108e-08_r8,0.14243e-07_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.35571e-08_r8,0.15989e-07_r8,0.23328e-07_r8,0.28003e-07_r8,0.22999e-07_r8, & + & 0.17316e-07_r8,0.10856e-07_r8,0.49279e-08_r8,0.13770e-07_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.40065e-08_r8,0.19481e-07_r8,0.27247e-07_r8,0.30922e-07_r8,0.24592e-07_r8, & + & 0.18005e-07_r8,0.11331e-07_r8,0.53242e-08_r8,0.13758e-07_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.44047e-08_r8,0.23368e-07_r8,0.31337e-07_r8,0.33478e-07_r8,0.26467e-07_r8, & + & 0.19093e-07_r8,0.12194e-07_r8,0.56088e-08_r8,0.13665e-07_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.32692e-08_r8,0.79127e-08_r8,0.11108e-07_r8,0.13962e-07_r8,0.15949e-07_r8, & + & 0.18125e-07_r8,0.12367e-07_r8,0.53666e-08_r8,0.28048e-07_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.39872e-08_r8,0.10056e-07_r8,0.14185e-07_r8,0.17838e-07_r8,0.20262e-07_r8, & + & 0.19824e-07_r8,0.13459e-07_r8,0.59111e-08_r8,0.29491e-07_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.46117e-08_r8,0.12472e-07_r8,0.17902e-07_r8,0.22130e-07_r8,0.25362e-07_r8, & + & 0.21745e-07_r8,0.14226e-07_r8,0.62741e-08_r8,0.30373e-07_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.52024e-08_r8,0.15275e-07_r8,0.21923e-07_r8,0.27295e-07_r8,0.30210e-07_r8, & + & 0.23240e-07_r8,0.15087e-07_r8,0.66869e-08_r8,0.31196e-07_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.56198e-08_r8,0.17975e-07_r8,0.26684e-07_r8,0.30762e-07_r8,0.34012e-07_r8, & + & 0.25509e-07_r8,0.16208e-07_r8,0.72951e-08_r8,0.31583e-07_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.48178e-08_r8,0.70531e-08_r8,0.93321e-08_r8,0.10834e-07_r8,0.12386e-07_r8, & + & 0.13718e-07_r8,0.14795e-07_r8,0.73464e-08_r8,0.35934e-07_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.55752e-08_r8,0.86985e-08_r8,0.11492e-07_r8,0.13823e-07_r8,0.15291e-07_r8, & + & 0.17278e-07_r8,0.18153e-07_r8,0.81439e-08_r8,0.37177e-07_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.63274e-08_r8,0.10735e-07_r8,0.13985e-07_r8,0.17136e-07_r8,0.19303e-07_r8, & + & 0.20940e-07_r8,0.20044e-07_r8,0.88008e-08_r8,0.38431e-07_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.70007e-08_r8,0.12858e-07_r8,0.17195e-07_r8,0.20946e-07_r8,0.23543e-07_r8, & + & 0.25732e-07_r8,0.21748e-07_r8,0.95846e-08_r8,0.39768e-07_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.75858e-08_r8,0.15576e-07_r8,0.20803e-07_r8,0.25331e-07_r8,0.28222e-07_r8, & + & 0.30974e-07_r8,0.23346e-07_r8,0.10532e-07_r8,0.41126e-07_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.71066e-08_r8,0.91105e-08_r8,0.91823e-08_r8,0.10078e-07_r8,0.11080e-07_r8, & + & 0.11808e-07_r8,0.12592e-07_r8,0.10585e-07_r8,0.36646e-07_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.75651e-08_r8,0.10196e-07_r8,0.11288e-07_r8,0.12341e-07_r8,0.13264e-07_r8, & + & 0.14635e-07_r8,0.15304e-07_r8,0.12113e-07_r8,0.37821e-07_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.84521e-08_r8,0.11641e-07_r8,0.13494e-07_r8,0.15134e-07_r8,0.16494e-07_r8, & + & 0.17667e-07_r8,0.18637e-07_r8,0.13998e-07_r8,0.39151e-07_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.96535e-08_r8,0.13091e-07_r8,0.16210e-07_r8,0.18132e-07_r8,0.20108e-07_r8, & + & 0.21506e-07_r8,0.22578e-07_r8,0.15372e-07_r8,0.40534e-07_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.10866e-07_r8,0.15259e-07_r8,0.19222e-07_r8,0.21816e-07_r8,0.23808e-07_r8, & + & 0.25779e-07_r8,0.26640e-07_r8,0.16560e-07_r8,0.41783e-07_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.80834e-08_r8,0.10420e-07_r8,0.92387e-08_r8,0.95448e-08_r8,0.10004e-07_r8, & + & 0.10210e-07_r8,0.10715e-07_r8,0.12956e-07_r8,0.37307e-07_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.93300e-08_r8,0.11721e-07_r8,0.10935e-07_r8,0.11240e-07_r8,0.12099e-07_r8, & + & 0.12529e-07_r8,0.12978e-07_r8,0.14968e-07_r8,0.38619e-07_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.10509e-07_r8,0.12830e-07_r8,0.12793e-07_r8,0.13649e-07_r8,0.14634e-07_r8, & + & 0.15024e-07_r8,0.15635e-07_r8,0.17087e-07_r8,0.40001e-07_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.11973e-07_r8,0.14173e-07_r8,0.14811e-07_r8,0.16236e-07_r8,0.17652e-07_r8, & + & 0.18139e-07_r8,0.18897e-07_r8,0.19167e-07_r8,0.41426e-07_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.13412e-07_r8,0.16145e-07_r8,0.17438e-07_r8,0.18946e-07_r8,0.20873e-07_r8, & + & 0.21649e-07_r8,0.22446e-07_r8,0.20222e-07_r8,0.42866e-07_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.96752e-08_r8,0.12525e-07_r8,0.10944e-07_r8,0.96402e-08_r8,0.92613e-08_r8, & + & 0.89183e-08_r8,0.91757e-08_r8,0.10962e-07_r8,0.37700e-07_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.10573e-07_r8,0.14013e-07_r8,0.12095e-07_r8,0.11243e-07_r8,0.11108e-07_r8, & + & 0.10880e-07_r8,0.11099e-07_r8,0.12700e-07_r8,0.39054e-07_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.12096e-07_r8,0.15476e-07_r8,0.13719e-07_r8,0.13357e-07_r8,0.13060e-07_r8, & + & 0.13122e-07_r8,0.13232e-07_r8,0.14320e-07_r8,0.40767e-07_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.13461e-07_r8,0.16674e-07_r8,0.15454e-07_r8,0.15611e-07_r8,0.15616e-07_r8, & + & 0.15505e-07_r8,0.16233e-07_r8,0.16510e-07_r8,0.42192e-07_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.14863e-07_r8,0.17307e-07_r8,0.17245e-07_r8,0.18041e-07_r8,0.18314e-07_r8, & + & 0.18445e-07_r8,0.19222e-07_r8,0.18635e-07_r8,0.43353e-07_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.11698e-08_r8,0.30848e-07_r8,0.36454e-07_r8,0.38710e-07_r8,0.45901e-07_r8, & + & 0.55227e-07_r8,0.66976e-07_r8,0.88407e-07_r8,0.23422e-07_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.11855e-08_r8,0.31924e-07_r8,0.37139e-07_r8,0.40576e-07_r8,0.48515e-07_r8, & + & 0.57453e-07_r8,0.68267e-07_r8,0.87661e-07_r8,0.23548e-07_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.14595e-08_r8,0.39594e-07_r8,0.49562e-07_r8,0.62806e-07_r8,0.77187e-07_r8, & + & 0.93412e-07_r8,0.11204e-06_r8,0.13944e-06_r8,0.36327e-07_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.16033e-08_r8,0.32903e-07_r8,0.39616e-07_r8,0.43600e-07_r8,0.51878e-07_r8, & + & 0.61189e-07_r8,0.71838e-07_r8,0.88579e-07_r8,0.23754e-07_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.16713e-08_r8,0.33816e-07_r8,0.40271e-07_r8,0.44761e-07_r8,0.53112e-07_r8, & + & 0.62817e-07_r8,0.73214e-07_r8,0.89918e-07_r8,0.23712e-07_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.14413e-08_r8,0.29542e-07_r8,0.33672e-07_r8,0.38233e-07_r8,0.38429e-07_r8, & + & 0.45175e-07_r8,0.55138e-07_r8,0.73579e-07_r8,0.25050e-07_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.13819e-08_r8,0.33839e-07_r8,0.35660e-07_r8,0.39637e-07_r8,0.40862e-07_r8, & + & 0.47496e-07_r8,0.56716e-07_r8,0.72256e-07_r8,0.25722e-07_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.14034e-08_r8,0.38888e-07_r8,0.49224e-07_r8,0.54694e-07_r8,0.64529e-07_r8, & + & 0.76758e-07_r8,0.91615e-07_r8,0.11521e-06_r8,0.39473e-07_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.15427e-08_r8,0.40736e-07_r8,0.49562e-07_r8,0.55626e-07_r8,0.65520e-07_r8, & + & 0.77421e-07_r8,0.92434e-07_r8,0.11487e-06_r8,0.39089e-07_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.19146e-08_r8,0.37020e-07_r8,0.37998e-07_r8,0.40828e-07_r8,0.46417e-07_r8, & + & 0.52511e-07_r8,0.60306e-07_r8,0.73583e-07_r8,0.26882e-07_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.16720e-08_r8,0.23360e-07_r8,0.34106e-07_r8,0.35883e-07_r8,0.37371e-07_r8, & + & 0.37719e-07_r8,0.44564e-07_r8,0.59521e-07_r8,0.60171e-07_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.17699e-08_r8,0.26546e-07_r8,0.36000e-07_r8,0.36846e-07_r8,0.38381e-07_r8, & + & 0.39667e-07_r8,0.46368e-07_r8,0.60306e-07_r8,0.60604e-07_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.18009e-08_r8,0.29450e-07_r8,0.37614e-07_r8,0.38630e-07_r8,0.39041e-07_r8, & + & 0.41600e-07_r8,0.48142e-07_r8,0.59638e-07_r8,0.61274e-07_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.18222e-08_r8,0.39219e-07_r8,0.48109e-07_r8,0.53485e-07_r8,0.57150e-07_r8, & + & 0.64444e-07_r8,0.75574e-07_r8,0.94813e-07_r8,0.76759e-07_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.18210e-08_r8,0.34020e-07_r8,0.40366e-07_r8,0.41710e-07_r8,0.42164e-07_r8, & + & 0.45001e-07_r8,0.49878e-07_r8,0.60009e-07_r8,0.61481e-07_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.21152e-08_r8,0.23706e-07_r8,0.29784e-07_r8,0.35302e-07_r8,0.35282e-07_r8, & + & 0.34361e-07_r8,0.35938e-07_r8,0.47065e-07_r8,0.17050e-06_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.22014e-08_r8,0.24318e-07_r8,0.33239e-07_r8,0.37390e-07_r8,0.36975e-07_r8, & + & 0.35774e-07_r8,0.38207e-07_r8,0.49025e-07_r8,0.17312e-06_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.21940e-08_r8,0.26005e-07_r8,0.37067e-07_r8,0.38353e-07_r8,0.38894e-07_r8, & + & 0.37527e-07_r8,0.40105e-07_r8,0.50082e-07_r8,0.17777e-06_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.23140e-08_r8,0.28378e-07_r8,0.41743e-07_r8,0.40523e-07_r8,0.40492e-07_r8, & + & 0.38652e-07_r8,0.40876e-07_r8,0.49640e-07_r8,0.18336e-06_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.23213e-08_r8,0.34154e-07_r8,0.50461e-07_r8,0.52357e-07_r8,0.54187e-07_r8, & + & 0.57113e-07_r8,0.62843e-07_r8,0.77605e-07_r8,0.21695e-06_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.26738e-08_r8,0.26329e-07_r8,0.23971e-07_r8,0.31112e-07_r8,0.35671e-07_r8, & + & 0.34087e-07_r8,0.29799e-07_r8,0.37789e-07_r8,0.52514e-06_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.25455e-08_r8,0.28564e-07_r8,0.26376e-07_r8,0.34876e-07_r8,0.38195e-07_r8, & + & 0.36126e-07_r8,0.31889e-07_r8,0.38787e-07_r8,0.53894e-06_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.27955e-08_r8,0.30168e-07_r8,0.29598e-07_r8,0.39256e-07_r8,0.39488e-07_r8, & + & 0.38121e-07_r8,0.34110e-07_r8,0.40225e-07_r8,0.55617e-06_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.30518e-08_r8,0.31696e-07_r8,0.32642e-07_r8,0.43581e-07_r8,0.40810e-07_r8, & + & 0.38887e-07_r8,0.35568e-07_r8,0.41837e-07_r8,0.57141e-06_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.29545e-08_r8,0.34626e-07_r8,0.42873e-07_r8,0.52742e-07_r8,0.53043e-07_r8, & + & 0.52428e-07_r8,0.54304e-07_r8,0.64247e-07_r8,0.63906e-06_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.30127e-08_r8,0.42606e-07_r8,0.28980e-07_r8,0.24923e-07_r8,0.29265e-07_r8, & + & 0.34534e-07_r8,0.31090e-07_r8,0.30814e-07_r8,0.12844e-05_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.33504e-08_r8,0.42102e-07_r8,0.30491e-07_r8,0.27666e-07_r8,0.33477e-07_r8, & + & 0.35643e-07_r8,0.33324e-07_r8,0.31448e-07_r8,0.13231e-05_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.37714e-08_r8,0.40516e-07_r8,0.32080e-07_r8,0.30623e-07_r8,0.37391e-07_r8, & + & 0.37255e-07_r8,0.35144e-07_r8,0.32296e-07_r8,0.13598e-05_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.40809e-08_r8,0.41419e-07_r8,0.33638e-07_r8,0.33756e-07_r8,0.41072e-07_r8, & + & 0.38814e-07_r8,0.36264e-07_r8,0.33664e-07_r8,0.13955e-05_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.38112e-08_r8,0.42764e-07_r8,0.35694e-07_r8,0.36747e-07_r8,0.45193e-07_r8, & + & 0.40460e-07_r8,0.37371e-07_r8,0.35107e-07_r8,0.14282e-05_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.36577e-08_r8,0.64857e-07_r8,0.37268e-07_r8,0.28977e-07_r8,0.24480e-07_r8, & + & 0.26864e-07_r8,0.30486e-07_r8,0.25122e-07_r8,0.20521e-05_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.39427e-08_r8,0.65731e-07_r8,0.37248e-07_r8,0.30585e-07_r8,0.26773e-07_r8, & + & 0.30114e-07_r8,0.31576e-07_r8,0.26187e-07_r8,0.21480e-05_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.43811e-08_r8,0.66809e-07_r8,0.38170e-07_r8,0.32043e-07_r8,0.28837e-07_r8, & + & 0.34005e-07_r8,0.32765e-07_r8,0.27322e-07_r8,0.22122e-05_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.46591e-08_r8,0.68244e-07_r8,0.41020e-07_r8,0.34183e-07_r8,0.31347e-07_r8, & + & 0.37946e-07_r8,0.34473e-07_r8,0.28264e-07_r8,0.22876e-05_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.51635e-08_r8,0.69768e-07_r8,0.42241e-07_r8,0.36125e-07_r8,0.34689e-07_r8, & + & 0.41422e-07_r8,0.36208e-07_r8,0.29319e-07_r8,0.23528e-05_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.48063e-08_r8,0.99492e-07_r8,0.67977e-07_r8,0.40583e-07_r8,0.27462e-07_r8, & + & 0.23261e-07_r8,0.24790e-07_r8,0.24175e-07_r8,0.34404e-05_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.46794e-08_r8,0.10207e-06_r8,0.68838e-07_r8,0.41170e-07_r8,0.30068e-07_r8, & + & 0.24536e-07_r8,0.27696e-07_r8,0.25318e-07_r8,0.35579e-05_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.51560e-08_r8,0.10436e-06_r8,0.69782e-07_r8,0.42105e-07_r8,0.32065e-07_r8, & + & 0.26776e-07_r8,0.30613e-07_r8,0.26859e-07_r8,0.36807e-05_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.59944e-08_r8,0.10484e-06_r8,0.71027e-07_r8,0.44319e-07_r8,0.34843e-07_r8, & + & 0.29788e-07_r8,0.33876e-07_r8,0.28922e-07_r8,0.37740e-05_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.64682e-08_r8,0.10541e-06_r8,0.71736e-07_r8,0.46124e-07_r8,0.36934e-07_r8, & + & 0.32173e-07_r8,0.36502e-07_r8,0.30991e-07_r8,0.38805e-05_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.56433e-08_r8,0.13757e-06_r8,0.10641e-06_r8,0.72870e-07_r8,0.43453e-07_r8, & + & 0.25530e-07_r8,0.19778e-07_r8,0.25383e-07_r8,0.95912e-05_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.61882e-08_r8,0.14041e-06_r8,0.11046e-06_r8,0.75424e-07_r8,0.44204e-07_r8, & + & 0.28513e-07_r8,0.22344e-07_r8,0.27258e-07_r8,0.98257e-05_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.68724e-08_r8,0.14355e-06_r8,0.11272e-06_r8,0.76977e-07_r8,0.44934e-07_r8, & + & 0.30972e-07_r8,0.24609e-07_r8,0.29074e-07_r8,0.10035e-04_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.75288e-08_r8,0.14628e-06_r8,0.11397e-06_r8,0.77508e-07_r8,0.45913e-07_r8, & + & 0.33498e-07_r8,0.27308e-07_r8,0.31237e-07_r8,0.10206e-04_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.82361e-08_r8,0.14989e-06_r8,0.11575e-06_r8,0.78052e-07_r8,0.47282e-07_r8, & + & 0.34986e-07_r8,0.29571e-07_r8,0.31933e-07_r8,0.10332e-04_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.80705e-08_r8,0.18916e-06_r8,0.16332e-06_r8,0.12182e-06_r8,0.80167e-07_r8, & + & 0.44659e-07_r8,0.24027e-07_r8,0.20514e-07_r8,0.18076e-04_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.86522e-08_r8,0.19825e-06_r8,0.16839e-06_r8,0.12817e-06_r8,0.85984e-07_r8, & + & 0.48117e-07_r8,0.24937e-07_r8,0.22855e-07_r8,0.18392e-04_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.93838e-08_r8,0.20474e-06_r8,0.17472e-06_r8,0.13185e-06_r8,0.89897e-07_r8, & + & 0.50484e-07_r8,0.27069e-07_r8,0.24729e-07_r8,0.18827e-04_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.10442e-07_r8,0.21110e-06_r8,0.17958e-06_r8,0.13546e-06_r8,0.92462e-07_r8, & + & 0.51368e-07_r8,0.29958e-07_r8,0.26382e-07_r8,0.19325e-04_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.11203e-07_r8,0.21676e-06_r8,0.18359e-06_r8,0.14012e-06_r8,0.94090e-07_r8, & + & 0.51431e-07_r8,0.32637e-07_r8,0.27900e-07_r8,0.19654e-04_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.10898e-07_r8,0.20490e-06_r8,0.23352e-06_r8,0.18592e-06_r8,0.13108e-06_r8, & + & 0.82594e-07_r8,0.41478e-07_r8,0.20359e-07_r8,0.24656e-04_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.12100e-07_r8,0.21595e-06_r8,0.24259e-06_r8,0.19598e-06_r8,0.14307e-06_r8, & + & 0.90287e-07_r8,0.44897e-07_r8,0.21400e-07_r8,0.25439e-04_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.12997e-07_r8,0.22559e-06_r8,0.25028e-06_r8,0.20624e-06_r8,0.15074e-06_r8, & + & 0.95763e-07_r8,0.46972e-07_r8,0.22656e-07_r8,0.26128e-04_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.12774e-07_r8,0.23494e-06_r8,0.26130e-06_r8,0.21398e-06_r8,0.15730e-06_r8, & + & 0.98985e-07_r8,0.48309e-07_r8,0.24026e-07_r8,0.26834e-04_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.13184e-07_r8,0.24219e-06_r8,0.26811e-06_r8,0.22059e-06_r8,0.16314e-06_r8, & + & 0.10271e-06_r8,0.49802e-07_r8,0.25441e-07_r8,0.27644e-04_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.11394e-07_r8,0.19172e-06_r8,0.27076e-06_r8,0.23579e-06_r8,0.17648e-06_r8, & + & 0.11366e-06_r8,0.56463e-07_r8,0.20869e-07_r8,0.27151e-04_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.12908e-07_r8,0.20309e-06_r8,0.28462e-06_r8,0.24753e-06_r8,0.18719e-06_r8, & + & 0.12033e-06_r8,0.60157e-07_r8,0.21646e-07_r8,0.27962e-04_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.13752e-07_r8,0.21619e-06_r8,0.29476e-06_r8,0.25594e-06_r8,0.19641e-06_r8, & + & 0.12734e-06_r8,0.64272e-07_r8,0.22557e-07_r8,0.28912e-04_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.14906e-07_r8,0.22665e-06_r8,0.30298e-06_r8,0.26272e-06_r8,0.20331e-06_r8, & + & 0.13316e-06_r8,0.68243e-07_r8,0.23417e-07_r8,0.29816e-04_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.15969e-07_r8,0.23477e-06_r8,0.31068e-06_r8,0.27029e-06_r8,0.20850e-06_r8, & + & 0.13902e-06_r8,0.71857e-07_r8,0.25264e-07_r8,0.30765e-04_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.13593e-07_r8,0.19801e-06_r8,0.26490e-06_r8,0.27826e-06_r8,0.22531e-06_r8, & + & 0.15112e-06_r8,0.78691e-07_r8,0.27273e-07_r8,0.28055e-04_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.15426e-07_r8,0.20839e-06_r8,0.27732e-06_r8,0.28785e-06_r8,0.23371e-06_r8, & + & 0.16027e-06_r8,0.86131e-07_r8,0.29011e-07_r8,0.29165e-04_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.16638e-07_r8,0.21808e-06_r8,0.28896e-06_r8,0.29666e-06_r8,0.24201e-06_r8, & + & 0.16845e-06_r8,0.91791e-07_r8,0.30670e-07_r8,0.30372e-04_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.17929e-07_r8,0.22577e-06_r8,0.29798e-06_r8,0.30533e-06_r8,0.24895e-06_r8, & + & 0.17573e-06_r8,0.96085e-07_r8,0.31360e-07_r8,0.31437e-04_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.18861e-07_r8,0.23397e-06_r8,0.30715e-06_r8,0.31382e-06_r8,0.25665e-06_r8, & + & 0.18246e-06_r8,0.10017e-06_r8,0.32454e-07_r8,0.32266e-04_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.39751e-08_r8,0.10094e-06_r8,0.20247e-06_r8,0.30028e-06_r8,0.39102e-06_r8, & + & 0.48711e-06_r8,0.59106e-06_r8,0.72709e-06_r8,0.20885e-06_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.43080e-08_r8,0.10546e-06_r8,0.20982e-06_r8,0.31135e-06_r8,0.40303e-06_r8, & + & 0.49632e-06_r8,0.59855e-06_r8,0.74477e-06_r8,0.21012e-06_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.42986e-08_r8,0.15269e-06_r8,0.29890e-06_r8,0.43493e-06_r8,0.56429e-06_r8, & + & 0.69336e-06_r8,0.83181e-06_r8,0.10423e-05_r8,0.36557e-06_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.43554e-08_r8,0.11271e-06_r8,0.22069e-06_r8,0.32651e-06_r8,0.42391e-06_r8, & + & 0.51393e-06_r8,0.61294e-06_r8,0.75229e-06_r8,0.20945e-06_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.45047e-08_r8,0.11576e-06_r8,0.22657e-06_r8,0.33173e-06_r8,0.43142e-06_r8, & + & 0.52151e-06_r8,0.61871e-06_r8,0.74980e-06_r8,0.20891e-06_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.46065e-08_r8,0.81519e-07_r8,0.15960e-06_r8,0.23610e-06_r8,0.31656e-06_r8, & + & 0.39839e-06_r8,0.48591e-06_r8,0.60182e-06_r8,0.18230e-06_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.46837e-08_r8,0.82106e-07_r8,0.16429e-06_r8,0.24471e-06_r8,0.32626e-06_r8, & + & 0.40531e-06_r8,0.49330e-06_r8,0.61810e-06_r8,0.18355e-06_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.50163e-08_r8,0.12328e-06_r8,0.23602e-06_r8,0.35332e-06_r8,0.46387e-06_r8, & + & 0.57515e-06_r8,0.69445e-06_r8,0.88167e-06_r8,0.30546e-06_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.49809e-08_r8,0.12454e-06_r8,0.23839e-06_r8,0.35429e-06_r8,0.46515e-06_r8, & + & 0.57491e-06_r8,0.69031e-06_r8,0.86630e-06_r8,0.29807e-06_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.51988e-08_r8,0.91291e-07_r8,0.17869e-06_r8,0.26485e-06_r8,0.34907e-06_r8, & + & 0.42509e-06_r8,0.50894e-06_r8,0.62361e-06_r8,0.18234e-06_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.51916e-08_r8,0.88867e-07_r8,0.12220e-06_r8,0.18411e-06_r8,0.24720e-06_r8, & + & 0.32303e-06_r8,0.39526e-06_r8,0.49595e-06_r8,0.27125e-06_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.56319e-08_r8,0.87189e-07_r8,0.12678e-06_r8,0.19176e-06_r8,0.25624e-06_r8, & + & 0.32740e-06_r8,0.40564e-06_r8,0.50601e-06_r8,0.28010e-06_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.59026e-08_r8,0.86017e-07_r8,0.13043e-06_r8,0.19649e-06_r8,0.26497e-06_r8, & + & 0.33305e-06_r8,0.40679e-06_r8,0.51963e-06_r8,0.28660e-06_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.59909e-08_r8,0.10759e-06_r8,0.18790e-06_r8,0.28104e-06_r8,0.37702e-06_r8, & + & 0.47222e-06_r8,0.57322e-06_r8,0.72906e-06_r8,0.37657e-06_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.64422e-08_r8,0.89472e-07_r8,0.13687e-06_r8,0.20453e-06_r8,0.27802e-06_r8, & + & 0.34266e-06_r8,0.41565e-06_r8,0.51746e-06_r8,0.29675e-06_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.62298e-08_r8,0.99509e-07_r8,0.10306e-06_r8,0.14232e-06_r8,0.19390e-06_r8, & + & 0.25435e-06_r8,0.31764e-06_r8,0.40578e-06_r8,0.49031e-06_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.68419e-08_r8,0.10415e-06_r8,0.10349e-06_r8,0.14672e-06_r8,0.19860e-06_r8, & + & 0.26012e-06_r8,0.32720e-06_r8,0.41327e-06_r8,0.51522e-06_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.71418e-08_r8,0.10626e-06_r8,0.10522e-06_r8,0.15175e-06_r8,0.20471e-06_r8, & + & 0.26435e-06_r8,0.33148e-06_r8,0.42294e-06_r8,0.53456e-06_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.72470e-08_r8,0.10891e-06_r8,0.10648e-06_r8,0.15457e-06_r8,0.21007e-06_r8, & + & 0.26937e-06_r8,0.33376e-06_r8,0.42939e-06_r8,0.55207e-06_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.77585e-08_r8,0.12954e-06_r8,0.14999e-06_r8,0.22224e-06_r8,0.29994e-06_r8, & + & 0.38053e-06_r8,0.47027e-06_r8,0.60032e-06_r8,0.76592e-06_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.68852e-08_r8,0.11288e-06_r8,0.11969e-06_r8,0.11689e-06_r8,0.14994e-06_r8, & + & 0.19637e-06_r8,0.25309e-06_r8,0.33018e-06_r8,0.84551e-06_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.75119e-08_r8,0.11838e-06_r8,0.12255e-06_r8,0.11926e-06_r8,0.15341e-06_r8, & + & 0.20169e-06_r8,0.26231e-06_r8,0.33745e-06_r8,0.85714e-06_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.84416e-08_r8,0.12128e-06_r8,0.12324e-06_r8,0.12015e-06_r8,0.15812e-06_r8, & + & 0.20463e-06_r8,0.26808e-06_r8,0.34461e-06_r8,0.86734e-06_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.92293e-08_r8,0.12493e-06_r8,0.12330e-06_r8,0.12093e-06_r8,0.16146e-06_r8, & + & 0.20899e-06_r8,0.26904e-06_r8,0.35101e-06_r8,0.88204e-06_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.10279e-07_r8,0.14631e-06_r8,0.14078e-06_r8,0.17511e-06_r8,0.23546e-06_r8, & + & 0.30442e-06_r8,0.38374e-06_r8,0.50000e-06_r8,0.10431e-05_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.51921e-08_r8,0.14437e-06_r8,0.12917e-06_r8,0.11673e-06_r8,0.12444e-06_r8, & + & 0.14966e-06_r8,0.19338e-06_r8,0.26674e-06_r8,0.16987e-05_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.69052e-08_r8,0.14822e-06_r8,0.13564e-06_r8,0.12080e-06_r8,0.12884e-06_r8, & + & 0.15616e-06_r8,0.20083e-06_r8,0.27373e-06_r8,0.17147e-05_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.93932e-08_r8,0.15309e-06_r8,0.13785e-06_r8,0.12361e-06_r8,0.12904e-06_r8, & + & 0.16004e-06_r8,0.20790e-06_r8,0.27928e-06_r8,0.17384e-05_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.10364e-07_r8,0.15577e-06_r8,0.14281e-06_r8,0.12445e-06_r8,0.13032e-06_r8, & + & 0.16178e-06_r8,0.21225e-06_r8,0.28499e-06_r8,0.17733e-05_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.10950e-07_r8,0.15768e-06_r8,0.14728e-06_r8,0.12674e-06_r8,0.12961e-06_r8, & + & 0.16455e-06_r8,0.21080e-06_r8,0.28744e-06_r8,0.17869e-05_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.51527e-08_r8,0.13331e-06_r8,0.15220e-06_r8,0.13781e-06_r8,0.11791e-06_r8, & + & 0.12291e-06_r8,0.14839e-06_r8,0.21430e-06_r8,0.45802e-05_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.52409e-08_r8,0.14109e-06_r8,0.15809e-06_r8,0.14393e-06_r8,0.12362e-06_r8, & + & 0.12831e-06_r8,0.15572e-06_r8,0.22059e-06_r8,0.46088e-05_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.66901e-08_r8,0.14833e-06_r8,0.16524e-06_r8,0.14893e-06_r8,0.12670e-06_r8, & + & 0.13152e-06_r8,0.16110e-06_r8,0.22404e-06_r8,0.46200e-05_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.90836e-08_r8,0.15267e-06_r8,0.17113e-06_r8,0.15541e-06_r8,0.12966e-06_r8, & + & 0.13240e-06_r8,0.16410e-06_r8,0.22868e-06_r8,0.45999e-05_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.11721e-07_r8,0.15605e-06_r8,0.17580e-06_r8,0.16064e-06_r8,0.13194e-06_r8, & + & 0.13127e-06_r8,0.16676e-06_r8,0.23245e-06_r8,0.46103e-05_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.53770e-08_r8,0.12906e-06_r8,0.19117e-06_r8,0.16928e-06_r8,0.14454e-06_r8, & + & 0.11318e-06_r8,0.12091e-06_r8,0.16771e-06_r8,0.10838e-04_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.71217e-08_r8,0.13171e-06_r8,0.20115e-06_r8,0.17525e-06_r8,0.15189e-06_r8, & + & 0.11980e-06_r8,0.12589e-06_r8,0.17247e-06_r8,0.10844e-04_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.76051e-08_r8,0.13463e-06_r8,0.20837e-06_r8,0.18092e-06_r8,0.15831e-06_r8, & + & 0.12491e-06_r8,0.12782e-06_r8,0.17568e-06_r8,0.10855e-04_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.87276e-08_r8,0.14002e-06_r8,0.21488e-06_r8,0.18616e-06_r8,0.16272e-06_r8, & + & 0.12991e-06_r8,0.13139e-06_r8,0.17775e-06_r8,0.10873e-04_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.98102e-08_r8,0.14390e-06_r8,0.21715e-06_r8,0.19383e-06_r8,0.16843e-06_r8, & + & 0.13102e-06_r8,0.13320e-06_r8,0.18001e-06_r8,0.10883e-04_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.78846e-08_r8,0.14921e-06_r8,0.16266e-06_r8,0.21810e-06_r8,0.17257e-06_r8, & + & 0.13914e-06_r8,0.10621e-06_r8,0.13009e-06_r8,0.22193e-04_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.87670e-08_r8,0.15667e-06_r8,0.17179e-06_r8,0.22870e-06_r8,0.18453e-06_r8, & + & 0.14806e-06_r8,0.11198e-06_r8,0.13228e-06_r8,0.22470e-04_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.94042e-08_r8,0.16331e-06_r8,0.17929e-06_r8,0.23732e-06_r8,0.19309e-06_r8, & + & 0.15669e-06_r8,0.11769e-06_r8,0.13462e-06_r8,0.22759e-04_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.10052e-07_r8,0.16738e-06_r8,0.18654e-06_r8,0.24428e-06_r8,0.19714e-06_r8, & + & 0.16469e-06_r8,0.12194e-06_r8,0.13694e-06_r8,0.23037e-04_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.99609e-08_r8,0.16974e-06_r8,0.19096e-06_r8,0.25212e-06_r8,0.20604e-06_r8, & + & 0.17005e-06_r8,0.12529e-06_r8,0.13965e-06_r8,0.23331e-04_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.10600e-07_r8,0.19194e-06_r8,0.19694e-06_r8,0.19228e-06_r8,0.23306e-06_r8, & + & 0.18017e-06_r8,0.13563e-06_r8,0.11106e-06_r8,0.57833e-04_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.11513e-07_r8,0.19670e-06_r8,0.20600e-06_r8,0.20153e-06_r8,0.24712e-06_r8, & + & 0.19420e-06_r8,0.14374e-06_r8,0.11223e-06_r8,0.59252e-04_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.12267e-07_r8,0.20052e-06_r8,0.21125e-06_r8,0.21502e-06_r8,0.25879e-06_r8, & + & 0.20809e-06_r8,0.15257e-06_r8,0.11412e-06_r8,0.60474e-04_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.11377e-07_r8,0.20485e-06_r8,0.21479e-06_r8,0.22527e-06_r8,0.26884e-06_r8, & + & 0.21723e-06_r8,0.15872e-06_r8,0.11733e-06_r8,0.61380e-04_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.12141e-07_r8,0.20611e-06_r8,0.22439e-06_r8,0.22986e-06_r8,0.27411e-06_r8, & + & 0.22402e-06_r8,0.16342e-06_r8,0.11916e-06_r8,0.62353e-04_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.12251e-07_r8,0.29022e-06_r8,0.24496e-06_r8,0.24059e-06_r8,0.21631e-06_r8, & + & 0.23923e-06_r8,0.16597e-06_r8,0.10842e-06_r8,0.80074e-04_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.12224e-07_r8,0.29680e-06_r8,0.25368e-06_r8,0.24691e-06_r8,0.22294e-06_r8, & + & 0.24912e-06_r8,0.17747e-06_r8,0.10969e-06_r8,0.81125e-04_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.14264e-07_r8,0.29886e-06_r8,0.26040e-06_r8,0.25256e-06_r8,0.23184e-06_r8, & + & 0.25957e-06_r8,0.18845e-06_r8,0.11123e-06_r8,0.82960e-04_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.16608e-07_r8,0.30056e-06_r8,0.26198e-06_r8,0.25724e-06_r8,0.23897e-06_r8, & + & 0.26977e-06_r8,0.19716e-06_r8,0.11521e-06_r8,0.84911e-04_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.18982e-07_r8,0.30200e-06_r8,0.26559e-06_r8,0.26090e-06_r8,0.24427e-06_r8, & + & 0.27763e-06_r8,0.20825e-06_r8,0.11858e-06_r8,0.86586e-04_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.16186e-07_r8,0.36864e-06_r8,0.27735e-06_r8,0.24475e-06_r8,0.23659e-06_r8, & + & 0.20178e-06_r8,0.20651e-06_r8,0.11504e-06_r8,0.90323e-04_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.16900e-07_r8,0.36903e-06_r8,0.27865e-06_r8,0.25015e-06_r8,0.24279e-06_r8, & + & 0.21379e-06_r8,0.22149e-06_r8,0.12739e-06_r8,0.92788e-04_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.18900e-07_r8,0.36546e-06_r8,0.28369e-06_r8,0.25919e-06_r8,0.24650e-06_r8, & + & 0.22349e-06_r8,0.23741e-06_r8,0.13455e-06_r8,0.94381e-04_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.24666e-07_r8,0.36289e-06_r8,0.28992e-06_r8,0.26755e-06_r8,0.25261e-06_r8, & + & 0.23012e-06_r8,0.24862e-06_r8,0.14012e-06_r8,0.95689e-04_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.28047e-07_r8,0.36144e-06_r8,0.29439e-06_r8,0.27280e-06_r8,0.25910e-06_r8, & + & 0.23527e-06_r8,0.25804e-06_r8,0.14441e-06_r8,0.97273e-04_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.27099e-07_r8,0.42452e-06_r8,0.36469e-06_r8,0.28012e-06_r8,0.24206e-06_r8, & + & 0.21452e-06_r8,0.19737e-06_r8,0.12552e-06_r8,0.93221e-04_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.30641e-07_r8,0.42348e-06_r8,0.36821e-06_r8,0.29049e-06_r8,0.25191e-06_r8, & + & 0.22447e-06_r8,0.20459e-06_r8,0.13174e-06_r8,0.95326e-04_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.31538e-07_r8,0.42218e-06_r8,0.36978e-06_r8,0.29801e-06_r8,0.26042e-06_r8, & + & 0.23413e-06_r8,0.21354e-06_r8,0.13999e-06_r8,0.97244e-04_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.33087e-07_r8,0.42233e-06_r8,0.36980e-06_r8,0.30223e-06_r8,0.26697e-06_r8, & + & 0.24077e-06_r8,0.22289e-06_r8,0.14849e-06_r8,0.99282e-04_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.35771e-07_r8,0.42124e-06_r8,0.36949e-06_r8,0.30814e-06_r8,0.27423e-06_r8, & + & 0.24510e-06_r8,0.22998e-06_r8,0.15431e-06_r8,0.10189e-03_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.60599e-08_r8,0.49839e-06_r8,0.90796e-06_r8,0.12825e-05_r8,0.16387e-05_r8, & + & 0.20000e-05_r8,0.24097e-05_r8,0.30198e-05_r8,0.14012e-05_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.57361e-08_r8,0.51373e-06_r8,0.93344e-06_r8,0.13150e-05_r8,0.16776e-05_r8, & + & 0.20412e-05_r8,0.24476e-05_r8,0.30155e-05_r8,0.14079e-05_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.61895e-08_r8,0.64074e-06_r8,0.11706e-05_r8,0.16523e-05_r8,0.21138e-05_r8, & + & 0.25765e-05_r8,0.30714e-05_r8,0.37148e-05_r8,0.20046e-05_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.63590e-08_r8,0.53918e-06_r8,0.97233e-06_r8,0.13614e-05_r8,0.17274e-05_r8, & + & 0.21018e-05_r8,0.24992e-05_r8,0.30391e-05_r8,0.14106e-05_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.66907e-08_r8,0.54769e-06_r8,0.98459e-06_r8,0.13756e-05_r8,0.17428e-05_r8, & + & 0.21216e-05_r8,0.25190e-05_r8,0.30528e-05_r8,0.14057e-05_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.63247e-08_r8,0.40976e-06_r8,0.75743e-06_r8,0.10729e-05_r8,0.13776e-05_r8, & + & 0.16847e-05_r8,0.20386e-05_r8,0.25923e-05_r8,0.11016e-05_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.71971e-08_r8,0.42277e-06_r8,0.77866e-06_r8,0.11006e-05_r8,0.14075e-05_r8, & + & 0.17208e-05_r8,0.20689e-05_r8,0.25842e-05_r8,0.11093e-05_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.68862e-08_r8,0.54111e-06_r8,0.99924e-06_r8,0.14135e-05_r8,0.18137e-05_r8, & + & 0.22190e-05_r8,0.26613e-05_r8,0.32636e-05_r8,0.16377e-05_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.74570e-08_r8,0.54374e-06_r8,0.10016e-05_r8,0.14142e-05_r8,0.18118e-05_r8, & + & 0.22093e-05_r8,0.26451e-05_r8,0.32306e-05_r8,0.16062e-05_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.76975e-08_r8,0.44890e-06_r8,0.82016e-06_r8,0.11488e-05_r8,0.14591e-05_r8, & + & 0.17814e-05_r8,0.21241e-05_r8,0.26089e-05_r8,0.11145e-05_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.83656e-08_r8,0.31311e-06_r8,0.61949e-06_r8,0.88176e-06_r8,0.11379e-05_r8, & + & 0.13977e-05_r8,0.17043e-05_r8,0.22078e-05_r8,0.73836e-06_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.85171e-08_r8,0.32573e-06_r8,0.63573e-06_r8,0.90517e-06_r8,0.11641e-05_r8, & + & 0.14286e-05_r8,0.17247e-05_r8,0.21938e-05_r8,0.74285e-06_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.78702e-08_r8,0.33673e-06_r8,0.64948e-06_r8,0.92347e-06_r8,0.11844e-05_r8, & + & 0.14525e-05_r8,0.17473e-05_r8,0.21823e-05_r8,0.74417e-06_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.88135e-08_r8,0.44484e-06_r8,0.84006e-06_r8,0.11924e-05_r8,0.15326e-05_r8, & + & 0.18766e-05_r8,0.22592e-05_r8,0.27980e-05_r8,0.11629e-05_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.83594e-08_r8,0.34852e-06_r8,0.67171e-06_r8,0.94786e-06_r8,0.12080e-05_r8, & + & 0.14818e-05_r8,0.17721e-05_r8,0.22017e-05_r8,0.74162e-06_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.82233e-08_r8,0.22714e-06_r8,0.49574e-06_r8,0.71618e-06_r8,0.92897e-06_r8, & + & 0.11522e-05_r8,0.14150e-05_r8,0.18749e-05_r8,0.10829e-05_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.90906e-08_r8,0.23281e-06_r8,0.51082e-06_r8,0.73615e-06_r8,0.95322e-06_r8, & + & 0.11749e-05_r8,0.14287e-05_r8,0.18456e-05_r8,0.10964e-05_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.10403e-07_r8,0.23873e-06_r8,0.52083e-06_r8,0.75142e-06_r8,0.97057e-06_r8, & + & 0.11959e-05_r8,0.14456e-05_r8,0.18299e-05_r8,0.11024e-05_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.11681e-07_r8,0.24287e-06_r8,0.52982e-06_r8,0.76518e-06_r8,0.98418e-06_r8, & + & 0.12105e-05_r8,0.14593e-05_r8,0.18314e-05_r8,0.11002e-05_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.11781e-07_r8,0.32919e-06_r8,0.69041e-06_r8,0.99008e-06_r8,0.12781e-05_r8, & + & 0.15684e-05_r8,0.18900e-05_r8,0.23626e-05_r8,0.11507e-05_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.10746e-07_r8,0.16960e-06_r8,0.36271e-06_r8,0.57393e-06_r8,0.75088e-06_r8, & + & 0.94078e-06_r8,0.11700e-05_r8,0.15610e-05_r8,0.23060e-05_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.12322e-07_r8,0.17145e-06_r8,0.37466e-06_r8,0.58975e-06_r8,0.77156e-06_r8, & + & 0.96051e-06_r8,0.11773e-05_r8,0.15431e-05_r8,0.23550e-05_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.12362e-07_r8,0.17491e-06_r8,0.38517e-06_r8,0.60273e-06_r8,0.78779e-06_r8, & + & 0.97831e-06_r8,0.11895e-05_r8,0.15264e-05_r8,0.23946e-05_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.11932e-07_r8,0.17603e-06_r8,0.39310e-06_r8,0.61276e-06_r8,0.80198e-06_r8, & + & 0.99168e-06_r8,0.12014e-05_r8,0.15209e-05_r8,0.24122e-05_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.12827e-07_r8,0.23797e-06_r8,0.54915e-06_r8,0.81314e-06_r8,0.10605e-05_r8, & + & 0.13079e-05_r8,0.15848e-05_r8,0.19982e-05_r8,0.26265e-05_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.16887e-07_r8,0.16918e-06_r8,0.26182e-06_r8,0.43955e-06_r8,0.59876e-06_r8, & + & 0.76220e-06_r8,0.96205e-06_r8,0.12977e-05_r8,0.30196e-05_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.16463e-07_r8,0.17256e-06_r8,0.26723e-06_r8,0.45266e-06_r8,0.61330e-06_r8, & + & 0.77949e-06_r8,0.96881e-06_r8,0.12938e-05_r8,0.31027e-05_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.14297e-07_r8,0.17174e-06_r8,0.27626e-06_r8,0.46141e-06_r8,0.62873e-06_r8, & + & 0.79335e-06_r8,0.97523e-06_r8,0.12716e-05_r8,0.31487e-05_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.15984e-07_r8,0.17093e-06_r8,0.27951e-06_r8,0.46972e-06_r8,0.64062e-06_r8, & + & 0.80616e-06_r8,0.98183e-06_r8,0.12602e-05_r8,0.31591e-05_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.17832e-07_r8,0.17197e-06_r8,0.28124e-06_r8,0.47610e-06_r8,0.64900e-06_r8, & + & 0.81537e-06_r8,0.99403e-06_r8,0.12613e-05_r8,0.32001e-05_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.19543e-07_r8,0.20424e-06_r8,0.20827e-06_r8,0.30613e-06_r8,0.46038e-06_r8, & + & 0.61052e-06_r8,0.78796e-06_r8,0.10769e-05_r8,0.53495e-05_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.21943e-07_r8,0.20486e-06_r8,0.21292e-06_r8,0.31650e-06_r8,0.47369e-06_r8, & + & 0.62546e-06_r8,0.78997e-06_r8,0.10696e-05_r8,0.53612e-05_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.23096e-07_r8,0.20519e-06_r8,0.21260e-06_r8,0.32419e-06_r8,0.48522e-06_r8, & + & 0.63494e-06_r8,0.79556e-06_r8,0.10562e-05_r8,0.54125e-05_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.23811e-07_r8,0.20761e-06_r8,0.21334e-06_r8,0.32752e-06_r8,0.49467e-06_r8, & + & 0.64456e-06_r8,0.80411e-06_r8,0.10435e-05_r8,0.54920e-05_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.23502e-07_r8,0.20918e-06_r8,0.21430e-06_r8,0.32878e-06_r8,0.50037e-06_r8, & + & 0.65413e-06_r8,0.80879e-06_r8,0.10409e-05_r8,0.55076e-05_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.28818e-07_r8,0.26386e-06_r8,0.23322e-06_r8,0.23394e-06_r8,0.31766e-06_r8, & + & 0.47372e-06_r8,0.64268e-06_r8,0.89272e-06_r8,0.10691e-04_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.30094e-07_r8,0.27235e-06_r8,0.23524e-06_r8,0.24245e-06_r8,0.32636e-06_r8, & + & 0.48411e-06_r8,0.63773e-06_r8,0.88040e-06_r8,0.10770e-04_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.32474e-07_r8,0.27799e-06_r8,0.23717e-06_r8,0.24789e-06_r8,0.33554e-06_r8, & + & 0.49304e-06_r8,0.64255e-06_r8,0.87788e-06_r8,0.10799e-04_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.33631e-07_r8,0.28020e-06_r8,0.23819e-06_r8,0.25000e-06_r8,0.34187e-06_r8, & + & 0.49874e-06_r8,0.64803e-06_r8,0.86373e-06_r8,0.10824e-04_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.34597e-07_r8,0.28107e-06_r8,0.24266e-06_r8,0.24933e-06_r8,0.34607e-06_r8, & + & 0.50692e-06_r8,0.65081e-06_r8,0.85686e-06_r8,0.10819e-04_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.37049e-07_r8,0.33070e-06_r8,0.32147e-06_r8,0.25828e-06_r8,0.24460e-06_r8, & + & 0.33057e-06_r8,0.51182e-06_r8,0.72970e-06_r8,0.32667e-04_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.39634e-07_r8,0.34282e-06_r8,0.32875e-06_r8,0.26785e-06_r8,0.25757e-06_r8, & + & 0.33579e-06_r8,0.50462e-06_r8,0.72240e-06_r8,0.32638e-04_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.42012e-07_r8,0.34998e-06_r8,0.33495e-06_r8,0.27514e-06_r8,0.26581e-06_r8, & + & 0.33988e-06_r8,0.50360e-06_r8,0.72105e-06_r8,0.32828e-04_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.43216e-07_r8,0.35061e-06_r8,0.33953e-06_r8,0.28140e-06_r8,0.27172e-06_r8, & + & 0.34266e-06_r8,0.50914e-06_r8,0.70829e-06_r8,0.32970e-04_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.43838e-07_r8,0.35447e-06_r8,0.34674e-06_r8,0.28252e-06_r8,0.27122e-06_r8, & + & 0.34740e-06_r8,0.51058e-06_r8,0.70194e-06_r8,0.33023e-04_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.46492e-07_r8,0.34673e-06_r8,0.43959e-06_r8,0.39620e-06_r8,0.30969e-06_r8, & + & 0.25359e-06_r8,0.35579e-06_r8,0.58999e-06_r8,0.75308e-04_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.51642e-07_r8,0.35814e-06_r8,0.45251e-06_r8,0.40694e-06_r8,0.31643e-06_r8, & + & 0.25658e-06_r8,0.34700e-06_r8,0.58340e-06_r8,0.75445e-04_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.55139e-07_r8,0.36959e-06_r8,0.46273e-06_r8,0.41592e-06_r8,0.32168e-06_r8, & + & 0.26320e-06_r8,0.34598e-06_r8,0.57972e-06_r8,0.75796e-04_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.58094e-07_r8,0.37731e-06_r8,0.47160e-06_r8,0.41969e-06_r8,0.32536e-06_r8, & + & 0.27186e-06_r8,0.34692e-06_r8,0.57173e-06_r8,0.76680e-04_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.62665e-07_r8,0.38529e-06_r8,0.47122e-06_r8,0.42322e-06_r8,0.32990e-06_r8, & + & 0.28125e-06_r8,0.34920e-06_r8,0.56204e-06_r8,0.77515e-04_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.71997e-07_r8,0.39039e-06_r8,0.48930e-06_r8,0.52037e-06_r8,0.44835e-06_r8, & + & 0.32920e-06_r8,0.25424e-06_r8,0.45719e-06_r8,0.97599e-04_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.84174e-07_r8,0.39220e-06_r8,0.49753e-06_r8,0.53466e-06_r8,0.46035e-06_r8, & + & 0.34028e-06_r8,0.25580e-06_r8,0.44804e-06_r8,0.98017e-04_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.88241e-07_r8,0.39809e-06_r8,0.50514e-06_r8,0.54464e-06_r8,0.47069e-06_r8, & + & 0.34919e-06_r8,0.25830e-06_r8,0.44783e-06_r8,0.97609e-04_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.93462e-07_r8,0.40271e-06_r8,0.51216e-06_r8,0.55531e-06_r8,0.48178e-06_r8, & + & 0.35530e-06_r8,0.26505e-06_r8,0.43524e-06_r8,0.97099e-04_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.96966e-07_r8,0.40660e-06_r8,0.51682e-06_r8,0.56367e-06_r8,0.48662e-06_r8, & + & 0.35706e-06_r8,0.26903e-06_r8,0.42986e-06_r8,0.97653e-04_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.99102e-07_r8,0.42179e-06_r8,0.46920e-06_r8,0.54974e-06_r8,0.50699e-06_r8, & + & 0.41543e-06_r8,0.26692e-06_r8,0.34287e-06_r8,0.10692e-03_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.10220e-06_r8,0.42343e-06_r8,0.48263e-06_r8,0.56179e-06_r8,0.52088e-06_r8, & + & 0.42826e-06_r8,0.27416e-06_r8,0.32165e-06_r8,0.10849e-03_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.10736e-06_r8,0.42994e-06_r8,0.49237e-06_r8,0.56848e-06_r8,0.53837e-06_r8, & + & 0.43862e-06_r8,0.28070e-06_r8,0.31402e-06_r8,0.10890e-03_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.10535e-06_r8,0.42853e-06_r8,0.49830e-06_r8,0.57259e-06_r8,0.55337e-06_r8, & + & 0.45117e-06_r8,0.28964e-06_r8,0.30229e-06_r8,0.11005e-03_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.10635e-06_r8,0.42826e-06_r8,0.50038e-06_r8,0.57688e-06_r8,0.56182e-06_r8, & + & 0.45862e-06_r8,0.29473e-06_r8,0.29904e-06_r8,0.11056e-03_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.11521e-06_r8,0.43118e-06_r8,0.49222e-06_r8,0.52624e-06_r8,0.55771e-06_r8, & + & 0.47186e-06_r8,0.32691e-06_r8,0.24833e-06_r8,0.10886e-03_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.11730e-06_r8,0.43904e-06_r8,0.49350e-06_r8,0.54164e-06_r8,0.56845e-06_r8, & + & 0.49098e-06_r8,0.34261e-06_r8,0.23938e-06_r8,0.11077e-03_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.11952e-06_r8,0.44327e-06_r8,0.50284e-06_r8,0.55816e-06_r8,0.58198e-06_r8, & + & 0.50372e-06_r8,0.35861e-06_r8,0.22850e-06_r8,0.11296e-03_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.11965e-06_r8,0.44664e-06_r8,0.51058e-06_r8,0.56661e-06_r8,0.59093e-06_r8, & + & 0.51146e-06_r8,0.36596e-06_r8,0.22349e-06_r8,0.11560e-03_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.12171e-06_r8,0.45566e-06_r8,0.52364e-06_r8,0.57439e-06_r8,0.59010e-06_r8, & + & 0.52011e-06_r8,0.37200e-06_r8,0.22417e-06_r8,0.11598e-03_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.64393e-08_r8,0.14477e-05_r8,0.26383e-05_r8,0.37578e-05_r8,0.48497e-05_r8, & + & 0.58771e-05_r8,0.69748e-05_r8,0.83337e-05_r8,0.52972e-05_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.74788e-08_r8,0.14813e-05_r8,0.26820e-05_r8,0.38123e-05_r8,0.49043e-05_r8, & + & 0.59719e-05_r8,0.70794e-05_r8,0.84777e-05_r8,0.53686e-05_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.70698e-08_r8,0.17381e-05_r8,0.31521e-05_r8,0.44815e-05_r8,0.57370e-05_r8, & + & 0.69696e-05_r8,0.82426e-05_r8,0.98195e-05_r8,0.67445e-05_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.75728e-08_r8,0.15363e-05_r8,0.27544e-05_r8,0.38956e-05_r8,0.49855e-05_r8, & + & 0.60556e-05_r8,0.72284e-05_r8,0.86770e-05_r8,0.54442e-05_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.72646e-08_r8,0.15573e-05_r8,0.27840e-05_r8,0.39266e-05_r8,0.50091e-05_r8, & + & 0.60781e-05_r8,0.72327e-05_r8,0.87344e-05_r8,0.54537e-05_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.91682e-08_r8,0.12471e-05_r8,0.22727e-05_r8,0.32462e-05_r8,0.42007e-05_r8, & + & 0.51012e-05_r8,0.60761e-05_r8,0.73379e-05_r8,0.44448e-05_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.78841e-08_r8,0.12745e-05_r8,0.23098e-05_r8,0.32938e-05_r8,0.42384e-05_r8, & + & 0.51817e-05_r8,0.61658e-05_r8,0.74615e-05_r8,0.44925e-05_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.88457e-08_r8,0.15305e-05_r8,0.27824e-05_r8,0.39573e-05_r8,0.50820e-05_r8, & + & 0.61863e-05_r8,0.73547e-05_r8,0.88186e-05_r8,0.58192e-05_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.81699e-08_r8,0.15379e-05_r8,0.27884e-05_r8,0.39554e-05_r8,0.50640e-05_r8, & + & 0.61598e-05_r8,0.73260e-05_r8,0.88047e-05_r8,0.57596e-05_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.81267e-08_r8,0.13345e-05_r8,0.23941e-05_r8,0.33760e-05_r8,0.43121e-05_r8, & + & 0.52406e-05_r8,0.62663e-05_r8,0.76657e-05_r8,0.45393e-05_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.91717e-08_r8,0.10541e-05_r8,0.19313e-05_r8,0.27682e-05_r8,0.35915e-05_r8, & + & 0.43666e-05_r8,0.52222e-05_r8,0.63759e-05_r8,0.36110e-05_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.10331e-07_r8,0.10789e-05_r8,0.19645e-05_r8,0.28075e-05_r8,0.36240e-05_r8, & + & 0.44392e-05_r8,0.52990e-05_r8,0.64883e-05_r8,0.36530e-05_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.12324e-07_r8,0.10988e-05_r8,0.19944e-05_r8,0.28363e-05_r8,0.36532e-05_r8, & + & 0.44650e-05_r8,0.53622e-05_r8,0.65761e-05_r8,0.36791e-05_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.11596e-07_r8,0.13389e-05_r8,0.24365e-05_r8,0.34597e-05_r8,0.44354e-05_r8, & + & 0.54167e-05_r8,0.64681e-05_r8,0.78697e-05_r8,0.48568e-05_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.11476e-07_r8,0.11282e-05_r8,0.20370e-05_r8,0.28768e-05_r8,0.36785e-05_r8, & + & 0.44764e-05_r8,0.53828e-05_r8,0.66660e-05_r8,0.36841e-05_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.12942e-07_r8,0.87057e-06_r8,0.16185e-05_r8,0.23328e-05_r8,0.30327e-05_r8, & + & 0.36939e-05_r8,0.44351e-05_r8,0.54720e-05_r8,0.21271e-05_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.12911e-07_r8,0.89351e-06_r8,0.16491e-05_r8,0.23657e-05_r8,0.30660e-05_r8, & + & 0.37589e-05_r8,0.45049e-05_r8,0.55808e-05_r8,0.21315e-05_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.11919e-07_r8,0.91285e-06_r8,0.16762e-05_r8,0.23907e-05_r8,0.30911e-05_r8, & + & 0.37889e-05_r8,0.45584e-05_r8,0.56554e-05_r8,0.21302e-05_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.12644e-07_r8,0.92680e-06_r8,0.16966e-05_r8,0.24115e-05_r8,0.31023e-05_r8, & + & 0.37973e-05_r8,0.46002e-05_r8,0.57029e-05_r8,0.21090e-05_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.14252e-07_r8,0.11501e-05_r8,0.21042e-05_r8,0.29827e-05_r8,0.38200e-05_r8, & + & 0.46680e-05_r8,0.55977e-05_r8,0.69211e-05_r8,0.32123e-05_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.14457e-07_r8,0.68848e-06_r8,0.13403e-05_r8,0.19448e-05_r8,0.25364e-05_r8, & + & 0.30956e-05_r8,0.37236e-05_r8,0.46561e-05_r8,0.23476e-05_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.13664e-07_r8,0.70724e-06_r8,0.13666e-05_r8,0.19744e-05_r8,0.25701e-05_r8, & + & 0.31515e-05_r8,0.37903e-05_r8,0.47386e-05_r8,0.23292e-05_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.16363e-07_r8,0.72382e-06_r8,0.13894e-05_r8,0.19966e-05_r8,0.25908e-05_r8, & + & 0.31942e-05_r8,0.38380e-05_r8,0.48063e-05_r8,0.23210e-05_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.18854e-07_r8,0.73645e-06_r8,0.14075e-05_r8,0.20143e-05_r8,0.25995e-05_r8, & + & 0.31924e-05_r8,0.38751e-05_r8,0.48509e-05_r8,0.23084e-05_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.19502e-07_r8,0.95711e-06_r8,0.17948e-05_r8,0.25536e-05_r8,0.32756e-05_r8, & + & 0.40127e-05_r8,0.48356e-05_r8,0.60502e-05_r8,0.26522e-05_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.20265e-07_r8,0.45716e-06_r8,0.10840e-05_r8,0.16034e-05_r8,0.20999e-05_r8, & + & 0.25681e-05_r8,0.30977e-05_r8,0.39107e-05_r8,0.52450e-05_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.21598e-07_r8,0.47132e-06_r8,0.11079e-05_r8,0.16263e-05_r8,0.21396e-05_r8, & + & 0.26164e-05_r8,0.31577e-05_r8,0.39701e-05_r8,0.52182e-05_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.24575e-07_r8,0.48601e-06_r8,0.11257e-05_r8,0.16486e-05_r8,0.21513e-05_r8, & + & 0.26585e-05_r8,0.32022e-05_r8,0.40354e-05_r8,0.51968e-05_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.24397e-07_r8,0.49804e-06_r8,0.11416e-05_r8,0.16645e-05_r8,0.21605e-05_r8, & + & 0.26639e-05_r8,0.32353e-05_r8,0.40822e-05_r8,0.51575e-05_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.24456e-07_r8,0.50499e-06_r8,0.11522e-05_r8,0.16738e-05_r8,0.21632e-05_r8, & + & 0.26629e-05_r8,0.32463e-05_r8,0.41051e-05_r8,0.51085e-05_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.28039e-07_r8,0.29800e-06_r8,0.81783e-06_r8,0.13008e-05_r8,0.17226e-05_r8, & + & 0.21163e-05_r8,0.25578e-05_r8,0.32519e-05_r8,0.82307e-05_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.29388e-07_r8,0.30492e-06_r8,0.83771e-06_r8,0.13192e-05_r8,0.17591e-05_r8, & + & 0.21563e-05_r8,0.26128e-05_r8,0.33130e-05_r8,0.81908e-05_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.29556e-07_r8,0.30866e-06_r8,0.85444e-06_r8,0.13376e-05_r8,0.17722e-05_r8, & + & 0.21943e-05_r8,0.26541e-05_r8,0.33584e-05_r8,0.81819e-05_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.26709e-07_r8,0.30951e-06_r8,0.86739e-06_r8,0.13505e-05_r8,0.17805e-05_r8, & + & 0.22093e-05_r8,0.26812e-05_r8,0.34009e-05_r8,0.81017e-05_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.27877e-07_r8,0.31158e-06_r8,0.87645e-06_r8,0.13597e-05_r8,0.17817e-05_r8, & + & 0.22083e-05_r8,0.26996e-05_r8,0.34240e-05_r8,0.80774e-05_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.34498e-07_r8,0.30504e-06_r8,0.50025e-06_r8,0.99104e-06_r8,0.13907e-05_r8, & + & 0.17284e-05_r8,0.20950e-05_r8,0.26875e-05_r8,0.12492e-04_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.34468e-07_r8,0.31253e-06_r8,0.51376e-06_r8,0.10029e-05_r8,0.14233e-05_r8, & + & 0.17665e-05_r8,0.21486e-05_r8,0.27439e-05_r8,0.12811e-04_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.33481e-07_r8,0.31885e-06_r8,0.52532e-06_r8,0.10176e-05_r8,0.14361e-05_r8, & + & 0.18000e-05_r8,0.21864e-05_r8,0.27713e-05_r8,0.12979e-04_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.35023e-07_r8,0.32212e-06_r8,0.53171e-06_r8,0.10292e-05_r8,0.14414e-05_r8, & + & 0.18222e-05_r8,0.22113e-05_r8,0.28111e-05_r8,0.13061e-04_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.38480e-07_r8,0.32386e-06_r8,0.53818e-06_r8,0.10355e-05_r8,0.14400e-05_r8, & + & 0.18162e-05_r8,0.22298e-05_r8,0.28367e-05_r8,0.13100e-04_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.41152e-07_r8,0.31870e-06_r8,0.36402e-06_r8,0.61613e-06_r8,0.10619e-05_r8, & + & 0.13940e-05_r8,0.17098e-05_r8,0.22173e-05_r8,0.27198e-04_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.47020e-07_r8,0.31765e-06_r8,0.37312e-06_r8,0.61961e-06_r8,0.10763e-05_r8, & + & 0.14273e-05_r8,0.17555e-05_r8,0.22573e-05_r8,0.28218e-04_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.48171e-07_r8,0.31526e-06_r8,0.38468e-06_r8,0.62540e-06_r8,0.10803e-05_r8, & + & 0.14543e-05_r8,0.17919e-05_r8,0.22822e-05_r8,0.28600e-04_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.52826e-07_r8,0.32481e-06_r8,0.38733e-06_r8,0.62721e-06_r8,0.10854e-05_r8, & + & 0.14750e-05_r8,0.18124e-05_r8,0.23140e-05_r8,0.29051e-04_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.56456e-07_r8,0.32727e-06_r8,0.38424e-06_r8,0.63178e-06_r8,0.10853e-05_r8, & + & 0.14692e-05_r8,0.18309e-05_r8,0.23369e-05_r8,0.29958e-04_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.62033e-07_r8,0.45418e-06_r8,0.43247e-06_r8,0.44775e-06_r8,0.62834e-06_r8, & + & 0.10534e-05_r8,0.13865e-05_r8,0.18301e-05_r8,0.47779e-04_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.66259e-07_r8,0.45321e-06_r8,0.43983e-06_r8,0.45223e-06_r8,0.63440e-06_r8, & + & 0.10746e-05_r8,0.14253e-05_r8,0.18534e-05_r8,0.48468e-04_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.78966e-07_r8,0.45246e-06_r8,0.44780e-06_r8,0.45868e-06_r8,0.63026e-06_r8, & + & 0.10842e-05_r8,0.14519e-05_r8,0.18794e-05_r8,0.49251e-04_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.87881e-07_r8,0.44642e-06_r8,0.45426e-06_r8,0.46583e-06_r8,0.63116e-06_r8, & + & 0.10925e-05_r8,0.14710e-05_r8,0.18965e-05_r8,0.49742e-04_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.92572e-07_r8,0.44310e-06_r8,0.45326e-06_r8,0.47005e-06_r8,0.63094e-06_r8, & + & 0.10763e-05_r8,0.14843e-05_r8,0.19214e-05_r8,0.50457e-04_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.10522e-06_r8,0.58600e-06_r8,0.57473e-06_r8,0.52150e-06_r8,0.51202e-06_r8, & + & 0.62383e-06_r8,0.10987e-05_r8,0.15032e-05_r8,0.50557e-04_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.98332e-07_r8,0.58669e-06_r8,0.57910e-06_r8,0.52997e-06_r8,0.52591e-06_r8, & + & 0.62992e-06_r8,0.11144e-05_r8,0.15271e-05_r8,0.52915e-04_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.10383e-06_r8,0.58976e-06_r8,0.58650e-06_r8,0.53573e-06_r8,0.53394e-06_r8, & + & 0.63743e-06_r8,0.11251e-05_r8,0.15415e-05_r8,0.55206e-04_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.10626e-06_r8,0.58622e-06_r8,0.58747e-06_r8,0.53868e-06_r8,0.53891e-06_r8, & + & 0.62645e-06_r8,0.11296e-05_r8,0.15628e-05_r8,0.58020e-04_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.10795e-06_r8,0.57800e-06_r8,0.58664e-06_r8,0.53883e-06_r8,0.54784e-06_r8, & + & 0.62145e-06_r8,0.11279e-05_r8,0.15782e-05_r8,0.60369e-04_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.11905e-06_r8,0.60759e-06_r8,0.68611e-06_r8,0.59318e-06_r8,0.53805e-06_r8, & + & 0.44962e-06_r8,0.74828e-06_r8,0.12279e-05_r8,0.57098e-04_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.12660e-06_r8,0.61695e-06_r8,0.68094e-06_r8,0.60079e-06_r8,0.55064e-06_r8, & + & 0.44953e-06_r8,0.74858e-06_r8,0.12489e-05_r8,0.55969e-04_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.12824e-06_r8,0.61561e-06_r8,0.67586e-06_r8,0.61662e-06_r8,0.55533e-06_r8, & + & 0.46796e-06_r8,0.74406e-06_r8,0.12615e-05_r8,0.57249e-04_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.12834e-06_r8,0.62554e-06_r8,0.67923e-06_r8,0.62343e-06_r8,0.55964e-06_r8, & + & 0.48091e-06_r8,0.73622e-06_r8,0.12795e-05_r8,0.58462e-04_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.13022e-06_r8,0.63206e-06_r8,0.68726e-06_r8,0.62663e-06_r8,0.56231e-06_r8, & + & 0.48008e-06_r8,0.72942e-06_r8,0.12885e-05_r8,0.57642e-04_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.15325e-06_r8,0.60909e-06_r8,0.76952e-06_r8,0.71232e-06_r8,0.57983e-06_r8, & + & 0.50489e-06_r8,0.48627e-06_r8,0.99183e-06_r8,0.58778e-04_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.15519e-06_r8,0.62152e-06_r8,0.78639e-06_r8,0.71888e-06_r8,0.59866e-06_r8, & + & 0.50930e-06_r8,0.48247e-06_r8,0.10069e-05_r8,0.57959e-04_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.17242e-06_r8,0.64099e-06_r8,0.78686e-06_r8,0.71502e-06_r8,0.60678e-06_r8, & + & 0.51633e-06_r8,0.47220e-06_r8,0.10180e-05_r8,0.56844e-04_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.18585e-06_r8,0.65002e-06_r8,0.78368e-06_r8,0.71421e-06_r8,0.61538e-06_r8, & + & 0.52650e-06_r8,0.46857e-06_r8,0.10263e-05_r8,0.55757e-04_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.19235e-06_r8,0.64166e-06_r8,0.76203e-06_r8,0.70622e-06_r8,0.61837e-06_r8, & + & 0.53042e-06_r8,0.45529e-06_r8,0.10275e-05_r8,0.55475e-04_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.95617e-08_r8,0.36774e-05_r8,0.65849e-05_r8,0.92221e-05_r8,0.11700e-04_r8, & + & 0.14161e-04_r8,0.16732e-04_r8,0.20350e-04_r8,0.14554e-04_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.93327e-08_r8,0.37537e-05_r8,0.66916e-05_r8,0.93495e-05_r8,0.11842e-04_r8, & + & 0.14289e-04_r8,0.16848e-04_r8,0.20318e-04_r8,0.14747e-04_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.98298e-08_r8,0.41944e-05_r8,0.75022e-05_r8,0.10503e-04_r8,0.13381e-04_r8, & + & 0.16104e-04_r8,0.19004e-04_r8,0.22601e-04_r8,0.17337e-04_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.92318e-08_r8,0.38872e-05_r8,0.68816e-05_r8,0.95784e-05_r8,0.12112e-04_r8, & + & 0.14510e-04_r8,0.17052e-04_r8,0.20522e-04_r8,0.14967e-04_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.98053e-08_r8,0.39438e-05_r8,0.69574e-05_r8,0.96665e-05_r8,0.12218e-04_r8, & + & 0.14607e-04_r8,0.17135e-04_r8,0.20557e-04_r8,0.15005e-04_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.99669e-08_r8,0.32456e-05_r8,0.58216e-05_r8,0.81575e-05_r8,0.10349e-04_r8, & + & 0.12573e-04_r8,0.14901e-04_r8,0.18163e-04_r8,0.12615e-04_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.12231e-07_r8,0.33138e-05_r8,0.59221e-05_r8,0.82752e-05_r8,0.10501e-04_r8, & + & 0.12666e-04_r8,0.15004e-04_r8,0.18147e-04_r8,0.12797e-04_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.10745e-07_r8,0.37581e-05_r8,0.67327e-05_r8,0.94426e-05_r8,0.12044e-04_r8, & + & 0.14533e-04_r8,0.17181e-04_r8,0.20503e-04_r8,0.15464e-04_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.11723e-07_r8,0.37897e-05_r8,0.67581e-05_r8,0.94584e-05_r8,0.12035e-04_r8, & + & 0.14508e-04_r8,0.17115e-04_r8,0.20450e-04_r8,0.15378e-04_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.10775e-07_r8,0.34864e-05_r8,0.61478e-05_r8,0.85479e-05_r8,0.10823e-04_r8, & + & 0.12985e-04_r8,0.15273e-04_r8,0.18381e-04_r8,0.12972e-04_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.12159e-07_r8,0.28311e-05_r8,0.50923e-05_r8,0.71433e-05_r8,0.90735e-05_r8, & + & 0.11042e-04_r8,0.13160e-04_r8,0.16141e-04_r8,0.10790e-04_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.11403e-07_r8,0.28950e-05_r8,0.51829e-05_r8,0.72481e-05_r8,0.92149e-05_r8, & + & 0.11135e-04_r8,0.13267e-04_r8,0.16084e-04_r8,0.10912e-04_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.12436e-07_r8,0.29531e-05_r8,0.52642e-05_r8,0.73461e-05_r8,0.93337e-05_r8, & + & 0.11250e-04_r8,0.13358e-04_r8,0.16208e-04_r8,0.10995e-04_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.14856e-07_r8,0.33723e-05_r8,0.60342e-05_r8,0.84579e-05_r8,0.10776e-04_r8, & + & 0.13025e-04_r8,0.15434e-04_r8,0.18466e-04_r8,0.13550e-04_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.16537e-07_r8,0.30506e-05_r8,0.53821e-05_r8,0.74897e-05_r8,0.94861e-05_r8, & + & 0.11421e-04_r8,0.13503e-04_r8,0.16308e-04_r8,0.11045e-04_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.13114e-07_r8,0.24467e-05_r8,0.44159e-05_r8,0.61941e-05_r8,0.78845e-05_r8, & + & 0.96031e-05_r8,0.11513e-04_r8,0.14234e-04_r8,0.89642e-05_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.15028e-07_r8,0.25040e-05_r8,0.44954e-05_r8,0.62931e-05_r8,0.80050e-05_r8, & + & 0.97056e-05_r8,0.11618e-04_r8,0.14175e-04_r8,0.90802e-05_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.18213e-07_r8,0.25556e-05_r8,0.45678e-05_r8,0.63789e-05_r8,0.81071e-05_r8, & + & 0.98077e-05_r8,0.11694e-04_r8,0.14301e-04_r8,0.91538e-05_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.19097e-07_r8,0.26037e-05_r8,0.46288e-05_r8,0.64476e-05_r8,0.81897e-05_r8, & + & 0.98941e-05_r8,0.11740e-04_r8,0.14344e-04_r8,0.91968e-05_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.18014e-07_r8,0.29993e-05_r8,0.53622e-05_r8,0.75209e-05_r8,0.95686e-05_r8, & + & 0.11571e-04_r8,0.13783e-04_r8,0.16522e-04_r8,0.11644e-04_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.21237e-07_r8,0.20921e-05_r8,0.37961e-05_r8,0.53264e-05_r8,0.67905e-05_r8, & + & 0.82846e-05_r8,0.99803e-05_r8,0.12512e-04_r8,0.44075e-05_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.23885e-07_r8,0.21444e-05_r8,0.38676e-05_r8,0.54146e-05_r8,0.68931e-05_r8, & + & 0.83832e-05_r8,0.10077e-04_r8,0.12417e-04_r8,0.44982e-05_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.20851e-07_r8,0.21906e-05_r8,0.39301e-05_r8,0.54900e-05_r8,0.69833e-05_r8, & + & 0.84513e-05_r8,0.10145e-04_r8,0.12513e-04_r8,0.45299e-05_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.22487e-07_r8,0.22322e-05_r8,0.39843e-05_r8,0.55506e-05_r8,0.70502e-05_r8, & + & 0.85357e-05_r8,0.10189e-04_r8,0.12546e-04_r8,0.45220e-05_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.23015e-07_r8,0.26442e-05_r8,0.47363e-05_r8,0.66520e-05_r8,0.84676e-05_r8, & + & 0.10272e-04_r8,0.12268e-04_r8,0.14801e-04_r8,0.72945e-05_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.22693e-07_r8,0.17592e-05_r8,0.32289e-05_r8,0.45327e-05_r8,0.57876e-05_r8, & + & 0.70822e-05_r8,0.85643e-05_r8,0.10966e-04_r8,0.53375e-05_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.22407e-07_r8,0.18081e-05_r8,0.32912e-05_r8,0.46136e-05_r8,0.58716e-05_r8, & + & 0.71710e-05_r8,0.86530e-05_r8,0.10805e-04_r8,0.53845e-05_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.22705e-07_r8,0.18504e-05_r8,0.33475e-05_r8,0.46786e-05_r8,0.59585e-05_r8, & + & 0.72252e-05_r8,0.87123e-05_r8,0.10876e-04_r8,0.53808e-05_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.23941e-07_r8,0.18862e-05_r8,0.33938e-05_r8,0.47325e-05_r8,0.60159e-05_r8, & + & 0.72910e-05_r8,0.87573e-05_r8,0.10893e-04_r8,0.53357e-05_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.27004e-07_r8,0.19136e-05_r8,0.34294e-05_r8,0.47766e-05_r8,0.60573e-05_r8, & + & 0.73309e-05_r8,0.87892e-05_r8,0.10892e-04_r8,0.52484e-05_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.27131e-07_r8,0.14236e-05_r8,0.27128e-05_r8,0.38203e-05_r8,0.48870e-05_r8, & + & 0.59983e-05_r8,0.72827e-05_r8,0.94729e-05_r8,0.86942e-05_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.26214e-07_r8,0.14673e-05_r8,0.27677e-05_r8,0.38940e-05_r8,0.49627e-05_r8, & + & 0.60727e-05_r8,0.73587e-05_r8,0.93332e-05_r8,0.87651e-05_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.29249e-07_r8,0.15085e-05_r8,0.28175e-05_r8,0.39503e-05_r8,0.50362e-05_r8, & + & 0.61230e-05_r8,0.74095e-05_r8,0.93608e-05_r8,0.87497e-05_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.35846e-07_r8,0.15423e-05_r8,0.28570e-05_r8,0.39988e-05_r8,0.50875e-05_r8, & + & 0.61709e-05_r8,0.74491e-05_r8,0.93691e-05_r8,0.88300e-05_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.36255e-07_r8,0.15665e-05_r8,0.28868e-05_r8,0.40378e-05_r8,0.51248e-05_r8, & + & 0.62083e-05_r8,0.74689e-05_r8,0.93597e-05_r8,0.88065e-05_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.37619e-07_r8,0.92017e-06_r8,0.22295e-05_r8,0.31821e-05_r8,0.40883e-05_r8, & + & 0.50331e-05_r8,0.61447e-05_r8,0.80461e-05_r8,0.15512e-04_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.43015e-07_r8,0.95048e-06_r8,0.22782e-05_r8,0.32493e-05_r8,0.41585e-05_r8, & + & 0.50968e-05_r8,0.61995e-05_r8,0.80232e-05_r8,0.15472e-04_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.47635e-07_r8,0.97934e-06_r8,0.23207e-05_r8,0.33002e-05_r8,0.42181e-05_r8, & + & 0.51430e-05_r8,0.62468e-05_r8,0.79821e-05_r8,0.15652e-04_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.48140e-07_r8,0.10026e-05_r8,0.23582e-05_r8,0.33416e-05_r8,0.42650e-05_r8, & + & 0.51734e-05_r8,0.62779e-05_r8,0.79833e-05_r8,0.15762e-04_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.45231e-07_r8,0.10212e-05_r8,0.23819e-05_r8,0.33754e-05_r8,0.42991e-05_r8, & + & 0.52146e-05_r8,0.62945e-05_r8,0.79701e-05_r8,0.15840e-04_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.48601e-07_r8,0.49350e-06_r8,0.16585e-05_r8,0.26009e-05_r8,0.33796e-05_r8, & + & 0.41888e-05_r8,0.51434e-05_r8,0.67867e-05_r8,0.26875e-04_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.49825e-07_r8,0.51680e-06_r8,0.16935e-05_r8,0.26607e-05_r8,0.34457e-05_r8, & + & 0.42434e-05_r8,0.51839e-05_r8,0.68587e-05_r8,0.27475e-04_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.52843e-07_r8,0.53573e-06_r8,0.17199e-05_r8,0.27038e-05_r8,0.35027e-05_r8, & + & 0.42858e-05_r8,0.52233e-05_r8,0.67410e-05_r8,0.28097e-04_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.49841e-07_r8,0.54248e-06_r8,0.17493e-05_r8,0.27418e-05_r8,0.35427e-05_r8, & + & 0.43127e-05_r8,0.52517e-05_r8,0.67418e-05_r8,0.28632e-04_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.50649e-07_r8,0.54940e-06_r8,0.17700e-05_r8,0.27695e-05_r8,0.35712e-05_r8, & + & 0.43482e-05_r8,0.52645e-05_r8,0.67282e-05_r8,0.28662e-04_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.82685e-07_r8,0.54022e-06_r8,0.87761e-06_r8,0.18752e-05_r8,0.27293e-05_r8, & + & 0.34506e-05_r8,0.42821e-05_r8,0.56501e-05_r8,0.44067e-04_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.87011e-07_r8,0.54017e-06_r8,0.89732e-06_r8,0.19208e-05_r8,0.27945e-05_r8, & + & 0.35005e-05_r8,0.43124e-05_r8,0.57881e-05_r8,0.45858e-04_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.79909e-07_r8,0.55355e-06_r8,0.90995e-06_r8,0.19451e-05_r8,0.28460e-05_r8, & + & 0.35425e-05_r8,0.43438e-05_r8,0.56593e-05_r8,0.45805e-04_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.75533e-07_r8,0.55705e-06_r8,0.92147e-06_r8,0.19661e-05_r8,0.28785e-05_r8, & + & 0.35628e-05_r8,0.43635e-05_r8,0.56526e-05_r8,0.46295e-04_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.76631e-07_r8,0.55159e-06_r8,0.93362e-06_r8,0.19832e-05_r8,0.29003e-05_r8, & + & 0.35965e-05_r8,0.43731e-05_r8,0.56385e-05_r8,0.46720e-04_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.11164e-06_r8,0.57710e-06_r8,0.71279e-06_r8,0.10003e-05_r8,0.19253e-05_r8, & + & 0.28027e-05_r8,0.35523e-05_r8,0.47607e-05_r8,0.51144e-04_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.11484e-06_r8,0.58649e-06_r8,0.71918e-06_r8,0.10167e-05_r8,0.19538e-05_r8, & + & 0.28431e-05_r8,0.35713e-05_r8,0.48333e-05_r8,0.49887e-04_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.11442e-06_r8,0.58483e-06_r8,0.70503e-06_r8,0.10320e-05_r8,0.19684e-05_r8, & + & 0.28674e-05_r8,0.35911e-05_r8,0.47191e-05_r8,0.50222e-04_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.11737e-06_r8,0.58895e-06_r8,0.70242e-06_r8,0.10442e-05_r8,0.19738e-05_r8, & + & 0.28962e-05_r8,0.36035e-05_r8,0.47045e-05_r8,0.48754e-04_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.12314e-06_r8,0.59299e-06_r8,0.70874e-06_r8,0.10470e-05_r8,0.19736e-05_r8, & + & 0.29100e-05_r8,0.36075e-05_r8,0.46813e-05_r8,0.45986e-04_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.14446e-06_r8,0.57459e-06_r8,0.72800e-06_r8,0.69912e-06_r8,0.11693e-05_r8, & + & 0.21457e-05_r8,0.29151e-05_r8,0.39683e-05_r8,0.42970e-04_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.14738e-06_r8,0.58568e-06_r8,0.75374e-06_r8,0.69814e-06_r8,0.11797e-05_r8, & + & 0.21759e-05_r8,0.29287e-05_r8,0.39942e-05_r8,0.41434e-04_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.15006e-06_r8,0.60144e-06_r8,0.75420e-06_r8,0.70559e-06_r8,0.11849e-05_r8, & + & 0.21718e-05_r8,0.29383e-05_r8,0.39185e-05_r8,0.42909e-04_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.15745e-06_r8,0.60776e-06_r8,0.75984e-06_r8,0.71270e-06_r8,0.11804e-05_r8, & + & 0.21578e-05_r8,0.29477e-05_r8,0.38939e-05_r8,0.41761e-04_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.16583e-06_r8,0.62207e-06_r8,0.74591e-06_r8,0.69746e-06_r8,0.11751e-05_r8, & + & 0.21552e-05_r8,0.29514e-05_r8,0.38695e-05_r8,0.45252e-04_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.18492e-06_r8,0.65841e-06_r8,0.74904e-06_r8,0.82698e-06_r8,0.69790e-06_r8, & + & 0.13356e-05_r8,0.23333e-05_r8,0.33010e-05_r8,0.43502e-04_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.18447e-06_r8,0.66115e-06_r8,0.74200e-06_r8,0.80748e-06_r8,0.68676e-06_r8, & + & 0.13419e-05_r8,0.23369e-05_r8,0.32873e-05_r8,0.44908e-04_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.20107e-06_r8,0.65387e-06_r8,0.73155e-06_r8,0.79291e-06_r8,0.67848e-06_r8, & + & 0.13368e-05_r8,0.23434e-05_r8,0.32337e-05_r8,0.47417e-04_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.20493e-06_r8,0.66191e-06_r8,0.72707e-06_r8,0.79839e-06_r8,0.67208e-06_r8, & + & 0.13273e-05_r8,0.23466e-05_r8,0.32075e-05_r8,0.48703e-04_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.20003e-06_r8,0.66753e-06_r8,0.73390e-06_r8,0.79794e-06_r8,0.66936e-06_r8, & + & 0.13150e-05_r8,0.23558e-05_r8,0.31828e-05_r8,0.50012e-04_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.45955e-07_r8,0.96988e-05_r8,0.16766e-04_r8,0.23073e-04_r8,0.28829e-04_r8, & + & 0.34350e-04_r8,0.39744e-04_r8,0.45071e-04_r8,0.36783e-04_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.57268e-07_r8,0.98413e-05_r8,0.16970e-04_r8,0.23311e-04_r8,0.29149e-04_r8, & + & 0.34726e-04_r8,0.40229e-04_r8,0.45682e-04_r8,0.37190e-04_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.70060e-07_r8,0.10517e-04_r8,0.18168e-04_r8,0.24965e-04_r8,0.31264e-04_r8, & + & 0.37439e-04_r8,0.43299e-04_r8,0.49335e-04_r8,0.41254e-04_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.84370e-07_r8,0.10120e-04_r8,0.17302e-04_r8,0.23633e-04_r8,0.29544e-04_r8, & + & 0.35368e-04_r8,0.40885e-04_r8,0.46535e-04_r8,0.37819e-04_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.97346e-07_r8,0.10254e-04_r8,0.17458e-04_r8,0.23773e-04_r8,0.29672e-04_r8, & + & 0.35542e-04_r8,0.41140e-04_r8,0.46864e-04_r8,0.38054e-04_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.27937e-07_r8,0.87332e-05_r8,0.15102e-04_r8,0.20785e-04_r8,0.26002e-04_r8, & + & 0.30993e-04_r8,0.35918e-04_r8,0.41124e-04_r8,0.32692e-04_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.34502e-07_r8,0.88655e-05_r8,0.15279e-04_r8,0.20992e-04_r8,0.26281e-04_r8, & + & 0.31393e-04_r8,0.36363e-04_r8,0.41768e-04_r8,0.33047e-04_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.45243e-07_r8,0.95567e-05_r8,0.16535e-04_r8,0.22740e-04_r8,0.28503e-04_r8, & + & 0.34161e-04_r8,0.39521e-04_r8,0.45509e-04_r8,0.37184e-04_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.56029e-07_r8,0.96404e-05_r8,0.16599e-04_r8,0.22759e-04_r8,0.28526e-04_r8, & + & 0.34207e-04_r8,0.39586e-04_r8,0.45601e-04_r8,0.37152e-04_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.67453e-07_r8,0.92372e-05_r8,0.15744e-04_r8,0.21435e-04_r8,0.26769e-04_r8, & + & 0.32085e-04_r8,0.37228e-04_r8,0.42908e-04_r8,0.33841e-04_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.21909e-07_r8,0.77821e-05_r8,0.13457e-04_r8,0.18525e-04_r8,0.23194e-04_r8, & + & 0.27662e-04_r8,0.32086e-04_r8,0.37089e-04_r8,0.28700e-04_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.25816e-07_r8,0.78998e-05_r8,0.13627e-04_r8,0.18723e-04_r8,0.23459e-04_r8, & + & 0.28049e-04_r8,0.32494e-04_r8,0.37775e-04_r8,0.29060e-04_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.28009e-07_r8,0.80177e-05_r8,0.13778e-04_r8,0.18883e-04_r8,0.23652e-04_r8, & + & 0.28348e-04_r8,0.32831e-04_r8,0.38183e-04_r8,0.29363e-04_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.32250e-07_r8,0.87000e-05_r8,0.14997e-04_r8,0.20591e-04_r8,0.25858e-04_r8, & + & 0.30984e-04_r8,0.35855e-04_r8,0.41716e-04_r8,0.33352e-04_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.38565e-07_r8,0.82442e-05_r8,0.14048e-04_r8,0.19147e-04_r8,0.23963e-04_r8, & + & 0.28712e-04_r8,0.33322e-04_r8,0.38841e-04_r8,0.29827e-04_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.27845e-07_r8,0.68782e-05_r8,0.11887e-04_r8,0.16370e-04_r8,0.20522e-04_r8, & + & 0.24507e-04_r8,0.28445e-04_r8,0.33146e-04_r8,0.25091e-04_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.30162e-07_r8,0.69860e-05_r8,0.12053e-04_r8,0.16569e-04_r8,0.20786e-04_r8, & + & 0.24863e-04_r8,0.28833e-04_r8,0.33823e-04_r8,0.25439e-04_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.31547e-07_r8,0.70934e-05_r8,0.12196e-04_r8,0.16734e-04_r8,0.20984e-04_r8, & + & 0.25140e-04_r8,0.29167e-04_r8,0.34188e-04_r8,0.25743e-04_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.30733e-07_r8,0.72009e-05_r8,0.12319e-04_r8,0.16870e-04_r8,0.21150e-04_r8, & + & 0.25350e-04_r8,0.29432e-04_r8,0.34551e-04_r8,0.26011e-04_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.33104e-07_r8,0.78742e-05_r8,0.13511e-04_r8,0.18536e-04_r8,0.23314e-04_r8, & + & 0.27934e-04_r8,0.32284e-04_r8,0.37983e-04_r8,0.29911e-04_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.31453e-07_r8,0.60344e-05_r8,0.10431e-04_r8,0.14360e-04_r8,0.18025e-04_r8, & + & 0.21556e-04_r8,0.25057e-04_r8,0.29352e-04_r8,0.21244e-04_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.32645e-07_r8,0.61373e-05_r8,0.10589e-04_r8,0.14561e-04_r8,0.18288e-04_r8, & + & 0.21896e-04_r8,0.25427e-04_r8,0.30041e-04_r8,0.21582e-04_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.36285e-07_r8,0.62371e-05_r8,0.10724e-04_r8,0.14730e-04_r8,0.18494e-04_r8, & + & 0.22175e-04_r8,0.25749e-04_r8,0.30401e-04_r8,0.21875e-04_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.35840e-07_r8,0.63361e-05_r8,0.10841e-04_r8,0.14872e-04_r8,0.18672e-04_r8, & + & 0.22386e-04_r8,0.26001e-04_r8,0.30772e-04_r8,0.22136e-04_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.34391e-07_r8,0.70384e-05_r8,0.12100e-04_r8,0.16639e-04_r8,0.20967e-04_r8, & + & 0.25106e-04_r8,0.29033e-04_r8,0.34382e-04_r8,0.26458e-04_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.38317e-07_r8,0.52554e-05_r8,0.90847e-05_r8,0.12506e-04_r8,0.15706e-04_r8, & + & 0.18802e-04_r8,0.21926e-04_r8,0.25721e-04_r8,0.82786e-05_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.42993e-07_r8,0.53521e-05_r8,0.92425e-05_r8,0.12708e-04_r8,0.15965e-04_r8, & + & 0.19131e-04_r8,0.22269e-04_r8,0.26449e-04_r8,0.85145e-05_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.43612e-07_r8,0.54474e-05_r8,0.93707e-05_r8,0.12875e-04_r8,0.16176e-04_r8, & + & 0.19407e-04_r8,0.22575e-04_r8,0.26830e-04_r8,0.87594e-05_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.42757e-07_r8,0.55405e-05_r8,0.94823e-05_r8,0.13019e-04_r8,0.16363e-04_r8, & + & 0.19625e-04_r8,0.22815e-04_r8,0.27200e-04_r8,0.90170e-05_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.43664e-07_r8,0.56274e-05_r8,0.95923e-05_r8,0.13140e-04_r8,0.16520e-04_r8, & + & 0.19797e-04_r8,0.22995e-04_r8,0.27528e-04_r8,0.91836e-05_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.39995e-07_r8,0.45414e-05_r8,0.78502e-05_r8,0.10801e-04_r8,0.13562e-04_r8, & + & 0.16248e-04_r8,0.19009e-04_r8,0.22439e-04_r8,0.93804e-05_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.43614e-07_r8,0.46331e-05_r8,0.80059e-05_r8,0.11000e-04_r8,0.13813e-04_r8, & + & 0.16577e-04_r8,0.19346e-04_r8,0.23103e-04_r8,0.95334e-05_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.45687e-07_r8,0.47201e-05_r8,0.81316e-05_r8,0.11167e-04_r8,0.14031e-04_r8, & + & 0.16844e-04_r8,0.19646e-04_r8,0.23513e-04_r8,0.96503e-05_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.48386e-07_r8,0.48081e-05_r8,0.82413e-05_r8,0.11310e-04_r8,0.14223e-04_r8, & + & 0.17063e-04_r8,0.19885e-04_r8,0.23881e-04_r8,0.95360e-05_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.54287e-07_r8,0.48899e-05_r8,0.83473e-05_r8,0.11434e-04_r8,0.14383e-04_r8, & + & 0.17240e-04_r8,0.20064e-04_r8,0.24201e-04_r8,0.94267e-05_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.45720e-07_r8,0.38685e-05_r8,0.67269e-05_r8,0.92537e-05_r8,0.11613e-04_r8, & + & 0.13930e-04_r8,0.16333e-04_r8,0.19500e-04_r8,0.15537e-04_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.46817e-07_r8,0.39568e-05_r8,0.68775e-05_r8,0.94493e-05_r8,0.11857e-04_r8, & + & 0.14250e-04_r8,0.16679e-04_r8,0.19983e-04_r8,0.15822e-04_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.48700e-07_r8,0.40362e-05_r8,0.70012e-05_r8,0.96148e-05_r8,0.12076e-04_r8, & + & 0.14508e-04_r8,0.16969e-04_r8,0.20440e-04_r8,0.15878e-04_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.54460e-07_r8,0.41199e-05_r8,0.71098e-05_r8,0.97580e-05_r8,0.12268e-04_r8, & + & 0.14725e-04_r8,0.17206e-04_r8,0.20805e-04_r8,0.16014e-04_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.59565e-07_r8,0.42000e-05_r8,0.72128e-05_r8,0.98789e-05_r8,0.12424e-04_r8, & + & 0.14896e-04_r8,0.17382e-04_r8,0.21113e-04_r8,0.15894e-04_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.60502e-07_r8,0.31758e-05_r8,0.57011e-05_r8,0.78602e-05_r8,0.98646e-05_r8, & + & 0.11842e-04_r8,0.13914e-04_r8,0.16812e-04_r8,0.32738e-04_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.61920e-07_r8,0.32583e-05_r8,0.58474e-05_r8,0.80501e-05_r8,0.10097e-04_r8, & + & 0.12150e-04_r8,0.14260e-04_r8,0.17128e-04_r8,0.32707e-04_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.66102e-07_r8,0.33410e-05_r8,0.59686e-05_r8,0.82148e-05_r8,0.10310e-04_r8, & + & 0.12398e-04_r8,0.14542e-04_r8,0.17650e-04_r8,0.33629e-04_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.86168e-07_r8,0.34261e-05_r8,0.60763e-05_r8,0.83539e-05_r8,0.10496e-04_r8, & + & 0.12604e-04_r8,0.14773e-04_r8,0.17994e-04_r8,0.33878e-04_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.91586e-07_r8,0.35057e-05_r8,0.61764e-05_r8,0.84703e-05_r8,0.10646e-04_r8, & + & 0.12765e-04_r8,0.14939e-04_r8,0.18282e-04_r8,0.33645e-04_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.96997e-07_r8,0.19211e-05_r8,0.47098e-05_r8,0.66155e-05_r8,0.83225e-05_r8, & + & 0.10005e-04_r8,0.11773e-04_r8,0.14404e-04_r8,0.53631e-04_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.96064e-07_r8,0.20141e-05_r8,0.48491e-05_r8,0.67941e-05_r8,0.85382e-05_r8, & + & 0.10290e-04_r8,0.12102e-04_r8,0.14626e-04_r8,0.54289e-04_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.10431e-06_r8,0.20834e-05_r8,0.49690e-05_r8,0.69520e-05_r8,0.87398e-05_r8, & + & 0.10520e-04_r8,0.12369e-04_r8,0.15124e-04_r8,0.55603e-04_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.11432e-06_r8,0.21653e-05_r8,0.50755e-05_r8,0.70852e-05_r8,0.89148e-05_r8, & + & 0.10714e-04_r8,0.12591e-04_r8,0.15457e-04_r8,0.56630e-04_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.11074e-06_r8,0.22480e-05_r8,0.51732e-05_r8,0.71951e-05_r8,0.90530e-05_r8, & + & 0.10860e-04_r8,0.12745e-04_r8,0.15721e-04_r8,0.54963e-04_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.15854e-06_r8,0.91297e-06_r8,0.32555e-05_r8,0.55113e-05_r8,0.70464e-05_r8, & + & 0.85121e-05_r8,0.10027e-04_r8,0.12303e-04_r8,0.52607e-04_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.16751e-06_r8,0.96634e-06_r8,0.33790e-05_r8,0.56722e-05_r8,0.72351e-05_r8, & + & 0.87519e-05_r8,0.10311e-04_r8,0.12547e-04_r8,0.52883e-04_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.16741e-06_r8,0.10318e-05_r8,0.35064e-05_r8,0.58058e-05_r8,0.74099e-05_r8, & + & 0.89413e-05_r8,0.10546e-04_r8,0.12998e-04_r8,0.52407e-04_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.16708e-06_r8,0.10925e-05_r8,0.36064e-05_r8,0.59145e-05_r8,0.75531e-05_r8, & + & 0.90996e-05_r8,0.10715e-04_r8,0.13285e-04_r8,0.53203e-04_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.16578e-06_r8,0.11490e-05_r8,0.36852e-05_r8,0.60104e-05_r8,0.76652e-05_r8, & + & 0.92182e-05_r8,0.10838e-04_r8,0.13496e-04_r8,0.54467e-04_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.17287e-06_r8,0.67222e-06_r8,0.20177e-05_r8,0.42045e-05_r8,0.58863e-05_r8, & + & 0.71911e-05_r8,0.84904e-05_r8,0.10467e-04_r8,0.53824e-04_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.17534e-06_r8,0.66930e-06_r8,0.20902e-05_r8,0.43510e-05_r8,0.60518e-05_r8, & + & 0.73834e-05_r8,0.87285e-05_r8,0.10723e-04_r8,0.57713e-04_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.19862e-06_r8,0.69271e-06_r8,0.21807e-05_r8,0.44473e-05_r8,0.61938e-05_r8, & + & 0.75395e-05_r8,0.89230e-05_r8,0.11082e-04_r8,0.58727e-04_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.20481e-06_r8,0.70155e-06_r8,0.22437e-05_r8,0.45330e-05_r8,0.63072e-05_r8, & + & 0.76639e-05_r8,0.90515e-05_r8,0.11316e-04_r8,0.62478e-04_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.22362e-06_r8,0.66686e-06_r8,0.23107e-05_r8,0.46277e-05_r8,0.64004e-05_r8, & + & 0.77560e-05_r8,0.91460e-05_r8,0.11480e-04_r8,0.61459e-04_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.24394e-06_r8,0.78850e-06_r8,0.10005e-05_r8,0.25869e-05_r8,0.46671e-05_r8, & + & 0.60110e-05_r8,0.71462e-05_r8,0.88357e-05_r8,0.59707e-04_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.25387e-06_r8,0.77656e-06_r8,0.10565e-05_r8,0.27093e-05_r8,0.48105e-05_r8, & + & 0.61610e-05_r8,0.73436e-05_r8,0.90989e-05_r8,0.60151e-04_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.22260e-06_r8,0.76604e-06_r8,0.11188e-05_r8,0.28168e-05_r8,0.49259e-05_r8, & + & 0.62864e-05_r8,0.74912e-05_r8,0.93777e-05_r8,0.58560e-04_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.22499e-06_r8,0.75979e-06_r8,0.11746e-05_r8,0.28869e-05_r8,0.50154e-05_r8, & + & 0.63819e-05_r8,0.75933e-05_r8,0.95633e-05_r8,0.61656e-04_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.22527e-06_r8,0.74699e-06_r8,0.12195e-05_r8,0.29526e-05_r8,0.50915e-05_r8, & + & 0.64528e-05_r8,0.76669e-05_r8,0.96909e-05_r8,0.60588e-04_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.29788e-05_r8,0.29380e-04_r8,0.47103e-04_r8,0.62484e-04_r8,0.75923e-04_r8, & + & 0.86945e-04_r8,0.96459e-04_r8,0.10727e-03_r8,0.95715e-04_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.31829e-05_r8,0.29542e-04_r8,0.47406e-04_r8,0.62987e-04_r8,0.76500e-04_r8, & + & 0.87575e-04_r8,0.97244e-04_r8,0.10847e-03_r8,0.96769e-04_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.34017e-05_r8,0.30451e-04_r8,0.49181e-04_r8,0.65673e-04_r8,0.79848e-04_r8, & + & 0.91475e-04_r8,0.10206e-03_r8,0.11418e-03_r8,0.10339e-03_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.36204e-05_r8,0.29858e-04_r8,0.47964e-04_r8,0.63849e-04_r8,0.77416e-04_r8, & + & 0.88495e-04_r8,0.98624e-04_r8,0.11030e-03_r8,0.98665e-04_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.38336e-05_r8,0.30032e-04_r8,0.48176e-04_r8,0.64174e-04_r8,0.77743e-04_r8, & + & 0.88899e-04_r8,0.99219e-04_r8,0.11117e-03_r8,0.99410e-04_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.24422e-05_r8,0.27039e-04_r8,0.43472e-04_r8,0.57657e-04_r8,0.69985e-04_r8, & + & 0.80297e-04_r8,0.89716e-04_r8,0.10091e-03_r8,0.87814e-04_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.26194e-05_r8,0.27224e-04_r8,0.43834e-04_r8,0.58227e-04_r8,0.70564e-04_r8, & + & 0.80899e-04_r8,0.90555e-04_r8,0.10201e-03_r8,0.88900e-04_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.28026e-05_r8,0.28185e-04_r8,0.45675e-04_r8,0.60941e-04_r8,0.73932e-04_r8, & + & 0.84933e-04_r8,0.95539e-04_r8,0.10795e-03_r8,0.95932e-04_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.29807e-05_r8,0.28297e-04_r8,0.45818e-04_r8,0.61151e-04_r8,0.74119e-04_r8, & + & 0.85132e-04_r8,0.95905e-04_r8,0.10857e-03_r8,0.96316e-04_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.31559e-05_r8,0.27777e-04_r8,0.44649e-04_r8,0.59431e-04_r8,0.71821e-04_r8, & + & 0.82324e-04_r8,0.92537e-04_r8,0.10487e-03_r8,0.91446e-04_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.19527e-05_r8,0.24728e-04_r8,0.39864e-04_r8,0.52777e-04_r8,0.63893e-04_r8, & + & 0.73441e-04_r8,0.82582e-04_r8,0.93968e-04_r8,0.79571e-04_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.21028e-05_r8,0.24948e-04_r8,0.40273e-04_r8,0.53366e-04_r8,0.64472e-04_r8, & + & 0.74070e-04_r8,0.83496e-04_r8,0.95166e-04_r8,0.80711e-04_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.22571e-05_r8,0.25146e-04_r8,0.40613e-04_r8,0.53873e-04_r8,0.64998e-04_r8, & + & 0.74638e-04_r8,0.84298e-04_r8,0.96249e-04_r8,0.81670e-04_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.24052e-05_r8,0.26082e-04_r8,0.42367e-04_r8,0.56407e-04_r8,0.68204e-04_r8, & + & 0.78600e-04_r8,0.89199e-04_r8,0.10217e-03_r8,0.88502e-04_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.25493e-05_r8,0.25521e-04_r8,0.41156e-04_r8,0.54597e-04_r8,0.65795e-04_r8, & + & 0.75610e-04_r8,0.85600e-04_r8,0.98234e-04_r8,0.83132e-04_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.15249e-05_r8,0.22458e-04_r8,0.36230e-04_r8,0.47832e-04_r8,0.57788e-04_r8, & + & 0.66572e-04_r8,0.75267e-04_r8,0.86613e-04_r8,0.71765e-04_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.16472e-05_r8,0.22706e-04_r8,0.36674e-04_r8,0.48420e-04_r8,0.58373e-04_r8, & + & 0.67233e-04_r8,0.76205e-04_r8,0.87918e-04_r8,0.72872e-04_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.17727e-05_r8,0.22924e-04_r8,0.37041e-04_r8,0.48925e-04_r8,0.58917e-04_r8, & + & 0.67822e-04_r8,0.77056e-04_r8,0.89127e-04_r8,0.73812e-04_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.18979e-05_r8,0.23116e-04_r8,0.37363e-04_r8,0.49353e-04_r8,0.59386e-04_r8, & + & 0.68373e-04_r8,0.77816e-04_r8,0.90208e-04_r8,0.74597e-04_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.20187e-05_r8,0.24032e-04_r8,0.39090e-04_r8,0.51784e-04_r8,0.62486e-04_r8, & + & 0.72274e-04_r8,0.82652e-04_r8,0.95944e-04_r8,0.81360e-04_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.11616e-05_r8,0.20230e-04_r8,0.32593e-04_r8,0.43015e-04_r8,0.51913e-04_r8, & + & 0.59885e-04_r8,0.68041e-04_r8,0.79091e-04_r8,0.64237e-04_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.12634e-05_r8,0.20493e-04_r8,0.33052e-04_r8,0.43575e-04_r8,0.52485e-04_r8, & + & 0.60579e-04_r8,0.68993e-04_r8,0.80447e-04_r8,0.65308e-04_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.13665e-05_r8,0.20722e-04_r8,0.33449e-04_r8,0.44078e-04_r8,0.53031e-04_r8, & + & 0.61206e-04_r8,0.69878e-04_r8,0.81712e-04_r8,0.66219e-04_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.14654e-05_r8,0.20926e-04_r8,0.33806e-04_r8,0.44507e-04_r8,0.53511e-04_r8, & + & 0.61775e-04_r8,0.70644e-04_r8,0.82800e-04_r8,0.67010e-04_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.15654e-05_r8,0.21919e-04_r8,0.35683e-04_r8,0.47135e-04_r8,0.56892e-04_r8, & + & 0.66014e-04_r8,0.75901e-04_r8,0.88948e-04_r8,0.74367e-04_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.85477e-06_r8,0.18056e-04_r8,0.29058e-04_r8,0.38374e-04_r8,0.46318e-04_r8, & + & 0.53503e-04_r8,0.60983e-04_r8,0.71567e-04_r8,0.55220e-04_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.93399e-06_r8,0.18333e-04_r8,0.29518e-04_r8,0.38924e-04_r8,0.46903e-04_r8, & + & 0.54228e-04_r8,0.61990e-04_r8,0.72960e-04_r8,0.56327e-04_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.10173e-05_r8,0.18568e-04_r8,0.29940e-04_r8,0.39430e-04_r8,0.47457e-04_r8, & + & 0.54891e-04_r8,0.62912e-04_r8,0.74219e-04_r8,0.57262e-04_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.10990e-05_r8,0.18773e-04_r8,0.30321e-04_r8,0.39858e-04_r8,0.47937e-04_r8, & + & 0.55463e-04_r8,0.63685e-04_r8,0.75339e-04_r8,0.58060e-04_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.11736e-05_r8,0.18980e-04_r8,0.30632e-04_r8,0.40210e-04_r8,0.48338e-04_r8, & + & 0.55952e-04_r8,0.64349e-04_r8,0.76243e-04_r8,0.58787e-04_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.60315e-06_r8,0.15982e-04_r8,0.25725e-04_r8,0.33991e-04_r8,0.41066e-04_r8, & + & 0.47516e-04_r8,0.54302e-04_r8,0.64196e-04_r8,0.19175e-04_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.66792e-06_r8,0.16270e-04_r8,0.26184e-04_r8,0.34534e-04_r8,0.41673e-04_r8, & + & 0.48253e-04_r8,0.55322e-04_r8,0.65617e-04_r8,0.20214e-04_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.72908e-06_r8,0.16517e-04_r8,0.26616e-04_r8,0.35037e-04_r8,0.42229e-04_r8, & + & 0.48924e-04_r8,0.56239e-04_r8,0.66903e-04_r8,0.21171e-04_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.78570e-06_r8,0.16735e-04_r8,0.27002e-04_r8,0.35463e-04_r8,0.42700e-04_r8, & + & 0.49504e-04_r8,0.57015e-04_r8,0.68011e-04_r8,0.22118e-04_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.83832e-06_r8,0.16948e-04_r8,0.27325e-04_r8,0.35815e-04_r8,0.43102e-04_r8, & + & 0.50003e-04_r8,0.57693e-04_r8,0.68917e-04_r8,0.22989e-04_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.37835e-06_r8,0.14042e-04_r8,0.22619e-04_r8,0.29906e-04_r8,0.36184e-04_r8, & + & 0.41943e-04_r8,0.48058e-04_r8,0.57159e-04_r8,0.15030e-04_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.42400e-06_r8,0.14336e-04_r8,0.23076e-04_r8,0.30441e-04_r8,0.36790e-04_r8, & + & 0.42677e-04_r8,0.49055e-04_r8,0.58574e-04_r8,0.15267e-04_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.47003e-06_r8,0.14598e-04_r8,0.23503e-04_r8,0.30926e-04_r8,0.37338e-04_r8, & + & 0.43345e-04_r8,0.49944e-04_r8,0.59871e-04_r8,0.15168e-04_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.50983e-06_r8,0.14832e-04_r8,0.23887e-04_r8,0.31342e-04_r8,0.37806e-04_r8, & + & 0.43932e-04_r8,0.50714e-04_r8,0.60954e-04_r8,0.15479e-04_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.55238e-06_r8,0.15050e-04_r8,0.24211e-04_r8,0.31698e-04_r8,0.38215e-04_r8, & + & 0.44447e-04_r8,0.51404e-04_r8,0.61843e-04_r8,0.15864e-04_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.20614e-06_r8,0.12247e-04_r8,0.19755e-04_r8,0.26136e-04_r8,0.31671e-04_r8, & + & 0.36795e-04_r8,0.42267e-04_r8,0.50480e-04_r8,0.31415e-04_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.22820e-06_r8,0.12543e-04_r8,0.20203e-04_r8,0.26660e-04_r8,0.32273e-04_r8, & + & 0.37518e-04_r8,0.43228e-04_r8,0.51895e-04_r8,0.32257e-04_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.25381e-06_r8,0.12814e-04_r8,0.20621e-04_r8,0.27129e-04_r8,0.32814e-04_r8, & + & 0.38186e-04_r8,0.44095e-04_r8,0.53151e-04_r8,0.31766e-04_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.26266e-06_r8,0.13056e-04_r8,0.20991e-04_r8,0.27538e-04_r8,0.33285e-04_r8, & + & 0.38781e-04_r8,0.44859e-04_r8,0.54214e-04_r8,0.32184e-04_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.28878e-06_r8,0.13277e-04_r8,0.21308e-04_r8,0.27899e-04_r8,0.33704e-04_r8, & + & 0.39313e-04_r8,0.45556e-04_r8,0.55111e-04_r8,0.32436e-04_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.12421e-06_r8,0.10598e-04_r8,0.17170e-04_r8,0.22745e-04_r8,0.27597e-04_r8, & + & 0.32129e-04_r8,0.37024e-04_r8,0.44410e-04_r8,0.36288e-04_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.11833e-06_r8,0.10888e-04_r8,0.17606e-04_r8,0.23251e-04_r8,0.28191e-04_r8, & + & 0.32843e-04_r8,0.37957e-04_r8,0.45757e-04_r8,0.36706e-04_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.11564e-06_r8,0.11153e-04_r8,0.18009e-04_r8,0.23706e-04_r8,0.28726e-04_r8, & + & 0.33507e-04_r8,0.38804e-04_r8,0.46971e-04_r8,0.39285e-04_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.11888e-06_r8,0.11400e-04_r8,0.18364e-04_r8,0.24104e-04_r8,0.29196e-04_r8, & + & 0.34101e-04_r8,0.39555e-04_r8,0.47996e-04_r8,0.37765e-04_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.13250e-06_r8,0.11625e-04_r8,0.18671e-04_r8,0.24463e-04_r8,0.29622e-04_r8, & + & 0.34646e-04_r8,0.40249e-04_r8,0.48876e-04_r8,0.41184e-04_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.17958e-06_r8,0.90757e-05_r8,0.15007e-04_r8,0.19889e-04_r8,0.24154e-04_r8, & + & 0.28187e-04_r8,0.32636e-04_r8,0.39437e-04_r8,0.34162e-04_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.18139e-06_r8,0.93666e-05_r8,0.15418e-04_r8,0.20361e-04_r8,0.24716e-04_r8, & + & 0.28864e-04_r8,0.33507e-04_r8,0.40680e-04_r8,0.35787e-04_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.18275e-06_r8,0.96291e-05_r8,0.15787e-04_r8,0.20786e-04_r8,0.25221e-04_r8, & + & 0.29495e-04_r8,0.34295e-04_r8,0.41765e-04_r8,0.33878e-04_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.18574e-06_r8,0.98743e-05_r8,0.16117e-04_r8,0.21165e-04_r8,0.25673e-04_r8, & + & 0.30069e-04_r8,0.35015e-04_r8,0.42686e-04_r8,0.32841e-04_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.20082e-06_r8,0.10102e-04_r8,0.16409e-04_r8,0.21512e-04_r8,0.26096e-04_r8, & + & 0.30600e-04_r8,0.35678e-04_r8,0.43526e-04_r8,0.33904e-04_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.23860e-06_r8,0.72127e-05_r8,0.13015e-04_r8,0.17297e-04_r8,0.21033e-04_r8, & + & 0.24600e-04_r8,0.28604e-04_r8,0.34818e-04_r8,0.40933e-04_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.23391e-06_r8,0.75352e-05_r8,0.13408e-04_r8,0.17740e-04_r8,0.21564e-04_r8, & + & 0.25251e-04_r8,0.29426e-04_r8,0.35947e-04_r8,0.39399e-04_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.24701e-06_r8,0.78057e-05_r8,0.13760e-04_r8,0.18144e-04_r8,0.22045e-04_r8, & + & 0.25844e-04_r8,0.30162e-04_r8,0.36924e-04_r8,0.38294e-04_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.26761e-06_r8,0.80774e-05_r8,0.14071e-04_r8,0.18509e-04_r8,0.22485e-04_r8, & + & 0.26399e-04_r8,0.30850e-04_r8,0.37793e-04_r8,0.37310e-04_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.23665e-06_r8,0.83711e-05_r8,0.14360e-04_r8,0.18850e-04_r8,0.22903e-04_r8, & + & 0.26918e-04_r8,0.31485e-04_r8,0.38601e-04_r8,0.34593e-04_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.27521e-06_r8,0.50755e-05_r8,0.11059e-04_r8,0.14942e-04_r8,0.18221e-04_r8, & + & 0.21366e-04_r8,0.24941e-04_r8,0.30569e-04_r8,0.35909e-04_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.25317e-06_r8,0.53749e-05_r8,0.11450e-04_r8,0.15364e-04_r8,0.18725e-04_r8, & + & 0.21982e-04_r8,0.25707e-04_r8,0.31598e-04_r8,0.37411e-04_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.23895e-06_r8,0.56684e-05_r8,0.11800e-04_r8,0.15745e-04_r8,0.19182e-04_r8, & + & 0.22548e-04_r8,0.26403e-04_r8,0.32490e-04_r8,0.35715e-04_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.23323e-06_r8,0.59219e-05_r8,0.12110e-04_r8,0.16104e-04_r8,0.19621e-04_r8, & + & 0.23090e-04_r8,0.27069e-04_r8,0.33309e-04_r8,0.26489e-04_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.23115e-06_r8,0.61949e-05_r8,0.12408e-04_r8,0.16438e-04_r8,0.20031e-04_r8, & + & 0.23602e-04_r8,0.27683e-04_r8,0.34068e-04_r8,0.26612e-04_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.91507e-04_r8,0.14710e-03_r8,0.19128e-03_r8,0.22605e-03_r8,0.25532e-03_r8, & + & 0.28077e-03_r8,0.30345e-03_r8,0.32646e-03_r8,0.30807e-03_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.91242e-04_r8,0.14642e-03_r8,0.19074e-03_r8,0.22564e-03_r8,0.25500e-03_r8, & + & 0.28086e-03_r8,0.30369e-03_r8,0.32690e-03_r8,0.30957e-03_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.90877e-04_r8,0.14692e-03_r8,0.19251e-03_r8,0.22869e-03_r8,0.25946e-03_r8, & + & 0.28682e-03_r8,0.31087e-03_r8,0.33538e-03_r8,0.32011e-03_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.90459e-04_r8,0.14494e-03_r8,0.18943e-03_r8,0.22459e-03_r8,0.25465e-03_r8, & + & 0.28114e-03_r8,0.30414e-03_r8,0.32755e-03_r8,0.31196e-03_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.89993e-04_r8,0.14416e-03_r8,0.18875e-03_r8,0.22408e-03_r8,0.25453e-03_r8, & + & 0.28137e-03_r8,0.30449e-03_r8,0.32780e-03_r8,0.31307e-03_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.77262e-04_r8,0.13432e-03_r8,0.17769e-03_r8,0.21240e-03_r8,0.24204e-03_r8, & + & 0.26866e-03_r8,0.29235e-03_r8,0.31628e-03_r8,0.29582e-03_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.77061e-04_r8,0.13375e-03_r8,0.17727e-03_r8,0.21210e-03_r8,0.24206e-03_r8, & + & 0.26905e-03_r8,0.29288e-03_r8,0.31707e-03_r8,0.29754e-03_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.76803e-04_r8,0.13443e-03_r8,0.17926e-03_r8,0.21557e-03_r8,0.24713e-03_r8, & + & 0.27557e-03_r8,0.30072e-03_r8,0.32610e-03_r8,0.30880e-03_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.76502e-04_r8,0.13372e-03_r8,0.17855e-03_r8,0.21503e-03_r8,0.24689e-03_r8, & + & 0.27560e-03_r8,0.30084e-03_r8,0.32601e-03_r8,0.30963e-03_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.76149e-04_r8,0.13198e-03_r8,0.17568e-03_r8,0.21133e-03_r8,0.24254e-03_r8, & + & 0.27051e-03_r8,0.29485e-03_r8,0.31890e-03_r8,0.30223e-03_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.65103e-04_r8,0.12258e-03_r8,0.16452e-03_r8,0.19865e-03_r8,0.22866e-03_r8, & + & 0.25591e-03_r8,0.28055e-03_r8,0.30511e-03_r8,0.28178e-03_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.64961e-04_r8,0.12216e-03_r8,0.16424e-03_r8,0.19863e-03_r8,0.22903e-03_r8, & + & 0.25664e-03_r8,0.28152e-03_r8,0.30626e-03_r8,0.28379e-03_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.64796e-04_r8,0.12170e-03_r8,0.16393e-03_r8,0.19861e-03_r8,0.22948e-03_r8, & + & 0.25740e-03_r8,0.28253e-03_r8,0.30727e-03_r8,0.28578e-03_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.64583e-04_r8,0.12248e-03_r8,0.16600e-03_r8,0.20227e-03_r8,0.23481e-03_r8, & + & 0.26421e-03_r8,0.29055e-03_r8,0.31636e-03_r8,0.29736e-03_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.64341e-04_r8,0.12081e-03_r8,0.16325e-03_r8,0.19869e-03_r8,0.23043e-03_r8, & + & 0.25903e-03_r8,0.28445e-03_r8,0.30920e-03_r8,0.28976e-03_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.54784e-04_r8,0.11174e-03_r8,0.15188e-03_r8,0.18523e-03_r8,0.21503e-03_r8, & + & 0.24239e-03_r8,0.26770e-03_r8,0.29311e-03_r8,0.26685e-03_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.54700e-04_r8,0.11144e-03_r8,0.15177e-03_r8,0.18550e-03_r8,0.21578e-03_r8, & + & 0.24348e-03_r8,0.26903e-03_r8,0.29466e-03_r8,0.26928e-03_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.54592e-04_r8,0.11111e-03_r8,0.15167e-03_r8,0.18578e-03_r8,0.21655e-03_r8, & + & 0.24456e-03_r8,0.27029e-03_r8,0.29609e-03_r8,0.27162e-03_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.54457e-04_r8,0.11078e-03_r8,0.15152e-03_r8,0.18607e-03_r8,0.21728e-03_r8, & + & 0.24565e-03_r8,0.27151e-03_r8,0.29746e-03_r8,0.27399e-03_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.54312e-04_r8,0.11162e-03_r8,0.15369e-03_r8,0.18993e-03_r8,0.22281e-03_r8, & + & 0.25263e-03_r8,0.27972e-03_r8,0.30664e-03_r8,0.28593e-03_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.46088e-04_r8,0.10164e-03_r8,0.13985e-03_r8,0.17192e-03_r8,0.20105e-03_r8, & + & 0.22810e-03_r8,0.25365e-03_r8,0.28019e-03_r8,0.25169e-03_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.46037e-04_r8,0.10150e-03_r8,0.13996e-03_r8,0.17251e-03_r8,0.20208e-03_r8, & + & 0.22949e-03_r8,0.25532e-03_r8,0.28211e-03_r8,0.25438e-03_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.45971e-04_r8,0.10129e-03_r8,0.14008e-03_r8,0.17302e-03_r8,0.20310e-03_r8, & + & 0.23085e-03_r8,0.25690e-03_r8,0.28385e-03_r8,0.25702e-03_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.45890e-04_r8,0.10111e-03_r8,0.14015e-03_r8,0.17355e-03_r8,0.20405e-03_r8, & + & 0.23221e-03_r8,0.25843e-03_r8,0.28547e-03_r8,0.25970e-03_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.45808e-04_r8,0.10210e-03_r8,0.14263e-03_r8,0.17783e-03_r8,0.21010e-03_r8, & + & 0.23994e-03_r8,0.26750e-03_r8,0.29545e-03_r8,0.27288e-03_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.38759e-04_r8,0.92287e-04_r8,0.12830e-03_r8,0.15873e-03_r8,0.18673e-03_r8, & + & 0.21305e-03_r8,0.23858e-03_r8,0.26603e-03_r8,0.23576e-03_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.38742e-04_r8,0.92285e-04_r8,0.12860e-03_r8,0.15956e-03_r8,0.18804e-03_r8, & + & 0.21479e-03_r8,0.24061e-03_r8,0.26833e-03_r8,0.23876e-03_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.38716e-04_r8,0.92248e-04_r8,0.12890e-03_r8,0.16031e-03_r8,0.18934e-03_r8, & + & 0.21647e-03_r8,0.24252e-03_r8,0.27042e-03_r8,0.24167e-03_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.38672e-04_r8,0.92189e-04_r8,0.12914e-03_r8,0.16108e-03_r8,0.19055e-03_r8, & + & 0.21815e-03_r8,0.24441e-03_r8,0.27232e-03_r8,0.24468e-03_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.38631e-04_r8,0.92110e-04_r8,0.12940e-03_r8,0.16181e-03_r8,0.19180e-03_r8, & + & 0.21982e-03_r8,0.24634e-03_r8,0.27420e-03_r8,0.24778e-03_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.32524e-04_r8,0.83578e-04_r8,0.11715e-03_r8,0.14581e-03_r8,0.17242e-03_r8, & + & 0.19778e-03_r8,0.22289e-03_r8,0.25099e-03_r8,0.21544e-03_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.32544e-04_r8,0.83724e-04_r8,0.11765e-03_r8,0.14685e-03_r8,0.17402e-03_r8, & + & 0.19984e-03_r8,0.22531e-03_r8,0.25360e-03_r8,0.21897e-03_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.32541e-04_r8,0.83837e-04_r8,0.11812e-03_r8,0.14785e-03_r8,0.17560e-03_r8, & + & 0.20184e-03_r8,0.22764e-03_r8,0.25604e-03_r8,0.22234e-03_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.32522e-04_r8,0.83911e-04_r8,0.11855e-03_r8,0.14886e-03_r8,0.17710e-03_r8, & + & 0.20381e-03_r8,0.22989e-03_r8,0.25831e-03_r8,0.22586e-03_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.32511e-04_r8,0.83972e-04_r8,0.11899e-03_r8,0.14985e-03_r8,0.17863e-03_r8, & + & 0.20577e-03_r8,0.23212e-03_r8,0.26056e-03_r8,0.22930e-03_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.27162e-04_r8,0.75477e-04_r8,0.10657e-03_r8,0.13337e-03_r8,0.15848e-03_r8, & + & 0.18267e-03_r8,0.20707e-03_r8,0.23532e-03_r8,0.10685e-03_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.27219e-04_r8,0.75747e-04_r8,0.10724e-03_r8,0.13464e-03_r8,0.16036e-03_r8, & + & 0.18507e-03_r8,0.20988e-03_r8,0.23834e-03_r8,0.11049e-03_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.27240e-04_r8,0.75981e-04_r8,0.10788e-03_r8,0.13591e-03_r8,0.16217e-03_r8, & + & 0.18731e-03_r8,0.21250e-03_r8,0.24115e-03_r8,0.11463e-03_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.27241e-04_r8,0.76175e-04_r8,0.10851e-03_r8,0.13715e-03_r8,0.16392e-03_r8, & + & 0.18952e-03_r8,0.21504e-03_r8,0.24375e-03_r8,0.11830e-03_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.27254e-04_r8,0.76338e-04_r8,0.10913e-03_r8,0.13836e-03_r8,0.16569e-03_r8, & + & 0.19172e-03_r8,0.21755e-03_r8,0.24638e-03_r8,0.12227e-03_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.22546e-04_r8,0.67903e-04_r8,0.96628e-04_r8,0.12150e-03_r8,0.14489e-03_r8, & + & 0.16757e-03_r8,0.19095e-03_r8,0.21913e-03_r8,0.25626e-04_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.22635e-04_r8,0.68268e-04_r8,0.97460e-04_r8,0.12301e-03_r8,0.14702e-03_r8, & + & 0.17028e-03_r8,0.19411e-03_r8,0.22260e-03_r8,0.25839e-04_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.22685e-04_r8,0.68616e-04_r8,0.98277e-04_r8,0.12450e-03_r8,0.14909e-03_r8, & + & 0.17284e-03_r8,0.19709e-03_r8,0.22578e-03_r8,0.27443e-04_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.22709e-04_r8,0.68929e-04_r8,0.99095e-04_r8,0.12593e-03_r8,0.15108e-03_r8, & + & 0.17530e-03_r8,0.19995e-03_r8,0.22878e-03_r8,0.28531e-04_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.22740e-04_r8,0.69227e-04_r8,0.99896e-04_r8,0.12734e-03_r8,0.15306e-03_r8, & + & 0.17777e-03_r8,0.20277e-03_r8,0.23170e-03_r8,0.28894e-04_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.18403e-04_r8,0.60856e-04_r8,0.87340e-04_r8,0.11017e-03_r8,0.13174e-03_r8, & + & 0.15284e-03_r8,0.17492e-03_r8,0.20267e-03_r8,0.31931e-04_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.18527e-04_r8,0.61329e-04_r8,0.88371e-04_r8,0.11191e-03_r8,0.13412e-03_r8, & + & 0.15579e-03_r8,0.17838e-03_r8,0.20650e-03_r8,0.29084e-04_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.18600e-04_r8,0.61796e-04_r8,0.89354e-04_r8,0.11363e-03_r8,0.13643e-03_r8, & + & 0.15861e-03_r8,0.18170e-03_r8,0.21009e-03_r8,0.27893e-04_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.18642e-04_r8,0.62226e-04_r8,0.90339e-04_r8,0.11526e-03_r8,0.13867e-03_r8, & + & 0.16137e-03_r8,0.18486e-03_r8,0.21346e-03_r8,0.33895e-04_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.18688e-04_r8,0.62651e-04_r8,0.91302e-04_r8,0.11690e-03_r8,0.14093e-03_r8, & + & 0.16416e-03_r8,0.18804e-03_r8,0.21676e-03_r8,0.31724e-04_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.14636e-04_r8,0.54588e-04_r8,0.79114e-04_r8,0.10030e-03_r8,0.12035e-03_r8, & + & 0.14003e-03_r8,0.16089e-03_r8,0.18797e-03_r8,0.24886e-04_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.14721e-04_r8,0.55182e-04_r8,0.80295e-04_r8,0.10221e-03_r8,0.12288e-03_r8, & + & 0.14315e-03_r8,0.16455e-03_r8,0.19200e-03_r8,0.28280e-04_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.14784e-04_r8,0.55751e-04_r8,0.81465e-04_r8,0.10405e-03_r8,0.12535e-03_r8, & + & 0.14614e-03_r8,0.16802e-03_r8,0.19578e-03_r8,0.31405e-04_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.14831e-04_r8,0.56293e-04_r8,0.82611e-04_r8,0.10589e-03_r8,0.12782e-03_r8, & + & 0.14918e-03_r8,0.17147e-03_r8,0.19942e-03_r8,0.34684e-04_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.14856e-04_r8,0.56829e-04_r8,0.83754e-04_r8,0.10776e-03_r8,0.13034e-03_r8, & + & 0.15225e-03_r8,0.17499e-03_r8,0.20312e-03_r8,0.30970e-04_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.11572e-04_r8,0.48876e-04_r8,0.71553e-04_r8,0.91191e-04_r8,0.10973e-03_r8, & + & 0.12799e-03_r8,0.14756e-03_r8,0.17351e-03_r8,0.30682e-04_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.11642e-04_r8,0.49592e-04_r8,0.72882e-04_r8,0.93233e-04_r8,0.11240e-03_r8, & + & 0.13124e-03_r8,0.15132e-03_r8,0.17770e-03_r8,0.31240e-04_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.11629e-04_r8,0.50261e-04_r8,0.74205e-04_r8,0.95210e-04_r8,0.11505e-03_r8, & + & 0.13447e-03_r8,0.15502e-03_r8,0.18170e-03_r8,0.31943e-04_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.11633e-04_r8,0.50925e-04_r8,0.75501e-04_r8,0.97246e-04_r8,0.11773e-03_r8, & + & 0.13775e-03_r8,0.15878e-03_r8,0.18567e-03_r8,0.23441e-04_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.11677e-04_r8,0.51560e-04_r8,0.76851e-04_r8,0.99310e-04_r8,0.12044e-03_r8, & + & 0.14103e-03_r8,0.16255e-03_r8,0.18968e-03_r8,0.23249e-04_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.88185e-05_r8,0.43709e-04_r8,0.64627e-04_r8,0.82824e-04_r8,0.99889e-04_r8, & + & 0.11672e-03_r8,0.13488e-03_r8,0.15952e-03_r8,0.30903e-04_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.88986e-05_r8,0.44515e-04_r8,0.66093e-04_r8,0.84980e-04_r8,0.10270e-03_r8, & + & 0.12016e-03_r8,0.13885e-03_r8,0.16386e-03_r8,0.25840e-04_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.89568e-05_r8,0.45280e-04_r8,0.67556e-04_r8,0.87134e-04_r8,0.10555e-03_r8, & + & 0.12361e-03_r8,0.14282e-03_r8,0.16813e-03_r8,0.26878e-04_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.89829e-05_r8,0.46045e-04_r8,0.69040e-04_r8,0.89346e-04_r8,0.10842e-03_r8, & + & 0.12710e-03_r8,0.14682e-03_r8,0.17243e-03_r8,0.28852e-04_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.90413e-05_r8,0.46787e-04_r8,0.70568e-04_r8,0.91561e-04_r8,0.11129e-03_r8, & + & 0.13056e-03_r8,0.15080e-03_r8,0.17669e-03_r8,0.28623e-04_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.44112e-03_r8,0.47423e-03_r8,0.54876e-03_r8,0.61567e-03_r8,0.66971e-03_r8, & + & 0.71699e-03_r8,0.76347e-03_r8,0.77814e-03_r8,0.77298e-03_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.43794e-03_r8,0.47285e-03_r8,0.54643e-03_r8,0.61370e-03_r8,0.66959e-03_r8, & + & 0.71530e-03_r8,0.76226e-03_r8,0.77693e-03_r8,0.76966e-03_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.43480e-03_r8,0.47183e-03_r8,0.54721e-03_r8,0.61831e-03_r8,0.67726e-03_r8, & + & 0.72423e-03_r8,0.77288e-03_r8,0.78901e-03_r8,0.78603e-03_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.43220e-03_r8,0.46825e-03_r8,0.54213e-03_r8,0.61349e-03_r8,0.66880e-03_r8, & + & 0.71215e-03_r8,0.75938e-03_r8,0.77341e-03_r8,0.76775e-03_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.42987e-03_r8,0.46597e-03_r8,0.54025e-03_r8,0.61237e-03_r8,0.66800e-03_r8, & + & 0.70968e-03_r8,0.75599e-03_r8,0.77132e-03_r8,0.76754e-03_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.37934e-03_r8,0.43540e-03_r8,0.51852e-03_r8,0.59327e-03_r8,0.65919e-03_r8, & + & 0.71028e-03_r8,0.75523e-03_r8,0.78660e-03_r8,0.77018e-03_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.37616e-03_r8,0.43418e-03_r8,0.51743e-03_r8,0.59232e-03_r8,0.65869e-03_r8, & + & 0.70879e-03_r8,0.75385e-03_r8,0.78506e-03_r8,0.76914e-03_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.37285e-03_r8,0.43338e-03_r8,0.51992e-03_r8,0.59796e-03_r8,0.66588e-03_r8, & + & 0.71863e-03_r8,0.76525e-03_r8,0.79746e-03_r8,0.78726e-03_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.36993e-03_r8,0.43092e-03_r8,0.51858e-03_r8,0.59729e-03_r8,0.66425e-03_r8, & + & 0.71582e-03_r8,0.76129e-03_r8,0.79428e-03_r8,0.78557e-03_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.36795e-03_r8,0.42667e-03_r8,0.51498e-03_r8,0.59125e-03_r8,0.65451e-03_r8, & + & 0.70295e-03_r8,0.74646e-03_r8,0.77706e-03_r8,0.76846e-03_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.32398e-03_r8,0.39840e-03_r8,0.48910e-03_r8,0.57202e-03_r8,0.64247e-03_r8, & + & 0.69920e-03_r8,0.74272e-03_r8,0.78560e-03_r8,0.76158e-03_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.32107e-03_r8,0.39683e-03_r8,0.48877e-03_r8,0.57106e-03_r8,0.64200e-03_r8, & + & 0.69780e-03_r8,0.74068e-03_r8,0.78389e-03_r8,0.76255e-03_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.31808e-03_r8,0.39502e-03_r8,0.48851e-03_r8,0.57104e-03_r8,0.64052e-03_r8, & + & 0.69677e-03_r8,0.73846e-03_r8,0.78156e-03_r8,0.76341e-03_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.31534e-03_r8,0.39419e-03_r8,0.49223e-03_r8,0.57621e-03_r8,0.64746e-03_r8, & + & 0.70569e-03_r8,0.74986e-03_r8,0.79350e-03_r8,0.78192e-03_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.31343e-03_r8,0.39031e-03_r8,0.48789e-03_r8,0.56911e-03_r8,0.63804e-03_r8, & + & 0.69322e-03_r8,0.73529e-03_r8,0.77554e-03_r8,0.76249e-03_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.27516e-03_r8,0.36405e-03_r8,0.46107e-03_r8,0.54790e-03_r8,0.62253e-03_r8, & + & 0.68384e-03_r8,0.73057e-03_r8,0.77856e-03_r8,0.74793e-03_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.27272e-03_r8,0.36262e-03_r8,0.46080e-03_r8,0.54700e-03_r8,0.62201e-03_r8, & + & 0.68300e-03_r8,0.72976e-03_r8,0.77591e-03_r8,0.74919e-03_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.26991e-03_r8,0.36139e-03_r8,0.46064e-03_r8,0.54673e-03_r8,0.62063e-03_r8, & + & 0.68269e-03_r8,0.72862e-03_r8,0.77298e-03_r8,0.75070e-03_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.26757e-03_r8,0.35993e-03_r8,0.46053e-03_r8,0.54625e-03_r8,0.61982e-03_r8, & + & 0.68167e-03_r8,0.72799e-03_r8,0.77005e-03_r8,0.75046e-03_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.26556e-03_r8,0.36025e-03_r8,0.46433e-03_r8,0.55132e-03_r8,0.62683e-03_r8, & + & 0.69143e-03_r8,0.74137e-03_r8,0.78366e-03_r8,0.76845e-03_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.23277e-03_r8,0.33279e-03_r8,0.43313e-03_r8,0.52236e-03_r8,0.59970e-03_r8, & + & 0.66464e-03_r8,0.71686e-03_r8,0.76626e-03_r8,0.72457e-03_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.23078e-03_r8,0.33167e-03_r8,0.43303e-03_r8,0.52181e-03_r8,0.60054e-03_r8, & + & 0.66529e-03_r8,0.71807e-03_r8,0.76458e-03_r8,0.72852e-03_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.22839e-03_r8,0.33111e-03_r8,0.43245e-03_r8,0.52229e-03_r8,0.60068e-03_r8, & + & 0.66640e-03_r8,0.71880e-03_r8,0.76367e-03_r8,0.73165e-03_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.22634e-03_r8,0.33010e-03_r8,0.43234e-03_r8,0.52220e-03_r8,0.60179e-03_r8, & + & 0.66699e-03_r8,0.71996e-03_r8,0.76305e-03_r8,0.73316e-03_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.22442e-03_r8,0.33158e-03_r8,0.43680e-03_r8,0.52864e-03_r8,0.61018e-03_r8, & + & 0.67770e-03_r8,0.73371e-03_r8,0.78031e-03_r8,0.75138e-03_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.19685e-03_r8,0.30442e-03_r8,0.40547e-03_r8,0.49610e-03_r8,0.57453e-03_r8, & + & 0.64299e-03_r8,0.69899e-03_r8,0.74954e-03_r8,0.69460e-03_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.19517e-03_r8,0.30338e-03_r8,0.40585e-03_r8,0.49683e-03_r8,0.57671e-03_r8, & + & 0.64425e-03_r8,0.70130e-03_r8,0.75004e-03_r8,0.70036e-03_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.19324e-03_r8,0.30268e-03_r8,0.40573e-03_r8,0.49834e-03_r8,0.57803e-03_r8, & + & 0.64627e-03_r8,0.70310e-03_r8,0.75130e-03_r8,0.70596e-03_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.19132e-03_r8,0.30224e-03_r8,0.40644e-03_r8,0.49947e-03_r8,0.58014e-03_r8, & + & 0.64741e-03_r8,0.70472e-03_r8,0.75293e-03_r8,0.70917e-03_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.18952e-03_r8,0.30177e-03_r8,0.40672e-03_r8,0.50101e-03_r8,0.58137e-03_r8, & + & 0.64847e-03_r8,0.70602e-03_r8,0.75537e-03_r8,0.71121e-03_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.16684e-03_r8,0.27825e-03_r8,0.37860e-03_r8,0.46883e-03_r8,0.54680e-03_r8, & + & 0.61510e-03_r8,0.67386e-03_r8,0.72824e-03_r8,0.66391e-03_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.16553e-03_r8,0.27719e-03_r8,0.37963e-03_r8,0.47077e-03_r8,0.54985e-03_r8, & + & 0.61768e-03_r8,0.67717e-03_r8,0.73093e-03_r8,0.67156e-03_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.16397e-03_r8,0.27663e-03_r8,0.38054e-03_r8,0.47308e-03_r8,0.55166e-03_r8, & + & 0.62067e-03_r8,0.67975e-03_r8,0.73342e-03_r8,0.67787e-03_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.16246e-03_r8,0.27634e-03_r8,0.38198e-03_r8,0.47489e-03_r8,0.55414e-03_r8, & + & 0.62280e-03_r8,0.68232e-03_r8,0.73600e-03_r8,0.68175e-03_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.16089e-03_r8,0.27624e-03_r8,0.38314e-03_r8,0.47665e-03_r8,0.55585e-03_r8, & + & 0.62443e-03_r8,0.68436e-03_r8,0.73852e-03_r8,0.68559e-03_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.14215e-03_r8,0.25407e-03_r8,0.35215e-03_r8,0.43863e-03_r8,0.51443e-03_r8, & + & 0.58154e-03_r8,0.64180e-03_r8,0.70004e-03_r8,0.62276e-03_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.14104e-03_r8,0.25332e-03_r8,0.35394e-03_r8,0.44179e-03_r8,0.51810e-03_r8, & + & 0.58508e-03_r8,0.64584e-03_r8,0.70407e-03_r8,0.63285e-03_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.13977e-03_r8,0.25313e-03_r8,0.35560e-03_r8,0.44458e-03_r8,0.52101e-03_r8, & + & 0.58953e-03_r8,0.65037e-03_r8,0.70785e-03_r8,0.64108e-03_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.13869e-03_r8,0.25332e-03_r8,0.35744e-03_r8,0.44722e-03_r8,0.52464e-03_r8, & + & 0.59336e-03_r8,0.65468e-03_r8,0.71201e-03_r8,0.64611e-03_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.13742e-03_r8,0.25367e-03_r8,0.35927e-03_r8,0.44959e-03_r8,0.52752e-03_r8, & + & 0.59656e-03_r8,0.65824e-03_r8,0.71554e-03_r8,0.65066e-03_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.12109e-03_r8,0.23210e-03_r8,0.32446e-03_r8,0.40715e-03_r8,0.48065e-03_r8, & + & 0.54715e-03_r8,0.60775e-03_r8,0.66825e-03_r8,0.18336e-04_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.12018e-03_r8,0.23207e-03_r8,0.32699e-03_r8,0.41058e-03_r8,0.48505e-03_r8, & + & 0.55180e-03_r8,0.61323e-03_r8,0.67309e-03_r8,0.24327e-04_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.11917e-03_r8,0.23229e-03_r8,0.32956e-03_r8,0.41390e-03_r8,0.48910e-03_r8, & + & 0.55710e-03_r8,0.61911e-03_r8,0.67851e-03_r8,0.23065e-04_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.11843e-03_r8,0.23292e-03_r8,0.33197e-03_r8,0.41764e-03_r8,0.49354e-03_r8, & + & 0.56238e-03_r8,0.62497e-03_r8,0.68395e-03_r8,0.23680e-04_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.11748e-03_r8,0.23365e-03_r8,0.33458e-03_r8,0.42109e-03_r8,0.49774e-03_r8, & + & 0.56667e-03_r8,0.62987e-03_r8,0.68909e-03_r8,0.25905e-04_r8 /) + kao(:, 1,10,10) = (/ & + & 0.10273e-03_r8,0.21204e-03_r8,0.29794e-03_r8,0.37761e-03_r8,0.44937e-03_r8, & + & 0.51495e-03_r8,0.57567e-03_r8,0.63761e-03_r8,0.19724e-04_r8 /) + kao(:, 2,10,10) = (/ & + & 0.10190e-03_r8,0.21272e-03_r8,0.30059e-03_r8,0.38150e-03_r8,0.45434e-03_r8, & + & 0.52089e-03_r8,0.58270e-03_r8,0.64346e-03_r8,0.24197e-04_r8 /) + kao(:, 3,10,10) = (/ & + & 0.10112e-03_r8,0.21334e-03_r8,0.30377e-03_r8,0.38507e-03_r8,0.45917e-03_r8, & + & 0.52739e-03_r8,0.58976e-03_r8,0.64941e-03_r8,0.34326e-04_r8 /) + kao(:, 4,10,10) = (/ & + & 0.10061e-03_r8,0.21443e-03_r8,0.30659e-03_r8,0.38965e-03_r8,0.46453e-03_r8, & + & 0.53354e-03_r8,0.59675e-03_r8,0.65639e-03_r8,0.33702e-04_r8 /) + kao(:, 5,10,10) = (/ & + & 0.99890e-04_r8,0.21543e-03_r8,0.30998e-03_r8,0.39375e-03_r8,0.46925e-03_r8, & + & 0.53804e-03_r8,0.60223e-03_r8,0.66255e-03_r8,0.31412e-04_r8 /) + kao(:, 1,11,10) = (/ & + & 0.86338e-04_r8,0.19398e-03_r8,0.27516e-03_r8,0.35204e-03_r8,0.42116e-03_r8, & + & 0.48556e-03_r8,0.54615e-03_r8,0.60927e-03_r8,0.19945e-04_r8 /) + kao(:, 2,11,10) = (/ & + & 0.85730e-04_r8,0.19502e-03_r8,0.27834e-03_r8,0.35636e-03_r8,0.42792e-03_r8, & + & 0.49403e-03_r8,0.55597e-03_r8,0.61737e-03_r8,0.90093e-05_r8 /) + kao(:, 3,11,10) = (/ & + & 0.85275e-04_r8,0.19618e-03_r8,0.28168e-03_r8,0.36165e-03_r8,0.43438e-03_r8, & + & 0.50224e-03_r8,0.56492e-03_r8,0.62614e-03_r8,0.37496e-04_r8 /) + kao(:, 4,11,10) = (/ & + & 0.84865e-04_r8,0.19761e-03_r8,0.28526e-03_r8,0.36657e-03_r8,0.44042e-03_r8, & + & 0.50863e-03_r8,0.57263e-03_r8,0.63413e-03_r8,0.15044e-04_r8 /) + kao(:, 5,11,10) = (/ & + & 0.84443e-04_r8,0.19914e-03_r8,0.28886e-03_r8,0.37069e-03_r8,0.44492e-03_r8, & + & 0.51377e-03_r8,0.57803e-03_r8,0.63993e-03_r8,0.48683e-04_r8 /) + kao(:, 1,12,10) = (/ & + & 0.72237e-04_r8,0.17794e-03_r8,0.25491e-03_r8,0.32737e-03_r8,0.39376e-03_r8, & + & 0.45690e-03_r8,0.51684e-03_r8,0.58057e-03_r8,0.10800e-04_r8 /) + kao(:, 2,12,10) = (/ & + & 0.71846e-04_r8,0.17916e-03_r8,0.25896e-03_r8,0.33355e-03_r8,0.40234e-03_r8, & + & 0.46708e-03_r8,0.52856e-03_r8,0.59174e-03_r8,0.37304e-04_r8 /) + kao(:, 3,12,10) = (/ & + & 0.71641e-04_r8,0.18095e-03_r8,0.26291e-03_r8,0.34013e-03_r8,0.41022e-03_r8, & + & 0.47645e-03_r8,0.53911e-03_r8,0.60240e-03_r8,0.20066e-04_r8 /) + kao(:, 4,12,10) = (/ & + & 0.71337e-04_r8,0.18255e-03_r8,0.26698e-03_r8,0.34557e-03_r8,0.41722e-03_r8, & + & 0.48390e-03_r8,0.54753e-03_r8,0.61134e-03_r8,0.20267e-04_r8 /) + kao(:, 5,12,10) = (/ & + & 0.71187e-04_r8,0.18456e-03_r8,0.27032e-03_r8,0.35012e-03_r8,0.42265e-03_r8, & + & 0.49079e-03_r8,0.55462e-03_r8,0.61760e-03_r8,0.29175e-04_r8 /) + kao(:, 1,13,10) = (/ & + & 0.60308e-04_r8,0.16344e-03_r8,0.23674e-03_r8,0.30451e-03_r8,0.36859e-03_r8, & + & 0.42973e-03_r8,0.48896e-03_r8,0.55265e-03_r8,0.35870e-04_r8 /) + kao(:, 2,13,10) = (/ & + & 0.60075e-04_r8,0.16518e-03_r8,0.24182e-03_r8,0.31202e-03_r8,0.37817e-03_r8, & + & 0.44097e-03_r8,0.50163e-03_r8,0.56563e-03_r8,0.24717e-04_r8 /) + kao(:, 3,13,10) = (/ & + & 0.59963e-04_r8,0.16736e-03_r8,0.24636e-03_r8,0.31956e-03_r8,0.38717e-03_r8, & + & 0.45122e-03_r8,0.51282e-03_r8,0.57786e-03_r8,0.24967e-04_r8 /) + kao(:, 4,13,10) = (/ & + & 0.59808e-04_r8,0.16950e-03_r8,0.25081e-03_r8,0.32559e-03_r8,0.39488e-03_r8, & + & 0.45992e-03_r8,0.52243e-03_r8,0.58716e-03_r8,0.25073e-04_r8 /) + kao(:, 5,13,10) = (/ & + & 0.59738e-04_r8,0.17182e-03_r8,0.25430e-03_r8,0.33121e-03_r8,0.40220e-03_r8, & + & 0.46925e-03_r8,0.53224e-03_r8,0.59573e-03_r8,0.14031e-04_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.79109e-03_r8,0.77354e-03_r8,0.84795e-03_r8,0.91837e-03_r8,0.98287e-03_r8, & + & 0.10467e-02_r8,0.10876e-02_r8,0.10899e-02_r8,0.10918e-02_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.79035e-03_r8,0.76999e-03_r8,0.84502e-03_r8,0.91315e-03_r8,0.97569e-03_r8, & + & 0.10420e-02_r8,0.10843e-02_r8,0.10840e-02_r8,0.10904e-02_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.79094e-03_r8,0.76969e-03_r8,0.84501e-03_r8,0.91212e-03_r8,0.97616e-03_r8, & + & 0.10502e-02_r8,0.10978e-02_r8,0.10968e-02_r8,0.11098e-02_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.79012e-03_r8,0.76698e-03_r8,0.84052e-03_r8,0.90224e-03_r8,0.96448e-03_r8, & + & 0.10367e-02_r8,0.10810e-02_r8,0.10798e-02_r8,0.10838e-02_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.78840e-03_r8,0.76416e-03_r8,0.83816e-03_r8,0.89971e-03_r8,0.96199e-03_r8, & + & 0.10344e-02_r8,0.10796e-02_r8,0.10773e-02_r8,0.10800e-02_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.69789e-03_r8,0.72093e-03_r8,0.81475e-03_r8,0.89922e-03_r8,0.96655e-03_r8, & + & 0.10286e-02_r8,0.10852e-02_r8,0.10968e-02_r8,0.10998e-02_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.69799e-03_r8,0.71831e-03_r8,0.81026e-03_r8,0.89390e-03_r8,0.96162e-03_r8, & + & 0.10278e-02_r8,0.10853e-02_r8,0.10953e-02_r8,0.10980e-02_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.69849e-03_r8,0.71872e-03_r8,0.81039e-03_r8,0.89368e-03_r8,0.96713e-03_r8, & + & 0.10387e-02_r8,0.11003e-02_r8,0.11139e-02_r8,0.11199e-02_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.69786e-03_r8,0.71702e-03_r8,0.80831e-03_r8,0.88926e-03_r8,0.96426e-03_r8, & + & 0.10353e-02_r8,0.10976e-02_r8,0.11107e-02_r8,0.11152e-02_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.69639e-03_r8,0.71420e-03_r8,0.80246e-03_r8,0.88289e-03_r8,0.95515e-03_r8, & + & 0.10226e-02_r8,0.10812e-02_r8,0.10915e-02_r8,0.10904e-02_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.60717e-03_r8,0.66595e-03_r8,0.77916e-03_r8,0.87509e-03_r8,0.95372e-03_r8, & + & 0.10167e-02_r8,0.10820e-02_r8,0.11070e-02_r8,0.11005e-02_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.60740e-03_r8,0.66447e-03_r8,0.77425e-03_r8,0.87078e-03_r8,0.95087e-03_r8, & + & 0.10164e-02_r8,0.10820e-02_r8,0.11070e-02_r8,0.10996e-02_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.60743e-03_r8,0.66421e-03_r8,0.77076e-03_r8,0.86668e-03_r8,0.94936e-03_r8, & + & 0.10146e-02_r8,0.10809e-02_r8,0.11066e-02_r8,0.10979e-02_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.60721e-03_r8,0.66487e-03_r8,0.77207e-03_r8,0.87093e-03_r8,0.95679e-03_r8, & + & 0.10247e-02_r8,0.10950e-02_r8,0.11248e-02_r8,0.11171e-02_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.60632e-03_r8,0.66259e-03_r8,0.76645e-03_r8,0.86469e-03_r8,0.94611e-03_r8, & + & 0.10116e-02_r8,0.10778e-02_r8,0.11040e-02_r8,0.10953e-02_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.52196e-03_r8,0.61309e-03_r8,0.74127e-03_r8,0.84825e-03_r8,0.93805e-03_r8, & + & 0.10078e-02_r8,0.10732e-02_r8,0.11156e-02_r8,0.10964e-02_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.52205e-03_r8,0.61209e-03_r8,0.73709e-03_r8,0.84586e-03_r8,0.93585e-03_r8, & + & 0.10074e-02_r8,0.10727e-02_r8,0.11168e-02_r8,0.10976e-02_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.52218e-03_r8,0.61175e-03_r8,0.73426e-03_r8,0.84316e-03_r8,0.93485e-03_r8, & + & 0.10055e-02_r8,0.10718e-02_r8,0.11162e-02_r8,0.10985e-02_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.52176e-03_r8,0.61131e-03_r8,0.73315e-03_r8,0.84162e-03_r8,0.93319e-03_r8, & + & 0.10035e-02_r8,0.10709e-02_r8,0.11149e-02_r8,0.11000e-02_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.52100e-03_r8,0.61215e-03_r8,0.73639e-03_r8,0.84868e-03_r8,0.94102e-03_r8, & + & 0.10132e-02_r8,0.10822e-02_r8,0.11303e-02_r8,0.11192e-02_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.44537e-03_r8,0.56415e-03_r8,0.70334e-03_r8,0.81986e-03_r8,0.91737e-03_r8, & + & 0.99505e-03_r8,0.10590e-02_r8,0.11155e-02_r8,0.10855e-02_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.44499e-03_r8,0.56304e-03_r8,0.70021e-03_r8,0.81824e-03_r8,0.91496e-03_r8, & + & 0.99465e-03_r8,0.10577e-02_r8,0.11163e-02_r8,0.10886e-02_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.44481e-03_r8,0.56231e-03_r8,0.69884e-03_r8,0.81557e-03_r8,0.91387e-03_r8, & + & 0.99269e-03_r8,0.10566e-02_r8,0.11154e-02_r8,0.10925e-02_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.44459e-03_r8,0.56155e-03_r8,0.69827e-03_r8,0.81462e-03_r8,0.91145e-03_r8, & + & 0.99105e-03_r8,0.10558e-02_r8,0.11141e-02_r8,0.10950e-02_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.44401e-03_r8,0.56266e-03_r8,0.70342e-03_r8,0.82262e-03_r8,0.92017e-03_r8, & + & 0.10017e-02_r8,0.10686e-02_r8,0.11300e-02_r8,0.11166e-02_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.37714e-03_r8,0.51787e-03_r8,0.66544e-03_r8,0.78793e-03_r8,0.89178e-03_r8, & + & 0.97506e-03_r8,0.10421e-02_r8,0.11072e-02_r8,0.10679e-02_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.37645e-03_r8,0.51719e-03_r8,0.66329e-03_r8,0.78619e-03_r8,0.88946e-03_r8, & + & 0.97613e-03_r8,0.10421e-02_r8,0.11076e-02_r8,0.10727e-02_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.37621e-03_r8,0.51663e-03_r8,0.66248e-03_r8,0.78421e-03_r8,0.88840e-03_r8, & + & 0.97530e-03_r8,0.10423e-02_r8,0.11074e-02_r8,0.10773e-02_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.37625e-03_r8,0.51591e-03_r8,0.66198e-03_r8,0.78342e-03_r8,0.88665e-03_r8, & + & 0.97510e-03_r8,0.10427e-02_r8,0.11065e-02_r8,0.10807e-02_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.37578e-03_r8,0.51583e-03_r8,0.66231e-03_r8,0.78322e-03_r8,0.88597e-03_r8, & + & 0.97458e-03_r8,0.10416e-02_r8,0.11045e-02_r8,0.10828e-02_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.31849e-03_r8,0.47598e-03_r8,0.62784e-03_r8,0.75245e-03_r8,0.86097e-03_r8, & + & 0.95037e-03_r8,0.10228e-02_r8,0.10907e-02_r8,0.10381e-02_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.31748e-03_r8,0.47565e-03_r8,0.62625e-03_r8,0.75127e-03_r8,0.86016e-03_r8, & + & 0.95292e-03_r8,0.10249e-02_r8,0.10924e-02_r8,0.10446e-02_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.31709e-03_r8,0.47527e-03_r8,0.62527e-03_r8,0.75044e-03_r8,0.86086e-03_r8, & + & 0.95398e-03_r8,0.10272e-02_r8,0.10943e-02_r8,0.10513e-02_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.31690e-03_r8,0.47506e-03_r8,0.62534e-03_r8,0.75023e-03_r8,0.86098e-03_r8, & + & 0.95576e-03_r8,0.10298e-02_r8,0.10956e-02_r8,0.10570e-02_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.31661e-03_r8,0.47556e-03_r8,0.62564e-03_r8,0.75129e-03_r8,0.86194e-03_r8, & + & 0.95752e-03_r8,0.10312e-02_r8,0.10967e-02_r8,0.10605e-02_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.26920e-03_r8,0.43740e-03_r8,0.58907e-03_r8,0.71604e-03_r8,0.82585e-03_r8, & + & 0.92017e-03_r8,0.99828e-03_r8,0.10677e-02_r8,0.99191e-03_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.26802e-03_r8,0.43738e-03_r8,0.58846e-03_r8,0.71590e-03_r8,0.82753e-03_r8, & + & 0.92484e-03_r8,0.10036e-02_r8,0.10726e-02_r8,0.10010e-02_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.26738e-03_r8,0.43742e-03_r8,0.58827e-03_r8,0.71679e-03_r8,0.83051e-03_r8, & + & 0.92821e-03_r8,0.10079e-02_r8,0.10772e-02_r8,0.10102e-02_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.26701e-03_r8,0.43751e-03_r8,0.58933e-03_r8,0.71793e-03_r8,0.83304e-03_r8, & + & 0.93190e-03_r8,0.10124e-02_r8,0.10810e-02_r8,0.10188e-02_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.26686e-03_r8,0.43824e-03_r8,0.58999e-03_r8,0.72050e-03_r8,0.83607e-03_r8, & + & 0.93581e-03_r8,0.10160e-02_r8,0.10848e-02_r8,0.10263e-02_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.22904e-03_r8,0.40123e-03_r8,0.55115e-03_r8,0.67712e-03_r8,0.78732e-03_r8, & + & 0.88313e-03_r8,0.96568e-03_r8,0.10387e-02_r8,0.14403e-04_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.22775e-03_r8,0.40129e-03_r8,0.55155e-03_r8,0.67918e-03_r8,0.79168e-03_r8, & + & 0.89045e-03_r8,0.97356e-03_r8,0.10468e-02_r8,0.17396e-04_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.22691e-03_r8,0.40187e-03_r8,0.55239e-03_r8,0.68238e-03_r8,0.79664e-03_r8, & + & 0.89641e-03_r8,0.98013e-03_r8,0.10538e-02_r8,0.17983e-04_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.22637e-03_r8,0.40220e-03_r8,0.55452e-03_r8,0.68525e-03_r8,0.80145e-03_r8, & + & 0.90223e-03_r8,0.98673e-03_r8,0.10599e-02_r8,0.14884e-04_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.22595e-03_r8,0.40316e-03_r8,0.55613e-03_r8,0.68950e-03_r8,0.80623e-03_r8, & + & 0.90849e-03_r8,0.99244e-03_r8,0.10655e-02_r8,0.19485e-04_r8 /) + kao(:, 1,10,11) = (/ & + & 0.19610e-03_r8,0.36707e-03_r8,0.51305e-03_r8,0.63612e-03_r8,0.74337e-03_r8, & + & 0.83875e-03_r8,0.92458e-03_r8,0.10007e-02_r8,0.30583e-04_r8 /) + kao(:, 2,10,11) = (/ & + & 0.19499e-03_r8,0.36759e-03_r8,0.51501e-03_r8,0.64066e-03_r8,0.75082e-03_r8, & + & 0.84853e-03_r8,0.93443e-03_r8,0.10117e-02_r8,0.20484e-04_r8 /) + kao(:, 3,10,11) = (/ & + & 0.19427e-03_r8,0.36886e-03_r8,0.51745e-03_r8,0.64625e-03_r8,0.75815e-03_r8, & + & 0.85733e-03_r8,0.94303e-03_r8,0.10217e-02_r8,0.20784e-04_r8 /) + kao(:, 4,10,11) = (/ & + & 0.19367e-03_r8,0.36958e-03_r8,0.52106e-03_r8,0.65093e-03_r8,0.76545e-03_r8, & + & 0.86571e-03_r8,0.95244e-03_r8,0.10301e-02_r8,0.30511e-04_r8 /) + kao(:, 5,10,11) = (/ & + & 0.19319e-03_r8,0.37098e-03_r8,0.52409e-03_r8,0.65675e-03_r8,0.77258e-03_r8, & + & 0.87491e-03_r8,0.96110e-03_r8,0.10378e-02_r8,0.19883e-04_r8 /) + kao(:, 1,11,11) = (/ & + & 0.16767e-03_r8,0.33624e-03_r8,0.47635e-03_r8,0.59543e-03_r8,0.70301e-03_r8, & + & 0.79872e-03_r8,0.88652e-03_r8,0.96550e-03_r8,0.27483e-04_r8 /) + kao(:, 2,11,11) = (/ & + & 0.16687e-03_r8,0.33764e-03_r8,0.48055e-03_r8,0.60283e-03_r8,0.71186e-03_r8, & + & 0.80978e-03_r8,0.89673e-03_r8,0.97758e-03_r8,0.20639e-04_r8 /) + kao(:, 3,11,11) = (/ & + & 0.16664e-03_r8,0.33942e-03_r8,0.48524e-03_r8,0.60962e-03_r8,0.72075e-03_r8, & + & 0.81953e-03_r8,0.90753e-03_r8,0.98729e-03_r8,0.27689e-04_r8 /) + kao(:, 4,11,11) = (/ & + & 0.16611e-03_r8,0.34104e-03_r8,0.48994e-03_r8,0.61708e-03_r8,0.72992e-03_r8, & + & 0.83047e-03_r8,0.91898e-03_r8,0.99769e-03_r8,0.13719e-04_r8 /) + kao(:, 5,11,11) = (/ & + & 0.16596e-03_r8,0.34313e-03_r8,0.49467e-03_r8,0.62538e-03_r8,0.73960e-03_r8, & + & 0.84171e-03_r8,0.92999e-03_r8,0.10075e-02_r8,0.27137e-04_r8 /) + kao(:, 1,12,11) = (/ & + & 0.14282e-03_r8,0.30890e-03_r8,0.44183e-03_r8,0.55831e-03_r8,0.66503e-03_r8, & + & 0.76077e-03_r8,0.84890e-03_r8,0.93128e-03_r8,0.21228e-04_r8 /) + kao(:, 2,12,11) = (/ & + & 0.14255e-03_r8,0.31125e-03_r8,0.44731e-03_r8,0.56685e-03_r8,0.67491e-03_r8, & + & 0.77277e-03_r8,0.86092e-03_r8,0.94274e-03_r8,0.32331e-04_r8 /) + kao(:, 3,12,11) = (/ & + & 0.14244e-03_r8,0.31334e-03_r8,0.45354e-03_r8,0.57479e-03_r8,0.68552e-03_r8, & + & 0.78420e-03_r8,0.87396e-03_r8,0.95434e-03_r8,0.19978e-06_r8 /) + kao(:, 4,12,11) = (/ & + & 0.14239e-03_r8,0.31614e-03_r8,0.45984e-03_r8,0.58419e-03_r8,0.69607e-03_r8, & + & 0.79750e-03_r8,0.88765e-03_r8,0.96637e-03_r8,0.21475e-04_r8 /) + kao(:, 5,12,11) = (/ & + & 0.14252e-03_r8,0.31876e-03_r8,0.46658e-03_r8,0.59385e-03_r8,0.70775e-03_r8, & + & 0.80986e-03_r8,0.90037e-03_r8,0.97814e-03_r8,0.21476e-04_r8 /) + kao(:, 1,13,11) = (/ & + & 0.12125e-03_r8,0.28444e-03_r8,0.41080e-03_r8,0.52444e-03_r8,0.62932e-03_r8, & + & 0.72481e-03_r8,0.81245e-03_r8,0.89716e-03_r8,0.27405e-04_r8 /) + kao(:, 2,13,11) = (/ & + & 0.12138e-03_r8,0.28788e-03_r8,0.41712e-03_r8,0.53396e-03_r8,0.64078e-03_r8, & + & 0.73819e-03_r8,0.82737e-03_r8,0.91020e-03_r8,0.13699e-04_r8 /) + kao(:, 3,13,11) = (/ & + & 0.12142e-03_r8,0.29086e-03_r8,0.42441e-03_r8,0.54338e-03_r8,0.65260e-03_r8, & + & 0.75224e-03_r8,0.84352e-03_r8,0.92398e-03_r8,0.13820e-04_r8 /) + kao(:, 4,13,11) = (/ & + & 0.12174e-03_r8,0.29430e-03_r8,0.43176e-03_r8,0.55440e-03_r8,0.66546e-03_r8, & + & 0.76738e-03_r8,0.85914e-03_r8,0.93821e-03_r8,0.26505e-06_r8 /) + kao(:, 5,13,11) = (/ & + & 0.12197e-03_r8,0.29750e-03_r8,0.43989e-03_r8,0.56500e-03_r8,0.67844e-03_r8, & + & 0.78071e-03_r8,0.87280e-03_r8,0.95108e-03_r8,0.33764e-06_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.15537e-02_r8,0.13818e-02_r8,0.14273e-02_r8,0.15055e-02_r8,0.15786e-02_r8, & + & 0.16339e-02_r8,0.16467e-02_r8,0.15800e-02_r8,0.16050e-02_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.15485e-02_r8,0.13765e-02_r8,0.14181e-02_r8,0.14978e-02_r8,0.15727e-02_r8, & + & 0.16256e-02_r8,0.16371e-02_r8,0.15728e-02_r8,0.16005e-02_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.15437e-02_r8,0.13722e-02_r8,0.14122e-02_r8,0.14971e-02_r8,0.15752e-02_r8, & + & 0.16261e-02_r8,0.16396e-02_r8,0.15797e-02_r8,0.16209e-02_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.15424e-02_r8,0.13691e-02_r8,0.14015e-02_r8,0.14839e-02_r8,0.15593e-02_r8, & + & 0.16040e-02_r8,0.16150e-02_r8,0.15487e-02_r8,0.15957e-02_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.15425e-02_r8,0.13681e-02_r8,0.13961e-02_r8,0.14766e-02_r8,0.15502e-02_r8, & + & 0.15943e-02_r8,0.16046e-02_r8,0.15376e-02_r8,0.15923e-02_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.14274e-02_r8,0.13101e-02_r8,0.13901e-02_r8,0.14665e-02_r8,0.15597e-02_r8, & + & 0.16365e-02_r8,0.16682e-02_r8,0.16286e-02_r8,0.16381e-02_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.14223e-02_r8,0.13039e-02_r8,0.13828e-02_r8,0.14629e-02_r8,0.15522e-02_r8, & + & 0.16256e-02_r8,0.16567e-02_r8,0.16183e-02_r8,0.16362e-02_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.14195e-02_r8,0.12999e-02_r8,0.13791e-02_r8,0.14641e-02_r8,0.15538e-02_r8, & + & 0.16259e-02_r8,0.16605e-02_r8,0.16235e-02_r8,0.16585e-02_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.14181e-02_r8,0.12958e-02_r8,0.13726e-02_r8,0.14576e-02_r8,0.15447e-02_r8, & + & 0.16149e-02_r8,0.16487e-02_r8,0.16101e-02_r8,0.16540e-02_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.14191e-02_r8,0.12933e-02_r8,0.13650e-02_r8,0.14448e-02_r8,0.15270e-02_r8, & + & 0.15959e-02_r8,0.16273e-02_r8,0.15850e-02_r8,0.16279e-02_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.12975e-02_r8,0.12495e-02_r8,0.13516e-02_r8,0.14440e-02_r8,0.15390e-02_r8, & + & 0.16298e-02_r8,0.16807e-02_r8,0.16634e-02_r8,0.16697e-02_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.12938e-02_r8,0.12434e-02_r8,0.13457e-02_r8,0.14406e-02_r8,0.15301e-02_r8, & + & 0.16196e-02_r8,0.16709e-02_r8,0.16534e-02_r8,0.16671e-02_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.12920e-02_r8,0.12378e-02_r8,0.13412e-02_r8,0.14340e-02_r8,0.15221e-02_r8, & + & 0.16094e-02_r8,0.16610e-02_r8,0.16426e-02_r8,0.16655e-02_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.12905e-02_r8,0.12343e-02_r8,0.13399e-02_r8,0.14335e-02_r8,0.15224e-02_r8, & + & 0.16137e-02_r8,0.16692e-02_r8,0.16519e-02_r8,0.16891e-02_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.12916e-02_r8,0.12305e-02_r8,0.13333e-02_r8,0.14197e-02_r8,0.15049e-02_r8, & + & 0.15945e-02_r8,0.16481e-02_r8,0.16282e-02_r8,0.16593e-02_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.11586e-02_r8,0.11791e-02_r8,0.13059e-02_r8,0.14246e-02_r8,0.15191e-02_r8, & + & 0.16155e-02_r8,0.16888e-02_r8,0.16884e-02_r8,0.16900e-02_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.11563e-02_r8,0.11735e-02_r8,0.13020e-02_r8,0.14191e-02_r8,0.15117e-02_r8, & + & 0.16067e-02_r8,0.16804e-02_r8,0.16804e-02_r8,0.16885e-02_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.11547e-02_r8,0.11684e-02_r8,0.12989e-02_r8,0.14121e-02_r8,0.15049e-02_r8, & + & 0.15986e-02_r8,0.16736e-02_r8,0.16742e-02_r8,0.16864e-02_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.11549e-02_r8,0.11640e-02_r8,0.12947e-02_r8,0.14053e-02_r8,0.14971e-02_r8, & + & 0.15940e-02_r8,0.16690e-02_r8,0.16701e-02_r8,0.16826e-02_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.11568e-02_r8,0.11629e-02_r8,0.12947e-02_r8,0.14048e-02_r8,0.15017e-02_r8, & + & 0.16054e-02_r8,0.16836e-02_r8,0.16886e-02_r8,0.17044e-02_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.10197e-02_r8,0.11002e-02_r8,0.12563e-02_r8,0.13948e-02_r8,0.15048e-02_r8, & + & 0.16026e-02_r8,0.16898e-02_r8,0.17082e-02_r8,0.17013e-02_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.10187e-02_r8,0.10963e-02_r8,0.12532e-02_r8,0.13909e-02_r8,0.14993e-02_r8, & + & 0.15953e-02_r8,0.16843e-02_r8,0.17040e-02_r8,0.16991e-02_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.10179e-02_r8,0.10925e-02_r8,0.12502e-02_r8,0.13858e-02_r8,0.14932e-02_r8, & + & 0.15900e-02_r8,0.16803e-02_r8,0.17019e-02_r8,0.16952e-02_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.10188e-02_r8,0.10896e-02_r8,0.12461e-02_r8,0.13806e-02_r8,0.14878e-02_r8, & + & 0.15873e-02_r8,0.16767e-02_r8,0.17001e-02_r8,0.16925e-02_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.10211e-02_r8,0.10901e-02_r8,0.12464e-02_r8,0.13834e-02_r8,0.14970e-02_r8, & + & 0.16026e-02_r8,0.16952e-02_r8,0.17210e-02_r8,0.17180e-02_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.88455e-03_r8,0.10185e-02_r8,0.12021e-02_r8,0.13605e-02_r8,0.14894e-02_r8, & + & 0.15922e-02_r8,0.16870e-02_r8,0.17277e-02_r8,0.17006e-02_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.88487e-03_r8,0.10158e-02_r8,0.12001e-02_r8,0.13587e-02_r8,0.14854e-02_r8, & + & 0.15856e-02_r8,0.16819e-02_r8,0.17253e-02_r8,0.17001e-02_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.88512e-03_r8,0.10136e-02_r8,0.11981e-02_r8,0.13544e-02_r8,0.14820e-02_r8, & + & 0.15811e-02_r8,0.16785e-02_r8,0.17233e-02_r8,0.16989e-02_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.88698e-03_r8,0.10127e-02_r8,0.11948e-02_r8,0.13505e-02_r8,0.14784e-02_r8, & + & 0.15789e-02_r8,0.16749e-02_r8,0.17211e-02_r8,0.16988e-02_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.88923e-03_r8,0.10128e-02_r8,0.11919e-02_r8,0.13468e-02_r8,0.14756e-02_r8, & + & 0.15764e-02_r8,0.16734e-02_r8,0.17190e-02_r8,0.16990e-02_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.75937e-03_r8,0.93876e-03_r8,0.11443e-02_r8,0.13228e-02_r8,0.14681e-02_r8, & + & 0.15807e-02_r8,0.16771e-02_r8,0.17403e-02_r8,0.16920e-02_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.75998e-03_r8,0.93770e-03_r8,0.11447e-02_r8,0.13222e-02_r8,0.14656e-02_r8, & + & 0.15751e-02_r8,0.16722e-02_r8,0.17374e-02_r8,0.16943e-02_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.76057e-03_r8,0.93698e-03_r8,0.11442e-02_r8,0.13192e-02_r8,0.14630e-02_r8, & + & 0.15711e-02_r8,0.16684e-02_r8,0.17351e-02_r8,0.16966e-02_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.76306e-03_r8,0.93700e-03_r8,0.11417e-02_r8,0.13175e-02_r8,0.14605e-02_r8, & + & 0.15679e-02_r8,0.16649e-02_r8,0.17327e-02_r8,0.16998e-02_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.76563e-03_r8,0.93740e-03_r8,0.11401e-02_r8,0.13155e-02_r8,0.14583e-02_r8, & + & 0.15655e-02_r8,0.16637e-02_r8,0.17306e-02_r8,0.17045e-02_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.64586e-03_r8,0.86421e-03_r8,0.10884e-02_r8,0.12806e-02_r8,0.14383e-02_r8, & + & 0.15636e-02_r8,0.16605e-02_r8,0.17434e-02_r8,0.16711e-02_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.64665e-03_r8,0.86473e-03_r8,0.10896e-02_r8,0.12820e-02_r8,0.14363e-02_r8, & + & 0.15592e-02_r8,0.16561e-02_r8,0.17403e-02_r8,0.16771e-02_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.64816e-03_r8,0.86506e-03_r8,0.10903e-02_r8,0.12802e-02_r8,0.14357e-02_r8, & + & 0.15554e-02_r8,0.16529e-02_r8,0.17367e-02_r8,0.16846e-02_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.65115e-03_r8,0.86561e-03_r8,0.10893e-02_r8,0.12797e-02_r8,0.14336e-02_r8, & + & 0.15533e-02_r8,0.16505e-02_r8,0.17349e-02_r8,0.16920e-02_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.65335e-03_r8,0.86692e-03_r8,0.10897e-02_r8,0.12788e-02_r8,0.14323e-02_r8, & + & 0.15519e-02_r8,0.16494e-02_r8,0.17328e-02_r8,0.17005e-02_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.54495e-03_r8,0.79374e-03_r8,0.10331e-02_r8,0.12325e-02_r8,0.13999e-02_r8, & + & 0.15343e-02_r8,0.16359e-02_r8,0.17304e-02_r8,0.88289e-03_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.54631e-03_r8,0.79621e-03_r8,0.10351e-02_r8,0.12356e-02_r8,0.13999e-02_r8, & + & 0.15332e-02_r8,0.16343e-02_r8,0.17287e-02_r8,0.90009e-03_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.54838e-03_r8,0.79738e-03_r8,0.10366e-02_r8,0.12358e-02_r8,0.14008e-02_r8, & + & 0.15312e-02_r8,0.16325e-02_r8,0.17267e-02_r8,0.91715e-03_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.55103e-03_r8,0.79925e-03_r8,0.10373e-02_r8,0.12370e-02_r8,0.14003e-02_r8, & + & 0.15313e-02_r8,0.16317e-02_r8,0.17265e-02_r8,0.93948e-03_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.55358e-03_r8,0.80158e-03_r8,0.10391e-02_r8,0.12370e-02_r8,0.14008e-02_r8, & + & 0.15320e-02_r8,0.16328e-02_r8,0.17271e-02_r8,0.97099e-03_r8 /) + kao(:, 1,10,12) = (/ & + & 0.45828e-03_r8,0.73128e-03_r8,0.97725e-03_r8,0.11801e-02_r8,0.13541e-02_r8, & + & 0.14966e-02_r8,0.16059e-02_r8,0.17081e-02_r8,0.25261e-04_r8 /) + kao(:, 2,10,12) = (/ & + & 0.45994e-03_r8,0.73433e-03_r8,0.98047e-03_r8,0.11852e-02_r8,0.13571e-02_r8, & + & 0.14993e-02_r8,0.16071e-02_r8,0.17093e-02_r8,0.32778e-04_r8 /) + kao(:, 3,10,12) = (/ & + & 0.46172e-03_r8,0.73698e-03_r8,0.98332e-03_r8,0.11877e-02_r8,0.13607e-02_r8, & + & 0.15001e-02_r8,0.16089e-02_r8,0.17098e-02_r8,0.30108e-04_r8 /) + kao(:, 4,10,12) = (/ & + & 0.46419e-03_r8,0.73967e-03_r8,0.98568e-03_r8,0.11903e-02_r8,0.13620e-02_r8, & + & 0.15042e-02_r8,0.16117e-02_r8,0.17131e-02_r8,0.14814e-04_r8 /) + kao(:, 5,10,12) = (/ & + & 0.46710e-03_r8,0.74287e-03_r8,0.98852e-03_r8,0.11927e-02_r8,0.13653e-02_r8, & + & 0.15080e-02_r8,0.16153e-02_r8,0.17174e-02_r8,0.18206e-04_r8 /) + kao(:, 1,11,12) = (/ & + & 0.38711e-03_r8,0.67660e-03_r8,0.92352e-03_r8,0.11285e-02_r8,0.13042e-02_r8, & + & 0.14533e-02_r8,0.15680e-02_r8,0.16768e-02_r8,0.35375e-04_r8 /) + kao(:, 2,11,12) = (/ & + & 0.38827e-03_r8,0.68076e-03_r8,0.92811e-03_r8,0.11355e-02_r8,0.13110e-02_r8, & + & 0.14578e-02_r8,0.15732e-02_r8,0.16802e-02_r8,0.17785e-04_r8 /) + kao(:, 3,11,12) = (/ & + & 0.39017e-03_r8,0.68339e-03_r8,0.93243e-03_r8,0.11404e-02_r8,0.13179e-02_r8, & + & 0.14648e-02_r8,0.15809e-02_r8,0.16870e-02_r8,0.17310e-04_r8 /) + kao(:, 4,11,12) = (/ & + & 0.39259e-03_r8,0.68706e-03_r8,0.93609e-03_r8,0.11451e-02_r8,0.13243e-02_r8, & + & 0.14746e-02_r8,0.15892e-02_r8,0.16958e-02_r8,0.17795e-04_r8 /) + kao(:, 5,11,12) = (/ & + & 0.39544e-03_r8,0.69011e-03_r8,0.94016e-03_r8,0.11496e-02_r8,0.13318e-02_r8, & + & 0.14825e-02_r8,0.15980e-02_r8,0.17052e-02_r8,0.87581e-05_r8 /) + kao(:, 1,12,12) = (/ & + & 0.32882e-03_r8,0.62658e-03_r8,0.87124e-03_r8,0.10770e-02_r8,0.12526e-02_r8, & + & 0.14042e-02_r8,0.15246e-02_r8,0.16367e-02_r8,0.13823e-04_r8 /) + kao(:, 2,12,12) = (/ & + & 0.33008e-03_r8,0.63068e-03_r8,0.87790e-03_r8,0.10857e-02_r8,0.12638e-02_r8, & + & 0.14155e-02_r8,0.15376e-02_r8,0.16473e-02_r8,0.27356e-04_r8 /) + kao(:, 3,12,12) = (/ & + & 0.33191e-03_r8,0.63479e-03_r8,0.88401e-03_r8,0.10939e-02_r8,0.12749e-02_r8, & + & 0.14298e-02_r8,0.15521e-02_r8,0.16615e-02_r8,0.26924e-04_r8 /) + kao(:, 4,12,12) = (/ & + & 0.33384e-03_r8,0.63914e-03_r8,0.88945e-03_r8,0.11023e-02_r8,0.12871e-02_r8, & + & 0.14439e-02_r8,0.15651e-02_r8,0.16755e-02_r8,0.13486e-04_r8 /) + kao(:, 5,12,12) = (/ & + & 0.33630e-03_r8,0.64288e-03_r8,0.89554e-03_r8,0.11106e-02_r8,0.12985e-02_r8, & + & 0.14567e-02_r8,0.15792e-02_r8,0.16910e-02_r8,0.54470e-04_r8 /) + kao(:, 1,13,12) = (/ & + & 0.28179e-03_r8,0.58039e-03_r8,0.82131e-03_r8,0.10258e-02_r8,0.12001e-02_r8, & + & 0.13522e-02_r8,0.14762e-02_r8,0.15892e-02_r8,0.17365e-04_r8 /) + kao(:, 2,13,12) = (/ & + & 0.28322e-03_r8,0.58517e-03_r8,0.83048e-03_r8,0.10376e-02_r8,0.12180e-02_r8, & + & 0.13721e-02_r8,0.14980e-02_r8,0.16092e-02_r8,0.19167e-10_r8 /) + kao(:, 3,13,12) = (/ & + & 0.28449e-03_r8,0.59004e-03_r8,0.83867e-03_r8,0.10495e-02_r8,0.12349e-02_r8, & + & 0.13937e-02_r8,0.15189e-02_r8,0.16302e-02_r8,0.17686e-04_r8 /) + kao(:, 4,13,12) = (/ & + & 0.28623e-03_r8,0.59506e-03_r8,0.84661e-03_r8,0.10616e-02_r8,0.12511e-02_r8, & + & 0.14124e-02_r8,0.15380e-02_r8,0.16505e-02_r8,0.27174e-10_r8 /) + kao(:, 5,13,12) = (/ & + & 0.28834e-03_r8,0.60000e-03_r8,0.85510e-03_r8,0.10735e-02_r8,0.12664e-02_r8, & + & 0.14298e-02_r8,0.15583e-02_r8,0.16724e-02_r8,0.30930e-10_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.39229e-02_r8,0.34326e-02_r8,0.30162e-02_r8,0.28699e-02_r8,0.28381e-02_r8, & + & 0.27734e-02_r8,0.26260e-02_r8,0.23062e-02_r8,0.25522e-02_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.39213e-02_r8,0.34310e-02_r8,0.30108e-02_r8,0.28565e-02_r8,0.28216e-02_r8, & + & 0.27552e-02_r8,0.26075e-02_r8,0.22956e-02_r8,0.25296e-02_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.39180e-02_r8,0.34283e-02_r8,0.30095e-02_r8,0.28490e-02_r8,0.28140e-02_r8, & + & 0.27516e-02_r8,0.26057e-02_r8,0.23031e-02_r8,0.25320e-02_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.39161e-02_r8,0.34265e-02_r8,0.30039e-02_r8,0.28320e-02_r8,0.27864e-02_r8, & + & 0.27263e-02_r8,0.25779e-02_r8,0.22767e-02_r8,0.24834e-02_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.39129e-02_r8,0.34239e-02_r8,0.29985e-02_r8,0.28202e-02_r8,0.27725e-02_r8, & + & 0.27107e-02_r8,0.25647e-02_r8,0.22654e-02_r8,0.24632e-02_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.35717e-02_r8,0.31250e-02_r8,0.28583e-02_r8,0.28716e-02_r8,0.28885e-02_r8, & + & 0.28569e-02_r8,0.27419e-02_r8,0.24528e-02_r8,0.26589e-02_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.35704e-02_r8,0.31241e-02_r8,0.28509e-02_r8,0.28521e-02_r8,0.28717e-02_r8, & + & 0.28411e-02_r8,0.27277e-02_r8,0.24440e-02_r8,0.26352e-02_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.35692e-02_r8,0.31228e-02_r8,0.28479e-02_r8,0.28438e-02_r8,0.28636e-02_r8, & + & 0.28419e-02_r8,0.27327e-02_r8,0.24542e-02_r8,0.26382e-02_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.35651e-02_r8,0.31194e-02_r8,0.28382e-02_r8,0.28288e-02_r8,0.28472e-02_r8, & + & 0.28288e-02_r8,0.27211e-02_r8,0.24428e-02_r8,0.26140e-02_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.35614e-02_r8,0.31162e-02_r8,0.28280e-02_r8,0.28080e-02_r8,0.28270e-02_r8, & + & 0.28018e-02_r8,0.26919e-02_r8,0.24122e-02_r8,0.25721e-02_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.32370e-02_r8,0.28408e-02_r8,0.27429e-02_r8,0.28459e-02_r8,0.29107e-02_r8, & + & 0.29163e-02_r8,0.28452e-02_r8,0.26013e-02_r8,0.27589e-02_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.32378e-02_r8,0.28409e-02_r8,0.27346e-02_r8,0.28282e-02_r8,0.28967e-02_r8, & + & 0.29036e-02_r8,0.28357e-02_r8,0.25912e-02_r8,0.27381e-02_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.32344e-02_r8,0.28366e-02_r8,0.27224e-02_r8,0.28159e-02_r8,0.28824e-02_r8, & + & 0.28940e-02_r8,0.28268e-02_r8,0.25801e-02_r8,0.27164e-02_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.32328e-02_r8,0.28349e-02_r8,0.27139e-02_r8,0.28071e-02_r8,0.28820e-02_r8, & + & 0.28985e-02_r8,0.28328e-02_r8,0.25870e-02_r8,0.27280e-02_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.32337e-02_r8,0.28348e-02_r8,0.27027e-02_r8,0.27877e-02_r8,0.28613e-02_r8, & + & 0.28723e-02_r8,0.28004e-02_r8,0.25498e-02_r8,0.26848e-02_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.29442e-02_r8,0.26158e-02_r8,0.26686e-02_r8,0.28002e-02_r8,0.29074e-02_r8, & + & 0.29569e-02_r8,0.29354e-02_r8,0.27381e-02_r8,0.28491e-02_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.29416e-02_r8,0.26110e-02_r8,0.26570e-02_r8,0.27866e-02_r8,0.28959e-02_r8, & + & 0.29477e-02_r8,0.29295e-02_r8,0.27262e-02_r8,0.28287e-02_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.29392e-02_r8,0.26064e-02_r8,0.26421e-02_r8,0.27765e-02_r8,0.28845e-02_r8, & + & 0.29406e-02_r8,0.29202e-02_r8,0.27107e-02_r8,0.28099e-02_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.29406e-02_r8,0.26055e-02_r8,0.26309e-02_r8,0.27645e-02_r8,0.28769e-02_r8, & + & 0.29312e-02_r8,0.29057e-02_r8,0.26928e-02_r8,0.27972e-02_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.29379e-02_r8,0.26016e-02_r8,0.26230e-02_r8,0.27605e-02_r8,0.28772e-02_r8, & + & 0.29338e-02_r8,0.29114e-02_r8,0.26956e-02_r8,0.28225e-02_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.26861e-02_r8,0.24510e-02_r8,0.26014e-02_r8,0.27478e-02_r8,0.28811e-02_r8, & + & 0.29878e-02_r8,0.30091e-02_r8,0.28610e-02_r8,0.29320e-02_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.26822e-02_r8,0.24426e-02_r8,0.25898e-02_r8,0.27369e-02_r8,0.28725e-02_r8, & + & 0.29815e-02_r8,0.30039e-02_r8,0.28485e-02_r8,0.29157e-02_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.26829e-02_r8,0.24377e-02_r8,0.25766e-02_r8,0.27289e-02_r8,0.28648e-02_r8, & + & 0.29741e-02_r8,0.29940e-02_r8,0.28292e-02_r8,0.29014e-02_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.26816e-02_r8,0.24329e-02_r8,0.25674e-02_r8,0.27192e-02_r8,0.28602e-02_r8, & + & 0.29643e-02_r8,0.29808e-02_r8,0.28105e-02_r8,0.28911e-02_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.26776e-02_r8,0.24242e-02_r8,0.25584e-02_r8,0.27174e-02_r8,0.28631e-02_r8, & + & 0.29690e-02_r8,0.29916e-02_r8,0.28176e-02_r8,0.29253e-02_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.24590e-02_r8,0.23376e-02_r8,0.25355e-02_r8,0.26945e-02_r8,0.28553e-02_r8, & + & 0.29996e-02_r8,0.30574e-02_r8,0.29544e-02_r8,0.30033e-02_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.24565e-02_r8,0.23281e-02_r8,0.25242e-02_r8,0.26862e-02_r8,0.28495e-02_r8, & + & 0.29966e-02_r8,0.30559e-02_r8,0.29459e-02_r8,0.29901e-02_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.24594e-02_r8,0.23224e-02_r8,0.25135e-02_r8,0.26796e-02_r8,0.28441e-02_r8, & + & 0.29914e-02_r8,0.30494e-02_r8,0.29315e-02_r8,0.29796e-02_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.24561e-02_r8,0.23120e-02_r8,0.25070e-02_r8,0.26723e-02_r8,0.28398e-02_r8, & + & 0.29830e-02_r8,0.30431e-02_r8,0.29165e-02_r8,0.29718e-02_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.24544e-02_r8,0.23009e-02_r8,0.24971e-02_r8,0.26678e-02_r8,0.28335e-02_r8, & + & 0.29758e-02_r8,0.30342e-02_r8,0.29019e-02_r8,0.29654e-02_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.22277e-02_r8,0.22296e-02_r8,0.24669e-02_r8,0.26497e-02_r8,0.28285e-02_r8, & + & 0.29885e-02_r8,0.30855e-02_r8,0.30292e-02_r8,0.30616e-02_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.22293e-02_r8,0.22219e-02_r8,0.24569e-02_r8,0.26437e-02_r8,0.28247e-02_r8, & + & 0.29924e-02_r8,0.30879e-02_r8,0.30266e-02_r8,0.30510e-02_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.22351e-02_r8,0.22176e-02_r8,0.24495e-02_r8,0.26382e-02_r8,0.28222e-02_r8, & + & 0.29913e-02_r8,0.30877e-02_r8,0.30175e-02_r8,0.30415e-02_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.22344e-02_r8,0.22079e-02_r8,0.24453e-02_r8,0.26324e-02_r8,0.28192e-02_r8, & + & 0.29887e-02_r8,0.30862e-02_r8,0.30074e-02_r8,0.30342e-02_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.22361e-02_r8,0.21982e-02_r8,0.24378e-02_r8,0.26291e-02_r8,0.28143e-02_r8, & + & 0.29850e-02_r8,0.30822e-02_r8,0.29969e-02_r8,0.30270e-02_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.19878e-02_r8,0.21080e-02_r8,0.23886e-02_r8,0.26087e-02_r8,0.27952e-02_r8, & + & 0.29676e-02_r8,0.31003e-02_r8,0.30904e-02_r8,0.31018e-02_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.19936e-02_r8,0.21034e-02_r8,0.23825e-02_r8,0.26049e-02_r8,0.27978e-02_r8, & + & 0.29755e-02_r8,0.31107e-02_r8,0.30954e-02_r8,0.30940e-02_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.20012e-02_r8,0.21016e-02_r8,0.23778e-02_r8,0.26010e-02_r8,0.27982e-02_r8, & + & 0.29815e-02_r8,0.31166e-02_r8,0.30929e-02_r8,0.30865e-02_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.20034e-02_r8,0.20960e-02_r8,0.23764e-02_r8,0.25979e-02_r8,0.27992e-02_r8, & + & 0.29823e-02_r8,0.31192e-02_r8,0.30868e-02_r8,0.30812e-02_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.20095e-02_r8,0.20891e-02_r8,0.23711e-02_r8,0.25960e-02_r8,0.27964e-02_r8, & + & 0.29828e-02_r8,0.31181e-02_r8,0.30806e-02_r8,0.30733e-02_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.17523e-02_r8,0.19789e-02_r8,0.23024e-02_r8,0.25572e-02_r8,0.27629e-02_r8, & + & 0.29479e-02_r8,0.31085e-02_r8,0.31444e-02_r8,0.30417e-02_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.17607e-02_r8,0.19777e-02_r8,0.23013e-02_r8,0.25587e-02_r8,0.27691e-02_r8, & + & 0.29613e-02_r8,0.31227e-02_r8,0.31535e-02_r8,0.30346e-02_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.17693e-02_r8,0.19800e-02_r8,0.23011e-02_r8,0.25605e-02_r8,0.27739e-02_r8, & + & 0.29714e-02_r8,0.31329e-02_r8,0.31549e-02_r8,0.30299e-02_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.17751e-02_r8,0.19773e-02_r8,0.23025e-02_r8,0.25606e-02_r8,0.27770e-02_r8, & + & 0.29770e-02_r8,0.31405e-02_r8,0.31532e-02_r8,0.30280e-02_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.17845e-02_r8,0.19738e-02_r8,0.23006e-02_r8,0.25633e-02_r8,0.27766e-02_r8, & + & 0.29802e-02_r8,0.31452e-02_r8,0.31517e-02_r8,0.30317e-02_r8 /) + kao(:, 1,10,13) = (/ & + & 0.15244e-02_r8,0.18437e-02_r8,0.22100e-02_r8,0.24972e-02_r8,0.27331e-02_r8, & + & 0.29304e-02_r8,0.31059e-02_r8,0.31844e-02_r8,0.23817e-04_r8 /) + kao(:, 2,10,13) = (/ & + & 0.15360e-02_r8,0.18467e-02_r8,0.22145e-02_r8,0.25068e-02_r8,0.27437e-02_r8, & + & 0.29473e-02_r8,0.31260e-02_r8,0.31986e-02_r8,0.12454e-04_r8 /) + kao(:, 3,10,13) = (/ & + & 0.15476e-02_r8,0.18512e-02_r8,0.22181e-02_r8,0.25119e-02_r8,0.27538e-02_r8, & + & 0.29593e-02_r8,0.31389e-02_r8,0.32042e-02_r8,0.30814e-04_r8 /) + kao(:, 4,10,13) = (/ & + & 0.15571e-02_r8,0.18528e-02_r8,0.22235e-02_r8,0.25174e-02_r8,0.27591e-02_r8, & + & 0.29666e-02_r8,0.31497e-02_r8,0.32063e-02_r8,0.11698e-04_r8 /) + kao(:, 5,10,13) = (/ & + & 0.15695e-02_r8,0.18534e-02_r8,0.22262e-02_r8,0.25236e-02_r8,0.27611e-02_r8, & + & 0.29733e-02_r8,0.31600e-02_r8,0.32093e-02_r8,0.22330e-04_r8 /) + kao(:, 1,11,13) = (/ & + & 0.13188e-02_r8,0.17123e-02_r8,0.21150e-02_r8,0.24398e-02_r8,0.27060e-02_r8, & + & 0.29190e-02_r8,0.31061e-02_r8,0.32197e-02_r8,0.11689e-04_r8 /) + kao(:, 2,11,13) = (/ & + & 0.13341e-02_r8,0.17189e-02_r8,0.21240e-02_r8,0.24532e-02_r8,0.27222e-02_r8, & + & 0.29371e-02_r8,0.31262e-02_r8,0.32338e-02_r8,0.11845e-04_r8 /) + kao(:, 3,11,13) = (/ & + & 0.13447e-02_r8,0.17274e-02_r8,0.21339e-02_r8,0.24651e-02_r8,0.27343e-02_r8, & + & 0.29498e-02_r8,0.31430e-02_r8,0.32440e-02_r8,0.24255e-04_r8 /) + kao(:, 4,11,13) = (/ & + & 0.13578e-02_r8,0.17324e-02_r8,0.21454e-02_r8,0.24765e-02_r8,0.27400e-02_r8, & + & 0.29585e-02_r8,0.31579e-02_r8,0.32502e-02_r8,0.35648e-04_r8 /) + kao(:, 5,11,13) = (/ & + & 0.13715e-02_r8,0.17394e-02_r8,0.21518e-02_r8,0.24842e-02_r8,0.27436e-02_r8, & + & 0.29689e-02_r8,0.31719e-02_r8,0.32570e-02_r8,0.48216e-04_r8 /) + kao(:, 1,12,13) = (/ & + & 0.11367e-02_r8,0.15942e-02_r8,0.20255e-02_r8,0.23827e-02_r8,0.26757e-02_r8, & + & 0.29001e-02_r8,0.30944e-02_r8,0.32386e-02_r8,0.48616e-12_r8 /) + kao(:, 2,12,13) = (/ & + & 0.11495e-02_r8,0.16057e-02_r8,0.20405e-02_r8,0.24019e-02_r8,0.26965e-02_r8, & + & 0.29177e-02_r8,0.31160e-02_r8,0.32553e-02_r8,0.63803e-12_r8 /) + kao(:, 3,12,13) = (/ & + & 0.11626e-02_r8,0.16147e-02_r8,0.20558e-02_r8,0.24193e-02_r8,0.27102e-02_r8, & + & 0.29330e-02_r8,0.31363e-02_r8,0.32673e-02_r8,0.18451e-04_r8 /) + kao(:, 4,12,13) = (/ & + & 0.11784e-02_r8,0.16224e-02_r8,0.20681e-02_r8,0.24334e-02_r8,0.27187e-02_r8, & + & 0.29473e-02_r8,0.31560e-02_r8,0.32789e-02_r8,0.93725e-12_r8 /) + kao(:, 5,12,13) = (/ & + & 0.11935e-02_r8,0.16327e-02_r8,0.20790e-02_r8,0.24438e-02_r8,0.27275e-02_r8, & + & 0.29614e-02_r8,0.31756e-02_r8,0.32901e-02_r8,0.36773e-04_r8 /) + kao(:, 1,13,13) = (/ & + & 0.97386e-03_r8,0.14865e-02_r8,0.19422e-02_r8,0.23265e-02_r8,0.26377e-02_r8, & + & 0.28742e-02_r8,0.30758e-02_r8,0.32440e-02_r8,0.42838e-12_r8 /) + kao(:, 2,13,13) = (/ & + & 0.98704e-03_r8,0.15018e-02_r8,0.19617e-02_r8,0.23518e-02_r8,0.26608e-02_r8, & + & 0.28955e-02_r8,0.31025e-02_r8,0.32660e-02_r8,0.54956e-12_r8 /) + kao(:, 3,13,13) = (/ & + & 0.10034e-02_r8,0.15127e-02_r8,0.19822e-02_r8,0.23722e-02_r8,0.26791e-02_r8, & + & 0.29131e-02_r8,0.31272e-02_r8,0.32827e-02_r8,0.68281e-12_r8 /) + kao(:, 4,13,13) = (/ & + & 0.10185e-02_r8,0.15248e-02_r8,0.19990e-02_r8,0.23896e-02_r8,0.26942e-02_r8, & + & 0.29331e-02_r8,0.31525e-02_r8,0.33003e-02_r8,0.47348e-04_r8 /) + kao(:, 5,13,13) = (/ & + & 0.10353e-02_r8,0.15370e-02_r8,0.20122e-02_r8,0.24032e-02_r8,0.27096e-02_r8, & + & 0.29526e-02_r8,0.31774e-02_r8,0.33154e-02_r8,0.94094e-12_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.11127e-01_r8,0.97365e-02_r8,0.83450e-02_r8,0.69546e-02_r8,0.57518e-02_r8, & + & 0.48972e-02_r8,0.42517e-02_r8,0.34771e-02_r8,0.44616e-02_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.11168e-01_r8,0.97719e-02_r8,0.83762e-02_r8,0.69801e-02_r8,0.57613e-02_r8, & + & 0.48914e-02_r8,0.42324e-02_r8,0.34356e-02_r8,0.44183e-02_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.11206e-01_r8,0.98061e-02_r8,0.84051e-02_r8,0.70040e-02_r8,0.57786e-02_r8, & + & 0.48973e-02_r8,0.42300e-02_r8,0.34167e-02_r8,0.44088e-02_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.11230e-01_r8,0.98265e-02_r8,0.84228e-02_r8,0.70190e-02_r8,0.57794e-02_r8, & + & 0.48702e-02_r8,0.41927e-02_r8,0.33658e-02_r8,0.43365e-02_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.11247e-01_r8,0.98411e-02_r8,0.84348e-02_r8,0.70292e-02_r8,0.57800e-02_r8, & + & 0.48600e-02_r8,0.41735e-02_r8,0.33367e-02_r8,0.43003e-02_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.11360e-01_r8,0.99403e-02_r8,0.85204e-02_r8,0.71449e-02_r8,0.60754e-02_r8, & + & 0.53678e-02_r8,0.47333e-02_r8,0.38804e-02_r8,0.48459e-02_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.11402e-01_r8,0.99768e-02_r8,0.85517e-02_r8,0.71687e-02_r8,0.60816e-02_r8, & + & 0.53522e-02_r8,0.47062e-02_r8,0.38343e-02_r8,0.48034e-02_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.11432e-01_r8,0.10003e-01_r8,0.85744e-02_r8,0.71872e-02_r8,0.60934e-02_r8, & + & 0.53498e-02_r8,0.46968e-02_r8,0.38177e-02_r8,0.48004e-02_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.11460e-01_r8,0.10028e-01_r8,0.85956e-02_r8,0.72000e-02_r8,0.60909e-02_r8, & + & 0.53282e-02_r8,0.46686e-02_r8,0.37852e-02_r8,0.47598e-02_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.11484e-01_r8,0.10049e-01_r8,0.86132e-02_r8,0.72108e-02_r8,0.60794e-02_r8, & + & 0.52951e-02_r8,0.46284e-02_r8,0.37347e-02_r8,0.46895e-02_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.11375e-01_r8,0.99535e-02_r8,0.85318e-02_r8,0.72748e-02_r8,0.63965e-02_r8, & + & 0.58374e-02_r8,0.52215e-02_r8,0.43002e-02_r8,0.52258e-02_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.11412e-01_r8,0.99855e-02_r8,0.85592e-02_r8,0.72909e-02_r8,0.63926e-02_r8, & + & 0.58142e-02_r8,0.51838e-02_r8,0.42530e-02_r8,0.51857e-02_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.11451e-01_r8,0.10019e-01_r8,0.85873e-02_r8,0.73027e-02_r8,0.63856e-02_r8, & + & 0.57886e-02_r8,0.51485e-02_r8,0.42153e-02_r8,0.51479e-02_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.11483e-01_r8,0.10047e-01_r8,0.86122e-02_r8,0.73190e-02_r8,0.63840e-02_r8, & + & 0.57742e-02_r8,0.51342e-02_r8,0.42027e-02_r8,0.51482e-02_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.11512e-01_r8,0.10073e-01_r8,0.86339e-02_r8,0.73301e-02_r8,0.63706e-02_r8, & + & 0.57344e-02_r8,0.50899e-02_r8,0.41496e-02_r8,0.50782e-02_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.11149e-01_r8,0.97560e-02_r8,0.83906e-02_r8,0.73568e-02_r8,0.67050e-02_r8, & + & 0.62789e-02_r8,0.56809e-02_r8,0.47244e-02_r8,0.55742e-02_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.11201e-01_r8,0.98016e-02_r8,0.84237e-02_r8,0.73684e-02_r8,0.66927e-02_r8, & + & 0.62506e-02_r8,0.56398e-02_r8,0.46775e-02_r8,0.55381e-02_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.11250e-01_r8,0.98437e-02_r8,0.84576e-02_r8,0.73794e-02_r8,0.66793e-02_r8, & + & 0.62192e-02_r8,0.56018e-02_r8,0.46402e-02_r8,0.55028e-02_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.11293e-01_r8,0.98814e-02_r8,0.84883e-02_r8,0.73928e-02_r8,0.66658e-02_r8, & + & 0.61879e-02_r8,0.55699e-02_r8,0.46073e-02_r8,0.54669e-02_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.11341e-01_r8,0.99237e-02_r8,0.85206e-02_r8,0.74085e-02_r8,0.66636e-02_r8, & + & 0.61710e-02_r8,0.55548e-02_r8,0.45934e-02_r8,0.54646e-02_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.10704e-01_r8,0.93660e-02_r8,0.81568e-02_r8,0.74021e-02_r8,0.69945e-02_r8, & + & 0.66654e-02_r8,0.61172e-02_r8,0.51470e-02_r8,0.58967e-02_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.10771e-01_r8,0.94250e-02_r8,0.81953e-02_r8,0.74101e-02_r8,0.69769e-02_r8, & + & 0.66347e-02_r8,0.60743e-02_r8,0.50992e-02_r8,0.58616e-02_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.10834e-01_r8,0.94795e-02_r8,0.82348e-02_r8,0.74202e-02_r8,0.69586e-02_r8, & + & 0.66047e-02_r8,0.60376e-02_r8,0.50623e-02_r8,0.58279e-02_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.10899e-01_r8,0.95365e-02_r8,0.82726e-02_r8,0.74343e-02_r8,0.69400e-02_r8, & + & 0.65760e-02_r8,0.60076e-02_r8,0.50289e-02_r8,0.57953e-02_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.10965e-01_r8,0.95941e-02_r8,0.83123e-02_r8,0.74464e-02_r8,0.69292e-02_r8, & + & 0.65626e-02_r8,0.59940e-02_r8,0.50178e-02_r8,0.57938e-02_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.10078e-01_r8,0.88178e-02_r8,0.78666e-02_r8,0.74112e-02_r8,0.72308e-02_r8, & + & 0.70100e-02_r8,0.65312e-02_r8,0.55779e-02_r8,0.62140e-02_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.10161e-01_r8,0.88906e-02_r8,0.79113e-02_r8,0.74185e-02_r8,0.72160e-02_r8, & + & 0.69843e-02_r8,0.64888e-02_r8,0.55247e-02_r8,0.61818e-02_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.10243e-01_r8,0.89616e-02_r8,0.79583e-02_r8,0.74318e-02_r8,0.71999e-02_r8, & + & 0.69579e-02_r8,0.64523e-02_r8,0.54833e-02_r8,0.61492e-02_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.10327e-01_r8,0.90374e-02_r8,0.79989e-02_r8,0.74443e-02_r8,0.71832e-02_r8, & + & 0.69350e-02_r8,0.64210e-02_r8,0.54479e-02_r8,0.61172e-02_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.10409e-01_r8,0.91075e-02_r8,0.80421e-02_r8,0.74489e-02_r8,0.71645e-02_r8, & + & 0.69118e-02_r8,0.63952e-02_r8,0.54129e-02_r8,0.60849e-02_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.93799e-02_r8,0.82246e-02_r8,0.75645e-02_r8,0.73983e-02_r8,0.74124e-02_r8, & + & 0.73054e-02_r8,0.69103e-02_r8,0.59986e-02_r8,0.65205e-02_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.94746e-02_r8,0.83048e-02_r8,0.76105e-02_r8,0.74041e-02_r8,0.74008e-02_r8, & + & 0.72835e-02_r8,0.68745e-02_r8,0.59435e-02_r8,0.64911e-02_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.95665e-02_r8,0.83814e-02_r8,0.76560e-02_r8,0.74150e-02_r8,0.73885e-02_r8, & + & 0.72645e-02_r8,0.68399e-02_r8,0.59000e-02_r8,0.64612e-02_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.96610e-02_r8,0.84615e-02_r8,0.76953e-02_r8,0.74218e-02_r8,0.73786e-02_r8, & + & 0.72467e-02_r8,0.68110e-02_r8,0.58618e-02_r8,0.64309e-02_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.97576e-02_r8,0.85445e-02_r8,0.77428e-02_r8,0.74271e-02_r8,0.73666e-02_r8, & + & 0.72295e-02_r8,0.67856e-02_r8,0.58248e-02_r8,0.64018e-02_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.86695e-02_r8,0.76539e-02_r8,0.72832e-02_r8,0.73811e-02_r8,0.75539e-02_r8, & + & 0.75395e-02_r8,0.72391e-02_r8,0.63979e-02_r8,0.68067e-02_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.87714e-02_r8,0.77350e-02_r8,0.73260e-02_r8,0.73889e-02_r8,0.75481e-02_r8, & + & 0.75307e-02_r8,0.72059e-02_r8,0.63386e-02_r8,0.67797e-02_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.88648e-02_r8,0.78065e-02_r8,0.73635e-02_r8,0.73928e-02_r8,0.75428e-02_r8, & + & 0.75176e-02_r8,0.71786e-02_r8,0.62948e-02_r8,0.67512e-02_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.89696e-02_r8,0.78903e-02_r8,0.74008e-02_r8,0.73947e-02_r8,0.75364e-02_r8, & + & 0.75091e-02_r8,0.71562e-02_r8,0.62573e-02_r8,0.67249e-02_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.90827e-02_r8,0.79827e-02_r8,0.74524e-02_r8,0.74004e-02_r8,0.75307e-02_r8, & + & 0.75004e-02_r8,0.71406e-02_r8,0.62196e-02_r8,0.66995e-02_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.79522e-02_r8,0.71197e-02_r8,0.70358e-02_r8,0.73522e-02_r8,0.76328e-02_r8, & + & 0.77097e-02_r8,0.75175e-02_r8,0.67703e-02_r8,0.70524e-02_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.80598e-02_r8,0.71969e-02_r8,0.70715e-02_r8,0.73653e-02_r8,0.76374e-02_r8, & + & 0.77113e-02_r8,0.74908e-02_r8,0.67151e-02_r8,0.70338e-02_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.81632e-02_r8,0.72678e-02_r8,0.71027e-02_r8,0.73712e-02_r8,0.76458e-02_r8, & + & 0.77123e-02_r8,0.74742e-02_r8,0.66728e-02_r8,0.70182e-02_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.82823e-02_r8,0.73561e-02_r8,0.71392e-02_r8,0.73768e-02_r8,0.76576e-02_r8, & + & 0.77143e-02_r8,0.74622e-02_r8,0.66357e-02_r8,0.69991e-02_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.84105e-02_r8,0.74558e-02_r8,0.71910e-02_r8,0.73874e-02_r8,0.76648e-02_r8, & + & 0.77180e-02_r8,0.74509e-02_r8,0.65977e-02_r8,0.69736e-02_r8 /) + kao(:, 1,10,14) = (/ & + & 0.72630e-02_r8,0.66377e-02_r8,0.68373e-02_r8,0.72984e-02_r8,0.76509e-02_r8, & + & 0.78294e-02_r8,0.77460e-02_r8,0.71207e-02_r8,0.20344e-04_r8 /) + kao(:, 2,10,14) = (/ & + & 0.73671e-02_r8,0.67055e-02_r8,0.68587e-02_r8,0.73198e-02_r8,0.76710e-02_r8, & + & 0.78437e-02_r8,0.77323e-02_r8,0.70655e-02_r8,0.20564e-04_r8 /) + kao(:, 3,10,14) = (/ & + & 0.74810e-02_r8,0.67793e-02_r8,0.68858e-02_r8,0.73353e-02_r8,0.76947e-02_r8, & + & 0.78590e-02_r8,0.77307e-02_r8,0.70272e-02_r8,0.37563e-05_r8 /) + kao(:, 4,10,14) = (/ & + & 0.76171e-02_r8,0.68754e-02_r8,0.69230e-02_r8,0.73502e-02_r8,0.77241e-02_r8, & + & 0.78765e-02_r8,0.77271e-02_r8,0.69915e-02_r8,0.47236e-05_r8 /) + kao(:, 5,10,14) = (/ & + & 0.77608e-02_r8,0.69811e-02_r8,0.69732e-02_r8,0.73676e-02_r8,0.77455e-02_r8, & + & 0.78941e-02_r8,0.77236e-02_r8,0.69531e-02_r8,0.26047e-04_r8 /) + kao(:, 1,11,14) = (/ & + & 0.66493e-02_r8,0.62366e-02_r8,0.66807e-02_r8,0.72344e-02_r8,0.76404e-02_r8, & + & 0.79217e-02_r8,0.79405e-02_r8,0.74097e-02_r8,0.00000e+00_r8 /) + kao(:, 2,11,14) = (/ & + & 0.67616e-02_r8,0.63044e-02_r8,0.67053e-02_r8,0.72656e-02_r8,0.76819e-02_r8, & + & 0.79515e-02_r8,0.79506e-02_r8,0.73718e-02_r8,0.18408e-04_r8 /) + kao(:, 3,11,14) = (/ & + & 0.69005e-02_r8,0.63894e-02_r8,0.67349e-02_r8,0.72931e-02_r8,0.77291e-02_r8, & + & 0.79845e-02_r8,0.79576e-02_r8,0.73388e-02_r8,0.37607e-04_r8 /) + kao(:, 4,11,14) = (/ & + & 0.70530e-02_r8,0.64912e-02_r8,0.67712e-02_r8,0.73223e-02_r8,0.77726e-02_r8, & + & 0.80170e-02_r8,0.79618e-02_r8,0.73054e-02_r8,0.56367e-04_r8 /) + kao(:, 5,11,14) = (/ & + & 0.72039e-02_r8,0.65911e-02_r8,0.68118e-02_r8,0.73572e-02_r8,0.78096e-02_r8, & + & 0.80477e-02_r8,0.79648e-02_r8,0.72708e-02_r8,0.00000e+00_r8 /) + kao(:, 1,12,14) = (/ & + & 0.60858e-02_r8,0.58916e-02_r8,0.65335e-02_r8,0.71525e-02_r8,0.76284e-02_r8, & + & 0.80006e-02_r8,0.81294e-02_r8,0.76675e-02_r8,0.58588e-04_r8 /) + kao(:, 2,12,14) = (/ & + & 0.62191e-02_r8,0.59612e-02_r8,0.65675e-02_r8,0.71998e-02_r8,0.76898e-02_r8, & + & 0.80500e-02_r8,0.81534e-02_r8,0.76479e-02_r8,0.00000e+00_r8 /) + kao(:, 3,12,14) = (/ & + & 0.63725e-02_r8,0.60546e-02_r8,0.66095e-02_r8,0.72445e-02_r8,0.77558e-02_r8, & + & 0.80973e-02_r8,0.81695e-02_r8,0.76255e-02_r8,0.29841e-04_r8 /) + kao(:, 4,12,14) = (/ & + & 0.65241e-02_r8,0.61494e-02_r8,0.66519e-02_r8,0.72916e-02_r8,0.78126e-02_r8, & + & 0.81445e-02_r8,0.81839e-02_r8,0.75955e-02_r8,0.00000e+00_r8 /) + kao(:, 5,12,14) = (/ & + & 0.66908e-02_r8,0.62534e-02_r8,0.66904e-02_r8,0.73429e-02_r8,0.78615e-02_r8, & + & 0.81879e-02_r8,0.81898e-02_r8,0.75652e-02_r8,0.00000e+00_r8 /) + kao(:, 1,13,14) = (/ & + & 0.55891e-02_r8,0.56116e-02_r8,0.63936e-02_r8,0.70621e-02_r8,0.76241e-02_r8, & + & 0.80837e-02_r8,0.82964e-02_r8,0.79007e-02_r8,0.00000e+00_r8 /) + kao(:, 2,13,14) = (/ & + & 0.57354e-02_r8,0.56825e-02_r8,0.64439e-02_r8,0.71280e-02_r8,0.77039e-02_r8, & + & 0.81460e-02_r8,0.83322e-02_r8,0.78896e-02_r8,0.38090e-04_r8 /) + kao(:, 3,13,14) = (/ & + & 0.58847e-02_r8,0.57651e-02_r8,0.64971e-02_r8,0.71963e-02_r8,0.77792e-02_r8, & + & 0.82047e-02_r8,0.83632e-02_r8,0.78746e-02_r8,0.00000e+00_r8 /) + kao(:, 4,13,14) = (/ & + & 0.60503e-02_r8,0.58579e-02_r8,0.65448e-02_r8,0.72663e-02_r8,0.78467e-02_r8, & + & 0.82617e-02_r8,0.83886e-02_r8,0.78555e-02_r8,0.00000e+00_r8 /) + kao(:, 5,13,14) = (/ & + & 0.62326e-02_r8,0.59678e-02_r8,0.65939e-02_r8,0.73313e-02_r8,0.79071e-02_r8, & + & 0.83133e-02_r8,0.83975e-02_r8,0.78294e-02_r8,0.00000e+00_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.22784e-01_r8,0.19937e-01_r8,0.17089e-01_r8,0.14240e-01_r8,0.11393e-01_r8, & + & 0.85439e-02_r8,0.62360e-02_r8,0.50515e-02_r8,0.76952e-02_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.22781e-01_r8,0.19933e-01_r8,0.17085e-01_r8,0.14238e-01_r8,0.11390e-01_r8, & + & 0.85426e-02_r8,0.62118e-02_r8,0.49990e-02_r8,0.75953e-02_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.22781e-01_r8,0.19934e-01_r8,0.17086e-01_r8,0.14239e-01_r8,0.11390e-01_r8, & + & 0.85428e-02_r8,0.62149e-02_r8,0.49913e-02_r8,0.75531e-02_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.22807e-01_r8,0.19955e-01_r8,0.17104e-01_r8,0.14253e-01_r8,0.11403e-01_r8, & + & 0.85521e-02_r8,0.61662e-02_r8,0.48921e-02_r8,0.74213e-02_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.22846e-01_r8,0.19991e-01_r8,0.17134e-01_r8,0.14278e-01_r8,0.11422e-01_r8, & + & 0.85672e-02_r8,0.61477e-02_r8,0.48442e-02_r8,0.73437e-02_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.25963e-01_r8,0.22716e-01_r8,0.19471e-01_r8,0.16227e-01_r8,0.12981e-01_r8, & + & 0.97432e-02_r8,0.72799e-02_r8,0.58913e-02_r8,0.89930e-02_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.25957e-01_r8,0.22712e-01_r8,0.19468e-01_r8,0.16223e-01_r8,0.12978e-01_r8, & + & 0.97376e-02_r8,0.72409e-02_r8,0.58243e-02_r8,0.88738e-02_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.25967e-01_r8,0.22721e-01_r8,0.19475e-01_r8,0.16229e-01_r8,0.12984e-01_r8, & + & 0.97376e-02_r8,0.72294e-02_r8,0.57970e-02_r8,0.88082e-02_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.25991e-01_r8,0.22741e-01_r8,0.19493e-01_r8,0.16243e-01_r8,0.12995e-01_r8, & + & 0.97464e-02_r8,0.71939e-02_r8,0.57194e-02_r8,0.86974e-02_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.26012e-01_r8,0.22759e-01_r8,0.19508e-01_r8,0.16256e-01_r8,0.13005e-01_r8, & + & 0.97539e-02_r8,0.71378e-02_r8,0.56167e-02_r8,0.85506e-02_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.29273e-01_r8,0.25614e-01_r8,0.21954e-01_r8,0.18296e-01_r8,0.14638e-01_r8, & + & 0.11059e-01_r8,0.84536e-02_r8,0.68488e-02_r8,0.10453e-01_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.29273e-01_r8,0.25613e-01_r8,0.21954e-01_r8,0.18296e-01_r8,0.14636e-01_r8, & + & 0.11040e-01_r8,0.84006e-02_r8,0.67671e-02_r8,0.10308e-01_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.29281e-01_r8,0.25620e-01_r8,0.21957e-01_r8,0.18299e-01_r8,0.14639e-01_r8, & + & 0.11029e-01_r8,0.83532e-02_r8,0.66803e-02_r8,0.10170e-01_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.29284e-01_r8,0.25622e-01_r8,0.21963e-01_r8,0.18303e-01_r8,0.14642e-01_r8, & + & 0.11027e-01_r8,0.83265e-02_r8,0.66328e-02_r8,0.10072e-01_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.29273e-01_r8,0.25615e-01_r8,0.21955e-01_r8,0.18297e-01_r8,0.14636e-01_r8, & + & 0.11016e-01_r8,0.82524e-02_r8,0.65141e-02_r8,0.98927e-02_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.32689e-01_r8,0.28601e-01_r8,0.24517e-01_r8,0.20431e-01_r8,0.16343e-01_r8, & + & 0.12498e-01_r8,0.97860e-02_r8,0.79359e-02_r8,0.11964e-01_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.32673e-01_r8,0.28590e-01_r8,0.24505e-01_r8,0.20420e-01_r8,0.16336e-01_r8, & + & 0.12462e-01_r8,0.97090e-02_r8,0.78356e-02_r8,0.11793e-01_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.32657e-01_r8,0.28575e-01_r8,0.24494e-01_r8,0.20410e-01_r8,0.16330e-01_r8, & + & 0.12434e-01_r8,0.96384e-02_r8,0.77321e-02_r8,0.11625e-01_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.32631e-01_r8,0.28553e-01_r8,0.24473e-01_r8,0.20396e-01_r8,0.16316e-01_r8, & + & 0.12404e-01_r8,0.95671e-02_r8,0.76286e-02_r8,0.11457e-01_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.32595e-01_r8,0.28521e-01_r8,0.24445e-01_r8,0.20372e-01_r8,0.16297e-01_r8, & + & 0.12376e-01_r8,0.95137e-02_r8,0.75694e-02_r8,0.11318e-01_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.36129e-01_r8,0.31613e-01_r8,0.27097e-01_r8,0.22582e-01_r8,0.18065e-01_r8, & + & 0.14059e-01_r8,0.11253e-01_r8,0.91497e-02_r8,0.13513e-01_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.36091e-01_r8,0.31580e-01_r8,0.27068e-01_r8,0.22557e-01_r8,0.18046e-01_r8, & + & 0.13996e-01_r8,0.11159e-01_r8,0.90273e-02_r8,0.13314e-01_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.36050e-01_r8,0.31543e-01_r8,0.27038e-01_r8,0.22530e-01_r8,0.18025e-01_r8, & + & 0.13938e-01_r8,0.11057e-01_r8,0.89022e-02_r8,0.13117e-01_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.35994e-01_r8,0.31496e-01_r8,0.26994e-01_r8,0.22495e-01_r8,0.17996e-01_r8, & + & 0.13877e-01_r8,0.10953e-01_r8,0.87755e-02_r8,0.12914e-01_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.35944e-01_r8,0.31450e-01_r8,0.26957e-01_r8,0.22466e-01_r8,0.17973e-01_r8, & + & 0.13819e-01_r8,0.10863e-01_r8,0.86942e-02_r8,0.12744e-01_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.39506e-01_r8,0.34566e-01_r8,0.29627e-01_r8,0.24691e-01_r8,0.19819e-01_r8, & + & 0.15734e-01_r8,0.12852e-01_r8,0.10482e-01_r8,0.15100e-01_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.39438e-01_r8,0.34510e-01_r8,0.29581e-01_r8,0.24651e-01_r8,0.19767e-01_r8, & + & 0.15626e-01_r8,0.12723e-01_r8,0.10339e-01_r8,0.14869e-01_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.39363e-01_r8,0.34443e-01_r8,0.29524e-01_r8,0.24601e-01_r8,0.19714e-01_r8, & + & 0.15531e-01_r8,0.12593e-01_r8,0.10189e-01_r8,0.14636e-01_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.39295e-01_r8,0.34380e-01_r8,0.29468e-01_r8,0.24559e-01_r8,0.19663e-01_r8, & + & 0.15432e-01_r8,0.12453e-01_r8,0.10038e-01_r8,0.14402e-01_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.39232e-01_r8,0.34326e-01_r8,0.29423e-01_r8,0.24518e-01_r8,0.19622e-01_r8, & + & 0.15336e-01_r8,0.12308e-01_r8,0.98939e-02_r8,0.14172e-01_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.42642e-01_r8,0.37314e-01_r8,0.31983e-01_r8,0.26652e-01_r8,0.21609e-01_r8, & + & 0.17542e-01_r8,0.14584e-01_r8,0.11924e-01_r8,0.16714e-01_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.42588e-01_r8,0.37267e-01_r8,0.31942e-01_r8,0.26620e-01_r8,0.21537e-01_r8, & + & 0.17385e-01_r8,0.14405e-01_r8,0.11750e-01_r8,0.16453e-01_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.42519e-01_r8,0.37203e-01_r8,0.31888e-01_r8,0.26575e-01_r8,0.21450e-01_r8, & + & 0.17237e-01_r8,0.14233e-01_r8,0.11569e-01_r8,0.16190e-01_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.42450e-01_r8,0.37145e-01_r8,0.31837e-01_r8,0.26531e-01_r8,0.21364e-01_r8, & + & 0.17089e-01_r8,0.14051e-01_r8,0.11390e-01_r8,0.15924e-01_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.42372e-01_r8,0.37075e-01_r8,0.31780e-01_r8,0.26482e-01_r8,0.21293e-01_r8, & + & 0.16947e-01_r8,0.13866e-01_r8,0.11216e-01_r8,0.15662e-01_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.45438e-01_r8,0.39757e-01_r8,0.34077e-01_r8,0.28427e-01_r8,0.23418e-01_r8, & + & 0.19456e-01_r8,0.16427e-01_r8,0.13456e-01_r8,0.18359e-01_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.45420e-01_r8,0.39742e-01_r8,0.34065e-01_r8,0.28396e-01_r8,0.23308e-01_r8, & + & 0.19242e-01_r8,0.16196e-01_r8,0.13253e-01_r8,0.18076e-01_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.45404e-01_r8,0.39728e-01_r8,0.34054e-01_r8,0.28379e-01_r8,0.23190e-01_r8, & + & 0.19044e-01_r8,0.15968e-01_r8,0.13036e-01_r8,0.17789e-01_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.45355e-01_r8,0.39684e-01_r8,0.34015e-01_r8,0.28348e-01_r8,0.23074e-01_r8, & + & 0.18841e-01_r8,0.15735e-01_r8,0.12818e-01_r8,0.17487e-01_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.45268e-01_r8,0.39604e-01_r8,0.33951e-01_r8,0.28294e-01_r8,0.22964e-01_r8, & + & 0.18639e-01_r8,0.15495e-01_r8,0.12608e-01_r8,0.17187e-01_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.47828e-01_r8,0.41848e-01_r8,0.35870e-01_r8,0.30096e-01_r8,0.25238e-01_r8, & + & 0.21453e-01_r8,0.18348e-01_r8,0.15048e-01_r8,0.20030e-01_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.47883e-01_r8,0.41899e-01_r8,0.35911e-01_r8,0.30061e-01_r8,0.25102e-01_r8, & + & 0.21178e-01_r8,0.18071e-01_r8,0.14812e-01_r8,0.19720e-01_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.47917e-01_r8,0.41930e-01_r8,0.35941e-01_r8,0.30033e-01_r8,0.24934e-01_r8, & + & 0.20917e-01_r8,0.17786e-01_r8,0.14566e-01_r8,0.19396e-01_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.47914e-01_r8,0.41927e-01_r8,0.35936e-01_r8,0.29997e-01_r8,0.24771e-01_r8, & + & 0.20657e-01_r8,0.17491e-01_r8,0.14311e-01_r8,0.19056e-01_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.47853e-01_r8,0.41872e-01_r8,0.35889e-01_r8,0.29935e-01_r8,0.24616e-01_r8, & + & 0.20393e-01_r8,0.17196e-01_r8,0.14061e-01_r8,0.18721e-01_r8 /) + kao(:, 1,10,15) = (/ & + & 0.49786e-01_r8,0.43562e-01_r8,0.37346e-01_r8,0.31673e-01_r8,0.27058e-01_r8, & + & 0.23446e-01_r8,0.20298e-01_r8,0.16634e-01_r8,0.20401e-01_r8 /) + kao(:, 2,10,15) = (/ & + & 0.49957e-01_r8,0.43713e-01_r8,0.37470e-01_r8,0.31624e-01_r8,0.26879e-01_r8, & + & 0.23121e-01_r8,0.19962e-01_r8,0.16379e-01_r8,0.19980e-01_r8 /) + kao(:, 3,10,15) = (/ & + & 0.50073e-01_r8,0.43811e-01_r8,0.37553e-01_r8,0.31591e-01_r8,0.26668e-01_r8, & + & 0.22810e-01_r8,0.19616e-01_r8,0.16101e-01_r8,0.19150e-01_r8 /) + kao(:, 4,10,15) = (/ & + & 0.50104e-01_r8,0.43839e-01_r8,0.37576e-01_r8,0.31542e-01_r8,0.26451e-01_r8, & + & 0.22487e-01_r8,0.19263e-01_r8,0.15810e-01_r8,0.18309e-01_r8 /) + kao(:, 5,10,15) = (/ & + & 0.50083e-01_r8,0.43821e-01_r8,0.37560e-01_r8,0.31463e-01_r8,0.26247e-01_r8, & + & 0.22153e-01_r8,0.18906e-01_r8,0.15516e-01_r8,0.17790e-01_r8 /) + kao(:, 1,11,15) = (/ & + & 0.51449e-01_r8,0.45016e-01_r8,0.38642e-01_r8,0.33136e-01_r8,0.28759e-01_r8, & + & 0.25254e-01_r8,0.22053e-01_r8,0.18120e-01_r8,0.53897e-02_r8 /) + kao(:, 2,11,15) = (/ & + & 0.51718e-01_r8,0.45255e-01_r8,0.38815e-01_r8,0.33090e-01_r8,0.28517e-01_r8, & + & 0.24894e-01_r8,0.21659e-01_r8,0.17825e-01_r8,0.47196e-02_r8 /) + kao(:, 3,11,15) = (/ & + & 0.51885e-01_r8,0.45397e-01_r8,0.38919e-01_r8,0.33034e-01_r8,0.28248e-01_r8, & + & 0.24520e-01_r8,0.21252e-01_r8,0.17499e-01_r8,0.36639e-02_r8 /) + kao(:, 4,11,15) = (/ & + & 0.51965e-01_r8,0.45468e-01_r8,0.38969e-01_r8,0.32946e-01_r8,0.27987e-01_r8, & + & 0.24125e-01_r8,0.20834e-01_r8,0.17164e-01_r8,0.30436e-02_r8 /) + kao(:, 5,11,15) = (/ & + & 0.52007e-01_r8,0.45508e-01_r8,0.39008e-01_r8,0.32828e-01_r8,0.27732e-01_r8, & + & 0.23720e-01_r8,0.20415e-01_r8,0.16822e-01_r8,0.23024e-02_r8 /) + kao(:, 1,12,15) = (/ & + & 0.52772e-01_r8,0.46179e-01_r8,0.39786e-01_r8,0.34518e-01_r8,0.30341e-01_r8, & + & 0.26996e-01_r8,0.23719e-01_r8,0.19625e-01_r8,0.00000e+00_r8 /) + kao(:, 2,12,15) = (/ & + & 0.53131e-01_r8,0.46489e-01_r8,0.39976e-01_r8,0.34451e-01_r8,0.30050e-01_r8, & + & 0.26583e-01_r8,0.23271e-01_r8,0.19259e-01_r8,0.79250e-04_r8 /) + kao(:, 3,12,15) = (/ & + & 0.53372e-01_r8,0.46707e-01_r8,0.40090e-01_r8,0.34369e-01_r8,0.29734e-01_r8, & + & 0.26140e-01_r8,0.22802e-01_r8,0.18870e-01_r8,0.00000e+00_r8 /) + kao(:, 4,12,15) = (/ & + & 0.53549e-01_r8,0.46855e-01_r8,0.40175e-01_r8,0.34238e-01_r8,0.29424e-01_r8, & + & 0.25661e-01_r8,0.22318e-01_r8,0.18486e-01_r8,0.00000e+00_r8 /) + kao(:, 5,12,15) = (/ & + & 0.53641e-01_r8,0.46944e-01_r8,0.40238e-01_r8,0.34087e-01_r8,0.29108e-01_r8, & + & 0.25184e-01_r8,0.21836e-01_r8,0.18091e-01_r8,0.00000e+00_r8 /) + kao(:, 1,13,15) = (/ & + & 0.53794e-01_r8,0.47070e-01_r8,0.40802e-01_r8,0.35804e-01_r8,0.31808e-01_r8, & + & 0.28611e-01_r8,0.25317e-01_r8,0.21103e-01_r8,0.00000e+00_r8 /) + kao(:, 2,13,15) = (/ & + & 0.54248e-01_r8,0.47468e-01_r8,0.40994e-01_r8,0.35717e-01_r8,0.31468e-01_r8, & + & 0.28147e-01_r8,0.24800e-01_r8,0.20666e-01_r8,0.99549e-04_r8 /) + kao(:, 3,13,15) = (/ & + & 0.54616e-01_r8,0.47795e-01_r8,0.41127e-01_r8,0.35591e-01_r8,0.31112e-01_r8, & + & 0.27634e-01_r8,0.24251e-01_r8,0.20223e-01_r8,0.00000e+00_r8 /) + kao(:, 4,13,15) = (/ & + & 0.54881e-01_r8,0.48017e-01_r8,0.41234e-01_r8,0.35410e-01_r8,0.30749e-01_r8, & + & 0.27090e-01_r8,0.23692e-01_r8,0.19766e-01_r8,0.00000e+00_r8 /) + kao(:, 5,13,15) = (/ & + & 0.55030e-01_r8,0.48150e-01_r8,0.41295e-01_r8,0.35229e-01_r8,0.30369e-01_r8, & + & 0.26544e-01_r8,0.23150e-01_r8,0.19313e-01_r8,0.00000e+00_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.31412e-01_r8,0.27484e-01_r8,0.23556e-01_r8,0.19630e-01_r8,0.15703e-01_r8, & + & 0.11777e-01_r8,0.78503e-02_r8,0.63859e-02_r8,0.10546e-01_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.31306e-01_r8,0.27393e-01_r8,0.23480e-01_r8,0.19566e-01_r8,0.15652e-01_r8, & + & 0.11737e-01_r8,0.78244e-02_r8,0.64039e-02_r8,0.10543e-01_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.31189e-01_r8,0.27291e-01_r8,0.23390e-01_r8,0.19492e-01_r8,0.15594e-01_r8, & + & 0.11694e-01_r8,0.77949e-02_r8,0.65607e-02_r8,0.10621e-01_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.31060e-01_r8,0.27175e-01_r8,0.23293e-01_r8,0.19412e-01_r8,0.15526e-01_r8, & + & 0.11645e-01_r8,0.77621e-02_r8,0.64197e-02_r8,0.10470e-01_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.30934e-01_r8,0.27069e-01_r8,0.23201e-01_r8,0.19334e-01_r8,0.15466e-01_r8, & + & 0.11599e-01_r8,0.77309e-02_r8,0.64181e-02_r8,0.10407e-01_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.37345e-01_r8,0.32673e-01_r8,0.28007e-01_r8,0.23341e-01_r8,0.18670e-01_r8, & + & 0.14002e-01_r8,0.93330e-02_r8,0.76035e-02_r8,0.12759e-01_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.37160e-01_r8,0.32513e-01_r8,0.27871e-01_r8,0.23225e-01_r8,0.18579e-01_r8, & + & 0.13933e-01_r8,0.92868e-02_r8,0.75902e-02_r8,0.12702e-01_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.36977e-01_r8,0.32353e-01_r8,0.27732e-01_r8,0.23111e-01_r8,0.18487e-01_r8, & + & 0.13864e-01_r8,0.92415e-02_r8,0.77168e-02_r8,0.12729e-01_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.36807e-01_r8,0.32204e-01_r8,0.27602e-01_r8,0.23002e-01_r8,0.18402e-01_r8, & + & 0.13798e-01_r8,0.91981e-02_r8,0.77023e-02_r8,0.12641e-01_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.36620e-01_r8,0.32046e-01_r8,0.27465e-01_r8,0.22887e-01_r8,0.18309e-01_r8, & + & 0.13731e-01_r8,0.91527e-02_r8,0.75684e-02_r8,0.12457e-01_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.44232e-01_r8,0.38700e-01_r8,0.33173e-01_r8,0.27644e-01_r8,0.22114e-01_r8, & + & 0.16581e-01_r8,0.11054e-01_r8,0.91028e-02_r8,0.15510e-01_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.43957e-01_r8,0.38463e-01_r8,0.32969e-01_r8,0.27474e-01_r8,0.21977e-01_r8, & + & 0.16483e-01_r8,0.10987e-01_r8,0.90298e-02_r8,0.15354e-01_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.43680e-01_r8,0.38217e-01_r8,0.32756e-01_r8,0.27297e-01_r8,0.21838e-01_r8, & + & 0.16376e-01_r8,0.10918e-01_r8,0.89896e-02_r8,0.15195e-01_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.43409e-01_r8,0.37982e-01_r8,0.32556e-01_r8,0.27128e-01_r8,0.21703e-01_r8, & + & 0.16277e-01_r8,0.10849e-01_r8,0.90630e-02_r8,0.15090e-01_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.43148e-01_r8,0.37757e-01_r8,0.32362e-01_r8,0.26967e-01_r8,0.21574e-01_r8, & + & 0.16179e-01_r8,0.10784e-01_r8,0.89323e-02_r8,0.14861e-01_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.52173e-01_r8,0.45650e-01_r8,0.39129e-01_r8,0.32609e-01_r8,0.26084e-01_r8, & + & 0.19564e-01_r8,0.13063e-01_r8,0.10928e-01_r8,0.18665e-01_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.51767e-01_r8,0.45298e-01_r8,0.38824e-01_r8,0.32358e-01_r8,0.25882e-01_r8, & + & 0.19411e-01_r8,0.12948e-01_r8,0.10795e-01_r8,0.18386e-01_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.51358e-01_r8,0.44935e-01_r8,0.38514e-01_r8,0.32093e-01_r8,0.25677e-01_r8, & + & 0.19255e-01_r8,0.12843e-01_r8,0.10694e-01_r8,0.18120e-01_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.50955e-01_r8,0.44587e-01_r8,0.38218e-01_r8,0.31847e-01_r8,0.25475e-01_r8, & + & 0.19107e-01_r8,0.12737e-01_r8,0.10607e-01_r8,0.17851e-01_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.50544e-01_r8,0.44227e-01_r8,0.37909e-01_r8,0.31588e-01_r8,0.25270e-01_r8, & + & 0.18952e-01_r8,0.12634e-01_r8,0.10599e-01_r8,0.17618e-01_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.61214e-01_r8,0.53565e-01_r8,0.45917e-01_r8,0.38262e-01_r8,0.30607e-01_r8, & + & 0.22954e-01_r8,0.15462e-01_r8,0.13125e-01_r8,0.22278e-01_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.60651e-01_r8,0.53068e-01_r8,0.45484e-01_r8,0.37903e-01_r8,0.30322e-01_r8, & + & 0.22741e-01_r8,0.15244e-01_r8,0.12927e-01_r8,0.21870e-01_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.60040e-01_r8,0.52533e-01_r8,0.45028e-01_r8,0.37524e-01_r8,0.30019e-01_r8, & + & 0.22514e-01_r8,0.15074e-01_r8,0.12758e-01_r8,0.21465e-01_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.59437e-01_r8,0.52006e-01_r8,0.44573e-01_r8,0.37145e-01_r8,0.29715e-01_r8, & + & 0.22286e-01_r8,0.14911e-01_r8,0.12602e-01_r8,0.21062e-01_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.58809e-01_r8,0.51461e-01_r8,0.44106e-01_r8,0.36755e-01_r8,0.29405e-01_r8, & + & 0.22053e-01_r8,0.14746e-01_r8,0.12499e-01_r8,0.20685e-01_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.71375e-01_r8,0.62451e-01_r8,0.53529e-01_r8,0.44607e-01_r8,0.35687e-01_r8, & + & 0.26759e-01_r8,0.18273e-01_r8,0.15758e-01_r8,0.26378e-01_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.70571e-01_r8,0.61748e-01_r8,0.52933e-01_r8,0.44107e-01_r8,0.35285e-01_r8, & + & 0.26462e-01_r8,0.17959e-01_r8,0.15470e-01_r8,0.25822e-01_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.69734e-01_r8,0.61022e-01_r8,0.52301e-01_r8,0.43583e-01_r8,0.34867e-01_r8, & + & 0.26147e-01_r8,0.17660e-01_r8,0.15207e-01_r8,0.25265e-01_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.68870e-01_r8,0.60256e-01_r8,0.51654e-01_r8,0.43043e-01_r8,0.34432e-01_r8, & + & 0.25826e-01_r8,0.17391e-01_r8,0.14968e-01_r8,0.24710e-01_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.67988e-01_r8,0.59482e-01_r8,0.50988e-01_r8,0.42488e-01_r8,0.33987e-01_r8, & + & 0.25491e-01_r8,0.17159e-01_r8,0.14740e-01_r8,0.24148e-01_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.82705e-01_r8,0.72369e-01_r8,0.62031e-01_r8,0.51694e-01_r8,0.41353e-01_r8, & + & 0.31012e-01_r8,0.21511e-01_r8,0.18843e-01_r8,0.31008e-01_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.81487e-01_r8,0.71304e-01_r8,0.61113e-01_r8,0.50924e-01_r8,0.40740e-01_r8, & + & 0.30554e-01_r8,0.21074e-01_r8,0.18457e-01_r8,0.30235e-01_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.80318e-01_r8,0.70281e-01_r8,0.60235e-01_r8,0.50200e-01_r8,0.40157e-01_r8, & + & 0.30117e-01_r8,0.20636e-01_r8,0.18102e-01_r8,0.29494e-01_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.79154e-01_r8,0.69255e-01_r8,0.59365e-01_r8,0.49470e-01_r8,0.39576e-01_r8, & + & 0.29680e-01_r8,0.20228e-01_r8,0.17748e-01_r8,0.28759e-01_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.77937e-01_r8,0.68190e-01_r8,0.58450e-01_r8,0.48707e-01_r8,0.38965e-01_r8, & + & 0.29223e-01_r8,0.19858e-01_r8,0.17406e-01_r8,0.28017e-01_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.95173e-01_r8,0.83270e-01_r8,0.71377e-01_r8,0.59480e-01_r8,0.47582e-01_r8, & + & 0.35684e-01_r8,0.25169e-01_r8,0.22449e-01_r8,0.36274e-01_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.93409e-01_r8,0.81740e-01_r8,0.70058e-01_r8,0.58384e-01_r8,0.46709e-01_r8, & + & 0.35028e-01_r8,0.24581e-01_r8,0.21893e-01_r8,0.35207e-01_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.91737e-01_r8,0.80263e-01_r8,0.68796e-01_r8,0.57330e-01_r8,0.45863e-01_r8, & + & 0.34396e-01_r8,0.23987e-01_r8,0.21409e-01_r8,0.34174e-01_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.90113e-01_r8,0.78852e-01_r8,0.67585e-01_r8,0.56324e-01_r8,0.45060e-01_r8, & + & 0.33794e-01_r8,0.23415e-01_r8,0.20940e-01_r8,0.33185e-01_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.88500e-01_r8,0.77445e-01_r8,0.66378e-01_r8,0.55317e-01_r8,0.44252e-01_r8, & + & 0.33190e-01_r8,0.22890e-01_r8,0.20471e-01_r8,0.32236e-01_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.10878e+00_r8,0.95186e-01_r8,0.81587e-01_r8,0.67986e-01_r8,0.54386e-01_r8, & + & 0.40792e-01_r8,0.29314e-01_r8,0.26669e-01_r8,0.42265e-01_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.10631e+00_r8,0.93021e-01_r8,0.79732e-01_r8,0.66444e-01_r8,0.53150e-01_r8, & + & 0.39864e-01_r8,0.28508e-01_r8,0.25873e-01_r8,0.40792e-01_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.10400e+00_r8,0.91002e-01_r8,0.78003e-01_r8,0.64997e-01_r8,0.51997e-01_r8, & + & 0.39001e-01_r8,0.27707e-01_r8,0.25186e-01_r8,0.39383e-01_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.10173e+00_r8,0.89018e-01_r8,0.76292e-01_r8,0.63582e-01_r8,0.50863e-01_r8, & + & 0.38144e-01_r8,0.26926e-01_r8,0.24532e-01_r8,0.38084e-01_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.99555e-01_r8,0.87113e-01_r8,0.74666e-01_r8,0.62221e-01_r8,0.49774e-01_r8, & + & 0.37334e-01_r8,0.26211e-01_r8,0.23902e-01_r8,0.36825e-01_r8 /) + kao(:, 1,10,16) = (/ & + & 0.12320e+00_r8,0.10779e+00_r8,0.92400e-01_r8,0.76993e-01_r8,0.61601e-01_r8, & + & 0.46197e-01_r8,0.33879e-01_r8,0.31475e-01_r8,0.48792e-01_r8 /) + kao(:, 2,10,16) = (/ & + & 0.11986e+00_r8,0.10487e+00_r8,0.89890e-01_r8,0.74910e-01_r8,0.59927e-01_r8, & + & 0.44946e-01_r8,0.32786e-01_r8,0.30373e-01_r8,0.46838e-01_r8 /) + kao(:, 3,10,16) = (/ & + & 0.11671e+00_r8,0.10212e+00_r8,0.87531e-01_r8,0.72938e-01_r8,0.58350e-01_r8, & + & 0.43767e-01_r8,0.31728e-01_r8,0.29415e-01_r8,0.45011e-01_r8 /) + kao(:, 4,10,16) = (/ & + & 0.11373e+00_r8,0.99514e-01_r8,0.85291e-01_r8,0.71084e-01_r8,0.56859e-01_r8, & + & 0.42648e-01_r8,0.30712e-01_r8,0.28518e-01_r8,0.43306e-01_r8 /) + kao(:, 5,10,16) = (/ & + & 0.11086e+00_r8,0.97005e-01_r8,0.83130e-01_r8,0.69287e-01_r8,0.55428e-01_r8, & + & 0.41573e-01_r8,0.29748e-01_r8,0.27669e-01_r8,0.41673e-01_r8 /) + kao(:, 1,11,16) = (/ & + & 0.13635e+00_r8,0.11930e+00_r8,0.10226e+00_r8,0.85213e-01_r8,0.68170e-01_r8, & + & 0.51126e-01_r8,0.38257e-01_r8,0.36212e-01_r8,0.54706e-01_r8 /) + kao(:, 2,11,16) = (/ & + & 0.13203e+00_r8,0.11554e+00_r8,0.99030e-01_r8,0.82523e-01_r8,0.66019e-01_r8, & + & 0.49513e-01_r8,0.36799e-01_r8,0.34833e-01_r8,0.52312e-01_r8 /) + kao(:, 3,11,16) = (/ & + & 0.12805e+00_r8,0.11203e+00_r8,0.96022e-01_r8,0.80023e-01_r8,0.64019e-01_r8, & + & 0.48015e-01_r8,0.35435e-01_r8,0.33591e-01_r8,0.50057e-01_r8 /) + kao(:, 4,11,16) = (/ & + & 0.12432e+00_r8,0.10877e+00_r8,0.93237e-01_r8,0.77695e-01_r8,0.62158e-01_r8, & + & 0.46618e-01_r8,0.34181e-01_r8,0.32427e-01_r8,0.47918e-01_r8 /) + kao(:, 5,11,16) = (/ & + & 0.12077e+00_r8,0.10567e+00_r8,0.90572e-01_r8,0.75471e-01_r8,0.60381e-01_r8, & + & 0.45284e-01_r8,0.32973e-01_r8,0.31331e-01_r8,0.45895e-01_r8 /) + kao(:, 1,12,16) = (/ & + & 0.14909e+00_r8,0.13045e+00_r8,0.11182e+00_r8,0.93176e-01_r8,0.74537e-01_r8, & + & 0.55927e-01_r8,0.42736e-01_r8,0.41194e-01_r8,0.43864e-01_r8 /) + kao(:, 2,12,16) = (/ & + & 0.14380e+00_r8,0.12582e+00_r8,0.10785e+00_r8,0.89883e-01_r8,0.71900e-01_r8, & + & 0.53925e-01_r8,0.40874e-01_r8,0.39509e-01_r8,0.34410e-01_r8 /) + kao(:, 3,12,16) = (/ & + & 0.13887e+00_r8,0.12152e+00_r8,0.10414e+00_r8,0.86796e-01_r8,0.69431e-01_r8, & + & 0.52073e-01_r8,0.39165e-01_r8,0.37950e-01_r8,0.27228e-01_r8 /) + kao(:, 4,12,16) = (/ & + & 0.13436e+00_r8,0.11758e+00_r8,0.10078e+00_r8,0.83978e-01_r8,0.67186e-01_r8, & + & 0.50383e-01_r8,0.37599e-01_r8,0.36473e-01_r8,0.23165e-01_r8 /) + kao(:, 5,12,16) = (/ & + & 0.13007e+00_r8,0.11382e+00_r8,0.97560e-01_r8,0.81293e-01_r8,0.65042e-01_r8, & + & 0.48775e-01_r8,0.36131e-01_r8,0.35083e-01_r8,0.14412e-01_r8 /) + kao(:, 1,13,16) = (/ & + & 0.16113e+00_r8,0.14100e+00_r8,0.12085e+00_r8,0.10071e+00_r8,0.80563e-01_r8, & + & 0.60580e-01_r8,0.47246e-01_r8,0.46365e-01_r8,0.26456e-01_r8 /) + kao(:, 2,13,16) = (/ & + & 0.15486e+00_r8,0.13550e+00_r8,0.11616e+00_r8,0.96791e-01_r8,0.77431e-01_r8, & + & 0.58082e-01_r8,0.44915e-01_r8,0.44314e-01_r8,0.19340e-01_r8 /) + kao(:, 3,13,16) = (/ & + & 0.14906e+00_r8,0.13042e+00_r8,0.11179e+00_r8,0.93156e-01_r8,0.74526e-01_r8, & + & 0.55893e-01_r8,0.42831e-01_r8,0.42380e-01_r8,0.11993e-01_r8 /) + kao(:, 4,13,16) = (/ & + & 0.14369e+00_r8,0.12574e+00_r8,0.10777e+00_r8,0.89817e-01_r8,0.71849e-01_r8, & + & 0.53884e-01_r8,0.40915e-01_r8,0.40556e-01_r8,0.50486e-02_r8 /) + kao(:, 5,13,16) = (/ & + & 0.13868e+00_r8,0.12134e+00_r8,0.10400e+00_r8,0.86669e-01_r8,0.69338e-01_r8, & + & 0.52006e-01_r8,0.39136e-01_r8,0.38851e-01_r8,0.00000e+00_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.12158e-08_r8,0.13238e-08_r8,0.15146e-08_r8,0.16862e-08_r8,0.18609e-08_r8 /) + kbo(:,14, 1) = (/ & + & 0.16931e-08_r8,0.20047e-08_r8,0.23006e-08_r8,0.25636e-08_r8,0.28912e-08_r8 /) + kbo(:,15, 1) = (/ & + & 0.31521e-08_r8,0.36963e-08_r8,0.41550e-08_r8,0.46365e-08_r8,0.50834e-08_r8 /) + kbo(:,16, 1) = (/ & + & 0.46152e-08_r8,0.50173e-08_r8,0.55381e-08_r8,0.60748e-08_r8,0.66355e-08_r8 /) + kbo(:,17, 1) = (/ & + & 0.62662e-08_r8,0.67518e-08_r8,0.71765e-08_r8,0.80302e-08_r8,0.89056e-08_r8 /) + kbo(:,18, 1) = (/ & + & 0.81764e-08_r8,0.91818e-08_r8,0.10385e-07_r8,0.11708e-07_r8,0.12536e-07_r8 /) + kbo(:,19, 1) = (/ & + & 0.12946e-07_r8,0.13631e-07_r8,0.14453e-07_r8,0.15133e-07_r8,0.15911e-07_r8 /) + kbo(:,20, 1) = (/ & + & 0.15868e-07_r8,0.16654e-07_r8,0.17281e-07_r8,0.17857e-07_r8,0.18383e-07_r8 /) + kbo(:,21, 1) = (/ & + & 0.18151e-07_r8,0.19056e-07_r8,0.20057e-07_r8,0.20708e-07_r8,0.21229e-07_r8 /) + kbo(:,22, 1) = (/ & + & 0.20234e-07_r8,0.21482e-07_r8,0.22599e-07_r8,0.23778e-07_r8,0.25115e-07_r8 /) + kbo(:,23, 1) = (/ & + & 0.23827e-07_r8,0.25405e-07_r8,0.26545e-07_r8,0.27716e-07_r8,0.28422e-07_r8 /) + kbo(:,24, 1) = (/ & + & 0.27638e-07_r8,0.28518e-07_r8,0.29101e-07_r8,0.29639e-07_r8,0.30077e-07_r8 /) + kbo(:,25, 1) = (/ & + & 0.28942e-07_r8,0.29436e-07_r8,0.29831e-07_r8,0.30066e-07_r8,0.30242e-07_r8 /) + kbo(:,26, 1) = (/ & + & 0.28774e-07_r8,0.29004e-07_r8,0.29272e-07_r8,0.29431e-07_r8,0.29616e-07_r8 /) + kbo(:,27, 1) = (/ & + & 0.27317e-07_r8,0.27462e-07_r8,0.27698e-07_r8,0.27835e-07_r8,0.27843e-07_r8 /) + kbo(:,28, 1) = (/ & + & 0.25463e-07_r8,0.25523e-07_r8,0.25678e-07_r8,0.25658e-07_r8,0.25687e-07_r8 /) + kbo(:,29, 1) = (/ & + & 0.22603e-07_r8,0.22672e-07_r8,0.22704e-07_r8,0.22668e-07_r8,0.22698e-07_r8 /) + kbo(:,30, 1) = (/ & + & 0.19657e-07_r8,0.19747e-07_r8,0.19687e-07_r8,0.19659e-07_r8,0.19680e-07_r8 /) + kbo(:,31, 1) = (/ & + & 0.16553e-07_r8,0.16571e-07_r8,0.16522e-07_r8,0.16545e-07_r8,0.16563e-07_r8 /) + kbo(:,32, 1) = (/ & + & 0.13867e-07_r8,0.13795e-07_r8,0.13808e-07_r8,0.13815e-07_r8,0.13799e-07_r8 /) + kbo(:,33, 1) = (/ & + & 0.11414e-07_r8,0.11409e-07_r8,0.11395e-07_r8,0.11384e-07_r8,0.11416e-07_r8 /) + kbo(:,34, 1) = (/ & + & 0.95639e-08_r8,0.95514e-08_r8,0.95251e-08_r8,0.95607e-08_r8,0.95767e-08_r8 /) + kbo(:,35, 1) = (/ & + & 0.80018e-08_r8,0.79882e-08_r8,0.79720e-08_r8,0.79934e-08_r8,0.79942e-08_r8 /) + kbo(:,36, 1) = (/ & + & 0.67279e-08_r8,0.67135e-08_r8,0.67089e-08_r8,0.67131e-08_r8,0.67290e-08_r8 /) + kbo(:,37, 1) = (/ & + & 0.57292e-08_r8,0.57278e-08_r8,0.57247e-08_r8,0.57298e-08_r8,0.57269e-08_r8 /) + kbo(:,38, 1) = (/ & + & 0.48406e-08_r8,0.48461e-08_r8,0.48394e-08_r8,0.48468e-08_r8,0.48401e-08_r8 /) + kbo(:,39, 1) = (/ & + & 0.40368e-08_r8,0.40419e-08_r8,0.40353e-08_r8,0.40432e-08_r8,0.40267e-08_r8 /) + kbo(:,40, 1) = (/ & + & 0.34875e-08_r8,0.34931e-08_r8,0.34872e-08_r8,0.34940e-08_r8,0.34782e-08_r8 /) + kbo(:,41, 1) = (/ & + & 0.30195e-08_r8,0.30243e-08_r8,0.30129e-08_r8,0.30148e-08_r8,0.30016e-08_r8 /) + kbo(:,42, 1) = (/ & + & 0.25993e-08_r8,0.25924e-08_r8,0.25861e-08_r8,0.25841e-08_r8,0.25734e-08_r8 /) + kbo(:,43, 1) = (/ & + & 0.22290e-08_r8,0.22166e-08_r8,0.22080e-08_r8,0.22067e-08_r8,0.21992e-08_r8 /) + kbo(:,44, 1) = (/ & + & 0.18916e-08_r8,0.18847e-08_r8,0.18733e-08_r8,0.18685e-08_r8,0.18685e-08_r8 /) + kbo(:,45, 1) = (/ & + & 0.15840e-08_r8,0.15787e-08_r8,0.15719e-08_r8,0.15641e-08_r8,0.15644e-08_r8 /) + kbo(:,46, 1) = (/ & + & 0.13197e-08_r8,0.13138e-08_r8,0.13098e-08_r8,0.13024e-08_r8,0.13049e-08_r8 /) + kbo(:,47, 1) = (/ & + & 0.11052e-08_r8,0.11003e-08_r8,0.10954e-08_r8,0.10927e-08_r8,0.10941e-08_r8 /) + kbo(:,48, 1) = (/ & + & 0.91115e-09_r8,0.90837e-09_r8,0.90520e-09_r8,0.90009e-09_r8,0.90047e-09_r8 /) + kbo(:,49, 1) = (/ & + & 0.73101e-09_r8,0.73246e-09_r8,0.73006e-09_r8,0.72687e-09_r8,0.72508e-09_r8 /) + kbo(:,50, 1) = (/ & + & 0.60565e-09_r8,0.60526e-09_r8,0.60121e-09_r8,0.60117e-09_r8,0.60056e-09_r8 /) + kbo(:,51, 1) = (/ & + & 0.50736e-09_r8,0.50750e-09_r8,0.50421e-09_r8,0.50378e-09_r8,0.50259e-09_r8 /) + kbo(:,52, 1) = (/ & + & 0.41843e-09_r8,0.41856e-09_r8,0.41499e-09_r8,0.41535e-09_r8,0.41353e-09_r8 /) + kbo(:,53, 1) = (/ & + & 0.33766e-09_r8,0.33794e-09_r8,0.33511e-09_r8,0.33405e-09_r8,0.33405e-09_r8 /) + kbo(:,54, 1) = (/ & + & 0.29473e-09_r8,0.29448e-09_r8,0.29284e-09_r8,0.29146e-09_r8,0.29053e-09_r8 /) + kbo(:,55, 1) = (/ & + & 0.26948e-09_r8,0.27034e-09_r8,0.27016e-09_r8,0.26799e-09_r8,0.26580e-09_r8 /) + kbo(:,56, 1) = (/ & + & 0.24773e-09_r8,0.24784e-09_r8,0.24734e-09_r8,0.24436e-09_r8,0.24377e-09_r8 /) + kbo(:,57, 1) = (/ & + & 0.22707e-09_r8,0.22765e-09_r8,0.22683e-09_r8,0.22503e-09_r8,0.22447e-09_r8 /) + kbo(:,58, 1) = (/ & + & 0.21180e-09_r8,0.21264e-09_r8,0.21254e-09_r8,0.21338e-09_r8,0.21089e-09_r8 /) + kbo(:,59, 1) = (/ & + & 0.22898e-09_r8,0.23089e-09_r8,0.23471e-09_r8,0.23606e-09_r8,0.23388e-09_r8 /) + kbo(:,13, 2) = (/ & + & 0.18001e-08_r8,0.19945e-08_r8,0.21612e-08_r8,0.23316e-08_r8,0.25983e-08_r8 /) + kbo(:,14, 2) = (/ & + & 0.39853e-08_r8,0.42632e-08_r8,0.44602e-08_r8,0.46784e-08_r8,0.48071e-08_r8 /) + kbo(:,15, 2) = (/ & + & 0.60848e-08_r8,0.61494e-08_r8,0.61069e-08_r8,0.61295e-08_r8,0.65707e-08_r8 /) + kbo(:,16, 2) = (/ & + & 0.75494e-08_r8,0.85999e-08_r8,0.91057e-08_r8,0.10175e-07_r8,0.10943e-07_r8 /) + kbo(:,17, 2) = (/ & + & 0.12037e-07_r8,0.12753e-07_r8,0.13314e-07_r8,0.13239e-07_r8,0.13306e-07_r8 /) + kbo(:,18, 2) = (/ & + & 0.15519e-07_r8,0.15517e-07_r8,0.15097e-07_r8,0.14435e-07_r8,0.13983e-07_r8 /) + kbo(:,19, 2) = (/ & + & 0.16420e-07_r8,0.17025e-07_r8,0.17639e-07_r8,0.17633e-07_r8,0.17513e-07_r8 /) + kbo(:,20, 2) = (/ & + & 0.18021e-07_r8,0.19301e-07_r8,0.20621e-07_r8,0.22238e-07_r8,0.23351e-07_r8 /) + kbo(:,21, 2) = (/ & + & 0.22378e-07_r8,0.23582e-07_r8,0.24409e-07_r8,0.24915e-07_r8,0.25516e-07_r8 /) + kbo(:,22, 2) = (/ & + & 0.24712e-07_r8,0.24864e-07_r8,0.24556e-07_r8,0.23953e-07_r8,0.23424e-07_r8 /) + kbo(:,23, 2) = (/ & + & 0.22545e-07_r8,0.22002e-07_r8,0.21325e-07_r8,0.20492e-07_r8,0.20022e-07_r8 /) + kbo(:,24, 2) = (/ & + & 0.18798e-07_r8,0.18566e-07_r8,0.18366e-07_r8,0.18099e-07_r8,0.17971e-07_r8 /) + kbo(:,25, 2) = (/ & + & 0.16773e-07_r8,0.16803e-07_r8,0.16541e-07_r8,0.16450e-07_r8,0.16482e-07_r8 /) + kbo(:,26, 2) = (/ & + & 0.15222e-07_r8,0.15398e-07_r8,0.15177e-07_r8,0.15147e-07_r8,0.14951e-07_r8 /) + kbo(:,27, 2) = (/ & + & 0.13792e-07_r8,0.13944e-07_r8,0.13534e-07_r8,0.13546e-07_r8,0.13516e-07_r8 /) + kbo(:,28, 2) = (/ & + & 0.12157e-07_r8,0.12221e-07_r8,0.11930e-07_r8,0.12115e-07_r8,0.12027e-07_r8 /) + kbo(:,29, 2) = (/ & + & 0.10487e-07_r8,0.10393e-07_r8,0.10366e-07_r8,0.10455e-07_r8,0.10269e-07_r8 /) + kbo(:,30, 2) = (/ & + & 0.90084e-08_r8,0.88590e-08_r8,0.90055e-08_r8,0.88655e-08_r8,0.87392e-08_r8 /) + kbo(:,31, 2) = (/ & + & 0.74765e-08_r8,0.74889e-08_r8,0.73915e-08_r8,0.73289e-08_r8,0.72219e-08_r8 /) + kbo(:,32, 2) = (/ & + & 0.62311e-08_r8,0.62461e-08_r8,0.61378e-08_r8,0.59795e-08_r8,0.60309e-08_r8 /) + kbo(:,33, 2) = (/ & + & 0.51421e-08_r8,0.50519e-08_r8,0.50031e-08_r8,0.49630e-08_r8,0.49489e-08_r8 /) + kbo(:,34, 2) = (/ & + & 0.42880e-08_r8,0.42042e-08_r8,0.41366e-08_r8,0.41198e-08_r8,0.41265e-08_r8 /) + kbo(:,35, 2) = (/ & + & 0.35718e-08_r8,0.34728e-08_r8,0.34599e-08_r8,0.34385e-08_r8,0.34695e-08_r8 /) + kbo(:,36, 2) = (/ & + & 0.29713e-08_r8,0.29023e-08_r8,0.28707e-08_r8,0.28790e-08_r8,0.28873e-08_r8 /) + kbo(:,37, 2) = (/ & + & 0.25246e-08_r8,0.24463e-08_r8,0.24323e-08_r8,0.24308e-08_r8,0.24753e-08_r8 /) + kbo(:,38, 2) = (/ & + & 0.21159e-08_r8,0.20527e-08_r8,0.20532e-08_r8,0.20325e-08_r8,0.20615e-08_r8 /) + kbo(:,39, 2) = (/ & + & 0.17631e-08_r8,0.17097e-08_r8,0.17043e-08_r8,0.16987e-08_r8,0.17298e-08_r8 /) + kbo(:,40, 2) = (/ & + & 0.15260e-08_r8,0.14757e-08_r8,0.14566e-08_r8,0.14513e-08_r8,0.14651e-08_r8 /) + kbo(:,41, 2) = (/ & + & 0.13009e-08_r8,0.12457e-08_r8,0.12523e-08_r8,0.12490e-08_r8,0.12671e-08_r8 /) + kbo(:,42, 2) = (/ & + & 0.10990e-08_r8,0.10789e-08_r8,0.10741e-08_r8,0.10762e-08_r8,0.10873e-08_r8 /) + kbo(:,43, 2) = (/ & + & 0.94313e-09_r8,0.92236e-09_r8,0.92369e-09_r8,0.91495e-09_r8,0.92405e-09_r8 /) + kbo(:,44, 2) = (/ & + & 0.80746e-09_r8,0.78453e-09_r8,0.77646e-09_r8,0.77477e-09_r8,0.77888e-09_r8 /) + kbo(:,45, 2) = (/ & + & 0.67944e-09_r8,0.66381e-09_r8,0.65747e-09_r8,0.65286e-09_r8,0.65668e-09_r8 /) + kbo(:,46, 2) = (/ & + & 0.56677e-09_r8,0.55682e-09_r8,0.54825e-09_r8,0.54623e-09_r8,0.54843e-09_r8 /) + kbo(:,47, 2) = (/ & + & 0.47375e-09_r8,0.47120e-09_r8,0.45836e-09_r8,0.45709e-09_r8,0.45689e-09_r8 /) + kbo(:,48, 2) = (/ & + & 0.39797e-09_r8,0.39204e-09_r8,0.37735e-09_r8,0.37505e-09_r8,0.37687e-09_r8 /) + kbo(:,49, 2) = (/ & + & 0.32772e-09_r8,0.31857e-09_r8,0.30808e-09_r8,0.30232e-09_r8,0.30140e-09_r8 /) + kbo(:,50, 2) = (/ & + & 0.27300e-09_r8,0.26581e-09_r8,0.26125e-09_r8,0.24922e-09_r8,0.25029e-09_r8 /) + kbo(:,51, 2) = (/ & + & 0.23073e-09_r8,0.22159e-09_r8,0.21979e-09_r8,0.20969e-09_r8,0.21117e-09_r8 /) + kbo(:,52, 2) = (/ & + & 0.18868e-09_r8,0.18466e-09_r8,0.18517e-09_r8,0.17470e-09_r8,0.17469e-09_r8 /) + kbo(:,53, 2) = (/ & + & 0.15290e-09_r8,0.14970e-09_r8,0.15032e-09_r8,0.14201e-09_r8,0.14053e-09_r8 /) + kbo(:,54, 2) = (/ & + & 0.13616e-09_r8,0.13340e-09_r8,0.13256e-09_r8,0.12713e-09_r8,0.12621e-09_r8 /) + kbo(:,55, 2) = (/ & + & 0.12605e-09_r8,0.12524e-09_r8,0.12106e-09_r8,0.11994e-09_r8,0.11735e-09_r8 /) + kbo(:,56, 2) = (/ & + & 0.11625e-09_r8,0.11350e-09_r8,0.11287e-09_r8,0.11534e-09_r8,0.10942e-09_r8 /) + kbo(:,57, 2) = (/ & + & 0.10168e-09_r8,0.10628e-09_r8,0.10684e-09_r8,0.10799e-09_r8,0.10313e-09_r8 /) + kbo(:,58, 2) = (/ & + & 0.92659e-10_r8,0.10050e-09_r8,0.10168e-09_r8,0.97877e-10_r8,0.97971e-10_r8 /) + kbo(:,59, 2) = (/ & + & 0.10198e-09_r8,0.11632e-09_r8,0.11127e-09_r8,0.10947e-09_r8,0.11000e-09_r8 /) + kbo(:,13, 3) = (/ & + & 0.33788e-08_r8,0.38685e-08_r8,0.40059e-08_r8,0.41301e-08_r8,0.43316e-08_r8 /) + kbo(:,14, 3) = (/ & + & 0.54022e-08_r8,0.55644e-08_r8,0.55814e-08_r8,0.55195e-08_r8,0.57708e-08_r8 /) + kbo(:,15, 3) = (/ & + & 0.95769e-08_r8,0.10205e-07_r8,0.12445e-07_r8,0.13419e-07_r8,0.13357e-07_r8 /) + kbo(:,16, 3) = (/ & + & 0.17233e-07_r8,0.16177e-07_r8,0.16092e-07_r8,0.15590e-07_r8,0.15068e-07_r8 /) + kbo(:,17, 3) = (/ & + & 0.19731e-07_r8,0.19947e-07_r8,0.20278e-07_r8,0.20235e-07_r8,0.20699e-07_r8 /) + kbo(:,18, 3) = (/ & + & 0.23168e-07_r8,0.23970e-07_r8,0.25507e-07_r8,0.27034e-07_r8,0.29135e-07_r8 /) + kbo(:,19, 3) = (/ & + & 0.33749e-07_r8,0.35374e-07_r8,0.37333e-07_r8,0.38730e-07_r8,0.39816e-07_r8 /) + kbo(:,20, 3) = (/ & + & 0.39844e-07_r8,0.39698e-07_r8,0.39651e-07_r8,0.38618e-07_r8,0.37699e-07_r8 /) + kbo(:,21, 3) = (/ & + & 0.37013e-07_r8,0.35923e-07_r8,0.35560e-07_r8,0.35217e-07_r8,0.34594e-07_r8 /) + kbo(:,22, 3) = (/ & + & 0.32381e-07_r8,0.31844e-07_r8,0.32272e-07_r8,0.32430e-07_r8,0.31922e-07_r8 /) + kbo(:,23, 3) = (/ & + & 0.29924e-07_r8,0.29834e-07_r8,0.30537e-07_r8,0.30494e-07_r8,0.30313e-07_r8 /) + kbo(:,24, 3) = (/ & + & 0.27849e-07_r8,0.28147e-07_r8,0.29005e-07_r8,0.29081e-07_r8,0.28673e-07_r8 /) + kbo(:,25, 3) = (/ & + & 0.25534e-07_r8,0.25854e-07_r8,0.26978e-07_r8,0.27173e-07_r8,0.27116e-07_r8 /) + kbo(:,26, 3) = (/ & + & 0.23413e-07_r8,0.24124e-07_r8,0.25341e-07_r8,0.25322e-07_r8,0.25266e-07_r8 /) + kbo(:,27, 3) = (/ & + & 0.21218e-07_r8,0.22105e-07_r8,0.23470e-07_r8,0.23280e-07_r8,0.23250e-07_r8 /) + kbo(:,28, 3) = (/ & + & 0.19002e-07_r8,0.20309e-07_r8,0.21106e-07_r8,0.20908e-07_r8,0.21199e-07_r8 /) + kbo(:,29, 3) = (/ & + & 0.16901e-07_r8,0.18244e-07_r8,0.18426e-07_r8,0.18398e-07_r8,0.18708e-07_r8 /) + kbo(:,30, 3) = (/ & + & 0.15065e-07_r8,0.15814e-07_r8,0.15711e-07_r8,0.16012e-07_r8,0.16145e-07_r8 /) + kbo(:,31, 3) = (/ & + & 0.13100e-07_r8,0.13194e-07_r8,0.13385e-07_r8,0.13455e-07_r8,0.13435e-07_r8 /) + kbo(:,32, 3) = (/ & + & 0.10972e-07_r8,0.10986e-07_r8,0.11085e-07_r8,0.11182e-07_r8,0.11030e-07_r8 /) + kbo(:,33, 3) = (/ & + & 0.90750e-08_r8,0.90832e-08_r8,0.91769e-08_r8,0.89877e-08_r8,0.89513e-08_r8 /) + kbo(:,34, 3) = (/ & + & 0.75008e-08_r8,0.76569e-08_r8,0.76237e-08_r8,0.74547e-08_r8,0.74719e-08_r8 /) + kbo(:,35, 3) = (/ & + & 0.63063e-08_r8,0.64050e-08_r8,0.62067e-08_r8,0.61836e-08_r8,0.61775e-08_r8 /) + kbo(:,36, 3) = (/ & + & 0.53250e-08_r8,0.52712e-08_r8,0.52454e-08_r8,0.51153e-08_r8,0.51657e-08_r8 /) + kbo(:,37, 3) = (/ & + & 0.45450e-08_r8,0.45358e-08_r8,0.44274e-08_r8,0.43893e-08_r8,0.43616e-08_r8 /) + kbo(:,38, 3) = (/ & + & 0.38039e-08_r8,0.38254e-08_r8,0.37172e-08_r8,0.37203e-08_r8,0.37278e-08_r8 /) + kbo(:,39, 3) = (/ & + & 0.31821e-08_r8,0.31632e-08_r8,0.30774e-08_r8,0.30626e-08_r8,0.30979e-08_r8 /) + kbo(:,40, 3) = (/ & + & 0.27339e-08_r8,0.27443e-08_r8,0.26754e-08_r8,0.26505e-08_r8,0.27022e-08_r8 /) + kbo(:,41, 3) = (/ & + & 0.23939e-08_r8,0.24228e-08_r8,0.23415e-08_r8,0.23287e-08_r8,0.23327e-08_r8 /) + kbo(:,42, 3) = (/ & + & 0.20895e-08_r8,0.20874e-08_r8,0.20298e-08_r8,0.20180e-08_r8,0.19876e-08_r8 /) + kbo(:,43, 3) = (/ & + & 0.17869e-08_r8,0.17800e-08_r8,0.17392e-08_r8,0.17376e-08_r8,0.16927e-08_r8 /) + kbo(:,44, 3) = (/ & + & 0.15169e-08_r8,0.15335e-08_r8,0.14778e-08_r8,0.14668e-08_r8,0.14407e-08_r8 /) + kbo(:,45, 3) = (/ & + & 0.12692e-08_r8,0.12902e-08_r8,0.12439e-08_r8,0.12324e-08_r8,0.11996e-08_r8 /) + kbo(:,46, 3) = (/ & + & 0.10611e-08_r8,0.10656e-08_r8,0.10472e-08_r8,0.10282e-08_r8,0.10015e-08_r8 /) + kbo(:,47, 3) = (/ & + & 0.90394e-09_r8,0.88143e-09_r8,0.87958e-09_r8,0.84984e-09_r8,0.85121e-09_r8 /) + kbo(:,48, 3) = (/ & + & 0.73451e-09_r8,0.71978e-09_r8,0.73014e-09_r8,0.70436e-09_r8,0.69840e-09_r8 /) + kbo(:,49, 3) = (/ & + & 0.58678e-09_r8,0.58259e-09_r8,0.58316e-09_r8,0.55960e-09_r8,0.56079e-09_r8 /) + kbo(:,50, 3) = (/ & + & 0.48502e-09_r8,0.47984e-09_r8,0.48693e-09_r8,0.47265e-09_r8,0.46016e-09_r8 /) + kbo(:,51, 3) = (/ & + & 0.40704e-09_r8,0.40367e-09_r8,0.41046e-09_r8,0.39764e-09_r8,0.38714e-09_r8 /) + kbo(:,52, 3) = (/ & + & 0.33771e-09_r8,0.33070e-09_r8,0.32984e-09_r8,0.33231e-09_r8,0.32299e-09_r8 /) + kbo(:,53, 3) = (/ & + & 0.27062e-09_r8,0.27028e-09_r8,0.26516e-09_r8,0.26816e-09_r8,0.25661e-09_r8 /) + kbo(:,54, 3) = (/ & + & 0.23501e-09_r8,0.23579e-09_r8,0.23460e-09_r8,0.23532e-09_r8,0.22777e-09_r8 /) + kbo(:,55, 3) = (/ & + & 0.20561e-09_r8,0.21843e-09_r8,0.22171e-09_r8,0.22358e-09_r8,0.21702e-09_r8 /) + kbo(:,56, 3) = (/ & + & 0.18557e-09_r8,0.20864e-09_r8,0.21196e-09_r8,0.20646e-09_r8,0.20759e-09_r8 /) + kbo(:,57, 3) = (/ & + & 0.17099e-09_r8,0.19489e-09_r8,0.19486e-09_r8,0.19102e-09_r8,0.19124e-09_r8 /) + kbo(:,58, 3) = (/ & + & 0.16535e-09_r8,0.16955e-09_r8,0.18769e-09_r8,0.18586e-09_r8,0.18358e-09_r8 /) + kbo(:,59, 3) = (/ & + & 0.18472e-09_r8,0.17614e-09_r8,0.20835e-09_r8,0.19900e-09_r8,0.17587e-09_r8 /) + kbo(:,13, 4) = (/ & + & 0.14276e-07_r8,0.14530e-07_r8,0.14762e-07_r8,0.14823e-07_r8,0.15070e-07_r8 /) + kbo(:,14, 4) = (/ & + & 0.22710e-07_r8,0.23419e-07_r8,0.26577e-07_r8,0.28008e-07_r8,0.28298e-07_r8 /) + kbo(:,15, 4) = (/ & + & 0.40218e-07_r8,0.40306e-07_r8,0.38786e-07_r8,0.38421e-07_r8,0.37982e-07_r8 /) + kbo(:,16, 4) = (/ & + & 0.46010e-07_r8,0.46709e-07_r8,0.48658e-07_r8,0.49166e-07_r8,0.49018e-07_r8 /) + kbo(:,17, 4) = (/ & + & 0.57896e-07_r8,0.59606e-07_r8,0.62582e-07_r8,0.65981e-07_r8,0.66467e-07_r8 /) + kbo(:,18, 4) = (/ & + & 0.74731e-07_r8,0.75116e-07_r8,0.75181e-07_r8,0.74922e-07_r8,0.73535e-07_r8 /) + kbo(:,19, 4) = (/ & + & 0.76222e-07_r8,0.73788e-07_r8,0.71345e-07_r8,0.70864e-07_r8,0.69839e-07_r8 /) + kbo(:,20, 4) = (/ & + & 0.69638e-07_r8,0.67680e-07_r8,0.66694e-07_r8,0.67021e-07_r8,0.67066e-07_r8 /) + kbo(:,21, 4) = (/ & + & 0.65779e-07_r8,0.64200e-07_r8,0.63508e-07_r8,0.64106e-07_r8,0.64461e-07_r8 /) + kbo(:,22, 4) = (/ & + & 0.61488e-07_r8,0.60248e-07_r8,0.59719e-07_r8,0.60704e-07_r8,0.61392e-07_r8 /) + kbo(:,23, 4) = (/ & + & 0.56738e-07_r8,0.55143e-07_r8,0.55071e-07_r8,0.56796e-07_r8,0.58031e-07_r8 /) + kbo(:,24, 4) = (/ & + & 0.53299e-07_r8,0.52091e-07_r8,0.52308e-07_r8,0.54157e-07_r8,0.55094e-07_r8 /) + kbo(:,25, 4) = (/ & + & 0.49763e-07_r8,0.48954e-07_r8,0.49068e-07_r8,0.51533e-07_r8,0.52367e-07_r8 /) + kbo(:,26, 4) = (/ & + & 0.46006e-07_r8,0.45410e-07_r8,0.45860e-07_r8,0.48840e-07_r8,0.49788e-07_r8 /) + kbo(:,27, 4) = (/ & + & 0.42208e-07_r8,0.41876e-07_r8,0.43006e-07_r8,0.46350e-07_r8,0.47032e-07_r8 /) + kbo(:,28, 4) = (/ & + & 0.38508e-07_r8,0.38430e-07_r8,0.40481e-07_r8,0.43465e-07_r8,0.43170e-07_r8 /) + kbo(:,29, 4) = (/ & + & 0.33913e-07_r8,0.34466e-07_r8,0.37202e-07_r8,0.38288e-07_r8,0.38327e-07_r8 /) + kbo(:,30, 4) = (/ & + & 0.29454e-07_r8,0.30842e-07_r8,0.33204e-07_r8,0.33354e-07_r8,0.33727e-07_r8 /) + kbo(:,31, 4) = (/ & + & 0.25253e-07_r8,0.27183e-07_r8,0.28228e-07_r8,0.27946e-07_r8,0.28495e-07_r8 /) + kbo(:,32, 4) = (/ & + & 0.21784e-07_r8,0.23351e-07_r8,0.23372e-07_r8,0.23449e-07_r8,0.23246e-07_r8 /) + kbo(:,33, 4) = (/ & + & 0.18910e-07_r8,0.19134e-07_r8,0.18984e-07_r8,0.19294e-07_r8,0.18955e-07_r8 /) + kbo(:,34, 4) = (/ & + & 0.15933e-07_r8,0.15755e-07_r8,0.16059e-07_r8,0.15913e-07_r8,0.15386e-07_r8 /) + kbo(:,35, 4) = (/ & + & 0.13356e-07_r8,0.13247e-07_r8,0.13429e-07_r8,0.13202e-07_r8,0.12675e-07_r8 /) + kbo(:,36, 4) = (/ & + & 0.11207e-07_r8,0.11196e-07_r8,0.11048e-07_r8,0.10870e-07_r8,0.10431e-07_r8 /) + kbo(:,37, 4) = (/ & + & 0.95811e-08_r8,0.94647e-08_r8,0.93875e-08_r8,0.90968e-08_r8,0.88553e-08_r8 /) + kbo(:,38, 4) = (/ & + & 0.81243e-08_r8,0.80255e-08_r8,0.78559e-08_r8,0.75538e-08_r8,0.74057e-08_r8 /) + kbo(:,39, 4) = (/ & + & 0.66871e-08_r8,0.66553e-08_r8,0.65003e-08_r8,0.62809e-08_r8,0.60862e-08_r8 /) + kbo(:,40, 4) = (/ & + & 0.58254e-08_r8,0.57657e-08_r8,0.56185e-08_r8,0.54242e-08_r8,0.52135e-08_r8 /) + kbo(:,41, 4) = (/ & + & 0.50967e-08_r8,0.50027e-08_r8,0.48304e-08_r8,0.46813e-08_r8,0.44864e-08_r8 /) + kbo(:,42, 4) = (/ & + & 0.43731e-08_r8,0.43157e-08_r8,0.41432e-08_r8,0.39968e-08_r8,0.38854e-08_r8 /) + kbo(:,43, 4) = (/ & + & 0.37430e-08_r8,0.37088e-08_r8,0.35491e-08_r8,0.34012e-08_r8,0.33022e-08_r8 /) + kbo(:,44, 4) = (/ & + & 0.32207e-08_r8,0.31034e-08_r8,0.30690e-08_r8,0.29015e-08_r8,0.27644e-08_r8 /) + kbo(:,45, 4) = (/ & + & 0.27111e-08_r8,0.25582e-08_r8,0.26092e-08_r8,0.24352e-08_r8,0.23234e-08_r8 /) + kbo(:,46, 4) = (/ & + & 0.22675e-08_r8,0.21455e-08_r8,0.21930e-08_r8,0.20490e-08_r8,0.19277e-08_r8 /) + kbo(:,47, 4) = (/ & + & 0.18722e-08_r8,0.18163e-08_r8,0.18222e-08_r8,0.17256e-08_r8,0.16025e-08_r8 /) + kbo(:,48, 4) = (/ & + & 0.15670e-08_r8,0.15133e-08_r8,0.14751e-08_r8,0.14433e-08_r8,0.13269e-08_r8 /) + kbo(:,49, 4) = (/ & + & 0.12576e-08_r8,0.12106e-08_r8,0.11779e-08_r8,0.11664e-08_r8,0.10722e-08_r8 /) + kbo(:,50, 4) = (/ & + & 0.10308e-08_r8,0.10019e-08_r8,0.98151e-09_r8,0.96758e-09_r8,0.89739e-09_r8 /) + kbo(:,51, 4) = (/ & + & 0.84050e-09_r8,0.85047e-09_r8,0.83131e-09_r8,0.81346e-09_r8,0.77303e-09_r8 /) + kbo(:,52, 4) = (/ & + & 0.67669e-09_r8,0.70190e-09_r8,0.68695e-09_r8,0.66858e-09_r8,0.63719e-09_r8 /) + kbo(:,53, 4) = (/ & + & 0.52755e-09_r8,0.56097e-09_r8,0.54716e-09_r8,0.53877e-09_r8,0.51047e-09_r8 /) + kbo(:,54, 4) = (/ & + & 0.44864e-09_r8,0.48984e-09_r8,0.48831e-09_r8,0.46728e-09_r8,0.45462e-09_r8 /) + kbo(:,55, 4) = (/ & + & 0.40938e-09_r8,0.45501e-09_r8,0.45212e-09_r8,0.43586e-09_r8,0.42245e-09_r8 /) + kbo(:,56, 4) = (/ & + & 0.38293e-09_r8,0.40217e-09_r8,0.41760e-09_r8,0.39645e-09_r8,0.38652e-09_r8 /) + kbo(:,57, 4) = (/ & + & 0.35808e-09_r8,0.34306e-09_r8,0.38440e-09_r8,0.37442e-09_r8,0.33472e-09_r8 /) + kbo(:,58, 4) = (/ & + & 0.33278e-09_r8,0.31839e-09_r8,0.35327e-09_r8,0.33061e-09_r8,0.29093e-09_r8 /) + kbo(:,59, 4) = (/ & + & 0.32589e-09_r8,0.30766e-09_r8,0.30185e-09_r8,0.35182e-09_r8,0.34474e-09_r8 /) + kbo(:,13, 5) = (/ & + & 0.19090e-07_r8,0.19323e-07_r8,0.21491e-07_r8,0.23162e-07_r8,0.23970e-07_r8 /) + kbo(:,14, 5) = (/ & + & 0.37888e-07_r8,0.37108e-07_r8,0.33727e-07_r8,0.34146e-07_r8,0.33930e-07_r8 /) + kbo(:,15, 5) = (/ & + & 0.46395e-07_r8,0.47265e-07_r8,0.48201e-07_r8,0.50512e-07_r8,0.51101e-07_r8 /) + kbo(:,16, 5) = (/ & + & 0.60743e-07_r8,0.64371e-07_r8,0.67862e-07_r8,0.71479e-07_r8,0.74200e-07_r8 /) + kbo(:,17, 5) = (/ & + & 0.79052e-07_r8,0.79011e-07_r8,0.77558e-07_r8,0.75900e-07_r8,0.76450e-07_r8 /) + kbo(:,18, 5) = (/ & + & 0.75325e-07_r8,0.74009e-07_r8,0.72866e-07_r8,0.72803e-07_r8,0.73869e-07_r8 /) + kbo(:,19, 5) = (/ & + & 0.74009e-07_r8,0.74054e-07_r8,0.73970e-07_r8,0.73800e-07_r8,0.75638e-07_r8 /) + kbo(:,20, 5) = (/ & + & 0.73077e-07_r8,0.73306e-07_r8,0.72248e-07_r8,0.73120e-07_r8,0.74630e-07_r8 /) + kbo(:,21, 5) = (/ & + & 0.68928e-07_r8,0.70100e-07_r8,0.69203e-07_r8,0.69478e-07_r8,0.71860e-07_r8 /) + kbo(:,22, 5) = (/ & + & 0.65324e-07_r8,0.66570e-07_r8,0.66457e-07_r8,0.66345e-07_r8,0.68314e-07_r8 /) + kbo(:,23, 5) = (/ & + & 0.62411e-07_r8,0.63996e-07_r8,0.63443e-07_r8,0.63576e-07_r8,0.65766e-07_r8 /) + kbo(:,24, 5) = (/ & + & 0.60058e-07_r8,0.60956e-07_r8,0.60176e-07_r8,0.60222e-07_r8,0.63287e-07_r8 /) + kbo(:,25, 5) = (/ & + & 0.57223e-07_r8,0.58225e-07_r8,0.58348e-07_r8,0.58584e-07_r8,0.61933e-07_r8 /) + kbo(:,26, 5) = (/ & + & 0.55089e-07_r8,0.55723e-07_r8,0.55839e-07_r8,0.56337e-07_r8,0.60335e-07_r8 /) + kbo(:,27, 5) = (/ & + & 0.52294e-07_r8,0.51745e-07_r8,0.52750e-07_r8,0.52701e-07_r8,0.57676e-07_r8 /) + kbo(:,28, 5) = (/ & + & 0.48915e-07_r8,0.48234e-07_r8,0.48708e-07_r8,0.49873e-07_r8,0.54442e-07_r8 /) + kbo(:,29, 5) = (/ & + & 0.43357e-07_r8,0.43230e-07_r8,0.43679e-07_r8,0.47285e-07_r8,0.49519e-07_r8 /) + kbo(:,30, 5) = (/ & + & 0.37379e-07_r8,0.38427e-07_r8,0.39703e-07_r8,0.43492e-07_r8,0.43278e-07_r8 /) + kbo(:,31, 5) = (/ & + & 0.31354e-07_r8,0.32238e-07_r8,0.35376e-07_r8,0.37358e-07_r8,0.37130e-07_r8 /) + kbo(:,32, 5) = (/ & + & 0.26553e-07_r8,0.27801e-07_r8,0.30978e-07_r8,0.30698e-07_r8,0.31234e-07_r8 /) + kbo(:,33, 5) = (/ & + & 0.21542e-07_r8,0.24274e-07_r8,0.24944e-07_r8,0.25194e-07_r8,0.25415e-07_r8 /) + kbo(:,34, 5) = (/ & + & 0.19097e-07_r8,0.20582e-07_r8,0.20324e-07_r8,0.21006e-07_r8,0.20944e-07_r8 /) + kbo(:,35, 5) = (/ & + & 0.16377e-07_r8,0.16881e-07_r8,0.16957e-07_r8,0.16743e-07_r8,0.16958e-07_r8 /) + kbo(:,36, 5) = (/ & + & 0.13727e-07_r8,0.13834e-07_r8,0.13766e-07_r8,0.13776e-07_r8,0.13546e-07_r8 /) + kbo(:,37, 5) = (/ & + & 0.11550e-07_r8,0.11601e-07_r8,0.11757e-07_r8,0.11723e-07_r8,0.11413e-07_r8 /) + kbo(:,38, 5) = (/ & + & 0.98076e-08_r8,0.96320e-08_r8,0.10028e-07_r8,0.98197e-08_r8,0.91408e-08_r8 /) + kbo(:,39, 5) = (/ & + & 0.80861e-08_r8,0.80113e-08_r8,0.81586e-08_r8,0.80121e-08_r8,0.75021e-08_r8 /) + kbo(:,40, 5) = (/ & + & 0.70348e-08_r8,0.69980e-08_r8,0.71058e-08_r8,0.69171e-08_r8,0.64103e-08_r8 /) + kbo(:,41, 5) = (/ & + & 0.61395e-08_r8,0.60379e-08_r8,0.61651e-08_r8,0.59006e-08_r8,0.54433e-08_r8 /) + kbo(:,42, 5) = (/ & + & 0.51740e-08_r8,0.51391e-08_r8,0.53717e-08_r8,0.50506e-08_r8,0.46901e-08_r8 /) + kbo(:,43, 5) = (/ & + & 0.44374e-08_r8,0.44002e-08_r8,0.45405e-08_r8,0.42888e-08_r8,0.39390e-08_r8 /) + kbo(:,44, 5) = (/ & + & 0.36635e-08_r8,0.37555e-08_r8,0.37320e-08_r8,0.35598e-08_r8,0.33280e-08_r8 /) + kbo(:,45, 5) = (/ & + & 0.30833e-08_r8,0.31320e-08_r8,0.30264e-08_r8,0.29827e-08_r8,0.28298e-08_r8 /) + kbo(:,46, 5) = (/ & + & 0.25366e-08_r8,0.26077e-08_r8,0.24905e-08_r8,0.24281e-08_r8,0.22727e-08_r8 /) + kbo(:,47, 5) = (/ & + & 0.20576e-08_r8,0.22029e-08_r8,0.20905e-08_r8,0.21040e-08_r8,0.19027e-08_r8 /) + kbo(:,48, 5) = (/ & + & 0.16047e-08_r8,0.18190e-08_r8,0.17008e-08_r8,0.17298e-08_r8,0.16059e-08_r8 /) + kbo(:,49, 5) = (/ & + & 0.12276e-08_r8,0.14135e-08_r8,0.13565e-08_r8,0.13704e-08_r8,0.13029e-08_r8 /) + kbo(:,50, 5) = (/ & + & 0.98291e-09_r8,0.11837e-08_r8,0.11000e-08_r8,0.11342e-08_r8,0.10621e-08_r8 /) + kbo(:,51, 5) = (/ & + & 0.79374e-09_r8,0.97756e-09_r8,0.90252e-09_r8,0.90527e-09_r8,0.86815e-09_r8 /) + kbo(:,52, 5) = (/ & + & 0.64781e-09_r8,0.78454e-09_r8,0.75690e-09_r8,0.74124e-09_r8,0.73195e-09_r8 /) + kbo(:,53, 5) = (/ & + & 0.51536e-09_r8,0.61158e-09_r8,0.60936e-09_r8,0.59007e-09_r8,0.58458e-09_r8 /) + kbo(:,54, 5) = (/ & + & 0.46178e-09_r8,0.51944e-09_r8,0.52167e-09_r8,0.53965e-09_r8,0.50524e-09_r8 /) + kbo(:,55, 5) = (/ & + & 0.44467e-09_r8,0.42857e-09_r8,0.50799e-09_r8,0.47528e-09_r8,0.43900e-09_r8 /) + kbo(:,56, 5) = (/ & + & 0.39667e-09_r8,0.37862e-09_r8,0.45808e-09_r8,0.43270e-09_r8,0.38817e-09_r8 /) + kbo(:,57, 5) = (/ & + & 0.35926e-09_r8,0.35410e-09_r8,0.38962e-09_r8,0.37502e-09_r8,0.40935e-09_r8 /) + kbo(:,58, 5) = (/ & + & 0.31517e-09_r8,0.32964e-09_r8,0.29323e-09_r8,0.39945e-09_r8,0.40389e-09_r8 /) + kbo(:,59, 5) = (/ & + & 0.36198e-09_r8,0.38633e-09_r8,0.41096e-09_r8,0.53914e-09_r8,0.57631e-09_r8 /) + kbo(:,13, 6) = (/ & + & 0.23095e-07_r8,0.23025e-07_r8,0.25126e-07_r8,0.25618e-07_r8,0.24969e-07_r8 /) + kbo(:,14, 6) = (/ & + & 0.31573e-07_r8,0.32360e-07_r8,0.33220e-07_r8,0.32611e-07_r8,0.32150e-07_r8 /) + kbo(:,15, 6) = (/ & + & 0.45219e-07_r8,0.45787e-07_r8,0.47088e-07_r8,0.49543e-07_r8,0.54072e-07_r8 /) + kbo(:,16, 6) = (/ & + & 0.65293e-07_r8,0.67448e-07_r8,0.64557e-07_r8,0.63976e-07_r8,0.64905e-07_r8 /) + kbo(:,17, 6) = (/ & + & 0.64862e-07_r8,0.63259e-07_r8,0.62851e-07_r8,0.62500e-07_r8,0.63112e-07_r8 /) + kbo(:,18, 6) = (/ & + & 0.61849e-07_r8,0.62108e-07_r8,0.60565e-07_r8,0.60920e-07_r8,0.61810e-07_r8 /) + kbo(:,19, 6) = (/ & + & 0.63930e-07_r8,0.63195e-07_r8,0.62478e-07_r8,0.62282e-07_r8,0.62250e-07_r8 /) + kbo(:,20, 6) = (/ & + & 0.60100e-07_r8,0.60269e-07_r8,0.59919e-07_r8,0.57578e-07_r8,0.57933e-07_r8 /) + kbo(:,21, 6) = (/ & + & 0.56465e-07_r8,0.56674e-07_r8,0.56992e-07_r8,0.55969e-07_r8,0.54719e-07_r8 /) + kbo(:,22, 6) = (/ & + & 0.54280e-07_r8,0.53760e-07_r8,0.52615e-07_r8,0.52261e-07_r8,0.51523e-07_r8 /) + kbo(:,23, 6) = (/ & + & 0.49921e-07_r8,0.49472e-07_r8,0.49168e-07_r8,0.47959e-07_r8,0.47449e-07_r8 /) + kbo(:,24, 6) = (/ & + & 0.45803e-07_r8,0.46271e-07_r8,0.46322e-07_r8,0.46536e-07_r8,0.46494e-07_r8 /) + kbo(:,25, 6) = (/ & + & 0.43723e-07_r8,0.44225e-07_r8,0.44324e-07_r8,0.43726e-07_r8,0.43579e-07_r8 /) + kbo(:,26, 6) = (/ & + & 0.41617e-07_r8,0.42588e-07_r8,0.42306e-07_r8,0.41086e-07_r8,0.41943e-07_r8 /) + kbo(:,27, 6) = (/ & + & 0.38855e-07_r8,0.40231e-07_r8,0.39090e-07_r8,0.39461e-07_r8,0.39072e-07_r8 /) + kbo(:,28, 6) = (/ & + & 0.35912e-07_r8,0.36691e-07_r8,0.35670e-07_r8,0.35644e-07_r8,0.38295e-07_r8 /) + kbo(:,29, 6) = (/ & + & 0.33357e-07_r8,0.33134e-07_r8,0.32394e-07_r8,0.32909e-07_r8,0.36234e-07_r8 /) + kbo(:,30, 6) = (/ & + & 0.30529e-07_r8,0.29196e-07_r8,0.29147e-07_r8,0.30292e-07_r8,0.33912e-07_r8 /) + kbo(:,31, 6) = (/ & + & 0.27228e-07_r8,0.27081e-07_r8,0.26630e-07_r8,0.30010e-07_r8,0.28781e-07_r8 /) + kbo(:,32, 6) = (/ & + & 0.24109e-07_r8,0.24388e-07_r8,0.25546e-07_r8,0.26823e-07_r8,0.26681e-07_r8 /) + kbo(:,33, 6) = (/ & + & 0.21402e-07_r8,0.22303e-07_r8,0.24668e-07_r8,0.24556e-07_r8,0.24369e-07_r8 /) + kbo(:,34, 6) = (/ & + & 0.18136e-07_r8,0.20944e-07_r8,0.21211e-07_r8,0.21286e-07_r8,0.21648e-07_r8 /) + kbo(:,35, 6) = (/ & + & 0.16306e-07_r8,0.17531e-07_r8,0.17744e-07_r8,0.18061e-07_r8,0.18282e-07_r8 /) + kbo(:,36, 6) = (/ & + & 0.13873e-07_r8,0.14963e-07_r8,0.15398e-07_r8,0.15527e-07_r8,0.15391e-07_r8 /) + kbo(:,37, 6) = (/ & + & 0.11948e-07_r8,0.12614e-07_r8,0.12946e-07_r8,0.12916e-07_r8,0.13085e-07_r8 /) + kbo(:,38, 6) = (/ & + & 0.98235e-08_r8,0.10612e-07_r8,0.10029e-07_r8,0.10618e-07_r8,0.10860e-07_r8 /) + kbo(:,39, 6) = (/ & + & 0.81514e-08_r8,0.84716e-08_r8,0.81123e-08_r8,0.83644e-08_r8,0.81668e-08_r8 /) + kbo(:,40, 6) = (/ & + & 0.68179e-08_r8,0.69030e-08_r8,0.69393e-08_r8,0.69969e-08_r8,0.71027e-08_r8 /) + kbo(:,41, 6) = (/ & + & 0.59350e-08_r8,0.60668e-08_r8,0.59026e-08_r8,0.60181e-08_r8,0.60779e-08_r8 /) + kbo(:,42, 6) = (/ & + & 0.51181e-08_r8,0.52127e-08_r8,0.48788e-08_r8,0.51397e-08_r8,0.50230e-08_r8 /) + kbo(:,43, 6) = (/ & + & 0.42653e-08_r8,0.44600e-08_r8,0.41100e-08_r8,0.44735e-08_r8,0.42607e-08_r8 /) + kbo(:,44, 6) = (/ & + & 0.34724e-08_r8,0.37628e-08_r8,0.35340e-08_r8,0.38309e-08_r8,0.36188e-08_r8 /) + kbo(:,45, 6) = (/ & + & 0.27994e-08_r8,0.31690e-08_r8,0.28599e-08_r8,0.30290e-08_r8,0.27730e-08_r8 /) + kbo(:,46, 6) = (/ & + & 0.22089e-08_r8,0.25761e-08_r8,0.23856e-08_r8,0.24874e-08_r8,0.23603e-08_r8 /) + kbo(:,47, 6) = (/ & + & 0.18078e-08_r8,0.20304e-08_r8,0.19457e-08_r8,0.19366e-08_r8,0.19286e-08_r8 /) + kbo(:,48, 6) = (/ & + & 0.14716e-08_r8,0.15703e-08_r8,0.17393e-08_r8,0.14836e-08_r8,0.15316e-08_r8 /) + kbo(:,49, 6) = (/ & + & 0.11334e-08_r8,0.12901e-08_r8,0.13556e-08_r8,0.11610e-08_r8,0.11617e-08_r8 /) + kbo(:,50, 6) = (/ & + & 0.90881e-09_r8,0.10323e-08_r8,0.11378e-08_r8,0.95509e-09_r8,0.96291e-09_r8 /) + kbo(:,51, 6) = (/ & + & 0.76751e-09_r8,0.81710e-09_r8,0.97432e-09_r8,0.82408e-09_r8,0.81205e-09_r8 /) + kbo(:,52, 6) = (/ & + & 0.62668e-09_r8,0.66223e-09_r8,0.76870e-09_r8,0.68347e-09_r8,0.65771e-09_r8 /) + kbo(:,53, 6) = (/ & + & 0.50547e-09_r8,0.49991e-09_r8,0.61494e-09_r8,0.55640e-09_r8,0.52803e-09_r8 /) + kbo(:,54, 6) = (/ & + & 0.42841e-09_r8,0.42678e-09_r8,0.51796e-09_r8,0.46340e-09_r8,0.44830e-09_r8 /) + kbo(:,55, 6) = (/ & + & 0.40234e-09_r8,0.40065e-09_r8,0.45944e-09_r8,0.42252e-09_r8,0.44365e-09_r8 /) + kbo(:,56, 6) = (/ & + & 0.36764e-09_r8,0.35937e-09_r8,0.36570e-09_r8,0.44631e-09_r8,0.45684e-09_r8 /) + kbo(:,57, 6) = (/ & + & 0.33321e-09_r8,0.29808e-09_r8,0.31056e-09_r8,0.44585e-09_r8,0.41122e-09_r8 /) + kbo(:,58, 6) = (/ & + & 0.31198e-09_r8,0.29542e-09_r8,0.33327e-09_r8,0.43871e-09_r8,0.45291e-09_r8 /) + kbo(:,59, 6) = (/ & + & 0.38710e-09_r8,0.42412e-09_r8,0.44197e-09_r8,0.49964e-09_r8,0.70387e-09_r8 /) + kbo(:,13, 7) = (/ & + & 0.30377e-07_r8,0.31586e-07_r8,0.27647e-07_r8,0.27937e-07_r8,0.28036e-07_r8 /) + kbo(:,14, 7) = (/ & + & 0.37766e-07_r8,0.39819e-07_r8,0.39822e-07_r8,0.40069e-07_r8,0.42091e-07_r8 /) + kbo(:,15, 7) = (/ & + & 0.57996e-07_r8,0.64474e-07_r8,0.69368e-07_r8,0.70909e-07_r8,0.70748e-07_r8 /) + kbo(:,16, 7) = (/ & + & 0.73220e-07_r8,0.70124e-07_r8,0.69135e-07_r8,0.68058e-07_r8,0.66524e-07_r8 /) + kbo(:,17, 7) = (/ & + & 0.66529e-07_r8,0.66306e-07_r8,0.63797e-07_r8,0.63551e-07_r8,0.63462e-07_r8 /) + kbo(:,18, 7) = (/ & + & 0.66492e-07_r8,0.65156e-07_r8,0.66323e-07_r8,0.64485e-07_r8,0.63285e-07_r8 /) + kbo(:,19, 7) = (/ & + & 0.62980e-07_r8,0.62900e-07_r8,0.62718e-07_r8,0.61114e-07_r8,0.59765e-07_r8 /) + kbo(:,20, 7) = (/ & + & 0.59754e-07_r8,0.58066e-07_r8,0.59540e-07_r8,0.58926e-07_r8,0.57835e-07_r8 /) + kbo(:,21, 7) = (/ & + & 0.57368e-07_r8,0.55161e-07_r8,0.55685e-07_r8,0.55360e-07_r8,0.53982e-07_r8 /) + kbo(:,22, 7) = (/ & + & 0.51435e-07_r8,0.49998e-07_r8,0.50952e-07_r8,0.50442e-07_r8,0.49717e-07_r8 /) + kbo(:,23, 7) = (/ & + & 0.47663e-07_r8,0.46845e-07_r8,0.47849e-07_r8,0.48876e-07_r8,0.48885e-07_r8 /) + kbo(:,24, 7) = (/ & + & 0.47926e-07_r8,0.45619e-07_r8,0.45793e-07_r8,0.46467e-07_r8,0.45938e-07_r8 /) + kbo(:,25, 7) = (/ & + & 0.44687e-07_r8,0.43904e-07_r8,0.44284e-07_r8,0.44176e-07_r8,0.45520e-07_r8 /) + kbo(:,26, 7) = (/ & + & 0.42751e-07_r8,0.41938e-07_r8,0.42889e-07_r8,0.42927e-07_r8,0.43868e-07_r8 /) + kbo(:,27, 7) = (/ & + & 0.40180e-07_r8,0.40529e-07_r8,0.40621e-07_r8,0.40949e-07_r8,0.41005e-07_r8 /) + kbo(:,28, 7) = (/ & + & 0.35890e-07_r8,0.36716e-07_r8,0.37875e-07_r8,0.38308e-07_r8,0.37626e-07_r8 /) + kbo(:,29, 7) = (/ & + & 0.31499e-07_r8,0.33284e-07_r8,0.32725e-07_r8,0.32493e-07_r8,0.35018e-07_r8 /) + kbo(:,30, 7) = (/ & + & 0.29364e-07_r8,0.28675e-07_r8,0.28942e-07_r8,0.28761e-07_r8,0.33960e-07_r8 /) + kbo(:,31, 7) = (/ & + & 0.25558e-07_r8,0.23679e-07_r8,0.24292e-07_r8,0.26053e-07_r8,0.29211e-07_r8 /) + kbo(:,32, 7) = (/ & + & 0.20860e-07_r8,0.21491e-07_r8,0.20910e-07_r8,0.25598e-07_r8,0.24209e-07_r8 /) + kbo(:,33, 7) = (/ & + & 0.18874e-07_r8,0.18554e-07_r8,0.21206e-07_r8,0.20708e-07_r8,0.21100e-07_r8 /) + kbo(:,34, 7) = (/ & + & 0.18632e-07_r8,0.18625e-07_r8,0.20707e-07_r8,0.19570e-07_r8,0.18956e-07_r8 /) + kbo(:,35, 7) = (/ & + & 0.15958e-07_r8,0.19141e-07_r8,0.19004e-07_r8,0.19249e-07_r8,0.17793e-07_r8 /) + kbo(:,36, 7) = (/ & + & 0.14552e-07_r8,0.16561e-07_r8,0.16607e-07_r8,0.16784e-07_r8,0.16326e-07_r8 /) + kbo(:,37, 7) = (/ & + & 0.13127e-07_r8,0.14300e-07_r8,0.14021e-07_r8,0.14385e-07_r8,0.13328e-07_r8 /) + kbo(:,38, 7) = (/ & + & 0.11514e-07_r8,0.12356e-07_r8,0.12677e-07_r8,0.12181e-07_r8,0.11774e-07_r8 /) + kbo(:,39, 7) = (/ & + & 0.93434e-08_r8,0.10196e-07_r8,0.10605e-07_r8,0.10201e-07_r8,0.10584e-07_r8 /) + kbo(:,40, 7) = (/ & + & 0.81790e-08_r8,0.89000e-08_r8,0.85315e-08_r8,0.89663e-08_r8,0.91635e-08_r8 /) + kbo(:,41, 7) = (/ & + & 0.65541e-08_r8,0.74884e-08_r8,0.72364e-08_r8,0.72692e-08_r8,0.75649e-08_r8 /) + kbo(:,42, 7) = (/ & + & 0.54665e-08_r8,0.61796e-08_r8,0.61564e-08_r8,0.61304e-08_r8,0.64285e-08_r8 /) + kbo(:,43, 7) = (/ & + & 0.43531e-08_r8,0.47798e-08_r8,0.51393e-08_r8,0.49135e-08_r8,0.53520e-08_r8 /) + kbo(:,44, 7) = (/ & + & 0.35872e-08_r8,0.38233e-08_r8,0.42659e-08_r8,0.39384e-08_r8,0.44541e-08_r8 /) + kbo(:,45, 7) = (/ & + & 0.28156e-08_r8,0.32775e-08_r8,0.36262e-08_r8,0.32518e-08_r8,0.36805e-08_r8 /) + kbo(:,46, 7) = (/ & + & 0.23879e-08_r8,0.26299e-08_r8,0.28972e-08_r8,0.27379e-08_r8,0.30333e-08_r8 /) + kbo(:,47, 7) = (/ & + & 0.19282e-08_r8,0.22066e-08_r8,0.23812e-08_r8,0.23512e-08_r8,0.23794e-08_r8 /) + kbo(:,48, 7) = (/ & + & 0.15092e-08_r8,0.18255e-08_r8,0.17414e-08_r8,0.19322e-08_r8,0.19399e-08_r8 /) + kbo(:,49, 7) = (/ & + & 0.11905e-08_r8,0.13964e-08_r8,0.14306e-08_r8,0.14791e-08_r8,0.14939e-08_r8 /) + kbo(:,50, 7) = (/ & + & 0.98537e-09_r8,0.10687e-08_r8,0.11753e-08_r8,0.11334e-08_r8,0.13178e-08_r8 /) + kbo(:,51, 7) = (/ & + & 0.84255e-09_r8,0.88069e-09_r8,0.95073e-09_r8,0.92632e-09_r8,0.10457e-08_r8 /) + kbo(:,52, 7) = (/ & + & 0.68238e-09_r8,0.70376e-09_r8,0.74795e-09_r8,0.75152e-09_r8,0.78131e-09_r8 /) + kbo(:,53, 7) = (/ & + & 0.56271e-09_r8,0.58527e-09_r8,0.61397e-09_r8,0.56343e-09_r8,0.61138e-09_r8 /) + kbo(:,54, 7) = (/ & + & 0.52493e-09_r8,0.46040e-09_r8,0.53769e-09_r8,0.51459e-09_r8,0.52912e-09_r8 /) + kbo(:,55, 7) = (/ & + & 0.40372e-09_r8,0.38720e-09_r8,0.40004e-09_r8,0.56294e-09_r8,0.55844e-09_r8 /) + kbo(:,56, 7) = (/ & + & 0.37372e-09_r8,0.35358e-09_r8,0.39920e-09_r8,0.52819e-09_r8,0.50147e-09_r8 /) + kbo(:,57, 7) = (/ & + & 0.31149e-09_r8,0.39454e-09_r8,0.38951e-09_r8,0.52086e-09_r8,0.54542e-09_r8 /) + kbo(:,58, 7) = (/ & + & 0.30564e-09_r8,0.36251e-09_r8,0.38551e-09_r8,0.43845e-09_r8,0.61772e-09_r8 /) + kbo(:,59, 7) = (/ & + & 0.46934e-09_r8,0.57639e-09_r8,0.58591e-09_r8,0.63021e-09_r8,0.71158e-09_r8 /) + kbo(:,13, 8) = (/ & + & 0.34320e-07_r8,0.31607e-07_r8,0.29840e-07_r8,0.29114e-07_r8,0.28831e-07_r8 /) + kbo(:,14, 8) = (/ & + & 0.38157e-07_r8,0.37907e-07_r8,0.40351e-07_r8,0.45015e-07_r8,0.44786e-07_r8 /) + kbo(:,15, 8) = (/ & + & 0.71231e-07_r8,0.71647e-07_r8,0.71034e-07_r8,0.71647e-07_r8,0.71755e-07_r8 /) + kbo(:,16, 8) = (/ & + & 0.72049e-07_r8,0.69075e-07_r8,0.67707e-07_r8,0.67019e-07_r8,0.66780e-07_r8 /) + kbo(:,17, 8) = (/ & + & 0.69751e-07_r8,0.66211e-07_r8,0.66017e-07_r8,0.63095e-07_r8,0.63343e-07_r8 /) + kbo(:,18, 8) = (/ & + & 0.67728e-07_r8,0.66581e-07_r8,0.64787e-07_r8,0.62981e-07_r8,0.62245e-07_r8 /) + kbo(:,19, 8) = (/ & + & 0.65864e-07_r8,0.63789e-07_r8,0.62712e-07_r8,0.62065e-07_r8,0.61005e-07_r8 /) + kbo(:,20, 8) = (/ & + & 0.61816e-07_r8,0.63755e-07_r8,0.63424e-07_r8,0.61945e-07_r8,0.58720e-07_r8 /) + kbo(:,21, 8) = (/ & + & 0.59112e-07_r8,0.58061e-07_r8,0.57019e-07_r8,0.54795e-07_r8,0.56069e-07_r8 /) + kbo(:,22, 8) = (/ & + & 0.56217e-07_r8,0.53887e-07_r8,0.54812e-07_r8,0.52500e-07_r8,0.53303e-07_r8 /) + kbo(:,23, 8) = (/ & + & 0.54428e-07_r8,0.52930e-07_r8,0.53278e-07_r8,0.52797e-07_r8,0.51840e-07_r8 /) + kbo(:,24, 8) = (/ & + & 0.51236e-07_r8,0.52532e-07_r8,0.53348e-07_r8,0.51715e-07_r8,0.53224e-07_r8 /) + kbo(:,25, 8) = (/ & + & 0.49989e-07_r8,0.50872e-07_r8,0.49932e-07_r8,0.52702e-07_r8,0.51493e-07_r8 /) + kbo(:,26, 8) = (/ & + & 0.49845e-07_r8,0.48733e-07_r8,0.48348e-07_r8,0.51346e-07_r8,0.51109e-07_r8 /) + kbo(:,27, 8) = (/ & + & 0.43883e-07_r8,0.43853e-07_r8,0.46523e-07_r8,0.47281e-07_r8,0.47292e-07_r8 /) + kbo(:,28, 8) = (/ & + & 0.41424e-07_r8,0.42057e-07_r8,0.43773e-07_r8,0.43422e-07_r8,0.41438e-07_r8 /) + kbo(:,29, 8) = (/ & + & 0.37736e-07_r8,0.34915e-07_r8,0.37971e-07_r8,0.38437e-07_r8,0.38122e-07_r8 /) + kbo(:,30, 8) = (/ & + & 0.30209e-07_r8,0.32936e-07_r8,0.31853e-07_r8,0.30285e-07_r8,0.31746e-07_r8 /) + kbo(:,31, 8) = (/ & + & 0.25886e-07_r8,0.26990e-07_r8,0.27039e-07_r8,0.26019e-07_r8,0.34246e-07_r8 /) + kbo(:,32, 8) = (/ & + & 0.24750e-07_r8,0.20653e-07_r8,0.21921e-07_r8,0.25087e-07_r8,0.25874e-07_r8 /) + kbo(:,33, 8) = (/ & + & 0.19410e-07_r8,0.18820e-07_r8,0.18768e-07_r8,0.23223e-07_r8,0.20942e-07_r8 /) + kbo(:,34, 8) = (/ & + & 0.16037e-07_r8,0.16060e-07_r8,0.19012e-07_r8,0.17686e-07_r8,0.18319e-07_r8 /) + kbo(:,35, 8) = (/ & + & 0.16085e-07_r8,0.15072e-07_r8,0.16472e-07_r8,0.15719e-07_r8,0.16406e-07_r8 /) + kbo(:,36, 8) = (/ & + & 0.15014e-07_r8,0.17144e-07_r8,0.16353e-07_r8,0.15223e-07_r8,0.14884e-07_r8 /) + kbo(:,37, 8) = (/ & + & 0.12909e-07_r8,0.15628e-07_r8,0.16086e-07_r8,0.15318e-07_r8,0.15605e-07_r8 /) + kbo(:,38, 8) = (/ & + & 0.11803e-07_r8,0.12970e-07_r8,0.13587e-07_r8,0.13257e-07_r8,0.13920e-07_r8 /) + kbo(:,39, 8) = (/ & + & 0.10299e-07_r8,0.10951e-07_r8,0.11006e-07_r8,0.11507e-07_r8,0.10553e-07_r8 /) + kbo(:,40, 8) = (/ & + & 0.87605e-08_r8,0.10094e-07_r8,0.10641e-07_r8,0.94199e-08_r8,0.97115e-08_r8 /) + kbo(:,41, 8) = (/ & + & 0.69747e-08_r8,0.82105e-08_r8,0.93516e-08_r8,0.90234e-08_r8,0.91657e-08_r8 /) + kbo(:,42, 8) = (/ & + & 0.60201e-08_r8,0.73523e-08_r8,0.76249e-08_r8,0.76962e-08_r8,0.80489e-08_r8 /) + kbo(:,43, 8) = (/ & + & 0.50249e-08_r8,0.64035e-08_r8,0.62997e-08_r8,0.63745e-08_r8,0.65773e-08_r8 /) + kbo(:,44, 8) = (/ & + & 0.43021e-08_r8,0.55682e-08_r8,0.52391e-08_r8,0.55432e-08_r8,0.53417e-08_r8 /) + kbo(:,45, 8) = (/ & + & 0.34659e-08_r8,0.41011e-08_r8,0.41998e-08_r8,0.45328e-08_r8,0.45452e-08_r8 /) + kbo(:,46, 8) = (/ & + & 0.26629e-08_r8,0.30573e-08_r8,0.34050e-08_r8,0.36018e-08_r8,0.38146e-08_r8 /) + kbo(:,47, 8) = (/ & + & 0.20352e-08_r8,0.25120e-08_r8,0.29668e-08_r8,0.27818e-08_r8,0.34015e-08_r8 /) + kbo(:,48, 8) = (/ & + & 0.16537e-08_r8,0.17568e-08_r8,0.23894e-08_r8,0.22154e-08_r8,0.25802e-08_r8 /) + kbo(:,49, 8) = (/ & + & 0.13981e-08_r8,0.14349e-08_r8,0.17246e-08_r8,0.17767e-08_r8,0.19090e-08_r8 /) + kbo(:,50, 8) = (/ & + & 0.10918e-08_r8,0.11356e-08_r8,0.12258e-08_r8,0.14996e-08_r8,0.12493e-08_r8 /) + kbo(:,51, 8) = (/ & + & 0.96204e-09_r8,0.88786e-09_r8,0.10061e-08_r8,0.12415e-08_r8,0.10774e-08_r8 /) + kbo(:,52, 8) = (/ & + & 0.79848e-09_r8,0.70289e-09_r8,0.84515e-09_r8,0.10143e-08_r8,0.85552e-09_r8 /) + kbo(:,53, 8) = (/ & + & 0.60435e-09_r8,0.54746e-09_r8,0.63806e-09_r8,0.74615e-09_r8,0.64507e-09_r8 /) + kbo(:,54, 8) = (/ & + & 0.47378e-09_r8,0.48059e-09_r8,0.54886e-09_r8,0.73215e-09_r8,0.65721e-09_r8 /) + kbo(:,55, 8) = (/ & + & 0.45346e-09_r8,0.46291e-09_r8,0.55380e-09_r8,0.67829e-09_r8,0.56756e-09_r8 /) + kbo(:,56, 8) = (/ & + & 0.43938e-09_r8,0.46043e-09_r8,0.50980e-09_r8,0.62685e-09_r8,0.70094e-09_r8 /) + kbo(:,57, 8) = (/ & + & 0.42587e-09_r8,0.43184e-09_r8,0.47819e-09_r8,0.57152e-09_r8,0.76528e-09_r8 /) + kbo(:,58, 8) = (/ & + & 0.47403e-09_r8,0.46387e-09_r8,0.50904e-09_r8,0.58886e-09_r8,0.70162e-09_r8 /) + kbo(:,59, 8) = (/ & + & 0.54448e-09_r8,0.50172e-09_r8,0.65155e-09_r8,0.65748e-09_r8,0.98321e-09_r8 /) + kbo(:,13, 9) = (/ & + & 0.10995e-05_r8,0.11095e-05_r8,0.11168e-05_r8,0.11200e-05_r8,0.11274e-05_r8 /) + kbo(:,14, 9) = (/ & + & 0.73340e-06_r8,0.73567e-06_r8,0.73740e-06_r8,0.73330e-06_r8,0.73919e-06_r8 /) + kbo(:,15, 9) = (/ & + & 0.32510e-06_r8,0.31252e-06_r8,0.30243e-06_r8,0.29146e-06_r8,0.28830e-06_r8 /) + kbo(:,16, 9) = (/ & + & 0.61567e-07_r8,0.60590e-07_r8,0.61057e-07_r8,0.58821e-07_r8,0.58536e-07_r8 /) + kbo(:,17, 9) = (/ & + & 0.60009e-07_r8,0.60924e-07_r8,0.61205e-07_r8,0.63591e-07_r8,0.59950e-07_r8 /) + kbo(:,18, 9) = (/ & + & 0.61458e-07_r8,0.61692e-07_r8,0.60339e-07_r8,0.59878e-07_r8,0.58575e-07_r8 /) + kbo(:,19, 9) = (/ & + & 0.57878e-07_r8,0.60299e-07_r8,0.60236e-07_r8,0.59512e-07_r8,0.58126e-07_r8 /) + kbo(:,20, 9) = (/ & + & 0.58329e-07_r8,0.57451e-07_r8,0.54760e-07_r8,0.57082e-07_r8,0.56805e-07_r8 /) + kbo(:,21, 9) = (/ & + & 0.53092e-07_r8,0.51700e-07_r8,0.51833e-07_r8,0.52853e-07_r8,0.52467e-07_r8 /) + kbo(:,22, 9) = (/ & + & 0.47591e-07_r8,0.51357e-07_r8,0.49075e-07_r8,0.53548e-07_r8,0.55924e-07_r8 /) + kbo(:,23, 9) = (/ & + & 0.49724e-07_r8,0.51803e-07_r8,0.51793e-07_r8,0.49922e-07_r8,0.52665e-07_r8 /) + kbo(:,24, 9) = (/ & + & 0.47737e-07_r8,0.49279e-07_r8,0.51207e-07_r8,0.49000e-07_r8,0.51613e-07_r8 /) + kbo(:,25, 9) = (/ & + & 0.49014e-07_r8,0.50174e-07_r8,0.54886e-07_r8,0.47520e-07_r8,0.49798e-07_r8 /) + kbo(:,26, 9) = (/ & + & 0.42783e-07_r8,0.51200e-07_r8,0.50600e-07_r8,0.47620e-07_r8,0.43709e-07_r8 /) + kbo(:,27, 9) = (/ & + & 0.42685e-07_r8,0.50611e-07_r8,0.42800e-07_r8,0.43026e-07_r8,0.46518e-07_r8 /) + kbo(:,28, 9) = (/ & + & 0.40023e-07_r8,0.44433e-07_r8,0.38380e-07_r8,0.40945e-07_r8,0.42005e-07_r8 /) + kbo(:,29, 9) = (/ & + & 0.34641e-07_r8,0.38943e-07_r8,0.36153e-07_r8,0.36773e-07_r8,0.32051e-07_r8 /) + kbo(:,30, 9) = (/ & + & 0.31936e-07_r8,0.28774e-07_r8,0.32629e-07_r8,0.32074e-07_r8,0.31547e-07_r8 /) + kbo(:,31, 9) = (/ & + & 0.25468e-07_r8,0.25946e-07_r8,0.23671e-07_r8,0.23770e-07_r8,0.28704e-07_r8 /) + kbo(:,32, 9) = (/ & + & 0.18317e-07_r8,0.22069e-07_r8,0.20055e-07_r8,0.21665e-07_r8,0.25653e-07_r8 /) + kbo(:,33, 9) = (/ & + & 0.18319e-07_r8,0.17920e-07_r8,0.16523e-07_r8,0.20049e-07_r8,0.19951e-07_r8 /) + kbo(:,34, 9) = (/ & + & 0.15127e-07_r8,0.13546e-07_r8,0.16257e-07_r8,0.16818e-07_r8,0.15661e-07_r8 /) + kbo(:,35, 9) = (/ & + & 0.12192e-07_r8,0.13829e-07_r8,0.15792e-07_r8,0.15440e-07_r8,0.14596e-07_r8 /) + kbo(:,36, 9) = (/ & + & 0.11593e-07_r8,0.10509e-07_r8,0.13211e-07_r8,0.13026e-07_r8,0.13917e-07_r8 /) + kbo(:,37, 9) = (/ & + & 0.12302e-07_r8,0.13196e-07_r8,0.12558e-07_r8,0.11760e-07_r8,0.12490e-07_r8 /) + kbo(:,38, 9) = (/ & + & 0.10116e-07_r8,0.12498e-07_r8,0.12546e-07_r8,0.12890e-07_r8,0.12908e-07_r8 /) + kbo(:,39, 9) = (/ & + & 0.88258e-08_r8,0.10400e-07_r8,0.11293e-07_r8,0.11361e-07_r8,0.11468e-07_r8 /) + kbo(:,40, 9) = (/ & + & 0.70753e-08_r8,0.81481e-08_r8,0.94292e-08_r8,0.10943e-07_r8,0.90300e-08_r8 /) + kbo(:,41, 9) = (/ & + & 0.71994e-08_r8,0.84394e-08_r8,0.89108e-08_r8,0.89407e-08_r8,0.87875e-08_r8 /) + kbo(:,42, 9) = (/ & + & 0.55536e-08_r8,0.66846e-08_r8,0.83965e-08_r8,0.80560e-08_r8,0.79305e-08_r8 /) + kbo(:,43, 9) = (/ & + & 0.50223e-08_r8,0.59958e-08_r8,0.69583e-08_r8,0.70648e-08_r8,0.76990e-08_r8 /) + kbo(:,44, 9) = (/ & + & 0.40990e-08_r8,0.43884e-08_r8,0.50706e-08_r8,0.56081e-08_r8,0.62414e-08_r8 /) + kbo(:,45, 9) = (/ & + & 0.35590e-08_r8,0.38731e-08_r8,0.41923e-08_r8,0.44278e-08_r8,0.44950e-08_r8 /) + kbo(:,46, 9) = (/ & + & 0.26814e-08_r8,0.33691e-08_r8,0.34101e-08_r8,0.34324e-08_r8,0.35321e-08_r8 /) + kbo(:,47, 9) = (/ & + & 0.21424e-08_r8,0.21249e-08_r8,0.27532e-08_r8,0.28475e-08_r8,0.25748e-08_r8 /) + kbo(:,48, 9) = (/ & + & 0.16514e-08_r8,0.18931e-08_r8,0.22507e-08_r8,0.22575e-08_r8,0.21238e-08_r8 /) + kbo(:,49, 9) = (/ & + & 0.12235e-08_r8,0.12503e-08_r8,0.16643e-08_r8,0.16742e-08_r8,0.16438e-08_r8 /) + kbo(:,50, 9) = (/ & + & 0.11340e-08_r8,0.11248e-08_r8,0.13120e-08_r8,0.13854e-08_r8,0.13503e-08_r8 /) + kbo(:,51, 9) = (/ & + & 0.79176e-09_r8,0.91681e-09_r8,0.99908e-09_r8,0.13532e-08_r8,0.10405e-08_r8 /) + kbo(:,52, 9) = (/ & + & 0.64785e-09_r8,0.57185e-09_r8,0.84784e-09_r8,0.90912e-09_r8,0.87721e-09_r8 /) + kbo(:,53, 9) = (/ & + & 0.51330e-09_r8,0.43209e-09_r8,0.61659e-09_r8,0.79798e-09_r8,0.65017e-09_r8 /) + kbo(:,54, 9) = (/ & + & 0.40227e-09_r8,0.45562e-09_r8,0.54691e-09_r8,0.63160e-09_r8,0.62902e-09_r8 /) + kbo(:,55, 9) = (/ & + & 0.44280e-09_r8,0.43833e-09_r8,0.48132e-09_r8,0.55748e-09_r8,0.72672e-09_r8 /) + kbo(:,56, 9) = (/ & + & 0.33767e-09_r8,0.43448e-09_r8,0.42774e-09_r8,0.52401e-09_r8,0.66273e-09_r8 /) + kbo(:,57, 9) = (/ & + & 0.40113e-09_r8,0.38794e-09_r8,0.46286e-09_r8,0.57261e-09_r8,0.60773e-09_r8 /) + kbo(:,58, 9) = (/ & + & 0.36624e-09_r8,0.52965e-09_r8,0.49530e-09_r8,0.54114e-09_r8,0.65708e-09_r8 /) + kbo(:,59, 9) = (/ & + & 0.52598e-09_r8,0.55940e-09_r8,0.70094e-09_r8,0.71749e-09_r8,0.81086e-09_r8 /) + kbo(:,13,10) = (/ & + & 0.75197e-05_r8,0.74908e-05_r8,0.74768e-05_r8,0.74579e-05_r8,0.74485e-05_r8 /) + kbo(:,14,10) = (/ & + & 0.62427e-05_r8,0.62400e-05_r8,0.62314e-05_r8,0.62357e-05_r8,0.62230e-05_r8 /) + kbo(:,15,10) = (/ & + & 0.51235e-05_r8,0.51220e-05_r8,0.51270e-05_r8,0.51388e-05_r8,0.51377e-05_r8 /) + kbo(:,16,10) = (/ & + & 0.36653e-05_r8,0.36812e-05_r8,0.36844e-05_r8,0.36893e-05_r8,0.37175e-05_r8 /) + kbo(:,17,10) = (/ & + & 0.10067e-05_r8,0.10571e-05_r8,0.10948e-05_r8,0.11331e-05_r8,0.11791e-05_r8 /) + kbo(:,18,10) = (/ & + & 0.37963e-07_r8,0.35028e-07_r8,0.38085e-07_r8,0.36252e-07_r8,0.39741e-07_r8 /) + kbo(:,19,10) = (/ & + & 0.58861e-07_r8,0.39909e-07_r8,0.43872e-07_r8,0.52963e-07_r8,0.37762e-07_r8 /) + kbo(:,20,10) = (/ & + & 0.65438e-07_r8,0.43429e-07_r8,0.52709e-07_r8,0.35811e-07_r8,0.59833e-07_r8 /) + kbo(:,21,10) = (/ & + & 0.50452e-07_r8,0.50995e-07_r8,0.40371e-07_r8,0.51145e-07_r8,0.52725e-07_r8 /) + kbo(:,22,10) = (/ & + & 0.42139e-07_r8,0.45011e-07_r8,0.61867e-07_r8,0.41292e-07_r8,0.37916e-07_r8 /) + kbo(:,23,10) = (/ & + & 0.30176e-07_r8,0.29856e-07_r8,0.39637e-07_r8,0.38957e-07_r8,0.64896e-07_r8 /) + kbo(:,24,10) = (/ & + & 0.36010e-07_r8,0.42155e-07_r8,0.32787e-07_r8,0.46750e-07_r8,0.46940e-07_r8 /) + kbo(:,25,10) = (/ & + & 0.34802e-07_r8,0.41607e-07_r8,0.40854e-07_r8,0.61643e-07_r8,0.53762e-07_r8 /) + kbo(:,26,10) = (/ & + & 0.41295e-07_r8,0.39697e-07_r8,0.46005e-07_r8,0.46334e-07_r8,0.53334e-07_r8 /) + kbo(:,27,10) = (/ & + & 0.61711e-07_r8,0.29641e-07_r8,0.51823e-07_r8,0.42625e-07_r8,0.36336e-07_r8 /) + kbo(:,28,10) = (/ & + & 0.45196e-07_r8,0.56637e-07_r8,0.31716e-07_r8,0.38569e-07_r8,0.45693e-07_r8 /) + kbo(:,29,10) = (/ & + & 0.47349e-07_r8,0.38492e-07_r8,0.26330e-07_r8,0.30953e-07_r8,0.33330e-07_r8 /) + kbo(:,30,10) = (/ & + & 0.20700e-07_r8,0.24999e-07_r8,0.19626e-07_r8,0.33645e-07_r8,0.21883e-07_r8 /) + kbo(:,31,10) = (/ & + & 0.31879e-07_r8,0.26245e-07_r8,0.28697e-07_r8,0.26867e-07_r8,0.26801e-07_r8 /) + kbo(:,32,10) = (/ & + & 0.29616e-07_r8,0.18927e-07_r8,0.18903e-07_r8,0.14917e-07_r8,0.25602e-07_r8 /) + kbo(:,33,10) = (/ & + & 0.22437e-07_r8,0.26260e-07_r8,0.17262e-07_r8,0.13354e-07_r8,0.18413e-07_r8 /) + kbo(:,34,10) = (/ & + & 0.15957e-07_r8,0.11226e-07_r8,0.16852e-07_r8,0.11987e-07_r8,0.14358e-07_r8 /) + kbo(:,35,10) = (/ & + & 0.11233e-07_r8,0.90736e-08_r8,0.13960e-07_r8,0.76472e-08_r8,0.11733e-07_r8 /) + kbo(:,36,10) = (/ & + & 0.13919e-07_r8,0.10081e-07_r8,0.10035e-07_r8,0.10345e-07_r8,0.10622e-07_r8 /) + kbo(:,37,10) = (/ & + & 0.76780e-08_r8,0.12331e-07_r8,0.10794e-07_r8,0.16023e-07_r8,0.11524e-07_r8 /) + kbo(:,38,10) = (/ & + & 0.65416e-08_r8,0.97484e-08_r8,0.12132e-07_r8,0.10472e-07_r8,0.11363e-07_r8 /) + kbo(:,39,10) = (/ & + & 0.78511e-08_r8,0.70392e-08_r8,0.91444e-08_r8,0.84352e-08_r8,0.95946e-08_r8 /) + kbo(:,40,10) = (/ & + & 0.81878e-08_r8,0.94957e-08_r8,0.84996e-08_r8,0.11246e-07_r8,0.13024e-07_r8 /) + kbo(:,41,10) = (/ & + & 0.65901e-08_r8,0.80717e-08_r8,0.78357e-08_r8,0.67309e-08_r8,0.85966e-08_r8 /) + kbo(:,42,10) = (/ & + & 0.64210e-08_r8,0.59979e-08_r8,0.56936e-08_r8,0.70018e-08_r8,0.70433e-08_r8 /) + kbo(:,43,10) = (/ & + & 0.40388e-08_r8,0.71452e-08_r8,0.63548e-08_r8,0.84902e-08_r8,0.75828e-08_r8 /) + kbo(:,44,10) = (/ & + & 0.39142e-08_r8,0.55915e-08_r8,0.49863e-08_r8,0.52254e-08_r8,0.62790e-08_r8 /) + kbo(:,45,10) = (/ & + & 0.42931e-08_r8,0.31608e-08_r8,0.46572e-08_r8,0.47490e-08_r8,0.59912e-08_r8 /) + kbo(:,46,10) = (/ & + & 0.38722e-08_r8,0.16146e-08_r8,0.40010e-08_r8,0.24242e-08_r8,0.45711e-08_r8 /) + kbo(:,47,10) = (/ & + & 0.14942e-08_r8,0.28671e-08_r8,0.27168e-08_r8,0.40090e-08_r8,0.42343e-08_r8 /) + kbo(:,48,10) = (/ & + & 0.11911e-08_r8,0.13582e-08_r8,0.26580e-08_r8,0.29275e-08_r8,0.17855e-08_r8 /) + kbo(:,49,10) = (/ & + & 0.14130e-08_r8,0.10553e-08_r8,0.10543e-08_r8,0.11428e-08_r8,0.14141e-08_r8 /) + kbo(:,50,10) = (/ & + & 0.12182e-08_r8,0.14973e-08_r8,0.13182e-08_r8,0.84197e-09_r8,0.12115e-08_r8 /) + kbo(:,51,10) = (/ & + & 0.81227e-09_r8,0.90496e-09_r8,0.77903e-09_r8,0.83007e-09_r8,0.86051e-09_r8 /) + kbo(:,52,10) = (/ & + & 0.96715e-09_r8,0.52504e-09_r8,0.42702e-09_r8,0.99435e-09_r8,0.91829e-09_r8 /) + kbo(:,53,10) = (/ & + & 0.37232e-09_r8,0.22359e-09_r8,0.89279e-09_r8,0.85173e-09_r8,0.51790e-09_r8 /) + kbo(:,54,10) = (/ & + & 0.34402e-09_r8,0.40116e-09_r8,0.54696e-09_r8,0.50848e-09_r8,0.53123e-09_r8 /) + kbo(:,55,10) = (/ & + & 0.66100e-09_r8,0.65370e-09_r8,0.58427e-09_r8,0.74840e-09_r8,0.49778e-09_r8 /) + kbo(:,56,10) = (/ & + & 0.43138e-09_r8,0.39155e-09_r8,0.52944e-09_r8,0.58374e-09_r8,0.77481e-09_r8 /) + kbo(:,57,10) = (/ & + & 0.48190e-09_r8,0.37726e-09_r8,0.54783e-09_r8,0.43462e-09_r8,0.46295e-09_r8 /) + kbo(:,58,10) = (/ & + & 0.42276e-09_r8,0.62831e-09_r8,0.68493e-09_r8,0.49089e-09_r8,0.43799e-09_r8 /) + kbo(:,59,10) = (/ & + & 0.37023e-09_r8,0.90764e-09_r8,0.36527e-09_r8,0.99235e-09_r8,0.10719e-08_r8 /) + kbo(:,13,11) = (/ & + & 0.15119e-04_r8,0.15135e-04_r8,0.15140e-04_r8,0.15181e-04_r8,0.15209e-04_r8 /) + kbo(:,14,11) = (/ & + & 0.12807e-04_r8,0.12837e-04_r8,0.12873e-04_r8,0.12938e-04_r8,0.12999e-04_r8 /) + kbo(:,15,11) = (/ & + & 0.10789e-04_r8,0.10839e-04_r8,0.10921e-04_r8,0.10986e-04_r8,0.11078e-04_r8 /) + kbo(:,16,11) = (/ & + & 0.90472e-05_r8,0.91077e-05_r8,0.91930e-05_r8,0.92812e-05_r8,0.93959e-05_r8 /) + kbo(:,17,11) = (/ & + & 0.74085e-05_r8,0.75116e-05_r8,0.76103e-05_r8,0.77238e-05_r8,0.78364e-05_r8 /) + kbo(:,18,11) = (/ & + & 0.47863e-05_r8,0.49607e-05_r8,0.51634e-05_r8,0.53824e-05_r8,0.55724e-05_r8 /) + kbo(:,19,11) = (/ & + & 0.17849e-05_r8,0.19797e-05_r8,0.21641e-05_r8,0.23597e-05_r8,0.26015e-05_r8 /) + kbo(:,20,11) = (/ & + & 0.14011e-06_r8,0.26424e-06_r8,0.39902e-06_r8,0.56382e-06_r8,0.75666e-06_r8 /) + kbo(:,21,11) = (/ & + & 0.32681e-07_r8,0.30855e-07_r8,0.23688e-07_r8,0.28954e-07_r8,0.30262e-07_r8 /) + kbo(:,22,11) = (/ & + & 0.39000e-07_r8,0.34641e-07_r8,0.36220e-07_r8,0.29230e-07_r8,0.25365e-07_r8 /) + kbo(:,23,11) = (/ & + & 0.39936e-07_r8,0.40586e-07_r8,0.26460e-07_r8,0.13886e-07_r8,0.18108e-07_r8 /) + kbo(:,24,11) = (/ & + & 0.34546e-07_r8,0.30818e-07_r8,0.33243e-07_r8,0.31408e-07_r8,0.37755e-07_r8 /) + kbo(:,25,11) = (/ & + & 0.36078e-07_r8,0.45586e-07_r8,0.18117e-07_r8,0.20176e-07_r8,0.46256e-07_r8 /) + kbo(:,26,11) = (/ & + & 0.61382e-07_r8,0.31185e-07_r8,0.38578e-07_r8,0.18908e-07_r8,0.43919e-07_r8 /) + kbo(:,27,11) = (/ & + & 0.37585e-07_r8,0.28323e-07_r8,0.45638e-07_r8,0.34261e-07_r8,0.26227e-07_r8 /) + kbo(:,28,11) = (/ & + & 0.41226e-07_r8,0.24793e-07_r8,0.23296e-07_r8,0.20952e-07_r8,0.27899e-07_r8 /) + kbo(:,29,11) = (/ & + & 0.21318e-07_r8,0.23768e-07_r8,0.39220e-07_r8,0.28896e-07_r8,0.15703e-07_r8 /) + kbo(:,30,11) = (/ & + & 0.25522e-07_r8,0.29485e-07_r8,0.39326e-07_r8,0.29293e-07_r8,0.36529e-07_r8 /) + kbo(:,31,11) = (/ & + & 0.14494e-07_r8,0.25417e-07_r8,0.13732e-07_r8,0.97827e-08_r8,0.20014e-07_r8 /) + kbo(:,32,11) = (/ & + & 0.14101e-07_r8,0.26239e-07_r8,0.22312e-07_r8,0.10163e-07_r8,0.17547e-07_r8 /) + kbo(:,33,11) = (/ & + & 0.17347e-07_r8,0.17261e-07_r8,0.13014e-07_r8,0.21130e-07_r8,0.31576e-08_r8 /) + kbo(:,34,11) = (/ & + & 0.11923e-07_r8,0.13818e-07_r8,0.14692e-07_r8,0.14120e-07_r8,0.12000e-07_r8 /) + kbo(:,35,11) = (/ & + & 0.86917e-08_r8,0.10083e-07_r8,0.11872e-07_r8,0.58578e-08_r8,0.13194e-07_r8 /) + kbo(:,36,11) = (/ & + & 0.74538e-08_r8,0.94606e-08_r8,0.85633e-08_r8,0.15394e-07_r8,0.81997e-08_r8 /) + kbo(:,37,11) = (/ & + & 0.59982e-08_r8,0.58805e-08_r8,0.92255e-08_r8,0.69472e-08_r8,0.63632e-08_r8 /) + kbo(:,38,11) = (/ & + & 0.75481e-08_r8,0.82094e-08_r8,0.10405e-07_r8,0.62921e-08_r8,0.70021e-08_r8 /) + kbo(:,39,11) = (/ & + & 0.65770e-08_r8,0.73715e-08_r8,0.70899e-08_r8,0.49884e-08_r8,0.73567e-08_r8 /) + kbo(:,40,11) = (/ & + & 0.62200e-08_r8,0.79227e-08_r8,0.65710e-08_r8,0.35793e-08_r8,0.48653e-08_r8 /) + kbo(:,41,11) = (/ & + & 0.67810e-08_r8,0.64933e-08_r8,0.26651e-08_r8,0.71067e-08_r8,0.42136e-08_r8 /) + kbo(:,42,11) = (/ & + & 0.32351e-08_r8,0.79993e-08_r8,0.25727e-08_r8,0.70581e-08_r8,0.58932e-08_r8 /) + kbo(:,43,11) = (/ & + & 0.54331e-08_r8,0.21653e-08_r8,0.69372e-08_r8,0.30142e-08_r8,0.23071e-07_r8 /) + kbo(:,44,11) = (/ & + & 0.26834e-08_r8,0.43047e-08_r8,0.44246e-08_r8,0.29474e-08_r8,0.52315e-07_r8 /) + kbo(:,45,11) = (/ & + & 0.22521e-08_r8,0.21920e-08_r8,0.35952e-08_r8,0.29799e-08_r8,0.81164e-07_r8 /) + kbo(:,46,11) = (/ & + & 0.28580e-08_r8,0.12605e-08_r8,0.64390e-09_r8,0.24255e-07_r8,0.96879e-07_r8 /) + kbo(:,47,11) = (/ & + & 0.13005e-08_r8,0.17967e-08_r8,0.21618e-08_r8,0.30225e-07_r8,0.10319e-06_r8 /) + kbo(:,48,11) = (/ & + & 0.13676e-08_r8,0.96043e-09_r8,0.14275e-08_r8,0.39735e-07_r8,0.11261e-06_r8 /) + kbo(:,49,11) = (/ & + & 0.79619e-09_r8,0.85338e-09_r8,0.14300e-08_r8,0.51821e-07_r8,0.12169e-06_r8 /) + kbo(:,50,11) = (/ & + & 0.49284e-09_r8,0.21801e-09_r8,0.75017e-08_r8,0.50308e-07_r8,0.11953e-06_r8 /) + kbo(:,51,11) = (/ & + & 0.51956e-09_r8,0.59927e-09_r8,0.87276e-08_r8,0.45028e-07_r8,0.11141e-06_r8 /) + kbo(:,52,11) = (/ & + & 0.35814e-09_r8,0.78982e-09_r8,0.10205e-07_r8,0.45574e-07_r8,0.10332e-06_r8 /) + kbo(:,53,11) = (/ & + & 0.69729e-09_r8,0.23757e-09_r8,0.11741e-07_r8,0.45086e-07_r8,0.98023e-07_r8 /) + kbo(:,54,11) = (/ & + & 0.38203e-09_r8,0.28792e-09_r8,0.72239e-08_r8,0.35770e-07_r8,0.80771e-07_r8 /) + kbo(:,55,11) = (/ & + & 0.33870e-09_r8,0.39698e-09_r8,0.15883e-08_r8,0.22568e-07_r8,0.61465e-07_r8 /) + kbo(:,56,11) = (/ & + & 0.50424e-09_r8,0.25383e-09_r8,0.46226e-09_r8,0.12214e-07_r8,0.43776e-07_r8 /) + kbo(:,57,11) = (/ & + & 0.18824e-09_r8,0.14340e-09_r8,0.96547e-10_r8,0.36771e-08_r8,0.28437e-07_r8 /) + kbo(:,58,11) = (/ & + & 0.53960e-09_r8,0.71198e-09_r8,0.40290e-09_r8,0.38600e-09_r8,0.14449e-07_r8 /) + kbo(:,59,11) = (/ & + & 0.64570e-09_r8,0.80856e-09_r8,0.54439e-09_r8,0.66021e-09_r8,0.28306e-09_r8 /) + kbo(:,13,12) = (/ & + & 0.35137e-04_r8,0.35315e-04_r8,0.35473e-04_r8,0.35691e-04_r8,0.35953e-04_r8 /) + kbo(:,14,12) = (/ & + & 0.30387e-04_r8,0.30535e-04_r8,0.30693e-04_r8,0.30906e-04_r8,0.31121e-04_r8 /) + kbo(:,15,12) = (/ & + & 0.26404e-04_r8,0.26560e-04_r8,0.26776e-04_r8,0.26963e-04_r8,0.27157e-04_r8 /) + kbo(:,16,12) = (/ & + & 0.22908e-04_r8,0.23161e-04_r8,0.23420e-04_r8,0.23636e-04_r8,0.23864e-04_r8 /) + kbo(:,17,12) = (/ & + & 0.19849e-04_r8,0.20170e-04_r8,0.20453e-04_r8,0.20723e-04_r8,0.21011e-04_r8 /) + kbo(:,18,12) = (/ & + & 0.17158e-04_r8,0.17516e-04_r8,0.17820e-04_r8,0.18149e-04_r8,0.18467e-04_r8 /) + kbo(:,19,12) = (/ & + & 0.14706e-04_r8,0.15074e-04_r8,0.15426e-04_r8,0.15809e-04_r8,0.16128e-04_r8 /) + kbo(:,20,12) = (/ & + & 0.12200e-04_r8,0.12654e-04_r8,0.13122e-04_r8,0.13561e-04_r8,0.13942e-04_r8 /) + kbo(:,21,12) = (/ & + & 0.88744e-05_r8,0.95294e-05_r8,0.10194e-04_r8,0.10811e-04_r8,0.11447e-04_r8 /) + kbo(:,22,12) = (/ & + & 0.63063e-05_r8,0.69160e-05_r8,0.75170e-05_r8,0.81696e-05_r8,0.87829e-05_r8 /) + kbo(:,23,12) = (/ & + & 0.42549e-05_r8,0.48576e-05_r8,0.54224e-05_r8,0.60649e-05_r8,0.65852e-05_r8 /) + kbo(:,24,12) = (/ & + & 0.26155e-05_r8,0.31537e-05_r8,0.36816e-05_r8,0.42795e-05_r8,0.47356e-05_r8 /) + kbo(:,25,12) = (/ & + & 0.14576e-05_r8,0.18762e-05_r8,0.23875e-05_r8,0.29308e-05_r8,0.33846e-05_r8 /) + kbo(:,26,12) = (/ & + & 0.67369e-06_r8,0.10096e-05_r8,0.14730e-05_r8,0.19592e-05_r8,0.24356e-05_r8 /) + kbo(:,27,12) = (/ & + & 0.27240e-06_r8,0.59733e-06_r8,0.98553e-06_r8,0.13968e-05_r8,0.18466e-05_r8 /) + kbo(:,28,12) = (/ & + & 0.81179e-07_r8,0.35063e-06_r8,0.74692e-06_r8,0.11081e-05_r8,0.15613e-05_r8 /) + kbo(:,29,12) = (/ & + & 0.94800e-07_r8,0.40513e-06_r8,0.73547e-06_r8,0.10914e-05_r8,0.16188e-05_r8 /) + kbo(:,30,12) = (/ & + & 0.19045e-06_r8,0.51192e-06_r8,0.80594e-06_r8,0.12694e-05_r8,0.16954e-05_r8 /) + kbo(:,31,12) = (/ & + & 0.38493e-06_r8,0.71230e-06_r8,0.11392e-05_r8,0.15875e-05_r8,0.20565e-05_r8 /) + kbo(:,32,12) = (/ & + & 0.61444e-06_r8,0.97779e-06_r8,0.14257e-05_r8,0.18883e-05_r8,0.26649e-05_r8 /) + kbo(:,33,12) = (/ & + & 0.84230e-06_r8,0.12390e-05_r8,0.17304e-05_r8,0.23322e-05_r8,0.32859e-05_r8 /) + kbo(:,34,12) = (/ & + & 0.10458e-05_r8,0.14709e-05_r8,0.19634e-05_r8,0.28004e-05_r8,0.37724e-05_r8 /) + kbo(:,35,12) = (/ & + & 0.11901e-05_r8,0.16306e-05_r8,0.22411e-05_r8,0.31089e-05_r8,0.41007e-05_r8 /) + kbo(:,36,12) = (/ & + & 0.12859e-05_r8,0.17604e-05_r8,0.24414e-05_r8,0.32964e-05_r8,0.43267e-05_r8 /) + kbo(:,37,12) = (/ & + & 0.13015e-05_r8,0.17577e-05_r8,0.24562e-05_r8,0.33117e-05_r8,0.43238e-05_r8 /) + kbo(:,38,12) = (/ & + & 0.13522e-05_r8,0.18247e-05_r8,0.25116e-05_r8,0.33483e-05_r8,0.43352e-05_r8 /) + kbo(:,39,12) = (/ & + & 0.14322e-05_r8,0.19336e-05_r8,0.26107e-05_r8,0.34258e-05_r8,0.44158e-05_r8 /) + kbo(:,40,12) = (/ & + & 0.14006e-05_r8,0.18728e-05_r8,0.25304e-05_r8,0.33179e-05_r8,0.42738e-05_r8 /) + kbo(:,41,12) = (/ & + & 0.13551e-05_r8,0.18012e-05_r8,0.24357e-05_r8,0.32084e-05_r8,0.41141e-05_r8 /) + kbo(:,42,12) = (/ & + & 0.13297e-05_r8,0.17512e-05_r8,0.23561e-05_r8,0.30946e-05_r8,0.39665e-05_r8 /) + kbo(:,43,12) = (/ & + & 0.12687e-05_r8,0.16768e-05_r8,0.22464e-05_r8,0.29540e-05_r8,0.37527e-05_r8 /) + kbo(:,44,12) = (/ & + & 0.12099e-05_r8,0.15968e-05_r8,0.21385e-05_r8,0.28006e-05_r8,0.35240e-05_r8 /) + kbo(:,45,12) = (/ & + & 0.11534e-05_r8,0.15243e-05_r8,0.20279e-05_r8,0.26581e-05_r8,0.33062e-05_r8 /) + kbo(:,46,12) = (/ & + & 0.10898e-05_r8,0.14434e-05_r8,0.19097e-05_r8,0.24739e-05_r8,0.30807e-05_r8 /) + kbo(:,47,12) = (/ & + & 0.10111e-05_r8,0.13412e-05_r8,0.17607e-05_r8,0.22724e-05_r8,0.28391e-05_r8 /) + kbo(:,48,12) = (/ & + & 0.92540e-06_r8,0.12447e-05_r8,0.16295e-05_r8,0.20863e-05_r8,0.26097e-05_r8 /) + kbo(:,49,12) = (/ & + & 0.84684e-06_r8,0.11506e-05_r8,0.15141e-05_r8,0.19160e-05_r8,0.23957e-05_r8 /) + kbo(:,50,12) = (/ & + & 0.76391e-06_r8,0.10519e-05_r8,0.13910e-05_r8,0.17635e-05_r8,0.22060e-05_r8 /) + kbo(:,51,12) = (/ & + & 0.68139e-06_r8,0.95640e-06_r8,0.12771e-05_r8,0.16252e-05_r8,0.20363e-05_r8 /) + kbo(:,52,12) = (/ & + & 0.60392e-06_r8,0.86706e-06_r8,0.11671e-05_r8,0.14940e-05_r8,0.18793e-05_r8 /) + kbo(:,53,12) = (/ & + & 0.53856e-06_r8,0.78259e-06_r8,0.10620e-05_r8,0.13737e-05_r8,0.17330e-05_r8 /) + kbo(:,54,12) = (/ & + & 0.46919e-06_r8,0.69589e-06_r8,0.96582e-06_r8,0.12666e-05_r8,0.16070e-05_r8 /) + kbo(:,55,12) = (/ & + & 0.40013e-06_r8,0.61215e-06_r8,0.87450e-06_r8,0.11663e-05_r8,0.14929e-05_r8 /) + kbo(:,56,12) = (/ & + & 0.33987e-06_r8,0.53286e-06_r8,0.78520e-06_r8,0.10697e-05_r8,0.13857e-05_r8 /) + kbo(:,57,12) = (/ & + & 0.28415e-06_r8,0.45936e-06_r8,0.69784e-06_r8,0.97544e-06_r8,0.12829e-05_r8 /) + kbo(:,58,12) = (/ & + & 0.23457e-06_r8,0.39019e-06_r8,0.61528e-06_r8,0.88439e-06_r8,0.11866e-05_r8 /) + kbo(:,59,12) = (/ & + & 0.19576e-06_r8,0.34385e-06_r8,0.56055e-06_r8,0.82347e-06_r8,0.11274e-05_r8 /) + kbo(:,13,13) = (/ & + & 0.12143e-03_r8,0.12308e-03_r8,0.12512e-03_r8,0.12699e-03_r8,0.12910e-03_r8 /) + kbo(:,14,13) = (/ & + & 0.10385e-03_r8,0.10569e-03_r8,0.10770e-03_r8,0.10972e-03_r8,0.11214e-03_r8 /) + kbo(:,15,13) = (/ & + & 0.88944e-04_r8,0.90837e-04_r8,0.92688e-04_r8,0.94910e-04_r8,0.97472e-04_r8 /) + kbo(:,16,13) = (/ & + & 0.76542e-04_r8,0.78268e-04_r8,0.80179e-04_r8,0.82469e-04_r8,0.84734e-04_r8 /) + kbo(:,17,13) = (/ & + & 0.66332e-04_r8,0.67885e-04_r8,0.69742e-04_r8,0.71831e-04_r8,0.74034e-04_r8 /) + kbo(:,18,13) = (/ & + & 0.57811e-04_r8,0.59251e-04_r8,0.61096e-04_r8,0.62954e-04_r8,0.65175e-04_r8 /) + kbo(:,19,13) = (/ & + & 0.50669e-04_r8,0.52124e-04_r8,0.53790e-04_r8,0.55608e-04_r8,0.57861e-04_r8 /) + kbo(:,20,13) = (/ & + & 0.44810e-04_r8,0.46258e-04_r8,0.47774e-04_r8,0.49573e-04_r8,0.51715e-04_r8 /) + kbo(:,21,13) = (/ & + & 0.40009e-04_r8,0.41361e-04_r8,0.42755e-04_r8,0.44560e-04_r8,0.46559e-04_r8 /) + kbo(:,22,13) = (/ & + & 0.36116e-04_r8,0.37297e-04_r8,0.38718e-04_r8,0.40472e-04_r8,0.42441e-04_r8 /) + kbo(:,23,13) = (/ & + & 0.32736e-04_r8,0.33861e-04_r8,0.35361e-04_r8,0.37075e-04_r8,0.39134e-04_r8 /) + kbo(:,24,13) = (/ & + & 0.29883e-04_r8,0.31056e-04_r8,0.32552e-04_r8,0.34296e-04_r8,0.36499e-04_r8 /) + kbo(:,25,13) = (/ & + & 0.27373e-04_r8,0.28693e-04_r8,0.30179e-04_r8,0.32033e-04_r8,0.34358e-04_r8 /) + kbo(:,26,13) = (/ & + & 0.25273e-04_r8,0.26749e-04_r8,0.28306e-04_r8,0.30341e-04_r8,0.32793e-04_r8 /) + kbo(:,27,13) = (/ & + & 0.23652e-04_r8,0.25175e-04_r8,0.26905e-04_r8,0.29145e-04_r8,0.31814e-04_r8 /) + kbo(:,28,13) = (/ & + & 0.22453e-04_r8,0.24077e-04_r8,0.26031e-04_r8,0.28419e-04_r8,0.31259e-04_r8 /) + kbo(:,29,13) = (/ & + & 0.21794e-04_r8,0.23553e-04_r8,0.25672e-04_r8,0.28266e-04_r8,0.31243e-04_r8 /) + kbo(:,30,13) = (/ & + & 0.21501e-04_r8,0.23414e-04_r8,0.25687e-04_r8,0.28389e-04_r8,0.31547e-04_r8 /) + kbo(:,31,13) = (/ & + & 0.21532e-04_r8,0.23577e-04_r8,0.25947e-04_r8,0.28793e-04_r8,0.32070e-04_r8 /) + kbo(:,32,13) = (/ & + & 0.21702e-04_r8,0.23850e-04_r8,0.26365e-04_r8,0.29337e-04_r8,0.32730e-04_r8 /) + kbo(:,33,13) = (/ & + & 0.21999e-04_r8,0.24243e-04_r8,0.26895e-04_r8,0.29970e-04_r8,0.33492e-04_r8 /) + kbo(:,34,13) = (/ & + & 0.22272e-04_r8,0.24615e-04_r8,0.27365e-04_r8,0.30535e-04_r8,0.34149e-04_r8 /) + kbo(:,35,13) = (/ & + & 0.22408e-04_r8,0.24786e-04_r8,0.27609e-04_r8,0.30838e-04_r8,0.34518e-04_r8 /) + kbo(:,36,13) = (/ & + & 0.22324e-04_r8,0.24717e-04_r8,0.27535e-04_r8,0.30781e-04_r8,0.34466e-04_r8 /) + kbo(:,37,13) = (/ & + & 0.21914e-04_r8,0.24278e-04_r8,0.27037e-04_r8,0.30223e-04_r8,0.33847e-04_r8 /) + kbo(:,38,13) = (/ & + & 0.21518e-04_r8,0.23846e-04_r8,0.26529e-04_r8,0.29664e-04_r8,0.33219e-04_r8 /) + kbo(:,39,13) = (/ & + & 0.21138e-04_r8,0.23443e-04_r8,0.26064e-04_r8,0.29132e-04_r8,0.32628e-04_r8 /) + kbo(:,40,13) = (/ & + & 0.20535e-04_r8,0.22813e-04_r8,0.25328e-04_r8,0.28289e-04_r8,0.31682e-04_r8 /) + kbo(:,41,13) = (/ & + & 0.19918e-04_r8,0.22174e-04_r8,0.24598e-04_r8,0.27447e-04_r8,0.30722e-04_r8 /) + kbo(:,42,13) = (/ & + & 0.19309e-04_r8,0.21550e-04_r8,0.23909e-04_r8,0.26639e-04_r8,0.29801e-04_r8 /) + kbo(:,43,13) = (/ & + & 0.18566e-04_r8,0.20812e-04_r8,0.23112e-04_r8,0.25700e-04_r8,0.28732e-04_r8 /) + kbo(:,44,13) = (/ & + & 0.17767e-04_r8,0.20035e-04_r8,0.22299e-04_r8,0.24756e-04_r8,0.27639e-04_r8 /) + kbo(:,45,13) = (/ & + & 0.16962e-04_r8,0.19260e-04_r8,0.21500e-04_r8,0.23864e-04_r8,0.26597e-04_r8 /) + kbo(:,46,13) = (/ & + & 0.16086e-04_r8,0.18421e-04_r8,0.20671e-04_r8,0.22972e-04_r8,0.25545e-04_r8 /) + kbo(:,47,13) = (/ & + & 0.15115e-04_r8,0.17481e-04_r8,0.19766e-04_r8,0.22019e-04_r8,0.24442e-04_r8 /) + kbo(:,48,13) = (/ & + & 0.14158e-04_r8,0.16526e-04_r8,0.18843e-04_r8,0.21088e-04_r8,0.23419e-04_r8 /) + kbo(:,49,13) = (/ & + & 0.13195e-04_r8,0.15552e-04_r8,0.17911e-04_r8,0.20179e-04_r8,0.22454e-04_r8 /) + kbo(:,50,13) = (/ & + & 0.12314e-04_r8,0.14653e-04_r8,0.17032e-04_r8,0.19326e-04_r8,0.21576e-04_r8 /) + kbo(:,51,13) = (/ & + & 0.11480e-04_r8,0.13788e-04_r8,0.16154e-04_r8,0.18484e-04_r8,0.20739e-04_r8 /) + kbo(:,52,13) = (/ & + & 0.10629e-04_r8,0.12922e-04_r8,0.15279e-04_r8,0.17642e-04_r8,0.19921e-04_r8 /) + kbo(:,53,13) = (/ & + & 0.97710e-05_r8,0.12082e-04_r8,0.14410e-04_r8,0.16788e-04_r8,0.19091e-04_r8 /) + kbo(:,54,13) = (/ & + & 0.90074e-05_r8,0.11316e-04_r8,0.13617e-04_r8,0.15981e-04_r8,0.18321e-04_r8 /) + kbo(:,55,13) = (/ & + & 0.83042e-05_r8,0.10569e-04_r8,0.12859e-04_r8,0.15214e-04_r8,0.17581e-04_r8 /) + kbo(:,56,13) = (/ & + & 0.76202e-05_r8,0.98296e-05_r8,0.12125e-04_r8,0.14457e-04_r8,0.16835e-04_r8 /) + kbo(:,57,13) = (/ & + & 0.69561e-05_r8,0.91024e-05_r8,0.11398e-04_r8,0.13700e-04_r8,0.16068e-04_r8 /) + kbo(:,58,13) = (/ & + & 0.63426e-05_r8,0.84347e-05_r8,0.10695e-04_r8,0.12984e-04_r8,0.15340e-04_r8 /) + kbo(:,59,13) = (/ & + & 0.61056e-05_r8,0.81719e-05_r8,0.10410e-04_r8,0.12698e-04_r8,0.15054e-04_r8 /) + kbo(:,13,14) = (/ & + & 0.69692e-03_r8,0.71516e-03_r8,0.73378e-03_r8,0.75443e-03_r8,0.77716e-03_r8 /) + kbo(:,14,14) = (/ & + & 0.64436e-03_r8,0.66211e-03_r8,0.68199e-03_r8,0.70460e-03_r8,0.72891e-03_r8 /) + kbo(:,15,14) = (/ & + & 0.59775e-03_r8,0.61618e-03_r8,0.63785e-03_r8,0.66198e-03_r8,0.68803e-03_r8 /) + kbo(:,16,14) = (/ & + & 0.55668e-03_r8,0.57752e-03_r8,0.60052e-03_r8,0.62615e-03_r8,0.65391e-03_r8 /) + kbo(:,17,14) = (/ & + & 0.52104e-03_r8,0.54458e-03_r8,0.56934e-03_r8,0.59627e-03_r8,0.62539e-03_r8 /) + kbo(:,18,14) = (/ & + & 0.49086e-03_r8,0.51685e-03_r8,0.54337e-03_r8,0.57147e-03_r8,0.60182e-03_r8 /) + kbo(:,19,14) = (/ & + & 0.46544e-03_r8,0.49373e-03_r8,0.52192e-03_r8,0.55124e-03_r8,0.58277e-03_r8 /) + kbo(:,20,14) = (/ & + & 0.44496e-03_r8,0.47526e-03_r8,0.50494e-03_r8,0.53564e-03_r8,0.56857e-03_r8 /) + kbo(:,21,14) = (/ & + & 0.42855e-03_r8,0.46070e-03_r8,0.49202e-03_r8,0.52375e-03_r8,0.55795e-03_r8 /) + kbo(:,22,14) = (/ & + & 0.41783e-03_r8,0.45160e-03_r8,0.48421e-03_r8,0.51739e-03_r8,0.55269e-03_r8 /) + kbo(:,23,14) = (/ & + & 0.41085e-03_r8,0.44564e-03_r8,0.47947e-03_r8,0.51389e-03_r8,0.55016e-03_r8 /) + kbo(:,24,14) = (/ & + & 0.40699e-03_r8,0.44263e-03_r8,0.47766e-03_r8,0.51290e-03_r8,0.55008e-03_r8 /) + kbo(:,25,14) = (/ & + & 0.40592e-03_r8,0.44215e-03_r8,0.47812e-03_r8,0.51419e-03_r8,0.55216e-03_r8 /) + kbo(:,26,14) = (/ & + & 0.40741e-03_r8,0.44425e-03_r8,0.48085e-03_r8,0.51770e-03_r8,0.55654e-03_r8 /) + kbo(:,27,14) = (/ & + & 0.41074e-03_r8,0.44811e-03_r8,0.48506e-03_r8,0.52264e-03_r8,0.56211e-03_r8 /) + kbo(:,28,14) = (/ & + & 0.41538e-03_r8,0.45333e-03_r8,0.49042e-03_r8,0.52868e-03_r8,0.56877e-03_r8 /) + kbo(:,29,14) = (/ & + & 0.42139e-03_r8,0.45956e-03_r8,0.49700e-03_r8,0.53588e-03_r8,0.57647e-03_r8 /) + kbo(:,30,14) = (/ & + & 0.42836e-03_r8,0.46659e-03_r8,0.50435e-03_r8,0.54377e-03_r8,0.58489e-03_r8 /) + kbo(:,31,14) = (/ & + & 0.43618e-03_r8,0.47431e-03_r8,0.51248e-03_r8,0.55256e-03_r8,0.59401e-03_r8 /) + kbo(:,32,14) = (/ & + & 0.44466e-03_r8,0.48256e-03_r8,0.52138e-03_r8,0.56187e-03_r8,0.60364e-03_r8 /) + kbo(:,33,14) = (/ & + & 0.45349e-03_r8,0.49137e-03_r8,0.53076e-03_r8,0.57166e-03_r8,0.61359e-03_r8 /) + kbo(:,34,14) = (/ & + & 0.46108e-03_r8,0.49922e-03_r8,0.53902e-03_r8,0.58028e-03_r8,0.62237e-03_r8 /) + kbo(:,35,14) = (/ & + & 0.46528e-03_r8,0.50354e-03_r8,0.54368e-03_r8,0.58501e-03_r8,0.62724e-03_r8 /) + kbo(:,36,14) = (/ & + & 0.46539e-03_r8,0.50375e-03_r8,0.54391e-03_r8,0.58538e-03_r8,0.62763e-03_r8 /) + kbo(:,37,14) = (/ & + & 0.45984e-03_r8,0.49817e-03_r8,0.53806e-03_r8,0.57948e-03_r8,0.62153e-03_r8 /) + kbo(:,38,14) = (/ & + & 0.45408e-03_r8,0.49229e-03_r8,0.53205e-03_r8,0.57322e-03_r8,0.61533e-03_r8 /) + kbo(:,39,14) = (/ & + & 0.44837e-03_r8,0.48652e-03_r8,0.52604e-03_r8,0.56712e-03_r8,0.60916e-03_r8 /) + kbo(:,40,14) = (/ & + & 0.43865e-03_r8,0.47705e-03_r8,0.51607e-03_r8,0.55678e-03_r8,0.59870e-03_r8 /) + kbo(:,41,14) = (/ & + & 0.42850e-03_r8,0.46708e-03_r8,0.50578e-03_r8,0.54611e-03_r8,0.58790e-03_r8 /) + kbo(:,42,14) = (/ & + & 0.41832e-03_r8,0.45718e-03_r8,0.49552e-03_r8,0.53551e-03_r8,0.57688e-03_r8 /) + kbo(:,43,14) = (/ & + & 0.40611e-03_r8,0.44501e-03_r8,0.48328e-03_r8,0.52271e-03_r8,0.56375e-03_r8 /) + kbo(:,44,14) = (/ & + & 0.39281e-03_r8,0.43169e-03_r8,0.47025e-03_r8,0.50904e-03_r8,0.54960e-03_r8 /) + kbo(:,45,14) = (/ & + & 0.37939e-03_r8,0.41841e-03_r8,0.45722e-03_r8,0.49565e-03_r8,0.53564e-03_r8 /) + kbo(:,46,14) = (/ & + & 0.36481e-03_r8,0.40443e-03_r8,0.44334e-03_r8,0.48171e-03_r8,0.52104e-03_r8 /) + kbo(:,47,14) = (/ & + & 0.34813e-03_r8,0.38867e-03_r8,0.42754e-03_r8,0.46626e-03_r8,0.50489e-03_r8 /) + kbo(:,48,14) = (/ & + & 0.33101e-03_r8,0.37257e-03_r8,0.41188e-03_r8,0.45078e-03_r8,0.48906e-03_r8 /) + kbo(:,49,14) = (/ & + & 0.31369e-03_r8,0.35613e-03_r8,0.39621e-03_r8,0.43508e-03_r8,0.47354e-03_r8 /) + kbo(:,50,14) = (/ & + & 0.29739e-03_r8,0.34030e-03_r8,0.38132e-03_r8,0.42035e-03_r8,0.45918e-03_r8 /) + kbo(:,51,14) = (/ & + & 0.28140e-03_r8,0.32461e-03_r8,0.36662e-03_r8,0.40619e-03_r8,0.44511e-03_r8 /) + kbo(:,52,14) = (/ & + & 0.26563e-03_r8,0.30898e-03_r8,0.35161e-03_r8,0.39193e-03_r8,0.43080e-03_r8 /) + kbo(:,53,14) = (/ & + & 0.24997e-03_r8,0.29311e-03_r8,0.33618e-03_r8,0.37741e-03_r8,0.41655e-03_r8 /) + kbo(:,54,14) = (/ & + & 0.23534e-03_r8,0.27846e-03_r8,0.32175e-03_r8,0.36391e-03_r8,0.40359e-03_r8 /) + kbo(:,55,14) = (/ & + & 0.22140e-03_r8,0.26468e-03_r8,0.30799e-03_r8,0.35062e-03_r8,0.39107e-03_r8 /) + kbo(:,56,14) = (/ & + & 0.20748e-03_r8,0.25097e-03_r8,0.29409e-03_r8,0.33714e-03_r8,0.37835e-03_r8 /) + kbo(:,57,14) = (/ & + & 0.19363e-03_r8,0.23702e-03_r8,0.28013e-03_r8,0.32339e-03_r8,0.36545e-03_r8 /) + kbo(:,58,14) = (/ & + & 0.18066e-03_r8,0.22379e-03_r8,0.26710e-03_r8,0.31040e-03_r8,0.35295e-03_r8 /) + kbo(:,59,14) = (/ & + & 0.17550e-03_r8,0.21855e-03_r8,0.26188e-03_r8,0.30515e-03_r8,0.34793e-03_r8 /) + kbo(:,13,15) = (/ & + & 0.67077e-02_r8,0.67643e-02_r8,0.68102e-02_r8,0.68432e-02_r8,0.68617e-02_r8 /) + kbo(:,14,15) = (/ & + & 0.68112e-02_r8,0.68842e-02_r8,0.69413e-02_r8,0.69806e-02_r8,0.70063e-02_r8 /) + kbo(:,15,15) = (/ & + & 0.68961e-02_r8,0.69833e-02_r8,0.70488e-02_r8,0.70965e-02_r8,0.71269e-02_r8 /) + kbo(:,16,15) = (/ & + & 0.69706e-02_r8,0.70648e-02_r8,0.71387e-02_r8,0.71925e-02_r8,0.72279e-02_r8 /) + kbo(:,17,15) = (/ & + & 0.70342e-02_r8,0.71339e-02_r8,0.72130e-02_r8,0.72737e-02_r8,0.73138e-02_r8 /) + kbo(:,18,15) = (/ & + & 0.70890e-02_r8,0.71933e-02_r8,0.72776e-02_r8,0.73426e-02_r8,0.73856e-02_r8 /) + kbo(:,19,15) = (/ & + & 0.71380e-02_r8,0.72441e-02_r8,0.73326e-02_r8,0.74006e-02_r8,0.74464e-02_r8 /) + kbo(:,20,15) = (/ & + & 0.71838e-02_r8,0.72907e-02_r8,0.73816e-02_r8,0.74514e-02_r8,0.74969e-02_r8 /) + kbo(:,21,15) = (/ & + & 0.72239e-02_r8,0.73326e-02_r8,0.74235e-02_r8,0.74941e-02_r8,0.75405e-02_r8 /) + kbo(:,22,15) = (/ & + & 0.72699e-02_r8,0.73767e-02_r8,0.74650e-02_r8,0.75340e-02_r8,0.75785e-02_r8 /) + kbo(:,23,15) = (/ & + & 0.73111e-02_r8,0.74172e-02_r8,0.75033e-02_r8,0.75687e-02_r8,0.76113e-02_r8 /) + kbo(:,24,15) = (/ & + & 0.73510e-02_r8,0.74537e-02_r8,0.75371e-02_r8,0.76008e-02_r8,0.76395e-02_r8 /) + kbo(:,25,15) = (/ & + & 0.73875e-02_r8,0.74885e-02_r8,0.75684e-02_r8,0.76282e-02_r8,0.76634e-02_r8 /) + kbo(:,26,15) = (/ & + & 0.74256e-02_r8,0.75226e-02_r8,0.75985e-02_r8,0.76530e-02_r8,0.76835e-02_r8 /) + kbo(:,27,15) = (/ & + & 0.74605e-02_r8,0.75517e-02_r8,0.76248e-02_r8,0.76742e-02_r8,0.77008e-02_r8 /) + kbo(:,28,15) = (/ & + & 0.74927e-02_r8,0.75800e-02_r8,0.76483e-02_r8,0.76927e-02_r8,0.77139e-02_r8 /) + kbo(:,29,15) = (/ & + & 0.75244e-02_r8,0.76057e-02_r8,0.76690e-02_r8,0.77086e-02_r8,0.77249e-02_r8 /) + kbo(:,30,15) = (/ & + & 0.75518e-02_r8,0.76303e-02_r8,0.76877e-02_r8,0.77209e-02_r8,0.77334e-02_r8 /) + kbo(:,31,15) = (/ & + & 0.75781e-02_r8,0.76519e-02_r8,0.77036e-02_r8,0.77320e-02_r8,0.77395e-02_r8 /) + kbo(:,32,15) = (/ & + & 0.76025e-02_r8,0.76727e-02_r8,0.77178e-02_r8,0.77409e-02_r8,0.77439e-02_r8 /) + kbo(:,33,15) = (/ & + & 0.76266e-02_r8,0.76908e-02_r8,0.77289e-02_r8,0.77461e-02_r8,0.77464e-02_r8 /) + kbo(:,34,15) = (/ & + & 0.76450e-02_r8,0.77038e-02_r8,0.77387e-02_r8,0.77507e-02_r8,0.77465e-02_r8 /) + kbo(:,35,15) = (/ & + & 0.76558e-02_r8,0.77117e-02_r8,0.77433e-02_r8,0.77536e-02_r8,0.77475e-02_r8 /) + kbo(:,36,15) = (/ & + & 0.76587e-02_r8,0.77150e-02_r8,0.77452e-02_r8,0.77564e-02_r8,0.77495e-02_r8 /) + kbo(:,37,15) = (/ & + & 0.76522e-02_r8,0.77109e-02_r8,0.77439e-02_r8,0.77579e-02_r8,0.77534e-02_r8 /) + kbo(:,38,15) = (/ & + & 0.76429e-02_r8,0.77056e-02_r8,0.77426e-02_r8,0.77582e-02_r8,0.77560e-02_r8 /) + kbo(:,39,15) = (/ & + & 0.76339e-02_r8,0.76993e-02_r8,0.77402e-02_r8,0.77587e-02_r8,0.77588e-02_r8 /) + kbo(:,40,15) = (/ & + & 0.76166e-02_r8,0.76865e-02_r8,0.77335e-02_r8,0.77564e-02_r8,0.77613e-02_r8 /) + kbo(:,41,15) = (/ & + & 0.75961e-02_r8,0.76706e-02_r8,0.77239e-02_r8,0.77534e-02_r8,0.77621e-02_r8 /) + kbo(:,42,15) = (/ & + & 0.75752e-02_r8,0.76537e-02_r8,0.77143e-02_r8,0.77487e-02_r8,0.77622e-02_r8 /) + kbo(:,43,15) = (/ & + & 0.75459e-02_r8,0.76317e-02_r8,0.76988e-02_r8,0.77406e-02_r8,0.77602e-02_r8 /) + kbo(:,44,15) = (/ & + & 0.75134e-02_r8,0.76061e-02_r8,0.76788e-02_r8,0.77299e-02_r8,0.77567e-02_r8 /) + kbo(:,45,15) = (/ & + & 0.74772e-02_r8,0.75773e-02_r8,0.76562e-02_r8,0.77161e-02_r8,0.77502e-02_r8 /) + kbo(:,46,15) = (/ & + & 0.74372e-02_r8,0.75438e-02_r8,0.76298e-02_r8,0.76975e-02_r8,0.77405e-02_r8 /) + kbo(:,47,15) = (/ & + & 0.73875e-02_r8,0.75032e-02_r8,0.75980e-02_r8,0.76724e-02_r8,0.77261e-02_r8 /) + kbo(:,48,15) = (/ & + & 0.73358e-02_r8,0.74597e-02_r8,0.75632e-02_r8,0.76453e-02_r8,0.77080e-02_r8 /) + kbo(:,49,15) = (/ & + & 0.72811e-02_r8,0.74117e-02_r8,0.75238e-02_r8,0.76147e-02_r8,0.76865e-02_r8 /) + kbo(:,50,15) = (/ & + & 0.72248e-02_r8,0.73656e-02_r8,0.74842e-02_r8,0.75831e-02_r8,0.76614e-02_r8 /) + kbo(:,51,15) = (/ & + & 0.71662e-02_r8,0.73174e-02_r8,0.74427e-02_r8,0.75493e-02_r8,0.76342e-02_r8 /) + kbo(:,52,15) = (/ & + & 0.71006e-02_r8,0.72655e-02_r8,0.73997e-02_r8,0.75133e-02_r8,0.76064e-02_r8 /) + kbo(:,53,15) = (/ & + & 0.70300e-02_r8,0.72101e-02_r8,0.73531e-02_r8,0.74734e-02_r8,0.75745e-02_r8 /) + kbo(:,54,15) = (/ & + & 0.69596e-02_r8,0.71548e-02_r8,0.73082e-02_r8,0.74357e-02_r8,0.75431e-02_r8 /) + kbo(:,55,15) = (/ & + & 0.68873e-02_r8,0.70968e-02_r8,0.72620e-02_r8,0.73967e-02_r8,0.75110e-02_r8 /) + kbo(:,56,15) = (/ & + & 0.68089e-02_r8,0.70345e-02_r8,0.72141e-02_r8,0.73575e-02_r8,0.74766e-02_r8 /) + kbo(:,57,15) = (/ & + & 0.67241e-02_r8,0.69678e-02_r8,0.71623e-02_r8,0.73141e-02_r8,0.74401e-02_r8 /) + kbo(:,58,15) = (/ & + & 0.66371e-02_r8,0.69009e-02_r8,0.71063e-02_r8,0.72699e-02_r8,0.74044e-02_r8 /) + kbo(:,59,15) = (/ & + & 0.66009e-02_r8,0.68723e-02_r8,0.70852e-02_r8,0.72532e-02_r8,0.73888e-02_r8 /) + kbo(:,13,16) = (/ & + & 0.20091e-01_r8,0.19310e-01_r8,0.18586e-01_r8,0.17917e-01_r8,0.17293e-01_r8 /) + kbo(:,14,16) = (/ & + & 0.21405e-01_r8,0.20507e-01_r8,0.19679e-01_r8,0.18912e-01_r8,0.18201e-01_r8 /) + kbo(:,15,16) = (/ & + & 0.22567e-01_r8,0.21555e-01_r8,0.20633e-01_r8,0.19775e-01_r8,0.18992e-01_r8 /) + kbo(:,16,16) = (/ & + & 0.23562e-01_r8,0.22456e-01_r8,0.21445e-01_r8,0.20508e-01_r8,0.19661e-01_r8 /) + kbo(:,17,16) = (/ & + & 0.24411e-01_r8,0.23217e-01_r8,0.22126e-01_r8,0.21126e-01_r8,0.20220e-01_r8 /) + kbo(:,18,16) = (/ & + & 0.25116e-01_r8,0.23847e-01_r8,0.22688e-01_r8,0.21635e-01_r8,0.20680e-01_r8 /) + kbo(:,19,16) = (/ & + & 0.25693e-01_r8,0.24361e-01_r8,0.23149e-01_r8,0.22047e-01_r8,0.21053e-01_r8 /) + kbo(:,20,16) = (/ & + & 0.26126e-01_r8,0.24747e-01_r8,0.23489e-01_r8,0.22355e-01_r8,0.21332e-01_r8 /) + kbo(:,21,16) = (/ & + & 0.26457e-01_r8,0.25034e-01_r8,0.23751e-01_r8,0.22588e-01_r8,0.21537e-01_r8 /) + kbo(:,22,16) = (/ & + & 0.26586e-01_r8,0.25153e-01_r8,0.23857e-01_r8,0.22677e-01_r8,0.21621e-01_r8 /) + kbo(:,23,16) = (/ & + & 0.26640e-01_r8,0.25191e-01_r8,0.23890e-01_r8,0.22706e-01_r8,0.21649e-01_r8 /) + kbo(:,24,16) = (/ & + & 0.26616e-01_r8,0.25160e-01_r8,0.23861e-01_r8,0.22680e-01_r8,0.21622e-01_r8 /) + kbo(:,25,16) = (/ & + & 0.26518e-01_r8,0.25075e-01_r8,0.23777e-01_r8,0.22603e-01_r8,0.21555e-01_r8 /) + kbo(:,26,16) = (/ & + & 0.26348e-01_r8,0.24922e-01_r8,0.23637e-01_r8,0.22478e-01_r8,0.21437e-01_r8 /) + kbo(:,27,16) = (/ & + & 0.26138e-01_r8,0.24737e-01_r8,0.23465e-01_r8,0.22328e-01_r8,0.21299e-01_r8 /) + kbo(:,28,16) = (/ & + & 0.25904e-01_r8,0.24526e-01_r8,0.23272e-01_r8,0.22156e-01_r8,0.21140e-01_r8 /) + kbo(:,29,16) = (/ & + & 0.25645e-01_r8,0.24289e-01_r8,0.23059e-01_r8,0.21960e-01_r8,0.20965e-01_r8 /) + kbo(:,30,16) = (/ & + & 0.25364e-01_r8,0.24034e-01_r8,0.22831e-01_r8,0.21758e-01_r8,0.20776e-01_r8 /) + kbo(:,31,16) = (/ & + & 0.25075e-01_r8,0.23766e-01_r8,0.22595e-01_r8,0.21541e-01_r8,0.20581e-01_r8 /) + kbo(:,32,16) = (/ & + & 0.24769e-01_r8,0.23490e-01_r8,0.22348e-01_r8,0.21316e-01_r8,0.20377e-01_r8 /) + kbo(:,33,16) = (/ & + & 0.24460e-01_r8,0.23211e-01_r8,0.22098e-01_r8,0.21090e-01_r8,0.20170e-01_r8 /) + kbo(:,34,16) = (/ & + & 0.24193e-01_r8,0.22975e-01_r8,0.21887e-01_r8,0.20894e-01_r8,0.19994e-01_r8 /) + kbo(:,35,16) = (/ & + & 0.24050e-01_r8,0.22849e-01_r8,0.21770e-01_r8,0.20789e-01_r8,0.19901e-01_r8 /) + kbo(:,36,16) = (/ & + & 0.24043e-01_r8,0.22842e-01_r8,0.21764e-01_r8,0.20784e-01_r8,0.19894e-01_r8 /) + kbo(:,37,16) = (/ & + & 0.24229e-01_r8,0.23006e-01_r8,0.21915e-01_r8,0.20918e-01_r8,0.20018e-01_r8 /) + kbo(:,38,16) = (/ & + & 0.24421e-01_r8,0.23180e-01_r8,0.22070e-01_r8,0.21062e-01_r8,0.20144e-01_r8 /) + kbo(:,39,16) = (/ & + & 0.24617e-01_r8,0.23352e-01_r8,0.22226e-01_r8,0.21205e-01_r8,0.20274e-01_r8 /) + kbo(:,40,16) = (/ & + & 0.24953e-01_r8,0.23654e-01_r8,0.22496e-01_r8,0.21449e-01_r8,0.20495e-01_r8 /) + kbo(:,41,16) = (/ & + & 0.25312e-01_r8,0.23980e-01_r8,0.22786e-01_r8,0.21712e-01_r8,0.20738e-01_r8 /) + kbo(:,42,16) = (/ & + & 0.25679e-01_r8,0.24315e-01_r8,0.23082e-01_r8,0.21982e-01_r8,0.20981e-01_r8 /) + kbo(:,43,16) = (/ & + & 0.26140e-01_r8,0.24730e-01_r8,0.23454e-01_r8,0.22317e-01_r8,0.21287e-01_r8 /) + kbo(:,44,16) = (/ & + & 0.26653e-01_r8,0.25200e-01_r8,0.23871e-01_r8,0.22691e-01_r8,0.21628e-01_r8 /) + kbo(:,45,16) = (/ & + & 0.27190e-01_r8,0.25674e-01_r8,0.24311e-01_r8,0.23078e-01_r8,0.21977e-01_r8 /) + kbo(:,46,16) = (/ & + & 0.27783e-01_r8,0.26205e-01_r8,0.24787e-01_r8,0.23504e-01_r8,0.22362e-01_r8 /) + kbo(:,47,16) = (/ & + & 0.28471e-01_r8,0.26819e-01_r8,0.25343e-01_r8,0.24006e-01_r8,0.22809e-01_r8 /) + kbo(:,48,16) = (/ & + & 0.29185e-01_r8,0.27464e-01_r8,0.25918e-01_r8,0.24532e-01_r8,0.23275e-01_r8 /) + kbo(:,49,16) = (/ & + & 0.29935e-01_r8,0.28138e-01_r8,0.26520e-01_r8,0.25074e-01_r8,0.23762e-01_r8 /) + kbo(:,50,16) = (/ & + & 0.30661e-01_r8,0.28793e-01_r8,0.27111e-01_r8,0.25603e-01_r8,0.24243e-01_r8 /) + kbo(:,51,16) = (/ & + & 0.31401e-01_r8,0.29455e-01_r8,0.27706e-01_r8,0.26135e-01_r8,0.24726e-01_r8 /) + kbo(:,52,16) = (/ & + & 0.32182e-01_r8,0.30140e-01_r8,0.28322e-01_r8,0.26686e-01_r8,0.25224e-01_r8 /) + kbo(:,53,16) = (/ & + & 0.33002e-01_r8,0.30856e-01_r8,0.28966e-01_r8,0.27268e-01_r8,0.25738e-01_r8 /) + kbo(:,54,16) = (/ & + & 0.33792e-01_r8,0.31541e-01_r8,0.29577e-01_r8,0.27816e-01_r8,0.26234e-01_r8 /) + kbo(:,55,16) = (/ & + & 0.34581e-01_r8,0.32233e-01_r8,0.30182e-01_r8,0.28363e-01_r8,0.26721e-01_r8 /) + kbo(:,56,16) = (/ & + & 0.35416e-01_r8,0.32947e-01_r8,0.30807e-01_r8,0.28926e-01_r8,0.27227e-01_r8 /) + kbo(:,57,16) = (/ & + & 0.36291e-01_r8,0.33701e-01_r8,0.31460e-01_r8,0.29510e-01_r8,0.27750e-01_r8 /) + kbo(:,58,16) = (/ & + & 0.37161e-01_r8,0.34436e-01_r8,0.32106e-01_r8,0.30077e-01_r8,0.28264e-01_r8 /) + kbo(:,59,16) = (/ & + & 0.37521e-01_r8,0.34750e-01_r8,0.32373e-01_r8,0.30309e-01_r8,0.28477e-01_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.515619e-08_r8, 0.131078e-06_r8, 0.349038e-06_r8 /) + forrefo(:, 2) = (/ 0.329605e-07_r8, 0.430497e-06_r8, 0.458569e-05_r8 /) + forrefo(:, 3) = (/ 0.188244e-06_r8, 0.792931e-06_r8, 0.267176e-05_r8 /) + forrefo(:, 4) = (/ 0.611237e-06_r8, 0.798868e-06_r8, 0.411583e-06_r8 /) + forrefo(:, 5) = (/ 0.111903e-05_r8, 0.914895e-06_r8, 0.444828e-06_r8 /) + forrefo(:, 6) = (/ 0.235399e-05_r8, 0.269099e-05_r8, 0.739855e-06_r8 /) + forrefo(:, 7) = (/ 0.400131e-05_r8, 0.378135e-05_r8, 0.231265e-06_r8 /) + forrefo(:, 8) = (/ 0.464257e-05_r8, 0.371927e-05_r8, 0.460611e-06_r8 /) + forrefo(:, 9) = (/ 0.476792e-05_r8, 0.311841e-05_r8, 0.934811e-06_r8 /) + forrefo(:,10) = (/ 0.555683e-05_r8, 0.238129e-05_r8, 0.400334e-07_r8 /) + forrefo(:,11) = (/ 0.569068e-05_r8, 0.196039e-05_r8, 0.374476e-07_r8 /) + forrefo(:,12) = (/ 0.554154e-05_r8, 0.131724e-05_r8, 0.399720e-07_r8 /) + forrefo(:,13) = (/ 0.462684e-05_r8, 0.238826e-07_r8, 0.325793e-07_r8 /) + forrefo(:,14) = (/ 0.808644e-06_r8, 0.105126e-11_r8, 0.148691e-07_r8 /) + forrefo(:,15) = (/ 0.865024e-12_r8, 0.822434e-12_r8, 0.825756e-12_r8 /) + forrefo(:,16) = (/ 0.945747e-12_r8, 0.802065e-12_r8, 0.724732e-12_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.637755e-05_r8, 0.403921e-05_r8, 0.255823e-05_r8, 0.162025e-05_r8, 0.102618e-05_r8, & + & 0.649930e-06_r8, 0.411632e-06_r8, 0.260707e-06_r8, 0.165118e-06_r8, 0.104577e-06_r8 /) + selfrefo(:, 2) = (/ & + & 0.180887e-04_r8, 0.108890e-04_r8, 0.655493e-05_r8, 0.394592e-05_r8, 0.237536e-05_r8, & + & 0.142991e-05_r8, 0.860774e-06_r8, 0.518167e-06_r8, 0.311925e-06_r8, 0.187772e-06_r8 /) + selfrefo(:, 3) = (/ & + & 0.212261e-04_r8, 0.150697e-04_r8, 0.106989e-04_r8, 0.759581e-05_r8, 0.539274e-05_r8, & + & 0.382864e-05_r8, 0.271819e-05_r8, 0.192981e-05_r8, 0.137009e-05_r8, 0.972711e-06_r8 /) + selfrefo(:, 4) = (/ & + & 0.132497e-04_r8, 0.118071e-04_r8, 0.105216e-04_r8, 0.937599e-05_r8, 0.835516e-05_r8, & + & 0.744547e-05_r8, 0.663482e-05_r8, 0.591243e-05_r8, 0.526870e-05_r8, 0.469506e-05_r8 /) + selfrefo(:, 5) = (/ & + & 0.124069e-04_r8, 0.120785e-04_r8, 0.117589e-04_r8, 0.114477e-04_r8, 0.111447e-04_r8, & + & 0.108498e-04_r8, 0.105626e-04_r8, 0.102831e-04_r8, 0.100109e-04_r8, 0.974601e-05_r8 /) + selfrefo(:, 6) = (/ & + & 0.411994e-04_r8, 0.372560e-04_r8, 0.336901e-04_r8, 0.304654e-04_r8, 0.275494e-04_r8, & + & 0.249126e-04_r8, 0.225281e-04_r8, 0.203718e-04_r8, 0.184219e-04_r8, 0.166587e-04_r8 /) + selfrefo(:, 7) = (/ & + & 0.537376e-04_r8, 0.501002e-04_r8, 0.467090e-04_r8, 0.435473e-04_r8, 0.405996e-04_r8, & + & 0.378515e-04_r8, 0.352893e-04_r8, 0.329006e-04_r8, 0.306736e-04_r8, 0.285974e-04_r8 /) + selfrefo(:, 8) = (/ & + & 0.494279e-04_r8, 0.475365e-04_r8, 0.457175e-04_r8, 0.439681e-04_r8, 0.422857e-04_r8, & + & 0.406676e-04_r8, 0.391114e-04_r8, 0.376148e-04_r8, 0.361755e-04_r8, 0.347912e-04_r8 /) + selfrefo(:, 9) = (/ & + & 0.377444e-04_r8, 0.378199e-04_r8, 0.378956e-04_r8, 0.379715e-04_r8, 0.380475e-04_r8, & + & 0.381236e-04_r8, 0.381999e-04_r8, 0.382763e-04_r8, 0.383529e-04_r8, 0.384297e-04_r8 /) + selfrefo(:,10) = (/ & + & 0.245916e-04_r8, 0.267183e-04_r8, 0.290289e-04_r8, 0.315394e-04_r8, 0.342669e-04_r8, & + & 0.372304e-04_r8, 0.404501e-04_r8, 0.439483e-04_r8, 0.477490e-04_r8, 0.518784e-04_r8 /) + selfrefo(:,11) = (/ & + & 0.186528e-04_r8, 0.211417e-04_r8, 0.239628e-04_r8, 0.271603e-04_r8, 0.307845e-04_r8, & + & 0.348923e-04_r8, 0.395482e-04_r8, 0.448254e-04_r8, 0.508068e-04_r8, 0.575863e-04_r8 /) + selfrefo(:,12) = (/ & + & 0.109896e-04_r8, 0.133794e-04_r8, 0.162890e-04_r8, 0.198312e-04_r8, 0.241438e-04_r8, & + & 0.293942e-04_r8, 0.357864e-04_r8, 0.435686e-04_r8, 0.530432e-04_r8, 0.645781e-04_r8 /) + selfrefo(:,13) = (/ & + & 0.183885e-06_r8, 0.391019e-06_r8, 0.831472e-06_r8, 0.176806e-05_r8, 0.375966e-05_r8, & + & 0.799463e-05_r8, 0.170000e-04_r8, 0.361492e-04_r8, 0.768686e-04_r8, 0.163455e-03_r8 /) + selfrefo(:,14) = (/ & + & 0.466057e-07_r8, 0.937419e-07_r8, 0.188551e-06_r8, 0.379248e-06_r8, 0.762813e-06_r8, & + & 0.153431e-05_r8, 0.308608e-05_r8, 0.620729e-05_r8, 0.124852e-04_r8, 0.251126e-04_r8 /) + selfrefo(:,15) = (/ & + & 0.248961e-06_r8, 0.216780e-06_r8, 0.188758e-06_r8, 0.164358e-06_r8, 0.143113e-06_r8, & + & 0.124613e-06_r8, 0.108505e-06_r8, 0.944795e-07_r8, 0.822667e-07_r8, 0.716326e-07_r8 /) + selfrefo(:,16) = (/ & + & 0.252246e-06_r8, 0.220335e-06_r8, 0.192462e-06_r8, 0.168114e-06_r8, 0.146847e-06_r8, & + & 0.128270e-06_r8, 0.112043e-06_r8, 0.978688e-07_r8, 0.854878e-07_r8, 0.746731e-07_r8 /) + + end subroutine sw_kgb24 + +! ************************************************************************** + subroutine sw_kgb25 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg25, only : kao, sfluxrefo, & + raylo, abso3ao, abso3bo, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & + & 42.6858_r8 , 45.7720_r8, 44.9872_r8, 45.9662_r8 , & + & 46.5458_r8 , 41.6926_r8, 32.2893_r8, 24.0928_r8 , & + & 16.7686_r8 , 1.86048_r8, 1.54057_r8, 1.23503_r8 , & + & 0.915085_r8,0.590099_r8,0.218622_r8, 3.21287e-02_r8 /) + +! Rayleigh extinction coefficient at v = 2925 cm-1. + raylo(:) = (/ & + & 9.81132e-07_r8,8.25605e-07_r8,6.71302e-07_r8,5.53556e-07_r8, & + & 3.97383e-07_r8,3.68206e-07_r8,4.42379e-07_r8,4.57799e-07_r8, & + & 4.22683e-07_r8,3.87113e-07_r8,3.79810e-07_r8,3.63192e-07_r8, & + & 3.51921e-07_r8,3.34231e-07_r8,3.34294e-07_r8,3.32673e-07_r8 /) + + abso3ao(:) = (/ & + & 2.32664e-02_r8,5.76154e-02_r8,0.125389_r8,0.250158_r8, & + & 0.378756_r8 ,0.402196_r8 ,0.352026_r8,0.352036_r8, & + & 0.386253_r8 ,0.414598_r8 ,0.420079_r8,0.435471_r8, & + & 0.445487_r8 ,0.459549_r8 ,0.452920_r8,0.456838_r8 /) + + abso3bo(:) = (/ & + & 1.76917e-02_r8,4.64185e-02_r8,1.03640e-01_r8,0.189469_r8, & + & 0.303858_r8 ,0.400248_r8 ,0.447357_r8 ,0.470009_r8, & + & 0.498673_r8 ,0.515696_r8 ,0.517053_r8 ,0.517930_r8, & + & 0.518345_r8 ,0.524952_r8 ,0.508244_r8 ,0.468981_r8 /) + + layreffr = 2 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1) = (/ & + & 0.16461e-08_r8,0.16782e-08_r8,0.19339e-08_r8,0.17100e-08_r8,0.17045e-08_r8 /) + kao(:, 2, 1) = (/ & + & 0.28759e-08_r8,0.29469e-08_r8,0.33789e-08_r8,0.34357e-08_r8,0.28833e-08_r8 /) + kao(:, 3, 1) = (/ & + & 0.55148e-08_r8,0.54808e-08_r8,0.54190e-08_r8,0.68260e-08_r8,0.51972e-08_r8 /) + kao(:, 4, 1) = (/ & + & 0.95336e-08_r8,0.94552e-08_r8,0.93001e-08_r8,0.90961e-08_r8,0.14451e-07_r8 /) + kao(:, 5, 1) = (/ & + & 0.14930e-07_r8,0.14736e-07_r8,0.14432e-07_r8,0.14074e-07_r8,0.24102e-07_r8 /) + kao(:, 6, 1) = (/ & + & 0.22770e-07_r8,0.22301e-07_r8,0.21778e-07_r8,0.21194e-07_r8,0.20569e-07_r8 /) + kao(:, 7, 1) = (/ & + & 0.34699e-07_r8,0.33951e-07_r8,0.33124e-07_r8,0.32144e-07_r8,0.31220e-07_r8 /) + kao(:, 8, 1) = (/ & + & 0.62339e-07_r8,0.60405e-07_r8,0.59548e-07_r8,0.58214e-07_r8,0.56977e-07_r8 /) + kao(:, 9, 1) = (/ & + & 0.17411e-06_r8,0.17654e-06_r8,0.18315e-06_r8,0.18100e-06_r8,0.17839e-06_r8 /) + kao(:,10, 1) = (/ & + & 0.23526e-06_r8,0.22729e-06_r8,0.21947e-06_r8,0.21188e-06_r8,0.20454e-06_r8 /) + kao(:,11, 1) = (/ & + & 0.23535e-06_r8,0.22737e-06_r8,0.21956e-06_r8,0.21196e-06_r8,0.20461e-06_r8 /) + kao(:,12, 1) = (/ & + & 0.23539e-06_r8,0.22740e-06_r8,0.21959e-06_r8,0.21199e-06_r8,0.20465e-06_r8 /) + kao(:,13, 1) = (/ & + & 0.23543e-06_r8,0.22744e-06_r8,0.21962e-06_r8,0.21202e-06_r8,0.20467e-06_r8 /) + kao(:, 1, 2) = (/ & + & 0.62912e-08_r8,0.61559e-08_r8,0.84640e-08_r8,0.59240e-08_r8,0.58217e-08_r8 /) + kao(:, 2, 2) = (/ & + & 0.83749e-08_r8,0.80756e-08_r8,0.11623e-07_r8,0.11272e-07_r8,0.73636e-08_r8 /) + kao(:, 3, 2) = (/ & + & 0.13304e-07_r8,0.12795e-07_r8,0.12343e-07_r8,0.21235e-07_r8,0.11577e-07_r8 /) + kao(:, 4, 2) = (/ & + & 0.20704e-07_r8,0.19736e-07_r8,0.18900e-07_r8,0.18228e-07_r8,0.31601e-07_r8 /) + kao(:, 5, 2) = (/ & + & 0.31149e-07_r8,0.29669e-07_r8,0.28318e-07_r8,0.27101e-07_r8,0.49649e-07_r8 /) + kao(:, 6, 2) = (/ & + & 0.45713e-07_r8,0.43519e-07_r8,0.41488e-07_r8,0.39918e-07_r8,0.38291e-07_r8 /) + kao(:, 7, 2) = (/ & + & 0.77265e-07_r8,0.73848e-07_r8,0.70437e-07_r8,0.67945e-07_r8,0.66127e-07_r8 /) + kao(:, 8, 2) = (/ & + & 0.15754e-06_r8,0.15664e-06_r8,0.15378e-06_r8,0.15027e-06_r8,0.14633e-06_r8 /) + kao(:, 9, 2) = (/ & + & 0.16439e-06_r8,0.14678e-06_r8,0.12610e-06_r8,0.11532e-06_r8,0.10591e-06_r8 /) + kao(:,10, 2) = (/ & + & 0.14366e-06_r8,0.13506e-06_r8,0.12583e-06_r8,0.11774e-06_r8,0.11011e-06_r8 /) + kao(:,11, 2) = (/ & + & 0.14521e-06_r8,0.13766e-06_r8,0.13072e-06_r8,0.12218e-06_r8,0.11400e-06_r8 /) + kao(:,12, 2) = (/ & + & 0.14524e-06_r8,0.13769e-06_r8,0.13074e-06_r8,0.12241e-06_r8,0.11552e-06_r8 /) + kao(:,13, 2) = (/ & + & 0.14525e-06_r8,0.13770e-06_r8,0.13075e-06_r8,0.12252e-06_r8,0.11553e-06_r8 /) + kao(:, 1, 3) = (/ & + & 0.14060e-07_r8,0.13587e-07_r8,0.24644e-07_r8,0.12716e-07_r8,0.12367e-07_r8 /) + kao(:, 2, 3) = (/ & + & 0.17055e-07_r8,0.16577e-07_r8,0.32443e-07_r8,0.31273e-07_r8,0.15381e-07_r8 /) + kao(:, 3, 3) = (/ & + & 0.25414e-07_r8,0.24672e-07_r8,0.23874e-07_r8,0.47281e-07_r8,0.22346e-07_r8 /) + kao(:, 4, 3) = (/ & + & 0.39536e-07_r8,0.38124e-07_r8,0.36836e-07_r8,0.35587e-07_r8,0.72260e-07_r8 /) + kao(:, 5, 3) = (/ & + & 0.59488e-07_r8,0.57630e-07_r8,0.55623e-07_r8,0.53878e-07_r8,0.11230e-06_r8 /) + kao(:, 6, 3) = (/ & + & 0.99996e-07_r8,0.96206e-07_r8,0.93184e-07_r8,0.90812e-07_r8,0.89206e-07_r8 /) + kao(:, 7, 3) = (/ & + & 0.17678e-06_r8,0.17554e-06_r8,0.17358e-06_r8,0.17091e-06_r8,0.16830e-06_r8 /) + kao(:, 8, 3) = (/ & + & 0.18672e-06_r8,0.17850e-06_r8,0.16967e-06_r8,0.16275e-06_r8,0.15875e-06_r8 /) + kao(:, 9, 3) = (/ & + & 0.13558e-06_r8,0.13493e-06_r8,0.13633e-06_r8,0.13799e-06_r8,0.13932e-06_r8 /) + kao(:,10, 3) = (/ & + & 0.18883e-06_r8,0.20452e-06_r8,0.22206e-06_r8,0.24347e-06_r8,0.26091e-06_r8 /) + kao(:,11, 3) = (/ & + & 0.21296e-06_r8,0.23580e-06_r8,0.26439e-06_r8,0.30148e-06_r8,0.34942e-06_r8 /) + kao(:,12, 3) = (/ & + & 0.22072e-06_r8,0.25535e-06_r8,0.28661e-06_r8,0.34814e-06_r8,0.39337e-06_r8 /) + kao(:,13, 3) = (/ & + & 0.22515e-06_r8,0.26161e-06_r8,0.30833e-06_r8,0.36527e-06_r8,0.40123e-06_r8 /) + kao(:, 1, 4) = (/ & + & 0.32735e-07_r8,0.31345e-07_r8,0.58846e-07_r8,0.28258e-07_r8,0.27022e-07_r8 /) + kao(:, 2, 4) = (/ & + & 0.37754e-07_r8,0.36873e-07_r8,0.82776e-07_r8,0.80947e-07_r8,0.35190e-07_r8 /) + kao(:, 3, 4) = (/ & + & 0.76368e-07_r8,0.75292e-07_r8,0.74075e-07_r8,0.10820e-06_r8,0.73183e-07_r8 /) + kao(:, 4, 4) = (/ & + & 0.16392e-06_r8,0.16130e-06_r8,0.15926e-06_r8,0.15700e-06_r8,0.22041e-06_r8 /) + kao(:, 5, 4) = (/ & + & 0.29704e-06_r8,0.28924e-06_r8,0.28301e-06_r8,0.27633e-06_r8,0.42284e-06_r8 /) + kao(:, 6, 4) = (/ & + & 0.48466e-06_r8,0.47240e-06_r8,0.46143e-06_r8,0.45012e-06_r8,0.43867e-06_r8 /) + kao(:, 7, 4) = (/ & + & 0.71637e-06_r8,0.69847e-06_r8,0.67384e-06_r8,0.65368e-06_r8,0.63375e-06_r8 /) + kao(:, 8, 4) = (/ & + & 0.11904e-05_r8,0.11714e-05_r8,0.11524e-05_r8,0.11354e-05_r8,0.11172e-05_r8 /) + kao(:, 9, 4) = (/ & + & 0.21976e-05_r8,0.21606e-05_r8,0.21332e-05_r8,0.20944e-05_r8,0.20536e-05_r8 /) + kao(:,10, 4) = (/ & + & 0.21713e-05_r8,0.21144e-05_r8,0.20553e-05_r8,0.19901e-05_r8,0.19286e-05_r8 /) + kao(:,11, 4) = (/ & + & 0.21443e-05_r8,0.20785e-05_r8,0.20048e-05_r8,0.19232e-05_r8,0.18295e-05_r8 /) + kao(:,12, 4) = (/ & + & 0.21363e-05_r8,0.20578e-05_r8,0.19811e-05_r8,0.18729e-05_r8,0.17807e-05_r8 /) + kao(:,13, 4) = (/ & + & 0.21319e-05_r8,0.20513e-05_r8,0.19580e-05_r8,0.18546e-05_r8,0.17725e-05_r8 /) + kao(:, 1, 5) = (/ & + & 0.36050e-07_r8,0.36125e-07_r8,0.46253e-07_r8,0.37280e-07_r8,0.37359e-07_r8 /) + kao(:, 2, 5) = (/ & + & 0.65102e-07_r8,0.64266e-07_r8,0.68896e-07_r8,0.65925e-07_r8,0.61190e-07_r8 /) + kao(:, 3, 5) = (/ & + & 0.12173e-06_r8,0.11889e-06_r8,0.11625e-06_r8,0.17574e-06_r8,0.10921e-06_r8 /) + kao(:, 4, 5) = (/ & + & 0.20555e-06_r8,0.19853e-06_r8,0.19068e-06_r8,0.18313e-06_r8,0.30241e-06_r8 /) + kao(:, 5, 5) = (/ & + & 0.30900e-06_r8,0.29996e-06_r8,0.28857e-06_r8,0.27772e-06_r8,0.51631e-06_r8 /) + kao(:, 6, 5) = (/ & + & 0.43774e-06_r8,0.42465e-06_r8,0.40920e-06_r8,0.39315e-06_r8,0.37901e-06_r8 /) + kao(:, 7, 5) = (/ & + & 0.63869e-06_r8,0.61654e-06_r8,0.60324e-06_r8,0.58966e-06_r8,0.57948e-06_r8 /) + kao(:, 8, 5) = (/ & + & 0.98362e-06_r8,0.96271e-06_r8,0.94180e-06_r8,0.92206e-06_r8,0.91105e-06_r8 /) + kao(:, 9, 5) = (/ & + & 0.12061e-05_r8,0.11895e-05_r8,0.11564e-05_r8,0.11296e-05_r8,0.11110e-05_r8 /) + kao(:,10, 5) = (/ & + & 0.12958e-05_r8,0.12694e-05_r8,0.12425e-05_r8,0.12153e-05_r8,0.11880e-05_r8 /) + kao(:,11, 5) = (/ & + & 0.12962e-05_r8,0.12698e-05_r8,0.12429e-05_r8,0.12156e-05_r8,0.11883e-05_r8 /) + kao(:,12, 5) = (/ & + & 0.12964e-05_r8,0.12701e-05_r8,0.12431e-05_r8,0.12158e-05_r8,0.11885e-05_r8 /) + kao(:,13, 5) = (/ & + & 0.12966e-05_r8,0.12702e-05_r8,0.12433e-05_r8,0.12160e-05_r8,0.11886e-05_r8 /) + kao(:, 1, 6) = (/ & + & 0.73925e-07_r8,0.70231e-07_r8,0.21454e-06_r8,0.63477e-07_r8,0.60912e-07_r8 /) + kao(:, 2, 6) = (/ & + & 0.67794e-07_r8,0.65807e-07_r8,0.13854e-06_r8,0.13061e-06_r8,0.59361e-07_r8 /) + kao(:, 3, 6) = (/ & + & 0.98353e-07_r8,0.95275e-07_r8,0.92426e-07_r8,0.15768e-06_r8,0.87986e-07_r8 /) + kao(:, 4, 6) = (/ & + & 0.15855e-06_r8,0.15394e-06_r8,0.14948e-06_r8,0.14655e-06_r8,0.23172e-06_r8 /) + kao(:, 5, 6) = (/ & + & 0.27764e-06_r8,0.26941e-06_r8,0.26299e-06_r8,0.25975e-06_r8,0.40526e-06_r8 /) + kao(:, 6, 6) = (/ & + & 0.45469e-06_r8,0.44417e-06_r8,0.43276e-06_r8,0.42440e-06_r8,0.41489e-06_r8 /) + kao(:, 7, 6) = (/ & + & 0.71540e-06_r8,0.71291e-06_r8,0.70656e-06_r8,0.69823e-06_r8,0.68342e-06_r8 /) + kao(:, 8, 6) = (/ & + & 0.79651e-06_r8,0.79807e-06_r8,0.80621e-06_r8,0.80941e-06_r8,0.79835e-06_r8 /) + kao(:, 9, 6) = (/ & + & 0.18716e-06_r8,0.16713e-06_r8,0.14725e-06_r8,0.13728e-06_r8,0.11763e-06_r8 /) + kao(:,10, 6) = (/ & + & 0.92638e-07_r8,0.86207e-07_r8,0.80877e-07_r8,0.70432e-07_r8,0.64517e-07_r8 /) + kao(:,11, 6) = (/ & + & 0.13396e-06_r8,0.12820e-06_r8,0.12387e-06_r8,0.10427e-06_r8,0.94091e-07_r8 /) + kao(:,12, 6) = (/ & + & 0.14877e-06_r8,0.14827e-06_r8,0.14350e-06_r8,0.12154e-06_r8,0.10552e-06_r8 /) + kao(:,13, 6) = (/ & + & 0.15437e-06_r8,0.15323e-06_r8,0.14992e-06_r8,0.12715e-06_r8,0.10933e-06_r8 /) + kao(:, 1, 7) = (/ & + & 0.72717e-06_r8,0.70656e-06_r8,0.13933e-05_r8,0.66449e-06_r8,0.64269e-06_r8 /) + kao(:, 2, 7) = (/ & + & 0.52595e-06_r8,0.50791e-06_r8,0.11171e-05_r8,0.10538e-05_r8,0.45644e-06_r8 /) + kao(:, 3, 7) = (/ & + & 0.29919e-06_r8,0.29227e-06_r8,0.28284e-06_r8,0.65215e-06_r8,0.26347e-06_r8 /) + kao(:, 4, 7) = (/ & + & 0.27961e-06_r8,0.27579e-06_r8,0.27068e-06_r8,0.26343e-06_r8,0.41265e-06_r8 /) + kao(:, 5, 7) = (/ & + & 0.37031e-06_r8,0.36318e-06_r8,0.35475e-06_r8,0.34488e-06_r8,0.53740e-06_r8 /) + kao(:, 6, 7) = (/ & + & 0.53195e-06_r8,0.52692e-06_r8,0.52224e-06_r8,0.51934e-06_r8,0.51146e-06_r8 /) + kao(:, 7, 7) = (/ & + & 0.83043e-06_r8,0.84552e-06_r8,0.84833e-06_r8,0.82800e-06_r8,0.80930e-06_r8 /) + kao(:, 8, 7) = (/ & + & 0.14910e-05_r8,0.15179e-05_r8,0.15248e-05_r8,0.15091e-05_r8,0.14853e-05_r8 /) + kao(:, 9, 7) = (/ & + & 0.37340e-05_r8,0.37823e-05_r8,0.38311e-05_r8,0.38453e-05_r8,0.38567e-05_r8 /) + kao(:,10, 7) = (/ & + & 0.86791e-05_r8,0.89697e-05_r8,0.92118e-05_r8,0.93991e-05_r8,0.95564e-05_r8 /) + kao(:,11, 7) = (/ & + & 0.11878e-04_r8,0.12201e-04_r8,0.12588e-04_r8,0.12897e-04_r8,0.13151e-04_r8 /) + kao(:,12, 7) = (/ & + & 0.13192e-04_r8,0.13732e-04_r8,0.14137e-04_r8,0.14465e-04_r8,0.14643e-04_r8 /) + kao(:,13, 7) = (/ & + & 0.13716e-04_r8,0.14229e-04_r8,0.14617e-04_r8,0.14944e-04_r8,0.15182e-04_r8 /) + kao(:, 1, 8) = (/ & + & 0.39538e-05_r8,0.38949e-05_r8,0.56188e-05_r8,0.37475e-05_r8,0.36648e-05_r8 /) + kao(:, 2, 8) = (/ & + & 0.34231e-05_r8,0.33633e-05_r8,0.51877e-05_r8,0.50048e-05_r8,0.31425e-05_r8 /) + kao(:, 3, 8) = (/ & + & 0.28073e-05_r8,0.27497e-05_r8,0.26875e-05_r8,0.44405e-05_r8,0.25492e-05_r8 /) + kao(:, 4, 8) = (/ & + & 0.19229e-05_r8,0.18818e-05_r8,0.18382e-05_r8,0.17896e-05_r8,0.33073e-05_r8 /) + kao(:, 5, 8) = (/ & + & 0.11453e-05_r8,0.11293e-05_r8,0.11095e-05_r8,0.10866e-05_r8,0.19344e-05_r8 /) + kao(:, 6, 8) = (/ & + & 0.14565e-05_r8,0.14517e-05_r8,0.14369e-05_r8,0.14141e-05_r8,0.13944e-05_r8 /) + kao(:, 7, 8) = (/ & + & 0.23228e-05_r8,0.22753e-05_r8,0.22395e-05_r8,0.22124e-05_r8,0.21731e-05_r8 /) + kao(:, 8, 8) = (/ & + & 0.34877e-05_r8,0.34362e-05_r8,0.33796e-05_r8,0.33389e-05_r8,0.32924e-05_r8 /) + kao(:, 9, 8) = (/ & + & 0.63448e-05_r8,0.63701e-05_r8,0.63619e-05_r8,0.62632e-05_r8,0.61645e-05_r8 /) + kao(:,10, 8) = (/ & + & 0.12155e-04_r8,0.11880e-04_r8,0.11762e-04_r8,0.11759e-04_r8,0.11651e-04_r8 /) + kao(:,11, 8) = (/ & + & 0.14093e-04_r8,0.13835e-04_r8,0.13547e-04_r8,0.13205e-04_r8,0.12690e-04_r8 /) + kao(:,12, 8) = (/ & + & 0.14428e-04_r8,0.14056e-04_r8,0.13932e-04_r8,0.13396e-04_r8,0.12885e-04_r8 /) + kao(:,13, 8) = (/ & + & 0.15229e-04_r8,0.14534e-04_r8,0.13849e-04_r8,0.13292e-04_r8,0.12704e-04_r8 /) + kao(:, 1, 9) = (/ & + & 0.19250e-04_r8,0.19148e-04_r8,0.21702e-04_r8,0.18906e-04_r8,0.18761e-04_r8 /) + kao(:, 2, 9) = (/ & + & 0.18132e-04_r8,0.18040e-04_r8,0.20884e-04_r8,0.20523e-04_r8,0.17656e-04_r8 /) + kao(:, 3, 9) = (/ & + & 0.16928e-04_r8,0.16843e-04_r8,0.16742e-04_r8,0.19715e-04_r8,0.16470e-04_r8 /) + kao(:, 4, 9) = (/ & + & 0.15526e-04_r8,0.15463e-04_r8,0.15377e-04_r8,0.15268e-04_r8,0.18367e-04_r8 /) + kao(:, 5, 9) = (/ & + & 0.13545e-04_r8,0.13511e-04_r8,0.13455e-04_r8,0.13362e-04_r8,0.16722e-04_r8 /) + kao(:, 6, 9) = (/ & + & 0.97183e-05_r8,0.97218e-05_r8,0.97084e-05_r8,0.96717e-05_r8,0.96030e-05_r8 /) + kao(:, 7, 9) = (/ & + & 0.50307e-05_r8,0.50984e-05_r8,0.51628e-05_r8,0.52093e-05_r8,0.52354e-05_r8 /) + kao(:, 8, 9) = (/ & + & 0.45837e-05_r8,0.45939e-05_r8,0.45938e-05_r8,0.45639e-05_r8,0.45109e-05_r8 /) + kao(:, 9, 9) = (/ & + & 0.12254e-04_r8,0.12319e-04_r8,0.12397e-04_r8,0.12584e-04_r8,0.12620e-04_r8 /) + kao(:,10, 9) = (/ & + & 0.21545e-04_r8,0.21836e-04_r8,0.21718e-04_r8,0.21511e-04_r8,0.21211e-04_r8 /) + kao(:,11, 9) = (/ & + & 0.20079e-04_r8,0.19539e-04_r8,0.18859e-04_r8,0.18393e-04_r8,0.18181e-04_r8 /) + kao(:,12, 9) = (/ & + & 0.17115e-04_r8,0.16357e-04_r8,0.15410e-04_r8,0.15220e-04_r8,0.15207e-04_r8 /) + kao(:,13, 9) = (/ & + & 0.14935e-04_r8,0.14679e-04_r8,0.14593e-04_r8,0.14448e-04_r8,0.14436e-04_r8 /) + kao(:, 1,10) = (/ & + & 0.53569e-04_r8,0.53042e-04_r8,0.55454e-04_r8,0.52098e-04_r8,0.51678e-04_r8 /) + kao(:, 2,10) = (/ & + & 0.52196e-04_r8,0.51739e-04_r8,0.54777e-04_r8,0.54075e-04_r8,0.50624e-04_r8 /) + kao(:, 3,10) = (/ & + & 0.50339e-04_r8,0.50046e-04_r8,0.49769e-04_r8,0.53168e-04_r8,0.49370e-04_r8 /) + kao(:, 4,10) = (/ & + & 0.48505e-04_r8,0.48316e-04_r8,0.48143e-04_r8,0.47993e-04_r8,0.51621e-04_r8 /) + kao(:, 5,10) = (/ & + & 0.46313e-04_r8,0.46267e-04_r8,0.46119e-04_r8,0.46064e-04_r8,0.50279e-04_r8 /) + kao(:, 6,10) = (/ & + & 0.42662e-04_r8,0.42818e-04_r8,0.42935e-04_r8,0.43007e-04_r8,0.43099e-04_r8 /) + kao(:, 7,10) = (/ & + & 0.35762e-04_r8,0.36149e-04_r8,0.36450e-04_r8,0.36639e-04_r8,0.36887e-04_r8 /) + kao(:, 8,10) = (/ & + & 0.13516e-05_r8,0.18607e-05_r8,0.23061e-05_r8,0.27339e-05_r8,0.36516e-05_r8 /) + kao(:, 9,10) = (/ & + & 0.36432e-05_r8,0.40739e-05_r8,0.43830e-05_r8,0.41136e-05_r8,0.43128e-05_r8 /) + kao(:,10,10) = (/ & + & 0.62049e-05_r8,0.69116e-05_r8,0.73244e-05_r8,0.65087e-05_r8,0.78951e-05_r8 /) + kao(:,11,10) = (/ & + & 0.32156e-05_r8,0.38834e-05_r8,0.41231e-05_r8,0.43386e-05_r8,0.43405e-05_r8 /) + kao(:,12,10) = (/ & + & 0.22152e-05_r8,0.26754e-05_r8,0.31971e-05_r8,0.34911e-05_r8,0.37935e-05_r8 /) + kao(:,13,10) = (/ & + & 0.19792e-05_r8,0.26543e-05_r8,0.31511e-05_r8,0.34597e-05_r8,0.40624e-05_r8 /) + kao(:, 1,11) = (/ & + & 0.75384e-04_r8,0.75103e-04_r8,0.77406e-04_r8,0.74222e-04_r8,0.73734e-04_r8 /) + kao(:, 2,11) = (/ & + & 0.75458e-04_r8,0.75244e-04_r8,0.77778e-04_r8,0.77018e-04_r8,0.73942e-04_r8 /) + kao(:, 3,11) = (/ & + & 0.75023e-04_r8,0.74844e-04_r8,0.74477e-04_r8,0.77271e-04_r8,0.73633e-04_r8 /) + kao(:, 4,11) = (/ & + & 0.73633e-04_r8,0.73539e-04_r8,0.73257e-04_r8,0.72934e-04_r8,0.76232e-04_r8 /) + kao(:, 5,11) = (/ & + & 0.71348e-04_r8,0.71322e-04_r8,0.71227e-04_r8,0.71069e-04_r8,0.75258e-04_r8 /) + kao(:, 6,11) = (/ & + & 0.67784e-04_r8,0.67873e-04_r8,0.67974e-04_r8,0.67924e-04_r8,0.67903e-04_r8 /) + kao(:, 7,11) = (/ & + & 0.61855e-04_r8,0.61922e-04_r8,0.61973e-04_r8,0.62206e-04_r8,0.62496e-04_r8 /) + kao(:, 8,11) = (/ & + & 0.36622e-04_r8,0.37413e-04_r8,0.38740e-04_r8,0.40550e-04_r8,0.41833e-04_r8 /) + kao(:, 9,11) = (/ & + & 0.28544e-05_r8,0.28831e-05_r8,0.31445e-05_r8,0.32900e-05_r8,0.27967e-05_r8 /) + kao(:,10,11) = (/ & + & 0.53755e-05_r8,0.42123e-05_r8,0.51154e-05_r8,0.63481e-05_r8,0.54219e-05_r8 /) + kao(:,11,11) = (/ & + & 0.12605e-05_r8,0.14078e-05_r8,0.19167e-05_r8,0.23729e-05_r8,0.30161e-05_r8 /) + kao(:,12,11) = (/ & + & 0.11370e-05_r8,0.91524e-06_r8,0.11150e-05_r8,0.14746e-05_r8,0.20128e-05_r8 /) + kao(:,13,11) = (/ & + & 0.10511e-05_r8,0.10014e-05_r8,0.11405e-05_r8,0.13852e-05_r8,0.15576e-05_r8 /) + kao(:, 1,12) = (/ & + & 0.11184e-03_r8,0.11117e-03_r8,0.11327e-03_r8,0.10989e-03_r8,0.10910e-03_r8 /) + kao(:, 2,12) = (/ & + & 0.11379e-03_r8,0.11322e-03_r8,0.11555e-03_r8,0.11462e-03_r8,0.11135e-03_r8 /) + kao(:, 3,12) = (/ & + & 0.11508e-03_r8,0.11459e-03_r8,0.11421e-03_r8,0.11671e-03_r8,0.11339e-03_r8 /) + kao(:, 4,12) = (/ & + & 0.11596e-03_r8,0.11563e-03_r8,0.11538e-03_r8,0.11511e-03_r8,0.11770e-03_r8 /) + kao(:, 5,12) = (/ & + & 0.11597e-03_r8,0.11581e-03_r8,0.11569e-03_r8,0.11553e-03_r8,0.11890e-03_r8 /) + kao(:, 6,12) = (/ & + & 0.11443e-03_r8,0.11445e-03_r8,0.11443e-03_r8,0.11443e-03_r8,0.11438e-03_r8 /) + kao(:, 7,12) = (/ & + & 0.10852e-03_r8,0.10888e-03_r8,0.10912e-03_r8,0.10934e-03_r8,0.10942e-03_r8 /) + kao(:, 8,12) = (/ & + & 0.93194e-04_r8,0.94766e-04_r8,0.95355e-04_r8,0.95090e-04_r8,0.94926e-04_r8 /) + kao(:, 9,12) = (/ & + & 0.11836e-05_r8,0.16115e-05_r8,0.12883e-05_r8,0.14202e-05_r8,0.16541e-05_r8 /) + kao(:,10,12) = (/ & + & 0.18748e-05_r8,0.34401e-05_r8,0.39984e-05_r8,0.44576e-05_r8,0.33683e-05_r8 /) + kao(:,11,12) = (/ & + & 0.29890e-06_r8,0.48741e-06_r8,0.66276e-06_r8,0.99698e-06_r8,0.19230e-05_r8 /) + kao(:,12,12) = (/ & + & 0.15034e-06_r8,0.39966e-06_r8,0.56523e-06_r8,0.70494e-06_r8,0.10046e-05_r8 /) + kao(:,13,12) = (/ & + & 0.15016e-06_r8,0.25751e-06_r8,0.48928e-06_r8,0.63534e-06_r8,0.93575e-06_r8 /) + kao(:, 1,13) = (/ & + & 0.17305e-03_r8,0.17234e-03_r8,0.17389e-03_r8,0.17055e-03_r8,0.16974e-03_r8 /) + kao(:, 2,13) = (/ & + & 0.18170e-03_r8,0.18075e-03_r8,0.18265e-03_r8,0.18138e-03_r8,0.17772e-03_r8 /) + kao(:, 3,13) = (/ & + & 0.18990e-03_r8,0.18892e-03_r8,0.18776e-03_r8,0.18950e-03_r8,0.18494e-03_r8 /) + kao(:, 4,13) = (/ & + & 0.19649e-03_r8,0.19552e-03_r8,0.19424e-03_r8,0.19281e-03_r8,0.19464e-03_r8 /) + kao(:, 5,13) = (/ & + & 0.20197e-03_r8,0.20109e-03_r8,0.19993e-03_r8,0.19856e-03_r8,0.20092e-03_r8 /) + kao(:, 6,13) = (/ & + & 0.20595e-03_r8,0.20549e-03_r8,0.20452e-03_r8,0.20331e-03_r8,0.20199e-03_r8 /) + kao(:, 7,13) = (/ & + & 0.20703e-03_r8,0.20710e-03_r8,0.20649e-03_r8,0.20552e-03_r8,0.20428e-03_r8 /) + kao(:, 8,13) = (/ & + & 0.19874e-03_r8,0.19767e-03_r8,0.19696e-03_r8,0.19655e-03_r8,0.19591e-03_r8 /) + kao(:, 9,13) = (/ & + & 0.20434e-04_r8,0.23398e-04_r8,0.27400e-04_r8,0.32409e-04_r8,0.38451e-04_r8 /) + kao(:,10,13) = (/ & + & 0.18617e-05_r8,0.99513e-06_r8,0.10554e-05_r8,0.16516e-05_r8,0.37792e-05_r8 /) + kao(:,11,13) = (/ & + & 0.12517e-06_r8,0.29518e-06_r8,0.77058e-06_r8,0.11660e-05_r8,0.15349e-05_r8 /) + kao(:,12,13) = (/ & + & 0.12734e-06_r8,0.36524e-06_r8,0.66699e-06_r8,0.10362e-05_r8,0.14158e-05_r8 /) + kao(:,13,13) = (/ & + & 0.12431e-06_r8,0.39389e-06_r8,0.67331e-06_r8,0.10292e-05_r8,0.14448e-05_r8 /) + kao(:, 1,14) = (/ & + & 0.29365e-03_r8,0.29046e-03_r8,0.29008e-03_r8,0.28509e-03_r8,0.28286e-03_r8 /) + kao(:, 2,14) = (/ & + & 0.31990e-03_r8,0.31668e-03_r8,0.31617e-03_r8,0.31332e-03_r8,0.30885e-03_r8 /) + kao(:, 3,14) = (/ & + & 0.34787e-03_r8,0.34432e-03_r8,0.34112e-03_r8,0.34052e-03_r8,0.33589e-03_r8 /) + kao(:, 4,14) = (/ & + & 0.37401e-03_r8,0.37027e-03_r8,0.36696e-03_r8,0.36394e-03_r8,0.36355e-03_r8 /) + kao(:, 5,14) = (/ & + & 0.39840e-03_r8,0.39446e-03_r8,0.39082e-03_r8,0.38763e-03_r8,0.38760e-03_r8 /) + kao(:, 6,14) = (/ & + & 0.42165e-03_r8,0.41729e-03_r8,0.41335e-03_r8,0.41006e-03_r8,0.40721e-03_r8 /) + kao(:, 7,14) = (/ & + & 0.44257e-03_r8,0.43782e-03_r8,0.43364e-03_r8,0.43014e-03_r8,0.42736e-03_r8 /) + kao(:, 8,14) = (/ & + & 0.45299e-03_r8,0.44953e-03_r8,0.44586e-03_r8,0.44260e-03_r8,0.44006e-03_r8 /) + kao(:, 9,14) = (/ & + & 0.40190e-03_r8,0.39751e-03_r8,0.39238e-03_r8,0.38812e-03_r8,0.38612e-03_r8 /) + kao(:,10,14) = (/ & + & 0.64278e-05_r8,0.18248e-05_r8,0.16996e-05_r8,0.31086e-06_r8,0.16836e-06_r8 /) + kao(:,11,14) = (/ & + & 0.14350e-05_r8,0.94778e-06_r8,0.41349e-06_r8,0.20817e-06_r8,0.20238e-06_r8 /) + kao(:,12,14) = (/ & + & 0.16805e-05_r8,0.15323e-05_r8,0.62348e-06_r8,0.99743e-07_r8,0.12977e-06_r8 /) + kao(:,13,14) = (/ & + & 0.16858e-05_r8,0.17103e-05_r8,0.80574e-06_r8,0.15825e-06_r8,0.15032e-06_r8 /) + kao(:, 1,15) = (/ & + & 0.52181e-03_r8,0.51578e-03_r8,0.51251e-03_r8,0.50356e-03_r8,0.49731e-03_r8 /) + kao(:, 2,15) = (/ & + & 0.59491e-03_r8,0.58822e-03_r8,0.58413e-03_r8,0.57646e-03_r8,0.56692e-03_r8 /) + kao(:, 3,15) = (/ & + & 0.67653e-03_r8,0.66881e-03_r8,0.66126e-03_r8,0.65540e-03_r8,0.64461e-03_r8 /) + kao(:, 4,15) = (/ & + & 0.76388e-03_r8,0.75456e-03_r8,0.74556e-03_r8,0.73649e-03_r8,0.72840e-03_r8 /) + kao(:, 5,15) = (/ & + & 0.85507e-03_r8,0.84417e-03_r8,0.83378e-03_r8,0.82338e-03_r8,0.81349e-03_r8 /) + kao(:, 6,15) = (/ & + & 0.95034e-03_r8,0.93798e-03_r8,0.92553e-03_r8,0.91287e-03_r8,0.89957e-03_r8 /) + kao(:, 7,15) = (/ & + & 0.10496e-02_r8,0.10352e-02_r8,0.10206e-02_r8,0.10054e-02_r8,0.98958e-03_r8 /) + kao(:, 8,15) = (/ & + & 0.11507e-02_r8,0.11337e-02_r8,0.11169e-02_r8,0.10991e-02_r8,0.10806e-02_r8 /) + kao(:, 9,15) = (/ & + & 0.12408e-02_r8,0.12207e-02_r8,0.11996e-02_r8,0.11773e-02_r8,0.11531e-02_r8 /) + kao(:,10,15) = (/ & + & 0.12042e-03_r8,0.11501e-03_r8,0.11424e-03_r8,0.11450e-03_r8,0.13219e-03_r8 /) + kao(:,11,15) = (/ & + & 0.68914e-06_r8,0.83960e-06_r8,0.74591e-06_r8,0.18660e-05_r8,0.32503e-05_r8 /) + kao(:,12,15) = (/ & + & 0.35963e-07_r8,0.46256e-06_r8,0.56223e-06_r8,0.98816e-06_r8,0.92366e-06_r8 /) + kao(:,13,15) = (/ & + & 0.36605e-07_r8,0.56591e-06_r8,0.84008e-06_r8,0.86042e-06_r8,0.68452e-06_r8 /) + kao(:, 1,16) = (/ & + & 0.76517e-03_r8,0.75944e-03_r8,0.76010e-03_r8,0.76100e-03_r8,0.76498e-03_r8 /) + kao(:, 2,16) = (/ & + & 0.92375e-03_r8,0.91357e-03_r8,0.90997e-03_r8,0.90997e-03_r8,0.90993e-03_r8 /) + kao(:, 3,16) = (/ & + & 0.11142e-02_r8,0.10974e-02_r8,0.10835e-02_r8,0.10789e-02_r8,0.10748e-02_r8 /) + kao(:, 4,16) = (/ & + & 0.13278e-02_r8,0.13025e-02_r8,0.12802e-02_r8,0.12631e-02_r8,0.12539e-02_r8 /) + kao(:, 5,16) = (/ & + & 0.15712e-02_r8,0.15343e-02_r8,0.15017e-02_r8,0.14713e-02_r8,0.14497e-02_r8 /) + kao(:, 6,16) = (/ & + & 0.18525e-02_r8,0.17982e-02_r8,0.17525e-02_r8,0.17101e-02_r8,0.16714e-02_r8 /) + kao(:, 7,16) = (/ & + & 0.21731e-02_r8,0.20986e-02_r8,0.20340e-02_r8,0.19757e-02_r8,0.19210e-02_r8 /) + kao(:, 8,16) = (/ & + & 0.25325e-02_r8,0.24346e-02_r8,0.23473e-02_r8,0.22687e-02_r8,0.21950e-02_r8 /) + kao(:, 9,16) = (/ & + & 0.29269e-02_r8,0.28006e-02_r8,0.26863e-02_r8,0.25805e-02_r8,0.24878e-02_r8 /) + kao(:,10,16) = (/ & + & 0.29442e-02_r8,0.27008e-02_r8,0.23913e-02_r8,0.21437e-02_r8,0.18865e-02_r8 /) + kao(:,11,16) = (/ & + & 0.23220e-05_r8,0.22310e-04_r8,0.48349e-04_r8,0.67183e-04_r8,0.88908e-04_r8 /) + kao(:,12,16) = (/ & + & 0.22857e-05_r8,0.11848e-04_r8,0.42066e-04_r8,0.67613e-04_r8,0.86033e-04_r8 /) + kao(:,13,16) = (/ & + & 0.22823e-05_r8,0.69105e-05_r8,0.36212e-04_r8,0.66247e-04_r8,0.85488e-04_r8 /) + + end subroutine sw_kgb25 + +! ************************************************************************** + subroutine sw_kgb26 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg26, only : sfluxrefo, raylo + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & +! & 129.462_r8, 15*0._r8 /) + & 29.0079_r8, 28.4088_r8, 20.3099_r8, 13.0283_r8 & + &, 11.8619_r8, 9.95840_r8, 6.68696_r8, 5.38987_r8 & + &, 3.49829_r8, 0.407693_r8, 0.299027_r8, 0.236827_r8 & + &, 0.188502_r8, 0.163489_r8, 4.64335e-02_r8, 2.72662e-03_r8 /) + +! Rayleigh extinction coefficient at all v + raylo(:) = (/ & + & 1.21263e-06_r8,1.43428e-06_r8,1.67677e-06_r8,1.93255e-06_r8 & + &, 2.19177e-06_r8,2.44195e-06_r8,2.66926e-06_r8,2.85990e-06_r8 & + &, 3.00380e-06_r8,3.06996e-06_r8,3.08184e-06_r8,3.09172e-06_r8 & + &, 3.09938e-06_r8,3.10456e-06_r8,3.10727e-06_r8,3.10818e-06_r8 /) + + end subroutine sw_kgb26 + +! ************************************************************************** + subroutine sw_kgb27 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg27, only : kao, kbo, sfluxrefo, raylo, & + scalekur, layreffr + + implicit none + save + +! Kurucz solar source function +! The following values were obtained using the "low resolution" +! version of the Kurucz solar source function. For unknown reasons, +! the total irradiance in this band differs from the corresponding +! total in the "high-resolution" version of the Kurucz function. +! Therefore, below these values are scaled by the factor SCALEKUR. + sfluxrefo(:) = (/ & + & 14.0526_r8 , 11.4794_r8 , 8.72590_r8 , 5.56966_r8 , & + & 3.80927_r8 , 1.57690_r8 , 1.15099_r8 , 1.10012_r8 , & + & 0.658212_r8 , 5.86859e-02_r8, 5.56186e-02_r8, 4.68040e-02_r8, & + & 3.64897e-02_r8, 3.58053e-02_r8, 1.38130e-02_r8, 1.90193e-03_r8 /) + +! Rayleigh extinction coefficient at v = 2925 cm-1. + raylo(:) = (/ & + & 3.44534e-06_r8,4.14480e-06_r8,4.95069e-06_r8,5.81204e-06_r8, & + & 6.69748e-06_r8,7.56488e-06_r8,8.36344e-06_r8,9.04135e-06_r8, & + & 9.58324e-06_r8,9.81542e-06_r8,9.75119e-06_r8,9.74533e-06_r8, & + & 9.74139e-06_r8,9.73525e-06_r8,9.73577e-06_r8,9.73618e-06_r8 /) + + scalekur = 50.15_r8/48.37_r8 + + layreffr = 32 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1) = (/ & + & 0.22907e+00_r8,0.25625e+00_r8,0.28779e+00_r8,0.32376e+00_r8,0.36426e+00_r8 /) + kao(:, 2, 1) = (/ & + & 0.21913e+00_r8,0.24445e+00_r8,0.27422e+00_r8,0.30832e+00_r8,0.34694e+00_r8 /) + kao(:, 3, 1) = (/ & + & 0.20602e+00_r8,0.22864e+00_r8,0.25574e+00_r8,0.28721e+00_r8,0.32310e+00_r8 /) + kao(:, 4, 1) = (/ & + & 0.19379e+00_r8,0.21352e+00_r8,0.23771e+00_r8,0.26643e+00_r8,0.29940e+00_r8 /) + kao(:, 5, 1) = (/ & + & 0.18369e+00_r8,0.20061e+00_r8,0.22200e+00_r8,0.24786e+00_r8,0.27816e+00_r8 /) + kao(:, 6, 1) = (/ & + & 0.17517e+00_r8,0.18920e+00_r8,0.20771e+00_r8,0.23069e+00_r8,0.25817e+00_r8 /) + kao(:, 7, 1) = (/ & + & 0.16888e+00_r8,0.17988e+00_r8,0.19559e+00_r8,0.21577e+00_r8,0.24042e+00_r8 /) + kao(:, 8, 1) = (/ & + & 0.16442e+00_r8,0.17273e+00_r8,0.18565e+00_r8,0.20315e+00_r8,0.22512e+00_r8 /) + kao(:, 9, 1) = (/ & + & 0.16159e+00_r8,0.16738e+00_r8,0.17752e+00_r8,0.19242e+00_r8,0.21179e+00_r8 /) + kao(:,10, 1) = (/ & + & 0.16037e+00_r8,0.16402e+00_r8,0.17204e+00_r8,0.18463e+00_r8,0.20183e+00_r8 /) + kao(:,11, 1) = (/ & + & 0.16036e+00_r8,0.16399e+00_r8,0.17198e+00_r8,0.18455e+00_r8,0.20173e+00_r8 /) + kao(:,12, 1) = (/ & + & 0.16036e+00_r8,0.16399e+00_r8,0.17198e+00_r8,0.18455e+00_r8,0.20173e+00_r8 /) + kao(:,13, 1) = (/ & + & 0.16036e+00_r8,0.16399e+00_r8,0.17198e+00_r8,0.18455e+00_r8,0.20173e+00_r8 /) + kao(:, 1, 2) = (/ & + & 0.20716e+01_r8,0.21925e+01_r8,0.23327e+01_r8,0.24921e+01_r8,0.26726e+01_r8 /) + kao(:, 2, 2) = (/ & + & 0.20272e+01_r8,0.21401e+01_r8,0.22723e+01_r8,0.24238e+01_r8,0.25950e+01_r8 /) + kao(:, 3, 2) = (/ & + & 0.19684e+01_r8,0.20697e+01_r8,0.21902e+01_r8,0.23301e+01_r8,0.24892e+01_r8 /) + kao(:, 4, 2) = (/ & + & 0.19133e+01_r8,0.20021e+01_r8,0.21101e+01_r8,0.22375e+01_r8,0.23842e+01_r8 /) + kao(:, 5, 2) = (/ & + & 0.18673e+01_r8,0.19441e+01_r8,0.20400e+01_r8,0.21553e+01_r8,0.22898e+01_r8 /) + kao(:, 6, 2) = (/ & + & 0.18277e+01_r8,0.18925e+01_r8,0.19760e+01_r8,0.20788e+01_r8,0.22009e+01_r8 /) + kao(:, 7, 2) = (/ & + & 0.17963e+01_r8,0.18497e+01_r8,0.19214e+01_r8,0.20121e+01_r8,0.21222e+01_r8 /) + kao(:, 8, 2) = (/ & + & 0.17749e+01_r8,0.18156e+01_r8,0.18763e+01_r8,0.19555e+01_r8,0.20540e+01_r8 /) + kao(:, 9, 2) = (/ & + & 0.17600e+01_r8,0.17885e+01_r8,0.18388e+01_r8,0.19071e+01_r8,0.19943e+01_r8 /) + kao(:,10, 2) = (/ & + & 0.17526e+01_r8,0.17729e+01_r8,0.18121e+01_r8,0.18716e+01_r8,0.19496e+01_r8 /) + kao(:,11, 2) = (/ & + & 0.17525e+01_r8,0.17727e+01_r8,0.18119e+01_r8,0.18712e+01_r8,0.19491e+01_r8 /) + kao(:,12, 2) = (/ & + & 0.17525e+01_r8,0.17727e+01_r8,0.18119e+01_r8,0.18712e+01_r8,0.19491e+01_r8 /) + kao(:,13, 2) = (/ & + & 0.17525e+01_r8,0.17727e+01_r8,0.18119e+01_r8,0.18712e+01_r8,0.19491e+01_r8 /) + kao(:, 1, 3) = (/ & + & 0.12189e+02_r8,0.12619e+02_r8,0.13110e+02_r8,0.13663e+02_r8,0.14275e+02_r8 /) + kao(:, 2, 3) = (/ & + & 0.12030e+02_r8,0.12434e+02_r8,0.12899e+02_r8,0.13427e+02_r8,0.14015e+02_r8 /) + kao(:, 3, 3) = (/ & + & 0.11816e+02_r8,0.12183e+02_r8,0.12611e+02_r8,0.13101e+02_r8,0.13653e+02_r8 /) + kao(:, 4, 3) = (/ & + & 0.11611e+02_r8,0.11938e+02_r8,0.12327e+02_r8,0.12777e+02_r8,0.13289e+02_r8 /) + kao(:, 5, 3) = (/ & + & 0.11437e+02_r8,0.11726e+02_r8,0.12076e+02_r8,0.12488e+02_r8,0.12961e+02_r8 /) + kao(:, 6, 3) = (/ & + & 0.11284e+02_r8,0.11533e+02_r8,0.11843e+02_r8,0.12215e+02_r8,0.12649e+02_r8 /) + kao(:, 7, 3) = (/ & + & 0.11160e+02_r8,0.11370e+02_r8,0.11641e+02_r8,0.11975e+02_r8,0.12370e+02_r8 /) + kao(:, 8, 3) = (/ & + & 0.11063e+02_r8,0.11237e+02_r8,0.11471e+02_r8,0.11768e+02_r8,0.12126e+02_r8 /) + kao(:, 9, 3) = (/ & + & 0.10990e+02_r8,0.11129e+02_r8,0.11327e+02_r8,0.11588e+02_r8,0.11910e+02_r8 /) + kao(:,10, 3) = (/ & + & 0.10945e+02_r8,0.11053e+02_r8,0.11223e+02_r8,0.11454e+02_r8,0.11746e+02_r8 /) + kao(:,11, 3) = (/ & + & 0.10945e+02_r8,0.11052e+02_r8,0.11222e+02_r8,0.11452e+02_r8,0.11744e+02_r8 /) + kao(:,12, 3) = (/ & + & 0.10945e+02_r8,0.11052e+02_r8,0.11222e+02_r8,0.11452e+02_r8,0.11744e+02_r8 /) + kao(:,13, 3) = (/ & + & 0.10945e+02_r8,0.11052e+02_r8,0.11222e+02_r8,0.11452e+02_r8,0.11744e+02_r8 /) + kao(:, 1, 4) = (/ & + & 0.55057e+02_r8,0.56143e+02_r8,0.57364e+02_r8,0.58719e+02_r8,0.60208e+02_r8 /) + kao(:, 2, 4) = (/ & + & 0.54647e+02_r8,0.55677e+02_r8,0.56842e+02_r8,0.58142e+02_r8,0.59575e+02_r8 /) + kao(:, 3, 4) = (/ & + & 0.54090e+02_r8,0.55039e+02_r8,0.56123e+02_r8,0.57342e+02_r8,0.58694e+02_r8 /) + kao(:, 4, 4) = (/ & + & 0.53548e+02_r8,0.54410e+02_r8,0.55408e+02_r8,0.56539e+02_r8,0.57805e+02_r8 /) + kao(:, 5, 4) = (/ & + & 0.53074e+02_r8,0.53853e+02_r8,0.54766e+02_r8,0.55813e+02_r8,0.56995e+02_r8 /) + kao(:, 6, 4) = (/ & + & 0.52644e+02_r8,0.53336e+02_r8,0.54162e+02_r8,0.55123e+02_r8,0.56218e+02_r8 /) + kao(:, 7, 4) = (/ & + & 0.52279e+02_r8,0.52887e+02_r8,0.53629e+02_r8,0.54505e+02_r8,0.55516e+02_r8 /) + kao(:, 8, 4) = (/ & + & 0.51979e+02_r8,0.52507e+02_r8,0.53168e+02_r8,0.53965e+02_r8,0.54895e+02_r8 /) + kao(:, 9, 4) = (/ & + & 0.51734e+02_r8,0.52183e+02_r8,0.52767e+02_r8,0.53485e+02_r8,0.54337e+02_r8 /) + kao(:,10, 4) = (/ & + & 0.51565e+02_r8,0.51948e+02_r8,0.52467e+02_r8,0.53120e+02_r8,0.53907e+02_r8 /) + kao(:,11, 4) = (/ & + & 0.51563e+02_r8,0.51946e+02_r8,0.52464e+02_r8,0.53116e+02_r8,0.53902e+02_r8 /) + kao(:,12, 4) = (/ & + & 0.51563e+02_r8,0.51946e+02_r8,0.52464e+02_r8,0.53116e+02_r8,0.53902e+02_r8 /) + kao(:,13, 4) = (/ & + & 0.51563e+02_r8,0.51946e+02_r8,0.52464e+02_r8,0.53116e+02_r8,0.53902e+02_r8 /) + kao(:, 1, 5) = (/ & + & 0.17794e+03_r8,0.17973e+03_r8,0.18164e+03_r8,0.18366e+03_r8,0.18581e+03_r8 /) + kao(:, 2, 5) = (/ & + & 0.17724e+03_r8,0.17898e+03_r8,0.18083e+03_r8,0.18281e+03_r8,0.18491e+03_r8 /) + kao(:, 3, 5) = (/ & + & 0.17624e+03_r8,0.17791e+03_r8,0.17970e+03_r8,0.18160e+03_r8,0.18363e+03_r8 /) + kao(:, 4, 5) = (/ & + & 0.17523e+03_r8,0.17682e+03_r8,0.17853e+03_r8,0.18036e+03_r8,0.18231e+03_r8 /) + kao(:, 5, 5) = (/ & + & 0.17429e+03_r8,0.17581e+03_r8,0.17744e+03_r8,0.17920e+03_r8,0.18107e+03_r8 /) + kao(:, 6, 5) = (/ & + & 0.17338e+03_r8,0.17482e+03_r8,0.17638e+03_r8,0.17805e+03_r8,0.17985e+03_r8 /) + kao(:, 7, 5) = (/ & + & 0.17253e+03_r8,0.17390e+03_r8,0.17539e+03_r8,0.17699e+03_r8,0.17871e+03_r8 /) + kao(:, 8, 5) = (/ & + & 0.17177e+03_r8,0.17307e+03_r8,0.17448e+03_r8,0.17601e+03_r8,0.17767e+03_r8 /) + kao(:, 9, 5) = (/ & + & 0.17107e+03_r8,0.17230e+03_r8,0.17364e+03_r8,0.17511e+03_r8,0.17669e+03_r8 /) + kao(:,10, 5) = (/ & + & 0.17052e+03_r8,0.17169e+03_r8,0.17298e+03_r8,0.17438e+03_r8,0.17591e+03_r8 /) + kao(:,11, 5) = (/ & + & 0.17051e+03_r8,0.17168e+03_r8,0.17297e+03_r8,0.17437e+03_r8,0.17590e+03_r8 /) + kao(:,12, 5) = (/ & + & 0.17051e+03_r8,0.17168e+03_r8,0.17297e+03_r8,0.17437e+03_r8,0.17590e+03_r8 /) + kao(:,13, 5) = (/ & + & 0.17051e+03_r8,0.17168e+03_r8,0.17297e+03_r8,0.17437e+03_r8,0.17590e+03_r8 /) + kao(:, 1, 6) = (/ & + & 0.37680e+05_r8,0.36801e+05_r8,0.36011e+05_r8,0.35298e+05_r8,0.34715e+05_r8 /) + kao(:, 2, 6) = (/ & + & 0.39286e+03_r8,0.39463e+03_r8,0.39616e+03_r8,0.39748e+03_r8,0.39858e+03_r8 /) + kao(:, 3, 6) = (/ & + & 0.39169e+03_r8,0.39359e+03_r8,0.39526e+03_r8,0.39671e+03_r8,0.39794e+03_r8 /) + kao(:, 4, 6) = (/ & + & 0.39034e+03_r8,0.39239e+03_r8,0.39421e+03_r8,0.39580e+03_r8,0.39717e+03_r8 /) + kao(:, 5, 6) = (/ & + & 0.38895e+03_r8,0.39113e+03_r8,0.39309e+03_r8,0.39483e+03_r8,0.39634e+03_r8 /) + kao(:, 6, 6) = (/ & + & 0.38742e+03_r8,0.38975e+03_r8,0.39185e+03_r8,0.39373e+03_r8,0.39539e+03_r8 /) + kao(:, 7, 6) = (/ & + & 0.38585e+03_r8,0.38832e+03_r8,0.39056e+03_r8,0.39258e+03_r8,0.39438e+03_r8 /) + kao(:, 8, 6) = (/ & + & 0.38426e+03_r8,0.38686e+03_r8,0.38924e+03_r8,0.39140e+03_r8,0.39333e+03_r8 /) + kao(:, 9, 6) = (/ & + & 0.38264e+03_r8,0.38538e+03_r8,0.38789e+03_r8,0.39017e+03_r8,0.39223e+03_r8 /) + kao(:,10, 6) = (/ & + & 0.38123e+03_r8,0.38408e+03_r8,0.38670e+03_r8,0.38909e+03_r8,0.39126e+03_r8 /) + kao(:,11, 6) = (/ & + & 0.38122e+03_r8,0.38406e+03_r8,0.38668e+03_r8,0.38908e+03_r8,0.39125e+03_r8 /) + kao(:,12, 6) = (/ & + & 0.38122e+03_r8,0.38406e+03_r8,0.38668e+03_r8,0.38908e+03_r8,0.39125e+03_r8 /) + kao(:,13, 6) = (/ & + & 0.38122e+03_r8,0.38406e+03_r8,0.38668e+03_r8,0.38908e+03_r8,0.39125e+03_r8 /) + kao(:, 1, 7) = (/ & + & 0.18202e+07_r8,0.17771e+07_r8,0.17382e+07_r8,0.17034e+07_r8,0.16716e+07_r8 /) + kao(:, 2, 7) = (/ & + & 0.63027e+03_r8,0.63194e+03_r8,0.63388e+03_r8,0.63607e+03_r8,0.63849e+03_r8 /) + kao(:, 3, 7) = (/ & + & 0.62938e+03_r8,0.63090e+03_r8,0.63268e+03_r8,0.63472e+03_r8,0.63701e+03_r8 /) + kao(:, 4, 7) = (/ & + & 0.62853e+03_r8,0.62989e+03_r8,0.63150e+03_r8,0.63337e+03_r8,0.63550e+03_r8 /) + kao(:, 5, 7) = (/ & + & 0.62781e+03_r8,0.62901e+03_r8,0.63046e+03_r8,0.63217e+03_r8,0.63413e+03_r8 /) + kao(:, 6, 7) = (/ & + & 0.62717e+03_r8,0.62821e+03_r8,0.62950e+03_r8,0.63104e+03_r8,0.63283e+03_r8 /) + kao(:, 7, 7) = (/ & + & 0.62666e+03_r8,0.62753e+03_r8,0.62867e+03_r8,0.63005e+03_r8,0.63168e+03_r8 /) + kao(:, 8, 7) = (/ & + & 0.62627e+03_r8,0.62698e+03_r8,0.62795e+03_r8,0.62919e+03_r8,0.63067e+03_r8 /) + kao(:, 9, 7) = (/ & + & 0.62600e+03_r8,0.62653e+03_r8,0.62735e+03_r8,0.62844e+03_r8,0.62978e+03_r8 /) + kao(:,10, 7) = (/ & + & 0.62583e+03_r8,0.62624e+03_r8,0.62692e+03_r8,0.62788e+03_r8,0.62910e+03_r8 /) + kao(:,11, 7) = (/ & + & 0.62583e+03_r8,0.62623e+03_r8,0.62691e+03_r8,0.62787e+03_r8,0.62909e+03_r8 /) + kao(:,12, 7) = (/ & + & 0.62583e+03_r8,0.62623e+03_r8,0.62691e+03_r8,0.62787e+03_r8,0.62909e+03_r8 /) + kao(:,13, 7) = (/ & + & 0.62583e+03_r8,0.62623e+03_r8,0.62691e+03_r8,0.62787e+03_r8,0.62909e+03_r8 /) + kao(:, 1, 8) = (/ & + & 0.55488e+07_r8,0.54180e+07_r8,0.53005e+07_r8,0.51943e+07_r8,0.50978e+07_r8 /) + kao(:, 2, 8) = (/ & + & 0.82143e+03_r8,0.82232e+03_r8,0.82327e+03_r8,0.82429e+03_r8,0.82541e+03_r8 /) + kao(:, 3, 8) = (/ & + & 0.82092e+03_r8,0.82177e+03_r8,0.82269e+03_r8,0.82366e+03_r8,0.82472e+03_r8 /) + kao(:, 4, 8) = (/ & + & 0.82041e+03_r8,0.82121e+03_r8,0.82209e+03_r8,0.82303e+03_r8,0.82402e+03_r8 /) + kao(:, 5, 8) = (/ & + & 0.81996e+03_r8,0.82070e+03_r8,0.82152e+03_r8,0.82243e+03_r8,0.82339e+03_r8 /) + kao(:, 6, 8) = (/ & + & 0.81952e+03_r8,0.82021e+03_r8,0.82098e+03_r8,0.82184e+03_r8,0.82277e+03_r8 /) + kao(:, 7, 8) = (/ & + & 0.81917e+03_r8,0.81977e+03_r8,0.82048e+03_r8,0.82129e+03_r8,0.82218e+03_r8 /) + kao(:, 8, 8) = (/ & + & 0.81881e+03_r8,0.81938e+03_r8,0.82004e+03_r8,0.82080e+03_r8,0.82163e+03_r8 /) + kao(:, 9, 8) = (/ & + & 0.81846e+03_r8,0.81906e+03_r8,0.81965e+03_r8,0.82035e+03_r8,0.82114e+03_r8 /) + kao(:,10, 8) = (/ & + & 0.81821e+03_r8,0.81877e+03_r8,0.81934e+03_r8,0.82000e+03_r8,0.82074e+03_r8 /) + kao(:,11, 8) = (/ & + & 0.81821e+03_r8,0.81877e+03_r8,0.81934e+03_r8,0.81999e+03_r8,0.82074e+03_r8 /) + kao(:,12, 8) = (/ & + & 0.81821e+03_r8,0.81877e+03_r8,0.81934e+03_r8,0.81999e+03_r8,0.82074e+03_r8 /) + kao(:,13, 8) = (/ & + & 0.81821e+03_r8,0.81877e+03_r8,0.81935e+03_r8,0.81999e+03_r8,0.82074e+03_r8 /) + kao(:, 1, 9) = (/ & + & 0.10204e+08_r8,0.99477e+07_r8,0.97209e+07_r8,0.95103e+07_r8,0.92960e+07_r8 /) + kao(:, 2, 9) = (/ & + & 0.95102e+03_r8,0.95144e+03_r8,0.95133e+03_r8,0.95066e+03_r8,0.94964e+03_r8 /) + kao(:, 3, 9) = (/ & + & 0.95048e+03_r8,0.95118e+03_r8,0.95136e+03_r8,0.95103e+03_r8,0.95020e+03_r8 /) + kao(:, 4, 9) = (/ & + & 0.94969e+03_r8,0.95077e+03_r8,0.95126e+03_r8,0.95124e+03_r8,0.95074e+03_r8 /) + kao(:, 5, 9) = (/ & + & 0.94872e+03_r8,0.95015e+03_r8,0.95101e+03_r8,0.95129e+03_r8,0.95105e+03_r8 /) + kao(:, 6, 9) = (/ & + & 0.94752e+03_r8,0.94929e+03_r8,0.95052e+03_r8,0.95116e+03_r8,0.95126e+03_r8 /) + kao(:, 7, 9) = (/ & + & 0.94612e+03_r8,0.94825e+03_r8,0.94981e+03_r8,0.95083e+03_r8,0.95126e+03_r8 /) + kao(:, 8, 9) = (/ & + & 0.94461e+03_r8,0.94704e+03_r8,0.94894e+03_r8,0.95029e+03_r8,0.95107e+03_r8 /) + kao(:, 9, 9) = (/ & + & 0.94291e+03_r8,0.94567e+03_r8,0.94791e+03_r8,0.94957e+03_r8,0.95069e+03_r8 /) + kao(:,10, 9) = (/ & + & 0.94135e+03_r8,0.94441e+03_r8,0.94689e+03_r8,0.94884e+03_r8,0.95022e+03_r8 /) + kao(:,11, 9) = (/ & + & 0.94133e+03_r8,0.94440e+03_r8,0.94688e+03_r8,0.94883e+03_r8,0.95021e+03_r8 /) + kao(:,12, 9) = (/ & + & 0.94133e+03_r8,0.94438e+03_r8,0.94688e+03_r8,0.94883e+03_r8,0.95021e+03_r8 /) + kao(:,13, 9) = (/ & + & 0.94133e+03_r8,0.94438e+03_r8,0.94687e+03_r8,0.94883e+03_r8,0.95021e+03_r8 /) + kao(:, 1,10) = (/ & + & 0.12764e+08_r8,0.12408e+08_r8,0.12012e+08_r8,0.11438e+08_r8,0.11217e+08_r8 /) + kao(:, 2,10) = (/ & + & 0.99589e+03_r8,0.99493e+03_r8,0.99263e+03_r8,0.98974e+03_r8,0.98742e+03_r8 /) + kao(:, 3,10) = (/ & + & 0.99532e+03_r8,0.99571e+03_r8,0.99447e+03_r8,0.99207e+03_r8,0.98779e+03_r8 /) + kao(:, 4,10) = (/ & + & 0.99446e+03_r8,0.99559e+03_r8,0.99536e+03_r8,0.99386e+03_r8,0.99088e+03_r8 /) + kao(:, 5,10) = (/ & + & 0.99288e+03_r8,0.99493e+03_r8,0.99558e+03_r8,0.99487e+03_r8,0.99336e+03_r8 /) + kao(:, 6,10) = (/ & + & 0.99069e+03_r8,0.99366e+03_r8,0.99519e+03_r8,0.99534e+03_r8,0.99428e+03_r8 /) + kao(:, 7,10) = (/ & + & 0.98811e+03_r8,0.99191e+03_r8,0.99430e+03_r8,0.99510e+03_r8,0.99504e+03_r8 /) + kao(:, 8,10) = (/ & + & 0.98531e+03_r8,0.98996e+03_r8,0.99300e+03_r8,0.99479e+03_r8,0.99513e+03_r8 /) + kao(:, 9,10) = (/ & + & 0.98264e+03_r8,0.98737e+03_r8,0.99138e+03_r8,0.99390e+03_r8,0.99503e+03_r8 /) + kao(:,10,10) = (/ & + & 0.98010e+03_r8,0.98517e+03_r8,0.98974e+03_r8,0.99281e+03_r8,0.99470e+03_r8 /) + kao(:,11,10) = (/ & + & 0.98010e+03_r8,0.98509e+03_r8,0.98985e+03_r8,0.99280e+03_r8,0.99468e+03_r8 /) + kao(:,12,10) = (/ & + & 0.98035e+03_r8,0.98524e+03_r8,0.98973e+03_r8,0.99279e+03_r8,0.99468e+03_r8 /) + kao(:,13,10) = (/ & + & 0.98012e+03_r8,0.98526e+03_r8,0.98973e+03_r8,0.99279e+03_r8,0.99468e+03_r8 /) + kao(:, 1,11) = (/ & + & 0.12266e+08_r8,0.12000e+08_r8,0.11724e+08_r8,0.11828e+08_r8,0.11523e+08_r8 /) + kao(:, 2,11) = (/ & + & 0.10001e+04_r8,0.99984e+03_r8,0.99745e+03_r8,0.99535e+03_r8,0.98599e+03_r8 /) + kao(:, 3,11) = (/ & + & 0.99963e+03_r8,0.99927e+03_r8,0.99848e+03_r8,0.99596e+03_r8,0.99390e+03_r8 /) + kao(:, 4,11) = (/ & + & 0.99904e+03_r8,0.99942e+03_r8,0.99870e+03_r8,0.99747e+03_r8,0.99542e+03_r8 /) + kao(:, 5,11) = (/ & + & 0.99826e+03_r8,0.99927e+03_r8,0.99919e+03_r8,0.99821e+03_r8,0.99627e+03_r8 /) + kao(:, 6,11) = (/ & + & 0.99730e+03_r8,0.99882e+03_r8,0.99938e+03_r8,0.99902e+03_r8,0.99764e+03_r8 /) + kao(:, 7,11) = (/ & + & 0.99551e+03_r8,0.99810e+03_r8,0.99919e+03_r8,0.99961e+03_r8,0.99863e+03_r8 /) + kao(:, 8,11) = (/ & + & 0.99324e+03_r8,0.99688e+03_r8,0.99871e+03_r8,0.99940e+03_r8,0.99942e+03_r8 /) + kao(:, 9,11) = (/ & + & 0.99058e+03_r8,0.99489e+03_r8,0.99773e+03_r8,0.99912e+03_r8,0.99954e+03_r8 /) + kao(:,10,11) = (/ & + & 0.98802e+03_r8,0.99297e+03_r8,0.99656e+03_r8,0.99861e+03_r8,0.99937e+03_r8 /) + kao(:,11,11) = (/ & + & 0.98800e+03_r8,0.99310e+03_r8,0.99655e+03_r8,0.99860e+03_r8,0.99936e+03_r8 /) + kao(:,12,11) = (/ & + & 0.98771e+03_r8,0.99296e+03_r8,0.99669e+03_r8,0.99859e+03_r8,0.99936e+03_r8 /) + kao(:,13,11) = (/ & + & 0.98800e+03_r8,0.99296e+03_r8,0.99655e+03_r8,0.99859e+03_r8,0.99936e+03_r8 /) + kao(:, 1,12) = (/ & + & 0.12503e+08_r8,0.11946e+08_r8,0.11557e+08_r8,0.11503e+08_r8,0.11901e+08_r8 /) + kao(:, 2,12) = (/ & + & 0.10015e+04_r8,0.10004e+04_r8,0.99932e+03_r8,0.99373e+03_r8,0.98591e+03_r8 /) + kao(:, 3,12) = (/ & + & 0.10024e+04_r8,0.10021e+04_r8,0.10003e+04_r8,0.99817e+03_r8,0.99146e+03_r8 /) + kao(:, 4,12) = (/ & + & 0.10022e+04_r8,0.10027e+04_r8,0.10021e+04_r8,0.99956e+03_r8,0.99610e+03_r8 /) + kao(:, 5,12) = (/ & + & 0.10024e+04_r8,0.10024e+04_r8,0.10028e+04_r8,0.10015e+04_r8,0.99826e+03_r8 /) + kao(:, 6,12) = (/ & + & 0.10017e+04_r8,0.10025e+04_r8,0.10025e+04_r8,0.10023e+04_r8,0.10008e+04_r8 /) + kao(:, 7,12) = (/ & + & 0.10005e+04_r8,0.10020e+04_r8,0.10028e+04_r8,0.10028e+04_r8,0.10019e+04_r8 /) + kao(:, 8,12) = (/ & + & 0.10000e+04_r8,0.10010e+04_r8,0.10024e+04_r8,0.10029e+04_r8,0.10023e+04_r8 /) + kao(:, 9,12) = (/ & + & 0.99906e+03_r8,0.10004e+04_r8,0.10018e+04_r8,0.10029e+04_r8,0.10028e+04_r8 /) + kao(:,10,12) = (/ & + & 0.99791e+03_r8,0.99989e+03_r8,0.10010e+04_r8,0.10024e+04_r8,0.10031e+04_r8 /) + kao(:,11,12) = (/ & + & 0.99769e+03_r8,0.99967e+03_r8,0.10008e+04_r8,0.10024e+04_r8,0.10029e+04_r8 /) + kao(:,12,12) = (/ & + & 0.99787e+03_r8,0.99985e+03_r8,0.10008e+04_r8,0.10025e+04_r8,0.10029e+04_r8 /) + kao(:,13,12) = (/ & + & 0.99768e+03_r8,0.99984e+03_r8,0.10012e+04_r8,0.10026e+04_r8,0.10029e+04_r8 /) + kao(:, 1,13) = (/ & + & 0.12359e+08_r8,0.12469e+08_r8,0.12868e+08_r8,0.12776e+08_r8,0.12590e+08_r8 /) + kao(:, 2,13) = (/ & + & 0.10045e+04_r8,0.10033e+04_r8,0.99840e+03_r8,0.99184e+03_r8,0.98861e+03_r8 /) + kao(:, 3,13) = (/ & + & 0.10050e+04_r8,0.10041e+04_r8,0.10024e+04_r8,0.99701e+03_r8,0.99083e+03_r8 /) + kao(:, 4,13) = (/ & + & 0.10053e+04_r8,0.10043e+04_r8,0.10035e+04_r8,0.10017e+04_r8,0.99538e+03_r8 /) + kao(:, 5,13) = (/ & + & 0.10048e+04_r8,0.10056e+04_r8,0.10038e+04_r8,0.10026e+04_r8,0.10008e+04_r8 /) + kao(:, 6,13) = (/ & + & 0.10042e+04_r8,0.10054e+04_r8,0.10054e+04_r8,0.10039e+04_r8,0.10017e+04_r8 /) + kao(:, 7,13) = (/ & + & 0.10029e+04_r8,0.10046e+04_r8,0.10055e+04_r8,0.10046e+04_r8,0.10033e+04_r8 /) + kao(:, 8,13) = (/ & + & 0.10002e+04_r8,0.10039e+04_r8,0.10051e+04_r8,0.10054e+04_r8,0.10046e+04_r8 /) + kao(:, 9,13) = (/ & + & 0.99825e+03_r8,0.10019e+04_r8,0.10043e+04_r8,0.10051e+04_r8,0.10052e+04_r8 /) + kao(:,10,13) = (/ & + & 0.99595e+03_r8,0.99983e+03_r8,0.10034e+04_r8,0.10050e+04_r8,0.10051e+04_r8 /) + kao(:,11,13) = (/ & + & 0.99621e+03_r8,0.99979e+03_r8,0.10034e+04_r8,0.10050e+04_r8,0.10054e+04_r8 /) + kao(:,12,13) = (/ & + & 0.99597e+03_r8,0.99979e+03_r8,0.10031e+04_r8,0.10047e+04_r8,0.10054e+04_r8 /) + kao(:,13,13) = (/ & + & 0.99623e+03_r8,0.99978e+03_r8,0.10031e+04_r8,0.10047e+04_r8,0.10054e+04_r8 /) + kao(:, 1,14) = (/ & + & 0.13636e+08_r8,0.13818e+08_r8,0.13518e+08_r8,0.13266e+08_r8,0.13048e+08_r8 /) + kao(:, 2,14) = (/ & + & 0.10049e+04_r8,0.99946e+03_r8,0.99774e+03_r8,0.99774e+03_r8,0.99771e+03_r8 /) + kao(:, 3,14) = (/ & + & 0.10051e+04_r8,0.10068e+04_r8,0.10007e+04_r8,0.99775e+03_r8,0.99778e+03_r8 /) + kao(:, 4,14) = (/ & + & 0.10071e+04_r8,0.10061e+04_r8,0.10050e+04_r8,0.10005e+04_r8,0.99776e+03_r8 /) + kao(:, 5,14) = (/ & + & 0.10067e+04_r8,0.10072e+04_r8,0.10061e+04_r8,0.10044e+04_r8,0.99972e+03_r8 /) + kao(:, 6,14) = (/ & + & 0.10049e+04_r8,0.10070e+04_r8,0.10074e+04_r8,0.10057e+04_r8,0.10037e+04_r8 /) + kao(:, 7,14) = (/ & + & 0.10033e+04_r8,0.10063e+04_r8,0.10072e+04_r8,0.10067e+04_r8,0.10050e+04_r8 /) + kao(:, 8,14) = (/ & + & 0.10025e+04_r8,0.10048e+04_r8,0.10068e+04_r8,0.10071e+04_r8,0.10062e+04_r8 /) + kao(:, 9,14) = (/ & + & 0.99880e+03_r8,0.10031e+04_r8,0.10060e+04_r8,0.10071e+04_r8,0.10069e+04_r8 /) + kao(:,10,14) = (/ & + & 0.99610e+03_r8,0.10023e+04_r8,0.10047e+04_r8,0.10067e+04_r8,0.10072e+04_r8 /) + kao(:,11,14) = (/ & + & 0.99601e+03_r8,0.10023e+04_r8,0.10047e+04_r8,0.10067e+04_r8,0.10072e+04_r8 /) + kao(:,12,14) = (/ & + & 0.99598e+03_r8,0.10023e+04_r8,0.10051e+04_r8,0.10067e+04_r8,0.10076e+04_r8 /) + kao(:,13,14) = (/ & + & 0.99596e+03_r8,0.10027e+04_r8,0.10047e+04_r8,0.10067e+04_r8,0.10072e+04_r8 /) + kao(:, 1,15) = (/ & + & 0.14285e+08_r8,0.13947e+08_r8,0.13644e+08_r8,0.13317e+08_r8,0.13015e+08_r8 /) + kao(:, 2,15) = (/ & + & 0.99932e+03_r8,0.10011e+04_r8,0.10018e+04_r8,0.10007e+04_r8,0.99706e+03_r8 /) + kao(:, 3,15) = (/ & + & 0.10097e+04_r8,0.99743e+03_r8,0.10015e+04_r8,0.10018e+04_r8,0.99920e+03_r8 /) + kao(:, 4,15) = (/ & + & 0.10099e+04_r8,0.10076e+04_r8,0.10030e+04_r8,0.10017e+04_r8,0.10013e+04_r8 /) + kao(:, 5,15) = (/ & + & 0.10075e+04_r8,0.10079e+04_r8,0.10073e+04_r8,0.10035e+04_r8,0.10018e+04_r8 /) + kao(:, 6,15) = (/ & + & 0.10068e+04_r8,0.10088e+04_r8,0.10068e+04_r8,0.10090e+04_r8,0.10033e+04_r8 /) + kao(:, 7,15) = (/ & + & 0.10057e+04_r8,0.10073e+04_r8,0.10090e+04_r8,0.10087e+04_r8,0.10062e+04_r8 /) + kao(:, 8,15) = (/ & + & 0.10010e+04_r8,0.10054e+04_r8,0.10076e+04_r8,0.10079e+04_r8,0.10072e+04_r8 /) + kao(:, 9,15) = (/ & + & 0.99853e+03_r8,0.10054e+04_r8,0.10071e+04_r8,0.10079e+04_r8,0.10078e+04_r8 /) + kao(:,10,15) = (/ & + & 0.99742e+03_r8,0.10007e+04_r8,0.10064e+04_r8,0.10076e+04_r8,0.10080e+04_r8 /) + kao(:,11,15) = (/ & + & 0.99635e+03_r8,0.10006e+04_r8,0.10064e+04_r8,0.10087e+04_r8,0.10090e+04_r8 /) + kao(:,12,15) = (/ & + & 0.99635e+03_r8,0.10006e+04_r8,0.10064e+04_r8,0.10087e+04_r8,0.10069e+04_r8 /) + kao(:,13,15) = (/ & + & 0.99635e+03_r8,0.99960e+03_r8,0.10064e+04_r8,0.10076e+04_r8,0.10080e+04_r8 /) + kao(:, 1,16) = (/ & + & 0.14326e+08_r8,0.13988e+08_r8,0.13684e+08_r8,0.13409e+08_r8,0.13021e+08_r8 /) + kao(:, 2,16) = (/ & + & 0.10008e+04_r8,0.10027e+04_r8,0.10036e+04_r8,0.10037e+04_r8,0.99673e+03_r8 /) + kao(:, 3,16) = (/ & + & 0.99286e+03_r8,0.10016e+04_r8,0.10031e+04_r8,0.10038e+04_r8,0.10035e+04_r8 /) + kao(:, 4,16) = (/ & + & 0.99278e+03_r8,0.10078e+04_r8,0.10023e+04_r8,0.10035e+04_r8,0.10038e+04_r8 /) + kao(:, 5,16) = (/ & + & 0.10074e+04_r8,0.10079e+04_r8,0.10075e+04_r8,0.10028e+04_r8,0.10037e+04_r8 /) + kao(:, 6,16) = (/ & + & 0.10069e+04_r8,0.10002e+04_r8,0.10079e+04_r8,0.99212e+03_r8,0.10032e+04_r8 /) + kao(:, 7,16) = (/ & + & 0.10060e+04_r8,0.10072e+04_r8,0.10004e+04_r8,0.10003e+04_r8,0.10063e+04_r8 /) + kao(:, 8,16) = (/ & + & 0.10009e+04_r8,0.10066e+04_r8,0.10075e+04_r8,0.10080e+04_r8,0.10074e+04_r8 /) + kao(:, 9,16) = (/ & + & 0.99860e+03_r8,0.10057e+04_r8,0.10071e+04_r8,0.10078e+04_r8,0.10079e+04_r8 /) + kao(:,10,16) = (/ & + & 0.98908e+03_r8,0.10006e+04_r8,0.10065e+04_r8,0.10075e+04_r8,0.10080e+04_r8 /) + kao(:,11,16) = (/ & + & 0.99644e+03_r8,0.10006e+04_r8,0.10065e+04_r8,0.10000e+04_r8,0.10005e+04_r8 /) + kao(:,12,16) = (/ & + & 0.99644e+03_r8,0.10006e+04_r8,0.10065e+04_r8,0.10000e+04_r8,0.10080e+04_r8 /) + kao(:,13,16) = (/ & + & 0.99644e+03_r8,0.10006e+04_r8,0.10065e+04_r8,0.10075e+04_r8,0.10080e+04_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.16036e+00_r8,0.16399e+00_r8,0.17198e+00_r8,0.18455e+00_r8,0.20173e+00_r8 /) + kbo(:,14, 1) = (/ & + & 0.16050e+00_r8,0.16454e+00_r8,0.17292e+00_r8,0.18592e+00_r8,0.20351e+00_r8 /) + kbo(:,15, 1) = (/ & + & 0.16071e+00_r8,0.16519e+00_r8,0.17400e+00_r8,0.18750e+00_r8,0.20554e+00_r8 /) + kbo(:,16, 1) = (/ & + & 0.16098e+00_r8,0.16593e+00_r8,0.17517e+00_r8,0.18921e+00_r8,0.20772e+00_r8 /) + kbo(:,17, 1) = (/ & + & 0.16129e+00_r8,0.16670e+00_r8,0.17642e+00_r8,0.19093e+00_r8,0.20991e+00_r8 /) + kbo(:,18, 1) = (/ & + & 0.16164e+00_r8,0.16750e+00_r8,0.17771e+00_r8,0.19267e+00_r8,0.21211e+00_r8 /) + kbo(:,19, 1) = (/ & + & 0.16203e+00_r8,0.16832e+00_r8,0.17901e+00_r8,0.19443e+00_r8,0.21431e+00_r8 /) + kbo(:,20, 1) = (/ & + & 0.16255e+00_r8,0.16934e+00_r8,0.18059e+00_r8,0.19653e+00_r8,0.21694e+00_r8 /) + kbo(:,21, 1) = (/ & + & 0.16313e+00_r8,0.17044e+00_r8,0.18225e+00_r8,0.19873e+00_r8,0.21967e+00_r8 /) + kbo(:,22, 1) = (/ & + & 0.16416e+00_r8,0.17227e+00_r8,0.18498e+00_r8,0.20229e+00_r8,0.22406e+00_r8 /) + kbo(:,23, 1) = (/ & + & 0.16539e+00_r8,0.17431e+00_r8,0.18796e+00_r8,0.20612e+00_r8,0.22875e+00_r8 /) + kbo(:,24, 1) = (/ & + & 0.16684e+00_r8,0.17666e+00_r8,0.19125e+00_r8,0.21032e+00_r8,0.23385e+00_r8 /) + kbo(:,25, 1) = (/ & + & 0.16856e+00_r8,0.17939e+00_r8,0.19493e+00_r8,0.21495e+00_r8,0.23943e+00_r8 /) + kbo(:,26, 1) = (/ & + & 0.17067e+00_r8,0.18260e+00_r8,0.19919e+00_r8,0.22024e+00_r8,0.24578e+00_r8 /) + kbo(:,27, 1) = (/ & + & 0.17306e+00_r8,0.18613e+00_r8,0.20377e+00_r8,0.22588e+00_r8,0.25248e+00_r8 /) + kbo(:,28, 1) = (/ & + & 0.17570e+00_r8,0.18994e+00_r8,0.20865e+00_r8,0.23184e+00_r8,0.25952e+00_r8 /) + kbo(:,29, 1) = (/ & + & 0.17882e+00_r8,0.19417e+00_r8,0.21399e+00_r8,0.23828e+00_r8,0.26708e+00_r8 /) + kbo(:,30, 1) = (/ & + & 0.18223e+00_r8,0.19870e+00_r8,0.21964e+00_r8,0.24505e+00_r8,0.27492e+00_r8 /) + kbo(:,31, 1) = (/ & + & 0.18602e+00_r8,0.20364e+00_r8,0.22572e+00_r8,0.25229e+00_r8,0.28325e+00_r8 /) + kbo(:,32, 1) = (/ & + & 0.19018e+00_r8,0.20895e+00_r8,0.23219e+00_r8,0.25994e+00_r8,0.29200e+00_r8 /) + kbo(:,33, 1) = (/ & + & 0.19466e+00_r8,0.21461e+00_r8,0.23902e+00_r8,0.26795e+00_r8,0.30114e+00_r8 /) + kbo(:,34, 1) = (/ & + & 0.19880e+00_r8,0.21976e+00_r8,0.24520e+00_r8,0.27509e+00_r8,0.30932e+00_r8 /) + kbo(:,35, 1) = (/ & + & 0.20129e+00_r8,0.22283e+00_r8,0.24886e+00_r8,0.27931e+00_r8,0.31412e+00_r8 /) + kbo(:,36, 1) = (/ & + & 0.20170e+00_r8,0.22334e+00_r8,0.24946e+00_r8,0.28000e+00_r8,0.31492e+00_r8 /) + kbo(:,37, 1) = (/ & + & 0.19920e+00_r8,0.22026e+00_r8,0.24579e+00_r8,0.27578e+00_r8,0.31010e+00_r8 /) + kbo(:,38, 1) = (/ & + & 0.19662e+00_r8,0.21706e+00_r8,0.24197e+00_r8,0.27135e+00_r8,0.30504e+00_r8 /) + kbo(:,39, 1) = (/ & + & 0.19414e+00_r8,0.21396e+00_r8,0.23824e+00_r8,0.26704e+00_r8,0.30010e+00_r8 /) + kbo(:,40, 1) = (/ & + & 0.19003e+00_r8,0.20877e+00_r8,0.23197e+00_r8,0.25968e+00_r8,0.29171e+00_r8 /) + kbo(:,41, 1) = (/ & + & 0.18597e+00_r8,0.20357e+00_r8,0.22564e+00_r8,0.25219e+00_r8,0.28314e+00_r8 /) + kbo(:,42, 1) = (/ & + & 0.18220e+00_r8,0.19865e+00_r8,0.21958e+00_r8,0.24498e+00_r8,0.27484e+00_r8 /) + kbo(:,43, 1) = (/ & + & 0.17798e+00_r8,0.19304e+00_r8,0.21257e+00_r8,0.23657e+00_r8,0.26510e+00_r8 /) + kbo(:,44, 1) = (/ & + & 0.17397e+00_r8,0.18746e+00_r8,0.20548e+00_r8,0.22798e+00_r8,0.25496e+00_r8 /) + kbo(:,45, 1) = (/ & + & 0.17053e+00_r8,0.18239e+00_r8,0.19890e+00_r8,0.21989e+00_r8,0.24535e+00_r8 /) + kbo(:,46, 1) = (/ & + & 0.16739e+00_r8,0.17754e+00_r8,0.19245e+00_r8,0.21183e+00_r8,0.23568e+00_r8 /) + kbo(:,47, 1) = (/ & + & 0.16454e+00_r8,0.17292e+00_r8,0.18592e+00_r8,0.20351e+00_r8,0.22556e+00_r8 /) + kbo(:,48, 1) = (/ & + & 0.16239e+00_r8,0.16903e+00_r8,0.18011e+00_r8,0.19590e+00_r8,0.21615e+00_r8 /) + kbo(:,49, 1) = (/ & + & 0.16095e+00_r8,0.16584e+00_r8,0.17504e+00_r8,0.18902e+00_r8,0.20747e+00_r8 /) + kbo(:,50, 1) = (/ & + & 0.16025e+00_r8,0.16348e+00_r8,0.17109e+00_r8,0.18322e+00_r8,0.20000e+00_r8 /) + kbo(:,51, 1) = (/ & + & 0.16021e+00_r8,0.16179e+00_r8,0.16781e+00_r8,0.17821e+00_r8,0.19335e+00_r8 /) + kbo(:,52, 1) = (/ & + & 0.16078e+00_r8,0.16068e+00_r8,0.16511e+00_r8,0.17387e+00_r8,0.18731e+00_r8 /) + kbo(:,53, 1) = (/ & + & 0.16197e+00_r8,0.16018e+00_r8,0.16299e+00_r8,0.17017e+00_r8,0.18186e+00_r8 /) + kbo(:,54, 1) = (/ & + & 0.16362e+00_r8,0.16026e+00_r8,0.16155e+00_r8,0.16729e+00_r8,0.17738e+00_r8 /) + kbo(:,55, 1) = (/ & + & 0.16570e+00_r8,0.16083e+00_r8,0.16064e+00_r8,0.16498e+00_r8,0.17365e+00_r8 /) + kbo(:,56, 1) = (/ & + & 0.16825e+00_r8,0.16187e+00_r8,0.16020e+00_r8,0.16311e+00_r8,0.17041e+00_r8 /) + kbo(:,57, 1) = (/ & + & 0.17129e+00_r8,0.16340e+00_r8,0.16023e+00_r8,0.16169e+00_r8,0.16761e+00_r8 /) + kbo(:,58, 1) = (/ & + & 0.17462e+00_r8,0.16529e+00_r8,0.16069e+00_r8,0.16077e+00_r8,0.16535e+00_r8 /) + kbo(:,59, 1) = (/ & + & 0.17607e+00_r8,0.16617e+00_r8,0.16100e+00_r8,0.16051e+00_r8,0.16456e+00_r8 /) + kbo(:,13, 2) = (/ & + & 0.17525e+01_r8,0.17727e+01_r8,0.18119e+01_r8,0.18712e+01_r8,0.19491e+01_r8 /) + kbo(:,14, 2) = (/ & + & 0.17536e+01_r8,0.17755e+01_r8,0.18165e+01_r8,0.18775e+01_r8,0.19571e+01_r8 /) + kbo(:,15, 2) = (/ & + & 0.17549e+01_r8,0.17787e+01_r8,0.18219e+01_r8,0.18847e+01_r8,0.19662e+01_r8 /) + kbo(:,16, 2) = (/ & + & 0.17565e+01_r8,0.17819e+01_r8,0.18278e+01_r8,0.18925e+01_r8,0.19761e+01_r8 /) + kbo(:,17, 2) = (/ & + & 0.17583e+01_r8,0.17850e+01_r8,0.18336e+01_r8,0.19003e+01_r8,0.19859e+01_r8 /) + kbo(:,18, 2) = (/ & + & 0.17603e+01_r8,0.17891e+01_r8,0.18396e+01_r8,0.19082e+01_r8,0.19957e+01_r8 /) + kbo(:,19, 2) = (/ & + & 0.17624e+01_r8,0.17934e+01_r8,0.18457e+01_r8,0.19162e+01_r8,0.20056e+01_r8 /) + kbo(:,20, 2) = (/ & + & 0.17652e+01_r8,0.17986e+01_r8,0.18530e+01_r8,0.19257e+01_r8,0.20174e+01_r8 /) + kbo(:,21, 2) = (/ & + & 0.17683e+01_r8,0.18042e+01_r8,0.18607e+01_r8,0.19356e+01_r8,0.20296e+01_r8 /) + kbo(:,22, 2) = (/ & + & 0.17736e+01_r8,0.18133e+01_r8,0.18732e+01_r8,0.19516e+01_r8,0.20492e+01_r8 /) + kbo(:,23, 2) = (/ & + & 0.17796e+01_r8,0.18234e+01_r8,0.18868e+01_r8,0.19689e+01_r8,0.20702e+01_r8 /) + kbo(:,24, 2) = (/ & + & 0.17857e+01_r8,0.18347e+01_r8,0.19018e+01_r8,0.19877e+01_r8,0.20929e+01_r8 /) + kbo(:,25, 2) = (/ & + & 0.17946e+01_r8,0.18475e+01_r8,0.19185e+01_r8,0.20085e+01_r8,0.21178e+01_r8 /) + kbo(:,26, 2) = (/ & + & 0.18053e+01_r8,0.18623e+01_r8,0.19377e+01_r8,0.20322e+01_r8,0.21460e+01_r8 /) + kbo(:,27, 2) = (/ & + & 0.18172e+01_r8,0.18785e+01_r8,0.19583e+01_r8,0.20574e+01_r8,0.21757e+01_r8 /) + kbo(:,28, 2) = (/ & + & 0.18303e+01_r8,0.18959e+01_r8,0.19802e+01_r8,0.20839e+01_r8,0.22069e+01_r8 /) + kbo(:,29, 2) = (/ & + & 0.18448e+01_r8,0.19150e+01_r8,0.20042e+01_r8,0.21126e+01_r8,0.22404e+01_r8 /) + kbo(:,30, 2) = (/ & + & 0.18606e+01_r8,0.19355e+01_r8,0.20295e+01_r8,0.21428e+01_r8,0.22754e+01_r8 /) + kbo(:,31, 2) = (/ & + & 0.18780e+01_r8,0.19577e+01_r8,0.20566e+01_r8,0.21749e+01_r8,0.23125e+01_r8 /) + kbo(:,32, 2) = (/ & + & 0.18969e+01_r8,0.19816e+01_r8,0.20855e+01_r8,0.22088e+01_r8,0.23514e+01_r8 /) + kbo(:,33, 2) = (/ & + & 0.19172e+01_r8,0.20069e+01_r8,0.21160e+01_r8,0.22443e+01_r8,0.23920e+01_r8 /) + kbo(:,34, 2) = (/ & + & 0.19359e+01_r8,0.20300e+01_r8,0.21434e+01_r8,0.22762e+01_r8,0.24282e+01_r8 /) + kbo(:,35, 2) = (/ & + & 0.19471e+01_r8,0.20437e+01_r8,0.21597e+01_r8,0.22949e+01_r8,0.24495e+01_r8 /) + kbo(:,36, 2) = (/ & + & 0.19490e+01_r8,0.20460e+01_r8,0.21624e+01_r8,0.22980e+01_r8,0.24530e+01_r8 /) + kbo(:,37, 2) = (/ & + & 0.19377e+01_r8,0.20322e+01_r8,0.21461e+01_r8,0.22792e+01_r8,0.24317e+01_r8 /) + kbo(:,38, 2) = (/ & + & 0.19261e+01_r8,0.20179e+01_r8,0.21291e+01_r8,0.22595e+01_r8,0.24093e+01_r8 /) + kbo(:,39, 2) = (/ & + & 0.19149e+01_r8,0.20040e+01_r8,0.21125e+01_r8,0.22402e+01_r8,0.23873e+01_r8 /) + kbo(:,40, 2) = (/ & + & 0.18963e+01_r8,0.19807e+01_r8,0.20845e+01_r8,0.22076e+01_r8,0.23501e+01_r8 /) + kbo(:,41, 2) = (/ & + & 0.18778e+01_r8,0.19574e+01_r8,0.20563e+01_r8,0.21745e+01_r8,0.23120e+01_r8 /) + kbo(:,42, 2) = (/ & + & 0.18604e+01_r8,0.19352e+01_r8,0.20292e+01_r8,0.21425e+01_r8,0.22750e+01_r8 /) + kbo(:,43, 2) = (/ & + & 0.18409e+01_r8,0.19099e+01_r8,0.19978e+01_r8,0.21050e+01_r8,0.22315e+01_r8 /) + kbo(:,44, 2) = (/ & + & 0.18217e+01_r8,0.18845e+01_r8,0.19660e+01_r8,0.20667e+01_r8,0.21867e+01_r8 /) + kbo(:,45, 2) = (/ & + & 0.18046e+01_r8,0.18613e+01_r8,0.19364e+01_r8,0.20306e+01_r8,0.21441e+01_r8 /) + kbo(:,46, 2) = (/ & + & 0.17886e+01_r8,0.18389e+01_r8,0.19072e+01_r8,0.19945e+01_r8,0.21011e+01_r8 /) + kbo(:,47, 2) = (/ & + & 0.17755e+01_r8,0.18165e+01_r8,0.18775e+01_r8,0.19571e+01_r8,0.20559e+01_r8 /) + kbo(:,48, 2) = (/ & + & 0.17644e+01_r8,0.17970e+01_r8,0.18508e+01_r8,0.19228e+01_r8,0.20139e+01_r8 /) + kbo(:,49, 2) = (/ & + & 0.17563e+01_r8,0.17816e+01_r8,0.18271e+01_r8,0.18916e+01_r8,0.19749e+01_r8 /) + kbo(:,50, 2) = (/ & + & 0.17517e+01_r8,0.17702e+01_r8,0.18074e+01_r8,0.18651e+01_r8,0.19413e+01_r8 /) + kbo(:,51, 2) = (/ & + & 0.17504e+01_r8,0.17611e+01_r8,0.17908e+01_r8,0.18420e+01_r8,0.19113e+01_r8 /) + kbo(:,52, 2) = (/ & + & 0.17523e+01_r8,0.17547e+01_r8,0.17783e+01_r8,0.18212e+01_r8,0.18839e+01_r8 /) + kbo(:,53, 2) = (/ & + & 0.17566e+01_r8,0.17510e+01_r8,0.17675e+01_r8,0.18028e+01_r8,0.18589e+01_r8 /) + kbo(:,54, 2) = (/ & + & 0.17623e+01_r8,0.17507e+01_r8,0.17598e+01_r8,0.17881e+01_r8,0.18381e+01_r8 /) + kbo(:,55, 2) = (/ & + & 0.17691e+01_r8,0.17524e+01_r8,0.17544e+01_r8,0.17777e+01_r8,0.18201e+01_r8 /) + kbo(:,56, 2) = (/ & + & 0.17776e+01_r8,0.17562e+01_r8,0.17512e+01_r8,0.17682e+01_r8,0.18040e+01_r8 /) + kbo(:,57, 2) = (/ & + & 0.17881e+01_r8,0.17616e+01_r8,0.17505e+01_r8,0.17606e+01_r8,0.17897e+01_r8 /) + kbo(:,58, 2) = (/ & + & 0.17996e+01_r8,0.17678e+01_r8,0.17520e+01_r8,0.17552e+01_r8,0.17794e+01_r8 /) + kbo(:,59, 2) = (/ & + & 0.18045e+01_r8,0.17707e+01_r8,0.17530e+01_r8,0.17536e+01_r8,0.17756e+01_r8 /) + kbo(:,13, 3) = (/ & + & 0.10945e+02_r8,0.11052e+02_r8,0.11222e+02_r8,0.11452e+02_r8,0.11744e+02_r8 /) + kbo(:,14, 3) = (/ & + & 0.10952e+02_r8,0.11065e+02_r8,0.11240e+02_r8,0.11476e+02_r8,0.11774e+02_r8 /) + kbo(:,15, 3) = (/ & + & 0.10961e+02_r8,0.11080e+02_r8,0.11261e+02_r8,0.11503e+02_r8,0.11807e+02_r8 /) + kbo(:,16, 3) = (/ & + & 0.10971e+02_r8,0.11097e+02_r8,0.11284e+02_r8,0.11533e+02_r8,0.11844e+02_r8 /) + kbo(:,17, 3) = (/ & + & 0.10981e+02_r8,0.11115e+02_r8,0.11307e+02_r8,0.11562e+02_r8,0.11879e+02_r8 /) + kbo(:,18, 3) = (/ & + & 0.10992e+02_r8,0.11132e+02_r8,0.11331e+02_r8,0.11592e+02_r8,0.11915e+02_r8 /) + kbo(:,19, 3) = (/ & + & 0.11003e+02_r8,0.11149e+02_r8,0.11354e+02_r8,0.11622e+02_r8,0.11951e+02_r8 /) + kbo(:,20, 3) = (/ & + & 0.11017e+02_r8,0.11170e+02_r8,0.11382e+02_r8,0.11657e+02_r8,0.11994e+02_r8 /) + kbo(:,21, 3) = (/ & + & 0.11031e+02_r8,0.11192e+02_r8,0.11412e+02_r8,0.11694e+02_r8,0.12038e+02_r8 /) + kbo(:,22, 3) = (/ & + & 0.11056e+02_r8,0.11228e+02_r8,0.11460e+02_r8,0.11754e+02_r8,0.12109e+02_r8 /) + kbo(:,23, 3) = (/ & + & 0.11085e+02_r8,0.11267e+02_r8,0.11511e+02_r8,0.11817e+02_r8,0.12184e+02_r8 /) + kbo(:,24, 3) = (/ & + & 0.11118e+02_r8,0.11312e+02_r8,0.11568e+02_r8,0.11886e+02_r8,0.12266e+02_r8 /) + kbo(:,25, 3) = (/ & + & 0.11154e+02_r8,0.11361e+02_r8,0.11630e+02_r8,0.11962e+02_r8,0.12354e+02_r8 /) + kbo(:,26, 3) = (/ & + & 0.11196e+02_r8,0.11418e+02_r8,0.11702e+02_r8,0.12048e+02_r8,0.12455e+02_r8 /) + kbo(:,27, 3) = (/ & + & 0.11243e+02_r8,0.11480e+02_r8,0.11778e+02_r8,0.12138e+02_r8,0.12560e+02_r8 /) + kbo(:,28, 3) = (/ & + & 0.11294e+02_r8,0.11545e+02_r8,0.11859e+02_r8,0.12234e+02_r8,0.12670e+02_r8 /) + kbo(:,29, 3) = (/ & + & 0.11351e+02_r8,0.11617e+02_r8,0.11946e+02_r8,0.12336e+02_r8,0.12788e+02_r8 /) + kbo(:,30, 3) = (/ & + & 0.11411e+02_r8,0.11694e+02_r8,0.12038e+02_r8,0.12443e+02_r8,0.12910e+02_r8 /) + kbo(:,31, 3) = (/ & + & 0.11478e+02_r8,0.11776e+02_r8,0.12136e+02_r8,0.12557e+02_r8,0.13040e+02_r8 /) + kbo(:,32, 3) = (/ & + & 0.11549e+02_r8,0.11864e+02_r8,0.12239e+02_r8,0.12677e+02_r8,0.13175e+02_r8 /) + kbo(:,33, 3) = (/ & + & 0.11626e+02_r8,0.11956e+02_r8,0.12348e+02_r8,0.12801e+02_r8,0.13316e+02_r8 /) + kbo(:,34, 3) = (/ & + & 0.11695e+02_r8,0.12040e+02_r8,0.12446e+02_r8,0.12913e+02_r8,0.13442e+02_r8 /) + kbo(:,35, 3) = (/ & + & 0.11737e+02_r8,0.12089e+02_r8,0.12503e+02_r8,0.12979e+02_r8,0.13515e+02_r8 /) + kbo(:,36, 3) = (/ & + & 0.11744e+02_r8,0.12098e+02_r8,0.12513e+02_r8,0.12989e+02_r8,0.13528e+02_r8 /) + kbo(:,37, 3) = (/ & + & 0.11702e+02_r8,0.12048e+02_r8,0.12455e+02_r8,0.12924e+02_r8,0.13454e+02_r8 /) + kbo(:,38, 3) = (/ & + & 0.11659e+02_r8,0.11996e+02_r8,0.12395e+02_r8,0.12855e+02_r8,0.13376e+02_r8 /) + kbo(:,39, 3) = (/ & + & 0.11617e+02_r8,0.11946e+02_r8,0.12336e+02_r8,0.12787e+02_r8,0.13300e+02_r8 /) + kbo(:,40, 3) = (/ & + & 0.11547e+02_r8,0.11861e+02_r8,0.12236e+02_r8,0.12673e+02_r8,0.13171e+02_r8 /) + kbo(:,41, 3) = (/ & + & 0.11477e+02_r8,0.11775e+02_r8,0.12134e+02_r8,0.12555e+02_r8,0.13038e+02_r8 /) + kbo(:,42, 3) = (/ & + & 0.11411e+02_r8,0.11693e+02_r8,0.12037e+02_r8,0.12442e+02_r8,0.12909e+02_r8 /) + kbo(:,43, 3) = (/ & + & 0.11335e+02_r8,0.11598e+02_r8,0.11923e+02_r8,0.12309e+02_r8,0.12757e+02_r8 /) + kbo(:,44, 3) = (/ & + & 0.11261e+02_r8,0.11503e+02_r8,0.11807e+02_r8,0.12172e+02_r8,0.12599e+02_r8 /) + kbo(:,45, 3) = (/ & + & 0.11193e+02_r8,0.11414e+02_r8,0.11697e+02_r8,0.12042e+02_r8,0.12448e+02_r8 /) + kbo(:,46, 3) = (/ & + & 0.11129e+02_r8,0.11328e+02_r8,0.11588e+02_r8,0.11911e+02_r8,0.12295e+02_r8 /) + kbo(:,47, 3) = (/ & + & 0.11065e+02_r8,0.11240e+02_r8,0.11476e+02_r8,0.11774e+02_r8,0.12133e+02_r8 /) + kbo(:,48, 3) = (/ & + & 0.11012e+02_r8,0.11163e+02_r8,0.11374e+02_r8,0.11647e+02_r8,0.11981e+02_r8 /) + kbo(:,49, 3) = (/ & + & 0.10969e+02_r8,0.11095e+02_r8,0.11282e+02_r8,0.11530e+02_r8,0.11839e+02_r8 /) + kbo(:,50, 3) = (/ & + & 0.10938e+02_r8,0.11040e+02_r8,0.11204e+02_r8,0.11429e+02_r8,0.11715e+02_r8 /) + kbo(:,51, 3) = (/ & + & 0.10916e+02_r8,0.10996e+02_r8,0.11138e+02_r8,0.11340e+02_r8,0.11604e+02_r8 /) + kbo(:,52, 3) = (/ & + & 0.10900e+02_r8,0.10960e+02_r8,0.11079e+02_r8,0.11259e+02_r8,0.11500e+02_r8 /) + kbo(:,53, 3) = (/ & + & 0.10894e+02_r8,0.10932e+02_r8,0.11028e+02_r8,0.11186e+02_r8,0.11405e+02_r8 /) + kbo(:,54, 3) = (/ & + & 0.10895e+02_r8,0.10912e+02_r8,0.10989e+02_r8,0.11127e+02_r8,0.11325e+02_r8 /) + kbo(:,55, 3) = (/ & + & 0.10903e+02_r8,0.10900e+02_r8,0.10958e+02_r8,0.11075e+02_r8,0.11255e+02_r8 /) + kbo(:,56, 3) = (/ & + & 0.10921e+02_r8,0.10894e+02_r8,0.10933e+02_r8,0.11031e+02_r8,0.11191e+02_r8 /) + kbo(:,57, 3) = (/ & + & 0.10944e+02_r8,0.10894e+02_r8,0.10914e+02_r8,0.10993e+02_r8,0.11134e+02_r8 /) + kbo(:,58, 3) = (/ & + & 0.10972e+02_r8,0.10901e+02_r8,0.10902e+02_r8,0.10963e+02_r8,0.11084e+02_r8 /) + kbo(:,59, 3) = (/ & + & 0.10984e+02_r8,0.10906e+02_r8,0.10898e+02_r8,0.10952e+02_r8,0.11066e+02_r8 /) + kbo(:,13, 4) = (/ & + & 0.51563e+02_r8,0.51946e+02_r8,0.52464e+02_r8,0.53116e+02_r8,0.53902e+02_r8 /) + kbo(:,14, 4) = (/ & + & 0.51593e+02_r8,0.51987e+02_r8,0.52517e+02_r8,0.53182e+02_r8,0.53980e+02_r8 /) + kbo(:,15, 4) = (/ & + & 0.51626e+02_r8,0.52035e+02_r8,0.52579e+02_r8,0.53256e+02_r8,0.54069e+02_r8 /) + kbo(:,16, 4) = (/ & + & 0.51664e+02_r8,0.52087e+02_r8,0.52644e+02_r8,0.53337e+02_r8,0.54163e+02_r8 /) + kbo(:,17, 4) = (/ & + & 0.51701e+02_r8,0.52138e+02_r8,0.52710e+02_r8,0.53416e+02_r8,0.54257e+02_r8 /) + kbo(:,18, 4) = (/ & + & 0.51740e+02_r8,0.52191e+02_r8,0.52776e+02_r8,0.53496e+02_r8,0.54351e+02_r8 /) + kbo(:,19, 4) = (/ & + & 0.51779e+02_r8,0.52244e+02_r8,0.52843e+02_r8,0.53576e+02_r8,0.54444e+02_r8 /) + kbo(:,20, 4) = (/ & + & 0.51827e+02_r8,0.52307e+02_r8,0.52922e+02_r8,0.53671e+02_r8,0.54555e+02_r8 /) + kbo(:,21, 4) = (/ & + & 0.51877e+02_r8,0.52373e+02_r8,0.53004e+02_r8,0.53770e+02_r8,0.54669e+02_r8 /) + kbo(:,22, 4) = (/ & + & 0.51959e+02_r8,0.52481e+02_r8,0.53136e+02_r8,0.53927e+02_r8,0.54851e+02_r8 /) + kbo(:,23, 4) = (/ & + & 0.52049e+02_r8,0.52596e+02_r8,0.53278e+02_r8,0.54094e+02_r8,0.55044e+02_r8 /) + kbo(:,24, 4) = (/ & + & 0.52148e+02_r8,0.52723e+02_r8,0.53431e+02_r8,0.54274e+02_r8,0.55252e+02_r8 /) + kbo(:,25, 4) = (/ & + & 0.52259e+02_r8,0.52862e+02_r8,0.53599e+02_r8,0.54471e+02_r8,0.55477e+02_r8 /) + kbo(:,26, 4) = (/ & + & 0.52387e+02_r8,0.53022e+02_r8,0.53790e+02_r8,0.54693e+02_r8,0.55730e+02_r8 /) + kbo(:,27, 4) = (/ & + & 0.52525e+02_r8,0.53191e+02_r8,0.53992e+02_r8,0.54926e+02_r8,0.55995e+02_r8 /) + kbo(:,28, 4) = (/ & + & 0.52672e+02_r8,0.53371e+02_r8,0.54203e+02_r8,0.55170e+02_r8,0.56271e+02_r8 /) + kbo(:,29, 4) = (/ & + & 0.52833e+02_r8,0.53565e+02_r8,0.54430e+02_r8,0.55430e+02_r8,0.56565e+02_r8 /) + kbo(:,30, 4) = (/ & + & 0.53003e+02_r8,0.53768e+02_r8,0.54668e+02_r8,0.55702e+02_r8,0.56870e+02_r8 /) + kbo(:,31, 4) = (/ & + & 0.53186e+02_r8,0.53986e+02_r8,0.54920e+02_r8,0.55988e+02_r8,0.57190e+02_r8 /) + kbo(:,32, 4) = (/ & + & 0.53381e+02_r8,0.54216e+02_r8,0.55184e+02_r8,0.56287e+02_r8,0.57525e+02_r8 /) + kbo(:,33, 4) = (/ & + & 0.53587e+02_r8,0.54457e+02_r8,0.55460e+02_r8,0.56599e+02_r8,0.57871e+02_r8 /) + kbo(:,34, 4) = (/ & + & 0.53773e+02_r8,0.54673e+02_r8,0.55707e+02_r8,0.56876e+02_r8,0.58179e+02_r8 /) + kbo(:,35, 4) = (/ & + & 0.53883e+02_r8,0.54800e+02_r8,0.55852e+02_r8,0.57039e+02_r8,0.58359e+02_r8 /) + kbo(:,36, 4) = (/ & + & 0.53901e+02_r8,0.54822e+02_r8,0.55876e+02_r8,0.57066e+02_r8,0.58389e+02_r8 /) + kbo(:,37, 4) = (/ & + & 0.53791e+02_r8,0.54694e+02_r8,0.55731e+02_r8,0.56903e+02_r8,0.58208e+02_r8 /) + kbo(:,38, 4) = (/ & + & 0.53676e+02_r8,0.54560e+02_r8,0.55578e+02_r8,0.56731e+02_r8,0.58018e+02_r8 /) + kbo(:,39, 4) = (/ & + & 0.53563e+02_r8,0.54429e+02_r8,0.55429e+02_r8,0.56563e+02_r8,0.57832e+02_r8 /) + kbo(:,40, 4) = (/ & + & 0.53375e+02_r8,0.54208e+02_r8,0.55175e+02_r8,0.56277e+02_r8,0.57513e+02_r8 /) + kbo(:,41, 4) = (/ & + & 0.53184e+02_r8,0.53983e+02_r8,0.54916e+02_r8,0.55984e+02_r8,0.57186e+02_r8 /) + kbo(:,42, 4) = (/ & + & 0.53001e+02_r8,0.53766e+02_r8,0.54665e+02_r8,0.55699e+02_r8,0.56866e+02_r8 /) + kbo(:,43, 4) = (/ & + & 0.52790e+02_r8,0.53513e+02_r8,0.54370e+02_r8,0.55362e+02_r8,0.56488e+02_r8 /) + kbo(:,44, 4) = (/ & + & 0.52577e+02_r8,0.53254e+02_r8,0.54066e+02_r8,0.55012e+02_r8,0.56093e+02_r8 /) + kbo(:,45, 4) = (/ & + & 0.52379e+02_r8,0.53011e+02_r8,0.53777e+02_r8,0.54678e+02_r8,0.55713e+02_r8 /) + kbo(:,46, 4) = (/ & + & 0.52184e+02_r8,0.52768e+02_r8,0.53486e+02_r8,0.54339e+02_r8,0.55326e+02_r8 /) + kbo(:,47, 4) = (/ & + & 0.51987e+02_r8,0.52517e+02_r8,0.53182e+02_r8,0.53980e+02_r8,0.54913e+02_r8 /) + kbo(:,48, 4) = (/ & + & 0.51812e+02_r8,0.52288e+02_r8,0.52898e+02_r8,0.53643e+02_r8,0.54522e+02_r8 /) + kbo(:,49, 4) = (/ & + & 0.51659e+02_r8,0.52081e+02_r8,0.52637e+02_r8,0.53327e+02_r8,0.54152e+02_r8 /) + kbo(:,50, 4) = (/ & + & 0.51535e+02_r8,0.51906e+02_r8,0.52412e+02_r8,0.53052e+02_r8,0.53826e+02_r8 /) + kbo(:,51, 4) = (/ & + & 0.51433e+02_r8,0.51755e+02_r8,0.52211e+02_r8,0.52802e+02_r8,0.53527e+02_r8 /) + kbo(:,52, 4) = (/ & + & 0.51349e+02_r8,0.51622e+02_r8,0.52029e+02_r8,0.52571e+02_r8,0.53247e+02_r8 /) + kbo(:,53, 4) = (/ & + & 0.51285e+02_r8,0.51507e+02_r8,0.51865e+02_r8,0.52358e+02_r8,0.52985e+02_r8 /) + kbo(:,54, 4) = (/ & + & 0.51240e+02_r8,0.51417e+02_r8,0.51730e+02_r8,0.52178e+02_r8,0.52760e+02_r8 /) + kbo(:,55, 4) = (/ & + & 0.51211e+02_r8,0.51346e+02_r8,0.51615e+02_r8,0.52020e+02_r8,0.52559e+02_r8 /) + kbo(:,56, 4) = (/ & + & 0.51194e+02_r8,0.51288e+02_r8,0.51514e+02_r8,0.51875e+02_r8,0.52371e+02_r8 /) + kbo(:,57, 4) = (/ & + & 0.51190e+02_r8,0.51245e+02_r8,0.51426e+02_r8,0.51746e+02_r8,0.52198e+02_r8 /) + kbo(:,58, 4) = (/ & + & 0.51200e+02_r8,0.51216e+02_r8,0.51357e+02_r8,0.51635e+02_r8,0.52046e+02_r8 /) + kbo(:,59, 4) = (/ & + & 0.51207e+02_r8,0.51207e+02_r8,0.51333e+02_r8,0.51594e+02_r8,0.51989e+02_r8 /) + kbo(:,13, 5) = (/ & + & 0.17051e+03_r8,0.17168e+03_r8,0.17297e+03_r8,0.17437e+03_r8,0.17590e+03_r8 /) + kbo(:,14, 5) = (/ & + & 0.17061e+03_r8,0.17179e+03_r8,0.17309e+03_r8,0.17451e+03_r8,0.17604e+03_r8 /) + kbo(:,15, 5) = (/ & + & 0.17073e+03_r8,0.17192e+03_r8,0.17323e+03_r8,0.17466e+03_r8,0.17621e+03_r8 /) + kbo(:,16, 5) = (/ & + & 0.17085e+03_r8,0.17205e+03_r8,0.17338e+03_r8,0.17482e+03_r8,0.17638e+03_r8 /) + kbo(:,17, 5) = (/ & + & 0.17097e+03_r8,0.17218e+03_r8,0.17352e+03_r8,0.17497e+03_r8,0.17655e+03_r8 /) + kbo(:,18, 5) = (/ & + & 0.17109e+03_r8,0.17232e+03_r8,0.17366e+03_r8,0.17513e+03_r8,0.17671e+03_r8 /) + kbo(:,19, 5) = (/ & + & 0.17121e+03_r8,0.17245e+03_r8,0.17381e+03_r8,0.17528e+03_r8,0.17688e+03_r8 /) + kbo(:,20, 5) = (/ & + & 0.17134e+03_r8,0.17260e+03_r8,0.17397e+03_r8,0.17547e+03_r8,0.17708e+03_r8 /) + kbo(:,21, 5) = (/ & + & 0.17149e+03_r8,0.17276e+03_r8,0.17415e+03_r8,0.17565e+03_r8,0.17728e+03_r8 /) + kbo(:,22, 5) = (/ & + & 0.17172e+03_r8,0.17301e+03_r8,0.17442e+03_r8,0.17594e+03_r8,0.17759e+03_r8 /) + kbo(:,23, 5) = (/ & + & 0.17195e+03_r8,0.17327e+03_r8,0.17470e+03_r8,0.17625e+03_r8,0.17792e+03_r8 /) + kbo(:,24, 5) = (/ & + & 0.17221e+03_r8,0.17355e+03_r8,0.17500e+03_r8,0.17658e+03_r8,0.17827e+03_r8 /) + kbo(:,25, 5) = (/ & + & 0.17248e+03_r8,0.17385e+03_r8,0.17533e+03_r8,0.17693e+03_r8,0.17865e+03_r8 /) + kbo(:,26, 5) = (/ & + & 0.17279e+03_r8,0.17418e+03_r8,0.17569e+03_r8,0.17732e+03_r8,0.17906e+03_r8 /) + kbo(:,27, 5) = (/ & + & 0.17311e+03_r8,0.17453e+03_r8,0.17606e+03_r8,0.17772e+03_r8,0.17949e+03_r8 /) + kbo(:,28, 5) = (/ & + & 0.17344e+03_r8,0.17488e+03_r8,0.17645e+03_r8,0.17813e+03_r8,0.17994e+03_r8 /) + kbo(:,29, 5) = (/ & + & 0.17379e+03_r8,0.17526e+03_r8,0.17686e+03_r8,0.17857e+03_r8,0.18040e+03_r8 /) + kbo(:,30, 5) = (/ & + & 0.17414e+03_r8,0.17565e+03_r8,0.17727e+03_r8,0.17902e+03_r8,0.18088e+03_r8 /) + kbo(:,31, 5) = (/ & + & 0.17452e+03_r8,0.17605e+03_r8,0.17771e+03_r8,0.17948e+03_r8,0.18137e+03_r8 /) + kbo(:,32, 5) = (/ & + & 0.17491e+03_r8,0.17647e+03_r8,0.17816e+03_r8,0.17996e+03_r8,0.18188e+03_r8 /) + kbo(:,33, 5) = (/ & + & 0.17531e+03_r8,0.17690e+03_r8,0.17862e+03_r8,0.18045e+03_r8,0.18241e+03_r8 /) + kbo(:,34, 5) = (/ & + & 0.17566e+03_r8,0.17728e+03_r8,0.17903e+03_r8,0.18089e+03_r8,0.18287e+03_r8 /) + kbo(:,35, 5) = (/ & + & 0.17586e+03_r8,0.17750e+03_r8,0.17926e+03_r8,0.18114e+03_r8,0.18313e+03_r8 /) + kbo(:,36, 5) = (/ & + & 0.17590e+03_r8,0.17754e+03_r8,0.17930e+03_r8,0.18118e+03_r8,0.18318e+03_r8 /) + kbo(:,37, 5) = (/ & + & 0.17569e+03_r8,0.17732e+03_r8,0.17906e+03_r8,0.18093e+03_r8,0.18291e+03_r8 /) + kbo(:,38, 5) = (/ & + & 0.17547e+03_r8,0.17708e+03_r8,0.17881e+03_r8,0.18066e+03_r8,0.18263e+03_r8 /) + kbo(:,39, 5) = (/ & + & 0.17526e+03_r8,0.17685e+03_r8,0.17857e+03_r8,0.18040e+03_r8,0.18235e+03_r8 /) + kbo(:,40, 5) = (/ & + & 0.17489e+03_r8,0.17646e+03_r8,0.17814e+03_r8,0.17995e+03_r8,0.18187e+03_r8 /) + kbo(:,41, 5) = (/ & + & 0.17451e+03_r8,0.17605e+03_r8,0.17770e+03_r8,0.17948e+03_r8,0.18137e+03_r8 /) + kbo(:,42, 5) = (/ & + & 0.17414e+03_r8,0.17565e+03_r8,0.17727e+03_r8,0.17901e+03_r8,0.18087e+03_r8 /) + kbo(:,43, 5) = (/ & + & 0.17369e+03_r8,0.17516e+03_r8,0.17675e+03_r8,0.17846e+03_r8,0.18028e+03_r8 /) + kbo(:,44, 5) = (/ & + & 0.17323e+03_r8,0.17465e+03_r8,0.17620e+03_r8,0.17787e+03_r8,0.17965e+03_r8 /) + kbo(:,45, 5) = (/ & + & 0.17277e+03_r8,0.17416e+03_r8,0.17567e+03_r8,0.17729e+03_r8,0.17904e+03_r8 /) + kbo(:,46, 5) = (/ & + & 0.17230e+03_r8,0.17365e+03_r8,0.17511e+03_r8,0.17669e+03_r8,0.17840e+03_r8 /) + kbo(:,47, 5) = (/ & + & 0.17179e+03_r8,0.17309e+03_r8,0.17451e+03_r8,0.17604e+03_r8,0.17770e+03_r8 /) + kbo(:,48, 5) = (/ & + & 0.17130e+03_r8,0.17255e+03_r8,0.17392e+03_r8,0.17541e+03_r8,0.17702e+03_r8 /) + kbo(:,49, 5) = (/ & + & 0.17083e+03_r8,0.17204e+03_r8,0.17336e+03_r8,0.17480e+03_r8,0.17636e+03_r8 /) + kbo(:,50, 5) = (/ & + & 0.17041e+03_r8,0.17157e+03_r8,0.17285e+03_r8,0.17424e+03_r8,0.17576e+03_r8 /) + kbo(:,51, 5) = (/ & + & 0.17002e+03_r8,0.17113e+03_r8,0.17237e+03_r8,0.17372e+03_r8,0.17519e+03_r8 /) + kbo(:,52, 5) = (/ & + & 0.16964e+03_r8,0.17071e+03_r8,0.17190e+03_r8,0.17321e+03_r8,0.17464e+03_r8 /) + kbo(:,53, 5) = (/ & + & 0.16927e+03_r8,0.17031e+03_r8,0.17145e+03_r8,0.17272e+03_r8,0.17411e+03_r8 /) + kbo(:,54, 5) = (/ & + & 0.16896e+03_r8,0.16995e+03_r8,0.17106e+03_r8,0.17228e+03_r8,0.17363e+03_r8 /) + kbo(:,55, 5) = (/ & + & 0.16866e+03_r8,0.16962e+03_r8,0.17069e+03_r8,0.17188e+03_r8,0.17318e+03_r8 /) + kbo(:,56, 5) = (/ & + & 0.16839e+03_r8,0.16930e+03_r8,0.17033e+03_r8,0.17148e+03_r8,0.17275e+03_r8 /) + kbo(:,57, 5) = (/ & + & 0.16812e+03_r8,0.16899e+03_r8,0.16999e+03_r8,0.17110e+03_r8,0.17233e+03_r8 /) + kbo(:,58, 5) = (/ & + & 0.16788e+03_r8,0.16871e+03_r8,0.16968e+03_r8,0.17075e+03_r8,0.17195e+03_r8 /) + kbo(:,59, 5) = (/ & + & 0.16779e+03_r8,0.16861e+03_r8,0.16955e+03_r8,0.17062e+03_r8,0.17180e+03_r8 /) + kbo(:,13, 6) = (/ & + & 0.38122e+03_r8,0.38406e+03_r8,0.38668e+03_r8,0.38908e+03_r8,0.39125e+03_r8 /) + kbo(:,14, 6) = (/ & + & 0.38148e+03_r8,0.38431e+03_r8,0.38691e+03_r8,0.38929e+03_r8,0.39144e+03_r8 /) + kbo(:,15, 6) = (/ & + & 0.38178e+03_r8,0.38458e+03_r8,0.38716e+03_r8,0.38951e+03_r8,0.39164e+03_r8 /) + kbo(:,16, 6) = (/ & + & 0.38209e+03_r8,0.38487e+03_r8,0.38742e+03_r8,0.38975e+03_r8,0.39186e+03_r8 /) + kbo(:,17, 6) = (/ & + & 0.38239e+03_r8,0.38514e+03_r8,0.38767e+03_r8,0.38998e+03_r8,0.39206e+03_r8 /) + kbo(:,18, 6) = (/ & + & 0.38268e+03_r8,0.38541e+03_r8,0.38792e+03_r8,0.39020e+03_r8,0.39226e+03_r8 /) + kbo(:,19, 6) = (/ & + & 0.38297e+03_r8,0.38568e+03_r8,0.38816e+03_r8,0.39042e+03_r8,0.39246e+03_r8 /) + kbo(:,20, 6) = (/ & + & 0.38330e+03_r8,0.38598e+03_r8,0.38844e+03_r8,0.39067e+03_r8,0.39268e+03_r8 /) + kbo(:,21, 6) = (/ & + & 0.38363e+03_r8,0.38629e+03_r8,0.38872e+03_r8,0.39092e+03_r8,0.39291e+03_r8 /) + kbo(:,22, 6) = (/ & + & 0.38414e+03_r8,0.38675e+03_r8,0.38914e+03_r8,0.39131e+03_r8,0.39325e+03_r8 /) + kbo(:,23, 6) = (/ & + & 0.38466e+03_r8,0.38723e+03_r8,0.38958e+03_r8,0.39170e+03_r8,0.39360e+03_r8 /) + kbo(:,24, 6) = (/ & + & 0.38520e+03_r8,0.38772e+03_r8,0.39002e+03_r8,0.39210e+03_r8,0.39395e+03_r8 /) + kbo(:,25, 6) = (/ & + & 0.38575e+03_r8,0.38823e+03_r8,0.39048e+03_r8,0.39251e+03_r8,0.39432e+03_r8 /) + kbo(:,26, 6) = (/ & + & 0.38635e+03_r8,0.38877e+03_r8,0.39098e+03_r8,0.39295e+03_r8,0.39470e+03_r8 /) + kbo(:,27, 6) = (/ & + & 0.38694e+03_r8,0.38932e+03_r8,0.39146e+03_r8,0.39339e+03_r8,0.39509e+03_r8 /) + kbo(:,28, 6) = (/ & + & 0.38753e+03_r8,0.38985e+03_r8,0.39194e+03_r8,0.39381e+03_r8,0.39546e+03_r8 /) + kbo(:,29, 6) = (/ & + & 0.38813e+03_r8,0.39039e+03_r8,0.39243e+03_r8,0.39424e+03_r8,0.39583e+03_r8 /) + kbo(:,30, 6) = (/ & + & 0.38871e+03_r8,0.39092e+03_r8,0.39290e+03_r8,0.39466e+03_r8,0.39620e+03_r8 /) + kbo(:,31, 6) = (/ & + & 0.38930e+03_r8,0.39145e+03_r8,0.39338e+03_r8,0.39508e+03_r8,0.39655e+03_r8 /) + kbo(:,32, 6) = (/ & + & 0.38988e+03_r8,0.39197e+03_r8,0.39384e+03_r8,0.39548e+03_r8,0.39690e+03_r8 /) + kbo(:,33, 6) = (/ & + & 0.39045e+03_r8,0.39248e+03_r8,0.39429e+03_r8,0.39587e+03_r8,0.39723e+03_r8 /) + kbo(:,34, 6) = (/ & + & 0.39093e+03_r8,0.39291e+03_r8,0.39467e+03_r8,0.39620e+03_r8,0.39751e+03_r8 /) + kbo(:,35, 6) = (/ & + & 0.39120e+03_r8,0.39316e+03_r8,0.39488e+03_r8,0.39639e+03_r8,0.39766e+03_r8 /) + kbo(:,36, 6) = (/ & + & 0.39125e+03_r8,0.39320e+03_r8,0.39492e+03_r8,0.39642e+03_r8,0.39769e+03_r8 /) + kbo(:,37, 6) = (/ & + & 0.39098e+03_r8,0.39295e+03_r8,0.39471e+03_r8,0.39623e+03_r8,0.39754e+03_r8 /) + kbo(:,38, 6) = (/ & + & 0.39068e+03_r8,0.39269e+03_r8,0.39447e+03_r8,0.39603e+03_r8,0.39737e+03_r8 /) + kbo(:,39, 6) = (/ & + & 0.39039e+03_r8,0.39243e+03_r8,0.39424e+03_r8,0.39583e+03_r8,0.39720e+03_r8 /) + kbo(:,40, 6) = (/ & + & 0.38986e+03_r8,0.39196e+03_r8,0.39382e+03_r8,0.39547e+03_r8,0.39689e+03_r8 /) + kbo(:,41, 6) = (/ & + & 0.38929e+03_r8,0.39144e+03_r8,0.39337e+03_r8,0.39507e+03_r8,0.39655e+03_r8 /) + kbo(:,42, 6) = (/ & + & 0.38871e+03_r8,0.39092e+03_r8,0.39290e+03_r8,0.39466e+03_r8,0.39619e+03_r8 /) + kbo(:,43, 6) = (/ & + & 0.38797e+03_r8,0.39025e+03_r8,0.39230e+03_r8,0.39413e+03_r8,0.39574e+03_r8 /) + kbo(:,44, 6) = (/ & + & 0.38715e+03_r8,0.38951e+03_r8,0.39164e+03_r8,0.39354e+03_r8,0.39522e+03_r8 /) + kbo(:,45, 6) = (/ & + & 0.38631e+03_r8,0.38874e+03_r8,0.39094e+03_r8,0.39292e+03_r8,0.39468e+03_r8 /) + kbo(:,46, 6) = (/ & + & 0.38538e+03_r8,0.38789e+03_r8,0.39018e+03_r8,0.39224e+03_r8,0.39407e+03_r8 /) + kbo(:,47, 6) = (/ & + & 0.38431e+03_r8,0.38691e+03_r8,0.38929e+03_r8,0.39144e+03_r8,0.39336e+03_r8 /) + kbo(:,48, 6) = (/ & + & 0.38320e+03_r8,0.38589e+03_r8,0.38836e+03_r8,0.39060e+03_r8,0.39262e+03_r8 /) + kbo(:,49, 6) = (/ & + & 0.38206e+03_r8,0.38484e+03_r8,0.38739e+03_r8,0.38972e+03_r8,0.39183e+03_r8 /) + kbo(:,50, 6) = (/ & + & 0.38095e+03_r8,0.38382e+03_r8,0.38646e+03_r8,0.38887e+03_r8,0.39106e+03_r8 /) + kbo(:,51, 6) = (/ & + & 0.37985e+03_r8,0.38279e+03_r8,0.38552e+03_r8,0.38802e+03_r8,0.39029e+03_r8 /) + kbo(:,52, 6) = (/ & + & 0.37873e+03_r8,0.38175e+03_r8,0.38455e+03_r8,0.38713e+03_r8,0.38949e+03_r8 /) + kbo(:,53, 6) = (/ & + & 0.37762e+03_r8,0.38067e+03_r8,0.38355e+03_r8,0.38621e+03_r8,0.38865e+03_r8 /) + kbo(:,54, 6) = (/ & + & 0.37661e+03_r8,0.37965e+03_r8,0.38261e+03_r8,0.38535e+03_r8,0.38786e+03_r8 /) + kbo(:,55, 6) = (/ & + & 0.37559e+03_r8,0.37867e+03_r8,0.38169e+03_r8,0.38450e+03_r8,0.38708e+03_r8 /) + kbo(:,56, 6) = (/ & + & 0.37459e+03_r8,0.37768e+03_r8,0.38074e+03_r8,0.38362e+03_r8,0.38628e+03_r8 /) + kbo(:,57, 6) = (/ & + & 0.37353e+03_r8,0.37673e+03_r8,0.37977e+03_r8,0.38272e+03_r8,0.38545e+03_r8 /) + kbo(:,58, 6) = (/ & + & 0.37251e+03_r8,0.37577e+03_r8,0.37885e+03_r8,0.38185e+03_r8,0.38465e+03_r8 /) + kbo(:,59, 6) = (/ & + & 0.37212e+03_r8,0.37539e+03_r8,0.37847e+03_r8,0.38150e+03_r8,0.38432e+03_r8 /) + kbo(:,13, 7) = (/ & + & 0.62583e+03_r8,0.62623e+03_r8,0.62691e+03_r8,0.62787e+03_r8,0.62909e+03_r8 /) + kbo(:,14, 7) = (/ & + & 0.62586e+03_r8,0.62628e+03_r8,0.62699e+03_r8,0.62797e+03_r8,0.62921e+03_r8 /) + kbo(:,15, 7) = (/ & + & 0.62589e+03_r8,0.62634e+03_r8,0.62708e+03_r8,0.62809e+03_r8,0.62935e+03_r8 /) + kbo(:,16, 7) = (/ & + & 0.62593e+03_r8,0.62640e+03_r8,0.62717e+03_r8,0.62821e+03_r8,0.62950e+03_r8 /) + kbo(:,17, 7) = (/ & + & 0.62597e+03_r8,0.62647e+03_r8,0.62727e+03_r8,0.62833e+03_r8,0.62965e+03_r8 /) + kbo(:,18, 7) = (/ & + & 0.62601e+03_r8,0.62654e+03_r8,0.62737e+03_r8,0.62846e+03_r8,0.62980e+03_r8 /) + kbo(:,19, 7) = (/ & + & 0.62605e+03_r8,0.62661e+03_r8,0.62746e+03_r8,0.62858e+03_r8,0.62995e+03_r8 /) + kbo(:,20, 7) = (/ & + & 0.62610e+03_r8,0.62670e+03_r8,0.62758e+03_r8,0.62873e+03_r8,0.63012e+03_r8 /) + kbo(:,21, 7) = (/ & + & 0.62615e+03_r8,0.62679e+03_r8,0.62770e+03_r8,0.62888e+03_r8,0.63031e+03_r8 /) + kbo(:,22, 7) = (/ & + & 0.62625e+03_r8,0.62694e+03_r8,0.62790e+03_r8,0.62913e+03_r8,0.63060e+03_r8 /) + kbo(:,23, 7) = (/ & + & 0.62636e+03_r8,0.62710e+03_r8,0.62812e+03_r8,0.62939e+03_r8,0.63091e+03_r8 /) + kbo(:,24, 7) = (/ & + & 0.62648e+03_r8,0.62729e+03_r8,0.62835e+03_r8,0.62968e+03_r8,0.63125e+03_r8 /) + kbo(:,25, 7) = (/ & + & 0.62663e+03_r8,0.62749e+03_r8,0.62861e+03_r8,0.62999e+03_r8,0.63162e+03_r8 /) + kbo(:,26, 7) = (/ & + & 0.62681e+03_r8,0.62773e+03_r8,0.62891e+03_r8,0.63035e+03_r8,0.63203e+03_r8 /) + kbo(:,27, 7) = (/ & + & 0.62700e+03_r8,0.62799e+03_r8,0.62923e+03_r8,0.63072e+03_r8,0.63247e+03_r8 /) + kbo(:,28, 7) = (/ & + & 0.62721e+03_r8,0.62826e+03_r8,0.62956e+03_r8,0.63112e+03_r8,0.63292e+03_r8 /) + kbo(:,29, 7) = (/ & + & 0.62745e+03_r8,0.62856e+03_r8,0.62993e+03_r8,0.63154e+03_r8,0.63341e+03_r8 /) + kbo(:,30, 7) = (/ & + & 0.62770e+03_r8,0.62888e+03_r8,0.63031e+03_r8,0.63198e+03_r8,0.63392e+03_r8 /) + kbo(:,31, 7) = (/ & + & 0.62798e+03_r8,0.62922e+03_r8,0.63071e+03_r8,0.63245e+03_r8,0.63446e+03_r8 /) + kbo(:,32, 7) = (/ & + & 0.62828e+03_r8,0.62958e+03_r8,0.63114e+03_r8,0.63295e+03_r8,0.63503e+03_r8 /) + kbo(:,33, 7) = (/ & + & 0.62860e+03_r8,0.62997e+03_r8,0.63159e+03_r8,0.63347e+03_r8,0.63562e+03_r8 /) + kbo(:,34, 7) = (/ & + & 0.62889e+03_r8,0.63031e+03_r8,0.63199e+03_r8,0.63393e+03_r8,0.63614e+03_r8 /) + kbo(:,35, 7) = (/ & + & 0.62906e+03_r8,0.63052e+03_r8,0.63223e+03_r8,0.63421e+03_r8,0.63644e+03_r8 /) + kbo(:,36, 7) = (/ & + & 0.62909e+03_r8,0.63055e+03_r8,0.63227e+03_r8,0.63425e+03_r8,0.63649e+03_r8 /) + kbo(:,37, 7) = (/ & + & 0.62891e+03_r8,0.63035e+03_r8,0.63203e+03_r8,0.63397e+03_r8,0.63619e+03_r8 /) + kbo(:,38, 7) = (/ & + & 0.62873e+03_r8,0.63013e+03_r8,0.63178e+03_r8,0.63369e+03_r8,0.63586e+03_r8 /) + kbo(:,39, 7) = (/ & + & 0.62856e+03_r8,0.62992e+03_r8,0.63154e+03_r8,0.63341e+03_r8,0.63555e+03_r8 /) + kbo(:,40, 7) = (/ & + & 0.62827e+03_r8,0.62957e+03_r8,0.63113e+03_r8,0.63293e+03_r8,0.63501e+03_r8 /) + kbo(:,41, 7) = (/ & + & 0.62798e+03_r8,0.62922e+03_r8,0.63071e+03_r8,0.63245e+03_r8,0.63445e+03_r8 /) + kbo(:,42, 7) = (/ & + & 0.62770e+03_r8,0.62887e+03_r8,0.63030e+03_r8,0.63198e+03_r8,0.63391e+03_r8 /) + kbo(:,43, 7) = (/ & + & 0.62739e+03_r8,0.62848e+03_r8,0.62983e+03_r8,0.63143e+03_r8,0.63328e+03_r8 /) + kbo(:,44, 7) = (/ & + & 0.62708e+03_r8,0.62808e+03_r8,0.62935e+03_r8,0.63086e+03_r8,0.63263e+03_r8 /) + kbo(:,45, 7) = (/ & + & 0.62679e+03_r8,0.62771e+03_r8,0.62889e+03_r8,0.63032e+03_r8,0.63200e+03_r8 /) + kbo(:,46, 7) = (/ & + & 0.62653e+03_r8,0.62735e+03_r8,0.62844e+03_r8,0.62978e+03_r8,0.63137e+03_r8 /) + kbo(:,47, 7) = (/ & + & 0.62629e+03_r8,0.62699e+03_r8,0.62797e+03_r8,0.62921e+03_r8,0.63070e+03_r8 /) + kbo(:,48, 7) = (/ & + & 0.62608e+03_r8,0.62667e+03_r8,0.62755e+03_r8,0.62868e+03_r8,0.63007e+03_r8 /) + kbo(:,49, 7) = (/ & + & 0.62592e+03_r8,0.62640e+03_r8,0.62716e+03_r8,0.62820e+03_r8,0.62948e+03_r8 /) + kbo(:,50, 7) = (/ & + & 0.62580e+03_r8,0.62619e+03_r8,0.62684e+03_r8,0.62778e+03_r8,0.62897e+03_r8 /) + kbo(:,51, 7) = (/ & + & 0.62580e+03_r8,0.62602e+03_r8,0.62657e+03_r8,0.62741e+03_r8,0.62850e+03_r8 /) + kbo(:,52, 7) = (/ & + & 0.62578e+03_r8,0.62589e+03_r8,0.62633e+03_r8,0.62707e+03_r8,0.62807e+03_r8 /) + kbo(:,53, 7) = (/ & + & 0.62574e+03_r8,0.62578e+03_r8,0.62614e+03_r8,0.62677e+03_r8,0.62768e+03_r8 /) + kbo(:,54, 7) = (/ & + & 0.62576e+03_r8,0.62580e+03_r8,0.62600e+03_r8,0.62652e+03_r8,0.62734e+03_r8 /) + kbo(:,55, 7) = (/ & + & 0.62585e+03_r8,0.62578e+03_r8,0.62588e+03_r8,0.62632e+03_r8,0.62705e+03_r8 /) + kbo(:,56, 7) = (/ & + & 0.62587e+03_r8,0.62576e+03_r8,0.62579e+03_r8,0.62615e+03_r8,0.62678e+03_r8 /) + kbo(:,57, 7) = (/ & + & 0.62591e+03_r8,0.62574e+03_r8,0.62580e+03_r8,0.62601e+03_r8,0.62655e+03_r8 /) + kbo(:,58, 7) = (/ & + & 0.62591e+03_r8,0.62583e+03_r8,0.62578e+03_r8,0.62590e+03_r8,0.62636e+03_r8 /) + kbo(:,59, 7) = (/ & + & 0.62590e+03_r8,0.62586e+03_r8,0.62578e+03_r8,0.62586e+03_r8,0.62628e+03_r8 /) + kbo(:,13, 8) = (/ & + & 0.81821e+03_r8,0.81877e+03_r8,0.81935e+03_r8,0.81999e+03_r8,0.82074e+03_r8 /) + kbo(:,14, 8) = (/ & + & 0.81826e+03_r8,0.81882e+03_r8,0.81939e+03_r8,0.82006e+03_r8,0.82081e+03_r8 /) + kbo(:,15, 8) = (/ & + & 0.81831e+03_r8,0.81888e+03_r8,0.81946e+03_r8,0.82012e+03_r8,0.82089e+03_r8 /) + kbo(:,16, 8) = (/ & + & 0.81836e+03_r8,0.81895e+03_r8,0.81952e+03_r8,0.82021e+03_r8,0.82098e+03_r8 /) + kbo(:,17, 8) = (/ & + & 0.81842e+03_r8,0.81901e+03_r8,0.81959e+03_r8,0.82028e+03_r8,0.82106e+03_r8 /) + kbo(:,18, 8) = (/ & + & 0.81847e+03_r8,0.81907e+03_r8,0.81965e+03_r8,0.82036e+03_r8,0.82116e+03_r8 /) + kbo(:,19, 8) = (/ & + & 0.81853e+03_r8,0.81913e+03_r8,0.81972e+03_r8,0.82043e+03_r8,0.82123e+03_r8 /) + kbo(:,20, 8) = (/ & + & 0.81860e+03_r8,0.81919e+03_r8,0.81980e+03_r8,0.82052e+03_r8,0.82133e+03_r8 /) + kbo(:,21, 8) = (/ & + & 0.81868e+03_r8,0.81925e+03_r8,0.81988e+03_r8,0.82061e+03_r8,0.82143e+03_r8 /) + kbo(:,22, 8) = (/ & + & 0.81879e+03_r8,0.81936e+03_r8,0.82001e+03_r8,0.82076e+03_r8,0.82160e+03_r8 /) + kbo(:,23, 8) = (/ & + & 0.81889e+03_r8,0.81947e+03_r8,0.82015e+03_r8,0.82091e+03_r8,0.82177e+03_r8 /) + kbo(:,24, 8) = (/ & + & 0.81902e+03_r8,0.81960e+03_r8,0.82030e+03_r8,0.82108e+03_r8,0.82195e+03_r8 /) + kbo(:,25, 8) = (/ & + & 0.81914e+03_r8,0.81974e+03_r8,0.82046e+03_r8,0.82126e+03_r8,0.82214e+03_r8 /) + kbo(:,26, 8) = (/ & + & 0.81927e+03_r8,0.81990e+03_r8,0.82063e+03_r8,0.82145e+03_r8,0.82236e+03_r8 /) + kbo(:,27, 8) = (/ & + & 0.81941e+03_r8,0.82006e+03_r8,0.82082e+03_r8,0.82166e+03_r8,0.82258e+03_r8 /) + kbo(:,28, 8) = (/ & + & 0.81957e+03_r8,0.82024e+03_r8,0.82101e+03_r8,0.82188e+03_r8,0.82281e+03_r8 /) + kbo(:,29, 8) = (/ & + & 0.81971e+03_r8,0.82042e+03_r8,0.82122e+03_r8,0.82210e+03_r8,0.82305e+03_r8 /) + kbo(:,30, 8) = (/ & + & 0.81988e+03_r8,0.82061e+03_r8,0.82143e+03_r8,0.82233e+03_r8,0.82330e+03_r8 /) + kbo(:,31, 8) = (/ & + & 0.82006e+03_r8,0.82081e+03_r8,0.82166e+03_r8,0.82258e+03_r8,0.82355e+03_r8 /) + kbo(:,32, 8) = (/ & + & 0.82025e+03_r8,0.82103e+03_r8,0.82189e+03_r8,0.82283e+03_r8,0.82380e+03_r8 /) + kbo(:,33, 8) = (/ & + & 0.82044e+03_r8,0.82124e+03_r8,0.82213e+03_r8,0.82308e+03_r8,0.82408e+03_r8 /) + kbo(:,34, 8) = (/ & + & 0.82062e+03_r8,0.82144e+03_r8,0.82234e+03_r8,0.82330e+03_r8,0.82432e+03_r8 /) + kbo(:,35, 8) = (/ & + & 0.82072e+03_r8,0.82155e+03_r8,0.82246e+03_r8,0.82342e+03_r8,0.82446e+03_r8 /) + kbo(:,36, 8) = (/ & + & 0.82074e+03_r8,0.82157e+03_r8,0.82248e+03_r8,0.82345e+03_r8,0.82448e+03_r8 /) + kbo(:,37, 8) = (/ & + & 0.82063e+03_r8,0.82146e+03_r8,0.82236e+03_r8,0.82332e+03_r8,0.82434e+03_r8 /) + kbo(:,38, 8) = (/ & + & 0.82053e+03_r8,0.82134e+03_r8,0.82223e+03_r8,0.82319e+03_r8,0.82419e+03_r8 /) + kbo(:,39, 8) = (/ & + & 0.82042e+03_r8,0.82122e+03_r8,0.82210e+03_r8,0.82305e+03_r8,0.82405e+03_r8 /) + kbo(:,40, 8) = (/ & + & 0.82024e+03_r8,0.82102e+03_r8,0.82188e+03_r8,0.82282e+03_r8,0.82380e+03_r8 /) + kbo(:,41, 8) = (/ & + & 0.82006e+03_r8,0.82081e+03_r8,0.82165e+03_r8,0.82257e+03_r8,0.82354e+03_r8 /) + kbo(:,42, 8) = (/ & + & 0.81988e+03_r8,0.82061e+03_r8,0.82143e+03_r8,0.82233e+03_r8,0.82329e+03_r8 /) + kbo(:,43, 8) = (/ & + & 0.81967e+03_r8,0.82037e+03_r8,0.82117e+03_r8,0.82204e+03_r8,0.82299e+03_r8 /) + kbo(:,44, 8) = (/ & + & 0.81946e+03_r8,0.82013e+03_r8,0.82089e+03_r8,0.82174e+03_r8,0.82267e+03_r8 /) + kbo(:,45, 8) = (/ & + & 0.81926e+03_r8,0.81989e+03_r8,0.82062e+03_r8,0.82144e+03_r8,0.82234e+03_r8 /) + kbo(:,46, 8) = (/ & + & 0.81907e+03_r8,0.81965e+03_r8,0.82034e+03_r8,0.82114e+03_r8,0.82201e+03_r8 /) + kbo(:,47, 8) = (/ & + & 0.81882e+03_r8,0.81939e+03_r8,0.82006e+03_r8,0.82081e+03_r8,0.82165e+03_r8 /) + kbo(:,48, 8) = (/ & + & 0.81858e+03_r8,0.81917e+03_r8,0.81978e+03_r8,0.82050e+03_r8,0.82130e+03_r8 /) + kbo(:,49, 8) = (/ & + & 0.81836e+03_r8,0.81894e+03_r8,0.81953e+03_r8,0.82019e+03_r8,0.82097e+03_r8 /) + kbo(:,50, 8) = (/ & + & 0.81817e+03_r8,0.81871e+03_r8,0.81929e+03_r8,0.81993e+03_r8,0.82067e+03_r8 /) + kbo(:,51, 8) = (/ & + & 0.81790e+03_r8,0.81850e+03_r8,0.81910e+03_r8,0.81967e+03_r8,0.82039e+03_r8 /) + kbo(:,52, 8) = (/ & + & 0.81779e+03_r8,0.81830e+03_r8,0.81888e+03_r8,0.81945e+03_r8,0.82012e+03_r8 /) + kbo(:,53, 8) = (/ & + & 0.81766e+03_r8,0.81812e+03_r8,0.81866e+03_r8,0.81924e+03_r8,0.81986e+03_r8 /) + kbo(:,54, 8) = (/ & + & 0.81744e+03_r8,0.81785e+03_r8,0.81846e+03_r8,0.81906e+03_r8,0.81964e+03_r8 /) + kbo(:,55, 8) = (/ & + & 0.81733e+03_r8,0.81777e+03_r8,0.81829e+03_r8,0.81886e+03_r8,0.81944e+03_r8 /) + kbo(:,56, 8) = (/ & + & 0.81741e+03_r8,0.81767e+03_r8,0.81813e+03_r8,0.81867e+03_r8,0.81925e+03_r8 /) + kbo(:,57, 8) = (/ & + & 0.81785e+03_r8,0.81749e+03_r8,0.81788e+03_r8,0.81848e+03_r8,0.81908e+03_r8 /) + kbo(:,58, 8) = (/ & + & 0.81817e+03_r8,0.81731e+03_r8,0.81779e+03_r8,0.81832e+03_r8,0.81889e+03_r8 /) + kbo(:,59, 8) = (/ & + & 0.81824e+03_r8,0.81736e+03_r8,0.81776e+03_r8,0.81826e+03_r8,0.81883e+03_r8 /) + kbo(:,13, 9) = (/ & + & 0.94133e+03_r8,0.94438e+03_r8,0.94687e+03_r8,0.94883e+03_r8,0.95021e+03_r8 /) + kbo(:,14, 9) = (/ & + & 0.94163e+03_r8,0.94463e+03_r8,0.94708e+03_r8,0.94898e+03_r8,0.95031e+03_r8 /) + kbo(:,15, 9) = (/ & + & 0.94195e+03_r8,0.94490e+03_r8,0.94731e+03_r8,0.94914e+03_r8,0.95042e+03_r8 /) + kbo(:,16, 9) = (/ & + & 0.94229e+03_r8,0.94518e+03_r8,0.94753e+03_r8,0.94930e+03_r8,0.95052e+03_r8 /) + kbo(:,17, 9) = (/ & + & 0.94262e+03_r8,0.94544e+03_r8,0.94774e+03_r8,0.94946e+03_r8,0.95061e+03_r8 /) + kbo(:,18, 9) = (/ & + & 0.94293e+03_r8,0.94570e+03_r8,0.94795e+03_r8,0.94960e+03_r8,0.95069e+03_r8 /) + kbo(:,19, 9) = (/ & + & 0.94323e+03_r8,0.94595e+03_r8,0.94814e+03_r8,0.94974e+03_r8,0.95078e+03_r8 /) + kbo(:,20, 9) = (/ & + & 0.94357e+03_r8,0.94624e+03_r8,0.94835e+03_r8,0.94989e+03_r8,0.95087e+03_r8 /) + kbo(:,21, 9) = (/ & + & 0.94393e+03_r8,0.94654e+03_r8,0.94857e+03_r8,0.95003e+03_r8,0.95096e+03_r8 /) + kbo(:,22, 9) = (/ & + & 0.94445e+03_r8,0.94695e+03_r8,0.94888e+03_r8,0.95025e+03_r8,0.95105e+03_r8 /) + kbo(:,23, 9) = (/ & + & 0.94499e+03_r8,0.94737e+03_r8,0.94919e+03_r8,0.95045e+03_r8,0.95113e+03_r8 /) + kbo(:,24, 9) = (/ & + & 0.94549e+03_r8,0.94778e+03_r8,0.94948e+03_r8,0.95063e+03_r8,0.95120e+03_r8 /) + kbo(:,25, 9) = (/ & + & 0.94602e+03_r8,0.94819e+03_r8,0.94978e+03_r8,0.95082e+03_r8,0.95125e+03_r8 /) + kbo(:,26, 9) = (/ & + & 0.94658e+03_r8,0.94861e+03_r8,0.95006e+03_r8,0.95096e+03_r8,0.95127e+03_r8 /) + kbo(:,27, 9) = (/ & + & 0.94710e+03_r8,0.94900e+03_r8,0.95033e+03_r8,0.95109e+03_r8,0.95126e+03_r8 /) + kbo(:,28, 9) = (/ & + & 0.94759e+03_r8,0.94937e+03_r8,0.95056e+03_r8,0.95118e+03_r8,0.95123e+03_r8 /) + kbo(:,29, 9) = (/ & + & 0.94811e+03_r8,0.94973e+03_r8,0.95077e+03_r8,0.95124e+03_r8,0.95116e+03_r8 /) + kbo(:,30, 9) = (/ & + & 0.94856e+03_r8,0.95003e+03_r8,0.95095e+03_r8,0.95127e+03_r8,0.95105e+03_r8 /) + kbo(:,31, 9) = (/ & + & 0.94901e+03_r8,0.95032e+03_r8,0.95108e+03_r8,0.95127e+03_r8,0.95090e+03_r8 /) + kbo(:,32, 9) = (/ & + & 0.94939e+03_r8,0.95057e+03_r8,0.95118e+03_r8,0.95121e+03_r8,0.95071e+03_r8 /) + kbo(:,33, 9) = (/ & + & 0.94975e+03_r8,0.95079e+03_r8,0.95125e+03_r8,0.95115e+03_r8,0.95050e+03_r8 /) + kbo(:,34, 9) = (/ & + & 0.95004e+03_r8,0.95095e+03_r8,0.95128e+03_r8,0.95105e+03_r8,0.95030e+03_r8 /) + kbo(:,35, 9) = (/ & + & 0.95020e+03_r8,0.95102e+03_r8,0.95127e+03_r8,0.95098e+03_r8,0.95016e+03_r8 /) + kbo(:,36, 9) = (/ & + & 0.95021e+03_r8,0.95103e+03_r8,0.95127e+03_r8,0.95096e+03_r8,0.95023e+03_r8 /) + kbo(:,37, 9) = (/ & + & 0.95006e+03_r8,0.95096e+03_r8,0.95127e+03_r8,0.95104e+03_r8,0.95027e+03_r8 /) + kbo(:,38, 9) = (/ & + & 0.94990e+03_r8,0.95087e+03_r8,0.95126e+03_r8,0.95110e+03_r8,0.95040e+03_r8 /) + kbo(:,39, 9) = (/ & + & 0.94972e+03_r8,0.95077e+03_r8,0.95124e+03_r8,0.95117e+03_r8,0.95053e+03_r8 /) + kbo(:,40, 9) = (/ & + & 0.94939e+03_r8,0.95057e+03_r8,0.95118e+03_r8,0.95123e+03_r8,0.95072e+03_r8 /) + kbo(:,41, 9) = (/ & + & 0.94899e+03_r8,0.95032e+03_r8,0.95108e+03_r8,0.95127e+03_r8,0.95090e+03_r8 /) + kbo(:,42, 9) = (/ & + & 0.94856e+03_r8,0.95004e+03_r8,0.95094e+03_r8,0.95127e+03_r8,0.95105e+03_r8 /) + kbo(:,43, 9) = (/ & + & 0.94799e+03_r8,0.94963e+03_r8,0.95073e+03_r8,0.95123e+03_r8,0.95118e+03_r8 /) + kbo(:,44, 9) = (/ & + & 0.94729e+03_r8,0.94914e+03_r8,0.95041e+03_r8,0.95112e+03_r8,0.95126e+03_r8 /) + kbo(:,45, 9) = (/ & + & 0.94655e+03_r8,0.94858e+03_r8,0.95004e+03_r8,0.95095e+03_r8,0.95127e+03_r8 /) + kbo(:,46, 9) = (/ & + & 0.94568e+03_r8,0.94792e+03_r8,0.94958e+03_r8,0.95070e+03_r8,0.95122e+03_r8 /) + kbo(:,47, 9) = (/ & + & 0.94463e+03_r8,0.94708e+03_r8,0.94898e+03_r8,0.95031e+03_r8,0.95108e+03_r8 /) + kbo(:,48, 9) = (/ & + & 0.94348e+03_r8,0.94616e+03_r8,0.94829e+03_r8,0.94984e+03_r8,0.95084e+03_r8 /) + kbo(:,49, 9) = (/ & + & 0.94226e+03_r8,0.94515e+03_r8,0.94748e+03_r8,0.94928e+03_r8,0.95051e+03_r8 /) + kbo(:,50, 9) = (/ & + & 0.94103e+03_r8,0.94413e+03_r8,0.94669e+03_r8,0.94868e+03_r8,0.95011e+03_r8 /) + kbo(:,51, 9) = (/ & + & 0.93978e+03_r8,0.94307e+03_r8,0.94580e+03_r8,0.94802e+03_r8,0.94965e+03_r8 /) + kbo(:,52, 9) = (/ & + & 0.93828e+03_r8,0.94192e+03_r8,0.94488e+03_r8,0.94728e+03_r8,0.94912e+03_r8 /) + kbo(:,53, 9) = (/ & + & 0.93678e+03_r8,0.94072e+03_r8,0.94388e+03_r8,0.94646e+03_r8,0.94851e+03_r8 /) + kbo(:,54, 9) = (/ & + & 0.93537e+03_r8,0.93955e+03_r8,0.94287e+03_r8,0.94565e+03_r8,0.94789e+03_r8 /) + kbo(:,55, 9) = (/ & + & 0.93380e+03_r8,0.93820e+03_r8,0.94186e+03_r8,0.94483e+03_r8,0.94722e+03_r8 /) + kbo(:,56, 9) = (/ & + & 0.93205e+03_r8,0.93688e+03_r8,0.94080e+03_r8,0.94394e+03_r8,0.94652e+03_r8 /) + kbo(:,57, 9) = (/ & + & 0.92997e+03_r8,0.93554e+03_r8,0.93969e+03_r8,0.94299e+03_r8,0.94574e+03_r8 /) + kbo(:,58, 9) = (/ & + & 0.92808e+03_r8,0.93414e+03_r8,0.93844e+03_r8,0.94204e+03_r8,0.94498e+03_r8 /) + kbo(:,59, 9) = (/ & + & 0.92793e+03_r8,0.93341e+03_r8,0.93792e+03_r8,0.94165e+03_r8,0.94465e+03_r8 /) + kbo(:,13,10) = (/ & + & 0.98036e+03_r8,0.98526e+03_r8,0.98973e+03_r8,0.99279e+03_r8,0.99468e+03_r8 /) + kbo(:,14,10) = (/ & + & 0.98067e+03_r8,0.98568e+03_r8,0.99005e+03_r8,0.99301e+03_r8,0.99477e+03_r8 /) + kbo(:,15,10) = (/ & + & 0.98125e+03_r8,0.98614e+03_r8,0.99040e+03_r8,0.99324e+03_r8,0.99485e+03_r8 /) + kbo(:,16,10) = (/ & + & 0.98185e+03_r8,0.98662e+03_r8,0.99076e+03_r8,0.99348e+03_r8,0.99493e+03_r8 /) + kbo(:,17,10) = (/ & + & 0.98242e+03_r8,0.98721e+03_r8,0.99109e+03_r8,0.99369e+03_r8,0.99498e+03_r8 /) + kbo(:,18,10) = (/ & + & 0.98296e+03_r8,0.98755e+03_r8,0.99141e+03_r8,0.99390e+03_r8,0.99502e+03_r8 /) + kbo(:,19,10) = (/ & + & 0.98350e+03_r8,0.98800e+03_r8,0.99172e+03_r8,0.99408e+03_r8,0.99505e+03_r8 /) + kbo(:,20,10) = (/ & + & 0.98411e+03_r8,0.98852e+03_r8,0.99205e+03_r8,0.99428e+03_r8,0.99507e+03_r8 /) + kbo(:,21,10) = (/ & + & 0.98464e+03_r8,0.98894e+03_r8,0.99238e+03_r8,0.99447e+03_r8,0.99496e+03_r8 /) + kbo(:,22,10) = (/ & + & 0.98547e+03_r8,0.98983e+03_r8,0.99286e+03_r8,0.99470e+03_r8,0.99509e+03_r8 /) + kbo(:,23,10) = (/ & + & 0.98617e+03_r8,0.99062e+03_r8,0.99331e+03_r8,0.99487e+03_r8,0.99508e+03_r8 /) + kbo(:,24,10) = (/ & + & 0.98718e+03_r8,0.99115e+03_r8,0.99373e+03_r8,0.99499e+03_r8,0.99503e+03_r8 /) + kbo(:,25,10) = (/ & + & 0.98813e+03_r8,0.99180e+03_r8,0.99413e+03_r8,0.99494e+03_r8,0.99492e+03_r8 /) + kbo(:,26,10) = (/ & + & 0.98918e+03_r8,0.99244e+03_r8,0.99450e+03_r8,0.99508e+03_r8,0.99475e+03_r8 /) + kbo(:,27,10) = (/ & + & 0.99010e+03_r8,0.99304e+03_r8,0.99478e+03_r8,0.99509e+03_r8,0.99499e+03_r8 /) + kbo(:,28,10) = (/ & + & 0.99090e+03_r8,0.99357e+03_r8,0.99495e+03_r8,0.99505e+03_r8,0.99433e+03_r8 /) + kbo(:,29,10) = (/ & + & 0.99167e+03_r8,0.99393e+03_r8,0.99505e+03_r8,0.99495e+03_r8,0.99385e+03_r8 /) + kbo(:,30,10) = (/ & + & 0.99249e+03_r8,0.99447e+03_r8,0.99508e+03_r8,0.99477e+03_r8,0.99348e+03_r8 /) + kbo(:,31,10) = (/ & + & 0.99290e+03_r8,0.99477e+03_r8,0.99509e+03_r8,0.99452e+03_r8,0.99326e+03_r8 /) + kbo(:,32,10) = (/ & + & 0.99360e+03_r8,0.99496e+03_r8,0.99505e+03_r8,0.99419e+03_r8,0.99287e+03_r8 /) + kbo(:,33,10) = (/ & + & 0.99410e+03_r8,0.99506e+03_r8,0.99493e+03_r8,0.99381e+03_r8,0.99210e+03_r8 /) + kbo(:,34,10) = (/ & + & 0.99447e+03_r8,0.99508e+03_r8,0.99465e+03_r8,0.99347e+03_r8,0.99121e+03_r8 /) + kbo(:,35,10) = (/ & + & 0.99453e+03_r8,0.99509e+03_r8,0.99465e+03_r8,0.99330e+03_r8,0.99083e+03_r8 /) + kbo(:,36,10) = (/ & + & 0.99467e+03_r8,0.99509e+03_r8,0.99463e+03_r8,0.99327e+03_r8,0.98992e+03_r8 /) + kbo(:,37,10) = (/ & + & 0.99451e+03_r8,0.99508e+03_r8,0.99475e+03_r8,0.99344e+03_r8,0.99124e+03_r8 /) + kbo(:,38,10) = (/ & + & 0.99429e+03_r8,0.99507e+03_r8,0.99486e+03_r8,0.99365e+03_r8,0.99174e+03_r8 /) + kbo(:,39,10) = (/ & + & 0.99405e+03_r8,0.99505e+03_r8,0.99495e+03_r8,0.99373e+03_r8,0.99219e+03_r8 /) + kbo(:,40,10) = (/ & + & 0.99347e+03_r8,0.99496e+03_r8,0.99505e+03_r8,0.99420e+03_r8,0.99289e+03_r8 /) + kbo(:,41,10) = (/ & + & 0.99302e+03_r8,0.99477e+03_r8,0.99509e+03_r8,0.99452e+03_r8,0.99315e+03_r8 /) + kbo(:,42,10) = (/ & + & 0.99237e+03_r8,0.99435e+03_r8,0.99508e+03_r8,0.99477e+03_r8,0.99348e+03_r8 /) + kbo(:,43,10) = (/ & + & 0.99148e+03_r8,0.99394e+03_r8,0.99491e+03_r8,0.99498e+03_r8,0.99395e+03_r8 /) + kbo(:,44,10) = (/ & + & 0.99040e+03_r8,0.99324e+03_r8,0.99485e+03_r8,0.99508e+03_r8,0.99453e+03_r8 /) + kbo(:,45,10) = (/ & + & 0.98910e+03_r8,0.99241e+03_r8,0.99449e+03_r8,0.99508e+03_r8,0.99476e+03_r8 /) + kbo(:,46,10) = (/ & + & 0.98735e+03_r8,0.99138e+03_r8,0.99388e+03_r8,0.99490e+03_r8,0.99500e+03_r8 /) + kbo(:,47,10) = (/ & + & 0.98565e+03_r8,0.99006e+03_r8,0.99301e+03_r8,0.99477e+03_r8,0.99509e+03_r8 /) + kbo(:,48,10) = (/ & + & 0.98383e+03_r8,0.98834e+03_r8,0.99196e+03_r8,0.99423e+03_r8,0.99507e+03_r8 /) + kbo(:,49,10) = (/ & + & 0.98174e+03_r8,0.98651e+03_r8,0.99073e+03_r8,0.99346e+03_r8,0.99492e+03_r8 /) + kbo(:,50,10) = (/ & + & 0.97955e+03_r8,0.98480e+03_r8,0.98924e+03_r8,0.99257e+03_r8,0.99470e+03_r8 /) + kbo(:,51,10) = (/ & + & 0.97755e+03_r8,0.98298e+03_r8,0.98767e+03_r8,0.99154e+03_r8,0.99399e+03_r8 /) + kbo(:,52,10) = (/ & + & 0.97554e+03_r8,0.98111e+03_r8,0.98597e+03_r8,0.99036e+03_r8,0.99323e+03_r8 /) + kbo(:,53,10) = (/ & + & 0.97320e+03_r8,0.97892e+03_r8,0.98413e+03_r8,0.98888e+03_r8,0.99232e+03_r8 /) + kbo(:,54,10) = (/ & + & 0.97086e+03_r8,0.97720e+03_r8,0.98263e+03_r8,0.98733e+03_r8,0.99135e+03_r8 /) + kbo(:,55,10) = (/ & + & 0.96881e+03_r8,0.97539e+03_r8,0.98096e+03_r8,0.98583e+03_r8,0.99029e+03_r8 /) + kbo(:,56,10) = (/ & + & 0.96735e+03_r8,0.97336e+03_r8,0.97906e+03_r8,0.98435e+03_r8,0.98900e+03_r8 /) + kbo(:,57,10) = (/ & + & 0.96407e+03_r8,0.97115e+03_r8,0.97740e+03_r8,0.98282e+03_r8,0.98752e+03_r8 /) + kbo(:,58,10) = (/ & + & 0.96154e+03_r8,0.96893e+03_r8,0.97574e+03_r8,0.98129e+03_r8,0.98611e+03_r8 /) + kbo(:,59,10) = (/ & + & 0.95571e+03_r8,0.96861e+03_r8,0.97503e+03_r8,0.98063e+03_r8,0.98557e+03_r8 /) + kbo(:,13,11) = (/ & + & 0.98771e+03_r8,0.99296e+03_r8,0.99655e+03_r8,0.99859e+03_r8,0.99936e+03_r8 /) + kbo(:,14,11) = (/ & + & 0.98850e+03_r8,0.99335e+03_r8,0.99679e+03_r8,0.99871e+03_r8,0.99939e+03_r8 /) + kbo(:,15,11) = (/ & + & 0.98905e+03_r8,0.99377e+03_r8,0.99705e+03_r8,0.99882e+03_r8,0.99942e+03_r8 /) + kbo(:,16,11) = (/ & + & 0.98962e+03_r8,0.99419e+03_r8,0.99730e+03_r8,0.99893e+03_r8,0.99945e+03_r8 /) + kbo(:,17,11) = (/ & + & 0.99016e+03_r8,0.99444e+03_r8,0.99754e+03_r8,0.99903e+03_r8,0.99947e+03_r8 /) + kbo(:,18,11) = (/ & + & 0.99067e+03_r8,0.99497e+03_r8,0.99775e+03_r8,0.99911e+03_r8,0.99948e+03_r8 /) + kbo(:,19,11) = (/ & + & 0.99117e+03_r8,0.99532e+03_r8,0.99795e+03_r8,0.99918e+03_r8,0.99949e+03_r8 /) + kbo(:,20,11) = (/ & + & 0.99173e+03_r8,0.99572e+03_r8,0.99816e+03_r8,0.99924e+03_r8,0.99949e+03_r8 /) + kbo(:,21,11) = (/ & + & 0.99228e+03_r8,0.99610e+03_r8,0.99835e+03_r8,0.99929e+03_r8,0.99946e+03_r8 /) + kbo(:,22,11) = (/ & + & 0.99309e+03_r8,0.99663e+03_r8,0.99862e+03_r8,0.99936e+03_r8,0.99953e+03_r8 /) + kbo(:,23,11) = (/ & + & 0.99388e+03_r8,0.99698e+03_r8,0.99900e+03_r8,0.99942e+03_r8,0.99925e+03_r8 /) + kbo(:,24,11) = (/ & + & 0.99466e+03_r8,0.99758e+03_r8,0.99904e+03_r8,0.99947e+03_r8,0.99905e+03_r8 /) + kbo(:,25,11) = (/ & + & 0.99542e+03_r8,0.99800e+03_r8,0.99919e+03_r8,0.99963e+03_r8,0.99878e+03_r8 /) + kbo(:,26,11) = (/ & + & 0.99618e+03_r8,0.99839e+03_r8,0.99930e+03_r8,0.99945e+03_r8,0.99847e+03_r8 /) + kbo(:,27,11) = (/ & + & 0.99683e+03_r8,0.99872e+03_r8,0.99939e+03_r8,0.99934e+03_r8,0.99751e+03_r8 /) + kbo(:,28,11) = (/ & + & 0.99741e+03_r8,0.99897e+03_r8,0.99946e+03_r8,0.99913e+03_r8,0.99749e+03_r8 /) + kbo(:,29,11) = (/ & + & 0.99792e+03_r8,0.99917e+03_r8,0.99949e+03_r8,0.99884e+03_r8,0.99707e+03_r8 /) + kbo(:,30,11) = (/ & + & 0.99821e+03_r8,0.99929e+03_r8,0.99946e+03_r8,0.99850e+03_r8,0.99637e+03_r8 /) + kbo(:,31,11) = (/ & + & 0.99871e+03_r8,0.99938e+03_r8,0.99949e+03_r8,0.99810e+03_r8,0.99532e+03_r8 /) + kbo(:,32,11) = (/ & + & 0.99899e+03_r8,0.99961e+03_r8,0.99926e+03_r8,0.99761e+03_r8,0.99460e+03_r8 /) + kbo(:,33,11) = (/ & + & 0.99918e+03_r8,0.99949e+03_r8,0.99880e+03_r8,0.99700e+03_r8,0.99413e+03_r8 /) + kbo(:,34,11) = (/ & + & 0.99929e+03_r8,0.99946e+03_r8,0.99850e+03_r8,0.99635e+03_r8,0.99329e+03_r8 /) + kbo(:,35,11) = (/ & + & 0.99934e+03_r8,0.99941e+03_r8,0.99830e+03_r8,0.99590e+03_r8,0.99292e+03_r8 /) + kbo(:,36,11) = (/ & + & 0.99935e+03_r8,0.99940e+03_r8,0.99826e+03_r8,0.99583e+03_r8,0.99287e+03_r8 /) + kbo(:,37,11) = (/ & + & 0.99930e+03_r8,0.99946e+03_r8,0.99846e+03_r8,0.99628e+03_r8,0.99327e+03_r8 /) + kbo(:,38,11) = (/ & + & 0.99924e+03_r8,0.99949e+03_r8,0.99866e+03_r8,0.99670e+03_r8,0.99350e+03_r8 /) + kbo(:,39,11) = (/ & + & 0.99917e+03_r8,0.99949e+03_r8,0.99899e+03_r8,0.99707e+03_r8,0.99451e+03_r8 /) + kbo(:,40,11) = (/ & + & 0.99898e+03_r8,0.99946e+03_r8,0.99913e+03_r8,0.99777e+03_r8,0.99505e+03_r8 /) + kbo(:,41,11) = (/ & + & 0.99871e+03_r8,0.99939e+03_r8,0.99935e+03_r8,0.99810e+03_r8,0.99546e+03_r8 /) + kbo(:,42,11) = (/ & + & 0.99835e+03_r8,0.99929e+03_r8,0.99947e+03_r8,0.99851e+03_r8,0.99637e+03_r8 /) + kbo(:,43,11) = (/ & + & 0.99780e+03_r8,0.99913e+03_r8,0.99949e+03_r8,0.99893e+03_r8,0.99722e+03_r8 /) + kbo(:,44,11) = (/ & + & 0.99704e+03_r8,0.99882e+03_r8,0.99942e+03_r8,0.99928e+03_r8,0.99778e+03_r8 /) + kbo(:,45,11) = (/ & + & 0.99613e+03_r8,0.99837e+03_r8,0.99930e+03_r8,0.99947e+03_r8,0.99849e+03_r8 /) + kbo(:,46,11) = (/ & + & 0.99492e+03_r8,0.99787e+03_r8,0.99911e+03_r8,0.99949e+03_r8,0.99897e+03_r8 /) + kbo(:,47,11) = (/ & + & 0.99335e+03_r8,0.99679e+03_r8,0.99871e+03_r8,0.99939e+03_r8,0.99936e+03_r8 /) + kbo(:,48,11) = (/ & + & 0.99156e+03_r8,0.99560e+03_r8,0.99810e+03_r8,0.99923e+03_r8,0.99951e+03_r8 /) + kbo(:,49,11) = (/ & + & 0.98955e+03_r8,0.99414e+03_r8,0.99727e+03_r8,0.99894e+03_r8,0.99946e+03_r8 /) + kbo(:,50,11) = (/ & + & 0.98749e+03_r8,0.99256e+03_r8,0.99630e+03_r8,0.99847e+03_r8,0.99918e+03_r8 /) + kbo(:,51,11) = (/ & + & 0.98496e+03_r8,0.99085e+03_r8,0.99509e+03_r8,0.99784e+03_r8,0.99916e+03_r8 /) + kbo(:,52,11) = (/ & + & 0.98304e+03_r8,0.98897e+03_r8,0.99370e+03_r8,0.99701e+03_r8,0.99883e+03_r8 /) + kbo(:,53,11) = (/ & + & 0.98104e+03_r8,0.98693e+03_r8,0.99213e+03_r8,0.99600e+03_r8,0.99833e+03_r8 /) + kbo(:,54,11) = (/ & + & 0.97906e+03_r8,0.98440e+03_r8,0.99053e+03_r8,0.99485e+03_r8,0.99771e+03_r8 /) + kbo(:,55,11) = (/ & + & 0.97789e+03_r8,0.98286e+03_r8,0.98886e+03_r8,0.99361e+03_r8,0.99696e+03_r8 /) + kbo(:,56,11) = (/ & + & 0.97514e+03_r8,0.98117e+03_r8,0.98708e+03_r8,0.99224e+03_r8,0.99622e+03_r8 /) + kbo(:,57,11) = (/ & + & 0.97242e+03_r8,0.97945e+03_r8,0.98472e+03_r8,0.99072e+03_r8,0.99500e+03_r8 /) + kbo(:,58,11) = (/ & + & 0.96969e+03_r8,0.97814e+03_r8,0.98316e+03_r8,0.98916e+03_r8,0.99384e+03_r8 /) + kbo(:,59,11) = (/ & + & 0.96859e+03_r8,0.97725e+03_r8,0.98261e+03_r8,0.98851e+03_r8,0.99335e+03_r8 /) + kbo(:,13,12) = (/ & + & 0.99768e+03_r8,0.99984e+03_r8,0.10010e+04_r8,0.10024e+04_r8,0.10029e+04_r8 /) + kbo(:,14,12) = (/ & + & 0.99795e+03_r8,0.99992e+03_r8,0.10011e+04_r8,0.10025e+04_r8,0.10029e+04_r8 /) + kbo(:,15,12) = (/ & + & 0.99880e+03_r8,0.99996e+03_r8,0.10013e+04_r8,0.10026e+04_r8,0.10031e+04_r8 /) + kbo(:,16,12) = (/ & + & 0.99852e+03_r8,0.10003e+04_r8,0.10015e+04_r8,0.10028e+04_r8,0.10029e+04_r8 /) + kbo(:,17,12) = (/ & + & 0.99876e+03_r8,0.10000e+04_r8,0.10016e+04_r8,0.10027e+04_r8,0.10029e+04_r8 /) + kbo(:,18,12) = (/ & + & 0.99898e+03_r8,0.10001e+04_r8,0.10018e+04_r8,0.10028e+04_r8,0.10028e+04_r8 /) + kbo(:,19,12) = (/ & + & 0.99918e+03_r8,0.10003e+04_r8,0.10021e+04_r8,0.10028e+04_r8,0.10028e+04_r8 /) + kbo(:,20,12) = (/ & + & 0.99940e+03_r8,0.10005e+04_r8,0.10026e+04_r8,0.10029e+04_r8,0.10031e+04_r8 /) + kbo(:,21,12) = (/ & + & 0.99959e+03_r8,0.10007e+04_r8,0.10022e+04_r8,0.10029e+04_r8,0.10026e+04_r8 /) + kbo(:,22,12) = (/ & + & 0.99984e+03_r8,0.10010e+04_r8,0.10024e+04_r8,0.10030e+04_r8,0.10023e+04_r8 /) + kbo(:,23,12) = (/ & + & 0.99996e+03_r8,0.10013e+04_r8,0.10024e+04_r8,0.10029e+04_r8,0.10025e+04_r8 /) + kbo(:,24,12) = (/ & + & 0.10000e+04_r8,0.10016e+04_r8,0.10029e+04_r8,0.10029e+04_r8,0.10023e+04_r8 /) + kbo(:,25,12) = (/ & + & 0.10003e+04_r8,0.10023e+04_r8,0.10029e+04_r8,0.10026e+04_r8,0.10019e+04_r8 /) + kbo(:,26,12) = (/ & + & 0.10007e+04_r8,0.10022e+04_r8,0.10029e+04_r8,0.10026e+04_r8,0.10015e+04_r8 /) + kbo(:,27,12) = (/ & + & 0.10012e+04_r8,0.10025e+04_r8,0.10031e+04_r8,0.10024e+04_r8,0.10010e+04_r8 /) + kbo(:,28,12) = (/ & + & 0.10015e+04_r8,0.10027e+04_r8,0.10029e+04_r8,0.10022e+04_r8,0.10005e+04_r8 /) + kbo(:,29,12) = (/ & + & 0.10019e+04_r8,0.10028e+04_r8,0.10028e+04_r8,0.10019e+04_r8,0.99992e+03_r8 /) + kbo(:,30,12) = (/ & + & 0.10022e+04_r8,0.10029e+04_r8,0.10026e+04_r8,0.10017e+04_r8,0.99965e+03_r8 /) + kbo(:,31,12) = (/ & + & 0.10025e+04_r8,0.10030e+04_r8,0.10022e+04_r8,0.10011e+04_r8,0.99843e+03_r8 /) + kbo(:,32,12) = (/ & + & 0.10027e+04_r8,0.10029e+04_r8,0.10020e+04_r8,0.10007e+04_r8,0.99748e+03_r8 /) + kbo(:,33,12) = (/ & + & 0.10029e+04_r8,0.10028e+04_r8,0.10021e+04_r8,0.10000e+04_r8,0.99658e+03_r8 /) + kbo(:,34,12) = (/ & + & 0.10031e+04_r8,0.10026e+04_r8,0.10017e+04_r8,0.99945e+03_r8,0.99563e+03_r8 /) + kbo(:,35,12) = (/ & + & 0.10030e+04_r8,0.10025e+04_r8,0.10031e+04_r8,0.99888e+03_r8,0.99496e+03_r8 /) + kbo(:,36,12) = (/ & + & 0.10030e+04_r8,0.10025e+04_r8,0.10020e+04_r8,0.99880e+03_r8,0.99482e+03_r8 /) + kbo(:,37,12) = (/ & + & 0.10029e+04_r8,0.10026e+04_r8,0.10015e+04_r8,0.99939e+03_r8,0.99547e+03_r8 /) + kbo(:,38,12) = (/ & + & 0.10029e+04_r8,0.10027e+04_r8,0.10017e+04_r8,0.99958e+03_r8,0.99634e+03_r8 /) + kbo(:,39,12) = (/ & + & 0.10028e+04_r8,0.10028e+04_r8,0.10017e+04_r8,0.99993e+03_r8,0.99613e+03_r8 /) + kbo(:,40,12) = (/ & + & 0.10027e+04_r8,0.10029e+04_r8,0.10022e+04_r8,0.10003e+04_r8,0.99696e+03_r8 /) + kbo(:,41,12) = (/ & + & 0.10027e+04_r8,0.10029e+04_r8,0.10024e+04_r8,0.10013e+04_r8,0.99857e+03_r8 /) + kbo(:,42,12) = (/ & + & 0.10022e+04_r8,0.10029e+04_r8,0.10028e+04_r8,0.10021e+04_r8,0.99929e+03_r8 /) + kbo(:,43,12) = (/ & + & 0.10018e+04_r8,0.10028e+04_r8,0.10028e+04_r8,0.10020e+04_r8,0.10001e+04_r8 /) + kbo(:,44,12) = (/ & + & 0.10013e+04_r8,0.10026e+04_r8,0.10029e+04_r8,0.10023e+04_r8,0.10016e+04_r8 /) + kbo(:,45,12) = (/ & + & 0.10007e+04_r8,0.10022e+04_r8,0.10029e+04_r8,0.10026e+04_r8,0.10015e+04_r8 /) + kbo(:,46,12) = (/ & + & 0.10014e+04_r8,0.10016e+04_r8,0.10028e+04_r8,0.10028e+04_r8,0.10020e+04_r8 /) + kbo(:,47,12) = (/ & + & 0.99993e+03_r8,0.10012e+04_r8,0.10025e+04_r8,0.10029e+04_r8,0.10024e+04_r8 /) + kbo(:,48,12) = (/ & + & 0.99937e+03_r8,0.10005e+04_r8,0.10022e+04_r8,0.10029e+04_r8,0.10027e+04_r8 /) + kbo(:,49,12) = (/ & + & 0.99853e+03_r8,0.10002e+04_r8,0.10015e+04_r8,0.10026e+04_r8,0.10029e+04_r8 /) + kbo(:,50,12) = (/ & + & 0.99741e+03_r8,0.99993e+03_r8,0.10008e+04_r8,0.10023e+04_r8,0.10029e+04_r8 /) + kbo(:,51,12) = (/ & + & 0.99665e+03_r8,0.99912e+03_r8,0.10002e+04_r8,0.10018e+04_r8,0.10028e+04_r8 /) + kbo(:,52,12) = (/ & + & 0.99385e+03_r8,0.99826e+03_r8,0.10000e+04_r8,0.10013e+04_r8,0.10025e+04_r8 /) + kbo(:,53,12) = (/ & + & 0.99099e+03_r8,0.99714e+03_r8,0.99965e+03_r8,0.10007e+04_r8,0.10022e+04_r8 /) + kbo(:,54,12) = (/ & + & 0.98826e+03_r8,0.99612e+03_r8,0.99903e+03_r8,0.10002e+04_r8,0.10018e+04_r8 /) + kbo(:,55,12) = (/ & + & 0.98397e+03_r8,0.99379e+03_r8,0.99822e+03_r8,0.10000e+04_r8,0.10013e+04_r8 /) + kbo(:,56,12) = (/ & + & 0.98006e+03_r8,0.99120e+03_r8,0.99722e+03_r8,0.99969e+03_r8,0.10006e+04_r8 /) + kbo(:,57,12) = (/ & + & 0.97631e+03_r8,0.98840e+03_r8,0.99624e+03_r8,0.99911e+03_r8,0.10002e+04_r8 /) + kbo(:,58,12) = (/ & + & 0.97279e+03_r8,0.98508e+03_r8,0.99422e+03_r8,0.99838e+03_r8,0.10001e+04_r8 /) + kbo(:,59,12) = (/ & + & 0.97171e+03_r8,0.98327e+03_r8,0.99315e+03_r8,0.99818e+03_r8,0.99997e+03_r8 /) + kbo(:,13,13) = (/ & + & 0.99623e+03_r8,0.99978e+03_r8,0.10034e+04_r8,0.10050e+04_r8,0.10054e+04_r8 /) + kbo(:,14,13) = (/ & + & 0.99674e+03_r8,0.10002e+04_r8,0.10034e+04_r8,0.10050e+04_r8,0.10053e+04_r8 /) + kbo(:,15,13) = (/ & + & 0.99652e+03_r8,0.10007e+04_r8,0.10036e+04_r8,0.10051e+04_r8,0.10051e+04_r8 /) + kbo(:,16,13) = (/ & + & 0.99785e+03_r8,0.10007e+04_r8,0.10039e+04_r8,0.10049e+04_r8,0.10053e+04_r8 /) + kbo(:,17,13) = (/ & + & 0.99816e+03_r8,0.10017e+04_r8,0.10043e+04_r8,0.10052e+04_r8,0.10052e+04_r8 /) + kbo(:,18,13) = (/ & + & 0.99792e+03_r8,0.10021e+04_r8,0.10042e+04_r8,0.10053e+04_r8,0.10051e+04_r8 /) + kbo(:,19,13) = (/ & + & 0.99826e+03_r8,0.10023e+04_r8,0.10042e+04_r8,0.10053e+04_r8,0.10051e+04_r8 /) + kbo(:,20,13) = (/ & + & 0.99869e+03_r8,0.10028e+04_r8,0.10038e+04_r8,0.10053e+04_r8,0.10044e+04_r8 /) + kbo(:,21,13) = (/ & + & 0.99914e+03_r8,0.10028e+04_r8,0.10048e+04_r8,0.10054e+04_r8,0.10048e+04_r8 /) + kbo(:,22,13) = (/ & + & 0.99989e+03_r8,0.10035e+04_r8,0.10050e+04_r8,0.10053e+04_r8,0.10046e+04_r8 /) + kbo(:,23,13) = (/ & + & 0.10011e+04_r8,0.10037e+04_r8,0.10051e+04_r8,0.10053e+04_r8,0.10041e+04_r8 /) + kbo(:,24,13) = (/ & + & 0.10018e+04_r8,0.10041e+04_r8,0.10050e+04_r8,0.10052e+04_r8,0.10037e+04_r8 /) + kbo(:,25,13) = (/ & + & 0.10026e+04_r8,0.10040e+04_r8,0.10056e+04_r8,0.10050e+04_r8,0.10036e+04_r8 /) + kbo(:,26,13) = (/ & + & 0.10031e+04_r8,0.10048e+04_r8,0.10054e+04_r8,0.10050e+04_r8,0.10030e+04_r8 /) + kbo(:,27,13) = (/ & + & 0.10047e+04_r8,0.10050e+04_r8,0.10051e+04_r8,0.10045e+04_r8,0.10025e+04_r8 /) + kbo(:,28,13) = (/ & + & 0.10039e+04_r8,0.10052e+04_r8,0.10052e+04_r8,0.10041e+04_r8,0.10018e+04_r8 /) + kbo(:,29,13) = (/ & + & 0.10044e+04_r8,0.10053e+04_r8,0.10051e+04_r8,0.10037e+04_r8,0.10011e+04_r8 /) + kbo(:,30,13) = (/ & + & 0.10048e+04_r8,0.10054e+04_r8,0.10048e+04_r8,0.10029e+04_r8,0.99977e+03_r8 /) + kbo(:,31,13) = (/ & + & 0.10050e+04_r8,0.10053e+04_r8,0.10045e+04_r8,0.10025e+04_r8,0.99968e+03_r8 /) + kbo(:,32,13) = (/ & + & 0.10052e+04_r8,0.10050e+04_r8,0.10041e+04_r8,0.10015e+04_r8,0.99880e+03_r8 /) + kbo(:,33,13) = (/ & + & 0.10053e+04_r8,0.10050e+04_r8,0.10033e+04_r8,0.10008e+04_r8,0.99675e+03_r8 /) + kbo(:,34,13) = (/ & + & 0.10051e+04_r8,0.10048e+04_r8,0.10028e+04_r8,0.10000e+04_r8,0.99529e+03_r8 /) + kbo(:,35,13) = (/ & + & 0.10054e+04_r8,0.10047e+04_r8,0.10003e+04_r8,0.99992e+03_r8,0.99481e+03_r8 /) + kbo(:,36,13) = (/ & + & 0.10054e+04_r8,0.10046e+04_r8,0.10017e+04_r8,0.99987e+03_r8,0.99445e+03_r8 /) + kbo(:,37,13) = (/ & + & 0.10054e+04_r8,0.10048e+04_r8,0.10030e+04_r8,0.99995e+03_r8,0.99517e+03_r8 /) + kbo(:,38,13) = (/ & + & 0.10054e+04_r8,0.10049e+04_r8,0.10034e+04_r8,0.10006e+04_r8,0.99603e+03_r8 /) + kbo(:,39,13) = (/ & + & 0.10053e+04_r8,0.10051e+04_r8,0.10037e+04_r8,0.10011e+04_r8,0.99693e+03_r8 /) + kbo(:,40,13) = (/ & + & 0.10052e+04_r8,0.10052e+04_r8,0.10041e+04_r8,0.10018e+04_r8,0.99860e+03_r8 /) + kbo(:,41,13) = (/ & + & 0.10048e+04_r8,0.10053e+04_r8,0.10045e+04_r8,0.10023e+04_r8,0.99951e+03_r8 /) + kbo(:,42,13) = (/ & + & 0.10048e+04_r8,0.10054e+04_r8,0.10046e+04_r8,0.10024e+04_r8,0.10003e+04_r8 /) + kbo(:,43,13) = (/ & + & 0.10043e+04_r8,0.10053e+04_r8,0.10051e+04_r8,0.10038e+04_r8,0.10013e+04_r8 /) + kbo(:,44,13) = (/ & + & 0.10036e+04_r8,0.10051e+04_r8,0.10053e+04_r8,0.10044e+04_r8,0.10012e+04_r8 /) + kbo(:,45,13) = (/ & + & 0.10028e+04_r8,0.10048e+04_r8,0.10054e+04_r8,0.10048e+04_r8,0.10031e+04_r8 /) + kbo(:,46,13) = (/ & + & 0.10008e+04_r8,0.10042e+04_r8,0.10053e+04_r8,0.10052e+04_r8,0.10038e+04_r8 /) + kbo(:,47,13) = (/ & + & 0.10002e+04_r8,0.10039e+04_r8,0.10050e+04_r8,0.10053e+04_r8,0.10045e+04_r8 /) + kbo(:,48,13) = (/ & + & 0.99859e+03_r8,0.10025e+04_r8,0.10043e+04_r8,0.10054e+04_r8,0.10050e+04_r8 /) + kbo(:,49,13) = (/ & + & 0.99776e+03_r8,0.10009e+04_r8,0.10041e+04_r8,0.10052e+04_r8,0.10053e+04_r8 /) + kbo(:,50,13) = (/ & + & 0.99565e+03_r8,0.99944e+03_r8,0.10034e+04_r8,0.10049e+04_r8,0.10054e+04_r8 /) + kbo(:,51,13) = (/ & + & 0.99271e+03_r8,0.99811e+03_r8,0.10022e+04_r8,0.10043e+04_r8,0.10053e+04_r8 /) + kbo(:,52,13) = (/ & + & 0.99056e+03_r8,0.99717e+03_r8,0.10006e+04_r8,0.10036e+04_r8,0.10051e+04_r8 /) + kbo(:,53,13) = (/ & + & 0.98830e+03_r8,0.99502e+03_r8,0.99909e+03_r8,0.10028e+04_r8,0.10048e+04_r8 /) + kbo(:,54,13) = (/ & + & 0.98610e+03_r8,0.99275e+03_r8,0.99821e+03_r8,0.10021e+04_r8,0.10042e+04_r8 /) + kbo(:,55,13) = (/ & + & 0.98386e+03_r8,0.99045e+03_r8,0.99729e+03_r8,0.10008e+04_r8,0.10038e+04_r8 /) + kbo(:,56,13) = (/ & + & 0.98150e+03_r8,0.98846e+03_r8,0.99517e+03_r8,0.99919e+03_r8,0.10028e+04_r8 /) + kbo(:,57,13) = (/ & + & 0.97902e+03_r8,0.98636e+03_r8,0.99303e+03_r8,0.99832e+03_r8,0.10022e+04_r8 /) + kbo(:,58,13) = (/ & + & 0.97656e+03_r8,0.98426e+03_r8,0.99079e+03_r8,0.99735e+03_r8,0.10008e+04_r8 /) + kbo(:,59,13) = (/ & + & 0.97503e+03_r8,0.98337e+03_r8,0.99004e+03_r8,0.99647e+03_r8,0.10002e+04_r8 /) + kbo(:,13,14) = (/ & + & 0.99596e+03_r8,0.10023e+04_r8,0.10047e+04_r8,0.10067e+04_r8,0.10072e+04_r8 /) + kbo(:,14,14) = (/ & + & 0.99625e+03_r8,0.10024e+04_r8,0.10052e+04_r8,0.10068e+04_r8,0.10071e+04_r8 /) + kbo(:,15,14) = (/ & + & 0.99662e+03_r8,0.10025e+04_r8,0.10054e+04_r8,0.10069e+04_r8,0.10071e+04_r8 /) + kbo(:,16,14) = (/ & + & 0.99703e+03_r8,0.10026e+04_r8,0.10056e+04_r8,0.10070e+04_r8,0.10070e+04_r8 /) + kbo(:,17,14) = (/ & + & 0.99784e+03_r8,0.10032e+04_r8,0.10054e+04_r8,0.10071e+04_r8,0.10070e+04_r8 /) + kbo(:,18,14) = (/ & + & 0.99947e+03_r8,0.10032e+04_r8,0.10060e+04_r8,0.10071e+04_r8,0.10069e+04_r8 /) + kbo(:,19,14) = (/ & + & 0.10001e+04_r8,0.10036e+04_r8,0.10062e+04_r8,0.10071e+04_r8,0.10068e+04_r8 /) + kbo(:,20,14) = (/ & + & 0.10009e+04_r8,0.10037e+04_r8,0.10064e+04_r8,0.10076e+04_r8,0.10067e+04_r8 /) + kbo(:,21,14) = (/ & + & 0.10015e+04_r8,0.10046e+04_r8,0.10065e+04_r8,0.10072e+04_r8,0.10065e+04_r8 /) + kbo(:,22,14) = (/ & + & 0.10023e+04_r8,0.10047e+04_r8,0.10068e+04_r8,0.10071e+04_r8,0.10063e+04_r8 /) + kbo(:,23,14) = (/ & + & 0.10021e+04_r8,0.10055e+04_r8,0.10069e+04_r8,0.10071e+04_r8,0.10060e+04_r8 /) + kbo(:,24,14) = (/ & + & 0.10028e+04_r8,0.10059e+04_r8,0.10071e+04_r8,0.10069e+04_r8,0.10057e+04_r8 /) + kbo(:,25,14) = (/ & + & 0.10033e+04_r8,0.10062e+04_r8,0.10068e+04_r8,0.10068e+04_r8,0.10052e+04_r8 /) + kbo(:,26,14) = (/ & + & 0.10043e+04_r8,0.10066e+04_r8,0.10072e+04_r8,0.10061e+04_r8,0.10047e+04_r8 /) + kbo(:,27,14) = (/ & + & 0.10033e+04_r8,0.10068e+04_r8,0.10071e+04_r8,0.10062e+04_r8,0.10042e+04_r8 /) + kbo(:,28,14) = (/ & + & 0.10057e+04_r8,0.10070e+04_r8,0.10070e+04_r8,0.10058e+04_r8,0.10036e+04_r8 /) + kbo(:,29,14) = (/ & + & 0.10062e+04_r8,0.10075e+04_r8,0.10068e+04_r8,0.10053e+04_r8,0.10030e+04_r8 /) + kbo(:,30,14) = (/ & + & 0.10065e+04_r8,0.10072e+04_r8,0.10069e+04_r8,0.10048e+04_r8,0.10022e+04_r8 /) + kbo(:,31,14) = (/ & + & 0.10068e+04_r8,0.10071e+04_r8,0.10062e+04_r8,0.10042e+04_r8,0.10014e+04_r8 /) + kbo(:,32,14) = (/ & + & 0.10070e+04_r8,0.10070e+04_r8,0.10058e+04_r8,0.10035e+04_r8,0.99925e+03_r8 /) + kbo(:,33,14) = (/ & + & 0.10071e+04_r8,0.10068e+04_r8,0.10053e+04_r8,0.10029e+04_r8,0.99808e+03_r8 /) + kbo(:,34,14) = (/ & + & 0.10072e+04_r8,0.10065e+04_r8,0.10048e+04_r8,0.10021e+04_r8,0.99788e+03_r8 /) + kbo(:,35,14) = (/ & + & 0.10072e+04_r8,0.10064e+04_r8,0.10045e+04_r8,0.10016e+04_r8,0.99700e+03_r8 /) + kbo(:,36,14) = (/ & + & 0.10072e+04_r8,0.10063e+04_r8,0.10044e+04_r8,0.10015e+04_r8,0.99731e+03_r8 /) + kbo(:,37,14) = (/ & + & 0.10072e+04_r8,0.10065e+04_r8,0.10047e+04_r8,0.10021e+04_r8,0.99778e+03_r8 /) + kbo(:,38,14) = (/ & + & 0.10072e+04_r8,0.10067e+04_r8,0.10050e+04_r8,0.10026e+04_r8,0.99820e+03_r8 /) + kbo(:,39,14) = (/ & + & 0.10071e+04_r8,0.10068e+04_r8,0.10053e+04_r8,0.10030e+04_r8,0.99855e+03_r8 /) + kbo(:,40,14) = (/ & + & 0.10070e+04_r8,0.10070e+04_r8,0.10058e+04_r8,0.10036e+04_r8,0.99965e+03_r8 /) + kbo(:,41,14) = (/ & + & 0.10068e+04_r8,0.10071e+04_r8,0.10062e+04_r8,0.10042e+04_r8,0.10010e+04_r8 /) + kbo(:,42,14) = (/ & + & 0.10065e+04_r8,0.10072e+04_r8,0.10065e+04_r8,0.10048e+04_r8,0.10022e+04_r8 /) + kbo(:,43,14) = (/ & + & 0.10061e+04_r8,0.10071e+04_r8,0.10069e+04_r8,0.10055e+04_r8,0.10031e+04_r8 /) + kbo(:,44,14) = (/ & + & 0.10054e+04_r8,0.10069e+04_r8,0.10071e+04_r8,0.10061e+04_r8,0.10039e+04_r8 /) + kbo(:,45,14) = (/ & + & 0.10046e+04_r8,0.10066e+04_r8,0.10072e+04_r8,0.10065e+04_r8,0.10048e+04_r8 /) + kbo(:,46,14) = (/ & + & 0.10023e+04_r8,0.10060e+04_r8,0.10075e+04_r8,0.10069e+04_r8,0.10055e+04_r8 /) + kbo(:,47,14) = (/ & + & 0.10024e+04_r8,0.10044e+04_r8,0.10068e+04_r8,0.10071e+04_r8,0.10062e+04_r8 /) + kbo(:,48,14) = (/ & + & 0.10006e+04_r8,0.10039e+04_r8,0.10063e+04_r8,0.10072e+04_r8,0.10067e+04_r8 /) + kbo(:,49,14) = (/ & + & 0.99705e+03_r8,0.10026e+04_r8,0.10052e+04_r8,0.10070e+04_r8,0.10070e+04_r8 /) + kbo(:,50,14) = (/ & + & 0.99574e+03_r8,0.10014e+04_r8,0.10040e+04_r8,0.10066e+04_r8,0.10072e+04_r8 /) + kbo(:,51,14) = (/ & + & 0.99447e+03_r8,0.99966e+03_r8,0.10033e+04_r8,0.10065e+04_r8,0.10071e+04_r8 /) + kbo(:,52,14) = (/ & + & 0.99299e+03_r8,0.99670e+03_r8,0.10025e+04_r8,0.10054e+04_r8,0.10069e+04_r8 /) + kbo(:,53,14) = (/ & + & 0.99138e+03_r8,0.99552e+03_r8,0.10013e+04_r8,0.10044e+04_r8,0.10065e+04_r8 /) + kbo(:,54,14) = (/ & + & 0.98979e+03_r8,0.99462e+03_r8,0.99874e+03_r8,0.10030e+04_r8,0.10060e+04_r8 /) + kbo(:,55,14) = (/ & + & 0.98814e+03_r8,0.99291e+03_r8,0.99630e+03_r8,0.10029e+04_r8,0.10050e+04_r8 /) + kbo(:,56,14) = (/ & + & 0.98639e+03_r8,0.99150e+03_r8,0.99562e+03_r8,0.10014e+04_r8,0.10045e+04_r8 /) + kbo(:,57,14) = (/ & + & 0.98454e+03_r8,0.98998e+03_r8,0.99438e+03_r8,0.99904e+03_r8,0.10032e+04_r8 /) + kbo(:,58,14) = (/ & + & 0.98268e+03_r8,0.98844e+03_r8,0.99315e+03_r8,0.99688e+03_r8,0.10025e+04_r8 /) + kbo(:,59,14) = (/ & + & 0.98190e+03_r8,0.98779e+03_r8,0.99262e+03_r8,0.99638e+03_r8,0.10024e+04_r8 /) + kbo(:,13,15) = (/ & + & 0.99739e+03_r8,0.10017e+04_r8,0.10064e+04_r8,0.10076e+04_r8,0.10080e+04_r8 /) + kbo(:,14,15) = (/ & + & 0.99781e+03_r8,0.10021e+04_r8,0.10065e+04_r8,0.10077e+04_r8,0.10090e+04_r8 /) + kbo(:,15,15) = (/ & + & 0.99827e+03_r8,0.10029e+04_r8,0.10067e+04_r8,0.10077e+04_r8,0.10079e+04_r8 /) + kbo(:,16,15) = (/ & + & 0.99875e+03_r8,0.10040e+04_r8,0.10068e+04_r8,0.10078e+04_r8,0.10089e+04_r8 /) + kbo(:,17,15) = (/ & + & 0.99816e+03_r8,0.10041e+04_r8,0.10080e+04_r8,0.10079e+04_r8,0.10078e+04_r8 /) + kbo(:,18,15) = (/ & + & 0.99861e+03_r8,0.10065e+04_r8,0.10071e+04_r8,0.10090e+04_r8,0.10078e+04_r8 /) + kbo(:,19,15) = (/ & + & 0.10001e+04_r8,0.10056e+04_r8,0.10072e+04_r8,0.10079e+04_r8,0.10077e+04_r8 /) + kbo(:,20,15) = (/ & + & 0.99952e+03_r8,0.10059e+04_r8,0.10074e+04_r8,0.10090e+04_r8,0.10087e+04_r8 /) + kbo(:,21,15) = (/ & + & 0.10000e+04_r8,0.10061e+04_r8,0.10085e+04_r8,0.10080e+04_r8,0.10085e+04_r8 /) + kbo(:,22,15) = (/ & + & 0.10012e+04_r8,0.10064e+04_r8,0.10076e+04_r8,0.10090e+04_r8,0.10073e+04_r8 /) + kbo(:,23,15) = (/ & + & 0.10032e+04_r8,0.10067e+04_r8,0.10088e+04_r8,0.10079e+04_r8,0.10070e+04_r8 /) + kbo(:,24,15) = (/ & + & 0.10052e+04_r8,0.10070e+04_r8,0.10079e+04_r8,0.10089e+04_r8,0.10067e+04_r8 /) + kbo(:,25,15) = (/ & + & 0.10057e+04_r8,0.10083e+04_r8,0.10079e+04_r8,0.10098e+04_r8,0.10062e+04_r8 /) + kbo(:,26,15) = (/ & + & 0.10061e+04_r8,0.10085e+04_r8,0.10080e+04_r8,0.10075e+04_r8,0.10068e+04_r8 /) + kbo(:,27,15) = (/ & + & 0.10066e+04_r8,0.10087e+04_r8,0.10111e+04_r8,0.10072e+04_r8,0.10051e+04_r8 /) + kbo(:,28,15) = (/ & + & 0.10069e+04_r8,0.10089e+04_r8,0.10079e+04_r8,0.10068e+04_r8,0.10054e+04_r8 /) + kbo(:,29,15) = (/ & + & 0.10072e+04_r8,0.10069e+04_r8,0.10077e+04_r8,0.10063e+04_r8,0.10034e+04_r8 /) + kbo(:,30,15) = (/ & + & 0.10075e+04_r8,0.10111e+04_r8,0.10075e+04_r8,0.10068e+04_r8,0.10088e+04_r8 /) + kbo(:,31,15) = (/ & + & 0.10077e+04_r8,0.10080e+04_r8,0.10072e+04_r8,0.10061e+04_r8,0.10007e+04_r8 /) + kbo(:,32,15) = (/ & + & 0.10078e+04_r8,0.10089e+04_r8,0.10068e+04_r8,0.10043e+04_r8,0.10013e+04_r8 /) + kbo(:,33,15) = (/ & + & 0.10079e+04_r8,0.10077e+04_r8,0.10063e+04_r8,0.10044e+04_r8,0.10009e+04_r8 /) + kbo(:,34,15) = (/ & + & 0.10090e+04_r8,0.10075e+04_r8,0.10058e+04_r8,0.10025e+04_r8,0.10002e+04_r8 /) + kbo(:,35,15) = (/ & + & 0.10080e+04_r8,0.10073e+04_r8,0.10054e+04_r8,0.10021e+04_r8,0.99972e+03_r8 /) + kbo(:,36,15) = (/ & + & 0.10090e+04_r8,0.10073e+04_r8,0.10054e+04_r8,0.10020e+04_r8,0.99964e+03_r8 /) + kbo(:,37,15) = (/ & + & 0.10080e+04_r8,0.10075e+04_r8,0.10057e+04_r8,0.10024e+04_r8,0.10001e+04_r8 /) + kbo(:,38,15) = (/ & + & 0.10090e+04_r8,0.10076e+04_r8,0.10060e+04_r8,0.10040e+04_r8,0.10006e+04_r8 /) + kbo(:,39,15) = (/ & + & 0.10079e+04_r8,0.10077e+04_r8,0.10063e+04_r8,0.10034e+04_r8,0.10010e+04_r8 /) + kbo(:,40,15) = (/ & + & 0.10089e+04_r8,0.10089e+04_r8,0.10068e+04_r8,0.10054e+04_r8,0.10014e+04_r8 /) + kbo(:,41,15) = (/ & + & 0.10087e+04_r8,0.10090e+04_r8,0.10082e+04_r8,0.10051e+04_r8,0.10018e+04_r8 /) + kbo(:,42,15) = (/ & + & 0.10085e+04_r8,0.10090e+04_r8,0.10075e+04_r8,0.10058e+04_r8,0.10025e+04_r8 /) + kbo(:,43,15) = (/ & + & 0.10071e+04_r8,0.10079e+04_r8,0.10078e+04_r8,0.10086e+04_r8,0.10037e+04_r8 /) + kbo(:,44,15) = (/ & + & 0.10067e+04_r8,0.10088e+04_r8,0.10079e+04_r8,0.10071e+04_r8,0.10048e+04_r8 /) + kbo(:,45,15) = (/ & + & 0.10061e+04_r8,0.10075e+04_r8,0.10090e+04_r8,0.10096e+04_r8,0.10057e+04_r8 /) + kbo(:,46,15) = (/ & + & 0.10054e+04_r8,0.10071e+04_r8,0.10068e+04_r8,0.10078e+04_r8,0.10065e+04_r8 /) + kbo(:,47,15) = (/ & + & 0.10020e+04_r8,0.10065e+04_r8,0.10087e+04_r8,0.10079e+04_r8,0.10093e+04_r8 /) + kbo(:,48,15) = (/ & + & 0.99938e+03_r8,0.10058e+04_r8,0.10073e+04_r8,0.10079e+04_r8,0.10087e+04_r8 /) + kbo(:,49,15) = (/ & + & 0.99869e+03_r8,0.10038e+04_r8,0.10079e+04_r8,0.10099e+04_r8,0.10089e+04_r8 /) + kbo(:,50,15) = (/ & + & 0.99593e+03_r8,0.10003e+04_r8,0.10062e+04_r8,0.10075e+04_r8,0.10090e+04_r8 /) + kbo(:,51,15) = (/ & + & 0.99417e+03_r8,0.99877e+03_r8,0.10055e+04_r8,0.10061e+04_r8,0.10090e+04_r8 /) + kbo(:,52,15) = (/ & + & 0.99334e+03_r8,0.99717e+03_r8,0.10030e+04_r8,0.10077e+04_r8,0.10077e+04_r8 /) + kbo(:,53,15) = (/ & + & 0.99034e+03_r8,0.99548e+03_r8,0.99989e+03_r8,0.10071e+04_r8,0.10085e+04_r8 /) + kbo(:,54,15) = (/ & + & 0.98844e+03_r8,0.99385e+03_r8,0.99849e+03_r8,0.10064e+04_r8,0.10081e+04_r8 /) + kbo(:,55,15) = (/ & + & 0.98654e+03_r8,0.99323e+03_r8,0.99708e+03_r8,0.10005e+04_r8,0.10066e+04_r8 /) + kbo(:,56,15) = (/ & + & 0.98558e+03_r8,0.99048e+03_r8,0.99560e+03_r8,0.99999e+03_r8,0.10071e+04_r8 /) + kbo(:,57,15) = (/ & + & 0.98349e+03_r8,0.98867e+03_r8,0.99404e+03_r8,0.99866e+03_r8,0.10054e+04_r8 /) + kbo(:,58,15) = (/ & + & 0.98039e+03_r8,0.98688e+03_r8,0.99250e+03_r8,0.99837e+03_r8,0.10028e+04_r8 /) + kbo(:,59,15) = (/ & + & 0.97954e+03_r8,0.98614e+03_r8,0.99186e+03_r8,0.99679e+03_r8,0.10019e+04_r8 /) + kbo(:,13,16) = (/ & + & 0.98905e+03_r8,0.99319e+03_r8,0.10065e+04_r8,0.10075e+04_r8,0.10080e+04_r8 /) + kbo(:,14,16) = (/ & + & 0.98947e+03_r8,0.10009e+04_r8,0.10067e+04_r8,0.10076e+04_r8,0.10005e+04_r8 /) + kbo(:,15,16) = (/ & + & 0.98993e+03_r8,0.10052e+04_r8,0.10068e+04_r8,0.10076e+04_r8,0.10080e+04_r8 /) + kbo(:,16,16) = (/ & + & 0.99040e+03_r8,0.10054e+04_r8,0.10069e+04_r8,0.10077e+04_r8,0.10005e+04_r8 /) + kbo(:,17,16) = (/ & + & 0.99823e+03_r8,0.10056e+04_r8,0.99955e+03_r8,0.10078e+04_r8,0.10080e+04_r8 /) + kbo(:,18,16) = (/ & + & 0.99867e+03_r8,0.99832e+03_r8,0.10071e+04_r8,0.10003e+04_r8,0.10079e+04_r8 /) + kbo(:,19,16) = (/ & + & 0.99168e+03_r8,0.10059e+04_r8,0.10072e+04_r8,0.10078e+04_r8,0.10079e+04_r8 /) + kbo(:,20,16) = (/ & + & 0.99955e+03_r8,0.10061e+04_r8,0.10073e+04_r8,0.99297e+03_r8,0.10003e+04_r8 /) + kbo(:,21,16) = (/ & + & 0.10000e+04_r8,0.10063e+04_r8,0.99994e+03_r8,0.10079e+04_r8,0.10002e+04_r8 /) + kbo(:,22,16) = (/ & + & 0.10007e+04_r8,0.10066e+04_r8,0.10075e+04_r8,0.10005e+04_r8,0.10075e+04_r8 /) + kbo(:,23,16) = (/ & + & 0.10052e+04_r8,0.10068e+04_r8,0.10002e+04_r8,0.10080e+04_r8,0.10072e+04_r8 /) + kbo(:,24,16) = (/ & + & 0.10056e+04_r8,0.10070e+04_r8,0.10078e+04_r8,0.10005e+04_r8,0.10068e+04_r8 /) + kbo(:,25,16) = (/ & + & 0.10060e+04_r8,0.99977e+03_r8,0.10079e+04_r8,0.99294e+03_r8,0.10064e+04_r8 /) + kbo(:,26,16) = (/ & + & 0.10064e+04_r8,0.99996e+03_r8,0.10080e+04_r8,0.10077e+04_r8,0.99839e+03_r8 /) + kbo(:,27,16) = (/ & + & 0.10067e+04_r8,0.10001e+04_r8,0.98561e+03_r8,0.10074e+04_r8,0.10052e+04_r8 /) + kbo(:,28,16) = (/ & + & 0.10069e+04_r8,0.10003e+04_r8,0.10080e+04_r8,0.10070e+04_r8,0.99700e+03_r8 /) + kbo(:,29,16) = (/ & + & 0.10072e+04_r8,0.10078e+04_r8,0.10079e+04_r8,0.10065e+04_r8,0.10036e+04_r8 /) + kbo(:,30,16) = (/ & + & 0.10074e+04_r8,0.98555e+03_r8,0.10002e+04_r8,0.99845e+03_r8,0.95900e+03_r8 /) + kbo(:,31,16) = (/ & + & 0.10076e+04_r8,0.10080e+04_r8,0.10074e+04_r8,0.99776e+03_r8,0.10037e+04_r8 /) + kbo(:,32,16) = (/ & + & 0.10077e+04_r8,0.10005e+04_r8,0.10070e+04_r8,0.10044e+04_r8,0.10038e+04_r8 /) + kbo(:,33,16) = (/ & + & 0.10079e+04_r8,0.10079e+04_r8,0.10064e+04_r8,0.99602e+03_r8,0.10038e+04_r8 /) + kbo(:,34,16) = (/ & + & 0.10005e+04_r8,0.10077e+04_r8,0.10059e+04_r8,0.10036e+04_r8,0.10037e+04_r8 /) + kbo(:,35,16) = (/ & + & 0.10080e+04_r8,0.10075e+04_r8,0.10055e+04_r8,0.10037e+04_r8,0.10036e+04_r8 /) + kbo(:,36,16) = (/ & + & 0.10005e+04_r8,0.10075e+04_r8,0.10055e+04_r8,0.10037e+04_r8,0.10036e+04_r8 /) + kbo(:,37,16) = (/ & + & 0.10080e+04_r8,0.10077e+04_r8,0.10058e+04_r8,0.10037e+04_r8,0.10037e+04_r8 /) + kbo(:,38,16) = (/ & + & 0.10004e+04_r8,0.10078e+04_r8,0.10062e+04_r8,0.99569e+03_r8,0.10037e+04_r8 /) + kbo(:,39,16) = (/ & + & 0.10078e+04_r8,0.10079e+04_r8,0.10065e+04_r8,0.10036e+04_r8,0.10038e+04_r8 /) + kbo(:,40,16) = (/ & + & 0.10003e+04_r8,0.10005e+04_r8,0.10070e+04_r8,0.99698e+03_r8,0.10038e+04_r8 /) + kbo(:,41,16) = (/ & + & 0.10001e+04_r8,0.10005e+04_r8,0.99992e+03_r8,0.10052e+04_r8,0.10037e+04_r8 /) + kbo(:,42,16) = (/ & + & 0.99994e+03_r8,0.10005e+04_r8,0.10077e+04_r8,0.10059e+04_r8,0.10036e+04_r8 /) + kbo(:,43,16) = (/ & + & 0.10071e+04_r8,0.10078e+04_r8,0.10079e+04_r8,0.99172e+03_r8,0.10038e+04_r8 /) + kbo(:,44,16) = (/ & + & 0.10068e+04_r8,0.10002e+04_r8,0.10080e+04_r8,0.10072e+04_r8,0.10049e+04_r8 /) + kbo(:,45,16) = (/ & + & 0.10063e+04_r8,0.10074e+04_r8,0.10005e+04_r8,0.99276e+03_r8,0.10059e+04_r8 /) + kbo(:,46,16) = (/ & + & 0.10057e+04_r8,0.10071e+04_r8,0.10078e+04_r8,0.10079e+04_r8,0.10067e+04_r8 /) + kbo(:,47,16) = (/ & + & 0.10009e+04_r8,0.10067e+04_r8,0.10001e+04_r8,0.10080e+04_r8,0.99247e+03_r8 /) + kbo(:,48,16) = (/ & + & 0.99941e+03_r8,0.10061e+04_r8,0.10073e+04_r8,0.10079e+04_r8,0.10004e+04_r8 /) + kbo(:,49,16) = (/ & + & 0.99034e+03_r8,0.10054e+04_r8,0.99943e+03_r8,0.99276e+03_r8,0.10005e+04_r8 /) + kbo(:,50,16) = (/ & + & 0.99601e+03_r8,0.10003e+04_r8,0.10064e+04_r8,0.10074e+04_r8,0.10005e+04_r8 /) + kbo(:,51,16) = (/ & + & 0.99422e+03_r8,0.99882e+03_r8,0.10058e+04_r8,0.10071e+04_r8,0.10003e+04_r8 /) + kbo(:,52,16) = (/ & + & 0.98496e+03_r8,0.99726e+03_r8,0.10013e+04_r8,0.99930e+03_r8,0.10076e+04_r8 /) + kbo(:,53,16) = (/ & + & 0.99030e+03_r8,0.99555e+03_r8,0.99990e+03_r8,0.99882e+03_r8,0.99991e+03_r8 /) + kbo(:,54,16) = (/ & + & 0.98836e+03_r8,0.98653e+03_r8,0.99856e+03_r8,0.99827e+03_r8,0.99962e+03_r8 /) + kbo(:,55,16) = (/ & + & 0.98643e+03_r8,0.98485e+03_r8,0.99716e+03_r8,0.10012e+04_r8,0.10067e+04_r8 /) + kbo(:,56,16) = (/ & + & 0.97714e+03_r8,0.99044e+03_r8,0.99567e+03_r8,0.99999e+03_r8,0.99885e+03_r8 /) + kbo(:,57,16) = (/ & + & 0.97511e+03_r8,0.98860e+03_r8,0.99409e+03_r8,0.99872e+03_r8,0.10058e+04_r8 /) + kbo(:,58,16) = (/ & + & 0.98036e+03_r8,0.98678e+03_r8,0.99251e+03_r8,0.99003e+03_r8,0.10052e+04_r8 /) + kbo(:,59,16) = (/ & + & 0.97953e+03_r8,0.98603e+03_r8,0.99185e+03_r8,0.99687e+03_r8,0.10009e+04_r8 /) + + end subroutine sw_kgb27 + +! ************************************************************************** + subroutine sw_kgb28 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg28, only : kao, kbo, sfluxrefo, & + rayl, strrat, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:,1) = (/ & + & 1.06156_r8 , 0.599910_r8 , 0.422462_r8 , 0.400077_r8 , & + & 0.282221_r8 , 0.187893_r8 , 6.77357e-02_r8, 3.04572e-02_r8, & + & 2.00442e-02_r8, 2.30786e-03_r8, 2.08824e-03_r8, 1.42604e-03_r8, & + & 9.67384e-04_r8, 6.35362e-04_r8, 1.47727e-04_r8, 6.87639e-06_r8 /) + sfluxrefo(:,2) = (/ & + & 1.07598_r8 , 0.585099_r8 , 0.422852_r8 , 0.400077_r8 , & + & 0.282221_r8 , 0.187893_r8 , 6.69686e-02_r8, 3.09070e-02_r8, & + & 2.02400e-02_r8, 2.47760e-03_r8, 1.89411e-03_r8, 1.41122e-03_r8, & + & 1.12449e-03_r8, 5.73505e-04_r8, 2.04160e-04_r8, 1.58371e-05_r8 /) + sfluxrefo(:,3) = (/ & + & 0.461647_r8 , 0.406113_r8 , 0.332506_r8 , 0.307508_r8 , & + & 0.211167_r8 , 0.235457_r8 , 0.495886_r8 , 0.363921_r8 , & + & 0.192700_r8 , 2.04678e-02_r8, 1.55407e-02_r8, 1.03882e-02_r8, & + & 1.10778e-02_r8, 1.00504e-02_r8, 4.93497e-03_r8, 5.73410e-04_r8 /) + sfluxrefo(:,4) = (/ & + & 0.132669_r8 , 0.175058_r8 , 0.359263_r8 , 0.388142_r8 , & + & 0.350359_r8 , 0.475892_r8 , 0.489593_r8 , 0.408437_r8 , & + & 0.221049_r8 , 1.94514e-02_r8, 1.54848e-02_r8, 1.44999e-02_r8, & + & 1.44568e-02_r8, 1.00527e-02_r8, 4.95897e-03_r8, 5.73327e-04_r8 /) + sfluxrefo(:,5) = (/ & + & 7.54800e-02_r8, 0.232246_r8 , 0.359263_r8 , 0.388142_r8 , & + & 0.350359_r8 , 0.426317_r8 , 0.493485_r8 , 0.432016_r8 , & + & 0.239203_r8 , 1.74951e-02_r8, 1.74477e-02_r8, 1.83566e-02_r8, & + & 1.44818e-02_r8, 1.01048e-02_r8, 4.97487e-03_r8, 5.66831e-04_r8 /) + +! Rayleigh extinction coefficient at v = ????? cm-1. + rayl = 2.02e-05_r8 + + strrat = 6.67029e-07_r8 + + layreffr = 58 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1, 1) = (/ & + & 0.46447e+02_r8,0.18001e+03_r8,0.31338e+03_r8,0.44652e+03_r8,0.54636e+03_r8, & + & 0.54173e+03_r8,0.45707e+03_r8,0.27363e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 1, 1) = (/ & + & 0.45270e+02_r8,0.17886e+03_r8,0.31225e+03_r8,0.44541e+03_r8,0.54177e+03_r8, & + & 0.53436e+03_r8,0.44932e+03_r8,0.26748e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 1, 1) = (/ & + & 0.44214e+02_r8,0.17776e+03_r8,0.31115e+03_r8,0.44427e+03_r8,0.53733e+03_r8, & + & 0.52756e+03_r8,0.44224e+03_r8,0.26195e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 1, 1) = (/ & + & 0.43259e+02_r8,0.17673e+03_r8,0.31005e+03_r8,0.44305e+03_r8,0.53298e+03_r8, & + & 0.52129e+03_r8,0.43574e+03_r8,0.25696e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 1, 1) = (/ & + & 0.42393e+02_r8,0.17575e+03_r8,0.30896e+03_r8,0.44173e+03_r8,0.52883e+03_r8, & + & 0.51548e+03_r8,0.42976e+03_r8,0.25242e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 2, 1) = (/ & + & 0.42908e+02_r8,0.17695e+03_r8,0.31077e+03_r8,0.44434e+03_r8,0.53161e+03_r8, & + & 0.51895e+03_r8,0.43332e+03_r8,0.25512e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 2, 1) = (/ & + & 0.41899e+02_r8,0.17596e+03_r8,0.30980e+03_r8,0.44336e+03_r8,0.52686e+03_r8, & + & 0.51213e+03_r8,0.42632e+03_r8,0.24984e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 2, 1) = (/ & + & 0.40995e+02_r8,0.17502e+03_r8,0.30884e+03_r8,0.44232e+03_r8,0.52230e+03_r8, & + & 0.50592e+03_r8,0.41995e+03_r8,0.24511e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 2, 1) = (/ & + & 0.40181e+02_r8,0.17412e+03_r8,0.30788e+03_r8,0.44119e+03_r8,0.51785e+03_r8, & + & 0.50025e+03_r8,0.41414e+03_r8,0.24085e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 2, 1) = (/ & + & 0.39443e+02_r8,0.17326e+03_r8,0.30691e+03_r8,0.43992e+03_r8,0.51364e+03_r8, & + & 0.49503e+03_r8,0.40882e+03_r8,0.23699e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 3, 1) = (/ & + & 0.40126e+02_r8,0.17457e+03_r8,0.30876e+03_r8,0.44248e+03_r8,0.51755e+03_r8, & + & 0.49986e+03_r8,0.41375e+03_r8,0.24056e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 3, 1) = (/ & + & 0.39240e+02_r8,0.17370e+03_r8,0.30792e+03_r8,0.44146e+03_r8,0.51254e+03_r8, & + & 0.49358e+03_r8,0.40735e+03_r8,0.23593e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 3, 1) = (/ & + & 0.38450e+02_r8,0.17288e+03_r8,0.30708e+03_r8,0.44031e+03_r8,0.50793e+03_r8, & + & 0.48786e+03_r8,0.40155e+03_r8,0.23179e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 3, 1) = (/ & + & 0.37740e+02_r8,0.17210e+03_r8,0.30624e+03_r8,0.43908e+03_r8,0.50368e+03_r8, & + & 0.48264e+03_r8,0.39629e+03_r8,0.22808e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 3, 1) = (/ & + & 0.37099e+02_r8,0.17134e+03_r8,0.30539e+03_r8,0.43781e+03_r8,0.49975e+03_r8, & + & 0.47787e+03_r8,0.39149e+03_r8,0.22473e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 4, 1) = (/ & + & 0.37818e+02_r8,0.17258e+03_r8,0.30708e+03_r8,0.43967e+03_r8,0.50412e+03_r8, & + & 0.48321e+03_r8,0.39687e+03_r8,0.22848e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 4, 1) = (/ & + & 0.37034e+02_r8,0.17183e+03_r8,0.30636e+03_r8,0.43833e+03_r8,0.49935e+03_r8, & + & 0.47738e+03_r8,0.39100e+03_r8,0.22439e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 4, 1) = (/ & + & 0.36338e+02_r8,0.17111e+03_r8,0.30564e+03_r8,0.43700e+03_r8,0.49496e+03_r8, & + & 0.47212e+03_r8,0.38572e+03_r8,0.22075e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 4, 1) = (/ & + & 0.35716e+02_r8,0.17043e+03_r8,0.30491e+03_r8,0.43569e+03_r8,0.49094e+03_r8, & + & 0.46732e+03_r8,0.38094e+03_r8,0.21749e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 4, 1) = (/ & + & 0.35156e+02_r8,0.16977e+03_r8,0.30416e+03_r8,0.43437e+03_r8,0.48726e+03_r8, & + & 0.46294e+03_r8,0.37660e+03_r8,0.21456e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 5, 1) = (/ & + & 0.35857e+02_r8,0.17089e+03_r8,0.30563e+03_r8,0.43619e+03_r8,0.49186e+03_r8, & + & 0.46841e+03_r8,0.38202e+03_r8,0.21822e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 5, 1) = (/ & + & 0.35163e+02_r8,0.17023e+03_r8,0.30502e+03_r8,0.43478e+03_r8,0.48731e+03_r8, & + & 0.46300e+03_r8,0.37666e+03_r8,0.21460e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 5, 1) = (/ & + & 0.34550e+02_r8,0.16961e+03_r8,0.30441e+03_r8,0.43332e+03_r8,0.48321e+03_r8, & + & 0.45813e+03_r8,0.37186e+03_r8,0.21139e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 5, 1) = (/ & + & 0.34004e+02_r8,0.16902e+03_r8,0.30378e+03_r8,0.43194e+03_r8,0.47950e+03_r8, & + & 0.45375e+03_r8,0.36755e+03_r8,0.20853e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 5, 1) = (/ & + & 0.33514e+02_r8,0.16844e+03_r8,0.30312e+03_r8,0.43058e+03_r8,0.47611e+03_r8, & + & 0.44977e+03_r8,0.36365e+03_r8,0.20597e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 6, 1) = (/ & + & 0.34212e+02_r8,0.16946e+03_r8,0.30440e+03_r8,0.43247e+03_r8,0.48092e+03_r8, & + & 0.45542e+03_r8,0.36920e+03_r8,0.20962e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 6, 1) = (/ & + & 0.33595e+02_r8,0.16889e+03_r8,0.30389e+03_r8,0.43093e+03_r8,0.47667e+03_r8, & + & 0.45043e+03_r8,0.36430e+03_r8,0.20639e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 6, 1) = (/ & + & 0.33052e+02_r8,0.16835e+03_r8,0.30337e+03_r8,0.42946e+03_r8,0.47287e+03_r8, & + & 0.44599e+03_r8,0.35993e+03_r8,0.20355e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 6, 1) = (/ & + & 0.32571e+02_r8,0.16784e+03_r8,0.30283e+03_r8,0.42807e+03_r8,0.46947e+03_r8, & + & 0.44201e+03_r8,0.35602e+03_r8,0.20103e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 6, 1) = (/ & + & 0.32141e+02_r8,0.16733e+03_r8,0.30227e+03_r8,0.42674e+03_r8,0.46640e+03_r8, & + & 0.43842e+03_r8,0.35250e+03_r8,0.19879e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 7, 1) = (/ & + & 0.32812e+02_r8,0.16823e+03_r8,0.30334e+03_r8,0.42859e+03_r8,0.47118e+03_r8, & + & 0.44401e+03_r8,0.35799e+03_r8,0.20230e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 7, 1) = (/ & + & 0.32263e+02_r8,0.16774e+03_r8,0.30291e+03_r8,0.42708e+03_r8,0.46727e+03_r8, & + & 0.43944e+03_r8,0.35350e+03_r8,0.19942e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 7, 1) = (/ & + & 0.31782e+02_r8,0.16728e+03_r8,0.30248e+03_r8,0.42558e+03_r8,0.46381e+03_r8, & + & 0.43539e+03_r8,0.34954e+03_r8,0.19691e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 7, 1) = (/ & + & 0.31357e+02_r8,0.16683e+03_r8,0.30203e+03_r8,0.42413e+03_r8,0.46069e+03_r8, & + & 0.43177e+03_r8,0.34599e+03_r8,0.19468e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 7, 1) = (/ & + & 0.30980e+02_r8,0.16640e+03_r8,0.30154e+03_r8,0.42276e+03_r8,0.45787e+03_r8, & + & 0.42852e+03_r8,0.34280e+03_r8,0.19271e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 8, 1) = (/ & + & 0.31614e+02_r8,0.16716e+03_r8,0.30239e+03_r8,0.42473e+03_r8,0.46259e+03_r8, & + & 0.43397e+03_r8,0.34814e+03_r8,0.19603e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 8, 1) = (/ & + & 0.31125e+02_r8,0.16674e+03_r8,0.30206e+03_r8,0.42311e+03_r8,0.45896e+03_r8, & + & 0.42978e+03_r8,0.34403e+03_r8,0.19347e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 8, 1) = (/ & + & 0.30699e+02_r8,0.16635e+03_r8,0.30170e+03_r8,0.42163e+03_r8,0.45573e+03_r8, & + & 0.42608e+03_r8,0.34039e+03_r8,0.19124e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 8, 1) = (/ & + & 0.30325e+02_r8,0.16597e+03_r8,0.30133e+03_r8,0.42027e+03_r8,0.45286e+03_r8, & + & 0.42281e+03_r8,0.33716e+03_r8,0.18928e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 8, 1) = (/ & + & 0.29993e+02_r8,0.16559e+03_r8,0.30092e+03_r8,0.41901e+03_r8,0.45030e+03_r8, & + & 0.41988e+03_r8,0.33427e+03_r8,0.18755e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 9, 1) = (/ & + & 0.30594e+02_r8,0.16624e+03_r8,0.30156e+03_r8,0.42087e+03_r8,0.45493e+03_r8, & + & 0.42517e+03_r8,0.33949e+03_r8,0.19069e+03_r8,0.35000e+02_r8 /) + kao(:, 2, 9, 1) = (/ & + & 0.30158e+02_r8,0.16589e+03_r8,0.30131e+03_r8,0.41937e+03_r8,0.45157e+03_r8, & + & 0.42134e+03_r8,0.33570e+03_r8,0.18841e+03_r8,0.35000e+02_r8 /) + kao(:, 3, 9, 1) = (/ & + & 0.29780e+02_r8,0.16556e+03_r8,0.30103e+03_r8,0.41800e+03_r8,0.44864e+03_r8, & + & 0.41799e+03_r8,0.33239e+03_r8,0.18643e+03_r8,0.35000e+02_r8 /) + kao(:, 4, 9, 1) = (/ & + & 0.29450e+02_r8,0.16523e+03_r8,0.30072e+03_r8,0.41674e+03_r8,0.44606e+03_r8, & + & 0.41504e+03_r8,0.32946e+03_r8,0.18471e+03_r8,0.35000e+02_r8 /) + kao(:, 5, 9, 1) = (/ & + & 0.29159e+02_r8,0.16491e+03_r8,0.30039e+03_r8,0.41557e+03_r8,0.44377e+03_r8, & + & 0.41242e+03_r8,0.32686e+03_r8,0.18318e+03_r8,0.35000e+02_r8 /) + kao(:, 1,10, 1) = (/ & + & 0.29691e+02_r8,0.16541e+03_r8,0.30081e+03_r8,0.41722e+03_r8,0.44795e+03_r8, & + & 0.41720e+03_r8,0.33160e+03_r8,0.18597e+03_r8,0.35000e+02_r8 /) + kao(:, 2,10, 1) = (/ & + & 0.29307e+02_r8,0.16512e+03_r8,0.30063e+03_r8,0.41581e+03_r8,0.44493e+03_r8, & + & 0.41375e+03_r8,0.32818e+03_r8,0.18396e+03_r8,0.35000e+02_r8 /) + kao(:, 3,10, 1) = (/ & + & 0.28975e+02_r8,0.16485e+03_r8,0.30042e+03_r8,0.41454e+03_r8,0.44231e+03_r8, & + & 0.41076e+03_r8,0.32520e+03_r8,0.18222e+03_r8,0.35000e+02_r8 /) + kao(:, 4,10, 1) = (/ & + & 0.28687e+02_r8,0.16458e+03_r8,0.30018e+03_r8,0.41340e+03_r8,0.44002e+03_r8, & + & 0.40814e+03_r8,0.32259e+03_r8,0.18071e+03_r8,0.35000e+02_r8 /) + kao(:, 5,10, 1) = (/ & + & 0.28434e+02_r8,0.16431e+03_r8,0.29989e+03_r8,0.41235e+03_r8,0.43799e+03_r8, & + & 0.40583e+03_r8,0.32028e+03_r8,0.17939e+03_r8,0.35000e+02_r8 /) + kao(:, 1,11, 1) = (/ & + & 0.28760e+02_r8,0.16459e+03_r8,0.30010e+03_r8,0.41321e+03_r8,0.44060e+03_r8, & + & 0.40880e+03_r8,0.32325e+03_r8,0.18109e+03_r8,0.35000e+02_r8 /) + kao(:, 2,11, 1) = (/ & + & 0.28444e+02_r8,0.16436e+03_r8,0.29997e+03_r8,0.41200e+03_r8,0.43807e+03_r8, & + & 0.40592e+03_r8,0.32038e+03_r8,0.17944e+03_r8,0.35000e+02_r8 /) + kao(:, 3,11, 1) = (/ & + & 0.28173e+02_r8,0.16414e+03_r8,0.29981e+03_r8,0.41092e+03_r8,0.43587e+03_r8, & + & 0.40342e+03_r8,0.31788e+03_r8,0.17802e+03_r8,0.35000e+02_r8 /) + kao(:, 4,11, 1) = (/ & + & 0.27937e+02_r8,0.16392e+03_r8,0.29960e+03_r8,0.40994e+03_r8,0.43395e+03_r8, & + & 0.40124e+03_r8,0.31570e+03_r8,0.17679e+03_r8,0.35000e+02_r8 /) + kao(:, 5,11, 1) = (/ & + & 0.27730e+02_r8,0.16369e+03_r8,0.29936e+03_r8,0.40905e+03_r8,0.43224e+03_r8, & + & 0.39931e+03_r8,0.31377e+03_r8,0.17571e+03_r8,0.35000e+02_r8 /) + kao(:, 1,12, 1) = (/ & + & 0.27995e+02_r8,0.16391e+03_r8,0.29951e+03_r8,0.40970e+03_r8,0.43443e+03_r8, & + & 0.40178e+03_r8,0.31624e+03_r8,0.17709e+03_r8,0.35000e+02_r8 /) + kao(:, 2,12, 1) = (/ & + & 0.27737e+02_r8,0.16374e+03_r8,0.29943e+03_r8,0.40869e+03_r8,0.43230e+03_r8, & + & 0.39938e+03_r8,0.31384e+03_r8,0.17574e+03_r8,0.35000e+02_r8 /) + kao(:, 3,12, 1) = (/ & + & 0.27515e+02_r8,0.16356e+03_r8,0.29930e+03_r8,0.40779e+03_r8,0.43046e+03_r8, & + & 0.39730e+03_r8,0.31176e+03_r8,0.17458e+03_r8,0.35000e+02_r8 /) + kao(:, 4,12, 1) = (/ & + & 0.27322e+02_r8,0.16338e+03_r8,0.29913e+03_r8,0.40697e+03_r8,0.42883e+03_r8, & + & 0.39548e+03_r8,0.30994e+03_r8,0.17357e+03_r8,0.35000e+02_r8 /) + kao(:, 5,12, 1) = (/ & + & 0.27152e+02_r8,0.16318e+03_r8,0.29892e+03_r8,0.40622e+03_r8,0.42740e+03_r8, & + & 0.39387e+03_r8,0.30834e+03_r8,0.17268e+03_r8,0.35000e+02_r8 /) + kao(:, 1,13, 1) = (/ & + & 0.27369e+02_r8,0.16336e+03_r8,0.29903e+03_r8,0.40671e+03_r8,0.42924e+03_r8, & + & 0.39593e+03_r8,0.31039e+03_r8,0.17382e+03_r8,0.35000e+02_r8 /) + kao(:, 2,13, 1) = (/ & + & 0.27158e+02_r8,0.16323e+03_r8,0.29898e+03_r8,0.40587e+03_r8,0.42745e+03_r8, & + & 0.39393e+03_r8,0.30840e+03_r8,0.17271e+03_r8,0.35000e+02_r8 /) + kao(:, 3,13, 1) = (/ & + & 0.26976e+02_r8,0.16309e+03_r8,0.29889e+03_r8,0.40513e+03_r8,0.42590e+03_r8, & + & 0.39221e+03_r8,0.30667e+03_r8,0.17176e+03_r8,0.35000e+02_r8 /) + kao(:, 4,13, 1) = (/ & + & 0.26818e+02_r8,0.16293e+03_r8,0.29875e+03_r8,0.40445e+03_r8,0.42455e+03_r8, & + & 0.39070e+03_r8,0.30516e+03_r8,0.17093e+03_r8,0.35000e+02_r8 /) + kao(:, 5,13, 1) = (/ & + & 0.26679e+02_r8,0.16276e+03_r8,0.29855e+03_r8,0.40381e+03_r8,0.42335e+03_r8, & + & 0.38937e+03_r8,0.30384e+03_r8,0.17021e+03_r8,0.35000e+02_r8 /) + kao(:, 1, 1, 2) = (/ & + & 0.17271e+03_r8,0.27646e+03_r8,0.38039e+03_r8,0.48420e+03_r8,0.56932e+03_r8, & + & 0.57534e+03_r8,0.47873e+03_r8,0.28147e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 1, 2) = (/ & + & 0.16834e+03_r8,0.27246e+03_r8,0.37678e+03_r8,0.48091e+03_r8,0.56471e+03_r8, & + & 0.56734e+03_r8,0.47005e+03_r8,0.27593e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 1, 2) = (/ & + & 0.16441e+03_r8,0.26883e+03_r8,0.37341e+03_r8,0.47777e+03_r8,0.56037e+03_r8, & + & 0.56003e+03_r8,0.46210e+03_r8,0.27096e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 1, 2) = (/ & + & 0.16086e+03_r8,0.26548e+03_r8,0.37025e+03_r8,0.47479e+03_r8,0.55629e+03_r8, & + & 0.55327e+03_r8,0.45481e+03_r8,0.26647e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 1, 2) = (/ & + & 0.15764e+03_r8,0.26237e+03_r8,0.36725e+03_r8,0.47195e+03_r8,0.55235e+03_r8, & + & 0.54701e+03_r8,0.44810e+03_r8,0.26239e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 2, 2) = (/ & + & 0.15955e+03_r8,0.26500e+03_r8,0.37067e+03_r8,0.47595e+03_r8,0.55480e+03_r8, & + & 0.55074e+03_r8,0.45210e+03_r8,0.26482e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 2, 2) = (/ & + & 0.15580e+03_r8,0.26157e+03_r8,0.36756e+03_r8,0.47303e+03_r8,0.55028e+03_r8, & + & 0.54339e+03_r8,0.44423e+03_r8,0.26007e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 2, 2) = (/ & + & 0.15244e+03_r8,0.25844e+03_r8,0.36465e+03_r8,0.47023e+03_r8,0.54619e+03_r8, & + & 0.53664e+03_r8,0.43708e+03_r8,0.25581e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 2, 2) = (/ & + & 0.14941e+03_r8,0.25556e+03_r8,0.36191e+03_r8,0.46753e+03_r8,0.54253e+03_r8, & + & 0.53041e+03_r8,0.43052e+03_r8,0.25198e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 2, 2) = (/ & + & 0.14667e+03_r8,0.25289e+03_r8,0.35930e+03_r8,0.46494e+03_r8,0.53908e+03_r8, & + & 0.52470e+03_r8,0.42448e+03_r8,0.24851e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 3, 2) = (/ & + & 0.14921e+03_r8,0.25601e+03_r8,0.36308e+03_r8,0.46872e+03_r8,0.54234e+03_r8, & + & 0.52999e+03_r8,0.43007e+03_r8,0.25172e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 3, 2) = (/ & + & 0.14591e+03_r8,0.25301e+03_r8,0.36036e+03_r8,0.46599e+03_r8,0.53834e+03_r8, & + & 0.52313e+03_r8,0.42280e+03_r8,0.24755e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 3, 2) = (/ & + & 0.14297e+03_r8,0.25028e+03_r8,0.35782e+03_r8,0.46350e+03_r8,0.53459e+03_r8, & + & 0.51696e+03_r8,0.41619e+03_r8,0.24383e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 3, 2) = (/ & + & 0.14033e+03_r8,0.24777e+03_r8,0.35542e+03_r8,0.46116e+03_r8,0.53100e+03_r8, & + & 0.51122e+03_r8,0.41016e+03_r8,0.24049e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 3, 2) = (/ & + & 0.13795e+03_r8,0.24544e+03_r8,0.35313e+03_r8,0.45882e+03_r8,0.52751e+03_r8, & + & 0.50591e+03_r8,0.40463e+03_r8,0.23747e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 4, 2) = (/ & + & 0.14062e+03_r8,0.24856e+03_r8,0.35678e+03_r8,0.46260e+03_r8,0.53137e+03_r8, & + & 0.51186e+03_r8,0.41082e+03_r8,0.24086e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 4, 2) = (/ & + & 0.13771e+03_r8,0.24592e+03_r8,0.35440e+03_r8,0.46020e+03_r8,0.52732e+03_r8, & + & 0.50537e+03_r8,0.40407e+03_r8,0.23717e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 4, 2) = (/ & + & 0.13512e+03_r8,0.24353e+03_r8,0.35219e+03_r8,0.45796e+03_r8,0.52348e+03_r8, & + & 0.49954e+03_r8,0.39798e+03_r8,0.23389e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 4, 2) = (/ & + & 0.13281e+03_r8,0.24133e+03_r8,0.35008e+03_r8,0.45583e+03_r8,0.51985e+03_r8, & + & 0.49431e+03_r8,0.39246e+03_r8,0.23096e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 4, 2) = (/ & + & 0.13073e+03_r8,0.23928e+03_r8,0.34807e+03_r8,0.45378e+03_r8,0.51643e+03_r8, & + & 0.48957e+03_r8,0.38745e+03_r8,0.22833e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 5, 2) = (/ & + & 0.13333e+03_r8,0.24222e+03_r8,0.35141e+03_r8,0.45702e+03_r8,0.52057e+03_r8, & + & 0.49550e+03_r8,0.39372e+03_r8,0.23163e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 5, 2) = (/ & + & 0.13075e+03_r8,0.23990e+03_r8,0.34934e+03_r8,0.45476e+03_r8,0.51651e+03_r8, & + & 0.48963e+03_r8,0.38752e+03_r8,0.22836e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 5, 2) = (/ & + & 0.12847e+03_r8,0.23780e+03_r8,0.34741e+03_r8,0.45266e+03_r8,0.51271e+03_r8, & + & 0.48438e+03_r8,0.38196e+03_r8,0.22548e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 5, 2) = (/ & + & 0.12644e+03_r8,0.23588e+03_r8,0.34557e+03_r8,0.45066e+03_r8,0.50911e+03_r8, & + & 0.47962e+03_r8,0.37696e+03_r8,0.22291e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 5, 2) = (/ & + & 0.12462e+03_r8,0.23409e+03_r8,0.34381e+03_r8,0.44874e+03_r8,0.50570e+03_r8, & + & 0.47526e+03_r8,0.37245e+03_r8,0.22060e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 6, 2) = (/ & + & 0.12722e+03_r8,0.23690e+03_r8,0.34688e+03_r8,0.45177e+03_r8,0.51032e+03_r8, & + & 0.48144e+03_r8,0.37887e+03_r8,0.22389e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 6, 2) = (/ & + & 0.12492e+03_r8,0.23485e+03_r8,0.34508e+03_r8,0.44967e+03_r8,0.50620e+03_r8, & + & 0.47598e+03_r8,0.37319e+03_r8,0.22098e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 6, 2) = (/ & + & 0.12290e+03_r8,0.23301e+03_r8,0.34340e+03_r8,0.44769e+03_r8,0.50242e+03_r8, & + & 0.47108e+03_r8,0.36815e+03_r8,0.21843e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 6, 2) = (/ & + & 0.12111e+03_r8,0.23132e+03_r8,0.34180e+03_r8,0.44582e+03_r8,0.49894e+03_r8, & + & 0.46668e+03_r8,0.36363e+03_r8,0.21616e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 6, 2) = (/ & + & 0.11952e+03_r8,0.22976e+03_r8,0.34026e+03_r8,0.44407e+03_r8,0.49574e+03_r8, & + & 0.46270e+03_r8,0.35956e+03_r8,0.21414e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 7, 2) = (/ & + & 0.12201e+03_r8,0.23235e+03_r8,0.34300e+03_r8,0.44700e+03_r8,0.50054e+03_r8, & + & 0.46889e+03_r8,0.36590e+03_r8,0.21730e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 7, 2) = (/ & + & 0.11997e+03_r8,0.23055e+03_r8,0.34145e+03_r8,0.44492e+03_r8,0.49657e+03_r8, & + & 0.46383e+03_r8,0.36071e+03_r8,0.21471e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 7, 2) = (/ & + & 0.11818e+03_r8,0.22894e+03_r8,0.33999e+03_r8,0.44309e+03_r8,0.49292e+03_r8, & + & 0.45934e+03_r8,0.35613e+03_r8,0.21245e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 7, 2) = (/ & + & 0.11660e+03_r8,0.22746e+03_r8,0.33859e+03_r8,0.44146e+03_r8,0.48959e+03_r8, & + & 0.45533e+03_r8,0.35208e+03_r8,0.21045e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 7, 2) = (/ & + & 0.11520e+03_r8,0.22609e+03_r8,0.33724e+03_r8,0.43996e+03_r8,0.48657e+03_r8, & + & 0.45175e+03_r8,0.34847e+03_r8,0.20867e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 8, 2) = (/ & + & 0.11756e+03_r8,0.22844e+03_r8,0.33965e+03_r8,0.44261e+03_r8,0.49147e+03_r8, & + & 0.45776e+03_r8,0.35454e+03_r8,0.21166e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 8, 2) = (/ & + & 0.11574e+03_r8,0.22687e+03_r8,0.33830e+03_r8,0.44082e+03_r8,0.48767e+03_r8, & + & 0.45313e+03_r8,0.34986e+03_r8,0.20936e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 8, 2) = (/ & + & 0.11415e+03_r8,0.22546e+03_r8,0.33704e+03_r8,0.43915e+03_r8,0.48429e+03_r8, & + & 0.44908e+03_r8,0.34579e+03_r8,0.20735e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 8, 2) = (/ & + & 0.11276e+03_r8,0.22417e+03_r8,0.33584e+03_r8,0.43758e+03_r8,0.48126e+03_r8, & + & 0.44549e+03_r8,0.34220e+03_r8,0.20559e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 8, 2) = (/ & + & 0.11153e+03_r8,0.22298e+03_r8,0.33466e+03_r8,0.43617e+03_r8,0.47855e+03_r8, & + & 0.44228e+03_r8,0.33902e+03_r8,0.20403e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 9, 2) = (/ & + & 0.11376e+03_r8,0.22510e+03_r8,0.33674e+03_r8,0.43882e+03_r8,0.48336e+03_r8, & + & 0.44807e+03_r8,0.34479e+03_r8,0.20686e+03_r8,0.71840e+02_r8 /) + kao(:, 2, 9, 2) = (/ & + & 0.11214e+03_r8,0.22372e+03_r8,0.33559e+03_r8,0.43706e+03_r8,0.47989e+03_r8, & + & 0.44388e+03_r8,0.34060e+03_r8,0.20480e+03_r8,0.71840e+02_r8 /) + kao(:, 3, 9, 2) = (/ & + & 0.11074e+03_r8,0.22250e+03_r8,0.33451e+03_r8,0.43547e+03_r8,0.47679e+03_r8, & + & 0.44020e+03_r8,0.33697e+03_r8,0.20303e+03_r8,0.71840e+02_r8 /) + kao(:, 4, 9, 2) = (/ & + & 0.10951e+03_r8,0.22138e+03_r8,0.33348e+03_r8,0.43404e+03_r8,0.47404e+03_r8, & + & 0.43694e+03_r8,0.33379e+03_r8,0.20147e+03_r8,0.71840e+02_r8 /) + kao(:, 5, 9, 2) = (/ & + & 0.10843e+03_r8,0.22034e+03_r8,0.33246e+03_r8,0.43277e+03_r8,0.47159e+03_r8, & + & 0.43405e+03_r8,0.33096e+03_r8,0.20010e+03_r8,0.71840e+02_r8 /) + kao(:, 1,10, 2) = (/ & + & 0.11041e+03_r8,0.22214e+03_r8,0.33414e+03_r8,0.43517e+03_r8,0.47604e+03_r8, & + & 0.43932e+03_r8,0.33611e+03_r8,0.20261e+03_r8,0.71840e+02_r8 /) + kao(:, 2,10, 2) = (/ & + & 0.10898e+03_r8,0.22095e+03_r8,0.33317e+03_r8,0.43358e+03_r8,0.47283e+03_r8, & + & 0.43552e+03_r8,0.33239e+03_r8,0.20080e+03_r8,0.71840e+02_r8 /) + kao(:, 3,10, 2) = (/ & + & 0.10774e+03_r8,0.21989e+03_r8,0.33226e+03_r8,0.43213e+03_r8,0.47002e+03_r8, & + & 0.43222e+03_r8,0.32917e+03_r8,0.19924e+03_r8,0.71840e+02_r8 /) + kao(:, 4,10, 2) = (/ & + & 0.10667e+03_r8,0.21893e+03_r8,0.33139e+03_r8,0.43083e+03_r8,0.46753e+03_r8, & + & 0.42932e+03_r8,0.32634e+03_r8,0.19788e+03_r8,0.71840e+02_r8 /) + kao(:, 5,10, 2) = (/ & + & 0.10573e+03_r8,0.21803e+03_r8,0.33053e+03_r8,0.42965e+03_r8,0.46532e+03_r8, & + & 0.42677e+03_r8,0.32386e+03_r8,0.19669e+03_r8,0.71840e+02_r8 /) + kao(:, 1,11, 2) = (/ & + & 0.10694e+03_r8,0.21911e+03_r8,0.33152e+03_r8,0.43127e+03_r8,0.46816e+03_r8, & + & 0.43005e+03_r8,0.32706e+03_r8,0.19822e+03_r8,0.71840e+02_r8 /) + kao(:, 2,11, 2) = (/ & + & 0.10577e+03_r8,0.21815e+03_r8,0.33074e+03_r8,0.42984e+03_r8,0.46541e+03_r8, & + & 0.42687e+03_r8,0.32396e+03_r8,0.19674e+03_r8,0.71840e+02_r8 /) + kao(:, 3,11, 2) = (/ & + & 0.10476e+03_r8,0.21728e+03_r8,0.33000e+03_r8,0.42855e+03_r8,0.46301e+03_r8, & + & 0.42411e+03_r8,0.32130e+03_r8,0.19546e+03_r8,0.71840e+02_r8 /) + kao(:, 4,11, 2) = (/ & + & 0.10388e+03_r8,0.21649e+03_r8,0.32928e+03_r8,0.42741e+03_r8,0.46089e+03_r8, & + & 0.42169e+03_r8,0.31897e+03_r8,0.19435e+03_r8,0.71840e+02_r8 /) + kao(:, 5,11, 2) = (/ & + & 0.10311e+03_r8,0.21575e+03_r8,0.32855e+03_r8,0.42639e+03_r8,0.45902e+03_r8, & + & 0.41954e+03_r8,0.31692e+03_r8,0.19338e+03_r8,0.71840e+02_r8 /) + kao(:, 1,12, 2) = (/ & + & 0.10410e+03_r8,0.21663e+03_r8,0.32937e+03_r8,0.42778e+03_r8,0.46141e+03_r8, & + & 0.42229e+03_r8,0.31955e+03_r8,0.19463e+03_r8,0.71840e+02_r8 /) + kao(:, 2,12, 2) = (/ & + & 0.10314e+03_r8,0.21585e+03_r8,0.32875e+03_r8,0.42654e+03_r8,0.45909e+03_r8, & + & 0.41961e+03_r8,0.31700e+03_r8,0.19341e+03_r8,0.71840e+02_r8 /) + kao(:, 3,12, 2) = (/ & + & 0.10231e+03_r8,0.21515e+03_r8,0.32815e+03_r8,0.42544e+03_r8,0.45707e+03_r8, & + & 0.41729e+03_r8,0.31480e+03_r8,0.19236e+03_r8,0.71840e+02_r8 /) + kao(:, 4,12, 2) = (/ & + & 0.10159e+03_r8,0.21449e+03_r8,0.32754e+03_r8,0.42445e+03_r8,0.45532e+03_r8, & + & 0.41526e+03_r8,0.31288e+03_r8,0.19145e+03_r8,0.71840e+02_r8 /) + kao(:, 5,12, 2) = (/ & + & 0.10096e+03_r8,0.21387e+03_r8,0.32692e+03_r8,0.42356e+03_r8,0.45377e+03_r8, & + & 0.41347e+03_r8,0.31119e+03_r8,0.19066e+03_r8,0.71840e+02_r8 /) + kao(:, 1,13, 2) = (/ & + & 0.10177e+03_r8,0.21460e+03_r8,0.32761e+03_r8,0.42475e+03_r8,0.45575e+03_r8, & + & 0.41576e+03_r8,0.31335e+03_r8,0.19168e+03_r8,0.71840e+02_r8 /) + kao(:, 2,13, 2) = (/ & + & 0.10099e+03_r8,0.21397e+03_r8,0.32712e+03_r8,0.42368e+03_r8,0.45383e+03_r8, & + & 0.41353e+03_r8,0.31125e+03_r8,0.19068e+03_r8,0.71840e+02_r8 /) + kao(:, 3,13, 2) = (/ & + & 0.10031e+03_r8,0.21340e+03_r8,0.32663e+03_r8,0.42272e+03_r8,0.45216e+03_r8, & + & 0.41160e+03_r8,0.30943e+03_r8,0.18983e+03_r8,0.71840e+02_r8 /) + kao(:, 4,13, 2) = (/ & + & 0.99720e+02_r8,0.21286e+03_r8,0.32612e+03_r8,0.42187e+03_r8,0.45071e+03_r8, & + & 0.40991e+03_r8,0.30785e+03_r8,0.18908e+03_r8,0.71840e+02_r8 /) + kao(:, 5,13, 2) = (/ & + & 0.99204e+02_r8,0.21233e+03_r8,0.32558e+03_r8,0.42112e+03_r8,0.44942e+03_r8, & + & 0.40842e+03_r8,0.30646e+03_r8,0.18843e+03_r8,0.71840e+02_r8 /) + kao(:, 1, 1, 3) = (/ & + & 0.44909e+03_r8,0.47445e+03_r8,0.49981e+03_r8,0.52556e+03_r8,0.59352e+03_r8, & + & 0.63011e+03_r8,0.50440e+03_r8,0.31793e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 1, 3) = (/ & + & 0.43771e+03_r8,0.46449e+03_r8,0.49128e+03_r8,0.51852e+03_r8,0.58982e+03_r8, & + & 0.62155e+03_r8,0.49364e+03_r8,0.31383e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 1, 3) = (/ & + & 0.42749e+03_r8,0.45555e+03_r8,0.48362e+03_r8,0.51220e+03_r8,0.58623e+03_r8, & + & 0.61324e+03_r8,0.48379e+03_r8,0.31014e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 1, 3) = (/ & + & 0.41826e+03_r8,0.44748e+03_r8,0.47670e+03_r8,0.50650e+03_r8,0.58281e+03_r8, & + & 0.60555e+03_r8,0.47483e+03_r8,0.30681e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 1, 3) = (/ & + & 0.40989e+03_r8,0.44015e+03_r8,0.47042e+03_r8,0.50132e+03_r8,0.57944e+03_r8, & + & 0.59846e+03_r8,0.46657e+03_r8,0.30379e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 2, 3) = (/ & + & 0.41487e+03_r8,0.44451e+03_r8,0.47415e+03_r8,0.50447e+03_r8,0.58410e+03_r8, & + & 0.60269e+03_r8,0.47150e+03_r8,0.30559e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 2, 3) = (/ & + & 0.40511e+03_r8,0.43597e+03_r8,0.46683e+03_r8,0.49854e+03_r8,0.58056e+03_r8, & + & 0.59434e+03_r8,0.46181e+03_r8,0.30207e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 2, 3) = (/ & + & 0.39637e+03_r8,0.42832e+03_r8,0.46028e+03_r8,0.49326e+03_r8,0.57701e+03_r8, & + & 0.58648e+03_r8,0.45298e+03_r8,0.29892e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 2, 3) = (/ & + & 0.38850e+03_r8,0.42143e+03_r8,0.45437e+03_r8,0.48855e+03_r8,0.57350e+03_r8, & + & 0.57914e+03_r8,0.44500e+03_r8,0.29608e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 2, 3) = (/ & + & 0.38136e+03_r8,0.41519e+03_r8,0.44902e+03_r8,0.48433e+03_r8,0.57004e+03_r8, & + & 0.57245e+03_r8,0.43774e+03_r8,0.29351e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 3, 3) = (/ & + & 0.38797e+03_r8,0.42097e+03_r8,0.45397e+03_r8,0.48897e+03_r8,0.57508e+03_r8, & + & 0.57865e+03_r8,0.44446e+03_r8,0.29589e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 3, 3) = (/ & + & 0.37940e+03_r8,0.41348e+03_r8,0.44755e+03_r8,0.48416e+03_r8,0.57138e+03_r8, & + & 0.57059e+03_r8,0.43573e+03_r8,0.29280e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 3, 3) = (/ & + & 0.37176e+03_r8,0.40679e+03_r8,0.44182e+03_r8,0.47985e+03_r8,0.56781e+03_r8, & + & 0.56324e+03_r8,0.42791e+03_r8,0.29005e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 3, 3) = (/ & + & 0.36490e+03_r8,0.40078e+03_r8,0.43667e+03_r8,0.47599e+03_r8,0.56436e+03_r8, & + & 0.55656e+03_r8,0.42088e+03_r8,0.28757e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 3, 3) = (/ & + & 0.35870e+03_r8,0.39536e+03_r8,0.43202e+03_r8,0.47253e+03_r8,0.56109e+03_r8, & + & 0.55041e+03_r8,0.41448e+03_r8,0.28534e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 4, 3) = (/ & + & 0.36565e+03_r8,0.40144e+03_r8,0.43723e+03_r8,0.47759e+03_r8,0.56581e+03_r8, & + & 0.55729e+03_r8,0.42164e+03_r8,0.28784e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 4, 3) = (/ & + & 0.35808e+03_r8,0.39482e+03_r8,0.43155e+03_r8,0.47386e+03_r8,0.56215e+03_r8, & + & 0.54978e+03_r8,0.41381e+03_r8,0.28511e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 4, 3) = (/ & + & 0.35135e+03_r8,0.38893e+03_r8,0.42651e+03_r8,0.47052e+03_r8,0.55875e+03_r8, & + & 0.54295e+03_r8,0.40683e+03_r8,0.28269e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 4, 3) = (/ & + & 0.34533e+03_r8,0.38366e+03_r8,0.42199e+03_r8,0.46746e+03_r8,0.55555e+03_r8, & + & 0.53669e+03_r8,0.40055e+03_r8,0.28052e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 4, 3) = (/ & + & 0.33991e+03_r8,0.37892e+03_r8,0.41793e+03_r8,0.46467e+03_r8,0.55244e+03_r8, & + & 0.53093e+03_r8,0.39488e+03_r8,0.27856e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 5, 3) = (/ & + & 0.34669e+03_r8,0.38485e+03_r8,0.42301e+03_r8,0.46943e+03_r8,0.55667e+03_r8, & + & 0.53812e+03_r8,0.40197e+03_r8,0.28101e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 5, 3) = (/ & + & 0.33999e+03_r8,0.37899e+03_r8,0.41799e+03_r8,0.46662e+03_r8,0.55311e+03_r8, & + & 0.53101e+03_r8,0.39496e+03_r8,0.27859e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 5, 3) = (/ & + & 0.33406e+03_r8,0.37380e+03_r8,0.41354e+03_r8,0.46416e+03_r8,0.54976e+03_r8, & + & 0.52459e+03_r8,0.38873e+03_r8,0.27645e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 5, 3) = (/ & + & 0.32878e+03_r8,0.36918e+03_r8,0.40958e+03_r8,0.46185e+03_r8,0.54671e+03_r8, & + & 0.51881e+03_r8,0.38326e+03_r8,0.27455e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 5, 3) = (/ & + & 0.32404e+03_r8,0.36503e+03_r8,0.40603e+03_r8,0.45969e+03_r8,0.54395e+03_r8, & + & 0.51356e+03_r8,0.37844e+03_r8,0.27284e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 6, 3) = (/ & + & 0.33079e+03_r8,0.37094e+03_r8,0.41109e+03_r8,0.46395e+03_r8,0.54790e+03_r8, & + & 0.52101e+03_r8,0.38534e+03_r8,0.27527e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 6, 3) = (/ & + & 0.32482e+03_r8,0.36572e+03_r8,0.40662e+03_r8,0.46188e+03_r8,0.54448e+03_r8, & + & 0.51443e+03_r8,0.37923e+03_r8,0.27312e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 6, 3) = (/ & + & 0.31958e+03_r8,0.36113e+03_r8,0.40268e+03_r8,0.45998e+03_r8,0.54143e+03_r8, & + & 0.50857e+03_r8,0.37397e+03_r8,0.27123e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 6, 3) = (/ & + & 0.31492e+03_r8,0.35705e+03_r8,0.39919e+03_r8,0.45816e+03_r8,0.53866e+03_r8, & + & 0.50335e+03_r8,0.36939e+03_r8,0.26955e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 6, 3) = (/ & + & 0.31076e+03_r8,0.35342e+03_r8,0.39607e+03_r8,0.45638e+03_r8,0.53611e+03_r8, & + & 0.49868e+03_r8,0.36537e+03_r8,0.26805e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 7, 3) = (/ & + & 0.31725e+03_r8,0.35910e+03_r8,0.40094e+03_r8,0.45992e+03_r8,0.53978e+03_r8, & + & 0.50597e+03_r8,0.37168e+03_r8,0.27039e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 7, 3) = (/ & + & 0.31194e+03_r8,0.35445e+03_r8,0.39695e+03_r8,0.45835e+03_r8,0.53664e+03_r8, & + & 0.50000e+03_r8,0.36650e+03_r8,0.26848e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 7, 3) = (/ & + & 0.30729e+03_r8,0.35038e+03_r8,0.39347e+03_r8,0.45686e+03_r8,0.53383e+03_r8, & + & 0.49465e+03_r8,0.36205e+03_r8,0.26680e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 7, 3) = (/ & + & 0.30318e+03_r8,0.34679e+03_r8,0.39040e+03_r8,0.45536e+03_r8,0.53125e+03_r8, & + & 0.48979e+03_r8,0.35818e+03_r8,0.26532e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 7, 3) = (/ & + & 0.29953e+03_r8,0.34359e+03_r8,0.38767e+03_r8,0.45383e+03_r8,0.52882e+03_r8, & + & 0.48543e+03_r8,0.35479e+03_r8,0.26401e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 8, 3) = (/ & + & 0.30567e+03_r8,0.34896e+03_r8,0.39226e+03_r8,0.45673e+03_r8,0.53243e+03_r8, & + & 0.49274e+03_r8,0.36052e+03_r8,0.26622e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 8, 3) = (/ & + & 0.30094e+03_r8,0.34482e+03_r8,0.38872e+03_r8,0.45541e+03_r8,0.52945e+03_r8, & + & 0.48711e+03_r8,0.35609e+03_r8,0.26451e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 8, 3) = (/ & + & 0.29682e+03_r8,0.34122e+03_r8,0.38564e+03_r8,0.45413e+03_r8,0.52674e+03_r8, & + & 0.48217e+03_r8,0.35231e+03_r8,0.26303e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 8, 3) = (/ & + & 0.29320e+03_r8,0.33805e+03_r8,0.38294e+03_r8,0.45285e+03_r8,0.52426e+03_r8, & + & 0.47779e+03_r8,0.34904e+03_r8,0.26172e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 8, 3) = (/ & + & 0.29000e+03_r8,0.33525e+03_r8,0.38055e+03_r8,0.45152e+03_r8,0.52191e+03_r8, & + & 0.47388e+03_r8,0.34618e+03_r8,0.26057e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 9, 3) = (/ & + & 0.29581e+03_r8,0.34033e+03_r8,0.38489e+03_r8,0.45387e+03_r8,0.52555e+03_r8, & + & 0.48095e+03_r8,0.35139e+03_r8,0.26266e+03_r8,0.17829e+03_r8 /) + kao(:, 2, 9, 3) = (/ & + & 0.29159e+03_r8,0.33664e+03_r8,0.38173e+03_r8,0.45277e+03_r8,0.52268e+03_r8, & + & 0.47582e+03_r8,0.34759e+03_r8,0.26114e+03_r8,0.17829e+03_r8 /) + kao(:, 3, 9, 3) = (/ & + & 0.28794e+03_r8,0.33344e+03_r8,0.37901e+03_r8,0.45167e+03_r8,0.52008e+03_r8, & + & 0.47135e+03_r8,0.34436e+03_r8,0.25982e+03_r8,0.17829e+03_r8 /) + kao(:, 4, 9, 3) = (/ & + & 0.28475e+03_r8,0.33065e+03_r8,0.37663e+03_r8,0.45055e+03_r8,0.51765e+03_r8, & + & 0.46738e+03_r8,0.34157e+03_r8,0.25867e+03_r8,0.17829e+03_r8 /) + kao(:, 5, 9, 3) = (/ & + & 0.28193e+03_r8,0.32819e+03_r8,0.37453e+03_r8,0.44937e+03_r8,0.51538e+03_r8, & + & 0.46382e+03_r8,0.33916e+03_r8,0.25766e+03_r8,0.17829e+03_r8 /) + kao(:, 1,10, 3) = (/ & + & 0.28708e+03_r8,0.33269e+03_r8,0.37836e+03_r8,0.45121e+03_r8,0.51885e+03_r8, & + & 0.47029e+03_r8,0.34361e+03_r8,0.25951e+03_r8,0.17829e+03_r8 /) + kao(:, 2,10, 3) = (/ & + & 0.28336e+03_r8,0.32944e+03_r8,0.37559e+03_r8,0.45027e+03_r8,0.51611e+03_r8, & + & 0.46563e+03_r8,0.34037e+03_r8,0.25817e+03_r8,0.17829e+03_r8 /) + kao(:, 3,10, 3) = (/ & + & 0.28016e+03_r8,0.32664e+03_r8,0.37320e+03_r8,0.44932e+03_r8,0.51361e+03_r8, & + & 0.46153e+03_r8,0.33765e+03_r8,0.25702e+03_r8,0.17829e+03_r8 /) + kao(:, 4,10, 3) = (/ & + & 0.27737e+03_r8,0.32420e+03_r8,0.37112e+03_r8,0.44835e+03_r8,0.51133e+03_r8, & + & 0.45793e+03_r8,0.33532e+03_r8,0.25601e+03_r8,0.17829e+03_r8 /) + kao(:, 5,10, 3) = (/ & + & 0.27492e+03_r8,0.32206e+03_r8,0.36930e+03_r8,0.44735e+03_r8,0.50922e+03_r8, & + & 0.45473e+03_r8,0.33330e+03_r8,0.25513e+03_r8,0.17829e+03_r8 /) + kao(:, 1,11, 3) = (/ & + & 0.27807e+03_r8,0.32481e+03_r8,0.37164e+03_r8,0.44842e+03_r8,0.51141e+03_r8, & + & 0.45884e+03_r8,0.33590e+03_r8,0.25627e+03_r8,0.17829e+03_r8 /) + kao(:, 2,11, 3) = (/ & + & 0.27502e+03_r8,0.32214e+03_r8,0.36937e+03_r8,0.44764e+03_r8,0.50894e+03_r8, & + & 0.45486e+03_r8,0.33338e+03_r8,0.25517e+03_r8,0.17829e+03_r8 /) + kao(:, 3,11, 3) = (/ & + & 0.27240e+03_r8,0.31985e+03_r8,0.36742e+03_r8,0.44685e+03_r8,0.50671e+03_r8, & + & 0.45139e+03_r8,0.33123e+03_r8,0.25422e+03_r8,0.17829e+03_r8 /) + kao(:, 4,11, 3) = (/ & + & 0.27012e+03_r8,0.31785e+03_r8,0.36572e+03_r8,0.44602e+03_r8,0.50464e+03_r8, & + & 0.44836e+03_r8,0.32939e+03_r8,0.25340e+03_r8,0.17829e+03_r8 /) + kao(:, 5,11, 3) = (/ & + & 0.26811e+03_r8,0.31610e+03_r8,0.36422e+03_r8,0.44514e+03_r8,0.50273e+03_r8, & + & 0.44569e+03_r8,0.32779e+03_r8,0.25268e+03_r8,0.17829e+03_r8 /) + kao(:, 1,12, 3) = (/ & + & 0.27068e+03_r8,0.31834e+03_r8,0.36613e+03_r8,0.44605e+03_r8,0.50476e+03_r8, & + & 0.44911e+03_r8,0.32983e+03_r8,0.25360e+03_r8,0.17829e+03_r8 /) + kao(:, 2,12, 3) = (/ & + & 0.26818e+03_r8,0.31616e+03_r8,0.36428e+03_r8,0.44539e+03_r8,0.50255e+03_r8, & + & 0.44579e+03_r8,0.32784e+03_r8,0.25270e+03_r8,0.17829e+03_r8 /) + kao(:, 3,12, 3) = (/ & + & 0.26603e+03_r8,0.31428e+03_r8,0.36268e+03_r8,0.44471e+03_r8,0.50054e+03_r8, & + & 0.44293e+03_r8,0.32614e+03_r8,0.25193e+03_r8,0.17829e+03_r8 /) + kao(:, 4,12, 3) = (/ & + & 0.26417e+03_r8,0.31264e+03_r8,0.36129e+03_r8,0.44399e+03_r8,0.49874e+03_r8, & + & 0.44043e+03_r8,0.32468e+03_r8,0.25125e+03_r8,0.17829e+03_r8 /) + kao(:, 5,12, 3) = (/ & + & 0.26252e+03_r8,0.31121e+03_r8,0.36005e+03_r8,0.44322e+03_r8,0.49710e+03_r8, & + & 0.43824e+03_r8,0.32341e+03_r8,0.25066e+03_r8,0.17829e+03_r8 /) + kao(:, 1,13, 3) = (/ & + & 0.26463e+03_r8,0.31305e+03_r8,0.36163e+03_r8,0.44400e+03_r8,0.49889e+03_r8, & + & 0.44105e+03_r8,0.32504e+03_r8,0.25142e+03_r8,0.17829e+03_r8 /) + kao(:, 2,13, 3) = (/ & + & 0.26258e+03_r8,0.31126e+03_r8,0.36010e+03_r8,0.44348e+03_r8,0.49698e+03_r8, & + & 0.43831e+03_r8,0.32345e+03_r8,0.25068e+03_r8,0.17829e+03_r8 /) + kao(:, 3,13, 3) = (/ & + & 0.26082e+03_r8,0.30972e+03_r8,0.35880e+03_r8,0.44291e+03_r8,0.49519e+03_r8, & + & 0.43595e+03_r8,0.32210e+03_r8,0.25005e+03_r8,0.17829e+03_r8 /) + kao(:, 4,13, 3) = (/ & + & 0.25929e+03_r8,0.30838e+03_r8,0.35766e+03_r8,0.44229e+03_r8,0.49360e+03_r8, & + & 0.43388e+03_r8,0.32093e+03_r8,0.24950e+03_r8,0.17829e+03_r8 /) + kao(:, 5,13, 3) = (/ & + & 0.25795e+03_r8,0.30721e+03_r8,0.35666e+03_r8,0.44160e+03_r8,0.49217e+03_r8, & + & 0.43204e+03_r8,0.31991e+03_r8,0.24901e+03_r8,0.17829e+03_r8 /) + kao(:, 1, 1, 4) = (/ & + & 0.86913e+03_r8,0.80389e+03_r8,0.73864e+03_r8,0.67339e+03_r8,0.62239e+03_r8, & + & 0.67741e+03_r8,0.51596e+03_r8,0.43641e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 1, 4) = (/ & + & 0.84711e+03_r8,0.78462e+03_r8,0.72212e+03_r8,0.65963e+03_r8,0.61530e+03_r8, & + & 0.66963e+03_r8,0.50564e+03_r8,0.43387e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 1, 4) = (/ & + & 0.82734e+03_r8,0.76731e+03_r8,0.70729e+03_r8,0.64727e+03_r8,0.60932e+03_r8, & + & 0.66251e+03_r8,0.49688e+03_r8,0.43160e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 1, 4) = (/ & + & 0.80948e+03_r8,0.75169e+03_r8,0.69390e+03_r8,0.63611e+03_r8,0.60420e+03_r8, & + & 0.65531e+03_r8,0.48930e+03_r8,0.42954e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 1, 4) = (/ & + & 0.79327e+03_r8,0.73751e+03_r8,0.68174e+03_r8,0.62598e+03_r8,0.59980e+03_r8, & + & 0.64776e+03_r8,0.48275e+03_r8,0.42767e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 2, 4) = (/ & + & 0.80291e+03_r8,0.74594e+03_r8,0.68897e+03_r8,0.63200e+03_r8,0.60547e+03_r8, & + & 0.65273e+03_r8,0.48660e+03_r8,0.42878e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 2, 4) = (/ & + & 0.78403e+03_r8,0.72942e+03_r8,0.67481e+03_r8,0.62020e+03_r8,0.60133e+03_r8, & + & 0.64384e+03_r8,0.47915e+03_r8,0.42661e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 2, 4) = (/ & + & 0.76711e+03_r8,0.71462e+03_r8,0.66212e+03_r8,0.60962e+03_r8,0.59788e+03_r8, & + & 0.63506e+03_r8,0.47284e+03_r8,0.42466e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 2, 4) = (/ & + & 0.75187e+03_r8,0.70128e+03_r8,0.65069e+03_r8,0.60010e+03_r8,0.59472e+03_r8, & + & 0.62679e+03_r8,0.46742e+03_r8,0.42291e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 2, 4) = (/ & + & 0.73807e+03_r8,0.68920e+03_r8,0.64034e+03_r8,0.59147e+03_r8,0.59165e+03_r8, & + & 0.61864e+03_r8,0.46272e+03_r8,0.42132e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 3, 4) = (/ & + & 0.75084e+03_r8,0.70038e+03_r8,0.64992e+03_r8,0.59946e+03_r8,0.59732e+03_r8, & + & 0.62621e+03_r8,0.46707e+03_r8,0.42279e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 3, 4) = (/ & + & 0.73427e+03_r8,0.68588e+03_r8,0.63749e+03_r8,0.58910e+03_r8,0.59435e+03_r8, & + & 0.61627e+03_r8,0.46147e+03_r8,0.42088e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 3, 4) = (/ & + & 0.71948e+03_r8,0.67294e+03_r8,0.62640e+03_r8,0.57986e+03_r8,0.59145e+03_r8, & + & 0.60690e+03_r8,0.45675e+03_r8,0.41918e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 3, 4) = (/ & + & 0.70620e+03_r8,0.66132e+03_r8,0.61644e+03_r8,0.57156e+03_r8,0.58863e+03_r8, & + & 0.59842e+03_r8,0.45269e+03_r8,0.41765e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 3, 4) = (/ & + & 0.69421e+03_r8,0.65083e+03_r8,0.60744e+03_r8,0.56406e+03_r8,0.58580e+03_r8, & + & 0.59032e+03_r8,0.44923e+03_r8,0.41627e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 4, 4) = (/ & + & 0.70765e+03_r8,0.66259e+03_r8,0.61753e+03_r8,0.57246e+03_r8,0.59114e+03_r8, & + & 0.59936e+03_r8,0.45313e+03_r8,0.41781e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 4, 4) = (/ & + & 0.69300e+03_r8,0.64977e+03_r8,0.60654e+03_r8,0.56330e+03_r8,0.58834e+03_r8, & + & 0.58949e+03_r8,0.44892e+03_r8,0.41613e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 4, 4) = (/ & + & 0.67997e+03_r8,0.63837e+03_r8,0.59677e+03_r8,0.55516e+03_r8,0.58563e+03_r8, & + & 0.58057e+03_r8,0.44538e+03_r8,0.41463e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 4, 4) = (/ & + & 0.66833e+03_r8,0.62818e+03_r8,0.58803e+03_r8,0.54788e+03_r8,0.58292e+03_r8, & + & 0.57257e+03_r8,0.44238e+03_r8,0.41329e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 4, 4) = (/ & + & 0.65784e+03_r8,0.61901e+03_r8,0.58017e+03_r8,0.54133e+03_r8,0.58031e+03_r8, & + & 0.56522e+03_r8,0.43982e+03_r8,0.41208e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 5, 4) = (/ & + & 0.67096e+03_r8,0.63048e+03_r8,0.59001e+03_r8,0.54953e+03_r8,0.58521e+03_r8, & + & 0.57438e+03_r8,0.44304e+03_r8,0.41359e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 5, 4) = (/ & + & 0.65799e+03_r8,0.61913e+03_r8,0.58028e+03_r8,0.54142e+03_r8,0.58256e+03_r8, & + & 0.56532e+03_r8,0.43984e+03_r8,0.41210e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 5, 4) = (/ & + & 0.64651e+03_r8,0.60909e+03_r8,0.57167e+03_r8,0.53427e+03_r8,0.57997e+03_r8, & + & 0.55705e+03_r8,0.43718e+03_r8,0.41077e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 5, 4) = (/ & + & 0.63629e+03_r8,0.60015e+03_r8,0.56401e+03_r8,0.52793e+03_r8,0.57742e+03_r8, & + & 0.54959e+03_r8,0.43482e+03_r8,0.40960e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 5, 4) = (/ & + & 0.62713e+03_r8,0.59213e+03_r8,0.55713e+03_r8,0.52227e+03_r8,0.57480e+03_r8, & + & 0.54282e+03_r8,0.43271e+03_r8,0.40854e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 6, 4) = (/ & + & 0.64019e+03_r8,0.60356e+03_r8,0.56693e+03_r8,0.53034e+03_r8,0.57955e+03_r8, & + & 0.55244e+03_r8,0.43572e+03_r8,0.41005e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 6, 4) = (/ & + & 0.62864e+03_r8,0.59346e+03_r8,0.55827e+03_r8,0.52321e+03_r8,0.57700e+03_r8, & + & 0.54395e+03_r8,0.43306e+03_r8,0.40872e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 6, 4) = (/ & + & 0.61849e+03_r8,0.58457e+03_r8,0.55065e+03_r8,0.51703e+03_r8,0.57439e+03_r8, & + & 0.53634e+03_r8,0.43072e+03_r8,0.40755e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 6, 4) = (/ & + & 0.60948e+03_r8,0.57669e+03_r8,0.54390e+03_r8,0.51158e+03_r8,0.57170e+03_r8, & + & 0.52946e+03_r8,0.42865e+03_r8,0.40651e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 6, 4) = (/ & + & 0.60143e+03_r8,0.56965e+03_r8,0.53786e+03_r8,0.50675e+03_r8,0.56897e+03_r8, & + & 0.52321e+03_r8,0.42679e+03_r8,0.40558e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 7, 4) = (/ & + & 0.61399e+03_r8,0.58064e+03_r8,0.54728e+03_r8,0.51440e+03_r8,0.57380e+03_r8, & + & 0.53292e+03_r8,0.42969e+03_r8,0.40703e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 7, 4) = (/ & + & 0.60371e+03_r8,0.57164e+03_r8,0.53957e+03_r8,0.50828e+03_r8,0.57103e+03_r8, & + & 0.52498e+03_r8,0.42732e+03_r8,0.40585e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 7, 4) = (/ & + & 0.59471e+03_r8,0.56376e+03_r8,0.53282e+03_r8,0.50302e+03_r8,0.56836e+03_r8, & + & 0.51802e+03_r8,0.42525e+03_r8,0.40481e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 7, 4) = (/ & + & 0.58676e+03_r8,0.55681e+03_r8,0.52686e+03_r8,0.49842e+03_r8,0.56580e+03_r8, & + & 0.51197e+03_r8,0.42342e+03_r8,0.40389e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 7, 4) = (/ & + & 0.57970e+03_r8,0.55063e+03_r8,0.52156e+03_r8,0.49437e+03_r8,0.56333e+03_r8, & + & 0.50656e+03_r8,0.42179e+03_r8,0.40308e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 8, 4) = (/ & + & 0.59158e+03_r8,0.56102e+03_r8,0.53047e+03_r8,0.50136e+03_r8,0.56762e+03_r8, & + & 0.51564e+03_r8,0.42452e+03_r8,0.40445e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 8, 4) = (/ & + & 0.58242e+03_r8,0.55301e+03_r8,0.52360e+03_r8,0.49623e+03_r8,0.56499e+03_r8, & + & 0.50866e+03_r8,0.42242e+03_r8,0.40339e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 8, 4) = (/ & + & 0.57445e+03_r8,0.54604e+03_r8,0.51762e+03_r8,0.49188e+03_r8,0.56245e+03_r8, & + & 0.50238e+03_r8,0.42058e+03_r8,0.40248e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 8, 4) = (/ & + & 0.56745e+03_r8,0.53991e+03_r8,0.51237e+03_r8,0.48811e+03_r8,0.55998e+03_r8, & + & 0.49675e+03_r8,0.41897e+03_r8,0.40167e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 8, 4) = (/ & + & 0.56125e+03_r8,0.53448e+03_r8,0.50772e+03_r8,0.48477e+03_r8,0.55757e+03_r8, & + & 0.49178e+03_r8,0.41754e+03_r8,0.40096e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 9, 4) = (/ & + & 0.57249e+03_r8,0.54432e+03_r8,0.51615e+03_r8,0.49103e+03_r8,0.56159e+03_r8, & + & 0.50080e+03_r8,0.42013e+03_r8,0.40225e+03_r8,0.38437e+03_r8 /) + kao(:, 2, 9, 4) = (/ & + & 0.56432e+03_r8,0.53718e+03_r8,0.51003e+03_r8,0.48678e+03_r8,0.55899e+03_r8, & + & 0.49424e+03_r8,0.41825e+03_r8,0.40131e+03_r8,0.38437e+03_r8 /) + kao(:, 3, 9, 4) = (/ & + & 0.55726e+03_r8,0.53099e+03_r8,0.50473e+03_r8,0.48321e+03_r8,0.55650e+03_r8, & + & 0.48858e+03_r8,0.41662e+03_r8,0.40050e+03_r8,0.38437e+03_r8 /) + kao(:, 4, 9, 4) = (/ & + & 0.55108e+03_r8,0.52559e+03_r8,0.50010e+03_r8,0.48011e+03_r8,0.55416e+03_r8, & + & 0.48367e+03_r8,0.41520e+03_r8,0.39978e+03_r8,0.38437e+03_r8 /) + kao(:, 5, 9, 4) = (/ & + & 0.54564e+03_r8,0.52083e+03_r8,0.49601e+03_r8,0.47737e+03_r8,0.55194e+03_r8, & + & 0.47938e+03_r8,0.41394e+03_r8,0.39916e+03_r8,0.38437e+03_r8 /) + kao(:, 1,10, 4) = (/ & + & 0.55559e+03_r8,0.52954e+03_r8,0.50348e+03_r8,0.48256e+03_r8,0.55544e+03_r8, & + & 0.48725e+03_r8,0.41624e+03_r8,0.40030e+03_r8,0.38437e+03_r8 /) + kao(:, 2,10, 4) = (/ & + & 0.54839e+03_r8,0.52324e+03_r8,0.49808e+03_r8,0.47910e+03_r8,0.55295e+03_r8, & + & 0.48155e+03_r8,0.41458e+03_r8,0.39948e+03_r8,0.38437e+03_r8 /) + kao(:, 3,10, 4) = (/ & + & 0.54220e+03_r8,0.51781e+03_r8,0.49343e+03_r8,0.47621e+03_r8,0.55067e+03_r8, & + & 0.47667e+03_r8,0.41315e+03_r8,0.39876e+03_r8,0.38437e+03_r8 /) + kao(:, 4,10, 4) = (/ & + & 0.53680e+03_r8,0.51310e+03_r8,0.48939e+03_r8,0.47371e+03_r8,0.54855e+03_r8, & + & 0.47238e+03_r8,0.41191e+03_r8,0.39814e+03_r8,0.38437e+03_r8 /) + kao(:, 5,10, 4) = (/ & + & 0.53207e+03_r8,0.50895e+03_r8,0.48584e+03_r8,0.47148e+03_r8,0.54655e+03_r8, & + & 0.46857e+03_r8,0.41082e+03_r8,0.39760e+03_r8,0.38437e+03_r8 /) + kao(:, 1,11, 4) = (/ & + & 0.53816e+03_r8,0.51428e+03_r8,0.49041e+03_r8,0.47455e+03_r8,0.54857e+03_r8, & + & 0.47346e+03_r8,0.41222e+03_r8,0.39830e+03_r8,0.38437e+03_r8 /) + kao(:, 2,11, 4) = (/ & + & 0.53226e+03_r8,0.50912e+03_r8,0.48598e+03_r8,0.47200e+03_r8,0.54640e+03_r8, & + & 0.46874e+03_r8,0.41086e+03_r8,0.39762e+03_r8,0.38437e+03_r8 /) + kao(:, 3,11, 4) = (/ & + & 0.52718e+03_r8,0.50468e+03_r8,0.48217e+03_r8,0.46982e+03_r8,0.54436e+03_r8, & + & 0.46486e+03_r8,0.40969e+03_r8,0.39703e+03_r8,0.38437e+03_r8 /) + kao(:, 4,11, 4) = (/ & + & 0.52277e+03_r8,0.50081e+03_r8,0.47886e+03_r8,0.46790e+03_r8,0.54248e+03_r8, & + & 0.46109e+03_r8,0.40868e+03_r8,0.39652e+03_r8,0.38437e+03_r8 /) + kao(:, 5,11, 4) = (/ & + & 0.51889e+03_r8,0.49742e+03_r8,0.47595e+03_r8,0.46618e+03_r8,0.54076e+03_r8, & + & 0.45793e+03_r8,0.40778e+03_r8,0.39608e+03_r8,0.38437e+03_r8 /) + kao(:, 1,12, 4) = (/ & + & 0.52385e+03_r8,0.50177e+03_r8,0.47968e+03_r8,0.46863e+03_r8,0.54244e+03_r8, & + & 0.46202e+03_r8,0.40893e+03_r8,0.39665e+03_r8,0.38437e+03_r8 /) + kao(:, 2,12, 4) = (/ & + & 0.51902e+03_r8,0.49754e+03_r8,0.47606e+03_r8,0.46673e+03_r8,0.54050e+03_r8, & + & 0.45805e+03_r8,0.40782e+03_r8,0.39609e+03_r8,0.38437e+03_r8 /) + kao(:, 3,12, 4) = (/ & + & 0.51487e+03_r8,0.49390e+03_r8,0.47294e+03_r8,0.46509e+03_r8,0.53868e+03_r8, & + & 0.45465e+03_r8,0.40686e+03_r8,0.39561e+03_r8,0.38437e+03_r8 /) + kao(:, 4,12, 4) = (/ & + & 0.51125e+03_r8,0.49074e+03_r8,0.47022e+03_r8,0.46362e+03_r8,0.53703e+03_r8, & + & 0.45171e+03_r8,0.40602e+03_r8,0.39520e+03_r8,0.38437e+03_r8 /) + kao(:, 5,12, 4) = (/ & + & 0.50807e+03_r8,0.48796e+03_r8,0.46784e+03_r8,0.46227e+03_r8,0.53558e+03_r8, & + & 0.44916e+03_r8,0.40529e+03_r8,0.39483e+03_r8,0.38437e+03_r8 /) + kao(:, 1,13, 4) = (/ & + & 0.51214e+03_r8,0.49152e+03_r8,0.47089e+03_r8,0.46425e+03_r8,0.53698e+03_r8, & + & 0.45243e+03_r8,0.40623e+03_r8,0.39530e+03_r8,0.38437e+03_r8 /) + kao(:, 2,13, 4) = (/ & + & 0.50819e+03_r8,0.48806e+03_r8,0.46793e+03_r8,0.46281e+03_r8,0.53522e+03_r8, & + & 0.44925e+03_r8,0.40532e+03_r8,0.39485e+03_r8,0.38437e+03_r8 /) + kao(:, 3,13, 4) = (/ & + & 0.50478e+03_r8,0.48508e+03_r8,0.46537e+03_r8,0.46157e+03_r8,0.53378e+03_r8, & + & 0.44654e+03_r8,0.40453e+03_r8,0.39445e+03_r8,0.38437e+03_r8 /) + kao(:, 4,13, 4) = (/ & + & 0.50182e+03_r8,0.48249e+03_r8,0.46315e+03_r8,0.46044e+03_r8,0.53251e+03_r8, & + & 0.44422e+03_r8,0.40385e+03_r8,0.39411e+03_r8,0.38437e+03_r8 /) + kao(:, 5,13, 4) = (/ & + & 0.49922e+03_r8,0.48021e+03_r8,0.46120e+03_r8,0.45936e+03_r8,0.53137e+03_r8, & + & 0.44221e+03_r8,0.40325e+03_r8,0.39381e+03_r8,0.38437e+03_r8 /) + kao(:, 1, 1, 5) = (/ & + & 0.13243e+04_r8,0.11799e+04_r8,0.10354e+04_r8,0.89093e+03_r8,0.74647e+03_r8, & + & 0.71044e+03_r8,0.61021e+03_r8,0.64069e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 1, 5) = (/ & + & 0.12908e+04_r8,0.11505e+04_r8,0.10102e+04_r8,0.86996e+03_r8,0.72969e+03_r8, & + & 0.70292e+03_r8,0.60750e+03_r8,0.63934e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 1, 5) = (/ & + & 0.12606e+04_r8,0.11241e+04_r8,0.98763e+03_r8,0.85113e+03_r8,0.71463e+03_r8, & + & 0.69451e+03_r8,0.60507e+03_r8,0.63812e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 1, 5) = (/ & + & 0.12334e+04_r8,0.11003e+04_r8,0.96722e+03_r8,0.83412e+03_r8,0.70102e+03_r8, & + & 0.68564e+03_r8,0.60287e+03_r8,0.63703e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 1, 5) = (/ & + & 0.12087e+04_r8,0.10787e+04_r8,0.94870e+03_r8,0.81869e+03_r8,0.68867e+03_r8, & + & 0.67724e+03_r8,0.60088e+03_r8,0.63603e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 2, 5) = (/ & + & 0.12234e+04_r8,0.10916e+04_r8,0.95972e+03_r8,0.82787e+03_r8,0.69602e+03_r8, & + & 0.68345e+03_r8,0.60207e+03_r8,0.63662e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 2, 5) = (/ & + & 0.11946e+04_r8,0.10664e+04_r8,0.93814e+03_r8,0.80988e+03_r8,0.68163e+03_r8, & + & 0.67225e+03_r8,0.59975e+03_r8,0.63546e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 2, 5) = (/ & + & 0.11689e+04_r8,0.10438e+04_r8,0.91881e+03_r8,0.79377e+03_r8,0.66882e+03_r8, & + & 0.66165e+03_r8,0.59767e+03_r8,0.63442e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 2, 5) = (/ & + & 0.11456e+04_r8,0.10235e+04_r8,0.90139e+03_r8,0.77926e+03_r8,0.65759e+03_r8, & + & 0.65058e+03_r8,0.59579e+03_r8,0.63348e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 2, 5) = (/ & + & 0.11246e+04_r8,0.10051e+04_r8,0.88561e+03_r8,0.76611e+03_r8,0.64778e+03_r8, & + & 0.64016e+03_r8,0.59410e+03_r8,0.63264e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 3, 5) = (/ & + & 0.11441e+04_r8,0.10221e+04_r8,0.90021e+03_r8,0.77828e+03_r8,0.65728e+03_r8, & + & 0.64981e+03_r8,0.59567e+03_r8,0.63342e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 3, 5) = (/ & + & 0.11188e+04_r8,0.10001e+04_r8,0.88128e+03_r8,0.76250e+03_r8,0.64582e+03_r8, & + & 0.63739e+03_r8,0.59363e+03_r8,0.63240e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 3, 5) = (/ & + & 0.10963e+04_r8,0.98033e+03_r8,0.86437e+03_r8,0.74841e+03_r8,0.63611e+03_r8, & + & 0.62581e+03_r8,0.59181e+03_r8,0.63149e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 3, 5) = (/ & + & 0.10761e+04_r8,0.96263e+03_r8,0.84920e+03_r8,0.73577e+03_r8,0.62780e+03_r8, & + & 0.61513e+03_r8,0.59018e+03_r8,0.63068e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 3, 5) = (/ & + & 0.10578e+04_r8,0.94664e+03_r8,0.83549e+03_r8,0.72435e+03_r8,0.62066e+03_r8, & + & 0.60588e+03_r8,0.58871e+03_r8,0.62994e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 4, 5) = (/ & + & 0.10783e+04_r8,0.96456e+03_r8,0.85086e+03_r8,0.73715e+03_r8,0.62971e+03_r8, & + & 0.61628e+03_r8,0.59036e+03_r8,0.63077e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 4, 5) = (/ & + & 0.10559e+04_r8,0.94502e+03_r8,0.83411e+03_r8,0.72319e+03_r8,0.62145e+03_r8, & + & 0.60490e+03_r8,0.58856e+03_r8,0.62987e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 4, 5) = (/ & + & 0.10361e+04_r8,0.92766e+03_r8,0.81923e+03_r8,0.71079e+03_r8,0.61457e+03_r8, & + & 0.59452e+03_r8,0.58696e+03_r8,0.62907e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 4, 5) = (/ & + & 0.10183e+04_r8,0.91213e+03_r8,0.80591e+03_r8,0.69970e+03_r8,0.60876e+03_r8, & + & 0.58559e+03_r8,0.58552e+03_r8,0.62835e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 4, 5) = (/ & + & 0.10024e+04_r8,0.89816e+03_r8,0.79394e+03_r8,0.68972e+03_r8,0.60374e+03_r8, & + & 0.57800e+03_r8,0.58424e+03_r8,0.62771e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 5, 5) = (/ & + & 0.10224e+04_r8,0.91564e+03_r8,0.80892e+03_r8,0.70221e+03_r8,0.61144e+03_r8, & + & 0.58757e+03_r8,0.58585e+03_r8,0.62851e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 5, 5) = (/ & + & 0.10026e+04_r8,0.89835e+03_r8,0.79410e+03_r8,0.68985e+03_r8,0.60588e+03_r8, & + & 0.57810e+03_r8,0.58425e+03_r8,0.62772e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 5, 5) = (/ & + & 0.98511e+03_r8,0.88305e+03_r8,0.78099e+03_r8,0.67893e+03_r8,0.60138e+03_r8, & + & 0.57034e+03_r8,0.58284e+03_r8,0.62701e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 5, 5) = (/ & + & 0.96954e+03_r8,0.86942e+03_r8,0.76931e+03_r8,0.66919e+03_r8,0.59759e+03_r8, & + & 0.56378e+03_r8,0.58159e+03_r8,0.62638e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 5, 5) = (/ & + & 0.95557e+03_r8,0.85720e+03_r8,0.75883e+03_r8,0.66046e+03_r8,0.59436e+03_r8, & + & 0.55823e+03_r8,0.58046e+03_r8,0.62582e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 6, 5) = (/ & + & 0.97547e+03_r8,0.87461e+03_r8,0.77376e+03_r8,0.67290e+03_r8,0.60045e+03_r8, & + & 0.56624e+03_r8,0.58207e+03_r8,0.62662e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 6, 5) = (/ & + & 0.95788e+03_r8,0.85922e+03_r8,0.76057e+03_r8,0.66191e+03_r8,0.59710e+03_r8, & + & 0.55912e+03_r8,0.58065e+03_r8,0.62591e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 6, 5) = (/ & + & 0.94241e+03_r8,0.84568e+03_r8,0.74896e+03_r8,0.65223e+03_r8,0.59434e+03_r8, & + & 0.55328e+03_r8,0.57940e+03_r8,0.62529e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 6, 5) = (/ & + & 0.92868e+03_r8,0.83367e+03_r8,0.73866e+03_r8,0.64365e+03_r8,0.59182e+03_r8, & + & 0.54839e+03_r8,0.57829e+03_r8,0.62473e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 6, 5) = (/ & + & 0.91642e+03_r8,0.82295e+03_r8,0.72947e+03_r8,0.63599e+03_r8,0.58948e+03_r8, & + & 0.54428e+03_r8,0.57730e+03_r8,0.62424e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 7, 5) = (/ & + & 0.93556e+03_r8,0.83969e+03_r8,0.74382e+03_r8,0.64795e+03_r8,0.59420e+03_r8, & + & 0.55081e+03_r8,0.57885e+03_r8,0.62501e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 7, 5) = (/ & + & 0.91989e+03_r8,0.82598e+03_r8,0.73207e+03_r8,0.63816e+03_r8,0.59179e+03_r8, & + & 0.54542e+03_r8,0.57758e+03_r8,0.62438e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 7, 5) = (/ & + & 0.90618e+03_r8,0.81398e+03_r8,0.72179e+03_r8,0.62959e+03_r8,0.58955e+03_r8, & + & 0.54102e+03_r8,0.57648e+03_r8,0.62383e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 7, 5) = (/ & + & 0.89407e+03_r8,0.80339e+03_r8,0.71271e+03_r8,0.62202e+03_r8,0.58737e+03_r8, & + & 0.53729e+03_r8,0.57550e+03_r8,0.62334e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 7, 5) = (/ & + & 0.88331e+03_r8,0.79397e+03_r8,0.70463e+03_r8,0.61530e+03_r8,0.58524e+03_r8, & + & 0.53413e+03_r8,0.57463e+03_r8,0.62290e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 8, 5) = (/ & + & 0.90140e+03_r8,0.80981e+03_r8,0.71821e+03_r8,0.62661e+03_r8,0.58941e+03_r8, & + & 0.53953e+03_r8,0.57609e+03_r8,0.62363e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 8, 5) = (/ & + & 0.88745e+03_r8,0.79760e+03_r8,0.70774e+03_r8,0.61789e+03_r8,0.58727e+03_r8, & + & 0.53533e+03_r8,0.57497e+03_r8,0.62307e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 8, 5) = (/ & + & 0.87531e+03_r8,0.78697e+03_r8,0.69863e+03_r8,0.61030e+03_r8,0.58522e+03_r8, & + & 0.53203e+03_r8,0.57399e+03_r8,0.62258e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 8, 5) = (/ & + & 0.86464e+03_r8,0.77763e+03_r8,0.69063e+03_r8,0.60363e+03_r8,0.58317e+03_r8, & + & 0.52938e+03_r8,0.57313e+03_r8,0.62215e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 8, 5) = (/ & + & 0.85519e+03_r8,0.76937e+03_r8,0.68354e+03_r8,0.59772e+03_r8,0.58120e+03_r8, & + & 0.52712e+03_r8,0.57236e+03_r8,0.62177e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 9, 5) = (/ & + & 0.87232e+03_r8,0.78435e+03_r8,0.69639e+03_r8,0.60843e+03_r8,0.58508e+03_r8, & + & 0.53128e+03_r8,0.57375e+03_r8,0.62246e+03_r8,0.67118e+03_r8 /) + kao(:, 2, 9, 5) = (/ & + & 0.85988e+03_r8,0.77347e+03_r8,0.68706e+03_r8,0.60065e+03_r8,0.58302e+03_r8, & + & 0.52823e+03_r8,0.57274e+03_r8,0.62196e+03_r8,0.67118e+03_r8 /) + kao(:, 3, 9, 5) = (/ & + & 0.84911e+03_r8,0.76405e+03_r8,0.67898e+03_r8,0.59392e+03_r8,0.58102e+03_r8, & + & 0.52572e+03_r8,0.57187e+03_r8,0.62153e+03_r8,0.67118e+03_r8 /) + kao(:, 4, 9, 5) = (/ & + & 0.83970e+03_r8,0.75581e+03_r8,0.67193e+03_r8,0.58804e+03_r8,0.57906e+03_r8, & + & 0.52364e+03_r8,0.57111e+03_r8,0.62115e+03_r8,0.67118e+03_r8 /) + kao(:, 5, 9, 5) = (/ & + & 0.83140e+03_r8,0.74855e+03_r8,0.66571e+03_r8,0.58286e+03_r8,0.57713e+03_r8, & + & 0.52190e+03_r8,0.57045e+03_r8,0.62081e+03_r8,0.67118e+03_r8 /) + kao(:, 1,10, 5) = (/ & + & 0.84657e+03_r8,0.76183e+03_r8,0.67708e+03_r8,0.59234e+03_r8,0.58061e+03_r8, & + & 0.52515e+03_r8,0.57167e+03_r8,0.62142e+03_r8,0.67118e+03_r8 /) + kao(:, 2,10, 5) = (/ & + & 0.83560e+03_r8,0.75223e+03_r8,0.66886e+03_r8,0.58548e+03_r8,0.57865e+03_r8, & + & 0.52276e+03_r8,0.57078e+03_r8,0.62098e+03_r8,0.67118e+03_r8 /) + kao(:, 3,10, 5) = (/ & + & 0.82616e+03_r8,0.74397e+03_r8,0.66177e+03_r8,0.57958e+03_r8,0.57663e+03_r8, & + & 0.52085e+03_r8,0.57002e+03_r8,0.62060e+03_r8,0.67118e+03_r8 /) + kao(:, 4,10, 5) = (/ & + & 0.81794e+03_r8,0.73678e+03_r8,0.65561e+03_r8,0.57444e+03_r8,0.57466e+03_r8, & + & 0.51933e+03_r8,0.56936e+03_r8,0.62027e+03_r8,0.67118e+03_r8 /) + kao(:, 5,10, 5) = (/ & + & 0.81073e+03_r8,0.73047e+03_r8,0.65020e+03_r8,0.56994e+03_r8,0.57276e+03_r8, & + & 0.51811e+03_r8,0.56878e+03_r8,0.61998e+03_r8,0.67118e+03_r8 /) + kao(:, 1,11, 5) = (/ & + & 0.82001e+03_r8,0.73859e+03_r8,0.65716e+03_r8,0.57574e+03_r8,0.57531e+03_r8, & + & 0.51970e+03_r8,0.56953e+03_r8,0.62035e+03_r8,0.67118e+03_r8 /) + kao(:, 2,11, 5) = (/ & + & 0.81102e+03_r8,0.73072e+03_r8,0.65042e+03_r8,0.57012e+03_r8,0.57326e+03_r8, & + & 0.51814e+03_r8,0.56880e+03_r8,0.61999e+03_r8,0.67118e+03_r8 /) + kao(:, 3,11, 5) = (/ & + & 0.80328e+03_r8,0.72395e+03_r8,0.64462e+03_r8,0.56528e+03_r8,0.57135e+03_r8, & + & 0.51670e+03_r8,0.56818e+03_r8,0.61968e+03_r8,0.67118e+03_r8 /) + kao(:, 4,11, 5) = (/ & + & 0.79655e+03_r8,0.71806e+03_r8,0.63957e+03_r8,0.56108e+03_r8,0.56956e+03_r8, & + & 0.51595e+03_r8,0.56763e+03_r8,0.61941e+03_r8,0.67118e+03_r8 /) + kao(:, 5,11, 5) = (/ & + & 0.79064e+03_r8,0.71289e+03_r8,0.63514e+03_r8,0.55738e+03_r8,0.56781e+03_r8, & + & 0.51517e+03_r8,0.56716e+03_r8,0.61917e+03_r8,0.67118e+03_r8 /) + kao(:, 1,12, 5) = (/ & + & 0.79821e+03_r8,0.71951e+03_r8,0.64081e+03_r8,0.56211e+03_r8,0.57002e+03_r8, & + & 0.51613e+03_r8,0.56777e+03_r8,0.61947e+03_r8,0.67118e+03_r8 /) + kao(:, 2,12, 5) = (/ & + & 0.79085e+03_r8,0.71307e+03_r8,0.63529e+03_r8,0.55751e+03_r8,0.56813e+03_r8, & + & 0.51519e+03_r8,0.56717e+03_r8,0.61918e+03_r8,0.67118e+03_r8 /) + kao(:, 3,12, 5) = (/ & + & 0.78452e+03_r8,0.70753e+03_r8,0.63054e+03_r8,0.55355e+03_r8,0.56648e+03_r8, & + & 0.51441e+03_r8,0.56666e+03_r8,0.61892e+03_r8,0.67118e+03_r8 /) + kao(:, 4,12, 5) = (/ & + & 0.77901e+03_r8,0.70271e+03_r8,0.62641e+03_r8,0.55011e+03_r8,0.56489e+03_r8, & + & 0.51374e+03_r8,0.56622e+03_r8,0.61870e+03_r8,0.67118e+03_r8 /) + kao(:, 5,12, 5) = (/ & + & 0.77417e+03_r8,0.69847e+03_r8,0.62278e+03_r8,0.54708e+03_r8,0.56325e+03_r8, & + & 0.51315e+03_r8,0.56583e+03_r8,0.61850e+03_r8,0.67118e+03_r8 /) + kao(:, 1,13, 5) = (/ & + & 0.78036e+03_r8,0.70389e+03_r8,0.62743e+03_r8,0.55096e+03_r8,0.56495e+03_r8, & + & 0.51390e+03_r8,0.56633e+03_r8,0.61875e+03_r8,0.67118e+03_r8 /) + kao(:, 2,13, 5) = (/ & + & 0.77434e+03_r8,0.69862e+03_r8,0.62291e+03_r8,0.54719e+03_r8,0.56343e+03_r8, & + & 0.51318e+03_r8,0.56584e+03_r8,0.61851e+03_r8,0.67118e+03_r8 /) + kao(:, 3,13, 5) = (/ & + & 0.76915e+03_r8,0.69408e+03_r8,0.61902e+03_r8,0.54395e+03_r8,0.56189e+03_r8, & + & 0.51255e+03_r8,0.56542e+03_r8,0.61830e+03_r8,0.67118e+03_r8 /) + kao(:, 4,13, 5) = (/ & + & 0.76464e+03_r8,0.69014e+03_r8,0.61563e+03_r8,0.54113e+03_r8,0.56027e+03_r8, & + & 0.51200e+03_r8,0.56506e+03_r8,0.61812e+03_r8,0.67118e+03_r8 /) + kao(:, 5,13, 5) = (/ & + & 0.76068e+03_r8,0.68667e+03_r8,0.61266e+03_r8,0.53865e+03_r8,0.55865e+03_r8, & + & 0.51152e+03_r8,0.56474e+03_r8,0.61796e+03_r8,0.67118e+03_r8 /) + kao(:, 1, 1, 6) = (/ & + & 0.16832e+04_r8,0.14832e+04_r8,0.12833e+04_r8,0.10834e+04_r8,0.88343e+03_r8, & + & 0.73047e+03_r8,0.75923e+03_r8,0.85568e+03_r8,0.94989e+03_r8 /) + kao(:, 2, 1, 6) = (/ & + & 0.16405e+04_r8,0.14459e+04_r8,0.12513e+04_r8,0.10567e+04_r8,0.86211e+03_r8, & + & 0.72257e+03_r8,0.75791e+03_r8,0.85457e+03_r8,0.94915e+03_r8 /) + kao(:, 3, 1, 6) = (/ & + & 0.16022e+04_r8,0.14124e+04_r8,0.12226e+04_r8,0.10328e+04_r8,0.84296e+03_r8, & + & 0.71182e+03_r8,0.75643e+03_r8,0.85315e+03_r8,0.94805e+03_r8 /) + kao(:, 4, 1, 6) = (/ & + & 0.15677e+04_r8,0.13822e+04_r8,0.11967e+04_r8,0.10112e+04_r8,0.82566e+03_r8, & + & 0.70003e+03_r8,0.75475e+03_r8,0.85145e+03_r8,0.94659e+03_r8 /) + kao(:, 5, 1, 6) = (/ & + & 0.15363e+04_r8,0.13547e+04_r8,0.11731e+04_r8,0.99155e+03_r8,0.80997e+03_r8, & + & 0.68802e+03_r8,0.75277e+03_r8,0.84941e+03_r8,0.94478e+03_r8 /) + kao(:, 1, 2, 6) = (/ & + & 0.15549e+04_r8,0.13710e+04_r8,0.11871e+04_r8,0.10032e+04_r8,0.81930e+03_r8, & + & 0.69644e+03_r8,0.75599e+03_r8,0.85402e+03_r8,0.95009e+03_r8 /) + kao(:, 2, 2, 6) = (/ & + & 0.15184e+04_r8,0.13390e+04_r8,0.11597e+04_r8,0.98036e+03_r8,0.80102e+03_r8, & + & 0.68214e+03_r8,0.75486e+03_r8,0.85308e+03_r8,0.94950e+03_r8 /) + kao(:, 3, 2, 6) = (/ & + & 0.14856e+04_r8,0.13104e+04_r8,0.11351e+04_r8,0.95988e+03_r8,0.78464e+03_r8, & + & 0.67032e+03_r8,0.75359e+03_r8,0.85186e+03_r8,0.94855e+03_r8 /) + kao(:, 4, 2, 6) = (/ & + & 0.14561e+04_r8,0.12845e+04_r8,0.11130e+04_r8,0.94143e+03_r8,0.76988e+03_r8, & + & 0.66240e+03_r8,0.75215e+03_r8,0.85037e+03_r8,0.94724e+03_r8 /) + kao(:, 5, 2, 6) = (/ & + & 0.14294e+04_r8,0.12611e+04_r8,0.10929e+04_r8,0.92472e+03_r8,0.75651e+03_r8, & + & 0.65660e+03_r8,0.75042e+03_r8,0.84857e+03_r8,0.94557e+03_r8 /) + kao(:, 1, 3, 6) = (/ & + & 0.14541e+04_r8,0.12828e+04_r8,0.11115e+04_r8,0.94019e+03_r8,0.76889e+03_r8, & + & 0.66226e+03_r8,0.75340e+03_r8,0.85268e+03_r8,0.95029e+03_r8 /) + kao(:, 2, 3, 6) = (/ & + & 0.14220e+04_r8,0.12547e+04_r8,0.10874e+04_r8,0.92013e+03_r8,0.75284e+03_r8, & + & 0.65611e+03_r8,0.75249e+03_r8,0.85200e+03_r8,0.94990e+03_r8 /) + kao(:, 3, 3, 6) = (/ & + & 0.13934e+04_r8,0.12297e+04_r8,0.10659e+04_r8,0.90223e+03_r8,0.73852e+03_r8, & + & 0.65222e+03_r8,0.75143e+03_r8,0.85101e+03_r8,0.94916e+03_r8 /) + kao(:, 4, 3, 6) = (/ & + & 0.13676e+04_r8,0.12071e+04_r8,0.10467e+04_r8,0.88615e+03_r8,0.72566e+03_r8, & + & 0.64945e+03_r8,0.75024e+03_r8,0.84977e+03_r8,0.94807e+03_r8 /) + kao(:, 5, 3, 6) = (/ & + & 0.13444e+04_r8,0.11868e+04_r8,0.10292e+04_r8,0.87164e+03_r8,0.71405e+03_r8, & + & 0.64733e+03_r8,0.74880e+03_r8,0.84822e+03_r8,0.94662e+03_r8 /) + kao(:, 1, 4, 6) = (/ & + & 0.13705e+04_r8,0.12096e+04_r8,0.10488e+04_r8,0.88791e+03_r8,0.72707e+03_r8, & + & 0.64976e+03_r8,0.75119e+03_r8,0.85151e+03_r8,0.95037e+03_r8 /) + kao(:, 2, 4, 6) = (/ & + & 0.13421e+04_r8,0.11848e+04_r8,0.10275e+04_r8,0.87017e+03_r8,0.71287e+03_r8, & + & 0.64785e+03_r8,0.75047e+03_r8,0.85104e+03_r8,0.95019e+03_r8 /) + kao(:, 3, 4, 6) = (/ & + & 0.13169e+04_r8,0.11627e+04_r8,0.10086e+04_r8,0.85441e+03_r8,0.70026e+03_r8, & + & 0.64696e+03_r8,0.74964e+03_r8,0.85031e+03_r8,0.94968e+03_r8 /) + kao(:, 4, 4, 6) = (/ & + & 0.12943e+04_r8,0.11430e+04_r8,0.99164e+03_r8,0.84031e+03_r8,0.68898e+03_r8, & + & 0.64601e+03_r8,0.74865e+03_r8,0.84930e+03_r8,0.94882e+03_r8 /) + kao(:, 5, 4, 6) = (/ & + & 0.12740e+04_r8,0.11252e+04_r8,0.97642e+03_r8,0.82763e+03_r8,0.67884e+03_r8, & + & 0.64496e+03_r8,0.74747e+03_r8,0.84802e+03_r8,0.94760e+03_r8 /) + kao(:, 1, 5, 6) = (/ & + & 0.12994e+04_r8,0.11474e+04_r8,0.99546e+03_r8,0.84350e+03_r8,0.69153e+03_r8, & + & 0.64599e+03_r8,0.74922e+03_r8,0.85040e+03_r8,0.95032e+03_r8 /) + kao(:, 2, 5, 6) = (/ & + & 0.12743e+04_r8,0.11254e+04_r8,0.97662e+03_r8,0.82780e+03_r8,0.67897e+03_r8, & + & 0.64529e+03_r8,0.74869e+03_r8,0.85015e+03_r8,0.95034e+03_r8 /) + kao(:, 3, 5, 6) = (/ & + & 0.12521e+04_r8,0.11060e+04_r8,0.95996e+03_r8,0.81391e+03_r8,0.66786e+03_r8, & + & 0.64458e+03_r8,0.74805e+03_r8,0.84965e+03_r8,0.95004e+03_r8 /) + kao(:, 4, 5, 6) = (/ & + & 0.12323e+04_r8,0.10887e+04_r8,0.94511e+03_r8,0.80154e+03_r8,0.65797e+03_r8, & + & 0.64380e+03_r8,0.74727e+03_r8,0.84886e+03_r8,0.94940e+03_r8 /) + kao(:, 5, 5, 6) = (/ & + & 0.12145e+04_r8,0.10732e+04_r8,0.93180e+03_r8,0.79045e+03_r8,0.64909e+03_r8, & + & 0.64294e+03_r8,0.74629e+03_r8,0.84781e+03_r8,0.94841e+03_r8 /) + kao(:, 1, 6, 6) = (/ & + & 0.12398e+04_r8,0.10953e+04_r8,0.95077e+03_r8,0.80625e+03_r8,0.66174e+03_r8, & + & 0.64362e+03_r8,0.74747e+03_r8,0.84935e+03_r8,0.95014e+03_r8 /) + kao(:, 2, 6, 6) = (/ & + & 0.12174e+04_r8,0.10757e+04_r8,0.93400e+03_r8,0.79228e+03_r8,0.65056e+03_r8, & + & 0.64308e+03_r8,0.74712e+03_r8,0.84932e+03_r8,0.95036e+03_r8 /) + kao(:, 3, 6, 6) = (/ & + & 0.11978e+04_r8,0.10585e+04_r8,0.91925e+03_r8,0.77999e+03_r8,0.64087e+03_r8, & + & 0.64253e+03_r8,0.74666e+03_r8,0.84902e+03_r8,0.95027e+03_r8 /) + kao(:, 4, 6, 6) = (/ & + & 0.11803e+04_r8,0.10432e+04_r8,0.90616e+03_r8,0.76908e+03_r8,0.63262e+03_r8, & + & 0.64192e+03_r8,0.74606e+03_r8,0.84847e+03_r8,0.94985e+03_r8 /) + kao(:, 5, 6, 6) = (/ & + & 0.11647e+04_r8,0.10296e+04_r8,0.89448e+03_r8,0.75935e+03_r8,0.62549e+03_r8, & + & 0.64122e+03_r8,0.74529e+03_r8,0.84763e+03_r8,0.94909e+03_r8 /) + kao(:, 1, 7, 6) = (/ & + & 0.11891e+04_r8,0.10509e+04_r8,0.91272e+03_r8,0.77455e+03_r8,0.63693e+03_r8, & + & 0.64154e+03_r8,0.74584e+03_r8,0.84830e+03_r8,0.94975e+03_r8 /) + kao(:, 2, 7, 6) = (/ & + & 0.11692e+04_r8,0.10335e+04_r8,0.89779e+03_r8,0.76210e+03_r8,0.62795e+03_r8, & + & 0.64115e+03_r8,0.74575e+03_r8,0.84848e+03_r8,0.95025e+03_r8 /) + kao(:, 3, 7, 6) = (/ & + & 0.11517e+04_r8,0.10182e+04_r8,0.88471e+03_r8,0.75121e+03_r8,0.62051e+03_r8, & + & 0.64074e+03_r8,0.74542e+03_r8,0.84840e+03_r8,0.95037e+03_r8 /) + kao(:, 4, 7, 6) = (/ & + & 0.11363e+04_r8,0.10048e+04_r8,0.87317e+03_r8,0.74159e+03_r8,0.61432e+03_r8, & + & 0.64028e+03_r8,0.74499e+03_r8,0.84806e+03_r8,0.95015e+03_r8 /) + kao(:, 5, 7, 6) = (/ & + & 0.11227e+04_r8,0.99279e+03_r8,0.86291e+03_r8,0.73304e+03_r8,0.60908e+03_r8, & + & 0.63974e+03_r8,0.74440e+03_r8,0.84744e+03_r8,0.94961e+03_r8 /) + kao(:, 1, 8, 6) = (/ & + & 0.11457e+04_r8,0.10129e+04_r8,0.88017e+03_r8,0.74742e+03_r8,0.61848e+03_r8, & + & 0.63968e+03_r8,0.74433e+03_r8,0.84725e+03_r8,0.94927e+03_r8 /) + kao(:, 2, 8, 6) = (/ & + & 0.11279e+04_r8,0.99740e+03_r8,0.86687e+03_r8,0.73633e+03_r8,0.61183e+03_r8, & + & 0.63944e+03_r8,0.74439e+03_r8,0.84765e+03_r8,0.94999e+03_r8 /) + kao(:, 3, 8, 6) = (/ & + & 0.11125e+04_r8,0.98389e+03_r8,0.85529e+03_r8,0.72668e+03_r8,0.60652e+03_r8, & + & 0.63917e+03_r8,0.74428e+03_r8,0.84777e+03_r8,0.95034e+03_r8 /) + kao(:, 4, 8, 6) = (/ & + & 0.10989e+04_r8,0.97202e+03_r8,0.84512e+03_r8,0.71821e+03_r8,0.60224e+03_r8, & + & 0.63885e+03_r8,0.74401e+03_r8,0.84763e+03_r8,0.95032e+03_r8 /) + kao(:, 5, 8, 6) = (/ & + & 0.10869e+04_r8,0.96152e+03_r8,0.83611e+03_r8,0.71070e+03_r8,0.59867e+03_r8, & + & 0.63844e+03_r8,0.74359e+03_r8,0.84721e+03_r8,0.94997e+03_r8 /) + kao(:, 1, 9, 6) = (/ & + & 0.11087e+04_r8,0.98057e+03_r8,0.85244e+03_r8,0.72431e+03_r8,0.60583e+03_r8, & + & 0.63802e+03_r8,0.74290e+03_r8,0.84619e+03_r8,0.94868e+03_r8 /) + kao(:, 2, 9, 6) = (/ & + & 0.10929e+04_r8,0.96673e+03_r8,0.84058e+03_r8,0.71443e+03_r8,0.60128e+03_r8, & + & 0.63792e+03_r8,0.74318e+03_r8,0.84681e+03_r8,0.94962e+03_r8 /) + kao(:, 3, 9, 6) = (/ & + & 0.10792e+04_r8,0.95475e+03_r8,0.83031e+03_r8,0.70587e+03_r8,0.59784e+03_r8, & + & 0.63778e+03_r8,0.74323e+03_r8,0.84713e+03_r8,0.95019e+03_r8 /) + kao(:, 4, 9, 6) = (/ & + & 0.10672e+04_r8,0.94429e+03_r8,0.82134e+03_r8,0.69840e+03_r8,0.59517e+03_r8, & + & 0.63759e+03_r8,0.74313e+03_r8,0.84718e+03_r8,0.95037e+03_r8 /) + kao(:, 5, 9, 6) = (/ & + & 0.10567e+04_r8,0.93506e+03_r8,0.81344e+03_r8,0.69181e+03_r8,0.59278e+03_r8, & + & 0.63730e+03_r8,0.74285e+03_r8,0.84695e+03_r8,0.95021e+03_r8 /) + kao(:, 1,10, 6) = (/ & + & 0.10760e+04_r8,0.95193e+03_r8,0.82790e+03_r8,0.70386e+03_r8,0.59768e+03_r8, & + & 0.63651e+03_r8,0.74157e+03_r8,0.84519e+03_r8,0.94809e+03_r8 /) + kao(:, 2,10, 6) = (/ & + & 0.10620e+04_r8,0.93974e+03_r8,0.81744e+03_r8,0.69515e+03_r8,0.59477e+03_r8, & + & 0.63656e+03_r8,0.74203e+03_r8,0.84600e+03_r8,0.94921e+03_r8 /) + kao(:, 3,10, 6) = (/ & + & 0.10500e+04_r8,0.92923e+03_r8,0.80844e+03_r8,0.68764e+03_r8,0.59242e+03_r8, & + & 0.63654e+03_r8,0.74226e+03_r8,0.84650e+03_r8,0.94996e+03_r8 /) + kao(:, 4,10, 6) = (/ & + & 0.10396e+04_r8,0.92010e+03_r8,0.80061e+03_r8,0.68112e+03_r8,0.59042e+03_r8, & + & 0.63645e+03_r8,0.74230e+03_r8,0.84672e+03_r8,0.95033e+03_r8 /) + kao(:, 5,10, 6) = (/ & + & 0.10304e+04_r8,0.91207e+03_r8,0.79373e+03_r8,0.67539e+03_r8,0.58849e+03_r8, & + & 0.63628e+03_r8,0.74216e+03_r8,0.84665e+03_r8,0.95033e+03_r8 /) + kao(:, 1,11, 6) = (/ & + & 0.10422e+04_r8,0.92239e+03_r8,0.80258e+03_r8,0.68276e+03_r8,0.59118e+03_r8, & + & 0.63525e+03_r8,0.74065e+03_r8,0.84470e+03_r8,0.94808e+03_r8 /) + kao(:, 2,11, 6) = (/ & + & 0.10308e+04_r8,0.91240e+03_r8,0.79401e+03_r8,0.67562e+03_r8,0.58920e+03_r8, & + & 0.63540e+03_r8,0.74118e+03_r8,0.84554e+03_r8,0.94920e+03_r8 /) + kao(:, 3,11, 6) = (/ & + & 0.10210e+04_r8,0.90379e+03_r8,0.78663e+03_r8,0.66947e+03_r8,0.58737e+03_r8, & + & 0.63545e+03_r8,0.74147e+03_r8,0.84609e+03_r8,0.94995e+03_r8 /) + kao(:, 4,11, 6) = (/ & + & 0.10124e+04_r8,0.89631e+03_r8,0.78022e+03_r8,0.66413e+03_r8,0.58569e+03_r8, & + & 0.63543e+03_r8,0.74156e+03_r8,0.84634e+03_r8,0.95033e+03_r8 /) + kao(:, 5,11, 6) = (/ & + & 0.10049e+04_r8,0.88974e+03_r8,0.77458e+03_r8,0.65943e+03_r8,0.58398e+03_r8, & + & 0.63532e+03_r8,0.74146e+03_r8,0.84628e+03_r8,0.95033e+03_r8 /) + kao(:, 1,12, 6) = (/ & + & 0.10145e+04_r8,0.89815e+03_r8,0.78180e+03_r8,0.66544e+03_r8,0.58616e+03_r8, & + & 0.63421e+03_r8,0.73990e+03_r8,0.84430e+03_r8,0.94808e+03_r8 /) + kao(:, 2,12, 6) = (/ & + & 0.10052e+04_r8,0.88997e+03_r8,0.77478e+03_r8,0.65960e+03_r8,0.58451e+03_r8, & + & 0.63444e+03_r8,0.74048e+03_r8,0.84518e+03_r8,0.94921e+03_r8 /) + kao(:, 3,12, 6) = (/ & + & 0.99710e+03_r8,0.88292e+03_r8,0.76874e+03_r8,0.65457e+03_r8,0.58265e+03_r8, & + & 0.63457e+03_r8,0.74082e+03_r8,0.84574e+03_r8,0.94995e+03_r8 /) + kao(:, 4,12, 6) = (/ & + & 0.99010e+03_r8,0.87679e+03_r8,0.76349e+03_r8,0.65019e+03_r8,0.58054e+03_r8, & + & 0.63460e+03_r8,0.74095e+03_r8,0.84600e+03_r8,0.95033e+03_r8 /) + kao(:, 5,12, 6) = (/ & + & 0.98395e+03_r8,0.87141e+03_r8,0.75888e+03_r8,0.64634e+03_r8,0.57844e+03_r8, & + & 0.63453e+03_r8,0.74089e+03_r8,0.84598e+03_r8,0.95033e+03_r8 /) + kao(:, 1,13, 6) = (/ & + & 0.99182e+03_r8,0.87830e+03_r8,0.76478e+03_r8,0.65127e+03_r8,0.58122e+03_r8, & + & 0.63336e+03_r8,0.73928e+03_r8,0.84397e+03_r8,0.94808e+03_r8 /) + kao(:, 2,13, 6) = (/ & + & 0.98416e+03_r8,0.87160e+03_r8,0.75904e+03_r8,0.64648e+03_r8,0.57888e+03_r8, & + & 0.63366e+03_r8,0.73991e+03_r8,0.84487e+03_r8,0.94921e+03_r8 /) + kao(:, 3,13, 6) = (/ & + & 0.97757e+03_r8,0.86583e+03_r8,0.75410e+03_r8,0.64236e+03_r8,0.57650e+03_r8, & + & 0.63384e+03_r8,0.74029e+03_r8,0.84546e+03_r8,0.94996e+03_r8 /) + kao(:, 4,13, 6) = (/ & + & 0.97184e+03_r8,0.86082e+03_r8,0.74980e+03_r8,0.63878e+03_r8,0.57428e+03_r8, & + & 0.63391e+03_r8,0.74045e+03_r8,0.84574e+03_r8,0.95033e+03_r8 /) + kao(:, 5,13, 6) = (/ & + & 0.96680e+03_r8,0.85641e+03_r8,0.74602e+03_r8,0.63563e+03_r8,0.57218e+03_r8, & + & 0.63388e+03_r8,0.74043e+03_r8,0.84574e+03_r8,0.95033e+03_r8 /) + kao(:, 1, 1, 7) = (/ & + & 0.18845e+04_r8,0.16548e+04_r8,0.14251e+04_r8,0.11953e+04_r8,0.96557e+03_r8, & + & 0.74301e+03_r8,0.82697e+03_r8,0.94964e+03_r8,0.10740e+04_r8 /) + kao(:, 2, 1, 7) = (/ & + & 0.18367e+04_r8,0.16130e+04_r8,0.13892e+04_r8,0.11655e+04_r8,0.94169e+03_r8, & + & 0.73101e+03_r8,0.82533e+03_r8,0.94833e+03_r8,0.10730e+04_r8 /) + kao(:, 3, 1, 7) = (/ & + & 0.17938e+04_r8,0.15755e+04_r8,0.13571e+04_r8,0.11387e+04_r8,0.92025e+03_r8, & + & 0.71894e+03_r8,0.82353e+03_r8,0.94679e+03_r8,0.10715e+04_r8 /) + kao(:, 4, 1, 7) = (/ & + & 0.17551e+04_r8,0.15416e+04_r8,0.13280e+04_r8,0.11145e+04_r8,0.90089e+03_r8, & + & 0.70691e+03_r8,0.82149e+03_r8,0.94487e+03_r8,0.10696e+04_r8 /) + kao(:, 5, 1, 7) = (/ & + & 0.17200e+04_r8,0.15108e+04_r8,0.13017e+04_r8,0.10925e+04_r8,0.88332e+03_r8, & + & 0.69946e+03_r8,0.81920e+03_r8,0.94260e+03_r8,0.10672e+04_r8 /) + kao(:, 1, 2, 7) = (/ & + & 0.17409e+04_r8,0.15291e+04_r8,0.13174e+04_r8,0.11056e+04_r8,0.89377e+03_r8, & + & 0.70556e+03_r8,0.82545e+03_r8,0.94918e+03_r8,0.10743e+04_r8 /) + kao(:, 2, 2, 7) = (/ & + & 0.16999e+04_r8,0.14933e+04_r8,0.12867e+04_r8,0.10800e+04_r8,0.87329e+03_r8, & + & 0.70177e+03_r8,0.82404e+03_r8,0.94806e+03_r8,0.10734e+04_r8 /) + kao(:, 3, 2, 7) = (/ & + & 0.16632e+04_r8,0.14612e+04_r8,0.12591e+04_r8,0.10571e+04_r8,0.85495e+03_r8, & + & 0.69985e+03_r8,0.82245e+03_r8,0.94668e+03_r8,0.10721e+04_r8 /) + kao(:, 4, 2, 7) = (/ & + & 0.16302e+04_r8,0.14323e+04_r8,0.12344e+04_r8,0.10364e+04_r8,0.83842e+03_r8, & + & 0.69778e+03_r8,0.82061e+03_r8,0.94495e+03_r8,0.10705e+04_r8 /) + kao(:, 5, 2, 7) = (/ & + & 0.16003e+04_r8,0.14061e+04_r8,0.12119e+04_r8,0.10177e+04_r8,0.82345e+03_r8, & + & 0.69549e+03_r8,0.81853e+03_r8,0.94286e+03_r8,0.10683e+04_r8 /) + kao(:, 1, 3, 7) = (/ & + & 0.16280e+04_r8,0.14303e+04_r8,0.12327e+04_r8,0.10350e+04_r8,0.83731e+03_r8, & + & 0.70164e+03_r8,0.82440e+03_r8,0.94900e+03_r8,0.10748e+04_r8 /) + kao(:, 2, 3, 7) = (/ & + & 0.15920e+04_r8,0.13989e+04_r8,0.12057e+04_r8,0.10126e+04_r8,0.81934e+03_r8, & + & 0.70016e+03_r8,0.82323e+03_r8,0.94804e+03_r8,0.10740e+04_r8 /) + kao(:, 3, 3, 7) = (/ & + & 0.15600e+04_r8,0.13708e+04_r8,0.11817e+04_r8,0.99252e+03_r8,0.80330e+03_r8, & + & 0.69850e+03_r8,0.82187e+03_r8,0.94688e+03_r8,0.10730e+04_r8 /) + kao(:, 4, 3, 7) = (/ & + & 0.15312e+04_r8,0.13457e+04_r8,0.11601e+04_r8,0.97452e+03_r8,0.78890e+03_r8, & + & 0.69669e+03_r8,0.82029e+03_r8,0.94542e+03_r8,0.10716e+04_r8 /) + kao(:, 5, 3, 7) = (/ & + & 0.15052e+04_r8,0.13229e+04_r8,0.11406e+04_r8,0.95827e+03_r8,0.77590e+03_r8, & + & 0.69468e+03_r8,0.81844e+03_r8,0.94358e+03_r8,0.10697e+04_r8 /) + kao(:, 1, 4, 7) = (/ & + & 0.15343e+04_r8,0.13484e+04_r8,0.11625e+04_r8,0.97650e+03_r8,0.79047e+03_r8, & + & 0.70005e+03_r8,0.82352e+03_r8,0.94883e+03_r8,0.10751e+04_r8 /) + kao(:, 2, 4, 7) = (/ & + & 0.15026e+04_r8,0.13206e+04_r8,0.11386e+04_r8,0.95663e+03_r8,0.77458e+03_r8, & + & 0.69884e+03_r8,0.82260e+03_r8,0.94808e+03_r8,0.10745e+04_r8 /) + kao(:, 3, 4, 7) = (/ & + & 0.14743e+04_r8,0.12959e+04_r8,0.11175e+04_r8,0.93898e+03_r8,0.76046e+03_r8, & + & 0.69743e+03_r8,0.82145e+03_r8,0.94711e+03_r8,0.10737e+04_r8 /) + kao(:, 4, 4, 7) = (/ & + & 0.14491e+04_r8,0.12738e+04_r8,0.10985e+04_r8,0.92319e+03_r8,0.74783e+03_r8, & + & 0.69586e+03_r8,0.82010e+03_r8,0.94588e+03_r8,0.10725e+04_r8 /) + kao(:, 5, 4, 7) = (/ & + & 0.14263e+04_r8,0.12539e+04_r8,0.10815e+04_r8,0.90900e+03_r8,0.73646e+03_r8, & + & 0.69412e+03_r8,0.81852e+03_r8,0.94430e+03_r8,0.10710e+04_r8 /) + kao(:, 1, 5, 7) = (/ & + & 0.14548e+04_r8,0.12788e+04_r8,0.11028e+04_r8,0.92676e+03_r8,0.75068e+03_r8, & + & 0.69862e+03_r8,0.82271e+03_r8,0.94860e+03_r8,0.10753e+04_r8 /) + kao(:, 2, 5, 7) = (/ & + & 0.14266e+04_r8,0.12542e+04_r8,0.10817e+04_r8,0.90918e+03_r8,0.73662e+03_r8, & + & 0.69765e+03_r8,0.82202e+03_r8,0.94804e+03_r8,0.10749e+04_r8 /) + kao(:, 3, 5, 7) = (/ & + & 0.14018e+04_r8,0.12324e+04_r8,0.10630e+04_r8,0.89363e+03_r8,0.72418e+03_r8, & + & 0.69649e+03_r8,0.82110e+03_r8,0.94729e+03_r8,0.10743e+04_r8 /) + kao(:, 4, 5, 7) = (/ & + & 0.13796e+04_r8,0.12130e+04_r8,0.10464e+04_r8,0.87978e+03_r8,0.71309e+03_r8, & + & 0.69515e+03_r8,0.81992e+03_r8,0.94623e+03_r8,0.10733e+04_r8 /) + kao(:, 5, 5, 7) = (/ & + & 0.13597e+04_r8,0.11956e+04_r8,0.10315e+04_r8,0.86737e+03_r8,0.70315e+03_r8, & + & 0.69363e+03_r8,0.81858e+03_r8,0.94492e+03_r8,0.10720e+04_r8 /) + kao(:, 1, 6, 7) = (/ & + & 0.13881e+04_r8,0.12204e+04_r8,0.10528e+04_r8,0.88506e+03_r8,0.71732e+03_r8, & + & 0.69732e+03_r8,0.82195e+03_r8,0.94833e+03_r8,0.10753e+04_r8 /) + kao(:, 2, 6, 7) = (/ & + & 0.13630e+04_r8,0.11985e+04_r8,0.10340e+04_r8,0.86942e+03_r8,0.70480e+03_r8, & + & 0.69661e+03_r8,0.82150e+03_r8,0.94796e+03_r8,0.10752e+04_r8 /) + kao(:, 3, 6, 7) = (/ & + & 0.13410e+04_r8,0.11792e+04_r8,0.10175e+04_r8,0.85565e+03_r8,0.69378e+03_r8, & + & 0.69568e+03_r8,0.82079e+03_r8,0.94739e+03_r8,0.10747e+04_r8 /) + kao(:, 4, 6, 7) = (/ & + & 0.13215e+04_r8,0.11622e+04_r8,0.10028e+04_r8,0.84344e+03_r8,0.68401e+03_r8, & + & 0.69456e+03_r8,0.81984e+03_r8,0.94655e+03_r8,0.10740e+04_r8 /) + kao(:, 5, 6, 7) = (/ & + & 0.13040e+04_r8,0.11469e+04_r8,0.98973e+03_r8,0.83254e+03_r8,0.67529e+03_r8, & + & 0.69326e+03_r8,0.81868e+03_r8,0.94544e+03_r8,0.10729e+04_r8 /) + kao(:, 1, 7, 7) = (/ & + & 0.13313e+04_r8,0.11707e+04_r8,0.10101e+04_r8,0.84956e+03_r8,0.68891e+03_r8, & + & 0.69611e+03_r8,0.82122e+03_r8,0.94800e+03_r8,0.10754e+04_r8 /) + kao(:, 2, 7, 7) = (/ & + & 0.13090e+04_r8,0.11512e+04_r8,0.99343e+03_r8,0.83562e+03_r8,0.67776e+03_r8, & + & 0.69564e+03_r8,0.82091e+03_r8,0.94785e+03_r8,0.10753e+04_r8 /) + kao(:, 3, 7, 7) = (/ & + & 0.12894e+04_r8,0.11341e+04_r8,0.97879e+03_r8,0.82342e+03_r8,0.66800e+03_r8, & + & 0.69494e+03_r8,0.82048e+03_r8,0.94742e+03_r8,0.10750e+04_r8 /) + kao(:, 4, 7, 7) = (/ & + & 0.12722e+04_r8,0.11191e+04_r8,0.96587e+03_r8,0.81266e+03_r8,0.65938e+03_r8, & + & 0.69403e+03_r8,0.81973e+03_r8,0.94677e+03_r8,0.10745e+04_r8 /) + kao(:, 5, 7, 7) = (/ & + & 0.12569e+04_r8,0.11057e+04_r8,0.95438e+03_r8,0.80308e+03_r8,0.65172e+03_r8, & + & 0.69293e+03_r8,0.81874e+03_r8,0.94587e+03_r8,0.10736e+04_r8 /) + kao(:, 1, 8, 7) = (/ & + & 0.12827e+04_r8,0.11282e+04_r8,0.97371e+03_r8,0.81918e+03_r8,0.66460e+03_r8, & + & 0.69497e+03_r8,0.82050e+03_r8,0.94762e+03_r8,0.10753e+04_r8 /) + kao(:, 2, 8, 7) = (/ & + & 0.12628e+04_r8,0.11108e+04_r8,0.95881e+03_r8,0.80678e+03_r8,0.65467e+03_r8, & + & 0.69473e+03_r8,0.82044e+03_r8,0.94765e+03_r8,0.10754e+04_r8 /) + kao(:, 3, 8, 7) = (/ & + & 0.12455e+04_r8,0.10957e+04_r8,0.94585e+03_r8,0.79597e+03_r8,0.64602e+03_r8, & + & 0.69425e+03_r8,0.82014e+03_r8,0.94746e+03_r8,0.10752e+04_r8 /) + kao(:, 4, 8, 7) = (/ & + & 0.12303e+04_r8,0.10824e+04_r8,0.93446e+03_r8,0.78648e+03_r8,0.63843e+03_r8, & + & 0.69354e+03_r8,0.81959e+03_r8,0.94691e+03_r8,0.10748e+04_r8 /) + kao(:, 5, 8, 7) = (/ & + & 0.12169e+04_r8,0.10706e+04_r8,0.92437e+03_r8,0.77807e+03_r8,0.63171e+03_r8, & + & 0.69262e+03_r8,0.81878e+03_r8,0.94618e+03_r8,0.10741e+04_r8 /) + kao(:, 1, 9, 7) = (/ & + & 0.12413e+04_r8,0.10920e+04_r8,0.94266e+03_r8,0.79331e+03_r8,0.64390e+03_r8, & + & 0.69387e+03_r8,0.81977e+03_r8,0.94713e+03_r8,0.10750e+04_r8 /) + kao(:, 2, 9, 7) = (/ & + & 0.12236e+04_r8,0.10765e+04_r8,0.92938e+03_r8,0.78225e+03_r8,0.63504e+03_r8, & + & 0.69385e+03_r8,0.81989e+03_r8,0.94741e+03_r8,0.10753e+04_r8 /) + kao(:, 3, 9, 7) = (/ & + & 0.12082e+04_r8,0.10631e+04_r8,0.91789e+03_r8,0.77267e+03_r8,0.62738e+03_r8, & + & 0.69359e+03_r8,0.81979e+03_r8,0.94732e+03_r8,0.10754e+04_r8 /) + kao(:, 4, 9, 7) = (/ & + & 0.11949e+04_r8,0.10514e+04_r8,0.90785e+03_r8,0.76430e+03_r8,0.62068e+03_r8, & + & 0.69307e+03_r8,0.81942e+03_r8,0.94698e+03_r8,0.10751e+04_r8 /) + kao(:, 5, 9, 7) = (/ & + & 0.11831e+04_r8,0.10410e+04_r8,0.89899e+03_r8,0.75692e+03_r8,0.61500e+03_r8, & + & 0.69235e+03_r8,0.81879e+03_r8,0.94641e+03_r8,0.10746e+04_r8 /) + kao(:, 1,10, 7) = (/ & + & 0.12046e+04_r8,0.10599e+04_r8,0.91518e+03_r8,0.77041e+03_r8,0.62557e+03_r8, & + & 0.69285e+03_r8,0.81909e+03_r8,0.94663e+03_r8,0.10746e+04_r8 /) + kao(:, 2,10, 7) = (/ & + & 0.11890e+04_r8,0.10463e+04_r8,0.90347e+03_r8,0.76066e+03_r8,0.61799e+03_r8, & + & 0.69301e+03_r8,0.81937e+03_r8,0.94709e+03_r8,0.10752e+04_r8 /) + kao(:, 3,10, 7) = (/ & + & 0.11756e+04_r8,0.10345e+04_r8,0.89339e+03_r8,0.75225e+03_r8,0.61189e+03_r8, & + & 0.69293e+03_r8,0.81942e+03_r8,0.94719e+03_r8,0.10754e+04_r8 /) + kao(:, 4,10, 7) = (/ & + & 0.11639e+04_r8,0.10243e+04_r8,0.88463e+03_r8,0.74495e+03_r8,0.60683e+03_r8, & + & 0.69260e+03_r8,0.81922e+03_r8,0.94698e+03_r8,0.10753e+04_r8 /) + kao(:, 5,10, 7) = (/ & + & 0.11536e+04_r8,0.10153e+04_r8,0.87693e+03_r8,0.73853e+03_r8,0.60268e+03_r8, & + & 0.69203e+03_r8,0.81871e+03_r8,0.94653e+03_r8,0.10749e+04_r8 /) + kao(:, 1,11, 7) = (/ & + & 0.11668e+04_r8,0.10268e+04_r8,0.88684e+03_r8,0.74678e+03_r8,0.60837e+03_r8, & + & 0.69208e+03_r8,0.81864e+03_r8,0.94642e+03_r8,0.10746e+04_r8 /) + kao(:, 2,11, 7) = (/ & + & 0.11540e+04_r8,0.10157e+04_r8,0.87724e+03_r8,0.73879e+03_r8,0.60335e+03_r8, & + & 0.69229e+03_r8,0.81896e+03_r8,0.94691e+03_r8,0.10752e+04_r8 /) + kao(:, 3,11, 7) = (/ & + & 0.11430e+04_r8,0.10060e+04_r8,0.86898e+03_r8,0.73191e+03_r8,0.59939e+03_r8, & + & 0.69226e+03_r8,0.81904e+03_r8,0.94700e+03_r8,0.10754e+04_r8 /) + kao(:, 4,11, 7) = (/ & + & 0.11335e+04_r8,0.99764e+03_r8,0.86180e+03_r8,0.72592e+03_r8,0.59585e+03_r8, & + & 0.69198e+03_r8,0.81884e+03_r8,0.94679e+03_r8,0.10753e+04_r8 /) + kao(:, 5,11, 7) = (/ & + & 0.11251e+04_r8,0.99028e+03_r8,0.85549e+03_r8,0.72067e+03_r8,0.59286e+03_r8, & + & 0.69146e+03_r8,0.81839e+03_r8,0.94639e+03_r8,0.10749e+04_r8 /) + kao(:, 1,12, 7) = (/ & + & 0.11358e+04_r8,0.99970e+03_r8,0.86357e+03_r8,0.72739e+03_r8,0.59707e+03_r8, & + & 0.69145e+03_r8,0.81829e+03_r8,0.94626e+03_r8,0.10746e+04_r8 /) + kao(:, 2,12, 7) = (/ & + & 0.11253e+04_r8,0.99054e+03_r8,0.85571e+03_r8,0.72085e+03_r8,0.59339e+03_r8, & + & 0.69172e+03_r8,0.81863e+03_r8,0.94675e+03_r8,0.10752e+04_r8 /) + kao(:, 3,12, 7) = (/ & + & 0.11163e+04_r8,0.98265e+03_r8,0.84895e+03_r8,0.71521e+03_r8,0.59030e+03_r8, & + & 0.69172e+03_r8,0.81873e+03_r8,0.94686e+03_r8,0.10754e+04_r8 /) + kao(:, 4,12, 7) = (/ & + & 0.11085e+04_r8,0.97579e+03_r8,0.84307e+03_r8,0.71031e+03_r8,0.58782e+03_r8, & + & 0.69148e+03_r8,0.81855e+03_r8,0.94672e+03_r8,0.10753e+04_r8 /) + kao(:, 5,12, 7) = (/ & + & 0.11016e+04_r8,0.96977e+03_r8,0.83790e+03_r8,0.70601e+03_r8,0.58538e+03_r8, & + & 0.69099e+03_r8,0.81812e+03_r8,0.94628e+03_r8,0.10749e+04_r8 /) + kao(:, 1,13, 7) = (/ & + & 0.11104e+04_r8,0.97748e+03_r8,0.84452e+03_r8,0.71152e+03_r8,0.58852e+03_r8, & + & 0.69093e+03_r8,0.81799e+03_r8,0.94612e+03_r8,0.10746e+04_r8 /) + kao(:, 2,13, 7) = (/ & + & 0.11018e+04_r8,0.96998e+03_r8,0.83809e+03_r8,0.70616e+03_r8,0.58570e+03_r8, & + & 0.69123e+03_r8,0.81841e+03_r8,0.94664e+03_r8,0.10752e+04_r8 /) + kao(:, 3,13, 7) = (/ & + & 0.10945e+04_r8,0.96352e+03_r8,0.83255e+03_r8,0.70155e+03_r8,0.58307e+03_r8, & + & 0.69128e+03_r8,0.81849e+03_r8,0.94675e+03_r8,0.10754e+04_r8 /) + kao(:, 4,13, 7) = (/ & + & 0.10880e+04_r8,0.95790e+03_r8,0.82774e+03_r8,0.69753e+03_r8,0.58045e+03_r8, & + & 0.69107e+03_r8,0.81832e+03_r8,0.94657e+03_r8,0.10753e+04_r8 /) + kao(:, 5,13, 7) = (/ & + & 0.10824e+04_r8,0.95297e+03_r8,0.82351e+03_r8,0.69401e+03_r8,0.57806e+03_r8, & + & 0.69061e+03_r8,0.81788e+03_r8,0.94614e+03_r8,0.10749e+04_r8 /) + kao(:, 1, 1, 8) = (/ & + & 0.19433e+04_r8,0.17047e+04_r8,0.14661e+04_r8,0.12275e+04_r8,0.98902e+03_r8, & + & 0.75120e+03_r8,0.85754e+03_r8,0.98845e+03_r8,0.11206e+04_r8 /) + kao(:, 2, 1, 8) = (/ & + & 0.18941e+04_r8,0.16616e+04_r8,0.14292e+04_r8,0.11968e+04_r8,0.96439e+03_r8, & + & 0.73548e+03_r8,0.85594e+03_r8,0.98707e+03_r8,0.11193e+04_r8 /) + kao(:, 3, 1, 8) = (/ & + & 0.18499e+04_r8,0.16229e+04_r8,0.13960e+04_r8,0.11691e+04_r8,0.94229e+03_r8, & + & 0.72448e+03_r8,0.85413e+03_r8,0.98549e+03_r8,0.11177e+04_r8 /) + kao(:, 4, 1, 8) = (/ & + & 0.18099e+04_r8,0.15880e+04_r8,0.13661e+04_r8,0.11442e+04_r8,0.92233e+03_r8, & + & 0.72225e+03_r8,0.85214e+03_r8,0.98373e+03_r8,0.11158e+04_r8 /) + kao(:, 5, 1, 8) = (/ & + & 0.17737e+04_r8,0.15563e+04_r8,0.13389e+04_r8,0.11215e+04_r8,0.90421e+03_r8, & + & 0.72001e+03_r8,0.85005e+03_r8,0.98175e+03_r8,0.11138e+04_r8 /) + kao(:, 1, 2, 8) = (/ & + & 0.17953e+04_r8,0.15751e+04_r8,0.13551e+04_r8,0.11350e+04_r8,0.91499e+03_r8, & + & 0.72569e+03_r8,0.85649e+03_r8,0.98821e+03_r8,0.11210e+04_r8 /) + kao(:, 2, 2, 8) = (/ & + & 0.17530e+04_r8,0.15382e+04_r8,0.13234e+04_r8,0.11086e+04_r8,0.89388e+03_r8, & + & 0.72424e+03_r8,0.85509e+03_r8,0.98698e+03_r8,0.11198e+04_r8 /) + kao(:, 3, 2, 8) = (/ & + & 0.17152e+04_r8,0.15051e+04_r8,0.12950e+04_r8,0.10850e+04_r8,0.87497e+03_r8, & + & 0.72267e+03_r8,0.85348e+03_r8,0.98553e+03_r8,0.11184e+04_r8 /) + kao(:, 4, 2, 8) = (/ & + & 0.16811e+04_r8,0.14753e+04_r8,0.12695e+04_r8,0.10637e+04_r8,0.85793e+03_r8, & + & 0.72084e+03_r8,0.85163e+03_r8,0.98389e+03_r8,0.11166e+04_r8 /) + kao(:, 5, 2, 8) = (/ & + & 0.16502e+04_r8,0.14483e+04_r8,0.12463e+04_r8,0.10444e+04_r8,0.84250e+03_r8, & + & 0.71877e+03_r8,0.84969e+03_r8,0.98204e+03_r8,0.11147e+04_r8 /) + kao(:, 1, 3, 8) = (/ & + & 0.16788e+04_r8,0.14733e+04_r8,0.12678e+04_r8,0.10623e+04_r8,0.85679e+03_r8, & + & 0.72434e+03_r8,0.85588e+03_r8,0.98822e+03_r8,0.11216e+04_r8 /) + kao(:, 2, 3, 8) = (/ & + & 0.16418e+04_r8,0.14409e+04_r8,0.12400e+04_r8,0.10391e+04_r8,0.83827e+03_r8, & + & 0.72306e+03_r8,0.85466e+03_r8,0.98716e+03_r8,0.11206e+04_r8 /) + kao(:, 3, 3, 8) = (/ & + & 0.16087e+04_r8,0.14119e+04_r8,0.12152e+04_r8,0.10184e+04_r8,0.82172e+03_r8, & + & 0.72165e+03_r8,0.85327e+03_r8,0.98590e+03_r8,0.11193e+04_r8 /) + kao(:, 4, 3, 8) = (/ & + & 0.15790e+04_r8,0.13859e+04_r8,0.11929e+04_r8,0.99988e+03_r8,0.80688e+03_r8, & + & 0.72007e+03_r8,0.85161e+03_r8,0.98438e+03_r8,0.11177e+04_r8 /) + kao(:, 5, 3, 8) = (/ & + & 0.15522e+04_r8,0.13625e+04_r8,0.11728e+04_r8,0.98311e+03_r8,0.79349e+03_r8, & + & 0.71824e+03_r8,0.84982e+03_r8,0.98270e+03_r8,0.11159e+04_r8 /) + kao(:, 1, 4, 8) = (/ & + & 0.15823e+04_r8,0.13888e+04_r8,0.11953e+04_r8,0.10019e+04_r8,0.80851e+03_r8, & + & 0.72326e+03_r8,0.85540e+03_r8,0.98823e+03_r8,0.11221e+04_r8 /) + kao(:, 2, 4, 8) = (/ & + & 0.15495e+04_r8,0.13601e+04_r8,0.11708e+04_r8,0.98142e+03_r8,0.79213e+03_r8, & + & 0.72214e+03_r8,0.85436e+03_r8,0.98737e+03_r8,0.11213e+04_r8 /) + kao(:, 3, 4, 8) = (/ & + & 0.15204e+04_r8,0.13346e+04_r8,0.11489e+04_r8,0.96322e+03_r8,0.77758e+03_r8, & + & 0.72091e+03_r8,0.85317e+03_r8,0.98628e+03_r8,0.11202e+04_r8 /) + kao(:, 4, 4, 8) = (/ & + & 0.14943e+04_r8,0.13118e+04_r8,0.11294e+04_r8,0.94694e+03_r8,0.76455e+03_r8, & + & 0.71952e+03_r8,0.85175e+03_r8,0.98496e+03_r8,0.11188e+04_r8 /) + kao(:, 5, 4, 8) = (/ & + & 0.14709e+04_r8,0.12913e+04_r8,0.11118e+04_r8,0.93229e+03_r8,0.75284e+03_r8, & + & 0.71792e+03_r8,0.85010e+03_r8,0.98342e+03_r8,0.11171e+04_r8 /) + kao(:, 1, 5, 8) = (/ & + & 0.15002e+04_r8,0.13170e+04_r8,0.11338e+04_r8,0.95063e+03_r8,0.76749e+03_r8, & + & 0.72234e+03_r8,0.85495e+03_r8,0.98821e+03_r8,0.11224e+04_r8 /) + kao(:, 2, 5, 8) = (/ & + & 0.14712e+04_r8,0.12916e+04_r8,0.11120e+04_r8,0.93250e+03_r8,0.75300e+03_r8, & + & 0.72139e+03_r8,0.85409e+03_r8,0.98753e+03_r8,0.11218e+04_r8 /) + kao(:, 3, 5, 8) = (/ & + & 0.14456e+04_r8,0.12692e+04_r8,0.10928e+04_r8,0.91647e+03_r8,0.74017e+03_r8, & + & 0.72031e+03_r8,0.85307e+03_r8,0.98657e+03_r8,0.11209e+04_r8 /) + kao(:, 4, 5, 8) = (/ & + & 0.14227e+04_r8,0.12492e+04_r8,0.10757e+04_r8,0.90219e+03_r8,0.72875e+03_r8, & + & 0.71909e+03_r8,0.85186e+03_r8,0.98546e+03_r8,0.11197e+04_r8 /) + kao(:, 5, 5, 8) = (/ & + & 0.14022e+04_r8,0.12312e+04_r8,0.10603e+04_r8,0.88937e+03_r8,0.71851e+03_r8, & + & 0.71769e+03_r8,0.85037e+03_r8,0.98406e+03_r8,0.11182e+04_r8 /) + kao(:, 1, 6, 8) = (/ & + & 0.14314e+04_r8,0.12568e+04_r8,0.10822e+04_r8,0.90763e+03_r8,0.73310e+03_r8, & + & 0.72155e+03_r8,0.85452e+03_r8,0.98813e+03_r8,0.11226e+04_r8 /) + kao(:, 2, 6, 8) = (/ & + & 0.14056e+04_r8,0.12342e+04_r8,0.10628e+04_r8,0.89150e+03_r8,0.72020e+03_r8, & + & 0.72077e+03_r8,0.85386e+03_r8,0.98765e+03_r8,0.11222e+04_r8 /) + kao(:, 3, 6, 8) = (/ & + & 0.13829e+04_r8,0.12143e+04_r8,0.10458e+04_r8,0.87730e+03_r8,0.70887e+03_r8, & + & 0.71986e+03_r8,0.85300e+03_r8,0.98688e+03_r8,0.11215e+04_r8 /) + kao(:, 4, 6, 8) = (/ & + & 0.13627e+04_r8,0.11967e+04_r8,0.10307e+04_r8,0.86473e+03_r8,0.69880e+03_r8, & + & 0.71879e+03_r8,0.85197e+03_r8,0.98590e+03_r8,0.11205e+04_r8 /) + kao(:, 5, 6, 8) = (/ & + & 0.13448e+04_r8,0.11810e+04_r8,0.10172e+04_r8,0.85348e+03_r8,0.68979e+03_r8, & + & 0.71757e+03_r8,0.85073e+03_r8,0.98469e+03_r8,0.11192e+04_r8 /) + kao(:, 1, 7, 8) = (/ & + & 0.13728e+04_r8,0.12055e+04_r8,0.10383e+04_r8,0.87102e+03_r8,0.70382e+03_r8, & + & 0.72081e+03_r8,0.85410e+03_r8,0.98799e+03_r8,0.11227e+04_r8 /) + kao(:, 2, 7, 8) = (/ & + & 0.13499e+04_r8,0.11854e+04_r8,0.10210e+04_r8,0.85666e+03_r8,0.69233e+03_r8, & + & 0.72022e+03_r8,0.85362e+03_r8,0.98768e+03_r8,0.11225e+04_r8 /) + kao(:, 3, 7, 8) = (/ & + & 0.13297e+04_r8,0.11678e+04_r8,0.10059e+04_r8,0.84408e+03_r8,0.68228e+03_r8, & + & 0.71945e+03_r8,0.85293e+03_r8,0.98711e+03_r8,0.11220e+04_r8 /) + kao(:, 4, 7, 8) = (/ & + & 0.13120e+04_r8,0.11523e+04_r8,0.99261e+03_r8,0.83298e+03_r8,0.67339e+03_r8, & + & 0.71854e+03_r8,0.85205e+03_r8,0.98632e+03_r8,0.11212e+04_r8 /) + kao(:, 5, 7, 8) = (/ & + & 0.12962e+04_r8,0.11384e+04_r8,0.98077e+03_r8,0.82312e+03_r8,0.66550e+03_r8, & + & 0.71746e+03_r8,0.85098e+03_r8,0.98523e+03_r8,0.11200e+04_r8 /) + kao(:, 1, 8, 8) = (/ & + & 0.13227e+04_r8,0.11617e+04_r8,0.10007e+04_r8,0.83971e+03_r8,0.67877e+03_r8, & + & 0.72007e+03_r8,0.85366e+03_r8,0.98779e+03_r8,0.11227e+04_r8 /) + kao(:, 2, 8, 8) = (/ & + & 0.13022e+04_r8,0.11438e+04_r8,0.98533e+03_r8,0.82690e+03_r8,0.66854e+03_r8, & + & 0.71969e+03_r8,0.85334e+03_r8,0.98763e+03_r8,0.11227e+04_r8 /) + kao(:, 3, 8, 8) = (/ & + & 0.12844e+04_r8,0.11282e+04_r8,0.97196e+03_r8,0.81577e+03_r8,0.65963e+03_r8, & + & 0.71908e+03_r8,0.85283e+03_r8,0.98717e+03_r8,0.11223e+04_r8 /) + kao(:, 4, 8, 8) = (/ & + & 0.12688e+04_r8,0.11145e+04_r8,0.96023e+03_r8,0.80599e+03_r8,0.65182e+03_r8, & + & 0.71830e+03_r8,0.85210e+03_r8,0.98659e+03_r8,0.11217e+04_r8 /) + kao(:, 5, 8, 8) = (/ & + & 0.12549e+04_r8,0.11024e+04_r8,0.94982e+03_r8,0.79733e+03_r8,0.64488e+03_r8, & + & 0.71736e+03_r8,0.85118e+03_r8,0.98569e+03_r8,0.11208e+04_r8 /) + kao(:, 1, 9, 8) = (/ & + & 0.12800e+04_r8,0.11244e+04_r8,0.96868e+03_r8,0.81302e+03_r8,0.65744e+03_r8, & + & 0.71936e+03_r8,0.85323e+03_r8,0.98761e+03_r8,0.11226e+04_r8 /) + kao(:, 2, 9, 8) = (/ & + & 0.12618e+04_r8,0.11084e+04_r8,0.95498e+03_r8,0.80161e+03_r8,0.64832e+03_r8, & + & 0.71916e+03_r8,0.85306e+03_r8,0.98751e+03_r8,0.11227e+04_r8 /) + kao(:, 3, 9, 8) = (/ & + & 0.12460e+04_r8,0.10945e+04_r8,0.94313e+03_r8,0.79175e+03_r8,0.64042e+03_r8, & + & 0.71874e+03_r8,0.85269e+03_r8,0.98731e+03_r8,0.11226e+04_r8 /) + kao(:, 4, 9, 8) = (/ & + & 0.12322e+04_r8,0.10825e+04_r8,0.93277e+03_r8,0.78311e+03_r8,0.63351e+03_r8, & + & 0.71809e+03_r8,0.85213e+03_r8,0.98681e+03_r8,0.11221e+04_r8 /) + kao(:, 5, 9, 8) = (/ & + & 0.12200e+04_r8,0.10718e+04_r8,0.92365e+03_r8,0.77552e+03_r8,0.62743e+03_r8, & + & 0.71728e+03_r8,0.85134e+03_r8,0.98607e+03_r8,0.11214e+04_r8 /) + kao(:, 1,10, 8) = (/ & + & 0.12423e+04_r8,0.10913e+04_r8,0.94034e+03_r8,0.78942e+03_r8,0.63856e+03_r8, & + & 0.71867e+03_r8,0.85279e+03_r8,0.98738e+03_r8,0.11225e+04_r8 /) + kao(:, 2,10, 8) = (/ & + & 0.12262e+04_r8,0.10772e+04_r8,0.92827e+03_r8,0.77936e+03_r8,0.63052e+03_r8, & + & 0.71863e+03_r8,0.85274e+03_r8,0.98738e+03_r8,0.11227e+04_r8 /) + kao(:, 3,10, 8) = (/ & + & 0.12123e+04_r8,0.10651e+04_r8,0.91788e+03_r8,0.77071e+03_r8,0.62359e+03_r8, & + & 0.71835e+03_r8,0.85251e+03_r8,0.98725e+03_r8,0.11227e+04_r8 /) + kao(:, 4,10, 8) = (/ & + & 0.12002e+04_r8,0.10545e+04_r8,0.90884e+03_r8,0.76317e+03_r8,0.61756e+03_r8, & + & 0.71785e+03_r8,0.85203e+03_r8,0.98691e+03_r8,0.11224e+04_r8 /) + kao(:, 5,10, 8) = (/ & + & 0.11897e+04_r8,0.10453e+04_r8,0.90090e+03_r8,0.75655e+03_r8,0.61227e+03_r8, & + & 0.71716e+03_r8,0.85141e+03_r8,0.98631e+03_r8,0.11218e+04_r8 /) + kao(:, 1,11, 8) = (/ & + & 0.12033e+04_r8,0.10572e+04_r8,0.91110e+03_r8,0.76506e+03_r8,0.61908e+03_r8, & + & 0.71809e+03_r8,0.85242e+03_r8,0.98721e+03_r8,0.11225e+04_r8 /) + kao(:, 2,11, 8) = (/ & + & 0.11901e+04_r8,0.10456e+04_r8,0.90123e+03_r8,0.75682e+03_r8,0.61248e+03_r8, & + & 0.71809e+03_r8,0.85240e+03_r8,0.98723e+03_r8,0.11226e+04_r8 /) + kao(:, 3,11, 8) = (/ & + & 0.11788e+04_r8,0.10357e+04_r8,0.89271e+03_r8,0.74972e+03_r8,0.60692e+03_r8, & + & 0.71785e+03_r8,0.85217e+03_r8,0.98712e+03_r8,0.11227e+04_r8 /) + kao(:, 4,11, 8) = (/ & + & 0.11689e+04_r8,0.10271e+04_r8,0.88529e+03_r8,0.74355e+03_r8,0.60253e+03_r8, & + & 0.71738e+03_r8,0.85177e+03_r8,0.98681e+03_r8,0.11224e+04_r8 /) + kao(:, 5,11, 8) = (/ & + & 0.11602e+04_r8,0.10195e+04_r8,0.87880e+03_r8,0.73813e+03_r8,0.59855e+03_r8, & + & 0.71672e+03_r8,0.85114e+03_r8,0.98618e+03_r8,0.11218e+04_r8 /) + kao(:, 1,12, 8) = (/ & + & 0.11713e+04_r8,0.10292e+04_r8,0.88712e+03_r8,0.74507e+03_r8,0.60379e+03_r8, & + & 0.71766e+03_r8,0.85212e+03_r8,0.98706e+03_r8,0.11225e+04_r8 /) + kao(:, 2,12, 8) = (/ & + & 0.11605e+04_r8,0.10197e+04_r8,0.87902e+03_r8,0.73833e+03_r8,0.59891e+03_r8, & + & 0.71764e+03_r8,0.85212e+03_r8,0.98710e+03_r8,0.11227e+04_r8 /) + kao(:, 3,12, 8) = (/ & + & 0.11512e+04_r8,0.10116e+04_r8,0.87205e+03_r8,0.73251e+03_r8,0.59502e+03_r8, & + & 0.71744e+03_r8,0.85192e+03_r8,0.98700e+03_r8,0.11227e+04_r8 /) + kao(:, 4,12, 8) = (/ & + & 0.11431e+04_r8,0.10045e+04_r8,0.86598e+03_r8,0.72746e+03_r8,0.59151e+03_r8, & + & 0.71699e+03_r8,0.85153e+03_r8,0.98663e+03_r8,0.11224e+04_r8 /) + kao(:, 5,12, 8) = (/ & + & 0.11360e+04_r8,0.99832e+03_r8,0.86067e+03_r8,0.72302e+03_r8,0.58868e+03_r8, & + & 0.71636e+03_r8,0.85092e+03_r8,0.98606e+03_r8,0.11218e+04_r8 /) + kao(:, 1,13, 8) = (/ & + & 0.11451e+04_r8,0.10063e+04_r8,0.86748e+03_r8,0.72871e+03_r8,0.59258e+03_r8, & + & 0.71726e+03_r8,0.85187e+03_r8,0.98696e+03_r8,0.11225e+04_r8 /) + kao(:, 2,13, 8) = (/ & + & 0.11363e+04_r8,0.99855e+03_r8,0.86085e+03_r8,0.72320e+03_r8,0.58896e+03_r8, & + & 0.71729e+03_r8,0.85183e+03_r8,0.98699e+03_r8,0.11227e+04_r8 /) + kao(:, 3,13, 8) = (/ & + & 0.11287e+04_r8,0.99189e+03_r8,0.85515e+03_r8,0.71842e+03_r8,0.58585e+03_r8, & + & 0.71710e+03_r8,0.85169e+03_r8,0.98691e+03_r8,0.11227e+04_r8 /) + kao(:, 4,13, 8) = (/ & + & 0.11220e+04_r8,0.98609e+03_r8,0.85017e+03_r8,0.71429e+03_r8,0.58380e+03_r8, & + & 0.71668e+03_r8,0.85133e+03_r8,0.98660e+03_r8,0.11224e+04_r8 /) + kao(:, 5,13, 8) = (/ & + & 0.11162e+04_r8,0.98101e+03_r8,0.84582e+03_r8,0.71065e+03_r8,0.58234e+03_r8, & + & 0.71606e+03_r8,0.85074e+03_r8,0.98601e+03_r8,0.11218e+04_r8 /) + kao(:, 1, 1, 9) = (/ & + & 0.19571e+04_r8,0.17167e+04_r8,0.14761e+04_r8,0.12357e+04_r8,0.99528e+03_r8, & + & 0.75488e+03_r8,0.87315e+03_r8,0.10086e+04_r8,0.11441e+04_r8 /) + kao(:, 2, 1, 9) = (/ & + & 0.19076e+04_r8,0.16733e+04_r8,0.14390e+04_r8,0.12047e+04_r8,0.97044e+03_r8, & + & 0.73841e+03_r8,0.87146e+03_r8,0.10070e+04_r8,0.11425e+04_r8 /) + kao(:, 3, 1, 9) = (/ & + & 0.18630e+04_r8,0.16343e+04_r8,0.14056e+04_r8,0.11769e+04_r8,0.94822e+03_r8, & + & 0.73460e+03_r8,0.86967e+03_r8,0.10052e+04_r8,0.11407e+04_r8 /) + kao(:, 4, 1, 9) = (/ & + & 0.18229e+04_r8,0.15991e+04_r8,0.13754e+04_r8,0.11517e+04_r8,0.92811e+03_r8, & + & 0.73269e+03_r8,0.86788e+03_r8,0.10033e+04_r8,0.11387e+04_r8 /) + kao(:, 5, 1, 9) = (/ & + & 0.17864e+04_r8,0.15672e+04_r8,0.13481e+04_r8,0.11289e+04_r8,0.90984e+03_r8, & + & 0.73091e+03_r8,0.86616e+03_r8,0.10016e+04_r8,0.11368e+04_r8 /) + kao(:, 1, 2, 9) = (/ & + & 0.18080e+04_r8,0.15862e+04_r8,0.13643e+04_r8,0.11425e+04_r8,0.92072e+03_r8, & + & 0.73694e+03_r8,0.87246e+03_r8,0.10086e+04_r8,0.11448e+04_r8 /) + kao(:, 2, 2, 9) = (/ & + & 0.17655e+04_r8,0.15491e+04_r8,0.13324e+04_r8,0.11159e+04_r8,0.89943e+03_r8, & + & 0.73525e+03_r8,0.87092e+03_r8,0.10070e+04_r8,0.11432e+04_r8 /) + kao(:, 3, 2, 9) = (/ & + & 0.17274e+04_r8,0.15157e+04_r8,0.13039e+04_r8,0.10921e+04_r8,0.88039e+03_r8, & + & 0.73343e+03_r8,0.86922e+03_r8,0.10053e+04_r8,0.11415e+04_r8 /) + kao(:, 4, 2, 9) = (/ & + & 0.16931e+04_r8,0.14856e+04_r8,0.12781e+04_r8,0.10706e+04_r8,0.86326e+03_r8, & + & 0.73166e+03_r8,0.86752e+03_r8,0.10036e+04_r8,0.11395e+04_r8 /) + kao(:, 5, 2, 9) = (/ & + & 0.16621e+04_r8,0.14584e+04_r8,0.12549e+04_r8,0.10512e+04_r8,0.84768e+03_r8, & + & 0.73000e+03_r8,0.86583e+03_r8,0.10018e+04_r8,0.11376e+04_r8 /) + kao(:, 1, 3, 9) = (/ & + & 0.16908e+04_r8,0.14837e+04_r8,0.12764e+04_r8,0.10692e+04_r8,0.86209e+03_r8, & + & 0.73591e+03_r8,0.87213e+03_r8,0.10088e+04_r8,0.11456e+04_r8 /) + kao(:, 2, 3, 9) = (/ & + & 0.16535e+04_r8,0.14509e+04_r8,0.12484e+04_r8,0.10459e+04_r8,0.84339e+03_r8, & + & 0.73450e+03_r8,0.87080e+03_r8,0.10075e+04_r8,0.11442e+04_r8 /) + kao(:, 3, 3, 9) = (/ & + & 0.16202e+04_r8,0.14218e+04_r8,0.12234e+04_r8,0.10251e+04_r8,0.82680e+03_r8, & + & 0.73291e+03_r8,0.86926e+03_r8,0.10059e+04_r8,0.11426e+04_r8 /) + kao(:, 4, 3, 9) = (/ & + & 0.15902e+04_r8,0.13956e+04_r8,0.12011e+04_r8,0.10064e+04_r8,0.81183e+03_r8, & + & 0.73120e+03_r8,0.86761e+03_r8,0.10042e+04_r8,0.11407e+04_r8 /) + kao(:, 5, 3, 9) = (/ & + & 0.15632e+04_r8,0.13720e+04_r8,0.11808e+04_r8,0.98952e+03_r8,0.79832e+03_r8, & + & 0.72957e+03_r8,0.86594e+03_r8,0.10024e+04_r8,0.11387e+04_r8 /) + kao(:, 1, 4, 9) = (/ & + & 0.15935e+04_r8,0.13985e+04_r8,0.12035e+04_r8,0.10084e+04_r8,0.81344e+03_r8, & + & 0.73513e+03_r8,0.87195e+03_r8,0.10092e+04_r8,0.11463e+04_r8 /) + kao(:, 2, 4, 9) = (/ & + & 0.15605e+04_r8,0.13697e+04_r8,0.11787e+04_r8,0.98782e+03_r8,0.79694e+03_r8, & + & 0.73394e+03_r8,0.87080e+03_r8,0.10079e+04_r8,0.11451e+04_r8 /) + kao(:, 3, 4, 9) = (/ & + & 0.15313e+04_r8,0.13439e+04_r8,0.11567e+04_r8,0.96950e+03_r8,0.78229e+03_r8, & + & 0.73257e+03_r8,0.86942e+03_r8,0.10065e+04_r8,0.11436e+04_r8 /) + kao(:, 4, 4, 9) = (/ & + & 0.15050e+04_r8,0.13210e+04_r8,0.11371e+04_r8,0.95308e+03_r8,0.76922e+03_r8, & + & 0.73104e+03_r8,0.86787e+03_r8,0.10049e+04_r8,0.11419e+04_r8 /) + kao(:, 5, 4, 9) = (/ & + & 0.14814e+04_r8,0.13003e+04_r8,0.11193e+04_r8,0.93833e+03_r8,0.75745e+03_r8, & + & 0.72946e+03_r8,0.86622e+03_r8,0.10032e+04_r8,0.11400e+04_r8 /) + kao(:, 1, 5, 9) = (/ & + & 0.15109e+04_r8,0.13262e+04_r8,0.11415e+04_r8,0.95685e+03_r8,0.77217e+03_r8, & + & 0.73443e+03_r8,0.87177e+03_r8,0.10094e+04_r8,0.11470e+04_r8 /) + kao(:, 2, 5, 9) = (/ & + & 0.14817e+04_r8,0.13007e+04_r8,0.11196e+04_r8,0.93852e+03_r8,0.75755e+03_r8, & + & 0.73343e+03_r8,0.87078e+03_r8,0.10083e+04_r8,0.11459e+04_r8 /) + kao(:, 3, 5, 9) = (/ & + & 0.14559e+04_r8,0.12780e+04_r8,0.11003e+04_r8,0.92240e+03_r8,0.74463e+03_r8, & + & 0.73229e+03_r8,0.86958e+03_r8,0.10071e+04_r8,0.11446e+04_r8 /) + kao(:, 4, 5, 9) = (/ & + & 0.14329e+04_r8,0.12579e+04_r8,0.10829e+04_r8,0.90802e+03_r8,0.73310e+03_r8, & + & 0.73095e+03_r8,0.86817e+03_r8,0.10056e+04_r8,0.11430e+04_r8 /) + kao(:, 5, 5, 9) = (/ & + & 0.14122e+04_r8,0.12398e+04_r8,0.10675e+04_r8,0.89511e+03_r8,0.72281e+03_r8, & + & 0.72946e+03_r8,0.86664e+03_r8,0.10039e+04_r8,0.11412e+04_r8 /) + kao(:, 1, 6, 9) = (/ & + & 0.14417e+04_r8,0.12655e+04_r8,0.10896e+04_r8,0.91348e+03_r8,0.73747e+03_r8, & + & 0.73386e+03_r8,0.87165e+03_r8,0.10096e+04_r8,0.11475e+04_r8 /) + kao(:, 2, 6, 9) = (/ & + & 0.14156e+04_r8,0.12429e+04_r8,0.10700e+04_r8,0.89725e+03_r8,0.72457e+03_r8, & + & 0.73304e+03_r8,0.87078e+03_r8,0.10087e+04_r8,0.11466e+04_r8 /) + kao(:, 3, 6, 9) = (/ & + & 0.13928e+04_r8,0.12228e+04_r8,0.10529e+04_r8,0.88300e+03_r8,0.71308e+03_r8, & + & 0.73207e+03_r8,0.86977e+03_r8,0.10076e+04_r8,0.11455e+04_r8 /) + kao(:, 4, 6, 9) = (/ & + & 0.13725e+04_r8,0.12051e+04_r8,0.10377e+04_r8,0.87029e+03_r8,0.70290e+03_r8, & + & 0.73093e+03_r8,0.86853e+03_r8,0.10063e+04_r8,0.11441e+04_r8 /) + kao(:, 5, 6, 9) = (/ & + & 0.13544e+04_r8,0.11892e+04_r8,0.10241e+04_r8,0.85897e+03_r8,0.69390e+03_r8, & + & 0.72961e+03_r8,0.86706e+03_r8,0.10048e+04_r8,0.11424e+04_r8 /) + kao(:, 1, 7, 9) = (/ & + & 0.13826e+04_r8,0.12140e+04_r8,0.10453e+04_r8,0.87664e+03_r8,0.70803e+03_r8, & + & 0.73339e+03_r8,0.87155e+03_r8,0.10098e+04_r8,0.11480e+04_r8 /) + kao(:, 2, 7, 9) = (/ & + & 0.13594e+04_r8,0.11937e+04_r8,0.10279e+04_r8,0.86216e+03_r8,0.69645e+03_r8, & + & 0.73269e+03_r8,0.87079e+03_r8,0.10090e+04_r8,0.11472e+04_r8 /) + kao(:, 3, 7, 9) = (/ & + & 0.13392e+04_r8,0.11759e+04_r8,0.10127e+04_r8,0.84953e+03_r8,0.68632e+03_r8, & + & 0.73188e+03_r8,0.86990e+03_r8,0.10081e+04_r8,0.11462e+04_r8 /) + kao(:, 4, 7, 9) = (/ & + & 0.13213e+04_r8,0.11603e+04_r8,0.99928e+03_r8,0.83829e+03_r8,0.67737e+03_r8, & + & 0.73090e+03_r8,0.86884e+03_r8,0.10069e+04_r8,0.11450e+04_r8 /) + kao(:, 5, 7, 9) = (/ & + & 0.13054e+04_r8,0.11464e+04_r8,0.98739e+03_r8,0.82837e+03_r8,0.66946e+03_r8, & + & 0.72975e+03_r8,0.86756e+03_r8,0.10055e+04_r8,0.11435e+04_r8 /) + kao(:, 1, 8, 9) = (/ & + & 0.13322e+04_r8,0.11698e+04_r8,0.10074e+04_r8,0.84511e+03_r8,0.68280e+03_r8, & + & 0.73302e+03_r8,0.87145e+03_r8,0.10099e+04_r8,0.11483e+04_r8 /) + kao(:, 2, 8, 9) = (/ & + & 0.13116e+04_r8,0.11517e+04_r8,0.99199e+03_r8,0.83221e+03_r8,0.67250e+03_r8, & + & 0.73244e+03_r8,0.87079e+03_r8,0.10093e+04_r8,0.11477e+04_r8 /) + kao(:, 3, 8, 9) = (/ & + & 0.12937e+04_r8,0.11360e+04_r8,0.97848e+03_r8,0.82097e+03_r8,0.66349e+03_r8, & + & 0.73170e+03_r8,0.87002e+03_r8,0.10085e+04_r8,0.11469e+04_r8 /) + kao(:, 4, 8, 9) = (/ & + & 0.12778e+04_r8,0.11223e+04_r8,0.96666e+03_r8,0.81113e+03_r8,0.65562e+03_r8, & + & 0.73087e+03_r8,0.86909e+03_r8,0.10075e+04_r8,0.11458e+04_r8 /) + kao(:, 5, 8, 9) = (/ & + & 0.12639e+04_r8,0.11101e+04_r8,0.95620e+03_r8,0.80244e+03_r8,0.64865e+03_r8, & + & 0.72985e+03_r8,0.86796e+03_r8,0.10062e+04_r8,0.11444e+04_r8 /) + kao(:, 1, 9, 9) = (/ & + & 0.12892e+04_r8,0.11322e+04_r8,0.97520e+03_r8,0.81821e+03_r8,0.66134e+03_r8, & + & 0.73274e+03_r8,0.87135e+03_r8,0.10099e+04_r8,0.11485e+04_r8 /) + kao(:, 2, 9, 9) = (/ & + & 0.12708e+04_r8,0.11161e+04_r8,0.96140e+03_r8,0.80674e+03_r8,0.65213e+03_r8, & + & 0.73213e+03_r8,0.87079e+03_r8,0.10095e+04_r8,0.11481e+04_r8 /) + kao(:, 3, 9, 9) = (/ & + & 0.12548e+04_r8,0.11022e+04_r8,0.94949e+03_r8,0.79681e+03_r8,0.64421e+03_r8, & + & 0.73152e+03_r8,0.87011e+03_r8,0.10088e+04_r8,0.11474e+04_r8 /) + kao(:, 4, 9, 9) = (/ & + & 0.12410e+04_r8,0.10900e+04_r8,0.93905e+03_r8,0.78808e+03_r8,0.63726e+03_r8, & + & 0.73083e+03_r8,0.86928e+03_r8,0.10079e+04_r8,0.11464e+04_r8 /) + kao(:, 5, 9, 9) = (/ & + & 0.12287e+04_r8,0.10793e+04_r8,0.92981e+03_r8,0.78042e+03_r8,0.63106e+03_r8, & + & 0.72995e+03_r8,0.86831e+03_r8,0.10068e+04_r8,0.11452e+04_r8 /) + kao(:, 1,10, 9) = (/ & + & 0.12511e+04_r8,0.10989e+04_r8,0.94665e+03_r8,0.79449e+03_r8,0.64227e+03_r8, & + & 0.73248e+03_r8,0.87121e+03_r8,0.10099e+04_r8,0.11487e+04_r8 /) + kao(:, 2,10, 9) = (/ & + & 0.12350e+04_r8,0.10848e+04_r8,0.93449e+03_r8,0.78435e+03_r8,0.63416e+03_r8, & + & 0.73188e+03_r8,0.87073e+03_r8,0.10095e+04_r8,0.11483e+04_r8 /) + kao(:, 3,10, 9) = (/ & + & 0.12209e+04_r8,0.10725e+04_r8,0.92407e+03_r8,0.77565e+03_r8,0.62724e+03_r8, & + & 0.73132e+03_r8,0.87012e+03_r8,0.10091e+04_r8,0.11477e+04_r8 /) + kao(:, 4,10, 9) = (/ & + & 0.12088e+04_r8,0.10618e+04_r8,0.91493e+03_r8,0.76801e+03_r8,0.62113e+03_r8, & + & 0.73072e+03_r8,0.86943e+03_r8,0.10082e+04_r8,0.11469e+04_r8 /) + kao(:, 5,10, 9) = (/ & + & 0.11981e+04_r8,0.10526e+04_r8,0.90691e+03_r8,0.76134e+03_r8,0.61583e+03_r8, & + & 0.72997e+03_r8,0.86853e+03_r8,0.10072e+04_r8,0.11458e+04_r8 /) + kao(:, 1,11, 9) = (/ & + & 0.12119e+04_r8,0.10646e+04_r8,0.91723e+03_r8,0.76995e+03_r8,0.62265e+03_r8, & + & 0.73201e+03_r8,0.87093e+03_r8,0.10098e+04_r8,0.11487e+04_r8 /) + kao(:, 2,11, 9) = (/ & + & 0.11986e+04_r8,0.10529e+04_r8,0.90727e+03_r8,0.76161e+03_r8,0.61603e+03_r8, & + & 0.73147e+03_r8,0.87046e+03_r8,0.10094e+04_r8,0.11483e+04_r8 /) + kao(:, 3,11, 9) = (/ & + & 0.11871e+04_r8,0.10429e+04_r8,0.89865e+03_r8,0.75449e+03_r8,0.61031e+03_r8, & + & 0.73094e+03_r8,0.86988e+03_r8,0.10088e+04_r8,0.11477e+04_r8 /) + kao(:, 4,11, 9) = (/ & + & 0.11772e+04_r8,0.10342e+04_r8,0.89122e+03_r8,0.74824e+03_r8,0.60537e+03_r8, & + & 0.73035e+03_r8,0.86918e+03_r8,0.10081e+04_r8,0.11469e+04_r8 /) + kao(:, 5,11, 9) = (/ & + & 0.11684e+04_r8,0.10265e+04_r8,0.88467e+03_r8,0.74278e+03_r8,0.60127e+03_r8, & + & 0.72963e+03_r8,0.86831e+03_r8,0.10071e+04_r8,0.11458e+04_r8 /) + kao(:, 1,12, 9) = (/ & + & 0.11796e+04_r8,0.10363e+04_r8,0.89308e+03_r8,0.74980e+03_r8,0.60664e+03_r8, & + & 0.73158e+03_r8,0.87066e+03_r8,0.10097e+04_r8,0.11487e+04_r8 /) + kao(:, 2,12, 9) = (/ & + & 0.11688e+04_r8,0.10268e+04_r8,0.88492e+03_r8,0.74297e+03_r8,0.60173e+03_r8, & + & 0.73111e+03_r8,0.87023e+03_r8,0.10093e+04_r8,0.11483e+04_r8 /) + kao(:, 3,12, 9) = (/ & + & 0.11594e+04_r8,0.10186e+04_r8,0.87787e+03_r8,0.73715e+03_r8,0.59711e+03_r8, & + & 0.73061e+03_r8,0.86968e+03_r8,0.10088e+04_r8,0.11478e+04_r8 /) + kao(:, 4,12, 9) = (/ & + & 0.11512e+04_r8,0.10115e+04_r8,0.87180e+03_r8,0.73203e+03_r8,0.59373e+03_r8, & + & 0.73004e+03_r8,0.86900e+03_r8,0.10080e+04_r8,0.11469e+04_r8 /) + kao(:, 5,12, 9) = (/ & + & 0.11441e+04_r8,0.10053e+04_r8,0.86640e+03_r8,0.72756e+03_r8,0.59149e+03_r8, & + & 0.72934e+03_r8,0.86813e+03_r8,0.10070e+04_r8,0.11458e+04_r8 /) + kao(:, 1,13, 9) = (/ & + & 0.11533e+04_r8,0.10132e+04_r8,0.87330e+03_r8,0.73334e+03_r8,0.59476e+03_r8, & + & 0.73130e+03_r8,0.87046e+03_r8,0.10096e+04_r8,0.11487e+04_r8 /) + kao(:, 2,13, 9) = (/ & + & 0.11444e+04_r8,0.10055e+04_r8,0.86659e+03_r8,0.72770e+03_r8,0.59240e+03_r8, & + & 0.73084e+03_r8,0.87005e+03_r8,0.10092e+04_r8,0.11483e+04_r8 /) + kao(:, 3,13, 9) = (/ & + & 0.11367e+04_r8,0.99882e+03_r8,0.86084e+03_r8,0.72297e+03_r8,0.59186e+03_r8, & + & 0.73036e+03_r8,0.86950e+03_r8,0.10087e+04_r8,0.11478e+04_r8 /) + kao(:, 4,13, 9) = (/ & + & 0.11300e+04_r8,0.99294e+03_r8,0.85585e+03_r8,0.71880e+03_r8,0.59143e+03_r8, & + & 0.72979e+03_r8,0.86883e+03_r8,0.10079e+04_r8,0.11469e+04_r8 /) + kao(:, 5,13, 9) = (/ & + & 0.11242e+04_r8,0.98788e+03_r8,0.85146e+03_r8,0.71512e+03_r8,0.59082e+03_r8, & + & 0.72910e+03_r8,0.86797e+03_r8,0.10069e+04_r8,0.11459e+04_r8 /) + kao(:, 1, 1,10) = (/ & + & 0.19609e+04_r8,0.17196e+04_r8,0.14787e+04_r8,0.12373e+04_r8,0.99636e+03_r8, & + & 0.75577e+03_r8,0.88158e+03_r8,0.10175e+04_r8,0.11538e+04_r8 /) + kao(:, 2, 1,10) = (/ & + & 0.19102e+04_r8,0.16765e+04_r8,0.14403e+04_r8,0.12063e+04_r8,0.97232e+03_r8, & + & 0.74406e+03_r8,0.87986e+03_r8,0.10152e+04_r8,0.11513e+04_r8 /) + kao(:, 3, 1,10) = (/ & + & 0.18658e+04_r8,0.16364e+04_r8,0.14075e+04_r8,0.11783e+04_r8,0.94916e+03_r8, & + & 0.74249e+03_r8,0.87815e+03_r8,0.10135e+04_r8,0.11491e+04_r8 /) + kao(:, 4, 1,10) = (/ & + & 0.18250e+04_r8,0.16014e+04_r8,0.13778e+04_r8,0.11533e+04_r8,0.92945e+03_r8, & + & 0.74050e+03_r8,0.87640e+03_r8,0.10114e+04_r8,0.11477e+04_r8 /) + kao(:, 5, 1,10) = (/ & + & 0.17888e+04_r8,0.15692e+04_r8,0.13504e+04_r8,0.11313e+04_r8,0.91134e+03_r8, & + & 0.73837e+03_r8,0.87432e+03_r8,0.10096e+04_r8,0.11467e+04_r8 /) + kao(:, 1, 2,10) = (/ & + & 0.18108e+04_r8,0.15879e+04_r8,0.13673e+04_r8,0.11437e+04_r8,0.92213e+03_r8, & + & 0.74428e+03_r8,0.88077e+03_r8,0.10175e+04_r8,0.11547e+04_r8 /) + kao(:, 2, 2,10) = (/ & + & 0.17684e+04_r8,0.15508e+04_r8,0.13352e+04_r8,0.11178e+04_r8,0.90099e+03_r8, & + & 0.74265e+03_r8,0.87920e+03_r8,0.10158e+04_r8,0.11521e+04_r8 /) + kao(:, 3, 2,10) = (/ & + & 0.17293e+04_r8,0.15183e+04_r8,0.13063e+04_r8,0.10931e+04_r8,0.88199e+03_r8, & + & 0.74117e+03_r8,0.87755e+03_r8,0.10136e+04_r8,0.11500e+04_r8 /) + kao(:, 4, 2,10) = (/ & + & 0.16960e+04_r8,0.14887e+04_r8,0.12799e+04_r8,0.10727e+04_r8,0.86433e+03_r8, & + & 0.73957e+03_r8,0.87577e+03_r8,0.10116e+04_r8,0.11482e+04_r8 /) + kao(:, 5, 2,10) = (/ & + & 0.16637e+04_r8,0.14607e+04_r8,0.12562e+04_r8,0.10527e+04_r8,0.84877e+03_r8, & + & 0.73748e+03_r8,0.87409e+03_r8,0.10096e+04_r8,0.11470e+04_r8 /) + kao(:, 1, 3,10) = (/ & + & 0.16939e+04_r8,0.14847e+04_r8,0.12786e+04_r8,0.10705e+04_r8,0.86372e+03_r8, & + & 0.74343e+03_r8,0.88064e+03_r8,0.10178e+04_r8,0.11559e+04_r8 /) + kao(:, 2, 3,10) = (/ & + & 0.16557e+04_r8,0.14542e+04_r8,0.12503e+04_r8,0.10478e+04_r8,0.84533e+03_r8, & + & 0.74182e+03_r8,0.87906e+03_r8,0.10163e+04_r8,0.11537e+04_r8 /) + kao(:, 3, 3,10) = (/ & + & 0.16218e+04_r8,0.14239e+04_r8,0.12249e+04_r8,0.10266e+04_r8,0.82819e+03_r8, & + & 0.74031e+03_r8,0.87730e+03_r8,0.10137e+04_r8,0.11513e+04_r8 /) + kao(:, 4, 3,10) = (/ & + & 0.15929e+04_r8,0.13992e+04_r8,0.12027e+04_r8,0.10077e+04_r8,0.81299e+03_r8, & + & 0.73896e+03_r8,0.87590e+03_r8,0.10123e+04_r8,0.11493e+04_r8 /) + kao(:, 5, 3,10) = (/ & + & 0.15654e+04_r8,0.13740e+04_r8,0.11824e+04_r8,0.99136e+03_r8,0.79933e+03_r8, & + & 0.73740e+03_r8,0.87406e+03_r8,0.10104e+04_r8,0.11477e+04_r8 /) + kao(:, 1, 4,10) = (/ & + & 0.15959e+04_r8,0.14010e+04_r8,0.12054e+04_r8,0.10100e+04_r8,0.81522e+03_r8, & + & 0.74271e+03_r8,0.88040e+03_r8,0.10180e+04_r8,0.11570e+04_r8 /) + kao(:, 2, 4,10) = (/ & + & 0.15637e+04_r8,0.13710e+04_r8,0.11804e+04_r8,0.98920e+03_r8,0.79803e+03_r8, & + & 0.74139e+03_r8,0.87903e+03_r8,0.10168e+04_r8,0.11552e+04_r8 /) + kao(:, 3, 4,10) = (/ & + & 0.15330e+04_r8,0.13459e+04_r8,0.11594e+04_r8,0.97120e+03_r8,0.78314e+03_r8, & + & 0.74000e+03_r8,0.87753e+03_r8,0.10151e+04_r8,0.11528e+04_r8 /) + kao(:, 4, 4,10) = (/ & + & 0.15077e+04_r8,0.13229e+04_r8,0.11386e+04_r8,0.95486e+03_r8,0.77029e+03_r8, & + & 0.73854e+03_r8,0.87600e+03_r8,0.10131e+04_r8,0.11506e+04_r8 /) + kao(:, 5, 4,10) = (/ & + & 0.14835e+04_r8,0.13025e+04_r8,0.11209e+04_r8,0.94000e+03_r8,0.75786e+03_r8, & + & 0.73717e+03_r8,0.87438e+03_r8,0.10111e+04_r8,0.11486e+04_r8 /) + kao(:, 1, 5,10) = (/ & + & 0.15126e+04_r8,0.13285e+04_r8,0.11431e+04_r8,0.95745e+03_r8,0.77284e+03_r8, & + & 0.74220e+03_r8,0.88024e+03_r8,0.10187e+04_r8,0.11578e+04_r8 /) + kao(:, 2, 5,10) = (/ & + & 0.14829e+04_r8,0.13024e+04_r8,0.11209e+04_r8,0.94020e+03_r8,0.75863e+03_r8, & + & 0.74099e+03_r8,0.87909e+03_r8,0.10174e+04_r8,0.11564e+04_r8 /) + kao(:, 3, 5,10) = (/ & + & 0.14582e+04_r8,0.12806e+04_r8,0.11014e+04_r8,0.92377e+03_r8,0.74596e+03_r8, & + & 0.73960e+03_r8,0.87772e+03_r8,0.10159e+04_r8,0.11544e+04_r8 /) + kao(:, 4, 5,10) = (/ & + & 0.14345e+04_r8,0.12594e+04_r8,0.10847e+04_r8,0.90887e+03_r8,0.73410e+03_r8, & + & 0.73828e+03_r8,0.87622e+03_r8,0.10139e+04_r8,0.11518e+04_r8 /) + kao(:, 5, 5,10) = (/ & + & 0.14140e+04_r8,0.12418e+04_r8,0.10683e+04_r8,0.89661e+03_r8,0.72364e+03_r8, & + & 0.73696e+03_r8,0.87469e+03_r8,0.10119e+04_r8,0.11501e+04_r8 /) + kao(:, 1, 6,10) = (/ & + & 0.14435e+04_r8,0.12676e+04_r8,0.10914e+04_r8,0.91493e+03_r8,0.73889e+03_r8, & + & 0.74179e+03_r8,0.88024e+03_r8,0.10190e+04_r8,0.11586e+04_r8 /) + kao(:, 2, 6,10) = (/ & + & 0.14184e+04_r8,0.12443e+04_r8,0.10722e+04_r8,0.89834e+03_r8,0.72535e+03_r8, & + & 0.74069e+03_r8,0.87922e+03_r8,0.10178e+04_r8,0.11574e+04_r8 /) + kao(:, 3, 6,10) = (/ & + & 0.13949e+04_r8,0.12245e+04_r8,0.10548e+04_r8,0.88411e+03_r8,0.71441e+03_r8, & + & 0.73951e+03_r8,0.87792e+03_r8,0.10164e+04_r8,0.11554e+04_r8 /) + kao(:, 4, 6,10) = (/ & + & 0.13745e+04_r8,0.12070e+04_r8,0.10388e+04_r8,0.87157e+03_r8,0.70381e+03_r8, & + & 0.73817e+03_r8,0.87654e+03_r8,0.10150e+04_r8,0.11533e+04_r8 /) + kao(:, 5, 6,10) = (/ & + & 0.13558e+04_r8,0.11909e+04_r8,0.10253e+04_r8,0.86039e+03_r8,0.69505e+03_r8, & + & 0.73669e+03_r8,0.87508e+03_r8,0.10128e+04_r8,0.11510e+04_r8 /) + kao(:, 1, 7,10) = (/ & + & 0.13849e+04_r8,0.12154e+04_r8,0.10465e+04_r8,0.87809e+03_r8,0.70922e+03_r8, & + & 0.74150e+03_r8,0.88017e+03_r8,0.10197e+04_r8,0.11599e+04_r8 /) + kao(:, 2, 7,10) = (/ & + & 0.13622e+04_r8,0.11954e+04_r8,0.10296e+04_r8,0.86328e+03_r8,0.69750e+03_r8, & + & 0.74031e+03_r8,0.87926e+03_r8,0.10184e+04_r8,0.11581e+04_r8 /) + kao(:, 3, 7,10) = (/ & + & 0.13407e+04_r8,0.11775e+04_r8,0.10144e+04_r8,0.85098e+03_r8,0.68710e+03_r8, & + & 0.73933e+03_r8,0.87824e+03_r8,0.10171e+04_r8,0.11568e+04_r8 /) + kao(:, 4, 7,10) = (/ & + & 0.13234e+04_r8,0.11620e+04_r8,0.10006e+04_r8,0.83940e+03_r8,0.67808e+03_r8, & + & 0.73818e+03_r8,0.87693e+03_r8,0.10157e+04_r8,0.11549e+04_r8 /) + kao(:, 5, 7,10) = (/ & + & 0.13077e+04_r8,0.11481e+04_r8,0.98850e+03_r8,0.82952e+03_r8,0.66976e+03_r8, & + & 0.73685e+03_r8,0.87533e+03_r8,0.10140e+04_r8,0.11525e+04_r8 /) + kao(:, 1, 8,10) = (/ & + & 0.13336e+04_r8,0.11711e+04_r8,0.10088e+04_r8,0.84626e+03_r8,0.68382e+03_r8, & + & 0.74131e+03_r8,0.88025e+03_r8,0.10205e+04_r8,0.11609e+04_r8 /) + kao(:, 2, 8,10) = (/ & + & 0.13133e+04_r8,0.11535e+04_r8,0.99382e+03_r8,0.83328e+03_r8,0.67355e+03_r8, & + & 0.73954e+03_r8,0.87931e+03_r8,0.10187e+04_r8,0.11591e+04_r8 /) + kao(:, 3, 8,10) = (/ & + & 0.12952e+04_r8,0.11377e+04_r8,0.97980e+03_r8,0.82257e+03_r8,0.66450e+03_r8, & + & 0.73910e+03_r8,0.87831e+03_r8,0.10177e+04_r8,0.11576e+04_r8 /) + kao(:, 4, 8,10) = (/ & + & 0.12798e+04_r8,0.11238e+04_r8,0.96848e+03_r8,0.81189e+03_r8,0.65672e+03_r8, & + & 0.73820e+03_r8,0.87729e+03_r8,0.10162e+04_r8,0.11560e+04_r8 /) + kao(:, 5, 8,10) = (/ & + & 0.12652e+04_r8,0.11115e+04_r8,0.95739e+03_r8,0.80373e+03_r8,0.64938e+03_r8, & + & 0.73712e+03_r8,0.87584e+03_r8,0.10149e+04_r8,0.11541e+04_r8 /) + kao(:, 1, 9,10) = (/ & + & 0.12921e+04_r8,0.11338e+04_r8,0.97649e+03_r8,0.81965e+03_r8,0.66193e+03_r8, & + & 0.74117e+03_r8,0.88056e+03_r8,0.10212e+04_r8,0.11621e+04_r8 /) + kao(:, 2, 9,10) = (/ & + & 0.12725e+04_r8,0.11175e+04_r8,0.96294e+03_r8,0.80792e+03_r8,0.65314e+03_r8, & + & 0.74018e+03_r8,0.87944e+03_r8,0.10196e+04_r8,0.11602e+04_r8 /) + kao(:, 3, 9,10) = (/ & + & 0.12569e+04_r8,0.11032e+04_r8,0.95038e+03_r8,0.79825e+03_r8,0.64471e+03_r8, & + & 0.73910e+03_r8,0.87852e+03_r8,0.10181e+04_r8,0.11585e+04_r8 /) + kao(:, 4, 9,10) = (/ & + & 0.12428e+04_r8,0.10914e+04_r8,0.94028e+03_r8,0.78940e+03_r8,0.63769e+03_r8, & + & 0.73816e+03_r8,0.87758e+03_r8,0.10170e+04_r8,0.11569e+04_r8 /) + kao(:, 5, 9,10) = (/ & + & 0.12310e+04_r8,0.10815e+04_r8,0.93149e+03_r8,0.78151e+03_r8,0.63218e+03_r8, & + & 0.73726e+03_r8,0.87637e+03_r8,0.10156e+04_r8,0.11553e+04_r8 /) + kao(:, 1,10,10) = (/ & + & 0.12531e+04_r8,0.11009e+04_r8,0.94808e+03_r8,0.79569e+03_r8,0.64353e+03_r8, & + & 0.74092e+03_r8,0.88101e+03_r8,0.10222e+04_r8,0.11631e+04_r8 /) + kao(:, 2,10,10) = (/ & + & 0.12357e+04_r8,0.10861e+04_r8,0.93599e+03_r8,0.78490e+03_r8,0.63564e+03_r8, & + & 0.74008e+03_r8,0.87961e+03_r8,0.10203e+04_r8,0.11613e+04_r8 /) + kao(:, 3,10,10) = (/ & + & 0.12227e+04_r8,0.10738e+04_r8,0.92501e+03_r8,0.77680e+03_r8,0.62842e+03_r8, & + & 0.73914e+03_r8,0.87860e+03_r8,0.10179e+04_r8,0.11592e+04_r8 /) + kao(:, 4,10,10) = (/ & + & 0.12109e+04_r8,0.10632e+04_r8,0.91605e+03_r8,0.76920e+03_r8,0.62177e+03_r8, & + & 0.73819e+03_r8,0.87758e+03_r8,0.10174e+04_r8,0.11577e+04_r8 /) + kao(:, 5,10,10) = (/ & + & 0.11998e+04_r8,0.10537e+04_r8,0.90813e+03_r8,0.76232e+03_r8,0.61616e+03_r8, & + & 0.73732e+03_r8,0.87676e+03_r8,0.10162e+04_r8,0.11563e+04_r8 /) + kao(:, 1,11,10) = (/ & + & 0.12137e+04_r8,0.10654e+04_r8,0.91884e+03_r8,0.77105e+03_r8,0.62358e+03_r8, & + & 0.74042e+03_r8,0.88057e+03_r8,0.10221e+04_r8,0.11630e+04_r8 /) + kao(:, 2,11,10) = (/ & + & 0.11999e+04_r8,0.10545e+04_r8,0.90854e+03_r8,0.76253e+03_r8,0.61715e+03_r8, & + & 0.73961e+03_r8,0.87932e+03_r8,0.10201e+04_r8,0.11611e+04_r8 /) + kao(:, 3,11,10) = (/ & + & 0.11890e+04_r8,0.10445e+04_r8,0.90019e+03_r8,0.75537e+03_r8,0.61109e+03_r8, & + & 0.73864e+03_r8,0.87832e+03_r8,0.10186e+04_r8,0.11592e+04_r8 /) + kao(:, 4,11,10) = (/ & + & 0.11789e+04_r8,0.10359e+04_r8,0.89280e+03_r8,0.74928e+03_r8,0.60622e+03_r8, & + & 0.73779e+03_r8,0.87747e+03_r8,0.10172e+04_r8,0.11577e+04_r8 /) + kao(:, 5,11,10) = (/ & + & 0.11709e+04_r8,0.10287e+04_r8,0.88607e+03_r8,0.74401e+03_r8,0.60247e+03_r8, & + & 0.73688e+03_r8,0.87644e+03_r8,0.10160e+04_r8,0.11563e+04_r8 /) + kao(:, 1,12,10) = (/ & + & 0.11820e+04_r8,0.10383e+04_r8,0.89456e+03_r8,0.75081e+03_r8,0.60714e+03_r8, & + & 0.74001e+03_r8,0.88049e+03_r8,0.10220e+04_r8,0.11631e+04_r8 /) + kao(:, 2,12,10) = (/ & + & 0.11713e+04_r8,0.10290e+04_r8,0.88623e+03_r8,0.74407e+03_r8,0.60058e+03_r8, & + & 0.73921e+03_r8,0.87901e+03_r8,0.10201e+04_r8,0.11611e+04_r8 /) + kao(:, 3,12,10) = (/ & + & 0.11605e+04_r8,0.10200e+04_r8,0.87951e+03_r8,0.73788e+03_r8,0.59769e+03_r8, & + & 0.73835e+03_r8,0.87808e+03_r8,0.10182e+04_r8,0.11591e+04_r8 /) + kao(:, 4,12,10) = (/ & + & 0.11533e+04_r8,0.10132e+04_r8,0.87284e+03_r8,0.73305e+03_r8,0.59795e+03_r8, & + & 0.73753e+03_r8,0.87718e+03_r8,0.10171e+04_r8,0.11577e+04_r8 /) + kao(:, 5,12,10) = (/ & + & 0.11467e+04_r8,0.10071e+04_r8,0.86739e+03_r8,0.72890e+03_r8,0.59711e+03_r8, & + & 0.73664e+03_r8,0.87623e+03_r8,0.10159e+04_r8,0.11563e+04_r8 /) + kao(:, 1,13,10) = (/ & + & 0.11553e+04_r8,0.10149e+04_r8,0.87419e+03_r8,0.73470e+03_r8,0.59975e+03_r8, & + & 0.73968e+03_r8,0.88029e+03_r8,0.10219e+04_r8,0.11630e+04_r8 /) + kao(:, 2,13,10) = (/ & + & 0.11455e+04_r8,0.10072e+04_r8,0.86782e+03_r8,0.72873e+03_r8,0.59921e+03_r8, & + & 0.73889e+03_r8,0.87889e+03_r8,0.10200e+04_r8,0.11611e+04_r8 /) + kao(:, 3,13,10) = (/ & + & 0.11380e+04_r8,0.10000e+04_r8,0.86190e+03_r8,0.72452e+03_r8,0.59831e+03_r8, & + & 0.73799e+03_r8,0.87789e+03_r8,0.10182e+04_r8,0.11592e+04_r8 /) + kao(:, 4,13,10) = (/ & + & 0.11318e+04_r8,0.99472e+03_r8,0.85697e+03_r8,0.71950e+03_r8,0.59744e+03_r8, & + & 0.73726e+03_r8,0.87708e+03_r8,0.10170e+04_r8,0.11577e+04_r8 /) + kao(:, 5,13,10) = (/ & + & 0.11253e+04_r8,0.98825e+03_r8,0.85273e+03_r8,0.71635e+03_r8,0.59683e+03_r8, & + & 0.73639e+03_r8,0.87606e+03_r8,0.10160e+04_r8,0.11562e+04_r8 /) + kao(:, 1, 1,11) = (/ & + & 0.19598e+04_r8,0.17186e+04_r8,0.14777e+04_r8,0.12380e+04_r8,0.99729e+03_r8, & + & 0.75567e+03_r8,0.88469e+03_r8,0.10202e+04_r8,0.11560e+04_r8 /) + kao(:, 2, 1,11) = (/ & + & 0.19102e+04_r8,0.16743e+04_r8,0.14414e+04_r8,0.12066e+04_r8,0.97117e+03_r8, & + & 0.74679e+03_r8,0.88252e+03_r8,0.10178e+04_r8,0.11544e+04_r8 /) + kao(:, 3, 1,11) = (/ & + & 0.18656e+04_r8,0.16383e+04_r8,0.14073e+04_r8,0.11791e+04_r8,0.94951e+03_r8, & + & 0.74505e+03_r8,0.88029e+03_r8,0.10159e+04_r8,0.11530e+04_r8 /) + kao(:, 4, 1,11) = (/ & + & 0.18261e+04_r8,0.16025e+04_r8,0.13782e+04_r8,0.11540e+04_r8,0.92917e+03_r8, & + & 0.74299e+03_r8,0.87816e+03_r8,0.10141e+04_r8,0.11522e+04_r8 /) + kao(:, 5, 1,11) = (/ & + & 0.17888e+04_r8,0.15710e+04_r8,0.13500e+04_r8,0.11298e+04_r8,0.91140e+03_r8, & + & 0.74109e+03_r8,0.87588e+03_r8,0.10122e+04_r8,0.11510e+04_r8 /) + kao(:, 1, 2,11) = (/ & + & 0.18117e+04_r8,0.15887e+04_r8,0.13651e+04_r8,0.11459e+04_r8,0.92177e+03_r8, & + & 0.74731e+03_r8,0.88412e+03_r8,0.10203e+04_r8,0.11568e+04_r8 /) + kao(:, 2, 2,11) = (/ & + & 0.17673e+04_r8,0.15512e+04_r8,0.13335e+04_r8,0.11174e+04_r8,0.90028e+03_r8, & + & 0.74546e+03_r8,0.88203e+03_r8,0.10179e+04_r8,0.11551e+04_r8 /) + kao(:, 3, 2,11) = (/ & + & 0.17317e+04_r8,0.15193e+04_r8,0.13050e+04_r8,0.10955e+04_r8,0.88112e+03_r8, & + & 0.74378e+03_r8,0.87978e+03_r8,0.10161e+04_r8,0.11535e+04_r8 /) + kao(:, 4, 2,11) = (/ & + & 0.16956e+04_r8,0.14873e+04_r8,0.12805e+04_r8,0.10729e+04_r8,0.86470e+03_r8, & + & 0.74189e+03_r8,0.87768e+03_r8,0.10142e+04_r8,0.11524e+04_r8 /) + kao(:, 5, 2,11) = (/ & + & 0.16657e+04_r8,0.14596e+04_r8,0.12568e+04_r8,0.10531e+04_r8,0.84904e+03_r8, & + & 0.73979e+03_r8,0.87528e+03_r8,0.10122e+04_r8,0.11511e+04_r8 /) + kao(:, 1, 3,11) = (/ & + & 0.16927e+04_r8,0.14859e+04_r8,0.12782e+04_r8,0.10724e+04_r8,0.86335e+03_r8, & + & 0.74646e+03_r8,0.88392e+03_r8,0.10211e+04_r8,0.11579e+04_r8 /) + kao(:, 2, 3,11) = (/ & + & 0.16581e+04_r8,0.14524e+04_r8,0.12540e+04_r8,0.10466e+04_r8,0.84448e+03_r8, & + & 0.74471e+03_r8,0.88205e+03_r8,0.10189e+04_r8,0.11562e+04_r8 /) + kao(:, 3, 3,11) = (/ & + & 0.16261e+04_r8,0.14229e+04_r8,0.12269e+04_r8,0.10264e+04_r8,0.82790e+03_r8, & + & 0.74305e+03_r8,0.87988e+03_r8,0.10167e+04_r8,0.11544e+04_r8 /) + kao(:, 4, 3,11) = (/ & + & 0.15929e+04_r8,0.13986e+04_r8,0.12038e+04_r8,0.10084e+04_r8,0.81266e+03_r8, & + & 0.74160e+03_r8,0.87767e+03_r8,0.10148e+04_r8,0.11530e+04_r8 /) + kao(:, 5, 3,11) = (/ & + & 0.15661e+04_r8,0.13746e+04_r8,0.11837e+04_r8,0.99103e+03_r8,0.79967e+03_r8, & + & 0.73929e+03_r8,0.87586e+03_r8,0.10132e+04_r8,0.11521e+04_r8 /) + kao(:, 1, 4,11) = (/ & + & 0.15973e+04_r8,0.14004e+04_r8,0.12065e+04_r8,0.10106e+04_r8,0.81385e+03_r8, & + & 0.74599e+03_r8,0.88404e+03_r8,0.10218e+04_r8,0.11590e+04_r8 /) + kao(:, 2, 4,11) = (/ & + & 0.15637e+04_r8,0.13722e+04_r8,0.11812e+04_r8,0.98900e+03_r8,0.79856e+03_r8, & + & 0.74428e+03_r8,0.88217e+03_r8,0.10197e+04_r8,0.11572e+04_r8 /) + kao(:, 3, 4,11) = (/ & + & 0.15340e+04_r8,0.13469e+04_r8,0.11576e+04_r8,0.97012e+03_r8,0.78412e+03_r8, & + & 0.74257e+03_r8,0.88022e+03_r8,0.10176e+04_r8,0.11556e+04_r8 /) + kao(:, 4, 4,11) = (/ & + & 0.15085e+04_r8,0.13226e+04_r8,0.11393e+04_r8,0.95486e+03_r8,0.76980e+03_r8, & + & 0.74114e+03_r8,0.87815e+03_r8,0.10155e+04_r8,0.11538e+04_r8 /) + kao(:, 5, 4,11) = (/ & + & 0.14836e+04_r8,0.13020e+04_r8,0.11212e+04_r8,0.93957e+03_r8,0.75824e+03_r8, & + & 0.73939e+03_r8,0.87630e+03_r8,0.10138e+04_r8,0.11526e+04_r8 /) + kao(:, 1, 5,11) = (/ & + & 0.15143e+04_r8,0.13286e+04_r8,0.11431e+04_r8,0.95847e+03_r8,0.77403e+03_r8, & + & 0.74572e+03_r8,0.88418e+03_r8,0.10223e+04_r8,0.11603e+04_r8 /) + kao(:, 2, 5,11) = (/ & + & 0.14842e+04_r8,0.13025e+04_r8,0.11230e+04_r8,0.94028e+03_r8,0.75881e+03_r8, & + & 0.74405e+03_r8,0.88254e+03_r8,0.10205e+04_r8,0.11584e+04_r8 /) + kao(:, 3, 5,11) = (/ & + & 0.14577e+04_r8,0.12799e+04_r8,0.11020e+04_r8,0.92340e+03_r8,0.74531e+03_r8, & + & 0.74244e+03_r8,0.88060e+03_r8,0.10185e+04_r8,0.11566e+04_r8 /) + kao(:, 4, 5,11) = (/ & + & 0.14365e+04_r8,0.12603e+04_r8,0.10859e+04_r8,0.90939e+03_r8,0.73467e+03_r8, & + & 0.74090e+03_r8,0.87865e+03_r8,0.10164e+04_r8,0.11549e+04_r8 /) + kao(:, 5, 5,11) = (/ & + & 0.14147e+04_r8,0.12422e+04_r8,0.10695e+04_r8,0.89657e+03_r8,0.72409e+03_r8, & + & 0.73938e+03_r8,0.87659e+03_r8,0.10145e+04_r8,0.11530e+04_r8 /) + kao(:, 1, 6,11) = (/ & + & 0.14426e+04_r8,0.12686e+04_r8,0.10911e+04_r8,0.91528e+03_r8,0.73914e+03_r8, & + & 0.74563e+03_r8,0.88436e+03_r8,0.10228e+04_r8,0.11615e+04_r8 /) + kao(:, 2, 6,11) = (/ & + & 0.14171e+04_r8,0.12457e+04_r8,0.10728e+04_r8,0.89861e+03_r8,0.72517e+03_r8, & + & 0.74402e+03_r8,0.88280e+03_r8,0.10215e+04_r8,0.11596e+04_r8 /) + kao(:, 3, 6,11) = (/ & + & 0.13943e+04_r8,0.12252e+04_r8,0.10539e+04_r8,0.88362e+03_r8,0.71333e+03_r8, & + & 0.74243e+03_r8,0.88117e+03_r8,0.10194e+04_r8,0.11577e+04_r8 /) + kao(:, 4, 6,11) = (/ & + & 0.13749e+04_r8,0.12056e+04_r8,0.10405e+04_r8,0.87188e+03_r8,0.70449e+03_r8, & + & 0.74089e+03_r8,0.87923e+03_r8,0.10173e+04_r8,0.11560e+04_r8 /) + kao(:, 5, 6,11) = (/ & + & 0.13580e+04_r8,0.11907e+04_r8,0.10258e+04_r8,0.85998e+03_r8,0.69473e+03_r8, & + & 0.73937e+03_r8,0.87727e+03_r8,0.10154e+04_r8,0.11543e+04_r8 /) + kao(:, 1, 7,11) = (/ & + & 0.13844e+04_r8,0.12166e+04_r8,0.10469e+04_r8,0.87815e+03_r8,0.70873e+03_r8, & + & 0.74560e+03_r8,0.88449e+03_r8,0.10233e+04_r8,0.11626e+04_r8 /) + kao(:, 2, 7,11) = (/ & + & 0.13610e+04_r8,0.11962e+04_r8,0.10291e+04_r8,0.86318e+03_r8,0.69730e+03_r8, & + & 0.74409e+03_r8,0.88322e+03_r8,0.10221e+04_r8,0.11608e+04_r8 /) + kao(:, 3, 7,11) = (/ & + & 0.13413e+04_r8,0.11786e+04_r8,0.10145e+04_r8,0.85031e+03_r8,0.68760e+03_r8, & + & 0.74253e+03_r8,0.88154e+03_r8,0.10203e+04_r8,0.11589e+04_r8 /) + kao(:, 4, 7,11) = (/ & + & 0.13235e+04_r8,0.11630e+04_r8,0.10007e+04_r8,0.84004e+03_r8,0.67864e+03_r8, & + & 0.74101e+03_r8,0.87982e+03_r8,0.10185e+04_r8,0.11572e+04_r8 /) + kao(:, 5, 7,11) = (/ & + & 0.13063e+04_r8,0.11482e+04_r8,0.98932e+03_r8,0.82998e+03_r8,0.67037e+03_r8, & + & 0.73955e+03_r8,0.87796e+03_r8,0.10167e+04_r8,0.11554e+04_r8 /) + kao(:, 1, 8,11) = (/ & + & 0.13361e+04_r8,0.11714e+04_r8,0.10092e+04_r8,0.84627e+03_r8,0.68340e+03_r8, & + & 0.74540e+03_r8,0.88457e+03_r8,0.10236e+04_r8,0.11638e+04_r8 /) + kao(:, 2, 8,11) = (/ & + & 0.13143e+04_r8,0.11537e+04_r8,0.99295e+03_r8,0.83355e+03_r8,0.67330e+03_r8, & + & 0.74420e+03_r8,0.88339e+03_r8,0.10225e+04_r8,0.11619e+04_r8 /) + kao(:, 3, 8,11) = (/ & + & 0.12952e+04_r8,0.11377e+04_r8,0.98075e+03_r8,0.82213e+03_r8,0.66496e+03_r8, & + & 0.74271e+03_r8,0.88199e+03_r8,0.10211e+04_r8,0.11601e+04_r8 /) + kao(:, 4, 8,11) = (/ & + & 0.12808e+04_r8,0.11242e+04_r8,0.96858e+03_r8,0.81350e+03_r8,0.65663e+03_r8, & + & 0.74121e+03_r8,0.88037e+03_r8,0.10192e+04_r8,0.11582e+04_r8 /) + kao(:, 5, 8,11) = (/ & + & 0.12664e+04_r8,0.11113e+04_r8,0.95757e+03_r8,0.80317e+03_r8,0.64978e+03_r8, & + & 0.73975e+03_r8,0.87862e+03_r8,0.10173e+04_r8,0.11564e+04_r8 /) + kao(:, 1, 9,11) = (/ & + & 0.12911e+04_r8,0.11331e+04_r8,0.97754e+03_r8,0.81972e+03_r8,0.66210e+03_r8, & + & 0.74501e+03_r8,0.88462e+03_r8,0.10244e+04_r8,0.11652e+04_r8 /) + kao(:, 2, 9,11) = (/ & + & 0.12743e+04_r8,0.11193e+04_r8,0.96288e+03_r8,0.80865e+03_r8,0.65325e+03_r8, & + & 0.74437e+03_r8,0.88360e+03_r8,0.10230e+04_r8,0.11629e+04_r8 /) + kao(:, 3, 9,11) = (/ & + & 0.12573e+04_r8,0.11051e+04_r8,0.95155e+03_r8,0.79729e+03_r8,0.64451e+03_r8, & + & 0.74294e+03_r8,0.88237e+03_r8,0.10218e+04_r8,0.11610e+04_r8 /) + kao(:, 4, 9,11) = (/ & + & 0.12441e+04_r8,0.10920e+04_r8,0.94089e+03_r8,0.78911e+03_r8,0.63797e+03_r8, & + & 0.74148e+03_r8,0.88091e+03_r8,0.10202e+04_r8,0.11593e+04_r8 /) + kao(:, 5, 9,11) = (/ & + & 0.12297e+04_r8,0.10813e+04_r8,0.93127e+03_r8,0.78127e+03_r8,0.63265e+03_r8, & + & 0.74003e+03_r8,0.87926e+03_r8,0.10184e+04_r8,0.11573e+04_r8 /) + kao(:, 1,10,11) = (/ & + & 0.12530e+04_r8,0.11001e+04_r8,0.94821e+03_r8,0.79486e+03_r8,0.64277e+03_r8, & + & 0.74454e+03_r8,0.88447e+03_r8,0.10249e+04_r8,0.11664e+04_r8 /) + kao(:, 2,10,11) = (/ & + & 0.12387e+04_r8,0.10865e+04_r8,0.93685e+03_r8,0.78643e+03_r8,0.63425e+03_r8, & + & 0.74423e+03_r8,0.88371e+03_r8,0.10234e+04_r8,0.11637e+04_r8 /) + kao(:, 3,10,11) = (/ & + & 0.12243e+04_r8,0.10744e+04_r8,0.92585e+03_r8,0.77676e+03_r8,0.62740e+03_r8, & + & 0.74307e+03_r8,0.88260e+03_r8,0.10221e+04_r8,0.11620e+04_r8 /) + kao(:, 4,10,11) = (/ & + & 0.12107e+04_r8,0.10640e+04_r8,0.91623e+03_r8,0.76957e+03_r8,0.62235e+03_r8, & + & 0.74168e+03_r8,0.88129e+03_r8,0.10208e+04_r8,0.11602e+04_r8 /) + kao(:, 5,10,11) = (/ & + & 0.12010e+04_r8,0.10536e+04_r8,0.90891e+03_r8,0.76248e+03_r8,0.61761e+03_r8, & + & 0.74025e+03_r8,0.87965e+03_r8,0.10191e+04_r8,0.11583e+04_r8 /) + kao(:, 1,11,11) = (/ & + & 0.12140e+04_r8,0.10672e+04_r8,0.91852e+03_r8,0.77048e+03_r8,0.62320e+03_r8, & + & 0.74401e+03_r8,0.88413e+03_r8,0.10249e+04_r8,0.11664e+04_r8 /) + kao(:, 2,11,11) = (/ & + & 0.12007e+04_r8,0.10549e+04_r8,0.90904e+03_r8,0.76333e+03_r8,0.61635e+03_r8, & + & 0.74367e+03_r8,0.88337e+03_r8,0.10233e+04_r8,0.11639e+04_r8 /) + kao(:, 3,11,11) = (/ & + & 0.11891e+04_r8,0.10458e+04_r8,0.90055e+03_r8,0.75543e+03_r8,0.61123e+03_r8, & + & 0.74262e+03_r8,0.88229e+03_r8,0.10219e+04_r8,0.11620e+04_r8 /) + kao(:, 4,11,11) = (/ & + & 0.11794e+04_r8,0.10371e+04_r8,0.89190e+03_r8,0.74912e+03_r8,0.60572e+03_r8, & + & 0.74128e+03_r8,0.88110e+03_r8,0.10207e+04_r8,0.11602e+04_r8 /) + kao(:, 5,11,11) = (/ & + & 0.11697e+04_r8,0.10285e+04_r8,0.88631e+03_r8,0.74374e+03_r8,0.60062e+03_r8, & + & 0.73987e+03_r8,0.87958e+03_r8,0.10191e+04_r8,0.11583e+04_r8 /) + kao(:, 1,12,11) = (/ & + & 0.11829e+04_r8,0.10373e+04_r8,0.89433e+03_r8,0.75107e+03_r8,0.60775e+03_r8, & + & 0.74357e+03_r8,0.88385e+03_r8,0.10247e+04_r8,0.11664e+04_r8 /) + kao(:, 2,12,11) = (/ & + & 0.11707e+04_r8,0.10276e+04_r8,0.88712e+03_r8,0.74426e+03_r8,0.60163e+03_r8, & + & 0.74327e+03_r8,0.88309e+03_r8,0.10231e+04_r8,0.11639e+04_r8 /) + kao(:, 3,12,11) = (/ & + & 0.11629e+04_r8,0.10211e+04_r8,0.88018e+03_r8,0.73831e+03_r8,0.60184e+03_r8, & + & 0.74224e+03_r8,0.88203e+03_r8,0.10219e+04_r8,0.11620e+04_r8 /) + kao(:, 4,12,11) = (/ & + & 0.11538e+04_r8,0.10126e+04_r8,0.87253e+03_r8,0.73377e+03_r8,0.60080e+03_r8, & + & 0.74101e+03_r8,0.88067e+03_r8,0.10205e+04_r8,0.11602e+04_r8 /) + kao(:, 5,12,11) = (/ & + & 0.11449e+04_r8,0.10062e+04_r8,0.86764e+03_r8,0.72842e+03_r8,0.59975e+03_r8, & + & 0.73955e+03_r8,0.87926e+03_r8,0.10190e+04_r8,0.11583e+04_r8 /) + kao(:, 1,13,11) = (/ & + & 0.11561e+04_r8,0.10152e+04_r8,0.87509e+03_r8,0.73383e+03_r8,0.60253e+03_r8, & + & 0.74321e+03_r8,0.88362e+03_r8,0.10246e+04_r8,0.11664e+04_r8 /) + kao(:, 2,13,11) = (/ & + & 0.11468e+04_r8,0.10069e+04_r8,0.86783e+03_r8,0.72921e+03_r8,0.60211e+03_r8, & + & 0.74294e+03_r8,0.88286e+03_r8,0.10230e+04_r8,0.11639e+04_r8 /) + kao(:, 3,13,11) = (/ & + & 0.11390e+04_r8,0.10001e+04_r8,0.86301e+03_r8,0.72323e+03_r8,0.60140e+03_r8, & + & 0.74194e+03_r8,0.88181e+03_r8,0.10218e+04_r8,0.11621e+04_r8 /) + kao(:, 4,13,11) = (/ & + & 0.11313e+04_r8,0.99361e+03_r8,0.85706e+03_r8,0.72032e+03_r8,0.60042e+03_r8, & + & 0.74065e+03_r8,0.88048e+03_r8,0.10204e+04_r8,0.11602e+04_r8 /) + kao(:, 5,13,11) = (/ & + & 0.11266e+04_r8,0.99042e+03_r8,0.85257e+03_r8,0.71548e+03_r8,0.59931e+03_r8, & + & 0.73930e+03_r8,0.87908e+03_r8,0.10187e+04_r8,0.11583e+04_r8 /) + kao(:, 1, 1,12) = (/ & + & 0.19596e+04_r8,0.17200e+04_r8,0.14802e+04_r8,0.12370e+04_r8,0.99641e+03_r8, & + & 0.75556e+03_r8,0.88658e+03_r8,0.10236e+04_r8,0.11622e+04_r8 /) + kao(:, 2, 1,12) = (/ & + & 0.19107e+04_r8,0.16797e+04_r8,0.14463e+04_r8,0.12083e+04_r8,0.97440e+03_r8, & + & 0.74935e+03_r8,0.88455e+03_r8,0.10223e+04_r8,0.11611e+04_r8 /) + kao(:, 3, 1,12) = (/ & + & 0.18687e+04_r8,0.16368e+04_r8,0.14091e+04_r8,0.11809e+04_r8,0.95100e+03_r8, & + & 0.74626e+03_r8,0.88278e+03_r8,0.10214e+04_r8,0.11600e+04_r8 /) + kao(:, 4, 1,12) = (/ & + & 0.18274e+04_r8,0.15998e+04_r8,0.13805e+04_r8,0.11544e+04_r8,0.92955e+03_r8, & + & 0.74432e+03_r8,0.88029e+03_r8,0.10193e+04_r8,0.11572e+04_r8 /) + kao(:, 5, 1,12) = (/ & + & 0.17908e+04_r8,0.15685e+04_r8,0.13492e+04_r8,0.11303e+04_r8,0.91228e+03_r8, & + & 0.74183e+03_r8,0.87814e+03_r8,0.10165e+04_r8,0.11551e+04_r8 /) + kao(:, 1, 2,12) = (/ & + & 0.18091e+04_r8,0.15890e+04_r8,0.13701e+04_r8,0.11447e+04_r8,0.92240e+03_r8, & + & 0.75031e+03_r8,0.88580e+03_r8,0.10236e+04_r8,0.11628e+04_r8 /) + kao(:, 2, 2,12) = (/ & + & 0.17702e+04_r8,0.15507e+04_r8,0.13346e+04_r8,0.11179e+04_r8,0.90072e+03_r8, & + & 0.74790e+03_r8,0.88384e+03_r8,0.10222e+04_r8,0.11616e+04_r8 /) + kao(:, 3, 2,12) = (/ & + & 0.17282e+04_r8,0.15159e+04_r8,0.13066e+04_r8,0.10967e+04_r8,0.88274e+03_r8, & + & 0.74530e+03_r8,0.88241e+03_r8,0.10213e+04_r8,0.11606e+04_r8 /) + kao(:, 4, 2,12) = (/ & + & 0.16964e+04_r8,0.14887e+04_r8,0.12816e+04_r8,0.10711e+04_r8,0.86387e+03_r8, & + & 0.74308e+03_r8,0.88064e+03_r8,0.10199e+04_r8,0.11593e+04_r8 /) + kao(:, 5, 2,12) = (/ & + & 0.16664e+04_r8,0.14634e+04_r8,0.12570e+04_r8,0.10541e+04_r8,0.84878e+03_r8, & + & 0.74105e+03_r8,0.87802e+03_r8,0.10170e+04_r8,0.11559e+04_r8 /) + kao(:, 1, 3,12) = (/ & + & 0.16969e+04_r8,0.14893e+04_r8,0.12806e+04_r8,0.10686e+04_r8,0.86200e+03_r8, & + & 0.74953e+03_r8,0.88586e+03_r8,0.10239e+04_r8,0.11637e+04_r8 /) + kao(:, 2, 3,12) = (/ & + & 0.16530e+04_r8,0.14535e+04_r8,0.12505e+04_r8,0.10502e+04_r8,0.84485e+03_r8, & + & 0.74734e+03_r8,0.88380e+03_r8,0.10224e+04_r8,0.11623e+04_r8 /) + kao(:, 3, 3,12) = (/ & + & 0.16258e+04_r8,0.14316e+04_r8,0.12308e+04_r8,0.10274e+04_r8,0.82737e+03_r8, & + & 0.74498e+03_r8,0.88220e+03_r8,0.10214e+04_r8,0.11612e+04_r8 /) + kao(:, 4, 3,12) = (/ & + & 0.15947e+04_r8,0.13987e+04_r8,0.12036e+04_r8,0.10100e+04_r8,0.81398e+03_r8, & + & 0.74250e+03_r8,0.88073e+03_r8,0.10203e+04_r8,0.11601e+04_r8 /) + kao(:, 5, 3,12) = (/ & + & 0.15659e+04_r8,0.13745e+04_r8,0.11827e+04_r8,0.99357e+03_r8,0.79945e+03_r8, & + & 0.74072e+03_r8,0.87844e+03_r8,0.10192e+04_r8,0.11574e+04_r8 /) + kao(:, 1, 4,12) = (/ & + & 0.15993e+04_r8,0.14029e+04_r8,0.12034e+04_r8,0.10105e+04_r8,0.81494e+03_r8, & + & 0.74898e+03_r8,0.88604e+03_r8,0.10246e+04_r8,0.11648e+04_r8 /) + kao(:, 2, 4,12) = (/ & + & 0.15603e+04_r8,0.13717e+04_r8,0.11803e+04_r8,0.99158e+03_r8,0.79797e+03_r8, & + & 0.74702e+03_r8,0.88413e+03_r8,0.10230e+04_r8,0.11631e+04_r8 /) + kao(:, 3, 4,12) = (/ & + & 0.15363e+04_r8,0.13460e+04_r8,0.11581e+04_r8,0.97158e+03_r8,0.78286e+03_r8, & + & 0.74488e+03_r8,0.88249e+03_r8,0.10215e+04_r8,0.11618e+04_r8 /) + kao(:, 4, 4,12) = (/ & + & 0.15069e+04_r8,0.13248e+04_r8,0.11397e+04_r8,0.95515e+03_r8,0.77185e+03_r8, & + & 0.74259e+03_r8,0.88086e+03_r8,0.10207e+04_r8,0.11608e+04_r8 /) + kao(:, 5, 4,12) = (/ & + & 0.14842e+04_r8,0.13030e+04_r8,0.11201e+04_r8,0.94205e+03_r8,0.75928e+03_r8, & + & 0.74072e+03_r8,0.87912e+03_r8,0.10193e+04_r8,0.11593e+04_r8 /) + kao(:, 1, 5,12) = (/ & + & 0.15161e+04_r8,0.13293e+04_r8,0.11434e+04_r8,0.96071e+03_r8,0.77366e+03_r8, & + & 0.74856e+03_r8,0.88634e+03_r8,0.10256e+04_r8,0.11660e+04_r8 /) + kao(:, 2, 5,12) = (/ & + & 0.14862e+04_r8,0.13039e+04_r8,0.11202e+04_r8,0.93927e+03_r8,0.75808e+03_r8, & + & 0.74678e+03_r8,0.88432e+03_r8,0.10237e+04_r8,0.11641e+04_r8 /) + kao(:, 3, 5,12) = (/ & + & 0.14569e+04_r8,0.12812e+04_r8,0.11040e+04_r8,0.92477e+03_r8,0.74608e+03_r8, & + & 0.74483e+03_r8,0.88267e+03_r8,0.10221e+04_r8,0.11626e+04_r8 /) + kao(:, 4, 5,12) = (/ & + & 0.14370e+04_r8,0.12601e+04_r8,0.10866e+04_r8,0.91322e+03_r8,0.73546e+03_r8, & + & 0.74282e+03_r8,0.88106e+03_r8,0.10210e+04_r8,0.11614e+04_r8 /) + kao(:, 5, 5,12) = (/ & + & 0.14157e+04_r8,0.12432e+04_r8,0.10692e+04_r8,0.89766e+03_r8,0.72371e+03_r8, & + & 0.74075e+03_r8,0.87977e+03_r8,0.10201e+04_r8,0.11604e+04_r8 /) + kao(:, 1, 6,12) = (/ & + & 0.14446e+04_r8,0.12668e+04_r8,0.10902e+04_r8,0.91458e+03_r8,0.73853e+03_r8, & + & 0.74800e+03_r8,0.88683e+03_r8,0.10267e+04_r8,0.11674e+04_r8 /) + kao(:, 2, 6,12) = (/ & + & 0.14180e+04_r8,0.12442e+04_r8,0.10729e+04_r8,0.90054e+03_r8,0.72712e+03_r8, & + & 0.74664e+03_r8,0.88490e+03_r8,0.10243e+04_r8,0.11653e+04_r8 /) + kao(:, 3, 6,12) = (/ & + & 0.13970e+04_r8,0.12338e+04_r8,0.10562e+04_r8,0.88644e+03_r8,0.71466e+03_r8, & + & 0.74490e+03_r8,0.88299e+03_r8,0.10228e+04_r8,0.11635e+04_r8 /) + kao(:, 4, 6,12) = (/ & + & 0.13772e+04_r8,0.12092e+04_r8,0.10403e+04_r8,0.87191e+03_r8,0.70566e+03_r8, & + & 0.74297e+03_r8,0.88145e+03_r8,0.10214e+04_r8,0.11622e+04_r8 /) + kao(:, 5, 6,12) = (/ & + & 0.13536e+04_r8,0.11933e+04_r8,0.10279e+04_r8,0.85985e+03_r8,0.69532e+03_r8, & + & 0.74091e+03_r8,0.88002e+03_r8,0.10207e+04_r8,0.11611e+04_r8 /) + kao(:, 1, 7,12) = (/ & + & 0.13872e+04_r8,0.12173e+04_r8,0.10473e+04_r8,0.87779e+03_r8,0.70929e+03_r8, & + & 0.74753e+03_r8,0.88739e+03_r8,0.10279e+04_r8,0.11686e+04_r8 /) + kao(:, 2, 7,12) = (/ & + & 0.13614e+04_r8,0.11960e+04_r8,0.10302e+04_r8,0.86342e+03_r8,0.69779e+03_r8, & + & 0.74649e+03_r8,0.88535e+03_r8,0.10254e+04_r8,0.11666e+04_r8 /) + kao(:, 3, 7,12) = (/ & + & 0.13423e+04_r8,0.11779e+04_r8,0.10152e+04_r8,0.85120e+03_r8,0.68669e+03_r8, & + & 0.74500e+03_r8,0.88364e+03_r8,0.10236e+04_r8,0.11646e+04_r8 /) + kao(:, 4, 7,12) = (/ & + & 0.13222e+04_r8,0.11614e+04_r8,0.10027e+04_r8,0.84138e+03_r8,0.67980e+03_r8, & + & 0.74324e+03_r8,0.88194e+03_r8,0.10219e+04_r8,0.11628e+04_r8 /) + kao(:, 5, 7,12) = (/ & + & 0.13077e+04_r8,0.11487e+04_r8,0.98870e+03_r8,0.82923e+03_r8,0.67117e+03_r8, & + & 0.74131e+03_r8,0.88052e+03_r8,0.10200e+04_r8,0.11617e+04_r8 /) + kao(:, 1, 8,12) = (/ & + & 0.13318e+04_r8,0.11751e+04_r8,0.10116e+04_r8,0.84760e+03_r8,0.68552e+03_r8, & + & 0.74755e+03_r8,0.88764e+03_r8,0.10284e+04_r8,0.11697e+04_r8 /) + kao(:, 2, 8,12) = (/ & + & 0.13123e+04_r8,0.11533e+04_r8,0.99316e+03_r8,0.83364e+03_r8,0.67452e+03_r8, & + & 0.74634e+03_r8,0.88623e+03_r8,0.10267e+04_r8,0.11679e+04_r8 /) + kao(:, 3, 8,12) = (/ & + & 0.12963e+04_r8,0.11395e+04_r8,0.98036e+03_r8,0.82206e+03_r8,0.66378e+03_r8, & + & 0.74528e+03_r8,0.88422e+03_r8,0.10245e+04_r8,0.11657e+04_r8 /) + kao(:, 4, 8,12) = (/ & + & 0.12799e+04_r8,0.11235e+04_r8,0.96838e+03_r8,0.81175e+03_r8,0.65688e+03_r8, & + & 0.74350e+03_r8,0.88249e+03_r8,0.10227e+04_r8,0.11639e+04_r8 /) + kao(:, 5, 8,12) = (/ & + & 0.12649e+04_r8,0.11128e+04_r8,0.95762e+03_r8,0.80323e+03_r8,0.64917e+03_r8, & + & 0.74172e+03_r8,0.88089e+03_r8,0.10213e+04_r8,0.11624e+04_r8 /) + kao(:, 1, 9,12) = (/ & + & 0.12892e+04_r8,0.11353e+04_r8,0.97529e+03_r8,0.81997e+03_r8,0.66439e+03_r8, & + & 0.74689e+03_r8,0.88774e+03_r8,0.10288e+04_r8,0.11703e+04_r8 /) + kao(:, 2, 9,12) = (/ & + & 0.12710e+04_r8,0.11179e+04_r8,0.96230e+03_r8,0.80757e+03_r8,0.65174e+03_r8, & + & 0.74606e+03_r8,0.88671e+03_r8,0.10277e+04_r8,0.11691e+04_r8 /) + kao(:, 3, 9,12) = (/ & + & 0.12556e+04_r8,0.11026e+04_r8,0.95506e+03_r8,0.79904e+03_r8,0.64512e+03_r8, & + & 0.74525e+03_r8,0.88489e+03_r8,0.10254e+04_r8,0.11669e+04_r8 /) + kao(:, 4, 9,12) = (/ & + & 0.12434e+04_r8,0.10930e+04_r8,0.94625e+03_r8,0.79326e+03_r8,0.63956e+03_r8, & + & 0.74375e+03_r8,0.88308e+03_r8,0.10236e+04_r8,0.11649e+04_r8 /) + kao(:, 5, 9,12) = (/ & + & 0.12362e+04_r8,0.10807e+04_r8,0.93519e+03_r8,0.78318e+03_r8,0.63176e+03_r8, & + & 0.74222e+03_r8,0.88144e+03_r8,0.10218e+04_r8,0.11632e+04_r8 /) + kao(:, 1,10,12) = (/ & + & 0.12560e+04_r8,0.11008e+04_r8,0.94819e+03_r8,0.79713e+03_r8,0.64289e+03_r8, & + & 0.74662e+03_r8,0.88790e+03_r8,0.10293e+04_r8,0.11710e+04_r8 /) + kao(:, 2,10,12) = (/ & + & 0.12370e+04_r8,0.10868e+04_r8,0.93614e+03_r8,0.78750e+03_r8,0.63591e+03_r8, & + & 0.74589e+03_r8,0.88689e+03_r8,0.10281e+04_r8,0.11697e+04_r8 /) + kao(:, 3,10,12) = (/ & + & 0.12228e+04_r8,0.10745e+04_r8,0.92565e+03_r8,0.77586e+03_r8,0.63013e+03_r8, & + & 0.74525e+03_r8,0.88546e+03_r8,0.10265e+04_r8,0.11680e+04_r8 /) + kao(:, 4,10,12) = (/ & + & 0.12130e+04_r8,0.10629e+04_r8,0.91805e+03_r8,0.77218e+03_r8,0.62214e+03_r8, & + & 0.74398e+03_r8,0.88360e+03_r8,0.10243e+04_r8,0.11659e+04_r8 /) + kao(:, 5,10,12) = (/ & + & 0.11990e+04_r8,0.10561e+04_r8,0.90990e+03_r8,0.76234e+03_r8,0.61782e+03_r8, & + & 0.74238e+03_r8,0.88192e+03_r8,0.10225e+04_r8,0.11640e+04_r8 /) + kao(:, 1,11,12) = (/ & + & 0.12160e+04_r8,0.10660e+04_r8,0.91756e+03_r8,0.77092e+03_r8,0.62410e+03_r8, & + & 0.74614e+03_r8,0.88758e+03_r8,0.10288e+04_r8,0.11712e+04_r8 /) + kao(:, 2,11,12) = (/ & + & 0.12001e+04_r8,0.10573e+04_r8,0.90897e+03_r8,0.76187e+03_r8,0.61778e+03_r8, & + & 0.74563e+03_r8,0.88659e+03_r8,0.10280e+04_r8,0.11697e+04_r8 /) + kao(:, 3,11,12) = (/ & + & 0.11883e+04_r8,0.10436e+04_r8,0.89901e+03_r8,0.75711e+03_r8,0.61087e+03_r8, & + & 0.74468e+03_r8,0.88519e+03_r8,0.10264e+04_r8,0.11680e+04_r8 /) + kao(:, 4,11,12) = (/ & + & 0.11791e+04_r8,0.10338e+04_r8,0.89462e+03_r8,0.74974e+03_r8,0.60740e+03_r8, & + & 0.74372e+03_r8,0.88322e+03_r8,0.10242e+04_r8,0.11659e+04_r8 /) + kao(:, 5,11,12) = (/ & + & 0.11736e+04_r8,0.10284e+04_r8,0.88610e+03_r8,0.74386e+03_r8,0.60256e+03_r8, & + & 0.74204e+03_r8,0.88156e+03_r8,0.10223e+04_r8,0.11640e+04_r8 /) + kao(:, 1,12,12) = (/ & + & 0.11783e+04_r8,0.10408e+04_r8,0.89462e+03_r8,0.75034e+03_r8,0.60838e+03_r8, & + & 0.74575e+03_r8,0.88732e+03_r8,0.10288e+04_r8,0.11710e+04_r8 /) + kao(:, 2,12,12) = (/ & + & 0.11693e+04_r8,0.10333e+04_r8,0.88486e+03_r8,0.74467e+03_r8,0.60420e+03_r8, & + & 0.74514e+03_r8,0.88635e+03_r8,0.10279e+04_r8,0.11697e+04_r8 /) + kao(:, 3,12,12) = (/ & + & 0.11597e+04_r8,0.10197e+04_r8,0.87845e+03_r8,0.73901e+03_r8,0.60371e+03_r8, & + & 0.74440e+03_r8,0.88495e+03_r8,0.10263e+04_r8,0.11680e+04_r8 /) + kao(:, 4,12,12) = (/ & + & 0.11554e+04_r8,0.10154e+04_r8,0.87390e+03_r8,0.73209e+03_r8,0.60310e+03_r8, & + & 0.74343e+03_r8,0.88312e+03_r8,0.10241e+04_r8,0.11659e+04_r8 /) + kao(:, 5,12,12) = (/ & + & 0.11463e+04_r8,0.10081e+04_r8,0.86768e+03_r8,0.73113e+03_r8,0.60226e+03_r8, & + & 0.74178e+03_r8,0.88148e+03_r8,0.10222e+04_r8,0.11640e+04_r8 /) + kao(:, 1,13,12) = (/ & + & 0.11576e+04_r8,0.10172e+04_r8,0.87697e+03_r8,0.73496e+03_r8,0.60442e+03_r8, & + & 0.74542e+03_r8,0.88710e+03_r8,0.10287e+04_r8,0.11710e+04_r8 /) + kao(:, 2,13,12) = (/ & + & 0.11489e+04_r8,0.10121e+04_r8,0.86787e+03_r8,0.73038e+03_r8,0.60369e+03_r8, & + & 0.74483e+03_r8,0.88615e+03_r8,0.10278e+04_r8,0.11697e+04_r8 /) + kao(:, 3,13,12) = (/ & + & 0.11408e+04_r8,0.10003e+04_r8,0.86069e+03_r8,0.72468e+03_r8,0.60332e+03_r8, & + & 0.74398e+03_r8,0.88477e+03_r8,0.10262e+04_r8,0.11679e+04_r8 /) + kao(:, 4,13,12) = (/ & + & 0.11353e+04_r8,0.99812e+03_r8,0.85805e+03_r8,0.72010e+03_r8,0.60276e+03_r8, & + & 0.74301e+03_r8,0.88294e+03_r8,0.10240e+04_r8,0.11659e+04_r8 /) + kao(:, 5,13,12) = (/ & + & 0.11276e+04_r8,0.99093e+03_r8,0.85424e+03_r8,0.71851e+03_r8,0.60186e+03_r8, & + & 0.74137e+03_r8,0.88131e+03_r8,0.10223e+04_r8,0.11640e+04_r8 /) + kao(:, 1, 1,13) = (/ & + & 0.19698e+04_r8,0.17183e+04_r8,0.14812e+04_r8,0.12476e+04_r8,0.10057e+04_r8, & + & 0.76142e+03_r8,0.89076e+03_r8,0.10305e+04_r8,0.11701e+04_r8 /) + kao(:, 2, 1,13) = (/ & + & 0.19138e+04_r8,0.16790e+04_r8,0.14471e+04_r8,0.12079e+04_r8,0.97024e+03_r8, & + & 0.74958e+03_r8,0.88854e+03_r8,0.10281e+04_r8,0.11676e+04_r8 /) + kao(:, 3, 1,13) = (/ & + & 0.18656e+04_r8,0.16362e+04_r8,0.14072e+04_r8,0.11764e+04_r8,0.95368e+03_r8, & + & 0.74756e+03_r8,0.88578e+03_r8,0.10247e+04_r8,0.11642e+04_r8 /) + kao(:, 4, 1,13) = (/ & + & 0.18274e+04_r8,0.16076e+04_r8,0.13744e+04_r8,0.11522e+04_r8,0.93101e+03_r8, & + & 0.74489e+03_r8,0.88368e+03_r8,0.10224e+04_r8,0.11624e+04_r8 /) + kao(:, 5, 1,13) = (/ & + & 0.18123e+04_r8,0.15711e+04_r8,0.13539e+04_r8,0.11391e+04_r8,0.91271e+03_r8, & + & 0.74309e+03_r8,0.88194e+03_r8,0.10210e+04_r8,0.11601e+04_r8 /) + kao(:, 1, 2,13) = (/ & + & 0.18136e+04_r8,0.16074e+04_r8,0.13682e+04_r8,0.11455e+04_r8,0.92152e+03_r8, & + & 0.75090e+03_r8,0.89044e+03_r8,0.10309e+04_r8,0.11711e+04_r8 /) + kao(:, 2, 2,13) = (/ & + & 0.17663e+04_r8,0.15639e+04_r8,0.13412e+04_r8,0.11338e+04_r8,0.90565e+03_r8, & + & 0.74892e+03_r8,0.88842e+03_r8,0.10286e+04_r8,0.11690e+04_r8 /) + kao(:, 3, 2,13) = (/ & + & 0.17473e+04_r8,0.15168e+04_r8,0.13179e+04_r8,0.10933e+04_r8,0.88564e+03_r8, & + & 0.74657e+03_r8,0.88587e+03_r8,0.10277e+04_r8,0.11659e+04_r8 /) + kao(:, 4, 2,13) = (/ & + & 0.16935e+04_r8,0.14940e+04_r8,0.12866e+04_r8,0.10771e+04_r8,0.86513e+03_r8, & + & 0.74388e+03_r8,0.88292e+03_r8,0.10226e+04_r8,0.11621e+04_r8 /) + kao(:, 5, 2,13) = (/ & + & 0.16796e+04_r8,0.14587e+04_r8,0.12610e+04_r8,0.10625e+04_r8,0.85051e+03_r8, & + & 0.74222e+03_r8,0.88187e+03_r8,0.10215e+04_r8,0.11614e+04_r8 /) + kao(:, 1, 3,13) = (/ & + & 0.16915e+04_r8,0.14853e+04_r8,0.12759e+04_r8,0.10742e+04_r8,0.87078e+03_r8, & + & 0.75040e+03_r8,0.89056e+03_r8,0.10314e+04_r8,0.11723e+04_r8 /) + kao(:, 2, 3,13) = (/ & + & 0.16685e+04_r8,0.14695e+04_r8,0.12569e+04_r8,0.10522e+04_r8,0.84369e+03_r8, & + & 0.74849e+03_r8,0.88875e+03_r8,0.10295e+04_r8,0.11702e+04_r8 /) + kao(:, 3, 3,13) = (/ & + & 0.16315e+04_r8,0.14234e+04_r8,0.12207e+04_r8,0.10278e+04_r8,0.83542e+03_r8, & + & 0.74665e+03_r8,0.88665e+03_r8,0.10272e+04_r8,0.11677e+04_r8 /) + kao(:, 4, 3,13) = (/ & + & 0.15936e+04_r8,0.13973e+04_r8,0.11983e+04_r8,0.10068e+04_r8,0.81253e+03_r8, & + & 0.74392e+03_r8,0.88383e+03_r8,0.10241e+04_r8,0.11643e+04_r8 /) + kao(:, 5, 3,13) = (/ & + & 0.15704e+04_r8,0.13749e+04_r8,0.11794e+04_r8,0.99081e+03_r8,0.79887e+03_r8, & + & 0.74214e+03_r8,0.88216e+03_r8,0.10204e+04_r8,0.11625e+04_r8 /) + kao(:, 1, 4,13) = (/ & + & 0.16005e+04_r8,0.14146e+04_r8,0.12141e+04_r8,0.10096e+04_r8,0.81830e+03_r8, & + & 0.74981e+03_r8,0.89073e+03_r8,0.10323e+04_r8,0.11736e+04_r8 /) + kao(:, 2, 4,13) = (/ & + & 0.15697e+04_r8,0.13709e+04_r8,0.11792e+04_r8,0.98706e+03_r8,0.80274e+03_r8, & + & 0.74843e+03_r8,0.88917e+03_r8,0.10304e+04_r8,0.11716e+04_r8 /) + kao(:, 3, 4,13) = (/ & + & 0.15342e+04_r8,0.13528e+04_r8,0.11633e+04_r8,0.97494e+03_r8,0.78298e+03_r8, & + & 0.74655e+03_r8,0.88714e+03_r8,0.10283e+04_r8,0.11694e+04_r8 /) + kao(:, 4, 4,13) = (/ & + & 0.15079e+04_r8,0.13273e+04_r8,0.11368e+04_r8,0.95326e+03_r8,0.76898e+03_r8, & + & 0.74477e+03_r8,0.88522e+03_r8,0.10258e+04_r8,0.11666e+04_r8 /) + kao(:, 5, 4,13) = (/ & + & 0.14904e+04_r8,0.13050e+04_r8,0.11274e+04_r8,0.94133e+03_r8,0.75918e+03_r8, & + & 0.74185e+03_r8,0.88236e+03_r8,0.10229e+04_r8,0.11634e+04_r8 /) + kao(:, 1, 5,13) = (/ & + & 0.15223e+04_r8,0.13292e+04_r8,0.11458e+04_r8,0.96632e+03_r8,0.77253e+03_r8, & + & 0.74931e+03_r8,0.89080e+03_r8,0.10327e+04_r8,0.11744e+04_r8 /) + kao(:, 2, 5,13) = (/ & + & 0.14887e+04_r8,0.13100e+04_r8,0.11308e+04_r8,0.95564e+03_r8,0.76318e+03_r8, & + & 0.74814e+03_r8,0.88953e+03_r8,0.10311e+04_r8,0.11728e+04_r8 /) + kao(:, 3, 5,13) = (/ & + & 0.14666e+04_r8,0.12805e+04_r8,0.10990e+04_r8,0.92585e+03_r8,0.74527e+03_r8, & + & 0.74662e+03_r8,0.88788e+03_r8,0.10293e+04_r8,0.11708e+04_r8 /) + kao(:, 4, 5,13) = (/ & + & 0.14380e+04_r8,0.12615e+04_r8,0.10805e+04_r8,0.91192e+03_r8,0.73306e+03_r8, & + & 0.74471e+03_r8,0.88594e+03_r8,0.10272e+04_r8,0.11684e+04_r8 /) + kao(:, 5, 5,13) = (/ & + & 0.14117e+04_r8,0.12389e+04_r8,0.10707e+04_r8,0.89863e+03_r8,0.72872e+03_r8, & + & 0.74254e+03_r8,0.88356e+03_r8,0.10243e+04_r8,0.11652e+04_r8 /) + kao(:, 1, 6,13) = (/ & + & 0.14428e+04_r8,0.12661e+04_r8,0.10990e+04_r8,0.91605e+03_r8,0.74645e+03_r8, & + & 0.74914e+03_r8,0.89068e+03_r8,0.10327e+04_r8,0.11747e+04_r8 /) + kao(:, 2, 6,13) = (/ & + & 0.14277e+04_r8,0.12454e+04_r8,0.10670e+04_r8,0.90364e+03_r8,0.72758e+03_r8, & + & 0.74802e+03_r8,0.88983e+03_r8,0.10318e+04_r8,0.11738e+04_r8 /) + kao(:, 3, 6,13) = (/ & + & 0.14072e+04_r8,0.12244e+04_r8,0.10539e+04_r8,0.88576e+03_r8,0.71342e+03_r8, & + & 0.74674e+03_r8,0.88844e+03_r8,0.10303e+04_r8,0.11723e+04_r8 /) + kao(:, 4, 6,13) = (/ & + & 0.13764e+04_r8,0.12101e+04_r8,0.10371e+04_r8,0.87173e+03_r8,0.70565e+03_r8, & + & 0.74519e+03_r8,0.88672e+03_r8,0.10284e+04_r8,0.11700e+04_r8 /) + kao(:, 5, 6,13) = (/ & + & 0.13559e+04_r8,0.11928e+04_r8,0.10275e+04_r8,0.87202e+03_r8,0.69916e+03_r8, & + & 0.74337e+03_r8,0.88468e+03_r8,0.10257e+04_r8,0.11677e+04_r8 /) + kao(:, 1, 7,13) = (/ & + & 0.13816e+04_r8,0.12181e+04_r8,0.10498e+04_r8,0.87727e+03_r8,0.70862e+03_r8, & + & 0.74879e+03_r8,0.89032e+03_r8,0.10324e+04_r8,0.11748e+04_r8 /) + kao(:, 2, 7,13) = (/ & + & 0.13746e+04_r8,0.12007e+04_r8,0.10368e+04_r8,0.86700e+03_r8,0.69742e+03_r8, & + & 0.74791e+03_r8,0.88998e+03_r8,0.10322e+04_r8,0.11745e+04_r8 /) + kao(:, 3, 7,13) = (/ & + & 0.13471e+04_r8,0.11822e+04_r8,0.10118e+04_r8,0.85187e+03_r8,0.69076e+03_r8, & + & 0.74684e+03_r8,0.88891e+03_r8,0.10311e+04_r8,0.11732e+04_r8 /) + kao(:, 4, 7,13) = (/ & + & 0.13306e+04_r8,0.11625e+04_r8,0.10055e+04_r8,0.83687e+03_r8,0.67946e+03_r8, & + & 0.74564e+03_r8,0.88741e+03_r8,0.10294e+04_r8,0.11714e+04_r8 /) + kao(:, 5, 7,13) = (/ & + & 0.13072e+04_r8,0.11462e+04_r8,0.98997e+03_r8,0.82975e+03_r8,0.67148e+03_r8, & + & 0.74390e+03_r8,0.88544e+03_r8,0.10275e+04_r8,0.11691e+04_r8 /) + kao(:, 1, 8,13) = (/ & + & 0.13342e+04_r8,0.11738e+04_r8,0.10072e+04_r8,0.84777e+03_r8,0.68336e+03_r8, & + & 0.74810e+03_r8,0.89032e+03_r8,0.10328e+04_r8,0.11753e+04_r8 /) + kao(:, 2, 8,13) = (/ & + & 0.13170e+04_r8,0.11565e+04_r8,0.99551e+03_r8,0.83812e+03_r8,0.67873e+03_r8, & + & 0.74767e+03_r8,0.88984e+03_r8,0.10325e+04_r8,0.11747e+04_r8 /) + kao(:, 3, 8,13) = (/ & + & 0.12961e+04_r8,0.11348e+04_r8,0.98531e+03_r8,0.82142e+03_r8,0.66767e+03_r8, & + & 0.74660e+03_r8,0.88923e+03_r8,0.10317e+04_r8,0.11741e+04_r8 /) + kao(:, 4, 8,13) = (/ & + & 0.12863e+04_r8,0.11324e+04_r8,0.96704e+03_r8,0.81553e+03_r8,0.65703e+03_r8, & + & 0.74590e+03_r8,0.88815e+03_r8,0.10305e+04_r8,0.11725e+04_r8 /) + kao(:, 5, 8,13) = (/ & + & 0.12689e+04_r8,0.11113e+04_r8,0.96142e+03_r8,0.81188e+03_r8,0.65150e+03_r8, & + & 0.74435e+03_r8,0.88637e+03_r8,0.10284e+04_r8,0.11705e+04_r8 /) + kao(:, 1, 9,13) = (/ & + & 0.12929e+04_r8,0.11420e+04_r8,0.97941e+03_r8,0.82358e+03_r8,0.66259e+03_r8, & + & 0.74862e+03_r8,0.89046e+03_r8,0.10332e+04_r8,0.11761e+04_r8 /) + kao(:, 2, 9,13) = (/ & + & 0.12739e+04_r8,0.11222e+04_r8,0.96918e+03_r8,0.81141e+03_r8,0.65436e+03_r8, & + & 0.74747e+03_r8,0.88962e+03_r8,0.10323e+04_r8,0.11749e+04_r8 /) + kao(:, 3, 9,13) = (/ & + & 0.12674e+04_r8,0.11070e+04_r8,0.94554e+03_r8,0.79811e+03_r8,0.64989e+03_r8, & + & 0.74671e+03_r8,0.88937e+03_r8,0.10320e+04_r8,0.11746e+04_r8 /) + kao(:, 4, 9,13) = (/ & + & 0.12536e+04_r8,0.10974e+04_r8,0.93180e+03_r8,0.78881e+03_r8,0.64048e+03_r8, & + & 0.74596e+03_r8,0.88846e+03_r8,0.10310e+04_r8,0.11735e+04_r8 /) + kao(:, 5, 9,13) = (/ & + & 0.12304e+04_r8,0.10931e+04_r8,0.92897e+03_r8,0.78158e+03_r8,0.63657e+03_r8, & + & 0.74461e+03_r8,0.88706e+03_r8,0.10294e+04_r8,0.11717e+04_r8 /) + kao(:, 1,10,13) = (/ & + & 0.12516e+04_r8,0.11039e+04_r8,0.96641e+03_r8,0.80204e+03_r8,0.64728e+03_r8, & + & 0.74871e+03_r8,0.89043e+03_r8,0.10331e+04_r8,0.11761e+04_r8 /) + kao(:, 2,10,13) = (/ & + & 0.12445e+04_r8,0.10951e+04_r8,0.94205e+03_r8,0.78296e+03_r8,0.63684e+03_r8, & + & 0.74738e+03_r8,0.88974e+03_r8,0.10326e+04_r8,0.11754e+04_r8 /) + kao(:, 3,10,13) = (/ & + & 0.12212e+04_r8,0.10830e+04_r8,0.92907e+03_r8,0.78344e+03_r8,0.62583e+03_r8, & + & 0.74649e+03_r8,0.88924e+03_r8,0.10320e+04_r8,0.11747e+04_r8 /) + kao(:, 4,10,13) = (/ & + & 0.12116e+04_r8,0.10675e+04_r8,0.91424e+03_r8,0.76668e+03_r8,0.62374e+03_r8, & + & 0.74589e+03_r8,0.88889e+03_r8,0.10314e+04_r8,0.11741e+04_r8 /) + kao(:, 5,10,13) = (/ & + & 0.12052e+04_r8,0.10532e+04_r8,0.90488e+03_r8,0.76246e+03_r8,0.61399e+03_r8, & + & 0.74500e+03_r8,0.88754e+03_r8,0.10301e+04_r8,0.11727e+04_r8 /) + kao(:, 1,11,13) = (/ & + & 0.12119e+04_r8,0.10670e+04_r8,0.92549e+03_r8,0.77292e+03_r8,0.62469e+03_r8, & + & 0.74822e+03_r8,0.89015e+03_r8,0.10331e+04_r8,0.11759e+04_r8 /) + kao(:, 2,11,13) = (/ & + & 0.12040e+04_r8,0.10529e+04_r8,0.90947e+03_r8,0.76631e+03_r8,0.61756e+03_r8, & + & 0.74680e+03_r8,0.88950e+03_r8,0.10325e+04_r8,0.11754e+04_r8 /) + kao(:, 3,11,13) = (/ & + & 0.11932e+04_r8,0.10470e+04_r8,0.90374e+03_r8,0.75316e+03_r8,0.61137e+03_r8, & + & 0.74625e+03_r8,0.88901e+03_r8,0.10319e+04_r8,0.11747e+04_r8 /) + kao(:, 4,11,13) = (/ & + & 0.11901e+04_r8,0.10395e+04_r8,0.89205e+03_r8,0.75483e+03_r8,0.60707e+03_r8, & + & 0.74529e+03_r8,0.88868e+03_r8,0.10313e+04_r8,0.11742e+04_r8 /) + kao(:, 5,11,13) = (/ & + & 0.11740e+04_r8,0.10262e+04_r8,0.88782e+03_r8,0.74555e+03_r8,0.60321e+03_r8, & + & 0.74456e+03_r8,0.88735e+03_r8,0.10302e+04_r8,0.11727e+04_r8 /) + kao(:, 1,12,13) = (/ & + & 0.11952e+04_r8,0.10387e+04_r8,0.90464e+03_r8,0.75031e+03_r8,0.60579e+03_r8, & + & 0.74809e+03_r8,0.88993e+03_r8,0.10330e+04_r8,0.11761e+04_r8 /) + kao(:, 2,12,13) = (/ & + & 0.11767e+04_r8,0.10280e+04_r8,0.89305e+03_r8,0.74295e+03_r8,0.60520e+03_r8, & + & 0.74658e+03_r8,0.88930e+03_r8,0.10324e+04_r8,0.11754e+04_r8 /) + kao(:, 3,12,13) = (/ & + & 0.11638e+04_r8,0.10252e+04_r8,0.88200e+03_r8,0.74209e+03_r8,0.60448e+03_r8, & + & 0.74580e+03_r8,0.88883e+03_r8,0.10318e+04_r8,0.11747e+04_r8 /) + kao(:, 4,12,13) = (/ & + & 0.11608e+04_r8,0.10182e+04_r8,0.87717e+03_r8,0.73339e+03_r8,0.60384e+03_r8, & + & 0.74474e+03_r8,0.88834e+03_r8,0.10314e+04_r8,0.11742e+04_r8 /) + kao(:, 5,12,13) = (/ & + & 0.11455e+04_r8,0.10085e+04_r8,0.86868e+03_r8,0.72782e+03_r8,0.60261e+03_r8, & + & 0.74417e+03_r8,0.88752e+03_r8,0.10299e+04_r8,0.11727e+04_r8 /) + kao(:, 1,13,13) = (/ & + & 0.11538e+04_r8,0.10104e+04_r8,0.87836e+03_r8,0.74181e+03_r8,0.60545e+03_r8, & + & 0.74747e+03_r8,0.88975e+03_r8,0.10329e+04_r8,0.11763e+04_r8 /) + kao(:, 2,13,13) = (/ & + & 0.11412e+04_r8,0.10013e+04_r8,0.88484e+03_r8,0.73153e+03_r8,0.60489e+03_r8, & + & 0.74629e+03_r8,0.88914e+03_r8,0.10323e+04_r8,0.11754e+04_r8 /) + kao(:, 3,13,13) = (/ & + & 0.11370e+04_r8,0.10022e+04_r8,0.86246e+03_r8,0.73215e+03_r8,0.60419e+03_r8, & + & 0.74569e+03_r8,0.88867e+03_r8,0.10317e+04_r8,0.11747e+04_r8 /) + kao(:, 4,13,13) = (/ & + & 0.11288e+04_r8,0.99109e+03_r8,0.86549e+03_r8,0.72280e+03_r8,0.60356e+03_r8, & + & 0.74480e+03_r8,0.88820e+03_r8,0.10312e+04_r8,0.11742e+04_r8 /) + kao(:, 5,13,13) = (/ & + & 0.11445e+04_r8,0.99099e+03_r8,0.85129e+03_r8,0.71952e+03_r8,0.60234e+03_r8, & + & 0.74410e+03_r8,0.88705e+03_r8,0.10299e+04_r8,0.11727e+04_r8 /) + kao(:, 1, 1,14) = (/ & + & 0.20185e+04_r8,0.18044e+04_r8,0.14758e+04_r8,0.13047e+04_r8,0.10029e+04_r8, & + & 0.77460e+03_r8,0.89226e+03_r8,0.10322e+04_r8,0.11721e+04_r8 /) + kao(:, 2, 1,14) = (/ & + & 0.19173e+04_r8,0.17154e+04_r8,0.14467e+04_r8,0.12101e+04_r8,0.99594e+03_r8, & + & 0.75026e+03_r8,0.88974e+03_r8,0.10295e+04_r8,0.11713e+04_r8 /) + kao(:, 3, 1,14) = (/ & + & 0.19468e+04_r8,0.16851e+04_r8,0.14136e+04_r8,0.12474e+04_r8,0.94959e+03_r8, & + & 0.74773e+03_r8,0.88696e+03_r8,0.10271e+04_r8,0.11663e+04_r8 /) + kao(:, 4, 1,14) = (/ & + & 0.18423e+04_r8,0.16214e+04_r8,0.13991e+04_r8,0.11633e+04_r8,0.94698e+03_r8, & + & 0.74507e+03_r8,0.88457e+03_r8,0.10239e+04_r8,0.11632e+04_r8 /) + kao(:, 5, 1,14) = (/ & + & 0.17538e+04_r8,0.16376e+04_r8,0.13645e+04_r8,0.11303e+04_r8,0.98877e+03_r8, & + & 0.74430e+03_r8,0.88372e+03_r8,0.10232e+04_r8,0.11626e+04_r8 /) + kao(:, 1, 2,14) = (/ & + & 0.18551e+04_r8,0.16163e+04_r8,0.13640e+04_r8,0.12440e+04_r8,0.97095e+03_r8, & + & 0.75153e+03_r8,0.89202e+03_r8,0.10323e+04_r8,0.11731e+04_r8 /) + kao(:, 2, 2,14) = (/ & + & 0.18136e+04_r8,0.16209e+04_r8,0.13887e+04_r8,0.11127e+04_r8,0.90845e+03_r8, & + & 0.74936e+03_r8,0.88974e+03_r8,0.10301e+04_r8,0.11702e+04_r8 /) + kao(:, 3, 2,14) = (/ & + & 0.17918e+04_r8,0.15931e+04_r8,0.13282e+04_r8,0.11266e+04_r8,0.93052e+03_r8, & + & 0.74732e+03_r8,0.88725e+03_r8,0.10243e+04_r8,0.11672e+04_r8 /) + kao(:, 4, 2,14) = (/ & + & 0.17507e+04_r8,0.14791e+04_r8,0.12865e+04_r8,0.10818e+04_r8,0.87901e+03_r8, & + & 0.74478e+03_r8,0.88467e+03_r8,0.10246e+04_r8,0.11645e+04_r8 /) + kao(:, 5, 2,14) = (/ & + & 0.16872e+04_r8,0.14818e+04_r8,0.12871e+04_r8,0.10513e+04_r8,0.88744e+03_r8, & + & 0.74325e+03_r8,0.88337e+03_r8,0.10230e+04_r8,0.11625e+04_r8 /) + kao(:, 1, 3,14) = (/ & + & 0.16919e+04_r8,0.15533e+04_r8,0.13337e+04_r8,0.10831e+04_r8,0.86308e+03_r8, & + & 0.75085e+03_r8,0.89217e+03_r8,0.10333e+04_r8,0.11744e+04_r8 /) + kao(:, 2, 3,14) = (/ & + & 0.17034e+04_r8,0.15495e+04_r8,0.12643e+04_r8,0.11407e+04_r8,0.84365e+03_r8, & + & 0.74929e+03_r8,0.89025e+03_r8,0.10312e+04_r8,0.11722e+04_r8 /) + kao(:, 3, 3,14) = (/ & + & 0.16844e+04_r8,0.14282e+04_r8,0.12585e+04_r8,0.10790e+04_r8,0.84114e+03_r8, & + & 0.74691e+03_r8,0.88785e+03_r8,0.10286e+04_r8,0.11700e+04_r8 /) + kao(:, 4, 3,14) = (/ & + & 0.16791e+04_r8,0.14180e+04_r8,0.12209e+04_r8,0.10441e+04_r8,0.85899e+03_r8, & + & 0.74519e+03_r8,0.88544e+03_r8,0.10259e+04_r8,0.11667e+04_r8 /) + kao(:, 5, 3,14) = (/ & + & 0.16063e+04_r8,0.13774e+04_r8,0.12181e+04_r8,0.10006e+04_r8,0.82020e+03_r8, & + & 0.74245e+03_r8,0.88287e+03_r8,0.10231e+04_r8,0.11633e+04_r8 /) + kao(:, 1, 4,14) = (/ & + & 0.15960e+04_r8,0.13846e+04_r8,0.12078e+04_r8,0.10284e+04_r8,0.81079e+03_r8, & + & 0.75078e+03_r8,0.89233e+03_r8,0.10336e+04_r8,0.11751e+04_r8 /) + kao(:, 2, 4,14) = (/ & + & 0.16237e+04_r8,0.13919e+04_r8,0.11906e+04_r8,0.10115e+04_r8,0.83009e+03_r8, & + & 0.74909e+03_r8,0.89076e+03_r8,0.10322e+04_r8,0.11737e+04_r8 /) + kao(:, 3, 4,14) = (/ & + & 0.16136e+04_r8,0.13698e+04_r8,0.12046e+04_r8,0.98839e+03_r8,0.80997e+03_r8, & + & 0.74745e+03_r8,0.88871e+03_r8,0.10300e+04_r8,0.11712e+04_r8 /) + kao(:, 4, 4,14) = (/ & + & 0.15739e+04_r8,0.13753e+04_r8,0.11394e+04_r8,0.97871e+03_r8,0.77029e+03_r8, & + & 0.74770e+03_r8,0.88627e+03_r8,0.10279e+04_r8,0.11682e+04_r8 /) + kao(:, 5, 4,14) = (/ & + & 0.14863e+04_r8,0.13334e+04_r8,0.11445e+04_r8,0.95775e+03_r8,0.78998e+03_r8, & + & 0.74317e+03_r8,0.88387e+03_r8,0.10246e+04_r8,0.11653e+04_r8 /) + kao(:, 1, 5,14) = (/ & + & 0.15101e+04_r8,0.14006e+04_r8,0.11513e+04_r8,0.96783e+03_r8,0.79581e+03_r8, & + & 0.75045e+03_r8,0.89239e+03_r8,0.10340e+04_r8,0.11759e+04_r8 /) + kao(:, 2, 5,14) = (/ & + & 0.15461e+04_r8,0.13003e+04_r8,0.11685e+04_r8,0.92112e+03_r8,0.77517e+03_r8, & + & 0.74927e+03_r8,0.89114e+03_r8,0.10330e+04_r8,0.11749e+04_r8 /) + kao(:, 3, 5,14) = (/ & + & 0.14676e+04_r8,0.12966e+04_r8,0.11042e+04_r8,0.93875e+03_r8,0.79645e+03_r8, & + & 0.74772e+03_r8,0.88943e+03_r8,0.10311e+04_r8,0.11729e+04_r8 /) + kao(:, 4, 5,14) = (/ & + & 0.14571e+04_r8,0.12955e+04_r8,0.11734e+04_r8,0.89731e+03_r8,0.76986e+03_r8, & + & 0.74578e+03_r8,0.88723e+03_r8,0.10287e+04_r8,0.11702e+04_r8 /) + kao(:, 5, 5,14) = (/ & + & 0.14311e+04_r8,0.13054e+04_r8,0.10738e+04_r8,0.10079e+04_r8,0.72704e+03_r8, & + & 0.74437e+03_r8,0.88461e+03_r8,0.10260e+04_r8,0.11675e+04_r8 /) + kao(:, 1, 6,14) = (/ & + & 0.14715e+04_r8,0.12798e+04_r8,0.11182e+04_r8,0.92160e+03_r8,0.75379e+03_r8, & + & 0.75023e+03_r8,0.89251e+03_r8,0.10348e+04_r8,0.11771e+04_r8 /) + kao(:, 2, 6,14) = (/ & + & 0.14479e+04_r8,0.12414e+04_r8,0.11222e+04_r8,0.91289e+03_r8,0.75013e+03_r8, & + & 0.74921e+03_r8,0.89141e+03_r8,0.10336e+04_r8,0.11758e+04_r8 /) + kao(:, 3, 6,14) = (/ & + & 0.14270e+04_r8,0.12651e+04_r8,0.10793e+04_r8,0.91215e+03_r8,0.74649e+03_r8, & + & 0.74796e+03_r8,0.89005e+03_r8,0.10321e+04_r8,0.11739e+04_r8 /) + kao(:, 4, 6,14) = (/ & + & 0.14058e+04_r8,0.12702e+04_r8,0.11005e+04_r8,0.93809e+03_r8,0.69854e+03_r8, & + & 0.74632e+03_r8,0.88820e+03_r8,0.10301e+04_r8,0.11720e+04_r8 /) + kao(:, 5, 6,14) = (/ & + & 0.14048e+04_r8,0.12100e+04_r8,0.10413e+04_r8,0.84934e+03_r8,0.69794e+03_r8, & + & 0.74429e+03_r8,0.88588e+03_r8,0.10284e+04_r8,0.11701e+04_r8 /) + kao(:, 1, 7,14) = (/ & + & 0.14325e+04_r8,0.12413e+04_r8,0.10595e+04_r8,0.88906e+03_r8,0.71717e+03_r8, & + & 0.75037e+03_r8,0.89273e+03_r8,0.10353e+04_r8,0.11779e+04_r8 /) + kao(:, 2, 7,14) = (/ & + & 0.13620e+04_r8,0.12089e+04_r8,0.10598e+04_r8,0.89550e+03_r8,0.73134e+03_r8, & + & 0.74911e+03_r8,0.89161e+03_r8,0.10341e+04_r8,0.11766e+04_r8 /) + kao(:, 3, 7,14) = (/ & + & 0.13346e+04_r8,0.12111e+04_r8,0.10262e+04_r8,0.84775e+03_r8,0.68161e+03_r8, & + & 0.74811e+03_r8,0.89050e+03_r8,0.10329e+04_r8,0.11753e+04_r8 /) + kao(:, 4, 7,14) = (/ & + & 0.13132e+04_r8,0.11998e+04_r8,0.99757e+03_r8,0.86083e+03_r8,0.70251e+03_r8, & + & 0.74653e+03_r8,0.88899e+03_r8,0.10312e+04_r8,0.11735e+04_r8 /) + kao(:, 5, 7,14) = (/ & + & 0.13232e+04_r8,0.11634e+04_r8,0.10230e+04_r8,0.84353e+03_r8,0.68339e+03_r8, & + & 0.74500e+03_r8,0.88698e+03_r8,0.10287e+04_r8,0.11709e+04_r8 /) + kao(:, 1, 8,14) = (/ & + & 0.13366e+04_r8,0.11630e+04_r8,0.10188e+04_r8,0.86405e+03_r8,0.71800e+03_r8, & + & 0.75008e+03_r8,0.89285e+03_r8,0.10357e+04_r8,0.11785e+04_r8 /) + kao(:, 2, 8,14) = (/ & + & 0.13647e+04_r8,0.11518e+04_r8,0.10110e+04_r8,0.84719e+03_r8,0.67819e+03_r8, & + & 0.74911e+03_r8,0.89187e+03_r8,0.10343e+04_r8,0.11777e+04_r8 /) + kao(:, 3, 8,14) = (/ & + & 0.13128e+04_r8,0.11472e+04_r8,0.99038e+03_r8,0.82656e+03_r8,0.66483e+03_r8, & + & 0.74815e+03_r8,0.89080e+03_r8,0.10335e+04_r8,0.11761e+04_r8 /) + kao(:, 4, 8,14) = (/ & + & 0.12817e+04_r8,0.11127e+04_r8,0.10092e+04_r8,0.82047e+03_r8,0.65442e+03_r8, & + & 0.74685e+03_r8,0.88933e+03_r8,0.10318e+04_r8,0.11746e+04_r8 /) + kao(:, 5, 8,14) = (/ & + & 0.13162e+04_r8,0.11356e+04_r8,0.98305e+03_r8,0.84668e+03_r8,0.66544e+03_r8, & + & 0.74558e+03_r8,0.88790e+03_r8,0.10302e+04_r8,0.11725e+04_r8 /) + kao(:, 1, 9,14) = (/ & + & 0.13174e+04_r8,0.11399e+04_r8,0.97696e+03_r8,0.84117e+03_r8,0.66145e+03_r8, & + & 0.75011e+03_r8,0.89307e+03_r8,0.10362e+04_r8,0.11789e+04_r8 /) + kao(:, 2, 9,14) = (/ & + & 0.13196e+04_r8,0.11310e+04_r8,0.99094e+03_r8,0.80674e+03_r8,0.67265e+03_r8, & + & 0.74915e+03_r8,0.89213e+03_r8,0.10351e+04_r8,0.11781e+04_r8 /) + kao(:, 3, 9,14) = (/ & + & 0.12950e+04_r8,0.10983e+04_r8,0.10229e+04_r8,0.86051e+03_r8,0.66007e+03_r8, & + & 0.74819e+03_r8,0.89107e+03_r8,0.10339e+04_r8,0.11768e+04_r8 /) + kao(:, 4, 9,14) = (/ & + & 0.12605e+04_r8,0.10785e+04_r8,0.10061e+04_r8,0.79531e+03_r8,0.63414e+03_r8, & + & 0.74728e+03_r8,0.89004e+03_r8,0.10328e+04_r8,0.11756e+04_r8 /) + kao(:, 5, 9,14) = (/ & + & 0.12553e+04_r8,0.10628e+04_r8,0.94908e+03_r8,0.82074e+03_r8,0.64983e+03_r8, & + & 0.74606e+03_r8,0.88866e+03_r8,0.10313e+04_r8,0.11739e+04_r8 /) + kao(:, 1,10,14) = (/ & + & 0.13413e+04_r8,0.11632e+04_r8,0.10048e+04_r8,0.80476e+03_r8,0.65189e+03_r8, & + & 0.75022e+03_r8,0.89354e+03_r8,0.10369e+04_r8,0.11806e+04_r8 /) + kao(:, 2,10,14) = (/ & + & 0.12838e+04_r8,0.11017e+04_r8,0.10173e+04_r8,0.85213e+03_r8,0.64367e+03_r8, & + & 0.74909e+03_r8,0.89223e+03_r8,0.10354e+04_r8,0.11786e+04_r8 /) + kao(:, 3,10,14) = (/ & + & 0.12657e+04_r8,0.11229e+04_r8,0.92134e+03_r8,0.80214e+03_r8,0.64195e+03_r8, & + & 0.74870e+03_r8,0.89159e+03_r8,0.10344e+04_r8,0.11778e+04_r8 /) + kao(:, 4,10,14) = (/ & + & 0.12310e+04_r8,0.10594e+04_r8,0.92792e+03_r8,0.78251e+03_r8,0.62401e+03_r8, & + & 0.74734e+03_r8,0.89003e+03_r8,0.10332e+04_r8,0.11762e+04_r8 /) + kao(:, 5,10,14) = (/ & + & 0.12088e+04_r8,0.10663e+04_r8,0.92275e+03_r8,0.77707e+03_r8,0.64354e+03_r8, & + & 0.74634e+03_r8,0.88914e+03_r8,0.10320e+04_r8,0.11748e+04_r8 /) + kao(:, 1,11,14) = (/ & + & 0.12205e+04_r8,0.10982e+04_r8,0.93349e+03_r8,0.79899e+03_r8,0.64961e+03_r8, & + & 0.74981e+03_r8,0.89329e+03_r8,0.10368e+04_r8,0.11803e+04_r8 /) + kao(:, 2,11,14) = (/ & + & 0.12266e+04_r8,0.10977e+04_r8,0.90836e+03_r8,0.76723e+03_r8,0.61851e+03_r8, & + & 0.74871e+03_r8,0.89199e+03_r8,0.10353e+04_r8,0.11786e+04_r8 /) + kao(:, 3,11,14) = (/ & + & 0.11876e+04_r8,0.10750e+04_r8,0.92258e+03_r8,0.76849e+03_r8,0.61349e+03_r8, & + & 0.74902e+03_r8,0.89163e+03_r8,0.10343e+04_r8,0.11775e+04_r8 /) + kao(:, 4,11,14) = (/ & + & 0.12363e+04_r8,0.10327e+04_r8,0.91965e+03_r8,0.74736e+03_r8,0.60206e+03_r8, & + & 0.74703e+03_r8,0.88982e+03_r8,0.10331e+04_r8,0.11762e+04_r8 /) + kao(:, 5,11,14) = (/ & + & 0.11827e+04_r8,0.10266e+04_r8,0.89018e+03_r8,0.76668e+03_r8,0.60360e+03_r8, & + & 0.74604e+03_r8,0.88895e+03_r8,0.10316e+04_r8,0.11748e+04_r8 /) + kao(:, 1,12,14) = (/ & + & 0.11808e+04_r8,0.10792e+04_r8,0.88334e+03_r8,0.76947e+03_r8,0.60663e+03_r8, & + & 0.74904e+03_r8,0.89307e+03_r8,0.10367e+04_r8,0.11803e+04_r8 /) + kao(:, 2,12,14) = (/ & + & 0.12120e+04_r8,0.10402e+04_r8,0.92096e+03_r8,0.78880e+03_r8,0.60609e+03_r8, & + & 0.74841e+03_r8,0.89179e+03_r8,0.10352e+04_r8,0.11786e+04_r8 /) + kao(:, 3,12,14) = (/ & + & 0.12016e+04_r8,0.10899e+04_r8,0.90018e+03_r8,0.73017e+03_r8,0.60527e+03_r8, & + & 0.75028e+03_r8,0.89119e+03_r8,0.10342e+04_r8,0.11778e+04_r8 /) + kao(:, 4,12,14) = (/ & + & 0.11901e+04_r8,0.10101e+04_r8,0.88929e+03_r8,0.75342e+03_r8,0.60426e+03_r8, & + & 0.74677e+03_r8,0.88991e+03_r8,0.10327e+04_r8,0.11762e+04_r8 /) + kao(:, 5,12,14) = (/ & + & 0.12404e+04_r8,0.10285e+04_r8,0.87283e+03_r8,0.77029e+03_r8,0.60316e+03_r8, & + & 0.74579e+03_r8,0.88852e+03_r8,0.10318e+04_r8,0.11748e+04_r8 /) + kao(:, 1,13,14) = (/ & + & 0.11819e+04_r8,0.10465e+04_r8,0.87588e+03_r8,0.72550e+03_r8,0.60649e+03_r8, & + & 0.74922e+03_r8,0.89289e+03_r8,0.10366e+04_r8,0.11799e+04_r8 /) + kao(:, 2,13,14) = (/ & + & 0.11759e+04_r8,0.10245e+04_r8,0.86816e+03_r8,0.77411e+03_r8,0.60565e+03_r8, & + & 0.74816e+03_r8,0.89163e+03_r8,0.10351e+04_r8,0.11786e+04_r8 /) + kao(:, 3,13,14) = (/ & + & 0.11354e+04_r8,0.10124e+04_r8,0.96299e+03_r8,0.72358e+03_r8,0.60486e+03_r8, & + & 0.74851e+03_r8,0.89156e+03_r8,0.10341e+04_r8,0.11778e+04_r8 /) + kao(:, 4,13,14) = (/ & + & 0.11811e+04_r8,0.10736e+04_r8,0.85638e+03_r8,0.74549e+03_r8,0.60366e+03_r8, & + & 0.74655e+03_r8,0.88977e+03_r8,0.10330e+04_r8,0.11762e+04_r8 /) + kao(:, 5,13,14) = (/ & + & 0.11332e+04_r8,0.99282e+03_r8,0.87259e+03_r8,0.77082e+03_r8,0.60280e+03_r8, & + & 0.74559e+03_r8,0.88865e+03_r8,0.10317e+04_r8,0.11748e+04_r8 /) + kao(:, 1, 1,15) = (/ & + & 0.19847e+04_r8,0.16615e+04_r8,0.16299e+04_r8,0.11466e+04_r8,0.10123e+04_r8, & + & 0.72871e+03_r8,0.89405e+03_r8,0.10334e+04_r8,0.11734e+04_r8 /) + kao(:, 2, 1,15) = (/ & + & 0.18867e+04_r8,0.16470e+04_r8,0.14051e+04_r8,0.12848e+04_r8,0.91870e+03_r8, & + & 0.75104e+03_r8,0.89013e+03_r8,0.10307e+04_r8,0.11650e+04_r8 /) + kao(:, 3, 1,15) = (/ & + & 0.17405e+04_r8,0.16240e+04_r8,0.14364e+04_r8,0.10773e+04_r8,0.10008e+04_r8, & + & 0.74790e+03_r8,0.89023e+03_r8,0.10382e+04_r8,0.11720e+04_r8 /) + kao(:, 4, 1,15) = (/ & + & 0.19099e+04_r8,0.16930e+04_r8,0.14454e+04_r8,0.12410e+04_r8,0.95925e+03_r8, & + & 0.74605e+03_r8,0.88544e+03_r8,0.10248e+04_r8,0.11651e+04_r8 /) + kao(:, 5, 1,15) = (/ & + & 0.19738e+04_r8,0.13892e+04_r8,0.14377e+04_r8,0.12129e+04_r8,0.77083e+03_r8, & + & 0.74496e+03_r8,0.88458e+03_r8,0.10242e+04_r8,0.11638e+04_r8 /) + kao(:, 1, 2,15) = (/ & + & 0.18788e+04_r8,0.15414e+04_r8,0.14391e+04_r8,0.94831e+03_r8,0.88384e+03_r8, & + & 0.75320e+03_r8,0.89399e+03_r8,0.10340e+04_r8,0.11746e+04_r8 /) + kao(:, 2, 2,15) = (/ & + & 0.16660e+04_r8,0.14507e+04_r8,0.12145e+04_r8,0.11753e+04_r8,0.91977e+03_r8, & + & 0.75003e+03_r8,0.89113e+03_r8,0.10308e+04_r8,0.11712e+04_r8 /) + kao(:, 3, 2,15) = (/ & + & 0.15746e+04_r8,0.14551e+04_r8,0.13375e+04_r8,0.10698e+04_r8,0.76931e+03_r8, & + & 0.74657e+03_r8,0.88729e+03_r8,0.10267e+04_r8,0.11695e+04_r8 /) + kao(:, 4, 2,15) = (/ & + & 0.16772e+04_r8,0.16415e+04_r8,0.13391e+04_r8,0.10287e+04_r8,0.88207e+03_r8, & + & 0.74593e+03_r8,0.88530e+03_r8,0.10252e+04_r8,0.11661e+04_r8 /) + kao(:, 5, 2,15) = (/ & + & 0.16581e+04_r8,0.15452e+04_r8,0.12479e+04_r8,0.10067e+04_r8,0.83698e+03_r8, & + & 0.74419e+03_r8,0.88279e+03_r8,0.10234e+04_r8,0.11634e+04_r8 /) + kao(:, 1, 3,15) = (/ & + & 0.17888e+04_r8,0.13395e+04_r8,0.12224e+04_r8,0.11479e+04_r8,0.91734e+03_r8, & + & 0.75291e+03_r8,0.89358e+03_r8,0.10348e+04_r8,0.11761e+04_r8 /) + kao(:, 2, 3,15) = (/ & + & 0.16146e+04_r8,0.11805e+04_r8,0.12709e+04_r8,0.85911e+03_r8,0.90210e+03_r8, & + & 0.75028e+03_r8,0.89203e+03_r8,0.10324e+04_r8,0.11734e+04_r8 /) + kao(:, 3, 3,15) = (/ & + & 0.14717e+04_r8,0.15353e+04_r8,0.12224e+04_r8,0.96001e+03_r8,0.77554e+03_r8, & + & 0.74753e+03_r8,0.88823e+03_r8,0.10297e+04_r8,0.11678e+04_r8 /) + kao(:, 4, 3,15) = (/ & + & 0.15479e+04_r8,0.14535e+04_r8,0.11756e+04_r8,0.99609e+03_r8,0.71892e+03_r8, & + & 0.74634e+03_r8,0.88703e+03_r8,0.10366e+04_r8,0.11684e+04_r8 /) + kao(:, 5, 3,15) = (/ & + & 0.15155e+04_r8,0.14515e+04_r8,0.11733e+04_r8,0.10638e+04_r8,0.80510e+03_r8, & + & 0.74461e+03_r8,0.88580e+03_r8,0.10240e+04_r8,0.11652e+04_r8 /) + kao(:, 1, 4,15) = (/ & + & 0.15848e+04_r8,0.14083e+04_r8,0.12006e+04_r8,0.10439e+04_r8,0.81336e+03_r8, & + & 0.75201e+03_r8,0.89444e+03_r8,0.10363e+04_r8,0.11781e+04_r8 /) + kao(:, 2, 4,15) = (/ & + & 0.13736e+04_r8,0.13760e+04_r8,0.12165e+04_r8,0.94289e+03_r8,0.75006e+03_r8, & + & 0.75167e+03_r8,0.89210e+03_r8,0.10337e+04_r8,0.11753e+04_r8 /) + kao(:, 3, 4,15) = (/ & + & 0.14353e+04_r8,0.13702e+04_r8,0.10217e+04_r8,0.10119e+04_r8,0.72585e+03_r8, & + & 0.74883e+03_r8,0.88956e+03_r8,0.10325e+04_r8,0.11731e+04_r8 /) + kao(:, 4, 4,15) = (/ & + & 0.14295e+04_r8,0.12548e+04_r8,0.12198e+04_r8,0.96945e+03_r8,0.84557e+03_r8, & + & 0.73846e+03_r8,0.88641e+03_r8,0.10258e+04_r8,0.11703e+04_r8 /) + kao(:, 5, 4,15) = (/ & + & 0.15742e+04_r8,0.13268e+04_r8,0.10395e+04_r8,0.90301e+03_r8,0.67604e+03_r8, & + & 0.74473e+03_r8,0.88569e+03_r8,0.10266e+04_r8,0.11676e+04_r8 /) + kao(:, 1, 5,15) = (/ & + & 0.15038e+04_r8,0.11787e+04_r8,0.11191e+04_r8,0.96573e+03_r8,0.74364e+03_r8, & + & 0.75161e+03_r8,0.89373e+03_r8,0.10358e+04_r8,0.11780e+04_r8 /) + kao(:, 2, 5,15) = (/ & + & 0.12972e+04_r8,0.14157e+04_r8,0.10073e+04_r8,0.10120e+04_r8,0.78829e+03_r8, & + & 0.75051e+03_r8,0.89254e+03_r8,0.10346e+04_r8,0.11785e+04_r8 /) + kao(:, 3, 5,15) = (/ & + & 0.15562e+04_r8,0.12980e+04_r8,0.11053e+04_r8,0.96784e+03_r8,0.68156e+03_r8, & + & 0.74938e+03_r8,0.89063e+03_r8,0.10325e+04_r8,0.11743e+04_r8 /) + kao(:, 4, 5,15) = (/ & + & 0.15203e+04_r8,0.12953e+04_r8,0.96757e+03_r8,0.95061e+03_r8,0.68480e+03_r8, & + & 0.74750e+03_r8,0.88780e+03_r8,0.10293e+04_r8,0.11708e+04_r8 /) + kao(:, 5, 5,15) = (/ & + & 0.14730e+04_r8,0.11456e+04_r8,0.11151e+04_r8,0.68408e+03_r8,0.76176e+03_r8, & + & 0.75307e+03_r8,0.89322e+03_r8,0.10317e+04_r8,0.11682e+04_r8 /) + kao(:, 1, 6,15) = (/ & + & 0.15240e+04_r8,0.12794e+04_r8,0.10826e+04_r8,0.93131e+03_r8,0.69525e+03_r8, & + & 0.75122e+03_r8,0.89364e+03_r8,0.10361e+04_r8,0.11785e+04_r8 /) + kao(:, 2, 6,15) = (/ & + & 0.13735e+04_r8,0.12837e+04_r8,0.10725e+04_r8,0.91616e+03_r8,0.69548e+03_r8, & + & 0.75041e+03_r8,0.89279e+03_r8,0.10360e+04_r8,0.11776e+04_r8 /) + kao(:, 3, 6,15) = (/ & + & 0.14287e+04_r8,0.11366e+04_r8,0.10240e+04_r8,0.87529e+03_r8,0.70795e+03_r8, & + & 0.75034e+03_r8,0.89142e+03_r8,0.10337e+04_r8,0.11759e+04_r8 /) + kao(:, 4, 6,15) = (/ & + & 0.12768e+04_r8,0.11078e+04_r8,0.98805e+03_r8,0.76254e+03_r8,0.77383e+03_r8, & + & 0.74782e+03_r8,0.88921e+03_r8,0.10312e+04_r8,0.11732e+04_r8 /) + kao(:, 5, 6,15) = (/ & + & 0.13045e+04_r8,0.12087e+04_r8,0.10585e+04_r8,0.89185e+03_r8,0.69378e+03_r8, & + & 0.74461e+03_r8,0.88618e+03_r8,0.10253e+04_r8,0.11684e+04_r8 /) + kao(:, 1, 7,15) = (/ & + & 0.13068e+04_r8,0.11778e+04_r8,0.10485e+04_r8,0.87245e+03_r8,0.70237e+03_r8, & + & 0.75029e+03_r8,0.89358e+03_r8,0.10363e+04_r8,0.11790e+04_r8 /) + kao(:, 2, 7,15) = (/ & + & 0.13988e+04_r8,0.11525e+04_r8,0.98924e+03_r8,0.83779e+03_r8,0.64617e+03_r8, & + & 0.75022e+03_r8,0.89357e+03_r8,0.10355e+04_r8,0.11782e+04_r8 /) + kao(:, 3, 7,15) = (/ & + & 0.14294e+04_r8,0.11695e+04_r8,0.10182e+04_r8,0.91196e+03_r8,0.69696e+03_r8, & + & 0.74932e+03_r8,0.89330e+03_r8,0.10353e+04_r8,0.11780e+04_r8 /) + kao(:, 4, 7,15) = (/ & + & 0.14082e+04_r8,0.10640e+04_r8,0.10540e+04_r8,0.79295e+03_r8,0.62688e+03_r8, & + & 0.74789e+03_r8,0.89097e+03_r8,0.10327e+04_r8,0.11750e+04_r8 /) + kao(:, 5, 7,15) = (/ & + & 0.13514e+04_r8,0.12038e+04_r8,0.10012e+04_r8,0.83544e+03_r8,0.67927e+03_r8, & + & 0.74629e+03_r8,0.88843e+03_r8,0.10298e+04_r8,0.11718e+04_r8 /) + kao(:, 1, 8,15) = (/ & + & 0.14761e+04_r8,0.12412e+04_r8,0.10429e+04_r8,0.84370e+03_r8,0.62388e+03_r8, & + & 0.75133e+03_r8,0.89371e+03_r8,0.10367e+04_r8,0.11796e+04_r8 /) + kao(:, 2, 8,15) = (/ & + & 0.12119e+04_r8,0.11409e+04_r8,0.10121e+04_r8,0.85755e+03_r8,0.70976e+03_r8, & + & 0.74998e+03_r8,0.89216e+03_r8,0.10357e+04_r8,0.11786e+04_r8 /) + kao(:, 3, 8,15) = (/ & + & 0.12581e+04_r8,0.11663e+04_r8,0.10198e+04_r8,0.88649e+03_r8,0.69509e+03_r8, & + & 0.74932e+03_r8,0.89355e+03_r8,0.10350e+04_r8,0.11787e+04_r8 /) + kao(:, 4, 8,15) = (/ & + & 0.12478e+04_r8,0.12066e+04_r8,0.87201e+03_r8,0.84155e+03_r8,0.70223e+03_r8, & + & 0.74886e+03_r8,0.89098e+03_r8,0.10337e+04_r8,0.11764e+04_r8 /) + kao(:, 5, 8,15) = (/ & + & 0.12322e+04_r8,0.11048e+04_r8,0.93070e+03_r8,0.68296e+03_r8,0.66022e+03_r8, & + & 0.74776e+03_r8,0.88972e+03_r8,0.10315e+04_r8,0.11748e+04_r8 /) + kao(:, 1, 9,15) = (/ & + & 0.13164e+04_r8,0.12093e+04_r8,0.10729e+04_r8,0.80022e+03_r8,0.68605e+03_r8, & + & 0.75075e+03_r8,0.89396e+03_r8,0.10372e+04_r8,0.11804e+04_r8 /) + kao(:, 2, 9,15) = (/ & + & 0.12738e+04_r8,0.11851e+04_r8,0.88381e+03_r8,0.85846e+03_r8,0.65813e+03_r8, & + & 0.74985e+03_r8,0.89295e+03_r8,0.10369e+04_r8,0.11792e+04_r8 /) + kao(:, 3, 9,15) = (/ & + & 0.12657e+04_r8,0.12031e+04_r8,0.79849e+03_r8,0.64636e+03_r8,0.60824e+03_r8, & + & 0.74924e+03_r8,0.89227e+03_r8,0.10353e+04_r8,0.11783e+04_r8 /) + kao(:, 4, 9,15) = (/ & + & 0.12866e+04_r8,0.11531e+04_r8,0.85958e+03_r8,0.76890e+03_r8,0.66204e+03_r8, & + & 0.74965e+03_r8,0.89143e+03_r8,0.10344e+04_r8,0.11773e+04_r8 /) + kao(:, 5, 9,15) = (/ & + & 0.11604e+04_r8,0.11730e+04_r8,0.87009e+03_r8,0.73148e+03_r8,0.58106e+03_r8, & + & 0.74723e+03_r8,0.88998e+03_r8,0.10327e+04_r8,0.11755e+04_r8 /) + kao(:, 1,10,15) = (/ & + & 0.11188e+04_r8,0.99215e+03_r8,0.73460e+03_r8,0.83046e+03_r8,0.68844e+03_r8, & + & 0.75085e+03_r8,0.89429e+03_r8,0.10377e+04_r8,0.11803e+04_r8 /) + kao(:, 2,10,15) = (/ & + & 0.12059e+04_r8,0.10804e+04_r8,0.70761e+03_r8,0.65712e+03_r8,0.66535e+03_r8, & + & 0.74980e+03_r8,0.89311e+03_r8,0.10364e+04_r8,0.11807e+04_r8 /) + kao(:, 3,10,15) = (/ & + & 0.11817e+04_r8,0.10195e+04_r8,0.95365e+03_r8,0.71601e+03_r8,0.59959e+03_r8, & + & 0.74791e+03_r8,0.89228e+03_r8,0.10355e+04_r8,0.11778e+04_r8 /) + kao(:, 4,10,15) = (/ & + & 0.11350e+04_r8,0.11533e+04_r8,0.91058e+03_r8,0.81845e+03_r8,0.64874e+03_r8, & + & 0.74908e+03_r8,0.89233e+03_r8,0.10356e+04_r8,0.11779e+04_r8 /) + kao(:, 5,10,15) = (/ & + & 0.12000e+04_r8,0.10896e+04_r8,0.93671e+03_r8,0.81314e+03_r8,0.60750e+03_r8, & + & 0.74754e+03_r8,0.89053e+03_r8,0.10335e+04_r8,0.11765e+04_r8 /) + kao(:, 1,11,15) = (/ & + & 0.12887e+04_r8,0.10795e+04_r8,0.92507e+03_r8,0.76020e+03_r8,0.61621e+03_r8, & + & 0.75046e+03_r8,0.89404e+03_r8,0.10376e+04_r8,0.11812e+04_r8 /) + kao(:, 2,11,15) = (/ & + & 0.11864e+04_r8,0.99352e+03_r8,0.96688e+03_r8,0.81999e+03_r8,0.65449e+03_r8, & + & 0.74944e+03_r8,0.89287e+03_r8,0.10363e+04_r8,0.11797e+04_r8 /) + kao(:, 3,11,15) = (/ & + & 0.11946e+04_r8,0.10069e+04_r8,0.91904e+03_r8,0.81170e+03_r8,0.65606e+03_r8, & + & 0.74582e+03_r8,0.89066e+03_r8,0.10354e+04_r8,0.11787e+04_r8 /) + kao(:, 4,11,15) = (/ & + & 0.10269e+04_r8,0.10463e+04_r8,0.82697e+03_r8,0.81731e+03_r8,0.61185e+03_r8, & + & 0.74876e+03_r8,0.89142e+03_r8,0.10347e+04_r8,0.11779e+04_r8 /) + kao(:, 5,11,15) = (/ & + & 0.11483e+04_r8,0.10490e+04_r8,0.91718e+03_r8,0.72295e+03_r8,0.60510e+03_r8, & + & 0.74783e+03_r8,0.89173e+03_r8,0.10334e+04_r8,0.11765e+04_r8 /) + kao(:, 1,12,15) = (/ & + & 0.12157e+04_r8,0.94948e+03_r8,0.89441e+03_r8,0.76380e+03_r8,0.60866e+03_r8, & + & 0.75013e+03_r8,0.89382e+03_r8,0.10375e+04_r8,0.11812e+04_r8 /) + kao(:, 2,12,15) = (/ & + & 0.10470e+04_r8,0.10059e+04_r8,0.83704e+03_r8,0.70161e+03_r8,0.60721e+03_r8, & + & 0.74914e+03_r8,0.89267e+03_r8,0.10370e+04_r8,0.11807e+04_r8 /) + kao(:, 3,12,15) = (/ & + & 0.10541e+04_r8,0.86865e+03_r8,0.86614e+03_r8,0.79420e+03_r8,0.60576e+03_r8, & + & 0.74144e+03_r8,0.89117e+03_r8,0.10353e+04_r8,0.11778e+04_r8 /) + kao(:, 4,12,15) = (/ & + & 0.11152e+04_r8,0.10946e+04_r8,0.91200e+03_r8,0.75719e+03_r8,0.60459e+03_r8, & + & 0.74791e+03_r8,0.89124e+03_r8,0.10346e+04_r8,0.11788e+04_r8 /) + kao(:, 5,12,15) = (/ & + & 0.10232e+04_r8,0.97767e+03_r8,0.95862e+03_r8,0.62268e+03_r8,0.60382e+03_r8, & + & 0.74758e+03_r8,0.88947e+03_r8,0.10333e+04_r8,0.11765e+04_r8 /) + kao(:, 1,13,15) = (/ & + & 0.11027e+04_r8,0.93786e+03_r8,0.84040e+03_r8,0.77686e+03_r8,0.60858e+03_r8, & + & 0.74987e+03_r8,0.89364e+03_r8,0.10374e+04_r8,0.11812e+04_r8 /) + kao(:, 2,13,15) = (/ & + & 0.10816e+04_r8,0.10747e+04_r8,0.88690e+03_r8,0.66213e+03_r8,0.60670e+03_r8, & + & 0.74889e+03_r8,0.89251e+03_r8,0.10369e+04_r8,0.11797e+04_r8 /) + kao(:, 3,13,15) = (/ & + & 0.11963e+04_r8,0.98701e+03_r8,0.69767e+03_r8,0.73646e+03_r8,0.60528e+03_r8, & + & 0.74531e+03_r8,0.88962e+03_r8,0.10352e+04_r8,0.11778e+04_r8 /) + kao(:, 4,13,15) = (/ & + & 0.10530e+04_r8,0.78530e+03_r8,0.91477e+03_r8,0.71026e+03_r8,0.60430e+03_r8, & + & 0.74770e+03_r8,0.89110e+03_r8,0.10345e+04_r8,0.11779e+04_r8 /) + kao(:, 5,13,15) = (/ & + & 0.11409e+04_r8,0.10574e+04_r8,0.83207e+03_r8,0.61034e+03_r8,0.60355e+03_r8, & + & 0.74679e+03_r8,0.89073e+03_r8,0.10333e+04_r8,0.11765e+04_r8 /) + kao(:, 1, 1,16) = (/ & + & 0.34848e+03_r8,0.49670e+03_r8,0.29569e+03_r8,0.31627e+03_r8,0.46514e+03_r8, & + & 0.42834e+03_r8,0.88848e+03_r8,0.10335e+04_r8,0.11735e+04_r8 /) + kao(:, 2, 1,16) = (/ & + & 0.18044e+04_r8,0.87518e+03_r8,0.11930e+04_r8,0.45580e+03_r8,0.83690e+03_r8, & + & 0.74631e+03_r8,0.89022e+03_r8,0.10242e+04_r8,0.11632e+04_r8 /) + kao(:, 3, 1,16) = (/ & + & 0.11196e+04_r8,0.73658e+03_r8,0.10480e+04_r8,0.53695e+03_r8,0.39566e+03_r8, & + & 0.74377e+03_r8,0.86775e+03_r8,0.94144e+03_r8,0.11277e+04_r8 /) + kao(:, 4, 1,16) = (/ & + & 0.72013e+03_r8,0.40040e+03_r8,0.39030e+03_r8,0.31401e+03_r8,0.31498e+03_r8, & + & 0.74613e+03_r8,0.88553e+03_r8,0.10249e+04_r8,0.11579e+04_r8 /) + kao(:, 5, 1,16) = (/ & + & 0.34789e+03_r8,0.14911e+04_r8,0.33003e+03_r8,0.29522e+03_r8,0.31385e+03_r8, & + & 0.74516e+03_r8,0.88480e+03_r8,0.10244e+04_r8,0.11641e+04_r8 /) + kao(:, 1, 2,16) = (/ & + & 0.41247e+03_r8,0.81197e+03_r8,0.68322e+03_r8,0.50855e+03_r8,0.24076e+03_r8, & + & 0.74851e+03_r8,0.88842e+03_r8,0.10341e+04_r8,0.11748e+04_r8 /) + kao(:, 2, 2,16) = (/ & + & 0.16209e+04_r8,0.56884e+03_r8,0.94156e+03_r8,0.29182e+03_r8,0.46039e+03_r8, & + & 0.75011e+03_r8,0.88557e+03_r8,0.10309e+04_r8,0.11714e+04_r8 /) + kao(:, 3, 2,16) = (/ & + & 0.11534e+04_r8,0.51443e+03_r8,0.23941e+03_r8,0.44358e+03_r8,0.58779e+03_r8, & + & 0.74720e+03_r8,0.88237e+03_r8,0.10275e+04_r8,0.11547e+04_r8 /) + kao(:, 4, 2,16) = (/ & + & 0.78193e+03_r8,0.30585e+03_r8,0.42670e+03_r8,0.10365e+04_r8,0.43225e+03_r8, & + & 0.74126e+03_r8,0.88535e+03_r8,0.10253e+04_r8,0.11588e+04_r8 /) + kao(:, 5, 2,16) = (/ & + & 0.67509e+03_r8,0.40574e+03_r8,0.57252e+03_r8,0.10353e+04_r8,0.15564e+03_r8, & + & 0.73954e+03_r8,0.88360e+03_r8,0.10236e+04_r8,0.11636e+04_r8 /) + kao(:, 1, 3,16) = (/ & + & 0.91257e+03_r8,0.11144e+04_r8,0.54685e+03_r8,0.19037e+03_r8,0.25900e+03_r8, & + & 0.74823e+03_r8,0.89369e+03_r8,0.10350e+04_r8,0.11762e+04_r8 /) + kao(:, 2, 3,16) = (/ & + & 0.67162e+03_r8,0.10092e+04_r8,0.40983e+03_r8,0.37826e+03_r8,0.42702e+03_r8, & + & 0.75035e+03_r8,0.88647e+03_r8,0.10325e+04_r8,0.11736e+04_r8 /) + kao(:, 3, 3,16) = (/ & + & 0.94657e+03_r8,0.26107e+03_r8,0.43567e+03_r8,0.41065e+03_r8,0.70838e+03_r8, & + & 0.74760e+03_r8,0.88832e+03_r8,0.10233e+04_r8,0.11698e+04_r8 /) + kao(:, 4, 3,16) = (/ & + & 0.10618e+03_r8,0.45040e+03_r8,0.10291e+04_r8,0.30237e+03_r8,0.57813e+03_r8, & + & 0.73277e+03_r8,0.87582e+03_r8,0.95203e+03_r8,0.11472e+04_r8 /) + kao(:, 5, 3,16) = (/ & + & 0.96551e+03_r8,0.68706e+03_r8,0.56500e+03_r8,0.14865e+03_r8,0.35532e+03_r8, & + & 0.73527e+03_r8,0.86908e+03_r8,0.10241e+04_r8,0.11579e+04_r8 /) + kao(:, 1, 4,16) = (/ & + & 0.13211e+04_r8,0.11050e+04_r8,0.91067e+03_r8,0.34788e+03_r8,0.76485e+03_r8, & + & 0.75213e+03_r8,0.88892e+03_r8,0.10299e+04_r8,0.11709e+04_r8 /) + kao(:, 2, 4,16) = (/ & + & 0.15543e+04_r8,0.92211e+03_r8,0.72798e+03_r8,0.86839e+03_r8,0.36802e+03_r8, & + & 0.74223e+03_r8,0.89219e+03_r8,0.10338e+04_r8,0.11754e+04_r8 /) + kao(:, 3, 4,16) = (/ & + & 0.53676e+03_r8,0.46363e+03_r8,0.10941e+04_r8,0.19958e+03_r8,0.68767e+03_r8, & + & 0.74416e+03_r8,0.88965e+03_r8,0.10195e+04_r8,0.11658e+04_r8 /) + kao(:, 4, 4,16) = (/ & + & 0.66992e+03_r8,0.61007e+03_r8,0.50612e+03_r8,0.34999e+03_r8,0.19685e+03_r8, & + & 0.74139e+03_r8,0.88155e+03_r8,0.10274e+04_r8,0.11555e+04_r8 /) + kao(:, 5, 4,16) = (/ & + & 0.55226e+03_r8,0.42689e+03_r8,0.10712e+04_r8,0.69959e+03_r8,0.69105e+03_r8, & + & 0.73534e+03_r8,0.87452e+03_r8,0.10137e+04_r8,0.11529e+04_r8 /) + kao(:, 1, 5,16) = (/ & + & 0.11854e+04_r8,0.90025e+03_r8,0.10734e+04_r8,0.36732e+03_r8,0.51551e+03_r8, & + & 0.75181e+03_r8,0.89397e+03_r8,0.10361e+04_r8,0.11783e+04_r8 /) + kao(:, 2, 5,16) = (/ & + & 0.13933e+04_r8,0.23882e+03_r8,0.71015e+03_r8,0.29765e+03_r8,0.88507e+02_r8, & + & 0.75060e+03_r8,0.89266e+03_r8,0.10347e+04_r8,0.11637e+04_r8 /) + kao(:, 3, 5,16) = (/ & + & 0.30783e+03_r8,0.72533e+03_r8,0.99782e+03_r8,0.22581e+03_r8,0.21957e+03_r8, & + & 0.74471e+03_r8,0.89072e+03_r8,0.10326e+04_r8,0.11744e+04_r8 /) + kao(:, 4, 5,16) = (/ & + & 0.12756e+03_r8,0.23797e+03_r8,0.16871e+03_r8,0.60625e+03_r8,0.35893e+03_r8, & + & 0.73811e+03_r8,0.88789e+03_r8,0.10294e+04_r8,0.11709e+04_r8 /) + kao(:, 5, 5,16) = (/ & + & 0.67577e+03_r8,0.67606e+03_r8,0.57612e+03_r8,0.15439e+03_r8,0.22922e+03_r8, & + & 0.66526e+03_r8,0.82593e+03_r8,0.98621e+03_r8,0.11543e+04_r8 /) + kao(:, 1, 6,16) = (/ & + & 0.35294e+03_r8,0.92951e+03_r8,0.39404e+03_r8,0.59466e+03_r8,0.46365e+03_r8, & + & 0.75155e+03_r8,0.89403e+03_r8,0.10365e+04_r8,0.11790e+04_r8 /) + kao(:, 2, 6,16) = (/ & + & 0.83494e+03_r8,0.91972e+03_r8,0.83351e+02_r8,0.26459e+03_r8,0.33053e+03_r8, & + & 0.75056e+03_r8,0.89298e+03_r8,0.10296e+04_r8,0.11778e+04_r8 /) + kao(:, 3, 6,16) = (/ & + & 0.77495e+02_r8,0.67358e+03_r8,0.71470e+03_r8,0.28985e+03_r8,0.12695e+03_r8, & + & 0.74093e+03_r8,0.89153e+03_r8,0.10338e+04_r8,0.11761e+04_r8 /) + kao(:, 4, 6,16) = (/ & + & 0.12524e+04_r8,0.52300e+03_r8,0.17321e+03_r8,0.31958e+03_r8,0.15643e+03_r8, & + & 0.74316e+03_r8,0.88930e+03_r8,0.10313e+04_r8,0.11733e+04_r8 /) + kao(:, 5, 6,16) = (/ & + & 0.79880e+03_r8,0.54259e+03_r8,0.31909e+03_r8,0.47791e+03_r8,0.45938e+03_r8, & + & 0.74468e+03_r8,0.88626e+03_r8,0.10278e+04_r8,0.11499e+04_r8 /) + kao(:, 1, 7,16) = (/ & + & 0.10078e+04_r8,0.83081e+03_r8,0.68047e+03_r8,0.68284e+03_r8,0.57904e+03_r8, & + & 0.75128e+03_r8,0.89403e+03_r8,0.10368e+04_r8,0.11795e+04_r8 /) + kao(:, 2, 7,16) = (/ & + & 0.67323e+03_r8,0.10228e+04_r8,0.49758e+03_r8,0.33578e+03_r8,0.38746e+03_r8, & + & 0.75047e+03_r8,0.88822e+03_r8,0.10359e+04_r8,0.11786e+04_r8 /) + kao(:, 3, 7,16) = (/ & + & 0.60358e+03_r8,0.41876e+03_r8,0.74942e+03_r8,0.38757e+03_r8,0.61092e+03_r8, & + & 0.74943e+03_r8,0.88213e+03_r8,0.10289e+04_r8,0.11707e+04_r8 /) + kao(:, 4, 7,16) = (/ & + & 0.69109e+03_r8,0.11040e+04_r8,0.46705e+03_r8,0.74628e+03_r8,0.47483e+03_r8, & + & 0.74797e+03_r8,0.88542e+03_r8,0.10328e+04_r8,0.11752e+04_r8 /) + kao(:, 5, 7,16) = (/ & + & 0.68277e+03_r8,0.46564e+03_r8,0.19228e+03_r8,0.48854e+03_r8,0.28304e+03_r8, & + & 0.74163e+03_r8,0.88289e+03_r8,0.10299e+04_r8,0.11719e+04_r8 /) + kao(:, 1, 8,16) = (/ & + & 0.26685e+03_r8,0.60532e+03_r8,0.51009e+03_r8,0.40907e+03_r8,0.39126e+03_r8, & + & 0.74682e+03_r8,0.89396e+03_r8,0.10369e+04_r8,0.11799e+04_r8 /) + kao(:, 2, 8,16) = (/ & + & 0.94869e+03_r8,0.11471e+04_r8,0.44706e+03_r8,0.23151e+03_r8,0.93532e+02_r8, & + & 0.75035e+03_r8,0.89331e+03_r8,0.10363e+04_r8,0.11727e+04_r8 /) + kao(:, 3, 8,16) = (/ & + & 0.11588e+04_r8,0.74588e+03_r8,0.28311e+03_r8,0.27864e+03_r8,0.32853e+03_r8, & + & 0.74950e+03_r8,0.88246e+03_r8,0.10352e+04_r8,0.11716e+04_r8 /) + kao(:, 4, 8,16) = (/ & + & 0.11874e+04_r8,0.47456e+03_r8,0.83368e+03_r8,0.31591e+03_r8,0.30274e+03_r8, & + & 0.74421e+03_r8,0.89109e+03_r8,0.10338e+04_r8,0.11765e+04_r8 /) + kao(:, 5, 8,16) = (/ & + & 0.45710e+03_r8,0.66086e+03_r8,0.55863e+03_r8,0.58037e+03_r8,0.20569e+03_r8, & + & 0.73836e+03_r8,0.88417e+03_r8,0.10316e+04_r8,0.11675e+04_r8 /) + kao(:, 1, 9,16) = (/ & + & 0.55233e+03_r8,0.18269e+03_r8,0.18991e+03_r8,0.35964e+03_r8,0.38998e+03_r8, & + & 0.75089e+03_r8,0.89415e+03_r8,0.10374e+04_r8,0.11807e+04_r8 /) + kao(:, 2, 9,16) = (/ & + & 0.31819e+03_r8,0.14904e+03_r8,0.79703e+03_r8,0.32317e+03_r8,0.20679e+03_r8, & + & 0.75021e+03_r8,0.89337e+03_r8,0.10308e+04_r8,0.11797e+04_r8 /) + kao(:, 3, 9,16) = (/ & + & 0.16059e+03_r8,0.37409e+03_r8,0.62337e+03_r8,0.62951e+03_r8,0.47662e+03_r8, & + & 0.74953e+03_r8,0.89262e+03_r8,0.10357e+04_r8,0.11788e+04_r8 /) + kao(:, 4, 9,16) = (/ & + & 0.15191e+03_r8,0.63681e+03_r8,0.25601e+03_r8,0.65772e+03_r8,0.38994e+03_r8, & + & 0.74029e+03_r8,0.89158e+03_r8,0.10346e+04_r8,0.11775e+04_r8 /) + kao(:, 5, 9,16) = (/ & + & 0.10392e+04_r8,0.33629e+03_r8,0.90538e+03_r8,0.33435e+03_r8,0.46694e+03_r8, & + & 0.74731e+03_r8,0.89008e+03_r8,0.10329e+04_r8,0.11756e+04_r8 /) + kao(:, 1,10,16) = (/ & + & 0.43161e+03_r8,0.53194e+03_r8,0.82168e+03_r8,0.11050e+03_r8,0.32159e+02_r8, & + & 0.75101e+03_r8,0.89450e+03_r8,0.10380e+04_r8,0.11815e+04_r8 /) + kao(:, 2,10,16) = (/ & + & 0.23362e+03_r8,0.50697e+03_r8,0.75913e+03_r8,0.37965e+03_r8,0.15877e+03_r8, & + & 0.75002e+03_r8,0.89333e+03_r8,0.10366e+04_r8,0.11734e+04_r8 /) + kao(:, 3,10,16) = (/ & + & 0.66577e+03_r8,0.22676e+03_r8,0.63752e+03_r8,0.50488e+03_r8,0.52339e+03_r8, & + & 0.74947e+03_r8,0.88778e+03_r8,0.10360e+04_r8,0.11793e+04_r8 /) + kao(:, 4,10,16) = (/ & + & 0.12040e+04_r8,0.37222e+03_r8,0.71269e+03_r8,0.68368e+02_r8,0.31445e+03_r8, & + & 0.74453e+03_r8,0.88691e+03_r8,0.10293e+04_r8,0.11782e+04_r8 /) + kao(:, 5,10,16) = (/ & + & 0.85334e+03_r8,0.50951e+03_r8,0.43397e+03_r8,0.11861e+03_r8,0.15074e+03_r8, & + & 0.74764e+03_r8,0.89065e+03_r8,0.10337e+04_r8,0.11767e+04_r8 /) + kao(:, 1,11,16) = (/ & + & 0.45853e+03_r8,0.29024e+03_r8,0.38275e+03_r8,0.26130e+03_r8,0.12124e+03_r8, & + & 0.75062e+03_r8,0.89424e+03_r8,0.10379e+04_r8,0.11815e+04_r8 /) + kao(:, 2,11,16) = (/ & + & 0.66691e+03_r8,0.55656e+03_r8,0.39879e+03_r8,0.16526e+03_r8,0.24675e+03_r8, & + & 0.74965e+03_r8,0.89309e+03_r8,0.10365e+04_r8,0.11800e+04_r8 /) + kao(:, 3,11,16) = (/ & + & 0.10239e+04_r8,0.60930e+03_r8,0.22001e+03_r8,0.10914e+03_r8,0.22748e+03_r8, & + & 0.74913e+03_r8,0.89251e+03_r8,0.10359e+04_r8,0.11793e+04_r8 /) + kao(:, 4,11,16) = (/ & + & 0.80567e+03_r8,0.90344e+03_r8,0.77356e+03_r8,0.12489e+03_r8,0.55902e+03_r8, & + & 0.74421e+03_r8,0.89165e+03_r8,0.10349e+04_r8,0.11782e+04_r8 /) + kao(:, 5,11,16) = (/ & + & 0.80619e+03_r8,0.87963e+03_r8,0.47254e+03_r8,0.39261e+03_r8,0.59752e+03_r8, & + & 0.74319e+03_r8,0.88056e+03_r8,0.10336e+04_r8,0.11767e+04_r8 /) + kao(:, 1,12,16) = (/ & + & 0.54479e+03_r8,0.73809e+03_r8,0.74534e+03_r8,0.30870e+03_r8,0.60893e+03_r8, & + & 0.75030e+03_r8,0.89402e+03_r8,0.10378e+04_r8,0.11815e+04_r8 /) + kao(:, 2,12,16) = (/ & + & 0.10600e+04_r8,0.76559e+03_r8,0.34957e+03_r8,0.18602e+03_r8,0.60736e+03_r8, & + & 0.74935e+03_r8,0.89289e+03_r8,0.10307e+04_r8,0.11734e+04_r8 /) + kao(:, 3,12,16) = (/ & + & 0.10515e+04_r8,0.60079e+03_r8,0.43472e+03_r8,0.33220e+03_r8,0.60582e+03_r8, & + & 0.74885e+03_r8,0.89233e+03_r8,0.10358e+04_r8,0.11793e+04_r8 /) + kao(:, 4,12,16) = (/ & + & 0.32670e+03_r8,0.23075e+03_r8,0.13581e+03_r8,0.17106e+03_r8,0.60474e+03_r8, & + & 0.74811e+03_r8,0.89148e+03_r8,0.10348e+04_r8,0.11717e+04_r8 /) + kao(:, 5,12,16) = (/ & + & 0.20371e+03_r8,0.68798e+03_r8,0.91592e+02_r8,0.60316e+03_r8,0.60390e+03_r8, & + & 0.74294e+03_r8,0.89029e+03_r8,0.10335e+04_r8,0.11767e+04_r8 /) + kao(:, 1,13,16) = (/ & + & 0.85988e+03_r8,0.94717e+03_r8,0.84544e+03_r8,0.31415e+03_r8,0.60500e+03_r8, & + & 0.75003e+03_r8,0.89385e+03_r8,0.10377e+04_r8,0.11815e+04_r8 /) + kao(:, 2,13,16) = (/ & + & 0.10379e+04_r8,0.11189e+03_r8,0.20733e+03_r8,0.17410e+03_r8,0.60685e+03_r8, & + & 0.74910e+03_r8,0.89272e+03_r8,0.10306e+04_r8,0.11800e+04_r8 /) + kao(:, 3,13,16) = (/ & + & 0.70206e+03_r8,0.77801e+03_r8,0.11974e+03_r8,0.34591e+03_r8,0.60534e+03_r8, & + & 0.74861e+03_r8,0.89217e+03_r8,0.10357e+04_r8,0.11793e+04_r8 /) + kao(:, 4,13,16) = (/ & + & 0.69165e+03_r8,0.93369e+03_r8,0.16190e+03_r8,0.16396e+03_r8,0.60445e+03_r8, & + & 0.74789e+03_r8,0.89133e+03_r8,0.10348e+04_r8,0.11782e+04_r8 /) + kao(:, 5,13,16) = (/ & + & 0.20016e+03_r8,0.25832e+03_r8,0.57797e+03_r8,0.24270e+03_r8,0.60363e+03_r8, & + & 0.74689e+03_r8,0.88521e+03_r8,0.10334e+04_r8,0.11767e+04_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:, 1,13, 1) = (/ & + & 0.27369e+02_r8,0.29903e+03_r8,0.42924e+03_r8,0.31039e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,13, 1) = (/ & + & 0.27158e+02_r8,0.29898e+03_r8,0.42745e+03_r8,0.30840e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,13, 1) = (/ & + & 0.26976e+02_r8,0.29889e+03_r8,0.42590e+03_r8,0.30668e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,13, 1) = (/ & + & 0.26818e+02_r8,0.29875e+03_r8,0.42455e+03_r8,0.30517e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,13, 1) = (/ & + & 0.26679e+02_r8,0.29855e+03_r8,0.42335e+03_r8,0.30384e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,14, 1) = (/ & + & 0.26840e+02_r8,0.29863e+03_r8,0.42474e+03_r8,0.30538e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,14, 1) = (/ & + & 0.26669e+02_r8,0.29862e+03_r8,0.42327e+03_r8,0.30375e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,14, 1) = (/ & + & 0.26522e+02_r8,0.29854e+03_r8,0.42199e+03_r8,0.30234e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,14, 1) = (/ & + & 0.26394e+02_r8,0.29842e+03_r8,0.42088e+03_r8,0.30111e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,14, 1) = (/ & + & 0.26282e+02_r8,0.29824e+03_r8,0.41990e+03_r8,0.30002e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,15, 1) = (/ & + & 0.26408e+02_r8,0.29831e+03_r8,0.42100e+03_r8,0.30124e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,15, 1) = (/ & + & 0.26271e+02_r8,0.29832e+03_r8,0.41980e+03_r8,0.29991e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,15, 1) = (/ & + & 0.26152e+02_r8,0.29826e+03_r8,0.41876e+03_r8,0.29877e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,15, 1) = (/ & + & 0.26049e+02_r8,0.29814e+03_r8,0.41785e+03_r8,0.29776e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,15, 1) = (/ & + & 0.25958e+02_r8,0.29797e+03_r8,0.41705e+03_r8,0.29688e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,16, 1) = (/ & + & 0.26057e+02_r8,0.29806e+03_r8,0.41793e+03_r8,0.29784e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,16, 1) = (/ & + & 0.25946e+02_r8,0.29807e+03_r8,0.41695e+03_r8,0.29676e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,16, 1) = (/ & + & 0.25851e+02_r8,0.29803e+03_r8,0.41610e+03_r8,0.29583e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,16, 1) = (/ & + & 0.25767e+02_r8,0.29792e+03_r8,0.41536e+03_r8,0.29502e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,16, 1) = (/ & + & 0.25694e+02_r8,0.29776e+03_r8,0.41470e+03_r8,0.29430e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,17, 1) = (/ & + & 0.25772e+02_r8,0.29785e+03_r8,0.41540e+03_r8,0.29506e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,17, 1) = (/ & + & 0.25683e+02_r8,0.29787e+03_r8,0.41460e+03_r8,0.29419e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,17, 1) = (/ & + & 0.25606e+02_r8,0.29784e+03_r8,0.41391e+03_r8,0.29343e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,17, 1) = (/ & + & 0.25538e+02_r8,0.29774e+03_r8,0.41331e+03_r8,0.29277e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,17, 1) = (/ & + & 0.25479e+02_r8,0.29758e+03_r8,0.41278e+03_r8,0.29219e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,18, 1) = (/ & + & 0.25541e+02_r8,0.29768e+03_r8,0.41334e+03_r8,0.29280e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,18, 1) = (/ & + & 0.25469e+02_r8,0.29772e+03_r8,0.41269e+03_r8,0.29209e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,18, 1) = (/ & + & 0.25407e+02_r8,0.29768e+03_r8,0.41213e+03_r8,0.29147e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,18, 1) = (/ & + & 0.25353e+02_r8,0.29758e+03_r8,0.41163e+03_r8,0.29094e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,18, 1) = (/ & + & 0.25305e+02_r8,0.29743e+03_r8,0.41120e+03_r8,0.29046e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,19, 1) = (/ & + & 0.25354e+02_r8,0.29755e+03_r8,0.41165e+03_r8,0.29095e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,19, 1) = (/ & + & 0.25296e+02_r8,0.29758e+03_r8,0.41112e+03_r8,0.29037e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,19, 1) = (/ & + & 0.25245e+02_r8,0.29755e+03_r8,0.41067e+03_r8,0.28988e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,19, 1) = (/ & + & 0.25201e+02_r8,0.29746e+03_r8,0.41027e+03_r8,0.28944e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,19, 1) = (/ & + & 0.25163e+02_r8,0.29730e+03_r8,0.40991e+03_r8,0.28905e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,20, 1) = (/ & + & 0.25201e+02_r8,0.29744e+03_r8,0.41026e+03_r8,0.28943e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,20, 1) = (/ & + & 0.25154e+02_r8,0.29748e+03_r8,0.40984e+03_r8,0.28897e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,20, 1) = (/ & + & 0.25113e+02_r8,0.29745e+03_r8,0.40947e+03_r8,0.28856e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,20, 1) = (/ & + & 0.25078e+02_r8,0.29735e+03_r8,0.40914e+03_r8,0.28821e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,20, 1) = (/ & + & 0.25047e+02_r8,0.29719e+03_r8,0.40886e+03_r8,0.28790e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,21, 1) = (/ & + & 0.25076e+02_r8,0.29736e+03_r8,0.40913e+03_r8,0.28819e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,21, 1) = (/ & + & 0.25039e+02_r8,0.29739e+03_r8,0.40879e+03_r8,0.28782e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,21, 1) = (/ & + & 0.25006e+02_r8,0.29736e+03_r8,0.40849e+03_r8,0.28749e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,21, 1) = (/ & + & 0.24978e+02_r8,0.29726e+03_r8,0.40823e+03_r8,0.28722e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,21, 1) = (/ & + & 0.24952e+02_r8,0.29710e+03_r8,0.40800e+03_r8,0.28695e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,22, 1) = (/ & + & 0.24973e+02_r8,0.29729e+03_r8,0.40819e+03_r8,0.28717e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,22, 1) = (/ & + & 0.24944e+02_r8,0.29732e+03_r8,0.40792e+03_r8,0.28687e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,22, 1) = (/ & + & 0.24917e+02_r8,0.29728e+03_r8,0.40768e+03_r8,0.28661e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,22, 1) = (/ & + & 0.24895e+02_r8,0.29717e+03_r8,0.40747e+03_r8,0.28638e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,22, 1) = (/ & + & 0.24874e+02_r8,0.29700e+03_r8,0.40728e+03_r8,0.28618e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,23, 1) = (/ & + & 0.24890e+02_r8,0.29724e+03_r8,0.40743e+03_r8,0.28634e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,23, 1) = (/ & + & 0.24866e+02_r8,0.29726e+03_r8,0.40721e+03_r8,0.28610e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,23, 1) = (/ & + & 0.24846e+02_r8,0.29721e+03_r8,0.40702e+03_r8,0.28589e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,23, 1) = (/ & + & 0.24827e+02_r8,0.29710e+03_r8,0.40685e+03_r8,0.28571e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,23, 1) = (/ & + & 0.24811e+02_r8,0.29692e+03_r8,0.40671e+03_r8,0.28554e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,24, 1) = (/ & + & 0.24823e+02_r8,0.29721e+03_r8,0.40681e+03_r8,0.28566e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,24, 1) = (/ & + & 0.24804e+02_r8,0.29721e+03_r8,0.40664e+03_r8,0.28547e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,24, 1) = (/ & + & 0.24787e+02_r8,0.29715e+03_r8,0.40649e+03_r8,0.28530e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,24, 1) = (/ & + & 0.24773e+02_r8,0.29703e+03_r8,0.40635e+03_r8,0.28516e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,24, 1) = (/ & + & 0.24760e+02_r8,0.29684e+03_r8,0.40623e+03_r8,0.28503e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,25, 1) = (/ & + & 0.24769e+02_r8,0.29717e+03_r8,0.40631e+03_r8,0.28511e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,25, 1) = (/ & + & 0.24753e+02_r8,0.29717e+03_r8,0.40618e+03_r8,0.28496e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,25, 1) = (/ & + & 0.24740e+02_r8,0.29710e+03_r8,0.40606e+03_r8,0.28483e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,25, 1) = (/ & + & 0.24729e+02_r8,0.29696e+03_r8,0.40595e+03_r8,0.28472e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,25, 1) = (/ & + & 0.24718e+02_r8,0.29676e+03_r8,0.40585e+03_r8,0.28462e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,26, 1) = (/ & + & 0.24724e+02_r8,0.29715e+03_r8,0.40591e+03_r8,0.28467e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,26, 1) = (/ & + & 0.24712e+02_r8,0.29713e+03_r8,0.40580e+03_r8,0.28456e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,26, 1) = (/ & + & 0.24702e+02_r8,0.29704e+03_r8,0.40570e+03_r8,0.28445e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,26, 1) = (/ & + & 0.24693e+02_r8,0.29689e+03_r8,0.40562e+03_r8,0.28435e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,26, 1) = (/ & + & 0.24684e+02_r8,0.29668e+03_r8,0.40554e+03_r8,0.28427e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,27, 1) = (/ & + & 0.24689e+02_r8,0.29713e+03_r8,0.40558e+03_r8,0.28431e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,27, 1) = (/ & + & 0.24679e+02_r8,0.29709e+03_r8,0.40550e+03_r8,0.28422e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,27, 1) = (/ & + & 0.24671e+02_r8,0.29699e+03_r8,0.40542e+03_r8,0.28423e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,27, 1) = (/ & + & 0.24664e+02_r8,0.29683e+03_r8,0.40535e+03_r8,0.28405e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,27, 1) = (/ & + & 0.24657e+02_r8,0.29660e+03_r8,0.40529e+03_r8,0.28399e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,28, 1) = (/ & + & 0.24660e+02_r8,0.29710e+03_r8,0.40532e+03_r8,0.28404e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,28, 1) = (/ & + & 0.24653e+02_r8,0.29706e+03_r8,0.40525e+03_r8,0.28395e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,28, 1) = (/ & + & 0.24646e+02_r8,0.29694e+03_r8,0.40519e+03_r8,0.28389e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,28, 1) = (/ & + & 0.24640e+02_r8,0.29676e+03_r8,0.40514e+03_r8,0.28383e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,28, 1) = (/ & + & 0.24635e+02_r8,0.29651e+03_r8,0.40509e+03_r8,0.28376e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,29, 1) = (/ & + & 0.24637e+02_r8,0.29708e+03_r8,0.40511e+03_r8,0.28380e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,29, 1) = (/ & + & 0.24631e+02_r8,0.29702e+03_r8,0.40505e+03_r8,0.28374e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,29, 1) = (/ & + & 0.24626e+02_r8,0.29689e+03_r8,0.40500e+03_r8,0.28368e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,29, 1) = (/ & + & 0.24621e+02_r8,0.29669e+03_r8,0.40496e+03_r8,0.28364e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,29, 1) = (/ & + & 0.24617e+02_r8,0.29643e+03_r8,0.40492e+03_r8,0.28359e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,30, 1) = (/ & + & 0.24619e+02_r8,0.29706e+03_r8,0.40494e+03_r8,0.28360e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,30, 1) = (/ & + & 0.24614e+02_r8,0.29698e+03_r8,0.40489e+03_r8,0.28355e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,30, 1) = (/ & + & 0.24610e+02_r8,0.29683e+03_r8,0.40485e+03_r8,0.28351e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,30, 1) = (/ & + & 0.24606e+02_r8,0.29662e+03_r8,0.40482e+03_r8,0.28347e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,30, 1) = (/ & + & 0.24603e+02_r8,0.29634e+03_r8,0.40479e+03_r8,0.28344e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,31, 1) = (/ & + & 0.24604e+02_r8,0.29704e+03_r8,0.40480e+03_r8,0.28345e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,31, 1) = (/ & + & 0.24600e+02_r8,0.29694e+03_r8,0.40477e+03_r8,0.28341e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,31, 1) = (/ & + & 0.24597e+02_r8,0.29678e+03_r8,0.40473e+03_r8,0.28338e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,31, 1) = (/ & + & 0.24594e+02_r8,0.29655e+03_r8,0.40471e+03_r8,0.28336e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,31, 1) = (/ & + & 0.24591e+02_r8,0.29625e+03_r8,0.40468e+03_r8,0.28332e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,32, 1) = (/ & + & 0.24592e+02_r8,0.29701e+03_r8,0.40469e+03_r8,0.28333e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,32, 1) = (/ & + & 0.24589e+02_r8,0.29689e+03_r8,0.40466e+03_r8,0.28330e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,32, 1) = (/ & + & 0.24586e+02_r8,0.29672e+03_r8,0.40464e+03_r8,0.28328e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,32, 1) = (/ & + & 0.24584e+02_r8,0.29647e+03_r8,0.40461e+03_r8,0.28324e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,32, 1) = (/ & + & 0.24582e+02_r8,0.29615e+03_r8,0.40459e+03_r8,0.28325e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,33, 1) = (/ & + & 0.24582e+02_r8,0.29698e+03_r8,0.40460e+03_r8,0.28323e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,33, 1) = (/ & + & 0.24580e+02_r8,0.29685e+03_r8,0.40458e+03_r8,0.28321e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,33, 1) = (/ & + & 0.24578e+02_r8,0.29665e+03_r8,0.40456e+03_r8,0.28318e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,33, 1) = (/ & + & 0.24576e+02_r8,0.29639e+03_r8,0.40454e+03_r8,0.28317e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,33, 1) = (/ & + & 0.24574e+02_r8,0.29605e+03_r8,0.40452e+03_r8,0.28315e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,34, 1) = (/ & + & 0.24574e+02_r8,0.29695e+03_r8,0.40453e+03_r8,0.28315e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,34, 1) = (/ & + & 0.24572e+02_r8,0.29680e+03_r8,0.40451e+03_r8,0.28313e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,34, 1) = (/ & + & 0.24571e+02_r8,0.29659e+03_r8,0.40449e+03_r8,0.28312e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,34, 1) = (/ & + & 0.24569e+02_r8,0.29631e+03_r8,0.40448e+03_r8,0.28310e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,34, 1) = (/ & + & 0.24568e+02_r8,0.29596e+03_r8,0.40447e+03_r8,0.28308e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,35, 1) = (/ & + & 0.24568e+02_r8,0.29693e+03_r8,0.40447e+03_r8,0.28309e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,35, 1) = (/ & + & 0.24567e+02_r8,0.29678e+03_r8,0.40446e+03_r8,0.28308e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,35, 1) = (/ & + & 0.24565e+02_r8,0.29656e+03_r8,0.40444e+03_r8,0.28306e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,35, 1) = (/ & + & 0.24564e+02_r8,0.29627e+03_r8,0.40443e+03_r8,0.28305e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,35, 1) = (/ & + & 0.24563e+02_r8,0.29590e+03_r8,0.40442e+03_r8,0.28304e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,36, 1) = (/ & + & 0.24563e+02_r8,0.29692e+03_r8,0.40443e+03_r8,0.28305e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,36, 1) = (/ & + & 0.24562e+02_r8,0.29677e+03_r8,0.40442e+03_r8,0.28304e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,36, 1) = (/ & + & 0.24561e+02_r8,0.29655e+03_r8,0.40440e+03_r8,0.28301e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,36, 1) = (/ & + & 0.24560e+02_r8,0.29626e+03_r8,0.40440e+03_r8,0.28302e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,36, 1) = (/ & + & 0.24559e+02_r8,0.29589e+03_r8,0.40439e+03_r8,0.28301e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,37, 1) = (/ & + & 0.24560e+02_r8,0.29693e+03_r8,0.40439e+03_r8,0.28301e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,37, 1) = (/ & + & 0.24559e+02_r8,0.29679e+03_r8,0.40438e+03_r8,0.28299e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,37, 1) = (/ & + & 0.24558e+02_r8,0.29658e+03_r8,0.40437e+03_r8,0.28299e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,37, 1) = (/ & + & 0.24557e+02_r8,0.29630e+03_r8,0.40437e+03_r8,0.28297e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,37, 1) = (/ & + & 0.24556e+02_r8,0.29594e+03_r8,0.40436e+03_r8,0.28297e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,38, 1) = (/ & + & 0.24557e+02_r8,0.29695e+03_r8,0.40436e+03_r8,0.28297e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,38, 1) = (/ & + & 0.24556e+02_r8,0.29681e+03_r8,0.40436e+03_r8,0.28296e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,38, 1) = (/ & + & 0.24555e+02_r8,0.29661e+03_r8,0.40435e+03_r8,0.28297e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,38, 1) = (/ & + & 0.24554e+02_r8,0.29634e+03_r8,0.40434e+03_r8,0.28296e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,38, 1) = (/ & + & 0.24554e+02_r8,0.29599e+03_r8,0.40434e+03_r8,0.28294e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,39, 1) = (/ & + & 0.24554e+02_r8,0.29696e+03_r8,0.40434e+03_r8,0.28295e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,39, 1) = (/ & + & 0.24553e+02_r8,0.29683e+03_r8,0.40433e+03_r8,0.28294e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,39, 1) = (/ & + & 0.24553e+02_r8,0.29664e+03_r8,0.40433e+03_r8,0.28293e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,39, 1) = (/ & + & 0.24552e+02_r8,0.29638e+03_r8,0.40432e+03_r8,0.28292e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,39, 1) = (/ & + & 0.24552e+02_r8,0.29604e+03_r8,0.40432e+03_r8,0.28292e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,40, 1) = (/ & + & 0.24552e+02_r8,0.29698e+03_r8,0.40432e+03_r8,0.28292e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,40, 1) = (/ & + & 0.24551e+02_r8,0.29687e+03_r8,0.40432e+03_r8,0.28293e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,40, 1) = (/ & + & 0.24551e+02_r8,0.29669e+03_r8,0.40431e+03_r8,0.28292e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,40, 1) = (/ & + & 0.24550e+02_r8,0.29645e+03_r8,0.40431e+03_r8,0.28291e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,40, 1) = (/ & + & 0.24550e+02_r8,0.29613e+03_r8,0.40430e+03_r8,0.28291e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,41, 1) = (/ & + & 0.24550e+02_r8,0.29699e+03_r8,0.40431e+03_r8,0.28290e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,41, 1) = (/ & + & 0.24550e+02_r8,0.29690e+03_r8,0.40430e+03_r8,0.28291e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,41, 1) = (/ & + & 0.24549e+02_r8,0.29674e+03_r8,0.40430e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,41, 1) = (/ & + & 0.24549e+02_r8,0.29651e+03_r8,0.40429e+03_r8,0.28290e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,41, 1) = (/ & + & 0.24549e+02_r8,0.29622e+03_r8,0.40429e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,42, 1) = (/ & + & 0.24549e+02_r8,0.29700e+03_r8,0.40429e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,42, 1) = (/ & + & 0.24549e+02_r8,0.29693e+03_r8,0.40429e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,42, 1) = (/ & + & 0.24548e+02_r8,0.29679e+03_r8,0.40429e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,42, 1) = (/ & + & 0.24548e+02_r8,0.29658e+03_r8,0.40428e+03_r8,0.28289e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,42, 1) = (/ & + & 0.24547e+02_r8,0.29630e+03_r8,0.40428e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,43, 1) = (/ & + & 0.24548e+02_r8,0.29701e+03_r8,0.40428e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,43, 1) = (/ & + & 0.24547e+02_r8,0.29696e+03_r8,0.40428e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,43, 1) = (/ & + & 0.24547e+02_r8,0.29684e+03_r8,0.40428e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,43, 1) = (/ & + & 0.24547e+02_r8,0.29665e+03_r8,0.40427e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,43, 1) = (/ & + & 0.24547e+02_r8,0.29639e+03_r8,0.40427e+03_r8,0.28288e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,44, 1) = (/ & + & 0.24547e+02_r8,0.29702e+03_r8,0.40427e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,44, 1) = (/ & + & 0.24547e+02_r8,0.29698e+03_r8,0.40427e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,44, 1) = (/ & + & 0.24546e+02_r8,0.29688e+03_r8,0.40427e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,44, 1) = (/ & + & 0.24546e+02_r8,0.29672e+03_r8,0.40427e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,44, 1) = (/ & + & 0.24546e+02_r8,0.29649e+03_r8,0.40426e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,45, 1) = (/ & + & 0.24546e+02_r8,0.29701e+03_r8,0.40427e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,45, 1) = (/ & + & 0.24546e+02_r8,0.29700e+03_r8,0.40426e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,45, 1) = (/ & + & 0.24546e+02_r8,0.29692e+03_r8,0.40426e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,45, 1) = (/ & + & 0.24545e+02_r8,0.29678e+03_r8,0.40426e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,45, 1) = (/ & + & 0.24545e+02_r8,0.29657e+03_r8,0.40426e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,46, 1) = (/ & + & 0.24545e+02_r8,0.29699e+03_r8,0.40426e+03_r8,0.28287e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,46, 1) = (/ & + & 0.24545e+02_r8,0.29701e+03_r8,0.40426e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,46, 1) = (/ & + & 0.24545e+02_r8,0.29696e+03_r8,0.40426e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,46, 1) = (/ & + & 0.24545e+02_r8,0.29684e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,46, 1) = (/ & + & 0.24545e+02_r8,0.29665e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,47, 1) = (/ & + & 0.24545e+02_r8,0.29696e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,47, 1) = (/ & + & 0.24545e+02_r8,0.29701e+03_r8,0.40425e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,47, 1) = (/ & + & 0.24544e+02_r8,0.29699e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,47, 1) = (/ & + & 0.24544e+02_r8,0.29690e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,47, 1) = (/ & + & 0.24544e+02_r8,0.29674e+03_r8,0.40425e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,48, 1) = (/ & + & 0.24544e+02_r8,0.29691e+03_r8,0.40425e+03_r8,0.28286e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,48, 1) = (/ & + & 0.24544e+02_r8,0.29700e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,48, 1) = (/ & + & 0.24544e+02_r8,0.29701e+03_r8,0.40425e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,48, 1) = (/ & + & 0.24544e+02_r8,0.29694e+03_r8,0.40425e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,48, 1) = (/ & + & 0.24544e+02_r8,0.29681e+03_r8,0.40425e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,49, 1) = (/ & + & 0.24544e+02_r8,0.29685e+03_r8,0.40425e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,49, 1) = (/ & + & 0.24544e+02_r8,0.29698e+03_r8,0.40425e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,49, 1) = (/ & + & 0.24544e+02_r8,0.29701e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,49, 1) = (/ & + & 0.24544e+02_r8,0.29697e+03_r8,0.40424e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,49, 1) = (/ & + & 0.24544e+02_r8,0.29687e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,50, 1) = (/ & + & 0.24544e+02_r8,0.29678e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,50, 1) = (/ & + & 0.24544e+02_r8,0.29694e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,50, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,50, 1) = (/ & + & 0.24543e+02_r8,0.29700e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,50, 1) = (/ & + & 0.24543e+02_r8,0.29692e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,51, 1) = (/ & + & 0.24543e+02_r8,0.29670e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,51, 1) = (/ & + & 0.24543e+02_r8,0.29689e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,51, 1) = (/ & + & 0.24543e+02_r8,0.29699e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,51, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,51, 1) = (/ & + & 0.24543e+02_r8,0.29695e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,52, 1) = (/ & + & 0.24543e+02_r8,0.29660e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,52, 1) = (/ & + & 0.24543e+02_r8,0.29684e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,52, 1) = (/ & + & 0.24543e+02_r8,0.29697e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,52, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,52, 1) = (/ & + & 0.24543e+02_r8,0.29698e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,53, 1) = (/ & + & 0.24543e+02_r8,0.29648e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,53, 1) = (/ & + & 0.24543e+02_r8,0.29676e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,53, 1) = (/ & + & 0.24543e+02_r8,0.29693e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,53, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,53, 1) = (/ & + & 0.24543e+02_r8,0.29700e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,54, 1) = (/ & + & 0.24543e+02_r8,0.29635e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,54, 1) = (/ & + & 0.24543e+02_r8,0.29668e+03_r8,0.40424e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,54, 1) = (/ & + & 0.24543e+02_r8,0.29688e+03_r8,0.40424e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,54, 1) = (/ & + & 0.24543e+02_r8,0.29699e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,54, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40423e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,55, 1) = (/ & + & 0.24543e+02_r8,0.29622e+03_r8,0.40424e+03_r8,0.28285e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,55, 1) = (/ & + & 0.24543e+02_r8,0.29659e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,55, 1) = (/ & + & 0.24543e+02_r8,0.29683e+03_r8,0.40423e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,55, 1) = (/ & + & 0.24543e+02_r8,0.29696e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,55, 1) = (/ & + & 0.24543e+02_r8,0.29701e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,56, 1) = (/ & + & 0.24543e+02_r8,0.29607e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,56, 1) = (/ & + & 0.24543e+02_r8,0.29649e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,56, 1) = (/ & + & 0.24543e+02_r8,0.29676e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,56, 1) = (/ & + & 0.24542e+02_r8,0.29693e+03_r8,0.40423e+03_r8,0.28282e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,56, 1) = (/ & + & 0.24542e+02_r8,0.29700e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,57, 1) = (/ & + & 0.24543e+02_r8,0.29591e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,57, 1) = (/ & + & 0.24542e+02_r8,0.29637e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,57, 1) = (/ & + & 0.24542e+02_r8,0.29669e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,57, 1) = (/ & + & 0.24542e+02_r8,0.29689e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,57, 1) = (/ & + & 0.24542e+02_r8,0.29699e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,58, 1) = (/ & + & 0.24542e+02_r8,0.29574e+03_r8,0.40423e+03_r8,0.28282e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,58, 1) = (/ & + & 0.24542e+02_r8,0.29624e+03_r8,0.40423e+03_r8,0.28282e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,58, 1) = (/ & + & 0.24542e+02_r8,0.29660e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,58, 1) = (/ & + & 0.24542e+02_r8,0.29684e+03_r8,0.40423e+03_r8,0.28284e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,58, 1) = (/ & + & 0.24542e+02_r8,0.29697e+03_r8,0.40423e+03_r8,0.28282e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,59, 1) = (/ & + & 0.24542e+02_r8,0.29566e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 2,59, 1) = (/ & + & 0.24542e+02_r8,0.29619e+03_r8,0.40423e+03_r8,0.28282e+03_r8,0.35000e+02_r8 /) + kbo(:, 3,59, 1) = (/ & + & 0.24542e+02_r8,0.29657e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 4,59, 1) = (/ & + & 0.24542e+02_r8,0.29682e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 5,59, 1) = (/ & + & 0.24542e+02_r8,0.29696e+03_r8,0.40423e+03_r8,0.28283e+03_r8,0.35000e+02_r8 /) + kbo(:, 1,13, 2) = (/ & + & 0.10177e+03_r8,0.32761e+03_r8,0.45575e+03_r8,0.31335e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,13, 2) = (/ & + & 0.10099e+03_r8,0.32713e+03_r8,0.45383e+03_r8,0.31125e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,13, 2) = (/ & + & 0.10031e+03_r8,0.32663e+03_r8,0.45216e+03_r8,0.30943e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,13, 2) = (/ & + & 0.99721e+02_r8,0.32612e+03_r8,0.45071e+03_r8,0.30785e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,13, 2) = (/ & + & 0.99204e+02_r8,0.32558e+03_r8,0.44942e+03_r8,0.30646e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,14, 2) = (/ & + & 0.99803e+02_r8,0.32613e+03_r8,0.45091e+03_r8,0.30807e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,14, 2) = (/ & + & 0.99169e+02_r8,0.32574e+03_r8,0.44934e+03_r8,0.30636e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,14, 2) = (/ & + & 0.98622e+02_r8,0.32534e+03_r8,0.44797e+03_r8,0.30489e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,14, 2) = (/ & + & 0.98146e+02_r8,0.32491e+03_r8,0.44677e+03_r8,0.30362e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,14, 2) = (/ & + & 0.97728e+02_r8,0.32444e+03_r8,0.44571e+03_r8,0.30248e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,15, 2) = (/ & + & 0.98198e+02_r8,0.32493e+03_r8,0.44690e+03_r8,0.30375e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,15, 2) = (/ & + & 0.97687e+02_r8,0.32462e+03_r8,0.44560e+03_r8,0.30237e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,15, 2) = (/ & + & 0.97245e+02_r8,0.32429e+03_r8,0.44448e+03_r8,0.30119e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,15, 2) = (/ & + & 0.96861e+02_r8,0.32392e+03_r8,0.44350e+03_r8,0.30014e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,15, 2) = (/ & + & 0.96523e+02_r8,0.32350e+03_r8,0.44263e+03_r8,0.29923e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,16, 2) = (/ & + & 0.96892e+02_r8,0.32395e+03_r8,0.44358e+03_r8,0.30023e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,16, 2) = (/ & + & 0.96480e+02_r8,0.32371e+03_r8,0.44252e+03_r8,0.29912e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,16, 2) = (/ & + & 0.96125e+02_r8,0.32343e+03_r8,0.44161e+03_r8,0.29817e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,16, 2) = (/ & + & 0.95814e+02_r8,0.32311e+03_r8,0.44081e+03_r8,0.29733e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,16, 2) = (/ & + & 0.95541e+02_r8,0.32273e+03_r8,0.44010e+03_r8,0.29661e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,17, 2) = (/ & + & 0.95833e+02_r8,0.32316e+03_r8,0.44086e+03_r8,0.29737e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,17, 2) = (/ & + & 0.95501e+02_r8,0.32297e+03_r8,0.44000e+03_r8,0.29648e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,17, 2) = (/ & + & 0.95214e+02_r8,0.32274e+03_r8,0.43925e+03_r8,0.29569e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,17, 2) = (/ & + & 0.94964e+02_r8,0.32245e+03_r8,0.43860e+03_r8,0.29502e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,17, 2) = (/ & + & 0.94743e+02_r8,0.32210e+03_r8,0.43803e+03_r8,0.29442e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,18, 2) = (/ & + & 0.94974e+02_r8,0.32251e+03_r8,0.43863e+03_r8,0.29504e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,18, 2) = (/ & + & 0.94707e+02_r8,0.32236e+03_r8,0.43793e+03_r8,0.29432e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,18, 2) = (/ & + & 0.94475e+02_r8,0.32217e+03_r8,0.43733e+03_r8,0.29369e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,18, 2) = (/ & + & 0.94272e+02_r8,0.32191e+03_r8,0.43680e+03_r8,0.29315e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,18, 2) = (/ & + & 0.94094e+02_r8,0.32158e+03_r8,0.43633e+03_r8,0.29267e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,19, 2) = (/ & + & 0.94277e+02_r8,0.32199e+03_r8,0.43681e+03_r8,0.29316e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,19, 2) = (/ & + & 0.94061e+02_r8,0.32187e+03_r8,0.43624e+03_r8,0.29258e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,19, 2) = (/ & + & 0.93874e+02_r8,0.32170e+03_r8,0.43575e+03_r8,0.29207e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,19, 2) = (/ & + & 0.93711e+02_r8,0.32146e+03_r8,0.43532e+03_r8,0.29164e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,19, 2) = (/ & + & 0.93566e+02_r8,0.32115e+03_r8,0.43494e+03_r8,0.29125e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,20, 2) = (/ & + & 0.93708e+02_r8,0.32157e+03_r8,0.43531e+03_r8,0.29163e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,20, 2) = (/ & + & 0.93534e+02_r8,0.32147e+03_r8,0.43485e+03_r8,0.29117e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,20, 2) = (/ & + & 0.93383e+02_r8,0.32132e+03_r8,0.43445e+03_r8,0.29076e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,20, 2) = (/ & + & 0.93251e+02_r8,0.32109e+03_r8,0.43411e+03_r8,0.29041e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,20, 2) = (/ & + & 0.93135e+02_r8,0.32079e+03_r8,0.43380e+03_r8,0.29010e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,21, 2) = (/ & + & 0.93246e+02_r8,0.32122e+03_r8,0.43409e+03_r8,0.29040e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,21, 2) = (/ & + & 0.93106e+02_r8,0.32114e+03_r8,0.43372e+03_r8,0.29003e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,21, 2) = (/ & + & 0.92985e+02_r8,0.32100e+03_r8,0.43340e+03_r8,0.28970e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,21, 2) = (/ & + & 0.92878e+02_r8,0.32079e+03_r8,0.43311e+03_r8,0.28941e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,21, 2) = (/ & + & 0.92784e+02_r8,0.32049e+03_r8,0.43286e+03_r8,0.28917e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,22, 2) = (/ & + & 0.92863e+02_r8,0.32094e+03_r8,0.43307e+03_r8,0.28938e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,22, 2) = (/ & + & 0.92751e+02_r8,0.32087e+03_r8,0.43278e+03_r8,0.28908e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,22, 2) = (/ & + & 0.92655e+02_r8,0.32073e+03_r8,0.43252e+03_r8,0.28882e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,22, 2) = (/ & + & 0.92569e+02_r8,0.32051e+03_r8,0.43229e+03_r8,0.28860e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,22, 2) = (/ & + & 0.92494e+02_r8,0.32022e+03_r8,0.43209e+03_r8,0.28840e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,23, 2) = (/ & + & 0.92553e+02_r8,0.32072e+03_r8,0.43225e+03_r8,0.28855e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,23, 2) = (/ & + & 0.92465e+02_r8,0.32064e+03_r8,0.43201e+03_r8,0.28832e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,23, 2) = (/ & + & 0.92387e+02_r8,0.32050e+03_r8,0.43180e+03_r8,0.28811e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,23, 2) = (/ & + & 0.92319e+02_r8,0.32029e+03_r8,0.43162e+03_r8,0.28793e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,23, 2) = (/ & + & 0.92259e+02_r8,0.31998e+03_r8,0.43146e+03_r8,0.28778e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,24, 2) = (/ & + & 0.92303e+02_r8,0.32053e+03_r8,0.43158e+03_r8,0.28789e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,24, 2) = (/ & + & 0.92233e+02_r8,0.32046e+03_r8,0.43139e+03_r8,0.28770e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,24, 2) = (/ & + & 0.92171e+02_r8,0.32031e+03_r8,0.43122e+03_r8,0.28754e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,24, 2) = (/ & + & 0.92117e+02_r8,0.32009e+03_r8,0.43108e+03_r8,0.28740e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,24, 2) = (/ & + & 0.92068e+02_r8,0.31978e+03_r8,0.43095e+03_r8,0.28727e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,25, 2) = (/ & + & 0.92101e+02_r8,0.32038e+03_r8,0.43103e+03_r8,0.28736e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,25, 2) = (/ & + & 0.92045e+02_r8,0.32030e+03_r8,0.43088e+03_r8,0.28721e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,25, 2) = (/ & + & 0.91996e+02_r8,0.32015e+03_r8,0.43075e+03_r8,0.28708e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,25, 2) = (/ & + & 0.91952e+02_r8,0.31991e+03_r8,0.43064e+03_r8,0.28696e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,25, 2) = (/ & + & 0.91914e+02_r8,0.31959e+03_r8,0.43053e+03_r8,0.28684e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,26, 2) = (/ & + & 0.91937e+02_r8,0.32025e+03_r8,0.43059e+03_r8,0.28693e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,26, 2) = (/ & + & 0.91892e+02_r8,0.32016e+03_r8,0.43047e+03_r8,0.28680e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,26, 2) = (/ & + & 0.91853e+02_r8,0.32000e+03_r8,0.43037e+03_r8,0.28670e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,26, 2) = (/ & + & 0.91819e+02_r8,0.31975e+03_r8,0.43028e+03_r8,0.28661e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,26, 2) = (/ & + & 0.91788e+02_r8,0.31942e+03_r8,0.43019e+03_r8,0.28653e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,27, 2) = (/ & + & 0.91805e+02_r8,0.32015e+03_r8,0.43024e+03_r8,0.28658e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,27, 2) = (/ & + & 0.91770e+02_r8,0.32005e+03_r8,0.43014e+03_r8,0.28648e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,27, 2) = (/ & + & 0.91738e+02_r8,0.31986e+03_r8,0.43006e+03_r8,0.28630e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,27, 2) = (/ & + & 0.91711e+02_r8,0.31960e+03_r8,0.42998e+03_r8,0.28633e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,27, 2) = (/ & + & 0.91687e+02_r8,0.31925e+03_r8,0.42992e+03_r8,0.28626e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,28, 2) = (/ & + & 0.91698e+02_r8,0.32005e+03_r8,0.42995e+03_r8,0.28628e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,28, 2) = (/ & + & 0.91670e+02_r8,0.31994e+03_r8,0.42987e+03_r8,0.28622e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,28, 2) = (/ & + & 0.91646e+02_r8,0.31974e+03_r8,0.42981e+03_r8,0.28615e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,28, 2) = (/ & + & 0.91624e+02_r8,0.31946e+03_r8,0.42975e+03_r8,0.28609e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,28, 2) = (/ & + & 0.91604e+02_r8,0.31910e+03_r8,0.42970e+03_r8,0.28605e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,29, 2) = (/ & + & 0.91613e+02_r8,0.31997e+03_r8,0.42972e+03_r8,0.28605e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,29, 2) = (/ & + & 0.91591e+02_r8,0.31984e+03_r8,0.42966e+03_r8,0.28600e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,29, 2) = (/ & + & 0.91571e+02_r8,0.31963e+03_r8,0.42960e+03_r8,0.28595e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,29, 2) = (/ & + & 0.91554e+02_r8,0.31933e+03_r8,0.42956e+03_r8,0.28590e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,29, 2) = (/ & + & 0.91538e+02_r8,0.31895e+03_r8,0.42952e+03_r8,0.28586e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,30, 2) = (/ & + & 0.91544e+02_r8,0.31990e+03_r8,0.42953e+03_r8,0.28589e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,30, 2) = (/ & + & 0.91526e+02_r8,0.31975e+03_r8,0.42948e+03_r8,0.28584e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,30, 2) = (/ & + & 0.91511e+02_r8,0.31952e+03_r8,0.42944e+03_r8,0.28580e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,30, 2) = (/ & + & 0.91497e+02_r8,0.31920e+03_r8,0.42940e+03_r8,0.28577e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,30, 2) = (/ & + & 0.91484e+02_r8,0.31880e+03_r8,0.42937e+03_r8,0.28573e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,31, 2) = (/ & + & 0.91488e+02_r8,0.31983e+03_r8,0.42938e+03_r8,0.28574e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,31, 2) = (/ & + & 0.91474e+02_r8,0.31966e+03_r8,0.42934e+03_r8,0.28571e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,31, 2) = (/ & + & 0.91462e+02_r8,0.31941e+03_r8,0.42931e+03_r8,0.28567e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,31, 2) = (/ & + & 0.91451e+02_r8,0.31908e+03_r8,0.42928e+03_r8,0.28564e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,31, 2) = (/ & + & 0.91441e+02_r8,0.31866e+03_r8,0.42925e+03_r8,0.28562e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,32, 2) = (/ & + & 0.91443e+02_r8,0.31976e+03_r8,0.42926e+03_r8,0.28562e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,32, 2) = (/ & + & 0.91432e+02_r8,0.31958e+03_r8,0.42923e+03_r8,0.28559e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,32, 2) = (/ & + & 0.91423e+02_r8,0.31930e+03_r8,0.42920e+03_r8,0.28557e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,32, 2) = (/ & + & 0.91414e+02_r8,0.31895e+03_r8,0.42918e+03_r8,0.28555e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,32, 2) = (/ & + & 0.91406e+02_r8,0.31851e+03_r8,0.42916e+03_r8,0.28551e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,33, 2) = (/ & + & 0.91407e+02_r8,0.31970e+03_r8,0.42916e+03_r8,0.28553e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,33, 2) = (/ & + & 0.91399e+02_r8,0.31949e+03_r8,0.42914e+03_r8,0.28551e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,33, 2) = (/ & + & 0.91391e+02_r8,0.31920e+03_r8,0.42912e+03_r8,0.28549e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,33, 2) = (/ & + & 0.91384e+02_r8,0.31882e+03_r8,0.42910e+03_r8,0.28547e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,33, 2) = (/ & + & 0.91378e+02_r8,0.31837e+03_r8,0.42908e+03_r8,0.28546e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,34, 2) = (/ & + & 0.91379e+02_r8,0.31964e+03_r8,0.42908e+03_r8,0.28546e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,34, 2) = (/ & + & 0.91372e+02_r8,0.31941e+03_r8,0.42906e+03_r8,0.28544e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,34, 2) = (/ & + & 0.91365e+02_r8,0.31910e+03_r8,0.42905e+03_r8,0.28542e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,34, 2) = (/ & + & 0.91360e+02_r8,0.31871e+03_r8,0.42903e+03_r8,0.28541e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,34, 2) = (/ & + & 0.91355e+02_r8,0.31824e+03_r8,0.42902e+03_r8,0.28540e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,35, 2) = (/ & + & 0.91356e+02_r8,0.31960e+03_r8,0.42902e+03_r8,0.28539e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,35, 2) = (/ & + & 0.91350e+02_r8,0.31936e+03_r8,0.42901e+03_r8,0.28538e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,35, 2) = (/ & + & 0.91345e+02_r8,0.31904e+03_r8,0.42899e+03_r8,0.28537e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,35, 2) = (/ & + & 0.91341e+02_r8,0.31863e+03_r8,0.42898e+03_r8,0.28535e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,35, 2) = (/ & + & 0.91337e+02_r8,0.31816e+03_r8,0.42897e+03_r8,0.28535e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,36, 2) = (/ & + & 0.91338e+02_r8,0.31958e+03_r8,0.42897e+03_r8,0.28535e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,36, 2) = (/ & + & 0.91334e+02_r8,0.31934e+03_r8,0.42896e+03_r8,0.28533e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,36, 2) = (/ & + & 0.91330e+02_r8,0.31902e+03_r8,0.42895e+03_r8,0.28533e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,36, 2) = (/ & + & 0.91326e+02_r8,0.31862e+03_r8,0.42894e+03_r8,0.28530e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,36, 2) = (/ & + & 0.91323e+02_r8,0.31814e+03_r8,0.42893e+03_r8,0.28530e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,37, 2) = (/ & + & 0.91324e+02_r8,0.31959e+03_r8,0.42894e+03_r8,0.28531e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,37, 2) = (/ & + & 0.91320e+02_r8,0.31937e+03_r8,0.42893e+03_r8,0.28530e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,37, 2) = (/ & + & 0.91317e+02_r8,0.31906e+03_r8,0.42892e+03_r8,0.28529e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,37, 2) = (/ & + & 0.91314e+02_r8,0.31866e+03_r8,0.42891e+03_r8,0.28529e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,37, 2) = (/ & + & 0.91311e+02_r8,0.31819e+03_r8,0.42890e+03_r8,0.28527e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,38, 2) = (/ & + & 0.91313e+02_r8,0.31961e+03_r8,0.42890e+03_r8,0.28528e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,38, 2) = (/ & + & 0.91310e+02_r8,0.31939e+03_r8,0.42890e+03_r8,0.28528e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,38, 2) = (/ & + & 0.91307e+02_r8,0.31910e+03_r8,0.42889e+03_r8,0.28526e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,38, 2) = (/ & + & 0.91304e+02_r8,0.31871e+03_r8,0.42888e+03_r8,0.28525e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,38, 2) = (/ & + & 0.91302e+02_r8,0.31826e+03_r8,0.42888e+03_r8,0.28525e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,39, 2) = (/ & + & 0.91303e+02_r8,0.31962e+03_r8,0.42888e+03_r8,0.28525e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,39, 2) = (/ & + & 0.91301e+02_r8,0.31942e+03_r8,0.42887e+03_r8,0.28525e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,39, 2) = (/ & + & 0.91298e+02_r8,0.31914e+03_r8,0.42886e+03_r8,0.28525e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,39, 2) = (/ & + & 0.91296e+02_r8,0.31877e+03_r8,0.42886e+03_r8,0.28524e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,39, 2) = (/ & + & 0.91294e+02_r8,0.31832e+03_r8,0.42885e+03_r8,0.28523e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,40, 2) = (/ & + & 0.91296e+02_r8,0.31965e+03_r8,0.42886e+03_r8,0.28524e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,40, 2) = (/ & + & 0.91293e+02_r8,0.31947e+03_r8,0.42885e+03_r8,0.28522e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,40, 2) = (/ & + & 0.91292e+02_r8,0.31921e+03_r8,0.42885e+03_r8,0.28522e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,40, 2) = (/ & + & 0.91290e+02_r8,0.31886e+03_r8,0.42884e+03_r8,0.28522e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,40, 2) = (/ & + & 0.91288e+02_r8,0.31843e+03_r8,0.42884e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,41, 2) = (/ & + & 0.91289e+02_r8,0.31968e+03_r8,0.42884e+03_r8,0.28523e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,41, 2) = (/ & + & 0.91288e+02_r8,0.31952e+03_r8,0.42884e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,41, 2) = (/ & + & 0.91286e+02_r8,0.31928e+03_r8,0.42883e+03_r8,0.28522e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,41, 2) = (/ & + & 0.91284e+02_r8,0.31895e+03_r8,0.42883e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,41, 2) = (/ & + & 0.91283e+02_r8,0.31854e+03_r8,0.42882e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,42, 2) = (/ & + & 0.91284e+02_r8,0.31970e+03_r8,0.42883e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,42, 2) = (/ & + & 0.91283e+02_r8,0.31957e+03_r8,0.42882e+03_r8,0.28521e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,42, 2) = (/ & + & 0.91281e+02_r8,0.31934e+03_r8,0.42882e+03_r8,0.28520e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,42, 2) = (/ & + & 0.91280e+02_r8,0.31904e+03_r8,0.42882e+03_r8,0.28519e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,42, 2) = (/ & + & 0.91279e+02_r8,0.31865e+03_r8,0.42881e+03_r8,0.28520e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,43, 2) = (/ & + & 0.91280e+02_r8,0.31972e+03_r8,0.42882e+03_r8,0.28520e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,43, 2) = (/ & + & 0.91279e+02_r8,0.31961e+03_r8,0.42881e+03_r8,0.28520e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,43, 2) = (/ & + & 0.91277e+02_r8,0.31942e+03_r8,0.42881e+03_r8,0.28519e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,43, 2) = (/ & + & 0.91276e+02_r8,0.31914e+03_r8,0.42881e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,43, 2) = (/ & + & 0.91275e+02_r8,0.31878e+03_r8,0.42880e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,44, 2) = (/ & + & 0.91276e+02_r8,0.31974e+03_r8,0.42881e+03_r8,0.28519e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,44, 2) = (/ & + & 0.91275e+02_r8,0.31966e+03_r8,0.42880e+03_r8,0.28519e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,44, 2) = (/ & + & 0.91274e+02_r8,0.31949e+03_r8,0.42880e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,44, 2) = (/ & + & 0.91273e+02_r8,0.31924e+03_r8,0.42880e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,44, 2) = (/ & + & 0.91273e+02_r8,0.31890e+03_r8,0.42880e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,45, 2) = (/ & + & 0.91274e+02_r8,0.31974e+03_r8,0.42880e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,45, 2) = (/ & + & 0.91273e+02_r8,0.31969e+03_r8,0.42880e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,45, 2) = (/ & + & 0.91272e+02_r8,0.31955e+03_r8,0.42879e+03_r8,0.28518e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,45, 2) = (/ & + & 0.91271e+02_r8,0.31933e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,45, 2) = (/ & + & 0.91270e+02_r8,0.31903e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,46, 2) = (/ & + & 0.91271e+02_r8,0.31974e+03_r8,0.42879e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,46, 2) = (/ & + & 0.91270e+02_r8,0.31972e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,46, 2) = (/ & + & 0.91270e+02_r8,0.31961e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,46, 2) = (/ & + & 0.91269e+02_r8,0.31942e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,46, 2) = (/ & + & 0.91268e+02_r8,0.31914e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,47, 2) = (/ & + & 0.91269e+02_r8,0.31973e+03_r8,0.42879e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,47, 2) = (/ & + & 0.91268e+02_r8,0.31974e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,47, 2) = (/ & + & 0.91268e+02_r8,0.31966e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,47, 2) = (/ & + & 0.91267e+02_r8,0.31951e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,47, 2) = (/ & + & 0.91267e+02_r8,0.31926e+03_r8,0.42878e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,48, 2) = (/ & + & 0.91267e+02_r8,0.31970e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,48, 2) = (/ & + & 0.91267e+02_r8,0.31974e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,48, 2) = (/ & + & 0.91266e+02_r8,0.31970e+03_r8,0.42878e+03_r8,0.28517e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,48, 2) = (/ & + & 0.91266e+02_r8,0.31958e+03_r8,0.42878e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,48, 2) = (/ & + & 0.91265e+02_r8,0.31937e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,49, 2) = (/ & + & 0.91266e+02_r8,0.31966e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,49, 2) = (/ & + & 0.91265e+02_r8,0.31973e+03_r8,0.42878e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,49, 2) = (/ & + & 0.91265e+02_r8,0.31973e+03_r8,0.42877e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,49, 2) = (/ & + & 0.91265e+02_r8,0.31964e+03_r8,0.42878e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,49, 2) = (/ & + & 0.91264e+02_r8,0.31946e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,50, 2) = (/ & + & 0.91265e+02_r8,0.31962e+03_r8,0.42877e+03_r8,0.28516e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,50, 2) = (/ & + & 0.91264e+02_r8,0.31972e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,50, 2) = (/ & + & 0.91264e+02_r8,0.31974e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,50, 2) = (/ & + & 0.91264e+02_r8,0.31968e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,50, 2) = (/ & + & 0.91263e+02_r8,0.31954e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,51, 2) = (/ & + & 0.91264e+02_r8,0.31958e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,51, 2) = (/ & + & 0.91263e+02_r8,0.31969e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,51, 2) = (/ & + & 0.91263e+02_r8,0.31974e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,51, 2) = (/ & + & 0.91263e+02_r8,0.31971e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,51, 2) = (/ & + & 0.91262e+02_r8,0.31960e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,52, 2) = (/ & + & 0.91263e+02_r8,0.31953e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,52, 2) = (/ & + & 0.91263e+02_r8,0.31965e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,52, 2) = (/ & + & 0.91262e+02_r8,0.31973e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,52, 2) = (/ & + & 0.91262e+02_r8,0.31973e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,52, 2) = (/ & + & 0.91262e+02_r8,0.31965e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,53, 2) = (/ & + & 0.91262e+02_r8,0.31948e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,53, 2) = (/ & + & 0.91262e+02_r8,0.31961e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,53, 2) = (/ & + & 0.91262e+02_r8,0.31971e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,53, 2) = (/ & + & 0.91261e+02_r8,0.31974e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,53, 2) = (/ & + & 0.91261e+02_r8,0.31969e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,54, 2) = (/ & + & 0.91262e+02_r8,0.31942e+03_r8,0.42877e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,54, 2) = (/ & + & 0.91261e+02_r8,0.31957e+03_r8,0.42877e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,54, 2) = (/ & + & 0.91261e+02_r8,0.31968e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,54, 2) = (/ & + & 0.91261e+02_r8,0.31973e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,54, 2) = (/ & + & 0.91261e+02_r8,0.31971e+03_r8,0.42876e+03_r8,0.28513e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,55, 2) = (/ & + & 0.91261e+02_r8,0.31937e+03_r8,0.42876e+03_r8,0.28513e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,55, 2) = (/ & + & 0.91261e+02_r8,0.31953e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,55, 2) = (/ & + & 0.91261e+02_r8,0.31965e+03_r8,0.42876e+03_r8,0.28513e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,55, 2) = (/ & + & 0.91261e+02_r8,0.31973e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,55, 2) = (/ & + & 0.91260e+02_r8,0.31973e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,56, 2) = (/ & + & 0.91261e+02_r8,0.31932e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,56, 2) = (/ & + & 0.91260e+02_r8,0.31947e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,56, 2) = (/ & + & 0.91260e+02_r8,0.31961e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,56, 2) = (/ & + & 0.91260e+02_r8,0.31971e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,56, 2) = (/ & + & 0.91260e+02_r8,0.31974e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,57, 2) = (/ & + & 0.91260e+02_r8,0.31927e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,57, 2) = (/ & + & 0.91260e+02_r8,0.31943e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,57, 2) = (/ & + & 0.91260e+02_r8,0.31957e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,57, 2) = (/ & + & 0.91260e+02_r8,0.31968e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,57, 2) = (/ & + & 0.91260e+02_r8,0.31974e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,58, 2) = (/ & + & 0.91260e+02_r8,0.31922e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,58, 2) = (/ & + & 0.91260e+02_r8,0.31938e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,58, 2) = (/ & + & 0.91260e+02_r8,0.31953e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,58, 2) = (/ & + & 0.91260e+02_r8,0.31965e+03_r8,0.42876e+03_r8,0.28513e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,58, 2) = (/ & + & 0.91260e+02_r8,0.31973e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,59, 2) = (/ & + & 0.91260e+02_r8,0.31920e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 2,59, 2) = (/ & + & 0.91260e+02_r8,0.31936e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 3,59, 2) = (/ & + & 0.91259e+02_r8,0.31952e+03_r8,0.42876e+03_r8,0.28515e+03_r8,0.71839e+02_r8 /) + kbo(:, 4,59, 2) = (/ & + & 0.91259e+02_r8,0.31964e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 5,59, 2) = (/ & + & 0.91259e+02_r8,0.31972e+03_r8,0.42876e+03_r8,0.28514e+03_r8,0.71839e+02_r8 /) + kbo(:, 1,13, 3) = (/ & + & 0.26463e+03_r8,0.36163e+03_r8,0.49889e+03_r8,0.32504e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,13, 3) = (/ & + & 0.26258e+03_r8,0.36010e+03_r8,0.49695e+03_r8,0.32345e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,13, 3) = (/ & + & 0.26083e+03_r8,0.35879e+03_r8,0.49519e+03_r8,0.32209e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,13, 3) = (/ & + & 0.25930e+03_r8,0.35766e+03_r8,0.49360e+03_r8,0.32093e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,13, 3) = (/ & + & 0.25795e+03_r8,0.35666e+03_r8,0.49217e+03_r8,0.31991e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,14, 3) = (/ & + & 0.25951e+03_r8,0.35782e+03_r8,0.49358e+03_r8,0.32109e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,14, 3) = (/ & + & 0.25786e+03_r8,0.35659e+03_r8,0.49191e+03_r8,0.31984e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,14, 3) = (/ & + & 0.25644e+03_r8,0.35554e+03_r8,0.49043e+03_r8,0.31877e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,14, 3) = (/ & + & 0.25520e+03_r8,0.35461e+03_r8,0.48912e+03_r8,0.31784e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,14, 3) = (/ & + & 0.25411e+03_r8,0.35381e+03_r8,0.48795e+03_r8,0.31704e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,15, 3) = (/ & + & 0.25534e+03_r8,0.35471e+03_r8,0.48908e+03_r8,0.31794e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,15, 3) = (/ & + & 0.25401e+03_r8,0.35373e+03_r8,0.48771e+03_r8,0.31695e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,15, 3) = (/ & + & 0.25286e+03_r8,0.35287e+03_r8,0.48651e+03_r8,0.31610e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,15, 3) = (/ & + & 0.25186e+03_r8,0.35213e+03_r8,0.48543e+03_r8,0.31537e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,15, 3) = (/ & + & 0.25098e+03_r8,0.35147e+03_r8,0.48447e+03_r8,0.31472e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,16, 3) = (/ & + & 0.25194e+03_r8,0.35219e+03_r8,0.48538e+03_r8,0.31543e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,16, 3) = (/ & + & 0.25087e+03_r8,0.35140e+03_r8,0.48427e+03_r8,0.31463e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,16, 3) = (/ & + & 0.24994e+03_r8,0.35071e+03_r8,0.48328e+03_r8,0.31395e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,16, 3) = (/ & + & 0.24914e+03_r8,0.35011e+03_r8,0.48239e+03_r8,0.31337e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,16, 3) = (/ & + & 0.24843e+03_r8,0.34958e+03_r8,0.48159e+03_r8,0.31282e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,17, 3) = (/ & + & 0.24919e+03_r8,0.35014e+03_r8,0.48236e+03_r8,0.31341e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,17, 3) = (/ & + & 0.24832e+03_r8,0.34950e+03_r8,0.48145e+03_r8,0.31278e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,17, 3) = (/ & + & 0.24758e+03_r8,0.34895e+03_r8,0.48063e+03_r8,0.31225e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,17, 3) = (/ & + & 0.24693e+03_r8,0.34847e+03_r8,0.47989e+03_r8,0.31178e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,17, 3) = (/ & + & 0.24635e+03_r8,0.34804e+03_r8,0.47924e+03_r8,0.31137e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,18, 3) = (/ & + & 0.24695e+03_r8,0.34848e+03_r8,0.47988e+03_r8,0.31180e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,18, 3) = (/ & + & 0.24626e+03_r8,0.34797e+03_r8,0.47913e+03_r8,0.31130e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,18, 3) = (/ & + & 0.24565e+03_r8,0.34752e+03_r8,0.47845e+03_r8,0.31086e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,18, 3) = (/ & + & 0.24513e+03_r8,0.34713e+03_r8,0.47784e+03_r8,0.31048e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,18, 3) = (/ & + & 0.24466e+03_r8,0.34679e+03_r8,0.47731e+03_r8,0.31015e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,19, 3) = (/ & + & 0.24514e+03_r8,0.34714e+03_r8,0.47784e+03_r8,0.31049e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,19, 3) = (/ & + & 0.24458e+03_r8,0.34672e+03_r8,0.47721e+03_r8,0.31009e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,19, 3) = (/ & + & 0.24409e+03_r8,0.34636e+03_r8,0.47665e+03_r8,0.30974e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,19, 3) = (/ & + & 0.24367e+03_r8,0.34605e+03_r8,0.47616e+03_r8,0.30943e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,19, 3) = (/ & + & 0.24329e+03_r8,0.34577e+03_r8,0.47573e+03_r8,0.30916e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,20, 3) = (/ & + & 0.24366e+03_r8,0.34604e+03_r8,0.47615e+03_r8,0.30943e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,20, 3) = (/ & + & 0.24321e+03_r8,0.34571e+03_r8,0.47563e+03_r8,0.30910e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,20, 3) = (/ & + & 0.24282e+03_r8,0.34542e+03_r8,0.47518e+03_r8,0.30882e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,20, 3) = (/ & + & 0.24247e+03_r8,0.34516e+03_r8,0.47478e+03_r8,0.30857e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,20, 3) = (/ & + & 0.24217e+03_r8,0.34494e+03_r8,0.47443e+03_r8,0.30835e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,21, 3) = (/ & + & 0.24246e+03_r8,0.34515e+03_r8,0.47476e+03_r8,0.30856e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,21, 3) = (/ & + & 0.24210e+03_r8,0.34488e+03_r8,0.47434e+03_r8,0.30830e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,21, 3) = (/ & + & 0.24178e+03_r8,0.34465e+03_r8,0.47397e+03_r8,0.30807e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,21, 3) = (/ & + & 0.24150e+03_r8,0.34444e+03_r8,0.47364e+03_r8,0.30787e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,21, 3) = (/ & + & 0.24126e+03_r8,0.34426e+03_r8,0.47341e+03_r8,0.30769e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,22, 3) = (/ & + & 0.24146e+03_r8,0.34441e+03_r8,0.47360e+03_r8,0.30784e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,22, 3) = (/ & + & 0.24117e+03_r8,0.34420e+03_r8,0.47327e+03_r8,0.30763e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,22, 3) = (/ & + & 0.24092e+03_r8,0.34401e+03_r8,0.47296e+03_r8,0.30745e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,22, 3) = (/ & + & 0.24070e+03_r8,0.34385e+03_r8,0.47270e+03_r8,0.30729e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,22, 3) = (/ & + & 0.24050e+03_r8,0.34370e+03_r8,0.47246e+03_r8,0.30715e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,23, 3) = (/ & + & 0.24066e+03_r8,0.34382e+03_r8,0.47265e+03_r8,0.30726e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,23, 3) = (/ & + & 0.24043e+03_r8,0.34365e+03_r8,0.47237e+03_r8,0.30709e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,23, 3) = (/ & + & 0.24023e+03_r8,0.34350e+03_r8,0.47213e+03_r8,0.30695e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,23, 3) = (/ & + & 0.24005e+03_r8,0.34336e+03_r8,0.47191e+03_r8,0.30682e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,23, 3) = (/ & + & 0.23989e+03_r8,0.34325e+03_r8,0.47173e+03_r8,0.30671e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,24, 3) = (/ & + & 0.24001e+03_r8,0.34333e+03_r8,0.47187e+03_r8,0.30679e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,24, 3) = (/ & + & 0.23982e+03_r8,0.34320e+03_r8,0.47164e+03_r8,0.30666e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,24, 3) = (/ & + & 0.23966e+03_r8,0.34308e+03_r8,0.47145e+03_r8,0.30654e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,24, 3) = (/ & + & 0.23952e+03_r8,0.34297e+03_r8,0.47128e+03_r8,0.30644e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,24, 3) = (/ & + & 0.23940e+03_r8,0.34288e+03_r8,0.47113e+03_r8,0.30635e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,25, 3) = (/ & + & 0.23948e+03_r8,0.34294e+03_r8,0.47124e+03_r8,0.30641e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,25, 3) = (/ & + & 0.23934e+03_r8,0.34284e+03_r8,0.47105e+03_r8,0.30631e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,25, 3) = (/ & + & 0.23921e+03_r8,0.34274e+03_r8,0.47089e+03_r8,0.30622e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,25, 3) = (/ & + & 0.23910e+03_r8,0.34266e+03_r8,0.47075e+03_r8,0.30613e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,25, 3) = (/ & + & 0.23900e+03_r8,0.34258e+03_r8,0.47063e+03_r8,0.30606e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,26, 3) = (/ & + & 0.23906e+03_r8,0.34263e+03_r8,0.47070e+03_r8,0.30610e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,26, 3) = (/ & + & 0.23894e+03_r8,0.34254e+03_r8,0.47056e+03_r8,0.30602e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,26, 3) = (/ & + & 0.23884e+03_r8,0.34247e+03_r8,0.47044e+03_r8,0.30595e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,26, 3) = (/ & + & 0.23875e+03_r8,0.34240e+03_r8,0.47033e+03_r8,0.30588e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,26, 3) = (/ & + & 0.23867e+03_r8,0.34234e+03_r8,0.47023e+03_r8,0.30583e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,27, 3) = (/ & + & 0.23871e+03_r8,0.34237e+03_r8,0.47028e+03_r8,0.30586e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,27, 3) = (/ & + & 0.23862e+03_r8,0.34230e+03_r8,0.47017e+03_r8,0.30579e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,27, 3) = (/ & + & 0.23854e+03_r8,0.34225e+03_r8,0.47007e+03_r8,0.30573e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,27, 3) = (/ & + & 0.23847e+03_r8,0.34219e+03_r8,0.46998e+03_r8,0.30568e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,27, 3) = (/ & + & 0.23840e+03_r8,0.34214e+03_r8,0.46990e+03_r8,0.30564e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,28, 3) = (/ & + & 0.23844e+03_r8,0.34217e+03_r8,0.46994e+03_r8,0.30566e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,28, 3) = (/ & + & 0.23836e+03_r8,0.34211e+03_r8,0.46985e+03_r8,0.30561e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,28, 3) = (/ & + & 0.23830e+03_r8,0.34207e+03_r8,0.46977e+03_r8,0.30556e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,28, 3) = (/ & + & 0.23824e+03_r8,0.34202e+03_r8,0.46970e+03_r8,0.30552e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,28, 3) = (/ & + & 0.23819e+03_r8,0.34198e+03_r8,0.46964e+03_r8,0.30548e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,29, 3) = (/ & + & 0.23821e+03_r8,0.34200e+03_r8,0.46966e+03_r8,0.30550e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,29, 3) = (/ & + & 0.23815e+03_r8,0.34196e+03_r8,0.46959e+03_r8,0.30546e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,29, 3) = (/ & + & 0.23810e+03_r8,0.34192e+03_r8,0.46953e+03_r8,0.30542e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,29, 3) = (/ & + & 0.23806e+03_r8,0.34189e+03_r8,0.46948e+03_r8,0.30539e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,29, 3) = (/ & + & 0.23802e+03_r8,0.34185e+03_r8,0.46942e+03_r8,0.30536e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,30, 3) = (/ & + & 0.23803e+03_r8,0.34187e+03_r8,0.46944e+03_r8,0.30537e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,30, 3) = (/ & + & 0.23799e+03_r8,0.34184e+03_r8,0.46939e+03_r8,0.30533e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,30, 3) = (/ & + & 0.23795e+03_r8,0.34180e+03_r8,0.46934e+03_r8,0.30531e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,30, 3) = (/ & + & 0.23791e+03_r8,0.34178e+03_r8,0.46929e+03_r8,0.30528e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,30, 3) = (/ & + & 0.23788e+03_r8,0.34175e+03_r8,0.46925e+03_r8,0.30526e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,31, 3) = (/ & + & 0.23789e+03_r8,0.34176e+03_r8,0.46926e+03_r8,0.30526e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,31, 3) = (/ & + & 0.23785e+03_r8,0.34173e+03_r8,0.46922e+03_r8,0.30524e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,31, 3) = (/ & + & 0.23782e+03_r8,0.34171e+03_r8,0.46918e+03_r8,0.30521e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,31, 3) = (/ & + & 0.23779e+03_r8,0.34169e+03_r8,0.46914e+03_r8,0.30519e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,31, 3) = (/ & + & 0.23777e+03_r8,0.34167e+03_r8,0.46911e+03_r8,0.30518e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,32, 3) = (/ & + & 0.23777e+03_r8,0.34168e+03_r8,0.46912e+03_r8,0.30518e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,32, 3) = (/ & + & 0.23774e+03_r8,0.34166e+03_r8,0.46908e+03_r8,0.30516e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,32, 3) = (/ & + & 0.23772e+03_r8,0.34163e+03_r8,0.46905e+03_r8,0.30514e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,32, 3) = (/ & + & 0.23770e+03_r8,0.34162e+03_r8,0.46902e+03_r8,0.30512e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,32, 3) = (/ & + & 0.23767e+03_r8,0.34160e+03_r8,0.46900e+03_r8,0.30511e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,33, 3) = (/ & + & 0.23768e+03_r8,0.34161e+03_r8,0.46900e+03_r8,0.30511e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,33, 3) = (/ & + & 0.23766e+03_r8,0.34159e+03_r8,0.46897e+03_r8,0.30510e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,33, 3) = (/ & + & 0.23764e+03_r8,0.34157e+03_r8,0.46895e+03_r8,0.30508e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,33, 3) = (/ & + & 0.23762e+03_r8,0.34156e+03_r8,0.46893e+03_r8,0.30507e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,33, 3) = (/ & + & 0.23760e+03_r8,0.34154e+03_r8,0.46891e+03_r8,0.30506e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,34, 3) = (/ & + & 0.23760e+03_r8,0.34155e+03_r8,0.46891e+03_r8,0.30506e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,34, 3) = (/ & + & 0.23759e+03_r8,0.34154e+03_r8,0.46889e+03_r8,0.30505e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,34, 3) = (/ & + & 0.23757e+03_r8,0.34152e+03_r8,0.46887e+03_r8,0.30503e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,34, 3) = (/ & + & 0.23756e+03_r8,0.34151e+03_r8,0.46885e+03_r8,0.30502e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,34, 3) = (/ & + & 0.23754e+03_r8,0.34150e+03_r8,0.46883e+03_r8,0.30501e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,35, 3) = (/ & + & 0.23755e+03_r8,0.34151e+03_r8,0.46884e+03_r8,0.30502e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,35, 3) = (/ & + & 0.23753e+03_r8,0.34150e+03_r8,0.46882e+03_r8,0.30501e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,35, 3) = (/ & + & 0.23752e+03_r8,0.34148e+03_r8,0.46880e+03_r8,0.30500e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,35, 3) = (/ & + & 0.23751e+03_r8,0.34147e+03_r8,0.46879e+03_r8,0.30499e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,35, 3) = (/ & + & 0.23750e+03_r8,0.34146e+03_r8,0.46878e+03_r8,0.30498e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,36, 3) = (/ & + & 0.23750e+03_r8,0.34147e+03_r8,0.46878e+03_r8,0.30498e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,36, 3) = (/ & + & 0.23749e+03_r8,0.34146e+03_r8,0.46877e+03_r8,0.30497e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,36, 3) = (/ & + & 0.23748e+03_r8,0.34145e+03_r8,0.46875e+03_r8,0.30497e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,36, 3) = (/ & + & 0.23747e+03_r8,0.34144e+03_r8,0.46874e+03_r8,0.30496e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,36, 3) = (/ & + & 0.23746e+03_r8,0.34144e+03_r8,0.46873e+03_r8,0.30495e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,37, 3) = (/ & + & 0.23746e+03_r8,0.34145e+03_r8,0.46874e+03_r8,0.30496e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,37, 3) = (/ & + & 0.23745e+03_r8,0.34144e+03_r8,0.46872e+03_r8,0.30495e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,37, 3) = (/ & + & 0.23744e+03_r8,0.34143e+03_r8,0.46871e+03_r8,0.30494e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,37, 3) = (/ & + & 0.23744e+03_r8,0.34142e+03_r8,0.46870e+03_r8,0.30494e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,37, 3) = (/ & + & 0.23743e+03_r8,0.34141e+03_r8,0.46869e+03_r8,0.30493e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,38, 3) = (/ & + & 0.23743e+03_r8,0.34143e+03_r8,0.46870e+03_r8,0.30493e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,38, 3) = (/ & + & 0.23742e+03_r8,0.34142e+03_r8,0.46869e+03_r8,0.30493e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,38, 3) = (/ & + & 0.23742e+03_r8,0.34141e+03_r8,0.46868e+03_r8,0.30492e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,38, 3) = (/ & + & 0.23741e+03_r8,0.34140e+03_r8,0.46867e+03_r8,0.30492e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,38, 3) = (/ & + & 0.23740e+03_r8,0.34140e+03_r8,0.46866e+03_r8,0.30491e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,39, 3) = (/ & + & 0.23741e+03_r8,0.34141e+03_r8,0.46867e+03_r8,0.30492e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,39, 3) = (/ & + & 0.23740e+03_r8,0.34140e+03_r8,0.46866e+03_r8,0.30491e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,39, 3) = (/ & + & 0.23739e+03_r8,0.34139e+03_r8,0.46865e+03_r8,0.30491e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,39, 3) = (/ & + & 0.23739e+03_r8,0.34139e+03_r8,0.46865e+03_r8,0.30490e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,39, 3) = (/ & + & 0.23738e+03_r8,0.34138e+03_r8,0.46864e+03_r8,0.30490e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,40, 3) = (/ & + & 0.23739e+03_r8,0.34139e+03_r8,0.46864e+03_r8,0.30490e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,40, 3) = (/ & + & 0.23738e+03_r8,0.34139e+03_r8,0.46864e+03_r8,0.30490e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,40, 3) = (/ & + & 0.23738e+03_r8,0.34138e+03_r8,0.46863e+03_r8,0.30489e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,40, 3) = (/ & + & 0.23737e+03_r8,0.34138e+03_r8,0.46862e+03_r8,0.30489e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,40, 3) = (/ & + & 0.23737e+03_r8,0.34137e+03_r8,0.46862e+03_r8,0.30489e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,41, 3) = (/ & + & 0.23737e+03_r8,0.34138e+03_r8,0.46862e+03_r8,0.30489e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,41, 3) = (/ & + & 0.23737e+03_r8,0.34138e+03_r8,0.46862e+03_r8,0.30489e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,41, 3) = (/ & + & 0.23736e+03_r8,0.34137e+03_r8,0.46861e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,41, 3) = (/ & + & 0.23736e+03_r8,0.34137e+03_r8,0.46861e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,41, 3) = (/ & + & 0.23736e+03_r8,0.34136e+03_r8,0.46860e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,42, 3) = (/ & + & 0.23736e+03_r8,0.34137e+03_r8,0.46861e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,42, 3) = (/ & + & 0.23735e+03_r8,0.34137e+03_r8,0.46860e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,42, 3) = (/ & + & 0.23735e+03_r8,0.34136e+03_r8,0.46860e+03_r8,0.30488e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,42, 3) = (/ & + & 0.23735e+03_r8,0.34136e+03_r8,0.46859e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,42, 3) = (/ & + & 0.23734e+03_r8,0.34135e+03_r8,0.46859e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,43, 3) = (/ & + & 0.23735e+03_r8,0.34136e+03_r8,0.46859e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,43, 3) = (/ & + & 0.23734e+03_r8,0.34136e+03_r8,0.46859e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,43, 3) = (/ & + & 0.23734e+03_r8,0.34136e+03_r8,0.46858e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,43, 3) = (/ & + & 0.23734e+03_r8,0.34135e+03_r8,0.46858e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,43, 3) = (/ & + & 0.23734e+03_r8,0.34135e+03_r8,0.46858e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,44, 3) = (/ & + & 0.23734e+03_r8,0.34136e+03_r8,0.46858e+03_r8,0.30487e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,44, 3) = (/ & + & 0.23734e+03_r8,0.34135e+03_r8,0.46858e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,44, 3) = (/ & + & 0.23733e+03_r8,0.34135e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,44, 3) = (/ & + & 0.23733e+03_r8,0.34135e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,44, 3) = (/ & + & 0.23733e+03_r8,0.34134e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,45, 3) = (/ & + & 0.23733e+03_r8,0.34135e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,45, 3) = (/ & + & 0.23733e+03_r8,0.34135e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,45, 3) = (/ & + & 0.23733e+03_r8,0.34135e+03_r8,0.46857e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,45, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,45, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,46, 3) = (/ & + & 0.23732e+03_r8,0.34135e+03_r8,0.46856e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,46, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30486e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,46, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,46, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,46, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,47, 3) = (/ & + & 0.23732e+03_r8,0.34135e+03_r8,0.46856e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,47, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46856e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,47, 3) = (/ & + & 0.23732e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,47, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,47, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,48, 3) = (/ & + & 0.23731e+03_r8,0.34135e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,48, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,48, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,48, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,48, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,49, 3) = (/ & + & 0.23731e+03_r8,0.34135e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,49, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46855e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,49, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30485e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,49, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,49, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,50, 3) = (/ & + & 0.23731e+03_r8,0.34136e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,50, 3) = (/ & + & 0.23731e+03_r8,0.34134e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,50, 3) = (/ & + & 0.23731e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,50, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,50, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,51, 3) = (/ & + & 0.23731e+03_r8,0.34136e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,51, 3) = (/ & + & 0.23730e+03_r8,0.34134e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,51, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,51, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,51, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,52, 3) = (/ & + & 0.23730e+03_r8,0.34136e+03_r8,0.46852e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,52, 3) = (/ & + & 0.23730e+03_r8,0.34135e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,52, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,52, 3) = (/ & + & 0.23730e+03_r8,0.34132e+03_r8,0.46854e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,52, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,53, 3) = (/ & + & 0.23730e+03_r8,0.34137e+03_r8,0.46851e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,53, 3) = (/ & + & 0.23730e+03_r8,0.34135e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,53, 3) = (/ & + & 0.23730e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,53, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,53, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,54, 3) = (/ & + & 0.23730e+03_r8,0.34137e+03_r8,0.46849e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,54, 3) = (/ & + & 0.23730e+03_r8,0.34136e+03_r8,0.46852e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,54, 3) = (/ & + & 0.23730e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,54, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,54, 3) = (/ & + & 0.23730e+03_r8,0.34132e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,55, 3) = (/ & + & 0.23730e+03_r8,0.34138e+03_r8,0.46847e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,55, 3) = (/ & + & 0.23730e+03_r8,0.34136e+03_r8,0.46852e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,55, 3) = (/ & + & 0.23730e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,55, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,55, 3) = (/ & + & 0.23730e+03_r8,0.34132e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,56, 3) = (/ & + & 0.23730e+03_r8,0.34139e+03_r8,0.46844e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,56, 3) = (/ & + & 0.23730e+03_r8,0.34137e+03_r8,0.46850e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,56, 3) = (/ & + & 0.23730e+03_r8,0.34135e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,56, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,56, 3) = (/ & + & 0.23730e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,57, 3) = (/ & + & 0.23730e+03_r8,0.34140e+03_r8,0.46840e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,57, 3) = (/ & + & 0.23730e+03_r8,0.34137e+03_r8,0.46849e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,57, 3) = (/ & + & 0.23730e+03_r8,0.34135e+03_r8,0.46852e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,57, 3) = (/ & + & 0.23730e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,57, 3) = (/ & + & 0.23729e+03_r8,0.34132e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,58, 3) = (/ & + & 0.23730e+03_r8,0.34140e+03_r8,0.46837e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,58, 3) = (/ & + & 0.23729e+03_r8,0.34138e+03_r8,0.46847e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,58, 3) = (/ & + & 0.23729e+03_r8,0.34136e+03_r8,0.46851e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,58, 3) = (/ & + & 0.23729e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,58, 3) = (/ & + & 0.23729e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30483e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,59, 3) = (/ & + & 0.23729e+03_r8,0.34141e+03_r8,0.46835e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 2,59, 3) = (/ & + & 0.23729e+03_r8,0.34138e+03_r8,0.46846e+03_r8,0.30484e+03_r8,0.17829e+03_r8 /) + kbo(:, 3,59, 3) = (/ & + & 0.23729e+03_r8,0.34136e+03_r8,0.46851e+03_r8,0.30483e+03_r8,0.17829e+03_r8 /) + kbo(:, 4,59, 3) = (/ & + & 0.23729e+03_r8,0.34134e+03_r8,0.46853e+03_r8,0.30483e+03_r8,0.17829e+03_r8 /) + kbo(:, 5,59, 3) = (/ & + & 0.23729e+03_r8,0.34133e+03_r8,0.46853e+03_r8,0.30483e+03_r8,0.17829e+03_r8 /) + kbo(:, 1,13, 4) = (/ & + & 0.51214e+03_r8,0.47089e+03_r8,0.53698e+03_r8,0.40623e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,13, 4) = (/ & + & 0.50819e+03_r8,0.46793e+03_r8,0.53525e+03_r8,0.40532e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,13, 4) = (/ & + & 0.50478e+03_r8,0.46537e+03_r8,0.53379e+03_r8,0.40453e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,13, 4) = (/ & + & 0.50182e+03_r8,0.46315e+03_r8,0.53251e+03_r8,0.40385e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,13, 4) = (/ & + & 0.49922e+03_r8,0.46120e+03_r8,0.53137e+03_r8,0.40325e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,14, 4) = (/ & + & 0.50224e+03_r8,0.46346e+03_r8,0.53224e+03_r8,0.40395e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,14, 4) = (/ & + & 0.49905e+03_r8,0.46107e+03_r8,0.53090e+03_r8,0.40321e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,14, 4) = (/ & + & 0.49629e+03_r8,0.45901e+03_r8,0.52974e+03_r8,0.40258e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,14, 4) = (/ & + & 0.49390e+03_r8,0.45721e+03_r8,0.52871e+03_r8,0.40203e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,14, 4) = (/ & + & 0.49179e+03_r8,0.45563e+03_r8,0.52774e+03_r8,0.40154e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,15, 4) = (/ & + & 0.49416e+03_r8,0.45741e+03_r8,0.52835e+03_r8,0.40209e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,15, 4) = (/ & + & 0.49159e+03_r8,0.45548e+03_r8,0.52725e+03_r8,0.40149e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,15, 4) = (/ & + & 0.48937e+03_r8,0.45381e+03_r8,0.52626e+03_r8,0.40098e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,15, 4) = (/ & + & 0.48743e+03_r8,0.45236e+03_r8,0.52534e+03_r8,0.40054e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,15, 4) = (/ & + & 0.48573e+03_r8,0.45108e+03_r8,0.52448e+03_r8,0.40015e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,16, 4) = (/ & + & 0.48759e+03_r8,0.45248e+03_r8,0.52492e+03_r8,0.40057e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,16, 4) = (/ & + & 0.48552e+03_r8,0.45092e+03_r8,0.52397e+03_r8,0.40010e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,16, 4) = (/ & + & 0.48373e+03_r8,0.44958e+03_r8,0.52310e+03_r8,0.39968e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,16, 4) = (/ & + & 0.48216e+03_r8,0.44841e+03_r8,0.52232e+03_r8,0.39932e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,16, 4) = (/ & + & 0.48079e+03_r8,0.44738e+03_r8,0.52159e+03_r8,0.39901e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,17, 4) = (/ & + & 0.48226e+03_r8,0.44848e+03_r8,0.52188e+03_r8,0.39935e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,17, 4) = (/ & + & 0.48059e+03_r8,0.44723e+03_r8,0.52110e+03_r8,0.39896e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,17, 4) = (/ & + & 0.47915e+03_r8,0.44615e+03_r8,0.52038e+03_r8,0.39863e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,17, 4) = (/ & + & 0.47788e+03_r8,0.44520e+03_r8,0.51974e+03_r8,0.39834e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,17, 4) = (/ & + & 0.47677e+03_r8,0.44437e+03_r8,0.51913e+03_r8,0.39808e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,18, 4) = (/ & + & 0.47794e+03_r8,0.44524e+03_r8,0.51928e+03_r8,0.39835e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,18, 4) = (/ & + & 0.47659e+03_r8,0.44423e+03_r8,0.51865e+03_r8,0.39804e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,18, 4) = (/ & + & 0.47542e+03_r8,0.44336e+03_r8,0.51808e+03_r8,0.39777e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,18, 4) = (/ & + & 0.47441e+03_r8,0.44259e+03_r8,0.51755e+03_r8,0.39754e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,18, 4) = (/ & + & 0.47351e+03_r8,0.44192e+03_r8,0.51705e+03_r8,0.39733e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,19, 4) = (/ & + & 0.47443e+03_r8,0.44261e+03_r8,0.51710e+03_r8,0.39754e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,19, 4) = (/ & + & 0.47334e+03_r8,0.44179e+03_r8,0.51660e+03_r8,0.39729e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,19, 4) = (/ & + & 0.47240e+03_r8,0.44109e+03_r8,0.51615e+03_r8,0.39708e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,19, 4) = (/ & + & 0.47158e+03_r8,0.44047e+03_r8,0.51573e+03_r8,0.39689e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,19, 4) = (/ & + & 0.47085e+03_r8,0.43993e+03_r8,0.51533e+03_r8,0.39672e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,20, 4) = (/ & + & 0.47156e+03_r8,0.44046e+03_r8,0.51527e+03_r8,0.39688e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,20, 4) = (/ & + & 0.47069e+03_r8,0.43980e+03_r8,0.51490e+03_r8,0.39668e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,20, 4) = (/ & + & 0.46993e+03_r8,0.43924e+03_r8,0.51455e+03_r8,0.39651e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,20, 4) = (/ & + & 0.46927e+03_r8,0.43874e+03_r8,0.51422e+03_r8,0.39635e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,20, 4) = (/ & + & 0.46868e+03_r8,0.43830e+03_r8,0.51389e+03_r8,0.39622e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,21, 4) = (/ & + & 0.46924e+03_r8,0.43872e+03_r8,0.51377e+03_r8,0.39635e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,21, 4) = (/ & + & 0.46853e+03_r8,0.43819e+03_r8,0.51350e+03_r8,0.39619e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,21, 4) = (/ & + & 0.46792e+03_r8,0.43773e+03_r8,0.51323e+03_r8,0.39604e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,21, 4) = (/ & + & 0.46739e+03_r8,0.43733e+03_r8,0.51296e+03_r8,0.39592e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,21, 4) = (/ & + & 0.46692e+03_r8,0.43697e+03_r8,0.51263e+03_r8,0.39581e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,22, 4) = (/ & + & 0.46731e+03_r8,0.43727e+03_r8,0.51254e+03_r8,0.39590e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,22, 4) = (/ & + & 0.46675e+03_r8,0.43685e+03_r8,0.51231e+03_r8,0.39577e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,22, 4) = (/ & + & 0.46626e+03_r8,0.43648e+03_r8,0.51212e+03_r8,0.39566e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,22, 4) = (/ & + & 0.46584e+03_r8,0.43616e+03_r8,0.51190e+03_r8,0.39556e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,22, 4) = (/ & + & 0.46546e+03_r8,0.43588e+03_r8,0.51168e+03_r8,0.39548e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,23, 4) = (/ & + & 0.46575e+03_r8,0.43610e+03_r8,0.51153e+03_r8,0.39554e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,23, 4) = (/ & + & 0.46531e+03_r8,0.43577e+03_r8,0.51138e+03_r8,0.39544e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,23, 4) = (/ & + & 0.46492e+03_r8,0.43548e+03_r8,0.51122e+03_r8,0.39535e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,23, 4) = (/ & + & 0.46458e+03_r8,0.43522e+03_r8,0.51104e+03_r8,0.39527e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,23, 4) = (/ & + & 0.46427e+03_r8,0.43499e+03_r8,0.51086e+03_r8,0.39520e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,24, 4) = (/ & + & 0.46450e+03_r8,0.43516e+03_r8,0.51071e+03_r8,0.39525e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,24, 4) = (/ & + & 0.46414e+03_r8,0.43489e+03_r8,0.51060e+03_r8,0.39517e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,24, 4) = (/ & + & 0.46383e+03_r8,0.43466e+03_r8,0.51047e+03_r8,0.39510e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,24, 4) = (/ & + & 0.46356e+03_r8,0.43445e+03_r8,0.51033e+03_r8,0.39504e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,24, 4) = (/ & + & 0.46331e+03_r8,0.43427e+03_r8,0.51019e+03_r8,0.39498e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,25, 4) = (/ & + & 0.46348e+03_r8,0.43439e+03_r8,0.51003e+03_r8,0.39502e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,25, 4) = (/ & + & 0.46319e+03_r8,0.43418e+03_r8,0.50997e+03_r8,0.39496e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,25, 4) = (/ & + & 0.46295e+03_r8,0.43400e+03_r8,0.50987e+03_r8,0.39490e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,25, 4) = (/ & + & 0.46273e+03_r8,0.43383e+03_r8,0.50976e+03_r8,0.39485e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,25, 4) = (/ & + & 0.46254e+03_r8,0.43369e+03_r8,0.50965e+03_r8,0.39480e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,26, 4) = (/ & + & 0.46265e+03_r8,0.43378e+03_r8,0.50951e+03_r8,0.39483e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,26, 4) = (/ & + & 0.46243e+03_r8,0.43361e+03_r8,0.50946e+03_r8,0.39478e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,26, 4) = (/ & + & 0.46223e+03_r8,0.43346e+03_r8,0.50938e+03_r8,0.39473e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,26, 4) = (/ & + & 0.46206e+03_r8,0.43333e+03_r8,0.50930e+03_r8,0.39469e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,26, 4) = (/ & + & 0.46190e+03_r8,0.43321e+03_r8,0.50921e+03_r8,0.39466e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,27, 4) = (/ & + & 0.46199e+03_r8,0.43328e+03_r8,0.50908e+03_r8,0.39468e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,27, 4) = (/ & + & 0.46181e+03_r8,0.43314e+03_r8,0.50904e+03_r8,0.39464e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,27, 4) = (/ & + & 0.46165e+03_r8,0.43303e+03_r8,0.50899e+03_r8,0.39460e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,27, 4) = (/ & + & 0.46152e+03_r8,0.43292e+03_r8,0.50892e+03_r8,0.39457e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,27, 4) = (/ & + & 0.46139e+03_r8,0.43283e+03_r8,0.50885e+03_r8,0.39454e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,28, 4) = (/ & + & 0.46145e+03_r8,0.43288e+03_r8,0.50873e+03_r8,0.39455e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,28, 4) = (/ & + & 0.46131e+03_r8,0.43277e+03_r8,0.50871e+03_r8,0.39452e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,28, 4) = (/ & + & 0.46119e+03_r8,0.43268e+03_r8,0.50867e+03_r8,0.39449e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,28, 4) = (/ & + & 0.46108e+03_r8,0.43259e+03_r8,0.50862e+03_r8,0.39447e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,28, 4) = (/ & + & 0.46098e+03_r8,0.43252e+03_r8,0.50856e+03_r8,0.39445e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,29, 4) = (/ & + & 0.46102e+03_r8,0.43255e+03_r8,0.50845e+03_r8,0.39445e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,29, 4) = (/ & + & 0.46091e+03_r8,0.43247e+03_r8,0.50844e+03_r8,0.39443e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,29, 4) = (/ & + & 0.46081e+03_r8,0.43239e+03_r8,0.50842e+03_r8,0.39441e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,29, 4) = (/ & + & 0.46072e+03_r8,0.43233e+03_r8,0.50837e+03_r8,0.39439e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,29, 4) = (/ & + & 0.46064e+03_r8,0.43227e+03_r8,0.50832e+03_r8,0.39437e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,30, 4) = (/ & + & 0.46067e+03_r8,0.43229e+03_r8,0.50823e+03_r8,0.39437e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,30, 4) = (/ & + & 0.46058e+03_r8,0.43223e+03_r8,0.50823e+03_r8,0.39435e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,30, 4) = (/ & + & 0.46051e+03_r8,0.43217e+03_r8,0.50821e+03_r8,0.39434e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,30, 4) = (/ & + & 0.46044e+03_r8,0.43211e+03_r8,0.50818e+03_r8,0.39432e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,30, 4) = (/ & + & 0.46037e+03_r8,0.43207e+03_r8,0.50813e+03_r8,0.39431e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,31, 4) = (/ & + & 0.46039e+03_r8,0.43208e+03_r8,0.50805e+03_r8,0.39431e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,31, 4) = (/ & + & 0.46032e+03_r8,0.43203e+03_r8,0.50805e+03_r8,0.39429e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,31, 4) = (/ & + & 0.46026e+03_r8,0.43198e+03_r8,0.50804e+03_r8,0.39428e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,31, 4) = (/ & + & 0.46021e+03_r8,0.43194e+03_r8,0.50801e+03_r8,0.39427e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,31, 4) = (/ & + & 0.46016e+03_r8,0.43190e+03_r8,0.50797e+03_r8,0.39426e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,32, 4) = (/ & + & 0.46017e+03_r8,0.43191e+03_r8,0.50790e+03_r8,0.39426e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,32, 4) = (/ & + & 0.46011e+03_r8,0.43187e+03_r8,0.50792e+03_r8,0.39425e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,32, 4) = (/ & + & 0.46006e+03_r8,0.43183e+03_r8,0.50791e+03_r8,0.39423e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,32, 4) = (/ & + & 0.46002e+03_r8,0.43180e+03_r8,0.50788e+03_r8,0.39422e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,32, 4) = (/ & + & 0.45998e+03_r8,0.43177e+03_r8,0.50784e+03_r8,0.39421e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,33, 4) = (/ & + & 0.45999e+03_r8,0.43178e+03_r8,0.50779e+03_r8,0.39422e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,33, 4) = (/ & + & 0.45994e+03_r8,0.43174e+03_r8,0.50781e+03_r8,0.39421e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,33, 4) = (/ & + & 0.45990e+03_r8,0.43171e+03_r8,0.50780e+03_r8,0.39420e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,33, 4) = (/ & + & 0.45987e+03_r8,0.43169e+03_r8,0.50777e+03_r8,0.39419e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,33, 4) = (/ & + & 0.45984e+03_r8,0.43166e+03_r8,0.50773e+03_r8,0.39418e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,34, 4) = (/ & + & 0.45984e+03_r8,0.43167e+03_r8,0.50770e+03_r8,0.39418e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,34, 4) = (/ & + & 0.45981e+03_r8,0.43164e+03_r8,0.50772e+03_r8,0.39418e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,34, 4) = (/ & + & 0.45978e+03_r8,0.43162e+03_r8,0.50771e+03_r8,0.39417e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,34, 4) = (/ & + & 0.45975e+03_r8,0.43160e+03_r8,0.50768e+03_r8,0.39416e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,34, 4) = (/ & + & 0.45972e+03_r8,0.43158e+03_r8,0.50764e+03_r8,0.39416e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,35, 4) = (/ & + & 0.45973e+03_r8,0.43158e+03_r8,0.50763e+03_r8,0.39416e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,35, 4) = (/ & + & 0.45970e+03_r8,0.43156e+03_r8,0.50764e+03_r8,0.39415e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,35, 4) = (/ & + & 0.45968e+03_r8,0.43154e+03_r8,0.50764e+03_r8,0.39414e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,35, 4) = (/ & + & 0.45965e+03_r8,0.43153e+03_r8,0.50761e+03_r8,0.39414e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,35, 4) = (/ & + & 0.45963e+03_r8,0.43151e+03_r8,0.50757e+03_r8,0.39413e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,36, 4) = (/ & + & 0.45964e+03_r8,0.43152e+03_r8,0.50757e+03_r8,0.39414e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,36, 4) = (/ & + & 0.45962e+03_r8,0.43150e+03_r8,0.50758e+03_r8,0.39413e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,36, 4) = (/ & + & 0.45960e+03_r8,0.43148e+03_r8,0.50758e+03_r8,0.39413e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,36, 4) = (/ & + & 0.45958e+03_r8,0.43147e+03_r8,0.50756e+03_r8,0.39412e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,36, 4) = (/ & + & 0.45956e+03_r8,0.43146e+03_r8,0.50752e+03_r8,0.39412e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,37, 4) = (/ & + & 0.45957e+03_r8,0.43146e+03_r8,0.50751e+03_r8,0.39412e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,37, 4) = (/ & + & 0.45955e+03_r8,0.43145e+03_r8,0.50753e+03_r8,0.39412e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,37, 4) = (/ & + & 0.45953e+03_r8,0.43144e+03_r8,0.50754e+03_r8,0.39411e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,37, 4) = (/ & + & 0.45952e+03_r8,0.43142e+03_r8,0.50752e+03_r8,0.39411e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,37, 4) = (/ & + & 0.45950e+03_r8,0.43141e+03_r8,0.50748e+03_r8,0.39411e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,38, 4) = (/ & + & 0.45951e+03_r8,0.43142e+03_r8,0.50746e+03_r8,0.39411e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,38, 4) = (/ & + & 0.45950e+03_r8,0.43141e+03_r8,0.50749e+03_r8,0.39410e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,38, 4) = (/ & + & 0.45948e+03_r8,0.43140e+03_r8,0.50750e+03_r8,0.39410e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,38, 4) = (/ & + & 0.45947e+03_r8,0.43139e+03_r8,0.50749e+03_r8,0.39410e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,38, 4) = (/ & + & 0.45946e+03_r8,0.43138e+03_r8,0.50745e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,39, 4) = (/ & + & 0.45946e+03_r8,0.43138e+03_r8,0.50742e+03_r8,0.39410e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,39, 4) = (/ & + & 0.45945e+03_r8,0.43137e+03_r8,0.50746e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,39, 4) = (/ & + & 0.45944e+03_r8,0.43137e+03_r8,0.50747e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,39, 4) = (/ & + & 0.45943e+03_r8,0.43136e+03_r8,0.50746e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,39, 4) = (/ & + & 0.45942e+03_r8,0.43135e+03_r8,0.50743e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,40, 4) = (/ & + & 0.45943e+03_r8,0.43136e+03_r8,0.50738e+03_r8,0.39409e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,40, 4) = (/ & + & 0.45941e+03_r8,0.43135e+03_r8,0.50742e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,40, 4) = (/ & + & 0.45940e+03_r8,0.43134e+03_r8,0.50744e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,40, 4) = (/ & + & 0.45940e+03_r8,0.43133e+03_r8,0.50744e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,40, 4) = (/ & + & 0.45939e+03_r8,0.43133e+03_r8,0.50742e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,41, 4) = (/ & + & 0.45939e+03_r8,0.43133e+03_r8,0.50734e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,41, 4) = (/ & + & 0.45938e+03_r8,0.43133e+03_r8,0.50739e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,41, 4) = (/ & + & 0.45938e+03_r8,0.43132e+03_r8,0.50742e+03_r8,0.39408e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,41, 4) = (/ & + & 0.45937e+03_r8,0.43131e+03_r8,0.50742e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,41, 4) = (/ & + & 0.45936e+03_r8,0.43131e+03_r8,0.50741e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,42, 4) = (/ & + & 0.45937e+03_r8,0.43131e+03_r8,0.50731e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,42, 4) = (/ & + & 0.45936e+03_r8,0.43131e+03_r8,0.50736e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,42, 4) = (/ & + & 0.45935e+03_r8,0.43130e+03_r8,0.50739e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,42, 4) = (/ & + & 0.45935e+03_r8,0.43130e+03_r8,0.50741e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,42, 4) = (/ & + & 0.45934e+03_r8,0.43129e+03_r8,0.50740e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,43, 4) = (/ & + & 0.45935e+03_r8,0.43130e+03_r8,0.50727e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,43, 4) = (/ & + & 0.45934e+03_r8,0.43129e+03_r8,0.50733e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,43, 4) = (/ & + & 0.45933e+03_r8,0.43129e+03_r8,0.50737e+03_r8,0.39407e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,43, 4) = (/ & + & 0.45933e+03_r8,0.43128e+03_r8,0.50739e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,43, 4) = (/ & + & 0.45932e+03_r8,0.43128e+03_r8,0.50739e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,44, 4) = (/ & + & 0.45933e+03_r8,0.43128e+03_r8,0.50723e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,44, 4) = (/ & + & 0.45932e+03_r8,0.43128e+03_r8,0.50730e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,44, 4) = (/ & + & 0.45932e+03_r8,0.43128e+03_r8,0.50735e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,44, 4) = (/ & + & 0.45931e+03_r8,0.43127e+03_r8,0.50737e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,44, 4) = (/ & + & 0.45931e+03_r8,0.43127e+03_r8,0.50738e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,45, 4) = (/ & + & 0.45931e+03_r8,0.43127e+03_r8,0.50718e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,45, 4) = (/ & + & 0.45931e+03_r8,0.43127e+03_r8,0.50727e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,45, 4) = (/ & + & 0.45930e+03_r8,0.43127e+03_r8,0.50732e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,45, 4) = (/ & + & 0.45930e+03_r8,0.43126e+03_r8,0.50736e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,45, 4) = (/ & + & 0.45930e+03_r8,0.43126e+03_r8,0.50737e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,46, 4) = (/ & + & 0.45930e+03_r8,0.43126e+03_r8,0.50714e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,46, 4) = (/ & + & 0.45930e+03_r8,0.43126e+03_r8,0.50723e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,46, 4) = (/ & + & 0.45929e+03_r8,0.43126e+03_r8,0.50730e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,46, 4) = (/ & + & 0.45929e+03_r8,0.43125e+03_r8,0.50734e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,46, 4) = (/ & + & 0.45929e+03_r8,0.43125e+03_r8,0.50736e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,47, 4) = (/ & + & 0.45929e+03_r8,0.43126e+03_r8,0.50708e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,47, 4) = (/ & + & 0.45929e+03_r8,0.43125e+03_r8,0.50719e+03_r8,0.39406e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,47, 4) = (/ & + & 0.45928e+03_r8,0.43125e+03_r8,0.50727e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,47, 4) = (/ & + & 0.45928e+03_r8,0.43125e+03_r8,0.50732e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,47, 4) = (/ & + & 0.45928e+03_r8,0.43125e+03_r8,0.50735e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,48, 4) = (/ & + & 0.45928e+03_r8,0.43125e+03_r8,0.50701e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,48, 4) = (/ & + & 0.45928e+03_r8,0.43125e+03_r8,0.50714e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,48, 4) = (/ & + & 0.45928e+03_r8,0.43124e+03_r8,0.50723e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,48, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50729e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,48, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50733e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,49, 4) = (/ & + & 0.45928e+03_r8,0.43124e+03_r8,0.50694e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,49, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50709e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,49, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50720e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,49, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50727e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,49, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50732e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,50, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50686e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,50, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50704e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,50, 4) = (/ & + & 0.45927e+03_r8,0.43124e+03_r8,0.50716e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,50, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50724e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,50, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50730e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,51, 4) = (/ & + & 0.45926e+03_r8,0.43124e+03_r8,0.50679e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,51, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50697e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,51, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50711e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,51, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50721e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,51, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50728e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,52, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50671e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,52, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50691e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,52, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50707e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,52, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50718e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,52, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50725e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,53, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50663e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,53, 4) = (/ & + & 0.45926e+03_r8,0.43123e+03_r8,0.50684e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,53, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50701e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,53, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50714e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,53, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50722e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,54, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50655e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,54, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50677e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,54, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50696e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,54, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50710e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,54, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50720e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,55, 4) = (/ & + & 0.45925e+03_r8,0.43123e+03_r8,0.50647e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,55, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50670e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,55, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50690e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,55, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50706e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,55, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50717e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,56, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50640e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,56, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50663e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,56, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50683e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,56, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50701e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,56, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50714e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,57, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50632e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,57, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50656e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,57, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50677e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,57, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50696e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,57, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50710e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,58, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50624e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,58, 4) = (/ & + & 0.45925e+03_r8,0.43122e+03_r8,0.50648e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,58, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50671e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,58, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50690e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,58, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50706e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,59, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50622e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 2,59, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50645e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 3,59, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50668e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 4,59, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50688e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 5,59, 4) = (/ & + & 0.45924e+03_r8,0.43122e+03_r8,0.50704e+03_r8,0.39405e+03_r8,0.38437e+03_r8 /) + kbo(:, 1,13, 5) = (/ & + & 0.78037e+03_r8,0.62743e+03_r8,0.56495e+03_r8,0.56633e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,13, 5) = (/ & + & 0.77434e+03_r8,0.62291e+03_r8,0.56343e+03_r8,0.56584e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,13, 5) = (/ & + & 0.76915e+03_r8,0.61902e+03_r8,0.56189e+03_r8,0.56542e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,13, 5) = (/ & + & 0.76464e+03_r8,0.61563e+03_r8,0.56027e+03_r8,0.56506e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,13, 5) = (/ & + & 0.76068e+03_r8,0.61266e+03_r8,0.55865e+03_r8,0.56474e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,14, 5) = (/ & + & 0.76527e+03_r8,0.61611e+03_r8,0.56011e+03_r8,0.56511e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,14, 5) = (/ & + & 0.76041e+03_r8,0.61246e+03_r8,0.55859e+03_r8,0.56472e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,14, 5) = (/ & + & 0.75622e+03_r8,0.60932e+03_r8,0.55696e+03_r8,0.56438e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,14, 5) = (/ & + & 0.75257e+03_r8,0.60658e+03_r8,0.55539e+03_r8,0.56408e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,14, 5) = (/ & + & 0.74936e+03_r8,0.60417e+03_r8,0.55391e+03_r8,0.56383e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,15, 5) = (/ & + & 0.75296e+03_r8,0.60688e+03_r8,0.55521e+03_r8,0.56412e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,15, 5) = (/ & + & 0.74904e+03_r8,0.60394e+03_r8,0.55372e+03_r8,0.56380e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,15, 5) = (/ & + & 0.74566e+03_r8,0.60140e+03_r8,0.55235e+03_r8,0.56353e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,15, 5) = (/ & + & 0.74271e+03_r8,0.59919e+03_r8,0.55103e+03_r8,0.56329e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,15, 5) = (/ & + & 0.74012e+03_r8,0.59724e+03_r8,0.54977e+03_r8,0.56308e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,16, 5) = (/ & + & 0.74295e+03_r8,0.59937e+03_r8,0.55079e+03_r8,0.56331e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,16, 5) = (/ & + & 0.73979e+03_r8,0.59700e+03_r8,0.54953e+03_r8,0.56305e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,16, 5) = (/ & + & 0.73707e+03_r8,0.59495e+03_r8,0.54828e+03_r8,0.56283e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,16, 5) = (/ & + & 0.73469e+03_r8,0.59317e+03_r8,0.54708e+03_r8,0.56264e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,16, 5) = (/ & + & 0.73259e+03_r8,0.59160e+03_r8,0.54600e+03_r8,0.56247e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,17, 5) = (/ & + & 0.73483e+03_r8,0.59328e+03_r8,0.54695e+03_r8,0.56265e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,17, 5) = (/ & + & 0.73229e+03_r8,0.59137e+03_r8,0.54572e+03_r8,0.56245e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,17, 5) = (/ & + & 0.73009e+03_r8,0.58972e+03_r8,0.54462e+03_r8,0.56227e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,17, 5) = (/ & + & 0.72817e+03_r8,0.58828e+03_r8,0.54366e+03_r8,0.56212e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,17, 5) = (/ & + & 0.72647e+03_r8,0.58701e+03_r8,0.54281e+03_r8,0.56198e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,18, 5) = (/ & + & 0.72825e+03_r8,0.58834e+03_r8,0.54354e+03_r8,0.56212e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,18, 5) = (/ & + & 0.72619e+03_r8,0.58680e+03_r8,0.54253e+03_r8,0.56196e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,18, 5) = (/ & + & 0.72442e+03_r8,0.58547e+03_r8,0.54166e+03_r8,0.56181e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,18, 5) = (/ & + & 0.72286e+03_r8,0.58430e+03_r8,0.54091e+03_r8,0.56169e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,18, 5) = (/ & + & 0.72150e+03_r8,0.58328e+03_r8,0.54024e+03_r8,0.56158e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,19, 5) = (/ & + & 0.72290e+03_r8,0.58433e+03_r8,0.54075e+03_r8,0.56169e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,19, 5) = (/ & + & 0.72124e+03_r8,0.58309e+03_r8,0.53996e+03_r8,0.56156e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,19, 5) = (/ & + & 0.71981e+03_r8,0.58201e+03_r8,0.53928e+03_r8,0.56144e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,19, 5) = (/ & + & 0.71856e+03_r8,0.58107e+03_r8,0.53868e+03_r8,0.56134e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,19, 5) = (/ & + & 0.71745e+03_r8,0.58024e+03_r8,0.53816e+03_r8,0.56125e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,20, 5) = (/ & + & 0.71853e+03_r8,0.58105e+03_r8,0.53849e+03_r8,0.56134e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,20, 5) = (/ & + & 0.71720e+03_r8,0.58006e+03_r8,0.53788e+03_r8,0.56123e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,20, 5) = (/ & + & 0.71605e+03_r8,0.57919e+03_r8,0.53734e+03_r8,0.56114e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,20, 5) = (/ & + & 0.71504e+03_r8,0.57843e+03_r8,0.53687e+03_r8,0.56106e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,20, 5) = (/ & + & 0.71414e+03_r8,0.57776e+03_r8,0.53643e+03_r8,0.56098e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,21, 5) = (/ & + & 0.71499e+03_r8,0.57840e+03_r8,0.53667e+03_r8,0.56105e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,21, 5) = (/ & + & 0.71392e+03_r8,0.57759e+03_r8,0.53620e+03_r8,0.56097e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,21, 5) = (/ & + & 0.71299e+03_r8,0.57690e+03_r8,0.53578e+03_r8,0.56089e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,21, 5) = (/ & + & 0.71217e+03_r8,0.57628e+03_r8,0.53541e+03_r8,0.56083e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,21, 5) = (/ & + & 0.71145e+03_r8,0.57574e+03_r8,0.53506e+03_r8,0.56077e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,22, 5) = (/ & + & 0.71206e+03_r8,0.57620e+03_r8,0.53519e+03_r8,0.56082e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,22, 5) = (/ & + & 0.71120e+03_r8,0.57555e+03_r8,0.53482e+03_r8,0.56075e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,22, 5) = (/ & + & 0.71046e+03_r8,0.57500e+03_r8,0.53450e+03_r8,0.56069e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,22, 5) = (/ & + & 0.70981e+03_r8,0.57451e+03_r8,0.53420e+03_r8,0.56064e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,22, 5) = (/ & + & 0.70923e+03_r8,0.57408e+03_r8,0.53390e+03_r8,0.56059e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,23, 5) = (/ & + & 0.70968e+03_r8,0.57442e+03_r8,0.53396e+03_r8,0.56063e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,23, 5) = (/ & + & 0.70900e+03_r8,0.57391e+03_r8,0.53367e+03_r8,0.56057e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,23, 5) = (/ & + & 0.70841e+03_r8,0.57346e+03_r8,0.53341e+03_r8,0.56052e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,23, 5) = (/ & + & 0.70789e+03_r8,0.57307e+03_r8,0.53316e+03_r8,0.56048e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,23, 5) = (/ & + & 0.70743e+03_r8,0.57272e+03_r8,0.53290e+03_r8,0.56044e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,24, 5) = (/ & + & 0.70776e+03_r8,0.57298e+03_r8,0.53293e+03_r8,0.56047e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,24, 5) = (/ & + & 0.70722e+03_r8,0.57257e+03_r8,0.53269e+03_r8,0.56043e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,24, 5) = (/ & + & 0.70675e+03_r8,0.57222e+03_r8,0.53248e+03_r8,0.56039e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,24, 5) = (/ & + & 0.70633e+03_r8,0.57190e+03_r8,0.53228e+03_r8,0.56036e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,24, 5) = (/ & + & 0.70596e+03_r8,0.57163e+03_r8,0.53207e+03_r8,0.56033e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,25, 5) = (/ & + & 0.70621e+03_r8,0.57181e+03_r8,0.53206e+03_r8,0.56035e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,25, 5) = (/ & + & 0.70578e+03_r8,0.57149e+03_r8,0.53188e+03_r8,0.56031e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,25, 5) = (/ & + & 0.70541e+03_r8,0.57121e+03_r8,0.53172e+03_r8,0.56028e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,25, 5) = (/ & + & 0.70507e+03_r8,0.57096e+03_r8,0.53156e+03_r8,0.56025e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,25, 5) = (/ & + & 0.70478e+03_r8,0.57074e+03_r8,0.53138e+03_r8,0.56023e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,26, 5) = (/ & + & 0.70496e+03_r8,0.57087e+03_r8,0.53135e+03_r8,0.56024e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,26, 5) = (/ & + & 0.70461e+03_r8,0.57061e+03_r8,0.53122e+03_r8,0.56022e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,26, 5) = (/ & + & 0.70432e+03_r8,0.57039e+03_r8,0.53110e+03_r8,0.56019e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,26, 5) = (/ & + & 0.70405e+03_r8,0.57019e+03_r8,0.53097e+03_r8,0.56017e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,26, 5) = (/ & + & 0.70382e+03_r8,0.57001e+03_r8,0.53082e+03_r8,0.56015e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,27, 5) = (/ & + & 0.70394e+03_r8,0.57011e+03_r8,0.53077e+03_r8,0.56016e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,27, 5) = (/ & + & 0.70367e+03_r8,0.56991e+03_r8,0.53069e+03_r8,0.56014e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,27, 5) = (/ & + & 0.70343e+03_r8,0.56973e+03_r8,0.53060e+03_r8,0.56012e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,27, 5) = (/ & + & 0.70322e+03_r8,0.56957e+03_r8,0.53049e+03_r8,0.56010e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,27, 5) = (/ & + & 0.70304e+03_r8,0.56943e+03_r8,0.53036e+03_r8,0.56009e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,28, 5) = (/ & + & 0.70313e+03_r8,0.56950e+03_r8,0.53032e+03_r8,0.56010e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,28, 5) = (/ & + & 0.70291e+03_r8,0.56934e+03_r8,0.53026e+03_r8,0.56008e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,28, 5) = (/ & + & 0.70272e+03_r8,0.56920e+03_r8,0.53019e+03_r8,0.56006e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,28, 5) = (/ & + & 0.70256e+03_r8,0.56907e+03_r8,0.53010e+03_r8,0.56005e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,28, 5) = (/ & + & 0.70241e+03_r8,0.56896e+03_r8,0.52998e+03_r8,0.56004e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,29, 5) = (/ & + & 0.70247e+03_r8,0.56901e+03_r8,0.52995e+03_r8,0.56004e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,29, 5) = (/ & + & 0.70230e+03_r8,0.56888e+03_r8,0.52991e+03_r8,0.56003e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,29, 5) = (/ & + & 0.70215e+03_r8,0.56877e+03_r8,0.52985e+03_r8,0.56002e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,29, 5) = (/ & + & 0.70202e+03_r8,0.56867e+03_r8,0.52978e+03_r8,0.56001e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,29, 5) = (/ & + & 0.70190e+03_r8,0.56858e+03_r8,0.52967e+03_r8,0.56000e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,30, 5) = (/ & + & 0.70194e+03_r8,0.56861e+03_r8,0.52966e+03_r8,0.56000e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,30, 5) = (/ & + & 0.70181e+03_r8,0.56851e+03_r8,0.52963e+03_r8,0.55999e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,30, 5) = (/ & + & 0.70169e+03_r8,0.56842e+03_r8,0.52958e+03_r8,0.55998e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,30, 5) = (/ & + & 0.70158e+03_r8,0.56834e+03_r8,0.52951e+03_r8,0.55997e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,30, 5) = (/ & + & 0.70149e+03_r8,0.56827e+03_r8,0.52941e+03_r8,0.55996e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,31, 5) = (/ & + & 0.70151e+03_r8,0.56829e+03_r8,0.52942e+03_r8,0.55997e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,31, 5) = (/ & + & 0.70141e+03_r8,0.56821e+03_r8,0.52941e+03_r8,0.55996e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,31, 5) = (/ & + & 0.70131e+03_r8,0.56814e+03_r8,0.52936e+03_r8,0.55995e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,31, 5) = (/ & + & 0.70123e+03_r8,0.56807e+03_r8,0.52930e+03_r8,0.55994e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,31, 5) = (/ & + & 0.70115e+03_r8,0.56802e+03_r8,0.52920e+03_r8,0.55994e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,32, 5) = (/ & + & 0.70117e+03_r8,0.56803e+03_r8,0.52924e+03_r8,0.55994e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,32, 5) = (/ & + & 0.70109e+03_r8,0.56797e+03_r8,0.52922e+03_r8,0.55993e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,32, 5) = (/ & + & 0.70101e+03_r8,0.56791e+03_r8,0.52919e+03_r8,0.55993e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,32, 5) = (/ & + & 0.70094e+03_r8,0.56786e+03_r8,0.52912e+03_r8,0.55992e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,32, 5) = (/ & + & 0.70088e+03_r8,0.56782e+03_r8,0.52902e+03_r8,0.55992e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,33, 5) = (/ & + & 0.70090e+03_r8,0.56782e+03_r8,0.52908e+03_r8,0.55992e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,33, 5) = (/ & + & 0.70083e+03_r8,0.56777e+03_r8,0.52907e+03_r8,0.55991e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,33, 5) = (/ & + & 0.70077e+03_r8,0.56773e+03_r8,0.52904e+03_r8,0.55991e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,33, 5) = (/ & + & 0.70072e+03_r8,0.56769e+03_r8,0.52897e+03_r8,0.55990e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,33, 5) = (/ & + & 0.70067e+03_r8,0.56765e+03_r8,0.52887e+03_r8,0.55990e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,34, 5) = (/ & + & 0.70068e+03_r8,0.56766e+03_r8,0.52896e+03_r8,0.55990e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,34, 5) = (/ & + & 0.70062e+03_r8,0.56762e+03_r8,0.52895e+03_r8,0.55989e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,34, 5) = (/ & + & 0.70057e+03_r8,0.56758e+03_r8,0.52892e+03_r8,0.55989e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,34, 5) = (/ & + & 0.70053e+03_r8,0.56755e+03_r8,0.52885e+03_r8,0.55989e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,34, 5) = (/ & + & 0.70049e+03_r8,0.56752e+03_r8,0.52874e+03_r8,0.55988e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,35, 5) = (/ & + & 0.70050e+03_r8,0.56753e+03_r8,0.52886e+03_r8,0.55988e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,35, 5) = (/ & + & 0.70046e+03_r8,0.56750e+03_r8,0.52885e+03_r8,0.55988e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,35, 5) = (/ & + & 0.70042e+03_r8,0.56747e+03_r8,0.52883e+03_r8,0.55988e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,35, 5) = (/ & + & 0.70039e+03_r8,0.56744e+03_r8,0.52876e+03_r8,0.55988e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,35, 5) = (/ & + & 0.70035e+03_r8,0.56742e+03_r8,0.52864e+03_r8,0.55987e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,36, 5) = (/ & + & 0.70037e+03_r8,0.56743e+03_r8,0.52877e+03_r8,0.55987e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,36, 5) = (/ & + & 0.70033e+03_r8,0.56740e+03_r8,0.52878e+03_r8,0.55987e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,36, 5) = (/ & + & 0.70030e+03_r8,0.56738e+03_r8,0.52875e+03_r8,0.55987e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,36, 5) = (/ & + & 0.70027e+03_r8,0.56736e+03_r8,0.52869e+03_r8,0.55987e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,36, 5) = (/ & + & 0.70025e+03_r8,0.56734e+03_r8,0.52857e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,37, 5) = (/ & + & 0.70026e+03_r8,0.56735e+03_r8,0.52870e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,37, 5) = (/ & + & 0.70023e+03_r8,0.56733e+03_r8,0.52872e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,37, 5) = (/ & + & 0.70020e+03_r8,0.56731e+03_r8,0.52870e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,37, 5) = (/ & + & 0.70018e+03_r8,0.56729e+03_r8,0.52864e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,37, 5) = (/ & + & 0.70016e+03_r8,0.56727e+03_r8,0.52854e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,38, 5) = (/ & + & 0.70017e+03_r8,0.56728e+03_r8,0.52864e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,38, 5) = (/ & + & 0.70015e+03_r8,0.56726e+03_r8,0.52866e+03_r8,0.55986e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,38, 5) = (/ & + & 0.70012e+03_r8,0.56725e+03_r8,0.52866e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,38, 5) = (/ & + & 0.70010e+03_r8,0.56723e+03_r8,0.52860e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,38, 5) = (/ & + & 0.70009e+03_r8,0.56722e+03_r8,0.52852e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,39, 5) = (/ & + & 0.70010e+03_r8,0.56723e+03_r8,0.52860e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,39, 5) = (/ & + & 0.70008e+03_r8,0.56721e+03_r8,0.52862e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,39, 5) = (/ & + & 0.70006e+03_r8,0.56720e+03_r8,0.52861e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,39, 5) = (/ & + & 0.70004e+03_r8,0.56719e+03_r8,0.52858e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,39, 5) = (/ & + & 0.70003e+03_r8,0.56717e+03_r8,0.52850e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,40, 5) = (/ & + & 0.70004e+03_r8,0.56718e+03_r8,0.52855e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,40, 5) = (/ & + & 0.70002e+03_r8,0.56717e+03_r8,0.52858e+03_r8,0.55985e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,40, 5) = (/ & + & 0.70001e+03_r8,0.56716e+03_r8,0.52859e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,40, 5) = (/ & + & 0.69999e+03_r8,0.56715e+03_r8,0.52856e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,40, 5) = (/ & + & 0.69998e+03_r8,0.56714e+03_r8,0.52849e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,41, 5) = (/ & + & 0.69999e+03_r8,0.56715e+03_r8,0.52850e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,41, 5) = (/ & + & 0.69998e+03_r8,0.56714e+03_r8,0.52854e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,41, 5) = (/ & + & 0.69996e+03_r8,0.56713e+03_r8,0.52856e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,41, 5) = (/ & + & 0.69995e+03_r8,0.56712e+03_r8,0.52854e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,41, 5) = (/ & + & 0.69994e+03_r8,0.56711e+03_r8,0.52848e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,42, 5) = (/ & + & 0.69995e+03_r8,0.56712e+03_r8,0.52846e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,42, 5) = (/ & + & 0.69994e+03_r8,0.56711e+03_r8,0.52851e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,42, 5) = (/ & + & 0.69993e+03_r8,0.56710e+03_r8,0.52853e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,42, 5) = (/ & + & 0.69992e+03_r8,0.56709e+03_r8,0.52853e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,42, 5) = (/ & + & 0.69991e+03_r8,0.56709e+03_r8,0.52848e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,43, 5) = (/ & + & 0.69992e+03_r8,0.56709e+03_r8,0.52843e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,43, 5) = (/ & + & 0.69991e+03_r8,0.56708e+03_r8,0.52848e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,43, 5) = (/ & + & 0.69990e+03_r8,0.56708e+03_r8,0.52851e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,43, 5) = (/ & + & 0.69989e+03_r8,0.56707e+03_r8,0.52851e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,43, 5) = (/ & + & 0.69988e+03_r8,0.56707e+03_r8,0.52848e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,44, 5) = (/ & + & 0.69989e+03_r8,0.56707e+03_r8,0.52838e+03_r8,0.55984e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,44, 5) = (/ & + & 0.69988e+03_r8,0.56707e+03_r8,0.52844e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,44, 5) = (/ & + & 0.69988e+03_r8,0.56706e+03_r8,0.52848e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,44, 5) = (/ & + & 0.69987e+03_r8,0.56705e+03_r8,0.52850e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,44, 5) = (/ & + & 0.69986e+03_r8,0.56705e+03_r8,0.52849e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,45, 5) = (/ & + & 0.69987e+03_r8,0.56706e+03_r8,0.52834e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,45, 5) = (/ & + & 0.69986e+03_r8,0.56705e+03_r8,0.52841e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,45, 5) = (/ & + & 0.69986e+03_r8,0.56704e+03_r8,0.52846e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,45, 5) = (/ & + & 0.69985e+03_r8,0.56704e+03_r8,0.52848e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,45, 5) = (/ & + & 0.69984e+03_r8,0.56704e+03_r8,0.52848e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,46, 5) = (/ & + & 0.69985e+03_r8,0.56704e+03_r8,0.52830e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,46, 5) = (/ & + & 0.69984e+03_r8,0.56704e+03_r8,0.52837e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,46, 5) = (/ & + & 0.69984e+03_r8,0.56703e+03_r8,0.52843e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,46, 5) = (/ & + & 0.69983e+03_r8,0.56703e+03_r8,0.52847e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,46, 5) = (/ & + & 0.69983e+03_r8,0.56703e+03_r8,0.52848e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,47, 5) = (/ & + & 0.69984e+03_r8,0.56703e+03_r8,0.52826e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,47, 5) = (/ & + & 0.69983e+03_r8,0.56703e+03_r8,0.52834e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,47, 5) = (/ & + & 0.69982e+03_r8,0.56702e+03_r8,0.52840e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,47, 5) = (/ & + & 0.69982e+03_r8,0.56702e+03_r8,0.52845e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,47, 5) = (/ & + & 0.69982e+03_r8,0.56702e+03_r8,0.52847e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,48, 5) = (/ & + & 0.69982e+03_r8,0.56702e+03_r8,0.52821e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,48, 5) = (/ & + & 0.69982e+03_r8,0.56702e+03_r8,0.52830e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,48, 5) = (/ & + & 0.69981e+03_r8,0.56701e+03_r8,0.52837e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,48, 5) = (/ & + & 0.69981e+03_r8,0.56701e+03_r8,0.52842e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,48, 5) = (/ & + & 0.69981e+03_r8,0.56701e+03_r8,0.52845e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,49, 5) = (/ & + & 0.69981e+03_r8,0.56701e+03_r8,0.52817e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,49, 5) = (/ & + & 0.69981e+03_r8,0.56701e+03_r8,0.52825e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,49, 5) = (/ & + & 0.69980e+03_r8,0.56701e+03_r8,0.52833e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,49, 5) = (/ & + & 0.69980e+03_r8,0.56700e+03_r8,0.52840e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,49, 5) = (/ & + & 0.69980e+03_r8,0.56700e+03_r8,0.52844e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,50, 5) = (/ & + & 0.69980e+03_r8,0.56701e+03_r8,0.52812e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,50, 5) = (/ & + & 0.69980e+03_r8,0.56700e+03_r8,0.52821e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,50, 5) = (/ & + & 0.69980e+03_r8,0.56700e+03_r8,0.52830e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,50, 5) = (/ & + & 0.69979e+03_r8,0.56700e+03_r8,0.52837e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,50, 5) = (/ & + & 0.69979e+03_r8,0.56700e+03_r8,0.52842e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,51, 5) = (/ & + & 0.69979e+03_r8,0.56700e+03_r8,0.52807e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,51, 5) = (/ & + & 0.69979e+03_r8,0.56700e+03_r8,0.52818e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,51, 5) = (/ & + & 0.69979e+03_r8,0.56699e+03_r8,0.52827e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,51, 5) = (/ & + & 0.69979e+03_r8,0.56699e+03_r8,0.52834e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,51, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52841e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,52, 5) = (/ & + & 0.69979e+03_r8,0.56699e+03_r8,0.52802e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,52, 5) = (/ & + & 0.69979e+03_r8,0.56699e+03_r8,0.52814e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,52, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52823e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,52, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52831e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,52, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52838e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,53, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52798e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,53, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52809e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,53, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52820e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,53, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52828e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,53, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52836e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,54, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52794e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,54, 5) = (/ & + & 0.69978e+03_r8,0.56699e+03_r8,0.52804e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,54, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52816e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,54, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52825e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,54, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52833e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,55, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52790e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,55, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52801e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,55, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52812e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,55, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52822e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,55, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52830e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,56, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52786e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,56, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52797e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,56, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52808e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,56, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52819e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,56, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52827e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,57, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52781e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,57, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52794e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,57, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52805e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,57, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52815e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,57, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52825e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,58, 5) = (/ & + & 0.69977e+03_r8,0.56698e+03_r8,0.52777e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,58, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52790e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,58, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52801e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,58, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52812e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,58, 5) = (/ & + & 0.69976e+03_r8,0.56697e+03_r8,0.52822e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,59, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52775e+03_r8,0.55983e+03_r8,0.67117e+03_r8 /) + kbo(:, 2,59, 5) = (/ & + & 0.69976e+03_r8,0.56698e+03_r8,0.52788e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 3,59, 5) = (/ & + & 0.69976e+03_r8,0.56697e+03_r8,0.52801e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 4,59, 5) = (/ & + & 0.69976e+03_r8,0.56697e+03_r8,0.52811e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 5,59, 5) = (/ & + & 0.69976e+03_r8,0.56697e+03_r8,0.52821e+03_r8,0.55982e+03_r8,0.67117e+03_r8 /) + kbo(:, 1,13, 6) = (/ & + & 0.99182e+03_r8,0.76479e+03_r8,0.58123e+03_r8,0.73928e+03_r8,0.94808e+03_r8 /) + kbo(:, 2,13, 6) = (/ & + & 0.98417e+03_r8,0.75904e+03_r8,0.57888e+03_r8,0.73991e+03_r8,0.94920e+03_r8 /) + kbo(:, 3,13, 6) = (/ & + & 0.97757e+03_r8,0.75410e+03_r8,0.57650e+03_r8,0.74029e+03_r8,0.94995e+03_r8 /) + kbo(:, 4,13, 6) = (/ & + & 0.97184e+03_r8,0.74980e+03_r8,0.57428e+03_r8,0.74046e+03_r8,0.95033e+03_r8 /) + kbo(:, 5,13, 6) = (/ & + & 0.96680e+03_r8,0.74602e+03_r8,0.57217e+03_r8,0.74043e+03_r8,0.95033e+03_r8 /) + kbo(:, 1,14, 6) = (/ & + & 0.97264e+03_r8,0.75040e+03_r8,0.57482e+03_r8,0.73884e+03_r8,0.94820e+03_r8 /) + kbo(:, 2,14, 6) = (/ & + & 0.96646e+03_r8,0.74576e+03_r8,0.57229e+03_r8,0.73949e+03_r8,0.94928e+03_r8 /) + kbo(:, 3,14, 6) = (/ & + & 0.96113e+03_r8,0.74177e+03_r8,0.57016e+03_r8,0.73988e+03_r8,0.95000e+03_r8 /) + kbo(:, 4,14, 6) = (/ & + & 0.95649e+03_r8,0.73829e+03_r8,0.56822e+03_r8,0.74006e+03_r8,0.95035e+03_r8 /) + kbo(:, 5,14, 6) = (/ & + & 0.95242e+03_r8,0.73523e+03_r8,0.56635e+03_r8,0.74003e+03_r8,0.95032e+03_r8 /) + kbo(:, 1,15, 6) = (/ & + & 0.95700e+03_r8,0.73867e+03_r8,0.56844e+03_r8,0.73851e+03_r8,0.94832e+03_r8 /) + kbo(:, 2,15, 6) = (/ & + & 0.95201e+03_r8,0.73493e+03_r8,0.56632e+03_r8,0.73916e+03_r8,0.94937e+03_r8 /) + kbo(:, 3,15, 6) = (/ & + & 0.94772e+03_r8,0.73170e+03_r8,0.56426e+03_r8,0.73956e+03_r8,0.95005e+03_r8 /) + kbo(:, 4,15, 6) = (/ & + & 0.94397e+03_r8,0.72889e+03_r8,0.56242e+03_r8,0.73973e+03_r8,0.95035e+03_r8 /) + kbo(:, 5,15, 6) = (/ & + & 0.94067e+03_r8,0.72642e+03_r8,0.56076e+03_r8,0.73970e+03_r8,0.95029e+03_r8 /) + kbo(:, 1,16, 6) = (/ & + & 0.94427e+03_r8,0.72912e+03_r8,0.56257e+03_r8,0.73826e+03_r8,0.94846e+03_r8 /) + kbo(:, 2,16, 6) = (/ & + & 0.94026e+03_r8,0.72611e+03_r8,0.56064e+03_r8,0.73891e+03_r8,0.94946e+03_r8 /) + kbo(:, 3,16, 6) = (/ & + & 0.93679e+03_r8,0.72351e+03_r8,0.55906e+03_r8,0.73929e+03_r8,0.95011e+03_r8 /) + kbo(:, 4,16, 6) = (/ & + & 0.93377e+03_r8,0.72124e+03_r8,0.55770e+03_r8,0.73948e+03_r8,0.95036e+03_r8 /) + kbo(:, 5,16, 6) = (/ & + & 0.93110e+03_r8,0.71925e+03_r8,0.55641e+03_r8,0.73943e+03_r8,0.95027e+03_r8 /) + kbo(:, 1,17, 6) = (/ & + & 0.93395e+03_r8,0.72138e+03_r8,0.55755e+03_r8,0.73807e+03_r8,0.94857e+03_r8 /) + kbo(:, 2,17, 6) = (/ & + & 0.93072e+03_r8,0.71896e+03_r8,0.55622e+03_r8,0.73871e+03_r8,0.94955e+03_r8 /) + kbo(:, 3,17, 6) = (/ & + & 0.92792e+03_r8,0.71686e+03_r8,0.55497e+03_r8,0.73909e+03_r8,0.95015e+03_r8 /) + kbo(:, 4,17, 6) = (/ & + & 0.92548e+03_r8,0.71503e+03_r8,0.55372e+03_r8,0.73925e+03_r8,0.95038e+03_r8 /) + kbo(:, 5,17, 6) = (/ & + & 0.92333e+03_r8,0.71341e+03_r8,0.55252e+03_r8,0.73921e+03_r8,0.95024e+03_r8 /) + kbo(:, 1,18, 6) = (/ & + & 0.92558e+03_r8,0.71510e+03_r8,0.55360e+03_r8,0.73792e+03_r8,0.94869e+03_r8 /) + kbo(:, 2,18, 6) = (/ & + & 0.92297e+03_r8,0.71315e+03_r8,0.55237e+03_r8,0.73856e+03_r8,0.94963e+03_r8 /) + kbo(:, 3,18, 6) = (/ & + & 0.92072e+03_r8,0.71146e+03_r8,0.55114e+03_r8,0.73892e+03_r8,0.95019e+03_r8 /) + kbo(:, 4,18, 6) = (/ & + & 0.91874e+03_r8,0.70998e+03_r8,0.55001e+03_r8,0.73908e+03_r8,0.95037e+03_r8 /) + kbo(:, 5,18, 6) = (/ & + & 0.91700e+03_r8,0.70867e+03_r8,0.54903e+03_r8,0.73903e+03_r8,0.95021e+03_r8 /) + kbo(:, 1,19, 6) = (/ & + & 0.91879e+03_r8,0.71001e+03_r8,0.55004e+03_r8,0.73782e+03_r8,0.94880e+03_r8 /) + kbo(:, 2,19, 6) = (/ & + & 0.91668e+03_r8,0.70843e+03_r8,0.54889e+03_r8,0.73844e+03_r8,0.94970e+03_r8 /) + kbo(:, 3,19, 6) = (/ & + & 0.91486e+03_r8,0.70706e+03_r8,0.54830e+03_r8,0.73880e+03_r8,0.95023e+03_r8 /) + kbo(:, 4,19, 6) = (/ & + & 0.91327e+03_r8,0.70587e+03_r8,0.54705e+03_r8,0.73894e+03_r8,0.95037e+03_r8 /) + kbo(:, 5,19, 6) = (/ & + & 0.91186e+03_r8,0.70481e+03_r8,0.54615e+03_r8,0.73887e+03_r8,0.95019e+03_r8 /) + kbo(:, 1,20, 6) = (/ & + & 0.91324e+03_r8,0.70585e+03_r8,0.54718e+03_r8,0.73776e+03_r8,0.94893e+03_r8 /) + kbo(:, 2,20, 6) = (/ & + & 0.91155e+03_r8,0.70458e+03_r8,0.54599e+03_r8,0.73835e+03_r8,0.94979e+03_r8 /) + kbo(:, 3,20, 6) = (/ & + & 0.91008e+03_r8,0.70348e+03_r8,0.54519e+03_r8,0.73870e+03_r8,0.95026e+03_r8 /) + kbo(:, 4,20, 6) = (/ & + & 0.90879e+03_r8,0.70251e+03_r8,0.54450e+03_r8,0.73882e+03_r8,0.95036e+03_r8 /) + kbo(:, 5,20, 6) = (/ & + & 0.90766e+03_r8,0.70166e+03_r8,0.54390e+03_r8,0.73874e+03_r8,0.95013e+03_r8 /) + kbo(:, 1,21, 6) = (/ & + & 0.90874e+03_r8,0.70247e+03_r8,0.54444e+03_r8,0.73773e+03_r8,0.94905e+03_r8 /) + kbo(:, 2,21, 6) = (/ & + & 0.90737e+03_r8,0.70145e+03_r8,0.54370e+03_r8,0.73831e+03_r8,0.94986e+03_r8 /) + kbo(:, 3,21, 6) = (/ & + & 0.90619e+03_r8,0.70056e+03_r8,0.54308e+03_r8,0.73862e+03_r8,0.95029e+03_r8 /) + kbo(:, 4,21, 6) = (/ & + & 0.90515e+03_r8,0.69978e+03_r8,0.54255e+03_r8,0.73872e+03_r8,0.95035e+03_r8 /) + kbo(:, 5,21, 6) = (/ & + & 0.90424e+03_r8,0.69910e+03_r8,0.54208e+03_r8,0.73862e+03_r8,0.95008e+03_r8 /) + kbo(:, 1,22, 6) = (/ & + & 0.90500e+03_r8,0.69967e+03_r8,0.54240e+03_r8,0.73776e+03_r8,0.94923e+03_r8 /) + kbo(:, 2,22, 6) = (/ & + & 0.90392e+03_r8,0.69886e+03_r8,0.54185e+03_r8,0.73829e+03_r8,0.94997e+03_r8 /) + kbo(:, 3,22, 6) = (/ & + & 0.90297e+03_r8,0.69815e+03_r8,0.54138e+03_r8,0.73857e+03_r8,0.95033e+03_r8 /) + kbo(:, 4,22, 6) = (/ & + & 0.90215e+03_r8,0.69753e+03_r8,0.54099e+03_r8,0.73864e+03_r8,0.95033e+03_r8 /) + kbo(:, 5,22, 6) = (/ & + & 0.90141e+03_r8,0.69698e+03_r8,0.54066e+03_r8,0.73851e+03_r8,0.94999e+03_r8 /) + kbo(:, 1,23, 6) = (/ & + & 0.90199e+03_r8,0.69741e+03_r8,0.54083e+03_r8,0.73780e+03_r8,0.94940e+03_r8 /) + kbo(:, 2,23, 6) = (/ & + & 0.90112e+03_r8,0.69676e+03_r8,0.54044e+03_r8,0.73828e+03_r8,0.95007e+03_r8 /) + kbo(:, 3,23, 6) = (/ & + & 0.90037e+03_r8,0.69620e+03_r8,0.54010e+03_r8,0.73854e+03_r8,0.95036e+03_r8 /) + kbo(:, 4,23, 6) = (/ & + & 0.89971e+03_r8,0.69570e+03_r8,0.53983e+03_r8,0.73858e+03_r8,0.95029e+03_r8 /) + kbo(:, 5,23, 6) = (/ & + & 0.89912e+03_r8,0.69526e+03_r8,0.53959e+03_r8,0.73840e+03_r8,0.94989e+03_r8 /) + kbo(:, 1,24, 6) = (/ & + & 0.89955e+03_r8,0.69558e+03_r8,0.53965e+03_r8,0.73787e+03_r8,0.94957e+03_r8 /) + kbo(:, 2,24, 6) = (/ & + & 0.89886e+03_r8,0.69507e+03_r8,0.53937e+03_r8,0.73829e+03_r8,0.95016e+03_r8 /) + kbo(:, 3,24, 6) = (/ & + & 0.89826e+03_r8,0.69461e+03_r8,0.53914e+03_r8,0.73851e+03_r8,0.95038e+03_r8 /) + kbo(:, 4,24, 6) = (/ & + & 0.89773e+03_r8,0.69422e+03_r8,0.53895e+03_r8,0.73850e+03_r8,0.95023e+03_r8 /) + kbo(:, 5,24, 6) = (/ & + & 0.89726e+03_r8,0.69387e+03_r8,0.53876e+03_r8,0.73829e+03_r8,0.94977e+03_r8 /) + kbo(:, 1,25, 6) = (/ & + & 0.89758e+03_r8,0.69410e+03_r8,0.53876e+03_r8,0.73792e+03_r8,0.94973e+03_r8 /) + kbo(:, 2,25, 6) = (/ & + & 0.89703e+03_r8,0.69369e+03_r8,0.53857e+03_r8,0.73831e+03_r8,0.95024e+03_r8 /) + kbo(:, 3,25, 6) = (/ & + & 0.89655e+03_r8,0.69333e+03_r8,0.53841e+03_r8,0.73848e+03_r8,0.95037e+03_r8 /) + kbo(:, 4,25, 6) = (/ & + & 0.89613e+03_r8,0.69302e+03_r8,0.53826e+03_r8,0.73843e+03_r8,0.95016e+03_r8 /) + kbo(:, 5,25, 6) = (/ & + & 0.89576e+03_r8,0.69273e+03_r8,0.53811e+03_r8,0.73818e+03_r8,0.94963e+03_r8 /) + kbo(:, 1,26, 6) = (/ & + & 0.89598e+03_r8,0.69290e+03_r8,0.53808e+03_r8,0.73799e+03_r8,0.94987e+03_r8 /) + kbo(:, 2,26, 6) = (/ & + & 0.89555e+03_r8,0.69258e+03_r8,0.53794e+03_r8,0.73834e+03_r8,0.95030e+03_r8 /) + kbo(:, 3,26, 6) = (/ & + & 0.89517e+03_r8,0.69229e+03_r8,0.53782e+03_r8,0.73845e+03_r8,0.95035e+03_r8 /) + kbo(:, 4,26, 6) = (/ & + & 0.89483e+03_r8,0.69204e+03_r8,0.53770e+03_r8,0.73836e+03_r8,0.95007e+03_r8 /) + kbo(:, 5,26, 6) = (/ & + & 0.89453e+03_r8,0.69182e+03_r8,0.53759e+03_r8,0.73806e+03_r8,0.94946e+03_r8 /) + kbo(:, 1,27, 6) = (/ & + & 0.89469e+03_r8,0.69194e+03_r8,0.53754e+03_r8,0.73806e+03_r8,0.95001e+03_r8 /) + kbo(:, 2,27, 6) = (/ & + & 0.89435e+03_r8,0.69168e+03_r8,0.53744e+03_r8,0.73835e+03_r8,0.95034e+03_r8 /) + kbo(:, 3,27, 6) = (/ & + & 0.89405e+03_r8,0.69145e+03_r8,0.53736e+03_r8,0.73843e+03_r8,0.95031e+03_r8 /) + kbo(:, 4,27, 6) = (/ & + & 0.89378e+03_r8,0.69125e+03_r8,0.53727e+03_r8,0.73828e+03_r8,0.94995e+03_r8 /) + kbo(:, 5,27, 6) = (/ & + & 0.89354e+03_r8,0.69107e+03_r8,0.53717e+03_r8,0.73792e+03_r8,0.94926e+03_r8 /) + kbo(:, 1,28, 6) = (/ & + & 0.89366e+03_r8,0.69116e+03_r8,0.53711e+03_r8,0.73814e+03_r8,0.95012e+03_r8 /) + kbo(:, 2,28, 6) = (/ & + & 0.89338e+03_r8,0.69096e+03_r8,0.53705e+03_r8,0.73836e+03_r8,0.95037e+03_r8 /) + kbo(:, 3,28, 6) = (/ & + & 0.89314e+03_r8,0.69078e+03_r8,0.53699e+03_r8,0.73838e+03_r8,0.95026e+03_r8 /) + kbo(:, 4,28, 6) = (/ & + & 0.89293e+03_r8,0.69062e+03_r8,0.53692e+03_r8,0.73819e+03_r8,0.94982e+03_r8 /) + kbo(:, 5,28, 6) = (/ & + & 0.89274e+03_r8,0.69047e+03_r8,0.53684e+03_r8,0.73778e+03_r8,0.94904e+03_r8 /) + kbo(:, 1,29, 6) = (/ & + & 0.89282e+03_r8,0.69053e+03_r8,0.53678e+03_r8,0.73818e+03_r8,0.95022e+03_r8 /) + kbo(:, 2,29, 6) = (/ & + & 0.89261e+03_r8,0.69037e+03_r8,0.53674e+03_r8,0.73837e+03_r8,0.95037e+03_r8 /) + kbo(:, 3,29, 6) = (/ & + & 0.89241e+03_r8,0.69023e+03_r8,0.53670e+03_r8,0.73834e+03_r8,0.95018e+03_r8 /) + kbo(:, 4,29, 6) = (/ & + & 0.89224e+03_r8,0.69010e+03_r8,0.53663e+03_r8,0.73810e+03_r8,0.94966e+03_r8 /) + kbo(:, 5,29, 6) = (/ & + & 0.89209e+03_r8,0.68999e+03_r8,0.53656e+03_r8,0.73762e+03_r8,0.94880e+03_r8 /) + kbo(:, 1,30, 6) = (/ & + & 0.89215e+03_r8,0.69003e+03_r8,0.53652e+03_r8,0.73823e+03_r8,0.95029e+03_r8 /) + kbo(:, 2,30, 6) = (/ & + & 0.89198e+03_r8,0.68990e+03_r8,0.53650e+03_r8,0.73836e+03_r8,0.95035e+03_r8 /) + kbo(:, 3,30, 6) = (/ & + & 0.89183e+03_r8,0.68979e+03_r8,0.53646e+03_r8,0.73828e+03_r8,0.95008e+03_r8 /) + kbo(:, 4,30, 6) = (/ & + & 0.89169e+03_r8,0.68969e+03_r8,0.53641e+03_r8,0.73798e+03_r8,0.94948e+03_r8 /) + kbo(:, 5,30, 6) = (/ & + & 0.89157e+03_r8,0.68960e+03_r8,0.53634e+03_r8,0.73744e+03_r8,0.94852e+03_r8 /) + kbo(:, 1,31, 6) = (/ & + & 0.89161e+03_r8,0.68962e+03_r8,0.53631e+03_r8,0.73827e+03_r8,0.95034e+03_r8 /) + kbo(:, 2,31, 6) = (/ & + & 0.89147e+03_r8,0.68952e+03_r8,0.53629e+03_r8,0.73835e+03_r8,0.95031e+03_r8 /) + kbo(:, 3,31, 6) = (/ & + & 0.89135e+03_r8,0.68943e+03_r8,0.53627e+03_r8,0.73821e+03_r8,0.94996e+03_r8 /) + kbo(:, 4,31, 6) = (/ & + & 0.89124e+03_r8,0.68935e+03_r8,0.53622e+03_r8,0.73786e+03_r8,0.94927e+03_r8 /) + kbo(:, 5,31, 6) = (/ & + & 0.89115e+03_r8,0.68928e+03_r8,0.53615e+03_r8,0.73725e+03_r8,0.94822e+03_r8 /) + kbo(:, 1,32, 6) = (/ & + & 0.89117e+03_r8,0.68930e+03_r8,0.53614e+03_r8,0.73830e+03_r8,0.95037e+03_r8 /) + kbo(:, 2,32, 6) = (/ & + & 0.89106e+03_r8,0.68922e+03_r8,0.53614e+03_r8,0.73833e+03_r8,0.95025e+03_r8 /) + kbo(:, 3,32, 6) = (/ & + & 0.89097e+03_r8,0.68914e+03_r8,0.53611e+03_r8,0.73813e+03_r8,0.94981e+03_r8 /) + kbo(:, 4,32, 6) = (/ & + & 0.89088e+03_r8,0.68908e+03_r8,0.53608e+03_r8,0.73772e+03_r8,0.94903e+03_r8 /) + kbo(:, 5,32, 6) = (/ & + & 0.89081e+03_r8,0.68902e+03_r8,0.53600e+03_r8,0.73703e+03_r8,0.94789e+03_r8 /) + kbo(:, 1,33, 6) = (/ & + & 0.89082e+03_r8,0.68903e+03_r8,0.53602e+03_r8,0.73832e+03_r8,0.95037e+03_r8 /) + kbo(:, 2,33, 6) = (/ & + & 0.89073e+03_r8,0.68897e+03_r8,0.53601e+03_r8,0.73829e+03_r8,0.95017e+03_r8 /) + kbo(:, 3,33, 6) = (/ & + & 0.89066e+03_r8,0.68891e+03_r8,0.53599e+03_r8,0.73804e+03_r8,0.94964e+03_r8 /) + kbo(:, 4,33, 6) = (/ & + & 0.89059e+03_r8,0.68886e+03_r8,0.53595e+03_r8,0.73756e+03_r8,0.94877e+03_r8 /) + kbo(:, 5,33, 6) = (/ & + & 0.89053e+03_r8,0.68882e+03_r8,0.53586e+03_r8,0.73678e+03_r8,0.94753e+03_r8 /) + kbo(:, 1,34, 6) = (/ & + & 0.89054e+03_r8,0.68882e+03_r8,0.53592e+03_r8,0.73832e+03_r8,0.95035e+03_r8 /) + kbo(:, 2,34, 6) = (/ & + & 0.89047e+03_r8,0.68877e+03_r8,0.53592e+03_r8,0.73824e+03_r8,0.95008e+03_r8 /) + kbo(:, 3,34, 6) = (/ & + & 0.89041e+03_r8,0.68873e+03_r8,0.53589e+03_r8,0.73795e+03_r8,0.94947e+03_r8 /) + kbo(:, 4,34, 6) = (/ & + & 0.89036e+03_r8,0.68869e+03_r8,0.53584e+03_r8,0.73741e+03_r8,0.94852e+03_r8 /) + kbo(:, 5,34, 6) = (/ & + & 0.89031e+03_r8,0.68865e+03_r8,0.53575e+03_r8,0.73655e+03_r8,0.94719e+03_r8 /) + kbo(:, 1,35, 6) = (/ & + & 0.89032e+03_r8,0.68866e+03_r8,0.53584e+03_r8,0.73832e+03_r8,0.95034e+03_r8 /) + kbo(:, 2,35, 6) = (/ & + & 0.89027e+03_r8,0.68862e+03_r8,0.53584e+03_r8,0.73821e+03_r8,0.95002e+03_r8 /) + kbo(:, 3,35, 6) = (/ & + & 0.89022e+03_r8,0.68858e+03_r8,0.53581e+03_r8,0.73788e+03_r8,0.94937e+03_r8 /) + kbo(:, 4,35, 6) = (/ & + & 0.89017e+03_r8,0.68855e+03_r8,0.53576e+03_r8,0.73731e+03_r8,0.94836e+03_r8 /) + kbo(:, 5,35, 6) = (/ & + & 0.89013e+03_r8,0.68852e+03_r8,0.53567e+03_r8,0.73640e+03_r8,0.94700e+03_r8 /) + kbo(:, 1,36, 6) = (/ & + & 0.89015e+03_r8,0.68853e+03_r8,0.53577e+03_r8,0.73831e+03_r8,0.95033e+03_r8 /) + kbo(:, 2,36, 6) = (/ & + & 0.89010e+03_r8,0.68849e+03_r8,0.53577e+03_r8,0.73820e+03_r8,0.95001e+03_r8 /) + kbo(:, 3,36, 6) = (/ & + & 0.89006e+03_r8,0.68846e+03_r8,0.53575e+03_r8,0.73787e+03_r8,0.94935e+03_r8 /) + kbo(:, 4,36, 6) = (/ & + & 0.89003e+03_r8,0.68844e+03_r8,0.53570e+03_r8,0.73729e+03_r8,0.94834e+03_r8 /) + kbo(:, 5,36, 6) = (/ & + & 0.88999e+03_r8,0.68841e+03_r8,0.53561e+03_r8,0.73637e+03_r8,0.94696e+03_r8 /) + kbo(:, 1,37, 6) = (/ & + & 0.89001e+03_r8,0.68843e+03_r8,0.53571e+03_r8,0.73831e+03_r8,0.95036e+03_r8 /) + kbo(:, 2,37, 6) = (/ & + & 0.88997e+03_r8,0.68840e+03_r8,0.53572e+03_r8,0.73823e+03_r8,0.95007e+03_r8 /) + kbo(:, 3,37, 6) = (/ & + & 0.88994e+03_r8,0.68837e+03_r8,0.53570e+03_r8,0.73792e+03_r8,0.94946e+03_r8 /) + kbo(:, 4,37, 6) = (/ & + & 0.88991e+03_r8,0.68835e+03_r8,0.53566e+03_r8,0.73738e+03_r8,0.94849e+03_r8 /) + kbo(:, 5,37, 6) = (/ & + & 0.88988e+03_r8,0.68833e+03_r8,0.53557e+03_r8,0.73651e+03_r8,0.94716e+03_r8 /) + kbo(:, 1,38, 6) = (/ & + & 0.88990e+03_r8,0.68834e+03_r8,0.53566e+03_r8,0.73830e+03_r8,0.95036e+03_r8 /) + kbo(:, 2,38, 6) = (/ & + & 0.88987e+03_r8,0.68832e+03_r8,0.53568e+03_r8,0.73825e+03_r8,0.95013e+03_r8 /) + kbo(:, 3,38, 6) = (/ & + & 0.88984e+03_r8,0.68830e+03_r8,0.53566e+03_r8,0.73798e+03_r8,0.94957e+03_r8 /) + kbo(:, 4,38, 6) = (/ & + & 0.88982e+03_r8,0.68828e+03_r8,0.53563e+03_r8,0.73747e+03_r8,0.94865e+03_r8 /) + kbo(:, 5,38, 6) = (/ & + & 0.88979e+03_r8,0.68826e+03_r8,0.53555e+03_r8,0.73665e+03_r8,0.94737e+03_r8 /) + kbo(:, 1,39, 6) = (/ & + & 0.88981e+03_r8,0.68827e+03_r8,0.53562e+03_r8,0.73829e+03_r8,0.95037e+03_r8 /) + kbo(:, 2,39, 6) = (/ & + & 0.88978e+03_r8,0.68825e+03_r8,0.53564e+03_r8,0.73826e+03_r8,0.95018e+03_r8 /) + kbo(:, 3,39, 6) = (/ & + & 0.88976e+03_r8,0.68824e+03_r8,0.53563e+03_r8,0.73803e+03_r8,0.94966e+03_r8 /) + kbo(:, 4,39, 6) = (/ & + & 0.88974e+03_r8,0.68822e+03_r8,0.53560e+03_r8,0.73755e+03_r8,0.94880e+03_r8 /) + kbo(:, 5,39, 6) = (/ & + & 0.88972e+03_r8,0.68821e+03_r8,0.53553e+03_r8,0.73679e+03_r8,0.94757e+03_r8 /) + kbo(:, 1,40, 6) = (/ & + & 0.88973e+03_r8,0.68822e+03_r8,0.53558e+03_r8,0.73826e+03_r8,0.95037e+03_r8 /) + kbo(:, 2,40, 6) = (/ & + & 0.88971e+03_r8,0.68820e+03_r8,0.53561e+03_r8,0.73829e+03_r8,0.95026e+03_r8 /) + kbo(:, 3,40, 6) = (/ & + & 0.88969e+03_r8,0.68819e+03_r8,0.53561e+03_r8,0.73810e+03_r8,0.94982e+03_r8 /) + kbo(:, 4,40, 6) = (/ & + & 0.88967e+03_r8,0.68817e+03_r8,0.53559e+03_r8,0.73769e+03_r8,0.94904e+03_r8 /) + kbo(:, 5,40, 6) = (/ & + & 0.88966e+03_r8,0.68816e+03_r8,0.53553e+03_r8,0.73700e+03_r8,0.94790e+03_r8 /) + kbo(:, 1,41, 6) = (/ & + & 0.88967e+03_r8,0.68817e+03_r8,0.53555e+03_r8,0.73822e+03_r8,0.95035e+03_r8 /) + kbo(:, 2,41, 6) = (/ & + & 0.88965e+03_r8,0.68816e+03_r8,0.53558e+03_r8,0.73830e+03_r8,0.95031e+03_r8 /) + kbo(:, 3,41, 6) = (/ & + & 0.88964e+03_r8,0.68815e+03_r8,0.53559e+03_r8,0.73817e+03_r8,0.94996e+03_r8 /) + kbo(:, 4,41, 6) = (/ & + & 0.88962e+03_r8,0.68813e+03_r8,0.53558e+03_r8,0.73782e+03_r8,0.94927e+03_r8 /) + kbo(:, 5,41, 6) = (/ & + & 0.88961e+03_r8,0.68812e+03_r8,0.53553e+03_r8,0.73722e+03_r8,0.94822e+03_r8 /) + kbo(:, 1,42, 6) = (/ & + & 0.88962e+03_r8,0.68813e+03_r8,0.53551e+03_r8,0.73816e+03_r8,0.95029e+03_r8 /) + kbo(:, 2,42, 6) = (/ & + & 0.88960e+03_r8,0.68812e+03_r8,0.53555e+03_r8,0.73830e+03_r8,0.95035e+03_r8 /) + kbo(:, 3,42, 6) = (/ & + & 0.88959e+03_r8,0.68811e+03_r8,0.53557e+03_r8,0.73822e+03_r8,0.95008e+03_r8 /) + kbo(:, 4,42, 6) = (/ & + & 0.88958e+03_r8,0.68810e+03_r8,0.53556e+03_r8,0.73793e+03_r8,0.94948e+03_r8 /) + kbo(:, 5,42, 6) = (/ & + & 0.88957e+03_r8,0.68809e+03_r8,0.53553e+03_r8,0.73739e+03_r8,0.94853e+03_r8 /) + kbo(:, 1,43, 6) = (/ & + & 0.88958e+03_r8,0.68810e+03_r8,0.53547e+03_r8,0.73807e+03_r8,0.95020e+03_r8 /) + kbo(:, 2,43, 6) = (/ & + & 0.88957e+03_r8,0.68809e+03_r8,0.53552e+03_r8,0.73828e+03_r8,0.95037e+03_r8 /) + kbo(:, 3,43, 6) = (/ & + & 0.88955e+03_r8,0.68808e+03_r8,0.53555e+03_r8,0.73826e+03_r8,0.95020e+03_r8 /) + kbo(:, 4,43, 6) = (/ & + & 0.88954e+03_r8,0.68808e+03_r8,0.53555e+03_r8,0.73804e+03_r8,0.94970e+03_r8 /) + kbo(:, 5,43, 6) = (/ & + & 0.88953e+03_r8,0.68807e+03_r8,0.53553e+03_r8,0.73758e+03_r8,0.94886e+03_r8 /) + kbo(:, 1,44, 6) = (/ & + & 0.88954e+03_r8,0.68808e+03_r8,0.53544e+03_r8,0.73795e+03_r8,0.95005e+03_r8 /) + kbo(:, 2,44, 6) = (/ & + & 0.88953e+03_r8,0.68807e+03_r8,0.53549e+03_r8,0.73823e+03_r8,0.95035e+03_r8 /) + kbo(:, 3,44, 6) = (/ & + & 0.88952e+03_r8,0.68806e+03_r8,0.53553e+03_r8,0.73829e+03_r8,0.95030e+03_r8 /) + kbo(:, 4,44, 6) = (/ & + & 0.88951e+03_r8,0.68805e+03_r8,0.53554e+03_r8,0.73815e+03_r8,0.94991e+03_r8 /) + kbo(:, 5,44, 6) = (/ & + & 0.88951e+03_r8,0.68805e+03_r8,0.53553e+03_r8,0.73776e+03_r8,0.94919e+03_r8 /) + kbo(:, 1,45, 6) = (/ & + & 0.88952e+03_r8,0.68806e+03_r8,0.53540e+03_r8,0.73782e+03_r8,0.94987e+03_r8 /) + kbo(:, 2,45, 6) = (/ & + & 0.88951e+03_r8,0.68805e+03_r8,0.53547e+03_r8,0.73816e+03_r8,0.95030e+03_r8 /) + kbo(:, 3,45, 6) = (/ & + & 0.88950e+03_r8,0.68804e+03_r8,0.53551e+03_r8,0.73830e+03_r8,0.95035e+03_r8 /) + kbo(:, 4,45, 6) = (/ & + & 0.88949e+03_r8,0.68804e+03_r8,0.53553e+03_r8,0.73821e+03_r8,0.95008e+03_r8 /) + kbo(:, 5,45, 6) = (/ & + & 0.88948e+03_r8,0.68803e+03_r8,0.53553e+03_r8,0.73792e+03_r8,0.94947e+03_r8 /) + kbo(:, 1,46, 6) = (/ & + & 0.88949e+03_r8,0.68804e+03_r8,0.53537e+03_r8,0.73763e+03_r8,0.94962e+03_r8 /) + kbo(:, 2,46, 6) = (/ & + & 0.88948e+03_r8,0.68803e+03_r8,0.53544e+03_r8,0.73806e+03_r8,0.95019e+03_r8 /) + kbo(:, 3,46, 6) = (/ & + & 0.88948e+03_r8,0.68803e+03_r8,0.53549e+03_r8,0.73827e+03_r8,0.95037e+03_r8 /) + kbo(:, 4,46, 6) = (/ & + & 0.88947e+03_r8,0.68802e+03_r8,0.53552e+03_r8,0.73827e+03_r8,0.95021e+03_r8 /) + kbo(:, 5,46, 6) = (/ & + & 0.88946e+03_r8,0.68802e+03_r8,0.53552e+03_r8,0.73805e+03_r8,0.94973e+03_r8 /) + kbo(:, 1,47, 6) = (/ & + & 0.88947e+03_r8,0.68802e+03_r8,0.53531e+03_r8,0.73737e+03_r8,0.94929e+03_r8 /) + kbo(:, 2,47, 6) = (/ & + & 0.88947e+03_r8,0.68802e+03_r8,0.53539e+03_r8,0.73792e+03_r8,0.95000e+03_r8 /) + kbo(:, 3,47, 6) = (/ & + & 0.88946e+03_r8,0.68801e+03_r8,0.53546e+03_r8,0.73821e+03_r8,0.95034e+03_r8 /) + kbo(:, 4,47, 6) = (/ & + & 0.88945e+03_r8,0.68801e+03_r8,0.53550e+03_r8,0.73829e+03_r8,0.95032e+03_r8 /) + kbo(:, 5,47, 6) = (/ & + & 0.88945e+03_r8,0.68800e+03_r8,0.53551e+03_r8,0.73816e+03_r8,0.94996e+03_r8 /) + kbo(:, 1,48, 6) = (/ & + & 0.88946e+03_r8,0.68801e+03_r8,0.53528e+03_r8,0.73708e+03_r8,0.94889e+03_r8 /) + kbo(:, 2,48, 6) = (/ & + & 0.88945e+03_r8,0.68801e+03_r8,0.53536e+03_r8,0.73773e+03_r8,0.94976e+03_r8 /) + kbo(:, 3,48, 6) = (/ & + & 0.88944e+03_r8,0.68800e+03_r8,0.53543e+03_r8,0.73812e+03_r8,0.95025e+03_r8 /) + kbo(:, 4,48, 6) = (/ & + & 0.88944e+03_r8,0.68800e+03_r8,0.53548e+03_r8,0.73829e+03_r8,0.95037e+03_r8 /) + kbo(:, 5,48, 6) = (/ & + & 0.88944e+03_r8,0.68800e+03_r8,0.53551e+03_r8,0.73824e+03_r8,0.95014e+03_r8 /) + kbo(:, 1,49, 6) = (/ & + & 0.88944e+03_r8,0.68800e+03_r8,0.53524e+03_r8,0.73674e+03_r8,0.94844e+03_r8 /) + kbo(:, 2,49, 6) = (/ & + & 0.88944e+03_r8,0.68800e+03_r8,0.53533e+03_r8,0.73750e+03_r8,0.94945e+03_r8 /) + kbo(:, 3,49, 6) = (/ & + & 0.88943e+03_r8,0.68799e+03_r8,0.53540e+03_r8,0.73799e+03_r8,0.95016e+03_r8 /) + kbo(:, 4,49, 6) = (/ & + & 0.88943e+03_r8,0.68799e+03_r8,0.53546e+03_r8,0.73825e+03_r8,0.95036e+03_r8 /) + kbo(:, 5,49, 6) = (/ & + & 0.88942e+03_r8,0.68799e+03_r8,0.53549e+03_r8,0.73828e+03_r8,0.95027e+03_r8 /) + kbo(:, 1,50, 6) = (/ & + & 0.88943e+03_r8,0.68799e+03_r8,0.53521e+03_r8,0.73638e+03_r8,0.94796e+03_r8 /) + kbo(:, 2,50, 6) = (/ & + & 0.88943e+03_r8,0.68799e+03_r8,0.53529e+03_r8,0.73724e+03_r8,0.94911e+03_r8 /) + kbo(:, 3,50, 6) = (/ & + & 0.88942e+03_r8,0.68798e+03_r8,0.53537e+03_r8,0.73783e+03_r8,0.94990e+03_r8 /) + kbo(:, 4,50, 6) = (/ & + & 0.88942e+03_r8,0.68798e+03_r8,0.53544e+03_r8,0.73817e+03_r8,0.95031e+03_r8 /) + kbo(:, 5,50, 6) = (/ & + & 0.88942e+03_r8,0.68798e+03_r8,0.53548e+03_r8,0.73829e+03_r8,0.95034e+03_r8 /) + kbo(:, 1,51, 6) = (/ & + & 0.88942e+03_r8,0.68798e+03_r8,0.53518e+03_r8,0.73600e+03_r8,0.94745e+03_r8 /) + kbo(:, 2,51, 6) = (/ & + & 0.88942e+03_r8,0.68798e+03_r8,0.53525e+03_r8,0.73696e+03_r8,0.94873e+03_r8 /) + kbo(:, 3,51, 6) = (/ & + & 0.88941e+03_r8,0.68798e+03_r8,0.53533e+03_r8,0.73765e+03_r8,0.94966e+03_r8 /) + kbo(:, 4,51, 6) = (/ & + & 0.88941e+03_r8,0.68798e+03_r8,0.53541e+03_r8,0.73807e+03_r8,0.95020e+03_r8 /) + kbo(:, 5,51, 6) = (/ & + & 0.88941e+03_r8,0.68797e+03_r8,0.53546e+03_r8,0.73827e+03_r8,0.95037e+03_r8 /) + kbo(:, 1,52, 6) = (/ & + & 0.88941e+03_r8,0.68798e+03_r8,0.53513e+03_r8,0.73556e+03_r8,0.94688e+03_r8 /) + kbo(:, 2,52, 6) = (/ & + & 0.88941e+03_r8,0.68798e+03_r8,0.53522e+03_r8,0.73664e+03_r8,0.94831e+03_r8 /) + kbo(:, 3,52, 6) = (/ & + & 0.88941e+03_r8,0.68797e+03_r8,0.53531e+03_r8,0.73743e+03_r8,0.94936e+03_r8 /) + kbo(:, 4,52, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53538e+03_r8,0.73795e+03_r8,0.95005e+03_r8 /) + kbo(:, 5,52, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53545e+03_r8,0.73822e+03_r8,0.95036e+03_r8 /) + kbo(:, 1,53, 6) = (/ & + & 0.88941e+03_r8,0.68797e+03_r8,0.53507e+03_r8,0.73509e+03_r8,0.94627e+03_r8 /) + kbo(:, 2,53, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53519e+03_r8,0.73629e+03_r8,0.94784e+03_r8 /) + kbo(:, 3,53, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53527e+03_r8,0.73717e+03_r8,0.94902e+03_r8 /) + kbo(:, 4,53, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53535e+03_r8,0.73779e+03_r8,0.94984e+03_r8 /) + kbo(:, 5,53, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53542e+03_r8,0.73815e+03_r8,0.95029e+03_r8 /) + kbo(:, 1,54, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53502e+03_r8,0.73463e+03_r8,0.94566e+03_r8 /) + kbo(:, 2,54, 6) = (/ & + & 0.88940e+03_r8,0.68797e+03_r8,0.53516e+03_r8,0.73592e+03_r8,0.94735e+03_r8 /) + kbo(:, 3,54, 6) = (/ & + & 0.88940e+03_r8,0.68796e+03_r8,0.53524e+03_r8,0.73691e+03_r8,0.94866e+03_r8 /) + kbo(:, 4,54, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53533e+03_r8,0.73761e+03_r8,0.94961e+03_r8 /) + kbo(:, 5,54, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53539e+03_r8,0.73805e+03_r8,0.95018e+03_r8 /) + kbo(:, 1,55, 6) = (/ & + & 0.88940e+03_r8,0.68796e+03_r8,0.53495e+03_r8,0.73415e+03_r8,0.94503e+03_r8 /) + kbo(:, 2,55, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53513e+03_r8,0.73554e+03_r8,0.94685e+03_r8 /) + kbo(:, 3,55, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53521e+03_r8,0.73662e+03_r8,0.94828e+03_r8 /) + kbo(:, 4,55, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53530e+03_r8,0.73742e+03_r8,0.94934e+03_r8 /) + kbo(:, 5,55, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53537e+03_r8,0.73794e+03_r8,0.95004e+03_r8 /) + kbo(:, 1,56, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53489e+03_r8,0.73364e+03_r8,0.94437e+03_r8 /) + kbo(:, 2,56, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53507e+03_r8,0.73512e+03_r8,0.94631e+03_r8 /) + kbo(:, 3,56, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53519e+03_r8,0.73631e+03_r8,0.94787e+03_r8 /) + kbo(:, 4,56, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53527e+03_r8,0.73719e+03_r8,0.94904e+03_r8 /) + kbo(:, 5,56, 6) = (/ & + & 0.88938e+03_r8,0.68796e+03_r8,0.53535e+03_r8,0.73780e+03_r8,0.94987e+03_r8 /) + kbo(:, 1,57, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53481e+03_r8,0.73310e+03_r8,0.94366e+03_r8 /) + kbo(:, 2,57, 6) = (/ & + & 0.88939e+03_r8,0.68796e+03_r8,0.53502e+03_r8,0.73469e+03_r8,0.94573e+03_r8 /) + kbo(:, 3,57, 6) = (/ & + & 0.88938e+03_r8,0.68796e+03_r8,0.53516e+03_r8,0.73597e+03_r8,0.94741e+03_r8 /) + kbo(:, 4,57, 6) = (/ & + & 0.88938e+03_r8,0.68796e+03_r8,0.53524e+03_r8,0.73694e+03_r8,0.94871e+03_r8 /) + kbo(:, 5,57, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53532e+03_r8,0.73764e+03_r8,0.94964e+03_r8 /) + kbo(:, 1,58, 6) = (/ & + & 0.88938e+03_r8,0.68796e+03_r8,0.53474e+03_r8,0.73255e+03_r8,0.94296e+03_r8 /) + kbo(:, 2,58, 6) = (/ & + & 0.88938e+03_r8,0.68796e+03_r8,0.53496e+03_r8,0.73423e+03_r8,0.94515e+03_r8 /) + kbo(:, 3,58, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53512e+03_r8,0.73561e+03_r8,0.94695e+03_r8 /) + kbo(:, 4,58, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53522e+03_r8,0.73667e+03_r8,0.94836e+03_r8 /) + kbo(:, 5,58, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53530e+03_r8,0.73745e+03_r8,0.94939e+03_r8 /) + kbo(:, 1,59, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53470e+03_r8,0.73233e+03_r8,0.94266e+03_r8 /) + kbo(:, 2,59, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53494e+03_r8,0.73405e+03_r8,0.94490e+03_r8 /) + kbo(:, 3,59, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53510e+03_r8,0.73546e+03_r8,0.94675e+03_r8 /) + kbo(:, 4,59, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53521e+03_r8,0.73657e+03_r8,0.94820e+03_r8 /) + kbo(:, 5,59, 6) = (/ & + & 0.88938e+03_r8,0.68795e+03_r8,0.53529e+03_r8,0.73737e+03_r8,0.94929e+03_r8 /) + kbo(:, 1,13, 7) = (/ & + & 0.11104e+04_r8,0.84453e+03_r8,0.58852e+03_r8,0.81799e+03_r8,0.10746e+04_r8 /) + kbo(:, 2,13, 7) = (/ & + & 0.11019e+04_r8,0.83810e+03_r8,0.58572e+03_r8,0.81836e+03_r8,0.10752e+04_r8 /) + kbo(:, 3,13, 7) = (/ & + & 0.10945e+04_r8,0.83257e+03_r8,0.58306e+03_r8,0.81848e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,13, 7) = (/ & + & 0.10881e+04_r8,0.82775e+03_r8,0.58047e+03_r8,0.81831e+03_r8,0.10753e+04_r8 /) + kbo(:, 5,13, 7) = (/ & + & 0.10824e+04_r8,0.82352e+03_r8,0.57809e+03_r8,0.81788e+03_r8,0.10749e+04_r8 /) + kbo(:, 1,14, 7) = (/ & + & 0.10890e+04_r8,0.82842e+03_r8,0.58087e+03_r8,0.81780e+03_r8,0.10747e+04_r8 /) + kbo(:, 2,14, 7) = (/ & + & 0.10820e+04_r8,0.82323e+03_r8,0.57803e+03_r8,0.81816e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,14, 7) = (/ & + & 0.10761e+04_r8,0.81875e+03_r8,0.57524e+03_r8,0.81827e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,14, 7) = (/ & + & 0.10709e+04_r8,0.81486e+03_r8,0.57281e+03_r8,0.81809e+03_r8,0.10752e+04_r8 /) + kbo(:, 5,14, 7) = (/ & + & 0.10663e+04_r8,0.81144e+03_r8,0.57087e+03_r8,0.81766e+03_r8,0.10748e+04_r8 /) + kbo(:, 1,15, 7) = (/ & + & 0.10714e+04_r8,0.81529e+03_r8,0.57324e+03_r8,0.81765e+03_r8,0.10748e+04_r8 /) + kbo(:, 2,15, 7) = (/ & + & 0.10659e+04_r8,0.81110e+03_r8,0.57094e+03_r8,0.81800e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,15, 7) = (/ & + & 0.10611e+04_r8,0.80749e+03_r8,0.56926e+03_r8,0.81809e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,15, 7) = (/ & + & 0.10569e+04_r8,0.80434e+03_r8,0.56791e+03_r8,0.81790e+03_r8,0.10752e+04_r8 /) + kbo(:, 5,15, 7) = (/ & + & 0.10532e+04_r8,0.80157e+03_r8,0.56672e+03_r8,0.81746e+03_r8,0.10748e+04_r8 /) + kbo(:, 1,16, 7) = (/ & + & 0.10572e+04_r8,0.80460e+03_r8,0.56822e+03_r8,0.81755e+03_r8,0.10748e+04_r8 /) + kbo(:, 2,16, 7) = (/ & + & 0.10527e+04_r8,0.80122e+03_r8,0.56701e+03_r8,0.81788e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,16, 7) = (/ & + & 0.10488e+04_r8,0.79831e+03_r8,0.56599e+03_r8,0.81796e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,16, 7) = (/ & + & 0.10454e+04_r8,0.79577e+03_r8,0.56505e+03_r8,0.81773e+03_r8,0.10752e+04_r8 /) + kbo(:, 5,16, 7) = (/ & + & 0.10425e+04_r8,0.79354e+03_r8,0.56418e+03_r8,0.81728e+03_r8,0.10747e+04_r8 /) + kbo(:, 1,17, 7) = (/ & + & 0.10456e+04_r8,0.79593e+03_r8,0.56540e+03_r8,0.81747e+03_r8,0.10749e+04_r8 /) + kbo(:, 2,17, 7) = (/ & + & 0.10420e+04_r8,0.79321e+03_r8,0.56464e+03_r8,0.81778e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,17, 7) = (/ & + & 0.10389e+04_r8,0.79086e+03_r8,0.56406e+03_r8,0.81783e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,17, 7) = (/ & + & 0.10362e+04_r8,0.78881e+03_r8,0.56355e+03_r8,0.81761e+03_r8,0.10751e+04_r8 /) + kbo(:, 5,17, 7) = (/ & + & 0.10337e+04_r8,0.78701e+03_r8,0.56298e+03_r8,0.81712e+03_r8,0.10746e+04_r8 /) + kbo(:, 1,18, 7) = (/ & + & 0.10363e+04_r8,0.78890e+03_r8,0.56372e+03_r8,0.81741e+03_r8,0.10750e+04_r8 /) + kbo(:, 2,18, 7) = (/ & + & 0.10334e+04_r8,0.78671e+03_r8,0.56351e+03_r8,0.81771e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,18, 7) = (/ & + & 0.10308e+04_r8,0.78481e+03_r8,0.56335e+03_r8,0.81775e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,18, 7) = (/ & + & 0.10286e+04_r8,0.78316e+03_r8,0.56306e+03_r8,0.81749e+03_r8,0.10751e+04_r8 /) + kbo(:, 5,18, 7) = (/ & + & 0.10267e+04_r8,0.78170e+03_r8,0.56253e+03_r8,0.81698e+03_r8,0.10746e+04_r8 /) + kbo(:, 1,19, 7) = (/ & + & 0.10287e+04_r8,0.78319e+03_r8,0.56306e+03_r8,0.81737e+03_r8,0.10751e+04_r8 /) + kbo(:, 2,19, 7) = (/ & + & 0.10263e+04_r8,0.78143e+03_r8,0.56317e+03_r8,0.81766e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,19, 7) = (/ & + & 0.10243e+04_r8,0.77990e+03_r8,0.56256e+03_r8,0.81764e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,19, 7) = (/ & + & 0.10225e+04_r8,0.77856e+03_r8,0.56270e+03_r8,0.81737e+03_r8,0.10751e+04_r8 /) + kbo(:, 5,19, 7) = (/ & + & 0.10209e+04_r8,0.77738e+03_r8,0.56230e+03_r8,0.81685e+03_r8,0.10745e+04_r8 /) + kbo(:, 1,20, 7) = (/ & + & 0.10225e+04_r8,0.77853e+03_r8,0.56258e+03_r8,0.81735e+03_r8,0.10751e+04_r8 /) + kbo(:, 2,20, 7) = (/ & + & 0.10206e+04_r8,0.77711e+03_r8,0.56304e+03_r8,0.81761e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,20, 7) = (/ & + & 0.10189e+04_r8,0.77589e+03_r8,0.56295e+03_r8,0.81757e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,20, 7) = (/ & + & 0.10175e+04_r8,0.77480e+03_r8,0.56264e+03_r8,0.81728e+03_r8,0.10750e+04_r8 /) + kbo(:, 5,20, 7) = (/ & + & 0.10162e+04_r8,0.77385e+03_r8,0.56211e+03_r8,0.81672e+03_r8,0.10744e+04_r8 /) + kbo(:, 1,21, 7) = (/ & + & 0.10174e+04_r8,0.77475e+03_r8,0.56279e+03_r8,0.81734e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,21, 7) = (/ & + & 0.10159e+04_r8,0.77361e+03_r8,0.56292e+03_r8,0.81756e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,21, 7) = (/ & + & 0.10146e+04_r8,0.77262e+03_r8,0.56281e+03_r8,0.81751e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,21, 7) = (/ & + & 0.10134e+04_r8,0.77175e+03_r8,0.56248e+03_r8,0.81718e+03_r8,0.10750e+04_r8 /) + kbo(:, 5,21, 7) = (/ & + & 0.10124e+04_r8,0.77098e+03_r8,0.56193e+03_r8,0.81661e+03_r8,0.10743e+04_r8 /) + kbo(:, 1,22, 7) = (/ & + & 0.10132e+04_r8,0.77163e+03_r8,0.56273e+03_r8,0.81736e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,22, 7) = (/ & + & 0.10120e+04_r8,0.77071e+03_r8,0.56281e+03_r8,0.81753e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,22, 7) = (/ & + & 0.10110e+04_r8,0.76992e+03_r8,0.56267e+03_r8,0.81743e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,22, 7) = (/ & + & 0.10100e+04_r8,0.76922e+03_r8,0.56230e+03_r8,0.81706e+03_r8,0.10749e+04_r8 /) + kbo(:, 5,22, 7) = (/ & + & 0.10092e+04_r8,0.76860e+03_r8,0.56172e+03_r8,0.81643e+03_r8,0.10742e+04_r8 /) + kbo(:, 1,23, 7) = (/ & + & 0.10099e+04_r8,0.76909e+03_r8,0.56267e+03_r8,0.81738e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,23, 7) = (/ & + & 0.10089e+04_r8,0.76836e+03_r8,0.56273e+03_r8,0.81751e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,23, 7) = (/ & + & 0.10080e+04_r8,0.76773e+03_r8,0.56254e+03_r8,0.81734e+03_r8,0.10752e+04_r8 /) + kbo(:, 4,23, 7) = (/ & + & 0.10073e+04_r8,0.76717e+03_r8,0.56214e+03_r8,0.81691e+03_r8,0.10748e+04_r8 /) + kbo(:, 5,23, 7) = (/ & + & 0.10067e+04_r8,0.76668e+03_r8,0.56152e+03_r8,0.81625e+03_r8,0.10740e+04_r8 /) + kbo(:, 1,24, 7) = (/ & + & 0.10071e+04_r8,0.76704e+03_r8,0.56263e+03_r8,0.81739e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,24, 7) = (/ & + & 0.10064e+04_r8,0.76647e+03_r8,0.56264e+03_r8,0.81747e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,24, 7) = (/ & + & 0.10057e+04_r8,0.76596e+03_r8,0.56242e+03_r8,0.81725e+03_r8,0.10751e+04_r8 /) + kbo(:, 4,24, 7) = (/ & + & 0.10051e+04_r8,0.76551e+03_r8,0.56198e+03_r8,0.81678e+03_r8,0.10746e+04_r8 /) + kbo(:, 5,24, 7) = (/ & + & 0.10046e+04_r8,0.76512e+03_r8,0.56132e+03_r8,0.81606e+03_r8,0.10738e+04_r8 /) + kbo(:, 1,25, 7) = (/ & + & 0.10049e+04_r8,0.76538e+03_r8,0.56260e+03_r8,0.81741e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,25, 7) = (/ & + & 0.10043e+04_r8,0.76492e+03_r8,0.56256e+03_r8,0.81742e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,25, 7) = (/ & + & 0.10038e+04_r8,0.76453e+03_r8,0.56229e+03_r8,0.81717e+03_r8,0.10750e+04_r8 /) + kbo(:, 4,25, 7) = (/ & + & 0.10033e+04_r8,0.76417e+03_r8,0.56181e+03_r8,0.81663e+03_r8,0.10745e+04_r8 /) + kbo(:, 5,25, 7) = (/ & + & 0.10029e+04_r8,0.76385e+03_r8,0.56111e+03_r8,0.81585e+03_r8,0.10736e+04_r8 /) + kbo(:, 1,26, 7) = (/ & + & 0.10031e+04_r8,0.76404e+03_r8,0.56257e+03_r8,0.81743e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,26, 7) = (/ & + & 0.10026e+04_r8,0.76368e+03_r8,0.56248e+03_r8,0.81736e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,26, 7) = (/ & + & 0.10022e+04_r8,0.76336e+03_r8,0.56216e+03_r8,0.81707e+03_r8,0.10749e+04_r8 /) + kbo(:, 4,26, 7) = (/ & + & 0.10018e+04_r8,0.76308e+03_r8,0.56163e+03_r8,0.81645e+03_r8,0.10743e+04_r8 /) + kbo(:, 5,26, 7) = (/ & + & 0.10015e+04_r8,0.76282e+03_r8,0.56088e+03_r8,0.81561e+03_r8,0.10734e+04_r8 /) + kbo(:, 1,27, 7) = (/ & + & 0.10017e+04_r8,0.76296e+03_r8,0.56253e+03_r8,0.81743e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,27, 7) = (/ & + & 0.10013e+04_r8,0.76268e+03_r8,0.56239e+03_r8,0.81730e+03_r8,0.10752e+04_r8 /) + kbo(:, 3,27, 7) = (/ & + & 0.10010e+04_r8,0.76242e+03_r8,0.56202e+03_r8,0.81696e+03_r8,0.10748e+04_r8 /) + kbo(:, 4,27, 7) = (/ & + & 0.10007e+04_r8,0.76220e+03_r8,0.56144e+03_r8,0.81630e+03_r8,0.10741e+04_r8 /) + kbo(:, 5,27, 7) = (/ & + & 0.10004e+04_r8,0.76200e+03_r8,0.56064e+03_r8,0.81536e+03_r8,0.10731e+04_r8 /) + kbo(:, 1,28, 7) = (/ & + & 0.10005e+04_r8,0.76209e+03_r8,0.56249e+03_r8,0.81738e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,28, 7) = (/ & + & 0.10002e+04_r8,0.76186e+03_r8,0.56229e+03_r8,0.81724e+03_r8,0.10752e+04_r8 /) + kbo(:, 3,28, 7) = (/ & + & 0.99995e+03_r8,0.76166e+03_r8,0.56188e+03_r8,0.81687e+03_r8,0.10747e+04_r8 /) + kbo(:, 4,28, 7) = (/ & + & 0.99971e+03_r8,0.76148e+03_r8,0.56124e+03_r8,0.81607e+03_r8,0.10739e+04_r8 /) + kbo(:, 5,28, 7) = (/ & + & 0.99950e+03_r8,0.76132e+03_r8,0.56040e+03_r8,0.81510e+03_r8,0.10728e+04_r8 /) + kbo(:, 1,29, 7) = (/ & + & 0.99960e+03_r8,0.76139e+03_r8,0.56244e+03_r8,0.81739e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,29, 7) = (/ & + & 0.99935e+03_r8,0.76121e+03_r8,0.56219e+03_r8,0.81712e+03_r8,0.10751e+04_r8 /) + kbo(:, 3,29, 7) = (/ & + & 0.99914e+03_r8,0.76105e+03_r8,0.56172e+03_r8,0.81663e+03_r8,0.10745e+04_r8 /) + kbo(:, 4,29, 7) = (/ & + & 0.99895e+03_r8,0.76091e+03_r8,0.56103e+03_r8,0.81584e+03_r8,0.10737e+04_r8 /) + kbo(:, 5,29, 7) = (/ & + & 0.99878e+03_r8,0.76078e+03_r8,0.56014e+03_r8,0.81482e+03_r8,0.10725e+04_r8 /) + kbo(:, 1,30, 7) = (/ & + & 0.99885e+03_r8,0.76083e+03_r8,0.56238e+03_r8,0.81733e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,30, 7) = (/ & + & 0.99865e+03_r8,0.76069e+03_r8,0.56207e+03_r8,0.81703e+03_r8,0.10750e+04_r8 /) + kbo(:, 3,30, 7) = (/ & + & 0.99848e+03_r8,0.76055e+03_r8,0.56155e+03_r8,0.81643e+03_r8,0.10743e+04_r8 /) + kbo(:, 4,30, 7) = (/ & + & 0.99833e+03_r8,0.76044e+03_r8,0.56081e+03_r8,0.81561e+03_r8,0.10734e+04_r8 /) + kbo(:, 5,30, 7) = (/ & + & 0.99819e+03_r8,0.76034e+03_r8,0.55986e+03_r8,0.81451e+03_r8,0.10721e+04_r8 /) + kbo(:, 1,31, 7) = (/ & + & 0.99824e+03_r8,0.76037e+03_r8,0.56231e+03_r8,0.81727e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,31, 7) = (/ & + & 0.99808e+03_r8,0.76026e+03_r8,0.56195e+03_r8,0.81690e+03_r8,0.10748e+04_r8 /) + kbo(:, 3,31, 7) = (/ & + & 0.99794e+03_r8,0.76015e+03_r8,0.56137e+03_r8,0.81625e+03_r8,0.10741e+04_r8 /) + kbo(:, 4,31, 7) = (/ & + & 0.99782e+03_r8,0.76006e+03_r8,0.56058e+03_r8,0.81535e+03_r8,0.10731e+04_r8 /) + kbo(:, 5,31, 7) = (/ & + & 0.99772e+03_r8,0.75998e+03_r8,0.55958e+03_r8,0.81419e+03_r8,0.10717e+04_r8 /) + kbo(:, 1,32, 7) = (/ & + & 0.99774e+03_r8,0.76000e+03_r8,0.56222e+03_r8,0.81719e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,32, 7) = (/ & + & 0.99763e+03_r8,0.75991e+03_r8,0.56181e+03_r8,0.81675e+03_r8,0.10747e+04_r8 /) + kbo(:, 3,32, 7) = (/ & + & 0.99752e+03_r8,0.75984e+03_r8,0.56117e+03_r8,0.81604e+03_r8,0.10739e+04_r8 /) + kbo(:, 4,32, 7) = (/ & + & 0.99742e+03_r8,0.75976e+03_r8,0.56033e+03_r8,0.81507e+03_r8,0.10728e+04_r8 /) + kbo(:, 5,32, 7) = (/ & + & 0.99733e+03_r8,0.75970e+03_r8,0.55927e+03_r8,0.81384e+03_r8,0.10713e+04_r8 /) + kbo(:, 1,33, 7) = (/ & + & 0.99735e+03_r8,0.75971e+03_r8,0.56212e+03_r8,0.81709e+03_r8,0.10751e+04_r8 /) + kbo(:, 2,33, 7) = (/ & + & 0.99725e+03_r8,0.75964e+03_r8,0.56165e+03_r8,0.81658e+03_r8,0.10745e+04_r8 /) + kbo(:, 3,33, 7) = (/ & + & 0.99717e+03_r8,0.75957e+03_r8,0.56096e+03_r8,0.81581e+03_r8,0.10736e+04_r8 /) + kbo(:, 4,33, 7) = (/ & + & 0.99709e+03_r8,0.75952e+03_r8,0.56006e+03_r8,0.81477e+03_r8,0.10724e+04_r8 /) + kbo(:, 5,33, 7) = (/ & + & 0.99703e+03_r8,0.75946e+03_r8,0.55896e+03_r8,0.81347e+03_r8,0.10709e+04_r8 /) + kbo(:, 1,34, 7) = (/ & + & 0.99704e+03_r8,0.75947e+03_r8,0.56203e+03_r8,0.81702e+03_r8,0.10750e+04_r8 /) + kbo(:, 2,34, 7) = (/ & + & 0.99696e+03_r8,0.75942e+03_r8,0.56151e+03_r8,0.81642e+03_r8,0.10743e+04_r8 /) + kbo(:, 3,34, 7) = (/ & + & 0.99689e+03_r8,0.75937e+03_r8,0.56077e+03_r8,0.81558e+03_r8,0.10734e+04_r8 /) + kbo(:, 4,34, 7) = (/ & + & 0.99683e+03_r8,0.75932e+03_r8,0.55982e+03_r8,0.81449e+03_r8,0.10721e+04_r8 /) + kbo(:, 5,34, 7) = (/ & + & 0.99678e+03_r8,0.75928e+03_r8,0.55868e+03_r8,0.81314e+03_r8,0.10704e+04_r8 /) + kbo(:, 1,35, 7) = (/ & + & 0.99679e+03_r8,0.75929e+03_r8,0.56197e+03_r8,0.81693e+03_r8,0.10749e+04_r8 /) + kbo(:, 2,35, 7) = (/ & + & 0.99673e+03_r8,0.75925e+03_r8,0.56142e+03_r8,0.81633e+03_r8,0.10742e+04_r8 /) + kbo(:, 3,35, 7) = (/ & + & 0.99667e+03_r8,0.75920e+03_r8,0.56065e+03_r8,0.81545e+03_r8,0.10733e+04_r8 /) + kbo(:, 4,35, 7) = (/ & + & 0.99663e+03_r8,0.75916e+03_r8,0.55968e+03_r8,0.81434e+03_r8,0.10719e+04_r8 /) + kbo(:, 5,35, 7) = (/ & + & 0.99658e+03_r8,0.75913e+03_r8,0.55851e+03_r8,0.81294e+03_r8,0.10702e+04_r8 /) + kbo(:, 1,36, 7) = (/ & + & 0.99660e+03_r8,0.75914e+03_r8,0.56195e+03_r8,0.81692e+03_r8,0.10749e+04_r8 /) + kbo(:, 2,36, 7) = (/ & + & 0.99655e+03_r8,0.75911e+03_r8,0.56140e+03_r8,0.81631e+03_r8,0.10742e+04_r8 /) + kbo(:, 3,36, 7) = (/ & + & 0.99650e+03_r8,0.75907e+03_r8,0.56063e+03_r8,0.81543e+03_r8,0.10732e+04_r8 /) + kbo(:, 4,36, 7) = (/ & + & 0.99646e+03_r8,0.75904e+03_r8,0.55965e+03_r8,0.81430e+03_r8,0.10719e+04_r8 /) + kbo(:, 5,36, 7) = (/ & + & 0.99642e+03_r8,0.75901e+03_r8,0.55848e+03_r8,0.81290e+03_r8,0.10702e+04_r8 /) + kbo(:, 1,37, 7) = (/ & + & 0.99645e+03_r8,0.75903e+03_r8,0.56200e+03_r8,0.81697e+03_r8,0.10749e+04_r8 /) + kbo(:, 2,37, 7) = (/ & + & 0.99640e+03_r8,0.75900e+03_r8,0.56148e+03_r8,0.81640e+03_r8,0.10743e+04_r8 /) + kbo(:, 3,37, 7) = (/ & + & 0.99636e+03_r8,0.75897e+03_r8,0.56074e+03_r8,0.81556e+03_r8,0.10734e+04_r8 /) + kbo(:, 4,37, 7) = (/ & + & 0.99633e+03_r8,0.75894e+03_r8,0.55979e+03_r8,0.81446e+03_r8,0.10721e+04_r8 /) + kbo(:, 5,37, 7) = (/ & + & 0.99630e+03_r8,0.75892e+03_r8,0.55864e+03_r8,0.81313e+03_r8,0.10704e+04_r8 /) + kbo(:, 1,38, 7) = (/ & + & 0.99632e+03_r8,0.75894e+03_r8,0.56206e+03_r8,0.81703e+03_r8,0.10750e+04_r8 /) + kbo(:, 2,38, 7) = (/ & + & 0.99628e+03_r8,0.75891e+03_r8,0.56157e+03_r8,0.81650e+03_r8,0.10744e+04_r8 /) + kbo(:, 3,38, 7) = (/ & + & 0.99625e+03_r8,0.75889e+03_r8,0.56085e+03_r8,0.81569e+03_r8,0.10735e+04_r8 /) + kbo(:, 4,38, 7) = (/ & + & 0.99623e+03_r8,0.75887e+03_r8,0.55993e+03_r8,0.81464e+03_r8,0.10723e+04_r8 /) + kbo(:, 5,38, 7) = (/ & + & 0.99620e+03_r8,0.75885e+03_r8,0.55881e+03_r8,0.81331e+03_r8,0.10707e+04_r8 /) + kbo(:, 1,39, 7) = (/ & + & 0.99622e+03_r8,0.75886e+03_r8,0.56210e+03_r8,0.81708e+03_r8,0.10751e+04_r8 /) + kbo(:, 2,39, 7) = (/ & + & 0.99619e+03_r8,0.75884e+03_r8,0.56164e+03_r8,0.81666e+03_r8,0.10745e+04_r8 /) + kbo(:, 3,39, 7) = (/ & + & 0.99617e+03_r8,0.75882e+03_r8,0.56096e+03_r8,0.81582e+03_r8,0.10737e+04_r8 /) + kbo(:, 4,39, 7) = (/ & + & 0.99614e+03_r8,0.75880e+03_r8,0.56007e+03_r8,0.81479e+03_r8,0.10725e+04_r8 /) + kbo(:, 5,39, 7) = (/ & + & 0.99612e+03_r8,0.75878e+03_r8,0.55897e+03_r8,0.81351e+03_r8,0.10709e+04_r8 /) + kbo(:, 1,40, 7) = (/ & + & 0.99613e+03_r8,0.75880e+03_r8,0.56218e+03_r8,0.81716e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,40, 7) = (/ & + & 0.99611e+03_r8,0.75878e+03_r8,0.56177e+03_r8,0.81672e+03_r8,0.10747e+04_r8 /) + kbo(:, 3,40, 7) = (/ & + & 0.99609e+03_r8,0.75876e+03_r8,0.56114e+03_r8,0.81603e+03_r8,0.10739e+04_r8 /) + kbo(:, 4,40, 7) = (/ & + & 0.99607e+03_r8,0.75875e+03_r8,0.56030e+03_r8,0.81506e+03_r8,0.10728e+04_r8 /) + kbo(:, 5,40, 7) = (/ & + & 0.99605e+03_r8,0.75874e+03_r8,0.55925e+03_r8,0.81383e+03_r8,0.10713e+04_r8 /) + kbo(:, 1,41, 7) = (/ & + & 0.99606e+03_r8,0.75874e+03_r8,0.56225e+03_r8,0.81724e+03_r8,0.10752e+04_r8 /) + kbo(:, 2,41, 7) = (/ & + & 0.99604e+03_r8,0.75873e+03_r8,0.56189e+03_r8,0.81688e+03_r8,0.10748e+04_r8 /) + kbo(:, 3,41, 7) = (/ & + & 0.99602e+03_r8,0.75871e+03_r8,0.56132e+03_r8,0.81623e+03_r8,0.10741e+04_r8 /) + kbo(:, 4,41, 7) = (/ & + & 0.99601e+03_r8,0.75870e+03_r8,0.56053e+03_r8,0.81532e+03_r8,0.10731e+04_r8 /) + kbo(:, 5,41, 7) = (/ & + & 0.99600e+03_r8,0.75869e+03_r8,0.55954e+03_r8,0.81416e+03_r8,0.10717e+04_r8 /) + kbo(:, 1,42, 7) = (/ & + & 0.99601e+03_r8,0.75870e+03_r8,0.56231e+03_r8,0.81730e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,42, 7) = (/ & + & 0.99599e+03_r8,0.75869e+03_r8,0.56200e+03_r8,0.81698e+03_r8,0.10750e+04_r8 /) + kbo(:, 3,42, 7) = (/ & + & 0.99597e+03_r8,0.75868e+03_r8,0.56149e+03_r8,0.81641e+03_r8,0.10743e+04_r8 /) + kbo(:, 4,42, 7) = (/ & + & 0.99596e+03_r8,0.75867e+03_r8,0.56075e+03_r8,0.81559e+03_r8,0.10734e+04_r8 /) + kbo(:, 5,42, 7) = (/ & + & 0.99595e+03_r8,0.75866e+03_r8,0.55981e+03_r8,0.81449e+03_r8,0.10721e+04_r8 /) + kbo(:, 1,43, 7) = (/ & + & 0.99596e+03_r8,0.75867e+03_r8,0.56235e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,43, 7) = (/ & + & 0.99595e+03_r8,0.75866e+03_r8,0.56212e+03_r8,0.81712e+03_r8,0.10751e+04_r8 /) + kbo(:, 3,43, 7) = (/ & + & 0.99594e+03_r8,0.75865e+03_r8,0.56167e+03_r8,0.81662e+03_r8,0.10746e+04_r8 /) + kbo(:, 4,43, 7) = (/ & + & 0.99592e+03_r8,0.75864e+03_r8,0.56100e+03_r8,0.81588e+03_r8,0.10737e+04_r8 /) + kbo(:, 5,43, 7) = (/ & + & 0.99591e+03_r8,0.75863e+03_r8,0.56012e+03_r8,0.81487e+03_r8,0.10726e+04_r8 /) + kbo(:, 1,44, 7) = (/ & + & 0.99592e+03_r8,0.75864e+03_r8,0.56237e+03_r8,0.81736e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,44, 7) = (/ & + & 0.99591e+03_r8,0.75863e+03_r8,0.56222e+03_r8,0.81722e+03_r8,0.10752e+04_r8 /) + kbo(:, 3,44, 7) = (/ & + & 0.99591e+03_r8,0.75862e+03_r8,0.56184e+03_r8,0.81680e+03_r8,0.10748e+04_r8 /) + kbo(:, 4,44, 7) = (/ & + & 0.99589e+03_r8,0.75861e+03_r8,0.56125e+03_r8,0.81614e+03_r8,0.10741e+04_r8 /) + kbo(:, 5,44, 7) = (/ & + & 0.99588e+03_r8,0.75861e+03_r8,0.56044e+03_r8,0.81523e+03_r8,0.10730e+04_r8 /) + kbo(:, 1,45, 7) = (/ & + & 0.99589e+03_r8,0.75861e+03_r8,0.56237e+03_r8,0.81733e+03_r8,0.10754e+04_r8 /) + kbo(:, 2,45, 7) = (/ & + & 0.99588e+03_r8,0.75861e+03_r8,0.56230e+03_r8,0.81729e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,45, 7) = (/ & + & 0.99587e+03_r8,0.75860e+03_r8,0.56199e+03_r8,0.81699e+03_r8,0.10750e+04_r8 /) + kbo(:, 4,45, 7) = (/ & + & 0.99586e+03_r8,0.75859e+03_r8,0.56147e+03_r8,0.81641e+03_r8,0.10743e+04_r8 /) + kbo(:, 5,45, 7) = (/ & + & 0.99585e+03_r8,0.75859e+03_r8,0.56074e+03_r8,0.81557e+03_r8,0.10734e+04_r8 /) + kbo(:, 1,46, 7) = (/ & + & 0.99586e+03_r8,0.75859e+03_r8,0.56233e+03_r8,0.81728e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,46, 7) = (/ & + & 0.99585e+03_r8,0.75859e+03_r8,0.56235e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,46, 7) = (/ & + & 0.99585e+03_r8,0.75858e+03_r8,0.56213e+03_r8,0.81712e+03_r8,0.10751e+04_r8 /) + kbo(:, 4,46, 7) = (/ & + & 0.99584e+03_r8,0.75858e+03_r8,0.56169e+03_r8,0.81663e+03_r8,0.10746e+04_r8 /) + kbo(:, 5,46, 7) = (/ & + & 0.99583e+03_r8,0.75858e+03_r8,0.56103e+03_r8,0.81590e+03_r8,0.10738e+04_r8 /) + kbo(:, 1,47, 7) = (/ & + & 0.99585e+03_r8,0.75858e+03_r8,0.56226e+03_r8,0.81718e+03_r8,0.10753e+04_r8 /) + kbo(:, 2,47, 7) = (/ & + & 0.99583e+03_r8,0.75857e+03_r8,0.56237e+03_r8,0.81736e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,47, 7) = (/ & + & 0.99583e+03_r8,0.75857e+03_r8,0.56224e+03_r8,0.81723e+03_r8,0.10752e+04_r8 /) + kbo(:, 4,47, 7) = (/ & + & 0.99582e+03_r8,0.75856e+03_r8,0.56189e+03_r8,0.81686e+03_r8,0.10748e+04_r8 /) + kbo(:, 5,47, 7) = (/ & + & 0.99581e+03_r8,0.75856e+03_r8,0.56132e+03_r8,0.81626e+03_r8,0.10741e+04_r8 /) + kbo(:, 1,48, 7) = (/ & + & 0.99582e+03_r8,0.75856e+03_r8,0.56215e+03_r8,0.81703e+03_r8,0.10751e+04_r8 /) + kbo(:, 2,48, 7) = (/ & + & 0.99582e+03_r8,0.75856e+03_r8,0.56235e+03_r8,0.81732e+03_r8,0.10754e+04_r8 /) + kbo(:, 3,48, 7) = (/ & + & 0.99581e+03_r8,0.75855e+03_r8,0.56232e+03_r8,0.81733e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,48, 7) = (/ & + & 0.99580e+03_r8,0.75855e+03_r8,0.56206e+03_r8,0.81704e+03_r8,0.10750e+04_r8 /) + kbo(:, 5,48, 7) = (/ & + & 0.99580e+03_r8,0.75855e+03_r8,0.56157e+03_r8,0.81651e+03_r8,0.10744e+04_r8 /) + kbo(:, 1,49, 7) = (/ & + & 0.99581e+03_r8,0.75855e+03_r8,0.56199e+03_r8,0.81684e+03_r8,0.10748e+04_r8 /) + kbo(:, 2,49, 7) = (/ & + & 0.99580e+03_r8,0.75855e+03_r8,0.56230e+03_r8,0.81724e+03_r8,0.10753e+04_r8 /) + kbo(:, 3,49, 7) = (/ & + & 0.99580e+03_r8,0.75854e+03_r8,0.56236e+03_r8,0.81736e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,49, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56219e+03_r8,0.81718e+03_r8,0.10752e+04_r8 /) + kbo(:, 5,49, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56179e+03_r8,0.81678e+03_r8,0.10747e+04_r8 /) + kbo(:, 1,50, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56180e+03_r8,0.81662e+03_r8,0.10745e+04_r8 /) + kbo(:, 2,50, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56221e+03_r8,0.81713e+03_r8,0.10752e+04_r8 /) + kbo(:, 3,50, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56237e+03_r8,0.81735e+03_r8,0.10754e+04_r8 /) + kbo(:, 4,50, 7) = (/ & + & 0.99579e+03_r8,0.75854e+03_r8,0.56228e+03_r8,0.81728e+03_r8,0.10753e+04_r8 /) + kbo(:, 5,50, 7) = (/ & + & 0.99578e+03_r8,0.75853e+03_r8,0.56197e+03_r8,0.81695e+03_r8,0.10749e+04_r8 /) + kbo(:, 1,51, 7) = (/ & + & 0.99578e+03_r8,0.75853e+03_r8,0.56158e+03_r8,0.81637e+03_r8,0.10741e+04_r8 /) + kbo(:, 2,51, 7) = (/ & + & 0.99578e+03_r8,0.75853e+03_r8,0.56209e+03_r8,0.81697e+03_r8,0.10750e+04_r8 /) + kbo(:, 3,51, 7) = (/ & + & 0.99578e+03_r8,0.75853e+03_r8,0.56234e+03_r8,0.81729e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,51, 7) = (/ & + & 0.99578e+03_r8,0.75853e+03_r8,0.56234e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 5,51, 7) = (/ & + & 0.99577e+03_r8,0.75852e+03_r8,0.56211e+03_r8,0.81712e+03_r8,0.10751e+04_r8 /) + kbo(:, 1,52, 7) = (/ & + & 0.99577e+03_r8,0.75853e+03_r8,0.56131e+03_r8,0.81608e+03_r8,0.10737e+04_r8 /) + kbo(:, 2,52, 7) = (/ & + & 0.99577e+03_r8,0.75852e+03_r8,0.56194e+03_r8,0.81678e+03_r8,0.10748e+04_r8 /) + kbo(:, 3,52, 7) = (/ & + & 0.99577e+03_r8,0.75852e+03_r8,0.56228e+03_r8,0.81721e+03_r8,0.10753e+04_r8 /) + kbo(:, 4,52, 7) = (/ & + & 0.99577e+03_r8,0.75852e+03_r8,0.56237e+03_r8,0.81738e+03_r8,0.10754e+04_r8 /) + kbo(:, 5,52, 7) = (/ & + & 0.99576e+03_r8,0.75852e+03_r8,0.56222e+03_r8,0.81722e+03_r8,0.10752e+04_r8 /) + kbo(:, 1,53, 7) = (/ & + & 0.99577e+03_r8,0.75852e+03_r8,0.56102e+03_r8,0.81574e+03_r8,0.10731e+04_r8 /) + kbo(:, 2,53, 7) = (/ & + & 0.99576e+03_r8,0.75852e+03_r8,0.56174e+03_r8,0.81656e+03_r8,0.10744e+04_r8 /) + kbo(:, 3,53, 7) = (/ & + & 0.99576e+03_r8,0.75852e+03_r8,0.56218e+03_r8,0.81709e+03_r8,0.10752e+04_r8 /) + kbo(:, 4,53, 7) = (/ & + & 0.99576e+03_r8,0.75851e+03_r8,0.56236e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 5,53, 7) = (/ & + & 0.99576e+03_r8,0.75852e+03_r8,0.56230e+03_r8,0.81736e+03_r8,0.10753e+04_r8 /) + kbo(:, 1,54, 7) = (/ & + & 0.99576e+03_r8,0.75852e+03_r8,0.56072e+03_r8,0.81536e+03_r8,0.10726e+04_r8 /) + kbo(:, 2,54, 7) = (/ & + & 0.99576e+03_r8,0.75851e+03_r8,0.56153e+03_r8,0.81633e+03_r8,0.10740e+04_r8 /) + kbo(:, 3,54, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56207e+03_r8,0.81694e+03_r8,0.10750e+04_r8 /) + kbo(:, 4,54, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56233e+03_r8,0.81728e+03_r8,0.10753e+04_r8 /) + kbo(:, 5,54, 7) = (/ & + & 0.99576e+03_r8,0.75851e+03_r8,0.56235e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 1,55, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56039e+03_r8,0.81495e+03_r8,0.10720e+04_r8 /) + kbo(:, 2,55, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56128e+03_r8,0.81606e+03_r8,0.10736e+04_r8 /) + kbo(:, 3,55, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56193e+03_r8,0.81677e+03_r8,0.10747e+04_r8 /) + kbo(:, 4,55, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56227e+03_r8,0.81720e+03_r8,0.10753e+04_r8 /) + kbo(:, 5,55, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56237e+03_r8,0.81736e+03_r8,0.10754e+04_r8 /) + kbo(:, 1,56, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56002e+03_r8,0.81448e+03_r8,0.10713e+04_r8 /) + kbo(:, 2,56, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56104e+03_r8,0.81576e+03_r8,0.10732e+04_r8 /) + kbo(:, 3,56, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.56175e+03_r8,0.81659e+03_r8,0.10744e+04_r8 /) + kbo(:, 4,56, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56219e+03_r8,0.81709e+03_r8,0.10752e+04_r8 /) + kbo(:, 5,56, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56236e+03_r8,0.81734e+03_r8,0.10754e+04_r8 /) + kbo(:, 1,57, 7) = (/ & + & 0.99575e+03_r8,0.75851e+03_r8,0.55963e+03_r8,0.81395e+03_r8,0.10705e+04_r8 /) + kbo(:, 2,57, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56076e+03_r8,0.81540e+03_r8,0.10727e+04_r8 /) + kbo(:, 3,57, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56157e+03_r8,0.81635e+03_r8,0.10741e+04_r8 /) + kbo(:, 4,57, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56208e+03_r8,0.81696e+03_r8,0.10750e+04_r8 /) + kbo(:, 5,57, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56234e+03_r8,0.81729e+03_r8,0.10754e+04_r8 /) + kbo(:, 1,58, 7) = (/ & + & 0.99575e+03_r8,0.75850e+03_r8,0.55922e+03_r8,0.81340e+03_r8,0.10697e+04_r8 /) + kbo(:, 2,58, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56044e+03_r8,0.81503e+03_r8,0.10721e+04_r8 /) + kbo(:, 3,58, 7) = (/ & + & 0.99574e+03_r8,0.75851e+03_r8,0.56134e+03_r8,0.81611e+03_r8,0.10737e+04_r8 /) + kbo(:, 4,58, 7) = (/ & + & 0.99574e+03_r8,0.75851e+03_r8,0.56195e+03_r8,0.81681e+03_r8,0.10748e+04_r8 /) + kbo(:, 5,58, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56228e+03_r8,0.81722e+03_r8,0.10753e+04_r8 /) + kbo(:, 1,59, 7) = (/ & + & 0.99575e+03_r8,0.75850e+03_r8,0.55905e+03_r8,0.81317e+03_r8,0.10694e+04_r8 /) + kbo(:, 2,59, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56032e+03_r8,0.81485e+03_r8,0.10718e+04_r8 /) + kbo(:, 3,59, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56125e+03_r8,0.81601e+03_r8,0.10735e+04_r8 /) + kbo(:, 4,59, 7) = (/ & + & 0.99574e+03_r8,0.75850e+03_r8,0.56189e+03_r8,0.81673e+03_r8,0.10747e+04_r8 /) + kbo(:, 5,59, 7) = (/ & + & 0.99573e+03_r8,0.75850e+03_r8,0.56225e+03_r8,0.81718e+03_r8,0.10753e+04_r8 /) + kbo(:, 1,13, 8) = (/ & + & 0.11451e+04_r8,0.86748e+03_r8,0.59259e+03_r8,0.85187e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,13, 8) = (/ & + & 0.11363e+04_r8,0.86085e+03_r8,0.58896e+03_r8,0.85188e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,13, 8) = (/ & + & 0.11286e+04_r8,0.85515e+03_r8,0.58586e+03_r8,0.85170e+03_r8,0.11227e+04_r8 /) + kbo(:, 4,13, 8) = (/ & + & 0.11220e+04_r8,0.85016e+03_r8,0.58378e+03_r8,0.85132e+03_r8,0.11224e+04_r8 /) + kbo(:, 5,13, 8) = (/ & + & 0.11162e+04_r8,0.84582e+03_r8,0.58229e+03_r8,0.85074e+03_r8,0.11218e+04_r8 /) + kbo(:, 1,14, 8) = (/ & + & 0.11230e+04_r8,0.85087e+03_r8,0.58392e+03_r8,0.85168e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,14, 8) = (/ & + & 0.11158e+04_r8,0.84552e+03_r8,0.58280e+03_r8,0.85169e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,14, 8) = (/ & + & 0.11097e+04_r8,0.84090e+03_r8,0.58233e+03_r8,0.85151e+03_r8,0.11227e+04_r8 /) + kbo(:, 4,14, 8) = (/ & + & 0.11043e+04_r8,0.83689e+03_r8,0.58194e+03_r8,0.85113e+03_r8,0.11223e+04_r8 /) + kbo(:, 5,14, 8) = (/ & + & 0.10996e+04_r8,0.83336e+03_r8,0.58140e+03_r8,0.85052e+03_r8,0.11217e+04_r8 /) + kbo(:, 1,15, 8) = (/ & + & 0.11049e+04_r8,0.83731e+03_r8,0.58207e+03_r8,0.85153e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,15, 8) = (/ & + & 0.10991e+04_r8,0.83301e+03_r8,0.58217e+03_r8,0.85153e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,15, 8) = (/ & + & 0.10942e+04_r8,0.82928e+03_r8,0.58200e+03_r8,0.85134e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,15, 8) = (/ & + & 0.10899e+04_r8,0.82605e+03_r8,0.58161e+03_r8,0.85094e+03_r8,0.11223e+04_r8 /) + kbo(:, 5,15, 8) = (/ & + & 0.10860e+04_r8,0.82320e+03_r8,0.58108e+03_r8,0.85034e+03_r8,0.11216e+04_r8 /) + kbo(:, 1,16, 8) = (/ & + & 0.10902e+04_r8,0.82630e+03_r8,0.58181e+03_r8,0.85141e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,16, 8) = (/ & + & 0.10856e+04_r8,0.82283e+03_r8,0.58190e+03_r8,0.85139e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,16, 8) = (/ & + & 0.10816e+04_r8,0.81983e+03_r8,0.58172e+03_r8,0.85119e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,16, 8) = (/ & + & 0.10781e+04_r8,0.81721e+03_r8,0.58133e+03_r8,0.85078e+03_r8,0.11222e+04_r8 /) + kbo(:, 5,16, 8) = (/ & + & 0.10750e+04_r8,0.81491e+03_r8,0.58080e+03_r8,0.85015e+03_r8,0.11215e+04_r8 /) + kbo(:, 1,17, 8) = (/ & + & 0.10783e+04_r8,0.81738e+03_r8,0.58160e+03_r8,0.85131e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,17, 8) = (/ & + & 0.10746e+04_r8,0.81457e+03_r8,0.58168e+03_r8,0.85129e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,17, 8) = (/ & + & 0.10713e+04_r8,0.81215e+03_r8,0.58149e+03_r8,0.85108e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,17, 8) = (/ & + & 0.10685e+04_r8,0.81004e+03_r8,0.58109e+03_r8,0.85064e+03_r8,0.11222e+04_r8 /) + kbo(:, 5,17, 8) = (/ & + & 0.10660e+04_r8,0.80818e+03_r8,0.58056e+03_r8,0.85000e+03_r8,0.11214e+04_r8 /) + kbo(:, 1,18, 8) = (/ & + & 0.10686e+04_r8,0.81013e+03_r8,0.58144e+03_r8,0.85124e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,18, 8) = (/ & + & 0.10656e+04_r8,0.80786e+03_r8,0.58150e+03_r8,0.85119e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,18, 8) = (/ & + & 0.10630e+04_r8,0.80591e+03_r8,0.58129e+03_r8,0.85095e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,18, 8) = (/ & + & 0.10607e+04_r8,0.80419e+03_r8,0.58089e+03_r8,0.85052e+03_r8,0.11221e+04_r8 /) + kbo(:, 5,18, 8) = (/ & + & 0.10587e+04_r8,0.80269e+03_r8,0.58036e+03_r8,0.84984e+03_r8,0.11213e+04_r8 /) + kbo(:, 1,19, 8) = (/ & + & 0.10608e+04_r8,0.80424e+03_r8,0.58130e+03_r8,0.85117e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,19, 8) = (/ & + & 0.10584e+04_r8,0.80242e+03_r8,0.58135e+03_r8,0.85109e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,19, 8) = (/ & + & 0.10562e+04_r8,0.80084e+03_r8,0.58113e+03_r8,0.85087e+03_r8,0.11225e+04_r8 /) + kbo(:, 4,19, 8) = (/ & + & 0.10544e+04_r8,0.79946e+03_r8,0.58072e+03_r8,0.85040e+03_r8,0.11220e+04_r8 /) + kbo(:, 5,19, 8) = (/ & + & 0.10528e+04_r8,0.79825e+03_r8,0.58019e+03_r8,0.84971e+03_r8,0.11212e+04_r8 /) + kbo(:, 1,20, 8) = (/ & + & 0.10544e+04_r8,0.79943e+03_r8,0.58120e+03_r8,0.85111e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,20, 8) = (/ & + & 0.10524e+04_r8,0.79797e+03_r8,0.58122e+03_r8,0.85103e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,20, 8) = (/ & + & 0.10507e+04_r8,0.79669e+03_r8,0.58098e+03_r8,0.85078e+03_r8,0.11225e+04_r8 /) + kbo(:, 4,20, 8) = (/ & + & 0.10492e+04_r8,0.79558e+03_r8,0.58056e+03_r8,0.85028e+03_r8,0.11220e+04_r8 /) + kbo(:, 5,20, 8) = (/ & + & 0.10479e+04_r8,0.79460e+03_r8,0.58002e+03_r8,0.84958e+03_r8,0.11211e+04_r8 /) + kbo(:, 1,21, 8) = (/ & + & 0.10492e+04_r8,0.79553e+03_r8,0.58112e+03_r8,0.85107e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,21, 8) = (/ & + & 0.10476e+04_r8,0.79436e+03_r8,0.58112e+03_r8,0.85096e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,21, 8) = (/ & + & 0.10462e+04_r8,0.79334e+03_r8,0.58085e+03_r8,0.85069e+03_r8,0.11224e+04_r8 /) + kbo(:, 4,21, 8) = (/ & + & 0.10450e+04_r8,0.79243e+03_r8,0.58042e+03_r8,0.85021e+03_r8,0.11219e+04_r8 /) + kbo(:, 5,21, 8) = (/ & + & 0.10440e+04_r8,0.79165e+03_r8,0.57987e+03_r8,0.84945e+03_r8,0.11210e+04_r8 /) + kbo(:, 1,22, 8) = (/ & + & 0.10449e+04_r8,0.79230e+03_r8,0.58106e+03_r8,0.85103e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,22, 8) = (/ & + & 0.10436e+04_r8,0.79136e+03_r8,0.58100e+03_r8,0.85090e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,22, 8) = (/ & + & 0.10425e+04_r8,0.79054e+03_r8,0.58071e+03_r8,0.85058e+03_r8,0.11224e+04_r8 /) + kbo(:, 4,22, 8) = (/ & + & 0.10416e+04_r8,0.78983e+03_r8,0.58026e+03_r8,0.85002e+03_r8,0.11217e+04_r8 /) + kbo(:, 5,22, 8) = (/ & + & 0.10407e+04_r8,0.78921e+03_r8,0.57969e+03_r8,0.84925e+03_r8,0.11208e+04_r8 /) + kbo(:, 1,23, 8) = (/ & + & 0.10414e+04_r8,0.78969e+03_r8,0.58100e+03_r8,0.85099e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,23, 8) = (/ & + & 0.10404e+04_r8,0.78894e+03_r8,0.58090e+03_r8,0.85083e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,23, 8) = (/ & + & 0.10395e+04_r8,0.78829e+03_r8,0.58058e+03_r8,0.85047e+03_r8,0.11223e+04_r8 /) + kbo(:, 4,23, 8) = (/ & + & 0.10387e+04_r8,0.78772e+03_r8,0.58011e+03_r8,0.84989e+03_r8,0.11216e+04_r8 /) + kbo(:, 5,23, 8) = (/ & + & 0.10381e+04_r8,0.78721e+03_r8,0.57952e+03_r8,0.84905e+03_r8,0.11206e+04_r8 /) + kbo(:, 1,24, 8) = (/ & + & 0.10386e+04_r8,0.78759e+03_r8,0.58095e+03_r8,0.85095e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,24, 8) = (/ & + & 0.10378e+04_r8,0.78698e+03_r8,0.58081e+03_r8,0.85075e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,24, 8) = (/ & + & 0.10371e+04_r8,0.78646e+03_r8,0.58046e+03_r8,0.85035e+03_r8,0.11222e+04_r8 /) + kbo(:, 4,24, 8) = (/ & + & 0.10365e+04_r8,0.78601e+03_r8,0.57995e+03_r8,0.84971e+03_r8,0.11214e+04_r8 /) + kbo(:, 5,24, 8) = (/ & + & 0.10359e+04_r8,0.78561e+03_r8,0.57934e+03_r8,0.84885e+03_r8,0.11203e+04_r8 /) + kbo(:, 1,25, 8) = (/ & + & 0.10363e+04_r8,0.78588e+03_r8,0.58090e+03_r8,0.85090e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,25, 8) = (/ & + & 0.10357e+04_r8,0.78541e+03_r8,0.58070e+03_r8,0.85067e+03_r8,0.11225e+04_r8 /) + kbo(:, 3,25, 8) = (/ & + & 0.10351e+04_r8,0.78498e+03_r8,0.58032e+03_r8,0.85020e+03_r8,0.11220e+04_r8 /) + kbo(:, 4,25, 8) = (/ & + & 0.10346e+04_r8,0.78461e+03_r8,0.57980e+03_r8,0.84953e+03_r8,0.11212e+04_r8 /) + kbo(:, 5,25, 8) = (/ & + & 0.10342e+04_r8,0.78430e+03_r8,0.57916e+03_r8,0.84863e+03_r8,0.11201e+04_r8 /) + kbo(:, 1,26, 8) = (/ & + & 0.10345e+04_r8,0.78450e+03_r8,0.58084e+03_r8,0.85084e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,26, 8) = (/ & + & 0.10339e+04_r8,0.78411e+03_r8,0.58059e+03_r8,0.85057e+03_r8,0.11224e+04_r8 /) + kbo(:, 3,26, 8) = (/ & + & 0.10335e+04_r8,0.78378e+03_r8,0.58018e+03_r8,0.85004e+03_r8,0.11219e+04_r8 /) + kbo(:, 4,26, 8) = (/ & + & 0.10331e+04_r8,0.78349e+03_r8,0.57964e+03_r8,0.84934e+03_r8,0.11210e+04_r8 /) + kbo(:, 5,26, 8) = (/ & + & 0.10328e+04_r8,0.78323e+03_r8,0.57897e+03_r8,0.84838e+03_r8,0.11198e+04_r8 /) + kbo(:, 1,27, 8) = (/ & + & 0.10329e+04_r8,0.78338e+03_r8,0.58078e+03_r8,0.85078e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,27, 8) = (/ & + & 0.10326e+04_r8,0.78307e+03_r8,0.58048e+03_r8,0.85045e+03_r8,0.11223e+04_r8 /) + kbo(:, 3,27, 8) = (/ & + & 0.10322e+04_r8,0.78282e+03_r8,0.58003e+03_r8,0.84982e+03_r8,0.11217e+04_r8 /) + kbo(:, 4,27, 8) = (/ & + & 0.10319e+04_r8,0.78258e+03_r8,0.57947e+03_r8,0.84907e+03_r8,0.11207e+04_r8 /) + kbo(:, 5,27, 8) = (/ & + & 0.10316e+04_r8,0.78237e+03_r8,0.57877e+03_r8,0.84811e+03_r8,0.11194e+04_r8 /) + kbo(:, 1,28, 8) = (/ & + & 0.10318e+04_r8,0.78248e+03_r8,0.58069e+03_r8,0.85072e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,28, 8) = (/ & + & 0.10314e+04_r8,0.78225e+03_r8,0.58037e+03_r8,0.85030e+03_r8,0.11222e+04_r8 /) + kbo(:, 3,28, 8) = (/ & + & 0.10312e+04_r8,0.78205e+03_r8,0.57989e+03_r8,0.84960e+03_r8,0.11215e+04_r8 /) + kbo(:, 4,28, 8) = (/ & + & 0.10309e+04_r8,0.78185e+03_r8,0.57929e+03_r8,0.84888e+03_r8,0.11204e+04_r8 /) + kbo(:, 5,28, 8) = (/ & + & 0.10307e+04_r8,0.78168e+03_r8,0.57856e+03_r8,0.84784e+03_r8,0.11191e+04_r8 /) + kbo(:, 1,29, 8) = (/ & + & 0.10308e+04_r8,0.78175e+03_r8,0.58061e+03_r8,0.85062e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,29, 8) = (/ & + & 0.10305e+04_r8,0.78157e+03_r8,0.58024e+03_r8,0.85019e+03_r8,0.11221e+04_r8 /) + kbo(:, 3,29, 8) = (/ & + & 0.10303e+04_r8,0.78140e+03_r8,0.57974e+03_r8,0.84950e+03_r8,0.11213e+04_r8 /) + kbo(:, 4,29, 8) = (/ & + & 0.10301e+04_r8,0.78126e+03_r8,0.57911e+03_r8,0.84863e+03_r8,0.11201e+04_r8 /) + kbo(:, 5,29, 8) = (/ & + & 0.10300e+04_r8,0.78112e+03_r8,0.57834e+03_r8,0.84752e+03_r8,0.11188e+04_r8 /) + kbo(:, 1,30, 8) = (/ & + & 0.10300e+04_r8,0.78117e+03_r8,0.58052e+03_r8,0.85055e+03_r8,0.11224e+04_r8 /) + kbo(:, 2,30, 8) = (/ & + & 0.10298e+04_r8,0.78102e+03_r8,0.58011e+03_r8,0.85001e+03_r8,0.11219e+04_r8 /) + kbo(:, 3,30, 8) = (/ & + & 0.10296e+04_r8,0.78089e+03_r8,0.57958e+03_r8,0.84932e+03_r8,0.11210e+04_r8 /) + kbo(:, 4,30, 8) = (/ & + & 0.10295e+04_r8,0.78077e+03_r8,0.57892e+03_r8,0.84838e+03_r8,0.11198e+04_r8 /) + kbo(:, 5,30, 8) = (/ & + & 0.10294e+04_r8,0.78066e+03_r8,0.57811e+03_r8,0.84720e+03_r8,0.11184e+04_r8 /) + kbo(:, 1,31, 8) = (/ & + & 0.10294e+04_r8,0.78070e+03_r8,0.58042e+03_r8,0.85041e+03_r8,0.11223e+04_r8 /) + kbo(:, 2,31, 8) = (/ & + & 0.10292e+04_r8,0.78058e+03_r8,0.57998e+03_r8,0.84985e+03_r8,0.11217e+04_r8 /) + kbo(:, 3,31, 8) = (/ & + & 0.10291e+04_r8,0.78049e+03_r8,0.57941e+03_r8,0.84908e+03_r8,0.11207e+04_r8 /) + kbo(:, 4,31, 8) = (/ & + & 0.10290e+04_r8,0.78039e+03_r8,0.57872e+03_r8,0.84808e+03_r8,0.11195e+04_r8 /) + kbo(:, 5,31, 8) = (/ & + & 0.10289e+04_r8,0.78030e+03_r8,0.57786e+03_r8,0.84686e+03_r8,0.11179e+04_r8 /) + kbo(:, 1,32, 8) = (/ & + & 0.10289e+04_r8,0.78033e+03_r8,0.58031e+03_r8,0.85030e+03_r8,0.11222e+04_r8 /) + kbo(:, 2,32, 8) = (/ & + & 0.10288e+04_r8,0.78024e+03_r8,0.57984e+03_r8,0.84967e+03_r8,0.11215e+04_r8 /) + kbo(:, 3,32, 8) = (/ & + & 0.10287e+04_r8,0.78016e+03_r8,0.57924e+03_r8,0.84884e+03_r8,0.11204e+04_r8 /) + kbo(:, 4,32, 8) = (/ & + & 0.10286e+04_r8,0.78009e+03_r8,0.57851e+03_r8,0.84778e+03_r8,0.11191e+04_r8 /) + kbo(:, 5,32, 8) = (/ & + & 0.10285e+04_r8,0.78000e+03_r8,0.57759e+03_r8,0.84651e+03_r8,0.11175e+04_r8 /) + kbo(:, 1,33, 8) = (/ & + & 0.10285e+04_r8,0.78003e+03_r8,0.58019e+03_r8,0.85016e+03_r8,0.11220e+04_r8 /) + kbo(:, 2,33, 8) = (/ & + & 0.10284e+04_r8,0.77995e+03_r8,0.57968e+03_r8,0.84947e+03_r8,0.11212e+04_r8 /) + kbo(:, 3,33, 8) = (/ & + & 0.10283e+04_r8,0.77988e+03_r8,0.57905e+03_r8,0.84858e+03_r8,0.11201e+04_r8 /) + kbo(:, 4,33, 8) = (/ & + & 0.10282e+04_r8,0.77982e+03_r8,0.57829e+03_r8,0.84747e+03_r8,0.11187e+04_r8 /) + kbo(:, 5,33, 8) = (/ & + & 0.10282e+04_r8,0.77978e+03_r8,0.57730e+03_r8,0.84615e+03_r8,0.11170e+04_r8 /) + kbo(:, 1,34, 8) = (/ & + & 0.10282e+04_r8,0.77978e+03_r8,0.58008e+03_r8,0.84998e+03_r8,0.11219e+04_r8 /) + kbo(:, 2,34, 8) = (/ & + & 0.10281e+04_r8,0.77972e+03_r8,0.57954e+03_r8,0.84930e+03_r8,0.11210e+04_r8 /) + kbo(:, 3,34, 8) = (/ & + & 0.10280e+04_r8,0.77967e+03_r8,0.57889e+03_r8,0.84836e+03_r8,0.11198e+04_r8 /) + kbo(:, 4,34, 8) = (/ & + & 0.10280e+04_r8,0.77962e+03_r8,0.57808e+03_r8,0.84718e+03_r8,0.11184e+04_r8 /) + kbo(:, 5,34, 8) = (/ & + & 0.10279e+04_r8,0.77958e+03_r8,0.57705e+03_r8,0.84582e+03_r8,0.11166e+04_r8 /) + kbo(:, 1,35, 8) = (/ & + & 0.10279e+04_r8,0.77958e+03_r8,0.58001e+03_r8,0.84995e+03_r8,0.11218e+04_r8 /) + kbo(:, 2,35, 8) = (/ & + & 0.10278e+04_r8,0.77953e+03_r8,0.57946e+03_r8,0.84916e+03_r8,0.11209e+04_r8 /) + kbo(:, 3,35, 8) = (/ & + & 0.10278e+04_r8,0.77951e+03_r8,0.57880e+03_r8,0.84823e+03_r8,0.11196e+04_r8 /) + kbo(:, 4,35, 8) = (/ & + & 0.10277e+04_r8,0.77946e+03_r8,0.57796e+03_r8,0.84701e+03_r8,0.11181e+04_r8 /) + kbo(:, 5,35, 8) = (/ & + & 0.10277e+04_r8,0.77943e+03_r8,0.57689e+03_r8,0.84563e+03_r8,0.11163e+04_r8 /) + kbo(:, 1,36, 8) = (/ & + & 0.10277e+04_r8,0.77944e+03_r8,0.58000e+03_r8,0.84992e+03_r8,0.11218e+04_r8 /) + kbo(:, 2,36, 8) = (/ & + & 0.10277e+04_r8,0.77940e+03_r8,0.57944e+03_r8,0.84917e+03_r8,0.11208e+04_r8 /) + kbo(:, 3,36, 8) = (/ & + & 0.10276e+04_r8,0.77936e+03_r8,0.57877e+03_r8,0.84819e+03_r8,0.11196e+04_r8 /) + kbo(:, 4,36, 8) = (/ & + & 0.10276e+04_r8,0.77933e+03_r8,0.57793e+03_r8,0.84697e+03_r8,0.11181e+04_r8 /) + kbo(:, 5,36, 8) = (/ & + & 0.10275e+04_r8,0.77931e+03_r8,0.57686e+03_r8,0.84561e+03_r8,0.11162e+04_r8 /) + kbo(:, 1,37, 8) = (/ & + & 0.10275e+04_r8,0.77932e+03_r8,0.58006e+03_r8,0.85002e+03_r8,0.11219e+04_r8 /) + kbo(:, 2,37, 8) = (/ & + & 0.10275e+04_r8,0.77929e+03_r8,0.57952e+03_r8,0.84927e+03_r8,0.11210e+04_r8 /) + kbo(:, 3,37, 8) = (/ & + & 0.10275e+04_r8,0.77926e+03_r8,0.57886e+03_r8,0.84832e+03_r8,0.11198e+04_r8 /) + kbo(:, 4,37, 8) = (/ & + & 0.10274e+04_r8,0.77924e+03_r8,0.57805e+03_r8,0.84715e+03_r8,0.11183e+04_r8 /) + kbo(:, 5,37, 8) = (/ & + & 0.10274e+04_r8,0.77921e+03_r8,0.57701e+03_r8,0.84575e+03_r8,0.11165e+04_r8 /) + kbo(:, 1,38, 8) = (/ & + & 0.10274e+04_r8,0.77922e+03_r8,0.58012e+03_r8,0.85009e+03_r8,0.11220e+04_r8 /) + kbo(:, 2,38, 8) = (/ & + & 0.10274e+04_r8,0.77920e+03_r8,0.57959e+03_r8,0.84938e+03_r8,0.11211e+04_r8 /) + kbo(:, 3,38, 8) = (/ & + & 0.10274e+04_r8,0.77918e+03_r8,0.57896e+03_r8,0.84848e+03_r8,0.11200e+04_r8 /) + kbo(:, 4,38, 8) = (/ & + & 0.10273e+04_r8,0.77915e+03_r8,0.57818e+03_r8,0.84731e+03_r8,0.11185e+04_r8 /) + kbo(:, 5,38, 8) = (/ & + & 0.10273e+04_r8,0.77912e+03_r8,0.57716e+03_r8,0.84599e+03_r8,0.11168e+04_r8 /) + kbo(:, 1,39, 8) = (/ & + & 0.10273e+04_r8,0.77914e+03_r8,0.58018e+03_r8,0.85016e+03_r8,0.11221e+04_r8 /) + kbo(:, 2,39, 8) = (/ & + & 0.10273e+04_r8,0.77912e+03_r8,0.57968e+03_r8,0.84939e+03_r8,0.11213e+04_r8 /) + kbo(:, 3,39, 8) = (/ & + & 0.10273e+04_r8,0.77911e+03_r8,0.57905e+03_r8,0.84861e+03_r8,0.11201e+04_r8 /) + kbo(:, 4,39, 8) = (/ & + & 0.10272e+04_r8,0.77910e+03_r8,0.57829e+03_r8,0.84750e+03_r8,0.11187e+04_r8 /) + kbo(:, 5,39, 8) = (/ & + & 0.10272e+04_r8,0.77907e+03_r8,0.57732e+03_r8,0.84617e+03_r8,0.11171e+04_r8 /) + kbo(:, 1,40, 8) = (/ & + & 0.10272e+04_r8,0.77908e+03_r8,0.58028e+03_r8,0.85029e+03_r8,0.11222e+04_r8 /) + kbo(:, 2,40, 8) = (/ & + & 0.10272e+04_r8,0.77906e+03_r8,0.57981e+03_r8,0.84968e+03_r8,0.11215e+04_r8 /) + kbo(:, 3,40, 8) = (/ & + & 0.10272e+04_r8,0.77904e+03_r8,0.57922e+03_r8,0.84885e+03_r8,0.11204e+04_r8 /) + kbo(:, 4,40, 8) = (/ & + & 0.10272e+04_r8,0.77904e+03_r8,0.57849e+03_r8,0.84779e+03_r8,0.11191e+04_r8 /) + kbo(:, 5,40, 8) = (/ & + & 0.10272e+04_r8,0.77901e+03_r8,0.57757e+03_r8,0.84651e+03_r8,0.11176e+04_r8 /) + kbo(:, 1,41, 8) = (/ & + & 0.10272e+04_r8,0.77903e+03_r8,0.58037e+03_r8,0.85041e+03_r8,0.11224e+04_r8 /) + kbo(:, 2,41, 8) = (/ & + & 0.10272e+04_r8,0.77902e+03_r8,0.57994e+03_r8,0.84983e+03_r8,0.11217e+04_r8 /) + kbo(:, 3,41, 8) = (/ & + & 0.10271e+04_r8,0.77900e+03_r8,0.57937e+03_r8,0.84906e+03_r8,0.11207e+04_r8 /) + kbo(:, 4,41, 8) = (/ & + & 0.10271e+04_r8,0.77898e+03_r8,0.57870e+03_r8,0.84808e+03_r8,0.11195e+04_r8 /) + kbo(:, 5,41, 8) = (/ & + & 0.10271e+04_r8,0.77898e+03_r8,0.57782e+03_r8,0.84685e+03_r8,0.11180e+04_r8 /) + kbo(:, 1,42, 8) = (/ & + & 0.10271e+04_r8,0.77900e+03_r8,0.58046e+03_r8,0.85051e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,42, 8) = (/ & + & 0.10271e+04_r8,0.77898e+03_r8,0.58006e+03_r8,0.85002e+03_r8,0.11219e+04_r8 /) + kbo(:, 3,42, 8) = (/ & + & 0.10271e+04_r8,0.77896e+03_r8,0.57953e+03_r8,0.84930e+03_r8,0.11210e+04_r8 /) + kbo(:, 4,42, 8) = (/ & + & 0.10271e+04_r8,0.77895e+03_r8,0.57888e+03_r8,0.84835e+03_r8,0.11198e+04_r8 /) + kbo(:, 5,42, 8) = (/ & + & 0.10270e+04_r8,0.77894e+03_r8,0.57806e+03_r8,0.84718e+03_r8,0.11184e+04_r8 /) + kbo(:, 1,43, 8) = (/ & + & 0.10271e+04_r8,0.77895e+03_r8,0.58056e+03_r8,0.85062e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,43, 8) = (/ & + & 0.10270e+04_r8,0.77895e+03_r8,0.58020e+03_r8,0.85017e+03_r8,0.11221e+04_r8 /) + kbo(:, 3,43, 8) = (/ & + & 0.10270e+04_r8,0.77892e+03_r8,0.57970e+03_r8,0.84954e+03_r8,0.11213e+04_r8 /) + kbo(:, 4,43, 8) = (/ & + & 0.10270e+04_r8,0.77892e+03_r8,0.57909e+03_r8,0.84866e+03_r8,0.11202e+04_r8 /) + kbo(:, 5,43, 8) = (/ & + & 0.10270e+04_r8,0.77891e+03_r8,0.57834e+03_r8,0.84756e+03_r8,0.11188e+04_r8 /) + kbo(:, 1,44, 8) = (/ & + & 0.10270e+04_r8,0.77892e+03_r8,0.58064e+03_r8,0.85071e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,44, 8) = (/ & + & 0.10270e+04_r8,0.77891e+03_r8,0.58034e+03_r8,0.85036e+03_r8,0.11223e+04_r8 /) + kbo(:, 3,44, 8) = (/ & + & 0.10270e+04_r8,0.77891e+03_r8,0.57988e+03_r8,0.84979e+03_r8,0.11216e+04_r8 /) + kbo(:, 4,44, 8) = (/ & + & 0.10270e+04_r8,0.77890e+03_r8,0.57931e+03_r8,0.84899e+03_r8,0.11206e+04_r8 /) + kbo(:, 5,44, 8) = (/ & + & 0.10270e+04_r8,0.77888e+03_r8,0.57861e+03_r8,0.84797e+03_r8,0.11193e+04_r8 /) + kbo(:, 1,45, 8) = (/ & + & 0.10270e+04_r8,0.77889e+03_r8,0.58069e+03_r8,0.85078e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,45, 8) = (/ & + & 0.10270e+04_r8,0.77888e+03_r8,0.58047e+03_r8,0.85051e+03_r8,0.11224e+04_r8 /) + kbo(:, 3,45, 8) = (/ & + & 0.10270e+04_r8,0.77888e+03_r8,0.58005e+03_r8,0.84999e+03_r8,0.11219e+04_r8 /) + kbo(:, 4,45, 8) = (/ & + & 0.10270e+04_r8,0.77888e+03_r8,0.57952e+03_r8,0.84927e+03_r8,0.11210e+04_r8 /) + kbo(:, 5,45, 8) = (/ & + & 0.10269e+04_r8,0.77886e+03_r8,0.57890e+03_r8,0.84837e+03_r8,0.11198e+04_r8 /) + kbo(:, 1,46, 8) = (/ & + & 0.10270e+04_r8,0.77887e+03_r8,0.58072e+03_r8,0.85082e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,46, 8) = (/ & + & 0.10270e+04_r8,0.77886e+03_r8,0.58056e+03_r8,0.85063e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,46, 8) = (/ & + & 0.10269e+04_r8,0.77886e+03_r8,0.58022e+03_r8,0.85021e+03_r8,0.11221e+04_r8 /) + kbo(:, 4,46, 8) = (/ & + & 0.10270e+04_r8,0.77885e+03_r8,0.57972e+03_r8,0.84957e+03_r8,0.11213e+04_r8 /) + kbo(:, 5,46, 8) = (/ & + & 0.10269e+04_r8,0.77884e+03_r8,0.57911e+03_r8,0.84871e+03_r8,0.11203e+04_r8 /) + kbo(:, 1,47, 8) = (/ & + & 0.10269e+04_r8,0.77885e+03_r8,0.58070e+03_r8,0.85086e+03_r8,0.11227e+04_r8 /) + kbo(:, 2,47, 8) = (/ & + & 0.10269e+04_r8,0.77886e+03_r8,0.58066e+03_r8,0.85073e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,47, 8) = (/ & + & 0.10269e+04_r8,0.77885e+03_r8,0.58037e+03_r8,0.85041e+03_r8,0.11223e+04_r8 /) + kbo(:, 4,47, 8) = (/ & + & 0.10269e+04_r8,0.77884e+03_r8,0.57993e+03_r8,0.84985e+03_r8,0.11217e+04_r8 /) + kbo(:, 5,47, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.57937e+03_r8,0.84903e+03_r8,0.11207e+04_r8 /) + kbo(:, 1,48, 8) = (/ & + & 0.10269e+04_r8,0.77884e+03_r8,0.58064e+03_r8,0.85086e+03_r8,0.11226e+04_r8 /) + kbo(:, 2,48, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.58071e+03_r8,0.85080e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,48, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.58051e+03_r8,0.85055e+03_r8,0.11225e+04_r8 /) + kbo(:, 4,48, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.58013e+03_r8,0.85010e+03_r8,0.11220e+04_r8 /) + kbo(:, 5,48, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.57961e+03_r8,0.84941e+03_r8,0.11212e+04_r8 /) + kbo(:, 1,49, 8) = (/ & + & 0.10269e+04_r8,0.77884e+03_r8,0.58054e+03_r8,0.85082e+03_r8,0.11225e+04_r8 /) + kbo(:, 2,49, 8) = (/ & + & 0.10269e+04_r8,0.77882e+03_r8,0.58072e+03_r8,0.85085e+03_r8,0.11227e+04_r8 /) + kbo(:, 3,49, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.58061e+03_r8,0.85068e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,49, 8) = (/ & + & 0.10269e+04_r8,0.77882e+03_r8,0.58029e+03_r8,0.85032e+03_r8,0.11222e+04_r8 /) + kbo(:, 5,49, 8) = (/ & + & 0.10269e+04_r8,0.77881e+03_r8,0.57983e+03_r8,0.84969e+03_r8,0.11215e+04_r8 /) + kbo(:, 1,50, 8) = (/ & + & 0.10269e+04_r8,0.77883e+03_r8,0.58042e+03_r8,0.85074e+03_r8,0.11224e+04_r8 /) + kbo(:, 2,50, 8) = (/ & + & 0.10269e+04_r8,0.77881e+03_r8,0.58068e+03_r8,0.85085e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,50, 8) = (/ & + & 0.10269e+04_r8,0.77882e+03_r8,0.58069e+03_r8,0.85077e+03_r8,0.11227e+04_r8 /) + kbo(:, 4,50, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58043e+03_r8,0.85048e+03_r8,0.11224e+04_r8 /) + kbo(:, 5,50, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58002e+03_r8,0.84997e+03_r8,0.11218e+04_r8 /) + kbo(:, 1,51, 8) = (/ & + & 0.10269e+04_r8,0.77881e+03_r8,0.58027e+03_r8,0.85064e+03_r8,0.11224e+04_r8 /) + kbo(:, 2,51, 8) = (/ & + & 0.10269e+04_r8,0.77882e+03_r8,0.58061e+03_r8,0.85085e+03_r8,0.11226e+04_r8 /) + kbo(:, 3,51, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58071e+03_r8,0.85082e+03_r8,0.11227e+04_r8 /) + kbo(:, 4,51, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58055e+03_r8,0.85061e+03_r8,0.11226e+04_r8 /) + kbo(:, 5,51, 8) = (/ & + & 0.10269e+04_r8,0.77881e+03_r8,0.58020e+03_r8,0.85015e+03_r8,0.11221e+04_r8 /) + kbo(:, 1,52, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58011e+03_r8,0.85051e+03_r8,0.11222e+04_r8 /) + kbo(:, 2,52, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58051e+03_r8,0.85080e+03_r8,0.11225e+04_r8 /) + kbo(:, 3,52, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58071e+03_r8,0.85085e+03_r8,0.11227e+04_r8 /) + kbo(:, 4,52, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58064e+03_r8,0.85068e+03_r8,0.11226e+04_r8 /) + kbo(:, 5,52, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58034e+03_r8,0.85037e+03_r8,0.11223e+04_r8 /) + kbo(:, 1,53, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.57994e+03_r8,0.85036e+03_r8,0.11220e+04_r8 /) + kbo(:, 2,53, 8) = (/ & + & 0.10269e+04_r8,0.77879e+03_r8,0.58038e+03_r8,0.85072e+03_r8,0.11224e+04_r8 /) + kbo(:, 3,53, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58066e+03_r8,0.85087e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,53, 8) = (/ & + & 0.10269e+04_r8,0.77880e+03_r8,0.58069e+03_r8,0.85078e+03_r8,0.11227e+04_r8 /) + kbo(:, 5,53, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58047e+03_r8,0.85044e+03_r8,0.11225e+04_r8 /) + kbo(:, 1,54, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.57977e+03_r8,0.85022e+03_r8,0.11219e+04_r8 /) + kbo(:, 2,54, 8) = (/ & + & 0.10269e+04_r8,0.77879e+03_r8,0.58026e+03_r8,0.85061e+03_r8,0.11223e+04_r8 /) + kbo(:, 3,54, 8) = (/ & + & 0.10268e+04_r8,0.77881e+03_r8,0.58060e+03_r8,0.85084e+03_r8,0.11226e+04_r8 /) + kbo(:, 4,54, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58072e+03_r8,0.85083e+03_r8,0.11227e+04_r8 /) + kbo(:, 5,54, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58058e+03_r8,0.85063e+03_r8,0.11226e+04_r8 /) + kbo(:, 1,55, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.57962e+03_r8,0.85008e+03_r8,0.11217e+04_r8 /) + kbo(:, 2,55, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58011e+03_r8,0.85050e+03_r8,0.11222e+04_r8 /) + kbo(:, 3,55, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58050e+03_r8,0.85080e+03_r8,0.11225e+04_r8 /) + kbo(:, 4,55, 8) = (/ & + & 0.10268e+04_r8,0.77880e+03_r8,0.58071e+03_r8,0.85085e+03_r8,0.11226e+04_r8 /) + kbo(:, 5,55, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58064e+03_r8,0.85072e+03_r8,0.11226e+04_r8 /) + kbo(:, 1,56, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.57945e+03_r8,0.84993e+03_r8,0.11216e+04_r8 /) + kbo(:, 2,56, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.57995e+03_r8,0.85037e+03_r8,0.11220e+04_r8 /) + kbo(:, 3,56, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.58039e+03_r8,0.85071e+03_r8,0.11224e+04_r8 /) + kbo(:, 4,56, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58067e+03_r8,0.85086e+03_r8,0.11226e+04_r8 /) + kbo(:, 5,56, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58069e+03_r8,0.85078e+03_r8,0.11227e+04_r8 /) + kbo(:, 1,57, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.57927e+03_r8,0.84978e+03_r8,0.11215e+04_r8 /) + kbo(:, 2,57, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.57979e+03_r8,0.85024e+03_r8,0.11219e+04_r8 /) + kbo(:, 3,57, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58025e+03_r8,0.85063e+03_r8,0.11223e+04_r8 /) + kbo(:, 4,57, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58060e+03_r8,0.85084e+03_r8,0.11226e+04_r8 /) + kbo(:, 5,57, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58071e+03_r8,0.85083e+03_r8,0.11227e+04_r8 /) + kbo(:, 1,58, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.57911e+03_r8,0.84962e+03_r8,0.11212e+04_r8 /) + kbo(:, 2,58, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.57964e+03_r8,0.85010e+03_r8,0.11218e+04_r8 /) + kbo(:, 3,58, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.58013e+03_r8,0.85053e+03_r8,0.11222e+04_r8 /) + kbo(:, 4,58, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.58052e+03_r8,0.85080e+03_r8,0.11225e+04_r8 /) + kbo(:, 5,58, 8) = (/ & + & 0.10268e+04_r8,0.77879e+03_r8,0.58071e+03_r8,0.85085e+03_r8,0.11227e+04_r8 /) + kbo(:, 1,59, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.57904e+03_r8,0.84955e+03_r8,0.11212e+04_r8 /) + kbo(:, 2,59, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.57958e+03_r8,0.85006e+03_r8,0.11217e+04_r8 /) + kbo(:, 3,59, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.58007e+03_r8,0.85048e+03_r8,0.11222e+04_r8 /) + kbo(:, 4,59, 8) = (/ & + & 0.10268e+04_r8,0.77878e+03_r8,0.58048e+03_r8,0.85078e+03_r8,0.11225e+04_r8 /) + kbo(:, 5,59, 8) = (/ & + & 0.10268e+04_r8,0.77877e+03_r8,0.58070e+03_r8,0.85086e+03_r8,0.11227e+04_r8 /) + kbo(:, 1,13, 9) = (/ & + & 0.11533e+04_r8,0.87327e+03_r8,0.59473e+03_r8,0.87046e+03_r8,0.11487e+04_r8 /) + kbo(:, 2,13, 9) = (/ & + & 0.11444e+04_r8,0.86660e+03_r8,0.59240e+03_r8,0.87005e+03_r8,0.11483e+04_r8 /) + kbo(:, 3,13, 9) = (/ & + & 0.11367e+04_r8,0.86090e+03_r8,0.59185e+03_r8,0.86950e+03_r8,0.11478e+04_r8 /) + kbo(:, 4,13, 9) = (/ & + & 0.11301e+04_r8,0.85587e+03_r8,0.59143e+03_r8,0.86883e+03_r8,0.11469e+04_r8 /) + kbo(:, 5,13, 9) = (/ & + & 0.11242e+04_r8,0.85148e+03_r8,0.59084e+03_r8,0.86797e+03_r8,0.11458e+04_r8 /) + kbo(:, 1,14, 9) = (/ & + & 0.11310e+04_r8,0.85656e+03_r8,0.59238e+03_r8,0.87026e+03_r8,0.11487e+04_r8 /) + kbo(:, 2,14, 9) = (/ & + & 0.11238e+04_r8,0.85118e+03_r8,0.59190e+03_r8,0.86988e+03_r8,0.11483e+04_r8 /) + kbo(:, 3,14, 9) = (/ & + & 0.11176e+04_r8,0.84654e+03_r8,0.59149e+03_r8,0.86931e+03_r8,0.11477e+04_r8 /) + kbo(:, 4,14, 9) = (/ & + & 0.11122e+04_r8,0.84248e+03_r8,0.59105e+03_r8,0.86863e+03_r8,0.11468e+04_r8 /) + kbo(:, 5,14, 9) = (/ & + & 0.11074e+04_r8,0.83890e+03_r8,0.59046e+03_r8,0.86777e+03_r8,0.11457e+04_r8 /) + kbo(:, 1,15, 9) = (/ & + & 0.11128e+04_r8,0.84292e+03_r8,0.59202e+03_r8,0.87009e+03_r8,0.11486e+04_r8 /) + kbo(:, 2,15, 9) = (/ & + & 0.11070e+04_r8,0.83857e+03_r8,0.59157e+03_r8,0.86969e+03_r8,0.11482e+04_r8 /) + kbo(:, 3,15, 9) = (/ & + & 0.11020e+04_r8,0.83480e+03_r8,0.59118e+03_r8,0.86913e+03_r8,0.11476e+04_r8 /) + kbo(:, 4,15, 9) = (/ & + & 0.10976e+04_r8,0.83151e+03_r8,0.59076e+03_r8,0.86843e+03_r8,0.11467e+04_r8 /) + kbo(:, 5,15, 9) = (/ & + & 0.10938e+04_r8,0.82865e+03_r8,0.59015e+03_r8,0.86756e+03_r8,0.11457e+04_r8 /) + kbo(:, 1,16, 9) = (/ & + & 0.10980e+04_r8,0.83182e+03_r8,0.59172e+03_r8,0.86994e+03_r8,0.11486e+04_r8 /) + kbo(:, 2,16, 9) = (/ & + & 0.10933e+04_r8,0.82831e+03_r8,0.59129e+03_r8,0.86966e+03_r8,0.11482e+04_r8 /) + kbo(:, 3,16, 9) = (/ & + & 0.10893e+04_r8,0.82527e+03_r8,0.59092e+03_r8,0.86898e+03_r8,0.11475e+04_r8 /) + kbo(:, 4,16, 9) = (/ & + & 0.10858e+04_r8,0.82261e+03_r8,0.59049e+03_r8,0.86826e+03_r8,0.11466e+04_r8 /) + kbo(:, 5,16, 9) = (/ & + & 0.10827e+04_r8,0.82037e+03_r8,0.58989e+03_r8,0.86738e+03_r8,0.11455e+04_r8 /) + kbo(:, 1,17, 9) = (/ & + & 0.10860e+04_r8,0.82280e+03_r8,0.59147e+03_r8,0.86983e+03_r8,0.11485e+04_r8 /) + kbo(:, 2,17, 9) = (/ & + & 0.10822e+04_r8,0.81997e+03_r8,0.59107e+03_r8,0.86941e+03_r8,0.11481e+04_r8 /) + kbo(:, 3,17, 9) = (/ & + & 0.10790e+04_r8,0.81753e+03_r8,0.59070e+03_r8,0.86883e+03_r8,0.11474e+04_r8 /) + kbo(:, 4,17, 9) = (/ & + & 0.10761e+04_r8,0.81539e+03_r8,0.59027e+03_r8,0.86811e+03_r8,0.11465e+04_r8 /) + kbo(:, 5,17, 9) = (/ & + & 0.10736e+04_r8,0.81353e+03_r8,0.58965e+03_r8,0.86721e+03_r8,0.11454e+04_r8 /) + kbo(:, 1,18, 9) = (/ & + & 0.10762e+04_r8,0.81555e+03_r8,0.59126e+03_r8,0.86969e+03_r8,0.11485e+04_r8 /) + kbo(:, 2,18, 9) = (/ & + & 0.10732e+04_r8,0.81322e+03_r8,0.59088e+03_r8,0.86928e+03_r8,0.11481e+04_r8 /) + kbo(:, 3,18, 9) = (/ & + & 0.10706e+04_r8,0.81128e+03_r8,0.59052e+03_r8,0.86870e+03_r8,0.11474e+04_r8 /) + kbo(:, 4,18, 9) = (/ & + & 0.10683e+04_r8,0.80956e+03_r8,0.59008e+03_r8,0.86800e+03_r8,0.11464e+04_r8 /) + kbo(:, 5,18, 9) = (/ & + & 0.10663e+04_r8,0.80808e+03_r8,0.58945e+03_r8,0.86705e+03_r8,0.11452e+04_r8 /) + kbo(:, 1,19, 9) = (/ & + & 0.10684e+04_r8,0.80963e+03_r8,0.59108e+03_r8,0.86962e+03_r8,0.11485e+04_r8 /) + kbo(:, 2,19, 9) = (/ & + & 0.10659e+04_r8,0.80774e+03_r8,0.59072e+03_r8,0.86917e+03_r8,0.11480e+04_r8 /) + kbo(:, 3,19, 9) = (/ & + & 0.10638e+04_r8,0.80613e+03_r8,0.59038e+03_r8,0.86858e+03_r8,0.11473e+04_r8 /) + kbo(:, 4,19, 9) = (/ & + & 0.10619e+04_r8,0.80481e+03_r8,0.58991e+03_r8,0.86784e+03_r8,0.11463e+04_r8 /) + kbo(:, 5,19, 9) = (/ & + & 0.10603e+04_r8,0.80353e+03_r8,0.58926e+03_r8,0.86690e+03_r8,0.11451e+04_r8 /) + kbo(:, 1,20, 9) = (/ & + & 0.10619e+04_r8,0.80474e+03_r8,0.59092e+03_r8,0.86952e+03_r8,0.11484e+04_r8 /) + kbo(:, 2,20, 9) = (/ & + & 0.10599e+04_r8,0.80326e+03_r8,0.59057e+03_r8,0.86907e+03_r8,0.11479e+04_r8 /) + kbo(:, 3,20, 9) = (/ & + & 0.10582e+04_r8,0.80198e+03_r8,0.59022e+03_r8,0.86845e+03_r8,0.11472e+04_r8 /) + kbo(:, 4,20, 9) = (/ & + & 0.10567e+04_r8,0.80089e+03_r8,0.58976e+03_r8,0.86771e+03_r8,0.11462e+04_r8 /) + kbo(:, 5,20, 9) = (/ & + & 0.10554e+04_r8,0.79986e+03_r8,0.58910e+03_r8,0.86674e+03_r8,0.11449e+04_r8 /) + kbo(:, 1,21, 9) = (/ & + & 0.10567e+04_r8,0.80080e+03_r8,0.59079e+03_r8,0.86945e+03_r8,0.11483e+04_r8 /) + kbo(:, 2,21, 9) = (/ & + & 0.10550e+04_r8,0.79960e+03_r8,0.59045e+03_r8,0.86897e+03_r8,0.11478e+04_r8 /) + kbo(:, 3,21, 9) = (/ & + & 0.10537e+04_r8,0.79858e+03_r8,0.59010e+03_r8,0.86836e+03_r8,0.11471e+04_r8 /) + kbo(:, 4,21, 9) = (/ & + & 0.10525e+04_r8,0.79770e+03_r8,0.58962e+03_r8,0.86752e+03_r8,0.11460e+04_r8 /) + kbo(:, 5,21, 9) = (/ & + & 0.10514e+04_r8,0.79685e+03_r8,0.58893e+03_r8,0.86654e+03_r8,0.11447e+04_r8 /) + kbo(:, 1,22, 9) = (/ & + & 0.10523e+04_r8,0.79754e+03_r8,0.59066e+03_r8,0.86933e+03_r8,0.11483e+04_r8 /) + kbo(:, 2,22, 9) = (/ & + & 0.10510e+04_r8,0.79661e+03_r8,0.59033e+03_r8,0.86884e+03_r8,0.11477e+04_r8 /) + kbo(:, 3,22, 9) = (/ & + & 0.10500e+04_r8,0.79577e+03_r8,0.58997e+03_r8,0.86819e+03_r8,0.11469e+04_r8 /) + kbo(:, 4,22, 9) = (/ & + & 0.10490e+04_r8,0.79506e+03_r8,0.58945e+03_r8,0.86737e+03_r8,0.11458e+04_r8 /) + kbo(:, 5,22, 9) = (/ & + & 0.10482e+04_r8,0.79443e+03_r8,0.58872e+03_r8,0.86635e+03_r8,0.11444e+04_r8 /) + kbo(:, 1,23, 9) = (/ & + & 0.10488e+04_r8,0.79491e+03_r8,0.59053e+03_r8,0.86922e+03_r8,0.11482e+04_r8 /) + kbo(:, 2,23, 9) = (/ & + & 0.10478e+04_r8,0.79417e+03_r8,0.59023e+03_r8,0.86872e+03_r8,0.11476e+04_r8 /) + kbo(:, 3,23, 9) = (/ & + & 0.10469e+04_r8,0.79351e+03_r8,0.58983e+03_r8,0.86802e+03_r8,0.11467e+04_r8 /) + kbo(:, 4,23, 9) = (/ & + & 0.10461e+04_r8,0.79293e+03_r8,0.58929e+03_r8,0.86717e+03_r8,0.11456e+04_r8 /) + kbo(:, 5,23, 9) = (/ & + & 0.10455e+04_r8,0.79241e+03_r8,0.58851e+03_r8,0.86610e+03_r8,0.11442e+04_r8 /) + kbo(:, 1,24, 9) = (/ & + & 0.10460e+04_r8,0.79285e+03_r8,0.59042e+03_r8,0.86910e+03_r8,0.11481e+04_r8 /) + kbo(:, 2,24, 9) = (/ & + & 0.10452e+04_r8,0.79220e+03_r8,0.59009e+03_r8,0.86856e+03_r8,0.11474e+04_r8 /) + kbo(:, 3,24, 9) = (/ & + & 0.10445e+04_r8,0.79170e+03_r8,0.58968e+03_r8,0.86785e+03_r8,0.11465e+04_r8 /) + kbo(:, 4,24, 9) = (/ & + & 0.10439e+04_r8,0.79123e+03_r8,0.58911e+03_r8,0.86698e+03_r8,0.11453e+04_r8 /) + kbo(:, 5,24, 9) = (/ & + & 0.10433e+04_r8,0.79086e+03_r8,0.58830e+03_r8,0.86584e+03_r8,0.11439e+04_r8 /) + kbo(:, 1,25, 9) = (/ & + & 0.10438e+04_r8,0.79109e+03_r8,0.59032e+03_r8,0.86899e+03_r8,0.11480e+04_r8 /) + kbo(:, 2,25, 9) = (/ & + & 0.10430e+04_r8,0.79059e+03_r8,0.58999e+03_r8,0.86841e+03_r8,0.11473e+04_r8 /) + kbo(:, 3,25, 9) = (/ & + & 0.10425e+04_r8,0.79018e+03_r8,0.58955e+03_r8,0.86768e+03_r8,0.11463e+04_r8 /) + kbo(:, 4,25, 9) = (/ & + & 0.10420e+04_r8,0.78985e+03_r8,0.58893e+03_r8,0.86674e+03_r8,0.11450e+04_r8 /) + kbo(:, 5,25, 9) = (/ & + & 0.10416e+04_r8,0.78947e+03_r8,0.58810e+03_r8,0.86557e+03_r8,0.11436e+04_r8 /) + kbo(:, 1,26, 9) = (/ & + & 0.10418e+04_r8,0.78966e+03_r8,0.59022e+03_r8,0.86886e+03_r8,0.11478e+04_r8 /) + kbo(:, 2,26, 9) = (/ & + & 0.10414e+04_r8,0.78932e+03_r8,0.58989e+03_r8,0.86824e+03_r8,0.11471e+04_r8 /) + kbo(:, 3,26, 9) = (/ & + & 0.10409e+04_r8,0.78898e+03_r8,0.58940e+03_r8,0.86743e+03_r8,0.11460e+04_r8 /) + kbo(:, 4,26, 9) = (/ & + & 0.10405e+04_r8,0.78870e+03_r8,0.58873e+03_r8,0.86647e+03_r8,0.11447e+04_r8 /) + kbo(:, 5,26, 9) = (/ & + & 0.10401e+04_r8,0.78842e+03_r8,0.58782e+03_r8,0.86527e+03_r8,0.11432e+04_r8 /) + kbo(:, 1,27, 9) = (/ & + & 0.10403e+04_r8,0.78855e+03_r8,0.59012e+03_r8,0.86872e+03_r8,0.11477e+04_r8 /) + kbo(:, 2,27, 9) = (/ & + & 0.10399e+04_r8,0.78827e+03_r8,0.58977e+03_r8,0.86806e+03_r8,0.11468e+04_r8 /) + kbo(:, 3,27, 9) = (/ & + & 0.10396e+04_r8,0.78799e+03_r8,0.58924e+03_r8,0.86723e+03_r8,0.11458e+04_r8 /) + kbo(:, 4,27, 9) = (/ & + & 0.10392e+04_r8,0.78776e+03_r8,0.58850e+03_r8,0.86619e+03_r8,0.11444e+04_r8 /) + kbo(:, 5,27, 9) = (/ & + & 0.10390e+04_r8,0.78757e+03_r8,0.58756e+03_r8,0.86495e+03_r8,0.11428e+04_r8 /) + kbo(:, 1,28, 9) = (/ & + & 0.10391e+04_r8,0.78770e+03_r8,0.59002e+03_r8,0.86856e+03_r8,0.11475e+04_r8 /) + kbo(:, 2,28, 9) = (/ & + & 0.10388e+04_r8,0.78747e+03_r8,0.58964e+03_r8,0.86790e+03_r8,0.11466e+04_r8 /) + kbo(:, 3,28, 9) = (/ & + & 0.10385e+04_r8,0.78719e+03_r8,0.58908e+03_r8,0.86701e+03_r8,0.11455e+04_r8 /) + kbo(:, 4,28, 9) = (/ & + & 0.10383e+04_r8,0.78704e+03_r8,0.58829e+03_r8,0.86590e+03_r8,0.11440e+04_r8 /) + kbo(:, 5,28, 9) = (/ & + & 0.10381e+04_r8,0.78687e+03_r8,0.58729e+03_r8,0.86461e+03_r8,0.11423e+04_r8 /) + kbo(:, 1,29, 9) = (/ & + & 0.10382e+04_r8,0.78694e+03_r8,0.58994e+03_r8,0.86841e+03_r8,0.11473e+04_r8 /) + kbo(:, 2,29, 9) = (/ & + & 0.10379e+04_r8,0.78677e+03_r8,0.58950e+03_r8,0.86767e+03_r8,0.11463e+04_r8 /) + kbo(:, 3,29, 9) = (/ & + & 0.10377e+04_r8,0.78658e+03_r8,0.58888e+03_r8,0.86674e+03_r8,0.11451e+04_r8 /) + kbo(:, 4,29, 9) = (/ & + & 0.10375e+04_r8,0.78645e+03_r8,0.58805e+03_r8,0.86559e+03_r8,0.11436e+04_r8 /) + kbo(:, 5,29, 9) = (/ & + & 0.10374e+04_r8,0.78628e+03_r8,0.58702e+03_r8,0.86429e+03_r8,0.11419e+04_r8 /) + kbo(:, 1,30, 9) = (/ & + & 0.10373e+04_r8,0.78632e+03_r8,0.58983e+03_r8,0.86822e+03_r8,0.11471e+04_r8 /) + kbo(:, 2,30, 9) = (/ & + & 0.10371e+04_r8,0.78619e+03_r8,0.58935e+03_r8,0.86746e+03_r8,0.11460e+04_r8 /) + kbo(:, 3,30, 9) = (/ & + & 0.10370e+04_r8,0.78613e+03_r8,0.58869e+03_r8,0.86647e+03_r8,0.11448e+04_r8 /) + kbo(:, 4,30, 9) = (/ & + & 0.10369e+04_r8,0.78594e+03_r8,0.58779e+03_r8,0.86529e+03_r8,0.11432e+04_r8 /) + kbo(:, 5,30, 9) = (/ & + & 0.10367e+04_r8,0.78585e+03_r8,0.58673e+03_r8,0.86393e+03_r8,0.11414e+04_r8 /) + kbo(:, 1,31, 9) = (/ & + & 0.10367e+04_r8,0.78588e+03_r8,0.58971e+03_r8,0.86804e+03_r8,0.11468e+04_r8 /) + kbo(:, 2,31, 9) = (/ & + & 0.10365e+04_r8,0.78574e+03_r8,0.58919e+03_r8,0.86720e+03_r8,0.11457e+04_r8 /) + kbo(:, 3,31, 9) = (/ & + & 0.10364e+04_r8,0.78562e+03_r8,0.58847e+03_r8,0.86618e+03_r8,0.11443e+04_r8 /) + kbo(:, 4,31, 9) = (/ & + & 0.10363e+04_r8,0.78557e+03_r8,0.58752e+03_r8,0.86495e+03_r8,0.11427e+04_r8 /) + kbo(:, 5,31, 9) = (/ & + & 0.10362e+04_r8,0.78546e+03_r8,0.58644e+03_r8,0.86356e+03_r8,0.11409e+04_r8 /) + kbo(:, 1,32, 9) = (/ & + & 0.10362e+04_r8,0.78556e+03_r8,0.58958e+03_r8,0.86784e+03_r8,0.11466e+04_r8 /) + kbo(:, 2,32, 9) = (/ & + & 0.10361e+04_r8,0.78539e+03_r8,0.58901e+03_r8,0.86697e+03_r8,0.11454e+04_r8 /) + kbo(:, 3,32, 9) = (/ & + & 0.10360e+04_r8,0.78539e+03_r8,0.58824e+03_r8,0.86587e+03_r8,0.11440e+04_r8 /) + kbo(:, 4,32, 9) = (/ & + & 0.10359e+04_r8,0.78525e+03_r8,0.58724e+03_r8,0.86459e+03_r8,0.11423e+04_r8 /) + kbo(:, 5,32, 9) = (/ & + & 0.10358e+04_r8,0.78516e+03_r8,0.58615e+03_r8,0.86318e+03_r8,0.11404e+04_r8 /) + kbo(:, 1,33, 9) = (/ & + & 0.10358e+04_r8,0.78520e+03_r8,0.58945e+03_r8,0.86763e+03_r8,0.11463e+04_r8 /) + kbo(:, 2,33, 9) = (/ & + & 0.10357e+04_r8,0.78510e+03_r8,0.58883e+03_r8,0.86670e+03_r8,0.11450e+04_r8 /) + kbo(:, 3,33, 9) = (/ & + & 0.10356e+04_r8,0.78504e+03_r8,0.58799e+03_r8,0.86554e+03_r8,0.11435e+04_r8 /) + kbo(:, 4,33, 9) = (/ & + & 0.10356e+04_r8,0.78500e+03_r8,0.58695e+03_r8,0.86422e+03_r8,0.11418e+04_r8 /) + kbo(:, 5,33, 9) = (/ & + & 0.10355e+04_r8,0.78493e+03_r8,0.58586e+03_r8,0.86281e+03_r8,0.11399e+04_r8 /) + kbo(:, 1,34, 9) = (/ & + & 0.10355e+04_r8,0.78495e+03_r8,0.58932e+03_r8,0.86743e+03_r8,0.11460e+04_r8 /) + kbo(:, 2,34, 9) = (/ & + & 0.10354e+04_r8,0.78487e+03_r8,0.58865e+03_r8,0.86644e+03_r8,0.11447e+04_r8 /) + kbo(:, 3,34, 9) = (/ & + & 0.10354e+04_r8,0.78485e+03_r8,0.58776e+03_r8,0.86524e+03_r8,0.11432e+04_r8 /) + kbo(:, 4,34, 9) = (/ & + & 0.10353e+04_r8,0.78479e+03_r8,0.58670e+03_r8,0.86390e+03_r8,0.11414e+04_r8 /) + kbo(:, 5,34, 9) = (/ & + & 0.10352e+04_r8,0.78474e+03_r8,0.58560e+03_r8,0.86249e+03_r8,0.11395e+04_r8 /) + kbo(:, 1,35, 9) = (/ & + & 0.10352e+04_r8,0.78478e+03_r8,0.58924e+03_r8,0.86731e+03_r8,0.11459e+04_r8 /) + kbo(:, 2,35, 9) = (/ & + & 0.10352e+04_r8,0.78472e+03_r8,0.58855e+03_r8,0.86632e+03_r8,0.11445e+04_r8 /) + kbo(:, 3,35, 9) = (/ & + & 0.10351e+04_r8,0.78465e+03_r8,0.58761e+03_r8,0.86508e+03_r8,0.11430e+04_r8 /) + kbo(:, 4,35, 9) = (/ & + & 0.10350e+04_r8,0.78465e+03_r8,0.58655e+03_r8,0.86369e+03_r8,0.11412e+04_r8 /) + kbo(:, 5,35, 9) = (/ & + & 0.10350e+04_r8,0.78456e+03_r8,0.58545e+03_r8,0.86237e+03_r8,0.11393e+04_r8 /) + kbo(:, 1,36, 9) = (/ & + & 0.10350e+04_r8,0.78465e+03_r8,0.58922e+03_r8,0.86729e+03_r8,0.11458e+04_r8 /) + kbo(:, 2,36, 9) = (/ & + & 0.10350e+04_r8,0.78456e+03_r8,0.58852e+03_r8,0.86627e+03_r8,0.11445e+04_r8 /) + kbo(:, 3,36, 9) = (/ & + & 0.10350e+04_r8,0.78452e+03_r8,0.58759e+03_r8,0.86505e+03_r8,0.11429e+04_r8 /) + kbo(:, 4,36, 9) = (/ & + & 0.10349e+04_r8,0.78450e+03_r8,0.58651e+03_r8,0.86369e+03_r8,0.11411e+04_r8 /) + kbo(:, 5,36, 9) = (/ & + & 0.10348e+04_r8,0.78444e+03_r8,0.58544e+03_r8,0.86227e+03_r8,0.11392e+04_r8 /) + kbo(:, 1,37, 9) = (/ & + & 0.10349e+04_r8,0.78446e+03_r8,0.58930e+03_r8,0.86738e+03_r8,0.11460e+04_r8 /) + kbo(:, 2,37, 9) = (/ & + & 0.10348e+04_r8,0.78444e+03_r8,0.58863e+03_r8,0.86642e+03_r8,0.11447e+04_r8 /) + kbo(:, 3,37, 9) = (/ & + & 0.10348e+04_r8,0.78441e+03_r8,0.58773e+03_r8,0.86522e+03_r8,0.11432e+04_r8 /) + kbo(:, 4,37, 9) = (/ & + & 0.10348e+04_r8,0.78439e+03_r8,0.58667e+03_r8,0.86387e+03_r8,0.11414e+04_r8 /) + kbo(:, 5,37, 9) = (/ & + & 0.10347e+04_r8,0.78436e+03_r8,0.58559e+03_r8,0.86245e+03_r8,0.11394e+04_r8 /) + kbo(:, 1,38, 9) = (/ & + & 0.10348e+04_r8,0.78440e+03_r8,0.58936e+03_r8,0.86753e+03_r8,0.11462e+04_r8 /) + kbo(:, 2,38, 9) = (/ & + & 0.10347e+04_r8,0.78434e+03_r8,0.58873e+03_r8,0.86658e+03_r8,0.11449e+04_r8 /) + kbo(:, 3,38, 9) = (/ & + & 0.10347e+04_r8,0.78432e+03_r8,0.58786e+03_r8,0.86537e+03_r8,0.11434e+04_r8 /) + kbo(:, 4,38, 9) = (/ & + & 0.10346e+04_r8,0.78431e+03_r8,0.58681e+03_r8,0.86407e+03_r8,0.11416e+04_r8 /) + kbo(:, 5,38, 9) = (/ & + & 0.10347e+04_r8,0.78428e+03_r8,0.58573e+03_r8,0.86265e+03_r8,0.11397e+04_r8 /) + kbo(:, 1,39, 9) = (/ & + & 0.10347e+04_r8,0.78431e+03_r8,0.58943e+03_r8,0.86764e+03_r8,0.11463e+04_r8 /) + kbo(:, 2,39, 9) = (/ & + & 0.10346e+04_r8,0.78431e+03_r8,0.58882e+03_r8,0.86672e+03_r8,0.11451e+04_r8 /) + kbo(:, 3,39, 9) = (/ & + & 0.10346e+04_r8,0.78424e+03_r8,0.58800e+03_r8,0.86557e+03_r8,0.11436e+04_r8 /) + kbo(:, 4,39, 9) = (/ & + & 0.10346e+04_r8,0.78421e+03_r8,0.58697e+03_r8,0.86426e+03_r8,0.11419e+04_r8 /) + kbo(:, 5,39, 9) = (/ & + & 0.10346e+04_r8,0.78429e+03_r8,0.58587e+03_r8,0.86284e+03_r8,0.11400e+04_r8 /) + kbo(:, 1,40, 9) = (/ & + & 0.10346e+04_r8,0.78426e+03_r8,0.58957e+03_r8,0.86785e+03_r8,0.11466e+04_r8 /) + kbo(:, 2,40, 9) = (/ & + & 0.10345e+04_r8,0.78427e+03_r8,0.58899e+03_r8,0.86697e+03_r8,0.11454e+04_r8 /) + kbo(:, 3,40, 9) = (/ & + & 0.10345e+04_r8,0.78422e+03_r8,0.58822e+03_r8,0.86585e+03_r8,0.11440e+04_r8 /) + kbo(:, 4,40, 9) = (/ & + & 0.10345e+04_r8,0.78421e+03_r8,0.58723e+03_r8,0.86460e+03_r8,0.11423e+04_r8 /) + kbo(:, 5,40, 9) = (/ & + & 0.10344e+04_r8,0.78416e+03_r8,0.58614e+03_r8,0.86319e+03_r8,0.11403e+04_r8 /) + kbo(:, 1,41, 9) = (/ & + & 0.10345e+04_r8,0.78421e+03_r8,0.58967e+03_r8,0.86804e+03_r8,0.11468e+04_r8 /) + kbo(:, 2,41, 9) = (/ & + & 0.10345e+04_r8,0.78418e+03_r8,0.58916e+03_r8,0.86720e+03_r8,0.11457e+04_r8 /) + kbo(:, 3,41, 9) = (/ & + & 0.10344e+04_r8,0.78415e+03_r8,0.58844e+03_r8,0.86618e+03_r8,0.11444e+04_r8 /) + kbo(:, 4,41, 9) = (/ & + & 0.10344e+04_r8,0.78413e+03_r8,0.58748e+03_r8,0.86492e+03_r8,0.11428e+04_r8 /) + kbo(:, 5,41, 9) = (/ & + & 0.10344e+04_r8,0.78411e+03_r8,0.58642e+03_r8,0.86355e+03_r8,0.11409e+04_r8 /) + kbo(:, 1,42, 9) = (/ & + & 0.10345e+04_r8,0.78414e+03_r8,0.58976e+03_r8,0.86830e+03_r8,0.11471e+04_r8 /) + kbo(:, 2,42, 9) = (/ & + & 0.10344e+04_r8,0.78417e+03_r8,0.58930e+03_r8,0.86744e+03_r8,0.11460e+04_r8 /) + kbo(:, 3,42, 9) = (/ & + & 0.10344e+04_r8,0.78411e+03_r8,0.58863e+03_r8,0.86645e+03_r8,0.11448e+04_r8 /) + kbo(:, 4,42, 9) = (/ & + & 0.10344e+04_r8,0.78409e+03_r8,0.58775e+03_r8,0.86525e+03_r8,0.11432e+04_r8 /) + kbo(:, 5,42, 9) = (/ & + & 0.10344e+04_r8,0.78408e+03_r8,0.58670e+03_r8,0.86391e+03_r8,0.11414e+04_r8 /) + kbo(:, 1,43, 9) = (/ & + & 0.10344e+04_r8,0.78410e+03_r8,0.58987e+03_r8,0.86842e+03_r8,0.11473e+04_r8 /) + kbo(:, 2,43, 9) = (/ & + & 0.10344e+04_r8,0.78408e+03_r8,0.58947e+03_r8,0.86769e+03_r8,0.11464e+04_r8 /) + kbo(:, 3,43, 9) = (/ & + & 0.10344e+04_r8,0.78409e+03_r8,0.58887e+03_r8,0.86678e+03_r8,0.11452e+04_r8 /) + kbo(:, 4,43, 9) = (/ & + & 0.10344e+04_r8,0.78410e+03_r8,0.58806e+03_r8,0.86567e+03_r8,0.11437e+04_r8 /) + kbo(:, 5,43, 9) = (/ & + & 0.10343e+04_r8,0.78406e+03_r8,0.58704e+03_r8,0.86435e+03_r8,0.11420e+04_r8 /) + kbo(:, 1,44, 9) = (/ & + & 0.10344e+04_r8,0.78409e+03_r8,0.58998e+03_r8,0.86862e+03_r8,0.11476e+04_r8 /) + kbo(:, 2,44, 9) = (/ & + & 0.10343e+04_r8,0.78407e+03_r8,0.58962e+03_r8,0.86796e+03_r8,0.11467e+04_r8 /) + kbo(:, 3,44, 9) = (/ & + & 0.10343e+04_r8,0.78406e+03_r8,0.58910e+03_r8,0.86711e+03_r8,0.11456e+04_r8 /) + kbo(:, 4,44, 9) = (/ & + & 0.10343e+04_r8,0.78403e+03_r8,0.58835e+03_r8,0.86607e+03_r8,0.11442e+04_r8 /) + kbo(:, 5,44, 9) = (/ & + & 0.10343e+04_r8,0.78403e+03_r8,0.58738e+03_r8,0.86483e+03_r8,0.11426e+04_r8 /) + kbo(:, 1,45, 9) = (/ & + & 0.10343e+04_r8,0.78404e+03_r8,0.59009e+03_r8,0.86881e+03_r8,0.11478e+04_r8 /) + kbo(:, 2,45, 9) = (/ & + & 0.10343e+04_r8,0.78405e+03_r8,0.58975e+03_r8,0.86821e+03_r8,0.11471e+04_r8 /) + kbo(:, 3,45, 9) = (/ & + & 0.10343e+04_r8,0.78404e+03_r8,0.58930e+03_r8,0.86741e+03_r8,0.11460e+04_r8 /) + kbo(:, 4,45, 9) = (/ & + & 0.10342e+04_r8,0.78400e+03_r8,0.58862e+03_r8,0.86644e+03_r8,0.11447e+04_r8 /) + kbo(:, 5,45, 9) = (/ & + & 0.10343e+04_r8,0.78402e+03_r8,0.58769e+03_r8,0.86520e+03_r8,0.11432e+04_r8 /) + kbo(:, 1,46, 9) = (/ & + & 0.10343e+04_r8,0.78403e+03_r8,0.59019e+03_r8,0.86899e+03_r8,0.11481e+04_r8 /) + kbo(:, 2,46, 9) = (/ & + & 0.10343e+04_r8,0.78403e+03_r8,0.58989e+03_r8,0.86845e+03_r8,0.11474e+04_r8 /) + kbo(:, 3,46, 9) = (/ & + & 0.10343e+04_r8,0.78403e+03_r8,0.58947e+03_r8,0.86773e+03_r8,0.11464e+04_r8 /) + kbo(:, 4,46, 9) = (/ & + & 0.10342e+04_r8,0.78401e+03_r8,0.58890e+03_r8,0.86681e+03_r8,0.11452e+04_r8 /) + kbo(:, 5,46, 9) = (/ & + & 0.10343e+04_r8,0.78405e+03_r8,0.58808e+03_r8,0.86568e+03_r8,0.11438e+04_r8 /) + kbo(:, 1,47, 9) = (/ & + & 0.10343e+04_r8,0.78401e+03_r8,0.59032e+03_r8,0.86917e+03_r8,0.11483e+04_r8 /) + kbo(:, 2,47, 9) = (/ & + & 0.10342e+04_r8,0.78398e+03_r8,0.59001e+03_r8,0.86868e+03_r8,0.11477e+04_r8 /) + kbo(:, 3,47, 9) = (/ & + & 0.10342e+04_r8,0.78398e+03_r8,0.58967e+03_r8,0.86807e+03_r8,0.11468e+04_r8 /) + kbo(:, 4,47, 9) = (/ & + & 0.10343e+04_r8,0.78397e+03_r8,0.58916e+03_r8,0.86720e+03_r8,0.11457e+04_r8 /) + kbo(:, 5,47, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.58844e+03_r8,0.86618e+03_r8,0.11444e+04_r8 /) + kbo(:, 1,48, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.59046e+03_r8,0.86932e+03_r8,0.11485e+04_r8 /) + kbo(:, 2,48, 9) = (/ & + & 0.10343e+04_r8,0.78398e+03_r8,0.59013e+03_r8,0.86890e+03_r8,0.11480e+04_r8 /) + kbo(:, 3,48, 9) = (/ & + & 0.10342e+04_r8,0.78402e+03_r8,0.58982e+03_r8,0.86829e+03_r8,0.11472e+04_r8 /) + kbo(:, 4,48, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.58938e+03_r8,0.86756e+03_r8,0.11462e+04_r8 /) + kbo(:, 5,48, 9) = (/ & + & 0.10342e+04_r8,0.78400e+03_r8,0.58875e+03_r8,0.86661e+03_r8,0.11449e+04_r8 /) + kbo(:, 1,49, 9) = (/ & + & 0.10343e+04_r8,0.78402e+03_r8,0.59060e+03_r8,0.86945e+03_r8,0.11486e+04_r8 /) + kbo(:, 2,49, 9) = (/ & + & 0.10342e+04_r8,0.78398e+03_r8,0.59025e+03_r8,0.86908e+03_r8,0.11482e+04_r8 /) + kbo(:, 3,49, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.58995e+03_r8,0.86856e+03_r8,0.11475e+04_r8 /) + kbo(:, 4,49, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.58958e+03_r8,0.86790e+03_r8,0.11466e+04_r8 /) + kbo(:, 5,49, 9) = (/ & + & 0.10342e+04_r8,0.78398e+03_r8,0.58903e+03_r8,0.86700e+03_r8,0.11455e+04_r8 /) + kbo(:, 1,50, 9) = (/ & + & 0.10343e+04_r8,0.78395e+03_r8,0.59074e+03_r8,0.86956e+03_r8,0.11487e+04_r8 /) + kbo(:, 2,50, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.59038e+03_r8,0.86924e+03_r8,0.11483e+04_r8 /) + kbo(:, 3,50, 9) = (/ & + & 0.10342e+04_r8,0.78394e+03_r8,0.59006e+03_r8,0.86878e+03_r8,0.11478e+04_r8 /) + kbo(:, 4,50, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.58974e+03_r8,0.86817e+03_r8,0.11470e+04_r8 /) + kbo(:, 5,50, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.58927e+03_r8,0.86736e+03_r8,0.11460e+04_r8 /) + kbo(:, 1,51, 9) = (/ & + & 0.10342e+04_r8,0.78399e+03_r8,0.59088e+03_r8,0.86965e+03_r8,0.11488e+04_r8 /) + kbo(:, 2,51, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59051e+03_r8,0.86937e+03_r8,0.11485e+04_r8 /) + kbo(:, 3,51, 9) = (/ & + & 0.10342e+04_r8,0.78400e+03_r8,0.59018e+03_r8,0.86897e+03_r8,0.11480e+04_r8 /) + kbo(:, 4,51, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.58987e+03_r8,0.86840e+03_r8,0.11473e+04_r8 /) + kbo(:, 5,51, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.58946e+03_r8,0.86768e+03_r8,0.11464e+04_r8 /) + kbo(:, 1,52, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.59100e+03_r8,0.86971e+03_r8,0.11490e+04_r8 /) + kbo(:, 2,52, 9) = (/ & + & 0.10342e+04_r8,0.78394e+03_r8,0.59064e+03_r8,0.86949e+03_r8,0.11486e+04_r8 /) + kbo(:, 3,52, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.59029e+03_r8,0.86915e+03_r8,0.11482e+04_r8 /) + kbo(:, 4,52, 9) = (/ & + & 0.10342e+04_r8,0.78394e+03_r8,0.58998e+03_r8,0.86864e+03_r8,0.11476e+04_r8 /) + kbo(:, 5,52, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.58963e+03_r8,0.86796e+03_r8,0.11468e+04_r8 /) + kbo(:, 1,53, 9) = (/ & + & 0.10342e+04_r8,0.78397e+03_r8,0.59111e+03_r8,0.86975e+03_r8,0.11490e+04_r8 /) + kbo(:, 2,53, 9) = (/ & + & 0.10342e+04_r8,0.78394e+03_r8,0.59078e+03_r8,0.86960e+03_r8,0.11488e+04_r8 /) + kbo(:, 3,53, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.59041e+03_r8,0.86926e+03_r8,0.11484e+04_r8 /) + kbo(:, 4,53, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59010e+03_r8,0.86884e+03_r8,0.11479e+04_r8 /) + kbo(:, 5,53, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.58977e+03_r8,0.86822e+03_r8,0.11471e+04_r8 /) + kbo(:, 1,54, 9) = (/ & + & 0.10343e+04_r8,0.78394e+03_r8,0.59121e+03_r8,0.86979e+03_r8,0.11491e+04_r8 /) + kbo(:, 2,54, 9) = (/ & + & 0.10341e+04_r8,0.78399e+03_r8,0.59088e+03_r8,0.86966e+03_r8,0.11489e+04_r8 /) + kbo(:, 3,54, 9) = (/ & + & 0.10341e+04_r8,0.78394e+03_r8,0.59052e+03_r8,0.86939e+03_r8,0.11485e+04_r8 /) + kbo(:, 4,54, 9) = (/ & + & 0.10341e+04_r8,0.78394e+03_r8,0.59020e+03_r8,0.86900e+03_r8,0.11481e+04_r8 /) + kbo(:, 5,54, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.58987e+03_r8,0.86845e+03_r8,0.11474e+04_r8 /) + kbo(:, 1,55, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.59130e+03_r8,0.86983e+03_r8,0.11491e+04_r8 /) + kbo(:, 2,55, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59100e+03_r8,0.86971e+03_r8,0.11490e+04_r8 /) + kbo(:, 3,55, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59065e+03_r8,0.86949e+03_r8,0.11486e+04_r8 /) + kbo(:, 4,55, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.59029e+03_r8,0.86914e+03_r8,0.11483e+04_r8 /) + kbo(:, 5,55, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59000e+03_r8,0.86864e+03_r8,0.11477e+04_r8 /) + kbo(:, 1,56, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59137e+03_r8,0.86987e+03_r8,0.11492e+04_r8 /) + kbo(:, 2,56, 9) = (/ & + & 0.10342e+04_r8,0.78395e+03_r8,0.59111e+03_r8,0.86975e+03_r8,0.11490e+04_r8 /) + kbo(:, 3,56, 9) = (/ & + & 0.10342e+04_r8,0.78392e+03_r8,0.59077e+03_r8,0.86958e+03_r8,0.11488e+04_r8 /) + kbo(:, 4,56, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59040e+03_r8,0.86926e+03_r8,0.11484e+04_r8 /) + kbo(:, 5,56, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59009e+03_r8,0.86883e+03_r8,0.11479e+04_r8 /) + kbo(:, 1,57, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.59143e+03_r8,0.86993e+03_r8,0.11492e+04_r8 /) + kbo(:, 2,57, 9) = (/ & + & 0.10342e+04_r8,0.78392e+03_r8,0.59122e+03_r8,0.86979e+03_r8,0.11491e+04_r8 /) + kbo(:, 3,57, 9) = (/ & + & 0.10342e+04_r8,0.78392e+03_r8,0.59089e+03_r8,0.86966e+03_r8,0.11489e+04_r8 /) + kbo(:, 4,57, 9) = (/ & + & 0.10341e+04_r8,0.78395e+03_r8,0.59052e+03_r8,0.86938e+03_r8,0.11485e+04_r8 /) + kbo(:, 5,57, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59018e+03_r8,0.86897e+03_r8,0.11481e+04_r8 /) + kbo(:, 1,58, 9) = (/ & + & 0.10341e+04_r8,0.78395e+03_r8,0.59147e+03_r8,0.86996e+03_r8,0.11493e+04_r8 /) + kbo(:, 2,58, 9) = (/ & + & 0.10341e+04_r8,0.78397e+03_r8,0.59129e+03_r8,0.86982e+03_r8,0.11491e+04_r8 /) + kbo(:, 3,58, 9) = (/ & + & 0.10341e+04_r8,0.78393e+03_r8,0.59099e+03_r8,0.86970e+03_r8,0.11489e+04_r8 /) + kbo(:, 4,58, 9) = (/ & + & 0.10342e+04_r8,0.78397e+03_r8,0.59063e+03_r8,0.86948e+03_r8,0.11486e+04_r8 /) + kbo(:, 5,58, 9) = (/ & + & 0.10342e+04_r8,0.78390e+03_r8,0.59028e+03_r8,0.86913e+03_r8,0.11482e+04_r8 /) + kbo(:, 1,59, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59148e+03_r8,0.86998e+03_r8,0.11494e+04_r8 /) + kbo(:, 2,59, 9) = (/ & + & 0.10342e+04_r8,0.78396e+03_r8,0.59132e+03_r8,0.86982e+03_r8,0.11492e+04_r8 /) + kbo(:, 3,59, 9) = (/ & + & 0.10342e+04_r8,0.78393e+03_r8,0.59103e+03_r8,0.86972e+03_r8,0.11490e+04_r8 /) + kbo(:, 4,59, 9) = (/ & + & 0.10341e+04_r8,0.78394e+03_r8,0.59067e+03_r8,0.86951e+03_r8,0.11487e+04_r8 /) + kbo(:, 5,59, 9) = (/ & + & 0.10341e+04_r8,0.78397e+03_r8,0.59032e+03_r8,0.86918e+03_r8,0.11483e+04_r8 /) + kbo(:, 1,13,10) = (/ & + & 0.11544e+04_r8,0.87486e+03_r8,0.59975e+03_r8,0.88029e+03_r8,0.11631e+04_r8 /) + kbo(:, 2,13,10) = (/ & + & 0.11458e+04_r8,0.86752e+03_r8,0.59921e+03_r8,0.87889e+03_r8,0.11611e+04_r8 /) + kbo(:, 3,13,10) = (/ & + & 0.11380e+04_r8,0.86177e+03_r8,0.59836e+03_r8,0.87789e+03_r8,0.11592e+04_r8 /) + kbo(:, 4,13,10) = (/ & + & 0.11310e+04_r8,0.85697e+03_r8,0.59745e+03_r8,0.87697e+03_r8,0.11577e+04_r8 /) + kbo(:, 5,13,10) = (/ & + & 0.11259e+04_r8,0.85279e+03_r8,0.59663e+03_r8,0.87606e+03_r8,0.11564e+04_r8 /) + kbo(:, 1,14,10) = (/ & + & 0.11329e+04_r8,0.85757e+03_r8,0.59935e+03_r8,0.88000e+03_r8,0.11630e+04_r8 /) + kbo(:, 2,14,10) = (/ & + & 0.11257e+04_r8,0.85228e+03_r8,0.59878e+03_r8,0.87841e+03_r8,0.11609e+04_r8 /) + kbo(:, 3,14,10) = (/ & + & 0.11201e+04_r8,0.84731e+03_r8,0.59797e+03_r8,0.87766e+03_r8,0.11591e+04_r8 /) + kbo(:, 4,14,10) = (/ & + & 0.11140e+04_r8,0.84389e+03_r8,0.59731e+03_r8,0.87707e+03_r8,0.11577e+04_r8 /) + kbo(:, 5,14,10) = (/ & + & 0.11094e+04_r8,0.84001e+03_r8,0.59642e+03_r8,0.87571e+03_r8,0.11561e+04_r8 /) + kbo(:, 1,15,10) = (/ & + & 0.11142e+04_r8,0.84370e+03_r8,0.59900e+03_r8,0.87973e+03_r8,0.11627e+04_r8 /) + kbo(:, 2,15,10) = (/ & + & 0.11097e+04_r8,0.84029e+03_r8,0.59841e+03_r8,0.87827e+03_r8,0.11607e+04_r8 /) + kbo(:, 3,15,10) = (/ & + & 0.11039e+04_r8,0.83570e+03_r8,0.59763e+03_r8,0.87745e+03_r8,0.11587e+04_r8 /) + kbo(:, 4,15,10) = (/ & + & 0.10995e+04_r8,0.83295e+03_r8,0.59685e+03_r8,0.87664e+03_r8,0.11574e+04_r8 /) + kbo(:, 5,15,10) = (/ & + & 0.10956e+04_r8,0.82966e+03_r8,0.59611e+03_r8,0.87548e+03_r8,0.11555e+04_r8 /) + kbo(:, 1,16,10) = (/ & + & 0.11006e+04_r8,0.83290e+03_r8,0.59871e+03_r8,0.87947e+03_r8,0.11625e+04_r8 /) + kbo(:, 2,16,10) = (/ & + & 0.10967e+04_r8,0.82960e+03_r8,0.59809e+03_r8,0.87696e+03_r8,0.11605e+04_r8 /) + kbo(:, 3,16,10) = (/ & + & 0.10908e+04_r8,0.82627e+03_r8,0.59735e+03_r8,0.87716e+03_r8,0.11587e+04_r8 /) + kbo(:, 4,16,10) = (/ & + & 0.10878e+04_r8,0.82496e+03_r8,0.59665e+03_r8,0.87645e+03_r8,0.11573e+04_r8 /) + kbo(:, 5,16,10) = (/ & + & 0.10846e+04_r8,0.82140e+03_r8,0.59584e+03_r8,0.87537e+03_r8,0.11556e+04_r8 /) + kbo(:, 1,17,10) = (/ & + & 0.10872e+04_r8,0.82399e+03_r8,0.59847e+03_r8,0.87912e+03_r8,0.11623e+04_r8 /) + kbo(:, 2,17,10) = (/ & + & 0.10836e+04_r8,0.82137e+03_r8,0.59782e+03_r8,0.87785e+03_r8,0.11604e+04_r8 /) + kbo(:, 3,17,10) = (/ & + & 0.10806e+04_r8,0.81903e+03_r8,0.59710e+03_r8,0.87700e+03_r8,0.11586e+04_r8 /) + kbo(:, 4,17,10) = (/ & + & 0.10781e+04_r8,0.81649e+03_r8,0.59641e+03_r8,0.87627e+03_r8,0.11571e+04_r8 /) + kbo(:, 5,17,10) = (/ & + & 0.10750e+04_r8,0.81461e+03_r8,0.59560e+03_r8,0.87517e+03_r8,0.11554e+04_r8 /) + kbo(:, 1,18,10) = (/ & + & 0.10783e+04_r8,0.81627e+03_r8,0.59826e+03_r8,0.87902e+03_r8,0.11620e+04_r8 /) + kbo(:, 2,18,10) = (/ & + & 0.10752e+04_r8,0.81450e+03_r8,0.59759e+03_r8,0.87778e+03_r8,0.11602e+04_r8 /) + kbo(:, 3,18,10) = (/ & + & 0.10718e+04_r8,0.81284e+03_r8,0.59689e+03_r8,0.87707e+03_r8,0.11584e+04_r8 /) + kbo(:, 4,18,10) = (/ & + & 0.10695e+04_r8,0.81051e+03_r8,0.59620e+03_r8,0.87578e+03_r8,0.11570e+04_r8 /) + kbo(:, 5,18,10) = (/ & + & 0.10675e+04_r8,0.80859e+03_r8,0.59539e+03_r8,0.87498e+03_r8,0.11554e+04_r8 /) + kbo(:, 1,19,10) = (/ & + & 0.10693e+04_r8,0.81014e+03_r8,0.59808e+03_r8,0.87871e+03_r8,0.11618e+04_r8 /) + kbo(:, 2,19,10) = (/ & + & 0.10674e+04_r8,0.80961e+03_r8,0.59739e+03_r8,0.87763e+03_r8,0.11601e+04_r8 /) + kbo(:, 3,19,10) = (/ & + & 0.10651e+04_r8,0.80782e+03_r8,0.59664e+03_r8,0.87683e+03_r8,0.11582e+04_r8 /) + kbo(:, 4,19,10) = (/ & + & 0.10639e+04_r8,0.80562e+03_r8,0.59610e+03_r8,0.87595e+03_r8,0.11569e+04_r8 /) + kbo(:, 5,19,10) = (/ & + & 0.10620e+04_r8,0.80440e+03_r8,0.59520e+03_r8,0.87481e+03_r8,0.11551e+04_r8 /) + kbo(:, 1,20,10) = (/ & + & 0.10633e+04_r8,0.80580e+03_r8,0.59791e+03_r8,0.87862e+03_r8,0.11616e+04_r8 /) + kbo(:, 2,20,10) = (/ & + & 0.10619e+04_r8,0.80442e+03_r8,0.59720e+03_r8,0.87747e+03_r8,0.11598e+04_r8 /) + kbo(:, 3,20,10) = (/ & + & 0.10607e+04_r8,0.80344e+03_r8,0.59654e+03_r8,0.87680e+03_r8,0.11581e+04_r8 /) + kbo(:, 4,20,10) = (/ & + & 0.10584e+04_r8,0.80182e+03_r8,0.59585e+03_r8,0.87568e+03_r8,0.11568e+04_r8 /) + kbo(:, 5,20,10) = (/ & + & 0.10568e+04_r8,0.80142e+03_r8,0.59502e+03_r8,0.87461e+03_r8,0.11549e+04_r8 /) + kbo(:, 1,21,10) = (/ & + & 0.10577e+04_r8,0.80247e+03_r8,0.59775e+03_r8,0.87831e+03_r8,0.11614e+04_r8 /) + kbo(:, 2,21,10) = (/ & + & 0.10572e+04_r8,0.80108e+03_r8,0.59703e+03_r8,0.87733e+03_r8,0.11595e+04_r8 /) + kbo(:, 3,21,10) = (/ & + & 0.10551e+04_r8,0.79955e+03_r8,0.59639e+03_r8,0.87689e+03_r8,0.11579e+04_r8 /) + kbo(:, 4,21,10) = (/ & + & 0.10548e+04_r8,0.79914e+03_r8,0.59569e+03_r8,0.87563e+03_r8,0.11565e+04_r8 /) + kbo(:, 5,21,10) = (/ & + & 0.10533e+04_r8,0.79794e+03_r8,0.59484e+03_r8,0.87454e+03_r8,0.11546e+04_r8 /) + kbo(:, 1,22,10) = (/ & + & 0.10544e+04_r8,0.79901e+03_r8,0.59755e+03_r8,0.87816e+03_r8,0.11610e+04_r8 /) + kbo(:, 2,22,10) = (/ & + & 0.10524e+04_r8,0.79865e+03_r8,0.59692e+03_r8,0.87715e+03_r8,0.11592e+04_r8 /) + kbo(:, 3,22,10) = (/ & + & 0.10518e+04_r8,0.79733e+03_r8,0.59621e+03_r8,0.87638e+03_r8,0.11576e+04_r8 /) + kbo(:, 4,22,10) = (/ & + & 0.10503e+04_r8,0.79602e+03_r8,0.59549e+03_r8,0.87540e+03_r8,0.11562e+04_r8 /) + kbo(:, 5,22,10) = (/ & + & 0.10497e+04_r8,0.79577e+03_r8,0.59455e+03_r8,0.87415e+03_r8,0.11542e+04_r8 /) + kbo(:, 1,23,10) = (/ & + & 0.10504e+04_r8,0.79618e+03_r8,0.59736e+03_r8,0.87790e+03_r8,0.11608e+04_r8 /) + kbo(:, 2,23,10) = (/ & + & 0.10488e+04_r8,0.79542e+03_r8,0.59652e+03_r8,0.87687e+03_r8,0.11588e+04_r8 /) + kbo(:, 3,23,10) = (/ & + & 0.10489e+04_r8,0.79466e+03_r8,0.59603e+03_r8,0.87619e+03_r8,0.11574e+04_r8 /) + kbo(:, 4,23,10) = (/ & + & 0.10477e+04_r8,0.79399e+03_r8,0.59528e+03_r8,0.87505e+03_r8,0.11559e+04_r8 /) + kbo(:, 5,23,10) = (/ & + & 0.10468e+04_r8,0.79357e+03_r8,0.59440e+03_r8,0.87388e+03_r8,0.11537e+04_r8 /) + kbo(:, 1,24,10) = (/ & + & 0.10475e+04_r8,0.79355e+03_r8,0.59716e+03_r8,0.87766e+03_r8,0.11603e+04_r8 /) + kbo(:, 2,24,10) = (/ & + & 0.10471e+04_r8,0.79325e+03_r8,0.59650e+03_r8,0.87681e+03_r8,0.11585e+04_r8 /) + kbo(:, 3,24,10) = (/ & + & 0.10463e+04_r8,0.79243e+03_r8,0.59586e+03_r8,0.87587e+03_r8,0.11571e+04_r8 /) + kbo(:, 4,24,10) = (/ & + & 0.10454e+04_r8,0.79206e+03_r8,0.59508e+03_r8,0.87468e+03_r8,0.11555e+04_r8 /) + kbo(:, 5,24,10) = (/ & + & 0.10455e+04_r8,0.79146e+03_r8,0.59426e+03_r8,0.87360e+03_r8,0.11532e+04_r8 /) + kbo(:, 1,25,10) = (/ & + & 0.10443e+04_r8,0.79222e+03_r8,0.59698e+03_r8,0.87742e+03_r8,0.11598e+04_r8 /) + kbo(:, 2,25,10) = (/ & + & 0.10446e+04_r8,0.79165e+03_r8,0.59633e+03_r8,0.87696e+03_r8,0.11582e+04_r8 /) + kbo(:, 3,25,10) = (/ & + & 0.10440e+04_r8,0.79123e+03_r8,0.59567e+03_r8,0.87565e+03_r8,0.11568e+04_r8 /) + kbo(:, 4,25,10) = (/ & + & 0.10433e+04_r8,0.79106e+03_r8,0.59487e+03_r8,0.87451e+03_r8,0.11551e+04_r8 /) + kbo(:, 5,25,10) = (/ & + & 0.10423e+04_r8,0.79063e+03_r8,0.59375e+03_r8,0.87329e+03_r8,0.11525e+04_r8 /) + kbo(:, 1,26,10) = (/ & + & 0.10431e+04_r8,0.79112e+03_r8,0.59671e+03_r8,0.87720e+03_r8,0.11595e+04_r8 /) + kbo(:, 2,26,10) = (/ & + & 0.10430e+04_r8,0.79016e+03_r8,0.59608e+03_r8,0.87633e+03_r8,0.11579e+04_r8 /) + kbo(:, 3,26,10) = (/ & + & 0.10422e+04_r8,0.78992e+03_r8,0.59547e+03_r8,0.87551e+03_r8,0.11565e+04_r8 /) + kbo(:, 4,26,10) = (/ & + & 0.10418e+04_r8,0.78943e+03_r8,0.59456e+03_r8,0.87419e+03_r8,0.11545e+04_r8 /) + kbo(:, 5,26,10) = (/ & + & 0.10417e+04_r8,0.78966e+03_r8,0.59375e+03_r8,0.87285e+03_r8,0.11523e+04_r8 /) + kbo(:, 1,27,10) = (/ & + & 0.10421e+04_r8,0.78970e+03_r8,0.59653e+03_r8,0.87700e+03_r8,0.11589e+04_r8 /) + kbo(:, 2,27,10) = (/ & + & 0.10419e+04_r8,0.78911e+03_r8,0.59591e+03_r8,0.87623e+03_r8,0.11575e+04_r8 /) + kbo(:, 3,27,10) = (/ & + & 0.10414e+04_r8,0.78914e+03_r8,0.59527e+03_r8,0.87524e+03_r8,0.11555e+04_r8 /) + kbo(:, 4,27,10) = (/ & + & 0.10412e+04_r8,0.78891e+03_r8,0.59440e+03_r8,0.87398e+03_r8,0.11540e+04_r8 /) + kbo(:, 5,27,10) = (/ & + & 0.10400e+04_r8,0.78850e+03_r8,0.59354e+03_r8,0.87262e+03_r8,0.11516e+04_r8 /) + kbo(:, 1,28,10) = (/ & + & 0.10402e+04_r8,0.78860e+03_r8,0.59644e+03_r8,0.87682e+03_r8,0.11586e+04_r8 /) + kbo(:, 2,28,10) = (/ & + & 0.10405e+04_r8,0.78788e+03_r8,0.59574e+03_r8,0.87579e+03_r8,0.11571e+04_r8 /) + kbo(:, 3,28,10) = (/ & + & 0.10403e+04_r8,0.78855e+03_r8,0.59498e+03_r8,0.87473e+03_r8,0.11552e+04_r8 /) + kbo(:, 4,28,10) = (/ & + & 0.10397e+04_r8,0.78826e+03_r8,0.59417e+03_r8,0.87377e+03_r8,0.11534e+04_r8 /) + kbo(:, 5,28,10) = (/ & + & 0.10396e+04_r8,0.78810e+03_r8,0.59333e+03_r8,0.87227e+03_r8,0.11511e+04_r8 /) + kbo(:, 1,29,10) = (/ & + & 0.10391e+04_r8,0.78797e+03_r8,0.59612e+03_r8,0.87685e+03_r8,0.11584e+04_r8 /) + kbo(:, 2,29,10) = (/ & + & 0.10393e+04_r8,0.78808e+03_r8,0.59562e+03_r8,0.87577e+03_r8,0.11569e+04_r8 /) + kbo(:, 3,29,10) = (/ & + & 0.10401e+04_r8,0.78791e+03_r8,0.59476e+03_r8,0.87463e+03_r8,0.11550e+04_r8 /) + kbo(:, 4,29,10) = (/ & + & 0.10388e+04_r8,0.78727e+03_r8,0.59387e+03_r8,0.87332e+03_r8,0.11526e+04_r8 /) + kbo(:, 5,29,10) = (/ & + & 0.10383e+04_r8,0.78753e+03_r8,0.59306e+03_r8,0.87189e+03_r8,0.11504e+04_r8 /) + kbo(:, 1,30,10) = (/ & + & 0.10398e+04_r8,0.78748e+03_r8,0.59603e+03_r8,0.87643e+03_r8,0.11579e+04_r8 /) + kbo(:, 2,30,10) = (/ & + & 0.10387e+04_r8,0.78733e+03_r8,0.59550e+03_r8,0.87550e+03_r8,0.11567e+04_r8 /) + kbo(:, 3,30,10) = (/ & + & 0.10384e+04_r8,0.78700e+03_r8,0.59460e+03_r8,0.87431e+03_r8,0.11543e+04_r8 /) + kbo(:, 4,30,10) = (/ & + & 0.10381e+04_r8,0.78738e+03_r8,0.59372e+03_r8,0.87275e+03_r8,0.11522e+04_r8 /) + kbo(:, 5,30,10) = (/ & + & 0.10382e+04_r8,0.78707e+03_r8,0.59292e+03_r8,0.87137e+03_r8,0.11500e+04_r8 /) + kbo(:, 1,31,10) = (/ & + & 0.10388e+04_r8,0.78740e+03_r8,0.59593e+03_r8,0.87621e+03_r8,0.11575e+04_r8 /) + kbo(:, 2,31,10) = (/ & + & 0.10385e+04_r8,0.78757e+03_r8,0.59522e+03_r8,0.87522e+03_r8,0.11561e+04_r8 /) + kbo(:, 3,31,10) = (/ & + & 0.10386e+04_r8,0.78718e+03_r8,0.59436e+03_r8,0.87397e+03_r8,0.11540e+04_r8 /) + kbo(:, 4,31,10) = (/ & + & 0.10377e+04_r8,0.78650e+03_r8,0.59350e+03_r8,0.87250e+03_r8,0.11516e+04_r8 /) + kbo(:, 5,31,10) = (/ & + & 0.10376e+04_r8,0.78651e+03_r8,0.59269e+03_r8,0.87108e+03_r8,0.11495e+04_r8 /) + kbo(:, 1,32,10) = (/ & + & 0.10383e+04_r8,0.78682e+03_r8,0.59576e+03_r8,0.87597e+03_r8,0.11572e+04_r8 /) + kbo(:, 2,32,10) = (/ & + & 0.10383e+04_r8,0.78712e+03_r8,0.59500e+03_r8,0.87480e+03_r8,0.11556e+04_r8 /) + kbo(:, 3,32,10) = (/ & + & 0.10381e+04_r8,0.78606e+03_r8,0.59405e+03_r8,0.87362e+03_r8,0.11534e+04_r8 /) + kbo(:, 4,32,10) = (/ & + & 0.10372e+04_r8,0.78628e+03_r8,0.59329e+03_r8,0.87223e+03_r8,0.11510e+04_r8 /) + kbo(:, 5,32,10) = (/ & + & 0.10377e+04_r8,0.78690e+03_r8,0.59245e+03_r8,0.87068e+03_r8,0.11490e+04_r8 /) + kbo(:, 1,33,10) = (/ & + & 0.10380e+04_r8,0.78593e+03_r8,0.59549e+03_r8,0.87572e+03_r8,0.11567e+04_r8 /) + kbo(:, 2,33,10) = (/ & + & 0.10375e+04_r8,0.78654e+03_r8,0.59477e+03_r8,0.87458e+03_r8,0.11551e+04_r8 /) + kbo(:, 3,33,10) = (/ & + & 0.10374e+04_r8,0.78686e+03_r8,0.59389e+03_r8,0.87337e+03_r8,0.11527e+04_r8 /) + kbo(:, 4,33,10) = (/ & + & 0.10366e+04_r8,0.78593e+03_r8,0.59308e+03_r8,0.87194e+03_r8,0.11506e+04_r8 /) + kbo(:, 5,33,10) = (/ & + & 0.10369e+04_r8,0.78626e+03_r8,0.59219e+03_r8,0.87038e+03_r8,0.11486e+04_r8 /) + kbo(:, 1,34,10) = (/ & + & 0.10373e+04_r8,0.78657e+03_r8,0.59539e+03_r8,0.87559e+03_r8,0.11565e+04_r8 /) + kbo(:, 2,34,10) = (/ & + & 0.10370e+04_r8,0.78641e+03_r8,0.59464e+03_r8,0.87429e+03_r8,0.11546e+04_r8 /) + kbo(:, 3,34,10) = (/ & + & 0.10370e+04_r8,0.78587e+03_r8,0.59369e+03_r8,0.87295e+03_r8,0.11522e+04_r8 /) + kbo(:, 4,34,10) = (/ & + & 0.10371e+04_r8,0.78562e+03_r8,0.59289e+03_r8,0.87146e+03_r8,0.11500e+04_r8 /) + kbo(:, 5,34,10) = (/ & + & 0.10372e+04_r8,0.78597e+03_r8,0.59202e+03_r8,0.86991e+03_r8,0.11482e+04_r8 /) + kbo(:, 1,35,10) = (/ & + & 0.10364e+04_r8,0.78559e+03_r8,0.59529e+03_r8,0.87523e+03_r8,0.11563e+04_r8 /) + kbo(:, 2,35,10) = (/ & + & 0.10362e+04_r8,0.78545e+03_r8,0.59445e+03_r8,0.87400e+03_r8,0.11543e+04_r8 /) + kbo(:, 3,35,10) = (/ & + & 0.10372e+04_r8,0.78599e+03_r8,0.59365e+03_r8,0.87265e+03_r8,0.11519e+04_r8 /) + kbo(:, 4,35,10) = (/ & + & 0.10370e+04_r8,0.78527e+03_r8,0.59278e+03_r8,0.87136e+03_r8,0.11496e+04_r8 /) + kbo(:, 5,35,10) = (/ & + & 0.10363e+04_r8,0.78582e+03_r8,0.59179e+03_r8,0.86905e+03_r8,0.11477e+04_r8 /) + kbo(:, 1,36,10) = (/ & + & 0.10368e+04_r8,0.78515e+03_r8,0.59520e+03_r8,0.87532e+03_r8,0.11563e+04_r8 /) + kbo(:, 2,36,10) = (/ & + & 0.10358e+04_r8,0.78589e+03_r8,0.59443e+03_r8,0.87419e+03_r8,0.11542e+04_r8 /) + kbo(:, 3,36,10) = (/ & + & 0.10361e+04_r8,0.78556e+03_r8,0.59355e+03_r8,0.87273e+03_r8,0.11517e+04_r8 /) + kbo(:, 4,36,10) = (/ & + & 0.10361e+04_r8,0.78543e+03_r8,0.59275e+03_r8,0.87122e+03_r8,0.11497e+04_r8 /) + kbo(:, 5,36,10) = (/ & + & 0.10368e+04_r8,0.78570e+03_r8,0.59176e+03_r8,0.86999e+03_r8,0.11477e+04_r8 /) + kbo(:, 1,37,10) = (/ & + & 0.10363e+04_r8,0.78591e+03_r8,0.59537e+03_r8,0.87546e+03_r8,0.11565e+04_r8 /) + kbo(:, 2,37,10) = (/ & + & 0.10360e+04_r8,0.78548e+03_r8,0.59454e+03_r8,0.87425e+03_r8,0.11545e+04_r8 /) + kbo(:, 3,37,10) = (/ & + & 0.10362e+04_r8,0.78546e+03_r8,0.59366e+03_r8,0.87291e+03_r8,0.11521e+04_r8 /) + kbo(:, 4,37,10) = (/ & + & 0.10364e+04_r8,0.78543e+03_r8,0.59286e+03_r8,0.87142e+03_r8,0.11500e+04_r8 /) + kbo(:, 5,37,10) = (/ & + & 0.10360e+04_r8,0.78560e+03_r8,0.59177e+03_r8,0.86987e+03_r8,0.11482e+04_r8 /) + kbo(:, 1,38,10) = (/ & + & 0.10362e+04_r8,0.78542e+03_r8,0.59547e+03_r8,0.87560e+03_r8,0.11567e+04_r8 /) + kbo(:, 2,38,10) = (/ & + & 0.10357e+04_r8,0.78588e+03_r8,0.59466e+03_r8,0.87433e+03_r8,0.11549e+04_r8 /) + kbo(:, 3,38,10) = (/ & + & 0.10370e+04_r8,0.78605e+03_r8,0.59385e+03_r8,0.87310e+03_r8,0.11524e+04_r8 /) + kbo(:, 4,38,10) = (/ & + & 0.10362e+04_r8,0.78574e+03_r8,0.59297e+03_r8,0.87186e+03_r8,0.11501e+04_r8 /) + kbo(:, 5,38,10) = (/ & + & 0.10364e+04_r8,0.78533e+03_r8,0.59199e+03_r8,0.87009e+03_r8,0.11482e+04_r8 /) + kbo(:, 1,39,10) = (/ & + & 0.10359e+04_r8,0.78514e+03_r8,0.59557e+03_r8,0.87574e+03_r8,0.11567e+04_r8 /) + kbo(:, 2,39,10) = (/ & + & 0.10371e+04_r8,0.78541e+03_r8,0.59478e+03_r8,0.87461e+03_r8,0.11552e+04_r8 /) + kbo(:, 3,39,10) = (/ & + & 0.10366e+04_r8,0.78569e+03_r8,0.59382e+03_r8,0.87329e+03_r8,0.11528e+04_r8 /) + kbo(:, 4,39,10) = (/ & + & 0.10359e+04_r8,0.78528e+03_r8,0.59308e+03_r8,0.87198e+03_r8,0.11506e+04_r8 /) + kbo(:, 5,39,10) = (/ & + & 0.10356e+04_r8,0.78487e+03_r8,0.59220e+03_r8,0.87042e+03_r8,0.11486e+04_r8 /) + kbo(:, 1,40,10) = (/ & + & 0.10357e+04_r8,0.78518e+03_r8,0.59566e+03_r8,0.87586e+03_r8,0.11569e+04_r8 /) + kbo(:, 2,40,10) = (/ & + & 0.10357e+04_r8,0.78506e+03_r8,0.59498e+03_r8,0.87480e+03_r8,0.11555e+04_r8 /) + kbo(:, 3,40,10) = (/ & + & 0.10366e+04_r8,0.78504e+03_r8,0.59396e+03_r8,0.87362e+03_r8,0.11534e+04_r8 /) + kbo(:, 4,40,10) = (/ & + & 0.10363e+04_r8,0.78503e+03_r8,0.59319e+03_r8,0.87212e+03_r8,0.11511e+04_r8 /) + kbo(:, 5,40,10) = (/ & + & 0.10363e+04_r8,0.78540e+03_r8,0.59243e+03_r8,0.87078e+03_r8,0.11490e+04_r8 /) + kbo(:, 1,41,10) = (/ & + & 0.10363e+04_r8,0.78503e+03_r8,0.59590e+03_r8,0.87608e+03_r8,0.11576e+04_r8 /) + kbo(:, 2,41,10) = (/ & + & 0.10356e+04_r8,0.78491e+03_r8,0.59519e+03_r8,0.87520e+03_r8,0.11561e+04_r8 /) + kbo(:, 3,41,10) = (/ & + & 0.10364e+04_r8,0.78558e+03_r8,0.59433e+03_r8,0.87384e+03_r8,0.11540e+04_r8 /) + kbo(:, 4,41,10) = (/ & + & 0.10357e+04_r8,0.78518e+03_r8,0.59354e+03_r8,0.87259e+03_r8,0.11516e+04_r8 /) + kbo(:, 5,41,10) = (/ & + & 0.10360e+04_r8,0.78526e+03_r8,0.59259e+03_r8,0.87107e+03_r8,0.11495e+04_r8 /) + kbo(:, 1,42,10) = (/ & + & 0.10360e+04_r8,0.78488e+03_r8,0.59605e+03_r8,0.87553e+03_r8,0.11576e+04_r8 /) + kbo(:, 2,42,10) = (/ & + & 0.10363e+04_r8,0.78507e+03_r8,0.59538e+03_r8,0.87537e+03_r8,0.11565e+04_r8 /) + kbo(:, 3,42,10) = (/ & + & 0.10362e+04_r8,0.78535e+03_r8,0.59456e+03_r8,0.87429e+03_r8,0.11545e+04_r8 /) + kbo(:, 4,42,10) = (/ & + & 0.10361e+04_r8,0.78514e+03_r8,0.59368e+03_r8,0.87295e+03_r8,0.11522e+04_r8 /) + kbo(:, 5,42,10) = (/ & + & 0.10360e+04_r8,0.78523e+03_r8,0.59281e+03_r8,0.87146e+03_r8,0.11502e+04_r8 /) + kbo(:, 1,43,10) = (/ & + & 0.10359e+04_r8,0.78504e+03_r8,0.59624e+03_r8,0.87675e+03_r8,0.11584e+04_r8 /) + kbo(:, 2,43,10) = (/ & + & 0.10355e+04_r8,0.78552e+03_r8,0.59568e+03_r8,0.87580e+03_r8,0.11570e+04_r8 /) + kbo(:, 3,43,10) = (/ & + & 0.10354e+04_r8,0.78512e+03_r8,0.59483e+03_r8,0.87469e+03_r8,0.11553e+04_r8 /) + kbo(:, 4,43,10) = (/ & + & 0.10354e+04_r8,0.78569e+03_r8,0.59395e+03_r8,0.87316e+03_r8,0.11531e+04_r8 /) + kbo(:, 5,43,10) = (/ & + & 0.10359e+04_r8,0.78598e+03_r8,0.59313e+03_r8,0.87186e+03_r8,0.11507e+04_r8 /) + kbo(:, 1,44,10) = (/ & + & 0.10359e+04_r8,0.78521e+03_r8,0.59645e+03_r8,0.87700e+03_r8,0.11590e+04_r8 /) + kbo(:, 2,44,10) = (/ & + & 0.10361e+04_r8,0.78510e+03_r8,0.59583e+03_r8,0.87611e+03_r8,0.11574e+04_r8 /) + kbo(:, 3,44,10) = (/ & + & 0.10368e+04_r8,0.78519e+03_r8,0.59511e+03_r8,0.87509e+03_r8,0.11561e+04_r8 /) + kbo(:, 4,44,10) = (/ & + & 0.10360e+04_r8,0.78508e+03_r8,0.59424e+03_r8,0.87372e+03_r8,0.11538e+04_r8 /) + kbo(:, 5,44,10) = (/ & + & 0.10356e+04_r8,0.78537e+03_r8,0.59339e+03_r8,0.87213e+03_r8,0.11514e+04_r8 /) + kbo(:, 1,45,10) = (/ & + & 0.10357e+04_r8,0.78557e+03_r8,0.59666e+03_r8,0.87715e+03_r8,0.11597e+04_r8 /) + kbo(:, 2,45,10) = (/ & + & 0.10356e+04_r8,0.78527e+03_r8,0.59604e+03_r8,0.87639e+03_r8,0.11579e+04_r8 /) + kbo(:, 3,45,10) = (/ & + & 0.10360e+04_r8,0.78546e+03_r8,0.59537e+03_r8,0.87547e+03_r8,0.11565e+04_r8 /) + kbo(:, 4,45,10) = (/ & + & 0.10361e+04_r8,0.78506e+03_r8,0.59454e+03_r8,0.87427e+03_r8,0.11544e+04_r8 /) + kbo(:, 5,45,10) = (/ & + & 0.10353e+04_r8,0.78535e+03_r8,0.59366e+03_r8,0.87293e+03_r8,0.11520e+04_r8 /) + kbo(:, 1,46,10) = (/ & + & 0.10358e+04_r8,0.78506e+03_r8,0.59691e+03_r8,0.87749e+03_r8,0.11602e+04_r8 /) + kbo(:, 2,46,10) = (/ & + & 0.10353e+04_r8,0.78486e+03_r8,0.59626e+03_r8,0.87678e+03_r8,0.11584e+04_r8 /) + kbo(:, 3,46,10) = (/ & + & 0.10353e+04_r8,0.78495e+03_r8,0.59563e+03_r8,0.87572e+03_r8,0.11570e+04_r8 /) + kbo(:, 4,46,10) = (/ & + & 0.10363e+04_r8,0.78534e+03_r8,0.59478e+03_r8,0.87473e+03_r8,0.11554e+04_r8 /) + kbo(:, 5,46,10) = (/ & + & 0.10355e+04_r8,0.78455e+03_r8,0.59398e+03_r8,0.87342e+03_r8,0.11530e+04_r8 /) + kbo(:, 1,47,10) = (/ & + & 0.10357e+04_r8,0.78544e+03_r8,0.59719e+03_r8,0.87795e+03_r8,0.11609e+04_r8 /) + kbo(:, 2,47,10) = (/ & + & 0.10355e+04_r8,0.78533e+03_r8,0.59651e+03_r8,0.87696e+03_r8,0.11589e+04_r8 /) + kbo(:, 3,47,10) = (/ & + & 0.10358e+04_r8,0.78543e+03_r8,0.59590e+03_r8,0.87576e+03_r8,0.11576e+04_r8 /) + kbo(:, 4,47,10) = (/ & + & 0.10351e+04_r8,0.78562e+03_r8,0.59519e+03_r8,0.87521e+03_r8,0.11561e+04_r8 /) + kbo(:, 5,47,10) = (/ & + & 0.10359e+04_r8,0.78571e+03_r8,0.59433e+03_r8,0.87385e+03_r8,0.11540e+04_r8 /) + kbo(:, 1,48,10) = (/ & + & 0.10363e+04_r8,0.78513e+03_r8,0.59744e+03_r8,0.87846e+03_r8,0.11618e+04_r8 /) + kbo(:, 2,48,10) = (/ & + & 0.10360e+04_r8,0.78532e+03_r8,0.59677e+03_r8,0.87730e+03_r8,0.11598e+04_r8 /) + kbo(:, 3,48,10) = (/ & + & 0.10365e+04_r8,0.78483e+03_r8,0.59614e+03_r8,0.87707e+03_r8,0.11581e+04_r8 /) + kbo(:, 4,48,10) = (/ & + & 0.10355e+04_r8,0.78521e+03_r8,0.59549e+03_r8,0.87564e+03_r8,0.11567e+04_r8 /) + kbo(:, 5,48,10) = (/ & + & 0.10355e+04_r8,0.78531e+03_r8,0.59469e+03_r8,0.87448e+03_r8,0.11550e+04_r8 /) + kbo(:, 1,49,10) = (/ & + & 0.10351e+04_r8,0.78492e+03_r8,0.59768e+03_r8,0.87902e+03_r8,0.11625e+04_r8 /) + kbo(:, 2,49,10) = (/ & + & 0.10355e+04_r8,0.78541e+03_r8,0.59705e+03_r8,0.87772e+03_r8,0.11606e+04_r8 /) + kbo(:, 3,49,10) = (/ & + & 0.10352e+04_r8,0.78472e+03_r8,0.59639e+03_r8,0.87682e+03_r8,0.11587e+04_r8 /) + kbo(:, 4,49,10) = (/ & + & 0.10356e+04_r8,0.78511e+03_r8,0.59577e+03_r8,0.87591e+03_r8,0.11574e+04_r8 /) + kbo(:, 5,49,10) = (/ & + & 0.10352e+04_r8,0.78501e+03_r8,0.59510e+03_r8,0.87498e+03_r8,0.11558e+04_r8 /) + kbo(:, 1,50,10) = (/ & + & 0.10361e+04_r8,0.78540e+03_r8,0.59770e+03_r8,0.87956e+03_r8,0.11633e+04_r8 /) + kbo(:, 2,50,10) = (/ & + & 0.10357e+04_r8,0.78530e+03_r8,0.59731e+03_r8,0.87817e+03_r8,0.11612e+04_r8 /) + kbo(:, 3,50,10) = (/ & + & 0.10365e+04_r8,0.78510e+03_r8,0.59662e+03_r8,0.87710e+03_r8,0.11596e+04_r8 /) + kbo(:, 4,50,10) = (/ & + & 0.10365e+04_r8,0.78510e+03_r8,0.59601e+03_r8,0.87645e+03_r8,0.11578e+04_r8 /) + kbo(:, 5,50,10) = (/ & + & 0.10352e+04_r8,0.78588e+03_r8,0.59525e+03_r8,0.87541e+03_r8,0.11564e+04_r8 /) + kbo(:, 1,51,10) = (/ & + & 0.10356e+04_r8,0.78490e+03_r8,0.59781e+03_r8,0.88010e+03_r8,0.11639e+04_r8 /) + kbo(:, 2,51,10) = (/ & + & 0.10356e+04_r8,0.78539e+03_r8,0.59751e+03_r8,0.87866e+03_r8,0.11620e+04_r8 /) + kbo(:, 3,51,10) = (/ & + & 0.10359e+04_r8,0.78461e+03_r8,0.59687e+03_r8,0.87744e+03_r8,0.11601e+04_r8 /) + kbo(:, 4,51,10) = (/ & + & 0.10352e+04_r8,0.78519e+03_r8,0.59623e+03_r8,0.87674e+03_r8,0.11583e+04_r8 /) + kbo(:, 5,51,10) = (/ & + & 0.10356e+04_r8,0.78470e+03_r8,0.59552e+03_r8,0.87578e+03_r8,0.11569e+04_r8 /) + kbo(:, 1,52,10) = (/ & + & 0.10352e+04_r8,0.78509e+03_r8,0.59800e+03_r8,0.88094e+03_r8,0.11643e+04_r8 /) + kbo(:, 2,52,10) = (/ & + & 0.10355e+04_r8,0.78528e+03_r8,0.59763e+03_r8,0.87918e+03_r8,0.11627e+04_r8 /) + kbo(:, 3,52,10) = (/ & + & 0.10361e+04_r8,0.78479e+03_r8,0.59712e+03_r8,0.87762e+03_r8,0.11608e+04_r8 /) + kbo(:, 4,52,10) = (/ & + & 0.10358e+04_r8,0.78528e+03_r8,0.59645e+03_r8,0.87678e+03_r8,0.11589e+04_r8 /) + kbo(:, 5,52,10) = (/ & + & 0.10355e+04_r8,0.78528e+03_r8,0.59584e+03_r8,0.87612e+03_r8,0.11573e+04_r8 /) + kbo(:, 1,53,10) = (/ & + & 0.10357e+04_r8,0.78528e+03_r8,0.59832e+03_r8,0.88148e+03_r8,0.11650e+04_r8 /) + kbo(:, 2,53,10) = (/ & + & 0.10357e+04_r8,0.78596e+03_r8,0.59772e+03_r8,0.87969e+03_r8,0.11634e+04_r8 /) + kbo(:, 3,53,10) = (/ & + & 0.10361e+04_r8,0.78547e+03_r8,0.59737e+03_r8,0.87830e+03_r8,0.11614e+04_r8 /) + kbo(:, 4,53,10) = (/ & + & 0.10362e+04_r8,0.78537e+03_r8,0.59668e+03_r8,0.87707e+03_r8,0.11596e+04_r8 /) + kbo(:, 5,53,10) = (/ & + & 0.10356e+04_r8,0.78498e+03_r8,0.59606e+03_r8,0.87642e+03_r8,0.11578e+04_r8 /) + kbo(:, 1,54,10) = (/ & + & 0.10351e+04_r8,0.78567e+03_r8,0.59851e+03_r8,0.88199e+03_r8,0.11656e+04_r8 /) + kbo(:, 2,54,10) = (/ & + & 0.10366e+04_r8,0.78518e+03_r8,0.59776e+03_r8,0.88021e+03_r8,0.11638e+04_r8 /) + kbo(:, 3,54,10) = (/ & + & 0.10364e+04_r8,0.78478e+03_r8,0.59753e+03_r8,0.87875e+03_r8,0.11621e+04_r8 /) + kbo(:, 4,54,10) = (/ & + & 0.10356e+04_r8,0.78498e+03_r8,0.59692e+03_r8,0.87751e+03_r8,0.11602e+04_r8 /) + kbo(:, 5,54,10) = (/ & + & 0.10362e+04_r8,0.78527e+03_r8,0.59627e+03_r8,0.87657e+03_r8,0.11584e+04_r8 /) + kbo(:, 1,55,10) = (/ & + & 0.10355e+04_r8,0.78488e+03_r8,0.59876e+03_r8,0.88250e+03_r8,0.11663e+04_r8 /) + kbo(:, 2,55,10) = (/ & + & 0.10362e+04_r8,0.78527e+03_r8,0.59801e+03_r8,0.88087e+03_r8,0.11643e+04_r8 /) + kbo(:, 3,55,10) = (/ & + & 0.10356e+04_r8,0.78507e+03_r8,0.59764e+03_r8,0.87920e+03_r8,0.11628e+04_r8 /) + kbo(:, 4,55,10) = (/ & + & 0.10353e+04_r8,0.78488e+03_r8,0.59714e+03_r8,0.87787e+03_r8,0.11606e+04_r8 /) + kbo(:, 5,55,10) = (/ & + & 0.10356e+04_r8,0.78488e+03_r8,0.59639e+03_r8,0.87691e+03_r8,0.11585e+04_r8 /) + kbo(:, 1,56,10) = (/ & + & 0.10353e+04_r8,0.78537e+03_r8,0.59904e+03_r8,0.88318e+03_r8,0.11672e+04_r8 /) + kbo(:, 2,56,10) = (/ & + & 0.10354e+04_r8,0.78497e+03_r8,0.59830e+03_r8,0.88144e+03_r8,0.11649e+04_r8 /) + kbo(:, 3,56,10) = (/ & + & 0.10361e+04_r8,0.78536e+03_r8,0.59771e+03_r8,0.87966e+03_r8,0.11634e+04_r8 /) + kbo(:, 4,56,10) = (/ & + & 0.10357e+04_r8,0.78497e+03_r8,0.59736e+03_r8,0.87826e+03_r8,0.11615e+04_r8 /) + kbo(:, 5,56,10) = (/ & + & 0.10353e+04_r8,0.78478e+03_r8,0.59667e+03_r8,0.87705e+03_r8,0.11595e+04_r8 /) + kbo(:, 1,57,10) = (/ & + & 0.10358e+04_r8,0.78458e+03_r8,0.59927e+03_r8,0.88350e+03_r8,0.11679e+04_r8 /) + kbo(:, 2,57,10) = (/ & + & 0.10352e+04_r8,0.78536e+03_r8,0.59840e+03_r8,0.88193e+03_r8,0.11656e+04_r8 /) + kbo(:, 3,57,10) = (/ & + & 0.10352e+04_r8,0.78526e+03_r8,0.59782e+03_r8,0.88003e+03_r8,0.11638e+04_r8 /) + kbo(:, 4,57,10) = (/ & + & 0.10358e+04_r8,0.78497e+03_r8,0.59751e+03_r8,0.87869e+03_r8,0.11622e+04_r8 /) + kbo(:, 5,57,10) = (/ & + & 0.10360e+04_r8,0.78497e+03_r8,0.59689e+03_r8,0.87746e+03_r8,0.11601e+04_r8 /) + kbo(:, 1,58,10) = (/ & + & 0.10358e+04_r8,0.78468e+03_r8,0.59969e+03_r8,0.88402e+03_r8,0.11685e+04_r8 /) + kbo(:, 2,58,10) = (/ & + & 0.10357e+04_r8,0.78458e+03_r8,0.59873e+03_r8,0.88241e+03_r8,0.11662e+04_r8 /) + kbo(:, 3,58,10) = (/ & + & 0.10358e+04_r8,0.78526e+03_r8,0.59797e+03_r8,0.88085e+03_r8,0.11642e+04_r8 /) + kbo(:, 4,58,10) = (/ & + & 0.10356e+04_r8,0.78487e+03_r8,0.59762e+03_r8,0.87912e+03_r8,0.11626e+04_r8 /) + kbo(:, 5,58,10) = (/ & + & 0.10357e+04_r8,0.78565e+03_r8,0.59710e+03_r8,0.87769e+03_r8,0.11608e+04_r8 /) + kbo(:, 1,59,10) = (/ & + & 0.10360e+04_r8,0.78507e+03_r8,0.59979e+03_r8,0.88416e+03_r8,0.11687e+04_r8 /) + kbo(:, 2,59,10) = (/ & + & 0.10357e+04_r8,0.78477e+03_r8,0.59879e+03_r8,0.88260e+03_r8,0.11665e+04_r8 /) + kbo(:, 3,59,10) = (/ & + & 0.10350e+04_r8,0.78526e+03_r8,0.59804e+03_r8,0.88100e+03_r8,0.11644e+04_r8 /) + kbo(:, 4,59,10) = (/ & + & 0.10357e+04_r8,0.78467e+03_r8,0.59773e+03_r8,0.87930e+03_r8,0.11629e+04_r8 /) + kbo(:, 5,59,10) = (/ & + & 0.10358e+04_r8,0.78457e+03_r8,0.59718e+03_r8,0.87783e+03_r8,0.11609e+04_r8 /) + kbo(:, 1,13,11) = (/ & + & 0.11563e+04_r8,0.87491e+03_r8,0.60253e+03_r8,0.88362e+03_r8,0.11664e+04_r8 /) + kbo(:, 2,13,11) = (/ & + & 0.11454e+04_r8,0.86861e+03_r8,0.60211e+03_r8,0.88300e+03_r8,0.11639e+04_r8 /) + kbo(:, 3,13,11) = (/ & + & 0.11392e+04_r8,0.86181e+03_r8,0.60140e+03_r8,0.88181e+03_r8,0.11620e+04_r8 /) + kbo(:, 4,13,11) = (/ & + & 0.11315e+04_r8,0.85680e+03_r8,0.60042e+03_r8,0.88057e+03_r8,0.11602e+04_r8 /) + kbo(:, 5,13,11) = (/ & + & 0.11273e+04_r8,0.85330e+03_r8,0.59929e+03_r8,0.87908e+03_r8,0.11581e+04_r8 /) + kbo(:, 1,14,11) = (/ & + & 0.11333e+04_r8,0.85776e+03_r8,0.60215e+03_r8,0.88338e+03_r8,0.11660e+04_r8 /) + kbo(:, 2,14,11) = (/ & + & 0.11256e+04_r8,0.85211e+03_r8,0.60176e+03_r8,0.88258e+03_r8,0.11637e+04_r8 /) + kbo(:, 3,14,11) = (/ & + & 0.11185e+04_r8,0.84809e+03_r8,0.60101e+03_r8,0.88154e+03_r8,0.11618e+04_r8 /) + kbo(:, 4,14,11) = (/ & + & 0.11137e+04_r8,0.84328e+03_r8,0.59992e+03_r8,0.87989e+03_r8,0.11599e+04_r8 /) + kbo(:, 5,14,11) = (/ & + & 0.11092e+04_r8,0.83997e+03_r8,0.59898e+03_r8,0.87879e+03_r8,0.11581e+04_r8 /) + kbo(:, 1,15,11) = (/ & + & 0.11149e+04_r8,0.84435e+03_r8,0.60192e+03_r8,0.88317e+03_r8,0.11660e+04_r8 /) + kbo(:, 2,15,11) = (/ & + & 0.11071e+04_r8,0.83899e+03_r8,0.60145e+03_r8,0.88233e+03_r8,0.11635e+04_r8 /) + kbo(:, 3,15,11) = (/ & + & 0.11058e+04_r8,0.83612e+03_r8,0.60066e+03_r8,0.88128e+03_r8,0.11617e+04_r8 /) + kbo(:, 4,15,11) = (/ & + & 0.10996e+04_r8,0.83410e+03_r8,0.59965e+03_r8,0.88002e+03_r8,0.11599e+04_r8 /) + kbo(:, 5,15,11) = (/ & + & 0.10957e+04_r8,0.83022e+03_r8,0.59863e+03_r8,0.87850e+03_r8,0.11578e+04_r8 /) + kbo(:, 1,16,11) = (/ & + & 0.10993e+04_r8,0.83361e+03_r8,0.60157e+03_r8,0.88298e+03_r8,0.11657e+04_r8 /) + kbo(:, 2,16,11) = (/ & + & 0.10933e+04_r8,0.82961e+03_r8,0.60127e+03_r8,0.88210e+03_r8,0.11633e+04_r8 /) + kbo(:, 3,16,11) = (/ & + & 0.10924e+04_r8,0.82745e+03_r8,0.60035e+03_r8,0.88104e+03_r8,0.11615e+04_r8 /) + kbo(:, 4,16,11) = (/ & + & 0.10885e+04_r8,0.82319e+03_r8,0.59934e+03_r8,0.87977e+03_r8,0.11597e+04_r8 /) + kbo(:, 5,16,11) = (/ & + & 0.10838e+04_r8,0.82062e+03_r8,0.59823e+03_r8,0.87823e+03_r8,0.11577e+04_r8 /) + kbo(:, 1,17,11) = (/ & + & 0.10881e+04_r8,0.82385e+03_r8,0.60135e+03_r8,0.88282e+03_r8,0.11656e+04_r8 /) + kbo(:, 2,17,11) = (/ & + & 0.10840e+04_r8,0.82201e+03_r8,0.60094e+03_r8,0.88190e+03_r8,0.11631e+04_r8 /) + kbo(:, 3,17,11) = (/ & + & 0.10809e+04_r8,0.81908e+03_r8,0.60007e+03_r8,0.88083e+03_r8,0.11613e+04_r8 /) + kbo(:, 4,17,11) = (/ & + & 0.10772e+04_r8,0.81792e+03_r8,0.59907e+03_r8,0.87953e+03_r8,0.11595e+04_r8 /) + kbo(:, 5,17,11) = (/ & + & 0.10760e+04_r8,0.81580e+03_r8,0.59806e+03_r8,0.87798e+03_r8,0.11575e+04_r8 /) + kbo(:, 1,18,11) = (/ & + & 0.10780e+04_r8,0.81679e+03_r8,0.60116e+03_r8,0.88267e+03_r8,0.11653e+04_r8 /) + kbo(:, 2,18,11) = (/ & + & 0.10749e+04_r8,0.81512e+03_r8,0.60072e+03_r8,0.88171e+03_r8,0.11629e+04_r8 /) + kbo(:, 3,18,11) = (/ & + & 0.10728e+04_r8,0.81180e+03_r8,0.59983e+03_r8,0.88050e+03_r8,0.11611e+04_r8 /) + kbo(:, 4,18,11) = (/ & + & 0.10707e+04_r8,0.81081e+03_r8,0.59883e+03_r8,0.87944e+03_r8,0.11593e+04_r8 /) + kbo(:, 5,18,11) = (/ & + & 0.10678e+04_r8,0.80905e+03_r8,0.59782e+03_r8,0.87775e+03_r8,0.11574e+04_r8 /) + kbo(:, 1,19,11) = (/ & + & 0.10696e+04_r8,0.81122e+03_r8,0.60101e+03_r8,0.88252e+03_r8,0.11649e+04_r8 /) + kbo(:, 2,19,11) = (/ & + & 0.10692e+04_r8,0.80792e+03_r8,0.60053e+03_r8,0.88155e+03_r8,0.11625e+04_r8 /) + kbo(:, 3,19,11) = (/ & + & 0.10653e+04_r8,0.80791e+03_r8,0.59962e+03_r8,0.88058e+03_r8,0.11609e+04_r8 /) + kbo(:, 4,19,11) = (/ & + & 0.10635e+04_r8,0.80651e+03_r8,0.59853e+03_r8,0.87910e+03_r8,0.11591e+04_r8 /) + kbo(:, 5,19,11) = (/ & + & 0.10626e+04_r8,0.80552e+03_r8,0.59761e+03_r8,0.87753e+03_r8,0.11572e+04_r8 /) + kbo(:, 1,20,11) = (/ & + & 0.10638e+04_r8,0.80613e+03_r8,0.60096e+03_r8,0.88236e+03_r8,0.11646e+04_r8 /) + kbo(:, 2,20,11) = (/ & + & 0.10623e+04_r8,0.80416e+03_r8,0.60035e+03_r8,0.88137e+03_r8,0.11625e+04_r8 /) + kbo(:, 3,20,11) = (/ & + & 0.10590e+04_r8,0.80264e+03_r8,0.59950e+03_r8,0.88013e+03_r8,0.11607e+04_r8 /) + kbo(:, 4,20,11) = (/ & + & 0.10603e+04_r8,0.80308e+03_r8,0.59841e+03_r8,0.87915e+03_r8,0.11587e+04_r8 /) + kbo(:, 5,20,11) = (/ & + & 0.10573e+04_r8,0.80101e+03_r8,0.59740e+03_r8,0.87729e+03_r8,0.11568e+04_r8 /) + kbo(:, 1,21,11) = (/ & + & 0.10580e+04_r8,0.80255e+03_r8,0.60075e+03_r8,0.88233e+03_r8,0.11643e+04_r8 /) + kbo(:, 2,21,11) = (/ & + & 0.10580e+04_r8,0.80172e+03_r8,0.60017e+03_r8,0.88121e+03_r8,0.11623e+04_r8 /) + kbo(:, 3,21,11) = (/ & + & 0.10551e+04_r8,0.80129e+03_r8,0.59922e+03_r8,0.87954e+03_r8,0.11605e+04_r8 /) + kbo(:, 4,21,11) = (/ & + & 0.10544e+04_r8,0.79894e+03_r8,0.59822e+03_r8,0.87866e+03_r8,0.11586e+04_r8 /) + kbo(:, 5,21,11) = (/ & + & 0.10531e+04_r8,0.79850e+03_r8,0.59721e+03_r8,0.87693e+03_r8,0.11568e+04_r8 /) + kbo(:, 1,22,11) = (/ & + & 0.10535e+04_r8,0.79809e+03_r8,0.60064e+03_r8,0.88198e+03_r8,0.11639e+04_r8 /) + kbo(:, 2,22,11) = (/ & + & 0.10534e+04_r8,0.79679e+03_r8,0.59986e+03_r8,0.88098e+03_r8,0.11619e+04_r8 /) + kbo(:, 3,22,11) = (/ & + & 0.10517e+04_r8,0.79764e+03_r8,0.59897e+03_r8,0.87993e+03_r8,0.11602e+04_r8 /) + kbo(:, 4,22,11) = (/ & + & 0.10510e+04_r8,0.79739e+03_r8,0.59797e+03_r8,0.87835e+03_r8,0.11582e+04_r8 /) + kbo(:, 5,22,11) = (/ & + & 0.10492e+04_r8,0.79579e+03_r8,0.59697e+03_r8,0.87672e+03_r8,0.11565e+04_r8 /) + kbo(:, 1,23,11) = (/ & + & 0.10516e+04_r8,0.79606e+03_r8,0.60095e+03_r8,0.88176e+03_r8,0.11633e+04_r8 /) + kbo(:, 2,23,11) = (/ & + & 0.10497e+04_r8,0.79542e+03_r8,0.59972e+03_r8,0.88074e+03_r8,0.11616e+04_r8 /) + kbo(:, 3,23,11) = (/ & + & 0.10482e+04_r8,0.79453e+03_r8,0.59873e+03_r8,0.87952e+03_r8,0.11598e+04_r8 /) + kbo(:, 4,23,11) = (/ & + & 0.10486e+04_r8,0.79431e+03_r8,0.59782e+03_r8,0.87802e+03_r8,0.11579e+04_r8 /) + kbo(:, 5,23,11) = (/ & + & 0.10473e+04_r8,0.79522e+03_r8,0.59672e+03_r8,0.87637e+03_r8,0.11562e+04_r8 /) + kbo(:, 1,24,11) = (/ & + & 0.10467e+04_r8,0.79476e+03_r8,0.60034e+03_r8,0.88154e+03_r8,0.11630e+04_r8 /) + kbo(:, 2,24,11) = (/ & + & 0.10461e+04_r8,0.79357e+03_r8,0.59948e+03_r8,0.88049e+03_r8,0.11613e+04_r8 /) + kbo(:, 3,24,11) = (/ & + & 0.10460e+04_r8,0.79280e+03_r8,0.59849e+03_r8,0.87921e+03_r8,0.11596e+04_r8 /) + kbo(:, 4,24,11) = (/ & + & 0.10457e+04_r8,0.79222e+03_r8,0.59749e+03_r8,0.87768e+03_r8,0.11575e+04_r8 /) + kbo(:, 5,24,11) = (/ & + & 0.10450e+04_r8,0.79193e+03_r8,0.59639e+03_r8,0.87600e+03_r8,0.11558e+04_r8 /) + kbo(:, 1,25,11) = (/ & + & 0.10463e+04_r8,0.79209e+03_r8,0.60015e+03_r8,0.88131e+03_r8,0.11626e+04_r8 /) + kbo(:, 2,25,11) = (/ & + & 0.10455e+04_r8,0.79185e+03_r8,0.59924e+03_r8,0.87983e+03_r8,0.11609e+04_r8 /) + kbo(:, 3,25,11) = (/ & + & 0.10450e+04_r8,0.79214e+03_r8,0.59824e+03_r8,0.87889e+03_r8,0.11590e+04_r8 /) + kbo(:, 4,25,11) = (/ & + & 0.10445e+04_r8,0.79118e+03_r8,0.59725e+03_r8,0.87732e+03_r8,0.11571e+04_r8 /) + kbo(:, 5,25,11) = (/ & + & 0.10428e+04_r8,0.79168e+03_r8,0.59624e+03_r8,0.87561e+03_r8,0.11555e+04_r8 /) + kbo(:, 1,26,11) = (/ & + & 0.10437e+04_r8,0.79093e+03_r8,0.59993e+03_r8,0.88106e+03_r8,0.11624e+04_r8 /) + kbo(:, 2,26,11) = (/ & + & 0.10430e+04_r8,0.79091e+03_r8,0.59898e+03_r8,0.87993e+03_r8,0.11605e+04_r8 /) + kbo(:, 3,26,11) = (/ & + & 0.10430e+04_r8,0.79069e+03_r8,0.59808e+03_r8,0.87852e+03_r8,0.11586e+04_r8 /) + kbo(:, 4,26,11) = (/ & + & 0.10425e+04_r8,0.79087e+03_r8,0.59699e+03_r8,0.87692e+03_r8,0.11569e+04_r8 /) + kbo(:, 5,26,11) = (/ & + & 0.10414e+04_r8,0.78954e+03_r8,0.59598e+03_r8,0.87517e+03_r8,0.11547e+04_r8 /) + kbo(:, 1,27,11) = (/ & + & 0.10423e+04_r8,0.79028e+03_r8,0.59970e+03_r8,0.88080e+03_r8,0.11616e+04_r8 /) + kbo(:, 2,27,11) = (/ & + & 0.10415e+04_r8,0.78939e+03_r8,0.59872e+03_r8,0.87961e+03_r8,0.11600e+04_r8 /) + kbo(:, 3,27,11) = (/ & + & 0.10419e+04_r8,0.78972e+03_r8,0.59773e+03_r8,0.87814e+03_r8,0.11581e+04_r8 /) + kbo(:, 4,27,11) = (/ & + & 0.10405e+04_r8,0.78901e+03_r8,0.59673e+03_r8,0.87651e+03_r8,0.11564e+04_r8 /) + kbo(:, 5,27,11) = (/ & + & 0.10410e+04_r8,0.78880e+03_r8,0.59572e+03_r8,0.87471e+03_r8,0.11546e+04_r8 /) + kbo(:, 1,28,11) = (/ & + & 0.10411e+04_r8,0.78831e+03_r8,0.59945e+03_r8,0.88052e+03_r8,0.11614e+04_r8 /) + kbo(:, 2,28,11) = (/ & + & 0.10402e+04_r8,0.78866e+03_r8,0.59846e+03_r8,0.87954e+03_r8,0.11596e+04_r8 /) + kbo(:, 3,28,11) = (/ & + & 0.10401e+04_r8,0.78798e+03_r8,0.59747e+03_r8,0.87776e+03_r8,0.11577e+04_r8 /) + kbo(:, 4,28,11) = (/ & + & 0.10407e+04_r8,0.78779e+03_r8,0.59647e+03_r8,0.87596e+03_r8,0.11560e+04_r8 /) + kbo(:, 5,28,11) = (/ & + & 0.10407e+04_r8,0.78751e+03_r8,0.59548e+03_r8,0.87425e+03_r8,0.11542e+04_r8 /) + kbo(:, 1,29,11) = (/ & + & 0.10408e+04_r8,0.78876e+03_r8,0.59920e+03_r8,0.87983e+03_r8,0.11608e+04_r8 /) + kbo(:, 2,29,11) = (/ & + & 0.10408e+04_r8,0.78834e+03_r8,0.59820e+03_r8,0.87891e+03_r8,0.11591e+04_r8 /) + kbo(:, 3,29,11) = (/ & + & 0.10387e+04_r8,0.78864e+03_r8,0.59721e+03_r8,0.87735e+03_r8,0.11572e+04_r8 /) + kbo(:, 4,29,11) = (/ & + & 0.10384e+04_r8,0.78778e+03_r8,0.59621e+03_r8,0.87578e+03_r8,0.11555e+04_r8 /) + kbo(:, 5,29,11) = (/ & + & 0.10412e+04_r8,0.78824e+03_r8,0.59524e+03_r8,0.87368e+03_r8,0.11538e+04_r8 /) + kbo(:, 1,30,11) = (/ & + & 0.10383e+04_r8,0.78758e+03_r8,0.59894e+03_r8,0.87992e+03_r8,0.11605e+04_r8 /) + kbo(:, 2,30,11) = (/ & + & 0.10390e+04_r8,0.78755e+03_r8,0.59785e+03_r8,0.87840e+03_r8,0.11584e+04_r8 /) + kbo(:, 3,30,11) = (/ & + & 0.10391e+04_r8,0.78813e+03_r8,0.59695e+03_r8,0.87693e+03_r8,0.11568e+04_r8 /) + kbo(:, 4,30,11) = (/ & + & 0.10384e+04_r8,0.78683e+03_r8,0.59594e+03_r8,0.87519e+03_r8,0.11551e+04_r8 /) + kbo(:, 5,30,11) = (/ & + & 0.10388e+04_r8,0.78660e+03_r8,0.59501e+03_r8,0.87341e+03_r8,0.11534e+04_r8 /) + kbo(:, 1,31,11) = (/ & + & 0.10376e+04_r8,0.78640e+03_r8,0.59867e+03_r8,0.87959e+03_r8,0.11601e+04_r8 /) + kbo(:, 2,31,11) = (/ & + & 0.10381e+04_r8,0.78687e+03_r8,0.59768e+03_r8,0.87813e+03_r8,0.11581e+04_r8 /) + kbo(:, 3,31,11) = (/ & + & 0.10369e+04_r8,0.78736e+03_r8,0.59668e+03_r8,0.87650e+03_r8,0.11564e+04_r8 /) + kbo(:, 4,31,11) = (/ & + & 0.10380e+04_r8,0.78738e+03_r8,0.59577e+03_r8,0.87483e+03_r8,0.11546e+04_r8 /) + kbo(:, 5,31,11) = (/ & + & 0.10391e+04_r8,0.78671e+03_r8,0.59479e+03_r8,0.87299e+03_r8,0.11532e+04_r8 /) + kbo(:, 1,32,11) = (/ & + & 0.10371e+04_r8,0.78531e+03_r8,0.59840e+03_r8,0.87936e+03_r8,0.11596e+04_r8 /) + kbo(:, 2,32,11) = (/ & + & 0.10383e+04_r8,0.78734e+03_r8,0.59742e+03_r8,0.87771e+03_r8,0.11576e+04_r8 /) + kbo(:, 3,32,11) = (/ & + & 0.10363e+04_r8,0.78691e+03_r8,0.59641e+03_r8,0.87605e+03_r8,0.11559e+04_r8 /) + kbo(:, 4,32,11) = (/ & + & 0.10373e+04_r8,0.78648e+03_r8,0.59543e+03_r8,0.87420e+03_r8,0.11542e+04_r8 /) + kbo(:, 5,32,11) = (/ & + & 0.10376e+04_r8,0.78617e+03_r8,0.59455e+03_r8,0.87256e+03_r8,0.11529e+04_r8 /) + kbo(:, 1,33,11) = (/ & + & 0.10366e+04_r8,0.78725e+03_r8,0.59814e+03_r8,0.87885e+03_r8,0.11591e+04_r8 /) + kbo(:, 2,33,11) = (/ & + & 0.10366e+04_r8,0.78694e+03_r8,0.59715e+03_r8,0.87729e+03_r8,0.11572e+04_r8 /) + kbo(:, 3,33,11) = (/ & + & 0.10365e+04_r8,0.78534e+03_r8,0.59614e+03_r8,0.87545e+03_r8,0.11555e+04_r8 /) + kbo(:, 4,33,11) = (/ & + & 0.10377e+04_r8,0.78705e+03_r8,0.59518e+03_r8,0.87362e+03_r8,0.11536e+04_r8 /) + kbo(:, 5,33,11) = (/ & + & 0.10381e+04_r8,0.78546e+03_r8,0.59428e+03_r8,0.87201e+03_r8,0.11526e+04_r8 /) + kbo(:, 1,34,11) = (/ & + & 0.10370e+04_r8,0.78547e+03_r8,0.59791e+03_r8,0.87837e+03_r8,0.11586e+04_r8 /) + kbo(:, 2,34,11) = (/ & + & 0.10369e+04_r8,0.78635e+03_r8,0.59683e+03_r8,0.87691e+03_r8,0.11568e+04_r8 /) + kbo(:, 3,34,11) = (/ & + & 0.10373e+04_r8,0.78607e+03_r8,0.59591e+03_r8,0.87516e+03_r8,0.11551e+04_r8 /) + kbo(:, 4,34,11) = (/ & + & 0.10371e+04_r8,0.78696e+03_r8,0.59498e+03_r8,0.87338e+03_r8,0.11534e+04_r8 /) + kbo(:, 5,34,11) = (/ & + & 0.10366e+04_r8,0.78538e+03_r8,0.59374e+03_r8,0.87179e+03_r8,0.11524e+04_r8 /) + kbo(:, 1,35,11) = (/ & + & 0.10371e+04_r8,0.78681e+03_r8,0.59778e+03_r8,0.87830e+03_r8,0.11583e+04_r8 /) + kbo(:, 2,35,11) = (/ & + & 0.10367e+04_r8,0.78665e+03_r8,0.59678e+03_r8,0.87669e+03_r8,0.11566e+04_r8 /) + kbo(:, 3,35,11) = (/ & + & 0.10363e+04_r8,0.78613e+03_r8,0.59569e+03_r8,0.87491e+03_r8,0.11549e+04_r8 /) + kbo(:, 4,35,11) = (/ & + & 0.10364e+04_r8,0.78668e+03_r8,0.59487e+03_r8,0.87304e+03_r8,0.11533e+04_r8 /) + kbo(:, 5,35,11) = (/ & + & 0.10370e+04_r8,0.78641e+03_r8,0.59363e+03_r8,0.87159e+03_r8,0.11523e+04_r8 /) + kbo(:, 1,36,11) = (/ & + & 0.10366e+04_r8,0.78595e+03_r8,0.59775e+03_r8,0.87827e+03_r8,0.11583e+04_r8 /) + kbo(:, 2,36,11) = (/ & + & 0.10367e+04_r8,0.78568e+03_r8,0.59676e+03_r8,0.87652e+03_r8,0.11565e+04_r8 /) + kbo(:, 3,36,11) = (/ & + & 0.10363e+04_r8,0.78600e+03_r8,0.59575e+03_r8,0.87487e+03_r8,0.11548e+04_r8 /) + kbo(:, 4,36,11) = (/ & + & 0.10370e+04_r8,0.78596e+03_r8,0.59503e+03_r8,0.87314e+03_r8,0.11533e+04_r8 /) + kbo(:, 5,36,11) = (/ & + & 0.10356e+04_r8,0.78546e+03_r8,0.59359e+03_r8,0.87116e+03_r8,0.11523e+04_r8 /) + kbo(:, 1,37,11) = (/ & + & 0.10367e+04_r8,0.78524e+03_r8,0.59788e+03_r8,0.87847e+03_r8,0.11586e+04_r8 /) + kbo(:, 2,37,11) = (/ & + & 0.10373e+04_r8,0.78580e+03_r8,0.59689e+03_r8,0.87687e+03_r8,0.11567e+04_r8 /) + kbo(:, 3,37,11) = (/ & + & 0.10369e+04_r8,0.78554e+03_r8,0.59588e+03_r8,0.87512e+03_r8,0.11550e+04_r8 /) + kbo(:, 4,37,11) = (/ & + & 0.10372e+04_r8,0.78551e+03_r8,0.59495e+03_r8,0.87335e+03_r8,0.11534e+04_r8 /) + kbo(:, 5,37,11) = (/ & + & 0.10364e+04_r8,0.78631e+03_r8,0.59378e+03_r8,0.87175e+03_r8,0.11524e+04_r8 /) + kbo(:, 1,38,11) = (/ & + & 0.10372e+04_r8,0.78574e+03_r8,0.59801e+03_r8,0.87867e+03_r8,0.11588e+04_r8 /) + kbo(:, 2,38,11) = (/ & + & 0.10364e+04_r8,0.78476e+03_r8,0.59702e+03_r8,0.87710e+03_r8,0.11570e+04_r8 /) + kbo(:, 3,38,11) = (/ & + & 0.10351e+04_r8,0.78521e+03_r8,0.59593e+03_r8,0.87537e+03_r8,0.11553e+04_r8 /) + kbo(:, 4,38,11) = (/ & + & 0.10362e+04_r8,0.78507e+03_r8,0.59507e+03_r8,0.87344e+03_r8,0.11536e+04_r8 /) + kbo(:, 5,38,11) = (/ & + & 0.10371e+04_r8,0.78635e+03_r8,0.59400e+03_r8,0.87197e+03_r8,0.11525e+04_r8 /) + kbo(:, 1,39,11) = (/ & + & 0.10359e+04_r8,0.78601e+03_r8,0.59815e+03_r8,0.87888e+03_r8,0.11591e+04_r8 /) + kbo(:, 2,39,11) = (/ & + & 0.10375e+04_r8,0.78669e+03_r8,0.59716e+03_r8,0.87732e+03_r8,0.11572e+04_r8 /) + kbo(:, 3,39,11) = (/ & + & 0.10350e+04_r8,0.78597e+03_r8,0.59615e+03_r8,0.87562e+03_r8,0.11555e+04_r8 /) + kbo(:, 4,39,11) = (/ & + & 0.10366e+04_r8,0.78524e+03_r8,0.59519e+03_r8,0.87365e+03_r8,0.11538e+04_r8 /) + kbo(:, 5,39,11) = (/ & + & 0.10373e+04_r8,0.78605e+03_r8,0.59422e+03_r8,0.87205e+03_r8,0.11526e+04_r8 /) + kbo(:, 1,40,11) = (/ & + & 0.10361e+04_r8,0.78559e+03_r8,0.59838e+03_r8,0.87949e+03_r8,0.11596e+04_r8 /) + kbo(:, 2,40,11) = (/ & + & 0.10364e+04_r8,0.78533e+03_r8,0.59740e+03_r8,0.87771e+03_r8,0.11576e+04_r8 /) + kbo(:, 3,40,11) = (/ & + & 0.10357e+04_r8,0.78567e+03_r8,0.59640e+03_r8,0.87605e+03_r8,0.11559e+04_r8 /) + kbo(:, 4,40,11) = (/ & + & 0.10354e+04_r8,0.78518e+03_r8,0.59541e+03_r8,0.87434e+03_r8,0.11542e+04_r8 /) + kbo(:, 5,40,11) = (/ & + & 0.10361e+04_r8,0.78553e+03_r8,0.59453e+03_r8,0.87244e+03_r8,0.11529e+04_r8 /) + kbo(:, 1,41,11) = (/ & + & 0.10352e+04_r8,0.78554e+03_r8,0.59863e+03_r8,0.87958e+03_r8,0.11601e+04_r8 /) + kbo(:, 2,41,11) = (/ & + & 0.10361e+04_r8,0.78611e+03_r8,0.59765e+03_r8,0.87811e+03_r8,0.11581e+04_r8 /) + kbo(:, 3,41,11) = (/ & + & 0.10357e+04_r8,0.78586e+03_r8,0.59665e+03_r8,0.87648e+03_r8,0.11564e+04_r8 /) + kbo(:, 4,41,11) = (/ & + & 0.10369e+04_r8,0.78632e+03_r8,0.59556e+03_r8,0.87469e+03_r8,0.11547e+04_r8 /) + kbo(:, 5,41,11) = (/ & + & 0.10372e+04_r8,0.78631e+03_r8,0.59476e+03_r8,0.87298e+03_r8,0.11532e+04_r8 /) + kbo(:, 1,42,11) = (/ & + & 0.10352e+04_r8,0.78620e+03_r8,0.59889e+03_r8,0.87990e+03_r8,0.11605e+04_r8 /) + kbo(:, 2,42,11) = (/ & + & 0.10362e+04_r8,0.78666e+03_r8,0.59790e+03_r8,0.87851e+03_r8,0.11586e+04_r8 /) + kbo(:, 3,42,11) = (/ & + & 0.10358e+04_r8,0.78476e+03_r8,0.59691e+03_r8,0.87691e+03_r8,0.11568e+04_r8 /) + kbo(:, 4,42,11) = (/ & + & 0.10367e+04_r8,0.78534e+03_r8,0.59590e+03_r8,0.87517e+03_r8,0.11551e+04_r8 /) + kbo(:, 5,42,11) = (/ & + & 0.10374e+04_r8,0.78497e+03_r8,0.59497e+03_r8,0.87339e+03_r8,0.11533e+04_r8 /) + kbo(:, 1,43,11) = (/ & + & 0.10357e+04_r8,0.78569e+03_r8,0.59919e+03_r8,0.88014e+03_r8,0.11611e+04_r8 /) + kbo(:, 2,43,11) = (/ & + & 0.10384e+04_r8,0.78603e+03_r8,0.59811e+03_r8,0.87910e+03_r8,0.11592e+04_r8 /) + kbo(:, 3,43,11) = (/ & + & 0.10376e+04_r8,0.78685e+03_r8,0.59731e+03_r8,0.87742e+03_r8,0.11573e+04_r8 /) + kbo(:, 4,43,11) = (/ & + & 0.10368e+04_r8,0.78484e+03_r8,0.59612e+03_r8,0.87573e+03_r8,0.11555e+04_r8 /) + kbo(:, 5,43,11) = (/ & + & 0.10371e+04_r8,0.78612e+03_r8,0.59525e+03_r8,0.87389e+03_r8,0.11539e+04_r8 /) + kbo(:, 1,44,11) = (/ & + & 0.10362e+04_r8,0.78531e+03_r8,0.59952e+03_r8,0.88052e+03_r8,0.11615e+04_r8 /) + kbo(:, 2,44,11) = (/ & + & 0.10357e+04_r8,0.78506e+03_r8,0.59854e+03_r8,0.87945e+03_r8,0.11599e+04_r8 /) + kbo(:, 3,44,11) = (/ & + & 0.10347e+04_r8,0.78494e+03_r8,0.59755e+03_r8,0.87796e+03_r8,0.11576e+04_r8 /) + kbo(:, 4,44,11) = (/ & + & 0.10360e+04_r8,0.78599e+03_r8,0.59655e+03_r8,0.87632e+03_r8,0.11562e+04_r8 /) + kbo(:, 5,44,11) = (/ & + & 0.10364e+04_r8,0.78610e+03_r8,0.59556e+03_r8,0.87451e+03_r8,0.11545e+04_r8 /) + kbo(:, 1,45,11) = (/ & + & 0.10355e+04_r8,0.78552e+03_r8,0.59982e+03_r8,0.88100e+03_r8,0.11621e+04_r8 /) + kbo(:, 2,45,11) = (/ & + & 0.10357e+04_r8,0.78527e+03_r8,0.59887e+03_r8,0.87975e+03_r8,0.11605e+04_r8 /) + kbo(:, 3,45,11) = (/ & + & 0.10358e+04_r8,0.78432e+03_r8,0.59788e+03_r8,0.87848e+03_r8,0.11586e+04_r8 /) + kbo(:, 4,45,11) = (/ & + & 0.10358e+04_r8,0.78597e+03_r8,0.59689e+03_r8,0.87689e+03_r8,0.11568e+04_r8 /) + kbo(:, 5,45,11) = (/ & + & 0.10353e+04_r8,0.78525e+03_r8,0.59589e+03_r8,0.87514e+03_r8,0.11551e+04_r8 /) + kbo(:, 1,46,11) = (/ & + & 0.10358e+04_r8,0.78503e+03_r8,0.60010e+03_r8,0.88136e+03_r8,0.11629e+04_r8 /) + kbo(:, 2,46,11) = (/ & + & 0.10366e+04_r8,0.78667e+03_r8,0.59923e+03_r8,0.88004e+03_r8,0.11611e+04_r8 /) + kbo(:, 3,46,11) = (/ & + & 0.10372e+04_r8,0.78560e+03_r8,0.59824e+03_r8,0.87915e+03_r8,0.11593e+04_r8 /) + kbo(:, 4,46,11) = (/ & + & 0.10348e+04_r8,0.78513e+03_r8,0.59725e+03_r8,0.87748e+03_r8,0.11574e+04_r8 /) + kbo(:, 5,46,11) = (/ & + & 0.10372e+04_r8,0.78595e+03_r8,0.59625e+03_r8,0.87592e+03_r8,0.11557e+04_r8 /) + kbo(:, 1,47,11) = (/ & + & 0.10352e+04_r8,0.78466e+03_r8,0.60059e+03_r8,0.88175e+03_r8,0.11637e+04_r8 /) + kbo(:, 2,47,11) = (/ & + & 0.10362e+04_r8,0.78477e+03_r8,0.59970e+03_r8,0.88075e+03_r8,0.11618e+04_r8 /) + kbo(:, 3,47,11) = (/ & + & 0.10362e+04_r8,0.78559e+03_r8,0.59863e+03_r8,0.87958e+03_r8,0.11601e+04_r8 /) + kbo(:, 4,47,11) = (/ & + & 0.10356e+04_r8,0.78476e+03_r8,0.59765e+03_r8,0.87812e+03_r8,0.11581e+04_r8 /) + kbo(:, 5,47,11) = (/ & + & 0.10361e+04_r8,0.78428e+03_r8,0.59665e+03_r8,0.87649e+03_r8,0.11564e+04_r8 /) + kbo(:, 1,48,11) = (/ & + & 0.10354e+04_r8,0.78500e+03_r8,0.60042e+03_r8,0.88214e+03_r8,0.11645e+04_r8 /) + kbo(:, 2,48,11) = (/ & + & 0.10348e+04_r8,0.78582e+03_r8,0.59995e+03_r8,0.88117e+03_r8,0.11625e+04_r8 /) + kbo(:, 3,48,11) = (/ & + & 0.10353e+04_r8,0.78569e+03_r8,0.59903e+03_r8,0.87942e+03_r8,0.11608e+04_r8 /) + kbo(:, 4,48,11) = (/ & + & 0.10359e+04_r8,0.78569e+03_r8,0.59804e+03_r8,0.87873e+03_r8,0.11589e+04_r8 /) + kbo(:, 5,48,11) = (/ & + & 0.10354e+04_r8,0.78509e+03_r8,0.59705e+03_r8,0.87716e+03_r8,0.11570e+04_r8 /) + kbo(:, 1,49,11) = (/ & + & 0.10362e+04_r8,0.78463e+03_r8,0.60042e+03_r8,0.88242e+03_r8,0.11657e+04_r8 /) + kbo(:, 2,49,11) = (/ & + & 0.10367e+04_r8,0.78580e+03_r8,0.60023e+03_r8,0.88156e+03_r8,0.11633e+04_r8 /) + kbo(:, 3,49,11) = (/ & + & 0.10373e+04_r8,0.78533e+03_r8,0.59942e+03_r8,0.88054e+03_r8,0.11615e+04_r8 /) + kbo(:, 4,49,11) = (/ & + & 0.10373e+04_r8,0.78462e+03_r8,0.59844e+03_r8,0.87918e+03_r8,0.11595e+04_r8 /) + kbo(:, 5,49,11) = (/ & + & 0.10370e+04_r8,0.78532e+03_r8,0.59736e+03_r8,0.87781e+03_r8,0.11578e+04_r8 /) + kbo(:, 1,50,11) = (/ & + & 0.10356e+04_r8,0.78474e+03_r8,0.60056e+03_r8,0.88267e+03_r8,0.11666e+04_r8 /) + kbo(:, 2,50,11) = (/ & + & 0.10370e+04_r8,0.78497e+03_r8,0.60046e+03_r8,0.88192e+03_r8,0.11642e+04_r8 /) + kbo(:, 3,50,11) = (/ & + & 0.10348e+04_r8,0.78508e+03_r8,0.59977e+03_r8,0.88094e+03_r8,0.11634e+04_r8 /) + kbo(:, 4,50,11) = (/ & + & 0.10352e+04_r8,0.78473e+03_r8,0.59881e+03_r8,0.87954e+03_r8,0.11604e+04_r8 /) + kbo(:, 5,50,11) = (/ & + & 0.10360e+04_r8,0.78437e+03_r8,0.59782e+03_r8,0.87840e+03_r8,0.11585e+04_r8 /) + kbo(:, 1,51,11) = (/ & + & 0.10365e+04_r8,0.78532e+03_r8,0.60054e+03_r8,0.88306e+03_r8,0.11674e+04_r8 /) + kbo(:, 2,51,11) = (/ & + & 0.10360e+04_r8,0.78555e+03_r8,0.60046e+03_r8,0.88226e+03_r8,0.11651e+04_r8 /) + kbo(:, 3,51,11) = (/ & + & 0.10359e+04_r8,0.78508e+03_r8,0.60006e+03_r8,0.88131e+03_r8,0.11628e+04_r8 /) + kbo(:, 4,51,11) = (/ & + & 0.10359e+04_r8,0.78554e+03_r8,0.59917e+03_r8,0.88011e+03_r8,0.11610e+04_r8 /) + kbo(:, 5,51,11) = (/ & + & 0.10363e+04_r8,0.78507e+03_r8,0.59818e+03_r8,0.87894e+03_r8,0.11592e+04_r8 /) + kbo(:, 1,52,11) = (/ & + & 0.10357e+04_r8,0.78531e+03_r8,0.60048e+03_r8,0.88333e+03_r8,0.11687e+04_r8 /) + kbo(:, 2,52,11) = (/ & + & 0.10368e+04_r8,0.78554e+03_r8,0.60053e+03_r8,0.88249e+03_r8,0.11660e+04_r8 /) + kbo(:, 3,52,11) = (/ & + & 0.10362e+04_r8,0.78601e+03_r8,0.60037e+03_r8,0.88166e+03_r8,0.11635e+04_r8 /) + kbo(:, 4,52,11) = (/ & + & 0.10354e+04_r8,0.78507e+03_r8,0.59952e+03_r8,0.88066e+03_r8,0.11617e+04_r8 /) + kbo(:, 5,52,11) = (/ & + & 0.10363e+04_r8,0.78565e+03_r8,0.59854e+03_r8,0.87959e+03_r8,0.11599e+04_r8 /) + kbo(:, 1,53,11) = (/ & + & 0.10366e+04_r8,0.78460e+03_r8,0.60030e+03_r8,0.88415e+03_r8,0.11699e+04_r8 /) + kbo(:, 2,53,11) = (/ & + & 0.10366e+04_r8,0.78400e+03_r8,0.60056e+03_r8,0.88262e+03_r8,0.11668e+04_r8 /) + kbo(:, 3,53,11) = (/ & + & 0.10358e+04_r8,0.78459e+03_r8,0.60039e+03_r8,0.88202e+03_r8,0.11644e+04_r8 /) + kbo(:, 4,53,11) = (/ & + & 0.10348e+04_r8,0.78471e+03_r8,0.59985e+03_r8,0.88104e+03_r8,0.11623e+04_r8 /) + kbo(:, 5,53,11) = (/ & + & 0.10366e+04_r8,0.78577e+03_r8,0.59891e+03_r8,0.87992e+03_r8,0.11606e+04_r8 /) + kbo(:, 1,54,11) = (/ & + & 0.10355e+04_r8,0.78471e+03_r8,0.60033e+03_r8,0.88501e+03_r8,0.11708e+04_r8 /) + kbo(:, 2,54,11) = (/ & + & 0.10360e+04_r8,0.78494e+03_r8,0.60053e+03_r8,0.88313e+03_r8,0.11678e+04_r8 /) + kbo(:, 3,54,11) = (/ & + & 0.10360e+04_r8,0.78671e+03_r8,0.60047e+03_r8,0.88230e+03_r8,0.11652e+04_r8 /) + kbo(:, 4,54,11) = (/ & + & 0.10355e+04_r8,0.78588e+03_r8,0.60010e+03_r8,0.88137e+03_r8,0.11629e+04_r8 /) + kbo(:, 5,54,11) = (/ & + & 0.10357e+04_r8,0.78517e+03_r8,0.59924e+03_r8,0.88032e+03_r8,0.11612e+04_r8 /) + kbo(:, 1,55,11) = (/ & + & 0.10357e+04_r8,0.78506e+03_r8,0.60035e+03_r8,0.88567e+03_r8,0.11714e+04_r8 /) + kbo(:, 2,55,11) = (/ & + & 0.10357e+04_r8,0.78518e+03_r8,0.60047e+03_r8,0.88349e+03_r8,0.11688e+04_r8 /) + kbo(:, 3,55,11) = (/ & + & 0.10361e+04_r8,0.78517e+03_r8,0.60053e+03_r8,0.88250e+03_r8,0.11660e+04_r8 /) + kbo(:, 4,55,11) = (/ & + & 0.10357e+04_r8,0.78529e+03_r8,0.60029e+03_r8,0.88168e+03_r8,0.11636e+04_r8 /) + kbo(:, 5,55,11) = (/ & + & 0.10360e+04_r8,0.78529e+03_r8,0.59954e+03_r8,0.88068e+03_r8,0.11617e+04_r8 /) + kbo(:, 1,56,11) = (/ & + & 0.10361e+04_r8,0.78494e+03_r8,0.60049e+03_r8,0.88607e+03_r8,0.11718e+04_r8 /) + kbo(:, 2,56,11) = (/ & + & 0.10360e+04_r8,0.78482e+03_r8,0.60030e+03_r8,0.88410e+03_r8,0.11698e+04_r8 /) + kbo(:, 3,56,11) = (/ & + & 0.10354e+04_r8,0.78493e+03_r8,0.60056e+03_r8,0.88273e+03_r8,0.11667e+04_r8 /) + kbo(:, 4,56,11) = (/ & + & 0.10357e+04_r8,0.78552e+03_r8,0.60038e+03_r8,0.88199e+03_r8,0.11645e+04_r8 /) + kbo(:, 5,56,11) = (/ & + & 0.10357e+04_r8,0.78517e+03_r8,0.59983e+03_r8,0.88101e+03_r8,0.11624e+04_r8 /) + kbo(:, 1,57,11) = (/ & + & 0.10357e+04_r8,0.78588e+03_r8,0.60099e+03_r8,0.88686e+03_r8,0.11725e+04_r8 /) + kbo(:, 2,57,11) = (/ & + & 0.10366e+04_r8,0.78458e+03_r8,0.60033e+03_r8,0.88491e+03_r8,0.11707e+04_r8 /) + kbo(:, 3,57,11) = (/ & + & 0.10366e+04_r8,0.78481e+03_r8,0.60053e+03_r8,0.88335e+03_r8,0.11676e+04_r8 /) + kbo(:, 4,57,11) = (/ & + & 0.10358e+04_r8,0.78611e+03_r8,0.60046e+03_r8,0.88227e+03_r8,0.11650e+04_r8 /) + kbo(:, 5,57,11) = (/ & + & 0.10355e+04_r8,0.78599e+03_r8,0.60008e+03_r8,0.88133e+03_r8,0.11630e+04_r8 /) + kbo(:, 1,58,11) = (/ & + & 0.10363e+04_r8,0.78576e+03_r8,0.60143e+03_r8,0.88764e+03_r8,0.11733e+04_r8 /) + kbo(:, 2,58,11) = (/ & + & 0.10354e+04_r8,0.78611e+03_r8,0.60042e+03_r8,0.88557e+03_r8,0.11713e+04_r8 /) + kbo(:, 3,58,11) = (/ & + & 0.10363e+04_r8,0.78576e+03_r8,0.60048e+03_r8,0.88329e+03_r8,0.11686e+04_r8 /) + kbo(:, 4,58,11) = (/ & + & 0.10364e+04_r8,0.78505e+03_r8,0.60052e+03_r8,0.88247e+03_r8,0.11659e+04_r8 /) + kbo(:, 5,58,11) = (/ & + & 0.10357e+04_r8,0.78552e+03_r8,0.60026e+03_r8,0.88163e+03_r8,0.11633e+04_r8 /) + kbo(:, 1,59,11) = (/ & + & 0.10354e+04_r8,0.78634e+03_r8,0.60176e+03_r8,0.88797e+03_r8,0.11736e+04_r8 /) + kbo(:, 2,59,11) = (/ & + & 0.10350e+04_r8,0.78505e+03_r8,0.60038e+03_r8,0.88577e+03_r8,0.11715e+04_r8 /) + kbo(:, 3,59,11) = (/ & + & 0.10360e+04_r8,0.78469e+03_r8,0.60046e+03_r8,0.88358e+03_r8,0.11703e+04_r8 /) + kbo(:, 4,59,11) = (/ & + & 0.10357e+04_r8,0.78493e+03_r8,0.60045e+03_r8,0.88254e+03_r8,0.11662e+04_r8 /) + kbo(:, 5,59,11) = (/ & + & 0.10366e+04_r8,0.78516e+03_r8,0.60041e+03_r8,0.88174e+03_r8,0.11637e+04_r8 /) + kbo(:, 1,13,12) = (/ & + & 0.11535e+04_r8,0.87955e+03_r8,0.60434e+03_r8,0.88744e+03_r8,0.11710e+04_r8 /) + kbo(:, 2,13,12) = (/ & + & 0.11485e+04_r8,0.86886e+03_r8,0.60369e+03_r8,0.88598e+03_r8,0.11697e+04_r8 /) + kbo(:, 3,13,12) = (/ & + & 0.11395e+04_r8,0.86441e+03_r8,0.60332e+03_r8,0.88477e+03_r8,0.11680e+04_r8 /) + kbo(:, 4,13,12) = (/ & + & 0.11350e+04_r8,0.86216e+03_r8,0.60276e+03_r8,0.88294e+03_r8,0.11659e+04_r8 /) + kbo(:, 5,13,12) = (/ & + & 0.11237e+04_r8,0.85514e+03_r8,0.60186e+03_r8,0.88131e+03_r8,0.11640e+04_r8 /) + kbo(:, 1,14,12) = (/ & + & 0.11312e+04_r8,0.85960e+03_r8,0.60391e+03_r8,0.88683e+03_r8,0.11708e+04_r8 /) + kbo(:, 2,14,12) = (/ & + & 0.11248e+04_r8,0.85192e+03_r8,0.60329e+03_r8,0.88591e+03_r8,0.11696e+04_r8 /) + kbo(:, 3,14,12) = (/ & + & 0.11210e+04_r8,0.84824e+03_r8,0.60297e+03_r8,0.88444e+03_r8,0.11678e+04_r8 /) + kbo(:, 4,14,12) = (/ & + & 0.11139e+04_r8,0.84322e+03_r8,0.60241e+03_r8,0.88264e+03_r8,0.11657e+04_r8 /) + kbo(:, 5,14,12) = (/ & + & 0.11123e+04_r8,0.84158e+03_r8,0.60150e+03_r8,0.88104e+03_r8,0.11639e+04_r8 /) + kbo(:, 1,15,12) = (/ & + & 0.11159e+04_r8,0.84414e+03_r8,0.60344e+03_r8,0.88657e+03_r8,0.11715e+04_r8 /) + kbo(:, 2,15,12) = (/ & + & 0.11106e+04_r8,0.84043e+03_r8,0.60296e+03_r8,0.88568e+03_r8,0.11695e+04_r8 /) + kbo(:, 3,15,12) = (/ & + & 0.11018e+04_r8,0.83588e+03_r8,0.60268e+03_r8,0.88413e+03_r8,0.11676e+04_r8 /) + kbo(:, 4,15,12) = (/ & + & 0.10976e+04_r8,0.83213e+03_r8,0.60210e+03_r8,0.88235e+03_r8,0.11655e+04_r8 /) + kbo(:, 5,15,12) = (/ & + & 0.10965e+04_r8,0.83273e+03_r8,0.60128e+03_r8,0.88077e+03_r8,0.11639e+04_r8 /) + kbo(:, 1,16,12) = (/ & + & 0.11003e+04_r8,0.83414e+03_r8,0.60325e+03_r8,0.88634e+03_r8,0.11705e+04_r8 /) + kbo(:, 2,16,12) = (/ & + & 0.10991e+04_r8,0.82921e+03_r8,0.60259e+03_r8,0.88546e+03_r8,0.11694e+04_r8 /) + kbo(:, 3,16,12) = (/ & + & 0.10955e+04_r8,0.82665e+03_r8,0.60243e+03_r8,0.88384e+03_r8,0.11674e+04_r8 /) + kbo(:, 4,16,12) = (/ & + & 0.10851e+04_r8,0.82401e+03_r8,0.60183e+03_r8,0.88207e+03_r8,0.11653e+04_r8 /) + kbo(:, 5,16,12) = (/ & + & 0.10849e+04_r8,0.82356e+03_r8,0.60085e+03_r8,0.88053e+03_r8,0.11635e+04_r8 /) + kbo(:, 1,17,12) = (/ & + & 0.10876e+04_r8,0.82527e+03_r8,0.60299e+03_r8,0.88614e+03_r8,0.11702e+04_r8 /) + kbo(:, 2,17,12) = (/ & + & 0.10859e+04_r8,0.82135e+03_r8,0.60250e+03_r8,0.88526e+03_r8,0.11692e+04_r8 /) + kbo(:, 3,17,12) = (/ & + & 0.10841e+04_r8,0.81891e+03_r8,0.60222e+03_r8,0.88356e+03_r8,0.11671e+04_r8 /) + kbo(:, 4,17,12) = (/ & + & 0.10784e+04_r8,0.81708e+03_r8,0.60159e+03_r8,0.88183e+03_r8,0.11651e+04_r8 /) + kbo(:, 5,17,12) = (/ & + & 0.10763e+04_r8,0.81350e+03_r8,0.60170e+03_r8,0.88030e+03_r8,0.11634e+04_r8 /) + kbo(:, 1,18,12) = (/ & + & 0.10781e+04_r8,0.81748e+03_r8,0.60276e+03_r8,0.88597e+03_r8,0.11700e+04_r8 /) + kbo(:, 2,18,12) = (/ & + & 0.10771e+04_r8,0.81396e+03_r8,0.60232e+03_r8,0.88573e+03_r8,0.11691e+04_r8 /) + kbo(:, 3,18,12) = (/ & + & 0.10718e+04_r8,0.81415e+03_r8,0.60204e+03_r8,0.88331e+03_r8,0.11669e+04_r8 /) + kbo(:, 4,18,12) = (/ & + & 0.10689e+04_r8,0.81027e+03_r8,0.60137e+03_r8,0.88144e+03_r8,0.11649e+04_r8 /) + kbo(:, 5,18,12) = (/ & + & 0.10691e+04_r8,0.80937e+03_r8,0.60029e+03_r8,0.88009e+03_r8,0.11632e+04_r8 /) + kbo(:, 1,19,12) = (/ & + & 0.10732e+04_r8,0.81093e+03_r8,0.60257e+03_r8,0.88582e+03_r8,0.11702e+04_r8 /) + kbo(:, 2,19,12) = (/ & + & 0.10665e+04_r8,0.81093e+03_r8,0.60218e+03_r8,0.88486e+03_r8,0.11689e+04_r8 /) + kbo(:, 3,19,12) = (/ & + & 0.10668e+04_r8,0.80596e+03_r8,0.60188e+03_r8,0.88291e+03_r8,0.11667e+04_r8 /) + kbo(:, 4,19,12) = (/ & + & 0.10625e+04_r8,0.80871e+03_r8,0.60129e+03_r8,0.88139e+03_r8,0.11647e+04_r8 /) + kbo(:, 5,19,12) = (/ & + & 0.10641e+04_r8,0.80549e+03_r8,0.60005e+03_r8,0.87990e+03_r8,0.11631e+04_r8 /) + kbo(:, 1,20,12) = (/ & + & 0.10655e+04_r8,0.80608e+03_r8,0.60228e+03_r8,0.88568e+03_r8,0.11700e+04_r8 /) + kbo(:, 2,20,12) = (/ & + & 0.10621e+04_r8,0.80582e+03_r8,0.60205e+03_r8,0.88462e+03_r8,0.11686e+04_r8 /) + kbo(:, 3,20,12) = (/ & + & 0.10596e+04_r8,0.80439e+03_r8,0.60161e+03_r8,0.88282e+03_r8,0.11664e+04_r8 /) + kbo(:, 4,20,12) = (/ & + & 0.10569e+04_r8,0.80052e+03_r8,0.60133e+03_r8,0.88084e+03_r8,0.11645e+04_r8 /) + kbo(:, 5,20,12) = (/ & + & 0.10576e+04_r8,0.80029e+03_r8,0.59980e+03_r8,0.87969e+03_r8,0.11629e+04_r8 /) + kbo(:, 1,21,12) = (/ & + & 0.10601e+04_r8,0.80047e+03_r8,0.60235e+03_r8,0.88539e+03_r8,0.11699e+04_r8 /) + kbo(:, 2,21,12) = (/ & + & 0.10553e+04_r8,0.80126e+03_r8,0.60195e+03_r8,0.88437e+03_r8,0.11684e+04_r8 /) + kbo(:, 3,21,12) = (/ & + & 0.10581e+04_r8,0.79916e+03_r8,0.60159e+03_r8,0.88257e+03_r8,0.11662e+04_r8 /) + kbo(:, 4,21,12) = (/ & + & 0.10523e+04_r8,0.79871e+03_r8,0.60090e+03_r8,0.88096e+03_r8,0.11643e+04_r8 /) + kbo(:, 5,21,12) = (/ & + & 0.10536e+04_r8,0.79852e+03_r8,0.59957e+03_r8,0.87950e+03_r8,0.11627e+04_r8 /) + kbo(:, 1,22,12) = (/ & + & 0.10543e+04_r8,0.79995e+03_r8,0.60207e+03_r8,0.88538e+03_r8,0.11697e+04_r8 /) + kbo(:, 2,22,12) = (/ & + & 0.10531e+04_r8,0.79794e+03_r8,0.60195e+03_r8,0.88401e+03_r8,0.11680e+04_r8 /) + kbo(:, 3,22,12) = (/ & + & 0.10510e+04_r8,0.79590e+03_r8,0.60141e+03_r8,0.88205e+03_r8,0.11658e+04_r8 /) + kbo(:, 4,22,12) = (/ & + & 0.10516e+04_r8,0.79518e+03_r8,0.60121e+03_r8,0.88065e+03_r8,0.11640e+04_r8 /) + kbo(:, 5,22,12) = (/ & + & 0.10507e+04_r8,0.79514e+03_r8,0.59925e+03_r8,0.87922e+03_r8,0.11625e+04_r8 /) + kbo(:, 1,23,12) = (/ & + & 0.10496e+04_r8,0.79686e+03_r8,0.60138e+03_r8,0.88518e+03_r8,0.11695e+04_r8 /) + kbo(:, 2,23,12) = (/ & + & 0.10500e+04_r8,0.79504e+03_r8,0.60174e+03_r8,0.88363e+03_r8,0.11675e+04_r8 /) + kbo(:, 3,23,12) = (/ & + & 0.10497e+04_r8,0.79559e+03_r8,0.60122e+03_r8,0.88187e+03_r8,0.11654e+04_r8 /) + kbo(:, 4,23,12) = (/ & + & 0.10478e+04_r8,0.79456e+03_r8,0.60013e+03_r8,0.88034e+03_r8,0.11637e+04_r8 /) + kbo(:, 5,23,12) = (/ & + & 0.10481e+04_r8,0.79269e+03_r8,0.59893e+03_r8,0.87894e+03_r8,0.11623e+04_r8 /) + kbo(:, 1,24,12) = (/ & + & 0.10504e+04_r8,0.79322e+03_r8,0.60186e+03_r8,0.88494e+03_r8,0.11692e+04_r8 /) + kbo(:, 2,24,12) = (/ & + & 0.10474e+04_r8,0.79292e+03_r8,0.60174e+03_r8,0.88325e+03_r8,0.11671e+04_r8 /) + kbo(:, 3,24,12) = (/ & + & 0.10457e+04_r8,0.79315e+03_r8,0.60103e+03_r8,0.88153e+03_r8,0.11648e+04_r8 /) + kbo(:, 4,24,12) = (/ & + & 0.10462e+04_r8,0.79329e+03_r8,0.59996e+03_r8,0.88003e+03_r8,0.11633e+04_r8 /) + kbo(:, 5,24,12) = (/ & + & 0.10477e+04_r8,0.79348e+03_r8,0.59860e+03_r8,0.87867e+03_r8,0.11620e+04_r8 /) + kbo(:, 1,25,12) = (/ & + & 0.10437e+04_r8,0.79315e+03_r8,0.60179e+03_r8,0.88497e+03_r8,0.11688e+04_r8 /) + kbo(:, 2,25,12) = (/ & + & 0.10446e+04_r8,0.79177e+03_r8,0.60151e+03_r8,0.88285e+03_r8,0.11666e+04_r8 /) + kbo(:, 3,25,12) = (/ & + & 0.10443e+04_r8,0.79105e+03_r8,0.60081e+03_r8,0.88119e+03_r8,0.11647e+04_r8 /) + kbo(:, 4,25,12) = (/ & + & 0.10440e+04_r8,0.79204e+03_r8,0.59965e+03_r8,0.87971e+03_r8,0.11630e+04_r8 /) + kbo(:, 5,25,12) = (/ & + & 0.10441e+04_r8,0.79141e+03_r8,0.59825e+03_r8,0.87840e+03_r8,0.11618e+04_r8 /) + kbo(:, 1,26,12) = (/ & + & 0.10444e+04_r8,0.79040e+03_r8,0.60171e+03_r8,0.88422e+03_r8,0.11681e+04_r8 /) + kbo(:, 2,26,12) = (/ & + & 0.10415e+04_r8,0.78987e+03_r8,0.60136e+03_r8,0.88243e+03_r8,0.11661e+04_r8 /) + kbo(:, 3,26,12) = (/ & + & 0.10417e+04_r8,0.79014e+03_r8,0.60043e+03_r8,0.88082e+03_r8,0.11642e+04_r8 /) + kbo(:, 4,26,12) = (/ & + & 0.10442e+04_r8,0.78985e+03_r8,0.59932e+03_r8,0.87937e+03_r8,0.11625e+04_r8 /) + kbo(:, 5,26,12) = (/ & + & 0.10421e+04_r8,0.79004e+03_r8,0.59787e+03_r8,0.87814e+03_r8,0.11615e+04_r8 /) + kbo(:, 1,27,12) = (/ & + & 0.10431e+04_r8,0.78868e+03_r8,0.60163e+03_r8,0.88378e+03_r8,0.11678e+04_r8 /) + kbo(:, 2,27,12) = (/ & + & 0.10423e+04_r8,0.79138e+03_r8,0.60118e+03_r8,0.88201e+03_r8,0.11657e+04_r8 /) + kbo(:, 3,27,12) = (/ & + & 0.10404e+04_r8,0.78916e+03_r8,0.60037e+03_r8,0.88046e+03_r8,0.11638e+04_r8 /) + kbo(:, 4,27,12) = (/ & + & 0.10405e+04_r8,0.78893e+03_r8,0.59897e+03_r8,0.87905e+03_r8,0.11624e+04_r8 /) + kbo(:, 5,27,12) = (/ & + & 0.10396e+04_r8,0.78917e+03_r8,0.59748e+03_r8,0.87790e+03_r8,0.11613e+04_r8 /) + kbo(:, 1,28,12) = (/ & + & 0.10409e+04_r8,0.79152e+03_r8,0.60155e+03_r8,0.88334e+03_r8,0.11673e+04_r8 /) + kbo(:, 2,28,12) = (/ & + & 0.10439e+04_r8,0.78963e+03_r8,0.60099e+03_r8,0.88127e+03_r8,0.11652e+04_r8 /) + kbo(:, 3,28,12) = (/ & + & 0.10423e+04_r8,0.78823e+03_r8,0.60006e+03_r8,0.88010e+03_r8,0.11635e+04_r8 /) + kbo(:, 4,28,12) = (/ & + & 0.10442e+04_r8,0.78834e+03_r8,0.59861e+03_r8,0.87873e+03_r8,0.11621e+04_r8 /) + kbo(:, 5,28,12) = (/ & + & 0.10392e+04_r8,0.79042e+03_r8,0.59708e+03_r8,0.87768e+03_r8,0.11610e+04_r8 /) + kbo(:, 1,29,12) = (/ & + & 0.10405e+04_r8,0.79019e+03_r8,0.60167e+03_r8,0.88289e+03_r8,0.11667e+04_r8 /) + kbo(:, 2,29,12) = (/ & + & 0.10432e+04_r8,0.78865e+03_r8,0.60111e+03_r8,0.88122e+03_r8,0.11647e+04_r8 /) + kbo(:, 3,29,12) = (/ & + & 0.10406e+04_r8,0.78834e+03_r8,0.59962e+03_r8,0.87974e+03_r8,0.11631e+04_r8 /) + kbo(:, 4,29,12) = (/ & + & 0.10397e+04_r8,0.78909e+03_r8,0.59824e+03_r8,0.87826e+03_r8,0.11618e+04_r8 /) + kbo(:, 5,29,12) = (/ & + & 0.10387e+04_r8,0.78925e+03_r8,0.59665e+03_r8,0.87746e+03_r8,0.11608e+04_r8 /) + kbo(:, 1,30,12) = (/ & + & 0.10411e+04_r8,0.78840e+03_r8,0.60130e+03_r8,0.88244e+03_r8,0.11662e+04_r8 /) + kbo(:, 2,30,12) = (/ & + & 0.10395e+04_r8,0.79020e+03_r8,0.60051e+03_r8,0.88083e+03_r8,0.11643e+04_r8 /) + kbo(:, 3,30,12) = (/ & + & 0.10384e+04_r8,0.78543e+03_r8,0.59928e+03_r8,0.87938e+03_r8,0.11627e+04_r8 /) + kbo(:, 4,30,12) = (/ & + & 0.10394e+04_r8,0.78756e+03_r8,0.59785e+03_r8,0.87814e+03_r8,0.11615e+04_r8 /) + kbo(:, 5,30,12) = (/ & + & 0.10383e+04_r8,0.78820e+03_r8,0.59620e+03_r8,0.87743e+03_r8,0.11605e+04_r8 /) + kbo(:, 1,31,12) = (/ & + & 0.10385e+04_r8,0.78703e+03_r8,0.60113e+03_r8,0.88199e+03_r8,0.11657e+04_r8 /) + kbo(:, 2,31,12) = (/ & + & 0.10401e+04_r8,0.79050e+03_r8,0.60021e+03_r8,0.88045e+03_r8,0.11639e+04_r8 /) + kbo(:, 3,31,12) = (/ & + & 0.10412e+04_r8,0.78681e+03_r8,0.59892e+03_r8,0.87903e+03_r8,0.11624e+04_r8 /) + kbo(:, 4,31,12) = (/ & + & 0.10385e+04_r8,0.78582e+03_r8,0.59732e+03_r8,0.87772e+03_r8,0.11613e+04_r8 /) + kbo(:, 5,31,12) = (/ & + & 0.10372e+04_r8,0.78947e+03_r8,0.59573e+03_r8,0.87705e+03_r8,0.11602e+04_r8 /) + kbo(:, 1,32,12) = (/ & + & 0.10378e+04_r8,0.78710e+03_r8,0.60105e+03_r8,0.88140e+03_r8,0.11652e+04_r8 /) + kbo(:, 2,32,12) = (/ & + & 0.10375e+04_r8,0.78506e+03_r8,0.59989e+03_r8,0.88006e+03_r8,0.11634e+04_r8 /) + kbo(:, 3,32,12) = (/ & + & 0.10409e+04_r8,0.78648e+03_r8,0.59855e+03_r8,0.87869e+03_r8,0.11621e+04_r8 /) + kbo(:, 4,32,12) = (/ & + & 0.10389e+04_r8,0.78640e+03_r8,0.59701e+03_r8,0.87765e+03_r8,0.11610e+04_r8 /) + kbo(:, 5,32,12) = (/ & + & 0.10378e+04_r8,0.78589e+03_r8,0.59527e+03_r8,0.87675e+03_r8,0.11598e+04_r8 /) + kbo(:, 1,33,12) = (/ & + & 0.10380e+04_r8,0.78620e+03_r8,0.60093e+03_r8,0.88116e+03_r8,0.11647e+04_r8 /) + kbo(:, 2,33,12) = (/ & + & 0.10383e+04_r8,0.78582e+03_r8,0.59966e+03_r8,0.87968e+03_r8,0.11631e+04_r8 /) + kbo(:, 3,33,12) = (/ & + & 0.10388e+04_r8,0.78740e+03_r8,0.59816e+03_r8,0.87838e+03_r8,0.11618e+04_r8 /) + kbo(:, 4,33,12) = (/ & + & 0.10367e+04_r8,0.78734e+03_r8,0.59657e+03_r8,0.87743e+03_r8,0.11608e+04_r8 /) + kbo(:, 5,33,12) = (/ & + & 0.10382e+04_r8,0.78803e+03_r8,0.59484e+03_r8,0.87630e+03_r8,0.11592e+04_r8 /) + kbo(:, 1,34,12) = (/ & + & 0.10390e+04_r8,0.78774e+03_r8,0.60058e+03_r8,0.88098e+03_r8,0.11643e+04_r8 /) + kbo(:, 2,34,12) = (/ & + & 0.10374e+04_r8,0.78664e+03_r8,0.59936e+03_r8,0.87936e+03_r8,0.11627e+04_r8 /) + kbo(:, 3,34,12) = (/ & + & 0.10352e+04_r8,0.78733e+03_r8,0.59781e+03_r8,0.87813e+03_r8,0.11615e+04_r8 /) + kbo(:, 4,34,12) = (/ & + & 0.10386e+04_r8,0.78609e+03_r8,0.59617e+03_r8,0.87742e+03_r8,0.11605e+04_r8 /) + kbo(:, 5,34,12) = (/ & + & 0.10400e+04_r8,0.78709e+03_r8,0.59476e+03_r8,0.87581e+03_r8,0.11592e+04_r8 /) + kbo(:, 1,35,12) = (/ & + & 0.10374e+04_r8,0.78486e+03_r8,0.60032e+03_r8,0.88061e+03_r8,0.11641e+04_r8 /) + kbo(:, 2,35,12) = (/ & + & 0.10385e+04_r8,0.78482e+03_r8,0.59906e+03_r8,0.87918e+03_r8,0.11626e+04_r8 /) + kbo(:, 3,35,12) = (/ & + & 0.10371e+04_r8,0.78627e+03_r8,0.59760e+03_r8,0.87799e+03_r8,0.11614e+04_r8 /) + kbo(:, 4,35,12) = (/ & + & 0.10378e+04_r8,0.78697e+03_r8,0.59593e+03_r8,0.87715e+03_r8,0.11604e+04_r8 /) + kbo(:, 5,35,12) = (/ & + & 0.10370e+04_r8,0.78545e+03_r8,0.59500e+03_r8,0.87549e+03_r8,0.11592e+04_r8 /) + kbo(:, 1,36,12) = (/ & + & 0.10362e+04_r8,0.78845e+03_r8,0.60029e+03_r8,0.88058e+03_r8,0.11640e+04_r8 /) + kbo(:, 2,36,12) = (/ & + & 0.10379e+04_r8,0.78676e+03_r8,0.59903e+03_r8,0.87915e+03_r8,0.11625e+04_r8 /) + kbo(:, 3,36,12) = (/ & + & 0.10369e+04_r8,0.78598e+03_r8,0.59768e+03_r8,0.87797e+03_r8,0.11614e+04_r8 /) + kbo(:, 4,36,12) = (/ & + & 0.10369e+04_r8,0.78595e+03_r8,0.59566e+03_r8,0.87713e+03_r8,0.11604e+04_r8 /) + kbo(:, 5,36,12) = (/ & + & 0.10368e+04_r8,0.78548e+03_r8,0.59464e+03_r8,0.87594e+03_r8,0.11600e+04_r8 /) + kbo(:, 1,37,12) = (/ & + & 0.10374e+04_r8,0.78579e+03_r8,0.60055e+03_r8,0.88077e+03_r8,0.11642e+04_r8 /) + kbo(:, 2,37,12) = (/ & + & 0.10362e+04_r8,0.78844e+03_r8,0.59921e+03_r8,0.87933e+03_r8,0.11627e+04_r8 /) + kbo(:, 3,37,12) = (/ & + & 0.10360e+04_r8,0.78603e+03_r8,0.59777e+03_r8,0.87810e+03_r8,0.11615e+04_r8 /) + kbo(:, 4,37,12) = (/ & + & 0.10367e+04_r8,0.78734e+03_r8,0.59623e+03_r8,0.87723e+03_r8,0.11605e+04_r8 /) + kbo(:, 5,37,12) = (/ & + & 0.10361e+04_r8,0.78702e+03_r8,0.59474e+03_r8,0.87592e+03_r8,0.11587e+04_r8 /) + kbo(:, 1,38,12) = (/ & + & 0.10367e+04_r8,0.78778e+03_r8,0.60058e+03_r8,0.88098e+03_r8,0.11645e+04_r8 /) + kbo(:, 2,38,12) = (/ & + & 0.10387e+04_r8,0.78865e+03_r8,0.59939e+03_r8,0.87952e+03_r8,0.11629e+04_r8 /) + kbo(:, 3,38,12) = (/ & + & 0.10363e+04_r8,0.78758e+03_r8,0.59820e+03_r8,0.87825e+03_r8,0.11617e+04_r8 /) + kbo(:, 4,38,12) = (/ & + & 0.10372e+04_r8,0.78786e+03_r8,0.59636e+03_r8,0.87717e+03_r8,0.11609e+04_r8 /) + kbo(:, 5,38,12) = (/ & + & 0.10362e+04_r8,0.78470e+03_r8,0.59485e+03_r8,0.87657e+03_r8,0.11589e+04_r8 /) + kbo(:, 1,39,12) = (/ & + & 0.10374e+04_r8,0.78680e+03_r8,0.60094e+03_r8,0.88119e+03_r8,0.11647e+04_r8 /) + kbo(:, 2,39,12) = (/ & + & 0.10352e+04_r8,0.78618e+03_r8,0.60014e+03_r8,0.87971e+03_r8,0.11631e+04_r8 /) + kbo(:, 3,39,12) = (/ & + & 0.10401e+04_r8,0.78497e+03_r8,0.59818e+03_r8,0.87840e+03_r8,0.11618e+04_r8 /) + kbo(:, 4,39,12) = (/ & + & 0.10369e+04_r8,0.78868e+03_r8,0.59660e+03_r8,0.87744e+03_r8,0.11608e+04_r8 /) + kbo(:, 5,39,12) = (/ & + & 0.10353e+04_r8,0.78494e+03_r8,0.59497e+03_r8,0.87635e+03_r8,0.11593e+04_r8 /) + kbo(:, 1,40,12) = (/ & + & 0.10385e+04_r8,0.78584e+03_r8,0.60091e+03_r8,0.88123e+03_r8,0.11652e+04_r8 /) + kbo(:, 2,40,12) = (/ & + & 0.10387e+04_r8,0.78568e+03_r8,0.59987e+03_r8,0.88006e+03_r8,0.11635e+04_r8 /) + kbo(:, 3,40,12) = (/ & + & 0.10371e+04_r8,0.78626e+03_r8,0.59853e+03_r8,0.87869e+03_r8,0.11621e+04_r8 /) + kbo(:, 4,40,12) = (/ & + & 0.10386e+04_r8,0.78684e+03_r8,0.59700e+03_r8,0.87748e+03_r8,0.11610e+04_r8 /) + kbo(:, 5,40,12) = (/ & + & 0.10362e+04_r8,0.78503e+03_r8,0.59526e+03_r8,0.87692e+03_r8,0.11598e+04_r8 /) + kbo(:, 1,41,12) = (/ & + & 0.10384e+04_r8,0.78504e+03_r8,0.60109e+03_r8,0.88198e+03_r8,0.11657e+04_r8 /) + kbo(:, 2,41,12) = (/ & + & 0.10360e+04_r8,0.78533e+03_r8,0.60017e+03_r8,0.88043e+03_r8,0.11639e+04_r8 /) + kbo(:, 3,41,12) = (/ & + & 0.10374e+04_r8,0.78412e+03_r8,0.59889e+03_r8,0.87902e+03_r8,0.11624e+04_r8 /) + kbo(:, 4,41,12) = (/ & + & 0.10350e+04_r8,0.78545e+03_r8,0.59741e+03_r8,0.87788e+03_r8,0.11613e+04_r8 /) + kbo(:, 5,41,12) = (/ & + & 0.10385e+04_r8,0.78529e+03_r8,0.59570e+03_r8,0.87704e+03_r8,0.11607e+04_r8 /) + kbo(:, 1,42,12) = (/ & + & 0.10370e+04_r8,0.78560e+03_r8,0.60125e+03_r8,0.88242e+03_r8,0.11662e+04_r8 /) + kbo(:, 2,42,12) = (/ & + & 0.10383e+04_r8,0.78469e+03_r8,0.60057e+03_r8,0.88081e+03_r8,0.11643e+04_r8 /) + kbo(:, 3,42,12) = (/ & + & 0.10368e+04_r8,0.78617e+03_r8,0.59924e+03_r8,0.87937e+03_r8,0.11627e+04_r8 /) + kbo(:, 4,42,12) = (/ & + & 0.10362e+04_r8,0.78586e+03_r8,0.59780e+03_r8,0.87813e+03_r8,0.11615e+04_r8 /) + kbo(:, 5,42,12) = (/ & + & 0.10350e+04_r8,0.78958e+03_r8,0.59616e+03_r8,0.87725e+03_r8,0.11605e+04_r8 /) + kbo(:, 1,43,12) = (/ & + & 0.10375e+04_r8,0.78586e+03_r8,0.60140e+03_r8,0.88280e+03_r8,0.11669e+04_r8 /) + kbo(:, 2,43,12) = (/ & + & 0.10344e+04_r8,0.78615e+03_r8,0.60088e+03_r8,0.88112e+03_r8,0.11651e+04_r8 /) + kbo(:, 3,43,12) = (/ & + & 0.10344e+04_r8,0.78345e+03_r8,0.59953e+03_r8,0.87980e+03_r8,0.11632e+04_r8 /) + kbo(:, 4,43,12) = (/ & + & 0.10347e+04_r8,0.78777e+03_r8,0.59827e+03_r8,0.87847e+03_r8,0.11619e+04_r8 /) + kbo(:, 5,43,12) = (/ & + & 0.10355e+04_r8,0.78627e+03_r8,0.59681e+03_r8,0.87766e+03_r8,0.11609e+04_r8 /) + kbo(:, 1,44,12) = (/ & + & 0.10355e+04_r8,0.78449e+03_r8,0.60162e+03_r8,0.88358e+03_r8,0.11676e+04_r8 /) + kbo(:, 2,44,12) = (/ & + & 0.10359e+04_r8,0.78627e+03_r8,0.60103e+03_r8,0.88182e+03_r8,0.11655e+04_r8 /) + kbo(:, 3,44,12) = (/ & + & 0.10377e+04_r8,0.78715e+03_r8,0.60005e+03_r8,0.88029e+03_r8,0.11637e+04_r8 /) + kbo(:, 4,44,12) = (/ & + & 0.10378e+04_r8,0.78625e+03_r8,0.59875e+03_r8,0.87890e+03_r8,0.11623e+04_r8 /) + kbo(:, 5,44,12) = (/ & + & 0.10374e+04_r8,0.78401e+03_r8,0.59725e+03_r8,0.87779e+03_r8,0.11612e+04_r8 /) + kbo(:, 1,45,12) = (/ & + & 0.10390e+04_r8,0.78655e+03_r8,0.60158e+03_r8,0.88419e+03_r8,0.11684e+04_r8 /) + kbo(:, 2,45,12) = (/ & + & 0.10396e+04_r8,0.78684e+03_r8,0.60124e+03_r8,0.88239e+03_r8,0.11662e+04_r8 /) + kbo(:, 3,45,12) = (/ & + & 0.10355e+04_r8,0.78758e+03_r8,0.60044e+03_r8,0.88079e+03_r8,0.11643e+04_r8 /) + kbo(:, 4,45,12) = (/ & + & 0.10368e+04_r8,0.78548e+03_r8,0.59922e+03_r8,0.87935e+03_r8,0.11627e+04_r8 /) + kbo(:, 5,45,12) = (/ & + & 0.10360e+04_r8,0.78578e+03_r8,0.59778e+03_r8,0.87811e+03_r8,0.11615e+04_r8 /) + kbo(:, 1,46,12) = (/ & + & 0.10390e+04_r8,0.78534e+03_r8,0.60165e+03_r8,0.88476e+03_r8,0.11691e+04_r8 /) + kbo(:, 2,46,12) = (/ & + & 0.10368e+04_r8,0.78339e+03_r8,0.60141e+03_r8,0.88303e+03_r8,0.11669e+04_r8 /) + kbo(:, 3,46,12) = (/ & + & 0.10364e+04_r8,0.78696e+03_r8,0.60079e+03_r8,0.88117e+03_r8,0.11649e+04_r8 /) + kbo(:, 4,46,12) = (/ & + & 0.10407e+04_r8,0.78666e+03_r8,0.59968e+03_r8,0.87985e+03_r8,0.11632e+04_r8 /) + kbo(:, 5,46,12) = (/ & + & 0.10344e+04_r8,0.78501e+03_r8,0.59832e+03_r8,0.87835e+03_r8,0.11619e+04_r8 /) + kbo(:, 1,47,12) = (/ & + & 0.10372e+04_r8,0.78547e+03_r8,0.60140e+03_r8,0.88518e+03_r8,0.11696e+04_r8 /) + kbo(:, 2,47,12) = (/ & + & 0.10368e+04_r8,0.78740e+03_r8,0.60142e+03_r8,0.88376e+03_r8,0.11678e+04_r8 /) + kbo(:, 3,47,12) = (/ & + & 0.10360e+04_r8,0.78411e+03_r8,0.60109e+03_r8,0.88198e+03_r8,0.11657e+04_r8 /) + kbo(:, 4,47,12) = (/ & + & 0.10358e+04_r8,0.78709e+03_r8,0.60017e+03_r8,0.88044e+03_r8,0.11639e+04_r8 /) + kbo(:, 5,47,12) = (/ & + & 0.10354e+04_r8,0.78664e+03_r8,0.59889e+03_r8,0.87902e+03_r8,0.11624e+04_r8 /) + kbo(:, 1,48,12) = (/ & + & 0.10362e+04_r8,0.78680e+03_r8,0.60195e+03_r8,0.88548e+03_r8,0.11701e+04_r8 /) + kbo(:, 2,48,12) = (/ & + & 0.10362e+04_r8,0.78545e+03_r8,0.60161e+03_r8,0.88447e+03_r8,0.11687e+04_r8 /) + kbo(:, 3,48,12) = (/ & + & 0.10378e+04_r8,0.78604e+03_r8,0.60144e+03_r8,0.88268e+03_r8,0.11665e+04_r8 /) + kbo(:, 4,48,12) = (/ & + & 0.10382e+04_r8,0.78544e+03_r8,0.60061e+03_r8,0.88104e+03_r8,0.11646e+04_r8 /) + kbo(:, 5,48,12) = (/ & + & 0.10364e+04_r8,0.78424e+03_r8,0.59943e+03_r8,0.87957e+03_r8,0.11630e+04_r8 /) + kbo(:, 1,49,12) = (/ & + & 0.10370e+04_r8,0.78693e+03_r8,0.60225e+03_r8,0.88600e+03_r8,0.11705e+04_r8 /) + kbo(:, 2,49,12) = (/ & + & 0.10356e+04_r8,0.78469e+03_r8,0.60169e+03_r8,0.88499e+03_r8,0.11694e+04_r8 /) + kbo(:, 3,49,12) = (/ & + & 0.10350e+04_r8,0.78588e+03_r8,0.60148e+03_r8,0.88340e+03_r8,0.11674e+04_r8 /) + kbo(:, 4,49,12) = (/ & + & 0.10352e+04_r8,0.78677e+03_r8,0.60095e+03_r8,0.88166e+03_r8,0.11653e+04_r8 /) + kbo(:, 5,49,12) = (/ & + & 0.10356e+04_r8,0.78647e+03_r8,0.59993e+03_r8,0.88015e+03_r8,0.11636e+04_r8 /) + kbo(:, 1,50,12) = (/ & + & 0.10356e+04_r8,0.78558e+03_r8,0.60226e+03_r8,0.88620e+03_r8,0.11712e+04_r8 /) + kbo(:, 2,50,12) = (/ & + & 0.10346e+04_r8,0.78796e+03_r8,0.60171e+03_r8,0.88533e+03_r8,0.11698e+04_r8 /) + kbo(:, 3,50,12) = (/ & + & 0.10366e+04_r8,0.78751e+03_r8,0.60168e+03_r8,0.88408e+03_r8,0.11667e+04_r8 /) + kbo(:, 4,50,12) = (/ & + & 0.10366e+04_r8,0.78646e+03_r8,0.60132e+03_r8,0.88229e+03_r8,0.11661e+04_r8 /) + kbo(:, 5,50,12) = (/ & + & 0.10393e+04_r8,0.78616e+03_r8,0.60083e+03_r8,0.88070e+03_r8,0.11642e+04_r8 /) + kbo(:, 1,51,12) = (/ & + & 0.10356e+04_r8,0.78468e+03_r8,0.60241e+03_r8,0.88644e+03_r8,0.11719e+04_r8 /) + kbo(:, 2,51,12) = (/ & + & 0.10368e+04_r8,0.78423e+03_r8,0.60203e+03_r8,0.88559e+03_r8,0.11702e+04_r8 /) + kbo(:, 3,51,12) = (/ & + & 0.10356e+04_r8,0.78586e+03_r8,0.60163e+03_r8,0.88469e+03_r8,0.11690e+04_r8 /) + kbo(:, 4,51,12) = (/ & + & 0.10358e+04_r8,0.78601e+03_r8,0.60139e+03_r8,0.88294e+03_r8,0.11668e+04_r8 /) + kbo(:, 5,51,12) = (/ & + & 0.10379e+04_r8,0.78646e+03_r8,0.60074e+03_r8,0.88126e+03_r8,0.11648e+04_r8 /) + kbo(:, 1,52,12) = (/ & + & 0.10383e+04_r8,0.78512e+03_r8,0.60257e+03_r8,0.88672e+03_r8,0.11727e+04_r8 /) + kbo(:, 2,52,12) = (/ & + & 0.10350e+04_r8,0.78646e+03_r8,0.60217e+03_r8,0.88594e+03_r8,0.11707e+04_r8 /) + kbo(:, 3,52,12) = (/ & + & 0.10358e+04_r8,0.78466e+03_r8,0.60160e+03_r8,0.88510e+03_r8,0.11695e+04_r8 /) + kbo(:, 4,52,12) = (/ & + & 0.10356e+04_r8,0.78511e+03_r8,0.60151e+03_r8,0.88359e+03_r8,0.11676e+04_r8 /) + kbo(:, 5,52,12) = (/ & + & 0.10365e+04_r8,0.78541e+03_r8,0.60103e+03_r8,0.88167e+03_r8,0.11655e+04_r8 /) + kbo(:, 1,53,12) = (/ & + & 0.10352e+04_r8,0.78496e+03_r8,0.60273e+03_r8,0.88710e+03_r8,0.11735e+04_r8 /) + kbo(:, 2,53,12) = (/ & + & 0.10359e+04_r8,0.78600e+03_r8,0.60229e+03_r8,0.88628e+03_r8,0.11714e+04_r8 /) + kbo(:, 3,53,12) = (/ & + & 0.10369e+04_r8,0.78526e+03_r8,0.60188e+03_r8,0.88540e+03_r8,0.11699e+04_r8 /) + kbo(:, 4,53,12) = (/ & + & 0.10383e+04_r8,0.78660e+03_r8,0.60159e+03_r8,0.88425e+03_r8,0.11685e+04_r8 /) + kbo(:, 5,53,12) = (/ & + & 0.10373e+04_r8,0.78555e+03_r8,0.60126e+03_r8,0.88246e+03_r8,0.11663e+04_r8 /) + kbo(:, 1,54,12) = (/ & + & 0.10367e+04_r8,0.78451e+03_r8,0.60297e+03_r8,0.88752e+03_r8,0.11746e+04_r8 /) + kbo(:, 2,54,12) = (/ & + & 0.10355e+04_r8,0.78600e+03_r8,0.60244e+03_r8,0.88648e+03_r8,0.11721e+04_r8 /) + kbo(:, 3,54,12) = (/ & + & 0.10348e+04_r8,0.78301e+03_r8,0.60206e+03_r8,0.88564e+03_r8,0.11703e+04_r8 /) + kbo(:, 4,54,12) = (/ & + & 0.10395e+04_r8,0.78629e+03_r8,0.60165e+03_r8,0.88477e+03_r8,0.11691e+04_r8 /) + kbo(:, 5,54,12) = (/ & + & 0.10361e+04_r8,0.78420e+03_r8,0.60141e+03_r8,0.88305e+03_r8,0.11670e+04_r8 /) + kbo(:, 1,55,12) = (/ & + & 0.10361e+04_r8,0.78555e+03_r8,0.60296e+03_r8,0.88822e+03_r8,0.11760e+04_r8 /) + kbo(:, 2,55,12) = (/ & + & 0.10355e+04_r8,0.78495e+03_r8,0.60258e+03_r8,0.88674e+03_r8,0.11727e+04_r8 /) + kbo(:, 3,55,12) = (/ & + & 0.10349e+04_r8,0.78525e+03_r8,0.60217e+03_r8,0.88596e+03_r8,0.11709e+04_r8 /) + kbo(:, 4,55,12) = (/ & + & 0.10361e+04_r8,0.78465e+03_r8,0.60184e+03_r8,0.88512e+03_r8,0.11696e+04_r8 /) + kbo(:, 5,55,12) = (/ & + & 0.10363e+04_r8,0.78599e+03_r8,0.60163e+03_r8,0.88363e+03_r8,0.11677e+04_r8 /) + kbo(:, 1,56,12) = (/ & + & 0.10361e+04_r8,0.78599e+03_r8,0.60309e+03_r8,0.88918e+03_r8,0.11774e+04_r8 /) + kbo(:, 2,56,12) = (/ & + & 0.10391e+04_r8,0.78674e+03_r8,0.60272e+03_r8,0.88707e+03_r8,0.11734e+04_r8 /) + kbo(:, 3,56,12) = (/ & + & 0.10363e+04_r8,0.78584e+03_r8,0.60228e+03_r8,0.88626e+03_r8,0.11716e+04_r8 /) + kbo(:, 4,56,12) = (/ & + & 0.10369e+04_r8,0.78509e+03_r8,0.60186e+03_r8,0.88538e+03_r8,0.11695e+04_r8 /) + kbo(:, 5,56,12) = (/ & + & 0.10363e+04_r8,0.78554e+03_r8,0.60158e+03_r8,0.88421e+03_r8,0.11682e+04_r8 /) + kbo(:, 1,57,12) = (/ & + & 0.10381e+04_r8,0.78509e+03_r8,0.60327e+03_r8,0.89026e+03_r8,0.11789e+04_r8 /) + kbo(:, 2,57,12) = (/ & + & 0.10344e+04_r8,0.78852e+03_r8,0.60284e+03_r8,0.88747e+03_r8,0.11744e+04_r8 /) + kbo(:, 3,57,12) = (/ & + & 0.10369e+04_r8,0.78509e+03_r8,0.60242e+03_r8,0.88612e+03_r8,0.11720e+04_r8 /) + kbo(:, 4,57,12) = (/ & + & 0.10393e+04_r8,0.78330e+03_r8,0.60216e+03_r8,0.88561e+03_r8,0.11703e+04_r8 /) + kbo(:, 5,57,12) = (/ & + & 0.10365e+04_r8,0.78494e+03_r8,0.60164e+03_r8,0.88472e+03_r8,0.11688e+04_r8 /) + kbo(:, 1,58,12) = (/ & + & 0.10353e+04_r8,0.78509e+03_r8,0.60357e+03_r8,0.89125e+03_r8,0.11802e+04_r8 /) + kbo(:, 2,58,12) = (/ & + & 0.10371e+04_r8,0.78524e+03_r8,0.60283e+03_r8,0.88807e+03_r8,0.11757e+04_r8 /) + kbo(:, 3,58,12) = (/ & + & 0.10365e+04_r8,0.78718e+03_r8,0.60278e+03_r8,0.88669e+03_r8,0.11726e+04_r8 /) + kbo(:, 4,58,12) = (/ & + & 0.10349e+04_r8,0.78673e+03_r8,0.60216e+03_r8,0.88590e+03_r8,0.11708e+04_r8 /) + kbo(:, 5,58,12) = (/ & + & 0.10365e+04_r8,0.78389e+03_r8,0.60170e+03_r8,0.88506e+03_r8,0.11695e+04_r8 /) + kbo(:, 1,59,12) = (/ & + & 0.10365e+04_r8,0.78390e+03_r8,0.60373e+03_r8,0.89165e+03_r8,0.11808e+04_r8 /) + kbo(:, 2,59,12) = (/ & + & 0.10369e+04_r8,0.78479e+03_r8,0.60298e+03_r8,0.88840e+03_r8,0.11763e+04_r8 /) + kbo(:, 3,59,12) = (/ & + & 0.10357e+04_r8,0.78703e+03_r8,0.60261e+03_r8,0.88680e+03_r8,0.11713e+04_r8 /) + kbo(:, 4,59,12) = (/ & + & 0.10363e+04_r8,0.78509e+03_r8,0.60219e+03_r8,0.88602e+03_r8,0.11708e+04_r8 /) + kbo(:, 5,59,12) = (/ & + & 0.10365e+04_r8,0.78479e+03_r8,0.60174e+03_r8,0.88517e+03_r8,0.11696e+04_r8 /) + kbo(:, 1,13,13) = (/ & + & 0.11661e+04_r8,0.87073e+03_r8,0.60556e+03_r8,0.88929e+03_r8,0.11761e+04_r8 /) + kbo(:, 2,13,13) = (/ & + & 0.11527e+04_r8,0.87014e+03_r8,0.60489e+03_r8,0.88914e+03_r8,0.11754e+04_r8 /) + kbo(:, 3,13,13) = (/ & + & 0.11423e+04_r8,0.85968e+03_r8,0.60419e+03_r8,0.88867e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,13,13) = (/ & + & 0.11371e+04_r8,0.85890e+03_r8,0.60344e+03_r8,0.88820e+03_r8,0.11742e+04_r8 /) + kbo(:, 5,13,13) = (/ & + & 0.11390e+04_r8,0.85008e+03_r8,0.60234e+03_r8,0.88705e+03_r8,0.11727e+04_r8 /) + kbo(:, 1,14,13) = (/ & + & 0.11362e+04_r8,0.85805e+03_r8,0.60511e+03_r8,0.88957e+03_r8,0.11761e+04_r8 /) + kbo(:, 2,14,13) = (/ & + & 0.11276e+04_r8,0.85398e+03_r8,0.60448e+03_r8,0.88893e+03_r8,0.11753e+04_r8 /) + kbo(:, 3,14,13) = (/ & + & 0.11208e+04_r8,0.84888e+03_r8,0.60397e+03_r8,0.88854e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,14,13) = (/ & + & 0.11194e+04_r8,0.85006e+03_r8,0.60305e+03_r8,0.88823e+03_r8,0.11740e+04_r8 /) + kbo(:, 5,14,13) = (/ & + & 0.11083e+04_r8,0.84212e+03_r8,0.60191e+03_r8,0.88682e+03_r8,0.11725e+04_r8 /) + kbo(:, 1,15,13) = (/ & + & 0.11142e+04_r8,0.84766e+03_r8,0.60488e+03_r8,0.88941e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,15,13) = (/ & + & 0.11176e+04_r8,0.84112e+03_r8,0.60414e+03_r8,0.88873e+03_r8,0.11752e+04_r8 /) + kbo(:, 3,15,13) = (/ & + & 0.11051e+04_r8,0.84191e+03_r8,0.60348e+03_r8,0.88843e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,15,13) = (/ & + & 0.11036e+04_r8,0.83753e+03_r8,0.60270e+03_r8,0.88781e+03_r8,0.11739e+04_r8 /) + kbo(:, 5,15,13) = (/ & + & 0.10935e+04_r8,0.82883e+03_r8,0.60139e+03_r8,0.88658e+03_r8,0.11723e+04_r8 /) + kbo(:, 1,16,13) = (/ & + & 0.11074e+04_r8,0.83456e+03_r8,0.60440e+03_r8,0.88927e+03_r8,0.11760e+04_r8 /) + kbo(:, 2,16,13) = (/ & + & 0.11018e+04_r8,0.83298e+03_r8,0.60385e+03_r8,0.88856e+03_r8,0.11751e+04_r8 /) + kbo(:, 3,16,13) = (/ & + & 0.10859e+04_r8,0.83101e+03_r8,0.60319e+03_r8,0.88832e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,16,13) = (/ & + & 0.10925e+04_r8,0.82836e+03_r8,0.60254e+03_r8,0.88762e+03_r8,0.11738e+04_r8 /) + kbo(:, 5,16,13) = (/ & + & 0.10900e+04_r8,0.82283e+03_r8,0.60124e+03_r8,0.88636e+03_r8,0.11721e+04_r8 /) + kbo(:, 1,17,13) = (/ & + & 0.10953e+04_r8,0.82596e+03_r8,0.60413e+03_r8,0.88915e+03_r8,0.11759e+04_r8 /) + kbo(:, 2,17,13) = (/ & + & 0.10864e+04_r8,0.82504e+03_r8,0.60360e+03_r8,0.88842e+03_r8,0.11750e+04_r8 /) + kbo(:, 3,17,13) = (/ & + & 0.10812e+04_r8,0.81898e+03_r8,0.60295e+03_r8,0.88822e+03_r8,0.11746e+04_r8 /) + kbo(:, 4,17,13) = (/ & + & 0.10806e+04_r8,0.81706e+03_r8,0.60242e+03_r8,0.88745e+03_r8,0.11736e+04_r8 /) + kbo(:, 5,17,13) = (/ & + & 0.10764e+04_r8,0.81771e+03_r8,0.59943e+03_r8,0.88638e+03_r8,0.11722e+04_r8 /) + kbo(:, 1,18,13) = (/ & + & 0.10787e+04_r8,0.82265e+03_r8,0.60390e+03_r8,0.88903e+03_r8,0.11759e+04_r8 /) + kbo(:, 2,18,13) = (/ & + & 0.10743e+04_r8,0.81466e+03_r8,0.60339e+03_r8,0.88738e+03_r8,0.11749e+04_r8 /) + kbo(:, 3,18,13) = (/ & + & 0.10792e+04_r8,0.81648e+03_r8,0.60273e+03_r8,0.88812e+03_r8,0.11749e+04_r8 /) + kbo(:, 4,18,13) = (/ & + & 0.10724e+04_r8,0.81516e+03_r8,0.60185e+03_r8,0.88728e+03_r8,0.11735e+04_r8 /) + kbo(:, 5,18,13) = (/ & + & 0.10737e+04_r8,0.81301e+03_r8,0.60092e+03_r8,0.88618e+03_r8,0.11717e+04_r8 /) + kbo(:, 1,19,13) = (/ & + & 0.10778e+04_r8,0.81646e+03_r8,0.60388e+03_r8,0.88893e+03_r8,0.11758e+04_r8 /) + kbo(:, 2,19,13) = (/ & + & 0.10709e+04_r8,0.81021e+03_r8,0.60321e+03_r8,0.88822e+03_r8,0.11748e+04_r8 /) + kbo(:, 3,19,13) = (/ & + & 0.10651e+04_r8,0.80945e+03_r8,0.60254e+03_r8,0.88803e+03_r8,0.11745e+04_r8 /) + kbo(:, 4,19,13) = (/ & + & 0.10677e+04_r8,0.80743e+03_r8,0.60147e+03_r8,0.88735e+03_r8,0.11733e+04_r8 /) + kbo(:, 5,19,13) = (/ & + & 0.10575e+04_r8,0.80245e+03_r8,0.60072e+03_r8,0.88575e+03_r8,0.11721e+04_r8 /) + kbo(:, 1,20,13) = (/ & + & 0.10622e+04_r8,0.81096e+03_r8,0.60356e+03_r8,0.88881e+03_r8,0.11757e+04_r8 /) + kbo(:, 2,20,13) = (/ & + & 0.10607e+04_r8,0.80739e+03_r8,0.60305e+03_r8,0.88816e+03_r8,0.11748e+04_r8 /) + kbo(:, 3,20,13) = (/ & + & 0.10623e+04_r8,0.80381e+03_r8,0.60252e+03_r8,0.88792e+03_r8,0.11744e+04_r8 /) + kbo(:, 4,20,13) = (/ & + & 0.10570e+04_r8,0.80456e+03_r8,0.60093e+03_r8,0.88695e+03_r8,0.11731e+04_r8 /) + kbo(:, 5,20,13) = (/ & + & 0.10628e+04_r8,0.80481e+03_r8,0.60051e+03_r8,0.88554e+03_r8,0.11713e+04_r8 /) + kbo(:, 1,21,13) = (/ & + & 0.10564e+04_r8,0.80721e+03_r8,0.60326e+03_r8,0.88869e+03_r8,0.11756e+04_r8 /) + kbo(:, 2,21,13) = (/ & + & 0.10630e+04_r8,0.79813e+03_r8,0.60290e+03_r8,0.88813e+03_r8,0.11748e+04_r8 /) + kbo(:, 3,21,13) = (/ & + & 0.10553e+04_r8,0.80228e+03_r8,0.60219e+03_r8,0.88781e+03_r8,0.11743e+04_r8 /) + kbo(:, 4,21,13) = (/ & + & 0.10544e+04_r8,0.79888e+03_r8,0.60136e+03_r8,0.88677e+03_r8,0.11729e+04_r8 /) + kbo(:, 5,21,13) = (/ & + & 0.10596e+04_r8,0.81049e+03_r8,0.60032e+03_r8,0.88532e+03_r8,0.11710e+04_r8 /) + kbo(:, 1,22,13) = (/ & + & 0.10550e+04_r8,0.80310e+03_r8,0.60326e+03_r8,0.88850e+03_r8,0.11754e+04_r8 /) + kbo(:, 2,22,13) = (/ & + & 0.10516e+04_r8,0.80380e+03_r8,0.60256e+03_r8,0.88810e+03_r8,0.11747e+04_r8 /) + kbo(:, 3,22,13) = (/ & + & 0.10562e+04_r8,0.80152e+03_r8,0.60229e+03_r8,0.88764e+03_r8,0.11741e+04_r8 /) + kbo(:, 4,22,13) = (/ & + & 0.10509e+04_r8,0.80224e+03_r8,0.60002e+03_r8,0.88651e+03_r8,0.11726e+04_r8 /) + kbo(:, 5,22,13) = (/ & + & 0.10563e+04_r8,0.79871e+03_r8,0.59990e+03_r8,0.88500e+03_r8,0.11706e+04_r8 /) + kbo(:, 1,23,13) = (/ & + & 0.10567e+04_r8,0.79860e+03_r8,0.60326e+03_r8,0.88832e+03_r8,0.11752e+04_r8 /) + kbo(:, 2,23,13) = (/ & + & 0.10532e+04_r8,0.79557e+03_r8,0.60254e+03_r8,0.88806e+03_r8,0.11747e+04_r8 /) + kbo(:, 3,23,13) = (/ & + & 0.10534e+04_r8,0.79512e+03_r8,0.60237e+03_r8,0.88744e+03_r8,0.11739e+04_r8 /) + kbo(:, 4,23,13) = (/ & + & 0.10472e+04_r8,0.79721e+03_r8,0.60072e+03_r8,0.88622e+03_r8,0.11723e+04_r8 /) + kbo(:, 5,23,13) = (/ & + & 0.10509e+04_r8,0.79423e+03_r8,0.59964e+03_r8,0.88466e+03_r8,0.11702e+04_r8 /) + kbo(:, 1,24,13) = (/ & + & 0.10549e+04_r8,0.79502e+03_r8,0.60296e+03_r8,0.88817e+03_r8,0.11750e+04_r8 /) + kbo(:, 2,24,13) = (/ & + & 0.10498e+04_r8,0.80428e+03_r8,0.60221e+03_r8,0.88799e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,24,13) = (/ & + & 0.10553e+04_r8,0.79369e+03_r8,0.60149e+03_r8,0.88721e+03_r8,0.11736e+04_r8 /) + kbo(:, 4,24,13) = (/ & + & 0.10517e+04_r8,0.79240e+03_r8,0.60048e+03_r8,0.88592e+03_r8,0.11719e+04_r8 /) + kbo(:, 5,24,13) = (/ & + & 0.10493e+04_r8,0.79281e+03_r8,0.59936e+03_r8,0.88429e+03_r8,0.11697e+04_r8 /) + kbo(:, 1,25,13) = (/ & + & 0.10472e+04_r8,0.79884e+03_r8,0.60281e+03_r8,0.88760e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,25,13) = (/ & + & 0.10433e+04_r8,0.79261e+03_r8,0.60217e+03_r8,0.88787e+03_r8,0.11745e+04_r8 /) + kbo(:, 3,25,13) = (/ & + & 0.10495e+04_r8,0.79568e+03_r8,0.60138e+03_r8,0.88696e+03_r8,0.11733e+04_r8 /) + kbo(:, 4,25,13) = (/ & + & 0.10412e+04_r8,0.79264e+03_r8,0.60023e+03_r8,0.88559e+03_r8,0.11715e+04_r8 /) + kbo(:, 5,25,13) = (/ & + & 0.10432e+04_r8,0.79682e+03_r8,0.59908e+03_r8,0.88390e+03_r8,0.11692e+04_r8 /) + kbo(:, 1,26,13) = (/ & + & 0.10426e+04_r8,0.79538e+03_r8,0.60266e+03_r8,0.88804e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,26,13) = (/ & + & 0.10459e+04_r8,0.79909e+03_r8,0.60196e+03_r8,0.88771e+03_r8,0.11743e+04_r8 /) + kbo(:, 3,26,13) = (/ & + & 0.10455e+04_r8,0.79078e+03_r8,0.60113e+03_r8,0.88666e+03_r8,0.11729e+04_r8 /) + kbo(:, 4,26,13) = (/ & + & 0.10380e+04_r8,0.79069e+03_r8,0.60011e+03_r8,0.88521e+03_r8,0.11710e+04_r8 /) + kbo(:, 5,26,13) = (/ & + & 0.10428e+04_r8,0.79124e+03_r8,0.59892e+03_r8,0.88345e+03_r8,0.11686e+04_r8 /) + kbo(:, 1,27,13) = (/ & + & 0.10409e+04_r8,0.79057e+03_r8,0.60249e+03_r8,0.88802e+03_r8,0.11747e+04_r8 /) + kbo(:, 2,27,13) = (/ & + & 0.10432e+04_r8,0.78863e+03_r8,0.60172e+03_r8,0.88750e+03_r8,0.11740e+04_r8 /) + kbo(:, 3,27,13) = (/ & + & 0.10404e+04_r8,0.79041e+03_r8,0.60057e+03_r8,0.88634e+03_r8,0.11728e+04_r8 /) + kbo(:, 4,27,13) = (/ & + & 0.10425e+04_r8,0.78854e+03_r8,0.59967e+03_r8,0.88481e+03_r8,0.11704e+04_r8 /) + kbo(:, 5,27,13) = (/ & + & 0.10492e+04_r8,0.78874e+03_r8,0.59843e+03_r8,0.88297e+03_r8,0.11680e+04_r8 /) + kbo(:, 1,28,13) = (/ & + & 0.10434e+04_r8,0.79273e+03_r8,0.60231e+03_r8,0.88820e+03_r8,0.11747e+04_r8 /) + kbo(:, 2,28,13) = (/ & + & 0.10472e+04_r8,0.78799e+03_r8,0.60162e+03_r8,0.88726e+03_r8,0.11737e+04_r8 /) + kbo(:, 3,28,13) = (/ & + & 0.10366e+04_r8,0.79125e+03_r8,0.60032e+03_r8,0.88600e+03_r8,0.11720e+04_r8 /) + kbo(:, 4,28,13) = (/ & + & 0.10345e+04_r8,0.78841e+03_r8,0.59938e+03_r8,0.88440e+03_r8,0.11699e+04_r8 /) + kbo(:, 5,28,13) = (/ & + & 0.10534e+04_r8,0.78866e+03_r8,0.59808e+03_r8,0.88245e+03_r8,0.11673e+04_r8 /) + kbo(:, 1,29,13) = (/ & + & 0.10524e+04_r8,0.78934e+03_r8,0.60181e+03_r8,0.88786e+03_r8,0.11745e+04_r8 /) + kbo(:, 2,29,13) = (/ & + & 0.10481e+04_r8,0.78588e+03_r8,0.60321e+03_r8,0.88698e+03_r8,0.11734e+04_r8 /) + kbo(:, 3,29,13) = (/ & + & 0.10466e+04_r8,0.79266e+03_r8,0.60021e+03_r8,0.88562e+03_r8,0.11715e+04_r8 /) + kbo(:, 4,29,13) = (/ & + & 0.10466e+04_r8,0.79965e+03_r8,0.59906e+03_r8,0.88395e+03_r8,0.11693e+04_r8 /) + kbo(:, 5,29,13) = (/ & + & 0.10459e+04_r8,0.78993e+03_r8,0.59799e+03_r8,0.88185e+03_r8,0.11668e+04_r8 /) + kbo(:, 1,30,13) = (/ & + & 0.10360e+04_r8,0.78916e+03_r8,0.60191e+03_r8,0.88770e+03_r8,0.11743e+04_r8 /) + kbo(:, 2,30,13) = (/ & + & 0.10409e+04_r8,0.78411e+03_r8,0.60093e+03_r8,0.88667e+03_r8,0.11729e+04_r8 /) + kbo(:, 3,30,13) = (/ & + & 0.10391e+04_r8,0.79193e+03_r8,0.59993e+03_r8,0.88546e+03_r8,0.11710e+04_r8 /) + kbo(:, 4,30,13) = (/ & + & 0.10409e+04_r8,0.78876e+03_r8,0.59874e+03_r8,0.88348e+03_r8,0.11687e+04_r8 /) + kbo(:, 5,30,13) = (/ & + & 0.10396e+04_r8,0.78722e+03_r8,0.59722e+03_r8,0.88117e+03_r8,0.11665e+04_r8 /) + kbo(:, 1,31,13) = (/ & + & 0.10394e+04_r8,0.79419e+03_r8,0.60167e+03_r8,0.88749e+03_r8,0.11740e+04_r8 /) + kbo(:, 2,31,13) = (/ & + & 0.10363e+04_r8,0.79203e+03_r8,0.60068e+03_r8,0.88633e+03_r8,0.11725e+04_r8 /) + kbo(:, 3,31,13) = (/ & + & 0.10437e+04_r8,0.78663e+03_r8,0.59963e+03_r8,0.88481e+03_r8,0.11705e+04_r8 /) + kbo(:, 4,31,13) = (/ & + & 0.10406e+04_r8,0.79000e+03_r8,0.59839e+03_r8,0.88297e+03_r8,0.11680e+04_r8 /) + kbo(:, 5,31,13) = (/ & + & 0.10413e+04_r8,0.79093e+03_r8,0.59674e+03_r8,0.88044e+03_r8,0.11650e+04_r8 /) + kbo(:, 1,32,13) = (/ & + & 0.10440e+04_r8,0.79014e+03_r8,0.60327e+03_r8,0.88723e+03_r8,0.11737e+04_r8 /) + kbo(:, 2,32,13) = (/ & + & 0.10391e+04_r8,0.79106e+03_r8,0.60042e+03_r8,0.88596e+03_r8,0.11720e+04_r8 /) + kbo(:, 3,32,13) = (/ & + & 0.10467e+04_r8,0.78955e+03_r8,0.59932e+03_r8,0.88436e+03_r8,0.11699e+04_r8 /) + kbo(:, 4,32,13) = (/ & + & 0.10407e+04_r8,0.79722e+03_r8,0.59818e+03_r8,0.88241e+03_r8,0.11673e+04_r8 /) + kbo(:, 5,32,13) = (/ & + & 0.10382e+04_r8,0.78961e+03_r8,0.59626e+03_r8,0.87980e+03_r8,0.11639e+04_r8 /) + kbo(:, 1,33,13) = (/ & + & 0.10522e+04_r8,0.78494e+03_r8,0.60081e+03_r8,0.88693e+03_r8,0.11733e+04_r8 /) + kbo(:, 2,33,13) = (/ & + & 0.10373e+04_r8,0.79220e+03_r8,0.59999e+03_r8,0.88557e+03_r8,0.11715e+04_r8 /) + kbo(:, 3,33,13) = (/ & + & 0.10359e+04_r8,0.78622e+03_r8,0.59900e+03_r8,0.88389e+03_r8,0.11695e+04_r8 /) + kbo(:, 4,33,13) = (/ & + & 0.10377e+04_r8,0.78474e+03_r8,0.59760e+03_r8,0.88177e+03_r8,0.11667e+04_r8 /) + kbo(:, 5,33,13) = (/ & + & 0.10406e+04_r8,0.78876e+03_r8,0.59580e+03_r8,0.87933e+03_r8,0.11633e+04_r8 /) + kbo(:, 1,34,13) = (/ & + & 0.10360e+04_r8,0.79366e+03_r8,0.60074e+03_r8,0.88666e+03_r8,0.11729e+04_r8 /) + kbo(:, 2,34,13) = (/ & + & 0.10445e+04_r8,0.78362e+03_r8,0.59974e+03_r8,0.88521e+03_r8,0.11710e+04_r8 /) + kbo(:, 3,34,13) = (/ & + & 0.10445e+04_r8,0.78784e+03_r8,0.59871e+03_r8,0.88346e+03_r8,0.11687e+04_r8 /) + kbo(:, 4,34,13) = (/ & + & 0.10420e+04_r8,0.78840e+03_r8,0.59718e+03_r8,0.88091e+03_r8,0.11665e+04_r8 /) + kbo(:, 5,34,13) = (/ & + & 0.10384e+04_r8,0.79182e+03_r8,0.59540e+03_r8,0.87927e+03_r8,0.11620e+04_r8 /) + kbo(:, 1,35,13) = (/ & + & 0.10422e+04_r8,0.79326e+03_r8,0.60077e+03_r8,0.88648e+03_r8,0.11727e+04_r8 /) + kbo(:, 2,35,13) = (/ & + & 0.10360e+04_r8,0.79158e+03_r8,0.59975e+03_r8,0.88500e+03_r8,0.11707e+04_r8 /) + kbo(:, 3,35,13) = (/ & + & 0.10370e+04_r8,0.78869e+03_r8,0.59854e+03_r8,0.88320e+03_r8,0.11683e+04_r8 /) + kbo(:, 4,35,13) = (/ & + & 0.10364e+04_r8,0.79354e+03_r8,0.59694e+03_r8,0.88077e+03_r8,0.11651e+04_r8 /) + kbo(:, 5,35,13) = (/ & + & 0.10369e+04_r8,0.78943e+03_r8,0.59473e+03_r8,0.87892e+03_r8,0.11616e+04_r8 /) + kbo(:, 1,36,13) = (/ & + & 0.10401e+04_r8,0.78191e+03_r8,0.60075e+03_r8,0.88645e+03_r8,0.11727e+04_r8 /) + kbo(:, 2,36,13) = (/ & + & 0.10371e+04_r8,0.78614e+03_r8,0.59972e+03_r8,0.88519e+03_r8,0.11707e+04_r8 /) + kbo(:, 3,36,13) = (/ & + & 0.10392e+04_r8,0.78550e+03_r8,0.59835e+03_r8,0.88339e+03_r8,0.11683e+04_r8 /) + kbo(:, 4,36,13) = (/ & + & 0.10378e+04_r8,0.78649e+03_r8,0.59690e+03_r8,0.88071e+03_r8,0.11650e+04_r8 /) + kbo(:, 5,36,13) = (/ & + & 0.10389e+04_r8,0.79012e+03_r8,0.59516e+03_r8,0.87821e+03_r8,0.11604e+04_r8 /) + kbo(:, 1,37,13) = (/ & + & 0.10397e+04_r8,0.78790e+03_r8,0.60071e+03_r8,0.88662e+03_r8,0.11729e+04_r8 /) + kbo(:, 2,37,13) = (/ & + & 0.10413e+04_r8,0.78135e+03_r8,0.59986e+03_r8,0.88540e+03_r8,0.11710e+04_r8 /) + kbo(:, 3,37,13) = (/ & + & 0.10434e+04_r8,0.78885e+03_r8,0.59867e+03_r8,0.88341e+03_r8,0.11686e+04_r8 /) + kbo(:, 4,37,13) = (/ & + & 0.10382e+04_r8,0.79636e+03_r8,0.59698e+03_r8,0.88108e+03_r8,0.11655e+04_r8 /) + kbo(:, 5,37,13) = (/ & + & 0.10369e+04_r8,0.78656e+03_r8,0.59536e+03_r8,0.87879e+03_r8,0.11626e+04_r8 /) + kbo(:, 1,38,13) = (/ & + & 0.10433e+04_r8,0.78475e+03_r8,0.60099e+03_r8,0.88680e+03_r8,0.11731e+04_r8 /) + kbo(:, 2,38,13) = (/ & + & 0.10422e+04_r8,0.78187e+03_r8,0.60001e+03_r8,0.88539e+03_r8,0.11713e+04_r8 /) + kbo(:, 3,38,13) = (/ & + & 0.10376e+04_r8,0.78470e+03_r8,0.59854e+03_r8,0.88368e+03_r8,0.11690e+04_r8 /) + kbo(:, 4,38,13) = (/ & + & 0.10379e+04_r8,0.78467e+03_r8,0.59739e+03_r8,0.88147e+03_r8,0.11660e+04_r8 /) + kbo(:, 5,38,13) = (/ & + & 0.10346e+04_r8,0.79279e+03_r8,0.59559e+03_r8,0.87849e+03_r8,0.11631e+04_r8 /) + kbo(:, 1,39,13) = (/ & + & 0.10564e+04_r8,0.79016e+03_r8,0.60113e+03_r8,0.88696e+03_r8,0.11734e+04_r8 /) + kbo(:, 2,39,13) = (/ & + & 0.10405e+04_r8,0.78139e+03_r8,0.59938e+03_r8,0.88561e+03_r8,0.11715e+04_r8 /) + kbo(:, 3,39,13) = (/ & + & 0.10386e+04_r8,0.79256e+03_r8,0.59902e+03_r8,0.88393e+03_r8,0.11693e+04_r8 /) + kbo(:, 4,39,13) = (/ & + & 0.10351e+04_r8,0.78501e+03_r8,0.59779e+03_r8,0.88184e+03_r8,0.11668e+04_r8 /) + kbo(:, 5,39,13) = (/ & + & 0.10353e+04_r8,0.78561e+03_r8,0.59583e+03_r8,0.87937e+03_r8,0.11634e+04_r8 /) + kbo(:, 1,40,13) = (/ & + & 0.10351e+04_r8,0.78501e+03_r8,0.60325e+03_r8,0.88723e+03_r8,0.11737e+04_r8 /) + kbo(:, 2,40,13) = (/ & + & 0.10332e+04_r8,0.78519e+03_r8,0.60040e+03_r8,0.88596e+03_r8,0.11720e+04_r8 /) + kbo(:, 3,40,13) = (/ & + & 0.10393e+04_r8,0.78843e+03_r8,0.59931e+03_r8,0.88436e+03_r8,0.11699e+04_r8 /) + kbo(:, 4,40,13) = (/ & + & 0.10339e+04_r8,0.78821e+03_r8,0.59801e+03_r8,0.88242e+03_r8,0.11676e+04_r8 /) + kbo(:, 5,40,13) = (/ & + & 0.10476e+04_r8,0.78616e+03_r8,0.59626e+03_r8,0.87958e+03_r8,0.11639e+04_r8 /) + kbo(:, 1,41,13) = (/ & + & 0.10420e+04_r8,0.78658e+03_r8,0.60226e+03_r8,0.88748e+03_r8,0.11740e+04_r8 /) + kbo(:, 2,41,13) = (/ & + & 0.10471e+04_r8,0.78433e+03_r8,0.60065e+03_r8,0.88632e+03_r8,0.11725e+04_r8 /) + kbo(:, 3,41,13) = (/ & + & 0.10385e+04_r8,0.78777e+03_r8,0.59960e+03_r8,0.88480e+03_r8,0.11705e+04_r8 /) + kbo(:, 4,41,13) = (/ & + & 0.10374e+04_r8,0.79305e+03_r8,0.59837e+03_r8,0.88319e+03_r8,0.11680e+04_r8 /) + kbo(:, 5,41,13) = (/ & + & 0.10341e+04_r8,0.79121e+03_r8,0.59671e+03_r8,0.88067e+03_r8,0.11641e+04_r8 /) + kbo(:, 1,42,13) = (/ & + & 0.10427e+04_r8,0.78654e+03_r8,0.60202e+03_r8,0.88768e+03_r8,0.11743e+04_r8 /) + kbo(:, 2,42,13) = (/ & + & 0.10376e+04_r8,0.78774e+03_r8,0.60073e+03_r8,0.88666e+03_r8,0.11730e+04_r8 /) + kbo(:, 3,42,13) = (/ & + & 0.10387e+04_r8,0.78631e+03_r8,0.59989e+03_r8,0.88522e+03_r8,0.11710e+04_r8 /) + kbo(:, 4,42,13) = (/ & + & 0.10432e+04_r8,0.79240e+03_r8,0.59870e+03_r8,0.88347e+03_r8,0.11690e+04_r8 /) + kbo(:, 5,42,13) = (/ & + & 0.10408e+04_r8,0.78283e+03_r8,0.59718e+03_r8,0.88116e+03_r8,0.11677e+04_r8 /) + kbo(:, 1,43,13) = (/ & + & 0.10384e+04_r8,0.78732e+03_r8,0.60211e+03_r8,0.88787e+03_r8,0.11746e+04_r8 /) + kbo(:, 2,43,13) = (/ & + & 0.10392e+04_r8,0.79483e+03_r8,0.60103e+03_r8,0.88703e+03_r8,0.11735e+04_r8 /) + kbo(:, 3,43,13) = (/ & + & 0.10435e+04_r8,0.79279e+03_r8,0.60022e+03_r8,0.88570e+03_r8,0.11717e+04_r8 /) + kbo(:, 4,43,13) = (/ & + & 0.10453e+04_r8,0.78261e+03_r8,0.59909e+03_r8,0.88405e+03_r8,0.11698e+04_r8 /) + kbo(:, 5,43,13) = (/ & + & 0.10349e+04_r8,0.78239e+03_r8,0.59773e+03_r8,0.88200e+03_r8,0.11670e+04_r8 /) + kbo(:, 1,44,13) = (/ & + & 0.10376e+04_r8,0.78973e+03_r8,0.60218e+03_r8,0.88797e+03_r8,0.11747e+04_r8 /) + kbo(:, 2,44,13) = (/ & + & 0.10357e+04_r8,0.79073e+03_r8,0.60154e+03_r8,0.88738e+03_r8,0.11742e+04_r8 /) + kbo(:, 3,44,13) = (/ & + & 0.10381e+04_r8,0.78584e+03_r8,0.60056e+03_r8,0.88619e+03_r8,0.11723e+04_r8 /) + kbo(:, 4,44,13) = (/ & + & 0.10410e+04_r8,0.78726e+03_r8,0.59965e+03_r8,0.88464e+03_r8,0.11703e+04_r8 /) + kbo(:, 5,44,13) = (/ & + & 0.10370e+04_r8,0.78461e+03_r8,0.59824e+03_r8,0.88299e+03_r8,0.11677e+04_r8 /) + kbo(:, 1,45,13) = (/ & + & 0.10383e+04_r8,0.78177e+03_r8,0.60254e+03_r8,0.88799e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,45,13) = (/ & + & 0.10337e+04_r8,0.78400e+03_r8,0.60200e+03_r8,0.88790e+03_r8,0.11743e+04_r8 /) + kbo(:, 3,45,13) = (/ & + & 0.10407e+04_r8,0.78928e+03_r8,0.60087e+03_r8,0.88664e+03_r8,0.11732e+04_r8 /) + kbo(:, 4,45,13) = (/ & + & 0.10410e+04_r8,0.79578e+03_r8,0.59987e+03_r8,0.88519e+03_r8,0.11713e+04_r8 /) + kbo(:, 5,45,13) = (/ & + & 0.10369e+04_r8,0.78337e+03_r8,0.59884e+03_r8,0.88344e+03_r8,0.11687e+04_r8 /) + kbo(:, 1,46,13) = (/ & + & 0.10415e+04_r8,0.79090e+03_r8,0.60272e+03_r8,0.88805e+03_r8,0.11749e+04_r8 /) + kbo(:, 2,46,13) = (/ & + & 0.10332e+04_r8,0.79374e+03_r8,0.60213e+03_r8,0.88788e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,46,13) = (/ & + & 0.10495e+04_r8,0.78743e+03_r8,0.60122e+03_r8,0.88707e+03_r8,0.11738e+04_r8 /) + kbo(:, 4,46,13) = (/ & + & 0.10359e+04_r8,0.78275e+03_r8,0.60025e+03_r8,0.88575e+03_r8,0.11717e+04_r8 /) + kbo(:, 5,46,13) = (/ & + & 0.10407e+04_r8,0.79210e+03_r8,0.59913e+03_r8,0.88411e+03_r8,0.11695e+04_r8 /) + kbo(:, 1,47,13) = (/ & + & 0.10396e+04_r8,0.78478e+03_r8,0.60291e+03_r8,0.88833e+03_r8,0.11753e+04_r8 /) + kbo(:, 2,47,13) = (/ & + & 0.10391e+04_r8,0.78254e+03_r8,0.60239e+03_r8,0.88798e+03_r8,0.11747e+04_r8 /) + kbo(:, 3,47,13) = (/ & + & 0.10358e+04_r8,0.79087e+03_r8,0.60194e+03_r8,0.88748e+03_r8,0.11740e+04_r8 /) + kbo(:, 4,47,13) = (/ & + & 0.10382e+04_r8,0.78212e+03_r8,0.60065e+03_r8,0.88632e+03_r8,0.11725e+04_r8 /) + kbo(:, 5,47,13) = (/ & + & 0.10417e+04_r8,0.78639e+03_r8,0.59976e+03_r8,0.88480e+03_r8,0.11705e+04_r8 /) + kbo(:, 1,48,13) = (/ & + & 0.10401e+04_r8,0.78456e+03_r8,0.60307e+03_r8,0.88865e+03_r8,0.11757e+04_r8 /) + kbo(:, 2,48,13) = (/ & + & 0.10385e+04_r8,0.78639e+03_r8,0.60262e+03_r8,0.88799e+03_r8,0.11748e+04_r8 /) + kbo(:, 3,48,13) = (/ & + & 0.10377e+04_r8,0.78374e+03_r8,0.60183e+03_r8,0.88778e+03_r8,0.11745e+04_r8 /) + kbo(:, 4,48,13) = (/ & + & 0.10347e+04_r8,0.78455e+03_r8,0.60102e+03_r8,0.88707e+03_r8,0.11732e+04_r8 /) + kbo(:, 5,48,13) = (/ & + & 0.10420e+04_r8,0.79085e+03_r8,0.60005e+03_r8,0.88545e+03_r8,0.11713e+04_r8 /) + kbo(:, 1,49,13) = (/ & + & 0.10372e+04_r8,0.78740e+03_r8,0.60317e+03_r8,0.88862e+03_r8,0.11760e+04_r8 /) + kbo(:, 2,49,13) = (/ & + & 0.10417e+04_r8,0.78862e+03_r8,0.60282e+03_r8,0.88818e+03_r8,0.11751e+04_r8 /) + kbo(:, 3,49,13) = (/ & + & 0.10345e+04_r8,0.78780e+03_r8,0.60227e+03_r8,0.88818e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,49,13) = (/ & + & 0.10406e+04_r8,0.78617e+03_r8,0.60221e+03_r8,0.88729e+03_r8,0.11738e+04_r8 /) + kbo(:, 5,49,13) = (/ & + & 0.10382e+04_r8,0.79023e+03_r8,0.60061e+03_r8,0.88605e+03_r8,0.11721e+04_r8 /) + kbo(:, 1,50,13) = (/ & + & 0.10347e+04_r8,0.79207e+03_r8,0.60367e+03_r8,0.88900e+03_r8,0.11761e+04_r8 /) + kbo(:, 2,50,13) = (/ & + & 0.10350e+04_r8,0.78739e+03_r8,0.60298e+03_r8,0.88872e+03_r8,0.11755e+04_r8 /) + kbo(:, 3,50,13) = (/ & + & 0.10353e+04_r8,0.78433e+03_r8,0.60234e+03_r8,0.88799e+03_r8,0.11744e+04_r8 /) + kbo(:, 4,50,13) = (/ & + & 0.10489e+04_r8,0.79267e+03_r8,0.60164e+03_r8,0.88763e+03_r8,0.11743e+04_r8 /) + kbo(:, 5,50,13) = (/ & + & 0.10406e+04_r8,0.78514e+03_r8,0.60019e+03_r8,0.88656e+03_r8,0.11728e+04_r8 /) + kbo(:, 1,51,13) = (/ & + & 0.10345e+04_r8,0.78799e+03_r8,0.60398e+03_r8,0.88932e+03_r8,0.11765e+04_r8 /) + kbo(:, 2,51,13) = (/ & + & 0.10401e+04_r8,0.78697e+03_r8,0.60314e+03_r8,0.88874e+03_r8,0.11758e+04_r8 /) + kbo(:, 3,51,13) = (/ & + & 0.10366e+04_r8,0.78656e+03_r8,0.60285e+03_r8,0.88803e+03_r8,0.11749e+04_r8 /) + kbo(:, 4,51,13) = (/ & + & 0.10374e+04_r8,0.78473e+03_r8,0.60240e+03_r8,0.88809e+03_r8,0.11746e+04_r8 /) + kbo(:, 5,51,13) = (/ & + & 0.10390e+04_r8,0.78920e+03_r8,0.60116e+03_r8,0.88701e+03_r8,0.11734e+04_r8 /) + kbo(:, 1,52,13) = (/ & + & 0.10369e+04_r8,0.78758e+03_r8,0.60425e+03_r8,0.88974e+03_r8,0.11770e+04_r8 /) + kbo(:, 2,52,13) = (/ & + & 0.10369e+04_r8,0.78229e+03_r8,0.60357e+03_r8,0.88889e+03_r8,0.11760e+04_r8 /) + kbo(:, 3,52,13) = (/ & + & 0.10371e+04_r8,0.78737e+03_r8,0.60287e+03_r8,0.88826e+03_r8,0.11752e+04_r8 /) + kbo(:, 4,52,13) = (/ & + & 0.10414e+04_r8,0.78574e+03_r8,0.60234e+03_r8,0.88797e+03_r8,0.11747e+04_r8 /) + kbo(:, 5,52,13) = (/ & + & 0.10377e+04_r8,0.78696e+03_r8,0.60170e+03_r8,0.88739e+03_r8,0.11739e+04_r8 /) + kbo(:, 1,53,13) = (/ & + & 0.10446e+04_r8,0.78533e+03_r8,0.60451e+03_r8,0.89022e+03_r8,0.11778e+04_r8 /) + kbo(:, 2,53,13) = (/ & + & 0.10366e+04_r8,0.78675e+03_r8,0.60391e+03_r8,0.88907e+03_r8,0.11762e+04_r8 /) + kbo(:, 3,53,13) = (/ & + & 0.10339e+04_r8,0.78472e+03_r8,0.60302e+03_r8,0.88857e+03_r8,0.11756e+04_r8 /) + kbo(:, 4,53,13) = (/ & + & 0.10347e+04_r8,0.78858e+03_r8,0.60271e+03_r8,0.88799e+03_r8,0.11748e+04_r8 /) + kbo(:, 5,53,13) = (/ & + & 0.10414e+04_r8,0.78370e+03_r8,0.60188e+03_r8,0.88770e+03_r8,0.11743e+04_r8 /) + kbo(:, 1,54,13) = (/ & + & 0.10366e+04_r8,0.78980e+03_r8,0.60463e+03_r8,0.89072e+03_r8,0.11788e+04_r8 /) + kbo(:, 2,54,13) = (/ & + & 0.10376e+04_r8,0.78289e+03_r8,0.60402e+03_r8,0.88939e+03_r8,0.11765e+04_r8 /) + kbo(:, 3,54,13) = (/ & + & 0.10387e+04_r8,0.78695e+03_r8,0.60318e+03_r8,0.88877e+03_r8,0.11759e+04_r8 /) + kbo(:, 4,54,13) = (/ & + & 0.10435e+04_r8,0.78370e+03_r8,0.60273e+03_r8,0.88806e+03_r8,0.11749e+04_r8 /) + kbo(:, 5,54,13) = (/ & + & 0.10492e+04_r8,0.79000e+03_r8,0.60214e+03_r8,0.88789e+03_r8,0.11746e+04_r8 /) + kbo(:, 1,55,13) = (/ & + & 0.10395e+04_r8,0.78654e+03_r8,0.60524e+03_r8,0.89136e+03_r8,0.11799e+04_r8 /) + kbo(:, 2,55,13) = (/ & + & 0.10379e+04_r8,0.78553e+03_r8,0.60426e+03_r8,0.88977e+03_r8,0.11770e+04_r8 /) + kbo(:, 3,55,13) = (/ & + & 0.10376e+04_r8,0.78959e+03_r8,0.60343e+03_r8,0.88890e+03_r8,0.11757e+04_r8 /) + kbo(:, 4,55,13) = (/ & + & 0.10360e+04_r8,0.78634e+03_r8,0.60272e+03_r8,0.88828e+03_r8,0.11752e+04_r8 /) + kbo(:, 5,55,13) = (/ & + & 0.10355e+04_r8,0.78796e+03_r8,0.60219e+03_r8,0.88821e+03_r8,0.11747e+04_r8 /) + kbo(:, 1,56,13) = (/ & + & 0.10500e+04_r8,0.78471e+03_r8,0.60540e+03_r8,0.89210e+03_r8,0.11812e+04_r8 /) + kbo(:, 2,56,13) = (/ & + & 0.10441e+04_r8,0.78735e+03_r8,0.60449e+03_r8,0.89019e+03_r8,0.11777e+04_r8 /) + kbo(:, 3,56,13) = (/ & + & 0.10382e+04_r8,0.78755e+03_r8,0.60374e+03_r8,0.88905e+03_r8,0.11759e+04_r8 /) + kbo(:, 4,56,13) = (/ & + & 0.10470e+04_r8,0.78715e+03_r8,0.60301e+03_r8,0.88855e+03_r8,0.11756e+04_r8 /) + kbo(:, 5,56,13) = (/ & + & 0.10358e+04_r8,0.78674e+03_r8,0.60270e+03_r8,0.88799e+03_r8,0.11748e+04_r8 /) + kbo(:, 1,57,13) = (/ & + & 0.10339e+04_r8,0.78715e+03_r8,0.60588e+03_r8,0.89295e+03_r8,0.11828e+04_r8 /) + kbo(:, 2,57,13) = (/ & + & 0.10441e+04_r8,0.78267e+03_r8,0.60475e+03_r8,0.89065e+03_r8,0.11787e+04_r8 /) + kbo(:, 3,57,13) = (/ & + & 0.10435e+04_r8,0.78938e+03_r8,0.60399e+03_r8,0.88934e+03_r8,0.11765e+04_r8 /) + kbo(:, 4,57,13) = (/ & + & 0.10392e+04_r8,0.79203e+03_r8,0.60300e+03_r8,0.88875e+03_r8,0.11758e+04_r8 /) + kbo(:, 5,57,13) = (/ & + & 0.10360e+04_r8,0.78491e+03_r8,0.60271e+03_r8,0.88827e+03_r8,0.11749e+04_r8 /) + kbo(:, 1,58,13) = (/ & + & 0.10392e+04_r8,0.78430e+03_r8,0.60601e+03_r8,0.89398e+03_r8,0.11847e+04_r8 /) + kbo(:, 2,58,13) = (/ & + & 0.10363e+04_r8,0.78694e+03_r8,0.60503e+03_r8,0.89124e+03_r8,0.11797e+04_r8 /) + kbo(:, 3,58,13) = (/ & + & 0.10360e+04_r8,0.78084e+03_r8,0.60391e+03_r8,0.88970e+03_r8,0.11769e+04_r8 /) + kbo(:, 4,58,13) = (/ & + & 0.10459e+04_r8,0.78267e+03_r8,0.60338e+03_r8,0.88888e+03_r8,0.11757e+04_r8 /) + kbo(:, 5,58,13) = (/ & + & 0.10368e+04_r8,0.79101e+03_r8,0.60285e+03_r8,0.88823e+03_r8,0.11752e+04_r8 /) + kbo(:, 1,59,13) = (/ & + & 0.10403e+04_r8,0.78613e+03_r8,0.60612e+03_r8,0.89444e+03_r8,0.11849e+04_r8 /) + kbo(:, 2,59,13) = (/ & + & 0.10349e+04_r8,0.78531e+03_r8,0.60514e+03_r8,0.89150e+03_r8,0.11802e+04_r8 /) + kbo(:, 3,59,13) = (/ & + & 0.10360e+04_r8,0.78470e+03_r8,0.60447e+03_r8,0.88985e+03_r8,0.11771e+04_r8 /) + kbo(:, 4,59,13) = (/ & + & 0.10411e+04_r8,0.78531e+03_r8,0.60349e+03_r8,0.88892e+03_r8,0.11761e+04_r8 /) + kbo(:, 5,59,13) = (/ & + & 0.10355e+04_r8,0.78795e+03_r8,0.60275e+03_r8,0.88833e+03_r8,0.11753e+04_r8 /) + kbo(:, 1,13,14) = (/ & + & 0.12194e+04_r8,0.91192e+03_r8,0.60649e+03_r8,0.89289e+03_r8,0.11803e+04_r8 /) + kbo(:, 2,13,14) = (/ & + & 0.11340e+04_r8,0.93388e+03_r8,0.60565e+03_r8,0.89163e+03_r8,0.11786e+04_r8 /) + kbo(:, 3,13,14) = (/ & + & 0.11287e+04_r8,0.93154e+03_r8,0.60510e+03_r8,0.89077e+03_r8,0.11775e+04_r8 /) + kbo(:, 4,13,14) = (/ & + & 0.11571e+04_r8,0.89198e+03_r8,0.60383e+03_r8,0.88977e+03_r8,0.11762e+04_r8 /) + kbo(:, 5,13,14) = (/ & + & 0.11232e+04_r8,0.85932e+03_r8,0.60280e+03_r8,0.88865e+03_r8,0.11748e+04_r8 /) + kbo(:, 1,14,14) = (/ & + & 0.11313e+04_r8,0.85574e+03_r8,0.60604e+03_r8,0.89259e+03_r8,0.11800e+04_r8 /) + kbo(:, 2,14,14) = (/ & + & 0.11392e+04_r8,0.85278e+03_r8,0.60523e+03_r8,0.89143e+03_r8,0.11785e+04_r8 /) + kbo(:, 3,14,14) = (/ & + & 0.11402e+04_r8,0.86846e+03_r8,0.60420e+03_r8,0.89055e+03_r8,0.11774e+04_r8 /) + kbo(:, 4,14,14) = (/ & + & 0.11058e+04_r8,0.85128e+03_r8,0.60339e+03_r8,0.88920e+03_r8,0.11761e+04_r8 /) + kbo(:, 5,14,14) = (/ & + & 0.11286e+04_r8,0.84325e+03_r8,0.60241e+03_r8,0.88842e+03_r8,0.11746e+04_r8 /) + kbo(:, 1,15,14) = (/ & + & 0.11349e+04_r8,0.84417e+03_r8,0.60541e+03_r8,0.89231e+03_r8,0.11798e+04_r8 /) + kbo(:, 2,15,14) = (/ & + & 0.11015e+04_r8,0.88045e+03_r8,0.60487e+03_r8,0.89125e+03_r8,0.11784e+04_r8 /) + kbo(:, 3,15,14) = (/ & + & 0.11261e+04_r8,0.83776e+03_r8,0.60408e+03_r8,0.89034e+03_r8,0.11772e+04_r8 /) + kbo(:, 4,15,14) = (/ & + & 0.10962e+04_r8,0.86597e+03_r8,0.60302e+03_r8,0.88937e+03_r8,0.11760e+04_r8 /) + kbo(:, 5,15,14) = (/ & + & 0.10995e+04_r8,0.86095e+03_r8,0.60207e+03_r8,0.88855e+03_r8,0.11740e+04_r8 /) + kbo(:, 1,16,14) = (/ & + & 0.11556e+04_r8,0.89943e+03_r8,0.60533e+03_r8,0.89241e+03_r8,0.11796e+04_r8 /) + kbo(:, 2,16,14) = (/ & + & 0.10928e+04_r8,0.87845e+03_r8,0.60456e+03_r8,0.89108e+03_r8,0.11783e+04_r8 /) + kbo(:, 3,16,14) = (/ & + & 0.11526e+04_r8,0.84568e+03_r8,0.60375e+03_r8,0.89014e+03_r8,0.11771e+04_r8 /) + kbo(:, 4,16,14) = (/ & + & 0.11224e+04_r8,0.82958e+03_r8,0.60245e+03_r8,0.88919e+03_r8,0.11758e+04_r8 /) + kbo(:, 5,16,14) = (/ & + & 0.11104e+04_r8,0.83492e+03_r8,0.60177e+03_r8,0.88796e+03_r8,0.11747e+04_r8 /) + kbo(:, 1,17,14) = (/ & + & 0.11093e+04_r8,0.86391e+03_r8,0.60505e+03_r8,0.89183e+03_r8,0.11794e+04_r8 /) + kbo(:, 2,17,14) = (/ & + & 0.10879e+04_r8,0.83992e+03_r8,0.60455e+03_r8,0.89093e+03_r8,0.11782e+04_r8 /) + kbo(:, 3,17,14) = (/ & + & 0.11180e+04_r8,0.83675e+03_r8,0.60345e+03_r8,0.88997e+03_r8,0.11769e+04_r8 /) + kbo(:, 4,17,14) = (/ & + & 0.11203e+04_r8,0.81299e+03_r8,0.60195e+03_r8,0.88902e+03_r8,0.11757e+04_r8 /) + kbo(:, 5,17,14) = (/ & + & 0.10902e+04_r8,0.84755e+03_r8,0.60151e+03_r8,0.88739e+03_r8,0.11736e+04_r8 /) + kbo(:, 1,18,14) = (/ & + & 0.10889e+04_r8,0.82171e+03_r8,0.60482e+03_r8,0.89199e+03_r8,0.11792e+04_r8 /) + kbo(:, 2,18,14) = (/ & + & 0.10836e+04_r8,0.85518e+03_r8,0.60408e+03_r8,0.89079e+03_r8,0.11781e+04_r8 /) + kbo(:, 3,18,14) = (/ & + & 0.10919e+04_r8,0.82437e+03_r8,0.60318e+03_r8,0.88981e+03_r8,0.11763e+04_r8 /) + kbo(:, 4,18,14) = (/ & + & 0.11143e+04_r8,0.86811e+03_r8,0.60223e+03_r8,0.88886e+03_r8,0.11755e+04_r8 /) + kbo(:, 5,18,14) = (/ & + & 0.10618e+04_r8,0.80694e+03_r8,0.60104e+03_r8,0.88718e+03_r8,0.11738e+04_r8 /) + kbo(:, 1,19,14) = (/ & + & 0.10700e+04_r8,0.81179e+03_r8,0.60437e+03_r8,0.89145e+03_r8,0.11790e+04_r8 /) + kbo(:, 2,19,14) = (/ & + & 0.11096e+04_r8,0.84185e+03_r8,0.60389e+03_r8,0.89066e+03_r8,0.11785e+04_r8 /) + kbo(:, 3,19,14) = (/ & + & 0.10919e+04_r8,0.82575e+03_r8,0.60295e+03_r8,0.89004e+03_r8,0.11767e+04_r8 /) + kbo(:, 4,19,14) = (/ & + & 0.10874e+04_r8,0.81974e+03_r8,0.60205e+03_r8,0.88835e+03_r8,0.11754e+04_r8 /) + kbo(:, 5,19,14) = (/ & + & 0.11077e+04_r8,0.86723e+03_r8,0.60084e+03_r8,0.88734e+03_r8,0.11727e+04_r8 /) + kbo(:, 1,20,14) = (/ & + & 0.10813e+04_r8,0.82037e+03_r8,0.60443e+03_r8,0.89128e+03_r8,0.11789e+04_r8 /) + kbo(:, 2,20,14) = (/ & + & 0.10944e+04_r8,0.83718e+03_r8,0.60369e+03_r8,0.89052e+03_r8,0.11778e+04_r8 /) + kbo(:, 3,20,14) = (/ & + & 0.10922e+04_r8,0.81527e+03_r8,0.60248e+03_r8,0.88953e+03_r8,0.11765e+04_r8 /) + kbo(:, 4,20,14) = (/ & + & 0.10962e+04_r8,0.82815e+03_r8,0.60188e+03_r8,0.88854e+03_r8,0.11752e+04_r8 /) + kbo(:, 5,20,14) = (/ & + & 0.10768e+04_r8,0.81150e+03_r8,0.60064e+03_r8,0.88711e+03_r8,0.11734e+04_r8 /) + kbo(:, 1,21,14) = (/ & + & 0.10919e+04_r8,0.79941e+03_r8,0.60426e+03_r8,0.89114e+03_r8,0.11787e+04_r8 /) + kbo(:, 2,21,14) = (/ & + & 0.10481e+04_r8,0.83111e+03_r8,0.60351e+03_r8,0.89037e+03_r8,0.11777e+04_r8 /) + kbo(:, 3,21,14) = (/ & + & 0.10716e+04_r8,0.81475e+03_r8,0.60253e+03_r8,0.88975e+03_r8,0.11764e+04_r8 /) + kbo(:, 4,21,14) = (/ & + & 0.11197e+04_r8,0.80344e+03_r8,0.60123e+03_r8,0.88837e+03_r8,0.11750e+04_r8 /) + kbo(:, 5,21,14) = (/ & + & 0.10436e+04_r8,0.80977e+03_r8,0.60045e+03_r8,0.88688e+03_r8,0.11731e+04_r8 /) + kbo(:, 1,22,14) = (/ & + & 0.11028e+04_r8,0.82019e+03_r8,0.60406e+03_r8,0.89099e+03_r8,0.11785e+04_r8 /) + kbo(:, 2,22,14) = (/ & + & 0.10664e+04_r8,0.84127e+03_r8,0.60327e+03_r8,0.89089e+03_r8,0.11775e+04_r8 /) + kbo(:, 3,22,14) = (/ & + & 0.10764e+04_r8,0.83101e+03_r8,0.60182e+03_r8,0.88920e+03_r8,0.11762e+04_r8 /) + kbo(:, 4,22,14) = (/ & + & 0.10955e+04_r8,0.82928e+03_r8,0.60175e+03_r8,0.88811e+03_r8,0.11747e+04_r8 /) + kbo(:, 5,22,14) = (/ & + & 0.10429e+04_r8,0.82150e+03_r8,0.60042e+03_r8,0.88653e+03_r8,0.11726e+04_r8 /) + kbo(:, 1,23,14) = (/ & + & 0.10449e+04_r8,0.79677e+03_r8,0.60363e+03_r8,0.89084e+03_r8,0.11784e+04_r8 /) + kbo(:, 2,23,14) = (/ & + & 0.10443e+04_r8,0.81477e+03_r8,0.60352e+03_r8,0.88994e+03_r8,0.11772e+04_r8 /) + kbo(:, 3,23,14) = (/ & + & 0.10490e+04_r8,0.84026e+03_r8,0.60112e+03_r8,0.88900e+03_r8,0.11759e+04_r8 /) + kbo(:, 4,23,14) = (/ & + & 0.10652e+04_r8,0.80737e+03_r8,0.60128e+03_r8,0.88783e+03_r8,0.11744e+04_r8 /) + kbo(:, 5,23,14) = (/ & + & 0.10777e+04_r8,0.80975e+03_r8,0.60014e+03_r8,0.88615e+03_r8,0.11722e+04_r8 /) + kbo(:, 1,24,14) = (/ & + & 0.10587e+04_r8,0.83370e+03_r8,0.60369e+03_r8,0.89067e+03_r8,0.11782e+04_r8 /) + kbo(:, 2,24,14) = (/ & + & 0.10413e+04_r8,0.79049e+03_r8,0.60278e+03_r8,0.88972e+03_r8,0.11769e+04_r8 /) + kbo(:, 3,24,14) = (/ & + & 0.10508e+04_r8,0.83928e+03_r8,0.60192e+03_r8,0.88879e+03_r8,0.11757e+04_r8 /) + kbo(:, 4,24,14) = (/ & + & 0.10667e+04_r8,0.80304e+03_r8,0.60105e+03_r8,0.88752e+03_r8,0.11740e+04_r8 /) + kbo(:, 5,24,14) = (/ & + & 0.10776e+04_r8,0.78685e+03_r8,0.59985e+03_r8,0.88574e+03_r8,0.11716e+04_r8 /) + kbo(:, 1,25,14) = (/ & + & 0.10559e+04_r8,0.78648e+03_r8,0.60348e+03_r8,0.89048e+03_r8,0.11779e+04_r8 /) + kbo(:, 2,25,14) = (/ & + & 0.10600e+04_r8,0.81980e+03_r8,0.60253e+03_r8,0.88951e+03_r8,0.11766e+04_r8 /) + kbo(:, 3,25,14) = (/ & + & 0.10484e+04_r8,0.79331e+03_r8,0.60149e+03_r8,0.88854e+03_r8,0.11754e+04_r8 /) + kbo(:, 4,25,14) = (/ & + & 0.11000e+04_r8,0.80548e+03_r8,0.60080e+03_r8,0.88717e+03_r8,0.11735e+04_r8 /) + kbo(:, 5,25,14) = (/ & + & 0.11165e+04_r8,0.79968e+03_r8,0.59952e+03_r8,0.88528e+03_r8,0.11711e+04_r8 /) + kbo(:, 1,26,14) = (/ & + & 0.10604e+04_r8,0.79570e+03_r8,0.60325e+03_r8,0.89026e+03_r8,0.11777e+04_r8 /) + kbo(:, 2,26,14) = (/ & + & 0.10870e+04_r8,0.78311e+03_r8,0.60230e+03_r8,0.88929e+03_r8,0.11764e+04_r8 /) + kbo(:, 3,26,14) = (/ & + & 0.10476e+04_r8,0.79338e+03_r8,0.60128e+03_r8,0.88826e+03_r8,0.11750e+04_r8 /) + kbo(:, 4,26,14) = (/ & + & 0.10459e+04_r8,0.80175e+03_r8,0.60027e+03_r8,0.88677e+03_r8,0.11730e+04_r8 /) + kbo(:, 5,26,14) = (/ & + & 0.10485e+04_r8,0.81112e+03_r8,0.59892e+03_r8,0.88476e+03_r8,0.11704e+04_r8 /) + kbo(:, 1,27,14) = (/ & + & 0.10458e+04_r8,0.79457e+03_r8,0.60301e+03_r8,0.89001e+03_r8,0.11773e+04_r8 /) + kbo(:, 2,27,14) = (/ & + & 0.10576e+04_r8,0.79170e+03_r8,0.60208e+03_r8,0.88906e+03_r8,0.11761e+04_r8 /) + kbo(:, 3,27,14) = (/ & + & 0.10632e+04_r8,0.79464e+03_r8,0.60130e+03_r8,0.88794e+03_r8,0.11741e+04_r8 /) + kbo(:, 4,27,14) = (/ & + & 0.10506e+04_r8,0.80916e+03_r8,0.60021e+03_r8,0.88633e+03_r8,0.11725e+04_r8 /) + kbo(:, 5,27,14) = (/ & + & 0.10406e+04_r8,0.79035e+03_r8,0.59878e+03_r8,0.88422e+03_r8,0.11697e+04_r8 /) + kbo(:, 1,28,14) = (/ & + & 0.10390e+04_r8,0.79142e+03_r8,0.60274e+03_r8,0.88940e+03_r8,0.11770e+04_r8 /) + kbo(:, 2,28,14) = (/ & + & 0.10793e+04_r8,0.84664e+03_r8,0.60165e+03_r8,0.88883e+03_r8,0.11758e+04_r8 /) + kbo(:, 3,28,14) = (/ & + & 0.10389e+04_r8,0.81244e+03_r8,0.60106e+03_r8,0.88760e+03_r8,0.11741e+04_r8 /) + kbo(:, 4,28,14) = (/ & + & 0.10910e+04_r8,0.82250e+03_r8,0.59988e+03_r8,0.88586e+03_r8,0.11718e+04_r8 /) + kbo(:, 5,28,14) = (/ & + & 0.10984e+04_r8,0.79766e+03_r8,0.59863e+03_r8,0.88510e+03_r8,0.11689e+04_r8 /) + kbo(:, 1,29,14) = (/ & + & 0.10453e+04_r8,0.79421e+03_r8,0.60249e+03_r8,0.88988e+03_r8,0.11767e+04_r8 /) + kbo(:, 2,29,14) = (/ & + & 0.10759e+04_r8,0.85231e+03_r8,0.59780e+03_r8,0.88856e+03_r8,0.11754e+04_r8 /) + kbo(:, 3,29,14) = (/ & + & 0.10355e+04_r8,0.83260e+03_r8,0.60079e+03_r8,0.88721e+03_r8,0.11736e+04_r8 /) + kbo(:, 4,29,14) = (/ & + & 0.10260e+04_r8,0.78313e+03_r8,0.59953e+03_r8,0.88535e+03_r8,0.11712e+04_r8 /) + kbo(:, 5,29,14) = (/ & + & 0.10495e+04_r8,0.79101e+03_r8,0.59751e+03_r8,0.88309e+03_r8,0.11682e+04_r8 /) + kbo(:, 1,30,14) = (/ & + & 0.10479e+04_r8,0.78753e+03_r8,0.60225e+03_r8,0.88928e+03_r8,0.11764e+04_r8 /) + kbo(:, 2,30,14) = (/ & + & 0.10451e+04_r8,0.80563e+03_r8,0.60150e+03_r8,0.88827e+03_r8,0.11750e+04_r8 /) + kbo(:, 3,30,14) = (/ & + & 0.10758e+04_r8,0.79525e+03_r8,0.60050e+03_r8,0.88643e+03_r8,0.11731e+04_r8 /) + kbo(:, 4,30,14) = (/ & + & 0.10781e+04_r8,0.79929e+03_r8,0.59916e+03_r8,0.88480e+03_r8,0.11705e+04_r8 /) + kbo(:, 5,30,14) = (/ & + & 0.10459e+04_r8,0.81358e+03_r8,0.59790e+03_r8,0.88220e+03_r8,0.11665e+04_r8 /) + kbo(:, 1,31,14) = (/ & + & 0.10607e+04_r8,0.80146e+03_r8,0.60204e+03_r8,0.88905e+03_r8,0.11761e+04_r8 /) + kbo(:, 2,31,14) = (/ & + & 0.10395e+04_r8,0.78822e+03_r8,0.60127e+03_r8,0.88793e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,31,14) = (/ & + & 0.10321e+04_r8,0.80923e+03_r8,0.60018e+03_r8,0.88632e+03_r8,0.11725e+04_r8 /) + kbo(:, 4,31,14) = (/ & + & 0.11042e+04_r8,0.80049e+03_r8,0.59875e+03_r8,0.88457e+03_r8,0.11697e+04_r8 /) + kbo(:, 5,31,14) = (/ & + & 0.10581e+04_r8,0.80105e+03_r8,0.59750e+03_r8,0.88200e+03_r8,0.11672e+04_r8 /) + kbo(:, 1,32,14) = (/ & + & 0.10889e+04_r8,0.84488e+03_r8,0.59867e+03_r8,0.88880e+03_r8,0.11757e+04_r8 /) + kbo(:, 2,32,14) = (/ & + & 0.10428e+04_r8,0.79586e+03_r8,0.60101e+03_r8,0.88756e+03_r8,0.11741e+04_r8 /) + kbo(:, 3,32,14) = (/ & + & 0.10671e+04_r8,0.82487e+03_r8,0.59984e+03_r8,0.88582e+03_r8,0.11718e+04_r8 /) + kbo(:, 4,32,14) = (/ & + & 0.10426e+04_r8,0.83726e+03_r8,0.59809e+03_r8,0.88469e+03_r8,0.11694e+04_r8 /) + kbo(:, 5,32,14) = (/ & + & 0.10522e+04_r8,0.80937e+03_r8,0.59684e+03_r8,0.88175e+03_r8,0.11659e+04_r8 /) + kbo(:, 1,33,14) = (/ & + & 0.10391e+04_r8,0.79980e+03_r8,0.60166e+03_r8,0.88852e+03_r8,0.11754e+04_r8 /) + kbo(:, 2,33,14) = (/ & + & 0.10719e+04_r8,0.78917e+03_r8,0.60073e+03_r8,0.88751e+03_r8,0.11736e+04_r8 /) + kbo(:, 3,33,14) = (/ & + & 0.10389e+04_r8,0.82235e+03_r8,0.59947e+03_r8,0.88564e+03_r8,0.11706e+04_r8 /) + kbo(:, 4,33,14) = (/ & + & 0.10819e+04_r8,0.81877e+03_r8,0.59794e+03_r8,0.88337e+03_r8,0.11676e+04_r8 /) + kbo(:, 5,33,14) = (/ & + & 0.10266e+04_r8,0.78772e+03_r8,0.59642e+03_r8,0.88112e+03_r8,0.11651e+04_r8 /) + kbo(:, 1,34,14) = (/ & + & 0.10675e+04_r8,0.78932e+03_r8,0.60147e+03_r8,0.88789e+03_r8,0.11750e+04_r8 /) + kbo(:, 2,34,14) = (/ & + & 0.10375e+04_r8,0.79310e+03_r8,0.60047e+03_r8,0.88677e+03_r8,0.11731e+04_r8 /) + kbo(:, 3,34,14) = (/ & + & 0.10378e+04_r8,0.82372e+03_r8,0.59913e+03_r8,0.88478e+03_r8,0.11704e+04_r8 /) + kbo(:, 4,34,14) = (/ & + & 0.10677e+04_r8,0.78757e+03_r8,0.59836e+03_r8,0.88254e+03_r8,0.11660e+04_r8 /) + kbo(:, 5,34,14) = (/ & + & 0.10419e+04_r8,0.77666e+03_r8,0.59604e+03_r8,0.87984e+03_r8,0.11644e+04_r8 /) + kbo(:, 1,35,14) = (/ & + & 0.10613e+04_r8,0.80031e+03_r8,0.60136e+03_r8,0.88808e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,35,14) = (/ & + & 0.11118e+04_r8,0.80250e+03_r8,0.60031e+03_r8,0.88654e+03_r8,0.11732e+04_r8 /) + kbo(:, 3,35,14) = (/ & + & 0.10759e+04_r8,0.83185e+03_r8,0.59892e+03_r8,0.88448e+03_r8,0.11701e+04_r8 /) + kbo(:, 4,35,14) = (/ & + & 0.11049e+04_r8,0.77622e+03_r8,0.59743e+03_r8,0.88477e+03_r8,0.11680e+04_r8 /) + kbo(:, 5,35,14) = (/ & + & 0.10459e+04_r8,0.78322e+03_r8,0.59581e+03_r8,0.87986e+03_r8,0.11634e+04_r8 /) + kbo(:, 1,36,14) = (/ & + & 0.10396e+04_r8,0.79026e+03_r8,0.60134e+03_r8,0.88805e+03_r8,0.11748e+04_r8 /) + kbo(:, 2,36,14) = (/ & + & 0.10471e+04_r8,0.80778e+03_r8,0.60028e+03_r8,0.88614e+03_r8,0.11727e+04_r8 /) + kbo(:, 3,36,14) = (/ & + & 0.10450e+04_r8,0.79912e+03_r8,0.59889e+03_r8,0.88407e+03_r8,0.11700e+04_r8 /) + kbo(:, 4,36,14) = (/ & + & 0.10626e+04_r8,0.80803e+03_r8,0.59740e+03_r8,0.88257e+03_r8,0.11756e+04_r8 /) + kbo(:, 5,36,14) = (/ & + & 0.10609e+04_r8,0.81056e+03_r8,0.59577e+03_r8,0.87981e+03_r8,0.11634e+04_r8 /) + kbo(:, 1,37,14) = (/ & + & 0.10479e+04_r8,0.79014e+03_r8,0.60145e+03_r8,0.88822e+03_r8,0.11750e+04_r8 /) + kbo(:, 2,37,14) = (/ & + & 0.10744e+04_r8,0.81437e+03_r8,0.60044e+03_r8,0.88637e+03_r8,0.11730e+04_r8 /) + kbo(:, 3,37,14) = (/ & + & 0.10335e+04_r8,0.79550e+03_r8,0.59909e+03_r8,0.88473e+03_r8,0.11704e+04_r8 /) + kbo(:, 4,37,14) = (/ & + & 0.10410e+04_r8,0.77504e+03_r8,0.59808e+03_r8,0.88321e+03_r8,0.11674e+04_r8 /) + kbo(:, 5,37,14) = (/ & + & 0.10557e+04_r8,0.79226e+03_r8,0.59599e+03_r8,0.88014e+03_r8,0.11643e+04_r8 /) + kbo(:, 1,38,14) = (/ & + & 0.10418e+04_r8,0.80249e+03_r8,0.60156e+03_r8,0.88838e+03_r8,0.11752e+04_r8 /) + kbo(:, 2,38,14) = (/ & + & 0.10220e+04_r8,0.82577e+03_r8,0.60060e+03_r8,0.88697e+03_r8,0.11733e+04_r8 /) + kbo(:, 3,38,14) = (/ & + & 0.10502e+04_r8,0.80915e+03_r8,0.59929e+03_r8,0.88503e+03_r8,0.11708e+04_r8 /) + kbo(:, 4,38,14) = (/ & + & 0.10497e+04_r8,0.81774e+03_r8,0.59826e+03_r8,0.88277e+03_r8,0.11673e+04_r8 /) + kbo(:, 5,38,14) = (/ & + & 0.10771e+04_r8,0.81134e+03_r8,0.59623e+03_r8,0.88049e+03_r8,0.11648e+04_r8 /) + kbo(:, 1,39,14) = (/ & + & 0.10165e+04_r8,0.77782e+03_r8,0.60118e+03_r8,0.88854e+03_r8,0.11754e+04_r8 /) + kbo(:, 2,39,14) = (/ & + & 0.10531e+04_r8,0.80302e+03_r8,0.60075e+03_r8,0.88719e+03_r8,0.11736e+04_r8 /) + kbo(:, 3,39,14) = (/ & + & 0.10758e+04_r8,0.78257e+03_r8,0.59949e+03_r8,0.88533e+03_r8,0.11712e+04_r8 /) + kbo(:, 4,39,14) = (/ & + & 0.10568e+04_r8,0.79852e+03_r8,0.59772e+03_r8,0.88307e+03_r8,0.11677e+04_r8 /) + kbo(:, 5,39,14) = (/ & + & 0.11120e+04_r8,0.79275e+03_r8,0.59645e+03_r8,0.88083e+03_r8,0.11652e+04_r8 /) + kbo(:, 1,40,14) = (/ & + & 0.10416e+04_r8,0.79660e+03_r8,0.59890e+03_r8,0.88879e+03_r8,0.11758e+04_r8 /) + kbo(:, 2,40,14) = (/ & + & 0.10391e+04_r8,0.79051e+03_r8,0.60100e+03_r8,0.88756e+03_r8,0.11741e+04_r8 /) + kbo(:, 3,40,14) = (/ & + & 0.10420e+04_r8,0.78155e+03_r8,0.59983e+03_r8,0.88583e+03_r8,0.11718e+04_r8 /) + kbo(:, 4,40,14) = (/ & + & 0.10496e+04_r8,0.79527e+03_r8,0.59833e+03_r8,0.88434e+03_r8,0.11689e+04_r8 /) + kbo(:, 5,40,14) = (/ & + & 0.10264e+04_r8,0.78919e+03_r8,0.59684e+03_r8,0.88140e+03_r8,0.11660e+04_r8 /) + kbo(:, 1,41,14) = (/ & + & 0.10689e+04_r8,0.80516e+03_r8,0.60103e+03_r8,0.88904e+03_r8,0.11761e+04_r8 /) + kbo(:, 2,41,14) = (/ & + & 0.10416e+04_r8,0.82239e+03_r8,0.60124e+03_r8,0.88792e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,41,14) = (/ & + & 0.10563e+04_r8,0.81535e+03_r8,0.60016e+03_r8,0.88632e+03_r8,0.11725e+04_r8 /) + kbo(:, 4,41,14) = (/ & + & 0.10676e+04_r8,0.82044e+03_r8,0.59873e+03_r8,0.88421e+03_r8,0.11697e+04_r8 /) + kbo(:, 5,41,14) = (/ & + & 0.10596e+04_r8,0.78372e+03_r8,0.59724e+03_r8,0.88164e+03_r8,0.11672e+04_r8 /) + kbo(:, 1,42,14) = (/ & + & 0.10655e+04_r8,0.80320e+03_r8,0.60196e+03_r8,0.88927e+03_r8,0.11764e+04_r8 /) + kbo(:, 2,42,14) = (/ & + & 0.10714e+04_r8,0.78435e+03_r8,0.60147e+03_r8,0.88825e+03_r8,0.11750e+04_r8 /) + kbo(:, 3,42,14) = (/ & + & 0.10516e+04_r8,0.79392e+03_r8,0.60071e+03_r8,0.88678e+03_r8,0.11731e+04_r8 /) + kbo(:, 4,42,14) = (/ & + & 0.10516e+04_r8,0.77763e+03_r8,0.59913e+03_r8,0.88479e+03_r8,0.11700e+04_r8 /) + kbo(:, 5,42,14) = (/ & + & 0.10486e+04_r8,0.79390e+03_r8,0.59811e+03_r8,0.88255e+03_r8,0.11641e+04_r8 /) + kbo(:, 1,43,14) = (/ & + & 0.10979e+04_r8,0.83796e+03_r8,0.60248e+03_r8,0.88955e+03_r8,0.11768e+04_r8 /) + kbo(:, 2,43,14) = (/ & + & 0.11147e+04_r8,0.76548e+03_r8,0.60171e+03_r8,0.88861e+03_r8,0.11750e+04_r8 /) + kbo(:, 3,43,14) = (/ & + & 0.10326e+04_r8,0.79357e+03_r8,0.60081e+03_r8,0.88729e+03_r8,0.11738e+04_r8 /) + kbo(:, 4,43,14) = (/ & + & 0.10439e+04_r8,0.86155e+03_r8,0.59958e+03_r8,0.88546e+03_r8,0.11709e+04_r8 /) + kbo(:, 5,43,14) = (/ & + & 0.10945e+04_r8,0.81749e+03_r8,0.59781e+03_r8,0.88321e+03_r8,0.11679e+04_r8 /) + kbo(:, 1,44,14) = (/ & + & 0.10684e+04_r8,0.83027e+03_r8,0.60306e+03_r8,0.88988e+03_r8,0.11772e+04_r8 /) + kbo(:, 2,44,14) = (/ & + & 0.10549e+04_r8,0.78589e+03_r8,0.60194e+03_r8,0.88895e+03_r8,0.11755e+04_r8 /) + kbo(:, 3,44,14) = (/ & + & 0.10654e+04_r8,0.79705e+03_r8,0.60140e+03_r8,0.88779e+03_r8,0.11744e+04_r8 /) + kbo(:, 4,44,14) = (/ & + & 0.10595e+04_r8,0.79130e+03_r8,0.59979e+03_r8,0.88614e+03_r8,0.11722e+04_r8 /) + kbo(:, 5,44,14) = (/ & + & 0.10477e+04_r8,0.80597e+03_r8,0.59858e+03_r8,0.88363e+03_r8,0.11704e+04_r8 /) + kbo(:, 1,45,14) = (/ & + & 0.10873e+04_r8,0.79417e+03_r8,0.60313e+03_r8,0.89023e+03_r8,0.11777e+04_r8 /) + kbo(:, 2,45,14) = (/ & + & 0.10616e+04_r8,0.78299e+03_r8,0.60195e+03_r8,0.88889e+03_r8,0.11764e+04_r8 /) + kbo(:, 3,45,14) = (/ & + & 0.10452e+04_r8,0.80979e+03_r8,0.60145e+03_r8,0.88823e+03_r8,0.11745e+04_r8 /) + kbo(:, 4,45,14) = (/ & + & 0.10957e+04_r8,0.80372e+03_r8,0.60045e+03_r8,0.88675e+03_r8,0.11726e+04_r8 /) + kbo(:, 5,45,14) = (/ & + & 0.10725e+04_r8,0.79223e+03_r8,0.59886e+03_r8,0.88476e+03_r8,0.11704e+04_r8 /) + kbo(:, 1,46,14) = (/ & + & 0.10477e+04_r8,0.79958e+03_r8,0.60344e+03_r8,0.89054e+03_r8,0.11781e+04_r8 /) + kbo(:, 2,46,14) = (/ & + & 0.10873e+04_r8,0.80021e+03_r8,0.60251e+03_r8,0.88958e+03_r8,0.11768e+04_r8 /) + kbo(:, 3,46,14) = (/ & + & 0.10228e+04_r8,0.78903e+03_r8,0.60173e+03_r8,0.88864e+03_r8,0.11751e+04_r8 /) + kbo(:, 4,46,14) = (/ & + & 0.10295e+04_r8,0.83052e+03_r8,0.60085e+03_r8,0.88734e+03_r8,0.11738e+04_r8 /) + kbo(:, 5,46,14) = (/ & + & 0.10527e+04_r8,0.80434e+03_r8,0.59963e+03_r8,0.88553e+03_r8,0.11714e+04_r8 /) + kbo(:, 1,47,14) = (/ & + & 0.10317e+04_r8,0.78934e+03_r8,0.60373e+03_r8,0.89119e+03_r8,0.11785e+04_r8 /) + kbo(:, 2,47,14) = (/ & + & 0.10325e+04_r8,0.79125e+03_r8,0.60291e+03_r8,0.88999e+03_r8,0.11778e+04_r8 /) + kbo(:, 3,47,14) = (/ & + & 0.10417e+04_r8,0.79891e+03_r8,0.60152e+03_r8,0.88904e+03_r8,0.11761e+04_r8 /) + kbo(:, 4,47,14) = (/ & + & 0.10561e+04_r8,0.78901e+03_r8,0.60124e+03_r8,0.88793e+03_r8,0.11746e+04_r8 /) + kbo(:, 5,47,14) = (/ & + & 0.10468e+04_r8,0.79347e+03_r8,0.59991e+03_r8,0.88632e+03_r8,0.11725e+04_r8 /) + kbo(:, 1,48,14) = (/ & + & 0.10540e+04_r8,0.78901e+03_r8,0.60401e+03_r8,0.89113e+03_r8,0.11789e+04_r8 /) + kbo(:, 2,48,14) = (/ & + & 0.10320e+04_r8,0.80975e+03_r8,0.60327e+03_r8,0.89037e+03_r8,0.11779e+04_r8 /) + kbo(:, 3,48,14) = (/ & + & 0.10535e+04_r8,0.79283e+03_r8,0.60233e+03_r8,0.88940e+03_r8,0.11766e+04_r8 /) + kbo(:, 4,48,14) = (/ & + & 0.10485e+04_r8,0.81102e+03_r8,0.60158e+03_r8,0.88807e+03_r8,0.11753e+04_r8 /) + kbo(:, 5,48,14) = (/ & + & 0.10337e+04_r8,0.82793e+03_r8,0.60064e+03_r8,0.88703e+03_r8,0.11734e+04_r8 /) + kbo(:, 1,49,14) = (/ & + & 0.10304e+04_r8,0.83177e+03_r8,0.60454e+03_r8,0.89164e+03_r8,0.11796e+04_r8 /) + kbo(:, 2,49,14) = (/ & + & 0.10417e+04_r8,0.78580e+03_r8,0.60359e+03_r8,0.89069e+03_r8,0.11783e+04_r8 /) + kbo(:, 3,49,14) = (/ & + & 0.10725e+04_r8,0.82186e+03_r8,0.60271e+03_r8,0.88942e+03_r8,0.11771e+04_r8 /) + kbo(:, 4,49,14) = (/ & + & 0.10362e+04_r8,0.80207e+03_r8,0.60065e+03_r8,0.88885e+03_r8,0.11758e+04_r8 /) + kbo(:, 5,49,14) = (/ & + & 0.10383e+04_r8,0.79856e+03_r8,0.60081e+03_r8,0.88765e+03_r8,0.11743e+04_r8 /) + kbo(:, 1,50,14) = (/ & + & 0.10581e+04_r8,0.78356e+03_r8,0.60457e+03_r8,0.89226e+03_r8,0.11805e+04_r8 /) + kbo(:, 2,50,14) = (/ & + & 0.10447e+04_r8,0.80207e+03_r8,0.60385e+03_r8,0.89058e+03_r8,0.11786e+04_r8 /) + kbo(:, 3,50,14) = (/ & + & 0.10788e+04_r8,0.82154e+03_r8,0.60308e+03_r8,0.89017e+03_r8,0.11776e+04_r8 /) + kbo(:, 4,50,14) = (/ & + & 0.10695e+04_r8,0.79696e+03_r8,0.60214e+03_r8,0.88920e+03_r8,0.11763e+04_r8 /) + kbo(:, 5,50,14) = (/ & + & 0.10859e+04_r8,0.79983e+03_r8,0.60140e+03_r8,0.88816e+03_r8,0.11749e+04_r8 /) + kbo(:, 1,51,14) = (/ & + & 0.10459e+04_r8,0.79632e+03_r8,0.60498e+03_r8,0.89284e+03_r8,0.11812e+04_r8 /) + kbo(:, 2,51,14) = (/ & + & 0.10371e+04_r8,0.78419e+03_r8,0.60411e+03_r8,0.89166e+03_r8,0.11796e+04_r8 /) + kbo(:, 3,51,14) = (/ & + & 0.10657e+04_r8,0.82185e+03_r8,0.60315e+03_r8,0.89049e+03_r8,0.11780e+04_r8 /) + kbo(:, 4,51,14) = (/ & + & 0.10396e+04_r8,0.78418e+03_r8,0.60197e+03_r8,0.88917e+03_r8,0.11768e+04_r8 /) + kbo(:, 5,51,14) = (/ & + & 0.10354e+04_r8,0.78290e+03_r8,0.60169e+03_r8,0.88859e+03_r8,0.11755e+04_r8 /) + kbo(:, 1,52,14) = (/ & + & 0.10434e+04_r8,0.78546e+03_r8,0.60574e+03_r8,0.89370e+03_r8,0.11824e+04_r8 /) + kbo(:, 2,52,14) = (/ & + & 0.10665e+04_r8,0.78610e+03_r8,0.60413e+03_r8,0.89180e+03_r8,0.11798e+04_r8 /) + kbo(:, 3,52,14) = (/ & + & 0.10821e+04_r8,0.78641e+03_r8,0.60367e+03_r8,0.89113e+03_r8,0.11784e+04_r8 /) + kbo(:, 4,52,14) = (/ & + & 0.10514e+04_r8,0.79279e+03_r8,0.60282e+03_r8,0.88989e+03_r8,0.11772e+04_r8 /) + kbo(:, 5,52,14) = (/ & + & 0.10408e+04_r8,0.77939e+03_r8,0.60170e+03_r8,0.88895e+03_r8,0.11760e+04_r8 /) + kbo(:, 1,53,14) = (/ & + & 0.10497e+04_r8,0.80875e+03_r8,0.60601e+03_r8,0.89382e+03_r8,0.11825e+04_r8 /) + kbo(:, 2,53,14) = (/ & + & 0.10514e+04_r8,0.81226e+03_r8,0.60441e+03_r8,0.89243e+03_r8,0.11807e+04_r8 /) + kbo(:, 3,53,14) = (/ & + & 0.11137e+04_r8,0.80237e+03_r8,0.60392e+03_r8,0.89101e+03_r8,0.11787e+04_r8 /) + kbo(:, 4,53,14) = (/ & + & 0.10661e+04_r8,0.79885e+03_r8,0.60292e+03_r8,0.89026e+03_r8,0.11777e+04_r8 /) + kbo(:, 5,53,14) = (/ & + & 0.10324e+04_r8,0.82343e+03_r8,0.60222e+03_r8,0.88929e+03_r8,0.11764e+04_r8 /) + kbo(:, 1,54,14) = (/ & + & 0.10594e+04_r8,0.86492e+03_r8,0.60646e+03_r8,0.89428e+03_r8,0.11831e+04_r8 /) + kbo(:, 2,54,14) = (/ & + & 0.10303e+04_r8,0.85949e+03_r8,0.60506e+03_r8,0.89294e+03_r8,0.11813e+04_r8 /) + kbo(:, 3,54,14) = (/ & + & 0.10905e+04_r8,0.84800e+03_r8,0.60416e+03_r8,0.89138e+03_r8,0.11793e+04_r8 /) + kbo(:, 4,54,14) = (/ & + & 0.10438e+04_r8,0.78736e+03_r8,0.60344e+03_r8,0.89055e+03_r8,0.11781e+04_r8 /) + kbo(:, 5,54,14) = (/ & + & 0.10324e+04_r8,0.83619e+03_r8,0.60252e+03_r8,0.88959e+03_r8,0.11768e+04_r8 /) + kbo(:, 1,55,14) = (/ & + & 0.10463e+04_r8,0.78385e+03_r8,0.60663e+03_r8,0.89475e+03_r8,0.11838e+04_r8 /) + kbo(:, 2,55,14) = (/ & + & 0.10543e+04_r8,0.79119e+03_r8,0.60552e+03_r8,0.89337e+03_r8,0.11824e+04_r8 /) + kbo(:, 3,55,14) = (/ & + & 0.10391e+04_r8,0.80395e+03_r8,0.60439e+03_r8,0.89183e+03_r8,0.11799e+04_r8 /) + kbo(:, 4,55,14) = (/ & + & 0.10421e+04_r8,0.79916e+03_r8,0.60368e+03_r8,0.89078e+03_r8,0.11784e+04_r8 /) + kbo(:, 5,55,14) = (/ & + & 0.10909e+04_r8,0.78448e+03_r8,0.60284e+03_r8,0.88955e+03_r8,0.11777e+04_r8 /) + kbo(:, 1,56,14) = (/ & + & 0.10143e+04_r8,0.81481e+03_r8,0.60727e+03_r8,0.89531e+03_r8,0.11848e+04_r8 /) + kbo(:, 2,56,14) = (/ & + & 0.10240e+04_r8,0.81034e+03_r8,0.60598e+03_r8,0.89378e+03_r8,0.11825e+04_r8 /) + kbo(:, 3,56,14) = (/ & + & 0.10324e+04_r8,0.78927e+03_r8,0.60463e+03_r8,0.89238e+03_r8,0.11806e+04_r8 /) + kbo(:, 4,56,14) = (/ & + & 0.10273e+04_r8,0.78959e+03_r8,0.60390e+03_r8,0.89099e+03_r8,0.11787e+04_r8 /) + kbo(:, 5,56,14) = (/ & + & 0.10404e+04_r8,0.80937e+03_r8,0.60290e+03_r8,0.89024e+03_r8,0.11777e+04_r8 /) + kbo(:, 1,57,14) = (/ & + & 0.10408e+04_r8,0.79150e+03_r8,0.60742e+03_r8,0.89593e+03_r8,0.11860e+04_r8 /) + kbo(:, 2,57,14) = (/ & + & 0.10640e+04_r8,0.82150e+03_r8,0.60641e+03_r8,0.89422e+03_r8,0.11831e+04_r8 /) + kbo(:, 3,57,14) = (/ & + & 0.10551e+04_r8,0.79661e+03_r8,0.60501e+03_r8,0.89288e+03_r8,0.11813e+04_r8 /) + kbo(:, 4,57,14) = (/ & + & 0.10817e+04_r8,0.79118e+03_r8,0.60413e+03_r8,0.89133e+03_r8,0.11792e+04_r8 /) + kbo(:, 5,57,14) = (/ & + & 0.10370e+04_r8,0.79629e+03_r8,0.60341e+03_r8,0.89015e+03_r8,0.11781e+04_r8 /) + kbo(:, 1,58,14) = (/ & + & 0.10442e+04_r8,0.84033e+03_r8,0.60809e+03_r8,0.89672e+03_r8,0.11869e+04_r8 /) + kbo(:, 2,58,14) = (/ & + & 0.10934e+04_r8,0.79820e+03_r8,0.60680e+03_r8,0.89466e+03_r8,0.11837e+04_r8 /) + kbo(:, 3,58,14) = (/ & + & 0.10657e+04_r8,0.80043e+03_r8,0.60544e+03_r8,0.89329e+03_r8,0.11818e+04_r8 /) + kbo(:, 4,58,14) = (/ & + & 0.10223e+04_r8,0.78480e+03_r8,0.60435e+03_r8,0.89175e+03_r8,0.11798e+04_r8 /) + kbo(:, 5,58,14) = (/ & + & 0.10438e+04_r8,0.81735e+03_r8,0.60364e+03_r8,0.89074e+03_r8,0.11789e+04_r8 /) + kbo(:, 1,59,14) = (/ & + & 0.10513e+04_r8,0.80331e+03_r8,0.60826e+03_r8,0.89709e+03_r8,0.11883e+04_r8 /) + kbo(:, 2,59,14) = (/ & + & 0.10429e+04_r8,0.81799e+03_r8,0.60696e+03_r8,0.89486e+03_r8,0.11840e+04_r8 /) + kbo(:, 3,59,14) = (/ & + & 0.10400e+04_r8,0.80905e+03_r8,0.60537e+03_r8,0.89345e+03_r8,0.11830e+04_r8 /) + kbo(:, 4,59,14) = (/ & + & 0.10488e+04_r8,0.79628e+03_r8,0.60443e+03_r8,0.89194e+03_r8,0.11800e+04_r8 /) + kbo(:, 5,59,14) = (/ & + & 0.10795e+04_r8,0.78415e+03_r8,0.60372e+03_r8,0.89082e+03_r8,0.11785e+04_r8 /) + kbo(:, 1,13,15) = (/ & + & 0.98934e+03_r8,0.75572e+03_r8,0.60810e+03_r8,0.89364e+03_r8,0.11812e+04_r8 /) + kbo(:, 2,13,15) = (/ & + & 0.12809e+04_r8,0.72091e+03_r8,0.60670e+03_r8,0.89251e+03_r8,0.11797e+04_r8 /) + kbo(:, 3,13,15) = (/ & + & 0.11704e+04_r8,0.77844e+03_r8,0.60529e+03_r8,0.89171e+03_r8,0.11787e+04_r8 /) + kbo(:, 4,13,15) = (/ & + & 0.11159e+04_r8,0.83495e+03_r8,0.60430e+03_r8,0.89110e+03_r8,0.11779e+04_r8 /) + kbo(:, 5,13,15) = (/ & + & 0.11939e+04_r8,0.93553e+03_r8,0.60355e+03_r8,0.89003e+03_r8,0.11765e+04_r8 /) + kbo(:, 1,14,15) = (/ & + & 0.11963e+04_r8,0.95315e+03_r8,0.60753e+03_r8,0.89338e+03_r8,0.11810e+04_r8 /) + kbo(:, 2,14,15) = (/ & + & 0.11729e+04_r8,0.92141e+03_r8,0.60616e+03_r8,0.89229e+03_r8,0.11796e+04_r8 /) + kbo(:, 3,14,15) = (/ & + & 0.11471e+04_r8,0.85602e+03_r8,0.60478e+03_r8,0.89154e+03_r8,0.11786e+04_r8 /) + kbo(:, 4,14,15) = (/ & + & 0.11824e+04_r8,0.88196e+03_r8,0.60401e+03_r8,0.89091e+03_r8,0.11778e+04_r8 /) + kbo(:, 5,14,15) = (/ & + & 0.11271e+04_r8,0.87462e+03_r8,0.60324e+03_r8,0.89075e+03_r8,0.11763e+04_r8 /) + kbo(:, 1,15,15) = (/ & + & 0.10604e+04_r8,0.90519e+03_r8,0.60703e+03_r8,0.89409e+03_r8,0.11809e+04_r8 /) + kbo(:, 2,15,15) = (/ & + & 0.11577e+04_r8,0.75557e+03_r8,0.60568e+03_r8,0.89209e+03_r8,0.11795e+04_r8 /) + kbo(:, 3,15,15) = (/ & + & 0.11406e+04_r8,0.81803e+03_r8,0.60438e+03_r8,0.89138e+03_r8,0.11785e+04_r8 /) + kbo(:, 4,15,15) = (/ & + & 0.11847e+04_r8,0.71960e+03_r8,0.60376e+03_r8,0.89073e+03_r8,0.11790e+04_r8 /) + kbo(:, 5,15,15) = (/ & + & 0.11179e+04_r8,0.81112e+03_r8,0.60296e+03_r8,0.88859e+03_r8,0.11787e+04_r8 /) + kbo(:, 1,16,15) = (/ & + & 0.10356e+04_r8,0.71983e+03_r8,0.60659e+03_r8,0.89194e+03_r8,0.11820e+04_r8 /) + kbo(:, 2,16,15) = (/ & + & 0.11364e+04_r8,0.76870e+03_r8,0.60526e+03_r8,0.89190e+03_r8,0.11794e+04_r8 /) + kbo(:, 3,16,15) = (/ & + & 0.96034e+03_r8,0.83277e+03_r8,0.60407e+03_r8,0.89124e+03_r8,0.11785e+04_r8 /) + kbo(:, 4,16,15) = (/ & + & 0.10077e+04_r8,0.87988e+03_r8,0.60354e+03_r8,0.89055e+03_r8,0.11776e+04_r8 /) + kbo(:, 5,16,15) = (/ & + & 0.10422e+04_r8,0.83397e+03_r8,0.60335e+03_r8,0.88931e+03_r8,0.11759e+04_r8 /) + kbo(:, 1,17,15) = (/ & + & 0.10091e+04_r8,0.77782e+03_r8,0.60621e+03_r8,0.89269e+03_r8,0.11805e+04_r8 /) + kbo(:, 2,17,15) = (/ & + & 0.11716e+04_r8,0.80971e+03_r8,0.60425e+03_r8,0.89175e+03_r8,0.11793e+04_r8 /) + kbo(:, 3,17,15) = (/ & + & 0.10550e+04_r8,0.78786e+03_r8,0.60385e+03_r8,0.89112e+03_r8,0.11784e+04_r8 /) + kbo(:, 4,17,15) = (/ & + & 0.99990e+03_r8,0.88096e+03_r8,0.60335e+03_r8,0.89039e+03_r8,0.11774e+04_r8 /) + kbo(:, 5,17,15) = (/ & + & 0.11263e+04_r8,0.73127e+03_r8,0.60311e+03_r8,0.88908e+03_r8,0.11770e+04_r8 /) + kbo(:, 1,18,15) = (/ & + & 0.11151e+04_r8,0.85991e+03_r8,0.60588e+03_r8,0.89155e+03_r8,0.11804e+04_r8 /) + kbo(:, 2,18,15) = (/ & + & 0.10413e+04_r8,0.70815e+03_r8,0.60458e+03_r8,0.89161e+03_r8,0.11791e+04_r8 /) + kbo(:, 3,18,15) = (/ & + & 0.11058e+04_r8,0.82037e+03_r8,0.60370e+03_r8,0.89101e+03_r8,0.11783e+04_r8 /) + kbo(:, 4,18,15) = (/ & + & 0.10134e+04_r8,0.64109e+03_r8,0.60383e+03_r8,0.89024e+03_r8,0.11786e+04_r8 /) + kbo(:, 5,18,15) = (/ & + & 0.11497e+04_r8,0.88170e+03_r8,0.60224e+03_r8,0.88981e+03_r8,0.11767e+04_r8 /) + kbo(:, 1,19,15) = (/ & + & 0.10261e+04_r8,0.82130e+03_r8,0.60625e+03_r8,0.89236e+03_r8,0.11802e+04_r8 /) + kbo(:, 2,19,15) = (/ & + & 0.10077e+04_r8,0.78017e+03_r8,0.60431e+03_r8,0.89148e+03_r8,0.11778e+04_r8 /) + kbo(:, 3,19,15) = (/ & + & 0.10505e+04_r8,0.75163e+03_r8,0.60422e+03_r8,0.88995e+03_r8,0.11782e+04_r8 /) + kbo(:, 4,19,15) = (/ & + & 0.10498e+04_r8,0.84163e+03_r8,0.60302e+03_r8,0.89009e+03_r8,0.11772e+04_r8 /) + kbo(:, 5,19,15) = (/ & + & 0.94853e+03_r8,0.71012e+03_r8,0.60269e+03_r8,0.88958e+03_r8,0.11765e+04_r8 /) + kbo(:, 1,20,15) = (/ & + & 0.11198e+04_r8,0.83291e+03_r8,0.60532e+03_r8,0.89221e+03_r8,0.11814e+04_r8 /) + kbo(:, 2,20,15) = (/ & + & 0.10146e+04_r8,0.70988e+03_r8,0.60473e+03_r8,0.89136e+03_r8,0.11789e+04_r8 /) + kbo(:, 3,20,15) = (/ & + & 0.98440e+03_r8,0.83872e+03_r8,0.60345e+03_r8,0.89080e+03_r8,0.11781e+04_r8 /) + kbo(:, 4,20,15) = (/ & + & 0.10595e+04_r8,0.75621e+03_r8,0.60286e+03_r8,0.88992e+03_r8,0.11770e+04_r8 /) + kbo(:, 5,20,15) = (/ & + & 0.10274e+04_r8,0.81836e+03_r8,0.60247e+03_r8,0.88836e+03_r8,0.11749e+04_r8 /) + kbo(:, 1,21,15) = (/ & + & 0.10788e+04_r8,0.78645e+03_r8,0.60506e+03_r8,0.89207e+03_r8,0.11799e+04_r8 /) + kbo(:, 2,21,15) = (/ & + & 0.10852e+04_r8,0.74295e+03_r8,0.60386e+03_r8,0.89125e+03_r8,0.11788e+04_r8 /) + kbo(:, 3,21,15) = (/ & + & 0.10428e+04_r8,0.82396e+03_r8,0.60333e+03_r8,0.88973e+03_r8,0.11780e+04_r8 /) + kbo(:, 4,21,15) = (/ & + & 0.10018e+04_r8,0.87387e+03_r8,0.60336e+03_r8,0.89071e+03_r8,0.11768e+04_r8 /) + kbo(:, 5,21,15) = (/ & + & 0.11155e+04_r8,0.79293e+03_r8,0.60225e+03_r8,0.88809e+03_r8,0.11746e+04_r8 /) + kbo(:, 1,22,15) = (/ & + & 0.10301e+04_r8,0.79445e+03_r8,0.60539e+03_r8,0.89186e+03_r8,0.11797e+04_r8 /) + kbo(:, 2,22,15) = (/ & + & 0.11174e+04_r8,0.68851e+03_r8,0.60364e+03_r8,0.88919e+03_r8,0.11787e+04_r8 /) + kbo(:, 3,22,15) = (/ & + & 0.10845e+04_r8,0.72821e+03_r8,0.60320e+03_r8,0.89053e+03_r8,0.11779e+04_r8 /) + kbo(:, 4,22,15) = (/ & + & 0.94182e+03_r8,0.74129e+03_r8,0.60185e+03_r8,0.88948e+03_r8,0.11777e+04_r8 /) + kbo(:, 5,22,15) = (/ & + & 0.11256e+04_r8,0.74069e+03_r8,0.60323e+03_r8,0.88766e+03_r8,0.11740e+04_r8 /) + kbo(:, 1,23,15) = (/ & + & 0.11218e+04_r8,0.85968e+03_r8,0.60443e+03_r8,0.89167e+03_r8,0.11795e+04_r8 /) + kbo(:, 2,23,15) = (/ & + & 0.10449e+04_r8,0.80739e+03_r8,0.60218e+03_r8,0.89100e+03_r8,0.11785e+04_r8 /) + kbo(:, 3,23,15) = (/ & + & 0.11277e+04_r8,0.69098e+03_r8,0.60306e+03_r8,0.89036e+03_r8,0.11777e+04_r8 /) + kbo(:, 4,23,15) = (/ & + & 0.10580e+04_r8,0.81384e+03_r8,0.60228e+03_r8,0.88919e+03_r8,0.11761e+04_r8 /) + kbo(:, 5,23,15) = (/ & + & 0.10279e+04_r8,0.82530e+03_r8,0.60094e+03_r8,0.88718e+03_r8,0.11734e+04_r8 /) + kbo(:, 1,24,15) = (/ & + & 0.10227e+04_r8,0.68179e+03_r8,0.60412e+03_r8,0.89149e+03_r8,0.11792e+04_r8 /) + kbo(:, 2,24,15) = (/ & + & 0.11518e+04_r8,0.80624e+03_r8,0.60338e+03_r8,0.89088e+03_r8,0.11784e+04_r8 /) + kbo(:, 3,24,15) = (/ & + & 0.10788e+04_r8,0.70820e+03_r8,0.60290e+03_r8,0.89016e+03_r8,0.11787e+04_r8 /) + kbo(:, 4,24,15) = (/ & + & 0.10466e+04_r8,0.82233e+03_r8,0.60268e+03_r8,0.88884e+03_r8,0.11757e+04_r8 /) + kbo(:, 5,24,15) = (/ & + & 0.10066e+04_r8,0.82618e+03_r8,0.60057e+03_r8,0.88665e+03_r8,0.11740e+04_r8 /) + kbo(:, 1,25,15) = (/ & + & 0.10780e+04_r8,0.80937e+03_r8,0.60386e+03_r8,0.89131e+03_r8,0.11790e+04_r8 /) + kbo(:, 2,25,15) = (/ & + & 0.10199e+04_r8,0.81059e+03_r8,0.60327e+03_r8,0.89075e+03_r8,0.11782e+04_r8 /) + kbo(:, 3,25,15) = (/ & + & 0.11207e+04_r8,0.80162e+03_r8,0.60338e+03_r8,0.88992e+03_r8,0.11771e+04_r8 /) + kbo(:, 4,25,15) = (/ & + & 0.97495e+03_r8,0.78589e+03_r8,0.60305e+03_r8,0.88845e+03_r8,0.11751e+04_r8 /) + kbo(:, 5,25,15) = (/ & + & 0.95428e+03_r8,0.80945e+03_r8,0.60015e+03_r8,0.88605e+03_r8,0.11720e+04_r8 /) + kbo(:, 1,26,15) = (/ & + & 0.10862e+04_r8,0.78235e+03_r8,0.60361e+03_r8,0.89115e+03_r8,0.11801e+04_r8 /) + kbo(:, 2,26,15) = (/ & + & 0.91581e+03_r8,0.82546e+03_r8,0.60381e+03_r8,0.89059e+03_r8,0.11780e+04_r8 /) + kbo(:, 3,26,15) = (/ & + & 0.10920e+04_r8,0.84813e+03_r8,0.60253e+03_r8,0.88964e+03_r8,0.11767e+04_r8 /) + kbo(:, 4,26,15) = (/ & + & 0.11174e+04_r8,0.83078e+03_r8,0.60207e+03_r8,0.88892e+03_r8,0.11745e+04_r8 /) + kbo(:, 5,26,15) = (/ & + & 0.11159e+04_r8,0.75128e+03_r8,0.59967e+03_r8,0.88536e+03_r8,0.11723e+04_r8 /) + kbo(:, 1,27,15) = (/ & + & 0.10835e+04_r8,0.80424e+03_r8,0.60343e+03_r8,0.89101e+03_r8,0.11786e+04_r8 /) + kbo(:, 2,27,15) = (/ & + & 0.10910e+04_r8,0.86525e+03_r8,0.60302e+03_r8,0.89041e+03_r8,0.11778e+04_r8 /) + kbo(:, 3,27,15) = (/ & + & 0.10210e+04_r8,0.77642e+03_r8,0.60231e+03_r8,0.89027e+03_r8,0.11763e+04_r8 /) + kbo(:, 4,27,15) = (/ & + & 0.10645e+04_r8,0.80598e+03_r8,0.60105e+03_r8,0.88742e+03_r8,0.11751e+04_r8 /) + kbo(:, 5,27,15) = (/ & + & 0.10451e+04_r8,0.82023e+03_r8,0.59981e+03_r8,0.88559e+03_r8,0.11701e+04_r8 /) + kbo(:, 1,28,15) = (/ & + & 0.10856e+04_r8,0.83991e+03_r8,0.60332e+03_r8,0.89088e+03_r8,0.11784e+04_r8 /) + kbo(:, 2,28,15) = (/ & + & 0.93268e+03_r8,0.70779e+03_r8,0.60288e+03_r8,0.89019e+03_r8,0.11788e+04_r8 /) + kbo(:, 3,28,15) = (/ & + & 0.11243e+04_r8,0.76544e+03_r8,0.60205e+03_r8,0.88894e+03_r8,0.11758e+04_r8 /) + kbo(:, 4,28,15) = (/ & + & 0.10096e+04_r8,0.72189e+03_r8,0.60064e+03_r8,0.88682e+03_r8,0.11730e+04_r8 /) + kbo(:, 5,28,15) = (/ & + & 0.88490e+03_r8,0.83821e+03_r8,0.59801e+03_r8,0.88198e+03_r8,0.11692e+04_r8 /) + kbo(:, 1,29,15) = (/ & + & 0.10218e+04_r8,0.78897e+03_r8,0.60322e+03_r8,0.88978e+03_r8,0.11783e+04_r8 /) + kbo(:, 2,29,15) = (/ & + & 0.97223e+03_r8,0.70803e+03_r8,0.60270e+03_r8,0.88994e+03_r8,0.11772e+04_r8 /) + kbo(:, 3,29,15) = (/ & + & 0.10729e+04_r8,0.71638e+03_r8,0.60175e+03_r8,0.88850e+03_r8,0.11752e+04_r8 /) + kbo(:, 4,29,15) = (/ & + & 0.10369e+04_r8,0.79357e+03_r8,0.60017e+03_r8,0.88614e+03_r8,0.11734e+04_r8 /) + kbo(:, 5,29,15) = (/ & + & 0.10748e+04_r8,0.83591e+03_r8,0.59814e+03_r8,0.88321e+03_r8,0.11671e+04_r8 /) + kbo(:, 1,30,15) = (/ & + & 0.10681e+04_r8,0.78838e+03_r8,0.60311e+03_r8,0.89058e+03_r8,0.11780e+04_r8 /) + kbo(:, 2,30,15) = (/ & + & 0.10690e+04_r8,0.81372e+03_r8,0.60250e+03_r8,0.88965e+03_r8,0.11768e+04_r8 /) + kbo(:, 3,30,15) = (/ & + & 0.10330e+04_r8,0.79065e+03_r8,0.60271e+03_r8,0.88800e+03_r8,0.11759e+04_r8 /) + kbo(:, 4,30,15) = (/ & + & 0.99812e+03_r8,0.80751e+03_r8,0.60032e+03_r8,0.88541e+03_r8,0.11712e+04_r8 /) + kbo(:, 5,30,15) = (/ & + & 0.10394e+04_r8,0.71741e+03_r8,0.59705e+03_r8,0.88643e+03_r8,0.11676e+04_r8 /) + kbo(:, 1,31,15) = (/ & + & 0.10025e+04_r8,0.73187e+03_r8,0.60298e+03_r8,0.89039e+03_r8,0.11778e+04_r8 /) + kbo(:, 2,31,15) = (/ & + & 0.11099e+04_r8,0.74280e+03_r8,0.60227e+03_r8,0.88930e+03_r8,0.11763e+04_r8 /) + kbo(:, 3,31,15) = (/ & + & 0.10884e+04_r8,0.79617e+03_r8,0.60102e+03_r8,0.88838e+03_r8,0.11738e+04_r8 /) + kbo(:, 4,31,15) = (/ & + & 0.90245e+03_r8,0.76637e+03_r8,0.59915e+03_r8,0.88368e+03_r8,0.11701e+04_r8 /) + kbo(:, 5,31,15) = (/ & + & 0.10031e+04_r8,0.78751e+03_r8,0.59673e+03_r8,0.89640e+03_r8,0.11644e+04_r8 /) + kbo(:, 1,32,15) = (/ & + & 0.87663e+03_r8,0.68400e+03_r8,0.60283e+03_r8,0.89016e+03_r8,0.11775e+04_r8 /) + kbo(:, 2,32,15) = (/ & + & 0.10467e+04_r8,0.83071e+03_r8,0.60330e+03_r8,0.88890e+03_r8,0.11758e+04_r8 /) + kbo(:, 3,32,15) = (/ & + & 0.97045e+03_r8,0.72881e+03_r8,0.60123e+03_r8,0.88677e+03_r8,0.11730e+04_r8 /) + kbo(:, 4,32,15) = (/ & + & 0.11080e+04_r8,0.69141e+03_r8,0.59860e+03_r8,0.88193e+03_r8,0.11679e+04_r8 /) + kbo(:, 5,32,15) = (/ & + & 0.10206e+04_r8,0.73037e+03_r8,0.59837e+03_r8,0.88358e+03_r8,0.11726e+04_r8 /) + kbo(:, 1,33,15) = (/ & + & 0.10520e+04_r8,0.78807e+03_r8,0.60265e+03_r8,0.89086e+03_r8,0.11771e+04_r8 /) + kbo(:, 2,33,15) = (/ & + & 0.98139e+03_r8,0.81175e+03_r8,0.60169e+03_r8,0.88843e+03_r8,0.11752e+04_r8 /) + kbo(:, 3,33,15) = (/ & + & 0.11223e+04_r8,0.75994e+03_r8,0.60074e+03_r8,0.88510e+03_r8,0.11720e+04_r8 /) + kbo(:, 4,33,15) = (/ & + & 0.10271e+04_r8,0.75564e+03_r8,0.59806e+03_r8,0.88218e+03_r8,0.11708e+04_r8 /) + kbo(:, 5,33,15) = (/ & + & 0.10438e+04_r8,0.78527e+03_r8,0.59677e+03_r8,0.88217e+03_r8,0.11682e+04_r8 /) + kbo(:, 1,34,15) = (/ & + & 0.10293e+04_r8,0.82175e+03_r8,0.60313e+03_r8,0.88963e+03_r8,0.11768e+04_r8 /) + kbo(:, 2,34,15) = (/ & + & 0.11086e+04_r8,0.80472e+03_r8,0.60138e+03_r8,0.88797e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,34,15) = (/ & + & 0.10235e+04_r8,0.72497e+03_r8,0.60029e+03_r8,0.88634e+03_r8,0.11724e+04_r8 /) + kbo(:, 4,34,15) = (/ & + & 0.10022e+04_r8,0.79360e+03_r8,0.59703e+03_r8,0.88927e+03_r8,0.11777e+04_r8 /) + kbo(:, 5,34,15) = (/ & + & 0.11107e+04_r8,0.84019e+03_r8,0.59650e+03_r8,0.88082e+03_r8,0.11651e+04_r8 /) + kbo(:, 1,35,15) = (/ & + & 0.10782e+04_r8,0.81052e+03_r8,0.60236e+03_r8,0.89138e+03_r8,0.11766e+04_r8 /) + kbo(:, 2,35,15) = (/ & + & 0.89922e+03_r8,0.74859e+03_r8,0.60119e+03_r8,0.88769e+03_r8,0.11729e+04_r8 /) + kbo(:, 3,35,15) = (/ & + & 0.10088e+04_r8,0.71209e+03_r8,0.59938e+03_r8,0.88499e+03_r8,0.11706e+04_r8 /) + kbo(:, 4,35,15) = (/ & + & 0.96175e+03_r8,0.77055e+03_r8,0.60072e+03_r8,0.87852e+03_r8,0.11710e+04_r8 /) + kbo(:, 5,35,15) = (/ & + & 0.10310e+04_r8,0.84426e+03_r8,0.59635e+03_r8,0.88059e+03_r8,0.11648e+04_r8 /) + kbo(:, 1,36,15) = (/ & + & 0.10188e+04_r8,0.85190e+03_r8,0.60234e+03_r8,0.88943e+03_r8,0.11765e+04_r8 /) + kbo(:, 2,36,15) = (/ & + & 0.10154e+04_r8,0.76964e+03_r8,0.60245e+03_r8,0.88859e+03_r8,0.11741e+04_r8 /) + kbo(:, 3,36,15) = (/ & + & 0.10902e+04_r8,0.77130e+03_r8,0.59998e+03_r8,0.88588e+03_r8,0.11705e+04_r8 /) + kbo(:, 4,36,15) = (/ & + & 0.98172e+03_r8,0.79246e+03_r8,0.59876e+03_r8,0.89371e+03_r8,0.11495e+04_r8 /) + kbo(:, 5,36,15) = (/ & + & 0.10409e+04_r8,0.75260e+03_r8,0.59632e+03_r8,0.88055e+03_r8,0.11660e+04_r8 /) + kbo(:, 1,37,15) = (/ & + & 0.10398e+04_r8,0.81024e+03_r8,0.60310e+03_r8,0.88960e+03_r8,0.11767e+04_r8 /) + kbo(:, 2,37,15) = (/ & + & 0.94253e+03_r8,0.72207e+03_r8,0.60199e+03_r8,0.88792e+03_r8,0.11745e+04_r8 /) + kbo(:, 3,37,15) = (/ & + & 0.11326e+04_r8,0.78984e+03_r8,0.60024e+03_r8,0.88532e+03_r8,0.11710e+04_r8 /) + kbo(:, 4,37,15) = (/ & + & 0.10789e+04_r8,0.84320e+03_r8,0.59634e+03_r8,0.88350e+03_r8,0.11688e+04_r8 /) + kbo(:, 5,37,15) = (/ & + & 0.10084e+04_r8,0.82623e+03_r8,0.59647e+03_r8,0.88078e+03_r8,0.11651e+04_r8 /) + kbo(:, 1,38,15) = (/ & + & 0.99835e+03_r8,0.77031e+03_r8,0.60321e+03_r8,0.88977e+03_r8,0.11782e+04_r8 /) + kbo(:, 2,38,15) = (/ & + & 0.11135e+04_r8,0.73046e+03_r8,0.60283e+03_r8,0.88917e+03_r8,0.11749e+04_r8 /) + kbo(:, 3,38,15) = (/ & + & 0.10419e+04_r8,0.72620e+03_r8,0.59987e+03_r8,0.88669e+03_r8,0.11716e+04_r8 /) + kbo(:, 4,38,15) = (/ & + & 0.10631e+04_r8,0.75245e+03_r8,0.59721e+03_r8,0.88572e+03_r8,0.11692e+04_r8 /) + kbo(:, 5,38,15) = (/ & + & 0.10228e+04_r8,0.73209e+03_r8,0.59792e+03_r8,0.88102e+03_r8,0.11654e+04_r8 /) + kbo(:, 1,39,15) = (/ & + & 0.10910e+04_r8,0.86853e+03_r8,0.60266e+03_r8,0.88992e+03_r8,0.11772e+04_r8 /) + kbo(:, 2,39,15) = (/ & + & 0.10519e+04_r8,0.73802e+03_r8,0.60236e+03_r8,0.88944e+03_r8,0.11753e+04_r8 /) + kbo(:, 3,39,15) = (/ & + & 0.90206e+03_r8,0.82442e+03_r8,0.60079e+03_r8,0.88708e+03_r8,0.11721e+04_r8 /) + kbo(:, 4,39,15) = (/ & + & 0.10954e+04_r8,0.83033e+03_r8,0.59811e+03_r8,0.88319e+03_r8,0.11696e+04_r8 /) + kbo(:, 5,39,15) = (/ & + & 0.92773e+03_r8,0.79134e+03_r8,0.59808e+03_r8,0.88316e+03_r8,0.11657e+04_r8 /) + kbo(:, 1,40,15) = (/ & + & 0.10887e+04_r8,0.78119e+03_r8,0.60281e+03_r8,0.89016e+03_r8,0.11775e+04_r8 /) + kbo(:, 2,40,15) = (/ & + & 0.10361e+04_r8,0.78964e+03_r8,0.60199e+03_r8,0.88890e+03_r8,0.11758e+04_r8 /) + kbo(:, 3,40,15) = (/ & + & 0.10674e+04_r8,0.81250e+03_r8,0.60058e+03_r8,0.88678e+03_r8,0.11730e+04_r8 /) + kbo(:, 4,40,15) = (/ & + & 0.11076e+04_r8,0.76250e+03_r8,0.59989e+03_r8,0.88480e+03_r8,0.11679e+04_r8 /) + kbo(:, 5,40,15) = (/ & + & 0.11154e+04_r8,0.83280e+03_r8,0.59900e+03_r8,0.88168e+03_r8,0.11814e+04_r8 /) + kbo(:, 1,41,15) = (/ & + & 0.10350e+04_r8,0.79893e+03_r8,0.60296e+03_r8,0.89038e+03_r8,0.11778e+04_r8 /) + kbo(:, 2,41,15) = (/ & + & 0.10104e+04_r8,0.69640e+03_r8,0.60225e+03_r8,0.88929e+03_r8,0.11763e+04_r8 /) + kbo(:, 3,41,15) = (/ & + & 0.10193e+04_r8,0.78110e+03_r8,0.60100e+03_r8,0.88741e+03_r8,0.11751e+04_r8 /) + kbo(:, 4,41,15) = (/ & + & 0.10785e+04_r8,0.73450e+03_r8,0.59977e+03_r8,0.88368e+03_r8,0.11701e+04_r8 /) + kbo(:, 5,41,15) = (/ & + & 0.96003e+03_r8,0.80480e+03_r8,0.59865e+03_r8,0.90400e+03_r8,0.11833e+04_r8 /) + kbo(:, 1,42,15) = (/ & + & 0.97569e+03_r8,0.77685e+03_r8,0.60307e+03_r8,0.89056e+03_r8,0.11793e+04_r8 /) + kbo(:, 2,42,15) = (/ & + & 0.98796e+03_r8,0.83953e+03_r8,0.60247e+03_r8,0.88963e+03_r8,0.11768e+04_r8 /) + kbo(:, 3,42,15) = (/ & + & 0.10852e+04_r8,0.82427e+03_r8,0.60332e+03_r8,0.88798e+03_r8,0.11746e+04_r8 /) + kbo(:, 4,42,15) = (/ & + & 0.10360e+04_r8,0.83188e+03_r8,0.59965e+03_r8,0.88636e+03_r8,0.11712e+04_r8 /) + kbo(:, 5,42,15) = (/ & + & 0.10125e+04_r8,0.74885e+03_r8,0.59702e+03_r8,0.88356e+03_r8,0.11676e+04_r8 /) + kbo(:, 1,43,15) = (/ & + & 0.91082e+03_r8,0.72514e+03_r8,0.60320e+03_r8,0.89075e+03_r8,0.11796e+04_r8 /) + kbo(:, 2,43,15) = (/ & + & 0.82029e+03_r8,0.80137e+03_r8,0.60335e+03_r8,0.88998e+03_r8,0.11773e+04_r8 /) + kbo(:, 3,43,15) = (/ & + & 0.11298e+04_r8,0.78950e+03_r8,0.60243e+03_r8,0.88859e+03_r8,0.11754e+04_r8 /) + kbo(:, 4,43,15) = (/ & + & 0.10717e+04_r8,0.65904e+03_r8,0.60090e+03_r8,0.88726e+03_r8,0.11724e+04_r8 /) + kbo(:, 5,43,15) = (/ & + & 0.89290e+03_r8,0.78779e+03_r8,0.59823e+03_r8,0.88240e+03_r8,0.11774e+04_r8 /) + kbo(:, 1,44,15) = (/ & + & 0.10292e+04_r8,0.72935e+03_r8,0.60266e+03_r8,0.89093e+03_r8,0.11785e+04_r8 /) + kbo(:, 2,44,15) = (/ & + & 0.10616e+04_r8,0.76323e+03_r8,0.60355e+03_r8,0.89030e+03_r8,0.11790e+04_r8 /) + kbo(:, 3,44,15) = (/ & + & 0.10058e+04_r8,0.82082e+03_r8,0.60215e+03_r8,0.88915e+03_r8,0.11762e+04_r8 /) + kbo(:, 4,44,15) = (/ & + & 0.96216e+03_r8,0.76914e+03_r8,0.60084e+03_r8,0.88814e+03_r8,0.11735e+04_r8 /) + kbo(:, 5,44,15) = (/ & + & 0.10069e+04_r8,0.76998e+03_r8,0.59893e+03_r8,0.88624e+03_r8,0.11672e+04_r8 /) + kbo(:, 1,45,15) = (/ & + & 0.92082e+03_r8,0.79879e+03_r8,0.60350e+03_r8,0.89110e+03_r8,0.11788e+04_r8 /) + kbo(:, 2,45,15) = (/ & + & 0.96551e+03_r8,0.79963e+03_r8,0.60307e+03_r8,0.89055e+03_r8,0.11780e+04_r8 /) + kbo(:, 3,45,15) = (/ & + & 0.10337e+04_r8,0.76320e+03_r8,0.60246e+03_r8,0.88962e+03_r8,0.11768e+04_r8 /) + kbo(:, 4,45,15) = (/ & + & 0.97219e+03_r8,0.72677e+03_r8,0.60201e+03_r8,0.88795e+03_r8,0.11746e+04_r8 /) + kbo(:, 5,45,15) = (/ & + & 0.10146e+04_r8,0.80892e+03_r8,0.59962e+03_r8,0.88632e+03_r8,0.11711e+04_r8 /) + kbo(:, 1,46,15) = (/ & + & 0.10772e+04_r8,0.81655e+03_r8,0.60383e+03_r8,0.89135e+03_r8,0.11792e+04_r8 /) + kbo(:, 2,46,15) = (/ & + & 0.98671e+03_r8,0.73523e+03_r8,0.60321e+03_r8,0.89077e+03_r8,0.11796e+04_r8 /) + kbo(:, 3,46,15) = (/ & + & 0.10348e+04_r8,0.84026e+03_r8,0.60272e+03_r8,0.89002e+03_r8,0.11773e+04_r8 /) + kbo(:, 4,46,15) = (/ & + & 0.11018e+04_r8,0.66661e+03_r8,0.60312e+03_r8,0.88865e+03_r8,0.11755e+04_r8 /) + kbo(:, 5,46,15) = (/ & + & 0.10012e+04_r8,0.71404e+03_r8,0.60161e+03_r8,0.88639e+03_r8,0.11725e+04_r8 /) + kbo(:, 1,47,15) = (/ & + & 0.10560e+04_r8,0.78520e+03_r8,0.60429e+03_r8,0.89072e+03_r8,0.11796e+04_r8 /) + kbo(:, 2,47,15) = (/ & + & 0.10627e+04_r8,0.82754e+03_r8,0.60335e+03_r8,0.89097e+03_r8,0.11773e+04_r8 /) + kbo(:, 3,47,15) = (/ & + & 0.10705e+04_r8,0.76570e+03_r8,0.60295e+03_r8,0.89038e+03_r8,0.11791e+04_r8 /) + kbo(:, 4,47,15) = (/ & + & 0.11051e+04_r8,0.83346e+03_r8,0.60225e+03_r8,0.89026e+03_r8,0.11789e+04_r8 /) + kbo(:, 5,47,15) = (/ & + & 0.10627e+04_r8,0.79957e+03_r8,0.60100e+03_r8,0.88742e+03_r8,0.11738e+04_r8 /) + kbo(:, 1,48,15) = (/ & + & 0.10526e+04_r8,0.83431e+03_r8,0.60478e+03_r8,0.89205e+03_r8,0.11801e+04_r8 /) + kbo(:, 2,48,15) = (/ & + & 0.11375e+04_r8,0.74537e+03_r8,0.60363e+03_r8,0.89121e+03_r8,0.11790e+04_r8 /) + kbo(:, 3,48,15) = (/ & + & 0.10571e+04_r8,0.77077e+03_r8,0.60313e+03_r8,0.89066e+03_r8,0.11782e+04_r8 /) + kbo(:, 4,48,15) = (/ & + & 0.10694e+04_r8,0.73604e+03_r8,0.60258e+03_r8,0.88981e+03_r8,0.11770e+04_r8 /) + kbo(:, 5,48,15) = (/ & + & 0.11062e+04_r8,0.66828e+03_r8,0.60158e+03_r8,0.88925e+03_r8,0.11750e+04_r8 /) + kbo(:, 1,49,15) = (/ & + & 0.10727e+04_r8,0.73859e+03_r8,0.60462e+03_r8,0.89249e+03_r8,0.11807e+04_r8 /) + kbo(:, 2,49,15) = (/ & + & 0.11006e+04_r8,0.84446e+03_r8,0.60404e+03_r8,0.89152e+03_r8,0.11794e+04_r8 /) + kbo(:, 3,49,15) = (/ & + & 0.96096e+03_r8,0.73858e+03_r8,0.60393e+03_r8,0.89088e+03_r8,0.11785e+04_r8 /) + kbo(:, 4,49,15) = (/ & + & 0.11140e+04_r8,0.80464e+03_r8,0.60285e+03_r8,0.89021e+03_r8,0.11776e+04_r8 /) + kbo(:, 5,49,15) = (/ & + & 0.10928e+04_r8,0.75297e+03_r8,0.60205e+03_r8,0.88996e+03_r8,0.11760e+04_r8 /) + kbo(:, 1,50,15) = (/ & + & 0.10626e+04_r8,0.84953e+03_r8,0.60572e+03_r8,0.89295e+03_r8,0.11814e+04_r8 /) + kbo(:, 2,50,15) = (/ & + & 0.11017e+04_r8,0.71824e+03_r8,0.60451e+03_r8,0.89185e+03_r8,0.11811e+04_r8 /) + kbo(:, 3,50,15) = (/ & + & 0.10336e+04_r8,0.71570e+03_r8,0.60345e+03_r8,0.89107e+03_r8,0.11800e+04_r8 /) + kbo(:, 4,50,15) = (/ & + & 0.95200e+03_r8,0.76482e+03_r8,0.60304e+03_r8,0.89051e+03_r8,0.11793e+04_r8 /) + kbo(:, 5,50,15) = (/ & + & 0.96988e+03_r8,0.83512e+03_r8,0.60306e+03_r8,0.88954e+03_r8,0.11767e+04_r8 /) + kbo(:, 1,51,15) = (/ & + & 0.11017e+04_r8,0.77329e+03_r8,0.60615e+03_r8,0.89371e+03_r8,0.11825e+04_r8 /) + kbo(:, 2,51,15) = (/ & + & 0.10950e+04_r8,0.81479e+03_r8,0.60496e+03_r8,0.89123e+03_r8,0.11790e+04_r8 /) + kbo(:, 3,51,15) = (/ & + & 0.99893e+03_r8,0.69452e+03_r8,0.60377e+03_r8,0.89131e+03_r8,0.11791e+04_r8 /) + kbo(:, 4,51,15) = (/ & + & 0.10704e+04_r8,0.82834e+03_r8,0.60319e+03_r8,0.89074e+03_r8,0.11783e+04_r8 /) + kbo(:, 5,51,15) = (/ & + & 0.10391e+04_r8,0.80716e+03_r8,0.60333e+03_r8,0.89092e+03_r8,0.11772e+04_r8 /) + kbo(:, 1,52,15) = (/ & + & 0.10358e+04_r8,0.83681e+03_r8,0.60593e+03_r8,0.89390e+03_r8,0.11828e+04_r8 /) + kbo(:, 2,52,15) = (/ & + & 0.95423e+03_r8,0.78599e+03_r8,0.60540e+03_r8,0.89262e+03_r8,0.11809e+04_r8 /) + kbo(:, 3,52,15) = (/ & + & 0.98439e+03_r8,0.83257e+03_r8,0.60417e+03_r8,0.89064e+03_r8,0.11795e+04_r8 /) + kbo(:, 4,52,15) = (/ & + & 0.10548e+04_r8,0.77074e+03_r8,0.60331e+03_r8,0.89093e+03_r8,0.11786e+04_r8 /) + kbo(:, 5,52,15) = (/ & + & 0.10358e+04_r8,0.81478e+03_r8,0.60291e+03_r8,0.89030e+03_r8,0.11777e+04_r8 /) + kbo(:, 1,53,15) = (/ & + & 0.96204e+03_r8,0.74448e+03_r8,0.60716e+03_r8,0.89629e+03_r8,0.11860e+04_r8 /) + kbo(:, 2,53,15) = (/ & + & 0.10872e+04_r8,0.75126e+03_r8,0.60583e+03_r8,0.89310e+03_r8,0.11816e+04_r8 /) + kbo(:, 3,53,15) = (/ & + & 0.90617e+03_r8,0.75210e+03_r8,0.60463e+03_r8,0.89194e+03_r8,0.11800e+04_r8 /) + kbo(:, 4,53,15) = (/ & + & 0.97991e+03_r8,0.76565e+03_r8,0.60352e+03_r8,0.89113e+03_r8,0.11788e+04_r8 /) + kbo(:, 5,53,15) = (/ & + & 0.10425e+04_r8,0.76988e+03_r8,0.60308e+03_r8,0.89058e+03_r8,0.11793e+04_r8 /) + kbo(:, 1,54,15) = (/ & + & 0.10112e+04_r8,0.55645e+03_r8,0.60785e+03_r8,0.89766e+03_r8,0.11878e+04_r8 /) + kbo(:, 2,54,15) = (/ & + & 0.10637e+04_r8,0.66232e+03_r8,0.60623e+03_r8,0.89389e+03_r8,0.11827e+04_r8 /) + kbo(:, 3,54,15) = (/ & + & 0.88717e+03_r8,0.63014e+03_r8,0.60503e+03_r8,0.89226e+03_r8,0.11804e+04_r8 /) + kbo(:, 4,54,15) = (/ & + & 0.10369e+04_r8,0.84103e+03_r8,0.60384e+03_r8,0.89232e+03_r8,0.11792e+04_r8 /) + kbo(:, 5,54,15) = (/ & + & 0.10000e+04_r8,0.70043e+03_r8,0.60321e+03_r8,0.89174e+03_r8,0.11783e+04_r8 /) + kbo(:, 1,55,15) = (/ & + & 0.10615e+04_r8,0.77920e+03_r8,0.60858e+03_r8,0.89903e+03_r8,0.11896e+04_r8 /) + kbo(:, 2,55,15) = (/ & + & 0.10425e+04_r8,0.78513e+03_r8,0.60661e+03_r8,0.89494e+03_r8,0.11829e+04_r8 /) + kbo(:, 3,55,15) = (/ & + & 0.10916e+04_r8,0.73854e+03_r8,0.60542e+03_r8,0.89361e+03_r8,0.11809e+04_r8 /) + kbo(:, 4,55,15) = (/ & + & 0.10715e+04_r8,0.78936e+03_r8,0.60420e+03_r8,0.89162e+03_r8,0.11795e+04_r8 /) + kbo(:, 5,55,15) = (/ & + & 0.96091e+03_r8,0.82578e+03_r8,0.60397e+03_r8,0.89094e+03_r8,0.11773e+04_r8 /) + kbo(:, 1,56,15) = (/ & + & 0.10458e+04_r8,0.77242e+03_r8,0.60942e+03_r8,0.90044e+03_r8,0.11915e+04_r8 /) + kbo(:, 2,56,15) = (/ & + & 0.11062e+04_r8,0.77581e+03_r8,0.60712e+03_r8,0.89619e+03_r8,0.11859e+04_r8 /) + kbo(:, 3,56,15) = (/ & + & 0.10883e+04_r8,0.80121e+03_r8,0.60580e+03_r8,0.89306e+03_r8,0.11815e+04_r8 /) + kbo(:, 4,56,15) = (/ & + & 0.10726e+04_r8,0.82069e+03_r8,0.60459e+03_r8,0.89192e+03_r8,0.11799e+04_r8 /) + kbo(:, 5,56,15) = (/ & + & 0.11263e+04_r8,0.78597e+03_r8,0.60416e+03_r8,0.89111e+03_r8,0.11788e+04_r8 /) + kbo(:, 1,57,15) = (/ & + & 0.11095e+04_r8,0.76988e+03_r8,0.61034e+03_r8,0.90190e+03_r8,0.11935e+04_r8 /) + kbo(:, 2,57,15) = (/ & + & 0.97543e+03_r8,0.72583e+03_r8,0.60777e+03_r8,0.89749e+03_r8,0.11876e+04_r8 /) + kbo(:, 3,57,15) = (/ & + & 0.98548e+03_r8,0.78597e+03_r8,0.60618e+03_r8,0.89378e+03_r8,0.11826e+04_r8 /) + kbo(:, 4,57,15) = (/ & + & 0.98213e+03_r8,0.81053e+03_r8,0.60499e+03_r8,0.89222e+03_r8,0.11804e+04_r8 /) + kbo(:, 5,57,15) = (/ & + & 0.10760e+04_r8,0.81137e+03_r8,0.60380e+03_r8,0.89133e+03_r8,0.11791e+04_r8 /) + kbo(:, 1,58,15) = (/ & + & 0.10034e+04_r8,0.71059e+03_r8,0.61128e+03_r8,0.90333e+03_r8,0.11954e+04_r8 /) + kbo(:, 2,58,15) = (/ & + & 0.97431e+03_r8,0.80290e+03_r8,0.60845e+03_r8,0.89878e+03_r8,0.11893e+04_r8 /) + kbo(:, 3,58,15) = (/ & + & 0.95308e+03_r8,0.77157e+03_r8,0.60654e+03_r8,0.89474e+03_r8,0.11839e+04_r8 /) + kbo(:, 4,58,15) = (/ & + & 0.10737e+04_r8,0.87404e+03_r8,0.60535e+03_r8,0.89257e+03_r8,0.11808e+04_r8 /) + kbo(:, 5,58,15) = (/ & + & 0.10626e+04_r8,0.67671e+03_r8,0.60413e+03_r8,0.89157e+03_r8,0.11782e+04_r8 /) + kbo(:, 1,59,15) = (/ & + & 0.98325e+03_r8,0.78258e+03_r8,0.61167e+03_r8,0.90392e+03_r8,0.11962e+04_r8 /) + kbo(:, 2,59,15) = (/ & + & 0.10481e+04_r8,0.74785e+03_r8,0.60874e+03_r8,0.89931e+03_r8,0.11900e+04_r8 /) + kbo(:, 3,59,15) = (/ & + & 0.11151e+04_r8,0.73006e+03_r8,0.60669e+03_r8,0.89518e+03_r8,0.11820e+04_r8 /) + kbo(:, 4,59,15) = (/ & + & 0.10425e+04_r8,0.79358e+03_r8,0.60550e+03_r8,0.89369e+03_r8,0.11810e+04_r8 /) + kbo(:, 5,59,15) = (/ & + & 0.97877e+03_r8,0.79866e+03_r8,0.60428e+03_r8,0.89168e+03_r8,0.11796e+04_r8 /) + kbo(:, 1,13,16) = (/ & + & 0.75523e+03_r8,0.86786e+03_r8,0.60838e+03_r8,0.89385e+03_r8,0.11815e+04_r8 /) + kbo(:, 2,13,16) = (/ & + & 0.10580e+03_r8,0.52074e+03_r8,0.60685e+03_r8,0.89272e+03_r8,0.11800e+04_r8 /) + kbo(:, 3,13,16) = (/ & + & 0.88450e+03_r8,0.99478e+02_r8,0.60069e+03_r8,0.89217e+03_r8,0.11793e+04_r8 /) + kbo(:, 4,13,16) = (/ & + & 0.47883e+03_r8,0.85714e+02_r8,0.60445e+03_r8,0.89133e+03_r8,0.11782e+04_r8 /) + kbo(:, 5,13,16) = (/ & + & 0.30313e+03_r8,0.39357e+02_r8,0.60363e+03_r8,0.89015e+03_r8,0.11767e+04_r8 /) + kbo(:, 1,14,16) = (/ & + & 0.59250e+03_r8,0.12538e+03_r8,0.60779e+03_r8,0.89359e+03_r8,0.11813e+04_r8 /) + kbo(:, 2,14,16) = (/ & + & 0.45021e+03_r8,0.30819e+03_r8,0.60630e+03_r8,0.89255e+03_r8,0.11799e+04_r8 /) + kbo(:, 3,14,16) = (/ & + & 0.38746e+03_r8,0.31955e+03_r8,0.60482e+03_r8,0.89198e+03_r8,0.11792e+04_r8 /) + kbo(:, 4,14,16) = (/ & + & 0.59123e+03_r8,0.24014e+03_r8,0.60415e+03_r8,0.89112e+03_r8,0.11781e+04_r8 /) + kbo(:, 5,14,16) = (/ & + & 0.47780e+03_r8,0.41362e+03_r8,0.60332e+03_r8,0.88306e+03_r8,0.11765e+04_r8 /) + kbo(:, 1,15,16) = (/ & + & 0.10202e+04_r8,0.29221e+03_r8,0.60727e+03_r8,0.88647e+03_r8,0.11812e+04_r8 /) + kbo(:, 2,15,16) = (/ & + & 0.55435e+03_r8,0.58788e+03_r8,0.60581e+03_r8,0.89239e+03_r8,0.11799e+04_r8 /) + kbo(:, 3,15,16) = (/ & + & 0.31413e+03_r8,0.75889e+03_r8,0.60450e+03_r8,0.89181e+03_r8,0.11791e+04_r8 /) + kbo(:, 4,15,16) = (/ & + & 0.41436e+03_r8,0.80717e+03_r8,0.60389e+03_r8,0.89092e+03_r8,0.11689e+04_r8 /) + kbo(:, 5,15,16) = (/ & + & 0.84269e+03_r8,0.27451e+03_r8,0.60303e+03_r8,0.88966e+03_r8,0.11582e+04_r8 /) + kbo(:, 1,16,16) = (/ & + & 0.19456e+03_r8,0.24351e+03_r8,0.60682e+03_r8,0.89311e+03_r8,0.11719e+04_r8 /) + kbo(:, 2,16,16) = (/ & + & 0.43800e+03_r8,0.21696e+03_r8,0.60538e+03_r8,0.89225e+03_r8,0.11798e+04_r8 /) + kbo(:, 3,16,16) = (/ & + & 0.73851e+03_r8,0.22888e+03_r8,0.60428e+03_r8,0.89164e+03_r8,0.11790e+04_r8 /) + kbo(:, 4,16,16) = (/ & + & 0.83650e+03_r8,0.13309e+03_r8,0.60366e+03_r8,0.89073e+03_r8,0.11778e+04_r8 /) + kbo(:, 5,16,16) = (/ & + & 0.65895e+03_r8,0.36022e+03_r8,0.59813e+03_r8,0.88942e+03_r8,0.11670e+04_r8 /) + kbo(:, 1,17,16) = (/ & + & 0.97890e+03_r8,0.27257e+03_r8,0.60643e+03_r8,0.89290e+03_r8,0.11808e+04_r8 /) + kbo(:, 2,17,16) = (/ & + & 0.21678e+03_r8,0.36639e+03_r8,0.60501e+03_r8,0.89213e+03_r8,0.11797e+04_r8 /) + kbo(:, 3,17,16) = (/ & + & 0.36576e+03_r8,0.64243e+03_r8,0.60409e+03_r8,0.89150e+03_r8,0.11789e+04_r8 /) + kbo(:, 4,17,16) = (/ & + & 0.71301e+03_r8,0.32666e+03_r8,0.60345e+03_r8,0.89056e+03_r8,0.11777e+04_r8 /) + kbo(:, 5,17,16) = (/ & + & 0.30605e+03_r8,0.68315e+03_r8,0.59789e+03_r8,0.88918e+03_r8,0.11668e+04_r8 /) + kbo(:, 1,18,16) = (/ & + & 0.52238e+03_r8,0.17591e+03_r8,0.60609e+03_r8,0.89271e+03_r8,0.11807e+04_r8 /) + kbo(:, 2,18,16) = (/ & + & 0.10253e+04_r8,0.75807e+03_r8,0.60468e+03_r8,0.89202e+03_r8,0.11797e+04_r8 /) + kbo(:, 3,18,16) = (/ & + & 0.23095e+03_r8,0.31874e+03_r8,0.60392e+03_r8,0.89136e+03_r8,0.11788e+04_r8 /) + kbo(:, 4,18,16) = (/ & + & 0.55144e+03_r8,0.80452e+03_r8,0.59863e+03_r8,0.89039e+03_r8,0.11685e+04_r8 /) + kbo(:, 5,18,16) = (/ & + & 0.36145e+03_r8,0.21165e+03_r8,0.60231e+03_r8,0.88211e+03_r8,0.11666e+04_r8 /) + kbo(:, 1,19,16) = (/ & + & 0.10124e+04_r8,0.51143e+03_r8,0.60113e+03_r8,0.89253e+03_r8,0.11805e+04_r8 /) + kbo(:, 2,19,16) = (/ & + & 0.54199e+03_r8,0.26758e+03_r8,0.60439e+03_r8,0.89192e+03_r8,0.11796e+04_r8 /) + kbo(:, 3,19,16) = (/ & + & 0.61467e+03_r8,0.78253e+03_r8,0.59913e+03_r8,0.89123e+03_r8,0.11787e+04_r8 /) + kbo(:, 4,19,16) = (/ & + & 0.58906e+03_r8,0.74398e+02_r8,0.60311e+03_r8,0.89023e+03_r8,0.11774e+04_r8 /) + kbo(:, 5,19,16) = (/ & + & 0.98025e+03_r8,0.28476e+03_r8,0.59747e+03_r8,0.88189e+03_r8,0.11663e+04_r8 /) + kbo(:, 1,20,16) = (/ & + & 0.25361e+03_r8,0.16739e+03_r8,0.60550e+03_r8,0.89234e+03_r8,0.11712e+04_r8 /) + kbo(:, 2,20,16) = (/ & + & 0.70227e+03_r8,0.71784e+03_r8,0.59948e+03_r8,0.89182e+03_r8,0.11795e+04_r8 /) + kbo(:, 3,20,16) = (/ & + & 0.89681e+03_r8,0.24714e+03_r8,0.60364e+03_r8,0.89109e+03_r8,0.11786e+04_r8 /) + kbo(:, 4,20,16) = (/ & + & 0.30123e+03_r8,0.54911e+03_r8,0.60295e+03_r8,0.89006e+03_r8,0.11772e+04_r8 /) + kbo(:, 5,20,16) = (/ & + & 0.68301e+03_r8,0.36973e+03_r8,0.59725e+03_r8,0.88846e+03_r8,0.11750e+04_r8 /) + kbo(:, 1,21,16) = (/ & + & 0.25236e+03_r8,0.80202e+03_r8,0.60523e+03_r8,0.89218e+03_r8,0.11801e+04_r8 /) + kbo(:, 2,21,16) = (/ & + & 0.77221e+03_r8,0.62834e+03_r8,0.60401e+03_r8,0.89171e+03_r8,0.11794e+04_r8 /) + kbo(:, 3,21,16) = (/ & + & 0.70626e+03_r8,0.20918e+03_r8,0.60351e+03_r8,0.89096e+03_r8,0.11784e+04_r8 /) + kbo(:, 4,21,16) = (/ & + & 0.16217e+03_r8,0.14134e+03_r8,0.59816e+03_r8,0.88303e+03_r8,0.11770e+04_r8 /) + kbo(:, 5,21,16) = (/ & + & 0.51843e+03_r8,0.20259e+03_r8,0.59703e+03_r8,0.88818e+03_r8,0.11747e+04_r8 /) + kbo(:, 1,22,16) = (/ & + & 0.21890e+03_r8,0.24577e+03_r8,0.60023e+03_r8,0.89209e+03_r8,0.11799e+04_r8 /) + kbo(:, 2,22,16) = (/ & + & 0.30771e+03_r8,0.55233e+03_r8,0.60388e+03_r8,0.89157e+03_r8,0.11793e+04_r8 /) + kbo(:, 3,22,16) = (/ & + & 0.17796e+03_r8,0.48432e+03_r8,0.60334e+03_r8,0.89076e+03_r8,0.11782e+04_r8 /) + kbo(:, 4,22,16) = (/ & + & 0.88899e+03_r8,0.36751e+03_r8,0.60258e+03_r8,0.88960e+03_r8,0.11676e+04_r8 /) + kbo(:, 5,22,16) = (/ & + & 0.37953e+03_r8,0.56918e+03_r8,0.58746e+03_r8,0.88775e+03_r8,0.11742e+04_r8 /) + kbo(:, 1,23,16) = (/ & + & 0.42018e+03_r8,0.21434e+03_r8,0.60456e+03_r8,0.89198e+03_r8,0.11798e+04_r8 /) + kbo(:, 2,23,16) = (/ & + & 0.10252e+04_r8,0.32427e+03_r8,0.60375e+03_r8,0.89142e+03_r8,0.11791e+04_r8 /) + kbo(:, 3,23,16) = (/ & + & 0.25811e+03_r8,0.61743e+03_r8,0.60318e+03_r8,0.89055e+03_r8,0.11779e+04_r8 /) + kbo(:, 4,23,16) = (/ & + & 0.60449e+03_r8,0.28100e+03_r8,0.60235e+03_r8,0.88930e+03_r8,0.11762e+04_r8 /) + kbo(:, 5,23,16) = (/ & + & 0.43495e+03_r8,0.18925e+03_r8,0.60100e+03_r8,0.88727e+03_r8,0.11735e+04_r8 /) + kbo(:, 1,24,16) = (/ & + & 0.68497e+03_r8,0.77568e+03_r8,0.60423e+03_r8,0.89188e+03_r8,0.11797e+04_r8 /) + kbo(:, 2,24,16) = (/ & + & 0.27378e+03_r8,0.43332e+03_r8,0.60362e+03_r8,0.89125e+03_r8,0.11789e+04_r8 /) + kbo(:, 3,24,16) = (/ & + & 0.44258e+03_r8,0.48182e+03_r8,0.60301e+03_r8,0.89032e+03_r8,0.11686e+04_r8 /) + kbo(:, 4,24,16) = (/ & + & 0.38603e+03_r8,0.34135e+03_r8,0.59747e+03_r8,0.88895e+03_r8,0.11758e+04_r8 /) + kbo(:, 5,24,16) = (/ & + & 0.39386e+03_r8,0.54222e+03_r8,0.60062e+03_r8,0.88674e+03_r8,0.11638e+04_r8 /) + kbo(:, 1,25,16) = (/ & + & 0.55482e+03_r8,0.53022e+03_r8,0.60394e+03_r8,0.89175e+03_r8,0.11796e+04_r8 /) + kbo(:, 2,25,16) = (/ & + & 0.90002e+03_r8,0.91361e+02_r8,0.60348e+03_r8,0.89107e+03_r8,0.11787e+04_r8 /) + kbo(:, 3,25,16) = (/ & + & 0.17670e+03_r8,0.51744e+03_r8,0.59819e+03_r8,0.89007e+03_r8,0.11773e+04_r8 /) + kbo(:, 4,25,16) = (/ & + & 0.44153e+03_r8,0.41376e+03_r8,0.59256e+03_r8,0.88854e+03_r8,0.11753e+04_r8 /) + kbo(:, 5,25,16) = (/ & + & 0.24073e+03_r8,0.21288e+03_r8,0.60020e+03_r8,0.88614e+03_r8,0.11721e+04_r8 /) + kbo(:, 1,26,16) = (/ & + & 0.37725e+03_r8,0.61445e+03_r8,0.60383e+03_r8,0.89161e+03_r8,0.11703e+04_r8 /) + kbo(:, 2,26,16) = (/ & + & 0.10269e+04_r8,0.42565e+03_r8,0.59868e+03_r8,0.89085e+03_r8,0.11784e+04_r8 /) + kbo(:, 3,26,16) = (/ & + & 0.49719e+03_r8,0.26744e+03_r8,0.60261e+03_r8,0.88977e+03_r8,0.11769e+04_r8 /) + kbo(:, 4,26,16) = (/ & + & 0.41684e+03_r8,0.19443e+03_r8,0.59685e+03_r8,0.88123e+03_r8,0.11746e+04_r8 /) + kbo(:, 5,26,16) = (/ & + & 0.32855e+03_r8,0.57095e+03_r8,0.59973e+03_r8,0.88545e+03_r8,0.11622e+04_r8 /) + kbo(:, 1,27,16) = (/ & + & 0.60914e+03_r8,0.57105e+03_r8,0.60371e+03_r8,0.89145e+03_r8,0.11792e+04_r8 /) + kbo(:, 2,27,16) = (/ & + & 0.26439e+03_r8,0.15182e+03_r8,0.60316e+03_r8,0.89062e+03_r8,0.11781e+04_r8 /) + kbo(:, 3,27,16) = (/ & + & 0.73685e+03_r8,0.69813e+03_r8,0.60238e+03_r8,0.88259e+03_r8,0.11765e+04_r8 /) + kbo(:, 4,27,16) = (/ & + & 0.64054e+03_r8,0.28524e+03_r8,0.60110e+03_r8,0.88751e+03_r8,0.11649e+04_r8 /) + kbo(:, 5,27,16) = (/ & + & 0.75244e+03_r8,0.50359e+03_r8,0.59461e+03_r8,0.87791e+03_r8,0.11702e+04_r8 /) + kbo(:, 1,28,16) = (/ & + & 0.64046e+03_r8,0.15170e+03_r8,0.60358e+03_r8,0.89127e+03_r8,0.11790e+04_r8 /) + kbo(:, 2,28,16) = (/ & + & 0.70429e+03_r8,0.23052e+03_r8,0.60299e+03_r8,0.89037e+03_r8,0.11687e+04_r8 /) + kbo(:, 3,28,16) = (/ & + & 0.44006e+03_r8,0.41240e+03_r8,0.60212e+03_r8,0.88904e+03_r8,0.11760e+04_r8 /) + kbo(:, 4,28,16) = (/ & + & 0.22398e+03_r8,0.59419e+03_r8,0.60069e+03_r8,0.88691e+03_r8,0.11731e+04_r8 /) + kbo(:, 5,28,16) = (/ & + & 0.55183e+03_r8,0.13336e+03_r8,0.59871e+03_r8,0.87038e+03_r8,0.11692e+04_r8 /) + kbo(:, 1,29,16) = (/ & + & 0.59987e+03_r8,0.49106e+03_r8,0.60344e+03_r8,0.89107e+03_r8,0.11787e+04_r8 /) + kbo(:, 2,29,16) = (/ & + & 0.34384e+03_r8,0.96976e+02_r8,0.60280e+03_r8,0.89009e+03_r8,0.11774e+04_r8 /) + kbo(:, 3,29,16) = (/ & + & 0.54363e+03_r8,0.20603e+03_r8,0.60181e+03_r8,0.88860e+03_r8,0.11754e+04_r8 /) + kbo(:, 4,29,16) = (/ & + & 0.10391e+04_r8,0.38775e+03_r8,0.60023e+03_r8,0.88623e+03_r8,0.11632e+04_r8 /) + kbo(:, 5,29,16) = (/ & + & 0.22377e+03_r8,0.17567e+03_r8,0.59820e+03_r8,0.88324e+03_r8,0.11684e+04_r8 /) + kbo(:, 1,30,16) = (/ & + & 0.63138e+03_r8,0.68455e+03_r8,0.60329e+03_r8,0.89085e+03_r8,0.11784e+04_r8 /) + kbo(:, 2,30,16) = (/ & + & 0.58332e+03_r8,0.21199e+03_r8,0.60259e+03_r8,0.88978e+03_r8,0.11770e+04_r8 /) + kbo(:, 3,30,16) = (/ & + & 0.33555e+03_r8,0.46024e+03_r8,0.59221e+03_r8,0.88809e+03_r8,0.11657e+04_r8 /) + kbo(:, 4,30,16) = (/ & + & 0.44733e+03_r8,0.32696e+03_r8,0.59512e+03_r8,0.88550e+03_r8,0.11713e+04_r8 /) + kbo(:, 5,30,16) = (/ & + & 0.79071e+03_r8,0.72043e+03_r8,0.59773e+03_r8,0.85548e+03_r8,0.11586e+04_r8 /) + kbo(:, 1,31,16) = (/ & + & 0.81471e+03_r8,0.68414e+03_r8,0.60312e+03_r8,0.89060e+03_r8,0.11781e+04_r8 /) + kbo(:, 2,31,16) = (/ & + & 0.44722e+03_r8,0.73246e+03_r8,0.60235e+03_r8,0.88942e+03_r8,0.11765e+04_r8 /) + kbo(:, 3,31,16) = (/ & + & 0.48709e+03_r8,0.24210e+03_r8,0.60108e+03_r8,0.88068e+03_r8,0.11739e+04_r8 /) + kbo(:, 4,31,16) = (/ & + & 0.63873e+03_r8,0.56888e+03_r8,0.59920e+03_r8,0.88472e+03_r8,0.11702e+04_r8 /) + kbo(:, 5,31,16) = (/ & + & 0.72647e+03_r8,0.26020e+03_r8,0.59739e+03_r8,0.78035e+03_r8,0.11669e+04_r8 /) + kbo(:, 1,32,16) = (/ & + & 0.10219e+04_r8,0.29652e+03_r8,0.60294e+03_r8,0.89034e+03_r8,0.11777e+04_r8 /) + kbo(:, 2,32,16) = (/ & + & 0.75833e+03_r8,0.13311e+03_r8,0.59281e+03_r8,0.88900e+03_r8,0.11759e+04_r8 /) + kbo(:, 3,32,16) = (/ & + & 0.54275e+03_r8,0.31460e+03_r8,0.59602e+03_r8,0.88686e+03_r8,0.11731e+04_r8 /) + kbo(:, 4,32,16) = (/ & + & 0.28731e+03_r8,0.15124e+03_r8,0.59865e+03_r8,0.87712e+03_r8,0.11692e+04_r8 /) + kbo(:, 5,32,16) = (/ & + & 0.79004e+03_r8,0.63514e+03_r8,0.58791e+03_r8,0.86135e+03_r8,0.11214e+04_r8 /) + kbo(:, 1,33,16) = (/ & + & 0.42295e+03_r8,0.52022e+03_r8,0.60275e+03_r8,0.88319e+03_r8,0.11773e+04_r8 /) + kbo(:, 2,33,16) = (/ & + & 0.72614e+03_r8,0.33266e+03_r8,0.60175e+03_r8,0.88169e+03_r8,0.11753e+04_r8 /) + kbo(:, 3,33,16) = (/ & + & 0.36703e+03_r8,0.22982e+03_r8,0.59554e+03_r8,0.88614e+03_r8,0.11721e+04_r8 /) + kbo(:, 4,33,16) = (/ & + & 0.23137e+03_r8,0.32656e+03_r8,0.59813e+03_r8,0.88315e+03_r8,0.11503e+04_r8 /) + kbo(:, 5,33,16) = (/ & + & 0.98125e+03_r8,0.60471e+03_r8,0.59681e+03_r8,0.86770e+03_r8,0.11478e+04_r8 /) + kbo(:, 1,34,16) = (/ & + & 0.44676e+03_r8,0.16327e+03_r8,0.59792e+03_r8,0.88976e+03_r8,0.11770e+04_r8 /) + kbo(:, 2,34,16) = (/ & + & 0.27122e+03_r8,0.52002e+03_r8,0.60144e+03_r8,0.88807e+03_r8,0.11747e+04_r8 /) + kbo(:, 3,34,16) = (/ & + & 0.89338e+03_r8,0.37487e+03_r8,0.59509e+03_r8,0.87866e+03_r8,0.11622e+04_r8 /) + kbo(:, 4,34,16) = (/ & + & 0.43071e+03_r8,0.56832e+03_r8,0.58850e+03_r8,0.83509e+03_r8,0.10958e+04_r8 /) + kbo(:, 5,34,16) = (/ & + & 0.20737e+03_r8,0.35064e+03_r8,0.59655e+03_r8,0.88088e+03_r8,0.11652e+04_r8 /) + kbo(:, 1,35,16) = (/ & + & 0.79758e+02_r8,0.10278e+03_r8,0.60244e+03_r8,0.87589e+03_r8,0.11767e+04_r8 /) + kbo(:, 2,35,16) = (/ & + & 0.52637e+03_r8,0.56826e+03_r8,0.60124e+03_r8,0.88778e+03_r8,0.11743e+04_r8 /) + kbo(:, 3,35,16) = (/ & + & 0.43064e+03_r8,0.29620e+03_r8,0.59943e+03_r8,0.88508e+03_r8,0.11707e+04_r8 /) + kbo(:, 4,35,16) = (/ & + & 0.21531e+03_r8,0.74954e+03_r8,0.57453e+03_r8,0.86197e+03_r8,0.11223e+04_r8 /) + kbo(:, 5,35,16) = (/ & + & 0.85323e+03_r8,0.27200e+03_r8,0.59640e+03_r8,0.88066e+03_r8,0.11649e+04_r8 /) + kbo(:, 1,36,16) = (/ & + & 0.99678e+03_r8,0.21760e+03_r8,0.60242e+03_r8,0.88955e+03_r8,0.11767e+04_r8 /) + kbo(:, 2,36,16) = (/ & + & 0.90902e+03_r8,0.40496e+03_r8,0.59196e+03_r8,0.88090e+03_r8,0.11742e+04_r8 /) + kbo(:, 3,36,16) = (/ & + & 0.38273e+03_r8,0.60439e+03_r8,0.59478e+03_r8,0.87820e+03_r8,0.11706e+04_r8 /) + kbo(:, 4,36,16) = (/ & + & 0.84516e+03_r8,0.25383e+03_r8,0.58829e+03_r8,0.79406e+03_r8,0.11312e+04_r8 /) + kbo(:, 5,36,16) = (/ & + & 0.45445e+03_r8,0.41700e+03_r8,0.59637e+03_r8,0.88062e+03_r8,0.11559e+04_r8 /) + kbo(:, 1,37,16) = (/ & + & 0.62987e+03_r8,0.44723e+03_r8,0.59790e+03_r8,0.88973e+03_r8,0.11769e+04_r8 /) + kbo(:, 2,37,16) = (/ & + & 0.80524e+03_r8,0.68894e+03_r8,0.59677e+03_r8,0.88802e+03_r8,0.11746e+04_r8 /) + kbo(:, 3,37,16) = (/ & + & 0.18337e+03_r8,0.45323e+03_r8,0.59504e+03_r8,0.88541e+03_r8,0.11712e+04_r8 /) + kbo(:, 4,37,16) = (/ & + & 0.50224e+03_r8,0.16920e+03_r8,0.59765e+03_r8,0.86220e+03_r8,0.11586e+04_r8 /) + kbo(:, 5,37,16) = (/ & + & 0.85299e+03_r8,0.22358e+03_r8,0.59652e+03_r8,0.88084e+03_r8,0.11652e+04_r8 /) + kbo(:, 1,38,16) = (/ & + & 0.91678e+03_r8,0.47738e+03_r8,0.59801e+03_r8,0.88990e+03_r8,0.11681e+04_r8 /) + kbo(:, 2,38,16) = (/ & + & 0.47033e+03_r8,0.39881e+03_r8,0.59234e+03_r8,0.88147e+03_r8,0.11750e+04_r8 /) + kbo(:, 3,38,16) = (/ & + & 0.69352e+03_r8,0.66467e+03_r8,0.59993e+03_r8,0.87901e+03_r8,0.11717e+04_r8 /) + kbo(:, 4,38,16) = (/ & + & 0.48625e+03_r8,0.32628e+03_r8,0.59330e+03_r8,0.86251e+03_r8,0.11590e+04_r8 /) + kbo(:, 5,38,16) = (/ & + & 0.31087e+03_r8,0.44108e+03_r8,0.58749e+03_r8,0.88107e+03_r8,0.11655e+04_r8 /) + kbo(:, 1,39,16) = (/ & + & 0.35870e+03_r8,0.11480e+03_r8,0.60275e+03_r8,0.89007e+03_r8,0.11774e+04_r8 /) + kbo(:, 2,39,16) = (/ & + & 0.37464e+03_r8,0.78547e+03_r8,0.59714e+03_r8,0.88174e+03_r8,0.11754e+04_r8 /) + kbo(:, 3,39,16) = (/ & + & 0.10123e+04_r8,0.30814e+03_r8,0.59558e+03_r8,0.87940e+03_r8,0.11722e+04_r8 /) + kbo(:, 4,39,16) = (/ & + & 0.17535e+03_r8,0.96668e+02_r8,0.59817e+03_r8,0.88323e+03_r8,0.11594e+04_r8 /) + kbo(:, 5,39,16) = (/ & + & 0.36664e+03_r8,0.56187e+03_r8,0.58764e+03_r8,0.86774e+03_r8,0.11658e+04_r8 /) + kbo(:, 1,40,16) = (/ & + & 0.48620e+03_r8,0.57396e+03_r8,0.60293e+03_r8,0.89033e+03_r8,0.11777e+04_r8 /) + kbo(:, 2,40,16) = (/ & + & 0.94847e+03_r8,0.62832e+03_r8,0.60206e+03_r8,0.88901e+03_r8,0.11760e+04_r8 /) + kbo(:, 3,40,16) = (/ & + & 0.54197e+03_r8,0.51352e+03_r8,0.60063e+03_r8,0.88687e+03_r8,0.11731e+04_r8 /) + kbo(:, 4,40,16) = (/ & + & 0.21519e+03_r8,0.61017e+03_r8,0.58944e+03_r8,0.86354e+03_r8,0.11692e+04_r8 /) + kbo(:, 5,40,16) = (/ & + & 0.27098e+03_r8,0.33831e+03_r8,0.58331e+03_r8,0.88170e+03_r8,0.10587e+04_r8 /) + kbo(:, 1,41,16) = (/ & + & 0.14346e+03_r8,0.26582e+03_r8,0.60309e+03_r8,0.89059e+03_r8,0.11781e+04_r8 /) + kbo(:, 2,41,16) = (/ & + & 0.76510e+03_r8,0.70682e+03_r8,0.60232e+03_r8,0.88941e+03_r8,0.11765e+04_r8 /) + kbo(:, 3,41,16) = (/ & + & 0.62163e+03_r8,0.16311e+03_r8,0.60105e+03_r8,0.88750e+03_r8,0.11649e+04_r8 /) + kbo(:, 4,41,16) = (/ & + & 0.87665e+02_r8,0.19331e+03_r8,0.59457e+03_r8,0.88472e+03_r8,0.11703e+04_r8 /) + kbo(:, 5,41,16) = (/ & + & 0.10041e+04_r8,0.44098e+03_r8,0.58818e+03_r8,0.72606e+03_r8,0.10412e+04_r8 /) + kbo(:, 1,42,16) = (/ & + & 0.66944e+03_r8,0.41079e+03_r8,0.60325e+03_r8,0.89083e+03_r8,0.11693e+04_r8 /) + kbo(:, 2,42,16) = (/ & + & 0.51801e+03_r8,0.25976e+03_r8,0.60255e+03_r8,0.88976e+03_r8,0.11770e+04_r8 /) + kbo(:, 3,42,16) = (/ & + & 0.23111e+03_r8,0.27788e+03_r8,0.58293e+03_r8,0.88808e+03_r8,0.11747e+04_r8 /) + kbo(:, 4,42,16) = (/ & + & 0.44627e+03_r8,0.35036e+03_r8,0.59971e+03_r8,0.87868e+03_r8,0.11713e+04_r8 /) + kbo(:, 5,42,16) = (/ & + & 0.75706e+03_r8,0.77924e+03_r8,0.59310e+03_r8,0.87584e+03_r8,0.11676e+04_r8 /) + kbo(:, 1,43,16) = (/ & + & 0.60566e+03_r8,0.10873e+03_r8,0.60342e+03_r8,0.89110e+03_r8,0.11697e+04_r8 /) + kbo(:, 2,43,16) = (/ & + & 0.92441e+03_r8,0.64634e+03_r8,0.59816e+03_r8,0.89014e+03_r8,0.11775e+04_r8 /) + kbo(:, 3,43,16) = (/ & + & 0.18329e+03_r8,0.35035e+03_r8,0.59722e+03_r8,0.88869e+03_r8,0.11755e+04_r8 /) + kbo(:, 4,43,16) = (/ & + & 0.34266e+03_r8,0.17517e+03_r8,0.59569e+03_r8,0.87957e+03_r8,0.11725e+04_r8 /) + kbo(:, 5,43,16) = (/ & + & 0.92438e+03_r8,0.90606e+02_r8,0.59829e+03_r8,0.88341e+03_r8,0.11057e+04_r8 /) + kbo(:, 1,44,16) = (/ & + & 0.38251e+03_r8,0.19934e+03_r8,0.60359e+03_r8,0.89135e+03_r8,0.11791e+04_r8 /) + kbo(:, 2,44,16) = (/ & + & 0.48609e+03_r8,0.71881e+03_r8,0.59839e+03_r8,0.89050e+03_r8,0.11689e+04_r8 /) + kbo(:, 3,44,16) = (/ & + & 0.54984e+03_r8,0.19933e+03_r8,0.59759e+03_r8,0.88926e+03_r8,0.11763e+04_r8 /) + kbo(:, 4,44,16) = (/ & + & 0.85264e+03_r8,0.64027e+03_r8,0.60090e+03_r8,0.88045e+03_r8,0.11736e+04_r8 /) + kbo(:, 5,44,16) = (/ & + & 0.88451e+03_r8,0.49530e+03_r8,0.59898e+03_r8,0.87082e+03_r8,0.11699e+04_r8 /) + kbo(:, 1,45,16) = (/ & + & 0.66936e+03_r8,0.51946e+03_r8,0.60373e+03_r8,0.89157e+03_r8,0.11794e+04_r8 /) + kbo(:, 2,45,16) = (/ & + & 0.95622e+03_r8,0.66442e+03_r8,0.60324e+03_r8,0.89082e+03_r8,0.11784e+04_r8 /) + kbo(:, 3,45,16) = (/ & + & 0.70122e+03_r8,0.25973e+03_r8,0.60254e+03_r8,0.88974e+03_r8,0.11769e+04_r8 /) + kbo(:, 4,45,16) = (/ & + & 0.13546e+03_r8,0.47717e+03_r8,0.59679e+03_r8,0.88805e+03_r8,0.11747e+04_r8 /) + kbo(:, 5,45,16) = (/ & + & 0.44623e+03_r8,0.47716e+03_r8,0.59968e+03_r8,0.87864e+03_r8,0.11712e+04_r8 /) + kbo(:, 1,46,16) = (/ & + & 0.16734e+03_r8,0.11476e+03_r8,0.60389e+03_r8,0.89176e+03_r8,0.11797e+04_r8 /) + kbo(:, 2,46,16) = (/ & + & 0.41435e+03_r8,0.59796e+03_r8,0.60344e+03_r8,0.89112e+03_r8,0.11697e+04_r8 /) + kbo(:, 3,46,16) = (/ & + & 0.78886e+03_r8,0.13892e+03_r8,0.60282e+03_r8,0.89018e+03_r8,0.11775e+04_r8 /) + kbo(:, 4,46,16) = (/ & + & 0.48606e+03_r8,0.76103e+03_r8,0.59263e+03_r8,0.88876e+03_r8,0.11756e+04_r8 /) + kbo(:, 5,46,16) = (/ & + & 0.77291e+03_r8,0.68855e+03_r8,0.59113e+03_r8,0.88648e+03_r8,0.11726e+04_r8 /) + kbo(:, 1,47,16) = (/ & + & 0.80479e+03_r8,0.70064e+03_r8,0.60443e+03_r8,0.89194e+03_r8,0.11799e+04_r8 /) + kbo(:, 2,47,16) = (/ & + & 0.74901e+03_r8,0.35032e+03_r8,0.60363e+03_r8,0.89142e+03_r8,0.11792e+04_r8 /) + kbo(:, 3,47,16) = (/ & + & 0.62948e+03_r8,0.48923e+03_r8,0.60309e+03_r8,0.89059e+03_r8,0.11690e+04_r8 /) + kbo(:, 4,47,16) = (/ & + & 0.87648e+02_r8,0.36239e+03_r8,0.60232e+03_r8,0.88257e+03_r8,0.11584e+04_r8 /) + kbo(:, 5,47,16) = (/ & + & 0.44621e+03_r8,0.42279e+03_r8,0.60106e+03_r8,0.88751e+03_r8,0.11740e+04_r8 /) + kbo(:, 1,48,16) = (/ & + & 0.39044e+03_r8,0.31407e+03_r8,0.60497e+03_r8,0.89220e+03_r8,0.11803e+04_r8 /) + kbo(:, 2,48,16) = (/ & + & 0.28685e+03_r8,0.50131e+03_r8,0.60379e+03_r8,0.89166e+03_r8,0.11795e+04_r8 /) + kbo(:, 3,48,16) = (/ & + & 0.38246e+03_r8,0.70665e+03_r8,0.60333e+03_r8,0.89096e+03_r8,0.11786e+04_r8 /) + kbo(:, 4,48,16) = (/ & + & 0.47011e+03_r8,0.61002e+03_r8,0.60267e+03_r8,0.88995e+03_r8,0.11772e+04_r8 /) + kbo(:, 5,48,16) = (/ & + & 0.36652e+03_r8,0.63417e+03_r8,0.60164e+03_r8,0.88155e+03_r8,0.11751e+04_r8 /) + kbo(:, 1,49,16) = (/ & + & 0.76492e+03_r8,0.96636e+02_r8,0.60550e+03_r8,0.89270e+03_r8,0.11810e+04_r8 /) + kbo(:, 2,49,16) = (/ & + & 0.23107e+03_r8,0.19931e+03_r8,0.60416e+03_r8,0.89186e+03_r8,0.11798e+04_r8 /) + kbo(:, 3,49,16) = (/ & + & 0.86850e+03_r8,0.30199e+03_r8,0.59890e+03_r8,0.89128e+03_r8,0.11790e+04_r8 /) + kbo(:, 4,49,16) = (/ & + & 0.27091e+03_r8,0.22951e+03_r8,0.60296e+03_r8,0.89040e+03_r8,0.11778e+04_r8 /) + kbo(:, 5,49,16) = (/ & + & 0.45416e+03_r8,0.53149e+03_r8,0.60212e+03_r8,0.88227e+03_r8,0.11761e+04_r8 /) + kbo(:, 1,50,16) = (/ & + & 0.39042e+03_r8,0.12079e+03_r8,0.60601e+03_r8,0.89316e+03_r8,0.11816e+04_r8 /) + kbo(:, 2,50,16) = (/ & + & 0.38245e+03_r8,0.73080e+03_r8,0.60467e+03_r8,0.89201e+03_r8,0.11709e+04_r8 /) + kbo(:, 3,50,16) = (/ & + & 0.19919e+03_r8,0.50733e+03_r8,0.60370e+03_r8,0.89153e+03_r8,0.11703e+04_r8 /) + kbo(:, 4,50,16) = (/ & + & 0.52587e+03_r8,0.41673e+03_r8,0.60320e+03_r8,0.89076e+03_r8,0.11693e+04_r8 /) + kbo(:, 5,50,16) = (/ & + & 0.25497e+03_r8,0.90594e+02_r8,0.59785e+03_r8,0.88966e+03_r8,0.11768e+04_r8 /) + kbo(:, 1,51,16) = (/ & + & 0.35058e+03_r8,0.56772e+03_r8,0.60650e+03_r8,0.89405e+03_r8,0.11830e+04_r8 /) + kbo(:, 2,51,16) = (/ & + & 0.39839e+03_r8,0.52545e+03_r8,0.60516e+03_r8,0.89238e+03_r8,0.11806e+04_r8 /) + kbo(:, 3,51,16) = (/ & + & 0.69319e+03_r8,0.65831e+03_r8,0.60384e+03_r8,0.89174e+03_r8,0.11796e+04_r8 /) + kbo(:, 4,51,16) = (/ & + & 0.66132e+03_r8,0.42881e+03_r8,0.60341e+03_r8,0.89108e+03_r8,0.11788e+04_r8 /) + kbo(:, 5,51,16) = (/ & + & 0.80473e+03_r8,0.49524e+03_r8,0.59814e+03_r8,0.88327e+03_r8,0.11775e+04_r8 /) + kbo(:, 1,52,16) = (/ & + & 0.75693e+03_r8,0.32010e+03_r8,0.60698e+03_r8,0.89551e+03_r8,0.11849e+04_r8 /) + kbo(:, 2,52,16) = (/ & + & 0.98002e+03_r8,0.74890e+03_r8,0.60565e+03_r8,0.89283e+03_r8,0.11812e+04_r8 /) + kbo(:, 3,52,16) = (/ & + & 0.42228e+03_r8,0.32613e+03_r8,0.60430e+03_r8,0.89190e+03_r8,0.11799e+04_r8 /) + kbo(:, 4,52,16) = (/ & + & 0.43025e+03_r8,0.70662e+03_r8,0.60359e+03_r8,0.89136e+03_r8,0.11791e+04_r8 /) + kbo(:, 5,52,16) = (/ & + & 0.81269e+03_r8,0.56167e+03_r8,0.60303e+03_r8,0.89051e+03_r8,0.11780e+04_r8 /) + kbo(:, 1,53,16) = (/ & + & 0.98002e+03_r8,0.61603e+03_r8,0.60747e+03_r8,0.89705e+03_r8,0.11870e+04_r8 /) + kbo(:, 2,53,16) = (/ & + & 0.28683e+03_r8,0.42277e+03_r8,0.60613e+03_r8,0.89328e+03_r8,0.11818e+04_r8 /) + kbo(:, 3,53,16) = (/ & + & 0.45415e+03_r8,0.68246e+03_r8,0.60479e+03_r8,0.89204e+03_r8,0.11801e+04_r8 /) + kbo(:, 4,53,16) = (/ & + & 0.78879e+03_r8,0.48920e+03_r8,0.60374e+03_r8,0.89159e+03_r8,0.11794e+04_r8 /) + kbo(:, 5,53,16) = (/ & + & 0.76488e+03_r8,0.14495e+03_r8,0.60326e+03_r8,0.89085e+03_r8,0.11694e+04_r8 /) + kbo(:, 1,54,16) = (/ & + & 0.67724e+03_r8,0.76701e+03_r8,0.60808e+03_r8,0.89852e+03_r8,0.11890e+04_r8 /) + kbo(:, 2,54,16) = (/ & + & 0.81269e+03_r8,0.24762e+03_r8,0.60658e+03_r8,0.89430e+03_r8,0.11833e+04_r8 /) + kbo(:, 3,54,16) = (/ & + & 0.94813e+03_r8,0.63414e+03_r8,0.60524e+03_r8,0.89246e+03_r8,0.11807e+04_r8 /) + kbo(:, 4,54,16) = (/ & + & 0.49398e+03_r8,0.28989e+03_r8,0.60390e+03_r8,0.88491e+03_r8,0.11797e+04_r8 /) + kbo(:, 5,54,16) = (/ & + & 0.89236e+03_r8,0.27781e+03_r8,0.60344e+03_r8,0.88428e+03_r8,0.11788e+04_r8 /) + kbo(:, 1,55,16) = (/ & + & 0.52586e+03_r8,0.77305e+03_r8,0.60906e+03_r8,0.89999e+03_r8,0.11909e+04_r8 /) + kbo(:, 2,55,16) = (/ & + & 0.54179e+03_r8,0.64018e+03_r8,0.60701e+03_r8,0.89560e+03_r8,0.11851e+04_r8 /) + kbo(:, 3,55,16) = (/ & + & 0.50992e+03_r8,0.60394e+03_r8,0.60567e+03_r8,0.88598e+03_r8,0.11812e+04_r8 /) + kbo(:, 4,55,16) = (/ & + & 0.63740e+03_r8,0.44088e+03_r8,0.60433e+03_r8,0.89191e+03_r8,0.11799e+04_r8 /) + kbo(:, 5,55,16) = (/ & + & 0.49398e+03_r8,0.37444e+03_r8,0.59895e+03_r8,0.89137e+03_r8,0.11791e+04_r8 /) + kbo(:, 1,56,16) = (/ & + & 0.90829e+03_r8,0.27177e+03_r8,0.61007e+03_r8,0.90151e+03_r8,0.11929e+04_r8 /) + kbo(:, 2,56,16) = (/ & + & 0.35854e+03_r8,0.24158e+03_r8,0.60744e+03_r8,0.89694e+03_r8,0.11869e+04_r8 /) + kbo(:, 3,56,16) = (/ & + & 0.59756e+03_r8,0.47107e+03_r8,0.60610e+03_r8,0.89325e+03_r8,0.11817e+04_r8 /) + kbo(:, 4,56,16) = (/ & + & 0.52585e+03_r8,0.35632e+03_r8,0.60476e+03_r8,0.89203e+03_r8,0.11801e+04_r8 /) + kbo(:, 5,56,16) = (/ & + & 0.27886e+03_r8,0.24761e+03_r8,0.59909e+03_r8,0.89157e+03_r8,0.11794e+04_r8 /) + kbo(:, 1,57,16) = (/ & + & 0.34260e+03_r8,0.66433e+03_r8,0.61112e+03_r8,0.90308e+03_r8,0.11950e+04_r8 /) + kbo(:, 2,57,16) = (/ & + & 0.66130e+03_r8,0.45295e+03_r8,0.60796e+03_r8,0.89834e+03_r8,0.11887e+04_r8 /) + kbo(:, 3,57,16) = (/ & + & 0.69317e+03_r8,0.42880e+03_r8,0.60653e+03_r8,0.89415e+03_r8,0.11831e+04_r8 /) + kbo(:, 4,57,16) = (/ & + & 0.27089e+03_r8,0.28385e+03_r8,0.60519e+03_r8,0.89241e+03_r8,0.11806e+04_r8 /) + kbo(:, 5,57,16) = (/ & + & 0.66926e+03_r8,0.34424e+03_r8,0.60385e+03_r8,0.89175e+03_r8,0.11797e+04_r8 /) + kbo(:, 1,58,16) = (/ & + & 0.96406e+03_r8,0.25365e+03_r8,0.61214e+03_r8,0.90462e+03_r8,0.11971e+04_r8 /) + kbo(:, 2,58,16) = (/ & + & 0.31073e+03_r8,0.28385e+03_r8,0.60888e+03_r8,0.89972e+03_r8,0.11906e+04_r8 /) + kbo(:, 3,58,16) = (/ & + & 0.96405e+03_r8,0.57374e+03_r8,0.60693e+03_r8,0.89536e+03_r8,0.11848e+04_r8 /) + kbo(:, 4,58,16) = (/ & + & 0.69316e+03_r8,0.13891e+03_r8,0.60560e+03_r8,0.89278e+03_r8,0.11811e+04_r8 /) + kbo(:, 5,58,16) = (/ & + & 0.59755e+03_r8,0.75492e+03_r8,0.60426e+03_r8,0.89189e+03_r8,0.11798e+04_r8 /) + kbo(:, 1,59,16) = (/ & + & 0.92422e+03_r8,0.39860e+03_r8,0.61256e+03_r8,0.90525e+03_r8,0.11979e+04_r8 /) + kbo(:, 2,59,16) = (/ & + & 0.78877e+03_r8,0.42275e+03_r8,0.60926e+03_r8,0.90029e+03_r8,0.11913e+04_r8 /) + kbo(:, 3,59,16) = (/ & + & 0.35853e+03_r8,0.65225e+03_r8,0.60710e+03_r8,0.89586e+03_r8,0.11854e+04_r8 /) + kbo(:, 4,59,16) = (/ & + & 0.54975e+03_r8,0.50730e+03_r8,0.60576e+03_r8,0.88606e+03_r8,0.11813e+04_r8 /) + kbo(:, 5,59,16) = (/ & + & 0.52585e+03_r8,0.62205e+03_r8,0.60442e+03_r8,0.89194e+03_r8,0.11799e+04_r8 /) + + end subroutine sw_kgb28 + +! ************************************************************************** + subroutine sw_kgb29 +! ************************************************************************** + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only : jpim, jprb + use rrsw_kg29, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & + absh2oo, absco2o, rayl, layreffr + + implicit none + save + +! Kurucz solar source function + sfluxrefo(:) = (/ & + & 1.32880_r8 , 2.14018_r8 , 1.97612_r8 , 1.79000_r8 , & + & 1.51242_r8 , 1.22977_r8 , 1.06052_r8 , 0.800996_r8 , & + & 0.748053_r8 , 8.64369e-02_r8, 7.10675e-02_r8, 5.62425e-02_r8, & + & 4.46988e-02_r8, 3.07441e-02_r8, 1.16728e-02_r8, 1.65573e-03_r8 /) + + absco2o(:) = (/ & + & 2.90073e-06_r8, 2.12382e-05_r8, 1.03032e-04_r8, 1.86481e-04_r8, & + & 4.31997e-04_r8, 6.08238e-04_r8, 2.17603e-03_r8, 4.64479e-02_r8, & + & 2.96956_r8 , 14.9569_r8 , 28.4831_r8 , 61.3998_r8 , & + & 164.129_r8 , 832.282_r8 , 4995.02_r8 , 12678.1_r8 /) + + absh2oo(:) = (/ & + & 2.99508e-04_r8, 3.95012e-03_r8, 1.49316e-02_r8, 3.24384e-02_r8, & + & 6.92879e-02_r8, 0.123523_r8 , 0.360985_r8 , 1.86434_r8 , & + & 10.38157_r8 , 0.214129_r8 , 0.213914_r8 , 0.212781_r8 , & + & 0.215562_r8 , 0.218087_r8 , 0.220918_r8 , 0.218546_r8 /) + +! Rayleigh extinction coefficient at v = 2200 cm-1. + rayl = 9.30e-11_r8 + + layreffr = 49 + +! ------------------------------------------------------------------ +! The array KAO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels> ~100mb, temperatures, and binary +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! JS = 3 corresponds to the parameter value 2/8, etc. The second index +! in the array, JT, which runs from 1 to 5, corresponds to different +! temperatures. More specifically, JT = 3 means that the data are for +! the reference temperature TREF for this pressure level, JT = 2 refers +! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 +! is for TREF+30. The third index, JP, runs from 1 to 13 and refers +! to the JPth reference pressure level (see taumol.f for these levels +! in mb). The fourth index, IG, goes from 1 to 16, and indicates +! which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kao(:, 1, 1) = (/ & + & 0.11565e-03_r8,0.10123e-03_r8,0.90804e-04_r8,0.82282e-04_r8,0.71083e-04_r8 /) + kao(:, 2, 1) = (/ & + & 0.96434e-04_r8,0.82830e-04_r8,0.72366e-04_r8,0.61803e-04_r8,0.52497e-04_r8 /) + kao(:, 3, 1) = (/ & + & 0.64539e-04_r8,0.56659e-04_r8,0.46605e-04_r8,0.39815e-04_r8,0.37118e-04_r8 /) + kao(:, 4, 1) = (/ & + & 0.34417e-04_r8,0.27113e-04_r8,0.25362e-04_r8,0.30345e-04_r8,0.36275e-04_r8 /) + kao(:, 5, 1) = (/ & + & 0.12260e-04_r8,0.15856e-04_r8,0.20834e-04_r8,0.27363e-04_r8,0.36114e-04_r8 /) + kao(:, 6, 1) = (/ & + & 0.10221e-04_r8,0.14598e-04_r8,0.19695e-04_r8,0.25976e-04_r8,0.33702e-04_r8 /) + kao(:, 7, 1) = (/ & + & 0.97563e-05_r8,0.13809e-04_r8,0.20231e-04_r8,0.27238e-04_r8,0.36110e-04_r8 /) + kao(:, 8, 1) = (/ & + & 0.14062e-04_r8,0.19587e-04_r8,0.27069e-04_r8,0.36937e-04_r8,0.49415e-04_r8 /) + kao(:, 9, 1) = (/ & + & 0.36371e-04_r8,0.48122e-04_r8,0.61586e-04_r8,0.77647e-04_r8,0.99897e-04_r8 /) + kao(:,10, 1) = (/ & + & 0.99203e-04_r8,0.12842e-03_r8,0.16588e-03_r8,0.20834e-03_r8,0.26000e-03_r8 /) + kao(:,11, 1) = (/ & + & 0.13233e-03_r8,0.17318e-03_r8,0.22059e-03_r8,0.28904e-03_r8,0.36062e-03_r8 /) + kao(:,12, 1) = (/ & + & 0.13379e-03_r8,0.17484e-03_r8,0.23687e-03_r8,0.30286e-03_r8,0.37504e-03_r8 /) + kao(:,13, 1) = (/ & + & 0.11740e-03_r8,0.15667e-03_r8,0.20962e-03_r8,0.26768e-03_r8,0.33485e-03_r8 /) + kao(:, 1, 2) = (/ & + & 0.10246e-03_r8,0.10450e-03_r8,0.97383e-04_r8,0.96398e-04_r8,0.10549e-03_r8 /) + kao(:, 2, 2) = (/ & + & 0.10589e-03_r8,0.10240e-03_r8,0.95801e-04_r8,0.98509e-04_r8,0.11993e-03_r8 /) + kao(:, 3, 2) = (/ & + & 0.94054e-04_r8,0.87009e-04_r8,0.10941e-03_r8,0.13486e-03_r8,0.15918e-03_r8 /) + kao(:, 4, 2) = (/ & + & 0.11883e-03_r8,0.14236e-03_r8,0.16636e-03_r8,0.18235e-03_r8,0.19785e-03_r8 /) + kao(:, 5, 2) = (/ & + & 0.17800e-03_r8,0.19347e-03_r8,0.20977e-03_r8,0.22730e-03_r8,0.25111e-03_r8 /) + kao(:, 6, 2) = (/ & + & 0.22243e-03_r8,0.24157e-03_r8,0.26567e-03_r8,0.28549e-03_r8,0.30723e-03_r8 /) + kao(:, 7, 2) = (/ & + & 0.29248e-03_r8,0.32242e-03_r8,0.34635e-03_r8,0.37915e-03_r8,0.40803e-03_r8 /) + kao(:, 8, 2) = (/ & + & 0.43386e-03_r8,0.48611e-03_r8,0.52681e-03_r8,0.56812e-03_r8,0.60642e-03_r8 /) + kao(:, 9, 2) = (/ & + & 0.89109e-03_r8,0.10345e-02_r8,0.11794e-02_r8,0.13045e-02_r8,0.14303e-02_r8 /) + kao(:,10, 2) = (/ & + & 0.21538e-02_r8,0.24459e-02_r8,0.27329e-02_r8,0.30932e-02_r8,0.35253e-02_r8 /) + kao(:,11, 2) = (/ & + & 0.29272e-02_r8,0.32676e-02_r8,0.36353e-02_r8,0.40062e-02_r8,0.45441e-02_r8 /) + kao(:,12, 2) = (/ & + & 0.30762e-02_r8,0.34365e-02_r8,0.38146e-02_r8,0.41556e-02_r8,0.47164e-02_r8 /) + kao(:,13, 2) = (/ & + & 0.27808e-02_r8,0.31114e-02_r8,0.34383e-02_r8,0.37954e-02_r8,0.42576e-02_r8 /) + kao(:, 1, 3) = (/ & + & 0.24042e-03_r8,0.32719e-03_r8,0.44370e-03_r8,0.56836e-03_r8,0.70357e-03_r8 /) + kao(:, 2, 3) = (/ & + & 0.23303e-03_r8,0.31901e-03_r8,0.41926e-03_r8,0.52400e-03_r8,0.62365e-03_r8 /) + kao(:, 3, 3) = (/ & + & 0.35050e-03_r8,0.42158e-03_r8,0.47490e-03_r8,0.53390e-03_r8,0.60411e-03_r8 /) + kao(:, 4, 3) = (/ & + & 0.49954e-03_r8,0.53067e-03_r8,0.56338e-03_r8,0.60859e-03_r8,0.66569e-03_r8 /) + kao(:, 5, 3) = (/ & + & 0.66908e-03_r8,0.69727e-03_r8,0.72898e-03_r8,0.76756e-03_r8,0.80358e-03_r8 /) + kao(:, 6, 3) = (/ & + & 0.88634e-03_r8,0.92853e-03_r8,0.96856e-03_r8,0.10101e-02_r8,0.10556e-02_r8 /) + kao(:, 7, 3) = (/ & + & 0.11659e-02_r8,0.12355e-02_r8,0.13238e-02_r8,0.13889e-02_r8,0.14491e-02_r8 /) + kao(:, 8, 3) = (/ & + & 0.17485e-02_r8,0.18223e-02_r8,0.19411e-02_r8,0.20705e-02_r8,0.22025e-02_r8 /) + kao(:, 9, 3) = (/ & + & 0.42442e-02_r8,0.43561e-02_r8,0.45061e-02_r8,0.47505e-02_r8,0.50358e-02_r8 /) + kao(:,10, 3) = (/ & + & 0.10940e-01_r8,0.11499e-01_r8,0.11906e-01_r8,0.12570e-01_r8,0.12803e-01_r8 /) + kao(:,11, 3) = (/ & + & 0.14287e-01_r8,0.15010e-01_r8,0.15581e-01_r8,0.16054e-01_r8,0.16609e-01_r8 /) + kao(:,12, 3) = (/ & + & 0.14856e-01_r8,0.15546e-01_r8,0.16074e-01_r8,0.16478e-01_r8,0.17057e-01_r8 /) + kao(:,13, 3) = (/ & + & 0.13257e-01_r8,0.13834e-01_r8,0.14155e-01_r8,0.14723e-01_r8,0.15095e-01_r8 /) + kao(:, 1, 4) = (/ & + & 0.24391e-02_r8,0.28720e-02_r8,0.33497e-02_r8,0.38926e-02_r8,0.45054e-02_r8 /) + kao(:, 2, 4) = (/ & + & 0.22506e-02_r8,0.26004e-02_r8,0.30002e-02_r8,0.34490e-02_r8,0.39579e-02_r8 /) + kao(:, 3, 4) = (/ & + & 0.22153e-02_r8,0.25711e-02_r8,0.29320e-02_r8,0.33330e-02_r8,0.37728e-02_r8 /) + kao(:, 4, 4) = (/ & + & 0.22483e-02_r8,0.25445e-02_r8,0.28745e-02_r8,0.32484e-02_r8,0.36554e-02_r8 /) + kao(:, 5, 4) = (/ & + & 0.23388e-02_r8,0.25985e-02_r8,0.28914e-02_r8,0.32377e-02_r8,0.36113e-02_r8 /) + kao(:, 6, 4) = (/ & + & 0.24669e-02_r8,0.26579e-02_r8,0.28834e-02_r8,0.31538e-02_r8,0.34593e-02_r8 /) + kao(:, 7, 4) = (/ & + & 0.32536e-02_r8,0.33413e-02_r8,0.34375e-02_r8,0.35905e-02_r8,0.38010e-02_r8 /) + kao(:, 8, 4) = (/ & + & 0.51228e-02_r8,0.51967e-02_r8,0.52820e-02_r8,0.53446e-02_r8,0.53797e-02_r8 /) + kao(:, 9, 4) = (/ & + & 0.13029e-01_r8,0.13065e-01_r8,0.12891e-01_r8,0.12848e-01_r8,0.12777e-01_r8 /) + kao(:,10, 4) = (/ & + & 0.29911e-01_r8,0.30117e-01_r8,0.28340e-01_r8,0.27321e-01_r8,0.27485e-01_r8 /) + kao(:,11, 4) = (/ & + & 0.36663e-01_r8,0.36877e-01_r8,0.34688e-01_r8,0.33004e-01_r8,0.32437e-01_r8 /) + kao(:,12, 4) = (/ & + & 0.37282e-01_r8,0.37775e-01_r8,0.34910e-01_r8,0.33463e-01_r8,0.33074e-01_r8 /) + kao(:,13, 4) = (/ & + & 0.33412e-01_r8,0.32961e-01_r8,0.30323e-01_r8,0.29437e-01_r8,0.29572e-01_r8 /) + kao(:, 1, 5) = (/ & + & 0.20792e-01_r8,0.22727e-01_r8,0.25207e-01_r8,0.27650e-01_r8,0.29866e-01_r8 /) + kao(:, 2, 5) = (/ & + & 0.17515e-01_r8,0.19421e-01_r8,0.21509e-01_r8,0.23389e-01_r8,0.25418e-01_r8 /) + kao(:, 3, 5) = (/ & + & 0.14912e-01_r8,0.16535e-01_r8,0.18159e-01_r8,0.19873e-01_r8,0.21718e-01_r8 /) + kao(:, 4, 5) = (/ & + & 0.13498e-01_r8,0.14786e-01_r8,0.16253e-01_r8,0.17812e-01_r8,0.19494e-01_r8 /) + kao(:, 5, 5) = (/ & + & 0.12840e-01_r8,0.13983e-01_r8,0.15257e-01_r8,0.16617e-01_r8,0.18015e-01_r8 /) + kao(:, 6, 5) = (/ & + & 0.12557e-01_r8,0.13714e-01_r8,0.14939e-01_r8,0.16145e-01_r8,0.17356e-01_r8 /) + kao(:, 7, 5) = (/ & + & 0.11839e-01_r8,0.12951e-01_r8,0.14090e-01_r8,0.15237e-01_r8,0.16396e-01_r8 /) + kao(:, 8, 5) = (/ & + & 0.13190e-01_r8,0.13998e-01_r8,0.14783e-01_r8,0.15641e-01_r8,0.16632e-01_r8 /) + kao(:, 9, 5) = (/ & + & 0.24479e-01_r8,0.24660e-01_r8,0.25206e-01_r8,0.25571e-01_r8,0.26098e-01_r8 /) + kao(:,10, 5) = (/ & + & 0.62373e-01_r8,0.60241e-01_r8,0.61372e-01_r8,0.61530e-01_r8,0.60978e-01_r8 /) + kao(:,11, 5) = (/ & + & 0.76394e-01_r8,0.73727e-01_r8,0.74701e-01_r8,0.75649e-01_r8,0.75608e-01_r8 /) + kao(:,12, 5) = (/ & + & 0.76656e-01_r8,0.73608e-01_r8,0.75610e-01_r8,0.76362e-01_r8,0.76033e-01_r8 /) + kao(:,13, 5) = (/ & + & 0.66025e-01_r8,0.64890e-01_r8,0.66873e-01_r8,0.66992e-01_r8,0.66685e-01_r8 /) + kao(:, 1, 6) = (/ & + & 0.99799e-01_r8,0.10479e+00_r8,0.10918e+00_r8,0.11347e+00_r8,0.11767e+00_r8 /) + kao(:, 2, 6) = (/ & + & 0.87946e-01_r8,0.91820e-01_r8,0.95208e-01_r8,0.99071e-01_r8,0.10286e+00_r8 /) + kao(:, 3, 6) = (/ & + & 0.76753e-01_r8,0.80377e-01_r8,0.84204e-01_r8,0.87924e-01_r8,0.91370e-01_r8 /) + kao(:, 4, 6) = (/ & + & 0.67002e-01_r8,0.70630e-01_r8,0.73736e-01_r8,0.76764e-01_r8,0.79671e-01_r8 /) + kao(:, 5, 6) = (/ & + & 0.58933e-01_r8,0.61857e-01_r8,0.64756e-01_r8,0.67323e-01_r8,0.69871e-01_r8 /) + kao(:, 6, 6) = (/ & + & 0.53143e-01_r8,0.55386e-01_r8,0.57507e-01_r8,0.59715e-01_r8,0.62263e-01_r8 /) + kao(:, 7, 6) = (/ & + & 0.50856e-01_r8,0.52603e-01_r8,0.54414e-01_r8,0.56230e-01_r8,0.58483e-01_r8 /) + kao(:, 8, 6) = (/ & + & 0.50528e-01_r8,0.52598e-01_r8,0.54634e-01_r8,0.56710e-01_r8,0.58872e-01_r8 /) + kao(:, 9, 6) = (/ & + & 0.64616e-01_r8,0.65915e-01_r8,0.67210e-01_r8,0.68742e-01_r8,0.70092e-01_r8 /) + kao(:,10, 6) = (/ & + & 0.11509e+00_r8,0.11448e+00_r8,0.11368e+00_r8,0.11348e+00_r8,0.11401e+00_r8 /) + kao(:,11, 6) = (/ & + & 0.14266e+00_r8,0.13997e+00_r8,0.13810e+00_r8,0.13688e+00_r8,0.13622e+00_r8 /) + kao(:,12, 6) = (/ & + & 0.14464e+00_r8,0.14198e+00_r8,0.13915e+00_r8,0.13789e+00_r8,0.13781e+00_r8 /) + kao(:,13, 6) = (/ & + & 0.12550e+00_r8,0.12328e+00_r8,0.12173e+00_r8,0.12127e+00_r8,0.12078e+00_r8 /) + kao(:, 1, 7) = (/ & + & 0.30825e+00_r8,0.31119e+00_r8,0.31335e+00_r8,0.31641e+00_r8,0.32024e+00_r8 /) + kao(:, 2, 7) = (/ & + & 0.28100e+00_r8,0.28660e+00_r8,0.29192e+00_r8,0.29680e+00_r8,0.30014e+00_r8 /) + kao(:, 3, 7) = (/ & + & 0.26374e+00_r8,0.27129e+00_r8,0.27887e+00_r8,0.28626e+00_r8,0.29478e+00_r8 /) + kao(:, 4, 7) = (/ & + & 0.24539e+00_r8,0.25325e+00_r8,0.26070e+00_r8,0.26955e+00_r8,0.27794e+00_r8 /) + kao(:, 5, 7) = (/ & + & 0.21737e+00_r8,0.22642e+00_r8,0.23531e+00_r8,0.24408e+00_r8,0.25322e+00_r8 /) + kao(:, 6, 7) = (/ & + & 0.19066e+00_r8,0.19913e+00_r8,0.20834e+00_r8,0.21782e+00_r8,0.22698e+00_r8 /) + kao(:, 7, 7) = (/ & + & 0.17386e+00_r8,0.18325e+00_r8,0.19211e+00_r8,0.20024e+00_r8,0.20881e+00_r8 /) + kao(:, 8, 7) = (/ & + & 0.17625e+00_r8,0.18236e+00_r8,0.18905e+00_r8,0.19574e+00_r8,0.20193e+00_r8 /) + kao(:, 9, 7) = (/ & + & 0.21820e+00_r8,0.22416e+00_r8,0.22986e+00_r8,0.23737e+00_r8,0.24518e+00_r8 /) + kao(:,10, 7) = (/ & + & 0.33529e+00_r8,0.34302e+00_r8,0.35397e+00_r8,0.36397e+00_r8,0.37339e+00_r8 /) + kao(:,11, 7) = (/ & + & 0.38474e+00_r8,0.39863e+00_r8,0.41168e+00_r8,0.42115e+00_r8,0.42917e+00_r8 /) + kao(:,12, 7) = (/ & + & 0.38499e+00_r8,0.39580e+00_r8,0.40497e+00_r8,0.41279e+00_r8,0.42045e+00_r8 /) + kao(:,13, 7) = (/ & + & 0.34291e+00_r8,0.35180e+00_r8,0.35970e+00_r8,0.36697e+00_r8,0.37460e+00_r8 /) + kao(:, 1, 8) = (/ & + & 0.87131e+00_r8,0.87876e+00_r8,0.88509e+00_r8,0.89061e+00_r8,0.89432e+00_r8 /) + kao(:, 2, 8) = (/ & + & 0.78963e+00_r8,0.79236e+00_r8,0.79978e+00_r8,0.80959e+00_r8,0.82163e+00_r8 /) + kao(:, 3, 8) = (/ & + & 0.82479e+00_r8,0.82842e+00_r8,0.83069e+00_r8,0.83679e+00_r8,0.84334e+00_r8 /) + kao(:, 4, 8) = (/ & + & 0.90877e+00_r8,0.91962e+00_r8,0.92466e+00_r8,0.93139e+00_r8,0.93904e+00_r8 /) + kao(:, 5, 8) = (/ & + & 0.97131e+00_r8,0.99301e+00_r8,0.10095e+01_r8,0.10270e+01_r8,0.10371e+01_r8 /) + kao(:, 6, 8) = (/ & + & 0.96984e+00_r8,0.10040e+01_r8,0.10393e+01_r8,0.10670e+01_r8,0.10990e+01_r8 /) + kao(:, 7, 8) = (/ & + & 0.95686e+00_r8,0.10029e+01_r8,0.10449e+01_r8,0.10923e+01_r8,0.11334e+01_r8 /) + kao(:, 8, 8) = (/ & + & 0.97227e+00_r8,0.10380e+01_r8,0.11014e+01_r8,0.11624e+01_r8,0.12218e+01_r8 /) + kao(:, 9, 8) = (/ & + & 0.12290e+01_r8,0.13071e+01_r8,0.14005e+01_r8,0.15005e+01_r8,0.15980e+01_r8 /) + kao(:,10, 8) = (/ & + & 0.17996e+01_r8,0.19304e+01_r8,0.20752e+01_r8,0.22219e+01_r8,0.23814e+01_r8 /) + kao(:,11, 8) = (/ & + & 0.19289e+01_r8,0.20656e+01_r8,0.22166e+01_r8,0.23715e+01_r8,0.25386e+01_r8 /) + kao(:,12, 8) = (/ & + & 0.18429e+01_r8,0.19765e+01_r8,0.21175e+01_r8,0.22722e+01_r8,0.24239e+01_r8 /) + kao(:,13, 8) = (/ & + & 0.16420e+01_r8,0.17464e+01_r8,0.18635e+01_r8,0.19773e+01_r8,0.21012e+01_r8 /) + kao(:, 1, 9) = (/ & + & 0.39892e+01_r8,0.40153e+01_r8,0.40324e+01_r8,0.40465e+01_r8,0.40524e+01_r8 /) + kao(:, 2, 9) = (/ & + & 0.38871e+01_r8,0.39035e+01_r8,0.39123e+01_r8,0.39056e+01_r8,0.38966e+01_r8 /) + kao(:, 3, 9) = (/ & + & 0.37883e+01_r8,0.37950e+01_r8,0.38080e+01_r8,0.37991e+01_r8,0.37826e+01_r8 /) + kao(:, 4, 9) = (/ & + & 0.37778e+01_r8,0.37663e+01_r8,0.37745e+01_r8,0.37709e+01_r8,0.37556e+01_r8 /) + kao(:, 5, 9) = (/ & + & 0.38757e+01_r8,0.38404e+01_r8,0.38539e+01_r8,0.39228e+01_r8,0.39777e+01_r8 /) + kao(:, 6, 9) = (/ & + & 0.40990e+01_r8,0.41407e+01_r8,0.41745e+01_r8,0.42258e+01_r8,0.42574e+01_r8 /) + kao(:, 7, 9) = (/ & + & 0.46288e+01_r8,0.46726e+01_r8,0.47096e+01_r8,0.47165e+01_r8,0.47374e+01_r8 /) + kao(:, 8, 9) = (/ & + & 0.58432e+01_r8,0.58474e+01_r8,0.58608e+01_r8,0.58935e+01_r8,0.59261e+01_r8 /) + kao(:, 9, 9) = (/ & + & 0.88685e+01_r8,0.88567e+01_r8,0.88137e+01_r8,0.87653e+01_r8,0.87262e+01_r8 /) + kao(:,10, 9) = (/ & + & 0.10455e+02_r8,0.10242e+02_r8,0.10004e+02_r8,0.97643e+01_r8,0.95067e+01_r8 /) + kao(:,11, 9) = (/ & + & 0.10240e+02_r8,0.99968e+01_r8,0.97347e+01_r8,0.94750e+01_r8,0.92006e+01_r8 /) + kao(:,12, 9) = (/ & + & 0.10401e+02_r8,0.10165e+02_r8,0.99240e+01_r8,0.96656e+01_r8,0.94112e+01_r8 /) + kao(:,13, 9) = (/ & + & 0.10764e+02_r8,0.10580e+02_r8,0.10381e+02_r8,0.10188e+02_r8,0.99802e+01_r8 /) + kao(:, 1,10) = (/ & + & 0.10712e+02_r8,0.10575e+02_r8,0.10581e+02_r8,0.10556e+02_r8,0.10575e+02_r8 /) + kao(:, 2,10) = (/ & + & 0.11144e+02_r8,0.11109e+02_r8,0.11034e+02_r8,0.11107e+02_r8,0.11138e+02_r8 /) + kao(:, 3,10) = (/ & + & 0.12257e+02_r8,0.12112e+02_r8,0.11992e+02_r8,0.11951e+02_r8,0.12031e+02_r8 /) + kao(:, 4,10) = (/ & + & 0.13040e+02_r8,0.13085e+02_r8,0.12882e+02_r8,0.12756e+02_r8,0.12737e+02_r8 /) + kao(:, 5,10) = (/ & + & 0.13809e+02_r8,0.13771e+02_r8,0.13452e+02_r8,0.12567e+02_r8,0.12086e+02_r8 /) + kao(:, 6,10) = (/ & + & 0.14608e+02_r8,0.13942e+02_r8,0.13365e+02_r8,0.13494e+02_r8,0.13762e+02_r8 /) + kao(:, 7,10) = (/ & + & 0.14665e+02_r8,0.14685e+02_r8,0.15121e+02_r8,0.15602e+02_r8,0.15768e+02_r8 /) + kao(:, 8,10) = (/ & + & 0.15612e+02_r8,0.16507e+02_r8,0.16644e+02_r8,0.16706e+02_r8,0.16696e+02_r8 /) + kao(:, 9,10) = (/ & + & 0.15405e+02_r8,0.15874e+02_r8,0.16716e+02_r8,0.17957e+02_r8,0.17859e+02_r8 /) + kao(:,10,10) = (/ & + & 0.19406e+00_r8,0.17932e+00_r8,0.16660e+00_r8,0.15558e+00_r8,0.14589e+00_r8 /) + kao(:,11,10) = (/ & + & 0.27650e+00_r8,0.25556e+00_r8,0.23727e+00_r8,0.22182e+00_r8,0.20805e+00_r8 /) + kao(:,12,10) = (/ & + & 0.29298e+00_r8,0.27044e+00_r8,0.25162e+00_r8,0.23497e+00_r8,0.22076e+00_r8 /) + kao(:,13,10) = (/ & + & 0.24883e+00_r8,0.22985e+00_r8,0.21413e+00_r8,0.20012e+00_r8,0.18795e+00_r8 /) + kao(:, 1,11) = (/ & + & 0.13650e+02_r8,0.13767e+02_r8,0.13771e+02_r8,0.13650e+02_r8,0.13663e+02_r8 /) + kao(:, 2,11) = (/ & + & 0.15146e+02_r8,0.15253e+02_r8,0.15272e+02_r8,0.15152e+02_r8,0.15138e+02_r8 /) + kao(:, 3,11) = (/ & + & 0.16834e+02_r8,0.17107e+02_r8,0.17158e+02_r8,0.17187e+02_r8,0.17057e+02_r8 /) + kao(:, 4,11) = (/ & + & 0.19191e+02_r8,0.19144e+02_r8,0.19155e+02_r8,0.19247e+02_r8,0.19292e+02_r8 /) + kao(:, 5,11) = (/ & + & 0.20953e+02_r8,0.21248e+02_r8,0.21186e+02_r8,0.21027e+02_r8,0.20703e+02_r8 /) + kao(:, 6,11) = (/ & + & 0.22592e+02_r8,0.22192e+02_r8,0.22056e+02_r8,0.20972e+02_r8,0.19910e+02_r8 /) + kao(:, 7,11) = (/ & + & 0.24652e+02_r8,0.23679e+02_r8,0.22339e+02_r8,0.21302e+02_r8,0.21697e+02_r8 /) + kao(:, 8,11) = (/ & + & 0.22508e+02_r8,0.20438e+02_r8,0.20163e+02_r8,0.20628e+02_r8,0.20954e+02_r8 /) + kao(:, 9,11) = (/ & + & 0.10264e+02_r8,0.85820e+01_r8,0.65270e+01_r8,0.38883e+01_r8,0.27974e+01_r8 /) + kao(:,10,11) = (/ & + & 0.19324e+00_r8,0.17913e+00_r8,0.16619e+00_r8,0.15516e+00_r8,0.14524e+00_r8 /) + kao(:,11,11) = (/ & + & 0.27573e+00_r8,0.25425e+00_r8,0.23627e+00_r8,0.22036e+00_r8,0.20639e+00_r8 /) + kao(:,12,11) = (/ & + & 0.29224e+00_r8,0.26998e+00_r8,0.25055e+00_r8,0.23380e+00_r8,0.21908e+00_r8 /) + kao(:,13,11) = (/ & + & 0.24964e+00_r8,0.23056e+00_r8,0.21391e+00_r8,0.19980e+00_r8,0.18698e+00_r8 /) + kao(:, 1,12) = (/ & + & 0.17721e+02_r8,0.17805e+02_r8,0.17752e+02_r8,0.17857e+02_r8,0.17872e+02_r8 /) + kao(:, 2,12) = (/ & + & 0.20222e+02_r8,0.20161e+02_r8,0.20267e+02_r8,0.20335e+02_r8,0.20254e+02_r8 /) + kao(:, 3,12) = (/ & + & 0.23717e+02_r8,0.23414e+02_r8,0.23571e+02_r8,0.23552e+02_r8,0.23687e+02_r8 /) + kao(:, 4,12) = (/ & + & 0.26876e+02_r8,0.26972e+02_r8,0.27155e+02_r8,0.26947e+02_r8,0.27025e+02_r8 /) + kao(:, 5,12) = (/ & + & 0.30213e+02_r8,0.29978e+02_r8,0.30226e+02_r8,0.30477e+02_r8,0.30329e+02_r8 /) + kao(:, 6,12) = (/ & + & 0.33660e+02_r8,0.33482e+02_r8,0.33159e+02_r8,0.32959e+02_r8,0.32299e+02_r8 /) + kao(:, 7,12) = (/ & + & 0.35893e+02_r8,0.35649e+02_r8,0.35067e+02_r8,0.34565e+02_r8,0.32437e+02_r8 /) + kao(:, 8,12) = (/ & + & 0.33426e+02_r8,0.33323e+02_r8,0.31984e+02_r8,0.29587e+02_r8,0.27505e+02_r8 /) + kao(:, 9,12) = (/ & + & 0.46633e-01_r8,0.43205e-01_r8,0.40562e-01_r8,0.38133e-01_r8,0.35900e-01_r8 /) + kao(:,10,12) = (/ & + & 0.19421e+00_r8,0.18024e+00_r8,0.16872e+00_r8,0.15815e+00_r8,0.14837e+00_r8 /) + kao(:,11,12) = (/ & + & 0.27315e+00_r8,0.25480e+00_r8,0.23771e+00_r8,0.22191e+00_r8,0.20780e+00_r8 /) + kao(:,12,12) = (/ & + & 0.29027e+00_r8,0.26969e+00_r8,0.25017e+00_r8,0.23314e+00_r8,0.21774e+00_r8 /) + kao(:,13,12) = (/ & + & 0.24833e+00_r8,0.22943e+00_r8,0.21278e+00_r8,0.19800e+00_r8,0.18543e+00_r8 /) + kao(:, 1,13) = (/ & + & 0.29672e+02_r8,0.29291e+02_r8,0.29191e+02_r8,0.29170e+02_r8,0.29116e+02_r8 /) + kao(:, 2,13) = (/ & + & 0.24713e+02_r8,0.24965e+02_r8,0.25039e+02_r8,0.25355e+02_r8,0.25650e+02_r8 /) + kao(:, 3,13) = (/ & + & 0.30510e+02_r8,0.31166e+02_r8,0.30663e+02_r8,0.31021e+02_r8,0.30901e+02_r8 /) + kao(:, 4,13) = (/ & + & 0.38695e+02_r8,0.38922e+02_r8,0.38741e+02_r8,0.39204e+02_r8,0.38826e+02_r8 /) + kao(:, 5,13) = (/ & + & 0.45118e+02_r8,0.44337e+02_r8,0.43664e+02_r8,0.43267e+02_r8,0.43524e+02_r8 /) + kao(:, 6,13) = (/ & + & 0.34652e+02_r8,0.35182e+02_r8,0.35339e+02_r8,0.35340e+02_r8,0.35899e+02_r8 /) + kao(:, 7,13) = (/ & + & 0.18801e+02_r8,0.18598e+02_r8,0.18855e+02_r8,0.18819e+02_r8,0.19052e+02_r8 /) + kao(:, 8,13) = (/ & + & 0.12297e-01_r8,0.11425e-01_r8,0.10670e-01_r8,0.99994e-02_r8,0.94139e-02_r8 /) + kao(:, 9,13) = (/ & + & 0.46821e-01_r8,0.43361e-01_r8,0.40368e-01_r8,0.37752e-01_r8,0.35493e-01_r8 /) + kao(:,10,13) = (/ & + & 0.19817e+00_r8,0.18303e+00_r8,0.17002e+00_r8,0.15883e+00_r8,0.14933e+00_r8 /) + kao(:,11,13) = (/ & + & 0.28145e+00_r8,0.25995e+00_r8,0.24181e+00_r8,0.22660e+00_r8,0.21326e+00_r8 /) + kao(:,12,13) = (/ & + & 0.29510e+00_r8,0.27294e+00_r8,0.25519e+00_r8,0.23947e+00_r8,0.22551e+00_r8 /) + kao(:,13,13) = (/ & + & 0.24830e+00_r8,0.23074e+00_r8,0.21556e+00_r8,0.20226e+00_r8,0.19029e+00_r8 /) + kao(:, 1,14) = (/ & + & 0.47168e+02_r8,0.46890e+02_r8,0.46612e+02_r8,0.46353e+02_r8,0.46088e+02_r8 /) + kao(:, 2,14) = (/ & + & 0.47771e+02_r8,0.46980e+02_r8,0.46445e+02_r8,0.45828e+02_r8,0.45437e+02_r8 /) + kao(:, 3,14) = (/ & + & 0.42946e+02_r8,0.42652e+02_r8,0.43791e+02_r8,0.43237e+02_r8,0.44104e+02_r8 /) + kao(:, 4,14) = (/ & + & 0.30957e+02_r8,0.30098e+02_r8,0.30055e+02_r8,0.29555e+02_r8,0.29902e+02_r8 /) + kao(:, 5,14) = (/ & + & 0.28397e+01_r8,0.38572e+01_r8,0.42906e+01_r8,0.47091e+01_r8,0.48135e+01_r8 /) + kao(:, 6,14) = (/ & + & 0.36978e-02_r8,0.34591e-02_r8,0.32524e-02_r8,0.30649e-02_r8,0.29018e-02_r8 /) + kao(:, 7,14) = (/ & + & 0.61733e-02_r8,0.57589e-02_r8,0.53925e-02_r8,0.50742e-02_r8,0.47835e-02_r8 /) + kao(:, 8,14) = (/ & + & 0.12390e-01_r8,0.11526e-01_r8,0.10766e-01_r8,0.10096e-01_r8,0.95010e-02_r8 /) + kao(:, 9,14) = (/ & + & 0.47105e-01_r8,0.43648e-01_r8,0.40665e-01_r8,0.38054e-01_r8,0.35722e-01_r8 /) + kao(:,10,14) = (/ & + & 0.19915e+00_r8,0.18412e+00_r8,0.17099e+00_r8,0.15957e+00_r8,0.14948e+00_r8 /) + kao(:,11,14) = (/ & + & 0.28280e+00_r8,0.26124e+00_r8,0.24266e+00_r8,0.22645e+00_r8,0.21214e+00_r8 /) + kao(:,12,14) = (/ & + & 0.29891e+00_r8,0.27613e+00_r8,0.25648e+00_r8,0.23927e+00_r8,0.22423e+00_r8 /) + kao(:,13,14) = (/ & + & 0.25421e+00_r8,0.23484e+00_r8,0.21809e+00_r8,0.20347e+00_r8,0.19057e+00_r8 /) + kao(:, 1,15) = (/ & + & 0.64994e+02_r8,0.64283e+02_r8,0.63755e+02_r8,0.63407e+02_r8,0.63287e+02_r8 /) + kao(:, 2,15) = (/ & + & 0.78266e+02_r8,0.77364e+02_r8,0.76722e+02_r8,0.76285e+02_r8,0.75992e+02_r8 /) + kao(:, 3,15) = (/ & + & 0.41710e+02_r8,0.38379e+02_r8,0.35076e+02_r8,0.35418e+02_r8,0.33306e+02_r8 /) + kao(:, 4,15) = (/ & + & 0.14170e-02_r8,0.13401e-02_r8,0.12716e-02_r8,0.12073e-02_r8,0.11535e-02_r8 /) + kao(:, 5,15) = (/ & + & 0.23659e-02_r8,0.22261e-02_r8,0.21042e-02_r8,0.19950e-02_r8,0.18970e-02_r8 /) + kao(:, 6,15) = (/ & + & 0.37432e-02_r8,0.35105e-02_r8,0.33006e-02_r8,0.31222e-02_r8,0.29521e-02_r8 /) + kao(:, 7,15) = (/ & + & 0.62408e-02_r8,0.58258e-02_r8,0.54782e-02_r8,0.51594e-02_r8,0.48767e-02_r8 /) + kao(:, 8,15) = (/ & + & 0.12522e-01_r8,0.11652e-01_r8,0.10922e-01_r8,0.10265e-01_r8,0.96672e-02_r8 /) + kao(:, 9,15) = (/ & + & 0.47545e-01_r8,0.44152e-01_r8,0.41251e-01_r8,0.38666e-01_r8,0.36358e-01_r8 /) + kao(:,10,15) = (/ & + & 0.20097e+00_r8,0.18592e+00_r8,0.17341e+00_r8,0.16203e+00_r8,0.15235e+00_r8 /) + kao(:,11,15) = (/ & + & 0.28499e+00_r8,0.26428e+00_r8,0.24585e+00_r8,0.22980e+00_r8,0.21575e+00_r8 /) + kao(:,12,15) = (/ & + & 0.30172e+00_r8,0.27929e+00_r8,0.25980e+00_r8,0.24306e+00_r8,0.22789e+00_r8 /) + kao(:,13,15) = (/ & + & 0.25655e+00_r8,0.23731e+00_r8,0.22092e+00_r8,0.20639e+00_r8,0.19367e+00_r8 /) + kao(:, 1,16) = (/ & + & 0.80810e+02_r8,0.81099e+02_r8,0.81190e+02_r8,0.81107e+02_r8,0.80989e+02_r8 /) + kao(:, 2,16) = (/ & + & 0.99319e+02_r8,0.99708e+02_r8,0.99822e+02_r8,0.99871e+02_r8,0.99993e+02_r8 /) + kao(:, 3,16) = (/ & + & 0.46927e+02_r8,0.54316e+02_r8,0.57355e+02_r8,0.53715e+02_r8,0.52802e+02_r8 /) + kao(:, 4,16) = (/ & + & 0.12802e-02_r8,0.12027e-02_r8,0.11386e-02_r8,0.10866e-02_r8,0.10525e-02_r8 /) + kao(:, 5,16) = (/ & + & 0.21675e-02_r8,0.20715e-02_r8,0.19422e-02_r8,0.18402e-02_r8,0.17681e-02_r8 /) + kao(:, 6,16) = (/ & + & 0.34707e-02_r8,0.32796e-02_r8,0.30986e-02_r8,0.29246e-02_r8,0.28034e-02_r8 /) + kao(:, 7,16) = (/ & + & 0.58659e-02_r8,0.55310e-02_r8,0.51820e-02_r8,0.48829e-02_r8,0.46784e-02_r8 /) + kao(:, 8,16) = (/ & + & 0.11875e-01_r8,0.11183e-01_r8,0.10438e-01_r8,0.98038e-02_r8,0.93665e-02_r8 /) + kao(:, 9,16) = (/ & + & 0.45519e-01_r8,0.42850e-01_r8,0.39715e-01_r8,0.37447e-01_r8,0.35369e-01_r8 /) + kao(:,10,16) = (/ & + & 0.19392e+00_r8,0.18108e+00_r8,0.16817e+00_r8,0.15883e+00_r8,0.14864e+00_r8 /) + kao(:,11,16) = (/ & + & 0.27830e+00_r8,0.25715e+00_r8,0.24100e+00_r8,0.22595e+00_r8,0.21321e+00_r8 /) + kao(:,12,16) = (/ & + & 0.29533e+00_r8,0.27422e+00_r8,0.25636e+00_r8,0.23936e+00_r8,0.22658e+00_r8 /) + kao(:,13,16) = (/ & + & 0.25310e+00_r8,0.23535e+00_r8,0.21855e+00_r8,0.20552e+00_r8,0.19293e+00_r8 /) + +! ----------------------------------------------------------------- +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! The second index, JP, runs from 13 to 59 and refers to the JPth +! reference pressure level (see taumol.f for the value of these +! pressure levels in mb). The third index, IG, goes from 1 to 16, +! and tells us which g-interval the absorption coefficients are for. +! ----------------------------------------------------------------- + + kbo(:,13, 1) = (/ & + & 0.18379e-05_r8,0.23296e-05_r8,0.29007e-05_r8,0.35902e-05_r8,0.43437e-05_r8 /) + kbo(:,14, 1) = (/ & + & 0.15919e-05_r8,0.19832e-05_r8,0.24720e-05_r8,0.30683e-05_r8,0.37253e-05_r8 /) + kbo(:,15, 1) = (/ & + & 0.13850e-05_r8,0.17115e-05_r8,0.21225e-05_r8,0.26292e-05_r8,0.31945e-05_r8 /) + kbo(:,16, 1) = (/ & + & 0.11896e-05_r8,0.14680e-05_r8,0.18142e-05_r8,0.22537e-05_r8,0.27284e-05_r8 /) + kbo(:,17, 1) = (/ & + & 0.10228e-05_r8,0.12597e-05_r8,0.15532e-05_r8,0.19272e-05_r8,0.23163e-05_r8 /) + kbo(:,18, 1) = (/ & + & 0.88243e-06_r8,0.10835e-05_r8,0.13316e-05_r8,0.16603e-05_r8,0.19808e-05_r8 /) + kbo(:,19, 1) = (/ & + & 0.75677e-06_r8,0.92925e-06_r8,0.11401e-05_r8,0.14107e-05_r8,0.16901e-05_r8 /) + kbo(:,20, 1) = (/ & + & 0.64614e-06_r8,0.79361e-06_r8,0.97353e-06_r8,0.11964e-05_r8,0.14414e-05_r8 /) + kbo(:,21, 1) = (/ & + & 0.55323e-06_r8,0.67580e-06_r8,0.82647e-06_r8,0.10137e-05_r8,0.12318e-05_r8 /) + kbo(:,22, 1) = (/ & + & 0.47719e-06_r8,0.58149e-06_r8,0.71060e-06_r8,0.87005e-06_r8,0.10605e-05_r8 /) + kbo(:,23, 1) = (/ & + & 0.41128e-06_r8,0.50080e-06_r8,0.61104e-06_r8,0.75347e-06_r8,0.91200e-06_r8 /) + kbo(:,24, 1) = (/ & + & 0.35306e-06_r8,0.42860e-06_r8,0.52320e-06_r8,0.65156e-06_r8,0.78122e-06_r8 /) + kbo(:,25, 1) = (/ & + & 0.30363e-06_r8,0.36731e-06_r8,0.44673e-06_r8,0.56097e-06_r8,0.66791e-06_r8 /) + kbo(:,26, 1) = (/ & + & 0.26073e-06_r8,0.31537e-06_r8,0.38738e-06_r8,0.48210e-06_r8,0.57382e-06_r8 /) + kbo(:,27, 1) = (/ & + & 0.22303e-06_r8,0.26986e-06_r8,0.33628e-06_r8,0.41161e-06_r8,0.48722e-06_r8 /) + kbo(:,28, 1) = (/ & + & 0.18954e-06_r8,0.22952e-06_r8,0.28797e-06_r8,0.35166e-06_r8,0.41440e-06_r8 /) + kbo(:,29, 1) = (/ & + & 0.16106e-06_r8,0.19430e-06_r8,0.24661e-06_r8,0.29815e-06_r8,0.35151e-06_r8 /) + kbo(:,30, 1) = (/ & + & 0.13630e-06_r8,0.16528e-06_r8,0.20922e-06_r8,0.25193e-06_r8,0.29913e-06_r8 /) + kbo(:,31, 1) = (/ & + & 0.11504e-06_r8,0.14276e-06_r8,0.17807e-06_r8,0.21482e-06_r8,0.25451e-06_r8 /) + kbo(:,32, 1) = (/ & + & 0.96980e-07_r8,0.12215e-06_r8,0.15159e-06_r8,0.18179e-06_r8,0.21515e-06_r8 /) + kbo(:,33, 1) = (/ & + & 0.81598e-07_r8,0.10315e-06_r8,0.12730e-06_r8,0.15190e-06_r8,0.18093e-06_r8 /) + kbo(:,34, 1) = (/ & + & 0.67700e-07_r8,0.85970e-07_r8,0.10559e-06_r8,0.12608e-06_r8,0.15006e-06_r8 /) + kbo(:,35, 1) = (/ & + & 0.55177e-07_r8,0.69519e-07_r8,0.85967e-07_r8,0.10223e-06_r8,0.12147e-06_r8 /) + kbo(:,36, 1) = (/ & + & 0.43924e-07_r8,0.54395e-07_r8,0.67998e-07_r8,0.81142e-07_r8,0.95717e-07_r8 /) + kbo(:,37, 1) = (/ & + & 0.34469e-07_r8,0.41036e-07_r8,0.52575e-07_r8,0.63117e-07_r8,0.74301e-07_r8 /) + kbo(:,38, 1) = (/ & + & 0.26777e-07_r8,0.31734e-07_r8,0.40555e-07_r8,0.49032e-07_r8,0.57653e-07_r8 /) + kbo(:,39, 1) = (/ & + & 0.20670e-07_r8,0.24721e-07_r8,0.30685e-07_r8,0.37873e-07_r8,0.44555e-07_r8 /) + kbo(:,40, 1) = (/ & + & 0.15860e-07_r8,0.19032e-07_r8,0.22612e-07_r8,0.28845e-07_r8,0.34246e-07_r8 /) + kbo(:,41, 1) = (/ & + & 0.12129e-07_r8,0.14603e-07_r8,0.17357e-07_r8,0.21851e-07_r8,0.26346e-07_r8 /) + kbo(:,42, 1) = (/ & + & 0.92319e-08_r8,0.11199e-07_r8,0.13365e-07_r8,0.16174e-07_r8,0.20019e-07_r8 /) + kbo(:,43, 1) = (/ & + & 0.69289e-08_r8,0.84537e-08_r8,0.10159e-07_r8,0.11992e-07_r8,0.14940e-07_r8 /) + kbo(:,44, 1) = (/ & + & 0.51546e-08_r8,0.63380e-08_r8,0.76593e-08_r8,0.90562e-08_r8,0.10716e-07_r8 /) + kbo(:,45, 1) = (/ & + & 0.38335e-08_r8,0.47085e-08_r8,0.57219e-08_r8,0.68148e-08_r8,0.79518e-08_r8 /) + kbo(:,46, 1) = (/ & + & 0.28583e-08_r8,0.34724e-08_r8,0.42447e-08_r8,0.50888e-08_r8,0.59494e-08_r8 /) + kbo(:,47, 1) = (/ & + & 0.20945e-08_r8,0.25418e-08_r8,0.31058e-08_r8,0.37494e-08_r8,0.44274e-08_r8 /) + kbo(:,48, 1) = (/ & + & 0.15164e-08_r8,0.18560e-08_r8,0.22628e-08_r8,0.27371e-08_r8,0.32773e-08_r8 /) + kbo(:,49, 1) = (/ & + & 0.10916e-08_r8,0.13465e-08_r8,0.16387e-08_r8,0.19740e-08_r8,0.23865e-08_r8 /) + kbo(:,50, 1) = (/ & + & 0.78324e-09_r8,0.98361e-09_r8,0.11977e-08_r8,0.14517e-08_r8,0.17457e-08_r8 /) + kbo(:,51, 1) = (/ & + & 0.57263e-09_r8,0.71786e-09_r8,0.87689e-09_r8,0.10705e-08_r8,0.12881e-08_r8 /) + kbo(:,52, 1) = (/ & + & 0.41574e-09_r8,0.51264e-09_r8,0.64152e-09_r8,0.78315e-09_r8,0.94705e-09_r8 /) + kbo(:,53, 1) = (/ & + & 0.29940e-09_r8,0.36836e-09_r8,0.45886e-09_r8,0.56405e-09_r8,0.69166e-09_r8 /) + kbo(:,54, 1) = (/ & + & 0.22617e-09_r8,0.27395e-09_r8,0.33754e-09_r8,0.42095e-09_r8,0.51544e-09_r8 /) + kbo(:,55, 1) = (/ & + & 0.17483e-09_r8,0.20845e-09_r8,0.25546e-09_r8,0.31817e-09_r8,0.39119e-09_r8 /) + kbo(:,56, 1) = (/ & + & 0.13496e-09_r8,0.15930e-09_r8,0.19380e-09_r8,0.23861e-09_r8,0.29770e-09_r8 /) + kbo(:,57, 1) = (/ & + & 0.10406e-09_r8,0.12247e-09_r8,0.14749e-09_r8,0.18078e-09_r8,0.22597e-09_r8 /) + kbo(:,58, 1) = (/ & + & 0.81345e-10_r8,0.94816e-10_r8,0.11329e-09_r8,0.13832e-09_r8,0.17161e-09_r8 /) + kbo(:,59, 1) = (/ & + & 0.67159e-10_r8,0.78312e-10_r8,0.94745e-10_r8,0.11544e-09_r8,0.14442e-09_r8 /) + kbo(:,13, 2) = (/ & + & 0.16654e-04_r8,0.18728e-04_r8,0.21238e-04_r8,0.24491e-04_r8,0.29038e-04_r8 /) + kbo(:,14, 2) = (/ & + & 0.15636e-04_r8,0.17574e-04_r8,0.19918e-04_r8,0.23671e-04_r8,0.27237e-04_r8 /) + kbo(:,15, 2) = (/ & + & 0.14853e-04_r8,0.16629e-04_r8,0.19700e-04_r8,0.22604e-04_r8,0.25586e-04_r8 /) + kbo(:,16, 2) = (/ & + & 0.13519e-04_r8,0.15923e-04_r8,0.18289e-04_r8,0.20530e-04_r8,0.22799e-04_r8 /) + kbo(:,17, 2) = (/ & + & 0.12411e-04_r8,0.14439e-04_r8,0.16431e-04_r8,0.18235e-04_r8,0.20109e-04_r8 /) + kbo(:,18, 2) = (/ & + & 0.11267e-04_r8,0.12880e-04_r8,0.14429e-04_r8,0.16005e-04_r8,0.17538e-04_r8 /) + kbo(:,19, 2) = (/ & + & 0.10025e-04_r8,0.11332e-04_r8,0.12550e-04_r8,0.13853e-04_r8,0.15103e-04_r8 /) + kbo(:,20, 2) = (/ & + & 0.86342e-05_r8,0.97455e-05_r8,0.10778e-04_r8,0.11898e-04_r8,0.12789e-04_r8 /) + kbo(:,21, 2) = (/ & + & 0.74004e-05_r8,0.83107e-05_r8,0.91633e-05_r8,0.10071e-04_r8,0.10674e-04_r8 /) + kbo(:,22, 2) = (/ & + & 0.63700e-05_r8,0.70549e-05_r8,0.78271e-05_r8,0.85170e-05_r8,0.90022e-05_r8 /) + kbo(:,23, 2) = (/ & + & 0.54404e-05_r8,0.60156e-05_r8,0.66393e-05_r8,0.71320e-05_r8,0.75007e-05_r8 /) + kbo(:,24, 2) = (/ & + & 0.45997e-05_r8,0.50718e-05_r8,0.55713e-05_r8,0.59455e-05_r8,0.62118e-05_r8 /) + kbo(:,25, 2) = (/ & + & 0.38745e-05_r8,0.42617e-05_r8,0.46479e-05_r8,0.49297e-05_r8,0.51638e-05_r8 /) + kbo(:,26, 2) = (/ & + & 0.32488e-05_r8,0.35592e-05_r8,0.38685e-05_r8,0.40759e-05_r8,0.43092e-05_r8 /) + kbo(:,27, 2) = (/ & + & 0.26995e-05_r8,0.29601e-05_r8,0.32065e-05_r8,0.33666e-05_r8,0.35609e-05_r8 /) + kbo(:,28, 2) = (/ & + & 0.22359e-05_r8,0.24429e-05_r8,0.26408e-05_r8,0.27752e-05_r8,0.29293e-05_r8 /) + kbo(:,29, 2) = (/ & + & 0.18487e-05_r8,0.20089e-05_r8,0.21668e-05_r8,0.22793e-05_r8,0.24029e-05_r8 /) + kbo(:,30, 2) = (/ & + & 0.15291e-05_r8,0.16589e-05_r8,0.17733e-05_r8,0.18706e-05_r8,0.19584e-05_r8 /) + kbo(:,31, 2) = (/ & + & 0.12554e-05_r8,0.13589e-05_r8,0.14436e-05_r8,0.15195e-05_r8,0.15928e-05_r8 /) + kbo(:,32, 2) = (/ & + & 0.10248e-05_r8,0.11046e-05_r8,0.11716e-05_r8,0.12288e-05_r8,0.12916e-05_r8 /) + kbo(:,33, 2) = (/ & + & 0.83272e-06_r8,0.89120e-06_r8,0.95036e-06_r8,0.99040e-06_r8,0.10409e-05_r8 /) + kbo(:,34, 2) = (/ & + & 0.67518e-06_r8,0.72097e-06_r8,0.76854e-06_r8,0.80246e-06_r8,0.83912e-06_r8 /) + kbo(:,35, 2) = (/ & + & 0.53577e-06_r8,0.57870e-06_r8,0.61715e-06_r8,0.64987e-06_r8,0.67220e-06_r8 /) + kbo(:,36, 2) = (/ & + & 0.42402e-06_r8,0.45825e-06_r8,0.49307e-06_r8,0.52005e-06_r8,0.54029e-06_r8 /) + kbo(:,37, 2) = (/ & + & 0.33419e-06_r8,0.36213e-06_r8,0.38911e-06_r8,0.41359e-06_r8,0.43177e-06_r8 /) + kbo(:,38, 2) = (/ & + & 0.26240e-06_r8,0.28355e-06_r8,0.30530e-06_r8,0.32881e-06_r8,0.34617e-06_r8 /) + kbo(:,39, 2) = (/ & + & 0.20468e-06_r8,0.22245e-06_r8,0.23980e-06_r8,0.25776e-06_r8,0.27424e-06_r8 /) + kbo(:,40, 2) = (/ & + & 0.16070e-06_r8,0.17478e-06_r8,0.18856e-06_r8,0.20230e-06_r8,0.21801e-06_r8 /) + kbo(:,41, 2) = (/ & + & 0.12583e-06_r8,0.13680e-06_r8,0.14851e-06_r8,0.15917e-06_r8,0.17184e-06_r8 /) + kbo(:,42, 2) = (/ & + & 0.98494e-07_r8,0.10639e-06_r8,0.11634e-06_r8,0.12500e-06_r8,0.13490e-06_r8 /) + kbo(:,43, 2) = (/ & + & 0.75196e-07_r8,0.82809e-07_r8,0.90095e-07_r8,0.97952e-07_r8,0.10509e-06_r8 /) + kbo(:,44, 2) = (/ & + & 0.57305e-07_r8,0.63787e-07_r8,0.69227e-07_r8,0.75635e-07_r8,0.81687e-07_r8 /) + kbo(:,45, 2) = (/ & + & 0.42965e-07_r8,0.48245e-07_r8,0.53346e-07_r8,0.58061e-07_r8,0.63120e-07_r8 /) + kbo(:,46, 2) = (/ & + & 0.31048e-07_r8,0.36457e-07_r8,0.40514e-07_r8,0.44557e-07_r8,0.48550e-07_r8 /) + kbo(:,47, 2) = (/ & + & 0.23094e-07_r8,0.26356e-07_r8,0.30443e-07_r8,0.33954e-07_r8,0.36789e-07_r8 /) + kbo(:,48, 2) = (/ & + & 0.16858e-07_r8,0.19402e-07_r8,0.22449e-07_r8,0.25401e-07_r8,0.28254e-07_r8 /) + kbo(:,49, 2) = (/ & + & 0.11413e-07_r8,0.14055e-07_r8,0.16046e-07_r8,0.18927e-07_r8,0.21080e-07_r8 /) + kbo(:,50, 2) = (/ & + & 0.78650e-08_r8,0.99879e-08_r8,0.11846e-07_r8,0.13654e-07_r8,0.15871e-07_r8 /) + kbo(:,51, 2) = (/ & + & 0.55417e-08_r8,0.68977e-08_r8,0.87006e-08_r8,0.10108e-07_r8,0.11829e-07_r8 /) + kbo(:,52, 2) = (/ & + & 0.39143e-08_r8,0.48025e-08_r8,0.60180e-08_r8,0.73762e-08_r8,0.85851e-08_r8 /) + kbo(:,53, 2) = (/ & + & 0.27637e-08_r8,0.33397e-08_r8,0.41996e-08_r8,0.52787e-08_r8,0.62923e-08_r8 /) + kbo(:,54, 2) = (/ & + & 0.19691e-08_r8,0.24529e-08_r8,0.30071e-08_r8,0.38041e-08_r8,0.46981e-08_r8 /) + kbo(:,55, 2) = (/ & + & 0.13034e-08_r8,0.18257e-08_r8,0.22359e-08_r8,0.28210e-08_r8,0.35386e-08_r8 /) + kbo(:,56, 2) = (/ & + & 0.10026e-08_r8,0.13422e-08_r8,0.16687e-08_r8,0.20793e-08_r8,0.26054e-08_r8 /) + kbo(:,57, 2) = (/ & + & 0.77730e-09_r8,0.91190e-09_r8,0.12468e-08_r8,0.15302e-08_r8,0.19418e-08_r8 /) + kbo(:,58, 2) = (/ & + & 0.60359e-09_r8,0.67848e-09_r8,0.92414e-09_r8,0.11511e-08_r8,0.14401e-08_r8 /) + kbo(:,59, 2) = (/ & + & 0.50441e-09_r8,0.56797e-09_r8,0.77369e-09_r8,0.95612e-09_r8,0.11957e-08_r8 /) + kbo(:,13, 3) = (/ & + & 0.98124e-04_r8,0.10149e-03_r8,0.10303e-03_r8,0.10669e-03_r8,0.10870e-03_r8 /) + kbo(:,14, 3) = (/ & + & 0.88110e-04_r8,0.89730e-04_r8,0.90679e-04_r8,0.91892e-04_r8,0.91413e-04_r8 /) + kbo(:,15, 3) = (/ & + & 0.78555e-04_r8,0.78633e-04_r8,0.79145e-04_r8,0.77689e-04_r8,0.77791e-04_r8 /) + kbo(:,16, 3) = (/ & + & 0.67245e-04_r8,0.67743e-04_r8,0.66690e-04_r8,0.65765e-04_r8,0.65950e-04_r8 /) + kbo(:,17, 3) = (/ & + & 0.57553e-04_r8,0.57490e-04_r8,0.56012e-04_r8,0.55634e-04_r8,0.56016e-04_r8 /) + kbo(:,18, 3) = (/ & + & 0.49729e-04_r8,0.48302e-04_r8,0.47418e-04_r8,0.47262e-04_r8,0.47732e-04_r8 /) + kbo(:,19, 3) = (/ & + & 0.42101e-04_r8,0.40906e-04_r8,0.40541e-04_r8,0.40229e-04_r8,0.40671e-04_r8 /) + kbo(:,20, 3) = (/ & + & 0.35046e-04_r8,0.34193e-04_r8,0.34032e-04_r8,0.33881e-04_r8,0.34691e-04_r8 /) + kbo(:,21, 3) = (/ & + & 0.29192e-04_r8,0.28813e-04_r8,0.28525e-04_r8,0.28485e-04_r8,0.29764e-04_r8 /) + kbo(:,22, 3) = (/ & + & 0.24212e-04_r8,0.23970e-04_r8,0.23804e-04_r8,0.23947e-04_r8,0.24310e-04_r8 /) + kbo(:,23, 3) = (/ & + & 0.20167e-04_r8,0.19961e-04_r8,0.19837e-04_r8,0.20528e-04_r8,0.19887e-04_r8 /) + kbo(:,24, 3) = (/ & + & 0.16817e-04_r8,0.16624e-04_r8,0.16525e-04_r8,0.17263e-04_r8,0.16481e-04_r8 /) + kbo(:,25, 3) = (/ & + & 0.13896e-04_r8,0.13806e-04_r8,0.13810e-04_r8,0.14348e-04_r8,0.13634e-04_r8 /) + kbo(:,26, 3) = (/ & + & 0.11515e-04_r8,0.11474e-04_r8,0.11553e-04_r8,0.11705e-04_r8,0.11167e-04_r8 /) + kbo(:,27, 3) = (/ & + & 0.95004e-05_r8,0.94543e-05_r8,0.95650e-05_r8,0.95316e-05_r8,0.91651e-05_r8 /) + kbo(:,28, 3) = (/ & + & 0.78135e-05_r8,0.77862e-05_r8,0.78715e-05_r8,0.77825e-05_r8,0.74877e-05_r8 /) + kbo(:,29, 3) = (/ & + & 0.63615e-05_r8,0.63601e-05_r8,0.64198e-05_r8,0.63507e-05_r8,0.61200e-05_r8 /) + kbo(:,30, 3) = (/ & + & 0.51738e-05_r8,0.51781e-05_r8,0.52250e-05_r8,0.51709e-05_r8,0.50243e-05_r8 /) + kbo(:,31, 3) = (/ & + & 0.41825e-05_r8,0.42240e-05_r8,0.42510e-05_r8,0.42241e-05_r8,0.41058e-05_r8 /) + kbo(:,32, 3) = (/ & + & 0.34024e-05_r8,0.34302e-05_r8,0.34514e-05_r8,0.34436e-05_r8,0.33474e-05_r8 /) + kbo(:,33, 3) = (/ & + & 0.27510e-05_r8,0.27828e-05_r8,0.28059e-05_r8,0.28125e-05_r8,0.27394e-05_r8 /) + kbo(:,34, 3) = (/ & + & 0.22195e-05_r8,0.22517e-05_r8,0.22743e-05_r8,0.22728e-05_r8,0.22254e-05_r8 /) + kbo(:,35, 3) = (/ & + & 0.18029e-05_r8,0.18238e-05_r8,0.18432e-05_r8,0.18461e-05_r8,0.18241e-05_r8 /) + kbo(:,36, 3) = (/ & + & 0.14477e-05_r8,0.14734e-05_r8,0.14936e-05_r8,0.15116e-05_r8,0.14874e-05_r8 /) + kbo(:,37, 3) = (/ & + & 0.11637e-05_r8,0.11929e-05_r8,0.12098e-05_r8,0.12265e-05_r8,0.12076e-05_r8 /) + kbo(:,38, 3) = (/ & + & 0.93292e-06_r8,0.96246e-06_r8,0.98169e-06_r8,0.99435e-06_r8,0.98749e-06_r8 /) + kbo(:,39, 3) = (/ & + & 0.74927e-06_r8,0.76742e-06_r8,0.79020e-06_r8,0.80604e-06_r8,0.81415e-06_r8 /) + kbo(:,40, 3) = (/ & + & 0.60479e-06_r8,0.61743e-06_r8,0.63973e-06_r8,0.65295e-06_r8,0.66261e-06_r8 /) + kbo(:,41, 3) = (/ & + & 0.48450e-06_r8,0.49742e-06_r8,0.51366e-06_r8,0.52876e-06_r8,0.53813e-06_r8 /) + kbo(:,42, 3) = (/ & + & 0.38298e-06_r8,0.40088e-06_r8,0.41192e-06_r8,0.42651e-06_r8,0.43595e-06_r8 /) + kbo(:,43, 3) = (/ & + & 0.30310e-06_r8,0.31905e-06_r8,0.32907e-06_r8,0.34154e-06_r8,0.35007e-06_r8 /) + kbo(:,44, 3) = (/ & + & 0.23745e-06_r8,0.25035e-06_r8,0.26224e-06_r8,0.27145e-06_r8,0.28146e-06_r8 /) + kbo(:,45, 3) = (/ & + & 0.18653e-06_r8,0.19510e-06_r8,0.20644e-06_r8,0.21510e-06_r8,0.22354e-06_r8 /) + kbo(:,46, 3) = (/ & + & 0.14759e-06_r8,0.15322e-06_r8,0.16145e-06_r8,0.17034e-06_r8,0.17744e-06_r8 /) + kbo(:,47, 3) = (/ & + & 0.11410e-06_r8,0.12007e-06_r8,0.12507e-06_r8,0.13237e-06_r8,0.13995e-06_r8 /) + kbo(:,48, 3) = (/ & + & 0.88327e-07_r8,0.93967e-07_r8,0.97683e-07_r8,0.10257e-06_r8,0.10921e-06_r8 /) + kbo(:,49, 3) = (/ & + & 0.66715e-07_r8,0.72172e-07_r8,0.76442e-07_r8,0.79214e-07_r8,0.84006e-07_r8 /) + kbo(:,50, 3) = (/ & + & 0.51458e-07_r8,0.55761e-07_r8,0.59239e-07_r8,0.62292e-07_r8,0.64470e-07_r8 /) + kbo(:,51, 3) = (/ & + & 0.39957e-07_r8,0.42400e-07_r8,0.45870e-07_r8,0.48592e-07_r8,0.50287e-07_r8 /) + kbo(:,52, 3) = (/ & + & 0.31150e-07_r8,0.32725e-07_r8,0.35598e-07_r8,0.37633e-07_r8,0.39607e-07_r8 /) + kbo(:,53, 3) = (/ & + & 0.23783e-07_r8,0.25415e-07_r8,0.26634e-07_r8,0.28885e-07_r8,0.30620e-07_r8 /) + kbo(:,54, 3) = (/ & + & 0.18531e-07_r8,0.19938e-07_r8,0.20988e-07_r8,0.22678e-07_r8,0.23867e-07_r8 /) + kbo(:,55, 3) = (/ & + & 0.14810e-07_r8,0.15772e-07_r8,0.16651e-07_r8,0.17727e-07_r8,0.18861e-07_r8 /) + kbo(:,56, 3) = (/ & + & 0.11652e-07_r8,0.12557e-07_r8,0.13319e-07_r8,0.13930e-07_r8,0.15077e-07_r8 /) + kbo(:,57, 3) = (/ & + & 0.91523e-08_r8,0.99835e-08_r8,0.10603e-07_r8,0.11081e-07_r8,0.11999e-07_r8 /) + kbo(:,58, 3) = (/ & + & 0.72383e-08_r8,0.79060e-08_r8,0.84489e-08_r8,0.88615e-08_r8,0.94456e-08_r8 /) + kbo(:,59, 3) = (/ & + & 0.60315e-08_r8,0.65931e-08_r8,0.71001e-08_r8,0.74012e-08_r8,0.78761e-08_r8 /) + kbo(:,13, 4) = (/ & + & 0.21882e-03_r8,0.20968e-03_r8,0.18648e-03_r8,0.17505e-03_r8,0.17320e-03_r8 /) + kbo(:,14, 4) = (/ & + & 0.19140e-03_r8,0.17026e-03_r8,0.15903e-03_r8,0.15552e-03_r8,0.16009e-03_r8 /) + kbo(:,15, 4) = (/ & + & 0.16003e-03_r8,0.14531e-03_r8,0.14007e-03_r8,0.14511e-03_r8,0.14619e-03_r8 /) + kbo(:,16, 4) = (/ & + & 0.13387e-03_r8,0.12423e-03_r8,0.12444e-03_r8,0.12743e-03_r8,0.12749e-03_r8 /) + kbo(:,17, 4) = (/ & + & 0.11266e-03_r8,0.10780e-03_r8,0.11110e-03_r8,0.11051e-03_r8,0.11075e-03_r8 /) + kbo(:,18, 4) = (/ & + & 0.96156e-04_r8,0.95617e-04_r8,0.96775e-04_r8,0.96220e-04_r8,0.96078e-04_r8 /) + kbo(:,19, 4) = (/ & + & 0.82712e-04_r8,0.82946e-04_r8,0.83265e-04_r8,0.82827e-04_r8,0.82044e-04_r8 /) + kbo(:,20, 4) = (/ & + & 0.71080e-04_r8,0.71167e-04_r8,0.71040e-04_r8,0.70443e-04_r8,0.69069e-04_r8 /) + kbo(:,21, 4) = (/ & + & 0.60110e-04_r8,0.60836e-04_r8,0.59994e-04_r8,0.58992e-04_r8,0.57237e-04_r8 /) + kbo(:,22, 4) = (/ & + & 0.50688e-04_r8,0.51296e-04_r8,0.50271e-04_r8,0.48889e-04_r8,0.48471e-04_r8 /) + kbo(:,23, 4) = (/ & + & 0.42706e-04_r8,0.42628e-04_r8,0.41764e-04_r8,0.39999e-04_r8,0.40893e-04_r8 /) + kbo(:,24, 4) = (/ & + & 0.35803e-04_r8,0.35316e-04_r8,0.34535e-04_r8,0.33229e-04_r8,0.34127e-04_r8 /) + kbo(:,25, 4) = (/ & + & 0.29906e-04_r8,0.29201e-04_r8,0.28336e-04_r8,0.27455e-04_r8,0.28044e-04_r8 /) + kbo(:,26, 4) = (/ & + & 0.24659e-04_r8,0.23926e-04_r8,0.23159e-04_r8,0.22827e-04_r8,0.23266e-04_r8 /) + kbo(:,27, 4) = (/ & + & 0.20221e-04_r8,0.19578e-04_r8,0.18838e-04_r8,0.18853e-04_r8,0.19067e-04_r8 /) + kbo(:,28, 4) = (/ & + & 0.16345e-04_r8,0.15913e-04_r8,0.15327e-04_r8,0.15412e-04_r8,0.15560e-04_r8 /) + kbo(:,29, 4) = (/ & + & 0.13195e-04_r8,0.12870e-04_r8,0.12430e-04_r8,0.12518e-04_r8,0.12639e-04_r8 /) + kbo(:,30, 4) = (/ & + & 0.10622e-04_r8,0.10384e-04_r8,0.10068e-04_r8,0.10151e-04_r8,0.10256e-04_r8 /) + kbo(:,31, 4) = (/ & + & 0.85785e-05_r8,0.83523e-05_r8,0.81227e-05_r8,0.81998e-05_r8,0.83313e-05_r8 /) + kbo(:,32, 4) = (/ & + & 0.69114e-05_r8,0.67093e-05_r8,0.65758e-05_r8,0.66222e-05_r8,0.67679e-05_r8 /) + kbo(:,33, 4) = (/ & + & 0.55456e-05_r8,0.54342e-05_r8,0.53229e-05_r8,0.53610e-05_r8,0.54819e-05_r8 /) + kbo(:,34, 4) = (/ & + & 0.44461e-05_r8,0.43891e-05_r8,0.43112e-05_r8,0.43632e-05_r8,0.44560e-05_r8 /) + kbo(:,35, 4) = (/ & + & 0.35725e-05_r8,0.35192e-05_r8,0.34703e-05_r8,0.35075e-05_r8,0.35919e-05_r8 /) + kbo(:,36, 4) = (/ & + & 0.28842e-05_r8,0.28362e-05_r8,0.28143e-05_r8,0.28097e-05_r8,0.29057e-05_r8 /) + kbo(:,37, 4) = (/ & + & 0.23374e-05_r8,0.22987e-05_r8,0.22934e-05_r8,0.22812e-05_r8,0.23451e-05_r8 /) + kbo(:,38, 4) = (/ & + & 0.18966e-05_r8,0.18679e-05_r8,0.18613e-05_r8,0.18437e-05_r8,0.18894e-05_r8 /) + kbo(:,39, 4) = (/ & + & 0.15300e-05_r8,0.15180e-05_r8,0.15096e-05_r8,0.14915e-05_r8,0.15107e-05_r8 /) + kbo(:,40, 4) = (/ & + & 0.12426e-05_r8,0.12357e-05_r8,0.12171e-05_r8,0.12170e-05_r8,0.12227e-05_r8 /) + kbo(:,41, 4) = (/ & + & 0.10102e-05_r8,0.10077e-05_r8,0.98593e-06_r8,0.98478e-06_r8,0.99213e-06_r8 /) + kbo(:,42, 4) = (/ & + & 0.82201e-06_r8,0.81050e-06_r8,0.80313e-06_r8,0.80181e-06_r8,0.80361e-06_r8 /) + kbo(:,43, 4) = (/ & + & 0.67318e-06_r8,0.65347e-06_r8,0.65478e-06_r8,0.64360e-06_r8,0.64722e-06_r8 /) + kbo(:,44, 4) = (/ & + & 0.55598e-06_r8,0.53355e-06_r8,0.52778e-06_r8,0.52097e-06_r8,0.51997e-06_r8 /) + kbo(:,45, 4) = (/ & + & 0.46157e-06_r8,0.43457e-06_r8,0.42412e-06_r8,0.42137e-06_r8,0.41750e-06_r8 /) + kbo(:,46, 4) = (/ & + & 0.39156e-06_r8,0.35690e-06_r8,0.34498e-06_r8,0.33995e-06_r8,0.33614e-06_r8 /) + kbo(:,47, 4) = (/ & + & 0.33392e-06_r8,0.29746e-06_r8,0.28074e-06_r8,0.27344e-06_r8,0.27079e-06_r8 /) + kbo(:,48, 4) = (/ & + & 0.27066e-06_r8,0.25369e-06_r8,0.23115e-06_r8,0.22213e-06_r8,0.21766e-06_r8 /) + kbo(:,49, 4) = (/ & + & 0.22198e-06_r8,0.21395e-06_r8,0.19274e-06_r8,0.18040e-06_r8,0.17542e-06_r8 /) + kbo(:,50, 4) = (/ & + & 0.18070e-06_r8,0.17367e-06_r8,0.16473e-06_r8,0.14916e-06_r8,0.14306e-06_r8 /) + kbo(:,51, 4) = (/ & + & 0.14595e-06_r8,0.14287e-06_r8,0.13847e-06_r8,0.12418e-06_r8,0.11697e-06_r8 /) + kbo(:,52, 4) = (/ & + & 0.11819e-06_r8,0.11588e-06_r8,0.11225e-06_r8,0.10604e-06_r8,0.96269e-07_r8 /) + kbo(:,53, 4) = (/ & + & 0.95028e-07_r8,0.93094e-07_r8,0.91303e-07_r8,0.88900e-07_r8,0.80262e-07_r8 /) + kbo(:,54, 4) = (/ & + & 0.77005e-07_r8,0.76238e-07_r8,0.74228e-07_r8,0.72526e-07_r8,0.67965e-07_r8 /) + kbo(:,55, 4) = (/ & + & 0.62979e-07_r8,0.62692e-07_r8,0.60930e-07_r8,0.59579e-07_r8,0.57700e-07_r8 /) + kbo(:,56, 4) = (/ & + & 0.51571e-07_r8,0.51196e-07_r8,0.50031e-07_r8,0.48916e-07_r8,0.48127e-07_r8 /) + kbo(:,57, 4) = (/ & + & 0.42602e-07_r8,0.41678e-07_r8,0.41006e-07_r8,0.39709e-07_r8,0.39283e-07_r8 /) + kbo(:,58, 4) = (/ & + & 0.35155e-07_r8,0.34052e-07_r8,0.33561e-07_r8,0.32395e-07_r8,0.32057e-07_r8 /) + kbo(:,59, 4) = (/ & + & 0.29318e-07_r8,0.28516e-07_r8,0.28097e-07_r8,0.26888e-07_r8,0.26840e-07_r8 /) + kbo(:,13, 5) = (/ & + & 0.43718e-03_r8,0.42279e-03_r8,0.43200e-03_r8,0.42910e-03_r8,0.42775e-03_r8 /) + kbo(:,14, 5) = (/ & + & 0.37902e-03_r8,0.38090e-03_r8,0.38058e-03_r8,0.37637e-03_r8,0.36798e-03_r8 /) + kbo(:,15, 5) = (/ & + & 0.33222e-03_r8,0.33597e-03_r8,0.33205e-03_r8,0.32000e-03_r8,0.31310e-03_r8 /) + kbo(:,16, 5) = (/ & + & 0.28736e-03_r8,0.28700e-03_r8,0.27853e-03_r8,0.26891e-03_r8,0.26391e-03_r8 /) + kbo(:,17, 5) = (/ & + & 0.24534e-03_r8,0.24098e-03_r8,0.23072e-03_r8,0.22519e-03_r8,0.22013e-03_r8 /) + kbo(:,18, 5) = (/ & + & 0.20645e-03_r8,0.20019e-03_r8,0.19266e-03_r8,0.18716e-03_r8,0.18139e-03_r8 /) + kbo(:,19, 5) = (/ & + & 0.17271e-03_r8,0.16642e-03_r8,0.16064e-03_r8,0.15556e-03_r8,0.14951e-03_r8 /) + kbo(:,20, 5) = (/ & + & 0.14266e-03_r8,0.13766e-03_r8,0.13239e-03_r8,0.12767e-03_r8,0.12305e-03_r8 /) + kbo(:,21, 5) = (/ & + & 0.11797e-03_r8,0.11256e-03_r8,0.10880e-03_r8,0.10424e-03_r8,0.10062e-03_r8 /) + kbo(:,22, 5) = (/ & + & 0.97085e-04_r8,0.92101e-04_r8,0.88420e-04_r8,0.85535e-04_r8,0.82201e-04_r8 /) + kbo(:,23, 5) = (/ & + & 0.79380e-04_r8,0.75312e-04_r8,0.72177e-04_r8,0.69710e-04_r8,0.66966e-04_r8 /) + kbo(:,24, 5) = (/ & + & 0.64591e-04_r8,0.61520e-04_r8,0.58891e-04_r8,0.56626e-04_r8,0.54603e-04_r8 /) + kbo(:,25, 5) = (/ & + & 0.52423e-04_r8,0.49934e-04_r8,0.48122e-04_r8,0.46331e-04_r8,0.44875e-04_r8 /) + kbo(:,26, 5) = (/ & + & 0.42528e-04_r8,0.40739e-04_r8,0.39218e-04_r8,0.37806e-04_r8,0.36631e-04_r8 /) + kbo(:,27, 5) = (/ & + & 0.34453e-04_r8,0.33104e-04_r8,0.32009e-04_r8,0.30764e-04_r8,0.30000e-04_r8 /) + kbo(:,28, 5) = (/ & + & 0.28076e-04_r8,0.26948e-04_r8,0.26097e-04_r8,0.25065e-04_r8,0.24596e-04_r8 /) + kbo(:,29, 5) = (/ & + & 0.22814e-04_r8,0.21902e-04_r8,0.21222e-04_r8,0.20350e-04_r8,0.20152e-04_r8 /) + kbo(:,30, 5) = (/ & + & 0.18551e-04_r8,0.17731e-04_r8,0.17162e-04_r8,0.16614e-04_r8,0.16461e-04_r8 /) + kbo(:,31, 5) = (/ & + & 0.15020e-04_r8,0.14383e-04_r8,0.13922e-04_r8,0.13548e-04_r8,0.13388e-04_r8 /) + kbo(:,32, 5) = (/ & + & 0.12091e-04_r8,0.11653e-04_r8,0.11308e-04_r8,0.11033e-04_r8,0.10954e-04_r8 /) + kbo(:,33, 5) = (/ & + & 0.97901e-05_r8,0.93570e-05_r8,0.91428e-05_r8,0.89594e-05_r8,0.89614e-05_r8 /) + kbo(:,34, 5) = (/ & + & 0.79439e-05_r8,0.76095e-05_r8,0.74365e-05_r8,0.73099e-05_r8,0.73269e-05_r8 /) + kbo(:,35, 5) = (/ & + & 0.64505e-05_r8,0.62326e-05_r8,0.60921e-05_r8,0.59939e-05_r8,0.59799e-05_r8 /) + kbo(:,36, 5) = (/ & + & 0.52745e-05_r8,0.51017e-05_r8,0.49658e-05_r8,0.48988e-05_r8,0.48773e-05_r8 /) + kbo(:,37, 5) = (/ & + & 0.43522e-05_r8,0.42053e-05_r8,0.40681e-05_r8,0.40176e-05_r8,0.40058e-05_r8 /) + kbo(:,38, 5) = (/ & + & 0.35676e-05_r8,0.34559e-05_r8,0.33446e-05_r8,0.33017e-05_r8,0.32771e-05_r8 /) + kbo(:,39, 5) = (/ & + & 0.29238e-05_r8,0.28445e-05_r8,0.27512e-05_r8,0.27095e-05_r8,0.26825e-05_r8 /) + kbo(:,40, 5) = (/ & + & 0.23985e-05_r8,0.23437e-05_r8,0.22756e-05_r8,0.22251e-05_r8,0.22009e-05_r8 /) + kbo(:,41, 5) = (/ & + & 0.19763e-05_r8,0.19311e-05_r8,0.18886e-05_r8,0.18370e-05_r8,0.18072e-05_r8 /) + kbo(:,42, 5) = (/ & + & 0.16256e-05_r8,0.15918e-05_r8,0.15558e-05_r8,0.15108e-05_r8,0.14861e-05_r8 /) + kbo(:,43, 5) = (/ & + & 0.13290e-05_r8,0.13116e-05_r8,0.12833e-05_r8,0.12550e-05_r8,0.12262e-05_r8 /) + kbo(:,44, 5) = (/ & + & 0.10777e-05_r8,0.10760e-05_r8,0.10566e-05_r8,0.10365e-05_r8,0.10136e-05_r8 /) + kbo(:,45, 5) = (/ & + & 0.86690e-06_r8,0.87981e-06_r8,0.87044e-06_r8,0.85428e-06_r8,0.83627e-06_r8 /) + kbo(:,46, 5) = (/ & + & 0.68706e-06_r8,0.71088e-06_r8,0.70939e-06_r8,0.70110e-06_r8,0.69032e-06_r8 /) + kbo(:,47, 5) = (/ & + & 0.54665e-06_r8,0.56934e-06_r8,0.58033e-06_r8,0.57830e-06_r8,0.57105e-06_r8 /) + kbo(:,48, 5) = (/ & + & 0.44874e-06_r8,0.44653e-06_r8,0.46650e-06_r8,0.47090e-06_r8,0.46732e-06_r8 /) + kbo(:,49, 5) = (/ & + & 0.36869e-06_r8,0.35456e-06_r8,0.36842e-06_r8,0.37978e-06_r8,0.38217e-06_r8 /) + kbo(:,50, 5) = (/ & + & 0.30489e-06_r8,0.29229e-06_r8,0.29104e-06_r8,0.30430e-06_r8,0.31068e-06_r8 /) + kbo(:,51, 5) = (/ & + & 0.25290e-06_r8,0.24012e-06_r8,0.23271e-06_r8,0.24366e-06_r8,0.25149e-06_r8 /) + kbo(:,52, 5) = (/ & + & 0.21148e-06_r8,0.19715e-06_r8,0.19121e-06_r8,0.19177e-06_r8,0.20148e-06_r8 /) + kbo(:,53, 5) = (/ & + & 0.17334e-06_r8,0.16335e-06_r8,0.15574e-06_r8,0.15266e-06_r8,0.15921e-06_r8 /) + kbo(:,54, 5) = (/ & + & 0.14189e-06_r8,0.13650e-06_r8,0.12781e-06_r8,0.12535e-06_r8,0.12749e-06_r8 /) + kbo(:,55, 5) = (/ & + & 0.11763e-06_r8,0.11398e-06_r8,0.10627e-06_r8,0.10373e-06_r8,0.10268e-06_r8 /) + kbo(:,56, 5) = (/ & + & 0.98316e-07_r8,0.94892e-07_r8,0.88799e-07_r8,0.85036e-07_r8,0.83393e-07_r8 /) + kbo(:,57, 5) = (/ & + & 0.83049e-07_r8,0.78499e-07_r8,0.74140e-07_r8,0.70137e-07_r8,0.68774e-07_r8 /) + kbo(:,58, 5) = (/ & + & 0.71768e-07_r8,0.64682e-07_r8,0.62012e-07_r8,0.58149e-07_r8,0.57037e-07_r8 /) + kbo(:,59, 5) = (/ & + & 0.60166e-07_r8,0.54824e-07_r8,0.52042e-07_r8,0.49198e-07_r8,0.47862e-07_r8 /) + kbo(:,13, 6) = (/ & + & 0.71254e-03_r8,0.65708e-03_r8,0.60824e-03_r8,0.57965e-03_r8,0.55389e-03_r8 /) + kbo(:,14, 6) = (/ & + & 0.58852e-03_r8,0.54811e-03_r8,0.51125e-03_r8,0.48557e-03_r8,0.47730e-03_r8 /) + kbo(:,15, 6) = (/ & + & 0.50599e-03_r8,0.46869e-03_r8,0.44362e-03_r8,0.43503e-03_r8,0.43705e-03_r8 /) + kbo(:,16, 6) = (/ & + & 0.43493e-03_r8,0.40996e-03_r8,0.39680e-03_r8,0.39623e-03_r8,0.40784e-03_r8 /) + kbo(:,17, 6) = (/ & + & 0.38028e-03_r8,0.36175e-03_r8,0.35696e-03_r8,0.36547e-03_r8,0.38127e-03_r8 /) + kbo(:,18, 6) = (/ & + & 0.33113e-03_r8,0.32205e-03_r8,0.32458e-03_r8,0.33502e-03_r8,0.35577e-03_r8 /) + kbo(:,19, 6) = (/ & + & 0.28886e-03_r8,0.29134e-03_r8,0.29799e-03_r8,0.31134e-03_r8,0.33676e-03_r8 /) + kbo(:,20, 6) = (/ & + & 0.25113e-03_r8,0.25555e-03_r8,0.26535e-03_r8,0.28470e-03_r8,0.30677e-03_r8 /) + kbo(:,21, 6) = (/ & + & 0.21640e-03_r8,0.22152e-03_r8,0.23323e-03_r8,0.25467e-03_r8,0.27764e-03_r8 /) + kbo(:,22, 6) = (/ & + & 0.18601e-03_r8,0.19217e-03_r8,0.20696e-03_r8,0.22593e-03_r8,0.24729e-03_r8 /) + kbo(:,23, 6) = (/ & + & 0.15978e-03_r8,0.16833e-03_r8,0.18229e-03_r8,0.19994e-03_r8,0.21913e-03_r8 /) + kbo(:,24, 6) = (/ & + & 0.13748e-03_r8,0.14696e-03_r8,0.16025e-03_r8,0.17620e-03_r8,0.19459e-03_r8 /) + kbo(:,25, 6) = (/ & + & 0.11841e-03_r8,0.12828e-03_r8,0.13998e-03_r8,0.15487e-03_r8,0.17174e-03_r8 /) + kbo(:,26, 6) = (/ & + & 0.10209e-03_r8,0.11175e-03_r8,0.12193e-03_r8,0.13590e-03_r8,0.15125e-03_r8 /) + kbo(:,27, 6) = (/ & + & 0.87003e-04_r8,0.95681e-04_r8,0.10499e-03_r8,0.11744e-03_r8,0.13086e-03_r8 /) + kbo(:,28, 6) = (/ & + & 0.73110e-04_r8,0.80653e-04_r8,0.89103e-04_r8,0.99988e-04_r8,0.11120e-03_r8 /) + kbo(:,29, 6) = (/ & + & 0.60620e-04_r8,0.66736e-04_r8,0.74222e-04_r8,0.82863e-04_r8,0.92471e-04_r8 /) + kbo(:,30, 6) = (/ & + & 0.49831e-04_r8,0.54602e-04_r8,0.61288e-04_r8,0.68281e-04_r8,0.75599e-04_r8 /) + kbo(:,31, 6) = (/ & + & 0.40315e-04_r8,0.44435e-04_r8,0.49703e-04_r8,0.55140e-04_r8,0.60140e-04_r8 /) + kbo(:,32, 6) = (/ & + & 0.32490e-04_r8,0.36020e-04_r8,0.39894e-04_r8,0.44068e-04_r8,0.48080e-04_r8 /) + kbo(:,33, 6) = (/ & + & 0.26085e-04_r8,0.29063e-04_r8,0.32003e-04_r8,0.35074e-04_r8,0.38662e-04_r8 /) + kbo(:,34, 6) = (/ & + & 0.21201e-04_r8,0.23256e-04_r8,0.25636e-04_r8,0.28140e-04_r8,0.31273e-04_r8 /) + kbo(:,35, 6) = (/ & + & 0.17022e-04_r8,0.18534e-04_r8,0.20322e-04_r8,0.22464e-04_r8,0.25109e-04_r8 /) + kbo(:,36, 6) = (/ & + & 0.13427e-04_r8,0.14606e-04_r8,0.16055e-04_r8,0.17783e-04_r8,0.19877e-04_r8 /) + kbo(:,37, 6) = (/ & + & 0.10630e-04_r8,0.11559e-04_r8,0.12731e-04_r8,0.14118e-04_r8,0.15831e-04_r8 /) + kbo(:,38, 6) = (/ & + & 0.84365e-05_r8,0.91300e-05_r8,0.10077e-04_r8,0.11171e-04_r8,0.12568e-04_r8 /) + kbo(:,39, 6) = (/ & + & 0.66762e-05_r8,0.71770e-05_r8,0.79359e-05_r8,0.88044e-05_r8,0.99043e-05_r8 /) + kbo(:,40, 6) = (/ & + & 0.53561e-05_r8,0.57216e-05_r8,0.63210e-05_r8,0.70080e-05_r8,0.79213e-05_r8 /) + kbo(:,41, 6) = (/ & + & 0.42954e-05_r8,0.45692e-05_r8,0.50356e-05_r8,0.56102e-05_r8,0.63394e-05_r8 /) + kbo(:,42, 6) = (/ & + & 0.34409e-05_r8,0.36788e-05_r8,0.40124e-05_r8,0.44898e-05_r8,0.50645e-05_r8 /) + kbo(:,43, 6) = (/ & + & 0.27453e-05_r8,0.29361e-05_r8,0.31651e-05_r8,0.35498e-05_r8,0.40058e-05_r8 /) + kbo(:,44, 6) = (/ & + & 0.21863e-05_r8,0.23320e-05_r8,0.24965e-05_r8,0.27915e-05_r8,0.31593e-05_r8 /) + kbo(:,45, 6) = (/ & + & 0.17409e-05_r8,0.18472e-05_r8,0.19801e-05_r8,0.21812e-05_r8,0.24741e-05_r8 /) + kbo(:,46, 6) = (/ & + & 0.13903e-05_r8,0.14639e-05_r8,0.15660e-05_r8,0.17042e-05_r8,0.19243e-05_r8 /) + kbo(:,47, 6) = (/ & + & 0.11229e-05_r8,0.11661e-05_r8,0.12377e-05_r8,0.13335e-05_r8,0.14898e-05_r8 /) + kbo(:,48, 6) = (/ & + & 0.90528e-06_r8,0.92962e-06_r8,0.97799e-06_r8,0.10483e-05_r8,0.11575e-05_r8 /) + kbo(:,49, 6) = (/ & + & 0.72877e-06_r8,0.74278e-06_r8,0.77380e-06_r8,0.82564e-06_r8,0.89736e-06_r8 /) + kbo(:,50, 6) = (/ & + & 0.59358e-06_r8,0.59955e-06_r8,0.62170e-06_r8,0.65720e-06_r8,0.70771e-06_r8 /) + kbo(:,51, 6) = (/ & + & 0.48783e-06_r8,0.48769e-06_r8,0.50300e-06_r8,0.52655e-06_r8,0.56377e-06_r8 /) + kbo(:,52, 6) = (/ & + & 0.39834e-06_r8,0.39922e-06_r8,0.40604e-06_r8,0.42316e-06_r8,0.45057e-06_r8 /) + kbo(:,53, 6) = (/ & + & 0.33019e-06_r8,0.32505e-06_r8,0.33011e-06_r8,0.33917e-06_r8,0.35858e-06_r8 /) + kbo(:,54, 6) = (/ & + & 0.27829e-06_r8,0.26763e-06_r8,0.27219e-06_r8,0.27714e-06_r8,0.29159e-06_r8 /) + kbo(:,55, 6) = (/ & + & 0.23259e-06_r8,0.22250e-06_r8,0.22510e-06_r8,0.22855e-06_r8,0.23937e-06_r8 /) + kbo(:,56, 6) = (/ & + & 0.19401e-06_r8,0.18605e-06_r8,0.18566e-06_r8,0.18937e-06_r8,0.19605e-06_r8 /) + kbo(:,57, 6) = (/ & + & 0.15908e-06_r8,0.15649e-06_r8,0.15396e-06_r8,0.15754e-06_r8,0.16039e-06_r8 /) + kbo(:,58, 6) = (/ & + & 0.12892e-06_r8,0.13132e-06_r8,0.12793e-06_r8,0.13093e-06_r8,0.13273e-06_r8 /) + kbo(:,59, 6) = (/ & + & 0.11177e-06_r8,0.11165e-06_r8,0.10875e-06_r8,0.11132e-06_r8,0.11431e-06_r8 /) + kbo(:,13, 7) = (/ & + & 0.19357e-02_r8,0.20341e-02_r8,0.21760e-02_r8,0.22982e-02_r8,0.24550e-02_r8 /) + kbo(:,14, 7) = (/ & + & 0.20343e-02_r8,0.21709e-02_r8,0.23192e-02_r8,0.24854e-02_r8,0.27026e-02_r8 /) + kbo(:,15, 7) = (/ & + & 0.21108e-02_r8,0.23009e-02_r8,0.25488e-02_r8,0.28048e-02_r8,0.30159e-02_r8 /) + kbo(:,16, 7) = (/ & + & 0.21016e-02_r8,0.23581e-02_r8,0.25958e-02_r8,0.28093e-02_r8,0.29839e-02_r8 /) + kbo(:,17, 7) = (/ & + & 0.21350e-02_r8,0.23722e-02_r8,0.25718e-02_r8,0.27703e-02_r8,0.30036e-02_r8 /) + kbo(:,18, 7) = (/ & + & 0.21493e-02_r8,0.23550e-02_r8,0.25593e-02_r8,0.27827e-02_r8,0.29722e-02_r8 /) + kbo(:,19, 7) = (/ & + & 0.21677e-02_r8,0.23602e-02_r8,0.25446e-02_r8,0.27267e-02_r8,0.29542e-02_r8 /) + kbo(:,20, 7) = (/ & + & 0.21009e-02_r8,0.22669e-02_r8,0.24261e-02_r8,0.26095e-02_r8,0.28436e-02_r8 /) + kbo(:,21, 7) = (/ & + & 0.19811e-02_r8,0.21249e-02_r8,0.22790e-02_r8,0.24716e-02_r8,0.26844e-02_r8 /) + kbo(:,22, 7) = (/ & + & 0.18393e-02_r8,0.19585e-02_r8,0.21127e-02_r8,0.22962e-02_r8,0.25211e-02_r8 /) + kbo(:,23, 7) = (/ & + & 0.16905e-02_r8,0.18032e-02_r8,0.19594e-02_r8,0.21280e-02_r8,0.23466e-02_r8 /) + kbo(:,24, 7) = (/ & + & 0.15327e-02_r8,0.16542e-02_r8,0.18047e-02_r8,0.19642e-02_r8,0.21591e-02_r8 /) + kbo(:,25, 7) = (/ & + & 0.13831e-02_r8,0.14932e-02_r8,0.16391e-02_r8,0.17921e-02_r8,0.19606e-02_r8 /) + kbo(:,26, 7) = (/ & + & 0.12298e-02_r8,0.13325e-02_r8,0.14676e-02_r8,0.16086e-02_r8,0.17628e-02_r8 /) + kbo(:,27, 7) = (/ & + & 0.10692e-02_r8,0.11652e-02_r8,0.12858e-02_r8,0.14124e-02_r8,0.15514e-02_r8 /) + kbo(:,28, 7) = (/ & + & 0.91706e-03_r8,0.10034e-02_r8,0.11100e-02_r8,0.12231e-02_r8,0.13481e-02_r8 /) + kbo(:,29, 7) = (/ & + & 0.76824e-03_r8,0.84492e-03_r8,0.93654e-03_r8,0.10377e-02_r8,0.11448e-02_r8 /) + kbo(:,30, 7) = (/ & + & 0.63841e-03_r8,0.70573e-03_r8,0.78553e-03_r8,0.87197e-03_r8,0.96607e-03_r8 /) + kbo(:,31, 7) = (/ & + & 0.51979e-03_r8,0.58056e-03_r8,0.64728e-03_r8,0.71891e-03_r8,0.80875e-03_r8 /) + kbo(:,32, 7) = (/ & + & 0.42659e-03_r8,0.47686e-03_r8,0.53347e-03_r8,0.60016e-03_r8,0.67592e-03_r8 /) + kbo(:,33, 7) = (/ & + & 0.34820e-03_r8,0.39030e-03_r8,0.44004e-03_r8,0.49875e-03_r8,0.56492e-03_r8 /) + kbo(:,34, 7) = (/ & + & 0.28753e-03_r8,0.32477e-03_r8,0.36831e-03_r8,0.41989e-03_r8,0.47708e-03_r8 /) + kbo(:,35, 7) = (/ & + & 0.23568e-03_r8,0.26716e-03_r8,0.30618e-03_r8,0.35062e-03_r8,0.39934e-03_r8 /) + kbo(:,36, 7) = (/ & + & 0.19116e-03_r8,0.21863e-03_r8,0.25180e-03_r8,0.28983e-03_r8,0.33082e-03_r8 /) + kbo(:,37, 7) = (/ & + & 0.15437e-03_r8,0.17829e-03_r8,0.20646e-03_r8,0.23900e-03_r8,0.27320e-03_r8 /) + kbo(:,38, 7) = (/ & + & 0.12397e-03_r8,0.14462e-03_r8,0.16847e-03_r8,0.19621e-03_r8,0.22528e-03_r8 /) + kbo(:,39, 7) = (/ & + & 0.98930e-04_r8,0.11647e-03_r8,0.13711e-03_r8,0.16057e-03_r8,0.18549e-03_r8 /) + kbo(:,40, 7) = (/ & + & 0.79845e-04_r8,0.94437e-04_r8,0.11202e-03_r8,0.13217e-03_r8,0.15346e-03_r8 /) + kbo(:,41, 7) = (/ & + & 0.64260e-04_r8,0.76439e-04_r8,0.91253e-04_r8,0.10837e-03_r8,0.12691e-03_r8 /) + kbo(:,42, 7) = (/ & + & 0.51561e-04_r8,0.61686e-04_r8,0.74044e-04_r8,0.88504e-04_r8,0.10431e-03_r8 /) + kbo(:,43, 7) = (/ & + & 0.40906e-04_r8,0.49267e-04_r8,0.59361e-04_r8,0.71417e-04_r8,0.84751e-04_r8 /) + kbo(:,44, 7) = (/ & + & 0.32247e-04_r8,0.38955e-04_r8,0.47246e-04_r8,0.57199e-04_r8,0.68540e-04_r8 /) + kbo(:,45, 7) = (/ & + & 0.25243e-04_r8,0.30790e-04_r8,0.37490e-04_r8,0.45754e-04_r8,0.55394e-04_r8 /) + kbo(:,46, 7) = (/ & + & 0.19604e-04_r8,0.24131e-04_r8,0.29598e-04_r8,0.36431e-04_r8,0.44419e-04_r8 /) + kbo(:,47, 7) = (/ & + & 0.15116e-04_r8,0.18785e-04_r8,0.23180e-04_r8,0.28780e-04_r8,0.35381e-04_r8 /) + kbo(:,48, 7) = (/ & + & 0.11550e-04_r8,0.14451e-04_r8,0.18039e-04_r8,0.22545e-04_r8,0.28005e-04_r8 /) + kbo(:,49, 7) = (/ & + & 0.87452e-05_r8,0.10992e-04_r8,0.13863e-04_r8,0.17498e-04_r8,0.21949e-04_r8 /) + kbo(:,50, 7) = (/ & + & 0.66768e-05_r8,0.84974e-05_r8,0.10835e-04_r8,0.13777e-04_r8,0.17448e-04_r8 /) + kbo(:,51, 7) = (/ & + & 0.51359e-05_r8,0.66277e-05_r8,0.85196e-05_r8,0.10905e-04_r8,0.13933e-04_r8 /) + kbo(:,52, 7) = (/ & + & 0.38737e-05_r8,0.51001e-05_r8,0.66347e-05_r8,0.85842e-05_r8,0.11033e-04_r8 /) + kbo(:,53, 7) = (/ & + & 0.28793e-05_r8,0.38820e-05_r8,0.50987e-05_r8,0.66800e-05_r8,0.86846e-05_r8 /) + kbo(:,54, 7) = (/ & + & 0.22250e-05_r8,0.30528e-05_r8,0.40721e-05_r8,0.53813e-05_r8,0.70529e-05_r8 /) + kbo(:,55, 7) = (/ & + & 0.17548e-05_r8,0.24455e-05_r8,0.32962e-05_r8,0.43877e-05_r8,0.58071e-05_r8 /) + kbo(:,56, 7) = (/ & + & 0.13740e-05_r8,0.19413e-05_r8,0.26523e-05_r8,0.35566e-05_r8,0.47512e-05_r8 /) + kbo(:,57, 7) = (/ & + & 0.10745e-05_r8,0.15242e-05_r8,0.21190e-05_r8,0.28679e-05_r8,0.38612e-05_r8 /) + kbo(:,58, 7) = (/ & + & 0.84271e-06_r8,0.12117e-05_r8,0.17039e-05_r8,0.23246e-05_r8,0.31564e-05_r8 /) + kbo(:,59, 7) = (/ & + & 0.75625e-06_r8,0.11002e-05_r8,0.15376e-05_r8,0.20855e-05_r8,0.28548e-05_r8 /) + kbo(:,13, 8) = (/ & + & 0.41133e-01_r8,0.43585e-01_r8,0.46448e-01_r8,0.50156e-01_r8,0.54607e-01_r8 /) + kbo(:,14, 8) = (/ & + & 0.39162e-01_r8,0.41636e-01_r8,0.44649e-01_r8,0.48118e-01_r8,0.52078e-01_r8 /) + kbo(:,15, 8) = (/ & + & 0.37770e-01_r8,0.40048e-01_r8,0.43090e-01_r8,0.46524e-01_r8,0.50698e-01_r8 /) + kbo(:,16, 8) = (/ & + & 0.35235e-01_r8,0.37712e-01_r8,0.40429e-01_r8,0.44092e-01_r8,0.48470e-01_r8 /) + kbo(:,17, 8) = (/ & + & 0.32748e-01_r8,0.35232e-01_r8,0.38049e-01_r8,0.41536e-01_r8,0.45596e-01_r8 /) + kbo(:,18, 8) = (/ & + & 0.30656e-01_r8,0.33078e-01_r8,0.36084e-01_r8,0.39403e-01_r8,0.43319e-01_r8 /) + kbo(:,19, 8) = (/ & + & 0.28887e-01_r8,0.31462e-01_r8,0.34348e-01_r8,0.37660e-01_r8,0.41532e-01_r8 /) + kbo(:,20, 8) = (/ & + & 0.26521e-01_r8,0.29153e-01_r8,0.32006e-01_r8,0.35368e-01_r8,0.39083e-01_r8 /) + kbo(:,21, 8) = (/ & + & 0.23988e-01_r8,0.26537e-01_r8,0.29508e-01_r8,0.32666e-01_r8,0.36356e-01_r8 /) + kbo(:,22, 8) = (/ & + & 0.21655e-01_r8,0.24205e-01_r8,0.27193e-01_r8,0.30346e-01_r8,0.33820e-01_r8 /) + kbo(:,23, 8) = (/ & + & 0.19724e-01_r8,0.22257e-01_r8,0.25021e-01_r8,0.27997e-01_r8,0.31309e-01_r8 /) + kbo(:,24, 8) = (/ & + & 0.18094e-01_r8,0.20464e-01_r8,0.23167e-01_r8,0.26069e-01_r8,0.29357e-01_r8 /) + kbo(:,25, 8) = (/ & + & 0.16666e-01_r8,0.18896e-01_r8,0.21422e-01_r8,0.24282e-01_r8,0.27401e-01_r8 /) + kbo(:,26, 8) = (/ & + & 0.15252e-01_r8,0.17451e-01_r8,0.19828e-01_r8,0.22565e-01_r8,0.25604e-01_r8 /) + kbo(:,27, 8) = (/ & + & 0.13902e-01_r8,0.15940e-01_r8,0.18143e-01_r8,0.20720e-01_r8,0.23727e-01_r8 /) + kbo(:,28, 8) = (/ & + & 0.12642e-01_r8,0.14401e-01_r8,0.16467e-01_r8,0.18975e-01_r8,0.21740e-01_r8 /) + kbo(:,29, 8) = (/ & + & 0.11177e-01_r8,0.12765e-01_r8,0.14750e-01_r8,0.16957e-01_r8,0.19575e-01_r8 /) + kbo(:,30, 8) = (/ & + & 0.97810e-02_r8,0.11281e-01_r8,0.13066e-01_r8,0.15112e-01_r8,0.17581e-01_r8 /) + kbo(:,31, 8) = (/ & + & 0.84562e-02_r8,0.98553e-02_r8,0.11427e-01_r8,0.13312e-01_r8,0.15536e-01_r8 /) + kbo(:,32, 8) = (/ & + & 0.73434e-02_r8,0.85939e-02_r8,0.10020e-01_r8,0.11770e-01_r8,0.13758e-01_r8 /) + kbo(:,33, 8) = (/ & + & 0.63801e-02_r8,0.74957e-02_r8,0.87874e-02_r8,0.10375e-01_r8,0.12145e-01_r8 /) + kbo(:,34, 8) = (/ & + & 0.56002e-02_r8,0.65926e-02_r8,0.77964e-02_r8,0.92186e-02_r8,0.10768e-01_r8 /) + kbo(:,35, 8) = (/ & + & 0.48489e-02_r8,0.57164e-02_r8,0.68333e-02_r8,0.80886e-02_r8,0.94500e-02_r8 /) + kbo(:,36, 8) = (/ & + & 0.41428e-02_r8,0.49220e-02_r8,0.58884e-02_r8,0.69905e-02_r8,0.81862e-02_r8 /) + kbo(:,37, 8) = (/ & + & 0.34967e-02_r8,0.41841e-02_r8,0.50244e-02_r8,0.59657e-02_r8,0.70167e-02_r8 /) + kbo(:,38, 8) = (/ & + & 0.29333e-02_r8,0.35364e-02_r8,0.42644e-02_r8,0.50719e-02_r8,0.59938e-02_r8 /) + kbo(:,39, 8) = (/ & + & 0.24443e-02_r8,0.29647e-02_r8,0.35953e-02_r8,0.42898e-02_r8,0.50972e-02_r8 /) + kbo(:,40, 8) = (/ & + & 0.20439e-02_r8,0.25046e-02_r8,0.30512e-02_r8,0.36459e-02_r8,0.43466e-02_r8 /) + kbo(:,41, 8) = (/ & + & 0.17068e-02_r8,0.21107e-02_r8,0.25838e-02_r8,0.30959e-02_r8,0.36971e-02_r8 /) + kbo(:,42, 8) = (/ & + & 0.14199e-02_r8,0.17705e-02_r8,0.21755e-02_r8,0.26204e-02_r8,0.31356e-02_r8 /) + kbo(:,43, 8) = (/ & + & 0.11616e-02_r8,0.14584e-02_r8,0.18069e-02_r8,0.21876e-02_r8,0.26286e-02_r8 /) + kbo(:,44, 8) = (/ & + & 0.93807e-03_r8,0.11864e-02_r8,0.14851e-02_r8,0.18080e-02_r8,0.21849e-02_r8 /) + kbo(:,45, 8) = (/ & + & 0.75026e-03_r8,0.95460e-03_r8,0.12092e-02_r8,0.14831e-02_r8,0.18037e-02_r8 /) + kbo(:,46, 8) = (/ & + & 0.59319e-03_r8,0.76134e-03_r8,0.97292e-03_r8,0.12059e-02_r8,0.14787e-02_r8 /) + kbo(:,47, 8) = (/ & + & 0.46546e-03_r8,0.60113e-03_r8,0.77762e-03_r8,0.97379e-03_r8,0.12030e-02_r8 /) + kbo(:,48, 8) = (/ & + & 0.36131e-03_r8,0.46999e-03_r8,0.61292e-03_r8,0.77778e-03_r8,0.96667e-03_r8 /) + kbo(:,49, 8) = (/ & + & 0.27490e-03_r8,0.36153e-03_r8,0.47561e-03_r8,0.61173e-03_r8,0.76634e-03_r8 /) + kbo(:,50, 8) = (/ & + & 0.21403e-03_r8,0.28416e-03_r8,0.37592e-03_r8,0.48994e-03_r8,0.61812e-03_r8 /) + kbo(:,51, 8) = (/ & + & 0.16745e-03_r8,0.22425e-03_r8,0.29943e-03_r8,0.39474e-03_r8,0.50310e-03_r8 /) + kbo(:,52, 8) = (/ & + & 0.12927e-03_r8,0.17496e-03_r8,0.23541e-03_r8,0.31434e-03_r8,0.40442e-03_r8 /) + kbo(:,53, 8) = (/ & + & 0.98512e-04_r8,0.13503e-03_r8,0.18276e-03_r8,0.24681e-03_r8,0.32086e-03_r8 /) + kbo(:,54, 8) = (/ & + & 0.78150e-04_r8,0.10819e-03_r8,0.14843e-03_r8,0.20243e-03_r8,0.26646e-03_r8 /) + kbo(:,55, 8) = (/ & + & 0.63455e-04_r8,0.88570e-04_r8,0.12297e-03_r8,0.17015e-03_r8,0.22626e-03_r8 /) + kbo(:,56, 8) = (/ & + & 0.51095e-04_r8,0.72223e-04_r8,0.10144e-03_r8,0.14188e-03_r8,0.19132e-03_r8 /) + kbo(:,57, 8) = (/ & + & 0.40866e-04_r8,0.58631e-04_r8,0.83096e-04_r8,0.11753e-03_r8,0.16055e-03_r8 /) + kbo(:,58, 8) = (/ & + & 0.32890e-04_r8,0.47893e-04_r8,0.68644e-04_r8,0.98156e-04_r8,0.13564e-03_r8 /) + kbo(:,59, 8) = (/ & + & 0.29702e-04_r8,0.43928e-04_r8,0.64217e-04_r8,0.92621e-04_r8,0.12965e-03_r8 /) + kbo(:,13, 9) = (/ & + & 0.27690e+01_r8,0.28644e+01_r8,0.29696e+01_r8,0.30850e+01_r8,0.32162e+01_r8 /) + kbo(:,14, 9) = (/ & + & 0.23162e+01_r8,0.23973e+01_r8,0.24876e+01_r8,0.25913e+01_r8,0.27107e+01_r8 /) + kbo(:,15, 9) = (/ & + & 0.19377e+01_r8,0.20096e+01_r8,0.20909e+01_r8,0.21846e+01_r8,0.22904e+01_r8 /) + kbo(:,16, 9) = (/ & + & 0.16221e+01_r8,0.16854e+01_r8,0.17596e+01_r8,0.18440e+01_r8,0.19374e+01_r8 /) + kbo(:,17, 9) = (/ & + & 0.13581e+01_r8,0.14147e+01_r8,0.14813e+01_r8,0.15562e+01_r8,0.16364e+01_r8 /) + kbo(:,18, 9) = (/ & + & 0.11494e+01_r8,0.11995e+01_r8,0.12558e+01_r8,0.13168e+01_r8,0.13828e+01_r8 /) + kbo(:,19, 9) = (/ & + & 0.99857e+00_r8,0.10422e+01_r8,0.10890e+01_r8,0.11391e+01_r8,0.11917e+01_r8 /) + kbo(:,20, 9) = (/ & + & 0.86585e+00_r8,0.90292e+00_r8,0.94341e+00_r8,0.98616e+00_r8,0.10332e+01_r8 /) + kbo(:,21, 9) = (/ & + & 0.74752e+00_r8,0.77983e+00_r8,0.81433e+00_r8,0.85283e+00_r8,0.89462e+00_r8 /) + kbo(:,22, 9) = (/ & + & 0.64494e+00_r8,0.67286e+00_r8,0.70277e+00_r8,0.73658e+00_r8,0.77352e+00_r8 /) + kbo(:,23, 9) = (/ & + & 0.55485e+00_r8,0.57897e+00_r8,0.60654e+00_r8,0.63699e+00_r8,0.66979e+00_r8 /) + kbo(:,24, 9) = (/ & + & 0.47664e+00_r8,0.49869e+00_r8,0.52329e+00_r8,0.54973e+00_r8,0.57955e+00_r8 /) + kbo(:,25, 9) = (/ & + & 0.41114e+00_r8,0.42988e+00_r8,0.45044e+00_r8,0.47447e+00_r8,0.50163e+00_r8 /) + kbo(:,26, 9) = (/ & + & 0.35513e+00_r8,0.37142e+00_r8,0.38942e+00_r8,0.41045e+00_r8,0.43493e+00_r8 /) + kbo(:,27, 9) = (/ & + & 0.30546e+00_r8,0.31995e+00_r8,0.33673e+00_r8,0.35597e+00_r8,0.37742e+00_r8 /) + kbo(:,28, 9) = (/ & + & 0.26188e+00_r8,0.27552e+00_r8,0.29117e+00_r8,0.30879e+00_r8,0.32839e+00_r8 /) + kbo(:,29, 9) = (/ & + & 0.22377e+00_r8,0.23654e+00_r8,0.25102e+00_r8,0.26735e+00_r8,0.28587e+00_r8 /) + kbo(:,30, 9) = (/ & + & 0.19129e+00_r8,0.20332e+00_r8,0.21691e+00_r8,0.23233e+00_r8,0.24924e+00_r8 /) + kbo(:,31, 9) = (/ & + & 0.16347e+00_r8,0.17463e+00_r8,0.18745e+00_r8,0.20165e+00_r8,0.21712e+00_r8 /) + kbo(:,32, 9) = (/ & + & 0.14037e+00_r8,0.15075e+00_r8,0.16282e+00_r8,0.17567e+00_r8,0.18973e+00_r8 /) + kbo(:,33, 9) = (/ & + & 0.12095e+00_r8,0.13081e+00_r8,0.14161e+00_r8,0.15337e+00_r8,0.16632e+00_r8 /) + kbo(:,34, 9) = (/ & + & 0.10468e+00_r8,0.11371e+00_r8,0.12351e+00_r8,0.13423e+00_r8,0.14632e+00_r8 /) + kbo(:,35, 9) = (/ & + & 0.90259e-01_r8,0.98421e-01_r8,0.10717e+00_r8,0.11695e+00_r8,0.12831e+00_r8 /) + kbo(:,36, 9) = (/ & + & 0.77272e-01_r8,0.84599e-01_r8,0.92464e-01_r8,0.10140e+00_r8,0.11193e+00_r8 /) + kbo(:,37, 9) = (/ & + & 0.65606e-01_r8,0.72029e-01_r8,0.79063e-01_r8,0.87174e-01_r8,0.96643e-01_r8 /) + kbo(:,38, 9) = (/ & + & 0.55528e-01_r8,0.61268e-01_r8,0.67613e-01_r8,0.74898e-01_r8,0.83456e-01_r8 /) + kbo(:,39, 9) = (/ & + & 0.46985e-01_r8,0.52085e-01_r8,0.57765e-01_r8,0.64303e-01_r8,0.72021e-01_r8 /) + kbo(:,40, 9) = (/ & + & 0.39626e-01_r8,0.44094e-01_r8,0.49150e-01_r8,0.55005e-01_r8,0.61884e-01_r8 /) + kbo(:,41, 9) = (/ & + & 0.33376e-01_r8,0.37326e-01_r8,0.41783e-01_r8,0.46997e-01_r8,0.53158e-01_r8 /) + kbo(:,42, 9) = (/ & + & 0.28074e-01_r8,0.31535e-01_r8,0.35493e-01_r8,0.40112e-01_r8,0.45645e-01_r8 /) + kbo(:,43, 9) = (/ & + & 0.23419e-01_r8,0.26419e-01_r8,0.29889e-01_r8,0.33982e-01_r8,0.38867e-01_r8 /) + kbo(:,44, 9) = (/ & + & 0.19437e-01_r8,0.22035e-01_r8,0.25042e-01_r8,0.28622e-01_r8,0.32930e-01_r8 /) + kbo(:,45, 9) = (/ & + & 0.16083e-01_r8,0.18329e-01_r8,0.20937e-01_r8,0.24027e-01_r8,0.27786e-01_r8 /) + kbo(:,46, 9) = (/ & + & 0.13236e-01_r8,0.15146e-01_r8,0.17420e-01_r8,0.20094e-01_r8,0.23328e-01_r8 /) + kbo(:,47, 9) = (/ & + & 0.10820e-01_r8,0.12455e-01_r8,0.14377e-01_r8,0.16656e-01_r8,0.19464e-01_r8 /) + kbo(:,48, 9) = (/ & + & 0.88043e-02_r8,0.10190e-01_r8,0.11813e-01_r8,0.13745e-01_r8,0.16141e-01_r8 /) + kbo(:,49, 9) = (/ & + & 0.71234e-02_r8,0.82775e-02_r8,0.96453e-02_r8,0.11284e-01_r8,0.13310e-01_r8 /) + kbo(:,50, 9) = (/ & + & 0.58127e-02_r8,0.67802e-02_r8,0.79379e-02_r8,0.93254e-02_r8,0.11078e-01_r8 /) + kbo(:,51, 9) = (/ & + & 0.47494e-02_r8,0.55659e-02_r8,0.65602e-02_r8,0.77407e-02_r8,0.92288e-02_r8 /) + kbo(:,52, 9) = (/ & + & 0.38618e-02_r8,0.45424e-02_r8,0.53925e-02_r8,0.64011e-02_r8,0.76645e-02_r8 /) + kbo(:,53, 9) = (/ & + & 0.31264e-02_r8,0.36823e-02_r8,0.43952e-02_r8,0.52615e-02_r8,0.63311e-02_r8 /) + kbo(:,54, 9) = (/ & + & 0.25794e-02_r8,0.30481e-02_r8,0.36548e-02_r8,0.44037e-02_r8,0.53380e-02_r8 /) + kbo(:,55, 9) = (/ & + & 0.21508e-02_r8,0.25472e-02_r8,0.30665e-02_r8,0.37188e-02_r8,0.45472e-02_r8 /) + kbo(:,56, 9) = (/ & + & 0.17938e-02_r8,0.21263e-02_r8,0.25713e-02_r8,0.31411e-02_r8,0.38667e-02_r8 /) + kbo(:,57, 9) = (/ & + & 0.14949e-02_r8,0.17755e-02_r8,0.21510e-02_r8,0.26439e-02_r8,0.32830e-02_r8 /) + kbo(:,58, 9) = (/ & + & 0.12521e-02_r8,0.14938e-02_r8,0.18137e-02_r8,0.22426e-02_r8,0.28028e-02_r8 /) + kbo(:,59, 9) = (/ & + & 0.11302e-02_r8,0.13552e-02_r8,0.16582e-02_r8,0.20691e-02_r8,0.26051e-02_r8 /) + kbo(:,13,10) = (/ & + & 0.14370e+02_r8,0.14649e+02_r8,0.14957e+02_r8,0.15296e+02_r8,0.15663e+02_r8 /) + kbo(:,14,10) = (/ & + & 0.12178e+02_r8,0.12411e+02_r8,0.12682e+02_r8,0.12978e+02_r8,0.13316e+02_r8 /) + kbo(:,15,10) = (/ & + & 0.10211e+02_r8,0.10402e+02_r8,0.10625e+02_r8,0.10894e+02_r8,0.11239e+02_r8 /) + kbo(:,16,10) = (/ & + & 0.85974e+01_r8,0.87539e+01_r8,0.89410e+01_r8,0.91849e+01_r8,0.95108e+01_r8 /) + kbo(:,17,10) = (/ & + & 0.72440e+01_r8,0.73858e+01_r8,0.75683e+01_r8,0.78199e+01_r8,0.81516e+01_r8 /) + kbo(:,18,10) = (/ & + & 0.59680e+01_r8,0.61054e+01_r8,0.63108e+01_r8,0.66074e+01_r8,0.69367e+01_r8 /) + kbo(:,19,10) = (/ & + & 0.47759e+01_r8,0.49000e+01_r8,0.51125e+01_r8,0.53858e+01_r8,0.56972e+01_r8 /) + kbo(:,20,10) = (/ & + & 0.40682e+01_r8,0.42060e+01_r8,0.43988e+01_r8,0.46035e+01_r8,0.48052e+01_r8 /) + kbo(:,21,10) = (/ & + & 0.35226e+01_r8,0.36715e+01_r8,0.38357e+01_r8,0.40017e+01_r8,0.41636e+01_r8 /) + kbo(:,22,10) = (/ & + & 0.30730e+01_r8,0.32059e+01_r8,0.33607e+01_r8,0.35055e+01_r8,0.36621e+01_r8 /) + kbo(:,23,10) = (/ & + & 0.26688e+01_r8,0.27999e+01_r8,0.29296e+01_r8,0.30668e+01_r8,0.32115e+01_r8 /) + kbo(:,24,10) = (/ & + & 0.23228e+01_r8,0.24338e+01_r8,0.25510e+01_r8,0.26866e+01_r8,0.28223e+01_r8 /) + kbo(:,25,10) = (/ & + & 0.19964e+01_r8,0.21083e+01_r8,0.22332e+01_r8,0.23566e+01_r8,0.24845e+01_r8 /) + kbo(:,26,10) = (/ & + & 0.17097e+01_r8,0.18190e+01_r8,0.19420e+01_r8,0.20663e+01_r8,0.21952e+01_r8 /) + kbo(:,27,10) = (/ & + & 0.14729e+01_r8,0.15741e+01_r8,0.16825e+01_r8,0.17963e+01_r8,0.19295e+01_r8 /) + kbo(:,28,10) = (/ & + & 0.12788e+01_r8,0.13609e+01_r8,0.14562e+01_r8,0.15668e+01_r8,0.17032e+01_r8 /) + kbo(:,29,10) = (/ & + & 0.11113e+01_r8,0.11813e+01_r8,0.12669e+01_r8,0.13763e+01_r8,0.15012e+01_r8 /) + kbo(:,30,10) = (/ & + & 0.96661e+00_r8,0.10287e+01_r8,0.11081e+01_r8,0.12093e+01_r8,0.13273e+01_r8 /) + kbo(:,31,10) = (/ & + & 0.83795e+00_r8,0.89792e+00_r8,0.97327e+00_r8,0.10727e+01_r8,0.11828e+01_r8 /) + kbo(:,32,10) = (/ & + & 0.72634e+00_r8,0.78480e+00_r8,0.86071e+00_r8,0.95503e+00_r8,0.10615e+01_r8 /) + kbo(:,33,10) = (/ & + & 0.63134e+00_r8,0.68789e+00_r8,0.76628e+00_r8,0.85854e+00_r8,0.96370e+00_r8 /) + kbo(:,34,10) = (/ & + & 0.55172e+00_r8,0.60863e+00_r8,0.68672e+00_r8,0.77637e+00_r8,0.87664e+00_r8 /) + kbo(:,35,10) = (/ & + & 0.48039e+00_r8,0.53701e+00_r8,0.61125e+00_r8,0.69795e+00_r8,0.79084e+00_r8 /) + kbo(:,36,10) = (/ & + & 0.41819e+00_r8,0.47188e+00_r8,0.54096e+00_r8,0.62096e+00_r8,0.70693e+00_r8 /) + kbo(:,37,10) = (/ & + & 0.36050e+00_r8,0.40906e+00_r8,0.47069e+00_r8,0.54184e+00_r8,0.62144e+00_r8 /) + kbo(:,38,10) = (/ & + & 0.31156e+00_r8,0.35409e+00_r8,0.40958e+00_r8,0.47371e+00_r8,0.54611e+00_r8 /) + kbo(:,39,10) = (/ & + & 0.26782e+00_r8,0.30677e+00_r8,0.35645e+00_r8,0.41535e+00_r8,0.48073e+00_r8 /) + kbo(:,40,10) = (/ & + & 0.23006e+00_r8,0.26273e+00_r8,0.30670e+00_r8,0.35934e+00_r8,0.41871e+00_r8 /) + kbo(:,41,10) = (/ & + & 0.19681e+00_r8,0.22601e+00_r8,0.26383e+00_r8,0.31041e+00_r8,0.36443e+00_r8 /) + kbo(:,42,10) = (/ & + & 0.16794e+00_r8,0.19457e+00_r8,0.22757e+00_r8,0.26875e+00_r8,0.31708e+00_r8 /) + kbo(:,43,10) = (/ & + & 0.14222e+00_r8,0.16606e+00_r8,0.19480e+00_r8,0.23049e+00_r8,0.27422e+00_r8 /) + kbo(:,44,10) = (/ & + & 0.11907e+00_r8,0.14059e+00_r8,0.16567e+00_r8,0.19741e+00_r8,0.23557e+00_r8 /) + kbo(:,45,10) = (/ & + & 0.99508e-01_r8,0.11792e+00_r8,0.14029e+00_r8,0.16912e+00_r8,0.20294e+00_r8 /) + kbo(:,46,10) = (/ & + & 0.82787e-01_r8,0.98729e-01_r8,0.11783e+00_r8,0.14344e+00_r8,0.17433e+00_r8 /) + kbo(:,47,10) = (/ & + & 0.68205e-01_r8,0.81739e-01_r8,0.98558e-01_r8,0.12017e+00_r8,0.14798e+00_r8 /) + kbo(:,48,10) = (/ & + & 0.55907e-01_r8,0.67050e-01_r8,0.81465e-01_r8,0.10030e+00_r8,0.12506e+00_r8 /) + kbo(:,49,10) = (/ & + & 0.45682e-01_r8,0.54871e-01_r8,0.66950e-01_r8,0.83270e-01_r8,0.10500e+00_r8 /) + kbo(:,50,10) = (/ & + & 0.37515e-01_r8,0.45259e-01_r8,0.55584e-01_r8,0.69475e-01_r8,0.88432e-01_r8 /) + kbo(:,51,10) = (/ & + & 0.31052e-01_r8,0.37347e-01_r8,0.46136e-01_r8,0.58029e-01_r8,0.74379e-01_r8 /) + kbo(:,52,10) = (/ & + & 0.25697e-01_r8,0.30758e-01_r8,0.38027e-01_r8,0.48169e-01_r8,0.62340e-01_r8 /) + kbo(:,53,10) = (/ & + & 0.21053e-01_r8,0.25282e-01_r8,0.31221e-01_r8,0.39765e-01_r8,0.52061e-01_r8 /) + kbo(:,54,10) = (/ & + & 0.17506e-01_r8,0.21171e-01_r8,0.26181e-01_r8,0.33450e-01_r8,0.43837e-01_r8 /) + kbo(:,55,10) = (/ & + & 0.14733e-01_r8,0.17912e-01_r8,0.22352e-01_r8,0.28517e-01_r8,0.37310e-01_r8 /) + kbo(:,56,10) = (/ & + & 0.12382e-01_r8,0.15138e-01_r8,0.19031e-01_r8,0.24337e-01_r8,0.31780e-01_r8 /) + kbo(:,57,10) = (/ & + & 0.10363e-01_r8,0.12802e-01_r8,0.16188e-01_r8,0.20731e-01_r8,0.27252e-01_r8 /) + kbo(:,58,10) = (/ & + & 0.87632e-02_r8,0.10863e-01_r8,0.13823e-01_r8,0.17907e-01_r8,0.23570e-01_r8 /) + kbo(:,59,10) = (/ & + & 0.79477e-02_r8,0.99708e-02_r8,0.12797e-01_r8,0.16832e-01_r8,0.22384e-01_r8 /) + kbo(:,13,11) = (/ & + & 0.27028e+02_r8,0.27753e+02_r8,0.28483e+02_r8,0.29219e+02_r8,0.29909e+02_r8 /) + kbo(:,14,11) = (/ & + & 0.23419e+02_r8,0.24025e+02_r8,0.24638e+02_r8,0.25228e+02_r8,0.25789e+02_r8 /) + kbo(:,15,11) = (/ & + & 0.20150e+02_r8,0.20660e+02_r8,0.21151e+02_r8,0.21642e+02_r8,0.22118e+02_r8 /) + kbo(:,16,11) = (/ & + & 0.17107e+02_r8,0.17510e+02_r8,0.17925e+02_r8,0.18355e+02_r8,0.18823e+02_r8 /) + kbo(:,17,11) = (/ & + & 0.14361e+02_r8,0.14686e+02_r8,0.15035e+02_r8,0.15422e+02_r8,0.15903e+02_r8 /) + kbo(:,18,11) = (/ & + & 0.12138e+02_r8,0.12397e+02_r8,0.12696e+02_r8,0.13058e+02_r8,0.13553e+02_r8 /) + kbo(:,19,11) = (/ & + & 0.10135e+02_r8,0.10395e+02_r8,0.10708e+02_r8,0.11115e+02_r8,0.11638e+02_r8 /) + kbo(:,20,11) = (/ & + & 0.81786e+01_r8,0.84190e+01_r8,0.87492e+01_r8,0.92221e+01_r8,0.97673e+01_r8 /) + kbo(:,21,11) = (/ & + & 0.68203e+01_r8,0.70074e+01_r8,0.73249e+01_r8,0.77062e+01_r8,0.81227e+01_r8 /) + kbo(:,22,11) = (/ & + & 0.58880e+01_r8,0.61142e+01_r8,0.64089e+01_r8,0.67273e+01_r8,0.70540e+01_r8 /) + kbo(:,23,11) = (/ & + & 0.51482e+01_r8,0.53972e+01_r8,0.56613e+01_r8,0.59190e+01_r8,0.62039e+01_r8 /) + kbo(:,24,11) = (/ & + & 0.45460e+01_r8,0.47798e+01_r8,0.50055e+01_r8,0.52340e+01_r8,0.54793e+01_r8 /) + kbo(:,25,11) = (/ & + & 0.40038e+01_r8,0.42162e+01_r8,0.44356e+01_r8,0.46519e+01_r8,0.48861e+01_r8 /) + kbo(:,26,11) = (/ & + & 0.35330e+01_r8,0.37282e+01_r8,0.39261e+01_r8,0.41342e+01_r8,0.43614e+01_r8 /) + kbo(:,27,11) = (/ & + & 0.30918e+01_r8,0.32790e+01_r8,0.34783e+01_r8,0.36774e+01_r8,0.38933e+01_r8 /) + kbo(:,28,11) = (/ & + & 0.27019e+01_r8,0.28880e+01_r8,0.30842e+01_r8,0.32755e+01_r8,0.34826e+01_r8 /) + kbo(:,29,11) = (/ & + & 0.23567e+01_r8,0.25399e+01_r8,0.27237e+01_r8,0.29118e+01_r8,0.31184e+01_r8 /) + kbo(:,30,11) = (/ & + & 0.20673e+01_r8,0.22421e+01_r8,0.24146e+01_r8,0.26001e+01_r8,0.28136e+01_r8 /) + kbo(:,31,11) = (/ & + & 0.18233e+01_r8,0.19796e+01_r8,0.21491e+01_r8,0.23275e+01_r8,0.25391e+01_r8 /) + kbo(:,32,11) = (/ & + & 0.16164e+01_r8,0.17629e+01_r8,0.19137e+01_r8,0.20921e+01_r8,0.23020e+01_r8 /) + kbo(:,33,11) = (/ & + & 0.14325e+01_r8,0.15691e+01_r8,0.17171e+01_r8,0.18965e+01_r8,0.20991e+01_r8 /) + kbo(:,34,11) = (/ & + & 0.12711e+01_r8,0.14025e+01_r8,0.15514e+01_r8,0.17231e+01_r8,0.19204e+01_r8 /) + kbo(:,35,11) = (/ & + & 0.11251e+01_r8,0.12478e+01_r8,0.13948e+01_r8,0.15591e+01_r8,0.17428e+01_r8 /) + kbo(:,36,11) = (/ & + & 0.98734e+00_r8,0.11026e+01_r8,0.12425e+01_r8,0.13991e+01_r8,0.15730e+01_r8 /) + kbo(:,37,11) = (/ & + & 0.85152e+00_r8,0.96327e+00_r8,0.10911e+01_r8,0.12398e+01_r8,0.14045e+01_r8 /) + kbo(:,38,11) = (/ & + & 0.73399e+00_r8,0.83942e+00_r8,0.95984e+00_r8,0.10967e+01_r8,0.12526e+01_r8 /) + kbo(:,39,11) = (/ & + & 0.63468e+00_r8,0.73175e+00_r8,0.84488e+00_r8,0.97279e+00_r8,0.11163e+01_r8 /) + kbo(:,40,11) = (/ & + & 0.54166e+00_r8,0.63099e+00_r8,0.73459e+00_r8,0.85525e+00_r8,0.98986e+00_r8 /) + kbo(:,41,11) = (/ & + & 0.46341e+00_r8,0.54185e+00_r8,0.63786e+00_r8,0.75041e+00_r8,0.87557e+00_r8 /) + kbo(:,42,11) = (/ & + & 0.39710e+00_r8,0.46604e+00_r8,0.55335e+00_r8,0.65788e+00_r8,0.77518e+00_r8 /) + kbo(:,43,11) = (/ & + & 0.33809e+00_r8,0.39845e+00_r8,0.47656e+00_r8,0.56991e+00_r8,0.67763e+00_r8 /) + kbo(:,44,11) = (/ & + & 0.28738e+00_r8,0.33811e+00_r8,0.40783e+00_r8,0.49238e+00_r8,0.58805e+00_r8 /) + kbo(:,45,11) = (/ & + & 0.24372e+00_r8,0.28787e+00_r8,0.34858e+00_r8,0.42338e+00_r8,0.51131e+00_r8 /) + kbo(:,46,11) = (/ & + & 0.20655e+00_r8,0.24407e+00_r8,0.29751e+00_r8,0.36239e+00_r8,0.44206e+00_r8 /) + kbo(:,47,11) = (/ & + & 0.17359e+00_r8,0.20653e+00_r8,0.25158e+00_r8,0.30900e+00_r8,0.37888e+00_r8 /) + kbo(:,48,11) = (/ & + & 0.14508e+00_r8,0.17395e+00_r8,0.21335e+00_r8,0.26232e+00_r8,0.32328e+00_r8 /) + kbo(:,49,11) = (/ & + & 0.12016e+00_r8,0.14523e+00_r8,0.17928e+00_r8,0.22128e+00_r8,0.27412e+00_r8 /) + kbo(:,50,11) = (/ & + & 0.99920e-01_r8,0.12218e+00_r8,0.15097e+00_r8,0.18907e+00_r8,0.23575e+00_r8 /) + kbo(:,51,11) = (/ & + & 0.82909e-01_r8,0.10226e+00_r8,0.12737e+00_r8,0.16132e+00_r8,0.20378e+00_r8 /) + kbo(:,52,11) = (/ & + & 0.68577e-01_r8,0.85131e-01_r8,0.10673e+00_r8,0.13644e+00_r8,0.17453e+00_r8 /) + kbo(:,53,11) = (/ & + & 0.56302e-01_r8,0.70491e-01_r8,0.88684e-01_r8,0.11469e+00_r8,0.14786e+00_r8 /) + kbo(:,54,11) = (/ & + & 0.47171e-01_r8,0.59185e-01_r8,0.74877e-01_r8,0.97387e-01_r8,0.12762e+00_r8 /) + kbo(:,55,11) = (/ & + & 0.40028e-01_r8,0.50199e-01_r8,0.63960e-01_r8,0.83211e-01_r8,0.11104e+00_r8 /) + kbo(:,56,11) = (/ & + & 0.33854e-01_r8,0.42508e-01_r8,0.54649e-01_r8,0.71262e-01_r8,0.95596e-01_r8 /) + kbo(:,57,11) = (/ & + & 0.28590e-01_r8,0.36142e-01_r8,0.46409e-01_r8,0.61269e-01_r8,0.82012e-01_r8 /) + kbo(:,58,11) = (/ & + & 0.24352e-01_r8,0.30934e-01_r8,0.39697e-01_r8,0.52483e-01_r8,0.71167e-01_r8 /) + kbo(:,59,11) = (/ & + & 0.22598e-01_r8,0.29152e-01_r8,0.37468e-01_r8,0.48573e-01_r8,0.66434e-01_r8 /) + kbo(:,13,12) = (/ & + & 0.57172e+02_r8,0.59297e+02_r8,0.61400e+02_r8,0.63512e+02_r8,0.65627e+02_r8 /) + kbo(:,14,12) = (/ & + & 0.50361e+02_r8,0.52086e+02_r8,0.53828e+02_r8,0.55595e+02_r8,0.57346e+02_r8 /) + kbo(:,15,12) = (/ & + & 0.44078e+02_r8,0.45453e+02_r8,0.46902e+02_r8,0.48347e+02_r8,0.49789e+02_r8 /) + kbo(:,16,12) = (/ & + & 0.38395e+02_r8,0.39554e+02_r8,0.40754e+02_r8,0.41955e+02_r8,0.43150e+02_r8 /) + kbo(:,17,12) = (/ & + & 0.33363e+02_r8,0.34355e+02_r8,0.35352e+02_r8,0.36337e+02_r8,0.37312e+02_r8 /) + kbo(:,18,12) = (/ & + & 0.28599e+02_r8,0.29463e+02_r8,0.30307e+02_r8,0.31155e+02_r8,0.32043e+02_r8 /) + kbo(:,19,12) = (/ & + & 0.24284e+02_r8,0.24982e+02_r8,0.25685e+02_r8,0.26424e+02_r8,0.27289e+02_r8 /) + kbo(:,20,12) = (/ & + & 0.20576e+02_r8,0.21117e+02_r8,0.21693e+02_r8,0.22370e+02_r8,0.23304e+02_r8 /) + kbo(:,21,12) = (/ & + & 0.17126e+02_r8,0.17629e+02_r8,0.18193e+02_r8,0.18968e+02_r8,0.20012e+02_r8 /) + kbo(:,22,12) = (/ & + & 0.14084e+02_r8,0.14526e+02_r8,0.15112e+02_r8,0.15986e+02_r8,0.17086e+02_r8 /) + kbo(:,23,12) = (/ & + & 0.11727e+02_r8,0.12073e+02_r8,0.12663e+02_r8,0.13546e+02_r8,0.14594e+02_r8 /) + kbo(:,24,12) = (/ & + & 0.10116e+02_r8,0.10483e+02_r8,0.11087e+02_r8,0.11839e+02_r8,0.12630e+02_r8 /) + kbo(:,25,12) = (/ & + & 0.89362e+01_r8,0.93748e+01_r8,0.99578e+01_r8,0.10576e+02_r8,0.11263e+02_r8 /) + kbo(:,26,12) = (/ & + & 0.79574e+01_r8,0.84325e+01_r8,0.89960e+01_r8,0.95862e+01_r8,0.10135e+02_r8 /) + kbo(:,27,12) = (/ & + & 0.71290e+01_r8,0.76343e+01_r8,0.81343e+01_r8,0.86609e+01_r8,0.91441e+01_r8 /) + kbo(:,28,12) = (/ & + & 0.64441e+01_r8,0.69081e+01_r8,0.73340e+01_r8,0.77892e+01_r8,0.82579e+01_r8 /) + kbo(:,29,12) = (/ & + & 0.57859e+01_r8,0.61904e+01_r8,0.65762e+01_r8,0.69937e+01_r8,0.74255e+01_r8 /) + kbo(:,30,12) = (/ & + & 0.51602e+01_r8,0.55338e+01_r8,0.58953e+01_r8,0.62766e+01_r8,0.66823e+01_r8 /) + kbo(:,31,12) = (/ & + & 0.45943e+01_r8,0.49270e+01_r8,0.52739e+01_r8,0.56298e+01_r8,0.60118e+01_r8 /) + kbo(:,32,12) = (/ & + & 0.40881e+01_r8,0.44095e+01_r8,0.47450e+01_r8,0.50839e+01_r8,0.54488e+01_r8 /) + kbo(:,33,12) = (/ & + & 0.36534e+01_r8,0.39549e+01_r8,0.42670e+01_r8,0.46043e+01_r8,0.49743e+01_r8 /) + kbo(:,34,12) = (/ & + & 0.32874e+01_r8,0.35667e+01_r8,0.38571e+01_r8,0.41872e+01_r8,0.45862e+01_r8 /) + kbo(:,35,12) = (/ & + & 0.29379e+01_r8,0.31963e+01_r8,0.34845e+01_r8,0.38151e+01_r8,0.42290e+01_r8 /) + kbo(:,36,12) = (/ & + & 0.26101e+01_r8,0.28628e+01_r8,0.31405e+01_r8,0.34760e+01_r8,0.38927e+01_r8 /) + kbo(:,37,12) = (/ & + & 0.23047e+01_r8,0.25368e+01_r8,0.28124e+01_r8,0.31292e+01_r8,0.35310e+01_r8 /) + kbo(:,38,12) = (/ & + & 0.20413e+01_r8,0.22603e+01_r8,0.25129e+01_r8,0.28252e+01_r8,0.32149e+01_r8 /) + kbo(:,39,12) = (/ & + & 0.18040e+01_r8,0.20133e+01_r8,0.22565e+01_r8,0.25571e+01_r8,0.29423e+01_r8 /) + kbo(:,40,12) = (/ & + & 0.15898e+01_r8,0.17862e+01_r8,0.20189e+01_r8,0.22992e+01_r8,0.26576e+01_r8 /) + kbo(:,41,12) = (/ & + & 0.14002e+01_r8,0.15861e+01_r8,0.18008e+01_r8,0.20620e+01_r8,0.24028e+01_r8 /) + kbo(:,42,12) = (/ & + & 0.12302e+01_r8,0.14049e+01_r8,0.16015e+01_r8,0.18444e+01_r8,0.21658e+01_r8 /) + kbo(:,43,12) = (/ & + & 0.10668e+01_r8,0.12258e+01_r8,0.14101e+01_r8,0.16347e+01_r8,0.19297e+01_r8 /) + kbo(:,44,12) = (/ & + & 0.91800e+00_r8,0.10642e+01_r8,0.12324e+01_r8,0.14347e+01_r8,0.17074e+01_r8 /) + kbo(:,45,12) = (/ & + & 0.78687e+00_r8,0.91967e+00_r8,0.10737e+01_r8,0.12598e+01_r8,0.15049e+01_r8 /) + kbo(:,46,12) = (/ & + & 0.67148e+00_r8,0.79041e+00_r8,0.92761e+00_r8,0.10973e+01_r8,0.13177e+01_r8 /) + kbo(:,47,12) = (/ & + & 0.57045e+00_r8,0.67640e+00_r8,0.80034e+00_r8,0.94779e+00_r8,0.11432e+01_r8 /) + kbo(:,48,12) = (/ & + & 0.48142e+00_r8,0.57646e+00_r8,0.68676e+00_r8,0.82116e+00_r8,0.98898e+00_r8 /) + kbo(:,49,12) = (/ & + & 0.40194e+00_r8,0.48757e+00_r8,0.58498e+00_r8,0.70838e+00_r8,0.85881e+00_r8 /) + kbo(:,50,12) = (/ & + & 0.34095e+00_r8,0.41499e+00_r8,0.50425e+00_r8,0.61464e+00_r8,0.75451e+00_r8 /) + kbo(:,51,12) = (/ & + & 0.29038e+00_r8,0.35608e+00_r8,0.43553e+00_r8,0.53422e+00_r8,0.66315e+00_r8 /) + kbo(:,52,12) = (/ & + & 0.24615e+00_r8,0.30360e+00_r8,0.37359e+00_r8,0.46378e+00_r8,0.57808e+00_r8 /) + kbo(:,53,12) = (/ & + & 0.20660e+00_r8,0.25764e+00_r8,0.31993e+00_r8,0.39869e+00_r8,0.50232e+00_r8 /) + kbo(:,54,12) = (/ & + & 0.17518e+00_r8,0.22280e+00_r8,0.27852e+00_r8,0.34881e+00_r8,0.44243e+00_r8 /) + kbo(:,55,12) = (/ & + & 0.14906e+00_r8,0.19392e+00_r8,0.24538e+00_r8,0.31045e+00_r8,0.39204e+00_r8 /) + kbo(:,56,12) = (/ & + & 0.12564e+00_r8,0.16748e+00_r8,0.21535e+00_r8,0.27386e+00_r8,0.34816e+00_r8 /) + kbo(:,57,12) = (/ & + & 0.10489e+00_r8,0.14334e+00_r8,0.18902e+00_r8,0.24147e+00_r8,0.30976e+00_r8 /) + kbo(:,58,12) = (/ & + & 0.88415e-01_r8,0.12250e+00_r8,0.16566e+00_r8,0.21499e+00_r8,0.27515e+00_r8 /) + kbo(:,59,12) = (/ & + & 0.80710e-01_r8,0.11375e+00_r8,0.15629e+00_r8,0.20737e+00_r8,0.26838e+00_r8 /) + kbo(:,13,13) = (/ & + & 0.16465e+03_r8,0.16298e+03_r8,0.16413e+03_r8,0.16796e+03_r8,0.17425e+03_r8 /) + kbo(:,14,13) = (/ & + & 0.14134e+03_r8,0.14223e+03_r8,0.14584e+03_r8,0.15183e+03_r8,0.15823e+03_r8 /) + kbo(:,15,13) = (/ & + & 0.12334e+03_r8,0.12642e+03_r8,0.13170e+03_r8,0.13719e+03_r8,0.14248e+03_r8 /) + kbo(:,16,13) = (/ & + & 0.10903e+03_r8,0.11350e+03_r8,0.11825e+03_r8,0.12284e+03_r8,0.12720e+03_r8 /) + kbo(:,17,13) = (/ & + & 0.96744e+02_r8,0.10077e+03_r8,0.10473e+03_r8,0.10856e+03_r8,0.11225e+03_r8 /) + kbo(:,18,13) = (/ & + & 0.85368e+02_r8,0.88669e+02_r8,0.91934e+02_r8,0.95127e+02_r8,0.98216e+02_r8 /) + kbo(:,19,13) = (/ & + & 0.74865e+02_r8,0.77560e+02_r8,0.80263e+02_r8,0.82912e+02_r8,0.85499e+02_r8 /) + kbo(:,20,13) = (/ & + & 0.65304e+02_r8,0.67588e+02_r8,0.69849e+02_r8,0.72099e+02_r8,0.74316e+02_r8 /) + kbo(:,21,13) = (/ & + & 0.56704e+02_r8,0.58616e+02_r8,0.60541e+02_r8,0.62457e+02_r8,0.64444e+02_r8 /) + kbo(:,22,13) = (/ & + & 0.49099e+02_r8,0.50788e+02_r8,0.52451e+02_r8,0.54119e+02_r8,0.55970e+02_r8 /) + kbo(:,23,13) = (/ & + & 0.42076e+02_r8,0.43646e+02_r8,0.45230e+02_r8,0.46888e+02_r8,0.48798e+02_r8 /) + kbo(:,24,13) = (/ & + & 0.35457e+02_r8,0.36904e+02_r8,0.38447e+02_r8,0.40262e+02_r8,0.42565e+02_r8 /) + kbo(:,25,13) = (/ & + & 0.29832e+02_r8,0.31036e+02_r8,0.32508e+02_r8,0.34502e+02_r8,0.36979e+02_r8 /) + kbo(:,26,13) = (/ & + & 0.25205e+02_r8,0.26348e+02_r8,0.27792e+02_r8,0.29788e+02_r8,0.32459e+02_r8 /) + kbo(:,27,13) = (/ & + & 0.21486e+02_r8,0.22586e+02_r8,0.24162e+02_r8,0.26260e+02_r8,0.28944e+02_r8 /) + kbo(:,28,13) = (/ & + & 0.18712e+02_r8,0.19693e+02_r8,0.21370e+02_r8,0.23591e+02_r8,0.26158e+02_r8 /) + kbo(:,29,13) = (/ & + & 0.16630e+02_r8,0.17716e+02_r8,0.19369e+02_r8,0.21565e+02_r8,0.24102e+02_r8 /) + kbo(:,30,13) = (/ & + & 0.14923e+02_r8,0.16119e+02_r8,0.17783e+02_r8,0.19989e+02_r8,0.22379e+02_r8 /) + kbo(:,31,13) = (/ & + & 0.13532e+02_r8,0.14853e+02_r8,0.16576e+02_r8,0.18745e+02_r8,0.21084e+02_r8 /) + kbo(:,32,13) = (/ & + & 0.12453e+02_r8,0.13784e+02_r8,0.15587e+02_r8,0.17718e+02_r8,0.20022e+02_r8 /) + kbo(:,33,13) = (/ & + & 0.11580e+02_r8,0.13038e+02_r8,0.14851e+02_r8,0.16892e+02_r8,0.19192e+02_r8 /) + kbo(:,34,13) = (/ & + & 0.10820e+02_r8,0.12376e+02_r8,0.14134e+02_r8,0.16152e+02_r8,0.18402e+02_r8 /) + kbo(:,35,13) = (/ & + & 0.10116e+02_r8,0.11686e+02_r8,0.13402e+02_r8,0.15346e+02_r8,0.17556e+02_r8 /) + kbo(:,36,13) = (/ & + & 0.93933e+01_r8,0.10910e+02_r8,0.12572e+02_r8,0.14432e+02_r8,0.16536e+02_r8 /) + kbo(:,37,13) = (/ & + & 0.85160e+01_r8,0.99755e+01_r8,0.11554e+02_r8,0.13358e+02_r8,0.15350e+02_r8 /) + kbo(:,38,13) = (/ & + & 0.77505e+01_r8,0.91225e+01_r8,0.10670e+02_r8,0.12380e+02_r8,0.14273e+02_r8 /) + kbo(:,39,13) = (/ & + & 0.70897e+01_r8,0.83885e+01_r8,0.98694e+01_r8,0.11502e+02_r8,0.13343e+02_r8 /) + kbo(:,40,13) = (/ & + & 0.63295e+01_r8,0.75506e+01_r8,0.89466e+01_r8,0.10495e+02_r8,0.12287e+02_r8 /) + kbo(:,41,13) = (/ & + & 0.56302e+01_r8,0.67988e+01_r8,0.80957e+01_r8,0.96013e+01_r8,0.11280e+02_r8 /) + kbo(:,42,13) = (/ & + & 0.50234e+01_r8,0.61071e+01_r8,0.73389e+01_r8,0.87816e+01_r8,0.10380e+02_r8 /) + kbo(:,43,13) = (/ & + & 0.44225e+01_r8,0.54282e+01_r8,0.65963e+01_r8,0.79433e+01_r8,0.94666e+01_r8 /) + kbo(:,44,13) = (/ & + & 0.38558e+01_r8,0.47912e+01_r8,0.58905e+01_r8,0.71478e+01_r8,0.86145e+01_r8 /) + kbo(:,45,13) = (/ & + & 0.33575e+01_r8,0.42351e+01_r8,0.52475e+01_r8,0.64292e+01_r8,0.78296e+01_r8 /) + kbo(:,46,13) = (/ & + & 0.29053e+01_r8,0.37074e+01_r8,0.46432e+01_r8,0.57484e+01_r8,0.70674e+01_r8 /) + kbo(:,47,13) = (/ & + & 0.24706e+01_r8,0.31851e+01_r8,0.40524e+01_r8,0.50837e+01_r8,0.62990e+01_r8 /) + kbo(:,48,13) = (/ & + & 0.20907e+01_r8,0.27320e+01_r8,0.35232e+01_r8,0.44689e+01_r8,0.55998e+01_r8 /) + kbo(:,49,13) = (/ & + & 0.17652e+01_r8,0.23397e+01_r8,0.30525e+01_r8,0.39130e+01_r8,0.49641e+01_r8 /) + kbo(:,50,13) = (/ & + & 0.14980e+01_r8,0.19995e+01_r8,0.26386e+01_r8,0.34309e+01_r8,0.43930e+01_r8 /) + kbo(:,51,13) = (/ & + & 0.12883e+01_r8,0.17229e+01_r8,0.22808e+01_r8,0.30058e+01_r8,0.38921e+01_r8 /) + kbo(:,52,13) = (/ & + & 0.11032e+01_r8,0.14878e+01_r8,0.19945e+01_r8,0.26225e+01_r8,0.34327e+01_r8 /) + kbo(:,53,13) = (/ & + & 0.94256e+00_r8,0.12803e+01_r8,0.17436e+01_r8,0.23095e+01_r8,0.30258e+01_r8 /) + kbo(:,54,13) = (/ & + & 0.80847e+00_r8,0.11045e+01_r8,0.15250e+01_r8,0.20573e+01_r8,0.27048e+01_r8 /) + kbo(:,55,13) = (/ & + & 0.69972e+00_r8,0.95008e+00_r8,0.13215e+01_r8,0.18178e+01_r8,0.24326e+01_r8 /) + kbo(:,56,13) = (/ & + & 0.60659e+00_r8,0.81298e+00_r8,0.11430e+01_r8,0.15925e+01_r8,0.21783e+01_r8 /) + kbo(:,57,13) = (/ & + & 0.52664e+00_r8,0.69670e+00_r8,0.97998e+00_r8,0.13891e+01_r8,0.19333e+01_r8 /) + kbo(:,58,13) = (/ & + & 0.45985e+00_r8,0.60682e+00_r8,0.84337e+00_r8,0.12113e+01_r8,0.17188e+01_r8 /) + kbo(:,59,13) = (/ & + & 0.43853e+00_r8,0.57879e+00_r8,0.79018e+00_r8,0.11130e+01_r8,0.16039e+01_r8 /) + kbo(:,13,14) = (/ & + & 0.86016e+03_r8,0.84626e+03_r8,0.83228e+03_r8,0.81817e+03_r8,0.80450e+03_r8 /) + kbo(:,14,14) = (/ & + & 0.75981e+03_r8,0.74663e+03_r8,0.73345e+03_r8,0.72104e+03_r8,0.71224e+03_r8 /) + kbo(:,15,14) = (/ & + & 0.66201e+03_r8,0.64993e+03_r8,0.63891e+03_r8,0.63210e+03_r8,0.62978e+03_r8 /) + kbo(:,16,14) = (/ & + & 0.57014e+03_r8,0.56027e+03_r8,0.55466e+03_r8,0.55378e+03_r8,0.55721e+03_r8 /) + kbo(:,17,14) = (/ & + & 0.48861e+03_r8,0.48354e+03_r8,0.48324e+03_r8,0.48760e+03_r8,0.49602e+03_r8 /) + kbo(:,18,14) = (/ & + & 0.41987e+03_r8,0.41964e+03_r8,0.42411e+03_r8,0.43291e+03_r8,0.44575e+03_r8 /) + kbo(:,19,14) = (/ & + & 0.36303e+03_r8,0.36702e+03_r8,0.37556e+03_r8,0.38834e+03_r8,0.40471e+03_r8 /) + kbo(:,20,14) = (/ & + & 0.31651e+03_r8,0.32421e+03_r8,0.33627e+03_r8,0.35219e+03_r8,0.37072e+03_r8 /) + kbo(:,21,14) = (/ & + & 0.27867e+03_r8,0.28947e+03_r8,0.30434e+03_r8,0.32131e+03_r8,0.33823e+03_r8 /) + kbo(:,22,14) = (/ & + & 0.24916e+03_r8,0.26251e+03_r8,0.27768e+03_r8,0.29296e+03_r8,0.30844e+03_r8 /) + kbo(:,23,14) = (/ & + & 0.22571e+03_r8,0.23932e+03_r8,0.25291e+03_r8,0.26670e+03_r8,0.28069e+03_r8 /) + kbo(:,24,14) = (/ & + & 0.20503e+03_r8,0.21765e+03_r8,0.23029e+03_r8,0.24291e+03_r8,0.25575e+03_r8 /) + kbo(:,25,14) = (/ & + & 0.18574e+03_r8,0.19763e+03_r8,0.20960e+03_r8,0.22151e+03_r8,0.23356e+03_r8 /) + kbo(:,26,14) = (/ & + & 0.16825e+03_r8,0.17945e+03_r8,0.19085e+03_r8,0.20242e+03_r8,0.21406e+03_r8 /) + kbo(:,27,14) = (/ & + & 0.15254e+03_r8,0.16311e+03_r8,0.17402e+03_r8,0.18521e+03_r8,0.19696e+03_r8 /) + kbo(:,28,14) = (/ & + & 0.13815e+03_r8,0.14857e+03_r8,0.15913e+03_r8,0.17022e+03_r8,0.18238e+03_r8 /) + kbo(:,29,14) = (/ & + & 0.12560e+03_r8,0.13571e+03_r8,0.14630e+03_r8,0.15763e+03_r8,0.17019e+03_r8 /) + kbo(:,30,14) = (/ & + & 0.11497e+03_r8,0.12476e+03_r8,0.13550e+03_r8,0.14719e+03_r8,0.16044e+03_r8 /) + kbo(:,31,14) = (/ & + & 0.10602e+03_r8,0.11577e+03_r8,0.12671e+03_r8,0.13889e+03_r8,0.15289e+03_r8 /) + kbo(:,32,14) = (/ & + & 0.98519e+02_r8,0.10855e+03_r8,0.11978e+03_r8,0.13265e+03_r8,0.14744e+03_r8 /) + kbo(:,33,14) = (/ & + & 0.92517e+02_r8,0.10274e+03_r8,0.11452e+03_r8,0.12822e+03_r8,0.14389e+03_r8 /) + kbo(:,34,14) = (/ & + & 0.87441e+02_r8,0.97936e+02_r8,0.11044e+03_r8,0.12495e+03_r8,0.14148e+03_r8 /) + kbo(:,35,14) = (/ & + & 0.82499e+02_r8,0.93333e+02_r8,0.10635e+03_r8,0.12151e+03_r8,0.13874e+03_r8 /) + kbo(:,36,14) = (/ & + & 0.77442e+02_r8,0.88493e+02_r8,0.10184e+03_r8,0.11740e+03_r8,0.13513e+03_r8 /) + kbo(:,37,14) = (/ & + & 0.71771e+02_r8,0.82731e+02_r8,0.96032e+02_r8,0.11158e+03_r8,0.12941e+03_r8 /) + kbo(:,38,14) = (/ & + & 0.66727e+02_r8,0.77610e+02_r8,0.90795e+02_r8,0.10632e+03_r8,0.12415e+03_r8 /) + kbo(:,39,14) = (/ & + & 0.62339e+02_r8,0.73113e+02_r8,0.86200e+02_r8,0.10167e+03_r8,0.11942e+03_r8 /) + kbo(:,40,14) = (/ & + & 0.57601e+02_r8,0.67999e+02_r8,0.80724e+02_r8,0.95858e+02_r8,0.11323e+03_r8 /) + kbo(:,41,14) = (/ & + & 0.53285e+02_r8,0.63203e+02_r8,0.75577e+02_r8,0.90242e+02_r8,0.10726e+03_r8 /) + kbo(:,42,14) = (/ & + & 0.49392e+02_r8,0.58908e+02_r8,0.70834e+02_r8,0.85045e+02_r8,0.10163e+03_r8 /) + kbo(:,43,14) = (/ & + & 0.45446e+02_r8,0.54452e+02_r8,0.65751e+02_r8,0.79402e+02_r8,0.95397e+02_r8 /) + kbo(:,44,14) = (/ & + & 0.41620e+02_r8,0.50184e+02_r8,0.60777e+02_r8,0.73786e+02_r8,0.89076e+02_r8 /) + kbo(:,45,14) = (/ & + & 0.38059e+02_r8,0.46282e+02_r8,0.56226e+02_r8,0.68539e+02_r8,0.83136e+02_r8 /) + kbo(:,46,14) = (/ & + & 0.34554e+02_r8,0.42501e+02_r8,0.51829e+02_r8,0.63383e+02_r8,0.77220e+02_r8 /) + kbo(:,47,14) = (/ & + & 0.31009e+02_r8,0.38610e+02_r8,0.47385e+02_r8,0.58058e+02_r8,0.71080e+02_r8 /) + kbo(:,48,14) = (/ & + & 0.27715e+02_r8,0.34934e+02_r8,0.43319e+02_r8,0.53190e+02_r8,0.65347e+02_r8 /) + kbo(:,49,14) = (/ & + & 0.24658e+02_r8,0.31478e+02_r8,0.39500e+02_r8,0.48743e+02_r8,0.59997e+02_r8 /) + kbo(:,50,14) = (/ & + & 0.22034e+02_r8,0.28437e+02_r8,0.36093e+02_r8,0.44894e+02_r8,0.55346e+02_r8 /) + kbo(:,51,14) = (/ & + & 0.19684e+02_r8,0.25626e+02_r8,0.32937e+02_r8,0.41385e+02_r8,0.51154e+02_r8 /) + kbo(:,52,14) = (/ & + & 0.17504e+02_r8,0.22995e+02_r8,0.29925e+02_r8,0.38057e+02_r8,0.47307e+02_r8 /) + kbo(:,53,14) = (/ & + & 0.15552e+02_r8,0.20544e+02_r8,0.27079e+02_r8,0.34832e+02_r8,0.43722e+02_r8 /) + kbo(:,54,14) = (/ & + & 0.13886e+02_r8,0.18476e+02_r8,0.24607e+02_r8,0.31966e+02_r8,0.40540e+02_r8 /) + kbo(:,55,14) = (/ & + & 0.12396e+02_r8,0.16681e+02_r8,0.22385e+02_r8,0.29384e+02_r8,0.37592e+02_r8 /) + kbo(:,56,14) = (/ & + & 0.11028e+02_r8,0.15006e+02_r8,0.20297e+02_r8,0.26955e+02_r8,0.34780e+02_r8 /) + kbo(:,57,14) = (/ & + & 0.97493e+01_r8,0.13452e+02_r8,0.18354e+02_r8,0.24644e+02_r8,0.32099e+02_r8 /) + kbo(:,58,14) = (/ & + & 0.86411e+01_r8,0.12068e+02_r8,0.16627e+02_r8,0.22569e+02_r8,0.29684e+02_r8 /) + kbo(:,59,14) = (/ & + & 0.80894e+01_r8,0.11449e+02_r8,0.15905e+02_r8,0.21753e+02_r8,0.28728e+02_r8 /) + kbo(:,13,15) = (/ & + & 0.50046e+04_r8,0.50034e+04_r8,0.49950e+04_r8,0.49781e+04_r8,0.49542e+04_r8 /) + kbo(:,14,15) = (/ & + & 0.51812e+04_r8,0.51738e+04_r8,0.51582e+04_r8,0.51357e+04_r8,0.51054e+04_r8 /) + kbo(:,15,15) = (/ & + & 0.52793e+04_r8,0.52645e+04_r8,0.52450e+04_r8,0.52172e+04_r8,0.51836e+04_r8 /) + kbo(:,16,15) = (/ & + & 0.53001e+04_r8,0.52818e+04_r8,0.52568e+04_r8,0.52274e+04_r8,0.51924e+04_r8 /) + kbo(:,17,15) = (/ & + & 0.52448e+04_r8,0.52242e+04_r8,0.52004e+04_r8,0.51715e+04_r8,0.51377e+04_r8 /) + kbo(:,18,15) = (/ & + & 0.51200e+04_r8,0.51031e+04_r8,0.50817e+04_r8,0.50571e+04_r8,0.50308e+04_r8 /) + kbo(:,19,15) = (/ & + & 0.49389e+04_r8,0.49284e+04_r8,0.49153e+04_r8,0.49007e+04_r8,0.48819e+04_r8 /) + kbo(:,20,15) = (/ & + & 0.47181e+04_r8,0.47168e+04_r8,0.47163e+04_r8,0.47129e+04_r8,0.47111e+04_r8 /) + kbo(:,21,15) = (/ & + & 0.44718e+04_r8,0.44865e+04_r8,0.44990e+04_r8,0.45153e+04_r8,0.45403e+04_r8 /) + kbo(:,22,15) = (/ & + & 0.42192e+04_r8,0.42497e+04_r8,0.42861e+04_r8,0.43316e+04_r8,0.43809e+04_r8 /) + kbo(:,23,15) = (/ & + & 0.39727e+04_r8,0.40275e+04_r8,0.40936e+04_r8,0.41646e+04_r8,0.42404e+04_r8 /) + kbo(:,24,15) = (/ & + & 0.37507e+04_r8,0.38336e+04_r8,0.39239e+04_r8,0.40206e+04_r8,0.41209e+04_r8 /) + kbo(:,25,15) = (/ & + & 0.35606e+04_r8,0.36694e+04_r8,0.37826e+04_r8,0.39026e+04_r8,0.40244e+04_r8 /) + kbo(:,26,15) = (/ & + & 0.34043e+04_r8,0.35364e+04_r8,0.36731e+04_r8,0.38130e+04_r8,0.39519e+04_r8 /) + kbo(:,27,15) = (/ & + & 0.32803e+04_r8,0.34346e+04_r8,0.35912e+04_r8,0.37476e+04_r8,0.39014e+04_r8 /) + kbo(:,28,15) = (/ & + & 0.31876e+04_r8,0.33610e+04_r8,0.35344e+04_r8,0.37042e+04_r8,0.38699e+04_r8 /) + kbo(:,29,15) = (/ & + & 0.31239e+04_r8,0.33137e+04_r8,0.34995e+04_r8,0.36813e+04_r8,0.38573e+04_r8 /) + kbo(:,30,15) = (/ & + & 0.30850e+04_r8,0.32872e+04_r8,0.34837e+04_r8,0.36745e+04_r8,0.38591e+04_r8 /) + kbo(:,31,15) = (/ & + & 0.30674e+04_r8,0.32795e+04_r8,0.34848e+04_r8,0.36826e+04_r8,0.38724e+04_r8 /) + kbo(:,32,15) = (/ & + & 0.30683e+04_r8,0.32879e+04_r8,0.34990e+04_r8,0.37022e+04_r8,0.38953e+04_r8 /) + kbo(:,33,15) = (/ & + & 0.30831e+04_r8,0.33087e+04_r8,0.35243e+04_r8,0.37303e+04_r8,0.39250e+04_r8 /) + kbo(:,34,15) = (/ & + & 0.31017e+04_r8,0.33308e+04_r8,0.35496e+04_r8,0.37580e+04_r8,0.39527e+04_r8 /) + kbo(:,35,15) = (/ & + & 0.31057e+04_r8,0.33387e+04_r8,0.35601e+04_r8,0.37700e+04_r8,0.39654e+04_r8 /) + kbo(:,36,15) = (/ & + & 0.30895e+04_r8,0.33260e+04_r8,0.35504e+04_r8,0.37630e+04_r8,0.39606e+04_r8 /) + kbo(:,37,15) = (/ & + & 0.30400e+04_r8,0.32811e+04_r8,0.35096e+04_r8,0.37263e+04_r8,0.39277e+04_r8 /) + kbo(:,38,15) = (/ & + & 0.29913e+04_r8,0.32361e+04_r8,0.34690e+04_r8,0.36890e+04_r8,0.38942e+04_r8 /) + kbo(:,39,15) = (/ & + & 0.29441e+04_r8,0.31926e+04_r8,0.34294e+04_r8,0.36526e+04_r8,0.38612e+04_r8 /) + kbo(:,40,15) = (/ & + & 0.28722e+04_r8,0.31254e+04_r8,0.33667e+04_r8,0.35943e+04_r8,0.38073e+04_r8 /) + kbo(:,41,15) = (/ & + & 0.27971e+04_r8,0.30548e+04_r8,0.33004e+04_r8,0.35326e+04_r8,0.37505e+04_r8 /) + kbo(:,42,15) = (/ & + & 0.27226e+04_r8,0.29837e+04_r8,0.32336e+04_r8,0.34701e+04_r8,0.36925e+04_r8 /) + kbo(:,43,15) = (/ & + & 0.26332e+04_r8,0.28981e+04_r8,0.31525e+04_r8,0.33944e+04_r8,0.36223e+04_r8 /) + kbo(:,44,15) = (/ & + & 0.25372e+04_r8,0.28050e+04_r8,0.30643e+04_r8,0.33114e+04_r8,0.35441e+04_r8 /) + kbo(:,45,15) = (/ & + & 0.24417e+04_r8,0.27113e+04_r8,0.29748e+04_r8,0.32268e+04_r8,0.34651e+04_r8 /) + kbo(:,46,15) = (/ & + & 0.23395e+04_r8,0.26115e+04_r8,0.28783e+04_r8,0.31351e+04_r8,0.33792e+04_r8 /) + kbo(:,47,15) = (/ & + & 0.22243e+04_r8,0.24998e+04_r8,0.27694e+04_r8,0.30313e+04_r8,0.32810e+04_r8 /) + kbo(:,48,15) = (/ & + & 0.21083e+04_r8,0.23877e+04_r8,0.26592e+04_r8,0.29257e+04_r8,0.31803e+04_r8 /) + kbo(:,49,15) = (/ & + & 0.19925e+04_r8,0.22741e+04_r8,0.25488e+04_r8,0.28180e+04_r8,0.30783e+04_r8 /) + kbo(:,50,15) = (/ & + & 0.18841e+04_r8,0.21666e+04_r8,0.24447e+04_r8,0.27159e+04_r8,0.29806e+04_r8 /) + kbo(:,51,15) = (/ & + & 0.17798e+04_r8,0.20618e+04_r8,0.23428e+04_r8,0.26160e+04_r8,0.28839e+04_r8 /) + kbo(:,52,15) = (/ & + & 0.16762e+04_r8,0.19574e+04_r8,0.22398e+04_r8,0.25156e+04_r8,0.27862e+04_r8 /) + kbo(:,53,15) = (/ & + & 0.15731e+04_r8,0.18530e+04_r8,0.21358e+04_r8,0.24152e+04_r8,0.26872e+04_r8 /) + kbo(:,54,15) = (/ & + & 0.14802e+04_r8,0.17581e+04_r8,0.20401e+04_r8,0.23219e+04_r8,0.25956e+04_r8 /) + kbo(:,55,15) = (/ & + & 0.13915e+04_r8,0.16675e+04_r8,0.19488e+04_r8,0.22318e+04_r8,0.25080e+04_r8 /) + kbo(:,56,15) = (/ & + & 0.13039e+04_r8,0.15778e+04_r8,0.18577e+04_r8,0.21406e+04_r8,0.24200e+04_r8 /) + kbo(:,57,15) = (/ & + & 0.12167e+04_r8,0.14890e+04_r8,0.17672e+04_r8,0.20493e+04_r8,0.23313e+04_r8 /) + kbo(:,58,15) = (/ & + & 0.11349e+04_r8,0.14057e+04_r8,0.16818e+04_r8,0.19631e+04_r8,0.22464e+04_r8 /) + kbo(:,59,15) = (/ & + & 0.11025e+04_r8,0.13721e+04_r8,0.16476e+04_r8,0.19283e+04_r8,0.22117e+04_r8 /) + kbo(:,13,16) = (/ & + & 0.12492e+05_r8,0.12602e+05_r8,0.12678e+05_r8,0.12730e+05_r8,0.12749e+05_r8 /) + kbo(:,14,16) = (/ & + & 0.14696e+05_r8,0.14792e+05_r8,0.14862e+05_r8,0.14890e+05_r8,0.14889e+05_r8 /) + kbo(:,15,16) = (/ & + & 0.17153e+05_r8,0.17242e+05_r8,0.17275e+05_r8,0.17274e+05_r8,0.17231e+05_r8 /) + kbo(:,16,16) = (/ & + & 0.19843e+05_r8,0.19894e+05_r8,0.19898e+05_r8,0.19845e+05_r8,0.19747e+05_r8 /) + kbo(:,17,16) = (/ & + & 0.22727e+05_r8,0.22731e+05_r8,0.22667e+05_r8,0.22551e+05_r8,0.22386e+05_r8 /) + kbo(:,18,16) = (/ & + & 0.25761e+05_r8,0.25684e+05_r8,0.25544e+05_r8,0.25342e+05_r8,0.25070e+05_r8 /) + kbo(:,19,16) = (/ & + & 0.28878e+05_r8,0.28701e+05_r8,0.28454e+05_r8,0.28131e+05_r8,0.27759e+05_r8 /) + kbo(:,20,16) = (/ & + & 0.31981e+05_r8,0.31695e+05_r8,0.31314e+05_r8,0.30871e+05_r8,0.30360e+05_r8 /) + kbo(:,21,16) = (/ & + & 0.35017e+05_r8,0.34575e+05_r8,0.34064e+05_r8,0.33480e+05_r8,0.32821e+05_r8 /) + kbo(:,22,16) = (/ & + & 0.37854e+05_r8,0.37264e+05_r8,0.36589e+05_r8,0.35840e+05_r8,0.35046e+05_r8 /) + kbo(:,23,16) = (/ & + & 0.40473e+05_r8,0.39710e+05_r8,0.38862e+05_r8,0.37967e+05_r8,0.37023e+05_r8 /) + kbo(:,24,16) = (/ & + & 0.42796e+05_r8,0.41864e+05_r8,0.40869e+05_r8,0.39817e+05_r8,0.38718e+05_r8 /) + kbo(:,25,16) = (/ & + & 0.44813e+05_r8,0.43719e+05_r8,0.42578e+05_r8,0.41380e+05_r8,0.40143e+05_r8 /) + kbo(:,26,16) = (/ & + & 0.46504e+05_r8,0.45263e+05_r8,0.43973e+05_r8,0.42641e+05_r8,0.41294e+05_r8 /) + kbo(:,27,16) = (/ & + & 0.47893e+05_r8,0.46507e+05_r8,0.45087e+05_r8,0.43647e+05_r8,0.42197e+05_r8 /) + kbo(:,28,16) = (/ & + & 0.48993e+05_r8,0.47480e+05_r8,0.45952e+05_r8,0.44417e+05_r8,0.42878e+05_r8 /) + kbo(:,29,16) = (/ & + & 0.49823e+05_r8,0.48206e+05_r8,0.46588e+05_r8,0.44969e+05_r8,0.43353e+05_r8 /) + kbo(:,30,16) = (/ & + & 0.50415e+05_r8,0.48716e+05_r8,0.47025e+05_r8,0.45339e+05_r8,0.43659e+05_r8 /) + kbo(:,31,16) = (/ & + & 0.50811e+05_r8,0.49042e+05_r8,0.47288e+05_r8,0.45543e+05_r8,0.43813e+05_r8 /) + kbo(:,32,16) = (/ & + & 0.51032e+05_r8,0.49203e+05_r8,0.47400e+05_r8,0.45610e+05_r8,0.43841e+05_r8 /) + kbo(:,33,16) = (/ & + & 0.51107e+05_r8,0.49234e+05_r8,0.47393e+05_r8,0.45565e+05_r8,0.43775e+05_r8 /) + kbo(:,34,16) = (/ & + & 0.51130e+05_r8,0.49228e+05_r8,0.47350e+05_r8,0.45497e+05_r8,0.43688e+05_r8 /) + kbo(:,35,16) = (/ & + & 0.51256e+05_r8,0.49316e+05_r8,0.47413e+05_r8,0.45540e+05_r8,0.43711e+05_r8 /) + kbo(:,36,16) = (/ & + & 0.51519e+05_r8,0.49555e+05_r8,0.47626e+05_r8,0.45731e+05_r8,0.43885e+05_r8 /) + kbo(:,37,16) = (/ & + & 0.52034e+05_r8,0.50041e+05_r8,0.48090e+05_r8,0.46168e+05_r8,0.44302e+05_r8 /) + kbo(:,38,16) = (/ & + & 0.52529e+05_r8,0.50511e+05_r8,0.48535e+05_r8,0.46595e+05_r8,0.44706e+05_r8 /) + kbo(:,39,16) = (/ & + & 0.52985e+05_r8,0.50952e+05_r8,0.48954e+05_r8,0.46996e+05_r8,0.45085e+05_r8 /) + kbo(:,40,16) = (/ & + & 0.53633e+05_r8,0.51575e+05_r8,0.49556e+05_r8,0.47578e+05_r8,0.45648e+05_r8 /) + kbo(:,41,16) = (/ & + & 0.54289e+05_r8,0.52211e+05_r8,0.50171e+05_r8,0.48171e+05_r8,0.46220e+05_r8 /) + kbo(:,42,16) = (/ & + & 0.54932e+05_r8,0.52836e+05_r8,0.50778e+05_r8,0.48759e+05_r8,0.46785e+05_r8 /) + kbo(:,43,16) = (/ & + & 0.55673e+05_r8,0.53569e+05_r8,0.51488e+05_r8,0.49449e+05_r8,0.47456e+05_r8 /) + kbo(:,44,16) = (/ & + & 0.56461e+05_r8,0.54346e+05_r8,0.52247e+05_r8,0.50190e+05_r8,0.48178e+05_r8 /) + kbo(:,45,16) = (/ & + & 0.57241e+05_r8,0.55121e+05_r8,0.53007e+05_r8,0.50929e+05_r8,0.48897e+05_r8 /) + kbo(:,46,16) = (/ & + & 0.58063e+05_r8,0.55933e+05_r8,0.53806e+05_r8,0.51710e+05_r8,0.49656e+05_r8 /) + kbo(:,47,16) = (/ & + & 0.58978e+05_r8,0.56828e+05_r8,0.54697e+05_r8,0.52582e+05_r8,0.50505e+05_r8 /) + kbo(:,48,16) = (/ & + & 0.59891e+05_r8,0.57720e+05_r8,0.55586e+05_r8,0.53459e+05_r8,0.51367e+05_r8 /) + kbo(:,49,16) = (/ & + & 0.60795e+05_r8,0.58621e+05_r8,0.56472e+05_r8,0.54336e+05_r8,0.52224e+05_r8 /) + kbo(:,50,16) = (/ & + & 0.61639e+05_r8,0.59466e+05_r8,0.57298e+05_r8,0.55162e+05_r8,0.53034e+05_r8 /) + kbo(:,51,16) = (/ & + & 0.62447e+05_r8,0.60284e+05_r8,0.58110e+05_r8,0.55961e+05_r8,0.53824e+05_r8 /) + kbo(:,52,16) = (/ & + & 0.63240e+05_r8,0.61098e+05_r8,0.58916e+05_r8,0.56760e+05_r8,0.54612e+05_r8 /) + kbo(:,53,16) = (/ & + & 0.64030e+05_r8,0.61903e+05_r8,0.59727e+05_r8,0.57558e+05_r8,0.55411e+05_r8 /) + kbo(:,54,16) = (/ & + & 0.64735e+05_r8,0.62637e+05_r8,0.60471e+05_r8,0.58287e+05_r8,0.56138e+05_r8 /) + kbo(:,55,16) = (/ & + & 0.65407e+05_r8,0.63332e+05_r8,0.61181e+05_r8,0.59003e+05_r8,0.56834e+05_r8 /) + kbo(:,56,16) = (/ & + & 0.66069e+05_r8,0.64015e+05_r8,0.61881e+05_r8,0.59702e+05_r8,0.57529e+05_r8 /) + kbo(:,57,16) = (/ & + & 0.66725e+05_r8,0.64683e+05_r8,0.62576e+05_r8,0.60411e+05_r8,0.58225e+05_r8 /) + kbo(:,58,16) = (/ & + & 0.67327e+05_r8,0.65315e+05_r8,0.63232e+05_r8,0.61078e+05_r8,0.58891e+05_r8 /) + kbo(:,59,16) = (/ & + & 0.67577e+05_r8,0.65572e+05_r8,0.63496e+05_r8,0.61349e+05_r8,0.59161e+05_r8 /) + +! ----------------------------------------------------------------- + + forrefo(:, 1) = (/ 0.299818e-05_r8, 0.209282e-05_r8, 0.988353e-04_r8, 0.632178e-03_r8 /) + forrefo(:, 2) = (/ 0.633648e-05_r8, 0.509214e-04_r8, 0.650535e-03_r8, 0.264019e-02_r8 /) + forrefo(:, 3) = (/ 0.636782e-04_r8, 0.136577e-03_r8, 0.166500e-02_r8, 0.750821e-02_r8 /) + forrefo(:, 4) = (/ 0.472314e-03_r8, 0.988296e-03_r8, 0.585751e-02_r8, 0.187352e-01_r8 /) + forrefo(:, 5) = (/ 0.558635e-02_r8, 0.856489e-02_r8, 0.157438e-01_r8, 0.181471e-01_r8 /) + forrefo(:, 6) = (/ 0.217395e-01_r8, 0.229156e-01_r8, 0.230125e-01_r8, 0.143821e-01_r8 /) + forrefo(:, 7) = (/ 0.277222e-01_r8, 0.299252e-01_r8, 0.208929e-01_r8, 0.826748e-02_r8 /) + forrefo(:, 8) = (/ 0.252119e-01_r8, 0.262911e-01_r8, 0.187663e-01_r8, 0.417110e-02_r8 /) + forrefo(:, 9) = (/ 0.304941e-01_r8, 0.175545e-01_r8, 0.971224e-02_r8, 0.142023e-02_r8 /) + forrefo(:,10) = (/ 0.327200e-01_r8, 0.215788e-01_r8, 0.346831e-02_r8, 0.157989e-02_r8 /) + forrefo(:,11) = (/ 0.324955e-01_r8, 0.228571e-01_r8, 0.171749e-02_r8, 0.226853e-02_r8 /) + forrefo(:,12) = (/ 0.326588e-01_r8, 0.198544e-01_r8, 0.532339e-06_r8, 0.279086e-02_r8 /) + forrefo(:,13) = (/ 0.345157e-01_r8, 0.168679e-01_r8, 0.505361e-06_r8, 0.276647e-02_r8 /) + forrefo(:,14) = (/ 0.448765e-01_r8, 0.123791e-02_r8, 0.488367e-06_r8, 0.122245e-02_r8 /) + forrefo(:,15) = (/ 0.486925e-01_r8, 0.464371e-06_r8, 0.464241e-06_r8, 0.753846e-06_r8 /) + forrefo(:,16) = (/ 0.530511e-01_r8, 0.376234e-06_r8, 0.409824e-06_r8, 0.470650e-06_r8 /) + +! ----------------------------------------------------------------- +! The array SELFREFO contains the coefficient of the water vapor +! self-continuum (including the energy term). The first index +! refers to temperature in 7.2 degree increments. For instance, +! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, +! etc. The second index runs over the g-channel (1 to 16). + + selfrefo(:, 1) = (/ & + & 0.118069e+00_r8, 0.713523e-01_r8, 0.431199e-01_r8, 0.260584e-01_r8, 0.157477e-01_r8, & + & 0.951675e-02_r8, 0.575121e-02_r8, 0.347560e-02_r8, 0.210039e-02_r8, 0.126932e-02_r8 /) + selfrefo(:, 2) = (/ & + & 0.137081e-01_r8, 0.139046e-01_r8, 0.141040e-01_r8, 0.143061e-01_r8, 0.145112e-01_r8, & + & 0.147193e-01_r8, 0.149303e-01_r8, 0.151443e-01_r8, 0.153614e-01_r8, 0.155816e-01_r8 /) + selfrefo(:, 3) = (/ & + & 0.166575e-01_r8, 0.164916e-01_r8, 0.163273e-01_r8, 0.161647e-01_r8, 0.160037e-01_r8, & + & 0.158443e-01_r8, 0.156864e-01_r8, 0.155302e-01_r8, 0.153755e-01_r8, 0.152224e-01_r8 /) + selfrefo(:, 4) = (/ & + & 0.597379e-01_r8, 0.509517e-01_r8, 0.434579e-01_r8, 0.370662e-01_r8, 0.316145e-01_r8, & + & 0.269647e-01_r8, 0.229988e-01_r8, 0.196162e-01_r8, 0.167311e-01_r8, 0.142703e-01_r8 /) + selfrefo(:, 5) = (/ & + & 0.227517e+00_r8, 0.198401e+00_r8, 0.173011e+00_r8, 0.150870e+00_r8, 0.131563e+00_r8, & + & 0.114726e+00_r8, 0.100044e+00_r8, 0.872415e-01_r8, 0.760769e-01_r8, 0.663411e-01_r8 /) + selfrefo(:, 6) = (/ & + & 0.453235e+00_r8, 0.414848e+00_r8, 0.379712e+00_r8, 0.347552e+00_r8, 0.318116e+00_r8, & + & 0.291173e+00_r8, 0.266512e+00_r8, 0.243940e+00_r8, 0.223279e+00_r8, 0.204368e+00_r8 /) + selfrefo(:, 7) = (/ & + & 0.569263e+00_r8, 0.516415e+00_r8, 0.468473e+00_r8, 0.424982e+00_r8, 0.385528e+00_r8, & + & 0.349737e+00_r8, 0.317269e+00_r8, 0.287815e+00_r8, 0.261095e+00_r8, 0.236856e+00_r8 /) + selfrefo(:, 8) = (/ & + & 0.490314e+00_r8, 0.448042e+00_r8, 0.409413e+00_r8, 0.374116e+00_r8, 0.341861e+00_r8, & + & 0.312387e+00_r8, 0.285455e+00_r8, 0.260844e+00_r8, 0.238355e+00_r8, 0.217805e+00_r8 /) + selfrefo(:, 9) = (/ & + & 0.258162e+00_r8, 0.265085e+00_r8, 0.272193e+00_r8, 0.279493e+00_r8, 0.286988e+00_r8, & + & 0.294684e+00_r8, 0.302586e+00_r8, 0.310701e+00_r8, 0.319033e+00_r8, 0.327588e+00_r8 /) + selfrefo(:,10) = (/ & + & 0.332019e+00_r8, 0.331902e+00_r8, 0.331784e+00_r8, 0.331666e+00_r8, 0.331549e+00_r8, & + & 0.331431e+00_r8, 0.331314e+00_r8, 0.331197e+00_r8, 0.331079e+00_r8, 0.330962e+00_r8 /) + selfrefo(:,11) = (/ & + & 0.357523e+00_r8, 0.353154e+00_r8, 0.348839e+00_r8, 0.344576e+00_r8, 0.340366e+00_r8, & + & 0.336207e+00_r8, 0.332099e+00_r8, 0.328041e+00_r8, 0.324032e+00_r8, 0.320073e+00_r8 /) + selfrefo(:,12) = (/ & + & 0.294662e+00_r8, 0.299043e+00_r8, 0.303488e+00_r8, 0.308000e+00_r8, 0.312579e+00_r8, & + & 0.317226e+00_r8, 0.321941e+00_r8, 0.326727e+00_r8, 0.331585e+00_r8, 0.336514e+00_r8 /) + selfrefo(:,13) = (/ & + & 0.227445e+00_r8, 0.241545e+00_r8, 0.256519e+00_r8, 0.272422e+00_r8, 0.289311e+00_r8, & + & 0.307247e+00_r8, 0.326294e+00_r8, 0.346523e+00_r8, 0.368005e+00_r8, 0.390820e+00_r8 /) + selfrefo(:,14) = (/ & + & 0.616203e-02_r8, 0.113523e-01_r8, 0.209144e-01_r8, 0.385307e-01_r8, 0.709852e-01_r8, & + & 0.130776e+00_r8, 0.240929e+00_r8, 0.443865e+00_r8, 0.817733e+00_r8, 0.150651e+01_r8 /) + selfrefo(:,15) = (/ & + & 0.279552e-03_r8, 0.808472e-03_r8, 0.233812e-02_r8, 0.676192e-02_r8, 0.195557e-01_r8, & + & 0.565555e-01_r8, 0.163560e+00_r8, 0.473020e+00_r8, 0.136799e+01_r8, 0.395626e+01_r8 /) + selfrefo(:,16) = (/ & + & 0.261006e-03_r8, 0.771043e-03_r8, 0.227776e-02_r8, 0.672879e-02_r8, 0.198777e-01_r8, & + & 0.587212e-01_r8, 0.173470e+00_r8, 0.512452e+00_r8, 0.151385e+01_r8, 0.447209e+01_r8 /) + + end subroutine sw_kgb29 + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 new file mode 100644 index 0000000000..450c64fac6 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_rad.f90 @@ -0,0 +1,882 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.6 $ +! created: $Date: 2008/01/03 21:35:35 $ +! + +module rrtmg_sw_rad + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! +! **************************************************************************** +! * * +! * RRTMG_SW * +! * * +! * * +! * * +! * a rapid radiative transfer model * +! * for the solar spectral region * +! * for application to general circulation models * +! * * +! * * +! * Atmospheric and Environmental Research, Inc. * +! * 131 Hartwell Avenue * +! * Lexington, MA 02421 * +! * * +! * * +! * Eli J. Mlawer * +! * Jennifer S. Delamere * +! * Michael J. Iacono * +! * Shepard A. Clough * +! * * +! * * +! * * +! * * +! * * +! * * +! * email: miacono@aer.com * +! * email: emlawer@aer.com * +! * email: jdelamer@aer.com * +! * * +! * The authors wish to acknowledge the contributions of the * +! * following people: Steven J. Taubman, Patrick D. Brown, * +! * Ronald E. Farren, Luke Chen, Robert Bergstrom. * +! * * +! **************************************************************************** + +! --------- Modules --------- + +use shr_kind_mod, only: r8=>shr_kind_r8 + +use mcica_subcol_gen_sw, only: mcica_subcol_sw +use rrtmg_sw_cldprmc, only: cldprmc_sw +use rrtmg_sw_setcoef, only: setcoef_sw +use rrtmg_sw_spcvmc, only: spcvmc_sw + +implicit none + +public :: rrtmg_sw + +! CAM supplies shortwave cloud optical properties +integer, parameter :: inflag = 0 ! flag for cloud parameterization method +integer, parameter :: iceflag = 0 ! flag for ice cloud parameterization method +integer, parameter :: liqflag = 0 ! flag for liquid cloud parameterization method + +! Set iaer to select aerosol option +! iaer = 0, no aerosols +! iaer = 10, input total aerosol optical depth, single scattering albedo +! and asymmetry parameter (tauaer, ssaaer, asmaer) directly +integer, parameter :: iaer = 10 + +! Set idelm to select between delta-M scaled or unscaled output direct and diffuse fluxes +! NOTE: total downward fluxes are always delta scaled +! idelm = 0, output direct and diffuse flux components are not delta scaled +! (direct flux does not include forward scattering peak) +! idelm = 1, output direct and diffuse flux components are delta scaled (default) +! (direct flux includes part or most of forward scattering peak) +integer, parameter :: idelm = 1 + +!========================================================================================= +contains +!========================================================================================= + +subroutine rrtmg_sw & + (lchnk ,ncol ,nlay ,icld , & + play ,plev ,tlay ,tlev ,tsfc , & + h2ovmr ,o3vmr ,co2vmr ,ch4vmr ,o2vmr ,n2ovmr , & + asdir ,asdif ,aldir ,aldif , & + coszen ,adjes ,dyofyr ,solvar, & + cldfmcl ,taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl, & + ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , & + tauaer ,ssaaer ,asmaer , & + swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, & + dirdnuv, dirdnir, difdnuv, difdnir, ninflx, ninflxc, & + swuflxs, swdflxs) + + +! ------- Description ------- + +! This program is the driver for RRTMG_SW, the AER SW radiation model for +! application to GCMs, that has been adapted from RRTM_SW for improved +! efficiency and to provide fractional cloudiness and cloud overlap +! capability using McICA. +! +! This routine +! b) calls INATM_SW to read in the atmospheric profile; +! all layering in RRTMG is ordered from surface to toa. +! c) calls CLDPRMC_SW to set cloud optical depth for McICA based +! on input cloud properties +! d) calls SETCOEF_SW to calculate various quantities needed for +! the radiative transfer algorithm +! e) calls SPCVMC to call the two-stream model that in turn +! calls TAUMOL to calculate gaseous optical depths for each +! of the 16 spectral bands and to perform the radiative transfer +! using McICA, the Monte-Carlo Independent Column Approximation, +! to represent sub-grid scale cloud variability +! f) passes the calculated fluxes and cooling rates back to GCM +! +! *** This version uses McICA *** +! Monte Carlo Independent Column Approximation (McICA, Pincus et al., +! JC, 2003) method is applied to the forward model calculation +! This method is valid for clear sky or partial cloud conditions. +! +! This call to RRTMG_SW must be preceeded by a call to the module +! mcica_subcol_gen_sw.f90 to run the McICA sub-column cloud generator, +! which will provide the cloud physical or cloud optical properties +! on the RRTMG quadrature point (ngptsw) dimension. +! +! *** This version only allows input of cloud optical properties *** +! Input cloud fraction, cloud optical depth, single scattering albedo +! and asymmetry parameter directly (inflg = 0) +! +! *** This version only allows input of aerosol optical properties *** +! Input aerosol optical depth, single scattering albedo and asymmetry +! parameter directly by layer and spectral band (iaer=10) +! +! +! ------- Modifications ------- +! +! This version of RRTMG_SW has been modified from RRTM_SW to use a reduced +! set of g-point intervals and a two-stream model for application to GCMs. +! +!-- Original version (derived from RRTM_SW) +! 2002: AER. Inc. +!-- Conversion to F90 formatting; addition of 2-stream radiative transfer +! Feb 2003: J.-J. Morcrette, ECMWF +!-- Additional modifications for GCM application +! Aug 2003: M. J. Iacono, AER Inc. +!-- Total number of g-points reduced from 224 to 112. Original +! set of 224 can be restored by exchanging code in module parrrsw.f90 +! and in file rrtmg_sw_init.f90. +! Apr 2004: M. J. Iacono, AER, Inc. +!-- Modifications to include output for direct and diffuse +! downward fluxes. There are output as "true" fluxes without +! any delta scaling applied. Code can be commented to exclude +! this calculation in source file rrtmg_sw_spcvrt.f90. +! Jan 2005: E. J. Mlawer, M. J. Iacono, AER, Inc. +!-- Revised to add McICA capability. +! Nov 2005: M. J. Iacono, AER, Inc. +!-- Reformatted for consistency with rrtmg_lw. +! Feb 2007: M. J. Iacono, AER, Inc. +!-- Modifications to formatting to use assumed-shape arrays. +! Aug 2007: M. J. Iacono, AER, Inc. +!-- Modified to output direct and diffuse fluxes either with or without +! delta scaling based on setting of idelm flag +! Dec 2008: M. J. Iacono, AER, Inc. + + use parrrsw, only: nbndsw, ngptsw, mxmol, jpband, jpb1, jpb2 + use rrsw_con, only: heatfac, oneminus, pi + + + ! ----- Input ----- + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! Number of horizontal columns + integer, intent(in) :: nlay ! Number of model layers + integer, intent(in) :: icld ! Cloud overlap method + ! 0: Clear only + ! 1: Random + ! 2: Maximum/random + ! 3: Maximum + real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K) + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: asdir(:) ! UV/vis surface albedo direct rad + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: aldir(:) ! Near-IR surface albedo direct rad + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: asdif(:) ! UV/vis surface albedo: diffuse rad + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: aldif(:) ! Near-IR surface albedo: diffuse rad + ! Dimensions: (ncol) + + integer, intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun + ! distance if adjflx not provided) + real(kind=r8), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance + real(kind=r8), intent(in) :: coszen(:) ! Cosine of solar zenith angle + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: solvar(1:nbndsw) ! Solar constant (Wm-2) scaling per band + + real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: ssacmcl(:,:,:) ! Cloud single scattering albedo + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: asmcmcl(:,:,:) ! Cloud asymmetry parameter + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: fsfcmcl(:,:,:) ! Cloud forward scattering parameter + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth (iaer=10 only) + ! Dimensions: (ncol,nlay,nbndsw) + ! (non-delta scaled) + real(kind=r8), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo (iaer=10 only) + ! Dimensions: (ncol,nlay,nbndsw) + ! (non-delta scaled) + real(kind=r8), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter (iaer=10 only) + ! Dimensions: (ncol,nlay,nbndsw) + ! (non-delta scaled) + + ! ----- Output ----- + + real(kind=r8), intent(out) :: swuflx(:,:) ! Total sky shortwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: swdflx(:,:) ! Total sky shortwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: swhr(:,:) ! Total sky shortwave radiative heating rate (K/d) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: swuflxc(:,:) ! Clear sky shortwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: swdflxc(:,:) ! Clear sky shortwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(out) :: swhrc(:,:) ! Clear sky shortwave radiative heating rate (K/d) + ! Dimensions: (ncol,nlay) + + real(kind=r8), intent(out) :: dirdnuv(:,:) ! Direct downward shortwave flux, UV/vis + real(kind=r8), intent(out) :: difdnuv(:,:) ! Diffuse downward shortwave flux, UV/vis + real(kind=r8), intent(out) :: dirdnir(:,:) ! Direct downward shortwave flux, near-IR + real(kind=r8), intent(out) :: difdnir(:,:) ! Diffuse downward shortwave flux, near-IR + + real(kind=r8), intent(out) :: ninflx(:,:) ! Net shortwave flux, near-IR + real(kind=r8), intent(out) :: ninflxc(:,:) ! Net clear sky shortwave flux, near-IR + + real(kind=r8), intent(out) :: swuflxs(:,:,:) ! shortwave spectral flux up + real(kind=r8), intent(out) :: swdflxs(:,:,:) ! shortwave spectral flux down + + ! ----- Local ----- + + ! Control + integer :: istart ! beginning band of calculation + integer :: iend ! ending band of calculation + integer :: icpr ! cldprop/cldprmc use flag + integer :: iout = 0 ! output option flag (inactive) + integer :: isccos ! instrumental cosine response flag (inactive) + integer :: iplon ! column loop index + integer :: i ! layer loop index ! jk + integer :: ib ! band loop index ! jsw + integer :: ia, ig ! indices + integer :: k ! layer loop index + integer :: ims ! value for changing mcica permute seed + + real(kind=r8) :: zepsec, zepzen ! epsilon + real(kind=r8) :: zdpgcp ! flux to heating conversion ratio + + ! Atmosphere + real(kind=r8) :: pavel(ncol,nlay) ! layer pressures (mb) + real(kind=r8) :: tavel(ncol,nlay) ! layer temperatures (K) + real(kind=r8) :: pz(ncol,0:nlay) ! level (interface) pressures (hPa, mb) + real(kind=r8) :: tz(ncol,0:nlay) ! level (interface) temperatures (K) + real(kind=r8) :: tbound(ncol) ! surface temperature (K) + real(kind=r8) :: pdp(ncol,nlay) ! layer pressure thickness (hPa, mb) + real(kind=r8) :: coldry(ncol,nlay) ! dry air column amount + real(kind=r8) :: wkl(ncol,mxmol,nlay) ! molecular amounts (mol/cm-2) + + real(kind=r8) :: cossza(ncol) ! Cosine of solar zenith angle + real(kind=r8) :: adjflux(ncol,jpband) ! adjustment for current Earth/Sun distance + ! default value of 1368.22 Wm-2 at 1 AU + real(kind=r8) :: albdir(ncol,nbndsw) ! surface albedo, direct ! zalbp + real(kind=r8) :: albdif(ncol,nbndsw) ! surface albedo, diffuse ! zalbd + + ! Atmosphere - setcoef + integer :: laytrop(ncol) ! tropopause layer index + integer :: layswtch(ncol) ! + integer :: laylow(ncol) ! + integer :: jp(ncol,nlay) ! + integer :: jt(ncol,nlay) ! + integer :: jt1(ncol,nlay) ! + + real(kind=r8) :: colh2o(ncol,nlay) ! column amount (h2o) + real(kind=r8) :: colco2(ncol,nlay) ! column amount (co2) + real(kind=r8) :: colo3(ncol,nlay) ! column amount (o3) + real(kind=r8) :: coln2o(ncol,nlay) ! column amount (n2o) + real(kind=r8) :: colch4(ncol,nlay) ! column amount (ch4) + real(kind=r8) :: colo2(ncol,nlay) ! column amount (o2) + real(kind=r8) :: colmol(ncol,nlay) ! column amount + real(kind=r8) :: co2mult(ncol,nlay) ! column amount + + integer :: indself(ncol,nlay) + integer :: indfor(ncol,nlay) + real(kind=r8) :: selffac(ncol,nlay) + real(kind=r8) :: selffrac(ncol,nlay) + real(kind=r8) :: forfac(ncol,nlay) + real(kind=r8) :: forfrac(ncol,nlay) + + real(kind=r8) :: fac00(ncol,nlay) + real(kind=r8) :: fac01(ncol,nlay) + real(kind=r8) :: fac11(ncol,nlay) + real(kind=r8) :: fac10(ncol,nlay) + + ! Atmosphere/clouds - cldprmc [mcica] + real(kind=r8) :: ciwpmc(ncol,ngptsw,nlay) ! cloud ice water path [mcica] + real(kind=r8) :: clwpmc(ncol,ngptsw,nlay) ! cloud liquid water path [mcica] + real(kind=r8) :: relqmc(ncol,nlay) ! liquid particle size (microns) + real(kind=r8) :: reicmc(ncol,nlay) ! ice particle effective radius (microns) + real(kind=r8) :: dgesmc(ncol,nlay) ! ice particle generalized effective size (microns) + real(kind=r8) :: fsfcmc(ncol,ngptsw,nlay) ! cloud forward scattering fraction [mcica] + + ! Atmosphere/clouds/aerosol - spcvrt,spcvmc + real(kind=r8) :: ztaua(ncol,nlay,nbndsw) ! total aerosol optical depth + real(kind=r8) :: zasya(ncol,nlay,nbndsw) ! total aerosol asymmetry parameter + real(kind=r8) :: zomga(ncol,nlay,nbndsw) ! total aerosol single scattering albedo + real(kind=r8) :: zcldfmc(ncol,nlay,ngptsw) ! cloud fraction [mcica] + real(kind=r8) :: ztaucmc(ncol,nlay,ngptsw) ! cloud optical depth [mcica] + real(kind=r8) :: ztaormc(ncol,nlay,ngptsw) ! unscaled cloud optical depth [mcica] + real(kind=r8) :: zasycmc(ncol,nlay,ngptsw) ! cloud asymmetry parameter [mcica] + real(kind=r8) :: zomgcmc(ncol,nlay,ngptsw) ! cloud single scattering albedo [mcica] + + real(kind=r8) :: zbbfddir(ncol,nlay+2) ! temporary downward direct shortwave flux (w/m2) + real(kind=r8) :: zbbcddir(ncol,nlay+2) ! temporary clear sky downward direct shortwave flux (w/m2) + real(kind=r8) :: zuvfd(ncol,nlay+2) ! temporary UV downward shortwave flux (w/m2) + real(kind=r8) :: zuvcd(ncol,nlay+2) ! temporary clear sky UV downward shortwave flux (w/m2) + real(kind=r8) :: zuvcddir(ncol,nlay+2) ! temporary clear sky UV downward direct shortwave flux (w/m2) + real(kind=r8) :: znifd(ncol,nlay+2) ! temporary near-IR downward shortwave flux (w/m2) + real(kind=r8) :: znicd(ncol,nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2) + real(kind=r8) :: znicddir(ncol,nlay+2) ! temporary clear sky near-IR downward direct shortwave flux (w/m2) + + ! Added for near-IR flux diagnostic + real(kind=r8) :: znifu(ncol,nlay+2) ! temporary near-IR downward shortwave flux (w/m2) + real(kind=r8) :: znicu(ncol,nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2) + + ! Optional output fields + real(kind=r8) :: swnflx(nlay+2) ! Total sky shortwave net flux (W/m2) + real(kind=r8) :: swnflxc(nlay+2) ! Clear sky shortwave net flux (W/m2) + real(kind=r8) :: dirdflux(nlay+2) ! Direct downward shortwave surface flux + real(kind=r8) :: difdflux(nlay+2) ! Diffuse downward shortwave surface flux + real(kind=r8) :: uvdflx(nlay+2) ! Total sky downward shortwave flux, UV/vis + real(kind=r8) :: nidflx(nlay+2) ! Total sky downward shortwave flux, near-IR + + ! Initializations + + zepsec = 1.e-06_r8 + zepzen = 1.e-10_r8 + oneminus = 1.0_r8 - zepsec + pi = 2._r8 * asin(1._r8) + + istart = jpb1 + iend = jpb2 + icpr = 0 + ims = 2 + + ! Prepare atmosphere profile from GCM for use in RRTMG, and define + ! other input parameters + call inatm_sw (ncol,nlay, icld, iaer, & + play, plev, tlay, tlev, tsfc, & + h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, adjes, dyofyr, solvar, & + cldfmcl, taucmcl, ssacmcl, asmcmcl, fsfcmcl, ciwpmcl, clwpmcl, & + reicmcl, relqmcl, tauaer, ssaaer, asmaer, & + pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, & + adjflux, zcldfmc, ztaucmc, & + zomgcmc, zasycmc, fsfcmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, & + ztaua, zomga, zasya) + + ! Cloud fraction and cloud + ! optical properties are transferred to rrtmg_sw arrays in cldprop. + + call cldprmc_sw(ncol,nlay, inflag, iceflag, liqflag, zcldfmc, & + ciwpmc, clwpmc, reicmc, dgesmc, relqmc, & + ztaormc, ztaucmc, zomgcmc, zasycmc, fsfcmc) + icpr = 1 + + ! This is the main longitude/column loop in RRTMG. + ! Modify to loop over all columns (nlon) or over daylight columns + + do iplon = 1, ncol + + ! Calculate coefficients for the temperature and pressure dependence of the + ! molecular absorption coefficients by interpolating data from stored + ! reference atmospheres. + + call setcoef_sw(nlay, pavel(iplon,:), tavel(iplon,:), pz(iplon,:), & + tz(iplon,:), tbound(iplon), coldry(iplon,:), wkl(iplon,:,:), & + laytrop(iplon), layswtch(iplon), laylow(iplon), & + jp(iplon,:), jt(iplon,:), jt1(iplon,:), & + co2mult(iplon,:), colch4(iplon,:), colco2(iplon,:),& + colh2o(iplon,:), colmol(iplon,:), coln2o(iplon,:), & + colo2(iplon,:), colo3(iplon,:), fac00(iplon,:),& + fac01(iplon,:), fac10(iplon,:), fac11(iplon,:), & + selffac(iplon,:), selffrac(iplon,:), indself(iplon,:),& + forfac(iplon,:), forfrac(iplon,:), indfor(iplon,:)) + end do + + ! Cosine of the solar zenith angle + ! Prevent using value of zero; ideally, SW model is not called from host model when sun + ! is below horizon + + do iplon = 1, ncol + cossza(iplon) = coszen(iplon) + + if (cossza(iplon) .lt. zepzen) cossza(iplon) = zepzen + end do + + ! Transfer albedo, cloud and aerosol properties into arrays for 2-stream radiative transfer + + ! Surface albedo + ! Near-IR bands 16-24 and 29 (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns + ! do ib=1,9 + do ib=1,8 + do iplon = 1, ncol + albdir(iplon,ib) = aldir(iplon) + albdif(iplon,ib) = aldif(iplon) + enddo + enddo + + do iplon = 1, ncol + albdir(iplon,nbndsw) = aldir(iplon) + albdif(iplon,nbndsw) = aldif(iplon) + ! Set band 24 (or, band 9 counting from 1) to use linear average of UV/visible + ! and near-IR values, since this band straddles 0.7 microns: + albdir(iplon,9) = 0.5*(aldir(iplon) + asdir(iplon)) + albdif(iplon,9) = 0.5*(aldif(iplon) + asdif(iplon)) + enddo + + ! UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron + do ib=10,13 + do iplon = 1, ncol + albdir(iplon,ib) = asdir(iplon) + albdif(iplon,ib) = asdif(iplon) + enddo + enddo + + ! Clouds + if (icld.eq.0) then + do iplon = 1, ncol + zcldfmc(iplon,1:nlay,1:ngptsw) = 0._r8 + ztaucmc(iplon,1:nlay,1:ngptsw) = 0._r8 + ztaormc(iplon,1:nlay,1:ngptsw) = 0._r8 + zasycmc(iplon,1:nlay,1:ngptsw) = 0._r8 + zomgcmc(iplon,1:nlay,1:ngptsw) = 1._r8 + enddo + endif + + ! Aerosol + ! IAER = 0: no aerosols + if (iaer.eq.0) then + do iplon = 1, ncol + ztaua(iplon,:,:) = 0._r8 + zasya(iplon,:,:) = 0._r8 + zomga(iplon,:,:) = 1._r8 + enddo + endif + + ! Call the 2-stream radiation transfer model + + call spcvmc_sw & + (lchnk, ncol, nlay, istart, iend, icpr, idelm, iout, & + pavel, tavel, pz, tz, tbound, albdif, albdir, & + zcldfmc, ztaucmc, zasycmc, zomgcmc, ztaormc, & + ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, & + laytrop, layswtch, laylow, jp, jt, jt1, & + co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & + fac00, fac01, fac10, fac11, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + swdflx, swuflx, swdflxc, swuflxc, zuvfd, zuvcd, znifd, znicd, znifu, znicu, & + zbbfddir, zbbcddir, dirdnuv, zuvcddir, dirdnir, znicddir, swuflxs, swdflxs) + + ! Transfer up and down, clear and total sky fluxes to output arrays. + ! Vertical indexing goes from bottom to top + + do i = 1, nlay+1 + uvdflx(i) = zuvfd(ncol,i) + nidflx(i) = znifd(ncol,i) + + do iplon = 1, ncol + ! Direct/diffuse fluxes + dirdflux(i) = zbbfddir(iplon,i) + difdflux(i) = swdflx(iplon,i) - dirdflux(i) + ! UV/visible direct/diffuse fluxes + difdnuv(iplon,i) = zuvfd(iplon,i) - dirdnuv(iplon,i) + ! Near-IR direct/diffuse fluxes + difdnir(iplon,i) = znifd(iplon,i) - dirdnir(iplon,i) + ! Added for net near-IR diagnostic + ninflx(iplon,i) = znifd(iplon,i) - znifu(iplon,i) + ninflxc(iplon,i) = znicd(iplon,i) - znicu(iplon,i) + end do + end do + + do iplon = 1, ncol + ! Total and clear sky net fluxes + do i = 1, nlay+1 + swnflxc(i) = swdflxc(iplon,i) - swuflxc(iplon,i) + swnflx(i) = swdflx(iplon,i) - swuflx(iplon,i) + end do + + ! Total and clear sky heating rates + ! Heating units are in K/d. Flux units are in W/m2. + do i = 1, nlay + zdpgcp = heatfac / pdp(iplon,i) + swhrc(iplon,i) = (swnflxc(i+1) - swnflxc(i)) * zdpgcp + swhr(iplon,i) = (swnflx(i+1) - swnflx(i)) * zdpgcp + end do + swhrc(iplon,nlay) = 0._r8 + swhr(iplon,nlay) = 0._r8 + + end do + +end subroutine rrtmg_sw + +!========================================================================================= + +real(kind=r8) function earth_sun(idn) + + ! Purpose: Function to calculate the correction factor of Earth's orbit + ! for current day of the year + + ! idn : Day of the year + ! earth_sun : square of the ratio of mean to actual Earth-Sun distance + + ! ------- Modules ------- + + use rrsw_con, only : pi + + integer, intent(in) :: idn + + real(kind=r8) :: gamma + + gamma = 2._r8*pi*(idn-1)/365._r8 + + ! Use Iqbal's equation 1.2.1 + + earth_sun = 1.000110_r8 + .034221_r8 * cos(gamma) + .001289_r8 * sin(gamma) + & + .000719_r8 * cos(2._r8*gamma) + .000077_r8 * sin(2._r8*gamma) + +end function earth_sun + +!========================================================================================= + +subroutine inatm_sw (ncol, nlay, icld, iaer, & + play, plev, tlay, tlev, tsfc, & + h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, adjes, dyofyr, solvar, & + cldfmcl, taucmcl, ssacmcl, asmcmcl, fsfcmcl, ciwpmcl, clwpmcl, & + reicmcl, relqmcl, tauaer, ssaaer, asmaer, & + pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, & + adjflux, zcldfmc, ztaucmc, & + zssacmc, zasmcmc, fsfcmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, & + taua, ssaa, asma) + + ! Input atmospheric profile from GCM, and prepare it for use in RRTMG_SW. + ! Set other RRTMG_SW input parameters. + + use parrrsw, only: nbndsw, ngptsw, nmol, mxmol, & + jpband, jpb1, jpb2 + use rrsw_con, only: grav, avogad + + ! ----- Input ----- + integer, intent(in) :: ncol ! column end index + integer, intent(in) :: nlay ! number of model layers + integer, intent(in) :: icld ! clear/cloud and cloud overlap flag + integer, intent(in) :: iaer ! aerosol option flag + + real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K) + ! Dimensions: (ncol,nlay+1) + real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K) + ! Dimensions: (ncol) + real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio + ! Dimensions: (ncol,nlay) + + integer, intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun + ! distance if adjflx not provided) + real(kind=r8), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance + real(kind=r8), intent(in) :: solvar(jpb1:jpb2) ! Solar constant (Wm-2) scaling per band + + real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth (optional) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: ssacmcl(:,:,:) ! Cloud single scattering albedo + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: asmcmcl(:,:,:) ! Cloud asymmetry parameter + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: fsfcmcl(:,:,:) ! Cloud forward scattering fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + + real(kind=r8), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth + ! Dimensions: (ncol,nlay,nbndsw) + real(kind=r8), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo + ! Dimensions: (ncol,nlay,nbndsw) + real(kind=r8), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter + ! Dimensions: (ncol,nlay,nbndsw) + + ! Atmosphere + + real(kind=r8), intent(out) :: pavel(ncol,nlay) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: tavel(ncol,nlay) ! layer temperatures (K) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: pz(ncol,0:nlay) ! level (interface) pressures (hPa, mb) + ! Dimensions: (ncol,0:nlay) + real(kind=r8), intent(out) :: tz(ncol,0:nlay) ! level (interface) temperatures (K) + ! Dimensions: (ncol,0:nlay) + real(kind=r8), intent(out) :: tbound(ncol) ! surface temperature (K) + ! Dimensions: (ncol) + real(kind=r8), intent(out) :: pdp(ncol,nlay) ! layer pressure thickness (hPa, mb) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: coldry(ncol,nlay) ! dry air column density (mol/cm2) + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: wkl(ncol,mxmol,nlay) ! molecular amounts (mol/cm-2) + ! Dimensions: (ncol,mxmol,nlay) + + real(kind=r8), intent(out) :: adjflux(ncol,jpband) ! adjustment for current Earth/Sun distance + ! Dimensions: (ncol,jpband) + real(kind=r8), intent(out) :: taua(ncol,nlay,nbndsw) ! Aerosol optical depth + ! Dimensions: (ncol,nlay,nbndsw) + real(kind=r8), intent(out) :: ssaa(ncol,nlay,nbndsw) ! Aerosol single scattering albedo + ! Dimensions: (ncol,nlay,nbndsw) + real(kind=r8), intent(out) :: asma(ncol,nlay,nbndsw) ! Aerosol asymmetry parameter + ! Dimensions: (ncol,nlay,nbndsw) + + ! Atmosphere/clouds - cldprop + + real(kind=r8), intent(out) :: zcldfmc(ncol,nlay,ngptsw) ! layer cloud fraction + ! Dimensions: (ncol,nlay,ngptsw) + real(kind=r8), intent(out) :: ztaucmc(ncol,nlay,ngptsw) ! cloud optical depth (non-delta scaled) + ! Dimensions: (ncol,nlay,ngptsw) + real(kind=r8), intent(out) :: zssacmc(ncol,nlay,ngptsw) ! cloud single scattering albedo (non-delta-scaled) + ! Dimensions: (ncol,nlay,ngptsw) + real(kind=r8), intent(out) :: zasmcmc(ncol,nlay,ngptsw) ! cloud asymmetry parameter (non-delta scaled) + real(kind=r8), intent(out) :: fsfcmc(ncol,ngptsw,nlay) ! cloud forward scattering fraction (non-delta scaled) + ! Dimensions: (ncol,ngptsw,nlay) + real(kind=r8), intent(out) :: ciwpmc(ncol,ngptsw,nlay) ! cloud ice water path + ! Dimensions: (ncol,ngptsw,nlay) + real(kind=r8), intent(out) :: clwpmc(ncol,ngptsw,nlay) ! cloud liquid water path + ! Dimensions: (ncol,ngptsw,nlay) + real(kind=r8), intent(out) :: reicmc(ncol,nlay) ! cloud ice particle effective radius + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: dgesmc(ncol,nlay) ! cloud ice particle effective radius + ! Dimensions: (ncol,nlay) + real(kind=r8), intent(out) :: relqmc(ncol,nlay) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + + ! ----- Local ----- + real(kind=r8), parameter :: amd = 28.9660_r8 ! Effective molecular weight of dry air (g/mol) + real(kind=r8), parameter :: amw = 18.0160_r8 ! Molecular weight of water vapor (g/mol) + + ! Set molecular weight ratios (for converting mmr to vmr) + ! e.g. h2ovmr = h2ommr * amdw) + real(kind=r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor + real(kind=r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide + real(kind=r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone + real(kind=r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane + real(kind=r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide + + real(kind=r8), parameter :: sbc = 5.67e-08_r8 ! Stefan-Boltzmann constant (W/m2K4) + + integer :: isp, l, ix, n, imol, ib, ig, iplon ! Loop indices + real(kind=r8) :: amm, summol ! + real(kind=r8) :: adjflx ! flux adjustment for Earth/Sun distance + !----------------------------------------------------------------------------------------- + + ! Set flux adjustment for current Earth/Sun distance (two options). + ! 1) Use Earth/Sun distance flux adjustment provided by GCM (input as adjes); + adjflx = adjes + + ! 2) Calculate Earth/Sun distance from DYOFYR, the cumulative day of the year. + ! (Set adjflx to 1. to use constant Earth/Sun distance of 1 AU). + if (dyofyr .gt. 0) then + adjflx = earth_sun(dyofyr) + endif + + ! Set incoming solar flux adjustment to include adjustment for + ! current Earth/Sun distance (ADJFLX) and scaling of default internal + ! solar constant (rrsw_scon = 1368.22 Wm-2) by band (SOLVAR). SOLVAR can be set + ! to a single scaling factor as needed, or to a different value in each + ! band, which may be necessary for paleoclimate simulations. + + do iplon = 1 ,ncol + adjflux(iplon,:) = 0._r8 + end do + + do ib = jpb1,jpb2 + do iplon = 1, ncol + adjflux(iplon,ib) = adjflx * solvar(ib) + end do + end do + + do iplon = 1, ncol + ! Set surface temperature. + tbound(iplon) = tsfc(iplon) + + ! Install input GCM arrays into RRTMG_SW arrays for pressure, temperature, + ! and molecular amounts. + ! Pressures are input in mb, or are converted to mb here. + ! Molecular amounts are input in volume mixing ratio, or are converted from + ! mass mixing ratio (or specific humidity for h2o) to volume mixing ratio + ! here. These are then converted to molecular amount (molec/cm2) below. + ! The dry air column COLDRY (in molec/cm2) is calculated from the level + ! pressures, pz (in mb), based on the hydrostatic equation and includes a + ! correction to account for h2o in the layer. The molecular weight of moist + ! air (amm) is calculated for each layer. + ! Note: In RRTMG, layer indexing goes from bottom to top, and coding below + ! assumes GCM input fields are also bottom to top. Input layer indexing + ! from GCM fields should be reversed here if necessary. + pz(iplon,0) = plev(iplon,nlay+1) + tz(iplon,0) = tlev(iplon,nlay+1) + end do + + do l = 1, nlay + do iplon = 1, ncol + pavel(iplon,l) = play(iplon,nlay-l+1) + tavel(iplon,l) = tlay(iplon,nlay-l+1) + pz(iplon,l) = plev(iplon,nlay-l+1) + tz(iplon,l) = tlev(iplon,nlay-l+1) + pdp(iplon,l) = pz(iplon,l-1) - pz(iplon,l) + end do + end do + + do iplon = 1, ncol + do l = 1, nlay + + ! For h2o input in vmr: + wkl(iplon,1,l) = h2ovmr(iplon,nlay-l+1) + wkl(iplon,2,l) = co2vmr(iplon,nlay-l+1) + wkl(iplon,3,l) = o3vmr(iplon,nlay-l+1) + wkl(iplon,4,l) = n2ovmr(iplon,nlay-l+1) + wkl(iplon,5,l) = 0._r8 + wkl(iplon,6,l) = ch4vmr(iplon,nlay-l+1) + wkl(iplon,7,l) = o2vmr(iplon,nlay-l+1) + amm = (1._r8 - wkl(iplon,1,l)) * amd + wkl(iplon,1,l) * amw + coldry(iplon,l) = (pz(iplon,l-1)-pz(iplon,l)) * 1.e3_r8 * avogad / & + (1.e2_r8 * grav * amm * (1._r8 + wkl(iplon,1,l))) + end do + + coldry(iplon,nlay) = (pz(iplon,nlay-1)) * 1.e3_r8 * avogad / & + (1.e2_r8 * grav * amm * (1._r8 + wkl(iplon,1,nlay-1))) + + ! At this point all molecular amounts in wkl are in volume mixing ratio; + ! convert to molec/cm2 based on coldry for use in rrtm. + + do l = 1, nlay + do imol = 1, nmol + wkl(iplon,imol,l) = coldry(iplon,l) * wkl(iplon,imol,l) + end do + end do + end do + + ! Transfer aerosol optical properties to RRTM variables; + ! modify to reverse layer indexing here if necessary. + + if (iaer .ge. 1) then + do l = 1, nlay-1 + do ib = 1, nbndsw + do iplon = 1, ncol + taua(iplon,l,ib) = tauaer(iplon,nlay-l,ib) + ssaa(iplon,l,ib) = ssaaer(iplon,nlay-l,ib) + asma(iplon,l,ib) = asmaer(iplon,nlay-l,ib) + end do + end do + end do + end if + + ! Transfer cloud fraction and cloud optical properties to RRTM variables; + ! modify to reverse layer indexing here if necessary. + + if (icld .ge. 1) then + ! Move incoming GCM cloud arrays to RRTMG cloud arrays. + ! For GCM input, incoming reice is in effective radius; for Fu parameterization (iceflag = 3) + ! convert effective radius to generalized effective size using method of Mitchell, JAS, 2002: + + do l = 1, nlay-1 + + do ig = 1, ngptsw + do iplon = 1, ncol + zcldfmc(iplon,l,ig) = cldfmcl(ig,iplon,nlay-l) + ztaucmc(iplon,l,ig) = taucmcl(ig,iplon,nlay-l) + zssacmc(iplon,l,ig) = ssacmcl(ig,iplon,nlay-l) + zasmcmc(iplon,l,ig) = asmcmcl(ig,iplon,nlay-l) + + fsfcmc(iplon,ig,l) = fsfcmcl(ig,iplon,nlay-l) + ciwpmc(iplon,ig,l) = ciwpmcl(ig,iplon,nlay-l) + clwpmc(iplon,ig,l) = clwpmcl(ig,iplon,nlay-l) + end do + end do + + do iplon = 1, ncol + reicmc(iplon,l) = reicmcl(iplon,nlay-l) + if (iceflag .eq. 3) then + dgesmc(iplon,l) = 1.5396_r8 * reicmcl(iplon,nlay-l) + end if + relqmc(iplon,l) = relqmcl(iplon,nlay-l) + end do + end do + + ! If an extra layer is being used in RRTMG, set all cloud properties to zero + ! in the extra layer. + do iplon = 1, ncol + zcldfmc(iplon,nlay,:) = 0.0_r8 + ztaucmc(iplon,nlay,:) = 0.0_r8 + zssacmc(iplon,nlay,:) = 1.0_r8 + zasmcmc(iplon,nlay,:) = 0.0_r8 + fsfcmc(iplon,:,nlay) = 0.0_r8 + ciwpmc(iplon,:,nlay) = 0.0_r8 + clwpmc(iplon,:,nlay) = 0.0_r8 + reicmc(iplon,nlay) = 0.0_r8 + dgesmc(iplon,nlay) = 0.0_r8 + relqmc(iplon,nlay) = 0.0_r8 + taua(iplon,nlay,:) = 0.0_r8 + ssaa(iplon,nlay,:) = 1.0_r8 + asma(iplon,nlay,:) = 0.0_r8 + end do + end if + +end subroutine inatm_sw + +end module rrtmg_sw_rad + + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 new file mode 100644 index 0000000000..d37f392025 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 @@ -0,0 +1,296 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_reftra.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:14 $ + + module rrtmg_sw_reftra + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use rrsw_tbl, only : tblint, bpade, od_lo, exp_tbl + + implicit none + + contains + +! -------------------------------------------------------------------- + subroutine reftra_sw(nlayers, ncol, lrtchk, pgg, prmuz, ptau, pw, & + pref, prefd, ptra, ptrad) +! -------------------------------------------------------------------- + +! Purpose: computes the reflectivity and transmissivity of a clear or +! cloudy layer using a choice of various approximations. +! +! Interface: *rrtmg_sw_reftra* is called by *rrtmg_sw_spcvrt* +! +! Description: +! explicit arguments : +! -------------------- +! inputs +! ------ +! lrtchk = .t. for all layers in clear profile +! lrtchk = .t. for cloudy layers in cloud profile +! = .f. for clear layers in cloud profile +! pgg = assymetry factor +! prmuz = cosine solar zenith angle +! ptau = optical thickness +! pw = single scattering albedo +! +! outputs +! ------- +! pref : collimated beam reflectivity +! prefd : diffuse beam reflectivity +! ptra : collimated beam transmissivity +! ptrad : diffuse beam transmissivity +! +! +! Method: +! ------- +! standard delta-eddington, p.i.f.m., or d.o.m. layer calculations. +! kmodts = 1 eddington (joseph et al., 1976) +! = 2 pifm (zdunkowski et al., 1980) +! = 3 discrete ordinates (liou, 1973) +! +! +! Modifications: +! -------------- +! Original: J-JMorcrette, ECMWF, Feb 2003 +! Revised for F90 reformatting: MJIacono, AER, Jul 2006 +! Revised to add exponential lookup table: MJIacono, AER, Aug 2007 +! +! ------------------------------------------------------------------ + +! ------- Declarations ------ + +! ------- Input ------- + + integer, intent(in) :: nlayers + integer, intent(in) :: ncol + logical, intent(in) :: lrtchk(ncol,nlayers) ! Logical flag for reflectivity and + ! and transmissivity calculation; + ! Dimensions: (nlayers) + + real(kind=r8), intent(in) :: pgg(ncol,nlayers) ! asymmetry parameter + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: ptau(ncol,nlayers) ! optical depth + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: pw(ncol,nlayers) ! single scattering albedo + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: prmuz(ncol) ! cosine of solar zenith angle + +! ------- Output ------- + + real(kind=r8), intent(inout) :: pref(ncol,nlayers+1) ! direct beam reflectivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(inout) :: prefd(ncol,nlayers+1) ! diffuse beam reflectivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(inout) :: ptra(ncol,nlayers+1) ! direct beam transmissivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(inout) :: ptrad(ncol,nlayers+1) ! diffuse beam transmissivity + ! Dimensions: (nlayers+1) + +! ------- Local ------- + + integer :: jk, icol, kmodts + integer :: itind + + real(kind=r8) :: tblind + real(kind=r8) :: za, za1, za2 + real(kind=r8) :: zbeta, zdend, zdenr, zdent + real(kind=r8) :: ze1, ze2, zem1, zem2, zemm, zep1, zep2 + real(kind=r8) :: zg, zg3, zgamma1, zgamma2, zgamma3, zgamma4, zgt + real(kind=r8) :: zr1, zr2, zr3, zr4, zr5 + real(kind=r8) :: zrk, zrk2, zrkg, zrm1, zrp, zrp1, zrpp + real(kind=r8) :: zsr3, zt1, zt2, zt3, zt4, zt5, zto1 + real(kind=r8) :: zw, zwcrit, zwo + real(kind=r8) :: temp1 + real(kind=r8), parameter :: eps = 1.e-08_r8 + +! ------------------------------------------------------------------ + +! Initialize + + zsr3=sqrt(3._r8) + zwcrit=0.9999995_r8 + kmodts=2 + + do jk=1, nlayers + do icol = 1,ncol + if (.not.lrtchk(icol,jk)) then + pref(icol,jk) =0._r8 + ptra(icol,jk) =1._r8 + prefd(icol,jk)=0._r8 + ptrad(icol,jk)=1._r8 + else + zto1=ptau(icol,jk) + zw =pw(icol,jk) + zg =pgg(icol,jk) + +! General two-stream expressions + + zg3= 3._r8 * zg + if (kmodts == 1) then + zgamma1= (7._r8 - zw * (4._r8 + zg3)) * 0.25_r8 + zgamma2=-(1._r8 - zw * (4._r8 - zg3)) * 0.25_r8 + zgamma3= (2._r8 - zg3 * prmuz(icol) ) * 0.25_r8 + else if (kmodts == 2) then + zgamma1= (8._r8 - zw * (5._r8 + zg3)) * 0.25_r8 + zgamma2= 3._r8 *(zw * (1._r8 - zg )) * 0.25_r8 + zgamma3= (2._r8 - zg3 * prmuz(icol) ) * 0.25_r8 + else if (kmodts == 3) then + zgamma1= zsr3 * (2._r8 - zw * (1._r8 + zg)) * 0.5_r8 + zgamma2= zsr3 * zw * (1._r8 - zg ) * 0.5_r8 + zgamma3= (1._r8 - zsr3 * zg * prmuz(icol) ) * 0.5_r8 + end if + zgamma4= 1._r8 - zgamma3 + +! Recompute original s.s.a. to test for conservative solution + + temp1 = 1._r8 - 2._r8 * zg + zwo= zw * (temp1 + zg**2)/(temp1 + zg**2 * zw) + if (zwo >= zwcrit) then +! Conservative scattering + + za = zgamma1 * prmuz(icol) + za1 = za - zgamma3 + zgt = zgamma1 * zto1 + +! Homogeneous reflectance and transmittance, +! collimated beam + + ze1 = min ( zto1 / prmuz(icol) , 500._r8) + ze2 = exp( -ze1 ) + +! Use exponential lookup table for transmittance, or expansion of +! exponential for low tau +! if (ze1 .le. od_lo) then +! ze2 = 1._r8 - ze1 + 0.5_r8 * ze1 * ze1 +! else +! tblind = ze1 / (bpade + ze1) +! itind = tblint * tblind + 0.5_r8 +! ze2 = exp_tbl(itind) +! endif +! + + pref(icol,jk) = (zgt - za1 * (1._r8 - ze2)) / ( 1._r8 + zgt) + ptra(icol,jk) = 1._r8 - pref(icol,jk) + +! isotropic incidence + + prefd(icol,jk) = zgt / ( 1._r8 + zgt) + ptrad(icol,jk) = 1._r8 - prefd(icol,jk) + +! This is applied for consistency between total (delta-scaled) and direct (unscaled) +! calculations at very low optical depths (tau < 1.e-4) when the exponential lookup +! table returns a transmittance of 1.0. + if (ze2 .eq. 1.0_r8) then + pref(icol,jk) = 0.0_r8 + ptra(icol,jk) = 1.0_r8 + prefd(icol,jk) = 0.0_r8 + ptrad(icol,jk) = 1.0_r8 + endif + + else +! Non-conservative scattering + + za1 = zgamma1 * zgamma4 + zgamma2 * zgamma3 + za2 = zgamma1 * zgamma3 + zgamma2 * zgamma4 + zrk = sqrt ( zgamma1**2 - zgamma2**2) + zrp = zrk * prmuz(icol) + zrp1 = 1._r8 + zrp + zrm1 = 1._r8 - zrp + zrk2 = 2._r8 * zrk + zrpp = 1._r8 - zrp*zrp + zrkg = zrk + zgamma1 + zr1 = zrm1 * (za2 + zrk * zgamma3) + zr2 = zrp1 * (za2 - zrk * zgamma3) + zr3 = zrk2 * (zgamma3 - za2 * prmuz(icol) ) + zr4 = zrpp * zrkg + zr5 = zrpp * (zrk - zgamma1) + zt1 = zrp1 * (za1 + zrk * zgamma4) + zt2 = zrm1 * (za1 - zrk * zgamma4) + zt3 = zrk2 * (zgamma4 + za1 * prmuz(icol) ) + zt4 = zr4 + zt5 = zr5 + zbeta = (zgamma1 - zrk) / zrkg !- zr5 / zr4 + +! Homogeneous reflectance and transmittance + + ze1 = min ( zrk * zto1, 500._r8) + ze2 = min ( zto1 / prmuz(icol) , 500._r8) +! +! Original +! zep1 = exp( ze1 ) +! zem1 = exp(-ze1 ) +! zep2 = exp( ze2 ) +! zem2 = exp(-ze2 ) +! +! Revised original, to reduce exponentials + zep1 = exp( ze1 ) + zem1 = 1._r8 / zep1 + zep2 = exp( ze2 ) + zem2 = 1._r8 / zep2 +! +! Use exponential lookup table for transmittance, or expansion of +! exponential for low tau +! if (ze1 .le. od_lo) then +! zem1 = 1._r8 - ze1 + 0.5_r8 * ze1 * ze1 +! zep1 = 1._r8 / zem1 +! else +! tblind = ze1 / (bpade + ze1) +! itind = tblint * tblind + 0.5_r8 +! zem1 = exp_tbl(itind) +! zep1 = 1._r8 / zem1 +! endif +! +! if (ze2 .le. od_lo) then +! zem2 = 1._r8 - ze2 + 0.5_r8 * ze2 * ze2 +! zep2 = 1._r8 / zem2 +! else +! tblind = ze2 / (bpade + ze2) +! itind = tblint * tblind + 0.5_r8 +! zem2 = exp_tbl(itind) +! zep2 = 1._r8 / zem2 +! endif + +! collimated beam + + zdenr = zr4*zep1 + zr5*zem1 + zdent = zt4*zep1 + zt5*zem1 + if (zdenr .ge. -eps .and. zdenr .le. eps) then + pref(icol,jk) = eps + ptra(icol,jk) = zem2 + else + pref(icol,jk) = zw * (zr1*zep1 - zr2*zem1 - zr3*zem2) / zdenr + ptra(icol,jk) = zem2 - zem2 * zw * (zt1*zep1 - zt2*zem1 - zt3*zep2) / zdent + endif + +! diffuse beam + + zemm = zem1*zem1 + zdend = 1._r8 / ( (1._r8 - zbeta*zemm ) * zrkg) + prefd(icol,jk) = zgamma2 * (1._r8 - zemm) * zdend + ptrad(icol,jk) = zrk2*zem1*zdend + + endif + + endif + + enddo + end do + end subroutine reftra_sw + + end module rrtmg_sw_reftra + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_setcoef.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_setcoef.f90 new file mode 100644 index 0000000000..ebee24db48 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_setcoef.f90 @@ -0,0 +1,346 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_setcoef.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:14 $ + + module rrtmg_sw_setcoef + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use rrsw_ref, only: pref, preflog, tref + + implicit none + + contains + +!---------------------------------------------------------------------------- + subroutine setcoef_sw(nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, & + laytrop, layswtch, laylow, jp, jt, jt1, & + co2mult, colch4, colco2, colh2o, colmol, coln2o, & + colo2, colo3, fac00, fac01, fac10, fac11, & + selffac, selffrac, indself, forfac, forfrac, indfor) +!---------------------------------------------------------------------------- +! +! Purpose: For a given atmosphere, calculate the indices and +! fractions related to the pressure and temperature interpolations. + +! Modifications: +! Original: J. Delamere, AER, Inc. (version 2.5, 02/04/01) +! Revised: Rewritten and adapted to ECMWF F90, JJMorcrette 030224 +! Revised: For uniform rrtmg formatting, MJIacono, Jul 2006 + +! ------ Declarations ------- + +! ----- Input ----- + integer, intent(in) :: nlayers ! total number of layers + + real(kind=r8), intent(in) :: pavel(:) ! layer pressures (mb) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: tavel(:) ! layer temperatures (K) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: pz(0:) ! level (interface) pressures (hPa, mb) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(in) :: tz(0:) ! level (interface) temperatures (K) + ! Dimensions: (0:nlayers) + real(kind=r8), intent(in) :: tbound ! surface temperature (K) + real(kind=r8), intent(in) :: coldry(:) ! dry air column density (mol/cm2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: wkl(:,:) ! molecular amounts (mol/cm-2) + ! Dimensions: (mxmol,nlayers) + +! ----- Output ----- + integer, intent(out) :: laytrop ! tropopause layer index + integer, intent(out) :: layswtch ! + integer, intent(out) :: laylow ! + + integer, intent(out) :: jp(:) ! + ! Dimensions: (nlayers) + integer, intent(out) :: jt(:) ! + ! Dimensions: (nlayers) + integer, intent(out) :: jt1(:) ! + ! Dimensions: (nlayers) + + real(kind=r8), intent(out) :: colh2o(:) ! column amount (h2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colco2(:) ! column amount (co2) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colo3(:) ! column amount (o3) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: coln2o(:) ! column amount (n2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colch4(:) ! column amount (ch4) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colo2(:) ! column amount (o2) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: colmol(:) ! + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: co2mult(:) ! + ! Dimensions: (nlayers) + + integer, intent(out) :: indself(:) + ! Dimensions: (nlayers) + integer, intent(out) :: indfor(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: selffac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: selffrac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: forfac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(out) :: forfrac(:) + ! Dimensions: (nlayers) + + real(kind=r8), intent(out) :: & ! + fac00(:), fac01(:), & ! Dimensions: (nlayers) + fac10(:), fac11(:) + +! ----- Local ----- + + integer :: indbound + integer :: indlev0 + integer :: lay + integer :: jp1 + + real(kind=r8) :: stpfac + real(kind=r8) :: tbndfrac + real(kind=r8) :: t0frac + real(kind=r8) :: plog + real(kind=r8) :: fp + real(kind=r8) :: ft + real(kind=r8) :: ft1 + real(kind=r8) :: water + real(kind=r8) :: scalefac + real(kind=r8) :: factor + real(kind=r8) :: co2reg + real(kind=r8) :: compfp + + +! Initializations + stpfac = 296._r8/1013._r8 + + indbound = tbound - 159._r8 + tbndfrac = tbound - int(tbound) + indlev0 = tz(0) - 159._r8 + t0frac = tz(0) - int(tz(0)) + + laytrop = 0 + layswtch = 0 + laylow = 0 + +! Begin layer loop + do lay = 1, nlayers +! Find the two reference pressures on either side of the +! layer pressure. Store them in JP and JP1. Store in FP the +! fraction of the difference (in ln(pressure)) between these +! two values that the layer pressure lies. + + plog = log(pavel(lay)) + jp(lay) = int(36._r8 - 5*(plog+0.04_r8)) + if (jp(lay) .lt. 1) then + jp(lay) = 1 + elseif (jp(lay) .gt. 58) then + jp(lay) = 58 + endif + jp1 = jp(lay) + 1 + fp = min(3._r8, max(-2._r8, 5._r8 * (preflog(jp(lay)) - plog))) + +! Determine, for each reference pressure (JP and JP1), which +! reference temperature (these are different for each +! reference pressure) is nearest the layer temperature but does +! not exceed it. Store these indices in JT and JT1, resp. +! Store in FT (resp. FT1) the fraction of the way between JT +! (JT1) and the next highest reference temperature that the +! layer temperature falls. + + jt(lay) = int(3._r8 + (tavel(lay)-tref(jp(lay)))/15._r8) + if (jt(lay) .lt. 1) then + jt(lay) = 1 + elseif (jt(lay) .gt. 4) then + jt(lay) = 4 + endif + ft = min(3._r8, max(-2._r8, ((tavel(lay)-tref(jp(lay)))/15._r8) - float(jt(lay)-3))) + jt1(lay) = int(3._r8 + (tavel(lay)-tref(jp1))/15._r8) + if (jt1(lay) .lt. 1) then + jt1(lay) = 1 + elseif (jt1(lay) .gt. 4) then + jt1(lay) = 4 + endif + ft1 = min(3._r8, max(-2._r8, ((tavel(lay)-tref(jp1))/15._r8) - float(jt1(lay)-3))) + + water = wkl(1,lay)/coldry(lay) + scalefac = pavel(lay) * stpfac / tavel(lay) + +! If the pressure is less than ~100mb, perform a different +! set of species interpolations. + + if (plog .le. 4.56_r8) go to 5300 + laytrop = laytrop + 1 + if (plog .ge. 6.62_r8) laylow = laylow + 1 + +! Set up factors needed to separately include the water vapor +! foreign-continuum in the calculation of absorption coefficient. + + forfac(lay) = scalefac / (1.+water) + factor = (332.0_r8-tavel(lay))/36.0_r8 + indfor(lay) = min(2, max(1, int(factor))) + forfrac(lay) = min(3._r8, max(-2._r8, factor - float(indfor(lay)))) + +! Set up factors needed to separately include the water vapor +! self-continuum in the calculation of absorption coefficient. + + selffac(lay) = water * forfac(lay) + factor = (tavel(lay)-188.0_r8)/7.2_r8 + indself(lay) = min(9, max(1, int(factor)-7)) + selffrac(lay) = min(3._r8, max(-2._r8, factor - float(indself(lay) + 7))) + +! Calculate needed column amounts. + + colh2o(lay) = 1.e-20_r8 * wkl(1,lay) + colco2(lay) = 1.e-20_r8 * wkl(2,lay) + colo3(lay) = 1.e-20_r8 * wkl(3,lay) +! colo3(lay) = 0._r8 +! colo3(lay) = colo3(lay)/1.16_r8 + coln2o(lay) = 1.e-20_r8 * wkl(4,lay) + colch4(lay) = 1.e-20_r8 * wkl(6,lay) + colo2(lay) = 1.e-20_r8 * wkl(7,lay) + colmol(lay) = 1.e-20_r8 * coldry(lay) + colh2o(lay) +! colco2(lay) = 0._r8 +! colo3(lay) = 0._r8 +! coln2o(lay) = 0._r8 +! colch4(lay) = 0._r8 +! colo2(lay) = 0._r8 +! colmol(lay) = 0._r8 + if (colco2(lay) .eq. 0._r8) colco2(lay) = 1.e-32_r8 * coldry(lay) + if (coln2o(lay) .eq. 0._r8) coln2o(lay) = 1.e-32_r8 * coldry(lay) + if (colch4(lay) .eq. 0._r8) colch4(lay) = 1.e-32_r8 * coldry(lay) + if (colo2(lay) .eq. 0._r8) colo2(lay) = 1.e-32_r8 * coldry(lay) +! Using E = 1334.2 cm-1. + co2reg = 3.55e-24_r8 * coldry(lay) + co2mult(lay)= (colco2(lay) - co2reg) * & + 272.63_r8*exp(-1919.4_r8/tavel(lay))/(8.7604e-4_r8*tavel(lay)) + goto 5400 + +! Above laytrop. + 5300 continue + +! Set up factors needed to separately include the water vapor +! foreign-continuum in the calculation of absorption coefficient. + + forfac(lay) = scalefac / (1.+water) + factor = (tavel(lay)-188.0_r8)/36.0_r8 + indfor(lay) = 3 + forfrac(lay) = min(3._r8, max(-2._r8, factor - 1.0_r8)) + +! Calculate needed column amounts. + + colh2o(lay) = 1.e-20_r8 * wkl(1,lay) + colco2(lay) = 1.e-20_r8 * wkl(2,lay) + colo3(lay) = 1.e-20_r8 * wkl(3,lay) + coln2o(lay) = 1.e-20_r8 * wkl(4,lay) + colch4(lay) = 1.e-20_r8 * wkl(6,lay) + colo2(lay) = 1.e-20_r8 * wkl(7,lay) + colmol(lay) = 1.e-20_r8 * coldry(lay) + colh2o(lay) + if (colco2(lay) .eq. 0._r8) colco2(lay) = 1.e-32_r8 * coldry(lay) + if (coln2o(lay) .eq. 0._r8) coln2o(lay) = 1.e-32_r8 * coldry(lay) + if (colch4(lay) .eq. 0._r8) colch4(lay) = 1.e-32_r8 * coldry(lay) + if (colo2(lay) .eq. 0._r8) colo2(lay) = 1.e-32_r8 * coldry(lay) + co2reg = 3.55e-24_r8 * coldry(lay) + co2mult(lay)= (colco2(lay) - co2reg) * & + 272.63_r8*exp(-1919.4_r8/tavel(lay))/(8.7604e-4_r8*tavel(lay)) + + selffac(lay) = 0._r8 + selffrac(lay)= 0._r8 + indself(lay) = 0 + + 5400 continue + +! We have now isolated the layer ln pressure and temperature, +! between two reference pressures and two reference temperatures +! (for each reference pressure). We multiply the pressure +! fraction FP with the appropriate temperature fractions to get +! the factors that will be needed for the interpolation that yields +! the optical depths (performed in routines TAUGBn for band n). + + compfp = 1._r8 - fp + fac10(lay) = compfp * ft + fac00(lay) = compfp * (1._r8 - ft) + fac11(lay) = fp * ft1 + fac01(lay) = fp * (1._r8 - ft1) + +! End layer loop + enddo + + end subroutine setcoef_sw + +!*************************************************************************** + subroutine swatmref +!*************************************************************************** + + save + +! These pressures are chosen such that the ln of the first pressure +! has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and +! each subsequent ln(pressure) differs from the previous one by 0.2. + + pref(:) = (/ & + 1.05363e+03_r8,8.62642e+02_r8,7.06272e+02_r8,5.78246e+02_r8,4.73428e+02_r8, & + 3.87610e+02_r8,3.17348e+02_r8,2.59823e+02_r8,2.12725e+02_r8,1.74164e+02_r8, & + 1.42594e+02_r8,1.16746e+02_r8,9.55835e+01_r8,7.82571e+01_r8,6.40715e+01_r8, & + 5.24573e+01_r8,4.29484e+01_r8,3.51632e+01_r8,2.87892e+01_r8,2.35706e+01_r8, & + 1.92980e+01_r8,1.57998e+01_r8,1.29358e+01_r8,1.05910e+01_r8,8.67114e+00_r8, & + 7.09933e+00_r8,5.81244e+00_r8,4.75882e+00_r8,3.89619e+00_r8,3.18993e+00_r8, & + 2.61170e+00_r8,2.13828e+00_r8,1.75067e+00_r8,1.43333e+00_r8,1.17351e+00_r8, & + 9.60789e-01_r8,7.86628e-01_r8,6.44036e-01_r8,5.27292e-01_r8,4.31710e-01_r8, & + 3.53455e-01_r8,2.89384e-01_r8,2.36928e-01_r8,1.93980e-01_r8,1.58817e-01_r8, & + 1.30029e-01_r8,1.06458e-01_r8,8.71608e-02_r8,7.13612e-02_r8,5.84256e-02_r8, & + 4.78349e-02_r8,3.91639e-02_r8,3.20647e-02_r8,2.62523e-02_r8,2.14936e-02_r8, & + 1.75975e-02_r8,1.44076e-02_r8,1.17959e-02_r8,9.65769e-03_r8 /) + + preflog(:) = (/ & + 6.9600e+00_r8, 6.7600e+00_r8, 6.5600e+00_r8, 6.3600e+00_r8, 6.1600e+00_r8, & + 5.9600e+00_r8, 5.7600e+00_r8, 5.5600e+00_r8, 5.3600e+00_r8, 5.1600e+00_r8, & + 4.9600e+00_r8, 4.7600e+00_r8, 4.5600e+00_r8, 4.3600e+00_r8, 4.1600e+00_r8, & + 3.9600e+00_r8, 3.7600e+00_r8, 3.5600e+00_r8, 3.3600e+00_r8, 3.1600e+00_r8, & + 2.9600e+00_r8, 2.7600e+00_r8, 2.5600e+00_r8, 2.3600e+00_r8, 2.1600e+00_r8, & + 1.9600e+00_r8, 1.7600e+00_r8, 1.5600e+00_r8, 1.3600e+00_r8, 1.1600e+00_r8, & + 9.6000e-01_r8, 7.6000e-01_r8, 5.6000e-01_r8, 3.6000e-01_r8, 1.6000e-01_r8, & + -4.0000e-02_r8,-2.4000e-01_r8,-4.4000e-01_r8,-6.4000e-01_r8,-8.4000e-01_r8, & + -1.0400e+00_r8,-1.2400e+00_r8,-1.4400e+00_r8,-1.6400e+00_r8,-1.8400e+00_r8, & + -2.0400e+00_r8,-2.2400e+00_r8,-2.4400e+00_r8,-2.6400e+00_r8,-2.8400e+00_r8, & + -3.0400e+00_r8,-3.2400e+00_r8,-3.4400e+00_r8,-3.6400e+00_r8,-3.8400e+00_r8, & + -4.0400e+00_r8,-4.2400e+00_r8,-4.4400e+00_r8,-4.6400e+00_r8 /) + +! These are the temperatures associated with the respective +! pressures for the MLS standard atmosphere. + + tref(:) = (/ & + 2.9420e+02_r8, 2.8799e+02_r8, 2.7894e+02_r8, 2.6925e+02_r8, 2.5983e+02_r8, & + 2.5017e+02_r8, 2.4077e+02_r8, 2.3179e+02_r8, 2.2306e+02_r8, 2.1578e+02_r8, & + 2.1570e+02_r8, 2.1570e+02_r8, 2.1570e+02_r8, 2.1706e+02_r8, 2.1858e+02_r8, & + 2.2018e+02_r8, 2.2174e+02_r8, 2.2328e+02_r8, 2.2479e+02_r8, 2.2655e+02_r8, & + 2.2834e+02_r8, 2.3113e+02_r8, 2.3401e+02_r8, 2.3703e+02_r8, 2.4022e+02_r8, & + 2.4371e+02_r8, 2.4726e+02_r8, 2.5085e+02_r8, 2.5457e+02_r8, 2.5832e+02_r8, & + 2.6216e+02_r8, 2.6606e+02_r8, 2.6999e+02_r8, 2.7340e+02_r8, 2.7536e+02_r8, & + 2.7568e+02_r8, 2.7372e+02_r8, 2.7163e+02_r8, 2.6955e+02_r8, 2.6593e+02_r8, & + 2.6211e+02_r8, 2.5828e+02_r8, 2.5360e+02_r8, 2.4854e+02_r8, 2.4348e+02_r8, & + 2.3809e+02_r8, 2.3206e+02_r8, 2.2603e+02_r8, 2.2000e+02_r8, 2.1435e+02_r8, & + 2.0887e+02_r8, 2.0340e+02_r8, 1.9792e+02_r8, 1.9290e+02_r8, 1.8809e+02_r8, & + 1.8329e+02_r8, 1.7849e+02_r8, 1.7394e+02_r8, 1.7212e+02_r8 /) + + end subroutine swatmref + + end module rrtmg_sw_setcoef + + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 new file mode 100644 index 0000000000..6382375f8a --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_spcvmc.f90 @@ -0,0 +1,726 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_spcvmc.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:14 $ + + module rrtmg_sw_spcvmc + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use parrrsw, only: nbndsw, ngptsw, mxmol, jpband + use rrsw_tbl, only: tblint, bpade, od_lo, exp_tbl + use rrsw_wvn, only: ngc, ngs + use rrtmg_sw_reftra, only: reftra_sw + use rrtmg_sw_taumol, only: taumol_sw + use rrtmg_sw_vrtqdr, only: vrtqdr_sw + + implicit none + + contains + +! --------------------------------------------------------------------------- + subroutine spcvmc_sw & + (lchnk, ncol, nlayers, istart, iend, icpr, idelm, iout, & + pavel, tavel, pz, tz, tbound, palbd, palbp, & + pcldfmc, ptaucmc, pasycmc, pomgcmc, ptaormc, & + ptaua, pasya, pomga, prmu0, coldry, wkl, adjflux, & + laytrop, layswtch, laylow, jp, jt, jt1, & + co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & + fac00, fac01, fac10, fac11, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + pbbfd, pbbfu, pbbcd, pbbcu, puvfd, puvcd, pnifd, pnicd, pnifu, pnicu, & + pbbfddir, pbbcddir, puvfddir, puvcddir, pnifddir, pnicddir, & + pbbfsu, pbbfsd) +! --------------------------------------------------------------------------- +! +! Purpose: Contains spectral loop to compute the shortwave radiative fluxes, +! using the two-stream method of H. Barker and McICA, the Monte-Carlo +! Independent Column Approximation, for the representation of +! sub-grid cloud variability (i.e. cloud overlap). +! +! Interface: *spcvmc_sw* is called from *rrtmg_sw.F90* or rrtmg_sw.1col.F90* +! +! Method: +! Adapted from two-stream model of H. Barker; +! Two-stream model options (selected with kmodts in rrtmg_sw_reftra.F90): +! 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discret ordinates +! +! Modifications: +! +! Original: H. Barker +! Revision: Merge with RRTMG_SW: J.-J.Morcrette, ECMWF, Feb 2003 +! Revision: Add adjustment for Earth/Sun distance : MJIacono, AER, Oct 2003 +! Revision: Bug fix for use of PALBP and PALBD: MJIacono, AER, Nov 2003 +! Revision: Bug fix to apply delta scaling to clear sky: AER, Dec 2004 +! Revision: Code modified so that delta scaling is not done in cloudy profiles +! if routine cldprop is used; delta scaling can be applied by swithcing +! code below if cldprop is not used to get cloud properties. +! AER, Jan 2005 +! Revision: Modified to use McICA: MJIacono, AER, Nov 2005 +! Revision: Uniform formatting for RRTMG: MJIacono, AER, Jul 2006 +! Revision: Use exponential lookup table for transmittance: MJIacono, AER, +! Aug 2007 +! +! ------------------------------------------------------------------ + +! ------- Declarations ------ + +! ------- Input ------- + + integer, intent(in) :: lchnk + + integer, intent(in) :: nlayers + integer, intent(in) :: istart + integer, intent(in) :: iend + integer, intent(in) :: icpr + integer, intent(in) :: idelm ! delta-m scaling flag + ! [0 = direct and diffuse fluxes are unscaled] + ! [1 = direct and diffuse fluxes are scaled] + integer, intent(in) :: iout + integer, intent(in) :: ncol + + integer, intent(in) :: laytrop(ncol) + integer, intent(in) :: layswtch(ncol) + integer, intent(in) :: laylow(ncol) + + integer, intent(in) :: indfor(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + integer, intent(in) :: indself(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + integer, intent(in) :: jp(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + integer, intent(in) :: jt(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + integer, intent(in) :: jt1(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + + real(kind=r8), intent(in) :: pavel(ncol,nlayers) ! layer pressure (hPa, mb) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: tavel(ncol,nlayers) ! layer temperature (K) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: pz(ncol,0:nlayers) ! level (interface) pressure (hPa, mb) + ! Dimensions: (ncol,0:nlayers) + real(kind=r8), intent(in) :: tz(ncol,0:nlayers) ! level temperatures (hPa, mb) + ! Dimensions: (ncol,0:nlayers) + real(kind=r8), intent(in) :: tbound(ncol) ! surface temperature (K) + real(kind=r8), intent(in) :: wkl(ncol,mxmol,nlayers) ! molecular amounts (mol/cm2) + ! Dimensions: (ncol,mxmol,nlayers) + real(kind=r8), intent(in) :: coldry(ncol,nlayers) ! dry air column density (mol/cm2) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: colmol(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: adjflux(ncol,jpband) ! Earth/Sun distance adjustment + ! Dimensions: (ncol,jpband) + + real(kind=r8), intent(in) :: palbd(ncol,nbndsw) ! surface albedo (diffuse) + ! Dimensions: (ncol,nbndsw) + real(kind=r8), intent(in) :: palbp(ncol,nbndsw) ! surface albedo (direct) + ! Dimensions: (ncol, nbndsw) + real(kind=r8), intent(in) :: prmu0(ncol) ! cosine of solar zenith angle + real(kind=r8), intent(in) :: pcldfmc(ncol,nlayers,ngptsw) ! cloud fraction [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: ptaucmc(ncol,nlayers,ngptsw) ! cloud optical depth [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: pasycmc(ncol,nlayers,ngptsw) ! cloud asymmetry parameter [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: pomgcmc(ncol,nlayers,ngptsw) ! cloud single scattering albedo [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: ptaormc(ncol,nlayers,ngptsw) ! cloud optical depth, non-delta scaled [mcica] + ! Dimensions: (ncol,nlayers,ngptsw) + real(kind=r8), intent(in) :: ptaua(ncol,nlayers,nbndsw) ! aerosol optical depth + ! Dimensions: (ncol,nlayers,nbndsw) + real(kind=r8), intent(in) :: pasya(ncol,nlayers,nbndsw) ! aerosol asymmetry parameter + ! Dimensions: (ncol,nlayers,nbndsw) + real(kind=r8), intent(in) :: pomga(ncol,nlayers,nbndsw) ! aerosol single scattering albedo + ! Dimensions: (ncol,nlayers,nbndsw) + + real(kind=r8), intent(in) :: colh2o(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: colco2(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: colch4(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: co2mult(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: colo3(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: colo2(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: coln2o(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: forfac(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: forfrac(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: selffac(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: selffrac(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: fac00(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: fac01(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: fac10(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + real(kind=r8), intent(in) :: fac11(ncol,nlayers) + ! Dimensions: (ncol,nlayers) + +! ------- Output ------- + ! All Dimensions: (nlayers+1) + real(kind=r8), intent(out) :: pbbcd(:,:) + real(kind=r8), intent(out) :: pbbcu(:,:) + real(kind=r8), intent(out) :: pbbfd(:,:) + real(kind=r8), intent(out) :: pbbfu(:,:) + real(kind=r8), intent(out) :: pbbfddir(ncol,nlayers+2) + real(kind=r8), intent(out) :: pbbcddir(ncol,nlayers+2) + + real(kind=r8), intent(out) :: puvcd(ncol,nlayers+2) + real(kind=r8), intent(out) :: puvfd(ncol,nlayers+2) + real(kind=r8), intent(out) :: puvcddir(ncol,nlayers+2) + real(kind=r8), intent(out) :: puvfddir(:,:) + + real(kind=r8), intent(out) :: pnicd(ncol,nlayers+2) + real(kind=r8), intent(out) :: pnifd(ncol,nlayers+2) + real(kind=r8), intent(out) :: pnicddir(ncol,nlayers+2) + real(kind=r8), intent(out) :: pnifddir(:,:) + +! Added for net near-IR flux diagnostic + real(kind=r8), intent(out) :: pnicu(ncol,nlayers+2) + real(kind=r8), intent(out) :: pnifu(ncol,nlayers+2) + +! Output - inactive ! All Dimensions: (nlayers+1) +! real(kind=r8), intent(out) :: puvcu(:) +! real(kind=r8), intent(out) :: puvfu(:) +! real(kind=r8), intent(out) :: pvscd(:) +! real(kind=r8), intent(out) :: pvscu(:) +! real(kind=r8), intent(out) :: pvsfd(:) +! real(kind=r8), intent(out) :: pvsfu(:) + + real(kind=r8), intent(out) :: pbbfsu(:,:,:) ! shortwave spectral flux up (nswbands,nlayers+1) + real(kind=r8), intent(out) :: pbbfsd(:,:,:) ! shortwave spectral flux down (nswbands,nlayers+1) + + +! ------- Local ------- + + logical :: lrtchkclr(ncol,nlayers),lrtchkcld(ncol,nlayers) + + integer :: klev + integer :: ib1, ib2, ibm, igt, ikl, ikp, ikx + integer :: jb, jg, jl, jk + integer :: iw(ncol), iplon +! integer, parameter :: nuv = ?? +! integer, parameter :: nvs = ?? + integer :: itind(ncol) + + real(kind=r8) :: tblind(ncol), ze1(ncol) + real(kind=r8) :: zclear(ncol), zcloud(ncol) + real(kind=r8) :: zdbt(ncol,nlayers+1), zdbt_nodel(ncol,nlayers+1) + real(kind=r8) :: zgcc(ncol,nlayers), zgco(ncol,nlayers) + real(kind=r8) :: zomcc(ncol,nlayers), zomco(ncol,nlayers) + real(kind=r8) :: zrdnd(ncol,nlayers+1), zrdndc(ncol,nlayers+1) + real(kind=r8) :: zref(ncol,nlayers+1), zrefc(ncol,nlayers+1), zrefo(ncol,nlayers+1) + real(kind=r8) :: zrefd(ncol,nlayers+1), zrefdc(ncol,nlayers+1), zrefdo(ncol,nlayers+1) + real(kind=r8) :: zrup(ncol,nlayers+1), zrupd(ncol,nlayers+1) + real(kind=r8) :: zrupc(ncol,nlayers+1), zrupdc(ncol,nlayers+1) + real(kind=r8) :: ztauc(ncol,nlayers), ztauo(ncol,nlayers) + real(kind=r8) :: ztdbt(ncol,nlayers+1) + real(kind=r8) :: ztra(ncol,nlayers+1), ztrac(ncol,nlayers+1), ztrao(ncol,nlayers+1) + real(kind=r8) :: ztrad(ncol,nlayers+1), ztradc(ncol,nlayers+1), ztrado(ncol,nlayers+1) + real(kind=r8) :: zdbtc(ncol,nlayers+1), ztdbtc(ncol,nlayers+1) + real(kind=r8) :: zincflx(ncol,ngptsw), zdbtc_nodel(ncol,nlayers+1) + real(kind=r8) :: ztdbt_nodel(ncol,nlayers+1), ztdbtc_nodel(ncol,nlayers+1) + + real(kind=r8) :: zdbtmc(ncol), zdbtmo(ncol), zf + real(kind=r8) :: zwf, tauorig(ncol), repclc +! real(kind=r8) :: zincflux ! inactive + +! Arrays from rrtmg_sw_taumoln routines + +! real(kind=r8) :: ztaug(nlayers,16), ztaur(nlayers,16) +! real(kind=r8) :: zsflxzen(16) + real(kind=r8) :: ztaug(ncol,nlayers,ngptsw), ztaur(ncol,nlayers,ngptsw) + real(kind=r8) :: zsflxzen(ncol,ngptsw) + +! Arrays from rrtmg_sw_vrtqdr routine + + real(kind=r8) :: zcd(ncol,nlayers+1,ngptsw), zcu(ncol,nlayers+1,ngptsw) + real(kind=r8) :: zfd(ncol,nlayers+1,ngptsw), zfu(ncol,nlayers+1,ngptsw) + +! Inactive arrays +! real(kind=r8) :: zbbcd(nlayers+1), zbbcu(nlayers+1) +! real(kind=r8) :: zbbfd(nlayers+1), zbbfu(nlayers+1) +! real(kind=r8) :: zbbfddir(nlayers+1), zbbcddir(nlayers+1) +! ------------------------------------------------------------------ + +! Initializations + + ib1 = istart + ib2 = iend + klev = nlayers + + +! zincflux = 0.0_r8 + + repclc = 1.e-12_r8 + pbbcd(1:ncol,1:klev+1)=0._r8 + pbbcu(1:ncol,1:klev+1)=0._r8 + pbbfd(1:ncol,1:klev+1)=0._r8 + pbbfu(1:ncol,1:klev+1)=0._r8 + pbbcddir(1:ncol,1:klev+1)=0._r8 + pbbfddir(1:ncol,1:klev+1)=0._r8 + puvcd(1:ncol,1:klev+1)=0._r8 + puvfd(1:ncol,1:klev+1)=0._r8 + puvcddir(1:ncol,1:klev+1)=0._r8 + puvfddir(1:ncol,1:klev+1)=0._r8 + pnicd(1:ncol,1:klev+1)=0._r8 + pnifd(1:ncol,1:klev+1)=0._r8 + pnicddir(1:ncol,1:klev+1)=0._r8 + pnifddir(1:ncol,1:klev+1)=0._r8 + pnicu(1:ncol,1:klev+1)=0._r8 + pnifu(1:ncol,1:klev+1)=0._r8 + pbbfsu(:,1:ncol,1:klev+1)= 0._r8 + pbbfsd(:,1:ncol,1:klev+1)=0._r8 + + +! Calculate the optical depths for gaseous absorption and Rayleigh scattering + + do iplon=1,ncol + call taumol_sw(klev, & + colh2o(iplon,:), colco2(iplon,:), colch4(iplon,:),& + colo2(iplon,:), colo3(iplon,:), colmol(iplon,:), & + laytrop(iplon), jp(iplon,:), jt(iplon,:), jt1(iplon,:), & + fac00(iplon,:), fac01(iplon,:), fac10(iplon,:),& + fac11(iplon,:), & + selffac(iplon,:), selffrac(iplon,:),& + indself(iplon,:), forfac(iplon,:), forfrac(iplon,:), indfor(iplon,:), & + zsflxzen(iplon,:), ztaug(iplon,:,:),& + ztaur(iplon,:,:)) + enddo + +! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14 + + jb = ib1-1 ! ??? + do iplon=1,ncol + iw(iplon) =0 + end do + do iplon=1,ncol +! Clear-sky +! TOA direct beam +! Surface values + ztdbtc(iplon,1)=1.0_r8 + ztdbtc_nodel(iplon,1)=1.0_r8 + zdbtc(iplon,klev+1) =0.0_r8 + ztrac(iplon,klev+1) =0.0_r8 + ztradc(iplon,klev+1)=0.0_r8 +! Cloudy-sky +! Surface values + ztrao(iplon,klev+1) =0.0_r8 + ztrado(iplon,klev+1)=0.0_r8 +! Total sky +! TOA direct beam + ztdbt(iplon,1)=1.0_r8 + ztdbt_nodel(iplon,1)=1.0_r8 +! Surface values + zdbt(iplon,klev+1) =0.0_r8 + ztra(iplon,klev+1) =0.0_r8 + ztrad(iplon,klev+1)=0.0_r8 + enddo + do jb = ib1, ib2 + ibm = jb-15 + igt = ngc(ibm) + +! Reinitialize g-point counter for each band if output for each band is requested. + do iplon=1,ncol + if (iout.gt.0.and.ibm.ge.2) iw(iplon)= ngs(ibm-1) + enddo + + +! do jk=1,klev+1 +! zbbcd(jk)=0.0_r8 +! zbbcu(jk)=0.0_r8 +! zbbfd(jk)=0.0_r8 +! zbbfu(jk)=0.0_r8 +! enddo + +! Top of g-point interval loop within each band (iw is cumulative counter) + do jg = 1,igt + do iplon=1,ncol + iw(iplon) = iw(iplon)+1 + +! Apply adjustment for correct Earth/Sun distance and zenith angle to incoming solar flux + zincflx(iplon,iw(iplon)) = adjflux(iplon,jb) * zsflxzen(iplon,iw(iplon)) * prmu0(iplon) +! zincflux = zincflux + adjflux(jb) * zsflxzen(iw) * prmu0 ! inactive + enddo + +! Compute layer reflectances and transmittances for direct and diffuse sources, +! first clear then cloudy + +! zrefc(jk) direct albedo for clear +! zrefo(jk) direct albedo for cloud +! zrefdc(jk) diffuse albedo for clear +! zrefdo(jk) diffuse albedo for cloud +! ztrac(jk) direct transmittance for clear +! ztrao(jk) direct transmittance for cloudy +! ztradc(jk) diffuse transmittance for clear +! ztrado(jk) diffuse transmittance for cloudy +! +! zref(jk) direct reflectance +! zrefd(jk) diffuse reflectance +! ztra(jk) direct transmittance +! ztrad(jk) diffuse transmittance +! +! zdbtc(jk) clear direct beam transmittance +! zdbto(jk) cloudy direct beam transmittance +! zdbt(jk) layer mean direct beam transmittance +! ztdbt(jk) total direct beam transmittance at levels + do iplon=1,ncol + zrefc(iplon,klev+1) =palbp(iplon,ibm) + zrefdc(iplon,klev+1)=palbd(iplon,ibm) + zrupc(iplon,klev+1) =palbp(iplon,ibm) + zrupdc(iplon,klev+1)=palbd(iplon,ibm) + zrefo(iplon,klev+1) =palbp(iplon,ibm) + zrefdo(iplon,klev+1)=palbd(iplon,ibm) + zref(iplon,klev+1) =palbp(iplon,ibm) + zrefd(iplon,klev+1)=palbd(iplon,ibm) + zrup(iplon,klev+1) =palbp(iplon,ibm) + zrupd(iplon,klev+1)=palbd(iplon,ibm) + enddo +! Top of layer loop + do jk=1,klev + ikl=klev+1-jk + do iplon=1,ncol +! Note: two-stream calculations proceed from top to bottom; +! RRTMG_SW quantities are given bottom to top and are reversed here + + +! Set logical flag to do REFTRA calculation +! Do REFTRA for all clear layers + lrtchkclr(iplon,jk)=.true. + +! Do REFTRA only for cloudy layers in profile, since already done for clear layers + lrtchkcld(iplon,jk)=.false. + lrtchkcld(iplon,jk)=(pcldfmc(iplon,ikl,iw(iplon)) > repclc) + +! Clear-sky optical parameters - this section inactive +! Original +! ztauc(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) +! zomcc(jk) = ztaur(ikl,iw) / ztauc(jk) +! zgcc(jk) = 0.0001_r8 +! Total sky optical parameters +! ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaucmc(ikl,iw) +! zomco(jk) = ptaucmc(ikl,iw) * pomgcmc(ikl,iw) + ztaur(ikl,iw) +! zgco (jk) = (ptaucmc(ikl,iw) * pomgcmc(ikl,iw) * pasycmc(ikl,iw) + & +! ztaur(ikl,iw) * 0.0001_r8) / zomco(jk) +! zomco(jk) = zomco(jk) / ztauo(jk) + +! Clear-sky optical parameters including aerosols + if (ztaug(iplon,ikl,iw(iplon)) .lt. 0.0_r8) ztaug(iplon,ikl,iw(iplon)) = 0.0_r8 + + ztauc(iplon,jk) = ztaur(iplon,ikl,iw(iplon)) + ztaug(iplon,ikl,iw(iplon)) + ptaua(iplon,ikl,ibm) + zomcc(iplon,jk) = ztaur(iplon,ikl,iw(iplon)) * 1.0_r8 + ptaua(iplon,ikl,ibm) * pomga(iplon,ikl,ibm) + zgcc(iplon,jk) = pasya(iplon,ikl,ibm) * pomga(iplon,ikl,ibm) * ptaua(iplon,ikl,ibm) / zomcc(iplon,jk) + zomcc(iplon,jk) = zomcc(iplon,jk) / ztauc(iplon,jk) + +! Pre-delta-scaling clear and cloudy direct beam transmittance (must use 'orig', unscaled cloud OD) +! \/\/\/ This block of code is only needed for unscaled direct beam calculation + enddo + if (idelm .eq. 0) then + do iplon=1,ncol +! + zclear(iplon) = 1.0_r8 - pcldfmc(iplon,ikl,iw(iplon)) + zcloud(iplon) = pcldfmc(iplon,ikl,iw(iplon)) + +! Clear +! zdbtmc = exp(-ztauc(jk) / prmu0) + +! Use exponential lookup table for transmittance, or expansion of exponential for low tau + ze1(iplon) = ztauc(iplon,jk) / prmu0(iplon) + enddo + do iplon=1,ncol + if (ze1(iplon) .le. od_lo) then + zdbtmc(iplon) = 1._r8 - ze1(iplon) + 0.5_r8 * ze1(iplon) * ze1(iplon) + else + tblind(iplon) = ze1(iplon) / (bpade + ze1(iplon)) + itind(iplon) = tblint * tblind(iplon) + 0.5_r8 + zdbtmc(iplon) = exp_tbl(itind(iplon)) + endif + enddo + do iplon=1,ncol + + zdbtc_nodel(iplon,jk) = zdbtmc(iplon) + ztdbtc_nodel(iplon,jk+1) = zdbtc_nodel(iplon,jk) * ztdbtc_nodel(iplon,jk) + +! Clear + Cloud + tauorig(iplon) = ztauc(iplon,jk) + ptaormc(iplon,ikl,iw(iplon)) +! zdbtmo = exp(-tauorig / prmu0) + +! Use exponential lookup table for transmittance, or expansion of exponential for low tau + ze1(iplon) = tauorig(iplon) / prmu0(iplon) + enddo + do iplon=1,ncol + if (ze1(iplon) .le. od_lo) then + zdbtmo(iplon) = 1._r8 - ze1(iplon) + 0.5_r8 * ze1(iplon) * ze1(iplon) + else + tblind(iplon) = ze1(iplon) / (bpade + ze1(iplon)) + itind(iplon) = tblint * tblind(iplon) + 0.5_r8 + zdbtmo(iplon) = exp_tbl(itind(iplon)) + endif + enddo + do iplon=1,ncol + + zdbt_nodel(iplon,jk) = zclear(iplon)*zdbtmc(iplon) + zcloud(iplon)*zdbtmo(iplon) + ztdbt_nodel(iplon,jk+1) = zdbt_nodel(iplon,jk) * ztdbt_nodel(iplon,jk) + + enddo + endif + do iplon=1,ncol +! /\/\/\ Above code only needed for unscaled direct beam calculation + + +! Delta scaling - clear + zf = zgcc(iplon,jk) * zgcc(iplon,jk) + zwf = zomcc(iplon,jk) * zf + ztauc(iplon,jk) = (1.0_r8 - zwf) * ztauc(iplon,jk) + zomcc(iplon,jk) = (zomcc(iplon,jk) - zwf) / (1.0_r8 - zwf) + zgcc (iplon,jk) = (zgcc(iplon,jk) - zf) / (1.0_r8 - zf) + enddo +! Total sky optical parameters (cloud properties already delta-scaled) +! Use this code if cloud properties are derived in rrtmg_sw_cldprop + if (icpr .ge. 1) then + do iplon=1,ncol + ztauo(iplon,jk) = ztauc(iplon,jk) + ptaucmc(iplon,ikl,iw(iplon)) + zomco(iplon,jk) = ztauc(iplon,jk) * zomcc(iplon,jk) + ptaucmc(iplon,ikl,iw(iplon)) * pomgcmc(iplon,ikl,iw(iplon)) + zgco (iplon,jk) = (ptaucmc(iplon,ikl,iw(iplon)) * pomgcmc(iplon,ikl,iw(iplon)) * pasycmc(iplon,ikl,iw(iplon)) + & + ztauc(iplon,jk) * zomcc(iplon,jk) * zgcc(iplon,jk)) / zomco(iplon,jk) + zomco(iplon,jk) = zomco(iplon,jk) / ztauo(iplon,jk) + enddo +! Total sky optical parameters (if cloud properties not delta scaled) +! Use this code if cloud properties are not derived in rrtmg_sw_cldprop + elseif (icpr .eq. 0) then + do iplon=1,ncol + ztauo(iplon,jk) = ztaur(iplon,ikl,iw(iplon)) + ztaug(iplon,ikl,iw(iplon)) + ptaua(iplon,ikl,ibm) + ptaucmc(iplon,ikl,iw(iplon)) + zomco(iplon,jk) = ptaua(iplon,ikl,ibm) * pomga(iplon,ikl,ibm) + ptaucmc(iplon,ikl,iw(iplon)) * pomgcmc(iplon,ikl,iw(iplon)) + & + ztaur(iplon,ikl,iw(iplon)) * 1.0_r8 + zgco (iplon,jk) = (ptaucmc(iplon,ikl,iw(iplon)) * pomgcmc(iplon,ikl,iw(iplon)) * pasycmc(iplon,ikl,iw(iplon)) + & + ptaua(iplon,ikl,ibm)*pomga(iplon,ikl,ibm)*pasya(iplon,ikl,ibm)) / zomco(iplon,jk) + zomco(iplon,jk) = zomco(iplon,jk) / ztauo(iplon,jk) + +! Delta scaling - clouds +! Use only if subroutine rrtmg_sw_cldprop is not used to get cloud properties and to apply delta scaling + zf = zgco(iplon,jk) * zgco(iplon,jk) + zwf = zomco(iplon,jk) * zf + ztauo(iplon,jk) = (1._r8 - zwf) * ztauo(iplon,jk) + zomco(iplon,jk) = (zomco(iplon,jk) - zwf) / (1.0_r8 - zwf) + zgco (iplon,jk) = (zgco(iplon,jk) - zf) / (1.0_r8 - zf) + enddo + endif + +! End of layer loop + enddo + +! Clear sky reflectivities + call reftra_sw (klev,ncol, & + lrtchkclr, zgcc, prmu0, ztauc, zomcc, & + zrefc, zrefdc, ztrac, ztradc) + +! Total sky reflectivities + call reftra_sw (klev, ncol, & + lrtchkcld, zgco, prmu0, ztauo, zomco, & + zrefo, zrefdo, ztrao, ztrado) + + do jk=1,klev + do iplon=1,ncol +! Combine clear and cloudy contributions for total sky + ikl = klev+1-jk + zclear(iplon) = 1.0_r8 - pcldfmc(iplon,ikl,iw(iplon)) + zcloud(iplon) = pcldfmc(iplon,ikl,iw(iplon)) + + zref(iplon,jk) = zclear(iplon)*zrefc(iplon,jk) + zcloud(iplon)*zrefo(iplon,jk) + zrefd(iplon,jk)= zclear(iplon)*zrefdc(iplon,jk) + zcloud(iplon)*zrefdo(iplon,jk) + ztra(iplon,jk) = zclear(iplon)*ztrac(iplon,jk) + zcloud(iplon)*ztrao(iplon,jk) + ztrad(iplon,jk)= zclear(iplon)*ztradc(iplon,jk) + zcloud(iplon)*ztrado(iplon,jk) + +! Direct beam transmittance + +! Clear +! zdbtmc(iplon) = exp(-ztauc(iplon,jk) / prmu0) + +! Use exponential lookup table for transmittance, or expansion of +! exponential for low tau + ze1(iplon) = ztauc(iplon,jk) / prmu0(iplon) + enddo + do iplon=1,ncol + if (ze1(iplon) .le. od_lo) then + zdbtmc(iplon) = 1._r8 - ze1(iplon) + 0.5_r8 * ze1(iplon) * ze1(iplon) + else + tblind(iplon) = ze1(iplon) / (bpade + ze1(iplon)) + itind(iplon) = tblint * tblind(iplon) + 0.5_r8 + zdbtmc(iplon) = exp_tbl(itind(iplon)) + endif + + zdbtc(iplon,jk) = zdbtmc(iplon) + ztdbtc(iplon,jk+1) = zdbtc(iplon,jk)*ztdbtc(iplon,jk) + +! Clear + Cloud +! zdbtmo = exp(-ztauo(jk) / prmu0) + +! Use exponential lookup table for transmittance, or expansion of +! exponential for low tau + ze1(iplon) = ztauo(iplon,jk) / prmu0(iplon) + if (ze1(iplon) .le. od_lo) then + zdbtmo(iplon) = 1._r8 - ze1(iplon) + 0.5_r8 * ze1(iplon) * ze1(iplon) + else + tblind(iplon) = ze1(iplon) / (bpade + ze1(iplon)) + itind(iplon) = tblint * tblind(iplon) + 0.5_r8 + zdbtmo(iplon) = exp_tbl(itind(iplon)) + endif + + zdbt(iplon,jk) = zclear(iplon)*zdbtmc(iplon) + zcloud(iplon)*zdbtmo(iplon) + ztdbt(iplon,jk+1) = zdbt(iplon,jk)*ztdbt(iplon,jk) + + enddo + enddo +! Vertical quadrature for clear-sky fluxes + + call vrtqdr_sw(ncol,klev, iw, & + zrefc, zrefdc, ztrac, ztradc, & + zdbtc, zrdndc, zrupc, zrupdc, ztdbtc, & + zcd, zcu) + +! Vertical quadrature for cloudy fluxes + + call vrtqdr_sw(ncol,klev, iw, & + zref, zrefd, ztra, ztrad, & + zdbt, zrdnd, zrup, zrupd, ztdbt, & + zfd, zfu) + +! Upwelling and downwelling fluxes at levels +! Two-stream calculations go from top to bottom; +! layer indexing is reversed to go bottom to top for output arrays + + do jk=1,klev+1 + do iplon=1,ncol + ikl=klev+2-jk + +! Accumulate spectral fluxes over bands - inactive +! zbbfu(ikl) = zbbfu(ikl) + zincflx(iw)*zfu(jk,iw) +! zbbfd(ikl) = zbbfd(ikl) + zincflx(iw)*zfd(jk,iw) +! zbbcu(ikl) = zbbcu(ikl) + zincflx(iw)*zcu(jk,iw) +! zbbcd(ikl) = zbbcd(ikl) + zincflx(iw)*zcd(jk,iw) +! zbbfddir(ikl) = zbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk) +! zbbcddir(ikl) = zbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk) + + pbbfsu(ibm,iplon,ikl) = pbbfsu(ibm,iplon,ikl) + zincflx(iplon,iw(iplon))*zfu(iplon,jk,iw(iplon)) + pbbfsd(ibm,iplon,ikl) = pbbfsd(ibm,iplon,ikl) + zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + +! Accumulate spectral fluxes over whole spectrum + pbbfu(iplon,ikl) = pbbfu(iplon,ikl) + zincflx(iplon,iw(iplon))*zfu(iplon,jk,iw(iplon)) + pbbfd(iplon,ikl) = pbbfd(iplon,ikl) + zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + pbbcu(iplon,ikl) = pbbcu(iplon,ikl) + zincflx(iplon,iw(iplon))*zcu(iplon,jk,iw(iplon)) + pbbcd(iplon,ikl) = pbbcd(iplon,ikl) + zincflx(iplon,iw(iplon))*zcd(iplon,jk,iw(iplon)) + enddo + if (idelm .eq. 0) then + do iplon=1,ncol + pbbfddir(iplon,ikl) = pbbfddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt_nodel(iplon,jk) + pbbcddir(iplon,ikl) = pbbcddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc_nodel(iplon,jk) + enddo + elseif (idelm .eq. 1) then + do iplon=1,ncol + pbbfddir(iplon,ikl) = pbbfddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt(iplon,jk) + pbbcddir(iplon,ikl) = pbbcddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc(iplon,jk) + enddo + endif + +! Accumulate direct fluxes for UV/visible bands + if (ibm >= 10 .and. ibm <= 13) then + do iplon=1,ncol + puvcd(iplon,ikl) = puvcd(iplon,ikl) + zincflx(iplon,iw(iplon))*zcd(iplon,jk,iw(iplon)) + puvfd(iplon,ikl) = puvfd(iplon,ikl) + zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + enddo + if (idelm .eq. 0) then + do iplon=1,ncol + puvfddir(iplon,ikl) = puvfddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt_nodel(iplon,jk) + puvcddir(iplon,ikl) = puvcddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc_nodel(iplon,jk) + enddo + elseif (idelm .eq. 1) then + do iplon=1,ncol + puvfddir(iplon,ikl) = puvfddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt(iplon,jk) + puvcddir(iplon,ikl) = puvcddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc(iplon,jk) + enddo + endif +! band 9 is half-NearIR and half-Visible + else if (ibm == 9) then + do iplon=1,ncol + puvcd(iplon,ikl) = puvcd(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zcd(iplon,jk,iw(iplon)) + puvfd(iplon,ikl) = puvfd(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + pnicd(iplon,ikl) = pnicd(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zcd(iplon,jk,iw(iplon)) + pnifd(iplon,ikl) = pnifd(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + enddo + if (idelm .eq. 0) then + do iplon=1,ncol + puvfddir(iplon,ikl) = puvfddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbt_nodel(iplon,jk) + puvcddir(iplon,ikl) = puvcddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbtc_nodel(iplon,jk) + pnifddir(iplon,ikl) = pnifddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbt_nodel(iplon,jk) + pnicddir(iplon,ikl) = pnicddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbtc_nodel(iplon,jk) + enddo + elseif (idelm .eq. 1) then + do iplon=1,ncol + puvfddir(iplon,ikl) = puvfddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbt(iplon,jk) + puvcddir(iplon,ikl) = puvcddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbtc(iplon,jk) + pnifddir(iplon,ikl) = pnifddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbt(iplon,jk) + pnicddir(iplon,ikl) = pnicddir(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*ztdbtc(iplon,jk) + enddo + endif + do iplon=1,ncol + pnicu(iplon,ikl) = pnicu(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zcu(iplon,jk,iw(iplon)) + pnifu(iplon,ikl) = pnifu(iplon,ikl) + 0.5_r8*zincflx(iplon,iw(iplon))*zfu(iplon,jk,iw(iplon)) +! Accumulate direct fluxes for near-IR bands + enddo + else if (ibm == 14 .or. ibm <= 8) then + do iplon=1,ncol + pnicd(iplon,ikl) = pnicd(iplon,ikl) + zincflx(iplon,iw(iplon))*zcd(iplon,jk,iw(iplon)) + pnifd(iplon,ikl) = pnifd(iplon,ikl) + zincflx(iplon,iw(iplon))*zfd(iplon,jk,iw(iplon)) + enddo + if (idelm .eq. 0) then + do iplon=1,ncol + pnifddir(iplon,ikl) = pnifddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt_nodel(iplon,jk) + pnicddir(iplon,ikl) = pnicddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc_nodel(iplon,jk) + enddo + elseif (idelm .eq. 1) then + do iplon=1,ncol + pnifddir(iplon,ikl) = pnifddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbt(iplon,jk) + pnicddir(iplon,ikl) = pnicddir(iplon,ikl) + zincflx(iplon,iw(iplon))*ztdbtc(iplon,jk) + enddo + endif +! Added for net near-IR flux diagnostic + do iplon=1,ncol + pnicu(iplon,ikl) = pnicu(iplon,ikl) + zincflx(iplon,iw(iplon))*zcu(iplon,jk,iw(iplon)) + pnifu(iplon,ikl) = pnifu(iplon,ikl) + zincflx(iplon,iw(iplon))*zfu(iplon,jk,iw(iplon)) + enddo + endif + + +! End loop on jg, g-point interval + enddo + +! End loop on jb, spectral band + enddo + end do + + end subroutine spcvmc_sw + + end module rrtmg_sw_spcvmc + + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 new file mode 100644 index 0000000000..8e1147ad41 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_taumol.f90 @@ -0,0 +1,1490 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_taumol.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:15 $ + + module rrtmg_sw_taumol + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + use rrsw_con, only: oneminus + use rrsw_wvn, only: nspa, nspb + + implicit none + + contains + +!---------------------------------------------------------------------------- + subroutine taumol_sw(nlayers, & + colh2o, colco2, colch4, colo2, colo3, colmol, & + laytrop, jp, jt, jt1, & + fac00, fac01, fac10, fac11, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + sfluxzen, taug, taur) +!---------------------------------------------------------------------------- + +! ****************************************************************************** +! * * +! * Optical depths developed for the * +! * * +! * RAPID RADIATIVE TRANSFER MODEL (RRTM) * +! * * +! * * +! * ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. * +! * 131 HARTWELL AVENUE * +! * LEXINGTON, MA 02421 * +! * * +! * * +! * ELI J. MLAWER * +! * JENNIFER DELAMERE * +! * STEVEN J. TAUBMAN * +! * SHEPARD A. CLOUGH * +! * * +! * * +! * * +! * * +! * email: mlawer@aer.com * +! * email: jdelamer@aer.com * +! * * +! * The authors wish to acknowledge the contributions of the * +! * following people: Patrick D. Brown, Michael J. Iacono, * +! * Ronald E. Farren, Luke Chen, Robert Bergstrom. * +! * * +! ****************************************************************************** +! * TAUMOL * +! * * +! * This file contains the subroutines TAUGBn (where n goes from * +! * 1 to 28). TAUGBn calculates the optical depths and Planck fractions * +! * per g-value and layer for band n. * +! * * +! * Output: optical depths (unitless) * +! * fractions needed to compute Planck functions at every layer * +! * and g-value * +! * * +! * COMMON /TAUGCOM/ TAUG(MXLAY,MG) * +! * COMMON /PLANKG/ FRACS(MXLAY,MG) * +! * * +! * Input * +! * * +! * PARAMETER (MG=16, MXLAY=203, NBANDS=14) * +! * * +! * COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS) * +! * COMMON /PRECISE/ ONEMINUS * +! * COMMON /PROFILE/ NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY), * +! * & PZ(0:MXLAY),TZ(0:MXLAY),TBOUND * +! * COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW, * +! * & COLH2O(MXLAY),COLCO2(MXLAY), * +! * & COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY), * +! * & COLO2(MXLAY),CO2MULT(MXLAY) * +! * COMMON /INTFAC/ FAC00(MXLAY),FAC01(MXLAY), * +! * & FAC10(MXLAY),FAC11(MXLAY) * +! * COMMON /INTIND/ JP(MXLAY),JT(MXLAY),JT1(MXLAY) * +! * COMMON /SELF/ SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY) * +! * * +! * Description: * +! * NG(IBAND) - number of g-values in band IBAND * +! * NSPA(IBAND) - for the lower atmosphere, the number of reference * +! * atmospheres that are stored for band IBAND per * +! * pressure level and temperature. Each of these * +! * atmospheres has different relative amounts of the * +! * key species for the band (i.e. different binary * +! * species parameters). * +! * NSPB(IBAND) - same for upper atmosphere * +! * ONEMINUS - since problems are caused in some cases by interpolation * +! * parameters equal to or greater than 1, for these cases * +! * these parameters are set to this value, slightly < 1. * +! * PAVEL - layer pressures (mb) * +! * TAVEL - layer temperatures (degrees K) * +! * PZ - level pressures (mb) * +! * TZ - level temperatures (degrees K) * +! * LAYTROP - layer at which switch is made from one combination of * +! * key species to another * +! * COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water * +! * vapor,carbon dioxide, ozone, nitrous ozide, methane, * +! * respectively (molecules/cm**2) * +! * CO2MULT - for bands in which carbon dioxide is implemented as a * +! * trace species, this is the factor used to multiply the * +! * band's average CO2 absorption coefficient to get the added * +! * contribution to the optical depth relative to 355 ppm. * +! * FACij(LAY) - for layer LAY, these are factors that are needed to * +! * compute the interpolation factors that multiply the * +! * appropriate reference k-values. A value of 0 (1) for * +! * i,j indicates that the corresponding factor multiplies * +! * reference k-value for the lower (higher) of the two * +! * appropriate temperatures, and altitudes, respectively. * +! * JP - the index of the lower (in altitude) of the two appropriate * +! * reference pressure levels needed for interpolation * +! * JT, JT1 - the indices of the lower of the two appropriate reference * +! * temperatures needed for interpolation (for pressure * +! * levels JP and JP+1, respectively) * +! * SELFFAC - scale factor needed to water vapor self-continuum, equals * +! * (water vapor density)/(atmospheric density at 296K and * +! * 1013 mb) * +! * SELFFRAC - factor needed for temperature interpolation of reference * +! * water vapor self-continuum data * +! * INDSELF - index of the lower of the two appropriate reference * +! * temperatures needed for the self-continuum interpolation * +! * * +! * Data input * +! * COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) * +! * (note: n is the band number) * +! * * +! * Description: * +! * KA - k-values for low reference atmospheres (no water vapor * +! * self-continuum) (units: cm**2/molecule) * +! * KB - k-values for high reference atmospheres (all sources) * +! * (units: cm**2/molecule) * +! * SELFREF - k-values for water vapor self-continuum for reference * +! * atmospheres (used below LAYTROP) * +! * (units: cm**2/molecule) * +! * * +! * DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG) * +! * EQUIVALENCE (KA,ABSA),(KB,ABSB) * +! * * +! ***************************************************************************** +! +! Modifications +! +! Revised: Adapted to F90 coding, J.-J.Morcrette, ECMWF, Feb 2003 +! Revised: Modified for g-point reduction, MJIacono, AER, Dec 2003 +! Revised: Reformatted for consistency with rrtmg_lw, MJIacono, AER, Jul 2006 +! +! ------- Declarations ------- + +! ----- Input ----- + integer, intent(in) :: nlayers ! total number of layers + + integer, intent(in) :: laytrop ! tropopause layer index + integer, intent(in) :: jp(:) ! + ! Dimensions: (nlayers) + integer, intent(in) :: jt(:) ! + ! Dimensions: (nlayers) + integer, intent(in) :: jt1(:) ! + ! Dimensions: (nlayers) + + real(kind=r8), intent(in) :: colh2o(:) ! column amount (h2o) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colco2(:) ! column amount (co2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colo3(:) ! column amount (o3) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colch4(:) ! column amount (ch4) + ! Dimensions: (nlayers) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colo2(:) ! column amount (o2) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: colmol(:) ! + ! Dimensions: (nlayers) + + integer, intent(in) :: indself(:) + ! Dimensions: (nlayers) + integer, intent(in) :: indfor(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: selffac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: selffrac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: forfac(:) + ! Dimensions: (nlayers) + real(kind=r8), intent(in) :: forfrac(:) + ! Dimensions: (nlayers) + + real(kind=r8), intent(in) :: & ! + fac00(:), fac01(:), & ! Dimensions: (nlayers) + fac10(:), fac11(:) + +! ----- Output ----- + real(kind=r8), intent(out) :: sfluxzen(:) ! solar source function + ! Dimensions: (ngptsw) + real(kind=r8), intent(out) :: taug(:,:) ! gaseous optical depth + ! Dimensions: (nlayers,ngptsw) + real(kind=r8), intent(out) :: taur(:,:) ! Rayleigh + ! Dimensions: (nlayers,ngptsw) +! real(kind=r8), intent(out) :: ssa(:,:) ! single scattering albedo (inactive) + ! Dimensions: (nlayers,ngptsw) + +! Calculate gaseous optical depth and planck fractions for each spectral band. + + call taumol16 + call taumol17 + call taumol18 + call taumol19 + call taumol20 + call taumol21 + call taumol22 + call taumol23 + call taumol24 + call taumol25 + call taumol26 + call taumol27 + call taumol28 + call taumol29 + +!------------- + contains +!------------- + +!---------------------------------------------------------------------------- + subroutine taumol16 +!---------------------------------------------------------------------------- +! +! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng16 + use rrsw_kg16, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat1 + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + speccomb = colh2o(lay) + strrat1*colch4(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng16 + taug(lay,ig) = speccomb * & + (fac000 * absa(ind0 ,ig) + & + fac100 * absa(ind0 +1,ig) + & + fac010 * absa(ind0 +9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1 ,ig) + & + fac101 * absa(ind1 +1,ig) + & + fac011 * absa(ind1 +9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ig) = tauray/taug(lay,ig) + taur(lay,ig) = tauray + enddo + enddo + + laysolfr = nlayers + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) & + laysolfr = lay + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1 + tauray = colmol(lay) * rayl + + do ig = 1, ng16 + taug(lay,ig) = colch4(lay) * & + (fac00(lay) * absb(ind0 ,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1 ,ig) + & + fac11(lay) * absb(ind1+1,ig)) +! ssa(lay,ig) = tauray/taug(lay,ig) + if (lay .eq. laysolfr) sfluxzen(ig) = sfluxref(ig) + taur(lay,ig) = tauray + enddo + enddo + + end subroutine taumol16 + +!---------------------------------------------------------------------------- + subroutine taumol17 +!---------------------------------------------------------------------------- +! +! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng17, ngs16 + use rrsw_kg17, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + speccomb = colh2o(lay) + strrat*colco2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(17) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(17) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng17 + taug(lay,ngs16+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig) + taur(lay,ngs16+ig) = tauray + enddo + enddo + + laysolfr = nlayers + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) & + laysolfr = lay + speccomb = colh2o(lay) + strrat*colco2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 4._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(17) + js + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(17) + js + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng17 + taug(lay,ngs16+ig) = speccomb * & + (fac000 * absb(ind0,ig) + & + fac100 * absb(ind0+1,ig) + & + fac010 * absb(ind0+5,ig) + & + fac110 * absb(ind0+6,ig) + & + fac001 * absb(ind1,ig) + & + fac101 * absb(ind1+1,ig) + & + fac011 * absb(ind1+5,ig) + & + fac111 * absb(ind1+6,ig)) + & + colh2o(lay) * & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig))) +! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig) + if (lay .eq. laysolfr) sfluxzen(ngs16+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs16+ig) = tauray + enddo + enddo + + end subroutine taumol17 + +!---------------------------------------------------------------------------- + subroutine taumol18 +!---------------------------------------------------------------------------- +! +! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng18, ngs17 + use rrsw_kg18, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + speccomb = colh2o(lay) + strrat*colch4(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(18) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(18) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng18 + taug(lay,ngs17+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig) + if (lay .eq. laysolfr) sfluxzen(ngs17+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs17+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(18) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(18) + 1 + tauray = colmol(lay) * rayl + + do ig = 1, ng18 + taug(lay,ngs17+ig) = colch4(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) +! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig) + taur(lay,ngs17+ig) = tauray + enddo + enddo + + end subroutine taumol18 + +!---------------------------------------------------------------------------- + subroutine taumol19 +!---------------------------------------------------------------------------- +! +! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng19, ngs18 + use rrsw_kg19, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + speccomb = colh2o(lay) + strrat*colco2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(19) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(19) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1 , ng19 + taug(lay,ngs18+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig) + if (lay .eq. laysolfr) sfluxzen(ngs18+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs18+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(19) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(19) + 1 + tauray = colmol(lay) * rayl + + do ig = 1 , ng19 + taug(lay,ngs18+ig) = colco2(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) +! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig) + taur(lay,ngs18+ig) = tauray + enddo + enddo + + end subroutine taumol19 + +!---------------------------------------------------------------------------- + subroutine taumol20 +!---------------------------------------------------------------------------- +! +! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng20, ngs19 + use rrsw_kg20, only : absa, absb, forref, selfref, & + sfluxref, absch4, rayl, layreffr + + implicit none + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(20) + 1 + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(20) + 1 + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng20 + taug(lay,ngs19+ig) = colh2o(lay) * & + ((fac00(lay) * absa(ind0,ig) + & + fac10(lay) * absa(ind0+1,ig) + & + fac01(lay) * absa(ind1,ig) + & + fac11(lay) * absa(ind1+1,ig)) + & + selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) & + + colch4(lay) * absch4(ig) +! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig) + taur(lay,ngs19+ig) = tauray + if (lay .eq. laysolfr) sfluxzen(ngs19+ig) = sfluxref(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(20) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(20) + 1 + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng20 + taug(lay,ngs19+ig) = colh2o(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) + & + colch4(lay) * absch4(ig) +! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig) + taur(lay,ngs19+ig) = tauray + enddo + enddo + + end subroutine taumol20 + +!---------------------------------------------------------------------------- + subroutine taumol21 +!---------------------------------------------------------------------------- +! +! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng21, ngs20 + use rrsw_kg21, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + speccomb = colh2o(lay) + strrat*colco2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(21) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(21) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng21 + taug(lay,ngs20+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig) + if (lay .eq. laysolfr) sfluxzen(ngs20+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs20+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + speccomb = colh2o(lay) + strrat*colco2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 4._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(21) + js + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(21) + js + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng21 + taug(lay,ngs20+ig) = speccomb * & + (fac000 * absb(ind0,ig) + & + fac100 * absb(ind0+1,ig) + & + fac010 * absb(ind0+5,ig) + & + fac110 * absb(ind0+6,ig) + & + fac001 * absb(ind1,ig) + & + fac101 * absb(ind1+1,ig) + & + fac011 * absb(ind1+5,ig) + & + fac111 * absb(ind1+6,ig)) + & + colh2o(lay) * & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig))) +! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig) + taur(lay,ngs20+ig) = tauray + enddo + enddo + + end subroutine taumol21 + +!---------------------------------------------------------------------------- + subroutine taumol22 +!---------------------------------------------------------------------------- +! +! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng22, ngs21 + use rrsw_kg22, only : absa, absb, forref, selfref, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray, o2adj, o2cont + +! The following factor is the ratio of total O2 band intensity (lines +! and Mate continuum) to O2 band intensity (line only). It is needed +! to adjust the optical depths since the k's include only lines. + o2adj = 1.6_r8 + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8) + speccomb = colh2o(lay) + o2adj*strrat*colo2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) +! odadj = specparm + o2adj * (1._r8 - specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(22) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(22) + js + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng22 + taug(lay,ngs21+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) & + + o2cont +! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig) + if (lay .eq. laysolfr) sfluxzen(ngs21+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs21+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8) + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(22) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(22) + 1 + tauray = colmol(lay) * rayl + + do ig = 1, ng22 + taug(lay,ngs21+ig) = colo2(lay) * o2adj * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) + & + o2cont +! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig) + taur(lay,ngs21+ig) = tauray + enddo + enddo + + end subroutine taumol22 + +!---------------------------------------------------------------------------- + subroutine taumol23 +!---------------------------------------------------------------------------- +! +! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng23, ngs22 + use rrsw_kg23, only : absa, forref, selfref, & + sfluxref, rayl, layreffr, givfac + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(23) + 1 + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(23) + 1 + inds = indself(lay) + indf = indfor(lay) + + do ig = 1, ng23 + tauray = colmol(lay) * rayl(ig) + taug(lay,ngs22+ig) = colh2o(lay) * & + (givfac * (fac00(lay) * absa(ind0,ig) + & + fac10(lay) * absa(ind0+1,ig) + & + fac01(lay) * absa(ind1,ig) + & + fac11(lay) * absa(ind1+1,ig)) + & + selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig) + if (lay .eq. laysolfr) sfluxzen(ngs22+ig) = sfluxref(ig) + taur(lay,ngs22+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng23 +! taug(lay,ngs22+ig) = colmol(lay) * rayl(ig) +! ssa(lay,ngs22+ig) = 1.0_r8 + taug(lay,ngs22+ig) = 0._r8 + taur(lay,ngs22+ig) = colmol(lay) * rayl(ig) + enddo + enddo + + end subroutine taumol23 + +!---------------------------------------------------------------------------- + subroutine taumol24 +!---------------------------------------------------------------------------- +! +! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng24, ngs23 + use rrsw_kg24, only : absa, absb, forref, selfref, & + sfluxref, abso3a, abso3b, rayla, raylb, & + layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + speccomb = colh2o(lay) + strrat*colo2(lay) + specparm = colh2o(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(24) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(24) + js + inds = indself(lay) + indf = indfor(lay) + + do ig = 1, ng24 + tauray = colmol(lay) * (rayla(ig,js) + & + fs * (rayla(ig,js+1) - rayla(ig,js))) + taug(lay,ngs23+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) + & + colo3(lay) * abso3a(ig) + & + colh2o(lay) * & + (selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) +! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig) + if (lay .eq. laysolfr) sfluxzen(ngs23+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs23+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(24) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(24) + 1 + + do ig = 1, ng24 + tauray = colmol(lay) * raylb(ig) + taug(lay,ngs23+ig) = colo2(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) + & + colo3(lay) * abso3b(ig) +! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig) + taur(lay,ngs23+ig) = tauray + enddo + enddo + + end subroutine taumol24 + +!---------------------------------------------------------------------------- + subroutine taumol25 +!---------------------------------------------------------------------------- +! +! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng25, ngs24 + use rrsw_kg25, only : absa, & + sfluxref, abso3a, abso3b, rayl, layreffr + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) & + laysolfr = min(lay+1,laytrop) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(25) + 1 + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(25) + 1 + + do ig = 1, ng25 + tauray = colmol(lay) * rayl(ig) + taug(lay,ngs24+ig) = colh2o(lay) * & + (fac00(lay) * absa(ind0,ig) + & + fac10(lay) * absa(ind0+1,ig) + & + fac01(lay) * absa(ind1,ig) + & + fac11(lay) * absa(ind1+1,ig)) + & + colo3(lay) * abso3a(ig) +! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig) + if (lay .eq. laysolfr) sfluxzen(ngs24+ig) = sfluxref(ig) + taur(lay,ngs24+ig) = tauray + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng25 + tauray = colmol(lay) * rayl(ig) + taug(lay,ngs24+ig) = colo3(lay) * abso3b(ig) +! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig) + taur(lay,ngs24+ig) = tauray + enddo + enddo + + end subroutine taumol25 + +!---------------------------------------------------------------------------- + subroutine taumol26 +!---------------------------------------------------------------------------- +! +! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng26, ngs25 + use rrsw_kg26, only : sfluxref, rayl + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + + laysolfr = laytrop + +! Lower atmosphere loop + do lay = 1, laytrop + do ig = 1, ng26 +! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig) +! ssa(lay,ngs25+ig) = 1.0_r8 + if (lay .eq. laysolfr) sfluxzen(ngs25+ig) = sfluxref(ig) + taug(lay,ngs25+ig) = 0._r8 + taur(lay,ngs25+ig) = colmol(lay) * rayl(ig) + enddo + enddo + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + do ig = 1, ng26 +! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig) +! ssa(lay,ngs25+ig) = 1.0_r8 + taug(lay,ngs25+ig) = 0._r8 + taur(lay,ngs25+ig) = colmol(lay) * rayl(ig) + enddo + enddo + + end subroutine taumol26 + +!---------------------------------------------------------------------------- + subroutine taumol27 +!---------------------------------------------------------------------------- +! +! band 27: 29000-38000 cm-1 (low - o3; high - o3) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng27, ngs26 + use rrsw_kg27, only : absa, absb, & + sfluxref, rayl, layreffr, scalekur + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(27) + 1 + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(27) + 1 + + do ig = 1, ng27 + tauray = colmol(lay) * rayl(ig) + taug(lay,ngs26+ig) = colo3(lay) * & + (fac00(lay) * absa(ind0,ig) + & + fac10(lay) * absa(ind0+1,ig) + & + fac01(lay) * absa(ind1,ig) + & + fac11(lay) * absa(ind1+1,ig)) +! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig) + taur(lay,ngs26+ig) = tauray + enddo + enddo + + laysolfr = nlayers + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) & + laysolfr = lay + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(27) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(27) + 1 + + do ig = 1, ng27 + tauray = colmol(lay) * rayl(ig) + taug(lay,ngs26+ig) = colo3(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) +! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig) + if (lay.eq.laysolfr) sfluxzen(ngs26+ig) = scalekur * sfluxref(ig) + taur(lay,ngs26+ig) = tauray + enddo + enddo + + end subroutine taumol27 + +!---------------------------------------------------------------------------- + subroutine taumol28 +!---------------------------------------------------------------------------- +! +! band 28: 38000-50000 cm-1 (low - o3,o2; high - o3,o2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng28, ngs27 + use rrsw_kg28, only : absa, absb, & + sfluxref, rayl, layreffr, strrat + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + speccomb = colo3(lay) + strrat*colo2(lay) + specparm = colo3(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 8._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(28) + js + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(28) + js + tauray = colmol(lay) * rayl + + do ig = 1, ng28 + taug(lay,ngs27+ig) = speccomb * & + (fac000 * absa(ind0,ig) + & + fac100 * absa(ind0+1,ig) + & + fac010 * absa(ind0+9,ig) + & + fac110 * absa(ind0+10,ig) + & + fac001 * absa(ind1,ig) + & + fac101 * absa(ind1+1,ig) + & + fac011 * absa(ind1+9,ig) + & + fac111 * absa(ind1+10,ig)) +! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig) + taur(lay,ngs27+ig) = tauray + enddo + enddo + + laysolfr = nlayers + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) & + laysolfr = lay + speccomb = colo3(lay) + strrat*colo2(lay) + specparm = colo3(lay)/speccomb + if (specparm .ge. oneminus) specparm = oneminus + specmult = 4._r8*(specparm) + js = 1 + int(specmult) + fs = mod(specmult, 1._r8 ) + fac000 = (1._r8 - fs) * fac00(lay) + fac010 = (1._r8 - fs) * fac10(lay) + fac100 = fs * fac00(lay) + fac110 = fs * fac10(lay) + fac001 = (1._r8 - fs) * fac01(lay) + fac011 = (1._r8 - fs) * fac11(lay) + fac101 = fs * fac01(lay) + fac111 = fs * fac11(lay) + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(28) + js + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(28) + js + tauray = colmol(lay) * rayl + + do ig = 1, ng28 + taug(lay,ngs27+ig) = speccomb * & + (fac000 * absb(ind0,ig) + & + fac100 * absb(ind0+1,ig) + & + fac010 * absb(ind0+5,ig) + & + fac110 * absb(ind0+6,ig) + & + fac001 * absb(ind1,ig) + & + fac101 * absb(ind1+1,ig) + & + fac011 * absb(ind1+5,ig) + & + fac111 * absb(ind1+6,ig)) +! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig) + if (lay .eq. laysolfr) sfluxzen(ngs27+ig) = sfluxref(ig,js) & + + fs * (sfluxref(ig,js+1) - sfluxref(ig,js)) + taur(lay,ngs27+ig) = tauray + enddo + enddo + + end subroutine taumol28 + +!---------------------------------------------------------------------------- + subroutine taumol29 +!---------------------------------------------------------------------------- +! +! band 29: 820-2600 cm-1 (low - h2o; high - co2) +! +!---------------------------------------------------------------------------- + +! ------- Modules ------- + + use parrrsw, only : ng29, ngs28 + use rrsw_kg29, only : absa, absb, forref, selfref, & + sfluxref, absh2o, absco2, rayl, layreffr + +! ------- Declarations ------- + +! Local + + integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr + real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, & + fac110, fac111, fs, speccomb, specmult, specparm, & + tauray + +! Compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. Below LAYTROP, the water +! vapor self-continuum is interpolated (in temperature) separately. + +! Lower atmosphere loop + do lay = 1, laytrop + ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(29) + 1 + ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(29) + 1 + inds = indself(lay) + indf = indfor(lay) + tauray = colmol(lay) * rayl + + do ig = 1, ng29 + taug(lay,ngs28+ig) = colh2o(lay) * & + ((fac00(lay) * absa(ind0,ig) + & + fac10(lay) * absa(ind0+1,ig) + & + fac01(lay) * absa(ind1,ig) + & + fac11(lay) * absa(ind1+1,ig)) + & + selffac(lay) * (selfref(inds,ig) + & + selffrac(lay) * & + (selfref(inds+1,ig) - selfref(inds,ig))) + & + forfac(lay) * (forref(indf,ig) + & + forfrac(lay) * & + (forref(indf+1,ig) - forref(indf,ig)))) & + + colco2(lay) * absco2(ig) +! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig) + taur(lay,ngs28+ig) = tauray + enddo + enddo + + laysolfr = nlayers + +! Upper atmosphere loop + do lay = laytrop+1, nlayers + if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) & + laysolfr = lay + ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(29) + 1 + ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(29) + 1 + tauray = colmol(lay) * rayl + + do ig = 1, ng29 + taug(lay,ngs28+ig) = colco2(lay) * & + (fac00(lay) * absb(ind0,ig) + & + fac10(lay) * absb(ind0+1,ig) + & + fac01(lay) * absb(ind1,ig) + & + fac11(lay) * absb(ind1+1,ig)) & + + colh2o(lay) * absh2o(ig) +! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig) + if (lay .eq. laysolfr) sfluxzen(ngs28+ig) = sfluxref(ig) + taur(lay,ngs28+ig) = tauray + enddo + enddo + + end subroutine taumol29 + + end subroutine taumol_sw + + end module rrtmg_sw_taumol + diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 new file mode 100644 index 0000000000..d1ced61871 --- /dev/null +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_vrtqdr.f90 @@ -0,0 +1,161 @@ +! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_vrtqdr.f90,v $ +! author: $Author: mike $ +! revision: $Revision: 1.2 $ +! created: $Date: 2007/08/23 20:40:15 $ +! + module rrtmg_sw_vrtqdr + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +! ------- Modules ------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! use parkind, only: jpim, jprb + use parrrsw, only: ngptsw + + implicit none + + contains + +! -------------------------------------------------------------------------- + subroutine vrtqdr_sw(ncol, klev, kw, & + pref, prefd, ptra, ptrad, & + pdbt, prdnd, prup, prupd, ptdbt, & + pfd, pfu) +! -------------------------------------------------------------------------- + +! Purpose: This routine performs the vertical quadrature integration +! +! Interface: *vrtqdr_sw* is called from *spcvrt_sw* and *spcvmc_sw* +! +! Modifications. +! +! Original: H. Barker +! Revision: Integrated with rrtmg_sw, J.-J. Morcrette, ECMWF, Oct 2002 +! Revision: Reformatted for consistency with rrtmg_lw: MJIacono, AER, Jul 2006 +! +!----------------------------------------------------------------------- + +! ------- Declarations ------- + +! Input + integer, intent (in) :: ncol + integer, intent (in) :: klev ! number of model layers + integer, intent (in) :: kw(ncol) ! g-point index + + real(kind=r8), intent(in) :: pref(ncol,klev+1) ! direct beam reflectivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(in) :: prefd(ncol,klev+1) ! diffuse beam reflectivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(in) :: ptra(ncol,klev+1) ! direct beam transmissivity + ! Dimensions: (nlayers+1) + real(kind=r8), intent(in) :: ptrad(ncol,klev+1) ! diffuse beam transmissivity + ! Dimensions: (nlayers+1) + + real(kind=r8), intent(in) :: pdbt(ncol,klev+1) + ! Dimensions: (nlayers+1) + real(kind=r8), intent(in) :: ptdbt(ncol,klev+1) + ! Dimensions: (nlayers+1) + + real(kind=r8), intent(inout) :: prdnd(ncol,klev+1) + ! Dimensions: (nlayers+1) + real(kind=r8), intent(inout) :: prup(ncol,klev+1) + ! Dimensions: (nlayers+1) + real(kind=r8), intent(inout) :: prupd(ncol,klev+1) + ! Dimensions: (nlayers+1) + +! Output + real(kind=r8), intent(out) :: pfd(ncol,klev+1,ngptsw) ! downwelling flux (W/m2) + ! Dimensions: (nlayers+1,ngptsw) + ! unadjusted for earth/sun distance or zenith angle + real(kind=r8), intent(out) :: pfu(ncol,klev+1,ngptsw) ! upwelling flux (W/m2) + ! Dimensions: (nlayers+1,ngptsw) + ! unadjusted for earth/sun distance or zenith angle + +! Local + + integer :: ikp, ikx, jk + integer :: icol + real(kind=r8) :: zreflect + real(kind=r8) :: ztdn(ncol,klev+1) + +! Definitions +! +! pref(jk) direct reflectance +! prefd(jk) diffuse reflectance +! ptra(jk) direct transmittance +! ptrad(jk) diffuse transmittance +! +! pdbt(jk) layer mean direct beam transmittance +! ptdbt(jk) total direct beam transmittance at levels +! +!----------------------------------------------------------------------------- + +! Link lowest layer with surface + + do icol=1,ncol + zreflect = 1._r8 / (1._r8 - prefd(icol,klev+1) * prefd(icol,klev)) + prup(icol,klev) = pref(icol,klev) + (ptrad(icol,klev) * & + ((ptra(icol,klev) - pdbt(icol,klev)) * prefd(icol,klev+1) + & + pdbt(icol,klev) * pref(icol,klev+1))) * zreflect + prupd(icol,klev) = prefd(icol,klev) + ptrad(icol,klev) * ptrad(icol,klev) * & + prefd(icol,klev+1) * zreflect + +! Pass from bottom to top + end do + do jk = 1,klev-1 + do icol=1,ncol + ikp = klev+1-jk + ikx = ikp-1 + zreflect = 1._r8 / (1._r8 -prupd(icol,ikp) * prefd(icol,ikx)) + prup(icol,ikx) = pref(icol,ikx) + (ptrad(icol,ikx) * & + ((ptra(icol,ikx) - pdbt(icol,ikx)) * prupd(icol,ikp) + & + pdbt(icol,ikx) * prup(icol,ikp))) * zreflect + prupd(icol,ikx) = prefd(icol,ikx) + ptrad(icol,ikx) * ptrad(icol,ikx) * & + prupd(icol,ikp) * zreflect + enddo + enddo + +! Upper boundary conditions + do icol=1,ncol + ztdn(icol,1) = 1._r8 + prdnd(icol,1) = 0._r8 + ztdn(icol,2) = ptra(icol,1) + prdnd(icol,2) = prefd(icol,1) + +! Pass from top to bottom + end do + do jk = 2,klev + do icol=1,ncol + ikp = jk+1 + zreflect = 1._r8 / (1._r8 - prefd(icol,jk) * prdnd(icol,jk)) + ztdn(icol,ikp) = ptdbt(icol,jk) * ptra(icol,jk) + & + (ptrad(icol,jk) * ((ztdn(icol,jk) - ptdbt(icol,jk)) + & + ptdbt(icol,jk) * pref(icol,jk) * prdnd(icol,jk))) * zreflect + prdnd(icol,ikp) = prefd(icol,jk) + ptrad(icol,jk) * ptrad(icol,jk) * & + prdnd(icol,jk) * zreflect + enddo + end do +! Up and down-welling fluxes at levels + + do jk = 1,klev+1 + do icol=1,ncol + zreflect = 1._r8 / (1._r8 - prdnd(icol,jk) * prupd(icol,jk)) + pfu(icol,jk,kw(icol)) = (ptdbt(icol,jk) * prup(icol,jk) + & + (ztdn(icol,jk) - ptdbt(icol,jk)) * prupd(icol,jk)) * zreflect + pfd(icol,jk,kw(icol)) = ptdbt(icol,jk) + (ztdn(icol,jk) - ptdbt(icol,jk)+ & + ptdbt(icol,jk) * prup(icol,jk) * prdnd(icol,jk)) * zreflect + enddo + end do + end subroutine vrtqdr_sw + + end module rrtmg_sw_vrtqdr diff --git a/src/physics/rrtmg/cloud_rad_props.F90 b/src/physics/rrtmg/cloud_rad_props.F90 new file mode 100644 index 0000000000..b2fe8424f5 --- /dev/null +++ b/src/physics/rrtmg/cloud_rad_props.F90 @@ -0,0 +1,773 @@ +module cloud_rad_props + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag +use cam_abortutils, only: endrun +use rad_constituents, only: iceopticsfile, liqopticsfile +use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init + +use ebert_curry, only: scalefactor +use cam_logfile, only: iulog + +use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry, lininterp_finish + +implicit none +private +save + +public :: & + cloud_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + get_ice_optics_sw, & ! return Mitchell SW ice radiative properties + ice_cloud_get_rad_props_lw, & ! Mitchell LW ice rad props + get_liquid_optics_sw, & ! return Conley SW rad props + liquid_cloud_get_rad_props_lw, & ! return Conley LW rad props + snow_cloud_get_rad_props_lw, & + get_snow_optics_sw + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: i_dei, i_mu, i_lambda, i_iciwp, i_iclwp, i_des, i_icswp + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine cloud_rad_props_init() + + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + use slingo, only: slingo_rad_props_init + use ebert_curry, only: ec_rad_props_init, scalefactor + + character(len=256) :: liquidfile + character(len=256) :: icefile + character(len=256) :: locfn + + integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr + integer :: vdimids(NF90_MAX_VAR_DIMS), ndims, templen + ! liquid clouds + integer :: mudimid, lambdadimid + integer :: mu_id, lambda_id, ext_sw_liq_id, ssa_sw_liq_id, asm_sw_liq_id, abs_lw_liq_id + + ! ice clouds + integer :: d_dimid ! diameters + integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id + + integer :: err + + liquidfile = liqopticsfile + icefile = iceopticsfile + + call slingo_rad_props_init + call ec_rad_props_init + call oldcloud_init + + i_dei = pbuf_get_index('DEI',errcode=err) + i_mu = pbuf_get_index('MU',errcode=err) + i_lambda = pbuf_get_index('LAMBDAC',errcode=err) + i_iciwp = pbuf_get_index('ICIWP',errcode=err) + i_iclwp = pbuf_get_index('ICLWP',errcode=err) + i_des = pbuf_get_index('DES',errcode=err) + i_icswp = pbuf_get_index('ICSWP',errcode=err) + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + ! read liquid cloud optics + if(masterproc) then + call getfil( trim(liquidfile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'liquid optics file missing') + write(iulog,*)' reading liquid cloud optics from file ',locfn + + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') + call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') + + call handle_ncerr(nf90_inq_dimid( ncid, 'lambda_scale', lambdadimid), 'getting lambda dim') + call handle_ncerr(nf90_inquire_dimension( ncid, lambdadimid, len=nlambda), 'getting n lambda samples') + endif ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(nmu, 1, mpiint, 0, mpicom, ierr) + call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) +#endif + + allocate(g_mu(nmu)) + allocate(g_lambda(nmu,nlambda)) + allocate(ext_sw_liq(nmu,nlambda,nswbands) ) + allocate(ssa_sw_liq(nmu,nlambda,nswbands)) + allocate(asm_sw_liq(nmu,nlambda,nswbands)) + allocate(abs_lw_liq(nmu,nlambda,nlwbands)) + + if(masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& + 'cloud optics mu get') + call handle_ncerr( nf90_get_var(ncid, mu_id, g_mu),& + 'read cloud optics mu values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lambda', lambda_id),& + 'cloud optics lambda get') + call handle_ncerr( nf90_get_var(ncid, lambda_id, g_lambda),& + 'read cloud optics lambda values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_ext_sw', ext_sw_liq_id),& + 'cloud optics ext_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ext_sw_liq_id, ext_sw_liq),& + 'read cloud optics ext_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'ssa_sw', ssa_sw_liq_id),& + 'cloud optics ssa_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_liq_id, ssa_sw_liq),& + 'read cloud optics ssa_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'asm_sw', asm_sw_liq_id),& + 'cloud optics asm_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_liq_id, asm_sw_liq),& + 'read cloud optics asm_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_abs_lw', abs_lw_liq_id),& + 'cloud optics abs_lw_liq get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_liq_id, abs_lw_liq),& + 'read cloud optics abs_lw_liq values') + + call handle_ncerr( nf90_close(ncid), 'liquid optics file missing') + endif ! if masterproc + +#if ( defined SPMD ) + call mpibcast(g_mu, nmu, mpir8, 0, mpicom, ierr) + call mpibcast(g_lambda, nmu*nlambda, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) +#endif + ! I forgot to convert kext from m^2/Volume to m^2/Kg + ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 + abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 + + ! read ice cloud optics + if(masterproc) then + call getfil( trim(icefile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'ice optics file missing') + write(iulog,*)' reading ice cloud optics from file ',locfn + + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') + call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') + + endif ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(n_g_d, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nswbands, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) +#endif + + allocate(g_d_eff(n_g_d)) + allocate(ext_sw_ice(n_g_d,nswbands)) + allocate(ssa_sw_ice(n_g_d,nswbands)) + allocate(asm_sw_ice(n_g_d,nswbands)) + allocate(abs_lw_ice(n_g_d,nlwbands)) + + if(masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& + 'cloud optics deff get') + call handle_ncerr( nf90_get_var(ncid, d_id, g_d_eff),& + 'read cloud optics deff values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ext', ext_sw_ice_id),& + 'cloud optics ext_sw_ice get') + call handle_ncerr(nf90_inquire_variable ( ncid, ext_sw_ice_id, ndims=ndims, dimids=vdimids),& + 'checking dimensions of ext_sw_ice') + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(1), len=templen),& + 'getting first dimension sw_ext') + !write(iulog,*) 'expected length',n_g_d,'actual len',templen + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(2), len=templen),& + 'getting first dimension sw_ext') + !write(iulog,*) 'expected length',nswbands,'actual len',templen + call handle_ncerr( nf90_get_var(ncid, ext_sw_ice_id, ext_sw_ice),& + 'read cloud optics ext_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ssa', ssa_sw_ice_id),& + 'cloud optics ssa_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_ice_id, ssa_sw_ice),& + 'read cloud optics ssa_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_asm', asm_sw_ice_id),& + 'cloud optics asm_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_ice_id, asm_sw_ice),& + 'read cloud optics asm_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lw_abs', abs_lw_ice_id),& + 'cloud optics abs_lw_ice get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_ice_id, abs_lw_ice),& + 'read cloud optics abs_lw_ice values') + + call handle_ncerr( nf90_close(ncid), 'ice optics file missing') + + endif ! if masterproc +#if ( defined SPMD ) + call mpibcast(g_d_eff, n_g_d, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_ice, n_g_d*nlwbands, mpir8, 0, mpicom, ierr) +#endif + + return + +end subroutine cloud_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex, oldliq, oldice) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + logical, optional, intent(in) :: oldliq,oldice + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + ! optical props for each aerosol + real(r8), pointer :: h_ext(:,:) + real(r8), pointer :: h_ssa(:,:) + real(r8), pointer :: h_asm(:,:) + real(r8), pointer :: n_ext(:) + real(r8), pointer :: n_ssa(:) + real(r8), pointer :: n_asm(:) + + ! rad properties for liquid clouds + real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + ! rad properties for ice clouds + real(r8) :: ice_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! initialize to conditions that would cause failure + tau (:,:,:) = -100._r8 + tau_w (:,:,:) = -100._r8 + tau_w_g (:,:,:) = -100._r8 + tau_w_f (:,:,:) = -100._r8 + + ! initialize layers to accumulate od's + tau (:,1:ncol,:) = 0._r8 + tau_w (:,1:ncol,:) = 0._r8 + tau_w_g(:,1:ncol,:) = 0._r8 + tau_w_f(:,1:ncol,:) = 0._r8 + + + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) + + call get_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) + + tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) + tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) + tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) + tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer:: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + ! rad properties for liquid clouds + real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth + + ! rad properties for ice clouds + real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + if(present(oldcloud))then + if(oldcloud) then + ! make diagnostic calls to these first to output ice and liq OD's + !call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) + !call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) + ! This affects climate (cld_abs_od) + call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) + return + endif + endif + + if(present(oldliq))then + if(oldliq) then + call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + + if(present(oldice))then + if(oldice) then + call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== + +subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_snow_optics_sw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_ice_optics_sw + +!============================================================================== + +subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + type(interp_type) :: dei_wgts + + integer :: i, k, swband + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + do k = 1,pver + do i = 1,ncol + if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + ! if ice water path is too small, OD := 0 + tau (:,i,k) = 0._r8 + tau_w (:,i,k) = 0._r8 + tau_w_g(:,i,k) = 0._r8 + tau_w_f(:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do swband = 1, nswbands + call lininterp(ext_sw_ice(:,swband), n_g_d, & + ext(swband:swband), 1, dei_wgts) + call lininterp(ssa_sw_ice(:,swband), n_g_d, & + ssa(swband:swband), 1, dei_wgts) + call lininterp(asm_sw_ice(:,swband), n_g_d, & + asm(swband:swband), 1, dei_wgts) + end do + tau (:,i,k) = iciwpth(i,k) * ext + tau_w (:,i,k) = tau(:,i,k) * ssa + tau_w_g(:,i,k) = tau_w(:,i,k) * asm + tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_sw + +!============================================================================== + +subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + real(r8), dimension(pcols,pver) :: kext + integer i,k,swband,lchnk,ncol + + lchnk = state%lchnk + ncol = state%ncol + + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud + call gam_liquid_sw(iclwpth(i,k), lamc(i,k), pgam(i,k), & + tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k)) + else + tau(1:nswbands,i,k) = 0._r8 + tau_w(1:nswbands,i,k) = 0._r8 + tau_w_g(1:nswbands,i,k) = 0._r8 + tau_w_f(1:nswbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine get_liquid_optics_sw + +!============================================================================== + +subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + integer :: lchnk, ncol + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + + integer lwband, i, k + + abs_od = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(iclwpth(i,k), lamc(i,k), pgam(i,k), abs_od(1:nlwbands,i,k)) + else + abs_od(1:nlwbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine liquid_cloud_get_rad_props_lw +!============================================================================== + +subroutine snow_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_lw(state%ncol,icswpth, des, abs_od) + +end subroutine snow_cloud_get_rad_props_lw + +!============================================================================== + +subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_lw(state%ncol,iciwpth, dei, abs_od) + +end subroutine ice_cloud_get_rad_props_lw + +!============================================================================== + +subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: abs_od(nlwbands,pcols,pver) + + type(interp_type) :: dei_wgts + + integer :: i, k, lwband + real(r8) :: absor(nlwbands) + + do k = 1,pver + do i = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + abs_od (:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,i,k) = iciwpth(i,k) * absor + where(abs_od(:,i,k) > 50.0_r8) abs_od(:,i,k) = 50.0_r8 + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_lw + +!============================================================================== + +subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: abs_od(1:nlwbands) + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < 1.e-80_r8) then + abs_od = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_lw + +!============================================================================== + +subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: tau(1:nswbands), tau_w(1:nswbands), tau_w_f(1:nswbands), tau_w_g(1:nswbands) + + integer :: swband ! sw band index + + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < 1.e-80_r8) then + tau = 0._r8 + tau_w = 0._r8 + tau_w_g = 0._r8 + tau_w_f = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do swband = 1, nswbands + call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & + ext(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & + ssa(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & + asm(swband:swband), 1, mu_wgts, lambda_wgts) + enddo + + ! compute radiative properties + tau = clwptn * ext + tau_w = tau * ssa + tau_w_g = tau_w * asm + tau_w_f = tau_w_g * asm + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_sw + +!============================================================================== + +subroutine get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts + type(interp_type), intent(out) :: lambda_wgts + + integer :: ilambda + real(r8) :: g_lambda_interp(nlambda) + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights + +!============================================================================== + +end module cloud_rad_props diff --git a/src/physics/rrtmg/ebert_curry.F90 b/src/physics/rrtmg/ebert_curry.F90 new file mode 100644 index 0000000000..5f6ed35518 --- /dev/null +++ b/src/physics/rrtmg/ebert_curry.F90 @@ -0,0 +1,408 @@ +module ebert_curry + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld + +implicit none +private +save + +public :: & + ec_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + ec_ice_optics_sw, & + ec_ice_get_rad_props_lw + + +real, public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: dei_idx = 0 + integer :: mu_idx = 0 + integer :: lambda_idx = 0 + integer :: iciwp_idx = 0 + integer :: iclwp_idx = 0 + integer :: cld_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine ec_rad_props_init() + +! use cam_history, only: addfld + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use cam_logfile, only: iulog + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') + !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') + !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') + + !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') + !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') + + !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') + !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') + + return + +end subroutine ec_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex, oldliq, oldice) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + logical, optional, intent(in) :: oldliq,oldice + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! initialize to conditions that would cause failure + tau (:,:,:) = -100._r8 + tau_w (:,:,:) = -100._r8 + tau_w_g (:,:,:) = -100._r8 + tau_w_f (:,:,:) = -100._r8 + + ! initialize layers to accumulate od's + tau (:,1:ncol,:) = 0._r8 + tau_w (:,1:ncol,:) = 0._r8 + tau_w_g(:,1:ncol,:) = 0._r8 + tau_w_f(:,1:ncol,:) = 0._r8 + + + call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) +! call outfld ('CI_OD_SW_OLD', ice_tau(idx_sw_diag,:,:), pcols, lchnk) + + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) + !call outfld('CI_OD_LW_OLD', ice_tau_abs_od(idx_lw_diag ,:,:), pcols, lchnk) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldicewp + + real(r8), pointer, dimension(:,:) :: rei + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cicewp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + ! + ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) + real(r8) :: abari(4) = & ! a coefficient for extinction optical depth + (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth + (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8) :: cbari(4) = & ! c coefficient for single scat albedo + (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8) :: dbari(4) = & ! d coefficient for single scat albedo + (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter + (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter + (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + integer :: ns, i, k, indxsl, lchnk, Nday + integer :: itim_old + real(r8) :: tmp1i, tmp2i, tmp3i, g + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rei_idx,rei) + + if(oldicewp) then + do k=1,pver + do i = 1,Nday + cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iciwp_idx<=0) then + call endrun('ec_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') + endif + call pbuf_get_field(pbuf, iciwp_idx, tmpptr) + cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr(1:pcols,1:pver) + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + abarii = abari(indxsl) + bbarii = bbari(indxsl) + cbarii = cbari(indxsl) + dbarii = dbari(indxsl) + ebarii = ebari(indxsl) + fbarii = fbari(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) + ice_tau(ns,i,k) = cicewp(i,k)*tmp1i + else + ice_tau(ns,i,k) = 0.0_r8 + endif + + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) + g = ebarii + tmp3i + ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g + ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine ec_ice_optics_sw +!============================================================================== + +subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('ec_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + !if(oldicewp) then + ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) + !else + ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) + !endif + !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) + +end subroutine ec_ice_get_rad_props_lw +!============================================================================== + +end module ebert_curry diff --git a/src/physics/rrtmg/oldcloud.F90 b/src/physics/rrtmg/oldcloud.F90 new file mode 100644 index 0000000000..2675a5c3f9 --- /dev/null +++ b/src/physics/rrtmg/oldcloud.F90 @@ -0,0 +1,643 @@ +module oldcloud + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld +use rad_constituents, only: iceopticsfile, liqopticsfile +use ebert_curry, only: scalefactor + +implicit none +private +save + +public :: & + oldcloud_init, oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: iciwp_idx = 0 + integer :: iclwp_idx = 0 + integer :: cld_idx = 0 + integer :: rel_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine oldcloud_init() + + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + return + +end subroutine oldcloud_init + +!============================================================================== +! Private methods +!============================================================================== + +subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldliqwp + + real(r8), pointer, dimension(:,:) :: rel + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cliqwp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + ! A. Slingo's data for cloud particle radiative properties (from 'A GCM + ! Parameterization for the Shortwave Properties of Water Clouds' JAS + ! vol. 46 may 1989 pp 1419-1427) + real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth + (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth + (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo + (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo + (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter + (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter + (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band + + ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor + ! greater than 20 micro-meters + + integer :: ns, i, k, indxsl, Nday + integer :: lchnk, itim_old + real(r8) :: tmp1l, tmp2l, tmp3l, g + real(r8) :: kext(pcols,pver) + real(r8), pointer, dimension(:,:) :: iclwpth + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rel_idx,rel) + + if (oldliqwp) then + do k=1,pver + do i = 1,Nday + cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iclwp_idx<0) then + call endrun('old_liquid_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') + endif + ! The following is the eventual target specification for in cloud liquid water path. + call pbuf_get_field(pbuf, iclwp_idx, tmpptr) + cliqwp = tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmin(ns) > 2.38_r8) then + indxsl = 4 + end if + + ! Set cloud extinction optical depth, single scatter albedo, + ! asymmetry parameter, and forward scattered fraction: + abarli = abarl(indxsl) + bbarli = bbarl(indxsl) + cbarli = cbarl(indxsl) + dbarli = dbarl(indxsl) + ebarli = ebarl(indxsl) + fbarli = fbarl(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l + else + liq_tau(ns,i,k) = 0.0_r8 + endif + + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) + g = ebarli + tmp3l + liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g + liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + + !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) + !call outfld('REL_OLD',rel(:,:), pcols, lchnk) + !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) + !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) + + +end subroutine old_liquid_optics_sw +!============================================================================== + +subroutine old_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldicewp + + real(r8), pointer, dimension(:,:) :: rei + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cicewp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + ! + ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) + real(r8) :: abari(4) = & ! a coefficient for extinction optical depth + (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth + (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8) :: cbari(4) = & ! c coefficient for single scat albedo + (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8) :: dbari(4) = & ! d coefficient for single scat albedo + (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter + (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter + (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + integer :: ns, i, k, indxsl, lchnk, Nday + integer :: itim_old + real(r8) :: tmp1i, tmp2i, tmp3i, g + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rei_idx,rei) + + if(oldicewp) then + do k=1,pver + do i = 1,Nday + cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iciwp_idx<=0) then + call endrun('old_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') + endif + call pbuf_get_field(pbuf, iciwp_idx, tmpptr) + cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmin(ns) > 2.38_r8) then + indxsl = 4 + end if + + abarii = abari(indxsl) + bbarii = bbari(indxsl) + cbarii = cbari(indxsl) + dbarii = dbari(indxsl) + ebarii = ebari(indxsl) + fbarii = fbari(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) + ice_tau(ns,i,k) = cicewp(i,k)*tmp1i + else + ice_tau(ns,i,k) = 0.0_r8 + endif + + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) + g = ebarii + tmp3i + ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g + ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine old_ice_optics_sw +!============================================================================== + +subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) + use physconst, only: gravit + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + logical,intent(in) :: oldwp ! use old definition of waterpath + + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('oldcloud_lw: oldwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + cld_abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine oldcloud_lw + +!============================================================================== +subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + +end subroutine old_liq_get_rad_props_lw +!============================================================================== + +subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + use physconst, only: gravit + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + !if(oldicewp) then + ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) + !else + ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) + !endif + !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) + +end subroutine old_ice_get_rad_props_lw +!============================================================================== + +subroutine cloud_total_vis_diag_out(lchnk, nnite, idxnite, tau, radsuffix) + + ! output total aerosol optical depth for the visible band + + use cam_history, only: outfld + use cam_history_support, only : fillvalue + + integer, intent(in) :: lchnk + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(nnite) ! local column indices of night columns + real(r8), intent(in) :: tau(:,:) + character(len=*), intent(in) :: radsuffix ! identifies whether the radiation call + ! is for the climate calc or a diagnostic calc + + ! Local variables + integer :: i + real(r8) :: tmp(pcols) + !----------------------------------------------------------------------------- + + ! compute total aerosol optical depth output where only daylight columns + tmp(:) = sum(tau(:,:), 2) + do i = 1, nnite + tmp(idxnite(i)) = fillvalue + end do + !call outfld('cloudOD_v'//trim(radsuffix), tmp, pcols, lchnk) + +end subroutine cloud_total_vis_diag_out + +!============================================================================== + +end module oldcloud diff --git a/src/physics/rrtmg/rad_solar_var.F90 b/src/physics/rrtmg/rad_solar_var.F90 new file mode 100644 index 0000000000..6c09f05cba --- /dev/null +++ b/src/physics/rrtmg/rad_solar_var.F90 @@ -0,0 +1,152 @@ +!------------------------------------------------------------------------------- +! This module uses the Lean solar irradiance data to provide a solar cycle +! scaling factor used in heating rate calculations +!------------------------------------------------------------------------------- +module rad_solar_var + + use shr_kind_mod , only : r8 => shr_kind_r8 + use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi + use solar_irrad_data, only : do_spctrl_scaling + use cam_abortutils, only : endrun + + implicit none + save + + private + public :: rad_solar_var_init + public :: get_variability + + real(r8), allocatable :: ref_band_irrad(:) ! scaling will be relative to ref_band_irrad in each band + real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + real(r8) :: tsi_ref ! total solar irradiance assumed by rrtmg + + real(r8), allocatable :: radbinmax(:) + real(r8), allocatable :: radbinmin(:) + integer :: nradbins +contains + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine rad_solar_var_init( ) + use radconstants, only : get_number_sw_bands + use radconstants, only : get_sw_spectral_boundaries + use radconstants, only : get_ref_solar_band_irrad + use radconstants, only : get_ref_total_solar_irrad + + integer :: i + integer :: ierr + integer :: yr, mon, tod + integer :: radmax_loc + + + call get_number_sw_bands(nradbins) + + if ( do_spctrl_scaling ) then + + if ( .not.has_spectrum ) then + call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') + endif + + allocate (radbinmax(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmax') + end if + + allocate (radbinmin(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmin') + end if + + allocate (ref_band_irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for ref_band_irrad') + end if + + allocate (irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for irrad') + end if + + call get_sw_spectral_boundaries(radbinmin, radbinmax, 'nm') + + ! Make sure that the far-IR is included, even if RRTMG does not + ! extend that far down. 10^5 nm corresponds to a wavenumber of + ! 100 cm^-1. + radmax_loc = maxloc(radbinmax,1) + radbinmax(radmax_loc) = max(100000._r8,radbinmax(radmax_loc)) + + ! for rrtmg, reference spectrum from rrtmg + call get_ref_solar_band_irrad( ref_band_irrad ) + + else + + call get_ref_total_solar_irrad(tsi_ref) + + endif + + endsubroutine rad_solar_var_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine get_variability( sfac ) + + real(r8), intent(out) :: sfac(nradbins) ! scaling factors for CAM heating + + integer :: yr, mon, day, tod + + if ( do_spctrl_scaling ) then + + call integrate_spectrum( nbins, nradbins, we, radbinmin, radbinmax, sol_irrad, irrad) + + sfac(:nradbins) = irrad(:nradbins)/ref_band_irrad(:nradbins) + + else + + sfac(:nradbins) = sol_tsi/tsi_ref + + endif + + endsubroutine get_variability + +!------------------------------------------------------------------------------- +! private method......... +!------------------------------------------------------------------------------- + + subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) + + use mo_util, only : rebin + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: max_trg(ntrg) ! target coordinates + real(r8), intent(in) :: min_trg(ntrg) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + real(r8) :: trg_x(2), targ(1) ! target coordinates + integer :: i + + do i = 1, ntrg + + trg_x(1) = min_trg(i) + trg_x(2) = max_trg(i) + + call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) + ! W/m2/nm --> W/m2 + trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) + + enddo + + + end subroutine integrate_spectrum + +endmodule rad_solar_var diff --git a/src/physics/rrtmg/radconstants.F90 b/src/physics/rrtmg/radconstants.F90 new file mode 100644 index 0000000000..f4f8c76b9c --- /dev/null +++ b/src/physics/rrtmg/radconstants.F90 @@ -0,0 +1,255 @@ +module radconstants + +! This module contains constants that are specific to the radiative transfer +! code used in the RRTMG model. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +implicit none +private +save + +! SHORTWAVE DATA + +! number of shorwave spectral intervals +integer, parameter, public :: nswbands = 14 +integer, parameter, public :: nbndsw = 14 + +! Wavenumbers of band boundaries +! +! Note: Currently rad_solar_var extends the lowest band down to +! 100 cm^-1 if it is too high to cover the far-IR. Any changes meant +! to affect IR solar variability should take note of this. + +real(r8),parameter :: wavenum_low(nbndsw) = & ! in cm^-1 + (/2600._r8, 3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, & + 8050._r8,12850._r8,16000._r8,22650._r8,29000._r8,38000._r8, 820._r8/) +real(r8),parameter :: wavenum_high(nbndsw) = & ! in cm^-1 + (/3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, 8050._r8, & + 12850._r8,16000._r8,22650._r8,29000._r8,38000._r8,50000._r8, 2600._r8/) + +! Solar irradiance at 1 A.U. in W/m^2 assumed by radiation code +! Rescaled so that sum is precisely 1368.22 and fractional amounts sum to 1.0 +real(r8), parameter :: solar_ref_band_irradiance(nbndsw) = & + (/ & + 12.11_r8, 20.3600000000001_r8, 23.73_r8, & + 22.43_r8, 55.63_r8, 102.93_r8, 24.29_r8, & + 345.74_r8, 218.19_r8, 347.20_r8, & + 129.49_r8, 50.15_r8, 3.08_r8, 12.89_r8 & + /) + +! None of the following comment appears to be the case any more? This +! should be reevalutated and/or removed. + +! rrtmg (coarse) reference solar flux in rrtmg is initialized as the following +! reference data inside rrtmg seems to indicate 1366.44 instead +! This data references 1366.442114152342 +!real(r8), parameter :: solar_ref_band_irradiance(nbndsw) = & +! (/ & +! 12.10956827000000_r8, 20.36508467999999_r8, 23.72973826333333_r8, & +! 22.42769644333333_r8, 55.62661262000000_r8, 102.9314315544444_r8, 24.29361887666667_r8, & +! 345.7425138000000_r8, 218.1870300666667_r8, 347.1923147000001_r8, & +! 129.4950181200000_r8, 48.37217043000000_r8, 3.079938997898001_r8, 12.88937733000000_r8 & +! /) +! Kurucz (fine) reference would seem to imply the following but the above values are from rrtmg_sw_init +! (/12.109559, 20.365097, 23.729752, 22.427697, 55.626622, 102.93142, 24.293593, & +! 345.73655, 218.18416, 347.18406, 129.49407, 50.147238, 3.1197130, 12.793834 /) + +! These are indices to the band for diagnostic output +integer, parameter, public :: idx_sw_diag = 10 ! index to sw visible band +integer, parameter, public :: idx_nir_diag = 8 ! index to sw near infrared (778-1240 nm) band +integer, parameter, public :: idx_uv_diag = 11 ! index to sw uv (345-441 nm) band + +integer, parameter, public :: rrtmg_sw_cloudsim_band = 9 ! rrtmg band for .67 micron + +! Number of evenly spaced intervals in rh +! The globality of this mesh may not be necessary +! Perhaps it could be specific to the aerosol +! But it is difficult to see how refined it must be +! for lookup. This value was found to be sufficient +! for Sulfate and probably necessary to resolve the +! high variation near rh = 1. Alternative methods +! were found to be too slow. +! Optimal approach would be for cam to specify size of aerosol +! based on each aerosol's characteristics. Radiation +! should know nothing about hygroscopic growth! +integer, parameter, public :: nrh = 1000 + +! LONGWAVE DATA + +! These are indices to the band for diagnostic output +integer, parameter, public :: idx_lw_diag = 7 ! index to (H20 window) LW band + +integer, parameter, public :: rrtmg_lw_cloudsim_band = 6 ! rrtmg band for 10.5 micron + +! number of lw bands +integer, parameter, public :: nlwbands = 16 +integer, parameter, public :: nbndlw = 16 + +real(r8), parameter :: wavenumber1_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) + (/ 10._r8, 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, & + 1180._r8, 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2390._r8, 2600._r8 /) + +real(r8), parameter :: wavenumber2_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) + (/ 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, 1180._r8, & + 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2390._r8, 2600._r8, 3250._r8 /) + +!These can go away when old camrt disappears +! Index of volc. abs., H2O non-window +integer, public, parameter :: idx_LW_H2O_NONWND=1 +! Index of volc. abs., H2O window +integer, public, parameter :: idx_LW_H2O_WINDOW=2 +! Index of volc. cnt. abs. 0500--0650 cm-1 +integer, public, parameter :: idx_LW_0500_0650=3 +! Index of volc. cnt. abs. 0650--0800 cm-1 +integer, public, parameter :: idx_LW_0650_0800=4 +! Index of volc. cnt. abs. 0800--1000 cm-1 +integer, public, parameter :: idx_LW_0800_1000=5 +! Index of volc. cnt. abs. 1000--1200 cm-1 +integer, public, parameter :: idx_LW_1000_1200=6 +! Index of volc. cnt. abs. 1200--2000 cm-1 +integer, public, parameter :: idx_LW_1200_2000=7 + +! GASES TREATED BY RADIATION (line spectrae) + +! gasses required by radiation +integer, public, parameter :: gasnamelength = 5 +integer, public, parameter :: nradgas = 8 +character(len=gasnamelength), public, parameter :: gaslist(nradgas) & + = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + +! what is the minimum mass mixing ratio that can be supported by radiation implementation? +real(r8), public, parameter :: minmmr(nradgas) & + = epsilon(1._r8) + +! Length of "optics type" string specified in optics files. +integer, parameter, public :: ot_length = 32 + +public :: rad_gas_index + +public :: get_number_sw_bands, & + get_sw_spectral_boundaries, & + get_lw_spectral_boundaries, & + get_ref_solar_band_irrad, & + get_ref_total_solar_irrad, & + get_solar_band_fraction_irrad + +contains +!------------------------------------------------------------------------------ +subroutine get_solar_band_fraction_irrad(fractional_irradiance) + ! provide Solar Irradiance for each band in RRTMG + + ! fraction of solar irradiance in each band + real(r8), intent(out) :: fractional_irradiance(1:nswbands) + real(r8) :: tsi ! total solar irradiance + + tsi = sum(solar_ref_band_irradiance) + fractional_irradiance = solar_ref_band_irradiance / tsi + +end subroutine get_solar_band_fraction_irrad +!------------------------------------------------------------------------------ +subroutine get_ref_total_solar_irrad(tsi) + ! provide Total Solar Irradiance assumed by RRTMG + + real(r8), intent(out) :: tsi + + tsi = sum(solar_ref_band_irradiance) + +end subroutine get_ref_total_solar_irrad +!------------------------------------------------------------------------------ +subroutine get_ref_solar_band_irrad( band_irrad ) + + ! solar irradiance in each band (W/m^2) + real(r8), intent(out) :: band_irrad(nswbands) + + band_irrad = solar_ref_band_irradiance + +end subroutine get_ref_solar_band_irrad +!------------------------------------------------------------------------------ +subroutine get_number_sw_bands(number_of_bands) + + ! number of solar (shortwave) bands in the rrtmg code + integer, intent(out) :: number_of_bands + + number_of_bands = nswbands + +end subroutine get_number_sw_bands + +!------------------------------------------------------------------------------ +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each longwave band + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber1_longwave + high_boundaries = wavenumber2_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber2_longwave + high_boundaries = 1.e-2_r8/wavenumber1_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber2_longwave + high_boundaries = 1.e7_r8/wavenumber1_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber2_longwave + high_boundaries = 1.e4_r8/wavenumber1_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber2_longwave + high_boundaries = 1._r8/wavenumber1_longwave + case default + call endrun('get_lw_spectral_boundaries: spectral units not acceptable'//units) + end select + +end subroutine get_lw_spectral_boundaries + +!------------------------------------------------------------------------------ +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each shortwave band + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenum_low + high_boundaries = wavenum_high + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenum_high + high_boundaries = 1.e-2_r8/wavenum_low + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenum_high + high_boundaries = 1.e7_r8/wavenum_low + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenum_high + high_boundaries = 1.e4_r8/wavenum_low + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenum_high + high_boundaries = 1._r8/wavenum_low + case default + call endrun('rad_constants.F90: spectral units not acceptable'//units) + end select + +end subroutine get_sw_spectral_boundaries + +!------------------------------------------------------------------------------ +integer function rad_gas_index(gasname) + + ! return the index in the gaslist array of the specified gasname + + character(len=*),intent(in) :: gasname + integer :: igas + + rad_gas_index = -1 + do igas = 1, nradgas + if (trim(gaslist(igas)).eq.trim(gasname)) then + rad_gas_index = igas + return + endif + enddo + call endrun ("rad_gas_index: can not find gas with name "//gasname) +end function rad_gas_index + +end module radconstants diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 new file mode 100644 index 0000000000..0015a0f304 --- /dev/null +++ b/src/physics/rrtmg/radiation.F90 @@ -0,0 +1,1403 @@ +module radiation + +!--------------------------------------------------------------------------------- +! +! CAM interface to RRTMG radiation parameterization +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use physics_types, only: physics_state, physics_ptend +use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx +use camsrfexch, only: cam_out_t, cam_in_t +use physconst, only: cappa, cpair + +use time_manager, only: get_nstep, is_first_restart_step, & + get_curr_calday, get_step_size + +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_info, & + rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & + liqcldoptics, icecldoptics + +use radconstants, only: nswbands, nlwbands, rrtmg_sw_cloudsim_band, rrtmg_lw_cloudsim_band, & + idx_sw_diag + +use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & + cospsimulator_intr_run, cosp_nradsteps + +use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs + +use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active +use cam_history_support, only: fillvalue + +use pio, only: file_desc_t, var_desc_t, & + pio_int, pio_noerr, & + pio_seterrorhandling, pio_bcast_error, & + pio_inq_varid, pio_def_var, & + pio_put_var, pio_get_var + +use cam_abortutils, only: endrun +use error_messages, only: handle_err +use perf_mod, only: t_startf, t_stopf +use cam_logfile, only: iulog + +implicit none +private +save + +public :: & + radiation_readnl, &! read namelist variables + radiation_register, &! registers radiation physics buffer fields + radiation_nextsw_cday, &! calendar day of next radiation calculation + radiation_do, &! query which radiation calcs are done this timestep + radiation_init, &! initialization + radiation_define_restart, &! define variables for restart + radiation_write_restart, &! write variables to restart + radiation_read_restart, &! read variables from restart + radiation_tend, &! compute heating rates and fluxes + rad_out_t ! type for diagnostic outputs + +integer,public, allocatable :: cosp_cnt(:) ! counter for cosp +integer,public :: cosp_cnt_init = 0 !initial value for cosp counter + +type rad_out_t + real(r8) :: solin(pcols) ! Solar incident flux + + real(r8) :: qrsc(pcols,pver) + + real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux + real(r8) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8) :: fsntoac(pcols) ! Clear sky net solar flux at TOA + real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA + + real(r8) :: fsnirt(pcols) ! Near-IR flux absorbed at toa + real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns + + real(r8) :: fsn200(pcols) ! fns interpolated to 200 mb + real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb + real(r8) :: fsnr(pcols) ! fns interpolated to tropopause + + real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux + real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + + real(r8) :: qrlc(pcols,pver) + + real(r8) :: flntc(pcols) ! Clear sky lw flux at model top + real(r8) :: flut(pcols) ! Upward flux at top of model + real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model + real(r8) :: lwcf(pcols) ! longwave cloud forcing + + real(r8) :: fln200(pcols) ! net longwave flux interpolated to 200 mb + real(r8) :: fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb + real(r8) :: flnr(pcols) ! net longwave flux interpolated to tropopause + + real(r8) :: flnsc(pcols) ! Clear sky lw flux at srf (up-down) + real(r8) :: fldsc(pcols) ! Clear sky lw flux at srf (down) + + real(r8) :: tot_cld_vistau(pcols,pver) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: tot_icld_vistau(pcols,pver) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth for output on history files + + real(r8) :: cld_tau_cloudsim(pcols,pver) + real(r8) :: aer_tau400(pcols,0:pver) + real(r8) :: aer_tau550(pcols,0:pver) + real(r8) :: aer_tau700(pcols,0:pver) + +end type rad_out_t + +! Namelist variables + +integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive) + ! or hours (negative). +integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive) + ! or hours (negative). + +integer :: irad_always = 0 ! Specifies length of time in timesteps (positive) + ! or hours (negative) SW/LW radiation will be + ! run continuously from the start of an + ! initial or restart run +logical :: use_rad_dt_cosz = .false. ! if true, use radiation dt for all cosz calculations +logical :: spectralflux = .false. ! calculate fluxes (up and down) per band. + +! Physics buffer indices +integer :: qrs_idx = 0 +integer :: qrl_idx = 0 +integer :: su_idx = 0 +integer :: sd_idx = 0 +integer :: lu_idx = 0 +integer :: ld_idx = 0 +integer :: fsds_idx = 0 +integer :: fsns_idx = 0 +integer :: fsnt_idx = 0 +integer :: flns_idx = 0 +integer :: flnt_idx = 0 +integer :: cldfsnow_idx = 0 +integer :: cld_idx = 0 + +character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +! averaging time interval for zenith angle +real(r8) :: dt_avg = 0._r8 + +! PIO descriptors (for restarts) +type(var_desc_t) :: cospcnt_desc + +!=============================================================================== +contains +!=============================================================================== + +subroutine radiation_readnl(nlfile) + + ! Read radiation_nl namelist group. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + integer :: dtime ! timestep size + character(len=*), parameter :: sub = 'radiation_readnl' + + namelist /radiation_nl/ iradsw, iradlw, irad_always, & + use_rad_dt_cosz, spectralflux + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'radiation_nl', status=ierr) + if (ierr == 0) then + read(unitn, radiation_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradsw") + call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradlw") + call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: irad_always") + call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") + call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux") + + ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary + dtime = get_step_size() + if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) + if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) + if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) + + !----------------------------------------------------------------------- + ! Print runtime options to log. + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'RRTMG radiation scheme parameters:' + write(iulog,10) iradsw, iradlw, irad_always, use_rad_dt_cosz, spectralflux + end if + +10 format(' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & + ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & + ' SW/LW calc done every timestep for first N steps. N=',i5/, & + ' Use average zenith angle: ',l5/, & + ' Output spectrally resolved fluxes: ',l5/) + +end subroutine radiation_readnl + +!================================================================================================ + +subroutine radiation_register + + ! Register radiation fields in the physics buffer + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use radiation_data, only: rad_data_register + + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate + call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate + + call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux + call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux + call pbuf_add_field('FSNT' , 'global',dtype_r8,(/pcols/), fsnt_idx) ! Top-of-model net shortwave flux + + call pbuf_add_field('FLNS' , 'global',dtype_r8,(/pcols/), flns_idx) ! Surface net longwave flux + call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux + + ! If the namelist has been configured for preserving the spectral fluxes, then create + ! physics buffer variables to store the results. + if (spectralflux) then + call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band) + call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band) + call pbuf_add_field('LU' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), lu_idx) ! longwave upward flux (per band) + call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band) + end if + + call rad_data_register() + +end subroutine radiation_register + +!================================================================================================ + +function radiation_do(op, timestep) + + ! Return true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in), optional:: timestep + logical :: radiation_do ! return value + + ! Local variables + integer :: nstep ! current timestep number + !----------------------------------------------------------------------- + + if (present(timestep)) then + nstep = timestep + else + nstep = get_nstep() + end if + + select case (op) + + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradsw == 1 & + .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradlw == 1 & + .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + + case default + call endrun('radiation_do: unknown operation:'//op) + + end select +end function radiation_do + +!================================================================================================ + +real(r8) function radiation_nextsw_cday() + + ! Return calendar day of next sw radiation calculation + + ! Local variables + integer :: nstep ! timestep counter + logical :: dosw ! true => do shosrtwave calc + integer :: offset ! offset for calendar day calculation + integer :: dTime ! integer timestep size + real(r8):: calday ! calendar day of + !----------------------------------------------------------------------- + + radiation_nextsw_cday = -1._r8 + dosw = .false. + nstep = get_nstep() + dtime = get_step_size() + offset = 0 + do while (.not. dosw) + nstep = nstep + 1 + offset = offset + dtime + if (radiation_do('sw', nstep)) then + radiation_nextsw_cday = get_curr_calday(offset=offset) + dosw = .true. + end if + end do + if(radiation_nextsw_cday == -1._r8) then + call endrun('error in radiation_nextsw_cday') + end if + +end function radiation_nextsw_cday + +!================================================================================================ + +subroutine radiation_init(pbuf2d) + + ! Initialize the radiation parameterization, add fields to the history buffer + + use physics_buffer, only: pbuf_get_index, pbuf_set_field + use phys_control, only: phys_getopts + use radsw, only: radsw_init + use radlw, only: radlw_init + use rad_solar_var, only: rad_solar_var_init + use radiation_data, only: rad_data_init + use cloud_rad_props, only: cloud_rad_props_init + use modal_aer_opt, only: modal_aer_opt_init + use rrtmg_state, only: rrtmg_state_init + use time_manager, only: is_first_step + + + ! arguments + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local variables + integer :: icall, nmodes + logical :: active_calls(0:N_DIAG) + integer :: nstep ! current timestep number + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_vdiag ! output the variables used by the AMWG variability diag package + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + integer :: err + + integer :: dtime + !----------------------------------------------------------------------- + + call rad_solar_var_init() + call rrtmg_state_init() + call rad_data_init(pbuf2d) ! initialize output fields for offline driver + call radsw_init() + call radlw_init() + call cloud_rad_props_init() + + cld_idx = pbuf_get_index('CLD') + cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=err) + + if (is_first_step()) then + call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) + end if + + ! Set the radiation timestep for cosz calculations if requested using the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dtime = get_step_size() + dt_avg = iradsw*dtime + end if + + call phys_getopts(history_amwg_out = history_amwg, & + history_vdiag_out = history_vdiag, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + ! Determine whether modal aerosols are affecting the climate, and if so + ! then initialize the modal aerosol optics module + call rad_cnst_get_info(0, nmodes=nmodes) + if (nmodes > 0) call modal_aer_opt_init() + + ! "irad_always" is number of time steps to execute radiation continuously from start of + ! initial OR restart run + nstep = get_nstep() + if (irad_always > 0) then + nstep = get_nstep() + irad_always = irad_always + nstep + end if + + if (docosp) call cospsimulator_intr_init + + allocate(cosp_cnt(begchunk:endchunk)) + if (is_first_restart_step()) then + cosp_cnt(begchunk:endchunk) = cosp_cnt_init + else + cosp_cnt(begchunk:endchunk) = 0 + end if + + call addfld('O3colAbove', horiz_only, 'A', 'DU', 'Column O3 above model top', sampling_seq='rad_lwsw') + + call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total gbx cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('TOT_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Liquid in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('ICE_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Ice in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + + if (cldfsnow_idx > 0) then + call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Snow in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + endif + + ! get list of active radiation calls + call rad_cnst_get_call_list(active_calls) + + ! Add shortwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + + call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar insolation', sampling_seq='rad_lwsw') + + call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Solar heating rate', sampling_seq='rad_lwsw') + call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky solar heating rate', & + sampling_seq='rad_lwsw') + call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Shortwave cloud forcing', & + sampling_seq='rad_lwsw') + call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') + + call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net shortwave flux at 200 mb', & + sampling_seq='rad_lwsw') + call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net shortwave flux at 200 mb', & + sampling_seq='rad_lwsw') + + call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at tropopause', & + sampling_seq='rad_lwsw') + + call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared direct to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible direct to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared diffuse to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible diffuse to surface', & + sampling_seq='rad_lwsw') + call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at surface', & + sampling_seq='rad_lwsw') + + call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling solar flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky downwelling solar flux at surface', & + sampling_seq='rad_lwsw') + + call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave upward flux') + call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave downward flux') + call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') + call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') + + if (history_amwg) then + call add_default('SOLIN'//diag(icall), 1, ' ') + call add_default('QRS'//diag(icall), 1, ' ') + call add_default('FSNT'//diag(icall), 1, ' ') + call add_default('FSNTC'//diag(icall), 1, ' ') + call add_default('FSNTOA'//diag(icall), 1, ' ') + call add_default('FSNTOAC'//diag(icall), 1, ' ') + call add_default('SWCF'//diag(icall), 1, ' ') + call add_default('FSNS'//diag(icall), 1, ' ') + call add_default('FSNSC'//diag(icall), 1, ' ') + call add_default('FSUTOA'//diag(icall), 1, ' ') + call add_default('FSDSC'//diag(icall), 1, ' ') + call add_default('FSDS'//diag(icall), 1, ' ') + endif + + end if + end do + + if (scm_crm_mode) then + call add_default('FUS ', 1, ' ') + call add_default('FUSC ', 1, ' ') + call add_default('FDS ', 1, ' ') + call add_default('FDSC ', 1, ' ') + endif + + ! Add longwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + + call addfld('QRL'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Longwave heating rate', sampling_seq='rad_lwsw') + call addfld('QRLC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky longwave heating rate', & + sampling_seq='rad_lwsw') + call addfld('FLNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FLNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FLUT'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling longwave flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FLUTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky upwelling longwave flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('LWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Longwave cloud forcing', sampling_seq='rad_lwsw') + + call addfld('FLN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at 200 mb', & + sampling_seq='rad_lwsw') + call addfld('FLN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at 200 mb', & + sampling_seq='rad_lwsw') + call addfld('FLNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at tropopause', & + sampling_seq='rad_lwsw') + + call addfld('FLNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FLNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FLDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling longwave flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky Downwelling longwave flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FUL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave upward flux') + call addfld('FDL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave downward flux') + call addfld('FULC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky upward flux') + call addfld('FDLC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky downward flux') + + if (history_amwg) then + call add_default('QRL'//diag(icall), 1, ' ') + call add_default('FLNT'//diag(icall), 1, ' ') + call add_default('FLNTC'//diag(icall), 1, ' ') + call add_default('FLUT'//diag(icall), 1, ' ') + call add_default('FLUTC'//diag(icall), 1, ' ') + call add_default('LWCF'//diag(icall), 1, ' ') + call add_default('FLNS'//diag(icall), 1, ' ') + call add_default('FLNSC'//diag(icall), 1, ' ') + call add_default('FLDS'//diag(icall), 1, ' ') + endif + + end if + end do + + call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') + + if (scm_crm_mode) then + call add_default ('FUL ', 1, ' ') + call add_default ('FULC ', 1, ' ') + call add_default ('FDL ', 1, ' ') + call add_default ('FDLC ', 1, ' ') + endif + + ! Heating rate needed for d(theta)/dt computation + call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation') + + if ( history_budget .and. history_budget_histfile_num > 1 ) then + call add_default ('QRL ', history_budget_histfile_num, ' ') + call add_default ('QRS ', history_budget_histfile_num, ' ') + end if + + if (history_vdiag) then + call add_default('FLUT', 2, ' ') + call add_default('FLUT', 3, ' ') + end if + +end subroutine radiation_init + +!=============================================================================== + +subroutine radiation_define_restart(file) + + ! define variables to be written to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + + if (docosp) then + ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc) + end if + +end subroutine radiation_define_restart + +!=============================================================================== + +subroutine radiation_write_restart(file) + + ! write variables to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + + if (docosp) then + ierr = pio_put_var(File, cospcnt_desc, (/cosp_cnt(begchunk)/)) + end if + +end subroutine radiation_write_restart + +!=============================================================================== + +subroutine radiation_read_restart(file) + + ! read variables from restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + + integer :: err_handling + integer :: ierr + + type(var_desc_t) :: vardesc + !---------------------------------------------------------------------------- + + if (docosp) then + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'cosp_cnt_init', vardesc) + call pio_seterrorhandling(File, err_handling) + if (ierr /= PIO_NOERR) then + cosp_cnt_init = 0 + else + ierr = pio_get_var(File, vardesc, cosp_cnt_init) + end if + end if + +end subroutine radiation_read_restart + +!=============================================================================== + +subroutine radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) + + !----------------------------------------------------------------------- + ! + ! Driver for radiation computation. + ! + ! Revision history: + ! 2007-11-05 M. Iacono Install rrtmg_lw and sw as radiation model. + ! 2007-12-27 M. Iacono Modify to use CAM cloud optical properties with rrtmg. + !----------------------------------------------------------------------- + + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr + use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz + + use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + + use cloud_rad_props, only: get_ice_optics_sw, get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & + ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, & + snow_cloud_get_rad_props_lw, get_snow_optics_sw + use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw + use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw + + use rad_solar_var, only: get_variability + use radsw, only: rad_rrtmg_sw + use radlw, only: rad_rrtmg_lw + use radheat, only: radheat_tend + + use radiation_data, only: rad_data_write + use rrtmg_state, only: rrtmg_state_create, rrtmg_state_update, rrtmg_state_destroy, rrtmg_state_t, & + num_rrtmg_levs + + use interpolate_data, only: vertinterp + use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + + use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps + + ! Arguments + type(physics_state), intent(in), target :: state + type(physics_ptend), intent(out) :: ptend + + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(out) :: net_flx(pcols) + + type(rad_out_t), target, optional, intent(out) :: rd_out + + + ! Local variables + type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object + ! if the argument is not present + logical :: write_output + + integer :: i, k + integer :: lchnk, ncol + logical :: dosw, dolw + + real(r8) :: calday ! current calendar day + real(r8) :: delta ! Solar declination angle in radians + real(r8) :: eccf ! Earth orbit eccentricity factor + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + + ! Gathered indices of day and night columns + ! chunk_column_index = IdxDay(daylight_column_index) + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer :: IdxDay(pcols) ! Indices of daylight columns + integer :: IdxNite(pcols) ! Indices of night columns + + integer :: itim_old + + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds- whatever they are" + real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate + real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate + real(r8), pointer :: fsds(:) ! Surface solar down flux + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + + real(r8), pointer, dimension(:,:,:) :: su => NULL() ! shortwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: sd => NULL() ! shortwave spectral flux down + real(r8), pointer, dimension(:,:,:) :: lu => NULL() ! longwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: ld => NULL() ! longwave spectral flux down + + ! tropopause diagnostic + integer :: troplev(pcols) + real(r8) :: p_trop(pcols) + + type(rrtmg_state_t), pointer :: r_state ! contains the atm concentrations in layers needed for RRTMG + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w + real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w + real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth + real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau + real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth + real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w + real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) + + ! combined cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) + real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau + real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) + + real(r8) :: sfac(1:nswbands) ! time varying scaling factors due to Solar Spectral Irrad at 1 A.U. per band + + integer :: icall ! index through climate/diagnostic radiation calls + logical :: active_calls(0:N_DIAG) + + ! Aerosol radiative properties + real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau + real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + + real(r8) :: fns(pcols,pverp) ! net shortwave flux + real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux + real(r8) :: fnl(pcols,pverp) ! net longwave flux + real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux + + ! for COSP + real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity + real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau + real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + + character(*), parameter :: name = 'radiation_tend' + !-------------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + if (present(rd_out)) then + rd => rd_out + write_output = .false. + else + allocate(rd) + write_output=.true. + end if + + dosw = radiation_do('sw') ! do shortwave heating calc this timestep? + dolw = radiation_do('lw') ! do longwave heating calc this timestep? + + ! Cosine solar zenith angle for current time step + calday = get_curr_calday() + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + + call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, & + delta, eccf) + do i = 1, ncol + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) + end do + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + ! Associate pointers to physics buffer fields + itim_old = pbuf_old_tim_idx() + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + + if (spectralflux) then + call pbuf_get_field(pbuf, su_idx, su) + call pbuf_get_field(pbuf, sd_idx, sd) + call pbuf_get_field(pbuf, lu_idx, lu) + call pbuf_get_field(pbuf, ld_idx, ld) + end if + + ! For CRM, make cloud equal to input observations: + if (scm_crm_mode .and. have_cld) then + do k = 1, pver + cld(:ncol,k)= cldobs(k) + end do + end if + + ! Find tropopause height if needed for diagnostic output + if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then + call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + endif + + if (dosw .or. dolw) then + + ! construct an RRTMG state object + r_state => rrtmg_state_create( state, cam_in ) + + call t_startf('cldoptics') + + if (cldfsnow_idx > 0) then + do k = 1, pver + do i = 1, ncol + cldfprime(i,k) = max(cld(i,k), cldfsnow(i,k)) + end do + end do + else + cldfprime(:ncol,:) = cld(:ncol,:) + end if + + + if (dosw) then + + if (oldcldoptics) then + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.) + else + select case (icecldoptics) + case ('ebertcurry') + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.true.) + case ('mitchell') + call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) + case default + call endrun('iccldoptics must be one either ebertcurry or mitchell') + end select + + select case (liqcldoptics) + case ('slingo') + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.true.) + case ('gammadist') + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) + case default + call endrun('liqcldoptics must be either slingo or gammadist') + end select + end if + + cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) + cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) + cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) + cld_tau_w_f(:,:ncol,:) = liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:) + + if (cldfsnow_idx > 0) then + ! add in snow + call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f) + do i = 1, ncol + do k = 1, pver + + if (cldfprime(i,k) > 0.) then + + c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & + + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & + + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & + + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_f(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_f(:,i,k) & + + cld(i,k)*cld_tau_w_f(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + c_cld_tau_w_f(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) + c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) + c_cld_tau_w_f(:,:ncol,:) = cld_tau_w_f(:,:ncol,:) + end if + + ! Output cloud optical depth fields for the visible band + rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) + rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) + rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) + + if (cldfsnow_idx > 0) then + rd%snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + endif + + ! multiply by total cloud fraction to get gridbox value + rd%tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) + + ! add fillvalue for night columns + do i = 1, Nnite + rd%tot_cld_vistau(IdxNite(i),:) = fillvalue + rd%tot_icld_vistau(IdxNite(i),:) = fillvalue + rd%liq_icld_vistau(IdxNite(i),:) = fillvalue + rd%ice_icld_vistau(IdxNite(i),:) = fillvalue + if (cldfsnow_idx > 0) then + rd%snow_icld_vistau(IdxNite(i),:) = fillvalue + end if + end do + + if (write_output) call radiation_output_cld(lchnk, ncol, rd) + + end if ! if (dosw) + + if (dolw) then + + if (oldcldoptics) then + call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.) + else + select case (icecldoptics) + case ('ebertcurry') + call ec_ice_get_rad_props_lw(state, pbuf, ice_lw_abs, oldicewp=.true.) + case ('mitchell') + call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) + case default + call endrun('iccldoptics must be one either ebertcurry or mitchell') + end select + + select case (liqcldoptics) + case ('slingo') + call slingo_liq_get_rad_props_lw(state, pbuf, liq_lw_abs, oldliqwp=.true.) + case ('gammadist') + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) + case default + call endrun('liqcldoptics must be either slingo or gammadist') + end select + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + + end if + + if (cldfsnow_idx > 0) then + + ! add in snow + call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) + + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) & + + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) + end if + + end if ! if (dolw) + + call t_stopf('cldoptics') + + ! Solar radiation computation + + if (dosw) then + + call get_variability(sfac) + + ! Get the active climate/diagnostic shortwave calculations + call rad_cnst_get_call_list(active_calls) + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + + if (active_calls(icall)) then + + ! update the concentrations in the RRTMG state object + call rrtmg_state_update(state, pbuf, icall, r_state) + + call aer_rad_props_sw(icall, state, pbuf, nnite, idxnite, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) + + rd%cld_tau_cloudsim(:ncol,:) = cld_tau(rrtmg_sw_cloudsim_band,:ncol,:) + rd%aer_tau550(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag) + rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1) + rd%aer_tau700(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag-1) + + call rad_rrtmg_sw( & + lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, & + cldfprime, aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f, & + eccf, coszrs, rd%solin, sfac, cam_in%asdir, & + cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, & + fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, & + rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, & + rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, & + cam_out%solld, fns, fcns, Nday, Nnite, & + IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, & + E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, & + E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.) + + ! Output net fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) + if (hist_fld_active('FSNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fns(i,:), rd%fsnr(i)) + end do + end if + + if (write_output) call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) + + end if + end do + + end if + + ! Output aerosol mmr + call rad_cnst_out(0, state, pbuf) + + ! Longwave radiation computation + + if (dolw) then + + call rad_cnst_get_call_list(active_calls) + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + + if (active_calls(icall)) then + + ! update the conctrations in the RRTMG state object + call rrtmg_state_update( state, pbuf, icall, r_state) + + call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs) + + call rad_rrtmg_lw( & + lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, & + aer_lw_abs, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, & + flns, flnt, rd%flnsc, rd%flntc, cam_out%flwds, & + rd%flut, rd%flutc, fnl, fcnl, rd%fldsc, & + lu, ld) + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) + if (hist_fld_active('FLNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fnl(i,:), rd%flnr(i)) + end do + end if + + if (write_output) call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + + end if + end do + + end if + + ! deconstruct the RRTMG state object + call rrtmg_state_destroy(r_state) + + if (docosp) then + + ! initialize and calculate emis + emis(:,:) = 0._r8 + emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(rrtmg_lw_cloudsim_band,:ncol,:)) + call outfld('EMIS', emis, pcols, lchnk) + + ! compute grid-box mean SW and LW snow optical depth for use by COSP + gb_snow_tau(:,:) = 0._r8 + gb_snow_lw(:,:) = 0._r8 + if (cldfsnow_idx > 0) then + do i = 1, ncol + do k = 1, pver + if (cldfsnow(i,k) > 0.) then + gb_snow_tau(i,k) = snow_tau(rrtmg_sw_cloudsim_band,i,k)*cldfsnow(i,k) + gb_snow_lw(i,k) = snow_lw_abs(rrtmg_lw_cloudsim_band,i,k)*cldfsnow(i,k) + end if + end do + end do + end if + + ! advance counter for this timestep (chunk dimension required for thread safety) + cosp_cnt(lchnk) = cosp_cnt(lchnk) + 1 + + ! if counter is the same as cosp_nradsteps, run cosp and reset counter + if (cosp_nradsteps .eq. cosp_cnt(lchnk)) then + + ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave + ! optical depths are passed. + call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in=cld_tau(rrtmg_sw_cloudsim_band,:,:),& + snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) + cosp_cnt(lchnk) = 0 + end if + end if + + else ! if (dosw .or. dolw) then + + ! convert radiative heating rates from Q*dp to Q for energy conservation + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)/state%pdel(i,k) + qrl(i,k) = qrl(i,k)/state%pdel(i,k) + end do + end do + + end if ! if (dosw .or. dolw) then + + ! output rad inputs and resulting heating rates + call rad_data_write( pbuf, state, cam_in, coszrs ) + + ! Compute net radiative heating tendency + call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, cam_in%asdir, net_flx) + + if (write_output) then + ! Compute heating rate for dtheta/dt + do k = 1, pver + do i = 1, ncol + ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR', ftem, pcols, lchnk) + end if + + ! convert radiative heating rates to Q*dp for energy conservation + do k = 1, pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)*state%pdel(i,k) + qrl(i,k) = qrl(i,k)*state%pdel(i,k) + end do + end do + + cam_out%netsw(:ncol) = fsns(:ncol) + + if (.not. present(rd_out)) then + deallocate(rd) + end if + +end subroutine radiation_tend + +!=============================================================================== + +subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump shortwave radiation information to history buffer. + + integer , intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrs(:,:) + real(r8), pointer :: fsnt(:) + real(r8), pointer :: fsns(:) + real(r8), pointer :: fsds(:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk) + + call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FSNT'//diag(icall), fsnt, pcols, lchnk) + call outfld('FSNTC'//diag(icall), rd%fsntc, pcols, lchnk) + call outfld('FSNTOA'//diag(icall), rd%fsntoa, pcols, lchnk) + call outfld('FSNTOAC'//diag(icall), rd%fsntoac, pcols, lchnk) + + ftem(:ncol) = rd%fsntoa(:ncol) - rd%fsntoac(:ncol) + call outfld('SWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FSUTOA'//diag(icall), rd%fsutoa, pcols, lchnk) + + call outfld('FSNIRTOA'//diag(icall), rd%fsnirt, pcols, lchnk) + call outfld('FSNRTOAC'//diag(icall), rd%fsnrtc, pcols, lchnk) + call outfld('FSNRTOAS'//diag(icall), rd%fsnirtsq, pcols, lchnk) + + call outfld('FSN200'//diag(icall), rd%fsn200, pcols, lchnk) + call outfld('FSN200C'//diag(icall), rd%fsn200c, pcols, lchnk) + + call outfld('FSNR'//diag(icall), rd%fsnr, pcols, lchnk) + + call outfld('SOLS'//diag(icall), cam_out%sols, pcols, lchnk) + call outfld('SOLL'//diag(icall), cam_out%soll, pcols, lchnk) + call outfld('SOLSD'//diag(icall), cam_out%solsd, pcols, lchnk) + call outfld('SOLLD'//diag(icall), cam_out%solld, pcols, lchnk) + + call outfld('FSNS'//diag(icall), fsns, pcols, lchnk) + call outfld('FSNSC'//diag(icall), rd%fsnsc, pcols, lchnk) + + call outfld('FSDS'//diag(icall), fsds, pcols, lchnk) + call outfld('FSDSC'//diag(icall), rd%fsdsc, pcols, lchnk) + +end subroutine radiation_output_sw + + +!=============================================================================== + +subroutine radiation_output_cld(lchnk, ncol, rd) + + ! Dump shortwave cloud optics information to history buffer. + + integer , intent(in) :: lchnk + integer, intent(in) :: ncol + type(rad_out_t), intent(in) :: rd + !---------------------------------------------------------------------------- + + call outfld('TOT_CLD_VISTAU', rd%tot_cld_vistau, pcols, lchnk) + call outfld('TOT_ICLD_VISTAU', rd%tot_icld_vistau, pcols, lchnk) + call outfld('LIQ_ICLD_VISTAU', rd%liq_icld_vistau, pcols, lchnk) + call outfld('ICE_ICLD_VISTAU', rd%ice_icld_vistau, pcols, lchnk) + if (cldfsnow_idx > 0) then + call outfld('SNOW_ICLD_VISTAU', rd%snow_icld_vistau, pcols, lchnk) + endif + +end subroutine radiation_output_cld + +!=============================================================================== + +subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump longwave radiation information to history buffer + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall ! icall=0 for climate diagnostics + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrl(:,:) + real(r8), pointer :: flnt(:) + real(r8), pointer :: flns(:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, flns_idx, flns) + + call outfld('QRL'//diag(icall), qrl(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRLC'//diag(icall), rd%qrlc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FLNT'//diag(icall), flnt, pcols, lchnk) + call outfld('FLNTC'//diag(icall), rd%flntc, pcols, lchnk) + + call outfld('FLUT'//diag(icall), rd%flut, pcols, lchnk) + call outfld('FLUTC'//diag(icall), rd%flutc, pcols, lchnk) + + ftem(:ncol) = rd%flutc(:ncol) - rd%flut(:ncol) + call outfld('LWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FLN200'//diag(icall), rd%fln200, pcols, lchnk) + call outfld('FLN200C'//diag(icall), rd%fln200c, pcols, lchnk) + + call outfld('FLNR'//diag(icall), rd%flnr, pcols, lchnk) + + call outfld('FLNS'//diag(icall), flns, pcols, lchnk) + call outfld('FLNSC'//diag(icall), rd%flnsc, pcols, lchnk) + + call outfld('FLDS'//diag(icall), cam_out%flwds, pcols, lchnk) + call outfld('FLDSC'//diag(icall), rd%fldsc, pcols, lchnk) + +end subroutine radiation_output_lw + +!=============================================================================== + +subroutine calc_col_mean(state, mmr_pointer, mean_value) + + ! Compute the column mean mass mixing ratio. + + type(physics_state), intent(in) :: state + real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) + real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr + + integer :: i, k, ncol + real(r8) :: ptot(pcols) + !----------------------------------------------------------------------- + + ncol = state%ncol + mean_value = 0.0_r8 + ptot = 0.0_r8 + + do k=1,pver + do i=1,ncol + mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k) + ptot(i) = ptot(i) + state%pdeldry(i,k) + end do + end do + do i=1,ncol + mean_value(i) = mean_value(i) / ptot(i) + end do + +end subroutine calc_col_mean + +!=============================================================================== + +end module radiation + diff --git a/src/physics/rrtmg/radlw.F90 b/src/physics/rrtmg/radlw.F90 new file mode 100644 index 0000000000..b2b56a751c --- /dev/null +++ b/src/physics/rrtmg/radlw.F90 @@ -0,0 +1,302 @@ + +module radlw +!----------------------------------------------------------------------- +! +! Purpose: Longwave radiation calculations. +! +!----------------------------------------------------------------------- +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use scamMod, only: single_column, scm_crm_mode +use parrrtm, only: nbndlw, ngptlw +use rrtmg_lw_init, only: rrtmg_lw_ini +use rrtmg_lw_rad, only: rrtmg_lw +use spmd_utils, only: masterproc +use perf_mod, only: t_startf, t_stopf +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use radconstants, only: nlwbands + +implicit none + +private +save + +! Public methods + +public ::& + radlw_init, &! initialize constants + rad_rrtmg_lw ! driver for longwave radiation code + +! Private data +integer :: ntoplw ! top level to solve for longwave cooling + +! Flag for cloud overlap method +! 0=clear, 1=random, 2=maximum/random, 3=maximum +integer, parameter :: icld = 2 + + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine rad_rrtmg_lw(lchnk ,ncol ,rrtmg_levs,r_state, & + pmid ,aer_lw_abs,cld ,tauc_lw, & + qrl ,qrlc , & + flns ,flnt ,flnsc ,flntc ,flwds, & + flut ,flutc ,fnl ,fcnl ,fldsc, & + lu ,ld ) + +!----------------------------------------------------------------------- + use cam_history, only: outfld + use mcica_subcol_gen_lw, only: mcica_subcol_lw + use physconst, only: cpair + use rrtmg_state, only: rrtmg_state_t + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: rrtmg_levs ! number of levels rad is applied + +! +! Input arguments which are only passed to other routines +! + type(rrtmg_state_t), intent(in) :: r_state + + real(r8), intent(in) :: pmid(pcols,pver) ! Level pressure (Pascals) + + real(r8), intent(in) :: aer_lw_abs (pcols,pver,nbndlw) ! aerosol absorption optics depth (LW) + + real(r8), intent(in) :: cld(pcols,pver) ! Cloud cover + real(r8), intent(in) :: tauc_lw(nbndlw,pcols,pver) ! Cloud longwave optical depth by band + +! +! Output arguments +! + real(r8), intent(out) :: qrl (pcols,pver) ! Longwave heating rate + real(r8), intent(out) :: qrlc(pcols,pver) ! Clearsky longwave heating rate + real(r8), intent(out) :: flns(pcols) ! Surface cooling flux + real(r8), intent(out) :: flnt(pcols) ! Net outgoing flux + real(r8), intent(out) :: flut(pcols) ! Upward flux at top of model + real(r8), intent(out) :: flnsc(pcols) ! Clear sky surface cooing + real(r8), intent(out) :: flntc(pcols) ! Net clear sky outgoing flux + real(r8), intent(out) :: flutc(pcols) ! Upward clear-sky flux at top of model + real(r8), intent(out) :: flwds(pcols) ! Down longwave flux at surface + real(r8), intent(out) :: fldsc(pcols) ! Down longwave clear flux at surface + real(r8), intent(out) :: fcnl(pcols,pverp) ! clear sky net flux at interfaces + real(r8), intent(out) :: fnl(pcols,pverp) ! net flux at interfaces + + real(r8), pointer, dimension(:,:,:) :: lu ! longwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: ld ! longwave spectral flux down + +! +!---------------------------Local variables----------------------------- +! + integer :: i, k, kk, nbnd ! indices + + real(r8) :: ful(pcols,pverp) ! Total upwards longwave flux + real(r8) :: fsul(pcols,pverp) ! Clear sky upwards longwave flux + real(r8) :: fdl(pcols,pverp) ! Total downwards longwave flux + real(r8) :: fsdl(pcols,pverp) ! Clear sky downwards longwv flux + + real(r8) :: tsfc(pcols) ! surface temperature + real(r8) :: emis(pcols,nbndlw) ! surface emissivity + + real(r8) :: taua_lw(pcols,rrtmg_levs-1,nbndlw) ! aerosol optical depth by band + + real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day + + ! Cloud arrays for McICA + integer, parameter :: nsubclw = ngptlw ! rrtmg_lw g-point (quadrature point) dimension + integer :: permuteseed ! permute seed for sub-column generator + + real(r8) :: cicewp(pcols,rrtmg_levs-1) ! in-cloud cloud ice water path + real(r8) :: cliqwp(pcols,rrtmg_levs-1) ! in-cloud cloud liquid water path + real(r8) :: rei(pcols,rrtmg_levs-1) ! ice particle effective radius (microns) + real(r8) :: rel(pcols,rrtmg_levs-1) ! liquid particle radius (micron) + + real(r8) :: cld_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud fraction (mcica) + real(r8) :: cicewp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud ice water path (mcica) + real(r8) :: cliqwp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud liquid water path (mcica) + real(r8) :: rei_stolw(pcols,rrtmg_levs-1) ! ice particle size (mcica) + real(r8) :: rel_stolw(pcols,rrtmg_levs-1) ! liquid particle size (mcica) + real(r8) :: tauc_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud optical depth (mcica - optional) + + ! Includes extra layer above model top + real(r8) :: uflx(pcols,rrtmg_levs+1) ! Total upwards longwave flux + real(r8) :: uflxc(pcols,rrtmg_levs+1) ! Clear sky upwards longwave flux + real(r8) :: dflx(pcols,rrtmg_levs+1) ! Total downwards longwave flux + real(r8) :: dflxc(pcols,rrtmg_levs+1) ! Clear sky downwards longwv flux + real(r8) :: hr(pcols,rrtmg_levs) ! Longwave heating rate (K/d) + real(r8) :: hrc(pcols,rrtmg_levs) ! Clear sky longwave heating rate (K/d) + real(r8) lwuflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux up + real(r8) lwdflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux down + !----------------------------------------------------------------------- + + ! mji/rrtmg + + ! Calculate cloud optical properties here if using CAM method, or if using one of the + ! methods in RRTMG_LW, then pass in cloud physical properties and zero out cloud optical + ! properties here + + ! Zero optional cloud optical depth input array tauc_lw, + ! if inputting cloud physical properties into RRTMG_LW + ! tauc_lw(:,:,:) = 0. + ! Or, pass in CAM cloud longwave optical depth to RRTMG_LW + ! do nbnd = 1, nbndlw + ! tauc_lw(nbnd,:ncol,:pver) = cldtau(:ncol,:pver) + ! end do + + ! Call mcica sub-column generator for RRTMG_LW + + ! Call sub-column generator for McICA in radiation + call t_startf('mcica_subcol_lw') + + ! Set permute seed (must be offset between LW and SW by at least 140 to insure + ! effective randomization) + permuteseed = 150 + + ! These fields are no longer supplied by CAM. + cicewp = 0.0_r8 + cliqwp = 0.0_r8 + rei = 0.0_r8 + rel = 0.0_r8 + + call mcica_subcol_lw(lchnk, ncol, rrtmg_levs-1, icld, permuteseed, pmid(:, pverp-rrtmg_levs+1:pverp-1), & + cld(:, pverp-rrtmg_levs+1:pverp-1), cicewp, cliqwp, rei, rel, tauc_lw(:, :ncol, pverp-rrtmg_levs+1:pverp-1), & + cld_stolw, cicewp_stolw, cliqwp_stolw, rei_stolw, rel_stolw, tauc_stolw) + + call t_stopf('mcica_subcol_lw') + + + call t_startf('rrtmg_lw') + + ! Convert incoming water amounts from specific humidity to vmr as needed; + ! Convert other incoming molecular amounts from mmr to vmr as needed; + ! Convert pressures from Pa to hPa; + ! Set surface emissivity to 1.0 here, this is treated in land surface model; + ! Set surface temperature + ! Set aerosol optical depth to zero for now + + emis(:ncol,:nbndlw) = 1._r8 + tsfc(:ncol) = r_state%tlev(:ncol,rrtmg_levs+1) + taua_lw(:ncol, 1:rrtmg_levs-1, :nbndlw) = aer_lw_abs(:ncol,pverp-rrtmg_levs+1:pverp-1,:nbndlw) + + if (associated(lu)) lu(1:ncol,:,:) = 0.0_r8 + if (associated(ld)) ld(1:ncol,:,:) = 0.0_r8 + + call rrtmg_lw(lchnk ,ncol ,rrtmg_levs ,icld , & + r_state%pmidmb ,r_state%pintmb ,r_state%tlay ,r_state%tlev ,tsfc ,r_state%h2ovmr, & + r_state%o3vmr ,r_state%co2vmr ,r_state%ch4vmr ,r_state%o2vmr ,r_state%n2ovmr ,r_state%cfc11vmr,r_state%cfc12vmr, & + r_state%cfc22vmr,r_state%ccl4vmr ,emis ,& + cld_stolw,tauc_stolw,cicewp_stolw,cliqwp_stolw ,rei, rel, & + taua_lw, & + uflx ,dflx ,hr ,uflxc ,dflxc ,hrc, & + lwuflxs, lwdflxs) + + ! + !---------------------------------------------------------------------- + ! All longitudes: store history tape quantities + ! Flux units are in W/m2 on output from rrtmg_lw and contain output for + ! extra layer above model top with vertical indexing from bottom to top. + ! Heating units are in K/d on output from RRTMG and contain output for + ! extra layer above model top with vertical indexing from bottom to top. + ! Heating units are converted to J/kg/s below for use in CAM. + + flwds(:ncol) = dflx (:ncol,1) + fldsc(:ncol) = dflxc(:ncol,1) + flns(:ncol) = uflx (:ncol,1) - dflx (:ncol,1) + flnsc(:ncol) = uflxc(:ncol,1) - dflxc(:ncol,1) + flnt(:ncol) = uflx (:ncol,rrtmg_levs) - dflx (:ncol,rrtmg_levs) + flntc(:ncol) = uflxc(:ncol,rrtmg_levs) - dflxc(:ncol,rrtmg_levs) + flut(:ncol) = uflx (:ncol,rrtmg_levs) + flutc(:ncol) = uflxc(:ncol,rrtmg_levs) + + ! + ! Reverse vertical indexing here for CAM arrays to go from top to bottom. + ! + ful = 0._r8 + fdl = 0._r8 + fsul = 0._r8 + fsdl = 0._r8 + ful (:ncol,pverp-rrtmg_levs+1:pverp)= uflx(:ncol,rrtmg_levs:1:-1) + fdl (:ncol,pverp-rrtmg_levs+1:pverp)= dflx(:ncol,rrtmg_levs:1:-1) + fsul(:ncol,pverp-rrtmg_levs+1:pverp)=uflxc(:ncol,rrtmg_levs:1:-1) + fsdl(:ncol,pverp-rrtmg_levs+1:pverp)=dflxc(:ncol,rrtmg_levs:1:-1) + + if (single_column.and.scm_crm_mode) then + call outfld('FUL ',ful,pcols,lchnk) + call outfld('FDL ',fdl,pcols,lchnk) + call outfld('FULC ',fsul,pcols,lchnk) + call outfld('FDLC ',fsdl,pcols,lchnk) + endif + + fnl(:ncol,:) = ful(:ncol,:) - fdl(:ncol,:) + ! mji/ cam excluded this? + fcnl(:ncol,:) = fsul(:ncol,:) - fsdl(:ncol,:) + + ! Pass longwave heating to CAM arrays and convert from K/d to J/kg/s + qrl = 0._r8 + qrlc = 0._r8 + qrl (:ncol,pverp-rrtmg_levs+1:pver)=hr (:ncol,rrtmg_levs-1:1:-1)*cpair*dps + qrlc(:ncol,pverp-rrtmg_levs+1:pver)=hrc(:ncol,rrtmg_levs-1:1:-1)*cpair*dps + + ! Return 0 above solution domain + if ( ntoplw > 1 )then + qrl(:ncol,:ntoplw-1) = 0._r8 + qrlc(:ncol,:ntoplw-1) = 0._r8 + end if + + ! Pass spectral fluxes, reverse layering + ! order=(/3,1,2/) maps the first index of lwuflxs to the third index of lu. + if (associated(lu)) then + lu(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwuflxs(:,:ncol,rrtmg_levs:1:-1), & + (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/)) + end if + + if (associated(ld)) then + ld(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwdflxs(:,:ncol,rrtmg_levs:1:-1), & + (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/)) + end if + + call t_stopf('rrtmg_lw') + +end subroutine rad_rrtmg_lw + +!------------------------------------------------------------------------------- + +subroutine radlw_init() +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize various constants for radiation scheme. +! +!----------------------------------------------------------------------- + + use ref_pres, only : pref_mid + + integer :: k + + ! If the top model level is above ~90 km (0.1 Pa), set the top level to compute + ! longwave cooling to about 80 km (1 Pa) + if (pref_mid(1) .lt. 0.1_r8) then + do k = 1, pver + if (pref_mid(k) .lt. 1._r8) ntoplw = k + end do + else + ntoplw = 1 + end if + if (masterproc) then + write(iulog,*) 'radlw_init: ntoplw =',ntoplw + endif + + call rrtmg_lw_ini + +end subroutine radlw_init + +!------------------------------------------------------------------------------- + +end module radlw diff --git a/src/physics/rrtmg/radsw.F90 b/src/physics/rrtmg/radsw.F90 new file mode 100644 index 0000000000..df222557dd --- /dev/null +++ b/src/physics/rrtmg/radsw.F90 @@ -0,0 +1,663 @@ + +module radsw +!----------------------------------------------------------------------- +! +! Purpose: Solar radiation calculations. +! +!----------------------------------------------------------------------- +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use cam_abortutils, only: endrun +use cam_history, only: outfld +use scamMod, only: single_column,scm_crm_mode,have_asdir, & + asdirobs, have_asdif, asdifobs, have_aldir, & + aldirobs, have_aldif, aldifobs +use cam_logfile, only: iulog +use parrrsw, only: nbndsw, ngptsw +use rrtmg_sw_init, only: rrtmg_sw_ini +use rrtmg_sw_rad, only: rrtmg_sw +use perf_mod, only: t_startf, t_stopf +use radconstants, only: idx_sw_diag + +implicit none + +private +save + +real(r8) :: fractional_solar_irradiance(1:nbndsw) ! fraction of solar irradiance in each band +real(r8) :: solar_band_irrad(1:nbndsw) ! rrtmg-assumed solar irradiance in each sw band + +! Public methods + +public ::& + radsw_init, &! initialize constants + rad_rrtmg_sw ! driver for solar radiation code + +! Flag for cloud overlap method +! 0=clear, 1=random, 2=maximum-random, 3=maximum +integer, parameter :: icld = 2 + +!=============================================================================== +CONTAINS +!=============================================================================== + +subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , & + E_pmid ,E_cld , & + E_aer_tau,E_aer_tau_w,E_aer_tau_w_g,E_aer_tau_w_f, & + eccf ,E_coszrs ,solin ,sfac , & + E_asdir ,E_asdif ,E_aldir ,E_aldif , & + qrs ,qrsc ,fsnt ,fsntc ,fsntoa,fsutoa, & + fsntoac ,fsnirtoa ,fsnrtoac ,fsnrtoaq ,fsns , & + fsnsc ,fsdsc ,fsds ,sols ,soll , & + solsd ,solld ,fns ,fcns , & + Nday ,Nnite ,IdxDay ,IdxNite , & + su ,sd , & + E_cld_tau, E_cld_tau_w, E_cld_tau_w_g, E_cld_tau_w_f, & + old_convert) + + +!----------------------------------------------------------------------- +! +! Purpose: +! Solar radiation code +! +! Method: +! mji/rrtmg +! RRTMG, two-stream, with McICA +! +! Divides solar spectrum into 14 intervals from 0.2-12.2 micro-meters. +! solar flux fractions specified for each interval. allows for +! seasonally and diurnally varying solar input. Includes molecular, +! cloud, aerosol, and surface scattering, along with h2o,o3,co2,o2,cloud, +! and surface absorption. Computes delta-eddington reflections and +! transmissions assuming homogeneously mixed layers. Adds the layers +! assuming scattering between layers to be isotropic, and distinguishes +! direct solar beam from scattered radiation. +! +! Longitude loops are broken into 1 or 2 sections, so that only daylight +! (i.e. coszrs > 0) computations are done. +! +! Note that an extra layer above the model top layer is added. +! +! mks units are used. +! +! Special diagnostic calculation of the clear sky surface and total column +! absorbed flux is also done for cloud forcing diagnostics. +! +!----------------------------------------------------------------------- + + use cmparray_mod, only: CmpDayNite, ExpDayNite + use phys_control, only: phys_getopts + use mcica_subcol_gen_sw, only: mcica_subcol_sw + use physconst, only: cpair + use rrtmg_state, only: rrtmg_state_t + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + ! Input arguments + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: rrtmg_levs ! number of levels rad is applied + + type(rrtmg_state_t), intent(in) :: r_state + + integer, intent(in) :: Nday ! Number of daylight columns + integer, intent(in) :: Nnite ! Number of night columns + integer, intent(in), dimension(pcols) :: IdxDay ! Indicies of daylight coumns + integer, intent(in), dimension(pcols) :: IdxNite ! Indicies of night coumns + + real(r8), intent(in) :: E_pmid(pcols,pver) ! Level pressure (Pascals) + real(r8), intent(in) :: E_cld(pcols,pver) ! Fractional cloud cover + + real(r8), intent(in) :: E_aer_tau (pcols, 0:pver, nbndsw) ! aerosol optical depth + real(r8), intent(in) :: E_aer_tau_w (pcols, 0:pver, nbndsw) ! aerosol OD * ssa + real(r8), intent(in) :: E_aer_tau_w_g(pcols, 0:pver, nbndsw) ! aerosol OD * ssa * asm + real(r8), intent(in) :: E_aer_tau_w_f(pcols, 0:pver, nbndsw) ! aerosol OD * ssa * fwd + + real(r8), intent(in) :: eccf ! Eccentricity factor (1./earth-sun dist^2) + real(r8), intent(in) :: E_coszrs(pcols) ! Cosine solar zenith angle + real(r8), intent(in) :: E_asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad + real(r8), intent(in) :: E_aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad + real(r8), intent(in) :: E_asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad + real(r8), intent(in) :: E_aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad + real(r8), intent(in) :: sfac(nbndsw) ! factor to account for solar variability in each band + + real(r8), optional, intent(in) :: E_cld_tau (nbndsw, pcols, pver) ! cloud optical depth + real(r8), optional, intent(in) :: E_cld_tau_w (nbndsw, pcols, pver) ! cloud optical + real(r8), optional, intent(in) :: E_cld_tau_w_g(nbndsw, pcols, pver) ! cloud optical + real(r8), optional, intent(in) :: E_cld_tau_w_f(nbndsw, pcols, pver) ! cloud optical + logical, optional, intent(in) :: old_convert + + ! Output arguments + + real(r8), intent(out) :: solin(pcols) ! Incident solar flux + real(r8), intent(out) :: qrs (pcols,pver) ! Solar heating rate + real(r8), intent(out) :: qrsc(pcols,pver) ! Clearsky solar heating rate + real(r8), intent(out) :: fsns(pcols) ! Surface absorbed solar flux + real(r8), intent(out) :: fsnt(pcols) ! Total column absorbed solar flux + real(r8), intent(out) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8), intent(out) :: fsutoa(pcols) ! Upward solar flux at TOA + real(r8), intent(out) :: fsds(pcols) ! Flux shortwave downwelling surface + + real(r8), intent(out) :: fsnsc(pcols) ! Clear sky surface absorbed solar flux + real(r8), intent(out) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + real(r8), intent(out) :: fsntc(pcols) ! Clear sky total column absorbed solar flx + real(r8), intent(out) :: fsntoac(pcols) ! Clear sky net solar flx at TOA + real(r8), intent(out) :: sols(pcols) ! Direct solar rad on surface (< 0.7) + real(r8), intent(out) :: soll(pcols) ! Direct solar rad on surface (>= 0.7) + real(r8), intent(out) :: solsd(pcols) ! Diffuse solar rad on surface (< 0.7) + real(r8), intent(out) :: solld(pcols) ! Diffuse solar rad on surface (>= 0.7) + real(r8), intent(out) :: fsnirtoa(pcols) ! Near-IR flux absorbed at toa + real(r8), intent(out) :: fsnrtoac(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8), intent(out) :: fsnrtoaq(pcols) ! Net near-IR flux at toa >= 0.7 microns + + real(r8), intent(out) :: fns(pcols,pverp) ! net flux at interfaces + real(r8), intent(out) :: fcns(pcols,pverp) ! net clear-sky flux at interfaces + + real(r8), pointer, dimension(:,:,:) :: su ! shortwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: sd ! shortwave spectral flux down + + !---------------------------Local variables----------------------------- + + ! Local and reordered copies of the intent(in) variables + + real(r8) :: pmid(pcols,pver) ! Level pressure (Pascals) + + real(r8) :: cld(pcols,rrtmg_levs-1) ! Fractional cloud cover + real(r8) :: cicewp(pcols,rrtmg_levs-1) ! in-cloud cloud ice water path + real(r8) :: cliqwp(pcols,rrtmg_levs-1) ! in-cloud cloud liquid water path + real(r8) :: rel(pcols,rrtmg_levs-1) ! Liquid effective drop size (microns) + real(r8) :: rei(pcols,rrtmg_levs-1) ! Ice effective drop size (microns) + + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + real(r8) :: asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad + real(r8) :: aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad + real(r8) :: asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad + real(r8) :: aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad + + real(r8) :: h2ovmr(pcols,rrtmg_levs) ! h2o volume mixing ratio + real(r8) :: o3vmr(pcols,rrtmg_levs) ! o3 volume mixing ratio + real(r8) :: co2vmr(pcols,rrtmg_levs) ! co2 volume mixing ratio + real(r8) :: ch4vmr(pcols,rrtmg_levs) ! ch4 volume mixing ratio + real(r8) :: o2vmr(pcols,rrtmg_levs) ! o2 volume mixing ratio + real(r8) :: n2ovmr(pcols,rrtmg_levs) ! n2o volume mixing ratio + + real(r8) :: tsfc(pcols) ! surface temperature + + integer :: dyofyr ! Set to day of year for Earth/Sun distance calculation in + ! rrtmg_sw, or pass in adjustment directly into adjes + real(r8) :: solvar(nbndsw) ! solar irradiance variability in each band + + integer, parameter :: nsubcsw = ngptsw ! rrtmg_sw g-point (quadrature point) dimension + integer :: permuteseed ! permute seed for sub-column generator + + real(r8) :: diagnostic_od(pcols, pver) ! cloud optical depth - diagnostic temp variable + + real(r8) :: tauc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud optical depth + real(r8) :: ssac_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud single scat. albedo + real(r8) :: asmc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud asymmetry parameter + real(r8) :: fsfc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud forward scattering fraction + + real(r8) :: tau_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer optical depth + real(r8) :: ssa_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer single scat. albedo + real(r8) :: asm_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer asymmetry parameter + + real(r8) :: cld_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud fraction + real(r8) :: rei_stosw(pcols, rrtmg_levs-1) ! stochastic ice particle size + real(r8) :: rel_stosw(pcols, rrtmg_levs-1) ! stochastic liquid particle size + real(r8) :: cicewp_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud ice water path + real(r8) :: cliqwp_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud liquid wter path + real(r8) :: tauc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud optical depth (optional) + real(r8) :: ssac_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud single scat. albedo (optional) + real(r8) :: asmc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud asymmetry parameter (optional) + real(r8) :: fsfc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud forward scattering fraction (optional) + + real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day + + real(r8) :: swuflx(pcols,rrtmg_levs+1) ! Total sky shortwave upward flux (W/m2) + real(r8) :: swdflx(pcols,rrtmg_levs+1) ! Total sky shortwave downward flux (W/m2) + real(r8) :: swhr(pcols,rrtmg_levs) ! Total sky shortwave radiative heating rate (K/d) + real(r8) :: swuflxc(pcols,rrtmg_levs+1) ! Clear sky shortwave upward flux (W/m2) + real(r8) :: swdflxc(pcols,rrtmg_levs+1) ! Clear sky shortwave downward flux (W/m2) + real(r8) :: swhrc(pcols,rrtmg_levs) ! Clear sky shortwave radiative heating rate (K/d) + real(r8) :: swuflxs(nbndsw,pcols,rrtmg_levs+1) ! Shortwave spectral flux up + real(r8) :: swdflxs(nbndsw,pcols,rrtmg_levs+1) ! Shortwave spectral flux down + + real(r8) :: dirdnuv(pcols,rrtmg_levs+1) ! Direct downward shortwave flux, UV/vis + real(r8) :: difdnuv(pcols,rrtmg_levs+1) ! Diffuse downward shortwave flux, UV/vis + real(r8) :: dirdnir(pcols,rrtmg_levs+1) ! Direct downward shortwave flux, near-IR + real(r8) :: difdnir(pcols,rrtmg_levs+1) ! Diffuse downward shortwave flux, near-IR + + ! Added for net near-IR diagnostic + real(r8) :: ninflx(pcols,rrtmg_levs+1) ! Net shortwave flux, near-IR + real(r8) :: ninflxc(pcols,rrtmg_levs+1) ! Net clear sky shortwave flux, near-IR + + ! Other + + integer :: i, k, ns ! indices + + ! Cloud radiative property arrays + real(r8) :: tauxcl(pcols,0:pver) ! water cloud extinction optical depth + real(r8) :: tauxci(pcols,0:pver) ! ice cloud extinction optical depth + real(r8) :: wcl(pcols,0:pver) ! liquid cloud single scattering albedo + real(r8) :: gcl(pcols,0:pver) ! liquid cloud asymmetry parameter + real(r8) :: fcl(pcols,0:pver) ! liquid cloud forward scattered fraction + real(r8) :: wci(pcols,0:pver) ! ice cloud single scattering albedo + real(r8) :: gci(pcols,0:pver) ! ice cloud asymmetry parameter + real(r8) :: fci(pcols,0:pver) ! ice cloud forward scattered fraction + + ! Aerosol radiative property arrays + real(r8) :: tauxar(pcols,0:pver) ! aerosol extinction optical depth + real(r8) :: wa(pcols,0:pver) ! aerosol single scattering albedo + real(r8) :: ga(pcols,0:pver) ! aerosol assymetry parameter + real(r8) :: fa(pcols,0:pver) ! aerosol forward scattered fraction + + ! CRM + real(r8) :: fus(pcols,pverp) ! Upward flux (added for CRM) + real(r8) :: fds(pcols,pverp) ! Downward flux (added for CRM) + real(r8) :: fusc(pcols,pverp) ! Upward clear-sky flux (added for CRM) + real(r8) :: fdsc(pcols,pverp) ! Downward clear-sky flux (added for CRM) + + integer :: kk + + real(r8) :: pmidmb(pcols,rrtmg_levs) ! Level pressure (hPa) + real(r8) :: pintmb(pcols,rrtmg_levs+1) ! Model interface pressure (hPa) + real(r8) :: tlay(pcols,rrtmg_levs) ! mid point temperature + real(r8) :: tlev(pcols,rrtmg_levs+1) ! interface temperature + + !----------------------------------------------------------------------- + ! START OF CALCULATION + !----------------------------------------------------------------------- + + ! Initialize output fields: + + fsds(1:ncol) = 0.0_r8 + + fsnirtoa(1:ncol) = 0.0_r8 + fsnrtoac(1:ncol) = 0.0_r8 + fsnrtoaq(1:ncol) = 0.0_r8 + + fsns(1:ncol) = 0.0_r8 + fsnsc(1:ncol) = 0.0_r8 + fsdsc(1:ncol) = 0.0_r8 + + fsnt(1:ncol) = 0.0_r8 + fsntc(1:ncol) = 0.0_r8 + fsntoa(1:ncol) = 0.0_r8 + fsutoa(1:ncol) = 0.0_r8 + fsntoac(1:ncol) = 0.0_r8 + + solin(1:ncol) = 0.0_r8 + + sols(1:ncol) = 0.0_r8 + soll(1:ncol) = 0.0_r8 + solsd(1:ncol) = 0.0_r8 + solld(1:ncol) = 0.0_r8 + + qrs (1:ncol,1:pver) = 0.0_r8 + qrsc(1:ncol,1:pver) = 0.0_r8 + fns(1:ncol,1:pverp) = 0.0_r8 + fcns(1:ncol,1:pverp) = 0.0_r8 + if (single_column.and.scm_crm_mode) then + fus(1:ncol,1:pverp) = 0.0_r8 + fds(1:ncol,1:pverp) = 0.0_r8 + fusc(:ncol,:pverp) = 0.0_r8 + fdsc(:ncol,:pverp) = 0.0_r8 + endif + + if (associated(su)) su(1:ncol,:,:) = 0.0_r8 + if (associated(sd)) sd(1:ncol,:,:) = 0.0_r8 + + ! If night everywhere, return: + if ( Nday == 0 ) then + return + endif + + ! Rearrange input arrays + call CmpDayNite(E_pmid(:,pverp-rrtmg_levs+1:pver), pmid(:,1:rrtmg_levs-1), & + Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs-1) + call CmpDayNite(E_cld(:,pverp-rrtmg_levs+1:pver), cld(:,1:rrtmg_levs-1), & + Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs-1) + + call CmpDayNite(r_state%pintmb, pintmb, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs+1) + call CmpDayNite(r_state%pmidmb, pmidmb, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%h2ovmr, h2ovmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%o3vmr, o3vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%co2vmr, co2vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + + call CmpDayNite(E_coszrs, coszrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_asdir, asdir, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_aldir, aldir, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_asdif, asdif, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call CmpDayNite(E_aldif, aldif, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + + call CmpDayNite(r_state%tlay, tlay, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%tlev, tlev, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs+1) + call CmpDayNite(r_state%ch4vmr, ch4vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%o2vmr, o2vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + call CmpDayNite(r_state%n2ovmr, n2ovmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs) + + ! These fields are no longer input by CAM. + cicewp = 0.0_r8 + cliqwp = 0.0_r8 + rel = 0.0_r8 + rei = 0.0_r8 + + ! Aerosol daylight map + ! Also convert to optical properties of rrtmg interface, even though + ! these quantities are later multiplied back together inside rrtmg ! + ! Why does rrtmg use the factored quantities? + ! There are several different ways this factoring could be done. + ! Other ways might allow for better optimization + do ns = 1, nbndsw + do k = 1, rrtmg_levs-1 + kk=(pverp-rrtmg_levs) + k + do i = 1, Nday + if(E_aer_tau_w(IdxDay(i),kk,ns) > 1.e-80_r8) then + asm_aer_sw(i,k,ns) = E_aer_tau_w_g(IdxDay(i),kk,ns)/E_aer_tau_w(IdxDay(i),kk,ns) + else + asm_aer_sw(i,k,ns) = 0._r8 + endif + if(E_aer_tau(IdxDay(i),kk,ns) > 0._r8) then + ssa_aer_sw(i,k,ns) = E_aer_tau_w(IdxDay(i),kk,ns)/E_aer_tau(IdxDay(i),kk,ns) + tau_aer_sw(i,k,ns) = E_aer_tau(IdxDay(i),kk,ns) + else + ssa_aer_sw(i,k,ns) = 1._r8 + tau_aer_sw(i,k,ns) = 0._r8 + endif + enddo + enddo + enddo + + if (scm_crm_mode) then + ! overwrite albedos for CRM + if(have_asdir) asdir = asdirobs(1) + if(have_asdif) asdif = asdifobs(1) + if(have_aldir) aldir = aldirobs(1) + if(have_aldif) aldif = aldifobs(1) + endif + + ! Define solar incident radiation + do i = 1, Nday + solin(i) = sum(sfac(:)*solar_band_irrad(:)) * eccf * coszrs(i) + end do + + ! Calculate cloud optical properties here if using CAM method, or if using one of the + ! methods in RRTMG_SW, then pass in cloud physical properties and zero out cloud optical + ! properties here + + ! Zero optional cloud optical property input arrays tauc_sw, ssac_sw, asmc_sw, + ! if inputting cloud physical properties to RRTMG_SW + !tauc_sw(:,:,:) = 0.0_r8 + !ssac_sw(:,:,:) = 1.0_r8 + !asmc_sw(:,:,:) = 0.0_r8 + !fsfc_sw(:,:,:) = 0.0_r8 + ! + ! Or, calculate and pass in CAM cloud shortwave optical properties to RRTMG_SW + !if (present(old_convert)) print *, 'old_convert',old_convert + !if (present(ancientmethod)) print *, 'ancientmethod',ancientmethod + if (present(old_convert))then + if (old_convert)then ! convert without limits + do i = 1, Nday + do k = 1, rrtmg_levs-1 + kk=(pverp-rrtmg_levs) + k + do ns = 1, nbndsw + if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then + fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/E_cld_tau_w(ns,IdxDay(i),kk) + asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/E_cld_tau_w(ns,IdxDay(i),kk) + else + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + endif + + tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk) + if (tauc_sw(ns,i,k) > 0._r8) then + ssac_sw(ns,i,k)=E_cld_tau_w(ns,IdxDay(i),kk)/tauc_sw(ns,i,k) + else + tauc_sw(ns,i,k) = 0._r8 + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + ssac_sw(ns,i,k) = 1._r8 + endif + enddo + enddo + enddo + else + ! eventually, when we are done with archaic versions, This set of code will become the default. + do i = 1, Nday + do k = 1, rrtmg_levs-1 + kk=(pverp-rrtmg_levs) + k + do ns = 1, nbndsw + if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then + fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8) + asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8) + else + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + endif + + tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk) + if (tauc_sw(ns,i,k) > 0._r8) then + ssac_sw(ns,i,k)=max(E_cld_tau_w(ns,IdxDay(i),kk),1.e-80_r8)/max(tauc_sw(ns,i,k),1.e-80_r8) + else + tauc_sw(ns,i,k) = 0._r8 + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + ssac_sw(ns,i,k) = 1._r8 + endif + enddo + enddo + enddo + endif + else + do i = 1, Nday + do k = 1, rrtmg_levs-1 + kk=(pverp-rrtmg_levs) + k + do ns = 1, nbndsw + if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then + fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8) + asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8) + else + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + endif + + tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk) + if (tauc_sw(ns,i,k) > 0._r8) then + ssac_sw(ns,i,k)=max(E_cld_tau_w(ns,IdxDay(i),kk),1.e-80_r8)/max(tauc_sw(ns,i,k),1.e-80_r8) + else + tauc_sw(ns,i,k) = 0._r8 + fsfc_sw(ns,i,k) = 0._r8 + asmc_sw(ns,i,k) = 0._r8 + ssac_sw(ns,i,k) = 1._r8 + endif + enddo + enddo + enddo + endif + + ! Call mcica sub-column generator for RRTMG_SW + + ! Call sub-column generator for McICA in radiation + call t_startf('mcica_subcol_sw') + + ! Set permute seed (must be offset between LW and SW by at least 140 to insure + ! effective randomization) + permuteseed = 1 + + + call mcica_subcol_sw(lchnk, Nday, rrtmg_levs-1, icld, permuteseed, pmid, & + cld, cicewp, cliqwp, rei, rel, tauc_sw, ssac_sw, asmc_sw, fsfc_sw, & + cld_stosw, cicewp_stosw, cliqwp_stosw, rei_stosw, rel_stosw, & + tauc_stosw, ssac_stosw, asmc_stosw, fsfc_stosw) + + call t_stopf('mcica_subcol_sw') + + call t_startf('rrtmg_sw') + + ! Call RRTMG_SW for all layers for daylight columns + + + ! Set day of year for Earth/Sun distance calculation in rrtmg_sw, or + ! set to zero and pass E/S adjustment (eccf) directly into array adjes + dyofyr = 0 + + tsfc(:ncol) = tlev(:ncol,rrtmg_levs+1) + + solvar(1:nbndsw) = sfac(1:nbndsw) + + call rrtmg_sw(lchnk, Nday, rrtmg_levs, icld, & + pmidmb, pintmb, tlay, tlev, tsfc, & + h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, & + asdir, asdif, aldir, aldif, & + coszrs, eccf, dyofyr, solvar, & + cld_stosw, tauc_stosw, ssac_stosw, asmc_stosw, fsfc_stosw, & + cicewp_stosw, cliqwp_stosw, rei, rel, & + tau_aer_sw, ssa_aer_sw, asm_aer_sw, & + swuflx, swdflx, swhr, swuflxc, swdflxc, swhrc, & + dirdnuv, dirdnir, difdnuv, difdnir, ninflx, ninflxc, swuflxs, swdflxs) + + ! Flux units are in W/m2 on output from rrtmg_sw and contain output for + ! extra layer above model top with vertical indexing from bottom to top. + ! + ! Heating units are in J/kg/s on output from rrtmg_sw and contain output + ! for extra layer above model top with vertical indexing from bottom to top. + ! + ! Reverse vertical indexing to go from top to bottom for CAM output. + + ! Set the net absorted shortwave flux at TOA (top of extra layer) + fsntoa(1:Nday) = swdflx(1:Nday,rrtmg_levs+1) - swuflx(1:Nday,rrtmg_levs+1) + fsutoa(1:Nday) = swuflx(1:Nday,rrtmg_levs+1) + fsntoac(1:Nday) = swdflxc(1:Nday,rrtmg_levs+1) - swuflxc(1:Nday,rrtmg_levs+1) + + ! Set net near-IR flux at top of the model + fsnirtoa(1:Nday) = ninflx(1:Nday,rrtmg_levs) + fsnrtoaq(1:Nday) = ninflx(1:Nday,rrtmg_levs) + fsnrtoac(1:Nday) = ninflxc(1:Nday,rrtmg_levs) + + ! Set the net absorbed shortwave flux at the model top level + fsnt(1:Nday) = swdflx(1:Nday,rrtmg_levs) - swuflx(1:Nday,rrtmg_levs) + fsntc(1:Nday) = swdflxc(1:Nday,rrtmg_levs) - swuflxc(1:Nday,rrtmg_levs) + + ! Set the downwelling flux at the surface + fsds(1:Nday) = swdflx(1:Nday,1) + fsdsc(1:Nday) = swdflxc(1:Nday,1) + + ! Set the net shortwave flux at the surface + fsns(1:Nday) = swdflx(1:Nday,1) - swuflx(1:Nday,1) + fsnsc(1:Nday) = swdflxc(1:Nday,1) - swuflxc(1:Nday,1) + + ! Set the UV/vis and near-IR direct and dirruse downward shortwave flux at surface + sols(1:Nday) = dirdnuv(1:Nday,1) + soll(1:Nday) = dirdnir(1:Nday,1) + solsd(1:Nday) = difdnuv(1:Nday,1) + solld(1:Nday) = difdnir(1:Nday,1) + + + ! Set the net, up and down fluxes at model interfaces + fns (1:Nday,pverp-rrtmg_levs+1:pverp) = swdflx(1:Nday,rrtmg_levs:1:-1) - swuflx(1:Nday,rrtmg_levs:1:-1) + fcns(1:Nday,pverp-rrtmg_levs+1:pverp) = swdflxc(1:Nday,rrtmg_levs:1:-1) - swuflxc(1:Nday,rrtmg_levs:1:-1) + fus (1:Nday,pverp-rrtmg_levs+1:pverp) = swuflx(1:Nday,rrtmg_levs:1:-1) + fusc(1:Nday,pverp-rrtmg_levs+1:pverp) = swuflxc(1:Nday,rrtmg_levs:1:-1) + fds (1:Nday,pverp-rrtmg_levs+1:pverp) = swdflx(1:Nday,rrtmg_levs:1:-1) + fdsc(1:Nday,pverp-rrtmg_levs+1:pverp) = swdflxc(1:Nday,rrtmg_levs:1:-1) + + ! Set solar heating, reverse layering + ! Pass shortwave heating to CAM arrays and convert from K/d to J/kg/s + qrs (1:Nday,pverp-rrtmg_levs+1:pver) = swhr (1:Nday,rrtmg_levs-1:1:-1)*cpair*dps + qrsc(1:Nday,pverp-rrtmg_levs+1:pver) = swhrc(1:Nday,rrtmg_levs-1:1:-1)*cpair*dps + + ! Set spectral fluxes, reverse layering + ! order=(/3,1,2/) maps the first index of swuflxs to the third index of su. + if (associated(su)) then + su(1:Nday,pverp-rrtmg_levs+1:pverp,:) = reshape(swuflxs(:,1:Nday,rrtmg_levs:1:-1), & + (/Nday,rrtmg_levs,nbndsw/), order=(/3,1,2/)) + end if + + if (associated(sd)) then + sd(1:Nday,pverp-rrtmg_levs+1:pverp,:) = reshape(swdflxs(:,1:Nday,rrtmg_levs:1:-1), & + (/Nday,rrtmg_levs,nbndsw/), order=(/3,1,2/)) + end if + + call t_stopf('rrtmg_sw') + + ! Rearrange output arrays. + ! + ! intent(out) + + call ExpDayNite(solin, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(qrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call ExpDayNite(qrsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver) + call ExpDayNite(fns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fcns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fsns, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnt, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsutoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsds, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsdsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntc, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsntoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(sols, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(soll, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(solsd, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(solld, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnirtoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnrtoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + call ExpDayNite(fsnrtoaq, Nday, IdxDay, Nnite, IdxNite, 1, pcols) + + if (associated(su)) then + call ExpDayNite(su, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp, 1, nbndsw) + end if + + if (associated(sd)) then + call ExpDayNite(sd, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp, 1, nbndsw) + end if + + ! these outfld calls don't work for spmd only outfield in scm mode (nonspmd) + if (single_column .and. scm_crm_mode) then + ! Following outputs added for CRM + call ExpDayNite(fus,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fds,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fusc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call ExpDayNite(fdsc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp) + call outfld('FUS ', fus, pcols, lchnk) + call outfld('FDS ', fds, pcols, lchnk) + call outfld('FUSC ', fusc, pcols, lchnk) + call outfld('FDSC ', fdsc, pcols, lchnk) + endif + +end subroutine rad_rrtmg_sw + +!------------------------------------------------------------------------------- + +subroutine radsw_init() +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize various constants for radiation scheme. +! +!----------------------------------------------------------------------- + use radconstants, only: get_solar_band_fraction_irrad, get_ref_solar_band_irrad + + ! get the reference fractional solar irradiance in each band + call get_solar_band_fraction_irrad(fractional_solar_irradiance) + call get_ref_solar_band_irrad( solar_band_irrad ) + + + ! Initialize rrtmg_sw + call rrtmg_sw_ini + +end subroutine radsw_init + + +!------------------------------------------------------------------------------- + +end module radsw diff --git a/src/physics/rrtmg/rrtmg_state.F90 b/src/physics/rrtmg/rrtmg_state.F90 new file mode 100644 index 0000000000..c481fc82d6 --- /dev/null +++ b/src/physics/rrtmg/rrtmg_state.F90 @@ -0,0 +1,272 @@ +!-------------------------------------------------------------------------------- +! Manages the absorber concentrations in the layers RRTMG operates +! including an extra layer over the model if needed. +! +! Creator: Francis Vitt +! 9 May 2011 +!-------------------------------------------------------------------------------- +module rrtmg_state + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use cam_history, only: outfld + + implicit none + private + save + + public :: rrtmg_state_t + public :: rrtmg_state_init + public :: rrtmg_state_create + public :: rrtmg_state_update + public :: rrtmg_state_destroy + public :: num_rrtmg_levs + + type rrtmg_state_t + + real(r8), allocatable :: h2ovmr(:,:) ! h2o volume mixing ratio + real(r8), allocatable :: o3vmr(:,:) ! o3 volume mixing ratio + real(r8), allocatable :: co2vmr(:,:) ! co2 volume mixing ratio + real(r8), allocatable :: ch4vmr(:,:) ! ch4 volume mixing ratio + real(r8), allocatable :: o2vmr(:,:) ! o2 volume mixing ratio + real(r8), allocatable :: n2ovmr(:,:) ! n2o volume mixing ratio + real(r8), allocatable :: cfc11vmr(:,:) ! cfc11 volume mixing ratio + real(r8), allocatable :: cfc12vmr(:,:) ! cfc12 volume mixing ratio + real(r8), allocatable :: cfc22vmr(:,:) ! cfc22 volume mixing ratio + real(r8), allocatable :: ccl4vmr(:,:) ! ccl4 volume mixing ratio + + real(r8), allocatable :: pmidmb(:,:) ! Level pressure (hPa) + real(r8), allocatable :: pintmb(:,:) ! Model interface pressure (hPa) + real(r8), allocatable :: tlay(:,:) ! mid point temperature + real(r8), allocatable :: tlev(:,:) ! interface temperature + + end type rrtmg_state_t + + integer :: num_rrtmg_levs ! number of pressure levels greate than 1.e-4_r8 mbar + + real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor + real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide + real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone + real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane + real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide + real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen + real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 + real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 + +contains + +!-------------------------------------------------------------------------------- +! sets the number of model levels RRTMG operates +!-------------------------------------------------------------------------------- + subroutine rrtmg_state_init + + use ref_pres,only : pref_edge + implicit none + + ! The following cuts off RRTMG at roughly the point where it becomes + ! invalid due to low pressure. + num_rrtmg_levs = count( pref_edge(:) > 1._r8 ) ! pascals (1.e-2 mbar) + + end subroutine rrtmg_state_init + +!-------------------------------------------------------------------------------- +! creates (alloacates) an rrtmg_state object +!-------------------------------------------------------------------------------- + + function rrtmg_state_create( pstate, cam_in ) result( rstate ) + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + use physconst, only: stebol + + implicit none + + type(physics_state), intent(in) :: pstate + type(cam_in_t), intent(in) :: cam_in + + type(rrtmg_state_t), pointer :: rstate + + real(r8) dy ! Temporary layer pressure thickness + real(r8) :: tint(pcols,pverp) ! Model interface temperature + integer :: ncol, i, kk, k + + allocate( rstate ) + + allocate( rstate%h2ovmr(pcols,num_rrtmg_levs) ) + allocate( rstate%o3vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%co2vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%ch4vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%o2vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%n2ovmr(pcols,num_rrtmg_levs) ) + allocate( rstate%cfc11vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%cfc12vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%cfc22vmr(pcols,num_rrtmg_levs) ) + allocate( rstate%ccl4vmr(pcols,num_rrtmg_levs) ) + + allocate( rstate%pmidmb(pcols,num_rrtmg_levs) ) + allocate( rstate%pintmb(pcols,num_rrtmg_levs+1) ) + allocate( rstate%tlay(pcols,num_rrtmg_levs) ) + allocate( rstate%tlev(pcols,num_rrtmg_levs+1) ) + + ncol = pstate%ncol + + ! Calculate interface temperatures (following method + ! used in radtpl for the longwave), using surface upward flux and + ! stebol constant in mks units + do i = 1,ncol + tint(i,1) = pstate%t(i,1) + tint(i,pverp) = sqrt(sqrt(cam_in%lwup(i)/stebol)) + do k = 2,pver + dy = (pstate%lnpint(i,k) - pstate%lnpmid(i,k)) / (pstate%lnpmid(i,k-1) - pstate%lnpmid(i,k)) + tint(i,k) = pstate%t(i,k) - dy * (pstate%t(i,k) - pstate%t(i,k-1)) + end do + end do + + do k = 1, num_rrtmg_levs + + kk = max(k + (pverp-num_rrtmg_levs)-1,1) + + rstate%pmidmb(:ncol,k) = pstate%pmid(:ncol,kk) * 1.e-2_r8 + rstate%pintmb(:ncol,k) = pstate%pint(:ncol,kk) * 1.e-2_r8 + + rstate%tlay(:ncol,k) = pstate%t(:ncol,kk) + rstate%tlev(:ncol,k) = tint(:ncol,kk) + + enddo + + ! bottom interface + rstate%pintmb(:ncol,num_rrtmg_levs+1) = pstate%pint(:ncol,pverp) * 1.e-2_r8 ! mbar + rstate%tlev(:ncol,num_rrtmg_levs+1) = tint(:ncol,pverp) + + ! top layer thickness + if (num_rrtmg_levs==pverp) then + rstate%pmidmb(:ncol,1) = 0.5_r8 * rstate%pintmb(:ncol,2) + rstate%pintmb(:ncol,1) = 1.e-4_r8 ! mbar + endif + + endfunction rrtmg_state_create + +!-------------------------------------------------------------------------------- +! updates the concentration fields +!-------------------------------------------------------------------------------- + subroutine rrtmg_state_update(pstate,pbuf,icall,rstate) + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use rad_constituents, only: rad_cnst_get_gas + + implicit none + + type(physics_state), intent(in), target :: pstate + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: icall ! index through climate/diagnostic radiation calls + type(rrtmg_state_t), pointer :: rstate + + real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity + real(r8), pointer, dimension(:,:) :: n2o ! nitrous oxide mass mixing ratio + real(r8), pointer, dimension(:,:) :: ch4 ! methane mass mixing ratio + real(r8), pointer, dimension(:,:) :: o2 ! O2 mass mixing ratio + real(r8), pointer, dimension(:,:) :: cfc11 ! cfc11 mass mixing ratio + real(r8), pointer, dimension(:,:) :: cfc12 ! cfc12 mass mixing ratio + real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio + real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio + + integer :: ncol, i, kk, k, lchnk + real(r8) :: H, P_top, P_surface + real(r8), dimension(pcols) :: P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + ncol = pstate%ncol + lchnk = pstate%lchnk + + ! Get specific humidity + call rad_cnst_get_gas(icall,'H2O', pstate, pbuf, sp_hum) + ! Get oxygen mass mixing ratio. + call rad_cnst_get_gas(icall,'O2', pstate, pbuf, o2) + ! Get ozone mass mixing ratio. + call rad_cnst_get_gas(icall,'O3', pstate, pbuf, o3) + ! Get CO2 mass mixing ratio + call rad_cnst_get_gas(icall,'CO2', pstate, pbuf, co2) + ! Get N2O mass mixing ratio + call rad_cnst_get_gas(icall,'N2O', pstate, pbuf, n2o) + ! Get CH4 mass mixing ratio + call rad_cnst_get_gas(icall,'CH4', pstate, pbuf, ch4) + ! Get CFC mass mixing ratios + call rad_cnst_get_gas(icall,'CFC11', pstate, pbuf, cfc11) + call rad_cnst_get_gas(icall,'CFC12', pstate, pbuf, cfc12) + + do k = 1, num_rrtmg_levs + + kk = max(k + (pverp-num_rrtmg_levs)-1,1) + + rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm + rstate%h2ovmr(:ncol,k) = (sp_hum(:ncol,kk) / (1._r8 - sp_hum(:ncol,kk))) * amdw + rstate%o3vmr(:ncol,k) = o3(:ncol,kk) * amdo + rstate%co2vmr(:ncol,k) = co2(:ncol,kk) * amdc + rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm + rstate%o2vmr(:ncol,k) = o2(:ncol,kk) * amdo2 + rstate%n2ovmr(:ncol,k) = n2o(:ncol,kk) * amdn + rstate%cfc11vmr(:ncol,k) = cfc11(:ncol,kk) * amdc1 + rstate%cfc12vmr(:ncol,k) = cfc12(:ncol,kk) * amdc2 + rstate%cfc22vmr(:ncol,k) = 0._r8 + rstate%ccl4vmr(:ncol,k) = 0._r8 + + enddo + + ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone + ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at + ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning + ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. + + P_top = 50.0_r8 ! pressure (Pa) at which we assume O3 = 0 in linear decay from CAM top + P_int(:ncol) = pstate%pint(:ncol,1) ! pressure (Pa) at upper interface of CAM + P_mid(:ncol) = pstate%pmid(:ncol,1) ! pressure (Pa) at midpoint of top layer of CAM + alpha(:) = 0.0_r8 + beta(:) = 0.0_r8 + alpha(:ncol) = log(P_int(:ncol)/P_top) + beta(:ncol) = log(P_mid(:ncol)/P_int(:ncol))/log(P_mid(:ncol)/P_top) + + a(:ncol) = ( (1._r8 + alpha(:ncol)) * exp(-alpha(:ncol)) - 1._r8 ) / alpha(:ncol) + b(:ncol) = 1_r8 - exp(-alpha(:ncol)) + + where(alpha .gt. 0) ! only apply where top level is below 80 km + chi_mid(:) = o3(:,1)*amdo ! molar mixing ratio of O3 at midpoint of top layer + chi_0(:) = chi_mid(:) / (1._r8 + beta(:)) + chi_eff(:) = chi_0(:) * (a(:) + b(:)) + rstate%o3vmr(:,1) = chi_eff(:) + chi_eff(:) = chi_eff(:) * P_int(:) / amdo / 9.8 ! O3 column above in kg m-2 + chi_eff(:) = chi_eff(:) / 2.1415e-5 ! O3 column above in DU + endwhere + + call outfld('O3colAbove', chi_eff(:ncol), pcols, lchnk) + + end subroutine rrtmg_state_update + +!-------------------------------------------------------------------------------- +! de-allocates an rrtmg_state object +!-------------------------------------------------------------------------------- + subroutine rrtmg_state_destroy(rstate) + + implicit none + + type(rrtmg_state_t), pointer :: rstate + + deallocate(rstate%h2ovmr) + deallocate(rstate%o3vmr) + deallocate(rstate%co2vmr) + deallocate(rstate%ch4vmr) + deallocate(rstate%o2vmr) + deallocate(rstate%n2ovmr) + deallocate(rstate%cfc11vmr) + deallocate(rstate%cfc12vmr) + deallocate(rstate%cfc22vmr) + deallocate(rstate%ccl4vmr) + + deallocate(rstate%pmidmb) + deallocate(rstate%pintmb) + deallocate(rstate%tlay) + deallocate(rstate%tlev) + + deallocate( rstate ) + nullify(rstate) + + endsubroutine rrtmg_state_destroy + +end module rrtmg_state diff --git a/src/physics/rrtmg/slingo.F90 b/src/physics/rrtmg/slingo.F90 new file mode 100644 index 0000000000..aedb44bcee --- /dev/null +++ b/src/physics/rrtmg/slingo.F90 @@ -0,0 +1,409 @@ +module slingo + +!------------------------------------------------------------------------------------------------ +! Implements Slingo Optics for MG/RRTMG for liquid clouds and +! a copy of the old cloud routine for reference +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld + +implicit none +private +save + +public :: & + slingo_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + slingo_liq_get_rad_props_lw, & + slingo_liq_optics_sw + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: iclwp_idx = 0 + integer :: iciwp_idx = 0 + integer :: cld_idx = 0 + integer :: rel_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldliq, & ! cloud liquid water index + ixcldice ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine slingo_rad_props_init() + +! use cam_history, only: addfld + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use cam_logfile, only: iulog + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') + !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') + !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') + + !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') + !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') + + !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') + !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') + + return + +end subroutine slingo_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + call slingo_liq_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldliqwp=.true. ) + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + ! rad properties for liquid clouds + real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + call slingo_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.true.) + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== +! Private methods +!============================================================================== + + +subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldliqwp + + real(r8), pointer, dimension(:,:) :: rel + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cliqwp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + ! A. Slingo's data for cloud particle radiative properties (from 'A GCM + ! Parameterization for the Shortwave Properties of Water Clouds' JAS + ! vol. 46 may 1989 pp 1419-1427) + real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth + (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth + (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo + (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo + (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter + (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter + (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band + + ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor + ! greater than 20 micro-meters + + integer :: ns, i, k, indxsl, Nday + integer :: i_rel, lchnk, icld, itim_old + real(r8) :: tmp1l, tmp2l, tmp3l, g + real(r8) :: kext(pcols,pver) + real(r8), pointer, dimension(:,:) :: iclwpth + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rel_idx, rel) + + if (oldliqwp) then + do k=1,pver + do i = 1,Nday + cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iclwp_idx<=0) then + call endrun('slingo_liq_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') + endif + ! The following is the eventual target specification for in cloud liquid water path. + call pbuf_get_field(pbuf, iclwp_idx, tmpptr) + cliqwp = tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + ! Set cloud extinction optical depth, single scatter albedo, + ! asymmetry parameter, and forward scattered fraction: + abarli = abarl(indxsl) + bbarli = bbarl(indxsl) + cbarli = cbarl(indxsl) + dbarli = dbarl(indxsl) + ebarli = ebarl(indxsl) + fbarli = fbarl(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l + else + liq_tau(ns,i,k) = 0.0_r8 + endif + + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) + g = ebarli + tmp3l + liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g + liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + + !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) + !call outfld('REL_OLD',rel(:,:), pcols, lchnk) + !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) + !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) + + +end subroutine slingo_liq_optics_sw + +subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, icld, itim_old, i_rei, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('slingo_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp (i,k) = 1000.0_r8 * iclwpth(i,k) + 1000.0_r8 * iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8, cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabs = kabsl*(1._r8-ficemr(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + +end subroutine slingo_liq_get_rad_props_lw + +end module slingo diff --git a/src/physics/simple/held_suarez.F90 b/src/physics/simple/held_suarez.F90 new file mode 100644 index 0000000000..b624dc9724 --- /dev/null +++ b/src/physics/simple/held_suarez.F90 @@ -0,0 +1,166 @@ +module held_suarez + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + save + + public :: held_suarez_1994_init + public :: held_suarez_1994 + + !! + !! Forcing parameters + !! + real(r8), parameter :: efoldf = 1._r8 ! efolding time for wind dissipation + real(r8), parameter :: efolda = 40._r8 ! efolding time for T dissipation + real(r8), parameter :: efolds = 4._r8 ! efolding time for T dissipation + real(r8), parameter :: sigmab = 0.7_r8 ! threshold sigma level + real(r8), parameter :: t00 = 200._r8 ! minimum reference temperature + real(r8), parameter :: kf = 1._r8/(86400._r8*efoldf) ! 1./efolding_time for wind dissipation + + real(r8), parameter :: onemsig = 1._r8 - sigmab ! 1. - sigma_reference + + real(r8), parameter :: ka = 1._r8/(86400._r8 * efolda) ! 1./efolding_time for temperature diss. + real(r8), parameter :: ks = 1._r8/(86400._r8 * efolds) + + !! + !! Model constants, reset in init call + !! + real(r8) :: cappa = 2.0_r8 / 7.0_r8 ! R/Cp + real(r8) :: cpair = 1004.0_r8 ! specific heat of dry air (J/K/kg) + real(r8) :: psurf_ref = 0.0_r8 ! Surface pressure + ! pref_mid_norm are layer midpoints normalized by surface pressure ('eta' coordinate) + real(r8), allocatable :: pref_mid_norm(:) + integer :: pver ! Num vertical levels + + + +!======================================================================= +contains +!======================================================================= + + subroutine held_suarez_1994_init(cappa_in, cpair_in, psurf_ref_in, pref_mid_norm_in) + !! Dummy arguments + real(r8), intent(in) :: cappa_in + real(r8), intent(in) :: cpair_in + real(r8), intent(in) :: psurf_ref_in + real(r8), intent(in) :: pref_mid_norm_in(:) + + pver = size(pref_mid_norm_in) + allocate(pref_mid_norm(pver)) + cappa = cappa_in + cpair = cpair_in + psurf_ref = psurf_ref_in + pref_mid_norm = pref_mid_norm_in + + end subroutine held_suarez_1994_init + + subroutine held_suarez_1994(pcols, ncol, clat, pmid, & + u, v, t, du, dv, s) + !----------------------------------------------------------------------- + ! + ! Purpose: Implement idealized Held-Suarez forcings + ! Held, I. M., and M. J. Suarez, 1994: 'A proposal for the + ! intercomparison of the dynamical cores of atmospheric general + ! circulation models.' + ! Bulletin of the Amer. Meteor. Soc., vol. 75, pp. 1825-1830. + ! + !----------------------------------------------------------------------- + + ! + ! Input arguments + ! + integer, intent(in) :: pcols ! Size of column dimension + integer, intent(in) :: ncol ! Num active columns + real(r8), intent(in) :: clat(pcols) ! latitudes(radians) for columns + real(r8), intent(in) :: pmid(pcols,pver) ! mid-point pressure + real(r8), intent(in) :: u(pcols,pver) ! Zonal wind (m/s) + real(r8), intent(in) :: v(pcols,pver) ! Meridional wind (m/s) + real(r8), intent(in) :: t(pcols,pver) ! Temperature (K) + ! + ! Output arguments + ! + real(r8), intent(out) :: du(pcols,pver) ! Zonal wind tend + real(r8), intent(out) :: dv(pcols,pver) ! Meridional wind tend + real(r8), intent(out) :: s(pcols,pver) ! Heating rate + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i, k ! Longitude, level indices + + real(r8) :: kv ! 1./efolding_time (normalized) for wind + real(r8) :: kt ! 1./efolding_time for temperature diss. + real(r8) :: trefa ! "radiative equilibrium" T + real(r8) :: trefc ! used in calc of "radiative equilibrium" T + real(r8) :: cossq(ncol) ! coslat**2 + real(r8) :: cossqsq(ncol) ! coslat**4 + real(r8) :: sinsq(ncol) ! sinlat**2 + real(r8) :: coslat(ncol) ! cosine(latitude) + ! + !----------------------------------------------------------------------- + ! + + do i = 1, ncol + coslat (i) = cos(clat(i)) + sinsq (i) = sin(clat(i))*sin(clat(i)) + cossq (i) = coslat(i)*coslat(i) + cossqsq(i) = cossq (i)*cossq (i) + end do + + ! + !----------------------------------------------------------------------- + ! + ! Held/Suarez IDEALIZED physics algorithm: + ! + ! Held, I. M., and M. J. Suarez, 1994: A proposal for the + ! intercomparison of the dynamical cores of atmospheric general + ! circulation models. + ! Bulletin of the Amer. Meteor. Soc., vol. 75, pp. 1825-1830. + ! + !----------------------------------------------------------------------- + ! + ! Compute idealized radiative heating rates (as dry static energy) + ! + ! + do k = 1, pver + if (pref_mid_norm(k) > sigmab) then + do i = 1, ncol + kt = ka + (ks - ka)*cossqsq(i)*(pref_mid_norm(k) - sigmab)/onemsig + trefc = 315._r8 - (60._r8 * sinsq(i)) + trefa = (trefc - 10._r8*cossq(i)*log((pmid(i,k)/psurf_ref)))*(pmid(i,k)/psurf_ref)**cappa + trefa = max(t00,trefa) + s(i,k) = (trefa - t(i,k))*kt*cpair + end do + else + do i = 1, ncol + trefc = 315._r8 - 60._r8*sinsq(i) + trefa = (trefc - 10._r8*cossq(i)*log((pmid(i,k)/psurf_ref)))*(pmid(i,k)/psurf_ref)**cappa + trefa = max(t00,trefa) + s(i,k) = (trefa - t(i,k))*ka*cpair + end do + end if + end do + ! + ! Add diffusion near the surface for the wind fields + ! + do k = 1, pver + do i = 1, pcols + du(i,k) = 0._r8 + dv(i,k) = 0._r8 + end do + end do + + ! + do k = 1, pver + if (pref_mid_norm(k) > sigmab) then + kv = kf*(pref_mid_norm(k) - sigmab)/onemsig + do i = 1, ncol + du(i,k) = -kv*u(i,k) + dv(i,k) = -kv*v(i,k) + end do + end if + end do + + end subroutine held_suarez_1994 + +end module held_suarez diff --git a/src/physics/simple/held_suarez_cam.F90 b/src/physics/simple/held_suarez_cam.F90 new file mode 100644 index 0000000000..5559c85c81 --- /dev/null +++ b/src/physics/simple/held_suarez_cam.F90 @@ -0,0 +1,114 @@ +#define MODHS 1 +#undef MODHS +module held_suarez_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + + implicit none + private + save + + public :: held_suarez_init, held_suarez_tend + + real(r8), parameter :: efoldf = 1._r8 ! efolding time for wind dissipation + real(r8), parameter :: efolda = 40._r8 ! efolding time for T dissipation + real(r8), parameter :: efolds = 4._r8 ! efolding time for T dissipation + real(r8), parameter :: sigmab = 0.7_r8 ! threshold sigma level + real(r8), parameter :: t00 = 200._r8 ! minimum reference temperature + real(r8), parameter :: kf = 1._r8/(86400._r8*efoldf) ! 1./efolding_time for wind dissipation + + real(r8), parameter :: onemsig = 1._r8 - sigmab ! 1. - sigma_reference + + real(r8), parameter :: ka = 1._r8/(86400._r8 * efolda) ! 1./efolding_time for temperature diss. + real(r8), parameter :: ks = 1._r8/(86400._r8 * efolds) + +!======================================================================= +contains +!======================================================================= + + subroutine held_suarez_init(pbuf2d) + use physics_buffer, only: physics_buffer_desc + use cam_history, only: addfld, add_default + use physconst, only: cappa, cpair + use ref_pres, only: pref_mid_norm, psurf_ref + use held_suarez, only: held_suarez_1994_init + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Set model constant values + call held_suarez_1994_init(cappa, cpair, psurf_ref, pref_mid_norm) + + ! This field is added by radiation when full physics is used + call addfld('QRS', (/ 'lev' /), 'A', 'K/s', & + 'Temperature tendency associated with the relaxation toward the equilibrium temperature profile') + call add_default('QRS', 1, ' ') + end subroutine held_suarez_init + + subroutine held_suarez_tend(state, ptend, ztodt) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! algorithm 1: Held/Suarez IDEALIZED physics + ! algorithm 2: Held/Suarez IDEALIZED physics (Williamson modified stratosphere + ! algorithm 3: Held/Suarez IDEALIZED physics (Lin/Williamson modified strato/meso-sphere + ! + ! Author: J. Olson + ! + !----------------------------------------------------------------------- + use physconst, only: cpairv + use phys_grid, only: get_rlat_all_p + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init + use cam_abortutils, only: endrun + use cam_history, only: outfld + use held_suarez, only: held_suarez_1994 + + ! + ! Input arguments + ! + type(physics_state), intent(inout) :: state + real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) + ! + ! Output argument + ! + type(physics_ptend), intent(out) :: ptend ! Package tendencies + ! + !---------------------------Local workspace----------------------------- + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + real(r8) :: clat(pcols) ! latitudes(radians) for columns + real(r8) :: pmid(pcols,pver) ! mid-point pressure + integer :: i, k ! Longitude, level indices + + ! + !----------------------------------------------------------------------- + ! + + lchnk = state%lchnk + ncol = state%ncol + + call get_rlat_all_p(lchnk, ncol, clat) + do k = 1, pver + do i = 1, ncol + pmid(i,k) = state%pmid(i,k) + end do + end do + + ! initialize individual parameterization tendencies + call physics_ptend_init(ptend, state%psetcols, 'held_suarez', ls=.true., lu=.true., lv=.true.) + + call held_suarez_1994(pcols, ncol, clat, state%pmid, & + state%u, state%v, state%t, ptend%u, ptend%v, ptend%s) + + ! Note, we assume that there are no subcolumns in simple physics + pmid(:ncol,:) = ptend%s(:ncol, :)/cpairv(:ncol,:,lchnk) + if (pcols > ncol) then + pmid(ncol+1:,:) = 0.0_r8 + end if + call outfld('QRS', pmid, pcols, lchnk) + + end subroutine held_suarez_tend + +end module held_suarez_cam diff --git a/src/physics/simple/kessler_cam.F90 b/src/physics/simple/kessler_cam.F90 new file mode 100644 index 0000000000..52d79b637e --- /dev/null +++ b/src/physics/simple/kessler_cam.F90 @@ -0,0 +1,196 @@ +module kessler_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + + implicit none + private + save + + public :: kessler_register, kessler_init, kessler_tend + + integer :: ixcldliq = -1 ! cloud liquid mixing ratio index + integer :: ixrain = -1 ! rain liquid mixing ratio index + +!======================================================================= +contains +!======================================================================= + + subroutine kessler_register() + use physconst, only: cpair, mwh2o + use constituents, only: cnst_add + + ! Add liquid constituents + call cnst_add('CLDLIQ', mwh2o, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add('RAINQM', mwh2o, cpair, 0._r8, ixrain, & + longname='Grid box averaged rain water amount', is_convtran1=.true.) + + end subroutine kessler_register + + subroutine kessler_init(pbuf2d) + use physics_buffer, only: physics_buffer_desc + use physconst, only: cpair, latvap,pstd, rair, rhoh2o + use constituents, only: cnst_name, cnst_longname, bpcnst, apcnst + use cam_history, only: addfld, add_default, horiz_only + use kessler_mod, only: kessler_set_const + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! mass mixing ratios + call addfld(cnst_name(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_longname(ixcldliq))) + call addfld(cnst_name(ixrain) , (/ 'lev' /), 'A', 'kg/kg', trim(cnst_longname(ixrain))) + call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_longname(ixcldliq))//' (before physics)') + call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_longname(ixcldliq))//' (after physics)') + + call add_default(cnst_name(ixcldliq), 1, ' ') + call add_default(cnst_name(ixrain), 1, ' ') + + ! Initialize Kessler with CAM physical constants + call kessler_set_const(rair, cpair, latvap, pstd/100.0_r8, rhoh2o) + + end subroutine kessler_init + + subroutine kessler_tend(state, ptend, ztodt, surf_state, precl) + !----------------------------------------------------------------------- + ! + ! Purpose: Run Kessler physics (see kessler.F90) + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: SHR_KIND_CM + use physconst, only: cpair, rair, zvir + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init + use constituents, only: pcnst, cnst_name, cnst_type + use camsrfexch, only: cam_out_t + use cam_abortutils, only: endrun + use cam_history, only: outfld + use kessler_mod, only: kessler + + ! + ! Input arguments + ! + type(physics_state), intent(inout) :: state + real(r8), intent(in) :: ztodt ! physics timestep + ! + ! Output arguments + ! + type(physics_ptend), intent(out) :: ptend ! Package tendencies + ! + type(cam_out_t), intent(inout) :: surf_state ! Surface fluxes + real(r8), pointer :: precl(:) ! Precip. (pcols) + + !---------------------------Local workspace----------------------------- + ! + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + real(r8) :: pmid(pcols,pver) ! mid-point pressure + real(r8) :: rho(pcols,pver) ! Dry air density + real(r8) :: pk(pcols,pver) ! exner func. + real(r8) :: th(pcols,pver) ! Potential temp. + real(r8) :: qv(pcols,pver) ! Water vapor + real(r8) :: qc(pcols,pver) ! Cloud water + real(r8) :: qr(pcols,pver) ! Rain water + real(r8) :: z(pcols,pver) ! height + real(r8) :: wet_to_dry(pcols)! factor to convert from wet to dry mixing ratio + real(r8) :: dry_to_wet(pcols)! factor to convert from dry to wet mixing ratio + integer :: k,rk ! vert. indices + logical :: lq(pcnst) ! Calc tendencies? + character(len=SHR_KIND_CM) :: errmsg + + integer :: i + + ! + !----------------------------------------------------------------------- + ! + lchnk = state%lchnk + ncol = state%ncol + + ! initialize individual parameterization tendencies + lq = .false. + lq(1) = .true. + lq(ixcldliq) = .true. + lq(ixrain) = .true. + call physics_ptend_init(ptend, state%psetcols, 'kessler', & + ls=.true., lu=.true., lv=.true., lq=lq) + + do k=1,pver + state%exner(:ncol,k) = (state%pmid(:ncol,k)/1.e5_r8)**(rair/cpair) !exner + end do + + do k = 1, pver + rk = pver - k + 1 + rho(:ncol,rk) = state%pmiddry(:ncol,k)/(rair*state%t(:ncol,k)) + pk(:ncol,rk) = state%exner(:ncol,k) + ! Create temporaries for state variables changed by Kessler routine + th(:ncol,rk) = state%t(:ncol,k) / state%exner(:ncol,k) + z(:ncol,rk) = state%zm(:ncol,k) + qv(:ncol,rk) = state%q(:ncol,k,1) + qc(:ncol,rk) = state%q(:ncol,k,ixcldliq) + qr(:ncol,rk) = state%q(:ncol,k,ixrain) + ! + ! mixing ratios are wet - convert to dry for Kessler physics + ! + wet_to_dry(:ncol) = state%pdel(:ncol,k)/state%pdeldry(:ncol,k) + + if (cnst_type(1).eq.'wet') qv(:ncol,rk) = wet_to_dry(:ncol)*qv(:ncol,rk) + if (cnst_type(ixcldliq).eq.'wet') qc(:ncol,rk) = wet_to_dry(:ncol)*qc(:ncol,rk) + if (cnst_type(ixrain).eq.'wet') qr(:ncol,rk) = wet_to_dry(:ncol)*qr(:ncol,rk) + end do + + ! Kessler physics arguments + ! ncol: Number of columns + ! nz: Number of vertical levels + ! dt: Time step (s) (in) + ! rho: Dry air density (not mean state as in KW) (kg/m^3) (in) + ! z: Heights of thermo. levels in the grid column (m) (in) + ! pk: Exner function (p/p0)**(R/cp) (in) + ! th: Potential Temperature (K) (inout) + ! qv: Water vapor mixing ratio (gm/gm) (inout) + ! qc: Cloud water mixing ratio (gm/gm) (inout) + ! qr: Rain water mixing ratio (gm/gm) (inout) + ! precl: Precipitation rate (m_water / s) (out) + ! errmsg: Error string if error found + call kessler(ncol, pver, ztodt, rho(:ncol,:), z(:ncol,:), pk(:ncol,:), & + th(:ncol,:), qv(:ncol,:), qc(:ncol,:), qr(:ncol,:), precl(:ncol), errmsg) + + if (len_trim(errmsg) > 0) then + call endrun(trim(errmsg)) + end if + + do k = 1, pver + rk = pver - k + 1 + ! + ! mixing ratios are dry - convert to wet + ! + dry_to_wet(:ncol) = state%pdeldry(:ncol,k)/state%pdel(:ncol,k) + + if (cnst_type(1).eq.'wet') qv(:ncol,rk) = dry_to_wet(:ncol)*qv(:ncol,rk) + if (cnst_type(ixcldliq).eq.'wet') qc(:ncol,rk) = dry_to_wet(:ncol)*qc(:ncol,rk) + if (cnst_type(ixrain).eq.'wet') qr(:ncol,rk) = dry_to_wet(:ncol)*qr(:ncol,rk) + end do + + + ! Back out tendencies from updated fields + do k = 1, pver + rk = pver - k + 1 + ptend%s(:ncol,k) = (th(:ncol,rk)*state%exner(:ncol,k) - state%t(:ncol,k)) * cpair / ztodt + ptend%q(:ncol,k,1) = (qv(:ncol,rk) - state%q(:ncol,k,1)) / ztodt + ptend%q(:ncol,k,ixcldliq) = (qc(:ncol,rk) - state%q(:ncol,k,ixcldliq)) / ztodt + ptend%q(:ncol,k,ixrain) = (qr(:ncol,rk) - state%q(:ncol,k,ixrain)) / ztodt + end do + + ! Update precip + if (ncol < pcols) then + precl(ncol+1:pcols) = 0.0_r8 + qc(ncol+1:pcols,:) = 0.0_r8 + qr(ncol+1:pcols,:) = 0.0_r8 + end if + surf_state%precl(:ncol) = surf_state%precl(:ncol) + precl(:ncol) + + ! Output liquid tracers + call outfld(cnst_name(ixcldliq), qc(:,pver:1:-1), pcols, lchnk) + call outfld(cnst_name(ixrain ), qr(:,pver:1:-1), pcols, lchnk) + + end subroutine kessler_tend +end module kessler_cam diff --git a/src/physics/simple/kessler_mod.F90 b/src/physics/simple/kessler_mod.F90 new file mode 100644 index 0000000000..ceefd690fe --- /dev/null +++ b/src/physics/simple/kessler_mod.F90 @@ -0,0 +1,251 @@ +module kessler_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + save + + public :: kessler ! Main routine + public :: kessler_set_const ! Initialize physical constants + + ! Private module data (constants set at initialization) + real(r8) :: rd ! gas constant for dry air, J/(kgK) + real(r8) :: cp ! heat capacity at constant pressure, J/(kgK) + real(r8) :: lv ! latent heat of vaporization, J/kg + real(r8) :: psl ! reference pressure at sea level, mb + real(r8) :: rhoqr ! density of liquid water, kg/m^3 + +CONTAINS + + subroutine kessler_set_const(rd_in, cp_in, lv_in, psl_in, rhoqr_in) + ! Set physical constants to be consistent with calling model + real(r8), intent(in) :: rd_in ! gas constant for dry air, J/(kgK) + real(r8), intent(in) :: cp_in ! heat capacity at constant pres., J/(kgK) + real(r8), intent(in) :: lv_in ! latent heat of vaporization, J/kg + real(r8), intent(in) :: psl_in ! reference pressure at sea level, mb + real(r8), intent(in) :: rhoqr_in ! density of liquid water, kg/m^3 + + rd = rd_in + cp = cp_in + lv = lv_in + psl = psl_in + rhoqr = rhoqr_in + + end subroutine kessler_set_const + + !----------------------------------------------------------------------- + ! + ! Version: 2.0 + ! + ! Date: January 22nd, 2015 + ! + ! Change log: + ! v2 - Added sub-cycling of rain sedimentation so as not to violate + ! CFL condition. + ! + ! The KESSLER subroutine implements the Kessler (1969) microphysics + ! parameterization as described by Soong and Ogura (1973) and Klemp + ! and Wilhelmson (1978, KW). KESSLER is called at the end of each + ! time step and makes the final adjustments to the potential + ! temperature and moisture variables due to microphysical processes + ! occurring during that time step. KESSLER is called once for each + ! vertical column of grid cells. Increments are computed and added + ! into the respective variables. The Kessler scheme contains three + ! moisture categories: water vapor, cloud water (liquid water that + ! moves with the flow), and rain water (liquid water that falls + ! relative to the surrounding air). There are no ice categories. + ! Variables in the column are ordered from the surface to the top. + ! + ! SUBROUTINE KESSLER(theta, qv, qc, qr, rho, pk, dt, z, nz, rainnc) + ! + ! Input variables: + ! temp - temperature (K) + ! qv - water vapor mixing ratio (gm/gm) + ! qc - cloud water mixing ratio (gm/gm) + ! qr - rain water mixing ratio (gm/gm) + ! rho - dry air density (not mean state as in KW) (kg/m^3) + ! pk - Exner function (not mean state as in KW) (p/p0)**(R/cp) + ! dt - time step (s) + ! z - heights of thermodynamic levels in the grid column (m) + ! nz - number of thermodynamic levels in the column + ! precl - Precipitation rate (m_water/s) + ! + ! Output variables: + ! Increments are added into t, qv, qc, qr, and rainnc which are + ! returned to the routine from which KESSLER was called. To obtain + ! the total precip qt, after calling the KESSLER routine, compute: + ! + ! qt = sum over surface grid cells of (rainnc * cell area) (kg) + ! [here, the conversion to kg uses (10^3 kg/m^3)*(10^-3 m/mm) = 1] + ! + ! + ! Authors: Paul Ullrich + ! University of California, Davis + ! Email: paullrich@ucdavis.edu + ! + ! Based on a code by Joseph Klemp + ! (National Center for Atmospheric Research) + ! + ! Reference: + ! + ! Klemp, J. B., W. C. Skamarock, W. C., and S.-H. Park, 2015: + ! Idealized Global Nonhydrostatic Atmospheric Test Cases on a Reduced + ! Radius Sphere. Journal of Advances in Modeling Earth Systems. + ! doi:10.1002/2015MS000435 + ! + !======================================================================= + + SUBROUTINE KESSLER(ncol, nz, dt, rho, z, pk, theta, qv, qc, qr, precl, errmsg) + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nz ! Number of vertical levels + real(r8), intent(in) :: dt ! Time step (s) + real(r8), intent(in) :: rho(:,:) ! Dry air density (kg/m^3) + real(r8), intent(in) :: z(:,:) ! Heights of thermo. levels (m) + real(r8), intent(in) :: pk(:,:) ! Exner function (p/p0)**(R/cp) + + real(r8), intent(inout) :: theta(:,:) ! temperature (K) + real(r8), intent(inout) :: qv(:,:) ! Water vapor mixing ratio (gm/gm) + real(r8), intent(inout) :: qc(:,:) ! Cloud water mixing ratio (gm/gm) + real(r8), intent(inout) :: qr(:,:) ! Rain water mixing ratio (gm/gm) + + real(r8), intent(out) :: precl(:) ! Precipitation rate (m_water / s) + character(len=*), intent(out) :: errmsg + + !------------------------------------------------ + ! Local variables + !------------------------------------------------ + real(r8) :: r(nz), rhalf(nz), velqr(nz), sed(nz), pc(nz) + real(r8) :: f5, f2x, xk, ern, qrprod, prod, qvs, dt_max, dt0 + integer :: col, k, rainsplit, nt + + ! Initialize output variables + precl = 0._r8 + errmsg = '' + + ! Check inputs + if (dt <= 0._r8) then + write(errmsg,*) 'KESSLER called with nonpositive dt' + return + end if + + !------------------------------------------------ + ! Begin calculation + !------------------------------------------------ + f2x = 17.27_r8 + f5 = 237.3_r8 * f2x * lv / cp + xk = .2875_r8 ! kappa (r/cp) + ! Loop through columns + do col = 1, ncol + do k = 1, nz + r(k) = 0.001_r8 * rho(col, k) + rhalf(k) = sqrt(rho(col, 1) / rho(col, k)) + pc(k) = 3.8_r8 / (pk(col, k)**(1._r8/xk)*psl) + ! + ! if qr is (round-off) negative then the computation of + ! velqr triggers floating point exception error when running + ! in debugging mode with NAG + ! + qr(col,k) = MAX(qr(col,k),0.0_r8) + ! + ! Liquid water terminal velocity (m/s) following KW eq. 2.15 + velqr(k) = 36.34_r8 * rhalf(k) * (qr(col, k) * r(k))**0.1364_r8 + end do + + ! Maximum time step size in accordance with CFL condition + dt_max = dt + do k = 1, nz - 1 +! if (velqr(k) /= 0._r8) then !this causes rainsplit to become NaN on Hobart + if (abs(velqr(k)) > 1.0E-12_r8) then + dt_max = min(dt_max, 0.8_r8*(z(col, k+1) - z(col, k)) / velqr(k)) + end if + end do + + ! Number of subcycles + rainsplit = ceiling(dt / dt_max) + if (rainsplit < 1) then + write(errmsg, *) 'KESSLER: bad rainsplit ',dt,dt_max,rainsplit + return + end if + dt0 = dt / real(rainsplit, r8) + + ! Subcycle through rain process + nt = 1 + do while (nt.le.rainsplit) + + ! Precipitation rate (m/s) + precl(col) = precl(col) + rho(col, 1) * qr(col, 1) * velqr(1) / rhoqr + + ! Sedimentation term using upstream differencing + do k = 1, nz-1 + sed(k) = dt0 * ((r(k+1) * qr(col, k+1) * velqr(k+1)) - & + (r(k) * qr(col, k) * velqr(k))) / & + (r(k) * (z(col, k+1) - z(col, k))) + end do + sed(nz) = -dt0 * qr(col, nz) * velqr(nz) / (0.5_r8 * (z(col, nz)-z(col, nz-1))) + + ! Adjustment terms + do k = 1, nz + + ! Autoconversion and accretion rates following KW eq. 2.13a,b + qrprod = qc(col, k) - (qc(col, k) - dt0 * max(.001_r8 * (qc(col, k)-.001_r8), 0._r8)) / & + (1._r8 + dt0 * 2.2_r8 * qr(col, k)**.875_r8) + qc(col, k) = max(qc(col, k) - qrprod, 0._r8) + qr(col, k) = max(qr(col, k) + qrprod + sed(k), 0._r8) + + ! Saturation vapor mixing ratio (gm/gm) following KW eq. 2.11 + qvs = pc(k) * exp(f2x*(pk(col, k)*theta(col, k) - 273._r8) / (pk(col, k)*theta(col, k) - 36._r8)) + prod = (qv(col, k) - qvs) / (1._r8 + qvs*f5 / (pk(col, k)*theta(col, k) - 36._r8)**2) + + + ! Evaporation rate following KW eq. 2.14a,b + ern = min(dt0 * (((1.6_r8 + 124.9_r8*(r(k)*qr(col, k))**.2046_r8) * & + (r(k) * qr(col, k))**.525_r8) / & + (2550000._r8 * pc(k) / (3.8_r8*qvs) + 540000._r8)) * & + (dim(qvs,qv(col, k)) / (r(k)*qvs)), & + max(-prod-qc(col, k),0._r8),qr(col, k)) + + ! Saturation adjustment following KW eq. 3.10 + theta(col, k)= theta(col, k) + (lv / (cp * pk(col, k)) * (max(prod,-qc(col, k)) - ern)) + qv(col, k) = max(qv(col, k) - max(prod, -qc(col, k)) + ern, 0._r8) + qc(col, k) = qc(col, k) + max(prod, -qc(col, k)) + qr(col, k) = qr(col, k) - ern + end do + + ! Recalculate liquid water terminal velocity + if (nt /= rainsplit) then + do k = 1, nz + velqr(k) = 36.34_r8 * rhalf(k) * (qr(col, k)*r(k))**0.1364_r8 + end do + ! + ! recompute rainsplit since velqr has changed + ! + do k = 1, nz - 1 + if (abs(velqr(k)) > 1.0E-12_r8) then + dt_max = min(dt_max, 0.8_r8*(z(col, k+1) - z(col, k)) / velqr(k)) + end if + end do + ! Number of subcycles + rainsplit = ceiling(dt / dt_max) + if (rainsplit < 1) then + write(errmsg, *) 'KESSLER: bad rainsplit ',dt,dt_max,rainsplit + return + end if + dt0 = dt / real(rainsplit, r8) + end if + nt=nt+1 + end do + + precl(col) = precl(col) / real(rainsplit, r8) + + end do ! column loop + + END SUBROUTINE KESSLER + + !======================================================================= + +end module kessler_mod diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 new file mode 100644 index 0000000000..0944b6566a --- /dev/null +++ b/src/physics/simple/physpkg.F90 @@ -0,0 +1,788 @@ +module physpkg + !----------------------------------------------------------------------- + ! Purpose: + ! + ! Provides the interface to a simple CAM physics package + ! + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc, mpicom + use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & + physics_ptend, physics_update, & + physics_type_alloc, physics_ptend_dealloc,& + physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc + use phys_grid, only: get_ncols_p + use phys_gmean, only: gmean_mass + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp + use camsrfexch, only: cam_out_t, cam_in_t + + use phys_control, only: phys_getopts + use perf_mod, only: t_barrierf, t_startf, t_stopf, t_adj_detailf + use cam_logfile, only: iulog + use shr_sys_mod, only: shr_sys_flush + use camsrfexch, only: cam_export + + implicit none + private + save + + ! Public methods + public phys_register ! register physics methods + public phys_init ! Public initialization method + public phys_run1 ! First phase of the public run method + public phys_run2 ! Second phase of the public run method + public phys_final ! Public finalization method + + ! Private module data + + ! Physics buffer indices + integer :: teout_idx = 0 + integer :: dtcore_idx = 0 + + integer :: qini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 + integer :: prec_sed_idx = 0 + + ! Physics package options + character(len=16) :: convection_scheme + logical :: state_debug_checks ! Debug physics_state. + +!======================================================================= +contains +!======================================================================= + + subroutine phys_register + !----------------------------------------------------------------------- + ! + ! Purpose: Register constituents and physics buffer fields. + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + + use physconst, only: mwh2o, cpwv + use constituents, only: cnst_add, cnst_chk_dim + use physics_buffer, only: pbuf_init_time, dtype_r8, pbuf_add_field + + use cam_control_mod, only: moist_physics, kessler_phys + use cam_diagnostics, only: diag_register + use chemistry, only: chem_register + use tracers, only: tracers_register + use check_energy, only: check_energy_register + use kessler_cam, only: kessler_register + + !---------------------------Local variables----------------------------- + ! + integer :: mm ! constituent index + !----------------------------------------------------------------------- + + ! Get physics options + call phys_getopts(state_debug_checks_out = state_debug_checks) + + ! Initialize dyn_time_lvls + call pbuf_init_time() + + ! Register water vapor. + ! ***** N.B. ***** This must be the first call to cnst_add so that + ! water vapor is constituent 1. + if (moist_physics) then + call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, & + longname='Specific humidity', readiv=.true., is_convtran1=.true.) + else + call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, & + longname='Specific humidity', readiv=.false., is_convtran1=.true.) + end if + + if (kessler_phys) then + call kessler_register() + call pbuf_add_field('PREC_SED', 'physpkg', dtype_r8, (/pcols/), prec_sed_idx) + end if + + ! Fields for physics package diagnostics + call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) + + if (moist_physics) then + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + end if + + ! check energy package + call check_energy_register + + ! Register diagnostics PBUF + call diag_register() + + ! register chemical constituents including aerosols ... + call chem_register() + + ! Register test tracers + call tracers_register() + + ! All tracers registered, check that the dimensions are correct + call cnst_chk_dim() + + ! ***NOTE*** No registering constituents after the call to cnst_chk_dim. + + end subroutine phys_register + + + + !======================================================================= + subroutine phys_inidat( cam_out, pbuf2d ) + use cam_abortutils, only: endrun + + use physics_buffer, only: physics_buffer_desc + + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + + ! Dummy arguments + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Local variables + character(len=8) :: dim1name, dim2name + integer :: grid_id ! grid ID for data mapping + character(len=*), parameter :: subname='phys_inidat' + + ! dynamics variables are handled in dyn_init - here we read variables + ! needed for physics but not dynamics + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(subname//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + end subroutine phys_inidat + + subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out ) + + !----------------------------------------------------------------------- + ! + ! Initialization of physics package. + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index + use physconst, only: physconst_init + + use cam_control_mod, only: initial_run, ideal_phys, kessler_phys + use check_energy, only: check_energy_init + use chemistry, only: chem_init, chem_is_active + use cam_diagnostics, only: diag_init + use held_suarez_cam, only: held_suarez_init + use kessler_cam, only: kessler_init + use tracers, only: tracers_init + use wv_saturation, only: wv_sat_init + use phys_debug_util, only: phys_debug_init + use qneg_module, only: qneg_init + + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk) + + ! local variables + integer :: lchnk + !----------------------------------------------------------------------- + + call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) + + do lchnk = begchunk, endchunk + call physics_state_set_grid(lchnk, phys_state(lchnk)) + end do + + !--------------------------------------------------------------------------- + ! Initialize any variables in physconst which are not temporally and/or + ! spatially constant + !--------------------------------------------------------------------------- + call physconst_init() + + ! Initialize debugging a physics column + call phys_debug_init() + + call pbuf_initialize(pbuf2d) + + ! diag_init makes addfld calls for dynamics fields that are output from + ! the physics decomposition + call diag_init(pbuf2d) + + call check_energy_init() + teout_idx = pbuf_get_index('TEOUT') + dtcore_idx = pbuf_get_index('DTCORE') + + ! wv_saturation is relatively independent of everything else and + ! low level, so init it early. Must at least do this before radiation. + if (kessler_phys) then + call wv_sat_init() + end if + + call tracers_init() + + if (initial_run) then + call phys_inidat(cam_out, pbuf2d) + end if + + if (ideal_phys) then + call held_suarez_init(pbuf2d) + else if (kessler_phys) then + call kessler_init(pbuf2d) + end if + + if (chem_is_active()) then + ! Prognostic chemistry. + call chem_init(phys_state,pbuf2d) + end if + + ! Initialize qneg3 and qneg4 + call qneg_init() + + end subroutine phys_init + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! First part of atmospheric physics package before updating of surface models + ! + !----------------------------------------------------------------------- + use time_manager, only: get_nstep + use cam_diagnostics, only: diag_allocate, diag_physvar_ic + use check_energy, only: check_energy_gmean + + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + type(cam_in_t), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), dimension(begchunk:endchunk) :: cam_out + !----------------------------------------------------------------------- + ! + !---------------------------Local workspace----------------------------- + ! + integer :: c ! indices + integer :: nstep ! current timestep number + type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) + type(physics_ptend) :: ptend(begchunk:endchunk) ! indivdual parameterization tendencies + + call t_startf ('physpkg_st1') + nstep = get_nstep() + + ! Compute total energy of input state and previous output state + call t_startf ('chk_en_gmean') + call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) + call t_stopf ('chk_en_gmean') + + call pbuf_allocate(pbuf2d, 'physpkg') + call diag_allocate() + + !----------------------------------------------------------------------- + ! Advance time information + !----------------------------------------------------------------------- + + call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) + + call t_stopf ('physpkg_st1') + +#ifdef TRACER_CHECK + call gmean_mass ('before tphysbc DRY', phys_state) +#endif + + !----------------------------------------------------------------------- + ! Tendency physics before flux coupler invocation + !----------------------------------------------------------------------- + ! + + call t_barrierf('sync_bc_physics', mpicom) + call t_startf ('bc_physics') + call t_adj_detailf(+1) + + !$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk) + do c = begchunk, endchunk + + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + + call t_startf ('diag_physvar_ic') + call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) ) + call t_stopf ('diag_physvar_ic') + + call tphysbc (ztodt, phys_state(c), phys_tend(c), phys_buffer_chunk, & + cam_out(c), cam_in(c) ) + end do + + call t_adj_detailf(-1) + call t_stopf ('bc_physics') + +#ifdef TRACER_CHECK + call gmean_mass ('between DRY', phys_state) +#endif + + end subroutine phys_run1 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, cam_in) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Second part of atmospheric physics package after updating of surface models + ! + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx + + + use cam_diagnostics, only: diag_deallocate + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d + + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + ! + !----------------------------------------------------------------------- + !---------------------------Local workspace----------------------------- + ! + integer :: c ! chunk index + integer :: ncol ! number of columns + type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk + + !----------------------------------------------------------------------- + ! Tendency physics after coupler + ! Not necessary at terminal timestep. + !----------------------------------------------------------------------- + ! + + call t_barrierf('sync_ac_physics', mpicom) + call t_startf ('ac_physics') + call t_adj_detailf(+1) + +!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk) + + do c = begchunk, endchunk + ncol = get_ncols_p(c) + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + + call tphysac(ztodt, cam_in(c), cam_out(c), phys_state(c), phys_tend(c), & + phys_buffer_chunk) + end do ! Chunk loop + + call t_adj_detailf(-1) + call t_stopf('ac_physics') + +#ifdef TRACER_CHECK + call gmean_mass ('after tphysac FV:WET)', phys_state) +#endif + + call t_startf ('physpkg_st2') + call pbuf_deallocate(pbuf2d, 'physpkg') + + call pbuf_update_tim_idx() + call diag_deallocate() + call t_stopf ('physpkg_st2') + + end subroutine phys_run2 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_final( phys_state, phys_tend, pbuf2d) + use physics_buffer, only : physics_buffer_desc, pbuf_deallocate + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Finalization of physics package + ! + !----------------------------------------------------------------------- + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if(associated(pbuf2d)) then + call pbuf_deallocate(pbuf2d,'global') + deallocate(pbuf2d) + end if + deallocate(phys_state) + deallocate(phys_tend) + + end subroutine phys_final + + subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) + !----------------------------------------------------------------------- + ! + ! Tendency physics after coupling to land, sea, and ice models. + ! + ! Computes the following: + ! + ! o Aerosol Emission at Surface + ! o Source-Sink for Advected Tracers + ! o Rayleigh Friction + ! o Scale Dry Mass Energy + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use physics_types, only: physics_state, physics_tend, physics_state_check + use physics_types, only: physics_dme_adjust, set_dry_to_wet + use constituents, only: cnst_get_ind + use cam_control_mod, only: moist_physics + use cam_diagnostics, only: diag_phys_tend_writeout + use dycore, only: dycore_is + ! + ! Arguments + ! + real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) + + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(inout) :: cam_out + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + !---------------------------Local workspace----------------------------- + real(r8) :: tmp_q(pcols, pver) + real(r8) :: tmp_cldliq(pcols, pver) + real(r8) :: tmp_cldice(pcols, pver) + real(r8), pointer :: dtcore(:,:) + real(r8), pointer :: qini(:,:) + real(r8), pointer :: cldliqini(:,:) + real(r8), pointer :: cldiceini(:,:) + integer :: ixcldliq + integer :: ixcldice + integer :: k + integer :: ncol + integer :: itim_old + + ! number of active atmospheric columns + ncol = state%ncol + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + + ! Validate the physics state. + if (state_debug_checks) then + call physics_state_check(state, name="before tphysac") + end if + call pbuf_get_field(pbuf, qini_idx, qini) + if (moist_physics) then + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + else + allocate(cldliqini(pcols, pver)) + cldliqini = 0.0_r8 + allocate(cldiceini(pcols, pver)) + cldiceini = 0.0_r8 + end if + ! + ! FV: convert dry-type mixing ratios to moist here because + ! physics_dme_adjust assumes moist. This is done in p_d_coupling for + ! other dynamics. Bundy, Feb 2004. + ! + if (moist_physics .and.dycore_is('LR')) then + call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist + end if + + if (moist_physics) then + ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) + if (ixcldliq > 0) then + tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + else + tmp_cldliq(:ncol,:pver) = 0.0_r8 + end if + if (ixcldice > 0) then + tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + else + tmp_cldice(:ncol,:pver) = 0.0_r8 + end if + if (dycore_is('LR')) call physics_dme_adjust(state, tend, qini, ztodt) + else + tmp_q (:ncol,:pver) = 0.0_r8 + tmp_cldliq(:ncol,:pver) = 0.0_r8 + tmp_cldice(:ncol,:pver) = 0.0_r8 + end if + + ! store T in buffer for use in computing dynamics T-tendency in next timestep + call pbuf_get_field(pbuf, dtcore_idx, dtcore, & + start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + do k = 1,pver + dtcore(:ncol,k) = state%t(:ncol,k) + end do + + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, & + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + + if (.not. moist_physics) then + deallocate(cldliqini) + deallocate(cldiceini) + end if + + end subroutine tphysac + + subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Evaluate and apply physical processes that are calculated BEFORE + ! coupling to land, sea, and ice models. + ! + ! Processes currently included are: + ! + ! o Resetting Negative Tracers to Positive + ! o Global Mean Total Energy Fixer + ! o Dry Adjustment + ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection + ! o Stratiform Macro-Microphysics + ! o Wet Scavenging of Aerosol + ! o Radiation + ! + ! Method: + ! + ! Each parameterization should be implemented with this sequence of calls: + ! 1) Call physics interface + ! 2) Check energy + ! 3) Call physics_update + ! See Interface to Column Physics and Chemistry Packages + ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx + use physics_buffer, only: dyn_time_lvls + use physics_types, only: physics_state_check, physics_tend_init + use cam_control_mod, only: moist_physics, adiabatic, ideal_phys, kessler_phys + use constituents, only: cnst_get_ind + + use cam_diagnostics, only: diag_phys_writeout, diag_state_b4_phys_write + use cam_diagnostics, only: diag_conv_tend_ini, diag_conv, diag_export + use cam_history, only: outfld + use time_manager, only: get_nstep + use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init + use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng + use chemistry, only: chem_is_active, chem_timestep_tend + use held_suarez_cam, only: held_suarez_tend + use kessler_cam, only: kessler_tend + use dycore, only: dycore_is + + ! Arguments + + real(r8), intent(in) :: ztodt ! model time increment + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(inout) :: cam_in + + + ! + !---------------------------Local workspace----------------------------- + ! + + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + integer :: nstep ! current timestep number + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: itim_old + integer :: ixcldliq + integer :: ixcldice + + ! physics buffer fields for total energy and mass adjustment + real(r8), pointer :: teout(:) + real(r8), pointer :: qini(:,:) + real(r8), pointer :: cldliqini(:,:) + real(r8), pointer :: cldiceini(:,:) + real(r8), pointer :: dtcore(:,:) + real(r8), pointer :: prec_sed(:) ! total precip from cloud sedimentation + + ! energy checking variables + real(r8) :: zero(pcols) ! array of zeros + real(r8) :: flx_heat(pcols) + type(check_tracers_data) :: tracerint ! energy integrals and cummulative boundary fluxes + !----------------------------------------------------------------------- + + call t_startf('bc_init') + + zero = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) + call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qini_idx, qini) + if (moist_physics) then + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + end if + + if (kessler_phys) then + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed) + end if + + ! Set physics tendencies to 0 + if (moist_physics) then + tend%dTdt(:ncol,:pver) = 0._r8 + tend%dudt(:ncol,:pver) = 0._r8 + tend%dvdt(:ncol,:pver) = 0._r8 + else + call physics_tend_init(tend) + end if + + ! Verify state coming from the dynamics + if (state_debug_checks) then + call physics_state_check(state, name="before tphysbc (dycore?)") + end if + + ! + ! Dump out "before physics" state + ! + call diag_state_b4_phys_write(state) + + ! compute mass integrals of input tracers state + call check_tracers_init(state, tracerint) + + call t_stopf('bc_init') + + !=================================================== + ! Global mean total energy fixer + !=================================================== + call t_startf('energy_fixer') + + if (dycore_is('LR') .or. dycore_is('SE')) then + call check_energy_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call outfld( 'EFIX', flx_heat , pcols, lchnk ) + call physics_ptend_dealloc(ptend) + end if + ! Save state for convective tendency calculations. + call diag_conv_tend_ini(state, pbuf) + + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + if (moist_physics) then + if (ixcldliq > 0) then + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + end if + if (ixcldice > 0) then + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + end if + end if + + call outfld('TEOUT', teout , pcols, lchnk ) + call outfld('TEINP', state%te_ini, pcols, lchnk ) + call outfld('TEFIX', state%te_cur, pcols, lchnk ) + + ! T tendency due to dynamics + if( nstep > dyn_time_lvls-1 ) then + dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt + call outfld( 'DTCORE', dtcore, pcols, lchnk ) + end if + + call t_stopf('energy_fixer') + + !=================================================== + ! Compute physics tendency based on namelist + !=================================================== + if (ideal_phys) then + call held_suarez_tend(state, ptend, ztodt) + ! update the state and total physics tendency + call physics_update(state, ptend, ztodt, tend) + else if (kessler_phys) then + call kessler_tend(state, ptend, ztodt, cam_out, prec_sed) + ! update the state and total physics tendency + call physics_update(state, ptend, ztodt, tend) + end if + + ! Can't turn on conservation error messages unless the appropriate heat + ! surface flux is computed and supplied as an argument to + ! check_energy_chng to account for how the ideal physics forcings are + ! changing the total exnergy. + call check_energy_chng(state, tend, "tphysidl", nstep, ztodt, zero, zero, zero, zero) + + if (chem_is_active()) then + call t_startf('simple_chem') + + call check_tracers_init(state, tracerint) + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, pbuf) + call physics_update(state, ptend, ztodt, tend) + call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, cam_in%cflx) + + call t_stopf('simple_chem') + call physics_ptend_dealloc(ptend) + end if + + call t_startf('bc_history_write') + if (moist_physics) then + call diag_phys_writeout(state, cam_out%psl) + call diag_conv(state, ztodt, pbuf) + else + call diag_phys_writeout(state) + end if + call t_stopf('bc_history_write') + + ! Save total enery after physics for energy conservation checks + teout = state%te_cur + + end subroutine tphysbc + + subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) + !-------------------------------------------------------------------------- + ! + ! Purpose: The place for parameterizations to call per timestep initializations. + ! Generally this is used to update time interpolated fields from + ! boundary datasets. + ! + !-------------------------------------------------------------------------- + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + + implicit none + + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !-------------------------------------------------------------------------- + + end subroutine phys_timestep_init + +end module physpkg diff --git a/src/physics/simple/radconstants.F90 b/src/physics/simple/radconstants.F90 new file mode 100644 index 0000000000..0649a6f730 --- /dev/null +++ b/src/physics/simple/radconstants.F90 @@ -0,0 +1,40 @@ +module radconstants + +! provide stubs to allow building with no radiation scheme active + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +implicit none +private +save + +integer, parameter, public :: nswbands = 1 +integer, parameter, public :: nlwbands = 1 +integer, parameter, public :: idx_sw_diag = 1 +integer, parameter, public :: idx_lw_diag = 1 +integer, parameter, public :: idx_nir_diag = 1 +integer, parameter, public :: idx_uv_diag = 1 +integer, parameter, public :: nrh = 1 +integer, parameter, public :: ot_length = 32 + +public :: rad_gas_index + +integer, public, parameter :: gasnamelength = 1 +integer, public, parameter :: nradgas = 1 +character(len=gasnamelength), public, parameter :: gaslist(nradgas) & + = (/' '/) + +!======================================================================================== +contains +!======================================================================================== + +integer function rad_gas_index(gasname) + + character(len=*),intent(in) :: gasname + + call endrun('rad_gas_index: ERROR: this is a stub') + +end function rad_gas_index + +end module radconstants diff --git a/src/physics/simple/radiation.F90 b/src/physics/simple/radiation.F90 new file mode 100644 index 0000000000..63dcb9eac0 --- /dev/null +++ b/src/physics/simple/radiation.F90 @@ -0,0 +1,57 @@ +module radiation + +! stub module + +use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl + +implicit none +private +save + +public :: & + radiation_readnl, & + radiation_nextsw_cday, & + radiation_do + +!======================================================================================== +contains +!======================================================================================== + +subroutine radiation_readnl(nlfile) + + ! this stub can be called, but does nothing + + character(len=*), intent(in) :: nlfile + +end subroutine radiation_readnl + +!======================================================================================== + +function radiation_do(op, timestep) + + ! Returns true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in), optional:: timestep + logical :: radiation_do ! return value + !--------------------------------------------------------------------------- + + radiation_do = .false. + +end function radiation_do + +!======================================================================================== + +real(r8) function radiation_nextsw_cday() + + ! Returns calendar day of next sw radiation calculation + !--------------------------------------------------------------------------- + + radiation_nextsw_cday = -1._r8 + +end function radiation_nextsw_cday + +!======================================================================================== + +end module radiation + diff --git a/src/physics/simple/restart_physics.F90 b/src/physics/simple/restart_physics.F90 new file mode 100644 index 0000000000..ef8f8795ef --- /dev/null +++ b/src/physics/simple/restart_physics.F90 @@ -0,0 +1,115 @@ +module restart_physics + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use constituents, only: pcnst + + use cam_abortutils, only: endrun + use camsrfexch, only: cam_in_t, cam_out_t + use cam_logfile, only: iulog + use pio, only: file_desc_t, io_desc_t, var_desc_t, & + pio_double, pio_int, pio_noerr, & + pio_seterrorhandling, pio_bcast_error, & + pio_inq_varid, pio_def_var, pio_def_dim, & + pio_put_var, pio_get_var + + implicit none + private + save +! +! Public interfaces +! + public :: write_restart_physics ! Write the physics restart info out + public :: read_restart_physics ! Read the physics restart info in + public :: init_restart_physics + +! +! Private data +! + +CONTAINS + + subroutine init_restart_physics ( File, pbuf2d) + + use physics_buffer, only: pbuf_init_restart, physics_buffer_desc + use cam_grid_support, only: cam_grid_write_attr, cam_grid_id + use cam_grid_support, only: cam_grid_header_info_t + + type(file_desc_t), intent(inout) :: file + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: grid_id + integer :: hdimcnt, ierr, i + integer :: dimids(4) + integer, allocatable :: hdimids(:) + type(cam_grid_header_info_t) :: info + character(len=4) :: num + + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + ! Probably should have the grid write this out. + grid_id = cam_grid_id('physgrid') + call cam_grid_write_attr(File, grid_id, info) + hdimcnt = info%num_hdims() + + do i = 1, hdimcnt + dimids(i) = info%get_hdimid(i) + end do + allocate(hdimids(hdimcnt)) + hdimids(1:hdimcnt) = dimids(1:hdimcnt) + + call pbuf_init_restart(File, pbuf2d) + + end subroutine init_restart_physics + + subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) + + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_write_restart + use phys_grid, only: phys_decomp + use ppgrid, only: begchunk, endchunk + use cam_grid_support, only: cam_grid_write_var + + use cam_history_support, only: fillvalue + ! + ! Input arguments + ! + type(file_desc_t), intent(inout) :: File + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) + type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + !----------------------------------------------------------------------- + + ! Write grid vars + call cam_grid_write_var(File, phys_decomp) + + ! Physics buffer + call pbuf_write_restart(File, pbuf2d) + + end subroutine write_restart_physics + + !####################################################################### + + subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) + + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_read_restart + + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp + use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_id + use cam_grid_support, only: cam_grid_get_decomp, cam_grid_dimensions + use cam_history_support, only: fillvalue + use pio, only: pio_read_darray + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: File + type(cam_in_t), pointer :: cam_in(:) + type(cam_out_t), pointer :: cam_out(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + !----------------------------------------------------------------------- + + call pbuf_read_restart(File, pbuf2d) + + end subroutine read_restart_physics + + end module restart_physics diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 new file mode 100644 index 0000000000..df9574cf4b --- /dev/null +++ b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 @@ -0,0 +1,47 @@ + +subroutine advect_scalar (f,fadv,flux,f2leadv,f2legrad,fwleadv,doit) + +! positively definite monotonic advection with non-oscillatory option + +use crmx_grid +use crmx_vars, only: u, v, w, rho, rhow +use crmx_params, only: docolumn + +implicit none + +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) +real flux(nz), fadv(nz) +real f2leadv(nz),f2legrad(nz),fwleadv(nz) +logical doit + +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) +integer i,j,k + +if(docolumn) then + flux = 0. + return +end if + +!call t_startf ('advect_scalars') + + df(:,:,:) = f(:,:,:) + +if(RUN3D) then + call advect_scalar3D(f, u, v, w, rho, rhow, flux) +else + call advect_scalar2D(f, u, w, rho, rhow, flux) +endif + + do k=1,nzm + fadv(k)=0. + do j=1,ny + do i=1,nx + fadv(k)=fadv(k)+f(i,j,k)-df(i,j,k) + end do + end do + end do + +!call t_stopf ('advect_scalars') + +end subroutine advect_scalar + diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 new file mode 100644 index 0000000000..a3773aa1ca --- /dev/null +++ b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 @@ -0,0 +1,182 @@ + +subroutine advect_scalar2D (f, u, w, rho, rhow, flux) + +! positively definite monotonic advection with non-oscillatory option + +use crmx_grid +use crmx_params, only: dowallx +implicit none + + +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) +real u(dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) +real w(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) +real rho(nzm) +real rhow(nz) +real flux(nz) + +real mx (0:nxp1,1,nzm) +real mn (0:nxp1,1,nzm) +real uuu(-1:nxp3,1,nzm) +real www(-1:nxp2,1,nz) + +real eps, dd +integer i,j,k,ic,ib,kc,kb +logical nonos +real iadz(nzm),irho(nzm),irhow(nzm) + +real x1, x2, a, b, a1, a2, y +real andiff,across,pp,pn +andiff(x1,x2,a,b)=(abs(a)-a*a*b)*0.5*(x2-x1) +across(x1,a1,a2)=0.03125*a1*a2*x1 +pp(y)= max(0.,y) +pn(y)=-min(0.,y) + +nonos = .true. +eps = 1.e-10 + +j=1 + +www(:,:,nz)=0. + +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + do i=dimx1_u,1 + u(i,j,k) = 0. + end do + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + do i=nx+1,dimx2_u + u(i,j,k) = 0. + end do + end do + end if + +end if + +!----------------------------------------- + +if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + do i=0,nxp1 + ib=i-1 + ic=i+1 + mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) + mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) + end do + end do + +end if ! nonos + +do k=1,nzm + kb=max(1,k-1) + do i=-1,nxp3 + uuu(i,j,k)=max(0.,u(i,j,k))*f(i-1,j,k)+min(0.,u(i,j,k))*f(i,j,k) + end do + do i=-1,nxp2 + www(i,j,k)=max(0.,w(i,j,k))*f(i,j,kb)+min(0.,w(i,j,k))*f(i,j,k) + end do + flux(k) = 0. + do i=1,nx + flux(k) = flux(k) + www(i,j,k) + end do +end do + +do k=1,nzm + irho(k) = 1./rho(k) + iadz(k) = 1./adz(k) + do i=-1,nxp2 + f(i,j,k) = f(i,j,k) - (uuu(i+1,j,k)-uuu(i,j,k) & + + (www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k) + end do +end do + + +do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + dd=2./(kc-kb)/adz(k) + irhow(k)=1./(rhow(k)*adz(k)) + do i=0,nxp2 + ib=i-1 + uuu(i,j,k)=andiff(f(ib,j,k),f(i,j,k),u(i,j,k),irho(k)) & + - across(dd*(f(ib,j,kc)+f(i,j,kc)-f(ib,j,kb)-f(i,j,kb)), & + u(i,j,k), w(ib,j,k)+w(ib,j,kc)+w(i,j,k)+w(i,j,kc)) *irho(k) + end do + + + do i=0,nxp1 + ib=i-1 + ic=i+1 + www(i,j,k)=andiff(f(i,j,kb),f(i,j,k),w(i,j,k),irhow(k)) & + -across(f(ic,j,kb)+f(ic,j,k)-f(ib,j,kb)-f(ib,j,k), & + w(i,j,k), u(i,j,kb)+u(i,j,k)+u(ic,j,k)+u(ic,j,kb)) *irho(k) + end do +end do +www(:,:,1) = 0. +!---------- non-osscilatory option --------------- + +if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + do i=0,nxp1 + ib=i-1 + ic=i+1 + mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mx(i,j,k)) + mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mn(i,j,k)) + end do + end do + + do k=1,nzm + kc=min(nzm,k+1) + do i=0,nxp1 + ic=i+1 + mx(i,j,k)=rho(k)*(mx(i,j,k)-f(i,j,k))/(pn(uuu(ic,j,k)) + pp(uuu(i,j,k))+& + iadz(k)*(pn(www(i,j,kc)) + pp(www(i,j,k)))+eps) + mn(i,j,k)=rho(k)*(f(i,j,k)-mn(i,j,k))/(pp(uuu(ic,j,k)) + pn(uuu(i,j,k))+& + iadz(k)*(pp(www(i,j,kc)) + pn(www(i,j,k)))+eps) + end do + end do + + do k=1,nzm + kb=max(1,k-1) + do i=1,nxp1 + ib=i-1 + uuu(i,j,k)= pp(uuu(i,j,k))*min(1.,mx(i,j,k), mn(ib,j,k)) & + - pn(uuu(i,j,k))*min(1.,mx(ib,j,k),mn(i,j,k)) + end do + do i=1,nx + www(i,j,k)= pp(www(i,j,k))*min(1.,mx(i,j,k), mn(i,j,kb)) & + - pn(www(i,j,k))*min(1.,mx(i,j,kb),mn(i,j,k)) + flux(k) = flux(k) + www(i,j,k) + end do + end do + + +endif ! nonos + + + do k=1,nzm + kc=k+1 + do i=1,nx + ! MK: added fix for very small negative values (relative to positive values) + ! especially when such large numbers as + ! hydrometeor concentrations are advected. The reason for negative values is + ! most likely truncation error. + f(i,j,k)= max(0., f(i,j,k) - (uuu(i+1,j,k)-uuu(i,j,k) & + +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k)) + end do + end do + +end subroutine advect_scalar2D + + diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 new file mode 100644 index 0000000000..cd66086006 --- /dev/null +++ b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 @@ -0,0 +1,302 @@ + +subroutine advect_scalar3D (f, u, v, w, rho, rhow, flux) + +! positively definite monotonic advection with non-oscillatory option + +use crmx_grid +use crmx_params, only: dowallx, dowally +implicit none + + +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) +real u(dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) +real v(dimx1_v:dimx2_v, dimy1_v:dimy2_v, nzm) +real w(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) +real rho(nzm) +real rhow(nz) +real flux(nz) + +real mx (0:nxp1,0:nyp1,nzm) +real mn (0:nxp1,0:nyp1,nzm) +real uuu(-1:nxp3,-1:nyp2,nzm) +real vvv(-1:nxp2,-1:nyp3,nzm) +real www(-1:nxp2,-1:nyp2,nz) + +real eps, dd +real iadz(nzm),irho(nzm),irhow(nzm) +integer i,j,k,ic,ib,jc,jb,kc,kb +logical nonos + +real x1, x2, a, b, a1, a2, y +real andiff,across,pp,pn +andiff(x1,x2,a,b)=(abs(a)-a*a*b)*0.5*(x2-x1) +across(x1,a1,a2)=0.03125*a1*a2*x1 +pp(y)= max(0.,y) +pn(y)=-min(0.,y) + +nonos = .true. +eps = 1.e-10 + +www(:,:,nz)=0. + +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + do j=dimy1_u,dimy2_u + do i=dimx1_u,1 + u(i,j,k) = 0. + end do + end do + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + do j=dimy1_u,dimy2_u + do i=nx+1,dimx2_u + u(i,j,k) = 0. + end do + end do + end do + end if + +end if + +if(dowally) then + + if(rank.lt.nsubdomains_x) then + do k=1,nzm + do j=dimy1_v,1 + do i=dimx1_v,dimx2_v + v(i,j,k) = 0. + end do + end do + end do + end if + if(rank.gt.nsubdomains-nsubdomains_x-1) then + do k=1,nzm + do j=ny+1,dimy2_v + do i=dimx1_v,dimx2_v + v(i,j,k) = 0. + end do + end do + end do + end if + +end if + +!----------------------------------------- + +if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + do j=0,nyp1 + jb=j-1 + jc=j+1 + do i=0,nxp1 + ib=i-1 + ic=i+1 + mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,jb,k), & + f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) + mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,jb,k), & + f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) + end do + end do + end do + +end if ! nonos + + do k=1,nzm + do j=-1,nyp2 + do i=-1,nxp3 + uuu(i,j,k)=max(0.,u(i,j,k))*f(i-1,j,k)+min(0.,u(i,j,k))*f(i,j,k) + end do + end do + end do + + do k=1,nzm + do j=-1,nyp3 + do i=-1,nxp2 + vvv(i,j,k)=max(0.,v(i,j,k))*f(i,j-1,k)+min(0.,v(i,j,k))*f(i,j,k) + end do + end do + end do + + do k=1,nzm + kb=max(1,k-1) + do j=-1,nyp2 + do i=-1,nxp2 + www(i,j,k)=max(0.,w(i,j,k))*f(i,j,kb)+min(0.,w(i,j,k))*f(i,j,k) + end do + end do + flux(k) = 0. + do j=1,ny + do i=1,nx + flux(k) = flux(k) + www(i,j,k) + end do + end do + end do + + + do k=1,nzm + irho(k) = 1./rho(k) + iadz(k) = 1./adz(k) + do j=-1,nyp2 + do i=-1,nxp2 + f(i,j,k)=f(i,j,k) -(uuu(i+1,j,k)-uuu(i,j,k)+vvv(i,j+1,k)-vvv(i,j,k) & + +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k) + end do + end do + end do + + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + dd=2./(kc-kb)/adz(k) + do j=0,nyp1 + jb=j-1 + jc=j+1 + do i=0,nxp2 + ib=i-1 + uuu(i,j,k)=andiff(f(ib,j,k),f(i,j,k),u(i,j,k),irho(k)) & + -(across(f(ib,jc,k)+f(i,jc,k)-f(ib,jb,k)-f(i,jb,k), & + u(i,j,k), v(ib,j,k)+v(ib,jc,k)+v(i,jc,k)+v(i,j,k)) & + +across(dd*(f(ib,j,kc)+f(i,j,kc)-f(ib,j,kb)-f(i,j,kb)), & + u(i,j,k), w(ib,j,k)+w(ib,j,kc)+w(i,j,k)+w(i,j,kc))) *irho(k) + end do + end do + end do + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + dd=2./(kc-kb)/adz(k) + do j=0,nyp2 + jb=j-1 + do i=0,nxp1 + ib=i-1 + ic=i+1 + vvv(i,j,k)=andiff(f(i,jb,k),f(i,j,k),v(i,j,k),irho(k)) & + -(across(f(ic,jb,k)+f(ic,j,k)-f(ib,jb,k)-f(ib,j,k), & + v(i,j,k), u(i,jb,k)+u(i,j,k)+u(ic,j,k)+u(ic,jb,k)) & + +across(dd*(f(i,jb,kc)+f(i,j,kc)-f(i,jb,kb)-f(i,j,kb)), & + v(i,j,k), w(i,jb,k)+w(i,j,k)+w(i,j,kc)+w(i,jb,kc))) *irho(k) + end do + end do + end do + + do k=1,nzm + kb=max(1,k-1) + irhow(k)=1./(rhow(k)*adz(k)) + do j=0,nyp1 + jb=j-1 + jc=j+1 + do i=0,nxp1 + ib=i-1 + ic=i+1 + www(i,j,k)=andiff(f(i,j,kb),f(i,j,k),w(i,j,k),irhow(k)) & + -(across(f(ic,j,kb)+f(ic,j,k)-f(ib,j,kb)-f(ib,j,k), & + w(i,j,k), u(i,j,kb)+u(i,j,k)+u(ic,j,k)+u(ic,j,kb)) & + +across(f(i,jc,k)+f(i,jc,kb)-f(i,jb,k)-f(i,jb,kb), & + w(i,j,k), v(i,j,kb)+v(i,jc,kb)+v(i,jc,k)+v(i,j,k))) *irho(k) + end do + end do + end do + +www(:,:,1) = 0. + +!---------- non-osscilatory option --------------- + +if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + do j=0,nyp1 + jb=j-1 + jc=j+1 + do i=0,nxp1 + ib=i-1 + ic=i+1 + mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,jb,k), & + f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mx(i,j,k)) + mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,jb,k), & + f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mn(i,j,k)) + end do + end do + end do + + do k=1,nzm + kc=min(nzm,k+1) + do j=0,nyp1 + jc=j+1 + do i=0,nxp1 + ic=i+1 + mx(i,j,k)=rho(k)*(mx(i,j,k)-f(i,j,k))/ & + (pn(uuu(ic,j,k)) + pp(uuu(i,j,k))+ & + pn(vvv(i,jc,k)) + pp(vvv(i,j,k))+ & + iadz(k)*(pn(www(i,j,kc)) + pp(www(i,j,k)))+eps) + mn(i,j,k)=rho(k)*(f(i,j,k)-mn(i,j,k))/ & + (pp(uuu(ic,j,k)) + pn(uuu(i,j,k))+ & + pp(vvv(i,jc,k)) + pn(vvv(i,j,k))+ & + iadz(k)*(pp(www(i,j,kc)) + pn(www(i,j,k)))+eps) + end do + end do + end do + + do k=1,nzm + do j=1,ny + do i=1,nxp1 + ib=i-1 + uuu(i,j,k)=pp(uuu(i,j,k))*min(1.,mx(i,j,k), mn(ib,j,k)) & + - pn(uuu(i,j,k))*min(1.,mx(ib,j,k),mn(i,j,k)) + end do + end do + end do + + do k=1,nzm + do j=1,nyp1 + jb=j-1 + do i=1,nx + vvv(i,j,k)=pp(vvv(i,j,k))*min(1.,mx(i,j,k), mn(i,jb,k)) & + - pn(vvv(i,j,k))*min(1.,mx(i,jb,k),mn(i,j,k)) + end do + end do + end do + + do k=1,nzm + kb=max(1,k-1) + do j=1,ny + do i=1,nx + www(i,j,k)=pp(www(i,j,k))*min(1.,mx(i,j,k), mn(i,j,kb)) & + - pn(www(i,j,k))*min(1.,mx(i,j,kb),mn(i,j,k)) + flux(k) = flux(k) + www(i,j,k) + end do + end do + end do + + +endif ! nonos + + +do k=1,nzm + kc=k+1 + do j=1,ny + do i=1,nx + ! MK: added fix for very small negative values (relative to positive values) + ! especially when such large numbers as + ! hydrometeor concentrations are advected. The reason for negative values is + ! most likely truncation error. + + f(i,j,k)=max(0.,f(i,j,k) -(uuu(i+1,j,k)-uuu(i,j,k)+vvv(i,j+1,k)-vvv(i,j,k) & + +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k)) + end do + end do +end do + +end subroutine advect_scalar3D + + diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 new file mode 100644 index 0000000000..04b1f60d9c --- /dev/null +++ b/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 @@ -0,0 +1,3 @@ +module crmx_advection + integer, parameter :: NADV = 0, NADVS=0 ! add'l boundary points +end module crmx_advection diff --git a/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 new file mode 100644 index 0000000000..2f49672025 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 @@ -0,0 +1,71 @@ +!$Id: Skw_module.F90 5999 2012-12-18 23:53:13Z raut@uwm.edu $ +!------------------------------------------------------------------------------- +module crmx_Skw_module + + implicit none + + private ! Default Scope + + public :: Skw_func + + contains + +!------------------------------------------------------------------------------- + elemental function Skw_func( wp2, wp3 ) & + result( Skw ) + +! Description: +! Calculate the skewness of w, Skw. + +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + w_tol_sqd, &! Constant for w_{_tol}^2, i.e. threshold for vertical velocity + Skw_max_mag ! Max magnitude of skewness + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: min, max + + ! Parameter Constants + ! Factor to decrease sensitivity in the denominator of Skw calculation + real( kind = core_rknd ), parameter :: & + Skw_denom_coef = 8.0_core_rknd ! [-] + + ! Whether to apply clipping to the final result + logical, parameter :: & + l_clipping_kluge = .false. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp2, & ! w'^2 [m^2/s^2] + wp3 ! w'^3 [m^3/s^3] + + ! Output Variable + real( kind = core_rknd ) :: & + Skw ! Result Skw [-] + + ! ---- Begin Code ---- + + !Skw = wp3 / ( max( wp2, w_tol_sqd ) )**1.5_core_rknd + ! Calculation of skewness to help reduce the sensitivity of this value to + ! small values of wp2. + Skw = wp3 / ( wp2 + Skw_denom_coef * w_tol_sqd )**1.5_core_rknd + + ! This is no longer needed since clipping is already + ! imposed on wp2 and wp3 elsewhere in the code + if ( l_clipping_kluge ) then + Skw = min( max( Skw, -Skw_max_mag ), Skw_max_mag ) + end if + + return + end function Skw_func +!----------------------------------------------------------------------- + +end module crmx_Skw_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 new file mode 100644 index 0000000000..971bccc073 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 @@ -0,0 +1,86 @@ +! $Id: T_in_K_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ + +module crmx_T_in_K_module + + implicit none + + private ! Default scope + + public :: thlm2T_in_K, T_in_K2thlm + + contains + +!------------------------------------------------------------------------------- + elemental function thlm2T_in_K( thlm, exner, rcm ) & + result( T_in_K ) + +! Description: +! Calculates absolute temperature from liquid water potential +! temperature. (Does not include ice.) + +! References: +! Cotton and Anthes (1989), "Storm and Cloud Dynamics", Eqn. (2.51). +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + ! Variable(s) + Cp, & ! Dry air specific heat at constant p [J/kg/K] + Lv ! Latent heat of vaporization [J/kg] + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input + real( kind = core_rknd ), intent(in) :: & + thlm, & ! Liquid potential temperature [K] + exner, & ! Exner function [-] + rcm ! Liquid water mixing ratio [kg/kg] + + real( kind = core_rknd ) :: & + T_in_K ! Result temperature [K] + + ! ---- Begin Code ---- + + T_in_K = thlm * exner + Lv * rcm / Cp + + return + end function thlm2T_in_K +!------------------------------------------------------------------------------- + elemental function T_in_K2thlm( T_in_K, exner, rcm ) & + result( thlm ) + +! Description: +! Calculates liquid water potential temperature from absolute temperature + +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + ! Variable(s) + Cp, & ! Dry air specific heat at constant p [J/kg/K] + Lv ! Latent heat of vaporization [J/kg] + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input + real( kind = core_rknd ), intent(in) :: & + T_in_K, &! Result temperature [K] + exner, & ! Exner function [-] + rcm ! Liquid water mixing ratio [kg/kg] + + real( kind = core_rknd ) :: & + thlm ! Liquid potential temperature [K] + + ! ---- Begin Code ---- + + thlm = ( T_in_K - Lv/Cp * rcm ) / exner + + return + end function T_in_K2thlm +!------------------------------------------------------------------------------- + +end module crmx_T_in_K_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 new file mode 100644 index 0000000000..4f1d8b53a0 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 @@ -0,0 +1,136 @@ +!------------------------------------------------------------------------- +! $Id: advance_helper_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_advance_helper_module + +! Description: +! This module contains helper methods for the advance_* modules. +!------------------------------------------------------------------------ + + implicit none + + public :: set_boundary_conditions_lhs, set_boundary_conditions_rhs + + private ! Set Default Scope + + contains + + !--------------------------------------------------------------------------- + subroutine set_boundary_conditions_lhs( diag_index, low_bound, high_bound, lhs, & + diag_index2, low_bound2, high_bound2 ) + + ! Description: + ! Sets the boundary conditions for a left-hand side LAPACK matrix. + ! + ! References: + ! none + !--------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + integer, intent(in) :: & + diag_index, low_bound, high_bound ! boundary indexes for the first variable + + integer, intent(in), optional :: & + diag_index2, low_bound2, high_bound2 ! boundary indexes for the second variable + + real( kind = core_rknd ), dimension(:,:), intent(inout) :: & + lhs ! left hand side of the LAPACK matrix equation + + ! --------------------- BEGIN CODE ---------------------- + + if( ( present(low_bound2) .or. present(high_bound2) ) .and. & + ( .not. present(diag_index2) ) ) then + + stop "Boundary index provided without diag_index." + + end if + + ! Set the lower boundaries for the first variable + lhs(:,low_bound) = 0.0_core_rknd + lhs(diag_index,low_bound) = 1.0_core_rknd + + ! Set the upper boundaries for the first variable + lhs(:,high_bound) = 0.0_core_rknd + lhs(diag_index,high_bound) = 1.0_core_rknd + + ! Set the lower boundaries for the second variable, if it is provided + if( present(low_bound2) ) then + + lhs(:,low_bound2) = 0.0_core_rknd + lhs(diag_index2,low_bound2) = 1.0_core_rknd + + end if + + ! Set the upper boundaries for the second variable, if it is provided + if( present(high_bound2) ) then + + lhs(:,high_bound2) = 0.0_core_rknd + lhs(diag_index2,high_bound2) = 1.0_core_rknd + + end if + + end subroutine set_boundary_conditions_lhs + + !-------------------------------------------------------------------------- + subroutine set_boundary_conditions_rhs( & + low_value, low_bound, high_value, high_bound, & + rhs, & + low_value2, low_bound2, high_value2, high_bound2 ) + + ! Description: + ! Sets the boundary conditions for a right-hand side LAPACK vector. + ! + ! References: + ! none + !--------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! The values for the first variable + real( kind = core_rknd ), intent(in) :: low_value, high_value + + ! The bounds for the first variable + integer, intent(in) :: low_bound, high_bound + + ! The values for the second variable + real( kind = core_rknd ), intent(in), optional :: low_value2, high_value2 + + ! The bounds for the second variable + integer, intent(in), optional :: low_bound2, high_bound2 + + ! The right-hand side vector + real( kind = core_rknd ), dimension(:), intent(inout) :: rhs + + ! -------------------- BEGIN CODE ------------------------ + + ! Stop execution if a boundary was provided without a value + if( (present(low_bound2) .and. (.not. present(low_value2))) .or. & + (present(high_bound2) .and. (.not. present(high_value2))) ) then + + stop "Boundary condition provided without value." + + end if + + ! Set the lower and upper bounds for the first variable + rhs(low_bound) = low_value + rhs(high_bound) = high_value + + ! If a lower bound was given for the second variable, set it + if( present(low_bound2) ) then + rhs(low_bound2) = low_value2 + end if + + ! If an upper bound was given for the second variable, set it + if( present(high_bound2) ) then + rhs(high_bound2) = high_value2 + end if + + end subroutine set_boundary_conditions_rhs + +end module crmx_advance_helper_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 new file mode 100644 index 0000000000..57799743cb --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 @@ -0,0 +1,1909 @@ +!------------------------------------------------------------------------ +! $Id: advance_windm_edsclrm_module.F90 5960 2012-10-18 20:34:59Z janhft@uwm.edu $ +!=============================================================================== +module crmx_advance_windm_edsclrm_module + + implicit none + + private ! Set Default Scope + + public :: advance_windm_edsclrm, xpwp_fnc + + private :: windm_edsclrm_solve, & + compute_uv_tndcy, & + windm_edsclrm_lhs, & + windm_edsclrm_rhs + + + ! Private named constants to avoid string comparisons + integer, parameter, private :: & + windm_edsclrm_um = 1, & ! Named constant to handle um solves + windm_edsclrm_vm = 2, & ! Named constant to handle vm solves + windm_edsclrm_scalar = 3, & ! Named constant to handle scalar solves + clip_upwp = 10, & ! Named constant for upwp clipping + ! NOTE: This must be the same as the clip_upwp + ! declared in clip_explicit! + clip_vpwp = 11 ! Named constant for vpwp clipping + ! NOTE: This must be the same as the clip_vpwp + ! declared in clip_explicit! + + contains + + !============================================================================= + subroutine advance_windm_edsclrm & + ( dt, wm_zt, Kh_zm, ug, vg, um_ref, vm_ref, & + wp2, up2, vp2, um_forcing, vm_forcing, & + edsclrm_forcing, & + rho_ds_zm, invrs_rho_ds_zt, & + fcor, l_implemented, & + um, vm, edsclrm, & + upwp, vpwp, wpedsclrp, err_code ) + + ! Description: + ! Solves for both mean horizontal wind components, um and vm, and for the + ! eddy-scalars (passive scalars that don't use the high-order closure). + + ! Uses the LAPACK tridiagonal solver subroutine with 2 + # of scalar(s) + ! back substitutions (since the left hand side matrix is the same for all + ! input variables). + + ! References: + ! Eqn. 8 & 9 on p. 3545 of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variables(s) + + use crmx_parameters_model, only: & + ts_nudge, & ! Variable(s) + edsclr_dim + + use crmx_parameters_tunable, only: & + nu10_vert_res_dep ! Constant + + use crmx_model_flags, only: & + l_uv_nudge, & ! Variable(s) + l_tke_aniso + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update, & ! Subroutines + stat_end_update, & + stat_update_var + + use crmx_stats_variables, only: & + ium_ref, & ! Variables + ivm_ref, & + ium_sdmp, & + ivm_sdmp, & + ium_ndg, & + ivm_ndg, & + iwindm_matrix_condt_num, & + zt, & + l_stats_samp + + use crmx_clip_explicit, only: & + clip_covar ! Procedure(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level, & ! Procedure(s) + fatal_error + + use crmx_error_code, only: & + clubb_no_error, & ! Constant(s) + clubb_singular_matrix + + use crmx_constants_clubb, only: & + fstderr, & ! Constant(s) + eps + + use crmx_sponge_layer_damping, only: & + uv_sponge_damp_settings, & + uv_sponge_damp_profile, & + sponge_damp_xm ! Procedure(s) + + implicit none + + ! External + intrinsic :: real + + ! Constant Parameters + real( kind = core_rknd ), dimension(gr%nz) :: & + dummy_nu ! Used to feed zero values into function calls + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wm_zt, & ! w wind component on thermodynamic levels [m/s] + Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] + ug, & ! u (west-to-east) geostrophic wind comp. [m/s] + vg, & ! v (south-to-north) geostrophic wind comp. [m/s] + um_ref, & ! Reference u wind component for nudging [m/s] + vm_ref, & ! Reference v wind component for nudging [m/s] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + um_forcing, & ! u forcing [m/s/s] + vm_forcing, & ! v forcing [m/s/s] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] + + real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(in) :: & + edsclrm_forcing ! Eddy scalar large-scale forcing [{units vary}/s] + + real( kind = core_rknd ), intent(in) :: & + fcor ! Coriolis parameter [s^-1] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + um, & ! Mean u (west-to-east) wind component [m/s] + vm ! Mean v (south-to-north) wind component [m/s] + + ! Input/Output Variable for eddy-scalars + real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(inout) :: & + edsclrm ! Mean eddy scalar quantity [units vary] + + ! Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vpwp ! v'w' (momentum levels) [m^2/s^2] + + ! Output Variable for eddy-scalars + real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(inout) :: & + wpedsclrp ! w'edsclr' (momentum levels) [units vary] + + integer, intent(inout) :: & + err_code ! clubb_singular_matrix when matrix is singular + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + um_tndcy, & ! u wind component tendency [m/s^2] + vm_tndcy ! v wind component tendency [m/s^2] + + real( kind = core_rknd ), dimension(gr%nz) :: & + upwp_chnge, & ! Net change of u'w' due to clipping [m^2/s^2] + vpwp_chnge ! Net change of v'w' due to clipping [m^2/s^2] + + real( kind = core_rknd ), dimension(3,gr%nz) :: & + lhs ! The implicit part of the tridiagonal matrix [units vary] + + real( kind = core_rknd ), dimension(gr%nz,max(2,edsclr_dim)) :: & + rhs, &! The explicit part of the tridiagonal matrix [units vary] + solution ! The solution to the tridiagonal matrix [units vary] + + real( kind = core_rknd ), dimension(gr%nz) :: & + wind_speed ! wind speed; sqrt(u^2 + v^2) [m/s] + + real( kind = core_rknd ) :: & + u_star_sqd ! Surface friction velocity, u_star, squared [m/s] + + logical :: & + l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. + + integer :: & + err_code_windm, err_code_edsclrm, & ! Error code for each LAPACK solve + nrhs ! Number of right hand side terms + + integer :: i ! Array index + + logical :: l_first_clip_ts, l_last_clip_ts ! flags for clip_covar + + !--------------------------- Begin Code ------------------------------------ + + ! Initialize to no errors + err_code_windm = clubb_no_error + err_code_edsclrm = clubb_no_error + + dummy_nu = 0._core_rknd + + !---------------------------------------------------------------- + ! Prepare tridiagonal system for horizontal winds, um and vm + !---------------------------------------------------------------- + + ! Compute Coriolis, geostrophic, and other prescribed wind forcings for um. + call compute_uv_tndcy( windm_edsclrm_um, fcor, vm, vg, um_forcing, & ! in + l_implemented, & ! in + um_tndcy ) ! out + + ! Compute Coriolis, geostrophic, and other prescribed wind forcings for vm. + call compute_uv_tndcy( windm_edsclrm_vm, fcor, um, ug, vm_forcing, & ! in + l_implemented, & ! in + vm_tndcy ) ! out + + ! Momentum surface fluxes, u'w'|_sfc and v'w'|_sfc, are applied to through + ! an implicit method, such that: + ! x'w'|_sfc = - ( u_star(t)^2 / wind_speed(t) ) * xm(t+1). + l_imp_sfc_momentum_flux = .true. + ! Compute wind speed (use threshold "eps" to prevent divide-by-zero error). + wind_speed = max( sqrt( um**2 + vm**2 ), eps ) + ! Compute u_star_sqd according to the definition of u_star. + u_star_sqd = sqrt( upwp(1)**2 + vpwp(1)**2 ) + + ! Compute the explicit portion of the um equation. + ! Build the right-hand side vector. + rhs(1:gr%nz,windm_edsclrm_um) & + = windm_edsclrm_rhs( windm_edsclrm_um, dt, nu10_vert_res_dep, Kh_zm, um, & ! in + um_tndcy, & ! in + rho_ds_zm, invrs_rho_ds_zt, & ! in + l_imp_sfc_momentum_flux, upwp(1) ) ! in + + ! Compute the explicit portion of the vm equation. + ! Build the right-hand side vector. + rhs(1:gr%nz,windm_edsclrm_vm) & + = windm_edsclrm_rhs( windm_edsclrm_vm, dt, nu10_vert_res_dep, Kh_zm, vm, & ! in + vm_tndcy, & ! in + rho_ds_zm, invrs_rho_ds_zt, & ! in + l_imp_sfc_momentum_flux, vpwp(1) ) ! in + + + ! Store momentum flux (explicit component) + + ! The surface flux, x'w'(1) = x'w'|_sfc, is set elsewhere in the model. +! upwp(1) = upwp_sfc +! vpwp(1) = vpwp_sfc + + ! Solve for x'w' at all intermediate model levels. + ! A Crank-Nicholson timestep is used. + + upwp(2:gr%nz-1) = - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+ & + nu10_vert_res_dep(2:gr%nz-1), & ! in + um(2:gr%nz-1), um(3:gr%nz), & ! in + gr%invrs_dzm(2:gr%nz-1) ) + + vpwp(2:gr%nz-1) = - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+ & + nu10_vert_res_dep(2:gr%nz-1), & ! in + vm(2:gr%nz-1), vm(3:gr%nz), & ! in + gr%invrs_dzm(2:gr%nz-1) ) + + ! A zero-flux boundary condition at the top of the model, d(xm)/dz = 0, + ! means that x'w' at the top model level is 0, + ! since x'w' = - K_zm * d(xm)/dz. + upwp(gr%nz) = 0._core_rknd + vpwp(gr%nz) = 0._core_rknd + + + ! Compute the implicit portion of the um and vm equations. + ! Build the left-hand side matrix. + call windm_edsclrm_lhs( dt, nu10_vert_res_dep, wm_zt, Kh_zm, wind_speed, u_star_sqd, & ! in + rho_ds_zm, invrs_rho_ds_zt, & ! in + l_implemented, l_imp_sfc_momentum_flux, & ! in + lhs ) ! out + + ! Decompose and back substitute for um and vm + nrhs = 2 + call windm_edsclrm_solve( nrhs, iwindm_matrix_condt_num, & ! in + lhs, rhs, & ! in/out + solution, err_code_windm ) ! out + + !---------------------------------------------------------------- + ! Update zonal (west-to-east) component of mean wind, um + !---------------------------------------------------------------- + um(1:gr%nz) = solution(1:gr%nz,windm_edsclrm_um) + + !---------------------------------------------------------------- + ! Update meridional (south-to-north) component of mean wind, vm + !---------------------------------------------------------------- + vm(1:gr%nz) = solution(1:gr%nz,windm_edsclrm_vm) + + if ( l_stats_samp ) then + + ! Implicit contributions to um and vm + call windm_edsclrm_implicit_stats( windm_edsclrm_um, um ) ! in + + call windm_edsclrm_implicit_stats( windm_edsclrm_vm, vm ) ! in + + endif ! l_stats_samp + + ! The values of um(1) and vm(1) are located below the model surface and do + ! not effect the rest of the model. The values of um(1) or vm(1) are simply + ! set to the values of um(2) and vm(2), respectively, after the equation + ! matrices has been solved. Even though um and vm would sharply decrease + ! to a value of 0 at the surface, this is done to avoid confusion on plots + ! of the vertical profiles of um and vm. + um(1) = um(2) + vm(1) = vm(2) + + + if ( uv_sponge_damp_settings%l_sponge_damping ) then + if( l_stats_samp ) then + call stat_begin_update( ium_sdmp, um/real( dt, kind = core_rknd ), zt ) + call stat_begin_update( ivm_sdmp, vm/real( dt, kind = core_rknd ), zt ) + endif + + um(1:gr%nz) = sponge_damp_xm( dt, um_ref(1:gr%nz), um(1:gr%nz), & + uv_sponge_damp_profile ) + vm(1:gr%nz) = sponge_damp_xm( dt, vm_ref(1:gr%nz), vm(1:gr%nz), & + uv_sponge_damp_profile ) + if( l_stats_samp ) then + call stat_end_update( ium_sdmp, um/real( dt, kind = core_rknd ), zt ) + call stat_end_update( ivm_sdmp, vm/real( dt, kind = core_rknd ), zt ) + endif + + endif + + ! Second part of momentum (implicit component) + + ! Solve for x'w' at all intermediate model levels. + ! A Crank-Nicholson timestep is used. + + upwp(2:gr%nz-1) = upwp(2:gr%nz-1) & + - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+nu10_vert_res_dep(2:gr%nz-1), & + um(2:gr%nz-1), um(3:gr%nz), gr%invrs_dzm(2:gr%nz-1) ) !in + + vpwp(2:gr%nz-1) = vpwp(2:gr%nz-1) & + - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+nu10_vert_res_dep(2:gr%nz-1), & + vm(2:gr%nz-1), vm(3:gr%nz), gr%invrs_dzm(2:gr%nz-1) ) !in + + + ! Adjust um and vm if nudging is turned on. + if ( l_uv_nudge ) then + + ! Reflect nudging in budget + if( l_stats_samp ) then + call stat_begin_update( ium_ndg, um / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_begin_update( ivm_ndg, vm / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + end if + + um(1:gr%nz) = um(1:gr%nz) & + - ((um(1:gr%nz) - um_ref(1:gr%nz)) * (real( dt, kind = core_rknd )/ts_nudge)) + vm(1:gr%nz) = vm(1:gr%nz) & + - ((vm(1:gr%nz) - vm_ref(1:gr%nz)) * (real( dt, kind = core_rknd )/ts_nudge)) + endif + + if( l_stats_samp ) then + + ! Reflect nudging in budget + if ( l_uv_nudge ) then + call stat_end_update( ium_ndg, um / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_end_update( ivm_ndg, vm / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + end if + + call stat_update_var( ium_ref, um_ref, zt ) + call stat_update_var( ivm_ref, vm_ref, zt ) + end if + + if ( l_tke_aniso ) then + + ! Clipping for u'w' + ! + ! Clipping u'w' at each vertical level, based on the + ! correlation of u and w at each vertical level, such that: + ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ]; + ! -1 <= corr_(u,w) <= 1. + ! + ! Since u'^2, w'^2, and u'w' are each advanced in different subroutines from + ! each other in advance_clubb_core, clipping for u'w' has to be done three + ! times during each timestep (once after each variable has been updated). + ! This is the third instance of u'w' clipping. + l_first_clip_ts = .false. + l_last_clip_ts = .true. + call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, up2, & ! intent(in) + upwp, upwp_chnge ) ! intent(inout) + + ! Clipping for v'w' + ! + ! Clipping v'w' at each vertical level, based on the + ! correlation of v and w at each vertical level, such that: + ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ]; + ! -1 <= corr_(v,w) <= 1. + ! + ! Since v'^2, w'^2, and v'w' are each advanced in different subroutines from + ! each other in advance_clubb_core, clipping for v'w' has to be done three + ! times during each timestep (once after each variable has been updated). + ! This is the third instance of v'w' clipping. + l_first_clip_ts = .false. + l_last_clip_ts = .true. + call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, vp2, & ! intent(in) + vpwp, vpwp_chnge ) ! intent(inout) + + else + + ! In this case, it is assumed that + ! u'^2 == v'^2 == w'^2, and the variables `up2' and `vp2' do not interact with + ! any other variables. + l_first_clip_ts = .false. + l_last_clip_ts = .true. + call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, wp2, & ! intent(in) + upwp, upwp_chnge ) ! intent(inout) + + call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, wp2, & ! intent(in) + vpwp, vpwp_chnge ) ! intent(inout) + + endif ! l_tke_aniso + + + !---------------------------------------------------------------- + ! Prepare tridiagonal system for eddy-scalars + !---------------------------------------------------------------- + + if ( edsclr_dim > 0 ) then + + ! Eddy-scalar surface fluxes, x'w'|_sfc, are applied through an explicit + ! method. + l_imp_sfc_momentum_flux = .false. + + ! Compute the explicit portion of eddy scalar equation. + ! Build the right-hand side vector. + ! Because of statistics, we have to use a DO rather than a FORALL here + ! -dschanen 7 Oct 2008 +!HPF$ INDEPENDENT + do i = 1, edsclr_dim + rhs(1:gr%nz,i) & + = windm_edsclrm_rhs( windm_edsclrm_scalar, dt, dummy_nu, Kh_zm, & ! in + edsclrm(:,i), edsclrm_forcing, & ! in + rho_ds_zm, invrs_rho_ds_zt, & ! in + l_imp_sfc_momentum_flux, wpedsclrp(1,i) ) ! in + enddo + + + ! Store momentum flux (explicit component) + + ! The surface flux, x'w'(1) = x'w'|_sfc, is set elsewhere in the model. +! wpedsclrp(1,1:edsclr_dim) = wpedsclrp_sfc(1:edsclr_dim) + + ! Solve for x'w' at all intermediate model levels. + ! A Crank-Nicholson timestep is used. + ! Here we use a forall and high performance fortran directive to try to + ! parallelize this computation. Note that FORALL is more restrictive than DO. +!HPF$ INDEPENDENT, REDUCTION(wpedsclrp) + forall( i = 1:edsclr_dim ) + wpedsclrp(2:gr%nz-1,i) = & + - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1), edsclrm(2:gr%nz-1,i), & ! in + edsclrm(3:gr%nz,i), gr%invrs_dzm(2:gr%nz-1) ) ! in + end forall + + ! A zero-flux boundary condition at the top of the model, d(xm)/dz = 0, + ! means that x'w' at the top model level is 0, + ! since x'w' = - K_zm * d(xm)/dz. + wpedsclrp(gr%nz,1:edsclr_dim) = 0._core_rknd + + + ! Compute the implicit portion of the xm (eddy-scalar) equations. + ! Build the left-hand side matrix. + call windm_edsclrm_lhs( dt, dummy_nu, wm_zt, Kh_zm, wind_speed, u_star_sqd, & ! in + rho_ds_zm, invrs_rho_ds_zt, & ! in + l_implemented, l_imp_sfc_momentum_flux, & ! in + lhs ) ! out + + ! Decompose and back substitute for all eddy-scalar variables + call windm_edsclrm_solve( edsclr_dim, 0, & ! in + lhs, rhs, & ! in/out + solution, err_code_edsclrm ) ! out + + !---------------------------------------------------------------- + ! Update Eddy-diff. Passive Scalars + !---------------------------------------------------------------- + edsclrm(1:gr%nz,1:edsclr_dim) = solution(1:gr%nz,1:edsclr_dim) + + ! The value of edsclrm(1) is located below the model surface and does not + ! effect the rest of the model. The value of edsclrm(1) is simply set to + ! the value of edsclrm(2) after the equation matrix has been solved. + forall( i=1:edsclr_dim ) + edsclrm(1,i) = edsclrm(2,i) + end forall + + ! Second part of momentum (implicit component) + + ! Solve for x'w' at all intermediate model levels. + ! A Crank-Nicholson timestep is used. +!HPF$ INDEPENDENT, REDUCTION(wpedsclrp) + forall( i = 1:edsclr_dim ) + wpedsclrp(2:gr%nz-1,i) = wpedsclrp(2:gr%nz-1,i) & + - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1), edsclrm(2:gr%nz-1,i), & ! in + edsclrm(3:gr%nz,i), gr%invrs_dzm(2:gr%nz-1) ) ! in + end forall + + ! Note that the w'edsclr' terms are not clipped, since we don't compute the + ! variance of edsclr anywhere. -dschanen 7 Oct 2008 + + endif + + ! Check for singular matrices and bad LAPACK arguments + if ( fatal_error( err_code_windm ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Fatal error solving for um/vm" + end if + err_code = err_code_windm + end if + + if ( fatal_error( err_code_edsclrm ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Fatal error solving for eddsclrm" + end if + err_code = err_code_edsclrm + end if + + ! Error report + ! Joshua Fasching February 2008 + if ( ( fatal_error( err_code_windm ) .or. fatal_error( err_code_edsclrm ) ) .and. & + clubb_at_least_debug_level( 1 ) ) then + + write(fstderr,*) "Error in advance_windm_edsclrm" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "dt = ", dt + write(fstderr,*) "wm_zt = ", wm_zt + write(fstderr,*) "Kh_zm = ", Kh_zm + write(fstderr,*) "ug = ", ug + write(fstderr,*) "vg = ", vg + write(fstderr,*) "um_ref = ", um_ref + write(fstderr,*) "vm_ref = ", vm_ref + write(fstderr,*) "wp2 = ", wp2 + write(fstderr,*) "up2 = ", up2 + write(fstderr,*) "vp2 = ", vp2 + write(fstderr,*) "um_forcing = ", um_forcing + write(fstderr,*) "vm_forcing = ", vm_forcing + do i = 1, edsclr_dim + write(fstderr,*) "edsclrm_forcing # = ", i, edsclrm_forcing + end do + write(fstderr,*) "fcor = ", fcor + write(fstderr,*) "l_implemented = ", l_implemented + + write(fstderr,*) "Intent(inout)" + + write(fstderr,*) "um = ", um + write(fstderr,*) "vm = ", vm + do i = 1, edsclr_dim + write(fstderr,*) "edsclrm # ", i, "=", edsclrm(:,i) + end do + write(fstderr,*) "upwp = ", upwp + write(fstderr,*) "vpwp = ", vpwp + write(fstderr,*) "wpedsclrp = ", wpedsclrp + + !write(fstderr,*) "Intent(out)" + + return + + end if + + return + end subroutine advance_windm_edsclrm + + !============================================================================= + subroutine windm_edsclrm_solve( nrhs, ixm_matrix_condt_num, & + lhs, rhs, solution, err_code ) + + ! Note: In the "Description" section of this subroutine, the variable + ! "invrs_dzm" will be written as simply "dzm", and the variable + ! "invrs_dzt" will be written as simply "dzt". This is being done as + ! as device to save space and to make some parts of the description + ! more readable. This change does not pertain to the actual code. + + ! Description: + ! Solves the horizontal wind or eddy-scalar time-tendency equation, and + ! diagnoses the turbulent flux. A Crank-Nicholson time-stepping algorithm + ! is used in solving the turbulent advection term and in diagnosing the + ! turbulent flux. + ! + ! The rate of change of an eddy-scalar quantity, xm, is: + ! + ! d(xm)/dt = - w * d(xm)/dz - (1/rho_ds) * d( rho_ds * x'w' )/dz + ! + xm_forcings. + ! + ! + ! The Turbulent Advection Term + ! ---------------------------- + ! + ! The above equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * x'w' )/dz; + ! + ! where the momentum flux, x'w', is closed using a down gradient approach: + ! + ! x'w' = - K_zm * d(xm)/dz. + ! + ! The turbulent advection term becomes: + ! + ! + (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz; + ! + ! which is the same as a standard eddy-diffusion term (if "rho_ds * K_zm" in + ! the term above is substituted for "K_zm" in a standard eddy-diffusion + ! term, and if the standard eddy-diffusion term is multiplied by + ! "1/rho_ds"). Thus, the turbulent advection term is treated and solved in + ! the same way that a standard eddy-diffusion term would be solved. The + ! term is discretized as follows: + ! + ! The values of xm are found on the thermodynamic levels, while the values + ! of K_zm are found on the momentum levels. Additionally, the values of + ! rho_ds_zm are found on the momentum levels, and the values of + ! invrs_rho_ds_zt are found on the thermodynamic levels. The + ! derivatives (d/dz) of xm are taken over the intermediate momentum levels. + ! At the intermediate momentum levels, d(xm)/dz is multiplied by K_zm and by + ! rho_ds_zm. Then, the derivative of the whole mathematical expression is + ! taken over the central thermodynamic level, where it is multiplied by + ! invrs_rho_ds_zt, which yields the desired result. + ! + ! ---xm(kp1)----------------------------------------------------- t(k+1) + ! + ! ===========d(xm)/dz===K_zm(k)=====rho_ds_zm(k)================= m(k) + ! + ! ---xm(k)---invrs_rho_ds_zt---d[rho_ds_zm*K_zm*d(xm)/dz]/dz----- t(k) + ! + ! ===========d(xm)/dz===K_zm(km1)===rho_ds_zm(km1)=============== m(k-1) + ! + ! ---xm(km1)----------------------------------------------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) + ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) + ! + ! The vertically discretized form of the turbulent advection term (treated + ! as an eddy diffusion term) is written out as: + ! + ! + invrs_rho_ds_zt(k) + ! * dzt(k) + ! * [ rho_ds_zm(k) * K_zm(k) * dzm(k) * ( xm(k+1) - xm(k) ) + ! - rho_ds_zm(k-1) * K_zm(k-1) * dzm(k-1) * ( xm(k) - xm(k-1) ) ]. + ! + ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme is + ! used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz + ! eddy-diffusion term. The discretized implicit portion of the term is + ! written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(k) + ! * dzt(k) + ! * [ rho_ds_zm(k) * K_zm(k) + ! * dzm(k) * ( xm(k+1,) - xm(k,) ) + ! - rho_ds_zm(k-1) * K_zm(k-1) + ! * dzm(k-1) * ( xm(k,) - xm(k-1,) ) ]. + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "+" in front of the term + ! is changed to a "-". + ! + ! The discretized explicit portion of the term is written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(k) + ! * dzt(k) + ! * [ rho_ds_zm(k) * K_zm(k) + ! * dzm(k) * ( xm(k+1,) - xm(k,) ) + ! - rho_ds_zm(k-1) * K_zm(k-1) + ! * dzm(k-1) * ( xm(k,) - xm(k-1,) ) ]. + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(xm)/dt equation. + ! + ! + ! Boundary Conditions: + ! + ! An eddy-scalar quantity is not allowed to flux out the upper boundary. + ! Thus, a zero-flux boundary condition is used for the upper boundary in the + ! eddy-diffusion equation. + ! + ! The lower boundary condition is much more complicated. It is neither a + ! zero-flux nor a fixed-point boundary condition. Rather, it is a + ! fixed-flux boundary condition. This term is a turbulent advection term, + ! but with the eddy-scalars, the only value of x'w' relevant in solving the + ! d(xm)/dt equation is the value of x'w' at the surface (the first momentum + ! level), which is written as x'w'|_sfc. + ! + ! 1) x'w' surface flux; generalized explicit form + ! + ! The x'w' surface flux is applied to the d(xm)/dt equation through the + ! turbulent advection term, which is: + ! + ! - (1/rho_ds) * d( rho_ds * x'w' )/dz. + ! + ! At most vertical levels, a substitution can be made for x'w', such + ! that: + ! + ! x'w' = - K_zm * d(xm)/dz. + ! + ! However, the same substitution cannot be made at the surface (momentum + ! level 1), as x'w'|_sfc is a surface flux that is explicitly computed + ! elsewhere in the model code. + ! + ! The lower boundary condition, which in this case needs to be applied to + ! the d(xm)/dt equation at level 2, is discretized as follows: + ! + ! --xm(3)------------------------------------------------------- t(3) + ! + ! ========[x'w'(2) = -K_zm(2)*d(xm)/dz]===rho_ds_zm(2)========== m(2) + ! + ! --xm(2)---invrs_rho_ds_zt(2)---d[rho_ds_zm*K_zm*d(xm)/dz]/dz-- t(2) + ! + ! ========[x'w'|_sfc]=====================rho_ds_zm(1)========== m(1) sfc + ! + ! --xm(1)-------(below surface; not applicable)----------------- t(1) + ! + ! where "sfc" is the level of the model surface or lower boundary. + ! + ! The vertically discretized form of the turbulent advection term + ! (treated as an eddy diffusion term), with the explicit surface flux, + ! x'w'|_sfc, in place, is written out as: + ! + ! - invrs_rho_ds_zt(2) + ! * dzt(2) * [ rho_ds_zm(2) * x'w'(2) - rho_ds_zm(1) * x'w'|_sfc ]; + ! + ! which can be re-written as: + ! + ! + invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) + ! + rho_ds_zm(1) * x'w'|_sfc ]; + ! + ! which can be re-written again as: + ! + ! + invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) + ! + invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(1) * x'w'|_sfc. + ! + ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme + ! is used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz + ! eddy-diffusion term. The discretized implicit portion of the term is + ! written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) * K_zm(2) + ! * dzm(2) * ( xm(3,) - xm(2,) ) ]. + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "+" in front of the term + ! is changed to a "-". + ! + ! The discretized explicit portion of the term is written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) * K_zm(2) + ! * dzm(2) * ( xm(3,) - xm(2,) ) ] + ! + invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(1) * x'w'|_sfc. + ! + ! Note: The x'w'|_sfc portion of the term written above has been pulled + ! away from the rest of the explicit form written above because + ! the (1/2) factor due to Crank-Nicholson time_stepping does not + ! apply to it, as there isn't an implicit portion for x'w'|_sfc. + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which + ! is being advanced to in solving the d(xm)/dt equation. + ! + ! 2) x'w' surface flux; implicit form for momentum fluxes u'w' and v'w' + ! + ! The x'w' surface flux is applied to the d(xm)/dt equation through the + ! turbulent advection term, which is: + ! + ! - (1/rho_ds) * d( rho_ds * x'w' )/dz. + ! + ! At most vertical levels, a substitution can be made for x'w', such + ! that: + ! + ! x'w' = - K_zm * d(xm)/dz. + ! + ! However, the same substitution cannot be made at the surface (momentum + ! level 1), as x'w'|_sfc is a surface momentum flux that is found by the + ! following equation: + ! + ! x'w'|_sfc = - [ u_star^2 / sqrt( um^2 + vm^2 ) ] * xm; + ! + ! where x'w'|_sfc and xm are either u'w'|_sfc and um, respectively, or + ! v'w'|_sfc and vm, respectively (um and vm are located at the first + ! thermodynamic level above the surface, which is thermodynamic level 2), + ! sqrt( um^2 + vm^2 ) is the wind speed (also at thermodynamic level 2), + ! and u_star is defined as: + ! + ! u_star = ( u'w'|_sfc^2 + v'w'|_sfc^2 )^(1/4); + ! + ! and thus u_star^2 is defined as: + ! + ! u_star^2 = sqrt( u'w'|_sfc^2 + v'w'|_sfc^2 ). + ! + ! The value of u_star is either set to a constant value or computed + ! (through function diag_ustar) based on the surface wind speed, the + ! height above surface of the surface wind speed (as compared to the + ! roughness height), and the buoyancy flux at the surface. Either way, + ! u_star is computed elsewhere in the model, and the values of u'w'|_sfc + ! and v'w'|_sfc are based on it and computed along with it. The values + ! of u'w'|_sfc and v'w'|_sfc are then passed into advance_clubb_core, + ! and are eventually passed into advance_windm_edsclrm. In subroutine + ! advance_windm_edsclrm, the value of u_star_sqd is then recomputed + ! based on u'w'|_sfc and v'w'|_sfc. The value of sqrt( u_star_sqd ) is + ! consistent with the value of the original computation of u_star. + ! + ! The equation listed above is substituted for x'w'|_sfc. The lower + ! boundary condition, which in this case needs to be applied to the + ! d(xm)/dt equation at level 2, is discretized as follows: + ! + ! --xm(3)------------------------------------------------------- t(3) + ! + ! ===[x'w'(2) = -K_zm(2)*d(xm)/dz]=================rho_ds_zm(2)= m(2) + ! + ! --xm(2)---invrs_rho_ds_zt(2)---d[rho_ds_zm*K_zm*d(xm)/dz]/dz-- t(2) + ! + ! ===[x'w'|_sfc = -[u_star^2/sqrt(um^2+vm^2)]*xm]==rho_ds_zm(1)= m(1) sfc + ! + ! --xm(1)-------(below surface; not applicable)----------------- t(1) + ! + ! where "sfc" is the level of the model surface or lower boundary. + ! + ! The vertically discretized form of the turbulent advection term + ! (treated as an eddy diffusion term), with the implicit surface momentum + ! flux in place, is written out as: + ! + ! - invrs_rho_ds_zt(2) + ! * dzt(2) * [ rho_ds_zm(2) * x'w'(2) - rho_ds_zm(1) * x'w'|_sfc ]; + ! + ! which can be re-written as: + ! + ! - invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) + ! * { - K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) } + ! - rho_ds_zm(1) + ! * { - [ u_star^2 / sqrt( um(2)^2 + vm(2)^2 ) ] * xm(2) } ]; + ! + ! which can be re-written as: + ! + ! + invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) + ! - invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(1) * [ u_star^2 / sqrt( um(2)^2 + vm(2)^2 ) ] * xm(2). + ! + ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme + ! is used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz + ! eddy-diffusion term. The discretized implicit portion of the term is + ! written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) * K_zm(2) + ! * dzm(2) * ( xm(3,) - xm(2,) ) ] + ! - invrs_rho_ds_zt(2) + ! * dzt(2) + ! * rho_ds_zm(1) + ! * [u_star^2/sqrt( um(2,)^2 + vm(2,)^2 )] * xm(2,). + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the signs are reversed and the leading "+" in front of the first + ! part of the term is changed to a "-", while the leading "-" in + ! front of the second part of the term is changed to a "+". + ! + ! Note: The x'w'|_sfc portion of the term written above has been pulled + ! away from the rest of the implicit form written above because + ! the (1/2) factor due to Crank-Nicholson time_stepping does not + ! apply to it. The x'w'|_sfc portion of the term is treated + ! completely implicitly in order to enhance numerical stability. + ! + ! The discretized explicit portion of the term is written out as: + ! + ! + (1/2) * invrs_rho_ds_zt(2) + ! * dzt(2) + ! * [ rho_ds_zm(2) * K_zm(2) + ! * dzm(2) * ( xm(3,) - xm(2,) ) ]. + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which + ! is being advanced to in solving the d(xm)/dt equation. + ! + ! + ! The lower boundary condition for the implicit and explicit portions of the + ! turbulent advection term, without the x'w'|_sfc portion of the term, can + ! easily be invoked by using the zero-flux boundary conditions found in the + ! generalized diffusion function (function diffusion_zt_lhs), which is used + ! for many other equations in this model. Either the generalized explicit + ! surface flux needs to be added onto the explicit term after the diffusion + ! function has been called from subroutine windm_edsclrm_rhs, or the + ! implicit momentum surface flux needs to be added onto the implicit term + ! after the diffusion function has been called from subroutine + ! windm_edsclrm_lhs. However, all other equations in this model that use + ! zero-flux diffusion have level 1 as the level to which the lower boundary + ! condition needs to be applied. Thus, an adjuster will have to be used at + ! level 2 to call diffusion_zt_lhs with level 1 as the input level (the last + ! variable being passed in during the function call). However, the other + ! variables passed in (rho_ds_zm*K_zm, gr%dzt, and gr%dzm variables) will + ! have to be passed in as solving for level 2. + ! + ! The value of xm(1) is located below the model surface and does not effect + ! the rest of the model. Since xm can be either a horizontal wind component + ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the + ! value of xm(2) after the equation matrix has been solved. + ! + ! + ! Conservation Properties: + ! + ! When a fixed-flux lower boundary condition is used (combined with a + ! zero-flux upper boundary condition), this technique of discretizing the + ! turbulent advection term (treated as an eddy-diffusion term) leads to + ! conservative differencing. When the implicit momentum surface flux is + ! either zero or not used, the column totals for each column in the + ! left-hand side matrix (for the turbulent advection term) should be equal + ! to 0. Otherwise, the column total for the second column will be equal to + ! rho_ds_zm(1) * x'w'|_sfc. When the generalized explicit surface + ! flux is either zero or not used, the column total for the right-hand side + ! vector (for the turbulent advection term) should be equal to 0. + ! Otherwise, the column total for the right-hand side vector (for the + ! turbulent advection term) will be equal to rho_ds_zm(1) * x'w'|_sfc. + ! This ensures that the total amount of quantity xm over the entire vertical + ! domain is only changed by the surface flux (neglecting any forcing terms). + ! The total amount of change is equal to rho_ds_zm(1) * x'w'|_sfc. + ! + ! To see that this conservation law is satisfied by the left-hand side + ! matrix, compute the turbulent advection (treated as eddy diffusion) of xm, + ! neglecting any implicit momentum surface flux, multiply by rho_ds_zt, and + ! integrate vertically. In discretized matrix notation (where "i" stands + ! for the matrix column and "j" stands for the matrix row): + ! + ! 0 = Sum_j Sum_i + ! (rho_ds_zt)_i ( 1/dzt )_i + ! ( 0.5_core_rknd * (1/rho_ds_zt) * dzt * (rho_ds_zm*K_zm*dzm) )_ij (xm)_j. + ! + ! The left-hand side matrix, + ! ( 0.5_core_rknd * (1/rho_ds_zt) * dzt * (rho_ds_zm*K_zm*dzm) )_ij, is partially + ! written below. The sum over i in the above equation removes (1/rho_ds_zt) + ! and dzt everywhere from the matrix below. The sum over j leaves the + ! column totals that are desired, which are 0. + ! + ! Left-hand side matrix contributions from the turbulent advection term + ! (treated as an eddy-diffusion term using a Crank-Nicholson timestep); + ! first five vertical levels: + ! + ! -------------------------------------------------------------------------------> + !k=1 | 0 0 0 0 + ! | + !k=2 | 0 +0.5* -0.5* 0 + ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* + ! | dzt(k)* dzt(k)* + ! | rho_ds_zm(k)* rho_ds_zm(k)* + ! | K_zm(k)*dzm(k) K_zm(k)*dzm(k) + ! | + !k=3 | 0 -0.5* +0.5* -0.5* + ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* + ! | dzt(k)* dzt(k)* dzt(k)* + ! | rho_ds_zm(k-1)* [ rho_ds_zm(k)* rho_ds_zm(k)* + ! | K_zm(k-1)*dzm(k-1) K_zm(k)*dzm(k) K_zm(k)*dzm(k) + ! | +rho_ds_zm(k-1)* + ! | K_zm(k-1)*dzm(k-1) ] + ! | + !k=4 | 0 0 -0.5* +0.5* + ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* + ! | dzt(k)* dzt(k)* + ! | rho_ds_zm(k-1)* [ rho_ds_zm(k)* + ! | K_zm(k-1)*dzm(k-1) K_zm(k)*dzm(k) + ! | +rho_ds_zm(k-1)* + ! | K_zm(k-1)*dzm(k-1) ] + ! | + !k=5 | 0 0 0 -0.5* + ! | (1/rho_ds_zt(k))* + ! | dzt(k)* + ! | rho_ds_zm(k-1)* + ! | K_zm(k-1)*dzm(k-1) + ! \ / + ! + ! Note: The superdiagonal term from level 4 and both the main diagonal and + ! superdiagonal terms from level 5 are not shown on this diagram. + ! + ! Note: If an implicit momentum surface flux is used, an additional term, + ! + (1/rho_ds_zt(2)) * dzt(2) * rho_ds_zm(1) + ! * [ u_star^2 / sqrt( um(2,)^2 + vm(2,)^2 ) ], is added to + ! row 2 (k=2), column 2. + ! + ! To see that the above conservation law is satisfied by the right-hand side + ! vector, compute the turbulent advection (treated as eddy diffusion) of xm, + ! neglecting any generalized explicit surface flux, multiply by rho_ds_zt, + ! and integrate vertically. In discretized matrix notation (where "i" + ! stands for the matrix column and "j" stands for the matrix row): + ! + ! 0 = Sum_j Sum_i (rho_ds_zt)_i ( 1/dzt )_i ( rhs_vector )_j. + ! + ! The right-hand side vector, ( rhs_vector )_j, is partially written below. + ! The sum over i in the above equation removes (1/rho_ds_zt) and dzt + ! everywhere from the vector below. The sum over j leaves the column total + ! that is desired, which is 0. + ! + ! Right-hand side vector contributions from the turbulent advection term + ! (treated as an eddy-diffusion term using a Crank-Nicholson timestep); + ! first five vertical levels: + ! + ! -------------------------------------------- + !k=1 | 0 | + ! | | + ! | | + !k=2 | +0.5*(1/rho_ds_zt(k))* | + ! | dzt(k)* | + ! | [ rho_ds_zm(k)*K_zm(k)* | + ! | dzm(k)*(xm(k+1,)-xm(k,)) ] | + ! | | + !k=3 | +0.5*(1/rho_ds_zt(k))* | + ! | dzt(k)* | + ! | [ rho_ds_zm(k)*K_zm(k)* | + ! | dzm(k)*(xm(k+1,)-xm(k,)) | + ! | -rho_ds_zm(k-1)*K_zm(k-1)* | + ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | + ! | | + !k=4 | +0.5*(1/rho_ds_zt(k))* | + ! | dzt(k)* | + ! | [ rho_ds_zm(k)*K_zm(k)* | + ! | dzm(k)*(xm(k+1,)-xm(k,)) | + ! | -rho_ds_zm(k-1)*K_zm(k-1)* | + ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | + ! | | + !k=5 | +0.5*(1/rho_ds_zt(k))* | + ! | dzt(k)* | + ! | [ rho_ds_zm(k)*K_zm(k)* | + ! | dzm(k)*(xm(k+1,)-xm(k,)) | + ! | -rho_ds_zm(k-1)*K_zm(k-1)* | + ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | + ! \ / \ / + ! + ! Note: If a generalized explicit surface flux is used, an additional term, + ! + (1/rho_ds_zt(2)) * dzt(2) * rho_ds_zm(1) * x'w'|_sfc, is added to + ! row 2 (k=2). + ! + ! Note: Only the contributions by the turbulent advection term are shown + ! for both the left-hand side matrix and the right-hand side vector. + ! There are more terms in the equation, and thus more factors to be + ! added to both the left-hand side matrix (such as time tendency and + ! mean advection) and the right-hand side vector (such as xm + ! forcings). The left-hand side matrix is set-up so that a singular + ! matrix is not encountered. + + ! References: + ! Eqn. 8 & 9 on p. 3545 of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_lapack_wrap, only: & + tridag_solve, & ! Procedure(s) + tridag_solvex + + use crmx_stats_variables, only: & + sfc, & ! Variable(s) + l_stats_samp + + use crmx_stats_type, only: & + stat_update_var_pt ! Subroutine + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + + integer, intent(in) :: & + nrhs ! Number of right-hand side (explicit) vectors & Number of solution vectors. + + integer, intent(in) :: & + ixm_matrix_condt_num ! Stats index of the condition numbers + + real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & + lhs ! Implicit contributions to um, vm, and eddy scalars [units vary] + + real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(inout) :: & + rhs ! Right-hand side (explicit) contributions. + + real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(out) :: & + solution ! Solution to the system of equations [units vary] + + integer, intent(out) :: & + err_code ! clubb_singular_matrix when matrix is singular + + ! Local variables + real( kind = core_rknd ) :: & + rcond ! Estimate of the reciprocal of the condition number on the LHS matrix + + ! Solve tridiagonal system for xm. + if ( l_stats_samp .and. ixm_matrix_condt_num > 0 ) then + call tridag_solvex & + ( "windm_edsclrm", gr%nz, nrhs, & ! Intent(in) + lhs(kp1_tdiag,:), lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Intent(inout) + solution, rcond, err_code ) ! Intent(out) + + ! Est. of the condition number of the variance LHS matrix + call stat_update_var_pt( ixm_matrix_condt_num, 1, 1.0_core_rknd/rcond, & ! Intent(in) + sfc ) ! Intent(inout) + else + + call tridag_solve( "windm_edsclrm", gr%nz, nrhs, & ! In + lhs(kp1_tdiag,:), lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Inout + solution, err_code ) ! Out + end if + + return + end subroutine windm_edsclrm_solve + + !============================================================================= + subroutine windm_edsclrm_implicit_stats( solve_type, xm ) + + ! Description: + ! Compute implicit contributions to um and vm + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_stats_variables, only: & + ium_ma, & ! Variables + ium_ta, & + ivm_ma, & + ivm_ta, & + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + zt + + use crmx_stats_type, only: & + stat_end_update_pt, & ! Subroutines + stat_update_var_pt + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_grid_class, only: & + gr ! Derived type variable + + implicit none + + ! Input variables + integer, intent(in) :: & + solve_type ! Desc. of what is being solved for + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm ! Computed value um or vm at [m/s] + + ! Local variables + integer :: k, kp1, km1 ! Array indices + + ! Budget indices + integer :: ixm_ma, ixm_ta + + select case ( solve_type ) + case ( windm_edsclrm_um ) + ixm_ma = ium_ma + ixm_ta = ium_ta + + case ( windm_edsclrm_vm ) + ixm_ma = ivm_ma + ixm_ta = ivm_ta + + case default + ixm_ma = 0 + ixm_ta = 0 + + end select + + + ! Finalize implicit contributions for xm + + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! xm mean advection + ! xm term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixm_ma, k, & + ztscr01(k) * xm(km1) & + + ztscr02(k) * xm(k) & + + ztscr03(k) * xm(kp1), zt ) + + ! xm turbulent transport (implicit component) + ! xm term ta has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( ixm_ta, k, & + ztscr04(k) * xm(km1) & + + ztscr05(k) * xm(k) & + + ztscr06(k) * xm(kp1), zt ) + + enddo + + + ! Upper boundary conditions + k = gr%nz + km1 = max( k-1, 1 ) + + ! xm mean advection + ! xm term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixm_ma, k, & + ztscr01(k) * xm(km1) & + + ztscr02(k) * xm(k), zt ) + + ! xm turbulent transport (implicit component) + ! xm term ta has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( ixm_ta, k, & + ztscr04(k) * xm(km1) & + + ztscr05(k) * xm(k), zt ) + + + return + end subroutine windm_edsclrm_implicit_stats + + !============================================================================= + subroutine compute_uv_tndcy( solve_type, fcor, perp_wind_m, perp_wind_g, xm_forcing, & + l_implemented, xm_tndcy ) + + ! Description: + ! Computes the explicit tendency for the um and vm wind components. + ! + ! The only explicit tendency that is involved in the d(um)/dt or d(vm)/dt + ! equations is the Coriolis tendency. + ! + ! The d(um)/dt equation contains the term: + ! + ! - f * ( v_g - vm ); + ! + ! where f is the Coriolis parameter and v_g is the v component of the + ! geostrophic wind. + ! + ! Likewise, the d(vm)/dt equation contains the term: + ! + ! + f * ( u_g - um ); + ! + ! where u_g is the u component of the geostrophic wind. + ! + ! This term is treated completely explicitly. The values of um, vm, u_g, + ! and v_g are all found on the thermodynamic levels. + ! + ! Wind forcing from the GCSS cases is also added here. + ! + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr + + use crmx_stats_type, only: & + stat_update_var + + use crmx_stats_variables, only: & + ium_gf, & + ium_cf, & + ivm_gf, & + ivm_cf, & + ium_f, & + ivm_f, & + zt, & + l_stats_samp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: & + solve_type ! Description of what is being solved for + + real( kind = core_rknd ), intent(in) :: & + fcor ! Coriolis parameter [s^-1] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + perp_wind_m, & ! Perpendicular component of the mean wind (e.g. v, for the u-eqn) [m/s] + perp_wind_g, & ! Perpendicular component of the geostropic wind (e.g. vg) [m/s] + xm_forcing ! Prescribed wind forcing [m/s/s] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + ! Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + xm_tndcy ! xm tendency [m/s^2] + + ! Local Variables + integer :: & + ixm_gf, & + ixm_cf, & + ixm_f + + real( kind = core_rknd ), dimension(gr%nz) :: & + xm_gf, & + xm_cf + + ! --- Begin Code --- + + if ( .not. l_implemented ) then + ! Only compute the Coriolis term if the model is running on it's own, + ! and is not part of a larger, host model. + + select case ( solve_type ) + + case ( windm_edsclrm_um ) + + ixm_gf = ium_gf + ixm_cf = ium_cf + ixm_f = ium_f + + xm_gf = - fcor * perp_wind_g(1:gr%nz) + + xm_cf = fcor * perp_wind_m(1:gr%nz) + + case ( windm_edsclrm_vm ) + + ixm_gf = ivm_gf + ixm_cf = ivm_cf + ixm_f = ivm_f + + xm_gf = fcor * perp_wind_g(1:gr%nz) + + xm_cf = -fcor * perp_wind_m(1:gr%nz) + + case default + + ixm_gf = 0 + ixm_cf = 0 + ixm_f = 0 + + xm_gf = 0._core_rknd + + + xm_cf = 0._core_rknd + + end select + + xm_tndcy(1:gr%nz) = xm_gf(1:gr%nz) + xm_cf(1:gr%nz) & + + xm_forcing(1:gr%nz) + + if ( l_stats_samp ) then + + ! xm term gf is completely explicit; call stat_update_var. + call stat_update_var( ixm_gf, xm_gf, zt ) + + ! xm term cf is completely explicit; call stat_update_var. + call stat_update_var( ixm_cf, xm_cf, zt ) + + ! xm term F + call stat_update_var( ixm_f, xm_forcing, zt ) + endif + + else ! implemented in a host model. + + xm_tndcy = 0.0_core_rknd + + endif + + + return + end subroutine compute_uv_tndcy + +!=============================================================================== + subroutine windm_edsclrm_lhs( dt, nu, wm_zt, Kh_zm, wind_speed, u_star_sqd, & + rho_ds_zm, invrs_rho_ds_zt, & + l_implemented, l_imp_sfc_momentum_flux, & + lhs ) + + ! Description: + ! Calculate the implicit portion of the horizontal wind or eddy-scalar + ! time-tendency equation. See the description in subroutine + ! windm_edsclrm_solve for more details. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_diffusion, only: & + diffusion_zt_lhs ! Procedure(s) + + use crmx_mean_adv, only: & + term_ma_zt_lhs ! Procedures + + use crmx_stats_variables, only: & + ium_ma, & ! Variable(s) + ium_ta, & + ivm_ma, & + ivm_ta, & + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + l_stats_samp + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + nu ! Background constant coef. of eddy diffusivity [m^2/s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wm_zt, & ! w wind component on thermodynamic levels [m/s] + Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] + wind_speed, & ! wind speed; sqrt( u^2 + v^2 ) [m/s] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] + + real( kind = core_rknd ), intent(in) :: & + u_star_sqd ! Surface friction velocity, u_*, squared [m/s] + + logical, intent(in) :: & + l_implemented, & ! Flag for CLUBB being implemented in a larger model. + l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. + + ! Output Variable + real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & + lhs ! Implicit contributions to xm (tridiagonal matrix) + + ! Local Variables + integer :: k, km1 ! Array indices + integer :: diff_k_in + + real( kind = core_rknd ), dimension(3) :: tmp + + ! --- Begin Code --- + + ! Initialize the LHS array to zero. + lhs = 0.0_core_rknd + + do k = 2, gr%nz, 1 + + ! Define index + km1 = max( k-1, 1 ) + + ! LHS mean advection term. + if ( .not. l_implemented ) then + + lhs(kp1_tdiag:km1_tdiag,k) & + = lhs(kp1_tdiag:km1_tdiag,k) & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + + else + ! The host model is assumed to apply the advection term to the mean elsewhere in this case. + lhs(kp1_tdiag:km1_tdiag,k) & + = lhs(kp1_tdiag:km1_tdiag,k) + 0.0_core_rknd + + endif + + ! LHS turbulent advection term (solved as an eddy-diffusion term). + if ( k == 2 ) then + ! The lower boundary condition needs to be applied here at level 2. + ! The lower boundary condition is a "fixed flux" boundary condition. + ! The coding is the same as for a zero-flux boundary condition, but with + ! an extra term added on the right-hand side at the boundary level. For + ! the rest of the model code, a zero-flux boundary condition is applied + ! at level 1, and thus subroutine diffusion_zt_lhs is set-up to do that. + ! In order to apply the same boundary condition code here at level 2, an + ! adjuster needs to be used to tell diffusion_zt_lhs to use the code at + ! level 2 that it normally uses at level 1. + diff_k_in = 1 + else + diff_k_in = k + endif + lhs(kp1_tdiag:km1_tdiag,k) & + = lhs(kp1_tdiag:km1_tdiag,k) & + + 0.5_core_rknd * invrs_rho_ds_zt(k) & + * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & + rho_ds_zm(km1) * Kh_zm(km1), nu, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), diff_k_in ) + + ! LHS time tendency. + lhs(k_tdiag,k) & + = lhs(k_tdiag,k) + 1.0_core_rknd / real( dt, kind = core_rknd ) + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for um or vm. + ! Note: we don't track these budgets for the eddy scalar variables + + if ( ium_ma + ivm_ma > 0 ) then + if ( .not. l_implemented ) then + tmp(1:3) & + = term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + ztscr01(k) = -tmp(3) + ztscr02(k) = -tmp(2) + ztscr03(k) = -tmp(1) + else + ztscr01(k) = 0.0_core_rknd + ztscr02(k) = 0.0_core_rknd + ztscr03(k) = 0.0_core_rknd + endif + endif + + if ( ium_ta + ivm_ta > 0 ) then + tmp(1:3) & + = 0.5_core_rknd * invrs_rho_ds_zt(k) & + * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & + rho_ds_zm(km1) * Kh_zm(km1), nu, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), diff_k_in ) + ztscr04(k) = -tmp(3) + ztscr05(k) = -tmp(2) + ztscr06(k) = -tmp(1) + endif + + endif ! l_stats_samp + + enddo ! k = 2 .. gr%nz + + + ! Boundary Conditions + + ! Lower Boundary + + ! The lower boundary condition is a fixed-flux boundary condition, which + ! gets added into the time-tendency equation at level 2. + ! The value of xm(1) is located below the model surface and does not effect + ! the rest of the model. Since xm can be either a horizontal wind component + ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the + ! value of xm(2) after the equation matrix has been solved. + + ! k = 1 + lhs(k_tdiag,1) = 1.0_core_rknd + + ! k = 2; add implicit momentum surface flux. + if ( l_imp_sfc_momentum_flux ) then + + ! LHS momentum surface flux. + lhs(k_tdiag,2) & + = lhs(k_tdiag,2) & + + invrs_rho_ds_zt(2) & + * gr%invrs_dzt(2) & + * rho_ds_zm(1) * ( u_star_sqd / wind_speed(2) ) + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for um or vm. + + ! xm term ta is modified at level 2 to include the effects of the + ! surface flux. In this case, this effects the implicit portion of + ! the term (after zmscr05, which handles the main diagonal for the + ! turbulent advection term, has already been called at level 2). + ! Modify zmscr05 accordingly. + if ( ium_ta + ivm_ta > 0 ) then + ztscr05(2) & + = ztscr05(2) & + - invrs_rho_ds_zt(2) & + * gr%invrs_dzt(2) & + * rho_ds_zm(1) * ( u_star_sqd / wind_speed(2) ) + endif + + endif ! l_stats_samp + + endif ! l_imp_sfc_momentum_flux + + + return + end subroutine windm_edsclrm_lhs + + !============================================================================= + function windm_edsclrm_rhs( solve_type, dt, nu, Kh_zm, xm, xm_tndcy, & + rho_ds_zm, invrs_rho_ds_zt, & + l_imp_sfc_momentum_flux, xpwp_sfc ) & + result( rhs ) + + ! Description: + ! Calculate the explicit portion of the horizontal wind or eddy-scalar + ! time-tendency equation. See the description in subroutine + ! windm_edsclrm_solve for more details. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_diffusion, only: & + diffusion_zt_lhs ! Procedure(s) + + use crmx_stats_variables, only: & + ium_ta, & ! Variable(s) + ivm_ta, & + zt, & + l_stats_samp + + use crmx_stats_type, only: & + stat_begin_update_pt, & ! Procedure(s) + stat_modify_pt + + use crmx_grid_class, only: & + gr ! Variable(s) + + implicit none + + ! External + intrinsic :: max, min, real, trim + + ! Input Variables + integer, intent(in) :: & + solve_type ! Description of what is being solved for + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + nu ! Background constant coef. of eddy diffusivity [m^2/s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] + xm, & ! Eddy-scalar variable, xm (thermo. levels) [units vary] + xm_tndcy, & ! The explicit time-tendency acting on xm [units vary] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] + + real( kind = core_rknd ), intent(in) :: & + xpwp_sfc ! x'w' at the surface [units vary] + + logical, intent(in) :: & + l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz) :: & + rhs ! Right-hand side (explicit) contributions. + + ! Local Variables + integer :: k, kp1, km1 ! Array indices + integer :: diff_k_in + + ! For use in Crank-Nicholson eddy diffusion. + real( kind = core_rknd ), dimension(3) :: rhs_diff + + integer :: ixm_ta + + ! --- Begin Code --- + + select case ( solve_type ) + case ( windm_edsclrm_um ) + ixm_ta = ium_ta + case ( windm_edsclrm_vm ) + ixm_ta = ivm_ta + case default ! Eddy scalars + ixm_ta = 0 + end select + + + ! Initialize the RHS vector. + rhs = 0.0_core_rknd + + do k = 2, gr%nz-1, 1 + + ! Define indices + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! RHS turbulent advection term (solved as an eddy-diffusion term). + if ( k == 2 ) then + ! The lower boundary condition needs to be applied here at level 2. + ! The lower boundary condition is a "fixed flux" boundary condition. + ! The coding is the same as for a zero-flux boundary condition, but with + ! an extra term added on the right-hand side at the boundary level. For + ! the rest of the model code, a zero-flux boundary condition is applied + ! at level 1, and thus subroutine diffusion_zt_lhs is set-up to do that. + ! In order to apply the same boundary condition code here at level 2, an + ! adjuster needs to be used to tell diffusion_zt_lhs to use the code at + ! level 2 that it normally uses at level 1. + diff_k_in = 1 + else + diff_k_in = k + endif + rhs_diff(1:3) & + = 0.5_core_rknd * invrs_rho_ds_zt(k) & + * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & + rho_ds_zm(km1) * Kh_zm(km1), nu, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), diff_k_in ) + rhs(k) = rhs(k) & + - rhs_diff(3) * xm(km1) & + - rhs_diff(2) * xm(k) & + - rhs_diff(1) * xm(kp1) + + ! RHS forcings. + rhs(k) = rhs(k) + xm_tndcy(k) + + ! RHS time tendency + rhs(k) = rhs(k) + 1.0_core_rknd / real ( dt, kind = core_rknd ) * xm(k) + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for um or vm. + + ! xm term ta has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on right-hand side + ! turbulent advection component. + if ( ixm_ta > 0 ) then + call stat_begin_update_pt( ixm_ta, k, & + rhs_diff(3) * xm(km1) & + + rhs_diff(2) * xm(k) & + + rhs_diff(1) * xm(kp1), zt ) + endif + + endif ! l_stats_samp + + enddo ! 2..gr%nz-1 + + + ! Boundary Conditions + + ! Lower Boundary + + ! The lower boundary condition is a fixed-flux boundary condition, which + ! gets added into the time-tendency equation at level 2. + ! The value of xm(1) is located below the model surface and does not effect + ! the rest of the model. Since xm can be either a horizontal wind component + ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the + ! value of xm(2) after the equation matrix has been solved. For purposes of + ! the matrix equation, rhs(1) is simply set to 0. + + ! k = 1 + rhs(1) = 0.0_core_rknd + + ! k = 2; add generalized explicit surface flux. + if ( .not. l_imp_sfc_momentum_flux ) then + + ! RHS generalized surface flux. + rhs(2) & + = rhs(2) & + + invrs_rho_ds_zt(2) & + * gr%invrs_dzt(2) & + * rho_ds_zm(1) * xpwp_sfc + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for um or vm. + + ! xm term ta is modified at level 2 to include the effects of the + ! surface flux. In this case, this effects the explicit portion of + ! the term (after stat_begin_update_pt has already been called at + ! level 2); call stat_modify_pt. + if ( ixm_ta > 0 ) then + call stat_modify_pt( ixm_ta, 2, & + + invrs_rho_ds_zt(2) & + * gr%invrs_dzt(2) & + * rho_ds_zm(1) * xpwp_sfc, & + zt ) + endif + + endif ! l_stats_samp + + endif ! l_imp_sfc_momentum_flux + + ! Upper Boundary + + ! A zero-flux boundary condition is used at the upper boundary, meaning that + ! xm is not allowed to exit the model through the upper boundary. This + ! boundary condition is invoked by calling diffusion_zt_lhs at the uppermost + ! level. + k = gr%nz + km1 = max( k-1, 1 ) + + ! RHS turbulent advection term (solved as an eddy-diffusion term) at the + ! upper boundary. + rhs_diff(1:3) & + = 0.5_core_rknd * invrs_rho_ds_zt(k) & + * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & + rho_ds_zm(km1) * Kh_zm(km1), nu, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + rhs(k) = rhs(k) & + - rhs_diff(3) * xm(km1) & + - rhs_diff(2) * xm(k) + + ! RHS forcing term at the upper boundary. + rhs(k) = rhs(k) + xm_tndcy(k) + + ! RHS time tendency term at the upper boundary. + rhs(k) = rhs(k) + 1.0_core_rknd / real( dt, kind = core_rknd ) * xm(k) + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for um or vm. + + ! xm term ta has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on right-hand side + ! turbulent advection component. + if ( ixm_ta > 0 ) then + call stat_begin_update_pt( ixm_ta, k, & + rhs_diff(3) * xm(km1) & + + rhs_diff(2) * xm(k), zt ) + endif + + endif ! l_stats_samp + + + return + end function windm_edsclrm_rhs + +!=============================================================================== + elemental function xpwp_fnc( Kh_zm, xm, xmp1, invrs_dzm ) + + ! Description: + ! Compute x'w' from x, x, Kh and invrs_dzm + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + real( kind = core_rknd ), intent(in) :: & + Kh_zm, & ! Eddy diff. (k momentum level) [m^2/s] + xm, & ! x (k thermo level) [units vary] + xmp1, & ! x (k+1 thermo level) [units vary] + invrs_dzm ! Inverse of the grid spacing (k thermo level) [1/m] + + ! Output variable + real( kind = core_rknd ) :: & + xpwp_fnc ! x'w' [(units vary)(m/s)] + + !----------------------------------------------------------------------- + ! --- Begin Code --- + + ! Solve for x'w' at all intermediate model levels. + xpwp_fnc = Kh_zm * invrs_dzm * ( xmp1 - xm ) + + return + end function xpwp_fnc + +!=============================================================================== + +end module crmx_advance_windm_edsclrm_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 new file mode 100644 index 0000000000..cefd03f334 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 @@ -0,0 +1,4427 @@ +!------------------------------------------------------------------------ +! $Id: advance_wp2_wp3_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +!=============================================================================== +module crmx_advance_wp2_wp3_module + + implicit none + + private ! Default Scope + + public :: advance_wp2_wp3 + + private :: wp23_solve, & + wp23_lhs, & + wp23_rhs, & + wp2_term_ta_lhs, & + wp2_terms_ac_pr2_lhs, & + wp2_term_dp1_lhs, & + wp2_term_pr1_lhs, & + wp2_terms_bp_pr2_rhs, & + wp2_term_dp1_rhs, & + wp2_term_pr3_rhs, & + wp2_term_pr1_rhs, & + wp3_terms_ta_tp_lhs, & + wp3_terms_ac_pr2_lhs, & + wp3_term_pr1_lhs, & + wp3_terms_bp1_pr2_rhs, & + wp3_term_pr1_rhs, & + wp3_term_bp2_rhs + +! private :: wp3_terms_ta_tp_rhs + + ! Private named constants to avoid string comparisons + integer, parameter, private :: & + clip_wp2 = 12 ! Named constant for wp2 clipping. + ! NOTE: This must be the same as the clip_wp2 declared in + ! clip_explicit! + + contains + + !============================================================================= + subroutine advance_wp2_wp3( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & + a3, a3_zt, wp3_on_wp2, & + wpthvp, wp2thvp, um, vm, upwp, vpwp, & + up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & + Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & + thv_ds_zm, thv_ds_zt, mixt_frac, & + wp2, wp3, wp3_zm, wp2_zt, err_code ) + + ! Description: + ! Advance w'^2 and w'^3 one timestep. + + ! References: + ! Eqn. 12 & 18 on p. 3545--3546 of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + + ! See also + ! ``Equations for CLUBB'', Section 6: + ! /Implict solution for the vertical velocity moments/ + !------------------------------------------------------------------------ + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zt2zm, & ! Procedure(s) + zm2zt + + use crmx_parameters_tunable, only: & + C11c, & ! Variable(s) + C11b, & + C11, & + C1c, & + C1b, & + C1, & + c_K1, & + c_K8 + + use crmx_stats_type, only: & + stat_update_var + + use crmx_stats_variables, only: & + iC1_Skw_fnc, & + iC11_Skw_fnc, & + zm, & + zt, & + l_stats_samp + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_model_flags, only: & + l_hyper_dfsn ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_error_code, only: & + fatal_error, & ! Procedure(s) + clubb_at_least_debug_level + + use crmx_error_code, only: & + clubb_var_out_of_range ! Constant(s) + + implicit none + + intrinsic :: exp + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + wpthvp, & ! w'th_v' (momentum levels) [K m/s] + wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] + um, & ! u wind component (thermodynamic levels) [m/s] + vm, & ! v wind component (thermodynamic levels) [m/s] + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vpwp, & ! v'w' (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] + Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] + tau_zm, & ! Time-scale tau on momentum levels [s] + tau_zt, & ! Time-scale tau on thermodynamic levels [s] + Skw_zm, & ! Skewness of w on momentum levels [-] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + radf, & ! Buoyancy production at the CL top [m^2/s^3] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K] + mixt_frac ! Weight of 1st normal distribution [-] + + ! Input/Output + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] + wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3] + + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] + + integer, intent(inout) :: err_code ! Diagnostic + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + tauw3t ! Currently just tau_zt [s] + + ! Eddy Diffusion for w'^2 and w'^3. + real( kind = core_rknd ), dimension(gr%nz) :: Kw1 ! w'^2 coef. eddy diff. [m^2/s] + real( kind = core_rknd ), dimension(gr%nz) :: Kw8 ! w'^3 coef. eddy diff. [m^2/s] + + ! Internal variables for C11 function, Vince Larson 13 Mar 2005 + ! Brian added C1 function. + real( kind = core_rknd ), dimension(gr%nz) :: & + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc ! C_11 parameter with Sk_w applied [-] + ! End Vince Larson's addition. + + integer :: & + nsub, & ! Number of subdiagonals in the LHS matrix. + nsup ! Number of superdiagonals in the LHS matrix. + + integer :: k ! Array indices + + integer :: wp2_wp3_err_code ! Error code from solving for wp2/wp3 + + + !----------------------------------------------------------------------- + + + +! Define tauw + +! tauw3t = tau_zt +! . / ( 1. +! . + 3.0_core_rknd * max( +! . min(1.-(mixt_frac-0.01_core_rknd)/(0.05_core_rknd-0.01_core_rknd) +! . ,1.) +! . ,0.) +! . + 3.0_core_rknd * max( +! . min(1.-(mixt_frac-0.99_core_rknd)/(0.95_core_rknd-0.99_core_rknd) +! . ,1.) +! . ,0.) +! . ) + +! do k=1,gr%nz +! +! Skw = abs( wp3(k)/max(wp2(k),1.e-8)**1.5_core_rknd ) +! Skw = min( 5.0_core_rknd, Skw ) +! tauw3t(k) = tau_zt(k) / ( 0.005_core_rknd*Skw**4 + 1.0_core_rknd ) +! +! end do + + tauw3t = tau_zt + + ! Vince Larson added code to make C11 function of Skw. 13 Mar 2005 + ! If this code is used, C11 is no longer relevant, i.e. constants + ! are hardwired. + + ! Calculate C_{1} and C_{11} as functions of skewness of w. + ! The if..then here is only for computational efficiency -dschanen 2 Sept 08 + if ( C11 /= C11b ) then + C11_Skw_fnc(1:gr%nz) = & + C11b + (C11-C11b)*EXP( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zt(1:gr%nz)/C11c)**2 ) + else + C11_Skw_fnc(1:gr%nz) = C11b + end if + + ! The if..then here is only for computational efficiency -dschanen 2 Sept 08 + if ( C1 /= C1b ) then + C1_Skw_fnc(1:gr%nz) = & + C1b + (C1-C1b)*EXP( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm(1:gr%nz)/C1c)**2 ) + else + C1_Skw_fnc(1:gr%nz) = C1b + end if + + !C11_Skw_fnc = C11 + !C1_Skw_fnc = C1 + + if ( clubb_at_least_debug_level( 2 ) ) then + ! Assertion check for C11_Skw_fnc + if ( any( C11_Skw_fnc(:) > 1._core_rknd ) .or. any( C11_Skw_fnc(:) < 0._core_rknd ) ) then + write(fstderr,*) "The C11_Skw_fnc is outside the valid range for this variable" + err_code = clubb_var_out_of_range + return + end if + end if + + if ( l_stats_samp ) then + call stat_update_var( iC11_Skw_fnc, C11_Skw_fnc, zt ) + call stat_update_var( iC1_Skw_fnc, C1_Skw_fnc, zm ) + endif + + ! Define the Coefficent of Eddy Diffusivity for the wp2 and wp3. + do k = 1, gr%nz, 1 + + ! Kw1 is used for wp2, which is located on momentum levels. + ! Kw1 is located on thermodynamic levels. + ! Kw1 = c_K1 * Kh_zt + Kw1(k) = c_K1 * Kh_zt(k) + + ! Kw8 is used for wp3, which is located on thermodynamic levels. + ! Kw8 is located on momentum levels. + ! Note: Kw8 is usually defined to be 1/2 of Kh_zm. + ! Kw8 = c_K8 * Kh_zm + Kw8(k) = c_K8 * Kh_zm(k) + + enddo + + ! Declare the number of subdiagonals and superdiagonals in the LHS matrix. + if ( l_hyper_dfsn ) then + ! There are nine overall diagonals (including four subdiagonals + ! and four superdiagonals). + nsub = 4 + nsup = 4 + else + ! There are five overall diagonals (including two subdiagonals + ! and two superdiagonals). + nsub = 2 + nsup = 2 + endif + + ! Solve semi-implicitly + call wp23_solve( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! Intent(in) + a3, a3_zt, wp3_on_wp2, & ! Intent(in) + wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! Intent(in) + up2, vp2, Kw1, Kw8, Kh_zt, Skw_zt, tau_zm, tauw3t, & ! Intent(in) + C1_Skw_fnc, C11_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, radf, thv_ds_zm, & ! Intent(in) + thv_ds_zt, nsub, nsup, & ! Intent(in) + wp2, wp3, wp3_zm, wp2_zt, wp2_wp3_err_code ) ! Intent(inout) + +! Error output +! Joshua Fasching Feb 2008 + if ( fatal_error( wp2_wp3_err_code ) ) then + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Errors in advance_wp2_wp3" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "dt = ", dt + write(fstderr,*) "sfc_elevation = ", sfc_elevation + write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w + write(fstderr,*) "wm_zm = ", wm_zm + write(fstderr,*) "wm_zt = ", wm_zt + write(fstderr,*) "wpthvp = ", wpthvp + write(fstderr,*) "wp2thvp = ", wp2thvp + write(fstderr,*) "um = ", um + write(fstderr,*) "vm = ", vm + write(fstderr,*) "upwp = ", upwp + write(fstderr,*) "vpwp = ", vpwp + write(fstderr,*) "up2 = ", up2 + write(fstderr,*) "vp2 = ", vp2 + write(fstderr,*) "Kh_zm = ", Kh_zm + write(fstderr,*) "Kh_zt = ", Kh_zt + write(fstderr,*) "tau_zm = ", tau_zm + write(fstderr,*) "tau_zt = ", tau_zt + write(fstderr,*) "Skw_zm = ", Skw_zm + write(fstderr,*) "Skw_zt = ", Skw_zt + write(fstderr,*) "mixt_frac = ", mixt_frac + write(fstderr,*) "wp2zt = ", wp2_zt + + write(fstderr,*) "Intent(in/out)" + + write(fstderr,*) "wp2 = ", wp2 + write(fstderr,*) "wp3 = ", wp3 + + end if + + err_code = wp2_wp3_err_code + end if ! fatal error + + return + + end subroutine advance_wp2_wp3 + + !============================================================================= + subroutine wp23_solve( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & + a3, a3_zt, wp3_on_wp2, & + wpthvp, wp2thvp, um, vm, upwp, vpwp, & + up2, vp2, Kw1, Kw8, Kh_zt, Skw_zt, tau1m, tauw3t, & + C1_Skw_fnc, C11_Skw_fnc, rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, radf, thv_ds_zm, & + thv_ds_zt, nsub, nsup, & + wp2, wp3, wp3_zm, wp2_zt, err_code ) + + ! Description: + ! Decompose, and back substitute the matrix for wp2/wp3 + + ! References: + ! _Equations for CLUBB_ section 6.3 + !------------------------------------------------------------------------ + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_grid_class, only: & + zm2zt, & ! Function(s) + zt2zm, & + ddzt + + use crmx_constants_clubb, only: & + w_tol_sqd, & ! Variables(s) + eps, & + zero_threshold, & + fstderr + + use crmx_model_flags, only: & + l_tke_aniso, & ! Variable(s) + l_hyper_dfsn, & + l_hole_fill, & + l_gmres + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_lapack_wrap, only: & + band_solve, & ! Procedure(s) + band_solvex + + use crmx_fill_holes, only: & + fill_holes_driver + + use crmx_clip_explicit, only: & + clip_variance, & ! Procedure(s) + clip_skewness + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_update_var_pt, & + stat_end_update, & + stat_end_update_pt + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + zt, & + sfc, & + l_stats_samp, & + iwp2_ta, & + iwp2_ma, & + iwp2_pd, & + iwp2_ac, & + iwp2_dp1, & + iwp2_dp2, & + iwp2_pr1, & + iwp2_pr2, & + iwp2_4hd, & + iwp3_ta, & + iwp3_ma, & + iwp3_tp, & + iwp3_ac, & + iwp3_dp1, & + iwp3_pr1, & + iwp3_pr2, & + iwp3_4hd, & + iwp23_matrix_condt_num + + use crmx_stats_variables, only: & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + ztscr01, & + ztscr02 + + use crmx_stats_variables, only: & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + implicit none + + ! External + intrinsic :: max, min, sqrt + + ! Parameter Constants + integer, parameter :: & + nrhs = 1 ! Number of RHS vectors + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + wpthvp, & ! w'th_v' (momentum levels) [K m/s] + wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] + um, & ! u wind component (thermodynamic levels) [m/s] + vm, & ! v wind component (thermodynamic levels) [m/s] + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vpwp, & ! v'w' (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] + Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] + Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + tau1m, & ! Time-scale tau on momentum levels [s] + tauw3t, & ! Time-scale tau on thermodynamic levels [s] + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + radf, & ! Buoyancy production at CL top [m^2/s^3] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] + + integer, intent(in) :: & + nsub, & ! Number of subdiagonals in the LHS matrix. + nsup ! Number of superdiagonals in the LHS matrix. + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] + wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3] + + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] + + integer, intent(inout) :: err_code ! Have any errors occured? + + ! Local Variables + real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & + lhs ! Implicit contributions to wp2/wp3 (band diag. matrix) + + real( kind = core_rknd ), dimension(2*gr%nz) :: & + rhs ! RHS of band matrix + +! real, target, dimension(2*gr%nz) :: + real( kind = core_rknd ), dimension(2*gr%nz) :: & + solut ! Solution to band diagonal system. + + real( kind = core_rknd ), dimension(gr%nz) :: & + a1, & ! a_1 (momentum levels); See eqn. 23 in `Equations for CLUBB' [-] + a1_zt ! a_1 interpolated to thermodynamic levels [-] + +! real, dimension(gr%nz) :: & +! wp2_n ! w'^2 at the previous timestep [m^2/s^2] + + real( kind = core_rknd ) :: & + rcond ! Est. of the reciprocal of the condition # + + ! Array indices + integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3 + + ! Set logical to true for Crank-Nicholson diffusion scheme + ! or to false for completely implicit diffusion scheme. + ! Note: Although Crank-Nicholson diffusion has usually been used for wp2 + ! and wp3 in the past, we found that using completely implicit + ! diffusion stabilized the deep convective cases more while having + ! almost no effect on the boundary layer cases. Brian; 1/4/2008. +! logical, parameter :: l_crank_nich_diff = .true. + logical, parameter :: l_crank_nich_diff = .false. + + ! Define a_1 and a_3 (both are located on momentum levels). + ! They are variables that are both functions of sigma_sqd_w (where + ! sigma_sqd_w is located on momentum levels). + + a1 = 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w ) + + ! Interpolate a_1 from momentum levels to thermodynamic + ! levels. This will be used for the w'^3 turbulent advection + ! (ta) and turbulent production (tp) combined term. + a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity + + ! Compute the explicit portion of the w'^2 and w'^3 equations. + ! Build the right-hand side vector. + call wp23_rhs( dt, wp2, wp3, a1, a1_zt, & + a3, a3_zt, wp3_on_wp2, wpthvp, wp2thvp, um, vm, & + upwp, vpwp, up2, vp2, Kw1, Kw8, Kh_zt, & + Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, invrs_rho_ds_zt, radf, & + thv_ds_zm, thv_ds_zt, l_crank_nich_diff, & + rhs ) + + if (l_gmres) then + call wp23_gmres( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsup, nsub, nrhs, & + rhs, & + solut, err_code ) + else + ! Compute the implicit portion of the w'^2 and w'^3 equations. + ! Build the left-hand side matrix. + call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & + lhs ) + + ! Solve the system with LAPACK + if ( l_stats_samp .and. iwp23_matrix_condt_num > 0 ) then + + ! Perform LU decomp and solve system (LAPACK with diagnostics) + ! Note that this can change the answer slightly + call band_solvex( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solut, rcond, err_code ) + + ! Est. of the condition number of the w'^2/w^3 LHS matrix + call stat_update_var_pt( iwp23_matrix_condt_num, 1, 1.0_core_rknd / rcond, sfc ) + + else + ! Perform LU decomp and solve system (LAPACK) + call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solut, err_code ) + end if + + end if ! l_gmres + + ! Copy result into output arrays and clip + + do k = 1, gr%nz + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + ! wp2_n(k) = wp2(k) ! For the positive definite scheme + + wp2(k) = solut(k_wp2) + wp3(k) = solut(k_wp3) + + end do + + if (l_stats_samp) then + + ! Finalize implicit contributions for wp2 + + do k = 2, gr%nz-1 + + km1 = max( k-1, 1 ) + km2 = max( k-2, 1 ) + kp1 = min( k+1, gr%nz ) + kp2 = min( k+2, gr%nz ) + + ! w'^2 term dp1 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp2_dp1, k, & + zmscr01(k) * wp2(k), zm ) + + ! w'^2 term dp2 has both implicit and explicit components (if the + ! Crank-Nicholson scheme is selected); call stat_end_update_pt. + ! If Crank-Nicholson diffusion is not selected, then w'^3 term dp1 is + ! completely implicit; call stat_update_var_pt. + if ( l_crank_nich_diff ) then + call stat_end_update_pt( iwp2_dp2, k, & + zmscr02(k) * wp2(km1) & + + zmscr03(k) * wp2(k) & + + zmscr04(k) * wp2(kp1), zm ) + else + call stat_update_var_pt( iwp2_dp2, k, & + zmscr02(k) * wp2(km1) & + + zmscr03(k) * wp2(k) & + + zmscr04(k) * wp2(kp1), zm ) + endif + + ! w'^2 term ta is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwp2_ta, k, & + zmscr05(k) * wp3(k) & + + zmscr06(k) * wp3(kp1), zm ) + + ! w'^2 term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwp2_ma, k, & + zmscr07(k) * wp2(km1) & + + zmscr08(k) * wp2(k) & + + zmscr09(k) * wp2(kp1), zm ) + + ! w'^2 term ac is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwp2_ac, k, & + zmscr10(k) * wp2(k), zm ) + + ! w'^2 term pr1 has both implicit and explicit components; + ! call stat_end_update_pt. + if ( l_tke_aniso ) then + call stat_end_update_pt( iwp2_pr1, k, & + zmscr12(k) * wp2(k), zm ) + endif + + ! w'^2 term pr2 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp2_pr2, k, & + zmscr11(k) * wp2(k), zm ) + + ! w'^2 term 4hd is completely implicit; call stat_update_var_pt. + if ( l_hyper_dfsn ) then + call stat_update_var_pt( iwp2_4hd, k, & + zmscr13(k) * wp2(km2) & + + zmscr14(k) * wp2(km1) & + + zmscr15(k) * wp2(k) & + + zmscr16(k) * wp2(kp1) & + + zmscr17(k) * wp2(kp2), zm ) + endif + enddo + + ! Finalize implicit contributions for wp3 + + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + km2 = max( k-2, 1 ) + kp1 = min( k+1, gr%nz ) + kp2 = min( k+2, gr%nz ) + + ! w'^3 term pr1 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp3_pr1, k, & + ztscr01(k) * wp3(k), zt ) + + ! w'^3 term dp1 has both implicit and explicit components (if the + ! Crank-Nicholson scheme is selected); call stat_end_update_pt. + ! If Crank-Nicholson diffusion is not selected, then w'^3 term dp1 is + ! completely implicit; call stat_update_var_pt. + if ( l_crank_nich_diff ) then + call stat_end_update_pt( iwp3_dp1, k, & + ztscr02(k) * wp3(km1) & + + ztscr03(k) * wp3(k) & + + ztscr04(k) * wp3(kp1), zt ) + else + call stat_update_var_pt( iwp3_dp1, k, & + ztscr02(k) * wp3(km1) & + + ztscr03(k) * wp3(k) & + + ztscr04(k) * wp3(kp1), zt ) + endif + + ! w'^3 term ta has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp3_ta, k, & + ztscr05(k) * wp3(km1) & + + ztscr06(k) * wp2(km1) & + + ztscr07(k) * wp3(k) & + + ztscr08(k) * wp2(k) & + + ztscr09(k) * wp3(kp1), zt ) + + ! w'^3 term tp has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp3_tp, k, & + ztscr10(k) * wp2(km1) & + + ztscr11(k) * wp2(k), zt ) + + ! w'^3 term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwp3_ma, k, & + ztscr12(k) * wp3(km1) & + + ztscr13(k) * wp3(k) & + + ztscr14(k) * wp3(kp1), zt ) + + ! w'^3 term ac is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwp3_ac, k, & + ztscr15(k) * wp3(k), zt ) + + ! w'^3 term pr2 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwp3_pr2, k, & + ztscr16(k) * wp3(k), zt ) + + ! w'^3 term 4hd is completely implicit; call stat_update_var_pt. + if ( l_hyper_dfsn ) then + call stat_update_var_pt( iwp3_4hd, k, & + ztscr17(k) * wp3(km2) & + + ztscr18(k) * wp3(km1) & + + ztscr19(k) * wp3(k) & + + ztscr20(k) * wp3(kp1) & + + ztscr21(k) * wp3(kp2), zt ) + endif + enddo + + endif ! l_stats_samp + + + if ( l_stats_samp ) then + ! Store previous value for effect of the positive definite scheme + call stat_begin_update( iwp2_pd, wp2 / real( dt, kind = core_rknd ), zm ) + endif + + if ( l_hole_fill .and. any( wp2 < w_tol_sqd ) ) then + + ! Use a simple hole filling algorithm + call fill_holes_driver( 2, w_tol_sqd, "zm", & + rho_ds_zt, rho_ds_zm, & + wp2 ) + + endif ! wp2 + + ! Here we attempt to clip extreme values of wp2 to prevent a crash of the + ! type found on the Climate Process Team ticket #49. Chris Golaz found that + ! instability caused by large wp2 in CLUBB led unrealistic results in AM3. + ! -dschanen 11 Apr 2011 + where ( wp2 > 1000._core_rknd ) wp2 = 1000._core_rknd + + if ( l_stats_samp ) then + ! Store updated value for effect of the positive definite scheme + call stat_end_update( iwp2_pd, wp2 / real( dt, kind = core_rknd ), zm ) + endif + + + ! Clip w'^2 at a minimum threshold. + call clip_variance( clip_wp2, dt, w_tol_sqd, wp2 ) + + ! Interpolate w'^2 from momentum levels to thermodynamic levels. + ! This is used for the clipping of w'^3 according to the value + ! of Sk_w now that w'^2 and w'^3 have been advanced one timestep. + wp2_zt = max( zm2zt( wp2 ), w_tol_sqd ) ! Positive definite quantity + + ! Clip w'^3 by limiting skewness. + call clip_skewness( dt, sfc_elevation, wp2_zt, wp3 ) + + ! Compute wp3_zm for output purposes + wp3_zm = zt2zm( wp3 ) + + return + end subroutine wp23_solve + + subroutine wp23_gmres( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsup, nsub, nrhs, & + rhs, & + solut, err_code ) + ! Description: + ! Perform all GMRES-specific matrix generation and solving for the + ! wp2/wp3 matrices. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + +#ifdef MKL + use crmx_error_code, only: & + fatal_error ! Procedure(s) + + use crmx_stats_variables, only: & + iwp23_matrix_condt_num, & ! Variable(s) + l_stats_samp, & + sfc + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_lapack_wrap, only: & + band_solve, & ! Procedure(s) + band_solvex + + use crmx_stats_type, only: & + stat_update_var_pt ! Procedure(s) + + use crmx_csr_matrix_class, only: & + csr_intlc_5b_5b_ia, & ! Variables + csr_intlc_5b_5b_ja, & + intlc_5d_5d_ja_size + + use crmx_gmres_wrap, only: & + gmres_solve ! Subroutine + + use crmx_gmres_cache, only: & + gmres_cache_soln, & ! Subroutine + gmres_prev_soln, & ! Variables + gmres_prev_precond_a, & + l_gmres_soln_ok, & + gmres_idx_wp2wp3, & + gmres_temp_intlc, & + gmres_tempsize_intlc +#endif /* MKL */ + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2 ! w'^2 (momentum levels) [m^2/s^2] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + a1, & ! a_1 (momentum levels); See eqn. 23 in `Equations for CLUBB' [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] + Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + tau1m, & ! Time-scale tau on momentum levels [s] + tauw3t, & ! Time-scale tau on thermodynamic levels [s] + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + logical, intent(in) :: & + l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. + + integer, intent(in) :: & + nsub, & ! Number of subdiagonals in the LHS matrix. + nsup, & ! Number of superdiagonals in the LHS matrix. + nrhs ! Number of right-hand side vectors + ! (GMRES currently only supports 1) + + ! Input/Output variables + real( kind = core_rknd ), dimension(2*gr%nz), intent(inout) :: & + rhs ! Right hand side vector + + ! Output variables + real( kind = core_rknd ), dimension(2*gr%nz), intent(out) :: & + solut ! Solution to band diagonal system + + integer, intent(out) :: err_code ! Have any errors occured? + +#ifdef MKL + ! Local variables + real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & + lhs, & ! Implicit contributions to wp2/wp3 (band diag. matrix) + lhs_cache ! Backup cache of LHS matrix + + real( kind = core_rknd ), dimension(intlc_5d_5d_ja_size) :: & + lhs_a_csr ! Implicit contributions to wp2/wp3 (CSR format) + + real( kind = core_rknd ), dimension(2*gr%nz) :: & + rhs_cache ! Backup cache of RHS vector + + real( kind = core_rknd ):: & + rcond ! Est. of the reciprocal of the condition # + + ! Begin code + + if (nsup > 2) then + write (fstderr, *) "WARNING: CSR-format solvers currently do not", & + "support solving with hyper diffusion", & + "at this time. l_hyper_dfsn ignored." + end if + call wp23_lhs_csr( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, & + lhs_a_csr ) + + if ( .not. l_gmres_soln_ok(gmres_idx_wp2wp3) ) then + call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & + lhs ) + + ! Solve system with LAPACK to give us our first solution vector + lhs_cache = lhs + rhs_cache = rhs + call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solut, err_code ) + + ! Use gmres_cache_wp2wp3_soln to set cache this solution for GMRES + call gmres_cache_soln( gr%nz * 2, gmres_idx_wp2wp3, solut ) + lhs = lhs_cache + rhs = rhs_cache + end if ! .not. l_gmres_soln_ok(gmres_idx_wp2wp3) + + call gmres_solve( intlc_5d_5d_ja_size, (gr%nz * 2), & + lhs_a_csr, csr_intlc_5b_5b_ia, csr_intlc_5b_5b_ja, & + gmres_tempsize_intlc, & + gmres_prev_soln(:,gmres_idx_wp2wp3), & + gmres_prev_precond_a(:,gmres_idx_wp2wp3), rhs, & + gmres_temp_intlc, & + solut, err_code ) + ! Fall back to LAPACK if GMRES returned any errors + if ( fatal_error( err_code ) ) then + write(fstderr,*) "Errors encountered in GMRES solve." + write(fstderr,*) "Falling back to LAPACK solver." + + ! Generate the LHS in LAPACK format + call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & + lhs ) + + ! Note: The RHS does not need to be re-generated. + + ! Solve the system with LAPACK as a fall-back. + if ( l_stats_samp .and. iwp23_matrix_condt_num > 0 ) then + + ! Perform LU decomp and solve system (LAPACK with diagnostics) + ! Note that this can change the answer slightly + call band_solvex( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solut, rcond, err_code ) + + ! Est. of the condition number of the w'^2/w^3 LHS matrix + call stat_update_var_pt( iwp23_matrix_condt_num, 1, 1.0_core_rknd / rcond, sfc ) + + else + ! Perform LU decomp and solve system (LAPACK) + call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solut, err_code ) + end if + + end if ! fatal_error + +#else + stop "This build was not compiled with PARDISO/GMRES support." + + ! These prevent compiler warnings when -DMKL not set. + if ( l_crank_nich_diff .or. .true. ) print *, "This should be unreachable" + solut = rhs + solut(1:gr%nz) = a1 + solut(1:gr%nz) = a1_zt + solut(1:gr%nz) = a3 + solut(1:gr%nz) = a3_zt + solut(1:gr%nz) = C11_Skw_fnc + solut(1:gr%nz) = C1_Skw_fnc + solut(1:gr%nz) = invrs_rho_ds_zm + solut(1:gr%nz) = invrs_rho_ds_zt + solut(1:gr%nz) = rho_ds_zm + solut(1:gr%nz) = rho_ds_zt + solut(1:gr%nz) = Kw1 + solut(1:gr%nz) = Kw8 + solut(1:gr%nz) = Skw_zt + solut(1:gr%nz) = tau1m + solut(1:gr%nz) = tauw3t + solut(1:gr%nz) = wm_zt + solut(1:gr%nz) = wm_zm + solut(1:gr%nz) = wp2 + solut(1:gr%nz) = wp3_on_wp2 + err_code = int( dt ) + err_code = nsup + err_code = nsub + err_code = nrhs + +#endif /* MKL */ + + end subroutine wp23_gmres + + !============================================================================= + subroutine wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & + lhs ) + + ! Description: + ! Compute LHS band diagonal matrix for w'^2 and w'^3. + ! This subroutine computes the implicit portion + ! of the w'^2 and w'^3 equations. + ! + ! NOTE: If changes are made to this subroutine, ensure that the CSR + ! version of the subroutine is updated as well! If the two are different, + ! the results will be inconsistent between LAPACK and PARDISO/GMRES! + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_parameters_tunable, only: & + C4, & ! Variables + C5, & + C8, & + C8b, & + C12, & + nu1_vert_res_dep, & + nu8_vert_res_dep, & + nu_hd_vert_res_dep + + use crmx_constants_clubb, only: & + eps, & ! Variable(s) + three_halves, & + gamma_over_implicit_ts + + use crmx_model_flags, only: & + l_tke_aniso, & ! Variable(s) + l_hyper_dfsn + + use crmx_diffusion, only: & + diffusion_zm_lhs, & ! Procedures + diffusion_zt_lhs + + use crmx_mean_adv, only: & + term_ma_zm_lhs, & ! Procedures + term_ma_zt_lhs + + use crmx_hyper_diffusion_4th_ord, only: & + hyper_dfsn_4th_ord_zm_lhs, & + hyper_dfsn_4th_ord_zt_lhs + + use crmx_clubb_precision, only: & + time_precision, & + core_rknd + + use crmx_stats_variables, only: & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr11, & + zmscr10, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + ztscr01, & + ztscr02 + + use crmx_stats_variables, only: & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use crmx_stats_variables, only: & + l_stats_samp, & + iwp2_dp1, & + iwp2_dp2, & + iwp2_ta, & + iwp2_ma, & + iwp2_ac, & + iwp2_pr2, & + iwp2_pr1, & + iwp2_4hd, & + iwp3_ta, & + iwp3_tp, & + iwp3_ma, & + iwp3_ac, & + iwp3_pr2, & + iwp3_pr1, & + iwp3_dp1, & + iwp3_4hd + + use crmx_advance_helper_module, only: set_boundary_conditions_lhs ! Procedure(s) + + implicit none + + ! Parameter Constants + ! Left-hand side matrix diagonal identifiers for + ! momentum-level variable, w'^2. + integer, parameter :: & + m_kp2_mdiag = 1, & ! Momentum super-super diagonal index for w'^2. + !m_kp2_tdiag = 2, & ! Thermodynamic super-super diagonal index for w'^2. + m_kp1_mdiag = 3, & ! Momentum super diagonal index for w'^2. + m_kp1_tdiag = 4, & ! Thermodynamic super diagonal index for w'^2. + m_k_mdiag = 5, & ! Momentum main diagonal index for w'^2. + m_k_tdiag = 6, & ! Thermodynamic sub diagonal index for w'^2. + m_km1_mdiag = 7, & ! Momentum sub diagonal index for w'^2. + !m_km1_tdiag = 8, & ! Thermodynamic sub-sub diagonal index for w'^2. + m_km2_mdiag = 9 ! Momentum sub-sub diagonal index for w'^2. + + ! Left-hand side matrix diagonal identifiers for + ! thermodynamic-level variable, w'^3. + integer, parameter :: & + t_kp2_tdiag = 1, & ! Thermodynamic super-super diagonal index for w'^3. + !t_kp1_mdiag = 2, & ! Momentum super-super diagonal index for w'^3. + t_kp1_tdiag = 3, & ! Thermodynamic super diagonal index for w'^3. + !t_k_mdiag = 4, & ! Momentum super diagonal index for w'^3. + t_k_tdiag = 5, & ! Thermodynamic main diagonal index for w'^3. + !t_km1_mdiag = 6, & ! Momentum sub diagonal index for w'^3. + t_km1_tdiag = 7, & ! Thermodynamic sub diagonal index for w'^3. + !t_km2_mdiag = 8, & ! Momentum sub-sub diagonal index for w'^3. + t_km2_tdiag = 9 ! Thermodynamic sub-sub diagonal index for w'^3. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] + Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + tau1m, & ! Time-scale tau on momentum levels [s] + tauw3t, & ! Time-scale tau on thermodynamic levels [s] + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + logical, intent(in) :: & + l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. + + integer, intent(in) :: & + nsub, & ! Number of subdiagonals in the LHS matrix. + nsup ! Number of superdiagonals in the LHS matrix. + + ! Output Variable + real( kind = core_rknd ), dimension(5-nsup:5+nsub,2*gr%nz), intent(out) :: & + lhs ! Implicit contributions to wp2/wp3 (band diag. matrix) + + ! Local Variables + + ! Array indices + integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3, k_wp2_low, k_wp2_high, & + k_wp3_low, k_wp3_high + + real( kind = core_rknd ), dimension(5) :: tmp + + + ! Initialize the left-hand side matrix to 0. + lhs = 0.0_core_rknd + + do k = 2, gr%nz-1, 1 + + ! Define indices + + km1 = max( k-1, 1 ) + km2 = max( k-2, 1 ) + kp1 = min( k+1, gr%nz ) + kp2 = min( k+2, gr%nz ) + + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + + !!!!!***** w'^2 *****!!!!! + + ! w'^2: Left-hand side (implicit w'^2 portion of the code). + ! + ! Momentum sub-sub diagonal (lhs index: m_km2_mdiag) + ! [ x wp2(k-2,) ] + ! Thermodynamic sub-sub diagonal (lhs index: m_km1_tdiag) + ! [ x wp3(k-1,) ] + ! Momentum sub diagonal (lhs index: m_km1_mdiag) + ! [ x wp2(k-1,) ] + ! Thermodynamic sub diagonal (lhs index: m_k_tdiag) + ! [ x wp3(k,) ] + ! Momentum main diagonal (lhs index: m_k_mdiag) + ! [ x wp2(k,) ] + ! Thermodynamic super diagonal (lhs index: m_kp1_tdiag) + ! [ x wp3(k+1,) ] + ! Momentum super diagonal (lhs index: m_kp1_mdiag) + ! [ x wp2(k+1,) ] + ! Thermodynamic super-super diagonal (lhs index: m_kp2_tdiag) + ! [ x wp3(k+2,) ] + ! Momentum super-super diagonal (lhs index: m_kp2_mdiag) + ! [ x wp2(k+2,) ] + + ! LHS time tendency. + lhs(m_k_mdiag,k_wp2) & + = + 1.0_core_rknd / real( dt, kind = core_rknd ) + + ! LHS mean advection (ma) term. + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + + ! LHS turbulent advection (ta) term. + lhs((/m_kp1_tdiag,m_k_tdiag/),k_wp2) & + = lhs((/m_kp1_tdiag,m_k_tdiag/),k_wp2) & + + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) + + ! LHS accumulation (ac) term and pressure term 2 (pr2). + lhs(m_k_mdiag,k_wp2) & + = lhs(m_k_mdiag,k_wp2) & + + wp2_terms_ac_pr2_lhs( C5, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + + ! LHS dissipation term 1 (dp1). + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the term + ! more numerically stable (see note below for w'^3 LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs(m_k_mdiag,k_wp2) & + = lhs(m_k_mdiag,k_wp2) & + + gamma_over_implicit_ts & + * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + + ! LHS eddy diffusion term: dissipation term 2 (dp2). + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp2 using a Crank-Nicholson time step. + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + + (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + else + ! Eddy diffusion for wp2 using a completely implicit time step. + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & + + diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + endif + + ! LHS pressure term 1 (pr1). + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the term + ! more numerically stable (see note below for w'^3 LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( l_tke_aniso ) then + ! Add in this term if we're not assuming tke = 1.5 * wp2 + lhs(m_k_mdiag,k_wp2) & + = lhs(m_k_mdiag,k_wp2) & + + gamma_over_implicit_ts & + * wp2_term_pr1_lhs( C4, tau1m(k) ) + endif + + ! LHS 4th-order hyper-diffusion (4hd). + if ( l_hyper_dfsn ) then + ! Note: w'^2 uses fixed-point boundary conditions. + lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & + k_wp2 ) & + = lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & + k_wp2 ) & + + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) + endif + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for wp2. + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 LHS + ! turbulent advection (ta) and turbulent production (tp) terms). + if ( iwp2_dp1 > 0 ) then + zmscr01(k) & + = - gamma_over_implicit_ts & + * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + endif + + if ( iwp2_dp2 > 0 ) then + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp2 using a Crank-Nicholson time step. + tmp(1:3) & + = (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + else + ! Eddy diffusion for wp2 using a completely implicit time step. + tmp(1:3) & + = diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + endif + + zmscr02(k) = -tmp(3) + zmscr03(k) = -tmp(2) + zmscr04(k) = -tmp(1) + + endif + + if ( iwp2_ta > 0 ) then + tmp(1:2) = & + + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) + zmscr05(k) = -tmp(2) + zmscr06(k) = -tmp(1) + endif + + if ( iwp2_ma > 0 ) then + tmp(1:3) = & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + zmscr07(k) = -tmp(3) + zmscr08(k) = -tmp(2) + zmscr09(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^2 term ac, substitute 0 for the + ! C_5 input to function wp2_terms_ac_pr2_lhs. + if ( iwp2_ac > 0 ) then + zmscr10(k) = & + - wp2_terms_ac_pr2_lhs( 0.0_core_rknd, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + endif + + ! Note: To find the contribution of w'^2 term pr2, add 1 to the + ! C_5 input to function wp2_terms_ac_pr2_lhs. + if ( iwp2_pr2 > 0 ) then + zmscr11(k) = & + - wp2_terms_ac_pr2_lhs( (1.0_core_rknd+C5), wm_zt(kp1), wm_zt(k), & + gr%invrs_dzm(k) ) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 LHS + ! turbulent advection (ta) and turbulent production (tp) terms). + if ( iwp2_pr1 > 0 .and. l_tke_aniso ) then + zmscr12(k) & + = - gamma_over_implicit_ts & + * wp2_term_pr1_lhs( C4, tau1m(k) ) + endif + + if ( iwp2_4hd > 0 .and. l_hyper_dfsn ) then + tmp(1:5) = & + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) + zmscr13(k) = -tmp(5) + zmscr14(k) = -tmp(4) + zmscr15(k) = -tmp(3) + zmscr16(k) = -tmp(2) + zmscr17(k) = -tmp(1) + endif + + endif + + + + !!!!!***** w'^3 *****!!!!! + + ! w'^3: Left-hand side (implicit w'^3 portion of the code). + ! + ! Thermodynamic sub-sub diagonal (lhs index: t_km2_tdiag) + ! [ x wp3(k-2,) ] + ! Momentum sub-sub diagonal (lhs index: t_km2_mdiag) + ! [ x wp2(k-2,) ] + ! Thermodynamic sub diagonal (lhs index: t_km1_tdiag) + ! [ x wp3(k-1,) ] + ! Momentum sub diagonal (lhs index: t_km1_mdiag) + ! [ x wp2(k-1,) ] + ! Thermodynamic main diagonal (lhs index: t_k_tdiag) + ! [ x wp3(k,) ] + ! Momentum super diagonal (lhs index: t_k_mdiag) + ! [ x wp2(k,) ] + ! Thermodynamic super diagonal (lhs index: t_kp1_tdiag) + ! [ x wp3(k+1,) ] + ! Momentum super-super diagonal (lhs index: t_kp1_mdiag) + ! [ x wp2(k+1,) ] + ! Thermodynamic super-super diagonal (lhs index: t_kp2_tdiag) + ! [ x wp3(k+2,) ] + + ! LHS time tendency. + lhs(t_k_tdiag,k_wp3) & + = + 1.0_core_rknd / real( dt, kind = core_rknd ) + + ! LHS mean advection (ma) term. + lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(k-1) ) + + ! LHS turbulent advection (ta) and turbulent production (tp) terms. + ! Note: An "over-implicit" weighted time step is applied to these terms. + ! The weight of the implicit portion of these terms is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (w'^3 in this case), y(t) is the linearized portion of + ! the terms that gets treated implicitly, and RHS is the portion of + ! the terms that is always treated explicitly. A weight of greater + ! than 1 can be applied to make the terms more numerically stable. + lhs(t_kp1_tdiag:t_km1_tdiag,k_wp3) & + = lhs(t_kp1_tdiag:t_km1_tdiag,k_wp3) & + + gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k), a3_zt(k), a3(km1), & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + + ! LHS accumulation (ac) term and pressure term 2 (pr2). + lhs(t_k_tdiag,k_wp3) & + = lhs(t_k_tdiag,k_wp3) & + + wp3_terms_ac_pr2_lhs( C11_Skw_fnc(k), & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + + ! LHS pressure term 1 (pr1). + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs(t_k_tdiag,k_wp3) & + = lhs(t_k_tdiag,k_wp3) & + + gamma_over_implicit_ts & + * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + + ! LHS eddy diffusion term: dissipation term 1 (dp1). + ! Added a new constant, C12. + ! Initially, this new constant will be set to 1.0 -dschanen 9/19/05 + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp3 using a Crank-Nicholson time step. + lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + + C12 * (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + else + ! Eddy diffusion for wp3 using a completely implicit time step. + lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & + + C12 & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + endif + + ! LHS 4th-order hyper-diffusion (4hd). + if ( l_hyper_dfsn ) then + ! Note: w'^3 uses fixed-point boundary conditions. + lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & + k_wp3 ) & + = lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & + k_wp3 ) & + + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & + gr%invrs_dzm(k), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) + endif + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for wp3. + + ! Note: To find the contribution of w'^3 term ta, add 3 to all of + ! the a_3 inputs and substitute 0 for the three_halves input to + ! function wp3_terms_ta_tp_lhs. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_ta > 0 ) then + tmp(1:5) & + = gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & + a3(km1)+3.0_core_rknd, & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + 0.0_core_rknd, & + gr%invrs_dzt(k), k ) + ztscr05(k) = -tmp(5) + ztscr06(k) = -tmp(4) + ztscr07(k) = -tmp(3) + ztscr08(k) = -tmp(2) + ztscr09(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^3 term tp, substitute 0 for all + ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 + ! inputs to function wp3_terms_ta_tp_lhs. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_tp > 0 ) then + tmp(1:5) & + = gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd, 0.0_core_rknd, & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + ztscr10(k) = -tmp(4) + ztscr11(k) = -tmp(2) + endif + + if ( iwp3_ma > 0 ) then + tmp(1:3) = & + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + ztscr12(k) = -tmp(3) + ztscr13(k) = -tmp(2) + ztscr14(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^3 term ac, substitute 0 for the + ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. + if ( iwp3_ac > 0 ) then + ztscr15(k) = & + - wp3_terms_ac_pr2_lhs( 0.0_core_rknd, & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + endif + + ! Note: To find the contribution of w'^3 term pr2, add 1 to the + ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. + if ( iwp3_pr2 > 0 ) then + ztscr16(k) = & + - wp3_terms_ac_pr2_lhs( (1.0_core_rknd+C11_Skw_fnc(k)), & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_pr1 > 0 ) then + ztscr01(k) & + = - gamma_over_implicit_ts & + * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + endif + + if ( iwp3_dp1 > 0 ) then + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp3 using a Crank-Nicholson time step. + tmp(1:3) & + = C12 * (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + else + ! Eddy diffusion for wp3 using a completely implicit time step. + tmp(1:3) & + = C12 & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + endif + + ztscr02(k) = -tmp(3) + ztscr03(k) = -tmp(2) + ztscr04(k) = -tmp(1) + + endif + + if ( iwp3_4hd > 0 .and. l_hyper_dfsn ) then + tmp(1:5) = & + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & + gr%invrs_dzm(k), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) + ztscr17(k) = -tmp(5) + ztscr18(k) = -tmp(4) + ztscr19(k) = -tmp(3) + ztscr20(k) = -tmp(2) + ztscr21(k) = -tmp(1) + endif + + endif + + enddo ! k = 2, gr%nz-1, 1 + + + ! Boundary conditions + + ! Both wp2 and wp3 used fixed-point boundary conditions. + ! Therefore, anything set in the above loop at both the upper + ! and lower boundaries would be overwritten here. However, the + ! above loop does not extend to the boundary levels. An array + ! with a value of 1 at the main diagonal on the left-hand side + ! and with values of 0 at all other diagonals on the left-hand + ! side will preserve the right-hand side value at that level. + ! + ! wp3(1) wp2(1) ... wp3(nzmax) wp2(nzmax) + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 1.0 1.0 ... 1.0 1.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + + ! Lower boundary + k = 1 + k_wp3_low = 2*k - 1 + k_wp2_low = 2*k + + ! Upper boundary + k = gr%nz + k_wp3_high = 2*k - 1 + k_wp2_high = 2*k + + ! t_k_tdiag and m_k_mdiag need to be adjusted because the dimensions of lhs + ! are offset + call set_boundary_conditions_lhs( t_k_tdiag - nsup, k_wp3_low, k_wp3_high, lhs, & + m_k_mdiag - nsup, k_wp2_low, k_wp2_high) + + return + + end subroutine wp23_lhs + +#ifdef MKL + !============================================================================= + subroutine wp23_lhs_csr( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & + wp3_on_wp2, & + Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, l_crank_nich_diff, & + lhs_a_csr ) + + ! Description: + ! Compute LHS band diagonal matrix for w'^2 and w'^3. + ! This subroutine computes the implicit portion + ! of the w'^2 and w'^3 equations. + ! + ! This version of the subroutine computes the LHS in CSR (compressed + ! sparse row) format. + ! NOTE: This subroutine must be kept up to date with the non CSR version + ! of the subroutine! If the two are different, the results will be + ! inconsistent between LAPACK and PARDISO/GMRES results! + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_parameters_tunable, only: & + C4, & ! Variables + C5, & + C8, & + C8b, & + C12, & + nu1_vert_res_dep, & + nu8_vert_res_dep, & + nu_hd_vert_res_dep + + use crmx_constants_clubb, only: & + eps, & ! Variable(s) + three_halves, & + gamma_over_implicit_ts + + use crmx_model_flags, only: & + l_tke_aniso, & ! Variable(s) + l_hyper_dfsn + + use crmx_diffusion, only: & + diffusion_zm_lhs, & ! Procedures + diffusion_zt_lhs + + use crmx_mean_adv, only: & + term_ma_zm_lhs, & ! Procedures + term_ma_zt_lhs + + use crmx_hyper_diffusion_4th_ord, only: & + hyper_dfsn_4th_ord_zm_lhs, & + hyper_dfsn_4th_ord_zt_lhs + + use crmx_clubb_precision, only: & + time_precision, & + core_rknd + + use crmx_stats_variables, only: & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr11, & + zmscr10, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + ztscr01, & + ztscr02 + + use crmx_stats_variables, only: & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use crmx_stats_variables, only: & + l_stats_samp, & + iwp2_dp1, & + iwp2_dp2, & + iwp2_ta, & + iwp2_ma, & + iwp2_ac, & + iwp2_pr2, & + iwp2_pr1, & + iwp2_4hd, & + iwp3_ta, & + iwp3_tp, & + iwp3_ma, & + iwp3_ac, & + iwp3_pr2, & + iwp3_pr1, & + iwp3_dp1, & + iwp3_4hd + + use crmx_csr_matrix_class, only: & + intlc_5d_5d_ja_size ! Variable + + implicit none + + ! Left-hand side matrix diagonal identifiers for + ! momentum-level variable, w'^2. + ! These are updated for each diagonal of the matrix as the + ! LHS of the matrix is created. + integer :: & + !m_kp2_mdiag, & ! Momentum super-super diagonal index for w'^2. + !m_kp2_tdiag, & ! Thermodynamic super-super diagonal index for w'^2. + m_kp1_mdiag, & ! Momentum super diagonal index for w'^2. + m_kp1_tdiag, & ! Thermodynamic super diagonal index for w'^2. + m_k_mdiag , & ! Momentum main diagonal index for w'^2. + m_k_tdiag , & ! Thermodynamic sub diagonal index for w'^2. + m_km1_mdiag ! Momentum sub diagonal index for w'^2. + !m_km1_tdiag, & ! Thermodynamic sub-sub diagonal index for w'^2. + !m_km2_mdiag ! Momentum sub-sub diagonal index for w'^2. + + ! Left-hand side matrix diagonal identifiers for + ! thermodynamic-level variable, w'^3. + ! These are updated for each diagonal of the matrix as the + ! LHS of the matrix is created + integer :: & + !t_kp2_tdiag, & ! Thermodynamic super-super diagonal index for w'^3. + !t_kp1_mdiag, & ! Momentum super-super diagonal index for w'^3. + t_kp1_tdiag, & ! Thermodynamic super diagonal index for w'^3. + !t_k_mdiag , & ! Momentum super diagonal index for w'^3. + t_k_tdiag , & ! Thermodynamic main diagonal index for w'^3. + !t_km1_mdiag, & ! Momentum sub diagonal index for w'^3. + t_km1_tdiag ! Thermodynamic sub diagonal index for w'^3. + !t_km2_mdiag, & ! Momentum sub-sub diagonal index for w'^3. + !t_km2_tdiag ! Thermodynamic sub-sub diagonal index for w'^3. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] + Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + tau1m, & ! Time-scale tau on momentum levels [s] + tauw3t, & ! Time-scale tau on thermodynamic levels [s] + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + logical, intent(in) :: & + l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. + +! integer, intent(in) :: & +! nsub, & ! Number of subdiagonals in the LHS matrix. +! nsup ! Number of superdiagonals in the LHS matrix. + + ! Output Variable + real( kind = core_rknd ), dimension(intlc_5d_5d_ja_size), intent(out) :: & + lhs_a_csr ! Implicit contributions to wp2/wp3 (band diag. matrix) + + ! Local Variables + + ! Array indices + integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3, wp2_cur_row, wp3_cur_row + + real( kind = core_rknd ), dimension(5) :: tmp + + + ! Initialize the left-hand side matrix to 0. + lhs_a_csr = 0.0_core_rknd + + do k = 2, gr%nz-1, 1 + + ! Define indices + + km1 = max( k-1, 1 ) + km2 = max( k-2, 1 ) + kp1 = min( k+1, gr%nz ) + kp2 = min( k+2, gr%nz ) + + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + wp2_cur_row = ((k_wp2 - 3) * 5) + 8 + wp3_cur_row = ((k_wp3 - 3) * 5) + 8 + + !!!!!***** w'^2 *****!!!!! + + ! w'^2: Left-hand side (implicit w'^2 portion of the code). + ! + ! Momentum sub-sub diagonal (lhs index: m_km2_mdiag) + ! [ x wp2(k-2,) ] + ! Thermodynamic sub-sub diagonal (lhs index: m_km1_tdiag) + ! [ x wp3(k-1,) ] + ! Momentum sub diagonal (lhs index: m_km1_mdiag) + ! [ x wp2(k-1,) ] + ! Thermodynamic sub diagonal (lhs index: m_k_tdiag) + ! [ x wp3(k,) ] + ! Momentum main diagonal (lhs index: m_k_mdiag) + ! [ x wp2(k,) ] + ! Thermodynamic super diagonal (lhs index: m_kp1_tdiag) + ! [ x wp3(k+1,) ] + ! Momentum super diagonal (lhs index: m_kp1_mdiag) + ! [ x wp2(k+1,) ] + ! Thermodynamic super-super diagonal (lhs index: m_kp2_tdiag) + ! [ x wp3(k+2,) ] + ! Momentum super-super diagonal (lhs index: m_kp2_mdiag) + ! [ x wp2(k+2,) ] + + ! NOTES FOR CSR-FORMAT MATRICES + ! The various diagonals are referenced through the following + ! array indices: + ! (m_kp1_mdiag, k_wp2) ==> (wp2_cur_row + 4) + ! (m_kp1_tdiag, k_wp2) ==> (wp2_cur_row + 3) + ! (m_k_mdiag, k_wp2) ==> (wp2_cur_row + 2) + ! (m_k_tdiag, k_wp2) ==> (wp2_cur_row + 1) + ! (m_km1_mdiag, k_wp2) ==> (wp2_cur_row) + ! For readability, these values are updated here. + ! This means that to update the CSR version of the LHS subroutine, + ! all that must be done is remove the ,k_wp2 from the array indices, + ! as the CSR-format matrix is one-dimensional. + + ! NOTE: All references to lhs will need to be changed to lhs_a_csr + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! WARNING: If you have array indices that go from m_kp1_mdiag to + ! m_km1_mdiag, you will need to set it to span by -1. This is because + ! in the CSR-format arrays, the indices descend as you go from m_kp1_mdiag + ! to m_km1_mdiag! + ! + ! EXAMPLE: lhs((m_kp1_mdiag:m_km1_mdiag),wp2) would become + ! lhs_a_csr((m_kp1_mdiag:m_km1_mdiag:-1)) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + m_kp1_mdiag = wp2_cur_row + 4 + m_kp1_tdiag = wp2_cur_row + 3 + m_k_mdiag = wp2_cur_row + 2 + m_k_tdiag = wp2_cur_row + 1 + m_km1_mdiag = wp2_cur_row + + ! LHS time tendency. + lhs_a_csr(m_k_mdiag) & + = real( + 1.0_core_rknd / dt ) + + ! LHS mean advection (ma) term. + lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + + ! LHS turbulent advection (ta) term. + lhs_a_csr((/m_kp1_tdiag,m_k_tdiag/)) & + = lhs_a_csr((/m_kp1_tdiag,m_k_tdiag/)) & + + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) + + ! LHS accumulation (ac) term and pressure term 2 (pr2). + lhs_a_csr(m_k_mdiag) & + = lhs_a_csr(m_k_mdiag) & + + wp2_terms_ac_pr2_lhs( C5, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + + ! LHS dissipation term 1 (dp1). + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the term + ! more numerically stable (see note below for w'^3 LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs_a_csr(m_k_mdiag) & + = lhs_a_csr(m_k_mdiag) & + + gamma_over_implicit_ts & + * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + + ! LHS eddy diffusion term: dissipation term 2 (dp2). + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp2 using a Crank-Nicholson time step. + lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + + (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + else + ! Eddy diffusion for wp2 using a completely implicit time step. + lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & + + diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + endif + + ! LHS pressure term 1 (pr1). + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the term + ! more numerically stable (see note below for w'^3 LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( l_tke_aniso ) then + ! Add in this term if we're not assuming tke = 1.5 * wp2 + lhs_a_csr(m_k_mdiag) & + = lhs_a_csr(m_k_mdiag) & + + gamma_over_implicit_ts & + * wp2_term_pr1_lhs( C4, tau1m(k) ) + endif + + ! LHS 4th-order hyper-diffusion (4hd). + ! NOTE: 4th-order hyper-diffusion is not yet supported in CSR-format. + ! As such, this needs to remain commented out. + !if ( l_hyper_dfsn ) then + ! ! Note: w'^2 uses fixed-point boundary conditions. + ! lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & + ! k_wp2) & + ! = lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & + ! k_wp2) & + ! + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & + ! gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + ! gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & + ! gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) + !endif + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for wp2. + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 LHS + ! turbulent advection (ta) and turbulent production (tp) terms). + if ( iwp2_dp1 > 0 ) then + zmscr01(k) & + = - gamma_over_implicit_ts & + * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + endif + + if ( iwp2_dp2 > 0 ) then + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp2 using a Crank-Nicholson time step. + tmp(1:3) & + = (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + else + ! Eddy diffusion for wp2 using a completely implicit time step. + tmp(1:3) & + = diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + endif + + zmscr02(k) = -tmp(3) + zmscr03(k) = -tmp(2) + zmscr04(k) = -tmp(1) + + endif + + if ( iwp2_ta > 0 ) then + tmp(1:2) = & + + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) + zmscr05(k) = -tmp(2) + zmscr06(k) = -tmp(1) + endif + + if ( iwp2_ma > 0 ) then + tmp(1:3) = & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + zmscr07(k) = -tmp(3) + zmscr08(k) = -tmp(2) + zmscr09(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^2 term ac, substitute 0 for the + ! C_5 input to function wp2_terms_ac_pr2_lhs. + if ( iwp2_ac > 0 ) then + zmscr10(k) = & + - wp2_terms_ac_pr2_lhs( 0.0_core_rknd, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + endif + + ! Note: To find the contribution of w'^2 term pr2, add 1 to the + ! C_5 input to function wp2_terms_ac_pr2_lhs. + if ( iwp2_pr2 > 0 ) then + zmscr11(k) = & + - wp2_terms_ac_pr2_lhs( (1.0_core_rknd+C5), wm_zt(kp1), wm_zt(k), & + gr%invrs_dzm(k) ) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 LHS + ! turbulent advection (ta) and turbulent production (tp) terms). + if ( iwp2_pr1 > 0 .and. l_tke_aniso ) then + zmscr12(k) & + = - gamma_over_implicit_ts & + * wp2_term_pr1_lhs( C4, tau1m(k) ) + endif + + if ( iwp2_4hd > 0 .and. l_hyper_dfsn ) then + tmp(1:5) = & + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) + zmscr13(k) = -tmp(5) + zmscr14(k) = -tmp(4) + zmscr15(k) = -tmp(3) + zmscr16(k) = -tmp(2) + zmscr17(k) = -tmp(1) + endif + + endif + + + + !!!!!***** w'^3 *****!!!!! + + ! w'^3: Left-hand side (implicit w'^3 portion of the code). + ! + ! Thermodynamic sub-sub diagonal (lhs index: t_km2_tdiag) + ! [ x wp3(k-2,) ] + ! Momentum sub-sub diagonal (lhs index: t_km2_mdiag) + ! [ x wp2(k-2,) ] + ! Thermodynamic sub diagonal (lhs index: t_km1_tdiag) + ! [ x wp3(k-1,) ] + ! Momentum sub diagonal (lhs index: t_km1_mdiag) + ! [ x wp2(k-1,) ] + ! Thermodynamic main diagonal (lhs index: t_k_tdiag) + ! [ x wp3(k,) ] + ! Momentum super diagonal (lhs index: t_k_mdiag) + ! [ x wp2(k,) ] + ! Thermodynamic super diagonal (lhs index: t_kp1_tdiag) + ! [ x wp3(k+1,) ] + ! Momentum super-super diagonal (lhs index: t_kp1_mdiag) + ! [ x wp2(k+1,) ] + ! Thermodynamic super-super diagonal (lhs index: t_kp2_tdiag) + ! [ x wp3(k+2,) ] + + ! NOTES FOR CSR-FORMAT MATRICES + ! The various diagonals are referenced through the following + ! array indices: + ! (t_kp1_tdiag, k_wp3) ==> (wp3_cur_row + 4) + ! (t_kp1_mdiag, k_wp3) ==> (wp3_cur_row + 3) + ! (t_k_tdiag, k_wp3) ==> (wp3_cur_row + 2) + ! (t_k_mdiag, k_wp3) ==> (wp3_cur_row + 1) + ! (t_km1_tdiag, k_wp3) ==> (wp3_cur_row) + ! For readability, these values are updated here. + ! This means that to update the CSR version of the LHS subroutine, + ! all that must be done is remove the ,k_wp2 from the array indices, + ! as the CSR-format matrix is one-dimensional. + + ! NOTE: All references to lhs will need to be changed to lhs_a_csr + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! WARNING: If you have array indices that go from t_kp1_tdiag to + ! t_km1_tdiag, you will need to set it to span by -1. This is because + ! in the CSR-format arrays, the indices descend as you go from t_kp1_tdiag + ! to t_km1_tdiag! + ! + ! EXAMPLE: lhs((t_kp1_tdiag:t_km1_tdiag),wp3) would become + ! lhs_a_csr((t_kp1_tdiag:t_km1_tdiag:-1)) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + t_kp1_tdiag = wp3_cur_row + 4 + !t_kp1_mdiag = wp3_cur_row + 3 + t_k_tdiag = wp3_cur_row + 2 + !t_k_mdiag = wp3_cur_row + 1 + t_km1_tdiag = wp3_cur_row + + ! LHS time tendency. + lhs_a_csr(t_k_tdiag) & + = real( + 1.0_core_rknd / dt ) + + ! LHS mean advection (ma) term. + lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + + ! LHS turbulent advection (ta) and turbulent production (tp) terms. + ! Note: An "over-implicit" weighted time step is applied to these terms. + ! The weight of the implicit portion of these terms is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (w'^3 in this case), y(t) is the linearized portion of + ! the terms that gets treated implicitly, and RHS is the portion of + ! the terms that is always treated explicitly. A weight of greater + ! than 1 can be applied to make the terms more numerically stable. + lhs_a_csr(t_kp1_tdiag:t_km1_tdiag:-1) & + = lhs_a_csr(t_kp1_tdiag:t_km1_tdiag:-1) & + + gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k), a3_zt(k), a3(km1), & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + + ! LHS accumulation (ac) term and pressure term 2 (pr2). + lhs_a_csr(t_k_tdiag) & + = lhs_a_csr(t_k_tdiag) & + + wp3_terms_ac_pr2_lhs( C11_Skw_fnc(k), & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + + ! LHS pressure term 1 (pr1). + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs_a_csr(t_k_tdiag) & + = lhs_a_csr(t_k_tdiag) & + + gamma_over_implicit_ts & + * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + + ! LHS eddy diffusion term: dissipation term 1 (dp1). + ! Added a new constant, C12. + ! Initially, this new constant will be set to 1.0 -dschanen 9/19/05 + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp3 using a Crank-Nicholson time step. + lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + + C12 * (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + else + ! Eddy diffusion for wp3 using a completely implicit time step. + lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & + + C12 & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + endif + + ! LHS 4th-order hyper-diffusion (4hd). + ! NOTE: 4th-order hyper-diffusion is not yet supported in CSR-format. + ! As such, this needs to remain commented out. + !if ( l_hyper_dfsn ) then + ! ! Note: w'^3 uses fixed-point boundary conditions. + ! lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & + ! k_wp3) & + ! = lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & + ! k_wp3) & + ! + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & + ! gr%invrs_dzm(k), gr%invrs_dzm(km1), & + ! gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & + ! gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) + !endif + + if (l_stats_samp) then + + ! Statistics: implicit contributions for wp3. + + ! Note: To find the contribution of w'^3 term ta, add 3 to all of + ! the a_3 inputs and substitute 0 for the three_halves input to + ! function wp3_terms_ta_tp_lhs. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_ta > 0 ) then + tmp(1:5) & + = gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & + a3(km1)+3.0_core_rknd, & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + 0.0_core_rknd, & + gr%invrs_dzt(k), k ) + ztscr05(k) = -tmp(5) + ztscr06(k) = -tmp(4) + ztscr07(k) = -tmp(3) + ztscr08(k) = -tmp(2) + ztscr09(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^3 term tp, substitute 0 for all + ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 + ! inputs to function wp3_terms_ta_tp_lhs. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_tp > 0 ) then + tmp(1:5) & + = gamma_over_implicit_ts & + * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd, 0.0_core_rknd, & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + ztscr10(k) = -tmp(4) + ztscr11(k) = -tmp(2) + endif + + if ( iwp3_ma > 0 ) then + tmp(1:3) = & + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + ztscr12(k) = -tmp(3) + ztscr13(k) = -tmp(2) + ztscr14(k) = -tmp(1) + endif + + ! Note: To find the contribution of w'^3 term ac, substitute 0 for the + ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. + if ( iwp3_ac > 0 ) then + ztscr15(k) = & + - wp3_terms_ac_pr2_lhs( 0.0_core_rknd, & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + endif + + ! Note: To find the contribution of w'^3 term pr2, add 1 to the + ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. + if ( iwp3_pr2 > 0 ) then + ztscr16(k) = & + - wp3_terms_ac_pr2_lhs( (1.0_core_rknd+C11_Skw_fnc(k)), & + wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) and turbulent production (tp) terms). + if ( iwp3_pr1 > 0 ) then + ztscr01(k) & + = - gamma_over_implicit_ts & + * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + endif + + if ( iwp3_dp1 > 0 ) then + if ( l_crank_nich_diff ) then + ! Eddy diffusion for wp3 using a Crank-Nicholson time step. + tmp(1:3) & + = C12 * (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + else + ! Eddy diffusion for wp3 using a completely implicit time step. + tmp(1:3) & + = C12 & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + endif + + ztscr02(k) = -tmp(3) + ztscr03(k) = -tmp(2) + ztscr04(k) = -tmp(1) + + endif + + if ( iwp3_4hd > 0 .and. l_hyper_dfsn ) then + tmp(1:5) = & + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & + gr%invrs_dzm(k), gr%invrs_dzm(km1), & + gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & + gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) + ztscr17(k) = -tmp(5) + ztscr18(k) = -tmp(4) + ztscr19(k) = -tmp(3) + ztscr20(k) = -tmp(2) + ztscr21(k) = -tmp(1) + endif + + endif + + enddo ! k = 2, gr%nz-1, 1 + + + ! Boundary conditions + + ! Both wp2 and wp3 used fixed-point boundary conditions. + ! Therefore, anything set in the above loop at both the upper + ! and lower boundaries would be overwritten here. However, the + ! above loop does not extend to the boundary levels. An array + ! with a value of 1 at the main diagonal on the left-hand side + ! and with values of 0 at all other diagonals on the left-hand + ! side will preserve the right-hand side value at that level. + ! + ! wp3(1) wp2(1) ... wp3(nzmax) wp2(nzmax) + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 1.0 1.0 ... 1.0 1.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 0.0 ] + + ! Lower boundary + k = 1 + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + wp3_cur_row = 1 + wp2_cur_row = 4 + + ! w'^2 + lhs_a_csr(wp2_cur_row:wp2_cur_row + 3) = 0.0_core_rknd + lhs_a_csr(wp2_cur_row + 1) = 1.0_core_rknd + + ! w'^3 + lhs_a_csr(wp3_cur_row:wp3_cur_row + 2) = 0.0_core_rknd + lhs_a_csr(wp3_cur_row) = 1.0_core_rknd + + ! w'^2 + !lhs(:,k_wp2) = 0.0_core_rknd + !lhs(m_k_mdiag,k_wp2) = 1.0_core_rknd + ! w'^3 + !lhs(:,k_wp3) = 0.0_core_rknd + !lhs(t_k_tdiag,k_wp3) = 1.0_core_rknd + + ! Upper boundary + k = gr%nz + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + ! w'^2 + lhs_a_csr(intlc_5d_5d_ja_size - 2:intlc_5d_5d_ja_size) = 0.0_core_rknd + lhs_a_csr(intlc_5d_5d_ja_size) = 1.0_core_rknd + + ! w'^3 + lhs_a_csr(intlc_5d_5d_ja_size - 6:intlc_5d_5d_ja_size - 3) = 0.0_core_rknd + lhs_a_csr(intlc_5d_5d_ja_size - 4) = 1.0_core_rknd + + ! w'^2 + !lhs(:,k_wp2) = 0.0_core_rknd + !lhs(m_k_mdiag,k_wp2) = 1.0_core_rknd + ! w'^3 + !lhs(:,k_wp3) = 0.0_core_rknd + !lhs(t_k_tdiag,k_wp3) = 1.0_core_rknd + + + return + end subroutine wp23_lhs_csr +#endif /* MKL */ + + !============================================================================= + subroutine wp23_rhs( dt, wp2, wp3, a1, a1_zt, & + a3, a3_zt, wp3_on_wp2, wpthvp, wp2thvp, um, vm, & + upwp, vpwp, up2, vp2, Kw1, Kw8, Kh_zt, & + Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & + C11_Skw_fnc, rho_ds_zm, invrs_rho_ds_zt, radf, & + thv_ds_zm, thv_ds_zt, l_crank_nich_diff, & + rhs ) + + ! Description: + ! Compute RHS vector for w'^2 and w'^3. + ! This subroutine computes the explicit portion of + ! the w'^2 and w'^3 equations. + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_grid_class, only: & + ddzt ! Procedure + + use crmx_parameters_tunable, only: & + C4, & ! Variables + C5, & + C8, & + C8b, & + C12, & + C15, & + nu1_vert_res_dep, & + nu8_vert_res_dep + + use crmx_constants_clubb, only: & + w_tol_sqd, & ! Variable(s) + eps, & + three_halves, & + gamma_over_implicit_ts + + use crmx_model_flags, only: & + l_tke_aniso ! Variable + + use crmx_diffusion, only: & + diffusion_zm_lhs, & ! Procedures + diffusion_zt_lhs + + use crmx_clubb_precision, only: & + time_precision, & ! Variable + core_rknd + + use crmx_stats_variables, only: & + l_stats_samp, iwp2_dp1, iwp2_dp2, zm, iwp2_bp, & ! Variable(s) + iwp2_pr1, iwp2_pr2, iwp2_pr3, iwp3_ta, zt, & + iwp3_tp, iwp3_bp1, iwp3_pr2, iwp3_pr1, iwp3_dp1, iwp3_bp2 + + use crmx_stats_type, only: & + stat_update_var_pt, & ! Procedure(s) + stat_begin_update_pt, & + stat_modify_pt + + use crmx_advance_helper_module, only: set_boundary_conditions_rhs + + + implicit none + + ! Constant parameters + logical, parameter :: & + l_wp3_2nd_buoyancy_term = .true. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] + a3_zt, & ! a_3 interpolated to thermodynamic levels [-] + wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] + wpthvp, & ! w'th_v' (momentum levels) [K m/s] + wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] + um, & ! u wind component (thermodynamic levels) [m/s] + vm, & ! v wind component (thermodynamic levels) [m/s] + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vpwp, & ! v'w' (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] + Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] + Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + tau1m, & ! Time-scale tau on momentum levels [s] + tauw3t, & ! Time-scale tau on thermodynamic levels [s] + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + radf, & ! Buoyancy production at the CL top [m^2/s^3] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] + + logical, intent(in) :: & + l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. + + ! Output Variable + real( kind = core_rknd ), dimension(2*gr%nz), intent(out) :: & + rhs ! RHS of band matrix + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + dum_dz, dvm_dz ! Vertical derivatives of um and vm + + ! Array indices + integer :: k, km1, kp1, k_wp2, k_wp3, k_wp2_low, k_wp2_high, & + k_wp3_low, k_wp3_high + + ! For "over-implicit" weighted time step. + ! This vector holds output from the LHS (implicit) portion of a term at a + ! given vertical level. This output is weighted and applied to the RHS. + ! This is used if the implicit portion of the term is "over-implicit", which + ! means that the LHS contribution is given extra weight (>1) in order to + ! increase numerical stability. A weighted factor must then be applied to + ! the RHS in order to balance the weight. + real( kind = core_rknd ), dimension(5) :: lhs_fnc_output + + real( kind = core_rknd ), dimension(3) :: & + rhs_diff ! For use in Crank-Nicholson eddy diffusion. + + real( kind = core_rknd ) :: temp + + + ! Initialize the right-hand side vector to 0. + rhs = 0.0_core_rknd + + if ( l_wp3_2nd_buoyancy_term ) then + ! Compute the vertical derivative of the u and v winds + dum_dz = ddzt( um ) + dvm_dz = ddzt( vm ) + else + dum_dz = -999._core_rknd + dvm_dz = -999._core_rknd + end if + + do k = 2, gr%nz-1, 1 + + + ! Define indices + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + k_wp3 = 2*k - 1 + k_wp2 = 2*k + + + !!!!!***** w'^2 *****!!!!! + + ! w'^2: Right-hand side (explicit w'^2 portion of the code). + + ! RHS time tendency. + rhs(k_wp2) & + = + ( 1.0_core_rknd / real( dt, kind = core_rknd ) ) * wp2(k) + + ! RHS buoyancy production (bp) term and pressure term 2 (pr2). + rhs(k_wp2) & + = rhs(k_wp2) & + + wp2_terms_bp_pr2_rhs( C5, thv_ds_zm(k), wpthvp(k) ) + + ! RHS buoyancy production at CL top due to LW radiative cooling + rhs(k_wp2) = rhs(k_wp2) + radf(k) + + ! RHS pressure term 3 (pr3). + rhs(k_wp2) & + = rhs(k_wp2) & + + wp2_term_pr3_rhs( C5, thv_ds_zm(k), wpthvp(k), upwp(k), um(kp1), & + um(k), vpwp(k), vm(kp1), vm(k), gr%invrs_dzm(k) ) + + ! RHS dissipation term 1 (dp1). + rhs(k_wp2) & + = rhs(k_wp2) & + + wp2_term_dp1_rhs( C1_Skw_fnc(k), tau1m(k), w_tol_sqd ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS dissipation term 1 (dp1). + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the term + ! more numerically stable (see note below for w'^3 RHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1) & + = wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + rhs(k_wp2) & + = rhs(k_wp2) & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp2(k) ) + + ! RHS eddy diffusion term: dissipation term 2 (dp2). + if ( l_crank_nich_diff ) then + ! These lines are for the diffusional term with a Crank-Nicholson + ! time step. They are not used for completely implicit diffusion. + rhs_diff(1:3) & + = (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + rhs(k_wp2) = rhs(k_wp2) & + - rhs_diff(3) * wp2(km1) & + - rhs_diff(2) * wp2(k) & + - rhs_diff(1) * wp2(kp1) + endif + + ! RHS pressure term 1 (pr1). + if ( l_tke_aniso ) then + + rhs(k_wp2) & + = rhs(k_wp2) & + + wp2_term_pr1_rhs( C4, up2(k), vp2(k), tau1m(k) ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS dissipation term 1 (dp1). + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 RHS + ! turbulent advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1) & + = wp2_term_pr1_lhs( C4, tau1m(k) ) + rhs(k_wp2) & + = rhs(k_wp2) & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp2(k) ) + + endif + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for wp2. + + ! w'^2 term dp2 has both implicit and explicit components (if the + ! Crank-Nicholson scheme is selected); call stat_begin_update_pt. + ! Since stat_begin_update_pt automatically subtracts the value sent in, + ! reverse the sign on right-hand side diffusion component. If + ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt + ! will not be called. + if ( l_crank_nich_diff ) then + call stat_begin_update_pt( iwp2_dp2, k, & + rhs_diff(3) * wp2(km1) & + + rhs_diff(2) * wp2(k) & + + rhs_diff(1) * wp2(kp1), zm ) + endif + + ! w'^2 term bp is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of w'^2 term bp, substitute 0 for the + ! C_5 input to function wp2_terms_bp_pr2_rhs. + call stat_update_var_pt( iwp2_bp, k, & + wp2_terms_bp_pr2_rhs( 0.0_core_rknd, thv_ds_zm(k), wpthvp(k) ), zm ) + + ! w'^2 term pr1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp2_term_pr1_rhs. + if ( l_tke_aniso ) then + call stat_begin_update_pt( iwp2_pr1, k, & + -wp2_term_pr1_rhs( C4, up2(k), vp2(k), tau1m(k) ), zm ) + + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note below for + ! w'^3 RHS turbulent advection (ta) and turbulent + ! production (tp) terms). + lhs_fnc_output(1) & + = wp2_term_pr1_lhs( C4, tau1m(k) ) + call stat_modify_pt( iwp2_pr1, k, & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp2(k) ), zm ) + endif + + ! w'^2 term pr2 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp2_terms_bp_pr2_rhs. + ! Note: To find the contribution of w'^2 term pr2, add 1 to the + ! C_5 input to function wp2_terms_bp_pr2_rhs. + call stat_begin_update_pt( iwp2_pr2, k, & + -wp2_terms_bp_pr2_rhs( (1.0_core_rknd+C5), thv_ds_zm(k), wpthvp(k) ), zm ) + + ! w'^2 term dp1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp2_term_dp1_rhs. + call stat_begin_update_pt( iwp2_dp1, k, & + -wp2_term_dp1_rhs( C1_Skw_fnc(k), tau1m(k), w_tol_sqd ), zm ) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note below for w'^3 RHS + ! turbulent advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1) & + = wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) + call stat_modify_pt( iwp2_dp1, k, & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp2(k) ), zm ) + + ! w'^2 term pr3 is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( iwp2_pr3, k, & + wp2_term_pr3_rhs( C5, thv_ds_zm(k), wpthvp(k), upwp(k), um(kp1), & + um(k), vpwp(k), vm(kp1), vm(k), gr%invrs_dzm(k) ), & + zm ) + + endif + + + + !!!!!***** w'^3 *****!!!!! + + ! w'^3: Right-hand side (explicit w'^3 portion of the code). + + ! RHS time tendency. + rhs(k_wp3) = & + + ( 1.0_core_rknd / real( dt, kind = core_rknd ) * wp3(k) ) + + ! RHS turbulent advection (ta) and turbulent production (tp) terms. +! rhs(k_wp3) & +! = rhs(k_wp3) & +! + wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & +! wp2(k), wp2(km1), & +! a1(k), a1_zt(k), a1(km1), & +! a3(k), a3_zt(k), a3(km1), & +! wp3_on_wp2(k), wp3_on_wp2(km1), & +! rho_ds_zm(k), rho_ds_zm(km1), & +! invrs_rho_ds_zt(k), & +! three_halves, & +! gr%invrs_dzt(k) ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS turbulent advection (ta) and turbulent production (tp) terms. + ! + ! Note: An "over-implicit" weighted time step is applied to these terms. + ! The weight of the implicit portion of these terms is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (w'^3 in this case), y(t) is the linearized portion of + ! the terms that gets treated implicitly, and RHS is the portion of + ! the terms that is always treated explicitly. A weight of greater + ! than 1 can be applied to make the terms more numerically stable. + lhs_fnc_output(1:5) & + = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k), a3_zt(k), a3(km1), & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + rhs(k_wp3) & + = rhs(k_wp3) & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp3(kp1) & + - lhs_fnc_output(2) * wp2(k) & + - lhs_fnc_output(3) * wp3(k) & + - lhs_fnc_output(4) * wp2(km1) & + - lhs_fnc_output(5) * wp3(km1) ) + + ! RHS buoyancy production (bp) term and pressure term 2 (pr2). + rhs(k_wp3) & + = rhs(k_wp3) & + + wp3_terms_bp1_pr2_rhs( C11_Skw_fnc(k), thv_ds_zt(k), wp2thvp(k) ) + + ! RHS pressure term 1 (pr1). + rhs(k_wp3) & + = rhs(k_wp3) & + + wp3_term_pr1_rhs( C8, C8b, tauw3t(k), Skw_zt(k), wp3(k) ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS pressure term 1 (pr1). + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs_fnc_output(1) & + = wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + rhs(k_wp3) & + = rhs(k_wp3) & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp3(k) ) + + ! RHS eddy diffusion term: dissipation term 1 (dp1). + if ( l_crank_nich_diff ) then + ! These lines are for the diffusional term with a Crank-Nicholson + ! time step. They are not used for completely implicit diffusion. + rhs_diff(1:3) & + = C12 * (1.0_core_rknd/2.0_core_rknd) & + * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & + gr%invrs_dzm(km1), gr%invrs_dzm(k), & + gr%invrs_dzt(k), k ) + rhs(k_wp3) = rhs(k_wp3) & + - rhs_diff(3) * wp3(km1) & + - rhs_diff(2) * wp3(k) & + - rhs_diff(1) * wp3(kp1) + endif + + if ( l_wp3_2nd_buoyancy_term ) then + ! RHS 2nd bouyancy term + rhs(k_wp3) = rhs(k_wp3) & + + wp3_term_bp2_rhs( C15, Kh_zt(k), wpthvp(k), wpthvp(km1), & + dum_dz(k), dum_dz(km1), dvm_dz(k), dvm_dz(km1), & + upwp(k), upwp(km1), vpwp(k), vpwp(km1), & + thv_ds_zt(k), gr%invrs_dzt(k) ) + end if + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for wp3. + + ! w'^3 term ta has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp3_terms_ta_tp_rhs. + ! Note: To find the contribution of w'^3 term ta, add 3 to all of the + ! a_3 inputs and substitute 0 for the three_halves input to + ! function wp3_terms_ta_tp_rhs. +! call stat_begin_update_pt( iwp3_ta, k, & +! -wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & +! wp2(k), wp2(km1), & +! a1(k), a1_zt(k), a1(km1), & +! a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, +! a3(km1)+3.0_core_rknd, & +! wp3_on_wp2(k), wp3_on_wp2(km1), & +! rho_ds_zm(k), rho_ds_zm(km1), & +! invrs_rho_ds_zt(k), & +! 0.0_core_rknd, & +! gr%invrs_dzt(k) ), & +! zt ) + call stat_begin_update_pt( iwp3_ta, k, 0.0_core_rknd, zt ) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1:5) & + = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + a1(k), a1_zt(k), a1(km1), & + a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & + a3(km1)+3.0_core_rknd, & + wp3_on_wp2(k), wp3_on_wp2(km1), & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + 0.0_core_rknd, & + gr%invrs_dzt(k), k ) + call stat_modify_pt( iwp3_ta, k, & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp3(kp1) & + - lhs_fnc_output(2) * wp2(k) & + - lhs_fnc_output(3) * wp3(k) & + - lhs_fnc_output(4) * wp2(km1) & + - lhs_fnc_output(5) * wp3(km1) ), zt ) + + ! w'^3 term tp has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp3_terms_ta_tp_rhs. + ! Note: To find the contribution of w'^3 term tp, substitute 0 for all + ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 + ! inputs to function wp3_terms_ta_tp_rhs. +! call stat_begin_update_pt( iwp3_tp, k, & +! -wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & +! wp2(k), wp2(km1), & +! 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & +! 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, +! 0.0_core_rknd-3.0_core_rknd, & +! 0.0_core_rknd, 0.0_core_rknd, & +! rho_ds_zm(k), rho_ds_zm(km1), & +! invrs_rho_ds_zt(k), & +! three_halves, & +! gr%invrs_dzt(k) ), & +! zt ) + call stat_begin_update_pt( iwp3_tp, k, 0.0_core_rknd, zt ) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1:5) & + = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & + 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd-3.0_core_rknd, & + 0.0_core_rknd, 0.0_core_rknd, & + rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), & + three_halves, & + gr%invrs_dzt(k), k ) + call stat_modify_pt( iwp3_tp, k, & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(2) * wp2(k) & + - lhs_fnc_output(4) * wp2(km1) ), zt ) + + ! w'^3 term bp is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of w'^3 term bp, substitute 0 for the + ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs. + call stat_update_var_pt( iwp3_bp1, k, & + wp3_terms_bp1_pr2_rhs( 0.0_core_rknd, thv_ds_zt(k), wp2thvp(k) ), zt ) + + ! w'^3 term pr2 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp3_terms_bp1_pr2_rhs. + ! Note: To find the contribution of w'^3 term pr2, add 1 to the + ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs. + call stat_begin_update_pt( iwp3_pr2, k, & + -wp3_terms_bp1_pr2_rhs( (1.0_core_rknd+C11_Skw_fnc(k)), thv_ds_zt(k), & + wp2thvp(k) ), & + zt ) + + ! w'^3 term pr1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on wp3_term_pr1_rhs. + call stat_begin_update_pt( iwp3_pr1, k, & + -wp3_term_pr1_rhs( C8, C8b, tauw3t(k), Skw_zt(k), wp3(k) ), & + zt ) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) and turbulent production (tp) terms). + lhs_fnc_output(1) & + = wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) + call stat_modify_pt( iwp3_pr1, k, & + + ( 1.0_core_rknd - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wp3(k) ), zt ) + + ! w'^3 term dp1 has both implicit and explicit components (if the + ! Crank-Nicholson scheme is selected); call stat_begin_update_pt. + ! Since stat_begin_update_pt automatically subtracts the value sent in, + ! reverse the sign on right-hand side diffusion component. If + ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt + ! will not be called. + if ( l_crank_nich_diff ) then + call stat_begin_update_pt( iwp3_dp1, k, & + rhs_diff(3) * wp3(km1) & + + rhs_diff(2) * wp3(k) & + + rhs_diff(1) * wp3(kp1), zt ) + endif + + if ( l_wp3_2nd_buoyancy_term ) then + temp = wp3_term_bp2_rhs( C15, Kh_zt(k), wpthvp(k), wpthvp(km1), & + dum_dz(k), dum_dz(km1), dvm_dz(k), dvm_dz(km1), & + upwp(k), upwp(km1), vpwp(k), vpwp(km1), & + thv_ds_zt(k), gr%invrs_dzt(k) ) + call stat_update_var_pt( iwp3_bp2, k, temp, zt ) + end if + + endif ! l_stats_samp + + enddo ! k = 2..gr%nz-1 + + + ! Boundary conditions + + ! Both wp2 and wp3 used fixed-point boundary conditions. + ! Therefore, anything set in the above loop at both the upper + ! and lower boundaries would be overwritten here. However, the + ! above loop does not extend to the boundary levels. An array + ! with a value of 1 at the main diagonal on the left-hand side + ! and with values of 0 at all other diagonals on the left-hand + ! side will preserve the right-hand side value at that level. + + ! Lower boundary + k = 1 + k_wp3_low = 2*k - 1 + k_wp2_low = 2*k + + ! Upper boundary + k = gr%nz + k_wp3_high = 2*k - 1 + k_wp2_high = 2*k + + + ! The value of w'^2 at the lower boundary will remain the same. + ! When the lower boundary is at the surface, the surface value of + ! w'^2 is set in subroutine surface_varnce (surface_varnce_module.F). + + ! The value of w'^3 at the lower boundary will be 0. + + ! The value of w'^2 at the upper boundary will be set to the threshold + ! minimum value of w_tol_sqd. + + ! The value of w'^3 at the upper boundary will be set to 0. + call set_boundary_conditions_rhs( & + wp2(1), k_wp2_low, w_tol_sqd, k_wp2_high, & ! Intent(in) + rhs, & ! Intent(inout) + 0.0_core_rknd, k_wp3_low, 0.0_core_rknd, k_wp3_high ) + + return + + end subroutine wp23_rhs + + !============================================================================= + pure function wp2_term_ta_lhs( rho_ds_ztp1, rho_ds_zt, & + invrs_rho_ds_zm, invrs_dzm ) & + result( lhs ) + + ! Description: + ! Turbulent advection term for w'^2: implicit portion of the code. + ! + ! The d(w'^2)/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'^3 )/dz. + ! + ! The term is solved for completely implicitly, such that: + ! + ! - (1/rho_ds) * d( rho_ds * w'^3(t+1) )/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'^3 being used is from + ! the next timestep, which is being advanced to in solving the d(w'^2)/dt + ! and d(w'^3)/dt equations. + ! + ! This term is discretized as follows: + ! + ! While the values of w'^2 are found on the momentum levels, the values of + ! w'^3 are found on the thermodynamic levels. Additionally, the values of + ! rho_ds_zt are found on the thermodynamic levels, and the values of + ! invrs_rho_ds_zm are found on the momentum levels. On the thermodynamic + ! levels, the values of rho_ds_zt are multiplied by the values of w'^3. The + ! derivative of (rho_ds_zt * w'^3) is taken over the intermediate (central) + ! momentum level, where it is multiplied by invrs_rho_ds_zm, yielding the + ! desired results. + ! + ! -----rho_ds_ztp1--------wp3p1---------------------------- t(k+1) + ! + ! ========invrs_rho_ds_zm==========d(rho_ds*wp3)/dz======== m(k) + ! + ! -----rho_ds_zt----------wp3------------------------------ t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2 ! Thermodynamic subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] + rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. lev. (k) [m^3/kg] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ), dimension(2) :: lhs + + ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] + lhs(kp1_tdiag) & + = + invrs_rho_ds_zm * invrs_dzm * rho_ds_ztp1 + + ! Thermodynamic subdiagonal: [ x wp3(k,) ] + lhs(k_tdiag) & + = - invrs_rho_ds_zm * invrs_dzm * rho_ds_zt + + return + + end function wp2_term_ta_lhs + + !============================================================================= + pure function wp2_terms_ac_pr2_lhs( C5, wm_ztp1, wm_zt, invrs_dzm ) & + result( lhs ) + + ! Description: + ! Accumulation of w'^2 and w'^2 pressure term 2: implicit portion of the + ! code. + ! + ! The d(w'^2)/dt equation contains an accumulation term: + ! + ! - 2 w'^2 dw/dz; + ! + ! and pressure term 2: + ! + ! - C_5 ( -2 w'^2 dw/dz + 2 (g/th_0) w'th_v' ). + ! + ! The w'^2 accumulation term is completely implicit, while w'^2 pressure + ! term 2 has both implicit and explicit components. The accumulation term + ! and the implicit portion of pressure term 2 are combined and solved + ! together as: + ! + ! + ( 1 - C_5 ) ( -2 w'^2(t+1) dw/dz ). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the "2" is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'^2 being used is from + ! the next timestep, which is being advanced to in solving the d(w'^2)/dt + ! equation. + ! + ! The terms are discretized as follows: + ! + ! The values of w'^2 are found on the momentum levels, while the values of + ! wm_zt (mean vertical velocity on thermodynamic levels) are found on the + ! thermodynamic levels. The vertical derivative of wm_zt is taken over the + ! intermediate (central) momentum level. It is then multiplied by w'^2 + ! (implicitly calculated at timestep (t+1)) and the coefficients to yield + ! the desired results. + ! + ! -------wm_ztp1------------------------------------------- t(k+1) + ! + ! ===============d(wm_zt)/dz============wp2================ m(k) + ! + ! -------wm_zt--------------------------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C5, & ! Model parameter C_5 [-] + wm_ztp1, & ! w wind component at t:hermodynamic levels (k+1) [m/s] + wm_zt, & ! w wind component at thermodynamic levels (k) [m/s] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Momentum main diagonal: [ x wp2(k,) ] + lhs & + = + ( 1.0_core_rknd - C5 ) * 2.0_core_rknd * invrs_dzm * ( wm_ztp1 - wm_zt ) + + return + + end function wp2_terms_ac_pr2_lhs + + !============================================================================= + pure function wp2_term_dp1_lhs( C1_Skw_fnc, tau1m ) & + result( lhs ) + + ! Description: + ! Dissipation term 1 for w'^2: implicit portion of the code. + ! + ! The d(w'^2)/dt equation contains dissipation term 1: + ! + ! - ( C_1 / tau_1m ) w'^2. + ! + ! Since w'^2 has a minimum threshold, the term should be damped only to that + ! threshold. The term becomes: + ! + ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ). + ! + ! This term is broken into implicit and explicit portions. The implicit + ! portion of this term is: + ! + ! - ( C_1 / tau_1m ) w'^2(t+1). + ! + ! Note: When the implicit term is brought over to the left-hand side, the + ! sign is reversed and the leading "-" in front of the term is + ! changed to a "+". + ! + ! The timestep index (t+1) means that the value of w'^2 being used is from + ! the next timestep, which is being advanced to in solving the d(w'^2)/dt + ! equation. + ! + ! The values of w'^2 are found on the momentum levels. The values of the + ! C_1 skewness function and time-scale tau1m are also found on the momentum + ! levels. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied (k) [-] + tau1m ! Time-scale tau at momentum levels (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Momentum main diagonal: [ x wp2(k,) ] + lhs & + = + C1_Skw_fnc / tau1m + + return + end function wp2_term_dp1_lhs + + !============================================================================= + pure function wp2_term_pr1_lhs( C4, tau1m ) & + result( lhs ) + + ! Description + ! Pressure term 1 for w'^2: implicit portion of the code. + ! + ! The d(w'^2)/dt equation contains pressure term 1: + ! + ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em ), + ! + ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ). + ! + ! This simplifies to: + ! + ! - ( C_4 / tau_1m ) * (2/3) * w'^2 + ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ). + ! + ! Pressure term 1 has both implicit and explicit components. The implicit + ! portion is: + ! + ! - ( C_4 / tau_1m ) * (2/3) * w'^2(t+1); + ! + ! and is computed in this function. + ! + ! Note: When the implicit term is brought over to the left-hand side, the + ! sign is reversed and the leading "-" in front of the term is + ! changed to a "+". + ! + ! The timestep index (t+1) means that the value of w'^2 being used is from + ! the next timestep, which is being advanced to in solving the d(w'^2)/dt + ! equation. + ! + ! The values of w'^2 are found on momentum levels, as are the values of tau1m. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C4, & ! Model parameter C_4 [-] + tau1m ! Time-scale tau at momentum levels (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Momentum main diagonal: [ x wp2(k,) ] + lhs & + = + ( 2.0_core_rknd * C4 ) / ( 3.0_core_rknd * tau1m ) + + return + end function wp2_term_pr1_lhs + + !============================================================================= + pure function wp2_terms_bp_pr2_rhs( C5, thv_ds_zm, wpthvp ) & + result( rhs ) + + ! Description: + ! Buoyancy production of w'^2 and w'^2 pressure term 2: explicit portion of + ! the code. + ! + ! The d(w'^2)/dt equation contains a buoyancy production term: + ! + ! + 2 (g/thv_ds) w'th_v'; + ! + ! and pressure term 2: + ! + ! - C_5 ( -2 w'^2 dw/dz + 2 (g/thv_ds) w'th_v' ). + ! + ! The w'^2 buoyancy production term is completely explicit, while w'^2 + ! pressure term 2 has both implicit and explicit components. The buoyancy + ! production term and the explicit portion of pressure term 2 are combined + ! and solved together as: + ! + ! + ( 1 - C_5 ) ( 2 (g/thv_ds) w'th_v' ). + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + ! Variable(s) + grav ! Gravitational acceleration [m/s^2] + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C5, & ! Model parameter C_5 [-] + thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] + wpthvp ! w'th_v'(k) [K m/s] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( 1.0_core_rknd - C5 ) * 2.0_core_rknd * ( grav / thv_ds_zm ) * wpthvp + + return + end function wp2_terms_bp_pr2_rhs + + !============================================================================= + pure function wp2_term_dp1_rhs( C1_Skw_fnc, tau1m, threshold ) & + result( rhs ) + + ! Description: + ! Dissipation term 1 for w'^2: explicit portion of the code. + ! + ! The d(w'^2)/dt equation contains dissipation term 1: + ! + ! - ( C_1 / tau_1m ) w'^2. + ! + ! Since w'^2 has a minimum threshold, the term should be damped only to that + ! threshold. The term becomes: + ! + ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ). + ! + ! This term is broken into implicit and explicit portions. The explicit + ! portion of this term is: + ! + ! + ( C_1 / tau_1m ) * threshold. + ! + ! The values of the C_1 skewness function, time-scale tau1m, and the + ! threshold are found on the momentum levels. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C1_Skw_fnc, & ! C_1 parameter with Sk_w applied (k) [-] + tau1m, & ! Time-scale tau at momentum levels (k) [s] + threshold ! Minimum allowable value of w'^2 [m^2/s^2] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( C1_Skw_fnc / tau1m ) * threshold + + return + end function wp2_term_dp1_rhs + + !============================================================================= + pure function wp2_term_pr3_rhs( C5, thv_ds_zm, wpthvp, upwp, ump1, & + um, vpwp, vmp1, vm, invrs_dzm ) & + result( rhs ) + + ! Description: + ! Pressure term 3 for w'^2: explicit portion of the code. + ! + ! The d(w'^2)/dt equation contains pressure term 3: + ! + ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ]. + ! + ! This term is solved for completely explicitly and is discretized as + ! follows: + ! + ! The values of w'th_v', u'w', and v'w' are found on the momentum levels, + ! whereas the values of um and vm are found on the thermodynamic levels. + ! Additionally, the values of thv_ds_zm are found on the momentum levels. + ! The derivatives of both um and vm are taken over the intermediate + ! (central) momentum level. All the remaining mathematical operations take + ! place at the central momentum level, yielding the desired result. + ! + ! -----ump1------------vmp1-------------------------------------- t(k+1) + ! + ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k) + ! + ! -----um--------------vm---------------------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & ! Variables + grav, & ! Gravitational acceleration [m/s^2] + zero_threshold + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C5, & ! Model parameter C_5 [-] + thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] + wpthvp, & ! w'th_v'(k) [K m/s] + upwp, & ! u'w'(k) [m^2/s^2] + ump1, & ! um(k+1) [m/s] + um, & ! um(k) [m/s] + vpwp, & ! v'w'(k) [m^2/s^2] + vmp1, & ! vm(k+1) [m/s] + vm, & ! vm(k) [m/s] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + ! Michael Falk, 2 August 2007 + ! Use the following code for standard mixing, with c_k=0.548: + = + (2.0_core_rknd/3.0_core_rknd) * C5 & + * ( ( grav / thv_ds_zm ) * wpthvp & + - upwp * invrs_dzm * ( ump1 - um ) & + - vpwp * invrs_dzm * ( vmp1 - vm ) & + ) + ! Use the following code for alternate mixing, with c_k=0.1 or 0.2 +! = + (2.0_core_rknd/3.0_core_rknd) * C5 & +! * ( ( grav / thv_ds_zm ) * wpthvp & +! - 0. * upwp * invrs_dzm * ( ump1 - um ) & +! - 0. * vpwp * invrs_dzm * ( vmp1 - vm ) & +! ) +! eMFc + + ! Added by dschanen for ticket #36 + ! We have found that when shear generation is zero this term will only be + ! offset by hole-filling (wp2_pd) and reduces turbulence + ! unrealistically at lower altitudes to make up the difference. + rhs = max( rhs, zero_threshold ) + + return + end function wp2_term_pr3_rhs + + !============================================================================= + pure function wp2_term_pr1_rhs( C4, up2, vp2, tau1m ) & + result( rhs ) + + ! Description: + ! Pressure term 1 for w'^2: explicit portion of the code. + ! + ! The d(w'^2)/dt equation contains pressure term 1: + ! + ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em ); + ! + ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ). + ! + ! This simplifies to: + ! + ! - ( C_4 / tau_1m ) * (2/3) * w'^2 + ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ). + ! + ! Pressure term 1 has both implicit and explicit components. + ! The explicit portion is: + ! + ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ); + ! + ! and is computed in this function. + ! + ! The values of u'^2 and v'^2 are found on momentum levels, as are the + ! values of tau1m. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C4, & ! Model parameter C_4 [-] + up2, & ! u'^2(k) [m^2/s^2] + vp2, & ! v'^2(k) [m^2/s^2] + tau1m ! Time-scale tau at momentum levels (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( C4 * ( up2 + vp2 ) ) / ( 3.0_core_rknd * tau1m ) + + return + end function wp2_term_pr1_rhs + + !============================================================================= + pure function wp3_terms_ta_tp_lhs( wp2, wp2m1, & + a1, a1_zt, a1m1, & + a3, a3_zt, a3m1, & + wp3_on_wp2, wp3_on_wp2_m1, & + rho_ds_zm, rho_ds_zmm1, & + invrs_rho_ds_zt, & + const_three_halves, & + invrs_dzt, level ) & + result( lhs ) + + ! Description: + ! Turbulent advection and turbulent production of w'^3: implicit portion of + ! the code. + ! + ! The d(w'^3)/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'^4 )/dz; + ! + ! and a turbulent production term: + ! + ! + 3 * ( w'^2 / rho_ds ) * d( rho_ds * w'^2 )/dz. + ! + ! A substitution is made in order to close the turbulent advection term, + ! such that: + ! + ! w'^4 = coef_sig_sqd_w * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ); + ! + ! where both a_1 and coef_sig_sqd_w are variables that are functions of + ! sigma_sqd_w, such that: + ! + ! coef_sig_sqd_w = 3*(sigma_sqd_w)^2 + 6*(1 - sigma_sqd_w)*sigma_sqd_w + ! + (1 - sigma_sqd_w)^2; and + ! + ! a_1 = 1 / (1 - sigma_sqd_w). + ! + ! Since the turbulent advection and turbulent production terms are being + ! combined, a further substitution is made, such that: + ! + ! a_3 = coef_sig_sqd_w - 3; + ! + ! and thus: + ! + ! w'^4 = (a_3 + 3) * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ). + ! + ! The turbulent production term is rewritten as: + ! + ! + 3 * ( w'^2 / rho_ds ) * d[ rho_ds * w'^2 ]/dz + ! = + (3/rho_ds) * d[ rho_ds * (w'^2)^2 ]/dz - (3/2) * d[ (w'^2)^2 ]/dz. + ! + ! The turbulent advection and turbulent production terms are combined as: + ! + ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( (w'^3)^2 / w'^2 ) ] / dz + ! - (3/2) * d [ (w'^2)^2 ] / dz. + ! + ! The (w'^2)^2 and (w'^3)^2 terms are both linearized, such that: + ! + ! ( w'^2(t+1) )^2 = - ( w'^2(t) )^2 + 2 * w'^2(t) * w'^2(t+1); + ! ( w'^3(t+1) )^2 = - ( w'^3(t) )^2 + 2 * w'^3(t) * w'^3(t+1); + ! + ! which produces implicit and explicit portions of these terms. The + ! implicit portion of these terms is: + ! + ! - (1/rho_ds) * d [ rho_ds * a_3 * 2 * w'^2(t) * w'^2(t+1) ] / dz + ! - (1/rho_ds) * d [ rho_ds * a_1 + ! * ( 2 * w'^3(t) * w'^3(t+1) ) / w'^2(t) ] / dz + ! - (3/2) * d [ 2 * w'^2(t) * w'^2(t+1) ] /dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign is + ! reversed and the leading "-" in front of all d[ ] / dz terms is + ! changed to a "+". + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations. + ! + ! The implicit portion of these terms is discretized as follows: + ! + ! The values of w'^3 are found on the thermodynamic levels, while the values + ! of w'^2, a_1, and a_3 are found on the momentum levels. Additionally, the + ! values of rho_ds_zm are found on the momentum levels, and the values of + ! invrs_rho_ds_zt are found on the thermodynamic levels. The variable w'^3 + ! is interpolated to the intermediate momentum levels. The values of the + ! mathematical expressions (called F, G, and H here) within the dF/dz, + ! dG/dz, and dH/dz terms are computed on the momentum levels. Then, the + ! derivatives (d/dz) of the expressions (F, G, and H) are taken over the + ! central thermodynamic level, where dF/dz and dG/dz are multiplied by + ! invrs_rho_ds_zt, and where dH/dz is multiplied by 3/2. This yields the + ! desired results. In this function, the values of F, G, and H are as + ! follows: + ! + ! F = rho_ds_zm * a_3(t) * 2 * w'^2(t) * w'^2(t+1); + ! + ! G = rho_ds_zm * a_1(t) * ( 2 * w'^3(t) * w'^3(t+1) ) / w'^2(t); and + ! + ! H = 2 * w'^2(t) * w'^2(t+1). + ! + ! + ! ------------------------------------------------wp3p1-------------- t(k+1) + ! + ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k) + ! + ! ---dH/dz---dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k) + ! + ! ===a3m1==wp2m1==rho_ds_zmm1==a1m1====================wp3(interp)=== m(k-1) + ! + ! ------------------------------------------------wp3m1-------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is + ! used for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable gr%weights_zt2zm + + use crmx_constants_clubb, only: & + w_tol_sqd + + use crmx_model_flags, only: & + l_standard_term_ta + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_mdiag = 2, & ! Momentum superdiagonal index. + k_tdiag = 3, & ! Thermodynamic main diagonal index. + km1_mdiag = 4, & ! Momentum subdiagonal index. + km1_tdiag = 5 ! Thermodynamic subdiagonal index. + + integer, parameter :: & + t_above = 1, & ! Index for upper thermodynamic level grid weight. + t_below = 2 ! Index for lower thermodynamic level grid weight. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp2, & ! w'^2(k) [m^2/s^2] + wp2m1, & ! w'^2(k-1) [m^2/s^2] + a1, & ! a_1(k) [-] + a1_zt, & ! a_1 interpolated to thermo. level (k) [-] + a1m1, & ! a_1(k-1) [-] + a3, & ! a_3(k) [-] + a3_zt, & ! a_3 interpolated to thermo. level (k) [-] + a3m1, & ! a_3(k-1) [-] + wp3_on_wp2, & ! wp3 / wp2 (k) [m/s] + wp3_on_wp2_m1, & ! wp3 / wp2 (k-1) [m/s] + rho_ds_zm, & ! Dry, static density at moment. lev (k) [kg/m^3] + rho_ds_zmm1, & ! Dry, static density at moment. lev (k-1) [kg/m^3] + invrs_rho_ds_zt, & ! Inv dry, static density @ thermo lev (k) [m^3/kg] + const_three_halves, & ! "3/2" ("0" is sent in for wp3_ta budget) [-] + invrs_dzt ! Inverse of grid spacing (k) [1/m] + + integer, intent(in) :: & + level ! Central thermodynamic level (on which calculation occurs). + + ! Return Variable + real( kind = core_rknd ), dimension(5) :: lhs + + ! Local Variables + integer :: & + mk, & ! Momentum level directly above central thermodynamic level. + mkm1 ! Momentum level directly below central thermodynamic level. + + + ! Momentum level (k) is between thermodynamic level (k+1) + ! and thermodynamic level (k). + mk = level + + ! Momentum level (k-1) is between thermodynamic level (k) + ! and thermodynamic level (k-1). + mkm1 = level - 1 + + if ( l_standard_term_ta ) then + + ! The turbulent advection term is discretized normally, in accordance + ! with the model equations found in the documentation and the description + ! listed above. + + ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] + lhs(kp1_tdiag) & + = + invrs_rho_ds_zt & + * invrs_dzt & + * rho_ds_zm * a1 & + * wp3_on_wp2 & + * gr%weights_zt2zm(t_above,mk) + + ! Momentum superdiagonal: [ x wp2(k,) ] + lhs(k_mdiag) & + = + invrs_rho_ds_zt & + * invrs_dzt * rho_ds_zm * a3 * wp2 & + + const_three_halves & + * invrs_dzt * wp2 + + ! Thermodynamic main diagonal: [ x wp3(k,) ] + lhs(k_tdiag) & + = + invrs_rho_ds_zt & + * invrs_dzt & + * ( rho_ds_zm * a1 & + * wp3_on_wp2 & + * gr%weights_zt2zm(t_below,mk) & + - rho_ds_zmm1 * a1m1 & + * wp3_on_wp2_m1 & + * gr%weights_zt2zm(t_above,mkm1) & + ) + + ! Momentum subdiagonal: [ x wp2(k-1,) ] + lhs(km1_mdiag) & + = - invrs_rho_ds_zt & + * invrs_dzt * rho_ds_zmm1 * a3m1 * wp2m1 & + - const_three_halves & + * invrs_dzt * wp2m1 + + ! Thermodynamic subdiagonal: [ x wp3(k-1,) ] + lhs(km1_tdiag) & + = - invrs_rho_ds_zt & + * invrs_dzt & + * rho_ds_zmm1 * a1m1 & + * wp3_on_wp2_m1 & + * gr%weights_zt2zm(t_below,mkm1) + + else + + ! Brian tried a new discretization for the turbulent advection term, + ! which contains the term: + ! - (1/rho_ds) * d [ rho_ds * a_1 * (w'^3)^2 / w'^2 ] / dz. In order + ! to help stabilize w'^3, a_1 has been pulled outside of the derivative. + ! On the left-hand side of the equation, this effects the thermodynamic + ! superdiagonal (kp1_tdiag), the thermodynamic main diagonal (k_tdiag), + ! and the thermodynamic subdiagonal (km1_tdiag). + + ! Additionally, the discretization of the turbulent advection term, which + ! contains the term: + ! - (1/rho_ds) * d [ rho_ds * (a_3 + 3) * (w'^2)^2 ] / dz, has been + ! altered to pull (a_3 + 3) outside of the derivative. This was done in + ! order to help stabilize w'^3. On the left-hand side of the equation, + ! this effects the momentum superdiagonal (k_mdiag) and the momentum + ! subdiagonal (km1_mdiag). + + ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] + lhs(kp1_tdiag) & + = + invrs_rho_ds_zt & + * a1_zt * invrs_dzt & + * rho_ds_zm & + * wp3_on_wp2 & + * gr%weights_zt2zm(t_above,mk) + + ! Momentum superdiagonal: [ x wp2(k,) ] + lhs(k_mdiag) & + = + invrs_rho_ds_zt & + * a3_zt * invrs_dzt * rho_ds_zm * wp2 & + + const_three_halves & + * invrs_dzt * wp2 + + ! Thermodynamic main diagonal: [ x wp3(k,) ] + lhs(k_tdiag) & + = + invrs_rho_ds_zt & + * a1_zt * invrs_dzt & + * ( rho_ds_zm & + * wp3_on_wp2 & + * gr%weights_zt2zm(t_below,mk) & + - rho_ds_zmm1 & + * wp3_on_wp2_m1 & + * gr%weights_zt2zm(t_above,mkm1) & + ) + + ! Momentum subdiagonal: [ x wp2(k-1,) ] + lhs(km1_mdiag) & + = - invrs_rho_ds_zt & + * a3_zt * invrs_dzt * rho_ds_zmm1 * wp2m1 & + - const_three_halves & + * invrs_dzt * wp2m1 + + ! Thermodynamic subdiagonal: [ x wp3(k-1,) ] + lhs(km1_tdiag) & + = - invrs_rho_ds_zt & + * a1_zt * invrs_dzt & + * rho_ds_zmm1 & + * wp3_on_wp2_m1 & + * gr%weights_zt2zm(t_below,mkm1) + + ! End of code that pulls out a3. + ! End of Brian's a1 change. Feb. 14, 2008. + + end if ! l_standard_term_ta + + + return + end function wp3_terms_ta_tp_lhs + + !============================================================================= + pure function wp3_terms_ac_pr2_lhs( C11_Skw_fnc, & + wm_zm, wm_zmm1, invrs_dzt ) & + result( lhs ) + + ! Description: + ! Accumulation of w'^3 and w'^3 pressure term 2: implicit portion of the + ! code. + ! + ! The d(w'^3)/dt equation contains an accumulation term: + ! + ! - 3 w'^3 dw/dz; + ! + ! and pressure term 2: + ! + ! - C_11 ( -3 w'^3 dw/dz + 3 (g/th_0) w'^2th_v' ). + ! + ! The w'^3 accumulation term is completely implicit, while w'^3 pressure + ! term 2 has both implicit and explicit components. The accumulation term + ! and the implicit portion of pressure term 2 are combined and solved + ! together as: + ! + ! + ( 1 - C_11 ) ( -3 w'^3(t+1) dw/dz ). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the "3" is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'^3 being used is from + ! the next timestep, which is being advanced to in solving the d(w'^3)/dt + ! equation. + ! + ! The terms are discretized as follows: + ! + ! The values of w'^3 are found on thermodynamic levels, while the values of + ! wm_zm (mean vertical velocity on momentum levels) are found on momentum + ! levels. The vertical derivative of wm_zm is taken over the intermediate + ! (central) thermodynamic level. It is then multiplied by w'^3 (implicitly + ! calculated at timestep (t+1)) and the coefficients to yield the desired + ! results. + ! + ! =======wm_zm============================================= m(k) + ! + ! ---------------d(wm_zm)/dz------------wp3---------------- t(k) + ! + ! =======wm_zmm1=========================================== m(k-1) + ! + ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes + ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied (k) [-] + wm_zm, & ! w wind component at momentum levels (k) [m/s] + wm_zmm1, & ! w wind component at momentum levels (k-1) [m/s] + invrs_dzt ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Thermodynamic main diagonal: [ x wp3(k,) ] + lhs & + = + ( 1.0_core_rknd - C11_Skw_fnc ) & + * 3.0_core_rknd * invrs_dzt * ( wm_zm - wm_zmm1 ) + + return + end function wp3_terms_ac_pr2_lhs + + !============================================================================= + pure function wp3_term_pr1_lhs( C8, C8b, tauw3t, Skw_zt ) & + result( lhs ) + + ! Description: + ! Pressure term 1 for w'^3: implicit portion of the code. + ! + ! Pressure term 1 is the term: + ! + ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^4 + 1 ) * w'^3; + ! + ! where Sk_wt = w'^3 / (w'^2)^(3/2). + ! + ! This term needs to be linearized, so function L(w'^3) is defined to be + ! equal to this term (pressure term 1), such that: + ! + ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^5 / (w'^2)^6 + w'^3 ). + ! + ! A Taylor Series expansion (truncated after the first derivative term) of + ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1. + ! Evaluating L(w'^3) at w'^3(t+1): + ! + ! L( w'^3(t+1) ) = L( w'^3(t) ) + ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t)) + ! * ( w'^3(t+1) - w'^3(t) ). + ! + ! After evaluating the expression above, the term has become linearized. It + ! is broken down into implicit (LHS) and explicit (RHS) components. + ! The implicit portion is: + ! + ! - (C_8/tau_w3t) * ( 5 * C_8b * Sk_wt^4 + 1 ) * w'^3(t+1). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(w'^3)/dt equation. + ! + ! The values of w'^3 are found on the thermodynamic levels, as are the + ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic + ! levels and w'^2 is interpolated to thermodynamic levels). + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C8, & ! Model parameter C_8 [-] + C8b, & ! Model parameter C_8b [-] + tauw3t, & ! Time-scale tau at thermodynamic levels (k) [s] + Skw_zt ! Skewness of w at thermodynamic levels (k) [-] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Thermodynamic main diagonal: [ x wp3(k,) ] + lhs & + = + ( C8 / tauw3t ) * ( 5.0_core_rknd * C8b * Skw_zt**4 + 1.0_core_rknd ) + + return + end function wp3_term_pr1_lhs + + !============================================================================= +! pure function wp3_terms_ta_tp_rhs( wp3_zm, wp3_zmm1, & +! wp2, wp2m1, & +! a1, a1_zt, a1m1, & +! a3, a3_zt, a3m1, & +! wp3_on_wp2, wp3_on_wp2_m1, & +! rho_ds_zm, rho_ds_zmm1, & +! invrs_rho_ds_zt, & +! const_three_halves, & +! invrs_dzt ) & +! result( rhs ) + + ! Description: + ! Turbulent advection and turbulent production of wp3: explicit portion of + ! the code. + ! + ! The d(w'^3)/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'^4 )/dz; + ! + ! and a turbulent production term: + ! + ! + 3 * ( w'^2 / rho_ds ) * d( rho_ds * w'^2 )/dz. + ! + ! A substitution is made in order to close the turbulent advection term, + ! such that: + ! + ! w'^4 = coef_sig_sqd_w * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ); + ! + ! where both a_1 and coef_sig_sqd_w are variables that are functions of + ! sigma_sqd_w, such that: + ! + ! coef_sig_sqd_w = 3*(sigma_sqd_w)^2 + 6*(1 - sigma_sqd_w)*sigma_sqd_w + ! + (1 - sigma_sqd_w)^2; and + ! + ! a_1 = 1 / (1 - sigma_sqd_w). + ! + ! Since the turbulent advection and turbulent production terms are being + ! combined, a further substitution is made, such that: + ! + ! a_3 = coef_sig_sqd_w - 3; + ! + ! and thus: + ! + ! w'^4 = (a_3 + 3) * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ). + ! + ! The turbulent production term is rewritten as: + ! + ! + 3 * ( w'^2 / rho_ds ) * d[ rho_ds * w'^2 ]/dz + ! = + (3/rho_ds) * d[ rho_ds * (w'^2)^2 ]/dz - (3/2) * d[ (w'^2)^2 ]/dz. + ! + ! The turbulent advection and turbulent production terms are combined as: + ! + ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( (w'^3)^2 / w'^2 ) ] / dz + ! - (3/2) * d [ (w'^2)^2 ] / dz. + ! + ! The (w'^2)^2 and (w'^3)^2 terms are both linearized, such that: + ! + ! ( w'^2(t+1) )^2 = - ( w'^2(t) )^2 + 2 * w'^2(t) * w'^2(t+1); + ! ( w'^3(t+1) )^2 = - ( w'^3(t) )^2 + 2 * w'^3(t) * w'^3(t+1); + ! + ! which produces implicit and explicit portions of these terms. The + ! explicit portion of these terms is: + ! + ! + (1/rho_ds) * d [ rho_ds * a_3 * ( w'^2(t) )^2 ] / dz + ! + (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3(t) )^2 / w'^2(t) ] / dz + ! + (3/2) * d [ ( w'^2(t) )^2 ] / dz. + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations. + ! + ! The explicit portion of these terms is discretized as follows: + ! + ! The values of w'^3 are found on the thermodynamic levels, while the values + ! of w'^2, a_1, and a_3 are found on the momentum levels. Additionally, the + ! values of rho_ds_zm are found on the momentum levels, and the values of + ! invrs_rho_ds_zt are found on the thermodynamic levels. The variable w'^3 + ! is interpolated to the intermediate momentum levels. The values of the + ! mathematical expressions (called F, G, and H here) within the dF/dz, + ! dG/dz, and dH/dz terms are computed on the momentum levels. Then, the + ! derivatives (d/dz) of the expressions (F, G, and H) are taken over the + ! central thermodynamic level, where dF/dz and dG/dz are multiplied by + ! invrs_rho_ds_zt, and where dH/dz is multiplied by 3/2. This yields the + ! desired results. In this function, the values of F, G, and H are as + ! follows: + ! + ! F = rho_ds_zm * a_3(t) * ( w'^2(t) )^2; + ! + ! G = rho_ds_zm * a_1(t) * ( w'^3(t) )^2 / w'^2(t); and + ! + ! H = ( w'^2(t) )^2. + ! + ! + ! ------------------------------------------------wp3p1-------------- t(k+1) + ! + ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k) + ! + ! ---dH/dz---dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k) + ! + ! ===a3m1==wp2m1==rho_ds_zmm1==a1m1====================wp3(interp)=== m(k-1) + ! + ! ------------------------------------------------wp3m1-------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + + ! References: + !----------------------------------------------------------------------- + +! use constants_clubb, only: & +! w_tol_sqd + +! use model_flags, only: & +! l_standard_term_ta + +! implicit none + + ! Input Variables +! real, intent(in) :: & +! wp3_zm, & ! w'^3 interpolated to momentum lev. (k) [m^3/s^3] +! wp3_zmm1, & ! w'^3 interpolated to momentum lev. (k-1) [m^3/s^3] +! wp2, & ! w'^2(k) [m^2/s^2] +! wp2m1, & ! w'^2(k-1) [m^2/s^2] +! a1, & ! a_1(k) [-] +! a1_zt, & ! a_1 interpolated to thermo. level (k) [-] +! a1m1, & ! a_1(k-1) [-] +! a3, & ! a_3(k) [-] +! a3_zt, & ! a_3 interpolated to thermo. level (k) [-] +! a3m1, & ! a_3(k-1) [-] +! wp3_on_wp2, & ! (k) [m/s] +! wp3_on_wp2_m1, & ! (k-1) [m/s] +! rho_ds_zm, & ! Dry, static density at moment. lev (k) [kg/m^3] +! rho_ds_zmm1, & ! Dry, static density at moment. lev (k-1) [kg/m^3] +! invrs_rho_ds_zt, & ! Inv dry, static density @ thermo lev (k) [m^3/kg] +! const_three_halves, & ! "3/2" ("0" is sent in for wp3_ta budget) [-] +! invrs_dzt ! Inverse of grid spacing (k) [1/m] + + ! Return Variable +! real :: rhs + + +! if ( l_standard_term_ta ) then + + ! The turbulent advection term is discretized normally, in accordance + ! with the model equations found in the documentation and the description + ! listed above. + +! rhs & +! = + invrs_rho_ds_zt & +! * invrs_dzt & +! * ( rho_ds_zm * a3 * wp2**2 & +! - rho_ds_zmm1 * a3m1 * wp2m1**2 & +! ) & +! + invrs_rho_ds_zt & +! * invrs_dzt & +! * ( rho_ds_zm * a1 & +! * wp3_zm * wp3_on_wp2 & +! - rho_ds_zmm1 * a1m1 & +! * wp3_zmm1 * wp3_on_wp2_m1 & +! ) & +! + const_three_halves & +! * invrs_dzt * ( wp2**2 - wp2m1**2 ) + +! else + + ! Brian tried a new discretization for the turbulent advection term, + ! which contains the term: + ! - (1/rho_ds) * d [ rho_ds * a_1 * (w'^3)^2 / w'^2 ] / dz. In order + ! to help stabilize w'^3, a_1 has been pulled outside of the derivative. + ! This effects the right-hand side of the equation, as well as the + ! left-hand side. + + ! Additionally, the discretization of the turbulent advection term, which + ! contains the term: + ! - (1/rho_ds) * d [ rho_ds * (a_3 + 3) * (w'^2)^2 ] / dz, has been + ! altered to pull (a_3 + 3) outside of the derivative. This was done in + ! order to help stabilize w'^3. This effects the right-hand side of the + ! equation, as well as the left-hand side. + +! rhs & +! = + invrs_rho_ds_zt & +! * a3_zt * invrs_dzt & +! * ( rho_ds_zm * wp2**2 & +! - rho_ds_zmm1 * wp2m1**2 ) & +! + invrs_rho_ds_zt & +! * a1_zt * invrs_dzt & +! * ( rho_ds_zm & +! * ( wp3_zm * wp3_on_wp2 ) & +! - rho_ds_zmm1 & +! * ( wp3_zmm1 * wp3_on_wp2_m1 ) & +! ) & +! + const_three_halves & +! * invrs_dzt * ( wp2**2 - wp2m1**2 ) + + ! End of code that pulls out a3. + ! End of Brian's a1 change. Feb. 14, 2008. + +! endif ! l_standard_term_ta + + +! return +! end function wp3_terms_ta_tp_rhs + + !============================================================================= + pure function wp3_terms_bp1_pr2_rhs( C11_Skw_fnc, thv_ds_zt, wp2thvp ) & + result( rhs ) + + ! Description: + ! Buoyancy production of w'^3 and w'^3 pressure term 2: explicit portion of + ! the code. + ! + ! The d(w'^3)/dt equation contains a buoyancy production term: + ! + ! + 3 (g/thv_ds) w'^2th_v'; + ! + ! and pressure term 2: + ! + ! - C_11 ( -3 w'^3 dw/dz + 3 (g/thv_ds) w'^2th_v' ). + ! + ! The w'^3 buoyancy production term is completely explicit, while w'^3 + ! pressure term 2 has both implicit and explicit components. The buoyancy + ! production term and the explicit portion of pressure term 2 are combined + ! and solved together as: + ! + ! + ( 1 - C_ll ) ( 3 (g/thv_ds) w'^2th_v' ). + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & ! Constant(s) + grav ! Gravitational acceleration [m/s^2] + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C11_Skw_fnc, & ! C_11 parameter with Sk_w applied (k) [-] + thv_ds_zt, & ! Dry, base-state theta_v at thermo. lev. (k) [K] + wp2thvp ! w'^2th_v'(k) [K m^2/s^2] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( 1.0_core_rknd - C11_Skw_fnc ) * 3.0_core_rknd * ( grav / thv_ds_zt ) * wp2thvp + + return + end function wp3_terms_bp1_pr2_rhs + + !============================================================================= + pure function wp3_term_bp2_rhs( C15, Kh_zt, wpthvp, wpthvp_m1, & + dum_dz, dum_dz_m1, dvm_dz, dvm_dz_m1, & + upwp, upwp_m1, vpwp, vpwp_m1, & + thv_ds_zt, invrs_dzt ) & + result( rhs ) + + ! Description: + ! Experimental term from CLUBB TRAC ticket #411. The derivative here is of + ! the form: + ! - C_15 * Kh * ∂{ grav / thv_ds * [w'th_v'(k) - w'th_v'(k-1)] + ! -[ u'w'(k) * ∂u(k)/∂z - u'w'(k-1) * ∂u(k-1)/∂z ] + ! -[ v'w'(k) * ∂v(k)/∂z - v'w'(k-1) * ∂v(k-1)/∂z ] }/∂z. + ! + ! This does not appear in Andre et al. 1976 or Bougeault et al. 1981, but + ! is based on experiments in matching LES data. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & ! Constant(s) + grav ! Gravitational acceleration [m/s^2] + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C15, & ! Model parameter C15 [-] + Kh_zt, & ! Eddy-diffusivity on moment. levels [m^2/s] + wpthvp, & ! w'th_v'(k) [K m/s] + wpthvp_m1, & ! w'th_v'(k-1) [K m/s] + dum_dz, & ! d u wind dz (k) [m/s] + dvm_dz, & ! d v wind dz (k) [m/s] + dum_dz_m1, & ! d u wind dz (k-1) [m/s] + dvm_dz_m1, & ! d v wind dz (k-1) [m/s] + upwp, & ! u'v'(k) [m^2/s^2] + upwp_m1, & ! u'v'(k-1) [m^2/s^2] + vpwp, & ! v'w'(k) [m^2/s^2] + vpwp_m1, & ! v'w'(k-1) [m^2/s^2] + thv_ds_zt, & ! Dry, base-state theta_v at thermo. lev. (k) [K] + invrs_dzt ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + ! ---- Begin Code ---- + +! rhs = - C15 * Kh_zt * invrs_dzt * grav / thv_ds_zt * ( wpthvp - wpthvp_m1 ) + + rhs = - C15 * Kh_zt * invrs_dzt * & + ( grav / thv_ds_zt * ( wpthvp - wpthvp_m1 ) & + - ( upwp * dum_dz - upwp_m1 * dum_dz_m1 ) & + - ( vpwp * dvm_dz - vpwp_m1 * dvm_dz_m1 ) ) + + return + end function wp3_term_bp2_rhs + + + !============================================================================= + pure function wp3_term_pr1_rhs( C8, C8b, tauw3t, Skw_zt, wp3 ) & + result( rhs ) + + ! Description: + ! Pressure term 1 for w'^3: explicit portion of the code. + ! + ! Pressure term 1 is the term: + ! + ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^4 + 1 ) * w'^3; + ! + ! where Sk_wt = w'^3 / (w'^2)^(3/2). + ! + ! This term needs to be linearized, so function L(w'^3) is defined to be + ! equal to this term (pressure term 1), such that: + ! + ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^5 / (w'^2)^6 + w'^3 ). + ! + ! A Taylor Series expansion (truncated after the first derivative term) of + ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1. + ! Evaluating L(w'^3) at w'^3(t+1): + ! + ! L( w'^3(t+1) ) = L( w'^3(t) ) + ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t)) + ! * ( w'^3(t+1) - w'^3(t) ). + ! + ! After evaluating the expression above, the term has become linearized. It + ! is broken down into implicit (LHS) and explicit (RHS) components. + ! The explicit portion is: + ! + ! + (C_8/tau_w3t) * ( 4 * C_8b * Sk_wt^4 + 1 ) * w'^3(t). + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(w'^3)/dt equation. + ! + ! The values of w'^3 are found on the thermodynamic levels, as are the + ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic + ! levels and w'^2 is interpolated to thermodynamic levels). + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C8, & ! Model parameter C_8 [-] + C8b, & ! Model parameter C_8b [-] + tauw3t, & ! Time-scale tau at thermodynamic levels (k) [s] + Skw_zt, & ! Skewness of w at thermodynamic levels (k) [-] + wp3 ! w'^3(k) [m^3/s^3] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( C8 / tauw3t ) * ( 4.0_core_rknd * C8b * Skw_zt**4 ) * wp3 + + return + end function wp3_term_pr1_rhs + +!=============================================================================== + +end module crmx_advance_wp2_wp3_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 new file mode 100644 index 0000000000..160755b817 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 @@ -0,0 +1,3213 @@ +!----------------------------------------------------------------------- +! $Id: advance_xm_wpxp_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +!=============================================================================== +module crmx_advance_xm_wpxp_module + + ! Description: + ! Contains the CLUBB advance_xm_wpxp_module scheme. + + ! References: + ! None + !----------------------------------------------------------------------- + + implicit none + + private ! Default scope + + public :: advance_xm_wpxp + + private :: xm_wpxp_lhs, & + xm_wpxp_rhs, & + xm_wpxp_solve, & + xm_wpxp_clipping_and_stats, & + xm_term_ta_lhs, & + wpxp_term_ta_lhs, & + wpxp_term_tp_lhs, & + wpxp_terms_ac_pr2_lhs, & + wpxp_term_pr1_lhs, & + wpxp_terms_bp_pr3_rhs, & + xm_correction_wpxp_cl, & + damp_coefficient + + ! Parameter Constants + integer, parameter, private :: & + nsub = 2, & ! Number of subdiagonals in the LHS matrix + nsup = 2, & ! Number of superdiagonals in the LHS matrix + xm_wpxp_thlm = 1, & ! Named constant for thlm solving + xm_wpxp_rtm = 2, & ! Named constant for rtm solving + xm_wpxp_scalar = 3 ! Named constant for scalar solving + + contains + + !============================================================================= + subroutine advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & + Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & + tau_zm, Skw_zm, rtpthvp, rtm_forcing, & + wprtp_forcing, rtm_ref, thlpthvp, & + thlm_forcing, wpthlp_forcing, thlm_ref, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & + w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & + mixt_frac_zm, l_implemented, & + sclrpthvp, sclrm_forcing, sclrp2, & + rtm, wprtp, thlm, wpthlp, & + err_code, & + sclrm, wpsclrp ) + + ! Description: + ! Advance the mean and flux terms by one timestep. + + ! References: + ! Eqn. 16 & 17 on p. 3546 of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + + ! See Also + ! ``Equations for CLUBB'' Section 5: + ! /Implicit solutions for the means and fluxes/ + !----------------------------------------------------------------------- + + use crmx_parameters_tunable, only: & + C6rt, & ! Variable(s) + C6rtb, & + C6rtc, & + C6thl, & + C6thlb, & + C6thlc, & + C7, & + C7b, & + C7c, & + c_K6, & + C6rt_Lscale0, & + C6thl_Lscale0, & + C7_Lscale0, & + wpxp_L_thresh + + use crmx_constants_clubb, only: & + fstderr, & ! Constant + rt_tol, & + thl_tol, & + thl_tol_mfl, & + rt_tol_mfl, & + max_mag_correlation, & + one, & + one_half, & + zero, & + zero_threshold + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + sclr_tol + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_grid_class, only: & + zm2zt, & ! Procedure(s) + zt2zm + + use crmx_model_flags, only: & + l_clip_semi_implicit ! Variable(s) + + use crmx_mono_flux_limiter, only: & + calc_turb_adv_range ! Procedure(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_error_code, only: & + clubb_at_least_debug_level, & ! Procedure(s) + reportError, & + fatal_error + + use crmx_error_code, only: & + clubb_var_out_of_range ! Constant(s) + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_end_update, & + stat_update_var + + use crmx_stats_variables, only: & + zt, & + zm, & + irtm_matrix_condt_num, & ! Variables + ithlm_matrix_condt_num, & + irtm_sdmp, ithlm_sdmp, & + l_stats_samp, & + iC7_Skw_fnc, & + iC6rt_Skw_fnc, & + iC6thl_Skw_fnc, & + l_stats_samp + + use crmx_sponge_layer_damping, only: & + rtm_sponge_damp_settings, & + thlm_sponge_damp_settings, & + rtm_sponge_damp_profile, & + thlm_sponge_damp_profile, & + sponge_damp_xm ! Procedure(s) + + implicit none + + ! External + intrinsic :: exp, sqrt + + ! Parameter Constants + logical, parameter :: & + l_iter = .true. ! True when the means and fluxes are prognosed + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + sigma_sqd_w, & ! sigma_sqd_w on momentum levels [-] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + Lscale, & ! Turbulent mixing length [m] + wp3_on_wp2, & ! Smoothed wp3 / wp2 on momentum levels [m/s] + wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] + Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] + tau_zm, & ! Time-scale tau on momentum levels [s] + Skw_zm, & ! Skewness of w on momentum levels [-] + rtpthvp, & ! r_t'th_v' (momentum levels) [(kg/kg) K] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + wprtp_forcing, & ! forcing (momentum levels) [(kg/kg)/s^2] + rtm_ref, & ! rtm for nudging [kg/kg] + thlpthvp, & ! th_l'th_v' (momentum levels) [K^2] + thlm_forcing, & ! th_l forcing (thermodynamic levels) [K/s] + wpthlp_forcing, & ! forcing (momentum levels) [K/s^2] + thlm_ref, & ! thlm for nudging [K] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on moment. levs. [K] + ! Added for clipping by Vince Larson 29 Sep 2007 + rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] + thlp2, & ! th_l'^2 (momentum levels) [K^2] + ! End of Vince Larson's addition. + w1_zm, & ! Mean w (1st PDF component) [m/s] + w2_zm, & ! Mean w (2nd PDF component) [m/s] + varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] + mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + + ! Additional variables for passive scalars + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & + sclrpthvp, sclrm_forcing, & ! [Units vary] + sclrp2 ! For clipping Vince Larson [Units vary] + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + rtm, & ! r_t (total water mixing ratio) [kg/kg] + wprtp, & ! w'r_t' [(kg/kg) m/s] + thlm, & ! th_l (liquid water potential temperature) [K] + wpthlp ! w'th_l' [K m/s] + + integer, intent(inout) :: err_code ! Error code for the model's status + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & + sclrm, wpsclrp ! [Units vary] + + ! Local variables + real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & + lhs ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK) + + real( kind = core_rknd ), dimension(gr%nz) :: & + C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc + + ! Eddy Diffusion for wpthlp and wprtp. + real( kind = core_rknd ), dimension(gr%nz) :: Kw6 ! wpxp eddy diff. [m^2/s] + + real( kind = core_rknd ), dimension(gr%nz) :: & + a1, & ! a_1 (momentum levels); See eqn. 24 in `Equations for CLUBB' [-] + a1_zt ! a_1 interpolated to thermodynamic levels [-] + + ! Variables used as part of the monotonic turbulent advection scheme. + ! Find the lowermost and uppermost grid levels that can have an effect + ! on the central thermodynamic level during the course of a time step, + ! due to the effects of turbulent advection only. + integer, dimension(gr%nz) :: & + low_lev_effect, & ! Index of the lowest level that has an effect. + high_lev_effect ! Index of the highest level that has an effect. + + ! Variables used for clipping of w'x' due to correlation + ! of w with x, such that: + ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]; + ! -1 <= corr_(w,x) <= 1. + real( kind = core_rknd ), dimension(gr%nz) :: & + wpxp_upper_lim, & ! Keeps correlations from becoming greater than 1. + wpxp_lower_lim ! Keeps correlations from becoming less than -1. + + real( kind = core_rknd ), dimension(gr%nz) :: dummy_1d ! Unreferenced array + + real( kind = core_rknd ), allocatable, dimension(:,:) :: & + rhs, &! Right-hand sides of band diag. matrix. (LAPACK) + solution ! solution vectors of band diag. matrix. (LAPACK) + + ! Constant parameters as a function of Skw. + + integer :: & + nrhs, & ! Number of RHS vectors + err_code_xm_wpxp ! Error code + + real( kind = core_rknd ) :: rcond + + ! Indices + integer :: i + + !--------------------------------------------------------------------------- + + ! ----- Begin Code ----- + if ( l_clip_semi_implicit ) then + nrhs = 1 + else + nrhs = 2+sclr_dim + endif + + ! Allocate rhs and solution vector + allocate( rhs(2*gr%nz,nrhs) ) + allocate( solution(2*gr%nz,nrhs) ) + + ! This is initialized solely for the purpose of avoiding a compiler + ! warning about uninitialized variables. + dummy_1d = zero + + ! Compute C6 and C7 as a function of Skw + ! The if...then is just here to save compute time + if ( C6rt /= C6rtb ) then + C6rt_Skw_fnc(1:gr%nz) = C6rtb + (C6rt-C6rtb) & + *EXP( -one_half * (Skw_zm(1:gr%nz)/C6rtc)**2 ) + else + C6rt_Skw_fnc(1:gr%nz) = C6rtb + endif + + if ( C6thl /= C6thlb ) then + C6thl_Skw_fnc(1:gr%nz) = C6thlb + (C6thl-C6thlb) & + *EXP( -one_half * (Skw_zm(1:gr%nz)/C6thlc)**2 ) + else + C6thl_Skw_fnc(1:gr%nz) = C6thlb + endif + + if ( C7 /= C7b ) then + C7_Skw_fnc(1:gr%nz) = C7b + (C7-C7b) & + *EXP( -one_half * (Skw_zm(1:gr%nz)/C7c)**2 ) + else + C7_Skw_fnc(1:gr%nz) = C7b + endif + + ! Damp C6 and C7 as a function of Lscale in stably stratified regions + C7_Skw_fnc = damp_coefficient( C7, C7_Skw_fnc, & + C7_Lscale0, wpxp_L_thresh, Lscale ) + C6rt_Skw_fnc = damp_coefficient( C6rt, C6rt_Skw_fnc, & + C6rt_Lscale0, wpxp_L_thresh, Lscale ) + C6thl_Skw_fnc = damp_coefficient( C6thl, C6thl_Skw_fnc, & + C6thl_Lscale0, wpxp_L_thresh, Lscale ) + + ! C6rt_Skw_fnc = C6rt + ! C6thl_Skw_fnc = C6thl + ! C7_Skw_fnc = C7 + + if ( l_stats_samp ) then + + call stat_update_var( iC7_Skw_fnc, C7_Skw_fnc, zm ) + call stat_update_var( iC6rt_Skw_fnc, C6rt_Skw_fnc, zm ) + call stat_update_var( iC6thl_Skw_fnc, C6thl_Skw_fnc, zm ) + + end if + + if ( clubb_at_least_debug_level( 2 ) ) then + ! Assertion check for C7_Skw_fnc + if ( any( C7_Skw_fnc(:) > one ) .or. any( C7_Skw_fnc(:) < zero ) ) then + write(fstderr,*) "The C7_Skw_fnc variable is outside the valid range" + err_code = clubb_var_out_of_range + return + end if + end if + + ! Define the Coefficent of Eddy Diffusivity for the wpthlp and wprtp. + ! Kw6 is used for wpthlp and wprtp, which are located on momentum levels. + ! Kw6 is located on thermodynamic levels. + ! Kw6 = c_K6 * Kh_zt + + Kw6(1:gr%nz) = c_K6 * Kh_zt(1:gr%nz) + + ! Find the number of grid levels, both upwards and downwards, that can + ! have an effect on the central thermodynamic level during the course of + ! one time step due to turbulent advection. This is used as part of the + ! monotonic turbulent advection scheme. + call calc_turb_adv_range( dt, w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! In + mixt_frac_zm, & ! In + low_lev_effect, high_lev_effect ) ! Out + + + ! Define a_1 (located on momentum levels). + ! It is a variable that is a function of sigma_sqd_w (where sigma_sqd_w is + ! located on momentum levels). + a1(1:gr%nz) = one / ( one - sigma_sqd_w(1:gr%nz) ) + + ! Interpolate a_1 from momentum levels to thermodynamic levels. This will + ! be used for the w'x' turbulent advection (ta) term. + a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity + + ! Setup and decompose matrix for each variable. + + if ( l_clip_semi_implicit ) then + + ! Compute the upper and lower limits of w'r_t' at every level, + ! based on the correlation of w and r_t, such that: + ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ]; + ! -1 <= corr_(w,r_t) <= 1. + if ( l_clip_semi_implicit ) then + wpxp_upper_lim = max_mag_correlation * sqrt( wp2 * rtp2 ) + wpxp_lower_lim = -wpxp_upper_lim + endif + + ! Compute the implicit portion of the r_t and w'r_t' equations. + ! Build the left-hand side matrix. + call xm_wpxp_lhs( l_iter, dt, wprtp, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) + wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) + Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) + C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) + lhs ) ! Intent(out) + + ! Compute the explicit portion of the r_t and w'r_t' equations. + ! Build the right-hand side vector. + call xm_wpxp_rhs( xm_wpxp_rtm, l_iter, dt, rtm, wprtp, & ! Intent(in) + rtm_forcing, wprtp_forcing, C7_Skw_fnc, & ! Intent(in) + rtpthvp, C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,1) ) ! Intent(out) + + ! Solve r_t / w'r_t' + if ( l_stats_samp .and. irtm_matrix_condt_num > 0 ) then + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp, rcond ) ! Intent(out) + else + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp ) ! Intent(out) + endif + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "Mean total water & total water flux LU decomp. failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_rtm, dt, wp2, rtp2, wm_zt, & ! Intent(in) + rtm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + rt_tol**2, rt_tol, rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,1), & ! Intent(in) + rtm, rt_tol_mfl, wprtp, & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "rtm monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + + ! Compute the upper and lower limits of w'th_l' at every level, + ! based on the correlation of w and th_l, such that: + ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ]; + ! -1 <= corr_(w,th_l) <= 1. + if ( l_clip_semi_implicit ) then + wpxp_upper_lim = max_mag_correlation * sqrt( wp2 * thlp2 ) + wpxp_lower_lim = -wpxp_upper_lim + endif + + ! Compute the implicit portion of the th_l and w'th_l' equations. + ! Build the left-hand side matrix. + call xm_wpxp_lhs( l_iter, dt, wpthlp, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) + wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) + Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) + C6thl_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) + lhs ) ! Intent(out) + + ! Compute the explicit portion of the th_l and w'th_l' equations. + ! Build the right-hand side vector. + call xm_wpxp_rhs( xm_wpxp_thlm, l_iter, dt, thlm, wpthlp, & ! Intent(in) + thlm_forcing, wpthlp_forcing, C7_Skw_fnc, & ! Intent(in) + thlpthvp, C6thl_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,1) ) ! Intent(out) + + ! Solve for th_l / w'th_l' + if ( l_stats_samp .and. ithlm_matrix_condt_num > 0 ) then + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp, rcond ) ! Intent(out) + else + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp ) ! Intent(out) + endif + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "Liquid pot. temp & thetal flux LU decomp. failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_thlm, dt, wp2, thlp2, wm_zt, & ! Intent(in) + thlm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + thl_tol**2, thl_tol, rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,1), & ! Intent(in) + thlm, thl_tol_mfl, wpthlp, & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "thlm monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + ! Solve sclrm / wpsclrp + ! If sclr_dim is 0, then this loop will execute 0 times. +! ---> h1g, 2010-06-15 +! scalar transport, e.g, droplet and ice number concentration +! are handled in " advance_sclrm_Nd_module.F90 " +#ifdef GFDL + do i = 1, 0, 1 +#else + do i = 1, sclr_dim, 1 +#endif +! <--- h1g, 2010-06-15 + + ! Compute the upper and lower limits of w'sclr' at every level, + ! based on the correlation of w and sclr, such that: + ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ]; + ! -1 <= corr_(w,sclr) <= 1. + if ( l_clip_semi_implicit ) then + wpxp_upper_lim(:) = max_mag_correlation * sqrt( wp2(:) * sclrp2(:,i) ) + wpxp_lower_lim(:) = -wpxp_upper_lim(:) + endif + + ! Compute the implicit portion of the sclr and w'sclr' equations. + ! Build the left-hand side matrix. + call xm_wpxp_lhs( l_iter, dt, wpsclrp(:,i), a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) + wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) + Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) + C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) + lhs ) ! Intent(out) + + ! Compute the explicit portion of the sclrm and w'sclr' equations. + ! Build the right-hand side vector. + call xm_wpxp_rhs( xm_wpxp_scalar, l_iter, dt, sclrm(:,i), wpsclrp(:,i), & ! Intent(in) + sclrm_forcing(:,i), dummy_1d, C7_Skw_fnc, & ! Intent(in) + sclrpthvp(:,i), C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,1) ) ! Intent(out) + + ! Solve for sclrm / w'sclr' + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Passive scalar # ", i, " LU decomp. failed." + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_scalar, dt, wp2, sclrp2(:,i), & ! Intent(in) + wm_zt, sclrm_forcing(:,i), & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + sclr_tol(i)**2, sclr_tol(i), rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,1), & ! Intent(in) + sclrm(:,i), sclr_tol(i), wpsclrp(:,i), & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "sclrm # ", i, "monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + enddo ! passive scalars + + else ! Simple case, where l_clip_semi_implicit is false + + ! Create the lhs once + call xm_wpxp_lhs( l_iter, dt, dummy_1d, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) + wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) + Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) + C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + dummy_1d, dummy_1d, l_implemented, & ! Intent(in) + lhs ) ! Intent(out) + + ! Compute the explicit portion of the r_t and w'r_t' equations. + ! Build the right-hand side vector. + call xm_wpxp_rhs( xm_wpxp_rtm, l_iter, dt, rtm, wprtp, & ! Intent(in) + rtm_forcing, wprtp_forcing, C7_Skw_fnc, & ! Intent(in) + rtpthvp, C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,1) ) ! Intent(out) + + ! Compute the explicit portion of the th_l and w'th_l' equations. + ! Build the right-hand side vector. + call xm_wpxp_rhs( xm_wpxp_thlm, l_iter, dt, thlm, wpthlp, & ! Intent(in) + thlm_forcing, wpthlp_forcing, C7_Skw_fnc, & ! Intent(in) + thlpthvp, C6thl_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,2) ) ! Intent(out) + +! ---> h1g, 2010-06-15 +! scalar transport, e.g, droplet and ice number concentration +! are handled in " advance_sclrm_Nd_module.F90 " +#ifdef GFDL + do i = 1, 0, 1 +#else + do i = 1, sclr_dim, 1 +#endif +! <--- h1g, 2010-06-15 + + call xm_wpxp_rhs( xm_wpxp_scalar, l_iter, dt, sclrm(:,i), wpsclrp(:,i), & ! Intent(in) + sclrm_forcing(:,i), dummy_1d, C7_Skw_fnc, & ! Intent(in) + sclrpthvp(:,i), C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) + wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) + rhs(:,2+i) ) ! Intent(out) + + enddo + + ! Solve for all fields + if ( l_stats_samp .and. ithlm_matrix_condt_num + irtm_matrix_condt_num > 0 ) then + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp, rcond ) ! Intent(out) + else + call xm_wpxp_solve( nrhs, & ! Intent(in) + lhs, rhs, & ! Intent(inout) + solution, err_code_xm_wpxp ) ! Intent(out) + endif + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "xm_wpxp matrix LU decomp. failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_rtm, dt, wp2, rtp2, wm_zt, & ! Intent(in) + rtm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + rt_tol**2, rt_tol, rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,1), & ! Intent(in) + rtm, rt_tol_mfl, wprtp, & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "rtm monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_thlm, dt, wp2, thlp2, wm_zt, & ! Intent(in) + thlm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + thl_tol**2, thl_tol, rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,2), & ! Intent(in) + thlm, thl_tol_mfl, wpthlp, & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,'(a)') "thlm monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + +! ---> h1g, 2010-06-15 +! scalar transport, e.g, droplet and ice number concentration +! are handled in " advance_sclrm_Nd_module.F90 " +#ifdef GFDL + do i = 1, 0, 1 +#else + do i = 1, sclr_dim, 1 +#endif +! <--- h1g, 2010-06-15 + + call xm_wpxp_clipping_and_stats & + ( xm_wpxp_scalar, dt, wp2, sclrp2(:,i), & ! Intent(in) + wm_zt, sclrm_forcing(:,i), & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + sclr_tol(i)**2, sclr_tol(i), rcond, & ! Intent(in) + low_lev_effect, high_lev_effect, & ! Intent(in) + l_implemented, solution(:,2+i), & ! Intent(in) + sclrm(:,i), sclr_tol(i), wpsclrp(:,i), & ! Intent(inout) + err_code_xm_wpxp ) ! Intent(out) + + if ( fatal_error( err_code_xm_wpxp ) ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "sclrm # ", i, "monotonic flux limiter: tridag failed" + call reportError( err_code_xm_wpxp ) + end if + + ! Overwrite the current error status with the new fatal error + err_code = err_code_xm_wpxp + + end if + + end do ! 1..sclr_dim + + end if ! l_clip_semi_implicit + + ! De-allocate memory + deallocate( rhs, solution ) + + ! Error Report + ! Joshua Fasching Feb 2008 + if ( fatal_error( err_code ) .and. clubb_at_least_debug_level( 1 ) ) then + + write(fstderr,*) "Error in advance_xm_wpxp" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "dt = ", dt + write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w + write(fstderr,*) "wm_zm = ", wm_zm + write(fstderr,*) "wm_zt = ", wm_zt + write(fstderr,*) "wp2 = ", wp2 + write(fstderr,*) "wp3_on_wp2 = ", wp3_on_wp2 + write(fstderr,*) "wp3_on_wp2_zt = ", wp3_on_wp2_zt + write(fstderr,*) "Kh_zt = ", Kh_zt + write(fstderr,*) "tau_zm = ", tau_zm + write(fstderr,*) "Skw_zm = ", Skw_zm + write(fstderr,*) "rtpthvp = ", rtpthvp + write(fstderr,*) "rtm_forcing = ", rtm_forcing + write(fstderr,*) "wprtp_forcing = ", wprtp_forcing + write(fstderr,*) "rtm_ref = ", rtm_ref + write(fstderr,*) "thlpthvp = ", thlpthvp + write(fstderr,*) "thlm_forcing = ", thlm_forcing + write(fstderr,*) "wpthlp_forcing = ", wpthlp_forcing + write(fstderr,*) "thlm_ref = ", thlm_ref + write(fstderr,*) "rho_ds_zm = ", rho_ds_zm + write(fstderr,*) "rho_ds_zt = ", rho_ds_zt + write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm + write(fstderr,*) "invrs_rho_ds_zt = ", invrs_rho_ds_zt + write(fstderr,*) "thv_ds_zm = ", thv_ds_zm + write(fstderr,*) "rtp2 = ", rtp2 + write(fstderr,*) "thlp2 = ", thlp2 + write(fstderr,*) "w1_zm = ", w1_zm + write(fstderr,*) "w2_zm = ", w2_zm + write(fstderr,*) "varnce_w1_zm = ", varnce_w1_zm + write(fstderr,*) "varnce_w2_zm = ", varnce_w2_zm + write(fstderr,*) "mixt_frac_zm = ", mixt_frac_zm + write(fstderr,*) "l_implemented = ", l_implemented + + if ( sclr_dim > 0 ) then + write(fstderr,*) "sclrp2 = ", sclrp2 + write(fstderr,*) "sclrpthvp = ", sclrpthvp + write(fstderr,*) "sclrm_forcing = ", sclrm_forcing + end if + + write(fstderr,*) "Intent(inout)" + + write(fstderr,*) "rtm = ", rtm + write(fstderr,*) "wprtp = ", wprtp + write(fstderr,*) "thlm = ", thlm + write(fstderr,*) "wpthlp =", wpthlp + + if ( sclr_dim > 0 ) then + write(fstderr,*) "sclrm = ", sclrm + write(fstderr,*) "wpsclrp = ", wpsclrp + end if + + end if ! Fatal error and debug_level >= 1 + + if ( rtm_sponge_damp_settings%l_sponge_damping ) then + if( l_stats_samp ) then + call stat_begin_update( irtm_sdmp, rtm / real( dt, kind = core_rknd ), zt ) + end if + rtm(1:gr%nz) = sponge_damp_xm( dt, rtm_ref(1:gr%nz), rtm(1:gr%nz), & + rtm_sponge_damp_profile ) + + if( l_stats_samp ) then + call stat_end_update( irtm_sdmp, rtm / real( dt, kind = core_rknd ), zt ) + end if + endif + + if ( thlm_sponge_damp_settings%l_sponge_damping ) then + if( l_stats_samp ) then + call stat_begin_update( ithlm_sdmp, thlm / real( dt, kind = core_rknd ), zt ) + end if + thlm(1:gr%nz) = sponge_damp_xm( dt, thlm_ref(1:gr%nz), thlm(1:gr%nz), & + thlm_sponge_damp_profile ) + if( l_stats_samp ) then + call stat_end_update( ithlm_sdmp, thlm / real( dt, kind = core_rknd ), zt ) + end if + endif + + return + + end subroutine advance_xm_wpxp + + !============================================================================= + subroutine xm_wpxp_lhs( l_iter, dt, wpxp, a1, a1_zt, wm_zm, wm_zt, & + wp2, wp3_on_wp2, wp3_on_wp2_zt, & + Kw6, tau_zm, C7_Skw_fnc, & + C6x_Skw_fnc, rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, & + wpxp_upper_lim, wpxp_lower_lim, l_implemented, & + lhs ) + + ! Description: + ! Compute LHS band diagonal matrix for xm and w'x'. + ! This subroutine computes the implicit portion of + ! the xm and w'x' equations. + + ! References: + ! None + !------------------------------------------------------------------------ + + use crmx_parameters_tunable, only: & + nu6_vert_res_dep ! Variable(s) + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt ! Procedure(s) + + use crmx_constants_clubb, only: & + gamma_over_implicit_ts, & ! Constant(s) + one, & + zero + + use crmx_model_flags, only: & + l_clip_semi_implicit, & ! Variable(s) + l_upwind_wpxp_ta + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_diffusion, only: & + diffusion_zm_lhs ! Procedure(s) + + use crmx_mean_adv, only: & + term_ma_zt_lhs, & ! Procedure(s) + term_ma_zm_lhs + + use crmx_clip_semi_implicit, only: & + clip_semi_imp_lhs ! Procedure(s) + + use crmx_stats_variables, only: & + ztscr01, & ! Variable(s) + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15 + + use crmx_stats_variables, only: & + l_stats_samp, & + ithlm_ma, & + ithlm_ta, & + irtm_ma, & + irtm_ta, & + iwpthlp_ma, & + iwpthlp_ta, & + iwpthlp_tp, & + iwpthlp_ac, & + iwpthlp_pr1, & + iwpthlp_pr2, & + iwpthlp_dp1, & + iwpthlp_sicl, & + iwprtp_ma, & + iwprtp_ta, & + iwprtp_tp, & + iwprtp_ac, & + iwprtp_pr1, & + iwprtp_pr2, & + iwprtp_dp1, & + iwprtp_sicl + + use crmx_advance_helper_module, only: set_boundary_conditions_lhs ! Procedure(s) + + + implicit none + + ! External + intrinsic :: min, max + + ! Constant parameters + ! Left-hand side matrix diagonal identifiers for + ! momentum-level variable, w'x'. + integer, parameter :: & + m_kp1_mdiag = 1, & ! Momentum superdiagonal index for w'x'. + m_kp1_tdiag = 2, & ! Thermodynamic superdiagonal index for w'x'. + m_k_mdiag = 3, & ! Momentum main diagonal index for w'x'. + m_k_tdiag = 4, & ! Thermodynamic subdiagonal index for w'x'. + m_km1_mdiag = 5 ! Momentum subdiagonal index for w'x'. + + ! Left-hand side matrix diagonal identifiers for + ! thermodynamic-level variable, xm. + integer, parameter :: & + t_kp1_tdiag = 1, & ! Thermodynamic superdiagonal index for xm. + t_k_mdiag = 2, & ! Momentum superdiagonal index for xm. + t_k_tdiag = 3, & ! Thermodynamic main diagonal index for xm. + t_km1_mdiag = 4, & ! Momentum subdiagonal index for xm. + t_km1_tdiag = 5 ! Thermodynamic subdiagonal index for xm. + + ! Input variables + logical, intent(in) :: l_iter + + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + wpxp, & ! w'x' (momentum levels) at timestep (t) [{xm units} m/s] + a1, & ! a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + wm_zm, & ! w wind component on momentum levels [m/s] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3_on_wp2, & ! Smoothed wp3 / wp2 on momentum levels [m/s] + wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] + Kw6, & ! Coefficient of eddy diffusivity for w'x' [m^2/s] + tau_zm, & ! Time-scale tau on momentum levels [s] + C7_Skw_fnc, & ! C_7 parameter with Sk_w applied [-] + C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + wpxp_upper_lim, & ! Keeps correlations from becoming > 1. [units vary] + wpxp_lower_lim ! Keeps correlations from becoming < -1. [units vary] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + ! Output Variable + real( kind = core_rknd ), intent(out), dimension(nsup+nsub+1,2*gr%nz) :: & + lhs ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK) + + ! Local Variables + + ! Indices + integer :: k, kp1, km1 + integer :: k_xm, k_wpxp + integer :: k_wpxp_low, k_wpxp_high + + real( kind = core_rknd ), dimension(3) :: tmp + + logical :: l_upper_thresh, l_lower_thresh ! flags for clip_semi_imp_lhs + + + ! Initialize the left-hand side matrix to 0. + lhs = zero + + ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at + ! level k = 1, which is below the model surface, is simply set equal to the + ! value of xm at level k = 2 after the solve has been completed. + + do k = 2, gr%nz, 1 + + ! Define indices + + km1 = max( k-1, 1 ) + + k_xm = 2*k - 1 + ! k_wpxp is 2*k + + + !!!!!***** xm *****!!!!! + + ! xm: Left-hand side (implicit xm portion of the code). + ! + ! Thermodynamic subdiagonal (lhs index: t_km1_tdiag) + ! [ x xm(k-1,) ] + ! Momentum subdiagonal (lhs index: t_km1_mdiag) + ! [ x wpxp(k-1,) ] + ! Thermodynamic main diagonal (lhs index: t_k_tdiag) + ! [ x xm(k,) ] + ! Momentum superdiagonal (lhs index: t_k_mdiag) + ! [ x wpxp(k,) ] + ! Thermodynamic superdiagonal (lhs index: t_kp1_tdiag) + ! [ x xm(k+1,) ] + + ! LHS mean advection (ma) term. + if ( .not. l_implemented ) then + + lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & + = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + + else + + lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & + = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) + zero + + endif + + ! LHS turbulent advection (ta) term. + lhs((/t_k_mdiag,t_km1_mdiag/),k_xm) & + = lhs((/t_k_mdiag,t_km1_mdiag/),k_xm) & + + xm_term_ta_lhs( rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), gr%invrs_dzt(k) ) + + ! LHS time tendency. + lhs(t_k_tdiag,k_xm) & + = lhs(t_k_tdiag,k_xm) + one / real( dt, kind = core_rknd ) + + if (l_stats_samp) then + + ! Statistics: implicit contributions for rtm or thlm. + + if ( irtm_ma > 0 .or. ithlm_ma > 0 ) then + if ( .not. l_implemented ) then + tmp(1:3) = & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + ztscr01(k) = - tmp(3) + ztscr02(k) = - tmp(2) + ztscr03(k) = - tmp(1) + else + ztscr01(k) = zero + ztscr02(k) = zero + ztscr03(k) = zero + endif + endif + + if ( irtm_ta > 0 .or. ithlm_ta > 0 ) then + tmp(1:2) = & + + xm_term_ta_lhs( rho_ds_zm(k), rho_ds_zm(km1), & + invrs_rho_ds_zt(k), gr%invrs_dzt(k) ) + ztscr04(k) = - tmp(2) + ztscr05(k) = - tmp(1) + endif + + endif + + enddo ! xm loop: 2..gr%nz + + + ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp + ! is set to specified values at both the lowest level, k = 1, and the + ! highest level, k = gr%nz. + + do k = 2, gr%nz-1, 1 + + ! Define indices + + kp1 = min( k+1, gr%nz ) + km1 = max( k-1, 1 ) + + ! k_xm is 2*k - 1 + k_wpxp = 2*k + + + !!!!!***** w'x' *****!!!!! + + ! w'x': Left-hand side (implicit w'x' portion of the code). + ! + ! Momentum subdiagonal (lhs index: m_km1_mdiag) + ! [ x wpxp(k-1,) ] + ! Thermodynamic subdiagonal (lhs index: m_k_tdiag) + ! [ x xm(k,) ] + ! Momentum main diagonal (lhs index: m_k_mdiag) + ! [ x wpxp(k,) ] + ! Thermodynamic superdiagonal (lhs index: m_kp1_tdiag) + ! [ x xm(k+1,) ] + ! Momentum superdiagonal (lhs index: m_kp1_mdiag) + ! [ x wpxp(k+1,) ] + + ! LHS mean advection (ma) term. + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + + ! LHS turbulent advection (ta) term. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! The weight of the implicit portion of this term is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (w'x' in this case), y(t) is the linearized portion of + ! the term that gets treated implicitly, and RHS is the portion of + ! the term that is always treated explicitly (in the case of the + ! w'x' turbulent advection term, RHS = 0). A weight of greater + ! than 1 can be applied to make the term more numerically stable. + if ( .not. l_upwind_wpxp_ta ) then + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + + gamma_over_implicit_ts & + * wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), & + gr%invrs_dzm(k), k ) + else + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + + gamma_over_implicit_ts & + * wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) + end if + + ! LHS turbulent production (tp) term. + lhs((/m_kp1_tdiag,m_k_tdiag/),k_wpxp) & + = lhs((/m_kp1_tdiag,m_k_tdiag/),k_wpxp) & + + wpxp_term_tp_lhs( wp2(k), gr%invrs_dzm(k) ) + + ! LHS accumulation (ac) term and pressure term 2 (pr2). + lhs(m_k_mdiag,k_wpxp) & + = lhs(m_k_mdiag,k_wpxp) & + + wpxp_terms_ac_pr2_lhs( C7_Skw_fnc(k), & + wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + + ! LHS pressure term 1 (pr1). + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs(m_k_mdiag,k_wpxp) & + = lhs(m_k_mdiag,k_wpxp) & + + gamma_over_implicit_ts & + * wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) + + ! LHS eddy diffusion term: dissipation term 1 (dp1). + lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & + + diffusion_zm_lhs( Kw6(k), Kw6(kp1), nu6_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + + ! LHS time tendency. + if ( l_iter ) then + lhs(m_k_mdiag,k_wpxp) & + = lhs(m_k_mdiag,k_wpxp) + one / real(dt, kind = core_rknd) + endif + + ! LHS portion of semi-implicit clipping term. + if ( l_clip_semi_implicit ) then + l_upper_thresh = .true. + l_lower_thresh = .true. + + lhs(m_k_mdiag,k_wpxp) & + = lhs(m_k_mdiag,k_wpxp) & + + clip_semi_imp_lhs( dt, wpxp(k), & + l_upper_thresh, wpxp_upper_lim(k), & + l_lower_thresh, wpxp_lower_lim(k) ) + + endif + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for wprtp or wpthlp. + + if ( iwprtp_ma > 0 .or. iwpthlp_ma > 0 ) then + tmp(1:3) = & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + zmscr01(k) = - tmp(3) + zmscr02(k) = - tmp(2) + zmscr03(k) = - tmp(1) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) term). + if ( iwprtp_ta > 0 .or. iwpthlp_ta > 0 ) then + if ( .not. l_upwind_wpxp_ta ) then + tmp(1:3) & + = gamma_over_implicit_ts & + * wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), & + gr%invrs_dzm(k), k ) + else + tmp(1:3) & + = gamma_over_implicit_ts & + * wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) + end if + + zmscr04(k) = - tmp(3) + zmscr05(k) = - tmp(2) + zmscr06(k) = - tmp(1) + endif + + if ( iwprtp_tp > 0 .or. iwpthlp_tp > 0 ) then + tmp(1:2) = & + + wpxp_term_tp_lhs( wp2(k), gr%invrs_dzm(k) ) + zmscr07(k) = - tmp(2) + zmscr08(k) = - tmp(1) + endif + + ! Note: To find the contribution of w'x' term ac, substitute 0 for the + ! C_7 skewness function input to function wpxp_terms_ac_pr2_lhs. + if ( iwprtp_ac > 0 .or. iwpthlp_ac > 0 ) then + zmscr09(k) = & + - wpxp_terms_ac_pr2_lhs( zero, & + wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) term). + if ( iwprtp_pr1 > 0 .or. iwpthlp_pr1 > 0 ) then + zmscr10(k) & + = - gamma_over_implicit_ts & + * wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) + endif + + ! Note: To find the contribution of w'x' term pr2, add 1 to the + ! C_7 skewness function input to function wpxp_terms_ac_pr2_lhs. + if ( iwprtp_pr2 > 0 .or. iwpthlp_pr2 > 0 ) then + zmscr11(k) = & + - wpxp_terms_ac_pr2_lhs( (one+C7_Skw_fnc(k)), & + wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) + endif + + if ( iwprtp_dp1 > 0 .or. iwpthlp_dp1 > 0 ) then + tmp(1:3) = & + + diffusion_zm_lhs( Kw6(k), Kw6(kp1), nu6_vert_res_dep, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + zmscr12(k) = - tmp(3) + zmscr13(k) = - tmp(2) + zmscr14(k) = - tmp(1) + endif + + if ( l_clip_semi_implicit ) then + if ( iwprtp_sicl > 0 .or. iwpthlp_sicl > 0 ) then + l_upper_thresh = .true. + l_lower_thresh = .true. + zmscr15(k) = & + - clip_semi_imp_lhs( dt, wpxp(k), & + l_upper_thresh, wpxp_upper_lim(k), & + l_lower_thresh, wpxp_lower_lim(k) ) + endif + endif + + endif + + enddo ! wpxp loop: 2..gr%nz-1 + + + ! Boundary conditions + + ! The turbulent flux (wpxp) use fixed-point boundary conditions at both the + ! upper and lower boundaries. Therefore, anything set in the wpxp loop + ! at both the upper and lower boundaries would be overwritten here. + ! However, the wpxp loop does not extend to the boundary levels. An array + ! with a value of 1 at the main diagonal on the left-hand side and with + ! values of 0 at all other diagonals on the left-hand side will preserve the + ! right-hand side value at that level. The value of xm at level k = 1, + ! which is below the model surface, is preserved and then overwritten to + ! match the new value of xm at level k = 2. + ! + ! xm(1) wpxp(1) ... wpxp(nzmax) + ! [ 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 ] + ! [ 1.0 1.0 ... 1.0 ] + ! [ 0.0 0.0 0.0 ] + ! [ 0.0 0.0 0.0 ] + + ! Lower boundary + k = 1 + k_xm = 2*k - 1 + k_wpxp_low = 2*k + + ! Upper boundary + k = gr%nz + !k_xm is 2*k - 1 + k_wpxp_high = 2*k + + call set_boundary_conditions_lhs( m_k_mdiag, k_wpxp_low, k_wpxp_high, lhs, & + t_k_tdiag, k_xm) + + return + + end subroutine xm_wpxp_lhs + + !============================================================================= + subroutine xm_wpxp_rhs( solve_type, l_iter, dt, xm, wpxp, & + xm_forcing, wpxp_forcing, C7_Skw_fnc, & + xpthvp, C6x_Skw_fnc, tau_zm, a1, a1_zt, & + wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & + rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & + wpxp_upper_lim, wpxp_lower_lim, & + rhs ) + + ! Description: + ! Compute RHS vector for xm and w'x'. + ! This subroutine computes the explicit portion of + ! the xm and w'x' equations. + + ! References: + !------------------------------------------------------------------------ + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + gamma_over_implicit_ts, & ! Constant(s) + one, & + zero + + use crmx_model_flags, only: & + l_clip_semi_implicit, & ! Variable(s) + l_upwind_wpxp_ta + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_clip_semi_implicit, only: & + clip_semi_imp_rhs ! Procedure(s) + + use crmx_stats_type, only: & + stat_update_var_pt, & + stat_begin_update_pt + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + zm, & + irtm_forcing, & + ithlm_forcing, & + iwprtp_bp, & + iwprtp_pr3, & + iwprtp_sicl, & + iwprtp_ta, & + iwprtp_pr1, & + iwprtp_forcing, & + iwpthlp_bp, & + iwpthlp_pr3, & + iwpthlp_sicl, & + iwpthlp_ta, & + iwpthlp_pr1, & + iwpthlp_forcing, & + l_stats_samp + + use crmx_advance_helper_module, only: set_boundary_conditions_rhs + + implicit none + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variables being solved for. + + logical, intent(in) :: l_iter + + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm, & ! xm (thermodynamic levels) [{xm units}] + wpxp, & ! (momentum levels) [{xm units} m/s] + xm_forcing, & ! xm forcings (thermodynamic levels) [{xm units}/s] + wpxp_forcing, & ! forcing (momentum levels) [{xm units} m/s^2] + C7_Skw_fnc, & ! C_7 parameter with Sk_w applied [-] + xpthvp, & ! x'th_v' (momentum levels) [{xm units} K] + C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied [-] + tau_zm, & ! Time-scale tau on momentum levels [s] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + a1, & ! a_1 [-] + wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels [m/s] + wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on moment. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + wpxp_upper_lim, & ! Keeps correlations from becoming > 1. [units vary] + wpxp_lower_lim ! Keeps correlations from becoming < -1. [units vary] + + ! Output Variable + real( kind = core_rknd ), intent(out), dimension(2*gr%nz) :: & + rhs ! Right-hand side of band diag. matrix. (LAPACK) + + ! Local Variables. + + ! For "over-implicit" weighted time step. + ! This vector holds output from the LHS (implicit) portion of a term at a + ! given vertical level. This output is weighted and applied to the RHS. + ! This is used if the implicit portion of the term is "over-implicit", which + ! means that the LHS contribution is given extra weight (>1) in order to + ! increase numerical stability. A weighted factor must then be applied to + ! the RHS in order to balance the weight. + real( kind = core_rknd ), dimension(3) :: lhs_fnc_output + + ! Indices + integer :: k, km1, kp1, k_xm, k_wpxp, k_xm_low, k_wpxp_low, k_wpxp_high + + + integer :: & + ixm_f, & + iwpxp_bp, & + iwpxp_pr3, & + iwpxp_f, & + iwpxp_sicl, & + iwpxp_ta, & + iwpxp_pr1 + + logical :: l_upper_thresh, l_lower_thresh ! flags for clip_semi_imp_lhs + + ! ---- Begin Code ---- + + select case ( solve_type ) + case ( xm_wpxp_rtm ) ! rtm/wprtp budget terms + ixm_f = irtm_forcing + iwpxp_bp = iwprtp_bp + iwpxp_pr3 = iwprtp_pr3 + iwpxp_f = iwprtp_forcing + iwpxp_sicl = iwprtp_sicl + iwpxp_ta = iwprtp_ta + iwpxp_pr1 = iwprtp_pr1 + case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms + ixm_f = ithlm_forcing + iwpxp_bp = iwpthlp_bp + iwpxp_pr3 = iwpthlp_pr3 + iwpxp_f = iwpthlp_forcing + iwpxp_sicl = iwpthlp_sicl + iwpxp_ta = iwpthlp_ta + iwpxp_pr1 = iwpthlp_pr1 + case default ! this includes the sclrm case + ixm_f = 0 + iwpxp_bp = 0 + iwpxp_pr3 = 0 + iwpxp_f = 0 + iwpxp_sicl = 0 + iwpxp_ta = 0 + iwpxp_pr1 = 0 + end select + + + ! Initialize the right-hand side vector to 0. + rhs = zero + + ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at + ! level k = 1, which is below the model surface, is simply set equal to the + ! value of xm at level k = 2 after the solve has been completed. + + do k = 2, gr%nz, 1 + + ! Define indices + + k_xm = 2*k - 1 + ! k_wpxp is 2*k + + + !!!!!***** xm *****!!!!! + + ! xm: Right-hand side (explicit xm portion of the code). + + ! RHS time tendency. + rhs(k_xm) = rhs(k_xm) + xm(k) / real( dt, kind = core_rknd ) + + ! RHS xm forcings. + ! Note: xm forcings include the effects of microphysics, + ! cloud water sedimentation, radiation, and any + ! imposed forcings on xm. + rhs(k_xm) = rhs(k_xm) + xm_forcing(k) + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for xm + ! (including microphysics/radiation). + + ! xm forcings term is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( ixm_f, k, xm_forcing(k), zt ) + + endif ! l_stats_samp + + enddo ! xm loop: 2..gr%nz + + + ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp + ! is set to specified values at both the lowest level, k = 1, and the + ! highest level, k = gr%nz. + + do k = 2, gr%nz-1, 1 + + ! Define indices + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! k_xm is 2*k - 1 + k_wpxp = 2*k + + + !!!!!***** w'x' *****!!!!! + + ! w'x': Right-hand side (explicit w'x' portion of the code). + + ! RHS buoyancy production (bp) term and pressure term 3 (pr3). + rhs(k_wpxp) & + = rhs(k_wpxp) & + + wpxp_terms_bp_pr3_rhs( C7_Skw_fnc(k), thv_ds_zm(k), xpthvp(k) ) + + ! RHS time tendency. + if ( l_iter ) then + rhs(k_wpxp) = rhs(k_wpxp) + wpxp(k) / real( dt, kind = core_rknd ) + end if + + ! RHS forcing. + ! Note: forcing includes the effects of microphysics on . + rhs(k_wpxp) = rhs(k_wpxp) + wpxp_forcing(k) + + ! RHS portion of semi-implicit clipping (sicl) term. + if ( l_clip_semi_implicit ) then + l_upper_thresh = .true. + l_lower_thresh = .true. + + rhs(k_wpxp) & + = rhs(k_wpxp) & + + clip_semi_imp_rhs( dt, wpxp(k), & + l_upper_thresh, wpxp_upper_lim(k), & + l_lower_thresh, wpxp_lower_lim(k) ) + + endif + + if( .not. l_upwind_wpxp_ta ) then ! Only do this when not using Upwind Differencing + ! RHS contribution from "over-implicit" weighted time step + ! for LHS turbulent advection (ta) term. + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + ! The weight of the implicit portion of this term is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (w'x' in this case), y(t) is the linearized portion of + ! the term that gets treated implicitly, and RHS is the portion of + ! the term that is always treated explicitly (in the case of the + ! w'x' turbulent advection term, RHS = 0). A weight of greater + ! than 1 can be applied to make the term more numerically stable. + lhs_fnc_output(1:3) & + = wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), & + gr%invrs_dzm(k), k ) + else + lhs_fnc_output(1:3) & + = wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) + endif + + rhs(k_wpxp) & + = rhs(k_wpxp) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wpxp(kp1) & + - lhs_fnc_output(2) * wpxp(k) & + - lhs_fnc_output(3) * wpxp(km1) ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS pressure term 1 (pr1). + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs_fnc_output(1) & + = wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) + rhs(k_wpxp) & + = rhs(k_wpxp) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wpxp(k) ) + + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for wpxp. + + ! w'x' term bp is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of w'x' term bp, substitute 0 for the + ! C_7 skewness function input to function wpxp_terms_bp_pr3_rhs. + call stat_update_var_pt( iwpxp_bp, k, & + wpxp_terms_bp_pr3_rhs( zero, thv_ds_zm(k), xpthvp(k) ), zm ) + + ! w'x' term pr3 is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of w'x' term pr3, add 1 to the + ! C_7 skewness function input to function wpxp_terms_bp_pr2_rhs. + call stat_update_var_pt( iwpxp_pr3, k, & + wpxp_terms_bp_pr3_rhs( (one+C7_Skw_fnc(k)), thv_ds_zm(k), & + xpthvp(k) ), & + zm ) + + ! w'x' forcing term is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_f, k, wpxp_forcing(k), zm ) + + ! w'x' term sicl has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on clip_semi_imp_rhs. + if ( l_clip_semi_implicit ) then + l_upper_thresh = .true. + l_lower_thresh = .true. + call stat_begin_update_pt( iwpxp_sicl, k, & + -clip_semi_imp_rhs( dt, wpxp(k), & + l_upper_thresh, wpxp_upper_lim(k), & + l_lower_thresh, wpxp_lower_lim(k) ), zm ) + endif + + if ( l_upwind_wpxp_ta ) then ! Use upwind differencing + lhs_fnc_output(1:3) & + = wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) + + else + ! w'x' term ta is normally completely implicit. However, there is a + ! RHS contribution from the "over-implicit" weighted time step. A + ! weighting factor of greater than 1 may be used to make the term more + ! numerically stable (see note above for RHS contribution from + ! "over-implicit" weighted time step for LHS turbulent advection (ta) + ! term). Therefore, w'x' term ta has both implicit and explicit + ! components; call stat_begin_update_pt. Since stat_begin_update_pt + ! automatically subtracts the value sent in, reverse the sign on the + ! input value. + lhs_fnc_output(1:3) & + = wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), & + invrs_rho_ds_zm(k), & + gr%invrs_dzm(k), k ) + endif + + call stat_begin_update_pt( iwpxp_ta, k, & + - ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wpxp(kp1) & + - lhs_fnc_output(2) * wpxp(k) & + - lhs_fnc_output(3) * wpxp(km1) ), zm ) + + ! w'x' term pr1 is normally completely implicit. However, there is a + ! RHS contribution from the "over-implicit" weighted time step. A + ! weighting factor of greater than 1 may be used to make the term more + ! numerically stable (see note above for RHS contribution from + ! "over-implicit" weighted time step for LHS turbulent advection (ta) + ! term). Therefore, w'x' term pr1 has both implicit and explicit + ! components; call stat_begin_update_pt. Since stat_begin_update_pt + ! automatically subtracts the value sent in, reverse the sign on the + ! input value. + lhs_fnc_output(1) & + = wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) + call stat_begin_update_pt( iwpxp_pr1, k, & + - ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * wpxp(k) ), zm ) + + + endif ! l_stats_samp + + enddo ! wpxp loop: 2..gr%nz-1 + + + ! Boundary conditions + + ! The turbulent flux (wpxp) use fixed-point boundary conditions at both the + ! upper and lower boundaries. Therefore, anything set in the wpxp loop + ! at both the upper and lower boundaries would be overwritten here. + ! However, the wpxp loop does not extend to the boundary levels. An array + ! with a value of 1 at the main diagonal on the left-hand side and with + ! values of 0 at all other diagonals on the left-hand side will preserve the + ! right-hand side value at that level. The value of xm at level k = 1, + ! which is below the model surface, is preserved and then overwritten to + ! match the new value of xm at level k = 2. + + ! Lower boundary + k = 1 + k_xm_low = 2*k - 1 + k_wpxp_low = 2*k + + ! Upper boundary + k = gr%nz + !k_xm is 2*k - 1 + k_wpxp_high = 2*k + + + ! The value of xm at the lower boundary will remain the same. + ! However, the value of xm at the lower boundary gets overwritten + ! after the matrix is solved for the next timestep, such + ! that xm(1) = xm(2). + + ! The value of w'x' at the lower boundary will remain the same. + ! The surface value of w'x' is set elsewhere + ! (case-specific information). + + ! The value of w'x' at the upper boundary will be 0. + call set_boundary_conditions_rhs( & + wpxp(1), k_wpxp_low, zero, k_wpxp_high, & + rhs, & + xm(1), k_xm_low ) + + + end subroutine xm_wpxp_rhs + + !============================================================================= + subroutine xm_wpxp_solve( nrhs, lhs, rhs, solution, err_code, rcond ) + + ! Description: + ! Solve for xm / w'x' using the band diagonal solver. + + ! References: + ! None + !------------------------------------------------------------------------ + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_lapack_wrap, only: & + band_solve, & ! Procedure(s) + band_solvex + + use crmx_error_code, only: & + clubb_no_error ! Constant + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: & + nrhs ! Number of rhs vectors + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout), dimension(nsup+nsub+1,2*gr%nz) :: & + lhs ! Implicit contributions to wpxp/xm (band diag. matrix in LAPACK storage) + + real( kind = core_rknd ), intent(inout), dimension(2*gr%nz,nrhs) :: & + rhs ! Right-hand side of band diag. matrix. (LAPACK storage) + + real( kind = core_rknd ), intent(out), dimension(2*gr%nz,nrhs) :: & + solution ! Solution to band diagonal system (LAPACK storage) + + ! Output Variables + integer, intent(out) :: err_code + + real( kind = core_rknd ), optional, intent(out) :: & + rcond ! Est. of the reciprocal of the condition # + + err_code = clubb_no_error ! Initialize to the value for no errors + + if ( present( rcond ) ) then + ! Perform LU decomp and solve system (LAPACK with diagnostics) + call band_solvex( "xm_wpxp", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solution, rcond, err_code ) + + + else + ! Perform LU decomp and solve system (LAPACK) + call band_solve( "xm_wpxp", nsup, nsub, 2*gr%nz, nrhs, & + lhs, rhs, solution, err_code ) + end if + + + return + end subroutine xm_wpxp_solve + +!=============================================================================== + subroutine xm_wpxp_clipping_and_stats & + ( solve_type, dt, wp2, xp2, wm_zt, & + xm_forcing, rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, & + xp2_threshold, xm_threshold, rcond, & + low_lev_effect, high_lev_effect, & + l_implemented, solution, & + xm, xm_tol, wpxp, err_code ) + + ! Description: + ! Clips and computes implicit stats for an artitrary xm and wpxp + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_model_flags, only: & + l_clip_semi_implicit ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_mono_flux_limiter, only: & + monotonic_turbulent_flux_limit ! Procedure(s) + + use crmx_pos_definite_module, only: & + pos_definite_adj ! Procedure(s) + + use crmx_clip_explicit, only: & + clip_covar, & ! Procedure(s) + clip_wprtp, & ! Variable(s) + clip_wpthlp, & + clip_wpsclrp + + use crmx_model_flags, only: & + l_pos_def, & ! Logical for whether to apply the positive definite scheme to rtm + l_hole_fill, & ! Logical for whether to apply the hole filling scheme to thlm/rtm + l_clip_turb_adv ! Logical for whether to clip xm when wpxp is clipped + + use crmx_constants_clubb, only: & + fstderr, & ! Constant(s) + one, & + zero + + use crmx_fill_holes, only: & + fill_holes_driver ! Procedure + + use crmx_error_code, only: & + clubb_at_least_debug_level, & ! Procedure(s) + clubb_no_error ! Constant + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_update_var_pt, & + stat_end_update_pt, & + stat_end_update, & + stat_update_var, & + stat_modify + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + zm, & + sfc, & + irtm_ta, & + irtm_ma, & + irtm_matrix_condt_num, & + irtm_pd, & + irtm_cl, & + iwprtp_bt, & + iwprtp_ma, & + iwprtp_ta, & + iwprtp_tp, & + iwprtp_ac, & + iwprtp_pr1, & + iwprtp_pr2, & + iwprtp_dp1, & + iwprtp_pd, & + iwprtp_sicl, & + ithlm_ta + + use crmx_stats_variables, only: & + ithlm_ma, & + ithlm_cl, & + ithlm_matrix_condt_num, & + iwpthlp_bt, & + iwpthlp_ma, & + iwpthlp_ta, & + iwpthlp_tp, & + iwpthlp_ac, & + iwpthlp_pr1, & + iwpthlp_pr2, & + iwpthlp_dp1, & + iwpthlp_sicl + + use crmx_stats_variables, only: & + l_stats_samp, & + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15 + + implicit none + + ! Constant Parameters + logical, parameter :: & + l_mono_flux_lim = .true., & ! Flag for monotonic turbulent flux limiter + l_enable_relaxed_clipping = .true., & ! Flag to relax clipping + l_first_clip_ts = .true., & + l_last_clip_ts = .false. + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variables being solved for. + + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + xp2, & ! x'^2 (momentum levels) [{xm units}^2] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + real( kind = core_rknd ), intent(in) :: & + xp2_threshold, & ! Minimum allowable value of x'^2 [units vary] + xm_threshold, & ! Minimum allowable value of xm [units vary] + xm_tol, & ! Minimum allowable deviation of xm [units vary] + rcond ! Reciprocal of the estimated condition number (from computing A^-1) + + ! Variables used as part of the monotonic turbulent advection scheme. + ! Find the lowermost and uppermost grid levels that can have an effect + ! on the central thermodynamic level during the course of a time step, + ! due to the effects of turbulent advection only. + integer, dimension(gr%nz), intent(in) :: & + low_lev_effect, & ! Index of the lowest level that has an effect. + high_lev_effect ! Index of the highest level that has an effect. + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + real( kind = core_rknd ), intent(in), dimension(2*gr%nz) :: & + solution ! The value of xm and wpxp [units vary] + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + xm, & ! The mean x field [units vary] + wpxp ! The flux of x [units vary m/s] + + ! Output Variable + integer, intent(out) :: & + err_code ! Returns an error code in the event of a singular matrix + + ! Local Variables + integer :: & + solve_type_cl ! solve_type used for clipping statistics. + + character(len=10) :: & + solve_type_str ! solve_type as a string for debug output purposes + + real( kind = core_rknd ), dimension(gr%nz) :: & + xm_n ! Old value of xm for positive definite scheme [units vary] + + real( kind = core_rknd ), dimension(gr%nz) :: & + wpxp_pd, xm_pd ! Change in xm and wpxp due to the pos. def. scheme + + real( kind = core_rknd ), dimension(gr%nz) :: & + wpxp_chnge, & ! Net change in w'x' due to clipping [units vary] + xp2_relaxed ! Value of x'^2 * clip_factor [units vary] + + ! Indices + integer :: & + k, km1, kp1, & + k_xm, k_wpxp + + integer :: & + ixm_ta, & + ixm_ma, & + ixm_matrix_condt_num, & + ixm_pd, & + ixm_cl, & + iwpxp_bt, & + iwpxp_ma, & + iwpxp_ta, & + iwpxp_tp, & + iwpxp_ac, & + iwpxp_pr1, & + iwpxp_pr2, & + iwpxp_dp1, & + iwpxp_pd, & + iwpxp_sicl + + ! ----- Begin code ------ + err_code = clubb_no_error ! Initialize to the value for no errors + + select case ( solve_type ) + case ( xm_wpxp_rtm ) ! rtm/wprtp budget terms + ixm_ta = irtm_ta + ixm_ma = irtm_ma + ixm_pd = irtm_pd + ixm_cl = irtm_cl + iwpxp_bt = iwprtp_bt + iwpxp_ma = iwprtp_ma + iwpxp_ta = iwprtp_ta + iwpxp_tp = iwprtp_tp + iwpxp_ac = iwprtp_ac + iwpxp_pr1 = iwprtp_pr1 + iwpxp_pr2 = iwprtp_pr2 + iwpxp_dp1 = iwprtp_dp1 + iwpxp_pd = iwprtp_pd + iwpxp_sicl = iwprtp_sicl + + ! This is a diagnostic from inverting the matrix, not a budget + ixm_matrix_condt_num = irtm_matrix_condt_num + case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms + ixm_ta = ithlm_ta + ixm_ma = ithlm_ma + ixm_pd = 0 + ixm_cl = ithlm_cl + iwpxp_bt = iwpthlp_bt + iwpxp_ma = iwpthlp_ma + iwpxp_ta = iwpthlp_ta + iwpxp_tp = iwpthlp_tp + iwpxp_ac = iwpthlp_ac + iwpxp_pr1 = iwpthlp_pr1 + iwpxp_pr2 = iwpthlp_pr2 + iwpxp_dp1 = iwpthlp_dp1 + iwpxp_pd = 0 + iwpxp_sicl = iwpthlp_sicl + + ! This is a diagnostic from inverting the matrix, not a budget + ixm_matrix_condt_num = ithlm_matrix_condt_num + + case default ! this includes the sclrm case + ixm_ta = 0 + ixm_ma = 0 + ixm_pd = 0 + ixm_cl = 0 + iwpxp_bt = 0 + iwpxp_ma = 0 + iwpxp_ta = 0 + iwpxp_tp = 0 + iwpxp_ac = 0 + iwpxp_pr1 = 0 + iwpxp_pr2 = 0 + iwpxp_dp1 = 0 + iwpxp_pd = 0 + iwpxp_sicl = 0 + + ixm_matrix_condt_num = 0 + end select + + ! Copy result into output arrays + + do k=1, gr%nz, 1 + + k_xm = 2 * k - 1 + k_wpxp = 2 * k + + xm_n(k) = xm(k) + + xm(k) = solution(k_xm) + wpxp(k) = solution(k_wpxp) + + end do ! k=1..gr%nz + + ! Lower boundary condition on xm + xm(1) = xm(2) + + + if ( l_stats_samp ) then + + + if ( ixm_matrix_condt_num > 0 ) then + ! Est. of the condition number of the mean/flux LHS matrix + call stat_update_var_pt( ixm_matrix_condt_num, 1, one / rcond, sfc ) + end if + + + ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at + ! level k = 1, which is below the model surface, is simply set equal to + ! the value of xm at level k = 2 after the solve has been completed. + ! Thus, the statistical code will run from levels 2 through gr%nz. + + do k = 2, gr%nz + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! Finalize implicit contributions for xm + + ! xm term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixm_ma, k, & + ztscr01(k) * xm(km1) & + + ztscr02(k) * xm(k) & + + ztscr03(k) * xm(kp1), zt ) + + ! xm term ta is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixm_ta, k, & + ztscr04(k) * wpxp(km1) & + + ztscr05(k) * wpxp(k), zt ) + + enddo ! xm loop: 2..gr%nz + + + ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp + ! is set to specified values at both the lowest level, k = 1, and the + ! highest level, k = gr%nz. Thus, the statistical code will run from + ! levels 2 through gr%nz-1. + + do k = 2, gr%nz-1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! Finalize implicit contributions for wpxp + + ! w'x' term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_ma, k, & + zmscr01(k) * wpxp(km1) & + + zmscr02(k) * wpxp(k) & + + zmscr03(k) * wpxp(kp1), zm ) + +! if( .not. l_upwind_wpxp_ta ) then + ! w'x' term ta is normally completely implicit. However, due to the + ! RHS contribution from the "over-implicit" weighted time step, + ! w'x' term ta has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwpxp_ta, k, & + zmscr04(k) * wpxp(km1) & + + zmscr05(k) * wpxp(k) & + + zmscr06(k) * wpxp(kp1), zm ) +! endif + + ! w'x' term tp is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_tp, k, & + zmscr07(k) * xm(k) & + + zmscr08(k) * xm(kp1), zm ) + + ! w'x' term ac is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_ac, k, & + zmscr09(k) * wpxp(k), zm ) + + ! w'x' term pr1 is normally completely implicit. However, due to the + ! RHS contribution from the "over-implicit" weighted time step, + ! w'x' term pr1 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( iwpxp_pr1, k, & + zmscr10(k) * wpxp(k), zm ) + + ! w'x' term pr2 is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_pr2, k, & + zmscr11(k) * wpxp(k), zm ) + + ! w'x' term dp1 is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( iwpxp_dp1, k, & + zmscr12(k) * wpxp(km1) & + + zmscr13(k) * wpxp(k) & + + zmscr14(k) * wpxp(kp1), zm ) + + ! w'x' term sicl has both implicit and explicit components; + ! call stat_end_update_pt. + if ( l_clip_semi_implicit ) then + call stat_end_update_pt( iwpxp_sicl, k, & + zmscr15(k) * wpxp(k), zm ) + endif + + enddo ! wpxp loop: 2..gr%nz-1 + + + endif ! l_stats_samp + + + ! Apply a monotonic turbulent flux limiter to xm/w'x'. + if ( l_mono_flux_lim ) then + call monotonic_turbulent_flux_limit( solve_type, dt, xm_n, & + xp2, wm_zt, xm_forcing, & + rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, & + xp2_threshold, l_implemented, & + low_lev_effect, high_lev_effect, & + xm, xm_tol, wpxp, err_code ) + end if ! l_mono_flux_lim + + ! Apply a flux limiting positive definite scheme if the solution + ! for the mean field is negative and we're determining total water + if ( solve_type == xm_wpxp_rtm .and. l_pos_def .and. any( xm < zero ) ) then + + call pos_definite_adj( dt, "zt", xm, wpxp, & + xm_n, xm_pd, wpxp_pd ) + + else + ! For stats purposes + xm_pd = zero + wpxp_pd = zero + + end if ! l_pos_def and solve_type == "rtm" and rtm less than 0 + + if ( l_stats_samp ) then + + call stat_update_var( iwpxp_pd, wpxp_pd(1:gr%nz), zm ) + + call stat_update_var( ixm_pd, xm_pd(1:gr%nz), zt ) + + end if + + ! Computed value before clipping + if ( l_stats_samp ) then + call stat_begin_update( ixm_cl, xm / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + end if + + if ( any( xm < xm_threshold ) .and. l_hole_fill ) then + + select case ( solve_type ) + case ( xm_wpxp_rtm ) + solve_type_str = "rtm" + case ( xm_wpxp_thlm ) + solve_type_str = "thlm" + case default + solve_type_str = "scalars" + end select + + if ( clubb_at_least_debug_level( 1 ) ) then + do k = 1, gr%nz + if ( xm(k) < zero ) then + write(fstderr,*) solve_type_str//" < ", xm_threshold, & + " in advance_xm_wpxp_module at k= ", k + end if + end do + end if + + call fill_holes_driver( 2, xm_threshold, "zt", & + rho_ds_zt, rho_ds_zm, & + xm ) + + end if ! any( xm < xm_threshold ) .and. l_hole_fill + + if ( l_stats_samp ) then + call stat_end_update( ixm_cl, xm / real( dt, kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + end if + + ! Use solve_type to find solve_type_cl, which is used + ! in subroutine clip_covar. + select case ( solve_type ) + case ( xm_wpxp_rtm ) + solve_type_cl = clip_wprtp + case ( xm_wpxp_thlm ) + solve_type_cl = clip_wpthlp + case default + solve_type_cl = clip_wpsclrp + end select + + ! Clipping for w'x' + ! Clipping w'x' at each vertical level, based on the + ! correlation of w and x at each vertical level, such that: + ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]; + ! -1 <= corr_(w,x) <= 1. + ! Since w'^2, x'^2, and w'x' are updated in different places + ! from each other, clipping for w'x' has to be done three times + ! (three times each for w'r_t', w'th_l', and w'sclr'). This is + ! the second instance of w'x' clipping. + + ! Compute a slightly larger value of rt'^2 for clipping purposes. This was + ! added to prevent a situation in which both the variance and flux are small + ! and the simulation gets "stuck" at the rt_tol^2 value. + ! See ticket #389 on the CLUBB TRAC for further details. + ! -dschanen 10 Jan 2011 + if ( l_enable_relaxed_clipping ) then + if ( solve_type == xm_wpxp_rtm ) then + xp2_relaxed = max( 1e-7_core_rknd , xp2 ) + + else if ( solve_type == xm_wpxp_thlm ) then + xp2_relaxed = max( 0.01_core_rknd, xp2 ) + + else ! This includes the passive scalars + xp2_relaxed = max( 1e-7_core_rknd , xp2 ) + + end if + + else ! Don't relax clipping + xp2_relaxed = xp2 + + end if + + call clip_covar( solve_type_cl, l_first_clip_ts, & ! In + l_last_clip_ts, dt, wp2, xp2_relaxed, & ! In + wpxp, wpxp_chnge ) ! In/Out + + ! Adjusting xm based on clipping for w'x'. + if ( any( wpxp_chnge /= zero ) .and. l_clip_turb_adv ) then + call xm_correction_wpxp_cl( solve_type, dt, wpxp_chnge, gr%invrs_dzt, & + xm ) + endif + + if ( l_stats_samp ) then + + ! wpxp time tendency + call stat_modify( iwpxp_bt, wpxp / real( dt, kind = core_rknd ), zm ) + ! Brian Griffin; July 5, 2008. + + endif + + return + end subroutine xm_wpxp_clipping_and_stats + + !============================================================================= + pure function xm_term_ta_lhs( rho_ds_zm, rho_ds_zmm1, & + invrs_rho_ds_zt, invrs_dzt ) & + result( lhs ) + + ! Description: + ! Turbulent advection of xm: implicit portion of the code. + ! + ! The d(xm)/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'x' )/dz. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - (1/rho_ds) * d( rho_ds * w'x'(t+1) )/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'x' being used is from + ! the next timestep, which is being advanced to in solving the d(xm)/dt and + ! d(w'x')/dt equations. + ! + ! This term is discretized as follows: + ! + ! While the values of xm are found on the thermodynamic levels, the values + ! of w'x' are found on the momentum levels. Additionally, the values of + ! rho_ds_zm are found on the momentum levels, and the values of + ! invrs_rho_ds_zt are found on the thermodynamic levels. On the momentum + ! levels, the values of rho_ds_zm are multiplied by the values of w'x'. The + ! derivative of (rho_ds_zm * w'x') is taken over the intermediate (central) + ! thermodynamic level, where it is multiplied by invrs_rho_ds_zt, yielding + ! the desired results. + ! + ! =====rho_ds_zm=====wpxp================================== m(k) + ! + ! ------invrs_rho_ds_zt--------d(rho_ds*wpxp)/dz----------- t(k) + ! + ! =====rho_ds_zmm1===wpxpm1================================ m(k-1) + ! + ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes + ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + k_mdiag = 1, & ! Momentum superdiagonal index. + km1_mdiag = 2 ! Momentum subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + rho_ds_zm, & ! Dry, static density at momentum level (k) [kg/m^3] + rho_ds_zmm1, & ! Dry, static density at momentum level (k+1) [kg/m^3] + invrs_rho_ds_zt, & ! Inverse dry, static density @ thermo lev (k) [m^3/kg] + invrs_dzt ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ), dimension(2) :: lhs + + + ! Momentum superdiagonal [ x wpxp(k,) ] + lhs(k_mdiag) & + = + invrs_rho_ds_zt * invrs_dzt * rho_ds_zm + + ! Momentum subdiagonal [ x wpxp(k-1,) ] + lhs(km1_mdiag) & + = - invrs_rho_ds_zt * invrs_dzt * rho_ds_zmm1 + + + return + end function xm_term_ta_lhs + + !============================================================================= + pure function wpxp_term_ta_lhs( wp3_on_wp2_ztp1, wp3_on_wp2_zt, & + a1_ztp1, a1_zt, & + rho_ds_ztp1, rho_ds_zt, & + invrs_rho_ds_zm, & + invrs_dzm, level ) & + result( lhs ) + + ! Description: + ! Turbulent advection of w'x': implicit portion of the code. + ! + ! The d(w'x')/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'^2x' )/dz. + ! + ! A substitution is made in order to close the turbulent advection term, + ! such that: + ! + ! w'^2x' = a_1 * ( w'^3 / w'^2 ) * w'x', + ! + ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent + ! advection term becomes: + ! + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x'(t+1) ] / dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'x' being used is from + ! the next timestep, which is being advanced to in solving the d(w'x')/dt + ! equation. + ! + ! This term is discretized as follows: + ! + ! The values of w'x', w'^2, and a_1 are found on the momentum levels, while + ! the values of w'^3 are found on the thermodynamic levels. Additionally, + ! the values of rho_ds_zt are found on the thermodynamic levels, and the + ! values of invrs_rho_ds_zm are found on the momentum levels. Each of the + ! variables w'x', w'^2, and a_1 are interpolated to the intermediate + ! thermodynamic levels. The values of the mathematical expression (called F + ! here) within the dF/dz term are computed on the thermodynamic levels. + ! Then, the derivative (d/dz) of the expression (F) is taken over the + ! central momentum level, where it is multiplied by invrs_rho_ds_zm, + ! yielding the desired result. In this function, the values of F are as + ! follows: + ! + ! F = rho_ds_zt * a_1(t) * ( w'^3(t) / w'^2(t) ) * w'x'(t+1); + ! + ! where the timestep index (t) stands for the index of the current timestep. + ! + ! + ! =a1p1========wp2p1========wpxpp1=================================== m(k+1) + ! + ! -----a1(interp)---wp2(interp)---wpxp(interp)---wp3p1---rho_ds_ztp1- t(k+1) + ! + ! =a1==========wp2==========wpxp=======invrs_rho_ds_zm=======dF/dz=== m(k) + ! + ! -----a1(interp)---wp2(interp)---wpxp(interp)---wp3-----rho_ds_zt--- t(k) + ! + ! =a1m1========wp2m1========wpxpm1=================================== m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable; gr%weights_zm2zt + +! use model_flags, only: & +! l_standard_term_ta + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + integer, parameter :: & + m_above = 1, & ! Index for upper momentum level grid weight. + m_below = 2 ! Index for lower momentum level grid weight. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp3_on_wp2_ztp1, & ! Smoothed wp3 / wp2 on thermo. levels (k+1) [m/s] + wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels (k) [m/s] +! a1, & ! a_1 interpolated to thermo. level (k+1) [-] + a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] + a1_zt, & ! a_1 interpolated to thermo. level (k) [-] + rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] + rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + integer, intent(in) :: & + level ! Central momentum level (on which calculation occurs). + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + ! Local Variables + integer :: & + tkp1, & ! Thermodynamic level directly above central momentum level. + tk ! Thermodynamic level directly below central momentum level. + + ! Thermodynamic level (k+1) is between momentum level (k+1) + ! and momentum level (k). + tkp1 = level + 1 + + ! Thermodynamic level (k) is between momentum level (k) + ! and momentum level (k-1). + tk = level + + ! Note: The w'x' turbulent advection term, which is + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz, + ! still keeps the a_1 term inside the derivative, unlike the w'^3 + ! equation (found in advance_wp2_wp3_module.F90) and the equations for + ! r_t'^2, th_l'^2, r_t'th_l', u'^2, v'^2, sclr'r_t', sclr'th_l', and + ! sclr'^2 (found in advance_xp2_xpyp_module.F90). Brian. + +! if ( l_standard_term_ta ) then + + ! Always use the standard discretization for the w'x' turbulent advection + ! term. Brian. + + ! The turbulent advection term is discretized normally, in accordance + ! with the model equations found in the documentation and the description + ! listed above. + ! The w'x' turbulent advection term is + ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz + + ! Momentum superdiagonal: [ x wpxp(k+1,) ] + lhs(kp1_mdiag) & + = + invrs_rho_ds_zm & + * invrs_dzm & + * rho_ds_ztp1 * a1_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_above,tkp1) + + ! Momentum main diagonal: [ x wpxp(k,) ] + lhs(k_mdiag) & + = + invrs_rho_ds_zm & + * invrs_dzm & + * ( rho_ds_ztp1 * a1_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_below,tkp1) & + - rho_ds_zt * a1_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_above,tk) & + ) + + ! Momentum subdiagonal: [ x wpxp(k-1,) ] + lhs(km1_mdiag) & + = - invrs_rho_ds_zm & + * invrs_dzm & + * rho_ds_zt * a1_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_below,tk) + +! else + + ! This discretization very similar to what Brian did for the xp2_ta terms + ! and is intended to stabilize the simulation by pulling a1 out of the + ! derivative. It didn't seem to work very well. -dschanen 17 Jan 2010 + + ! Momentum superdiagonal: [ x wpxp(k+1,) ] +! lhs(kp1_mdiag) & +! = + invrs_rho_ds_zm * a1 & +! * invrs_dzm & +! * rho_ds_ztp1 & +! * wp3_on_wp2_ztp1 & +! * gr%weights_zm2zt(m_above,tkp1) + + ! Momentum main diagonal: [ x wpxp(k,) ] +! lhs(k_mdiag) & +! = + invrs_rho_ds_zm * a1 & +! * invrs_dzm & +! * ( rho_ds_ztp1 & +! * wp3_on_wp2_ztp1 & +! * gr%weights_zm2zt(m_below,tkp1) & +! - rho_ds_zt & +! * wp3_on_wp2_zt & +! * gr%weights_zm2zt(m_above,tk) & +! ) + +! ! Momentum subdiagonal: [ x wpxp(k-1,) ] +! lhs(km1_mdiag) & +! = - invrs_rho_ds_zm * a1 & +! * invrs_dzm & +! * rho_ds_zt & +! * wp3_on_wp2_zt & +! * gr%weights_zm2zt(m_below,tk) + +! endif ! l_standard_term_ta + + + return + end function wpxp_term_ta_lhs + + !============================================================================= + pure function wpxp_term_ta_lhs_upwind( a1_zm, a1_zm_p1, a1_zm_m1, & + wp3_on_wp2_p1, wp3_on_wp2, wp3_on_wp2_m1, & + invrs_dzt, invrs_dztkp1, & + invrs_rho_ds_zm, & + rho_ds_zmp1, rho_ds_zm, rho_ds_zmm1 ) & + result( lhs ) + + ! Description: + ! Upwind Differencing for the wpxp term + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + zero ! Constant(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + a1_zm, & ! a_1(k) on momentum levels [-] + a1_zm_p1, & ! a_1(k+1) on momentum levels [-] + a1_zm_m1, & ! a_1(k-1) on momentum levels [-] + wp3_on_wp2_p1, & ! Smoothed wp3 / wp2 on moment. levels (k+1) [m/s] + wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels (k) [m/s] + wp3_on_wp2_m1, & ! Smoothed wp3 / wp2 on moment. levels (k-1) [m/s] + invrs_dzt, & ! Inverse of grid spacing (k) [1/m] + invrs_dztkp1, & ! Inverse of grid spacing (k+1) [1/m] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] + rho_ds_zm, & ! Density of air (k) [kg/m^3] + rho_ds_zmp1, & ! Density of air (k+1) [kg/m^3] + rho_ds_zmm1 ! Density of air (k-1) [kg/m^3] + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + + if ( wp3_on_wp2 > zero ) then + + ! "Wind" is blowing upwards (a1_zm > 0 and wp2 > 0 always) + lhs(kp1_mdiag) = zero + + lhs(k_mdiag) & + = + invrs_dzt * invrs_rho_ds_zm & + * rho_ds_zm * a1_zm * wp3_on_wp2 + + lhs(km1_mdiag) & + = - invrs_dzt * invrs_rho_ds_zm & + * rho_ds_zmm1 * a1_zm_m1 * wp3_on_wp2_m1 + + else ! "Wind" is blowing downward + + lhs(kp1_mdiag) & + = + invrs_dztkp1 * invrs_rho_ds_zm & + * rho_ds_zmp1 * a1_zm_p1 * wp3_on_wp2_p1 + + lhs(k_mdiag) & + = - invrs_dztkp1 * invrs_rho_ds_zm & + * rho_ds_zm * a1_zm * wp3_on_wp2 + + lhs(km1_mdiag) = zero + + endif + + + return + end function wpxp_term_ta_lhs_upwind + + !============================================================================= + pure function wpxp_term_tp_lhs( wp2, invrs_dzm ) & + result( lhs ) + + ! Description: + ! Turbulent production of w'x': implicit portion of the code. + ! + ! The d(w'x')/dt equation contains a turbulent production term: + ! + ! - w'^2 d(xm)/dz. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - w'^2 * d( xm(t+1) )/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of xm being used is from the + ! next timestep, which is being advanced to in solving the d(w'x')/dt and + ! d(xm)/dt equations. + ! + ! This term is discretized as follows: + ! + ! The values of xm are found on thermodynamic levels, while the values of + ! w'^2 are found on momentum levels. The derivative of xm is taken over the + ! intermediate (central) momentum level, where it is multiplied by w'^2, + ! yielding the desired result. + ! + ! ---------------------------xmp1-------------------------- t(k+1) + ! + ! ==========wp2=====================d(xm)/dz=============== m(k) + ! + ! ---------------------------xm---------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2 ! Thermodynamic subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp2, & ! w'^2(k) [m^2/s^2] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ), dimension(2) :: lhs + + + ! Thermodynamic superdiagonal [ x xm(k+1,) ] + lhs(kp1_tdiag) & + = + wp2 * invrs_dzm + + ! Thermodynamic subdiagonal [ x xm(k,) ] + lhs(k_tdiag) & + = - wp2 * invrs_dzm + + + return + end function wpxp_term_tp_lhs + + !============================================================================= + pure function wpxp_terms_ac_pr2_lhs( C7_Skw_fnc, & + wm_ztp1, wm_zt, invrs_dzm ) & + result( lhs ) + + ! Description: + ! Accumulation of w'x' and w'x' pressure term 2: implicit portion of the + ! code. + ! + ! The d(w'x')/dt equation contains an accumulation term: + ! + ! - w'x' dw/dz; + ! + ! and pressure term 2: + ! + ! + C_7 w'x' dw/dz. + ! + ! Both the w'x' accumulation term and pressure term 2 are completely + ! implicit. The accumulation term and pressure term 2 are combined and + ! solved together as: + ! + ! - ( 1 - C_7 ) * w'x'(t+1) * dw/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'x' being used is from + ! the next timestep, which is being advanced to in solving the d(w'x')/dt + ! equation. + ! + ! The terms are discretized as follows: + ! + ! The values of w'x' are found on momentum levels, while the values of wm_zt + ! (mean vertical velocity on thermodynamic levels) are found on + ! thermodynamic levels. The vertical derivative of wm_zt is taken over the + ! intermediate (central) momentum level. It is then multiplied by w'x' + ! (implicitly calculated at timestep (t+1)) and the coefficients to yield + ! the desired results. + ! + ! -------wm_ztp1------------------------------------------- t(k+1) + ! + ! ===============d(wm_zt)/dz============wpxp=============== m(k) + ! + ! -------wm_zt--------------------------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + one ! Constant(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C7_Skw_fnc, & ! C_7 parameter with Sk_w applied (k) [-] + wm_ztp1, & ! w wind component on thermodynamic level (k+1) [m/s] + wm_zt, & ! w wind component on thermodynamic level (k) [m/s] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + + ! Return Variable + real( kind = core_rknd ) :: lhs + + + ! Momentum main diagonal: [ x wpxp(k,) ] + lhs = ( one - C7_Skw_fnc ) * invrs_dzm * ( wm_ztp1 - wm_zt ) + + + return + end function wpxp_terms_ac_pr2_lhs + + !============================================================================= + pure function wpxp_term_pr1_lhs( C6x_Skw_fnc, tau_zm ) & + result( lhs ) + + ! Description + ! Pressure term 1 for w'x': implicit portion of the code. + ! + ! The d(w'x')/dt equation contains pressure term 1: + ! + ! - ( C_6 / tau_m ) w'x'. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - ( C_6 / tau_m ) w'x'(t+1) + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of w'x' being used is from + ! the next timestep, which is being advanced to in solving the d(w'x')/dt + ! equation. + ! + ! The values of w'x' are found on the momentum levels. The values of the + ! C_6 skewness function and time-scale tau_m are also found on the momentum + ! levels. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied (k) [-] + tau_zm ! Time-scale tau at momentum level (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + + ! Momentum main diagonal: [ x wpxp(k,) ] + lhs = C6x_Skw_fnc / tau_zm + + + return + end function wpxp_term_pr1_lhs + + !============================================================================= + pure function wpxp_terms_bp_pr3_rhs( C7_Skw_fnc, thv_ds_zm, xpthvp ) & + result( rhs ) + + ! Description: + ! Buoyancy production of w'x' and w'x' pressure term 3: explicit portion of + ! the code. + ! + ! The d(w'x')/dt equation contains a buoyancy production term: + ! + ! + (g/thv_ds) x'th_v'; + ! + ! and pressure term 3: + ! + ! - C_7 (g/thv_ds) x'th_v'. + ! + ! Both the w'x' buoyancy production term and pressure term 3 are completely + ! explicit. The buoyancy production term and pressure term 3 are combined + ! and solved together as: + ! + ! + ( 1 - C_7 ) * (g/thv_ds) * x'th_v'. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & ! Constants(s) + grav, & ! Gravitational acceleration [m/s^2] + one + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C7_Skw_fnc, & ! C_7 parameter with Sk_w applied (k) [-] + thv_ds_zm, & ! Dry, base-state theta_v on mom. lev. (k) [K] + xpthvp ! x'th_v'(k) [K {xm units}] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + + rhs = ( grav / thv_ds_zm ) * ( one - C7_Skw_fnc ) * xpthvp + + + return + end function wpxp_terms_bp_pr3_rhs + + !============================================================================= + subroutine xm_correction_wpxp_cl( solve_type, dt, wpxp_chnge, invrs_dzt, & + xm ) + + ! Description: + ! Corrects the value of xm if w'x' needed to be clipped, for xm is partially + ! based on the derivative of w'x' with respect to altitude. + ! + ! The time-tendency equation for xm is: + ! + ! d(xm)/dt = -w d(xm)/dz - d(w'x')/dz + d(xm)/dt|_ls; + ! + ! where d(xm)/dt|_ls is the rate of change of xm over time due to radiation, + ! microphysics, and/or any other large-scale forcing(s). + ! + ! The time-tendency equation for xm is solved in conjunction with the + ! time-tendency equation for w'x'. Both equations are solved together in a + ! semi-implicit manner. However, after both equations have been solved (and + ! thus both xm and w'x' have been advanced to the next timestep with + ! timestep index {t+1}), the value of covariance w'x' may be clipped at any + ! level in order to prevent the correlation of w and x from becoming greater + ! than 1 or less than -1. + ! + ! The correlation between w and x is: + ! + ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]. + ! + ! The correlation must always have a value between -1 and 1, such that: + ! + ! -1 <= corr_(w,x) <= 1. + ! + ! Therefore, there is an upper limit on w'x', such that: + ! + ! w'x' <= [ sqrt(w'^2) * sqrt(x'^2) ]; + ! + ! and a lower limit on w'x', such that: + ! + ! w'x' >= -[ sqrt(w'^2) * sqrt(x'^2) ]. + ! + ! The aforementioned time-tendency equation for xm is based on the value of + ! w'x' without being clipped (w'x'{t+1}_unclipped), such that: + ! + ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz + d(xm{t})/dt|_ls; + ! + ! where the both the mean advection term, -w d(xm{t+1})/dz, and the + ! turbulent advection term, -d(w'x'{t+1}_unclipped)/dz, are solved + ! completely implicitly. The xm forcing term, +d(xm{t})/dt|_ls, is solved + ! completely explicitly. + ! + ! However, if w'x' needs to be clipped after being advanced one timestep, + ! then xm needs to be altered to reflect the fact that w'x' has a different + ! value than the value used while both were being solved together. Ideally, + ! the xm time-tendency equation that should be used is: + ! + ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_clipped)/dz + d(xm{t})/dt|_ls. + ! + ! However, w'x'{t+1}_clipped isn't known until after the w'x' and xm + ! equations have been solved together. However, a proper adjuster can be + ! applied to xm through the use of the following relationship: + ! + ! w'x'{t+1}_clipped = w'x'{t+1}_unclipped + w'x'{t+1}_amount_clipped; + ! + ! at any given vertical level. + ! + ! When the expression above is substituted into the preceeding xm + ! time-tendency equation, the resulting equation for xm time-tendency is: + ! + ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz + ! - d(w'x'{t+1}_amount_clipped)/dz + d(xm{t})/dt|_ls. + ! + ! Thus, the resulting xm time-tendency equation is the same as the original + ! xm time-tendency equation, but with added adjuster term: + ! + ! -d(w'x'{t+1}_amount_clipped)/dz. + ! + ! Since the adjuster term needs to be applied after xm has already been + ! solved, it needs to be multiplied by the timestep length and added on to + ! xm{t+1}, such that: + ! + ! xm{t+1}_after_adjustment = + ! xm{t+1}_before_adjustment + ( -d(w'x'{t+1}_amount_clipped)/dz ) * dt. + ! + ! The adjuster term is discretized as follows: + ! + ! The values of w'x' are located on the momentum levels. Thus, the values + ! of w'x'_amount_clipped are also located on the momentum levels. The + ! values of xm are located on the thermodynamic levels. The derivatives + ! (d/dz) of w'x'_amount_clipped are taken over the intermediate + ! thermodynamic levels, where they are applied to xm. + ! + ! =======wpxp_amount_clipped=============================== m(k) + ! + ! -----------------------------d(wpxp_amount_clipped)/dz--- t(k) + ! + ! =======wpxpm1_amount_clipped============================= m(k-1) + ! + ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes + ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + + ! Note: The results of this xm adjustment are highly dependent on the + ! numerical stability and the smoothness of the w'^2 and x'^2 fields. + ! An unstable "sawtooth" profile for w'^2 and/or x'^2 causes an + ! unstable "sawtooth" profile for the upper and lower limits on w'x'. + ! In turn, this causes an unstable "sawtooth" profile for + ! w'x'_amount_clipped. Taking the derivative of that such a "noisy" + ! field and applying the results to xm causes the xm field to become + ! more "noisy" and unstable. + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s); gr%nz only. + + use crmx_clubb_precision, only: & + time_precision, & + core_rknd + + use crmx_stats_type, only: & + stat_update_var ! Procedure(s) + + use crmx_stats_variables, only: & + l_stats_samp, & ! Variable(s) + zt, & + ithlm_tacl, & + irtm_tacl + + implicit none + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variable that is being solved for. + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wpxp_chnge, & ! Amount of change in w'x' due to clipping [m/s {xm units}] + invrs_dzt ! Inverse of grid spacing [1/m] + + ! Input/Output Variable + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + xm ! xm (thermodynamic levels) [{xm units}] + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + xm_tndcy_wpxp_cl ! d(xm)/dt due to clipping of w'x' [{xm units}/s] + + integer :: k ! Array index + + integer :: ixm_tacl ! Statistical index + + + select case ( solve_type ) + case ( xm_wpxp_rtm ) + ixm_tacl = irtm_tacl + case ( xm_wpxp_thlm ) + ixm_tacl = ithlm_tacl + case default + ixm_tacl = 0 + end select + + ! Adjusting xm based on clipping for w'x'. + ! Loop over all thermodynamic levels between the second-lowest and the + ! highest. + do k = 2, gr%nz, 1 + xm_tndcy_wpxp_cl(k) = - invrs_dzt(k) * ( wpxp_chnge(k) - wpxp_chnge(k-1) ) + xm(k) = xm(k) + xm_tndcy_wpxp_cl(k) * real( dt, kind = core_rknd ) + enddo + + if ( l_stats_samp ) then + ! The adjustment to xm due to turbulent advection term clipping + ! (xm term tacl) is completely explicit; call stat_update_var. + call stat_update_var( ixm_tacl, xm_tndcy_wpxp_cl, zt ) + endif + + + return + + end subroutine xm_correction_wpxp_cl + + + !============================================================================= + pure function damp_coefficient( coefficient, Cx_Skw_fnc, max_coeff_value, & + threshold, Lscale ) & + result( damped_value ) + + ! Description: + ! Damps a given coefficient linearly based on the value of Lscale. + ! For additional information see CLUBB ticket #431. + + use crmx_constants_clubb, only: & + one_hundred ! Constant(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) + + implicit none + + ! Input variables + real( kind = core_rknd ), intent(in) :: & + coefficient, & ! The coefficient to be damped + max_coeff_value, & ! Maximum value the damped coefficient should have + threshold ! Value of Lscale below which the damping should occur + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + Lscale, & ! Current value of Lscale + Cx_Skw_fnc ! Initial skewness function before damping + + ! Local variables + real( kind = core_rknd ), parameter :: & + ! Added to prevent large damping at low altitudes where Lscale is small + altitude_threshold = one_hundred ! Altitude above which damping should occur + + ! Return Variable + real( kind = core_rknd ), dimension(gr%nz) :: damped_value + + damped_value = Cx_Skw_fnc + + where( Lscale < threshold .and. gr%zt > altitude_threshold) + damped_value = max_coeff_value & + + ( ( coefficient - max_coeff_value ) / threshold ) & + * Lscale + end where + + return + + end function damp_coefficient +!=============================================================================== + +end module crmx_advance_xm_wpxp_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 new file mode 100644 index 0000000000..c4f490df6f --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 @@ -0,0 +1,3417 @@ +!----------------------------------------------------------------------- +! $Id: advance_xp2_xpyp_module.F90 6149 2013-04-08 21:45:56Z storer@uwm.edu $ +!=============================================================================== +module crmx_advance_xp2_xpyp_module + + ! Description: + ! Contains the subroutine advance_xp2_xpyp and ancillary functions. + !----------------------------------------------------------------------- + + implicit none + + public :: advance_xp2_xpyp, & + update_xp2_mc_tndcy + + private :: xp2_xpyp_lhs, & + xp2_xpyp_solve, & + xp2_xpyp_uv_rhs, & + xp2_xpyp_rhs, & + xp2_xpyp_implicit_stats, & + term_ta_lhs, & + term_ta_lhs_upwind, & + term_ta_rhs, & + term_tp, & + term_dp1_lhs, & + term_dp1_rhs, & + term_pr1, & + term_pr2 + + private ! Set default scope + + ! Private named constants to avoid string comparisons + integer, parameter, private :: & + xp2_xpyp_rtp2 = 1, & ! Named constant for rtp2 solves + xp2_xpyp_thlp2 = 2, & ! Named constant for thlp2 solves + xp2_xpyp_rtpthlp = 3, & ! Named constant for rtpthlp solves + xp2_xpyp_up2_vp2 = 4, & ! Named constant for up2_vp2 solves + xp2_xpyp_up2 = 5, & ! Named constant for up2 solves + xp2_xpyp_vp2 = 6, & ! Named constant for vp2 solves + xp2_xpyp_scalars = 7, & ! Named constant for scalar solves + xp2_xpyp_sclrp2 = 8, & ! Named constant for sclrp2 solves + xp2_xpyp_sclrprtp = 9, & ! Named constant for sclrprtp solves + xp2_xpyp_sclrpthlp = 10 ! Named constant for sclrpthlp solves + + contains + + !============================================================================= + subroutine advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & + wpthlp, wpthvp, um, vm, wp2, wp2_zt, & + wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & + Kh_zt, rtp2_forcing, thlp2_forcing, & + rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, thv_ds_zm, & + Lscale, wp3_on_wp2, wp3_on_wp2_zt, & + l_iter, dt, & + sclrm, wpsclrp, & + rtp2, thlp2, rtpthlp, up2, vp2, & + err_code, & + sclrp2, sclrprtp, sclrpthlp ) + + ! Description: + ! Subprogram to diagnose variances by solving steady-state equations + + ! References: + ! Eqn. 13, 14, 15 on p. 3545 of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + + ! See also: + ! ``Equations for CLUBB'', Section 4: + ! /Steady-state solution for the variances/ + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + w_tol_sqd, & ! Constant(s) + rt_tol, & + thl_tol, & + w_tol_sqd, & + fstderr, & + one, & + two_thirds, & + one_half, & + one_third, & + zero, & + zero_threshold + + use crmx_model_flags, only: & + l_hole_fill, & ! logical constants + l_single_C2_Skw + + use crmx_parameters_tunable, only: & + C2rt, & ! Variable(s) + C2thl, & + C2rtthl, & + c_K2, & + nu2_vert_res_dep, & + c_K9, & + nu9_vert_res_dep, & + beta, & + C4, & + C14, & + C5, & + C2, & + C2b, & + C2c + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + sclr_tol + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt ! Procedure(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_clip_explicit, only: & + clip_covar, & ! Procedure(s) + clip_variance, & + clip_rtp2, & ! Variable(s) + clip_thlp2, & + clip_rtpthlp, & + clip_up2, & + clip_vp2, & + clip_sclrp2, & + clip_sclrprtp, & + clip_sclrpthlp + + use crmx_stats_type, only: & + stat_modify + + use crmx_error_code, only: & + clubb_no_error, & ! Variable(s) + clubb_var_out_of_range, & + clubb_singular_matrix + + use crmx_error_code, only: & + fatal_error, & ! Procedure(s) + clubb_at_least_debug_level + + use crmx_stats_variables, only: & + zm, & + irtp2_cl, & + l_stats_samp + + use crmx_array_index, only: & + iisclr_rt, & + iisclr_thl + + implicit none + + ! Intrinsic functions + intrinsic :: & + exp, sqrt, min + + ! Constant parameters + logical, parameter :: & + l_clip_large_rtp2 = .true. ! Clip rtp2 to be < rtm^2 * coef + + real( kind = core_rknd ), parameter :: & + rtp2_clip_coef = one_half ! Coefficient appled the clipping threshold on rtp2 [-] + + ! Input variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + tau_zm, & ! Time-scale tau on momentum levels [s] + wm_zm, & ! w-wind component on momentum levels [m/s] + rtm, & ! Total water mixing ratio (t-levs) [kg/kg] + wprtp, & ! (momentum levels) [(m/s)(kg/kg)] + thlm, & ! Liquid potential temp. (t-levs) [K] + wpthlp, & ! (momentum levels) [(m K)/s] + wpthvp, & ! (momentum levels) [(m K)/s] + um, & ! u wind (thermodynamic levels) [m/s] + vm, & ! v wind (thermodynamic levels) [m/s] + wp2, & ! (momentum levels) [m^2/s^2] + wp2_zt, & ! interpolated to thermo. levels [m^2/s^2] + wp3, & ! (thermodynamic levels) [m^3/s^3] + upwp, & ! (momentum levels) [m^2/s^2] + vpwp, & ! (momentum levels) [m^2/s^2] + sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] + Skw_zm, & ! Skewness of w on momentum levels [-] + Kh_zt, & ! Eddy diffusivity on thermo. levels [m^2/s] + rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] + thlp2_forcing, & ! forcing (momentum levels) [K^2/s] + rtpthlp_forcing, & ! forcing (momentum levels) [(kg/kg)K/s] + rho_ds_zm, & ! Dry, static density on momentum levs. [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ mom. levs. [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on mom. levs. [K] + Lscale, & ! Mixing length [m] + wp3_on_wp2, & ! Smoothed version of / zm [m/s] + wp3_on_wp2_zt ! Smoothed version of / zt [m/s] + + logical, intent(in) :: l_iter ! Whether variances are prognostic + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + ! Passive scalar input + real( kind = core_rknd ), intent(in), dimension(gr%nz, sclr_dim) :: & + sclrm, wpsclrp + + ! Input/Output variables + ! An attribute of (inout) is also needed to import the value of the variances + ! at the surface. Brian. 12/18/05. + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + rtp2, & ! [(kg/kg)^2] + thlp2, & ! [K^2] + rtpthlp, & ! [(kg K)/kg] + up2, & ! [m^2/s^2] + vp2 ! [m^2/s^2] + + ! Output variable for singular matrices + integer, intent(inout) :: err_code + + ! Passive scalar output + real( kind = core_rknd ), intent(inout), dimension(gr%nz, sclr_dim) :: & + sclrp2, sclrprtp, sclrpthlp + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + C2sclr_1d, C2rt_1d, C2thl_1d, C2rtthl_1d, & + C4_C14_1d ! Parameters C4 and C14 combined for simplicity + + real( kind = core_rknd ), dimension(gr%nz) :: & + a1 ! a_1 (momentum levels); See eqn. 24 in `Equations for CLUBB' [-] + + real( kind = core_rknd ), dimension(gr%nz) :: & + upwp_zt, & ! interpolated to thermodynamic levels [m^2/s^2] + vpwp_zt, & ! interpolated to thermodynamic levels [m^2/s^2] + wpsclrp_zt ! interp. to thermo. levels [m/s {sclrm units}] + + real( kind = core_rknd ) :: & + threshold ! Minimum value for variances [units vary] + + real( kind = core_rknd ), dimension(3,gr%nz) :: & + lhs ! Tridiagonal matrix + + real( kind = core_rknd ), dimension(gr%nz,1) :: & + rhs ! RHS vector of tridiagonal matrix + + real( kind = core_rknd ), dimension(gr%nz,2) :: & + uv_rhs, &! RHS vectors of tridiagonal system for up2/vp2 + uv_solution ! Solution to the tridiagonal system for up2/vp2 + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim*3) :: & + sclr_rhs, & ! RHS vectors of tridiagonal system for the passive scalars + sclr_solution ! Solution to tridiagonal system for the passive scalars + + integer, dimension(5+1) :: & + err_code_array ! Array containing the error codes for each variable + + ! Eddy Diffusion for Variances and Covariances. + real( kind = core_rknd ), dimension(gr%nz) :: & + Kw2, & ! For rtp2, thlp2, rtpthlp, and passive scalars [m^2/s] + Kw9 ! For up2 and vp2 [m^2/s] + + real( kind = core_rknd ), dimension(gr%nz) :: & + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + wprtp_zt, & ! w'r_t' interpolated to thermodynamic levels [(kg/kg) m/s] + wpthlp_zt ! w'th_l' interpolated to thermodyamnic levels [K m/s] + + real( kind = core_rknd ), dimension(gr%nz) :: & + rtpthlp_chnge ! Net change in r_t'th_l' due to clipping [(kg/kg) K] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & + sclrprtp_chnge, & ! Net change in sclr'r_t' due to clipping [{units vary}] + sclrpthlp_chnge ! Net change in sclr'th_l' due to clipping [{units vary}] + + real( kind = core_rknd ), dimension(gr%nz) :: & + sclrp2_forcing, & ! forcing (momentum levels) [units vary] + sclrprtp_forcing, & ! forcing (momentum levels) [units vary] + sclrpthlp_forcing ! forcing (momentum levels) [units vary] + + logical :: l_scalar_calc, l_first_clip_ts, l_last_clip_ts + + ! Loop indices + integer :: i, k + + !---------------------------- Begin Code ---------------------------------- + + if ( clubb_at_least_debug_level( 2 ) ) then + ! Assertion check for C5 + if ( C5 > one .or. C5 < zero ) then + write(fstderr,*) "The C5 variable is outside the valid range" + err_code = clubb_var_out_of_range + return + end if + end if + + if ( l_single_C2_Skw ) then + ! Use a single value of C2 for all equations. + C2rt_1d(1:gr%nz) & + = C2b + (C2-C2b) *exp( -one_half * (Skw_zm(1:gr%nz)/C2c)**2 ) + + C2thl_1d = C2rt_1d + C2rtthl_1d = C2rt_1d + + C2sclr_1d = C2rt_1d + else + ! Use 3 different values of C2 for rtp2, thlp2, rtpthlp. + C2rt_1d(1:gr%nz) = C2rt + C2thl_1d(1:gr%nz) = C2thl + C2rtthl_1d(1:gr%nz) = C2rtthl + + C2sclr_1d(1:gr%nz) = C2rt ! Use rt value for now + end if + + ! Combine C4 and C14 for simplicity + C4_C14_1d(1:gr%nz) = ( two_thirds * C4 ) + ( one_third * C14 ) + + ! Are we solving for passive scalars as well? + if ( sclr_dim > 0 ) then + l_scalar_calc = .true. + else + l_scalar_calc = .false. + end if + + + ! Define a_1 (located on momentum levels). + ! It is a variable that is a function of sigma_sqd_w (where sigma_sqd_w is + ! located on the momentum levels). + a1(1:gr%nz) = one / ( one - sigma_sqd_w(1:gr%nz) ) + + + ! Interpolate a_1, w'r_t', w'th_l', u'w', and v'w' from the momentum levels + ! to the thermodynamic levels. These will be used for the turbulent + ! advection (ta) terms in each equation. + a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity + wprtp_zt = zm2zt( wprtp ) + wpthlp_zt = zm2zt( wpthlp ) + upwp_zt = zm2zt( upwp ) + vpwp_zt = zm2zt( vpwp ) + + ! Initialize tridiagonal solutions to valid + + err_code_array(:) = clubb_no_error + + + ! Define the Coefficent of Eddy Diffusivity for the variances + ! and covariances. + do k = 1, gr%nz, 1 + + ! Kw2 is used for variances and covariances rtp2, thlp2, rtpthlp, and + ! passive scalars. The variances and covariances are located on the + ! momentum levels. Kw2 is located on the thermodynamic levels. + ! Kw2 = c_K2 * Kh_zt + Kw2(k) = c_K2 * Kh_zt(k) + + ! Kw9 is used for variances up2 and vp2. The variances are located on + ! the momentum levels. Kw9 is located on the thermodynamic levels. + ! Kw9 = c_K9 * Kh_zt + Kw9(k) = c_K9 * Kh_zt(k) + + enddo + + !!!!!***** r_t'^2 *****!!!!! + + ! Implicit contributions to term rtp2 + call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) + a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) + C2rt_1d, nu2_vert_res_dep, beta, & ! Intent(in) + lhs ) ! Intent(out) + + + call xp2_xpyp_rhs( xp2_xpyp_rtp2, dt, l_iter, a1, a1_zt, & ! Intent(in) + wp2_zt, wprtp, wprtp_zt, wp3_on_wp2, & ! Intent(in) + wp3_on_wp2_zt, wprtp, wprtp_zt, & ! Intent(in) + rtm, rtm, rtp2, rtp2_forcing, & ! Intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) + C2rt_1d, tau_zm, rt_tol**2, beta, & ! Intent(in) + rhs ) ! Intent(out) + + ! Solve the tridiagonal system + call xp2_xpyp_solve( xp2_xpyp_rtp2, 1, & ! Intent(in) + rhs, lhs, rtp2, & ! Intent(inout) + err_code_array(1) ) ! Intent(out) + + if ( l_stats_samp ) then + call xp2_xpyp_implicit_stats( xp2_xpyp_rtp2, rtp2 ) ! Intent(in) + end if + + !!!!!***** th_l'^2 *****!!!!! + + ! Implicit contributions to term thlp2 + call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) + a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) + C2thl_1d, nu2_vert_res_dep, beta, & ! Intent(in) + lhs ) ! Intent(out) + + ! Explicit contributions to thlp2 + call xp2_xpyp_rhs( xp2_xpyp_thlp2, dt, l_iter, a1, a1_zt, & ! Intent(in) + wp2_zt, wpthlp, wpthlp_zt, wp3_on_wp2, & ! Intent(in) + wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! Intent(in) + thlm, thlm, thlp2, thlp2_forcing, & ! Intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) + C2thl_1d, tau_zm, thl_tol**2, beta, & ! Intent(in) + rhs ) ! Intent(out) + + ! Solve the tridiagonal system + call xp2_xpyp_solve( xp2_xpyp_thlp2, 1, & ! Intent(in) + rhs, lhs, thlp2, & ! Intent(inout) + err_code_array(2) ) ! Intent(out) + + if ( l_stats_samp ) then + call xp2_xpyp_implicit_stats( xp2_xpyp_thlp2, thlp2 ) ! Intent(in) + end if + + + !!!!!***** r_t'th_l' *****!!!!! + + ! Implicit contributions to term rtpthlp + call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) + a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) + C2rtthl_1d, nu2_vert_res_dep, beta, & ! Intent(in) + lhs ) ! Intent(out) + + ! Explicit contributions to rtpthlp + call xp2_xpyp_rhs( xp2_xpyp_rtpthlp, dt, l_iter, a1, a1_zt, & ! Intent(in) + wp2_zt, wprtp, wprtp_zt, wp3_on_wp2, & ! Intent(in) + wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! Intent(in) + rtm, thlm, rtpthlp, rtpthlp_forcing, & ! Intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) + C2rtthl_1d, tau_zm, zero_threshold, beta, & ! Intent(in) + rhs ) ! Intent(out) + + ! Solve the tridiagonal system + call xp2_xpyp_solve( xp2_xpyp_rtpthlp, 1, & ! Intent(in) + rhs, lhs, rtpthlp, & ! Intent(inout) + err_code_array(3) ) ! Intent(out) + + if ( l_stats_samp ) then + call xp2_xpyp_implicit_stats( xp2_xpyp_rtpthlp, rtpthlp ) ! Intent(in) + end if + + + !!!!!***** u'^2 / v'^2 *****!!!!! + + ! Implicit contributions to term up2/vp2 + call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) + a1, a1_zt, tau_zm, wm_zm, Kw9, & ! Intent(in) + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) + C4_C14_1d, nu9_vert_res_dep, beta, & ! Intent(in) + lhs ) ! Intent(out) + + ! Explicit contributions to up2 + call xp2_xpyp_uv_rhs( xp2_xpyp_up2, dt, l_iter, a1, a1_zt, wp2, & ! Intent(in) + wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & ! Intent(in) + wp3_on_wp2, C4_C14_1d, tau_zm, & ! Intent(in) + um, vm, upwp, upwp_zt, vpwp, vpwp_zt, & ! Intent(in) + up2, vp2, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) + rho_ds_zm, & ! Intent(in) + thv_ds_zm, C4, C5, C14, beta, & ! Intent(in) + uv_rhs(:,1) ) ! Intent(out) + + ! Explicit contributions to vp2 + call xp2_xpyp_uv_rhs( xp2_xpyp_vp2, dt, l_iter, a1, a1_zt, wp2, & ! Intent(in) + wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & ! Intent(in) + wp3_on_wp2, C4_C14_1d, tau_zm, & ! Intent(in) + vm, um, vpwp, vpwp_zt, upwp, upwp_zt, & ! Intent(in) + vp2, up2, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) + rho_ds_zm, & ! Intent(in) + thv_ds_zm, C4, C5, C14, beta, & ! Intent(in) + uv_rhs(:,2) ) ! Intent(out) + + ! Solve the tridiagonal system + call xp2_xpyp_solve( xp2_xpyp_up2_vp2, 2, & ! Intent(in) + uv_rhs, lhs, & ! Intent(inout) + uv_solution, err_code_array(4) ) ! Intent(out) + + up2(1:gr%nz) = uv_solution(1:gr%nz,1) + vp2(1:gr%nz) = uv_solution(1:gr%nz,2) + + if ( l_stats_samp ) then + call xp2_xpyp_implicit_stats( xp2_xpyp_up2, up2 ) ! Intent(in) + call xp2_xpyp_implicit_stats( xp2_xpyp_vp2, vp2 ) ! Intent(in) + end if + + + ! Apply the positive definite scheme to variances + if ( l_hole_fill ) then + call pos_definite_variances( xp2_xpyp_rtp2, dt, rt_tol**2, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + rtp2 ) ! Intent(inout) + call pos_definite_variances( xp2_xpyp_thlp2, dt, thl_tol**2, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + thlp2 ) ! Intent(inout) + call pos_definite_variances( xp2_xpyp_up2, dt, w_tol_sqd, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + up2 ) ! Intent(inout) + call pos_definite_variances( xp2_xpyp_vp2, dt, w_tol_sqd, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + vp2 ) ! Intent(inout) + endif + + + ! Clipping for r_t'^2 + + !threshold = zero_threshold + ! + !where ( wp2 >= w_tol_sqd ) & + ! threshold = rt_tol*rt_tol + + threshold = rt_tol**2 + + call clip_variance( xp2_xpyp_rtp2, dt, threshold, & ! Intent(in) + rtp2 ) ! Intent(inout) + + ! Special clipping on the variance of rt to prevent a large variance at + ! higher altitudes. This is done because we don't want the PDF to extend + ! into the negative, and found that for latin hypercube sampling a large + ! variance aloft leads to negative samples of total water. + ! -dschanen 8 Dec 2010 + if ( l_clip_large_rtp2 ) then + + ! This overwrites stats clipping data from clip_variance + if ( l_stats_samp ) then + call stat_modify( irtp2_cl, -rtp2 / real( dt, kind = core_rknd ), zm ) + endif + + do k = 1, gr%nz + threshold = rtp2_clip_coef * rtm(k)**2 + if ( rtp2(k) > threshold ) then + rtp2(k) = threshold + end if + end do ! k = 1..gr%nz + + if ( l_stats_samp ) then + call stat_modify( irtp2_cl, rtp2 / real( dt, kind = core_rknd ), zm ) + endif + + end if ! l_clip_large_rtp2 + + + + ! Clipping for th_l'^2 + + !threshold = zero_threshold + ! + !where ( wp2 >= w_tol_sqd ) & + ! threshold = thl_tol*thl_tol + + threshold = thl_tol**2 + + call clip_variance( xp2_xpyp_thlp2, dt, threshold, & ! Intent(in) + thlp2 ) ! Intent(inout) + + + ! Clipping for u'^2 + + !threshold = zero_threshold + threshold = w_tol_sqd + + call clip_variance( xp2_xpyp_up2, dt, threshold, & ! Intent(in) + up2 ) ! Intent(inout) + + + ! Clipping for v'^2 + + !threshold = zero_threshold + threshold = w_tol_sqd + + call clip_variance( xp2_xpyp_vp2, dt, threshold, & ! Intent(in) + vp2 ) ! Intent(inout) + + + ! Clipping for r_t'th_l' + ! Clipping r_t'th_l' at each vertical level, based on the + ! correlation of r_t and th_l at each vertical level, such that: + ! corr_(r_t,th_l) = r_t'th_l' / [ sqrt(r_t'^2) * sqrt(th_l'^2) ]; + ! -1 <= corr_(r_t,th_l) <= 1. + ! Since r_t'^2, th_l'^2, and r_t'th_l' are all computed in the + ! same place, clipping for r_t'th_l' only has to be done once. + l_first_clip_ts = .true. + l_last_clip_ts = .true. + call clip_covar( xp2_xpyp_rtpthlp, l_first_clip_ts, & ! Intent(in) + l_last_clip_ts, dt, rtp2, thlp2, & ! Intent(in) + rtpthlp, rtpthlp_chnge ) ! Intent(inout) + + if ( l_scalar_calc ) then + + ! Implicit contributions to passive scalars + + !!!!!***** sclr'^2, sclr'r_t', sclr'th_l' *****!!!!! + + call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) + a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) + C2sclr_1d, nu2_vert_res_dep, beta, & ! Intent(in) + lhs ) ! Intent(out) + + + ! Explicit contributions to passive scalars + + do i = 1, sclr_dim, 1 + + ! Interpolate w'sclr' from momentum levels to thermodynamic + ! levels. These will be used for the turbulent advection (ta) + ! terms in each equation. + wpsclrp_zt = zm2zt( wpsclrp(:,i) ) + + ! Forcing for . + sclrp2_forcing = zero + + !!!!!***** sclr'^2 *****!!!!! + + call xp2_xpyp_rhs( xp2_xpyp_sclrp2, dt, l_iter, a1, a1_zt, & ! In + wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In + wp3_on_wp2_zt, wpsclrp(:,i), wpsclrp_zt, & ! In + sclrm(:,i), sclrm(:,i), sclrp2(:,i), sclrp2_forcing, & ! In + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In + C2sclr_1d, tau_zm, sclr_tol(i)**2, beta, & ! In + sclr_rhs(:,i) ) ! Out + + + !!!!!***** sclr'r_t' *****!!!!! + if ( i == iisclr_rt ) then + ! In this case we're trying to emulate rt'^2 with sclr'rt', so we + ! handle this as we would a variance, even though generally speaking + ! the scalar is not rt + sclrprtp_forcing = rtp2_forcing + threshold = rt_tol**2 + else + sclrprtp_forcing = zero + threshold = zero_threshold + endif + + call xp2_xpyp_rhs( xp2_xpyp_sclrprtp, dt, l_iter, a1, a1_zt, & ! In + wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In + wp3_on_wp2_zt, wprtp, wprtp_zt, & ! In + sclrm(:,i), rtm, sclrprtp(:,i), sclrprtp_forcing, & ! In + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In + C2sclr_1d, tau_zm, threshold, beta, & ! In + sclr_rhs(:,i+sclr_dim) ) ! Out + + + !!!!!***** sclr'th_l' *****!!!!! + + if ( i == iisclr_thl ) then + ! In this case we're trying to emulate thl'^2 with sclr'thl', so we + ! handle this as we did with sclr_rt, above. + sclrpthlp_forcing = thlp2_forcing + threshold = thl_tol**2 + else + sclrpthlp_forcing = zero + threshold = zero_threshold + endif + + call xp2_xpyp_rhs( xp2_xpyp_sclrpthlp, dt, l_iter, a1, a1_zt, & ! In + wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In + wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! In + sclrm(:,i), thlm, sclrpthlp(:,i), sclrpthlp_forcing, & ! In + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In + C2sclr_1d, tau_zm, threshold, beta, & ! In + sclr_rhs(:,i+2*sclr_dim) ) ! Out + + + enddo ! 1..sclr_dim + + + ! Solve the tridiagonal system + + call xp2_xpyp_solve( xp2_xpyp_scalars, 3*sclr_dim, & ! Intent(in) + sclr_rhs, lhs, sclr_solution, & ! Intent(inout) + err_code_array(6) ) ! Intent(out) + + sclrp2(:,1:sclr_dim) = sclr_solution(:,1:sclr_dim) + + sclrprtp(:,1:sclr_dim) = sclr_solution(:,sclr_dim+1:2*sclr_dim) + + sclrpthlp(:,1:sclr_dim) = sclr_solution(:,2*sclr_dim+1:3*sclr_dim) + + ! Apply hole filling algorithm to the scalar variance terms + if ( l_hole_fill ) then + do i = 1, sclr_dim, 1 + call pos_definite_variances( xp2_xpyp_sclrp2, dt, sclr_tol(i)**2, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + sclrp2(:,i) ) ! Intent(inout) + if ( i == iisclr_rt ) then + ! Here again, we do this kluge here to make sclr'rt' == rt'^2 + call pos_definite_variances( xp2_xpyp_sclrprtp, dt, sclr_tol(i)**2, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + sclrprtp(:,i) ) ! Intent(inout) + end if + if ( i == iisclr_thl ) then + ! As with sclr'rt' above, but for sclr'thl' + call pos_definite_variances( xp2_xpyp_sclrpthlp, dt, sclr_tol(i)**2, & ! Intent(in) + rho_ds_zm, rho_ds_zt, & ! Intent(in) + sclrpthlp(:,i) ) ! Intent(inout) + end if + enddo + endif + + + ! Clipping for sclr'^2 + do i = 1, sclr_dim, 1 + +! threshold = zero_threshold +! +! where ( wp2 >= w_tol_sqd ) & +! threshold = sclr_tol(i)*sclr_tol(i) + + threshold = sclr_tol(i)**2 + + call clip_variance( clip_sclrp2, dt, threshold, & ! Intent(in) + sclrp2(:,i) ) ! Intent(inout) + + enddo + + + ! Clipping for sclr'r_t' + ! Clipping sclr'r_t' at each vertical level, based on the + ! correlation of sclr and r_t at each vertical level, such that: + ! corr_(sclr,r_t) = sclr'r_t' / [ sqrt(sclr'^2) * sqrt(r_t'^2) ]; + ! -1 <= corr_(sclr,r_t) <= 1. + ! Since sclr'^2, r_t'^2, and sclr'r_t' are all computed in the + ! same place, clipping for sclr'r_t' only has to be done once. + do i = 1, sclr_dim, 1 + + if ( i == iisclr_rt ) then + ! Treat this like a variance if we're emulating rt + threshold = sclr_tol(i) * rt_tol + + call clip_variance( clip_sclrprtp, dt, threshold, & ! Intent(in) + sclrprtp(:,i) ) ! Intent(inout) + else + l_first_clip_ts = .true. + l_last_clip_ts = .true. + call clip_covar( clip_sclrprtp, l_first_clip_ts, & ! Intent(in) + l_last_clip_ts, dt, sclrp2(:,i), rtp2(:), & ! Intent(in) + sclrprtp(:,i), sclrprtp_chnge(:,i) ) ! Intent(inout) + end if + enddo + + + ! Clipping for sclr'th_l' + ! Clipping sclr'th_l' at each vertical level, based on the + ! correlation of sclr and th_l at each vertical level, such that: + ! corr_(sclr,th_l) = sclr'th_l' / [ sqrt(sclr'^2) * sqrt(th_l'^2) ]; + ! -1 <= corr_(sclr,th_l) <= 1. + ! Since sclr'^2, th_l'^2, and sclr'th_l' are all computed in the + ! same place, clipping for sclr'th_l' only has to be done once. + do i = 1, sclr_dim, 1 + if ( i == iisclr_thl ) then + ! As above, but for thl + threshold = sclr_tol(i) * thl_tol + call clip_variance( clip_sclrpthlp, dt, threshold, & ! Intent(in) + sclrpthlp(:,i) ) ! Intent(inout) + else + l_first_clip_ts = .true. + l_last_clip_ts = .true. + call clip_covar( clip_sclrpthlp, l_first_clip_ts, & ! Intent(in) + l_last_clip_ts, dt, sclrp2(:,i), thlp2(:), & ! Intent(in) + sclrpthlp(:,i), sclrpthlp_chnge(:,i) ) ! Intent(inout) + end if + enddo + + endif ! l_scalar_calc + + + ! Check for singular matrices and bad LAPACK arguments + if ( any( fatal_error( err_code_array ) ) ) then + err_code = clubb_singular_matrix + end if + + if ( fatal_error( err_code ) .and. & + clubb_at_least_debug_level( 1 ) ) then + + write(fstderr,*) "Error in advance_xp2_xpyp" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "tau_zm = ", tau_zm + write(fstderr,*) "wm_zm = ", wm_zm + write(fstderr,*) "rtm = ", rtm + write(fstderr,*) "wprtp = ", wprtp + write(fstderr,*) "thlm = ", thlm + write(fstderr,*) "wpthlp = ", wpthlp + write(fstderr,*) "wpthvp = ", wpthvp + write(fstderr,*) "um = ", um + write(fstderr,*) "vm = ", vm + write(fstderr,*) "wp2 = ", wp2 + write(fstderr,*) "wp3 = ", wp3 + write(fstderr,*) "upwp = ", upwp + write(fstderr,*) "vpwp = ", vpwp + write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w + write(fstderr,*) "Skw_zm = ", Skw_zm + write(fstderr,*) "Kh_zt = ", Kh_zt + write(fstderr,*) "rtp2_forcing = ", rtp2_forcing + write(fstderr,*) "thlp2_forcing = ", thlp2_forcing + write(fstderr,*) "rtpthlp_forcing = ", rtpthlp_forcing + write(fstderr,*) "rho_ds_zm = ", rho_ds_zm + write(fstderr,*) "rho_ds_zt = ", rho_ds_zt + write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm + write(fstderr,*) "thv_ds_zm = ", thv_ds_zm + write(fstderr,*) "wp2_zt = ", wp2_zt + + do i = 1, sclr_dim + write(fstderr,*) "sclrm = ", i, sclrm(:,i) + write(fstderr,*) "wpsclrp = ", i, wpsclrp(:,i) + enddo + + write(fstderr,*) "Intent(In/Out)" + + write(fstderr,*) "rtp2 = ", rtp2 + write(fstderr,*) "thlp2 = ", thlp2 + write(fstderr,*) "rtpthlp = ", rtpthlp + write(fstderr,*) "up2 = ", up2 + write(fstderr,*) "vp2 = ", vp2 + + do i = 1, sclr_dim + write(fstderr,*) "sclrp2 = ", i, sclrp2(:,i) + write(fstderr,*) "sclrprtp = ", i, sclrprtp(:,i) + write(fstderr,*) "sclrthlp = ", i, sclrpthlp(:,i) + enddo + + endif + + return + end subroutine advance_xp2_xpyp + + !============================================================================= + subroutine xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & + a1, a1_zt, tau_zm, wm_zm, Kw, & + rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & + Cn, nu, beta, lhs ) + + ! Description: + ! Compute LHS tridiagonal matrix for a variance or covariance term + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + gamma_over_implicit_ts, & ! Constant(s) + one, & + zero + + use crmx_model_flags, only: & + l_upwind_xpyp_ta ! Constant(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_diffusion, only: & + diffusion_zm_lhs ! Procedure(s) + + use crmx_mean_adv, only: & + term_ma_zm_lhs ! Procedure(s) + + use crmx_stats_variables, only: & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + l_stats_samp, & + irtp2_ma, & + irtp2_ta, & + irtp2_dp1, & + irtp2_dp2, & + ithlp2_ma, & + ithlp2_ta, & + ithlp2_dp1, & + ithlp2_dp2, & + irtpthlp_ma, & + irtpthlp_ta, & + irtpthlp_dp1, & + irtpthlp_dp2, & + iup2_ma, & + iup2_ta, & + iup2_dp2, & + ivp2_ma, & + ivp2_ta, & + ivp2_dp2 + + use crmx_advance_helper_module, only: set_boundary_conditions_lhs + + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep length [s] + + logical, intent(in) :: & + l_iter ! Whether the variances are prognostic (T/F) + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp3_on_wp2, & ! Smoothed w'^3 / w'^2 (moment. levels) [m/s] + wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 (thermo. levels) [m/s] + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + tau_zm, & ! Time-scale tau on momentum levels [s] + wm_zm, & ! w wind component on momentum levels [m/s] + Kw, & ! Coefficient of eddy diffusivity (all vars.) [m^2/s] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] + Cn ! Coefficient C_n [-] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + nu ! Background constant coef. of eddy diff. [-] + real( kind = core_rknd ), intent(in) :: & + beta ! Constant model parameter beta [-] + + ! Output Variables + real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & + lhs ! Implicit contributions to the term + + ! Local Variables + + ! Array indices + integer :: k, kp1, km1, low_bound, high_bound + + real( kind = core_rknd ), dimension(3) :: & + tmp + + ! Initialize LHS matrix to 0. + lhs = zero + + ! Setup LHS of the tridiagonal system + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! LHS mean advection (ma) term. + lhs(kp1_mdiag:km1_mdiag,k) & + = lhs(kp1_mdiag:km1_mdiag,k) & + + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + + ! LHS turbulent advection (ta) term. + ! Note: An "over-implicit" weighted time step is applied to this term. + ! The weight of the implicit portion of this term is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (x'^2 or x'y' in this case), y(t) is the linearized + ! portion of the term that gets treated implicitly, and RHS is the + ! portion of the term that is always treated explicitly. A weight + ! of greater than 1 can be applied to make the term more + ! numerically stable. + if ( .not. l_upwind_xpyp_ta ) then + lhs(kp1_mdiag:km1_mdiag,k) & + = lhs(kp1_mdiag:km1_mdiag,k) & + + gamma_over_implicit_ts & + * term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else + lhs(kp1_mdiag:km1_mdiag,k) & + = lhs(kp1_mdiag:km1_mdiag,k) & + + gamma_over_implicit_ts & + * term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + end if + + ! LHS dissipation term 1 (dp1) + ! (combined with pressure term 1 (pr1) for u'^2 and v'^2). + ! Note: An "over-implicit" weighted time step is applied to this term + ! (and to pressure term 1 for u'^2 and v'^2). + lhs(k_mdiag,k) & + = lhs(k_mdiag,k) & + + gamma_over_implicit_ts & + * term_dp1_lhs( Cn(k), tau_zm(k) ) + + ! LHS eddy diffusion term: dissipation term 2 (dp2). + lhs(kp1_mdiag:km1_mdiag,k) & + = lhs(kp1_mdiag:km1_mdiag,k) & + + diffusion_zm_lhs( Kw(k), Kw(kp1), nu, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + + ! LHS time tendency. + if ( l_iter ) then + lhs(k_mdiag,k) = lhs(k_mdiag,k) + ( one / real( dt, kind = core_rknd ) ) + endif + + if ( l_stats_samp ) then + + ! Statistics: implicit contributions for rtp2, thlp2, + ! rtpthlp, up2, or vp2. + + if ( irtp2_dp1 + ithlp2_dp1 + irtpthlp_dp1 > 0 ) then + ! Note: The statistical implicit contribution to term dp1 + ! (as well as to term pr1) for up2 and vp2 is recorded + ! in xp2_xpyp_uv_rhs because up2 and vp2 use a special + ! dp1/pr1 combined term. + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note above for + ! LHS turbulent advection (ta) term). + tmp(1) & + = gamma_over_implicit_ts & + * term_dp1_lhs( Cn(k), tau_zm(k) ) + zmscr01(k) = -tmp(1) + endif + + if ( irtp2_dp2 + ithlp2_dp2 + irtpthlp_dp2 + & + iup2_dp2 + ivp2_dp2 > 0 ) then + tmp(1:3) & + = diffusion_zm_lhs( Kw(k), Kw(kp1), nu, & + gr%invrs_dzt(kp1), gr%invrs_dzt(k), & + gr%invrs_dzm(k), k ) + zmscr02(k) = -tmp(3) + zmscr03(k) = -tmp(2) + zmscr04(k) = -tmp(1) + endif + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for LHS turbulent + ! advection (ta) term). + if ( irtp2_ta + ithlp2_ta + irtpthlp_ta + & + iup2_ta + ivp2_ta > 0 ) then + if ( .not. l_upwind_xpyp_ta ) then + tmp(1:3) & + = gamma_over_implicit_ts & + * term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else + tmp(1:3) & + = gamma_over_implicit_ts & + * term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + end if + + zmscr05(k) = -tmp(3) + zmscr06(k) = -tmp(2) + zmscr07(k) = -tmp(1) + endif + + if ( irtp2_ma + ithlp2_ma + irtpthlp_ma + & + iup2_ma + ivp2_ma > 0 ) then + tmp(1:3) & + = term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) + zmscr08(k) = -tmp(3) + zmscr09(k) = -tmp(2) + zmscr10(k) = -tmp(1) + endif + + endif ! l_stats_samp + + enddo ! k=2..gr%nz-1 + + + ! Boundary Conditions + ! These are set so that the surface_varnce value of the variances and + ! covariances can be used at the lowest boundary and the values of those + ! variables can be set to their respective threshold minimum values at the + ! top boundary. Fixed-point boundary conditions are used for both the + ! variances and the covariances. + low_bound = 1 + high_bound = gr%nz + + call set_boundary_conditions_lhs( k_mdiag, low_bound, high_bound, lhs ) + + return + + end subroutine xp2_xpyp_lhs + + !============================================================================= + subroutine xp2_xpyp_solve( solve_type, nrhs, rhs, lhs, xapxbp, err_code ) + + ! Description: + ! Solve a tridiagonal system + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + one ! Constant(s) + + use crmx_lapack_wrap, only: & + tridag_solve, & ! Variable(s) + tridag_solvex !, & +! band_solve + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_stats_type, only: & + stat_update_var_pt ! Procedure(s) + + use crmx_stats_variables, only: & + sfc, & ! Derived type + irtp2_matrix_condt_num, & ! Stat index Variables + ithlp2_matrix_condt_num, & + irtpthlp_matrix_condt_num, & + iup2_vp2_matrix_condt_num, & + l_stats_samp ! Logical + + use crmx_error_code, only: & + clubb_no_error ! Constant + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: trim + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + ! Input variables + integer, intent(in) :: & + nrhs ! Number of right hand side vectors + + integer, intent(in) :: & + solve_type ! Variable(s) description + + ! Input/Ouput variables + real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(inout) :: & + rhs ! Explicit contributions to x variance/covariance term [units vary] + + real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & + lhs ! Implicit contributions to x variance/covariance term [units vary] + + ! Output Variables + real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(out) :: & + xapxbp ! Computed value of the variable(s) at [units vary] + + integer, intent(out) :: & + err_code ! Returns an error code in the event of a singular matrix + + ! Local variables + real( kind = core_rknd ) :: rcond ! Est. of the reciprocal of the condition # on the matrix + + integer :: ixapxbp_matrix_condt_num ! Stat index + + character(len=10) :: & + solve_type_str ! solve_type in string format for debug output purposes + + ! --- Begin Code --- + err_code = clubb_no_error ! Initialize to the value for no errors + + select case ( solve_type ) + !------------------------------------------------------------------------ + ! Note that these are diagnostics from inverting the matrix, not a budget + !------------------------------------------------------------------------ + case ( xp2_xpyp_rtp2 ) + ixapxbp_matrix_condt_num = irtp2_matrix_condt_num + solve_type_str = "rtp2" + case ( xp2_xpyp_thlp2 ) + ixapxbp_matrix_condt_num = ithlp2_matrix_condt_num + solve_type_str = "thlp2" + case ( xp2_xpyp_rtpthlp ) + ixapxbp_matrix_condt_num = irtpthlp_matrix_condt_num + solve_type_str = "rtpthlp" + case ( xp2_xpyp_up2_vp2 ) + ixapxbp_matrix_condt_num = iup2_vp2_matrix_condt_num + solve_type_str = "up2_vp2" + case default + ! No condition number is setup for the passive scalars + ixapxbp_matrix_condt_num = 0 + solve_type_str = "scalar" + end select + + if ( l_stats_samp .and. ixapxbp_matrix_condt_num > 0 ) then + call tridag_solvex & + ( solve_type_str, gr%nz, nrhs, & ! Intent(in) + lhs(kp1_mdiag,:), lhs(k_mdiag,:), lhs(km1_mdiag,:), rhs(:,1:nrhs), & ! Intent(inout) + xapxbp(:,1:nrhs), rcond, err_code ) ! Intent(out) + + ! Est. of the condition number of the variance LHS matrix + call stat_update_var_pt( ixapxbp_matrix_condt_num, 1, one / rcond, & ! Intent(in) + sfc ) ! Intent(inout) + + else + call tridag_solve & + ( solve_type_str, gr%nz, nrhs, lhs(kp1_mdiag,:), & ! Intent(in) + lhs(k_mdiag,:), lhs(km1_mdiag,:), rhs(:,1:nrhs), & ! Intent(inout) + xapxbp(:,1:nrhs), err_code ) ! Intent(out) + end if + + return + end subroutine xp2_xpyp_solve + + !============================================================================= + subroutine xp2_xpyp_implicit_stats( solve_type, xapxbp ) + + ! Description: + ! Finalize implicit contributions for r_t'^2, th_l'^2, r_t'th_l', + ! u'^2, and v'^2. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Derived type variable + + use crmx_stats_type, only: & + stat_end_update_pt, & ! Procedure(s) + stat_update_var_pt + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + irtp2_dp1, & + irtp2_dp2, & + irtp2_ta, & + irtp2_ma, & + ithlp2_dp1, & + ithlp2_dp2, & + ithlp2_ta, & + ithlp2_ma, & + irtpthlp_dp1, & + irtpthlp_dp2, & + irtpthlp_ta, & + irtpthlp_ma, & + iup2_dp1, & + iup2_dp2, & + iup2_ta, & + iup2_ma, & + iup2_pr1, & + ivp2_dp1 + + use crmx_stats_variables, only: & + ivp2_dp2, & + ivp2_ta, & + ivp2_ma, & + ivp2_pr1, & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11 + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: max, min, trim + + ! Input variables + integer, intent(in) :: & + solve_type ! Variable(s) description + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xapxbp ! Computed value of the variable at [units vary] + + ! Local variables + integer :: k, kp1, km1 ! Array indices + + ! Budget indices + integer :: & + ixapxbp_dp1, & + ixapxbp_dp2, & + ixapxbp_ta, & + ixapxbp_ma, & + ixapxbp_pr1 + + ! --- Begin Code --- + + select case ( solve_type ) + case ( xp2_xpyp_rtp2 ) + ixapxbp_dp1 = irtp2_dp1 + ixapxbp_dp2 = irtp2_dp2 + ixapxbp_ta = irtp2_ta + ixapxbp_ma = irtp2_ma + ixapxbp_pr1 = 0 + + case ( xp2_xpyp_thlp2 ) + ixapxbp_dp1 = ithlp2_dp1 + ixapxbp_dp2 = ithlp2_dp2 + ixapxbp_ta = ithlp2_ta + ixapxbp_ma = ithlp2_ma + ixapxbp_pr1 = 0 + + case ( xp2_xpyp_rtpthlp ) + ixapxbp_dp1 = irtpthlp_dp1 + ixapxbp_dp2 = irtpthlp_dp2 + ixapxbp_ta = irtpthlp_ta + ixapxbp_ma = irtpthlp_ma + ixapxbp_pr1 = 0 + + case ( xp2_xpyp_up2 ) + ixapxbp_dp1 = iup2_dp1 + ixapxbp_dp2 = iup2_dp2 + ixapxbp_ta = iup2_ta + ixapxbp_ma = iup2_ma + ixapxbp_pr1 = iup2_pr1 + + case ( xp2_xpyp_vp2 ) + ixapxbp_dp1 = ivp2_dp1 + ixapxbp_dp2 = ivp2_dp2 + ixapxbp_ta = ivp2_ta + ixapxbp_ma = ivp2_ma + ixapxbp_pr1 = ivp2_pr1 + + case default ! No budgets are setup for the passive scalars + ixapxbp_dp1 = 0 + ixapxbp_dp2 = 0 + ixapxbp_ta = 0 + ixapxbp_ma = 0 + ixapxbp_pr1 = 0 + + end select + + do k = 2, gr%nz-1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! x'y' term dp1 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( ixapxbp_dp1, k, & ! Intent(in) + zmscr01(k) * xapxbp(k), & ! Intent(in) + zm ) ! Intent(inout) + + ! x'y' term dp2 is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_dp2, k, & ! Intent(in) + zmscr02(k) * xapxbp(km1) & ! Intent(in) + + zmscr03(k) * xapxbp(k) & + + zmscr04(k) * xapxbp(kp1), & + zm ) ! Intent(inout) + + ! x'y' term ta has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( ixapxbp_ta, k, & ! Intent(in) + zmscr05(k) * xapxbp(km1) & ! Intent(in) + + zmscr06(k) * xapxbp(k) & + + zmscr07(k) * xapxbp(kp1), & + zm ) ! Intent(inout) + + ! x'y' term ma is completely implicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_ma, k, & ! Intent(in) + zmscr08(k) * xapxbp(km1) & ! Intent(in) + + zmscr09(k) * xapxbp(k) & + + zmscr10(k) * xapxbp(kp1), & + zm ) ! Intent(inout) + + ! x'y' term pr1 has both implicit and explicit components; + ! call stat_end_update_pt. + call stat_end_update_pt( ixapxbp_pr1, k, & ! Intent(in) + zmscr11(k) * xapxbp(k), & ! Intent(in) + zm ) ! Intent(inout) + + end do ! k=2..gr%nz-1 + + return + end subroutine xp2_xpyp_implicit_stats + + !============================================================================= + subroutine xp2_xpyp_uv_rhs( solve_type, dt, l_iter, a1, a1_zt, wp2, & + wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & + wp3_on_wp2, C4_C14_1d, tau_zm, & + xam, xbm, wpxap, wpxap_zt, wpxbp, wpxbp_zt, & + xap2, xbp2, rho_ds_zt, invrs_rho_ds_zm, & + rho_ds_zm, & + thv_ds_zm, C4, C5, C14, beta, & + rhs ) + + ! Description: + ! Explicit contributions to u'^2 or v'^2 + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + gamma_over_implicit_ts, & ! Constant(s) + w_tol_sqd, & + one, & + two_thirds, & + one_third, & + zero + + use crmx_model_flags, only: & + l_upwind_xpyp_ta ! Constant(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update_pt, & ! Procedure(s) + stat_update_var_pt, & + stat_modify_pt + + use crmx_stats_variables, only: & + ivp2_ta, & ! Variable(s) + ivp2_tp, & + ivp2_dp1, & + ivp2_pr1, & + ivp2_pr2, & + iup2_ta, & + iup2_tp, & + iup2_dp1, & + iup2_pr1, & + iup2_pr2, & + zm, & + zmscr01, & + zmscr11, & + l_stats_samp + + implicit none + + ! Input Variables + integer, intent(in) :: solve_type + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + logical, intent(in) :: & + l_iter ! Whether x is prognostic (T/F) + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp2_zt, & ! w'^2 interpolated to thermodynamic levels [m^2/s^2] + wpthvp, & ! w'th_v' (momentum levels) [K m/s] + Lscale, & ! Mixing Length [m] + wp3_on_wp2, & ! Smoothed w'^3 / w'^2 on momentum levels [m/s] + wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 on thermo. levels [m/s] + C4_C14_1d, & ! Combination of model params. C_4 and C_14 [-] + tau_zm, & ! Time-scale tau on momentum levels [s] + xam, & ! x_am (thermodynamic levels) [m/s] + xbm, & ! x_bm (thermodynamic levels) [m/s] + wpxap, & ! w'x_a' (momentum levels) [m^2/s^2] + wpxap_zt, & ! w'x_a' interpolated to thermodynamic levels [m^2/s^2] + wpxbp, & ! w'x_b' (momentum levels) [m^2/s^2] + wpxbp_zt, & ! w'x_b' interpolated to thermodynamic levels [m^2/s^2] + xap2, & ! x_a'^2 (momentum levels) [m^2/s^2] + xbp2, & ! x_b'^2 (momentum levels) [m^2/s^2] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] + thv_ds_zm ! Dry, base-state theta_v on momentum levels [K] + + real( kind = core_rknd ), intent(in) :: & + C4, & ! Model parameter C_4 [-] + C5, & ! Model parameter C_5 [-] + C14, & ! Model parameter C_{14} [-] + beta ! Model parameter beta [-] + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz,1), intent(out) :: & + rhs ! Explicit contributions to x variance/covariance terms + + ! Local Variables + + ! Array indices + integer :: k, kp1, km1 + + ! For "over-implicit" weighted time step. + ! This vector holds output from the LHS (implicit) portion of a term at a + ! given vertical level. This output is weighted and applied to the RHS. + ! This is used if the implicit portion of the term is "over-implicit", which + ! means that the LHS contribution is given extra weight (>1) in order to + ! increase numerical stability. A weighted factor must then be applied to + ! the RHS in order to balance the weight. + real( kind = core_rknd ), dimension(3) :: lhs_fnc_output + + real( kind = core_rknd ) :: tmp + + integer :: & + ixapxbp_ta, & + ixapxbp_tp, & + ixapxbp_dp1, & + ixapxbp_pr1, & + ixapxbp_pr2 + + !----------------------------- Begin Code ---------------------------------- + + select case ( solve_type ) + case ( xp2_xpyp_vp2 ) + ixapxbp_ta = ivp2_ta + ixapxbp_tp = ivp2_tp + ixapxbp_dp1 = ivp2_dp1 + ixapxbp_pr1 = ivp2_pr1 + ixapxbp_pr2 = ivp2_pr2 + case ( xp2_xpyp_up2 ) + ixapxbp_ta = iup2_ta + ixapxbp_tp = iup2_tp + ixapxbp_dp1 = iup2_dp1 + ixapxbp_pr1 = iup2_pr1 + ixapxbp_pr2 = iup2_pr2 + case default ! No budgets for passive scalars + ixapxbp_ta = 0 + ixapxbp_tp = 0 + ixapxbp_dp1 = 0 + ixapxbp_pr1 = 0 + ixapxbp_pr2 = 0 + end select + + + ! Initialize RHS vector to 0. + rhs = zero + + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! RHS turbulent advection (ta) term. + rhs(k,1) & + = rhs(k,1) & + + term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & + wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS turbulent advection (ta) term. + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + ! The weight of the implicit portion of this term is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (x'^2 or x'y' in this case), y(t) is the linearized + ! portion of the term that gets treated implicitly, and RHS is the + ! portion of the term that is always treated explicitly. A weight + ! of greater than 1 can be applied to make the term more + ! numerically stable. + if ( .not. l_upwind_xpyp_ta ) then + lhs_fnc_output(1:3) & + = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else + lhs_fnc_output(1:3) & + = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + end if + + rhs(k,1) & + = rhs(k,1) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * xap2(kp1) & + - lhs_fnc_output(2) * xap2(k) & + - lhs_fnc_output(3) * xap2(km1) ) + + ! RHS turbulent production (tp) term. + rhs(k,1) & + = rhs(k,1) & + + ( one - C5 ) & + * term_tp( xam(kp1), xam(k), xam(kp1), xam(k), & + wpxap(k), wpxap(k), gr%invrs_dzm(k) ) + + ! RHS pressure term 1 (pr1) (and dissipation term 1 (dp1)). + rhs(k,1) & + = rhs(k,1) & + + term_pr1( C4, C14, xbp2(k), wp2(k), tau_zm(k) ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS dissipation term 1 (dp1) and pressure term 1 (pr1). + ! + ! Note: An "over-implicit" weighted time step is applied to these terms. + lhs_fnc_output(1) & + = term_dp1_lhs( C4_C14_1d(k), tau_zm(k) ) + rhs(k,1) & + = rhs(k,1) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * xap2(k) ) + + ! RHS pressure term 2 (pr2). + rhs(k,1) & + = rhs(k,1) & + + term_pr2( C5, thv_ds_zm(k), wpthvp(k), wpxap(k), wpxbp(k), & + xam, xbm, gr%invrs_dzm(k), kp1, k, & + Lscale(kp1), Lscale(k), wp2_zt(kp1), wp2_zt(k) ) + + ! RHS time tendency. + if ( l_iter ) then + rhs(k,1) = rhs(k,1) + one/real( dt, kind = core_rknd ) * xap2(k) + endif + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for up2 or vp2. + + ! x'y' term ta has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on term_ta_rhs. + call stat_begin_update_pt( ixapxbp_ta, k, & ! Intent(in) + -term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & ! Intent(in) + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & + wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ), & + zm ) ! Intent(inout) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) term). + if ( .not. l_upwind_xpyp_ta ) then + lhs_fnc_output(1:3) & + = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else ! turbulent advection is using an upwind discretization + lhs_fnc_output(1:3) & + = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + end if ! ~l_upwind_xpyp_ta + + call stat_modify_pt( ixapxbp_ta, k, & ! Intent(in) + + ( one - gamma_over_implicit_ts ) & ! Intent(in) + * ( - lhs_fnc_output(1) * xap2(kp1) & + - lhs_fnc_output(2) * xap2(k) & + - lhs_fnc_output(3) * xap2(km1) ), & + zm ) ! Intent(inout) + + if ( ixapxbp_dp1 > 0 ) then + ! Note: The function term_pr1 is the explicit component of a + ! semi-implicit solution to dp1 and pr1. + ! Record the statistical contribution of the implicit component of + ! term dp1 for up2 or vp2. This will overwrite anything set + ! statistically in xp2_xpyp_lhs for this term. + ! Note: To find the contribution of x'y' term dp1, substitute + ! (2/3)*C_4 for the C_n input to function term_dp1_lhs. + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note above for + ! RHS turbulent advection (ta) term). + tmp & + = gamma_over_implicit_ts & + * term_dp1_lhs( two_thirds*C4, tau_zm(k) ) + zmscr01(k) = -tmp + ! Statistical contribution of the explicit component of term dp1 for + ! up2 or vp2. + ! x'y' term dp1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on term_pr1. + ! Note: To find the contribution of x'y' term dp1, substitute 0 for + ! the C_14 input to function term_pr1. + call stat_begin_update_pt( ixapxbp_dp1, k, & ! Intent(in) + -term_pr1( C4, zero, xbp2(k), wp2(k), tau_zm(k) ), & ! Intent(in) + zm ) ! Intent(inout) + + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note above for + ! RHS turbulent advection (ta) term). + lhs_fnc_output(1) & + = term_dp1_lhs( two_thirds*C4, tau_zm(k) ) + call stat_modify_pt( ixapxbp_dp1, k, & ! Intent(in) + + ( one - gamma_over_implicit_ts ) & ! Intent(in) + * ( - lhs_fnc_output(1) * xap2(k) ), & ! Intent(in) + zm ) ! Intent(inout) + + endif + + if ( ixapxbp_pr1 > 0 ) then + ! Note: The function term_pr1 is the explicit component of a + ! semi-implicit solution to dp1 and pr1. + ! Statistical contribution of the implicit component of term pr1 for + ! up2 or vp2. + ! Note: To find the contribution of x'y' term pr1, substitute + ! (1/3)*C_14 for the C_n input to function term_dp1_lhs. + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note above for + ! RHS turbulent advection (ta) term). + tmp & + = gamma_over_implicit_ts & + * term_dp1_lhs( one_third*C14, tau_zm(k) ) + zmscr11(k) = -tmp + ! Statistical contribution of the explicit component of term pr1 for + ! up2 or vp2. + ! x'y' term pr1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on term_pr1. + ! Note: To find the contribution of x'y' term pr1, substitute 0 for + ! the C_4 input to function term_pr1. + call stat_begin_update_pt( ixapxbp_pr1, k, & ! Intent(in) + -term_pr1( zero, C14, xbp2(k), wp2(k), tau_zm(k) ), & ! Intent(in) + zm ) ! Intent(inout) + + ! Note: An "over-implicit" weighted time step is applied to this + ! term. A weighting factor of greater than 1 may be used to + ! make the term more numerically stable (see note above for + ! RHS turbulent advection (ta) term). + lhs_fnc_output(1) & + = term_dp1_lhs( one_third*C14, tau_zm(k) ) + call stat_modify_pt( ixapxbp_pr1, k, & ! Intent(in) + + ( one - gamma_over_implicit_ts ) & ! Intent(in) + * ( - lhs_fnc_output(1) * xap2(k) ), & ! Intent(in) + zm ) ! Intent(inout) + + endif + + ! x'y' term pr2 is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_pr2, k, & ! Intent(in) + term_pr2( C5, thv_ds_zm(k), wpthvp(k), wpxap(k), wpxbp(k), & ! Intent(in) + xam, xbm, gr%invrs_dzm(k), kp1, k, & + Lscale(kp1), Lscale(k), wp2_zt(kp1), wp2_zt(k) ), & + zm ) ! Intent(inout) + + ! x'y' term tp is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_tp, k, & ! Intent(in) + ( one - C5 ) & ! Intent(in) + * term_tp( xam(kp1), xam(k), xam(kp1), xam(k), & + wpxap(k), wpxap(k), gr%invrs_dzm(k) ), & + zm ) ! Intent(inout) + + endif ! l_stats_samp + + enddo ! k=2..gr%nz-1 + + + ! Boundary Conditions + ! These are set so that the surface_varnce value of u'^2 or v'^2 can be + ! used at the lowest boundary and the values of those variables can be + ! set to their respective threshold minimum values at the top boundary. + ! Fixed-point boundary conditions are used for the variances. + + rhs(1,1) = xap2(1) + ! The value of u'^2 or v'^2 at the upper boundary will be set to the + ! threshold minimum value of w_tol_sqd. + rhs(gr%nz,1) = w_tol_sqd + + return + end subroutine xp2_xpyp_uv_rhs + + !============================================================================= + subroutine xp2_xpyp_rhs( solve_type, dt, l_iter, a1, a1_zt, & + wp2_zt, wpxap, wpxap_zt, wp3_on_wp2, & + wp3_on_wp2_zt, wpxbp, wpxbp_zt, & + xam, xbm, xapxbp, xapxbp_forcing, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + Cn, tau_zm, threshold, beta, & + rhs ) + + ! Description: + ! Explicit contributions to r_t'^2, th_l'^2, r_t'th_l', sclr'r_t', + ! sclr'th_l', or sclr'^2. + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + gamma_over_implicit_ts, & ! Constant(s) + one, & + zero + + use crmx_model_flags, only: & + l_upwind_xpyp_ta ! Constant(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update_pt, & ! Procedure(s) + stat_update_var_pt, & + stat_modify_pt + + use crmx_stats_variables, only: & + irtp2_ta, & ! Variable(s) + irtp2_tp, & + irtp2_dp1, & + irtp2_forcing, & + ithlp2_ta, & + ithlp2_tp, & + ithlp2_dp1, & + ithlp2_forcing, & + irtpthlp_ta, & + irtpthlp_tp1, & + irtpthlp_tp2, & + irtpthlp_dp1, & + irtpthlp_forcing, & + zm, & + l_stats_samp + + use crmx_advance_helper_module, only: set_boundary_conditions_rhs + + implicit none + + ! Input Variables + integer, intent(in) :: solve_type + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + logical, intent(in) :: & + l_iter ! Whether x is prognostic (T/F) + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] + a1_zt, & ! a_1 interpolated to thermodynamic levels [-] + wp2_zt, & ! w'^2 interpolated to thermodynamic levels [m^2/s^2] + wpxap, & ! w'x_a' (momentum levels) [m/s {x_am units}] + wpxap_zt, & ! w'x_a' interpolated to thermodynamic levels [m/s {x_am units}] + wp3_on_wp2, & ! w'^3 / w'^2 on momentum levels [m/s] + wp3_on_wp2_zt, & ! w'^3 / w'^2 on thermodynamic levels [m/s] + wpxbp, & ! w'x_b' (momentum levels) [m/s {x_bm units}] + wpxbp_zt, & ! w'x_b' interpolated to thermodynamic levels [m/s {x_bm units}] + xam, & ! x_am (thermodynamic levels) [{x_am units}] + xbm, & ! x_bm (thermodynamic levels) [{x_bm units}] + xapxbp, & ! x_a'x_b' (momentum levels) [{x_am units}*{x_bm units}] + xapxbp_forcing, & ! x_a'x_b' forcing (momentum levels) [{x_am units}*{x_bm units}/s] + rho_ds_zm, & ! Dry, static density on moment. levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] + tau_zm, & ! Time-scale tau on momentum levels [s] + Cn ! Coefficient C_n [-] + + real( kind = core_rknd ), intent(in) :: & + threshold, & ! Smallest allowable mag. value for x_a'x_b' [{x_am units} + ! *{x_bm units}] + beta ! Model parameter beta [-] + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz,1), intent(out) :: & + rhs ! Explicit contributions to x variance/covariance terms + + ! Local Variables + + ! Array indices + integer :: k, kp1, km1, k_low, k_high + + ! For "over-implicit" weighted time step. + ! This vector holds output from the LHS (implicit) portion of a term at a + ! given vertical level. This output is weighted and applied to the RHS. + ! This is used if the implicit portion of the term is "over-implicit", which + ! means that the LHS contribution is given extra weight (>1) in order to + ! increase numerical stability. A weighted factor must then be applied to + ! the RHS in order to balance the weight. + real( kind = core_rknd ), dimension(3) :: lhs_fnc_output + + integer :: & + ixapxbp_ta, & + ixapxbp_tp, & + ixapxbp_tp1, & + ixapxbp_tp2, & + ixapxbp_dp1, & + ixapxbp_f + + !------------------------------ Begin Code --------------------------------- + + select case ( solve_type ) + case ( xp2_xpyp_rtp2 ) + ixapxbp_ta = irtp2_ta + ixapxbp_tp = irtp2_tp + ixapxbp_tp1 = 0 + ixapxbp_tp2 = 0 + ixapxbp_dp1 = irtp2_dp1 + ixapxbp_f = irtp2_forcing + case ( xp2_xpyp_thlp2 ) + ixapxbp_ta = ithlp2_ta + ixapxbp_tp = ithlp2_tp + ixapxbp_tp1 = 0 + ixapxbp_tp2 = 0 + ixapxbp_dp1 = ithlp2_dp1 + ixapxbp_f = ithlp2_forcing + case ( xp2_xpyp_rtpthlp ) + ixapxbp_ta = irtpthlp_ta + ixapxbp_tp = 0 + ixapxbp_tp1 = irtpthlp_tp1 + ixapxbp_tp2 = irtpthlp_tp2 + ixapxbp_dp1 = irtpthlp_dp1 + ixapxbp_f = irtpthlp_forcing + case default ! No budgets for passive scalars + ixapxbp_ta = 0 + ixapxbp_tp = 0 + ixapxbp_tp1 = 0 + ixapxbp_tp2 = 0 + ixapxbp_dp1 = 0 + ixapxbp_f = 0 + end select + + + ! Initialize RHS vector to 0. + rhs = zero + + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + kp1 = min( k+1, gr%nz ) + + ! RHS turbulent advection (ta) term. + rhs(k,1) & + = rhs(k,1) & + + term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & + wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS turbulent advection (ta) term. + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + ! The weight of the implicit portion of this term is controlled + ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the + ! expression below). A factor is added to the right-hand side of + ! the equation in order to balance a weight that is not equal to 1, + ! such that: + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! where X is the variable that is being solved for in a predictive + ! equation (x'^2 or x'y' in this case), y(t) is the linearized + ! portion of the term that gets treated implicitly, and RHS is the + ! portion of the term that is always treated explicitly. A weight + ! of greater than 1 can be applied to make the term more + ! numerically stable. + if ( .not. l_upwind_xpyp_ta ) then + lhs_fnc_output(1:3) & + = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else + lhs_fnc_output(1:3) & + = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + endif + + rhs(k,1) & + = rhs(k,1) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * xapxbp(kp1) & + - lhs_fnc_output(2) * xapxbp(k) & + - lhs_fnc_output(3) * xapxbp(km1) ) + + ! RHS turbulent production (tp) term. + rhs(k,1) & + = rhs(k,1) & + + term_tp( xam(kp1), xam(k), xbm(kp1), xbm(k), & + wpxbp(k), wpxap(k), gr%invrs_dzm(k) ) + + ! RHS dissipation term 1 (dp1) + rhs(k,1) & + = rhs(k,1) + term_dp1_rhs( Cn(k), tau_zm(k), threshold ) + + ! RHS contribution from "over-implicit" weighted time step + ! for LHS dissipation term 1 (dp1). + ! + ! Note: An "over-implicit" weighted time step is applied to this term. + lhs_fnc_output(1) & + = term_dp1_lhs( Cn(k), tau_zm(k) ) + rhs(k,1) & + = rhs(k,1) & + + ( one - gamma_over_implicit_ts ) & + * ( - lhs_fnc_output(1) * xapxbp(k) ) + + ! RHS time tendency. + if ( l_iter ) then + rhs(k,1) = rhs(k,1) + one/real( dt, kind = core_rknd ) * xapxbp(k) + endif + + ! RHS forcing. + ! Note: forcing includes the effects of microphysics on . + rhs(k,1) = rhs(k,1) + xapxbp_forcing(k) + + + if ( l_stats_samp ) then + + ! Statistics: explicit contributions for rtp2, thlp2, or rtpthlp. + + ! x'y' term ta has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on term_ta_rhs. + call stat_begin_update_pt( ixapxbp_ta, k, & ! Intent(in) + -term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & ! Intent(in) + wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & + wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ), & + zm ) ! Intent(inout) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) term). + if ( .not. l_upwind_xpyp_ta ) then + lhs_fnc_output(1:3) & + = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & + rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & + a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) + else + lhs_fnc_output(1:3) & + = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & + wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & + gr%invrs_dzt(k), gr%invrs_dzt(kp1), & + invrs_rho_ds_zm(k), & + rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) + end if + call stat_modify_pt( ixapxbp_ta, k, & ! Intent(in) + + ( one - gamma_over_implicit_ts ) & ! Intent(in) + * ( - lhs_fnc_output(1) * xapxbp(kp1) & + - lhs_fnc_output(2) * xapxbp(k) & + - lhs_fnc_output(3) * xapxbp(km1) ), & + zm ) ! Intent(inout) + + ! x'y' term dp1 has both implicit and explicit components; call + ! stat_begin_update_pt. Since stat_begin_update_pt automatically + ! subtracts the value sent in, reverse the sign on term_dp1_rhs. + call stat_begin_update_pt( ixapxbp_dp1, k, & ! Intent(in) + -term_dp1_rhs( Cn(k), tau_zm(k), threshold ), & ! Intent(in) + zm ) ! Intent(inout) + + ! Note: An "over-implicit" weighted time step is applied to this term. + ! A weighting factor of greater than 1 may be used to make the + ! term more numerically stable (see note above for RHS turbulent + ! advection (ta) term). + lhs_fnc_output(1) & + = term_dp1_lhs( Cn(k), tau_zm(k) ) + call stat_modify_pt( ixapxbp_dp1, k, & ! Intent(in) + + ( one - gamma_over_implicit_ts ) & ! Intent(in) + * ( - lhs_fnc_output(1) * xapxbp(k) ), & ! Intent(in) + zm ) ! Intent(inout) + + ! rtp2/thlp2 case (1 turbulent production term) + ! x'y' term tp is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_tp, k, & ! Intent(in) + term_tp( xam(kp1), xam(k), xbm(kp1), xbm(k), & ! Intent(in) + wpxbp(k), wpxap(k), gr%invrs_dzm(k) ), & + zm ) ! Intent(inout) + + ! rtpthlp case (2 turbulent production terms) + ! x'y' term tp1 is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of x'y' term tp1, substitute 0 for all + ! the xam inputs and the wpxbp input to function term_tp. + call stat_update_var_pt( ixapxbp_tp1, k, & ! Intent(in) + term_tp( zero, zero, xbm(kp1), xbm(k), & ! Intent(in) + zero, wpxap(k), gr%invrs_dzm(k) ), & + zm ) ! Intent(inout) + + ! x'y' term tp2 is completely explicit; call stat_update_var_pt. + ! Note: To find the contribution of x'y' term tp2, substitute 0 for all + ! the xbm inputs and the wpxap input to function term_tp. + call stat_update_var_pt( ixapxbp_tp2, k, & ! Intent(in) + term_tp( xam(kp1), xam(k), zero, zero, & ! Intent(in) + wpxbp(k), zero, gr%invrs_dzm(k) ), & + zm ) ! Intent(inout) + + ! x'y' forcing term is completely explicit; call stat_update_var_pt. + call stat_update_var_pt( ixapxbp_f, k, xapxbp_forcing(k), zm ) + + endif ! l_stats_samp + + enddo ! k=2..gr%nz-1 + + + ! Boundary Conditions + ! These are set so that the surface_varnce value of rtp2, thlp2, or rtpthlp + ! (or sclrp2, sclrprtp, or sclrpthlp) can be used at the lowest boundary and the + ! values of those variables can be set to their respective threshold minimum + ! values (which is 0 in the case of the covariances) at the top boundary. + ! Fixed-point boundary conditions are used for both the variances and the + ! covariances. + + k_low = 1 + k_high = gr%nz + + ! The value of the field at the upper boundary will be set to it's threshold + ! minimum value, as contained in the variable 'threshold'. + call set_boundary_conditions_rhs( & + xapxbp(1), k_low, threshold, k_high, & + rhs(:,1) ) + + return + end subroutine xp2_xpyp_rhs + + !============================================================================= + pure function term_ta_lhs( wp3_on_wp2_ztp1, wp3_on_wp2_zt, & + rho_ds_ztp1, rho_ds_zt, invrs_rho_ds_zm, & + a1_ztp1, a1, a1_zt, invrs_dzm, beta, level ) & + result( lhs ) + + ! Description: + ! Turbulent advection of x_a'x_b': implicit portion of the code. + ! + ! The d(x_a'x_b')/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'x_a'x_b' )/dz. + ! + ! A substitution is made in order to close the turbulent advection term, + ! such that: + ! + ! w'x_a'x_b' = (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' + ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b'; + ! + ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent + ! advection term is rewritten as: + ! + ! - (1/rho_ds) + ! * d [ rho_ds * { (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' + ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b' } ] + ! / dz; + ! + ! which produces an implicit and an explicit portion of this term. The + ! implicit portion of this term is: + ! + ! - (1/rho_ds) + ! * d [ rho_ds * (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b'(t+1) ] + ! / dz. + ! + ! Since (1/3)*beta is a constant, it can be pulled outside of the + ! derivative. The implicit portion of this term becomes: + ! + ! - (1/3)*beta/rho_ds + ! * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * x_a'x_b'(t+1) ] / dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of x_a'x_b' being used is + ! from the next timestep, which is being advanced to in solving the + ! d(x_a'x_b')/dt equation. + ! + ! The implicit portion of this term is discretized as follows: + ! + ! The values of x_a'x_b' are found on the momentum levels, as are the values + ! of w'^2 and a_1. The values of w'^3 are found on the thermodynamic + ! levels. Additionally, the values of rho_ds_zt are found on the + ! thermodynamic levels, and the values of invrs_rho_ds_zm are found on the + ! momentum levels. The variables x_a'x_b', w'^2, and a_1 are each + ! interpolated to the intermediate thermodynamic levels. The values of the + ! mathematical expression (called F here) within the dF/dz term are computed + ! on the thermodynamic levels. Then the derivative (d/dz) of the + ! expression (F) is taken over the central momentum level, where it is + ! multiplied by (1/3)*beta and by invrs_rho_ds_zm, yielding the desired + ! result. In this function, the values of F are as follows: + ! + ! F = rho_ds_zt * a_1(t) * ( w'^3(t) / w'^2(t) ) * x_a'x_b'(t+1); + ! + ! where the timestep index (t) stands for the index of the current timestep. + ! + ! + ! ==a1p1========wp2p1========xapxbpp1================================ m(k+1) + ! + ! ----a1(interp)--wp2(interp)--xapxbp(interp)--wp3p1---rho_ds_ztp1--- t(k+1) + ! + ! ==a1==========wp2==========xapxbp=======dF/dz====invrs_rho_ds_zm=== m(k) + ! + ! ----a1(interp)--wp2(interp)--xapxbp(interp)--wp3-----rho_ds_zt----- t(k) + ! + ! ==a1m1========wp2m1========xapxbpm1================================ m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & ! gr%weights_zm2zt + gr ! Variable(s) + + use crmx_constants_clubb, only: & + one_third ! Constant(s) + + use crmx_model_flags, only: & + l_standard_term_ta + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: max + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + integer, parameter :: & + m_above = 1, & ! Index for upper momentum level grid weight. + m_below = 2 ! Index for lower momentum level grid weight. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp3_on_wp2_ztp1, & ! w'^3 / w'^2 (k+1) [m/s] + wp3_on_wp2_zt, & ! w'^3 / w'^2 (k) [m/s] + rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] + rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] + a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] + a1, & ! a_1(k) [-] + a1_zt, & ! a_1 interpolated to thermo. level (k) [-] + invrs_dzm, & ! Inverse of grid spacing [1/m] + beta ! Model parameter [-] + + integer, intent(in) :: & + level ! Central momentum level (on which calculation occurs). + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + ! Local Variables + integer :: & + tkp1, & ! Thermodynamic level directly above central momentum level. + tk ! Thermodynamic level directly below central momentum level. + + + ! Thermodynamic level (k+1) is between momentum level (k+1) + ! and momentum level (k). + tkp1 = level + 1 + + ! Thermodynamic level (k) is between momentum level (k) + ! and momentum level (k-1). + tk = level + + if ( l_standard_term_ta ) then + + ! The turbulent advection term is discretized normally, in accordance + ! with the model equations found in the documentation and the description + ! listed above. + + ! Momentum superdiagonal: [ x xapxbp(k+1,) ] + lhs(kp1_mdiag) & + = + one_third * beta & + * invrs_rho_ds_zm & + * invrs_dzm & + * rho_ds_ztp1 * a1_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_above,tkp1) + + ! Momentum main diagonal: [ x xapxbp(k,) ] + lhs(k_mdiag) & + = + one_third * beta & + * invrs_rho_ds_zm & + * invrs_dzm & + * ( rho_ds_ztp1 * a1_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_below,tkp1) & + - rho_ds_zt * a1_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_above,tk) & + ) + + ! Momentum subdiagonal: [ x xapxbp(k-1,) ] + lhs(km1_mdiag) & + = - one_third * beta & + * invrs_rho_ds_zm & + * invrs_dzm & + * rho_ds_zt * a1_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_below,tk) + + else + + ! Brian tried a new discretization for the turbulent advection term, for + ! which the implicit portion of the term is: + ! - (1/rho_ds) + ! * d [ rho_ds * a_1 * (1/3)*beta * ( w'^3 / w'^2 ) * x_a'x_b' ] / dz. + ! In order to help stabilize x_a'x_b', a_1 has been pulled outside the + ! derivative. + + ! Momentum superdiagonal: [ x xapxbp(k+1,) ] + lhs(kp1_mdiag) & + = + one_third * beta & + * invrs_rho_ds_zm * a1 & + * invrs_dzm & + * rho_ds_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_above,tkp1) + + ! Momentum main diagonal: [ x xapxbp(k,) ] + lhs(k_mdiag) & + = + one_third * beta & + * invrs_rho_ds_zm * a1 & + * invrs_dzm & + * ( rho_ds_ztp1 & + * wp3_on_wp2_ztp1 & + * gr%weights_zm2zt(m_below,tkp1) & + - rho_ds_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_above,tk) & + ) + + ! Momentum subdiagonal: [ x xapxbp(k-1,) ] + lhs(km1_mdiag) & + = - one_third * beta & + * invrs_rho_ds_zm * a1 & + * invrs_dzm & + * rho_ds_zt & + * wp3_on_wp2_zt & + * gr%weights_zm2zt(m_below,tk) + + ! End of Brian's a1 change. 14 Feb 2008. + + endif + + + return + end function term_ta_lhs + + !----------------------------------------------------------------------------- + pure function term_ta_lhs_upwind( a1_zm, a1_zm_p1, a1_zm_m1, & + wp3_on_wp2_p1, wp3_on_wp2, wp3_on_wp2_m1, & + invrs_dzt, invrs_dzt_p1, & + invrs_rho_ds_zm, & + rho_ds_zm_p1, rho_ds_zm, rho_ds_zm_m1, beta ) & + result( lhs ) + + ! Description: + ! Turbulent advection of x_a'x_b' using an upwind differencing + ! approximation rather than a centered difference. + ! References: + ! None + !----------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + one_third, & ! Constant(s) + zero + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + a1_zm, & ! a_1(k) on momentum levels [-] + a1_zm_p1, & ! a_1(k+1) on momentum levels [-] + a1_zm_m1, & ! a_1(k-1) on momentum levels [-] + wp3_on_wp2_p1, & ! Smoothed wp3 / wp2 on moment. levels (k+1) [m/s] + wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels (k) [m/s] + wp3_on_wp2_m1, & ! Smoothed wp3 / wp2 on moment. levels (k-1) [m/s] + invrs_dzt, & ! Inverse of grid spacing (k) [1/m] + invrs_dzt_p1, & ! Inverse of grid spacing (k+1) [1/m] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] + rho_ds_zm, & ! Density of air (k) [kg/m^3] + rho_ds_zm_p1, & ! Density of air (k+1) [kg/m^3] + rho_ds_zm_m1, & ! Density of air (k-1) [kg/m^3] + beta ! Model parameter [-] + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + + if ( wp3_on_wp2 > zero ) then + + ! Momentum main diagonal: [ x xapxbp(k+1,) ] + lhs(kp1_mdiag) = zero + + ! Momentum main diagonal: [ x xapxbp(k,) ] + lhs(k_mdiag) & + = + one_third * beta & + * invrs_dzt * invrs_rho_ds_zm & + * rho_ds_zm * a1_zm * wp3_on_wp2 + + ! Momentum subdiagonal: [ x xapxbp(k-1,) ] + lhs(km1_mdiag) & + = - one_third * beta & + * invrs_dzt * invrs_rho_ds_zm & + * rho_ds_zm_m1 * a1_zm_m1 * wp3_on_wp2_m1 + + else ! "Wind" is blowing downward + + ! Momentum main diagonal: [ x xapxbp(k+1,) ] + lhs(kp1_mdiag) & + = + one_third * beta & + * invrs_dzt_p1 * invrs_rho_ds_zm & + * rho_ds_zm_p1 * a1_zm_p1 * wp3_on_wp2_p1 + + ! Momentum main diagonal: [ x xapxbp(k,) ] + lhs(k_mdiag) & + = - one_third * beta & + * invrs_dzt_p1 * invrs_rho_ds_zm & + * rho_ds_zm * a1_zm * wp3_on_wp2 + + ! Momentum subdiagonal: [ x xapxbp(k-1,) ] + lhs(km1_mdiag) = zero + + end if + + return + end function term_ta_lhs_upwind + + !============================================================================= + pure function term_ta_rhs( wp2_ztp1, wp2_zt, & + wp3_on_wp2_ztp1, wp3_on_wp2_zt, & + rho_ds_ztp1, rho_ds_zt, invrs_rho_ds_zm, & + a1_ztp1, a1, a1_zt, wpxbp_ztp1, wpxbp_zt, & + wpxap_ztp1, wpxap_zt, invrs_dzm, beta ) & + result( rhs ) + + ! Description: + ! Turbulent advection of x_a'x_b': explicit portion of the code. + ! + ! The d(x_a'x_b')/dt equation contains a turbulent advection term: + ! + ! - (1/rho_ds) * d( rho_ds * w'x_a'x_b' )/dz. + ! + ! A substitution is made in order to close the turbulent advection term, + ! such that: + ! + ! w'x_a'x_b' = (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' + ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b'; + ! + ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent + ! advection term is rewritten as: + ! + ! - (1/rho_ds) + ! * d [ rho_ds * { (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' + ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b' } ] + ! / dz; + ! + ! which produces an implicit and an explicit portion of this term. The + ! explicit portion of this term is: + ! + ! - (1/rho_ds) + ! * d [ rho_ds * (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b' ] / dz. + ! + ! Since (1-(1/3)*beta) is a constant, it can be pulled outside of the + ! derivative. The explicit portion of this term becomes: + ! + ! - (1-(1/3)*beta)/rho_ds + ! * d [ rho_ds * (a_1)^2 * ( w'^3 / (w'^2)^2 ) * w'x_a' * w'x_b' ] / dz. + ! + ! The explicit portion of this term is discretized as follows: + ! + ! The values of w'x_a', w'x_b', w'^2, and a_1 are found on the momentum + ! levels. The values of w'^3 are found on the thermodynamic levels. + ! Additionally, the values of rho_ds_zt are found on the thermodynamic + ! levels, and the values of invrs_rho_ds_zm are found on the momentum + ! levels. The variables w'x_a', w'x_b', w'^2, and a_1 are each interpolated + ! to the intermediate thermodynamic levels. The values of the mathematical + ! expression (called F here) within the dF/dz term are computed on the + ! thermodynamic levels. Then the derivative (d/dz) of the expression (F) is + ! taken over the central momentum level, where it is multiplied by + ! (1-(1/3)*beta), and by invrs_rho_ds_zm, yielding the desired result. In + ! this function, the values of F are as follows: + ! + ! F = rho_ds_zt * ( a_1(t) )^2 * ( w'^3(t) / ( w'^2(t) )^2 ) + ! * w'x_a'(t) * w'x_b'(t); + ! + ! where the timestep index (t) stands for the index of the current timestep. + ! + ! + ! =a1p1=======wp2p1=======wpxapp1=======wpxbpp1========================= m(k+1) + ! + ! -a1(interp)-wp2(interp)-wpxap(interp)-wpxbp(interp)-wp3p1-rho_ds_ztp1- t(k+1) + ! + ! =a1=========wp2=========wpxap=========wpxbp===dF/dz===invrs_rho_ds_zm= m(k) + ! + ! -a1(interp)-wp2(interp)-wpxap(interp)-wpxbp(interp)-wp3---rho_ds_zt--- t(k) + ! + ! =a1m1=======wp2m1=======wpxapm1=======wpxbpm1========================= m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + one, & ! Constant(s) + one_third + + use crmx_model_flags, only: & + l_standard_term_ta + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: max + + ! Input variables + real( kind = core_rknd ), intent(in) :: & + wp2_ztp1, & ! w'^2 interpolated to thermo. level (k+1) [m^2/s^2] + wp2_zt, & ! w'^2 interpolated to thermo. level (k) [m^2/s^2] + wp3_on_wp2_ztp1, & ! Smoothed w'^3 / w'^2 on thermo. level (k+1)[m^2/s^2] + wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 on thermo. level (k) [m^2/s^2] + rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] + rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ mome. lev (k) [m^3/kg] + a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] + a1, & ! a_1(k) [-] + a1_zt, & ! a_1 interpolated to thermo. level (k) [-] + wpxbp_ztp1, & ! w'x_b' interpolated to thermo. level (k+1) [m/s {x_bm units}] + wpxbp_zt, & ! w'x_b' interpolated to thermo. level (k) [m/s {x_bm units}] + wpxap_ztp1, & ! w'x_a' interpolated to thermo. level (k+1) [m/s {x_am units}] + wpxap_zt, & ! w'x_a' interpolated to thermo. level (k) [m/s {x_am units}] + invrs_dzm, & ! Inverse of grid spacing [1/m] + beta ! Model parameter [-] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + + if ( l_standard_term_ta ) then + + ! The turbulent advection term is discretized normally, in accordance + ! with the model equations found in the documentation and the description + ! listed above. + + rhs & + = - ( one - one_third * beta ) & + * invrs_rho_ds_zm & + * invrs_dzm & + * ( rho_ds_ztp1 * a1_ztp1**2 & + * wp3_on_wp2_ztp1 / wp2_ztp1 & + * wpxap_ztp1 * wpxbp_ztp1 & + - rho_ds_zt * a1_zt**2 & + * wp3_on_wp2_zt / wp2_zt & + * wpxap_zt * wpxbp_zt & + ) + + else + + ! Brian tried a new discretization for the turbulent advection term, for + ! which the explicit portion of the term is: + ! - (1/rho_ds) + ! * d [ rho_ds * (a_1)^2 * (1-(1/3)*beta) * ( w'^3 / (w'^2)^2 ) + ! * w'x_a' * w'x_b' ] / dz. + ! In order to help stabilize x_a'x_b', (a_1)^2 has been pulled outside + ! the derivative. + + rhs & + = - ( one - one_third * beta ) & + * invrs_rho_ds_zm * a1**2 & + * invrs_dzm & + * ( rho_ds_ztp1 & + * wp3_on_wp2_ztp1 / wp2_ztp1 & + * wpxap_ztp1 * wpxbp_ztp1 & + - rho_ds_zt & + * wp3_on_wp2_zt / wp2_zt & + * wpxap_zt * wpxbp_zt & + ) + + ! End of Brian's a1 change. 14 Feb 2008. + + endif + + + return + end function term_ta_rhs + + !============================================================================= + pure function term_tp( xamp1, xam, xbmp1, xbm, & + wpxbp, wpxap, invrs_dzm ) & + result( rhs ) + + ! Description: + ! Turbulent production of x_a'x_b': explicit portion of the code. + ! + ! The d(x_a'x_b')/dt equation contains a turbulent production term: + ! + ! - w'x_b' d(x_am)/dz - w'x_a' d(x_bm)/dz. + ! + ! This term is solved for completely explicitly and is discretized as + ! follows: + ! + ! The values of w'x_a' and w'x_b' are found on the momentum levels, whereas + ! the values of x_am and x_bm are found on the thermodynamic levels. The + ! derivatives of both x_am and x_bm are taken over the intermediate + ! (central) momentum level. All of the remaining mathematical operations + ! take place at the central momentum level, yielding the desired result. + ! + ! ---------xamp1------------xbmp1-------------------------- t(k+1) + ! + ! ===wpxap======d(xam)/dz=========d(xbm)/dz===wpxbp======== m(k) + ! + ! ---------xam--------------xbm---------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + real( kind = core_rknd ), intent(in) :: & + xam, & ! x_am(k) [{x_am units}] + xamp1, & ! x_am(k+1) [{x_am units}] + xbm, & ! x_bm(k) [{x_bm units}] + xbmp1, & ! x_bm(k+1) [{x_bm units}] + wpxbp, & ! w'x_b'(k) [m/s {x_bm units}] + wpxap, & ! w'x_a'(k) [m/s {x_am units}] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = - wpxbp * invrs_dzm * ( xamp1 - xam ) & + - wpxap * invrs_dzm * ( xbmp1 - xbm ) + + return + end function term_tp + + !============================================================================= + pure function term_dp1_lhs( Cn, tau_zm ) & + result( lhs ) + + ! Description: + ! Dissipation term 1 for x_a'x_b': implicit portion of the code. + ! + ! The d(x_a'x_b')/dt equation contains dissipation term 1: + ! + ! - ( C_n / tau_zm ) x_a'x_b'. + ! + ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b + ! are the same variable), the term is damped to a certain positive + ! threshold, such that: + ! + ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ). + ! + ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value + ! is part of pressure term 1 and is handled as part of function 'term_pr1'. + ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function + ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead. + ! + ! For cases where x_a'x_b' is a covariance (in other words, where x_a and + ! x_b are different variables), threshold is set to 0, and the expression + ! reverts to the form found in the first equation. + ! + ! This term is broken into implicit and explicit portions. The equations + ! for u'^2, v'^2, and any covariances only include the implicit portion. + ! The implicit portion of this term is: + ! + ! - ( C_n / tau_zm ) x_a'x_b'(t+1). + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "-" in front of the term + ! is changed to a "+". + ! + ! The timestep index (t+1) means that the value of x_a'x_b' being used is + ! from the next timestep, which is being advanced to in solving the + ! d(x_a'x_b')/dt equation. + ! + ! The values of x_a'x_b' are found on momentum levels. The values of + ! time-scale tau_zm are also found on momentum levels. + ! + ! Note: For equations that use pressure term 1 (such as the equations for + ! u'^2 and v'^2), C_n = ( 2*C_4 + C_14 ) / 3; which combines the + ! implicit contributions for dissipation term 1 and pressure term 1 + ! into one expression. Otherwise, C_n = C_2. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + Cn, & ! Coefficient C_n [-] + tau_zm ! Time-scale tau at momentum levels (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Momentum main diagonal: [ x xapxbp(k,) ] + lhs & + = + Cn / tau_zm + + return + end function term_dp1_lhs + + !============================================================================= + pure function term_dp1_rhs( Cn, tau_zm, threshold ) & + result( rhs ) + + ! Description: + ! Dissipation term 1 for x_a'x_b': explicit portion of the code. + ! + ! The d(x_a'x_b')/dt equation contains dissipation term 1: + ! + ! - ( C_n / tau_zm ) x_a'x_b'. + ! + ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b + ! are the same variable), the term is damped to a certain positive + ! threshold, such that: + ! + ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ). + ! + ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value + ! is part of pressure term 1 and is handled as part of function 'term_pr1'. + ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function + ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead. + ! + ! For cases where x_a'x_b' is a covariance (in other words, where x_a and + ! x_b are different variables), threshold is set to 0, and the expression + ! reverts to the form found in the first equation. + ! + ! This term is broken into implicit and explicit portions. The equations + ! for u'^2, v'^2, and any covariances only include the implicit portion. + ! The explicit portion of this term is: + ! + ! + ( C_n / tau_zm ) * threshold. + ! + ! The values of time-scale tau_zm and the threshold are found on the + ! momentum levels. + ! + ! Note: The equations that use pressure term 1 (such as the equations for + ! u'^2 and v'^2) do not call this function. Thus, within this + ! function, C_n = C_2. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + Cn, & ! Coefficient C_n [-] + tau_zm, & ! Time-scale tau at momentum levels (k) [s] + threshold ! Minimum allowable magnitude value of x_a'x_b' [units vary] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs & + = + ( Cn / tau_zm ) * threshold + + return + end function term_dp1_rhs + + !============================================================================= + pure function term_pr1( C4, C14, xbp2, wp2, tau_zm ) & + result( rhs ) + + ! Description: + ! Pressure term 1 for x_a'x_b': explicit portion of the code. + ! + ! Note: Pressure term 1 is only used when x_a'x_b' is either u'^2 or v'^2. + ! For the following description, pressure term 2 for u'^2 is used as + ! the example. Pressure term 2 for v'^2 is the same as pressure + ! term 2 for u'^2, except that the v'^2 and u'^2 variables are + ! switched. + ! + ! The d(u'^2)/dt equation contains dissipation term 1: + ! + ! - ( C_4 / tau_zm ) * ( u'^2 - (2/3)*em ); + ! + ! where em = (1/2) * ( u'^2 + v'^2 + w'^2 ); + ! + ! and with the substitution applied, dissipation term 1 becomes: + ! + ! - ( C_4 / tau_zm ) * ( u'^2 - (1/3) * ( u'^2 + v'^2 + w'^2 ) ). + ! + ! The d(u'^2)/dt equation also contains pressure term 1: + ! + ! - (2/3) * epsilon; + ! + ! where epsilon = C_14 * ( em / tau_zm ). + ! + ! Additionally, since pressure term 1 is a damping term, em is damped only + ! to it's minimum threshold value, em_min, where: + ! + ! em_min = (1/2) * ( u'^2|_min + v'^2|_min + w'^2|_min ) + ! = (1/2) * ( w_tol^2 + w_tol^2 + w_tol^2 ) + ! = (3/2) * w_tol^2. + ! + ! With the damping threshold applied, epsilon becomes: + ! + ! epsilon = C_14 * ( ( em - em_min ) / tau_zm ); + ! + ! and with all substitutions applied, pressure term 1 becomes: + ! + ! - (2/3) * ( C_14 / tau_zm ) + ! * [ (1/2) * ( u'^2 + v'^2 + w'^2 ) - (3/2) * w_tol^2 ]. + ! + ! Dissipation term 1 and pressure term 1 are combined and simplify to: + ! + ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2 + ! + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2 + w'^2 ) + ! + ( C_14 / tau_zm ) * w_tol^2. + ! + ! The combined term has both implicit and explicit components. + ! The implicit component is: + ! + ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2(t+1). + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "-" in front of the term + ! is changed to a "+". + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(x_a'x_b')/dt equation. + ! + ! The implicit component of the combined dp1 and pr1 term is solved in + ! function "term_dp1_lhs" above, where "( 2*C_4 + C_14 ) / 3" is sent in + ! as "C_n". + ! + ! The explicit component of the combined dp1 and pr1 term is: + ! + ! + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2(t) + w'^2(t) ) + ! + ( C_14 / tau_zm ) * w_tol^2; + ! + ! and is discretized as follows: + ! + ! The values for v'^2 and w'^2, as well as for tau_zm, are found on the + ! momentum levels. The mathematical operations all take place on the + ! momentum levels, yielding the desired result. + + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + w_tol_sqd, & ! Constant(s) + one_third + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C4, & ! Model parameter C_4 [-] + C14, & ! Model parameter C_14 [-] + xbp2, & ! v'^2(k) (if solving for u'^2) or vice versa [m^2/s^2] + wp2, & ! w'^2(k) [m^2/s^2] + tau_zm ! Time-scale tau at momentum levels (k) [s] + + ! Return Variable + real( kind = core_rknd ) :: rhs + + rhs = + one_third * ( C4 - C14 ) * ( xbp2 + wp2 ) / tau_zm & + + ( C14 / tau_zm ) * w_tol_sqd + + return + end function term_pr1 + + !============================================================================= + pure function term_pr2( C5, thv_ds_zm, wpthvp, upwp, vpwp, & + um, vm, invrs_dzm, kp1, k, & + Lscalep1, Lscale, wp2_ztp1, wp2_zt ) & + result( rhs ) + + ! Description: + ! Pressure term 2 for x_a'x_b': explicit portion of the code. + ! + ! Note: Pressure term 2 is only used when x_a'x_b' is either u'^2 or v'^2. + ! For the following description, pressure term 2 for u'^2 is used as + ! the example. Pressure term 2 for v'^2 is the exact same as + ! pressure term 2 for u'^2. + ! + ! The d(u'^2)/dt equation contains pressure term 2: + ! + ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ]. + ! + ! This term is solved for completely explicitly and is discretized as + ! follows: + ! + ! The values of w'th_v', u'w', and v'w' are found on the momentum levels, + ! whereas the values of um and vm are found on the thermodynamic levels. + ! Additionally, the values of thv_ds_zm are found on the momentum levels. + ! The derivatives of both um and vm are taken over the intermediate + ! (central) momentum level. All the remaining mathematical operations take + ! place at the central momentum level, yielding the desired result. + ! + ! -----ump1------------vmp1-------------------------------------- t(k+1) + ! + ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k) + ! + ! -----um--------------vm---------------------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & ! Constants + grav, & ! Gravitational acceleration [m/s^2] + one, & + two_thirds, & + zero, & + zero_threshold + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: abs, max + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + C5, & ! Model parameter C_5 [-] + thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] + wpthvp, & ! w'th_v'(k) [m/K/s] + upwp, & ! u'w'(k) [m^2/s^2] + vpwp, & ! v'w'(k) [m^2/s^2] + invrs_dzm, & ! Inverse of the grid spacing (k) [1/m] + Lscalep1, & ! Mixing length (k+1) [m] + Lscale, & ! Mixing length (k) [m] + wp2_ztp1, & ! w'^2(k+1) (thermo. levels) [m^2/s^2] + wp2_zt ! w'^2(k) (thermo. levels) [m^2/s^2] + + ! Note: Entire arrays of um and vm are now required rather than um and vm + ! only at levels k and k+1. The entire array is necessary when a vertical + ! average calculation of d(um)/dz and d(vm)/dz is used. --ldgrant March 2010 + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + um, & ! mean zonal wind [m/s] + vm ! mean meridional wind [m/s] + + integer, intent(in) :: & + kp1, & ! current level+1 in xp2_xpyp_uv_rhs loop + k ! current level in xp2_xpyp_uv_rhs loop + + ! Return Variable + real( kind = core_rknd ) :: rhs + + ! Local Variable(s) --ldgrant, March 2010 + real( kind = core_rknd ), parameter :: & + ! Constants empirically determined for experimental version of term_pr2 + ! ldgrant March 2010 + constant1 = one, & ! [m/s] + constant2 = 1000.0_core_rknd, & ! [m] + vert_avg_depth = 200.0_core_rknd ! Depth over which to average d(um)/dz and d(vm)/dz [m] + + real( kind = core_rknd ) :: & + zt_high, & ! altitude above current altitude zt(k) [m] + um_high, & ! um at altitude zt_high [m/s] + vm_high, & ! vm at altitude zt_high [m/s] + zt_low, & ! altitude below (or at) current altitude zt(k) [m] + um_low, & ! um at altitude zt_low [m/s] + vm_low ! vm at altitude zt_low [m/s] + + logical, parameter :: & + l_use_experimental_term_pr2 = .false., & ! If true, use experimental version + ! of term_pr2 calculation + l_use_vert_avg_winds = .true. ! If true, use vert_avg_depth average + ! calculation for d(um)/dz and d(vm)/dz + + !------ Begin code ------------ + + if( .not. l_use_experimental_term_pr2 ) then + ! use original version of term_pr2 + + ! As applied to w'2 + rhs = + two_thirds * C5 & + * ( ( grav / thv_ds_zm ) * wpthvp & + - upwp * invrs_dzm * ( um(kp1) - um(k) ) & + - vpwp * invrs_dzm * ( vm(kp1) - vm(k) ) & + ) + + else ! use experimental version of term_pr2 --ldgrant March 2010 + + if( l_use_vert_avg_winds ) then + ! We found that using a 200m running average of d(um)/dz and d(vm)/dz + ! produces larger spikes in up2 and vp2 near the inversion for + ! the stratocumulus cases. + call find_endpts_for_vert_avg_winds & + ( vert_avg_depth, k, um, vm, & ! intent(in) + zt_high, um_high, vm_high, & ! intent(out) + zt_low, um_low, vm_low ) ! intent(out) + + else ! Do not use a vertical average calculation for d(um)/dz and d(vm)/dz + zt_high = gr%zt(kp1) + um_high = um(kp1) + vm_high = vm(kp1) + + zt_low = gr%zt(k) + um_low = um(k) + vm_low = vm(k) + end if ! l_use_vert_avg_winds + + ! *****NOTES on experimental version***** + ! Leah Grant and Vince Larson eliminated the contribution from wpthvp + ! because terms with d(wp2)/dz include buoyancy effects and seem to + ! produce better results. + ! + ! We also eliminated the contribution from the momentum flux terms + ! because they didn't contribute to the results. + ! + ! The constant1 line does not depend on shear. This is important for + ! up2 and vp2 generation in cases that have little shear such as FIRE. + ! We also made the constant1 line proportional to d(Lscale)/dz to account + ! for higher spikes in up2 and vp2 near a stronger inversion. This + ! increases up2 and vp2 near the inversion for the stratocumulus cases, + ! but overpredicts up2 and vp2 near cloud base in cumulus cases such + ! as BOMEX where d(Lscale)/dz is large. Therefore, the d(Lscale)/dz + ! contribution is commented out for now. + ! + ! The constant2 line includes the possibility of shear generation of + ! up2 and vp2, which is important for some cases. The current functional + ! form used is: + ! constant2 * |d(wp2)/dz| * |d(vm)/dz| + ! We use |d(vm)/dz| instead of |d(um)/dz| + |d(vm)/dz| here because + ! this allows for different profiles of up2 and vp2, which occur for + ! many cases. In addition, we found that in buoyant cases, up2 is + ! more related to d(vm)/dz and vp2 is more related to d(um)/dz. This + ! occurs if horizontal rolls are oriented in the direction of the shear + ! vector. However, in stably stratified cases, the opposite relation is + ! true (horizontal rolls caused by shear are perpendicular to the shear + ! vector). This effect is not yet accounted for. + ! + ! For better results, we reduced the value of C5 from 5.2 to 3.0 and + ! changed the eddy diffusivity coefficient Kh so that it is + ! proportional to 1.5*wp2 rather than to em. + rhs = + two_thirds * C5 & + * ( constant1 * abs( wp2_ztp1 - wp2_zt ) * invrs_dzm & + ! * abs( Lscalep1 - Lscale ) * invrs_dzm & + + constant2 * abs( wp2_ztp1 - wp2_zt ) * invrs_dzm & + * abs( vm_high - vm_low ) / ( zt_high - zt_low ) & + + ( Lscalep1 + Lscale ) * zero & + ! This line eliminates an Intel compiler + ) ! warning that Lscalep1/Lscale are not + ! used. -meyern + end if ! .not. l_use_experimental_term_pr2 + + ! Added by dschanen for ticket #36 + ! We have found that when shear generation is zero this term will only be + ! offset by hole-filling (up2_pd/vp2_pd) and reduces turbulence + ! unrealistically at lower altitudes to make up the difference. + rhs = max( rhs, zero_threshold ) + + return + end function term_pr2 + + !============================================================================= + pure subroutine find_endpts_for_vert_avg_winds & + ( vert_avg_depth, k, um, vm, & ! intent(in) + zt_high, um_high, vm_high, & ! intent(out) + zt_low, um_low, vm_low ) ! intent(out) + ! Description: + ! This subroutine determines values of um and vm which are + ! +/- [vert_avg_depth/2] m above and below the current altitude zt(k). + ! This is for the purpose of using a running vertical average + ! calculation of d(um)/dz and d(vm)/dz in term_pr2 (over a depth + ! vert_avg_depth). E.g. If a running average over 200m is desired, + ! then this subroutine will determine the values of um and vm which + ! are 100m above and below the current level. + ! ldgrant March 2010 + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + two ! Constant(s) + + use crmx_interpolation, only : & + binary_search, lin_int ! Function(s) + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + vert_avg_depth ! Depth over which to average d(um)/dz + ! and d(vm)/dz in term_pr2 [m] + + integer, intent(in) :: & + k ! current level in xp2_xpyp_uv_rhs loop + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + um, & ! mean zonal wind [m/s] + vm ! mean meridional wind [m/s] + + ! Output Variables + real( kind = core_rknd ), intent(out) :: & + zt_high, & ! current altitude zt(k) + depth [m] + um_high, & ! um at altitude zt_high [m/s] + vm_high, & ! vm at altitude zt_high [m/s] + zt_low, & ! current altitude zt(k) - depth [m] + um_low, & ! um at altitude zt_low [m/s] + vm_low ! vm at altitude zt_low [m/s] + + ! Local Variables + real( kind = core_rknd ) :: depth ! vert_avg_depth/2 [m] + + integer :: k_high, k_low + ! Number of levels above (below) the current level where altitude is + ! [depth] greater (less) than the current altitude + ! [unless zt(k) < [depth] from an upper/lower boundary] + + !------ Begin code ------------ + + depth = vert_avg_depth / two + + ! Find the grid level that contains the altitude greater than or + ! equal to the current altitude + depth + k_high = binary_search( gr%nz, gr%zt, gr%zt(k)+depth ) + ! If the current altitude + depth is greater than the highest + ! altitude, binary_search returns a value of -1 + if ( k_high == -1 ) k_high = gr%nz + + if ( k_high == gr%nz ) then + ! Current altitude + depth is higher than or exactly at the top grid level. + ! Since this is a ghost point, use the altitude at grid level nzmax-1 + k_high = gr%nz-1 + zt_high = gr%zt(k_high) + um_high = um(k_high) + vm_high = vm(k_high) + else if ( gr%zt(k_high) == gr%zt(k)+depth ) then + ! Current altitude + depth falls exactly on another grid level. + ! In this case, no interpolation is necessary. + zt_high = gr%zt(k_high) + um_high = um(k_high) + vm_high = vm(k_high) + else ! Do an interpolation to find um & vm at current altitude + depth. + zt_high = gr%zt(k)+depth + um_high = lin_int( zt_high, gr%zt(k_high), gr%zt(k_high-1), & + um(k_high), um(k_high-1) ) + vm_high = lin_int( zt_high, gr%zt(k_high), gr%zt(k_high-1), & + vm(k_high), vm(k_high-1) ) + end if ! k_high ... + + + ! Find the grid level that contains the altitude less than or + ! equal to the current altitude - depth + k_low = binary_search( gr%nz, gr%zt, gr%zt(k)-depth ) + ! If the current altitude - depth is less than the lowest + ! altitude, binary_search returns a value of -1 + if ( k_low == -1 ) k_low = 2 + + if ( k_low == 2 ) then + ! Current altitude - depth is less than or exactly at grid level 2. + ! Since grid level 1 is a ghost point, use the altitude at grid level 2 + zt_low = gr%zt(k_low) + um_low = um(k_low) + vm_low = vm(k_low) + else if ( gr%zt(k_low) == gr%zt(k)-depth ) then + ! Current altitude - depth falls exactly on another grid level. + ! In this case, no interpolation is necessary. + zt_low = gr%zt(k_low) + um_low = um(k_low) + vm_low = vm(k_low) + else ! Do an interpolation to find um at current altitude - depth. + zt_low = gr%zt(k)-depth + um_low = lin_int( zt_low, gr%zt(k_low), gr%zt(k_low-1), & + um(k_low), um(k_low-1) ) + vm_low = lin_int( zt_low, gr%zt(k_low), gr%zt(k_low-1), & + vm(k_low), vm(k_low-1) ) + end if ! k_low ... + + return + end subroutine find_endpts_for_vert_avg_winds + + !============================================================================= + subroutine pos_definite_variances( solve_type, dt, tolerance, & + rho_ds_zm, rho_ds_zt, & + xp2_np1 ) + + ! Description: + ! Use the hole filling code to make a variance term positive definite + !----------------------------------------------------------------------- + + use crmx_fill_holes, only: fill_holes_driver + use crmx_grid_class, only: gr + use crmx_clubb_precision, only: time_precision, core_rknd + + use crmx_stats_variables, only: & + zm, l_stats_samp, & + irtp2_pd, ithlp2_pd, iup2_pd, ivp2_pd ! variables + use crmx_stats_type, only: & + stat_begin_update, stat_end_update ! subroutines + + + implicit none + + ! External + intrinsic :: any, real, trim + + ! Input variables + integer, intent(in) :: & + solve_type + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep [s] + + real( kind = core_rknd ), intent(in) :: & + tolerance ! Threshold for xp2_np1 [units vary] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt ! Dry, static density on thermodynamic levels [kg/m^3] + + ! Input/Output variables + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + xp2_np1 ! Variance for [units vary] + + ! Local variables + integer :: & + ixp2_pd + + select case( solve_type ) + case ( xp2_xpyp_rtp2 ) + ixp2_pd = irtp2_pd + case ( xp2_xpyp_thlp2 ) + ixp2_pd = ithlp2_pd + case ( xp2_xpyp_up2 ) + ixp2_pd = iup2_pd + case ( xp2_xpyp_vp2 ) + ixp2_pd = ivp2_pd + case default + ixp2_pd = 0 ! This includes the passive scalars + end select + + if ( l_stats_samp ) then + ! Store previous value for effect of the positive definite scheme + call stat_begin_update( ixp2_pd, xp2_np1 / real( dt, kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + endif + + + if ( any( xp2_np1 < tolerance ) ) then + + ! Call the hole-filling scheme. + ! The first pass-through should draw from only two levels on either side + ! of the hole. + call fill_holes_driver( 2, tolerance, "zm", & ! Intent(in) + rho_ds_zt, rho_ds_zm, & ! Intent(in) + xp2_np1 ) ! Intent(inout) + + endif + + if ( l_stats_samp ) then + ! Store previous value for effect of the positive definite scheme + call stat_end_update( ixp2_pd, xp2_np1 / real( dt, kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + endif + + + return + end subroutine pos_definite_variances + + !============================================================================ + subroutine update_xp2_mc_tndcy( nz, dt, cloud_frac, rcm, rvm, thlm, & + exner, rrainm_evap, pdf_params, & + rtp2_mc_tndcy, thlp2_mc_tndcy ) + !Description: + !This subroutine is for use when l_morr_xp2_mc_tndcy = .true. + !The effects of rain evaporation on rtp2 and thlp2 are included by + !assuming rain falls through the moist (cold) portion of the pdf. + !This is accomplished by defining a precip_fraction and assuming a double + !delta shaped pdf, such that the evaporation makes the moist component + !moister and the colder component colder. --storer + + use crmx_pdf_parameter_module, only: pdf_parameter + + use crmx_constants_clubb, only: & + cloud_frac_min, & !Variables + Cp, & + Lv + + use crmx_clubb_precision, only: & + core_rknd, & ! Variable(s) + time_precision + + implicit none + + !input parameters + integer, intent(in) :: nz ! Points in the Vertical [-] + + real( kind = time_precision ), intent(in) :: dt ! Model timestep [s] + + real( kind = core_rknd ), dimension(nz), intent(in) :: & + cloud_frac, & !Cloud fraction [-] + rcm, & !Cloud water mixing ratio [kg/kg] + rvm, & !Vapor water mixing ratio [kg/kg] + thlm, & !Liquid potential temperature [K] + exner, & !Exner function [-] + rrainm_evap !Evaporation of rain [kg/kg/s] + + type(pdf_parameter), target, dimension(nz), intent(in) :: & + pdf_params ! PDF parameters + + !input/output variables + real( kind = core_rknd ), dimension(nz), intent(inout) :: & + rtp2_mc_tndcy, & !Tendency of rtp2 due to evaporation [(kg/kg)^2/s] + thlp2_mc_tndcy !Tendency of thlp2 due to evaporation [K^2/s] + + !local variables + real( kind = core_rknd ), dimension(nz) :: & + temp_rtp2, & !Used only to calculate rtp2_mc_tndcy [(kg/kg)^2] + temp_thlp2, & !Used to calculate thlp2_mc_tndcy [K^2/s] + precip_frac, & !Precipitation fraction [-] + pf_const ! ( 1 - pf )/( pf ) [-] + + integer :: k + + ! ---- Begin Code ---- + + ! Calculate precip_frac + precip_frac(nz) = 0.0_core_rknd + do k = nz-1, 1, -1 + if ( cloud_frac(k) > cloud_frac_min ) then + precip_frac(k) = cloud_frac(k) + else + precip_frac(k) = precip_frac(k+1) + end if + end do + + !Calculate increased variance (rtp2 and thlp2) due to rain evaporation + + where ( precip_frac > cloud_frac_min ) + pf_const = ( 1.0_core_rknd - precip_frac ) / precip_frac + else where + pf_const = 0.0_core_rknd + end where + + ! Include effects of rain evaporation on rtp2 + temp_rtp2 = pdf_params%mixt_frac * ( ( pdf_params%rt1 - ( rcm + rvm ) )**2 & + + pdf_params%varnce_rt1 ) + ( 1.0_core_rknd - pdf_params%mixt_frac ) & + * ( ( pdf_params%rt2 - ( rcm + rvm ) )**2 + pdf_params%varnce_rt2 ) + + rtp2_mc_tndcy = rrainm_evap**2 * pf_const * dt & + + 2.0_core_rknd * abs(rrainm_evap) * sqrt(temp_rtp2 * pf_const) + !use absolute value of evaporation, as evaporation will add + !to rt1 + + !Include the effects of rain evaporation on thlp2 + temp_thlp2 = pdf_params%mixt_frac * ( ( pdf_params%thl1 - thlm )**2 & + + pdf_params%varnce_thl1 ) + ( 1.0_core_rknd - pdf_params%mixt_frac ) & + * ( ( pdf_params%thl2 - thlm )**2 + pdf_params%varnce_thl2 ) + + thlp2_mc_tndcy = ( rrainm_evap * Lv / ( Cp * exner) )**2 * pf_const * dt & + + 2.0_core_rknd * rrainm_evap * Lv / ( Cp * exner ) & + * sqrt(temp_thlp2 * pf_const) + + end subroutine update_xp2_mc_tndcy + +!=============================================================================== + +end module crmx_advance_xp2_xpyp_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 b/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 new file mode 100644 index 0000000000..4298620c1d --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 @@ -0,0 +1,228 @@ +! $Id: anl_erf.F90 5324 2011-07-27 21:05:45Z dschanen@uwm.edu $ +module crmx_anl_erf + + implicit none + + public :: erf + + interface erf + module procedure dp_erf, sp_erf + end interface + + private :: dp_erf, sp_erf + + private ! Default Scope + + contains + + function dp_erf( x ) result( erfx ) +!----------------------------------------------------------------------- +! Description: +! DP_ERF evaluates the error function DP_ERF(X). +! +! Original Author: +! William Cody, +! Mathematics and Computer Science Division, +! Argonne National Laboratory, +! Argonne, Illinois, 60439. +! +! References: +! William Cody, +! "Rational Chebyshev approximations for the error function", +! Mathematics of Computation, +! 1969, pages 631-638. +! +! Arguments: +! Input, real ( kind = 8 ) X, the argument of ERF. +! Output, real ( kind = 8 ) ERFX, the value of ERF(X). +!----------------------------------------------------------------------- + + implicit none + + ! Input Variables(s) + double precision, intent(in) :: x + + ! External + intrinsic :: epsilon, exp, aint + + ! Local Constants + real( kind = 8 ), parameter, dimension( 5 ) :: & + a = (/ 3.16112374387056560D+00, & + 1.13864154151050156D+02, & + 3.77485237685302021D+02, & + 3.20937758913846947D+03, & + 1.85777706184603153D-01 /) + real( kind = 8 ), parameter, dimension( 4 ) :: & + b = (/ 2.36012909523441209D+01, & + 2.44024637934444173D+02, & + 1.28261652607737228D+03, & + 2.84423683343917062D+03 /) + real( kind = 8 ), parameter, dimension( 9 ) :: & + c = (/ 5.64188496988670089D-01, & + 8.88314979438837594D+00, & + 6.61191906371416295D+01, & + 2.98635138197400131D+02, & + 8.81952221241769090D+02, & + 1.71204761263407058D+03, & + 2.05107837782607147D+03, & + 1.23033935479799725D+03, & + 2.15311535474403846D-08 /) + real( kind = 8 ), parameter, dimension( 8 ) :: & + d = (/ 1.57449261107098347D+01, & + 1.17693950891312499D+02, & + 5.37181101862009858D+02, & + 1.62138957456669019D+03, & + 3.29079923573345963D+03, & + 4.36261909014324716D+03, & + 3.43936767414372164D+03, & + 1.23033935480374942D+03 /) + real( kind = 8 ), parameter, dimension( 6 ) :: & + p = (/ 3.05326634961232344D-01, & + 3.60344899949804439D-01, & + 1.25781726111229246D-01, & + 1.60837851487422766D-02, & + 6.58749161529837803D-04, & + 1.63153871373020978D-02 /) + + real( kind = 8 ), parameter, dimension( 5 ) :: & + q = (/ 2.56852019228982242D+00, & + 1.87295284992346047D+00, & + 5.27905102951428412D-01, & + 6.05183413124413191D-02, & + 2.33520497626869185D-03 /) + + real( kind = 8 ), parameter :: & + SQRPI = 0.56418958354775628695D+00, & + THRESH = 0.46875D+00, & + XBIG = 26.543D+00 + + ! Return type + real( kind = 8 ) :: erfx + + ! Local variables + real( kind = 8 ) :: & + del, & + xabs, & + xden, & + xnum, & + xsq + + integer :: i ! Index + +!------------------------------------------------------------------------------- + xabs = abs( x ) + + ! + ! Evaluate ERF(X) for |X| <= 0.46875. + ! + if ( xabs <= THRESH ) then + + if ( epsilon( xabs ) < xabs ) then + xsq = xabs * xabs + else + xsq = 0.0D+00 + end if + + xnum = a(5) * xsq + xden = xsq + do i = 1, 3 + xnum = ( xnum + a(i) ) * xsq + xden = ( xden + b(i) ) * xsq + end do + + erfx = x * ( xnum + a(4) ) / ( xden + b(4) ) + ! + ! Evaluate ERFC(X) for 0.46875 <= |X| <= 4.0. + ! + else if ( xabs <= 4.0D+00 ) then + + xnum = c(9) * xabs + xden = xabs + do i = 1, 7 + xnum = ( xnum + c(i) ) * xabs + xden = ( xden + d(i) ) * xabs + end do + + erfx = ( xnum + c(8) ) / ( xden + d(8) ) + xsq = aint( xabs * 16.0D+00 ) / 16.0D+00 + del = ( xabs - xsq ) * ( xabs + xsq ) + ! xsq * xsq in the exponential was changed to xsq**2. + ! This seems to decrease runtime by about a half a percent. + ! ~~EIHoppe//20090622 + erfx = exp( - xsq**2 ) * exp( - del ) * erfx + + erfx = ( 0.5D+00 - erfx ) + 0.5D+00 + + if ( x < 0.0D+00 ) then + erfx = - erfx + end if + ! + ! Evaluate ERFC(X) for 4.0 < |X|. + ! + else + + if ( XBIG <= xabs ) then + + if ( 0.0D+00 < x ) then + erfx = 1.0D+00 + else + erfx = -1.0D+00 + end if + + else + + xsq = 1.0D+00 / ( xabs * xabs ) + + xnum = p(6) * xsq + xden = xsq + do i = 1, 4 + xnum = ( xnum + p(i) ) * xsq + xden = ( xden + q(i) ) * xsq + end do + + erfx = xsq * ( xnum + p(5) ) / ( xden + q(5) ) + erfx = ( SQRPI - erfx ) / xabs + xsq = aint( xabs * 16.0D+00 ) / 16.0D+00 + del = ( xabs - xsq ) * ( xabs + xsq ) + erfx = exp( - xsq * xsq ) * exp( - del ) * erfx + + erfx = ( 0.5D+00 - erfx ) + 0.5D+00 + if ( x < 0.0D+00 ) then + erfx = - erfx + end if + + end if + + end if + + return + end function dp_erf + +!----------------------------------------------------------------------- + function sp_erf( x ) result( erfx ) + +! Description: +! Return a truncation of the 64bit approx. of the error function. +! Ideally we would probably use a 32bit table for our approx. + +! References: +! None +!----------------------------------------------------------------------- + + implicit none + + ! External + intrinsic :: real + + ! Input Variables + real( kind=4 ), intent(in) :: x + + ! Return type + real( kind=4 ) :: erfx + + erfx = real( dp_erf( real(x, kind=8) ), kind=4 ) + + return + end function sp_erf + +end module crmx_anl_erf diff --git a/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 b/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 new file mode 100644 index 0000000000..41c5b7f38d --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 @@ -0,0 +1,37 @@ +!----------------------------------------------------------------------- +! $Id: array_index.F90 5216 2011-06-06 18:58:41Z dschanen@uwm.edu $ +!----------------------------------------------------------------------- +module crmx_array_index + +! Description: +! Contains indices to variables in larger arrays. +! Note that the 'ii' is necessary because 'i' is used in +! statistics to track locations in the zt/zm/sfc derived types. + +! References: +! None +!----------------------------------------------------------------------- + implicit none + + ! Variables + ! Microphysics mixing ratios + integer, public :: & + iirrainm, iirsnowm, iiricem, iirgraupelm ! [kg/kg] +!$omp threadprivate(iirrainm, iirsnowm, iiricem, iirgraupelm) + + ! Microphysics number concentration + integer, public :: & + iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm ! [#/kg] +!$omp threadprivate(iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm) + + ! Scalar quantities + integer, public :: & + iisclr_rt, iisclr_thl, iisclr_CO2, & ! [kg/kg]/[K]/[1e6 mol/mol] + iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2 ! " " +!$omp threadprivate(iisclr_rt, iisclr_thl, iisclr_CO2, & +!$omp iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2) + + private ! Default Scope + +end module crmx_array_index +!----------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 b/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 new file mode 100644 index 0000000000..28d7987614 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 @@ -0,0 +1,250 @@ +!$Id: calendar.F90 5867 2012-07-03 21:06:44Z dschanen@uwm.edu $ +module crmx_calendar + + implicit none + + public :: gregorian2julian_date, julian2gregorian_date, & + leap_year, compute_current_date, & + gregorian2julian_day + + private ! Default Scope + + ! Constant Parameters + + ! 3 Letter Month Abbreviations + character(len=3), dimension(12), public, parameter :: & + month_names = (/'JAN','FEB','MAR','APR','MAY','JUN', & + 'JUL','AUG','SEP','OCT','NOV','DEC'/) + + ! Number of days per month (Jan..Dec) for a non leap year + integer, public, dimension(12), parameter :: & + days_per_month = (/31, 28, 31, 30, 31, 30, & + 31, 31, 30, 31, 30, 31/) + + contains +!----------------------------------------------------------------------- + integer function gregorian2julian_date( day, month, year ) +! +! Description: +! Computes the Julian Date (gregorian2julian), or the number of days since +! 1 January 4713 BC, given a Gregorian Calender date (day, month, year). +! +! Reference: +! Fliegel, H. F. and van Flandern, T. C., +! Communications of the ACM, Vol. 11, No. 10 (October, 1968) +!---------------------------------------------------------------------- + + implicit none + + ! Input Variables + integer, intent(in) :: & + day, & ! Gregorian Calendar Day for given Month [dd] + month, & ! Gregorian Calendar Month for given Year [mm] + year ! Gregorian Calendar Year [yyyy] + + ! Local Variables + integer :: I,J,K + + I = year + J = month + K = day + + gregorian2julian_date = K-32075+1461*(I+4800+(J-14)/12)/4+367* & + (J-2-(J-14)/12*12)/12-3*((I+4900+(J-14)/12)/100)/4 + + return + end function gregorian2julian_date + +!------------------------------------------------------------------ + subroutine julian2gregorian_date & + ( julian_date, day, month, year ) +! +! Description: +! Computes the Gregorina Calendar date (day, month, year) +! given the Julian date (julian_date). +! +! Reference: +! Fliegel, H. F. and van Flandern, T. C., +! Communications of the ACM, Vol. 11, No. 10 (October, 1968) +! http://portal.acm.org/citation.cfm?id=364097 +!------------------------------------------------------------------ + implicit none + + ! Input Variable(s) + integer, intent(in) :: julian_date ! Julian date being converted from + + ! Output Variable(s) + integer, intent(out):: & + day, & ! Gregorian calender day for given Month [dd] + month, & ! Gregorian calender month for given Year [mm] + year ! Gregorian calender year [yyyy] + + ! Local Variables + integer :: i, j, k, n, l + + ! ---- Begin Code ---- + + L = julian_date+68569 ! Known magic number + N = 4*L/146097 ! Known magic number + L = L-(146097*N+3)/4 ! Known magic number + I = 4000*(L+1)/1461001 ! Known magic number + L = L-1461*I/4+31 ! Known magic number + J = 80*L/2447 ! Known magic number + K = L-2447*J/80 ! Known magic number + L = J/11 ! Known magic number + J = J+2-12*L ! Known magic number + I = 100*(N-49)+I+L ! Known magic number + + year = I + month = J + day = K + + return + + end subroutine julian2gregorian_date + +!----------------------------------------------------------------------------- + logical function leap_year( year ) +! +! Description: +! Determines if the given year is a leap year. +! +! References: +! None +!----------------------------------------------------------------------------- + implicit none + + ! External + intrinsic :: mod + + ! Input Variable(s) + integer, intent(in) :: year ! Gregorian Calendar Year [yyyy] + + ! ---- Begin Code ---- + + leap_year = ( (mod( year, 4 ) == 0) .and. & + (.not.( mod( year, 100 ) == 0 .and. mod( year, 400 ) /= 0 ) ) ) + + return + end function leap_year + +!---------------------------------------------------------------------------- + subroutine compute_current_date( previous_day, previous_month, & + previous_year, & + seconds_since_previous_date, & + current_day, current_month, & + current_year, & + seconds_since_current_date ) +! +! Description: +! Computes the current Gregorian date from a previous date and +! the seconds that have transpired since that date. +! +! References: +! None +!---------------------------------------------------------------------------- + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + use crmx_constants_clubb, only: & + sec_per_day ! Variable(s) + + implicit none + + ! Input Variable(s) + + ! Previous date + integer, intent(in) :: & + previous_day, & ! Day of the month [dd] + previous_month, & ! Month of the year [mm] + previous_year ! Year [yyyy] + + real(kind=time_precision), intent(in) :: & + seconds_since_previous_date ! [s] + + ! Output Variable(s) + + ! Current date + integer, intent(out) :: & + current_day, & ! Day of the month [dd] + current_month, & ! Month of the year [mm] + current_year ! Year [yyyy] + + real(kind=time_precision), intent(out) :: & + seconds_since_current_date + + integer :: & + days_since_1jan4713bc, & + days_since_start + + ! ---- Begin Code ---- + + ! Using Julian dates we are able to add the days that the model + ! has been running + + ! Determine the Julian Date of the starting date, + ! written in Gregorian (day, month, year) form + days_since_1jan4713bc = gregorian2julian_date( previous_day, & + previous_month, previous_year ) + + ! Determine the amount of days that have passed since start date + days_since_start = & + floor( seconds_since_previous_date / sec_per_day ) + + ! Set days_since_1jan4713 to the present Julian date + days_since_1jan4713bc = days_since_1jan4713bc + days_since_start + + ! Set Present time to be seconds since the Julian date + seconds_since_current_date = seconds_since_previous_date & + - ( real( days_since_start, kind=time_precision ) * sec_per_day ) + + call julian2gregorian_date & + ( days_since_1jan4713bc, & + current_day, current_month, current_year ) + + return + end subroutine compute_current_date + +!------------------------------------------------------------------------------------- + integer function gregorian2julian_day( day, month, year ) +! +! Description: +! This subroutine determines the Julian day (1-366) +! for a given Gregorian calendar date(e.g. July 1, 2008). +! +! References: +! None +!------------------------------------------------------------------------------------- + + implicit none + + ! External + intrinsic :: sum + + ! Input Variable(s) + integer, intent(in) :: & + day, & ! Day of the Month [dd] + month, & ! Month of the Year [mm] + year ! Year [yyyy] + + ! ---- Begin Code ---- + + ! Add the days from the previous months + gregorian2julian_day = day + sum( days_per_month(1:month-1) ) + + ! Kluge for a leap year + ! If the date were 29 Feb 2000 this would not increment julian_day + ! However 01 March 2000 would need the 1 day bump + if ( leap_year( year ) .and. month > 2 ) then + gregorian2julian_day = gregorian2julian_day + 1 + end if + + if ( ( leap_year( year ) .and. gregorian2julian_day > 366 ) .or. & + ( .not. leap_year( year ) .and. gregorian2julian_day > 365 ) ) then + stop "Problem with Julian day conversion in gregorian2julian_day." + end if + + return + end function gregorian2julian_day + +end module crmx_calendar diff --git a/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 b/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 new file mode 100644 index 0000000000..ce73c9c88a --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 @@ -0,0 +1,859 @@ +!------------------------------------------------------------------------------- +! $Id: clip_explicit.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_clip_explicit + + implicit none + + private + + public :: clip_covars_denom, & + clip_covar, & + clip_variance, & + clip_skewness, & + clip_skewness_core + + ! Named constants to avoid string comparisons + integer, parameter, public :: & + clip_rtp2 = 1, & ! Named constant for rtp2 clipping + clip_thlp2 = 2, & ! Named constant for thlp2 clipping + clip_rtpthlp = 3, & ! Named constant for rtpthlp clipping + clip_up2 = 5, & ! Named constant for up2 clipping + clip_vp2 = 6, & ! Named constant for vp2 clipping +! clip_scalar = 7, & ! Named constant for scalar clipping + clip_wprtp = 8, & ! Named constant for wprtp clipping + clip_wpthlp = 9, & ! Named constant for wpthlp clipping + clip_upwp = 10, & ! Named constant for upwp clipping + clip_vpwp = 11, & ! Named constant for vpwp clipping + clip_wp2 = 12, & ! Named constant for wp2 clipping + clip_wpsclrp = 13, & ! Named constant for wp scalar clipping + clip_sclrp2 = 14, & ! Named constant for sclrp2 clipping + clip_sclrprtp = 15, & ! Named constant for sclrprtp clipping + clip_sclrpthlp = 16 ! Named constant for sclrpthlp clipping + + contains + + !============================================================================= + subroutine clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & + sclrp2, wprtp_cl_num, wpthlp_cl_num, & + wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & + wprtp, wpthlp, upwp, vpwp, wpsclrp ) + + ! Description: + ! Some of the covariances found in the CLUBB model code need to be clipped + ! multiple times during each timestep to ensure that the correlation between + ! the two relevant variables stays between -1 and 1 at all times during the + ! model run. The covariances that need to be clipped multiple times are + ! w'r_t', w'th_l', w'sclr', u'w', and v'w'. One of the times that each one + ! of these covariances is clipped is immediately after each one is set. + ! However, each covariance still needs to be clipped two more times during + ! each timestep (once after advance_xp2_xpyp is called and once after + ! advance_wp2_wp3 is called). This subroutine handles the times that the + ! covariances are clipped away from the time that they are set. In other + ! words, this subroutine clips the covariances after the denominator terms + ! in the relevant correlation equation have been altered, ensuring that + ! all correlations will remain between -1 and 1 at all times. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_parameters_model, only: & + sclr_dim ! Variable(s) + + use crmx_model_flags, only: & + l_tke_aniso ! Logical + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_modify ! Procedure(s) + + use crmx_stats_variables, only: & + iwprtp_bt, & ! Variable(s) + iwpthlp_bt, & + zm, & + l_stats_samp + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + rtp2, & ! r_t'^2 [(kg/kg)^2] + thlp2, & ! theta_l'^2 [K^2] + up2, & ! u'^2 [m^2/s^2] + vp2, & ! v'^2 [m^2/s^2] + wp2 ! w'^2 [m^2/s^2] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(in) :: & + sclrp2 ! sclr'^2 [{units vary}^2] + + integer, intent(in) :: & + wprtp_cl_num, & + wpthlp_cl_num, & + wpsclrp_cl_num, & + upwp_cl_num, & + vpwp_cl_num + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wprtp, & ! w'r_t' [(kg/kg) m/s] + wpthlp, & ! w'theta_l' [K m/s] + upwp, & ! u'w' [m^2/s^2] + vpwp ! v'w' [m^2/s^2] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & + wpsclrp ! w'sclr' [units m/s] + + ! Local Variables + logical :: & + l_first_clip_ts, & ! First instance of clipping in a timestep. + l_last_clip_ts ! Last instance of clipping in a timestep. + + real( kind = core_rknd ), dimension(gr%nz) :: & + wprtp_chnge, & ! Net change in w'r_t' due to clipping [(kg/kg) m/s] + wpthlp_chnge, & ! Net change in w'th_l' due to clipping [K m/s] + upwp_chnge, & ! Net change in u'w' due to clipping [m^2/s^2] + vpwp_chnge ! Net change in v'w' due to clipping [m^2/s^2] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & + wpsclrp_chnge ! Net change in w'sclr' due to clipping [{units vary}] + + integer :: i ! scalar array index. + + ! ---- Begin Code ---- + + !!! Clipping for w'r_t' + ! + ! Clipping w'r_t' at each vertical level, based on the + ! correlation of w and r_t at each vertical level, such that: + ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ]; + ! -1 <= corr_(w,r_t) <= 1. + ! + ! Since w'^2, r_t'^2, and w'r_t' are each advanced in different + ! subroutines from each other in advance_clubb_core, clipping for w'r_t' + ! is done three times during each timestep (once after each variable has + ! been updated). + ! + ! This subroutine handles the first and third instances of + ! w'r_t' clipping. + ! The first instance of w'r_t' clipping takes place after + ! r_t'^2 is updated in advance_xp2_xpyp. + ! The third instance of w'r_t' clipping takes place after + ! w'^2 is updated in advance_wp2_wp3. + + ! Include effect of clipping in wprtp time tendency budget term. + if ( l_stats_samp ) then + + ! if wprtp_cl_num == 1 do nothing since + ! iwprtp_bt stat_begin_update is called outside of this method + + if ( wprtp_cl_num == 2 ) then + ! wprtp total time tendency (effect of clipping) + call stat_modify( iwprtp_bt, -wprtp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + elseif ( wprtp_cl_num == 3 ) then + ! wprtp total time tendency (effect of clipping) + call stat_modify( iwprtp_bt, -wprtp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + endif + endif + + ! Used within subroutine clip_covar. + if ( wprtp_cl_num == 1 ) then + l_first_clip_ts = .true. + l_last_clip_ts = .false. + elseif ( wprtp_cl_num == 2 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .false. + elseif ( wprtp_cl_num == 3 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .true. + endif + + ! Clip w'r_t' + call clip_covar( clip_wprtp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, rtp2, & ! intent(in) + wprtp, wprtp_chnge ) ! intent(inout) + + if ( l_stats_samp ) then + if ( wprtp_cl_num == 1 ) then + ! wprtp total time tendency (effect of clipping) + call stat_modify( iwprtp_bt, wprtp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + elseif ( wprtp_cl_num == 2 ) then + ! wprtp total time tendency (effect of clipping) + call stat_modify( iwprtp_bt, wprtp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + ! if wprtp_cl_num == 3 do nothing since + ! iwprtp_bt stat_end_update is called outside of this method + + endif + endif + + + !!! Clipping for w'th_l' + ! + ! Clipping w'th_l' at each vertical level, based on the + ! correlation of w and th_l at each vertical level, such that: + ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ]; + ! -1 <= corr_(w,th_l) <= 1. + ! + ! Since w'^2, th_l'^2, and w'th_l' are each advanced in different + ! subroutines from each other in advance_clubb_core, clipping for w'th_l' + ! is done three times during each timestep (once after each variable has + ! been updated). + ! + ! This subroutine handles the first and third instances of + ! w'th_l' clipping. + ! The first instance of w'th_l' clipping takes place after + ! th_l'^2 is updated in advance_xp2_xpyp. + ! The third instance of w'th_l' clipping takes place after + ! w'^2 is updated in advance_wp2_wp3. + + ! Include effect of clipping in wpthlp time tendency budget term. + if ( l_stats_samp ) then + + ! if wpthlp_cl_num == 1 do nothing since + ! iwpthlp_bt stat_begin_update is called outside of this method + + if ( wpthlp_cl_num == 2 ) then + ! wpthlp total time tendency (effect of clipping) + call stat_modify( iwpthlp_bt, -wpthlp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + elseif ( wpthlp_cl_num == 3 ) then + ! wpthlp total time tendency (effect of clipping) + call stat_modify( iwpthlp_bt, -wpthlp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + endif + endif + + ! Used within subroutine clip_covar. + if ( wpthlp_cl_num == 1 ) then + l_first_clip_ts = .true. + l_last_clip_ts = .false. + elseif ( wpthlp_cl_num == 2 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .false. + elseif ( wpthlp_cl_num == 3 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .true. + endif + + ! Clip w'th_l' + call clip_covar( clip_wpthlp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, thlp2, & ! intent(in) + wpthlp, wpthlp_chnge ) ! intent(inout) + + + if ( l_stats_samp ) then + if ( wpthlp_cl_num == 1 ) then + ! wpthlp total time tendency (effect of clipping) + call stat_modify( iwpthlp_bt, wpthlp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + elseif ( wpthlp_cl_num == 2 ) then + ! wpthlp total time tendency (effect of clipping) + call stat_modify( iwpthlp_bt, wpthlp / real( dt, kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + + ! if wpthlp_cl_num == 3 do nothing since + ! iwpthlp_bt stat_end_update is called outside of this method + + endif + endif + + + !!! Clipping for w'sclr' + ! + ! Clipping w'sclr' at each vertical level, based on the + ! correlation of w and sclr at each vertical level, such that: + ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ]; + ! -1 <= corr_(w,sclr) <= 1. + ! + ! Since w'^2, sclr'^2, and w'sclr' are each advanced in different + ! subroutines from each other in advance_clubb_core, clipping for w'sclr' + ! is done three times during each timestep (once after each variable has + ! been updated). + ! + ! This subroutine handles the first and third instances of + ! w'sclr' clipping. + ! The first instance of w'sclr' clipping takes place after + ! sclr'^2 is updated in advance_xp2_xpyp. + ! The third instance of w'sclr' clipping takes place after + ! w'^2 is updated in advance_wp2_wp3. + + ! Used within subroutine clip_covar. + if ( wpsclrp_cl_num == 1 ) then + l_first_clip_ts = .true. + l_last_clip_ts = .false. + elseif ( wpsclrp_cl_num == 2 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .false. + elseif ( wpsclrp_cl_num == 3 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .true. + endif + + ! Clip w'sclr' + do i = 1, sclr_dim, 1 + call clip_covar( clip_wpsclrp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2(:), sclrp2(:,i), & ! intent(in) + wpsclrp(:,i), wpsclrp_chnge(:,i) ) ! intent(inout) + enddo + + + !!! Clipping for u'w' + ! + ! Clipping u'w' at each vertical level, based on the + ! correlation of u and w at each vertical level, such that: + ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ]; + ! -1 <= corr_(u,w) <= 1. + ! + ! Since w'^2, u'^2, and u'w' are each advanced in different + ! subroutines from each other in advance_clubb_core, clipping for u'w' + ! is done three times during each timestep (once after each variable has + ! been updated). + ! + ! This subroutine handles the first and second instances of + ! u'w' clipping. + ! The first instance of u'w' clipping takes place after + ! u'^2 is updated in advance_xp2_xpyp. + ! The second instance of u'w' clipping takes place after + ! w'^2 is updated in advance_wp2_wp3. + + ! Used within subroutine clip_covar. + if ( upwp_cl_num == 1 ) then + l_first_clip_ts = .true. + l_last_clip_ts = .false. + elseif ( upwp_cl_num == 2 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .false. + elseif ( upwp_cl_num == 3 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .true. + endif + + ! Clip u'w' + if ( l_tke_aniso ) then + call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, up2, & ! intent(in) + upwp, upwp_chnge ) ! intent(inout) + else + ! In this case, up2 = wp2, and the variable `up2' does not interact + call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, wp2, & ! intent(in) + upwp, upwp_chnge ) ! intent(inout) + end if + + + + !!! Clipping for v'w' + ! + ! Clipping v'w' at each vertical level, based on the + ! correlation of v and w at each vertical level, such that: + ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ]; + ! -1 <= corr_(v,w) <= 1. + ! + ! Since w'^2, v'^2, and v'w' are each advanced in different + ! subroutines from each other in advance_clubb_core, clipping for v'w' + ! is done three times during each timestep (once after each variable has + ! been updated). + ! + ! This subroutine handles the first and second instances of + ! v'w' clipping. + ! The first instance of v'w' clipping takes place after + ! v'^2 is updated in advance_xp2_xpyp. + ! The second instance of v'w' clipping takes place after + ! w'^2 is updated in advance_wp2_wp3. + + ! Used within subroutine clip_covar. + if ( vpwp_cl_num == 1 ) then + l_first_clip_ts = .true. + l_last_clip_ts = .false. + elseif ( vpwp_cl_num == 2 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .false. + elseif ( vpwp_cl_num == 3 ) then + l_first_clip_ts = .false. + l_last_clip_ts = .true. + endif + + if ( l_tke_aniso ) then + call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, vp2, & ! intent(in) + vpwp, vpwp_chnge ) ! intent(inout) + else + ! In this case, vp2 = wp2, and the variable `vp2' does not interact + call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) + l_last_clip_ts, dt, wp2, wp2, & ! intent(in) + vpwp, vpwp_chnge ) ! intent(inout) + end if + + + return + end subroutine clip_covars_denom + + !============================================================================= + subroutine clip_covar( solve_type, l_first_clip_ts, & + l_last_clip_ts, dt, xp2, yp2, & + xpyp, xpyp_chnge ) + + ! Description: + ! Clipping the value of covariance x'y' based on the correlation between x + ! and y. + ! + ! The correlation between variables x and y is: + ! + ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ]; + ! + ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is + ! the covariance of x and y. + ! + ! The correlation of two variables must always have a value between -1 + ! and 1, such that: + ! + ! -1 <= corr_(x,y) <= 1. + ! + ! Therefore, there is an upper limit on x'y', such that: + ! + ! x'y' <= [ sqrt(x'^2) * sqrt(y'^2) ]; + ! + ! and a lower limit on x'y', such that: + ! + ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ]. + ! + ! The values of x'y', x'^2, and y'^2 are all found on momentum levels. + ! + ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is + ! updated. + ! + ! The following covariances are found in the code: + ! + ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp); + ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp); + ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm). + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + max_mag_correlation ! Constant(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_modify, & + stat_end_update + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + iwprtp_cl, & + iwpthlp_cl, & + irtpthlp_cl, & + l_stats_samp + + implicit none + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variable being solved; used for STATS. + + logical, intent(in) :: & + l_first_clip_ts, & ! First instance of clipping in a timestep. + l_last_clip_ts ! Last instance of clipping in a timestep. + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep; used here for STATS [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xp2, & ! Variance of x, x'^2 (momentum levels) [{x units}^2] + yp2 ! Variance of y, y'^2 (momentum levels) [{y units}^2] + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + xpyp ! Covariance of x and y, x'y' (momentum levels) [{x units}*{y units}] + + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + xpyp_chnge ! Net change in x'y' due to clipping [{x units}*{y units}] + + + ! Local Variable + integer :: k ! Array index + + integer :: & + ixpyp_cl + + ! ---- Begin Code ---- + + select case ( solve_type ) + case ( clip_wprtp ) ! wprtp clipping budget term + ixpyp_cl = iwprtp_cl + case ( clip_wpthlp ) ! wpthlp clipping budget term + ixpyp_cl = iwpthlp_cl + case ( clip_rtpthlp ) ! rtpthlp clipping budget term + ixpyp_cl = irtpthlp_cl + case default ! scalars (or upwp/vpwp) are involved + ixpyp_cl = 0 + end select + + + if ( l_stats_samp ) then + if ( l_first_clip_ts ) then + call stat_begin_update( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) + else + call stat_modify( ixpyp_cl, -xpyp / real( dt, kind = core_rknd ), zm ) + endif + endif + + ! The value of x'y' at the surface (or lower boundary) is a set value that + ! is either specified or determined elsewhere in a surface subroutine. It + ! is ensured elsewhere that the correlation between x and y at the surface + ! (or lower boundary) is between -1 and 1. Thus, the covariance clipping + ! code does not need to be invoked at the lower boundary. Likewise, the + ! value of x'y' is set at the upper boundary, so the covariance clipping + ! code does not need to be invoked at the upper boundary. + ! Note that if clipping were applied at the lower boundary, momentum will + ! not be conserved, therefore it should never be added. + do k = 2, gr%nz-1, 1 + + ! Clipping for xpyp at an upper limit corresponding with a correlation + ! between x and y of max_mag_correlation. + if ( xpyp(k) > max_mag_correlation * sqrt( xp2(k) * yp2(k) ) ) then + + xpyp_chnge(k) = max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - xpyp(k) + + xpyp(k) = max_mag_correlation * sqrt( xp2(k) * yp2(k) ) + + ! Clipping for xpyp at a lower limit corresponding with a correlation + ! between x and y of -max_mag_correlation. + elseif ( xpyp(k) < -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) ) then + + xpyp_chnge(k) = -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - xpyp(k) + + xpyp(k) = -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) + + else + + xpyp_chnge(k) = 0.0_core_rknd + + endif + + enddo ! k = 2..gr%nz + + ! Since there is no covariance clipping at the upper or lower boundaries, + ! the change in x'y' due to covariance clipping at those levels is 0. + xpyp_chnge(1) = 0.0_core_rknd + xpyp_chnge(gr%nz) = 0.0_core_rknd + + if ( l_stats_samp ) then + if ( l_last_clip_ts ) then + call stat_end_update( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) + else + call stat_modify( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) + endif + endif + + + return + end subroutine clip_covar + + !============================================================================= + subroutine clip_variance( solve_type, dt, threshold, & + xp2 ) + + ! Description: + ! Clipping the value of variance x'^2 based on a minimum threshold value. + ! The threshold value must be greater than or equal to 0. + ! + ! The values of x'^2 are found on the momentum levels. + ! + ! The following variances are found in the code: + ! + ! r_t'^2, th_l'^2, u'^2, v'^2, sclr'^2, (computed in advance_xp2_xpyp); + ! w'^2 (computed in advance_wp2_wp3). + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_end_update + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + iwp2_cl, & + irtp2_cl, & + ithlp2_cl, & + iup2_cl, & + ivp2_cl, & + l_stats_samp + + implicit none + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variable being solved; used for STATS. + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep; used here for STATS [s] + + real( kind = core_rknd ), intent(in) :: & + threshold ! Minimum value of x'^2 [{x units}^2] + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + xp2 ! Variance of x, x'^2 (momentum levels) [{x units}^2] + + ! Local Variables + integer :: k ! Array index + + + integer :: & + ixp2_cl + + ! ---- Begin Code ---- + + select case ( solve_type ) + case ( clip_wp2 ) ! wp2 clipping budget term + ixp2_cl = iwp2_cl + case ( clip_rtp2 ) ! rtp2 clipping budget term + ixp2_cl = irtp2_cl + case ( clip_thlp2 ) ! thlp2 clipping budget term + ixp2_cl = ithlp2_cl + case ( clip_up2 ) ! up2 clipping budget term + ixp2_cl = iup2_cl + case ( clip_vp2 ) ! vp2 clipping budget term + ixp2_cl = ivp2_cl + case default ! scalars are involved + ixp2_cl = 0 + end select + + + if ( l_stats_samp ) then + call stat_begin_update( ixp2_cl, xp2 / real( dt, kind = core_rknd ), zm ) + endif + + ! Limit the value of x'^2 at threshold. + ! The value of x'^2 at the surface (or lower boundary) is a set value that + ! is determined elsewhere in a surface subroutine. Thus, the variance + ! clipping code does not need to be invoked at the lower boundary. + ! Likewise, the value of x'^2 is set at the upper boundary, so the variance + ! clipping code does not need to be invoked at the upper boundary. + do k = 2, gr%nz-1, 1 + if ( xp2(k) < threshold ) then + xp2(k) = threshold + endif + enddo + + if ( l_stats_samp ) then + call stat_end_update( ixp2_cl, xp2 / real( dt, kind = core_rknd ), zm ) + endif + + + return + end subroutine clip_variance + + !============================================================================= + subroutine clip_skewness( dt, sfc_elevation, wp2_zt, wp3 ) + + ! Description: + ! Clipping the value of w'^3 based on the skewness of w, Sk_w. + ! + ! Aditionally, to prevent possible crashes due to wp3 growing too large, + ! abs(wp3) will be clipped to 100. + ! + ! The skewness of w is: + ! + ! Sk_w = w'^3 / (w'^2)^(3/2). + ! + ! The value of Sk_w is limited to a range between an upper limit and a lower + ! limit. The values of the limits depend on whether the level altitude is + ! within 100 meters of the surface. + ! + ! For altitudes less than or equal to 100 meters above ground level (AGL): + ! + ! -0.2_core_rknd*sqrt(2) <= Sk_w <= 0.2_core_rknd*sqrt(2); + ! + ! while for all altitudes greater than 100 meters AGL: + ! + ! -4.5_core_rknd <= Sk_w <= 4.5_core_rknd. + ! + ! Therefore, there is an upper limit on w'^3, such that: + ! + ! w'^3 <= threshold_magnitude * (w'^2)^(3/2); + ! + ! and a lower limit on w'^3, such that: + ! + ! w'^3 >= -threshold_magnitude * (w'^2)^(3/2). + ! + ! The values of w'^3 are found on the thermodynamic levels, while the values + ! of w'^2 are found on the momentum levels. Therefore, the values of w'^2 + ! are interpolated to the thermodynamic levels before being used to + ! calculate the upper and lower limits for w'^3. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_end_update + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + iwp3_cl, & + l_stats_samp + + implicit none + + ! External + intrinsic :: sign, sqrt, real + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep; used here for STATS [s] + + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] + + ! ---- Begin Code ---- + + if ( l_stats_samp ) then + call stat_begin_update( iwp3_cl, wp3 / real( dt, kind = core_rknd ), zt ) + endif + + call clip_skewness_core( sfc_elevation, wp2_zt, wp3 ) + + if ( l_stats_samp ) then + call stat_end_update( iwp3_cl, wp3 / real( dt, kind = core_rknd ), zt ) + endif + + return + end subroutine clip_skewness + +!============================================================================= + subroutine clip_skewness_core( sfc_elevation, wp2_zt, wp3 ) +! + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_constants_clubb, only: & + Skw_max_mag_sqd ! [-] + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: sign, sqrt, real + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + wp2_zt_cubed, & ! Variance of vertical velocity cubed (w^2_{zt}^3) [m^6/s^6] + wp3_lim_sqd ! Keeps absolute value of Sk_w from becoming > limit [m^6/s^6] + + integer :: k ! Vertical array index. + + real( kind = core_rknd ), parameter :: & + wp3_max = 100._core_rknd ! Threshold for wp3 [m^3/s^3] + + ! ---- Begin Code ---- + + ! Compute the upper and lower limits of w'^3 at every level, + ! based on the skewness of w, Sk_w, such that: + ! Sk_w = w'^3 / (w'^2)^(3/2); + ! -4.5 <= Sk_w <= 4.5; + ! or, if the level altitude is within 100 meters of the surface, + ! -0.2*sqrt(2) <= Sk_w <= 0.2*sqrt(2). + + ! The normal magnitude limit of skewness of w in the CLUBB code is 4.5. + ! However, according to Andre et al. (1976b & 1978), wp3 should not exceed + ! [2*(wp2^3)]^(1/2) at any level. However, this term should be multiplied + ! by 0.2 close to the surface to include surface effects. There already is + ! a wp3 clipping term in place for all other altitudes, but this term will + ! be included for the surface layer only. Therefore, the lowest level wp3 + ! should not exceed 0.2 * sqrt(2) * wp2^(3/2). Brian Griffin. 12/18/05. + + ! To lower compute time, we squared both sides of the equation and compute + ! wp2^3 only once. -dschanen 9 Oct 2008 + + wp2_zt_cubed(1:gr%nz) = wp2_zt(1:gr%nz)**3 + + do k = 1, gr%nz, 1 + if ( gr%zt(k) - sfc_elevation <= 100.0_core_rknd ) then ! Clip for 100 m. AGL. + !wp3_upper_lim(k) = 0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) + !wp3_lower_lim(k) = -0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) + wp3_lim_sqd(k) = 0.08_core_rknd * wp2_zt_cubed(k) ! Where 0.08_core_rknd + ! == (sqrt(2)*0.2_core_rknd)**2 known magic number + else ! Clip skewness consistently with a. + !wp3_upper_lim(k) = 4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) + !wp3_lower_lim(k) = -4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) + wp3_lim_sqd(k) = Skw_max_mag_sqd * wp2_zt_cubed(k) ! Skw_max_mag = 4.5_core_rknd^2 + endif + enddo + + ! Clipping for w'^3 at an upper and lower limit corresponding with + ! the appropriate value of Sk_w. + where ( wp3**2 > wp3_lim_sqd ) & + ! Set the magnitude to the wp3 limit and apply the sign of the current wp3 + wp3 = sign( sqrt( wp3_lim_sqd ), wp3 ) + + ! Clipping abs(wp3) to 100. This keeps wp3 from growing too large in some + ! deep convective cases, which helps prevent these cases from blowing up. + where ( abs(wp3) > wp3_max ) & + wp3 = sign( wp3_max , wp3 ) ! Known magic number + + end subroutine clip_skewness_core + +!=============================================================================== + +end module crmx_clip_explicit diff --git a/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 b/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 new file mode 100644 index 0000000000..4447d88325 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 @@ -0,0 +1,660 @@ +!----------------------------------------------------------------------- +! $Id: clip_semi_implicit.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_clip_semi_implicit + + ! Description of the semi-implicit clipping code: + ! The semi-implicit clipping code is based on an upper threshold and/or a + ! lower threshold value for variable f. + ! + ! The semi-implicit clipping code is used when the value of variable f should + ! not exceed the designated threshold(s) when it is advanced to timestep + ! index (t+1). + ! + ! + ! Clipping at an Upper Threshold: + ! + ! When there is an upper threshold to be applied, the equation for the clipped + ! value of the variable f, f_clipped, is: + ! + ! f_clipped(t+1) = MIN( f_unclipped(t+1), upper_threshold ) + ! = ( f_unclipped(t+1) - upper_threshold ) + ! * H(upper_threshold-f_unclipped(t+1)) + ! + upper_threshold; + ! + ! where f_unclipped is the value of the variable f without clipping, and + ! H(upper_threshold-f_unclipped(t+1)) is the Heaviside Step function. The + ! clipping term is turned into a time tendency term, such that: + ! + ! (df/dt)_clipping = (1/dt_clip) + ! * ( f_clipped(t+1) - f_unclipped(t+1) ); + ! + ! where dt_clip is the time scale for the clipping term. The difference + ! between the threshold value and f_unclipped is defined as f_diff: + ! + ! f_diff = upper_threshold - f_unclipped. + ! + ! The clipping time tendency is now simplified as: + ! + ! (df/dt)_clipping = + (1/dt_clip) + ! * { f_diff(t+1) * [ 1 - H(f_diff(t+1)) ] }. + ! + ! Function R(f_diff) is defined as: + ! + ! R(f_diff) = { f_diff * [ 1 - H(f_diff) ] }. + ! + ! The clipping time tendency is now written as: + ! + ! (df/dt)_clipping = + (1/dt_clip) * R(f_diff(t+1)). + ! + ! In order to solve for f_unclipped (and f_diff) at timestep index (t+1), the + ! clipping term must be linearized. A Taylor Series expansion (truncated + ! after the first derivative term) of R(f_diff) around f_diff = f_diff(t) is + ! used to linearize the term. However, the Heaviside Step function, + ! H(f_diff), is not differentiable when f_diff(t) = 0, as the function jumps + ! at that point. Likewise, the function R(f_diff) is not differentiable when + ! f_diff(t) = 0, as the function has a corner at that point. Therefore, a new + ! function, F_R(f_diff) is used as an approximation of R(f_diff). Function + ! F_R(f_diff) is a three-piece function that has the exact same value as + ! R(f_diff) when f_diff <= -sigma or f_diff >= sigma (sigma is an arbitrarily + ! declared value). However, when -sigma < f_diff < sigma, a parabolic + ! function is used to approximate the corner found in R(f_diff). The + ! parabolic function needs to have the same values at f_diff = -sigma and + ! f_diff = sigma as does R(f_diff). Furthermore, the derivative of the + ! parabolic function (with respect to f_diff) needs to have the same values at + ! f_diff = -sigma and f_diff = sigma as does d(R)/d(f_diff). The parabolic + ! function that satisfies these properities is: + ! f_diff - (sigma/4) * [ 1 + (f_diff/sigma) ]^2. + ! Therefore: + ! + ! | f_diff; where f_diff <= -sigma + ! | + ! F_R(f_diff) = | f_diff - (sigma/4) * [ 1 + (f_diff/sigma) ]^2; + ! | where -sigma < f_diff < sigma + ! | + ! | 0; where f_diff >= sigma; and + ! + ! | 1; where f_diff <= -sigma + ! | + ! ( d F_R / d f_diff ) = | 1 - (1/2) * [ 1 + (f_diff/sigma) ]; + ! | where -sigma < f_diff < sigma + ! | + ! | 0; where f_diff >= sigma. + ! + ! Since, R(f_diff(t+1)) approx.= F_R(f_diff(t+1)), the Taylor Series expansion + ! is done for F_R(f_diff) around f_diff = f_diff(t) in order to linearize the + ! term: + ! + ! F_R(f_diff(t+1)) approx.= + ! A_fnc + B_fnc * ( f_diff(t+1) - f_diff(t) ); + ! + ! where A_fnc is defined as F_R(f_diff(t)) and B_fnc is defined as + ! ( d F_R / d f_diff )|_(f_diff=f_diff(t)). + ! + ! The approximation is substituted into the (df/dt)_clipping equation. The + ! rate of change of variable f due to clipping with the upper threshold is: + ! + ! (df/dt)_clipping + ! = + (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) + ! + B_fnc * upper_threshold - B_fnc * f_unclipped(t+1) }. + ! + ! The implicit (LHS) portion of the equation for clipping with the upper + ! threshold is: + ! + ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The explicit (RHS) portion of the equation for clipping with the upper + ! threshold is: + ! + ! + (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) + B_fnc * upper_threshold }. + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(f)/dt equation. + ! + ! + ! Clipping at a Lower Threshold: + ! + ! When there is a lower threshold to be applied, the equation for the clipped + ! value of the variable f, f_clipped, is: + ! + ! f_clipped(t+1) = MAX( f_unclipped(t+1), lower_threshold ) + ! = ( f_unclipped(t+1) - lower_threshold ) + ! * H(f_unclipped(t+1)-lower_threshold) + ! + lower_threshold; + ! + ! where f_unclipped is the value of the variable f without clipping, and + ! H(f_unclipped(t+1)-lower_threshold) is the Heaviside Step function. The + ! clipping term is turned into a time tendency term, such that: + ! + ! (df/dt)_clipping = (1/dt_clip) + ! * ( f_clipped(t+1) - f_unclipped(t+1) ); + ! + ! where dt_clip is the time scale for the clipping term. The difference + ! between f_unclipped and the threshold value is defined as f_diff: + ! + ! f_diff = f_unclipped - lower_threshold. + ! + ! The clipping time tendency is now simplified as: + ! + ! (df/dt)_clipping = - (1/dt_clip) + ! * { f_diff(t+1) * [ 1 - H(f_diff(t+1)) ] }. + ! + ! Function R(f_diff) is defined as: + ! + ! R(f_diff) = { f_diff * [ 1 - H(f_diff) ] }. + ! + ! The clipping time tendency is now written as: + ! + ! (df/dt)_clipping = - (1/dt_clip) * R(f_diff(t+1)). + ! + ! The linearization process is the same for the lower threshold as it is for + ! the upper threshold. The formulas for A_fnc and B_fnc are the same, but the + ! values (based on a different f_diff) are different. The rate of change of + ! variable f due to clipping with the lower threshold is: + ! + ! (df/dt)_clipping + ! = - (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) + ! - B_fnc * lower_threshold + B_fnc * f_unclipped(t+1) }. + ! + ! The implicit (LHS) portion of the equation for clipping with the lower + ! threshold is: + ! + ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The explicit (RHS) portion of the equation for clipping with the lower + ! threshold is: + ! + ! - (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) - B_fnc * lower_threshold }. + ! + ! All variables in these equations are on the same vertical levels as the + ! variable f. + ! + ! + ! Adjustable parameters: + ! + ! sigma: sigma is the amount on either side of the threshold value to which + ! the parabolic function portion of F_R(f_diff) is applied. The value + ! of sigma must be greater than 0. A proportionally larger value of + ! sigma can be used to effect values of f that are near the threshold, + ! but not to it or over it. The close-to-threshold values will be + ! nudged away from the threshold. + ! + ! dt_clip: dt_clip is the clipping time scale. It can be set equal to the + ! model timestep, dt, but it doesn't have to be. Smaller values of + ! dt_clip produce a greater effect on the clipping term. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + implicit none + + private + + public :: clip_semi_imp_lhs, & + clip_semi_imp_rhs + + private :: compute_clip_lhs, & + compute_fncts_A_B + + ! Constant parameters. + + ! sigma coefficient: A coefficient with dimensionless units that must have a + ! value greater than 0. The value should be kept below 1. + ! The larger the value of sigma_coef, the larger the value + ! of sigma, and the larger the range of close-to-threshold + ! values that will be effected (nudged away from the + ! threshold) by the semi-implicit clipping. + real( kind = core_rknd ), parameter :: sigma_coef = 0.15_core_rknd + + ! dt_clip coefficient: A coefficient with dimensionless units that must have + ! a value greater than 0. A value of 1 will set the + ! clipping time scale, dt_clip, equal to the model + ! timestep, dt. The smaller the value of dt_clip_coef, + ! the smaller the value of dt_clip, and the larger the + ! magnitude of (df/dt)_clipping. + real(kind=time_precision), parameter :: dt_clip_coef = 1.0_time_precision + + contains + + !============================================================================= + function clip_semi_imp_lhs( dt, f_unclipped, & + l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold ) & + result( lhs ) + + ! Description: + ! The implicit portion of the semi-implicit clipping code. + ! + ! The implicit (LHS) portion of the equation for clipping with the upper + ! threshold is: + ! + ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). + ! + ! The implicit (LHS) portion of the equation for clipping with the lower + ! threshold is: + ! + ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). + ! + ! Note: When either term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of either term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of f being used is from the + ! next timestep, which is being advanced to in solving the d(f)/dt equation. + ! + ! While the formulas are the same for both the upper threshold and the lower + ! threshold, the values of A_fnc, B_fnc, and f_diff will differ between the + ! two thresholds. + ! + ! The overall implicit (LHS) portion for the clipping term is the sum of the + ! implicit portion from the upper threshold and the implicit portion from + ! the lower threshold. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s)implicit none + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep. [s] + + real( kind = core_rknd ), intent(in) :: & + f_unclipped, & ! The unclipped value of variable f at timestep (t). [f units] + upper_threshold, & ! Greatest allowable value of variable f. [f units] + lower_threshold ! Smallest allowable value of variable f. [f units] + + logical, intent(in) :: & + l_upper_thresh, & ! Flag for having an upper threshold value. + l_lower_thresh ! Flag for having a lower threshold value. + + ! Return Variable + real( kind = core_rknd ) :: lhs + + ! Local Variables + real(kind=time_precision) :: & + dt_clip ! Time scale for semi-implicit clipping term. [s] + + real( kind = core_rknd ) :: & + f_diff, & ! Difference between the threshold value and f_unclipped. [f units] + A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] + B_fnc, & ! Derivative w/ respect to f_diff of function A_fnc. [] + lhs_upper, & ! Contribution of upper threshold to implicit portion (LHS). [s^-1] + lhs_lower ! Contribution of lower threshold to implicit portion (LHS). [s^-1] + + + ! Compute the clipping time scale, dt_clip. + dt_clip = dt_clip_coef * dt + + + ! Upper Threshold + if ( l_upper_thresh ) then + + ! f_diff is the difference between the threshold value and f_unclipped. + ! In regards to the upper threshold, it is defined as + ! upper_threshold - f_unclipped. + f_diff = upper_threshold - f_unclipped + + ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) + ! for the upper threshold. + call compute_fncts_A_B( l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold, & + f_diff, A_fnc, B_fnc ) + + ! Compute the implicit (LHS) contribution from clipping for the upper + ! threshold. + lhs_upper = compute_clip_lhs( dt_clip, B_fnc ) + + else + + lhs_upper = 0.0_core_rknd + + endif + + + ! Lower Threshold + if ( l_lower_thresh ) then + + ! f_diff is the difference between the threshold value and f_unclipped. + ! In regards to the lower threshold, it is defined as + ! f_unclipped - lower_threshold. + f_diff = f_unclipped - lower_threshold + + ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) + ! for the lower threshold. + call compute_fncts_A_B( l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold, & + f_diff, A_fnc, B_fnc ) + + ! Compute the implicit (LHS) contribution from clipping for the lower + ! threshold. + lhs_lower = compute_clip_lhs( dt_clip, B_fnc ) + + else + + lhs_lower = 0.0_core_rknd + + endif + + + ! Total implicit (LHS) contribution to clipping. + ! Main diagonal: [ x f_unclipped(k,) ] + lhs = lhs_upper + lhs_lower + + + end function clip_semi_imp_lhs + + !============================================================================= + pure function compute_clip_lhs( dt_clip, B_fnc ) & + result( lhs_contribution ) + + ! Description: + ! Calculation of the implicit portion of the semi-implicit clipping term. + ! + ! The implicit portion of the semi-implicit clipping term is: + ! + ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of f being used is from the + ! next timestep, which is being advanced to in solving the d(f)/dt equation. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt_clip ! Time scale for semi-implicit clipping term. [s] + + real( kind = core_rknd ), intent(in) :: & + B_fnc ! Derivative w/ respect to f_diff of function A_fnc. [] + + ! Return Variable + real( kind = core_rknd ) :: lhs_contribution + + + ! Main diagonal: [ x f_unclipped(k,) ] + lhs_contribution & + = + (1.0_core_rknd/real( dt_clip, kind = core_rknd ) * B_fnc ) + + + end function compute_clip_lhs + + !============================================================================= + function clip_semi_imp_rhs( dt, f_unclipped, & + l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold ) & + result( rhs ) + + ! Description: + ! The explicit portion of the semi-implicit clipping code. + ! + ! The explicit (RHS) portion of the equation for clipping with the upper + ! threshold is: + ! + ! + (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) + B_fnc * upper_threshold }. + ! + ! The explicit (RHS) portion of the equation for clipping with the lower + ! threshold is: + ! + ! - (1/dt_clip) + ! * { A_fnc - B_fnc * f_diff(t) - B_fnc * lower_threshold }. + ! + ! Timestep index (t) stands for the index of the current timestep. + ! + ! The values of A_fnc, B_fnc, and f_diff will differ between the two + ! thresholds. + ! + ! The overall explicit (RHS) portion for the clipping term is the sum of the + ! explicit portion from the upper threshold and the explicit portion from + ! the lower threshold. + + ! References: + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep. [s] + + real( kind = core_rknd ), intent(in) :: & + f_unclipped, & ! The unclipped value of variable f at timestep (t). [f units] + upper_threshold, & ! Greatest allowable value of variable f. [f units] + lower_threshold ! Smallest allowable value of variable f. [f units] + + logical, intent(in) :: & + l_upper_thresh, & ! Flag for having an upper threshold value. + l_lower_thresh ! Flag for having a lower threshold value. + + ! Return Variable + real( kind = core_rknd ) :: rhs + + ! Local Variables + real(kind=time_precision) :: & + dt_clip ! Time scale for semi-implicit clipping term. [s] + + real( kind = core_rknd ) :: & + f_diff, & ! Difference between the threshold value and f_unclipped. [f units] + A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] + B_fnc, & ! Derivative w/ respect to f_diff of function A_fnc. [] + rhs_upper, & ! Contribution of upper threshold to explicit portion (RHS). [s^-1] + rhs_lower ! Contribution of lower threshold to explicit portion (RHS). [s^-1] + + + ! Compute the clipping time scale, dt_clip. + dt_clip = dt_clip_coef * dt + + + ! Upper Threshold + if ( l_upper_thresh ) then + + ! f_diff is the difference between the threshold value and f_unclipped. + ! In regards to the upper threshold, it is defined as + ! upper_threshold - f_unclipped. + f_diff = upper_threshold - f_unclipped + + ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) + ! for the upper threshold. + call compute_fncts_A_B( l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold, & + f_diff, A_fnc, B_fnc ) + + ! Compute the explicit (RHS) contribution from clipping for the upper + ! threshold. + rhs_upper & + = + (1.0_core_rknd/real( dt_clip, kind = core_rknd ) & + * ( A_fnc - B_fnc * f_diff + B_fnc * upper_threshold ) ) + + else + + rhs_upper = 0.0_core_rknd + + endif + + + ! Lower Threshold + if ( l_lower_thresh ) then + + ! f_diff is the difference between the threshold value and f_unclipped. + ! In regards to the lower threshold, it is defined as + ! f_unclipped - lower_threshold. + f_diff = f_unclipped - lower_threshold + + ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) + ! for the lower threshold. + call compute_fncts_A_B( l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold, & + f_diff, A_fnc, B_fnc ) + + ! Compute the explicit (RHS) contribution from clipping for the lower + ! threshold. + rhs_lower & + = - (1.0_core_rknd/ real( dt_clip, kind = core_rknd )) & + * ( A_fnc - B_fnc * f_diff - B_fnc * lower_threshold ) + + else + + rhs_lower = 0.0_core_rknd + + endif + + + ! Total explicit (RHS) contribution to clipping. + rhs = rhs_upper + rhs_lower + + + end function clip_semi_imp_rhs + + !============================================================================= + subroutine compute_fncts_A_B( l_upper_thresh, upper_threshold, & + l_lower_thresh, lower_threshold, & + f_diff, A_fnc, B_fnc ) + + ! Description: + ! This subroutine computes the values of two functions used in semi-implicit + ! clipping. Both of the functions are based on the values of f_diff(t) and + ! the parameter sigma. One function is A_fnc, which is F_R(f_diff) + ! evaluated at f_diff = f_diff(t). F_R(f_diff) is a three-piece function + ! that is used to approximate function R(f_diff). The other function is + ! B_fnc, the derivative with respect to f_diff of function A_fnc. In other + ! words, B_fnc is ( d F_R / d f_diff ) evaluated at f_diff = f_diff(t). + ! + ! The equation for A_fnc is: + ! + ! | f_diff(t); where f_diff(t) <= -sigma + ! | + ! A_fnc = | f_diff(t) - (sigma/4) * [ 1 + (f_diff(t)/sigma) ]^2; + ! | where -sigma < f_diff(t) < sigma + ! | + ! | 0; where f_diff(t) >= sigma; + ! + ! while the equation for B_fnc is: + ! + ! | 1; where f_diff(t) <= -sigma + ! | + ! B_fnc = | 1 - (1/2) * [ 1 + (f_diff(t)/sigma) ]; + ! | where -sigma < f_diff(t) < sigma + ! | + ! | 0; where f_diff(t) >= sigma; + ! + ! where timestep index (t) stands for the index of the current timestep. + + ! References: + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: eps ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in) :: & + f_diff, & ! Difference between the threshold value and f_unclipped. [f units] + upper_threshold, & ! Greatest allowable value of variable f. [f units] + lower_threshold ! Smallest allowable value of variable f. [f units] + + logical, intent(in) :: & + l_upper_thresh, & ! Flag for having an upper threshold value. + l_lower_thresh ! Flag for having a lower threshold value. + + ! Output Variables + real( kind = core_rknd ), intent(out) :: & + A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] + B_fnc ! Derivative w/ respect to f_diff of function A_fnc. [] + + ! Local Variables + real( kind = core_rknd ) :: sigma_val, & ! Value of parameter sigma. [f units] + thresh_avg_mag ! Average magnitude of threshold(s). [f units] + + thresh_avg_mag = 0.0_core_rknd ! Default Initialization + + ! Find the average magnitude of the threshold. + ! In cases where only one threshold applies, the average magnitude of the + ! threshold must be greater than 0. + ! Note: The constant eps is there in case only one threshold applies, and + ! it has a value of 0 (or very close to 0). However, eps is a very + ! small number, and therefore it will not start curbing values until + ! they get extremely close to the threshold. A larger constant value + ! may work better. + if ( l_upper_thresh .and. l_lower_thresh ) then + ! Both thresholds apply. + thresh_avg_mag = 0.5_core_rknd * ( abs(upper_threshold) & + + abs(lower_threshold) ) + elseif ( l_upper_thresh ) then + ! Only the upper threshold applies. + thresh_avg_mag = max( abs(upper_threshold), eps ) + elseif ( l_lower_thresh ) then + ! Only the lower threshold applies. + thresh_avg_mag = max( abs(lower_threshold), eps ) + endif + + ! Compute the value of sigma based on the magnitude of the threshold(s) for + ! variable f and the sigma coefficient. The value of sigma must always be + ! positive. + sigma_val = sigma_coef * thresh_avg_mag + + ! A_fnc is a three-piece function that approximates function + ! R(f_diff(t)) = { f_diff(t) * [ 1 - H(f_diff(t)) ] }. This is needed + ! because the R(f_diff(t)) is not differentiable at point f_diff(t) = 0, as + ! the function has a corner at that point. Function A_fnc is differentiable + ! at all points. It is evaluated for f_diff at timestep index (t). + if ( f_diff <= -sigma_val ) then + A_fnc = f_diff + elseif ( f_diff >= sigma_val ) then + A_fnc = 0.0_core_rknd + else ! -sigma_val < f_diff < sigma_val + A_fnc = f_diff - ( (sigma_val/4.0_core_rknd) & + * ( 1.0_core_rknd + f_diff/sigma_val )**2 ) + endif + + ! B_fnc is the derivative with respect to f_diff of function A_fnc. It is + ! evaluated for f_diff at timestep index (t). + if ( f_diff <= -sigma_val ) then + B_fnc = 1.0_core_rknd + elseif ( f_diff >= sigma_val ) then + B_fnc = 0.0_core_rknd + else ! -sigma_val < f_diff < sigma_val + B_fnc = 1.0_core_rknd - (1.0_core_rknd/2.0_core_rknd)*( 1.0_core_rknd + f_diff/sigma_val ) + endif + + + end subroutine compute_fncts_A_B + +!=============================================================================== + +end module crmx_clip_semi_implicit diff --git a/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 b/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 new file mode 100644 index 0000000000..3e768ff032 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 @@ -0,0 +1,3105 @@ +!----------------------------------------------------------------------- +! $Id: clubb_core.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +!----------------------------------------------------------------------- +module crmx_clubb_core + +! Description: +! The module containing the `core' of the CLUBB parameterization. +! A host model implementing CLUBB should only require this subroutine +! and the functions and subroutines it calls. +! +! References: +! ``A PDF-Based Model for Boundary Layer Clouds. Part I: +! Method and Model Description'' Golaz, et al. (2002) +! JAS, Vol. 59, pp. 3540--3551. +! +! Copyright Notice: +! +! This code and the source code it references are (C) 2006-2013 +! Jean-Christophe Golaz, Vincent E. Larson, Brian M. Griffin, +! David P. Schanen, Adam J. Smith, and Michael J. Falk. +! +! The distribution of this code and derived works thereof +! should include this notice. +! +! Portions of this code derived from other sources (Hugh Morrison, +! ACM TOMS, Numerical Recipes, et cetera) are the intellectual +! property of their respective authors as noted and are also subject +! to copyright. +!----------------------------------------------------------------------- + + implicit none + + public :: & + setup_clubb_core, & + advance_clubb_core, & + cleanup_clubb_core, & + set_Lscale_max + + private ! Default Scope + + contains + + !----------------------------------------------------------------------- + + !####################################################################### + !####################################################################### + ! If you change the argument list of advance_clubb_core you also have to + ! change the calls to this function in the host models CAM, WRF, SAM + ! and GFDL. + !####################################################################### + !####################################################################### + subroutine advance_clubb_core & + ( l_implemented, dt, fcor, sfc_elevation, & + thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & + sclrm_forcing, edsclrm_forcing, wprtp_forcing, & + wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + rtpthlp_forcing, wm_zm, wm_zt, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + wpsclrp_sfc, wpedsclrp_sfc, & + p_in_Pa, rho_zm, rho, exner, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & + rfrzm, radf, & + um, vm, upwp, vpwp, up2, vp2, & + thlm, rtm, wprtp, wpthlp, & + wp2, wp3, rtp2, thlp2, rtpthlp, & + sclrm, & +#ifdef GFDL + sclrm_trsport_only, & ! h1g, 2010-06-16 +#endif + sclrp2, sclrprtp, sclrpthlp, & + wpsclrp, edsclrm, err_code, & +#ifdef GFDL + RH_crit, do_liquid_only_in_clubb, & ! h1g, 2010-06-16 +#endif + rcm, wprcp, cloud_frac, ice_supersat_frac, & + rcm_in_layer, cloud_cover, & +#if defined(CLUBB_CAM) || defined(GFDL) || defined(CLUBB_SAM) + khzm, khzt, qclvar, & +#endif + pdf_params ) + + ! Description: + ! Subroutine to advance the model one timestep + + ! References: + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + !----------------------------------------------------------------------- + + ! Modules to be included + + use crmx_constants_clubb, only: & + w_tol, & ! Variable(s) + em_min, & + thl_tol, & + rt_tol, & + w_tol_sqd, & + ep2, & + Cp, & + Lv, & + ep1, & + eps, & + p0, & + kappa, & + fstderr, & + zero_threshold, & + three_halves + + use crmx_parameters_tunable, only: & + gamma_coefc, & ! Variable(s) + gamma_coefb, & + gamma_coef, & + taumax, & + c_K, & + mu, & + Lscale_mu_coef, & + Lscale_pert_coef + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + edsclr_dim, & + sclr_tol, & + ts_nudge, & + rtm_min, & + rtm_nudge_max_altitude + + use crmx_model_flags, only: & + l_tke_aniso, & ! Variable(s) + l_gamma_Skw, & + l_trapezoidal_rule_zt, & + l_trapezoidal_rule_zm, & + l_call_pdf_closure_twice, & + l_host_applies_sfc_fluxes, & + l_use_cloud_cover, & + l_rtm_nudge + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt, & ! Procedure(s) + zt2zm, & + ddzm + + use crmx_numerical_check, only: & + parameterization_check, & ! Procedure(s) + calculate_spurious_source + + use crmx_variables_diagnostic_module, only: & + Skw_zt, & ! Variable(s) + Skw_zm, & + sigma_sqd_w_zt, & + wp4, & + thlpthvp, & + rtpthvp, & + rtprcp, & + thlprcp, & + rcp2, & + rsat, & + pdf_params_zm, & + wprtp2, & + wp2rtp, & + wpthlp2, & + wp2thlp, & + wprtpthlp, & + wpthvp, & + wp2thvp, & + wp2rcp + + use crmx_variables_diagnostic_module, only: & + thvm, & + em, & + Lscale, & + Lscale_up, & + Lscale_down, & + tau_zm, & + tau_zt, & + Kh_zm, & + Kh_zt, & + vg, & + ug, & + um_ref, & + vm_ref + + use crmx_variables_diagnostic_module, only: & + wp2_zt, & + thlp2_zt, & + wpthlp_zt, & + wprtp_zt, & + rtp2_zt, & + rtpthlp_zt, & + up2_zt, & + vp2_zt, & + upwp_zt, & + vpwp_zt, & + rtm_ref, & + thlm_ref + + use crmx_variables_diagnostic_module, only: & + wpedsclrp, & + sclrpthvp, & ! sclr'th_v' + sclrprcp, & ! sclr'rc' + wp2sclrp, & ! w'^2 sclr' + wpsclrp2, & ! w'sclr'^2 + wpsclrprtp, & ! w'sclr'rt' + wpsclrpthlp, & ! w'sclr'thl' + wp3_zm, & ! wp3 interpolated to momentum levels + Skw_velocity, & ! Skewness velocity [m/s] + a3_coef, & ! The a3 coefficient [-] + a3_coef_zt ! The a3 coefficient interp. to the zt grid [-] + + use crmx_variables_diagnostic_module, only: & + wp3_on_wp2, & ! Variable(s) + wp3_on_wp2_zt + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Type + +#ifdef GFDL + use advance_sclrm_Nd_module, only: & ! h1g, 2010-06-16 begin mod + advance_sclrm_Nd_diffusion_OG, & + advance_sclrm_Nd_upwind, & + advance_sclrm_Nd_semi_implicit ! h1g, 2010-06-16 end mod +#endif + + use crmx_advance_xm_wpxp_module, only: & + ! Variable(s) + advance_xm_wpxp ! Compute mean/flux terms + + use crmx_advance_xp2_xpyp_module, only: & + ! Variable(s) + advance_xp2_xpyp ! Computes variance terms + + use crmx_surface_varnce_module, only: & + surface_varnce ! Procedure + + use crmx_pdf_closure_module, only: & + ! Procedure + pdf_closure ! Prob. density function + + use crmx_mixing_length, only: & + compute_length ! Procedure + + use crmx_advance_windm_edsclrm_module, only: & + advance_windm_edsclrm ! Procedure(s) + + use crmx_saturation, only: & + ! Procedure + sat_mixrat_liq ! Saturation mixing ratio + + use crmx_advance_wp2_wp3_module, only: & + advance_wp2_wp3 ! Procedure + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_error_code, only : & + clubb_no_error ! Constant(s) + + use crmx_error_code, only : & + clubb_at_least_debug_level, & ! Procedure(s) + reportError, & + fatal_error + + use crmx_Skw_module, only: & + Skw_func ! Procedure + + use crmx_clip_explicit, only: & + clip_covars_denom ! Procedure(s) + + use crmx_T_in_K_module, only: & + ! Read values from namelist + thlm2T_in_K ! Procedure + + use crmx_stats_subs, only: & + stats_accumulate ! Procedure + + use crmx_stats_type, only: & + stat_update_var_pt, & ! Procedure(s) + stat_update_var, & + stat_begin_update, & + stat_begin_update_pt, & + stat_end_update, & + stat_end_update_pt + + use crmx_stats_variables, only: & + irtp2_bt, & ! Variable(s) + ithlp2_bt, & + irtpthlp_bt, & + iwp2_bt, & + iwp3_bt, & + ivp2_bt, & + iup2_bt, & + iwprtp_bt, & + iwpthlp_bt, & + irtm_bt, & + ithlm_bt, & + ivm_bt, & + ium_bt, & + ircp2, & + iwp4, & + irsat, & + irvm, & + irel_humidity, & + iwpthlp_zt + + use crmx_stats_variables, only: & + iwprtp_zt, & + iup2_zt, & + ivp2_zt, & + iupwp_zt, & + ivpwp_zt, & + ithlp2_sf, & + irtp2_sf, & + irtpthlp_sf, & + iup2_sf, & + ivp2_sf, & + iwp2_sf, & + l_stats_samp, & + l_stats, & + zt, & + zm, & + sfc, & + irtm_spur_src, & + ithlm_spur_src + + use crmx_stats_variables, only: & + irfrzm ! Variable(s) + + use crmx_stats_variables, only: & + iSkw_velocity, & ! Variable(s) + igamma_Skw_fnc, & + iLscale_pert_1, & + iLscale_pert_2 + + use crmx_fill_holes, only: & + vertical_integral ! Procedure(s) + + use crmx_sigma_sqd_w_module, only: & + compute_sigma_sqd_w ! Procedure(s) + + implicit none + + !!! External + intrinsic :: sqrt, min, max, exp, mod, real + + ! Constant Parameters + logical, parameter :: & + l_avg_Lscale = .true., & ! Lscale is calculated in subroutine compute_length; if l_avg_Lscale + ! is true, compute_length is called two additional times with + ! perturbed values of rtm and thlm. An average value of Lscale + ! from the three calls to compute_length is then calculated. + ! This reduces temporal noise in RICO, BOMEX, LBA, and other cases. + l_Lscale_plume_centered = .false. ! Alternate that uses the PDF to + ! compute the perturbed values + + logical, parameter :: & + l_use_ice_latent = .false. !Includes the effects of ice latent heating in turbulence terms +! l_use_ice_latent = .true. !Includes the effects of ice latent heating in turbulence terms +++mhwang test + + logical, parameter :: & + l_iter_xp2_xpyp = .true. ! Set to true when rtp2/thlp2/rtpthlp, et cetera are prognostic + + !!! Input Variables + logical, intent(in) :: & + l_implemented ! Is this part of a larger host model (T/F) ? + + real(kind=time_precision), intent(in) :: & + dt ! Current timestep duration [s] + + real( kind = core_rknd ), intent(in) :: & + fcor, & ! Coriolis forcing [s^-1] + sfc_elevation ! Elevation of ground level [m AMSL] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] + vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + wprtp_forcing, & ! forcing (momentum levels) [m*K/s^2] + wpthlp_forcing, & ! forcing (momentum levels) [m*(kg/kg)/s^2] + rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] + thlp2_forcing, & ! forcing (momentum levels) [K^2/s] + rtpthlp_forcing, & ! forcing (momentum levels) [K*(kg/kg)/s] + wm_zm, & ! w mean wind component on momentum levels [m/s] + wm_zt, & ! w mean wind component on thermo. levels [m/s] + p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho, & ! Air density on thermodynamic levels [kg/m^3] + exner, & ! Exner function (thermodynamic levels) [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K] + rfrzm ! Total ice-phase water mixing ratio [kg/kg] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + radf ! Buoyancy production at the CL top due to LW radiative cooling [m^2/s^3] + + real( kind = core_rknd ), intent(in) :: & + wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] + wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] + upwp_sfc, & ! u'w' at surface [m^2/s^2] + vpwp_sfc ! v'w' at surface [m^2/s^2] + + ! Passive scalar variables + real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & + sclrm_forcing ! Passive scalar forcing [{units vary}/s] + + real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & + wpsclrp_sfc ! Scalar flux at surface [{units vary} m/s] + + ! Eddy passive scalar variables + real( kind = core_rknd ), intent(in), dimension(gr%nz,edsclr_dim) :: & + edsclrm_forcing ! Eddy passive scalar forcing [{units vary}/s] + + real( kind = core_rknd ), intent(in), dimension(edsclr_dim) :: & + wpedsclrp_sfc ! Eddy-Scalar flux at surface [{units vary} m/s] + + !!! Input/Output Variables + ! These are prognostic or are planned to be in the future + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + um, & ! u mean wind component (thermodynamic levels) [m/s] + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vm, & ! v mean wind component (thermodynamic levels) [m/s] + vpwp, & ! v'w' (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg] + wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s] + thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K] + wpthlp, & ! w' th_l' (momentum levels) [(m/s) K] + rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] + thlp2, & ! th_l'^2 (momentum levels) [K^2] + rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] + + ! Passive scalar variables + real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & + sclrm, & ! Passive scalar mean (thermo. levels) [units vary] + wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] + sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] + sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + sclrpthlp ! sclr'thl' (momentum levels) [{units vary} K] + +#ifdef GFDL + real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & ! h1g, 2010-06-16 + sclrm_trsport_only ! Passive scalar concentration due to pure transport [{units vary}/s] +#endif + + ! Eddy passive scalar variable + real( kind = core_rknd ), intent(inout), dimension(gr%nz,edsclr_dim) :: & + edsclrm ! Eddy passive scalar mean (thermo. levels) [units vary] + + ! Variables that need to be output for use in other parts of the CLUBB + ! code, such as microphysics (rcm, pdf_params), forcings (rcm), and/or + ! BUGSrad (cloud_cover). + real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & + rcm, & ! cloud water mixing ratio, r_c (thermo. levels) [kg/kg] + rcm_in_layer, & ! rcm in cloud layer [kg/kg] + cloud_cover ! cloud cover [-] + + type(pdf_parameter), dimension(gr%nz), intent(out) :: & + pdf_params ! PDF parameters [units vary] + + ! Variables that need to be output for use in host models + real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & + wprcp, & ! w'r_c' (momentum levels) [(kg/kg) m/s] + cloud_frac, & ! cloud fraction (thermodynamic levels) [-] + ice_supersat_frac ! ice cloud fraction (thermodynamic levels) [-] + + ! Eric Raut declared this variable solely for output to disk + real( kind = core_rknd ), dimension(gr%nz) :: & + rc_coef ! Coefficient of X' R_l' in Eq. (34) [-] + +#if defined(CLUBB_CAM) || defined(GFDL) || defined(CLUBB_SAM) + real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & + khzt, & ! eddy diffusivity on thermo levels + khzm, & ! eddy diffusivity on momentum levels + qclvar ! cloud water variance +#endif + + !!! Output Variable + ! Diagnostic, for if some calculation goes amiss. + integer, intent(inout) :: err_code + +#ifdef GFDL + ! hlg, 2010-06-16 + real( kind = core_rknd ), intent(inOUT), dimension(gr%nz, min(1,sclr_dim) , 2) :: & + RH_crit ! critical relative humidity for droplet and ice nucleation +! ---> h1g, 2012-06-14 + logical, intent(in) :: do_liquid_only_in_clubb +! <--- h1g, 2012-06-14 +#endif + + !!! Local Variables + integer :: i, k, & + err_code_pdf_closure, err_code_surface + + real( kind = core_rknd ), dimension(gr%nz) :: & + sigma_sqd_w, & ! PDF width parameter (momentum levels) [-] + sqrt_em_zt, & ! sqrt( em ) on zt levels; where em is TKE [m/s] + gamma_Skw_fnc, & ! Gamma as a function of skewness [???] + Lscale_pert_1, Lscale_pert_2, & ! For avg. calculation of Lscale [m] + thlm_pert_1, thlm_pert_2, & ! For avg. calculation of Lscale [K] + rtm_pert_1, rtm_pert_2, & ! For avg. calculation of Lscale [kg/kg] + thlm_pert_pos_rt, thlm_pert_neg_rt, & ! For avg. calculation of Lscale [K] + rtm_pert_pos_rt, rtm_pert_neg_rt ! For avg. calculation of Lscale [kg/kg] + !Lscale_weight Uncomment this if you need to use this vairable at some point. + + ! For pdf_closure + real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & + wpsclrp_zt, & ! w' sclr' on thermo. levels + sclrp2_zt, & ! sclr'^2 on thermo. levels + sclrprtp_zt, & ! sclr' r_t' on thermo. levels + sclrpthlp_zt ! sclr' th_l' on thermo. levels + + real( kind = core_rknd ), dimension(gr%nz) :: & + p_in_Pa_zm, & ! Pressure interpolated to momentum levels [Pa] + exner_zm, & ! Exner interpolated to momentum levels [-] + w1_zm, & ! Mean w (1st PDF component) [m/s] + w2_zm, & ! Mean w (2nd PDF component) [m/s] + varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] + mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] + + integer :: & + wprtp_cl_num, & ! Instance of w'r_t' clipping (1st or 3rd). + wpthlp_cl_num, & ! Instance of w'th_l' clipping (1st or 3rd). + wpsclrp_cl_num, & ! Instance of w'sclr' clipping (1st or 3rd). + upwp_cl_num, & ! Instance of u'w' clipping (1st or 2nd). + vpwp_cl_num ! Instance of v'w' clipping (1st or 2nd). + + ! These local variables are declared because they originally belong on the momentum + ! grid levels, but pdf_closure outputs them on the thermodynamic grid levels. + real( kind = core_rknd ), dimension(gr%nz) :: & + wp4_zt, & ! w'^4 (on thermo. grid) [m^4/s^4] + wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s] + rtpthvp_zt, & ! r_t' th_v' (on thermo. grid) [(kg K)/kg] + thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2] + wprcp_zt, & ! w' r_c' (on thermo. grid) [(m kg)/(s kg)] + rtprcp_zt, & ! r_t' r_c' (on thermo. grid) [(kg^2)/(kg^2)] + thlprcp_zt, & ! th_l' r_c' (on thermo. grid) [(K kg)/kg] + rcp2_zt, & ! r_c'^2 (on thermo. grid) [(kg^2)/(kg^2)] + rc_coef_zt ! X'R_l' coef. (on thermo. grid) [-] + + real( kind = core_rknd ), dimension(gr%nz, sclr_dim) :: & + sclrpthvp_zt, & ! sclr'th_v' (on thermo. grid) + sclrprcp_zt ! sclr'rc' (on thermo. grid) + + real( kind = core_rknd ), dimension(gr%nz) :: & + wprtp2_zm, & ! w'rt'^2 on momentum grid [m kg^2/kg^2] + wp2rtp_zm, & ! w'^2 rt' on momentum grid [m^2 kg/kg] + wpthlp2_zm, & ! w'thl'^2 on momentum grid [m K^2/s] + wp2thlp_zm, & ! w'^2 thl' on momentum grid [m^2 K/s^2] + wprtpthlp_zm, & ! w'rt'thl' on momentum grid [m kg K/kg s] + cloud_frac_zm, & ! Cloud Fraction on momentum grid [-] + ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-] + rtm_zm, & ! Total water mixing ratio [kg/kg] + thlm_zm, & ! Liquid potential temperature [kg/kg] + rcm_zm, & ! Liquid water mixing ratio on momentum grid [kg/kg] + wp2thvp_zm, & ! w'^2 th_v' on momentum grid [m^2 K/s^2] + wp2rcp_zm, & ! w'^2 rc' on momentum grid [m^2 kg/kg s^2] + sign_rtpthlp ! sign of the covariance rtpthlp [-] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & + wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid + wpsclrp2_zm, & ! w'sclr'^2 on momentum grid + wpsclrpthlp_zm, & ! w'sclr'thl' on momentum grid + wp2sclrp_zm, & ! w'^2 sclr' on momentum grid + sclrm_zm ! Passive scalar mean on momentum grid + + real( kind = core_rknd ) :: & + rtm_integral_before, & + rtm_integral_after, & + rtm_integral_forcing, & + rtm_flux_top, & + rtm_flux_sfc, & + rtm_spur_src, & + thlm_integral_before, & + thlm_integral_after, & + thlm_integral_forcing, & + thlm_flux_top, & + thlm_flux_sfc, & + thlm_spur_src, & + mu_pert_1, mu_pert_2, & ! For l_avg_Lscale + mu_pert_pos_rt, mu_pert_neg_rt ! For l_Lscale_plume_centered + + !The following variables are defined for use when l_use_ice_latent = .true. + type(pdf_parameter), dimension(gr%nz) :: & + pdf_params_frz, & + pdf_params_zm_frz + + + real( kind = core_rknd ), dimension(gr%nz) :: & + rtm_frz, & + thlm_frz, & + wp4_zt_frz, & + wprtp2_frz, & + wp2rtp_frz, & + wpthlp2_frz, & + wp2thlp_frz, & + wprtpthlp_frz, & + cloud_frac_frz, & + ice_supersat_frac_frz, & + rcm_frz, & + wpthvp_frz, & + wpthvp_zt_frz, & + wp2thvp_frz, & + wp2thvp_zm_frz, & + rtpthvp_frz, & + rtpthvp_zt_frz, & + thlpthvp_frz, & + thlpthvp_zt_frz, & + wprcp_zt_frz, & + wp2rcp_frz + + real( kind = core_rknd ), dimension(gr%nz) :: & + rtprcp_zt_frz, & + thlprcp_zt_frz, & + rcp2_zt_frz, & + rc_coef_zt_frz, & + wp4_frz, & + wprtp2_zm_frz, & + wp2rtp_zm_frz, & + wpthlp2_zm_frz, & + wp2thlp_zm_frz, & + wprtpthlp_zm_frz, & + cloud_frac_zm_frz, & + ice_supersat_frac_zm_frz, & + rcm_zm_frz, & + wprcp_frz, & + wp2rcp_zm_frz, & + rtprcp_frz, & + thlprcp_frz, & + rcp2_frz, & + rtm_zm_frz, & + thlm_zm_frz, & + rc_coef_frz + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & + wpsclrprtp_frz, & + wpsclrp2_frz, & + sclrpthvp_zt_frz, & + wpsclrpthlp_frz, & + sclrprcp_zt_frz, & + wp2sclrp_frz, & + wpsclrprtp_zm_frz, & + wpsclrp2_zm_frz, & + sclrpthvp_frz, & + wpsclrpthlp_zm_frz, & + sclrprcp_frz, & + wp2sclrp_zm_frz + + + !----- Begin Code ----- + + if ( l_stats .and. l_stats_samp ) then + ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero. + ! Therefore, wm must be zero or l_implemented must be true. + if ( l_implemented .or. ( all( wm_zt == 0._core_rknd ) .and. & + all( wm_zm == 0._core_rknd ) ) ) then + ! Get the vertical integral of rtm and thlm before this function begins + ! so that spurious source can be calculated + rtm_integral_before & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + thlm_integral_before & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + end if + end if + + !---------------------------------------------------------------- + ! Test input variables + !---------------------------------------------------------------- + if ( clubb_at_least_debug_level( 2 ) ) then + call parameterization_check & + ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in) + wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & ! intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & ! intent(in) + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! intent(in) + um, upwp, vm, vpwp, up2, vp2, & ! intent(in) + rtm, wprtp, thlm, wpthlp, & ! intent(in) + wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) + "beginning of ", & ! intent(in) + wpsclrp_sfc, wpedsclrp_sfc, & ! intent(in) + sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & ! intent(in) + sclrm_forcing, edsclrm, edsclrm_forcing, & ! intent(in) + err_code ) ! Intent(inout) + end if + !----------------------------------------------------------------------- + + if ( l_stats_samp ) then + call stat_update_var( irfrzm, rfrzm, & ! In + zt ) ! Out + end if + + ! Set up budget stats variables. + if ( l_stats_samp ) then + + call stat_begin_update( iwp2_bt, wp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( ivp2_bt, vp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( iup2_bt, up2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( iwprtp_bt, wprtp / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( iwpthlp_bt, wpthlp / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( irtp2_bt, rtp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( ithlp2_bt, thlp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_begin_update( irtpthlp_bt, rtpthlp / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + + call stat_begin_update( irtm_bt, rtm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_begin_update( ithlm_bt, thlm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_begin_update( ium_bt, um / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_begin_update( ivm_bt, vm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_begin_update( iwp3_bt, wp3 / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + + end if + + ! SET SURFACE VALUES OF FLUXES (BROUGHT IN) + ! We only do this for host models that do not apply the flux + ! elsewhere in the code (e.g. WRF). In other cases the _sfc variables will + ! only be used to compute the variance at the surface. -dschanen 8 Sept 2009 + if ( .not. l_host_applies_sfc_fluxes ) then + + wpthlp(1) = wpthlp_sfc + wprtp(1) = wprtp_sfc + upwp(1) = upwp_sfc + vpwp(1) = vpwp_sfc + + ! Set fluxes for passive scalars (if enabled) + if ( sclr_dim > 0 ) then + wpsclrp(1,1:sclr_dim) = wpsclrp_sfc(1:sclr_dim) + end if + + if ( edsclr_dim > 0 ) then + wpedsclrp(1,1:edsclr_dim) = wpedsclrp_sfc(1:edsclr_dim) + end if + + else + + wpthlp(1) = 0.0_core_rknd + wprtp(1) = 0.0_core_rknd + upwp(1) = 0.0_core_rknd + vpwp(1) = 0.0_core_rknd + + ! Set fluxes for passive scalars (if enabled) + if ( sclr_dim > 0 ) then + wpsclrp(1,1:sclr_dim) = 0.0_core_rknd + end if + + if ( edsclr_dim > 0 ) then + wpedsclrp(1,1:edsclr_dim) = 0.0_core_rknd + end if + + end if ! ~l_host_applies_sfc_fluxes + + !--------------------------------------------------------------------------- + ! Interpolate wp3 to momentum levels, and wp2 to thermodynamic levels + ! and then compute Skw for m & t grid + !--------------------------------------------------------------------------- + + wp2_zt = max( zm2zt( wp2 ), w_tol_sqd ) ! Positive definite quantity + wp3_zm = zt2zm( wp3 ) + + Skw_zt(1:gr%nz) = Skw_func( wp2_zt(1:gr%nz), wp3(1:gr%nz) ) + Skw_zm(1:gr%nz) = Skw_func( wp2(1:gr%nz), wp3_zm(1:gr%nz) ) + + ! The right hand side of this conjunction is only for reducing cpu time, + ! since the more complicated formula is mathematically equivalent + if ( l_gamma_Skw .and. ( gamma_coef /= gamma_coefb ) ) then + !---------------------------------------------------------------- + ! Compute gamma as a function of Skw - 14 April 06 dschanen + !---------------------------------------------------------------- + + gamma_Skw_fnc = gamma_coefb + (gamma_coef-gamma_coefb) & + *exp( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm/gamma_coefc)**2 ) + + else + + gamma_Skw_fnc = gamma_coef + + end if + + ! Compute sigma_sqd_w (dimensionless PDF width parameter) + sigma_sqd_w = compute_sigma_sqd_w( gamma_Skw_fnc, wp2, thlp2, rtp2, wpthlp, wprtp ) + + if ( l_stats_samp ) then + call stat_update_var( igamma_Skw_fnc, gamma_Skw_fnc, zm ) + endif + + ! Smooth in the vertical + sigma_sqd_w = zt2zm( zm2zt( sigma_sqd_w ) ) + + ! Interpolate the the zt grid + sigma_sqd_w_zt = max( zm2zt( sigma_sqd_w ), zero_threshold ) ! Pos. def. quantity + + ! Compute the a3 coefficient (formula 25 in `Equations for CLUBB') +! a3_coef = 3.0_core_rknd * sigma_sqd_w*sigma_sqd_w & +! + 6.0_core_rknd*(1.0_core_rknd-sigma_sqd_w)*sigma_sqd_w & +! + (1.0_core_rknd-sigma_sqd_w)*(1.0_core_rknd-sigma_sqd_w) & +! - 3.0_core_rknd + + ! This is a simplified version of the formula above. + a3_coef = -2._core_rknd * ( 1._core_rknd - sigma_sqd_w )**2 + + ! We found we obtain fewer spikes in wp3 when we clip a3 to be no greater + ! than -1.4 -dschanen 4 Jan 2011 + a3_coef = max( a3_coef, -1.4_core_rknd ) ! Known magic number + + a3_coef_zt = zm2zt( a3_coef ) + + !--------------------------------------------------------------------------- + ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels, + !--------------------------------------------------------------------------- + + ! Iterpolate variances to the zt grid (statistics and closure) + thlp2_zt = max( zm2zt( thlp2 ), thl_tol**2 ) ! Positive def. quantity + rtp2_zt = max( zm2zt( rtp2 ), rt_tol**2 ) ! Positive def. quantity + rtpthlp_zt = zm2zt( rtpthlp ) + + ! Compute skewness velocity for stats output purposes + if ( iSkw_velocity > 0 ) then + Skw_velocity = ( 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w(1:gr%nz) ) ) & + * ( wp3_zm(1:gr%nz) / max( wp2(1:gr%nz), w_tol_sqd ) ) + end if + + ! Compute wp3 / wp2 on zt levels. Always use the interpolated value in the + ! denominator since it's less likely to create spikes + wp3_on_wp2_zt = ( wp3(1:gr%nz) / max( wp2_zt(1:gr%nz), w_tol_sqd ) ) + + ! Clip wp3_on_wp2_zt if it's too large + do k=1, gr%nz + if( wp3_on_wp2_zt(k) < 0._core_rknd ) then + wp3_on_wp2_zt = max( -1000._core_rknd, wp3_on_wp2_zt ) + else + wp3_on_wp2_zt = min( 1000._core_rknd, wp3_on_wp2_zt ) + end if + end do + + ! Compute wp3_on_wp2 by interpolating wp3_on_wp2_zt + wp3_on_wp2 = zt2zm( wp3_on_wp2_zt ) + + ! Smooth again as above + wp3_on_wp2_zt = zm2zt( wp3_on_wp2 ) + + !---------------------------------------------------------------- + ! Call closure scheme + !---------------------------------------------------------------- + + ! Put passive scalar input on the t grid for the PDF + do i = 1, sclr_dim, 1 + wpsclrp_zt(:,i) = zm2zt( wpsclrp(:,i) ) + sclrp2_zt(:,i) = max( zm2zt( sclrp2(:,i) ), zero_threshold ) ! Pos. def. quantity + sclrprtp_zt(:,i) = zm2zt( sclrprtp(:,i) ) + sclrpthlp_zt(:,i) = zm2zt( sclrpthlp(:,i) ) + end do ! i = 1, sclr_dim, 1 + + + do k = 1, gr%nz, 1 + + call pdf_closure & + ( p_in_Pa(k), exner(k), thv_ds_zt(k), wm_zt(k), & ! intent(in) + wp2_zt(k), wp3(k), sigma_sqd_w_zt(k), & ! intent(in) + Skw_zt(k), rtm(k), rtp2_zt(k), & ! intent(in) + zm2zt( wprtp, k ), thlm(k), thlp2_zt(k), & ! intent(in) + zm2zt( wpthlp, k ), rtpthlp_zt(k), sclrm(k,:), & ! intent(in) + wpsclrp_zt(k,:), sclrp2_zt(k,:), sclrprtp_zt(k,:), & ! intent(in) + sclrpthlp_zt(k,:), k, & ! intent(in) +#ifdef GFDL + RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 +#endif + wp4_zt(k), wprtp2(k), wp2rtp(k), & ! intent(out) + wpthlp2(k), wp2thlp(k), wprtpthlp(k), & ! intent(out) + cloud_frac(k), ice_supersat_frac(k), & ! intent(out) + rcm(k), wpthvp_zt(k), wp2thvp(k), rtpthvp_zt(k), & ! intent(out) + thlpthvp_zt(k), wprcp_zt(k), wp2rcp(k), rtprcp_zt(k),& ! intent(out) + thlprcp_zt(k), rcp2_zt(k), pdf_params(k), & ! intent(out) + err_code_pdf_closure, & ! intent(out) + wpsclrprtp(k,:), wpsclrp2(k,:), sclrpthvp_zt(k,:), & ! intent(out) + wpsclrpthlp(k,:), sclrprcp_zt(k,:), wp2sclrp(k,:), & ! intent(out) + rc_coef_zt(k) ) ! intent(out) + + ! Subroutine may produce NaN values, and if so, exit + ! gracefully. + ! Joshua Fasching March 2008 + + if ( fatal_error( err_code_pdf_closure ) ) then + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "At grid level = ",k + end if + + err_code = err_code_pdf_closure + end if + + end do ! k = 1, gr%nz, 1 + + if( l_rtm_nudge ) then + ! Nudge rtm to prevent excessive drying + where( rtm < rtm_min .and. gr%zt < rtm_nudge_max_altitude ) + rtm = rtm + (rtm_ref - rtm) * ( real( dt, kind = core_rknd ) / ts_nudge ) + end where + end if + + + if ( l_call_pdf_closure_twice ) then + ! Call pdf_closure a second time on momentum levels, to + ! output (rather than interpolate) the variables which + ! belong on the momentum levels. + + ! Interpolate sclrm to the momentum level for use in + ! the second call to pdf_closure + do i = 1, sclr_dim + sclrm_zm(:,i) = zt2zm( sclrm(:,i) ) + ! Clip if extrap. causes sclrm_zm to be less than sclr_tol + sclrm_zm(gr%nz,i) = max( sclrm_zm(gr%nz,i), sclr_tol(i) ) + end do ! i = 1, sclr_dim + + ! Interpolate pressure, p_in_Pa, to momentum levels. + ! The pressure at thermodynamic level k = 1 has been set to be the surface + ! (or model lower boundary) pressure. Since the surface (or model lower + ! boundary) is located at momentum level k = 1, the pressure there is + ! p_sfc, which is p_in_Pa(1). Thus, p_in_Pa_zm(1) = p_in_Pa(1). + p_in_Pa_zm(:) = zt2zm( p_in_Pa ) + p_in_Pa_zm(1) = p_in_Pa(1) + + ! Clip pressure if the extrapolation leads to a negative value of pressure + p_in_Pa_zm(gr%nz) = max( p_in_Pa_zm(gr%nz), 0.5_core_rknd*p_in_Pa(gr%nz) ) + ! Set exner at momentum levels, exner_zm, based on p_in_Pa_zm. + exner_zm(:) = (p_in_Pa_zm(:)/p0)**kappa + + rtm_zm = zt2zm( rtm ) + ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol + rtm_zm(gr%nz) = max( rtm_zm(gr%nz), rt_tol ) + thlm_zm = zt2zm( thlm ) + ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol + thlm_zm(gr%nz) = max( thlm_zm(gr%nz), thl_tol ) + + ! Call pdf_closure to output the variables which belong on the momentum grid. + do k = 1, gr%nz, 1 + + call pdf_closure & + ( p_in_Pa_zm(k), exner_zm(k), thv_ds_zm(k), wm_zm(k), & ! intent(in) + wp2(k), wp3_zm(k), sigma_sqd_w(k), & ! intent(in) + Skw_zm(k), rtm_zm(k), rtp2(k), & ! intent(in) + wprtp(k), thlm_zm(k), thlp2(k), & ! intent(in) + wpthlp(k), rtpthlp(k), sclrm_zm(k,:), & ! intent(in) + wpsclrp(k,:), sclrp2(k,:), sclrprtp(k,:), & ! intent(in) + sclrpthlp(k,:), k, & ! intent(in) +#ifdef GFDL + RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 +#endif + wp4(k), wprtp2_zm(k), wp2rtp_zm(k), & ! intent(out) + wpthlp2_zm(k), wp2thlp_zm(k), wprtpthlp_zm(k), & ! intent(out) + cloud_frac_zm(k), ice_supersat_frac_zm(k), & ! intent(out) + rcm_zm(k), wpthvp(k), wp2thvp_zm(k), rtpthvp(k), & ! intent(out) + thlpthvp(k), wprcp(k), wp2rcp_zm(k), rtprcp(k), & ! intent(out) + thlprcp(k), rcp2(k), pdf_params_zm(k), & ! intent(out) + err_code_pdf_closure, & ! intent(out) + wpsclrprtp_zm(k,:), wpsclrp2_zm(k,:), sclrpthvp(k,:), & ! intent(out) + wpsclrpthlp_zm(k,:), sclrprcp(k,:), wp2sclrp_zm(k,:), & ! intent(out) + rc_coef(k) ) ! intent(out) + + ! Subroutine may produce NaN values, and if so, exit + ! gracefully. + ! Joshua Fasching March 2008 + + + if ( fatal_error( err_code_pdf_closure ) ) then + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "At grid level = ",k + end if + + err_code = err_code_pdf_closure + end if + + end do ! k = 1, gr%nz, 1 + + else ! l_call_pdf_closure_twice is false + + ! Interpolate momentum variables output from the first call to + ! pdf_closure back to momentum grid. + ! Since top momentum level is higher than top thermo level, + ! Set variables at top momentum level to 0. + + ! Only do this for wp4 and rcp2 if we're saving stats, since they are not + ! used elsewhere in the parameterization + if ( iwp4 > 0 ) then + wp4 = max( zt2zm( wp4_zt ), zero_threshold ) ! Pos. def. quantity + wp4(gr%nz) = 0.0_core_rknd + end if + +#ifndef CLUBB_SAM + if ( ircp2 > 0 ) then +#endif + rcp2 = max( zt2zm( rcp2_zt ), zero_threshold ) ! Pos. def. quantity +#ifndef CLUBB_SAM + rcp2(gr%nz) = 0.0_core_rknd + end if +#endif + + wpthvp = zt2zm( wpthvp_zt ) + wpthvp(gr%nz) = 0.0_core_rknd + thlpthvp = zt2zm( thlpthvp_zt ) + thlpthvp(gr%nz) = 0.0_core_rknd + rtpthvp = zt2zm( rtpthvp_zt ) + rtpthvp(gr%nz) = 0.0_core_rknd + wprcp = zt2zm( wprcp_zt ) + wprcp(gr%nz) = 0.0_core_rknd + rc_coef = zt2zm( rc_coef_zt ) + rc_coef(gr%nz) = 0.0_core_rknd + rtprcp = zt2zm( rtprcp_zt ) + rtprcp(gr%nz) = 0.0_core_rknd + thlprcp = zt2zm( thlprcp_zt ) + thlprcp(gr%nz) = 0.0_core_rknd + + ! Interpolate passive scalars back onto the m grid + do i = 1, sclr_dim + sclrpthvp(:,i) = zt2zm( sclrpthvp_zt(:,i) ) + sclrpthvp(gr%nz,i) = 0.0_core_rknd + sclrprcp(:,i) = zt2zm( sclrprcp_zt(:,i) ) + sclrprcp(gr%nz,i) = 0.0_core_rknd + end do ! i=1, sclr_dim + + end if ! l_call_pdf_closure_twice + + ! If l_trapezoidal_rule_zt is true, call trapezoidal_rule_zt for + ! thermodynamic-level variables output from pdf_closure. + ! ldgrant June 2009 + if ( l_trapezoidal_rule_zt ) then + call trapezoidal_rule_zt & + ( l_call_pdf_closure_twice, & ! intent(in) + wprtp2, wpthlp2, & ! intent(inout) + wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout) + rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout) + wpsclrpthlp, pdf_params, & ! intent(inout) + wprtp2_zm, wpthlp2_zm, & ! intent(inout) + wprtpthlp_zm, cloud_frac_zm, & ! intent(inout) + ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout) + wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm, & ! intent(inout) + pdf_params_zm ) ! intent(inout) + end if ! l_trapezoidal_rule_zt + + ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for + ! the important momentum-level variabes output from pdf_closure. + ! ldgrant Feb. 2010 + if ( l_trapezoidal_rule_zm ) then + call trapezoidal_rule_zm & + ( wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in) + wpthvp, thlpthvp, rtpthvp ) ! intent(inout) + end if ! l_trapezoidal_rule_zm + + ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. + ! This code won't work unless rtm >= 0 !!! + ! We do not clip rcm_in_layer because rcm_in_layer only influences + ! radiation, and we do not want to bother recomputing it. + ! Code is duplicated from below to ensure that relative humidity + ! is calculated properly. 3 Sep 2009 + call clip_rcm( rtm, 'rtm < rcm after pdf_closure', & ! intent (in) + rcm ) ! intent (inout) + + ! Compute variables cloud_cover and rcm_in_layer. + ! Added July 2009 + call compute_cloud_cover & + ( pdf_params, cloud_frac, rcm, & ! intent(in) + cloud_cover, rcm_in_layer ) ! intent(out) + + ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help + ! increase cloudiness at coarser grid resolutions. + if ( l_use_cloud_cover ) then + cloud_frac = cloud_cover + !ice_supersat_frac = cloud_cover !?-mark + rcm = rcm_in_layer + end if + + ! Clip cloud fraction here if it still exceeds 1.0 due to round off + cloud_frac = min( 1.0_core_rknd, cloud_frac ) + ! Ditto with ice cloud fraction + ice_supersat_frac = min( 1.0_core_rknd, ice_supersat_frac ) + + if (l_use_ice_latent) then + !A third call to pdf_closure, with terms modified to include the effects + !of latent heating due to ice. Thlm and rtm add the effects of ice, and + !the terms are all renamed with "_frz" appended. The modified terms will + !be fed into the calculations of the turbulence terms. storer-3/14/13 + + thlm_frz = thlm - (Lv / (Cp*exner) ) * rfrzm ! Add effects of ice latent heat + ! Ice is treated as liquid water here + rtm_frz = rtm + rfrzm + + + do k = 1, gr%nz, 1 + + call pdf_closure & + ( p_in_Pa(k), exner(k), thv_ds_zt(k), wm_zt(k), & ! intent(in) + wp2_zt(k), wp3(k), sigma_sqd_w_zt(k), & ! intent(in) + Skw_zt(k), rtm_frz(k), rtp2_zt(k), & ! intent(in) + zm2zt( wprtp, k ), thlm_frz(k), thlp2_zt(k), & ! intent(in) + zm2zt( wpthlp, k ), rtpthlp_zt(k), sclrm(k,:), & ! intent(in) + wpsclrp_zt(k,:), sclrp2_zt(k,:), sclrprtp_zt(k,:), & ! intent(in) + sclrpthlp_zt(k,:), k, & ! intent(in) +#ifdef GFDL + RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 +#endif + wp4_zt_frz(k), wprtp2_frz(k), wp2rtp_frz(k), & ! intent(out) + wpthlp2_frz(k), wp2thlp_frz(k), wprtpthlp_frz(k), & ! intent(out) + cloud_frac_frz(k), ice_supersat_frac_frz(k), & ! intent(out) + rcm_frz(k), wpthvp_zt_frz(k), wp2thvp_frz(k), rtpthvp_zt_frz(k), & ! intent(out) + thlpthvp_zt_frz(k), wprcp_zt_frz(k), wp2rcp_frz(k), rtprcp_zt_frz(k), & ! intent(out) + thlprcp_zt_frz(k), rcp2_zt_frz(k), pdf_params_frz(k), & ! intent(out) + err_code_pdf_closure, & ! intent(out) + wpsclrprtp_frz(k,:), wpsclrp2_frz(k,:), sclrpthvp_zt_frz(k,:), & ! intent(out) + wpsclrpthlp_frz(k,:), sclrprcp_zt_frz(k,:), wp2sclrp_frz(k,:), & ! intent(out) + rc_coef_zt_frz(k) ) ! intent(out) + + ! Subroutine may produce NaN values, and if so, exit gracefully. + ! Joshua Fasching March 2008 + + if ( fatal_error( err_code_pdf_closure ) ) then + + if ( clubb_at_least_debug_level ( 1 ) )then + write(fstderr,*) "At grid level = ", k + end if + + err_code = err_code_pdf_closure + end if + + end do !k=1, gr%nz, 1 + + + if( l_rtm_nudge ) then + ! Nudge rtm to prevent excessive drying + where( rtm < rtm_min .and. gr%zt < rtm_nudge_max_altitude ) + rtm = rtm + (rtm_ref - rtm) * ( real( dt, kind = core_rknd ) / ts_nudge ) + end where + end if + + rtm_zm_frz = zt2zm( rtm_frz ) + ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol + rtm_zm_frz(gr%nz) = max( rtm_zm_frz(gr%nz), rt_tol ) + thlm_zm_frz = zt2zm( thlm_frz ) + ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol + thlm_zm_frz(gr%nz) = max( thlm_zm_frz(gr%nz), thl_tol ) + + if ( l_call_pdf_closure_twice ) then + ! Call pdf_closure again to output the variables which belong on the momentum grid. + do k=1, gr%nz, 1 + call pdf_closure & + ( p_in_Pa_zm(k), exner_zm(k), thv_ds_zm(k), wm_zm(k), & ! intent(in) + wp2(k), wp3_zm(k), sigma_sqd_w(k), & ! intent(in) + Skw_zm(k), rtm_zm_frz(k), rtp2(k), & ! intent(in) + wprtp(k), thlm_zm_frz(k), thlp2(k), & ! intent(in) + wpthlp(k), rtpthlp(k), sclrm_zm(k,:), & ! intent(in) + wpsclrp(k,:), sclrp2(k,:), sclrprtp(k,:), & ! intent(in) + sclrpthlp(k,:), k, & ! intent(in) +#ifdef GFDL + RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 +#endif + wp4_frz(k), wprtp2_zm_frz(k), wp2rtp_zm_frz(k), & ! intent(out) + wpthlp2_zm_frz(k), wp2thlp_zm_frz(k), wprtpthlp_zm_frz(k), & ! intent(out) + cloud_frac_zm_frz(k), ice_supersat_frac_zm_frz(k), & ! intent(out) + rcm_zm_frz(k), wpthvp_frz(k), wp2thvp_zm_frz(k), rtpthvp_frz(k), & ! intent(out) + thlpthvp_frz(k), wprcp_frz(k), wp2rcp_zm_frz(k), rtprcp_frz(k), & ! intent(out) + thlprcp_frz(k), rcp2_frz(k), pdf_params_zm_frz(k), & ! intent(out) + err_code_pdf_closure, & ! intent(out) + wpsclrprtp_zm_frz(k,:), wpsclrp2_zm_frz(k,:), sclrpthvp_frz(k,:), & ! intent(out) + wpsclrpthlp_zm_frz(k,:), sclrprcp_frz(k,:), wp2sclrp_zm_frz(k,:), & ! intent(out) + rc_coef_frz(k) ) ! intent(out) + + ! Subroutine may produce NaN values, and if so, exit + ! gracefully. + ! Joshua Fasching March 2008 + + + if ( fatal_error( err_code_pdf_closure ) ) then + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "At grid level = ",k + end if + + err_code = err_code_pdf_closure + end if + + end do ! k = 1, gr%nz, 1 + else ! l_call_pdf_closure_twice is false + + wpthvp_frz = zt2zm( wpthvp_zt_frz ) + wpthvp_frz(gr%nz) = 0.0_core_rknd + thlpthvp_frz = zt2zm( thlpthvp_zt_frz ) + thlpthvp_frz(gr%nz) = 0.0_core_rknd + rtpthvp_frz = zt2zm( rtpthvp_zt_frz ) + rtpthvp_frz(gr%nz) = 0.0_core_rknd + + end if ! l_call_pdf_closure_twice + + if ( l_trapezoidal_rule_zt ) then + call trapezoidal_rule_zt & + ( l_call_pdf_closure_twice, & ! intent(in) + wprtp2_frz, wpthlp2_frz, & ! intent(inout) + wprtpthlp_frz, cloud_frac_frz, ice_supersat_frac_frz, & ! intent(inout) + rcm_frz, wp2thvp_frz, wpsclrprtp_frz, wpsclrp2_frz, & ! intent(inout) + wpsclrpthlp_frz, pdf_params_frz, & ! intent(inout) + wprtp2_zm_frz, wpthlp2_zm_frz, & ! intent(inout) + wprtpthlp_zm_frz, cloud_frac_zm_frz, & ! intent(inout) + ice_supersat_frac_zm_frz, rcm_zm_frz, wp2thvp_zm_frz, & ! intent(inout) + wpsclrprtp_zm_frz, wpsclrp2_zm_frz, wpsclrpthlp_zm_frz, & ! intent(inout) + pdf_params_zm_frz ) ! intent(inout) + end if ! l_trapezoidal_rule_zt + + ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for + ! the important momentum-level variabes output from pdf_closure. + ! ldgrant Feb. 2010 + if ( l_trapezoidal_rule_zm ) then + call trapezoidal_rule_zm & + ( wpthvp_zt_frz, thlpthvp_zt_frz, rtpthvp_zt_frz, & ! intent(in) + wpthvp_frz, thlpthvp_frz, rtpthvp_frz ) ! intent(inout) + end if ! l_trapezoidal_rule_zm + + end if ! l_use_ice_latent = .true. + + + + + + !---------------------------------------------------------------- + ! Compute thvm + !---------------------------------------------------------------- + + thvm = thlm + ep1 * thv_ds_zt * rtm & + + ( Lv/(Cp*exner) - ep2 * thv_ds_zt ) * rcm + + !---------------------------------------------------------------- + ! Compute tke (turbulent kinetic energy) + !---------------------------------------------------------------- + + if ( .not. l_tke_aniso ) then + ! tke is assumed to be 3/2 of wp2 + em = three_halves * wp2 ! Known magic number + else + em = 0.5_core_rknd * ( wp2 + vp2 + up2 ) + end if + + !---------------------------------------------------------------- + ! Compute mixing length + !---------------------------------------------------------------- + + if ( l_avg_Lscale .and. .not. l_Lscale_plume_centered ) then + ! Call compute length two additional times with perturbed values + ! of rtm and thlm so that an average value of Lscale may be calculated. + if ( l_use_ice_latent ) then + !Include the effects of ice in the length scale calculation + + thlm_pert_1 = thlm_frz + Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) + rtm_pert_1 = rtm_frz + Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) + mu_pert_1 = mu / Lscale_mu_coef + + thlm_pert_2 = thlm_frz - Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) + rtm_pert_2 = rtm_frz - Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) + mu_pert_2 = mu * Lscale_mu_coef + else + thlm_pert_1 = thlm + Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) + rtm_pert_1 = rtm + Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) + mu_pert_1 = mu / Lscale_mu_coef + + thlm_pert_2 = thlm - Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) + rtm_pert_2 = rtm - Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) + mu_pert_2 = mu * Lscale_mu_coef + end if + + call compute_length( thvm, thlm_pert_1, rtm_pert_1, em, & ! intent(in) + p_in_Pa, exner, thv_ds_zt, mu_pert_1, l_implemented, & ! intent(in) + err_code, & ! intent(inout) + Lscale_pert_1, Lscale_up, Lscale_down ) ! intent(out) + + call compute_length( thvm, thlm_pert_2, rtm_pert_2, em, & ! intent(in) + p_in_Pa, exner, thv_ds_zt, mu_pert_2, l_implemented, & ! intent(in) + err_code, & ! intent(inout) + Lscale_pert_2, Lscale_up, Lscale_down ) ! intent(out) + + else if ( l_avg_Lscale .and. l_Lscale_plume_centered ) then + ! Take the values of thl and rt based one 1st or 2nd plume + + do k = 1, gr%nz, 1 + sign_rtpthlp(k) = sign(1.0_core_rknd, rtpthlp(k)) + end do + + if ( l_use_ice_latent ) then + where ( pdf_params_frz%rt1 > pdf_params_frz%rt2 ) + rtm_pert_pos_rt = pdf_params_frz%rt1 & + + Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt1, rt_tol**2 ) ) + thlm_pert_pos_rt = pdf_params_frz%thl1 + ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params_frz%varnce_thl1, thl_tol**2 ) ) ) + thlm_pert_neg_rt = pdf_params_frz%thl2 - ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params_frz%varnce_thl2, thl_tol**2 ) ) ) + rtm_pert_neg_rt = pdf_params_frz%rt2 & + - Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt2, rt_tol**2 ) ) + !Lscale_weight = pdf_params%mixt_frac + else where + rtm_pert_pos_rt = pdf_params_frz%rt2 & + + Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt2, rt_tol**2 ) ) + thlm_pert_pos_rt = pdf_params_frz%thl2 + ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params_frz%varnce_thl2, thl_tol**2 ) ) ) + thlm_pert_neg_rt = pdf_params_frz%thl1 - ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params_frz%varnce_thl1, thl_tol**2 ) ) ) + rtm_pert_neg_rt = pdf_params_frz%rt1 & + - Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt1, rt_tol**2 ) ) + !Lscale_weight = 1.0_core_rknd - pdf_params%mixt_frac + end where + else + where ( pdf_params%rt1 > pdf_params%rt2 ) + rtm_pert_pos_rt = pdf_params%rt1 & + + Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt1, rt_tol**2 ) ) + thlm_pert_pos_rt = pdf_params%thl1 + ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params%varnce_thl1, thl_tol**2 ) ) ) + thlm_pert_neg_rt = pdf_params%thl2 - ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params%varnce_thl2, thl_tol**2 ) ) ) + rtm_pert_neg_rt = pdf_params%rt2 & + - Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt2, rt_tol**2 ) ) + !Lscale_weight = pdf_params%mixt_frac + else where + rtm_pert_pos_rt = pdf_params%rt2 & + + Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt2, rt_tol**2 ) ) + thlm_pert_pos_rt = pdf_params%thl2 + ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params%varnce_thl2, thl_tol**2 ) ) ) + thlm_pert_neg_rt = pdf_params%thl1 - ( sign_rtpthlp * Lscale_pert_coef & + * sqrt( max( pdf_params%varnce_thl1, thl_tol**2 ) ) ) + rtm_pert_neg_rt = pdf_params%rt1 & + - Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt1, rt_tol**2 ) ) + !Lscale_weight = 1.0_core_rknd - pdf_params%mixt_frac + end where + end if + mu_pert_pos_rt = mu / Lscale_mu_coef + mu_pert_neg_rt = mu * Lscale_mu_coef + + ! Call length with perturbed values of thl and rt + call compute_length( thvm, thlm_pert_pos_rt, rtm_pert_pos_rt, em, & ! intent(in) + p_in_Pa, exner, thv_ds_zt, mu_pert_pos_rt, l_implemented, & ! intent(in) + err_code, & ! intent(inout) + Lscale_pert_1, Lscale_up, Lscale_down ) ! intent(out) + + call compute_length( thvm, thlm_pert_neg_rt, rtm_pert_neg_rt, em, & ! intent(in) + p_in_Pa, exner, thv_ds_zt, mu_pert_neg_rt, l_implemented, & ! intent(in) + err_code, & ! intent(inout) + Lscale_pert_2, Lscale_up, Lscale_down ) ! intent(out) + else + Lscale_pert_1 = -999._core_rknd + Lscale_pert_2 = -999._core_rknd + + end if ! l_avg_Lscale + + if ( l_stats_samp ) then + call stat_update_var( iLscale_pert_1, Lscale_pert_1, zt ) + call stat_update_var( iLscale_pert_2, Lscale_pert_2, zt ) + end if ! l_stats_samp + + ! ********** NOTE: ********** + ! This call to compute_length must be last. Otherwise, the values of + ! Lscale_up and Lscale_down in stats will be based on perturbation length scales + ! rather than the mean length scale. + call compute_length( thvm, thlm, rtm, em, & ! intent(in) + p_in_Pa, exner, thv_ds_zt, mu, l_implemented, & ! intent(in) + err_code, & ! intent(inout) + Lscale, Lscale_up, Lscale_down ) ! intent(out) + + if ( l_avg_Lscale ) then + if ( l_Lscale_plume_centered ) then + ! Weighted average of mean, pert_1, & pert_2 +! Lscale = 0.5_core_rknd * ( Lscale + Lscale_weight*Lscale_pert_1 & +! + (1.0_core_rknd-Lscale_weight)*Lscale_pert_2 ) + + ! Weighted average of just the perturbed values +! Lscale = Lscale_weight*Lscale_pert_1 + (1.0_core_rknd-Lscale_weight)*Lscale_pert_2 + + ! Un-weighted average of just the perturbed values + Lscale = 0.5_core_rknd*( Lscale_pert_1 + Lscale_pert_2 ) + else + Lscale = (1.0_core_rknd/3.0_core_rknd) * ( Lscale + Lscale_pert_1 + Lscale_pert_2 ) + end if + end if + + !---------------------------------------------------------------- + ! Dissipation time + !---------------------------------------------------------------- +! Vince Larson replaced the cutoff of em_min by w_tol**2. 7 Jul 2007 +! This is to prevent tau from being too large (producing little damping) +! in stably stratified layers with little turbulence. +! sqrt_em_zt = SQRT( MAX( em_min, zm2zt( em ) ) ) +! tau_zt = MIN( Lscale / sqrt_em_zt, taumax ) +! tau_zm & +! = MIN( ( zt2zm( Lscale ) / SQRT( MAX( em_min, em ) ) ), taumax ) +! Addition by Brian: Model constant em_min is now set to (3/2)*w_tol_sqd. +! Thus, em_min can replace w_tol_sqd here. + sqrt_em_zt = SQRT( MAX( em_min, zm2zt( em ) ) ) + + tau_zt = MIN( Lscale / sqrt_em_zt, taumax ) + tau_zm = MIN( ( MAX( zt2zm( Lscale ), zero_threshold ) & + / SQRT( MAX( em_min, em ) ) ), taumax ) +! End Vince Larson's replacement. + + ! Modification to damp noise in stable region +! Vince Larson commented out because it may prevent turbulence from +! initiating in unstable regions. 7 Jul 2007 +! do k = 1, gr%nz +! if ( wp2(k) <= 0.005_core_rknd ) then +! tau_zt(k) = taumin +! tau_zm(k) = taumin +! end if +! end do +! End Vince Larson's commenting. + + !---------------------------------------------------------------- + ! Eddy diffusivity coefficient + !---------------------------------------------------------------- + ! c_K is 0.548 usually (Duynkerke and Driedonks 1987) + ! CLUBB uses a smaller value to better fit empirical data. + + Kh_zt = c_K * Lscale * sqrt_em_zt + Kh_zm = c_K * max( zt2zm( Lscale ), zero_threshold ) & + * sqrt( max( em, em_min ) ) + +#if defined(CLUBB_CAM) || defined(GFDL) || defined (CLUBB_SAM) + khzt(:) = Kh_zt(:) + khzm(:) = Kh_zm(:) + qclvar(:) = rcp2_zt(:) +#endif + + !---------------------------------------------------------------- + ! Set Surface variances + !---------------------------------------------------------------- + + ! Surface variances should be set here, before the call to either + ! advance_xp2_xpyp or advance_wp2_wp3. + ! Surface effects should not be included with any case where the lowest + ! level is not the ground level. Brian Griffin. December 22, 2005. + if ( gr%zm(1) == sfc_elevation ) then + + ! Reflect surface varnce changes in budget + if ( l_stats_samp ) then + call stat_begin_update_pt( ithlp2_sf, 1, & ! intent(in) + thlp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_begin_update_pt( irtp2_sf, 1, & ! intent(in) + rtp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_begin_update_pt( irtpthlp_sf, 1, & ! intent(in) + rtpthlp(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_begin_update_pt( iup2_sf, 1, & ! intent(in) + up2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_begin_update_pt( ivp2_sf, 1, & ! intent(in) + vp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_begin_update_pt( iwp2_sf, 1, & ! intent(in) + wp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + end if + + call surface_varnce( upwp_sfc, vpwp_sfc, wpthlp_sfc, wprtp_sfc, & ! intent(in) + um(2), vm(2), wpsclrp_sfc, & ! intent(in) + wp2(1), up2(1), vp2(1), & ! intent(out) + thlp2(1), rtp2(1), rtpthlp(1), err_code_surface,& ! intent(out) + sclrp2(1,1:sclr_dim), & ! intent(out) + sclrprtp(1,1:sclr_dim), & ! intent(out) + sclrpthlp(1,1:sclr_dim) ) ! intent(out) + + if ( fatal_error( err_code_surface ) ) then + call reportError( err_code_surface ) + err_code = err_code_surface + end if + + ! Update surface stats + if ( l_stats_samp ) then + call stat_end_update_pt( ithlp2_sf, 1, & ! intent(in) + thlp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_end_update_pt( irtp2_sf, 1, & ! intent(in) + rtp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_end_update_pt( irtpthlp_sf, 1, & ! intent(in) + rtpthlp(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_end_update_pt( iup2_sf, 1, & ! intent(in) + up2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_end_update_pt( ivp2_sf, 1, & ! intent(in) + vp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + call stat_end_update_pt( iwp2_sf, 1, & ! intent(in) + wp2(1) / real( dt , kind = core_rknd ), & ! intent(in) + zm ) ! intent(inout) + end if + + else + + ! Variances for cases where the lowest level is not at the surface. + ! Eliminate surface effects on lowest level variances. + wp2(1) = w_tol_sqd + up2(1) = w_tol_sqd + vp2(1) = w_tol_sqd + thlp2(1) = thl_tol**2 + rtp2(1) = rt_tol**2 + rtpthlp(1) = 0.0_core_rknd + + do i = 1, sclr_dim, 1 + sclrp2(1,i) = 0.0_core_rknd + sclrprtp(1,i) = 0.0_core_rknd + sclrpthlp(1,i) = 0.0_core_rknd + end do + + end if ! gr%zm(1) == sfc_elevation + + + !####################################################################### + !############## ADVANCE PROGNOSTIC VARIABLES ONE TIMESTEP ############## + !####################################################################### + + ! Store the saturation mixing ratio for output purposes. Brian + ! Compute rsat if either rsat or rel_humidity is to be saved. ldgrant + if ( ( irsat > 0 ) .or. ( irel_humidity > 0 ) ) then + rsat = sat_mixrat_liq( p_in_Pa, thlm2T_in_K( thlm, exner, rcm ) ) + end if + + + if ( l_stats_samp ) then + call stat_update_var( irvm, rtm - rcm, zt ) + + ! Output relative humidity (q/q∗ where q∗ is the saturation mixing ratio over liquid) + ! Added an extra check for irel_humidity > 0; otherwise, if both irsat = 0 and + ! irel_humidity = 0, rsat is not computed, leading to a floating-point exception + ! when stat_update_var is called for rel_humidity. ldgrant + if ( irel_humidity > 0 ) then + call stat_update_var( irel_humidity, (rtm - rcm) / rsat, zt) + end if ! irel_humidity > 0 + end if ! l_stats_samp + + !---------------------------------------------------------------- + ! Advance rtm/wprtp and thlm/wpthlp one time step + !---------------------------------------------------------------- + if ( l_call_pdf_closure_twice ) then + w1_zm = pdf_params_zm%w1 + w2_zm = pdf_params_zm%w2 + varnce_w1_zm = pdf_params_zm%varnce_w1 + varnce_w2_zm = pdf_params_zm%varnce_w2 + mixt_frac_zm = pdf_params_zm%mixt_frac + else + w1_zm = zt2zm( pdf_params%w1 ) + w2_zm = zt2zm( pdf_params%w2 ) + varnce_w1_zm = zt2zm( pdf_params%varnce_w1 ) + varnce_w2_zm = zt2zm( pdf_params%varnce_w2 ) + mixt_frac_zm = zt2zm( pdf_params%mixt_frac ) + end if + + if ( l_use_ice_latent ) then + !calculate turbulence with terms including ice latent heating + call advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & ! intent(in) + Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & ! intent(in) + tau_zm, Skw_zm, rtpthvp_frz, rtm_forcing, & ! intent(in) + wprtp_forcing, rtm_ref, thlpthvp_frz, & ! intent(in) + thlm_forcing, wpthlp_forcing, thlm_ref, & ! intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) + invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & ! intent(in) + w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! intent(in) + mixt_frac_zm, l_implemented, & ! intent(in) + sclrpthvp, sclrm_forcing, sclrp2, & ! intent(in) + rtm, wprtp, thlm, wpthlp, & ! intent(inout) + err_code, & ! intent(inout) + sclrm, wpsclrp ) ! intent(inout) + else + call advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & ! intent(in) + Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & ! intent(in) + tau_zm, Skw_zm, rtpthvp, rtm_forcing, & ! intent(in) + wprtp_forcing, rtm_ref, thlpthvp, & ! intent(in) + thlm_forcing, wpthlp_forcing, thlm_ref, & ! intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) + invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & ! intent(in) + w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! intent(in) + mixt_frac_zm, l_implemented, & ! intent(in) + sclrpthvp, sclrm_forcing, sclrp2, & ! intent(in) + rtm, wprtp, thlm, wpthlp, & ! intent(inout) + err_code, & ! intent(inout) + sclrm, wpsclrp ) ! intent(inout) + end if + + ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. + ! This code won't work unless rtm >= 0 !!! + ! We do not clip rcm_in_layer because rcm_in_layer only influences + ! radiation, and we do not want to bother recomputing it. 6 Aug 2009 + call clip_rcm( rtm, 'rtm < rcm in advance_xm_wpxp', & ! intent(in) + rcm ) ! intent(inout) + +#ifdef GFDL + call advance_sclrm_Nd_diffusion_OG( dt, sclrm, & ! h1g, 2010-06-16 + sclrm_trsport_only, Kh_zm, cloud_frac, err_code ) +#endif + + !---------------------------------------------------------------- + ! Compute some of the variances and covariances. These include the variance of + ! total water (rtp2), liquid potential termperature (thlp2), their + ! covariance (rtpthlp), and the variance of horizontal wind (up2 and vp2). + ! The variance of vertical velocity is computed later. + !---------------------------------------------------------------- + + ! We found that certain cases require a time tendency to run + ! at shorter timesteps so these are prognosed now. + + ! We found that if we call advance_xp2_xpyp first, we can use a longer timestep. + if ( l_use_ice_latent) then + ! calculate turbulence with terms including ice latent heating + call advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & ! intent(in) + wpthlp, wpthvp_frz, um, vm, wp2, wp2_zt, & ! intent(in) + wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & ! intent(in) + Kh_zt, rtp2_forcing, thlp2_forcing, & ! intent(in) + rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & ! intent(in) + invrs_rho_ds_zm, thv_ds_zm, & ! intent(in) + Lscale, wp3_on_wp2, wp3_on_wp2_zt, & ! intent(in) + l_iter_xp2_xpyp, dt, & ! intent(in) + sclrm, wpsclrp, & ! intent(in) + rtp2, thlp2, rtpthlp, up2, vp2, & ! intent(inout) + err_code, & ! intent(inout) + sclrp2, sclrprtp, sclrpthlp ) ! intent(inout) + else + call advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & ! intent(in) + wpthlp, wpthvp, um, vm, wp2, wp2_zt, & ! intent(in) + wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & ! intent(in) + Kh_zt, rtp2_forcing, thlp2_forcing, & ! intent(in) + rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & ! intent(in) + invrs_rho_ds_zm, thv_ds_zm, & ! intent(in) + Lscale, wp3_on_wp2, wp3_on_wp2_zt, & ! intent(in) + l_iter_xp2_xpyp, dt, & ! intent(in) + sclrm, wpsclrp, & ! intent(in) + rtp2, thlp2, rtpthlp, up2, vp2, & ! intent(inout) + err_code, & ! intent(inout) + sclrp2, sclrprtp, sclrpthlp ) ! intent(inout) + end if + + !---------------------------------------------------------------- + ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp + ! after subroutine advance_xp2_xpyp updated xp2. + !---------------------------------------------------------------- + + wprtp_cl_num = 2 ! Second instance of w'r_t' clipping. + wpthlp_cl_num = 2 ! Second instance of w'th_l' clipping. + wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping. + upwp_cl_num = 1 ! First instance of u'w' clipping. + vpwp_cl_num = 1 ! First instance of v'w' clipping. + + call clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in) + sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in) + wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in) + wprtp, wpthlp, upwp, vpwp, wpsclrp ) ! intent(inout) + + + !---------------------------------------------------------------- + ! Advance 2nd and 3rd order moment of vertical velocity (wp2 / wp3) + ! by one timestep + !---------------------------------------------------------------- + + if ( l_use_ice_latent) then + call advance_wp2_wp3 & + ( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! intent(in) + a3_coef, a3_coef_zt, wp3_on_wp2, & ! intent(in) + wpthvp_frz, wp2thvp_frz, um, vm, upwp, vpwp, & ! intent(in) + up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & ! intent(in) + Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & ! intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & ! intent(in) + thv_ds_zm, thv_ds_zt, pdf_params%mixt_frac, & ! intent(in) + wp2, wp3, wp3_zm, wp2_zt, err_code ) ! intent(inout) + else + call advance_wp2_wp3 & + ( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! intent(in) + a3_coef, a3_coef_zt, wp3_on_wp2, & ! intent(in) + wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! intent(in) + up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & ! intent(in) + Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & ! intent(in) + invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & ! intent(in) + thv_ds_zm, thv_ds_zt, pdf_params%mixt_frac, & ! intent(in) + wp2, wp3, wp3_zm, wp2_zt, err_code ) ! intent(inout) + end if + + !---------------------------------------------------------------- + ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp + ! after subroutine advance_wp2_wp3 updated wp2. + !---------------------------------------------------------------- + + wprtp_cl_num = 3 ! Third instance of w'r_t' clipping. + wpthlp_cl_num = 3 ! Third instance of w'th_l' clipping. + wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping. + upwp_cl_num = 2 ! Second instance of u'w' clipping. + vpwp_cl_num = 2 ! Second instance of v'w' clipping. + + call clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in) + sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in) + wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in) + wprtp, wpthlp, upwp, vpwp, wpsclrp ) ! intent(inout) + + !---------------------------------------------------------------- + ! Advance the horizontal mean of the wind in the x-y directions + ! (i.e. um, vm) and the mean of the eddy-diffusivity scalars + ! (i.e. edsclrm) by one time step + !---------------------------------------------------------------- + + call advance_windm_edsclrm( dt, wm_zt, Kh_zm, ug, vg, um_ref, vm_ref, & ! Intent(in) + wp2, up2, vp2, um_forcing, vm_forcing, & ! Intent(in) + edsclrm_forcing, & ! Intent(in) + rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) + fcor, l_implemented, & ! Intent(in) + um, vm, edsclrm, & ! Intent(inout) + upwp, vpwp, wpedsclrp, & ! Intent(inout) + err_code ) ! Intent(inout) + + !####################################################################### + !############# ACCUMULATE STATISTICS ############# + !####################################################################### + + if ( l_stats_samp ) then + + call stat_end_update( iwp2_bt, wp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( ivp2_bt, vp2 / real( dt , kind = core_rknd ),& ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( iup2_bt, up2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( iwprtp_bt, wprtp / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( iwpthlp_bt, wpthlp / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( irtp2_bt, rtp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( ithlp2_bt, thlp2 / real( dt , kind = core_rknd ), & ! Intent(in) + zm ) ! Intent(inout) + call stat_end_update( irtpthlp_bt, rtpthlp / real( dt , kind = core_rknd ), &! Intent(in) + zm ) ! Intent(inout) + + call stat_end_update( irtm_bt, rtm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_end_update( ithlm_bt, thlm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_end_update( ium_bt, um / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_end_update( ivm_bt, vm / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + call stat_end_update( iwp3_bt, wp3 / real( dt , kind = core_rknd ), & ! Intent(in) + zt ) ! Intent(inout) + + end if ! l_stats_samp + + + if ( iwpthlp_zt > 0 ) then + wpthlp_zt = zm2zt( wpthlp ) + end if + + if ( iwprtp_zt > 0 ) then + wprtp_zt = zm2zt( wprtp ) + end if + + if ( iup2_zt > 0 ) then + up2_zt = max( zm2zt( up2 ), w_tol_sqd ) + end if + + if (ivp2_zt > 0 ) then + vp2_zt = max( zm2zt( vp2 ), w_tol_sqd ) + end if + + if ( iupwp_zt > 0 ) then + upwp_zt = zm2zt( upwp ) + end if + + if ( ivpwp_zt > 0 ) then + vpwp_zt = zm2zt( vpwp ) + end if + + call stats_accumulate & + ( um, vm, upwp, vpwp, up2, vp2, & ! intent(in) + thlm, rtm, wprtp, wpthlp, & ! intent(in) + wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) + p_in_Pa, exner, rho, rho_zm, & ! intent(in) + rho_ds_zm, rho_ds_zt, thv_ds_zm, & ! intent(in) + thv_ds_zt, wm_zt, wm_zm, rcm, wprcp, rc_coef, & ! intent(in) + rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac,& ! intent(in) + cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, & ! intent(in) + cloud_cover, sigma_sqd_w, pdf_params, & ! intent(in) + sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & ! intent(in) + wpsclrp, edsclrm, edsclrm_forcing ) ! intent(in) + + + if ( clubb_at_least_debug_level( 2 ) ) then + call parameterization_check & + ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in) + wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & ! intent(in) + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & ! intent(in) + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! intent(in) + um, upwp, vm, vpwp, up2, vp2, & ! intent(in) + rtm, wprtp, thlm, wpthlp, & ! intent(in) + wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) + "end of ", & ! intent(in) + wpsclrp_sfc, wpedsclrp_sfc, & ! intent(in) + sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & ! intent(in) + sclrm_forcing, edsclrm, edsclrm_forcing, & ! intent(in) + err_code ) ! intent(inout) + end if + + if ( l_stats .and. l_stats_samp ) then + ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero. + ! Therefore, wm must be zero or l_implemented must be true. + if ( l_implemented .or. ( all( wm_zt == 0._core_rknd ) .and. & + all( wm_zm == 0._core_rknd ) ) ) then + ! Calculate the spurious source for rtm + rtm_flux_top = rho_ds_zm(gr%nz) * wprtp(gr%nz) + + if ( .not. l_host_applies_sfc_fluxes ) then + rtm_flux_sfc = rho_ds_zm(1) * wprtp_sfc + else + rtm_flux_sfc = 0.0_core_rknd + end if + + rtm_integral_after & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + rtm_integral_forcing & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + rtm_forcing(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + rtm_spur_src & + = calculate_spurious_source( rtm_integral_after, & + rtm_integral_before, & + rtm_flux_top, rtm_flux_sfc, & + rtm_integral_forcing, & + real( dt , kind = core_rknd ) ) + + ! Calculate the spurious source for thlm + thlm_flux_top = rho_ds_zm(gr%nz) * wpthlp(gr%nz) + + if ( .not. l_host_applies_sfc_fluxes ) then + thlm_flux_sfc = rho_ds_zm(1) * wpthlp_sfc + else + thlm_flux_sfc = 0.0_core_rknd + end if + + thlm_integral_after & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + thlm_integral_forcing & + = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + thlm_forcing(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + thlm_spur_src & + = calculate_spurious_source( thlm_integral_after, & + thlm_integral_before, & + thlm_flux_top, thlm_flux_sfc, & + thlm_integral_forcing, & + real( dt , kind = core_rknd ) ) + else ! If l_implemented is false, we don't want spurious source output + rtm_spur_src = -9999.0_core_rknd + thlm_spur_src = -9999.0_core_rknd + end if + + ! Write the var to stats + call stat_update_var_pt( irtm_spur_src, 1, & + rtm_spur_src, sfc ) + call stat_update_var_pt( ithlm_spur_src, 1, & + thlm_spur_src, sfc ) + end if + + return + end subroutine advance_clubb_core + + !----------------------------------------------------------------------- + subroutine setup_clubb_core & + ( nzmax, T0_in, ts_nudge_in, & ! In + hydromet_dim_in, sclr_dim_in, & ! In + sclr_tol_in, edsclr_dim_in, params, & ! In + l_host_applies_sfc_fluxes, & ! In + l_uv_nudge, saturation_formula, & ! In +#ifdef GFDL + I_sat_sphum, & ! intent(in) h1g, 2010-06-16 +#endif + l_implemented, grid_type, deltaz, zm_init, zm_top, & ! In + momentum_heights, thermodynamic_heights, & ! In + host_dx, host_dy, sfc_elevation, & ! In +#ifdef GFDL + cloud_frac_min , & ! intent(in) h1g, 2010-06-16 +#endif + err_code ) ! Out + ! + ! Description: + ! Subroutine to set up the model for execution. + ! + ! References: + ! None + !------------------------------------------------------------------------- + use crmx_grid_class, only: & + setup_grid, & ! Procedure + gr ! Variable(s) + + use crmx_parameter_indices, only: & + nparams ! Variable(s) + + use crmx_parameters_tunable, only: & + setup_parameters ! Procedure + + use crmx_parameters_model, only: & + setup_parameters_model ! Procedure + + use crmx_variables_diagnostic_module, only: & + setup_diagnostic_variables ! Procedure + + use crmx_variables_prognostic_module, only: & + setup_prognostic_variables ! Procedure + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_error_code, only: & + clubb_no_error ! Constant(s) + + use crmx_model_flags, only: & + setup_model_flags, & ! Subroutine + l_gmres ! Variable + +#ifdef MKL + use crmx_csr_matrix_class, only: & + initialize_csr_class, & ! Subroutine + intlc_5d_5d_ja_size ! Variable + + use crmx_gmres_wrap, only: & + gmres_init ! Subroutine + + use crmx_gmres_cache, only: & + gmres_cache_temp_init, & ! Subroutine + gmres_idx_wp2wp3 ! Variable +#endif /* MKL */ + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + + ! Grid definition + integer, intent(in) :: nzmax ! Vertical grid levels [#] + ! Only true when used in a host model + ! CLUBB determines what nzmax should be + ! given zm_init and zm_top when + ! running in standalone mode. + + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + ! Flag to see if CLUBB is running on it's own, + ! or if it's implemented as part of a host model. + logical, intent(in) :: l_implemented ! (T/F) + + ! If CLUBB is running on it's own, this option determines + ! if it is using: + ! 1) an evenly-spaced grid, + ! 2) a stretched (unevenly-spaced) grid entered on the + ! thermodynamic grid levels (with momentum levels set + ! halfway between thermodynamic levels), or + ! 3) a stretched (unevenly-spaced) grid entered on the + ! momentum grid levels (with thermodynamic levels set + ! halfway between momentum levels). + integer, intent(in) :: grid_type + + ! If the CLUBB model is running by itself, and is using an + ! evenly-spaced grid (grid_type = 1), it needs the vertical + ! grid spacing, momentum-level starting altitude, and maximum + ! altitude as input. + real( kind = core_rknd ), intent(in) :: & + deltaz, & ! Change in altitude per level [m] + zm_init, & ! Initial grid altitude (momentum level) [m] + zm_top ! Maximum grid altitude (momentum level) [m] + + ! If the CLUBB parameterization is implemented in a host model, + ! it needs to use the host model's momentum level altitudes + ! and thermodynamic level altitudes. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on thermodynamic levels (grid_type = 2), + ! it needs to use the thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on momentum levels (grid_type = 3), + ! it needs to use the momentum level altitudes as input. + real( kind = core_rknd ), intent(in), dimension(nzmax) :: & + momentum_heights, & ! Momentum level altitudes (input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (input) [m] + + ! Host model horizontal grid spacing, if part of host model. + real( kind = core_rknd ), intent(in) :: & + host_dx, & ! East-West horizontal grid spacing [m] + host_dy ! North-South horizontal grid spacing [m] + + ! Model parameters + real( kind = core_rknd ), intent(in) :: & + T0_in, ts_nudge_in + + integer, intent(in) :: & + hydromet_dim_in, & ! Number of hydrometeor species + sclr_dim_in, & ! Number of passive scalars + edsclr_dim_in ! Number of eddy-diff. passive scalars + + real( kind = core_rknd ), intent(in), dimension(sclr_dim_in) :: & + sclr_tol_in ! Thresholds for passive scalars + + real( kind = core_rknd ), intent(in), dimension(nparams) :: & + params ! Including C1, nu1, nu2, etc. + + ! Flags + logical, intent(in) :: & + l_uv_nudge, & ! Wind nudging + l_host_applies_sfc_fluxes ! Whether to apply for the surface flux + + character(len=*), intent(in) :: & + saturation_formula ! Approximation for saturation vapor pressure + +#ifdef GFDL + logical, intent(in) :: & ! h1g, 2010-06-16 begin mod + I_sat_sphum + + real( kind = core_rknd ), intent(in) :: & + cloud_frac_min ! h1g, 2010-06-16 end mod +#endif + + ! Output variables + integer, intent(out) :: & + err_code ! Diagnostic for a problem with the setup + + ! Local variables + real( kind = core_rknd ) :: Lscale_max + integer :: begin_height, end_height + + !----- Begin Code ----- + + ! Sanity check for the saturation formula + select case ( trim( saturation_formula ) ) + case ( "bolton", "Bolton" ) + ! Using the Bolton 1980 approximations for SVP over vapor/ice + + case ( "flatau", "Flatau" ) + ! Using the Flatau, et al. polynomial approximation for SVP over vapor/ice + + case ( "gfdl", "GFDL" ) ! h1g, 2010-06-16 + ! Using the GFDL SVP formula (Goff-Gratch) + + ! Add new saturation formulas after this + + case default + write(fstderr,*) "Error in setup_clubb_core." + write(fstderr,*) "Unknown approx. of saturation vapor pressure: "// & + trim( saturation_formula ) + stop + end select + + ! Setup grid + call setup_grid( nzmax, sfc_elevation, l_implemented, & ! intent(in) + grid_type, deltaz, zm_init, zm_top, & ! intent(in) + momentum_heights, thermodynamic_heights, & ! intent(in) + begin_height, end_height ) ! intent(out) + + ! Setup flags +#ifdef GFDL + call setup_model_flags & + ( l_host_applies_sfc_fluxes, & ! intent(in) + l_uv_nudge, saturation_formula, & ! intent(in) + I_sat_sphum ) ! intent(in) h1g, 2010-06-16 + +#else + call setup_model_flags & + ( l_host_applies_sfc_fluxes, & ! intent(in) + l_uv_nudge, saturation_formula ) ! intent(in) +#endif + + ! Determine the maximum allowable value for Lscale (in meters). + call set_Lscale_max( l_implemented, host_dx, host_dy, & ! Intent(in) + Lscale_max ) ! Intent(out) + + ! Define model constant parameters +#ifdef GFDL + call setup_parameters_model( T0_in, ts_nudge_in, & ! In + hydromet_dim_in, & ! in + sclr_dim_in, sclr_tol_in, edsclr_dim_in, &! In + Lscale_max, cloud_frac_min ) ! In h1g, 2010-06-16 +#else + call setup_parameters_model( T0_in, ts_nudge_in, & ! In + hydromet_dim_in, & ! in + sclr_dim_in, sclr_tol_in, edsclr_dim_in, &! In + Lscale_max ) ! In +#endif + + ! Define tunable constant parameters + call setup_parameters & + ( deltaz, params, gr%nz, & ! intent(in) + grid_type, momentum_heights(begin_height:end_height), & ! intent(in) + thermodynamic_heights(begin_height:end_height), & ! intent(in) + err_code ) ! intent(out) + + ! Error Report + ! Joshua Fasching February 2008 + if ( err_code /= clubb_no_error ) then + + write(fstderr,*) "Error in setup_clubb_core" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "deltaz = ", deltaz + write(fstderr,*) "zm_init = ", zm_init + write(fstderr,*) "zm_top = ", zm_top + write(fstderr,*) "momentum_heights = ", momentum_heights + write(fstderr,*) "thermodynamic_heights = ", & + thermodynamic_heights + write(fstderr,*) "T0_in = ", T0_in + write(fstderr,*) "ts_nudge_in = ", ts_nudge_in + write(fstderr,*) "params = ", params + + return + + end if + +#ifdef GFDL +! setup prognostic_variables + call setup_prognostic_variables( gr%nz ) ! intent(in) h1g, 2010-06-16 +#else + if ( .not. l_implemented ) then + call setup_prognostic_variables( gr%nz ) ! intent(in) + end if +#endif + + ! The diagnostic variables need to be + ! declared, allocated, initialized, and deallocated whether CLUBB + ! is part of a larger model or not. + call setup_diagnostic_variables( gr%nz ) + +#ifdef MKL + ! Initialize the CSR matrix class. + if ( l_gmres ) then + call initialize_csr_class + end if + + if ( l_gmres ) then + call gmres_cache_temp_init( gr%nz ) + call gmres_init( (2 * gr%nz), intlc_5d_5d_ja_size ) + end if +#endif /* MKL */ + + return + end subroutine setup_clubb_core + + !---------------------------------------------------------------------------- + subroutine cleanup_clubb_core( l_implemented ) + ! + ! Description: + ! Frees memory used by the model itself. + ! + ! References: + ! None + !--------------------------------------------------------------------------- + use crmx_parameters_model, only: sclr_tol ! Variable + + use crmx_variables_diagnostic_module, only: & + cleanup_diagnostic_variables ! Procedure + + use crmx_variables_prognostic_module, only: & + cleanup_prognostic_variables ! Procedure + + use crmx_grid_class, only: & + cleanup_grid ! Procedure + + use crmx_parameters_tunable, only: & + cleanup_nu ! Procedure + + implicit none + + ! Flag to see if CLUBB is running on it's own, + ! or if it's implemented as part of a host model. + logical, intent(in) :: l_implemented ! (T/F) + + !----- Begin Code ----- +#ifdef GFDL + ! cleanup prognostic_variables + call cleanup_prognostic_variables( ) ! h1g, 2010-06-16 +#else + if ( .not. l_implemented ) then + call cleanup_prognostic_variables( ) + end if +#endif + + ! The diagnostic variables need to be + ! declared, allocated, initialized, and deallocated whether CLUBB + ! is part of a larger model or not. + call cleanup_diagnostic_variables( ) + + ! De-allocate the array for the passive scalar tolerances + deallocate( sclr_tol ) + + ! De-allocate the arrays for the grid + call cleanup_grid( ) + + ! De-allocate the arrays for nu + call cleanup_nu( ) + + return + end subroutine cleanup_clubb_core + + !----------------------------------------------------------------------- + subroutine trapezoidal_rule_zt & + ( l_call_pdf_closure_twice, & ! intent(in) + wprtp2, wpthlp2, & ! intent(inout) + wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout) + rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout) + wpsclrpthlp, pdf_params, & ! intent(inout) + wprtp2_zm, wpthlp2_zm, & ! intent(inout) + wprtpthlp_zm, cloud_frac_zm, & ! intent(inout) + ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout) + wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm, & ! intent(inout) + pdf_params_zm ) ! intent(inout) + ! + ! Description: + ! This subroutine takes the output variables on the thermo. + ! grid and either: interpolates them to the momentum grid, or uses the + ! values output from the second call to pdf_closure on momentum levels if + ! l_call_pdf_closure_twice is true. It then calls the function + ! trapezoid_zt to recompute the variables on the thermo. grid. + ! + ! ldgrant June 2009 + ! + ! Note: + ! The argument variables in the last 5 lines of the subroutine + ! (wprtp2_zm through pdf_params_zm) are declared intent(inout) because + ! if l_call_pdf_closure_twice is true, these variables will already have + ! values from pdf_closure on momentum levels and will not be altered in + ! this subroutine. However, if l_call_pdf_closure_twice is false, these + ! variables will not have values yet and will be interpolated to + ! momentum levels in this subroutine. + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_stats_variables, only: & + iwprtp2, & ! Varibles + iwprtpthlp, & + iwpthlp2, & + iwprtp2, & + iwpsclrp2, & + iwpsclrprtp, & + iwpsclrpthlp, & + l_stats + + use crmx_grid_class, only: & + gr, & ! Variable + zt2zm ! Procedure + + use crmx_parameters_model, only: & + sclr_dim ! Number of passive scalar variables + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Derived data type + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + logical, parameter :: & + l_apply_rule_to_pdf_params = .false. ! Apply the trapezoidal rule to pdf_params + + ! Input variables + logical, intent(in) :: l_call_pdf_closure_twice + + ! Input/Output variables + ! Thermodynamic level variables output from the first call to pdf_closure + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wprtp2, & ! w'rt'^2 [m kg^2/kg^2] + wpthlp2, & ! w'thl'^2 [m K^2/s] + wprtpthlp, & ! w'rt'thl' [m kg K/kg s] + cloud_frac, & ! Cloud Fraction [-] + ice_supersat_frac, & ! Ice Cloud Fraction [-] + rcm, & ! Liquid water mixing ratio [kg/kg] + wp2thvp ! w'^2 th_v' [m^2 K/s^2] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & + wpsclrprtp, & ! w'sclr'rt' + wpsclrp2, & ! w'sclr'^2 + wpsclrpthlp ! w'sclr'thl' + + type (pdf_parameter), dimension(gr%nz), intent(inout) :: & + pdf_params ! PDF parameters [units vary] + + ! Thermo. level variables brought to momentum levels either by + ! interpolation (in subroutine trapezoidal_rule_zt) or by + ! the second call to pdf_closure (in subroutine advance_clubb_core) + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wprtp2_zm, & ! w'rt'^2 on momentum grid [m kg^2/kg^2] + wpthlp2_zm, & ! w'thl'^2 on momentum grid [m K^2/s] + wprtpthlp_zm, & ! w'rt'thl' on momentum grid [m kg K/kg s] + cloud_frac_zm, & ! Cloud Fraction on momentum grid [-] + ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-] + rcm_zm, & ! Liquid water mixing ratio on momentum grid [kg/kg] + wp2thvp_zm ! w'^2 th_v' on momentum grid [m^2 K/s^2] + + real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & + wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid + wpsclrp2_zm, & ! w'sclr'^2 on momentum grid + wpsclrpthlp_zm ! w'sclr'thl' on momentum grid + + type (pdf_parameter), dimension(gr%nz), intent(inout) :: & + pdf_params_zm ! PDF parameters on momentum grid [units vary] + + ! Local variables + + ! Components of PDF_parameters on the momentum grid (_zm) and on the thermo. grid (_zt) + real( kind = core_rknd ), dimension(gr%nz) :: & + w1_zt, & ! Mean of w for 1st normal distribution [m/s] + w1_zm, & ! Mean of w for 1st normal distribution [m/s] + w2_zm, & ! Mean of w for 2nd normal distribution [m/s] + w2_zt, & ! Mean of w for 2nd normal distribution [m/s] + varnce_w1_zm, & ! Variance of w for 1st normal distribution [m^2/s^2] + varnce_w1_zt, & ! Variance of w for 1st normal distribution [m^2/s^2] + varnce_w2_zm, & ! Variance of w for 2nd normal distribution [m^2/s^2] + varnce_w2_zt, & ! Variance of w for 2nd normal distribution [m^2/s^2] + rt1_zm, & ! Mean of r_t for 1st normal distribution [kg/kg] + rt1_zt, & ! Mean of r_t for 1st normal distribution [kg/kg] + rt2_zm, & ! Mean of r_t for 2nd normal distribution [kg/kg] + rt2_zt, & ! Mean of r_t for 2nd normal distribution [kg/kg] + varnce_rt1_zm, & ! Variance of r_t for 1st normal distribution [kg^2/kg^2] + varnce_rt1_zt, & ! Variance of r_t for 1st normal distribution [kg^2/kg^2] + varnce_rt2_zm, & ! Variance of r_t for 2nd normal distribution [kg^2/kg^2] + varnce_rt2_zt, & ! Variance of r_t for 2nd normal distribution [kg^2/kg^2] + crt1_zm, & ! Coefficient for s' [-] + crt1_zt, & ! Coefficient for s' [-] + crt2_zm ! Coefficient for s' [-] + + real( kind = core_rknd ), dimension(gr%nz) :: & + crt2_zt, & ! Coefficient for s' [-] + cthl1_zm, & ! Coefficient for s' [1/K] + cthl1_zt, & ! Coefficient for s' [1/K] + cthl2_zm, & ! Coefficient for s' [1/K] + cthl2_zt, & ! Coefficient for s' [1/K] + thl1_zm, & ! Mean of th_l for 1st normal distribution [K] + thl1_zt, & ! Mean of th_l for 1st normal distribution [K] + thl2_zm, & ! Mean of th_l for 2nd normal distribution [K] + thl2_zt, & ! Mean of th_l for 2nd normal distribution + varnce_thl1_zm, & ! Variance of th_l for 1st normal distribution [K^2] + varnce_thl1_zt, & ! Variance of th_l for 1st normal distribution [K^2] + varnce_thl2_zm, & ! Variance of th_l for 2nd normal distribution [K^2] + varnce_thl2_zt ! Variance of th_l for 2nd normal distribution [K^2] + + real( kind = core_rknd ), dimension(gr%nz) :: & + mixt_frac_zm, & ! Weight of 1st normal distribution (Sk_w dependent) [-] + mixt_frac_zt, & ! Weight of 1st normal distribution (Sk_w dependent) [-] + rc1_zm, & ! Mean of r_c for 1st normal distribution [kg/kg] + rc1_zt, & ! Mean of r_c for 1st normal distribution [kg/kg] + rc2_zm, & ! Mean of r_c for 2nd normal distribution [kg/kg] + rc2_zt, & ! Mean of r_c for 2nd normal distribution [kg/kg] + rsl1_zm, & ! Mean of r_sl for 1st normal distribution [kg/kg] + rsl1_zt, & ! Mean of r_sl for 1st normal distribution [kg/kg] + rsl2_zm, & ! Mean of r_sl for 2nd normal distribution [kg/kg] + rsl2_zt, & ! Mean of r_sl for 2nd normal distribution [kg/kg] + cloud_frac1_zm, & ! Cloud fraction for 1st normal distribution [-] + cloud_frac1_zt, & ! Cloud fraction for 1st normal distribution [-] + cloud_frac2_zm, & ! Cloud fraction for 2nd normal distribution [-] + cloud_frac2_zt, & ! Cloud fraction for 2nd normal distribution [-] + s1_zm, & ! Mean of s for 1st normal distribution [kg/kg] + s1_zt, & ! Mean of s for 1st normal distribution [kg/kg] + s2_zm, & ! Mean of s for 2nd normal distribution [kg/kg] + s2_zt, & ! Mean of s for 2nd normal distribution [kg/kg] + stdev_s1_zm ! Standard deviation of s for 1st normal distribution [kg/kg] + + real( kind = core_rknd ), dimension(gr%nz) :: & + stdev_s1_zt, & ! Standard deviation of s for 1st normal distribution [kg/kg] + stdev_s2_zm, & ! Standard deviation of s for 2nd normal distribution [kg/kg] + stdev_s2_zt, & ! Standard deviation of s for 2nd normal distribution [kg/kg] + stdev_t1_zm, & ! Standard deviation of t for 1st normal distribution [kg/kg] + stdev_t1_zt, & ! Standard deviation of t for 1st normal distribution [kg/kg] + stdev_t2_zm, & ! Standard deviation of t for 2nd normal distribution [kg/kg] + stdev_t2_zt, & ! Standard deviation of t for 2nd normal distribution [kg/kg] + rrtthl_zm, & ! Within-a-normal correlation of r_t and th_l [-] + rrtthl_zt, & ! Within-a-normal correlation of r_t and th_l [-] + alpha_thl_zm, & ! Factor relating to normalized variance for th_l [-] + alpha_thl_zt, & ! Factor relating to normalized variance for th_l [-] + alpha_rt_zm, & ! Factor relating to normalized variance for r_t [-] + alpha_rt_zt ! Factor relating to normalized variance for r_t [-] + + integer :: i + + !----------------------- Begin Code ----------------------------- + + ! Store components of pdf_params in the locally declared variables + ! We only apply the trapezoidal rule to these when + ! l_apply_rule_to_pdf_params is true. This is because when we apply the + ! rule to the final result of pdf_closure rather than the intermediate + ! results it can lead to an inconsistency in how we determine which + ! PDF component a point is in and whether the point is in or out of cloud, + ! which is turn will break the latin hypercube code that samples + ! preferentially in cloud. -dschanen 13 Feb 2012 + + if ( l_apply_rule_to_pdf_params ) then + w1_zt = pdf_params%w1 + w2_zt = pdf_params%w2 + varnce_w1_zt = pdf_params%varnce_w1 + varnce_w2_zt = pdf_params%varnce_w2 + rt1_zt = pdf_params%rt1 + rt2_zt = pdf_params%rt2 + varnce_rt1_zt = pdf_params%varnce_rt1 + varnce_rt2_zt = pdf_params%varnce_rt2 + crt1_zt = pdf_params%crt1 + crt2_zt = pdf_params%crt2 + cthl1_zt = pdf_params%cthl1 + cthl2_zt = pdf_params%cthl2 + thl1_zt = pdf_params%thl1 + thl2_zt = pdf_params%thl2 + varnce_thl1_zt = pdf_params%varnce_thl1 + varnce_thl2_zt = pdf_params%varnce_thl2 + mixt_frac_zt = pdf_params%mixt_frac + rc1_zt = pdf_params%rc1 + rc2_zt = pdf_params%rc2 + rsl1_zt = pdf_params%rsl1 + rsl2_zt = pdf_params%rsl2 + cloud_frac1_zt = pdf_params%cloud_frac1 + cloud_frac2_zt = pdf_params%cloud_frac2 + s1_zt = pdf_params%s1 + s2_zt = pdf_params%s2 + stdev_s1_zt = pdf_params%stdev_s1 + stdev_s2_zt = pdf_params%stdev_s2 + stdev_t1_zt = pdf_params%stdev_t1 + stdev_t2_zt = pdf_params%stdev_t2 + rrtthl_zt = pdf_params%rrtthl + alpha_thl_zt = pdf_params%alpha_thl + alpha_rt_zt = pdf_params%alpha_rt + end if + + ! If l_call_pdf_closure_twice is true, the _zm variables already have + ! values from the second call to pdf_closure in advance_clubb_core. + ! If it is false, the variables are interpolated to the _zm levels. + if ( l_call_pdf_closure_twice ) then + + ! Store, in locally declared variables, the pdf_params output + ! from the second call to pdf_closure + if ( l_apply_rule_to_pdf_params ) then + w1_zm = pdf_params_zm%w1 + w2_zm = pdf_params_zm%w2 + varnce_w1_zm = pdf_params_zm%varnce_w1 + varnce_w2_zm = pdf_params_zm%varnce_w2 + rt1_zm = pdf_params_zm%rt1 + rt2_zm = pdf_params_zm%rt2 + varnce_rt1_zm = pdf_params_zm%varnce_rt1 + varnce_rt2_zm = pdf_params_zm%varnce_rt2 + crt1_zm = pdf_params_zm%crt1 + crt2_zm = pdf_params_zm%crt2 + cthl1_zm = pdf_params_zm%cthl1 + cthl2_zm = pdf_params_zm%cthl2 + thl1_zm = pdf_params_zm%thl1 + thl2_zm = pdf_params_zm%thl2 + varnce_thl1_zm = pdf_params_zm%varnce_thl1 + varnce_thl2_zm = pdf_params_zm%varnce_thl2 + mixt_frac_zm = pdf_params_zm%mixt_frac + rc1_zm = pdf_params_zm%rc1 + rc2_zm = pdf_params_zm%rc2 + rsl1_zm = pdf_params_zm%rsl1 + rsl2_zm = pdf_params_zm%rsl2 + cloud_frac1_zm = pdf_params_zm%cloud_frac1 + cloud_frac2_zm = pdf_params_zm%cloud_frac2 + s1_zm = pdf_params_zm%s1 + s2_zm = pdf_params_zm%s2 + stdev_s1_zm = pdf_params_zm%stdev_s1 + stdev_s2_zm = pdf_params_zm%stdev_s2 + stdev_t1_zm = pdf_params_zm%stdev_t1 + stdev_t2_zm = pdf_params_zm%stdev_t2 + rrtthl_zm = pdf_params_zm%rrtthl + alpha_thl_zm = pdf_params_zm%alpha_thl + alpha_rt_zm = pdf_params_zm%alpha_rt + end if + + else + + ! Interpolate thermodynamic variables to the momentum grid. + ! Since top momentum level is higher than top thermo. level, + ! set variables at top momentum level to 0. + wprtp2_zm = zt2zm( wprtp2 ) + wprtp2_zm(gr%nz) = 0.0_core_rknd + wpthlp2_zm = zt2zm( wpthlp2 ) + wpthlp2_zm(gr%nz) = 0.0_core_rknd + wprtpthlp_zm = zt2zm( wprtpthlp ) + wprtpthlp_zm(gr%nz) = 0.0_core_rknd + cloud_frac_zm = zt2zm( cloud_frac ) + cloud_frac_zm(gr%nz) = 0.0_core_rknd + ice_supersat_frac_zm = zt2zm( ice_supersat_frac ) + ice_supersat_frac_zm(gr%nz) = 0.0_core_rknd + rcm_zm = zt2zm( rcm ) + rcm_zm(gr%nz) = 0.0_core_rknd + wp2thvp_zm = zt2zm( wp2thvp ) + wp2thvp_zm(gr%nz) = 0.0_core_rknd + + do i = 1, sclr_dim + wpsclrprtp_zm(:,i) = zt2zm( wpsclrprtp(:,i) ) + wpsclrprtp_zm(gr%nz,i) = 0.0_core_rknd + wpsclrp2_zm(:,i) = zt2zm( wpsclrp2(:,i) ) + wpsclrp2_zm(gr%nz,i) = 0.0_core_rknd + wpsclrpthlp_zm(:,i) = zt2zm( wpsclrpthlp(:,i) ) + wpsclrpthlp_zm(gr%nz,i) = 0.0_core_rknd + end do ! i = 1, sclr_dim + + if ( l_apply_rule_to_pdf_params ) then + w1_zm = zt2zm( pdf_params%w1 ) + w1_zm(gr%nz) = 0.0_core_rknd + w2_zm = zt2zm( pdf_params%w2 ) + w2_zm(gr%nz) = 0.0_core_rknd + varnce_w1_zm = zt2zm( pdf_params%varnce_w1 ) + varnce_w1_zm(gr%nz) = 0.0_core_rknd + varnce_w2_zm = zt2zm( pdf_params%varnce_w2 ) + varnce_w2_zm(gr%nz) = 0.0_core_rknd + rt1_zm = zt2zm( pdf_params%rt1 ) + rt1_zm(gr%nz) = 0.0_core_rknd + rt2_zm = zt2zm( pdf_params%rt2 ) + rt2_zm(gr%nz) = 0.0_core_rknd + varnce_rt1_zm = zt2zm( pdf_params%varnce_rt1 ) + varnce_rt1_zm(gr%nz) = 0.0_core_rknd + varnce_rt2_zm = zt2zm( pdf_params%varnce_rt2 ) + varnce_rt2_zm(gr%nz) = 0.0_core_rknd + crt1_zm = zt2zm( pdf_params%crt1 ) + crt1_zm(gr%nz) = 0.0_core_rknd + crt2_zm = zt2zm( pdf_params%crt2 ) + crt2_zm(gr%nz) = 0.0_core_rknd + cthl1_zm = zt2zm( pdf_params%cthl1 ) + cthl1_zm(gr%nz) = 0.0_core_rknd + cthl2_zm = zt2zm( pdf_params%cthl2 ) + cthl2_zm(gr%nz) = 0.0_core_rknd + thl1_zm = zt2zm( pdf_params%thl1 ) + thl1_zm(gr%nz) = 0.0_core_rknd + thl2_zm = zt2zm( pdf_params%thl2 ) + thl2_zm(gr%nz) = 0.0_core_rknd + varnce_thl1_zm = zt2zm( pdf_params%varnce_thl1 ) + varnce_thl1_zm(gr%nz) = 0.0_core_rknd + varnce_thl2_zm = zt2zm( pdf_params%varnce_thl2 ) + varnce_thl2_zm(gr%nz) = 0.0_core_rknd + mixt_frac_zm = zt2zm( pdf_params%mixt_frac ) + mixt_frac_zm(gr%nz) = 0.0_core_rknd + rc1_zm = zt2zm( pdf_params%rc1 ) + rc1_zm(gr%nz) = 0.0_core_rknd + rc2_zm = zt2zm( pdf_params%rc2 ) + rc2_zm(gr%nz) = 0.0_core_rknd + rsl1_zm = zt2zm( pdf_params%rsl1 ) + rsl1_zm(gr%nz) = 0.0_core_rknd + rsl2_zm = zt2zm( pdf_params%rsl2 ) + rsl2_zm(gr%nz) = 0.0_core_rknd + cloud_frac1_zm = zt2zm( pdf_params%cloud_frac1 ) + cloud_frac1_zm(gr%nz) = 0.0_core_rknd + cloud_frac2_zm = zt2zm( pdf_params%cloud_frac2 ) + cloud_frac2_zm(gr%nz) = 0.0_core_rknd + s1_zm = zt2zm( pdf_params%s1 ) + s1_zm(gr%nz) = 0.0_core_rknd + s2_zm = zt2zm( pdf_params%s2 ) + s2_zm(gr%nz) = 0.0_core_rknd + stdev_s1_zm = zt2zm( pdf_params%stdev_s1 ) + stdev_s1_zm(gr%nz) = 0.0_core_rknd + stdev_s2_zm = zt2zm( pdf_params%stdev_s2 ) + stdev_s2_zm(gr%nz) = 0.0_core_rknd + stdev_t1_zm = zt2zm( pdf_params%stdev_t1 ) + stdev_t1_zm(gr%nz) = 0.0_core_rknd + stdev_t2_zm = zt2zm( pdf_params%stdev_t2 ) + stdev_t2_zm(gr%nz) = 0.0_core_rknd + rrtthl_zm = zt2zm( pdf_params%rrtthl ) + rrtthl_zm(gr%nz) = 0.0_core_rknd + alpha_thl_zm = zt2zm( pdf_params%alpha_thl ) + alpha_thl_zm(gr%nz) = 0.0_core_rknd + alpha_rt_zm = zt2zm( pdf_params%alpha_rt ) + alpha_rt_zm(gr%nz) = 0.0_core_rknd + end if + end if ! l_call_pdf_closure_twice + + if ( l_stats ) then + ! Use the trapezoidal rule to recompute the variables on the zt level + if ( iwprtp2 > 0 ) then + wprtp2 = trapezoid_zt( wprtp2, wprtp2_zm ) + end if + if ( iwpthlp2 > 0 ) then + wpthlp2 = trapezoid_zt( wpthlp2, wpthlp2_zm ) + end if + if ( iwprtpthlp > 0 ) then + wprtpthlp = trapezoid_zt( wprtpthlp, wprtpthlp_zm ) + end if + + do i = 1, sclr_dim + if ( iwpsclrprtp(i) > 0 ) then + wpsclrprtp(:,i) = trapezoid_zt( wpsclrprtp(:,i), wpsclrprtp_zm(:,i) ) + end if + if ( iwpsclrpthlp(i) > 0 ) then + wpsclrpthlp(:,i) = trapezoid_zt( wpsclrpthlp(:,i), wpsclrpthlp_zm(:,i) ) + end if + if ( iwpsclrp2(i) > 0 ) then + wpsclrp2(:,i) = trapezoid_zt( wpsclrp2(:,i), wpsclrp2_zm(:,i) ) + end if + end do ! i = 1, sclr_dim + end if ! l_stats + + cloud_frac = trapezoid_zt( cloud_frac, cloud_frac_zm ) + ice_supersat_frac = trapezoid_zt( ice_supersat_frac, ice_supersat_frac_zm ) + rcm = trapezoid_zt( rcm, rcm_zm ) + + wp2thvp = trapezoid_zt( wp2thvp, wp2thvp_zm ) + + if ( l_apply_rule_to_pdf_params ) then + pdf_params%w1 = trapezoid_zt( w1_zt, w1_zm ) + pdf_params%w2 = trapezoid_zt( w2_zt, w2_zm ) + pdf_params%varnce_w1 = trapezoid_zt( varnce_w1_zt, varnce_w1_zm ) + pdf_params%varnce_w2 = trapezoid_zt( varnce_w2_zt, varnce_w2_zm ) + pdf_params%rt1 = trapezoid_zt( rt1_zt, rt1_zm ) + pdf_params%rt2 = trapezoid_zt( rt2_zt, rt2_zm ) + pdf_params%varnce_rt1 = trapezoid_zt( varnce_rt1_zt, varnce_rt1_zm ) + pdf_params%varnce_rt2 = trapezoid_zt( varnce_rt2_zt, varnce_rt2_zm ) + pdf_params%crt1 = trapezoid_zt( crt1_zt, crt1_zm ) + pdf_params%crt2 = trapezoid_zt( crt2_zt, crt2_zm ) + pdf_params%cthl1 = trapezoid_zt( cthl1_zt, cthl1_zm ) + pdf_params%cthl2 = trapezoid_zt( cthl2_zt, cthl2_zm ) + pdf_params%thl1 = trapezoid_zt( thl1_zt, thl1_zm ) + pdf_params%thl2 = trapezoid_zt( thl2_zt, thl2_zm ) + pdf_params%varnce_thl1 = trapezoid_zt( varnce_thl1_zt, varnce_thl1_zm ) + pdf_params%varnce_thl2 = trapezoid_zt( varnce_thl2_zt, varnce_thl2_zm ) + pdf_params%mixt_frac = trapezoid_zt( mixt_frac_zt, mixt_frac_zm ) + pdf_params%rc1 = trapezoid_zt( rc1_zt, rc1_zm ) + pdf_params%rc2 = trapezoid_zt( rc2_zt, rc2_zm ) + pdf_params%rsl1 = trapezoid_zt( rsl1_zt, rsl1_zm ) + pdf_params%rsl2 = trapezoid_zt( rsl2_zt, rsl2_zm ) + pdf_params%cloud_frac1 = trapezoid_zt( cloud_frac1_zt, cloud_frac1_zm ) + pdf_params%cloud_frac2 = trapezoid_zt( cloud_frac2_zt, cloud_frac2_zm ) + pdf_params%s1 = trapezoid_zt( s1_zt, s1_zm ) + pdf_params%s2 = trapezoid_zt( s2_zt, s2_zm ) + pdf_params%rrtthl = trapezoid_zt( rrtthl_zt, rrtthl_zm ) + pdf_params%alpha_thl = trapezoid_zt( alpha_thl_zt, alpha_thl_zm ) + pdf_params%alpha_rt = trapezoid_zt( alpha_rt_zt, alpha_rt_zm ) + pdf_params%stdev_s1 = trapezoid_zt( stdev_s1_zt, stdev_s1_zm ) + pdf_params%stdev_s2 = trapezoid_zt( stdev_s2_zt, stdev_s2_zm ) + pdf_params%stdev_t1 = trapezoid_zt( stdev_t1_zt, stdev_t1_zm ) + pdf_params%stdev_t2 = trapezoid_zt( stdev_t2_zt, stdev_t2_zm ) + end if + + ! End of trapezoidal rule + + return + end subroutine trapezoidal_rule_zt + + !----------------------------------------------------------------------- + subroutine trapezoidal_rule_zm & + ( wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in) + wpthvp, thlpthvp, rtpthvp ) ! intent(inout) + ! + ! Description: + ! This subroutine recomputes three variables on the + ! momentum grid from pdf_closure -- wpthvp, thlpthvp, and + ! rtpthvp -- by calling the function trapezoid_zm. Only these three + ! variables are used in this subroutine because they are the only + ! pdf_closure momentum variables used elsewhere in CLUBB. + ! + ! The _zt variables are output from the first call to pdf_closure. + ! The _zm variables are output from the second call to pdf_closure + ! on the momentum levels. + ! This is done before the call to this subroutine. + ! + ! ldgrant Feb. 2010 + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! variable(s) + + implicit none + + ! Input variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s] + thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2] + rtpthvp_zt ! r_t' th_v' (on thermo. grid) [(kg K)/kg] + + ! Input/Output variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + wpthvp, & ! Buoyancy flux [(K m)/s] + thlpthvp, & ! th_l' th_v' [K^2] + rtpthvp ! r_t' th_v' [(kg K)/kg] + + !----------------------- Begin Code ----------------------------- + + ! Use the trapezoidal rule to recompute the variables on the zm level + wpthvp = trapezoid_zm( wpthvp, wpthvp_zt ) + thlpthvp = trapezoid_zm( thlpthvp, thlpthvp_zt ) + rtpthvp = trapezoid_zm( rtpthvp, rtpthvp_zt ) + + return + end subroutine trapezoidal_rule_zm + + !----------------------------------------------------------------------- + pure function trapezoid_zt( variable_zt, variable_zm ) + ! + ! Description: + ! Function which uses the trapezoidal rule from calculus + ! to recompute the values for the variables on the thermo. grid which + ! are output from the first call to pdf_closure in module clubb_core. + ! + ! ldgrant June 2009 + !-------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + variable_zt, & ! Variable on the zt grid + variable_zm ! Variable on the zm grid + + ! Result + real( kind = core_rknd ), dimension(gr%nz) :: trapezoid_zt + + ! Local Variable + integer :: k ! Loop index + + !------------ Begin Code -------------- + + ! Boundary condition: trapezoidal rule not valid at zt level 1 + trapezoid_zt(1) = variable_zt(1) + + do k = 2, gr%nz + ! Trapezoidal rule from calculus + trapezoid_zt(k) = 0.5_core_rknd * ( variable_zm(k) + variable_zt(k) ) & + * ( gr%zm(k) - gr%zt(k) ) * gr%invrs_dzt(k) & + + 0.5_core_rknd * ( variable_zt(k) + variable_zm(k-1) ) & + * ( gr%zt(k) - gr%zm(k-1) ) * gr%invrs_dzt(k) + end do ! k = 2, gr%nz + + return + end function trapezoid_zt + + !----------------------------------------------------------------------- + pure function trapezoid_zm( variable_zm, variable_zt ) + ! + ! Description: + ! Function which uses the trapezoidal rule from calculus + ! to recompute the values for the important variables on the momentum + ! grid which are output from pdf_closure in module clubb_core. + ! These momentum variables only include wpthvp, thlpthvp, and rtpthvp. + ! + ! ldgrant Feb. 2010 + !-------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + variable_zm, & ! Variable on the zm grid + variable_zt ! Variable on the zt grid + + ! Result + real( kind = core_rknd ), dimension(gr%nz) :: trapezoid_zm + + ! Local Variable + integer :: k ! Loop index + + !------------ Begin Code -------------- + + ! Boundary conditions: trapezoidal rule not valid at top zm level, nzmax. + ! Trapezoidal rule also not used at zm level 1. + trapezoid_zm(1) = variable_zm(1) + trapezoid_zm(gr%nz) = variable_zm(gr%nz) + + do k = 2, gr%nz-1 + ! Trapezoidal rule from calculus + trapezoid_zm(k) = 0.5_core_rknd * ( variable_zt(k+1) + variable_zm(k) ) & + * ( gr%zt(k+1) - gr%zm(k) ) * gr%invrs_dzm(k) & + + 0.5_core_rknd * ( variable_zm(k) + variable_zt(k) ) & + * ( gr%zm(k) - gr%zt(k) ) * gr%invrs_dzm(k) + end do ! k = 2, gr%nz-1 + + return + end function trapezoid_zm + + !----------------------------------------------------------------------- + subroutine compute_cloud_cover & + ( pdf_params, cloud_frac, rcm, & ! intent(in) + cloud_cover, rcm_in_layer ) ! intent(out) + ! + ! Description: + ! Subroutine to compute cloud cover (the amount of sky + ! covered by cloud) and rcm in layer (liquid water mixing ratio in + ! the portion of the grid box filled by cloud). + ! + ! References: + ! Definition of 's' comes from: + ! ``The Gaussian Cloud Model Relations'' G. L. Mellor (1977) + ! JAS, Vol. 34, pp. 356--358. + ! + ! Notes: + ! Added July 2009 + !--------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + rc_tol, & ! Variable(s) + fstderr + + use crmx_grid_class, only: gr ! Variable + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Derived data type + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Procedure + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External functions + intrinsic :: abs, min, max + + ! Input variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + cloud_frac, & ! Cloud fraction [-] + rcm ! Liquid water mixing ratio [kg/kg] + + type (pdf_parameter), dimension(gr%nz), intent(in) :: & + pdf_params ! PDF Parameters [units vary] + + ! Output variables + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + cloud_cover, & ! Cloud cover [-] + rcm_in_layer ! Liquid water mixing ratio in cloud layer [kg/kg] + + ! Local variables + real( kind = core_rknd ), dimension(gr%nz) :: & + s_mean, & ! Mean extended cloud water mixing ratio of the + ! two Gaussian distributions + vert_cloud_frac_upper, & ! Fraction of cloud in top half of grid box + vert_cloud_frac_lower, & ! Fraction of cloud in bottom half of grid box + vert_cloud_frac ! Fraction of cloud filling the grid box in the vertical + + integer :: k + + ! ------------ Begin code --------------- + + do k = 1, gr%nz + + s_mean(k) = pdf_params(k)%mixt_frac * pdf_params(k)%s1 + & + (1.0_core_rknd-pdf_params(k)%mixt_frac) * pdf_params(k)%s2 + + end do + + do k = 2, gr%nz-1, 1 + + if ( rcm(k) < rc_tol ) then ! No cloud at this level + + cloud_cover(k) = cloud_frac(k) + rcm_in_layer(k) = rcm(k) + + else if ( ( rcm(k+1) >= rc_tol ) .and. ( rcm(k-1) >= rc_tol ) ) then + ! There is cloud above and below, + ! so assume cloud fills grid box from top to bottom + + cloud_cover(k) = cloud_frac(k) + rcm_in_layer(k) = rcm(k) + + else if ( ( rcm(k+1) < rc_tol ) .or. ( rcm(k-1) < rc_tol) ) then + ! Cloud may fail to reach gridbox top or base or both + + ! First let the cloud fill the entire grid box, then overwrite + ! vert_cloud_frac_upper(k) and/or vert_cloud_frac_lower(k) + ! for a cloud top, cloud base, or one-point cloud. + vert_cloud_frac_upper(k) = 0.5_core_rknd + vert_cloud_frac_lower(k) = 0.5_core_rknd + + if ( rcm(k+1) < rc_tol ) then ! Cloud top + + vert_cloud_frac_upper(k) = & + ( ( 0.5_core_rknd / gr%invrs_dzm(k) ) / ( gr%zm(k) - gr%zt(k) ) ) & + * ( rcm(k) / ( rcm(k) + abs( s_mean(k+1) ) ) ) + + vert_cloud_frac_upper(k) = min( 0.5_core_rknd, vert_cloud_frac_upper(k) ) + + ! Make the transition in cloudiness more gradual than using + ! the above min statement alone. + vert_cloud_frac_upper(k) = vert_cloud_frac_upper(k) + & + ( ( rcm(k+1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_upper(k) ) ) + + else + + vert_cloud_frac_upper(k) = 0.5_core_rknd + + end if + + if ( rcm(k-1) < rc_tol ) then ! Cloud base + + vert_cloud_frac_lower(k) = & + ( ( 0.5_core_rknd / gr%invrs_dzm(k-1) ) / ( gr%zt(k) - gr%zm(k-1) ) ) & + * ( rcm(k) / ( rcm(k) + abs( s_mean(k-1) ) ) ) + + vert_cloud_frac_lower(k) = min( 0.5_core_rknd, vert_cloud_frac_lower(k) ) + + ! Make the transition in cloudiness more gradual than using + ! the above min statement alone. + vert_cloud_frac_lower(k) = vert_cloud_frac_lower(k) + & + ( ( rcm(k-1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_lower(k) ) ) + + else + + vert_cloud_frac_lower(k) = 0.5_core_rknd + + end if + + vert_cloud_frac(k) = & + vert_cloud_frac_upper(k) + vert_cloud_frac_lower(k) + + vert_cloud_frac(k) = & + max( cloud_frac(k), min( 1.0_core_rknd, vert_cloud_frac(k) ) ) + + cloud_cover(k) = cloud_frac(k) / vert_cloud_frac(k) + rcm_in_layer(k) = rcm(k) / vert_cloud_frac(k) + + else + + if ( clubb_at_least_debug_level( 1 ) ) then + + write(fstderr,*) & + "Error: Should not arrive here in computation of cloud_cover" + + write(fstderr,*) "At grid level k = ", k + write(fstderr,*) "pdf_params(k)%mixt_frac = ", pdf_params(k)%mixt_frac + write(fstderr,*) "pdf_params(k)%s1 = ", pdf_params(k)%s1 + write(fstderr,*) "pdf_params(k)%s2 = ", pdf_params(k)%s2 + write(fstderr,*) "cloud_frac(k) = ", cloud_frac(k) + write(fstderr,*) "rcm(k) = ", rcm(k) + write(fstderr,*) "rcm(k+1) = ", rcm(k+1) + write(fstderr,*) "rcm(k-1) = ", rcm(k-1) + + end if + + return + + end if ! rcm(k) < rc_tol + + end do ! k = 2, gr%nz-1, 1 + + cloud_cover(1) = cloud_frac(1) + cloud_cover(gr%nz) = cloud_frac(gr%nz) + + rcm_in_layer(1) = rcm(1) + rcm_in_layer(gr%nz) = rcm(gr%nz) + + return + end subroutine compute_cloud_cover + !----------------------------------------------------------------------- + subroutine clip_rcm & + ( rtm, message, & ! intent(in) + rcm ) ! intent(inout) + ! + ! Description: + ! Subroutine that reduces cloud water (rcm) whenever + ! it exceeds total water (rtm = vapor + liquid). + ! This avoids negative values of rvm = water vapor mixing ratio. + ! However, it will not ensure that rcm <= rtm if rtm <= 0. + ! + ! References: + ! None + !--------------------------------------------------------------------- + + + use crmx_grid_class, only: gr ! Variable + + use crmx_error_code, only : & + clubb_at_least_debug_level ! Procedure(s) + + use crmx_constants_clubb, only: & + fstderr, & ! Variable(s) + zero_threshold + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External functions + intrinsic :: max, epsilon + + ! Input variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + rtm ! Total water mixing ratio [kg/kg] + + character(len= * ), intent(in) :: message + + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + rcm ! Cloud water mixing ratio [kg/kg] + + integer :: k + + ! ------------ Begin code --------------- + + ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. + ! This code won't work unless rtm >= 0 !!! + ! We do not clip rcm_in_layer because rcm_in_layer only influences + ! radiation, and we do not want to bother recomputing it. 6 Aug 2009 + do k = 1, gr%nz + if ( rtm(k) < rcm(k) ) then + + if ( clubb_at_least_debug_level(1) ) then + write(fstderr,*) message, ' at k=', k, 'rcm(k) = ', rcm(k), & + 'rtm(k) = ', rtm(k), '.', ' Clipping rcm.' + + end if ! clubb_at_least_debug_level(1) + + rcm(k) = max( zero_threshold, rtm(k) - epsilon( rtm(k) ) ) + + end if ! rtm(k) < rcm(k) + + end do ! k=1..gr%nz + + return + end subroutine clip_rcm + + !----------------------------------------------------------------------------- + subroutine set_Lscale_max( l_implemented, host_dx, host_dy, & + Lscale_max ) + + ! Description: + ! This subroutine sets the value of Lscale_max, which is the maximum + ! allowable value of Lscale. For standard CLUBB, it is set to a very large + ! value so that Lscale will not be limited. However, when CLUBB is running + ! as part of a host model, the value of Lscale_max is dependent on the size + ! of the host model's horizontal grid spacing. The smaller the host model's + ! horizontal grid spacing, the smaller the value of Lscale_max. When Lscale + ! is limited to a small value, the value of time-scale Tau is reduced, which + ! in turn produces greater damping on CLUBB's turbulent parameters. This + ! is the desired effect on turbulent parameters for a host model with small + ! horizontal grid spacing, for small areas usually contain much less + ! variation in meteorological quantities than large areas. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + logical, intent(in) :: & + l_implemented ! Flag to see if CLUBB is running on it's own, + ! or if it's implemented as part of a host model. + + real( kind = core_rknd ), intent(in) :: & + host_dx, & ! Host model's east-west horizontal grid spacing [m] + host_dy ! Host model's north-south horizontal grid spacing [m] + + ! Output Variable + real( kind = core_rknd ), intent(out) :: & + Lscale_max ! Maximum allowable value for Lscale [m] + + ! ---- Begin Code ---- + + ! Determine the maximum allowable value for Lscale (in meters). + if ( l_implemented ) then + Lscale_max = 0.25_core_rknd * min( host_dx, host_dy ) + else + Lscale_max = 1.0e5_core_rknd + end if + + return + end subroutine set_Lscale_max + +!=============================================================================== + + end module crmx_clubb_core +! vim: set expandtab tabstop=2 shiftwidth=2 textwidth=100 autoindent: diff --git a/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 b/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 new file mode 100644 index 0000000000..b594d17061 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 @@ -0,0 +1,24 @@ +!------------------------------------------------------------------------------- +! $Id: clubb_precision.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_clubb_precision + + implicit none + + public :: stat_nknd, stat_rknd, time_precision, dp, sp, core_rknd + + private ! Default scope + + ! The precisions below are arbitrary, and could be adjusted as + ! needed for long simulations or time averaging. Note that on + ! most machines 12 digits of precision will use a data type + ! which is 8 bytes long. + integer, parameter :: & + stat_nknd = selected_int_kind( 8 ), & + stat_rknd = selected_real_kind( p=12 ), & + time_precision = selected_real_kind( p=12 ), & + dp = selected_real_kind( p=12 ), & ! double precision + sp = selected_real_kind( p=5 ), & ! single precision + core_rknd = CLUBB_REAL_TYPE ! Value from the preprocessor directive + +end module crmx_clubb_precision +!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 b/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 new file mode 100644 index 0000000000..a6108f6419 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 @@ -0,0 +1,375 @@ +!----------------------------------------------------------------------------- +! $Id: constants_clubb.F90 6132 2013-03-28 13:09:40Z vlarson@uwm.edu $ +!============================================================================= +module crmx_constants_clubb + + ! Description: + ! Contains frequently occuring model constants + + ! References: + ! None + !--------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + dp, & + core_rknd + +!#ifdef CLUBB_CAM /* Set constants as they're set in CAM */ +#if defined(CLUBB_CAM) || defined(CRM) /* set constants as they' are set in CAM for CLUBB_CAM or MMF */ + use shr_const_mod, only: shr_const_rdair, shr_const_cpdair, shr_const_latvap, & + shr_const_latice, shr_const_latsub, shr_const_rgas, & + shr_const_mwwv, shr_const_stebol, shr_const_tkfrz, & + shr_const_mwdair, shr_const_g, shr_const_karman, & + shr_const_rhofw +#elif GFDL + ! use GFDL constants, and then rename them to avoid confusion in case + ! that the constants share the same names between GFDL and CLUBB + use constants_mod, only: pi_gfdl => PI, & + radians_per_deg_dp_gfdl => DEG_TO_RAD, & + Cp_gfdl => CP_AIR, & + Lv_gfdl => HLV, & + Ls_gfdl => HLS, & + Lf_gfdl => HLF, & + Rd_gfdl => RDGAS, & + Rv_gfdl => RVGAS, & + stefan_boltzmann_gfdl => STEFAN, & + T_freeze_K_gfdl => TFREEZE, & + grav_gfdl => GRAV, & + vonk_gfdl => VONKARM, & + rho_lw_gfdl => DENS_H2O +#endif + + implicit none + + private ! Default scope + + !----------------------------------------------------------------------------- + ! Numerical/Arbitrary Constants + !----------------------------------------------------------------------------- + + ! Fortran file unit I/O constants + integer, parameter, public :: & + fstderr = 0, fstdin = 5, fstdout = 6 + + ! Maximum variable name length in CLUBB GrADS or netCDF output + integer, parameter, public :: & + var_length = 30 + ! The parameter parab_cyl_max_input is the largest magnitude that the input to + ! the parabolic cylinder function is allowed to have. When the value of the + ! input to the parabolic cylinder function is too large in magnitude + ! (depending on the order of the parabolic cylinder function), overflow + ! occurs, and the output of the parabolic cylinder function is +/-Inf. The + ! parameter parab_cyl_max_input places a limit on the absolute value of the + ! input to the parabolic cylinder function. When the value of the potential + ! input exceeds this parameter (usually due to a very large ratio of ith PDF + ! component mean of x to ith PDF component standard deviation of x), the + ! variable x is considered to be constant and a different version of the + ! equation called. + ! + ! The largest allowable magnitude of the input to the parabolic cylinder + ! function (before overflow occurs) is dependent on the order of parabolic + ! cylinder function. However, after a lot of testing, it was determined that + ! an absolute value of 49 works well for an order of 12 or less. + real( kind = core_rknd ), parameter, public :: & + parab_cyl_max_input = 49.0_core_rknd ! Largest allowable input to parab. cyl. fnct. + + ! "Over-implicit" weighted time step. + ! + ! The weight of the implicit portion of a term is controlled by the factor + ! gamma_over_implicit_ts (abbreviated "gamma" in the expression below). A + ! factor is added to the right-hand side of the equation in order to balance a + ! weight that is not equal to 1, such that: + ! + ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; + ! + ! where X is the variable that is being solved for in a predictive equation + ! (such as w'^3, w'th_l', r_t'^2, etc), y(t) is the linearized portion of the + ! term that gets treated implicitly, and RHS is the portion of the term that + ! is always treated explicitly. A weight of greater than 1 can be applied to + ! make the term more numerically stable. + ! + ! gamma_over_implicit_ts Effect on term + ! + ! 0.0 Term becomes completely explicit + ! + ! 1.0 Standard implicit portion of the term; + ! as it was without the weighting factor. + ! + ! 1.5 Strongly weighted implicit portion of the term; + ! increased numerical stability. + ! + ! 2.0 More strongly weighted implicit portion of the + ! term; increased numerical stability. + ! + ! Note: The "over-implicit" weighted time step is only applied to terms that + ! tend to significantly decrease the amount of numerical stability for + ! variable X. + ! The "over-implicit" weighted time step is applied to the turbulent + ! advection term for the following variables: + ! w'^3 (also applied to the turbulent production term), found in + ! module advance_wp2_wp3_module; + ! w'r_t', w'th_l', and w'sclr', found in + ! module advance_xm_wpxp_module; and + ! r_t'^2, th_l'^2, r_t'th_l', u'^2, v'^2, sclr'^2, sclr'r_t', + ! and sclr'th_l', found in module advance_xp2_xpyp_module. + real( kind = core_rknd ), parameter, public :: & + gamma_over_implicit_ts = 1.50_core_rknd + + !----------------------------------------------------------------------------- + ! Mathematical Constants + !----------------------------------------------------------------------------- + real( kind = dp ), parameter, public :: & + pi_dp = 3.14159265358979323846_dp + +#ifdef GFDL + real( kind = core_rknd ), parameter, public :: & + pi = pi_gfdl ! The ratio of radii to their circumference + + real( kind = dp ), parameter, public :: & + radians_per_deg_dp = radians_per_deg_dp_gfdl +#else + + real( kind = core_rknd ), parameter, public :: & + pi = 3.141592654_core_rknd ! The ratio of radii to their circumference + + real( kind = dp ), parameter, public :: & + radians_per_deg_dp = pi_dp / 180._dp +#endif + + real( kind = core_rknd ), parameter, public :: & + sqrt_2pi = 2.5066282746310005024_core_rknd, & ! sqrt(2*pi) + sqrt_2 = 1.4142135623730950488_core_rknd ! sqrt(2) + + real( kind = dp ), parameter, public:: & + two_dp = 2.0_dp, & ! 2 + one_dp = 1.0_dp, & ! 1 + one_half_dp = 0.5_dp, & ! 1/2 + one_fourth_dp = 0.25_dp, & ! 1/4 + zero_dp = 0.0_dp ! 0 + + real( kind = core_rknd ), parameter, public :: & + one_hundred = 100.0_core_rknd, & ! 100 + fifty = 50.0_core_rknd, & ! 50 + twenty = 20.0_core_rknd, & ! 20 + ten = 10.0_core_rknd, & ! 10 + five = 5.0_core_rknd, & ! 5 + four = 4.0_core_rknd, & ! 4 + three = 3.0_core_rknd, & ! 3 + two = 2.0_core_rknd, & ! 2 + three_halves = 3.0_core_rknd/2.0_core_rknd, & ! 3/2 + four_thirds = 4.0_core_rknd/3.0_core_rknd, & ! 4/3 + one = 1.0_core_rknd, & ! 1 + three_fourths = 0.75_core_rknd, & ! 3/4 + two_thirds = 2.0_core_rknd/3.0_core_rknd, & ! 2/3 + one_half = 0.5_core_rknd, & ! 1/2 + one_third = 1.0_core_rknd/3.0_core_rknd, & ! 1/3 + one_fourth = 0.25_core_rknd, & ! 1/4 + zero = 0.0_core_rknd ! 0 + + !----------------------------------------------------------------------------- + ! Physical constants + !----------------------------------------------------------------------------- + +!#ifdef CLUBB_CAM +#if defined(CLUBB_CAM) || defined(CRM) /* set constants as they' are set in CAM for CLUBB_CAM or MMF */ + + real( kind = core_rknd ), parameter, public :: & + Cp = shr_const_cpdair, & ! Dry air specific heat at constant p [J/kg/K] + Lv = shr_const_latvap, & ! Latent heat of vaporization [J/kg] + Lf = shr_const_latice, & ! Latent heat of fusion [J/kg] + Ls = shr_const_latsub, & ! Latent heat of sublimation [J/kg] + Rd = shr_const_rdair, & ! Dry air gas constant [J/kg/K] + Rv = shr_const_rgas/shr_const_mwwv ! Water vapor gas constant [J/kg/K] + + real( kind = core_rknd ), parameter, public :: & + stefan_boltzmann = shr_const_stebol ! Stefan-Boltzmann constant [W/(m^2 K^4)] + + real( kind = core_rknd ), parameter, public :: & + T_freeze_K = shr_const_tkfrz ! Freezing point of water [K] + + ! Useful combinations of Rd and Rv + real( kind = core_rknd ), parameter, public :: & + ep = shr_const_mwwv/shr_const_mwdair, & ! ep = 0.622 [-] + ep1 = (1.0-ep)/ep,& ! ep1 = 0.61 [-] + ep2 = 1.0/ep ! ep2 = 1.61 [-] + + real( kind = core_rknd ), parameter, public :: & + kappa = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair ! kappa [-] + + real( kind = core_rknd ), parameter, public :: & + grav = shr_const_g, & ! Gravitational acceleration [m/s^2] + p0 = 1.0e5 ! Reference pressure [Pa] + + ! Von Karman's constant + ! Constant of the logarithmic wind profile in the surface layer + real( kind = core_rknd ), parameter, public :: & + vonk = shr_const_karman, & ! Accepted value is 0.40 (+/-) 0.01 [-] + rho_lw = shr_const_rhofw ! Density of liquid water [kg/m^3] + + +#elif GFDL + real( kind = core_rknd ), parameter, public :: & + Cp = Cp_gfdl, & ! Dry air specific heat at constant p [J/kg/K] + Lv = Lv_gfdl, & ! Latent heat of vaporization [J/kg] + Ls = Ls_gfdl, & ! Latent heat of sublimation [J/kg] + Lf = Lf_gfdl, & ! Latent heat of fusion [J/kg] + Rd = Rd_gfdl, & ! Dry air gas constant [J/kg/K] + Rv = Rv_gfdl ! Water vapor gas constant [J/kg/K] + + + real( kind = core_rknd ), parameter, public :: & + stefan_boltzmann = stefan_boltzmann_gfdl ! Stefan-Boltzmann constant [W/(m^2 K^4)] + + real( kind = core_rknd ), parameter, public :: & + T_freeze_K = T_freeze_K_gfdl ! Freezing point of water [K] + + ! Useful combinations of Rd and Rv + real( kind = core_rknd ), parameter, public :: & + ep = Rd / Rv, & ! ep = 0.622 [-] + ep1 = (1.0-ep)/ep,& ! ep1 = 0.61 [-] + ep2 = 1.0/ep ! ep2 = 1.61 [-] + + real( kind = core_rknd ), parameter, public :: & + kappa = Rd / Cp ! kappa [-] + + ! Changed g to grav to make it easier to find in the code 5/25/05 + ! real, parameter :: grav = 9.80665 ! Gravitational acceleration [m/s^2] + real( kind = core_rknd ), parameter, public :: & + grav = grav_gfdl, & ! Gravitational acceleration [m/s^2] + p0 = 1.0e5 ! Reference pressure [Pa] + + ! Von Karman's constant + ! Constant of the logarithmic wind profile in the surface layer + real( kind = core_rknd ), parameter, public :: & + vonk = vonk_gfdl, & ! Accepted value is 0.40 (+/-) 0.01 [-] + rho_lw = rho_lw_gfdl ! Density of liquid water [kg/m^3] + + +#else + + real( kind = core_rknd ), parameter, public :: & + Cp = 1004.67_core_rknd, & ! Dry air specific heat at constant p [J/kg/K] + Lv = 2.5e6_core_rknd, & ! Latent heat of vaporization [J/kg] + Ls = 2.834e6_core_rknd, & ! Latent heat of sublimation [J/kg] + Lf = 3.33e5_core_rknd, & ! Latent heat of fusion [J/kg] + Rd = 287.04_core_rknd, & ! Dry air gas constant [J/kg/K] + Rv = 461.5_core_rknd ! Water vapor gas constant [J/kg/K] + + + real( kind = core_rknd ), parameter, public :: & + stefan_boltzmann = 5.6704e-8_core_rknd ! Stefan-Boltzmann constant [W/(m^2 K^4)] + + real( kind = core_rknd ), parameter, public :: & + T_freeze_K = 273.15_core_rknd ! Freezing point of water [K] + + ! Useful combinations of Rd and Rv + real( kind = core_rknd ), parameter, public :: & + ep = Rd / Rv, & ! ep = 0.622_core_rknd [-] + ep1 = (1.0_core_rknd-ep)/ep,& ! ep1 = 0.61_core_rknd [-] + ep2 = 1.0_core_rknd/ep ! ep2 = 1.61_core_rknd [-] + + real( kind = core_rknd ), parameter, public :: & + kappa = Rd / Cp ! kappa [-] + + ! Changed g to grav to make it easier to find in the code 5/25/05 + ! real, parameter, public :: grav = 9.80665_core_rknd ! Gravitational acceleration [m/s^2] + real( kind = core_rknd ), parameter, public :: & + grav = 9.81_core_rknd, & ! Gravitational acceleration [m/s^2] + p0 = 1.0e5_core_rknd ! Reference pressure [Pa] + + ! Von Karman's constant + ! Constant of the logarithmic wind profile in the surface layer + real( kind = core_rknd ), parameter, public :: & + vonk = 0.4_core_rknd, & ! Accepted value is 0.40 (+/-) 0.01 [-] + rho_lw = 1000.0_core_rknd ! Density of liquid water [kg/m^3] + +#endif + + ! Tolerances below which we consider moments to be zero + real( kind = core_rknd ), parameter, public :: & + w_tol = 2.e-2_core_rknd, & ! [m/s] + thl_tol = 1.e-2_core_rknd, & ! [K] + rt_tol = 1.e-8_core_rknd, & ! [kg/kg] + s_mellor_tol = 1.e-8_core_rknd, & ! [kg/kg] + t_mellor_tol = s_mellor_tol ! [kg/kg] + + ! Tolerances for use by the monatonic flux limiter. + ! rt_tol_mfl is larger than rt_tol. rt_tol is extremely small + ! (1e-8) to prevent spurious cloud formation aloft in LBA. + ! rt_tol_mfl is larger (1e-4) to prevent the mfl from + ! depositing moisture at the top of the domain. + real( kind = core_rknd ), parameter, public :: & + thl_tol_mfl = 1.e-2_core_rknd, & ! [K] + rt_tol_mfl = 1.e-4_core_rknd ! [kg/kg] + + ! The tolerance for w'^2 is the square of the tolerance for w. + real( kind = core_rknd ), parameter, public :: & + w_tol_sqd = w_tol**2 ! [m^2/s^2] + + real( kind = core_rknd ), parameter, public :: & + Skw_max_mag = 4.5_core_rknd ! Max magnitude of skewness [-] + + real( kind = core_rknd ), parameter, public :: & + Skw_max_mag_sqd = Skw_max_mag**2 ! Max mag. of Skw squared [-] + + ! Set tolerances for Khairoutdinov and Kogan rain microphysics to insure + ! against numerical errors. The tolerance values for Nc, rr, and Nr insure + ! against underflow errors in computing the PDF for l_kk_rain. Basically, + ! they insure that those values squared won't be less then 10^-38, which is + ! the lowest number that can be numerically represented. However, the + ! tolerance value for rc doubles as the lowest mixing ratio there can be to + ! still officially have a cloud at that level. This is figured to be about + ! 1.0_core_rknd x 10^-7 kg/kg. Brian; February 10, 2007. + real( kind = core_rknd ), parameter, public :: & + rc_tol = 1.0E-6_core_rknd, & ! [kg/kg] + Nc_tol = 1.0E-10_core_rknd, & ! [#/kg] + rr_tol = 1.0E-10_core_rknd, & ! [kg/kg] + Nr_tol = 1.0E-10_core_rknd ! [#/kg] + + ! Minimum value for em (turbulence kinetic energy) + ! If anisotropic TKE is enabled, em = (1/2) * ( up2 + vp2 + wp2 ); + ! otherwise, em = (3/2) * wp2. Since up2, vp2, and wp2 all have + ! the same minimum threshold value of w_tol_sqd, em cannot be less + ! than (3/2) * w_tol_sqd. Thus, em_min = (3/2) * w_tol_sqd. + real( kind = core_rknd ), parameter, public :: em_min = 1.5_core_rknd * w_tol_sqd ! [m^2/s^2] + + real( kind = core_rknd ), parameter, public :: & + eps = 1.0e-10_core_rknd ! Small value to prevent a divide by zero + + real( kind = core_rknd ), parameter, public :: & + zero_threshold = 0.0_core_rknd ! Defining a threshold on a physical quantity to be 0. + + ! The maximum absolute value (or magnitude) that a correlation is allowed to + ! have. Statistically, a correlation is not allowed to be less than -1 or + ! greater than 1, so the maximum magnitude would be 1. + real( kind = core_rknd ), parameter, public :: & + max_mag_correlation = 0.99_core_rknd + + real( kind = core_rknd ), parameter, public :: & + cloud_frac_min = 0.005_core_rknd ! Threshold for cloud fractions + + !----------------------------------------------------------------------------- + ! Useful conversion factors. + !----------------------------------------------------------------------------- + real(kind=time_precision), parameter, public :: & + sec_per_day = 86400.0_time_precision, & ! Seconds in a day. + sec_per_hr = 3600.0_time_precision, & ! Seconds in an hour. + sec_per_min = 60.0_time_precision, & ! Seconds in a minute. + min_per_hr = 60.0_time_precision ! Minutes in an hour. + + real( kind = core_rknd ), parameter, public :: & + g_per_kg = 1000.0_core_rknd ! Grams in a kilogram. + + real( kind = core_rknd ), parameter, public :: & + pascal_per_mb = 100.0_core_rknd ! Pascals per Millibar + + real( kind = core_rknd ), parameter, public :: & + cm3_per_m3 = 1.e6_core_rknd, & ! Cubic centimeters per cubic meter + micron_per_m = 1.e6_core_rknd, & ! Micrometers per meter + cm_per_m = 100._core_rknd, & ! Centimeters per meter + mm_per_m = 1000._core_rknd ! Millimeters per meter + +!============================================================================= + +end module crmx_constants_clubb diff --git a/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 new file mode 100644 index 0000000000..1a9eaafd0b --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 @@ -0,0 +1,181 @@ +!$Id: corr_matrix_module.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ +!--------------------------------------------------------------------------------------------------- +module crmx_corr_matrix_module + + implicit none + + ! Latin hypercube indices / Correlation array indices + integer, public :: & + iiLH_s_mellor = -1, & + iiLH_t_mellor = -1, & + iiLH_w = -1 +!$omp threadprivate(iiLH_s_mellor, iiLH_t_mellor, iiLH_w) + + integer, public :: & + iiLH_rrain = -1, & + iiLH_rsnow = -1, & + iiLH_rice = -1, & + iiLH_rgraupel = -1 +!$omp threadprivate(iiLH_rrain, iiLH_rsnow, iiLH_rice, iiLH_rgraupel) + + integer, public :: & + iiLH_Nr = -1, & + iiLH_Nsnow = -1, & + iiLH_Ni = -1, & + iiLH_Ngraupel = -1, & + iiLH_Nc = -1 +!$omp threadprivate(iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Ngraupel, iiLH_Nc) + + public :: read_correlation_matrix + + private :: get_corr_var_index + + private + + contains + + !----------------------------------------------------------------------------- + subroutine read_correlation_matrix( iunit, input_file, d_variables, & + corr_array ) + + ! Description: + ! Reads a correlation variance array from a file and stores it in an array. + !----------------------------------------------------------------------------- + + use crmx_input_reader, only: & + one_dim_read_var, & ! Variable(s) + read_one_dim_file, deallocate_one_dim_vars, count_columns ! Procedure(s) + + use crmx_matrix_operations, only: set_lower_triangular_matrix ! Procedure(s) + + use crmx_constants_clubb, only: fstderr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable(s) + integer, intent(in) :: & + iunit, & ! File I/O unit + d_variables ! number of variables in the array + + character(len=*), intent(in) :: input_file ! Path to the file + + ! Input/Output Variable(s) + real( kind = core_rknd ), dimension(d_variables,d_variables), intent(inout) :: & + corr_array ! Correlation variance array + + ! Local Variable(s) + + type(one_dim_read_var), allocatable, dimension(:) :: & + retVars ! stores the variables read in from the corr_varnce.in file + + integer :: & + var_index1, & ! variable index + var_index2, & ! variable index + nCols, & ! the number of columns in the file + i, j ! Loop index + + + !--------------------------- BEGIN CODE ------------------------- + + nCols = count_columns( iunit, input_file ) + + ! Allocate all arrays based on d_variables + allocate( retVars(1:nCols) ) + + ! Initializing to zero means that correlations we don't have + ! (e.g. Nc and any variable other than s_mellor ) are assumed to be 0. + corr_array(:,:) = 0.0_core_rknd + + ! Set main diagonal to 1 + do i=1, d_variables + corr_array(i,i) = 1.0_core_rknd + end do + + ! Read the values from the specified file + call read_one_dim_file( iunit, nCols, input_file, retVars ) + + if( size( retVars(1)%values ) /= nCols ) then + write(fstderr, *) "Correlation matrix must have an equal number of rows and cols in file ", & + input_file + stop "Bad data in correlation file." + end if + + ! Start at 2 because the first index is always just 1.0 in the first row + ! and the rest of the rows are ignored + do i=2, nCols + var_index1 = get_corr_var_index( retVars(i)%name ) + if( var_index1 > -1 ) then + do j=1, (i-1) + var_index2 = get_corr_var_index( retVars(j)%name ) + if( var_index2 > -1 ) then + call set_lower_triangular_matrix & + ( d_variables, var_index1, var_index2, retVars(i)%values(j), & + corr_array ) + end if + end do + end if + end do + + call deallocate_one_dim_vars( nCols, retVars ) + + return + end subroutine read_correlation_matrix + + !-------------------------------------------------------------------------- + function get_corr_var_index( var_name ) result( i ) + + ! Definition: + ! Returns the index for a variable based on its name. + !-------------------------------------------------------------------------- + + implicit none + + character(len=*), intent(in) :: var_name ! The name of the variable + + ! Output variable + integer :: i + + !------------------ BEGIN CODE ----------------------------- + i = -1 + + select case( trim(var_name) ) + + case( "s" ) + i = iiLH_s_mellor + + case( "t" ) + i = iiLH_t_mellor + + case( "w" ) + i = iiLH_w + + case( "Nc" ) + i = iiLH_Nc + + case( "rrain" ) + i = iiLH_rrain + + case( "Nr" ) + i = iiLH_Nr + + case( "rice" ) + i = iiLH_rice + + case( "Ni" ) + i = iiLH_Ni + + case( "rsnow" ) + i = iiLH_rsnow + + case( "Nsnow" ) + i = iiLH_Nsnow + + end select + + return + + end function get_corr_var_index +end module crmx_corr_matrix_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 b/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 new file mode 100644 index 0000000000..1891bd6945 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 @@ -0,0 +1,522 @@ +!----------------------------------------------------------------------- +! $Id: csr_matrix_class_3array.F90 5529 2011-11-29 19:49:15Z connork@uwm.edu $ +!=============================================================================== +module crmx_csr_matrix_class + + ! Description: + ! This module contains some of the matrix description arrays required by + ! PARDISO, GMRES, and other sparse matrix solvers. The format is called CSR + ! (compressed sparse row) format, and is currently leveraged through PARDISO + ! and GMRES. + ! These are all 1 dimensional arrays that describe a matrix that + ! will be passed to the solver. The _ja arrays describe which + ! columns in the matrix have nonzero values--for our purposes, all the + ! elements on the appropriate diagonals have values. The _ia arrays describe + ! which _ja array elements correspond to new rows. + ! Further description of this format can be found in the PARDISO manual, or + ! alternately, in Intel MKL's documentation. + ! For our purposes, the _ia and _ja arrays will be fixed for the types + ! of matrices we have, so we calculate these initially using + ! initialize_csr_class and simply use the pointers, similar to how + ! the grid pointers are initialized. This should save a fair amount of time, + ! as we do not have to recalculate the arrays. + ! + ! A description of the CSR matrix format: + ! The CSR matrix format requires three arrays--an a array, + ! a ja array, and an ia array. + ! + ! The a array stores, in sequential order, the actual values in the matrix. + ! Essentially, just copy the matrix into a 1-dimensional array as you move + ! from left to right, top down through the matrix. The a array changes + ! frequently for our purposes in CLUBB, and is not useful to be initialized + ! here. + ! + ! The ja array stores, in sequential order, the columns of each element in + ! the matrix that is nonzero. Essentially, you take the column of each + ! element that is nonzero as you move from left to right, top down through + ! the matrix. + ! + ! An example follows to illustrate the point: + ! [3.0 2.0 0.0 0.0 0.0 0.0 + ! 2.5 1.7 3.6 0.0 0.0 0.0 + ! 0.0 5.2 1.7 3.6 0.0 0.0 + ! 0.0 0.0 4.7 2.9 0.6 0.0 + ! 0.0 0.0 0.0 8.9 4.6 1.2 + ! 0.0 0.0 0.0 0.0 5.8 3.7] + ! + ! Our ja array would look like the following--a pipe denotes a new row: + ! [1 2 | 1 2 3 | 2 3 4 | 3 4 5 | 4 5 6 | 5 6] + ! + ! The ia array stores the indices of the ja array that correspond to new rows + ! in the matrix, with a final entry just beyond the end of the ja matrix + ! that signifies the end of the matrix. + ! In our example, the ia array would look like this: + ! + ! [1 3 6 9 12 15 17] + ! + ! Similar principles can be applied to find the ia and ja matrices for all + ! of the general cases CLUBB uses. In addition, because CLUBB typically + ! uses similar matrices for its calculations, we can simply initialize + ! the ia and ja matrices in this module rather than repeatedly initialize + ! them. This should save on compute time and provide a centralized location + ! to acquire ia and ja arrays. + + implicit none + + public :: csr_tridiag_ia, csr_tridiag_ja, & + csr_banddiag5_135_ia, csr_banddiag5_135_ja, & + csr_banddiag5_12345_ia, csr_banddiag5_12345_ja, & + initialize_csr_class, & + ia_size, tridiag_ja_size, band12345_ja_size, band135_ja_size, & + csr_intlc_s3b_f5b_ia, csr_intlc_s3b_f5b_ja, & + csr_intlc_trid_5b_ia, csr_intlc_trid_5b_ja, & + csr_intlc_5b_5b_ia, csr_intlc_5b_5b_ja, & + intlc_ia_size, intlc_s3d_5d_ja_size, intlc_5d_5d_ja_size, & + intlc_td_5d_ja_size + + private ! Default scope + + integer, pointer, dimension(:) :: & + csr_tridiag_ia, & !_ia array description for a tridiagonal matrix + csr_tridiag_ja, & !_ja array description for a tridiagonal matrix + csr_banddiag5_135_ia, & !_ia array description for a 5-band matrix + ! with the first upper and lower bands as 0. + csr_banddiag5_135_ja, & !_ja array description for a 5-band matrix + ! with the first upper and lower bands as 0. + csr_banddiag5_12345_ia, & !_ia array description for a 5-band matrix + csr_banddiag5_12345_ja, & !_ja array description for a 5-band matrix + csr_intlc_s3b_f5b_ia, & !_ia array description for interlaced 5-band + ! matrix ("spaced 3-band, full 5-band") + csr_intlc_s3b_f5b_ja, & !_ja array description for interlaced 5-band + ! matrix ("spaced 3-band, full 5-band") + csr_intlc_trid_5b_ia, & !_ia array description for interlaced tridiag + ! and 5-band matrix (tridiag, 5-band) + csr_intlc_trid_5b_ja, & !_ja array description for interlaced tridiag + ! and 5-band matrix (tridiag, 5-band) + csr_intlc_5b_5b_ia, & !_ia array description for "interlaced" + ! 5-band and 5-band matrix (double-size 5-band) + csr_intlc_5b_5b_ja !_ja array description for "interlaced" + ! 5-band and 5-band matrix (double-size 5-band) + + integer :: & + ia_size, & ! Size of the _ia arrays. + tridiag_ja_size, & ! Size of the tridiagonal ja array. + band12345_ja_size, & ! Size of the 5-band-with-first-bands-0 ja array. + band135_ja_size, & ! Size of the 5-band ja array. + intlc_ia_size, & ! Size of the interlaced _ia arrays. + intlc_s3d_5d_ja_size, & ! Size of the interlaced spaced + ! 3-diag+5-diag ja arrays. + intlc_5d_5d_ja_size, & ! Size of the interlaced 5-diag+5-diag ja arrays. + intlc_td_5d_ja_size ! Size of the interlaced tridiag+5-diag ja arrays. + + contains + + !============================================================================ + subroutine initialize_csr_class + + ! Description: + ! PARDISO matrix array initialization + ! + ! This subroutine creates the _ia and _ja arrays, and calculates their + ! required values for the current gr%nz. + ! + ! References: + ! None + !------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) + + implicit none + + ! Local variables + integer :: & + i, j, & ! Loop indices + error, & ! Status for allocation + num_bands, & ! Number of diagonals for allocation + num_diags, & ! Number of non-empty diagonals for allocation + cur_row, & ! Current row--used in initialization + cur_diag, & ! Current diagonal--num_diags/2 + 1 is the main diagonal + ! Note: At the boundaries, less diagonals are in scope. + ! At the lower boundaries, the subdiagonals aren't in scope. + ! At the upper boundaries, the superdiagonals aren't in scope. + counter ! Counter used to initialize the interlaced matrices + + logical :: l_print_ia_ja ! Debug flag to print the ia and ja arrays after + ! initialization is complete. + + ! ---- Begin Code ---- + + ! Define the array sizes + ia_size = gr%nz + 1 + intlc_ia_size = (2 * gr%nz) + 1 + + ! Tridiagonal case and 5-band with 2 empty diagonals have 3 full diagonals + num_diags = 3 + tridiag_ja_size = (gr%nz * num_diags) - 2 + band135_ja_size = (gr%nz * num_diags) - 4 + + ! 5-band with all diagonals has 5 full diagonals + num_diags = 5 + band12345_ja_size = (gr%nz * num_diags) - 6 + + ! Interlaced arrays are tricky--there is an average of 4 diagonals for + ! the 3/5band, but we need to take into account the fact that the + ! tridiagonal and spaced 3-band will have different boundary indices. + num_diags = 4 + intlc_td_5d_ja_size = (gr%nz * 2 * num_diags) - 4 + intlc_s3d_5d_ja_size = (gr%nz * 2 * num_diags) - 5 + + ! The double-sized "interlaced" 5-band is similar to the standard 5-band + num_diags = 5 + intlc_5d_5d_ja_size = (gr%nz * 2 * num_diags) - 6 + + ! Allocate the correct amount of space for the actual _ia and _ja arrays + allocate( csr_tridiag_ia(1:ia_size), & + csr_tridiag_ja(1:tridiag_ja_size), & + csr_banddiag5_12345_ia(1:ia_size), & + csr_banddiag5_12345_ja(1:band12345_ja_size), & + csr_banddiag5_135_ia(1:ia_size), & + csr_banddiag5_135_ja(1:band135_ja_size), & + csr_intlc_s3b_f5b_ia(1:intlc_ia_size), & + csr_intlc_s3b_f5b_ja(1:intlc_s3d_5d_ja_size), & + csr_intlc_trid_5b_ia(1:intlc_ia_size), & + csr_intlc_trid_5b_ja(1:intlc_td_5d_ja_size), & + csr_intlc_5b_5b_ia(1:intlc_ia_size), & + csr_intlc_5b_5b_ja(1:intlc_5d_5d_ja_size), & + stat=error ) + + if ( error /= 0 ) then + write(fstderr,*) "Allocation of CSR matrix arrays failed." + stop "Fatal error--allocation of CSR matrix arrays failed." + end if + + ! Initialize the tridiagonal matrix arrays + num_bands = 3 + do i = 2, (gr%nz - 1), 1 + cur_row = (i - 1) * num_bands + do j = 1, num_bands, 1 + cur_diag = j - 1 + csr_tridiag_ja(cur_row + cur_diag) = i + j - 2 + end do + csr_tridiag_ia(i) = cur_row + end do ! i = 2...gr%nz-1 + + ! Handle boundary conditions for the tridiagonal matrix arrays + ! These conditions have been hand-calculated bearing in mind that the + ! matrix in question is tridiagonal. + + ! Make sure we don't crash if someone sets up gr%nz as 1. + if ( gr%nz > 1 ) then + ! Lower boundaries + csr_tridiag_ja(1) = 1 + csr_tridiag_ja(2) = 2 + csr_tridiag_ia(1) = 1 + + ! Upper boundaries + csr_tridiag_ja(tridiag_ja_size - 1) = gr%nz - 1 + csr_tridiag_ja(tridiag_ja_size) = gr%nz + csr_tridiag_ia(ia_size - 1) = tridiag_ja_size - 1 + + ! This final boundary is to signify the end of the matrix, and is + ! intended to be beyond the bound of the ja array. + csr_tridiag_ia(ia_size) = tridiag_ja_size + 1 + end if ! gr%nz > 1 + + ! Initialize the 5-band matrix arrays + num_bands = 5 + do i = 3, (gr%nz - 2), 1 + + ! Full 5-band matrix has 5 diagonals to initialize + num_diags = 5 + cur_row = num_diags * (i - 1) + do j = 1, num_diags, 1 + cur_diag = j - 3 + csr_banddiag5_12345_ja(cur_row + cur_diag) = i + cur_diag + end do + + csr_banddiag5_12345_ia(i) = cur_row - 2 + + ! 5-band matrix with 2 zero bands has 3 diagonals to initialize + num_diags = 3 + cur_row = num_diags * (i - 1) + do j = 1, num_diags, 1 + cur_diag = j - 2 + ! The first upper and first lower bands are zero, so there needs to be + ! special handling to account for this. The j * 2 takes into account + ! the spaces between diagonals. + csr_banddiag5_135_ja(cur_row + cur_diag) = i + ((j * 2) - 1) - num_diags + end do + + csr_banddiag5_135_ia(i) = cur_row - 1 + + end do ! i = 3...gr%nz-2 + + ! Handle boundary conditions for the 5-band matrix arrays + ! These values have been hand-calculated bearing in mind the two different + ! types of 5-band matrices. + + ! Make sure we don't crash if someone sets up gr%nz as less than 3. + if ( gr%nz > 2 ) then + + ! -------------- (full) 5-band matrix boundaries --------------- + + ! Lower boundaries for the (full) 5-band matrix. + do i = 1, 3, 1 + csr_banddiag5_12345_ja(i) = i + end do + do i = 1, 4, 1 + csr_banddiag5_12345_ja(i + 3) = i + end do + csr_banddiag5_12345_ia(1) = 1 + csr_banddiag5_12345_ia(2) = 4 + + ! Upper boundaries for the (full) 5-band matrix. + ! 7 and 3 are the number of elements from the "end" of the matrix if we + ! travel right to left, bottom up. Because the ja matrices correspond to + ! the column the element is in, we go 3 or 4 elements from the end for the + ! second to last row (both superdiagonals absent on last row), + ! and 3 for the last row (both superdiagonals absent). The indices are + ! similarly calculated, except that in the case of the second to last + ! row, it is necessary to offset for the last row as well (hence, + ! 7 = 4+3). + do i = 1, 4, 1 + csr_banddiag5_12345_ja(band12345_ja_size - 7 + i) = gr%nz + i - 4 + end do + do i = 1, 3, 1 + csr_banddiag5_12345_ja(band12345_ja_size - 3 + i) = gr%nz + i - 3 + end do + csr_banddiag5_12345_ia(ia_size - 2) = band12345_ja_size - 6 + csr_banddiag5_12345_ia(ia_size - 1) = band12345_ja_size - 2 + + ! This final boundary is to signify the end of the matrix, and is + ! intended to be beyond the bound of the ja array. + csr_banddiag5_12345_ia(ia_size) = band12345_ja_size + 1 + + ! ------------ end (full) 5-band matrix boundaries --------------- + + ! --------- 5-band matrix w/ empty first bands boundaries ---------- + + ! Lower boundaries for the 5-band w/ empty first bands matrix + ! The 2 * i is present because of the space between the main diagonal + ! and the superdiagonal that actually have nonzero values. + do i = 1, 2, 1 + csr_banddiag5_135_ja(i) = (2 * i) - 1 + csr_banddiag5_135_ja(i + 2) = (2 * i) + csr_banddiag5_135_ia(i) = (2 * i) - 1 + end do + + ! Upper boundaries for the 5-band w/ empty first bands matrix + ! The values for the boundaries are tricky, as the indices and values + ! are not equal. The indices are 2 and 4 away from the end, as there are + ! only two nonzero values at the two final rows. + ! The values, on the other hand, are different, because of the + ! aforementioned space, this time between the main and subdiagonal. + do i = 1, 2, 1 + csr_banddiag5_135_ja(band135_ja_size - 4 + i) = gr%nz + (i * 2) - 5 + csr_banddiag5_135_ja(band135_ja_size - 2 + i) = gr%nz + (i * 2) - 4 + end do + csr_banddiag5_135_ia(ia_size - 2) = band135_ja_size - 3 + csr_banddiag5_135_ia(ia_size - 1) = band135_ja_size + 1 + + ! This final boundary is to signify the end of the matrix, and is + ! intended to be beyond the bound of the ja array. + csr_banddiag5_135_ia(ia_size) = band135_ja_size + 1 + + ! ------- end 5-band matrix w/ empty first bands boundaries -------- + + end if ! gr%nz > 2 + + ! Initialize the interlaced arrays--all of them are 5-band right now. + num_bands = 5 + + ! Our counter starts at 2--this is used for the 3/5 interlaced matrices. + ! We start at 2 so when we enter the odd row and increment by 5, + ! it becomes 7. + counter = 2 + + do i = 3, ((gr%nz * 2) - 2), 1 + if (mod( i,2 ) == 1) then + ! Odd row, this is the potentially non 5-band row. + ! Increment counter. Last row was an even row, so we'll need to add 5. + counter = counter + 5 + + ! For our tridiag and spaced 3-band arrays, this will be a + ! 3-diagonal row. + num_diags = 3 + cur_row = counter + 1 + do j = 1, num_diags, 1 + cur_diag = j - 2 + csr_intlc_s3b_f5b_ja(cur_row + cur_diag) & + = i + ((j * 2) - 1) - num_diags + csr_intlc_trid_5b_ja(cur_row + cur_diag) = i + cur_diag + end do + csr_intlc_s3b_f5b_ia(i) = counter + csr_intlc_trid_5b_ia(i) = counter + + ! For our 5-band interlaced-size array, this will be a + ! 5-diagonal row (obviously!). + num_diags = 5 + cur_row = num_diags * (i - 1) + do j = 1, num_diags, 1 + cur_diag = j - 3 + csr_intlc_5b_5b_ja(cur_row + cur_diag) = i + cur_diag + end do + + csr_intlc_5b_5b_ia(i) = cur_row - 2 + + else + ! Even row, this is the "guaranteed" 5-band row. + ! Increment counter. Last row was an odd row, so we'll need to add 3. + counter = counter + 3 + + ! For our tridiag and spaced 3-band arrays, this will be a + ! 5-diagonal row. + num_diags = 5 + cur_row = counter + 2 + do j = 1, num_diags, 1 + cur_diag = j - 3 + csr_intlc_s3b_f5b_ja(cur_row + cur_diag) = i + cur_diag + csr_intlc_trid_5b_ja(cur_row + cur_diag) = i + cur_diag + end do + + csr_intlc_s3b_f5b_ia(i) = counter + csr_intlc_trid_5b_ia(i) = counter + + ! For our 5-band "interlaced" array, this will also be a + ! 5-diagonal row. However, we need to change the cur_row to match + ! what we're expecting for the 5-band. + num_diags = 5 + cur_row = num_diags * (i - 1) + do j = 1, num_diags, 1 + cur_diag = j - 3 + csr_intlc_5b_5b_ja(cur_row + cur_diag) = i + cur_diag + end do + + csr_intlc_5b_5b_ia(i) = cur_row - 2 + + end if ! mod(i,2) == 1 + end do ! i = 3...(gr%nz*2)-2 + + ! Handle boundary conditions for the interlaced matrix arrays + ! These conditions have been hand-calculated bearing in mind + ! the structure of the interlaced matrices. + + ! Make sure we don't crash if someone sets up gr%nz as less than 3. + if (gr%nz > 2) then + ! Lower boundaries + + ! First row + do i = 1, 2, 1 + csr_intlc_s3b_f5b_ja(i) = (i * 2) - 1 + csr_intlc_trid_5b_ja(i) = i + end do + do i = 1, 3, 1 + csr_intlc_5b_5b_ja(i) = i + end do + csr_intlc_s3b_f5b_ia(1) = 1 + csr_intlc_trid_5b_ia(1) = 1 + csr_intlc_5b_5b_ia(1) = 1 + + ! Second row + do i = 1, 4, 1 + csr_intlc_s3b_f5b_ja(i + 2) = i + csr_intlc_trid_5b_ja(i + 2) = i + csr_intlc_5b_5b_ja(i + 3) = i + end do + csr_intlc_s3b_f5b_ia(2) = 3 + csr_intlc_trid_5b_ia(2) = 3 + csr_intlc_5b_5b_ia(2) = 4 + + ! Upper boundaries + + ! Last two rows + ! Note that in comparison to the other upper boundaries, we have to use + ! intlc_ia_size - 1 for our upper index limit as the matrix is + ! double-sized. + + ! Second-to-last row + do i = 1, 2, 1 + csr_intlc_s3b_f5b_ja(intlc_s3d_5d_ja_size - 5 + i) & + = intlc_ia_size - 1 + (i * 2) - 5 + end do + do i = 1, 3, 1 + csr_intlc_trid_5b_ja(intlc_td_5d_ja_size - 6 + i) & + = intlc_ia_size - 1 + i - 3 + end do + do i = 1, 4, 1 + csr_intlc_5b_5b_ja(intlc_5d_5d_ja_size - 7 + i) & + = intlc_ia_size-1 + i - 4 + end do + + ! Last row + do i = 1, 3, 1 + csr_intlc_s3b_f5b_ja(intlc_s3d_5d_ja_size - 3 + i) & + = intlc_ia_size-1 + i - 3 + csr_intlc_trid_5b_ja(intlc_td_5d_ja_size - 3 + i) & + = intlc_ia_size-1 + i - 3 + csr_intlc_5b_5b_ja(intlc_5d_5d_ja_size - 3 + i) & + = intlc_ia_size-1 + i - 3 + end do + + ! Lastly, take care of the ia arrays. + csr_intlc_s3b_f5b_ia(intlc_ia_size - 2) = intlc_s3d_5d_ja_size - 4 + csr_intlc_s3b_f5b_ia(intlc_ia_size - 1) = intlc_s3d_5d_ja_size - 2 + csr_intlc_s3b_f5b_ia(intlc_ia_size) = intlc_s3d_5d_ja_size + 1 + + csr_intlc_trid_5b_ia(intlc_ia_size - 2) = intlc_td_5d_ja_size - 5 + csr_intlc_trid_5b_ia(intlc_ia_size - 1) = intlc_td_5d_ja_size - 2 + csr_intlc_trid_5b_ia(intlc_ia_size) = intlc_td_5d_ja_size + 1 + + csr_intlc_5b_5b_ia(intlc_ia_size - 2) = intlc_5d_5d_ja_size - 6 + csr_intlc_5b_5b_ia(intlc_ia_size - 1) = intlc_5d_5d_ja_size - 2 + csr_intlc_5b_5b_ia(intlc_ia_size) = intlc_5d_5d_ja_size + 1 + + + end if ! gr%nz > 2 + + ! Enable printing the ia/ja arrays for debug purposes + l_print_ia_ja = .false. + if (l_print_ia_ja) then + do i = 1, ia_size, 1 + print *, "tridiag ia idx", i, "=", csr_tridiag_ia(i) + print *, "banddiag12345 ia idx", i, "=", csr_banddiag5_12345_ia(i) + print *, "banddiag135 ia idx", i, "=", csr_banddiag5_135_ia(i) + end do + do i = 1, intlc_ia_size, 1 + print *, "interlaced tridiag w/ 5-band ia idx", i, & + "=", csr_intlc_trid_5b_ia(i) + print *, "interlaced spaced-3-band+5-band ia idx", i, & + "=", csr_intlc_s3b_f5b_ia(i) + print *, "interlaced 5-band w/ 5-band ia idx", i, "=", & + csr_intlc_5b_5b_ia(i) + end do + do i = 1, tridiag_ja_size, 1 + print *, "tridiag ja idx", i, "=", csr_tridiag_ja(i) + end do + do i = 1, band12345_ja_size, 1 + print *, "band12345 ja idx", i, "=", csr_banddiag5_12345_ja(i) + end do + do i = 1, band135_ja_size, 1 + print *, "band135 ja idx", i, "=", csr_banddiag5_135_ja(i) + end do + do i = 1, intlc_td_5d_ja_size, 1 + print *, "interlaced tridiag w/ 5-band ja idx", i, & + "=", csr_intlc_trid_5b_ja(i) + end do + do i = 1, intlc_s3d_5d_ja_size, 1 + print *, "interlaced spaced-3-band+5-band ja idx", i, & + "=", csr_intlc_s3b_f5b_ja(i) + end do + do i = 1, intlc_5d_5d_ja_size, 1 + print *, "interlaced 5-band w/ 5-band ja idx", i, "=", & + csr_intlc_5b_5b_ja(i) + end do + end if ! l_print_ia_ja + + end subroutine initialize_csr_class + +end module crmx_csr_matrix_class diff --git a/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 b/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 new file mode 100644 index 0000000000..1160134ab3 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 @@ -0,0 +1,489 @@ +! $Id$ +module crmx_diagnose_correlations_module + + use crmx_clubb_precision, only: & + core_rknd + + implicit none + + public :: diagnose_KK_corr, diagnose_LH_corr, & + calc_mean, calc_varnce, calc_w_corr + + + private :: diagnose_corr + + + contains + +!----------------------------------------------------------------------- + subroutine diagnose_KK_corr( Ncm, rrainm, Nrm, & ! intent(in) + Ncp2_on_Ncm2, rrp2_on_rrm2, Nrp2_on_Nrm2, & + corr_ws, corr_wrr, corr_wNr, corr_wNc, & + pdf_params, & + corr_rrNr_p, corr_srr_p, corr_sNr_p, corr_sNc_p, & + corr_rrNr, corr_srr, corr_sNr, corr_sNc ) ! intent(inout) + + ! Description: + ! This subroutine diagnoses the correlation matrix in order to feed it + ! into KK microphysics. + + ! References: + ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 + ! (see CLUBB-Trac:ticket:514) + !----------------------------------------------------------------------- + + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Type + + use crmx_constants_clubb, only: & + w_tol, & ! [m/s] + s_mellor_tol, & ! [kg/kg] + Nc_tol, & ! [num/kg] + rr_tol, & ! [kg/kg] + Nr_tol ! [num/kg] + + use crmx_stats_type, only: & + stat_update_var_pt ! Procedure(s) + + implicit none + + intrinsic :: sqrt + + ! Local Constants + integer, parameter :: & + n_variables = 5 + + ! Input Variables + + real( kind = core_rknd ), intent(in) :: & + Ncm, & ! Cloud droplet number conc. [num/kg] + rrainm, & ! rain water mixing ratio [kg/kg] + Nrm, & ! Mean rain drop concentration [num/kg] + Ncp2_on_Ncm2, & ! Variance of Nc divided by Ncm^2 [-] + rrp2_on_rrm2, & ! Variance of rrain divided by rrainm^2 [-] + Nrp2_on_Nrm2, & ! Variance of Nr divided by Nrm^2 [-] + corr_ws, & ! Correlation between s_mellor and w [-] + corr_wrr, & ! Correlation between rrain and w [-] + corr_wNr, & ! Correlation between Nr and w [-] + corr_wNc, & ! Correlation between Nc and w [-] + corr_rrNr_p, & ! Prescribed correlation between rrain and Nr [-] + corr_srr_p, & ! Prescribed correlation between s and rrain [-] + corr_sNr_p, & ! Prescribed correlation between s and Nr [-] + corr_sNc_p ! Prescribed correlation between s and Nc [-] + + type(pdf_parameter), intent(in) :: & + pdf_params ! PDF parameters [units vary] + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout) :: & + corr_rrNr, & ! Correlation between rrain and Nr [-] + corr_srr, & ! Correlation between s and rrain [-] + corr_sNr, & ! Correlation between s and Nr [-] + corr_sNc ! Correlation between s and Nc [-] + + + + ! Local Variables + real( kind = core_rknd ), dimension(n_variables, n_variables) :: & + corr_matrix_approx, & ! [-] + corr_matrix_prescribed ! [-] + + real( kind = core_rknd ), dimension(n_variables) :: & + sqrt_xp2_on_xm2, & ! sqrt of x_variance / x_mean^2 [units vary] + xm ! means of the hydrometeors [units vary] + + ! Indices of the hydrometeors + integer :: & + ii_w = 1, & + ii_s = 2, & + ii_rrain = 3, & + ii_Nr = 4, & + ii_Nc = 5 + + integer :: i, j ! Loop Iterators + + + !-------------------- Begin code -------------------- + + ! set up xp2_on_xm2 + + ! TODO Why is wp2_on_wm2=1 + ! S_i is set to 1 for s_mellor and w, because s_mellorm could be 0 + sqrt_xp2_on_xm2(ii_w) = 1._core_rknd + sqrt_xp2_on_xm2(ii_s) = 1._core_rknd + + sqrt_xp2_on_xm2(ii_rrain) = sqrt(rrp2_on_rrm2) + sqrt_xp2_on_xm2(ii_Nr) = sqrt(Nrp2_on_Nrm2) + sqrt_xp2_on_xm2(ii_Nc) = sqrt(Ncp2_on_Ncm2) + + ! initialize the correlation matrix with 0 + do i=1, n_variables + do j=1, n_variables + corr_matrix_approx(i,j) = 0._core_rknd + corr_matrix_prescribed(i,j) = 0._core_rknd + end do + end do + + ! set diagonal of the correlation matrix to 1 + do i = 1, n_variables + corr_matrix_approx(i,i) = 1._core_rknd + corr_matrix_prescribed(i,i) = 1._core_rknd + end do + + + ! set the first row to the corresponding prescribed correlations + corr_matrix_approx(ii_s,1) = corr_ws + corr_matrix_approx(ii_rrain,1) = corr_wrr + corr_matrix_approx(ii_Nr,1) = corr_wNr + corr_matrix_approx(ii_Nc,1) = corr_wNc + + !corr_matrix_prescribed = corr_matrix_approx + + ! set up the prescribed correlation matrix + if( ii_rrain > ii_Nr ) then + corr_matrix_prescribed(ii_rrain, ii_Nr) = corr_rrNr_p + else + corr_matrix_prescribed(ii_Nr, ii_rrain) = corr_rrNr_p + end if + + if ( ii_s > ii_rrain ) then + corr_matrix_prescribed(ii_s, ii_rrain) = corr_srr_p + else + corr_matrix_prescribed(ii_rrain, ii_s) = corr_srr_p + end if + + if ( ii_s > ii_Nr ) then + corr_matrix_prescribed(ii_s, ii_Nr) = corr_sNr_p + else + corr_matrix_prescribed(ii_Nr, ii_s) = corr_sNr_p + end if + + if ( ii_s > ii_Nc ) then + corr_matrix_prescribed(ii_s, ii_Nc) = corr_sNc_p + else + corr_matrix_prescribed(ii_Nc, ii_s) = corr_sNc_p + end if + + call diagnose_corr( n_variables, sqrt_xp2_on_xm2, corr_matrix_prescribed, & !intent(in) + corr_matrix_approx ) ! intent(inout) + + if( ii_rrain > ii_Nr ) then + corr_rrNr = corr_matrix_approx(ii_rrain, ii_Nr) + else + corr_rrNr = corr_matrix_approx(ii_Nr, ii_rrain) + end if + + if ( ii_s > ii_rrain ) then + corr_srr = corr_matrix_approx(ii_s, ii_rrain) + else + corr_srr = corr_matrix_approx(ii_rrain, ii_s) + end if + + if ( ii_s > ii_Nr ) then + corr_sNr = corr_matrix_approx(ii_s, ii_Nr) + else + corr_sNr = corr_matrix_approx(ii_Nr, ii_s) + end if + + if ( ii_s > ii_Nc ) then + corr_sNc = corr_matrix_approx(ii_s, ii_Nc) + else + corr_sNc = corr_matrix_approx(ii_Nc, ii_s) + end if + + end subroutine diagnose_KK_corr + +!----------------------------------------------------------------------- + subroutine diagnose_LH_corr( xp2_on_xm2, d_variables, corr_matrix_prescribed, & !intent(in) + corr_array ) ! intent(inout) + + ! Description: + ! This subroutine diagnoses the correlation matrix in order to feed it + ! into SILHS microphysics. + + ! References: + ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 + ! (see CLUBB Trac ticket#514) + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_corr_matrix_module, only: & + iiLH_w ! Variable(s) + + implicit none + + intrinsic :: max, sqrt, transpose + + ! Input Variables + integer, intent(in) :: d_variables + + real( kind = core_rknd ), dimension(d_variables, d_variables), intent(in) :: & + corr_matrix_prescribed + + real( kind = core_rknd ), dimension(d_variables), intent(in) :: & + xp2_on_xm2 ! ratios of x_variance over x_mean^2 + + ! Input/Output variables + real( kind = core_rknd ), dimension(d_variables, d_variables), intent(inout) :: & + corr_array + + ! Local Variables + real( kind = core_rknd ), dimension(d_variables, d_variables) :: & + corr_matrix_pre_swapped + + real( kind = core_rknd ), dimension(d_variables) :: & + swap_array + + !-------------------- Begin code -------------------- + + ! Swap the w-correlations to the first row + swap_array = corr_array(:, 1) + corr_array(1:iiLH_w, 1) = corr_array(iiLH_w, iiLH_w:1:-1) + corr_array((iiLH_w+1):d_variables, 1) = corr_array((iiLH_w+1):d_variables, iiLH_w) + corr_array(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) + corr_array((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) + + corr_matrix_pre_swapped = corr_matrix_prescribed + swap_array = corr_matrix_pre_swapped (:,1) + corr_matrix_pre_swapped(1:iiLH_w, 1) = corr_matrix_pre_swapped(iiLH_w, iiLH_w:1:-1) + corr_matrix_pre_swapped((iiLH_w+1):d_variables, 1) = corr_matrix_pre_swapped( & + (iiLH_w+1):d_variables, iiLH_w) + corr_matrix_pre_swapped(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) + corr_matrix_pre_swapped((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) + + ! diagnose correlations + call diagnose_corr( d_variables, sqrt(xp2_on_xm2), corr_matrix_pre_swapped, & + corr_array) + + ! Swap rows back + swap_array = corr_array(:, 1) + corr_array(1:iiLH_w, 1) = corr_array(iiLH_w, iiLH_w:1:-1) + corr_array((iiLH_w+1):d_variables, 1) = corr_array((iiLH_w+1):d_variables, iiLH_w) + corr_array(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) + corr_array((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) + + end subroutine diagnose_LH_corr + +!----------------------------------------------------------------------- + subroutine diagnose_corr( n_variables, sqrt_xp2_on_xm2, corr_matrix_prescribed, & !intent(in) + corr_matrix_approx ) ! intent(inout) + + ! Description: + ! This subroutine diagnoses the correlation matrix for each timestep. + + ! References: + ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 + ! (see CLUBB Trac ticket#514) + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_parameters_tunable, only: & + alpha_corr ! Constant(s) + + use crmx_constants_clubb, only: & + max_mag_correlation + + implicit none + + intrinsic :: & + sqrt, abs, sign + + ! Input Variables + integer, intent(in) :: & + n_variables ! number of variables in the correlation matrix [-] + + real( kind = core_rknd ), dimension(n_variables), intent(in) :: & + sqrt_xp2_on_xm2 ! sqrt of x_variance / x_mean^2 [units vary] + + real( kind = core_rknd ), dimension(n_variables,n_variables), intent(in) :: & + corr_matrix_prescribed ! correlation matrix [-] + + ! Input/Output Variables + real( kind = core_rknd ), dimension(n_variables,n_variables), intent(inout) :: & + corr_matrix_approx ! correlation matrix [-] + + + ! Local Variables + integer :: i, j ! Loop iterator + + real( kind = core_rknd ) :: & + f_ij, & + f_ij_o + + real( kind = core_rknd ), dimension(n_variables) :: & + s_1j ! s_1j = sqrt(1-c_1j^2) + + + !-------------------- Begin code -------------------- + + ! calculate all square roots + do i = 1, n_variables + + s_1j(i) = sqrt(1._core_rknd-corr_matrix_approx(i,1)**2) + + end do + + + ! Diagnose the missing correlations (upper triangle) + do j = 2, (n_variables-1) + do i = (j+1), n_variables + + ! formula (16) in the ref. paper (Larson et al. (2011)) + !f_ij = alpha_corr * sqrt_xp2_on_xm2(i) * sqrt_xp2_on_xm2(j) & + ! * sign(1.0_core_rknd,corr_matrix_approx(1,i)*corr_matrix_approx(1,j)) + + ! If the predicting c1i's are small then cij will be closer to the prescribed value. If + ! the c1i's are bigger, then cij will be closer to formular (15) from the ref. paper. See + ! clubb:ticket:514:comment:61 for details. + !f_ij = (1-abs(corr_matrix_approx(1,i)*corr_matrix_approx(1,j)))*corr_matrix_prescribed(i,j) & + ! + abs(corr_matrix_approx(1,i)*corr_matrix_approx(1,j))*f_ij_o + + f_ij = corr_matrix_prescribed(i,j) + + ! make sure -1 < f_ij < 1 + if ( f_ij < -max_mag_correlation ) then + + f_ij = -max_mag_correlation + + else if ( f_ij > max_mag_correlation ) then + + f_ij = max_mag_correlation + + end if + + + ! formula (15) in the ref. paper (Larson et al. (2011)) + corr_matrix_approx(i,j) = corr_matrix_approx(i,1) * corr_matrix_approx(j,1) & + + f_ij * s_1j(i) * s_1j(j) + + end do ! do j + end do ! do i + + end subroutine diagnose_corr + + !----------------------------------------------------------------------- + function calc_w_corr( wpxp, stdev_w, stdev_x, w_tol, x_tol ) + ! Description: + ! Compute the correlations of w with the hydrometeors. + + ! References: + ! clubb:ticket:514 + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + max_mag_correlation + + implicit none + + intrinsic :: max + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + stdev_w, & ! standard deviation of w [m/s] + stdev_x, & ! standard deviation of x [units vary] + wpxp, & ! Covariances of w with the hydrometeors [units vary] + w_tol, & ! tolerance for w [m/s] + x_tol ! tolerance for x [units vary] + + real( kind = core_rknd ) :: & + calc_w_corr + + ! --- Begin Code --- + + calc_w_corr = wpxp / ( max(stdev_x, x_tol) * max(stdev_w, w_tol) ) + + ! Make sure the correlation is in [-1,1] + if ( calc_w_corr < -max_mag_correlation ) then + + calc_w_corr = -max_mag_correlation + + else if ( calc_w_corr > max_mag_correlation ) then + + calc_w_corr = max_mag_correlation + + end if + + end function calc_w_corr + + + !----------------------------------------------------------------------- + function calc_varnce( mixt_frac, x1, x2, xm, x1p2, x2p2 ) + + ! Description: + ! Calculate the variance xp2 from the components x1, x2. + + ! References: + ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02, + ! page 3535 + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + mixt_frac, & ! mixing ratio [-] + x1, & ! first component of the double gaussian [units vary] + x2, & ! second component of the double gaussian [units vary] + xm, & ! mean of x [units vary] + x1p2, & ! variance of the first component [units vary] + x2p2 ! variance of the second component [units vary] + + ! Return Variable + real( kind = core_rknd ) :: & + calc_varnce ! variance of x (both components) [units vary] + + ! --- Begin Code --- + + calc_varnce = mixt_frac * ((x1 - xm)**2 + x1p2) + (1.0_core_rknd - mixt_frac) * ((x2 - xm)**2 + x2p2) + + return + end function calc_varnce + + !----------------------------------------------------------------------- + function calc_mean( mixt_frac, x1, x2 ) + + ! Description: + ! Calculate the mean xm from the components x1, x2. + + ! References: + ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02, + ! page 3535 + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + mixt_frac, & ! mixing ratio [-] + x1, & ! first component of the double gaussian [units vary] + x2 ! second component of the double gaussian [units vary] + + ! Return Variable + real( kind = core_rknd ) :: & + calc_mean ! mean of x (both components) [units vary] + + ! --- Begin Code --- + + calc_mean = mixt_frac * x1 + (1.0_core_rknd - mixt_frac) * x2 + + return + end function calc_mean + +end module crmx_diagnose_correlations_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 b/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 new file mode 100644 index 0000000000..75956e82d6 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 @@ -0,0 +1,800 @@ +! $Id: diffusion.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_diffusion + + ! Description: + ! Module diffusion computes the eddy diffusion terms for all of the + ! time-tendency (prognostic) equations in the CLUBB parameterization. Most of + ! the eddy diffusion terms are solved for completely implicitly, and therefore + ! become part of the left-hand side of their respective equations. However, + ! wp2 and wp3 have an option to use a Crank-Nicholson eddy diffusion scheme, + ! which has both implicit and explicit components. + ! + ! Function diffusion_zt_lhs handles the eddy diffusion terms for the variables + ! located at thermodynamic grid levels. These variables are: wp3 and all + ! hydrometeor species. The variables um and vm also use the Crank-Nicholson + ! eddy-diffusion scheme for their turbulent advection term. + ! + ! Function diffusion_zm_lhs handles the eddy diffusion terms for the variables + ! located at momentum grid levels. The variables are: wprtp, wpthlp, wp2, + ! rtp2, thlp2, rtpthlp, up2, vp2, wpsclrp, sclrprtp, sclrpthlp, and sclrp2. + + implicit none + + private ! Default Scope + + public :: diffusion_zt_lhs, & + diffusion_cloud_frac_zt_lhs, & + diffusion_zm_lhs + + contains + + !============================================================================= + pure function diffusion_zt_lhs( K_zm, K_zmm1, nu, & + invrs_dzmm1, invrs_dzm, & + invrs_dzt, level ) & + result( lhs ) + + ! Description: + ! Vertical eddy diffusion of var_zt: implicit portion of the code. + ! + ! The variable "var_zt" stands for a variable that is located at + ! thermodynamic grid levels. + ! + ! The d(var_zt)/dt equation contains an eddy diffusion term: + ! + ! + d [ ( K_zm + nu ) * d(var_zt)/dz ] / dz. + ! + ! This term is usually solved for completely implicitly, such that: + ! + ! + d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. + ! + ! However, when a Crank-Nicholson scheme is used, the eddy diffusion term + ! has both implicit and explicit components, such that: + ! + ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz + ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t) )/dz ] / dz; + ! + ! for which the implicit component is: + ! + ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "+" in front of the term + ! is changed to a "-". + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(var_zt)/dt equation. + ! + ! The implicit portion of this term is discretized as follows: + ! + ! The values of var_zt are found on the thermodynamic levels, while the + ! values of K_zm are found on the momentum levels. The derivatives (d/dz) + ! of var_zt are taken over the intermediate momentum levels. At the + ! intermediate momentum levels, d(var_zt)/dz is multiplied by ( K_zm + nu ). + ! Then, the derivative of the whole mathematical expression is taken over + ! the central thermodynamic level, which yields the desired result. + ! + ! --var_ztp1----------------------------------------------- t(k+1) + ! + ! ==========d(var_zt)/dz==(K_zm+nu)======================== m(k) + ! + ! --var_zt-------------------d[(K_zm+nu)*d(var_zt)/dz]/dz-- t(k) + ! + ! ==========d(var_zt)/dz==(K_zmm1+nu)====================== m(k-1) + ! + ! --var_ztm1----------------------------------------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + ! invrs_dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) + ! + ! Note: This function only computes the general implicit form: + ! + d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. + ! For a Crank-Nicholson scheme, the left-hand side result of this + ! function will have to be multiplied by (1/2). For a + ! Crank-Nicholson scheme, the right-hand side (explicit) component + ! needs to be computed by multiplying the left-hand side results by + ! (1/2), reversing the sign on each left-hand side element, and then + ! multiplying each element by the appropriate var_zt(t) value from + ! the appropriate vertical level. + ! + ! + ! Boundary Conditions: + ! + ! 1) Zero-flux boundary conditions. + ! This function is set up to use zero-flux boundary conditions at both + ! the lower boundary level and the upper boundary level. The flux, F, + ! is the amount of var_zt flowing normal through the boundary per unit + ! time per unit surface area. The derivative of the flux effects the + ! time-tendency of var_zt, such that: + ! + ! d(var_zt)/dt = -dF/dz. + ! + ! For the 2nd-order eddy-diffusion term, +d[(K_zm+nu)*d(var_zt)/dz]/dz, + ! the flux is: + ! + ! F = -(K_zm+nu)*d(var_zt)/dz. + ! + ! In order to have zero-flux boundary conditions, the derivative of + ! var_zt, d(var_zt)/dz, needs to equal 0 at both the lower boundary and + ! the upper boundary. + ! + ! In order to discretize the lower boundary condition, consider a new + ! level outside the model (thermodynamic level 0) just below the lower + ! boundary level (thermodynamic level 1). The value of var_zt at the + ! level just outside the model is defined to be the same as the value of + ! var_zt at the lower boundary level. Therefore, the value of + ! d(var_zt)/dz between the level just outside the model and the lower + ! boundary level is 0, satisfying the zero-flux boundary condition. The + ! other value for d(var_zt)/dz (between thermodynamic level 2 and + ! thermodynamic level 1) is taken over the intermediate momentum level + ! (momentum level 1), where it is multiplied by the factor + ! ( K_zm(1) + nu ). Then, the derivative of the whole expression is + ! taken over the central thermodynamic level. + ! + ! -var_zt(2)-------------------------------------------- t(2) + ! + ! ==========d(var_zt)/dz==(K_zm(1)+nu)================== m(1) + ! + ! -var_zt(1)---------------d[(K_zm+nu)*d(var_zt)/dz]/dz- t(1) Boundary + ! + ! [d(var_zt)/dz = 0] + ! + ! -[var_zt(0) = var_zt(1)]-----(level outside model)---- t(0) + ! + ! The result is dependent only on values of K_zm found at momentum + ! level 1 and values of var_zt found at thermodynamic levels 1 and 2. + ! Thus, it only affects 2 diagonals on the left-hand side matrix. + ! + ! The same method can be used to discretize the upper boundary by + ! considering a new level outside the model just above the upper boundary + ! level. + ! + ! 2) Fixed-point boundary conditions. + ! Many equations in the model use fixed-point boundary conditions rather + ! than zero-flux boundary conditions. This means that the value of + ! var_zt stays the same over the course of the timestep at the lower + ! boundary, as well as at the upper boundary. + ! + ! In order to discretize the boundary conditions for equations requiring + ! fixed-point boundary conditions, either: + ! a) in the parent subroutine or function (that calls this function), + ! loop over all vertical levels from the second-lowest to the + ! second-highest, ignoring the boundary levels. Then set the values + ! at the boundary levels in the parent subroutine; or + ! b) in the parent subroutine or function, loop over all vertical levels + ! and then overwrite the results at the boundary levels. + ! + ! Either way, at the boundary levels, an array with a value of 1 at the + ! main diagonal on the left-hand side and with values of 0 at all other + ! diagonals on the left-hand side will preserve the right-hand side value + ! at that level, thus satisfying the fixed-point boundary conditions. + ! + ! + ! Conservation Properties: + ! + ! When zero-flux boundary conditions are used, this technique of + ! discretizing the eddy diffusion term leads to conservative differencing. + ! When conservative differencing is in place, the column totals for each + ! column in the left-hand side matrix (for the eddy diffusion term) should + ! be equal to 0. This ensures that the total amount of the quantity var_zt + ! over the entire vertical domain is being conserved, meaning that nothing + ! is lost due to diffusional effects. + ! + ! To see that this conservation law is satisfied, compute the eddy diffusion + ! of var_zt and integrate vertically. In discretized matrix notation (where + ! "i" stands for the matrix column and "j" stands for the matrix row): + ! + ! 0 = Sum_j Sum_i ( 1/invrs_dzt )_i + ! ( invrs_dzt * ((K_zm+nu)*invrs_dzm) )_ij (var_zt)_j. + ! + ! The left-hand side matrix, ( invrs_dzt * ((K_zm+nu)*invrs_dzm) )_ij, is + ! partially written below. The sum over i in the above equation removes + ! invrs_dzt everywhere from the matrix below. The sum over j leaves the + ! column totals that are desired. + ! + ! Left-hand side matrix contributions from eddy diffusion term; first four + ! vertical levels: + ! + ! --------------------------------------------------------------------------> + !k=1 | +invrs_dzt(k) -invrs_dzt(k) 0 + ! | *(K_zm(k)+nu) *(K_zm(k)+nu) + ! | *invrs_dzm(k) *invrs_dzm(k) + ! | + !k=2 | -invrs_dzt(k) +invrs_dzt(k) -invrs_dzt(k) + ! | *(K_zm(k-1)+nu) *[ (K_zm(k)+nu) *(K_zm(k)+nu) + ! | *invrs_dzm(k-1) *invrs_dzm(k) *invrs_dzm(k) + ! | +(K_zm(k-1)+nu) + ! | *invrs_dzm(k-1) ] + ! | + !k=3 | 0 -invrs_dzt(k) +invrs_dzt(k) + ! | *(K_zm(k-1)+nu) *[ (K_zm(k)+nu) + ! | *invrs_dzm(k-1) *invrs_dzm(k) + ! | +(K_zm(k-1)+nu) + ! | *invrs_dzm(k-1) ] + ! | + !k=4 | 0 0 -invrs_dzt(k) + ! | *(K_zm(k-1)+nu) + ! | *invrs_dzm(k-1) + ! \ / + ! + ! Note: The superdiagonal term from level 3 and both the main diagonal and + ! superdiagonal terms from level 4 are not shown on this diagram. + ! + ! Note: The matrix shown is a tridiagonal matrix. For a band diagonal + ! matrix (with 5 diagonals), there would be an extra row between each + ! of the rows shown and an extra column between each of the columns + ! shown. However, for the purposes of the var_zt eddy diffusion + ! term, those extra row and column values are all 0, and the + ! conservation properties of the matrix aren't effected. + ! + ! If fixed-point boundary conditions are used, the matrix entries at + ! level 1 (k=1) read: 1 0 0; which means that conservative differencing + ! is not in play. The total amount of var_zt over the entire vertical + ! domain is not being conserved, as amounts of var_zt may be fluxed out + ! through the upper boundary or lower boundary through the effects of + ! diffusion. + ! + ! Brian Griffin. April 26, 2008. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + K_zm, & ! Coef. of eddy diffusivity at momentum level (k) [m^2/s] + K_zmm1, & ! Coef. of eddy diffusivity at momentum level (k-1) [m^2/s + invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] + invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] + invrs_dzmm1 ! Inverse of grid spacing over momentum level (k-1) [1/m] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + nu ! Background constant coef. of eddy diffusivity [m^2/s] + + integer, intent(in) :: & + level ! Thermodynamic level where calculation occurs. [-] + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + if ( level == 1 ) then + + ! k = 1 (bottom level); lower boundary level. + ! Only relevant if zero-flux boundary conditions are used. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) = - invrs_dzt * (K_zm+nu(1)) * invrs_dzm + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) = + invrs_dzt * (K_zm+nu(1)) * invrs_dzm + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) = 0.0_core_rknd + + + elseif ( level > 1 .and. level < gr%nz ) then + + ! Most of the interior model; normal conditions. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) = - invrs_dzt * (K_zm+nu(level)) * invrs_dzm + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) = + invrs_dzt * ( (K_zm+nu(level))*invrs_dzm & + + (K_zmm1+nu(level))*invrs_dzmm1 ) + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu(level)) * invrs_dzmm1 + + elseif ( level == gr%nz ) then + + ! k = gr%nz (top level); upper boundary level. + ! Only relevant if zero-flux boundary conditions are used. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) = + invrs_dzt * (K_zmm1+nu(gr%nz)) * invrs_dzmm1 + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu(gr%nz)) * invrs_dzmm1 + + + endif + + end function diffusion_zt_lhs + + !============================================================================= + pure function diffusion_cloud_frac_zt_lhs & + ( K_zm, K_zmm1, cloud_frac_zt, cloud_frac_ztm1, & + cloud_frac_ztp1, cloud_frac_zm, & + cloud_frac_zmm1, & + nu, invrs_dzmm1, invrs_dzm, invrs_dzt, level ) & + result( lhs ) + + ! Description: + ! This function adds a weight of cloud fraction to the existing diffusion + ! function for number concentration variables (e.g. cloud droplet number + ! concentration). This code should be considered experimental and may + ! contain bugs. + ! References: + ! This algorithm uses equations derived from Guo, et al. 2009. + !----------------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: min + + ! Constant parameters + real( kind = core_rknd ), parameter :: & + cf_ratio = 10._core_rknd ! Maximum cloud-fraction coefficient applied to Kh_zm + + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + K_zm, & ! Coef. of eddy diffusivity at mom. level (k) [m^2/s] + K_zmm1, & ! Coef. of eddy diffusivity at mom. level (k-1) [m^2/s] + cloud_frac_zt, & ! Cloud fraction at the thermo. level (k) [-] + cloud_frac_ztm1, & ! Cloud fraction at the thermo. level (k-1) [-] + cloud_frac_ztp1, & ! Cloud fraction at the thermo. level (k+1) [-] + cloud_frac_zm, & ! Cloud fraction at the momentum level (k) [-] + cloud_frac_zmm1, & ! Cloud fraction at the momentum level (k-1) [-] + invrs_dzt, & ! Inverse of grid spacing over thermo. lev. (k) [1/m] + invrs_dzm, & ! Inverse of grid spacing over mom. level (k) [1/m] + invrs_dzmm1 ! Inverse of grid spacing over mom. level (k-1) [1/m] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + nu ! Background constant coef. of eddy diffusivity [m^2/s] + + integer, intent(in) :: & + level ! Thermodynamic level where calculation occurs. [-] + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + ! ---- Begin Code ---- + + if ( level == 1 ) then + + ! k = 1 (bottom level); lower boundary level. + ! Only relevant if zero-flux boundary conditions are used. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] +! lhs(kp1_tdiag) = - invrs_dzt & +! * (K_zm+nu) & +! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm + lhs(kp1_tdiag) = - invrs_dzt & + * (K_zm & + * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & + + nu(1)) * invrs_dzm + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] +! lhs(k_tdiag) = + invrs_dzt & +! * (K_zm+nu) & +! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm + lhs(k_tdiag) = + invrs_dzt & + * (K_zm & + * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & + + nu(1)) * invrs_dzm + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) = 0.0_core_rknd + + + else if ( level > 1 .and. level < gr%nz ) then + + ! Most of the interior model; normal conditions. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] +! lhs(kp1_tdiag) = - invrs_dzt & +! * (K_zm+nu) & +! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm +! lhs(kp1_tdiag) = - invrs_dzt & +! * (K_zm & +! * ( cloud_frac_zm / cloud_frac_ztp1 ) & +! + nu ) * invrs_dzm + lhs(kp1_tdiag) = - invrs_dzt & + * (K_zm & + * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & + + nu(level) ) * invrs_dzm + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] +! lhs(k_tdiag) = + invrs_dzt & +! * ( ((K_zm+nu)*cloud_frac_zm)*invrs_dzm & +! + ((K_zmm1+nu)*cloud_frac_zmm1)*invrs_dzmm1 ) & +! / cloud_frac_zt +! lhs(k_tdiag) = + invrs_dzt & +! * ( nu*(invrs_dzm+invrs_dzmm1) + & +! ( ((K_zm*cloud_frac_zm)*invrs_dzm + +! (K_zmm1*cloud_frac_zmm1)*invrs_dzmm1)& +! / cloud_frac_zt & +! ) & +! ) + lhs(k_tdiag) = + invrs_dzt & + * ( nu(level)*(invrs_dzm+invrs_dzmm1) + & + ( K_zm*invrs_dzm* & + min( cloud_frac_zm / cloud_frac_zt, & + cf_ratio ) & + + K_zmm1*invrs_dzmm1* & + min( cloud_frac_zmm1 / cloud_frac_zt, & + cf_ratio ) & + ) & + ) + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] +! lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu) * & +! ( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 + lhs(km1_tdiag) = - invrs_dzt & + * (K_zmm1 & + * min( cloud_frac_zmm1 / cloud_frac_ztm1, & + cf_ratio ) & + + nu(level) ) * invrs_dzmm1 + + else if ( level == gr%nz ) then + + ! k = gr%nz (top level); upper boundary level. + ! Only relevant if zero-flux boundary conditions are used. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] +! lhs(k_tdiag) = + invrs_dzt & +! *(K_zmm1+nu) & +! *( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 + lhs(k_tdiag) = + invrs_dzt & + * (K_zmm1 & + * min( cloud_frac_zmm1 / cloud_frac_ztm1, & + cf_ratio ) & + + nu(gr%nz)) * invrs_dzmm1 + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] +! lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu) * & +! ( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 + lhs(km1_tdiag) = - invrs_dzt & + * (K_zmm1 & + * min( cloud_frac_zmm1 / cloud_frac_ztm1, & + cf_ratio ) & + + nu(gr%nz)) * invrs_dzmm1 + + end if + + return + end function diffusion_cloud_frac_zt_lhs + + !============================================================================= + pure function diffusion_zm_lhs( K_zt, K_ztp1, nu, & + invrs_dztp1, invrs_dzt, & + invrs_dzm, level ) & + result( lhs ) + + ! Description: + ! Vertical eddy diffusion of var_zm: implicit portion of the code. + ! + ! The variable "var_zm" stands for a variable that is located at momentum + ! grid levels. + ! + ! The d(var_zm)/dt equation contains an eddy diffusion term: + ! + ! + d [ ( K_zt + nu ) * d(var_zm)/dz ] / dz. + ! + ! This term is usually solved for completely implicitly, such that: + ! + ! + d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. + ! + ! However, when a Crank-Nicholson scheme is used, the eddy diffusion term + ! has both implicit and explicit components, such that: + ! + ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz + ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t) )/dz ] / dz; + ! + ! for which the implicit component is: + ! + ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. + ! + ! Note: When the implicit term is brought over to the left-hand side, + ! the sign is reversed and the leading "+" in front of the term + ! is changed to a "-". + ! + ! Timestep index (t) stands for the index of the current timestep, while + ! timestep index (t+1) stands for the index of the next timestep, which is + ! being advanced to in solving the d(var_zm)/dt equation. + ! + ! The implicit portion of this term is discretized as follows: + ! + ! The values of var_zm are found on the momentum levels, while the values of + ! K_zt are found on the thermodynamic levels. The derivatives (d/dz) of + ! var_zm are taken over the intermediate thermodynamic levels. At the + ! intermediate thermodynamic levels, d(var_zm)/dz is multiplied by + ! ( K_zt + nu ). Then, the derivative of the whole mathematical expression + ! is taken over the central momentum level, which yields the desired result. + ! + ! ==var_zmp1=============================================== m(k+1) + ! + ! ----------d(var_zm)/dz--(K_ztp1+nu)---------------------- t(k+1) + ! + ! ==var_zm===================d[(K_zt+nu)*d(var_zm)/dz]/dz== m(k) + ! + ! ----------d(var_zm)/dz--(K_zt+nu)------------------------ t(k) + ! + ! ==var_zmm1=============================================== m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + ! invrs_dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! + ! Note: This function only computes the general implicit form: + ! + d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. + ! For a Crank-Nicholson scheme, the left-hand side result of this + ! function will have to be multiplied by (1/2). For a + ! Crank-Nicholson scheme, the right-hand side (explicit) component + ! needs to be computed by multiplying the left-hand side results by + ! (1/2), reversing the sign on each left-hand side element, and then + ! multiplying each element by the appropriate var_zm(t) value from + ! the appropriate vertical level. + ! + ! + ! Boundary Conditions: + ! + ! 1) Zero-flux boundary conditions. + ! This function is set up to use zero-flux boundary conditions at both + ! the lower boundary level and the upper boundary level. The flux, F, + ! is the amount of var_zm flowing normal through the boundary per unit + ! time per unit surface area. The derivative of the flux effects the + ! time-tendency of var_zm, such that: + ! + ! d(var_zm)/dt = -dF/dz. + ! + ! For the 2nd-order eddy-diffusion term, +d[(K_zt+nu)*d(var_zm)/dz]/dz, + ! the flux is: + ! + ! F = -(K_zt+nu)*d(var_zm)/dz. + ! + ! In order to have zero-flux boundary conditions, the derivative of + ! var_zm, d(var_zm)/dz, needs to equal 0 at both the lower boundary and + ! the upper boundary. + ! + ! In order to discretize the lower boundary condition, consider a new + ! level outside the model (momentum level 0) just below the lower + ! boundary level (momentum level 1). The value of var_zm at the level + ! just outside the model is defined to be the same as the value of var_zm + ! at the lower boundary level. Therefore, the value of d(var_zm)/dz + ! between the level just outside the model and the lower boundary level + ! is 0, satisfying the zero-flux boundary condition. The other value for + ! d(var_zm)/dz (between momentum level 2 and momentum level 1) is taken + ! over the intermediate thermodynamic level (thermodynamic level 2), + ! where it is multiplied by the factor ( K_zt(2) + nu ). Then, the + ! derivative of the whole expression is taken over the central momentum + ! level. + ! + ! =var_zm(2)============================================ m(2) + ! + ! ----------d(var_zm)/dz==(K_zt(2)+nu)------------------ t(2) + ! + ! =var_zm(1)===============d[(K_zt+nu)*d(var_zm)/dz]/dz= m(1) Boundary + ! + ! ----------[d(var_zm)/dz = 0]-------------------------- t(1) + ! + ! =[var_zm(0) = var_zm(1)]=====(level outside model)==== m(0) + ! + ! The result is dependent only on values of K_zt found at thermodynamic + ! level 2 and values of var_zm found at momentum levels 1 and 2. Thus, + ! it only affects 2 diagonals on the left-hand side matrix. + ! + ! The same method can be used to discretize the upper boundary by + ! considering a new level outside the model just above the upper boundary + ! level. + ! + ! 2) Fixed-point boundary conditions. + ! Many equations in the model use fixed-point boundary conditions rather + ! than zero-flux boundary conditions. This means that the value of + ! var_zm stays the same over the course of the timestep at the lower + ! boundary, as well as at the upper boundary. + ! + ! In order to discretize the boundary conditions for equations requiring + ! fixed-point boundary conditions, either: + ! a) in the parent subroutine or function (that calls this function), + ! loop over all vertical levels from the second-lowest to the + ! second-highest, ignoring the boundary levels. Then set the values + ! at the boundary levels in the parent subroutine; or + ! b) in the parent subroutine or function, loop over all vertical levels + ! and then overwrite the results at the boundary levels. + ! + ! Either way, at the boundary levels, an array with a value of 1 at the + ! main diagonal on the left-hand side and with values of 0 at all other + ! diagonals on the left-hand side will preserve the right-hand side value + ! at that level, thus satisfying the fixed-point boundary conditions. + ! + ! + ! Conservation Properties: + ! + ! When zero-flux boundary conditions are used, this technique of + ! discretizing the eddy diffusion term leads to conservative differencing. + ! When conservative differencing is in place, the column totals for each + ! column in the left-hand side matrix (for the eddy diffusion term) should + ! be equal to 0. This ensures that the total amount of the quantity var_zm + ! over the entire vertical domain is being conserved, meaning that nothing + ! is lost due to diffusional effects. + ! + ! To see that this conservation law is satisfied, compute the eddy diffusion + ! of var_zm and integrate vertically. In discretized matrix notation (where + ! "i" stands for the matrix column and "j" stands for the matrix row): + ! + ! 0 = Sum_j Sum_i ( 1/invrs_dzm )_i + ! ( invrs_dzm * ((K_zt+nu)*invrs_dzt) )_ij (var_zm)_j. + ! + ! The left-hand side matrix, ( invrs_dzm * ((K_zt+nu)*invrs_dzt) )_ij, is + ! partially written below. The sum over i in the above equation removes + ! invrs_dzm everywhere from the matrix below. The sum over j leaves the + ! column totals that are desired. + ! + ! Left-hand side matrix contributions from eddy diffusion term; first four + ! vertical levels: + ! + ! ----------------------------------------------------------------------> + !k=1 | +invrs_dzm(k) -invrs_dzm(k) 0 + ! | *(K_zt(k+1)+nu) *(K_zt(k+1)+nu) + ! | *invrs_dzt(k+1) *invrs_dzt(k+1) + ! | + !k=2 | -invrs_dzm(k) +invrs_dzm(k) -invrs_dzm(k) + ! | *(K_zt(k)+nu) *[ (K_zt(k+1)+nu) *(K_zt(k+1)+nu) + ! | *invrs_dzt(k) *invrs_dzt(k+1) *invrs_dzt(k+1) + ! | +(K_zt(k)+nu) + ! | *invrs_dzt(k) ] + ! | + !k=3 | 0 -invrs_dzm(k) +invrs_dzm(k) + ! | *(K_zt(k)+nu) *[ (K_zt(k+1)+nu) + ! | *invrs_dzt(k) *invrs_dzt(k+1) + ! | +(K_zt(k)+nu) + ! | *invrs_dzt(k) ] + ! | + !k=4 | 0 0 -invrs_dzm(k) + ! | *(K_zt(k)+nu) + ! | *invrs_dzt(k) + ! \ / + ! + ! Note: The superdiagonal term from level 3 and both the main diagonal and + ! superdiagonal terms from level 4 are not shown on this diagram. + ! + ! Note: The matrix shown is a tridiagonal matrix. For a band diagonal + ! matrix (with 5 diagonals), there would be an extra row between each + ! of the rows shown and an extra column between each of the columns + ! shown. However, for the purposes of the var_zm eddy diffusion + ! term, those extra row and column values are all 0, and the + ! conservation properties of the matrix aren't effected. + ! + ! If fixed-point boundary conditions are used, the matrix entries at + ! level 1 (k=1) read: 1 0 0; which means that conservative differencing + ! is not in play. The total amount of var_zm over the entire vertical + ! domain is not being conserved, as amounts of var_zm may be fluxed out + ! through the upper boundary or lower boundary through the effects of + ! diffusion. + ! + ! Brian Griffin. April 26, 2008. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + K_zt, & ! Coef. of eddy diffusivity at thermo. level (k) [m^2/s] + K_ztp1, & ! Coef. of eddy diffusivity at thermo. level (k+1) [m^2/s] + invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] + invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] + invrs_dztp1 ! Inverse of grid spacing over thermo. level (k+1) [1/m] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + nu ! Background constant coef. of eddy diffusivity [m^2/s] + + integer, intent(in) :: & + level ! Momentum level where calculation occurs. [-] + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + if ( level == 1 ) then + + ! k = 1; lower boundary level at surface. + ! Only relevant if zero-flux boundary conditions are used. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) = - invrs_dzm * (K_ztp1+nu(2)) * invrs_dztp1 + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) = + invrs_dzm * (K_ztp1+nu(2)) * invrs_dztp1 + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) = 0.0_core_rknd + + + elseif ( level > 1 .and. level < gr%nz ) then + + ! Most of the interior model; normal conditions. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) = - invrs_dzm * (K_ztp1+nu(level+1)) * invrs_dztp1 + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) = + invrs_dzm * ( (K_ztp1+nu(level+1))*invrs_dztp1 & + + (K_zt+nu(level))*invrs_dzt ) + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) = - invrs_dzm * (K_zt+nu(level)) * invrs_dzt + + + elseif ( level == gr%nz ) then + + ! k = gr%nz (top level); upper boundary level. + ! Only relevant if zero-flux boundary conditions are used. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) = + invrs_dzm * (K_zt+nu(gr%nz)) * invrs_dzt + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) = - invrs_dzm * (K_zt+nu(gr%nz)) * invrs_dzt + + + endif + + end function diffusion_zm_lhs + +!=============================================================================== + +end module crmx_diffusion diff --git a/src/physics/spcam/crm/CLUBB/crmx_endian.F90 b/src/physics/spcam/crm/CLUBB/crmx_endian.F90 new file mode 100644 index 0000000000..6886f158a1 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_endian.F90 @@ -0,0 +1,173 @@ +!---------------------------------------------------------------------- +! $Id: endian.F90 3784 2009-07-14 21:29:16Z dschanen@uwm.edu $ + +!---------------------------------------------------------------------- +module crmx_endian + +! Description: +! big_endian and little_endian are parameters set at compile time +! based on whether the architecture is big or little endian. + +! native_4byte_real is a portable byte re-ordering subroutine +! native_8byte_real is a knock off of the other routine for 8 bytes +! References: +! big_endian, little_endian from: +! +!---------------------------------------------------------------------- + + implicit none + + interface byte_order_swap + module procedure native_4byte_real, native_8byte_real + end interface + + public :: big_endian, little_endian, byte_order_swap + private :: native_4byte_real, native_8byte_real + + private ! Default scope + ! External + intrinsic :: selected_int_kind, ichar, transfer + + ! Parameters + integer, parameter :: & + i4 = 4, & ! 4 byte long integer + ich = ichar( transfer( 1_i4, "a" ) ) + + logical, parameter :: & + big_endian = ich == 0, & + little_endian = .not. big_endian + + contains + +!------------------------------------------------------------------------------- +! SUBPROGRAM: native_4byte_real +! +! AUTHOR: David Stepaniak, NCAR/CGD/CAS +! DATE INITIATED: 29 April 2003 +! LAST MODIFIED: 19 April 2005 +! +! SYNOPSIS: Converts a 32 bit, 4 byte, REAL from big Endian to +! little Endian, or conversely from little Endian to big +! Endian. +! +! DESCRIPTION: This subprogram allows one to convert a 32 bit, 4 byte, +! REAL data element that was generated with, say, a big +! Endian processor (e.g. Sun/sparc, SGI/R10000, etc.) to its +! equivalent little Endian representation for use on little +! Endian processors (e.g. PC/Pentium running Linux). The +! converse, little Endian to big Endian, also holds. +! This conversion is accomplished by writing the 32 bits of +! the REAL data element into a generic 32 bit INTEGER space +! with the TRANSFER intrinsic, reordering the 4 bytes with +! the MVBITS intrinsic, and writing the reordered bytes into +! a new 32 bit REAL data element, again with the TRANSFER +! intrinsic. The following schematic illustrates the +! reordering process +! +! +! -------- -------- -------- -------- +! | D | | C | | B | | A | 4 Bytes +! -------- -------- -------- -------- +! | +! -> 1 bit +! || +! MVBITS +! || +! \/ +! +! -------- -------- -------- -------- +! | A | | B | | C | | D | 4 Bytes +! -------- -------- -------- -------- +! | | | | +! 24 16 8 0 <- bit +! position +! +! INPUT: realIn, a single 32 bit, 4 byte REAL data element. +! OUTPUT: realOut, a single 32 bit, 4 byte REAL data element, with +! reverse byte order to that of realIn. +! RESTRICTION: It is assumed that the default REAL data element is +! 32 bits / 4 bytes. +! +!----------------------------------------------------------------------- + SUBROUTINE native_4byte_real( realInOut ) + + IMPLICIT NONE + + REAL(KIND=4), INTENT(INOUT):: realInOut ! a single 32 bit, 4 byte + ! REAL data element +! Modified 8/1/05 +! I found transfer does not work on pgf90 when -r8 is used and the mold +! is a literal constant real; Changed the mold "0.0" to "readInOut" +! -dschanen +! +! REAL, INTENT(IN):: realInOut +! REAL, INTENT(OUT) :: realOut +! ! a single 32 bit, 4 byte +! ! REAL data element, with +! ! reverse byte order to +! ! that of realIn +!---------------------------------------------------------------------- +! Local variables (generic 32 bit INTEGER spaces): + + INTEGER(KIND=4) :: i_element + INTEGER(KIND=4) :: i_element_br +!---------------------------------------------------------------------- +! Transfer 32 bits of realIn to generic 32 bit INTEGER space: + i_element = TRANSFER( realInOut, i_element ) +!---------------------------------------------------------------------- +! Reverse order of 4 bytes in 32 bit INTEGER space: + CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) + CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) + CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) + CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) +!---------------------------------------------------------------------- +! Transfer reversed order bytes to 32 bit REAL space (realOut): + realInOut = TRANSFER( i_element_br, realInOut ) + + RETURN + END SUBROUTINE native_4byte_real + +!------------------------------------------------------------------------------- + subroutine native_8byte_real( realInOut ) + +! Description: +! This is just a modification of the above routine for 64 bit data +!------------------------------------------------------------------------------- + + implicit none + + ! External + intrinsic :: mvbits, transfer + + real(kind=8), intent(inout) :: realInOut ! a single 64 bit, 8 byte + ! REAL data element + ! Local variables (generic 64 bit INTEGER spaces): + + integer(kind=8) :: i_element + integer(kind=8) :: i_element_br + +!------------------------------------------------------------------------------- + + ! Transfer 64 bits of realIn to generic 64 bit INTEGER space: + i_element = transfer( realInOut, i_element ) + + ! Reverse order of 8 bytes in 64 bit INTEGER space: + call mvbits( i_element, 56, 8, i_element_br, 0 ) + call mvbits( i_element, 48, 8, i_element_br, 8 ) + call mvbits( i_element, 40, 8, i_element_br, 16 ) + call mvbits( i_element, 32, 8, i_element_br, 24 ) + call mvbits( i_element, 24, 8, i_element_br, 32 ) + call mvbits( i_element, 16, 8, i_element_br, 40 ) + call mvbits( i_element, 8, 8, i_element_br, 48 ) + call mvbits( i_element, 0, 8, i_element_br, 56 ) + + ! Transfer reversed order bytes to 64 bit REAL space (realOut): + realInOut = transfer( i_element_br, realInOut ) + + return + end subroutine native_8byte_real +!------------------------------------------------------------------------------- + +end module crmx_endian + +!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 b/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 new file mode 100644 index 0000000000..bddf1c39b2 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 @@ -0,0 +1,227 @@ +!------------------------------------------------------------------------------- +! $Id: error_code.F90 5906 2012-08-10 23:20:05Z dschanen@uwm.edu $ +!------------------------------------------------------------------------------- + +module crmx_error_code + +! Description: +! Since f90/95 lacks enumeration, we're stuck numbering each +! error code by hand like this. + +! We are "enumerating" error codes to be used with CLUBB. Adding +! additional codes is as simple adding an additional integer +! parameter. The error codes are ranked by severity, the higher +! number being more servere. When two errors occur, assign the +! most servere to the output. + +! This code also handles subroutines related to debug_level. See +! the 'set_clubb_debug_level' description for more detail. + +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + private ! Default Scope + + public :: & + reportError, & + fatal_error, & + lapack_error, & + clubb_at_least_debug_level, & + set_clubb_debug_level, & + clubb_debug + + private :: clubb_debug_level + + ! Model-Wide Debug Level + integer, save :: clubb_debug_level = 0 + +!$omp threadprivate(clubb_debug_level) + + ! Error Code Values + integer, parameter, public :: & + clubb_no_error = 0, & + clubb_var_less_than_zero = 1, & + clubb_var_equals_NaN = 2, & + clubb_singular_matrix = 3, & + clubb_bad_lapack_arg = 4, & + clubb_rtm_level_not_found = 5, & + clubb_var_out_of_bounds = 6, & + clubb_var_out_of_range = 7 + + contains + +!------------------------------------------------------------------------------- + subroutine reportError( err_code ) +! +! Description: +! Reports meaning of error code to console. +! +!------------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + implicit none + + ! Input Variable + integer, intent(in) :: err_code ! Error Code being examined + + ! ---- Begin Code ---- + + select case ( err_code ) + + case ( clubb_no_error ) + write(fstderr,*) "No errors reported." + + case ( clubb_var_less_than_zero ) + write(fstderr,*) "Variable in CLUBB is less than zero." + + case ( clubb_singular_matrix ) + write(fstderr,*) "Singular Matrix in CLUBB." + + case ( clubb_var_equals_NaN ) + write(fstderr,*) "Variable in CLUBB is NaN." + + case ( clubb_bad_lapack_arg ) + write(fstderr,*) "Argument passed to a LAPACK procedure is invalid." + + case ( clubb_rtm_level_not_found ) + write(fstderr,*) "rtm level not found" + + case ( clubb_var_out_of_bounds ) + write(fstderr,*) "Input variable is out of bounds." + + case ( clubb_var_out_of_range ) + write(fstderr,*) "A CLUBB variable had a value outside the valid range." + + case default + write(fstderr,*) "Unknown error: ", err_code + + end select + + return + end subroutine reportError +!------------------------------------------------------------------------------- + elemental function lapack_error( err_code ) +! +! Description: +! Checks to see if the err_code is equal to one +! caused by an error encountered using LAPACK. +! Reference: +! None +!------------------------------------------------------------------------------- + implicit none + + ! Input variable + integer,intent(in) :: err_code ! Error Code being examined + + ! Output variable + logical :: lapack_error + + ! ---- Begin Code ---- + + lapack_error = (err_code == clubb_singular_matrix .or. & + err_code == clubb_bad_lapack_arg ) + + return + end function lapack_error + +!------------------------------------------------------------------------------- + elemental function fatal_error( err_code ) +! +! Description: Checks to see if the err_code is one that usually +! causes an exit in other parts of CLUBB. +! References: +! None +!------------------------------------------------------------------------------- + implicit none + + ! Input Variable + integer, intent(in) :: err_code ! Error Code being examined + + ! Output variable + logical :: fatal_error + + ! ---- Begin Code ---- + + fatal_error = err_code /= clubb_no_error .and. & + err_code /= clubb_var_less_than_zero + return + end function fatal_error + +!------------------------------------------------------------------ + logical function clubb_at_least_debug_level( level ) +! +! Description: +! Checks to see if clubb has been set to a specified debug level +!------------------------------------------------------------------ + implicit none + + ! Input variable + integer, intent(in) :: level ! The debug level being checked against the current setting + + ! ---- Begin Code ---- + + clubb_at_least_debug_level = ( level <= clubb_debug_level ) + + return + end function clubb_at_least_debug_level + +!------------------------------------------------------------------------------- + subroutine set_clubb_debug_level( level ) +! +! Description: +! Accessor for clubb_debug_level +! +! 0 => Print no debug messages to the screen +! 1 => Print lightweight debug messages, e.g. print statements +! 2 => Print debug messages that require extra testing, +! e.g. checks for NaNs and spurious negative values. +! References: +! None +!------------------------------------------------------------------------------- + implicit none + + ! Input variable + integer, intent(in) :: level ! The debug level being checked against the current setting + + ! ---- Begin Code ---- + + clubb_debug_level = level + + return + end subroutine set_clubb_debug_level + +!------------------------------------------------------------------------------- + subroutine clubb_debug( level, str ) +! +! Description: +! Prints a message to file unit fstderr if the level is greater +! than or equal to the current debug level. +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + implicit none + + ! Input Variable(s) + + character(len=*), intent(in) :: str ! The message being reported + + ! The debug level being checked against the current setting + integer, intent(in) :: level + + ! ---- Begin Code ---- + + if ( level <= clubb_debug_level ) then + write(fstderr,*) str + end if + + return + end subroutine clubb_debug + +end module crmx_error_code +!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 b/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 new file mode 100644 index 0000000000..38c4837bd9 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 @@ -0,0 +1,90 @@ +!$Id: extrapolation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_extrapolation + + implicit none + + public :: lin_ext_zm_bottom, lin_ext_zt_bottom + + private ! Default scope + + contains +!=============================================================================== + pure function lin_ext_zm_bottom( var_zmp2, var_zmp1, & + zmp2, zmp1, zm ) & + result( var_zm ) + + ! Description: + ! This function computes the value of a momentum-level variable at a bottom + ! grid level by using a linear extension of the values of the variable at + ! the two levels immediately above the level where the result value is + ! needed. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + var_zmp2, & ! Momentum level variable at level (k+2) [units vary] + var_zmp1, & ! Momentum level variable at level (k+1) [units vary] + zmp2, & ! Altitude at momentum level (k+2) [m] + zmp1, & ! Altitude at momentum level (k+1) [m] + zm ! Altitude at momentum level (k) [m] + + ! Return Variable + real( kind = core_rknd ) :: var_zm ! Momentum level variable at level (k) [units vary] + + ! ---- Begin Code ----- + + var_zm = ( ( var_zmp2 - var_zmp1 ) / ( zmp2 - zmp1 ) ) & + * ( zm - zmp1 ) + var_zmp1 + + return + end function lin_ext_zm_bottom + +!=============================================================================== + pure function lin_ext_zt_bottom( var_ztp2, var_ztp1, & + ztp2, ztp1, zt ) & + result( var_zt ) + + ! Description: + ! This function computes the value of a thermodynamic-level variable at a + ! bottom grid level by using a linear extension of the values of the + ! variable at the two levels immediately above the level where the result + ! value is needed. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + var_ztp2, & ! Thermodynamic level variable at level (k+2) [units vary] + var_ztp1, & ! Thermodynamic level variable at level (k+1) [units vary] + ztp2, & ! Altitude at thermodynamic level (k+2) [m] + ztp1, & ! Altitude at thermodynamic level (k+1) [m] + zt ! Altitude at thermodynamic level (k) [m] + + ! Return Variable + real( kind = core_rknd ) :: var_zt ! Thermodynamic level variable at level (k) [units vary] + + ! ---- Begin Code ----- + + var_zt = ( ( var_ztp2 - var_ztp1 ) / ( ztp2 - ztp1 ) ) & + * ( zt - ztp1 ) + var_ztp1 + + return + end function lin_ext_zt_bottom + +end module crmx_extrapolation diff --git a/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 b/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 new file mode 100644 index 0000000000..82d1eb1d10 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 @@ -0,0 +1,156 @@ +!----------------------------------------------------------------------- +! $Id: file_functions.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_file_functions + + implicit none + + public :: file_read_1d, file_read_2d + + private ! Default Scope + + contains + +!=============================================================================== + subroutine file_read_1d( file_unit, path_and_filename, & + num_datapts, entries_per_line, variable ) + +! Description: +! This subroutine reads in values from a data file with a number of +! rows and a declared number of columns (entries_per_line) of data. +! It reads in the data in the form of: +! 1 ==> (row 1, column 1); 2 ==> (row 1, column 2); etc. +! +! Example: a diagram of a data file with 18 total data points +! (DP1 to DP18), with 4 data points per row. +! +! i = 1 i = 2 i = 3 i = 4 +! --------------------------------------- +! k = 1 | DP1 DP2 DP3 DP4 +! | +! k = 2 | DP5 DP6 DP7 DP8 +! | +! k = 3 | DP9 DP10 DP11 DP12 +! | +! k = 4 | DP13 DP14 DP15 DP16 +! | +! k = 5 | DP17 DP18 +! +! See Michael Falk's comments below for more information. +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: fstderr ! Constant(s) + + implicit none + + integer, intent(in) :: & + file_unit, & ! Unit number of file being read. + num_datapts, & ! Total number of data points being read in. + entries_per_line ! Number of data points + ! on one line of the file being read. + + character(*), intent(in) :: & + path_and_filename ! Path to file and filename of file being read. + + real( kind = core_rknd ), dimension(num_datapts), intent(out) :: & + variable ! Data values output into variable + + integer :: k ! Data file row number. + integer :: i ! Data file column number. + integer :: ierr + + ! ---- Begin Code ---- + + ! Open data file. + open( unit=file_unit, file=path_and_filename, action='read', status='old', & + iostat=ierr ) + if ( ierr /= 0 ) then + write(fstderr,*) "CLUBB encountered an error trying to open "//path_and_filename + stop "Error opening forcings file" + end if + + ! Michael Falk wrote this routine to read data files in a particular format for mpace_a. + ! Each line has a specific number of values, until the last line in the file, which + ! has the last few values and then ends. This reads the correct number of values on + ! each line. 24 September 2007 + + ! Loop over each full line of the input file. + do k = 1, (num_datapts/entries_per_line), 1 + read(file_unit,*) ( variable( ((k-1)*entries_per_line) + i ), & + i=1,entries_per_line ) + enddo + ! Read any partial line remaining. + if ( mod(num_datapts,entries_per_line) /= 0 ) then + k = (num_datapts/entries_per_line) + read(file_unit,*) ( variable( (k*entries_per_line) + i ), & + i=1,(mod(num_datapts,entries_per_line)) ) + endif + + ! Close data file. + close( file_unit ) + + return + + end subroutine file_read_1d + +!=============================================================================== + subroutine file_read_2d( device, file_path, file_dimension1, & + file_dimension2, file_per_line, variable ) + +! Description: +! Michael Falk wrote this routine to read data files in a particular format for mpace_a. +! The 2d mpace_a files list the (file_dimension2) values on a given vertical level, then +! moves to the next level to list its values. +! Each line has a specific number of values, until the last line on a level, which +! is short-- it has the last few values and then a line break. The next line, beginning +! the next level, is full-sized again. 24 September 2007 +! +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + integer, intent(in) :: & + device, & + file_dimension1, & + file_dimension2, & + file_per_line + + character(*), intent(in) :: & + file_path + + real( kind = core_rknd ), dimension(file_dimension1,file_dimension2), intent(out) :: & + variable + + integer i, j, k + + ! ---- Begin Code ---- + + variable = -999._core_rknd ! Initialize to nonsense values + + open(device,file=file_path,action='read') + + do k=1,(file_dimension1) ! For each level in the data file, + do j=0,((file_dimension2/file_per_line)-1) + read(device,*) (variable(k,(j*file_per_line)+i), & ! read file_per_line values in, + i=1,file_per_line) + end do + read (device,*) (variable(k,(j*file_per_line)+i), & ! then read the partial line + i=1,(mod(file_dimension2,file_per_line))) + end do ! and then start over at the next level. + + close(device) + + return + end subroutine file_read_2d + +!=============================================================================== + +end module crmx_file_functions diff --git a/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 b/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 new file mode 100644 index 0000000000..8e17d3bc53 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 @@ -0,0 +1,487 @@ +!----------------------------------------------------------------------- +! $Id: fill_holes.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_fill_holes + + implicit none + + public :: fill_holes_driver, & + vertical_avg, & + vertical_integral + + private :: fill_holes_multiplicative + + private ! Set Default Scope + + contains + + !============================================================================= + subroutine fill_holes_driver( num_pts, threshold, field_grid, & + rho_ds, rho_ds_zm, & + field ) + + ! Description: + ! This subroutine clips values of 'field' that are below 'threshold' as much + ! as possible (i.e. "fills holes"), but conserves the total integrated mass + ! of 'field'. This prevents clipping from acting as a spurious source. + ! + ! Mass is conserved by reducing the clipped field everywhere by a constant + ! multiplicative coefficient. + ! + ! This subroutine does not guarantee that the clipped field will exceed + ! threshold everywhere; blunt clipping is needed for that. + + ! References: + ! ``Numerical Methods for Wave Equations in Geophysical Fluid + ! Dynamics'', Durran (1999), p. 292. + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: & + num_pts ! The number of points on either side of the hole; + ! Mass is drawn from these points to fill the hole. [] + + real( kind = core_rknd ), intent(in) :: & + threshold ! A threshold (e.g. w_tol*w_tol) below which field must not + ! fall [Units vary; same as field] + + character(len=2), intent(in) :: & + field_grid ! The grid of the field, either zt or zm + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + rho_ds, & ! Dry, static density on thermodynamic levels [kg/m^3] + rho_ds_zm ! Dry, static density on momentum levels [kg/m^3] + + ! Input/Output variable + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + field ! The field (e.g. wp2) that contains holes [Units same as threshold] + + ! Local Variables + integer :: & + k, & ! Loop index for absolute grid level [] + begin_idx, & ! Lower grid level of local hole-filling range [] + end_idx, & ! Upper grid level of local hole-filling range [] + upper_hf_level ! Upper grid level of global hole-filling range [] + + !----------------------------------------------------------------------- + + ! Check whether any holes exist in the entire profile. + ! The lowest level (k=1) should not be included, as the hole-filling scheme + ! should not alter the set value of 'field' at the surface (for momentum + ! level variables), or consider the value of 'field' at a level below the + ! surface (for thermodynamic level variables). For momentum level variables + ! only, the hole-filling scheme should not alter the set value of 'field' at + ! the upper boundary level (k=gr%nz). + + if ( field_grid == "zt" ) then + ! 'field' is on the zt (thermodynamic level) grid + upper_hf_level = gr%nz + elseif ( field_grid == "zm" ) then + ! 'field' is on the zm (momentum level) grid + upper_hf_level = gr%nz-1 + endif + + if ( any( field( 2:upper_hf_level ) < threshold ) ) then + + ! Make one pass up the profile, filling holes as much as we can using + ! nearby mass. + ! The lowest level (k=1) should not be included in the loop, as the + ! hole-filling scheme should not alter the set value of 'field' at the + ! surface (for momentum level variables), or consider the value of + ! 'field' at a level below the surface (for thermodynamic level + ! variables). For momentum level variables only, the hole-filling scheme + ! should not alter the set value of 'field' at the upper boundary + ! level (k=gr%nz). + do k = 2+num_pts, upper_hf_level-num_pts, 1 + + begin_idx = k - num_pts + end_idx = k + num_pts + + if ( any( field( begin_idx:end_idx ) < threshold ) ) then + + ! 'field' is on the zt (thermodynamic level) grid + if ( field_grid == "zt" ) then + call fill_holes_multiplicative & + ( begin_idx, end_idx, threshold, & + rho_ds(begin_idx:end_idx), gr%invrs_dzt(begin_idx:end_idx), & + field(begin_idx:end_idx) ) + + ! 'field' is on the zm (momentum level) grid + elseif ( field_grid == "zm" ) then + call fill_holes_multiplicative & + ( begin_idx, end_idx, threshold, & + rho_ds_zm(begin_idx:end_idx), gr%invrs_dzm(begin_idx:end_idx), & + field(begin_idx:end_idx) ) + endif + + endif + + enddo + + ! Fill holes globally, to maximize the chance that all holes are filled. + ! The lowest level (k=1) should not be included, as the hole-filling + ! scheme should not alter the set value of 'field' at the surface (for + ! momentum level variables), or consider the value of 'field' at a level + ! below the surface (for thermodynamic level variables). For momentum + ! level variables only, the hole-filling scheme should not alter the set + ! value of 'field' at the upper boundary level (k=gr%nz). + if ( any( field( 2:upper_hf_level ) < threshold ) ) then + + ! 'field' is on the zt (thermodynamic level) grid + if ( field_grid == "zt" ) then + call fill_holes_multiplicative & + ( 2, upper_hf_level, threshold, & + rho_ds(2:upper_hf_level), gr%invrs_dzt(2:upper_hf_level), & + field(2:upper_hf_level) ) + + ! 'field' is on the zm (momentum level) grid + elseif ( field_grid == "zm" ) then + call fill_holes_multiplicative & + ( 2, upper_hf_level, threshold, & + rho_ds_zm(2:upper_hf_level), gr%invrs_dzm(2:upper_hf_level), & + field(2:upper_hf_level) ) + endif + + endif + + endif ! End overall check for existence of holes + + return + + end subroutine fill_holes_driver + + !============================================================================= + subroutine fill_holes_multiplicative & + ( begin_idx, end_idx, threshold, & + rho, invrs_dz, & + field ) + + ! Description: + ! This subroutine clips values of 'field' that are below 'threshold' as much + ! as possible (i.e. "fills holes"), but conserves the total integrated mass + ! of 'field'. This prevents clipping from acting as a spurious source. + ! + ! Mass is conserved by reducing the clipped field everywhere by a constant + ! multiplicative coefficient. + ! + ! This subroutine does not guarantee that the clipped field will exceed + ! threshold everywhere; blunt clipping is needed for that. + + ! References: + ! ``Numerical Methods for Wave Equations in Geophysical Fluid + ! Dynamics", Durran (1999), p. 292. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: & + begin_idx, & ! The beginning index (e.g. k=2) of the range of hole-filling + end_idx ! The end index (e.g. k=gr%nz) of the range of hole-filling + + real( kind = core_rknd ), intent(in) :: & + threshold ! A threshold (e.g. w_tol*w_tol) below which field must not fall + ! [Units vary; same as field] + + real( kind = core_rknd ), dimension(end_idx-begin_idx+1), intent(in) :: & + rho, & ! Dry, static density on either thermodynamic or momentum levels [kg/m^3] + invrs_dz ! Reciprocal of thermodynamic or momentum level thickness depending on whether + ! we're on zt or zm grid. + + ! Input/Output variable + real( kind = core_rknd ), dimension(end_idx-begin_idx+1), intent(inout) :: & + field ! The field (e.g. wp2) that contains holes + ! [Units same as threshold] + + ! Local Variables + real( kind = core_rknd ), dimension(end_idx-begin_idx+1) :: & + field_clipped ! The raw field (e.g. wp2) that contains no holes + ! [Units same as threshold] + + real( kind = core_rknd ) :: & + field_avg, & ! Vertical average of field [Units of field] + field_clipped_avg, & ! Vertical average of clipped field [Units of field] + mass_fraction ! Coefficient that multiplies clipped field + ! in order to conserve mass. [] + + !----------------------------------------------------------------------- + + ! Compute the field's vertical average, which we must conserve. + field_avg = vertical_avg( (end_idx-begin_idx+1), rho, & + field, invrs_dz ) + + ! Clip small or negative values from field. + if ( field_avg >= threshold ) then + ! We know we can fill in holes completely + field_clipped = max( threshold, field ) + else + ! We can only fill in holes partly; + ! to do so, we remove all mass above threshold. + field_clipped = min( threshold, field ) + endif + + ! Compute the clipped field's vertical integral. + ! clipped_total_mass >= original_total_mass + field_clipped_avg = vertical_avg( (end_idx-begin_idx+1), rho, & + field_clipped, invrs_dz ) + + ! If the difference between the field_clipped_avg and the threshold is so + ! small that it falls within numerical round-off, return to the parent + ! subroutine without altering the field in order to avoid divide-by-zero + ! error. + !if ( abs(field_clipped_avg - threshold) & + ! < threshold*epsilon(threshold) ) then + if ( abs(field_clipped_avg - threshold) == 0.0_core_rknd ) then + return + endif + + ! Compute coefficient that makes the clipped field have the same mass as the + ! original field. We should always have mass_fraction > 0. + mass_fraction = ( field_avg - threshold ) / & + ( field_clipped_avg - threshold ) + + ! Output normalized, filled field + field = mass_fraction * ( field_clipped - threshold ) & + + threshold + + + return + + end subroutine fill_holes_multiplicative + + !============================================================================= + function vertical_avg( total_idx, rho_ds, & + field, invrs_dz ) + + ! Description: + ! Computes the density-weighted vertical average of a field. + ! + ! The average value of a function, f, over a set domain, [a,b], is + ! calculated by the equation: + ! + ! f_avg = ( INT(a:b) f*g ) / ( INT(a:b) g ); + ! + ! as long as f is continous and g is nonnegative and integrable. Therefore, + ! the density-weighted (by dry, static, base-static density) vertical + ! average value of any model field, x, is calculated by the equation: + ! + ! x_avg|_z = ( INT(z_bot:z_top) x rho_ds dz ) + ! / ( INT(z_bot:z_top) rho_ds dz ); + ! + ! where z_bot is the bottom of the vertical domain, and z_top is the top of + ! the vertical domain. + ! + ! This calculation is done slightly differently depending on whether x is a + ! thermodynamic-level or a momentum-level variable. + ! + ! Thermodynamic-level computation: + + ! + ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the + ! numerator integral, is calculated as: + ! + ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k); + ! + ! where k is the index of the given thermodynamic level, x and rho_ds are + ! both thermodynamic-level variables, and delta_z(k) = zm(k) - zm(k-1). The + ! indices k_bot and k_top are the indices of the respective lower and upper + ! thermodynamic levels involved in the integration. + ! + ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral, + ! is calculated as: + ! + ! SUM(k_bot:k_top) rho_ds(k) delta_z(k). + ! + ! The first (k=1) thermodynamic level is below ground (or below the + ! official lower boundary at the first momentum level), so it should not + ! count in a vertical average, whether that vertical average is used for + ! the hole-filling scheme or for statistical purposes. Begin no lower + ! than level k=2, which is the first thermodynamic level above ground (or + ! above the model lower boundary). + ! + ! For cases where hole-filling over the entire (global) vertical domain + ! is desired, or where statistics over the entire (global) vertical + ! domain are desired, the lower (thermodynamic-level) index of k = 2 and + ! the upper (thermodynamic-level) index of k = gr%nz, means that the + ! overall vertical domain will be gr%zm(gr%nz) - gr%zm(1). + ! + ! + ! Momentum-level computation: + ! + ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the + ! numerator integral, is calculated as: + ! + ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k); + ! + ! where k is the index of the given momentum level, x and rho_ds are both + ! momentum-level variables, and delta_z(k) = zt(k+1) - zt(k). The indices + ! k_bot and k_top are the indices of the respective lower and upper momentum + ! levels involved in the integration. + ! + ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral, + ! is calculated as: + ! + ! SUM(k_bot:k_top) rho_ds(k) delta_z(k). + ! + ! The first (k=1) momentum level is right at ground level (or right at + ! the official lower boundary). The momentum level variables that call + ! the hole-filling scheme have set values at the surface (or lower + ! boundary), and those set values should not be changed. Therefore, the + ! vertical average (for purposes of hole-filling) should not include the + ! surface level (or lower boundary level). For hole-filling purposes, + ! begin no lower than level k=2, which is the second momentum level above + ! ground (or above the model lower boundary). Likewise, the value at the + ! model upper boundary (k=gr%nz) is also set for momentum level + ! variables. That value should also not be changed. + ! + ! However, this function is also used to keep track (for statistical + ! purposes) of the vertical average of certain variables. In that case, + ! the vertical average needs to be taken over the entire vertical domain + ! (level 1 to level gr%nz). + ! + ! + ! In both the thermodynamic-level computation and the momentum-level + ! computation, the numerator integral is divided by the denominator integral + ! in order to find the average value (over the vertical domain) of x. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: & + total_idx ! The total numer of indices within the range of averaging + + real( kind = core_rknd ), dimension(total_idx), intent(in) :: & + rho_ds, & ! Dry, static density on either thermodynamic or momentum levels [kg/m^3] + field, & ! The field (e.g. wp2) to be vertically averaged [Units vary] + invrs_dz ! Reciprocal of thermodynamic or momentum level thickness [1/m] + ! depending on whether we're on zt or zm grid. + ! Note: The rho_ds and field points need to be arranged from + ! lowest to highest in altitude, with rho_ds(1) and + ! field(1) actually their respective values at level k = 1. + + ! Output variable + real( kind = core_rknd ) :: & + vertical_avg ! Vertical average of field [Units of field] + + ! Local variables + real( kind = core_rknd ) :: & + numer_integral, & ! Integral in the numerator (see description) + denom_integral ! Integral in the denominator (see description) + + real( kind = core_rknd ), dimension(total_idx) :: & + denom_field ! When computing the vertical integral in the denominator + ! there is no field variable, so create a "dummy" variable + ! with value of 1 to pass as an argument + + !----------------------------------------------------------------------- + + ! Fill array with 1's (see variable description) + denom_field = 1.0_core_rknd + + ! Initializing vertical_avg to avoid a compiler warning. + vertical_avg = 0.0_core_rknd + + + ! Compute the numerator integral. + ! Multiply the variable 'field' at level k by rho_ds at level k and by + ! the level thickness at level k. Then, sum over all vertical levels. + ! Note: The level thickness at level k is the distance between either + ! momentum level k and momentum level k-1, or + ! thermodynamic level k+1 and thermodynamic level k, depending + ! on which field grid is being analyzed. Thus, 1.0/invrs_dz(k) + ! is the level thickness for level k. + ! Note: The values of 'field' and rho_ds are passed into this function + ! so that field(1) and rho_ds(1) are actually 'field' and rho_ds + ! at the level k = 1. + + numer_integral = vertical_integral( total_idx, rho_ds(1:total_idx), & + field(1:total_idx), invrs_dz(1:total_idx) ) + + ! Compute the denominator integral. + ! Multiply rho_ds at level k by the level thickness + ! at level k. Then, sum over all vertical levels. + denom_integral = vertical_integral( total_idx, rho_ds(1:total_idx), & + denom_field(1:total_idx), invrs_dz(1:total_idx) ) + + ! Find the vertical average of 'field'. + vertical_avg = numer_integral / denom_integral + + return + end function vertical_avg + + !============================================================================= + pure function vertical_integral( total_idx, rho_ds, & + field, invrs_dz ) + + ! Description: + ! Computes the vertical integral. rho_ds, field, and invrs_dz must all be + ! of size total_idx and should all start at the same index. + ! + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: & + total_idx ! The total numer of indices within the range of averaging + + real( kind = core_rknd ), dimension(total_idx), intent(in) :: & + rho_ds, & ! Dry, static density [kg/m^3] + field, & ! The field to be vertically averaged [Units vary] + invrs_dz ! Level thickness [1/m] + ! Note: The rho_ds and field points need to be arranged from + ! lowest to highest in altitude, with rho_ds(1) and + ! field(1) actually their respective values at level k = begin_idx. + + ! Local variables + real( kind = core_rknd ) :: & + vertical_integral ! Integral in the numerator (see description) + + !----------------------------------------------------------------------- + + ! Assertion checks: that begin_idx <= gr%nz - 1 + ! that end_idx >= 2 + ! that begin_idx <= end_idx + + + ! Initializing vertical_integral to avoid a compiler warning. + vertical_integral = 0.0_core_rknd + + ! Compute the integral. + ! Multiply the field at level k by rho_ds at level k and by + ! the level thickness at level k. Then, sum over all vertical levels. + ! Note: The values of the field and rho_ds are passed into this function + ! so that field(1) and rho_ds(1) are actually the field and rho_ds + ! at level k_start. + vertical_integral = sum( field * rho_ds / invrs_dz ) + + return + end function vertical_integral + +!=============================================================================== + +end module crmx_fill_holes diff --git a/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 b/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 new file mode 100644 index 0000000000..008ce4925d --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 @@ -0,0 +1,171 @@ +!---------------------------------------------------------------------------- +! $Id: gmres_cache.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!============================================================================== +module crmx_gmres_cache + +#ifdef MKL + + use crmx_clubb_precision, only: & + dp ! double precision + + ! Description: + ! This module contains cache data structures for the GMRES wrapper class. + ! + ! This is mostly to allow us to get around some...odd errors when it was + ! integrated into the gmres_wrap module. The cache variables are public, as + ! they will need to be passed in whenever gmres_solve is called. + + implicit none + + public :: gmres_cache_matrix_init, gmres_cache_soln, & + gmres_cache_temp_init + + private ! Default scope + + real( kind = dp ), public, pointer, dimension(:,:) :: & + gmres_prev_soln, & ! Stores the previous solution vectors from earlier + ! GMRES solve runs. The first dimension is for the + ! actual vector; the second dimension is to determine + ! which cache to access--this is done via the GMRES + ! indices for each of the different matrices. + gmres_prev_precond_a ! Stores the previous preconditioner matrix from + ! earlier GMRES solve runs. The first dimension is + ! for the a-array itself; the second dimension is to + ! determine which cached array to access--this is + ! done via the GMRES indices for each of the + ! different matrices. + + real( kind = dp ), public, pointer, dimension(:) :: & + gmres_temp_intlc, & ! Temporary array that stores GMRES internal values + ! for the interlaced matrices (2 x gr%nz grid + ! levels) + gmres_temp_norm ! Temporary array that stores GMRES internal values + ! for the non-interlaced matrices (gr%nz grid + ! levels) + + integer, public :: & + gmres_tempsize_norm, & ! Size of the temporary array for + ! non-interlaced matrices + gmres_tempsize_intlc ! Size of the temporary array for + ! interlaced matrices + + integer, public, parameter :: & + maximum_gmres_idx = 1 ! Maximum number of different types of solves the + ! wrapper can keep memory for. If new matrices are + ! added that GMRES is to be used for, increase this + ! number and add a public parameter corresponding to + ! the matrix below: + + integer, public, parameter :: & + gmres_idx_wp2wp3 = 1 ! GMRES wrapper index for the wp2_wp3 matrices + + logical, public, dimension(maximum_gmres_idx) :: & + l_gmres_soln_ok ! Stores if the current solution is "okay"--that is, if an + ! initial solution has been passed in for that particular + ! cache index. This defaults to false and is set to true + ! when a solution is updated. + + contains + + subroutine gmres_cache_temp_init(numeqns) ! Intent(in) + ! Description: + ! Initialization subroutine for the temporary arrays for GMRES + ! + ! This subroutine initializes the temporary arrays that are used to work + ! the GMRES solver. + ! + ! These temporary arrays are used for all GMRES solves. + ! + ! References: + ! None + + implicit none + + ! Input Variables + integer, intent(in) :: & + numeqns ! Number of equations for non-interlaced matrices (gr%nz) + + integer :: & + numeqns_intlc ! Number of equations for interlaced matrices + + numeqns_intlc = numeqns * 2 + + ! Figure out the sizes of the temporary arrays + ! The equations were lifted from the Intel documentation of dfgmres: + ! http://www.intel.com/software/products/mkl/docs/webhelp/ssr/functn_rci_dfgmres.html + ! All of the ipar(15)s have been replaced with "numeqns", as the code + ! examples seemed to use N (numeqns) in place of ipar(15). + gmres_tempsize_norm = ((((2*numeqns + 1)*numeqns) & + + (numeqns*(numeqns+9))/2) + 1) ! Known magic number + + gmres_tempsize_intlc = ((((2*numeqns_intlc + 1)*numeqns_intlc) & + + (numeqns_intlc*(numeqns_intlc+9))/2) + 1) ! Known magic number + + ! Allocate the temporary arrays + allocate( gmres_temp_intlc(1:gmres_tempsize_intlc), & + gmres_temp_norm(1:gmres_tempsize_norm) ) + + end subroutine gmres_cache_temp_init + + subroutine gmres_cache_matrix_init(max_numeqns, max_elements, & ! Intent(in) + max_gmres_idx) ! Intent(in) + ! Description: + ! Initialization subroutine for the caches for GMRES. + ! + ! This initializes the cache that stores the previous solution and + ! previous preconditioner values for all GMRES solves. + ! + ! References: + ! None + + implicit none + + ! Input Variables + integer, intent(in) :: & + max_numeqns, & ! Maximum number of equations for a matrix that will be + ! solved with GMRES + max_elements, & ! Maximum number of non-zero elements for a matrix that + ! will be solved with GMRES + max_gmres_idx ! Maximum number of distinct matrices that will be solved + ! with GMRES + + allocate( gmres_prev_soln(1:max_numeqns,1:max_gmres_idx), & + gmres_prev_precond_a(1:max_elements,1:max_gmres_idx) ) + + l_gmres_soln_ok = .false. + + end subroutine gmres_cache_matrix_init + + subroutine gmres_cache_soln(numeqns, gmres_idx, solution) ! Intent(in) + ! Description: + ! Subroutine that caches a previous solution for a particular GMRES-solved + ! matrix. + ! + ! Stores the current solution in the cache so it can be referenced for + ! the next GMRES solve. This subroutine will also set the solution_ok + ! flag for that particular GMRES index. + ! + ! References: + ! None + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + integer, intent(in) :: & + numeqns, & ! The number of equations in the solution vector + gmres_idx ! The index for the particular matrix solved by GMRES + + real( kind = core_rknd ), dimension(numeqns), intent(in) :: & + solution ! The solution vector to be cached + + gmres_prev_soln(1:numeqns,gmres_idx) = solution + + l_gmres_soln_ok(gmres_idx) = .true. + + end subroutine gmres_cache_soln + +#endif /* MKL */ + +end module crmx_gmres_cache diff --git a/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 b/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 new file mode 100644 index 0000000000..bcab38cdb4 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 @@ -0,0 +1,391 @@ +!---------------------------------------------------------------------------- +! $Id: gmres_wrap.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!============================================================================== + +module crmx_gmres_wrap + +#ifdef MKL + + ! Description: + ! This module wraps the MKL version of GMRES, an iterative solver. Note that + ! this will only work for the MKL-specific version of GMRES--any other GMRES + ! implementations will require retooling of this code! + ! + ! The primary subroutine, gmres_solve utilizes GMRES to solve a given matrix. + ! + ! There is also a gmres_init, which initializes some of the internal data + ! used for the wrapper. + ! + ! This wrapper automatically keeps prior solutions to use the previous data + ! to speed up the solves. For the purposes of allowing this solver to be used + ! with more than one matrix type, the wrapper has a "solve index" variable. + ! Pass in the proper solve index variable to associate your solve with + ! previous solves of the same matrix. + + use crmx_gmres_cache, only: & + maximum_gmres_idx ! Variable + + implicit none + + public :: gmres_solve, gmres_init + + private ! Default scope + + contains + + subroutine gmres_init(max_numeqns, max_elements) ! Intent(in) + + ! Description: + ! Initialization subroutine for the GMRES iterative matrix equation solver + ! + ! This subroutine initializes the previous memory handles for the GMRES + ! routines, for the purpose of speeding up calculations. + ! These handles are initialized to a size specified by the number of + ! equations specified in this subroutine. + ! + ! WARNING: Once initialized, only use the specified gmres_idx for that + ! particular matrix! Failure to do so could result in greatly decreased + ! performance, incorrect solutions, or both! + ! + ! Once this is called, the proper prev_soln_ and prev_lu_ + ! handles in the gmres_cache module can be used, and will need to be passed + ! in to gmres_solve for that matrix. + ! + ! References: + ! None + + use crmx_gmres_cache, only: & + gmres_cache_matrix_init ! Subroutines + + implicit none + + ! Input Variables + integer, intent(in) :: & + max_numeqns, & ! Maximum number of equations for a matrix that will be + ! solved with GMRES + max_elements ! Maximum number of non-zero elements for a matrix that + ! will be solved with GMRES + + call gmres_cache_matrix_init( max_numeqns, max_elements, maximum_gmres_idx ) + + end subroutine gmres_init + + subroutine gmres_solve(elements, numeqns, & !Intent(in) + csr_a, csr_ia, csr_ja, tempsize, & !Intent(in) + prev_soln, prev_lu, rhs, temp, & !Intent(in/out) + solution, err_code) !Intent(out) + + ! Description: + ! Solves a matrix equation using GMRES. On the first timestep and every + ! fifth timestep afterward, a preconditioner is computed for the matrix + ! and stored. In addition, on the first timestep the matrix is solved using + ! LAPACK, which is used as the estimate for GMRES for the first timestep. + ! After this, the previous solution found is used as the estimate. + ! + ! To use the proper cached preconditioner and solution, make sure you pass + ! the proper gmres_idx corresponding to the matrix you're solving--using a + ! value different than what has been used in the past will cause, at best, + ! a slower solve, and at worst, an incorrect one. + ! + ! References: + ! None + + use crmx_clubb_precision, only: & + dp, & ! double precision + core_rknd + + implicit none + + include "mkl_rci.fi" + + ! Input variables + integer, intent(in) :: & + elements, & ! Number of elements in the csr_a/csr_ja arrays + numeqns ! Number of equations in the matrix + + real( kind = core_rknd ), dimension(elements), intent(in) :: & + csr_a ! A-array description of the matrix in CSR format. This + ! will be converted to double precision for the purposes + ! of running GMRES. + + integer, dimension(numeqns + 1), intent(in) :: & + csr_ia ! IA-array portion of the matrix description in CSR format. + ! This describes the indices of the JA-array that start + ! new rows. For more details, check the documentation in + ! the csr_matrix_class module. + + integer, dimension(elements), intent(in) :: & + csr_ja ! JA-array portion of the matrix description in CSR format. + ! This describes which columns of a are nonzero. For more + ! details, check the documentation in the csr_matrix_class + ! module. + + integer, intent(in) :: & + tempsize ! Denotes the size of the temporary array used for GMRES + ! calculations. + + ! Input/Output variables + real( kind = core_rknd ), dimension(numeqns), intent(inout) :: & + rhs ! Right-hand-side vectors to solve the equation for. + + real( kind = dp ), dimension(numeqns), intent(inout) :: & + prev_soln ! Previous solution cache vector for the matrix to be solved + ! for--pass the proper handle from the gmres_cache module + + real( kind = dp ), dimension(elements), intent(inout) :: & + prev_lu ! Previous LU-decomposition a-array for the matrix to be + ! solved for--pass the proper handle from the gmres_cache + ! module + + real( kind = dp ), dimension(tempsize), intent(inout) :: & + temp ! Temporary array that stores working values while the GMRES + ! solver iterates + + ! Output variables + real( kind = core_rknd ), dimension(numeqns), intent(out) :: & + solution ! Solution vector, output of solver routine + + integer, intent(out) :: & + err_code ! Error code, nonzero if errors occurred. + + ! Local variables + logical :: l_gmres_run ! Variable denoting if we need to loop and run + ! a GMRES iteration again. + + integer :: & + rci_req, & ! RCI_Request for GMRES--allows us to take action based + ! on what the iterative solver requests to be done. + iters ! Total number of iterations GMRES has run. + + integer, dimension(128) :: & + ipar ! Parameter array for the GMRES iterative solver + + real( kind = dp ), dimension(128) :: & + dpar ! Parameter array for the GMRES iterative solver + + ! The following local variables are double-precision so we can use GMRES + ! as there is only double-precision support for GMRES. + ! We will need to convert our single-precision numbers to double precision + ! for the duration of the calculations. + real( kind = dp ), dimension(elements) :: & + csr_dbl_a ! Double-precision version of the CSR-format A array + + real( kind = dp ), dimension(numeqns) :: & + dbl_rhs, & ! Double-precision version of the rhs vector + dbl_soln, & ! Double-precision version of the solution vector + tempvec ! Temporary vector for applying inverse LU-decomp matrix + !tmp_rhs + + ! Variables used to solve the preconditioner the first time with PARDISO. + !integer, parameter :: & + !pardiso_size_arrays = 64, & + !real_nonsymm = 11 + + !integer(kind=8), dimension(pardiso_size_arrays) :: & + ! pt ! PARDISO internal pointer array + + !integer(kind=4), dimension(pardiso_size_arrays) :: & + ! iparm + + !integer(kind=4), dimension(numeqns) :: & + ! perm + + ! integer :: i, j + + ! We want to be running, initially. + l_gmres_run = .true. + + ! Set the default error code to 0 (no errors) + ! This is to make the default explicit; Fortran initializes + ! values to 0. + err_code = 0 + + ! Convert our A array and rhs vector to double precision... + csr_dbl_a = dble(csr_a) + dbl_rhs = dble(rhs) + + ! DEBUG: Set our a_array so it represents the identity matrix, and + ! set the RHS so we can get a meaningful answer. +! csr_dbl_a = 1_dp +! csr_dbl_a(1) = 1D1 +! csr_dbl_a(5) = 1D1 +! csr_dbl_a(elements) = 1D1 +! csr_dbl_a(elements - 4) = 1D1 +! do i=10,elements - 9,5 +! csr_dbl_a(i) = 1D1 +! end do +! do i=1,numeqns,1 +! dbl_rhs(i) = i * 1_dp +! end do +! dbl_rhs = 9D3 +! dbl_rhs = 1D1 + + ! DEBUG: Make sure our a_array isn't wrong +! do i=1,elements,1 +! print *, "csr_dbl_a idx",i,"=",csr_dbl_a(i) +! end do + + ! Figure out the default value for ipar(15) and put it in our ipar_15 int. + !ip_15 = min(150, numeqns) + + ! Figure out the size of the temp array. + !tempsize = ((((2*numeqns + 1)*numeqns)+(numeqns*(numeqns+9))/2) + 1) + ! This ugly equation was lifted from the Intel documentation of dfgmres: + ! http://www.intel.com/software/products/mkl/docs/webhelp/ssr/functn_rci_dfgmres.html + ! All of the ipar(15)s have been replaced with "numeqns", as the code + ! examples seemed to use N (numeqns) in place of ipar(15). + + ! Allocate the temp array. + !allocate(temp(1:tempsize)) + + ! Generate our preconditioner matrix with the ILU0 subroutine. + call dcsrilu0( numeqns, csr_dbl_a, csr_ia, csr_ja, & + prev_lu, ipar, dpar, err_code ) + + ! On the first timestep we need to solve our preconditioner to give us + ! our first solution estimate. After this, the previous solution will + ! suffice as an estimate. +! if (iteration_num(gmres_idx) == 0) then + !solve with precond_a, csr_ia, csr_ja. + !One thing to test, too: try just setting the solution vector to 1 + ! for the first timestep and see if it's not too unreasonably slow? +! call pardisoinit( pt, real_nonsymm, iparm ) +#ifdef _OPENMP +! iparm(3) = omp_get_max_threads() +#else +! iparm(3) = 1 +#endif + +! call pardiso( pt, 1, 1, real_nonsymm, 13, numeqns, & !Intent(in) +! prev_lu, csr_ia, csr_ja, perm, 1, iparm, 0, & !Intent(in) +! dbl_rhs, & !Intent(inout) +! prev_soln, err_code ) !Intent(out) +! end if !iteration_num == 1 + + !DEBUG: Set apporximate solution vector to 0.9 (?) for now + !prev_soln(:) = 0.9_dp + + !do i=1,numeqns,1 + ! print *, "Current approximate solution idx",i,"=",prev_soln(i) + !end do + + ! Initialize our solution vector to the previous solution passed in + dbl_soln = prev_soln + + ! Set up the GMRES solver. + call dfgmres_init( numeqns, dbl_soln, dbl_rhs, & + rci_req, ipar, dpar, temp ) + + ! Set the parameters that tell GMRES to handle stopping tests + ipar(9) = 1 + ipar(10) = 0 + ipar(12) = 1 + + ! Set the parameter that tells GMRES to use a preconditioner + ipar(11) = 1 + + ! Check our GMRES settings. + call dfgmres_check( numeqns, dbl_soln, dbl_rhs, & + rci_req, ipar, dpar, temp ) + + ! Start the GMRES solver. We set up a while loop which will be broken when + ! the GMRES solver indicates that a solution has been found. + do while(l_gmres_run) + !print *, "********************************************************" + !print *, "BEGINNING ANOTHER ITERATION..." + !print *, "========================================================" + ! Run a GMRES iteration. + call dfgmres( numeqns, dbl_soln, dbl_rhs, & + rci_req, ipar, dpar, temp ) + + select case(rci_req) + case (0) + l_gmres_run = .false. + case (1) + ! Multiply our left-hand side by the vector placed in the temp array, + ! at ipar(22), and place the result in the temp array at ipar(23). + ! Display temp(ipar(22)) + ! print *, "------------------------------------------------" + ! print *, "RCI_REQ=1: MULTIPLY VECTOR BY A MATRIX" + ! do i=1,numeqns,1 + ! print *, "Tempvec before, idx",i,"=",temp(ipar(22)+i-1) + ! end do + call mkl_dcsrgemv( 'N', numeqns, csr_dbl_a, csr_ia, csr_ja, & + temp(ipar(22)), temp(ipar(23)) ) ! Known magic number + ! do i=1,numeqns,1 + ! print *, "Tempvec after, idx",i,"=",temp(ipar(23)+i-1) + ! end do + ! print *, "------------------------------------------------" + case (2) + ! Ignore this for now, see if GMRES ever escapes. + case (3) + ! Apply the inverse of the preconditioner to the vector placed in the + ! temp array at ipar(22), and place the result in the temp array at + ! ipar(23). + !print *, "------------------------------------------------" + !print *, "RCI_REQ=3: APPLY PRECONDITION TO VECTOR" + !do i=1,numeqns,1 + ! print *, "Tempvec before, idx",i,"=",temp(ipar(22)+i-1) + !end do + call mkl_dcsrtrsv( 'L', 'N', 'U', numeqns, & + prev_lu, csr_ia, csr_ja, & + temp(ipar(22)), tempvec ) ! Known magic number + call mkl_dcsrtrsv( 'U', 'N', 'N', numeqns, & + prev_lu, csr_ia, csr_ja, & + tempvec, temp(ipar(23)) ) ! Known magic number + !do i=1,numeqns,1 + ! print *, "Tempvec after, idx",i,"=",temp(ipar(23)+i-1) + !end do + !print *, "------------------------------------------------" + + case (4) +! if (dpar(7) < GMRES_TOL) then +! l_gmres_run = .false. +! else +! ! Keep running, we aren't there yet. +! l_gmres_run = .true. +! end if + case default + ! We got a response we weren't expecting. This is probably bad. + ! (Then again, maybe it's just not something we accounted for?) + ! Regardless, let's set an error code and break out of here. + print *, "Unknown rci_request returned from GMRES:", rci_req + l_gmres_run = .false. + err_code = -1 + end select + ! Report current iteration +! call dfgmres_get( numeqns, dbl_soln, dbl_rhs, rci_req, & +! ipar, dpar, temp, iters ) +! print *, "========================================================" +! print *, "END OF LOOP: REPORTING INFORMATION" +! print *, "Current number of GMRES iterations: ", iters +! do i=1,numeqns,1 +! print *, "double value of soln so far, idx",i,"=",dbl_soln(i) +! end do +! print *, "========================================================" +! print *, "********************************************************" + end do + !if (err_code == 0) then + + ! Get the answer, convert it to single-precision + call dfgmres_get( numeqns, dbl_soln, dbl_rhs, rci_req, & + ipar, dpar, temp, iters ) + + !print *, "Total iterations for GMRES:",iters + + !do i=1,numeqns,1 + ! print *, "double value of soln, idx",i,"=",dbl_soln(i) + !end do + + ! Store our solution as the previous solution for use in the next + ! simulation timestep. + prev_soln = dbl_soln + + solution = real(dbl_soln) + !end if + + end subroutine gmres_solve + +#endif /* MKL */ + +end module crmx_gmres_wrap diff --git a/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 b/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 new file mode 100644 index 0000000000..26d1a8c86a --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 @@ -0,0 +1,2036 @@ +!------------------------------------------------------------------------ +! $Id: grid_class.F90 6116 2013-03-22 00:37:40Z bmg2@uwm.edu $ +!=============================================================================== +module crmx_grid_class + + ! Description: + ! + ! Definition of a grid class and associated functions + ! + ! The grid specification is as follows: + ! + ! + ================== zm(nzmax) =========GP======= + ! | + ! | + ! 1/dzt(nzmax) + ------------------ zt(nzmax) ---------GP------- + ! | | + ! | | + ! + 1/dzm(nzmax-1) ================== zm(nzmax-1) ================ + ! | + ! | + ! + ------------------ zt(nzmax-1) ---------------- + ! + ! . + ! . + ! . + ! . + ! + ! ================== zm(k+1) =================== + ! + ! + ! + ------------------ zt(k+1) ------------------- + ! | + ! | + ! + 1/dzm(k) ================== zm(k) ===================== + ! | | + ! | | + ! 1/dzt(k) + ------------------ zt(k) --------------------- + ! | + ! | + ! + ================== zm(k-1) =================== + ! + ! + ! ------------------ zt(k-1) ------------------- + ! + ! . + ! . + ! . + ! . + ! + ! + ================== zm(2) ===================== + ! | + ! | + ! 1/dzt(2) + ------------------ zt(2) --------------------- + ! | | + ! | | + ! + 1/dzm(1) ================== zm(1) ============GP======= zm_init + ! | ////////////////////////////////////////////// surface + ! | + ! + ------------------ zt(1) ------------GP------- + ! + ! + ! The variable zm(k) stands for the momentum level altitude at momentum + ! level k; the variable zt(k) stands for the thermodynamic level altitude at + ! thermodynamic level k; the variable invrs_dzt(k) is the inverse distance + ! between momentum levels (over a central thermodynamic level k); and the + ! variable invrs_dzm(k) is the inverse distance between thermodynamic levels + ! (over a central momentum level k). Please note that in the above diagram, + ! "invrs_dzt" is denoted "dzt", and "invrs_dzm" is denoted "dzm", such that + ! 1/dzt is the distance between successive momentum levels k-1 and k (over a + ! central thermodynamic level k), and 1/dzm is the distance between successive + ! thermodynamic levels k and k+1 (over a central momentum level k). + ! + ! The grid setup is compatible with a stretched (unevely-spaced) grid. Thus, + ! the distance between successive grid levels may not always be constant. + ! + ! The following diagram is an example of a stretched grid that is defined on + ! momentum levels. The thermodynamic levels are placed exactly halfway + ! between the momentum levels. However, the momentum levels do not fall + ! halfway between the thermodynamic levels. + ! + ! =============== zm(k+1) =============== + ! + ! + ! + ! --------------- zt(k+1) --------------- + ! + ! + ! + ! =============== zm(k) =============== + ! + ! --------------- zt(k) --------------- + ! + ! =============== zm(k-1) =============== + ! + ! The following diagram is an example of a stretched grid that is defined on + ! thermodynamic levels. The momentum levels are placed exactly halfway + ! between the thermodynamic levels. However, the thermodynamic levels do not + ! fall halfway between the momentum levels. + ! + ! --------------- zt(k+1) --------------- + ! + ! + ! + ! =============== zm(k) =============== + ! + ! + ! + ! --------------- zt(k) --------------- + ! + ! =============== zm(k-1) =============== + ! + ! --------------- zt(k-1) --------------- + ! + ! NOTE: Any future code written for use in the CLUBB parameterization should + ! use interpolation formulas consistent with a stretched grid. The + ! simplest way to do so is to call the appropriate interpolation + ! function from this module. Interpolations should *not* be handled in + ! the form of: ( var_zm(k) + var_zm(k-1) ) / 2; *nor* in the form of: + ! 0.5_core_rknd*( var_zt(k+1) + var_zt(k) ). Rather, all explicit interpolations + ! should call zt2zm or zm2zt; while interpolations for a variable being + ! solved for implicitly in the code should use gr%weights_zt2zm (which + ! refers to interp_weights_zt2zm_imp), or gr%weights_zm2zt (which + ! refers to interp_weights_zm2zt_imp). + ! + ! Momentum level 1 is placed at altitude zm_init, which is usually at the + ! surface. However, in general, zm_init can be at any altitude defined by the + ! user. + ! + ! GP indicates ghost points. Variables located at those levels are not + ! prognosed, but only used for boundary conditions. + ! + ! Chris Golaz, 7/17/99 + ! modified 9/10/99 + + ! References: + + ! Section 3c, p. 3548 /Numerical discretization/ of: + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + public :: gr, grid, zt2zm, interp_weights_zt2zm_imp, zm2zt, & + interp_weights_zm2zt_imp, ddzm, ddzt, & + setup_grid, cleanup_grid, setup_grid_heights, & + read_grid_heights, flip, zt2zm_linear, zm2zt_linear + + private :: linear_interpolated_azm, linear_interpolated_azmk, & + interpolated_azmk_imp, linear_interpolated_azt, & + linear_interpolated_aztk, interpolated_aztk_imp, & + gradzm, gradzt, t_above, t_below, m_above, m_below, & + cubic_interpolated_azmk, cubic_interpolated_aztk, & + cubic_interpolated_azm, cubic_interpolated_azt + + private ! Default Scoping + + ! Constant parameters + integer, parameter :: & + t_above = 1, & ! Upper thermodynamic level index (gr%weights_zt2zm). + t_below = 2, & ! Lower thermodynamic level index (gr%weights_zt2zm). + m_above = 1, & ! Upper momentum level index (gr%weights_zm2zt). + m_below = 2 ! Lower momentum level index (gr%weights_zm2zt). + + + type grid + + integer :: nz ! Number of points in the grid + ! Note: Fortran 90/95 prevents an allocatable array from appearing + ! within a derived type. However, a pointer can be used in the same + ! manner as an allocatable array, as we have done here (the grid + ! pointers are always allocated rather than assigned and nullified + ! like real pointers). Note that these must be de-allocated to prevent + ! memory leaks. + real( kind = core_rknd ), pointer, dimension(:) :: & + zm, & ! Momentum grid + zt ! Thermo grid + real( kind = core_rknd ), pointer, dimension(:) :: & + invrs_dzm, & ! The inverse spacing between thermodynamic grid + ! levels; centered over momentum grid levels. + invrs_dzt ! The inverse spacing between momentum grid levels; + ! centered over thermodynamic grid levels. + + real( kind = core_rknd ), pointer, dimension(:) :: & + dzm, & ! Spacing between thermodynamic grid levels; centered over + ! momentum grid levels + dzt ! Spcaing between momentum grid levels; centered over + ! thermodynamic grid levels + + ! These weights are normally used in situations + ! where a momentum level variable is being + ! solved for implicitly in an equation and + ! needs to be interpolated to the thermodynamic grid levels. + real( kind = core_rknd ), pointer, dimension(:,:) :: weights_zm2zt, & + ! These weights are normally used in situations where a + ! thermodynamic level variable is being solved for implicitly in an equation + ! and needs to be interpolated to the momentum grid levels. + weights_zt2zm + + end type grid + + ! The grid is defined here so that it is common throughout the module. + ! The implication is that only one grid can be defined ! + + type (grid) gr + +! Modification for using CLUBB in a host model (i.e. one grid per column) +!$omp threadprivate(gr) + + ! Interfaces provided for function overloading + + ! Interpolation/extension functions + interface zt2zm_linear + ! This performs a linear extension at the highest grid level and therefore + ! does not guarantee, for positive definite quantities (e.g. wp2), that the + ! extended point is indeed positive definite. Positive definiteness can be + ! ensured with a max statement. + ! In the future, we could add a flag (lposdef) and, when needed, apply the + ! max statement directly within interpolated_azm and interpolated_azmk. + module procedure linear_interpolated_azmk, linear_interpolated_azm + end interface + + interface zm2zt_linear + ! This performs a linear extension at the lowest grid level and therefore + ! does not guarantee, for positive definite quantities (e.g. wp2), that the + ! extended point is indeed positive definite. Positive definiteness can be + ! ensured with a max statement. + ! In the future, we could add a flag (lposdef) and, when needed, apply the + ! max statement directly within interpolated_azt and interpolated_aztk. + module procedure linear_interpolated_azt, linear_interpolated_aztk + end interface + + interface zt2zm + ! This version uses cublic spline interpolation of Stefen (1990). + module procedure cubic_interpolated_azmk, cubic_interpolated_azm + end interface + + interface zm2zt + ! As above, but for interpolating zm to zt levels. + module procedure cubic_interpolated_aztk, cubic_interpolated_azt + end interface + + interface interp_weights_zt2zm_imp + module procedure interpolated_azmk_imp + end interface + + + interface interp_weights_zm2zt_imp + module procedure interpolated_aztk_imp + end interface + + ! Vertical derivative functions + interface ddzm + module procedure gradzm + end interface + + interface ddzt + module procedure gradzt + end interface + + contains + + !============================================================================= + subroutine setup_grid( nzmax, sfc_elevation, l_implemented, & + grid_type, deltaz, zm_init, zm_top, & + momentum_heights, thermodynamic_heights, & + begin_height, end_height ) + + ! Description: + ! Grid Constructor + ! + ! This subroutine sets up the CLUBB vertical grid. + ! + ! References: + ! ``Equations for CLUBB'', Sec. 8, Grid Configuration. + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Procedure(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + NWARNING = 250 ! Issue a warning if nzmax exceeds this number. + + ! Input Variables + integer, intent(in) :: & + nzmax ! Number of vertical levels in grid [#] + + real( kind = core_rknd ), intent(in) :: & + sfc_elevation ! Elevation of ground level [m AMSL] + + ! Flag to see if CLUBB is running on it's own, + ! or if it's implemented as part of a host model. + logical, intent(in) :: l_implemented + + ! If CLUBB is running on it's own, this option determines if it is using: + ! 1) an evenly-spaced grid; + ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid + ! levels (with momentum levels set halfway between thermodynamic levels); + ! or + ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels + ! (with thermodynamic levels set halfway between momentum levels). + integer, intent(in) :: grid_type + + ! If the CLUBB model is running by itself, and is using an evenly-spaced + ! grid (grid_type = 1), it needs the vertical grid spacing and + ! momentum-level starting altitude as input. + real( kind = core_rknd ), intent(in) :: & + deltaz, & ! Vertical grid spacing [m] + zm_init, & ! Initial grid altitude (momentum level) [m] + zm_top ! Maximum grid altitude (momentum level) [m] + + ! If the CLUBB parameterization is implemented in a host model, it needs to + ! use the host model's momentum level altitudes and thermodynamic level + ! altitudes. + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on thermodynamic levels (grid_type = 2), it needs to use the + ! thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on momentum levels (grid_type = 3), it needs to use the momentum + ! level altitudes as input. + real( kind = core_rknd ), intent(in), dimension(nzmax) :: & + momentum_heights, & ! Momentum level altitudes (input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (input) [m] + + integer, intent(out) :: & + begin_height, & ! Lower bound for *_heights arrays [-] + end_height ! Upper bound for *_heights arrays [-] + + ! Local Variables + integer :: ierr, & ! Allocation stat + i ! Loop index + + + ! ---- Begin Code ---- + + ! Define the grid size + + if ( nzmax > NWARNING .and. clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Warning: running with vertical grid "// & + "which is larger than", NWARNING, "levels." + write(fstderr,*) "This may take a lot of CPU time and memory." + end if + + gr%nz = nzmax + + ! Default bounds + begin_height = 1 + + end_height = gr%nz + + !--------------------------------------------------- + if ( .not. l_implemented ) then + + if ( grid_type == 1 ) then + + ! Determine the number of grid points given the spacing + ! to fit within the bounds without going over. + gr%nz = floor( ( zm_top - zm_init + deltaz ) / deltaz ) + + else if( grid_type == 2 ) then! Thermo + + ! Find begin_height (lower bound) + + i = gr%nz + + do while( thermodynamic_heights(i) >= zm_init .and. i > 1 ) + + i = i - 1 + + end do + + if( thermodynamic_heights(i) >= zm_init ) then + + stop "Stretched zt grid cannot fulfill zm_init requirement" + + else + + begin_height = i + + end if + + ! Find end_height (upper bound) + + i = gr%nz + + do while( thermodynamic_heights(i) > zm_top .and. i > 1 ) + + i = i - 1 + + end do + + if( zm_top < thermodynamic_heights(i) ) then + + stop "Stretched zt grid cannot fulfill zm_top requirement" + + else + + end_height = i + + gr%nz = size( thermodynamic_heights(begin_height:end_height) ) + + end if + + else if( grid_type == 3 ) then ! Momentum + + ! Find begin_height (lower bound) + + i = 1 + + do while( momentum_heights(i) < zm_init .and. i < gr%nz ) + + i = i + 1 + + end do + + if( momentum_heights(i) < zm_init ) then + + stop "Stretched zm grid cannot fulfill zm_init requirement" + + else + + begin_height = i + + end if + + ! Find end_height (lower bound) + + i = gr%nz + + do while( momentum_heights(i) > zm_top .and. i > 1 ) + + i = i - 1 + + end do + + if( momentum_heights(i) > zm_top ) then + + stop "Stretched zm grid cannot fulfill zm_top requirement" + + else + + end_height = i + + gr%nz = size( momentum_heights(begin_height:end_height) ) + + end if + + endif ! grid_type + + endif ! l_implemented + + !--------------------------------------------------- + + ! Allocate memory for the grid levels + allocate( gr%zm(gr%nz), gr%zt(gr%nz), & + gr%dzm(gr%nz), gr%dzt(gr%nz), & + gr%invrs_dzm(gr%nz), gr%invrs_dzt(gr%nz), & + gr%weights_zm2zt(m_above:m_below,gr%nz), & + gr%weights_zt2zm(t_above:t_below,gr%nz), & + stat=ierr ) + + if ( ierr /= 0 ) then + write(fstderr,*) "In setup_grid: allocation of grid variables failed." + stop "Fatal error." + end if + + ! Set the values for the derived types used for heights, derivatives, and + ! interpolation from the momentum/thermodynamic grid + call setup_grid_heights & + ( l_implemented, grid_type, & + deltaz, zm_init, & + momentum_heights(begin_height:end_height), & + thermodynamic_heights(begin_height:end_height) ) + + if ( sfc_elevation > gr%zm(1) ) then + write(fstderr,*) "The altitude of the lowest momentum level, " & + // "gr%zm(1), must be at or above the altitude of " & + // "the surface, sfc_elevation. The lowest model " & + // "momentum level cannot be below the surface." + write(fstderr,*) "Altitude of lowest momentum level =", gr%zm(1) + write(fstderr,*) "Altitude of the surface =", sfc_elevation + stop "Fatal error." + endif + + return + + end subroutine setup_grid + + !============================================================================= + subroutine cleanup_grid + + ! Description: + ! De-allocates the memory for the grid + ! + ! References: + ! None + !------------------------------------------------------------------------------ + use crmx_constants_clubb, only: & + fstderr ! Constant + + implicit none + + ! Local Variable(s) + integer :: ierr + + ! ----- Begin Code ----- + + ! Allocate memory for grid levels + deallocate( gr%zm, gr%zt, & + gr%dzm, gr%dzt, & + gr%invrs_dzm, gr%invrs_dzt, & + gr%weights_zm2zt, gr%weights_zt2zm, & + stat=ierr ) + + if ( ierr /= 0 ) then + write(fstderr,*) "Grid deallocation failed." + end if + + return + end subroutine cleanup_grid + + !============================================================================= + subroutine setup_grid_heights & + ( l_implemented, grid_type, & + deltaz, zm_init, momentum_heights, & + thermodynamic_heights ) + + ! Description: + ! Sets the heights and interpolation weights of the column. + ! This is seperated from setup_grid for those host models that have heights + ! that vary with time. + ! References: + ! None + !------------------------------------------------------------------------------ + + use crmx_constants_clubb, only: fstderr ! Constant + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + + ! Flag to see if CLUBB is running on it's own, + ! or if it's implemented as part of a host model. + logical, intent(in) :: l_implemented + + ! If CLUBB is running on it's own, this option determines if it is using: + ! 1) an evenly-spaced grid; + ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid + ! levels (with momentum levels set halfway between thermodynamic levels); + ! or + ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels + ! (with thermodynamic levels set halfway between momentum levels). + integer, intent(in) :: grid_type + + ! If the CLUBB model is running by itself, and is using an evenly-spaced + ! grid (grid_type = 1), it needs the vertical grid spacing and + ! momentum-level starting altitude as input. + real( kind = core_rknd ), intent(in) :: & + deltaz, & ! Vertical grid spacing [m] + zm_init ! Initial grid altitude (momentum level) [m] + + + ! If the CLUBB parameterization is implemented in a host model, it needs to + ! use the host model's momentum level altitudes and thermodynamic level + ! altitudes. + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on thermodynamic levels (grid_type = 2), it needs to use the + ! thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on momentum levels (grid_type = 3), it needs to use the momentum + ! level altitudes as input. + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + momentum_heights, & ! Momentum level altitudes (input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (input) [m] + + integer :: k + + ! ---- Begin Code ---- + + if ( .not. l_implemented ) then + + + if ( grid_type == 1 ) then + + ! Evenly-spaced grid. + ! Momentum level altitudes are defined based on the grid starting + ! altitude, zm_init, the constant grid-spacing, deltaz, and the number + ! of grid levels, gr%nz. + + ! Define momentum level altitudes. The first momentum level is at + ! altitude zm_init. + do k = 1, gr%nz, 1 + gr%zm(k) = zm_init + real( k-1, kind = core_rknd ) * deltaz + enddo + + ! Define thermodynamic level altitudes. Thermodynamic level altitudes + ! are located at the central altitude levels, exactly halfway between + ! momentum level altitudes. The lowermost thermodynamic level is + ! found by taking 1/2 the altitude difference between the bottom two + ! momentum levels and subtracting that value from the bottom momentum + ! level. The first thermodynamic level is below zm_init. + gr%zt(1) = zm_init - ( 0.5_core_rknd * deltaz ) + do k = 2, gr%nz, 1 + gr%zt(k) = 0.5_core_rknd * ( gr%zm(k) + gr%zm(k-1) ) + enddo + + + elseif ( grid_type == 2 ) then + + ! Stretched (unevenly-spaced) grid: stretched thermodynamic levels. + ! Thermodynamic levels are defined according to a stretched grid that + ! is entered through the use of an input file. This is similar to a + ! SAM-style stretched grid. + + ! Define thermodynamic level altitudes. + do k = 1, gr%nz, 1 + gr%zt(k) = thermodynamic_heights(k) + enddo + + ! Define momentum level altitudes. Momentum level altitudes are + ! located at the central altitude levels, exactly halfway between + ! thermodynamic level altitudes. The uppermost momentum level + ! altitude is found by taking 1/2 the altitude difference between the + ! top two thermodynamic levels and adding that value to the top + ! thermodynamic level. + do k = 1, gr%nz-1, 1 + gr%zm(k) = 0.5_core_rknd * ( gr%zt(k+1) + gr%zt(k) ) + enddo + gr%zm(gr%nz) = gr%zt(gr%nz) + & + 0.5_core_rknd * ( gr%zt(gr%nz) - gr%zt(gr%nz-1) ) + + elseif ( grid_type == 3 ) then + + ! Stretched (unevenly-spaced) grid: stretched momentum levels. + ! Momentum levels are defined according to a stretched grid that is + ! entered through the use of an input file. This is similar to a + ! WRF-style stretched grid. + + ! Define momentum level altitudes. + do k = 1, gr%nz, 1 + gr%zm(k) = momentum_heights(k) + enddo + + ! Define thermodynamic level altitudes. Thermodynamic level altitudes + ! are located at the central altitude levels, exactly halfway between + ! momentum level altitudes. The lowermost thermodynamic level + ! altitude is found by taking 1/2 the altitude difference between the + ! bottom two momentum levels and subtracting that value from the + ! bottom momentum level. + gr%zt(1) = gr%zm(1) - 0.5_core_rknd * ( gr%zm(2) - gr%zm(1) ) + do k = 2, gr%nz, 1 + gr%zt(k) = 0.5_core_rknd * ( gr%zm(k) + gr%zm(k-1) ) + enddo + + + else + + ! Invalid grid type. + write(fstderr,*) "Invalid grid type: ", grid_type, & + ". Valid options are 1, 2, or 3." + stop "Fatal error." + + + endif + + + else + + ! The CLUBB parameterization is implemented in a host model. + ! Use the host model's momentum level altitudes and thermodynamic level + ! altitudes to set up the CLUBB grid. + + ! Momentum level altitudes from host model. + do k = 1, gr%nz, 1 + gr%zm(k) = momentum_heights(k) + enddo + + ! Thermodynamic level altitudes from host model after possible grid-index + ! adjustment for CLUBB interface. + do k = 1, gr%nz, 1 + gr%zt(k) = thermodynamic_heights(k) + enddo + + + endif ! not l_implemented + + + ! Define dzm, the spacing between thermodynamic grid levels; centered over + ! momentum grid levels + do k=1,gr%nz-1 + gr%dzm(k) = gr%zt(k+1) - gr%zt(k) + enddo + gr%dzm(gr%nz) = gr%dzm(gr%nz-1) + + ! Define dzt, the spacing between momentum grid levels; centered over + ! thermodynamic grid levels + do k=2,gr%nz + gr%dzt(k) = gr%zm(k) - gr%zm(k-1) + enddo + gr%dzt(1) = gr%dzt(2) + + ! Define invrs_dzm, which is the inverse spacing between thermodynamic grid + ! levels; centered over momentum grid levels. + do k=1,gr%nz-1 + gr%invrs_dzm(k) = 1._core_rknd / ( gr%zt(k+1) - gr%zt(k) ) + enddo + gr%invrs_dzm(gr%nz) = gr%invrs_dzm(gr%nz-1) + + + ! Define invrs_dzt, which is the inverse spacing between momentum grid + ! levels; centered over thermodynamic grid levels. + do k=2,gr%nz + gr%invrs_dzt(k) = 1._core_rknd / ( gr%zm(k) - gr%zm(k-1) ) + enddo + gr%invrs_dzt(1) = gr%invrs_dzt(2) + + + ! Interpolation Weights: zm grid to zt grid. + ! The grid index (k) is the index of the level on the thermodynamic (zt) + ! grid. The result is the weights of the upper and lower momentum levels + ! (that sandwich the thermodynamic level) applied to that thermodynamic + ! level. These weights are normally used in situations where a momentum + ! level variable is being solved for implicitly in an equation, and the + ! aforementioned variable needs to be interpolated from three successive + ! momentum levels (the central momentum level, as well as one momentum level + ! above and below the central momentum level) to the intermediate + ! thermodynamic grid levels that sandwich the central momentum level. + ! For more information, see the comments in function interpolated_aztk_imp. + do k = 1, gr%nz, 1 + gr%weights_zm2zt(m_above:m_below,k) & + = interp_weights_zm2zt_imp( k ) + enddo + + + ! Interpolation Weights: zt grid to zm grid. + ! The grid index (k) is the index of the level on the momentum (zm) grid. + ! The result is the weights of the upper and lower thermodynamic levels + ! (that sandwich the momentum level) applied to that momentum level. These + ! weights are normally used in situations where a thermodynamic level + ! variable is being solved for implicitly in an equation, and the + ! aforementioned variable needs to be interpolated from three successive + ! thermodynamic levels (the central thermodynamic level, as well as one + ! thermodynamic level above and below the central thermodynamic level) to + ! the intermediate momentum grid levels that sandwich the central + ! thermodynamic level. + ! For more information, see the comments in function interpolated_azmk_imp. + + do k = 1, gr%nz, 1 + gr%weights_zt2zm(t_above:t_below,k) & + = interp_weights_zt2zm_imp( k ) + enddo + + return + end subroutine setup_grid_heights + + !============================================================================= + subroutine read_grid_heights( nzmax, grid_type, & + zm_grid_fname, zt_grid_fname, & + file_unit, & + momentum_heights, & + thermodynamic_heights ) + + ! Description: + ! This subroutine is used foremost in cases where the grid_type corresponds + ! with the stretched (unevenly-spaced) grid options (either grid_type = 2 or + ! grid_type = 3). This subroutine reads in the values of the stretched grid + ! altitude levels for either the thermodynamic level grid or the momentum + ! level grid. This subroutine also handles basic error checking for all + ! three grid types. + !------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + use crmx_file_functions, only: & + file_read_1d ! Procedure(s) + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables. + + ! Declared number of vertical levels. + integer, intent(in) :: & + nzmax + + ! If CLUBB is running on it's own, this option determines if it is using: + ! 1) an evenly-spaced grid; + ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid + ! levels (with momentum levels set halfway between thermodynamic levels); + ! or + ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels + ! (with thermodynamic levels set halfway between momentum levels). + integer, intent(in) :: & + grid_type + + character(len=*), intent(in) :: & + zm_grid_fname, & ! Path and filename of file for momentum level altitudes + zt_grid_fname ! Path and filename of file for thermodynamic level altitudes + + integer, intent(in) :: & + file_unit ! Unit number for zt_grid_fname & zm_grid_fname (based on the OpenMP thread) + + ! Output Variables. + + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on thermodynamic levels (grid_type = 2), it needs to use the + ! thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a stretched grid + ! entered on momentum levels (grid_type = 3), it needs to use the momentum + ! level altitudes as input. + real( kind = core_rknd ), dimension(nzmax), intent(out) :: & + momentum_heights, & ! Momentum level altitudes (file input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (file input) [m] + + ! Local Variables. + + integer :: & + zt_level_count, & ! Number of altitudes found in zt_grid_fname + zm_level_count ! Number of altitudes found in zm_grid_fname + + integer :: input_status ! Status of file being read: + ! > 0 ==> error reading file. + ! = 0 ==> no error and more file to be read. + ! < 0 ==> end of file indicator. + + ! Generic variable for storing file data while counting the number + ! of file entries. + real( kind = core_rknd ) :: generic_input_item + + integer :: k ! Loop index + + ! ---- Begin Code ---- + + ! Declare the momentum level altitude array and the thermodynamic level + ! altitude array to be 0 until overwritten. + momentum_heights(1:nzmax) = 0.0_core_rknd + thermodynamic_heights(1:nzmax) = 0.0_core_rknd + + ! Avoid uninitialized memory + generic_input_item = 0.0_core_rknd + + + if ( grid_type == 1 ) then + + ! Evenly-spaced grid. + ! Grid level altitudes are based on a constant distance between them and + ! a starting point for the bottom of the grid. + + ! As a way of error checking, make sure that there isn't any file entry + ! for either momentum level altitudes or thermodynamic level altitudes. + if ( zm_grid_fname /= '' ) then + write(fstderr,*) & + "An evenly-spaced grid has been selected. " & + // " Please reset zm_grid_fname to ''." + stop + endif + if ( zt_grid_fname /= '' ) then + write(fstderr,*) & + "An evenly-spaced grid has been selected. " & + // " Please reset zt_grid_fname to ''." + stop + endif + + + elseif ( grid_type == 2 ) then + + ! Stretched (unevenly-spaced) grid: stretched thermodynamic levels. + ! Thermodynamic levels are defined according to a stretched grid that is + ! entered through the use of an input file. Momentum levels are set + ! halfway between thermodynamic levels. This is similar to a SAM-style + ! stretched grid. + + ! As a way of error checking, make sure that there isn't any file entry + ! for momentum level altitudes. + if ( zm_grid_fname /= '' ) then + write(fstderr,*) & + "Thermodynamic level altitudes have been selected " & + // "for use in a stretched (unevenly-spaced) grid. " & + // " Please reset zm_grid_fname to ''." + stop + endif + + ! Open the file zt_grid_fname. + open( unit=file_unit, file=zt_grid_fname, & + status='old', action='read' ) + + ! Find the number of thermodynamic level altitudes listed + ! in file zt_grid_fname. + zt_level_count = 0 + do + read( unit=file_unit, fmt=*, iostat=input_status ) & + generic_input_item + if ( input_status < 0 ) exit ! end of file indicator + if ( input_status > 0 ) stop & ! error reading input + "Error reading thermodynamic level input file." + zt_level_count = zt_level_count + 1 + enddo + + ! Close the file zt_grid_fname. + close( unit=file_unit ) + + ! Check that the number of thermodynamic grid altitudes in the input file + ! matches the declared number of CLUBB grid levels (nzmax). + if ( zt_level_count /= nzmax ) then + write(fstderr,*) & + "The number of thermodynamic grid altitudes " & + // "listed in file " // trim(zt_grid_fname) & + // " does not match the number of CLUBB grid " & + // "levels specified in the model.in file." + write(fstderr,*) & + "Number of thermodynamic grid altitudes listed: ", & + zt_level_count + write(fstderr,*) & + "Number of CLUBB grid levels specified: ", nzmax + stop + endif + + ! Read the thermodynamic level altitudes from zt_grid_fname. + call file_read_1d( file_unit, zt_grid_fname, nzmax, 1, & + thermodynamic_heights ) + + ! Check that each thermodynamic level altitude increases + ! in height as the thermodynamic level grid index increases. + do k = 2, nzmax, 1 + if ( thermodynamic_heights(k) & + <= thermodynamic_heights(k-1) ) then + write(fstderr,*) & + "The declared thermodynamic level grid " & + // "altitudes are not increasing in height " & + // "as grid level index increases." + write(fstderr,*) & + "Grid index: ", k-1, ";", & + " Thermodynamic level altitude: ", & + thermodynamic_heights(k-1) + write(fstderr,*) & + "Grid index: ", k, ";", & + " Thermodynamic level altitude: ", & + thermodynamic_heights(k) + stop + endif + enddo + + + elseif ( grid_type == 3 ) then + + ! Stretched (unevenly-spaced) grid: stretched momentum levels. + ! Momentum levels are defined according to a stretched grid that is + ! entered through the use of an input file. Thermodynamic levels are set + ! halfway between momentum levels. This is similar to a WRF-style + ! stretched grid. + + ! As a way of error checking, make sure that there isn't any file entry + ! for thermodynamic level altitudes. + if ( zt_grid_fname /= '' ) then + write(fstderr,*) & + "Momentum level altitudes have been selected " & + // "for use in a stretched (unevenly-spaced) grid. " & + // " Please reset zt_grid_fname to ''." + stop + endif + + ! Open the file zm_grid_fname. + open( unit=file_unit, file=zm_grid_fname, & + status='old', action='read' ) + + ! Find the number of momentum level altitudes + ! listed in file zm_grid_fname. + zm_level_count = 0 + do + read( unit=file_unit, fmt=*, iostat=input_status ) & + generic_input_item + if ( input_status < 0 ) exit ! end of file indicator + if ( input_status > 0 ) stop & ! error reading input + "Error reading momentum level input file." + zm_level_count = zm_level_count + 1 + enddo + + ! Close the file zm_grid_fname. + close( unit=file_unit ) + + ! Check that the number of momentum grid altitudes in the input file + ! matches the declared number of CLUBB grid levels (nzmax). + if ( zm_level_count /= nzmax ) then + write(fstderr,*) & + "The number of momentum grid altitudes " & + // "listed in file " // trim(zm_grid_fname) & + // " does not match the number of CLUBB grid " & + // "levels specified in the model.in file." + write(fstderr,*) & + "Number of momentum grid altitudes listed: ", & + zm_level_count + write(fstderr,*) & + "Number of CLUBB grid levels specified: ", nzmax + stop + endif + + ! Read the momentum level altitudes from zm_grid_fname. + call file_read_1d( file_unit, zm_grid_fname, nzmax, 1, & + momentum_heights ) + + ! Check that each momentum level altitude increases in height as the + ! momentum level grid index increases. + do k = 2, nzmax, 1 + if ( momentum_heights(k) & + <= momentum_heights(k-1) ) then + write(fstderr,*) & + "The declared momentum level grid " & + // "altitudes are not increasing in height " & + // "as grid level index increases." + write(fstderr,*) & + "Grid index: ", k-1, ";", & + " Momentum level altitude: ", & + momentum_heights(k-1) + write(fstderr,*) & + "Grid index: ", k, ";", & + " Momentum level altitude: ", & + momentum_heights(k) + stop + endif + enddo + + + endif + + + ! The purpose of this if statement is to avoid a compiler warning. + if ( generic_input_item > 0.0_core_rknd ) then + ! Do nothing + endif + ! Joshua Fasching June 2008 + + return + + end subroutine read_grid_heights + + !============================================================================= + pure function linear_interpolated_azm( azt ) + + ! Description: + ! Function to interpolate a variable located on the thermodynamic grid + ! levels (azt) to the momentum grid levels (azm). This function inputs the + ! entire azt array and outputs the results as an azm array. The + ! formulation used is compatible with a stretched (unevenly-spaced) grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_interpolation, only: linear_interp_factor + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt + + ! Return Variable + real( kind = core_rknd ), dimension(gr%nz) :: linear_interpolated_azm + + ! Local Variable + integer :: k + + ! ---- Begin Code ---- + + ! Do the actual interpolation. + ! Use linear interpolation. + forall( k = 1 : gr%nz-1 : 1 ) + linear_interpolated_azm(k) = & + linear_interp_factor( gr%weights_zt2zm(1, k), azt(k+1), azt(k) ) + end forall + +! ! Set the value of azm at level gr%nz (the uppermost level in the model) +! ! to the value of azt at level gr%nz. +! linear_interpolated_azm(gr%nz) = azt(gr%nz) + ! Use a linear extension based on the values of azt at levels gr%nz and + ! gr%nz-1 to find the value of azm at level gr%nz (the uppermost level + ! in the model). + linear_interpolated_azm(gr%nz) = & + ( ( azt(gr%nz)-azt(gr%nz-1) ) & + / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) ) & + * ( gr%zm(gr%nz)-gr%zt(gr%nz) ) + azt(gr%nz) + + return + + end function linear_interpolated_azm + + !============================================================================= + pure function linear_interpolated_azmk( azt, k ) + + ! Description: + ! Function to interpolate a variable located on the thermodynamic grid + ! levels (azt) to the momentum grid levels (azm). This function outputs the + ! value of azm at a single grid level (k) after interpolating using values + ! of azt at two grid levels. The formulation used is compatible with a + ! stretched (unevenly-spaced) grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_interpolation, only: linear_interp_factor + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt + + integer, intent(in) :: k + + ! Return Variable + real( kind = core_rknd ) :: linear_interpolated_azmk + + ! ---- Begin Code ---- + + ! Do the actual interpolation. + ! Use a linear interpolation. + if ( k /= gr%nz ) then + + linear_interpolated_azmk = & + linear_interp_factor( gr%weights_zt2zm(1, k), azt(k+1), azt(k) ) + + else + +! ! Set the value of azm at level gr%nz (the uppermost level in the +! ! model) to the value of azt at level gr%nz. +! linear_interpolated_azmk = azt(gr%nz) + ! Use a linear extension based on the values of azt at levels gr%nz and + ! gr%nz-1 to find the value of azm at level gr%nz (the uppermost + ! level in the model). + linear_interpolated_azmk = & + ( ( azt(gr%nz)-azt(gr%nz-1) ) & + / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) ) & + * ( gr%zm(gr%nz)-gr%zt(gr%nz) ) + azt(gr%nz) + + endif + + return + + end function linear_interpolated_azmk + + !============================================================================= + pure function cubic_interpolated_azm( azt ) + + ! Description: + ! Function to interpolate a variable located on the thermodynamic grid + ! levels (azt) to the momentum grid levels (azm). This function outputs the + ! value of azt at a all grid levels using Steffen's monotonic cubic + ! interpolation implemented by Tak Yamaguchi. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + azt + + ! Return Variable + real( kind = core_rknd ), dimension(gr%nz) :: & + cubic_interpolated_azm + + ! Local Variable(s) + real( kind = core_rknd ), dimension(gr%nz) :: & + tmp ! This is needed for variables that self-reference + integer :: & + k + + ! ---- Begin Code ---- + + forall( k = 1 : gr%nz ) + tmp(k) = cubic_interpolated_azmk( azt, k ) + end forall + + cubic_interpolated_azm = tmp + + return + + end function cubic_interpolated_azm + + !============================================================================= + pure function cubic_interpolated_azmk( azt, k ) + + ! Description: + ! Function to interpolate a variable located on the thermodynamic grid + ! levels (azt) to the momentum grid levels (azm). This function outputs the + ! value of azm at a single grid level (k) using Steffen's monotonic cubic + ! interpolation implemented by Tak Yamaguchi. + !----------------------------------------------------------------------- + + use crmx_interpolation, only: mono_cubic_interp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt + + integer, intent(in) :: k + + ! Return Variable + real( kind = core_rknd ) :: cubic_interpolated_azmk + + ! Local Variable(s) + integer :: km1, k00, kp1, kp2 + + ! ---- Begin Code ---- + + ! Special case for a very small domain + if ( gr%nz < 3 ) then + cubic_interpolated_azmk = linear_interpolated_azmk( azt, k ) + return + end if + + ! k levels are based on Tak's find_indices subroutine -dschanen 24 Oct 2011 + if ( k == gr%nz-1 ) then + km1 = gr%nz-2 + kp1 = gr%nz + kp2 = gr%nz + k00 = gr%nz-1 + else if ( k == gr%nz ) then ! Extrapolation + km1 = gr%nz + kp1 = gr%nz + kp2 = gr%nz + k00 = gr%nz-1 + else if ( k == 1 ) then + km1 = 1 + kp1 = 2 + kp2 = 3 + k00 = 1 + else + km1 = k-1 + kp1 = k+1 + kp2 = k+2 + k00 = k + end if + + ! Do the actual interpolation. + ! Use a cubic monotonic spline interpolation. + cubic_interpolated_azmk = & + mono_cubic_interp( gr%zm(k), km1, k00, kp1, kp2, & + gr%zt(km1), gr%zt(k00), gr%zt(kp1), gr%zt(kp2), & + azt(km1), azt(k00), azt(kp1), azt(kp2) ) + + return + + end function cubic_interpolated_azmk + + !============================================================================= + pure function interpolated_azmk_imp( m_lev ) & + result( azt_weight ) + + ! Description: + ! Function used to help in an interpolation of a variable (var_zt) located + ! on the thermodynamic grid levels (azt) to the momentum grid levels (azm). + ! This function computes a weighting factor for both the upper thermodynamic + ! level (k+1) and the lower thermodynamic level (k) applied to the central + ! momentum level (k). For the uppermost momentum grid level (k=gr%nz), a + ! weighting factor for both the thermodynamic level at gr%nz and the + ! thermodynamic level at gr%nz-1 are calculated based on the use of a + ! linear extension. This function outputs the weighting factors at a single + ! momentum grid level (k). The formulation used is compatible with a + ! stretched (unevenly-spaced) grid. The weights are defined as follows: + ! + ! ---var_zt(k+1)------------------------------------------- t(k+1) + ! azt_weight(t_above) = factor + ! ===========var_zt(interp)================================ m(k) + ! azt_weight(t_below) = 1 - factor + ! ---var_zt(k)--------------------------------------------- t(k) + ! + ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes + ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! For all levels k < gr%nz: + ! + ! The formula for a linear interpolation is given by: + ! + ! var_zt( interp to zm(k) ) + ! = [ ( var_zt(k+1) - var_zt(k) ) / ( zt(k+1) - zt(k) ) ] + ! * ( zm(k) - zt(k) ) + var_zt(k); + ! + ! which can be rewritten as: + ! + ! var_zt( interp to zm(k) ) + ! = [ ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ) ] + ! * ( var_zt(k+1) - var_zt(k) ) + var_zt(k). + ! + ! Furthermore, the formula can be rewritten as: + ! + ! var_zt( interp to zm(k) ) + ! = factor * var_zt(k+1) + ( 1 - factor ) * var_zt(k); + ! + ! where: + ! + ! factor = ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ). + ! + ! One of the important uses of this function is in situations where the + ! variable to be interpolated is being treated IMPLICITLY in an equation. + ! Usually, the variable to be interpolated is involved in a derivative (such + ! as d(var_zt)/dz in the diagram below). For the term of the equation + ! containing the derivative, grid weights are needed for two interpolations, + ! rather than just one interpolation. Thus, four grid weights (labeled + ! A(k), B(k), C(k), and D(k) in the diagram below) are needed. + ! + ! ---var_zt(k+1)------------------------------------------- t(k+1) + ! A(k) + ! ===========var_zt(interp)================================ m(k) + ! B(k) = 1 - A(k) + ! ---var_zt(k)-----------d(var_zt)/dz---------------------- t(k) + ! C(k) + ! ===========var_zt(interp)================================ m(k-1) + ! D(k) = 1 - C(k) + ! ---var_zt(k-1)------------------------------------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! The grid weights, indexed around the central thermodynamic level (k), are + ! defined as follows: + ! + ! A(k) = ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ); + ! + ! which is the same as "factor" for the interpolation to momentum + ! level (k). In the code, this interpolation is referenced as + ! gr%weights_zt2zm(t_above,mk), which can be read as "grid weight in a zt2zm + ! interpolation of the thermodynamic level above momentum level (k) (applied + ! to momentum level (k))". + ! + ! B(k) = 1 - [ ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ) ] + ! = 1 - A(k); + ! + ! which is the same as "1 - factor" for the interpolation to momentum + ! level (k). In the code, this interpolation is referenced as + ! gr%weights_zt2zm(t_below,mk), which can be read as "grid weight in a zt2zm + ! interpolation of the thermodynamic level below momentum level (k) (applied + ! to momentum level (k))". + ! + ! C(k) = ( zm(k-1) - zt(k-1) ) / ( zt(k) - zt(k-1) ); + ! + ! which is the same as "factor" for the interpolation to momentum + ! level (k-1). In the code, this interpolation is referenced as + ! gr%weights_zt2zm(t_above,mkm1), which can be read as "grid weight in a + ! zt2zm interpolation of the thermodynamic level above momentum level (k-1) + ! (applied to momentum level (k-1))". + ! + ! D(k) = 1 - [ ( zm(k-1) - zt(k-1) ) / ( zt(k) - zt(k-1) ) ] + ! = 1 - C(k); + ! + ! which is the same as "1 - factor" for the interpolation to momentum + ! level (k-1). In the code, this interpolation is referenced as + ! gr%weights_zt2zm(t_below,mkm1), which can be read as "grid weight in a + ! zt2zm interpolation of the thermodynamic level below momentum level (k-1) + ! (applied to momentum level (k-1))". + ! + ! Additionally, as long as the central thermodynamic level (k) in the above + ! scenario is not the uppermost thermodynamic level or the lowermost + ! thermodynamic level (k /= gr%nz and k /= 1), the four weighting factors + ! have the following relationships: A(k) = C(k+1) and B(k) = D(k+1). + ! + ! + ! Special condition for uppermost grid level, k = gr%nz: + ! + ! The uppermost momentum grid level is above the uppermost thermodynamic + ! grid level. Thus, a linear extension is used at this level. + ! + ! For level k = gr%nz: + ! + ! The formula for a linear extension is given by: + ! + ! var_zt( extend to zm(k) ) + ! = [ ( var_zt(k) - var_zt(k-1) ) / ( zt(k) - zt(k-1) ) ] + ! * ( zm(k) - zt(k-1) ) + var_zt(k-1); + ! + ! which can be rewritten as: + ! + ! var_zt( extend to zm(k) ) + ! = [ ( zm(k) - zt(k-1) ) / ( zt(k) - zt(k-1) ) ] + ! * ( var_zt(k) - var_zt(k-1) ) + var_zt(k-1). + ! + ! Furthermore, the formula can be rewritten as: + ! + ! var_zt( extend to zm(k) ) + ! = factor * var_zt(k) + ( 1 - factor ) * var_zt(k-1); + ! + ! where: + ! + ! factor = ( zm(k) - zt(k-1) ) / ( zt(k) - zt(k-1) ). + ! + ! Due to the fact that a linear extension is being used, the value of factor + ! will be greater than 1. The weight of thermodynamic level k = gr%nz on + ! momentum level k = gr%nz equals the value of factor. The weight of + ! thermodynamic level k = gr%nz-1 on momentum level k = gr%nz equals + ! 1 - factor, which is less than 0. However, the sum of the two weights + ! equals 1. + ! + ! + ! Brian Griffin; September 12, 2008. + ! + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + t_above = 1, & ! Upper thermodynamic level. + t_below = 2 ! Lower thermodynamic level. + + ! Input + integer, intent(in) :: m_lev ! Momentum level index + + ! Output + real( kind = core_rknd ), dimension(2) :: azt_weight ! Weights of the thermodynamic levels. + + ! Local Variables + real( kind = core_rknd ) :: factor + integer :: k + + ! ---- Begin Code ---- + + ! Compute the weighting factors at momentum level k. + k = m_lev + + if ( k /= gr%nz ) then + ! At most levels, the momentum level is found in-between two + ! thermodynamic levels. Linear interpolation is used. + factor = ( gr%zm(k)-gr%zt(k) ) / ( gr%zt(k+1)-gr%zt(k) ) + else + ! The top model level (gr%nz) is formulated differently because the top + ! momentum level is above the top thermodynamic level. A linear + ! extension is required, rather than linear interpolation. + ! Note: Variable "factor" will be greater than 1 in this situation. + factor = & + ( gr%zm(gr%nz)-gr%zt(gr%nz-1) ) & + / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) + endif + + ! Weight of upper thermodynamic level on momentum level. + azt_weight(t_above) = factor + ! Weight of lower thermodynamic level on momentum level. + azt_weight(t_below) = 1.0_core_rknd - factor + + return + + end function interpolated_azmk_imp + + !============================================================================= + pure function linear_interpolated_azt( azm ) + + ! Description: + ! Function to interpolate a variable located on the momentum grid levels + ! (azm) to the thermodynamic grid levels (azt). This function inputs the + ! entire azm array and outputs the results as an azt array. The formulation + ! used is compatible with a stretched (unevenly-spaced) grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_interpolation, only: linear_interp_factor + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz) :: linear_interpolated_azt + + ! Local Variable + integer :: k ! Index + + ! ---- Begin Code ---- + + ! Do actual interpolation. + ! Use a linear interpolation. + forall( k = gr%nz : 2 : -1 ) + linear_interpolated_azt(k) = & + linear_interp_factor( gr%weights_zm2zt(1, k), azm(k), azm(k-1) ) + end forall ! gr%nz .. 2 +! ! Set the value of azt at level 1 (the lowermost level in the model) to the +! ! value of azm at level 1. +! interpolated_azt(1) = azm(1) + ! Use a linear extension based on the values of azm at levels 1 and 2 to + ! find the value of azt at level 1 (the lowermost level in the model). + linear_interpolated_azt(1) = & + ( ( azm(2)-azm(1) ) / ( gr%zm(2)-gr%zm(1) ) ) & + * ( gr%zt(1)-gr%zm(1) ) + azm(1) + + return + + end function linear_interpolated_azt + + !============================================================================= + pure function linear_interpolated_aztk( azm, k ) + + ! Description: + ! Function to interpolate a variable located on the momentum grid levels + ! (azm) to the thermodynamic grid levels (azt). This function outputs the + ! value of azt at a single grid level (k) after interpolating using values + ! of azm at two grid levels. The formulation used is compatible with a + ! stretched (unevenly-spaced) grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_interpolation, only: linear_interp_factor + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm + + integer, intent(in) :: k + + ! Return Variables + real( kind = core_rknd ) :: linear_interpolated_aztk + + ! ---- Begin Code ---- + + ! Do actual interpolation. + ! Use a linear interpolation. + if ( k /= 1 ) then + + linear_interpolated_aztk = & + linear_interp_factor( gr%weights_zm2zt(1, k), azm(k), azm(k-1) ) + + else + +! ! Set the value of azt at level 1 (the lowermost level in the model) to +! ! the value of azm at level 1. +! linear_interpolated_aztk = azm(1) + ! Use a linear extension based on the values of azm at levels 1 and 2 to + ! find the value of azt at level 1 (the lowermost level in the model). + linear_interpolated_aztk = & + ( ( azm(2)-azm(1) ) / ( gr%zm(2)-gr%zm(1) ) ) & + * ( gr%zt(1)-gr%zm(1) ) + azm(1) + + endif + + return + + end function linear_interpolated_aztk + + !============================================================================= + pure function cubic_interpolated_azt( azm ) + + ! Description: + ! Function to interpolate a variable located on the momentum grid + ! levels (azm) to the thermodynamic grid levels (azt). This function outputs the + ! value of azt at a all grid levels using Steffen's monotonic cubic + ! interpolation implemented by Tak Yamaguchi. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + azm + + ! Return Variable + real( kind = core_rknd ), dimension(gr%nz) :: & + cubic_interpolated_azt + + ! Local Variable(s) + real( kind = core_rknd ), dimension(gr%nz) :: & + tmp ! This is needed for variables that self-reference + integer :: & + k + + ! ---- Begin Code ---- + + forall ( k = 1 : gr%nz ) + tmp(k) = cubic_interpolated_aztk( azm, k ) + end forall + + cubic_interpolated_azt = tmp + + return + + end function cubic_interpolated_azt + + + !============================================================================= + pure function cubic_interpolated_aztk( azm, k ) + + ! Description: + ! Function to interpolate a variable located on the momentum grid + ! levels (azm) to the thermodynamic grid levels (azt). This function outputs the + ! value of azt at a single grid level (k) using Steffen's monotonic cubic + ! interpolation implemented by Tak Yamaguchi. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_interpolation, only: mono_cubic_interp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm + + integer, intent(in) :: k + + ! Return Variable + real( kind = core_rknd ) :: cubic_interpolated_aztk + + ! Local Variable(s) + integer :: km1, k00, kp1, kp2 + + ! ---- Begin Code ---- + + ! Special case for a very small domain + if ( gr%nz < 3 ) then + cubic_interpolated_aztk = linear_interpolated_aztk( azm, k ) + return + end if + + ! k levels are based on Tak's find_indices subroutine -dschanen 24 Oct 2011 + if ( k == gr%nz ) then + km1 = gr%nz-2 + kp1 = gr%nz + kp2 = gr%nz + k00 = gr%nz-1 + else if ( k == 2 ) then + km1 = 1 + kp1 = 2 + kp2 = 3 + k00 = 1 + else if ( k == 1 ) then ! Extrapolation for the ghost point + km1 = gr%nz + k00 = 1 + kp1 = 2 + kp2 = 3 + else + km1 = k-2 + kp1 = k + kp2 = k+1 + k00 = k-1 + end if + ! Do the actual interpolation. + ! Use a cubic monotonic spline interpolation. + cubic_interpolated_aztk = & + mono_cubic_interp( gr%zt(k), km1, k00, kp1, kp2, & + gr%zm(km1), gr%zm(k00), gr%zm(kp1), gr%zm(kp2), & + azm(km1), azm(k00), azm(kp1), azm(kp2) ) + + return + + end function cubic_interpolated_aztk + + !============================================================================= + pure function interpolated_aztk_imp( t_lev ) & + result( azm_weight ) + + ! Description: + ! Function used to help in an interpolation of a variable (var_zm) located + ! on the momentum grid levels (azm) to the thermodynamic grid levels (azt). + ! This function computes a weighting factor for both the upper momentum + ! level (k) and the lower momentum level (k-1) applied to the central + ! thermodynamic level (k). For the lowermost thermodynamic grid + ! level (k=1), a weighting factor for both the momentum level at 1 and the + ! momentum level at 2 are calculated based on the use of a linear extension. + ! This function outputs the weighting factors at a single thermodynamic grid + ! level (k). The formulation used is compatible with a stretched + ! (unevenly-spaced) grid. The weights are defined as follows: + ! + ! ===var_zm(k)============================================= m(k) + ! azm_weight(m_above) = factor + ! -----------var_zm(interp)-------------------------------- t(k) + ! azm_weight(m_below) = 1 - factor + ! ===var_zm(k-1)=========================================== m(k-1) + ! + ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes + ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for + ! thermodynamic levels and the letter "m" is used for momentum levels. + ! + ! For all levels k > 1: + ! + ! The formula for a linear interpolation is given by: + ! + ! var_zm( interp to zt(k) ) + ! = [ ( var_zm(k) - var_zm(k-1) ) / ( zm(k) - zm(k-1) ) ] + ! * ( zt(k) - zm(k-1) ) + var_zm(k-1); + ! + ! which can be rewritten as: + ! + ! var_zm( interp to zt(k) ) + ! = [ ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ) ] + ! * ( var_zm(k) - var_zm(k-1) ) + var_zm(k-1). + ! + ! Furthermore, the formula can be rewritten as: + ! + ! var_zm( interp to zt(k) ) + ! = factor * var_zm(k) + ( 1 - factor ) * var_zm(k-1); + ! + ! where: + ! + ! factor = ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ). + ! + ! One of the important uses of this function is in situations where the + ! variable to be interpolated is being treated IMPLICITLY in an equation. + ! Usually, the variable to be interpolated is involved in a derivative (such + ! as d(var_zm)/dz in the diagram below). For the term of the equation + ! containing the derivative, grid weights are needed for two interpolations, + ! rather than just one interpolation. Thus, four grid weights (labeled + ! A(k), B(k), C(k), and D(k) in the diagram below) are needed. + ! + ! ===var_zm(k+1)=========================================== m(k+1) + ! A(k) + ! -----------var_zm(interp)-------------------------------- t(k+1) + ! B(k) = 1 - A(k) + ! ===var_zm(k)===========d(var_zm)/dz====================== m(k) + ! C(k) + ! -----------var_zm(interp)-------------------------------- t(k) + ! D(k) = 1 - C(k) + ! ===var_zm(k-1)=========================================== m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! The grid weights, indexed around the central momentum level (k), are + ! defined as follows: + ! + ! A(k) = ( zt(k+1) - zm(k) ) / ( zm(k+1) - zm(k) ); + ! + ! which is the same as "factor" for the interpolation to thermodynamic + ! level (k+1). In the code, this interpolation is referenced as + ! gr%weights_zm2zt(m_above,tkp1), which can be read as "grid weight in a + ! zm2zt interpolation of the momentum level above thermodynamic + ! level (k+1) (applied to thermodynamic level (k+1))". + ! + ! B(k) = 1 - [ ( zt(k+1) - zm(k) ) / ( zm(k+1) - zm(k) ) ] + ! = 1 - A(k); + ! + ! which is the same as "1 - factor" for the interpolation to thermodynamic + ! level (k+1). In the code, this interpolation is referenced as + ! gr%weights_zm2zt(m_below,tkp1), which can be read as "grid weight in a + ! zm2zt interpolation of the momentum level below thermodynamic + ! level (k+1) (applied to thermodynamic level (k+1))". + ! + ! C(k) = ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ); + ! + ! which is the same as "factor" for the interpolation to thermodynamic + ! level (k). In the code, this interpolation is referenced as + ! gr%weights_zm2zt(m_above,tk), which can be read as "grid weight in a zm2zt + ! interpolation of the momentum level above thermodynamic level (k) (applied + ! to thermodynamic level (k))". + ! + ! D(k) = 1 - [ ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ) ] + ! = 1 - C(k); + ! + ! which is the same as "1 - factor" for the interpolation to thermodynamic + ! level (k). In the code, this interpolation is referenced as + ! gr%weights_zm2zt(m_below,tk), which can be read as "grid weight in a zm2zt + ! interpolation of the momentum level below thermodynamic level (k) (applied + ! to thermodynamic level (k))". + ! + ! Additionally, as long as the central momentum level (k) in the above + ! scenario is not the lowermost momentum level or the uppermost momentum + ! level (k /= 1 and k /= gr%nz), the four weighting factors have the + ! following relationships: A(k) = C(k+1) and B(k) = D(k+1). + ! + ! + ! Special condition for lowermost grid level, k = 1: + ! + ! The lowermost thermodynamic grid level is below the lowermost momentum + ! grid level. Thus, a linear extension is used at this level. It should + ! be noted that the thermodynamic level k = 1 is considered to be below the + ! model lower boundary, which is defined to be at momentum level k = 1. + ! Thus, the values of most variables at thermodynamic level k = 1 are not + ! often needed or referenced. + ! + ! For level k = 1: + ! + ! The formula for a linear extension is given by: + ! + ! var_zm( extend to zt(k) ) + ! = [ ( var_zm(k+1) - var_zm(k) ) / ( zm(k+1) - zm(k) ) ] + ! * ( zt(k) - zm(k) ) + var_zm(k); + ! + ! which can be rewritten as: + ! + ! var_zm( extend to zt(k) ) + ! = [ ( zt(k) - zm(k) ) / ( zm(k+1) - zm(k) ) ] + ! * ( var_zm(k+1) - var_zm(k) ) + var_zm(k). + ! + ! Furthermore, the formula can be rewritten as: + ! + ! var_zm( extend to zt(k) ) + ! = factor * var_zm(k+1) + ( 1 - factor ) * var_zm(k); + ! + ! where: + ! + ! factor = ( zt(k) - zm(k) ) / ( zm(k+1) - zm(k) ). + ! + ! Due to the fact that a linear extension is being used, the value of factor + ! will be less than 0. The weight of the upper momentum level, which is + ! momentum level k = 2, on thermodynamic level k = 1 equals the value of + ! factor. The weight of the lower momentum level, which is momentum level + ! k = 1, on thermodynamic level k = 1 equals 1 - factor, which is greater + ! than 1. However, the sum of the weights equals 1. + ! + ! + ! Brian Griffin; September 12, 2008. + ! + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + m_above = 1, & ! Upper momentum level. + m_below = 2 ! Lower momentum level. + + ! Input + integer, intent(in) :: t_lev ! Thermodynamic level index. + + ! Output + real( kind = core_rknd ), dimension(2) :: azm_weight ! Weights of the momentum levels. + + ! Local Variables + real( kind = core_rknd ) :: factor + integer :: k + + ! ---- Begin Code ---- + + ! Compute the weighting factors at thermodynamic level k. + k = t_lev + + if ( k /= 1 ) then + ! At most levels, the thermodynamic level is found in-between two + ! momentum levels. Linear interpolation is used. + factor = ( gr%zt(k)-gr%zm(k-1) ) / ( gr%zm(k)-gr%zm(k-1) ) + else + ! The bottom model level (1) is formulated differently because the bottom + ! thermodynamic level is below the bottom momentum level. A linear + ! extension is required, rather than linear interpolation. + ! Note: Variable "factor" will have a negative sign in this situation. + factor = ( gr%zt(1)-gr%zm(1) ) / ( gr%zm(2)-gr%zm(1) ) + endif + + ! Weight of upper momentum level on thermodynamic level. + azm_weight(m_above) = factor + ! Weight of lower momentum level on thermodynamic level. + azm_weight(m_below) = 1.0_core_rknd - factor + + return + + end function interpolated_aztk_imp + + !============================================================================= + pure function gradzm( azm ) + + ! Description: + ! Function to compute the vertical derivative of a variable (azm) located on + ! the momentum grid. The results are returned in an array defined on the + ! thermodynamic grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm + + ! Return Variable + real( kind = core_rknd ), dimension(gr%nz) :: gradzm + + ! Local Variable + integer :: k + + ! ---- Begin Code ---- + + ! Compute vertical derivatives. + forall( k = gr%nz : 2 : -1 ) + ! Take derivative of momentum-level variable azm over the central + ! thermodynamic level (k). + gradzm(k) = ( azm(k) - azm(k-1) ) * gr%invrs_dzt(k) + end forall ! gr%nz .. 2 +! ! Thermodynamic level 1 is located below momentum level 1, so there is not +! ! enough information to calculate the derivative over thermodynamic +! ! level 1. Thus, the value of the derivative at thermodynamic level 1 is +! ! set equal to 0. This formulation is consistent with setting the value of +! ! the variable azm below the model grid to the value of the variable azm at +! ! the lowest grid level. +! gradzm(1) = 0. + ! Thermodynamic level 1 is located below momentum level 1, so there is not + ! enough information to calculate the derivative over thermodynamic level 1. + ! Thus, the value of the derivative at thermodynamic level 1 is set equal to + ! the value of the derivative at thermodynamic level 2. This formulation is + ! consistent with using a linear extension to find the values of the + ! variable azm below the model grid. + gradzm(1) = gradzm(2) + + return + + end function gradzm + + !============================================================================= + pure function gradzt( azt ) + + ! Description: + ! Function to compute the vertical derivative of a variable (azt) located on + ! the thermodynamic grid. The results are returned in an array defined on + ! the momentum grid. + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz) :: gradzt + + ! Local Variable + integer :: k + + ! ---- Begin Code ---- + + ! Compute vertical derivative. + forall( k = 1 : gr%nz-1 : 1 ) + ! Take derivative of thermodynamic-level variable azt over the central + ! momentum level (k). + gradzt(k) = ( azt(k+1) - azt(k) ) * gr%invrs_dzm(k) + end forall ! 1 .. gr%nz-1 +! ! Momentum level gr%nz is located above thermodynamic level gr%nz, so +! ! there is not enough information to calculate the derivative over momentum +! ! level gr%nz. Thus, the value of the derivative at momentum level +! ! gr%nz is set equal to 0. This formulation is consistent with setting +! ! the value of the variable azt above the model grid to the value of the +! ! variable azt at the highest grid level. +! gradzt(gr%nz) = 0. + ! Momentum level gr%nz is located above thermodynamic level gr%nz, so + ! there is not enough information to calculate the derivative over momentum + ! level gr%nz. Thus, the value of the derivative at momentum level + ! gr%nz is set equal to the value of the derivative at momentum level + ! gr%nz-1. This formulation is consistent with using a linear extension + ! to find the values of the variable azt above the model grid. + gradzt(gr%nz) = gradzt(gr%nz-1) + + return + + end function gradzt + + !============================================================================= + pure function flip( x, xdim ) + + ! Description: + ! Flips a single dimension array (i.e. a vector), so the first element + ! becomes the last and vice versa for the whole column. This is a + ! necessary part of the code because BUGSrad and CLUBB store altitudes in + ! reverse order. + ! + ! References: + ! None + !------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + dp ! double precision + + implicit none + + ! Input Variables + integer, intent(in) :: xdim + + real(kind = dp), dimension(xdim), intent(in) :: x + + ! Output Variables + real(kind = dp), dimension(xdim) :: flip + + ! Local Variables + real(kind = dp), dimension(xdim) :: tmp + + integer :: indx + + ! ---- Begin Code ---- + + forall ( indx = 1 : xdim ) + tmp(indx) = x((xdim+1) - (indx)) + end forall + + flip = tmp + + return + end function flip + +!=============================================================================== + +end module crmx_grid_class diff --git a/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 new file mode 100644 index 0000000000..48231ba015 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 @@ -0,0 +1,746 @@ +!----------------------------------------------------------------------- +! $Id: hydrostatic_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_hydrostatic_module + + implicit none + + private ! Default Scope + + public :: hydrostatic, & + inverse_hydrostatic + + private :: calc_exner_const_thvm, & + calc_exner_linear_thvm, & + calc_z_linear_thvm + + contains + +!=============================================================================== + subroutine hydrostatic( thvm, p_sfc, & + p_in_Pa, p_in_Pa_zm, & + exner, exner_zm, & + rho, rho_zm ) + + ! Description: + ! This subroutine integrates the hydrostatic equation. + ! + ! The hydrostatic equation is of the form: + ! + ! dp/dz = - rho * grav. + ! + ! This equation can be re-written in terms of d(exner)/dz, such that: + ! + ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } / { R_d * rho } ] * d(exner)/dz + ! = - grav / C_p; + ! + ! which can also be expressed as: + ! + ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } / { R_d * rho_d * ( 1 + r_v + r_c ) } ] + ! * d(exner)/dz + ! = - grav / C_p. + ! + ! Furthermore, the moist equation of state can be written as: + ! + ! theta = + ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } + ! / { R_d * rho_d * ( 1 + (R_v/R_d)*r_v ) } ]. + ! + ! The relationship between theta and theta_v (including water vapor and + ! cloud water) is: + ! + ! theta_v = theta * [ ( 1 + (R_v/R_d)*r_v ) / ( 1 + r_v + r_c ) ]; + ! + ! which, when substituted into the above equation, changes the equation of + ! state to: + ! + ! theta_v = + ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } + ! / { R_d * rho_d * ( 1 + r_v + r_c ) } ]. + ! + ! This equation is substituted into the d(exner)/dz form of the hydrostatic + ! equation, resulting in: + ! + ! theta_v * d(exner)/dz = - grav / C_p; + ! + ! which can be re-written as: + ! + ! d(exner)/dz = - grav / ( C_p * theta_v ). + ! + ! This subroutine integrates the above equation to solve for exner, such + ! that: + ! + ! INT(exner_1:exner_2) d(exner) = + ! - ( grav / C_p ) * INT(z_1:z_2) ( 1 / theta_v ) dz. + ! + ! + ! The resulting value of exner is used to calculate pressure. Then, the + ! values of pressure, exner, and theta_v can be used to calculate density. + + ! References: + ! + !------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + kappa, & ! Variable(s) + p0, & + Rd, & + zero_threshold + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt, & ! Procedure(s) + zt2zm + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + p_sfc ! Pressure at the surface [Pa] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + thvm ! Virtual potential temperature [K] + + ! Output Variables + real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & + p_in_Pa, & ! Pressure (thermodynamic levels) [Pa] + p_in_Pa_zm, & ! Pressure on momentum levels [Pa] + exner, & ! Exner function (thermodynamic levels) [-] + exner_zm, & ! Exner function on momentum levels [-] + rho, & ! Density (thermodynamic levels) [kg/m^3] + rho_zm ! Density on momentum levels [kg/m^3] + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + thvm_zm ! Theta_v interpolated to momentum levels [K] + + real( kind = core_rknd ) :: & + dthvm_dz ! Constant d(thvm)/dz between successive levels [K/m] + + integer :: k + + ! Interpolate thvm from thermodynamic to momentum levels. Linear + ! interpolation is used, except for the uppermost momentum level, where a + ! linear extension is used. Since thvm is considered to either be constant + ! or vary linearly over the depth of a grid level, this interpolation is + ! consistent with the rest of this code. + thvm_zm = zt2zm( thvm ) + + ! Exner is defined on thermodynamic grid levels except for the value at + ! index 1. Since thermodynamic level 1 is below the surface, it is + ! disregarded, and the value of exner(1) corresponds to surface value, which + ! is actually at momentum level 1. + exner(1) = ( p_sfc/p0 )**kappa + exner_zm(1) = ( p_sfc/p0 )**kappa + + ! Consider the value of exner at thermodynamic level (2) to be based on + ! a constant thvm between thermodynamic level (2) and momentum level (1), + ! which is the surface or model lower boundary. Since thlm(1) is set equal + ! to thlm(2), the values of thvm are considered to be basically constant + ! near the ground. + exner(2) & + = calc_exner_const_thvm( thvm(2), gr%zt(2), gr%zm(1), exner(1) ) + + ! Given the value of exner at thermodynamic level k-1, and considering + ! thvm to vary linearly between its values at thermodynamic levels k + ! and k-1, the value of exner can be found at thermodynamic level k, + ! as well as at intermediate momentum level k-1. + do k = 3, gr%nz + + dthvm_dz = gr%invrs_dzm(k-1) * ( thvm(k) - thvm(k-1) ) + + if ( dthvm_dz /= 0.0_core_rknd ) then + + exner(k) & + = calc_exner_linear_thvm( thvm(k-1), dthvm_dz, & + gr%zt(k-1), gr%zt(k), exner(k-1) ) + + exner_zm(k-1) & + = calc_exner_linear_thvm( thvm(k-1), dthvm_dz, & + gr%zt(k-1), gr%zm(k-1), exner(k-1) ) + + else ! dthvm_dz = 0 + + exner(k) & + = calc_exner_const_thvm & + ( thvm(k), gr%zt(k), gr%zt(k-1), exner(k-1) ) + + exner_zm(k-1) & + = calc_exner_const_thvm & + ( thvm(k), gr%zm(k-1), gr%zt(k-1), exner(k-1) ) + + endif + + enddo ! k = 3, gr%nz + + ! Find the value of exner_zm at momentum level gr%nz by using a linear + ! extension of thvm from the two thermodynamic level immediately below + ! momentum level gr%nz. + dthvm_dz = ( thvm_zm(gr%nz) - thvm(gr%nz) ) & + / ( gr%zm(gr%nz) - gr%zt(gr%nz) ) + + if ( dthvm_dz /= 0.0_core_rknd ) then + + exner_zm(gr%nz) & + = calc_exner_linear_thvm & + ( thvm(gr%nz), dthvm_dz, & + gr%zt(gr%nz), gr%zm(gr%nz), exner(gr%nz) ) + + else ! dthvm_dz = 0 + + exner_zm(gr%nz) & + = calc_exner_const_thvm & + ( thvm(gr%nz), gr%zm(gr%nz), gr%zt(gr%nz), exner(gr%nz) ) + + endif + + ! Calculate pressure based on the values of exner. + + do k = 1, gr%nz + p_in_Pa(k) = p0 * exner(k)**( 1._core_rknd/kappa ) + p_in_Pa_zm(k) = p0 * exner_zm(k)**( 1._core_rknd/kappa ) + enddo + + ! Calculate density based on pressure, exner, and thvm. + + do k = 1, gr%nz + rho(k) = p_in_Pa(k) / ( Rd * thvm(k) * exner(k) ) + rho_zm(k) = p_in_Pa_zm(k) / ( Rd * thvm_zm(k) * exner_zm(k) ) + enddo + + + return + end subroutine hydrostatic + +!=============================================================================== + subroutine inverse_hydrostatic( p_sfc, zm_init, nlevels, thvm, exner, & + z ) + + ! Description: + ! Subprogram to integrate the inverse of hydrostatic equation + + ! References: + ! + !------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + p0, & ! Constant(s) + kappa, & + fstderr + + use crmx_interpolation, only: & + binary_search ! Procedure(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + p_sfc, & ! Pressure at the surface [Pa] + zm_init ! Altitude at the surface [m] + + integer, intent(in) :: & + nlevels ! Number of levels in the sounding [-] + + real( kind = core_rknd ), intent(in), dimension(nlevels) :: & + thvm, & ! Virtual potential temperature [K] + exner ! Exner function [-] + + ! Output Variables + real( kind = core_rknd ), intent(out), dimension(nlevels) :: & + z ! Height [m] + + ! Local Variables + integer :: k + + real( kind = core_rknd ), dimension(nlevels) :: & + ref_z_snd ! Altitude minus altitude of the lowest sounding level [m] + + real( kind = core_rknd ), dimension(nlevels) :: & + exner_reverse_array ! Array of exner snd. values in reverse order [-] + + real( kind = core_rknd ) :: & + exner_sfc, & ! Value of exner at the surface [-] + ref_z_sfc, & ! Alt. diff between surface and lowest snd. level [m] + z_snd_bottom, & ! Altitude of the bottom of the input sounding [m] + dthvm_dexner ! Constant rate of change of thvm with respect to + ! exner between sounding levels k-1 and k [K] + + integer :: & + rev_low_idx, & + low_idx, & + high_idx + + + ! Variable ref_z_sfc is initialized to 0.0 to avoid a compiler warning. + ref_z_sfc = 0.0_core_rknd + + ! The variable ref_z_snd is the altitude of each sounding level compared to + ! the altitude of the lowest sounding level. Thus, the value of ref_z_snd + ! at sounding level 1 is 0. The lowest sounding level may or may not be + ! right at the surface, and therefore an adjustment may be required to find + ! the actual altitude above ground. + ref_z_snd(1) = 0.0_core_rknd + + do k = 2, nlevels + + ! The value of thvm is given at two successive sounding levels. For + ! purposes of achieving a quality estimate of altitude at each pressure + ! sounding level, the value of thvm is considered to vary linearly + ! with respect to exner between two successive sounding levels. Thus, + ! there is a constant d(thvm)/d(exner) between the two successive + ! sounding levels. If thvm is constant, then d(thvm)/d(exner) is 0. + dthvm_dexner = ( thvm(k) - thvm(k-1) ) / ( exner(k) - exner(k-1) ) + + ! Calculate the value of the reference height at sounding level k, based + ! the value of thvm at sounding level k-1, the constant value of + ! d(thvm)/d(exner), the value of exner at sounding levels k-1 and k, and + ! the reference altitude at sounding level k-1. + ref_z_snd(k) & + = calc_z_linear_thvm( thvm(k-1), dthvm_dexner, & + exner(k-1), exner(k), ref_z_snd(k-1) ) + + enddo + + ! Find the actual (above ground) altitude of the sounding levels from the + ! reference altitudes. + + ! The pressure at the surface (or model lower boundary), p_sfc, is found at + ! the altitude of the surface (or model lower boundary), zm_init. + + ! Find the value of exner at the surface from the pressure at the surface. + exner_sfc = ( p_sfc / p0 )**kappa + + ! Find the value of exner_sfc compared to the values of exner in the exner + ! sounding profile. + + if ( exner_sfc < exner(nlevels) ) then + + ! Since the values of exner decrease monotonically with height (and thus + ! with sounding level), the value of exner_sfc is less than all the + ! values of exner in the sounding (and thus the surface is located above + ! all the levels of the sounding), then there is insufficient information + ! to run the model. Stop the run. + + write(fstderr,*) "The entire sounding is below the model surface." + stop + + elseif ( exner_sfc > exner(1) ) then + + ! Since the values of exner decrease monotonically with height (and thus + ! with sounding level), the value of exner_sfc is greater than all the + ! values of exner in the sounding (and thus the surface is located below + ! all the levels of the sounding), use a linear extension of thvm to find + ! thvm at the surface. Thus, d(thvm)/d(exner) is the same as its value + ! between sounding levels 1 and 2. If the surface is so far below the + ! sounding that gr%zt(2) is below the first sounding level, the code in + ! subroutine read_sounding (found in sounding.F90) will stop the run. + + ! Calculate the appropriate d(thvm)/d(exner). + dthvm_dexner = ( thvm(2) - thvm(1) ) / ( exner(2) - exner(1) ) + + ! Calculate the difference between the altitude of the surface (or model + ! lower boundary) and the altitude of the lowest level of the sounding. + ref_z_sfc & + = calc_z_linear_thvm( thvm(1), dthvm_dexner, & + exner(1), exner_sfc, ref_z_snd(1) ) + + else ! exner(nlevels) < exner_sfc < exner(1) + + ! Since the values of exner decrease monotonically with height (and thus + ! with sounding level), the value of exner_sfc is between two values of + ! exner (at some levels k-1 and k) in the sounding, and the value of + ! d(thvm)/d(exner) is the same as between those two levels in the above + ! calculation. + + ! The value of exner_sfc is between two levels of the exner sounding. + ! Find the index of the lower level. + + ! In order to use the binary search, the array must be sorted from least + ! value to greatest value. Since exner decreases with altitude (and + ! vertical level), the array that is sent to function binary_search must + ! be the exact reverse of exner. + ! Thus, exner(1) becomes exner_reverse_array(nlevels), exner(nlevels) + ! becomes exner_reverse_array(1), etc. + do k = 1, nlevels, 1 + exner_reverse_array(k) = exner(nlevels-k+1) + enddo + ! The output from the binary search yields the first value in the + ! exner_reverse_array that is greater than or equal to exner_sfc. Thus, + ! in regards to the regular exner array, this is the reverse index of + ! the lower sounding level for exner_sfc. For example, if exner_sfc + ! is found between exner(1) and exner(2), the binary search for exner_sfc + ! in regards to exner_reverse_index will return a value of nlevels. + ! Once the actual lower level index is calculated, the result will be 1. + rev_low_idx = binary_search( nlevels, exner_reverse_array, exner_sfc ) + + ! Find the lower level index for the regular exner profile from the + ! lower level index for the reverse exner profile. + low_idx = nlevels - rev_low_idx + 1 + + ! Find the index of the upper level. + high_idx = low_idx + 1 + + ! Calculate the appropriate d(thvm)/d(exner). + dthvm_dexner = ( thvm(high_idx) - thvm(low_idx) ) & + / ( exner(high_idx) - exner(low_idx) ) + + ! Calculate the difference between the altitude of the surface (or model + ! lower boundary) and the altitude of the lowest level of the sounding. + ref_z_sfc & + = calc_z_linear_thvm( thvm(low_idx), dthvm_dexner, & + exner(low_idx), exner_sfc, ref_z_snd(low_idx) ) + + endif ! exner_sfc + + ! Find the altitude of the bottom of the sounding. + z_snd_bottom = zm_init - ref_z_sfc + + ! Calculate the sounding altitude profile based + ! on z_snd_bottom and ref_z_snd. + do k = 1, nlevels, 1 + z(k) = z_snd_bottom + ref_z_snd(k) + enddo + + + return + end subroutine inverse_hydrostatic + +!=============================================================================== + pure function calc_exner_const_thvm( thvm, z_2, z_1, exner_1 ) & + result( exner_2 ) + + ! Description: + ! This function solves for exner at a level, given exner at another level, + ! the altitudes of both levels, and a constant thvm over the depth of the + ! level. + ! + ! The derivative of exner is given by the following equation: + ! + ! d(exner)/dz = - grav / (Cp * thvm). + ! + ! This equation is integrated to solve for exner, such that: + ! + ! INT(exner_1:exner_2) d(exner) + ! = - ( grav / Cp ) INT(z_1:z_2) (1/thvm) dz. + ! + ! Since thvm is considered to be a constant over the depth of the layer + ! between z_1 and z_2, the equation can be written as: + ! + ! INT(exner_1:exner_2) d(exner) = - grav / ( Cp * thvm ) INT(z_1:z_2) dz. + ! + ! Solving the integral: + ! + ! exner_2 = exner_1 - [ grav / ( Cp * thvm ) ] * ( z_2 - z_1 ). + + ! References: + !------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + grav, & ! Gravitational acceleration [m/s^2] + Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + thvm, & ! Constant value of thvm over the layer [K] + z_2, & ! Altitude at the top of the layer [m] + z_1, & ! Altitude at the bottom of the layer [m] + exner_1 ! Exner at the bottom of the layer [-] + + ! Return Variable + real( kind = core_rknd ) :: exner_2 ! Exner at the top of the layer [-] + + ! Calculate exner at top of the layer. + exner_2 = exner_1 - ( grav / ( Cp * thvm ) ) * ( z_2 - z_1 ) + + return + end function calc_exner_const_thvm + +!=============================================================================== + pure function calc_exner_linear_thvm( thvm_km1, dthvm_dz, & + z_km1, z_2, exner_km1 ) & + result( exner_2 ) + + ! Description: + ! This function solves for exner at a level, given exner at another level, + ! the altitudes of both levels, and a value of thvm that is considered to + ! vary linearly over the depth of the level. + ! + ! The derivative of exner is given by the following equation: + ! + ! d(exner)/dz = - grav / (Cp * thvm). + ! + ! This equation is integrated to solve for exner, such that: + ! + ! INT(exner_1:exner_2) d(exner) + ! = - ( grav / Cp ) INT(z_1:z_2) (1/thvm) dz. + ! + ! The value of thvm is considered to vary linearly (with respect to height) + ! over the depth of the level (resulting in a constant d(thvm)/dz over the + ! depth of the level). The entire level between z_1 and z_2 must be + ! encompassed between two levels with two known values of thvm. The value + ! of thvm at the upper level (z_up) is called thvm_up, and the value of thvm + ! at the lower level (z_low) is called thvm_low. Again, the values of thvm + ! at all interior altitudes, z_low <= z_1 < z <= z_2 <= z_up, behave + ! linearly between thvm_low and thvm_up, such that: + ! + ! thvm(z) + ! = [ ( thvm_up - thvm_low ) / ( z_up - z_low ) ] * ( z - z_low) + ! + thvm_low + ! = [ d(thvm)/dz ] * ( z - z_low ) + thvm_low + ! = C_a*z + C_b; + ! + ! where: + ! + ! C_a + ! = ( thvm_up - thvm_low ) / ( z_up - z_low ) + ! = d(thvm)/dz; + ! + ! and: + ! + ! C_b + ! = thvm_low - [ ( thvm_up - thvm_low ) / ( z_up - z_low ) ] * z_low + ! = thvm_low - [ d(thvm)/dz ] * z_low. + ! + ! The integral becomes: + ! + ! INT(exner_1:exner_2) d(exner) + ! = - ( grav / Cp ) INT(z_1:z_2) [ 1 / ( C_a*z + C_b ) ] dz. + ! + ! Performing a u-substitution ( u = C_a*z + C_b ), the equation becomes: + ! + ! INT(exner_1:exner_2) d(exner) + ! = - ( grav / Cp ) * ( 1 / C_a ) INT(z=z_1:z=z_2) (1/u) du. + ! + ! Solving the integral, and then re-substituting for u: + ! + ! exner_2 = exner_1 + ! - ( grav / Cp ) * ( 1 / C_a ) + ! * ln [ ( C_a*z_2 + C_b ) / ( C_a*z_1 + C_b ) ]. + ! + ! Re-substituting for C_a and C_b: + ! + ! exner_2 + ! = exner_1 + ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) + ! * ln [ ( {d(thvm)/dz}*z_2 + thvm_low - {d(thvm)/dz}*z_low ) + ! / ( {d(thvm)/dz}*z_1 + thvm_low - {d(thvm)/dz}*z_low ) ]. + ! + ! This equation is used to calculate exner_2 using exner_1, which is at the + ! same level as z_1. Furthermore, thvm_low and z_low are taken from the + ! same level as z_1 and exner_1. Thus, z_1 = z_low. Therefore: + ! + ! exner_2 + ! = exner_low + ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) + ! * ln [ ( thvm_low + {d(thvm)/dz}*(z_2-z_low) ) / thvm_low ]. + ! + ! Considering either a thermodynamic or sounding level k-1 as the low level + ! in the integration, and that thvm varies linearly between level k-1 and + ! level k: + ! + ! exner_2 + ! = exner(k-1) + ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) + ! * ln [ ( thvm(k-1) + {d(thvm)/dz}*(z_2-z(k-1)) ) / thvm(k-1) ]; + ! + ! where: + ! + ! d(thvm)/dz = ( thvm(k) - thvm(k-1) ) / ( z(k) - z(k-1) ); + ! + ! and where z(k-1) < z_2 <= z(k); and {d(thvm)/dz} /= 0. If the value of + ! {d(thvm)/dz} is 0, then thvm is considered to be a constant over the depth + ! of the level. The appropriate equation is found in pure function + ! calc_exner_const_thvm. + + ! References: + !------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + grav, & ! Gravitational acceleration [m/s^2] + Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + thvm_km1, & ! Value of thvm at level k-1 [K] + dthvm_dz, & ! Constant d(thvm)/dz between levels k-1 and k [K/m] + z_km1, & ! Altitude at level k-1 [m] + z_2, & ! Altitude at the top of the layer [m] + exner_km1 ! Exner at level k-1 [-] + + ! Return Variable + real( kind = core_rknd ) :: exner_2 ! Exner at the top of the layer [-] + + ! Calculate exner at the top of the layer. + exner_2 & + = exner_km1 & + - ( grav / Cp ) * ( 1.0_core_rknd / dthvm_dz ) & + * log( ( thvm_km1 + dthvm_dz * ( z_2 - z_km1 ) ) / thvm_km1 ) + + return + end function calc_exner_linear_thvm + +!=============================================================================== + pure function calc_z_linear_thvm( thvm_km1, dthvm_dexner, & + exner_km1, exner_2, z_km1 ) & + result( z_2 ) + + ! Description: + ! This function solves for z (altitude) at a level, given altitude at + ! another level, the values of exner at both levels, and a value of thvm + ! that is considered to vary linearly over the depth of the level. + ! + ! The derivative of exner is given by the following equation: + ! + ! d(exner)/dz = - grav / (Cp * thvm). + ! + ! This equation is integrated to solve for z, such that: + ! + ! INT(exner_1:exner_2) thvm d(exner) = - ( grav / Cp ) INT(z_1:z_2) dz. + ! + ! The value of thvm is considered to vary linearly (with respect to exner) + ! over the depth of the level (resulting in a constant d(thvm)/d(exner) over + ! the depth of the level). The entire level between exner_1 and exner_2 + ! must be encompassed between two levels with two known values of thvm. The + ! value of thvm at the upper level (exner_up) is called thvm_up, and the + ! value of thvm at the lower level (exner_low) is called thvm_low. Again, + ! the values of thvm at all interior exner levels, + ! exner_low >= exner_1 > exner >= exner_2 >= exner_up, behave linearly + ! between thvm_low and thvm_up, such that: + ! + ! thvm(exner) + ! = [ ( thvm_up - thvm_low ) / ( exner_up - exner_low ) ] + ! * ( exner - exner_low ) + ! + thvm_low + ! = [ d(thvm)/d(exner) ] * ( exner - exner_low ) + thvm_low + ! = C_a*z + C_b; + ! + ! where: + ! + ! C_a + ! = ( thvm_up - thvm_low ) / ( exner_up - exner_low ) + ! = d(thvm)/d(exner); + ! + ! and: + ! + ! C_b + ! = thvm_low + ! - [ ( thvm_up - thvm_low ) / ( exner_up - exner_low ) ] * exner_low + ! = thvm_low - [ d(thvm)/d(exner) ] * exner_low. + ! + ! The integral becomes: + ! + ! INT(exner_1:exner_2) ( C_a*exner + C_b ) d(exner) + ! = - ( grav / Cp ) INT(z_1:z_2) dz. + ! + ! Solving the integral: + ! + ! z_2 + ! = z_1 + ! - ( Cp / grav ) + ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner_1}^2 ) + ! + ( thvm_low - {d(thvm)/d(exner)} * exner_low ) + ! * ( exner_2 - exner_1 ) ]. + ! + ! This equation is used to calculate z_2 using z_1, which is at the same + ! level as exner_1. Furthermore, thvm_low and exner_low are taken from the + ! same level as exner_1 and z_1. Thus, exner_1 = exner_low. Therefore: + ! + ! z_2 + ! = z_low + ! - ( Cp / grav ) + ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner_low}^2 ) + ! + ( thvm_low - {d(thvm)/d(exner)} * exner_low ) + ! * ( exner_2 - exner_low ) ]. + ! + ! Considering a sounding level k-1 as the low level in the integration, and + ! that thvm varies linearly (with respect to exner) between level k-1 and + ! level k: + ! + ! z_2 + ! = z(k-1) + ! - ( Cp / grav ) + ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner(k-1)}^2 ) + ! + ( thvm(k-1) - {d(thvm)/d(exner)} * exner(k-1) ) + ! * ( exner_2 - exner(k-1) ) ]; + ! + ! where: + ! + ! d(thvm)/d(exner) + ! = ( thvm(k) - thvm(k-1) ) / ( exner(k) - exner(k-1) ); + ! + ! and where exner(k-1) > exner_2 >= exner(k). If the value of + ! d(thvm)/d(exner) is 0, then thvm is considered to be a constant over the + ! depth of the level, and the equation will reduce to: + ! + ! z_2 = z(k-1) - ( Cp / grav ) * thvm(k-1) * ( exner_2 - exner(k-1) ). + ! + ! + ! IMPORTANT NOTE: + ! + ! CLUBB is an altitude-based model. All linear interpolations (and + ! extensions) are based on considering a variable to change linearly with + ! respect to altitude, rather than with respect to exner. An exception is + ! made here to calculate the altitude of a sounding level based on a + ! sounding given in terms of a pressure coordinate rather than a height + ! coordinate. After the altitude of the sounding level has been calculated, + ! the values of the sounding variables are interpolated onto the model grid + ! linearly with respect to altitude. Therefore, considering a variable to + ! change linearly with respect to exner is not consistent with the rest of + ! the model code, but provides for a better estimation of the altitude of + ! the sounding levels (than simply considering thvm to be constant over the + ! depth of the sounding level). + + ! References: + !------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + grav, & ! Gravitational acceleration [m/s^2] + Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + thvm_km1, & ! Value of thvm at sounding level k-1 [K] + dthvm_dexner, & ! Constant d(thvm)/d(exner) between levels k-1 and k [K] + exner_km1, & ! Value of exner at sounding level k-1 [-] + exner_2, & ! Value of exner at the top of the layer [-] + z_km1 ! Altitude at sounding level k-1 [m] + + ! Return Variable + real( kind = core_rknd ) :: z_2 ! Altitude at the top of the layer [m] + + ! Calculate z_2 at the top of the layer. + z_2 & + = z_km1 & + - ( Cp / grav ) & + * ( 0.5_core_rknd * dthvm_dexner * ( exner_2**2 - exner_km1**2 ) & + + ( thvm_km1 - dthvm_dexner * exner_km1 ) & + * ( exner_2 - exner_km1 ) & + ) + + return + end function calc_z_linear_thvm + +!=============================================================================== + +end module crmx_hydrostatic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 b/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 new file mode 100644 index 0000000000..a59714a42b --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 @@ -0,0 +1,1685 @@ +!----------------------------------------------------------------------- +! $Id: hyper_diffusion_4th_ord.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_hyper_diffusion_4th_ord + + ! Description: + ! Module hyper_diffusion_4th_ord computes the 4th-order numerical diffusion + ! for any equation to which it is applied. Hyper-diffusion will only be + ! called if the model flag l_hyper_dfsn is set to true. Function + ! hyper_dfsn_4th_ord_zt_lhs handles 4th-order hyper-diffusion for variables + ! that reside on thermodynamic levels. Function hyper_dfsn_4th_ord_zm_lhs + ! handles 4th-order hyper-diffusion for variables that reside on momentum + ! levels. A special constant coefficient of 4th-order numerical diffusion, + ! nu_hd (which is sent in this module as nu), is used and has units of m^4/s. + + implicit none + + private ! Default Scope + + public :: hyper_dfsn_4th_ord_zt_lhs, & + hyper_dfsn_4th_ord_zm_lhs + + contains + + !============================================================================= + pure function hyper_dfsn_4th_ord_zt_lhs( boundary_cond, nu, invrs_dzt, & + invrs_dzm, invrs_dzmm1, & + invrs_dztp1, invrs_dztm1, & + invrs_dzmp1, invrs_dzmm2, level ) & + result( lhs ) + + ! Note: In the "Description" section of this function, the variable + ! "invrs_dzm" will be written as simply "dzm", and the variable + ! "invrs_dzt" will be written as simply "dzt". This is being done as + ! as device to save space and to make some parts of the description + ! more readable. This change does not pertain to the actual code. + + ! Description: + ! Vertical 4th-order numerical diffusion of var_zt: implicit portion of the + ! code. + ! + ! Fourth-order numerical diffusion, or fourth-order hyper-diffusion, is used + ! to help eliminate small-scale noise without altering larger-scale + ! features. + ! + ! The variable "var_zt" stands for a variable that is located at + ! thermodynamic grid levels. + ! + ! The d(var_zt)/dt equation contains a 4th-order numerical diffusion term: + ! + ! - nu * d^4(var_zt)/dz^4. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - nu * d^4( var_zt(t+1) )/dz^4. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of var_zt being used is from + ! the next timestep, which is being advanced to in solving the d(var_zt)/dt + ! equation. + ! + ! The term is discretized as follows: + ! + ! The five values of var_zt are found on the thermodynamic levels. All four + ! derivatives (d/dz) of var_zt are taken over all the intermediate momentum + ! levels. Then, all three derivatives (d/dz) of d(var_zt)/dz are taken over + ! all the intermediate thermodynamic levels, which results in the second + ! derivatives. Then, both derivatives (d/dz) of d^2(var_zt)/dz^2 are taken + ! over the intermediate momentum levels, which results in the third + ! derivatives. Finally, the derivative (d/dz) of d^3(var_zt)/dz^3 is taken + ! over the intermediate (central) thermodynamic level, which results in the + ! fourth derivative. At the central thermodynamic level, d^4(var_zt)/dz^4 + ! is multiplied by constant coefficient nu. + ! + ! --var_ztp2----------------------------------------------- t(k+2) + ! + ! ======d(var_zt)/dz======================================= m(k+1) + ! + ! --var_ztp1----d^2(var_zt)/dz^2--------------------------- t(k+1) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(k) + ! + ! --var_zt------d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(k) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(k-1) + ! + ! --var_ztm1----d^2(var_zt)/dz^2--------------------------- t(k-1) + ! + ! ======d(var_zt)/dz======================================= m(k-2) + ! + ! --var_ztm2----------------------------------------------- t(k-2) + ! + ! The vertical indices t(k+2), m(k+1), t(k+1), m(k), t(k), m(k-1), t(k-1), + ! m(k-2), and t(k-2) correspond with altitudes zt(k+2), zm(k+1), zt(k+1), + ! zm(k), zt(k), zm(k-1), zt(k-1), zm(k-2), and zt(k-2) respectively. The + ! letter "t" is used for thermodynamic levels and the letter "m" is used for + ! momentum levels. + ! + ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) + ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) + ! dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) + ! dzt(k-1) = 1 / ( zm(k-1) - zm(k-2) ) + ! dzm(k+1) = 1 / ( zt(k+2) - zt(k+1) ) + ! dzm(k-2) = 1 / ( zt(k-1) - zt(k-2) ) + ! + ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k) + ! is written out as follows: + ! + ! -nu + ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) + ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) + ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } + ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) + ! -dzt(k-1)*( dzm(k-1)*(var_zt(k)-var_zt(k-1)) + ! -dzm(k-2)*(var_zt(k-1)-var_zt(k-2)) ) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" sign + ! changes to a "+" sign when the term is brought over to the left-hand side, + ! and var_zt is considered to be at timestep (t+1). + ! + ! + ! Boundary Conditions: + ! + ! 1) Zero-flux boundary conditions. + ! This function is set up to use zero-flux boundary conditions at both + ! the lower boundary level and the upper boundary level. The flux, F, + ! is the amount of var_zt flowing normal through the boundary per unit + ! time per unit surface area. The derivative of the flux effects the + ! time-tendency of var_zt, such that: + ! + ! d(var_zt)/dt = -dF/dz. + ! + ! For the 4th-order numerical diffusion term, -nu*d^4(var_zt)/dz^4 (which + ! is actually -d[nu*d^3(var_zt)/dz^3]/dz with a constant coefficient, + ! nu), the flux is: + ! + ! F = +nu*d^3(var_zt)/dz^3. + ! + ! In order to have zero-flux boundary conditions, the third derivative of + ! var_zt, d^3(var_zt)/dz^3, needs to equal 0 at both the lower boundary + ! and the upper boundary. + ! + ! Fourth-order numerical diffusion is used in conjunction with + ! second-order eddy diffusion, +d[(K_zm+nu)*d(var_zt)/dz]/dz, where the + ! coefficient of eddy diffusivity, (K_zm+nu), varies in the vertical. + ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the + ! same boundary condition type at all times, which in this case is + ! zero-flux boundary conditions. For 2nd-order eddy diffusion, the flux + ! is: F = -(K_zm+nu)*d(var_zt)/dz. In order to have zero-flux boundary + ! conditions, the derivative of var_zt, d(var_zt)/dz, needs to equal 0 at + ! both the lower boundary and the upper boundary. + ! + ! Thus, the boundary conditions used for 4th-order numerical diffusion + ! are: d^3(var_zt)/dz^3 = 0 and d(var_zt)/dz = 0 at both the upper + ! boundary and the lower boundary, resulting in four boundary conditions, + ! which is the number of boundary conditions needed for a 4th-order term. + ! + ! In order to discretize the lower boundary condition, consider a new + ! level outside the model (thermodynamic level 0) just below the lower + ! boundary level (thermodynamic level 1). The value of var_zt at the + ! level just outside the model is defined to be the same as the value of + ! var_zt at the lower boundary level. Therefore, the value of + ! d(var_zt)/dz between the level just outside the model and the lower + ! boundary level is 0, satisfying one of the boundary conditions. The + ! boundary condition d^3(var_zt)/dz^3 = 0 is also set at this level. The + ! rest of the levels involved are discretized normally, as listed above. + ! + ! Since the normal discretization includes two levels on either side of + ! the central level, the lower boundary begins to effect the + ! discretization at thermodynamic level 2. + ! + ! -var_zt(4)----------------------------------------------- t(4) + ! + ! ======d(var_zt)/dz======================================= m(3) + ! + ! -var_zt(3)----d^2(var_zt)/dz^2--------------------------- t(3) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(2) + ! + ! -var_zt(2)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(2) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) + ! + ! -var_zt(1)----d^2(var_zt)/dz^2--------------------------- t(1) Boundary + ! + ! ======[d(var_zt)/dz = 0]================================= m(0) + ! + ! -[var_zt(0) = var_zt(1)]-----(level outside model)------- t(0) + ! + ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=2) + ! is written out as follows: + ! + ! -nu + ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) + ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) + ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } + ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) + ! -dzt(k-1)*dzm(k-1)*(var_zt(k)-var_zt(k-1)) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zt is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zt found at thermodynamic + ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the + ! left-hand side matrix. + ! + ! The lower boundary also effects the discretization at thermodynamic + ! level 1. + ! + ! -var_zt(3)----------------------------------------------- t(3) + ! + ! ======d(var_zt)/dz======================================= m(2) + ! + ! -var_zt(2)----d^2(var_zt)/dz^2--------------------------- t(2) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) + ! + ! -var_zt(1)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(1) Boundary + ! + ! ======[d(var_zt)/dz = 0]==[d^3(var_zt)/dz^3 = 0]========= m(0) + ! + ! -[var_zt(0) = var_zt(1)]-----(level outside model)------- t(0) + ! + ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=1) + ! is written out as follows: + ! + ! -nu + ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) + ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) + ! -dzt(k)*dzm(k)*(var_zt(k+1)-var_zt(k)) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zt is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zt found at thermodynamic + ! levels 1, 2, and 3. Thus, it only affects 3 diagonals on the left-hand + ! side matrix. + ! + ! The same method can be used to discretize the upper boundary by + ! considering a new level outside the model just above the upper boundary + ! level. + ! + ! 2) Fixed-point boundary conditions. + ! Many equations in the model use fixed-point boundary conditions rather + ! than zero-flux boundary conditions. This means that the value of + ! var_zt stays the same over the course of the timestep at the lower + ! boundary, as well as at the upper boundary. + ! + ! For a 4th-order term, four boundary conditions are needed. Two + ! boundary conditions are applied at each boundary. For the case of + ! fixed-point boundary conditions, one of those two conditions is setting + ! var_zt = A, where A is a constant value. One more condition is needed. + ! Setting the values of d(var_zt)/dz and d^3(var_zt)/dz^3 are inherently + ! used for zero-flux (or perhaps fixed-flux) boundary conditions. + ! Fixed-point and zero-flux boundary conditions inherently should not be + ! invoked at the same time. The only remaining choice for a second + ! boundary condition for the fixed-point case is setting + ! d^2(var_zt)/dz^2. As it turns out, setting d^2(var_zt)/dz^2 = 0 is the + ! appropriate condition to use because it prevents values of var_zt at + ! levels outside the model from being involved in the discretization of + ! -nu*d^4(var_zt)/dz^4 at thermodynamic level 2. Setting + ! d^3(var_zt)/dz^3 = 0 does not accomplish the same thing for the + ! discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level 2. Also, + ! as stated above, fourth-order numerical diffusion is used in + ! conjunction with second-order eddy diffusion, + ! +d[(K_zm+nu)*d(var_zt)/dz]/dz, where the coefficient of eddy + ! diffusivity, (K_zm+nu), varies in the vertical. Both 4th-order + ! numerical diffusion and 2nd-order eddy diffusion use the same boundary + ! condition type at all times, which in this case is fixed-point boundary + ! conditions. For 2nd-order eddy diffusion, fixed-point boundary + ! conditions set var_zt = A, and do not set d(var_zt)/dz. Thus, + ! d(var_zt)/dz cannot be set for fixed-point boundary conditions. As + ! previously stated, the only other boundary condition that can be + ! invoked for a fixed-point boundary case is d^2(var_zt)/dz^2 = 0. + ! + ! Since the normal discretization includes two levels on either side of + ! the central level, the lower boundary begins to effect the + ! discretization at thermodynamic level 2. + ! + ! -var_zt(4)----------------------------------------------- t(4) + ! + ! ======d(var_zt)/dz======================================= m(3) + ! + ! -var_zt(3)----d^2(var_zt)/dz^2--------------------------- t(3) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(2) + ! + ! -var_zt(2)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(2) + ! + ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) + ! + ! -var_zt(1)----[d^2(var_zt)/dz^2 = 0]--------------------- t(1) Boundary + ! + ! ======d(var_zt)/dz======================================= m(0) + ! + ! -var_zt(0)-------------------(level outside model)------- t(0) + ! + ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=2) + ! is written out as follows: + ! + ! -nu + ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) + ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) + ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } + ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) + ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zt is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zt found at thermodynamic + ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the + ! left-hand side matrix. + ! + ! The same method can be used to discretize -nu*d^4(var_zt)/dz^4 at the + ! second-highest thermodynamic level (k=top-1) by setting + ! d^2(var_zt)/dz^2 = 0 at the highest thermodynamic level. + ! + ! The discretization at thermodynamic level (k=1) is written to simply + ! set the value var_zt(1) = A. Likewise, the discretization at + ! thermodynamic level (k=top) is written to simply set the value + ! var_zt(top) = B. In order to discretize the boundary conditions at the + ! lowest and highest vertical levels for equations requiring fixed-point + ! boundary conditions, either: + ! a) in the parent subroutine or function (that calls this function), + ! loop over all vertical levels from the second-lowest to the + ! second-highest, ignoring the lowest and highest levels. Then set + ! the values at the lowest and highest levels in the parent + ! subroutine; or + ! b) in the parent subroutine or function, loop over all vertical levels + ! and then overwrite the results at the lowest and highest levels. + ! + ! Either way, at the lowest and highest levels, an array with a value + ! of 1 at the main diagonal on the left-hand side and with values of 0 at + ! all other diagonals on the left-hand side will preserve the right-hand + ! side value at that level, thus satisfying the fixed-point boundary + ! conditions. + ! + ! + ! Conservation Properties: + ! + ! When zero-flux boundary conditions are used, this technique of + ! discretizing the 4th-order numerical diffusion term leads to conservative + ! differencing. When conservative differencing is in place, the column + ! totals for each column in the left-hand side matrix (for the 4th-order + ! numerical diffusion term) should be equal to 0. This ensures that the + ! total amount of the quantity var_zt over the entire vertical domain is + ! being conserved, meaning that nothing is lost due to diffusional effects. + ! + ! To see that this conservation law is satisfied, compute the 4th-order + ! numerical diffusion of var_zt and integrate vertically. In discretized + ! matrix notation (where "i" stands for the matrix column and "j" stands for + ! the matrix row): + ! + ! 0 = Sum_j Sum_i ( 1/dzt )_i ( nu*dzt*dzm*dzt*dzm )_ij (var_zt)_j. + ! + ! The left-hand side matrix, ( nu*dzt*dzm*dzt*dzm )_ij, is partially written + ! below. The sum over i in the above equation removes the first dzt(k) + ! everywhere from the matrix below. The sum over j leaves the column totals + ! that are desired. + ! + ! Left-hand side matrix contributions from 4th-order numerical diffusion + ! (or hyper-diffusion) term; first five vertical levels: + ! + ! column 1 || column 2 || column 3 || column 4 || column 5 + ! ------------------------------------------------------------------------------------------> + ! | +nu -nu +nu + ! | *dzt(k) *dzt(k) *dzt(k) + ! | *[ dzm(k) *[ dzm(k) *dzm(k) + !k=1| *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) 0 0 + ! | *dzm(k) *( dzm(k+1) *dzm(k+1) + ! | +dzt(k) +dzm(k) ) + ! | *dzm(k) } ] +dzt(k) + ! | *dzm(k) } ] + ! | + ! | -nu +nu -nu +nu + ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) + ! | *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) + ! | *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) + ! | *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) + ! | +dzm(k-1) +dzt(k) +dzm(k) ) + ! | *{ dzt(k) *( dzm(k) +dzt(k) + !k=2| *dzm(k-1) +dzm(k-1) ) *dzm(k) } 0 + ! | +dzt(k-1) } +dzm(k-1) + ! | *dzm(k-1) +dzm(k-1) *dzt(k) + ! | } ] *{ dzt(k) *dzm(k) ] + ! | *( dzm(k) + ! | +dzm(k-1) ) + ! | +dzt(k-1) + ! | *dzm(k-1) } ] + ! | + ! | +nu -nu +nu -nu +nu + ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) *dzt(k) + ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) + ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) + ! | *dzm(k-2) *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) + ! | +dzm(k-1) +dzt(k) +dzm(k) ) + ! | *{ dzt(k) *( dzm(k) +dzt(k) + !k=3| *dzm(k-1) +dzm(k-1) ) *dzm(k) } + ! | +dzt(k-1) } +dzm(k-1) + ! | *( dzm(k-1) +dzm(k-1) *dzt(k) + ! | +dzm(k-2) ) *{ dzt(k) *dzm(k) ] + ! | } ] *( dzm(k) + ! | +dzm(k-1) ) + ! | +dzt(k-1) + ! | *dzm(k-1) } ] + ! | + ! | +nu -nu +nu -nu + ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) + ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) *[ dzm(k) + ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) *{ dzt(k+1) + ! | *dzm(k-2) *dzm(k-1) *dzm(k) *( dzm(k+1) + ! | +dzm(k-1) +dzt(k) +dzm(k) ) + ! | *{ dzt(k) *( dzm(k) +dzt(k) + !k=4| 0 *dzm(k-1) +dzm(k-1) ) *dzm(k) } + ! | +dzt(k-1) } +dzm(k-1) + ! | *( dzm(k-1) +dzm(k-1) *dzt(k) + ! | +dzm(k-2) ) *{ dzt(k) *dzm(k) ] + ! | } ] *( dzm(k) + ! | +dzm(k-1) ) + ! | +dzt(k-1) + ! | *dzm(k-1) } ] + ! | + ! | +nu -nu +nu + ! | *dzt(k) *dzt(k) *dzt(k) + ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) + ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) + ! | *dzm(k-2) *dzm(k-1) *dzm(k) + ! | +dzm(k-1) +dzt(k) + ! | *{ dzt(k) *( dzm(k) + !k=5| 0 0 *dzm(k-1) +dzm(k-1) ) + ! | +dzt(k-1) } + ! | *( dzm(k-1) +dzm(k-1) + ! | +dzm(k-2) ) *{ dzt(k) + ! | } ] *( dzm(k) + ! | +dzm(k-1) ) + ! | +dzt(k-1) + ! | *dzm(k-1) } ] + ! \ / + ! + ! Note: The super-super diagonal term from level 4 and both the super + ! diagonal and super-super diagonal terms from level 5 are not shown + ! on this diagram. + ! + ! Note: The matrix shown is a five-diagonal matrix. For a nine-diagonal + ! matrix, there would be an extra row between each of the rows shown + ! and an extra column between each of the columns shown. However, + ! for the purposes of the var_zt 4th-order hyper-diffusion term, + ! those extra row and column values are all 0, and the conservation + ! properties of the matrix aren't effected. + ! + ! For the case of fixed-point boundary conditions, the contributions of the + ! 4th-order hyper-diffusion term are as follows (only the top 2 levels + ! differ from the matrix diagram above): + ! + ! column 1 || column 2 || column 3 || column 4 || column 5 + ! ------------------------------------------------------------------------------------------> + !k=1| 0 0 0 0 0 + ! | + ! | -nu +nu -nu +nu + ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) + ! | *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) + ! | *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) + ! | *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) + ! | +dzm(k-1) +dzt(k) +dzm(k) ) + !k=2| *dzt(k) *( dzm(k) +dzt(k) 0 + ! | *dzm(k-1) ] +dzm(k-1) ) *dzm(k) } + ! | } +dzm(k-1) + ! | +dzm(k-1) *dzt(k) + ! | *{ dzt(k) *dzm(k) ] + ! | *( dzm(k) + ! | +dzm(k-1) ) + ! | } ] + ! \ / + ! + ! For the left-hand side matrix as a whole, the matrix entries at level 1 + ! (k=1) read: 1 0 0 0 0. For the case of fixed-point boundary + ! conditions, conservative differencing is not in play. The total amount of + ! var_zt over the entire vertical domain is not being conserved, as amounts + ! of var_zt may be fluxed out through the upper boundary or lower boundary + ! through the effects of diffusion. + ! + ! Brian Griffin. October 7, 2008. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) gr%nz + + implicit none + + ! Constant parameters + integer, parameter :: & + kp2_tdiag = 1, & ! Thermodynamic super-super diagonal index. + kp1_tdiag = 2, & ! Thermodynamic super diagonal index. + k_tdiag = 3, & ! Thermodynamic main diagonal index. + km1_tdiag = 4, & ! Thermodynamic sub diagonal index. + km2_tdiag = 5 ! Thermodynamic sub-sub diagonal index. + + ! Input Variables + character (len=*), intent(in) :: & + boundary_cond ! Type of boundary conditions being used + ! ('zero-flux' or 'fixed-point'). + + real( kind = core_rknd ), intent(in) :: & + nu, & ! Constant coef. of 4th-order numerical diffusion [m^4/s] + invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] + invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] + invrs_dzmm1, & ! Inverse of grid spacing over momentum level (k-1) [1/m] + invrs_dztp1, & ! Inverse of grid spacing over thermo. level (k+1) [1/m] + invrs_dztm1, & ! Inverse of grid spacing over thermo. level (k-1) [1/m] + invrs_dzmp1, & ! Inverse of grid spacing over momentum level (k+1) [1/m] + invrs_dzmm2 ! Inverse of grid spacing over momentum level (k-2) [1/m] + + integer, intent(in) :: & + level ! Thermodynamic level where calculation occurs. [-] + + ! Return Variable + real( kind = core_rknd ), dimension(5) :: lhs + + + if ( level == 1 ) then + + ! Lowest level + ! k = 1; lower boundery level at surface. + ! Only relevant if zero-flux boundary conditions are used. + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *invrs_dzm*(invrs_dztp1*invrs_dzm + invrs_dzt*invrs_dzm) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & + +invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzm*invrs_dztp1*invrs_dzmp1 + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + ! The left-hand side matrix contributions from level 1 are + ! over-written or set in the parent subroutine. + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = 0.0_core_rknd + + endif + + + elseif ( level == 2 ) then + + ! Second-lowest level + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzmm1 & + +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & + +invrs_dztm1*invrs_dzmm1 ) ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*invrs_dzm & + +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & + +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & + +invrs_dztm1*invrs_dzmm1 ) ) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & + +invrs_dzt*invrs_dzm ) & + +invrs_dzmm1*invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzm*invrs_dztp1*invrs_dzmp1 + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzmm1 & + +invrs_dzmm1*invrs_dzt*invrs_dzmm1 ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*invrs_dzm & + +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & + +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) ) ) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & + +invrs_dzt*invrs_dzm ) & + +invrs_dzmm1*invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzm*invrs_dztp1*invrs_dzmp1 + + endif + + + elseif ( level > 2 .and. level < gr%nz-1 ) then + + ! k > 2 and k < num_levels-1 + ! These interior level are not effected by boundary conditions. + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzmm1 & + +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & + +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*invrs_dzm & + +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & + +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & + +invrs_dztm1*invrs_dzmm1 ) ) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & + +invrs_dzt*invrs_dzm ) & + +invrs_dzmm1*invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzm*invrs_dztp1*invrs_dzmp1 + + + elseif ( level == gr%nz-1 ) then + + ! Second-highest level + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzmm1 & + +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & + +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*invrs_dzm & + +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & + +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & + +invrs_dztm1*invrs_dzmm1 ) ) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*( invrs_dztp1*invrs_dzm & + +invrs_dzt*invrs_dzm ) & + +invrs_dzmm1*invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = 0.0_core_rknd + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzmm1 & + +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & + +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *( invrs_dzm*( invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & + +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & + +invrs_dztm1*invrs_dzmm1 ) ) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = -nu*invrs_dzt & + *( invrs_dzm*invrs_dzt*invrs_dzm & + +invrs_dzmm1*invrs_dzt*invrs_dzm ) + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = 0.0_core_rknd + + endif + + + elseif ( level == gr%nz ) then + + ! Highest level + ! k = gr%nz; upper boundery level at model top. + ! Only relevant if zero-flux boundary conditions are used. + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = +nu*invrs_dzt & + *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = -nu*invrs_dzt & + *invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & + +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = +nu*invrs_dzt & + *invrs_dzmm1*(invrs_dzt*invrs_dzmm1 + invrs_dztm1*invrs_dzmm1) + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = 0.0_core_rknd + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + ! The left-hand side matrix contributions from level gr%nz are + ! over-written or set in the parent subroutine. + + ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] + lhs(km2_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] + lhs(kp2_tdiag) & + = 0.0_core_rknd + + endif + + endif + + return + + end function hyper_dfsn_4th_ord_zt_lhs + + !============================================================================= + pure function hyper_dfsn_4th_ord_zm_lhs( boundary_cond, nu, invrs_dzm, & + invrs_dztp1, invrs_dzt, & + invrs_dzmp1, invrs_dzmm1, & + invrs_dztp2, invrs_dztm1, level ) & + result( lhs ) + + ! Note: In the "Description" section of this function, the variable + ! "invrs_dzm" will be written as simply "dzm", and the variable + ! "invrs_dzt" will be written as simply "dzt". This is being done as + ! as device to save space and to make some parts of the description + ! more readable. This change does not pertain to the actual code. + + ! Description: + ! Vertical 4th-order numerical diffusion of var_zm: implicit portion of the + ! code. + ! + ! Fourth-order numerical diffusion, or fourth-order hyper-diffusion, is used + ! to help eliminate small-scale noise without altering larger-scale + ! features. + ! + ! The variable "var_zm" stands for a variable that is located at momentum + ! grid levels. + ! + ! The d(var_zm)/dt equation contains a 4th-order numerical diffusion term: + ! + ! - nu * d^4(var_zm)/dz^4. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - nu * d^4( var_zm(t+1) )/dz^4. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed + ! to a "+". + ! + ! The timestep index (t+1) means that the value of var_zm being used is from + ! the next timestep, which is being advanced to in solving the d(var_zm)/dt + ! equation. + ! + ! The term is discretized as follows: + ! + ! The five values of var_zm are found on the momentum levels. All four + ! derivatives (d/dz) of var_zm are taken over all the intermediate + ! thermodynamic levels. Then, all three derivatives (d/dz) of d(var_zm)/dz + ! are taken over all the intermediate momentum levels, which results in the + ! second derivatives. Then, both derivatives (d/dz) of d^2(var_zm)/dz^2 are + ! taken over the intermediate thermodynamic levels, which results in the + ! third derivatives. Finally, the derivative (d/dz) of d^3(var_zm)/dz^3 is + ! taken over the intermediate (central) momentum level, which results in the + ! fourth derivative. At the central momentum level, d^4(var_zm)/dz^4 is + ! multiplied by constant coefficient nu. + ! + ! ==var_zmp2=============================================== m(k+2) + ! + ! ------d(var_zm)/dz--------------------------------------- t(k+2) + ! + ! ==var_zmp1====d^2(var_zm)/dz^2=========================== m(k+1) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(k+1) + ! + ! ==var_zm======d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(k) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(k) + ! + ! ==var_zmm1====d^2(var_zm)/dz^2=========================== m(k-1) + ! + ! ------d(var_zm)/dz--------------------------------------- t(k-1) + ! + ! ==var_zmm2=============================================== m(k-2) + ! + ! The vertical indices m(k+2), t(k+2), m(k+1), t(k+1), m(k), t(k), m(k-1), + ! t(k-1), and m(k-2) correspond with altitudes zm(k+2), zt(k+2), zm(k+1), + ! zt(k+1), zm(k), zt(k), zm(k-1), zt(k-1), and zm(k-2) respectively. The + ! letter "t" is used for thermodynamic levels and the letter "m" is used for + ! momentum levels. + ! + ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) + ! dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) + ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! dzm(k+1) = 1 / ( zt(k+2) - zt(k+1) ) + ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) + ! dzt(k+2) = 1 / ( zm(k+2) - zm(k+1) ) + ! dzt(k-1) = 1 / ( zm(k-1) - zm(k-2) ) + ! + ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k) is + ! written out as follows: + ! + ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) + ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) + ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } + ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) + ! -dzm(k-1)*( dzt(k)*(var_zm(k)-var_zm(k-1)) + ! -dzt(k-1)*(var_zm(k-1)-var_zm(k-2)) ) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" sign + ! changes to a "+" sign when the term is brought over to the left-hand side, + ! and var_zm is considered to be at timestep (t+1). + ! + ! + ! Boundary Conditions: + ! + ! 1) Zero-flux boundary conditions. + ! This function is set up to use zero-flux boundary conditions at both + ! the lower boundary level and the upper boundary level. The flux, F, + ! is the amount of var_zm flowing normal through the boundary per unit + ! time per unit surface area. The derivative of the flux effects the + ! time-tendency of var_zm, such that: + ! + ! d(var_zm)/dt = -dF/dz. + ! + ! For the 4th-order numerical diffusion term, -nu*d^4(var_zm)/dz^4 (which + ! is actually -d[nu*d^3(var_zm)/dz^3]/dz with a constant coefficient, + ! nu), the flux is: + ! + ! F = +nu*d^3(var_zm)/dz^3. + ! + ! In order to have zero-flux boundary conditions, the third derivative of + ! var_zm, d^3(var_zm)/dz^3, needs to equal 0 at both the lower boundary + ! and the upper boundary. + ! + ! Fourth-order numerical diffusion is used in conjunction with + ! second-order eddy diffusion, +d[(K_zt+nu)*d(var_zm)/dz]/dz, where the + ! coefficient of eddy diffusivity, (K_zt+nu), varies in the vertical. + ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the + ! same boundary condition type at all times, which in this case is + ! zero-flux boundary conditions. For 2nd-order eddy diffusion, the flux + ! is: F = -(K_zt+nu)*d(var_zm)/dz. In order to have zero-flux boundary + ! conditions, the derivative of var_zm, d(var_zm)/dz, needs to equal 0 at + ! both the lower boundary and the upper boundary. + ! + ! Thus, the boundary conditions used for 4th-order numerical diffusion + ! are: d^3(var_zm)/dz^3 = 0 and d(var_zm)/dz = 0 at both the upper + ! boundary and the lower boundary, resulting in four boundary conditions, + ! which is the number of boundary conditions needed for a 4th-order term. + ! + ! In order to discretize the lower boundary condition, consider a new + ! level outside the model (momentum level 0) just below the lower + ! boundary level (momentum level 1). The value of var_zm at the level + ! just outside the model is defined to be the same as the value of var_zm + ! at the lower boundary level. Therefore, the value of d(var_zm)/dz + ! between the level just outside the model and the lower boundary level + ! is 0, satisfying one of the boundary conditions. The boundary + ! condition d^3(var_zm)/dz^3 = 0 is also set at this level. The rest of + ! the levels involved are discretized normally, as listed above. + ! + ! Since the normal discretization includes two levels on either side of + ! the central level, the lower boundary begins to effect the + ! discretization at momentum level 2. + ! + ! =var_zm(4)=============================================== m(4) + ! + ! ------d(var_zm)/dz--------------------------------------- t(4) + ! + ! =var_zm(3)====d^2(var_zm)/dz^2=========================== m(3) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(3) + ! + ! =var_zm(2)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(2) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) + ! + ! =var_zm(1)====d^2(var_zm)/dz^2=========================== m(1) Boundary + ! + ! ------[d(var_zm)/dz = 0]--------------------------------- t(1) + ! + ! =[var_zm(0) = var_zm(1)]=====(level outside model)======= m(0) + ! + ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=2) is + ! written out as follows: + ! + ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) + ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) + ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } + ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) + ! -dzm(k-1)*dzt(k)*(var_zm(k)-var_zm(k-1)) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zm is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zm found at momentum + ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the + ! left-hand side matrix. + ! + ! The lower boundary also effects the discretization at momentum + ! level 1. + ! + ! =var_zm(3)=============================================== m(3) + ! + ! ------d(var_zm)/dz--------------------------------------- t(3) + ! + ! =var_zm(2)====d^2(var_zm)/dz^2=========================== m(2) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) + ! + ! =var_zm(1)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(1) Boundary + ! + ! ------[d(var_zm)/dz = 0]--[d^3(var_zm)/dz^3 = 0]--------- t(1) + ! + ! =[var_zm(0) = var_zm(1)]=====(level outside model)======= m(0) + ! + ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=1) is + ! written out as follows: + ! + ! -nu*dzm(k)*[dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) + ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) + ! -dzm(k)*dzt(k+1)*(var_zm(k+1)-var_zm(k)) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zm is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zm found at momentum + ! levels 1, 2, and 3. Thus, it only affects 3 diagonals on the left-hand + ! side matrix. + ! + ! The same method can be used to discretize the upper boundary by + ! considering a new level outside the model just above the upper boundary + ! level. + ! + ! 2) Fixed-point boundary conditions. + ! Many equations in the model use fixed-point boundary conditions rather + ! than zero-flux boundary conditions. This means that the value of + ! var_zm stays the same over the course of the timestep at the lower + ! boundary, as well as at the upper boundary. + ! + ! For a 4th-order term, four boundary conditions are needed. Two + ! boundary conditions are applied at each boundary. For the case of + ! fixed-point boundary conditions, one of those two conditions is setting + ! var_zm = A, where A is a constant value. One more condition is needed. + ! Setting the values of d(var_zm)/dz and d^3(var_zm)/dz^3 are inherently + ! used for zero-flux (or perhaps fixed-flux) boundary conditions. + ! Fixed-point and zero-flux boundary conditions inherently should not be + ! invoked at the same time. The only remaining choice for a second + ! boundary condition for the fixed-point case is setting + ! d^2(var_zm)/dz^2. As it turns out, setting d^2(var_zm)/dz^2 = 0 is the + ! appropriate condition to use because it prevents values of var_zm at + ! levels outside the model from being involved in the discretization of + ! -nu*d^4(var_zm)/dz^4 at momentum level 2. Setting d^3(var_zm)/dz^3 = 0 + ! does not accomplish the same thing for the discretization of + ! -nu*d^4(var_zm)/dz^4 at momentum level 2. Also, as stated above, + ! fourth-order numerical diffusion is used in conjunction with + ! second-order eddy diffusion, +d[(K_zt+nu)*d(var_zm)/dz]/dz, where the + ! coefficient of eddy diffusivity, (K_zt+nu), varies in the vertical. + ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the + ! same boundary condition type at all times, which in this case is + ! fixed-point boundary conditions. For 2nd-order eddy diffusion, + ! fixed-point boundary conditions set var_zm = A, and do not set + ! d(var_zm)/dz. Thus, d(var_zm)/dz cannot be set for fixed-point + ! boundary conditions. As previously stated, the only other boundary + ! condition that can be invoked for a fixed-point boundary case is + ! d^2(var_zm)/dz^2 = 0. + ! + ! Since the normal discretization includes two levels on either side of + ! the central level, the lower boundary begins to effect the + ! discretization at momentum level 2. + ! + ! =var_zm(4)=============================================== m(4) + ! + ! ------d(var_zm)/dz--------------------------------------- t(4) + ! + ! =var_zm(3)====d^2(var_zm)/dz^2=========================== m(3) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(3) + ! + ! =var_zm(2)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(2) + ! + ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) + ! + ! =var_zm(1)====[d^2(var_zm)/dz^2 = 0]===================== m(1) Boundary + ! + ! ------d(var_zm)/dz--------------------------------------- t(1) + ! + ! =var_zm(0)===================(level outside model)======= m(0) + ! + ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=2) is + ! written out as follows: + ! + ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) + ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) + ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } + ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) + ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } ]. + ! + ! Again, the term is treated completely implicitly, so the leading "-" + ! sign changes to a "+" sign when the term is brought over to the + ! left-hand side, and var_zm is considered to be at timestep (t+1). + ! + ! The result is dependent only on values of var_zm found at momentum + ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the + ! left-hand side matrix. + ! + ! The same method can be used to discretize -nu*d^4(var_zm)/dz^4 at the + ! second-highest momentum level (k=top-1) by setting d^2(var_zm)/dz^2 = 0 + ! at the highest momentum level. + ! + ! The discretization at momentum level (k=1) is written to simply set the + ! value var_zm(1) = A. Likewise, the discretization at momentum level + ! (k=top) is written to simply set the value var_zm(top) = B. In order + ! to discretize the boundary conditions at the lowest and highest + ! vertical levels for equations requiring fixed-point boundary + ! conditions, either: + ! a) in the parent subroutine or function (that calls this function), + ! loop over all vertical levels from the second-lowest to the + ! second-highest, ignoring the lowest and highest levels. Then set + ! the values at the lowest and highest levels in the parent + ! subroutine; or + ! b) in the parent subroutine or function, loop over all vertical levels + ! and then overwrite the results at the lowest and highest levels. + ! + ! Either way, at the lowest and highest levels, an array with a value + ! of 1 at the main diagonal on the left-hand side and with values of 0 at + ! all other diagonals on the left-hand side will preserve the right-hand + ! side value at that level, thus satisfying the fixed-point boundary + ! conditions. + ! + ! + ! Conservation Properties: + ! + ! When zero-flux boundary conditions are used, this technique of + ! discretizing the 4th-order numerical diffusion term leads to conservative + ! differencing. When conservative differencing is in place, the column + ! totals for each column in the left-hand side matrix (for the 4th-order + ! numerical diffusion term) should be equal to 0. This ensures that the + ! total amount of the quantity var_zm over the entire vertical domain is + ! being conserved, meaning that nothing is lost due to diffusional effects. + ! + ! To see that this conservation law is satisfied, compute the 4th-order + ! numerical diffusion of var_zm and integrate vertically. In discretized + ! matrix notation (where "i" stands for the matrix column and "j" stands for + ! the matrix row): + ! + ! 0 = Sum_j Sum_i ( 1/dzm )_i ( nu*dzm*dzt*dzm*dzt )_ij (var_zm)_j. + ! + ! The left-hand side matrix, ( nu*dzm*dzt*dzm*dzt )_ij, is partially written + ! below. The sum over i in the above equation removes the first dzm(k) + ! everywhere from the matrix below. The sum over j leaves the column totals + ! that are desired. + ! + ! Left-hand side matrix contributions from 4th-order numerical diffusion + ! (or hyper-diffusion) term; first five vertical levels: + ! + ! column 1 || column 2 || column 3 || column 4 || column 5 + ! ------------------------------------------------------------------------------------------> + ! | +nu -nu +nu + ! | *dzm(k) *dzm(k) *dzm(k) + ! | *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) + ! | *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) + !k=1| *dzt(k+1) *( dzt(k+2) *dzt(k+2) 0 0 + ! | +dzm(k) +dzt(k+1) ) + ! | *dzt(k+1) } +dzm(k) + ! | ] *dzt(k+1) } ] + ! | + ! | -nu +nu -nu +nu + ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) + ! | *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) + ! | *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) + ! | *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) + ! | +dzt(k) +dzm(k) +dzt(k+1) ) + !k=2| *{ dzm(k) *( dzt(k+1) +dzm(k) 0 + ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } + ! | +dzm(k-1) +dzt(k) +dzt(k) + ! | *dzt(k) } ] *{ dzm(k) *dzm(k) + ! | *( dzt(k+1) *dzt(k+1) ] + ! | +dzt(k) ) + ! | +dzm(k-1) + ! | *dzt(k) } ] + ! | + ! | +nu -nu +nu -nu +nu + ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) *dzm(k) + ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) + ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) + ! | *dzt(k-1) *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) + ! | +dzt(k) +dzm(k) +dzt(k+1) ) + !k=3| *{ dzm(k) *( dzt(k+1) +dzm(k) + ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } + ! | +dzm(k-1) +dzt(k) +dzt(k) + ! | *( dzt(k) *{ dzm(k) *dzm(k) + ! | +dzt(k-1) ) *( dzt(k+1) *dzt(k+1) ] + ! | } ] +dzt(k) ) + ! | +dzm(k-1) + ! | *dzt(k) } ] + ! | + ! | +nu -nu +nu -nu + ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) + ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) + ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) *{ dzm(k+1) + ! | *dzt(k-1) *dzt(k) *dzt(k+1) *( dzt(k+2) + ! | +dzt(k) +dzm(k) +dzt(k+1) ) + !k=4| 0 *{ dzm(k) *( dzt(k+1) +dzm(k) + ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } + ! | +dzm(k-1) +dzt(k) +dzt(k) + ! | *( dzt(k) *{ dzm(k) *dzm(k) + ! | +dzt(k-1) ) *( dzt(k+1) *dzt(k+1) ] + ! | } ] +dzt(k) ) + ! | +dzm(k-1) + ! | *dzt(k) } ] + ! | + ! | +nu -nu +nu + ! | *dzm(k) *dzm(k) *dzm(k) + ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) + ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) + ! | *dzt(k-1) *dzt(k) *dzt(k+1) + ! | +dzt(k) +dzm(k) + !k=5| 0 0 *{ dzm(k) *( dzt(k+1) + ! | *dzt(k) +dzt(k) ) } + ! | +dzm(k-1) +dzt(k) + ! | *( dzt(k) *{ dzm(k) + ! | +dzt(k-1) ) *( dzt(k+1) + ! | } ] +dzt(k) ) + ! | +dzm(k-1) + ! | *dzt(k) } ] + ! \ / + ! + ! Note: The super-super diagonal term from level 4 and both the super + ! diagonal and super-super diagonal terms from level 5 are not shown + ! on this diagram. + ! + ! Note: The matrix shown is a five-diagonal matrix. For a nine-diagonal + ! matrix, there would be an extra row between each of the rows shown + ! and an extra column between each of the columns shown. However, + ! for the purposes of the var_zm 4th-order hyper-diffusion term, + ! those extra row and column values are all 0, and the conservation + ! properties of the matrix aren't effected. + ! + ! For the case of fixed-point boundary conditions, the contributions of the + ! 4th-order hyper-diffusion term are as follows (only the top 2 levels + ! differ from the matrix diagram above): + ! + ! column 1 || column 2 || column 3 || column 4 || column 5 + ! ------------------------------------------------------------------------------------------> + !k=1| 0 0 0 0 0 + ! | + ! | -nu +nu -nu +nu + ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) + ! | *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) + ! | *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) + ! | *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) + !k=2| +dzt(k) +dzm(k) +dzt(k+1) ) 0 + ! | *dzm(k) *( dzt(k+1) +dzm(k) + ! | *dzt(k) ] +dzt(k) ) } *dzt(k+1) } + ! | +dzt(k) +dzt(k) + ! | *dzm(k) *dzm(k) + ! | *( dzt(k+1) *dzt(k+1) ] + ! | +dzt(k) ) ] + ! \ / + ! + ! For the left-hand side matrix as a whole, the matrix entries at level 1 + ! (k=1) read: 1 0 0 0 0. For the case of fixed-point boundary + ! conditions, conservative differencing is not in play. The total amount of + ! var_zm over the entire vertical domain is not being conserved, as amounts + ! of var_zm may be fluxed out through the upper boundary or lower boundary + ! through the effects of diffusion. + ! + ! Brian Griffin. September 28, 2008. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) gr%nz + + implicit none + + ! Constant parameters + integer, parameter :: & + kp2_mdiag = 1, & ! Momentum super-super diagonal index. + kp1_mdiag = 2, & ! Momentum super diagonal index. + k_mdiag = 3, & ! Momentum main diagonal index. + km1_mdiag = 4, & ! Momentum sub diagonal index. + km2_mdiag = 5 ! Momentum sub-sub diagonal index. + + ! Input Variables + character (len=*), intent(in) :: & + boundary_cond ! Type of boundary conditions being used + ! ('zero-flux' or 'fixed-point'). + + real( kind = core_rknd ), intent(in) :: & + nu, & ! Constant coef. of 4th-order numerical diffusion [m^4/s] + invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] + invrs_dztp1, & ! Inverse of grid spacing over thermo. level (k+1) [1/m] + invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] + invrs_dzmp1, & ! Inverse of grid spacing over momentum level (k+1) [1/m] + invrs_dzmm1, & ! Inverse of grid spacing over momentum level (k-1) [1/m] + invrs_dztp2, & ! Inverse of grid spacing over thermo. level (k+2) [1/m] + invrs_dztm1 ! Inverse of grid spacing over thermo. level (k-1) [1/m] + + integer, intent(in) :: & + level ! Momentum level where calculation occurs. [-] + + ! Return Variable + real( kind = core_rknd ), dimension(5) :: lhs + + + if ( level == 1 ) then + + ! Lowest level + ! k = 1; lower boundery level at surface. + ! Only relevant if zero-flux boundary conditions are used. + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = 0.0_core_rknd + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *invrs_dztp1*(invrs_dzmp1*invrs_dztp1 + invrs_dzm*invrs_dztp1) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & + +invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = +nu*invrs_dzm & + *invrs_dztp1*invrs_dzmp1*invrs_dztp2 + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + ! The left-hand side matrix contributions from level 1 are + ! over-written or set in the parent subroutine. + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = 0.0_core_rknd + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = 0.0_core_rknd + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = 0.0_core_rknd + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = 0.0_core_rknd + + endif + + + elseif ( level == 2 ) then + + ! Second-lowest level + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = 0.0_core_rknd + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dzt & + +invrs_dzt*( invrs_dzm*invrs_dzt & + +invrs_dzmm1*invrs_dzt ) ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & + +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & + +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & + +invrs_dzmm1*invrs_dzt ) ) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & + +invrs_dzm*invrs_dztp1 ) & + +invrs_dzt*invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = +nu*invrs_dzm & + *invrs_dztp1*invrs_dzmp1*invrs_dztp2 + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = 0.0_core_rknd + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dzt & + +invrs_dzt*invrs_dzm*invrs_dzt ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & + +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & + +invrs_dzt*invrs_dzm*(invrs_dztp1 + invrs_dzt) ) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & + +invrs_dzm*invrs_dztp1 ) & + +invrs_dzt*invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = +nu*invrs_dzm & + *invrs_dztp1*invrs_dzmp1*invrs_dztp2 + + endif + + + elseif ( level > 2 .and. level < gr%nz-1 ) then + + ! k > 2 and k < num_levels-1 + ! These interior level are not effected by boundary conditions. + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = +nu*invrs_dzm & + *invrs_dzt*invrs_dzmm1*invrs_dztm1 + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dzt & + +invrs_dzt*( invrs_dzm*invrs_dzt & + +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & + +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & + +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & + +invrs_dzmm1*invrs_dzt ) ) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & + +invrs_dzm*invrs_dztp1 ) & + +invrs_dzt*invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = +nu*invrs_dzm & + *invrs_dztp1*invrs_dzmp1*invrs_dztp2 + + + elseif ( level == gr%nz-1 ) then + + ! Second-highest level + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = +nu*invrs_dzm & + *invrs_dzt*invrs_dzmm1*invrs_dztm1 + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dzt & + +invrs_dzt*( invrs_dzm*invrs_dzt & + +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & + +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & + +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & + +invrs_dzmm1*invrs_dzt ) ) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & + +invrs_dzm*invrs_dztp1 ) & + +invrs_dzt*invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = 0.0_core_rknd + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = +nu*invrs_dzm & + *invrs_dzt*invrs_dzmm1*invrs_dztm1 + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dzt & + +invrs_dzt*( invrs_dzm*invrs_dzt & + +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *( invrs_dztp1*( invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & + +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & + +invrs_dzmm1*invrs_dzt ) ) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = -nu*invrs_dzm & + *( invrs_dztp1*invrs_dzm*invrs_dztp1 & + +invrs_dzt*invrs_dzm*invrs_dztp1 ) + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = 0.0_core_rknd + + endif + + + elseif ( level == gr%nz ) then + + ! Highest level + ! k = gr%nz; upper boundery level at model top. + ! Only relevant if zero-flux boundary conditions are used. + + if ( trim( boundary_cond ) == 'zero-flux' ) then + + ! Zero-flux boundary conditions + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = +nu*invrs_dzm & + *invrs_dzt*invrs_dzmm1*invrs_dztm1 + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = -nu*invrs_dzm & + *invrs_dzt*( invrs_dzm*invrs_dzt & + +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = +nu*invrs_dzm & + *invrs_dzt*(invrs_dzm*invrs_dzt + invrs_dzmm1*invrs_dzt) + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = 0.0_core_rknd + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = 0.0_core_rknd + + elseif ( trim( boundary_cond ) == 'fixed-point' ) then + + ! Fixed-point boundary conditions + ! The left-hand side matrix contributions from level gr%nz are + ! over-written or set in the parent subroutine. + + ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] + lhs(km2_mdiag) & + = 0.0_core_rknd + + ! Momentum sub diagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = 0.0_core_rknd + + ! Momentum super diagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = 0.0_core_rknd + + ! Momentum super-super diagonal: [ x var_zm(k+2,) ] + lhs(kp2_mdiag) & + = 0.0_core_rknd + + endif + + + endif + + + return + + end function hyper_dfsn_4th_ord_zm_lhs + +!=============================================================================== + +end module crmx_hyper_diffusion_4th_ord diff --git a/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 b/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 new file mode 100644 index 0000000000..d628d09b6f --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 @@ -0,0 +1,81 @@ +!$Id: input_names.F90 5378 2011-08-22 20:19:16Z connork@uwm.edu $ +module crmx_input_names +! +! Description: This module contains all of the strings used to define the +! headers for input_reader.F90 compatable files. +! +!--------------------------------------------------------------------------------------------------- + implicit none + ! Column identifiers + character(len=*), public, parameter :: & + z_name = 'z[m]' + + character(len=*), public, parameter :: & + pressure_name = 'Press[Pa]', & + press_mb_name = "Press[mb]" + + character(len=*), public, parameter :: & + temperature_name = 'T[K]', & + theta_name = 'thm[K]', & + thetal_name = 'thlm[K]' + + character(len=*), public, parameter :: & + temperature_f_name = 'T_f[K\s]', & + thetal_f_name = 'thlm_f[K\s]', & + theta_f_name = 'thm_f[K\s]' + + character(len=*), public, parameter :: & + rt_name = 'rt[kg\kg]', & + sp_humidity_name = "sp_hmdty[kg\kg]" + + character(len=*), public, parameter :: & + rt_f_name = 'rtm_f[kg\kg\s]', & + sp_humidity_f_name = 'sp_hmdty_f[kg\kg\s]' + + character(len=*), public, parameter :: & + um_name = 'u[m\s]', & + vm_name = 'v[m\s]' + + character(len=*), public, parameter :: & + ug_name = 'ug[m\s]', & + vg_name = 'vg[m\s]' + + character(len=*), public, parameter :: & + um_ref_name = 'um_ref[m\s]', & + vm_ref_name = 'vm_ref[m\s]' + + character(len=*), public, parameter :: & + um_f_name = 'um_f[m\s^2]', & + vm_f_name = 'vm_f[m\s^2]' + + character(len=*), public, parameter :: & + wm_name = 'w[m\s]', & + omega_name = 'omega[Pa\s]', & + omega_mb_hr_name = 'omega[mb\hr]' + + character(len=*), public, parameter :: & + CO2_name = 'CO2[ppmv]', & + CO2_umol_name = 'CO2[umol\m^2\s]', & + ozone_name = "o3[kg\kg]" + + character(len=*), public, parameter :: & + time_name = 'Time[s]' + + character(len=*), public, parameter :: & + latent_ht_name = 'latent_ht[W\m^2]', & + sens_ht_name = 'sens_ht[W\m^2]' + + character(len=*), public, parameter :: & + upwp_sfc_name = 'upwp_sfc[(m\s)^2]', & + vpwp_sfc_name = 'vpwp_sfc[(m\s)^2]' + + character(len=*), public, parameter :: & + T_sfc_name = 'T_sfc[K]' + + character(len=*), public, parameter :: & + wpthlp_sfc_name = 'wpthlp_sfc[mK\s]', & + wpqtp_sfc_name = 'wpqtp_sfc[(kg\kg)m\s]' + + private ! Default Scope + +end module crmx_input_names diff --git a/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 b/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 new file mode 100644 index 0000000000..a516a90063 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 @@ -0,0 +1,857 @@ +!$Id: input_reader.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_input_reader +! +! This module is respondsible for the procedures and structures necessary to +! read in "SAM-Like" case specific files. Currently only the +! _sounding.in file is formatted to be used by this module. +! +!--------------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + private + + public :: one_dim_read_var, & + read_one_dim_file, & + two_dim_read_var, & + read_two_dim_file, & + fill_blanks_one_dim_vars, & + fill_blanks_two_dim_vars, & + deallocate_one_dim_vars, & + deallocate_two_dim_vars, & + read_x_table, & + read_x_profile, & + get_target_index, & + count_columns + + ! Derived type for representing a rank 1 variable that has been read in by one + ! of the procedures. + type one_dim_read_var + + character(len=30) :: name ! Name of the variable + + character(len=30) :: dim_name ! Name of the dimension that the + ! variable varies along + + real( kind = core_rknd ), dimension(:), pointer :: values ! Values of that variable + + end type one_dim_read_var + + ! Derived type for representing a rank 2 variable that has been read in by one + ! of the procedures. + type two_dim_read_var + + character(len=30) :: name ! Name of the variable + + character(len=30) :: dim1_name ! Name of one of the dimensions + ! that the variable varies along + + character(len=30) :: dim2_name ! Name of the other variable that + ! the variable varies along + + real( kind = core_rknd ), dimension(:,:), pointer :: values ! Values of that variable + + end type two_dim_read_var + + + ! Constant Parameter(s) + real( kind = core_rknd ), parameter, private :: & + blank_value = -999.9_core_rknd ! Used to denote if a value is missing from the file + + contains + + !------------------------------------------------------------------------------------------------- + subroutine read_two_dim_file( iunit, nCol, filename, read_vars, other_dim ) + ! + ! Description: This subroutine reads from a file containing data that varies + ! in two dimensions. These are dimensions are typically height + ! and time. + ! + !----------------------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_input_names, only: & + time_name ! Constant(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: trim, index + + ! Input Variable(s) + + integer, intent(in) :: iunit ! File I/O unit + + integer, intent(in) :: nCol ! Number of columns expected in the data file + + + character(len=*), intent(in) :: filename ! Name of the file being read from + + ! Output Variable(s) + type (two_dim_read_var), dimension(nCol),intent(out) :: read_vars ! Structured information + ! from the file + + type (one_dim_read_var), intent(out) :: other_dim ! Structured information + ! on the dimesion not stored in read_vars + + ! Local Variables + character(len=30),dimension(nCol) :: names ! Names of variables + + integer nRowI ! Inner row + + integer nRowO ! Outer row + + integer :: k, j, i + + logical :: isComment + + character(len=200) :: tmpline + + real( kind = core_rknd ), dimension(nCol) :: tmp + + integer :: input_status ! The status of a read statement + + ! ---- Begin Code ---- + + ! First run through, take names and determine how large the data file is. + open(unit=iunit, file=trim( filename ), status = 'old', action='read' ) + + isComment = .true. + + ! Skip all the comments at the top of the file + do while ( isComment ) + read(iunit,fmt='(A)') tmpline + k = index( tmpline, "!" ) + isComment = .false. + if ( k > 0 ) then + isComment = .true. + end if + end do + + ! Go back to the line that wasn't a comment. + backspace(iunit) + + read(iunit, fmt=*) names + + nRowO = 0 + do while(.true.) + read(iunit, *, iostat=input_status) tmp(1), nRowI + + ! If input_status shows an end of data, then exit the loop + if( input_status < 0 ) then + exit + else if ( input_status > 0 ) then + write(fstderr,*) "Error reading data from file: " //trim( filename ) + stop "Fatal error input_reader" + end if + + if( nRowI < 1 ) then + stop "Number of elements must be an integer and greater than zero in two-dim input file." + end if + + do k =1, nRowI + read(iunit, *) tmp + end do + nRowO = nRowO + 1 + end do + + do i=1, nRowO + + backspace(iunit) + + do j=1, nRowI + + backspace(iunit) + + end do + + end do + + backspace(iunit) + + ! Store the names into the structure and allocate accordingly + do k =1, nCol + read_vars(k)%name = names(k) + read_vars(k)%dim1_name = time_name + read_vars(k)%dim2_name = names(1) + + allocate( read_vars(k)%values(nRowI, nRowO) ) + end do + + other_dim%name = time_name + other_dim%dim_name = time_name + + allocate( other_dim%values(nRowO) ) + + ! Read in the data again to the newly allocated arrays + do k=1, nRowO + read(iunit,*) other_dim%values(k) + do j=1, nRowI + read(iunit,*) ( read_vars(i)%values(j,k), i=1, nCol) + end do + end do + + close(iunit) + + ! Eliminate a compiler warning + if ( .false. ) print *, tmp + + return + end subroutine read_two_dim_file + + !------------------------------------------------------------------------------------------------ + subroutine read_one_dim_file( iunit, nCol, filename, read_vars ) + ! + ! Description: + ! This subroutine reads from a file containing data that varies + ! in one dimension. The dimension is typically time. + ! + ! References: + ! None + !---------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + + intrinsic :: trim, index + + ! Input Variable(s) + + integer, intent(in) :: iunit ! I/O unit + + integer, intent(in) :: nCol ! Number of columns expected in the data file + + character(len=*), intent(in) :: filename ! Name of the file being read from + + ! Output Variable(s) + + type (one_dim_read_var), dimension(nCol),intent(out) :: & + read_vars ! Structured information from the file + + ! Local Variable(s) + character(len=30),dimension(nCol) :: names + + character(len=200) :: tmpline + + integer nRow + + integer :: k, j + + real( kind = core_rknd ), dimension(nCol) :: tmp + + logical :: isComment + + integer :: input_status ! The status of a read statement + + ! ---- Begin Code ---- + + isComment = .true. + + ! First run through, take names and determine how large the data file is. + open(unit=iunit, file=trim( filename ), status = 'old' ) + + ! Skip all the comments at the top of the file + do while(isComment) + read(iunit,fmt='(A)') tmpline + k = index( tmpline, "!" ) + isComment = .false. + if(k > 0) then + isComment = .true. + end if + end do + + ! Go back to the line that wasn't a comment. + backspace(iunit) + + read(iunit, fmt=*) names + + ! Count up the number of rows + nRow = 0 + do while(.true.) + read(iunit, *, iostat=input_status) tmp + + ! If input_status shows an end of file, exit the loop + if( input_status < 0 ) then + exit + end if + + nRow = nRow+1 + end do + + ! Rewind that many rows + do k = 0, nRow + backspace(iunit) + end do + + ! Store the names into the structure and allocate accordingly + do k = 1, nCol + read_vars(k)%name = names(k) + read_vars(k)%dim_name = names(1) + allocate( read_vars(k)%values(nRow) ) + end do + + ! Read in the data again to the newly allocated arrays + do k=1, nRow + read(iunit,*) ( read_vars(j)%values(k), j=1, nCol) + end do + + close(iunit) + + ! Avoiding compiler warning + if ( .false. ) print *, tmp + + return + + end subroutine read_one_dim_file + + !------------------------------------------------------------------------------------------------ + subroutine fill_blanks_one_dim_vars( num_vars, one_dim_vars ) + ! + ! Description: + ! This subroutine fills in the blank spots (signified by constant blank_value) + ! with values linearly interpolated using the first element of the array as a + ! guide. + ! + ! References: + ! None + !---------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: size + + ! Input Variable(s) + integer, intent(in) :: num_vars ! Number of elements in one_dim_vars + + ! Input/Output Variable(s) + type(one_dim_read_var), dimension(num_vars), intent(inout) :: & + one_dim_vars ! Read data that may have gaps. + + ! Local variable(s) + integer :: i + + ! ---- Begin Code ---- + + do i=1, num_vars + one_dim_vars(i)%values = linear_fill_blanks( size( one_dim_vars(i)%values ), & + one_dim_vars(1)%values, one_dim_vars(i)%values, & + 0.0_core_rknd ) + end do + + return + + end subroutine fill_blanks_one_dim_vars + + !------------------------------------------------------------------------------------------------ + subroutine fill_blanks_two_dim_vars( num_vars, other_dim, two_dim_vars ) + ! + ! Description: + ! This subroutine fills in the blank spots (signified by the + ! constant blank_value with values linearly interpolated using the first + ! element of the array and the values in the other_dim argument as a guide. + ! + ! This is a two step process. First we assume that the other_dim values + ! have no holes, but there are blanks for that variable across that + ! dimension. Then we fill holes across the dimension whose values are first + ! in the array of two_dim_vars. + ! + ! Ex. Time is the 'other_dim' and Height in meters is the first element in + ! two_dim_vars. + ! + ! References: + ! None + !---------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: size + + ! Input Variable(s) + integer, intent(in) :: num_vars ! Number of elements in one_dim_vars + + ! Input/Output Variable(s) + type(one_dim_read_var), intent(in) :: other_dim ! Read data + + type(two_dim_read_var), dimension(num_vars), intent(inout) :: & + two_dim_vars ! Read data that may have gaps. + + ! Local variables + integer :: i,j ! Loop iterators + + integer :: & + dim_size, & ! 1st dimension size + other_dim_size ! 2nd dimension size + + ! ---- Begin Code ---- + + dim_size = size( two_dim_vars(1)%values, 1 ) + + other_dim_size = size( other_dim%values ) + + do i=2, num_vars + ! Interpolate along main dim + do j=1, other_dim_size + two_dim_vars(i)%values(:,j) = linear_fill_blanks( dim_size, & + two_dim_vars(1)%values(:,j), & + two_dim_vars(i)%values(:,j), blank_value ) + end do ! j = 1 .. other_dim_size + + ! Interpolate along other dim + do j=1, dim_size + two_dim_vars(i)%values(j,:) = linear_fill_blanks( other_dim_size, & + other_dim%values, & + two_dim_vars(i)%values(j,:), blank_value ) + end do ! j = 1 .. dim_size + + end do ! i = 2 .. num_vars + + return + + end subroutine fill_blanks_two_dim_vars + + + !------------------------------------------------------------------------------------------------ + function linear_fill_blanks( dim_grid, grid, var, default_value ) & + ! + ! Description: + ! This function fills blanks in array var using the grid + ! as a guide. Blank values in var are signified by being + ! less than or equal to the constant blank_value. + ! + ! References: + ! None + !----------------------------------------------------------------------------------------------- + result( var_out ) + + use crmx_interpolation, only: zlinterp_fnc + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable(s) + integer, intent(in) :: dim_grid ! Size of grid + + real( kind = core_rknd ), dimension(dim_grid), intent(in) :: & + grid ! Array that var is being interpolated to. + + real( kind = core_rknd ), dimension(dim_grid), intent(in) :: & + var ! Array that may contain gaps. + + real( kind = core_rknd ), intent(in) :: & + default_value ! Default value if entire profile == blank_value + + ! Output Variable(s) + real( kind = core_rknd ), dimension(dim_grid) :: & + var_out ! Return variable + + ! Local Variables + real( kind = core_rknd ), dimension(dim_grid) :: temp_grid + real( kind = core_rknd ), dimension(dim_grid) :: temp_var + + integer :: i + integer :: amt + + logical :: reversed + + ! ---- Begin Code ---- + + reversed = .false. + + ! Essentially this code leverages the previously written zlinterp function. + ! A smaller temporary grid and var variable are being created to pass to + ! zlinterp. zlinterp then performs the work of taking the temporary var + ! array and interpolating it to the actual grid array. + + amt = 0 + do i=1, dim_grid + if ( var(i) > blank_value ) then + amt = amt + 1 + temp_var(amt) = var(i) + temp_grid(amt) = grid(i) + end if + if ( i > 1 ) then + if ( grid(i) < grid(i-1) ) then + reversed = .true. + end if + end if + end do + + + if ( amt == 0 ) then + var_out = default_value + else if (amt < dim_grid) then + if ( reversed ) then + var_out = zlinterp_fnc( dim_grid, amt, -grid, -temp_grid(1:amt), temp_var(1:amt) ) + else + var_out = zlinterp_fnc( dim_grid, amt, grid, temp_grid(1:amt), temp_var(1:amt) ) + end if + else + var_out = var + end if + + return + end function linear_fill_blanks + !---------------------------------------------------------------------------- + subroutine deallocate_one_dim_vars( num_vars, one_dim_vars ) + ! + ! Description: + ! This subroutine deallocates the pointer stored in + ! one_dim_vars%value for the whole array. + ! + !------------------------------------------------------------------------------ + implicit none + + ! External functions + intrinsic :: associated + + ! Input Variable(s) + integer, intent(in) :: num_vars ! Number of elements in one_dim_vars + + type(one_dim_read_var), dimension(num_vars), intent(inout) :: & + one_dim_vars ! Read data that may have gaps. + + ! Local Variable(s) + integer :: i + + ! Begin Code + + do i=1, num_vars + + if ( associated( one_dim_vars(i)%values ) ) then + + deallocate( one_dim_vars(i)%values ) + + end if + + end do ! 1 .. num_vars + + return + end subroutine deallocate_one_dim_vars + + !------------------------------------------------------------------------------------------------ + subroutine deallocate_two_dim_vars( num_vars, two_dim_vars, other_dim ) + ! + ! Description: + ! This subroutine deallocates the pointer stored in + ! two_dim_vars%value for the whole array + ! + ! References: + ! None + !---------------------------------------------------------------------------------------------- + implicit none + + ! External Functions + intrinsic :: associated + + ! Input Variable(s) + integer, intent(in) :: num_vars ! Number of elements in one_dim_vars + + ! Input/Output Variables + type(one_dim_read_var), intent(inout) :: other_dim + + type(two_dim_read_var), dimension(num_vars), intent(inout) :: & + two_dim_vars ! Read data that may have gaps. + + ! Local Variable(s) + integer :: i + + ! ---- Begin Code ---- + + do i=1, num_vars + + if ( associated( two_dim_vars(i)%values ) ) then + + deallocate(two_dim_vars(i)%values) + + end if + + end do + + if ( associated( other_dim%values ) ) then + + deallocate(other_dim%values) + + end if + + return + end subroutine deallocate_two_dim_vars + !------------------------------------------------------------------------------------------------ + function read_x_table( nvar, xdim, ydim, target_name, retVars ) result( x ) + ! + ! Description: + ! Searches for the variable specified by target_name in the + ! collection of retVars. If the function finds the variable then it returns + ! it. If it does not the program using this function will exit gracefully + ! with a warning message. + ! + ! References: + ! None + !----------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + implicit none + + ! Input Variable(s) + integer, intent(in) :: nvar ! Number of variables in retVars + + integer, intent(in) :: xdim, ydim + + character(len=*), intent(in) :: & + target_name ! Name of the variable that is being searched for + + type(two_dim_read_var), dimension(nvar), intent(in) :: & + retVars ! Collection of data being searched through + + ! Output Variable(s) + real( kind = core_rknd ), dimension( xdim, ydim ) :: x + + ! Local Variables + integer :: i ! Loop iterator + + logical :: l_found + + ! ---- Begin Code ---- + + l_found = .false. + + i = 1 + + do while( i <= nvar .and. .not. l_found) + + if( retVars(i)%name == target_name ) then + + l_found = .true. + + x = retVars(i)%values + + end if + + i=i+1 + + end do ! i <= nvar .and. not l_found + + if ( .not. l_found ) then + + write(fstderr,*) trim( target_name )//" could not be found." + + stop "Fatal error in function read_x_table" + + end if + + return + + end function read_x_table + + + !------------------------------------------------------------------------------------------------ + function read_x_profile( nvar, dim_size, target_name, retVars, & + input_file ) result( x ) + ! + ! Description: + ! Searches for the variable specified by target_name in the + ! collection of retVars. If the function finds the variable then it returns + ! it. If it does not the program using this function will exit gracefully + ! with a warning message. + ! + ! Modified by Cavyn, June 2010 + !---------------------------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Variable for writing to error stream + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External Functions + intrinsic :: present, size + + ! Input Variable(s) + integer, intent(in) :: & + nvar, & ! Number of variables in retVars + dim_size ! Size of the array returned + + character(len=*), intent(in) :: & + target_name ! Name of the variable that is being searched for + + type(one_dim_read_var), dimension(nvar), intent(in) :: & + retVars ! Collection being searched + + character(len=*), optional, intent(in) :: & + input_file ! Name of the input file containing the variables + + ! Output Variable(s) + real( kind = core_rknd ), dimension(dim_size) :: x + + ! Local Variables + integer :: i + + ! ---- Begin Code ---- + + i = get_target_index( nvar, target_name, retVars ) + + if ( i > 0 ) then + x(1:size(retVars(i)%values)) = retVars(i)%values + + else + if( present( input_file ) ) then + write(fstderr,*) trim( target_name ), ' could not be found. Check the file ', input_file + else + write(fstderr,*) trim( target_name ), ' could not be found. Check your sounding.in file.' + end if ! present( input_file ) + stop "Fatal error in read_x_profile" + + end if ! target_exists_in_array + + return + + end function read_x_profile + + !------------------------------------------------------------------------------ + function get_target_index( nvar, target_name, retVars) result( i ) + ! + ! Description: + ! Returns the index of the variable specified by target_name in the + ! collection of retVars. Returns -1 if variable does not exist in retVars + ! + ! References: + ! None + ! + ! Created by Cavyn, July 2010 + !---------------------------------------------------------------------------------------------- + + implicit none + + ! Input Variable(s) + integer, intent(in) :: nvar ! Number of variables in retVars + character(len=*), intent(in) :: target_name ! Variable being searched for + type(one_dim_read_var), dimension(nvar), intent(in) :: retVars ! Collection being searched + + ! Output Variable + integer :: i + + ! Local Variable(s) + logical :: l_found + + !----------------BEGIN CODE------------------ + + l_found = .false. + + i = 0 + do while ( i < nvar .and. .not. l_found ) + i = i+1 + if( retVars(i)%name == target_name ) then + l_found = .true. + end if + end do + + if( .not. l_found ) then + i = -1 + end if + + return + + end function get_target_index + + !============================================================================= + function count_columns( iunit, filename ) result( nCols ) + ! Description: + ! This function counts the number of columns in a file, assuming that the + ! first line of the file contains only column headers. (Comments are OK) + + ! References: + ! None + + ! Created by Cavyn, July 2010 + !----------------------------------------------------------------------------- + + implicit none + + ! Input Variables + integer, intent(in) :: iunit ! I/O unit + character(len=*), intent(in) :: filename ! Name of the file being read from + + ! Output Variable + integer :: nCols ! The number of data columns in the selected file + + ! Local Variables + integer :: i, k ! Loop Counter + character(len=200) :: tmp ! Temporary char buffer + character(len=200), dimension(50) :: colArray ! Max of 50 columns + logical :: isComment + integer :: status_var ! IO status for read statement + + + ! -------------------------BEGIN CODE------------------------------------- + + isComment = .true. + + open(unit=iunit, file=trim(filename), status = 'old' ) + + ! Skip all the comments at the top of the file + do while(isComment) + read(iunit,fmt='(A)') tmp + k = index(tmp, "!") + isComment = .false. + if(k > 0) then + isComment = .true. + end if + end do + + ! Go back to the line that wasn't a comment. + backspace(iunit) + + ! Count the number of columns + nCols = 0 + colArray = "" + read(iunit,fmt='(A)',iostat=status_var) tmp + ! Only continue if there was no IO error or end of data + if( status_var == 0 ) then + ! Move all words into an array + read(tmp,*,iostat=status_var) (colArray(i), i=1,size( colArray )) + + else if ( status_var > 0 ) then + ! Handle the case where we have an error before the EOF marker is found + stop "Fatal error reading data in time_dependent_input function count_columns" + + end if + + do i=1,size(colArray) + if( colArray(i) /= "" ) then ! Increment number of columns until array is blank + nCols = nCols+1 + end if + end do + + close(iunit) + + end function count_columns + +!------------------------------------------------------------------------------ +end module crmx_input_reader diff --git a/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 b/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 new file mode 100644 index 0000000000..7a69a4e9f6 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 @@ -0,0 +1,620 @@ +!------------------------------------------------------------------------------- +!$Id: interpolation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_interpolation + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + private ! Default Scope + + public :: lin_int, binary_search, zlinterp_fnc, & + linear_interpolation, linear_interp_factor, mono_cubic_interp, plinterp_fnc + + contains + +!------------------------------------------------------------------------------- + pure function lin_int( height_int, height_high, height_low, & + var_high, var_low ) + +! Description: +! This function computes a linear interpolation of the value of variable. +! Given two known values of a variable at two height values, the value +! of that variable at a height between those two height levels (rather +! than a height outside of those two height levels) is computed. +! +! Here is a diagram: +! +! ################################ Height high, know variable value +! +! +! +! -------------------------------- Height to be interpolated to; linear interpolation +! +! +! +! +! +! ################################ Height low, know variable value +! +! +! FORMULA: +! +! variable(@ Height interpolation) = +! +! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] +! * (Height interpolation - Height low) + variable(@ Height low) + +! Comments from WRF-HOC, Brian Griffin. + +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + + real( kind = core_rknd ), intent(in) :: & + height_int, & ! Height to be interpolated to [m] + height_high, & ! Height above the interpolation [m] + height_low, & ! Height below the interpolation [m] + var_high, & ! Variable above the interpolation [units vary] + var_low ! Variable below the interpolation [units vary] + + ! Output Variables + real( kind = core_rknd ) :: lin_int + + ! Compute linear interpolation + + lin_int = ( ( height_int - height_low )/( height_high - height_low ) ) & + * ( var_high - var_low ) + var_low + + return + end function lin_int + + !------------------------------------------------------------------------------------------------- + elemental real( kind = core_rknd ) function linear_interp_factor( factor, var_high, var_low ) + ! Description: + ! Determines the coefficient for a linear interpolation + ! + ! References: + ! None + !------------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + real( kind = core_rknd ), intent(in) :: & + factor, & ! Factor [units vary] + var_high, & ! Variable above the interpolation [units vary] + var_low ! Variable below the interpolation [units vary] + + linear_interp_factor = factor * ( var_high - var_low ) + var_low + + return + end function linear_interp_factor + !------------------------------------------------------------------------------------------------- + pure function mono_cubic_interp & + ( z_in, km1, k00, kp1, kp2, zm1, z00, zp1, zp2, fm1, f00, fp1, fp2 ) result ( f_out ) + + ! Description: + ! Steffen's monotone cubic interpolation method + ! Returns monotone cubic interpolated value between x00 and xp1 + + ! Original Author: + ! Takanobu Yamaguchi + ! tak.yamaguchi@noaa.gov + ! + ! This version has been modified slightly for CLUBB's coding standards and + ! adds the 3/2 from eqn 21. -dschanen 26 Oct 2011 + ! We have also added a quintic polynomial option. + ! + ! References: + ! M. Steffen, Astron. Astrophys. 239, 443-450 (1990) + !------------------------------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + three_halves, & ! Constant(s) + eps + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_model_flags, only: & + l_quintic_poly_interp ! Variable(s) + + implicit none + + ! Constant Parameters + logical, parameter :: & + l_equation_21 = .true. + + ! External + intrinsic :: sign, abs, min + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + z_in ! The altitude to be interpolated to [m] + + ! k-levels; their meaning depends on whether we're extrapolating or interpolating + integer, intent(in) :: & + km1, k00, kp1, kp2 + + real( kind = core_rknd ), intent(in) :: & + zm1, z00, zp1, zp2, & ! The altitudes for km1, k00, kp1, kp2 [m] + fm1, f00, fp1, fp2 ! The field at km1, k00, kp1, and kp2 [units vary] + + ! Output Variables + real( kind = core_rknd ) :: f_out ! The interpolated field + + ! Local Variables + real( kind = core_rknd ) :: & + hm1, h00, hp1, & + sm1, s00, sp1, & + p00, pp1, & + dfdx00, dfdxp1, & + c1, c2, c3, c4, & + w00, wp1, & + coef1, coef2, & + zprime, beta, alpha, zn + + ! ---- Begin Code ---- + + if ( l_equation_21 ) then + ! Use the formula from Steffen (1990), which should make the interpolation + ! less restrictive + coef1 = three_halves + coef2 = 1.0_core_rknd/three_halves + else + coef1 = 1.0_core_rknd + coef2 = 1.0_core_rknd + end if + + if ( km1 <= k00 ) then + hm1 = z00 - zm1 + h00 = zp1 - z00 + hp1 = zp2 - zp1 + + if ( km1 == k00 ) then + s00 = ( fp1 - f00 ) / ( zp1 - z00 ) + sp1 = ( fp2 - fp1 ) / ( zp2 - zp1 ) + dfdx00 = s00 + pp1 = ( s00 * hp1 + sp1 * h00 ) / ( h00 + hp1 ) + dfdxp1 = coef1*( sign( 1.0_core_rknd, s00 ) + sign( 1.0_core_rknd, sp1 ) ) & + * min( abs( s00 ), abs( sp1 ), coef2*0.5_core_rknd*abs( pp1 ) ) + + else if ( kp1 == kp2 ) then + sm1 = ( f00 - fm1 ) / ( z00 - zm1 ) + s00 = ( fp1 - f00 ) / ( zp1 - z00 ) + p00 = ( sm1 * h00 + s00 * hm1 ) / ( hm1 + h00 ) + dfdx00 = coef1*( sign( 1.0_core_rknd, sm1 ) + sign( 1.0_core_rknd, s00 ) ) & + * min( abs( sm1 ), abs( s00 ), coef2*0.5_core_rknd*abs( p00 ) ) + dfdxp1 = s00 + + else + sm1 = ( f00 - fm1 ) / ( z00 - zm1 ) + s00 = ( fp1 - f00 ) / ( zp1 - z00 ) + sp1 = ( fp2 - fp1 ) / ( zp2 - zp1 ) + p00 = ( sm1 * h00 + s00 * hm1 ) / ( hm1 + h00 ) + pp1 = ( s00 * hp1 + sp1 * h00 ) / ( h00 + hp1 ) + dfdx00 = coef1*( sign( 1.0_core_rknd, sm1 ) + sign( 1.0_core_rknd, s00 ) ) & + * min( abs( sm1 ), abs( s00 ), coef2*0.5_core_rknd*abs( p00 ) ) + dfdxp1 = coef1*( sign( 1.0_core_rknd, s00 ) + sign( 1.0_core_rknd, sp1 ) ) & + * min( abs( s00 ), abs( sp1 ), coef2*0.5_core_rknd*abs( pp1 ) ) + + end if + + c1 = ( dfdx00 + dfdxp1 - 2._core_rknd * s00 ) / ( h00 ** 2 ) + c2 = ( 3._core_rknd * s00 - 2._core_rknd * dfdx00 - dfdxp1 ) / h00 + c3 = dfdx00 + c4 = f00 + + if ( .not. l_quintic_poly_interp ) then + + ! Old formula + !f_out = c1 * ( (z_in - z00)**3 ) + c2 * ( (z_in - z00)**2 ) + c3 * (z_in - z00) + c4 + + ! Faster nested multiplication + zprime = z_in - z00 + f_out = c4 + zprime*( c3 + zprime*( c2 + ( zprime*c1 ) ) ) + + else + + ! Use a quintic polynomial interpolation instead instead of the Steffen formula. + ! Unlike the formula above, this formula does not guarantee monotonicity. + + beta = 120._core_rknd * ( (fp1-f00) - 0.5_core_rknd * h00 * (dfdx00 + dfdxp1) ) + + ! Prevent an underflow by using a linear interpolation + if ( abs( beta ) < eps ) then + f_out = lin_int( z00, zp1, zm1, & + fp1, fm1 ) + + else + alpha = (6._core_rknd/beta) * h00 * (dfdxp1-dfdx00) + 0.5_core_rknd + zn = (z_in-z00)/h00 + + f_out = ( & + (( (beta/20._core_rknd)*zn - (beta*(1._core_rknd+alpha) & + / 12._core_rknd)) * zn + (beta*alpha/6._core_rknd)) & + * zn**2 + dfdx00*h00 & + ) * zn + f00 + end if ! beta < eps + end if ! ~quintic_polynomial + + else + ! Linear extrapolation + wp1 = ( z_in - z00 ) / ( zp1 - z00 ) + w00 = 1._core_rknd - wp1 + f_out = wp1 * fp1 + w00 * f00 + + end if + + return + end function mono_cubic_interp + +!------------------------------------------------------------------------------- + pure integer function binary_search( n, array, var ) & + result( i ) + + ! Description: + ! This subroutine performs a binary search to find the closest value greater + ! than or equal to var in the array. This function returns the index of the + ! closest value of array that is greater than or equal to var. It returns a + ! value of -1 if var is outside the bounds of array. + ! + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + + ! Size of the array + integer, intent(in) :: n + + ! The array being searched (must be sorted from least value to greatest + ! value). + real( kind = core_rknd ), dimension(n), intent(in) :: array + + ! The value being searched for + real( kind = core_rknd ), intent(in) :: var + + ! Local Variables + + ! Has an index been found? + logical :: l_found + + ! Bounds of the search + integer :: high + integer :: low + + ! Initialize local variables + + l_found = .false. + + ! The initial value of low has been changed from 1 to 2 due to a problem + ! that was occuring when var was close to the lower bound. + ! + ! The lowest value in the array (which is sorted by increasing values) is + ! found at index 1, while the highest value in the array is found at + ! index n. Unless the value of var exactly corresponds with one of the + ! values found in the array, or unless the value of var is found outside of + ! the array, the value of var will be found between two levels of the array. + ! In this scenario, the output of function binary_search is the index of the + ! HIGHER level. For example, if the value of var is found between array(1) + ! and array(2), the output of function binary_search will be 2. + ! + ! Therefore, the lowest index of a HIGHER level in an interpolation is 2. + ! Thus, the initial value of low has been changed to 2. This will prevent + ! the value of variable "i" below from becoming 1. If the value of "i" + ! becomes 1, the code below tries to access array(0) (which is array(i-1) + ! when i = 1) and produces an error. + + low = 2 + + high = n + + ! This line is here to avoid a false compiler warning about "i" being used + ! uninitialized in this function. + i = (low + high) / 2 + + do while( .not. l_found .and. low <= high ) + + i = (low + high) / 2 + + if ( var > array( i - 1 ) .and. var <= array( i ) ) then + + l_found = .true. + + elseif ( var == array(1) ) then + + ! Special case where var falls exactly on the lowest value in the + ! array, which is array(1). This case is not covered by the statement + ! above. + l_found = .true. + ! The value of "i" must be set to 2 because an interpolation is + ! performed in the subroutine that calls this function that uses + ! indices "i" and "i-1". + i = 2 + + elseif ( var < array( i ) ) then + + high = i - 1 + + elseif ( var > array( i ) ) then + + low = i + 1 + + endif + + enddo ! while ( ~l_found & low <= high ) + + if ( .not. l_found ) i = -1 + + return + + end function binary_search + +!------------------------------------------------------------------------------- + function plinterp_fnc( dim_out, dim_src, grid_out, & + grid_src, var_src ) & + result( var_out ) +! Description: +! Do a linear interpolation in the vertical with pressures. Assumes +! values that are less than lowest source point are zero and above the +! highest source point are zero. Also assumes altitude increases linearly. +! This function just calls zlinterp_fnc, but negates grid_out and grid_src. + +! References: +! function LIN_INT from WRF-HOC +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: dim_out, dim_src + + real( kind = core_rknd ), dimension(dim_src), intent(in) :: & + grid_src, & ! [m] + var_src ! [units vary] + + real( kind = core_rknd ), dimension(dim_out), intent(in) :: & + grid_out ! [m] + + ! Output variable + real( kind = core_rknd ), dimension(dim_out) :: & + var_out ! [units vary] + + ! ---- Begin Code ---- + + var_out = zlinterp_fnc( dim_out, dim_src, -grid_out, & + -grid_src, var_src ) + + return + end function plinterp_fnc +!------------------------------------------------------------------------------- + function zlinterp_fnc( dim_out, dim_src, grid_out, & + grid_src, var_src ) & + result( var_out ) +! Description: +! Do a linear interpolation in the vertical. Assumes values that +! are less than lowest source point are zero and above the highest +! source point are zero. Also assumes altitude increases linearly. + +! References: +! function LIN_INT from WRF-HOC +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: dim_out, dim_src + + real( kind = core_rknd ), dimension(dim_src), intent(in) :: & + grid_src, & ! [m] + var_src ! [units vary] + + real( kind = core_rknd ), dimension(dim_out), intent(in) :: & + grid_out ! [m] + + ! Output variable + real( kind = core_rknd ), dimension(dim_out) :: & + var_out ! [units vary] + + ! Local variables + integer :: k, kint, km1 + +! integer :: tst, kp1 + + ! ---- Begin Code ---- + + k = 1 + + do kint = 1, dim_out, 1 + + ! Set to 0 if we're below the input data's lowest point + if ( grid_out(kint) < grid_src(1) ) then + var_out(kint) = 0.0_core_rknd + cycle + end if + + ! Increment k until the level is correct +! do while ( grid_out(kint) > grid_src(k) +! . .and. k < dim_src ) +! k = k + 1 +! end do + + ! Changed so a binary search is used instead of a sequential search +! tst = binary_search(dim_src, grid_src, grid_out(kint)) + k = binary_search(dim_src, grid_src, grid_out(kint)) + ! Joshua Fasching April 2008 + +! print *, "k = ", k +! print *, "tst = ", tst +! print *, "dim_src = ", dim_src +! print *,"------------------------------" + + ! If the increment leads to a level above the data, set this + ! point and all those above it to zero + !if( k > dim_src ) then + if ( k == -1 ) then + var_out(kint:dim_out) = 0.0_core_rknd + exit + end if + + km1 = max( 1, k-1 ) + !kp1 = min( k+1, dim_src ) + + ! Interpolate + var_out(kint) = lin_int( grid_out(kint), grid_src(k), & + grid_src(km1), var_src(k), var_src(km1) ) + +! ( var_src(k) - var_src(km1) ) / & +! ( grid_src(k) - grid_src(km1) ) & +! * ( grid_out(kint) - grid_src(km1) ) + var_src(km1) & +! Changed to use a standard function for interpolation + + !! Note this ends up changing the results slightly because + !the placement of variables has been changed. + +! Joshua Fasching April 2008 + + end do ! kint = 1..dim_out + + return + end function zlinterp_fnc + +!------------------------------------------------------------------------------- + subroutine linear_interpolation & + ( nparam, xlist, tlist, xvalue, tvalue ) + +! Description: +! Linear interpolation for 25 June 1996 altocumulus case. + +! For example, to interpolate between two temperatures in space, put +! your spatial coordinates in x-list and your temperature values in +! tlist. The point in question should have its spatial value stored +! in xvalue, and tvalue will be the temperature at that point. + +! Author: Michael Falk for COAMPS. +!------------------------------------------------------------------------------- + + use crmx_error_code, only: clubb_debug ! Procedure + + use crmx_constants_clubb, only: fstderr ! Constant + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: nparam ! Number of parameters in xlist and tlist + + ! Input/Output Variables + real( kind = core_rknd ), intent(inout), dimension(nparam) :: & + xlist, & ! List of x-values (independent variable) + tlist ! List of t-values (dependent variable) + + real( kind = core_rknd ), intent(in) :: & + xvalue ! x-value at which to interpolate + + real( kind = core_rknd ), intent(inout) :: & + tvalue ! t-value solved by interpolation + + ! Local variables + integer :: & + i, & ! Loop control variable for bubble sort- number of the + ! lowest yet-unsorted data point. + j ! Loop control variable for bubble sort- index of value + ! currently being tested + integer :: & + bottombound, & ! Index of the smaller value in the linear interpolation + topbound, & ! Index of the larger value in the linear interpolation + smallest ! Index of the present smallest value, for bubble sort + + real( kind = core_rknd ) :: temp ! A temporary variable used for the bubble sort swap + +!------------------------------------------------------------------------------- +! +! Bubble Sort algorithm, assuring that the elements are in order so +! that the interpolation is between the two closest points to the +! point in question. +! +!------------------------------------------------------------------------------- + + do i=1,nparam + smallest = i + do j=i,nparam + if ( xlist(j) < xlist(smallest) ) then + smallest = j + end if + end do + + temp = xlist(i) + xlist(i) = xlist(smallest) + xlist(smallest) = temp + + temp = tlist(i) + tlist(i) = tlist(smallest) + tlist(smallest) = temp + end do + +!------------------------------------------------------------------------------- +! +! If the point in question is larger than the largest x-value or +! smaller than the smallest x-value, crash. +! +!------------------------------------------------------------------------------- + + if ( (xvalue < xlist(1)) .or. (xvalue > xlist(nparam)) ) then + write(fstderr,*) "linear_interpolation: Value out of range" + stop + end if + +!------------------------------------------------------------------------------- +! +! Find the correct top and bottom bounds, do the interpolation, return c +! the value. +! +!------------------------------------------------------------------------------- + + topbound = -1 + bottombound = -1 + + do i=2,nparam + if ( (xvalue >= xlist(i-1)) .and. (xvalue <= xlist(i)) ) then + bottombound = i-1 + topbound = i + end if + end do + + if ( topbound == -1 .or. bottombound == -1 ) then + call clubb_debug( 1, "Sanity check failed! xlist is not properly sorted" ) + call clubb_debug( 1, "in linear_interpolation.") + end if + + tvalue = & + lin_int( xvalue, xlist(topbound), xlist(bottombound), & + tlist(topbound), tlist(bottombound) ) + + return + end subroutine linear_interpolation + +end module crmx_interpolation diff --git a/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 b/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 new file mode 100644 index 0000000000..c70a7876a0 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 @@ -0,0 +1,740 @@ +!----------------------------------------------------------------------- +! $Id: lapack_wrap.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_lapack_wrap + +! Description: +! Wrappers for the band diagonal and tridiagonal direct matrix +! solvers contained in the LAPACK library. + +! References: +! LAPACK--Linear Algebra PACKage +! URL: +!----------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_error_code, only: & + clubb_singular_matrix, & ! Variable(s) + clubb_bad_lapack_arg, & + clubb_var_equals_NaN, & + clubb_no_error + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Simple routines + public :: tridag_solve, band_solve + + ! Expert routines + public :: tridag_solvex, band_solvex + + private :: lapack_isnan + + ! A best guess for what the precision of a single precision and double + ! precision float is in LAPACK. Hopefully this will work more portably on + ! architectures like Itanium than the old code -dschanen 11 Aug 2011 + integer, parameter, private :: & + sp = selected_real_kind( precision( 0.0_core_rknd ) ), & + dp = selected_real_kind( precision( 0.d0 ) ) + + private ! Set Default Scope + + contains + +!----------------------------------------------------------------------- + subroutine tridag_solvex( solve_type, ndim, nrhs, & + supd, diag, subd, rhs, & + solution, rcond, err_code ) + +! Description: +! Solves a tridiagonal system of equations (expert routine). + +! References: +! +! + +! Notes: +! More expensive than the simple routine, but tridiagonal +! decomposition is still relatively cheap. +!----------------------------------------------------------------------- + use crmx_error_code, only: & + clubb_at_least_debug_level ! Logical function + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + external :: & + sgtsvx, & ! Single-prec. General Tridiagonal Solver eXpert + dgtsvx ! Double-prec. General Tridiagonal Solver eXpert + + intrinsic :: kind + + ! Input variables + character(len=*), intent(in) :: & + solve_type ! Used to write a message if this fails + + integer, intent(in) :: & + ndim, & ! N-dimension of matrix + nrhs ! # of right hand sides to back subst. after LU-decomp. + + ! Input/Output variables + real( kind = core_rknd ), intent(inout), dimension(ndim) :: & + diag, & ! Main diagonal + subd, supd ! Sub and super diagonal + + real( kind = core_rknd ), intent(inout), dimension(ndim,nrhs) :: & + rhs ! RHS input + + ! The estimate of the reciprocal of the condition number on the LHS matrix. + ! If rcond is < machine precision the matrix is singular to working + ! precision, and info == ndim+1. If rcond == 0, then the LHS matrix + ! is singular. This condition is indicated by a return code of info > 0. + real( kind = core_rknd ), intent(out) :: rcond + + integer, intent(out) :: & + err_code ! Used to determine when a decomp. failed + + ! Output variables + real( kind = core_rknd ), intent(out), dimension(ndim,nrhs) :: & + solution ! Solution + + ! Local Variables + ! These contain the decomposition of the matrix + real( kind = core_rknd ), dimension(ndim-1) :: dlf, duf + real( kind = core_rknd ), dimension(ndim) :: df + real( kind = core_rknd ), dimension(ndim-2) :: du2 + + integer, dimension(ndim) :: & + ipivot ! Index of pivots done during decomposition + + integer, dimension(ndim) :: & + iwork ! `scrap' array + + + real( kind = core_rknd ), dimension(nrhs) :: & + ferr, & ! Forward error estimate + berr ! Backward error estimate + + real( kind = core_rknd ), dimension(3*ndim) :: & + work ! `Scrap' array + + integer :: info ! Diagnostic output + + integer :: i ! Array index + +!----------------------------------------------------------------------- +! *** The LAPACK Routine *** +! SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, +! $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, +! $ WORK, IWORK, INFO ) +!----------------------------------------------------------------------- + + if ( kind( diag(1) ) == dp ) then + call dgtsvx( "Not Factored", "No Transpose lhs", ndim, nrhs, & + subd(2:ndim), diag, supd(1:ndim-1), & + dlf, df, duf, du2, ipivot, & + rhs, ndim, solution, ndim, rcond, & + ferr, berr, work, iwork, info ) + + else if ( kind( diag(1) ) == sp ) then + call sgtsvx( "Not Factored", "No Transpose lhs", ndim, nrhs, & + subd(2:ndim), diag, supd(1:ndim-1), & + dlf, df, duf, du2, ipivot, & + rhs, ndim, solution, ndim, rcond, & + ferr, berr, work, iwork, info ) + + else + stop "tridag_solvex: Cannot resolve the precision of real datatype" + + end if + + ! Print diagnostics for when ferr is large + if ( clubb_at_least_debug_level( 2 ) .and. any( ferr > 1.e-3_core_rknd ) ) then + + write(fstderr,*) "Warning, large error est. for: " // trim( solve_type ) + + do i = 1, nrhs, 1 + write(fstderr,*) "rhs # ", i, "tridag forward error est. =", ferr(i) + write(fstderr,*) "rhs # ", i, "tridag backward error est. =", berr(i) + end do + + write(fstderr,'(2(a20,e15.6))') "rcond est. = ", rcond, & + "machine epsilon = ", epsilon( diag(1) ) + end if + + select case( info ) + case( :-1 ) + write(fstderr,*) trim( solve_type )// & + "illegal value in argument", -info + err_code = clubb_bad_lapack_arg + + case( 0 ) + ! Success! + if ( lapack_isnan( ndim, nrhs, solution ) ) then + err_code = clubb_var_equals_NaN + else + err_code = clubb_no_error + end if + + case( 1: ) + if ( info == ndim+1 ) then + write(fstderr,*) trim( solve_type) // & + " Warning: matrix is singular to working precision." + write(fstderr,'(a,e12.5)') & + "Estimate of the reciprocal of the condition number: ", rcond + err_code = clubb_no_error + else + write(fstderr,*) solve_type// & + " singular matrix." + err_code = clubb_singular_matrix + end if + + end select + + return + end subroutine tridag_solvex + +!----------------------------------------------------------------------- + subroutine tridag_solve & + ( solve_type, ndim, nrhs, & + supd, diag, subd, rhs, & + solution, err_code ) + +! Description: +! Solves a tridiagonal system of equations (simple routine) + +! References: +! +! +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + external :: & + sgtsv, & ! Single-prec. General Tridiagonal Solver eXpert + dgtsv ! Double-prec. General Tridiagonal Solver eXpert + + intrinsic :: kind + + ! Input variables + character(len=*), intent(in) :: & + solve_type ! Used to write a message if this fails + + integer, intent(in) :: & + ndim, & ! N-dimension of matrix + nrhs ! # of right hand sides to back subst. after LU-decomp. + + ! Input/Output variables + real( kind = core_rknd ), intent(inout), dimension(ndim) :: & + diag, & ! Main diagonal + subd, supd ! Sub and super diagonal + + real( kind = core_rknd ), intent(inout), dimension(ndim,nrhs) :: & + rhs ! RHS input + + ! Output variables + real( kind = core_rknd ), intent(out), dimension(ndim,nrhs) :: & + solution ! Solution + + + integer, intent(out) :: & + err_code ! Used to determine when a decomp. failed + + ! Local Variables + + integer :: info ! Diagnostic output + +!----------------------------------------------------------------------- +! *** The LAPACK Routine *** +! SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO ) +!----------------------------------------------------------------------- + + if ( kind( diag(1) ) == dp ) then + call dgtsv( ndim, nrhs, subd(2:ndim), diag, supd(1:ndim-1), & + rhs, ndim, info ) + + else if ( kind( diag(1) ) == sp ) then + call sgtsv( ndim, nrhs, subd(2:ndim), diag, supd(1:ndim-1), & + rhs, ndim, info ) + + else + stop "tridag_solve: Cannot resolve the precision of real datatype" + + end if + + select case( info ) + case( :-1 ) + write(fstderr,*) trim( solve_type )// & + " illegal value in argument", -info + err_code = clubb_bad_lapack_arg + + solution = -999._core_rknd + + case( 0 ) + ! Success! + if ( lapack_isnan( ndim, nrhs, rhs ) ) then + err_code = clubb_var_equals_NaN + else + err_code = clubb_no_error + end if + + solution = rhs + + case( 1: ) + write(fstderr,*) trim( solve_type )//" singular matrix." + err_code = clubb_singular_matrix + + solution = -999._core_rknd + + end select + + return + end subroutine tridag_solve + +!----------------------------------------------------------------------- + subroutine band_solvex( solve_type, nsup, nsub, ndim, nrhs, & + lhs, rhs, solution, rcond, err_code ) +! Description: +! Restructure and then solve a band diagonal system, with +! diagnostic output + +! References: +! +! + +! Notes: +! I found that due to the use of sgbcon/dgbcon it is much +! more expensive to use this on most systems than the simple +! driver. Use this version only if you don't case about compute time. +! Also note that this version equilibrates the lhs and does an iterative +! refinement of the solutions, which results in a slightly different answer +! than the simple driver does. -dschanen 24 Sep 2008 +!----------------------------------------------------------------------- + use crmx_error_code, only: & + clubb_at_least_debug_level ! Logical function + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + external :: & + sgbsvx, & ! Single-prec. General Band Solver eXpert + dgbsvx ! Double-prec. General Band Solver eXpert + + intrinsic :: eoshift, kind, trim + + ! Input Variables + character(len=*), intent(in) :: solve_type + + integer, intent(in) :: & + nsup, & ! Number of superdiagonals + nsub, & ! Number of subdiagonals + ndim, & ! The order of the LHS Matrix, i.e. the # of linear equations + nrhs ! Number of RHS's to back substitute for + + real( kind = core_rknd ), dimension(nsup+nsub+1,ndim), intent(inout) :: & + lhs ! Left hand side + real( kind = core_rknd ), dimension(ndim,nrhs), intent(inout) :: & + rhs ! Right hand side(s) + + ! Output Variables + real( kind = core_rknd ), dimension(ndim,nrhs), intent(out) :: & + solution + + ! The estimate of the reciprocal condition number of matrix + ! after equilibration (if done). + real( kind = core_rknd ), intent(out) :: & + rcond + + integer, intent(out) :: err_code ! Valid calculation? + + ! Local Variables + + ! Workspaces + real( kind = core_rknd ), dimension(3*ndim) :: work + integer, dimension(ndim) :: iwork + + real( kind = core_rknd ), dimension(2*nsub+nsup+1,ndim) :: & + lulhs ! LU Decomposition of the LHS + + integer, dimension(ndim) :: & + ipivot + + real( kind = core_rknd ), dimension(nrhs) :: & + ferr, berr ! Forward and backward error estimate + + real( kind = core_rknd ), dimension(ndim) :: & + rscale, cscale ! Row and column scale factors for the LHS + + integer :: & + info, & ! If this doesn't come back as 0, something went wrong + offset, & ! Loop iterator + imain, & ! Main diagonal of the matrix + i ! Loop iterator + + character :: & + equed ! Row equilibration status + + +!----------------------------------------------------------------------- +! Reorder Matrix to use LAPACK band matrix format (5x6) + +! Shift example: + +! [ * * lhs(1,1) lhs(1,2) lhs(1,3) lhs(1,4) ] (2)=> +! [ * lhs(2,1) lhs(2,2) lhs(2,3) lhs(2,4) lhs(2,5) ] (1)=> +! [ lhs(3,1) lhs(3,2) lhs(3,3) lhs(3,4) lhs(3,5) lhs(3,6) ] +! <=(1) [ lhs(4,2) lhs(4,3) lhs(4,4) lhs(4,5) lhs(4,6) * ] +! <=(2) [ lhs(5,3) lhs(5,4) lhs(5,5) lhs(5,6) * * ] + +! The '*' indicates unreferenced elements. +! For additional bands above and below the main diagonal, the +! shifts to the left or right increases by the distance from the +! main diagonal of the matrix. +!----------------------------------------------------------------------- + + imain = nsup + 1 + + ! For the offset, (+) is left, and (-) is right + + ! Sub diagonals + do offset = 1, nsub, 1 + lhs(imain+offset, 1:ndim) & + = eoshift( lhs(imain+offset, 1:ndim), offset ) + end do + + ! Super diagonals + do offset = 1, nsup, 1 + lhs(imain-offset, 1:ndim) & + = eoshift( lhs(imain-offset, 1:ndim), -offset ) + end do + +!----------------------------------------------------------------------- +! *** The LAPACK Routine *** +! SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, +! $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, +! $ RCOND, FERR, BERR, WORK, IWORK, INFO ) +!----------------------------------------------------------------------- + + if ( kind( lhs(1,1) ) == dp ) then + call dgbsvx( 'Equilibrate lhs', 'No Transpose lhs', & + ndim, nsub, nsup, nrhs, & + lhs, nsup+nsub+1, lulhs, 2*nsub+nsup+1, & + ipivot, equed, rscale, cscale, & + rhs, ndim, solution, ndim, & + rcond, ferr, berr, work, iwork, info ) + + else if ( kind( lhs(1,1) ) == sp ) then + call sgbsvx( 'Equilibrate lhs', 'No Transpose lhs', & + ndim, nsub, nsup, nrhs, & + lhs, nsup+nsub+1, lulhs, 2*nsub+nsup+1, & + ipivot, equed, rscale, cscale, & + rhs, ndim, solution, ndim, & + rcond, ferr, berr, work, iwork, info ) + + else + stop "band_solvex: Cannot resolve the precision of real datatype" + ! One implication of this is that CLUBB cannot be used with quad + ! precision variables without a quad precision band diagonal solver + end if + +! %% debug +! select case ( equed ) +! case ('N') +! print *, "No equilib. was required for lhs." +! case ('R') +! print *, "Row equilib. was done on lhs." +! case ('C') +! print *, "Column equilib. was done on lhs." +! case ('B') +! print *, "Row and column equilib. was done on lhs." +! end select + +! write(*,'(a,e12.5)') "Row scale : ", rscale +! write(*,'(a,e12.5)') "Column scale: ", cscale +! write(*,'(a,e12.5)') "Estimate of the reciprocal of the "// +! "condition number: ", rcond +! write(*,'(a,e12.5)') "Forward Error Estimate: ", ferr +! write(*,'(a,e12.5)') "Backward Error Estimate: ", berr +! %% end debug + + ! Diagnostic information + if ( clubb_at_least_debug_level( 2 ) .and. any( ferr > 1.e-3_core_rknd ) ) then + + write(fstderr,*) "Warning, large error est. for: " // trim( solve_type ) + + do i = 1, nrhs, 1 + write(fstderr,*) "rhs # ", i, "band_solvex forward error est. =", ferr(i) + write(fstderr,*) "rhs # ", i, "band_solvex backward error est. =", berr(i) + end do + + write(fstderr,'(2(a20,e15.6))') "rcond est. = ", rcond, & + "machine epsilon = ", epsilon( lhs(1,1) ) + end if + + select case( info ) + + case( :-1 ) + write(fstderr,*) trim( solve_type )// & + " illegal value for argument", -info + err_code = clubb_bad_lapack_arg + + case( 0 ) + ! Success! + if ( lapack_isnan( ndim, nrhs, solution ) ) then + err_code = clubb_var_equals_NaN + else + err_code = clubb_no_error + end if + + case( 1: ) + if ( info == ndim+1 ) then + write(fstderr,*) trim( solve_type )// & + " Warning: matrix singular to working precision." + write(fstderr,'(a,e12.5)') & + "Estimate of the reciprocal of the"// & + " condition number: ", rcond + err_code = clubb_no_error + else + write(fstderr,*) trim( solve_type )// & + " band solver: singular matrix" + err_code = clubb_singular_matrix + end if + + end select + + return + end subroutine band_solvex + +!----------------------------------------------------------------------- + subroutine band_solve( solve_type, nsup, nsub, ndim, nrhs, & + lhs, rhs, solution, err_code ) +! Description: +! Restructure and then solve a band diagonal system + +! References: +! +! +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + external :: & + sgbsv, & ! Single-prec. General Band Solver + dgbsv ! Double-prec. General Band Solver + + intrinsic :: eoshift, kind, trim + + ! Input Variables + character(len=*), intent(in) :: solve_type + + integer, intent(in) :: & + nsup, & ! Number of superdiagonals + nsub, & ! Number of subdiagonals + ndim, & ! The order of the LHS Matrix, i.e. the # of linear equations + nrhs ! Number of RHS's to solve for + + ! Note: matrix lhs is intent(in), not intent(inout) + ! as in the subroutine band_solvex( ) + real( kind = core_rknd ), dimension(nsup+nsub+1,ndim), intent(in) :: & + lhs ! Left hand side + real( kind = core_rknd ), dimension(ndim,nrhs), intent(inout) :: & + rhs ! Right hand side(s) + + ! Output Variables + real( kind = core_rknd ), dimension(ndim,nrhs), intent(out) :: solution + + integer, intent(out) :: err_code ! Valid calculation? + + ! Local Variables + + ! Workspaces + real( kind = core_rknd ), dimension(2*nsub+nsup+1,ndim) :: & + lulhs ! LU Decomposition of the LHS + + integer, dimension(ndim) :: & + ipivot + + integer :: & + info, & ! If this doesn't come back as 0, something went wrong + offset, & ! Loop iterator + imain ! Main diagonal of the matrix + + ! Copy LHS into Decomposition scratch space + + lulhs(nsub+1:2*nsub+nsup+1, 1:ndim) = lhs(1:nsub+nsup+1, 1:ndim) + +!----------------------------------------------------------------------- +! Reorder LU Matrix to use LAPACK band matrix format + +! Shift example for lulhs matrix (note the extra bands): + +! [ + + + + + + ] +! [ + + + + + + ] +! [ * * lhs(1,1) lhs(1,2) lhs(1,3) lhs(1,4) ] (2)=> +! [ * lhs(2,1) lhs(2,2) lhs(2,3) lhs(2,4) lhs(2,5) ] (1)=> +! [ lhs(3,1) lhs(3,2) lhs(3,3) lhs(3,4) lhs(3,5) lhs(3,6) ] +! <=(1) [ lhs(4,2) lhs(4,3) lhs(4,4) lhs(4,5) lhs(4,6) * ] +! <=(2) [ lhs(5,3) lhs(5,4) lhs(5,5) lhs(5,6) * * ] +! [ + + + + + + ] +! [ + + + + + + ] + +! The '*' indicates unreferenced elements. +! The '+' indicates an element overwritten during decomposition. +! For additional bands above and below the main diagonal, the +! shifts to the left or right increases by the distance from the +! main diagonal of the matrix. +!----------------------------------------------------------------------- + + ! Reorder lulhs, omitting the additional 2*nsub bands + ! that are used for the LU decomposition of the matrix. + + imain = nsub + nsup + 1 + + ! For the offset, (+) is left, and (-) is right + + ! Sub diagonals + do offset = 1, nsub, 1 + lulhs(imain+offset, 1:ndim) & + = eoshift( lulhs(imain+offset, 1:ndim), offset ) + end do + + ! Super diagonals + do offset = 1, nsup, 1 + lulhs(imain-offset, 1:ndim) & + = eoshift( lulhs(imain-offset, 1:ndim), -offset ) + end do + +!----------------------------------------------------------------------- +! *** LAPACK routine *** +! SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) +!----------------------------------------------------------------------- + + if ( kind( lhs(1,1) ) == dp ) then + call dgbsv( ndim, nsub, nsup, nrhs, lulhs, nsub*2+nsup+1, & + ipivot, rhs, ndim, info ) + + else if ( kind( lhs(1,1) ) == sp ) then + call sgbsv( ndim, nsub, nsup, nrhs, lulhs, nsub*2+nsup+1, & + ipivot, rhs, ndim, info ) + + else + stop "band_solve: Cannot resolve the precision of real datatype" + ! One implication of this is that CLUBB cannot be used with quad + ! precision variables without a quad precision band diagonal solver + + end if + + select case( info ) + + case( :-1 ) + write(fstderr,*) trim( solve_type )// & + " illegal value for argument ", -info + err_code = clubb_bad_lapack_arg + + solution = -999._core_rknd + + case( 0 ) + ! Success! + if ( lapack_isnan( ndim, nrhs, rhs ) ) then + err_code = clubb_var_equals_NaN + else + err_code = clubb_no_error + end if + + solution = rhs + + case( 1: ) + write(fstderr,*) trim( solve_type )//" band solver: singular matrix" + err_code = clubb_singular_matrix + + solution = -999._core_rknd + + end select + + return + end subroutine band_solve + +!----------------------------------------------------------------------- + logical function lapack_isnan( ndim, nrhs, variable ) + +! Description: +! Check for NaN values in a variable using the LAPACK subroutines + +! References: +! +! +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none +#ifdef NO_LAPACK_ISNAN /* Used for older LAPACK libraries that don't have sisnan/disnan */ + + intrinsic :: any + + integer, intent(in) :: & + ndim, & ! Size of variable + nrhs ! Number of right hand sides + + real( kind = core_rknd ), dimension(ndim,nrhs), intent(in) :: & + variable ! Variable to check + + lapack_isnan = any( variable(:,1:nrhs) /= variable(:,1:nrhs) ) +#else + logical, external :: sisnan, disnan + + integer, intent(in) :: & + ndim, & ! Size of variable + nrhs ! Number of right hand sides + + real( kind = core_rknd ), dimension(ndim,nrhs), intent(in) :: & + variable ! Variable to check + + integer :: k, j + + ! ---- Begin Code ---- + + lapack_isnan = .false. + + if ( kind( variable ) == dp ) then + do k = 1, ndim + do j = 1, nrhs + lapack_isnan = disnan( variable(k,j) ) + if ( lapack_isnan ) exit + end do + if ( lapack_isnan ) exit + end do + else if ( kind( variable ) == sp ) then + do k = 1, ndim + do j = 1, nrhs + lapack_isnan = sisnan( variable(k,j) ) + if ( lapack_isnan ) exit + end do + if ( lapack_isnan ) exit + end do + else + stop "lapack_isnan: Cannot resolve the precision of real datatype" + end if +#endif /* NO_LAPACK_ISNAN */ + + return + end function lapack_isnan + +end module crmx_lapack_wrap diff --git a/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 b/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 new file mode 100644 index 0000000000..ce8ef95a3c --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 @@ -0,0 +1,540 @@ +! $Id: matrix_operations.F90 5690 2012-02-02 02:53:16Z dschanen@uwm.edu $ +module crmx_matrix_operations + + implicit none + + + public :: symm_covar_matrix_2_corr_matrix, Cholesky_factor, & + row_mult_lower_tri_matrix, print_lower_triangular_matrix, & + get_lower_triangular_matrix, set_lower_triangular_matrix_dp, & + set_lower_triangular_matrix + + private :: Symm_matrix_eigenvalues + + private ! Default scope + + contains + +!----------------------------------------------------------------------- + subroutine symm_covar_matrix_2_corr_matrix( ndim, covar, corr ) + +! Description: +! Convert a matrix of covariances in to a matrix of correlations. +! This only does the computation the lower triangular portion of the +! matrix. +! References: +! None +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + dp ! double precision + + implicit none + + ! External + intrinsic :: sqrt + + ! Input Variables + integer, intent(in) :: ndim + + real( kind = dp ), dimension(ndim,ndim), intent(in) :: & + covar ! Covariance Matrix [units vary] + + ! Output Variables + real( kind = dp ), dimension(ndim,ndim), intent(out) :: & + corr ! Correlation Matrix [-] + + ! Local Variables + integer :: i, j + + ! ---- Begin Code ---- + + corr = 0._dp ! Initialize to 0 + + do i = 1, ndim + do j = 1, i + corr(i,j) = covar(i,j) / sqrt( covar(i,i) * covar(j,j) ) + end do + end do + + return + end subroutine symm_covar_matrix_2_corr_matrix +!----------------------------------------------------------------------- + subroutine row_mult_lower_tri_matrix( ndim, xvector, tmatrix_in, tmatrix_out ) + +! Description: +! Do a row-wise multiply of the elements of a lower triangular matrix. +! References: +! None +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + dp ! double precision + + implicit none + + + ! Input Variables + integer, intent(in) :: ndim + + real( kind = dp ), dimension(ndim), intent(in) :: & + xvector ! Factors to be multiplied across a row [units vary] + + ! Input Variables + real( kind = dp ), dimension(ndim,ndim), intent(inout) :: & + tmatrix_in ! nxn matrix (usually a correlation matrix) [units vary] + + ! Output Variables + real( kind = dp ), dimension(ndim,ndim), intent(inout) :: & + tmatrix_out ! nxn matrix (usually a covariance matrix) [units vary] + + ! Local Variables + integer :: i, j + + ! ---- Begin Code ---- + + do i = 1, ndim + do j = 1, i + tmatrix_out(i,j) = tmatrix_in(i,j) * xvector(i) + end do + end do + + return + end subroutine row_mult_lower_tri_matrix + +!------------------------------------------------------------------------------- + subroutine Cholesky_factor( ndim, a_input, a_scaling, a_Cholesky, l_scaled ) +! Description: +! Create a Cholesky factorization of a_input. +! If the factorization fails we use a modified a_input matrix and attempt +! to factorize again. +! +! References: +! dpotrf +! dpoequ +! dlaqsy +!------------------------------------------------------------------------------- + use crmx_error_code, only: & + clubb_at_least_debug_level ! Procedure + + use crmx_constants_clubb, only: & + fstderr ! Constant + + use crmx_clubb_precision, only: & + dp, & ! double precision + core_rknd + + implicit none + + ! External + external :: dpotrf, dpoequ, dlaqsy ! LAPACK subroutines + + ! Constant Parameters + integer, parameter :: itermax = 10 ! Max iterations of the modified method + + real( kind = core_rknd), parameter :: d_coef = 0.1_core_rknd + ! Coefficient applied if the decomposition doesn't work + + ! Input Variables + integer, intent(in) :: ndim + + real( kind = dp ), dimension(ndim,ndim), intent(in) :: a_input + + ! Output Variables + real( kind = dp ), dimension(ndim), intent(out) :: a_scaling + + real( kind = dp ), dimension(ndim,ndim), intent(out) :: a_Cholesky + + logical, intent(out) :: l_scaled + + ! Local Variables + real( kind = dp ), dimension(ndim) :: a_eigenvalues + real( kind = dp ), dimension(ndim,ndim) :: a_corr, a_scaled + + real( kind = dp ) :: tau, d_smallest + + real( kind = dp ) :: amax, scond + integer :: info + integer :: i, j, iter + + character :: equed + + ! ---- Begin code ---- + + a_scaled = a_input ! Copy input array into output array + +! do i = 1, n +! do j = 1, n +! write(6,'(e10.3)',advance='no') a(i,j) +! end do +! write(6,*) "" +! end do +! pause + + equed = 'N' + + ! Compute scaling for a_input + call dpoequ( ndim, a_input, ndim, a_scaling, scond, amax, info ) + + if ( info == 0 ) then + ! Apply scaling to a_input + call dlaqsy( 'Lower', ndim, a_scaled, ndim, a_scaling, scond, amax, equed ) + end if + + ! Determine if scaling was necessary + if ( equed == 'Y' ) then + l_scaled = .true. + a_Cholesky = a_scaled + else + l_scaled = .false. + a_Cholesky = a_input + end if + + do iter = 1, itermax + call dpotrf( 'Lower', ndim, a_Cholesky, ndim, info ) + + select case( info ) + case( :-1 ) + write(fstderr,*) "Cholesky_factor " // & + " illegal value for argument ", -info + stop + case( 0 ) + ! Success! + if ( clubb_at_least_debug_level( 1 ) .and. iter > 1 ) then + write(fstderr,*) "a_factored (worked)=" + do i = 1, ndim + do j = 1, i + write(fstderr,'(g10.3)',advance='no') a_Cholesky(i,j) + end do + write(fstderr,*) "" + end do + end if + exit + case( 1: ) + if ( clubb_at_least_debug_level( 1 ) ) then + ! This shouldn't happen now that the s and t Mellor elements have been + ! modified to never be perfectly correlated, but it's here just in case. + ! -dschanen 10 Sept 2010 + write(fstderr,*) "Cholesky_factor: leading minor of order ", & + info, " is not positive definite." + write(fstderr,*) "factorization failed." + write(fstderr,*) "a_input=" + do i = 1, ndim + do j = 1, i + write(fstderr,'(g10.3)',advance='no') a_input(i,j) + end do + write(fstderr,*) "" + end do + write(fstderr,*) "a_Cholesky=" + do i = 1, ndim + do j = 1, i + write(fstderr,'(g10.3)',advance='no') a_Cholesky(i,j) + end do + write(fstderr,*) "" + end do + end if + + if ( clubb_at_least_debug_level( 2 ) ) then + call Symm_matrix_eigenvalues( ndim, a_input, a_eigenvalues ) + write(fstderr,*) "a_eigenvalues=" + do i = 1, ndim + write(fstderr,'(g10.3)',advance='no') a_eigenvalues(i) + end do + write(fstderr,*) "" + + call symm_covar_matrix_2_corr_matrix( ndim, a_input, a_corr ) + write(fstderr,*) "a_correlations=" + do i = 1, ndim + do j = 1, i + write(fstderr,'(g10.3)',advance='no') a_corr(i,j) + end do + write(fstderr,*) "" + end do + end if + + if ( iter == itermax ) then + write(fstderr,*) "iteration =", iter, "itermax =", itermax + stop "Fatal error in Cholesky_factor" + else if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Attempting to modify matrix to allow factorization." + end if + + if ( l_scaled ) then + a_Cholesky = a_scaled + else + a_Cholesky = a_input + end if + ! The number used for tau here is case specific to the Sigma covariance + ! matrix in the latin hypercube code and is not at all general. + ! Tau should be a number that is small relative to the other diagonal + ! elements of the matrix to have keep the error caused by modifying 'a' low. + ! -dschanen 30 Aug 2010 + d_smallest = a_Cholesky(1,1) + do i = 2, ndim + if ( d_smallest > a_Cholesky(i,i) ) d_smallest = a_Cholesky(i,i) + end do + ! Use the smallest element * d_coef * iteration + tau = d_smallest * real(d_coef, kind = dp) * real( iter, kind=dp ) + +! print *, "tau =", tau, "d_smallest = ", d_smallest + + do i = 1, ndim + do j = 1, ndim + if ( i == j ) then + a_Cholesky(i,j) = a_Cholesky(i,j) + tau ! Add tau to the diagonal + else + a_Cholesky(i,j) = a_Cholesky(i,j) + end if + end do + end do + + if ( clubb_at_least_debug_level( 2 ) ) then + call Symm_matrix_eigenvalues( ndim, a_Cholesky, a_eigenvalues ) + write(fstderr,*) "a_modified eigenvalues=" + do i = 1, ndim + write(fstderr,'(e10.3)',advance='no') a_eigenvalues(i) + end do + write(fstderr,*) "" + end if + + end select ! info + end do ! 1..itermax + + return + end subroutine Cholesky_factor + +!---------------------------------------------------------------------- + subroutine Symm_matrix_eigenvalues( ndim, a_input, a_eigenvalues ) +! Description: +! References: +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant + + use crmx_clubb_precision, only: & + dp ! double precision + + implicit none + + ! External + external :: dsyev ! LAPACK subroutine + + ! Parameters + integer, parameter :: & + lwork = 180 ! This is the optimal value I obtained for an n of 5 -dschanen 31 Aug 2010 + + ! Input Variables + integer, intent(in) :: ndim + + real( kind = dp ), dimension(ndim,ndim), intent(in) :: a_input + + ! Output Variables + real( kind = dp ), dimension(ndim), intent(out) :: a_eigenvalues + + ! Local Variables + real( kind = dp ), dimension(ndim,ndim) :: a_scratch + + real( kind = dp ), dimension(lwork) :: work + + integer :: info +! integer :: i, j + ! ---- Begin code ---- + + a_scratch = a_input + +! do i = 1, ndim +! do j = 1, ndim +! write(6,'(e10.3)',advance='no') a(i,j) +! end do +! write(6,*) "" +! end do +! pause + + call dsyev( 'No eigenvectors', 'Lower', ndim, a_scratch, ndim, & + a_eigenvalues, work, lwork, info ) + + select case( info ) + case( :-1 ) + write(fstderr,*) "Symm_matrix_eigenvalues:" // & + " illegal value for argument ", -info + stop + case( 0 ) + ! Success! + + case( 1: ) + write(fstderr,*) "Symm_matrix_eigenvalues: Algorithm failed to converge." + stop + end select + + return + end subroutine Symm_matrix_eigenvalues +!------------------------------------------------------------------------------- + subroutine set_lower_triangular_matrix( d_variables, index1, index2, xpyp, & + matrix ) +! Description: +! Set a value for the lower triangular portion of a matrix. +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! user defined precision + + implicit none + + ! External + intrinsic :: max, min + + ! Input Variables + integer, intent(in) :: & + d_variables, & ! Number of variates + index1, index2 ! Indices for 2 variates (the order doesn't matter) + + real( kind = core_rknd ), intent(in) :: & + xpyp ! Value for the matrix (usually a correlation or covariance) [units vary] + + ! Input/Output Variables + real( kind = core_rknd ), dimension(d_variables,d_variables), intent(inout) :: & + matrix ! The lower triangular matrix + + integer :: i,j + + ! ---- Begin Code ---- + + ! Reverse these to set the values of upper triangular matrix + i = max( index1, index2 ) + j = min( index1, index2 ) + + if( i > 0 .and. j > 0 ) then + matrix(i,j) = xpyp + end if + + return + end subroutine set_lower_triangular_matrix + +!------------------------------------------------------------------------------- + subroutine set_lower_triangular_matrix_dp( d_variables, index1, index2, xpyp, & + matrix ) +! Description: +! Set a value for the lower triangular portion of a matrix. +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + dp ! double precision + + implicit none + + ! External + intrinsic :: max, min + + ! Input Variables + integer, intent(in) :: & + d_variables, & ! Number of variates + index1, index2 ! Indices for 2 variates (the order doesn't matter) + + real( kind = dp ), intent(in) :: & + xpyp ! Value for the matrix (usually a correlation or covariance) [units vary] + + ! Input/Output Variables + real( kind = dp ), dimension(d_variables,d_variables), intent(inout) :: & + matrix ! The lower triangular matrix + + integer :: i,j + + ! ---- Begin Code ---- + + ! Reverse these to set the values of upper triangular matrix + i = max( index1, index2 ) + j = min( index1, index2 ) + + if( i > 0 .and. j > 0 ) then + matrix(i,j) = xpyp + end if + + return + end subroutine set_lower_triangular_matrix_dp + +!------------------------------------------------------------------------------- + subroutine get_lower_triangular_matrix( d_variables, index1, index2, matrix, & + xpyp ) +! Description: +! Returns a value from the lower triangular portion of a matrix. +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd + + implicit none + + ! External + intrinsic :: max, min + + ! Input Variables + integer, intent(in) :: & + d_variables, & ! Number of variates + index1, index2 ! Indices for 2 variates (the order doesn't matter) + + ! Input/Output Variables + real( kind = core_rknd ), dimension(d_variables,d_variables), intent(in) :: & + matrix ! The covariance matrix + + real( kind = core_rknd ), intent(out) :: & + xpyp ! Value from the matrix (usually a correlation or covariance) [units vary] + + integer :: i,j + + ! ---- Begin Code ---- + + ! Reverse these to set the values of upper triangular matrix + i = max( index1, index2 ) + j = min( index1, index2 ) + + xpyp = matrix(i,j) + + return + end subroutine get_lower_triangular_matrix + +!----------------------------------------------------------------------- + subroutine print_lower_triangular_matrix( iunit, ndim, matrix ) + +! Description: +! Print the values of lower triangular matrix to a file or console. + +! References: +! None +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: & + iunit, & ! File I/O logical unit (usually 6 for stdout and 0 for stderr) + ndim ! Dimension of the matrix + + real( kind = core_rknd ), dimension(ndim,ndim), intent(in) :: & + matrix ! Lower triangular matrix [units vary] + + ! Local Variables + integer :: i, j + + ! ---- Begin Code ---- + + do i = 1, ndim + do j = 1, i + write(iunit,fmt='(g15.6)',advance='no') matrix(i,j) + end do + write(iunit,fmt=*) "" ! newline + end do + + return + end subroutine print_lower_triangular_matrix + +end module crmx_matrix_operations diff --git a/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 b/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 new file mode 100644 index 0000000000..792ac5325f --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 @@ -0,0 +1,505 @@ +!----------------------------------------------------------------------- +! $Id: mean_adv.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_mean_adv + + ! Description: + ! Module mean_adv computes the mean advection terms for all of the + ! time-tendency (prognostic) equations in the CLUBB parameterization. All of + ! the mean advection terms are solved for completely implicitly, and therefore + ! become part of the left-hand side of their respective equations. + ! + ! Function term_ma_zt_lhs handles the mean advection terms for the variables + ! located at thermodynamic grid levels. These variables are: rtm, thlm, wp3, + ! all hydrometeor species, and sclrm. + ! + ! Function term_ma_zm_lhs handles the mean advection terms for the variables + ! located at momentum grid levels. The variables are: wprtp, wpthlp, wp2, + ! rtp2, thlp2, rtpthlp, up2, vp2, wpsclrp, sclrprtp, sclrpthlp, and sclrp2. + + implicit none + + private ! Default scope + + public :: term_ma_zt_lhs, & + term_ma_zm_lhs + + contains + + !============================================================================= + pure function term_ma_zt_lhs( wm_zt, invrs_dzt, level, invrs_dzm_k, invrs_dzm_km1 ) & + result( lhs ) + + ! Description: + ! Mean advection of var_zt: implicit portion of the code. + ! + ! The variable "var_zt" stands for a variable that is located at + ! thermodynamic grid levels. + ! + ! The d(var_zt)/dt equation contains a mean advection term: + ! + ! - w * d(var_zt)/dz. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - w * d( var_zt(t+1) )/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed to + ! a "+". + ! + ! The timestep index (t+1) means that the value of var_zt being used is from + ! the next timestep, which is being advanced to in solving the d(var_zt)/dt + ! equation. + ! + ! This term is discretized as follows: + ! + ! The values of var_zt are found on the thermodynamic levels, as are the + ! values of wm_zt (mean vertical velocity on thermodynamic levels). The + ! variable var_zt is interpolated to the intermediate momentum levels. The + ! derivative of the interpolated values is taken over the central + ! thermodynamic level. The derivative is multiplied by wm_zt at the central + ! thermodynamic level to get the desired result. + ! + ! -----var_zt(kp1)----------------------------------------- t(k+1) + ! + ! =================var_zt(interp)========================== m(k) + ! + ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) + ! + ! =================var_zt(interp)========================== m(k-1) + ! + ! -----var_zt(km1)----------------------------------------- t(k-1) + ! + ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond + ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) + ! + ! + ! Special discretization for upper boundary level: + ! + ! Method 1: Constant derivative method (or "one-sided" method). + ! + ! The values of var_zt are found on the thermodynamic levels, as are the + ! values of wm_zt (mean vertical velocity on the thermodynamic levels). The + ! variable var_zt is interpolated to momentum level gr%nz-1, based on + ! the values of var_zt at thermodynamic levels gr%nz and gr%nz-1. + ! However, the variable var_zt cannot be interpolated to momentum level + ! gr%nz. Rather, a linear extension is used to find the value of var_zt + ! at momentum level gr%nz, based on the values of var_zt at thermodynamic + ! levels gr%nz and gr%nz-1. The derivative of the extended and + ! interpolated values, d(var_zt)/dz, is taken over the central thermodynamic + ! level. Of course, this derivative will be the same as the derivative of + ! var_zt between thermodynamic levels gr%nz and gr%nz-1. The derivative + ! is multiplied by wm_zt at the central thermodynamic level to get the + ! desired result. + ! + ! For the following diagram, k = gr%nz, which is the uppermost level of + ! the model: + ! + ! =================var_zt(extend)========================== m(k) Boundary + ! + ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) + ! + ! =================var_zt(interp)========================== m(k-1) + ! + ! -----var_zt(km1)----------------------------------------- t(k-1) + ! + ! + ! Method 2: Zero derivative method: + ! the derivative d(var_zt)/dz over the model top is set to 0. + ! + ! This method corresponds with the "zero-flux" boundary condition option + ! for eddy diffusion, where d(var_zt)/dz is set to 0 across the upper + ! boundary. + ! + ! In order to discretize the upper boundary condition, consider a new level + ! outside the model (thermodynamic level gr%nz+1) just above the upper + ! boundary level (thermodynamic level gr%nz). The value of var_zt at the + ! level just outside the model is defined to be the same as the value of + ! var_zt at thermodynamic level gr%nz. Therefore, the value of + ! d(var_zt)/dz between the level just outside the model and the uppermost + ! thermodynamic level is 0, staying consistent with the zero-flux boundary + ! condition option for the eddy diffusion portion of the code. Therefore, + ! the value of var_zt at momentum level gr%nz, which is the upper boundary + ! of the model, would be the same as the value of var_zt at the uppermost + ! thermodynamic level. + ! + ! The values of var_zt are found on the thermodynamic levels, as are the + ! values of wm_zt (mean vertical velocity on the thermodynamic levels). The + ! variable var_zt is interpolated to momentum level gr%nz-1, based on + ! the values of var_zt at thermodynamic levels gr%nz and gr%nz-1. The + ! value of var_zt at momentum level gr%nz is set equal to the value of + ! var_zt at thermodynamic level gr%nz, as described above. The derivative + ! of the set and interpolated values, d(var_zt)/dz, is taken over the + ! central thermodynamic level. The derivative is multiplied by wm_zt at the + ! central thermodynamic level to get the desired result. + ! + ! For the following diagram, k = gr%nz, which is the uppermost level of + ! the model: + ! + ! --[var_zt(kp1) = var_zt(k)]----(level outside model)----- t(k+1) + ! + ! ==[var_zt(top) = var_zt(k)]===[d(var_zt)/dz|_(top) = 0]== m(k) Boundary + ! + ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) + ! + ! =================var_zt(interp)========================== m(k-1) + ! + ! -----var_zt(km1)----------------------------------------- t(k-1) + ! + ! where (top) stands for the grid index of momentum level k = gr%nz, which + ! is the upper boundary of the model. + ! + ! This method of boundary discretization is also similar to the method + ! currently employed at the lower boundary for most thermodynamic-level + ! variables. Since thermodynamic level k = 1 is below the model bottom, + ! mean advection is not applied. Thus, thermodynamic level k = 2 becomes + ! the lower boundary level. Now, the mean advection term at thermodynamic + ! level 2 takes into account var_zt from levels 1, 2, and 3. However, in + ! most cases, the value of var_zt(1) is set equal to var_zt(2) after the + ! matrix of equations has been solved. Therefore, the derivative, + ! d(var_zt)/dz, over the model bottom (momentum level k = 1) becomes 0. + ! Thus, the method of setting d(var_zt)/dz to 0 over the model top keeps + ! the way the upper and lower boundaries are handled consistent with each + ! other. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_model_flags, only: & + l_upwind_xm_ma ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + integer, parameter :: & + t_above = 1, & ! Index for upper thermodynamic level grid weight. + t_below = 2 ! Index for lower thermodynamic level grid weight. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wm_zt, & ! wm_zt(k) [m/s] + invrs_dzt, & ! Inverse of grid spacing (k) [1/m] + invrs_dzm_k, & ! Inverse of grid spacing (k) [1/m] + invrs_dzm_km1 ! Inverse of grid spacing (k-1) [1/m] + + + integer, intent(in) :: & + level ! Central thermodynamic level (on which calculation occurs). + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + ! Local Variables + logical, parameter :: & + l_ub_const_deriv = .true. ! Flag to use the "one-sided" upper boundary. + + integer :: & + mk, & ! Momentum level directly above central thermodynamic level. + mkm1 ! Momentum level directly below central thermodynamic level. + + ! Momentum level (k) is between thermodynamic level (k+1) + ! and thermodynamic level (k). + mk = level + + ! Momentum level (k-1) is between thermodynamic level (k) + ! and thermodynamic level (k-1). + mkm1 = level - 1 + + if ( level == 1 ) then + + ! k = 1 (bottom level); lower boundary level. + ! Thermodynamic level k = 1 is below the model bottom, so all effects + ! are shut off. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = 0.0_core_rknd + + + elseif ( level > 1 .and. level < gr%nz ) then + + ! Most of the interior model; normal conditions. + + if( .not. l_upwind_xm_ma ) then ! Use centered differencing + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = + wm_zt * invrs_dzt * gr%weights_zt2zm(t_above,mk) + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_below,mk) & + - gr%weights_zt2zm(t_above,mkm1) ) + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = - wm_zt * invrs_dzt * gr%weights_zt2zm(t_below,mkm1) + + else ! l_upwind_xm_ma == .true. Use upwind differencing + + if ( wm_zt > 0._core_rknd ) then ! Wind is in upward direction + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = + wm_zt * invrs_dzm_km1 + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = - wm_zt * invrs_dzm_km1 + + + else ! wm_zt < 0 Wind is in downward direction + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = + wm_zt * invrs_dzm_k + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = - wm_zt * invrs_dzm_k + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = 0.0_core_rknd + + end if ! wm_zt >0 + + end if ! l_upwind_xm_ma + + elseif ( level == gr%nz ) then + + ! k = gr%nz (top level); upper boundary level. + + if ( l_ub_const_deriv ) then + + ! Special discretization for constant derivative method (or "one-sided" + ! derivative method). + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_above,mk) & + - gr%weights_zt2zm(t_above,mkm1) ) + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_below,mk) & + - gr%weights_zt2zm(t_below,mkm1) ) + + else + + ! Special discretization for zero derivative method, where the + ! derivative d(var_zt)/dz over the model top is set to 0, in order to + ! stay consistent with the zero-flux boundary condition option in the + ! eddy diffusion code. + + ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] + lhs(kp1_tdiag) & + = 0.0_core_rknd + + ! Thermodynamic main diagonal: [ x var_zt(k,) ] + lhs(k_tdiag) & + = + wm_zt * invrs_dzt * ( 1.0_core_rknd - gr%weights_zt2zm(t_above,mkm1) ) + + ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] + lhs(km1_tdiag) & + = - wm_zt * invrs_dzt * gr%weights_zt2zm(t_below,mkm1) + + endif + + + endif ! level = gr%nz + + + return + end function term_ma_zt_lhs + + !============================================================================= + pure function term_ma_zm_lhs( wm_zm, invrs_dzm, level ) & + result( lhs ) + + ! Description: + ! Mean advection of var_zm: implicit portion of the code. + ! + ! The variable "var_zm" stands for a variable that is located at momentum + ! grid levels. + ! + ! The d(var_zm)/dt equation contains a mean advection term: + ! + ! - w * d(var_zm)/dz. + ! + ! This term is solved for completely implicitly, such that: + ! + ! - w * d( var_zm(t+1) )/dz. + ! + ! Note: When the term is brought over to the left-hand side, the sign + ! is reversed and the leading "-" in front of the term is changed to + ! a "+". + ! + ! The timestep index (t+1) means that the value of var_zm being used is from + ! the next timestep, which is being advanced to in solving the d(var_zm)/dt + ! equation. + ! + ! This term is discretized as follows: + ! + ! The values of var_zm are found on the momentum levels, as are the values + ! of wm_zm (mean vertical velocity on momentum levels). The variable var_zm + ! is interpolated to the intermediate thermodynamic levels. The derivative + ! of the interpolated values is taken over the central momentum level. The + ! derivative is multiplied by wm_zm at the central momentum level to get the + ! desired result. + ! + ! =====var_zm(kp1)========================================= m(k+1) + ! + ! -----------------var_zm(interp)-------------------------- t(k+1) + ! + ! =====var_zm(k)==================d(var_zm)/dz=====wm_zm=== m(k) + ! + ! -----------------var_zm(interp)-------------------------- t(k) + ! + ! =====var_zm(km1)========================================= m(k-1) + ! + ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond + ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. + ! The letter "t" is used for thermodynamic levels and the letter "m" is used + ! for momentum levels. + ! + ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_mdiag = 1, & ! Momentum superdiagonal index. + k_mdiag = 2, & ! Momentum main diagonal index. + km1_mdiag = 3 ! Momentum subdiagonal index. + + integer, parameter :: & + m_above = 1, & ! Index for upper momentum level grid weight. + m_below = 2 ! Index for lower momentum level grid weight. + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wm_zm, & ! wm_zm(k) [m/s] + invrs_dzm ! Inverse of grid spacing (k) [1/m] + + integer, intent(in) :: & + level ! Central momentum level (on which calculation occurs). + + ! Return Variable + real( kind = core_rknd ), dimension(3) :: lhs + + ! Local Variables + integer :: & + tkp1, & ! Thermodynamic level directly above central momentum level. + tk ! Thermodynamic level directly below central momentum level. + + ! Thermodynamic level (k+1) is between momentum level (k+1) + ! and momentum level (k). + tkp1 = level + 1 + + ! Thermodynamic level (k) is between momentum level (k) + ! and momentum level (k-1). + tk = level + + if ( level == 1 ) then + + ! k = 1; lower boundery level at surface. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = 0.0_core_rknd + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = 0.0_core_rknd + + + elseif ( level > 1 .and. level < gr%nz ) then + + ! Most of the interior model; normal conditions. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = + wm_zm * invrs_dzm * gr%weights_zm2zt(m_above,tkp1) + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = + wm_zm * invrs_dzm * ( gr%weights_zm2zt(m_below,tkp1) & + - gr%weights_zm2zt(m_above,tk) ) + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = - wm_zm * invrs_dzm * gr%weights_zm2zt(m_below,tk) + + + elseif ( level == gr%nz ) then + + ! k = gr%nz (top level); upper boundary level. + + ! Momentum superdiagonal: [ x var_zm(k+1,) ] + lhs(kp1_mdiag) & + = 0.0_core_rknd + + ! Momentum main diagonal: [ x var_zm(k,) ] + lhs(k_mdiag) & + = 0.0_core_rknd + + ! Momentum subdiagonal: [ x var_zm(k-1,) ] + lhs(km1_mdiag) & + = 0.0_core_rknd + + + endif + + return + end function term_ma_zm_lhs + +!=============================================================================== + +end module crmx_mean_adv diff --git a/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 b/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 new file mode 100644 index 0000000000..1418835d6e --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 @@ -0,0 +1,817 @@ +! $Id: mixing_length.F90 5779 2012-04-02 16:59:10Z dschanen@uwm.edu $ +!=============================================================================== +module crmx_mixing_length + + implicit none + + private ! Default Scope + + public :: compute_length + + contains + + !============================================================================= + subroutine compute_length( thvm, thlm, rtm, em, & + p_in_Pa, exner, thv_ds, mu, l_implemented, & + err_code, & + Lscale, Lscale_up, Lscale_down ) + ! Description: + ! Larson's 5th moist, nonlocal length scale + + ! References: + ! Section 3b ( /Eddy length formulation/ ) of + ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: + ! Method and Model Description'' Golaz, et al. (2002) + ! JAS, Vol. 59, pp. 3540--3551. + + !----------------------------------------------------------------------- + + ! mu = (1/M) dM/dz > 0. mu=0 for no entrainment. + ! Siebesma recommends mu=2e-3, although most schemes use mu=1e-4 + ! When mu was fixed, we used the value mu = 6.e-4 + + use crmx_constants_clubb, only: & ! Variable(s) + Cp, & ! Dry air specific heat at constant pressure [J/kg/K] + Rd, & ! Dry air gas constant [J/kg/K] + ep, & ! Rd / Rv [-] + ep1, & ! (1-ep)/ep [-] + ep2, & ! 1/ep [-] + Lv, & ! Latent heat of vaporiztion [J/kg/K] + grav, & ! Gravitational acceleration [m/s^2] + fstderr, & + zero_threshold + + use crmx_parameters_tunable, only: & ! Variable(s) + lmin ! Minimum value for Lscale [m] + + use crmx_parameters_model, only: & + Lscale_max ! Maximum value for Lscale [m] + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt ! Procedure(s) + + use crmx_numerical_check, only: & + length_check ! Procedure(s) + + use crmx_saturation, only: & + sat_mixrat_liq, & ! Procedure(s) + sat_mixrat_liq_lookup + + use crmx_error_code, only: & + clubb_at_least_debug_level, & ! Procedure(s) + fatal_error + + use crmx_error_code, only: & + clubb_no_error ! Constant + + use crmx_model_flags, only: & + l_sat_mixrat_lookup ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: min, max, sqrt + + ! Constant Parameters + real( kind = core_rknd ), parameter :: & + zlmin = 0.1_core_rknd, & ! Minimum value for Lscale [m] + Lscale_sfclyr_depth = 500._core_rknd ! [m] + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + thvm, & ! Virtual potential temp. on themodynamic level [K] + thlm, & ! Liquid potential temp. on themodynamic level [K] + rtm, & ! Total water mixing ratio on themodynamic level [kg/kg] + em, & ! em = 3/2 * w'^2; on momentum level [m^2/s^2] + exner, & ! Exner function on thermodynamic level [-] + p_in_Pa, & ! Pressure on thermodynamic level [Pa] + thv_ds ! Dry, base-state theta_v on thermodynamic level [K] + ! Note: thv_ds used as a reference theta_l here + + real( kind = core_rknd ), intent(in) :: & + mu ! mu Fractional extrainment rate per unit altitude [1/m] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model + + ! Output Variables + integer, intent(inout) :: & + err_code + + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + Lscale, & ! Mixing length [m] + Lscale_up, & ! Mixing length up [m] + Lscale_down ! Mixing length down [m] + + ! Local Variables + + integer :: i, j, & + err_code_Lscale + + real( kind = core_rknd ) :: tke_i, CAPE_incr + + real( kind = core_rknd ) :: dCAPE_dz_j, dCAPE_dz_j_minus_1, dCAPE_dz_j_plus_1 + + ! Temporary arrays to store calculations to speed runtime + real( kind = core_rknd ), dimension(gr%nz) :: exp_mu_dzm, invrs_dzm_on_mu + + ! Minimum value for Lscale that will taper off with height + real( kind = core_rknd ) :: lminh + + ! Parcel quantities at grid level j + real( kind = core_rknd ) :: thl_par_j, rt_par_j, rc_par_j, thv_par_j + + ! Used in latent heating calculation + real( kind = core_rknd ) :: tl_par_j, rsl_par_j, beta_par_j, & + s_par_j + + ! Parcel quantities at grid level j-1 + real( kind = core_rknd ) :: thl_par_j_minus_1, rt_par_j_minus_1 + + ! Parcel quantities at grid level j+1 + real( kind = core_rknd ) :: thl_par_j_plus_1, rt_par_j_plus_1 + + ! Variables to make L nonlocal + real( kind = core_rknd ) :: Lscale_up_max_alt, Lscale_down_min_alt + + ! ---- Begin Code ---- + + err_code_Lscale = clubb_no_error + + !---------- Mixing length computation ---------------------------------- + + ! Avoid uninitialized memory (these values are not used in Lscale) + ! -dschanen 12 March 2008 + Lscale_up(1) = 0.0_core_rknd + Lscale_down(1) = 0.0_core_rknd + + ! Initialize exp_mu_dzm--sets each exp_mu_dzm value to its corresponding + ! exp(-mu/gr%invrs_dzm) value. In theory, this saves 11 computations of + ! exp(-mu/gr%invrs_dzm) used below. + ! ~~EIHoppe//20090615 + exp_mu_dzm(:) = exp( -mu/gr%invrs_dzm(:) ) + + ! Initialize invrs_dzm_on_mu -- sets each invrs_dzm_on_mu value to its + ! corresponding (gr%invrs_dzm/mu) value. This will save computations of + ! this value below. + ! ~EIHoppe//20100728 + invrs_dzm_on_mu(:) = (gr%invrs_dzm(:))/mu + + !!!!! Compute Lscale_up for every vertical level. + + ! Upwards loop + + Lscale_up_max_alt = 0._core_rknd + do i = 2, gr%nz, 1 + + tke_i = zm2zt( em, i ) ! TKE interpolated to thermodynamic level + + Lscale_up(i) = zlmin + j = i + 1 + + thl_par_j_minus_1 = thlm(i) + rt_par_j_minus_1 = rtm(i) + dCAPE_dz_j_minus_1 = 0.0_core_rknd + + do while ((tke_i > 0._core_rknd) .and. (j < gr%nz)) + + ! thl, rt of parcel are conserved except for entrainment + + ! theta_l of the parcel at grid level j. + ! + ! The equation for the rate of change of theta_l of the parcel with + ! respect to height, due to entrainment, is: + ! + ! d(thl_par)/dz = - mu * ( thl_par - thl_env ); + ! + ! where thl_par is theta_l of the parcel, thl_env is theta_l of the + ! ambient (or environmental) air, and mu is the entrainment rate, + ! such that: + ! + ! mu = (1/m)*(dm/dz); + ! + ! where m is the mass of the parcel. The value of mu is set to be a + ! constant. + ! + ! The differential equation is solved for thl_par_j (thl_par at + ! height gr%zt(j)) given the boundary condition thl_par_j_minus_1 + ! (thl_par at height gr%zt(j-1)), and given the fact that the value + ! of thl_env is treated as changing linearly for a parcel of air + ! ascending from level j-1 (where thl_env has the value thlm(j-1)) to + ! level j (where thl_env has the value thlm(j)). + ! + ! For the special case where entrainment rate, mu, is set to 0, + ! thl_par remains constant as the parcel ascends. + + if ( mu /= 0.0_core_rknd ) then + + ! The ascending parcel is entraining at rate mu. + + ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) + ! values. ~~EIHoppe//20090615 + + ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. + ! ~EIHoppe//20100728 + + thl_par_j = thlm(j) - thlm(j-1)*exp_mu_dzm(j-1) & + - ( 1.0_core_rknd - exp_mu_dzm(j-1)) & + * ( (thlm(j) - thlm(j-1)) & + * invrs_dzm_on_mu(j-1) ) & +! / (mu/gr%invrs_dzm(j-1)) ) & + + thl_par_j_minus_1 * exp_mu_dzm(j-1) + + else + + ! The ascending parcel is not entraining. + + thl_par_j = thl_par_j_minus_1 + + endif + + ! r_t of the parcel at grid level j. + ! + ! The equation for the rate of change of r_t of the parcel with + ! respect to height, due to entrainment, is: + ! + ! d(rt_par)/dz = - mu * ( rt_par - rt_env ); + ! + ! where rt_par is r_t of the parcel, rt_env is r_t of the ambient (or + ! environmental) air, and mu is the entrainment rate, such that: + ! + ! mu = (1/m)*(dm/dz); + ! + ! where m is the mass of the parcel. The value of mu is set to be a + ! constant. + ! + ! The differential equation is solved for rt_par_j (rt_par at height + ! gr%zt(j)) given the boundary condition rt_par_j_minus_1 (rt_par at + ! height gr%zt(j-1)), and given the fact that the value of rt_env is + ! treated as changing linearly for a parcel of air ascending from + ! level j-1 (where rt_env has the value rtm(j-1)) to level j (where + ! rt_env has the value rtm(j)). + ! + ! For the special case where entrainment rate, mu, is set to 0, + ! rt_par remains constant as the parcel ascends. + + if ( mu /= 0.0_core_rknd ) then + + ! The ascending parcel is entraining at rate mu. + + ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) + ! values. ~~EIHoppe//20090615 + + ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. + ! ~EIHoppe//20100728 + + rt_par_j = rtm(j) - rtm(j-1)*exp_mu_dzm(j-1) & + - ( 1.0_core_rknd - exp_mu_dzm(j-1)) & + * ( (rtm(j) - rtm(j-1)) & + * invrs_dzm_on_mu(j-1) ) & +! / (mu/gr%invrs_dzm(j-1)) ) & + + rt_par_j_minus_1 * exp_mu_dzm(j-1) + + else + + ! The ascending parcel is not entraining. + + rt_par_j = rt_par_j_minus_1 + + endif + + ! Include effects of latent heating on Lscale_up 6/12/00 + ! Use thermodynamic formula of Bougeault 1981 JAS Vol. 38, 2416 + ! Probably should use properties of bump 1 in Gaussian, not mean!!! + + ! Calculate r_c of the parcel at grid level j based on the values of + ! theta_l of the parcel and r_t of the parcel at grid level j. + tl_par_j = thl_par_j*exner(j) + if ( l_sat_mixrat_lookup ) then + rsl_par_j = sat_mixrat_liq_lookup( p_in_Pa(j), tl_par_j ) + else + rsl_par_j = sat_mixrat_liq( p_in_Pa(j), tl_par_j ) + end if + ! SD's beta (eqn. 8) + beta_par_j = ep*(Lv/(Rd*tl_par_j))*(Lv/(cp*tl_par_j)) + ! s from Lewellen and Yoh 1993 (LY) eqn. 1 + s_par_j = (rt_par_j-rsl_par_j)/(1._core_rknd+beta_par_j*rsl_par_j) + rc_par_j = max( s_par_j, zero_threshold ) + + ! theta_v of entraining parcel at grid level j. + thv_par_j = thl_par_j + ep1 * thv_ds(j) * rt_par_j & + + ( Lv / (exner(j)*cp) - ep2 * thv_ds(j) ) * rc_par_j + + ! Lscale_up and CAPE increment. + ! + ! The equation for Lscale_up is: + ! + ! INT(z_i:z_i+Lscale_up) g * ( thv_par - thvm ) / thvm dz = -em(z_i); + ! + ! where thv_par is theta_v of the parcel, thvm is the mean + ! environmental value of theta_v, z_i is the altitude that the parcel + ! started its ascent from, and em is the mean value of TKE at + ! altitude z_i (which gives the parcel its initial upward boost). + ! + ! The increment of CAPE for any two successive vertical levels (z_0 + ! and z_1, such that z_0 < z_1, and where z_0 is gr%zt(j-1) and z_1 + ! is gr%zt(j)) is: + ! + ! CAPE_incr = INT(z_0:z_1) g * ( thv_par - thvm ) / thvm dz. + ! + ! Thus, the derivative of CAPE with respect to height is: + ! + ! dCAPE/dz = g * ( thv_par - thvm ) / thvm. + ! + ! A purely trapezoidal rule is used between levels z_0 and z_1, such + ! that dCAPE/dz is evaluated at levels z_0 and z_1, and is considered + ! to vary linearly at all altitudes z_0 <= z <= z_1. Thus, dCAPE/dz + ! is considered to be of the form: A * (z-zo) + dCAPE/dz|_(z_0), + ! where A = ( dCAPE/dz|_(z_1) - dCAPE/dz|_(z_0) ) / ( z_1 - z_0 ). + ! + ! The integral is evaluated to find the CAPE increment between two + ! successive vertical levels. The result either adds to or depletes + ! from the total amount of energy that keeps the parcel ascending. + + dCAPE_dz_j = ( grav/thvm(j) ) * ( thv_par_j - thvm(j) ) + + CAPE_incr = 0.5_core_rknd * ( dCAPE_dz_j + dCAPE_dz_j_minus_1 ) & + / gr%invrs_dzm(j-1) + + if ( tke_i + CAPE_incr > 0.0_core_rknd ) then + + ! The total amount of CAPE increment has not exhausted the initial + ! TKE (plus any additions by CAPE increments due to upward + ! buoyancy) that boosted and carried the parcel upward. The + ! thickness of the full grid level is added to Lscale_up. + + Lscale_up(i) = Lscale_up(i) + gr%zt(j) - gr%zt(j-1) + + else + + ! The total amount of CAPE increment has exhausted the initial TKE + ! (plus any additions by CAPE increments due to upward buoyancy) + ! that boosted and carried the parcel upward. Add the thickness + ! z - z_0 (where z_0 < z <= z_1) to Lscale_up. The calculation of + ! Lscale_up is complete. + + if ( dCAPE_dz_j == dCAPE_dz_j_minus_1 ) then + + ! Special case where dCAPE/dz|_(z_1) - dCAPE/dz|_(z_0) = 0, + ! thus making factor A (above) equal to 0. Find the remaining + ! distance z - z_0 that it takes to exhaust the remaining TKE + ! (tke_i). + + Lscale_up(i) & + = Lscale_up(i) & + + ( - tke_i / dCAPE_dz_j ) + + else + + ! Case used for most scenarios where dCAPE/dz|_(z_1) + ! /= dCAPE/dz|_(z_0), thus making factor A /= 0. Find the + ! remaining distance z - z_0 that it takes to exhaust the + ! remaining TKE (tke_i), using the quadratic formula (only the + ! negative (-) root works in this scenario). + + Lscale_up(i) & + = Lscale_up(i) & + + ( - dCAPE_dz_j_minus_1 / & + ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) ) & + / gr%invrs_dzm(j-1) & + - sqrt( dCAPE_dz_j_minus_1**2 & + - 2.0_core_rknd * tke_i * gr%invrs_dzm(j-1) & + * ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) ) & + / ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) & + / gr%invrs_dzm(j-1) + + endif + + endif + + ! Reset values for use during the next vertical level up. + + thl_par_j_minus_1 = thl_par_j + rt_par_j_minus_1 = rt_par_j + dCAPE_dz_j_minus_1 = dCAPE_dz_j + + tke_i = tke_i + CAPE_incr + j = j + 1 + + enddo + + ! Make Lscale_up nonlocal + ! + ! This code makes the value of Lscale_up nonlocal. Thus, if a parcel + ! starting from a lower altitude can ascend to altitude + ! Lscale_up_max_alt, then a parcel starting from a higher altitude should + ! also be able to ascend to at least altitude Lscale_up_max_alt, even if + ! the local result of Lscale_up for the parcel that started at a higher + ! altitude is not sufficient for the parcel to reach altitude + ! Lscale_up_max_alt. + ! + ! For example, if it was found that a parcel starting at an altitude of + ! 100 m. ascended to an altitude of 2100 m. (an Lscale_up value of + ! 2000 m.), then a parcel starting at an altitude of 200 m. should also + ! be able to ascend to an altitude of at least 2100 m. If Lscale_up + ! was found to be only 1800 m. for the parcel starting at 200 m. + ! (resulting in the parcel only being able to ascend to an altitude of + ! 2000 m.), then this code will overwrite the 1800 m. value with a + ! Lscale_up value of 1900 m. (so that the parcel reaches an altitude of + ! 2100 m.). + ! + ! This feature insures that the profile of Lscale_up will be very smooth, + ! thus reducing numerical instability in the model. + + Lscale_up_max_alt = max( Lscale_up_max_alt, Lscale_up(i)+gr%zt(i) ) + + if ( ( gr%zt(i) + Lscale_up(i) ) < Lscale_up_max_alt ) then + Lscale_up(i) = Lscale_up_max_alt - gr%zt(i) + endif + + enddo + + + !!!!! Compute Lscale_down for every vertical level. + + ! Do it again for downwards particle motion. + ! For now, do not include latent heat + + ! Chris Golaz modification to include effects on latent heating + ! on Lscale_down + + Lscale_down_min_alt = gr%zt(gr%nz) + do i = gr%nz, 2, -1 + + tke_i = zm2zt( em, i ) ! TKE interpolated to thermodynamic level + + Lscale_down(i) = zlmin + j = i - 1 + + thl_par_j_plus_1 = thlm(i) + rt_par_j_plus_1 = rtm(i) + dCAPE_dz_j_plus_1 = 0.0_core_rknd + + do while ( (tke_i > 0._core_rknd) .and. (j >= 2) ) + + ! thl, rt of parcel are conserved except for entrainment + + ! theta_l of the parcel at grid level j. + ! + ! The equation for the rate of change of theta_l of the parcel with + ! respect to height, due to entrainment, is: + ! + ! d(thl_par)/dz = - mu * ( thl_par - thl_env ); + ! + ! where thl_par is theta_l of the parcel, thl_env is theta_l of the + ! ambient (or environmental) air, and mu is the entrainment rate, + ! such that: + ! + ! mu = (1/m)*(dm/dz); + ! + ! where m is the mass of the parcel. The value of mu is set to be a + ! constant. + ! + ! NOTE: For an entraining, descending parcel, parcel mass will + ! increase as height decreases. Thus dm/dz < 0, and therefore + ! mu < 0. However, in the equation for thl_par_j, mu is always + ! multiplied by the delta_z factor ( gr%zt(j) - gr%zt(j+1) ), + ! which always has the propery delta_z < 0 for a descending + ! parcel. Thus, mu*delta_z > 0, just as for an entraining, + ! ascending parcel. Therefore, the same general form of the + ! entrainment equation (only with differing grid level indices) + ! can be used for both the ascending and descending parcels. + ! + ! The differential equation is solved for thl_par_j (thl_par at + ! height gr%zt(j)) given the boundary condition thl_par_j_plus_1 + ! (thl_par at height gr%zt(j+1)), and given the fact that the value + ! of thl_env is treated as changing linearly for a parcel of air + ! descending from level j+1 (where thl_env has the value thlm(j+1)) to + ! level j (where thl_env has the value thlm(j)). + ! + ! For the special case where entrainment rate, mu, is set to 0, + ! thl_par remains constant as the parcel descends. + + if ( mu /= 0.0_core_rknd ) then + + ! The descending parcel is entraining at rate mu. + + ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) + ! values. ~~EIHoppe//20090615 + + ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. + ! ~EIHoppe//20100728 + + thl_par_j = thlm(j) - thlm(j+1)*exp_mu_dzm(j) & + - ( 1.0_core_rknd - exp_mu_dzm(j)) & + * ( (thlm(j) - thlm(j+1)) & + * invrs_dzm_on_mu(j) ) & +! / (mu/gr%invrs_dzm(j)) ) & + + thl_par_j_plus_1 * exp_mu_dzm(j) + + else + + ! The descending parcel is not entraining. + + thl_par_j = thl_par_j_plus_1 + + endif + + ! r_t of the parcel at grid level j. + ! + ! The equation for the rate of change of r_t of the parcel with + ! respect to height, due to entrainment, is: + ! + ! d(rt_par)/dz = - mu * ( rt_par - rt_env ); + ! + ! where rt_par is r_t of the parcel, rt_env is r_t of the ambient (or + ! environmental) air, and mu is the entrainment rate, such that: + ! + ! mu = (1/m)*(dm/dz); + ! + ! where m is the mass of the parcel. The value of mu is set to be a + ! constant. + ! + ! NOTE: For an entraining, descending parcel, parcel mass will + ! increase as height decreases. Thus dm/dz < 0, and therefore + ! mu < 0. However, in the equation for rt_par_j, mu is always + ! multiplied by the delta_z factor ( gr%zt(j) - gr%zt(j+1) ), + ! which always has the propery delta_z < 0 for a descending + ! parcel. Thus, mu*delta_z > 0, just as for an entraining, + ! ascending parcel. Therefore, the same general form of the + ! entrainment equation (only with differing grid level indices) + ! can be used for both the ascending and descending parcels. + ! + ! The differential equation is solved for rt_par_j (rt_par at height + ! gr%zt(j)) given the boundary condition rt_par_j_plus_1 (rt_par at + ! height gr%zt(j+1)), and given the fact that the value of rt_env is + ! treated as changing linearly for a parcel of air descending from + ! level j+1 (where rt_env has the value rtm(j+1)) to level j (where + ! rt_env has the value rtm(j)). + ! + ! For the special case where entrainment rate, mu, is set to 0, + ! rt_par remains constant as the parcel descends. + + if ( mu /= 0.0_core_rknd ) then + + ! The descending parcel is entraining at rate mu. + + ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) + ! values. ~~EIHoppe//20090615 + + ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. + ! ~EIHoppe//20100728 + + rt_par_j = rtm(j) - rtm(j+1)*exp_mu_dzm(j) & + - ( 1.0_core_rknd - exp_mu_dzm(j) ) & + * ( (rtm(j) - rtm(j+1)) & +! / (mu/gr%invrs_dzm(j)) ) & + * invrs_dzm_on_mu(j) ) & + + rt_par_j_plus_1 * exp_mu_dzm(j) + + else + + ! The descending parcel is not entraining. + + rt_par_j = rt_par_j_plus_1 + + endif + + ! Include effects of latent heating on Lscale_down + ! Use thermodynamic formula of Bougeault 1981 JAS Vol. 38, 2416 + ! Probably should use properties of bump 1 in Gaussian, not mean!!! + + ! Calculate r_c of the parcel at grid level j based on the values of + ! theta_l of the parcel and r_t of the parcel at grid level j. + tl_par_j = thl_par_j*exner(j) + if ( l_sat_mixrat_lookup ) then + rsl_par_j = sat_mixrat_liq_lookup( p_in_Pa(j), tl_par_j ) + else + rsl_par_j = sat_mixrat_liq( p_in_Pa(j), tl_par_j ) + end if + ! SD's beta (eqn. 8) + beta_par_j = ep*(Lv/(Rd*tl_par_j))*(Lv/(cp*tl_par_j)) + ! s from Lewellen and Yoh 1993 (LY) eqn. 1 + s_par_j = (rt_par_j-rsl_par_j)/(1._core_rknd+beta_par_j*rsl_par_j) + rc_par_j = max( s_par_j, zero_threshold ) + + ! theta_v of the entraining parcel at grid level j. + thv_par_j = thl_par_j + ep1 * thv_ds(j) * rt_par_j & + + ( Lv / (exner(j)*cp) - ep2 * thv_ds(j) ) * rc_par_j + + ! Lscale_down and CAPE increment. + ! + ! The equation for Lscale_down (where Lscale_down is the absolute + ! value of downward distance) is: + ! + ! INT(z_i-Lscale_down:z_i) g * ( thv_par - thvm ) / thvm dz = em(z_i); + ! + ! where thv_par is theta_v of the parcel, thvm is the mean + ! environmental value of theta_v, z_i is the altitude that the parcel + ! started its descent from, and em is the mean value of TKE at + ! altitude z_i (which gives the parcel its initial downward boost). + ! + ! The increment of CAPE for any two successive vertical levels (z_0 + ! and z_(-1), such that z_(-1) < z_0, and where z_0 is gr%zt(j+1) and + ! z_(-1) is gr%zt(j)) is: + ! + ! CAPE_incr = INT(z_(-1):z_0) g * ( thv_par - thvm ) / thvm dz. + ! + ! Thus, the derivative of CAPE with respect to height is: + ! + ! dCAPE/dz = g * ( thv_par - thvm ) / thvm. + ! + ! A purely trapezoidal rule is used between levels z_(-1) and z_0, + ! such that dCAPE/dz is evaluated at levels z_(-1) and z_0, and is + ! considered to vary linearly at all altitudes z_(-1) <= z <= z_0. + ! Thus, dCAPE/dz is considered to be of the form: + ! A * (z-zo) + dCAPE/dz|_(z_0), where + ! A = ( dCAPE/dz|_(z_(-1)) - dCAPE/dz|_(z_0) ) / ( z_(-1) - z_0 ). + ! + ! The integral is evaluated to find the CAPE increment between two + ! successive vertical levels. The result either adds to or depletes + ! from the total amount of energy that keeps the parcel descending. + + dCAPE_dz_j = ( grav/thvm(j) ) * ( thv_par_j - thvm(j) ) + + CAPE_incr = 0.5_core_rknd * ( dCAPE_dz_j + dCAPE_dz_j_plus_1 ) / gr%invrs_dzm(j) + + if ( tke_i - CAPE_incr > 0.0_core_rknd ) then + + ! The total amount of CAPE increment has not exhausted the initial + ! TKE (plus any additions by CAPE increments due to downward + ! buoyancy) that boosted and carried the parcel downward. The + ! thickness of the full grid level is added to Lscale_down. + + Lscale_down(i) = Lscale_down(i) + gr%zt(j+1) - gr%zt(j) + + else + + ! The total amount of CAPE increment has exhausted the initial TKE + ! (plus any additions by CAPE increments due to downward buoyancy) + ! that boosted and carried the parcel downward. Add the thickness + ! z_0 - z (where z_(-1) <= z < z_0) to Lscale_down. The + ! calculation of Lscale_down is complete. + + if ( dCAPE_dz_j == dCAPE_dz_j_plus_1 ) then + + ! Special case where dCAPE/dz|_(z_(-1)) - dCAPE/dz|_(z_0) = 0, + ! thus making factor A (above) equal to 0. Find the remaining + ! distance z_0 - z that it takes to exhaust the remaining TKE + ! (tke_i). + + Lscale_down(i) & + = Lscale_down(i) & + + ( tke_i / dCAPE_dz_j ) + + else + + ! Case used for most scenarios where dCAPE/dz|_(z_(-1)) + ! /= dCAPE/dz|_(z_0), thus making factor A /= 0. Find the + ! remaining distance z_0 - z that it takes to exhaust the + ! remaining TKE (tke_i), using the quadratic formula (only the + ! negative (-) root works in this scenario -- however, the + ! negative (-) root is divided by another negative (-) factor, + ! which results in an overall plus (+) sign in front of the + ! square root term in the equation below). + + Lscale_down(i) & + = Lscale_down(i) & + + ( - dCAPE_dz_j_plus_1 / & + ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) ) & + / gr%invrs_dzm(j) & + + sqrt( dCAPE_dz_j_plus_1**2 & + + 2.0_core_rknd * tke_i * gr%invrs_dzm(j) & + * ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) ) & + / ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) & + / gr%invrs_dzm(j) + + endif + + endif + + ! Reset values for use during the next vertical level down. + + thl_par_j_plus_1 = thl_par_j + rt_par_j_plus_1 = rt_par_j + dCAPE_dz_j_plus_1 = dCAPE_dz_j + + tke_i = tke_i - CAPE_incr + j = j - 1 + + enddo + + ! Make Lscale_down nonlocal + ! + ! This code makes the value of Lscale_down nonlocal. Thus, if a parcel + ! starting from a higher altitude can descend to altitude + ! Lscale_down_min_alt, then a parcel starting from a lower altitude + ! should also be able to descend to at least altitude + ! Lscale_down_min_alt, even if the local result of Lscale_down for the + ! parcel that started at a lower altitude is not sufficient for the + ! parcel to reach altitude Lscale_down_min_alt. + ! + ! For example, if it was found that a parcel starting at an altitude of + ! 1100 m. descended to an altitude of 100 m. (an Lscale_down value of + ! 1000 m.), then a parcel starting at an altitude of 1000 m. should also + ! be able to descend to an altitude of at least 100 m. If Lscale_down + ! was found to be only 800 m. for the parcel starting at 1000 m. + ! (resulting in the parcel only being able to descend to an altitude of + ! 200 m.), then this code will overwrite the 800 m. value with a + ! Lscale_down value of 900 m. (so that the parcel reaches an altitude of + ! 100 m.). + ! + ! This feature insures that the profile of Lscale_down will be very + ! smooth, thus reducing numerical instability in the model. + + Lscale_down_min_alt = min( Lscale_down_min_alt, gr%zt(i)-Lscale_down(i) ) + + if ( (gr%zt(i)-Lscale_down(i)) > Lscale_down_min_alt ) then + Lscale_down(i) = gr%zt(i) - Lscale_down_min_alt + endif + + enddo + + + !!!!! Compute Lscale for every vertical level. + + do i = 2, gr%nz, 1 + + ! The equation for Lscale is: + ! + ! Lscale = sqrt( Lscale_up * Lscale_down ). + + ! Make lminh a linear function starting at value lmin at the bottom + ! and going to zero at 500 meters in altitude. + ! -dschanen 27 April 2007 + if( l_implemented ) then + ! Within a host model, increase mixing length in 500 m layer above *ground* + lminh = max( zero_threshold, Lscale_sfclyr_depth - (gr%zt(i) - gr%zm(1)) ) & + * ( lmin / Lscale_sfclyr_depth ) + else + ! In standalone mode, increase mixing length in 500 m layer above *mean sea level* + lminh = max( zero_threshold, Lscale_sfclyr_depth - gr%zt(i) ) & + * ( lmin / Lscale_sfclyr_depth ) + end if + + Lscale_up(i) = max( lminh, Lscale_up(i) ) + Lscale_down(i) = max( lminh, Lscale_down(i) ) + + Lscale(i) = sqrt( Lscale_up(i)*Lscale_down(i) ) + + enddo + + ! Set the value of Lscale at the upper and lower boundaries. + Lscale(1) = Lscale(2) + Lscale(gr%nz) = Lscale(gr%nz-1) + + ! Vince Larson limited Lscale to allow host + ! model to take over deep convection. 13 Feb 2008. + + !Lscale = min( Lscale, 1e5 ) + Lscale = min( Lscale, Lscale_max ) + + if( clubb_at_least_debug_level( 2 ) ) then + + ! Ensure that the output from this subroutine is valid. + call length_check( Lscale, Lscale_up, Lscale_down, err_code_Lscale ) + ! Joshua Fasching January 2008 + + ! Error Reporting + ! Joshua Fasching February 2008 + + if ( fatal_error( err_code_Lscale ) ) then + + write(fstderr,*) "Errors in length subroutine" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "thvm = ", thvm + write(fstderr,*) "thlm = ", thlm + write(fstderr,*) "rtm = ", rtm + write(fstderr,*) "em = ", em + write(fstderr,*) "exner = ", exner + write(fstderr,*) "p_in_Pa = ", p_in_Pa + write(fstderr,*) "thv_ds = ", thv_ds + + write(fstderr,*) "Intent(out)" + + write(fstderr,*) "Lscale = ", Lscale + write(fstderr,*) "Lscale_up = ", Lscale_up + + ! Overwrite the last error code with this new fatal error + err_code = err_code_Lscale + + endif ! Fatal error + + endif ! clubb_debug_level + + return + + end subroutine compute_length + +!=============================================================================== + +end module crmx_mixing_length diff --git a/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 b/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 new file mode 100644 index 0000000000..b3fdc118f7 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 @@ -0,0 +1,401 @@ +!=============================================================================== +! $Id: model_flags.F90 6148 2013-04-08 21:45:15Z storer@uwm.edu $ + +module crmx_model_flags + +! Description: +! Various model options that can be toggled off and on as desired. + +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + public :: setup_model_flags, read_model_flags_from_file, setup_configurable_model_flags, & + get_configurable_model_flags, write_model_flags_to_file + + private ! Default Scope + + logical, parameter, public :: & + l_hyper_dfsn = .false., & ! 4th-order hyper-diffusion + l_pos_def = .false., & ! Flux limiting pos. def. scheme on rtm + l_hole_fill = .true., & ! Hole filling pos. def. scheme on wp2,up2,rtp2,etc + l_clip_semi_implicit = .false., & ! Semi-implicit clipping scheme on wpthlp and wprtp + l_clip_turb_adv = .false., & ! Corrects thlm/rtm when w'th_l'/w'r_t' is clipped + l_gmres = .false., & ! Use GMRES iterative solver rather than LAPACK + l_sat_mixrat_lookup = .false. ! Use a lookup table for mixing length + ! saturation vapor pressure calculations + + logical, parameter, public :: & +#ifdef BYTESWAP_IO + l_byteswap_io = .true., & ! Don't use the native byte ordering in GrADS output +#else + l_byteswap_io = .false., & ! Use the native byte ordering in GrADS output +#endif + l_gamma_Skw = .true. ! Use a Skw dependent gamma parameter + + logical, parameter, public :: & + l_use_boussinesq = .false. ! Flag to use the Boussinesq form of the + ! predictive equations. The predictive + ! equations are anelastic by default. + + logical, parameter, public :: & + l_use_precip_frac = .false. ! Flag to use precipitation fraction in KK + ! microphysics. The precipitation fraction + ! is automatically set to 1 when this flag + ! is turned off. + + logical, parameter, public :: & + l_morr_xp2_mc_tndcy = .false. !Flag to include the effects of rain evaporation + !on rtp2 and thlp2. The moister (rt1 or rt2) + !and colder (thl1 or thl2) will be fed into + !the morrison micro, and rain evaporation will + !be allowed to increase variances + + + ! These are the integer constants that represent the various saturation + ! formulas. To add a new formula, add an additional constant here, + ! add the logic to check the strings for the new formula in clubb_core and + ! this module, and add logic in saturation to call the proper function-- + ! the control logic will be based on these named constants. + + integer, parameter, public :: & + saturation_bolton = 1, & ! Constant for Bolton approximations of saturation + saturation_gfdl = 2, & ! Constant for the GFDL approximation of saturation + saturation_flatau = 3 ! Constant for Flatau approximations of saturation + + !----------------------------------------------------------------------------- + ! Options that can be changed at runtime + ! The default values are chosen below and overwritten if desired by the user + !----------------------------------------------------------------------------- + + ! These flags determine whether we want to use an upwind differencing approximation + ! rather than a centered differencing for turbulent or mean advection terms. + ! wpxp_ta affects wprtp, wpthlp, & wpsclrp + ! xpyp_ta affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & sclrpthlp + ! xm_ma affects rtm, thlm, sclrm, um and vm. + logical, public :: & + l_upwind_wpxp_ta = .false., & + l_upwind_xpyp_ta = .true., & + l_upwind_xm_ma = .true. + +!$omp threadprivate(l_upwind_wpxp_ta, l_upwind_xpyp_ta, l_upwind_xm_ma) + + logical, public :: & + l_quintic_poly_interp = .false. ! Use a quintic polynomial in mono_cubic_interp + +!$omp threadprivate(l_quintic_poly_interp) + + + logical, public :: & + l_uv_nudge = .false., & ! For wind speed nudging. - Michael Falk + l_rtm_nudge = .false., & ! For rtm nudging + l_tke_aniso = .true. ! For anisotropic turbulent kinetic energy, + ! i.e. TKE = 1/2 (u'^2 + v'^2 + w'^2) +! OpenMP directives. +!$omp threadprivate(l_uv_nudge, l_tke_aniso, l_rtm_nudge) + + ! Use 2 calls to pdf_closure and the trapezoidal rule to compute the + ! varibles that are output from high order closure + logical, private :: & + l_vert_avg_closure = .true. +!$omp threadprivate(l_vert_avg_closure) + + ! These are currently set based on l_vert_avg_closure + logical, public :: & + l_trapezoidal_rule_zt = .true., & ! If true, the trapezoidal rule is called for + ! the thermodynamic-level variables output + ! from pdf_closure. + l_trapezoidal_rule_zm = .true., & ! If true, the trapezoidal rule is called for + ! three momentum-level variables - wpthvp, + ! thlpthvp, and rtpthvp - output from pdf_closure. + l_call_pdf_closure_twice = .true., & ! This logical flag determines whether or not to + ! call subroutine pdf_closure twice. If true, + ! pdf_closure is called first on thermodynamic levels + ! and then on momentum levels so that each variable is + ! computed on its native level. If false, pdf_closure + ! is only called on thermodynamic levels, and variables + ! which belong on momentum levels are interpolated. + l_single_C2_Skw = .false. ! Use a single Skewness dependent C2 for rtp2, thlp2, and rtpthlp + +!$omp threadprivate(l_trapezoidal_rule_zt, l_trapezoidal_rule_zm, & +!$omp l_call_pdf_closure_twice, l_single_C2_Skw) + + logical, public :: & + l_standard_term_ta = .false. ! Use the standard discretization for the + ! turbulent advection terms. Setting to + ! .false. means that a_1 and a_3 are pulled + ! outside of the derivative in advance_wp2_wp3_module.F90 + ! and in advance_xp2_xpyp_module.F90. +!$omp threadprivate(l_standard_term_ta) + + ! Use to determine whether a host model has already applied the surface flux, + ! to avoid double counting. + logical, public :: & + l_host_applies_sfc_fluxes = .false. + +!$omp threadprivate(l_host_applies_sfc_fluxes) + + ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help increase cloudiness + ! at coarser grid resolutions. + logical, public :: & + l_use_cloud_cover = .true. +!$omp threadprivate(l_use_cloud_cover) + + integer, public :: & + saturation_formula = saturation_flatau ! Integer that stores the saturation formula to be used + +!$omp threadprivate(saturation_formula) + + ! See clubb:ticket:514 for details + logical, public :: & + l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + l_calc_w_corr ! Calculate the correlations between w and the hydrometeors + +!$omp threadprivate(l_diagnose_correlations, l_calc_w_corr) + +#ifdef GFDL + logical, public :: & + I_sat_sphum ! h1g, 2010-06-15 +#endif + + namelist /configurable_model_flags/ & + l_upwind_wpxp_ta, l_upwind_xpyp_ta, l_upwind_xm_ma, l_quintic_poly_interp, & + l_tke_aniso, l_vert_avg_closure, l_single_C2_Skw, l_standard_term_ta, & + l_use_cloud_cover + + contains + +!=============================================================================== + subroutine setup_model_flags & + ( l_host_applies_sfc_fluxes_in, & + l_uv_nudge_in, saturation_formula_in & +#ifdef GFDL + , I_sat_sphum_in & ! h1g, 2010-06-15 +#endif + ) + +! Description: +! Setup flags that influence the numerics, etc. of CLUBB core + +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + implicit none + + ! External + intrinsic :: trim + + ! Input Variables + logical, intent(in) :: & + l_host_applies_sfc_fluxes_in, & + l_uv_nudge_in + + character(len=*), intent(in) :: & + saturation_formula_in + +#ifdef GFDL + logical, intent(in) :: & + I_sat_sphum_in ! h1g, 2010-06-15 +#endif + + !---- Begin Code ---- + + ! Logicals + + l_uv_nudge = l_uv_nudge_in + + l_host_applies_sfc_fluxes = l_host_applies_sfc_fluxes_in + + ! Integers + + ! Set up the saturation formula value + select case ( trim( saturation_formula_in ) ) + case ( "bolton", "Bolton" ) + saturation_formula = saturation_bolton + + case ( "flatau", "Flatau" ) + saturation_formula = saturation_flatau + + case ( "gfdl", "GFDL" ) + saturation_formula = saturation_gfdl + + ! Add new saturation formulas after this. + end select + +#ifdef GFDL + I_sat_sphum = I_sat_sphum_in ! h1g, 2010-06-15 +#endif + return + end subroutine setup_model_flags + +!=============================================================================== + subroutine read_model_flags_from_file( iunit, filename ) + +! Description: +! Read in some of the model flags of interest from a namelist file. If the +! variable isn't in the file it will just be the default value. +! +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: & + iunit ! File I/O unit to use + + character(len=*), intent(in) :: & + filename ! Name of the file with the namelist + + ! Read the namelist + open(unit=iunit, file=filename, status='old', action='read') + + read(unit=iunit, nml=configurable_model_flags) + + close(unit=iunit) + + if ( l_vert_avg_closure ) then + l_trapezoidal_rule_zt = .true. + l_trapezoidal_rule_zm = .true. + l_call_pdf_closure_twice = .true. + else + l_trapezoidal_rule_zt = .false. + l_trapezoidal_rule_zm = .false. + l_call_pdf_closure_twice = .false. + end if + + return + end subroutine read_model_flags_from_file + +!=============================================================================== + subroutine write_model_flags_to_file( iunit, filename ) + +! Description: +! Write a new namelist for the configurable model flags +! +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: & + iunit ! File I/O unit to use + + character(len=*), intent(in) :: & + filename ! Name of the file with the namelist + + ! Read the namelist + open(unit=iunit, file=filename, status='unknown', action='write') + + write(unit=iunit, nml=configurable_model_flags) + + close(unit=iunit) + + return + end subroutine write_model_flags_to_file +!=============================================================================== + subroutine setup_configurable_model_flags & + ( l_upwind_wpxp_ta_in, l_upwind_xpyp_ta_in, & + l_upwind_xm_ma_in, l_quintic_poly_interp_in, & + l_vert_avg_closure_in, & + l_single_C2_Skw_in, l_standard_term_ta_in, & + l_tke_aniso_in, l_use_cloud_cover_in ) + +! Description: +! Set a model flag based on the input arguments for the purposes of trying +! all possible combinations in the clubb_tuner. +! +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + ! Input Variables + logical, intent(in) :: & + l_upwind_wpxp_ta_in, & ! Model flags + l_upwind_xpyp_ta_in, & + l_upwind_xm_ma_in, & + l_quintic_poly_interp_in, & + l_vert_avg_closure_in, & + l_single_C2_Skw_in, & + l_standard_term_ta_in, & + l_tke_aniso_in, & + l_use_cloud_cover_in + + ! ---- Begin Code ---- + + l_upwind_wpxp_ta = l_upwind_wpxp_ta_in + l_upwind_xpyp_ta = l_upwind_xpyp_ta_in + l_upwind_xm_ma = l_upwind_xm_ma_in + l_quintic_poly_interp = l_quintic_poly_interp_in + l_vert_avg_closure = l_vert_avg_closure_in + l_single_C2_Skw = l_single_C2_Skw_in + l_standard_term_ta = l_standard_term_ta_in + l_tke_aniso = l_tke_aniso_in + l_use_cloud_cover = l_use_cloud_cover_in + + if ( l_vert_avg_closure ) then + l_trapezoidal_rule_zt = .true. + l_trapezoidal_rule_zm = .true. + l_call_pdf_closure_twice = .true. + else + l_trapezoidal_rule_zt = .false. + l_trapezoidal_rule_zm = .false. + l_call_pdf_closure_twice = .false. + end if + + return + end subroutine setup_configurable_model_flags + +!=============================================================================== + subroutine get_configurable_model_flags & + ( l_upwind_wpxp_ta_out, l_upwind_xpyp_ta_out, & + l_upwind_xm_ma_out, l_quintic_poly_interp_out, & + l_vert_avg_closure_out, & + l_single_C2_Skw_out, l_standard_term_ta_out, & + l_tke_aniso_out, l_use_cloud_cover_out ) + +! Description: +! Get the current model flags. +! +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + ! Input Variables + logical, intent(out) :: & + l_upwind_wpxp_ta_out, & ! Model flags + l_upwind_xpyp_ta_out, & + l_upwind_xm_ma_out, & + l_quintic_poly_interp_out, & + l_vert_avg_closure_out, & + l_single_C2_Skw_out, & + l_standard_term_ta_out, & + l_tke_aniso_out, & + l_use_cloud_cover_out + + ! ---- Begin Code ---- + + l_upwind_wpxp_ta_out = l_upwind_wpxp_ta + l_upwind_xpyp_ta_out = l_upwind_xpyp_ta + l_upwind_xm_ma_out = l_upwind_xm_ma + l_quintic_poly_interp_out = l_quintic_poly_interp + l_vert_avg_closure_out = l_vert_avg_closure + l_single_C2_Skw_out = l_single_C2_Skw + l_standard_term_ta_out = l_standard_term_ta + l_tke_aniso_out = l_tke_aniso + l_use_cloud_cover_out = l_use_cloud_cover + + return + end subroutine get_configurable_model_flags + +end module crmx_model_flags diff --git a/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 b/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 new file mode 100644 index 0000000000..6ce1f60ece --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 @@ -0,0 +1,1838 @@ +!----------------------------------------------------------------------- +! $Id: mono_flux_limiter.F90 5715 2012-02-14 00:36:17Z dschanen@uwm.edu $ +!=============================================================================== +module crmx_mono_flux_limiter + + implicit none + + private ! Default Scope + + public :: monotonic_turbulent_flux_limit, & + calc_turb_adv_range + + private :: mfl_xm_lhs, & + mfl_xm_rhs, & + mfl_xm_solve, & + mean_vert_vel_up_down + + ! Private named constants to avoid string comparisons + ! NOTE: These values must match the values for xm_wpxp_thlm + ! and xm_wpxp_rtm given in advance_xm_wpxp_module! + integer, parameter, private :: & + mono_flux_thlm = 1, & ! Named constant for thlm mono_flux calls + mono_flux_rtm = 2 ! Named constant for rtm mono_flux calls + + contains + + !============================================================================= + subroutine monotonic_turbulent_flux_limit( solve_type, dt, xm_old, & + xp2, wm_zt, xm_forcing, & + rho_ds_zm, rho_ds_zt, & + invrs_rho_ds_zm, invrs_rho_ds_zt, & + xp2_threshold, l_implemented, & + low_lev_effect, high_lev_effect, & + xm, xm_tol, wpxp, err_code ) + + ! Description: + ! Limits the value of w'x' and corrects the value of xm when the xm turbulent + ! advection term is not monotonic. A monotonic turbulent advection scheme + ! will not create new extrema for variable x, based only on turbulent + ! advection (not considering mean advection and xm forcings). + ! + ! Montonic turbulent advection + ! ---------------------------- + ! + ! A monotonic turbulent advection scheme does not allow new extrema for + ! variable x to be created (by means of turbulent advection). In a + ! monotonic turbulent advection scheme, when only the effects of turbulent + ! advection are considered (neglecting forcings and mean advection), the + ! value of variable x at a given point should not increase above the + ! greatest value of variable x at nearby points, nor decrease below the + ! smallest value of variable x at nearby points. Nearby points are points + ! that are close enough to the given point so that the value of variable x + ! at the given point is effected by the values of variable x at the nearby + ! points by means of transfer by turbulent winds during a time step. Again, + ! a monotonic scheme insures that advection only transfers around values of + ! variable x and does not create new extrema for variable x. A monotonic + ! turbulent advection scheme is useful because the turbulent advection term + ! (w'x') may go numerically unstable, resulting in large instabilities in + ! the mean field (xm). A monotonic turbulent advection scheme will limit + ! the change in xm, and also in w'x'. + ! + ! The following example illustrates the concept of monotonic turbulent + ! advection. Three successive vertical grid levels are shown (k-1, k, and + ! k+1). Three point values of theta-l are listed at every vertical grid + ! level. All three vertical levels have a mean theta-l (thlm) of 288.0 K. + ! A circulation is occuring (in the direction of the arrows) in the vertical + ! (w wind component) and in the horizontal (u and/or v wind components), + ! such that the mean value of vertical velocity (wmm) is 0, but there is a + ! turbulent component such that w'^2 > 0. + ! + ! level = k+1 || --- 287.0 K --- 288.0 K --- 289.0 K --- || thlm = 288.0 + ! || / \--------------------->| || + ! || | | || wmm = 0; wp2 > 0 + ! || |<---------------------\ / || + ! level = k || --- 288.0 K --- 288.0 K --- 288.0 K --- || thlm = 288.0 + ! || |<---------------------/ \ || + ! || | | || wmm = 0; wp2 > 0 + ! || \ /--------------------->| || + ! level = k-1 || --- 287.5 K --- 288.0 K --- 288.5 K --- || thlm = 288.0 + ! + ! Neglecting any contributions from thlm forcings (effects of radiation, + ! microphysics, large-scale horizontal advection, etc.), the values of + ! theta-l as shown will be altered by only turbulent advection. As a side + ! note, the contribution of mean advection will be 0 since wmm = 0. The + ! diagram shows that the value of theta-l at the point on the right at level + ! k will increase. However, the values of theta-l at the other two points + ! at level k will remain the same. Thus, the value of thlm at level k will + ! become greater than 288.0 K. In the same manner, the values of thlm at + ! the other two vertical levels (k-1 and k+1) will become smaller than + ! 288.0 K. However, the monotonic turbulent advection scheme insures that + ! any theta-l point value cannot become smaller than the smallest theta-l + ! point value (287.0 K) or larger than the largest theta-l point value + ! (289.0 K). Since all theta-l point values must fall between 287.0 K and + ! 289.0 K, the level averages of theta-l (thlm) must fall between 287.0 K + ! and 289.0 K. Thus, any values of the turbulent flux, w'th_l', that would + ! cause thlm to rise above 289.0 K or fall below 287.0 K, not considering + ! the effect of other terms on thlm (such as forcings), are faulty and need + ! to be limited appropriately. The values of thlm also need to be corrected + ! appropriately. + ! + ! Formula for the limitation of w'x' and xm + ! ----------------------------------------- + ! + ! The equation for change in the mean field, xm, over time is: + ! + ! d(xm)/dt = -w*d(xm)/dz - (1/rho_ds) * d( rho_ds * w'x' )/dz + xm_forcing; + ! + ! where w*d(xm)/dz is the mean advection component, + ! (1/rho_ds) * d( rho_ds * w'x' )/dz is the turbulent advection component, + ! and xm_forcing is the xm forcing component. The d(xm)/dt time tendency + ! component is discretized as: + ! + ! xm(k,)/dt = xm(k,)/dt - w*d(xm)/dz + ! - (1/rho_ds) * d( rho_ds * w'x' )/dz + xm_forcing. + ! + ! The value of xm after it has been advanced to timestep (t+1) must be in an + ! appropriate range based on the values of xm at timestep (t), the amount of + ! xm forcings applied over the ensuing time step, and the amount of mean + ! advection applied over the ensuing time step. This is exactly the same + ! thing as saying that the value of xm(k,), with the contribution of + ! turbulent advection included, must fall into a certain range based on the + ! value of xm(k,) without the contribution of the turbulent advection + ! component over the last time step. The following inequality is used to + ! limit the value of xm(k,): + ! + ! MIN{ xm(k-1,) + dt*xm_forcing(k-1) - dt*wm_zt(k-1)*d(xm)/dz|_(k-1) + ! - x_max_dev_low(k-1,), + ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - x_max_dev_low(k,), + ! xm(k+1,) + dt*xm_forcing(k+1) - dt*wm_zt(k+1)*d(xm)/dz|_(k+1) + ! - x_max_dev_low(k+1,) } + ! <= xm(k,) <= + ! MAX{ xm(k-1,) + dt*xm_forcing(k-1) - dt*wm_zt(k-1)*d(xm)/dz|_(k-1) + ! + x_max_dev_high(k-1,), + ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! + x_max_dev_high(k,), + ! xm(k+1,) + dt*xm_forcing(k+1) - dt*wm_zt(k+1)*d(xm)/dz|_(k+1) + ! + x_max_dev_high(k+1,) }; + ! + ! where x_max_dev_low is the absolute value of the deviation from the mean + ! of the smallest point value of variable x at the given vertical level and + ! timestep; and where x_max_dev_high is the deviation from the mean of the + ! largest point value of variable x at the given vertical level and + ! timestep. For example, at vertical level (k+1) and timestep (t): + ! + ! x_max_dev_low(k+1,) = | MIN( x(k+1,) ) - xm(k+1,) |; + ! x_max_dev_high(k+1,) = MAX( x(k+1,) ) - xm(k+1,). + ! + ! The inequality shown above only takes into account values from the central + ! level, one-level-below the central level, and one-level-above the central + ! level. This is the minimal amount of vertical levels that can have their + ! values taken into consideration. Any vertical level that can have it's + ! properties advect to the given level during the course of a single time + ! step can be taken into consideration. However, only three levels will be + ! considered in this example for the sake of simplicity. + ! + ! The inequality will be written in more simple terms: + ! + ! xm_lower_lim_allowable(k) <= xm(k,) <= xm_upper_lim_allowable(k). + ! + ! The inequality can now be related to the turbulent flux, w'x'(k,), + ! through a substitution that is made for xm(k,), such that: + ! + ! xm(k,) = xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - dt * (1/rho_ds) * d( rho_ds * w'x' )/dz|_(k). + ! + ! The inequality becomes: + ! + ! xm_lower_lim_allowable(k) + ! <= + ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - dt * (1/rho_ds) * d( rho_ds * w'x' )/dz|_(k) + ! <= + ! xm_upper_lim_allowable(k). + ! + ! The inequality is rearranged, and the turbulent advection term, + ! d(w'x')/dz, is discretized: + ! + ! xm_lower_lim_allowable(k) + ! - [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) ] + ! <= + ! - dt * (1/rho_ds_zt(k)) + ! * invrs_dzt(k) + ! * [ rho_ds_zm(k) * w'x'(k,) + ! - rho_ds_zm(k-1) * w'x'(k-1,) ] + ! <= + ! xm_upper_lim_allowable(k) + ! - [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) ]; + ! + ! where invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ). + ! + ! Multiplying the inequality by -rho_ds_zt(k)/(dz*invrs_dzt(k)): + ! + ! rho_ds_zt(k)/(dz*invrs_dzt(k)) + ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_lower_lim_allowable(k) ] + ! >= + ! rho_ds_zm(k) * w'x'(k,) - rho_ds_zm(k-1) * w'x'(k-1,) + ! >= + ! rho_ds_zt(k)/(dz*invrs_dzt(k)) + ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_upper_lim_allowable(k) ]. + ! + ! Note: The inequality symbols have been flipped due to multiplication + ! involving a (-) sign. + ! + ! Adding rho_ds_zm(k-1) * w'x'(k-1,) to the inequality: + ! + ! rho_ds_zt(k)/(dz*invrs_dzt(k)) + ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_lower_lim_allowable(k) ] + ! + rho_ds_zm(k-1) * w'x'(k-1,) + ! >= rho_ds_zm(k) * w'x'(k,) >= + ! rho_ds_zt(k)/(dz*invrs_dzt(k)) + ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_upper_lim_allowable(k) ] + ! + rho_ds_zm(k-1) * w'x'(k-1,). + ! + ! The inequality is then rearranged to be based around w'x'(k,): + ! + ! (1/rho_ds_zm(k)) + ! * [ rho_ds_zt(k)/(dt*invrs_dzt(k)) + ! * { xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_lower_lim_allowable(k) } + ! + rho_ds_zm(k-1) * w'x'(k-1,) ] + ! >= w'x'(k,) >= + ! (1/rho_ds_zm(k)) + ! * [ rho_ds_zt(k)/(dt*invrs_dzt(k)) + ! * { xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) + ! - xm_upper_lim_allowable(k) } + ! + rho_ds_zm(k-1) * w'x'(k-1,) ]. + ! + ! The values of w'x' are found on the momentum levels, while the values of + ! xm are found on the thermodynamic levels. Additionally, the values of + ! rho_ds_zm are found on the momentum levels, and the values of rho_ds_zt + ! are found on the thermodynamic levels. The inequality is applied to + ! w'x'(k,) from vertical levels 2 through the second-highest level + ! (gr%nz-1). The value of w'x' at level 1 is a set surface (or lowest + ! level) flux. The value of w'x' at the highest level is also a set value, + ! and therefore is not altered. + ! + ! Approximating maximum and minimum values of x at any given vertical level + ! ------------------------------------------------------------------------- + ! + ! The CLUBB code provides means, variances, and covariances for certain + ! variables at all vertical levels. However, there is no way to find the + ! maximum or minimum point value of any variable on any vertical level. + ! Without that information, x_max_dev_low and x_max_dev_high can't be found, + ! and the inequality above is useless. However, there is a way to + ! approximate the maximum and minimum point values at any given vertical + ! level. The maximum and minimum point values can be approximated through + ! the use of the variance, x'^2. + ! + ! Just as the mean value of x, which is xm, and the turbulent flux of x, + ! which is w'x', are known, so is the variance of x, which is x'^2. The + ! standard deviation of x is the square root of the variance of x. The + ! distribution of x along the horizontal plane (at vertical level k) is + ! approximated to be the sum of two normal (or Gaussian) distributions. + ! Most of the values in a normal distribution are found within 2 standard + ! deviations from the mean. Thus, the maximum point value of x along the + ! horizontal plance at any vertical level can be approximated as: + ! xm + 2*sqrt(x'^2). Likewise, the minimum value of x along the horizontal + ! plane at any vertical level can be approximated as: xm - 2*sqrt(x'^2). + ! + ! The values of x'^2 are found on the momentum levels. The values of xm + ! are found on the thermodynamic levels. Thus, the values of x'^2 are + ! interpolated to the thermodynamic levels in order to find the maximum + ! and minimum point values of variable x. + ! + ! The one downfall of this method is that instabilities can arise in the + ! model where unphysically large values of x'^2 are produced. Thus, this + ! allows for an unphysically large deviation of xm from its values at the + ! previous time step due to turbulent advection. Thus, for purposes of + ! determining the maximum and minimum point values of x, a upper limit + ! is placed on x'^2, in order to limit the standard deviation of x. This + ! limit is only applied in this subroutine, and is not applied to x'^2 + ! elsewhere in the model code. + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zm2zt ! Procedure(s) + + use crmx_constants_clubb, only: & + zero_threshold, & + eps, & + fstderr + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_error_code, only: & + fatal_error, & ! Procedure(s) + clubb_no_error ! Constant + + use crmx_fill_holes, only: & + vertical_integral ! Procedure(s) + + use crmx_stats_type, only: & + stat_begin_update, & ! Procedure(s) + stat_end_update, & + stat_update_var + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + zt, & + iwprtp_mfl, & + irtm_mfl, & + iwpthlp_mfl, & + ithlm_mfl, & + ithlm_old, & + ithlm_without_ta, & + ithlm_mfl_min, & + ithlm_mfl_max, & + irtm_old, & + irtm_without_ta, & + irtm_mfl_min, & + irtm_mfl_max, & + ithlm_enter_mfl, & + ithlm_exit_mfl, & + irtm_enter_mfl, & + irtm_exit_mfl, & + iwpthlp_mfl_min, & + iwpthlp_mfl_max, & + iwpthlp_entermfl, & + iwpthlp_exit_mfl, & + iwprtp_mfl_min, & + iwprtp_mfl_max, & + iwprtp_enter_mfl, & + iwprtp_exit_mfl, & + l_stats_samp + + implicit none + + ! Constant Parameters + + ! Flag for using a semi-implicit, tridiagonal method to solve for xm(t+1) + ! when xm(t+1) needs to be changed. + logical, parameter :: l_mfl_xm_imp_adj = .true. + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variables being solved for. + + real(kind=time_precision), intent(in) :: & + dt ! Model timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm_old, & ! xm at previous time step (thermo. levs.) [units vary] + xp2, & ! x'^2 (momentum levels) [units vary] + wm_zt, & ! w wind component on thermodynamic levels [m/s] + xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + real( kind = core_rknd ), intent(in) :: & + xp2_threshold, & ! Lower limit of x'^2 [units vary] + xm_tol ! Lower limit of maxdev [units vary] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + integer, dimension(gr%nz), intent(in) :: & + low_lev_effect, & ! Index of lowest level that has an effect (for lev. k) + high_lev_effect ! Index of highest level that has an effect (for lev. k) + + ! Input/Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + xm, & ! xm at current time step (thermodynamic levels) [units vary] + wpxp ! w'x' (momentum levels) [units vary] + + ! Output Variable + integer, intent(out) :: & + err_code ! Returns an error code in the event of a singular matrix + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + xp2_zt, & ! x'^2 interpolated to thermodynamic levels [units vary] + xm_enter_mfl, & ! xm as it enters the MFL [units vary] + xm_without_ta, & ! Value of xm without turb. adv. contrib. [units vary] + wpxp_net_adjust, & ! Net amount of adjustment needed on w'x' [units vary] + dxm_dt_mfl_adjust ! Rate of change of adjustment to xm [units vary] + + real( kind = core_rknd ), dimension(gr%nz) :: & + min_x_allowable_lev, & ! Smallest usuable value of x at lev k [units vary] + max_x_allowable_lev, & ! Largest usuable value of x at lev k [units vary] + min_x_allowable, & ! Smallest usuable x within k +/- num_levs [units vary] + max_x_allowable, & ! Largest usuable x within k +/- num_levs [units vary] + wpxp_mfl_max, & ! Upper limit on w'x'(k) [units vary] + wpxp_mfl_min ! Lower limit on w'x'(k) [units vary] + + real( kind = core_rknd ) :: & + max_xp2, & ! Maximum allowable x'^2 [units vary] + stnd_dev_x, & ! Standard deviation of x [units vary] + max_dev, & ! Determines approximate upper/lower limit of x [units vary] + m_adv_term, & ! Contribution of mean advection to d(xm)/dt [units vary] + xm_density_weighted, & ! Density weighted xm at domain top [units vary] + xm_adj_coef, & ! Coeffecient to eliminate spikes at domain top [units vary] + xm_vert_integral, & ! Vertical integral of xm [units_vary] + dz ! zm grid spacing at top of domain [m] + + real( kind = core_rknd ), dimension(3,gr%nz) :: & + lhs_mfl_xm ! Left hand side of tridiagonal matrix + + real( kind = core_rknd ), dimension(gr%nz) :: & + rhs_mfl_xm ! Right hand side of tridiagonal matrix equation + + integer :: & + k, km1 ! Array indices + +! integer, parameter :: & +! num_levs = 10 ! Number of levels above and below level k to look for +! ! maxima and minima of variable x. + + integer :: & + low_lev, & ! Lowest level (from level k) to look for x minima and maxima + high_lev ! Highest level (from level k) to look for x minima and maxima + + integer :: & + iwpxp_mfl, & + ixm_mfl + + !--- Begin Code --- + err_code = clubb_no_error ! Initialize to the value for no errors + + ! Default Initialization required due to G95 compiler warning + max_xp2 = 0.0_core_rknd + dz = 0.0_core_rknd + + select case( solve_type ) + case ( mono_flux_rtm ) ! rtm/wprtp + iwpxp_mfl = iwprtp_mfl + ixm_mfl = irtm_mfl + max_xp2 = 5.0e-6_core_rknd + case ( mono_flux_thlm ) ! thlm/wpthlp + iwpxp_mfl = iwpthlp_mfl + ixm_mfl = ithlm_mfl + max_xp2 = 5.0_core_rknd + case default ! passive scalars are involved + iwpxp_mfl = 0 + ixm_mfl = 0 + max_xp2 = 5.0_core_rknd + end select + + + if ( l_stats_samp ) then + call stat_begin_update( iwpxp_mfl, wpxp / real( dt, kind = core_rknd ), zm ) + call stat_begin_update( ixm_mfl, xm / real( dt, kind = core_rknd ), zt ) + endif + if ( l_stats_samp .and. solve_type == mono_flux_thlm ) then + call stat_update_var( ithlm_enter_mfl, xm, zt ) + call stat_update_var( ithlm_old, xm_old, zt ) + call stat_update_var( iwpthlp_entermfl, xm, zm ) + elseif ( l_stats_samp .and. solve_type == mono_flux_rtm ) then + call stat_update_var( irtm_enter_mfl, xm, zt ) + call stat_update_var( irtm_old, xm_old, zt ) + call stat_update_var( iwprtp_enter_mfl, xm, zm ) + endif + + ! Initialize arrays. + wpxp_net_adjust = 0.0_core_rknd + dxm_dt_mfl_adjust = 0.0_core_rknd + + ! Store the value of xm as it enters the mfl + xm_enter_mfl = xm + + ! Interpolate x'^2 to thermodynamic levels. + xp2_zt = max( zm2zt( xp2 ), xp2_threshold ) + + ! Place an upper limit on xp2_zt. + ! For purposes of this subroutine, an upper limit has been placed on the + ! variance, x'^2. This does not effect the value of x'^2 anywhere else in + ! the model code. The upper limit is a reasonable upper limit. This is + ! done to prevent unphysically large standard deviations caused by numerical + ! instabilities in the x'^2 profile. + xp2_zt = min( xp2_zt, max_xp2 ) + + ! Find the maximum and minimum usuable values of variable x at each + ! vertical level. Start from level 2, which is the first level above + ! the ground (or above the model surface). This computation needs to be + ! performed for all vertical levels above the ground (or model surface). + do k = 2, gr%nz, 1 + + km1 = max( k-1, 1 ) + !kp1 = min( k+1, gr%nz ) + + ! Standard deviation is the square root of the variance. + stnd_dev_x = sqrt( xp2_zt(k) ) + + ! Most values are found within +/- 2 standard deviations from the mean. + ! Use +/- 2 standard deviations from the mean as the maximum/minimum + ! values. + ! max_dev = 2.0_core_rknd*stnd_dev_x + + ! Set a minimum on max_dev + max_dev = max(2.0_core_rknd * stnd_dev_x, xm_tol) + + ! Calculate the contribution of the mean advection term: + ! m_adv_term = -wm_zt(k)*d(xm)/dz|_(k). + ! Note: mean advection is not applied to xm at level gr%nz. + !if ( .not. l_implemented .and. k < gr%nz ) then + ! tmp(1:3) = term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k ) + ! m_adv_term = - tmp(1) * xm(kp1) & + ! - tmp(2) * xm(k) & + ! - tmp(3) * xm(km1) + !else + ! m_adv_term = 0.0_core_rknd + !endif + + ! Shut off to avoid using new, possibly corrupt mean advection term + m_adv_term = 0.0_core_rknd + + ! Find the value of xm without the contribution from the turbulent + ! advection term. + ! Note: the contribution of xm_forcing at level gr%nz should be 0. + xm_without_ta(k) = xm_old(k) + real( dt, kind = core_rknd )*xm_forcing(k) & + + real( dt, kind = core_rknd )*m_adv_term + + ! Find the minimum usuable value of variable x at each vertical level. + ! Since variable x must be one of theta_l, r_t, or a scalar, all of + ! which are positive definite quantities, the value must be >= 0. + min_x_allowable_lev(k) & + = max( xm_without_ta(k) - max_dev, zero_threshold ) + + ! Find the maximum usuable value of variable x at each vertical level. + max_x_allowable_lev(k) = xm_without_ta(k) + max_dev + + enddo + + ! Boundary condition on xm_without_ta + k = 1 + xm_without_ta(k) = xm(k) + min_x_allowable_lev(k) = min_x_allowable_lev(k+1) + max_x_allowable_lev(k) = max_x_allowable_lev(k+1) + + ! Find the maximum and minimum usuable values of x that can effect the value + ! of x at level k. Then, find the upper and lower limits of w'x'. Reset + ! the value of w'x' if it is outside of those limits, and store the amount + ! of adjustment that was needed to w'x'. + ! The values of w'x' at level 1 and at level gr%nz are set values and + ! are not altered. + do k = 2, gr%nz-1, 1 + + km1 = max( k-1, 1 ) + + low_lev = max( low_lev_effect(k), 2 ) + high_lev = min( high_lev_effect(k), gr%nz ) + !low_lev = max( k-num_levs, 2 ) + !high_lev = min( k+num_levs, gr%nz ) + + ! Find the smallest value of all relevant level minima for variable x. + min_x_allowable(k) = minval( min_x_allowable_lev(low_lev:high_lev) ) + + ! Find the largest value of all relevant level maxima for variable x. + max_x_allowable(k) = maxval( max_x_allowable_lev(low_lev:high_lev) ) + + ! Find the upper limit for w'x' for a monotonic turbulent flux. + wpxp_mfl_max(k) & + = invrs_rho_ds_zm(k) & + * ( ( rho_ds_zt(k) / (real( dt, kind = core_rknd )*gr%invrs_dzt(k)) ) & + * ( xm_without_ta(k) - min_x_allowable(k) ) & + + rho_ds_zm(km1) * wpxp(km1) ) + + ! Find the lower limit for w'x' for a monotonic turbulent flux. + wpxp_mfl_min(k) & + = invrs_rho_ds_zm(k) & + * ( ( rho_ds_zt(k) / (real( dt, kind = core_rknd )*gr%invrs_dzt(k)) ) & + * ( xm_without_ta(k) - max_x_allowable(k) ) & + + rho_ds_zm(km1) * wpxp(km1) ) + + if ( wpxp(k) > wpxp_mfl_max(k) ) then + + ! This block of print statements can be uncommented for debugging. + !print *, "k = ", k + !print *, "wpxp too large (mfl)" + !print *, "xm(t) = ", xm_old(k) + !print *, "xm(t+1) entering mfl = ", xm(k) + !print *, "xm(t+1) without ta = ", xm_without_ta(k) + !print *, "max x allowable = ", max_x_allowable(k) + !print *, "min x allowable = ", min_x_allowable(k) + !print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) + !print *, "rho_ds_zt(k) = ", rho_ds_zt(k) + !print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & + ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) + !print *, "xm without ta - min x allow = ", & + ! xm_without_ta(k) - min_x_allowable(k) + !print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) + !print *, "wpxp(km1) = ", wpxp(km1) + !print *, "rho_ds_zm(km1) * wpxp(km1) = ", rho_ds_zm(km1) * wpxp(km1) + !print *, "wpxp upper lim = ", wpxp_mfl_max(k) + !print *, "wpxp before adjustment = ", wpxp(k) + + ! Determine the net amount of adjustment needed for w'x'. + wpxp_net_adjust(k) = wpxp_mfl_max(k) - wpxp(k) + + ! Reset the value of w'x' to the upper limit allowed by the + ! monotonic flux limiter. + wpxp(k) = wpxp_mfl_max(k) + + elseif ( wpxp(k) < wpxp_mfl_min(k) ) then + + ! This block of print statements can be uncommented for debugging. + !print *, "k = ", k + !print *, "wpxp too small (mfl)" + !print *, "xm(t) = ", xm_old(k) + !print *, "xm(t+1) entering mfl = ", xm(k) + !print *, "xm(t+1) without ta = ", xm_without_ta(k) + !print *, "max x allowable = ", max_x_allowable(k) + !print *, "min x allowable = ", min_x_allowable(k) + !print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) + !print *, "rho_ds_zt(k) = ", rho_ds_zt(k) + !print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & + ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) + !print *, "xm without ta - max x allow = ", & + ! xm_without_ta(k) - max_x_allowable(k) + !print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) + !print *, "wpxp(km1) = ", wpxp(km1) + !print *, "rho_ds_zm(km1) * wpxp(km1) = ", rho_ds_zm(km1) * wpxp(km1) + !print *, "wpxp lower lim = ", wpxp_mfl_min(k) + !print *, "wpxp before adjustment = ", wpxp(k) + + ! Determine the net amount of adjustment needed for w'x'. + wpxp_net_adjust(k) = wpxp_mfl_min(k) - wpxp(k) + + ! Reset the value of w'x' to the lower limit allowed by the + ! monotonic flux limiter. + wpxp(k) = wpxp_mfl_min(k) + + ! This block of code can be uncommented for debugging. + !else + ! + ! ! wpxp(k) is okay. + ! if ( wpxp_net_adjust(km1) /= 0.0_core_rknd ) then + ! print *, "k = ", k + ! print *, "wpxp is in an acceptable range (mfl)" + ! print *, "xm(t) = ", xm_old(k) + ! print *, "xm(t+1) entering mfl = ", xm(k) + ! print *, "xm(t+1) without ta = ", xm_without_ta(k) + ! print *, "max x allowable = ", max_x_allowable(k) + ! print *, "min x allowable = ", min_x_allowable(k) + ! print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) + ! print *, "rho_ds_zt(k) = ", rho_ds_zt(k) + ! print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & + ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) + ! print *, "xm without ta - min x allow = ", & + ! xm_without_ta(k) - min_x_allowable(k) + ! print *, "xm without ta - max x allow = ", & + ! xm_without_ta(k) - max_x_allowable(k) + ! print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) + ! print *, "wpxp(km1) = ", wpxp(km1) + ! print *, "rho_ds_zm(km1) * wpxp(km1) = ", & + ! rho_ds_zm(km1) * wpxp(km1) + ! print *, "wpxp upper lim = ", wpxp_mfl_max(k) + ! print *, "wpxp lower lim = ", wpxp_mfl_min(k) + ! print *, "wpxp (stays the same) = ", wpxp(k) + ! endif + ! + endif + + enddo + + ! Boundary conditions + min_x_allowable(1) = 0._core_rknd + max_x_allowable(1) = 0._core_rknd + + min_x_allowable(gr%nz) = 0._core_rknd + max_x_allowable(gr%nz) = 0._core_rknd + + wpxp_mfl_min(1) = 0._core_rknd + wpxp_mfl_max(1) = 0._core_rknd + + wpxp_mfl_min(gr%nz) = 0._core_rknd + wpxp_mfl_max(gr%nz) = 0._core_rknd + + if ( l_stats_samp .and. solve_type == mono_flux_thlm ) then + call stat_update_var( ithlm_without_ta, xm_without_ta, zt ) + call stat_update_var( ithlm_mfl_min, min_x_allowable, zt ) + call stat_update_var( ithlm_mfl_max, max_x_allowable, zt ) + call stat_update_var( iwpthlp_mfl_min, wpxp_mfl_min, zm ) + call stat_update_var( iwpthlp_mfl_max, wpxp_mfl_max, zm ) + elseif ( l_stats_samp .and. solve_type == mono_flux_rtm ) then + call stat_update_var( irtm_without_ta, xm_without_ta, zt ) + call stat_update_var( irtm_mfl_min, min_x_allowable, zt ) + call stat_update_var( irtm_mfl_max, max_x_allowable, zt ) + call stat_update_var( iwprtp_mfl_min, wpxp_mfl_min, zm ) + call stat_update_var( iwprtp_mfl_max, wpxp_mfl_max, zm ) + endif + + + if ( any( wpxp_net_adjust(:) /= 0.0_core_rknd ) ) then + + ! Reset the value of xm to compensate for the change to w'x'. + + if ( l_mfl_xm_imp_adj ) then + + ! A tridiagonal matrix is used to semi-implicitly re-solve for the + ! values of xm at timestep index (t+1). + + ! Set up the left-hand side of the tridiagonal matrix equation. + call mfl_xm_lhs( dt, wm_zt, l_implemented, & + lhs_mfl_xm ) + + ! Set up the right-hand side of tridiagonal matrix equation. + call mfl_xm_rhs( dt, xm_old, wpxp, xm_forcing, & + rho_ds_zm, invrs_rho_ds_zt, & + rhs_mfl_xm ) + + ! Solve the tridiagonal matrix equation. + call mfl_xm_solve( solve_type, lhs_mfl_xm, rhs_mfl_xm, & + xm, err_code ) + + ! Check for errors + if ( fatal_error( err_code ) ) return + + else ! l_mfl_xm_imp_adj = .false. + + ! An explicit adjustment is made to the values of xm at timestep + ! index (t+1), which is based upon the array of the amounts of w'x' + ! adjustments. + + do k = 2, gr%nz, 1 + + km1 = max( k-1, 1 ) + + ! The rate of change of the adjustment to xm due to the monotonic + ! flux limiter. + dxm_dt_mfl_adjust(k) & + = - invrs_rho_ds_zt(k) & + * gr%invrs_dzt(k) & + * ( rho_ds_zm(k) * wpxp_net_adjust(k) & + - rho_ds_zm(km1) * wpxp_net_adjust(km1) ) + + ! The net change to xm due to the monotonic flux limiter is the + ! rate of change multiplied by the time step length. Add the + ! product to xm to find the new xm resulting from the monotonic + ! flux limiter. + xm(k) = xm(k) + dxm_dt_mfl_adjust(k) * real( dt, kind = core_rknd ) + + enddo + + ! Boundary condition on xm + xm(1) = xm(2) + + endif ! l_mfl_xm_imp_adj + + ! This code can be uncommented for debugging. + !do k = 1, gr%nz, 1 + ! print *, "k = ", k, "xm(t) = ", xm_old(k), "new xm(t+1) = ", xm(k) + !enddo + + !Ensure there are no spikes at the top of the domain + if (abs( xm(gr%nz) - xm_enter_mfl(gr%nz) ) > 10._core_rknd * xm_tol) then + dz = gr%zm(gr%nz) - gr%zm(gr%nz - 1) + + xm_density_weighted = rho_ds_zt(gr%nz) & + * (xm(gr%nz) - xm_enter_mfl(gr%nz)) & + * dz + + xm_vert_integral & + = vertical_integral & + ( ((gr%nz - 1) - 2 + 1), rho_ds_zt(2:gr%nz - 1), & + xm(2:gr%nz - 1), gr%invrs_dzt(2:gr%nz - 1) ) + + !Check to ensure the vertical integral is not zero to avoid a divide + !by zero error + if (xm_vert_integral < eps) then + write(fstderr,*) "Vertical integral of xm is zero;", & + "mfl will remove spike at top of domain,", & + "but it will not conserve xm." + + !Remove the spike at the top of the domain + xm(gr%nz) = xm_enter_mfl(gr%nz) + else + xm_adj_coef = xm_density_weighted / xm_vert_integral + + !xm_adj_coef can not be smaller than -1 + if (xm_adj_coef < -0.99_core_rknd) then + write(fstderr,*) "xm_adj_coef in mfl less than -0.99, " & + // "mx_adj_coef set to -0.99" + xm_adj_coef = -0.99_core_rknd + endif + + !Apply the adjustment + xm = xm * (1._core_rknd + xm_adj_coef) + + !Remove the spike at the top of the domain + xm(gr%nz) = xm_enter_mfl(gr%nz) + + !This code can be uncommented to ensure conservation + !if (abs(sum(rho_ds_zt(2:gr%nz) * xm(2:gr%nz) / gr%invrs_dzt(2:gr%nz)) - & + ! sum(rho_ds_zt(2:gr%nz) * xm_enter_mfl(2:gr%nz) / gr%invrs_dzt(2:gr%nz)))& + ! > (1000 * xm_tol)) then + ! write(fstderr,*) "NON-CONSERVATION in MFL", trim( solve_type ), & + ! abs(sum(rho_ds_zt(2:gr%nz) * xm(2:gr%nz) / gr%invrs_dzt(2:gr%nz)) - & + ! sum(rho_ds_zt(2:gr%nz) * xm_enter_mfl(2:gr%nz) / & + ! gr%invrs_dzt(2:gr%nz))) + ! + ! write(fstderr,*) "XM_ENTER_MFL=", xm_enter_mfl + ! write(fstderr,*) "XM_AFTER_SPIKE_REMOVAL", xm + ! write(fstderr,*) "XM_TOL", xm_tol + ! write(fstderr,*) "XM_ADJ_COEF", xm_adj_coef + !endif + + endif ! xm_vert_integral < eps + endif ! spike at domain top + + endif ! any( wpxp_net_adjust(:) /= 0.0_core_rknd ) + + + if ( l_stats_samp ) then + + call stat_end_update( iwpxp_mfl, wpxp / real( dt, kind = core_rknd ), zm ) + + call stat_end_update( ixm_mfl, xm / real( dt, kind = core_rknd ), zt ) + + if ( solve_type == mono_flux_thlm ) then + call stat_update_var( ithlm_exit_mfl, xm, zt ) + call stat_update_var( iwpthlp_exit_mfl, xm, zm ) + elseif ( solve_type == mono_flux_rtm ) then + call stat_update_var( irtm_exit_mfl, xm, zt ) + call stat_update_var( iwprtp_exit_mfl, xm, zm ) + endif + + endif + + + return + end subroutine monotonic_turbulent_flux_limit + + !============================================================================= + subroutine mfl_xm_lhs( dt, wm_zt, l_implemented, & + lhs ) + + ! Description: + ! This subroutine is part of the process of re-solving for xm at timestep + ! index (t+1). This is done because the original solving process produced + ! values outside of what is deemed acceptable by the monotonic flux limiter. + ! Unlike the original formulation for advancing xm one timestep, which + ! combines w'x' and xm in a band-diagonal solver, this formulation uses a + ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) + ! is known. + ! + ! Subroutine mfl_xm_lhs sets up the left-hand side of the matrix equation. + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_mean_adv, only: & + term_ma_zt_lhs ! Procedure(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + wm_zt ! w wind component on thermodynamic levels [m/s] + + logical, intent(in) :: & + l_implemented ! Flag for CLUBB being implemented in a larger model. + + ! Output Variables + real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & + lhs ! Left hand side of tridiagonal matrix + + ! Local Variables + integer :: k, km1 ! Array index + + + !----------------------------------------------------------------------- + + ! Initialize the left-hand side matrix to 0. + lhs = 0.0_core_rknd + + + ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at + ! level k = 1, which is below the model surface, is simply set equal to the + ! value of xm at level k = 2 after the solve has been completed. + + ! Setup LHS of the tridiagonal system + do k = 2, gr%nz, 1 + + km1 = max( k-1,1 ) + + ! LHS xm mean advection (ma) term. + if ( .not. l_implemented ) then + + lhs(kp1_tdiag:km1_tdiag,k) & + = lhs(kp1_tdiag:km1_tdiag,k) & + + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) + + else + + lhs(kp1_tdiag:km1_tdiag,k) & + = lhs(kp1_tdiag:km1_tdiag,k) + 0.0_core_rknd + + endif + + ! LHS xm time tendency. + lhs(k_tdiag,k) & + = lhs(k_tdiag,k) + 1.0_core_rknd / real( dt, kind = core_rknd ) + + enddo ! xm loop: 2..gr%nz + + ! Boundary conditions. + + ! Lower boundary + k = 1 + lhs(:,k) = 0.0_core_rknd + lhs(k_tdiag,k) = 1.0_core_rknd + + return + end subroutine mfl_xm_lhs + + !============================================================================= + subroutine mfl_xm_rhs( dt, xm_old, wpxp, xm_forcing, & + rho_ds_zm, invrs_rho_ds_zt, & + rhs ) + + ! Description: + ! This subroutine is part of the process of re-solving for xm at timestep + ! index (t+1). This is done because the original solving process produced + ! values outside of what is deemed acceptable by the monotonic flux limiter. + ! Unlike the original formulation for advancing xm one timestep, which + ! combines w'x' and xm in a band-diagonal solver, this formulation uses a + ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) + ! is known. + ! + ! Subroutine mfl_xm_rhs sets up the right-hand side of the matrix equation. + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + implicit none + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm_old, & ! xm; timestep (t) (thermodynamic levels) [units vary] + wpxp, & ! w'x'; timestep (t+1); limited (m-levs.) [units vary] + xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] + + ! Output Variable + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + rhs ! Right hand side of tridiagonal matrix equation + + ! Local Variables + integer :: k, km1 ! Array indices + + !----------------------------------------------------------------------- + + ! Initialize the right-hand side vector to 0. + rhs = 0.0_core_rknd + + + ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at + ! level k = 1, which is below the model surface, is simply set equal to the + ! value of xm at level k = 2 after the solve has been completed. + + do k = 2, gr%nz, 1 + + ! Define indices + km1 = max( k-1, 1 ) + + ! RHS xm time tendency. + rhs(k) = rhs(k) + xm_old(k) / real( dt, kind = core_rknd ) + + ! RHS xm turbulent advection (ta) term. + ! Note: Normally, the turbulent advection (ta) term is treated + ! implicitly when advancing xm one timestep, as both xm and w'x' + ! are advanced together from timestep index (t) to timestep + ! index (t+1). However, in this case, both xm and w'x' have + ! already been advanced one timestep. However, w'x'(t+1) has been + ! limited after the fact, and therefore it's values at timestep + ! index (t+1) are known. Thus, in re-solving for xm(t+1), the + ! derivative of w'x'(t+1) can be placed on the right-hand side of + ! the d(xm)/dt equation. + rhs(k) & + = rhs(k) & + - invrs_rho_ds_zt(k) & + * gr%invrs_dzt(k) & + * ( rho_ds_zm(k) * wpxp(k) - rho_ds_zm(km1) * wpxp(km1) ) + + ! RHS xm forcings. + ! Note: xm forcings include the effects of microphysics, + ! cloud water sedimentation, radiation, and any + ! imposed forcings on xm. + rhs(k) = rhs(k) + xm_forcing(k) + + enddo ! xm loop: 2..gr%nz + + ! Boundary conditions + + ! Lower Boundary + k = 1 + ! The value of xm at the lower boundary will remain the same. However, the + ! value of xm at the lower boundary gets overwritten after the matrix is + ! solved for the next timestep, such that xm(1) = xm(2). + rhs(k) = xm_old(k) + + return + end subroutine mfl_xm_rhs + + !============================================================================= + subroutine mfl_xm_solve( solve_type, lhs, rhs, & + xm, err_code ) + + ! Description: + ! This subroutine is part of the process of re-solving for xm at timestep + ! index (t+1). This is done because the original solving process produced + ! values outside of what is deemed acceptable by the monotonic flux limiter. + ! Unlike the original formulation for advancing xm one timestep, which + ! combines w'x' and xm in a band-diagonal solver, this formulation uses a + ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) + ! is known. + ! + ! Subroutine mfl_xm_solve solves the tridiagonal matrix equation for xm at + ! timestep index (t+1). + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_lapack_wrap, only: & + tridag_solve ! Procedure(s) + + use crmx_error_code, only: & + fatal_error, & ! Procedure(s) + clubb_no_error ! Constant + + use crmx_clubb_precision, only: & + core_rknd + + implicit none + + ! Constant parameters + integer, parameter :: & + kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. + k_tdiag = 2, & ! Thermodynamic main diagonal index. + km1_tdiag = 3 ! Thermodynamic subdiagonal index. + + ! Input Variables + integer, intent(in) :: & + solve_type ! Variables being solved for. + + real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & + lhs ! Left hand side of tridiagonal matrix + + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + rhs ! Right hand side of tridiagonal matrix equation + + ! Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & + xm ! Value of variable being solved for at timestep (t+1) [units vary] + + integer, intent(out) :: & + err_code ! Returns an error code in the event of a singular matrix + + ! Local variable + character(len=10) :: & + solve_type_str ! solve_type as a string for debug output purposes + + !----------------------------------------------------------------------- + + err_code = clubb_no_error ! Initialize to the value for no errors + + select case( solve_type ) + case ( mono_flux_rtm ) + solve_type_str = "rtm" + case ( mono_flux_thlm ) + solve_type_str = "thlm" + case default + solve_type_str = "scalars" + end select + + ! Solve for xm at timestep index (t+1) using the tridiagonal solver. + call tridag_solve & + ( solve_type_str, gr%nz, 1, lhs(kp1_tdiag,:), & ! Intent(in) + lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Intent(inout) + xm, err_code ) ! Intent(out) + + ! Check for errors + if ( fatal_error( err_code ) ) return + + ! Boundary condition on xm + xm(1) = xm(2) + + return + end subroutine mfl_xm_solve + + !============================================================================= + subroutine calc_turb_adv_range( dt, w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & + mixt_frac_zm, & + low_lev_effect, high_lev_effect ) + + ! Description: + ! Calculates the lowermost and uppermost thermodynamic grid levels that can + ! effect the base (or central) thermodynamic level through the effects of + ! turbulent advection over the course of one time step. This is used as + ! part of the monotonic turbulent advection scheme. + ! + ! One method is to use the vertical velocity at each level to determine the + ! amount of time that it takes to travel across that particular grid level. + ! The method is to keep on advancing one grid level until either (a) the + ! total sum of time taken reaches or exceeds the model time step length, + ! (b) the top or bottom of the model is reached, or (c) a level is reached + ! where the vertical velocity component (with turbulence included) is + ! oriented completely opposite of the direction of travel towards the base + ! (or central) thermodynamic level. An example of situation (c) would be, + ! while starting from a higher altitude and searching downward for all + ! upward vertical velocity components, encountering a strong downdraft + ! where the vertical velocity at every single point is oriented downward. + ! Such a situation would occur when the mean vertical velocity (wm_zm) + ! exceeds any turbulent component (w') that would be oriented upwards. + ! + ! Another method is to simply set the thickness (in meters) of the layer + ! that turbulent advection is allowed to act over, for purposes of the + ! monotonic turbulent advection scheme. The lowermost and uppermost + ! grid level that can effect the base (or central) thermodynamic level + ! is computed based on the thickness and altitude of each level. + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + implicit none + + ! Constant parameters + logical, parameter :: & + l_constant_thickness = .false. ! Toggle constant or variable thickness. + + real( kind = core_rknd ), parameter :: & + const_thick = 150.0_core_rknd ! Constant thickness value [m] + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt ! Model timestep length [s] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + w1_zm, & ! Mean w (1st PDF component) [m/s] + w2_zm, & ! Mean w (2nd PDF component) [m/s] + varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] + mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] + + ! Output Variables + integer, dimension(gr%nz), intent(out) :: & + low_lev_effect, & ! Index of lowest level that has an effect (for lev. k) + high_lev_effect ! Index of highest level that has an effect (for lev. k) + + ! Local Variables + real( kind = core_rknd ), dimension(gr%nz) :: & + vert_vel_up, & ! Average upwards vertical velocity component [m/s] + vert_vel_down ! Average downwards vertical velocity component [m/s] + + real(kind=time_precision) :: & + dt_one_grid_lev, & ! Amount of time to travel one grid box [s] + dt_all_grid_levs ! Running count of amount of time taken to travel [s] + + integer :: k, j + + ! ---- Begin Code ---- + + if ( l_constant_thickness ) then ! thickness is a constant value. + + ! The value of w'x' may only be altered between levels 3 and gr%nz-2. + do k = 3, gr%nz-2, 1 + + ! Compute the number of levels that effect the central thermodynamic + ! level through upwards motion (traveling from lower levels to reach + ! the central thermodynamic level). + + ! Start with the index of the thermodynamic level immediately below + ! the central thermodynamic level. + j = k - 1 + + do ! loop downwards until answer is found. + + if ( gr%zt(k) - gr%zt(j) >= const_thick ) then + + ! Stop, the current grid level is the lowest level that can + ! be considered. + low_lev_effect(k) = j + + exit + + else + + ! Thermodynamic level 1 cannot be considered because it is + ! located below the surface or below the bottom of the model. + ! The lowest level that can be considered is thermodynamic + ! level 2. + if ( j == 2 ) then + + ! The current level (level 2) is the lowest level that can + ! be considered. + low_lev_effect(k) = j + + exit + + else + + ! Increment to the next vertical level down. + j = j - 1 + + endif + + endif + + enddo ! downwards loop + + + ! Compute the number of levels that effect the central thermodynamic + ! level through downwards motion (traveling from higher levels to + ! reach the central thermodynamic level). + + ! Start with the index of the thermodynamic level immediately above + ! the central thermodynamic level. + j = k + 1 + + do ! loop upwards until answer is found. + + if ( gr%zt(j) - gr%zt(k) >= const_thick ) then + + ! Stop, the current grid level is the highest level that can + ! be considered. + high_lev_effect(k) = j + + exit + + else + + ! The highest level that can be considered is thermodynamic + ! level gr%nz. + if ( j == gr%nz ) then + + ! The current level (level gr%nz) is the highest level + ! that can be considered. + high_lev_effect(k) = j + + exit + + else + + ! Increment to the next vertical level up. + j = j + 1 + + endif + + endif + + enddo ! upwards loop + + enddo ! k = 3, gr%nz-2 + + + else ! thickness based on vertical velocity and time step length. + + ! Find the average upwards vertical velocity and the average downwards + ! vertical velocity. + ! Note: A level that has all vertical wind moving downwards will have a + ! vert_vel_up value that is 0, and vice versa. + call mean_vert_vel_up_down( w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! In + mixt_frac_zm, 0.0_core_rknd, & ! In + vert_vel_down, vert_vel_up ) + + ! The value of w'x' may only be altered between levels 3 and gr%nz-2. + do k = 3, gr%nz-2, 1 + + ! Compute the number of levels that effect the central thermodynamic + ! level through upwards motion (traveling from lower levels to reach + ! the central thermodynamic level). + + ! Start with the index of the thermodynamic level immediately below + ! the central thermodynamic level. + j = k - 1 + + ! Initialize the overall delta t counter to 0. + dt_all_grid_levs = 0.0_time_precision + + do ! loop downwards until answer is found. + + ! Continue if there is some component of upwards vertical velocity. + if ( vert_vel_up(j) > 0.0_core_rknd ) then + + ! Compute the amount of time it takes to travel one grid level + ! upwards: delta_t = delta_z / vert_vel_up. + dt_one_grid_lev = real( (1.0_core_rknd/gr%invrs_dzm(j)) / vert_vel_up(j), & + kind=time_precision ) + + ! Total time elapsed for crossing all grid levels that have been + ! passed, thus far. + dt_all_grid_levs = dt_all_grid_levs + dt_one_grid_lev + + ! Stop if has taken more than one model time step (overall) to + ! travel the entire extent of the current vertical grid level. + if ( dt_all_grid_levs >= dt ) then + + ! The current level is the lowest level that can be + ! considered. + low_lev_effect(k) = j + + exit + + ! Continue if the total elapsed time has not reached or exceeded + ! one model time step. + else + + ! Thermodynamic level 1 cannot be considered because it is + ! located below the surface or below the bottom of the model. + ! The lowest level that can be considered is thermodynamic + ! level 2. + if ( j == 2 ) then + + ! The current level (level 2) is the lowest level that can + ! be considered. + low_lev_effect(k) = j + + exit + + else + + ! Increment to the next vertical level down. + j = j - 1 + + endif + + endif + + ! Stop if there isn't a component of upwards vertical velocity. + else + + ! The current level cannot be considered. The lowest level that + ! can be considered is one-level-above the current level. + low_lev_effect(k) = j + 1 + + exit + + endif + + enddo ! downwards loop + + + ! Compute the number of levels that effect the central thermodynamic + ! level through downwards motion (traveling from higher levels to + ! reach the central thermodynamic level). + + ! Start with the index of the thermodynamic level immediately above + ! the central thermodynamic level. + j = k + 1 + + ! Initialize the overall delta t counter to 0. + dt_all_grid_levs = 0.0_time_precision + + do ! loop upwards until answer is found. + + ! Continue if there is some component of downwards vertical velocity. + if ( vert_vel_down(j-1) < 0.0_core_rknd ) then + + ! Compute the amount of time it takes to travel one grid level + ! downwards: delta_t = - delta_z / vert_vel_down. + ! Note: There is a (-) sign in front of delta_z because the + ! distance traveled is downwards. Since vert_vel_down + ! has a negative value, dt_one_grid_lev will be a + ! positive value. + dt_one_grid_lev = real( -(1.0_core_rknd/gr%invrs_dzm(j-1)) / vert_vel_down(j-1), & + kind=time_precision ) + + ! Total time elapsed for crossing all grid levels that have been + ! passed, thus far. + dt_all_grid_levs = real( dt_all_grid_levs + dt_one_grid_lev, kind=time_precision ) + + ! Stop if has taken more than one model time step (overall) to + ! travel the entire extent of the current vertical grid level. + if ( dt_all_grid_levs >= dt ) then + + ! The current level is the highest level that can be + ! considered. + high_lev_effect(k) = j + + exit + + ! Continue if the total elapsed time has not reached or exceeded + ! one model time step. + else + + ! The highest level that can be considered is thermodynamic + ! level gr%nz. + if ( j == gr%nz ) then + + ! The current level (level gr%nz) is the highest level + ! that can be considered. + high_lev_effect(k) = j + + exit + + else + + ! Increment to the next vertical level up. + j = j + 1 + + endif + + endif + + ! Stop if there isn't a component of downwards vertical velocity. + else + + ! The current level cannot be considered. The highest level + ! that can be considered is one-level-below the current level. + high_lev_effect(k) = j - 1 + + exit + + endif + + enddo ! upwards loop + + enddo ! k = 3, gr%nz-2 + + endif ! l_constant_thickness + + + ! Information for levels 1, 2, gr%nz-1, and gr%nz is not needed. + ! However, set the values at these levels for purposes of not having odd + ! values in the arrays. + low_lev_effect(1) = 1 + high_lev_effect(1) = 1 + low_lev_effect(2) = 2 + high_lev_effect(2) = 2 + low_lev_effect(gr%nz-1) = gr%nz-1 + high_lev_effect(gr%nz-1) = gr%nz + low_lev_effect(gr%nz) = gr%nz + high_lev_effect(gr%nz) = gr%nz + + + return + end subroutine calc_turb_adv_range + + !============================================================================= + subroutine mean_vert_vel_up_down( w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & + mixt_frac_zm, w_ref, & + mean_w_down, mean_w_up ) + + ! Description + ! The values of vertical velocity, along a horizontal plane at any given + ! vertical level, are not allowed by CLUBB to be uniform. In other words, + ! there must be some variance in vertical velocity. This subroutine + ! calculates the mean of all values of vertical velocity, at any given + ! vertical level, that are greater than a certain reference velocity. This + ! subroutine also calculates the mean of all values of vertical velocity, at + ! any given vertical level, that are less than a certain reference velocity. + ! The reference velocity is usually 0 m/s, in which case this subroutine + ! calculates the average positive (upward) velocity and the average negative + ! (downward) velocity. However, the reference velocity may be other values, + ! such as wm_zm, which is the overall mean vertical velocity. If the + ! reference velocity is wm_zm, this subroutine calculates the average of all + ! values of w that are on the positive ("upward") side of the mean and the + ! average of all values of w that are on the negative ("downward") side of + ! the mean. These mean positive and negative vertical velocities are useful + ! in determining how long, on average, it takes a parcel of air, being + ! driven by subgrid updrafts or downdrafts, to traverse the length of the + ! vertical grid level. + ! + ! Method + ! ------ + ! + ! The CLUBB model uses a joint PDF of vertical velocity, liquid water + ! potential temperature, and total water mixing ratio to determine subgrid + ! variability. + ! + ! The values of vertical velocity, w, along an undefined horizontal plane + ! at any vertical level, are considered to approximately follow a + ! distribution that is a mixture of two normal (or Gaussian) distributions. + ! The values of w that are a part of the 1st normal distribution are + ! referred to as w1, and the values of w that are part of the 2nd normal + ! distribution are referred to as w2. Note that these distributions + ! overlap, and there are many values of w that are found in both w1 and w2. + ! + ! The probability density function (PDF) for w, P(w), is: + ! + ! P(w) = mixt_frac*P(w1) + (1-mixt_frac)*P(w2); + ! + ! where "mixt_frac" is the weight of the 1st normal distribution, and P(w1) and + ! P(w2) are the equations for the 1st and 2nd normal distributions, + ! respectively: + ! + ! P(w1) = 1 / ( sigma_w1 * sqrt(2*PI) ) + ! * EXP[ -(w1-mu_w1)^2 / (2*sigma_w1^2) ]; and + ! + ! P(w2) = 1 / ( sigma_w2 * sqrt(2*PI) ) + ! * EXP[ -(w2-mu_w2)^2 / (2*sigma_w2^2) ]. + ! + ! The mean of the 1st normal distribution is mu_w1, and the standard + ! deviation of the 1st normal distribution is sigma_w1. The mean of the + ! 2nd normal distribution is mu_w2, and the standard deviation of the 2nd + ! normal distribution is sigma_w2. + ! + ! The average value of w, distributed according to the probability + ! distribution, between limits alpha and beta, is: + ! + ! = INT(alpha:beta) w P(w) dw. + ! + ! The average value of w over a certain domain is used to determine the + ! average positive and negative (as compared to the reference velocity) + ! values of w at any vertical level. + ! + ! Average Negative Vertical Velocity + ! ---------------------------------- + ! + ! The average of all values of w in the distribution that are below the + ! reference velocity, w|_ref, is the mean value of w over the domain + ! -inf <= w <= w|_ref, such that: + ! + ! = INT(-inf:w|_ref) w P(w) dw. + ! = mixt_frac * INT(-inf:w|_ref) w1 P(w1) dw1 + ! + (1-mixt_frac) * INT(-inf:w|_ref) w2 P(w2) dw2. + ! + ! For each normal distribution in the mixture of normal distribution, i + ! (where "i" can be 1 or 2): + ! + ! INT(-inf:w|_ref) wi P(wi) dwi = + ! - ( sigma_wi / sqrt(2*PI) ) * EXP[ -(w|_ref-mu_wi)^2 / (2*sigma_wi^2) ] + ! + mu_wi * (1/2)*[ 1 + erf( (w|_ref-mu_wi) / (sqrt(2)*sigma_wi) ) ]; + ! + ! where mu_wi is the mean of w for the ith normal distribution, sigma_wi is + ! the standard deviations of w for the ith normal distribution, and erf( ) + ! is the error function. + ! + ! The mean of all values of w <= w|_ref is: + ! + ! = + ! mixt_frac * { - ( sigma_w1 / sqrt(2*PI) ) + ! * EXP[ -(w|_ref-mu_w1)^2 / (2*sigma_w1^2) ] + ! + mu_w1 * (1/2) + ! *[1 + erf( (w|_ref-mu_w1) / (sqrt(2)*sigma_w1) )] } + ! + (1-mixt_frac) * { - ( sigma_w2 / sqrt(2*PI) ) + ! * EXP[ -(w|_ref-mu_w2)^2 / (2*sigma_w2^2) ] + ! + mu_w2 * (1/2) + ! *[1 + erf( (w|_ref-mu_w2) / (sqrt(2)*sigma_w2) )] }. + ! + ! Average Positive Vertical Velocity + ! ---------------------------------- + ! + ! The average of all values of w in the distribution that are above the + ! reference velocity, w|_ref, is the mean value of w over the domain + ! w|_ref <= w <= inf, such that: + ! + ! = INT(w|_ref:inf) w P(w) dw. + ! = mixt_frac * INT(w|_ref:inf) w1 P(w1) dw1 + ! + (1-mixt_frac) * INT(w|_ref:inf) w2 P(w2) dw2. + ! + ! For each normal distribution in the mixture of normal distribution, i + ! (where "i" can be 1 or 2): + ! + ! INT(w|_ref:inf) wi P(wi) dwi = + ! ( sigma_wi / sqrt(2*PI) ) * EXP[ -(w|_ref-mu_wi)^2 / (2*sigma_wi^2) ] + ! + mu_wi * (1/2)*[ 1 - erf( (w|_ref-mu_wi) / (sqrt(2)*sigma_wi) ) ]; + ! + ! where mu_wi is the mean of w for the ith normal distribution, sigma_wi is + ! the standard deviations of w for the ith normal distribution, and erf( ) + ! is the error function. + ! + ! The mean of all values of w >= w|_ref is: + ! + ! = + ! mixt_frac * { ( sigma_w1 / sqrt(2*PI) ) + ! * EXP[ -(w|_ref-mu_w1)^2 / (2*sigma_w1^2) ] + ! + mu_w1 * (1/2) + ! *[1 - erf( (w|_ref-mu_w1) / (sqrt(2)*sigma_w1) )] } + ! + (1-mixt_frac) * { ( sigma_w2 / sqrt(2*PI) ) + ! * EXP[ -(w|_ref-mu_w2)^2 / (2*sigma_w2^2) ] + ! + mu_w2 * (1/2) + ! *[1 - erf( (w|_ref-mu_w2) / (sqrt(2)*sigma_w2) )] }. + ! + ! Special Limitations: + ! -------------------- + ! + ! A normal distribution has a domain from -inf to inf. However, the mixture + ! of normal distributions is an approximation of the distribution of values + ! of w along a horizontal plane at any given vertical level. Vertical + ! velocity, w, has absolute minimum and maximum values (that cannot be + ! predicted by the PDF). The absolute maximum and minimum for each normal + ! distribution is most likely found within 2 or 3 standard deviations of the + ! mean for the relevant normal distribution. In other words, for each + ! normal distribution in the mixture of normal distributions, all the values + ! of w are found within 2 or 3 standard deviations on both sides of the + ! mean. Therefore, if one (or both) of the normal distributions has a mean + ! that is more than 3 standard deviations away from the reference velocity, + ! then that entire w distribution is found on ONE side of the reference + ! velocity. + ! + ! Therefore: + ! + ! a) where mu_wi + 3*sigma_wi <= w|_ref: + ! + ! The entire ith normal distribution of w is on the negative side of + ! w|_ref; and + ! + ! INT(-inf:w|_ref) wi P(wi) dwi = mu_wi; and + ! INT(inf:w|_ref) wi P(wi) dwi = 0. + ! + ! b) where mu_wi - 3*sigma_wi >= w|_ref: + ! + ! The entire ith normal distribution of w is on the positive side of + ! w|_ref; and + ! + ! INT(-inf:w|_ref) wi P(wi) dwi = 0; and + ! INT(inf:w|_ref) wi P(wi) dwi = mu_wi. + ! + ! Note: A value of 3 standard deviations above and below the mean of the + ! ith normal distribution was chosen for the approximate maximum and + ! minimum values of the ith normal distribution because 99.7% of + ! values in a normal distribution are found within 3 standard + ! deviations from the mean (compared to 95.4% for 2 standard + ! deviations). The value of 3 standard deviations provides for a + ! reasonable estimate of the absolute maximum and minimum of w, while + ! covering a great majority of the normal distribution. + + ! References: + !----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr, & ! Variable(s) + zt2zm ! Procedure(s) + + use crmx_constants_clubb, only: & + sqrt_2pi, & + sqrt_2 + + use crmx_anl_erf, only: & + erf ! Procedure(s) + ! The error function + + use crmx_stats_type, only: & + stat_update_var_pt ! Procedure(s) + + use crmx_stats_variables, only: & + zm, & ! Variable(s) + imean_w_up, & + imean_w_down, & + l_stats_samp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + w1_zm, & ! Mean w (1st PDF component) [m/s] + w2_zm, & ! Mean w (2nd PDF component) [m/s] + varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] + mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] + + real( kind = core_rknd ), intent(in) :: & + w_ref ! Reference velocity, w|_ref (normally = 0) [m/s] + + ! Output Variables + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + mean_w_down, & ! Overall mean w (<= w|_ref) [m/s] + mean_w_up ! Overall mean w (>= w|_ref) [m/s] + + ! Local Variables + + real( kind = core_rknd ) :: & + sigma_w1, & ! Standard deviation of w for 1st normal distribution [m/s] + sigma_w2, & ! Standard deviation of w for 2nd normal distribution [m/s] + mean_w_down_1st, & ! Mean w (<= w|_ref) from 1st normal distribution [m/s] + mean_w_down_2nd, & ! Mean w (<= w|_ref) from 2nd normal distribution [m/s] + mean_w_up_1st, & ! Mean w (>= w|_ref) from 1st normal distribution [m/s] + mean_w_up_2nd, & ! Mean w (>= w|_ref) from 2nd normal distribution [m/s] + exp_cache, & ! Cache of exponential calculations to reduce runtime + erf_cache ! Cache of error function calculations to reduce runtime + + integer :: k ! Vertical loop index + + ! ---- Begin Code ---- + + ! Loop over momentum levels from 2 to gr%nz-1. Levels 1 and gr%nz + ! are not needed. + do k = 2, gr%nz-1, 1 + + ! Standard deviation of w for the 1st normal distribution. + sigma_w1 = sqrt( varnce_w1_zm(k) ) + + ! Standard deviation of w for the 2nd normal distribution. + sigma_w2 = sqrt( varnce_w2_zm(k) ) + + + ! Contributions from the 1st normal distribution. + if ( w1_zm(k) + 3._core_rknd*sigma_w1 <= w_ref ) then + + ! The entire 1st normal is on the negative side of w|_ref. + mean_w_down_1st = w1_zm(k) + mean_w_up_1st = 0.0_core_rknd + + elseif ( w1_zm(k) - 3._core_rknd*sigma_w1 >= w_ref ) then + + ! The entire 1st normal is on the positive side of w|_ref. + mean_w_down_1st = 0.0_core_rknd + mean_w_up_1st = w1_zm(k) + + else + + ! The exponential calculation is pulled out as it is reused in both + ! equations. This should save one calculation of the + ! exp( -(w_ref-w1_zm(k))**2 ... etc. part of the formula. + ! ~~EIHoppe//20090618 + exp_cache = exp( -(w_ref-w1_zm(k))**2 / (2.0_core_rknd*sigma_w1**2) ) + + ! Added cache of the error function calculations. + ! This should save one calculation of the erf(...) part + ! of the formula. + ! ~~EIHoppe//20090623 + erf_cache = erf( (w_ref-w1_zm(k)) / (sqrt_2*sigma_w1) ) + + ! The 1st normal has values on both sides of w_ref. + mean_w_down_1st = & + - (sigma_w1/sqrt_2pi) & +! * exp( -(w_ref-w1_zm(k))**2 / (2.0_core_rknd*sigma_w1**2) ) & + * exp_cache & +! + w1(k) * 0.5_core_rknd*( 1.0_core_rknd + erf( (w_ref-w1(k)) / (sqrt_2*sigma_w1) ) ) + + w1_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf_cache) + + mean_w_up_1st = & + + (sigma_w1/sqrt_2pi) & +! * exp( -(w_ref-w1(k))**2 / (2.0_core_rknd*sigma_w1**2) ) & + * exp_cache & +! + w1(k) * 0.5_core_rknd*( 1.0_core_rknd - erf( (w_ref-w1(k)) / (sqrt_2*sigma_w1) ) ) + + w1_zm(k) * 0.5_core_rknd*( 1.0_core_rknd - erf_cache) + + ! /EIHoppe changes + + endif + + + ! Contributions from the 2nd normal distribution. + if ( w2_zm(k) + 3._core_rknd*sigma_w2 <= w_ref ) then + + ! The entire 2nd normal is on the negative side of w|_ref. + mean_w_down_2nd = w2_zm(k) + mean_w_up_2nd = 0.0_core_rknd + + elseif ( w2_zm(k) - 3._core_rknd*sigma_w2 >= w_ref ) then + + ! The entire 2nd normal is on the positive side of w|_ref. + mean_w_down_2nd = 0.0_core_rknd + mean_w_up_2nd = w2_zm(k) + + else + + ! The exponential calculation is pulled out as it is reused in both + ! equations. This should save one calculation of the + ! exp( -(w_ref-w1(k))**2 ... etc. part of the formula. + ! ~~EIHoppe//20090618 + exp_cache = exp( -(w_ref-w2_zm(k))**2 / (2.0_core_rknd*sigma_w2**2) ) + + ! Added cache of the error function calculations. + ! This should save one calculation of the erf(...) part + ! of the formula. + ! ~~EIHoppe//20090623 + erf_cache = erf( (w_ref-w2_zm(k)) / (sqrt_2*sigma_w2) ) + + ! The 2nd normal has values on both sides of w_ref. + mean_w_down_2nd = & + - (sigma_w2/sqrt_2pi) & +! * exp( -(w_ref-w2_zm(k))**2 / (2.0_core_rknd*sigma_w2**2) ) & + * exp_cache & +! + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf( (w_ref-w2(k)) / (sqrt_2*sigma_w2) ) ) + + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf_cache) + + mean_w_up_2nd = & + + (sigma_w2/sqrt_2pi) & +! * exp( -(w_ref-w2(k))**2 / (2.0_core_rknd*sigma_w2**2) ) & + * exp_cache & +! + w2(k) * 0.5_core_rknd*( 1.0_core_rknd - erf( (w_ref-w2(k)) / (sqrt_2*sigma_w2) ) ) + + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd - erf_cache) + + ! /EIHoppe changes + + endif + + ! Overall mean of downwards w. + mean_w_down(k) = mixt_frac_zm(k) * mean_w_down_1st & + + ( 1.0_core_rknd - mixt_frac_zm(k) ) * mean_w_down_2nd + + ! Overall mean of upwards w. + mean_w_up(k) = mixt_frac_zm(k) * mean_w_up_1st & + + ( 1.0_core_rknd - mixt_frac_zm(k) ) * mean_w_up_2nd + + if ( l_stats_samp ) then + + call stat_update_var_pt( imean_w_up, k, mean_w_up(k), zm ) + + call stat_update_var_pt( imean_w_down, k, mean_w_down(k), zm ) + + endif ! l_stats_samp + + enddo ! k = 2, gr%nz, 1 + + + return + end subroutine mean_vert_vel_up_down + +!=============================================================================== + +end module crmx_mono_flux_limiter diff --git a/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 b/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 new file mode 100644 index 0000000000..14d75bc733 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 @@ -0,0 +1,1317 @@ +! A C-program for MT19937, with initialization improved 2002/1/26. +! Coded by Takuji Nishimura and Makoto Matsumoto. + +! Code converted to Fortran 95 by José Rui Faustino de Sousa +! Date: 2002-02-01 + +! Enhanced version by José Rui Faustino de Sousa +! Date: 2003-04-30 + +! Interface: +! +! Kinds: +! genrand_intg +! Integer kind used must be at least 32 bits. +! genrand_real +! Real kind used +! +! Types: +! genrand_state +! Internal representation of the RNG state. +! genrand_srepr +! Public representation of the RNG state. Should be used to save the RNG state. +! +! Procedures: +! assignment(=) +! Converts from type genrand_state to genrand_srepr and vice versa. +! genrand_init +! Internal RNG state initialization subroutine accepts either an genrand_intg integer +! or a vector as seed or a new state using "put=" returns the present state using +! "get=". If it is called with "get=" before being seeded with "put=" returns a state +! initialized with a default seed. +! genrand_int32 +! Subroutine returns an array or scalar whose elements are random integer on the +! [0,0xffffffff] interval. +! genrand_int31 +! Subroutine returns an array or scalar whose elements are random integer on the +! [0,0x7fffffff] interval. +! genrand_real1 +! Subroutine returns an array or scalar whose elements are random real on the +! [0,1] interval. +! genrand_real2 +! Subroutine returns an array or scalar whose elements are random real on the +! [0,1[ interval. +! genrand_real3 +! Subroutine returns an array or scalar whose elements are random real on the +! ]0,1[ interval. +! genrand_res53 +! Subroutine returns an array or scalar whose elements are random real on the +! [0,1[ interval with 53-bit resolution. + +! Before using, initialize the state by using genrand_init( put=seed ) + +! This library is free software. +! This library is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +! Copyright (C) 1997, 2002 Makoto Matsumoto and Takuji Nishimura. +! Any feedback is very welcome. +! http://www.math.keio.ac.jp/matumoto/emt.html +! email: matumoto@math.keio.ac.jp +module crmx_mt95 + + implicit none + + public :: genrand_init, assignment(=) + public :: genrand_int32, genrand_int31, genrand_real1 + public :: genrand_real2, genrand_real3, genrand_res53 + private :: uiadd, uisub, uimlt, uidiv, uimod + private :: init_by_type, init_by_scalar, init_by_array, next_state + private :: genrand_encode, genrand_decode, genrand_load_state, genrand_dump_state + private :: genrand_int32_0d, genrand_int32_1d, genrand_int32_2d, genrand_int32_3d + private :: genrand_int32_4d, genrand_int32_5d, genrand_int32_6d, genrand_int32_7d + private :: genrand_int31_0d, genrand_int31_1d, genrand_int31_2d, genrand_int31_3d + private :: genrand_int31_4d, genrand_int31_5d, genrand_int31_6d, genrand_int31_7d + private :: genrand_real1_0d, genrand_real1_1d, genrand_real1_2d, genrand_real1_3d + private :: genrand_real1_4d, genrand_real1_5d, genrand_real1_6d, genrand_real1_7d + private :: genrand_real2_0d, genrand_real2_1d, genrand_real2_2d, genrand_real2_3d + private :: genrand_real2_4d, genrand_real2_5d, genrand_real2_6d, genrand_real2_7d + private :: genrand_real3_0d, genrand_real3_1d, genrand_real3_2d, genrand_real3_3d + private :: genrand_real3_4d, genrand_real3_5d, genrand_real3_6d, genrand_real3_7d + private :: genrand_res53_0d, genrand_res53_1d, genrand_res53_2d, genrand_res53_3d + private :: genrand_res53_4d, genrand_res53_5d, genrand_res53_6d, genrand_res53_7d + + intrinsic :: selected_int_kind, selected_real_kind + + integer, public, parameter :: genrand_intg = selected_int_kind( 9 ) + integer, public, parameter :: genrand_real = selected_real_kind( 15 ) + + integer, private, parameter :: wi = genrand_intg + integer, private, parameter :: wr = genrand_real + + ! Period parameters + integer(kind=wi), private, parameter :: n = 624_wi + integer(kind=wi), private, parameter :: m = 397_wi + + integer(kind=wi), private, parameter :: default_seed = 5489_wi + + integer(kind=wi), private, parameter :: fbs = 32_wi + integer(kind=wi), private, parameter :: hbs = fbs / 2_wi + integer(kind=wi), private, parameter :: qbs = hbs / 2_wi + integer(kind=wi), private, parameter :: tbs = 3_wi * qbs + + real(kind=wr), private, parameter :: p231 = 2147483648.0_wr + real(kind=wr), private, parameter :: p232 = 4294967296.0_wr + real(kind=wr), private, parameter :: p232_1 = p232 - 1.0_wr + real(kind=wr), private, parameter :: pi232 = 1.0_wr / p232 + real(kind=wr), private, parameter :: pi232_1 = 1.0_wr / p232_1 + real(kind=wr), private, parameter :: pi227 = 1.0_wr / 134217728.0_wr + real(kind=wr), private, parameter :: pi253 = 1.0_wr / 9007199254740992.0_wr + real(kind=wr), private, parameter :: p231d232_1 = p231 / p232_1 + real(kind=wr), private, parameter :: p231_5d232 = ( p231 + 0.5_wr ) / p232 + + character(len=*), private, parameter :: alph = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + character(len=*), private, parameter :: sepr = "&" + integer(kind=wi), private, parameter :: alps = 62_wi + integer(kind=wi), private, parameter :: clen = ( n + 1_wi ) * 7_wi !n * ( ceiling( fbs * log( 2.0_core_rknd ) / log( alps ) ) + 1 ) + + type, public :: genrand_state + private + logical(kind=wi) :: ini = .false._wi + integer(kind=wi) :: cnt = n+1_wi + integer(kind=wi), dimension(n) :: val = 0_wi + end type genrand_state + + type, public :: genrand_srepr + character(len=clen) :: repr + end type genrand_srepr + + type(genrand_state), private, save :: state + + interface assignment( = ) + module procedure genrand_load_state + module procedure genrand_dump_state + end interface assignment( = ) + + interface genrand_init + module procedure init_by_type + module procedure init_by_scalar + module procedure init_by_array + end interface genrand_init + + interface genrand_int32 + module procedure genrand_int32_0d + module procedure genrand_int32_1d + module procedure genrand_int32_2d + module procedure genrand_int32_3d + module procedure genrand_int32_4d + module procedure genrand_int32_5d + module procedure genrand_int32_6d + module procedure genrand_int32_7d + end interface genrand_int32 + + interface genrand_int31 + module procedure genrand_int31_0d + module procedure genrand_int31_1d + module procedure genrand_int31_2d + module procedure genrand_int31_3d + module procedure genrand_int31_4d + module procedure genrand_int31_5d + module procedure genrand_int31_6d + module procedure genrand_int31_7d + end interface genrand_int31 + + interface genrand_real1 + module procedure genrand_real1_0d + module procedure genrand_real1_1d + module procedure genrand_real1_2d + module procedure genrand_real1_3d + module procedure genrand_real1_4d + module procedure genrand_real1_5d + module procedure genrand_real1_6d + module procedure genrand_real1_7d + end interface genrand_real1 + + interface genrand_real2 + module procedure genrand_real2_0d + module procedure genrand_real2_1d + module procedure genrand_real2_2d + module procedure genrand_real2_3d + module procedure genrand_real2_4d + module procedure genrand_real2_5d + module procedure genrand_real2_6d + module procedure genrand_real2_7d + end interface genrand_real2 + + interface genrand_real3 + module procedure genrand_real3_0d + module procedure genrand_real3_1d + module procedure genrand_real3_2d + module procedure genrand_real3_3d + module procedure genrand_real3_4d + module procedure genrand_real3_5d + module procedure genrand_real3_6d + module procedure genrand_real3_7d + end interface genrand_real3 + + interface genrand_res53 + module procedure genrand_res53_0d + module procedure genrand_res53_1d + module procedure genrand_res53_2d + module procedure genrand_res53_3d + module procedure genrand_res53_4d + module procedure genrand_res53_5d + module procedure genrand_res53_6d + module procedure genrand_res53_7d + end interface genrand_res53 + + contains + + elemental function uiadd( a, b ) result( c ) + + intrinsic :: ibits, ior, ishft + + integer( kind = wi ), intent( in ) :: a, b + + integer( kind = wi ) :: c + + integer( kind = wi ) :: a1, a2, b1, b2, s1, s2 + + a1 = ibits( a, 0, hbs ) + a2 = ibits( a, hbs, hbs ) + b1 = ibits( b, 0, hbs ) + b2 = ibits( b, hbs, hbs ) + s1 = a1 + b1 + s2 = a2 + b2 + ibits( s1, hbs, hbs ) + c = ior( ishft( s2, hbs ), ibits( s1, 0, hbs ) ) + return + + end function uiadd + + elemental function uisub( a, b ) result( c ) + + intrinsic :: ibits, ior, ishft + + integer( kind = wi ), intent( in ) :: a, b + + integer( kind = wi ) :: c + + integer( kind = wi ) :: a1, a2, b1, b2, s1, s2 + + a1 = ibits( a, 0, hbs ) + a2 = ibits( a, hbs, hbs ) + b1 = ibits( b, 0, hbs ) + b2 = ibits( b, hbs, hbs ) + s1 = a1 - b1 + s2 = a2 - b2 + ibits( s1, hbs, hbs ) + c = ior( ishft( s2, hbs ), ibits( s1, 0, hbs ) ) + return + + end function uisub + + elemental function uimlt( a, b ) result( c ) + + intrinsic :: ibits, ior, ishft + + integer(kind=wi), intent(in) :: a, b + + integer(kind=wi) :: c + + integer(kind=wi) :: a0, a1, a2, a3 + integer(kind=wi) :: b0, b1, b2, b3 + integer(kind=wi) :: p0, p1, p2, p3 + + a0 = ibits( a, 0, qbs ) + a1 = ibits( a, qbs, qbs ) + a2 = ibits( a, hbs, qbs ) + a3 = ibits( a, tbs, qbs ) + b0 = ibits( b, 0, qbs ) + b1 = ibits( b, qbs, qbs ) + b2 = ibits( b, hbs, qbs ) + b3 = ibits( b, tbs, qbs ) + p0 = a0 * b0 + p1 = a1 * b0 + a0 * b1 + ibits( p0, qbs, tbs ) + p2 = a2 * b0 + a1 * b1 + a0 * b2 + ibits( p1, qbs, tbs ) + p3 = a3 * b0 + a2 * b1 + a1 * b2 + a0 * b3 + ibits( p2, qbs, tbs ) + c = ior( ishft( p1, qbs ), ibits( p0, 0, qbs ) ) + c = ior( ishft( p2, hbs ), ibits( c, 0, hbs ) ) + c = ior( ishft( p3, tbs ), ibits( c, 0, tbs ) ) + return + + end function uimlt + + elemental function uidiv( a, b ) result( c ) + + intrinsic :: btest, ishft + + integer(kind=wi), intent(in) :: a, b + + integer(kind=wi) :: c + + integer(kind=wi) :: dl, rl + + if ( btest( a, fbs-1 ) ) then + if ( btest( b, fbs-1 ) ) then + if ( a < b ) then + c = 0 + else + c = 1 + end if + else + dl = ishft( ishft( a, -1 ) / b, 1 ) + rl = uisub( a, uimlt( b, dl ) ) + if ( rl < b ) then + c = dl + else + c = uiadd( dl, 1 ) + end if + end if + else + if ( btest( b, fbs-1 ) ) then + c = 0 + else + c = a / b + end if + end if + return + + end function uidiv + + elemental function uimod( a, b ) result( c ) + + intrinsic :: modulo, btest, ishft + + integer(kind=wi), intent(in) :: a, b + + integer(kind=wi) :: c + + integer(kind=wi) :: dl, rl + + if ( btest( a, fbs-1 ) ) then + if ( btest( b, fbs-1 ) ) then + if ( a < b ) then + c = a + else + c = uisub( a, b ) + end if + else + dl = ishft( ishft( a, -1 ) / b, 1 ) + rl = uisub( a, uimlt( b, dl ) ) + if ( rl < b ) then + c = rl + else + c = uisub( rl, b ) + end if + end if + else + if ( btest( b, fbs-1 ) ) then + c = a + else + c = modulo( a, b ) + end if + end if + return + + end function uimod + + subroutine init_by_type( put, get ) + + intrinsic :: present + + type(genrand_state), optional, intent(in ) :: put + type(genrand_state), optional, intent(out) :: get + + if ( present( put ) ) then + if ( put%ini ) state = put + else if ( present( get ) ) then + if ( .not. state%ini ) call init_by_scalar( default_seed ) + get = state + else + call init_by_scalar( default_seed ) + end if + return + + end subroutine init_by_type + + ! initializes mt[N] with a seed + subroutine init_by_scalar( put ) + + intrinsic :: ishft, ieor, ibits + + integer(kind=wi), parameter :: mult_a = 1812433253_wi !z'6C078965' + + integer(kind=wi), intent(in) :: put + + integer(kind=wi) :: i + + state%ini = .true._wi + state%val(1) = ibits( put, 0, fbs ) + do i = 2, n, 1 + state%val(i) = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) + state%val(i) = uimlt( state%val(i), mult_a ) + state%val(i) = uiadd( state%val(i), i-1_wi ) + ! See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. + ! In the previous versions, MSBs of the seed affect + ! only MSBs of the array mt[]. + ! 2002/01/09 modified by Makoto Matsumoto + state%val(i) = ibits( state%val(i), 0, fbs ) + ! for >32 bit machines + end do + state%cnt = n + 1_wi + return + + end subroutine init_by_scalar + + ! initialize by an array with array-length + ! init_key is the array for initializing keys + ! key_length is its length + subroutine init_by_array( put ) + + intrinsic :: size, max, ishft, ieor, ibits + + integer(kind=wi), parameter :: seed_d = 19650218_wi !z'12BD6AA' + integer(kind=wi), parameter :: mult_a = 1664525_wi !z'19660D' + integer(kind=wi), parameter :: mult_b = 1566083941_wi !z'5D588B65' + integer(kind=wi), parameter :: msb1_d = ishft( 1_wi, fbs-1 ) !z'80000000' + + integer(kind=wi), dimension(:), intent(in) :: put + + integer(kind=wi) :: i, j, k, tp, key_length + + call init_by_scalar( seed_d ) + key_length = size( put, dim=1 ) + i = 2_wi + j = 1_wi + do k = max( n, key_length ), 1, -1 + tp = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) + tp = uimlt( tp, mult_a ) + state%val(i) = ieor( state%val(i), tp ) + state%val(i) = uiadd( state%val(i), uiadd( put(j), j-1_wi ) ) ! non linear + state%val(i) = ibits( state%val(i), 0, fbs ) ! for WORDSIZE > 32 machines + i = i + 1_wi + j = j + 1_wi + if ( i > n ) then + state%val(1) = state%val(n) + i = 2_wi + end if + if ( j > key_length) j = 1_wi + end do + do k = n-1, 1, -1 + tp = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) + tp = uimlt( tp, mult_b ) + state%val(i) = ieor( state%val(i), tp ) + state%val(i) = uisub( state%val(i), i-1_wi ) ! non linear + state%val(i) = ibits( state%val(i), 0, fbs ) ! for WORDSIZE > 32 machines + i = i + 1_wi + if ( i > n ) then + state%val(1) = state%val(n) + i = 2_wi + end if + end do + state%val(1) = msb1_d ! MSB is 1; assuring non-zero initial array + return + + end subroutine init_by_array + + subroutine next_state( ) + + intrinsic :: ishft, ieor, btest, ibits, mvbits + + integer(kind=wi), parameter :: matrix_a = -1727483681_wi !z'9908b0df' + + integer(kind=wi) :: i, mld + + if ( .not. state%ini ) call init_by_scalar( default_seed ) + do i = 1, n-m, 1 + mld = ibits( state%val(i+1), 0, 31 ) + call mvbits( state%val(i), 31, 1, mld, 31 ) + state%val(i) = ieor( state%val(i+m), ishft( mld, -1 ) ) + if ( btest( state%val(i+1), 0 ) ) state%val(i) = ieor( state%val(i), matrix_a ) + end do + do i = n-m+1, n-1, 1 + mld = ibits( state%val(i+1), 0, 31 ) + call mvbits( state%val(i), 31, 1, mld, 31 ) + state%val(i) = ieor( state%val(i+m-n), ishft( mld, -1 ) ) + if ( btest( state%val(i+1), 0 ) ) state%val(i) = ieor( state%val(i), matrix_a ) + end do + mld = ibits( state%val(1), 0, 31 ) + call mvbits( state%val(n), 31, 1, mld, 31 ) + state%val(n) = ieor( state%val(m), ishft( mld, -1 ) ) + if ( btest( state%val(1), 0 ) ) state%val(n) = ieor( state%val(n), matrix_a ) + state%cnt = 1_wi + return + + end subroutine next_state + + elemental subroutine genrand_encode( chr, val ) + + intrinsic :: len + + character(len=*), intent(out) :: chr + integer(kind=wi), intent(in ) :: val + + integer(kind=wi) :: i, m, d + + d = val + chr = "" + do i = 1, len( chr ), 1 + m = uimod( d, alps ) + 1 + chr(i:i) = alph(m:m) + d = uidiv( d, alps ) + if ( d == 0 ) exit + end do + return + + end subroutine genrand_encode + + elemental subroutine genrand_decode( val, chr ) + + intrinsic :: len, len_trim, trim, adjustl, scan + + integer(kind=wi), intent(out) :: val + character(len=*), intent(in ) :: chr + + integer(kind=wi) :: i, e, p + character(len=len(chr)) :: c + + e = 1 + c = trim( adjustl( chr ) ) + val = 0 + do i = 1, len_trim( c ), 1 + p = scan( alph, c(i:i) ) - 1 + if( p >= 0 ) then + val = uiadd( val, uimlt( p, e ) ) + e = uimlt( e, alps ) + end if + end do + return + + end subroutine genrand_decode + + elemental subroutine genrand_load_state( stt, rpr ) + + intrinsic :: scan + + type(genrand_state), intent(out) :: stt + type(genrand_srepr), intent(in ) :: rpr + + integer(kind=wi) :: i, j + character(len=clen) :: c + + i = 1 + c = rpr%repr + do + j = scan( c, sepr ) + if ( j /= 0 ) then + call genrand_decode( stt%val(i), c(:j-1) ) + i = i + 1 + c = c(j+1:) + else + exit + end if + end do + call genrand_decode( stt%cnt, c ) + stt%ini = .true._wi + return + + end subroutine genrand_load_state + + elemental subroutine genrand_dump_state( rpr, stt ) + + intrinsic :: len_trim + + type(genrand_srepr), intent(out) :: rpr + type(genrand_state), intent(in ) :: stt + + integer(kind=wi) :: i, j + + j = 1 + rpr%repr = "" + do i = 1, n, 1 + call genrand_encode( rpr%repr(j:), stt%val(i) ) + j = len_trim( rpr%repr ) + 1 + rpr%repr(j:j) = sepr + j = j + 1 + end do + call genrand_encode( rpr%repr(j:), stt%cnt ) + return + + end subroutine genrand_dump_state + + ! generates a random number on [0,0xffffffff]-interval + subroutine genrand_int32_0d( y ) + + intrinsic :: ieor, iand, ishft + + integer(kind=wi), parameter :: temper_a = -1658038656_wi !z'9D2C5680' + integer(kind=wi), parameter :: temper_b = -272236544_wi !z'EFC60000' + + integer(kind=wi), intent(out) :: y + + if ( state%cnt > n ) call next_state( ) + y = state%val(state%cnt) + state%cnt = state%cnt + 1_wi + ! Tempering + y = ieor( y, ishft( y, -11 ) ) + y = ieor( y, iand( ishft( y, 7 ), temper_a ) ) + y = ieor( y, iand( ishft( y, 15 ), temper_b ) ) + y = ieor( y, ishft( y, -18 ) ) + return + + end subroutine genrand_int32_0d + + subroutine genrand_int32_1d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 1 ), 1 + call genrand_int32_0d( y(i) ) + end do + return + + end subroutine genrand_int32_1d + + subroutine genrand_int32_2d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 2 ), 1 + call genrand_int32_1d( y(:,i) ) + end do + return + + end subroutine genrand_int32_2d + + subroutine genrand_int32_3d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 3 ), 1 + call genrand_int32_2d( y(:,:,i) ) + end do + return + + end subroutine genrand_int32_3d + + subroutine genrand_int32_4d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 4 ), 1 + call genrand_int32_3d( y(:,:,:,i) ) + end do + return + + end subroutine genrand_int32_4d + + subroutine genrand_int32_5d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 5 ), 1 + call genrand_int32_4d( y(:,:,:,:,i) ) + end do + return + + end subroutine genrand_int32_5d + + subroutine genrand_int32_6d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 6 ), 1 + call genrand_int32_5d( y(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_int32_6d + + subroutine genrand_int32_7d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 7 ), 1 + call genrand_int32_6d( y(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_int32_7d + + ! generates a random number on [0,0x7fffffff]-interval + subroutine genrand_int31_0d( y ) + + intrinsic :: ishft + + integer(kind=wi), intent(out) :: y + + call genrand_int32_0d( y ) + y = ishft( y, -1 ) + return + + end subroutine genrand_int31_0d + + subroutine genrand_int31_1d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 1 ), 1 + call genrand_int31_0d( y(i) ) + end do + return + + end subroutine genrand_int31_1d + + subroutine genrand_int31_2d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 2 ), 1 + call genrand_int31_1d( y(:,i) ) + end do + return + + end subroutine genrand_int31_2d + + subroutine genrand_int31_3d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 3 ), 1 + call genrand_int31_2d( y(:,:,i) ) + end do + return + + end subroutine genrand_int31_3d + + subroutine genrand_int31_4d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 4 ), 1 + call genrand_int31_3d( y(:,:,:,i) ) + end do + return + + end subroutine genrand_int31_4d + + subroutine genrand_int31_5d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 5 ), 1 + call genrand_int31_4d( y(:,:,:,:,i) ) + end do + return + + end subroutine genrand_int31_5d + + subroutine genrand_int31_6d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 6 ), 1 + call genrand_int31_5d( y(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_int31_6d + + subroutine genrand_int31_7d( y ) + + intrinsic :: size + + integer(kind=wi), dimension(:,:,:,:,:,:,:), intent(out) :: y + + integer(kind=wi) :: i + + do i = 1, size( y, 7 ), 1 + call genrand_int31_6d( y(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_int31_7d + + ! generates a random number on [0,1]-real-interval + subroutine genrand_real1_0d( r ) + + intrinsic :: real + + real(kind=wr), intent(out) :: r + + integer(kind=wi) :: a + + call genrand_int32_0d( a ) + r = real( a, kind=wr ) * pi232_1 + p231d232_1 + ! divided by 2^32-1 + return + + end subroutine genrand_real1_0d + + subroutine genrand_real1_1d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 1 ), 1 + call genrand_real1_0d( r(i) ) + end do + return + + end subroutine genrand_real1_1d + + subroutine genrand_real1_2d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 2 ), 1 + call genrand_real1_1d( r(:,i) ) + end do + return + + end subroutine genrand_real1_2d + + subroutine genrand_real1_3d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 3 ), 1 + call genrand_real1_2d( r(:,:,i) ) + end do + return + + end subroutine genrand_real1_3d + + subroutine genrand_real1_4d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 4 ), 1 + call genrand_real1_3d( r(:,:,:,i) ) + end do + return + + end subroutine genrand_real1_4d + + subroutine genrand_real1_5d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 5 ), 1 + call genrand_real1_4d( r(:,:,:,:,i) ) + end do + return + + end subroutine genrand_real1_5d + + subroutine genrand_real1_6d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 6 ), 1 + call genrand_real1_5d( r(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real1_6d + + subroutine genrand_real1_7d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 7 ), 1 + call genrand_real1_6d( r(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real1_7d + + ! generates a random number on [0,1)-real-interval + subroutine genrand_real2_0d( r ) + + intrinsic :: real + + real(kind=wr), intent(out) :: r + + integer(kind=wi) :: a + + call genrand_int32_0d( a ) + r = real( a, kind=wr ) * pi232 + 0.5_wr + ! divided by 2^32 + return + + end subroutine genrand_real2_0d + + subroutine genrand_real2_1d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 1 ), 1 + call genrand_real2_0d( r(i) ) + end do + return + + end subroutine genrand_real2_1d + + subroutine genrand_real2_2d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 2 ), 1 + call genrand_real2_1d( r(:,i) ) + end do + return + + end subroutine genrand_real2_2d + + subroutine genrand_real2_3d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 3 ), 1 + call genrand_real2_2d( r(:,:,i) ) + end do + return + + end subroutine genrand_real2_3d + + subroutine genrand_real2_4d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 4 ), 1 + call genrand_real2_3d( r(:,:,:,i) ) + end do + return + + end subroutine genrand_real2_4d + + subroutine genrand_real2_5d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 5 ), 1 + call genrand_real2_4d( r(:,:,:,:,i) ) + end do + return + + end subroutine genrand_real2_5d + + subroutine genrand_real2_6d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 6 ), 1 + call genrand_real2_5d( r(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real2_6d + + subroutine genrand_real2_7d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 7 ), 1 + call genrand_real2_6d( r(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real2_7d + + ! generates a random number on (0,1)-real-interval + subroutine genrand_real3_0d( r ) + + intrinsic :: real + + real(kind=wr), intent(out) :: r + + integer(kind=wi) :: a + + call genrand_int32_0d( a ) + r = real( a, kind=wr ) * pi232 + p231_5d232 + ! divided by 2^32 + return + + end subroutine genrand_real3_0d + + subroutine genrand_real3_1d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 1 ), 1 + call genrand_real3_0d( r(i) ) + end do + return + + end subroutine genrand_real3_1d + + subroutine genrand_real3_2d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 2 ), 1 + call genrand_real3_1d( r(:,i) ) + end do + return + + end subroutine genrand_real3_2d + + subroutine genrand_real3_3d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 3 ), 1 + call genrand_real3_2d( r(:,:,i) ) + end do + return + + end subroutine genrand_real3_3d + + subroutine genrand_real3_4d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 4 ), 1 + call genrand_real3_3d( r(:,:,:,i) ) + end do + return + + end subroutine genrand_real3_4d + + subroutine genrand_real3_5d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 5 ), 1 + call genrand_real3_4d( r(:,:,:,:,i) ) + end do + return + + end subroutine genrand_real3_5d + + subroutine genrand_real3_6d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 6 ), 1 + call genrand_real3_5d( r(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real3_6d + + subroutine genrand_real3_7d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 7 ), 1 + call genrand_real3_6d( r(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_real3_7d + + ! generates a random number on [0,1) with 53-bit resolution + subroutine genrand_res53_0d( r ) + + intrinsic :: ishft, real + + real(kind=wr), intent(out) :: r + + integer(kind=wi) :: a, b + + call genrand_int32_0d( a ) + call genrand_int32_0d( b ) + a = ishft( a, -5 ) + b = ishft( b, -6 ) + r = real( a, kind=wr ) * pi227 + real( b, kind=wr ) * pi253 + return + + end subroutine genrand_res53_0d + + subroutine genrand_res53_1d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 1 ), 1 + call genrand_res53_0d( r(i) ) + end do + return + + end subroutine genrand_res53_1d + + subroutine genrand_res53_2d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 2 ), 1 + call genrand_res53_1d( r(:,i) ) + end do + return + + end subroutine genrand_res53_2d + + subroutine genrand_res53_3d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 3 ), 1 + call genrand_res53_2d( r(:,:,i) ) + end do + return + + end subroutine genrand_res53_3d + + subroutine genrand_res53_4d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 4 ), 1 + call genrand_res53_3d( r(:,:,:,i) ) + end do + return + + end subroutine genrand_res53_4d + + subroutine genrand_res53_5d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 5 ), 1 + call genrand_res53_4d( r(:,:,:,:,i) ) + end do + return + + end subroutine genrand_res53_5d + + subroutine genrand_res53_6d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 6 ), 1 + call genrand_res53_5d( r(:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_res53_6d + + subroutine genrand_res53_7d( r ) + + intrinsic :: size + + real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r + + integer(kind=wi) :: i + + do i = 1, size( r, 7 ), 1 + call genrand_res53_6d( r(:,:,:,:,:,:,i) ) + end do + return + + end subroutine genrand_res53_7d + ! These real versions are due to Isaku Wada, 2002/01/09 added + ! Altered by José Sousa genrand_real[1-3] will not return exactely + ! the same values but should have the same properties and are faster + +end module crmx_mt95 + diff --git a/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 b/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 new file mode 100644 index 0000000000..c6650f4a99 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 @@ -0,0 +1,1072 @@ +!------------------------------------------------------------------------ +! $Id: numerical_check.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_numerical_check + + implicit none + +! Made is_nan_2d public so it may be used +! for finding code that cause NaNs +! Joshua Fasching November 2007 + +! *_check subroutines were added to ensure that the +! subroutines they are checking perform correctly +! Joshua Fasching February 2008 + +! rad_clipping has been replaced by rad_check as the new +! subroutine only reports if there are invalid values. +! Joshua Fasching March 2008 + + private ! Default scope + + public :: invalid_model_arrays, is_nan_2d, & + rad_check, parameterization_check, & + surface_varnce_check, pdf_closure_check, & + length_check, is_nan_sclr, calculate_spurious_source + + private :: check_negative, check_nan + + + ! Abstraction of check_nan + interface check_nan + module procedure check_nan_sclr, check_nan_2d + end interface + + ! Abstraction of check_negative + interface check_negative + module procedure check_negative_total, check_negative_index + end interface + + + contains +!--------------------------------------------------------------------------------- + subroutine length_check( Lscale, Lscale_up, Lscale_down, err_code ) +! +! Description: This subroutine determines if any of the output +! variables for the length_new subroutine carry values that +! are NaNs. +! +! Joshua Fasching February 2008 +!--------------------------------------------------------------------------------- + use crmx_grid_class, only: & + gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant Parameters + character(*), parameter :: proc_name = "compute_length" + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + Lscale, & ! Mixing length [m] + Lscale_up, & ! Upward mixing length [m] + Lscale_down ! Downward mixing length [m] + + ! Output Variable + integer, intent(inout) :: & + err_code + +!----------------------------------------------------------------------------- + + call check_nan( Lscale, "Lscale", proc_name, err_code ) + call check_nan( Lscale_up, "Lscale_up", proc_name, err_code ) + call check_nan( Lscale_down, "Lscale_down", proc_name, err_code ) + + return + end subroutine length_check + +!--------------------------------------------------------------------------- + subroutine pdf_closure_check( wp4, wprtp2, wp2rtp, wpthlp2, & + wp2thlp, cloud_frac, rcm, wpthvp, wp2thvp, & + rtpthvp, thlpthvp, wprcp, wp2rcp, & + rtprcp, thlprcp, rcp2, wprtpthlp, & + crt1, crt2, cthl1, cthl2, pdf_params, & + err_code, & + sclrpthvp, sclrprcp, wpsclrp2, & + wpsclrprtp, wpsclrpthlp, wp2sclrp ) + +! Description: This subroutine determines if any of the output +! variables for the pdf_closure subroutine carry values that +! are NaNs. +! +! Joshua Fasching February 2008 +!--------------------------------------------------------------------------- + + use crmx_parameters_model, only: & + sclr_dim ! Variable + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! type + + use crmx_stats_variables, only: & + iwp4, & ! Variables + ircp2, & + iwprtp2, & + iwprtpthlp, & + iwpthlp2 + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Parameter Constants + character(len=*), parameter :: proc_name = & + "pdf_closure" + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + wp4, & ! w'^4 [m^4/s^4] + wprtp2, & ! w' r_t' [(m kg)/(s kg)] + wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)] + wpthlp2, & ! w' th_l'^2 [(m K^2)/s] + wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2] + cloud_frac, & ! Cloud fraction [-] + rcm, & ! Mean liquid water [kg/kg] + wpthvp, & ! Buoyancy flux [(K m)/s] + wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2] + rtpthvp, & ! r_t' th_v' [(kg K)/kg] + thlpthvp, & ! th_l' th_v' [K^2] + wprcp, & ! w' r_c' [(m kg)/(s kg)] + wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)] + rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)] + thlprcp, & ! th_l' r_c' [(K kg)/kg] + rcp2, & ! r_c'^2 [(kg^2)/(kg^2)] + wprtpthlp, & ! w' r_t' th_l' [(m kg K)/(s kg)] + crt1, crt2, & + cthl1, cthl2 + + type(pdf_parameter), intent(in) :: & + pdf_params ! PDF parameters [units vary] + + ! Input (Optional passive scalar variables) + real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & + sclrpthvp, & + sclrprcp, & + wpsclrp2, & + wpsclrprtp, & + wpsclrpthlp, & + wp2sclrp + + ! Output Variable + integer, intent(inout) :: & + err_code ! Returns appropriate error code + +!------------------------------------------------------------------------------- + + ! ---- Begin Code ---- + + if ( iwp4 > 0 ) call check_nan( wp4,"wp4", proc_name, err_code ) + if ( iwprtp2 > 0 ) call check_nan( wprtp2,"wprtp2", proc_name, err_code ) + call check_nan( wp2rtp,"wp2rtp", proc_name, err_code ) + if ( iwpthlp2 > 0 ) call check_nan( wpthlp2,"wpthlp2", proc_name, err_code ) + call check_nan( wp2thlp,"wp2thlp", proc_name, err_code ) + call check_nan( cloud_frac,"cloud_frac", proc_name, err_code ) + call check_nan( rcm,"rcm", proc_name, err_code ) + call check_nan( wpthvp, "wpthvp", proc_name, err_code ) + call check_nan( wp2thvp, "wp2thvp", proc_name, err_code ) + call check_nan( rtpthvp, "rtpthvp", proc_name, err_code ) + call check_nan( thlpthvp, "thlpthvp", proc_name, err_code ) + call check_nan( wprcp, "wprcp", proc_name, err_code ) + call check_nan( wp2rcp, "wp2rcp", proc_name, err_code ) + call check_nan( rtprcp, "rtprcp", proc_name, err_code ) + call check_nan( thlprcp, "thlprcp", proc_name, err_code ) + if ( ircp2 > 0 ) call check_nan( rcp2, "rcp2", proc_name, err_code) + if ( iwprtpthlp > 0 ) call check_nan( wprtpthlp, "wprtpthlp", proc_name, err_code ) + call check_nan( crt1, "crt1", proc_name, err_code ) + call check_nan( crt2, "crt2", proc_name, err_code ) + call check_nan( cthl1, "cthl1", proc_name, err_code ) + call check_nan( cthl2, "cthl2", proc_name, err_code ) + ! Check each PDF parameter at the grid level sent in. + call check_nan( pdf_params%w1, "pdf_params%w1", proc_name, err_code ) + call check_nan( pdf_params%w2, "pdf_params%w2", proc_name, err_code ) + call check_nan( pdf_params%varnce_w1, "pdf_params%varnce_w1", proc_name, err_code ) + call check_nan( pdf_params%varnce_w2, "pdf_params%varnce_w2", proc_name, err_code ) + call check_nan( pdf_params%rt1, "pdf_params%rt1", proc_name, err_code ) + call check_nan( pdf_params%rt2, "pdf_params%rt2", proc_name, err_code ) + call check_nan( pdf_params%varnce_rt1, "pdf_params%varnce_rt1", proc_name, err_code ) + call check_nan( pdf_params%varnce_rt2, "pdf_params%varnce_rt2", proc_name, err_code ) + call check_nan( pdf_params%thl1, "pdf_params%thl1", proc_name, err_code ) + call check_nan( pdf_params%thl2, "pdf_params%thl2", proc_name, err_code ) + call check_nan( pdf_params%varnce_thl1, "pdf_params%varnce_thl1", proc_name, err_code ) + call check_nan( pdf_params%varnce_thl2, "pdf_params%varnce_thl2", proc_name, err_code ) + call check_nan( pdf_params%mixt_frac, "pdf_params%mixt_frac", proc_name, err_code ) + call check_nan( pdf_params%rrtthl, "pdf_params%rrtthl", proc_name, err_code ) + call check_nan( pdf_params%rc1, "pdf_params%rc1", proc_name, err_code ) + call check_nan( pdf_params%rc2, "pdf_params%rc2", proc_name, err_code ) + call check_nan( pdf_params%rsl1, "pdf_params%rsl1", proc_name, err_code ) + call check_nan( pdf_params%rsl2, "pdf_params%rsl2", proc_name, err_code ) + call check_nan( pdf_params%cloud_frac1, "pdf_params%cloud_frac1", proc_name, err_code ) + call check_nan( pdf_params%cloud_frac2, "pdf_params%cloud_frac2", proc_name, err_code ) + call check_nan( pdf_params%s1, "pdf_params%s1", proc_name, err_code ) + call check_nan( pdf_params%s2, "pdf_params%s2", proc_name, err_code ) + call check_nan( pdf_params%stdev_s1, "pdf_params%stdev_s1", proc_name, err_code ) + call check_nan( pdf_params%stdev_s2, "pdf_params%stdev_s2", proc_name, err_code ) + call check_nan( pdf_params%alpha_thl, "pdf_params%alpha_thl", proc_name, err_code ) + call check_nan( pdf_params%alpha_rt, "pdf_params%alpha_rt", proc_name, err_code ) + + if ( sclr_dim > 0 ) then + call check_nan( sclrpthvp,"sclrpthvp", & + proc_name, err_code) + call check_nan( sclrprcp, "sclrprcp", & + proc_name, err_code ) + call check_nan( wpsclrprtp, "wpsclrprtp", & + proc_name, err_code ) + call check_nan( wpsclrp2, "wpsclrp2", & + proc_name, err_code ) + call check_nan( wpsclrpthlp, "wpsclrtlp", & + proc_name, err_code ) + call check_nan( wp2sclrp, "wp2sclrp", & + proc_name, err_code ) + end if + + return + end subroutine pdf_closure_check + +!------------------------------------------------------------------------------- + subroutine parameterization_check & + ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & + wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + um, upwp, vm, vpwp, up2, vp2, & + rtm, wprtp, thlm, wpthlp, & + wp2, wp3, rtp2, thlp2, rtpthlp, & + prefix, & + wpsclrp_sfc, wpedsclrp_sfc, & + sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & + sclrm_forcing, edsclrm, edsclrm_forcing, err_code ) +! +! Description: +! This subroutine determines what input variables may have NaN values. +! In addition it checks to see if rho_zm, rho, exner, up2, vp2, rtm, thlm, +! wp2, rtp2, thlp2, or tau_zm have negative values. +!------------------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable + edsclr_dim + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant Parameters + ! Name of the procedure using parameterization_check + character(len=25), parameter :: & + proc_name = "parameterization_timestep" + + ! Input variables + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] + vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + wm_zm, & ! w mean wind component on momentum levels [m/s] + wm_zt, & ! w mean wind component on thermo. levels [m/s] + p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho, & ! Air density on thermodynamic levels [kg/m^3] + exner, & ! Exner function (thermodynamic levels) [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] + + real( kind = core_rknd ), intent(in) :: & + wpthlp_sfc, & ! w' theta_l' at surface. [(m K)/s] + wprtp_sfc, & ! w' r_t' at surface. [(kg m)/( kg s)] + upwp_sfc, & ! u'w' at surface. [m^2/s^2] + vpwp_sfc ! v'w' at surface. [m^2/s^2] + + ! These are prognostic or are planned to be in the future + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + um, & ! u mean wind component (thermodynamic levels) [m/s] + upwp, & ! u'w' (momentum levels) [m^2/s^2] + vm, & ! v mean wind component (thermodynamic levels) [m/s] + vpwp, & ! v'w' (momentum levels) [m^2/s^2] + up2, & ! u'^2 (momentum levels) [m^2/s^2] + vp2, & ! v'^2 (momentum levels) [m^2/s^2] + rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg] + wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s] + thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K] + wpthlp, & ! w' th_l' (momentum levels) [(m/s) K] + rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] + thlp2, & ! th_l'^2 (momentum levels) [K^2] + rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K] + wp2, & ! w'^2 (momentum levels) [m^2/s^2] + wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] + + character(len=*), intent(in) :: prefix ! Location where subroutine is called + + real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & + wpsclrp_sfc ! Scalar flux at surface [units m/s] + + real( kind = core_rknd ), intent(in), dimension(edsclr_dim) :: & + wpedsclrp_sfc ! Eddy-Scalar flux at surface [units m/s] + + real( kind = core_rknd ), intent(in),dimension(gr%nz,sclr_dim) :: & + sclrm, & ! Passive scalar mean [units vary] + wpsclrp, & ! w'sclr' [units vary] + sclrp2, & ! sclr'^2 [units vary] + sclrprtp, & ! sclr'rt' [units vary] + sclrpthlp, & ! sclr'thl' [units vary] + sclrm_forcing ! Passive scalar forcing [units / s] + + real( kind = core_rknd ), intent(in),dimension(gr%nz,edsclr_dim) :: & + edsclrm, & ! Eddy passive scalar mean [units vary] + edsclrm_forcing ! Eddy passive scalar forcing [units / s] + + ! In / Out Variables + integer, intent(inout) :: & + err_code ! Error code + + ! Local Variables + integer :: i ! Loop iterator for the scalars + +!-------- Input Nan Check ---------------------------------------------- + + call check_nan( thlm_forcing, "thlm_forcing", prefix//proc_name, err_code) + call check_nan( rtm_forcing,"rtm_forcing", prefix//proc_name, err_code ) + call check_nan( um_forcing,"um_forcing", prefix//proc_name, err_code ) + call check_nan( vm_forcing,"vm_forcing", prefix//proc_name, err_code ) + + call check_nan( wm_zm, "wm_zm", prefix//proc_name, err_code ) + call check_nan( wm_zt, "wm_zt", prefix//proc_name, err_code ) + call check_nan( p_in_Pa, "p_in_Pa", prefix//proc_name, err_code ) + call check_nan( rho_zm, "rho_zm", prefix//proc_name, err_code ) + call check_nan( rho, "rho", prefix//proc_name, err_code ) + call check_nan( exner, "exner", prefix//proc_name, err_code ) + call check_nan( rho_ds_zm, "rho_ds_zm", prefix//proc_name, err_code ) + call check_nan( rho_ds_zt, "rho_ds_zt", prefix//proc_name, err_code ) + call check_nan( invrs_rho_ds_zm, "invrs_rho_ds_zm", prefix//proc_name, err_code ) + call check_nan( invrs_rho_ds_zt, "invrs_rho_ds_zt", prefix//proc_name, err_code ) + call check_nan( thv_ds_zm, "thv_ds_zm", prefix//proc_name, err_code ) + call check_nan( thv_ds_zt, "thv_ds_zt", prefix//proc_name, err_code ) + + call check_nan( um, "um", prefix//proc_name, err_code ) + call check_nan( upwp, "upwp", prefix//proc_name, err_code ) + call check_nan( vm, "vm", prefix//proc_name, err_code ) + call check_nan( vpwp, "vpwp", prefix//proc_name, err_code ) + call check_nan( up2, "up2", prefix//proc_name, err_code ) + call check_nan( vp2, "vp2", prefix//proc_name, err_code ) + call check_nan( rtm, "rtm", prefix//proc_name, err_code ) + call check_nan( wprtp, "wprtp", prefix//proc_name, err_code ) + call check_nan( thlm, "thlm", prefix//proc_name, err_code ) + call check_nan( wpthlp, "wpthlp", prefix//proc_name, err_code ) + call check_nan( wp2, "wp2", prefix//proc_name, err_code ) + call check_nan( wp3, "wp3", prefix//proc_name, err_code ) + call check_nan( rtp2, "rtp2", prefix//proc_name, err_code ) + call check_nan( thlp2, "thlp2", prefix//proc_name, err_code ) + call check_nan( rtpthlp, "rtpthlp", prefix//proc_name, err_code ) + + call check_nan( wpthlp_sfc, "wpthlp_sfc", prefix//proc_name, err_code ) + call check_nan( wprtp_sfc, "wprtp_sfc", prefix//proc_name, err_code ) + call check_nan( upwp_sfc, "upwp_sfc", prefix//proc_name, err_code ) + call check_nan( vpwp_sfc, "vpwp_sfc", prefix//proc_name, err_code ) + + do i = 1, sclr_dim + + call check_nan( sclrm_forcing(:,i),"sclrm_forcing", & + prefix//proc_name, err_code ) + + call check_nan( wpsclrp_sfc(i),"wpsclrp_sfc", & + prefix//proc_name, err_code ) + + call check_nan( sclrm(:,i),"sclrm", prefix//proc_name, err_code ) + call check_nan( wpsclrp(:,i),"wpsclrp", prefix//proc_name, err_code ) + call check_nan( sclrp2(:,i),"sclrp2", prefix//proc_name, err_code ) + call check_nan( sclrprtp(:,i),"sclrprtp", prefix//proc_name, err_code ) + call check_nan( sclrpthlp(:,i),"sclrpthlp", prefix//proc_name, err_code ) + + end do + + + do i = 1, edsclr_dim + + call check_nan( edsclrm_forcing(:,i),"edsclrm_forcing", prefix//proc_name, err_code ) + + call check_nan( wpedsclrp_sfc(i),"wpedsclrp_sfc", & + prefix//proc_name, err_code ) + + call check_nan( edsclrm(:,i),"edsclrm", prefix//proc_name, err_code ) + + enddo + +!--------------------------------------------------------------------- + + + call check_negative( rtm, gr%nz ,"rtm", prefix//proc_name, err_code ) + call check_negative( p_in_Pa, gr%nz ,"p_in_Pa", prefix//proc_name, err_code ) + call check_negative( rho, gr%nz ,"rho", prefix//proc_name, err_code ) + call check_negative( rho_zm, gr%nz ,"rho_zm", prefix//proc_name, err_code ) + call check_negative( exner, gr%nz ,"exner", prefix//proc_name, err_code ) + call check_negative( rho_ds_zm, gr%nz ,"rho_ds_zm", prefix//proc_name, err_code ) + call check_negative( rho_ds_zt, gr%nz ,"rho_ds_zt", prefix//proc_name, err_code ) + call check_negative( invrs_rho_ds_zm, gr%nz ,"invrs_rho_ds_zm", & + prefix//proc_name, err_code ) + call check_negative( invrs_rho_ds_zt, gr%nz ,"invrs_rho_ds_zt", & + prefix//proc_name, err_code ) + call check_negative( thv_ds_zm, gr%nz ,"thv_ds_zm", prefix//proc_name, err_code ) + call check_negative( thv_ds_zt, gr%nz ,"thv_ds_zt", prefix//proc_name, err_code ) + call check_negative( up2, gr%nz ,"up2", prefix//proc_name, err_code ) + call check_negative( vp2, gr%nz ,"vp2", prefix//proc_name, err_code ) + call check_negative( wp2, gr%nz ,"wp2", prefix//proc_name, err_code ) + call check_negative( rtm, gr%nz ,"rtm", prefix//proc_name, err_code ) + call check_negative( thlm, gr%nz ,"thlm", prefix//proc_name, err_code ) + call check_negative( rtp2, gr%nz ,"rtp2", prefix//proc_name, err_code ) + call check_negative( thlp2, gr%nz ,"thlp2", prefix//proc_name, err_code ) + + return + end subroutine parameterization_check + +!----------------------------------------------------------------------- + subroutine surface_varnce_check( wp2_sfc, up2_sfc, vp2_sfc, thlp2_sfc, & + rtp2_sfc, rtpthlp_sfc, err_code, & + sclrp2_sfc, sclrprtp_sfc, sclrpthlp_sfc ) +! +! Description:This subroutine determines if any of the output +! variables for the surface_varnce subroutine carry values that +! are nans. +! +! Joshua Fasching February 2008 +! +! +!----------------------------------------------------------------------- + use crmx_parameters_model, only: & + sclr_dim ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant Parameters + ! Name of the subroutine calling the check + character(len=*), parameter :: & + proc_name = "surface_varnce" + + ! Input Variables + real( kind = core_rknd ),intent(in) :: & + wp2_sfc, & ! Vertical velocity variance [m^2/s^2] + up2_sfc, & ! u'^2 [m^2/s^2] + vp2_sfc, & ! u'^2 [m^2/s^2] + thlp2_sfc, & ! thetal variance [K^2] + rtp2_sfc, & ! rt variance [(kg/kg)^2] + rtpthlp_sfc ! thetal rt covariance [kg K/kg] + + + real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & + sclrp2_sfc, & ! Passive scalar variance [units^2] + sclrprtp_sfc, & ! Passive scalar r_t covariance [units kg/kg] + sclrpthlp_sfc ! Passive scalar theta_l covariance [units K] + + ! Input/Output Variable + integer, intent(inout) :: err_code ! Are these outputs valid? + +!----------------------------------------------------------------------- + + ! ---- Begin Code ---- + + call check_nan( wp2_sfc, "wp2_sfc", proc_name, err_code) + call check_nan( up2_sfc, "up2_sfc", proc_name, err_code) + call check_nan( vp2_sfc, "vp2_sfc", proc_name, err_code) + call check_nan( thlp2_sfc, "thlp2_sfc", proc_name, err_code) + call check_nan( rtp2_sfc, "rtp2_sfc", proc_name, err_code) + call check_nan( rtpthlp_sfc, "rtpthlp_sfc", & + proc_name, err_code) + + if ( sclr_dim > 0 ) then + call check_nan( sclrp2_sfc, "sclrp2_sfc", & + proc_name, err_code ) + + call check_nan( sclrprtp_sfc, "sclrprtp_sfc", & + proc_name, err_code ) + + call check_nan( sclrpthlp_sfc, "sclrpthlp_sfc", & + proc_name, err_code ) + end if + + return + end subroutine surface_varnce_check + +!----------------------------------------------------------------------- + subroutine rad_check( thlm, rcm, rtm, ricem, & + cloud_frac, p_in_Pa, exner, rho_zm ) +! Description: +! Checks radiation input variables. If they are < 0 it reports +! to the console. +!------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + fstderr ! Variable + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant Parameters + character(len=*), parameter :: & + proc_name = "Before BUGSrad." + + ! Input/Output variables + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + thlm, & ! Liquid Water Potential Temperature [K/s] + rcm, & ! Liquid Water Mixing Ratio [kg/kg] + rtm, & ! Total Water Mixing Ratio [kg/kg] + ricem, & ! Ice Water Mixing Ratio [kg/kg] + cloud_frac, & ! Cloud Fraction [-] + p_in_Pa, & ! Pressure [Pa] + exner, & ! Exner Function [-] + rho_zm ! Air Density [kg/m^3] + + ! Local variables + real( kind = core_rknd ),dimension(gr%nz) :: rvm + +!------------------------------------------------------------------------- + + rvm = rtm - rcm + + call check_negative( thlm, gr%nz ,"thlm", proc_name ) + call check_negative( rcm, gr%nz ,"rcm", proc_name ) + call check_negative( rtm, gr%nz ,"rtm", proc_name ) + call check_negative( rvm, gr%nz ,"rvm", proc_name ) + call check_negative( ricem, gr%nz ,"ricem", proc_name ) + call check_negative( cloud_frac, gr%nz ,"cloud_frac", proc_name ) + call check_negative( p_in_Pa, gr%nz ,"p_in_Pa", proc_name ) + call check_negative( exner, gr%nz ,"exner", proc_name ) + call check_negative( rho_zm, gr%nz ,"rho_zm", proc_name ) + + return + + end subroutine rad_check + +!----------------------------------------------------------------------- + logical function invalid_model_arrays( ) + +! Description: +! Checks for invalid floating point values in select model arrays. + +! References: +! None +!------------------------------------------------------------------------ + + use crmx_variables_diagnostic_module, only: & + hydromet, & ! Variable(s) + wp2thvp, & + rtpthvp, & + thlpthvp + + use crmx_variables_prognostic_module, only: & + um, & ! Variable(s) + vm, & + wp2, & + wp3, & + rtm, & + thlm, & + rtp2, & + thlp2, & + wprtp, & + wpthlp, & + rtpthlp, & + sclrm, & + edsclrm + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + edsclr_dim, & + hydromet_dim + + use crmx_parameters_microphys, only: & + hydromet_list ! Variable(s) + + implicit none + + ! Local Variables + integer :: i + + invalid_model_arrays = .false. + + ! Check whether any variable array contains a NaN for + ! um, vm, thlm, rtm, rtp2, thlp2, wprtp, wpthlp, rtpthlp, + ! wp2, & wp3. + if ( is_nan_2d( um ) ) then + write(fstderr,*) "NaN in um model array" +! write(fstderr,*) "um= ", um + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( vm ) ) then + write(fstderr,*) "NaN in vm model array" +! write(fstderr,*) "vm= ", vm + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( wp2 ) ) then + write(fstderr,*) "NaN in wp2 model array" +! write(fstderr,*) "wp2= ", wp2 + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( wp3 ) ) then + write(fstderr,*) "NaN in wp3 model array" +! write(fstderr,*) "wp3= ", wp3 + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( rtm ) ) then + write(fstderr,*) "NaN in rtm model array" +! write(fstderr,*) "rtm= ", rtm + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( thlm ) ) then + write(fstderr,*) "NaN in thlm model array" +! write(fstderr,*) "thlm= ", thlm + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( rtp2 ) ) then + write(fstderr,*) "NaN in rtp2 model array" +! write(fstderr,*) "rtp2= ", rtp2 + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( thlp2 ) ) then + write(fstderr,*) "NaN in thlp2 model array" +! write(fstderr,*) "thlp2= ", thlp2 + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( wprtp ) ) then + write(fstderr,*) "NaN in wprtp model array" +! write(fstderr,*) "wprtp= ", wprtp + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( wpthlp ) ) then + write(fstderr,*) "NaN in wpthlp model array" +! write(fstderr,*) "wpthlp= ", wpthlp + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( rtpthlp ) ) then + write(fstderr,*) "NaN in rtpthlp model array" +! write(fstderr,*) "rtpthlp= ", rtpthlp + invalid_model_arrays = .true. +! return + end if + + if ( hydromet_dim > 0 ) then + do i = 1, hydromet_dim, 1 + if ( is_nan_2d( hydromet(:,i) ) ) then + write(fstderr,*) "NaN in a hydrometeor model array "// & + trim( hydromet_list(i) ) +! write(fstderr,*) "hydromet= ", hydromet + invalid_model_arrays = .true. +! return + end if + end do + end if + +! if ( is_nan_2d( wm_zt ) ) then +! write(fstderr,*) "NaN in wm_zt model array" +! write(fstderr,*) "wm_zt= ", wm_zt +! invalid_model_arrays = .true. +! return +! end if + + if ( is_nan_2d( wp2thvp ) ) then + write(fstderr,*) "NaN in wp2thvp model array" +! write(fstderr,*) "wp2thvp = ", wp2thvp + invalid_model_arrays = .true. +! return + end if + + if ( is_nan_2d( rtpthvp ) ) then + write(fstderr,*) "NaN in rtpthvp model array" +! write(fstderr,*) "rtpthvp = ", rtpthvp + invalid_model_arrays = .true. + end if + + if ( is_nan_2d( thlpthvp ) ) then + write(fstderr,*) "NaN in thlpthvp model array" +! write(fstderr,*) "thlpthvp = ", thlpthvp + invalid_model_arrays = .true. + end if + + do i = 1, sclr_dim, 1 + if ( is_nan_2d( sclrm(:,i) ) ) then + write(fstderr,*) "NaN in sclrm", i, "model array" +! write(fstderr,'(a6,i2,a1)') "sclrm(", i, ")" +! write(fstderr,*) sclrm(:,i) + invalid_model_arrays = .true. + end if + end do + + do i = 1, edsclr_dim, 1 + if ( is_nan_2d( edsclrm(:,i) ) ) then + write(fstderr,*) "NaN in edsclrm", i, "model array" +! write(fstderr,'(a8,i2,a1)') "edsclrm(", i, ")" +! write(fstderr,*) edsclrm(:,i) + invalid_model_arrays = .true. + end if + end do + + return + end function invalid_model_arrays + +!------------------------------------------------------------------------ + logical function is_nan_sclr( xarg ) + +! Description: +! Checks if a given scalar real is a NaN, +inf or -inf. + +! Notes: +! I was advised by Andy Vaught to use a data statement and the transfer( ) +! intrinsic rather than using a hex number in a parameter for portability. + +! Certain compiler optimizations may cause variables with invalid +! results to flush to zero. Avoid these! +! -dschanen 16 Dec 2010 + +!------------------------------------------------------------------------ + +#ifndef __GFORTRAN__ + use crmx_parameters_model, only: & + PosInf ! Variable(s) +#endif + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: xarg + +#ifdef __GFORTRAN__ /* if the isnan extension is available, we use it here */ + is_nan_sclr = isnan( xarg ) +#else + ! ---- Begin Code --- + + ! This works on compilers with standardized floating point, + ! because the IEEE 754 spec defines that subnormals and nans + ! should not equal themselves. + ! However, all compilers do not seem to follow this. + if (xarg /= xarg ) then + is_nan_sclr = .true. + + ! This a second check, assuming the above does not work as + ! expected. + else if ( xarg == PosInf ) then + is_nan_sclr = .true. + + else + is_nan_sclr = .false. ! Our result should be a standard float + + end if +#endif + + return + end function is_nan_sclr +!------------------------------------------------------------------------ + +!------------------------------------------------------------------------ + logical function is_nan_2d( x2d ) + +! Description: +! Checks if a given real vector is a NaN, +inf or -inf. + +!------------------------------------------------------------------------ + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: any + + ! Input Variables + real( kind = core_rknd ), dimension(:), intent(in) :: x2d + + ! Local Variables + integer :: k + + ! ---- Begin Code ---- + + is_nan_2d = .false. + + do k = 1, size( x2d ) + if ( is_nan_sclr( x2d(k) ) ) then + is_nan_2d = .true. + exit + end if + end do + + return + + end function is_nan_2d + +!------------------------------------------------------------------------ + subroutine check_negative_total & + ( var, varname, operation, err_code ) +! +! Description: +! Checks for negative values in the var array and reports them. +! +!----------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_error_code, only: & + clubb_var_less_than_zero ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: any, present + + ! Input Variables + real( kind = core_rknd ), intent(in), dimension(:) :: var + + character(len=*), intent(in):: & + varname, & ! Varible being examined + operation ! Procedure calling check_zero + + ! Optional In/Out Variable + integer, optional, intent(inout) :: err_code + + if ( any( var < 0.0_core_rknd ) ) then + + write(fstderr,*) varname, " < 0 in ", operation + if ( present( err_code ) ) then + if (err_code < clubb_var_less_than_zero ) then + err_code = clubb_var_less_than_zero + end if + end if + + end if ! any ( var < 0 ) + + return + + end subroutine check_negative_total + + +!------------------------------------------------------------------------ + subroutine check_negative_index & + ( var, ndim, varname, operation, err_code ) +! +! Description: +! Checks for negative values in the var array and reports +! the index in which the negative values occur. +! +!----------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable + + use crmx_error_code, only: & + clubb_var_less_than_zero ! Variable + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: any, present + + ! Input Variables + integer, intent(in) :: ndim + + real( kind = core_rknd ), intent(in), dimension(ndim) :: var + + character(len=*), intent(in):: & + varname, & ! Varible being examined + operation ! Procedure calling check_zero + + ! Optional In/Out Variable + integer, optional, intent(inout) :: err_code + + ! Local Variable + integer :: k ! Loop iterator + + do k=1,ndim,1 + + if ( var(k) < 0.0_core_rknd ) then + + write(fstderr,*) varname, " < 0 in ", operation, & + " at k = ", k + + if ( present( err_code ) ) then + if (err_code < clubb_var_less_than_zero ) then + err_code = clubb_var_less_than_zero + end if + end if + + end if + + end do ! 1..n + + return + + end subroutine check_negative_index + + +!------------------------------------------------------------------------ + subroutine check_nan_2d( var, varname, operation, err_code ) +! +! Description: +! Checks for a NaN in the var array and reports it. +! +! +!------------------------------------------------------------------------ + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + use crmx_error_code, only: & + clubb_var_equals_NaN ! Variable(s) + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: present + + ! Input variables + real( kind = core_rknd ), intent(in), dimension(:) :: var ! Variable being examined + + character(len=*), intent(in):: & + varname, & ! Name of variable + operation ! Procedure calling check_nan + + ! Optional In/Out Variable + integer, optional, intent(inout) :: err_code + + if ( is_nan_2d( var ) ) then + write(fstderr,*) varname, " is NaN in ",operation + if ( present( err_code ) ) then + if( err_code < clubb_var_equals_NaN ) then + err_code = clubb_var_equals_NaN + end if + end if + end if + + return + end subroutine check_nan_2d + +!----------------------------------------------------------------------- + subroutine check_nan_sclr( var, varname, operation, err_code ) +! +! Description: +! Checks for a NaN in the scalar var then reports it. +! +!----------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr ! Variable + use crmx_error_code, only: & + clubb_var_equals_NaN ! Variable + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: present + + ! Input Variables + real( kind = core_rknd ), intent(in) :: var ! Variable being examined + + character(len=*), intent(in):: & + varname, & ! Name of variable being examined + operation ! Procedure calling check_nan + + ! Optional In/Out variable + integer, optional, intent(inout) :: err_code +!-------------------------------------------------------------------- + if ( is_nan_sclr( var ) ) then + write(fstderr,*) varname, " is NaN in ",operation + if ( present( err_code ) ) then + if( err_code < clubb_var_equals_NaN ) then + err_code = clubb_var_equals_NAN + end if + end if + end if + + return + + end subroutine check_nan_sclr +!------------------------------------------------------------------------- + +!----------------------------------------------------------------------- + pure function calculate_spurious_source( integral_after, integral_before, & + flux_top, flux_sfc, & + integral_forcing, dt ) & + result( spurious_source ) +! +! Description: +! Checks whether there is conservation within the column and returns any +! imbalance as spurious_source where spurious_source is defined negative +! for a spurious sink. +! +!----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + integral_after, & ! Vertically-integrated quantity after dt time [units vary] + integral_before, & ! Vertically-integrated quantity before dt time [units vary] + flux_top, & ! Total flux at the top of the domain [units vary] + flux_sfc, & ! Total flux at the bottom of the domain [units vary] + integral_forcing, & ! Vertically-integrated forcing [units vary] + dt ! Timestep size [s] + + ! Return Variable + real( kind = core_rknd ) :: spurious_source ! [units vary] + +!-------------------------------------------------------------------- + + ! ---- Begin Code ---- + + spurious_source = (integral_after - integral_before) / dt & + + flux_top - flux_sfc - integral_forcing + + return + + end function calculate_spurious_source +!------------------------------------------------------------------------- +end module crmx_numerical_check diff --git a/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 b/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 new file mode 100644 index 0000000000..af4f37e25c --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 @@ -0,0 +1,754 @@ +!------------------------------------------------------------------------------- +! $Id: output_grads.F90 5867 2012-07-03 21:06:44Z dschanen@uwm.edu $ +module crmx_output_grads + + +! Description: +! This module contains structure and subroutine definitions to +! create GrADS output data files for one dimensional arrays. +! +! The structure type (stat_file) contains all necessay information +! to generate a GrADS file and a list of variables to be output +! in the data file. +! +! References: +! None +! +! Original Author: +! Chris Golaz, updated 2/18/2003 +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + public :: open_grads, write_grads + + private :: format_date, check_grads, & + determine_time_inc + + ! Undefined value + real( kind = core_rknd ), private, parameter :: undef = -9.99e33_core_rknd + + private ! Default scope + + contains + +!------------------------------------------------------------------------------- + subroutine open_grads( iunit, fdir, fname, & + ia, iz, z, & + day, month, year, rlat, rlon, & + time, dtwrite, & + nvar, grads_file ) +! Description: +! Opens and initialize variable components for derived type 'grads_file' +! If the GrADS file already exists, open_grads will overwrite it. + +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + fstderr, & ! Variable + fstdout + + use crmx_stat_file_module, only: & + stat_file ! Type + + use crmx_clubb_precision, only: & + time_precision ! Variable + + implicit none + + ! Input Variables + + integer, intent(in) :: iunit ! File unit being written to [-] + + character(len=*), intent(in) :: & + fdir, & ! Directory where file is stored [-] + fname ! Name of file [-] + + integer, intent(in) :: & + ia, & ! Lower Bound of z [-] + iz ! Upper Bound of z [-] + + real( kind = core_rknd ), dimension(:), intent(in) :: z + + integer, intent(in) :: & + day, & ! Day of Month at Model Start [dd] + month, & ! Month of Year at Model start [mm] + year ! Year at Model Start [yyyy] + + real( kind = core_rknd ), dimension(1), intent(in) :: & + rlat, rlon ! Latitude and Longitude [Degrees N/E] + + real(kind=time_precision), intent(in) :: & + time, & ! Time since Model start [s] + dtwrite ! Time interval for output [s] + + ! Number of GrADS variables to store [#] + integer, intent(in) :: nvar + + ! Input/Output Variables + type (stat_file), intent(inout) :: & + grads_file ! File data [-] + + ! Local Variables + + integer :: k + logical :: l_ctl, l_dat, l_error + + ! ---- Begin Code ---- + + ! Define parameters for the GrADS ctl and dat files + + grads_file%iounit = iunit + grads_file%fdir = fdir + grads_file%fname = fname + grads_file%ia = ia + grads_file%iz = iz + + ! Determine if the altitudes are ascending or descending and setup the + ! variable z accordingly. + if ( ia <= iz ) then + do k=1,iz-ia+1 + grads_file%z(k) = z(ia+k-1) + end do + else + do k=1,ia-iz+1 + grads_file%z(k) = z(ia-k+1) + end do + end if + + grads_file%day = day + grads_file%month = month + grads_file%year = year + + allocate( grads_file%rlat(1), grads_file%rlon(1) ) + + grads_file%rlat = rlat + grads_file%rlon = rlon + + grads_file%dtwrite = dtwrite + + grads_file%nvar = nvar + + ! Check whether GrADS files already exists + + ! We don't use this feature for the single-column model. The + ! clubb_standalone program will simply overwrite existing data files if they + ! exist. The restart function will create a new GrADS file starting from + ! the restart time in the output directory. + + ! inquire( file=trim(fdir)//trim(fname)//'.ctl', exist=l_ctl ) + ! inquire( file=trim(fdir)//trim(fname)//'.dat', exist=l_dat ) + + l_ctl = .false. + l_dat = .false. + + ! If none of the files exist, set ntimes and nrecord and + ! to initial values and return + + if ( .not.l_ctl .and. .not.l_dat ) then + + grads_file%time = time + grads_file%ntimes = 0 + grads_file%nrecord = 1 + return + + ! If both files exists, attempt to append to existing files + + else if ( l_ctl .and. l_dat ) then + + ! Check existing ctl file + + call check_grads( iunit, fdir, fname, & + ia, iz, & + day, month, year, time, dtwrite, & + nvar, & + l_error, grads_file%ntimes, grads_file%nrecord, & + grads_file%time ) + + if ( l_error ) then + write(unit=fstderr,fmt=*) "Error in open_grads:" + write(unit=fstderr,fmt=*) & + "Attempt to append to existing files failed" +! call stopcode('open_grads') + stop 'open_grads' + end if + + return + +! If one file exists, but not the other, give up + + else + write(unit=fstderr,fmt=*) 'Error in open_grads:' + write(unit=fstderr,fmt=*) & + "Attempt to append to existing files failed,"// & + " because only one of the two GrADS files was found." + stop "open_grads" + + end if + + return + end subroutine open_grads + +!------------------------------------------------------------------------------- + subroutine check_grads( iunit, fdir, fname, & + ia, iz, & + day, month, year, time, dtwrite, & + nvar, & + l_error, ntimes, nrecord, time_grads ) +! Description: +! Given a GrADS file that already exists, this subroutine will attempt +! to determine whether data can be safely appended to existing file. +! References: +! None +!------------------------------------------------------------------------------- + use crmx_stat_file_module, only: & + variable ! Type + + use crmx_clubb_precision, only: & + time_precision ! Variable + + use crmx_constants_clubb, only: & + fstderr, & ! Variable + fstdout, & + sec_per_hr, & + sec_per_min + + implicit none + + ! Input Variables + + integer, intent(in) :: & + iunit, & ! Fortran file unit + ia, iz, & ! First and last level + day, month, year, & ! Day, month and year numbers + nvar ! Number of variables in the file + + character(len=*), intent(in) :: & + fdir, fname ! File directory and name + + real(kind=time_precision), intent(in) :: & + time ! Current model time [s] + + real(kind=time_precision), intent(in) :: & + dtwrite ! Time interval between writes to the file [s] + + ! Output Variables + logical, intent(out) :: & + l_error + + integer, intent(out) :: & + ntimes, nrecord + + real(kind=time_precision), intent(out) :: time_grads + + ! Local Variables + logical :: l_done + integer :: ierr + character(len = 256) :: line, tmp, date, dt + + integer :: & + i, nx, ny, nzmax, & + ihour, imin, & + ia_in, iz_in, ntimes_in, nvar_in, & + day_in, month_in, year_in + + real(kind=time_precision) :: dtwrite_in + + real( kind = core_rknd ), dimension(:), allocatable :: z_in + + type (variable), dimension(:), pointer :: var_in + +!------------------------------------------------------------------------------- + + ! ---- Begin Code ---- + + ! Initialize logical variables + l_error = .false. + l_done = .false. + + ! Open control file + open( unit = iunit, & + file = trim( fdir )//trim( fname )//'.ctl', & + status = 'old', iostat = ierr ) + if ( ierr < 0 ) l_done = .true. + + ! Read and process it + + read(unit=iunit,iostat=ierr,fmt='(a256)') line + if ( ierr < 0 ) l_done = .true. + + do while ( .not. l_done ) + + if ( index(line,'XDEF') > 0 ) then + + read(unit=line,fmt=*) tmp, nx + if ( nx /= 1 ) then + write(unit=fstderr,fmt=*) 'Error: XDEF can only be 1' + l_error = .true. + end if + + else if ( index(line,'YDEF') > 0 ) then + + read(unit=line,fmt=*) tmp, ny + if ( ny /= 1 ) then + write(unit=fstderr,fmt=*) "Error: YDEF can only be 1" + l_error = .true. + end if + + else if ( index(line,'ZDEF') > 0 ) then + + read(unit=line,fmt=*) tmp, iz_in + + if ( index(line,'LEVELS') > 0 ) then + ia_in = 1 + allocate( z_in(ia_in:iz_in) ) + read(unit=iunit,fmt=*) (z_in(i),i=ia_in,iz_in) + end if + + else if ( index(line,'TDEF') > 0 ) then + + read(unit=line,fmt=*) tmp, ntimes_in, tmp, date, dt + read(unit=date(1:2),fmt=*) ihour + read(unit=date(4:5),fmt=*) imin + time_grads = real( ihour, kind=time_precision ) * sec_per_hr & + + real( imin, kind=time_precision ) * sec_per_min + read(unit=date(7:8),fmt=*) day_in + read(unit=date(12:15),fmt=*) year_in + + select case( date(9:11) ) + case( 'JAN' ) + month_in = 1 + case( 'FEB' ) + month_in = 2 + case( 'MAR' ) + month_in = 3 + case( 'APR' ) + month_in = 4 + case( 'MAY' ) + month_in = 5 + case( 'JUN' ) + month_in = 6 + case( 'JUL' ) + month_in = 7 + case( 'AUG' ) + month_in = 8 + case( 'SEP' ) + month_in = 9 + case( 'OCT' ) + month_in = 10 + case( 'NOV' ) + month_in = 11 + case( 'DEC' ) + month_in = 12 + case default + write(unit=fstderr,fmt=*) "Unknown month: "//date(9:11) + l_error = .true. + end select + + read(unit=dt(1:len_trim(dt)-2),fmt=*) dtwrite_in + dtwrite_in = dtwrite_in * sec_per_min + + else if ( index(line,'ENDVARS') > 0 ) then + + l_done = .true. + + else if ( index(line,'VARS') > 0 ) then + + read(line,*) tmp, nvar_in + allocate( var_in(nvar_in) ) + do i=1, nvar_in + read(unit=iunit,iostat=ierr,fmt='(a256)') line + read(unit=line,fmt=*) var_in(i)%name, nzmax + if ( nzmax /= iz_in ) then + write(unit=fstderr,fmt=*) & + "Error reading ", trim( var_in(i)%name ) + l_error = .true. + end if ! nzmax /= iz_in + end do ! 1..nvar_in + end if + + read(unit=iunit,iostat=ierr,fmt='(a256)') line + if ( ierr < 0 ) l_done = .true. + + end do ! while ( .not. l_done ) + + close( unit=iunit ) + + ! Perform some error check + + if ( abs(ia_in - iz_in) /= abs(ia - iz) ) then + write(unit=fstderr,fmt=*) "check_grads: size mismatch" + l_error = .true. + end if + + if ( day_in /= day ) then + write(unit=fstderr,fmt=*) "check_grads: day mismatch" + l_error = .true. + end if + + if ( month_in /= month ) then + write(unit=fstderr,fmt=*) "check_grads: month mismatch" + l_error = .true. + end if + + if ( year_in /= year ) then + write(unit=fstderr,fmt=*) "check_grads: year mismatch" + l_error = .true. + end if + + if ( int( time_grads ) + ntimes_in*int( dtwrite_in ) & + /= int( time ) ) then + write(unit=fstderr,fmt=*) "check_grads: time mismatch" + l_error = .true. + end if + + if ( int( dtwrite_in ) /= int( dtwrite) ) then + write(unit=fstderr,fmt=*) 'check_grads: dtwrite mismatch' + l_error = .true. + end if + + if ( nvar_in /= nvar ) then + write(unit=fstderr,fmt=*) 'check_grads: nvar mismatch' + l_error = .true. + end if + + if ( l_error ) then + write(unit=fstderr,fmt=*) "check_grads diagnostic" + write(unit=fstderr,fmt=*) "ia = ", ia_in, ia + write(unit=fstderr,fmt=*) "iz = ", iz_in, iz + write(unit=fstderr,fmt=*) "day = ", day_in, day + write(unit=fstderr,fmt=*) "month = ", month_in, month + write(unit=fstderr,fmt=*) "year = ", year_in, year + write(unit=fstderr,fmt=*) "time_grads / time = ", time_grads, time + write(unit=fstderr,fmt=*) "dtwrite = ", dtwrite_in, dtwrite + write(unit=fstderr,fmt=*) "nvar = ", nvar_in, nvar + end if + + ! Set ntimes and nrecord to append to existing files + + ntimes = ntimes_in + nrecord = ntimes_in * nvar_in * iz_in + 1 + + deallocate( z_in ) + + ! The purpose of this statement is to avoid a compiler warning + ! for tmp + if (tmp =="") then + end if + ! Joshua Fasching June 2008 + + return + end subroutine check_grads + +!------------------------------------------------------------------------------- + subroutine write_grads( grads_file ) + +! Description: +! Write part of a GrADS file to data (.dat) file update control file (.ctl. +! Can be called as many times as necessary +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_model_flags, only: & + l_byteswap_io ! Variable + + use crmx_endian, only: & + big_endian, & ! Variable + little_endian + + use crmx_stat_file_module, only: & + stat_file ! Type + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + implicit none + + ! External + intrinsic :: selected_real_kind + + ! Constant parameters + integer, parameter :: & + r4 = selected_real_kind( p=5 ) ! Specify 5 decimal digits of precision + + ! Input Variables + type (stat_file), intent(inout) :: & + grads_file ! Contains all information on the files to be written to + + ! Local Variables + integer :: & + i, & ! Loop indices + ios ! I/O status + + character(len=15) :: date + + integer :: dtwrite_ctl ! Time increment for the ctl file + character(len=2) :: dtwrite_units ! Units on dtwrite_ctl + + ! ---- Begin Code ---- + ! Check number of variables and write nothing if less than 1 + + if ( grads_file%nvar < 1 ) return + +#include "recl.inc" + + ! Output data to file + open( unit=grads_file%iounit, & + file=trim( grads_file%fdir )//trim( grads_file%fname )//'.dat', & + form='unformatted', access='direct', & + recl=F_RECL*abs( grads_file%iz-grads_file%ia+1 ), & + status='unknown', iostat=ios ) + if ( ios /= 0 ) then + write(unit=fstderr,fmt=*) & + "write_grads: error opening binary file" + write(unit=fstderr,fmt=*) "iostat = ", ios + stop + end if + + if ( grads_file%ia <= grads_file%iz ) then + do i=1,grads_file%nvar + write(grads_file%iounit,rec=grads_file%nrecord) & + real( grads_file%var(i)%ptr(1,1,grads_file%ia:grads_file%iz), kind=r4) + grads_file%nrecord = grads_file%nrecord + 1 + end do + + else + do i=1, grads_file%nvar + write(grads_file%iounit,rec=grads_file%nrecord) & + real( grads_file%var(i)%ptr(1,1,grads_file%ia:grads_file%iz:-1), kind=r4) + grads_file%nrecord = grads_file%nrecord + 1 + end do + + end if ! grads_file%ia <= grads_file%iz + + close( unit=grads_file%iounit, iostat = ios ) + + if ( ios /= 0 ) then + write(unit=fstderr,fmt=*) & + "write_grads: error closing binary file" + write(unit=fstderr,fmt=*) "iostat = ", ios + stop + end if + + grads_file%ntimes = grads_file%ntimes + 1 + + ! Write control file + + open(unit=grads_file%iounit, & + file=trim( grads_file%fdir )//trim( grads_file%fname )//'.ctl', & + status='unknown', iostat=ios) + if ( ios > 0 ) then + write(unit=fstderr,fmt=*) & + "write_grads: error opening control file" + write(unit=fstderr,fmt=*) "iostat = ", ios + stop + end if + + ! Write file header + if ( ( big_endian .and. .not. l_byteswap_io ) & + .or. ( little_endian .and. l_byteswap_io ) ) then + write(unit=grads_file%iounit,fmt='(a)') 'OPTIONS BIG_ENDIAN' + + else + write(unit=grads_file%iounit,fmt='(a)') 'OPTIONS LITTLE_ENDIAN' + + end if + + write(unit=grads_file%iounit,fmt='(a)') 'DSET ^'//trim( grads_file%fname )//'.dat' + write(unit=grads_file%iounit,fmt='(a,e11.5)') 'UNDEF ',undef + write(unit=grads_file%iounit,fmt='(a,f8.3,a)') 'XDEF 1 LINEAR ', grads_file%rlon, ' 1.' + write(unit=grads_file%iounit,fmt='(a,f8.3,a)') 'YDEF 1 LINEAR ', grads_file%rlat, ' 1.' + if ( grads_file%ia == grads_file%iz ) then + write(unit=grads_file%iounit,fmt='(a)') 'ZDEF 1 LEVELS 0.' + else if ( grads_file%ia < grads_file%iz ) then + write(unit=grads_file%iounit,fmt='(a,i5,a)') & + 'ZDEF', abs(grads_file%iz-grads_file%ia)+1,' LEVELS ' + write(unit=grads_file%iounit,fmt='(6f13.4)') & + (grads_file%z(i-grads_file%ia+1),i=grads_file%ia,grads_file%iz) + else + write(unit=grads_file%iounit,fmt='(a,i5,a)') & + 'ZDEF',abs(grads_file%iz-grads_file%ia)+1,' LEVELS ' + write(grads_file%iounit,'(6f13.4)') (grads_file%z(grads_file%ia-i+1), & + i=grads_file%ia,grads_file%iz,-1) + end if + + call format_date( grads_file%day, grads_file%month, grads_file%year, grads_file%time, & ! In + date ) ! Out + + call determine_time_inc( grads_file%dtwrite, & ! In + dtwrite_ctl, dtwrite_units ) ! Out + + write(unit=grads_file%iounit,fmt='(a,i6,a,a,i5,a)') 'TDEF ', & + grads_file%ntimes, ' LINEAR ', date, dtwrite_ctl, dtwrite_units + + ! Variables description + write(unit=grads_file%iounit,fmt='(a,i5)') 'VARS', grads_file%nvar + + do i=1, grads_file%nvar, 1 + write(unit=grads_file%iounit,fmt='(a,i5,a,a)') & + grads_file%var(i)%name(1:len_trim(grads_file%var(i)%name)), & + abs(grads_file%iz-grads_file%ia)+1,' 99 ', & + grads_file%var(i)%description(1:len_trim(grads_file%var(i)%description)) + end do + + write(unit=grads_file%iounit,fmt='(a)') 'ENDVARS' + + close( unit=grads_file%iounit, iostat=ios ) + if ( ios > 0 ) then + write(unit=fstderr,fmt=*) & + "write_grads: error closing control file" + write(unit=fstderr,fmt=*) "iostat = ",ios + stop + end if + + return + end subroutine write_grads + +!--------------------------------------------------------- + subroutine format_date( day_in, month_in, year_in, time_in, & + date ) +! +! Description: +! This subroutine formats the current time of the model (given in seconds +! since the start time) to a date format usable as GrADS output. +! References: +! None +!--------------------------------------------------------- + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_calendar, only: & + compute_current_date ! Procedure(s) + + use crmx_calendar, only: & + month_names ! Variable(s) + + use crmx_constants_clubb, only: & + sec_per_hr, & ! Variable(s) + min_per_hr + + implicit none + + ! Input Variables + integer, intent(in) :: & + day_in, & ! Day of the Month at Model Start [dd] + month_in, & ! Month of the Year at Model Start [mm] + year_in ! Year at Model Start [yyyy] + + real(kind=time_precision), intent(in) :: & + time_in ! Time since Model Start [s] + + ! Output Variables + character(len=15), intent(out) :: & + date ! Current Date in format 'hh:mmZddmmmyyyy' + + ! Local Variables + integer :: iday, imonth, iyear ! Day, month, year + real(kind=time_precision) :: time ! time [s] + + ! ---- Begin Code ---- + + ! Copy input arguments into local variables + + iday = day_in + imonth = month_in + iyear = year_in + time = time_in + + call compute_current_date( day_in, month_in, & ! In + year_in, & ! In + time_in, & ! In + iday, imonth, & ! Out + iyear, & ! Out + time ) ! Out + + date = 'hh:mmZddmmmyyyy' + write(unit=date(7:8),fmt='(i2.2)') iday + write(unit=date(9:11),fmt='(a3)') month_names(imonth) + write(unit=date(12:15),fmt='(i4.4)') iyear + write(unit=date(1:2),fmt='(i2.2)') floor( time/sec_per_hr ) + write(unit=date(4:5),fmt='(i2.2)') & + int( mod( nint( time ), nint(sec_per_hr) ) / nint(min_per_hr) ) + + return + end subroutine format_date + +!------------------------------------------------------------------------------- + subroutine determine_time_inc( dtwrite_sec, & + dtwrite_ctl, units ) +! Description: +! Determine the units on the time increment, since GrADS only allows a 2 digit +! time increment. +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + sec_per_day, & ! Constants + sec_per_hr, & + sec_per_min + + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + implicit none + + ! External + intrinsic :: max, floor + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dtwrite_sec ! Time increment in GrADS [s] + + ! Output Variables + integer, intent(out) :: & + dtwrite_ctl ! Time increment in GrADS [units vary] + + character(len=2), intent(out) :: units ! Units on dtwrite_ctl + + ! Local variables + real(kind=time_precision) :: & + dtwrite_min, & ! Time increment [minutes] + dtwrite_hrs, & ! Time increment [hours] + dtwrite_days ! Time increment [days] + + ! ---- Begin Code ---- + + ! Since GrADs can't handle a time increment of less than a minute we assume + ! 1 minute output for an output frequency of less than a minute. + dtwrite_min = real( floor( dtwrite_sec/sec_per_min ), kind=time_precision ) + dtwrite_min = max( 1._time_precision, dtwrite_min ) + + if ( dtwrite_min <= 99._time_precision ) then + dtwrite_ctl = int( dtwrite_min ) + units = 'mn' + else + dtwrite_hrs = dtwrite_sec / sec_per_hr + if ( dtwrite_hrs <= 99._time_precision ) then + dtwrite_ctl = int( dtwrite_hrs ) + units = 'hr' + else + dtwrite_days = dtwrite_sec / sec_per_day + if ( dtwrite_days <= 99._time_precision ) then + dtwrite_ctl = int( dtwrite_days ) + units = 'dy' + else + stop "Fatal error in determine_time_inc" + end if ! dwrite_days <= 99. + end if ! dtwrite_hrs <= 99. + end if ! dtwrite_min <= 99. + + return + end subroutine determine_time_inc + +end module crmx_output_grads +!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 b/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 new file mode 100644 index 0000000000..cf5157e524 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 @@ -0,0 +1,835 @@ +! $Id: output_netcdf.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!------------------------------------------------------------------------------- +module crmx_output_netcdf +#ifdef NETCDF + +! Description: +! Functions and subroutines for writing NetCDF files + +! References: +! +!------------------------------------------------------------------------------- + + implicit none + + public :: open_netcdf, write_netcdf, close_netcdf + + private :: define_netcdf, write_grid, first_write, format_date + + ! Constant parameters + ! This will truncate all timesteps smaller than 1 mn to a minute for + ! the purposes of viewing the data in grads + logical, parameter, private :: & + l_grads_kludge = .true. + + private ! Default scope + + contains +!------------------------------------------------------------------------------- + subroutine open_netcdf( nlat, nlon, fdir, fname, ia, iz, zgrid, & + day, month, year, rlat, rlon, & + time, dtwrite, nvar, ncf ) + +! Description: +! Defines the structure used to reference the file `ncf' + +! References: +! None +!------------------------------------------------------------------------------- + use netcdf, only: & + NF90_CLOBBER, & ! Variable(s) + NF90_NOERR, & + nf90_create, & ! Procedure + nf90_strerror + + use crmx_stat_file_module, only: & + stat_file ! Type + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + implicit none + + ! Input Variables + character(len=*), intent(in) :: & + fdir, & ! Directory name of file + fname ! File name + + integer, intent(in) :: & + nlat, nlon, & ! Number of points in the X and Y + day, month, year, & ! Time + ia, iz, & ! First and last grid point + nvar ! Number of variables + + real( kind = core_rknd ), dimension(nlat), intent(in) :: & + rlat ! Latitudes [degrees_E] + + real( kind = core_rknd ), dimension(nlon), intent(in) :: & + rlon ! Longitudes [degrees_N] + + real(kind=time_precision), intent(in) :: & + dtwrite ! Time between write intervals [s] + + real(kind=time_precision), intent(in) :: & + time ! Current time [s] + + real( kind = core_rknd ), dimension(:), intent(in) :: & + zgrid ! The model grid [m] + + ! Input/output Variables + type (stat_file), intent(inout) :: ncf + + ! Local Variables + integer :: stat ! Error status + integer :: k ! Array index + + ! ---- Begin Code ---- + + ncf%nvar = nvar + + ! If there is no data to write, then return + if ( ncf%nvar == 0 ) then + return + end if + + ! Initialization for NetCDF + ncf%l_defined = .false. + + ! Define file (compatability with GrADS writing) + ncf%fdir = fdir + ncf%fname = fname + ncf%ia = ia + ncf%iz = iz + ncf%day = day + ncf%month = month + ncf%year = year + ncf%nlat = nlat + ncf%nlon = nlon + ncf%time = time + + ncf%dtwrite = dtwrite + + ! From open_grads. + ! This probably for the case of a reversed grid as in COAMPS + if ( ia <= iz ) then + do k=1,iz-ia+1 + ncf%z(k) = zgrid(ia+k-1) + end do + else ! Always this for CLUBB + do k=1,ia-iz+1 + ncf%z(k) = zgrid(ia-k+1) + end do + end if + + allocate( ncf%rlat(1:nlat), ncf%rlon(1:nlon) ) + + ncf%rlat = rlat + ncf%rlon = rlon + + ! Create NetCDF dataset: enter define mode + stat = nf90_create( path = trim( fdir )//trim( fname )//'.nc', & + cmode = NF90_CLOBBER, & ! overwrite existing file + ncid = ncf%iounit ) + if ( stat /= NF90_NOERR ) then + write(unit=fstderr,fmt=*) "Error opening file: ", & + trim( fdir )//trim( fname )//'.nc', & + trim( nf90_strerror( stat ) ) + stop + end if + + call define_netcdf( ncf%iounit, ncf%nlat, ncf%nlon, ncf%iz, & ! In + ncf%day, ncf%month, ncf%year, ncf%time, & ! In + ncf%LatDimId, ncf%LongDimId, ncf%AltDimId, ncf%TimeDimId, & ! Out + ncf%LatVarId, ncf%LongVarId, ncf%AltVarId, ncf%TimeVarId ) ! Out + + return + end subroutine open_netcdf + +!------------------------------------------------------------------------------- + + subroutine write_netcdf( ncf ) + +! Description: +! Writes some data to the NetCDF dataset, but doesn't close it. +! +! References: +! None +!------------------------------------------------------------------------------- + + use netcdf, only: & + NF90_NOERR, & ! Variable(s) + nf90_put_var, & ! Procedure + nf90_strerror + + use crmx_stat_file_module, only: & + stat_file ! Variable + + use crmx_constants_clubb, only: & + fstderr, & ! Variable + sec_per_min + + use crmx_clubb_precision, only: & + time_precision ! Constant(s) + + implicit none + + ! Input + type (stat_file), intent(inout) :: ncf ! The file + + ! Local Variables + integer, dimension(:), allocatable :: stat ! Error status + real(kind=8), dimension(1) :: time ! Time [s] + + integer :: i ! Array index + + ! ---- Begin Code ---- + + ! If there is no data to write, then return + if ( ncf%nvar == 0 ) then + return + end if + + ncf%ntimes = ncf%ntimes + 1 + + if ( .not. ncf%l_defined ) then + call first_write( ncf ) ! finalize the variable definitions + call write_grid( ncf ) ! define lat., long., and grid + ncf%l_defined = .true. + end if + + allocate( stat( ncf%nvar ) ) + if ( l_grads_kludge ) then + time = real( nint( real( ncf%ntimes, kind=time_precision ) & + * ncf%dtwrite / sec_per_min ), kind=time_precision ) ! minutes(rounded) + else + time = real( ncf%ntimes, kind=time_precision ) * ncf%dtwrite ! seconds + end if + + stat(1) = nf90_put_var( ncid=ncf%iounit, varid=ncf%TimeVarId, & + values=time(1), start=(/ncf%ntimes/) ) + if ( stat(1) /= NF90_NOERR ) then + stop "time variable nf90_put_var failed" + end if + + do i = 1, ncf%nvar, 1 + stat(i) & + = nf90_put_var( ncid=ncf%iounit, varid=ncf%var(i)%indx, & + values=ncf%var(i)%ptr(:,:,ncf%ia:ncf%iz), & + start=(/1,1,1,ncf%ntimes/), & + count=(/ncf%nlon,ncf%nlat,ncf%iz,1/) ) + + end do ! i=1..nvar + + if ( any (stat /= NF90_NOERR ) ) then + do i=1,ncf%nvar,1 + if( stat(i) /= NF90_NOERR ) then + write(unit=fstderr,fmt=*) ncf%var(i)%name, & + trim( nf90_strerror( stat(i) ) ) + end if + end do + stop "nf90_put_var error" + end if + + + deallocate( stat ) + + return + end subroutine write_netcdf + +!------------------------------------------------------------------------------- + subroutine define_netcdf( ncid, nlat, nlon, iz, & + day, month, year, time, & + LatDimId, LongDimId, AltDimId, TimeDimId, & + LatVarId, LongVarId, AltVarId, TimeVarId ) + +! Description: +! Used internally to create a definition for the NetCDF dataset +! +! References: +! None +!------------------------------------------------------------------------------- + use netcdf, only: & + NF90_NOERR, & ! Constants + NF90_FLOAT, & + NF90_DOUBLE, & + NF90_UNLIMITED + + use netcdf, only: & + nf90_def_dim, & ! Functions + nf90_strerror, & + nf90_def_var, & + nf90_put_att + + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + implicit none + + integer, intent(in) :: & + nlat, & ! Number of points in the N/S direction + nlon ! Number of points in the E/W direction + + ! Input Variables + integer, intent(in) :: & + day, month, year, & ! Time of year + ncid, & ! Number used by NetCDF for ref. the file + iz ! Dimension in z + + real(kind=time_precision), intent(in) :: & + time ! Current model time [s] + + ! Output Variables + integer, intent(out) :: & + LatDimId, LongDimId, AltDimId, TimeDimId ! NetCDF id's for dimensions + + ! NetCDF id's for data (e.g. longitude) associated with each dimension + integer, intent(out) :: & + LatVarId, LongVarId, AltVarId, TimeVarId + + ! Local variables + integer :: stat + character(len=35) :: TimeUnits + + ! ---- Begin Code ---- + + ! Define the dimensions for the variables + stat = nf90_def_dim( ncid, "longitude", nlon, LongDimId ) + + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining longitude: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_def_dim( ncid, "latitude", nlat, LatDimId ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining latitude: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_def_dim( ncid, "altitude", iz, AltDimId ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining altitude: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_def_dim( ncid, "time", NF90_UNLIMITED, TimeDimId ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining time: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + ! Define the initial variables for the dimensions + ! Longitude = deg_E = X + stat = nf90_def_var( ncid, "longitude", NF90_FLOAT, & + (/LongDimId/), LongVarId ) + + ! Latitude = deg_N = Y + stat = nf90_def_var( ncid, "latitude", NF90_FLOAT, & + (/LatDimId/), LatVarId ) + + ! Altitude = meters above the surfac3 = Z + stat = nf90_def_var( ncid, "altitude", NF90_FLOAT, & + (/AltDimId/), AltVarId ) + + ! grads2nc stores time as a double prec. value, so we follow that + stat = nf90_def_var( ncid, "time", NF90_DOUBLE, & + (/TimeDimId/), TimeVarId ) + + ! Assign attribute values + + ! Time attribute + stat = nf90_put_att( ncid, TimeVarId, "cartesian_axis", "T" ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) + stop + end if + + call format_date( day, month, year, time, TimeUnits ) + + stat = nf90_put_att( ncid, TimeVarId, "units", TimeUnits ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_put_att( ncid, TimeVarId, "ipositive", 1 ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_put_att( ncid, TimeVarId, "calendar_type", "Gregorian" ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error defining time", trim( nf90_strerror( stat ) ) + stop + end if + + ! Define Location + ! X & Y coordinates + stat = nf90_put_att( ncid, LongVarId, "cartesian_axis", "X" ) + + stat = nf90_put_att( ncid, LongVarId, "units", "degrees_E" ) + + stat = nf90_put_att( ncid, LongVarId, "ipositive", 1 ) + + stat = nf90_put_att( ncid, LatVarId, "cartesian_axis", "Y" ) + + stat = nf90_put_att( ncid, LatVarId, "units", "degrees_N" ) + + stat = nf90_put_att( ncid, LatVarId, "ipositive", 1 ) + + ! Altitude, Z coordinate + stat = nf90_put_att( ncid, AltVarId, "cartesian_axis", "Z" ) + + stat = nf90_put_att( ncid, AltVarId, "units", "meters" ) + + stat = nf90_put_att( ncid, AltVarId, "positive", "up" ) + + stat = nf90_put_att( ncid, AltVarId, "ipositive", 1 ) + + return + end subroutine define_netcdf + +!------------------------------------------------------------------------------- + subroutine close_netcdf( ncf ) + +! Description: +! Close a previously opened stats file. + +! Notes: +! I assume nf90_close() exists so that the NetCDF libraries can do a +! form of buffered I/O, but I don't know the implementation +! details. -dschanen +!------------------------------------------------------------------------------- + + use crmx_stat_file_module, only: & + stat_file ! Type + + use netcdf, only: & + NF90_NOERR, & ! Variable + nf90_close, & ! Procedure(s) + nf90_strerror + + use crmx_constants_clubb, only: & + fstderr ! Variable + + implicit none + + ! Input/Output Variables + type (stat_file), intent(inout) :: ncf + + ! Local Variables + integer :: stat + + ! ---- Begin Code ---- + + ! If there is no data to write, then return + if ( ncf%nvar == 0 ) then + return + end if + + stat = nf90_close( ncf%iounit ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error closing file "// & + trim( ncf%fname )//": ", trim( nf90_strerror( stat ) ) + stop + end if + + return + end subroutine close_netcdf + +!------------------------------------------------------------------------------- + subroutine first_write( ncf ) + +! Description: +! Used on the first call to write_nc to finalize definitions +! for the dataset, including the attributes for variable records. +! References: +! None +!------------------------------------------------------------------------------- + + use netcdf, only: & + NF90_NOERR, & ! Constants + NF90_FLOAT, & + NF90_GLOBAL, & + nf90_def_var, & ! Procedure(s) + nf90_strerror, & + nf90_put_att, & + nf90_enddef + + use crmx_stat_file_module, only: & + stat_file ! Derived type + + use crmx_constants_clubb, only: & + fstderr ! Variable + + use crmx_parameters_model, only: & + T0, & ! Real variables + ts_nudge, & + sclr_tol ! Real array variable + + use crmx_parameters_tunable, only: & + params_list ! Variable names (characters) + + use crmx_parameters_tunable, only: & + get_parameters ! Subroutine + + use crmx_parameter_indices, only: & + nparams ! Integer + + use crmx_model_flags, only: & + l_pos_def, & + l_hole_fill, & + l_clip_semi_implicit, & + l_standard_term_ta, & + l_single_C2_Skw, & + l_gamma_Skw, & + l_uv_nudge, & + l_tke_aniso + + use crmx_parameters_microphys, only: & + micro_scheme, & ! Variable(s) + l_local_kk, & ! Logicals + l_cloud_sed + + use crmx_parameters_radiation, only: & + rad_scheme + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input/Output Variables + type (stat_file), intent(inout) :: ncf + + ! Local Variables + integer, dimension(:), allocatable :: stat + + real( kind = core_rknd ), dimension(nparams) :: params ! Tunable parameters + + integer :: i ! Array index + logical :: l_error ! Error stat + + character(len=10) :: current_time + character(len=8) :: current_date + ! Range for NetCDF variables + real(kind=4), dimension(2) :: var_range + + ! Dimensions for variables + integer, dimension(4) :: var_dim + +!------------------------------------------------------------------------------- +! Typical valid ranges (IEEE 754) + +! real(kind=4): +/- 3.4028235E+38 +! real(kind=8): +/- 1.797693134862316E+308 +! real(kind=16):+/- 1.189731495357231765085759326628007E+4932 + +! We use a 4 byte data model for NetCDF and GrADS to save disk space +!------------------------------------------------------------------------------- + var_range(1) = -huge( var_range(1) ) + var_range(2) = huge( var_range(2) ) + +! var_range = (/ -1.e31, 1.e31 /) + +! Explanation: The NetCDF documentation claims the NF90_UNLIMITED +! variable should be the first dimension, but def_var is somehow +! inverted and requires the opposite. After writing, these +! dimensions are all in the opposite order of this in the file. +! -dschanen + + var_dim(1) = ncf%LongDimId ! X + var_dim(2) = ncf%LatDimId ! Y + var_dim(3) = ncf%AltDimId ! Z + var_dim(4) = ncf%TimeDimId ! The NF90_UNLIMITED dimension + + allocate( stat( ncf%nvar ) ) + + l_error = .false. + + do i = 1, ncf%nvar, 1 +! stat(i) = nf90_def_var( ncf%iounit, trim( ncf%var(i)%name ), & +! NF90_FLOAT, (/ncf%TimeDimId, ncf%AltDimId, & +! ncf%LatDimId, ncf%LongDimId/), ncf%var(i)%indx ) + stat(i) = nf90_def_var( ncf%iounit, trim( ncf%var(i)%name ), & + NF90_FLOAT, var_dim(:), ncf%var(i)%indx ) + if ( stat(i) /= NF90_NOERR ) then + write(fstderr,*) "Error defining variable ", & + ncf%var(i)%name //": ", trim( nf90_strerror( stat(i) ) ) + l_error = .true. + end if + + stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, & + "valid_range", var_range(1:2) ) + if ( stat(i) /= NF90_NOERR ) then + write(fstderr,*) "Error defining valid range", & + trim( nf90_strerror( stat(i) ) ) + l_error = .true. + end if + + stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, "long_name", & + trim( ncf%var(i)%description ) ) + if ( stat(i) /= NF90_NOERR ) then + write(fstderr,*) "Error in description", & + trim( nf90_strerror( stat(i) ) ) + l_error = .true. + end if + + stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, "units", & + trim( ncf%var(i)%units ) ) + if ( stat(i) /= NF90_NOERR ) then + write(fstderr,*) "Error in units", & + trim( nf90_strerror( stat(i) ) ) + l_error = .true. + end if + end do + + if ( l_error ) stop "Error in definition" + + deallocate( stat ) + + allocate( stat(5) ) + + ! Define global attributes of the file, for reproducing the results and + ! determining how a run was configured + stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "Conventions", "COARDS" ) + stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "model", "CLUBB" ) + + ! Figure out when the model is producing this file + call date_and_time( current_date, current_time ) + + stat(3) = nf90_put_att( & + ncf%iounit, NF90_GLOBAL, "created_on", & + current_date(1:4)//'-'//current_date(5:6)//'-'// & + current_date(7:8)//' '// & + current_time(1:2)//':'//current_time(3:4) ) + + stat(4) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "micro_scheme", & + trim( micro_scheme ) ) + + stat(5) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "rad_scheme", & + trim( rad_scheme ) ) + + if ( any( stat /= NF90_NOERR ) ) then + write(fstderr,*) "Error writing model information" + do i = 1, size( stat ), 1 + write(fstderr,*) trim( nf90_strerror( stat(i) ) ) + end do + stop + end if + + ! Write the model flags to the file + deallocate( stat ) + allocate( stat(10) ) ! # of model flags + + stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_local_kk", lchar( l_local_kk ) ) + stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_pos_def", lchar( l_pos_def ) ) + stat(3) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_hole_fill", lchar( l_hole_fill ) ) + stat(4) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_clip_semi_implicit", & + lchar( l_clip_semi_implicit ) ) + stat(5) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_standard_term_ta", & + lchar( l_standard_term_ta ) ) + stat(6) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_single_C2_Skw", & + lchar( l_single_C2_Skw ) ) + stat(7) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_gamma_Skw", lchar( l_gamma_Skw ) ) + stat(8) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_cloud_sed", lchar( l_cloud_sed ) ) + stat(9) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_uv_nudge", lchar( l_uv_nudge ) ) + stat(10) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_tke_aniso", lchar( l_tke_aniso ) ) + + if ( any( stat /= NF90_NOERR ) ) then + write(fstderr,*) "Error writing model flags" + do i = 1, size( stat ), 1 + write(fstderr,*) i, trim( nf90_strerror( stat(i) ) ) + end do + stop + end if + + ! Write model parameter values to the file + deallocate( stat ) + allocate( stat(nparams) ) + + stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "T0", T0 ) + stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "ts_nudge", ts_nudge ) + stat(3) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "sclr_tol", sclr_tol ) + + call get_parameters( params ) + + do i = 1, nparams, 1 + stat(i) = nf90_put_att( ncf%iounit, NF90_GLOBAL, params_list(i), params(i) ) + end do + + if ( any( stat /= NF90_NOERR ) ) then + write(fstderr,*) "Error writing parameters" + do i = 1, nparams, 1 + write(fstderr,*) i, trim( nf90_strerror( stat(i) ) ) + end do + stop + end if + + stat(1) = nf90_enddef( ncf%iounit ) ! end definitions + if ( stat(1) /= NF90_NOERR ) then + write(fstderr,*) "Error finalizing definitions", & + trim( nf90_strerror( stat(1) ) ) + stop + end if + + deallocate( stat ) + + return + end subroutine first_write + +!------------------------------------------------------------------------------- + subroutine write_grid( ncf ) + +! Description: +! Writes inforation about latitude, longitude and the grid +! References: +! None +!------------------------------------------------------------------------------- + + use netcdf, only: & + NF90_NOERR, & ! Variable(s) + nf90_put_var, & ! Procedure(s) + nf90_strerror + use crmx_stat_file_module, only: & + stat_file ! Type + use crmx_constants_clubb, only: & + fstderr ! Variable + + implicit none + + ! Input Variable(s) + type (stat_file), intent(inout) :: ncf + + integer :: stat + + ! ---- Begin Code ---- + + stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%AltVarId, & + values=ncf%z(ncf%ia:ncf%iz) ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error entering grid: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%LongVarId, & + values=ncf%rlon ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error entering longitude: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%LatVarId, & + values=ncf%rlat ) + if ( stat /= NF90_NOERR ) then + write(fstderr,*) "Error entering latitude: ", & + trim( nf90_strerror( stat ) ) + stop + end if + + return + end subroutine write_grid + +!------------------------------------------------------------------------------- + + subroutine format_date & + ( day_in, month_in, year_in, time_in, date ) + +! Description: +! Put the model date in a format that udunits and NetCDF can easily +! handle. GrADSnc is dumb and apparently cannot handle time +! intervals < 1 minute. + +! Notes: +! Adapted from the original GrADS version written by Chris Golaz. +! Uses Fortran `internal' files to write the string output. +!------------------------------------------------------------------------------- + + use crmx_calendar, only: & + compute_current_date ! Procedure(s) + + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + implicit none + + ! External + intrinsic :: floor, int, mod, nint + + ! Input Variables + integer, intent(in) :: & + day_in, & ! Day of Month at Model Start [dd] + month_in, & ! Month of Year at Model Start [mm] + year_in ! Year at Model Start [yyyy] + + real(kind=time_precision), intent(in) :: time_in ! Start time [s] + + ! Output Variables + character(len=35), intent(out) :: date + + integer:: & + iday, imonth, iyear ! Integer for day, month and year. + + real(kind=time_precision) :: st_time ! Start time [s] + + call compute_current_date( day_in, month_in, & + year_in, & + time_in, & + iday, imonth, & + iyear, & + st_time ) + + if ( .not. l_grads_kludge ) then + date = "seconds since YYYY-MM-DD HH:MM:00.0" + else + date = "minutes since YYYY-MM-DD HH:MM:00.0" + end if + write(date(15:18),'(i4.4)') iyear + write(date(20:21),'(i2.2)') imonth + write(date(23:24),'(i2.2)') iday + write(date(26:27),'(i2.2)') floor( st_time / 3600._time_precision ) + write(date(29:30),'(i2.2)') int( mod( nint( st_time ),3600 ) / 60 ) + + return + end subroutine format_date + +!=============================================================================== + character function lchar( l_input ) +! Description: +! Cast a logical to a character data type +! +! References: +! None +!------------------------------------------------------------------------------- + + implicit none + + logical, intent(in) :: l_input + + ! ---- Begin Code ---- + + if ( l_input ) then + lchar = 'T' + else + lchar = 'F' + end if + + return + end function lchar + +#endif /*NETCDF*/ +end module crmx_output_netcdf diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 new file mode 100644 index 0000000000..a4aefca91f --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 @@ -0,0 +1,108 @@ +!------------------------------------------------------------------------------- +! $Id: parameter_indices.F90 5929 2012-09-07 18:09:59Z bmg2@uwm.edu $ +module crmx_parameter_indices + +! Description: +! Since f90/95 lacks enumeration, we're stuck numbering each +! parameter by hand like this. + +! Adding new parameters is relatively simple. First, the +! parameter should be added in the common block of the parameters +! module so it can be used in other parts of the code. Each +! variable needs a unique number in this module, and nparams must +! be incremented for the new variable. Next, the params_list +! variable in module parameters should have new variable added to +! it. The subroutines pack_parameters and uppack_parameters will +! need to have the variable added to their list, but the order +! doesn't actually matter, since the i variables in here determine +! where in the params vector the number is placed. +! Finally, the namelists initvars and initspread will need to +! have the parameter added to them. +!------------------------------------------------------------------------------- + + implicit none + + private ! Default Scope + + integer, parameter, public :: & + nparams = 61 ! Total tunable parameters + +!*************************************************************** +! ***** IMPORTANT ***** +! If you change the order of these parameters, you will need to +! change the order of params_list as well or the tuner will +! break! +! ***** IMPORTANT ***** +!*************************************************************** + + integer, parameter, public :: & + iC1 = 1, & + iC1b = 2, & + iC1c = 3, & + iC2 = 4, & + iC2b = 5, & + iC2c = 6, & + iC2rt = 7, & + iC2thl = 8, & + iC2rtthl = 9, & + iC4 = 10, & + iC5 = 11, & + iC6rt = 12, & + iC6rtb = 13, & + iC6rtc = 14, & + iC6thl = 15, & + iC6thlb = 16, & + iC6thlc = 17, & + iC7 = 18, & + iC7b = 19, & + iC7c = 20, & + iC8 = 21, & + iC8b = 22, & + iC10 = 23, & + iC11 = 24, & + iC11b = 25, & + iC11c = 26, & + iC12 = 27, & + iC13 = 28, & + iC14 = 29, & + iC15 = 30 + + integer, parameter, public :: & + iC6rt_Lscale0 = 31, & + iC6thl_Lscale0 = 32, & + iC7_Lscale0 = 33, & + iwpxp_L_thresh = 34 + + integer, parameter, public :: & + ic_K = 35, & + ic_K1 = 36, & + inu1 = 37, & + ic_K2 = 38, & + inu2 = 39, & + ic_K6 = 40, & + inu6 = 41, & + ic_K8 = 42, & + inu8 = 43, & + ic_K9 = 44, & + inu9 = 45, & + inu10 = 46, & + ic_Krrainm = 47, & + inu_r = 48, & + inu_hd = 49 + + integer, parameter, public :: & + igamma_coef = 50, & + igamma_coefb = 51, & + igamma_coefc = 52, & + imu = 53, & + ibeta = 54, & + ilmin_coef = 55, & + imult_coef = 56, & + itaumin = 57, & + itaumax = 58, & + iLscale_mu_coef = 59, & + iLscale_pert_coef = 60, & + ialpha_corr = 61 + +end module crmx_parameter_indices +!----------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 new file mode 100644 index 0000000000..e6fe31957b --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 @@ -0,0 +1,191 @@ +! $Id: parameters_microphys.F90 6063 2013-02-12 18:01:12Z dschanen@uwm.edu $ +!=============================================================================== +module crmx_parameters_microphys + +! Description: +! Parameters for microphysical schemes + +! References: +! None +!------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + time_precision, & + core_rknd + + use crmx_mt95, only: & + genrand_intg + + implicit none + + ! Constant Parameters + integer, parameter, public :: & + LH_microphys_interactive = 1, & ! Feed the samples into the microphysics and allow feedback + LH_microphys_non_interactive = 2, & ! Feed the samples into the microphysics with no feedback + LH_microphys_disabled = 3 ! Disable Latin hypercube entirely + + ! Morrison aerosol parameters + integer, parameter, public :: & + morrison_no_aerosol = 0, & + morrison_power_law = 1, & + morrison_lognormal = 2 + + ! Local Variables + logical, public :: & + l_cloud_sed, & ! Cloud water sedimentation (K&K/No microphysics) + l_ice_micro, & ! Compute ice (COAMPS/Morrison) + l_upwind_diff_sed, & ! Use upwind differencing approx. for sedimentation (K&K/COAMPS) + l_graupel, & ! Compute graupel (COAMPS/Morrison) + l_hail, & ! Assumption about graupel/hail? (Morrison) + l_seifert_beheng, & ! Use Seifert and Behneng warm drizzle (Morrison) + l_predictnc, & ! Predict cloud droplet conconcentration (Morrison) + l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + l_subgrid_w, & ! Use subgrid w (Morrison) + l_arctic_nucl, & ! Use MPACE observations (Morrison) + l_fix_pgam, & ! Fix pgam (Morrison) + l_in_cloud_Nc_diff, & ! Use in cloud values of Nc for diffusion + l_var_covar_src ! Flag for using upscaled microphysics source terms + ! for predictive variances and covariances (KK micro) + +!$omp threadprivate( l_cloud_sed, l_ice_micro, l_graupel, l_hail, & +!$omp l_upwind_diff_sed, l_seifert_beheng, l_predictnc, & +!$omp l_const_Nc_in_cloud, l_subgrid_w, l_arctic_nucl, & +!$omp l_fix_pgam, l_in_cloud_Nc_diff, l_var_covar_src ) + + logical, public :: & + l_cloud_edge_activation, & ! Activate on cloud edges (Morrison) + l_local_kk ! Local drizzle for Khairoutdinov & Kogan microphysics + +!$omp threadprivate(l_cloud_edge_activation, l_local_kk) + + character(len=30), public :: & + specify_aerosol ! Specify aerosol (Morrison) + + ! Flags for the Latin Hypercube sampling code + logical, public :: & + l_fix_s_t_correlations, & ! Use a fixed correlation for s and t Mellor + l_lh_cloud_weighted_sampling, & ! Limit noise by sampling in-cloud + l_lh_vert_overlap ! Assume maximum overlap for s_mellor + +!$omp threadprivate( l_fix_s_t_correlations, l_lh_cloud_weighted_sampling, & +!$omp l_lh_vert_overlap ) + + integer, public :: & + LH_microphys_calls, & ! Number of latin hypercube samples to call the microphysics with + LH_sequence_length ! Number of timesteps before the latin hypercube seq. repeats + + integer(kind=genrand_intg), public :: & + LH_seed ! Seed for the Mersenne + +!$omp threadprivate( LH_microphys_calls, LH_sequence_length, LH_seed ) + + ! Determines how the latin hypercube samples should be used with the microphysics + integer, public :: & + LH_microphys_type + +!$omp threadprivate( LH_microphys_type ) + + character(len=50), public :: & + micro_scheme ! khairoutdinv_kogan, simplified_ice, coamps, etc. + +!$omp threadprivate( micro_scheme ) + + character(len=10), dimension(:), allocatable, public :: & + hydromet_list + +!$omp threadprivate( hydromet_list ) + + real(kind=time_precision), public :: & + microphys_start_time ! When to start the microphysics [s] + +!$omp threadprivate( microphys_start_time ) + + real( kind = core_rknd ), public :: & + Ncm_initial ! Initial cloud droplet number concentration [#/m^3] + +!$omp threadprivate( Ncm_initial ) + + real( kind = core_rknd ), public :: & + sigma_g ! Geometric std. dev. of cloud droplets falling in a stokes regime. + +!$omp threadprivate( sigma_g ) + + ! Statistical rain parameters . + + ! Parameters for in-cloud (from SAM RF02 DO). + real( kind = core_rknd ), public :: & ! RF02 value + rrp2_on_rrm2_cloud, & ! 0.766 + Nrp2_on_Nrm2_cloud, & ! 0.429 + Ncp2_on_Ncm2_cloud ! 0.003 + +!$omp threadprivate( rrp2_on_rrm2_cloud, Nrp2_on_Nrm2_cloud, & +!$omp Ncp2_on_Ncm2_cloud ) + + ! Parameters for below-cloud (from SAM RF02 DO). + real( kind = core_rknd ), public :: & ! RF02 value + rrp2_on_rrm2_below, & ! 8.97 + Nrp2_on_Nrm2_below, & ! 12.03 + Ncp2_on_Ncm2_below ! 0.00 ! Not applicable below cloud. + +!$omp threadprivate( rrp2_on_rrm2_below, Nrp2_on_Nrm2_below, & +!$omp Ncp2_on_Ncm2_below ) + + ! Other needed parameters + real( kind = core_rknd ), public :: C_evap ! 0.86 ! Khairoutdinov and Kogan (2000) ratio of + ! drizzle drop mean geometric radius to + ! drizzle drop mean volume radius. + ! Khairoutdinov and Kogan (2000); p. 233. + !real, public :: C_evap = 0.86*0.2 ! COAMPS value of KK C_evap + !real, public :: C_evap = 0.55 ! KK 2000, Marshall-Palmer (1948) value. + + real( kind = core_rknd ), public :: r_0 ! 25.0e-6 ! Assumed radius of all new drops; m. + ! Value specified in KK (2000); p. 235. + ! Vince Larson set r_0=28mum to agree with COAMPS-LES formula. 15 April 2005 + !REAL, PARAMETER:: r_0 = 28.0e-6 ! Assumed radius of all new drops; m. + ! ! Value that COAMPS LES has in it. + !REAL, PARAMETER:: r_0 = 30.0e-6 ! Assumed radius of all new drops; m. + ! ! Khairoutdinov said it was okay! + ! End Vince Larson's change. + +!$omp threadprivate( C_evap, r_0 ) + + ! Values of exponents in KK microphysics + real( kind = core_rknd ), public :: & + KK_evap_Supersat_exp, & ! Exponent on Supersaturation (S) in KK evap. eq.; 1 + KK_evap_rr_exp, & ! Exponent on r_r in KK evaporation eq.; 1/3 + KK_evap_Nr_exp, & ! Exponent on N_r in KK evaporation eq.; 2/3 + KK_auto_rc_exp, & ! Exponent on r_c in KK autoconversion eq.; 2.47 + KK_auto_Nc_exp, & ! Exponent on N_c in KK autoconversion eq.; -1.79 + KK_accr_rc_exp, & ! Exponent on r_c in KK accretion eq.; 1.15 + KK_accr_rr_exp, & ! Exponent on r_r in KK accretion eq.; 1.15 + KK_mvr_rr_exp, & ! Exponent on r_r in KK mean volume radius eq.; 1/3 + KK_mvr_Nr_exp ! Exponent on N_r in KK mean volume radius eq.; -1/3 + +!$omp threadprivate( KK_evap_Supersat_exp, KK_evap_rr_exp, KK_evap_Nr_exp, & +!$omp KK_auto_rc_exp, KK_auto_Nc_exp, KK_accr_rc_exp, & +!$omp KK_accr_rr_exp, KK_mvr_rr_exp, KK_mvr_Nr_exp ) + + ! Parameters added for ice microphysics and latin hypercube sampling + + real( kind = core_rknd ), public :: & + rsnowp2_on_rsnowm2_cloud, & + Nsnowp2_on_Nsnowm2_cloud, & + ricep2_on_ricem2_cloud, & + Nicep2_on_Nicem2_cloud + +!$omp threadprivate( rsnowp2_on_rsnowm2_cloud, Nsnowp2_on_Nsnowm2_cloud, & +!$omp ricep2_on_ricem2_cloud, Nicep2_on_Nicem2_cloud ) + + real( kind = core_rknd ), public :: & + rsnowp2_on_rsnowm2_below, & + Nsnowp2_on_Nsnowm2_below, & + ricep2_on_ricem2_below, & + Nicep2_on_Nicem2_below + +!$omp threadprivate( rsnowp2_on_rsnowm2_below, Nsnowp2_on_Nsnowm2_below, & +!$omp ricep2_on_ricem2_below, Nicep2_on_Nicem2_below ) + + private ! Default Scope + + +end module crmx_parameters_microphys diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 new file mode 100644 index 0000000000..4af1f55c36 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 @@ -0,0 +1,160 @@ +!------------------------------------------------------------------------------- +! $Id: parameters_model.F90 5723 2012-02-15 17:20:44Z meyern@uwm.edu $ +!=============================================================================== +module crmx_parameters_model + +! Description: +! Contains model parameters that are determined at run time rather than +! compile time. +! +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd + + implicit none + + private ! Default scope + + ! Maximum allowable value for Lscale [m]. + ! Value depends on whether the model is run by itself or as part of a + ! host model. + real( kind = core_rknd ), public :: Lscale_max + +!$omp threadprivate(Lscale_max) + + ! Maximum magnitude of PDF parameter 'mixt_frac'. + real( kind = core_rknd ), public :: mixt_frac_max_mag + +!$omp threadprivate(mixt_frac_max_mag) + + ! Model parameters and constraints setup in the namelists + real( kind = core_rknd ), public :: & + T0, & ! Reference temperature (usually 300) [K] + ts_nudge ! Timescale of u/v nudging [s] + +#ifdef GFDL + real( kind = core_rknd ), public :: & ! h1g, 2010-06-15 + cloud_frac_min ! minimum cloud fraction for droplet # +#endif + + +!$omp threadprivate(T0, ts_nudge) + + real( kind = core_rknd), public :: & + rtm_min, & ! Value below which rtm will be nudged [kg/kg] + rtm_nudge_max_altitude ! Highest altitude at which to nudge rtm [m] + + integer, public :: & + sclr_dim, & ! Number of passive scalars + edsclr_dim, & ! Number of eddy-diff. passive scalars + hydromet_dim ! Number of hydrometeor species + +!$omp threadprivate(sclr_dim, edsclr_dim, hydromet_dim) + + real( kind = core_rknd ), dimension(:), allocatable, public :: & + sclr_tol ! Threshold(s) on the passive scalars [units vary] + +!$omp threadprivate(sclr_tol) + + real( kind = 4 ), public :: PosInf + +!$omp threadprivate(PosInf) + + public :: setup_parameters_model + + contains + +!------------------------------------------------------------------------------- + subroutine setup_parameters_model & + ( T0_in, ts_nudge_in, & + hydromet_dim_in, & + sclr_dim_in, sclr_tol_in, edsclr_dim_in, & + Lscale_max_in & + +#ifdef GFDL + , cloud_frac_min_in & ! hlg, 2010-6-15 +#endif + + ) + +! Description: +! Sets parameters to their initial values +! +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: Skw_max_mag, Skw_max_mag_sqd + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: sqrt, allocated, transfer + + ! Constants + integer(kind=4), parameter :: nanbits = 2139095040 + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + T0_in, & ! Ref. temperature [K] + ts_nudge_in, & ! Timescale for u/v nudging [s] + Lscale_max_in ! Largest value for Lscale [m] + +#ifdef GFDL + real( kind = core_rknd ), intent(in) :: cloud_frac_min_in ! h1g, 2010-06-15 +#endif + + + integer, intent(in) :: & + hydromet_dim_in, & ! Number of hydrometeor species + sclr_dim_in, & ! Number of passive scalars + edsclr_dim_in ! Number of eddy-diff. passive scalars + + real( kind = core_rknd ), intent(in), dimension(sclr_dim_in) :: & + sclr_tol_in ! Threshold on passive scalars + + ! --- Begin Code --- + + ! Formula from subroutine pdf_closure, where sigma_sqd_w = 0.4 and Skw = + ! Skw_max_mag in this formula. Note that this is constant, but can't appear + ! with a Fortran parameter attribute, so we define it here. + mixt_frac_max_mag = 1.0_core_rknd & + - ( 0.5_core_rknd * ( 1.0_core_rknd - Skw_max_mag / & + sqrt( 4.0_core_rknd * ( 1.0_core_rknd - 0.4_core_rknd )**3 & + + Skw_max_mag_sqd ) ) ) ! Known magic number + + Lscale_max = Lscale_max_in + + T0 = T0_in + ts_nudge = ts_nudge_in + + hydromet_dim = hydromet_dim_in + sclr_dim = sclr_dim_in + edsclr_dim = edsclr_dim_in + + ! In a tuning run, this array has the potential to be allocated already + if ( .not. allocated( sclr_tol ) ) then + allocate( sclr_tol(1:sclr_dim) ) + else + deallocate( sclr_tol ) + allocate( sclr_tol(1:sclr_dim) ) + end if + + sclr_tol(1:sclr_dim) = sclr_tol_in(1:sclr_dim) + + PosInf = transfer( nanbits, PosInf ) + +#ifdef GFDL + cloud_frac_min = cloud_frac_min_in ! h1g, 2010-06-15 +#endif + + return + end subroutine setup_parameters_model +!------------------------------------------------------------------------------- + +end module crmx_parameters_model diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 new file mode 100644 index 0000000000..7ade0432e1 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 @@ -0,0 +1,78 @@ +!------------------------------------------------------------------------------- +! $Id: parameters_radiation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_parameters_radiation + +! Description: +! Parameters for radiation schemes + +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + dp, & ! double precision + core_rknd + + implicit none + + character(len=20), public :: & + rad_scheme ! Either BUGSrad, simplified, or simplied_bomex + + real( kind = dp ), dimension(1), public :: & + sol_const ! Solar constant + + real( kind = core_rknd ), public :: & + radiation_top ! The top of the atmosphere fed into a radiation scheme. + ! The computational grid should be extended to reach this + ! altitude. + + ! Albedo values (alvdr is used in the simplifed schemes as well) + real( kind = dp ), public :: & + alvdr, & !Visible direct surface albedo [-] + alndr, & !Near-IR direct surface albedo [-] + alvdf, & !Visible diffuse surface albedo [-] + alndf !Near-IR diffuse surface albedo [-] + + + ! Long-wave constants (simplified radiation) + real( kind = core_rknd ), public :: & + kappa, & ! A constant (Duynkerke eqn. 5) [m^2/kg] + F0, & ! Coefficient for cloud top heating (see Stevens) [W/m^2] + F1 ! Coefficient for cloud base heating (see Stevens)[W/m^2] + + ! Short-wave constants + real( kind = core_rknd ), public :: & + eff_drop_radius, & ! Effective droplet radius [m] + gc, & ! Asymmetry parameter, "g" in Duynkerke [-] + omega ! Single-scattering albedo [-] + + real( kind = dp ), public :: & + slr ! Fraction of daylight + + real( kind = core_rknd ), public, dimension(20) :: & + Fs_values, & ! List of Fs0 values for simplified radiation + cos_solar_zen_times, & ! List of cosine of the solar zenith angle times + cos_solar_zen_values ! List of cosine of the solar zenith angle values + + logical, public :: & + l_fix_cos_solar_zen, l_sw_radiation + + logical, public :: & + l_rad_above_cloud ! Use DYCOMS II RF02 heaviside step function + + integer, public :: & + nparam + + ! Flag to signal the use of the U.S. Standard Atmosphere Profile, 1976 + logical, public :: l_use_default_std_atmosphere + + private ! Default Scope + +! OpenMP directives. The first column of these cannot be indented. +!$omp threadprivate(rad_scheme, sol_const, alvdr, alvdf, alndr, alndf, & +!$omp kappa, F0, F1, eff_drop_radius, gc, omega, radiation_top, Fs_values, & +!$omp l_rad_above_cloud, cos_solar_zen_times, cos_solar_zen_values, & +!$omp l_fix_cos_solar_zen, nparam, & +!$omp l_sw_radiation, l_use_default_std_atmosphere) + +end module crmx_parameters_radiation diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 new file mode 100644 index 0000000000..818985e39d --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 @@ -0,0 +1,1246 @@ +!----------------------------------------------------------------------- +! $Id: parameters_tunable.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ +!=============================================================================== +module crmx_parameters_tunable + + ! Description: + ! This module contains tunable model parameters. The purpose of the module is to make it + ! easier for the clubb_tuner code to use the params vector without "knowing" any information + ! about the individual parameters contained in the vector itself. It makes it easier to add + ! new parameters to be tuned for, but does not make the CLUBB_core code itself any simpler. + ! The parameters within the vector do not need to be the same variables used in the rest of + ! CLUBB_core (see for e.g. nu1_vert_res_dep or lmin_coef). + ! The parameters in the params vector only need to be those parameters for which we're not + ! sure the correct value and we'd like to tune for. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_parameter_indices, only: nparams ! Variable(s) + + use crmx_grid_class, only: gr ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Default to private + private + + public :: setup_parameters, read_parameters, read_param_spread, & + get_parameters, adj_low_res_nu, cleanup_nu + + ! Model constant parameters + real( kind = core_rknd ), public :: & + C1 = 2.500000_core_rknd, & ! Low Skewness in C1 Skewness Function. + C1b = 2.500000_core_rknd, & ! High Skewness in C1 Skewness Function. + C1c = 1.000000_core_rknd, & ! Degree of Slope of C1 Skewness Function. + C2 = 1.300000_core_rknd, & ! Low Skewness in C2 Skewness Function. + C2rt = 1.500000_core_rknd, & ! C2 coefficient for the rtp2_dp1 term. + C2thl = 1.000000_core_rknd, & ! C2 coefficient for the thlp2_dp1 term. + C2rtthl = 2.000000_core_rknd, & ! C2 coefficient for the rtpthlp_dp1 term. + C2b = 1.300000_core_rknd, & ! High Skewness in C2 Skewness Function. + C2c = 5.000000_core_rknd, & ! Degree of Slope of C2 Skewness Function. + C4 = 5.200000_core_rknd, & ! Used only when l_tke_aniso is true. + C5 = 0.300000_core_rknd, & ! Coefficient in pressure terms in the w'^2 eqn. + C6rt = 2.300000_core_rknd, & ! Low Skewness in C6rt Skewness Function. + C6rtb = 6.000000_core_rknd, & ! High Skewness in C6rt Skewness Function. + C6rtc = 1.000000_core_rknd, & ! Degree of Slope of C6rt Skewness Function. + C6thl = 4.000000_core_rknd, & ! Low Skewness in C6thl Skewness Function. + C6thlb = 6.000000_core_rknd, & ! High Skewness in C6thl Skewness Function. + C6thlc = 1.000000_core_rknd, & ! Degree of Slope of C6thl Skewness Function. + C7 = 0.320000_core_rknd, & ! Low Skewness in C7 Skewness Function. + C7b = 0.800000_core_rknd, & ! High Skewness in C7 Skewness Function. + C7c = 0.500000_core_rknd, & ! Degree of Slope of C7 Skewness Function. + C8 = 3.000000_core_rknd, & ! Coefficient #1 in C8 Skewness Equation. + C8b = 0.000000_core_rknd, & ! Coefficient #2 in C8 Skewness Equation. + C10 = 3.300000_core_rknd, & ! Currently Not Used in the Model. + C11 = 0.80000_core_rknd, & ! Low Skewness in C11 Skewness Function. + C11b = 0.350000_core_rknd, & ! High Skewness in C11 Skewness Function. + C11c = 0.500000_core_rknd, & ! Degree of Slope of C11 Skewness Function. + C12 = 1.000000_core_rknd, & ! Constant in w'^3 Crank-Nicholson diffusional term. + C13 = 0.100000_core_rknd, & ! Not currently used in model. + C14 = 1.000000_core_rknd, & ! Constant for u'^2 and v'^2 terms. + C15 = 0.4_core_rknd ! Coefficient for the wp3_bp2 term + + real( kind = core_rknd ), public :: & + C6rt_Lscale0 = 14.0_core_rknd, & ! Damp C6rt as a function of Lscale + C6thl_Lscale0 = 14.0_core_rknd, & ! Damp C6thl as a function of Lscale + C7_Lscale0 = 0.8500000_core_rknd, & ! Damp C7 as a function of Lscale + wpxp_L_thresh = 60.0_core_rknd ! Lscale threshold for damping C6 and C7 coefficients + + real( kind = core_rknd ), public :: & + c_K = 0.200000_core_rknd, & ! Constant C_mu^(1/4) in Duynkerke & Driedonks 1987. + c_K1 = 0.750000_core_rknd, & ! Coefficient of Eddy Diffusion for wp2. + c_K2 = 0.125000_core_rknd, & ! Coefficient of Eddy Diffusion for xp2. + c_K6 = 0.375000_core_rknd, & ! Coefficient of Eddy Diffusion for wpthlp and wprtp. + c_K8 = 1.250000_core_rknd, & ! Coefficient of Eddy Diffusion for wp3. + c_K9 = 0.250000_core_rknd, & ! Coefficient of Eddy Diffusion for up2 and vp2. + c_Krrainm = 0.200000_core_rknd, & ! Coefficient of Eddy Diffusion for hydrometeors. + gamma_coef = 0.320000_core_rknd, & ! Low Skewness in gamma coefficient Skewness Function. + gamma_coefb = 0.320000_core_rknd, & ! High Skewness in gamma coefficient Skewness Function. + gamma_coefc = 5.000000_core_rknd, & ! Degree of Slope of gamma coefficient Skewness Function. + mu = 1.000E-3_core_rknd, & ! Fractional entrainment rate per unit altitude. + mult_coef = 1.500000_core_rknd, & ! Coefficient applied to log( avg dz / threshold ) + taumin = 90.00000_core_rknd, & ! Minimum allowable value of time-scale tau. + taumax = 3600.000_core_rknd, & ! Maximum allowable value of time-scale tau. + lmin ! Minimum value for the length scale. + + real( kind = core_rknd ), public :: & + Lscale_mu_coef = 2.0_core_rknd, & ! Coefficient to perturb mu for an avg calculation of Lscale + Lscale_pert_coef = 0.1_core_rknd ! Coeff to perturb thlm and rtm for an avg calc of Lscale. + + real( kind = core_rknd ), public :: & + alpha_corr = 0.15_core_rknd ! Coefficient for the correlation diagnosis algoritm + + real( kind = core_rknd ), private :: & + nu1 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wp2. + nu2 = 5.000000_core_rknd, & ! Background Coefficient of Eddy Diffusion for xp2. + nu6 = 5.000000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wpxp. + nu8 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wp3. + nu9 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for up2 and vp2. + nu10 = 0.00000_core_rknd,&! Background Coef of Eddy Dfsn for edsclrm, um, vm, upwp, vpwp + nu_r = 1.500000_core_rknd,& ! Background Coefficient of Eddy Diffusion for hydrometeors. + nu_hd = 20000.00_core_rknd ! Constant coefficient for 4th-order hyper-diffusion. + +!$omp threadprivate(C1, C1b, C1c, C2, C2b, C2c, & +!$omp C2rt, C2thl, C2rtthl, C4, C5, C6rt, C6rtb, C6rtc, & +!$omp C6thl, C6thlb, C6thlc, & +!$omp C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, C12, & +!$omp C13, C14, C15, & +!$omp c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & +!$omp c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, nu_hd, & +!$omp gamma_coef, gamma_coefb, gamma_coefc, mult_coef, & +!$omp taumin, taumax, mu, lmin, Lscale_mu_coef, Lscale_pert_coef) + + real( kind = core_rknd ), public, allocatable, dimension(:) :: & + nu1_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wp2. + nu2_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for xp2. + nu6_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wpxp. + nu8_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wp3. + nu9_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for up2 and vp2. + nu10_vert_res_dep, & ! Background Coef of Eddy Dfsn for edsclrm,um,vm,upwp,vpwp. + nu_r_vert_res_dep ! Background Coefficient of Eddy Diffusion for hydrometeors. + + real( kind = core_rknd ), public :: & + nu_hd_vert_res_dep ! Constant coefficient for 4th-order hyper-diffusion. + +!$omp threadprivate(nu1_vert_res_dep, nu2_vert_res_dep, nu6_vert_res_dep, & +!$omp nu8_vert_res_dep, nu9_vert_res_dep, nu10_vert_res_dep, nu_r_vert_res_dep, & +!$omp nu_hd_vert_res_dep ) + + ! Vince Larson added a constant to set plume widths for theta_l and rt + ! beta should vary between 0 and 3, with 1.5 the standard value + + real( kind = core_rknd ), public :: beta = 1.750000_core_rknd + +!$omp threadprivate(beta) + + real( kind = core_rknd ), private :: lmin_coef = 0.500000_core_rknd ! Coefficient of lmin + +!$omp threadprivate(lmin_coef) + + ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz +#ifdef GFDL + logical, public :: l_prescribed_avg_deltaz = .true. +#else + logical, public :: l_prescribed_avg_deltaz = .false. +#endif + +!$omp threadprivate(l_prescribed_avg_deltaz) + + ! Since we lack a devious way to do this just once, this namelist + ! must be changed as well when a new parameter is added. + namelist /initvars/ & + C1, C1b, C1c, C2, C2b, C2c, & + C2rt, C2thl, C2rtthl, C4, C5, & + C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, & + C12, C13, C14, C15, C6rt_Lscale0, C6thl_Lscale0, & + C7_Lscale0, wpxp_L_thresh, c_K, c_K1, nu1, c_K2, nu2, & + c_K6, nu6, c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, beta, gamma_coef, gamma_coefb, gamma_coefc, lmin_coef, & + mult_coef, taumin, taumax, mu, Lscale_mu_coef, Lscale_pert_coef, & + alpha_corr + + ! These are referenced together often enough that it made sense to + ! make a list of them. Note that lmin_coef is the input parameter, + ! while the actual lmin model constant is computed from this. + !*************************************************************** + ! ***** IMPORTANT ***** + ! If you change the order of the parameters in the parameter_indices, + ! you will need to change the order of this list as well or the + ! tuner will break! + ! ***** IMPORTANT ***** + !*************************************************************** + character(len=16), dimension(nparams), parameter, public :: & + params_list = & + (/"C1 ", "C1b ", "C1c ", "C2 ", & + "C2b ", "C2c ", "C2rt ", "C2thl ", & + "C2rtthl ", "C4 ", "C5 ", "C6rt ", & + "C6rtb ", "C6rtc ", "C6thl ", "C6thlb ", & + "C6thlc ", "C7 ", "C7b ", "C7c ", & + "C8 ", "C8b ", "C10 ", "C11 ", & + "C11b ", "C11c ", "C12 ", "C13 ", & + "C14 ", "C15 ", "C6rt_Lscale0 ", "C6thl_Lscale0 ", & + "C7_Lscale0 ", "wpxp_L_thresh ", "c_K ", "c_K1 ", & + "nu1 ", "c_K2 ", "nu2 ", "c_K6 ", & + "nu6 ", "c_K8 ", "nu8 ", "c_K9 ", & + "nu9 ", "nu10 ", "c_Krrainm ", "nu_r ", & + "nu_hd ", "gamma_coef ", "gamma_coefb ", "gamma_coefc ", & + "mu ", "beta ", "lmin_coef ", "mult_coef ", & + "taumin ", "taumax ", "Lscale_mu_coef ", "Lscale_pert_coef", & + "alpha_corr " /) + + real( kind = core_rknd ), parameter :: & + init_value = -999._core_rknd ! Initial value for the parameters, used to detect missing values + + contains + + !============================================================================= + subroutine setup_parameters & + ( deltaz, params, nzmax, & + grid_type, momentum_heights, thermodynamic_heights, & + err_code ) + + ! Description: + ! Subroutine to setup model parameters + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Variable(s) + + use crmx_error_code, only: & + clubb_var_out_of_bounds, & ! Variable(s) + clubb_no_error + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + deltaz ! Change per height level [m] + + real( kind = core_rknd ), intent(in), dimension(nparams) :: & + params ! Tuneable model parameters [-] + + ! Grid definition + integer, intent(in) :: nzmax ! Vertical grid levels [#] + + ! If CLUBB is running on its own, this option determines + ! if it is using: + ! 1) an evenly-spaced grid, + ! 2) a stretched (unevenly-spaced) grid entered on the + ! thermodynamic grid levels (with momentum levels set + ! halfway between thermodynamic levels), or + ! 3) a stretched (unevenly-spaced) grid entered on the + ! momentum grid levels (with thermodynamic levels set + ! halfway between momentum levels). + integer, intent(in) :: grid_type + + ! If the CLUBB parameterization is implemented in a host model, + ! it needs to use the host model's momentum level altitudes + ! and thermodynamic level altitudes. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on thermodynamic levels (grid_type = 2), + ! it needs to use the thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on momentum levels (grid_type = 3), + ! it needs to use the momentum level altitudes as input. + real( kind = core_rknd ), intent(in), dimension(nzmax) :: & + momentum_heights, & ! Momentum level altitudes (input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (input) [m] + + ! Output Variables + integer, intent(out) :: & + err_code ! Error condition + + ! Local Variables + real( kind = core_rknd ), parameter :: & + lmin_deltaz = 40.0_core_rknd ! Fixed value for minimum value for the length scale. + + !-------------------- Begin code -------------------- + + call unpack_parameters( params, & + C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr ) + + + ! It was decided after some experimentation, that the best + ! way to produce grid independent results is to set lmin to be + ! some fixed value. -dschanen 21 May 2007 + !lmin = lmin_coef * deltaz ! Old + lmin = lmin_coef * lmin_deltaz ! New fixed value + + ! ### Adjust Constant Diffusivity Coefficients Based On Grid Spacing ### + call adj_low_res_nu & + ( nzmax, grid_type, deltaz, & ! Intent(in) + momentum_heights, thermodynamic_heights ) ! Intent(in) + + ! Sanity check + if ( beta < 0.0_core_rknd .or. beta > 3.0_core_rknd ) then + + ! Constraints on beta + write(fstderr,*) "beta = ", beta + write(fstderr,*) "beta cannot be < 0 or > 3" + err_code = clubb_var_out_of_bounds + + else if ( mu < 0.0_core_rknd ) then + + ! Constraints on entrainment rate, mu. + write(fstderr,*) "mu = ", mu + write(fstderr,*) "mu cannot be < 0" + err_code = clubb_var_out_of_bounds + + else if ( lmin < 4.0_core_rknd ) then + + ! Constraints on mixing length + write(fstderr,*) "lmin = ", lmin + write(fstderr,*) "lmin is < 4.0_core_rknd" + err_code = clubb_var_out_of_bounds + + else + + err_code = clubb_no_error + + end if ! A parameter is outside the acceptable range + +! write(*,nml=initvars) ! %% debug + + + return + + end subroutine setup_parameters + + !============================================================================= + subroutine adj_low_res_nu & + ( nzmax, grid_type, deltaz, & ! Intent(in) + momentum_heights, thermodynamic_heights ) ! Intent(in) + + ! Description: + ! Adjust the values of background eddy diffusivity based on + ! vertical grid spacing. + ! This code was made into a public subroutine so that it may be + ! called multiple times per model run in scenarios where grid + ! altitudes, and hence average grid spacing, change through space + ! and/or time. This occurs, for example, when CLUBB is + ! implemented in WRF. --ldgrant Jul 2010 + !---------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant Parameters + + ! Flag for adjusting the values of the constant background eddy diffusivity + ! coefficients based on the average vertical grid spacing. If this flag is + ! turned off, the values of the various nu coefficients will remain as they + ! are declared in the tunable_parameters.in file. + logical, parameter :: l_adj_low_res_nu = .true. + + ! The size of the average vertical grid spacing that serves as a threshold + ! for when to increase the size of the background eddy diffusivity + ! coefficients (nus) by a certain factor above what the background + ! coefficients are specified to be in tunable_parameters.in. At any average + ! grid spacing at or below this value, the values of the background + ! diffusivities remain the same. However, at any average vertical grid + ! spacing above this value, the values of the background eddy diffusivities + ! are increased. Traditionally, the threshold grid spacing has been set to + ! 40.0 meters. This is only relevant if l_adj_low_res_nu is turned on. + real( kind = core_rknd ), parameter :: & + grid_spacing_thresh = 40.0_core_rknd ! grid spacing threshold [m] + + ! Input Variables + + ! Grid definition + integer, intent(in) :: nzmax ! Vertical grid levels [#] + + ! If CLUBB is running on it's own, this option determines + ! if it is using: + ! 1) an evenly-spaced grid, + ! 2) a stretched (unevenly-spaced) grid entered on the + ! thermodynamic grid levels (with momentum levels set + ! halfway between thermodynamic levels), or + ! 3) a stretched (unevenly-spaced) grid entered on the + ! momentum grid levels (with thermodynamic levels set + ! halfway between momentum levels). + integer, intent(in) :: grid_type + + real( kind = core_rknd ), intent(in) :: & + deltaz ! Change per height level [m] + + ! If the CLUBB parameterization is implemented in a host model, + ! it needs to use the host model's momentum level altitudes + ! and thermodynamic level altitudes. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on thermodynamic levels (grid_type = 2), + ! it needs to use the thermodynamic level altitudes as input. + ! If the CLUBB model is running by itself, but is using a + ! stretched grid entered on momentum levels (grid_type = 3), + ! it needs to use the momentum level altitudes as input. + real( kind = core_rknd ), intent(in), dimension(nzmax) :: & + momentum_heights, & ! Momentum level altitudes (input) [m] + thermodynamic_heights ! Thermodynamic level altitudes (input) [m] + + ! Local Variables + real( kind = core_rknd ) :: avg_deltaz ! Average grid box height [m] + + ! The factor by which to multiply the coefficients of background eddy + ! diffusivity if the grid spacing threshold is exceeded and l_adj_low_res_nu + ! is turned on. + real( kind = core_rknd ),dimension(gr%nz) :: & + mult_factor_zt, & ! Uses gr%dzt for nu values on zt levels + mult_factor_zm ! Uses gr%dzm for nu values on zm levels + + ! Flag to enable nu values that are a function of grid spacing + logical, parameter :: l_nu_grid_dependent = .false. + + integer :: k ! Loop variable + + !--------------- Begin code ------------------------- + + if ( .not. allocated( nu1_vert_res_dep ) ) then + allocate( nu1_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu2_vert_res_dep ) ) then + allocate( nu2_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu6_vert_res_dep ) ) then + allocate( nu6_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu8_vert_res_dep ) ) then + allocate( nu8_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu9_vert_res_dep ) ) then + allocate( nu9_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu10_vert_res_dep ) ) then + allocate( nu10_vert_res_dep(1:gr%nz) ) + end if + if ( .not. allocated( nu_r_vert_res_dep ) ) then + allocate( nu_r_vert_res_dep(1:gr%nz) ) + end if + + ! Flag for adjusting the values of the constant diffusivity coefficients + ! based on the grid spacing. If this flag is turned off, the values of the + ! various nu coefficients will remain as they are declared in the + ! parameters.in file. + if ( l_adj_low_res_nu ) then + + ! ### Adjust Constant Diffusivity Coefficients Based On Grid Spacing ### + + ! All of the background coefficients of eddy diffusivity, as well as the + ! constant coefficient for 4th-order hyper-diffusion, must be adjusted + ! based on the size of the grid spacing. For a case that uses an + ! evenly-spaced grid, the adjustment is based on the constant grid + ! spacing deltaz. For a case that uses a stretched grid, the adjustment + ! is based on avg_deltaz, which is the average grid spacing over the + ! vertical domain. + + if ( l_prescribed_avg_deltaz ) then + + avg_deltaz = deltaz + + else if ( grid_type == 3 ) then + + ! CLUBB is implemented in a host model, or is using grid_type = 3 + + ! Find the average deltaz over the grid based on momentum level + ! inputs. + + avg_deltaz & + = ( momentum_heights(nzmax) - momentum_heights(1) ) & + / real( nzmax - 1, kind = core_rknd ) + + else if ( grid_type == 1 ) then + + ! Evenly-spaced grid. + + avg_deltaz = deltaz + + else if ( grid_type == 2 ) then + + ! Stretched (unevenly-spaced) grid: stretched thermodynamic level + ! input. + + ! Find the average deltaz over the stretched grid based on + ! thermodynamic level inputs. + + avg_deltaz & + = ( thermodynamic_heights(nzmax) - thermodynamic_heights(1) ) & + / real( nzmax - 1, kind = core_rknd ) + else + ! Eric Raut added to remove compiler warning. (Obviously, this value is not used) + avg_deltaz = 0.0_core_rknd + write(fstderr,*) "Invalid grid_type:", grid_type + stop "Fatal error" + + end if ! grid_type + + ! The nu's are chosen for deltaz <= 40 m. Looks like they must + ! be adjusted for larger grid spacings (Vince Larson) + if( .not. l_nu_grid_dependent ) then + ! Use a constant mult_factor so nu does not depend on grid spacing + if( avg_deltaz > grid_spacing_thresh ) then + mult_factor_zt = 1.0_core_rknd + mult_coef * log( avg_deltaz / grid_spacing_thresh ) + mult_factor_zm = mult_factor_zt + else + mult_factor_zt = 1.0_core_rknd + mult_factor_zm = 1.0_core_rknd + end if + else ! l_nu_grid_dependent = .true. + ! mult_factor will vary to create nu values that vary with grid spacing + do k = 1, gr%nz + if( gr%dzm(k) > grid_spacing_thresh ) then + mult_factor_zm(k) = 1.0_core_rknd + mult_coef * log( gr%dzm(k) / grid_spacing_thresh ) + else + mult_factor_zm(k) = 1.0_core_rknd + end if + + if( gr%dzt(k) > grid_spacing_thresh ) then + mult_factor_zt(k) = 1.0_core_rknd + mult_coef * log( gr%dzt(k) / grid_spacing_thresh ) + else + mult_factor_zt(k) = 1.0_core_rknd + end if + end do + end if ! l_nu_grid_dependent + + !mult_factor = 1.0_core_rknd + mult_coef * log( avg_deltaz / grid_spacing_thresh ) + nu1_vert_res_dep = nu1 * mult_factor_zm + nu2_vert_res_dep = nu2 * mult_factor_zm + nu6_vert_res_dep = nu6 * mult_factor_zm + nu8_vert_res_dep = nu8 * mult_factor_zt + nu9_vert_res_dep = nu9 * mult_factor_zm + nu10_vert_res_dep = nu10 * mult_factor_zt !We're unsure of the grid + nu_r_vert_res_dep = nu_r * mult_factor_zt + + ! The value of nu_hd is based on an average grid box spacing of + ! 40 m. The value of nu_hd should be adjusted proportionally to + ! the average grid box size, whether the average grid box size is + ! less than 40 m. or greater than 40 m. + ! Since nu_hd should be very large for large grid boxes, but + ! substantially smaller for small grid boxes, the grid spacing + ! adjuster is squared. + + nu_hd_vert_res_dep = nu_hd * ( avg_deltaz / grid_spacing_thresh )**2 + + else ! nu values are not adjusted + + nu1_vert_res_dep = nu1 + nu2_vert_res_dep = nu2 + nu6_vert_res_dep = nu6 + nu8_vert_res_dep = nu8 + nu9_vert_res_dep = nu9 + nu10_vert_res_dep = nu10 + nu_r_vert_res_dep = nu_r + nu_hd_vert_res_dep = nu_hd + + end if ! l_adj_low_res_nu + + return + end subroutine adj_low_res_nu + + !============================================================================= + subroutine read_parameters( iunit, filename, params ) + + ! Description: + ! Read a namelist containing the model parameters + + ! References: + ! None + !----------------------------------------------------------------------- + use crmx_constants_clubb, only: fstderr ! Constant + + implicit none + + ! Input variables + integer, intent(in) :: iunit + + character(len=*), intent(in) :: filename + + ! Output variables + real( kind = core_rknd ), intent(out), dimension(nparams) :: params + + ! Local variables + integer :: i + + logical :: l_error + + ! ---- Begin Code ---- + + ! If the filename is empty, assume we're using a `working' set of + ! parameters that are set statically here (handy for host models). + ! Read the namelist + if ( filename /= "" ) then + ! Read the namelist + open(unit=iunit, file=filename, status='old', action='read') + + read(unit=iunit, nml=initvars) + + close(unit=iunit) + + end if + + ! Put the variables in the output array + call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, params ) + + l_error = .false. + + do i = 1, nparams + if ( params(i) == init_value ) then + write(fstderr,*) "Tuning parameter "//trim( params_list(i) )// & + " was missing from "//trim( filename ) + l_error = .true. + end if + end do + + if ( l_error ) stop "Fatal error." + + return + + end subroutine read_parameters + + !============================================================================= + subroutine read_param_spread & + ( iunit, filename, nindex, param_spread, ndim ) + + ! Description: + ! Read a namelist containing the amount to vary model parameters. + ! Used by the downhill simplex / simulated annealing algorithm. + + ! References: + ! None + !----------------------------------------------------------------------- + use crmx_constants_clubb, only: fstderr ! Constant + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input variables + integer, intent(in) :: iunit + + character(len=*), intent(in) :: filename + + ! Output variables + + ! An array of array indices (i.e. which elements of the array `params' + ! are contained within the simplex and the spread variable) + integer, intent(out), dimension(nparams) :: nindex + + real( kind = core_rknd ), intent(out), dimension(nparams) :: & + param_spread ! Amount to vary the parameter in the initial simplex + + integer, intent(out) :: ndim ! Dimension of the init simplex + + ! Local variables + integer :: i + + logical :: l_error + + ! Amount to change each parameter for the initial simplex + ! This MUST be changed to match the initvars namelist if parameters are added! + namelist /initspread/ & + C1, C1b, C1c, C2, C2b, C2c, & + C2rt, C2thl, C2rtthl, C4, C5, & + C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, & + C12, C13, C14, C15, C6rt_Lscale0, C6thl_Lscale0, & + C7_Lscale0, wpxp_L_thresh, c_K, c_K1, nu1, c_K2, nu2, & + c_K6, nu6, c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, beta, gamma_coef, gamma_coefb, gamma_coefc, & + lmin_coef, mult_coef, taumin, taumax, mu, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr + + ! Initialize values to -999. + call init_parameters_999( ) + + ! Read the namelist + open(unit=iunit, file=filename, status='old', action='read') + + read(unit=iunit, nml=initspread) + + close(unit=iunit) + + ! Put the variables in the output array + call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, param_spread ) + + l_error = .false. + + do i = 1, nparams + if ( param_spread(i) == init_value ) then + write(fstderr,*) "A spread parameter "//trim( params_list(i) )// & + " was missing from "//trim( filename ) + l_error = .true. + end if + end do + + if ( l_error ) stop "Fatal error." + + ! Initialize to zero + nindex(1:nparams) = 0 + ndim = 0 + + ! Determine how many variables are being changed + do i = 1, nparams, 1 + + if ( param_spread(i) /= 0.0_core_rknd ) then + ndim = ndim + 1 ! Increase the total + nindex(ndim) = i ! Set the next array index + endif + + enddo + + return + + end subroutine read_param_spread + + !============================================================================= + subroutine pack_parameters & + ( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, params ) + + ! Description: + ! Takes the list of scalar variables and puts them into a 1D vector. + ! It is here for the purpose of keeping the code generalized + ! when new variables are added. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_parameter_indices, only: & + iC1, & ! Variable(s) + iC1b, & + iC1c, & + iC2, & + iC2b, & + iC2c, & + iC2rt, & + iC2thl, & + iC2rtthl, & + iC4, & + iC5, & + iC6rt, & + iC6rtb, & + iC6rtc, & + iC6thl, & + iC6thlb, & + iC6thlc, & + iC7, & + iC7b, & + iC7c, & + iC8, & + iC8b, & + iC10, & + iC11, & + iC11b, & + iC11c, & + iC12, & + iC13, & + iC14, & + iC15 + + use crmx_parameter_indices, only: & + iC6rt_Lscale0, & + iC6thl_Lscale0, & + iC7_Lscale0, & + iwpxp_L_thresh + + use crmx_parameter_indices, only: & + ic_K, & + ic_K1, & + inu1, & + ic_K2, & + inu2, & + ic_K6, & + inu6, & + ic_K8, & + inu8, & + ic_K9, & + inu9, & + inu10, & + ic_Krrainm, & + inu_r, & + inu_hd, & + igamma_coef, & + igamma_coefb, & + igamma_coefc, & + imu, & + ibeta, & + ilmin_coef, & + imult_coef, & + itaumin, & + itaumax, & + iLscale_mu_coef, & + iLscale_pert_coef, & + ialpha_corr, & + nparams + + implicit none + + ! Input variables + real( kind = core_rknd ), intent(in) :: & + C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_Krrainm, nu_r, nu_hd, gamma_coef, & + gamma_coefb, gamma_coefc, mu, beta, lmin_coef, mult_coef, & + taumin, taumax, Lscale_mu_coef, Lscale_pert_coef, alpha_corr + + ! Output variables + real( kind = core_rknd ), intent(out), dimension(nparams) :: params + + params(iC1) = C1 + params(iC1b) = C1b + params(iC1c) = C1c + params(iC2) = C2 + params(iC2b) = C2b + params(iC2c) = C2c + params(iC2rt) = C2rt + params(iC2thl) = C2thl + params(iC2rtthl) = C2rtthl + params(iC4) = C4 + params(iC5) = C5 + params(iC6rt) = C6rt + params(iC6rtb) = C6rtb + params(iC6rtc) = C6rtc + params(iC6thl) = C6thl + params(iC6thlb) = C6thlb + params(iC6thlc) = C6thlc + params(iC7) = C7 + params(iC7b) = C7b + params(iC7c) = C7c + params(iC8) = C8 + params(iC8b) = C8b + params(iC10) = C10 + params(iC11) = C11 + params(iC11b) = C11b + params(iC11c) = C11c + params(iC12) = C12 + params(iC13) = C13 + params(iC14) = C14 + params(iC15) = C15 + + params(iC6rt_Lscale0) = C6rt_Lscale0 + params(iC6thl_Lscale0) = C6thl_Lscale0 + params(iC7_Lscale0) = C7_Lscale0 + params(iwpxp_L_thresh) = wpxp_L_thresh + + params(ic_K) = c_K + params(ic_K1) = c_K1 + params(inu1) = nu1 + params(ic_K2) = c_K2 + params(inu2) = nu2 + params(ic_K6) = c_K6 + params(inu6) = nu6 + params(ic_K8) = c_K8 + params(inu8) = nu8 + params(ic_K9) = c_K9 + params(inu9) = nu9 + params(inu10) = nu10 + params(ic_Krrainm) = c_Krrainm + params(inu_r) = nu_r + params(inu_hd) = nu_hd + + params(igamma_coef) = gamma_coef + params(igamma_coefb) = gamma_coefb + params(igamma_coefc) = gamma_coefc + + params(imu) = mu + + params(ibeta) = beta + + params(ilmin_coef) = lmin_coef + params(imult_coef) = mult_coef + + params(itaumin) = taumin + params(itaumax) = taumax + + params(iLscale_mu_coef) = Lscale_mu_coef + params(iLscale_pert_coef) = Lscale_pert_coef + params(ialpha_corr) = alpha_corr + + return + end subroutine pack_parameters + + !============================================================================= + subroutine unpack_parameters & + ( params, & + C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr ) + + ! Description: + ! Takes the 1D vector and returns the list of scalar variables. + ! Here for the purposes of keeping the code generalized + ! when new variables are added. + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_parameter_indices, only: & + iC1, & ! Variable(s) + iC1b, & + iC1c, & + iC2, & + iC2b, & + iC2c, & + iC2rt, & + iC2thl, & + iC2rtthl, & + iC4, & + iC5, & + iC6rt, & + iC6rtb, & + iC6rtc, & + iC6thl, & + iC6thlb, & + iC6thlc, & + iC7, & + iC7b, & + iC7c, & + iC8, & + iC8b, & + iC10, & + iC11, & + iC11b, & + iC11c, & + iC12, & + iC13, & + iC14, & + iC15 + + use crmx_parameter_indices, only: & + iC6rt_Lscale0, & + iC6thl_Lscale0, & + iC7_Lscale0, & + iwpxp_L_thresh + + use crmx_parameter_indices, only: & + ic_K, & + ic_K1, & + inu1, & + ic_K2, & + inu2, & + ic_K6, & + inu6, & + ic_K8, & + inu8, & + ic_K9, & + inu9, & + inu10, & + ic_Krrainm, & + inu_r, & + inu_hd, & + igamma_coef, & + igamma_coefb, & + igamma_coefc, & + imu, & + ibeta, & + ilmin_coef, & + imult_coef, & + itaumin, & + itaumax, & + iLscale_mu_coef, & + iLscale_pert_coef, & + ialpha_corr, & + nparams + + implicit none + + ! Input variables + real( kind = core_rknd ), intent(in), dimension(nparams) :: params + + ! Output variables + real( kind = core_rknd ), intent(out) :: & + C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr + + C1 = params(iC1) + C1b = params(iC1b) + C1c = params(iC1c) + C2 = params(iC2) + C2b = params(iC2b) + C2c = params(iC2c) + C2rt = params(iC2rt) + C2thl = params(iC2thl) + C2rtthl = params(iC2rtthl) + C4 = params(iC4) + C5 = params(iC5) + C6rt = params(iC6rt) + C6rtb = params(iC6rtb) + C6rtc = params(iC6rtc) + C6thl = params(iC6thl) + C6thlb = params(iC6thlb) + C6thlc = params(iC6thlc) + C7 = params(iC7) + C7b = params(iC7b) + C7c = params(iC7c) + C8 = params(iC8) + C8b = params(iC8b) + C10 = params(iC10) + C11 = params(iC11) + C11b = params(iC11b) + C11c = params(iC11c) + C12 = params(iC12) + C13 = params(iC13) + C14 = params(iC14) + C15 = params(iC15) + + C6rt_Lscale0 = params(iC6rt_Lscale0) + C6thl_Lscale0 = params(iC6thl_Lscale0) + C7_Lscale0 = params(iC7_Lscale0) + wpxp_L_thresh = params(iwpxp_L_thresh) + + c_K = params(ic_K) + c_K1 = params(ic_K1) + nu1 = params(inu1) + c_K2 = params(ic_K2) + nu2 = params(inu2) + c_K6 = params(ic_K6) + nu6 = params(inu6) + c_K8 = params(ic_K8) + nu8 = params(inu8) + c_K9 = params(ic_K9) + nu9 = params(inu9) + nu10 = params(inu10) + c_Krrainm = params(ic_Krrainm) + nu_r = params(inu_r) + nu_hd = params(inu_hd) + + gamma_coef = params(igamma_coef) + gamma_coefb = params(igamma_coefb) + gamma_coefc = params(igamma_coefc) + + mu = params(imu) + + beta = params(ibeta) + + lmin_coef = params(ilmin_coef) + mult_coef = params(imult_coef) + + taumin = params(itaumin) + taumax = params(itaumax) + + Lscale_mu_coef = params(iLscale_mu_coef) + Lscale_pert_coef = params(iLscale_pert_coef) + alpha_corr = params(ialpha_corr) + + return + end subroutine unpack_parameters + + !============================================================================= + subroutine get_parameters( params ) + + ! Description: + ! Return an array of all tunable parameters + + ! References: + ! None + !----------------------------------------------------------------------- + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(out), dimension(nparams) :: params + + call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & + C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C15, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & + c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & + nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & + mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, params ) + + return + + end subroutine get_parameters + + !============================================================================= + subroutine init_parameters_999( ) + + ! Description: + ! Set all tunable parameters to NaN + + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! --- Begin Code --- + + C1 = init_value + C1b = init_value + C1c = init_value + C2rt = init_value + C2thl = init_value + C2rtthl = init_value + C2 = init_value + C2b = init_value + C2c = init_value + C4 = init_value + C5 = init_value + C6rt = init_value + C6rtb = init_value + C6rtc = init_value + C6thl = init_value + C6thlb = init_value + C6thlc = init_value + C7 = init_value + C7b = init_value + C7c = init_value + C8 = init_value + C8b = init_value + C10 = init_value + C11 = init_value + C11b = init_value + C11c = init_value + C12 = init_value + C13 = init_value + C14 = init_value + C15 = init_value + C6rt_Lscale0 = init_value + C6thl_Lscale0 = init_value + C7_Lscale0 = init_value + wpxp_L_thresh = init_value + c_K = init_value + c_K1 = init_value + nu1 = init_value + c_K2 = init_value + nu2 = init_value + c_K6 = init_value + nu6 = init_value + c_K8 = init_value + nu8 = init_value + c_K9 = init_value + nu9 = init_value + nu10 = init_value + c_Krrainm = init_value + nu_r = init_value + nu_hd = init_value + beta = init_value + gamma_coef = init_value + gamma_coefb = init_value + gamma_coefc = init_value + mult_coef = init_value + taumin = init_value + taumax = init_value + lmin_coef = init_value + mu = init_value + Lscale_mu_coef = init_value + Lscale_pert_coef = init_value + alpha_corr = init_value + nu_hd_vert_res_dep = init_value + + return + end subroutine init_parameters_999 + + !============================================================================= + subroutine cleanup_nu( ) + + ! Description: + ! De-allocates memory used for the nu arrays + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant + + implicit none + + ! Local Variable(s) + integer :: ierr + + ! ----- Begin Code ----- + + deallocate( nu1_vert_res_dep, nu2_vert_res_dep, nu6_vert_res_dep, & + nu8_vert_res_dep, nu9_vert_res_dep, nu10_vert_res_dep, & + nu_r_vert_res_dep, stat = ierr ) + + if ( ierr /= 0 ) then + write(fstderr,*) "Nu deallocation failed." + end if + + return + + end subroutine cleanup_nu + +!=============================================================================== + +end module crmx_parameters_tunable diff --git a/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 new file mode 100644 index 0000000000..44e2f4f90a --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 @@ -0,0 +1,1208 @@ +! $Id: pdf_closure_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +module crmx_pdf_closure_module + + implicit none + + public :: pdf_closure + + private ! Set Default Scope + + contains +!------------------------------------------------------------------------ + + !####################################################################### + !####################################################################### + ! If you change the argument list of pdf_closure you also have to + ! change the calls to this function in the host models CAM, WRF, SAM + ! and GFDL. + !####################################################################### + !####################################################################### + subroutine pdf_closure & + ( p_in_Pa, exner, thv_ds, wm, & + wp2, wp3, sigma_sqd_w, & + Skw, rtm, rtp2, & + wprtp, thlm, thlp2, & + wpthlp, rtpthlp, sclrm, & + wpsclrp, sclrp2, sclrprtp, & + sclrpthlp, level, & +#ifdef GFDL + RH_crit, do_liquid_only_in_clubb,& ! h1g, 2010-06-15 +#endif + wp4, wprtp2, wp2rtp, & + wpthlp2, wp2thlp, wprtpthlp, & + cloud_frac, ice_supersat_frac, & + rcm, wpthvp, wp2thvp, rtpthvp, & + thlpthvp, wprcp, wp2rcp, rtprcp, & + thlprcp, rcp2, pdf_params, & + err_code, & + wpsclrprtp, wpsclrp2, sclrpthvp, & + wpsclrpthlp, sclrprcp, wp2sclrp, & + rc_coef ) + + +! Description: +! Subroutine that computes pdf parameters analytically. + +! Based of the original formulation, but with some tweaks +! to remove some of the less realistic assumptions and +! improve transport terms. + +! Corrected version that should remove inconsistency + +! References: +! Eqn. 29, 30, 31, 32 & 33 on p. 3547 of +! ``A PDF-Based Model for Boundary Layer Clouds. Part I: +! Method and Model Description'' Golaz, et al. (2002) +! JAS, Vol. 59, pp. 3540--3551. +!------------------------------------------------------------------------ + + use crmx_constants_clubb, only: & + ! Constants + sqrt_2pi, & ! sqrt(2*pi) + sqrt_2, & ! sqrt(2) + pi, & ! The ratio of radii to their circumference + two, & ! 2 + zero, & ! 0 + Cp, & ! Dry air specific heat at constant p [J/kg/K] + Lv, & ! Latent heat of vaporization [J/kg] + Rd, & ! Dry air gas constant [J/kg/K] + Rv, & ! Water vapor gas constant [J/kg/K] + ep, & ! Rd / Rv; ep = 0.622 [-] + ep1, & ! (1.0-ep)/ep; ep1 = 0.61 [-] + ep2, & ! 1.0/ep; ep2 = 1.61 [-] + w_tol_sqd, & ! Tolerance for w'^2 [m^2/s^2] + rt_tol, & ! Tolerance for r_t [kg/kg] + thl_tol, & ! Tolerance for th_l [K] + s_mellor_tol, & ! Tolerance for pdf parameter s [kg/kg] + T_freeze_K, & ! Freezing point of water [K] + fstderr, & + zero_threshold + + use crmx_parameters_model, only: & + sclr_tol, & ! Array of passive scalar tolerances [units vary] + sclr_dim, & ! Number of passive scalar variables + mixt_frac_max_mag ! Maximum values for PDF parameter 'mixt_frac' + + use crmx_parameters_tunable, only: & + beta ! Variable(s) + ! Plume widths for th_l and r_t [-] + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! type + + use crmx_anl_erf, only: & + erf ! Procedure(s) + ! The error function + + use crmx_numerical_check, only: & + pdf_closure_check ! Procedure(s) + + use crmx_saturation, only: & + sat_mixrat_liq, & ! Procedure(s) + sat_mixrat_ice + + use crmx_error_code, only: & + clubb_no_error ! Constant(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level, & ! Procedure(s) + fatal_error + + use crmx_stats_variables, only: & + iwp4, & ! Variables + ircp2, & + iwprtp2, & + iwprtpthlp, & + iwpthlp2 + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + +#ifdef sam1mom + use crmx_micro_params, only: tbgmin, tbgmax +#endif + + implicit none + + intrinsic :: sqrt, exp, min, max, abs, present + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + p_in_Pa, & ! Pressure [Pa] + exner, & ! Exner function [-] + thv_ds, & ! Dry, base-state theta_v (ref. th_l here) [K] + wm, & ! mean w-wind component (vertical velocity) [m/s] + wp2, & ! w'^2 [m^2/s^2] + wp3, & ! w'^3 [m^3/s^3] + sigma_sqd_w, & ! Width of individual w plumes [-] + Skw, & ! Skewness of w [-] + rtm, & ! Mean total water mixing ratio [kg/kg] + rtp2, & ! r_t'^2 [(kg/kg)^2] + wprtp, & ! w'r_t' [(kg/kg)(m/s)] + thlm, & ! Mean liquid water potential temperature [K] + thlp2, & ! th_l'^2 [K^2] + wpthlp, & ! w'th_l' [K(m/s)] + rtpthlp ! r_t'th_l' [K(kg/kg)] + + real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & + sclrm, & ! Mean passive scalar [units vary] + wpsclrp, & ! w' sclr' [units vary] + sclrp2, & ! sclr'^2 [units vary] + sclrprtp, & ! sclr' r_t' [units vary] + sclrpthlp ! sclr' th_l' [units vary] + +#ifdef GFDL + ! critial relative humidity for nucleation + real( kind = core_rknd ), dimension( min(1,sclr_dim), 2 ), intent(in) :: & ! h1g, 2010-06-15 + RH_crit ! critical relative humidity for droplet and ice nucleation +! ---> h1g, 2012-06-14 + logical, intent(in) :: do_liquid_only_in_clubb +! <--- h1g, 2012-06-14 +#endif + + integer, intent(in) :: & + level ! Thermodynamic level for which calculations are taking place. + + ! Output Variables + + real( kind = core_rknd ), intent(out) :: & + wp4, & ! w'^4 [m^4/s^4] + wprtp2, & ! w' r_t' [(m kg)/(s kg)] + wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)] + wpthlp2, & ! w' th_l'^2 [(m K^2)/s] + wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2] + cloud_frac, & ! Cloud fraction [-] + ice_supersat_frac, & ! Ice cloud fracion [-] + rcm, & ! Mean liquid water [kg/kg] + wpthvp, & ! Buoyancy flux [(K m)/s] + wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2] + rtpthvp, & ! r_t' th_v' [(kg K)/kg] + thlpthvp, & ! th_l' th_v' [K^2] + wprcp, & ! w' r_c' [(m kg)/(s kg)] + wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)] + rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)] + thlprcp, & ! th_l' r_c' [(K kg)/kg] + rcp2, & ! r_c'^2 [(kg^2)/(kg^2)] + wprtpthlp ! w' r_t' th_l' [(m kg K)/(s kg)] + + type(pdf_parameter), intent(out) :: & + pdf_params ! pdf paramters [units vary] + + integer, intent(out) :: & + err_code ! Are the outputs usable numbers? + + ! Output (passive scalar variables) + + real( kind = core_rknd ), intent(out), dimension(sclr_dim) :: & + sclrpthvp, & + sclrprcp, & + wpsclrp2, & + wpsclrprtp, & + wpsclrpthlp, & + wp2sclrp + + ! Local Variables + + real( kind = core_rknd ) :: & + w1_n, w2_n +! thl1_n, thl2_n, +! rt1_n, rt2_n + + ! Variables that are stored in derived data type pdf_params. + real( kind = core_rknd ) :: & + w1, & ! Mean of w (1st PDF component) [m/s] + w2, & ! Mean of w (2nd PDF component) [m/s] + varnce_w1, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2, & ! Variance of w (2nd PDF component) [m^2/s^2] + rt1, & ! Mean of r_t (1st PDF component) [kg/kg] + rt2, & ! Mean of r_t (2nd PDF component) [kg/kg] + varnce_rt1, & ! Variance of r_t (1st PDF component) [kg^2/kg^2] + varnce_rt2, & ! Variance of r_t (2nd PDF component) [kg^2/kg^2] + thl1, & ! Mean of th_l (1st PDF component) [K] + thl2, & ! Mean of th_l (2nd PDF component) [K] + varnce_thl1, & ! Variance of th_l (1st PDF component) [K^2] + varnce_thl2, & ! Variance of th_l (2nd PDF component) [K^2] + rrtthl, & ! Correlation between r_t and th_l (both components) [-] + alpha_thl, & ! Factor relating to normalized variance for th_l [-] + alpha_rt, & ! Factor relating to normalized variance for r_t [-] + crt1, & ! Coef. on r_t in s/t eqns. (1st PDF comp.) [-] + crt2, & ! Coef. on r_t in s/t eqns. (2nd PDF comp.) [-] + cthl1, & ! Coef. on th_l in s/t eqns. (1st PDF comp.) [(kg/kg)/K] + cthl2 ! Coef. on th_l in s/t eqns. (2nd PDF comp.) [(kg/kg)/K] + + real( kind = core_rknd ) :: & + s1, & ! Mean of s (1st PDF component) [kg/kg] + s2, & ! Mean of s (2nd PDF component) [kg/kg] + stdev_s1, & ! Standard deviation of s (1st PDF component) [kg/kg] + stdev_s2, & ! Standard deviation of s (2nd PDF component) [kg/kg] + stdev_t1, & ! Standard deviation of t (1st PDF component) [kg/kg] + stdev_t2, & ! Standard deviation of t (2nd PDF component) [kg/kg] + covar_st_1, & ! Covariance of s and t (1st PDF component) [kg^2/kg^2] + covar_st_2, & ! Covariance of s and t (2nd PDF component) [kg^2/kg^2] + corr_st_1, & ! Correlation between s and t (1st PDF component) [-] + corr_st_2, & ! Correlation between s and t (2nd PDF component) [-] + rsl1, & ! Mean of r_sl (1st PDF component) [kg/kg] + rsl2, & ! Mean of r_sl (2nd PDF component) [kg/kg] + rc1, & ! Mean of r_c (1st PDF component) [kg/kg] + rc2, & ! Mean of r_c (2nd PDF component) [kg/kg] + cloud_frac1, & ! Cloud fraction (1st PDF component) [-] + cloud_frac2, & ! Cloud fraction (2nd PDF component) [-] + mixt_frac ! Weight of 1st PDF component (Sk_w dependent) [-] + + ! Note: alpha coefficients = 0.5 * ( 1 - correlations^2 ). + ! These are used to calculate the scalar widths + ! varnce_thl1, varnce_thl2, varnce_rt1, and varnce_rt2 as in Eq. (34) of + ! Larson and Golaz (2005) + + ! Passive scalar local variables + + real( kind = core_rknd ), dimension(sclr_dim) :: & + sclr1, sclr2, & + varnce_sclr1, varnce_sclr2, & + alpha_sclr, & + rsclrthl, rsclrrt +! sclr1_n, sclr2_n, + + logical :: & + l_scalar_calc, & ! True if sclr_dim > 0 + l_calc_ice_supersat_frac ! True if we should calculate ice_supersat_frac + + ! Quantities needed to predict higher order moments + real( kind = core_rknd ) :: & + tl1, tl2, & + beta1, beta2 + + real( kind = core_rknd ) :: sqrt_wp2 + + ! Thermodynamic quantity + + real( kind = core_rknd ), intent(out) :: rc_coef + + ! variables for a generalization of Chris Golaz' closure + ! varies width of plumes in theta_l, rt + real( kind = core_rknd ) :: width_factor_1, width_factor_2 + + ! variables for computing ice cloud fraction + real( kind = core_rknd) :: & + ice_supersat_frac1, & ! first pdf component of ice_supersat_frac + ice_supersat_frac2, & ! second pdf component of ice_supersat_frac + rt_at_ice_sat1, rt_at_ice_sat2, & + s_at_ice_sat1, s_at_ice_sat2 + + + real( kind = core_rknd ), parameter :: & + s_at_liq_sat = 0.0_core_rknd ! Always zero + + integer :: i ! Index + +#ifdef GFDL + real ( kind = core_rknd ), parameter :: t1_combined = 273.16, & + t2_combined = 268.16, & + t3_combined = 238.16 +#endif +#ifdef sam1mom + real ( kind = core_rknd ), parameter :: t1_combined = tbgmax, & + t2_combined = tbgmin +#endif + +!------------------------ Code Begins ---------------------------------- + + ! Check whether the passive scalars are present. + + if ( sclr_dim > 0 ) then + l_scalar_calc = .true. + else + l_scalar_calc = .false. + end if + + err_code = clubb_no_error ! Initialize to the value for no errors + + ! If there is no velocity, then use single delta fnc. as pdf + ! Otherwise width parameters (e.g. varnce_w1, varnce_w2, etc.) are non-zero. + if ( wp2 <= w_tol_sqd ) then + + mixt_frac = 0.5_core_rknd + w1 = wm + w2 = wm + varnce_w1 = 0._core_rknd + varnce_w2 = 0._core_rknd + rt1 = rtm + rt2 = rtm + alpha_rt = 0.5_core_rknd + varnce_rt1 = 0._core_rknd + varnce_rt2 = 0._core_rknd + thl1 = thlm + thl2 = thlm + alpha_thl = 0.5_core_rknd + varnce_thl1 = 0._core_rknd + varnce_thl2 = 0._core_rknd + rrtthl = 0._core_rknd + + if ( l_scalar_calc ) then + do i = 1, sclr_dim, 1 + sclr1(i) = sclrm(i) + sclr2(i) = sclrm(i) + varnce_sclr1(i) = 0.0_core_rknd + varnce_sclr2(i) = 0.0_core_rknd + alpha_sclr(i) = 0.5_core_rknd + rsclrrt(i) = 0.0_core_rknd + rsclrthl(i) = 0.0_core_rknd + end do ! 1..sclr_dim + end if + + else ! Width (standard deviation) parameters are non-zero + + ! The variable "mixt_frac" is the weight of Gaussian "plume" 1. The weight of + ! Gaussian "plume" 2 is "1-mixt_frac". If there isn't any skewness of w + ! (Sk_w = 0 because w'^3 = 0), mixt_frac = 0.5, and both Gaussian "plumes" are + ! equally weighted. If there is positive skewness of w (Sk_w > 0 because + ! w'^3 > 0), 0 < mixt_frac < 0.5, and Gaussian "plume" 2 has greater weight than + ! does Gaussian "plume" 1. If there is negative skewness of w (Sk_w < 0 + ! because w'^3 < 0), 0.5 < mixt_frac < 1, and Gaussian "plume" 1 has greater + ! weight than does Gaussian "plume" 2. + if ( abs( Skw ) <= 1e-5_core_rknd ) then + mixt_frac = 0.5_core_rknd + else + mixt_frac = 0.5_core_rknd * ( 1.0_core_rknd - Skw/ & + sqrt( 4.0_core_rknd*( 1.0_core_rknd - sigma_sqd_w )**3 + Skw**2 ) ) + endif + + ! Determine sqrt( wp2 ) here to avoid re-computing it + sqrt_wp2 = sqrt( wp2 ) + + ! Clip mixt_frac, 1-mixt_frac, to avoid dividing by zero + ! Formula for mixt_frac_max_mag = + ! 1 - ( 1/2 * ( 1 - Skw_max/sqrt( 4*( 1 - sigma_sqd_w )^3 + Skw_max^2 ) ) ) + ! Where sigma_sqd_w is fixed at 0.4_core_rknd + mixt_frac = min( max( mixt_frac, 1.0_core_rknd-mixt_frac_max_mag ), mixt_frac_max_mag ) + + ! The normalized mean of w for Gaussian "plume" 1 is w1_n. It's value + ! will always be greater than 0. As an example, a value of 1.0 would + ! indicate that the actual mean of w for Gaussian "plume" 1 is found + ! 1.0 standard deviation above the overall mean for w. + w1_n = sqrt( ( (1._core_rknd-mixt_frac)/mixt_frac )*(1._core_rknd-sigma_sqd_w) ) + ! The normalized mean of w for Gaussian "plume" 2 is w2_n. It's value + ! will always be less than 0. As an example, a value of -0.5 would + ! indicate that the actual mean of w for Gaussian "plume" 2 is found + ! 0.5 standard deviations below the overall mean for w. + w2_n = -sqrt( ( mixt_frac/(1._core_rknd-mixt_frac) )*(1._core_rknd-sigma_sqd_w) ) + ! The mean of w for Gaussian "plume" 1 is w1. + w1 = wm + sqrt_wp2*w1_n + ! The mean of w for Gaussian "plume" 2 is w2. + w2 = wm + sqrt_wp2*w2_n + + ! The variance of w for Gaussian "plume" 1 for varnce_w1. + varnce_w1 = sigma_sqd_w*wp2 + ! The variance of w for Gaussian "plume" 2 for varnce_w2. + ! The variance in both Gaussian "plumes" is defined to be the same. + varnce_w2 = sigma_sqd_w*wp2 + + + ! The normalized variance for thl, rt, and sclr for "plume" 1 is: + ! + ! { 1 - [1/(1-sigma_sqd_w)]*[ (w'x')^2 / (w'^2 * x'^2) ] / mixt_frac } + ! * { (1/3)*beta + mixt_frac*( 1 - (2/3)*beta ) }; + ! + ! where "x" stands for thl, rt, or sclr; "mixt_frac" is the weight of Gaussian + ! "plume" 1, and 0 <= beta <= 3. + ! + ! The factor { (1/3)*beta + mixt_frac*( 1 - (2/3)*beta ) } does not depend on + ! which varable "x" stands for. The factor is multiplied by 2 and defined + ! as width_factor_1. + ! + ! The factor { 1 - [1/(1-sigma_sqd_w)]*[ (w'x')^2 / (w'^2 * x'^2) ] / mixt_frac } + ! depends on which variable "x" stands for. It is multiplied by 0.5_core_rknd and + ! defined as alpha_x, where "x" stands for thl, rt, or sclr. + + ! Vince Larson added a dimensionless factor so that the + ! width of plumes in theta_l, rt can vary. + ! beta is a constant defined in module parameters_tunable + ! Set 0 0._core_rknd .and. & + varnce_rt2*varnce_thl2 > 0._core_rknd ) then + rrtthl = ( rtpthlp - mixt_frac * ( rt1-rtm ) * ( thl1-thlm ) & + - (1._core_rknd-mixt_frac) * ( rt2-rtm ) * ( thl2-thlm ) ) & + / ( mixt_frac*sqrt( varnce_rt1*varnce_thl1 ) & + + (1._core_rknd-mixt_frac)*sqrt( varnce_rt2*varnce_thl2 ) ) + if ( rrtthl < -1.0_core_rknd ) then + rrtthl = -1.0_core_rknd + end if + if ( rrtthl > 1.0_core_rknd ) then + rrtthl = 1.0_core_rknd + end if + else + rrtthl = 0.0_core_rknd + end if ! varnce_rt1*varnce_thl1 > 0 .and. varnce_rt2*varnce_thl2 > 0 + + ! Sub-plume correlation, rsclrthl, between passive scalar and theta_l. + if ( l_scalar_calc ) then + do i=1, sclr_dim + if ( varnce_sclr1(i)*varnce_thl1 > 0._core_rknd .and. & + varnce_sclr2(i)*varnce_thl2 > 0._core_rknd ) then + rsclrthl(i) = ( sclrpthlp(i) & + - mixt_frac * ( sclr1(i)-sclrm(i) ) * ( thl1-thlm ) & + - (1._core_rknd-mixt_frac) * ( sclr2(i)-sclrm(i) ) * ( thl2-thlm ) ) & + / ( mixt_frac*sqrt( varnce_sclr1(i)*varnce_thl1 ) & + + (1._core_rknd-mixt_frac)*sqrt( varnce_sclr2(i)*varnce_thl2 ) ) + if ( rsclrthl(i) < -1.0_core_rknd ) then + rsclrthl(i) = -1.0_core_rknd + end if + if ( rsclrthl(i) > 1.0_core_rknd ) then + rsclrthl(i) = 1.0_core_rknd + end if + else + rsclrthl(i) = 0.0_core_rknd + end if + + ! Sub-plume correlation, rsclrrt, between passive scalar + ! and total water. + + if ( varnce_sclr1(i)*varnce_rt1 > 0._core_rknd .and. & + varnce_sclr2(i)*varnce_rt2 > 0._core_rknd ) then + rsclrrt(i) = ( sclrprtp(i) - mixt_frac * ( sclr1(i)-sclrm(i) ) * ( rt1-rtm )& + - (1._core_rknd-mixt_frac) * ( sclr2(i)-sclrm(i) ) * ( rt2-rtm ) ) & + / ( mixt_frac*sqrt( varnce_sclr1(i)*varnce_rt1 ) & + + (1._core_rknd-mixt_frac)*sqrt( varnce_sclr2(i)*varnce_rt2 ) ) + if ( rsclrrt(i) < -1.0_core_rknd ) then + rsclrrt(i) = -1.0_core_rknd + end if + if ( rsclrrt(i) > 1.0_core_rknd ) then + rsclrrt(i) = 1.0_core_rknd + end if + else + rsclrrt(i) = 0.0_core_rknd + end if + end do ! i=1, sclr_dim + end if ! l_scalar_calc + + end if ! Widths non-zero + + ! Compute higher order moments (these are interactive) + wp2rtp = mixt_frac * ( (w1-wm)**2+varnce_w1 ) * ( rt1-rtm ) & + + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( rt2-rtm ) + + wp2thlp = mixt_frac * ( (w1-wm)**2+varnce_w1 ) * ( thl1-thlm ) & + + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( thl2-thlm ) + + ! Compute higher order moments (these are non-interactive diagnostics) + if ( iwp4 > 0 ) then + wp4 = mixt_frac * ( 3._core_rknd*varnce_w1**2 + & + 6._core_rknd*((w1-wm)**2)*varnce_w1 + (w1-wm)**4 ) & + + (1._core_rknd-mixt_frac) * ( 3._core_rknd*varnce_w2**2 + & + 6._core_rknd*((w2-wm)**2)*varnce_w2 + (w2-wm)**4 ) + end if + + if ( iwprtp2 > 0 ) then + wprtp2 = mixt_frac * ( w1-wm )*( (rt1-rtm)**2 + varnce_rt1 ) & + + (1._core_rknd-mixt_frac) * ( w2-wm )*( (rt2-rtm)**2 + varnce_rt2) + end if + + if ( iwpthlp2 > 0 ) then + wpthlp2 = mixt_frac * ( w1-wm )*( (thl1-thlm)**2 + varnce_thl1 ) & + + (1._core_rknd-mixt_frac) * ( w2-wm )*( (thl2-thlm)**2+varnce_thl2 ) + end if + + if ( iwprtpthlp > 0 ) then + wprtpthlp = mixt_frac * ( w1-wm )*( (rt1-rtm)*(thl1-thlm) & + + rrtthl*sqrt( varnce_rt1*varnce_thl1 ) ) & + + ( 1._core_rknd-mixt_frac ) * ( w2-wm )*( (rt2-rtm)*(thl2-thlm) & + + rrtthl*sqrt( varnce_rt2*varnce_thl2 ) ) + end if + + + ! Scalar Addition to higher order moments + if ( l_scalar_calc ) then + do i=1, sclr_dim + + wp2sclrp(i) = mixt_frac * ( (w1-wm)**2+varnce_w1 )*( sclr1(i)-sclrm(i) ) & + + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( sclr2(i)-sclrm(i) ) + + wpsclrp2(i) = mixt_frac * ( w1-wm ) * ( (sclr1(i)-sclrm(i))**2 + varnce_sclr1(i) ) & + + (1._core_rknd-mixt_frac) * ( w2-wm ) * & + ( (sclr2(i)-sclrm(i))**2 + varnce_sclr2(i) ) + + wpsclrprtp(i) = mixt_frac * ( w1-wm ) * ( ( rt1-rtm )*( sclr1(i)-sclrm(i) ) & + + rsclrrt(i)*sqrt( varnce_rt1*varnce_sclr1(i) ) ) & + + ( 1._core_rknd-mixt_frac )*( w2-wm ) * & + ( ( rt2-rtm )*( sclr2(i)-sclrm(i) ) + rsclrrt(i)*sqrt( varnce_rt2*varnce_sclr2(i) ) ) + + wpsclrpthlp(i) = mixt_frac * ( w1-wm ) * ( ( sclr1(i)-sclrm(i) )*( thl1-thlm ) & + + rsclrthl(i)*sqrt( varnce_sclr1(i)*varnce_thl1 ) ) & + + ( 1._core_rknd-mixt_frac ) * ( w2-wm ) * & + ( ( sclr2(i)-sclrm(i) )*( thl2-thlm ) & + + rsclrthl(i)*sqrt( varnce_sclr2(i)*varnce_thl2 ) ) + + end do ! i=1, sclr_dim + end if ! l_scalar_calc + + ! Compute higher order moments that include theta_v. + + ! First compute some preliminary quantities. + ! "1" denotes first Gaussian; "2" denotes 2nd Gaussian + ! liq water temp (Sommeria & Deardorff 1977 (SD), eqn. 3) + + tl1 = thl1*exner + tl2 = thl2*exner + +#ifdef GFDL + if( sclr_dim > 0 .and. (.not. do_liquid_only_in_clubb) ) then ! h1g, 2010-06-16 begin mod + + if( tl1 > t1_combined ) then + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) + elseif( tl1 > t2_combined ) then + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) * (tl1 - t2_combined)/(t1_combined - t2_combined) & + + sat_mixrat_ice( p_in_Pa, tl1 ) * (t1_combined - tl1)/(t1_combined - t2_combined) + elseif( tl1 > t3_combined ) then + rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) & + + sat_mixrat_ice( p_in_Pa, tl1 ) * (RH_crit(1, 1) -1._core_rknd ) & + * ( t2_combined -tl1)/(t2_combined - t3_combined) + else + rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) * RH_crit(1, 1) + endif + + if( tl2 > t1_combined ) then + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) + elseif( tl2 > t2_combined ) then + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) * (tl2 - t2_combined)/(t1_combined - t2_combined) & + + sat_mixrat_ice( p_in_Pa, tl2 ) * (t1_combined - tl2)/(t1_combined - t2_combined) + elseif( tl2 > t3_combined ) then + rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) & + + sat_mixrat_ice( p_in_Pa, tl2 )* (RH_crit(1, 2) -1._core_rknd) & + * ( t2_combined -tl2)/(t2_combined - t3_combined) + else + rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) * RH_crit(1, 2) + endif + + else !sclr_dim <= 0 or do_liquid_only_in_clubb = .T. + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) + + endif !sclr_dim > 0 + +#elif sam1mom +! For sinlge moment microphysics in SAM_CLUBB + if(tl1 > t1_combined) then + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) + else if (tl1 < t2_combined) then + rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) + else + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) * (tl1-t2_combined)/(t1_combined-t2_combined) & + + sat_mixrat_ice( p_in_Pa, tl1 ) * (t1_combined-tl1)/(t1_combined-t2_combined) + endif + if(tl2 > t1_combined) then + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) + else if (tl2 < t2_combined) then + rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) + else + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) * (tl2-t2_combined)/(t1_combined-t2_combined) & + + sat_mixrat_ice( p_in_Pa, tl2 ) * (t1_combined-tl2)/(t1_combined-t2_combined) + endif +#else + rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) + rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) ! h1g, 2010-06-16 end mod +#endif + + ! SD's beta (eqn. 8) + beta1 = ep * ( Lv/(Rd*tl1) ) * ( Lv/(Cp*tl1) ) + beta2 = ep * ( Lv/(Rd*tl2) ) * ( Lv/(Cp*tl2) ) + + ! s from Lewellen and Yoh 1993 (LY) eqn. 1 + s1 = ( rt1 - rsl1 ) / ( 1._core_rknd + beta1 * rsl1 ) + s2 = ( rt2 - rsl2 ) / ( 1._core_rknd + beta2 * rsl2 ) + + ! Coefficients for s' + ! For each normal distribution in the sum of two normal distributions, + ! s' = crt * rt' + cthl * thl'; + ! therefore, x's' = crt * x'rt' + cthl * x'thl'. + ! Larson et al. May, 2001. + + crt1 = 1._core_rknd/( 1._core_rknd + beta1*rsl1) + crt2 = 1._core_rknd/( 1._core_rknd + beta2*rsl2) + + cthl1 = ( (1._core_rknd + beta1 * rt1) / ( 1._core_rknd + beta1*rsl1)**2 ) & + * ( Cp/Lv ) * beta1 * rsl1 * exner + cthl2 = ( (1._core_rknd + beta2 * rt2) / ( 1._core_rknd + beta2*rsl2 )**2 ) & + * ( Cp/Lv ) * beta2 * rsl2 * exner + + ! Standard deviation of s for each component. + ! Include subplume correlation of qt, thl + ! Because of round-off error, + ! stdev_s1 (and probably stdev_s2) can become negative when rrtthl=1 + ! One could also write this as a squared term + ! plus a postive correction; this might be a neater format + stdev_s1 = sqrt( max( crt1**2 * varnce_rt1 & + - two * rrtthl * crt1 * cthl1 & + * sqrt( varnce_rt1 * varnce_thl1 ) & + + cthl1**2 * varnce_thl1, & + zero_threshold ) ) + + stdev_s2 = sqrt( max( crt2**2 * varnce_rt2 & + - two * rrtthl * crt2 * cthl2 & + * sqrt( varnce_rt2 * varnce_thl2 ) & + + cthl2**2 * varnce_thl2, & + zero_threshold ) ) + + ! Standard deviation of t for each component. + stdev_t1 = sqrt( max( crt1**2 * varnce_rt1 & + + two * rrtthl * crt1 * cthl1 & + * sqrt( varnce_rt1 * varnce_thl1 ) & + + cthl1**2 * varnce_thl1, & + zero_threshold ) ) + + stdev_t2 = sqrt( max( crt2**2 * varnce_rt2 & + + two * rrtthl * crt2 * cthl2 & + * sqrt( varnce_rt2 * varnce_thl2 ) & + + cthl2**2 * varnce_thl2, & + zero_threshold ) ) + + ! Covariance of s and t for each component. + covar_st_1 = crt1**2 * varnce_rt1 - cthl1**2 * varnce_thl1 + + covar_st_2 = crt2**2 * varnce_rt2 - cthl2**2 * varnce_thl2 + + ! Correlation between s and t for each component. + if ( stdev_s1 * stdev_t1 > zero ) then + corr_st_1 = covar_st_1 / ( stdev_s1 * stdev_t1 ) + else + corr_st_1 = zero + endif + + if ( stdev_s2 * stdev_t2 > zero ) then + corr_st_2 = covar_st_2 / ( stdev_s2 * stdev_t2 ) + else + corr_st_2 = zero + endif + + ! Determine whether to compute ice_supersat_frac. We do not compute + ! ice_supersat_frac for GFDL (unless do_liquid_only_in_clubb is true), + ! because liquid and ice are both fed into rtm, ruining the calculation. +#ifdef GFDL + if (do_liquid_only_in_clubb) then + l_calc_ice_supersat_frac = .true. + else + l_calc_ice_supersat_frac = .false. + end if +#elif sam1mom + l_calc_ice_supersat_frac = .false. +#else + l_calc_ice_supersat_frac = .true. +#endif + + ! We need to introduce a threshold value for the variance of s + + ! Calculate cloud_frac1 and rc1 + call calc_cloud_frac_component(s1, stdev_s1, s_at_liq_sat, cloud_frac1, rc1) + + ! Calculate cloud_frac2 and rc2 + call calc_cloud_frac_component(s2, stdev_s2, s_at_liq_sat, cloud_frac2, rc2) + + if (l_calc_ice_supersat_frac) then + ! We must compute s_at_ice_sat1 and s_at_ice_sat2 + if (tl1 <= T_freeze_K) then + rt_at_ice_sat1 = sat_mixrat_ice( p_in_Pa, tl1 ) + s_at_ice_sat1 = ( rt_at_ice_sat1 - rsl1 ) / ( 1._core_rknd + beta1 * rsl1 ) + else + ! If the temperature is warmer than freezing (> 0C) then ice_supersat_frac + ! is not defined, so we use s_at_liq_sat + s_at_ice_sat1 = s_at_liq_sat + end if + + if (tl2 <= T_freeze_K) then + rt_at_ice_sat2 = sat_mixrat_ice( p_in_Pa, tl2 ) + s_at_ice_sat2 = ( rt_at_ice_sat2 - rsl2 ) / ( 1._core_rknd + beta2 * rsl2 ) + else + ! If the temperature is warmer than freezing (> 0C) then ice_supersat_frac + ! is not defined, so we use s_at_liq_sat + s_at_ice_sat2 = s_at_liq_sat + end if + + ! Calculate ice_supersat_frac1 + call calc_cloud_frac_component(s1, stdev_s1, s_at_ice_sat1, ice_supersat_frac1) + + ! Calculate ice_supersat_frac2 + call calc_cloud_frac_component(s2, stdev_s2, s_at_ice_sat2, ice_supersat_frac2) + end if + + ! Compute moments that depend on theta_v + ! + ! The moments that depend on th_v' are calculated based on an approximated + ! and linearized form of the theta_v equation: + ! + ! theta_v = theta_l + { (R_v/R_d) - 1 } * thv_ds * r_t + ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c; + ! + ! and therefore: + ! + ! th_v' = th_l' + { (R_v/R_d) - 1 } * thv_ds * r_t' + ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c'; + ! + ! where thv_ds is used as a reference value to approximate theta_l. + + rc_coef = Lv / (exner*Cp) - ep2 * thv_ds + + wp2rcp = mixt_frac * ((w1-wm)**2 + varnce_w1)*rc1 & + + (1._core_rknd-mixt_frac) * ((w2-wm)**2 + varnce_w2)*rc2 & + - wp2 * (mixt_frac*rc1+(1._core_rknd-mixt_frac)*rc2) + + wp2thvp = wp2thlp + ep1*thv_ds*wp2rtp + rc_coef*wp2rcp + + wprcp = mixt_frac * (w1-wm)*rc1 + (1._core_rknd-mixt_frac) * (w2-wm)*rc2 + + wpthvp = wpthlp + ep1*thv_ds*wprtp + rc_coef*wprcp + + ! Account for subplume correlation in qt-thl + thlprcp = mixt_frac * ( (thl1-thlm)*rc1 - (cthl1*varnce_thl1)*cloud_frac1 ) & + + (1._core_rknd-mixt_frac) * ( (thl2-thlm)*rc2 - (cthl2*varnce_thl2)*cloud_frac2 ) & + + mixt_frac*rrtthl*crt1*sqrt( varnce_rt1*varnce_thl1 )*cloud_frac1 & + + (1._core_rknd-mixt_frac)*rrtthl*crt2*sqrt( varnce_rt2*varnce_thl2 )*cloud_frac2 + thlpthvp = thlp2 + ep1*thv_ds*rtpthlp + rc_coef*thlprcp + + ! Account for subplume correlation in qt-thl + rtprcp = mixt_frac * ( (rt1-rtm)*rc1 + (crt1*varnce_rt1)*cloud_frac1 ) & + + (1._core_rknd-mixt_frac) * ( (rt2-rtm)*rc2 + (crt2*varnce_rt2)*cloud_frac2 ) & + - mixt_frac*rrtthl*cthl1*sqrt( varnce_rt1*varnce_thl1 )*cloud_frac1 & + - (1._core_rknd-mixt_frac)*rrtthl*cthl2*sqrt( varnce_rt2*varnce_thl2 )*cloud_frac2 + + rtpthvp = rtpthlp + ep1*thv_ds*rtp2 + rc_coef*rtprcp + + ! Account for subplume correlation between scalar, theta_v. + ! See Eqs. A13, A8 from Larson et al. (2002) ``Small-scale...'' + ! where the ``scalar'' in this paper is w. + if ( l_scalar_calc ) then + do i=1, sclr_dim + sclrprcp(i) & + = mixt_frac * ( ( sclr1(i)-sclrm(i) ) * rc1 ) & + + (1._core_rknd-mixt_frac) * ( ( sclr2(i)-sclrm(i) ) * rc2 ) & + + mixt_frac*rsclrrt(i) * crt1 & + * sqrt( varnce_sclr1(i) * varnce_rt1 ) * cloud_frac1 & + + (1._core_rknd-mixt_frac) * rsclrrt(i) * crt2 & + * sqrt( varnce_sclr2(i) * varnce_rt2 ) * cloud_frac2 & + - mixt_frac * rsclrthl(i) * cthl1 & + * sqrt( varnce_sclr1(i) * varnce_thl1 ) * cloud_frac1 & + - (1._core_rknd-mixt_frac) * rsclrthl(i) * cthl2 & + * sqrt( varnce_sclr2(i) * varnce_thl2 ) * cloud_frac2 + + sclrpthvp(i) = sclrpthlp(i) + ep1*thv_ds*sclrprtp(i) + rc_coef*sclrprcp(i) + end do ! i=1, sclr_dim + end if ! l_scalar_calc + + ! Compute mean cloud fraction and cloud water + cloud_frac = calc_cloud_frac(cloud_frac1, cloud_frac2, mixt_frac) + rcm = mixt_frac * rc1 + (1._core_rknd-mixt_frac) * rc2 + + rcm = max( zero_threshold, rcm ) + + if (l_calc_ice_supersat_frac) then + ! Compute ice cloud fraction, ice_supersat_frac + ice_supersat_frac = calc_cloud_frac(ice_supersat_frac1, ice_supersat_frac2, mixt_frac) + else + ! ice_supersat_frac will be garbage if computed as above + ice_supersat_frac = 0.0_core_rknd + if (clubb_at_least_debug_level( 1 )) then + write(fstderr,*) "Warning: ice_supersat_frac has garbage values if & + & do_liquid_only_in_clubb = .false." + end if + end if + ! Compute variance of liquid water mixing ratio. + ! This is not needed for closure. Statistical Analysis only. +#ifndef CLUBB_SAM ! in SAM, rcp2 is needed for Morrison microphysics + if ( ircp2 > 0 ) then +#endif + + rcp2 = mixt_frac * ( s1*rc1 + cloud_frac1*stdev_s1**2 ) & + + ( 1._core_rknd-mixt_frac ) * ( s2*rc2 + cloud_frac2*stdev_s2**2 ) - rcm**2 + rcp2 = max( zero_threshold, rcp2 ) + +#ifndef CLUBB_SAM ! in SAM, rcp2 is needed for Morrison microphysics + end if +#endif + + + ! Save PDF parameters + pdf_params%w1 = w1 + pdf_params%w2 = w2 + pdf_params%varnce_w1 = varnce_w1 + pdf_params%varnce_w2 = varnce_w2 + pdf_params%rt1 = rt1 + pdf_params%rt2 = rt2 + pdf_params%varnce_rt1 = varnce_rt1 + pdf_params%varnce_rt2 = varnce_rt2 + pdf_params%thl1 = thl1 + pdf_params%thl2 = thl2 + pdf_params%varnce_thl1 = varnce_thl1 + pdf_params%varnce_thl2 = varnce_thl2 + pdf_params%rrtthl = rrtthl + pdf_params%alpha_thl = alpha_thl + pdf_params%alpha_rt = alpha_rt + pdf_params%crt1 = crt1 + pdf_params%crt2 = crt2 + pdf_params%cthl1 = cthl1 + pdf_params%cthl2 = cthl2 + pdf_params%s1 = s1 + pdf_params%s2 = s2 + pdf_params%stdev_s1 = stdev_s1 + pdf_params%stdev_s2 = stdev_s2 + pdf_params%stdev_t1 = stdev_t1 + pdf_params%stdev_t2 = stdev_t2 + pdf_params%covar_st_1 = covar_st_1 + pdf_params%covar_st_2 = covar_st_2 + pdf_params%corr_st_1 = corr_st_1 + pdf_params%corr_st_2 = corr_st_2 + pdf_params%rsl1 = rsl1 + pdf_params%rsl2 = rsl2 + pdf_params%rc1 = rc1 + pdf_params%rc2 = rc2 + pdf_params%cloud_frac1 = cloud_frac1 + pdf_params%cloud_frac2 = cloud_frac2 + pdf_params%mixt_frac = mixt_frac + + + if ( clubb_at_least_debug_level( 2 ) ) then + + call pdf_closure_check & + ( wp4, wprtp2, wp2rtp, wpthlp2, & + wp2thlp, cloud_frac, rcm, wpthvp, wp2thvp, & + rtpthvp, thlpthvp, wprcp, wp2rcp, & + rtprcp, thlprcp, rcp2, wprtpthlp, & + crt1, crt2, cthl1, cthl2, pdf_params, & + err_code, & + sclrpthvp, sclrprcp, wpsclrp2, & + wpsclrprtp, wpsclrpthlp, wp2sclrp ) + + ! Error Reporting + ! Joshua Fasching February 2008 + + if ( fatal_error( err_code ) ) then + + write(fstderr,*) "Error in pdf_closure_new" + + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "p_in_Pa = ", p_in_Pa + write(fstderr,*) "exner = ", exner + write(fstderr,*) "thv_ds = ", thv_ds + write(fstderr,*) "wm = ", wm + write(fstderr,*) "wp2 = ", wp2 + write(fstderr,*) "wp3 = ", wp3 + write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w + write(fstderr,*) "rtm = ", rtm + write(fstderr,*) "rtp2 = ", rtp2 + write(fstderr,*) "wprtp = ", wprtp + write(fstderr,*) "thlm = ", thlm + write(fstderr,*) "thlp2 = ", thlp2 + write(fstderr,*) "wpthlp = ", wpthlp + write(fstderr,*) "rtpthlp = ", rtpthlp + + if ( sclr_dim > 0 ) then + write(fstderr,*) "sclrm = ", sclrm + write(fstderr,*) "wpsclrp = ", wpsclrp + write(fstderr,*) "sclrp2 = ", sclrp2 + write(fstderr,*) "sclrprtp = ", sclrprtp + write(fstderr,*) "sclrpthlp = ", sclrpthlp + end if + + write(fstderr,*) "level = ", level + + write(fstderr,*) "Intent(out)" + + write(fstderr,*) "wp4 = ", wp4 + write(fstderr,*) "wprtp2 = ", wprtp2 + write(fstderr,*) "wp2rtp = ", wp2rtp + write(fstderr,*) "wpthlp2 = ", wpthlp2 + write(fstderr,*) "cloud_frac = ", cloud_frac + write(fstderr,*) "ice_supersat_frac = ", ice_supersat_frac + write(fstderr,*) "rcm = ", rcm + write(fstderr,*) "wpthvp = ", wpthvp + write(fstderr,*) "wp2thvp = ", wp2thvp + write(fstderr,*) "rtpthvp = ", rtpthvp + write(fstderr,*) "thlpthvp = ", thlpthvp + write(fstderr,*) "wprcp = ", wprcp + write(fstderr,*) "wp2rcp = ", wp2rcp + write(fstderr,*) "rtprcp = ", rtprcp + write(fstderr,*) "thlprcp = ", thlprcp + write(fstderr,*) "rcp2 = ", rcp2 + write(fstderr,*) "wprtpthlp = ", wprtpthlp + write(fstderr,*) "pdf_params%w1 = ", pdf_params%w1 + write(fstderr,*) "pdf_params%w2 = ", pdf_params%w2 + write(fstderr,*) "pdf_params%varnce_w1 = ", pdf_params%varnce_w1 + write(fstderr,*) "pdf_params%varnce_w2 = ", pdf_params%varnce_w2 + write(fstderr,*) "pdf_params%rt1 = ", pdf_params%rt1 + write(fstderr,*) "pdf_params%rt2 = ", pdf_params%rt2 + write(fstderr,*) "pdf_params%varnce_rt1 = ", pdf_params%varnce_rt1 + write(fstderr,*) "pdf_params%varnce_rt2 = ", pdf_params%varnce_rt2 + write(fstderr,*) "pdf_params%thl1 = ", pdf_params%thl1 + write(fstderr,*) "pdf_params%thl2 = ", pdf_params%thl2 + write(fstderr,*) "pdf_params%varnce_thl1 = ", pdf_params%varnce_thl1 + write(fstderr,*) "pdf_params%varnce_thl2 = ", pdf_params%varnce_thl2 + write(fstderr,*) "pdf_params%rrtthl = ", pdf_params%rrtthl + write(fstderr,*) "pdf_params%alpha_thl = ", pdf_params%alpha_thl + write(fstderr,*) "pdf_params%alpha_rt = ", pdf_params%alpha_rt + write(fstderr,*) "pdf_params%crt1 = ", pdf_params%crt1 + write(fstderr,*) "pdf_params%crt2 = ", pdf_params%crt2 + write(fstderr,*) "pdf_params%cthl1 = ", pdf_params%cthl1 + write(fstderr,*) "pdf_params%cthl2 = ", pdf_params%cthl2 + write(fstderr,*) "pdf_params%s1 = ", pdf_params%s1 + write(fstderr,*) "pdf_params%s2 = ", pdf_params%s2 + write(fstderr,*) "pdf_params%stdev_s1 = ", pdf_params%stdev_s1 + write(fstderr,*) "pdf_params%stdev_s2 = ", pdf_params%stdev_s2 + write(fstderr,*) "pdf_params%stdev_t1 = ", pdf_params%stdev_t1 + write(fstderr,*) "pdf_params%stdev_t2 = ", pdf_params%stdev_t2 + write(fstderr,*) "pdf_params%covar_st_1 = ", pdf_params%covar_st_1 + write(fstderr,*) "pdf_params%covar_st_2 = ", pdf_params%covar_st_2 + write(fstderr,*) "pdf_params%corr_st_1 = ", pdf_params%corr_st_1 + write(fstderr,*) "pdf_params%corr_st_2 = ", pdf_params%corr_st_2 + write(fstderr,*) "pdf_params%rsl1 = ", pdf_params%rsl1 + write(fstderr,*) "pdf_params%rsl2 = ", pdf_params%rsl2 + write(fstderr,*) "pdf_params%rc1 = ", pdf_params%rc1 + write(fstderr,*) "pdf_params%rc2 = ", pdf_params%rc2 + write(fstderr,*) "pdf_params%cloud_frac1 = ", pdf_params%cloud_frac1 + write(fstderr,*) "pdf_params%cloud_frac2 = ", pdf_params%cloud_frac2 + write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac + + if ( sclr_dim > 0 )then + write(fstderr,*) "sclrpthvp = ", sclrpthvp + write(fstderr,*) "sclrprcp = ", sclrprcp + write(fstderr,*) "wpsclrp2 = ", wpsclrp2 + write(fstderr,*) "wpsclrprtp = ", wpsclrprtp + write(fstderr,*) "wpsclrpthlp = ", wpsclrpthlp + write(fstderr,*) "wp2sclrp = ", wp2sclrp + end if + + end if ! Fatal error + + end if ! clubb_at_least_debug_level + + return + end subroutine pdf_closure + + !----------------------------------------------------------------------- + subroutine calc_cloud_frac_component(s, stdev_s, s_at_sat, cloud_fracN, rcN) + ! Description: + ! Given the mean and standard deviation of 's', this subroutine + ! calculates cloud_frac, where n is the PDF component (either 1 or + ! 2). In addition, the subroutine can also optionally calculate rc, + ! the mean of r_c + ! + ! References: + ! See ticket#529 + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + s_mellor_tol,&! Tolerance for pdf parameter s [kg/kg] + sqrt_2pi, &! sqrt(2*pi) + sqrt_2 ! sqrt(2) + + use crmx_clubb_precision, only: & + core_rknd ! Precision + + use crmx_anl_erf, only: & + erf ! Procedure(s) + ! The error function + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + s, & ! Mean of 's' component + stdev_s, & ! Standard deviation of s + s_at_sat ! Value of 's' at exact saturation with respect to ice + ! Negative (or zero for liquid) + + ! Output Variables + real( kind = core_rknd ), intent(out) :: & + cloud_fracN ! Component of cloud_frac + + ! Output Variable + ! Note: this parameter can be optionally computed. + real( kind = core_rknd), intent(out), optional :: & + rcN ! Mean of r_c + + ! Local Variables + real( kind = core_rknd) :: zetaN + + !----------------------------------------------------------------------- + !----- Begin Code ----- + if ( stdev_s > s_mellor_tol ) then + zetaN = (s - s_at_sat) / stdev_s + cloud_fracN = 0.5_core_rknd*( 1._core_rknd + erf( zetaN/sqrt_2 ) ) + if (present(rcN)) & + rcN = s*cloud_fracN + stdev_s*exp( -0.5_core_rknd*zetaN**2 )/( sqrt_2pi ) + else + if ( s < 0.0_core_rknd ) then + cloud_fracN = 0.0_core_rknd + if (present(rcN)) & + rcN = 0.0_core_rknd + else + cloud_fracN = 1.0_core_rknd + if (present(rcN)) & + rcN = s + end if ! s < 0 + end if ! stdev_s > s_mellor_tol + + + end subroutine calc_cloud_frac_component + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + function calc_cloud_frac(cloud_frac1, cloud_frac2, mixt_frac) + ! Description: + ! Given the the two pdf components of a cloud fraction, and the weight + ! of the first component, this fuction calculates the cloud fraction, + ! cloud_frac + ! + ! References: + ! See ticket#530 + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr, &! Standard error output + zero_threshold ! A physical quantity equal to zero + + use crmx_clubb_precision, only: & + core_rknd ! Precision + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Function to check whether clubb is in + ! at least the specified debug level + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + cloud_frac1, & ! First PDF component of cloud_frac + cloud_frac2, & ! Second PDF component of cloud_frac + mixt_frac ! Weight of 1st PDF component (Sk_w dependent) + + ! Output Variables + real( kind = core_rknd) :: & + calc_cloud_frac ! Cloud fraction + + ! Local Variables + real( kind = core_rknd) :: & + cloud_frac ! Cloud fraction (used as a holding variable for + ! output) + + !----------------------------------------------------------------------- + !----- Begin Code ----- + cloud_frac = mixt_frac * cloud_frac1 + (1.0_core_rknd-mixt_frac) * cloud_frac2 + + ! Note: Brian added the following lines to ensure that there + ! are never any negative liquid water values (or any negative + ! cloud fraction values, for that matter). According to + ! Vince Larson, the analytic formula should not produce any + ! negative results, but such computer-induced errors such as + ! round-off error may produce such a value. This has been + ! corrected because Brian found a small negative value of + ! rcm in the first timestep of the FIRE case. + + cloud_frac = max( zero_threshold, cloud_frac ) + if ( clubb_at_least_debug_level( 2 ) ) then + if ( cloud_frac > 1.0_core_rknd ) then + write(fstderr,*) "Cloud fraction > 1" + end if + end if + cloud_frac = min( 1.0_core_rknd, cloud_frac ) + + calc_cloud_frac = cloud_frac + return + + end function calc_cloud_frac + !----------------------------------------------------------------------- + +end module crmx_pdf_closure_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 new file mode 100644 index 0000000000..bc62a8bdd5 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 @@ -0,0 +1,58 @@ +! $Id: pdf_parameter_module.F90 5668 2012-01-29 03:40:28Z bmg2@uwm.edu $ +module crmx_pdf_parameter_module +! Description: +! This module defines the derived type pdf_parameter. +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd + + implicit none + + private ! Default scope + + public :: pdf_parameter + + type pdf_parameter + real( kind = core_rknd ) :: & + w1, & ! Mean of w (1st PDF component) [m/s] + w2, & ! Mean of w (2nd PDF component) [m/s] + varnce_w1, & ! Variance of w (1st PDF component) [m^2/s^2] + varnce_w2, & ! Variance of w (2nd PDF component) [m^2/s^2] + rt1, & ! Mean of r_t (1st PDF component) [kg/kg] + rt2, & ! Mean of r_t (2nd PDF component) [kg/kg] + varnce_rt1, & ! Variance of r_t (1st PDF component) [kg^2/kg^2] + varnce_rt2, & ! Variance of r_t (2nd PDF component) [kg^2/kg^2] + thl1, & ! Mean of th_l (1st PDF component) [K] + thl2, & ! Mean of th_l (2nd PDF component) [K] + varnce_thl1, & ! Variance of th_l (1st PDF component) [K^2] + varnce_thl2, & ! Variance of th_l (2nd PDF component) [K^2] + rrtthl, & ! Correlation between r_t and th_l (both components) [-] + alpha_thl, & ! Factor relating to normalized variance for th_l [-] + alpha_rt, & ! Factor relating to normalized variance for r_t [-] + crt1, & ! Coef. on r_t in s/t eqns. (1st PDF comp.) [-] + crt2, & ! Coef. on r_t in s/t eqns. (2nd PDF comp.) [-] + cthl1, & ! Coef. on th_l in s/t eqns. (1st PDF comp.) [(kg/kg)/K] + cthl2, & ! Coef. on th_l in s/t eqns. (2nd PDF comp.) [(kg/kg)/K] + s1, & ! Mean of s (1st PDF component) [kg/kg] + s2, & ! Mean of s (2nd PDF component) [kg/kg] + stdev_s1, & ! Standard deviation of s (1st PDF component) [kg/kg] + stdev_s2, & ! Standard deviation of s (2nd PDF component) [kg/kg] + stdev_t1, & ! Standard deviation of t (1st PDF component) [kg/kg] + stdev_t2, & ! Standard deviation of t (2nd PDF component) [kg/kg] + covar_st_1, & ! Covariance of s and t (1st PDF component) [kg^2/kg^2] + covar_st_2, & ! Covariance of s and t (2nd PDF component) [kg^2/kg^2] + corr_st_1, & ! Correlation between s and t (1st PDF component) [-] + corr_st_2, & ! Correlation between s and t (2nd PDF component) [-] + rsl1, & ! Mean of r_sl (1st PDF component) [kg/kg] + rsl2, & ! Mean of r_sl (2nd PDF component) [kg/kg] + rc1, & ! Mean of r_c (1st PDF component) [kg/kg] + rc2, & ! Mean of r_c (2nd PDF component) [kg/kg] + cloud_frac1, & ! Cloud fraction (1st PDF component) [-] + cloud_frac2, & ! Cloud fraction (2nd PDF component) [-] + mixt_frac ! Weight of 1st PDF component (Sk_w dependent) [-] + end type pdf_parameter + +end module crmx_pdf_parameter_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 new file mode 100644 index 0000000000..65471a4345 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 @@ -0,0 +1,220 @@ +!$Id: pos_definite_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_pos_definite_module + + implicit none + + public :: pos_definite_adj + + private ! Default Scope + + contains +!----------------------------------------------------------------------- + subroutine pos_definite_adj & + ( dt, field_grid, field_np1, & + flux_np1, field_n, field_pd, flux_pd ) +! Description: +! Applies a flux conservative positive definite scheme to a variable + +! There are two possible grids: +! (1) flux on zm field on zt +! then +! flux_zt(k) = ( flux_zm(k) + flux_zm(k-1) ) / 2 + +! CLUBB grid Smolarkiewicz grid +! m +-- flux zm(k) --+ flux k + 1/2 +! t +-- field zt(k) --+ field, fout k +! m +-- flux zm(k-1) --+ flux k - 1/2 +! t +-- field zt(k-1) --+ + +! (1) flux on zt field on zm +! then +! flux_zm(k) = ( flux_zt(k) + flux_zt(k+1) ) / 2 + +! CLUBB grid Smolarkiewicz grid +! m +-- field (k+1) --+ +! t +-- flux (k+1) --+ flux k + 1/2 +! m +-- field (k) --+ field, fout k +! t +-- flux (k) --+ flux k - 1/2 + + +! References: +! ``A Positive Definite Advection Scheme Obtained by +! Nonlinear Renormalization of the Advective Fluxes'' Smolarkiewicz (1989) +! Monthly Weather Review, Vol. 117, pp. 2626--2632 +!----------------------------------------------------------------------- + + use crmx_grid_class, only: & + gr, & ! Variable(s) + ddzt, & ! Function + ddzm ! Function + + use crmx_constants_clubb, only : & + eps, & ! Variable(s) + zero_threshold + + use crmx_clubb_precision, only: & + time_precision, & ! Variable(s) + core_rknd + + use crmx_error_code, only: & + clubb_at_least_debug_level + + implicit none + + ! External + intrinsic :: eoshift, kind, any, min, max + + ! Input variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + character(len=2), intent(in) :: & + field_grid ! The grid of the field, either zt or zm + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + field_n ! The field (e.g. rtm) at n, prior to n+1 + + real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & + flux_pd, & ! Budget of the change in the flux term due to the scheme + field_pd ! Budget of the change in the mean term due to the scheme + + ! Output Variables + + real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & + field_np1, & ! Field at n+1 (e.g. rtm in [kg/kg]) + flux_np1 ! Flux applied to field + + ! Local Variables + integer :: & + kabove, & ! # of vertical levels the flux higher point resides + kbelow ! # of vertical levels the flux lower point resides + + integer :: & + k, kmhalf, kp1, kphalf ! Loop indices + + real( kind = core_rknd ), dimension(gr%nz) :: & + flux_plus, flux_minus, & ! [F_i+1/2]^+ [F_i+1/2]^- in Smolarkiewicz + fout, & ! (A4) F_i{}^OUT, or the sum flux_plus+flux_minus + flux_lim, & ! Correction applied to flux at n+1 + field_nonlim ! Temporary variable for calculation + + real( kind = core_rknd ), dimension(gr%nz) :: & + dz_over_dt ! Conversion factor [m/s] + + +!----------------------------------------------------------------------- + + ! If all the values are positive or the values at the previous + ! timestep were negative, then just return + if ( .not. any( field_np1 < 0._core_rknd ) .or. any( field_n < 0._core_rknd ) ) then + flux_pd = 0._core_rknd + field_pd = 0._core_rknd + return + end if + + if ( field_grid == "zm" ) then + kabove = 0 + kbelow = 1 + else if ( field_grid == "zt" ) then + kabove = 1 + kbelow = 0 + else + ! This is only necessary to avoid a compiler warning in g95 + kabove = -1 + kbelow = -1 + ! Joshua Fasching June 2008 + + stop "Error in pos_def_adj" + end if + + if ( clubb_at_least_debug_level( 1 ) ) then + print *, "Correcting flux" + end if + + do k = 1, gr%nz, 1 + + ! Def. of F+ and F- from eqn 2 Smolarkowicz + flux_plus(k) = max( zero_threshold, flux_np1(k) ) ! defined on flux levels + flux_minus(k) = -min( zero_threshold, flux_np1(k) ) ! defined on flux levels + + if ( field_grid == "zm" ) then + dz_over_dt(k) = ( 1._core_rknd/gr%invrs_dzm(k) ) / real( dt, kind = core_rknd ) + + else if ( field_grid == "zt" ) then + dz_over_dt(k) = ( 1._core_rknd/gr%invrs_dzt(k) ) / real( dt, kind = core_rknd ) + + end if + + end do + + do k = 1, gr%nz, 1 + ! If the scalar variable is on the kth t-level, then + ! Smolarkowicz's k+1/2 flux level is the kth m-level in CLUBB. + + ! If the scalar variable is on the kth m-level, then + ! Smolarkowicz's k+1/2 flux level is the k+1 t-level in CLUBB. + + kphalf = min( k+kabove, gr%nz ) ! k+1/2 flux level + kmhalf = max( k-kbelow, 1 ) ! k-1/2 flux level + + ! Eqn A4 from Smolarkowicz + ! We place a limiter of eps to prevent a divide by zero, and + ! after this calculation fout is on the scalar level, and + ! fout is the total outward flux for the scalar level k. + + fout(k) = max( flux_plus(kphalf) + flux_minus(kmhalf), eps ) + + end do + + + do k = 1, gr%nz, 1 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! FIXME: + ! We haven't tested this for negative values at the gr%nz level + ! -dschanen 13 June 2008 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + kphalf = min( k+kabove, gr%nz ) ! k+1/2 flux level + kp1 = min( k+1, gr%nz ) ! k+1 scalar level + + ! Eqn 10 from Smolarkowicz (1989) + + flux_lim(kphalf) & + = max( min( flux_np1(kphalf), & + ( flux_plus(kphalf)/fout(k) ) * field_n(k) & + * dz_over_dt(k) & + ), & + -( ( flux_minus(kphalf)/fout(kp1) ) * field_n(kp1) & + * dz_over_dt(k) ) & + ) + end do + + ! Boundary conditions + flux_lim(1) = flux_np1(1) + flux_lim(gr%nz) = flux_np1(gr%nz) + + flux_pd = ( flux_lim - flux_np1 ) / real( dt, kind = core_rknd ) + + field_nonlim = field_np1 + + ! Apply change to field at n+1 + if ( field_grid == "zt" ) then + + field_np1 = -real( dt, kind = core_rknd ) * ddzm( flux_lim - flux_np1 ) + field_np1 + + else if ( field_grid == "zm" ) then + + field_np1 = -real( dt, kind = core_rknd ) * ddzt( flux_lim - flux_np1 ) + field_np1 + + end if + + ! Determine the total time tendency in field due to this calculation + ! (for diagnostic purposes) + field_pd = ( field_np1 - field_nonlim ) / real( dt, kind = core_rknd ) + + ! Replace the non-limited flux with the limited flux + flux_np1 = flux_lim + + return + end subroutine pos_definite_adj + +end module crmx_pos_definite_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 b/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 new file mode 100644 index 0000000000..a99bfce9fc --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 @@ -0,0 +1,789 @@ +!$Id: saturation.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ +!----------------------------------------------------------------------- +module crmx_saturation + +! Description: +! Contains functions that compute saturation with respect +! to liquid or ice. +!----------------------------------------------------------------------- + +#ifdef GFDL + use crmx_model_flags, only: & ! h1g, 2010-06-18 + I_sat_sphum +#endif + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + private ! Change default so all items private + + public :: sat_mixrat_liq, sat_mixrat_liq_lookup, sat_mixrat_ice, rcm_sat_adj, & + sat_vapor_press_liq + + private :: sat_vapor_press_liq_flatau, sat_vapor_press_liq_bolton + private :: sat_vapor_press_ice_flatau, sat_vapor_press_ice_bolton + + ! Lookup table of values for saturation + real( kind = core_rknd ), private, dimension(188:343) :: & + svp_liq_lookup_table + + data svp_liq_lookup_table(188:343) / & + 0.049560547_core_rknd, 0.059753418_core_rknd, 0.070129395_core_rknd, 0.083618164_core_rknd, & + 0.09814453_core_rknd, 0.11444092_core_rknd, 0.13446045_core_rknd, 0.15686035_core_rknd, & + 0.18218994_core_rknd, 0.21240234_core_rknd, 0.24725342_core_rknd, 0.28668213_core_rknd, & + 0.33184814_core_rknd, 0.3826294_core_rknd, 0.4416504_core_rknd, 0.50775146_core_rknd, & + 0.58343506_core_rknd, 0.6694946_core_rknd, 0.7668457_core_rknd, 0.87750244_core_rknd, & + 1.0023804_core_rknd, 1.1434937_core_rknd, 1.3028564_core_rknd, 1.482544_core_rknd, & + 1.6847534_core_rknd, 1.9118042_core_rknd, 2.1671143_core_rknd, 2.4535522_core_rknd, & + 2.774231_core_rknd, 3.1330566_core_rknd, 3.5343628_core_rknd, 3.9819336_core_rknd, & + 4.480713_core_rknd, 5.036072_core_rknd, 5.6540527_core_rknd, 6.340088_core_rknd, & + 7.1015015_core_rknd, 7.9450684_core_rknd, 8.8793335_core_rknd, 9.91217_core_rknd, & + 11.053528_core_rknd, 12.313049_core_rknd, 13.70166_core_rknd, 15.231018_core_rknd, & + 16.91394_core_rknd, 18.764038_core_rknd, 20.795898_core_rknd, 23.025574_core_rknd, & + 25.470093_core_rknd, 28.147766_core_rknd, 31.078003_core_rknd, 34.282043_core_rknd, & + 37.782593_core_rknd, 41.60382_core_rknd, 45.771606_core_rknd, 50.31366_core_rknd, & + 55.259644_core_rknd, 60.641174_core_rknd, 66.492004_core_rknd, 72.84802_core_rknd, & + 79.74756_core_rknd, 87.23126_core_rknd, 95.34259_core_rknd, 104.12747_core_rknd, & + 113.634796_core_rknd, 123.91641_core_rknd, 135.02725_core_rknd, 147.02563_core_rknd, & + 159.97308_core_rknd, 173.93488_core_rknd, 188.97995_core_rknd, 205.18109_core_rknd, & + 222.61517_core_rknd, 241.36334_core_rknd, 261.51108_core_rknd, 283.14853_core_rknd, & + 306.37054_core_rknd, 331.27698_core_rknd, 357.97278_core_rknd, 386.56842_core_rknd, & + 417.17978_core_rknd, 449.9286_core_rknd, 484.94254_core_rknd, 522.3556_core_rknd, & + 562.30804_core_rknd, 604.947_core_rknd, 650.42645_core_rknd, 698.9074_core_rknd, & + 750.55835_core_rknd, 805.55554_core_rknd, 864.0828_core_rknd, 926.3325_core_rknd, & + 992.5052_core_rknd, 1062.8102_core_rknd, 1137.4657_core_rknd, 1216.6995_core_rknd, & + 1300.7483_core_rknd, 1389.8594_core_rknd, 1484.2896_core_rknd, 1584.3064_core_rknd, & + 1690.1881_core_rknd, 1802.224_core_rknd, 1920.7146_core_rknd, 2045.9724_core_rknd, & + 2178.3218_core_rknd, 2318.099_core_rknd, 2465.654_core_rknd, 2621.3489_core_rknd, & + 2785.5596_core_rknd, 2958.6758_core_rknd, 3141.101_core_rknd, 3333.2534_core_rknd, & + 3535.5657_core_rknd, 3748.4863_core_rknd, 3972.4792_core_rknd, 4208.024_core_rknd, & + 4455.616_core_rknd, 4715.7686_core_rknd, 4989.0127_core_rknd, 5275.8945_core_rknd, & + 5576.9795_core_rknd, 5892.8535_core_rknd, 6224.116_core_rknd, 6571.3926_core_rknd, & + 6935.3213_core_rknd, 7316.5674_core_rknd, 7715.8105_core_rknd, 8133.755_core_rknd, & + 8571.125_core_rknd, 9028.667_core_rknd, 9507.15_core_rknd, 10007.367_core_rknd, & + 10530.132_core_rknd, 11076.282_core_rknd, 11646.683_core_rknd, 12242.221_core_rknd, & + 12863.808_core_rknd, 13512.384_core_rknd, 14188.913_core_rknd, 14894.385_core_rknd, & + 15629.823_core_rknd, 16396.268_core_rknd, 17194.799_core_rknd, 18026.516_core_rknd, & + 18892.55_core_rknd, 19794.07_core_rknd, 20732.262_core_rknd, 21708.352_core_rknd, & + 22723.592_core_rknd, 23779.273_core_rknd, 24876.709_core_rknd, 26017.258_core_rknd, & + 27202.3_core_rknd, 28433.256_core_rknd, 29711.578_core_rknd, 31038.766_core_rknd / + + contains + +!------------------------------------------------------------------------- + elemental real( kind = core_rknd ) function sat_mixrat_liq( p_in_Pa, T_in_K ) + +! Description: +! Used to compute the saturation mixing ratio of liquid water. + +! References: +! Formula from Emanuel 1994, 4.4.14 +!------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + ep, & ! Variable + fstderr + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + p_in_Pa, & ! Pressure [Pa] + T_in_K ! Temperature [K] + + ! Local Variables + real( kind = core_rknd ) :: esatv + + ! --- Begin Code --- + + ! Calculate the SVP for water vapor. + esatv = sat_vapor_press_liq( T_in_K ) + + ! If esatv exceeds the air pressure, then assume esatv~=0.5*pressure + ! and set rsat = ep = 0.622 + if ( p_in_Pa-esatv < 1.0_core_rknd ) then + sat_mixrat_liq = ep + else + +#ifdef GFDL + + ! GFDL uses specific humidity + ! Formula for Saturation Specific Humidity + if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod + sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - (1.0_core_rknd-ep) * esatv ) ) + else + sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - esatv ) ) + endif ! h1g, 2010-06-18 end mod +#else + ! Formula for Saturation Mixing Ratio: + ! + ! rs = (epsilon) * [ esat / ( p - esat ) ]; + ! where epsilon = R_d / R_v + sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - esatv ) ) +#endif + + end if + + return + end function sat_mixrat_liq + +!------------------------------------------------------------------------- + elemental real( kind = core_rknd ) function sat_mixrat_liq_lookup( p_in_Pa, T_in_K ) + +! Description: +! Used to compute the saturation mixing ratio of liquid water. +! This function utilizes sat_vapor_press_liq_lookup; the SVP is found +! using a lookup table rather than calculating it using various +! approximations. + +! References: +! Formula from Emanuel 1994, 4.4.14 +!------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + ep, & ! Variable + fstderr + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + p_in_Pa, & ! Pressure [Pa] + T_in_K ! Temperature [K] + + ! Local Variables + real( kind = core_rknd ) :: esatv + + ! --- Begin Code --- + + ! Calculate the SVP for water vapor using a lookup table. + esatv = sat_vapor_press_liq_lookup( T_in_K ) + + ! If esatv exceeds the air pressure, then assume esatv~=0.5*pressure + ! and set rsat = ep = 0.622 + if ( p_in_Pa-esatv < 1.0_core_rknd ) then + sat_mixrat_liq_lookup = ep + else + +#ifdef GFDL + + ! GFDL uses specific humidity + ! Formula for Saturation Specific Humidity + if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod + sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - (1.0_core_rknd-ep) * esatv ) ) + else + sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - esatv ) ) + endif ! h1g, 2010-06-18 end mod +#else + ! Formula for Saturation Mixing Ratio: + ! + ! rs = (epsilon) * [ esat / ( p - esat ) ]; + ! where epsilon = R_d / R_v + sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - esatv ) ) +#endif + + end if + + return + end function sat_mixrat_liq_lookup + +!----------------------------------------------------------------- + elemental function sat_vapor_press_liq( T_in_K ) result ( esat ) + +! Description: +! Computes SVP for water vapor. Calls one of the other functions +! that calculate an approximation to SVP. + +! References: +! None + + use crmx_model_flags, only: & + saturation_formula, & ! Variable + saturation_bolton, & + saturation_gfdl, & + saturation_flatau + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esat ! Saturation Vapor Pressure over Water [Pa] + + ! Undefined approximation + esat = -99999.999_core_rknd + + ! Saturation Vapor Pressure, esat, can be found to be approximated + ! in many different ways. + select case ( saturation_formula ) + case ( saturation_bolton ) + ! Using the Bolton 1980 approximations for SVP over vapor + esat = sat_vapor_press_liq_bolton( T_in_K ) + + case ( saturation_flatau ) + ! Using the Flatau, et al. polynomial approximation for SVP over vapor + esat = sat_vapor_press_liq_flatau( T_in_K ) + +! ---> h1g + case ( saturation_gfdl ) + ! Using GFDL polynomial approximation for SVP with respect to liquid + esat = sat_vapor_press_liq_gfdl( T_in_K ) +! <--- h1g + + ! Add new cases after this + + end select + + return + + end function sat_vapor_press_liq + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_liq_lookup( T_in_K ) result ( esat ) + +! Description: +! Computes SVP for water vapor, using a lookup table. +! +! The lookup table was constructed using the Flatau approximation. + +! References: +! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, +! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, +! pp. 1507--1513 +!------------------------------------------------------------------------ + + implicit none + + ! External + intrinsic :: max, min, int, anint + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] + + ! Local Variables + integer :: T_in_K_int + + ! ---- Begin Code ---- + + T_in_K_int = int( anint( T_in_K ) ) + + ! Since this approximation is only good out to -85 degrees Celsius we + ! truncate the result here + T_in_K_int = min( max( T_in_K_int, 188 ), 343 ) + + ! Use the lookup table to determine the saturation vapor pressure. + esat = svp_liq_lookup_table( T_in_K_int ) + + return + end function sat_vapor_press_liq_lookup + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_liq_flatau( T_in_K ) result ( esat ) + +! Description: +! Computes SVP for water vapor. + +! References: +! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, +! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, +! pp. 1507--1513 +!------------------------------------------------------------------------ + + use crmx_constants_clubb, only: T_freeze_K + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Constant parameters + + ! Relative error norm expansion (-50 to 50 deg_C) from + ! Table 3 of pp. 1510 of Flatau et al. 1992 (Water Vapor) + ! (The 100 coefficient converts from mb to Pa) +! real, dimension(7), parameter :: a = & +! 100.* (/ 6.11176750, 0.443986062, 0.143053301E-01, & +! 0.265027242E-03, 0.302246994E-05, 0.203886313E-07, & +! 0.638780966E-10 /) + + ! Relative error norm expansion (-85 to 70 deg_C) from + ! Table 4 of pp. 1511 of Flatau et al. + real( kind = core_rknd ), dimension(9), parameter :: a = & + 100._core_rknd * & + (/ 6.11583699_core_rknd, 0.444606896_core_rknd, 0.143177157E-01_core_rknd, & + 0.264224321E-03_core_rknd, 0.299291081E-05_core_rknd, 0.203154182E-07_core_rknd, & + 0.702620698E-10_core_rknd, 0.379534310E-13_core_rknd,-0.321582393E-15_core_rknd /) + + real( kind = core_rknd ), parameter :: min_T_in_C = -85._core_rknd ! [deg_C] + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] + + ! Local Variables + real( kind = core_rknd ) :: T_in_C +! integer :: i ! Loop index + + ! ---- Begin Code ---- + + ! Determine deg K - 273.15 + T_in_C = T_in_K - T_freeze_K + + ! Since this approximation is only good out to -85 degrees Celsius we + ! truncate the result here (Flatau, et al. 1992) + T_in_C = max( T_in_C, min_T_in_C ) + + ! Polynomial approx. (Flatau, et al. 1992) + + ! This is the generalized formula but is not computationally efficient. + ! Based on Wexler's expressions(2.1)-(2.4) (See Flatau et al. p 1508) + ! e_{sat} = a_1 + a_2 ( T - T_0 ) + ... + a_{n+1} ( T - T_0 )^n + +! esat = a(1) + +! do i = 2, size( a ) , 1 +! esat = esat + a(i) * ( T_in_C )**(i-1) +! end do + + ! The 8th order polynomial fit. When running deep + ! convective cases I noticed that absolute temperature often dips below + ! -50 deg_C at higher altitudes, where the 6th order approximation is + ! not accurate. -dschanen 20 Nov 2008 + esat = a(1) + T_in_C*( a(2) + T_in_C*( a(3) + T_in_C*( a(4) + T_in_C & + *( a(5) + T_in_C*( a(6) + T_in_C*( a(7) + T_in_C*( a(8) + T_in_C*( a(9) ) ) ) ) ) ) ) ) + + return + end function sat_vapor_press_liq_flatau + + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_liq_bolton( T_in_K ) result ( esat ) +! Description: +! Computes SVP for water vapor. +! References: +! Bolton 1980 +!------------------------------------------------------------------------ + + use crmx_constants_clubb, only: T_freeze_K + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: exp + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] + + ! (Bolton 1980) approx. + ! Generally this more computationally expensive than the Flatau polnomial expansion + esat = 611.2_core_rknd * exp( (17.67_core_rknd*(T_in_K-T_freeze_K)) / & + (T_in_K-29.65_core_rknd) ) ! Known magic number + + return + end function sat_vapor_press_liq_bolton + + +! ---> h1g, 2010-06-16 +!------------------------------------------------------------------------ + elemental function sat_vapor_press_liq_gfdl( T_in_K ) result ( esat ) +! Description: +! copy from "GFDL polysvp.F90" +! Compute saturation vapor pressure with respect to liquid by using +! function from Goff and Gatch (1946) + +! Polysvp returned in units of pa. +! T_in_K is input in units of K. +!------------------------------------------------------------------------ + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] + +! Goff Gatch equation, uncertain below -70 C + + esat = 10._core_rknd**(-7.90298_core_rknd*(373.16_core_rknd/T_in_K-1._core_rknd)+ & + 5.02808_core_rknd*log10(373.16_core_rknd/T_in_K)- & + 1.3816e-7_core_rknd*(10._core_rknd**(11.344_core_rknd & + *(1._core_rknd-T_in_K/373.16_core_rknd))-1._core_rknd)+ & + 8.1328e-3_core_rknd*(10._core_rknd**(-3.49149_core_rknd & + *(373.16_core_rknd/T_in_K-1._core_rknd))-1._core_rknd)+ & + log10(1013.246_core_rknd))*100._core_rknd ! Known magic number + + return + end function sat_vapor_press_liq_gfdl +! <--- h1g, 2010-06-16 + +!------------------------------------------------------------------------ + elemental real( kind = core_rknd ) function sat_mixrat_ice( p_in_Pa, T_in_K ) + +! Description: +! Used to compute the saturation mixing ratio of ice. + +! References: +! Formula from Emanuel 1994, 4.4.15 +!------------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + ep ! Variable(s) + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: trim + + ! Input Variables + + real( kind = core_rknd ), intent(in) :: & + p_in_Pa, & ! Pressure [Pa] + T_in_K ! Temperature [K] + + ! Local Variables + + real( kind = core_rknd ) :: esat_ice + + ! --- Begin Code --- + + ! Determine the SVP for the given temperature + esat_ice = sat_vapor_press_ice( T_in_K ) + + ! If esat_ice exceeds the air pressure, then assume esat_ice~=0.5*pressure + ! and set rsat = ep = 0.622 + if ( p_in_Pa-esat_ice < 1.0_core_rknd ) then + sat_mixrat_ice = ep + else + +#ifdef GFDL + ! GFDL uses specific humidity + ! Formula for Saturation Specific Humidity + if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod + sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - (1.0_core_rknd-ep) * esat_ice ) ) + else + sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - esat_ice ) ) + endif ! h1g, 2010-06-18 end mod +#else + ! Formula for Saturation Mixing Ratio: + ! + ! rs = (epsilon) * [ esat / ( p - esat ) ]; + ! where epsilon = R_d / R_v + + sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - esat_ice ) ) +#endif + + end if + + return + end function sat_mixrat_ice + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_ice( T_in_K ) result ( esat_ice ) +! +! Description: +! Computes SVP for ice, using one of the various approximations. +! +! References: +! None +!------------------------------------------------------------------------ + + use crmx_model_flags, only: & + saturation_formula, & ! Variable(s) + saturation_bolton, & + saturation_gfdl, & + saturation_flatau + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable + real( kind = core_rknd ), intent(in) :: & + T_in_K ! Temperature [K] + + ! Output Variable + real( kind = core_rknd ) :: esat_ice ! Saturation Vapor Pressure over Ice [Pa] + + ! Undefined approximation + esat_ice = -99999.999_core_rknd + + select case ( saturation_formula ) + case ( saturation_bolton ) + ! Using the Bolton 1980 approximations for SVP over ice + esat_ice = sat_vapor_press_ice_bolton( T_in_K ) + + case ( saturation_flatau ) + ! Using the Flatau, et al. polynomial approximation for SVP over ice + esat_ice = sat_vapor_press_ice_flatau( T_in_K ) + +! ---> h1g, 2010-06-16 + case ( saturation_gfdl ) + ! Using GFDL polynomial approximation for SVP with respect to ice + esat_ice = sat_vapor_press_ice_gfdl( T_in_K ) +! <--- h1g, 2010-06-16 + + ! Add new cases after this + + end select + + return + + end function sat_vapor_press_ice + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_ice_flatau( T_in_K ) result ( esati ) +! +! Description: +! Computes SVP for ice. +! +! References: +! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, +! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, +! pp. 1507--1513 +!------------------------------------------------------------------------ + use crmx_constants_clubb, only: T_freeze_K + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: max + + ! Relative error norm expansion (-90 to 0 deg_C) from + ! Table 4 of pp. 1511 of Flatau et al. 1992 (Ice) + real( kind = core_rknd ), dimension(9), parameter :: a = & + 100._core_rknd * (/ 6.09868993_core_rknd, 0.499320233_core_rknd, 0.184672631E-01_core_rknd, & + 0.402737184E-03_core_rknd, 0.565392987E-05_core_rknd, 0.521693933E-07_core_rknd, & + 0.307839583E-09_core_rknd, 0.105785160E-11_core_rknd, 0.161444444E-14_core_rknd /) + + real( kind = core_rknd ), parameter :: min_T_in_C = -90._core_rknd ! [deg_C] + + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [deg_K] + + ! Output Variables + real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] + + ! Local Variables + real( kind = core_rknd ) :: T_in_C ! Temperature [deg_C] +! integer :: i + + ! ---- Begin Code ---- + + ! Determine deg K - 273.15 + T_in_C = T_in_K - T_freeze_K + + ! Since this approximation is only good out to -90 degrees Celsius we + ! truncate the result here (Flatau, et al. 1992) + T_in_C = max( T_in_C, min_T_in_C ) + + ! Polynomial approx. (Flatau, et al. 1992) +! esati = a(1) + +! do i = 2, size( a ), 1 +! esati = esati + a(i) * ( T_in_C )**(i-1) +! end do + + esati = a(1) + T_in_C*( a(2) + T_in_C*( a(3) + T_in_C*( a(4) + T_in_C & + *( a(5) + T_in_C*( a(6) + T_in_C*( a(7) + T_in_C*( a(8) + T_in_C*( a(9) ) ) ) ) ) ) ) ) + + return + + end function sat_vapor_press_ice_flatau + +!------------------------------------------------------------------------ + elemental function sat_vapor_press_ice_bolton( T_in_K ) result ( esati ) +! +! Description: +! Computes SVP for ice. +! +! References: +! Bolton 1980 +!------------------------------------------------------------------------ + use crmx_constants_clubb, only: T_freeze_K + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: exp, log + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] + + ! Exponential approx. + esati = 100.0_core_rknd * exp( 23.33086_core_rknd - & + (6111.72784_core_rknd/T_in_K) + (0.15215_core_rknd*log( T_in_K )) ) + + return + + end function sat_vapor_press_ice_bolton + + +! ---> h1g, 2010-06-16 +!------------------------------------------------------------------------ + elemental function sat_vapor_press_ice_gfdl( T_in_K ) result ( esati ) +! Description: +! copy from "GFDL polysvp.F90" +! Compute saturation vapor pressure with respect to liquid by using +! function from Goff and Gatch (1946) +! +! Polysvp returned in units of pa. +! T_in_K is input in units of K. +!------------------------------------------------------------------------ + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] + + ! Output Variables + real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] + +! Goff Gatch equation (good down to -100 C) + + esati = 10._core_rknd**(-9.09718_core_rknd* & + (273.16_core_rknd/T_in_k-1._core_rknd)-3.56654_core_rknd* & + log10(273.16_core_rknd/T_in_k)+0.876793_core_rknd* & + (1._core_rknd-T_in_k/273.16_core_rknd)+ & + log10(6.1071_core_rknd))*100._core_rknd ! Known magic number + + return + + end function sat_vapor_press_ice_gfdl +! <--- h1g, 2010-06-16 + +!------------------------------------------------------------------------- + FUNCTION rcm_sat_adj( thlm, rtm, p_in_Pa, exner ) result ( rcm ) + + ! Description: + ! + ! This function uses an iterative method to find the value of rcm + ! from an initial profile that has saturation at some point. + ! + ! References: + ! None + !------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + use crmx_constants_clubb, only: & + Cp, & ! Variable(s) + Lv, & + zero_threshold + + implicit none + + ! Local Constant(s) + real( kind = core_rknd ), parameter :: & + tolerance = 0.001_core_rknd ! Tolerance on theta calculation [K] + + integer, parameter :: & + itermax = 1000000 ! Maximum interations + + ! External + intrinsic :: max, abs + + ! Input Variable(s) + real( kind = core_rknd ), intent(in) :: & + thlm, & ! Liquid Water Potential Temperature [K] + rtm, & ! Total Water Mixing Ratio [kg/kg] + p_in_Pa, & ! Pressure [Pa] + exner ! Exner function [-] + + ! Output Variable(s) + real( kind = core_rknd ) :: rcm ! Cloud water mixing ratio [kg/kg] + + ! Local Variable(s) + real( kind = core_rknd ) :: & + theta, answer, too_low, too_high ! [K] + + integer :: iteration + + ! ----- Begin Code ----- + + ! Default initialization + theta = thlm + too_high = 0.0_core_rknd + too_low = 0.0_core_rknd + + DO iteration = 1, itermax, 1 + + answer = & + theta - (Lv/(Cp*exner)) & + *(MAX( rtm - sat_mixrat_liq(p_in_Pa,theta*exner), zero_threshold )) + + IF ( ABS(answer - thlm) <= tolerance ) THEN + EXIT + ELSEIF ( answer - thlm > tolerance ) THEN + too_high = theta + ELSEIF ( thlm - answer > tolerance ) THEN + too_low = theta + ENDIF + + ! For the first timestep, be sure to set a "too_high" + ! that is "way too high." + IF ( iteration == 1 ) THEN + too_high = theta + 20.0_core_rknd + ENDIF + + theta = (too_low + too_high)/2.0_core_rknd + + END DO ! 1..itermax + + if ( iteration == itermax ) then + ! Magic Eric Raut added to remove compiler warning (clearly this value is not used) + rcm = 0.0_core_rknd + + stop "Error in rcm_sat_adj: could not determine rcm" + else + rcm = MAX( rtm - sat_mixrat_liq( p_in_Pa, theta*exner), zero_threshold ) + return + end if + + END FUNCTION rcm_sat_adj + +end module crmx_saturation diff --git a/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 new file mode 100644 index 0000000000..a10a868cdb --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 @@ -0,0 +1,64 @@ +! $Id: sigma_sqd_w_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_sigma_sqd_w_module + + implicit none + + public :: compute_sigma_sqd_w + + private ! Default scope + + contains +!--------------------------------------------------------------------------------------------------- + elemental function compute_sigma_sqd_w( gamma_Skw_fnc, wp2, thlp2, rtp2, wpthlp, wprtp ) & + result( sigma_sqd_w ) +! Description: +! Compute the variable sigma_sqd_w (PDF width parameter) +! +! References: +! Eqn 22 in ``Equations for CLUBB'' +!--------------------------------------------------------------------------------------------------- + use crmx_constants_clubb, only: & + w_tol, & ! Constant(s) + rt_tol, & + thl_tol + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: min, max, sqrt + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + gamma_Skw_fnc, & ! Gamma as a function of skewness [-] + wp2, & ! Variance of vertical velocity [m^2/s^2] + thlp2, & ! Variance of liquid pot. temp. [K^2] + rtp2, & ! Variance of total water [kg^2/kg^2] + wpthlp, & ! Flux of liquid pot. temp. [m/s K] + wprtp ! Flux of total water [m/s kg/kg] + + ! Output Variable + real( kind = core_rknd ) :: sigma_sqd_w ! PDF width parameter [-] + + ! ---- Begin Code ---- + + !---------------------------------------------------------------- + ! Compute sigma_sqd_w with new formula from Vince + !---------------------------------------------------------------- + + sigma_sqd_w = gamma_Skw_fnc * & + ( 1.0_core_rknd - min( & + max( ( wpthlp / ( sqrt( wp2 * thlp2 ) & + + 0.01_core_rknd * w_tol * thl_tol ) )**2, & + ( wprtp / ( sqrt( wp2 * rtp2 ) & + + 0.01_core_rknd * w_tol * rt_tol ) )**2 & + ), & ! max + 1.0_core_rknd ) & ! min - Known magic number (eq. 22 from "Equations for CLUBB") + ) + + return + end function compute_sigma_sqd_w + +end module crmx_sigma_sqd_w_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 b/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 new file mode 100644 index 0000000000..5f13049ebe --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 @@ -0,0 +1,211 @@ +!$Id: sponge_layer_damping.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_sponge_layer_damping +! Description: +! This module is used for damping variables in upper altitudes of the grid. +! +! References: +! None +!--------------------------------------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + public :: sponge_damp_xm, initialize_tau_sponge_damp, finalize_tau_sponge_damp, & + sponge_damp_settings, sponge_damp_profile + + + type sponge_damp_settings + + real( kind = core_rknd ) :: & + tau_sponge_damp_min, & ! Minimum damping time-scale (at the top) [s] + tau_sponge_damp_max, & ! Maximum damping time-scale (base of damping layer) [s] + sponge_damp_depth ! damping depth as a fraction of domain height [-] + + logical :: & + l_sponge_damping ! True if damping is being used + + end type sponge_damp_settings + + type sponge_damp_profile + real( kind = core_rknd ), pointer, dimension(:) :: & + tau_sponge_damp ! Damping factor + + integer :: & + n_sponge_damp ! Number of levels damped + + end type sponge_damp_profile + + + type(sponge_damp_settings), public :: & + thlm_sponge_damp_settings, & + rtm_sponge_damp_settings, & + uv_sponge_damp_settings + + type(sponge_damp_profile), public :: & + thlm_sponge_damp_profile, & + rtm_sponge_damp_profile, & + uv_sponge_damp_profile + + + private + + contains + + !--------------------------------------------------------------------------------------------- + function sponge_damp_xm( dt, xm_ref, xm, damping_profile ) result( xm_p ) + ! + ! Description: + ! Damps specified variable. The module must be initialized for + ! this function to work. Otherwise a stop is issued. + ! + ! References: + ! None + !------------------------------------------------------------------------------------------- + + ! "Sponge"-layer damping at the domain top region + + use crmx_grid_class, only: gr ! Variable(s) + + use crmx_clubb_precision, only: time_precision, core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: associated + + ! Input Variable(s) + real(kind=time_precision), intent(in) :: dt ! Model Timestep + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm_ref ! Reference to damp to [-] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + xm ! Variable being damped [-] + + type(sponge_damp_profile), intent(in) :: & + damping_profile + + ! Output Variable(s) + real( kind = core_rknd ), dimension(gr%nz) :: xm_p ! Variable damped [-] + + real( kind = core_rknd ) :: dt_on_tau ! Ratio of timestep to damping timescale [-] + + integer :: k + + ! ---- Begin Code ---- + + if ( associated( damping_profile%tau_sponge_damp ) ) then + + xm_p = xm + + do k = gr%nz, gr%nz-damping_profile%n_sponge_damp, -1 + +! Vince Larson used implicit discretization in order to +! reduce noise in rtm in cloud_feedback_s12 (CGILS) +! xm_p(k) = xm(k) - real( ( ( xm(k) - xm_ref(k) ) / & +! damping_profile%tau_sponge_damp(k) ) * dt ) + dt_on_tau = real( dt, kind = core_rknd ) / damping_profile%tau_sponge_damp(k) + +! Really, we should be using xm_ref at time n+1 rather than n. +! However, for steady profiles of xm_ref, it won't matter. + xm_p(k) = ( xm(k) + dt_on_tau * xm_ref(k) ) / & + ( 1.0_core_rknd + dt_on_tau ) +! End Vince Larson's change + end do ! k + + else + + stop "tau_sponge_damp in damping used before initialization" + + end if + + return + end function sponge_damp_xm + + !--------------------------------------------------------------------------------------------- + subroutine initialize_tau_sponge_damp( dt, settings, damping_profile ) + ! + ! Description: + ! Initialize tau_sponge_damp used for damping + ! + ! References: + ! None + !------------------------------------------------------------------------------------------- + use crmx_clubb_precision, only: time_precision, core_rknd ! Variable(s) + + use crmx_constants_clubb, only: fstderr ! Constant(s) + + use crmx_grid_class, only: gr ! Variable(s) + + use crmx_interpolation, only: lin_int ! function + + implicit none + + ! Input Variable(s) + real(kind=time_precision), intent(in) :: dt ! Model Timestep [s] + + type(sponge_damp_settings), intent(in) :: & + settings + + type(sponge_damp_profile), intent(out) :: & + damping_profile + + integer :: k ! Loop iterator + + ! ---- Begin Code ---- + + allocate( damping_profile%tau_sponge_damp(1:gr%nz)) + + if( settings%tau_sponge_damp_min < 2._core_rknd * real( dt, kind = core_rknd ) ) then + write(fstderr,*) 'Error: in damping() tau_sponge_damp_min is too small!' + stop + end if + + do k=gr%nz,1,-1 + if(gr%zt(gr%nz)-gr%zt(k) < settings%sponge_damp_depth*gr%zt(gr%nz)) then + damping_profile%n_sponge_damp=gr%nz-k+1 + endif + end do + + do k=gr%nz,gr%nz-damping_profile%n_sponge_damp,-1 +! Vince Larson added code to use standard linear interpolation. +! damping_profile%tau_sponge_damp(k) = settings%tau_sponge_damp_min *& +! (settings%tau_sponge_damp_max/settings%tau_sponge_damp_min)** & +! ( ( gr%zt(gr%nz)-gr%zt(k) ) / & +! (gr%zt(gr%nz) - gr%zt( gr%nz-damping_profile%n_sponge_damp ) ) ) + damping_profile%tau_sponge_damp(k) = & + lin_int( gr%zt(k), gr%zt(gr%nz), & + gr%zt(gr%nz) - gr%zt( gr%nz-damping_profile%n_sponge_damp ) , & + settings%tau_sponge_damp_min, settings%tau_sponge_damp_max ) +! End Vince Larson's change + end do + + return + end subroutine initialize_tau_sponge_damp + + !--------------------------------------------------------------------------------------------- + subroutine finalize_tau_sponge_damp( damping_profile ) + ! + ! Description: + ! Frees memory allocated in initialize_tau_sponge_damp + ! + ! References: + ! None + !------------------------------------------------------------------------------------------- + implicit none + + ! Input/Output Variable(s) + type(sponge_damp_profile), intent(inout) :: & + damping_profile ! Information for damping the profile + + ! ---- Begin Code ---- + + deallocate( damping_profile%tau_sponge_damp ) + + return + end subroutine finalize_tau_sponge_damp + + +end module crmx_sponge_layer_damping diff --git a/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 new file mode 100644 index 0000000000..0818ecf1bd --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 @@ -0,0 +1,94 @@ +!------------------------------------------------------------------------------- +! $Id: stat_file_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +module crmx_stat_file_module + + +! Description: +! Contains two derived types for describing the contents and location of +! either NetCDF or GrADS files. +!------------------------------------------------------------------------------- + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable + time_precision, & + core_rknd + + implicit none + + public :: variable, stat_file + + private ! Default scope + + ! Structure to hold the description of a variable + + type variable + ! Pointer to the array + real(kind=stat_rknd), dimension(:,:,:), pointer :: ptr + + character(len = 30) :: name ! Variable name + character(len = 100) :: description ! Variable description + character(len = 20) :: units ! Variable units + + integer :: indx ! NetCDF module Id for var / GrADS index + end type variable + + ! Structure to hold the description of a NetCDF output file + ! This makes the new code as compatible as possible with the + ! GrADS output code + + type stat_file + + ! File information + + character(len = 200) :: & + fname, & ! File name without suffix + fdir ! Path where fname resides + + integer :: iounit ! This number is used internally by the + ! NetCDF module to track the data set, or by + ! GrADS to track the actual file unit. + integer :: & + nrecord, & ! Number of records written + ntimes ! Number of times written + + logical :: & + l_defined, & ! Whether nf90_enddef() has been called + l_byte_swapped ! Is this a file in the opposite byte ordering? + + ! NetCDF datafile dimensions indices + integer :: & + LatDimId, LongDimId, AltDimId, TimeDimId, & + LatVarId, LongVarId, AltVarId, TimeVarId + + ! Grid information + + integer :: ia, iz ! Vertical extent + + integer :: nlat, nlon ! The number of points in the X and Y + + real( kind = core_rknd ), dimension(:), pointer :: & + z ! Height of vertical levels [m] + + ! Time information + + integer :: day, month, year ! Date of starting time + + real( kind = core_rknd ), dimension(:), pointer :: & + rlat, & ! Latitude [Degrees N] + rlon ! Longitude [Degrees E] + + real(kind=time_precision) :: & + dtwrite ! Interval between output [Seconds] + + real(kind=time_precision) :: & + time ! Start time [Seconds] + + ! Statistical Variables + + integer :: nvar ! Number of variables for this file + + type (variable), dimension(:), pointer :: & + var ! List and variable description + + end type stat_file + + end module crmx_stat_file_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 new file mode 100644 index 0000000000..f25a867d2a --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 @@ -0,0 +1,106 @@ +!----------------------------------------------------------------------- +! $Id: stats_LH_sfc.F90 6100 2013-03-08 17:53:44Z dschanen@uwm.edu $ + +module crmx_stats_LH_sfc + + + implicit none + + private ! Set Default Scope + + public :: stats_init_LH_sfc + + ! Constant parameters + integer, parameter, public :: nvarmax_LH_sfc = 10 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_LH_sfc( vars_LH_sfc, l_error ) + +! Description: +! Initializes array indices for LH_sfc +! References: +! None +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + LH_sfc ! Variable(s) + + use crmx_stats_variables, only: & + iLH_morr_rain_rate, & ! Variable(s) + iLH_morr_snow_rate, & + iLH_vwp, & + iLH_lwp + + use crmx_stats_type, only: & + stat_assign ! Procedure + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_LH_sfc), intent(in) :: vars_LH_sfc + + ! Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, k + + ! ---- Begin Code ---- + + ! Default initialization for array indices for sfc + + iLH_morr_rain_rate = 0 + iLH_morr_snow_rate = 0 + iLH_vwp = 0 + iLH_lwp = 0 + + ! Assign pointers for statistics variables sfc + + k = 1 + do i=1,LH_sfc%nn + + select case ( trim( vars_LH_sfc(i) ) ) + + case ( 'LH_morr_rain_rate' ) + iLH_morr_rain_rate = k + call stat_assign( iLH_morr_rain_rate, "LH_morr_rain_rate", & + "Total precip fallout rate from Morrison scheme [mm/day]","mm/day", LH_sfc ) + k = k + 1 + + case ( 'LH_morr_snow_rate' ) + iLH_morr_snow_rate = k + call stat_assign( iLH_morr_snow_rate, "LH_morr_snow_rate", & + "Snow+Ice+Graupel fallout rate from Morrison scheme [mm/day]","mm/day", LH_sfc ) + k = k + 1 + + case ( 'LH_vwp' ) + iLH_vwp = k + call stat_assign( iLH_vwp, "LH_vwp", & + "Vapor water path [kg/m^2]","kg/m^2", LH_sfc ) + k = k + 1 + + case ( 'LH_lwp' ) + iLH_lwp = k + call stat_assign( iLH_lwp, "LH_lwp", & + "Liquid water path [kg/m^2]","kg/m^2", LH_sfc ) + k = k + 1 + + case default + write(fstderr,*) 'Error: unrecognized variable in vars_LH_sfc: ', & + trim( vars_LH_sfc(i) ) + l_error = .true. ! This will stop the run. + + end select + + end do + + return + end subroutine stats_init_LH_sfc + +end module crmx_stats_LH_sfc + diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 new file mode 100644 index 0000000000..9e48d884d6 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 @@ -0,0 +1,478 @@ +!----------------------------------------------------------------------- +! $Id: stats_LH_zt.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ + +module crmx_stats_LH_zt + + implicit none + + private ! Default Scope + + public :: stats_init_LH_zt + +! Constant parameters + integer, parameter, public :: nvarmax_LH_zt = 100 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_LH_zt( vars_LH_zt, l_error ) + +! Description: +! Initializes array indices for zt + +! Note: +! All code that is within subroutine stats_init_zt, including variable +! allocation code, is not called if l_stats is false. This subroutine is +! called only when l_stats is true. + +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + LH_zt ! Variable + + use crmx_stats_variables, only: & + iAKm, & ! Variable(s) + iLH_AKm, & + iAKstd, & + iAKstd_cld, & + iAKm_rcm, & + iAKm_rcc + + use crmx_stats_variables, only: & + iLH_thlm_mc, & ! Variable(s) + iLH_rvm_mc, & + iLH_rcm_mc, & + iLH_Ncm_mc, & + iLH_rrainm_mc, & + iLH_Nrm_mc, & + iLH_rsnowm_mc, & + iLH_Nsnowm_mc, & + iLH_rgraupelm_mc, & + iLH_Ngraupelm_mc, & + iLH_ricem_mc, & + iLH_Nim_mc, & + iLH_Vrr, & + iLH_VNr, & + iLH_rcm_avg + + use crmx_stats_variables, only: & + iLH_rrainm, & ! Variable(s) + iLH_Nrm, & + iLH_ricem, & + iLH_Nim, & + iLH_rsnowm, & + iLH_Nsnowm, & + iLH_rgraupelm, & + iLH_Ngraupelm, & + iLH_thlm, & + iLH_rcm, & + iLH_Ncm, & + iLH_rvm, & + iLH_wm, & + iLH_wp2_zt, & + iLH_rcp2_zt, & + iLH_rtp2_zt, & + iLH_thlp2_zt, & + iLH_rrainp2_zt, & + iLH_Nrp2_zt, & + iLH_Ncp2_zt, & + iLH_cloud_frac, & + iLH_rrainm_auto, & + iLH_rrainm_accr + + + use crmx_stats_type, only: & + stat_assign ! Procedure + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_LH_zt), intent(in) :: vars_LH_zt + + ! Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, k + + ! ---- Begin Code ---- + + ! Default initialization for array indices for LH_zt + + iAKm = 0 ! analytic Kessler. Vince Larson 22 May 2005 + iLH_AKm = 0 ! LH Kessler. Vince Larson 22 May 2005 + iAKstd = 0 + iAKstd_cld = 0 + iAKm_rcm = 0 + iAKm_rcc = 0 + + iLH_thlm_mc = 0 + iLH_rvm_mc = 0 + iLH_rcm_mc = 0 + iLH_Ncm_mc = 0 + iLH_rrainm_mc = 0 + iLH_Nrm_mc = 0 + iLH_rsnowm_mc = 0 + iLH_Nsnowm_mc = 0 + iLH_rgraupelm_mc = 0 + iLH_Ngraupelm_mc = 0 + iLH_ricem_mc = 0 + iLH_Nim_mc = 0 + + iLH_rcm_avg = 0 + + iLH_Vrr = 0 + iLH_VNr = 0 + + iLH_rrainm = 0 + iLH_ricem = 0 + iLH_rsnowm = 0 + iLH_rgraupelm = 0 + + iLH_Nrm = 0 + iLH_Nim = 0 + iLH_Nsnowm = 0 + iLH_Ngraupelm = 0 + + iLH_thlm = 0 + iLH_rcm = 0 + iLH_rvm = 0 + iLH_wm = 0 + iLH_cloud_frac = 0 + + iLH_wp2_zt = 0 + iLH_rcp2_zt = 0 + iLH_rtp2_zt = 0 + iLH_thlp2_zt = 0 + iLH_rrainp2_zt = 0 + iLH_Nrp2_zt = 0 + iLH_Ncp2_zt = 0 + + iLH_rrainm_auto = 0 + iLH_rrainm_accr = 0 + + ! Assign pointers for statistics variables zt + + k = 1 + do i=1,LH_zt%nn + + select case ( trim(vars_LH_zt(i)) ) + case ( 'AKm' ) ! Vince Larson 22 May 2005 + iAKm = k + call stat_assign( iAKm, "AKm", & + "Analytic Kessler ac [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_AKm' ) ! Vince Larson 22 May 2005 + iLH_AKm = k + + call stat_assign( iLH_AKm, "LH_AKm", & + "LH Kessler estimate [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'AKstd' ) + iAKstd = k + + call stat_assign( iAKstd, "AKstd", & + "Exact standard deviation of gba Kessler [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'AKstd_cld' ) + iAKstd_cld = k + + call stat_assign( iAKstd_cld, "AKstd_cld", & + "Exact w/in cloud std of gba Kessler [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'AKm_rcm' ) + iAKm_rcm = k + + call stat_assign( iAKm_rcm, "AKm_rcm", & + "Exact local gba auto based on rcm [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'AKm_rcc' ) + iAKm_rcc = k + + call stat_assign( iAKm_rcc, "AKm_rcc", & + "Exact local gba based on w/in cloud rc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_rvm_mc' ) + iLH_rvm_mc = k + + call stat_assign( iLH_rvm_mc, "LH_rvm_mc", & + "Latin hypercube estimate of rvm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_thlm_mc' ) + iLH_thlm_mc = k + + call stat_assign( iLH_thlm_mc, "LH_thlm_mc", & + "Latin hypercube estimate of thlm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_rcm_mc' ) + iLH_rcm_mc = k + + call stat_assign( iLH_rcm_mc, "LH_rcm_mc", & + "Latin hypercube estimate of rcm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Ncm_mc' ) + iLH_Ncm_mc = k + + call stat_assign( iLH_Ncm_mc, "LH_Ncm_mc", & + "Latin hypercube estimate of Ncm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_rrainm_mc' ) + iLH_rrainm_mc = k + + call stat_assign( iLH_rrainm_mc, "LH_rrainm_mc", & + "Latin hypercube estimate of rrainm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Nrm_mc' ) + iLH_Nrm_mc = k + + call stat_assign( iLH_Nrm_mc, "LH_Nrm_mc", & + "Latin hypercube estimate of Nrm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case('LH_rsnowm_mc') + iLH_rsnowm_mc = k + + call stat_assign( iLH_rsnowm_mc, "LH_rsnowm_mc", & + "Latin hypercube estimate of rsnowm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Nsnowm_mc' ) + iLH_Nsnowm_mc = k + + call stat_assign( iLH_Nsnowm_mc, "LH_Nsnowm_mc", & + "Latin hypercube estimate of Nsnowm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_rgraupelm_mc' ) + iLH_rgraupelm_mc = k + + call stat_assign( iLH_rgraupelm_mc, "LH_rgraupelm_mc", & + "Latin hypercube estimate of rgraupelm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Ngraupelm_mc' ) + iLH_Ngraupelm_mc = k + + call stat_assign( iLH_Ngraupelm_mc, "LH_Ngraupelm_mc", & + "Latin hypercube estimate of Ngraupelm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_ricem_mc' ) + iLH_ricem_mc = k + + call stat_assign( iLH_ricem_mc, "LH_ricem_mc", & + "Latin hypercube estimate of ricem_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Nim_mc' ) + iLH_Nim_mc = k + + call stat_assign( iLH_Nim_mc, "LH_Nim_mc", & + "Latin hypercube estimate of Nim_mc [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_Vrr' ) + iLH_Vrr = k + + call stat_assign( iLH_Vrr, "LH_Vrr", & + "Latin hypercube estimate of rrainm sedimentation velocity [m/s]", "m/s", LH_zt ) + k = k + 1 + + case ( 'LH_VNr' ) + iLH_VNr = k + + call stat_assign( iLH_VNr, "LH_VNr", & + "Latin hypercube estimate of Nrm sedimentation velocity [m/s]", "m/s", LH_zt ) + k = k + 1 + + case ( 'LH_rcm_avg' ) + iLH_rcm_avg = k + + call stat_assign( iLH_rcm_avg, "LH_rcm_avg", & + "Latin hypercube average estimate of rcm [kg/kg]", "kg/kg", LH_zt ) + + k = k + 1 + + case ( 'LH_rrainm' ) + iLH_rrainm = k + + call stat_assign( iLH_rrainm, "LH_rrainm", & + "Latin hypercube estimate of rrainm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_Nrm' ) + iLH_Nrm = k + + call stat_assign( iLH_Nrm, "LH_Nrm", & + "Latin hypercube estimate of Nrm [count/kg]", "count/kg", LH_zt ) + k = k + 1 + + case ( 'LH_ricem' ) + iLH_ricem = k + + call stat_assign( iLH_ricem, "LH_ricem", & + "Latin hypercube estimate of ricem [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_Nim' ) + iLH_Nim = k + + call stat_assign( iLH_Nim, "LH_Nim", & + "Latin hypercube estimate of Nim [count/kg]", "count/kg", LH_zt ) + k = k + 1 + + case ( 'LH_rsnowm' ) + iLH_rsnowm = k + + call stat_assign( iLH_rsnowm, "LH_rsnowm", & + "Latin hypercube estimate of rsnowm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_Nsnowm' ) + iLH_Nsnowm = k + + call stat_assign( iLH_Nsnowm, "LH_Nsnowm", & + "Latin hypercube estimate of Nsnowm [count/kg]", "count/kg", LH_zt ) + k = k + 1 + + + case ( 'LH_rgraupelm' ) + iLH_rgraupelm = k + + call stat_assign( iLH_rgraupelm, "LH_rgraupelm", & + "Latin hypercube estimate of rgraupelm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_Ngraupelm' ) + iLH_Ngraupelm = k + + call stat_assign( iLH_Ngraupelm, "LH_Ngraupelm", & + "Latin hypercube estimate of Ngraupelm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_thlm' ) + iLH_thlm = k + + call stat_assign( iLH_thlm, "LH_thlm", & + "Latin hypercube estimate of thlm [K]", "K", LH_zt ) + k = k + 1 + + case ( 'LH_rcm' ) + iLH_rcm = k + + call stat_assign( iLH_rcm, "LH_rcm", & + "Latin hypercube estimate of rcm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_Ncm' ) + iLH_Ncm = k + + call stat_assign( iLH_Ncm, "LH_Ncm", & + "Latin hypercube estimate of Ncm [count/kg]", "count/kg", LH_zt ) + k = k + 1 + + + case ( 'LH_rvm' ) + iLH_rvm = k + + call stat_assign( iLH_rvm, "LH_rvm", & + "Latin hypercube estimate of rvm [kg/kg]", "kg/kg", LH_zt ) + k = k + 1 + + case ( 'LH_wm' ) + iLH_wm = k + + call stat_assign( iLH_wm, "LH_wm", & + "Latin hypercube estimate of vertical velocity [m/s]", "m/s", LH_zt ) + k = k + 1 + + case ( 'LH_cloud_frac' ) + iLH_cloud_frac = k + + ! Note: count is the udunits compatible unit + call stat_assign( iLH_cloud_frac, "LH_cloud_frac", & + "Latin hypercube estimate of cloud fraction [count]", "count", LH_zt ) + k = k + 1 + + case ( 'LH_wp2_zt' ) + iLH_wp2_zt = k + call stat_assign( iLH_wp2_zt, "LH_wp2_zt", & + "Variance of the latin hypercube estimate of w [m^2/s^2]", "m^2/s^2", LH_zt ) + k = k + 1 + + case ( 'LH_Ncp2_zt' ) + iLH_Ncp2_zt = k + call stat_assign( iLH_Ncp2_zt, "LH_Ncp2_zt", & + "Variance of the latin hypercube estimate of Nc [count^2/kg^2]", "count^2/kg^2", LH_zt ) + k = k + 1 + + case ( 'LH_Nrp2_zt' ) + iLH_Nrp2_zt = k + call stat_assign( iLH_Nrp2_zt, "LH_Nrp2_zt", & + "Variance of the latin hypercube estimate of Nr [count^2/kg^2]", "count^2/kg^2", LH_zt ) + k = k + 1 + + case ( 'LH_rcp2_zt' ) + iLH_rcp2_zt = k + call stat_assign( iLH_rcp2_zt, "LH_rcp2_zt", & + "Variance of the latin hypercube estimate of rc [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) + k = k + 1 + + case ( 'LH_rtp2_zt' ) + iLH_rtp2_zt = k + call stat_assign( iLH_rtp2_zt, "LH_rtp2_zt", & + "Variance of the latin hypercube estimate of rt [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) + k = k + 1 + + case ( 'LH_thlp2_zt' ) + iLH_thlp2_zt = k + call stat_assign( iLH_thlp2_zt, "LH_thlp2_zt", & + "Variance of the latin hypercube estimate of thl [K^2]", "K^2", LH_zt ) + k = k + 1 + + case ( 'LH_rrainp2_zt' ) + iLH_rrainp2_zt = k + call stat_assign( iLH_rrainp2_zt, "LH_rrainp2_zt", & + "Variance of the latin hypercube estimate of rrain [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) + k = k + 1 + + case ( 'LH_rrainm_auto' ) + iLH_rrainm_auto = k + call stat_assign( iLH_rrainm_auto, "LH_rrainm_auto", & + "Latin hypercube estimate of autoconversion [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case ( 'LH_rrainm_accr' ) + iLH_rrainm_accr = k + call stat_assign( iLH_rrainm_accr, "LH_rrainm_accr", & + "Latin hypercube estimate of accretion [kg/kg/s]", "kg/kg/s", LH_zt ) + k = k + 1 + + case default + + write(fstderr,*) 'Error: unrecognized variable in vars_LH_zt: ', trim( vars_LH_zt(i) ) + + l_error = .true. ! This will stop the run. + + end select + + end do + + return + end subroutine stats_init_LH_zt + +end module crmx_stats_LH_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 new file mode 100644 index 0000000000..8e12d00fd7 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 @@ -0,0 +1,157 @@ +!----------------------------------------------------------------------- +! $Id: stats_rad_zm.F90 4032 2009-08-17 21:45:29Z senkbeil@uwm.edu $ + +module crmx_stats_rad_zm + + implicit none + + private ! Default Scope + + public :: stats_init_rad_zm + +! Constant parameters + integer, parameter, public :: nvarmax_rad_zm = 250 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_rad_zm( vars_rad_zm, l_error ) + +! Description: +! Initializes array indices for rad_zm variables +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + rad_zm, & + iFrad_LW_rad, & ! Variable(s) + iFrad_SW_rad, & + iFrad_SW_up_rad, & + iFrad_LW_up_rad, & + iFrad_SW_down_rad, & + iFrad_LW_down_rad + + use crmx_stats_variables, only: & + ifulwcl, ifdlwcl, ifdswcl, ifuswcl ! Variable(s) + + use crmx_stats_type, only: & + stat_assign ! Procedure + + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_rad_zm), intent(in) :: vars_rad_zm + + ! Input/Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, k + + ! ---- Begin Code ---- + + ! Default initialization for array indices for rad_zm + + iFrad_LW_rad = 0 + iFrad_SW_rad = 0 + iFrad_SW_up_rad = 0 + iFrad_LW_up_rad = 0 + iFrad_SW_down_rad = 0 + iFrad_LW_down_rad = 0 + + ifulwcl = 0 + ifdlwcl = 0 + ifdswcl = 0 + ifuswcl = 0 + +! Assign pointers for statistics variables rad_zm + + k = 1 + do i=1,rad_zm%nn + + select case ( trim(vars_rad_zm(i)) ) + + case('fulwcl') + ifulwcl = k + call stat_assign( ifulwcl, "fulwcl", & + "Upward clear-sky LW flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case( 'fdlwcl' ) + ifdlwcl = k + call stat_assign( ifdlwcl, "fdlwcl", & + "Downward clear-sky LW flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case( 'fdswcl' ) + ifdswcl = k + call stat_assign( ifdswcl, "fdswcl", & + "Downward clear-sky SW flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case( 'fuswcl' ) + ifuswcl = k + call stat_assign( ifuswcl, "fuswcl", & + "Upward clear-sky SW flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_LW_rad') + iFrad_LW_rad = k + + call stat_assign( iFrad_LW_rad, "Frad_LW_rad", & + "Net long-wave radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_SW_rad') + iFrad_SW_rad = k + + call stat_assign( iFrad_SW_rad, "Frad_SW_rad", & + "Net short-wave radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_SW_up_rad') + iFrad_SW_up_rad = k + + call stat_assign( iFrad_SW_up_rad, "Frad_SW_up_rad", & + "Short-wave upwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_LW_up_rad') + iFrad_LW_up_rad = k + + call stat_assign( iFrad_LW_up_rad, "Frad_LW_up_rad", & + "Long-wave upwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_SW_down_rad') + iFrad_SW_down_rad = k + + call stat_assign( iFrad_SW_down_rad, "Frad_SW_down_rad", & + "Short-wave downwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case ('Frad_LW_down_rad') + iFrad_LW_down_rad = k + + call stat_assign( iFrad_LW_down_rad, "Frad_LW_down_rad", & + "Long-wave downwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) + k = k + 1 + + case default + + write(fstderr,*) 'Error: unrecognized variable in vars_rad_zm: ', trim( vars_rad_zm(i) ) + + l_error = .true. ! This will stop the run. + + + end select + + end do + + return + end subroutine stats_init_rad_zm + +end module crmx_stats_rad_zm diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 new file mode 100644 index 0000000000..541fc2442b --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 @@ -0,0 +1,163 @@ +!----------------------------------------------------------------------- +! $Id: stats_rad_zt.F90 4032 2009-08-17 21:45:29Z senkbeil@uwm.edu $ + +module crmx_stats_rad_zt + + implicit none + + private ! Default Scope + + public :: stats_init_rad_zt + + ! Constant parameters + integer, parameter, public :: nvarmax_rad_zt = 250 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_rad_zt( vars_rad_zt, l_error ) + +! Description: +! Initializes array indices for zt +! +! References: +! None +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + rad_zt, & + iT_in_K_rad, & ! Variable(s) + ircil_rad, & + io3l_rad, & + irsnowm_rad, & + ircm_in_cloud_rad, & + icloud_frac_rad, & + iice_supersat_frac_rad, & + iradht_rad, & + iradht_LW_rad, & + iradht_SW_rad + + use crmx_stats_type, only: & + stat_assign ! Procedure + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_rad_zt), intent(in) :: vars_rad_zt + + ! Input/Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, k + + ! ---- Begin Code ---- + + ! Default initialization for array indices for rad_zt + + iT_in_K_rad = 0 + ircil_rad = 0 + io3l_rad = 0 + irsnowm_rad = 0 + ircm_in_cloud_rad = 0 + icloud_frac_rad = 0 + iice_supersat_frac_rad = 0 + iradht_rad = 0 + iradht_LW_rad = 0 + iradht_SW_rad = 0 + + ! Assign pointers for statistics variables rad_zt + + k = 1 + do i=1,rad_zt%nn + + select case ( trim(vars_rad_zt(i)) ) + + case ('T_in_K_rad') + iT_in_K_rad = k + + call stat_assign( iT_in_K_rad, "T_in_K_rad", & + "Temperature [K]", "K", rad_zt ) + k = k + 1 + + case ('rcil_rad') + ircil_rad = k + + call stat_assign( ircil_rad, "rcil_rad", & + "Ice mixing ratio [kg/kg]", "kg/kg", rad_zt ) + k = k + 1 + + case ('o3l_rad') + io3l_rad = k + + call stat_assign( io3l_rad, "o3l_rad", & + "Ozone mixing ratio [kg/kg]", "kg/kg", rad_zt ) + k = k + 1 + + case ('rsnowm_rad') + irsnowm_rad = k + + call stat_assign( irsnowm_rad, "rsnowm_rad", & + "Snow water mixing ratio [kg/kg]", "kg/kg", rad_zt ) + k = k + 1 + + case ('rcm_in_cloud_rad') + ircm_in_cloud_rad = k + + call stat_assign( ircm_in_cloud_rad, "rcm_in_cloud_rad", & + "rcm in cloud layer [kg/kg]", "kg/kg", rad_zt ) + k = k + 1 + + case ('cloud_frac_rad') + icloud_frac_rad = k + + call stat_assign( icloud_frac_rad, "cloud_frac_rad", & + "Cloud fraction (between 0 and 1) [-]", "count", rad_zt ) + k = k + 1 + + case ('ice_supersat_frac_rad') + iice_supersat_frac_rad = k + + call stat_assign( iice_supersat_frac_rad, "ice_supersat_frac_rad", & + "Ice cloud fraction (between 0 and 1) [-]", "count", rad_zt ) + k = k + 1 + + case ('radht_rad') + iradht_rad = k + + call stat_assign( iradht_rad, "radht_rad", & + "Total radiative heating rate [K/s]", "K/s", rad_zt ) + k = k + 1 + + case ('radht_LW_rad') + iradht_LW_rad = k + + call stat_assign( iradht_LW_rad, "radht_LW_rad", & + "Long-wave radiative heating rate [K/s]", "K/s", rad_zt ) + k = k + 1 + + case ('radht_SW_rad') + iradht_SW_rad = k + + call stat_assign( iradht_SW_rad, "radht_SW_rad", & + "Short-wave radiative heating rate [K/s]", "K/s", rad_zt ) + k = k + 1 + + case default + + write(fstderr,*) 'Error: unrecognized variable in vars_rad_zt: ', trim( vars_rad_zt(i) ) + + l_error = .true. ! This will stop the run. + + + end select + + end do + + return + end subroutine stats_init_rad_zt + +end module crmx_stats_rad_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 new file mode 100644 index 0000000000..fdea934be5 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 @@ -0,0 +1,469 @@ +!----------------------------------------------------------------------- +! $Id: stats_sfc.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ + +module crmx_stats_sfc + + + implicit none + + private ! Set Default Scope + + public :: stats_init_sfc + + ! Constant parameters + integer, parameter, public :: nvarmax_sfc = 250 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_sfc( vars_sfc, l_error ) + +! Description: +! Initializes array indices for sfc +! References: +! None +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + sfc, & ! Variables + iustar, & + isoil_heat_flux, & + iveg_T_in_K, & + isfc_soil_T_in_K,& + ideep_soil_T_in_K, & + ilh, & + ish, & + icc, & + ilwp, & + ivwp, & + iiwp, & + iswp, & + irwp, & + iz_cloud_base, & + iz_inversion, & + irain_rate_sfc, & + irain_flux_sfc, & + irrainm_sfc + + use crmx_stats_variables, only: & + iwpthlp_sfc, & + iwprtp_sfc, & + iupwp_sfc, & + ivpwp_sfc, & + ithlm_vert_avg, & + irtm_vert_avg, & + ium_vert_avg, & + ivm_vert_avg, & + iwp2_vert_avg, & + iup2_vert_avg, & + ivp2_vert_avg, & + irtp2_vert_avg, & + ithlp2_vert_avg, & + iT_sfc + + use crmx_stats_variables, only: & + iwp23_matrix_condt_num, & + irtm_matrix_condt_num, & + ithlm_matrix_condt_num, & + irtp2_matrix_condt_num, & + ithlp2_matrix_condt_num, & + irtpthlp_matrix_condt_num, & + iup2_vp2_matrix_condt_num, & + iwindm_matrix_condt_num + + use crmx_stats_variables, only: & + imorr_rain_rate, & + imorr_snow_rate + + use crmx_stats_variables, only: & + irtm_spur_src, & + ithlm_spur_src + + use crmx_stats_type, only: & + stat_assign ! Procedure + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_sfc), intent(in) :: vars_sfc + + ! Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, k + + ! ---- Begin Code ---- + + ! Default initialization for array indices for sfc + + isoil_heat_flux = 0 + iveg_T_in_K = 0 + isfc_soil_T_in_K = 0 + ideep_soil_T_in_K = 0 + + iustar = 0 + ilh = 0 + ish = 0 + icc = 0 + ilwp = 0 + irwp = 0 + ivwp = 0 ! nielsenb + iiwp = 0 ! nielsenb + iswp = 0 ! nielsenb + iz_cloud_base = 0 + iz_inversion = 0 + irain_rate_sfc = 0 ! Brian + irain_flux_sfc = 0 ! Brian + irrainm_sfc = 0 ! Brian + iwpthlp_sfc = 0 + iwprtp_sfc = 0 + iupwp_sfc = 0 + ivpwp_sfc = 0 + ithlm_vert_avg = 0 + irtm_vert_avg = 0 + ium_vert_avg = 0 + ivm_vert_avg = 0 + iwp2_vert_avg = 0 ! nielsenb + iup2_vert_avg = 0 + ivp2_vert_avg = 0 + irtp2_vert_avg = 0 + ithlp2_vert_avg = 0 + iT_sfc = 0 ! kcwhite + + ! These are estimates of the condition number on each LHS + ! matrix, and not located at the surface of the domain. + iwp23_matrix_condt_num = 0 + irtm_matrix_condt_num = 0 + ithlm_matrix_condt_num = 0 + irtp2_matrix_condt_num = 0 + ithlp2_matrix_condt_num = 0 + irtpthlp_matrix_condt_num = 0 + iup2_vp2_matrix_condt_num = 0 + iwindm_matrix_condt_num = 0 + + imorr_rain_rate = 0 + imorr_snow_rate = 0 + + irtm_spur_src = 0 + ithlm_spur_src = 0 + + ! Assign pointers for statistics variables sfc + + k = 1 + do i=1,sfc%nn + + select case ( trim(vars_sfc(i)) ) + case ('soil_heat_flux') + isoil_heat_flux = k + + call stat_assign(isoil_heat_flux, "soil_heat_flux", & + "soil_heat_flux[W/m^2]","W/m^2",sfc ) + k = k + 1 + case ('ustar') + iustar = k + + call stat_assign(iustar,"ustar", & + "Friction velocity [m/s]","m/s",sfc) + k = k + 1 + case ('veg_T_in_K') + iveg_T_in_K = k + + call stat_assign(iveg_T_in_K,"veg_T_in_K", & + "Surface Vegetation Temperature [K]","K",sfc) + k = k + 1 + case ('sfc_soil_T_in_K') + isfc_soil_T_in_K = k + + call stat_assign(isfc_soil_T_in_K,"sfc_soil_T_in_K", & + "Surface soil temperature [K]","K",sfc) + k = k + 1 + case ('deep_soil_T_in_K') + ideep_soil_T_in_K = k + + call stat_assign(ideep_soil_T_in_K,"deep_soil_T_in_K", & + "Deep soil Temperature [K]","K",sfc) + k = k + 1 + + case ('lh') + ilh = k + call stat_assign(ilh,"lh", & + "Surface latent heating [W/m^2]","W/m2",sfc) + k = k + 1 + + case ('sh') + ish = k + call stat_assign(ish,"sh", & + "Surface sensible heating [W/m^2]","W/m2",sfc) + k = k + 1 + + case ('cc') + icc = k + call stat_assign(icc,"cc", & + "Cloud cover [count]","count",sfc) + k = k + 1 + + case ('lwp') + ilwp = k + call stat_assign(ilwp,"lwp", & + "Liquid water path [kg/m^2]","kg/m2",sfc) + k = k + 1 + + case ('vwp') + ivwp = k + call stat_assign(ivwp,"vwp", & + "Vapor water path [kg/m^2]","kg/m2",sfc) + k = k + 1 + + case ('iwp') + iiwp = k + call stat_assign(iiwp,"iwp", & + "Ice water path [kg/m^2]","kg/m2",sfc) + k = k + 1 + + case ('swp') + iswp = k + call stat_assign(iswp,"swp", & + "Snow water path [kg/m^2]","kg/m2",sfc) + k = k + 1 + + case ('rwp') + irwp = k + call stat_assign(irwp,"rwp", & + "Rain water path [kg/m^2]","kg/m2",sfc) + k = k + 1 + + case ('z_cloud_base') + iz_cloud_base = k + call stat_assign(iz_cloud_base,"z_cloud_base", & + "Cloud base altitude [m]","m",sfc) + k = k + 1 + + case ('z_inversion') + iz_inversion = k + call stat_assign(iz_inversion,"z_inversion", & + "Inversion altitude [m]","m",sfc) + k = k + 1 + + case ('rain_rate_sfc') ! Brian + irain_rate_sfc = k + call stat_assign(irain_rate_sfc,"rain_rate_sfc", & + "Surface rainfall rate [mm/day]","mm/day",sfc) + k = k + 1 + + case ('rain_flux_sfc') ! Brian + irain_flux_sfc = k + + call stat_assign( irain_flux_sfc,"rain_flux_sfc", & + "Surface rain flux [W/m^2]", "W/m^2", sfc ) + k = k + 1 + + case ('rrainm_sfc') ! Brian + irrainm_sfc = k + + call stat_assign(irrainm_sfc,"rrainm_sfc", & + "Surface rain water mixing ratio [kg/kg]","kg/kg",sfc) + k = k + 1 + + case ( 'morr_rain_rate' ) + imorr_rain_rate = k + call stat_assign( imorr_rain_rate, "morr_rain_rate", & + "Total precip fallout rate from Morrison scheme [mm/day]","mm/day", sfc ) + k = k + 1 + + case ( 'morr_snow_rate' ) + imorr_snow_rate = k + call stat_assign( imorr_snow_rate, "morr_snow_rate", & + "Snow+Ice+Graupel fallout rate from Morrison scheme [mm/day]","mm/day", sfc ) + k = k + 1 + + case ('wpthlp_sfc') + iwpthlp_sfc = k + + call stat_assign(iwpthlp_sfc,"wpthlp_sfc", & + "wpthlp surface flux [K m/s]","K m/s",sfc) + k = k + 1 + + case ('wprtp_sfc') + iwprtp_sfc = k + + call stat_assign(iwprtp_sfc,"wprtp_sfc", & + "wprtp surface flux [kg/kg]","(kg/kg) m/s",sfc) + k = k + 1 + + case ('upwp_sfc') + iupwp_sfc = k + + call stat_assign(iupwp_sfc,"upwp_sfc", & + "upwp surface flux [m^2/s^2]","m^2/s^2",sfc) + k = k + 1 + + case ('vpwp_sfc') + ivpwp_sfc = k + + call stat_assign(ivpwp_sfc,"vpwp_sfc", & + "vpwp surface flux [m^2/s^2]","m^2/s^2",sfc) + k = k + 1 + + case ('thlm_vert_avg') + ithlm_vert_avg = k + + call stat_assign( ithlm_vert_avg, "thlm_vert_avg", & + "Vertical average (density-weighted) of thlm [K]", "K", sfc ) + k = k + 1 + + case ('rtm_vert_avg') + irtm_vert_avg = k + + call stat_assign( irtm_vert_avg, "rtm_vert_avg", & + "Vertical average (density-weighted) of rtm [kg/kg]", "kg/kg", sfc ) + k = k + 1 + + case ('um_vert_avg') + ium_vert_avg = k + + call stat_assign( ium_vert_avg, "um_vert_avg", & + "Vertical average (density-weighted) of um [m/s]", "m/s", sfc ) + k = k + 1 + + case ('vm_vert_avg') + ivm_vert_avg = k + + call stat_assign( ivm_vert_avg, "vm_vert_avg", & + "Vertical average (density-weighted) of vm [m/s]", "m/s", sfc ) + k = k + 1 + + case ('wp2_vert_avg') + iwp2_vert_avg = k + + call stat_assign( iwp2_vert_avg, "wp2_vert_avg", & + "Vertical average (density-weighted) of wp2 [m^2/s^2]", "m^2/s^2", & + sfc ) + k = k + 1 + + case ('up2_vert_avg') + iup2_vert_avg = k + + call stat_assign( iup2_vert_avg, "up2_vert_avg", & + "Vertical average (density-weighted) of up2 [m^2/s^2]", "m^2/s^2", & + sfc ) + k = k + 1 + + case ('vp2_vert_avg') + ivp2_vert_avg = k + + call stat_assign( ivp2_vert_avg, "vp2_vert_avg", & + "Vertical average (density-weighted) of vp2 [m^2/s^2]", "m^2/s^2", & + sfc ) + k = k + 1 + + case ('rtp2_vert_avg') + irtp2_vert_avg = k + + call stat_assign( irtp2_vert_avg, "rtp2_vert_avg", & + "Vertical average (density-weighted) of rtp2 [kg^2/kg^2]", & + "kg^2/kg^2", sfc ) + k = k + 1 + + case ('thlp2_vert_avg') + ithlp2_vert_avg = k + + call stat_assign( ithlp2_vert_avg, "thlp2_vert_avg", & + "Vertical average (density-weighted) of thlp2 [K^2]", "K^2", sfc ) + k = k + 1 + + case ('T_sfc') + iT_sfc = k + + call stat_assign( iT_sfc, "T_sfc", "Surface Temperature [K]", "K", sfc ) + k = k + 1 + + case ('wp23_matrix_condt_num') + iwp23_matrix_condt_num = k + call stat_assign(iwp23_matrix_condt_num,"wp23_matrix_condt_num", & + "Estimate of the condition number for wp2/3 [count]","count",sfc) + k = k + 1 + + case ('thlm_matrix_condt_num') + ithlm_matrix_condt_num = k + call stat_assign(ithlm_matrix_condt_num,"thlm_matrix_condt_num", & + "Estimate of the condition number for thlm/wpthlp [count]", & + "count",sfc) + k = k + 1 + + case ('rtm_matrix_condt_num') + irtm_matrix_condt_num = k + + call stat_assign(irtm_matrix_condt_num,"rtm_matrix_condt_num", & + "Estimate of the condition number for rtm/wprtp [count]", & + "count",sfc) + k = k + 1 + + case ('thlp2_matrix_condt_num') + ithlp2_matrix_condt_num = k + + call stat_assign(ithlp2_matrix_condt_num,"thlp2_matrix_condt_num", & + "Estimate of the condition number for thlp2 [count]", & + "count",sfc) + k = k + 1 + + case ('rtp2_matrix_condt_num') + irtp2_matrix_condt_num = k + call stat_assign(irtp2_matrix_condt_num,"rtp2_matrix_condt_num", & + "Estimate of the condition number for rtp2 [count]", & + "count",sfc) + k = k + 1 + + case ('rtpthlp_matrix_condt_num') + irtpthlp_matrix_condt_num = k + call stat_assign(irtpthlp_matrix_condt_num,"rtpthlp_matrix_condt_num", & + "Estimate of the condition number for rtpthlp [count]", & + "count",sfc) + k = k + 1 + + case ('up2_vp2_matrix_condt_num') + iup2_vp2_matrix_condt_num = k + call stat_assign(iup2_vp2_matrix_condt_num,"up2_vp2_matrix_condt_num", & + "Estimate of the condition number for up2/vp2 [count]","count",sfc) + k = k + 1 + + case ('windm_matrix_condt_num') + iwindm_matrix_condt_num = k + call stat_assign(iwindm_matrix_condt_num,"windm_matrix_condt_num", & + "Estimate of the condition number for the mean wind [count]","count",sfc) + + k = k + 1 + + case ('rtm_spur_src') + irtm_spur_src = k + + call stat_assign(irtm_spur_src, "rtm_spur_src", & + "rtm spurious source [kg/(m^2 s)]", "kg/(m^2 s)",sfc ) + k = k + 1 + + case ('thlm_spur_src') + ithlm_spur_src = k + + call stat_assign(ithlm_spur_src, "thlm_spur_src", & + "thlm spurious source [(K kg) / (m^2 s)]", "(K kg) / (m^2 s)",sfc ) + k = k + 1 + + case default + write(fstderr,*) 'Error: unrecognized variable in vars_sfc: ', & + trim( vars_sfc(i) ) + l_error = .true. ! This will stop the run. + + end select + + end do + + return + + end subroutine stats_init_sfc + + +end module crmx_stats_sfc + diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 new file mode 100644 index 0000000000..8245c378db --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 @@ -0,0 +1,2679 @@ +!----------------------------------------------------------------------- +! $Id: stats_subs.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +module crmx_stats_subs + + implicit none + + private ! Set Default Scope + + public :: stats_init, stats_begin_timestep, stats_end_timestep, & + stats_accumulate, stats_finalize, stats_accumulate_hydromet, & + stats_accumulate_LH_tend + + private :: stats_zero, stats_avg + + contains + + !----------------------------------------------------------------------- + subroutine stats_init( iunit, fname_prefix, fdir, l_stats_in, & + stats_fmt_in, stats_tsamp_in, stats_tout_in, fnamelist, & + nzmax, gzt, gzm, nnrad_zt, & + grad_zt, nnrad_zm, grad_zm, day, month, year, & + rlat, rlon, time_current, delt ) + ! + ! Description: + ! Initializes the statistics saving functionality of the CLUBB model. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_stats_variables, only: & + zt, & ! Variables + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use crmx_stats_variables, only: & + LH_zt, & ! Variable(s) + LH_sfc + + use crmx_stats_variables, only: & + zm, & ! Variables + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + rad_zt + + use crmx_stats_variables, only: & + rad_zm, & + sfc, & + l_stats, & + l_output_rad_files, & + stats_tsamp, & + stats_tout, & + l_stats_samp, & + l_stats_last, & + fname_zt, & + fname_LH_zt, & + fname_LH_sfc, & + fname_zm, & + fname_rad_zt, & + fname_rad_zm, & + fname_sfc, & + l_netcdf, & + l_grads + + use crmx_clubb_precision, only: & + time_precision, & ! Constant(s) + core_rknd + + use crmx_output_grads, only: & + open_grads ! Procedure + +#ifdef NETCDF + use crmx_output_netcdf, only: & + open_netcdf ! Procedure +#endif + + use crmx_stats_zm, only: & + nvarmax_zm, & ! Constant(s) + stats_init_zm ! Procedure(s) + + use crmx_stats_zt, only: & + nvarmax_zt, & ! Constant(s) + stats_init_zt ! Procedure(s) + + use crmx_stats_LH_zt, only: & + nvarmax_LH_zt, & ! Constant(s) + stats_init_LH_zt ! Procedure(s) + + use crmx_stats_LH_sfc, only: & + nvarmax_LH_sfc, & ! Constant(s) + stats_init_LH_sfc ! Procedure(s) + + use crmx_stats_rad_zt, only: & + nvarmax_rad_zt, & ! Constant(s) + stats_init_rad_zt ! Procedure(s) + + use crmx_stats_rad_zm, only: & + nvarmax_rad_zm, & ! Constant(s) + stats_init_rad_zm ! Procedure(s) + + use crmx_stats_sfc, only: & + nvarmax_sfc, & ! Constant(s) + stats_init_sfc ! Procedure(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Function + + use crmx_constants_clubb, only: & + fstdout, fstderr, var_length ! Constants + + use crmx_parameters_microphys, only: & + LH_microphys_disabled, & ! Constant + LH_microphys_type ! Variable + + implicit none + + ! Input Variables + + integer, intent(in) :: iunit ! File unit for fnamelist + + character(len=*), intent(in) :: & + fname_prefix, & ! Start of the stats filenames + fdir ! Directory to output to + + logical, intent(in) :: l_stats_in ! Stats on? T/F + + character(len=*), intent(in) :: & + stats_fmt_in ! Format of the stats file output + + real(kind=time_precision), intent(in) :: & + stats_tsamp_in, & ! Sampling interval [s] + stats_tout_in ! Output interval [s] + + character(len=*), intent(in) :: & + fnamelist ! Filename holding the &statsnl + + integer, intent(in) :: nzmax ! Grid points in the vertical [count] + + real( kind = core_rknd ), intent(in), dimension(nzmax) :: & + gzt, gzm ! Thermodynamic and momentum levels [m] + + integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] + + real( kind = core_rknd ), intent(in), dimension(nnrad_zt) :: grad_zt ! Radiation levels [m] + + integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] + + real( kind = core_rknd ), intent(in), dimension(nnrad_zm) :: grad_zm ! Radiation levels [m] + + integer, intent(in) :: day, month, year ! Time of year + + real( kind = core_rknd ), dimension(1), intent(in) :: & + rlat, rlon ! Latitude and Longitude [Degrees N/E] + + real(kind=time_precision), intent(in) :: & + time_current ! Model time [s] + + real(kind=time_precision), intent(in) :: & + delt ! Timestep (dt_main in CLUBB) [s] + + + ! Local Variables + logical :: l_error + + character(len=200) :: fname + + integer :: i, ntot, read_status + + ! Namelist Variables + + character(len=10) :: stats_fmt ! File storage convention + + character(len=var_length), dimension(nvarmax_zt) :: & + vars_zt ! Variables on the thermodynamic levels + + character(len=var_length), dimension(nvarmax_LH_zt) :: & + vars_LH_zt ! Latin Hypercube variables on the thermodynamic levels + + character(len=var_length), dimension(nvarmax_LH_sfc) :: & + vars_LH_sfc ! Latin Hypercube variables at the surface + + character(len=var_length), dimension(nvarmax_zm) :: & + vars_zm ! Variables on the momentum levels + + character(len=var_length), dimension(nvarmax_rad_zt) :: & + vars_rad_zt ! Variables on the radiation levels + + character(len=var_length), dimension(nvarmax_rad_zm) :: & + vars_rad_zm ! Variables on the radiation levels + + character(len=var_length), dimension(nvarmax_sfc) :: & + vars_sfc ! Variables at the model surface + + namelist /statsnl/ & + vars_zt, & + vars_zm, & + vars_LH_zt, & + vars_LH_sfc, & + vars_rad_zt, & + vars_rad_zm, & + vars_sfc + + ! ---- Begin Code ---- + + ! Initialize + l_error = .false. + + ! Set stats_variables variables with inputs from calling subroutine + l_stats = l_stats_in + + stats_tsamp = stats_tsamp_in + stats_tsamp = stats_tsamp_in + stats_tout = stats_tout_in + stats_fmt = trim( stats_fmt_in ) + + if ( .not. l_stats ) then + l_stats_samp = .false. + l_stats_last = .false. + return + end if + + ! Initialize namelist variables + + vars_zt = '' + vars_zm = '' + vars_LH_zt = '' + vars_LH_sfc = '' + vars_rad_zt = '' + vars_rad_zm = '' + vars_sfc = '' + + ! Reads list of variables that should be output to GrADS/NetCDF (namelist &statsnl) + + open(unit=iunit, file=fnamelist) + read(unit=iunit, nml=statsnl, iostat=read_status, end=100) + if ( read_status /= 0 ) then + if ( read_status > 0 ) then + write(fstderr,*) "Error reading stats namelist in file ", & + trim( fnamelist ) + else ! Read status < 0 + write(fstderr,*) "End of file marker reached while reading stats namelist in file ", & + trim( fnamelist ) + end if + write(fstderr,*) "One cause is having more statistical variables ", & + "listed in the namelist for var_zt, var_zm, or ", & + "var_sfc than allowed by nvarmax_zt, nvarmax_zm, ", & + "or nvarmax_sfc, respectively." + write(fstderr,*) "Maximum variables allowed for var_zt = ", nvarmax_zt + write(fstderr,*) "Maximum variables allowed for var_zm = ", nvarmax_zm + write(fstderr,*) "Maximum variables allowed for var_rad_zt = ", nvarmax_rad_zt + write(fstderr,*) "Maximum variables allowed for var_rad_zm = ", nvarmax_rad_zm + write(fstderr,*) "Maximum variables allowed for var_sfc = ", nvarmax_sfc + stop "stats_init: Error reading stats namelist." + end if ! read_status /= 0 + + close(unit=iunit) + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstdout,*) "--------------------------------------------------" + + write(fstdout,*) "Statistics" + + write(fstdout,*) "--------------------------------------------------" + write(fstdout,*) "vars_zt = " + i = 1 + do while ( vars_zt(i) /= '' ) + write(fstdout,*) vars_zt(i) + i = i + 1 + end do + + write(fstdout,*) "vars_zm = " + i = 1 + do while ( vars_zm(i) /= '' ) + write(fstdout,*) vars_zm(i) + i = i + 1 + end do + + if ( LH_microphys_type /= LH_microphys_disabled ) then + write(fstdout,*) "vars_LH_zt = " + i = 1 + do while ( vars_LH_zt(i) /= '' ) + write(fstdout,*) vars_LH_zt(i) + i = i + 1 + end do + + write(fstdout,*) "vars_LH_sfc = " + i = 1 + do while ( vars_LH_sfc(i) /= '' ) + write(fstdout,*) vars_LH_sfc(i) + i = i + 1 + end do + end if ! LH_microphys_type /= LH_microphys_disabled + + if ( l_output_rad_files ) then + write(fstdout,*) "vars_rad_zt = " + i = 1 + do while ( vars_rad_zt(i) /= '' ) + write(fstdout,*) vars_rad_zt(i) + i = i + 1 + end do + + write(fstdout,*) "vars_rad_zm = " + i = 1 + do while ( vars_rad_zm(i) /= '' ) + write(fstdout,*) vars_rad_zm(i) + i = i + 1 + end do + end if ! l_output_rad_files + + write(fstdout,*) "vars_sfc = " + i = 1 + do while ( vars_sfc(i) /= '' ) + write(fstdout,*) vars_sfc(i) + i = i + 1 + end do + + write(fstdout,*) "--------------------------------------------------" + end if ! clubb_at_least_debug_level 1 + + ! Determine file names for GrADS or NetCDF files + fname_zt = trim( fname_prefix )//"_zt" + fname_zm = trim( fname_prefix )//"_zm" + fname_LH_zt = trim( fname_prefix )//"_LH_zt" + fname_LH_sfc = trim( fname_prefix )//"_LH_sfc" + fname_rad_zt = trim( fname_prefix )//"_rad_zt" + fname_rad_zm = trim( fname_prefix )//"_rad_zm" + fname_sfc = trim( fname_prefix )//"_sfc" + + ! Parse the file type for stats output. Currently only GrADS and + ! netCDF > version 3.5 are supported by this code. + select case ( trim( stats_fmt ) ) + case ( "GrADS", "grads", "gr" ) + l_netcdf = .false. + l_grads = .true. + + case ( "NetCDF", "netcdf", "nc" ) + l_netcdf = .true. + l_grads = .false. + + case default + write(fstderr,*) "In module stats_subs subroutine stats_init: " + write(fstderr,*) "Invalid stats output format "//trim( stats_fmt ) + stop "Fatal error" + + end select + + ! Check sampling and output frequencies + + ! The model time step length, delt (which is dt_main), should multiply + ! evenly into the statistical sampling time step length, stats_tsamp. + if ( abs( stats_tsamp/delt - real( floor( stats_tsamp/delt ), kind=time_precision ) ) & + > 1.e-8_time_precision ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & + 'delt (which is dt_main). Check the appropriate ', & + 'model.in file.' + write(fstderr,*) 'stats_tsamp = ', stats_tsamp + write(fstderr,*) 'delt = ', delt + end if + + ! The statistical sampling time step length, stats_tsamp, should multiply + ! evenly into the statistical output time step length, stats_tout. + if ( abs( stats_tout/stats_tsamp & + - real( floor( stats_tout/stats_tsamp ), kind=time_precision ) ) & + > 1.e-8_time_precision ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tout should be an even multiple of ', & + 'stats_tsamp. Check the appropriate model.in file.' + write(fstderr,*) 'stats_tout = ', stats_tout + write(fstderr,*) 'stats_tsamp = ', stats_tsamp + end if + + ! Initialize zt (mass points) + + i = 1 + do while ( ichar(vars_zt(i)(1:1)) /= 0 & + .and. len_trim(vars_zt(i)) /= 0 & + .and. i <= nvarmax_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zt than allowed for by nvarmax_zt." + write(fstderr,*) "Check the number of variables listed for vars_zt ", & + "in the stats namelist, or change nvarmax_zt." + write(fstderr,*) "nvarmax_zt = ", nvarmax_zt + stop "stats_init: number of zt statistical variables exceeds limit" + end if + + zt%nn = ntot + zt%kk = nzmax + + allocate( zt%z( zt%kk ) ) + zt%z = gzt + + allocate( zt%x( 1, 1, zt%kk, zt%nn ) ) + allocate( zt%n( 1, 1, zt%kk, zt%nn ) ) + allocate( zt%l_in_update( 1, 1, zt%kk, zt%nn ) ) + call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) + + allocate( zt%f%var( zt%nn ) ) + allocate( zt%f%z( zt%kk ) ) + + ! Allocate scratch space + + allocate( ztscr01(zt%kk) ) + allocate( ztscr02(zt%kk) ) + allocate( ztscr03(zt%kk) ) + allocate( ztscr04(zt%kk) ) + allocate( ztscr05(zt%kk) ) + allocate( ztscr06(zt%kk) ) + allocate( ztscr07(zt%kk) ) + allocate( ztscr08(zt%kk) ) + allocate( ztscr09(zt%kk) ) + allocate( ztscr10(zt%kk) ) + allocate( ztscr11(zt%kk) ) + allocate( ztscr12(zt%kk) ) + allocate( ztscr13(zt%kk) ) + allocate( ztscr14(zt%kk) ) + allocate( ztscr15(zt%kk) ) + allocate( ztscr16(zt%kk) ) + allocate( ztscr17(zt%kk) ) + allocate( ztscr18(zt%kk) ) + allocate( ztscr19(zt%kk) ) + allocate( ztscr20(zt%kk) ) + allocate( ztscr21(zt%kk) ) + + ztscr01 = 0.0_core_rknd + ztscr02 = 0.0_core_rknd + ztscr03 = 0.0_core_rknd + ztscr04 = 0.0_core_rknd + ztscr05 = 0.0_core_rknd + ztscr06 = 0.0_core_rknd + ztscr07 = 0.0_core_rknd + ztscr08 = 0.0_core_rknd + ztscr09 = 0.0_core_rknd + ztscr10 = 0.0_core_rknd + ztscr11 = 0.0_core_rknd + ztscr12 = 0.0_core_rknd + ztscr13 = 0.0_core_rknd + ztscr14 = 0.0_core_rknd + ztscr15 = 0.0_core_rknd + ztscr16 = 0.0_core_rknd + ztscr17 = 0.0_core_rknd + ztscr18 = 0.0_core_rknd + ztscr19 = 0.0_core_rknd + ztscr20 = 0.0_core_rknd + ztscr21 = 0.0_core_rknd + + fname = trim( fname_zt ) + + if ( l_grads ) then + + ! Open GrADS file + call open_grads( iunit, fdir, fname, & + 1, zt%kk, zt%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + zt%nn, zt%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, 1, zt%kk, zt%z, & ! In + day, month, year, rlat, rlon, & ! In + time_current+stats_tout, stats_tout, zt%nn, & ! In + zt%f ) ! InOut +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + + end if + + ! Default initialization for array indices for zt + + call stats_init_zt( vars_zt, l_error ) + + + ! Setup output file for LH_zt (Latin Hypercube stats) + + if ( LH_microphys_type /= LH_microphys_disabled ) then + + i = 1 + do while ( ichar(vars_LH_zt(i)(1:1)) /= 0 & + .and. len_trim(vars_LH_zt(i)) /= 0 & + .and. i <= nvarmax_LH_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_LH_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zt than allowed for by nvarmax_LH_zt." + write(fstderr,*) "Check the number of variables listed for vars_LH_zt ", & + "in the stats namelist, or change nvarmax_LH_zt." + write(fstderr,*) "nvarmax_LH_zt = ", nvarmax_LH_zt + stop "stats_init: number of LH_zt statistical variables exceeds limit" + end if + + LH_zt%nn = ntot + LH_zt%kk = nzmax + + allocate( LH_zt%z( LH_zt%kk ) ) + LH_zt%z = gzt + + allocate( LH_zt%x( 1, 1, LH_zt%kk, LH_zt%nn ) ) + allocate( LH_zt%n( 1, 1, LH_zt%kk, LH_zt%nn ) ) + allocate( LH_zt%l_in_update( 1, 1, LH_zt%kk, LH_zt%nn ) ) + call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) + + allocate( LH_zt%f%var( LH_zt%nn ) ) + allocate( LH_zt%f%z( LH_zt%kk ) ) + + + fname = trim( fname_LH_zt ) + + if ( l_grads ) then + + ! Open GrADS file + call open_grads( iunit, fdir, fname, & + 1, LH_zt%kk, LH_zt%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + LH_zt%nn, LH_zt%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, 1, LH_zt%kk, LH_zt%z, & ! In + day, month, year, rlat, rlon, & ! In + time_current+stats_tout, stats_tout, LH_zt%nn, & ! In + LH_zt%f ) ! InOut +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + + end if + + call stats_init_LH_zt( vars_LH_zt, l_error ) + + i = 1 + do while ( ichar(vars_LH_sfc(i)(1:1)) /= 0 & + .and. len_trim(vars_LH_sfc(i)) /= 0 & + .and. i <= nvarmax_LH_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_LH_sfc ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zt than allowed for by nvarmax_LH_sfc." + write(fstderr,*) "Check the number of variables listed for vars_LH_sfc ", & + "in the stats namelist, or change nvarmax_LH_sfc." + write(fstderr,*) "nvarmax_LH_sfc = ", nvarmax_LH_sfc + stop "stats_init: number of LH_sfc statistical variables exceeds limit" + end if + + LH_sfc%nn = ntot + LH_sfc%kk = 1 + + allocate( LH_sfc%z( LH_sfc%kk ) ) + LH_sfc%z = gzm(1) + + allocate( LH_sfc%x( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + allocate( LH_sfc%n( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + allocate( LH_sfc%l_in_update( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + + call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) + + allocate( LH_sfc%f%var( LH_sfc%nn ) ) + allocate( LH_sfc%f%z( LH_sfc%kk ) ) + + fname = trim( fname_LH_sfc ) + + if ( l_grads ) then + + ! Open GrADS file + call open_grads( iunit, fdir, fname, & + 1, LH_sfc%kk, LH_sfc%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + LH_sfc%nn, LH_sfc%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, 1, LH_sfc%kk, LH_sfc%z, & ! In + day, month, year, rlat, rlon, & ! In + time_current+stats_tout, stats_tout, LH_sfc%nn, & ! In + LH_sfc%f ) ! InOut +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + + end if + + call stats_init_LH_sfc( vars_LH_sfc, l_error ) + + end if ! LH_microphys_type /= LH_microphys_disabled + + ! Initialize zm (momentum points) + + i = 1 + do while ( ichar(vars_zm(i)(1:1)) /= 0 & + .and. len_trim(vars_zm(i)) /= 0 & + .and. i <= nvarmax_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zm than allowed for by nvarmax_zm." + write(fstderr,*) "Check the number of variables listed for vars_zm ", & + "in the stats namelist, or change nvarmax_zm." + write(fstderr,*) "nvarmax_zm = ", nvarmax_zm + stop "stats_init: number of zm statistical variables exceeds limit" + end if + + zm%nn = ntot + zm%kk = nzmax + + allocate( zm%z( zm%kk ) ) + zm%z = gzm + + allocate( zm%x( 1, 1, zm%kk, zm%nn ) ) + allocate( zm%n( 1, 1, zm%kk, zm%nn ) ) + allocate( zm%l_in_update( 1, 1, zm%kk, zm%nn ) ) + + call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) + + allocate( zm%f%var( zm%nn ) ) + allocate( zm%f%z( zm%kk ) ) + + ! Allocate scratch space + + allocate( zmscr01(zm%kk) ) + allocate( zmscr02(zm%kk) ) + allocate( zmscr03(zm%kk) ) + allocate( zmscr04(zm%kk) ) + allocate( zmscr05(zm%kk) ) + allocate( zmscr06(zm%kk) ) + allocate( zmscr07(zm%kk) ) + allocate( zmscr08(zm%kk) ) + allocate( zmscr09(zm%kk) ) + allocate( zmscr10(zm%kk) ) + allocate( zmscr11(zm%kk) ) + allocate( zmscr12(zm%kk) ) + allocate( zmscr13(zm%kk) ) + allocate( zmscr14(zm%kk) ) + allocate( zmscr15(zm%kk) ) + allocate( zmscr16(zm%kk) ) + allocate( zmscr17(zm%kk) ) + + ! Initialize to 0 + zmscr01 = 0.0_core_rknd + zmscr02 = 0.0_core_rknd + zmscr03 = 0.0_core_rknd + zmscr04 = 0.0_core_rknd + zmscr05 = 0.0_core_rknd + zmscr06 = 0.0_core_rknd + zmscr07 = 0.0_core_rknd + zmscr08 = 0.0_core_rknd + zmscr09 = 0.0_core_rknd + zmscr10 = 0.0_core_rknd + zmscr11 = 0.0_core_rknd + zmscr12 = 0.0_core_rknd + zmscr13 = 0.0_core_rknd + zmscr14 = 0.0_core_rknd + zmscr15 = 0.0_core_rknd + zmscr16 = 0.0_core_rknd + zmscr17 = 0.0_core_rknd + + + fname = trim( fname_zm ) + if ( l_grads ) then + + ! Open GrADS files + call open_grads( iunit, fdir, fname, & + 1, zm%kk, zm%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + zm%nn, zm%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, 1, zm%kk, zm%z, & ! In + day, month, year, rlat, rlon, & ! In + time_current+stats_tout, stats_tout, zm%nn, & ! In + zm%f ) ! InOut + +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + end if + + call stats_init_zm( vars_zm, l_error ) + + ! Initialize rad_zt (radiation points) + + if (l_output_rad_files) then + + i = 1 + do while ( ichar(vars_rad_zt(i)(1:1)) /= 0 & + .and. len_trim(vars_rad_zt(i)) /= 0 & + .and. i <= nvarmax_rad_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_rad_zt than allowed for by nvarmax_rad_zt." + write(fstderr,*) "Check the number of variables listed for vars_rad_zt ", & + "in the stats namelist, or change nvarmax_rad_zt." + write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt + stop "stats_init: number of rad_zt statistical variables exceeds limit" + end if + + rad_zt%nn = ntot + rad_zt%kk = nnrad_zt + + allocate( rad_zt%z( rad_zt%kk ) ) + rad_zt%z = grad_zt + + allocate( rad_zt%x( 1, 1, rad_zt%kk, rad_zt%nn ) ) + allocate( rad_zt%n( 1, 1, rad_zt%kk, rad_zt%nn ) ) + allocate( rad_zt%l_in_update( 1, 1, rad_zt%kk, rad_zt%nn ) ) + + call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) + + allocate( rad_zt%f%var( rad_zt%nn ) ) + allocate( rad_zt%f%z( rad_zt%kk ) ) + + ! Allocate scratch space + + !allocate( radscr01(rad%kk) ) + !allocate( radscr02(rad%kk) ) + !allocate( radscr03(rad%kk) ) + !allocate( radscr04(rad%kk) ) + !allocate( radscr05(rad%kk) ) + !allocate( radscr06(rad%kk) ) + !allocate( radscr07(rad%kk) ) + !allocate( radscr08(rad%kk) ) + !allocate( radscr09(rad%kk) ) + !allocate( radscr10(rad%kk) ) + !allocate( radscr11(rad%kk) ) + !allocate( radscr12(rad%kk) ) + !allocate( radscr13(rad%kk) ) + !allocate( radscr14(rad%kk) ) + !allocate( radscr15(rad%kk) ) + !allocate( radscr16(rad%kk) ) + !allocate( radscr17(rad%kk) ) + + !radscr01 = 0.0_core_rknd + !radscr02 = 0.0_core_rknd + !radscr03 = 0.0_core_rknd + !radscr04 = 0.0_core_rknd + !radscr05 = 0.0_core_rknd + !radscr06 = 0.0_core_rknd + !radscr07 = 0.0_core_rknd + !radscr08 = 0.0_core_rknd + !radscr09 = 0.0_core_rknd + !radscr10 = 0.0_core_rknd + !radscr11 = 0.0_core_rknd + !radscr12 = 0.0_core_rknd + !radscr13 = 0.0_core_rknd + !radscr14 = 0.0_core_rknd + !radscr15 = 0.0_core_rknd + !radscr16 = 0.0_core_rknd + !radscr17 = 0.0_core_rknd + + + fname = trim( fname_rad_zt ) + if ( l_grads ) then + + ! Open GrADS files + call open_grads( iunit, fdir, fname, & + 1, rad_zt%kk, rad_zt%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + rad_zt%nn, rad_zt%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, & + 1, rad_zt%kk, rad_zt%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + rad_zt%nn, rad_zt%f ) + +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + end if + + call stats_init_rad_zt( vars_rad_zt, l_error ) + + ! Initialize rad_zm (radiation points) + + i = 1 + do while ( ichar(vars_rad_zm(i)(1:1)) /= 0 & + .and. len_trim(vars_rad_zm(i)) /= 0 & + .and. i <= nvarmax_rad_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_rad_zm than allowed for by nvarmax_rad_zm." + write(fstderr,*) "Check the number of variables listed for vars_rad_zm ", & + "in the stats namelist, or change nvarmax_rad_zm." + write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm + stop "stats_init: number of rad_zm statistical variables exceeds limit" + end if + + rad_zm%nn = ntot + rad_zm%kk = nnrad_zm + + allocate( rad_zm%z( rad_zm%kk ) ) + rad_zm%z = grad_zm + + allocate( rad_zm%x( 1, 1, rad_zm%kk, rad_zm%nn ) ) + allocate( rad_zm%n( 1, 1, rad_zm%kk, rad_zm%nn ) ) + allocate( rad_zm%l_in_update( 1, 1, rad_zm%kk, rad_zm%nn ) ) + + call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) + + allocate( rad_zm%f%var( rad_zm%nn ) ) + allocate( rad_zm%f%z( rad_zm%kk ) ) + + ! Allocate scratch space + + !allocate( radscr01(rad%kk) ) + !allocate( radscr02(rad%kk) ) + !allocate( radscr03(rad%kk) ) + !allocate( radscr04(rad%kk) ) + !allocate( radscr05(rad%kk) ) + !allocate( radscr06(rad%kk) ) + !allocate( radscr07(rad%kk) ) + !allocate( radscr08(rad%kk) ) + !allocate( radscr09(rad%kk) ) + !allocate( radscr10(rad%kk) ) + !allocate( radscr11(rad%kk) ) + !allocate( radscr12(rad%kk) ) + !allocate( radscr13(rad%kk) ) + !allocate( radscr14(rad%kk) ) + !allocate( radscr15(rad%kk) ) + !allocate( radscr16(rad%kk) ) + !allocate( radscr17(rad%kk) ) + + !radscr01 = 0.0_core_rknd + !radscr02 = 0.0_core_rknd + !radscr03 = 0.0_core_rknd + !radscr04 = 0.0_core_rknd + !radscr05 = 0.0_core_rknd + !radscr06 = 0.0_core_rknd + !radscr07 = 0.0_core_rknd + !radscr08 = 0.0_core_rknd + !radscr09 = 0.0_core_rknd + !radscr10 = 0.0_core_rknd + !radscr11 = 0.0_core_rknd + !radscr12 = 0.0_core_rknd + !radscr13 = 0.0_core_rknd + !radscr14 = 0.0_core_rknd + !radscr15 = 0.0_core_rknd + !radscr16 = 0.0_core_rknd + !radscr17 = 0.0_core_rknd + + + fname = trim( fname_rad_zm ) + if ( l_grads ) then + + ! Open GrADS files + call open_grads( iunit, fdir, fname, & + 1, rad_zm%kk, rad_zm%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + rad_zm%nn, rad_zm%f ) + + else ! Open NetCDF file +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, & + 1, rad_zm%kk, rad_zm%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + rad_zm%nn, rad_zm%f ) + +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + end if + + call stats_init_rad_zm( vars_rad_zm, l_error ) + end if ! l_output_rad_files + + + ! Initialize sfc (surface point) + + i = 1 + do while ( ichar(vars_sfc(i)(1:1)) /= 0 & + .and. len_trim(vars_sfc(i)) /= 0 & + .and. i <= nvarmax_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_sfc ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_sfc than allowed for by nvarmax_sfc." + write(fstderr,*) "Check the number of variables listed for vars_sfc ", & + "in the stats namelist, or change nvarmax_sfc." + write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc + stop "stats_init: number of sfc statistical variables exceeds limit" + end if + + sfc%nn = ntot + sfc%kk = 1 + + allocate( sfc%z( sfc%kk ) ) + sfc%z = gzm(1) + + allocate( sfc%x( 1, 1, sfc%kk, sfc%nn ) ) + allocate( sfc%n( 1, 1, sfc%kk, sfc%nn ) ) + allocate( sfc%l_in_update( 1, 1, sfc%kk, sfc%nn ) ) + + call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) + + allocate( sfc%f%var( sfc%nn ) ) + allocate( sfc%f%z( sfc%kk ) ) + + fname = trim( fname_sfc ) + + if ( l_grads ) then + + ! Open GrADS files + call open_grads( iunit, fdir, fname, & + 1, sfc%kk, sfc%z, & + day, month, year, rlat, rlon, & + time_current+stats_tout, stats_tout, & + sfc%nn, sfc%f ) + + else ! Open NetCDF files +#ifdef NETCDF + call open_netcdf( 1, 1, fdir, fname, 1, sfc%kk, sfc%z, & ! In + day, month, year, rlat, rlon, & ! In + time_current+stats_tout, stats_tout, sfc%nn, & ! In + sfc%f ) ! InOut + +#else + stop "This CLUBB program was not compiled with netCDF support." +#endif + end if + + call stats_init_sfc( vars_sfc, l_error ) + + ! Check for errors + + if ( l_error ) then + write(fstderr,*) 'stats_init: errors found' + stop "Fatal error" + endif + + return + + ! If namelist was not found in input file, turn off statistics + + 100 continue + write(fstderr,*) 'Error with statsnl, statistics is turned off' + l_stats = .false. + l_stats_samp = .false. + l_stats_last = .false. + + return + end subroutine stats_init + !----------------------------------------------------------------------- + subroutine stats_zero( kk, nn, x, n, l_in_update ) + + ! Description: + ! Initialize stats to zero + ! References: + ! None + !----------------------------------------------------------------------- + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + implicit none + + ! Input Variable(s) + integer, intent(in) :: kk, nn + + ! Output Variable(s) + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n + logical, dimension(1,1,kk,nn), intent(out) :: l_in_update + + ! Zero out arrays + + if ( nn > 0 ) then + x(:,:,:,:) = 0.0_stat_rknd + n(:,:,:,:) = 0_stat_nknd + l_in_update(:,:,:,:) = .false. + end if + + return + end subroutine stats_zero + + !----------------------------------------------------------------------- + subroutine stats_avg( kk, nn, x, n ) + + ! Description: + ! Compute the average of stats fields + ! References: + ! None + !----------------------------------------------------------------------- + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + implicit none + + ! External + intrinsic :: real + + ! Input Variable(s) + integer, intent(in) :: & + kk, & ! Number of levels in vertical (i.e. Z) dimension + nn ! Number of variables being sampled in x + + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: & + n ! The variable n is the number of samples per x per kk + + ! Output Variable(s) + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: & + x ! The variable x is a set of nn variables being averaged over n + + ! ---- Begin Code ---- + + ! Compute averages + where ( n(1,1,1:kk,1:nn) > 0 ) + x(1,1,1:kk,1:nn) = x(1,1,1:kk,1:nn) / real( n(1,1,1:kk,1:nn), kind=stat_rknd ) + end where + + return + end subroutine stats_avg + + !----------------------------------------------------------------------- + subroutine stats_begin_timestep( time_elapsed ) + + ! Description: + ! Given the elapsed time, set flags determining specifics such as + ! if this time set should be sampled or if this is the first or + ! last time step. + !----------------------------------------------------------------------- + + use crmx_stats_variables, only: & + l_stats, & ! Variable(s) + l_stats_samp, & + l_stats_last, & + stats_tsamp, & + stats_tout + + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + implicit none + + ! External + intrinsic :: mod + + ! Input Variable(s) + real(kind=time_precision), intent(in) :: & + time_elapsed ! Elapsed model time [s] + + if ( .not. l_stats ) return + + ! Only sample time steps that are multiples of "stats_tsamp" + ! in a case's "model.in" file to shorten length of run + if ( mod( time_elapsed, stats_tsamp ) < 1.e-8_time_precision ) then + l_stats_samp = .true. + else + l_stats_samp = .false. + end if + + ! Indicates the end of the sampling time period. Signals to start writing to the file + if ( mod( time_elapsed, stats_tout ) < 1.e-8_time_precision ) then + l_stats_last = .true. + else + l_stats_last = .false. + end if + + return + + end subroutine stats_begin_timestep + + !----------------------------------------------------------------------- + subroutine stats_end_timestep( ) + + ! Description: + ! Called when the stats timestep has ended. This subroutine + ! is responsible for calling statistics to be written to the output + ! format. + ! + ! References: + ! None + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + LH_zt, & + LH_sfc, & + zm, & + rad_zt, & + rad_zm, & + sfc, & + l_stats_last, & + stats_tsamp, & + stats_tout, & + l_output_rad_files, & + l_grads + + use crmx_clubb_precision, only: & + time_precision ! Variable(s) + + use crmx_output_grads, only: & + write_grads ! Procedure(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Procedure(s) + + use crmx_parameters_microphys, only: & + LH_microphys_disabled ! Constant + + use crmx_parameters_microphys, only: & + LH_microphys_type, & ! Variable(s) + LH_microphys_calls + +#ifdef NETCDF + use crmx_output_netcdf, only: & + write_netcdf ! Procedure(s) +#endif + + implicit none + + ! External + intrinsic :: floor + + ! Local Variables + + integer :: i, k + + logical :: l_error + + ! ---- Begin Code ---- + + ! Check if it is time to write to file + + if ( .not. l_stats_last ) return + + ! Initialize + l_error = .false. + + ! Look for errors by checking the number of sampling points + ! for each variable in the zt statistics at each vertical level. + do i = 1, zt%nn + do k = 1, zt%kk + + if ( zt%n(1,1,k,i) /= 0 .and. & + zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(zt%f%var(i)%name), ' in zt ', & + 'at k = ', k, & + '; zt%n(',k,',',i,') = ', zt%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= stats_tout/stats_tsamp + + end do ! k = 1 .. zt%kk + end do ! i = 1 .. zt%nn + + ! Look for errors by checking the number of sampling points + ! for each variable in the zm statistics at each vertical level. + do i = 1, zm%nn + do k = 1, zm%kk + + if ( zm%n(1,1,k,i) /= 0 .and. & + zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(zm%f%var(i)%name), ' in zm ', & + 'at k = ', k, & + '; zm%n(',k,',',i,') = ', zm%n(1,1,k,i) + end if ! clubb_at_least_debug_level 1 + + end if ! n /= 0 and n /= stats_tout/stats_tsamp + + end do ! k = 1 .. zm%kk + end do ! i = 1 .. zm%nn + + if ( LH_microphys_type /= LH_microphys_disabled ) then + ! Look for errors by checking the number of sampling points + ! for each variable in the LH_zt statistics at each vertical level. + do i = 1, LH_zt%nn + do k = 1, LH_zt%kk + + if ( LH_zt%n(1,1,k,i) /= 0 .and. & + LH_zt%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & + LH_zt%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(LH_zt%f%var(i)%name), ' in LH_zt ', & + 'at k = ', k, & + '; LH_zt%n(',k,',',i,') = ', LH_zt%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp + + end do ! k = 1 .. LH_zt%kk + end do ! i = 1 .. LH_zt%nn + + ! Look for errors by checking the number of sampling points + ! for each variable in the LH_zt statistics at each vertical level. + do i = 1, LH_sfc%nn + do k = 1, LH_sfc%kk + + if ( LH_sfc%n(1,1,k,i) /= 0 .and. & + LH_sfc%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & + LH_sfc%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(LH_sfc%f%var(i)%name), ' in LH_sfc ', & + 'at k = ', k, & + '; LH_sfc%n(',k,',',i,') = ', LH_sfc%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp + + end do ! k = 1 .. LH_sfc%kk + end do ! i = 1 .. LH_sfc%nn + end if ! LH_microphys_type /= LH_microphys_disabled + + + if ( l_output_rad_files ) then + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zt statistics at each vertical level. + do i = 1, rad_zt%nn + do k = 1, rad_zt%kk + + if ( rad_zt%n(1,1,k,i) /= 0 .and. & + rad_zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(rad_zt%f%var(i)%name), ' in rad_zt ', & + 'at k = ', k, & + '; rad_zt%n(',k,',',i,') = ', rad_zt%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= stats_tout/stats_tsamp + + end do ! k = 1 .. rad_zt%kk + end do ! i = 1 .. rad_zt%nn + + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zm statistics at each vertical level. + do i = 1, rad_zm%nn + do k = 1, rad_zm%kk + + if ( rad_zm%n(1,1,k,i) /= 0 .and. & + rad_zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(rad_zm%f%var(i)%name), ' in rad_zm ', & + 'at k = ', k, & + '; rad_zm%n(',k,',',i,') = ', rad_zm%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= stats_tout/stats_tsamp + + end do ! k = 1 .. rad_zm%kk + end do ! i = 1 .. rad_zm%nn + + end if ! l_output_rad_files + + ! Look for errors by checking the number of sampling points + ! for each variable in the sfc statistics at each vertical level. + do i = 1, sfc%nn + do k = 1, sfc%kk + + if ( sfc%n(1,1,k,i) /= 0 .and. & + sfc%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(sfc%f%var(i)%name), ' in sfc ', & + 'at k = ', k, & + '; sfc%n(',k,',',i,') = ', sfc%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= stats_tout/stats_tsamp + + end do ! k = 1 .. sfc%kk + end do ! i = 1 .. sfc%nn + + ! Stop the run if errors are found. + if ( l_error ) then + write(fstderr,*) 'Possible statistical sampling error' + write(fstderr,*) 'For details, set debug_level to a value of at ', & + 'least 1 in the appropriate model.in file.' + stop 'stats_end_timestep: error(s) found' + end if ! l_error + + ! Compute averages + call stats_avg( zt%kk, zt%nn, zt%x, zt%n ) + call stats_avg( zm%kk, zm%nn, zm%x, zm%n ) + if ( LH_microphys_type /= LH_microphys_disabled ) then + call stats_avg( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n ) + call stats_avg( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n ) + end if + if ( l_output_rad_files ) then + call stats_avg( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n ) + call stats_avg( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n ) + end if + call stats_avg( sfc%kk, sfc%nn, sfc%x, sfc%n ) + + ! Write to file + if ( l_grads ) then + call write_grads( zt%f ) + call write_grads( zm%f ) + if ( LH_microphys_type /= LH_microphys_disabled ) then + call write_grads( LH_zt%f ) + call write_grads( LH_sfc%f ) + end if + if ( l_output_rad_files ) then + call write_grads( rad_zt%f ) + call write_grads( rad_zm%f ) + end if + call write_grads( sfc%f ) + else ! l_netcdf +#ifdef NETCDF + call write_netcdf( zt%f ) + call write_netcdf( zm%f ) + if ( LH_microphys_type /= LH_microphys_disabled ) then + call write_netcdf( LH_zt%f ) + call write_netcdf( LH_sfc%f ) + end if + if ( l_output_rad_files ) then + call write_netcdf( rad_zt%f ) + call write_netcdf( rad_zm%f ) + end if + call write_netcdf( sfc%f ) +#else + stop "This program was not compiled with netCDF support" +#endif /* NETCDF */ + end if ! l_grads + + ! Reset sample fields + call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) + call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) + if ( LH_microphys_type /= LH_microphys_disabled ) then + call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) + call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) + end if + if ( l_output_rad_files ) then + call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) + call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) + end if + call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) + + + return + end subroutine stats_end_timestep + + !---------------------------------------------------------------------- + subroutine stats_accumulate & + ( um, vm, upwp, vpwp, up2, vp2, & + thlm, rtm, wprtp, wpthlp, & + wp2, wp3, rtp2, thlp2, rtpthlp, & + p_in_Pa, exner, rho, rho_zm, & + rho_ds_zm, rho_ds_zt, thv_ds_zm, & + thv_ds_zt, wm_zt, wm_zm, rcm, wprcp, rc_coef, & + rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac, & + cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, & + cloud_cover, sigma_sqd_w, pdf_params, & + sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & + wpsclrp, edsclrm, edsclrm_forcing ) + + ! Description: + ! Accumulate those stats variables that are preserved in CLUBB from timestep to + ! timestep, but not those stats that are not, (e.g. budget terms, longwave and + ! shortwave components, etc.) + ! + ! References: + ! None + !---------------------------------------------------------------------- + + use crmx_stats_variables, only: & + zt, & ! Variables + zm, & + sfc, & + l_stats_samp, & + ithlm, & + iT_in_K, & + ithvm, & + irtm, & + ircm, & + ium, & + ivm, & + iwm_zt, & + iwm_zm, & + iug, & + ivg, & + icloud_frac, & + iice_supersat_frac, & + ircm_in_layer, & + icloud_cover + + use crmx_stats_variables, only: & + ip_in_Pa, & + iexner, & + irho_ds_zt, & + ithv_ds_zt, & + iLscale, & + iwp3, & + iwp3_zm, & + iwpthlp2, & + iwp2thlp, & + iwprtp2, & + iwp2rtp, & + iLscale_up, & + iLscale_down, & + itau_zt, & + iKh_zt + + use crmx_stats_variables, only: & + iwp2thvp, & ! Variable(s) + iwp2rcp, & + iwprtpthlp, & + isigma_sqd_w_zt, & + irho, & + irsat, & + irsati + + use crmx_stats_variables, only: & + imixt_frac, & ! Variable(s) + iw1, & + iw2, & + ivarnce_w1, & + ivarnce_w2, & + ithl1, & + ithl2, & + ivarnce_thl1, & + ivarnce_thl2, & + irt1, & + irt2, & + ivarnce_rt1, & + ivarnce_rt2, & + irc1, & + irc2, & + irsl1, & + irsl2, & + icloud_frac1, & + icloud_frac2 + + use crmx_stats_variables, only: & + is1, & + is2, & + istdev_s1, & + istdev_s2, & + istdev_t1, & + istdev_t2, & + icovar_st_1, & + icovar_st_2, & + icorr_st_1, & + icorr_st_2, & + icrt1, & + icrt2, & + icthl1, & + icthl2, & + irrtthl, & + is_mellor + + use crmx_stats_variables, only: & + iwp2_zt, & ! Variable(s) + ithlp2_zt, & + iwpthlp_zt, & + iwprtp_zt, & + irtp2_zt, & + irtpthlp_zt, & + iup2_zt, & + ivp2_zt, & + iupwp_zt, & + ivpwp_zt, & + iwp2, & + irtp2, & + ithlp2, & + irtpthlp, & + iwprtp, & + iwpthlp, & + iwp4, & + iwpthvp, & + irtpthvp + + use crmx_stats_variables, only: & + ithlpthvp, & + itau_zm, & + iKh_zm, & + iwprcp, & + irc_coef, & + ithlprcp, & + irtprcp, & + ircp2, & + iupwp, & + ivpwp, & + iup2, & + ivp2, & + irho_zm, & + isigma_sqd_w, & + irho_ds_zm, & + ithv_ds_zm, & + iem + + use crmx_stats_variables, only: & + ishear, & ! Variable(s) + iFrad, & + icc, & + iz_cloud_base, & + ilwp, & + ivwp, & + ithlm_vert_avg, & + irtm_vert_avg, & + ium_vert_avg, & + ivm_vert_avg, & + iwp2_vert_avg, & + iup2_vert_avg, & + ivp2_vert_avg, & + irtp2_vert_avg, & + ithlp2_vert_avg + + use crmx_stats_variables, only: & + isclrm, & ! Variable(s) + isclrm_f, & + iedsclrm, & + iedsclrm_f, & + isclrprtp, & + isclrp2, & + isclrpthvp, & + isclrpthlp, & + isclrprcp, & + iwpsclrp, & + iwp2sclrp, & + iwpsclrp2, & + iwpsclrprtp, & + iwpsclrpthlp, & + iwpedsclrp + + use crmx_stats_variables, only: & + icloud_frac_zm, & + iice_supersat_frac_zm, & + ircm_zm, & + irtm_zm, & + ithlm_zm + + use crmx_stats_variables, only: & + iwp3_on_wp2, & + iwp3_on_wp2_zt, & + iSkw_velocity + + use crmx_stats_variables, only: & + ia3_coef, & ! Variables + ia3_coef_zt + + use crmx_grid_class, only: & + gr ! Variable + + use crmx_grid_class, only: & + zt2zm ! Procedure(s) + + use crmx_variables_diagnostic_module, only: & + thvm, & ! Variable(s) + ug, & + vg, & + Lscale, & + wpthlp2, & + wp2thlp, & + wprtp2, & + wp2rtp, & + Lscale_up, & + Lscale_down, & + tau_zt, & + Kh_zt, & + wp2thvp, & + wp2rcp, & + wprtpthlp, & + sigma_sqd_w_zt, & + rsat + + use crmx_variables_diagnostic_module, only: & + wp2_zt, & ! Variable(s) + thlp2_zt, & + wpthlp_zt, & + wprtp_zt, & + rtp2_zt, & + rtpthlp_zt, & + up2_zt, & + vp2_zt, & + upwp_zt, & + vpwp_zt, & + wp4, & + rtpthvp, & + thlpthvp, & + wpthvp, & + tau_zm, & + Kh_zm, & + thlprcp, & + rtprcp, & + rcp2, & + em, & + Frad, & + sclrpthvp, & + sclrprcp, & + wp2sclrp, & + wpsclrp2, & + wpsclrprtp, & + wpsclrpthlp, & + wpedsclrp + + use crmx_variables_diagnostic_module, only: & + a3_coef, & ! Variable(s) + a3_coef_zt, & + wp3_zm, & + wp3_on_wp2, & + wp3_on_wp2_zt, & + Skw_velocity + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Type + + use crmx_T_in_K_module, only: & + thlm2T_in_K ! Procedure + + use crmx_constants_clubb, only: & + rc_tol, & ! Constant(s) + w_tol_sqd + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + edsclr_dim + + use crmx_stats_type, only: & + stat_update_var, & ! Procedure(s) + stat_update_var_pt + + use crmx_fill_holes, only: & + vertical_avg, & ! Procedure(s) + vertical_integral + + use crmx_interpolation, only: & + lin_int ! Procedure + + use crmx_saturation, only: & + sat_mixrat_ice ! Procedure + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variable(s) + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + um, & ! u wind [m/s] + vm, & ! v wind [m/s] + upwp, & ! vertical u momentum flux [m^2/s^2] + vpwp, & ! vertical v momentum flux [m^2/s^2] + up2, & ! u'^2 [m^2/s^2] + vp2, & ! v'^2 [m^2/s^2] + thlm, & ! liquid potential temperature [K] + rtm, & ! total water mixing ratio [kg/kg] + wprtp, & ! w'rt' [(kg/kg) m/s] + wpthlp, & ! w'thl' [m K /s] + wp2, & ! w'^2 [m^2/s^2] + wp3, & ! w'^3 [m^3/s^3] + rtp2, & ! rt'^2 [(kg/kg)^2] + thlp2, & ! thl'^2 [K^2] + rtpthlp ! rt'thl' [kg/kg K] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + p_in_Pa, & ! Pressure (Pa) on thermodynamic points [Pa] + exner, & ! Exner function = ( p / p0 ) ** kappa [-] + rho, & ! Density [kg/m^3] + rho_zm, & ! Density [kg/m^3] + rho_ds_zm, & ! Dry, static density (momentum levels) [kg/m^3] + rho_ds_zt, & ! Dry, static density (thermo. levs.) [kg/m^3] + thv_ds_zm, & ! Dry, base-state theta_v (momentum levs.) [K] + thv_ds_zt, & ! Dry, base-state theta_v (thermo. levs.) [K] + wm_zt, & ! w on thermodynamic levels [m/s] + wm_zm ! w on momentum levels [m/s] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + rcm_zm, & ! Total water mixing ratio [kg/kg] + rtm_zm, & ! Total water mixing ratio [kg/kg] + thlm_zm, & ! Liquid potential temperature [K] + rcm, & ! Cloud water mixing ratio [kg/kg] + wprcp, & ! w'rc' [(kg/kg) m/s] + rc_coef, & ! Coefficient of X' R_l' in Eq. (34) [-] + cloud_frac, & ! Cloud fraction [-] + ice_supersat_frac, & ! Ice cloud fracion [-] + cloud_frac_zm, & ! Cloud fraction on zm levels [-] + ice_supersat_frac_zm, & ! Ice cloud fraction on zm levels [-] + rcm_in_layer, & ! Cloud water mixing ratio in cloud layer [kg/kg] + cloud_cover ! Cloud cover [-] + + real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & + sigma_sqd_w ! PDF width parameter (momentum levels) [-] + + type(pdf_parameter), dimension(gr%nz), intent(in) :: & + pdf_params ! PDF parameters [units vary] + + real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & + sclrm, & ! High-order passive scalar [units vary] + sclrp2, & ! High-order passive scalar variance [units^2] + sclrprtp, & ! High-order passive scalar covariance [units kg/kg] + sclrpthlp, & ! High-order passive scalar covariance [units K] + sclrm_forcing, & ! Large-scale forcing of scalar [units/s] + wpsclrp ! w'sclr' [units m/s] + + real( kind = core_rknd ), intent(in), dimension(gr%nz,edsclr_dim) :: & + edsclrm, & ! Eddy-diff passive scalar [units vary] + edsclrm_forcing ! Large-scale forcing of edscalar [units vary] + + ! Local Variables + + integer :: i, k + + real( kind = core_rknd ), dimension(gr%nz) :: & + T_in_K, & ! Absolute temperature [K] + rsati, & ! Saturation w.r.t ice [kg/kg] + shear, & ! Wind shear production term [m^2/s^3] + s_mellor ! Mellor's 's' [kg/kg] + + real( kind = core_rknd ) :: xtmp + + ! ---- Begin Code ---- + + ! Sample fields + + if ( l_stats_samp ) then + + ! zt variables + + + if ( iT_in_K > 0 .or. irsati > 0 ) then + T_in_K = thlm2T_in_K( thlm, exner, rcm ) + else + T_in_K = -999._core_rknd + end if + + call stat_update_var( iT_in_K, T_in_K, zt ) + + call stat_update_var( ithlm, thlm, zt ) + call stat_update_var( ithvm, thvm, zt ) + call stat_update_var( irtm, rtm, zt ) + call stat_update_var( ircm, rcm, zt ) + call stat_update_var( ium, um, zt ) + call stat_update_var( ivm, vm, zt ) + call stat_update_var( iwm_zt, wm_zt, zt ) + call stat_update_var( iwm_zm, wm_zm, zm ) + call stat_update_var( iug, ug, zt ) + call stat_update_var( ivg, vg, zt ) + call stat_update_var( icloud_frac, cloud_frac, zt ) + call stat_update_var( iice_supersat_frac, ice_supersat_frac, zt) + call stat_update_var( ircm_in_layer, rcm_in_layer, zt ) + call stat_update_var( icloud_cover, cloud_cover, zt ) + call stat_update_var( ip_in_Pa, p_in_Pa, zt ) + call stat_update_var( iexner, exner, zt ) + call stat_update_var( irho_ds_zt, rho_ds_zt, zt ) + call stat_update_var( ithv_ds_zt, thv_ds_zt, zt ) + call stat_update_var( iLscale, Lscale, zt ) + call stat_update_var( iwp3, wp3, zt ) + call stat_update_var( iwpthlp2, wpthlp2, zt ) + call stat_update_var( iwp2thlp, wp2thlp, zt ) + call stat_update_var( iwprtp2, wprtp2, zt ) + call stat_update_var( iwp2rtp, wp2rtp, zt ) + call stat_update_var( iLscale_up, Lscale_up, zt ) + call stat_update_var( iLscale_down, Lscale_down, zt ) + call stat_update_var( itau_zt, tau_zt, zt ) + call stat_update_var( iKh_zt, Kh_zt, zt ) + call stat_update_var( iwp2thvp, wp2thvp, zt ) + call stat_update_var( iwp2rcp, wp2rcp, zt ) + call stat_update_var( iwprtpthlp, wprtpthlp, zt ) + call stat_update_var( isigma_sqd_w_zt, sigma_sqd_w_zt, zt ) + call stat_update_var( irho, rho, zt ) + call stat_update_var( irsat, rsat, zt ) + if ( irsati > 0 ) then + rsati = sat_mixrat_ice( p_in_Pa, T_in_K ) + call stat_update_var( irsati, rsati, zt ) + end if + + call stat_update_var( imixt_frac, pdf_params%mixt_frac, zt ) + call stat_update_var( iw1, pdf_params%w1, zt ) + call stat_update_var( iw2, pdf_params%w2, zt ) + call stat_update_var( ivarnce_w1, pdf_params%varnce_w1, zt ) + call stat_update_var( ivarnce_w2, pdf_params%varnce_w2, zt ) + call stat_update_var( ithl1, pdf_params%thl1, zt ) + call stat_update_var( ithl2, pdf_params%thl2, zt ) + call stat_update_var( ivarnce_thl1, pdf_params%varnce_thl1, zt ) + call stat_update_var( ivarnce_thl2, pdf_params%varnce_thl2, zt ) + call stat_update_var( irt1, pdf_params%rt1, zt ) + call stat_update_var( irt2, pdf_params%rt2, zt ) + call stat_update_var( ivarnce_rt1, pdf_params%varnce_rt1, zt ) + call stat_update_var( ivarnce_rt2, pdf_params%varnce_rt2, zt ) + call stat_update_var( irc1, pdf_params%rc1, zt ) + call stat_update_var( irc2, pdf_params%rc2, zt ) + call stat_update_var( irsl1, pdf_params%rsl1, zt ) + call stat_update_var( irsl2, pdf_params%rsl2, zt ) + call stat_update_var( icloud_frac1, pdf_params%cloud_frac1, zt ) + call stat_update_var( icloud_frac2, pdf_params%cloud_frac2, zt ) + call stat_update_var( is1, pdf_params%s1, zt ) + call stat_update_var( is2, pdf_params%s2, zt ) + call stat_update_var( istdev_s1, pdf_params%stdev_s1, zt ) + call stat_update_var( istdev_s2, pdf_params%stdev_s2, zt ) + call stat_update_var( istdev_t1, pdf_params%stdev_t1, zt ) + call stat_update_var( istdev_t2, pdf_params%stdev_t2, zt ) + call stat_update_var( icovar_st_1, pdf_params%covar_st_1, zt ) + call stat_update_var( icovar_st_2, pdf_params%covar_st_2, zt ) + call stat_update_var( icorr_st_1, pdf_params%corr_st_1, zt ) + call stat_update_var( icorr_st_2, pdf_params%corr_st_2, zt ) + call stat_update_var( irrtthl, pdf_params%rrtthl, zt ) + call stat_update_var( icrt1, pdf_params%crt1, zt ) + call stat_update_var( icrt2, pdf_params%crt2, zt ) + call stat_update_var( icthl1, pdf_params%cthl1, zt ) + call stat_update_var( icthl2, pdf_params%cthl2, zt ) + call stat_update_var( iwp2_zt, wp2_zt, zt ) + call stat_update_var( ithlp2_zt, thlp2_zt, zt ) + call stat_update_var( iwpthlp_zt, wpthlp_zt, zt ) + call stat_update_var( iwprtp_zt, wprtp_zt, zt ) + call stat_update_var( irtp2_zt, rtp2_zt, zt ) + call stat_update_var( irtpthlp_zt, rtpthlp_zt, zt ) + call stat_update_var( iup2_zt, up2_zt, zt ) + call stat_update_var( ivp2_zt, vp2_zt, zt ) + call stat_update_var( iupwp_zt, upwp_zt, zt ) + call stat_update_var( ivpwp_zt, vpwp_zt, zt ) + call stat_update_var( ia3_coef_zt, a3_coef_zt, zt ) + call stat_update_var( iwp3_on_wp2_zt, wp3_on_wp2_zt, zt ) + + if ( is_mellor > 0 ) then + ! Determine 's' from Mellor (1977) (extended liquid water) + s_mellor(:) = pdf_params%mixt_frac * pdf_params%s1 & + + (1.0_core_rknd-pdf_params%mixt_frac) * pdf_params%s2 + call stat_update_var( is_mellor, s_mellor, zt ) + end if + + if ( sclr_dim > 0 ) then + do i=1, sclr_dim + call stat_update_var( isclrm(i), sclrm(:,i), zt ) + call stat_update_var( isclrm_f(i), sclrm_forcing(:,i), zt ) + end do + end if + + if ( edsclr_dim > 0 ) then + do i=1, edsclr_dim + call stat_update_var( iedsclrm(i), edsclrm(:,i), zt ) + call stat_update_var( iedsclrm_f(i), edsclrm_forcing(:,i), zt ) + end do + end if + + ! zm variables + + call stat_update_var( iwp2, wp2, zm ) + call stat_update_var( iwp3_zm, wp3_zm, zm ) + call stat_update_var( irtp2, rtp2, zm ) + call stat_update_var( ithlp2, thlp2, zm ) + call stat_update_var( irtpthlp, rtpthlp, zm ) + call stat_update_var( iwprtp, wprtp, zm ) + call stat_update_var( iwpthlp, wpthlp, zm ) + call stat_update_var( iwp4, wp4, zm ) + call stat_update_var( iwpthvp, wpthvp, zm ) + call stat_update_var( irtpthvp, rtpthvp, zm ) + call stat_update_var( ithlpthvp, thlpthvp, zm ) + call stat_update_var( itau_zm, tau_zm, zm ) + call stat_update_var( iKh_zm, Kh_zm, zm ) + call stat_update_var( iwprcp, wprcp, zm ) + call stat_update_var( irc_coef, rc_coef, zm ) + call stat_update_var( ithlprcp, thlprcp, zm ) + call stat_update_var( irtprcp, rtprcp, zm ) + call stat_update_var( ircp2, rcp2, zm ) + call stat_update_var( iupwp, upwp, zm ) + call stat_update_var( ivpwp, vpwp, zm ) + call stat_update_var( ivp2, vp2, zm ) + call stat_update_var( iup2, up2, zm ) + call stat_update_var( irho_zm, rho_zm, zm ) + call stat_update_var( isigma_sqd_w, sigma_sqd_w, zm ) + call stat_update_var( irho_ds_zm, rho_ds_zm, zm ) + call stat_update_var( ithv_ds_zm, thv_ds_zm, zm ) + call stat_update_var( iem, em, zm ) + call stat_update_var( iFrad, Frad, zm ) + + call stat_update_var( iSkw_velocity, Skw_velocity, zm ) + call stat_update_var( ia3_coef, a3_coef, zm ) + call stat_update_var( iwp3_on_wp2, wp3_on_wp2, zm ) + + call stat_update_var( icloud_frac_zm, cloud_frac_zm, zm ) + call stat_update_var( iice_supersat_frac_zm, ice_supersat_frac_zm, zm ) + call stat_update_var( ircm_zm, rcm_zm, zm ) + call stat_update_var( irtm_zm, rtm_zm, zm ) + call stat_update_var( ithlm_zm, thlm_zm, zm ) + + if ( sclr_dim > 0 ) then + do i=1, sclr_dim + call stat_update_var( isclrp2(i), sclrp2(:,i), zm ) + call stat_update_var( isclrprtp(i), sclrprtp(:,i), zm ) + call stat_update_var( isclrpthvp(i), sclrpthvp(:,i), zm ) + call stat_update_var( isclrpthlp(i), sclrpthlp(:,i), zm ) + call stat_update_var( isclrprcp(i), sclrprcp(:,i), zm ) + call stat_update_var( iwpsclrp(i), wpsclrp(:,i), zm ) + call stat_update_var( iwp2sclrp(i), wp2sclrp(:,i), zm ) + call stat_update_var( iwpsclrp2(i), wpsclrp2(:,i), zm ) + call stat_update_var( iwpsclrprtp(i), wpsclrprtp(:,i), zm ) + call stat_update_var( iwpsclrpthlp(i), wpsclrpthlp(:,i), zm ) + end do + end if + if ( edsclr_dim > 0 ) then + do i=1, edsclr_dim + call stat_update_var( iwpedsclrp(i), wpedsclrp(:,i), zm ) + end do + end if + + ! Calculate shear production + if ( ishear > 0 ) then + do k = 1, gr%nz-1, 1 + shear(k) = - upwp(k) * ( um(k+1) - um(k) ) * gr%invrs_dzm(k) & + - vpwp(k) * ( vm(k+1) - vm(k) ) * gr%invrs_dzm(k) + enddo + shear(gr%nz) = 0.0_core_rknd + end if + call stat_update_var( ishear, shear, zm ) + + ! sfc variables + + ! Cloud cover + call stat_update_var_pt( icc, 1, maxval( cloud_frac(1:gr%nz) ), sfc ) + + ! Cloud base + if ( iz_cloud_base > 0 ) then + + k = 1 + do while ( rcm(k) < rc_tol .and. k < gr%nz ) + k = k + 1 + enddo + + if ( k > 1 .and. k < gr%nz) then + + ! Use linear interpolation to find the exact height of the + ! rc_tol kg/kg level. Brian. + call stat_update_var_pt( iz_cloud_base, 1, lin_int( rc_tol, rcm(k), & + rcm(k-1), gr%zt(k), gr%zt(k-1) ), sfc ) + + else + + ! Set the cloud base output to -10m, if it's clear. + call stat_update_var_pt( iz_cloud_base, 1, -10.0_core_rknd , sfc ) ! Known magic number + + end if ! k > 1 and k < gr%nz + + end if ! iz_cloud_base > 0 + + ! Liquid Water Path + if ( ilwp > 0 ) then + + xtmp & + = vertical_integral & + ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + rcm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) + + call stat_update_var_pt( ilwp, 1, xtmp, sfc ) + + end if + + ! Vapor Water Path (Preciptable Water) + if ( ivwp > 0 ) then + + xtmp & + = vertical_integral & + ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + ( rtm(2:gr%nz) - rcm(2:gr%nz) ), gr%invrs_dzt(2:gr%nz) ) + + call stat_update_var_pt( ivwp, 1, xtmp, sfc ) + + end if + + + ! Vertical average of thermodynamic level variables. + + ! Find the vertical average of thermodynamic level variables, averaged from + ! level 2 (the first thermodynamic level above model surface) through + ! level gr%nz (the top of the model). Use the vertical averaging function + ! found in fill_holes.F90. + + ! Vertical average of thlm. + call stat_update_var_pt( ithlm_vert_avg, 1, & + vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & + thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & + sfc ) + + ! Vertical average of rtm. + call stat_update_var_pt( irtm_vert_avg, 1, & + vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & + rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & + sfc ) + + ! Vertical average of um. + call stat_update_var_pt( ium_vert_avg, 1, & + vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & + um(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & + sfc ) + + ! Vertical average of vm. + call stat_update_var_pt( ivm_vert_avg, 1, & + vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & + vm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & + sfc ) + + ! Vertical average of momentum level variables. + + ! Find the vertical average of momentum level variables, averaged over the + ! entire vertical profile (level 1 through level gr%nz). Use the vertical + ! averaging function found in fill_holes.F90. + + ! Vertical average of wp2. + call stat_update_var_pt( iwp2_vert_avg, 1, & + vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & + wp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & + sfc ) + + ! Vertical average of up2. + call stat_update_var_pt( iup2_vert_avg, 1, & + vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & + up2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & + sfc ) + + ! Vertical average of vp2. + call stat_update_var_pt( ivp2_vert_avg, 1, & + vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & + vp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & + sfc ) + + ! Vertical average of rtp2. + call stat_update_var_pt( irtp2_vert_avg, 1, & + vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & + rtp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & + sfc ) + + ! Vertical average of thlp2. + call stat_update_var_pt( ithlp2_vert_avg, 1, & + vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & + thlp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & + sfc ) + + + end if ! l_stats_samp + + + return + end subroutine stats_accumulate +!------------------------------------------------------------------------------ + subroutine stats_accumulate_hydromet( hydromet, rho_ds_zt ) +! Description: +! Compute stats related the hydrometeors + +! References: +! None +!------------------------------------------------------------------------------ + use crmx_parameters_model, only: & + hydromet_dim ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_array_index, only: & + iirrainm, iirsnowm, iiricem, iirgraupelm, & ! Variable(s) + iiNrm, iiNsnowm, iiNim, iiNgraupelm + + use crmx_stats_variables, only: & + sfc, & ! Variable(s) + irrainm, & + irsnowm, & + iricem, & + irgraupelm, & + iNim, & + iNrm, & + iNsnowm, & + iNgraupelm, & + iswp, & + irwp, & + iiwp + + use crmx_fill_holes, only: & + vertical_integral ! Procedure(s) + + use crmx_stats_type, only: & + stat_update_var, & ! Procedure(s) + stat_update_var_pt + + use crmx_stats_variables, only: & + zt, & ! Variables + l_stats_samp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: & + hydromet ! All hydrometeors except for rcm [units vary] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + rho_ds_zt ! Dry, static density (thermo. levs.) [kg/m^3] + + ! Local Variables + real(kind=core_rknd) :: xtmp + + ! ---- Begin Code ---- + + if ( l_stats_samp ) then + + if ( iirrainm > 0 ) then + call stat_update_var( irrainm, hydromet(:,iirrainm), zt ) + end if + + if ( iirsnowm > 0 ) then + call stat_update_var( irsnowm, hydromet(:,iirsnowm), zt ) + end if + + if ( iiricem > 0 ) then + call stat_update_var( iricem, hydromet(:,iiricem), zt ) + end if + + if ( iirgraupelm > 0 ) then + call stat_update_var( irgraupelm, & + hydromet(:,iirgraupelm), zt ) + end if + + if ( iiNim > 0 ) then + call stat_update_var( iNim, hydromet(:,iiNim), zt ) + end if + + if ( iiNrm > 0 ) then + call stat_update_var( iNrm, hydromet(:,iiNrm), zt ) + end if + + if ( iiNsnowm > 0 ) then + call stat_update_var( iNsnowm, hydromet(:,iiNsnowm), zt ) + end if + + if ( iiNgraupelm > 0 ) then + call stat_update_var( iNgraupelm, hydromet(:,iiNgraupelm), zt ) + end if + + ! Snow Water Path + if ( iswp > 0 .and. iirsnowm > 0 ) then + + ! Calculate snow water path + xtmp & + = vertical_integral & + ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + hydromet(2:gr%nz,iirsnowm), gr%invrs_dzt(2:gr%nz) ) + + call stat_update_var_pt( iswp, 1, xtmp, sfc ) + + end if ! iswp > 0 .and. iirsnowm > 0 + + ! Ice Water Path + if ( iiwp > 0 .and. iiricem > 0 ) then + + xtmp & + = vertical_integral & + ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + hydromet(2:gr%nz,iiricem), gr%invrs_dzt(2:gr%nz) ) + + call stat_update_var_pt( iiwp, 1, xtmp, sfc ) + + end if + + ! Rain Water Path + if ( irwp > 0 .and. iirrainm > 0 ) then + + xtmp & + = vertical_integral & + ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & + hydromet(2:gr%nz,iirrainm), gr%invrs_dzt(2:gr%nz) ) + + call stat_update_var_pt( irwp, 1, xtmp, sfc ) + + end if ! irwp > 0 .and. irrainm > 0 + end if ! l_stats_samp + + return + end subroutine stats_accumulate_hydromet +!------------------------------------------------------------------------------ + subroutine stats_accumulate_LH_tend( LH_hydromet_mc, LH_thlm_mc, LH_rvm_mc, LH_rcm_mc ) +! Description: +! Compute stats for the tendency of latin hypercube sample points. + +! References: +! None +!------------------------------------------------------------------------------ + use crmx_parameters_model, only: & + hydromet_dim ! Variable(s) + + use crmx_grid_class, only: & + gr ! Variable(s) + + use crmx_array_index, only: & + iirrainm, iirsnowm, iiricem, iirgraupelm, & ! Variable(s) + iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm + + use crmx_stats_variables, only: & + iLH_rrainm_mc, & ! Variable(s) + iLH_rsnowm_mc, & + iLH_ricem_mc, & + iLH_rgraupelm_mc, & + iLH_Ncm_mc, & + iLH_Nim_mc, & + iLH_Nrm_mc, & + iLH_Nsnowm_mc, & + iLH_Ngraupelm_mc, & + iLH_rcm_mc, & + iLH_rvm_mc, & + iLH_thlm_mc + + use crmx_stats_variables, only: & + iAKstd, & ! Variable(s) + iAKstd_cld, & + iAKm_rcm, & + iAKm_rcc, & + iAKm, & + iLH_AKm, & + iLH_rcm_avg + + use crmx_variables_diagnostic_module, only: & + AKm, & ! Variable(s) + lh_AKm, & + AKstd, & + lh_rcm_avg, & + AKstd_cld, & + AKm_rcm, & + AKm_rcc + + use crmx_stats_type, only: & + stat_update_var ! Procedure(s) + + use crmx_stats_variables, only: & + LH_zt, & ! Variables + l_stats_samp + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: & + LH_hydromet_mc ! Tendency of hydrometeors except for rvm/rcm [units vary] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + LH_thlm_mc, & ! Tendency of liquid potential temperature [kg/kg/s] + LH_rcm_mc, & ! Tendency of cloud water [kg/kg/s] + LH_rvm_mc ! Tendency of vapor [kg/kg/s] + + if ( l_stats_samp ) then + + call stat_update_var( iLH_thlm_mc, LH_thlm_mc, LH_zt ) + call stat_update_var( iLH_rcm_mc, LH_rcm_mc, LH_zt ) + call stat_update_var( iLH_rvm_mc, LH_rvm_mc, LH_zt ) + + if ( iiNcm > 0 ) then + call stat_update_var( iLH_Ncm_mc, LH_hydromet_mc(:,iiNcm), LH_zt ) + end if + + if ( iirrainm > 0 ) then + call stat_update_var( iLH_rrainm_mc, LH_hydromet_mc(:,iirrainm), LH_zt ) + end if + + if ( iirsnowm > 0 ) then + call stat_update_var( iLH_rsnowm_mc, LH_hydromet_mc(:,iirsnowm), LH_zt ) + end if + + if ( iiricem > 0 ) then + call stat_update_var( iLH_ricem_mc, LH_hydromet_mc(:,iiricem), LH_zt ) + end if + + if ( iirgraupelm > 0 ) then + call stat_update_var( iLH_rgraupelm_mc, LH_hydromet_mc(:,iirgraupelm), LH_zt ) + end if + + if ( iiNim > 0 ) then + call stat_update_var( iLH_Nim_mc, LH_hydromet_mc(:,iiNim), LH_zt ) + end if + + if ( iiNrm > 0 ) then + call stat_update_var( iLH_Nrm_mc, LH_hydromet_mc(:,iiNrm), LH_zt ) + end if + + if ( iiNsnowm > 0 ) then + call stat_update_var( iLH_Nsnowm_mc, LH_hydromet_mc(:,iiNsnowm), LH_zt ) + end if + + if ( iiNgraupelm > 0 ) then + call stat_update_var( iLH_Ngraupelm_mc, LH_hydromet_mc(:,iiNgraupelm), LH_zt ) + end if + + call stat_update_var( iAKm, AKm, LH_zt ) + call stat_update_var( iLH_AKm, lh_AKm, LH_zt) + call stat_update_var( iLH_rcm_avg, lh_rcm_avg, LH_zt ) + call stat_update_var( iAKstd, AKstd, LH_zt ) + call stat_update_var( iAKstd_cld, AKstd_cld, LH_zt ) + + call stat_update_var( iAKm_rcm, AKm_rcm, LH_zt) + call stat_update_var( iAKm_rcc, AKm_rcc, LH_zt ) + + end if ! l_stats_samp + + return + end subroutine stats_accumulate_LH_tend + + !----------------------------------------------------------------------- + subroutine stats_finalize( ) + + ! Description: + ! Close NetCDF files and deallocate scratch space and + ! stats file structures. + !----------------------------------------------------------------------- + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + LH_zt, & + LH_sfc, & + zm, & + rad_zt, & + rad_zm, & + sfc, & + l_netcdf, & + l_stats, & + l_output_rad_files + + use crmx_stats_variables, only: & + ztscr01, & ! Variable(s) + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use crmx_stats_variables, only: & + zmscr01, & ! Variable(s) + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17 + + !use stats_variables, only: & + ! radscr01, & ! Variable(s) + ! radscr02, & + ! radscr03, & + ! radscr04, & + ! radscr05, & + ! radscr06, & + ! radscr07, & + ! radscr08, & + ! radscr09, & + ! radscr10, & + ! radscr11, & + ! radscr12, & + ! radscr13, & + ! radscr14, & + ! radscr15, & + ! radscr16, & + ! radscr17 + + use crmx_stats_variables, only: & + isclrm, & + isclrm_f, & + iedsclrm, & + iedsclrm_f, & + isclrprtp, & + isclrp2, & + isclrpthvp, & + isclrpthlp, & + isclrprcp, & + iwpsclrp, & + iwp2sclrp, & + iwpsclrp2, & + iwpsclrprtp, & + iwpsclrpthlp, & + iwpedsclrp + + use crmx_parameters_microphys, only: & + LH_microphys_disabled ! Constant(s) + + use crmx_parameters_microphys, only: & + LH_microphys_type ! Variable(s) + +#ifdef NETCDF + use crmx_output_netcdf, only: & + close_netcdf ! Procedure +#endif + + implicit none + + if ( l_stats .and. l_netcdf ) then +#ifdef NETCDF + call close_netcdf( zt%f ) + call close_netcdf( LH_zt%f ) + call close_netcdf( LH_sfc%f ) + call close_netcdf( zm%f ) + call close_netcdf( rad_zt%f ) + call close_netcdf( rad_zm%f ) + call close_netcdf( sfc%f ) +#else + stop "This program was not compiled with netCDF support" +#endif + end if + + if ( l_stats ) then + ! De-allocate all zt variables + deallocate( zt%z ) + + deallocate( zt%x ) + + deallocate( zt%n ) + deallocate( zt%l_in_update ) + + + deallocate( zt%f%var ) + deallocate( zt%f%z ) + deallocate( zt%f%rlat ) + deallocate( zt%f%rlon ) + + deallocate ( ztscr01 ) + deallocate ( ztscr02 ) + deallocate ( ztscr03 ) + deallocate ( ztscr04 ) + deallocate ( ztscr05 ) + deallocate ( ztscr06 ) + deallocate ( ztscr07 ) + deallocate ( ztscr08 ) + deallocate ( ztscr09 ) + deallocate ( ztscr10 ) + deallocate ( ztscr11 ) + deallocate ( ztscr12 ) + deallocate ( ztscr13 ) + deallocate ( ztscr14 ) + deallocate ( ztscr15 ) + deallocate ( ztscr16 ) + deallocate ( ztscr17 ) + deallocate ( ztscr18 ) + deallocate ( ztscr19 ) + deallocate ( ztscr20 ) + deallocate ( ztscr21 ) + + if ( LH_microphys_type /= LH_microphys_disabled ) then + ! De-allocate all LH_zt variables + deallocate( LH_zt%z ) + + deallocate( LH_zt%x ) + + deallocate( LH_zt%n ) + deallocate( LH_zt%l_in_update ) + + + deallocate( LH_zt%f%var ) + deallocate( LH_zt%f%z ) + deallocate( LH_zt%f%rlat ) + deallocate( LH_zt%f%rlon ) + + ! De-allocate all LH_sfc variables + deallocate( LH_sfc%z ) + + deallocate( LH_sfc%x ) + + deallocate( LH_sfc%n ) + deallocate( LH_sfc%l_in_update ) + + + deallocate( LH_sfc%f%var ) + deallocate( LH_sfc%f%z ) + deallocate( LH_sfc%f%rlat ) + deallocate( LH_sfc%f%rlon ) + end if + + ! De-allocate all zm variables + deallocate( zm%z ) + + deallocate( zm%x ) + deallocate( zm%n ) + + deallocate( zm%f%var ) + deallocate( zm%f%z ) + deallocate( zm%f%rlat ) + deallocate( zm%f%rlon ) + deallocate( zm%l_in_update ) + + deallocate ( zmscr01 ) + deallocate ( zmscr02 ) + deallocate ( zmscr03 ) + deallocate ( zmscr04 ) + deallocate ( zmscr05 ) + deallocate ( zmscr06 ) + deallocate ( zmscr07 ) + deallocate ( zmscr08 ) + deallocate ( zmscr09 ) + deallocate ( zmscr10 ) + deallocate ( zmscr11 ) + deallocate ( zmscr12 ) + deallocate ( zmscr13 ) + deallocate ( zmscr14 ) + deallocate ( zmscr15 ) + deallocate ( zmscr16 ) + deallocate ( zmscr17 ) + + if (l_output_rad_files) then + ! De-allocate all rad_zt variables + deallocate( rad_zt%z ) + + deallocate( rad_zt%x ) + deallocate( rad_zt%n ) + + deallocate( rad_zt%f%var ) + deallocate( rad_zt%f%z ) + deallocate( rad_zt%f%rlat ) + deallocate( rad_zt%f%rlon ) + deallocate( rad_zt%l_in_update ) + + ! De-allocate all rad_zm variables + deallocate( rad_zm%z ) + + deallocate( rad_zm%x ) + deallocate( rad_zm%n ) + + deallocate( rad_zm%f%var ) + deallocate( rad_zm%f%z ) + deallocate( rad_zm%l_in_update ) + + !deallocate ( radscr01 ) + !deallocate ( radscr02 ) + !deallocate ( radscr03 ) + !deallocate ( radscr04 ) + !deallocate ( radscr05 ) + !deallocate ( radscr06 ) + !deallocate ( radscr07 ) + !deallocate ( radscr08 ) + !deallocate ( radscr09 ) + !deallocate ( radscr10 ) + !deallocate ( radscr11 ) + !deallocate ( radscr12 ) + !deallocate ( radscr13 ) + !deallocate ( radscr14 ) + !deallocate ( radscr15 ) + !deallocate ( radscr16 ) + !deallocate ( radscr17 ) + end if ! l_output_rad_files + + ! De-allocate all sfc variables + deallocate( sfc%z ) + + deallocate( sfc%x ) + deallocate( sfc%n ) + deallocate( sfc%l_in_update ) + + deallocate( sfc%f%var ) + deallocate( sfc%f%z ) + deallocate( sfc%f%rlat ) + deallocate( sfc%f%rlon ) + + ! De-allocate scalar indices + deallocate( isclrm ) + deallocate( isclrm_f ) + deallocate( iedsclrm ) + deallocate( iedsclrm_f ) + deallocate( isclrprtp ) + deallocate( isclrp2 ) + deallocate( isclrpthvp ) + deallocate( isclrpthlp ) + deallocate( isclrprcp ) + deallocate( iwpsclrp ) + deallocate( iwp2sclrp ) + deallocate( iwpsclrp2 ) + deallocate( iwpsclrprtp ) + deallocate( iwpsclrpthlp ) + deallocate( iwpedsclrp ) + + end if ! l_stats + + + return + end subroutine stats_finalize + +!=============================================================================== + +end module crmx_stats_subs diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 new file mode 100644 index 0000000000..f9c27a287e --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 @@ -0,0 +1,524 @@ +!----------------------------------------------------------------------- +! $Id: stats_type.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_stats_type + + ! Description: + ! Contains derived data type 'stats'. + ! Used for storing output statistics to disk. + !----------------------------------------------------------------------- + + use crmx_stat_file_module, only: & + stat_file ! Type + + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd, & + core_rknd + + implicit none + + private ! Set Default Scope + + public :: stats, & + stat_assign, & + stat_update_var, & + stat_update_var_pt, & + stat_begin_update, & + stat_begin_update_pt, & + stat_end_update, & + stat_end_update_pt, & + stat_modify, & + stat_modify_pt + + ! Derived data types to store GrADS/netCDF statistics + type stats + + ! Number of fields to sample + integer :: nn + + ! Vertical extent of variable + integer :: kk + + ! Vertical levels + real( kind = core_rknd ), pointer, dimension(:) :: z + + ! Array to store sampled fields + + real(kind=stat_rknd), pointer, dimension(:,:,:,:) :: x + + integer(kind=stat_nknd), pointer, dimension(:,:,:,:) :: n + + ! Tracks if a field is in the process of an update + logical, pointer, dimension(:,:,:,:) :: l_in_update + + ! Data for GrADS / netCDF output + + type (stat_file) f + + end type stats + + contains + + !============================================================================= + subroutine stat_assign( var_index, var_name, & + var_description, var_units, grid_kind ) + + ! Description: + ! Assigns pointers for statistics variables in grid. + !----------------------------------------------------------------------- + + implicit none + + ! Input Variables + + integer,intent(in) :: var_index ! Variable index [#] + character(len = *), intent(in) :: var_name ! Variable name [] + character(len = *), intent(in) :: var_description ! Variable description [] + character(len = *), intent(in) :: var_units ! Variable units [] + + ! Output Variable + + ! Which grid the variable is located on (zt, zm, or sfc ) + type(stats), intent(inout) :: grid_kind + + grid_kind%f%var(var_index)%ptr => grid_kind%x(:,:,:,var_index) + grid_kind%f%var(var_index)%name = var_name + grid_kind%f%var(var_index)%description = var_description + grid_kind%f%var(var_index)%units = var_units + + !Example of the old format + !changed by Joshua Fasching 23 August 2007 + + !zt%f%var(ithlm)%ptr => zt%x(:,k) + !zt%f%var(ithlm)%name = "thlm" + !zt%f%var(ithlm)%description = "thetal (K)" + !zt%f%var(ithlm)%units = "K" + + return + + end subroutine stat_assign + + !============================================================================= + subroutine stat_update_var( var_index, value, grid_kind ) + + ! Description: + ! This updates the value of a statistics variable located at var_index + ! associated with grid type 'grid_kind' (zt, zm, or sfc). + ! + ! This subroutine is used when a statistical variable needs to be updated + ! only once during a model timestep. + ! + ! In regards to budget terms, this subroutine is used for variables that + ! are either completely implicit (e.g. wprtp_ma) or completely explicit + ! (e.g. wp2_pr3). For completely implicit terms, once the variable has been + ! solved for, the implicit contribution can be finalized. The finalized + ! implicit contribution is sent into stat_update_var_pt. For completely + ! explicit terms, the explicit contribution is sent into stat_update_var_pt + ! once it has been calculated. + !--------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + stat_rknd ! Constant + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index ! The index at which the variable is stored [] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc ) + + ! Input Variable(s) NOTE: Due to the implicit none above, these must + ! be declared below to allow the use of grid_kind + + real( kind = core_rknd ), dimension(grid_kind%kk), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + integer :: k + + if ( var_index > 0 ) then + do k = 1, grid_kind%kk + grid_kind%x(1,1,k,var_index) = & + grid_kind%x(1,1,k,var_index) + real( value(k), kind=stat_rknd ) + grid_kind%n(1,1,k,var_index) = & + grid_kind%n(1,1,k,var_index) + 1 + end do + endif + + return + end subroutine stat_update_var + + !============================================================================= + subroutine stat_update_var_pt( var_index, grid_level, value, grid_kind ) + + ! Description: + ! This updates the value of a statistics variable located at var_index + ! associated with grid type 'grid_kind' at a specific grid_level. + ! + ! See the description of stat_update_var for more details. + !--------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + stat_rknd ! Constant + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index, & ! The index at which the variable is stored [] + grid_level ! The level at which the variable is to be modified [] + + real( kind = core_rknd ), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + if ( var_index > 0 ) then + + grid_kind%x(1,1,grid_level,var_index) = grid_kind%x(1,1,grid_level,var_index) & + + real( value, kind=stat_rknd ) + + grid_kind%n(1,1,grid_level,var_index) = grid_kind%n(1,1,grid_level,var_index) + 1 + + endif + + return + end subroutine stat_update_var_pt + + !============================================================================= + subroutine stat_begin_update( var_index, value, & + grid_kind ) + + ! Description: + ! This begins an update of the value of a statistics variable located at + ! var_index on the (zt, zm, or sfc) grid. It is used in conjunction with + ! subroutine stat_end_update. + ! + ! This subroutine is used when a statistical variable needs to be updated + ! more than one time during a model timestep. Commonly, this is used for + ! beginning a budget term calculation. + ! + ! In this type of stats calculation, we first subtract the field + ! (e.g. rtm / dt ) from the statistic, then update rtm by a term + ! (e.g. clip rtm), and then re-add the field (e.g. rtm / dt) to the + ! statistic. + ! + ! Example: + ! + ! call stat_begin_update( irtm_bt, real(rtm / dt), zt ) + ! + ! !!! Perform clipping of rtm !!! + ! + ! call stat_end_update( irtm_bt, real(rtm / dt), zt ) + ! + ! This subroutine is often used with stats budget terms for variables that + ! have both implicit and explicit components (e.g. wp3_ta). The explicit + ! component is sent into stat_begin_update_pt (with the sign reversed + ! because stat_begin_update_pt automatically subtracts the value sent into + ! it). Then, once the variable has been solved for, the implicit + ! statistical contribution can be finalized. The finalized implicit + ! component is sent into stat_end_update_pt. + !--------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable(s) + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index ! The index at which the variable is stored [] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + integer :: i + + do i = 1, gr%nz + + call stat_begin_update_pt & + ( var_index, i, value(i), grid_kind ) + + enddo + + return + end subroutine stat_begin_update + + !============================================================================= + subroutine stat_begin_update_pt & + ( var_index, grid_level, value, grid_kind ) + + ! Description: + ! This begins an update of the value of a statistics variable located at + ! var_index associated with the grid type (grid_kind) at a specific + ! grid_level. It is used in conjunction with subroutine stat_end_update_pt. + ! + ! Notes: + ! Commonly this is used for beginning a budget. See the description of + ! stat_begin_update for more details. + ! + ! References: + ! None + !--------------------------------------------------------------------- + + use crmx_error_code, only: clubb_debug ! Procedure(s) + + use crmx_clubb_precision, only: & + stat_rknd ! Constant + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index, & ! The index at which the variable is stored [] + grid_level ! The level at which the variable is to be modified [] + + real( kind = core_rknd ), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + ! ---- Begin Code ---- + + if ( var_index > 0 ) then ! Are we storing this variable? + + if ( .not. grid_kind%l_in_update(1,1,grid_level,var_index) ) then ! Can we begin an update? + + grid_kind%x(1,1,grid_level, var_index) = & + grid_kind%x(1,1,grid_level, var_index) - real( value, kind=stat_rknd ) + + grid_kind%l_in_update(1,1,grid_level, var_index) = .true. ! Start Record + + else + + call clubb_debug( 1, & + "Beginning an update before finishing previous for variable: "// & + trim( grid_kind%f%var(var_index)%name ) ) + endif + + endif + + return + end subroutine stat_begin_update_pt + + !============================================================================= + subroutine stat_end_update( var_index, value, grid_kind ) + + ! Description: + ! This ends an update of the value of a statistics variable located at + ! var_index on the (zt, zm, or sfc) grid. It is used in conjunction with + ! subroutine stat_begin_update. + ! + ! This subroutine is used when a statistical variable needs to be updated + ! more than one time during a model timestep. Commonly, this is used for + ! finishing a budget term calculation. + ! + ! In this type of stats calculation, we first subtract the field + ! (e.g. rtm / dt ) from the statistic, then update rtm by a term + ! (e.g. clip rtm), and then re-add the field (e.g. rtm / dt) to the + ! statistic. + ! + ! Example: + ! + ! call stat_begin_update( irtm_bt, real(rtm / dt), zt ) + ! + ! !!! Perform clipping of rtm !!! + ! + ! call stat_end_update( irtm_bt, real(rtm / dt), zt ) + ! + ! This subroutine is often used with stats budget terms for variables that + ! have both implicit and explicit components (e.g. wp3_ta). The explicit + ! component is sent into stat_begin_update_pt (with the sign reversed + ! because stat_begin_update_pt automatically subtracts the value sent into + ! it). Then, once the variable has been solved for, the implicit + ! statistical contribution can be finalized. The finalized implicit + ! component is sent into stat_end_update_pt. + !--------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable(s) + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index ! The index at which the variable is stored [] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + integer :: i + + ! ---- Begin Code ---- + + do i = 1,gr%nz + call stat_end_update_pt & + ( var_index, i, value(i), grid_kind ) + enddo + + return + end subroutine stat_end_update + + !============================================================================= + subroutine stat_end_update_pt & + ( var_index, grid_level, value, grid_kind ) + + ! Description: + ! This ends an update of the value of a statistics variable located at + ! var_index associated with the grid type (grid_kind) at a specific + ! grid_level. It is used in conjunction with subroutine + ! stat_begin_update_pt. + ! + ! Commonly this is used for finishing a budget. See the description of + ! stat_end_update for more details. + !--------------------------------------------------------------------- + + use crmx_error_code, only: clubb_debug ! Procedure(s) + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index, & ! The index at which the variable is stored [] + grid_level ! The level at which the variable is to be modified [] + + real( kind = core_rknd ), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + ! ---- Begin Code ---- + + if ( var_index > 0 ) then ! Are we storing this variable? + + if ( grid_kind%l_in_update(1,1,grid_level,var_index) ) then ! Can we end an update? + + call stat_update_var_pt & + ( var_index, grid_level, value, grid_kind ) + + grid_kind%l_in_update(1,1,grid_level,var_index) = .false. ! End Record + + else + + call clubb_debug( 1, "Ending before beginning update. For variable "// & + grid_kind%f%var(var_index)%name ) + + endif + + endif + + return + end subroutine stat_end_update_pt + + !============================================================================= + subroutine stat_modify( var_index, value, & + grid_kind ) + + ! Description: + ! This modifies the value of a statistics variable located at var_index on + ! the (zt, zm, or sfc) grid. It does not increment the sampling count. + ! + ! This subroutine is normally used when a statistical variable needs to be + ! updated more than twice during a model timestep. Commonly, this is used + ! if a budget term calculation needs an intermediate modification between + ! stat_begin_update and stat_end_update. + !--------------------------------------------------------------------- + + use crmx_grid_class, only: gr ! Variable(s) + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index ! The index at which the variable is stored [] + + real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + integer :: i + + ! ---- Begin Code ---- + + do i = 1, gr%nz + + call stat_modify_pt( var_index, i, value(i), grid_kind ) + + enddo + + return + end subroutine stat_modify + + !============================================================================= + subroutine stat_modify_pt( var_index, grid_level, value, & + grid_kind ) + + ! Description: + ! This modifies the value of a statistics variable located at var_index on + ! the grid at a specific point. It does not increment the sampling count. + ! + ! Commonly this is used for intermediate updates to a budget. See the + ! description of stat_modify for more details. + !--------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + stat_rknd ! Constant + + implicit none + + ! Input Variables(s) + + integer, intent(in) :: & + var_index ! The index at which the variable is stored [] + + + real( kind = core_rknd ), intent(in) :: & + value ! Value of field being added to the statistic [Units Vary] + + integer, intent(in) :: & + grid_level ! The level at which the variable is to be modified [] + + ! Input/Output Variable(s) + type(stats), intent(inout) :: & + grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). + + ! ---- Begin Code ---- + + if ( var_index > 0 ) then + + grid_kind%x(1,1,grid_level,var_index ) & + = grid_kind%x(1,1,grid_level,var_index ) + real( value, kind=stat_rknd ) + + end if + + return + end subroutine stat_modify_pt + +!=============================================================================== + +end module crmx_stats_type diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 new file mode 100644 index 0000000000..d571408e67 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 @@ -0,0 +1,1116 @@ +!------------------------------------------------------------------------------- +! $Id: stats_variables.F90 6153 2013-04-09 22:13:27Z bmg2@uwm.edu $ +!------------------------------------------------------------------------------- + +! Description: +! Holds pointers and other variables for statistics to be written to +! GrADS files and netCDF files. +!------------------------------------------------------------------------------- +module crmx_stats_variables + + + use crmx_stats_type, only: & + stats ! Type + + use crmx_clubb_precision, only: & + time_precision, & ! Variable + core_rknd + + implicit none + + private ! Set Default Scope + + ! Sampling and output frequencies + real(kind=time_precision), public :: & + stats_tsamp, & ! Sampling interval [s] + stats_tout ! Output interval [s] + +!$omp threadprivate(stats_tsamp, stats_tout) + + logical, public :: & + l_stats, & ! Main flag to turn statistics on/off + l_output_rad_files, & ! Flag to turn off radiation statistics output + l_netcdf, & ! Output to NetCDF format + l_grads ! Output to GrADS format + +!$omp threadprivate(l_stats, l_netcdf, l_grads) + + logical, public :: & + l_stats_samp, & ! Sample flag for current time step + l_stats_last ! Last time step of output period + +!$omp threadprivate(l_stats_samp, l_stats_last) + + character(len=200), public :: & + fname_zt, & ! Name of the stats file for thermodynamic grid fields + fname_LH_zt, & ! Name of the stats file for LH variables on the zt grid + fname_LH_sfc, & ! Name of the stats file for LH variables on the zt grid + fname_zm, & ! Name of the stats file for momentum grid fields + fname_rad_zt, & ! Name of the stats file for the zt radiation grid fields + fname_rad_zm, & ! Name of the stats file for the zm radiation grid fields + fname_sfc ! Name of the stats file for surface only fields + +!$omp threadprivate(fname_zt, fname_zm, fname_LH_zt, fname_LH_sfc, fname_rad_zt, & +!$omp fname_rad_zm, fname_sfc) + +! Indices for statistics in zt file + + integer, public :: & + ithlm, & + ithvm, & + irtm, & + ircm, & + irvm, & + ium, & + ivm, & + iwm_zt, & + iwm_zm, & + ium_ref,& + ivm_ref, & + iug, & + ivg, & + icloud_frac, & + iice_supersat_frac, & + ircm_in_layer, & + ircm_in_cloud, & + icloud_cover, & + ip_in_Pa, & + iexner, & + irho_ds_zt, & + ithv_ds_zt, & + iLscale, & + iwp3, & + iwpthlp2, & + iwp2thlp, & + iwprtp2, & + iwp2rtp + + integer, public :: & + iLscale_up, & + iLscale_down, & + iLscale_pert_1, & + iLscale_pert_2, & + itau_zt, & + iKh_zt, & + iwp2thvp, & + iwp2rcp, & + iwprtpthlp, & + isigma_sqd_w_zt, & + irho + + integer, public :: & + irr1, & + irr2, & + iNr1, & + iNr2, & + iLWP1, & + iLWP2, & + iprecip_frac, & + iprecip_frac_1, & + iprecip_frac_2 + + integer, public :: & + imu_rr_1, & + imu_rr_2, & + imu_Nr_1, & + imu_Nr_2, & + imu_Nc_1, & + imu_Nc_2, & + imu_rr_1_n, & + imu_rr_2_n, & + imu_Nr_1_n, & + imu_Nr_2_n, & + imu_Nc_1_n, & + imu_Nc_2_n, & + isigma_rr_1, & + isigma_rr_2, & + isigma_Nr_1, & + isigma_Nr_2, & + isigma_Nc_1, & + isigma_Nc_2, & + isigma_rr_1_n, & + isigma_rr_2_n, & + isigma_Nr_1_n, & + isigma_Nr_2_n, & + isigma_Nc_1_n, & + isigma_Nc_2_n + + integer, public :: & + icorr_srr_1, & + icorr_srr_2, & + icorr_sNr_1, & + icorr_sNr_2, & + icorr_sNc_1, & + icorr_sNc_2, & + icorr_trr_1, & + icorr_trr_2, & + icorr_tNr_1, & + icorr_tNr_2, & + icorr_tNc_1, & + icorr_tNc_2, & + icorr_rrNr_1, & + icorr_rrNr_2, & + icorr_srr_1_n, & + icorr_srr_2_n, & + icorr_sNr_1_n, & + icorr_sNr_2_n, & + icorr_sNc_1_n, & + icorr_sNc_2_n, & + icorr_trr_1_n, & + icorr_trr_2_n, & + icorr_tNr_1_n, & + icorr_tNr_2_n, & + icorr_tNc_1_n, & + icorr_tNc_2_n, & + icorr_rrNr_1_n, & + icorr_rrNr_2_n + + integer, public :: & ! janhft 09/25/12 + icorr_sw, & + icorr_wrr, & + icorr_wNr, & + icorr_wNc + + integer, public :: & + iNcm, & ! Brian + iNcnm, & + iNcm_in_cloud, & + iNc_activated, & + isnowslope, & ! Adam Smith, 22 April 2008 + ised_rcm, & ! Brian + irsat, & ! Brian + irsati, & + irrainm, & ! Brian + im_vol_rad_rain, & ! Brian + im_vol_rad_cloud, & ! COAMPS only. dschanen 6 Dec 2006 + irain_rate_zt, & ! Brian + iAKm, & ! analytic Kessler. Vince Larson 22 May 2005 + iLH_AKm, & ! LH Kessler. Vince Larson 22 May 2005 + iradht, & ! Radiative heating. + iradht_LW, & ! " " Long-wave component + iradht_SW, & ! " " Short-wave component + irel_humidity + + integer, public :: & + iAKstd, & + iAKstd_cld, & + iAKm_rcm, & + iAKm_rcc + +!$omp threadprivate(ithlm, ithvm, irtm, ircm, irvm, ium, ivm, ium_ref, ivm_ref, & +!$omp iwm_zt, iwm_zm, iug, ivg, icloud_frac, ircm_in_layer, ircm_in_cloud, icloud_cover, & +!$omp ip_in_Pa, iexner, irho_ds_zt, ithv_ds_zt, iLscale, iwp3, & +!$omp iwpthlp2, iwp2thlp, iwprtp2, iwp2rtp, iLscale_up, iLscale_down, & +!$omp iLscale_pert_1, iLscale_pert_2, & +!$omp itau_zt, iKh_zt, iwp2thvp, iwp2rcp, iwprtpthlp, isigma_sqd_w_zt, irho, & +!$omp irr1, irr2, iNr1, iNr2, iLWP1, iLWP2, & +!$omp iprecip_frac, iprecip_frac_1, iprecip_frac_2, & +!$omp irel_humidity, iNcm, iNcnm, isnowslope, & +!$omp ised_rcm, irsat, irsati, irrainm, & +!$omp im_vol_rad_rain, im_vol_rad_cloud, & +!$omp irain_rate_zt, iAKm, iLH_AKm, & +!$omp iradht, iradht_LW, iradht_SW, & +!$omp iAKstd, iAKstd_cld, iAKm_rcm, iAKm_rcc ) + +!$omp threadprivate( imu_rr_1, imu_rr_2, imu_Nr_1, imu_Nr_2, & +!$omp imu_Nc_1, imu_Nc_2, imu_rr_1_n, imu_rr_2_n, imu_Nr_1_n, imu_Nr_2_n, & +!$omp imu_Nc_1_n, imu_Nc_2_n, isigma_rr_1, isigma_rr_2, isigma_Nr_1, & +!$omp isigma_Nr_2, isigma_Nc_1, isigma_Nc_2, isigma_rr_1_n, isigma_rr_2_n, & +!$omp isigma_Nr_1_n, isigma_Nr_2_n, isigma_Nc_1_n, isigma_Nc_2_n, & +!$omp icorr_srr_1, icorr_srr_2, icorr_sNr_1, icorr_sNr_2, & +!$omp icorr_sNc_1, icorr_sNc_2, icorr_trr_1, icorr_trr_2, & +!$omp icorr_tNr_1, icorr_tNr_2, icorr_tNc_1, icorr_tNc_2, & +!$omp icorr_rrNr_1, icorr_rrNr_2, icorr_srr_1_n, icorr_srr_2_n, & +!$omp icorr_sNr_1_n, icorr_sNr_2_n, icorr_sNc_1_n, icorr_sNc_2_n, & +!$omp icorr_trr_1_n, icorr_trr_2_n, icorr_tNr_1_n, icorr_tNr_2_n, & +!$omp icorr_tNc_1_n, icorr_tNc_2_n, icorr_rrNr_1_n, icorr_rrNr_2_n, & +!$omp icorr_sw, icorr_wrr, icorr_wNr, icorr_wNc ) + + integer, public :: & + irfrzm +!$omp threadprivate(irfrzm) + + ! Skewness functions on zt grid + integer, public :: & + iC11_Skw_fnc + +!$omp threadprivate(iC11_Skw_fnc) + + integer, public :: & + icloud_frac_zm, & + iice_supersat_frac_zm, & + ircm_zm, & + irtm_zm, & + ithlm_zm + +!$omp threadprivate(icloud_frac_zm, ircm_zm, irtm_zm, ithlm_zm) + + integer, public :: & + iLH_rcm_avg + +!$omp threadprivate(iLH_rcm_avg) + + integer, public :: & + iNrm, & ! Rain droplet number concentration + iNim, & ! Ice number concentration + iNsnowm, & ! Snow number concentration + iNgraupelm ! Graupel number concentration +!$omp threadprivate(iNrm, iNim, iNsnowm, iNgraupelm) + + integer, public :: & + iT_in_K ! Absolute temperature +!$omp threadprivate(iT_in_K) + + integer, public :: & + ieff_rad_cloud, & + ieff_rad_ice, & + ieff_rad_snow, & + ieff_rad_rain, & + ieff_rad_graupel + +!$omp threadprivate(ieff_rad_cloud, ieff_rad_ice, ieff_rad_snow) +!$omp threadprivate(ieff_rad_rain, ieff_rad_graupel) + + integer, public :: & + irsnowm, & + irgraupelm, & + iricem, & + idiam, & ! Diameter of ice crystal [m] + imass_ice_cryst, & ! Mass of a single ice crystal [kg] + ircm_icedfs, & ! Change in liquid water due to ice [kg/kg/s] + iu_T_cm ! Fallspeed of ice crystal in cm/s [cm s^{-1}] + +!$omp threadprivate(irsnowm, irgraupelm, iricem, idiam) +!$omp threadprivate(imass_ice_cryst, ircm_icedfs, iu_T_cm) + + + ! thlm/rtm budget terms + integer, public :: & + irtm_bt, & ! rtm total time tendency + irtm_ma, & ! rtm mean advect. term + irtm_ta, & ! rtm turb. advect. term + irtm_forcing, & ! rtm large scale forcing term + irtm_mc, & ! rtm change from microphysics + irtm_sdmp, & ! rtm change from sponge damping + irvm_mc, & ! rvm change from microphysics + ircm_mc, & ! rcm change from microphysics + ircm_sd_mg_morr, & ! rcm sedimentation tendency + irtm_mfl, & ! rtm change due to monotonic flux limiter + irtm_tacl, & ! rtm correction from turbulent advection (wprtp) clipping + irtm_cl, & ! rtm clipping term + irtm_pd, & ! thlm postive definite adj term + ithlm_bt, & ! thlm total time tendency + ithlm_ma, & ! thlm mean advect. term + ithlm_ta, & ! thlm turb. advect. term + ithlm_forcing, & ! thlm large scale forcing term + ithlm_sdmp, & ! thlm change from sponge damping + ithlm_mc, & ! thlm change from microphysics + ithlm_mfl, & ! thlm change due to monotonic flux limiter + ithlm_tacl, & ! thlm correction from turbulent advection (wpthlp) clipping + ithlm_cl ! thlm clipping term + +!$omp threadprivate(irtm_bt, irtm_ma, irtm_ta, irtm_forcing, & +!$omp irtm_mc, irtm_sdmp, irtm_mfl, irtm_tacl, irtm_cl, irtm_pd, & +!$omp irvm_mc, ircm_mc, ircm_sd_mg_morr, & +!$omp ithlm_bt, ithlm_ma, ithlm_ta, ithlm_forcing, & +!$omp ithlm_mc, ithlm_sdmp, ithlm_mfl, ithlm_tacl, ithlm_cl) + + !monatonic flux limiter diagnostic terms + integer, public :: & + ithlm_mfl_min, & + ithlm_mfl_max, & + iwpthlp_entermfl, & + iwpthlp_exit_mfl, & + iwpthlp_mfl_min, & + iwpthlp_mfl_max, & + irtm_mfl_min, & + irtm_mfl_max, & + iwprtp_enter_mfl, & + iwprtp_exit_mfl, & + iwprtp_mfl_min, & + iwprtp_mfl_max, & + ithlm_enter_mfl, & + ithlm_exit_mfl, & + ithlm_old, & + ithlm_without_ta, & + irtm_enter_mfl, & + irtm_exit_mfl, & + irtm_old, & + irtm_without_ta + +!$omp threadprivate(ithlm_mfl_min, ithlm_mfl_max, iwpthlp_entermfl) +!$omp threadprivate(iwpthlp_exit_mfl, iwpthlp_mfl_min, iwpthlp_mfl_max) +!$omp threadprivate(irtm_mfl_min, irtm_mfl_max, iwprtp_enter_mfl) +!$omp threadprivate(iwprtp_exit_mfl, iwprtp_mfl_min, iwprtp_mfl_max) +!$omp threadprivate(ithlm_enter_mfl, ithlm_exit_mfl, ithlm_old, ithlm_without_ta) +!$omp threadprivate(irtm_enter_mfl, irtm_exit_mfl, irtm_old, irtm_without_ta) + + integer, public :: & + iwp3_bt, & + iwp3_ma, & + iwp3_ta, & + iwp3_tp, & + iwp3_ac, & + iwp3_bp1, & + iwp3_bp2, & + iwp3_pr1, & + iwp3_pr2, & + iwp3_dp1, & + iwp3_4hd, & + iwp3_cl + +!$omp threadprivate(iwp3_bt, iwp3_ma, iwp3_ta, iwp3_tp, iwp3_ac, iwp3_bp1) +!$omp threadprivate(iwp3_bp2, iwp3_pr1, iwp3_pr2, iwp3_dp1, iwp3_4hd, iwp3_cl) + + ! Rain mixing ratio budgets + integer, public :: & + irrainm_bt, & + irrainm_ma, & + irrainm_sd, & + irrainm_ts, & + irrainm_sd_morr, & + irrainm_dff, & + irrainm_cond, & + irrainm_auto, & + irrainm_accr, & + irrainm_cond_adj, & + irrainm_src_adj, & + irrainm_tsfl, & + irrainm_mc, & + irrainm_hf, & + irrainm_wvhf, & + irrainm_cl + +!$omp threadprivate(irrainm_bt, irrainm_ma, irrainm_sd, irrainm_ts) +!$omp threadprivate(irrainm_sd_morr, irrainm_dff) +!$omp threadprivate(irrainm_cond, irrainm_auto, irrainm_accr) +!$omp threadprivate(irrainm_cond_adj, irrainm_src_adj, irrainm_tsfl) +!$omp threadprivate(irrainm_mc, irrainm_hf, irrainm_wvhf, irrainm_cl) + + integer, public :: & + iNrm_bt, & + iNrm_ma, & + iNrm_sd, & + iNrm_ts, & + iNrm_dff, & + iNrm_cond, & + iNrm_auto, & + iNrm_cond_adj, & + iNrm_src_adj, & + iNrm_tsfl, & + iNrm_mc, & + iNrm_cl + +!$omp threadprivate(iNrm_bt, iNrm_ma, iNrm_sd, iNrm_ts, iNrm_dff, iNrm_cond) +!$omp threadprivate(iNrm_auto, iNrm_cond_adj, iNrm_src_adj, iNrm_tsfl) +!$omp threadprivate(iNrm_mc, iNrm_cl) + + + ! Snow/Ice/Graupel mixing ratio budgets + integer, public :: & + irsnowm_bt, & + irsnowm_ma, & + irsnowm_sd, & + irsnowm_sd_morr, & + irsnowm_dff, & + irsnowm_mc, & + irsnowm_hf, & + irsnowm_wvhf, & + irsnowm_cl + +!$omp threadprivate(irsnowm_bt, irsnowm_ma, irsnowm_sd, irsnowm_sd_morr, irsnowm_dff) +!$omp threadprivate(irsnowm_mc, irsnowm_hf, irsnowm_wvhf, irsnowm_cl) + + integer, public :: & + irgraupelm_bt, & + irgraupelm_ma, & + irgraupelm_sd, & + irgraupelm_sd_morr, & + irgraupelm_dff, & + irgraupelm_mc, & + irgraupelm_hf, & + irgraupelm_wvhf, & + irgraupelm_cl + +!$omp threadprivate(irgraupelm_bt, irgraupelm_ma, irgraupelm_sd, irgraupelm_sd_morr) +!$omp threadprivate(irgraupelm_dff, irgraupelm_mc) +!$omp threadprivate(irgraupelm_hf, irgraupelm_wvhf, irgraupelm_cl) + + integer, public :: & + iricem_bt, & + iricem_ma, & + iricem_sd, & + iricem_sd_mg_morr, & + iricem_dff, & + iricem_mc, & + iricem_hf, & + iricem_wvhf, & + iricem_cl + +!$omp threadprivate(iricem_bt, iricem_ma, iricem_sd, iricem_sd_mg_morr, iricem_dff) +!$omp threadprivate(iricem_mc, iricem_hf, iricem_wvhf, iricem_cl) + + integer, public :: & + iNsnowm_bt, & + iNsnowm_ma, & + iNsnowm_sd, & + iNsnowm_dff, & + iNsnowm_mc, & + iNsnowm_cl + +!$omp threadprivate(iNsnowm_bt, iNsnowm_ma, iNsnowm_sd, iNsnowm_dff, & +!$omp iNsnowm_mc, iNsnowm_cl) + + integer, public :: & + iNgraupelm_bt, & + iNgraupelm_ma, & + iNgraupelm_sd, & + iNgraupelm_dff, & + iNgraupelm_mc, & + iNgraupelm_cl + +!$omp threadprivate(iNgraupelm_bt, iNgraupelm_ma, iNgraupelm_sd, & +!$omp iNgraupelm_dff, iNgraupelm_mc, iNgraupelm_cl) + + integer, public :: & + iNim_bt, & + iNim_ma, & + iNim_sd, & + iNim_dff, & + iNim_mc, & + iNim_cl + +!$omp threadprivate(iNim_bt, iNim_ma, iNim_sd, iNim_dff, & +!$omp iNim_mc, iNim_cl) + + integer, public :: & + iNcm_bt, & + iNcm_ma, & + iNcm_dff, & + iNcm_mc, & + iNcm_cl, & + iNcm_act + +!$omp threadprivate(iNcm_bt, iNcm_ma, iNcm_dff, & +!$omp iNcm_mc, iNcm_cl) + + ! Covariances between w, r_t, theta_l and KK microphysics tendencies. + ! Additionally, covariances between r_r and N_r and KK rain drop mean + ! volume radius. These are all calculated on thermodynamic grid levels. + integer, public :: & + iw_KK_evap_covar_zt, & ! Covariance of w and KK evaporation tendency. + irt_KK_evap_covar_zt, & ! Covariance of r_t and KK evaporation tendency. + ithl_KK_evap_covar_zt, & ! Covariance of theta_l and KK evap. tendency. + iw_KK_auto_covar_zt, & ! Covariance of w and KK autoconversion tendency. + irt_KK_auto_covar_zt, & ! Covariance of r_t and KK autoconversion tendency. + ithl_KK_auto_covar_zt, & ! Covariance of theta_l and KK autoconv. tendency. + iw_KK_accr_covar_zt, & ! Covariance of w and KK accretion tendency. + irt_KK_accr_covar_zt, & ! Covariance of r_t and KK accretion tendency. + ithl_KK_accr_covar_zt, & ! Covariance of theta_l and KK accretion tendency. + irr_KK_mvr_covar_zt, & ! Covariance of r_r and KK mean volume radius. + iNr_KK_mvr_covar_zt ! Covariance of N_r and KK mean volume radius. + +!$omp threadprivate( iw_KK_evap_covar_zt, irt_KK_evap_covar_zt, & +!$omp ithl_KK_evap_covar_zt, iw_KK_auto_covar_zt, irt_KK_auto_covar_zt, & +!$omp ithl_KK_auto_covar_zt, iw_KK_accr_covar_zt, irt_KK_accr_covar_zt, & +!$omp ithl_KK_accr_covar_zt, irr_KK_mvr_covar_zt, iNr_KK_mvr_covar_zt ) + + ! Wind budgets + integer, public :: & + ivm_bt, & + ivm_ma, & + ivm_ta, & + ivm_gf, & + ivm_cf, & + ivm_f, & + ivm_sdmp, & + ivm_ndg + +!$omp threadprivate(ivm_bt, ivm_ma, ivm_ta, ivm_gf, ivm_cf, ivm_f, ivm_sdmp, ivm_ndg) + + integer, public :: & + ium_bt, & + ium_ma, & + ium_ta, & + ium_gf, & + ium_cf, & + ium_f, & + ium_sdmp, & + ium_ndg + +!$omp threadprivate(ium_bt, ium_ma, ium_ta, ium_gf, ium_cf, ium_f, ium_sdmp, ium_ndg) + + + ! PDF parameters + integer, public :: & + imixt_frac, & + iw1, & + iw2, & + ivarnce_w1, & + ivarnce_w2, & + ithl1, & + ithl2, & + ivarnce_thl1, & + ivarnce_thl2, & + irt1, & + irt2, & + ivarnce_rt1, & + ivarnce_rt2, & + irc1, & + irc2, & + irsl1, & + irsl2, & + icloud_frac1, & + icloud_frac2 + + integer, public :: & + is1, & + is2, & + istdev_s1, & + istdev_s2, & + istdev_t1, & + istdev_t2, & + icovar_st_1, & + icovar_st_2, & + icorr_st_1, & + icorr_st_2, & + irrtthl, & + icrt1, & + icrt2, & + icthl1, & + icthl2 + +!$omp threadprivate(imixt_frac, iw1, iw2, ivarnce_w1, ivarnce_w2, ithl1, ithl2, ivarnce_thl1, & +!$omp ivarnce_thl2, irt1, irt2, ivarnce_rt1, ivarnce_rt2, irc1, irc2, & +!$omp irsl1, irsl2, icloud_frac1, icloud_frac2, is1, is2, istdev_s1, istdev_s2, & +!$omp istdev_t1, istdev_t2, icovar_st_1, icovar_st_2, icorr_st_1, icorr_st_2, irrtthl, & +!$omp icrt1, icrt2, icthl1, icthl2 ) + + integer, public :: & + iwp2_zt, & + ithlp2_zt, & + iwpthlp_zt, & + iwprtp_zt, & + irtp2_zt, & + irtpthlp_zt, & + iup2_zt, & + ivp2_zt, & + iupwp_zt, & + ivpwp_zt + +!$omp threadprivate(iwp2_zt, ithlp2_zt, iwpthlp_zt, iwprtp_zt, irtp2_zt, irtpthlp_zt, & +!$omp iup2_zt, ivp2_zt, iupwp_zt, ivpwp_zt) + + integer, public :: & + is_mellor +!$omp threadprivate(is_mellor) + + integer, target, allocatable, dimension(:), public :: & + isclrm, & ! Passive scalar mean (1) + isclrm_f ! Passive scalar forcing (1) + +! Used to calculate clear-sky radiative fluxes. + integer, public :: & + ifulwcl, ifdlwcl, ifdswcl, ifuswcl + +!$omp threadprivate(isclrm, isclrm_f) + + integer, target, allocatable, dimension(:), public :: & + iedsclrm, & ! Eddy-diff. scalar term (1) + iedsclrm_f ! Eddy-diffusivity scalar forcing (1) + +!$omp threadprivate(iedsclrm, iedsclrm_f) + + integer, public :: & + iLH_thlm_mc, & ! Latin hypercube estimate of thlm_mc + iLH_rvm_mc, & ! Latin hypercube estimate of rvm_mc + iLH_rcm_mc, & ! Latin hypercube estimate of rcm_mc + iLH_Ncm_mc, & ! Latin hypercube estimate of Ncm_mc + iLH_rrainm_mc, & ! Latin hypercube estimate of rrainm_mc + iLH_Nrm_mc, & ! Latin hypercube estimate of Nrm_mc + iLH_rsnowm_mc, & ! Latin hypercube estimate of rsnowm_mc + iLH_Nsnowm_mc, & ! Latin hypercube estimate of Nsnowm_mc + iLH_rgraupelm_mc, & ! Latin hypercube estimate of rgraupelm_mc + iLH_Ngraupelm_mc, & ! Latin hypercube estimate of Ngraupelm_mc + iLH_ricem_mc, & ! Latin hypercube estimate of ricem_mc + iLH_Nim_mc ! Latin hypercube estimate of Nim_mc +!$omp threadprivate( iLH_thlm_mc, iLH_rvm_mc, iLH_rcm_mc, iLH_Ncm_mc, & +!$omp iLH_rrainm_mc, iLH_Nrm_mc, iLH_rsnowm_mc, iLH_Nsnowm_mc, & +!$omp iLH_rgraupelm_mc, iLH_Ngraupelm_mc, iLH_ricem_mc, iLH_Nim_mc ) + + integer, public :: & + iLH_rrainm_auto, & ! Latin hypercube estimate of autoconversion + iLH_rrainm_accr ! Latin hypercube estimate of accretion +!$omp threadprivate( iLH_rrainm_auto, iLH_rrainm_accr ) + + integer, public :: & + iLH_Vrr, & ! Latin hypercube estimate of rrainm sedimentation velocity + iLH_VNr ! Latin hypercube estimate of Nrm sedimentation velocity +!$omp threadprivate(iLH_Vrr, iLH_VNr) + + integer, public :: & + iLH_rrainm, & + iLH_Nrm, & + iLH_ricem, & + iLH_Nim, & + iLH_rsnowm, & + iLH_Nsnowm, & + iLH_rgraupelm, & + iLH_Ngraupelm, & + iLH_thlm, & + iLH_rcm, & + iLH_Ncm, & + iLH_rvm, & + iLH_wm, & + iLH_cloud_frac + +!$omp threadprivate(iLH_rrainm, iLH_Nrm, iLH_ricem, iLH_Nim, iLH_rsnowm, iLH_Nsnowm, & +!$omp iLH_rgraupelm, iLH_Ngraupelm, & +!$omp iLH_thlm, iLH_rcm, iLH_Ncm, iLH_rvm, iLH_wm, iLH_cloud_frac ) + + integer, public :: & + iLH_wp2_zt, & + iLH_Nrp2_zt, & + iLH_Ncp2_zt, & + iLH_rcp2_zt, & + iLH_rtp2_zt, & + iLH_thlp2_zt, & + iLH_rrainp2_zt + +!$omp threadprivate(iLH_wp2_zt, iLH_Nrp2_zt, iLH_Ncp2_zt, iLH_rcp2_zt, iLH_rtp2_zt, & +!$omp iLH_thlp2_zt, iLH_rrainp2_zt) + + ! Indices for statistics in zm file + integer, public :: & + iwp2, & + irtp2, & + ithlp2, & + irtpthlp, & + iwprtp, & + iwpthlp, & + iwp4, & + iwpthvp, & + irtpthvp, & + ithlpthvp, & + itau_zm, & + iKh_zm, & + iwprcp, & + irc_coef, & + ithlprcp, & + irtprcp, & + ircp2, & + iupwp, & + ivpwp + + integer, public :: & + irho_zm, & + isigma_sqd_w, & + irho_ds_zm, & + ithv_ds_zm, & + iem, & + ishear, & ! Brian + imean_w_up, & + imean_w_down, & + iFrad, & + iFrad_LW, & ! Brian + iFrad_SW, & ! Brian + iFrad_LW_up, & + iFrad_SW_up, & + iFrad_LW_down, & + iFrad_SW_down, & + iFprec, & ! Brian + iFcsed ! Brian + +!$omp threadprivate(iwp2, irtp2, ithlp2, irtpthlp, iwprtp, iwpthlp) +!$omp threadprivate(iwp4, iwpthvp, irtpthvp, ithlpthvp, itau_zm, iKh_zm) +!$omp threadprivate(iwprcp, irc_coef, ithlprcp, irtprcp, ircp2, iupwp, ivpwp) +!$omp threadprivate(irho_zm, isigma_sqd_w, irho_ds_zm, ithv_ds_zm, iem, ishear) +!$omp threadprivate(iFrad, iFrad_LW, iFrad_SW, iFrad_SW_up, iFrad_SW_down) +!$omp threadprivate(iFrad_LW_up, iFrad_LW_down, iFprec, iFcsed) + + ! Skewness Functions on zm grid + integer, public :: & + igamma_Skw_fnc, & + iC6rt_Skw_fnc, & + iC6thl_Skw_fnc, & + iC7_Skw_fnc, & + iC1_Skw_fnc + +!$omp threadprivate(igamma_Skw_fnc, iC6rt_Skw_fnc, iC6thl_Skw_fnc) +!$omp threadprivate(iC7_Skw_fnc, iC1_Skw_fnc) + + ! Sedimentation velocities + integer, public :: & + iVNr, & + iVrr, & + iVNc, & + iVrc, & + iVNsnow, & + iVrsnow, & + iVNice, & + iVrice, & + iVrgraupel + + ! Covariance of sedimentation velocity and hydrometeor, . + integer, public :: & + iVrrprrp, & + iVNrpNrp, & + iVrrprrp_net, & + iVNrpNrp_net + + +!$omp threadprivate(iVNr, iVrr, iVNc, iVrc, iVNsnow, iVrsnow, iVNice, iVrice, iVrgraupel) +!$omp threadprivate(iVrrprrp, iVNrpNrp, iVrrprrp_net, iVNrpNrp_net) + + integer, public :: & + iwp2_bt, & + iwp2_ma, & + iwp2_ta, & + iwp2_ac, & + iwp2_bp, & + iwp2_pr1, & + iwp2_pr2, & + iwp2_pr3, & + iwp2_dp1, & + iwp2_dp2, & + iwp2_4hd, & + iwp2_pd, & + iwp2_cl, & + iwp2_sf + +!$omp threadprivate(iwp2_bt, iwp2_ma, iwp2_ta, iwp2_ac, iwp2_bp) +!$omp threadprivate(iwp2_pr1, iwp2_pr2, iwp2_pr3) +!$omp threadprivate(iwp2_dp1, iwp2_dp2, iwp2_4hd) +!$omp threadprivate(iwp2_pd, iwp2_cl) + + integer, public :: & + iwprtp_bt, & + iwprtp_ma, & + iwprtp_ta, & + iwprtp_tp, & + iwprtp_ac, & + iwprtp_bp, & + iwprtp_pr1, & + iwprtp_pr2, & + iwprtp_pr3, & + iwprtp_dp1, & + iwprtp_mfl, & + iwprtp_cl, & + iwprtp_sicl, & + iwprtp_pd, & + iwprtp_forcing, & + iwprtp_mc + +!$omp threadprivate(iwprtp_bt, iwprtp_ma, iwprtp_ta, iwprtp_tp) +!$omp threadprivate(iwprtp_ac, iwprtp_bp, iwprtp_pr1, iwprtp_pr2) +!$omp threadprivate(iwprtp_pr3, iwprtp_dp1, iwprtp_mfl, iwprtp_cl) +!$omp threadprivate(iwprtp_sicl, iwprtp_pd, iwprtp_forcing, iwprtp_mc) + + integer, public :: & + iwpthlp_bt, & + iwpthlp_ma, & + iwpthlp_ta, & + iwpthlp_tp, & + iwpthlp_ac, & + iwpthlp_bp, & + iwpthlp_pr1, & + iwpthlp_pr2, & + iwpthlp_pr3, & + iwpthlp_dp1, & + iwpthlp_mfl, & + iwpthlp_cl, & + iwpthlp_sicl, & + iwpthlp_forcing, & + iwpthlp_mc + +!$omp threadprivate(iwpthlp_bt, iwpthlp_ma, iwpthlp_ta, iwpthlp_tp) +!$omp threadprivate(iwpthlp_ac, iwpthlp_bp, iwpthlp_pr1, iwpthlp_pr2) +!$omp threadprivate(iwpthlp_pr3, iwpthlp_dp1, iwpthlp_mfl, iwpthlp_cl) +!$omp threadprivate(iwpthlp_sicl, iwpthlp_forcing, iwpthlp_mc) + +! Dr. Golaz's new variance budget terms +! qt was changed to rt to avoid confusion + + integer, public :: & + irtp2_bt, & + irtp2_ma, & + irtp2_ta, & + irtp2_tp, & + irtp2_dp1, & + irtp2_dp2, & + irtp2_pd, & + irtp2_cl, & + irtp2_sf, & + irtp2_forcing, & + irtp2_mc + +!$omp threadprivate(irtp2_bt, irtp2_ma, irtp2_ta, irtp2_tp, irtp2_dp1) +!$omp threadprivate(irtp2_dp2, irtp2_pd, irtp2_cl, irtp2_sf, irtp2_forcing) +!$omp threadprivate(irtp2_mc) + + integer, public :: & + ithlp2_bt, & + ithlp2_ma, & + ithlp2_ta, & + ithlp2_tp, & + ithlp2_dp1, & + ithlp2_dp2, & + ithlp2_pd, & + ithlp2_cl, & + ithlp2_sf, & + ithlp2_forcing, & + ithlp2_mc + +!$omp threadprivate(ithlp2_bt, ithlp2_ma, ithlp2_ta, ithlp2_tp, ithlp2_dp1) +!$omp threadprivate(ithlp2_dp2, ithlp2_pd, ithlp2_cl, ithlp2_sf) +!$omp threadprivate(ithlp2_forcing, ithlp2_mc) + + integer, public :: & + irtpthlp_bt, & + irtpthlp_ma, & + irtpthlp_ta, & + irtpthlp_tp1, & + irtpthlp_tp2, & + irtpthlp_dp1, & + irtpthlp_dp2, & + irtpthlp_cl, & + irtpthlp_sf, & + irtpthlp_forcing, & + irtpthlp_mc + +!$omp threadprivate(irtpthlp_bt, irtpthlp_ma, irtpthlp_ta) +!$omp threadprivate(irtpthlp_tp1, irtpthlp_tp2, irtpthlp_dp1) +!$omp threadprivate(irtpthlp_dp2, irtpthlp_cl, irtpthlp_sf, irtpthlp_forcing) +!$omp threadprivate(irtpthlp_mc) + + integer, public :: & + iup2, & + ivp2 + +!$omp threadprivate(iup2, ivp2) + + integer, public :: & + iup2_bt, & + iup2_ta, & + iup2_tp, & + iup2_ma, & + iup2_dp1, & + iup2_dp2, & + iup2_pr1, & + iup2_pr2, & + iup2_pd, & + iup2_cl, & + iup2_sf, & + ivp2_bt, & + ivp2_ta, & + ivp2_tp, & + ivp2_ma, & + ivp2_dp1, & + ivp2_dp2, & + ivp2_pr1, & + ivp2_pr2, & + ivp2_pd, & + ivp2_cl, & + ivp2_sf + +!$omp threadprivate(iup2_bt, iup2_ta, iup2_tp, iup2_ma, iup2_dp1) +!$omp threadprivate(iup2_dp2, iup2_pr1, iup2_pr2, iup2_cl) +!$omp threadprivate(ivp2_bt, ivp2_ta, ivp2_tp, ivp2_ma, ivp2_dp1) +!$omp threadprivate(ivp2_dp2, ivp2_pr1, ivp2_pr2, ivp2_cl) +!$omp threadprivate(iup2_pd, ivp2_pd) + +! Passive scalars. Note that floating point roundoff may make +! mathematically equivalent variables different values. + integer,target, allocatable, dimension(:), public :: & + isclrprtp, & ! sclr'(1)rt' / rt'^2 + isclrp2, & ! sclr'(1)^2 / rt'^2 + isclrpthvp, & ! sclr'(1)th_v' / rt'th_v' + isclrpthlp, & ! sclr'(1)th_l' / rt'th_l' + isclrprcp, & ! sclr'(1)rc' / rt'rc' + iwpsclrp, & ! w'slcr'(1) / w'rt' + iwp2sclrp, & ! w'^2 sclr'(1) / w'^2 rt' + iwpsclrp2, & ! w'sclr'(1)^2 / w'rt'^2 + iwpsclrprtp, & ! w'sclr'(1)rt' / w'rt'^2 + iwpsclrpthlp ! w'sclr'(1)th_l' / w'rt'th_l' + +!$omp threadprivate(isclrprtp, isclrp2, isclrpthvp, isclrpthlp) +!$omp threadprivate(isclrprcp, iwpsclrp, iwp2sclrp, iwpsclrp2) +!$omp threadprivate(iwpsclrprtp, iwpsclrpthlp) + + integer, target, allocatable, dimension(:), public :: & + iwpedsclrp ! eddy sclr'(1)w' + +!$omp threadprivate(iwpedsclrp) + ! Indices for statistics in rad_zt file + integer, public :: & + iT_in_K_rad, & + ircil_rad, & + io3l_rad, & + irsnowm_rad, & + ircm_in_cloud_rad, & + icloud_frac_rad, & + iice_supersat_frac_rad, & + iradht_rad, & + iradht_LW_rad, & + iradht_SW_rad + +!$omp threadprivate(iT_in_K_rad, ircil_rad, io3l_rad) +!$omp threadprivate(irsnowm_rad, ircm_in_cloud_rad, icloud_frac_rad) +!$omp threadprivate(iradht_rad, iradht_LW_rad, iradht_SW_rad) + + ! Indices for statistics in rad_zm file + integer, public :: & + iFrad_LW_rad, & + iFrad_SW_rad, & + iFrad_SW_up_rad, & + iFrad_LW_up_rad, & + iFrad_SW_down_rad, & + iFrad_LW_down_rad + +!$omp threadprivate(iFrad_LW_rad, iFrad_SW_rad, iFrad_SW_up_rad) +!$omp threadprivate(iFrad_LW_up_rad, iFrad_SW_down_rad, iFrad_LW_down_rad) + + ! Indices for statistics in sfc file + + integer, public :: & + iustar, & + isoil_heat_flux,& + iveg_T_in_K,& + isfc_soil_T_in_K, & + ideep_soil_T_in_K,& + ilh, & + ish, & + icc, & + ilwp, & + ivwp, & ! nielsenb + iiwp, & ! nielsenb + iswp, & ! nielsenb + irwp, & + iz_cloud_base, & + iz_inversion, & + irain_rate_sfc, & ! Brian + irain_flux_sfc, & ! Brian + irrainm_sfc, & ! Brian + iwpthlp_sfc + + integer, public :: & + iwprtp_sfc, & + iupwp_sfc, & + ivpwp_sfc, & + ithlm_vert_avg, & + irtm_vert_avg, & + ium_vert_avg, & + ivm_vert_avg, & + iwp2_vert_avg, & ! nielsenb + iup2_vert_avg, & + ivp2_vert_avg, & + irtp2_vert_avg, & + ithlp2_vert_avg, & + iT_sfc ! kcwhite + + integer, public :: & + iwp23_matrix_condt_num, & + irtm_matrix_condt_num, & + ithlm_matrix_condt_num, & + irtp2_matrix_condt_num, & + ithlp2_matrix_condt_num, & + irtpthlp_matrix_condt_num, & + iup2_vp2_matrix_condt_num, & + iwindm_matrix_condt_num + + integer, public :: & + imorr_rain_rate, & + imorr_snow_rate + + integer, public :: & + irtm_spur_src, & + ithlm_spur_src +!$omp threadprivate(iustar, isoil_heat_flux, iveg_T_in_K, isfc_soil_T_in_K, ideep_soil_T_in_K, & +!$omp ilh, ish, icc, ilwp, ivwp, iiwp, iswp, irwp, iz_cloud_base, iz_inversion, & +!$omp irain_rate_sfc, irain_flux_sfc, irrainm_sfc, & +!$omp iwpthlp_sfc, iwprtp_sfc, iupwp_sfc, ivpwp_sfc, & +!$omp ithlm_vert_avg, irtm_vert_avg, ium_vert_avg, ivm_vert_avg, & +!$omp iwp2_vert_avg, iup2_vert_avg, ivp2_vert_avg, irtp2_vert_avg, ithlp2_vert_avg, iT_sfc, & +!$omp iwp23_matrix_condt_num, irtm_matrix_condt_num, ithlm_matrix_condt_num, & +!$omp irtp2_matrix_condt_num, ithlp2_matrix_condt_num, irtpthlp_matrix_condt_num, & +!$omp iup2_vp2_matrix_condt_num, iwindm_matrix_condt_num, & +!$omp imorr_rain_rate, imorr_snow_rate) + + integer, public :: & + iSkw_velocity, & ! Skewness velocity + iwp3_zm, & + ia3_coef, & + ia3_coef_zt +!$omp threadprivate(iSkw_velocity, iwp3_zm, ia3_coef, ia3_coef_zt) + + integer, public :: & + iwp3_on_wp2, & ! w'^3 / w'^2 [m/s] + iwp3_on_wp2_zt ! w'^3 / w'^2 [m/s] +!$omp threadprivate(iwp3_on_wp2, iwp3_on_wp2_zt) + + integer, public :: & + iLH_morr_rain_rate, & + iLH_morr_snow_rate +!$omp threadprivate( iLH_morr_rain_rate, iLH_morr_snow_rate ) + + integer, public :: & + iLH_vwp, & + iLH_lwp +!$omp threadprivate( iLH_vwp, iLH_lwp ) + + ! Variables that contains all the statistics + + type (stats), target, public :: zt, & ! zt grid + zm, & ! zm grid + LH_zt, & ! LH_zt grid + LH_sfc, & ! LH_sfc grid + rad_zt, & ! rad_zt grid + rad_zm, & ! rad_zm grid + sfc ! sfc + +!$omp threadprivate(zt, zm, rad_zt, rad_zm, sfc) + + ! Scratch space + + real( kind = core_rknd ), dimension(:), allocatable, public :: & + ztscr01, ztscr02, ztscr03, & + ztscr04, ztscr05, ztscr06, & + ztscr07, ztscr08, ztscr09, & + ztscr10, ztscr11, ztscr12, & + ztscr13, ztscr14, ztscr15, & + ztscr16, ztscr17, ztscr18, & + ztscr19, ztscr20, ztscr21 + +!$omp threadprivate(ztscr01, ztscr02, ztscr03, ztscr04, ztscr05) +!$omp threadprivate(ztscr06, ztscr07, ztscr08, ztscr09, ztscr10) +!$omp threadprivate(ztscr11, ztscr12, ztscr13, ztscr14, ztscr15) +!$omp threadprivate(ztscr16, ztscr17, ztscr18, ztscr19, ztscr20) +!$omp threadprivate(ztscr21) + + real( kind = core_rknd ), dimension(:), allocatable, public :: & + zmscr01, zmscr02, zmscr03, & + zmscr04, zmscr05, zmscr06, & + zmscr07, zmscr08, zmscr09, & + zmscr10, zmscr11, zmscr12, & + zmscr13, zmscr14, zmscr15, & + zmscr16, zmscr17 + +!$omp threadprivate(zmscr01, zmscr02, zmscr03, zmscr04, zmscr05) +!$omp threadprivate(zmscr06, zmscr07, zmscr08, zmscr09, zmscr10) +!$omp threadprivate(zmscr11, zmscr12, zmscr13, zmscr14, zmscr15) +!$omp threadprivate(zmscr16, zmscr17) + + real( kind = core_rknd ), dimension(:), allocatable, public :: & + radscr01, radscr02, radscr03, & + radscr04, radscr05, radscr06, & + radscr07, radscr08, radscr09, & + radscr10, radscr11, radscr12, & + radscr13, radscr14, radscr15, & + radscr16, radscr17 + +!$omp threadprivate(radscr01, radscr02, radscr03, radscr04, radscr05) +!$omp threadprivate(radscr06, radscr07, radscr08, radscr09, radscr10) +!$omp threadprivate(radscr11, radscr12, radscr13, radscr14, radscr15) +!$omp threadprivate(radscr16, radscr17) + +end module crmx_stats_variables diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 new file mode 100644 index 0000000000..a762e43cf0 --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 @@ -0,0 +1,1724 @@ +!----------------------------------------------------------------------- +! $Id: stats_zm.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ +module crmx_stats_zm + + implicit none + + private ! Default Scope + + public :: stats_init_zm + + ! Constant parameters + integer, parameter, public :: nvarmax_zm = 250 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_zm( vars_zm, l_error ) + +! Description: +! Initializes array indices for zm + +! Note: +! All code that is within subroutine stats_init_zm, including variable +! allocation code, is not called if l_stats is false. This subroutine is +! called only when l_stats is true. + +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + zm, & + iwp2, & + irtp2, & + ithlp2, & + irtpthlp, & + iwprtp, & + iwpthlp, & + iwp3_zm, & + iwp4, & + iwpthvp, & + irtpthvp, & + ithlpthvp, & + itau_zm, & + iKh_zm, & + iwprcp, & + irc_coef, & + ithlprcp, & + irtprcp, & + ircp2 + + use crmx_stats_variables, only: & + iupwp, & + ivpwp, & + irho_zm, & + isigma_sqd_w, & + irho_ds_zm, & + ithv_ds_zm, & + iem, & + ishear, & + imean_w_up, & + imean_w_down, & + iFrad, & + iFrad_LW, & + iFrad_SW, & + iFrad_LW_up, & + iFrad_SW_up, & + iFrad_LW_down, & + iFrad_SW_down, & + iFprec, & + iFcsed + + use crmx_stats_variables, only: & + iup2, & + ivp2, & + iup2_bt, & + iup2_ta, & + iup2_tp, & + iup2_ma, & + iup2_dp1, & + iup2_dp2, & + iup2_pr1, & + iup2_pr2, & + iup2_cl, & + iup2_pd, & + iup2_sf, & + ivp2_bt, & + ivp2_ta, & + ivp2_tp, & + ivp2_ma, & + ivp2_dp1, & + ivp2_dp2, & + ivp2_pr1, & + ivp2_pr2, & + ivp2_cl, & + ivp2_pd, & + ivp2_sf + + use crmx_stats_variables, only: & + iVNr, & + iVrr, & + iVNc, & + iVrc, & + iVNice, & + iVrice, & + iVNsnow, & + iVrsnow, & + iVrgraupel, & + iVrrprrp, & + iVNrpNrp, & + iVrrprrp_net, & + iVNrpNrp_net + + use crmx_stats_variables, only: & + iwp2_bt, & + iwp2_ma, & + iwp2_ta, & + iwp2_ac, & + iwp2_bp, & + iwp2_pr1, & + iwp2_pr2, & + iwp2_pr3, & + iwp2_dp1, & + iwp2_dp2, & + iwp2_4hd, & + iwp2_cl, & + iwp2_pd, & + iwp2_sf + + use crmx_stats_variables, only: & + iwprtp_bt, & + iwprtp_ma, & + iwprtp_ta, & + iwprtp_tp, & + iwprtp_ac, & + iwprtp_bp, & + iwprtp_pr1, & + iwprtp_pr2, & + iwprtp_pr3, & + iwprtp_dp1, & + iwprtp_mfl, & + iwprtp_cl, & + iwprtp_sicl, & + iwprtp_pd, & + iwprtp_forcing, & + iwprtp_mc, & + iwpthlp_bt, & + iwpthlp_ma, & + iwpthlp_ta + + use crmx_stats_variables, only: & + iwpthlp_tp, & + iwpthlp_ac, & + iwpthlp_bp, & + iwpthlp_pr1, & + iwpthlp_pr2, & + iwpthlp_pr3, & + iwpthlp_dp1, & + iwpthlp_mfl, & + iwpthlp_cl, & + iwpthlp_sicl, & + iwpthlp_forcing, & + iwpthlp_mc + + use crmx_stats_variables, only: & + irtp2_bt, & + irtp2_ma, & + irtp2_ta, & + irtp2_tp, & + irtp2_dp1, & + irtp2_dp2, & + irtp2_cl, & + irtp2_pd, & + irtp2_sf, & + irtp2_forcing, & + irtp2_mc, & + ithlp2_bt, & + ithlp2_ma, & + ithlp2_ta, & + ithlp2_tp, & + ithlp2_dp1, & + ithlp2_dp2, & + ithlp2_cl, & + ithlp2_pd + + use crmx_stats_variables, only: & + ithlp2_sf, & + ithlp2_forcing, & + ithlp2_mc, & + irtpthlp_bt, & + irtpthlp_ma, & + irtpthlp_ta, & + irtpthlp_tp1, & + irtpthlp_tp2, & + irtpthlp_dp1, & + irtpthlp_dp2, & + irtpthlp_cl, & + irtpthlp_sf, & + irtpthlp_forcing, & + irtpthlp_mc + + use crmx_stats_variables, only: & + iwpthlp_entermfl, & ! Variable(s) + iwpthlp_exit_mfl, & + iwpthlp_mfl_min, & + iwpthlp_mfl_max, & + iwprtp_enter_mfl, & + iwprtp_exit_mfl, & + iwprtp_mfl_min, & + iwprtp_mfl_max + + use crmx_stats_variables, only: & + iwm_zm, & ! Variable + icloud_frac_zm, & + iice_supersat_frac_zm, & + ircm_zm, & + irtm_zm, & + ithlm_zm + + use crmx_stats_variables, only: & + isclrprtp, & + isclrp2, & + isclrpthvp, & + isclrpthlp, & + isclrprcp, & + iwpsclrp, & + iwp2sclrp, & + iwpsclrp2, & + iwpsclrprtp, & + iwpsclrpthlp, & + iwpedsclrp + + use crmx_stats_variables, only: & + ia3_coef, & + iwp3_on_wp2, & + iSkw_velocity, & + igamma_Skw_fnc, & + iC6rt_Skw_fnc, & + iC6thl_Skw_fnc, & + iC7_Skw_fnc, & + iC1_Skw_fnc + + use crmx_stats_type, only: & + stat_assign ! Procedure + + use crmx_parameters_model, only: & + sclr_dim, & + edsclr_dim + +! use error_code, only: & +! clubb_at_least_debug_level ! Function + + implicit none + + ! Input Variable + ! zm variable names + + character(len= * ), dimension(nvarmax_zm), intent(in) :: vars_zm + + ! Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i,j, k + + logical :: l_found + + character(len=50) :: sclr_idx + +! Default initialization for array indices for zm + + iwp2 = 0 + irtp2 = 0 + ithlp2 = 0 + irtpthlp = 0 + iwprtp = 0 + iwpthlp = 0 + iwp3_zm = 0 + iwp4 = 0 + iwpthvp = 0 + irtpthvp = 0 + ithlpthvp = 0 + itau_zm = 0 + iKh_zm = 0 + iwprcp = 0 + irc_coef = 0 + ithlprcp = 0 + irtprcp = 0 + ircp2 = 0 + iupwp = 0 + ivpwp = 0 + irho_zm = 0 + isigma_sqd_w = 0 + irho_ds_zm = 0 + ithv_ds_zm = 0 + iem = 0 + ishear = 0 ! Brian + imean_w_up = 0 + imean_w_down = 0 + iFrad = 0 + iFrad_LW = 0 ! Brian + iFrad_SW = 0 ! Brian + iFrad_LW_up = 0 ! Brian + iFrad_SW_up = 0 ! Brian + iFrad_LW_down = 0 ! Brian + iFrad_SW_down = 0 ! Brian + iFprec = 0 ! Brian + iFcsed = 0 ! Brian + + + iup2 = 0 + ivp2 = 0 + + iup2_bt = 0 + iup2_ta = 0 + iup2_tp = 0 + iup2_ma = 0 + iup2_dp1 = 0 + iup2_dp2 = 0 + iup2_pr1 = 0 + iup2_pr2 = 0 + iup2_cl = 0 + iup2_sf = 0 + + ivp2_bt = 0 + ivp2_ta = 0 + ivp2_tp = 0 + ivp2_ma = 0 + ivp2_dp1 = 0 + ivp2_dp2 = 0 + ivp2_pr1 = 0 + ivp2_pr2 = 0 + ivp2_cl = 0 + ivp2_sf = 0 + + ! Sedimentation velocities + iVNr = 0 + iVrr = 0 + iVNc = 0 + iVrc = 0 + iVNice = 0 + iVrice = 0 + iVrgraupel = 0 + iVNsnow = 0 + iVrsnow = 0 + + ! Covariance of sedimentation velocity and hydrometeor, + iVrrprrp = 0 + iVNrpNrp = 0 + iVrrprrp_net = 0 + iVNrpNrp_net = 0 + + ! Vertical velocity budgets + iwp2_bt = 0 + iwp2_ma = 0 + iwp2_ta = 0 + iwp2_ac = 0 + iwp2_bp = 0 + iwp2_pr1 = 0 + iwp2_pr2 = 0 + iwp2_pr3 = 0 + iwp2_dp1 = 0 + iwp2_dp2 = 0 + iwp2_4hd = 0 + iwp2_cl = 0 + iwp2_pd = 0 + iwp2_sf = 0 + + ! Flux budgets + iwprtp_bt = 0 + iwprtp_ma = 0 + iwprtp_ta = 0 + iwprtp_tp = 0 + iwprtp_ac = 0 + iwprtp_bp = 0 + iwprtp_pr1 = 0 + iwprtp_pr2 = 0 + iwprtp_pr3 = 0 + iwprtp_dp1 = 0 + iwprtp_mfl = 0 + iwprtp_cl = 0 + iwprtp_sicl = 0 + iwprtp_pd = 0 + iwprtp_forcing = 0 + iwprtp_mc = 0 + + iwpthlp_bt = 0 + iwpthlp_ma = 0 + iwpthlp_ta = 0 + iwpthlp_tp = 0 + iwpthlp_ac = 0 + iwpthlp_bp = 0 + iwpthlp_pr1 = 0 + iwpthlp_pr2 = 0 + iwpthlp_pr3 = 0 + iwpthlp_dp1 = 0 + iwpthlp_mfl = 0 + iwpthlp_cl = 0 + iwpthlp_sicl = 0 + iwpthlp_forcing = 0 + iwpthlp_mc = 0 + + ! Variance budgets + irtp2_bt = 0 + irtp2_ma = 0 + irtp2_ta = 0 + irtp2_tp = 0 + irtp2_dp1 = 0 + irtp2_dp2 = 0 + irtp2_cl = 0 + irtp2_pd = 0 + irtp2_sf = 0 + irtp2_forcing = 0 + irtp2_mc = 0 + + ithlp2_bt = 0 + ithlp2_ma = 0 + ithlp2_ta = 0 + ithlp2_tp = 0 + ithlp2_dp1 = 0 + ithlp2_dp2 = 0 + ithlp2_cl = 0 + ithlp2_pd = 0 + ithlp2_sf = 0 + ithlp2_forcing = 0 + ithlp2_mc = 0 + + irtpthlp_bt = 0 + irtpthlp_ma = 0 + irtpthlp_ta = 0 + irtpthlp_tp1 = 0 + irtpthlp_tp2 = 0 + irtpthlp_dp1 = 0 + irtpthlp_dp2 = 0 + irtpthlp_cl = 0 + irtpthlp_sf = 0 + irtpthlp_forcing = 0 + irtpthlp_mc = 0 + + !Monatonic flux limiter diagnostic output + iwpthlp_mfl_min = 0 + iwpthlp_mfl_max = 0 + iwpthlp_entermfl = 0 + iwpthlp_exit_mfl = 0 + iwprtp_mfl_min = 0 + iwprtp_mfl_max = 0 + iwprtp_enter_mfl = 0 + iwprtp_exit_mfl = 0 + + ! Skewness velocity + iSkw_velocity = 0 + + ! Skewness function + igamma_Skw_fnc = 0 + iC6rt_Skw_fnc = 0 + iC6thl_Skw_fnc = 0 + iC7_Skw_fnc = 0 + iC1_Skw_fnc = 0 + + ia3_coef = 0 + iwp3_on_wp2 = 0 + + allocate(isclrprtp(1:sclr_dim)) + allocate(isclrp2(1:sclr_dim)) + allocate(isclrpthvp(1:sclr_dim)) + allocate(isclrpthlp(1:sclr_dim)) + allocate(isclrprcp(1:sclr_dim)) + allocate(iwpsclrp(1:sclr_dim)) + allocate(iwp2sclrp(1:sclr_dim)) + allocate(iwpsclrp2(1:sclr_dim)) + allocate(iwpsclrprtp(1:sclr_dim)) + allocate(iwpsclrpthlp(1:sclr_dim)) + + allocate(iwpedsclrp(1:edsclr_dim)) + +! Assign pointers for statistics variables zm + + isclrprtp = 0 + isclrp2 = 0 + isclrpthvp = 0 + isclrpthlp = 0 + isclrprcp = 0 + iwpsclrp = 0 + iwp2sclrp = 0 + iwpsclrp2 = 0 + iwpsclrprtp = 0 + iwpsclrpthlp = 0 + + iwpedsclrp = 0 + +! Assign pointers for statistics variables zm + + k = 1 + do i=1,zm%nn + + select case ( trim(vars_zm(i)) ) + + case ('wp2') + iwp2 = k + call stat_assign(iwp2,"wp2", & + "w'^2, Variance of vertical air velocity [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + + case ('rtp2') + irtp2 = k + call stat_assign(irtp2,"rtp2", & + "rt'^2, Variance of rt [(kg/kg)^2]","(kg/kg)^2",zm) + k = k + 1 + + case ('thlp2') + ithlp2 = k + call stat_assign(ithlp2,"thlp2", & + "thl'^2, Variance of thl [K^2]","K^2",zm) + k = k + 1 + + case ('rtpthlp') + irtpthlp = k + call stat_assign(irtpthlp,"rtpthlp", & + "rt'thl', Covariance of rt and thl [(kg K)/kg]","(kg K)/kg",zm) + k = k + 1 + + case ('wprtp') + iwprtp = k + + call stat_assign(iwprtp,"wprtp", & + "w'rt', Vertical turbulent flux of rt [(kg/kg) m/s]","(m kg)/(s kg)",zm) + k = k + 1 + + case ('wpthlp') + iwpthlp = k + + call stat_assign(iwpthlp,"wpthlp", & + "w'thl', Vertical turbulent flux of thl [K m/s]","(m K)/s",zm) + k = k + 1 + + case ('wp3_zm') + iwp3_zm = k + call stat_assign( iwp3_zm, "wp3_zm", & + "w'^3 interpolated to moment. levels [m^3/s^3]", "(m^3)/(s^3)", zm ) + k = k + 1 + + case ('wp4') + iwp4 = k + call stat_assign(iwp4,"wp4", & + "w'^4 [m^4/s^4]","(m^4)/(s^4)",zm) + k = k + 1 + + case ('wpthvp') + iwpthvp = k + call stat_assign(iwpthvp,"wpthvp", & + "Buoyancy flux [K m/s]","K m/s",zm) + k = k + 1 + + case ('rtpthvp') + irtpthvp = k + call stat_assign(irtpthvp,"rtpthvp", & + "rt'thv' [(kg/kg) K]","(kg/kg) K",zm) + k = k + 1 + + case ('thlpthvp') + ithlpthvp = k + call stat_assign(ithlpthvp,"thlpthvp", & + "thl'thv' [K^2]","K^2",zm) + k = k + 1 + + case ('tau_zm') + itau_zm = k + + call stat_assign(itau_zm,"tau_zm", & + "Time-scale tau on momentum levels [s]","s",zm) + k = k + 1 + + case ('Kh_zm') + iKh_zm = k + + call stat_assign(iKh_zm,"Kh_zm", & + "Eddy diffusivity on momentum levels [m^2/s]","m^2/s",zm) + k = k + 1 + + case ('wprcp') + iwprcp = k + call stat_assign(iwprcp,"wprcp", & + "w' rc' [(m/s) (kg/kg)]","(m/s) (kg/kg)",zm) + k = k + 1 + + case ('rc_coef') + irc_coef = k + call stat_assign(irc_coef, "rc_coef", & + "Coefficient of X' R_l' in Eq. (34)", "[-]", zm) + k = k + 1 + + case ('thlprcp') + ithlprcp = k + call stat_assign(ithlprcp,"thlprcp", & + "thl' rc' [K (kg/kg)]","K (kg/kg)",zm) + k = k + 1 + + case ('rtprcp') + irtprcp = k + + call stat_assign(irtprcp,"rtprcp", & + "rt'rc' [(kg^2)/(kg^2)]","(kg^2)/(kg^2)",zm) + k = k + 1 + + case ('rcp2') + ircp2 = k + call stat_assign(ircp2,"rcp2", & + "rc'^2 [(kg^2)/(kg^2)]","(kg^2)/(kg^2)",zm) + k = k + 1 + case ('upwp') + iupwp = k + call stat_assign(iupwp,"upwp", & + "u'w', Vertical east-west momentum flux [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + case ('vpwp') + ivpwp = k + call stat_assign(ivpwp,"vpwp", & + "v'w', Vertical north-south momentum flux [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + case ('rho_zm') + irho_zm = k + call stat_assign(irho_zm,"rho_zm", & + "Density on momentum levels [kg/m^3]","kg m^{-3}",zm) + k = k + 1 + case ('sigma_sqd_w') + isigma_sqd_w = k + call stat_assign(isigma_sqd_w,"sigma_sqd_w", & + "Nondimensionalized w variance of Gaussian component [-]","-",zm) + k = k + 1 + case ('rho_ds_zm') + irho_ds_zm = k + call stat_assign(irho_ds_zm,"rho_ds_zm", & + "Dry, static, base-state density [kg/m^3]","kg m^{-3}",zm) + k = k + 1 + case ('thv_ds_zm') + ithv_ds_zm = k + call stat_assign(ithv_ds_zm,"thv_ds_zm", & + "Dry, base-state theta_v [K]","K",zm) + k = k + 1 + case ('em') + iem = k + call stat_assign(iem,"em", & + "Turbulent kinetic energy, usu. 0.5*(u'^2+v'^2+w'^2) [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + case ('shear') ! Brian + ishear = k + call stat_assign(ishear,"shear", & + "Wind shear production term [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + case ('mean_w_up') + imean_w_up = k + call stat_assign(imean_w_up, "mean_w_up", & + "Mean w >= w_ref [m/s]", "m/s", zm) + k = k + 1 + case ('mean_w_down') + imean_w_down = k + call stat_assign(imean_w_down, "mean_w_down", & + "Mean w <= w_ref [m/s]", "m/s", zm) + k = k + 1 + case ('Frad') + iFrad = k + call stat_assign(iFrad,"Frad", & + "Total (sw+lw) net (up+down) radiative flux [W/m^2]","W/m^2",zm) + k = k + 1 + case ('Frad_LW') ! Brian + iFrad_LW = k + call stat_assign(iFrad_LW,"Frad_LW", & + "Net long-wave radiative flux [W/m^2]","W/m^2",zm) + k = k + 1 + case ('Frad_SW') ! Brian + iFrad_SW = k + + call stat_assign(iFrad_SW,"Frad_SW", & + "Net short-wave radiative flux [W/m^2]","W/m^2",zm) + k = k + 1 + + case ('Frad_LW_up') ! Brian + iFrad_LW_up = k + call stat_assign(iFrad_LW_up,"Frad_LW_up", & + "Long-wave upwelling radiative flux [W/m^2]","W/m^2",zm) + k = k + 1 + case ('Frad_SW_up') ! Brian + iFrad_SW_up = k + + call stat_assign(iFrad_SW_up,"Frad_SW_up", & + "Short-wave upwelling radiative flux [W/m^2]","W/m^2",zm) + k = k + 1 + + case ('Frad_LW_down') ! Brian + iFrad_LW_down = k + call stat_assign(iFrad_LW_down,"Frad_LW_down", & + "Long-wave downwelling radiative flux [W/m^2]", "W/m^2", zm ) + k = k + 1 + case ('Frad_SW_down') ! Brian + iFrad_SW_down = k + + call stat_assign(iFrad_SW_down,"Frad_SW_down", & + "Short-wave downwelling radiative flux [W/m^2]", "W/m^2", zm ) + k = k + 1 + + + case ('Fprec') ! Brian + iFprec = k + + call stat_assign(iFprec,"Fprec", & + "Rain flux [W/m^2]","W/m^2",zm) + k = k + 1 + + case ('Fcsed') ! Brian + iFcsed = k + + call stat_assign(iFcsed,"Fcsed", & + "cloud water sedimentation flux [kg/(s*m^2)]", & + "kg/(s*m^2)",zm) + k = k + 1 + + case ('VNr') + iVNr = k + + call stat_assign(iVNr,"VNr", & + "rrainm concentration fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrr') + iVrr = k + + call stat_assign(iVrr,"Vrr", & + "rrainm mixing ratio fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('VNc') + iVNc = k + + call stat_assign(iVNc,"VNc", & + "Nrm concentration fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrc') + iVrc = k + + call stat_assign(iVrc,"Vrc", & + "Nrm mixing ratio fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('VNsnow') + iVNsnow = k + + call stat_assign(iVNsnow,"VNsnow", & + "Snow concentration fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrsnow') + iVrsnow = k + + call stat_assign(iVrsnow,"Vrsnow", & + "Snow mixing ratio fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrgraupel') + iVrgraupel = k + + call stat_assign(iVrgraupel,"Vrgraupel", & + "Graupel sedimentation velocity [m/s]","m/s",zm) + k = k + 1 + + case ('VNice') + iVNice = k + + call stat_assign(iVNice,"VNice", & + "Cloud ice concentration fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrice') + iVrice = k + + call stat_assign(iVrice,"Vrice", & + "Cloud ice mixing ratio fallspeed [m/s]","m/s",zm) + k = k + 1 + + case ('Vrrprrp') + iVrrprrp = k + + call stat_assign( iVrrprrp, "Vrrprrp", & + "Covariance of V_rr (r_r sed. vel.) and r_r [(m/s)(kg/kg)]", & + "(m/s)(kg/kg)", zm ) + k = k + 1 + + case ('VNrpNrp') + iVNrpNrp = k + + call stat_assign( iVNrpNrp, "VNrpNrp", & + "Covariance of V_Nr (N_r sed. vel.) and N_r [(m/s)(num/kg)]", & + "(m/s)(num/kg)", zm ) + k = k + 1 + + case ('Vrrprrp_net') + iVrrprrp_net = k + + call stat_assign( iVrrprrp_net, "Vrrprrp_net", & + "Adjusted value of < V_rr'r_r' > (turb. sed. flux limiter)" & + //" [(m/s)(kg/kg)]", "(m/s)(kg/kg)", zm ) + k = k + 1 + + case ('VNrpNrp_net') + iVNrpNrp_net = k + + call stat_assign( iVNrpNrp_net, "VNrpNrp_net", & + "Adjusted value of < V_Nr'N_r' > (turb. sed. flux limiter)" & + //" [(m/s)(num/kg)]", "(m/s)(num/kg)", zm ) + k = k + 1 + + case ('wp2_bt') + iwp2_bt = k + + call stat_assign(iwp2_bt,"wp2_bt", & + "wp2 budget: wp2 time tendency [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_ma') + iwp2_ma = k + + call stat_assign(iwp2_ma,"wp2_ma", & + "wp2 budget: wp2 vertical mean advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_ta') + iwp2_ta = k + + call stat_assign(iwp2_ta,"wp2_ta", & + "wp2 budget: wp2 turbulent advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_ac') + iwp2_ac = k + + call stat_assign(iwp2_ac,"wp2_ac", & + "wp2 budget: wp2 accumulation term [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_bp') + iwp2_bp = k + + call stat_assign(iwp2_bp,"wp2_bp", & + "wp2 budget: wp2 buoyancy production [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_pr1') + iwp2_pr1 = k + + call stat_assign(iwp2_pr1,"wp2_pr1", & + "wp2 budget: wp2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_pr2') + iwp2_pr2 = k + call stat_assign(iwp2_pr2,"wp2_pr2", & + "wp2 budget: wp2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_pr3') + iwp2_pr3 = k + call stat_assign(iwp2_pr3,"wp2_pr3", & + "wp2 budget: wp2 pressure term 3 [m^2/s^3]","m^2/s^3",zm) + + k = k + 1 + + case ('wp2_dp1') + iwp2_dp1 = k + call stat_assign(iwp2_dp1,"wp2_dp1", & + "wp2 budget: wp2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('wp2_dp2') + iwp2_dp2 = k + call stat_assign(iwp2_dp2,"wp2_dp2", & + "wp2 budget: wp2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) + + k = k + 1 + + case ('wp2_4hd') + iwp2_4hd = k + call stat_assign(iwp2_4hd,"wp2_4hd", & + "wp2 budget: wp2 4th-order hyper-diffusion [m^2/s^3]","m^2/s^3",zm) + + k = k + 1 + + case ('wp2_cl') + iwp2_cl = k + + call stat_assign(iwp2_cl,"wp2_cl", & + "wp2 budget: wp2 clipping term [m^2/s^3]","m^2/s^3",zm) + + k = k + 1 + + case ('wp2_pd') + iwp2_pd = k + + call stat_assign(iwp2_pd,"wp2_pd", & + "wp2 budget: wp2 positive definite adjustment [m^2/s^3]","m2/s3",zm) + + k = k + 1 + + case ('wp2_sf') + iwp2_sf = k + + call stat_assign( iwp2_sf, "wp2_sf", & + "wp2 budget: wp2 surface variance [m^2/s^3]","m2/s3",zm) + + k = k + 1 + + case ('wprtp_bt') + iwprtp_bt = k + call stat_assign(iwprtp_bt,"wprtp_bt", & + "wprtp budget: wprtp time tendency [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_ma') + iwprtp_ma = k + + call stat_assign(iwprtp_ma,"wprtp_ma", & + "wprtp budget: wprtp mean advection [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_ta') + iwprtp_ta = k + + call stat_assign(iwprtp_ta,"wprtp_ta", & + "wprtp budget: wprtp turbulent advection [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_tp') + iwprtp_tp = k + + call stat_assign(iwprtp_tp,"wprtp_tp", & + "wprtp budget: wprtp turbulent production [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_ac') + iwprtp_ac = k + + call stat_assign(iwprtp_ac,"wprtp_ac", & + "wprtp budget: wprtp accumulation term [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_bp') + iwprtp_bp = k + + call stat_assign(iwprtp_bp,"wprtp_bp", & + "wprtp budget: wprtp buoyancy production [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_pr1') + iwprtp_pr1 = k + + call stat_assign(iwprtp_pr1,"wprtp_pr1", & + "wprtp budget: wprtp pressure term 1 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_pr2') + iwprtp_pr2 = k + + call stat_assign(iwprtp_pr2,"wprtp_pr2", & + "wprtp budget: wprtp pressure term 2 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_pr3') + iwprtp_pr3 = k + + call stat_assign(iwprtp_pr3,"wprtp_pr3", & + "wprtp budget: wprtp pressure term 3 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_dp1') + iwprtp_dp1 = k + + call stat_assign(iwprtp_dp1,"wprtp_dp1", & + "wprtp budget: wprtp dissipation term 1 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_mfl') + iwprtp_mfl = k + + call stat_assign(iwprtp_mfl,"wprtp_mfl", & + "wprtp budget: wprtp monotonic flux limiter [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_cl') + iwprtp_cl = k + + call stat_assign(iwprtp_cl,"wprtp_cl", & + "wprtp budget: wprtp clipping term [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_sicl') + iwprtp_sicl = k + + call stat_assign(iwprtp_sicl,"wprtp_sicl", & + "wprtp budget: wprtp semi-implicit clipping term [(m kg)/(s^2 kg)]", & + "(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_pd') + iwprtp_pd = k + + call stat_assign(iwprtp_pd,"wprtp_pd", & + "wprtp budget: wprtp flux corrected trans. term [(m kg)/(s^2 kg)]", & + "(m kg)/(s^2 kg)",zm) + k = k + 1 + + case ('wprtp_forcing') + iwprtp_forcing = k + + call stat_assign( iwprtp_forcing, "wprtp_forcing", & + "wprtp budget: wprtp forcing (includes microphysics tendency) [(m kg/kg)/s^2]", & + "(m kg/kg)/s^2", zm ) + k = k + 1 + + case ('wprtp_mc') + iwprtp_mc = k + + call stat_assign( iwprtp_mc, "wprtp_mc", & + "Microphysics tendency for wprtp (not in budget) [(m kg/kg)/s^2]", & + "(m kg/kg)/s^2", zm ) + k = k + 1 + + case ('wpthlp_bt') + iwpthlp_bt = k + + call stat_assign(iwpthlp_bt,"wpthlp_bt", & + "wpthlp budget: [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_ma') + iwpthlp_ma = k + call stat_assign(iwpthlp_ma,"wpthlp_ma", & + "wpthlp budget: wpthlp mean advection [(m K)/s^2]","(m K)/s^2",zm) + + k = k + 1 + + case ('wpthlp_ta') + iwpthlp_ta = k + call stat_assign(iwpthlp_ta,"wpthlp_ta", & + "wpthlp budget: wpthlp turbulent advection [(m K)/s^2]","(m K)/s^2",zm) + + k = k + 1 + + case ('wpthlp_tp') + iwpthlp_tp = k + call stat_assign(iwpthlp_tp,"wpthlp_tp", & + "wpthlp budget: wpthlp turbulent production [(m K)/s^2]","(m K)/s^2",zm) + + k = k + 1 + + case ('wpthlp_ac') + iwpthlp_ac = k + call stat_assign(iwpthlp_ac,"wpthlp_ac", & + "wpthlp budget: wpthlp accumulation term [(m K)/s^2]","(m K)/s^2",zm) + + k = k + 1 + + case ('wpthlp_bp') + iwpthlp_bp = k + call stat_assign(iwpthlp_bp,"wpthlp_bp", & + "wpthlp budget: wpthlp buoyancy production [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_pr1') + iwpthlp_pr1 = k + + call stat_assign(iwpthlp_pr1,"wpthlp_pr1", & + "wpthlp budget: wpthlp pressure term 1 [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_pr2') + iwpthlp_pr2 = k + + call stat_assign(iwpthlp_pr2,"wpthlp_pr2", & + "wpthlp budget: wpthlp pressure term 2 [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_pr3') + iwpthlp_pr3 = k + call stat_assign(iwpthlp_pr3,"wpthlp_pr3", & + "wpthlp budget: wpthlp pressure term 3 [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_dp1') + iwpthlp_dp1 = k + call stat_assign(iwpthlp_dp1,"wpthlp_dp1", & + "wpthlp budget: wpthlp dissipation term 1 [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_mfl') + iwpthlp_mfl = k + call stat_assign(iwpthlp_mfl,"wpthlp_mfl", & + "wpthlp budget: wpthlp monotonic flux limiter [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_cl') + iwpthlp_cl = k + call stat_assign(iwpthlp_cl,"wpthlp_cl", & + "wpthlp budget: wpthlp clipping term [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_sicl') + iwpthlp_sicl = k + call stat_assign(iwpthlp_sicl,"wpthlp_sicl", & + "wpthlp budget: wpthlp semi-implicit clipping term [(m K)/s^2]","(m K)/s^2",zm) + k = k + 1 + + case ('wpthlp_forcing') + iwpthlp_forcing = k + + call stat_assign( iwpthlp_forcing, "wpthlp_forcing", & + "wpthlp budget: wpthlp forcing (includes microphysics tendency) [(m K)/s^2]", & + "(m K)/s^2", zm ) + k = k + 1 + + case ('wpthlp_mc') + iwpthlp_mc = k + + call stat_assign( iwpthlp_mc, "wpthlp_mc", & + "Microphysics tendency for wpthlp (not in budget) [(m K)/s^2]", & + "(m K)/s^2", zm ) + k = k + 1 + + ! Variance budgets + case ('rtp2_bt') + irtp2_bt = k + call stat_assign(irtp2_bt,"rtp2_bt", & + "rtp2 budget: rtp2 time tendency [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_ma') + irtp2_ma = k + call stat_assign(irtp2_ma,"rtp2_ma", & + "rtp2 budget: rtp2 mean advection [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_ta') + irtp2_ta = k + call stat_assign(irtp2_ta,"rtp2_ta", & + "rtp2 budget: rtp2 turbulent advection [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_tp') + irtp2_tp = k + call stat_assign(irtp2_tp,"rtp2_tp", & + "rtp2 budget: rtp2 turbulent production [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_dp1') + irtp2_dp1 = k + call stat_assign(irtp2_dp1,"rtp2_dp1", & + "rtp2 budget: rtp2 dissipation term 1 [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_dp2') + irtp2_dp2 = k + call stat_assign(irtp2_dp2,"rtp2_dp2", & + "rtp2 budget: rtp2 dissipation term 2 [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + case ('rtp2_cl') + irtp2_cl = k + call stat_assign(irtp2_cl,"rtp2_cl", & + "rtp2 budget: rtp2 clipping term [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) + k = k + 1 + + case ('rtp2_pd') + irtp2_pd = k + call stat_assign( irtp2_pd, "rtp2_pd", & + "rtp2 budget: rtp2 positive definite adjustment [(kg^2)/(kg^2 s)]", & + "(kg^2)/(kg^2 s)", zm ) + k = k + 1 + + case ('rtp2_sf') + irtp2_sf = k + call stat_assign( irtp2_sf, "rtp2_sf", & + "rtp2 budget: rtp2 surface variance [(kg^2)/(kg^2 s)]", & + "(kg^2)/(kg^2 s)", zm ) + k = k + 1 + + case ('rtp2_forcing') + irtp2_forcing = k + + call stat_assign( irtp2_forcing, "rtp2_forcing", & + "rtp2 budget: rtp2 forcing (includes microphysics tendency) [(kg/kg)^2/s]", & + "(kg/kg)^2/s", zm ) + k = k + 1 + + case ('rtp2_mc') + irtp2_mc = k + + call stat_assign( irtp2_mc, "rtp2_mc", & + "Microphysics tendency for rtp2 (not in budget) [(kg/kg)^2/s]", & + "(kg/kg)^2/s", zm ) + k = k + 1 + + case ('thlp2_bt') + ithlp2_bt = k + call stat_assign(ithlp2_bt,"thlp2_bt", & + "thlp2 budget: thlp2 time tendency [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_ma') + ithlp2_ma = k + call stat_assign(ithlp2_ma,"thlp2_ma", & + "thlp2 budget: thlp2 mean advection [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_ta') + ithlp2_ta = k + call stat_assign(ithlp2_ta,"thlp2_ta", & + "thlp2 budget: thlp2 turbulent advection [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_tp') + ithlp2_tp = k + call stat_assign(ithlp2_tp,"thlp2_tp", & + "thlp2 budget: thlp2 turbulent production [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_dp1') + ithlp2_dp1 = k + call stat_assign(ithlp2_dp1,"thlp2_dp1", & + "thlp2 budget: thlp2 dissipation term 1 [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_dp2') + ithlp2_dp2 = k + call stat_assign(ithlp2_dp2,"thlp2_dp2", & + "thlp2 budget: thlp2 dissipation term 2 [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + case ('thlp2_cl') + ithlp2_cl = k + call stat_assign(ithlp2_cl,"thlp2_cl", & + "thlp2 budget: thlp2 clipping term [(K^2)/s]","(K^2)/s",zm) + k = k + 1 + + case ('thlp2_pd') + ithlp2_pd = k + call stat_assign( ithlp2_pd, "thlp2_pd", & + "thlp2 budget: thlp2 positive definite adjustment [(K^2)/s]", "K^2/s", zm ) + k = k + 1 + + case ('thlp2_sf') + ithlp2_sf = k + call stat_assign( ithlp2_sf, "thlp2_sf", & + "thlp2 budget: thlp2 surface variance [(K^2)/s]", "K^2/s", zm ) + k = k + 1 + case ('thlp2_forcing') + ithlp2_forcing = k + call stat_assign( ithlp2_forcing, "thlp2_forcing", & + "thlp2 budget: thlp2 forcing (includes microphysics tendency) [K^2/s]", & + "K^2/s", zm ) + k = k + 1 + case ('thlp2_mc') + ithlp2_mc = k + call stat_assign( ithlp2_mc, "thlp2_mc", & + "Microphysics tendency for thlp2 (not in budget) [K^2/s]", & + "K^2/s", zm ) + k = k + 1 + + case ('rtpthlp_bt') + irtpthlp_bt = k + call stat_assign(irtpthlp_bt,"rtpthlp_bt", & + "rtpthlp budget: rtpthlp time tendency [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_ma') + irtpthlp_ma = k + call stat_assign(irtpthlp_ma,"rtpthlp_ma", & + "rtpthlp budget: rtpthlp mean advection [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_ta') + irtpthlp_ta = k + call stat_assign(irtpthlp_ta,"rtpthlp_ta", & + "rtpthlp budget: rtpthlp turbulent advection [](kg K)/(kg s)","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_tp1') + irtpthlp_tp1 = k + call stat_assign(irtpthlp_tp1,"rtpthlp_tp1", & + "rtpthlp budget: rtpthlp turbulent production 1 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_tp2') + irtpthlp_tp2 = k + call stat_assign(irtpthlp_tp2,"rtpthlp_tp2", & + "rtpthlp budget: rtpthlp turbulent production 2 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_dp1') + irtpthlp_dp1 = k + call stat_assign(irtpthlp_dp1,"rtpthlp_dp1", & + "rtpthlp budget: rtpthlp dissipation term 1 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_dp2') + irtpthlp_dp2 = k + call stat_assign(irtpthlp_dp2,"rtpthlp_dp2", & + "rtpthlp budget: rtpthlp dissipation term 2 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_cl') + irtpthlp_cl = k + call stat_assign(irtpthlp_cl,"rtpthlp_cl", & + "rtpthlp budget: rtpthlp clipping term [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_sf') + irtpthlp_sf = k + call stat_assign(irtpthlp_sf,"rtpthlp_sf", & + "rtpthlp budget: rtpthlp surface variance [(kg K)/(kg s)]","(kg K)/(kg s)",zm) + k = k + 1 + case ('rtpthlp_forcing') + irtpthlp_forcing = k + call stat_assign( irtpthlp_forcing, "rtpthlp_forcing", & + "rtpthlp budget: rtpthlp forcing (includes microphysics tendency) [(K kg/kg)/s]", & + "(K kg/kg)/s", zm ) + k = k + 1 + case ('rtpthlp_mc') + irtpthlp_mc = k + call stat_assign( irtpthlp_mc, "rtpthlp_mc", & + "Microphysics tendency for rtpthlp (not in budget) [(K kg/kg)/s]", & + "(K kg/kg)/s", zm ) + k = k + 1 + + case ('up2') + iup2 = k + call stat_assign(iup2,"up2", & + "u'^2 (momentum levels) [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + + case ('vp2') + ivp2 = k + call stat_assign(ivp2,"vp2", & + "v'^2 (momentum levels) [m^2/s^2]","m^2/s^2",zm) + k = k + 1 + + case ('up2_bt') + iup2_bt = k + call stat_assign(iup2_bt,"up2_bt", & + "up2 budget: up2 time tendency [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_ma') + iup2_ma = k + call stat_assign(iup2_ma,"up2_ma", & + "up2 budget: up2 mean advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_ta') + iup2_ta = k + call stat_assign(iup2_ta,"up2_ta", & + "up2 budget: up2 turbulent advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_tp') + iup2_tp = k + call stat_assign(iup2_tp,"up2_tp", & + "up2 budget: up2 turbulent production [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_dp1') + iup2_dp1 = k + call stat_assign(iup2_dp1,"up2_dp1", & + "up2 budget: up2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_dp2') + iup2_dp2 = k + call stat_assign(iup2_dp2,"up2_dp2", & + "up2 budget: up2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_pr1') + iup2_pr1 = k + call stat_assign(iup2_pr1,"up2_pr1", & + "up2 budget: up2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_pr2') + iup2_pr2 = k + call stat_assign(iup2_pr2,"up2_pr2", & + "up2 budget: up2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_cl') + iup2_cl = k + call stat_assign(iup2_cl,"up2_cl", & + "up2 budget: up2 clipping [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('up2_pd') + iup2_pd = k + call stat_assign( iup2_pd, "up2_pd", & + "up2 budget: up2 positive definite adjustment [m^2/s^3]", "m^2/s^3", zm ) + k = k + 1 + + case ('up2_sf') + iup2_sf = k + call stat_assign(iup2_sf,"up2_sf", & + "up2 budget: up2 surface variance [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_bt') + ivp2_bt = k + call stat_assign(ivp2_bt,"vp2_bt", & + "vp2 budget: vp2 time tendency [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_ma') + ivp2_ma = k + call stat_assign(ivp2_ma,"vp2_ma", & + "vp2 budget: vp2 mean advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_ta') + ivp2_ta = k + call stat_assign(ivp2_ta,"vp2_ta", & + "vp2 budget: vp2 turbulent advection [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_tp') + ivp2_tp = k + call stat_assign(ivp2_tp,"vp2_tp", & + "vp2 budget: vp2 turbulent production [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_dp1') + ivp2_dp1 = k + call stat_assign(ivp2_dp1,"vp2_dp1", & + "vp2 budget: vp2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_dp2') + ivp2_dp2 = k + call stat_assign(ivp2_dp2,"vp2_dp2", & + "vp2 budget: vp2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_pr1') + ivp2_pr1 = k + call stat_assign(ivp2_pr1,"vp2_pr1", & + "vp2 budget: vp2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_pr2') + ivp2_pr2 = k + call stat_assign(ivp2_pr2,"vp2_pr2", & + "vp2 budget: vp2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_cl') + ivp2_cl = k + call stat_assign(ivp2_cl,"vp2_cl", & + "vp2 budget: vp2 clipping [m^2/s^3]","m^2/s^3",zm) + k = k + 1 + + case ('vp2_pd') + ivp2_pd = k + call stat_assign( ivp2_pd, "vp2_pd", & + "vp2 budget: vp2 positive definite adjustment [m^2/s^3]", "m^2/s^3", zm ) + k = k + 1 + + case ('vp2_sf') + ivp2_sf = k + call stat_assign( ivp2_sf, "vp2_sf", & + "vp2 budget: vp2 surface variance [m^2/s^3]", "m^2/s^3", zm ) + k = k + 1 + + case ('wpthlp_entermfl') + iwpthlp_entermfl = k + call stat_assign( iwpthlp_entermfl, "wpthlp_entermfl", & + "Wpthlp entering flux limiter [(m K)/s]", "(m K)/s", zm ) + k = k + 1 + + case ('wpthlp_exit_mfl') + iwpthlp_exit_mfl = k + call stat_assign( iwpthlp_exit_mfl, "wpthlp_exit_mfl", & + "Wpthlp exiting flux limiter [](m K)/s", "(m K)/s", zm ) + k = k + 1 + + case ('wpthlp_mfl_min') + iwpthlp_mfl_min = k + call stat_assign( iwpthlp_mfl_min, "wpthlp_mfl_min", & + "Minimum allowable wpthlp [(m K)/s]", "(m K)/s", zm ) + k = k + 1 + + case ('wpthlp_mfl_max') + iwpthlp_mfl_max = k + call stat_assign( iwpthlp_mfl_max, "wpthlp_mfl_max", & + "Maximum allowable wpthlp ((m K)/s) [(m K)/s]", "(m K)/s", zm ) + k = k + 1 + + case ('wprtp_mfl_min') + iwprtp_mfl_min = k + call stat_assign( iwprtp_mfl_min, "wprtp_mfl_min", & + "Minimum allowable wprtp [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) + k = k + 1 + + case ('wprtp_mfl_max') + iwprtp_mfl_max = k + call stat_assign( iwprtp_mfl_max, "wprtp_mfl_max", & + "Maximum allowable wprtp [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) + k = k + 1 + + case ('wprtp_enter_mfl') + iwprtp_enter_mfl = k + call stat_assign( iwprtp_enter_mfl, "wprtp_enter_mfl", & + "Wprtp entering flux limiter [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) + k = k + 1 + + case ('wprtp_exit_mfl') + iwprtp_exit_mfl = k + call stat_assign( iwprtp_exit_mfl, "wprtp_exit_mfl", & + "Wprtp exiting flux limiter [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) + k = k + 1 + + case ('wm_zm') + iwm_zm = k + call stat_assign( iwm_zm, "wm_zm", & + "Vertical (w) wind [m/s]", "m/s", zm ) + k = k + 1 + + case ('cloud_frac_zm') + icloud_frac_zm = k + call stat_assign( icloud_frac_zm, "cloud_frac_zm", & + "Cloud fraction", "count", zm ) + k = k + 1 + + case ('ice_supersat_frac_zm') + iice_supersat_frac_zm = k + call stat_assign( iice_supersat_frac_zm, "ice_supersat_frac_zm", & + "Ice cloud fraction", "count", zm ) + k = k + 1 + + case ('rcm_zm') + ircm_zm = k + call stat_assign( ircm_zm, "rcm_zm", & + "Total water mixing ratio [kg/kg]", "kg/kg", zm ) + k = k + 1 + + case ('rtm_zm') + irtm_zm = k + call stat_assign( irtm_zm, "rtm_zm", & + "Total water mixing ratio [kg/kg]", "kg/kg", zm ) + k = k + 1 + + case ('thlm_zm') + ithlm_zm = k + call stat_assign( ithlm_zm, "thlm_zm", & + "Liquid potential temperature [K]", "K", zm ) + k = k + 1 + + case ( 'Skw_velocity' ) + iSkw_velocity = k + call stat_assign( iSkw_velocity, "Skw_velocity", & + "Skewness velocity [m/s]", "m/s", zm ) + k = k + 1 + + case ( 'gamma_Skw_fnc' ) + igamma_Skw_fnc = k + call stat_assign( igamma_Skw_fnc, "gamma_Skw_fnc", & + "Gamma as a function of skewness [-]", "count", zm ) + k = k + 1 + + case ( 'C6rt_Skw_fnc' ) + iC6rt_Skw_fnc = k + call stat_assign( iC6rt_Skw_fnc, "C6rt_Skw_fnc", & + "C_6rt parameter with Sk_w applied [-]", "count", zm ) + k = k + 1 + + case ( 'C6thl_Skw_fnc' ) + iC6thl_Skw_fnc = k + call stat_assign( iC6thl_Skw_fnc, "C6thl_Skw_fnc", & + "C_6thl parameter with Sk_w applied [-]", "count", zm ) + k = k + 1 + + case ( 'C7_Skw_fnc' ) + iC7_Skw_fnc = k + call stat_assign( iC7_Skw_fnc, "C7_Skw_fnc", & + "C_7 parameter with Sk_w applied [-]", "count", zm ) + k = k + 1 + + case ( 'C1_Skw_fnc' ) + iC1_Skw_fnc = k + call stat_assign( iC1_Skw_fnc, "C1_Skw_fnc", & + "C_1 parameter with Sk_w applied [-]", "count", zm ) + k = k + 1 + + case ( 'a3_coef' ) + ia3_coef = k + call stat_assign( ia3_coef, "a3_coef", & + "Quantity in formula 25 from Equations for CLUBB [-]", "count", zm ) + k = k + 1 + + case ( 'wp3_on_wp2' ) + iwp3_on_wp2 = k + call stat_assign( iwp3_on_wp2, "wp3_on_wp2", & + "Smoothed version of wp3 / wp2 [m/s]", "m/s", zm ) + k = k + 1 + + case default + l_found = .false. + + j = 1 + + do while( j <= sclr_dim .and. .not. l_found ) + write( sclr_idx, * ) j + sclr_idx = adjustl(sclr_idx) + + if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'prtp'.and. .not. l_found ) then + isclrprtp(j) = k + + call stat_assign(isclrprtp(j),"sclr"//trim(sclr_idx)//"prtp", & + "scalar("//trim(sclr_idx)//")'rt'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'p2'.and. .not. l_found ) then + isclrp2(j) = k + call stat_assign(isclrp2(j) ,"sclr"//trim(sclr_idx)//"p2", & + "scalar("//trim(sclr_idx)//")'^2'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'pthvp'.and. .not. l_found ) then + isclrpthvp(j) = k + call stat_assign(isclrpthvp(j),"sclr"//trim(sclr_idx)//"pthvp", & + "scalar("//trim(sclr_idx)//")'th_v'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'pthlp'.and. .not. l_found ) then + isclrpthlp(j) = k + + call stat_assign(isclrpthlp(j),"sclr"//trim(sclr_idx)//"pthlp", & + "scalar("//trim(sclr_idx)//")'th_l'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'prcp'.and. .not. l_found ) then + + isclrprcp(j) = k + + call stat_assign(isclrprcp(j),"sclr"//trim(sclr_idx)//"prcp", & + "scalar("//trim(sclr_idx)//")'rc'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then + iwpsclrp(j) = k + + call stat_assign(iwpsclrp(j),"wpsclr"//trim(sclr_idx)//"p", & + "'w'scalar("//trim(sclr_idx)//")","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'p2'.and. .not. l_found ) then + + iwpsclrp2(j) = k + + call stat_assign(iwpsclrp2(j),"wpsclr"//trim(sclr_idx)//"p2", & + "'w'scalar("//trim(sclr_idx)//")'^2'","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'wp2sclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then + + iwp2sclrp(j) = k + + call stat_assign(iwp2sclrp(j) ,"wp2sclr"//trim(sclr_idx)//"p", & + "'w'^2 scalar("//trim(sclr_idx)//")","unknown",zm) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'prtp'.and. .not. l_found ) then + iwpsclrprtp(j) = k + + call stat_assign( iwpsclrprtp(j),"wpsclr"//trim(sclr_idx)//"prtp", & + "'w' scalar("//trim(sclr_idx)//")'rt'","unknown",zm ) + k = k + 1 + l_found = .true. + end if + if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'pthlp'.and. .not. l_found ) then + iwpsclrpthlp(j) = k + + call stat_assign(iwpsclrpthlp(j),"wpsclr"//trim(sclr_idx)//"pthlp", & + "'w' scalar("//trim(sclr_idx)//")'th_l'","unknown",zm) + k = k + 1 + l_found = .true. + end if + j = j + 1 + end do + + j = 1 + + do while( j <= edsclr_dim .and. .not. l_found ) + + write( sclr_idx, * ) j + sclr_idx = adjustl(sclr_idx) + + if( trim(vars_zm(i)) == 'wpedsclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then + iwpedsclrp(j) = k + + call stat_assign(iwpedsclrp(j),"wpedsclr"//trim(sclr_idx)//"p", & + "eddy scalar("//trim(sclr_idx)//")'w'","unknown",zm) + k = k + 1 + l_found = .true. + end if + + j = j + 1 + + end do + + if( .not. l_found ) then + write(fstderr,*) 'Error: unrecognized variable in vars_zm: ', trim(vars_zm(i)) + l_error = .true. ! This will stop the run. + end if + end select + + end do + +! Non-interative diagnostics (zm) +! iwp4, ircp2 + +! if ( .not. clubb_at_least_debug_level( 1 ) ) then +! if ( iwp4 + ircp2 + ishear > 0 ) then +! write(fstderr,'(a)') & +! "Warning: at debug level 0. Non-interactive diagnostics will not be computed, " +! write(fstderr,'(a)') "but some appear in the stats_zm namelist variable." +! end if +! end if + + return + end subroutine stats_init_zm + +end module crmx_stats_zm diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 new file mode 100644 index 0000000000..ea9ee63fea --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 @@ -0,0 +1,3221 @@ +!----------------------------------------------------------------------- +! $Id: stats_zt.F90 6153 2013-04-09 22:13:27Z bmg2@uwm.edu $ + +module crmx_stats_zt + + implicit none + + private ! Default Scope + + public :: stats_init_zt + +! Constant parameters + integer, parameter, public :: nvarmax_zt = 350 ! Maximum variables allowed + + contains + +!----------------------------------------------------------------------- + subroutine stats_init_zt( vars_zt, l_error ) + +! Description: +! Initializes array indices for zt + +! Note: +! All code that is within subroutine stats_init_zt, including variable +! allocation code, is not called if l_stats is false. This subroutine is +! called only when l_stats is true. + +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + ithlm, & ! Variable(s) + iT_in_K, & + ithvm, & + irtm, & + ircm, & + irfrzm, & + irvm, & + ium, & + ivm, & + iwm_zt, & + ium_ref, & + ivm_ref, & + iug, & + ivg, & + icloud_frac, & + iice_supersat_frac, & + ircm_in_layer, & + ircm_in_cloud, & + icloud_cover, & + ip_in_Pa, & + iexner, & + irho_ds_zt, & + ithv_ds_zt, & + iLscale + + use crmx_stats_variables, only: & + iwp3, & ! Variable(s) + iwpthlp2, & + iwp2thlp, & + iwprtp2, & + iwp2rtp, & + iLscale_up, & + iLscale_down, & + itau_zt, & + iKh_zt, & + iwp2thvp, & + iwp2rcp, & + iwprtpthlp, & + isigma_sqd_w_zt + + use crmx_stats_variables, only: & + irr1, & ! Variable(s) + irr2, & + iNr1, & + iNr2, & + iLWP1, & + iLWP2, & + iprecip_frac, & + iprecip_frac_1, & + iprecip_frac_2 + + use crmx_stats_variables, only: & + imu_rr_1, & ! Variable(s) + imu_rr_2, & + imu_Nr_1, & + imu_Nr_2, & + imu_Nc_1, & + imu_Nc_2, & + imu_rr_1_n, & + imu_rr_2_n, & + imu_Nr_1_n, & + imu_Nr_2_n, & + imu_Nc_1_n, & + imu_Nc_2_n, & + isigma_rr_1, & + isigma_rr_2, & + isigma_Nr_1, & + isigma_Nr_2, & + isigma_Nc_1, & + isigma_Nc_2, & + isigma_rr_1_n, & + isigma_rr_2_n, & + isigma_Nr_1_n, & + isigma_Nr_2_n, & + isigma_Nc_1_n, & + isigma_Nc_2_n + + use crmx_stats_variables, only: & + icorr_srr_1, & ! Variable(s) + icorr_srr_2, & + icorr_sNr_1, & + icorr_sNr_2, & + icorr_sNc_1, & + icorr_sNc_2, & + icorr_trr_1, & + icorr_trr_2, & + icorr_tNr_1, & + icorr_tNr_2, & + icorr_tNc_1, & + icorr_tNc_2, & + icorr_rrNr_1, & + icorr_rrNr_2, & + icorr_srr_1_n, & + icorr_srr_2_n, & + icorr_sNr_1_n, & + icorr_sNr_2_n, & + icorr_sNc_1_n, & + icorr_sNc_2_n, & + icorr_trr_1_n, & + icorr_trr_2_n, & + icorr_tNr_1_n, & + icorr_tNr_2_n, & + icorr_tNc_1_n, & + icorr_tNc_2_n, & + icorr_rrNr_1_n, & + icorr_rrNr_2_n + + use crmx_stats_variables, only: & ! janhft 09/25/12 + icorr_sw, & ! Variable(s) + icorr_wrr, & + icorr_wNr, & + icorr_wNc + + use crmx_stats_variables, only: & + irel_humidity, & + irho, & + iNcm, & + iNcm_in_cloud, & + iNc_activated, & + iNcnm, & + isnowslope, & + ised_rcm, & + irsat, & + irsati, & + irrainm, & + iNrm, & + irain_rate_zt, & + iradht, & + iradht_LW, & + iradht_SW, & + idiam, & + imass_ice_cryst, & + ircm_icedfs, & + iu_T_cm, & + im_vol_rad_rain, & + im_vol_rad_cloud, & + irsnowm, & + irgraupelm, & + iricem + + use crmx_stats_variables, only: & + ieff_rad_cloud, & + ieff_rad_ice, & + ieff_rad_snow, & + ieff_rad_rain, & + ieff_rad_graupel + + use crmx_stats_variables, only: & + irtm_bt, & + irtm_ma, & + irtm_ta, & + irtm_forcing, & + irtm_mc, & + irtm_sdmp, & + ircm_mc, & + ircm_sd_mg_morr, & + irvm_mc, & + irtm_mfl, & + irtm_tacl, & + irtm_cl, & + irtm_pd, & + ithlm_bt, & + ithlm_ma, & + ithlm_ta, & + ithlm_forcing, & + ithlm_mc, & + ithlm_sdmp + + use crmx_stats_variables, only: & + ithlm_mfl, & + ithlm_tacl, & + ithlm_cl, & + iwp3_bt, & + iwp3_ma, & + iwp3_ta, & + iwp3_tp, & + iwp3_ac, & + iwp3_bp1, & + iwp3_bp2, & + iwp3_pr1, & + iwp3_pr2, & + iwp3_dp1, & + iwp3_4hd, & + iwp3_cl + + ! Monotonic flux limiter diagnostic variables + use crmx_stats_variables, only: & + ithlm_mfl_min, & + ithlm_mfl_max, & + irtm_mfl_min, & + irtm_mfl_max, & + ithlm_enter_mfl, & + ithlm_exit_mfl, & + ithlm_old, & + ithlm_without_ta, & + irtm_enter_mfl, & + irtm_exit_mfl, & + irtm_old, & + irtm_without_ta + + use crmx_stats_variables, only: & + irrainm_bt, & + irrainm_ma, & + irrainm_sd, & + irrainm_ts, & + irrainm_sd_morr, & + irrainm_dff, & + irrainm_cond, & + irrainm_auto, & + irrainm_accr, & + irrainm_cond_adj, & + irrainm_src_adj, & + irrainm_tsfl, & + irrainm_mc, & + irrainm_hf + + use crmx_stats_variables, only: & + irrainm_wvhf, & + irrainm_cl, & + iNrm_bt, & + iNrm_ma, & + iNrm_sd, & + iNrm_ts, & + iNrm_dff, & + iNrm_cond, & + iNrm_auto, & + iNrm_cond_adj, & + iNrm_src_adj, & + iNrm_tsfl, & + iNrm_mc, & + iNrm_cl + + use crmx_stats_variables, only: & + irsnowm_bt, & + irsnowm_ma, & + irsnowm_sd, & + irsnowm_sd_morr, & + irsnowm_dff, & + irsnowm_mc, & + irsnowm_hf, & + irsnowm_wvhf, & + irsnowm_cl, & + irgraupelm_bt, & + irgraupelm_ma, & + irgraupelm_sd, & + irgraupelm_sd_morr, & + irgraupelm_dff, & + irgraupelm_mc + + use crmx_stats_variables, only: & + irgraupelm_hf, & + irgraupelm_wvhf, & + irgraupelm_cl, & + iricem_bt, & + iricem_ma, & + iricem_sd, & + iricem_sd_mg_morr, & + iricem_dff, & + iricem_mc, & + iricem_hf, & + iricem_wvhf, & + iricem_cl + + use crmx_stats_variables, only: & + ivm_bt, & + ivm_ma, & + ivm_gf, & + ivm_cf, & + ivm_ta, & + ivm_f, & + ivm_sdmp, & + ivm_ndg, & + ium_bt, & + ium_ma, & + ium_gf, & + ium_cf, & + ium_ta, & + ium_f, & + ium_sdmp, & + ium_ndg + + use crmx_stats_variables, only: & + imixt_frac, & ! Variable(s) + iw1, & + iw2, & + ivarnce_w1, & + ivarnce_w2, & + ithl1, & + ithl2, & + ivarnce_thl1, & + ivarnce_thl2, & + irt1, & + irt2, & + ivarnce_rt1, & + ivarnce_rt2, & + irc1, & + irc2, & + irsl1, & + irsl2, & + icloud_frac1, & + icloud_frac2 + + use crmx_stats_variables, only: & + is1, & + is2, & + istdev_s1, & + istdev_s2, & + istdev_t1, & + istdev_t2, & + icovar_st_1, & + icovar_st_2, & + icorr_st_1, & + icorr_st_2, & + irrtthl, & + icrt1, & + icrt2, & + icthl1, & + icthl2 + + + use crmx_stats_variables, only: & + iwp2_zt, & + ithlp2_zt, & + iwpthlp_zt, & + iwprtp_zt, & + irtp2_zt, & + irtpthlp_zt, & + iup2_zt, & + ivp2_zt, & + iupwp_zt, & + ivpwp_zt + + use crmx_stats_variables, only: & + zt, & + isclrm, & + isclrm_f, & + iedsclrm, & + iedsclrm_f + + use crmx_stats_variables, only: & + iNsnowm, & ! Variable(s) + iNrm, & + iNgraupelm, & + iNim, & + iNsnowm_bt, & + iNsnowm_mc, & + iNsnowm_ma, & + iNsnowm_dff, & + iNsnowm_sd, & + iNsnowm_cl, & + iNgraupelm_bt, & + iNgraupelm_mc, & + iNgraupelm_ma, & + iNgraupelm_dff, & + iNgraupelm_sd, & + iNgraupelm_cl, & + iNim_bt, & + iNim_mc, & + iNim_ma, & + iNim_dff, & + iNim_sd, & + iNim_cl + + use crmx_stats_variables, only: & + iNcm_bt, & + iNcm_mc, & + iNcm_ma, & + iNcm_dff, & + iNcm_cl, & + iNcm_act + + use crmx_stats_variables, only: & + iw_KK_evap_covar_zt, & + irt_KK_evap_covar_zt, & + ithl_KK_evap_covar_zt, & + iw_KK_auto_covar_zt, & + irt_KK_auto_covar_zt, & + ithl_KK_auto_covar_zt, & + iw_KK_accr_covar_zt, & + irt_KK_accr_covar_zt, & + ithl_KK_accr_covar_zt, & + irr_KK_mvr_covar_zt, & + iNr_KK_mvr_covar_zt + + use crmx_stats_variables, only: & + ieff_rad_cloud, & + ieff_rad_ice, & + ieff_rad_snow, & + ieff_rad_rain, & + ieff_rad_graupel + + use crmx_stats_variables, only: & + iC11_Skw_fnc, & ! Variable(s) + is_mellor, & + iwp3_on_wp2_zt, & + ia3_coef_zt + + use crmx_stats_variables, only: & + iLscale_pert_1, & ! Variable(s) + iLscale_pert_2 + + use crmx_stats_type, only: & + stat_assign ! Procedure + + use crmx_parameters_model, only: & + sclr_dim,& ! Variable(s) + edsclr_dim + +!use error_code, only: & +! clubb_at_least_debug_level ! Function + + + implicit none + + ! Input Variable + character(len= * ), dimension(nvarmax_zt), intent(in) :: vars_zt + + ! Output Variable + logical, intent(inout) :: l_error + + ! Local Varables + integer :: i, j, k + + logical :: l_found + + character(len=50) :: sclr_idx + +! Default initialization for array indices for zt + + ithlm = 0 + iT_in_K = 0 + ithvm = 0 + irtm = 0 + ircm = 0 + irfrzm = 0 + irvm = 0 + ium = 0 + ivm = 0 + iwm_zt = 0 + ium_ref = 0 + ivm_ref = 0 + iug = 0 + ivg = 0 + icloud_frac = 0 + iice_supersat_frac = 0 + ircm_in_layer = 0 + ircm_in_cloud = 0 + icloud_cover = 0 + ip_in_Pa = 0 + iexner = 0 + irho_ds_zt = 0 + ithv_ds_zt = 0 + iLscale = 0 + iwp3 = 0 + iwpthlp2 = 0 + iwp2thlp = 0 + iwprtp2 = 0 + iwp2rtp = 0 + iLscale_up = 0 + iLscale_down = 0 + itau_zt = 0 + iKh_zt = 0 + iwp2thvp = 0 + iwp2rcp = 0 + iwprtpthlp = 0 + isigma_sqd_w_zt = 0 + irho = 0 + irel_humidity = 0 + iNcm = 0 ! Brian + iNcm_in_cloud = 0 + iNc_activated = 0 + iNcnm = 0 + iNim = 0 + isnowslope = 0 ! Adam Smith, 22 April 2008 + ised_rcm = 0 ! Brian + irsat = 0 ! Brian + irrainm = 0 ! Brian + irain_rate_zt = 0 ! Brian + iradht = 0 + iradht_LW = 0 + iradht_SW = 0 + + ! Number concentrations + iNsnowm = 0 ! Adam Smith, 22 April 2008 + iNrm = 0 ! Brian + iNgraupelm = 0 + iNim = 0 + + idiam = 0 + imass_ice_cryst = 0 + ircm_icedfs = 0 + iu_T_cm = 0 + + irr1 = 0 + irr2 = 0 + iNr1 = 0 + iNr2 = 0 + iLWP1 = 0 + iLWP2 = 0 + iprecip_frac = 0 + iprecip_frac_1 = 0 + iprecip_frac_2 = 0 + + imu_rr_1 = 0 + imu_rr_2 = 0 + imu_Nr_1 = 0 + imu_Nr_2 = 0 + imu_Nc_1 = 0 + imu_Nc_2 = 0 + imu_rr_1_n = 0 + imu_rr_2_n = 0 + imu_Nr_1_n = 0 + imu_Nr_2_n = 0 + imu_Nc_1_n = 0 + imu_Nc_2_n = 0 + isigma_rr_1 = 0 + isigma_rr_2 = 0 + isigma_Nr_1 = 0 + isigma_Nr_2 = 0 + isigma_Nc_1 = 0 + isigma_Nc_2 = 0 + isigma_rr_1_n = 0 + isigma_rr_2_n = 0 + isigma_Nr_1_n = 0 + isigma_Nr_2_n = 0 + isigma_Nc_1_n = 0 + isigma_Nc_2_n = 0 + icorr_srr_1 = 0 + icorr_srr_2 = 0 + icorr_sNr_1 = 0 + icorr_sNr_2 = 0 + icorr_sNc_1 = 0 + icorr_sNc_2 = 0 + icorr_trr_1 = 0 + icorr_trr_2 = 0 + icorr_tNr_1 = 0 + icorr_tNr_2 = 0 + icorr_tNc_1 = 0 + icorr_tNc_2 = 0 + icorr_rrNr_1 = 0 + icorr_rrNr_2 = 0 + icorr_srr_1_n = 0 + icorr_srr_2_n = 0 + icorr_sNr_1_n = 0 + icorr_sNr_2_n = 0 + icorr_sNc_1_n = 0 + icorr_sNc_2_n = 0 + icorr_trr_1_n = 0 + icorr_trr_2_n = 0 + icorr_tNr_1_n = 0 + icorr_tNr_2_n = 0 + icorr_tNc_1_n = 0 + icorr_tNc_2_n = 0 + icorr_rrNr_1_n = 0 + icorr_rrNr_2_n = 0 + + ! Correlations + icorr_sw = 0 + icorr_wrr = 0 + icorr_wNr = 0 + icorr_wNc = 0 + + ! From K&K microphysics + im_vol_rad_rain = 0 ! Brian + im_vol_rad_cloud = 0 + + ! From Morrison microphysics + ieff_rad_cloud = 0 + ieff_rad_ice = 0 + ieff_rad_snow = 0 + ieff_rad_rain = 0 + ieff_rad_graupel = 0 + + irsnowm = 0 + irgraupelm = 0 + iricem = 0 + + irtm_bt = 0 + irtm_ma = 0 + irtm_ta = 0 + irtm_forcing = 0 + irtm_sdmp = 0 + irtm_mc = 0 + ircm_mc = 0 ! For the change due to COAMPS/Morrison microphysics + ircm_sd_mg_morr = 0 + irvm_mc = 0 ! For the change due to COAMPS/Morrison microphysics + irtm_mfl = 0 + irtm_tacl = 0 + irtm_cl = 0 ! Josh + irtm_pd = 0 + ithlm_bt = 0 + ithlm_ma = 0 + ithlm_ta = 0 + ithlm_forcing = 0 + ithlm_mc = 0 + ithlm_sdmp = 0 + ithlm_mfl = 0 + ithlm_tacl = 0 + ithlm_cl = 0 ! Josh + + ithlm_mfl_min = 0 + ithlm_mfl_max = 0 + irtm_mfl_min = 0 + irtm_mfl_max = 0 + ithlm_enter_mfl = 0 + ithlm_exit_mfl = 0 + ithlm_old = 0 + ithlm_without_ta = 0 + irtm_enter_mfl = 0 + irtm_exit_mfl = 0 + irtm_old = 0 + irtm_without_ta = 0 + + iwp3_bt = 0 + iwp3_ma = 0 + iwp3_ta = 0 + iwp3_tp = 0 + iwp3_ac = 0 + iwp3_bp1 = 0 + iwp3_bp2 = 0 + iwp3_pr1 = 0 + iwp3_pr2 = 0 + iwp3_dp1 = 0 + iwp3_4hd = 0 + iwp3_cl = 0 + + irrainm_bt = 0 + irrainm_ma = 0 + irrainm_sd = 0 + irrainm_ts = 0 + irrainm_sd_morr = 0 + irrainm_dff = 0 + irrainm_cond = 0 + irrainm_auto = 0 + irrainm_accr = 0 + irrainm_cond_adj = 0 + irrainm_src_adj = 0 + irrainm_tsfl = 0 + irrainm_mc = 0 + irrainm_hf = 0 + irrainm_wvhf = 0 + irrainm_cl = 0 + + iNrm_bt = 0 + iNrm_ma = 0 + iNrm_sd = 0 + iNrm_ts = 0 + iNrm_dff = 0 + iNrm_cond = 0 + iNrm_auto = 0 + iNrm_cond_adj = 0 + iNrm_src_adj = 0 + iNrm_tsfl = 0 + iNrm_mc = 0 + iNrm_cl = 0 + + iNsnowm_bt = 0 + iNsnowm_ma = 0 + iNsnowm_sd = 0 + iNsnowm_dff = 0 + iNsnowm_mc = 0 + iNsnowm_cl = 0 + + iNim_bt = 0 + iNim_ma = 0 + iNim_sd = 0 + iNim_dff = 0 + iNim_mc = 0 + iNim_cl = 0 + + iNcm_bt = 0 + iNcm_ma = 0 + iNcm_dff = 0 + iNcm_mc = 0 + iNcm_cl = 0 + iNcm_act = 0 + + irsnowm_bt = 0 + irsnowm_ma = 0 + irsnowm_sd = 0 + irsnowm_sd_morr = 0 + irsnowm_dff = 0 + irsnowm_mc = 0 + irsnowm_hf = 0 + irsnowm_wvhf = 0 + irsnowm_cl = 0 + + irgraupelm_bt = 0 + irgraupelm_ma = 0 + irgraupelm_sd = 0 + irgraupelm_sd_morr = 0 + irgraupelm_dff = 0 + irgraupelm_mc = 0 + irgraupelm_hf = 0 + irgraupelm_wvhf = 0 + irgraupelm_cl = 0 + + iricem_bt = 0 + iricem_ma = 0 + iricem_sd = 0 + iricem_sd_mg_morr = 0 + iricem_dff = 0 + iricem_mc = 0 + iricem_hf = 0 + iricem_wvhf = 0 + iricem_cl = 0 + + iw_KK_evap_covar_zt = 0 + irt_KK_evap_covar_zt = 0 + ithl_KK_evap_covar_zt = 0 + iw_KK_auto_covar_zt = 0 + irt_KK_auto_covar_zt = 0 + ithl_KK_auto_covar_zt = 0 + iw_KK_accr_covar_zt = 0 + irt_KK_accr_covar_zt = 0 + ithl_KK_accr_covar_zt = 0 + irr_KK_mvr_covar_zt = 0 + iNr_KK_mvr_covar_zt = 0 + + ivm_bt = 0 + ivm_ma = 0 + ivm_gf = 0 + ivm_cf = 0 + ivm_ta = 0 + ivm_f = 0 + ivm_sdmp = 0 + ivm_ndg = 0 + + ium_bt = 0 + ium_ma = 0 + ium_gf = 0 + ium_cf = 0 + ium_ta = 0 + ium_f = 0 + ium_sdmp = 0 + ium_ndg = 0 + + imixt_frac = 0 + iw1 = 0 + iw2 = 0 + ivarnce_w1 = 0 + ivarnce_w2 = 0 + ithl1 = 0 + ithl2 = 0 + ivarnce_thl1 = 0 + ivarnce_thl2 = 0 + irt1 = 0 + irt2 = 0 + ivarnce_rt1 = 0 + ivarnce_rt2 = 0 + irc1 = 0 + irc2 = 0 + irsl1 = 0 + irsl2 = 0 + icloud_frac1 = 0 + icloud_frac2 = 0 + is1 = 0 + is2 = 0 + istdev_s1 = 0 + istdev_s2 = 0 + istdev_t1 = 0 + istdev_t2 = 0 + icovar_st_1 = 0 + icovar_st_2 = 0 + icorr_st_1 = 0 + icorr_st_2 = 0 + irrtthl = 0 + icrt1 = 0 + icrt2 = 0 + icthl1 = 0 + icthl2 = 0 + + is_mellor = 0 + + iwp2_zt = 0 + ithlp2_zt = 0 + iwpthlp_zt = 0 + iwprtp_zt = 0 + irtp2_zt = 0 + irtpthlp_zt = 0 + iup2_zt = 0 + ivp2_zt = 0 + iupwp_zt = 0 + ivpwp_zt = 0 + + iC11_Skw_fnc = 0 + ia3_coef_zt = 0 + iwp3_on_wp2_zt = 0 + + iLscale_pert_1 = 0 + iLscale_pert_2 = 0 + + allocate( isclrm(1:sclr_dim) ) + allocate( isclrm_f(1:sclr_dim) ) + + isclrm = 0 + isclrm_f = 0 + + allocate( iedsclrm(1:edsclr_dim) ) + allocate( iedsclrm_f(1:edsclr_dim) ) + + iedsclrm = 0 + + iedsclrm_f = 0 + +! Assign pointers for statistics variables zt + + k = 1 + do i=1,zt%nn + + select case ( trim(vars_zt(i)) ) + case ('thlm') + ithlm = k + call stat_assign( ithlm, "thlm", & + "Liquid water potential temperature (theta_l) [K]", "K", zt) + k = k + 1 + + case ('T_in_K') + iT_in_K = k + call stat_assign( iT_in_K, "T_in_K", & + "Absolute temperature [K]", "K", zt ) + k = k + 1 + + case ('thvm') + ithvm = k + call stat_assign( ithvm, "thvm", & + "Virtual potential temperature [K]", "K", zt ) + k = k + 1 + + case ('rtm') + irtm = k + + call stat_assign( irtm, "rtm", & + "Total (vapor+liquid) water mixing ratio [kg/kg]", "kg/kg", zt ) + + !zt%f%var(irtm)%ptr => zt%x(:,k) + !zt%f%var(irtm)%name = "rtm" + !zt%f%var(irtm)%description + != "total water mixing ratio (kg/kg)" + !zt%f%var(irtm)%units = "kg/kg" + + k = k + 1 + + case ('rcm') + ircm = k + call stat_assign( ircm, "rcm", & + "Cloud water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rfrzm') + irfrzm = k + call stat_assign( irfrzm, "rfrzm", & + "Total ice phase water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rvm') + irvm = k + call stat_assign( irvm, "rvm", & + "Vapor water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + case ('rel_humidity') + irel_humidity = k + call stat_assign( irel_humidity, "rel_humidity", & + "Relative humidity w.r.t. liquid (range [0,1]) [-]", "[-]", zt ) + k = k + 1 + case ('um') + ium = k + call stat_assign( ium, "um", & + "East-west (u) wind [m/s]", "m/s", zt ) + k = k + 1 + case ('vm') + ivm = k + call stat_assign( ivm, "vm", & + "North-south (v) wind [m/s]", "m/s", zt ) + k = k + 1 + case ('wm_zt') + iwm_zt = k + call stat_assign( iwm_zt, "wm", & + "Vertical (w) wind [m/s]", "m/s", zt ) + k = k + 1 + case ('um_ref') + ium_ref = k + call stat_assign( ium_ref, "um_ref", & + "reference u wind (m/s) [m/s]", "m/s", zt) + k = k + 1 + case ('vm_ref') + ivm_ref = k + call stat_assign( ivm_ref, "vm_ref", & + "reference v wind (m/s) [m/s]", "m/s", zt) + k = k + 1 + case ('ug') + iug = k + call stat_assign( iug, "ug", & + "u geostrophic wind [m/s]", "m/s", zt) + k = k + 1 + case ('vg') + ivg = k + call stat_assign( ivg, "vg", & + "v geostrophic wind [m/s]", "m/s", zt ) + k = k + 1 + case ('cloud_frac') + icloud_frac = k + call stat_assign( icloud_frac, "cloud_frac", & + "Cloud fraction (between 0 and 1) [-]", "count", zt ) + k = k + 1 + + case ('ice_supersat_frac') + iice_supersat_frac = k + call stat_assign( iice_supersat_frac, "ice_supersat_frac", & + "Ice cloud fraction (between 0 and 1) [-]", "count", zt ) + k = k + 1 + + case ('rcm_in_layer') + ircm_in_layer = k + call stat_assign( ircm_in_layer, "rcm_in_layer", & + "rcm in cloud layer [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rcm_in_cloud') + ircm_in_cloud = k + call stat_assign( ircm_in_cloud, "rcm_in_cloud", & + "in-cloud value of rcm (for microphysics) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('cloud_cover') + icloud_cover = k + call stat_assign( icloud_cover, "cloud_cover", & + "Cloud cover (between 0 and 1) [-]", "count", zt ) + k = k + 1 + case ('p_in_Pa') + ip_in_Pa = k + call stat_assign( ip_in_Pa, "p_in_Pa", & + "Pressure [Pa]", "Pa", zt ) + k = k + 1 + case ('exner') + iexner = k + call stat_assign( iexner, "exner", & + "Exner function = (p/p0)**(rd/cp) [-]", "count", zt ) + k = k + 1 + case ('rho_ds_zt') + irho_ds_zt = k + call stat_assign( irho_ds_zt, "rho_ds_zt", & + "Dry, static, base-state density [kg/m^3]", "kg m^{-3}", zt ) + k = k + 1 + case ('thv_ds_zt') + ithv_ds_zt = k + call stat_assign( ithv_ds_zt, "thv_ds_zt", & + "Dry, base-state theta_v [K]", "K", zt ) + k = k + 1 + case ('Lscale') + iLscale = k + call stat_assign( iLscale, "Lscale", & + "Mixing length [m]", "m", zt ) + k = k + 1 + case ('thlm_forcing') + ithlm_forcing = k + call stat_assign( ithlm_forcing, "thlm_forcing", & + "thlm budget: thetal forcing (includes thlm_mc and radht) [K s^{-1}]", "K s^{-1}", zt ) + k = k + 1 + case ('thlm_mc') + ithlm_mc = k + call stat_assign( ithlm_mc, "thlm_mc", & + "Change in thlm due to microphysics (not in budget) [K s^{-1}]", "K s^{-1}", zt ) + k = k + 1 + case ('rtm_forcing') + irtm_forcing = k + call stat_assign( irtm_forcing, "rtm_forcing", & + "rtm budget: rt forcing (includes rtm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", & + zt ) + k = k + 1 + + case ('rtm_mc') + irtm_mc = k + call stat_assign( irtm_mc, "rtm_mc", & + "Change in rt due to microphysics (not in budget) [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rvm_mc') + irvm_mc = k + call stat_assign( irvm_mc, "rvm_mc", & + "Time tendency of vapor mixing ratio due to microphysics [kg/kg/s]", "kg/(kg s)", zt ) + k = k + 1 + + case ('rcm_mc') + ircm_mc = k + call stat_assign( ircm_mc, "rcm_mc", & + "Time tendency of liquid water mixing ratio due microphysics [kg/kg/s]", & + "kg/kg/s", zt ) + k = k + 1 + + case ('rcm_sd_mg_morr') + ircm_sd_mg_morr = k + call stat_assign( ircm_sd_mg_morr, "rcm_sd_mg_morr", & + "rcm sedimentation when using morrision or MG microphysics (not in budget," & + // " included in rcm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('thlm_mfl_min') + ithlm_mfl_min = k + call stat_assign( ithlm_mfl_min, "thlm_mfl_min", & + "Minimum allowable thlm [K]", "K", zt ) + k = k + 1 + + case ('thlm_mfl_max') + ithlm_mfl_max = k + call stat_assign( ithlm_mfl_max, "thlm_mfl_max", & + "Maximum allowable thlm [K]", "K", zt ) + k = k + 1 + + case ('thlm_enter_mfl') + ithlm_enter_mfl = k + call stat_assign( ithlm_enter_mfl, "thlm_enter_mfl", & + "Thlm before flux-limiter [K]", "K", zt ) + k = k + 1 + + case ('thlm_exit_mfl') + ithlm_exit_mfl = k + call stat_assign( ithlm_exit_mfl, "thlm_exit_mfl", & + "Thlm exiting flux-limiter [K]", "K", zt ) + k = k + 1 + + case ('thlm_old') + ithlm_old = k + call stat_assign( ithlm_old, "thlm_old", & + "Thlm at previous timestep [K]", "K", zt ) + k = k + 1 + + case ('thlm_without_ta') + ithlm_without_ta = k + call stat_assign( ithlm_without_ta, "thlm_without_ta", & + "Thlm without turbulent advection contribution [K]", "K", zt ) + k = k + 1 + + case ('rtm_mfl_min') + irtm_mfl_min = k + call stat_assign( irtm_mfl_min, "rtm_mfl_min", & + "Minimum allowable rtm [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rtm_mfl_max') + irtm_mfl_max = k + call stat_assign( irtm_mfl_max, "rtm_mfl_max", & + "Maximum allowable rtm [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rtm_enter_mfl') + irtm_enter_mfl = k + call stat_assign( irtm_enter_mfl, "rtm_enter_mfl", & + "Rtm before flux-limiter [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rtm_exit_mfl') + irtm_exit_mfl = k + call stat_assign( irtm_exit_mfl, "rtm_exit_mfl", & + "Rtm exiting flux-limiter [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rtm_old') + irtm_old = k + call stat_assign( irtm_old, "rtm_old", & + "Rtm at previous timestep [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rtm_without_ta') + irtm_without_ta = k + call stat_assign( irtm_without_ta, "rtm_without_ta", & + "Rtm without turbulent advection contribution [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('wp3') + iwp3 = k + call stat_assign( iwp3, "wp3", & + "w third order moment [m^3/s^3]", "m^3/s^3", zt ) + k = k + 1 + + case ('wpthlp2') + iwpthlp2 = k + call stat_assign( iwpthlp2, "wpthlp2", & + "w'thl'^2 [(m K^2)/s]", "(m K^2)/s", zt ) + k = k + 1 + + case ('wp2thlp') + iwp2thlp = k + call stat_assign( iwp2thlp, "wp2thlp", & + "w'^2thl' [(m^2 K)/s^2]", "(m^2 K)/s^2", zt ) + k = k + 1 + + case ('wprtp2') + iwprtp2 = k + call stat_assign( iwprtp2, "wprtp2", & + "w'rt'^2 [(m kg)/(s kg)]", "(m kg)/(s kg)", zt ) + k = k + 1 + + case ('wp2rtp') + iwp2rtp = k + call stat_assign( iwp2rtp, "wp2rtp", & + "w'^2rt' [(m^2 kg)/(s^2 kg)]", "(m^2 kg)/(s^2 kg)", zt ) + k = k + 1 + + case ('Lscale_up') + iLscale_up = k + call stat_assign( iLscale_up, "Lscale_up", & + "Upward mixing length [m]", "m", zt ) + k = k + 1 + + case ('Lscale_down') + iLscale_down = k + call stat_assign( iLscale_down, "Lscale_down", & + "Downward mixing length [m]", "m", zt ) + k = k + 1 + + case ('Lscale_pert_1') + iLscale_pert_1 = k + call stat_assign( iLscale_pert_1, "Lscale_pert_1", & + "Mixing length using a perturbed value of rtm/thlm [m]", "m", zt ) + k = k + 1 + + case ('Lscale_pert_2') + iLscale_pert_2 = k + call stat_assign( iLscale_pert_2, "Lscale_pert_2", & + "Mixing length using a perturbed value of rtm/thlm [m]", "m", zt ) + k = k + 1 + + case ('tau_zt') + itau_zt = k + call stat_assign( itau_zt, "tau_zt", & + "Dissipation time [s]", "s", zt ) + k = k + 1 + + case ('Kh_zt') + iKh_zt = k + call stat_assign( iKh_zt, "Kh_zt", & + "Eddy diffusivity [m^2/s]", "m^2/s", zt ) + k = k + 1 + + case ('wp2thvp') + iwp2thvp = k + call stat_assign( iwp2thvp, "wp2thvp", & + "w'^2thv' [K m^2/s^2]", "K m^2/s^2", zt ) + k = k + 1 + + case ('wp2rcp') + iwp2rcp = k + call stat_assign( iwp2rcp, "wp2rcp", & + "w'^2rc' [(m^2 kg)/(s^2 kg)]", "(m^2 kg)/(s^2 kg)", zt ) + k = k + 1 + + case ('wprtpthlp') + iwprtpthlp = k + call stat_assign( iwprtpthlp, "wprtpthlp", & + "w'rt'thl' [(m kg K)/(s kg)]", "(m kg K)/(s kg)", zt ) + k = k + 1 + + case ('sigma_sqd_w_zt') + isigma_sqd_w_zt = k + call stat_assign( isigma_sqd_w_zt, "sigma_sqd_w_zt", & + "Nondimensionalized w variance of Gaussian component [-]", "-", zt ) + k = k + 1 + + case ('rho') + irho = k + call stat_assign( irho, "rho", & + "Air density [kg/m^3]", "kg m^{-3}", zt ) + k = k + 1 + + case ('Ncm') ! Brian + iNcm = k + call stat_assign( iNcm, "Ncm", & + "Cloud droplet number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('Ncm_in_cloud') + iNcm_in_cloud = k + + call stat_assign( iNcm_in_cloud, "Ncm_in_cloud", & + "In cloud droplet concentration [num/kg]", "num/kg", zt ) + + k = k + 1 + + case ('Nc_activated') + iNc_activated = k + + call stat_assign( iNc_activated, "Nc_activated", & + "Droplets activated by GFDL activation [num/kg]", "num/kg", zt ) + + k = k + 1 + + case ('Ncnm') + iNcnm = k + call stat_assign( iNcnm, "Ncnm", & + "Cloud nuclei number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('Nim') ! Brian + iNim = k + call stat_assign( iNim, "Nim", & + "Ice crystal number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('snowslope') ! Adam Smith, 22 April 2008 + isnowslope = k + call stat_assign( isnowslope, "snowslope", & + "COAMPS microphysics snow slope parameter [1/m]", & + "1/m", zt ) + k = k + 1 + + case ('Nsnowm') ! Adam Smith, 22 April 2008 + iNsnowm = k + call stat_assign( iNsnowm, "Nsnowm", & + "Snow particle number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('Ngraupelm') + iNgraupelm = k + call stat_assign( iNgraupelm, "Ngraupelm", & + "Graupel number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('sed_rcm') ! Brian + ised_rcm = k + call stat_assign( ised_rcm, "sed_rcm", & + "d(rcm)/dt due to cloud sedimentation [kg / (m^2 s)]", & + "kg / [m^2 s]", zt ) + k = k + 1 + + case ('rsat') ! Brian + irsat = k + call stat_assign( irsat, "rsat", & + "Saturation mixing ratio over liquid [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rsati') + irsati = k + call stat_assign( irsati, "rsati", & + "Saturation mixing ratio over ice [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rrainm') ! Brian + irrainm = k + call stat_assign( irrainm, "rrainm", & + "Rain water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rsnowm') + irsnowm = k + call stat_assign( irsnowm, "rsnowm", & + "Snow water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('ricem') + iricem = k + call stat_assign( iricem, "ricem", & + "Pristine ice water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rgraupelm') + irgraupelm = k + call stat_assign( irgraupelm, "rgraupelm", & + "Graupel water mixing ratio [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('Nrm') ! Brian + iNrm = k + call stat_assign( iNrm, "Nrm", & + "Rain drop number concentration [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ('m_vol_rad_rain') ! Brian + im_vol_rad_rain = k + call stat_assign( im_vol_rad_rain, "mvrr", & + "Rain drop mean volume radius [m]", "m", zt ) + k = k + 1 + + case ('m_vol_rad_cloud') + im_vol_rad_cloud = k + call stat_assign( im_vol_rad_cloud, "m_vol_rad_cloud", & + "Cloud drop mean volume radius [m]", "m", zt ) + k = k + 1 + + case ('eff_rad_cloud') + ieff_rad_cloud = k + call stat_assign( ieff_rad_cloud, "eff_rad_cloud", & + "Cloud drop effective volume radius [microns]", "microns", zt ) + k = k + 1 + + case ('eff_rad_ice') + ieff_rad_ice = k + + call stat_assign( ieff_rad_ice, "eff_rad_ice", & + "Ice effective volume radius [microns]", "microns", zt ) + k = k + 1 + + case ('eff_rad_snow') + ieff_rad_snow = k + call stat_assign( ieff_rad_snow, "eff_rad_snow", & + "Snow effective volume radius [microns]", "microns", zt ) + k = k + 1 + + case ('eff_rad_rain') + ieff_rad_rain = k + call stat_assign( ieff_rad_rain, "eff_rad_rain", & + "Rain drop effective volume radius [microns]", "microns", zt ) + k = k + 1 + + case ('eff_rad_graupel') + ieff_rad_graupel = k + call stat_assign( ieff_rad_graupel, "eff_rad_graupel", & + "Graupel effective volume radius [microns]", "microns", zt ) + k = k + 1 + + case ('rain_rate_zt') ! Brian + irain_rate_zt = k + + call stat_assign( irain_rate_zt, "rain_rate_zt", & + "Rain rate [mm/day]", "mm/day", zt ) + k = k + 1 + + case ('radht') + iradht = k + + call stat_assign( iradht, "radht", & + "Total (sw+lw) radiative heating rate [K/s]", "K/s", zt ) + k = k + 1 + + case ('radht_LW') + iradht_LW = k + + call stat_assign( iradht_LW, "radht_LW", & + "Long-wave radiative heating rate [K/s]", "K/s", zt ) + + k = k + 1 + + case ('radht_SW') + iradht_SW = k + call stat_assign( iradht_SW, "radht_SW", & + "Short-wave radiative heating rate [K/s]", "K/s", zt ) + k = k + 1 + + case ('diam') + idiam = k + + call stat_assign( idiam, "diam", & + "Ice crystal diameter [m]", "m", zt ) + k = k + 1 + + case ('mass_ice_cryst') + imass_ice_cryst = k + call stat_assign( imass_ice_cryst, "mass_ice_cryst", & + "Mass of a single ice crystal [kg]", "kg", zt ) + k = k + 1 + + case ('rcm_icedfs') + + ircm_icedfs = k + call stat_assign( ircm_icedfs, "rcm_icedfs", & + "Change in liquid due to ice [kg/kg/s]", "kg/kg/s", zt ) + k = k + 1 + + case ('u_T_cm') + iu_T_cm = k + call stat_assign( iu_T_cm, "u_T_cm", & + "Ice crystal fallspeed [cm s^{-1}]", "cm s^{-1}", zt ) + k = k + 1 + + case ('rtm_bt') + irtm_bt = k + + call stat_assign( irtm_bt, "rtm_bt", & + "rtm budget: rtm time tendency [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) + k = k + 1 + + case ('rtm_ma') + irtm_ma = k + + call stat_assign( irtm_ma, "rtm_ma", & + "rtm budget: rtm vertical mean advection [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt) + k = k + 1 + + case ('rtm_ta') + irtm_ta = k + + call stat_assign( irtm_ta, "rtm_ta", & + "rtm budget: rtm turbulent advection [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) + k = k + 1 + + case ('rtm_mfl') + irtm_mfl = k + + call stat_assign( irtm_mfl, "rtm_mfl", & + "rtm budget: rtm correction due to monotonic flux limiter [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt) + k = k + 1 + + case ('rtm_tacl') + irtm_tacl = k + + call stat_assign( irtm_tacl, "rtm_tacl", & + "rtm budget: rtm correction due to ta term (wprtp) clipping [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt) + + k = k + 1 + + case ('rtm_cl') + irtm_cl = k + + call stat_assign( irtm_cl, "rtm_cl", & + "rtm budget: rtm clipping [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) + + k = k + 1 + case ('rtm_sdmp') + irtm_sdmp = k + + call stat_assign( irtm_sdmp, "rtm_sdmp", & + "rtm budget: rtm correction due to sponge damping [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt) + k = k + 1 + + + case ('rtm_pd') + irtm_pd = k + + call stat_assign( irtm_pd, "rtm_pd", & + "rtm budget: rtm positive definite adjustment [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt) + + k = k + 1 + + case ('thlm_bt') + ithlm_bt = k + + call stat_assign( ithlm_bt, "thlm_bt", & + "thlm budget: thlm time tendency [K s^{-1}]", "K s^{-1}", zt) + k = k + 1 + + case ('thlm_ma') + ithlm_ma = k + + call stat_assign( ithlm_ma, "thlm_ma", & + "thlm budget: thlm vertical mean advection [K s^{-1}]", "K s^{-1}", zt) + k = k + 1 + + case ('thlm_sdmp') + ithlm_sdmp = k + + call stat_assign( ithlm_sdmp, "thlm_sdmp", & + "thlm budget: thlm correction due to sponge damping [K s^{-1}]", "K s^{-1}", zt) + k = k + 1 + + + case ('thlm_ta') + ithlm_ta = k + + call stat_assign( ithlm_ta, "thlm_ta", & + "thlm budget: thlm turbulent advection [K s^{-1}]", "K s^{-1}", zt) + k = k + 1 + + case ('thlm_mfl') + ithlm_mfl = k + + call stat_assign( ithlm_mfl, "thlm_mfl", & + "thlm budget: thlm correction due to monotonic flux limiter [K s^{-1}]", & + "K s^{-1}", zt) + k = k + 1 + + case ('thlm_tacl') + ithlm_tacl = k + + call stat_assign( ithlm_tacl, "thlm_tacl", & + "thlm budget: thlm correction due to ta term (wpthlp) clipping [K s^{-1}]", & + "K s^{-1}", zt) + k = k + 1 + + case ('thlm_cl') + ithlm_cl = k + + call stat_assign( ithlm_cl, "thlm_cl", & + "thlm budget: thlm_cl [K s^{-1}]", "K s^{-1}", zt) + k = k + 1 + + case ('wp3_bt') + iwp3_bt = k + + call stat_assign( iwp3_bt, "wp3_bt", & + "wp3 budget: wp3 time tendency [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_ma') + iwp3_ma = k + + call stat_assign( iwp3_ma, "wp3_ma", & + "wp3 budget: wp3 vertical mean advection [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_ta') + iwp3_ta = k + + call stat_assign( iwp3_ta, "wp3_ta", & + "wp3 budget: wp3 turbulent advection [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + + k = k + 1 + + case ('wp3_tp') + iwp3_tp = k + call stat_assign( iwp3_tp, "wp3_tp", & + "wp3 budget: wp3 turbulent transport [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_ac') + iwp3_ac = k + call stat_assign( iwp3_ac, "wp3_ac", & + "wp3 budget: wp3 accumulation term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_bp1') + iwp3_bp1 = k + call stat_assign( iwp3_bp1, "wp3_bp1", & + "wp3 budget: wp3 buoyancy production [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_bp2') + iwp3_bp2 = k + call stat_assign( iwp3_bp2, "wp3_bp2", & + "wp3 budget: wp3 2nd buoyancy production term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_pr1') + iwp3_pr1 = k + call stat_assign( iwp3_pr1, "wp3_pr1", & + "wp3 budget: wp3 pressure term 1 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_pr2') + iwp3_pr2 = k + call stat_assign( iwp3_pr2, "wp3_pr2", & + "wp3 budget: wp3 pressure term 2 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + + k = k + 1 + + case ('wp3_dp1') + iwp3_dp1 = k + call stat_assign( iwp3_dp1, "wp3_dp1", & + "wp3 budget: wp3 dissipation term 1 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_4hd') + iwp3_4hd = k + call stat_assign( iwp3_4hd, "wp3_4hd", & + "wp3 budget: wp3 4th-order hyper-diffusion [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('wp3_cl') + iwp3_cl = k + call stat_assign( iwp3_cl, "wp3_cl", & + "wp3 budget: wp3 clipping term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) + k = k + 1 + + case ('rrainm_bt') + irrainm_bt = k + call stat_assign( irrainm_bt, "rrainm_bt", & + "rrainm budget: rrainm time tendency [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_ma') + irrainm_ma = k + + call stat_assign( irrainm_ma, "rrainm_ma", & + "rrainm budget: rrainm vertical mean advection [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_sd') + irrainm_sd = k + + call stat_assign( irrainm_sd, "rrainm_sd", & + "rrainm budget: rrainm sedimentation [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_ts') + irrainm_ts = k + + call stat_assign( irrainm_ts, "rrainm_ts", & + "rrainm budget: rrainm turbulent sedimentation" & + //" [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_sd_morr') + irrainm_sd_morr = k + + call stat_assign( irrainm_sd_morr, "rrainm_sd_morr", & + "rrainm sedimentation when using morrision microphysics (not in budget, included" & + // " in rrainm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_dff') + irrainm_dff = k + + call stat_assign( irrainm_dff, "rrainm_dff", & + "rrainm budget: rrainm diffusion [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_cond') + irrainm_cond = k + + call stat_assign( irrainm_cond, "rrainm_cond", & + "rrainm evaporation rate [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_auto') + irrainm_auto = k + + call stat_assign( irrainm_auto, "rrainm_auto", & + "rrainm autoconversion rate [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_accr') + irrainm_accr = k + call stat_assign( irrainm_accr, "rrainm_accr", & + "rrainm accretion rate [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_cond_adj') + irrainm_cond_adj = k + + call stat_assign( irrainm_cond_adj, "rrainm_cond_adj", & + "rrainm evaporation adjustment due to over-evaporation " // & + "[kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_src_adj') + irrainm_src_adj = k + + call stat_assign( irrainm_src_adj, "rrainm_src_adj", & + "rrainm source term adjustment due to over-depletion " // & + "[kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_tsfl') + irrainm_tsfl = k + + call stat_assign( irrainm_tsfl, "rrainm_tsfl", & + "rrainm budget: rrainm turbulent sedimentation flux limiter" & + //" [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_hf') + irrainm_hf = k + call stat_assign( irrainm_hf, "rrainm_hf", & + "rrainm budget: rrainm hole-filling term [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_wvhf') + irrainm_wvhf = k + call stat_assign( irrainm_wvhf, "rrainm_wvhf", & + "rrainm budget: rrainm water vapor hole-filling term [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_cl') + irrainm_cl = k + call stat_assign( irrainm_cl, "rrainm_cl", & + "rrainm budget: rrainm clipping term [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('rrainm_mc') + irrainm_mc = k + + call stat_assign( irrainm_mc, "rrainm_mc", & + "rrainm budget: Change in rrainm due to microphysics [kg kg^{-1} s^{-1}]", & + "kg kg^{-1} s^{-1}", zt ) + k = k + 1 + + case ('Nrm_bt') + iNrm_bt = k + call stat_assign( iNrm_bt, "Nrm_bt", & + "Nrm budget: Nrm time tendency [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nrm_ma') + iNrm_ma = k + + call stat_assign( iNrm_ma, "Nrm_ma", & + "Nrm budget: Nrm vertical mean advection [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_sd') + iNrm_sd = k + + call stat_assign( iNrm_sd, "Nrm_sd", & + "Nrm budget: Nrm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nrm_ts') + iNrm_ts = k + + call stat_assign( iNrm_ts, "Nrm_ts", & + "Nrm budget: Nrm turbulent sedimentation [(num/kg)/s]", & + "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_dff') + iNrm_dff = k + call stat_assign( iNrm_dff, "Nrm_dff", & + "Nrm budget: Nrm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nrm_cond') + iNrm_cond = k + + call stat_assign( iNrm_cond, "Nrm_cond", & + "Nrm evaporation rate [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_auto') + iNrm_auto = k + + call stat_assign( iNrm_auto, "Nrm_auto", & + "Nrm autoconversion rate [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nrm_cond_adj') + iNrm_cond_adj = k + + call stat_assign( iNrm_cond_adj, "Nrm_cond_adj", & + "Nrm evaporation adjustment due to over-evaporation [(num/kg)/s]", & + "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_src_adj') + iNrm_src_adj = k + + call stat_assign( iNrm_src_adj, "Nrm_src_adj", & + "Nrm source term adjustment due to over-depletion [(num/kg)/s]", & + "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_tsfl') + iNrm_tsfl = k + + call stat_assign( iNrm_tsfl, "Nrm_tsfl", & + "Nrm budget: Nrm turbulent sedimentation flux limiter" & + //" [(num/kg)/s]", & + "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_cl') + iNrm_cl = k + call stat_assign( iNrm_cl, "Nrm_cl", & + "Nrm budget: Nrm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nrm_mc') + iNrm_mc = k + call stat_assign( iNrm_mc, "Nrm_mc", & + "Nrm budget: Change in Nrm due to microphysics (Not in budget) [(num/kg)/s]", & + "(num/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_bt') + irsnowm_bt = k + call stat_assign( irsnowm_bt, "rsnowm_bt", & + "rsnowm budget: rsnowm time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) + + k = k + 1 + + case ('rsnowm_ma') + irsnowm_ma = k + + call stat_assign( irsnowm_ma, "rsnowm_ma", & + "rsnowm budget: rsnowm vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_sd') + irsnowm_sd = k + call stat_assign( irsnowm_sd, "rsnowm_sd", & + "rsnowm budget: rsnowm sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_sd_morr') + irsnowm_sd_morr = k + call stat_assign( irsnowm_sd_morr, "rsnowm_sd_morr", & + "rsnowm sedimentation when using morrison microphysics (Not in budget, included in" & + // " rsnowm_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_dff') + irsnowm_dff = k + + call stat_assign( irsnowm_dff, "rsnowm_dff", & + "rsnowm budget: rsnowm diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_mc') + irsnowm_mc = k + + call stat_assign( irsnowm_mc, "rsnowm_mc", & + "rsnowm budget: Change in rsnowm due to microphysics [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_hf') + irsnowm_hf = k + + call stat_assign( irsnowm_hf, "rsnowm_hf", & + "rsnowm budget: rsnowm hole-filling term [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_wvhf') + irsnowm_wvhf = k + + call stat_assign( irsnowm_wvhf, "rsnowm_wvhf", & + "rsnowm budget: rsnowm water vapor hole-filling term [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('rsnowm_cl') + irsnowm_cl = k + + call stat_assign( irsnowm_cl, "rsnowm_cl", & + "rsnowm budget: rsnowm clipping term [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('Nsnowm_bt') + iNsnowm_bt = k + call stat_assign( iNsnowm_bt, "Nsnowm_bt", & + "Nsnowm budget: [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nsnowm_ma') + iNsnowm_ma = k + + call stat_assign( iNsnowm_ma, "Nsnowm_ma", & + "Nsnowm budget: Nsnowm mean advection [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nsnowm_sd') + iNsnowm_sd = k + + call stat_assign( iNsnowm_sd, "Nsnowm_sd", & + "Nsnowm budget: Nsnowm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nsnowm_dff') + iNsnowm_dff = k + call stat_assign( iNsnowm_dff, "Nsnowm_dff", & + "Nsnowm budget: Nsnowm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nsnowm_mc') + iNsnowm_mc = k + call stat_assign( iNsnowm_mc, "Nsnowm_mc", & + "Nsnowm budget: Nsnowm microphysics [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nsnowm_cl') + iNsnowm_cl = k + + call stat_assign( iNsnowm_cl, "Nsnowm_cl", & + "Nsnowm budget: Nsnowm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('ricem_bt') + iricem_bt = k + + call stat_assign( iricem_bt, "ricem_bt", & + "ricem budget: ricem time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) + + k = k + 1 + + case ('ricem_ma') + iricem_ma = k + + call stat_assign( iricem_ma, "ricem_ma", & + "ricem budget: ricem vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_sd') + iricem_sd = k + + call stat_assign( iricem_sd, "ricem_sd", & + "ricem budget: ricem sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_sd_mg_morr') + iricem_sd_mg_morr = k + + call stat_assign( iricem_sd_mg_morr, "ricem_sd_mg_morr", & + "ricem sedimentation when using morrison or MG microphysics (not in budget," & + // " included in ricem_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_dff') + iricem_dff = k + + call stat_assign( iricem_dff, "ricem_dff", & + "ricem budget: ricem diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_mc') + iricem_mc = k + + call stat_assign( iricem_mc, "ricem_mc", & + "ricem budget: Change in ricem due to microphysics [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_hf') + iricem_hf = k + + call stat_assign( iricem_hf, "ricem_hf", & + "ricem budget: ricem hole-filling term [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_wvhf') + iricem_wvhf = k + + call stat_assign( iricem_wvhf, "ricem_wvhf", & + "ricem budget: ricem water vapor hole-filling term [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('ricem_cl') + iricem_cl = k + + call stat_assign( iricem_cl, "ricem_cl", & + "ricem budget: ricem clipping term [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_bt') + irgraupelm_bt = k + + call stat_assign( irgraupelm_bt, "rgraupelm_bt", & + "rgraupelm budget: rgraupelm time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_ma') + irgraupelm_ma = k + + call stat_assign( irgraupelm_ma, "rgraupelm_ma", & + "rgraupelm budget: rgraupelm vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_sd') + irgraupelm_sd = k + + call stat_assign( irgraupelm_sd, "rgraupelm_sd", & + "rgraupelm budget: rgraupelm sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_sd_morr') + irgraupelm_sd_morr = k + + call stat_assign( irgraupelm_sd_morr, "rgraupelm_sd_morr", & + "rgraupelm sedimentation when using morrison microphysics (not in budget, included" & + // " in rgraupelm_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_dff') + irgraupelm_dff = k + + call stat_assign( irgraupelm_dff, "rgraupelm_dff", & + "rgraupelm budget: rgraupelm diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_mc') + irgraupelm_mc = k + + call stat_assign( irgraupelm_mc, "rgraupelm_mc", & + "rgraupelm budget: Change in rgraupelm due to microphysics [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_hf') + irgraupelm_hf = k + + call stat_assign( irgraupelm_hf, "rgraupelm_hf", & + "rgraupelm budget: rgraupelm hole-filling term [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_wvhf') + irgraupelm_wvhf = k + + call stat_assign( irgraupelm_wvhf, "rgraupelm_wvhf", & + "rgraupelm budget: rgraupelm water vapor hole-filling term [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('rgraupelm_cl') + irgraupelm_cl = k + + call stat_assign( irgraupelm_cl, "rgraupelm_cl", & + "rgraupelm budget: rgraupelm clipping term [(kg/kg)/s]", & + "(kg/kg)/s", zt ) + k = k + 1 + + case ('Ngraupelm_bt') + iNgraupelm_bt = k + call stat_assign( iNgraupelm_bt, "Ngraupelm_bt", & + "Ngraupelm budget: [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ngraupelm_ma') + iNgraupelm_ma = k + + call stat_assign( iNgraupelm_ma, "Ngraupelm_ma", & + "Ngraupelm budget: Ngraupelm mean advection [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Ngraupelm_sd') + iNgraupelm_sd = k + + call stat_assign( iNgraupelm_sd, "Ngraupelm_sd", & + "Ngraupelm budget: Ngraupelm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ngraupelm_dff') + iNgraupelm_dff = k + call stat_assign( iNgraupelm_dff, "Ngraupelm_dff", & + "Ngraupelm budget: Ngraupelm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ngraupelm_mc') + iNgraupelm_mc = k + + call stat_assign( iNgraupelm_mc, "Ngraupelm_mc", & + "Ngraupelm budget: Ngraupelm microphysics term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Ngraupelm_cl') + iNgraupelm_cl = k + + call stat_assign( iNgraupelm_cl, "Ngraupelm_cl", & + "Ngraupelm budget: Ngraupelm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nim_bt') + iNim_bt = k + call stat_assign( iNim_bt, "Nim_bt", & + "Nim budget: [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nim_ma') + iNim_ma = k + + call stat_assign( iNim_ma, "Nim_ma", & + "Nim budget: Nim mean advection [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nim_sd') + iNim_sd = k + + call stat_assign( iNim_sd, "Nim_sd", & + "Nim budget: Nim sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nim_dff') + iNim_dff = k + call stat_assign( iNim_dff, "Nim_dff", & + "Nim budget: Nim diffusion [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Nim_mc') + iNim_mc = k + + call stat_assign( iNim_mc, "Nim_mc", & + "Nim budget: Nim microphysics term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Nim_cl') + iNim_cl = k + + call stat_assign( iNim_cl, "Nim_cl", & + "Nim budget: Nim clipping term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Ncm_bt') + iNcm_bt = k + call stat_assign( iNcm_bt, "Ncm_bt", & + "Ncm budget: Cloud droplet number concentration budget [(num/kg)/s]", & + "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ncm_ma') + iNcm_ma = k + + call stat_assign( iNcm_ma, "Ncm_ma", & + "Ncm budget: Ncm vertical mean advection [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Ncm_act') + iNcm_act = k + + call stat_assign( iNcm_act, "Ncm_act", & + "Ncm budget: Change in Ncm due to activation [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ncm_dff') + iNcm_dff = k + call stat_assign( iNcm_dff, "Ncm_dff", & + "Ncm budget: Ncm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) + + k = k + 1 + + case ('Ncm_mc') + iNcm_mc = k + + call stat_assign( iNcm_mc, "Ncm_mc", & + "Ncm budget: Change in Ncm due to microphysics [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('Ncm_cl') + iNcm_cl = k + + call stat_assign( iNcm_cl, "Ncm_cl", & + "Ncm budget: Ncm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) + k = k + 1 + + case ('w_KK_evap_covar_zt') + iw_KK_evap_covar_zt = k + + call stat_assign( iw_KK_evap_covar_zt, "w_KK_evap_covar_zt", & + "Covariance of w and KK evaporation rate", "m*(kg/kg)/s^2", zt ) + k = k + 1 + + case ('rt_KK_evap_covar_zt') + irt_KK_evap_covar_zt = k + + call stat_assign( irt_KK_evap_covar_zt, "rt_KK_evap_covar_zt", & + "Covariance of r_t and KK evaporation rate", "(kg/kg)^2/s", zt ) + k = k + 1 + + case ('thl_KK_evap_covar_zt') + ithl_KK_evap_covar_zt = k + + call stat_assign( ithl_KK_evap_covar_zt, "thl_KK_evap_covar_zt", & + "Covariance of theta_l and KK evaporation rate", "K*(kg/kg)/s", zt ) + k = k + 1 + + case ('w_KK_auto_covar_zt') + iw_KK_auto_covar_zt = k + + call stat_assign( iw_KK_auto_covar_zt, "w_KK_auto_covar_zt", & + "Covariance of w and KK autoconversion rate", "m*(kg/kg)/s^2", zt ) + k = k + 1 + + case ('rt_KK_auto_covar_zt') + irt_KK_auto_covar_zt = k + + call stat_assign( irt_KK_auto_covar_zt, "rt_KK_auto_covar_zt", & + "Covariance of r_t and KK autoconversion rate", "(kg/kg)^2/s", zt ) + k = k + 1 + + case ('thl_KK_auto_covar_zt') + ithl_KK_auto_covar_zt = k + + call stat_assign( ithl_KK_auto_covar_zt, "thl_KK_auto_covar_zt", & + "Covariance of theta_l and KK autoconversion rate", "K*(kg/kg)/s", & + zt ) + k = k + 1 + + case ('w_KK_accr_covar_zt') + iw_KK_accr_covar_zt = k + + call stat_assign( iw_KK_accr_covar_zt, "w_KK_accr_covar_zt", & + "Covariance of w and KK accretion rate", "m*(kg/kg)/s^2", zt ) + k = k + 1 + + case ('rt_KK_accr_covar_zt') + irt_KK_accr_covar_zt = k + + call stat_assign( irt_KK_accr_covar_zt, "rt_KK_accr_covar_zt", & + "Covariance of r_t and KK accretion rate", "(kg/kg)^2/s", zt ) + k = k + 1 + + case ('thl_KK_accr_covar_zt') + ithl_KK_accr_covar_zt = k + + call stat_assign( ithl_KK_accr_covar_zt, "thl_KK_accr_covar_zt", & + "Covariance of theta_l and KK accretion rate", "K*(kg/kg)/s", zt ) + k = k + 1 + + case ('rr_KK_mvr_covar_zt') + irr_KK_mvr_covar_zt = k + + call stat_assign( irr_KK_mvr_covar_zt, "rr_KK_mvr_covar_zt", & + "Covariance of r_r and KK rain drop mean volume radius [(kg/kg)m]", & + "(kg/kg)m", zt ) + k = k + 1 + + case ('Nr_KK_mvr_covar_zt') + iNr_KK_mvr_covar_zt = k + + call stat_assign( iNr_KK_mvr_covar_zt, "Nr_KK_mvr_covar_zt", & + "Covariance of N_r and KK rain drop mean volume radius [(num/kg)m]", & + "(num/kg)m", zt ) + k = k + 1 + + case ('vm_bt') + ivm_bt = k + + call stat_assign( ivm_bt, "vm_bt", & + "vm budget: vm time tendency [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_ma') + ivm_ma = k + call stat_assign( ivm_ma, "vm_ma", & + "vm budget: vm vertical mean advection [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_gf') + ivm_gf = k + + call stat_assign( ivm_gf, "vm_gf", & + "vm budget: vm geostrophic forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_cf') + ivm_cf = k + + call stat_assign( ivm_cf, "vm_cf", & + "vm budget: vm coriolis forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_ta') + ivm_ta = k + + call stat_assign( ivm_ta, "vm_ta", & + "vm budget: vm turbulent transport [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_f') + ivm_f = k + call stat_assign( ivm_f, "vm_f", & + "vm budget: vm forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_sdmp') + ivm_sdmp = k + call stat_assign( ivm_sdmp, "vm_sdmp", & + "vm budget: vm sponge damping [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('vm_ndg') + ivm_ndg = k + call stat_assign( ivm_ndg, "vm_ndg", & + "vm budget: vm nudging [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_bt') + ium_bt = k + + call stat_assign( ium_bt, "um_bt", & + "um budget: um time tendency [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_ma') + ium_ma = k + + call stat_assign( ium_ma, "um_ma", & + "um budget: um vertical mean advection [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_gf') + ium_gf = k + call stat_assign( ium_gf, "um_gf", & + "um budget: um geostrophic forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_cf') + ium_cf = k + call stat_assign( ium_cf, "um_cf", & + "um budget: um coriolis forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_ta') + ium_ta = k + call stat_assign( ium_ta, "um_ta", & + "um budget: um turbulent advection [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_f') + ium_f = k + call stat_assign( ium_f, "um_f", & + "um budget: um forcing [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_sdmp') + ium_sdmp = k + call stat_assign( ium_sdmp, "um_sdmp", & + "um budget: um sponge damping [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('um_ndg') + ium_ndg = k + call stat_assign( ium_ndg, "um_ndg", & + "um budget: um nudging [m s^{-2}]", "m s^{-2}", zt ) + k = k + 1 + + case ('mixt_frac') + imixt_frac = k + call stat_assign( imixt_frac, "mixt_frac", & + "pdf parameter: mixture fraction [count]", "count", zt ) + k = k + 1 + + case ('w1') + iw1 = k + call stat_assign( iw1, "w1", & + "pdf parameter: mean w of component 1 [m/s]", "m/s", zt ) + + k = k + 1 + + case ('w2') + iw2 = k + + call stat_assign( iw2, "w2", & + "pdf paramete: mean w of component 2 [m/s]", "m/s", zt ) + k = k + 1 + + case ('varnce_w1') + ivarnce_w1 = k + call stat_assign( ivarnce_w1, "varnce_w1", & + "pdf parameter: w variance of component 1 [m^2/s^2]", "m^2/s^2", zt ) + + k = k + 1 + + case ('varnce_w2') + ivarnce_w2 = k + + call stat_assign( ivarnce_w2, "varnce_w2", & + "pdf parameter: w variance of component 2 [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case ('thl1') + ithl1 = k + + call stat_assign( ithl1, "thl1", & + "pdf parameter: mean thl of component 1 [K]", "K", zt ) + + k = k + 1 + + case ('thl2') + ithl2 = k + + call stat_assign( ithl2, "thl2", & + "pdf parameter: mean thl of component 2 [K]", "K", zt ) + k = k + 1 + + case ('varnce_thl1') + ivarnce_thl1 = k + + call stat_assign( ivarnce_thl1, "varnce_thl1", & + "pdf parameter: thl variance of component 1 [K^2]", "K^2", zt ) + + k = k + 1 + + case ('varnce_thl2') + ivarnce_thl2 = k + call stat_assign( ivarnce_thl2, "varnce_thl2", & + "pdf parameter: thl variance of component 2 [K^2]", "K^2", zt ) + + k = k + 1 + + case ('rt1') + irt1 = k + call stat_assign( irt1, "rt1", & + "pdf parameter: mean rt of component 1 [kg/kg]", "kg/kg", zt ) + + k = k + 1 + + case ('rt2') + irt2 = k + + call stat_assign( irt2, "rt2", & + "pdf parameter: mean rt of component 2 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('varnce_rt1') + ivarnce_rt1 = k + call stat_assign( ivarnce_rt1, "varnce_rt1", & + "pdf parameter: rt variance of component 1 [(kg^2)/(kg^2)]", "(kg^2)/(kg^2)", zt ) + k = k + 1 + + case ('varnce_rt2') + ivarnce_rt2 = k + + call stat_assign( ivarnce_rt2, "varnce_rt2", & + "pdf parameter: rt variance of component 2 [(kg^2)/(kg^2)]", "(kg^2)/(kg^2)", zt ) + k = k + 1 + + case ('rc1') + irc1 = k + + call stat_assign( irc1, "rc1", & + "pdf parameter: mean rc of component 1 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rc2') + irc2 = k + + call stat_assign( irc2, "rc2", & + "pdf parameter: mean rc of component 2 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rsl1') + irsl1 = k + + call stat_assign( irsl1, "rsl1", & + "pdf parameter: sat mix rat based on tl1 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('rsl2') + irsl2 = k + + call stat_assign( irsl2, "rsl2", & + "pdf parameter: sat mix rat based on tl2 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('cloud_frac1') + icloud_frac1 = k + call stat_assign( icloud_frac1, "cloud_frac1", & + "pdf parameter cloud_frac1 [count]", "count", zt ) + k = k + 1 + + case ('cloud_frac2') + icloud_frac2 = k + + call stat_assign( icloud_frac2, "cloud_frac2", & + "pdf parameter cloud_frac2 [count]", "count", zt ) + k = k + 1 + + case ('s1') + is1 = k + + call stat_assign( is1, "s1", & + "pdf parameter: Mellor's s (extended liq) for component 1 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('s2') + is2 = k + + call stat_assign( is2, "s2", & + "pdf parameter: Mellor's s (extended liq) for component 2 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('stdev_s1') + istdev_s1 = k + + call stat_assign( istdev_s1, "stdev_s1", & + "pdf parameter: Std dev of s1 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('stdev_s2') + istdev_s2 = k + + call stat_assign( istdev_s2, "stdev_s2", & + "pdf parameter: Std dev of s2 [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('stdev_t1') + istdev_t1 = k + + call stat_assign( istdev_t1, "stdev_t1", & + "Standard dev. of t (1st PDF component) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('stdev_t2') + istdev_t2 = k + + call stat_assign( istdev_t2, "stdev_t2", & + "Standard dev. of t (2nd PDF component) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ('covar_st_1') + icovar_st_1 = k + + call stat_assign( icovar_st_1, "covar_st_1", & + "Covariance of s and t (1st PDF component) [kg^2/kg^2]", "kg^2/kg^2", zt ) + k = k + 1 + + case ('covar_st_2') + icovar_st_2 = k + + call stat_assign( icovar_st_2, "covar_st_2", & + "Covariance of s and t (2nd PDF component) [kg^2/kg^2]", "kg^2/kg^2", zt ) + k = k + 1 + + case ('corr_st_1') + icorr_st_1 = k + + call stat_assign( icorr_st_1, "corr_st_1", & + "Correlation btw. s and t (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ('corr_st_2') + icorr_st_2 = k + + call stat_assign( icorr_st_2, "corr_st_2", & + "Correlation btw. s and t (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ('rrtthl') + irrtthl = k + + call stat_assign( irrtthl, "rrtthl", & + "Correlation btw. rt and thl (both components) [-]", "-", zt ) + k = k + 1 + + case ('crt1') + icrt1 = k + + call stat_assign( icrt1, "crt1", & + " Coef. on r_t in s/t eqns. (1st PDF comp.) [-]", "count", zt ) + k = k + 1 + + case ('crt2') + icrt2 = k + + call stat_assign( icrt2, "crt2", & + " Coef. on r_t in s/t eqns. (2nd PDF comp.) [-]", "count", zt ) + k = k + 1 + + case ('cthl1') + icthl1 = k + + call stat_assign( icthl1, "cthl1", & + " Coef. on theta_l in s/t eqns. (1st PDF comp.) [kg/kg/K]", "kg/kg/K", zt ) + k = k + 1 + + case ('cthl2') + icthl2 = k + + call stat_assign( icthl2, "cthl2", & + " Coef. on theta_l in s/t eqns. (2nd PDF comp.) [kg/kg/K]", "kg/kg/K", zt ) + k = k + 1 + + + case('wp2_zt') + iwp2_zt = k + + call stat_assign( iwp2_zt, "wp2_zt", & + "w'^2 interpolated to thermodyamic levels [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case('thlp2_zt') + ithlp2_zt = k + + call stat_assign( ithlp2_zt, "thlp2_zt", & + "thl'^2 interpolated to thermodynamic levels [K^2]", "K^2", zt ) + k = k + 1 + + case('wpthlp_zt') + iwpthlp_zt = k + + call stat_assign( iwpthlp_zt, "wpthlp_zt", & + "w'thl' interpolated to thermodynamic levels [(m K)/s]", "(m K)/s", zt ) + k = k + 1 + + case('wprtp_zt') + iwprtp_zt = k + + call stat_assign( iwprtp_zt, "wprtp_zt", & + "w'rt' interpolated to thermodynamic levels [(m kg)/(s kg)]", "(m kg)/(s kg)", zt ) + k = k + 1 + + case('rtp2_zt') + irtp2_zt = k + + call stat_assign( irtp2_zt, "rtp2_zt", & + "rt'^2 interpolated to thermodynamic levels [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case('rtpthlp_zt') + irtpthlp_zt = k + + call stat_assign( irtpthlp_zt, "rtpthlp_zt", & + "rt'thl' interpolated to thermodynamic levels [(kg K)/kg]", "(kg K)/kg", zt ) + k = k + 1 + + case ('up2_zt') + iup2_zt = k + call stat_assign( iup2_zt, "up2_zt", & + "u'^2 interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case ('vp2_zt') + ivp2_zt = k + call stat_assign( ivp2_zt, "vp2_zt", & + "v'^2 interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case ('upwp_zt') + iupwp_zt = k + call stat_assign( iupwp_zt, "upwp_zt", & + "u'w' interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case ('vpwp_zt') + ivpwp_zt = k + call stat_assign( ivpwp_zt, "vpwp_zt", & + "v'w' interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) + k = k + 1 + + case ('C11_Skw_fnc') + iC11_Skw_fnc = k + + call stat_assign( iC11_Skw_fnc, "C11_Skw_fnc", & + "C_11 parameter with Sk_w applied [-]", "count", zt ) + k = k + 1 + + case ('s_mellor') + is_mellor = k + + call stat_assign( is_mellor, "s_mellor", & + "Mellor's s (extended liq) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ( 'a3_coef_zt' ) + ia3_coef_zt = k + call stat_assign( ia3_coef_zt, "a3_coef_zt", & + "The a3 coefficient interpolated the the zt grid [-]", "count", zt ) + k = k + 1 + + case ( 'wp3_on_wp2_zt' ) + iwp3_on_wp2_zt = k + call stat_assign( iwp3_on_wp2_zt, "wp3_on_wp2_zt", & + "Smoothed version of wp3 / wp2 [m/s]", "m/s", zt ) + k = k + 1 + + case ( 'rr1' ) + irr1 = k + call stat_assign( irr1, "rr1", & + "Mean of r_r (1st PDF component) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ( 'rr2' ) + irr2 = k + call stat_assign( irr2, "rr2", & + "Mean of r_r (2nd PDF component) [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ( 'Nr1' ) + iNr1 = k + call stat_assign( iNr1, "Nr1", & + "Mean of N_r (1st PDF component) [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'Nr2' ) + iNr2 = k + call stat_assign( iNr2, "Nr2", & + "Mean of N_r (2nd PDF component) [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'LWP1' ) + iLWP1 = k + call stat_assign( iLWP1, "LWP1", & + "Liquid water path (1st PDF component) [kg/m^2]", "kg/m^2", zt ) + k = k + 1 + + case ( 'LWP2' ) + iLWP2 = k + call stat_assign( iLWP2, "LWP2", & + "Liquid water path (2nd PDF component) [kg/m^2]", "kg/m^2", zt ) + k = k + 1 + + case ( 'precip_frac' ) + iprecip_frac = k + call stat_assign( iprecip_frac, "precip_frac", & + "Precipitation Fraction [-]", "-", zt ) + k = k + 1 + + case ( 'precip_frac_1' ) + iprecip_frac_1 = k + call stat_assign( iprecip_frac_1, "precip_frac_1", & + "Precipitation Fraction (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'precip_frac_2' ) + iprecip_frac_2 = k + call stat_assign( iprecip_frac_2, "precip_frac_2", & + "Precipitation Fraction (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'mu_rr_1' ) + imu_rr_1 = k + call stat_assign( imu_rr_1, "mu_rr_1", & + "Mean (in-precip) of r_r (1st PDF component) [kg/kg]", & + "kg/kg", zt ) + k = k + 1 + + case ( 'mu_rr_2' ) + imu_rr_2 = k + call stat_assign( imu_rr_2, "mu_rr_2", & + "Mean (in-precip) of r_r (2nd PDF component) [kg/kg]", & + "kg/kg", zt ) + k = k + 1 + + case ( 'mu_Nr_1' ) + imu_Nr_1 = k + call stat_assign( imu_Nr_1, "mu_Nr_1", & + "Mean (in-precip) of N_r (1st PDF component) [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ( 'mu_Nr_2' ) + imu_Nr_2 = k + call stat_assign( imu_Nr_2, "mu_Nr_2", & + "Mean (in-precip) of N_r (2nd PDF component) [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ( 'mu_Nc_1' ) + imu_Nc_1 = k + call stat_assign( imu_Nc_1, "mu_Nc_1", & + "Mean of N_c (1st PDF component) [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'mu_Nc_2' ) + imu_Nc_2 = k + call stat_assign( imu_Nc_2, "mu_Nc_2", & + "Mean of N_c (2nd PDF component) [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'mu_rr_1_n' ) + imu_rr_1_n = k + call stat_assign( imu_rr_1_n, "mu_rr_1_n", & + "Mean (in-precip) of ln r_r (1st PDF component) [ln(kg/kg)]", & + "ln(kg/kg)", zt ) + k = k + 1 + + case ( 'mu_rr_2_n' ) + imu_rr_2_n = k + call stat_assign( imu_rr_2_n, "mu_rr_2_n", & + "Mean (in-precip) of ln r_r (2nd PDF component) [ln(kg/kg)]", & + "ln(kg/kg)", zt ) + k = k + 1 + + case ( 'mu_Nr_1_n' ) + imu_Nr_1_n = k + call stat_assign( imu_Nr_1_n, "mu_Nr_1_n", & + "Mean (in-precip) of ln N_r (1st PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'mu_Nr_2_n' ) + imu_Nr_2_n = k + call stat_assign( imu_Nr_2_n, "mu_Nr_2_n", & + "Mean (in-precip) of ln N_r (2nd PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'mu_Nc_1_n' ) + imu_Nc_1_n = k + call stat_assign( imu_Nc_1_n, "mu_Nc_1_n", & + "Mean of ln N_c (1st PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'mu_Nc_2_n' ) + imu_Nc_2_n = k + call stat_assign( imu_Nc_2_n, "mu_Nc_2_n", & + "Mean of ln N_c (2nd PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'sigma_rr_1' ) + isigma_rr_1 = k + call stat_assign( isigma_rr_1, "sigma_rr_1", & + "Standard deviation (in-precip) of r_r (1st PDF component)" & + //" [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ( 'sigma_rr_2' ) + isigma_rr_2 = k + call stat_assign( isigma_rr_2, "sigma_rr_2", & + "Standard deviation (in-precip) of r_r (2nd PDF component)" & + //" [kg/kg]", "kg/kg", zt ) + k = k + 1 + + case ( 'sigma_Nr_1' ) + isigma_Nr_1 = k + call stat_assign( isigma_Nr_1, "sigma_Nr_1", & + "Standard deviation (in-precip) of N_r (1st PDF component)" & + //" [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'sigma_Nr_2' ) + isigma_Nr_2 = k + call stat_assign( isigma_Nr_2, "sigma_Nr_2", & + "Standard deviation (in-precip) of N_r (2nd PDF component)" & + //" [num/kg]", "num/kg", zt ) + k = k + 1 + + case ( 'sigma_Nc_1' ) + isigma_Nc_1 = k + call stat_assign( isigma_Nc_1, "sigma_Nc_1", & + "Standard deviation of N_c (1st PDF component) [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ( 'sigma_Nc_2' ) + isigma_Nc_2 = k + call stat_assign( isigma_Nc_2, "sigma_Nc_2", & + "Standard deviation of N_c (2nd PDF component) [num/kg]", & + "num/kg", zt ) + k = k + 1 + + case ( 'sigma_rr_1_n' ) + isigma_rr_1_n = k + call stat_assign( isigma_rr_1_n, "sigma_rr_1_n", & + "Standard deviation (in-precip) of ln r_r (1st PDF component)" & + //" [ln(kg/kg)]", "ln(kg/kg)", zt ) + k = k + 1 + + case ( 'sigma_rr_2_n' ) + isigma_rr_2_n = k + call stat_assign( isigma_rr_2_n, "sigma_rr_2_n", & + "Standard deviation (in-precip) of ln r_r (2nd PDF component)" & + //" [ln(kg/kg)]", "ln(kg/kg)", zt ) + k = k + 1 + + case ( 'sigma_Nr_1_n' ) + isigma_Nr_1_n = k + call stat_assign( isigma_Nr_1_n, "sigma_Nr_1_n", & + "Standard deviation (in-precip) of ln N_r (1st PDF component)" & + //" [ln(num/kg)]", "ln(num/kg)", zt ) + k = k + 1 + + case ( 'sigma_Nr_2_n' ) + isigma_Nr_2_n = k + call stat_assign( isigma_Nr_2_n, "sigma_Nr_2_n", & + "Standard deviation (in-precip) of ln N_r (2nd PDF component)" & + //" [ln(num/kg)]", "ln(num/kg)", zt ) + k = k + 1 + + case ( 'sigma_Nc_1_n' ) + isigma_Nc_1_n = k + call stat_assign( isigma_Nc_1_n, "sigma_Nc_1_n", & + "Standard deviation of ln N_c (1st PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'sigma_Nc_2_n' ) + isigma_Nc_2_n = k + call stat_assign( isigma_Nc_2_n, "sigma_Nc_2_n", & + "Standard deviation of ln N_c (2nd PDF component) [ln(num/kg)]", & + "ln(num/kg)", zt ) + k = k + 1 + + case ( 'corr_srr_1' ) + icorr_srr_1 = k + call stat_assign( icorr_srr_1, "corr_srr_1", & + "Correlation (in-precip) between s and r_r (1st PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_srr_2' ) + icorr_srr_2 = k + call stat_assign( icorr_srr_2, "corr_srr_2", & + "Correlation (in-precip) between s and r_r (2nd PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNr_1' ) + icorr_sNr_1 = k + call stat_assign( icorr_sNr_1, "corr_sNr_1", & + "Correlation (in-precip) between s and N_r (1st PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNr_2' ) + icorr_sNr_2 = k + call stat_assign( icorr_sNr_2, "corr_sNr_2", & + "Correlation (in-precip) between s and N_r (2nd PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNc_1' ) + icorr_sNc_1 = k + call stat_assign( icorr_sNc_1, "corr_sNc_1", & + "Correlation between s and N_c (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNc_2' ) + icorr_sNc_2 = k + call stat_assign( icorr_sNc_2, "corr_sNc_2", & + "Correlation between s and N_c (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_trr_1' ) + icorr_trr_1 = k + call stat_assign( icorr_trr_1, "corr_trr_1", & + "Correlation (in-precip) between t and r_r (1st PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_trr_2' ) + icorr_trr_2 = k + call stat_assign( icorr_trr_2, "corr_trr_2", & + "Correlation (in-precip) between t and r_r (2nd PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNr_1' ) + icorr_tNr_1 = k + call stat_assign( icorr_tNr_1, "corr_tNr_1", & + "Correlation (in-precip) between t and N_r (1st PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNr_2' ) + icorr_tNr_2 = k + call stat_assign( icorr_tNr_2, "corr_tNr_2", & + "Correlation (in-precip) between t and N_r (2nd PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNc_1' ) + icorr_tNc_1 = k + call stat_assign( icorr_tNc_1, "corr_tNc_1", & + "Correlation between t and N_c (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNc_2' ) + icorr_tNc_2 = k + call stat_assign( icorr_tNc_2, "corr_tNc_2", & + "Correlation between t and N_c (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_rrNr_1' ) + icorr_rrNr_1 = k + call stat_assign( icorr_rrNr_1, "corr_rrNr_1", & + "Correlation (in-precip) between r_r and N_r (1st PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_rrNr_2' ) + icorr_rrNr_2 = k + call stat_assign( icorr_rrNr_2, "corr_rrNr_2", & + "Correlation (in-precip) between r_r and N_r (2nd PDF component)" & + //" [-]", "-", zt ) + k = k + 1 + + case ( 'corr_srr_1_n' ) + icorr_srr_1_n = k + call stat_assign( icorr_srr_1_n, "corr_srr_1_n", & + "Correlation (in-precip) between s and ln r_r" & + //" (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_srr_2_n' ) + icorr_srr_2_n = k + call stat_assign( icorr_srr_2_n, "corr_srr_2_n", & + "Correlation (in-precip) between s and ln r_r" & + //" (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNr_1_n' ) + icorr_sNr_1_n = k + call stat_assign( icorr_sNr_1_n, "corr_sNr_1_n", & + "Correlation (in-precip) between s and ln N_r" & + //" (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNr_2_n' ) + icorr_sNr_2_n = k + call stat_assign( icorr_sNr_2_n, "corr_sNr_2_n", & + "Correlation (in-precip) between s and ln N_r" & + //" (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_sNc_1_n' ) + icorr_sNc_1_n = k + call stat_assign( icorr_sNc_1_n, "corr_sNc_1_n", & + "Correlation between s and ln N_c (1st PDF component) [-]", & + "-", zt ) + k = k + 1 + + case ( 'corr_sNc_2_n' ) + icorr_sNc_2_n = k + call stat_assign( icorr_sNc_2_n, "corr_sNc_2_n", & + "Correlation between s and ln N_c (2nd PDF component) [-]", & + "-", zt ) + k = k + 1 + + case ( 'corr_trr_1_n' ) + icorr_trr_1_n = k + call stat_assign( icorr_trr_1_n, "corr_trr_1_n", & + "Correlation (in-precip) between t and ln r_r" & + //" (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_trr_2_n' ) + icorr_trr_2_n = k + call stat_assign( icorr_trr_2_n, "corr_trr_2_n", & + "Correlation (in-precip) between t and ln r_r" & + //" (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNr_1_n' ) + icorr_tNr_1_n = k + call stat_assign( icorr_tNr_1_n, "corr_tNr_1_n", & + "Correlation (in-precip) between t and ln N_r" & + //" (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNr_2_n' ) + icorr_tNr_2_n = k + call stat_assign( icorr_tNr_2_n, "corr_tNr_2_n", & + "Correlation (in-precip) between t and ln N_r" & + //" (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_tNc_1_n' ) + icorr_tNc_1_n = k + call stat_assign( icorr_tNc_1_n, "corr_tNc_1_n", & + "Correlation between t and ln N_c (1st PDF component) [-]", & + "-", zt ) + k = k + 1 + + case ( 'corr_tNc_2_n' ) + icorr_tNc_2_n = k + call stat_assign( icorr_tNc_2_n, "corr_tNc_2_n", & + "Correlation between t and ln N_c (2nd PDF component) [-]", & + "-", zt ) + k = k + 1 + + case ( 'corr_rrNr_1_n' ) + icorr_rrNr_1_n = k + call stat_assign( icorr_rrNr_1_n, "corr_rrNr_1_n", & + "Correlation (in-precip) between ln r_r and ln N_r" & + //" (1st PDF component) [-]", "-", zt ) + k = k + 1 + + case ( 'corr_rrNr_2_n' ) + icorr_rrNr_2_n = k + call stat_assign( icorr_rrNr_2_n, "corr_rrNr_2_n", & + "Correlation (in-precip) between ln r_r and ln N_r" & + //" (2nd PDF component) [-]", "-", zt ) + k = k + 1 + + + ! changes by janhft 09/25/12 + case ('corr_sw') + icorr_sw = k + call stat_assign( icorr_sw, "corr_sw", & + "Correlation between s and w [-]", "-", zt ) + k = k + 1 + + case ('corr_wrr') + icorr_wrr = k + call stat_assign( icorr_wrr, "corr_wrr", & + "Correlation between w and rrain [-]", "-", zt ) + k = k + 1 + + case ('corr_wNr') + icorr_wNr = k + call stat_assign( icorr_wNr, "corr_wNr", & + "Correlation between w and Nr [-]", "-", zt ) + k = k + 1 + + case ('corr_wNc') + icorr_wNc = k + call stat_assign( icorr_wNc, "corr_wNc", & + "Correlation between w and Nc [-]", "-", zt ) + k = k + 1 + ! end changes by janhft 09/25/12 + + case default + + l_found =.false. + + j=1 + + do while( j <= sclr_dim .and. .not. l_found) + write(sclr_idx, * ) j + + sclr_idx = adjustl(sclr_idx) + + if(trim(vars_zt(i)) == "sclr"//trim(sclr_idx)//"m" .and. .not. l_found) then + + isclrm(j) = k + + call stat_assign( isclrm(j) , "sclr"//trim(sclr_idx)//"m",& + "passive scalar "//trim(sclr_idx), "unknown", zt ) + + k = k + 1 + + l_found = .true. + + else if(trim(vars_zt(i)) == "sclr"//trim(sclr_idx)//"m_f" .and. .not. l_found) then + + isclrm_f(j) = k + + call stat_assign( isclrm_f(j) , "sclr"//trim(sclr_idx)//"m_f", & + "passive scalar forcing "//trim(sclr_idx), "unknown", zt ) + + k = k + 1 + + l_found = .true. + + endif + + j = j + 1 + end do + + j = 1 + + do while( j <= edsclr_dim .and. .not. l_found) + + write(sclr_idx, * ) j + + sclr_idx = adjustl(sclr_idx) + + if(trim(vars_zt(i)) == "edsclr"//trim(sclr_idx)//"m" .and. .not. l_found ) then + + iedsclrm(j) = k + + call stat_assign( iedsclrm(j) , "edsclr"//trim(sclr_idx)//"m", & + "passive scalar "//trim(sclr_idx), "unknown", zt ) + + k = k + 1 + + l_found = .true. + + else if(trim(vars_zt(i)) == "edsclr"//trim(sclr_idx)//"m_f" .and. .not. l_found) then + + iedsclrm_f(j) = k + + call stat_assign( iedsclrm_f(j) , "edsclr"//trim(sclr_idx)//"m_f", & + "passive scalar forcing "//trim(sclr_idx), "unknown", zt ) + + k = k + 1 + + l_found = .true. + + endif + + j = j + 1 + + end do + + if (.not. l_found ) then + + write(fstderr,*) 'Error: unrecognized variable in vars_zt: ', trim( vars_zt(i) ) + + l_error = .true. ! This will stop the run. + + end if + + end select + + end do + + return + end subroutine stats_init_zt + +end module crmx_stats_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 new file mode 100644 index 0000000000..3ca35d19be --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 @@ -0,0 +1,409 @@ +! $Id: surface_varnce_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +!=============================================================================== +module crmx_surface_varnce_module + + implicit none + + private ! Default to private + + public :: surface_varnce + + contains + +!============================================================================= + subroutine surface_varnce( upwp_sfc, vpwp_sfc, wpthlp_sfc, wprtp_sfc, & + um_sfc, vm_sfc, wpsclrp_sfc, & + wp2_sfc, up2_sfc, vp2_sfc, & + thlp2_sfc, rtp2_sfc, rtpthlp_sfc, err_code, & + sclrp2_sfc, & + sclrprtp_sfc, & + sclrpthlp_sfc ) + +! Description: +! This subroutine computes estimate of the surface thermodynamic +! second order moments. + +! References: +! None +!------------------------------------------------------------------------------- + + use crmx_parameters_model, only: & + T0 ! Variable(s) + + use crmx_constants_clubb, only: & + grav, & ! Variable(s) + eps, & + fstderr + + use crmx_parameters_model, only: & + sclr_dim ! Variable(s) + + use crmx_numerical_check, only: & + surface_varnce_check ! Procedure + + use crmx_error_code, only: & + clubb_var_equals_NaN, & ! Variable(s) + clubb_at_least_debug_level, & + clubb_no_error ! Constant + + use crmx_array_index, only: & + iisclr_rt, & ! Index for a scalar emulating rt + iisclr_thl ! Index for a scalar emulating thetal + + use crmx_stats_type, only: & + stat_end_update_pt, & ! Procedure(s) + stat_update_var_pt + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! External + intrinsic :: sqrt, max + + ! Constant Parameters + + ! Logical for Andre et al., 1978 parameterization. + logical, parameter :: l_andre_1978 = .false. + + real( kind = core_rknd ), parameter :: & + a_const = 1.8_core_rknd, & + z_const = 1.0_core_rknd, & + ! Vince Larson increased ufmin to stabilize arm_97. 24 Jul 2007 +! ufmin = 0.0001_core_rknd, & + ufmin = 0.01_core_rknd, & + ! End Vince Larson's change. + ! Vince Larson changed in order to make correlations between [-1,1]. 31 Jan 2008. +! sclr_var_coef = 0.25_core_rknd, & ! This value is made up! - Vince Larson 12 Jul 2005 + sclr_var_coef = 0.4_core_rknd, & ! This value is made up! - Vince Larson 12 Jul 2005 + ! End Vince Larson's change + ! Vince Larson reduced surface spike in scalar variances associated + ! w/ Andre et al. 1978 scheme + reduce_coef = 0.2_core_rknd + + ! Input Variables + real( kind = core_rknd ), intent(in) :: & + upwp_sfc, & ! Surface u momentum flux [m^2/s^2] + vpwp_sfc, & ! Surface v momentum flux [m^2/s^2] + wpthlp_sfc, & ! Surface thetal flux [K m/s] + wprtp_sfc, & ! Surface moisture flux [kg/kg m/s] + um_sfc, & ! Surface u wind component [m/s] + vm_sfc ! Surface v wind component [m/s] + + real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & + wpsclrp_sfc ! Passive scalar flux [units m/s] + + ! Output Variables + real( kind = core_rknd ), intent(out) :: & + wp2_sfc, & ! Vertical velocity variance [m^2/s^2] + up2_sfc, & ! u'^2 [m^2/s^2] + vp2_sfc, & ! v'^2 [m^2/s^2] + thlp2_sfc, & ! thetal variance [K^2] + rtp2_sfc, & ! rt variance [(kg/kg)^2] + rtpthlp_sfc ! thetal rt covariance [kg K/kg] + + integer, intent(out) :: & + err_code + + real( kind = core_rknd ), intent(out), dimension(sclr_dim) :: & + sclrp2_sfc, & ! Passive scalar variance [units^2] + sclrprtp_sfc, & ! Passive scalar r_t covariance [units kg/kg] + sclrpthlp_sfc ! Passive scalar theta_l covariance [units K] + + ! Local Variables + real( kind = core_rknd ) :: ustar2, wstar + real( kind = core_rknd ) :: uf + + ! Variables for Andre et al., 1978 parameterization. + real( kind = core_rknd ) :: & + um_sfc_sqd, & ! Surface value of ^2 [m^2/s^2] + vm_sfc_sqd, & ! Surface value of ^2 [m^2/s^2] + usp2_sfc, & ! u_s (vector oriented w/ mean sfc. wind) variance [m^2/s^2] + vsp2_sfc ! v_s (vector perpen. to mean sfc. wind) variance [m^2/s^2] + + real( kind = core_rknd ) :: ustar + real( kind = core_rknd ) :: Lngth + real( kind = core_rknd ) :: zeta + + integer :: i ! Loop index + + ! ---- Begin Code ---- + + err_code = clubb_no_error + + if ( l_andre_1978 ) then + + ! Calculate ^2 and ^2. + um_sfc_sqd = um_sfc**2 + vm_sfc_sqd = vm_sfc**2 + + ! Calculate surface friction velocity, u*. + ustar = MAX( ( upwp_sfc**2 + vpwp_sfc**2 )**(1.0_core_rknd/4.0_core_rknd), ufmin ) + + ! Find Monin-Obukhov Length (Andre et al., 1978, p. 1866). + Lngth = - ( ustar**3 ) / & + ( 0.35_core_rknd * (1.0_core_rknd/T0) * grav * wpthlp_sfc ) ! Known magic number + + ! Find the value of dimensionless height zeta + ! (Andre et al., 1978, p. 1866). + zeta = z_const / Lngth + + ! Andre et al, 1978, Eq. 29. + ! Notes: 1) "reduce_coef" is a reduction coefficient intended to make + ! the values of rtp2, thlp2, and rtpthlp smaller at the + ! surface. + ! 2) With the reduction coefficient having a value of 0.2, the + ! surface correlations of both w & rt and w & thl have a value + ! of about 0.845. These correlations are greater if zeta < 0. + ! The correlations have a value greater than 1 if + ! zeta <= -0.212. + ! 3) The surface correlation of rt & thl is 1. + ! Brian Griffin; February 2, 2008. + if ( zeta < 0.0_core_rknd ) then + thlp2_sfc = reduce_coef & + * ( wpthlp_sfc**2 / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + rtp2_sfc = reduce_coef & + * ( wprtp_sfc**2 / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + rtpthlp_sfc = reduce_coef & + * ( wprtp_sfc*wpthlp_sfc / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + wp2_sfc = ( ustar**2 ) & + * ( 1.75_core_rknd + 2.0_core_rknd*(-zeta)**& + (2.0_core_rknd/3.0_core_rknd) ) ! Known magic number + else + thlp2_sfc = reduce_coef & + * 4.0_core_rknd * ( wpthlp_sfc**2 / ustar**2 ) ! Known magic number + rtp2_sfc = reduce_coef & + * 4.0_core_rknd * ( wprtp_sfc**2 / ustar**2 ) ! Known magic number + rtpthlp_sfc = reduce_coef & + * 4.0_core_rknd * ( wprtp_sfc*wpthlp_sfc / ustar**2 ) ! Known magic number + wp2_sfc = 1.75_core_rknd * ustar**2 ! Known magic number + end if + + ! Calculate wstar following Andre et al., 1978, p. 1866. + wstar = ( (1.0_core_rknd/T0) * grav * wpthlp_sfc * z_const )**(1.0_core_rknd/3.0_core_rknd) + + ! Andre et al., 1978, Eq. 29. + ! Andre et al. (1978) defines horizontal wind surface variances in terms + ! of orientation with the mean surface wind. The vector u_s is the wind + ! vector oriented with the mean surface wind. The vector v_s is the wind + ! vector oriented perpendicular to the mean surface wind. Thus, is + ! equal to the mean surface wind (both in speed and direction), and + ! is 0. Equation 29 gives the formula for the variance of u_s, which is + ! (usp2_sfc in the code), and the formula for the variance of + ! v_s, which is (vsp2_sfc in the code). + if ( wpthlp_sfc > 0.0_core_rknd ) then + usp2_sfc = 4.0_core_rknd * ustar**2 + 0.3_core_rknd * wstar**2 ! Known magic number + vsp2_sfc = 1.75_core_rknd * ustar**2 + 0.3_core_rknd * wstar**2 ! Known magic number + else + usp2_sfc = 4.0_core_rknd * ustar**2 ! Known magic number + vsp2_sfc = 1.75_core_rknd * ustar**2 ! Known magic number + end if + + ! Variance of u, , at the surface can be found from , + ! , and mean winds (at the surface) and , such that: + ! |_sfc = * [ ^2 / ( ^2 + ^2 ) ] + ! + * [ ^2 / ( ^2 + ^2 ) ]; + ! where ^2 + ^2 /= 0. + up2_sfc & + = usp2_sfc * ( um_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) & + + vsp2_sfc * ( vm_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) + + ! Variance of v, , at the surface can be found from , + ! , and mean winds (at the surface) and , such that: + ! |_sfc = * [ ^2 / ( ^2 + ^2 ) ] + ! + * [ ^2 / ( ^2 + ^2 ) ]; + ! where ^2 + ^2 /= 0. + vp2_sfc & + = vsp2_sfc * ( um_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) & + + usp2_sfc * ( vm_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) + + ! Passive scalars + if ( sclr_dim > 0 ) then + do i = 1, sclr_dim + ! Notes: 1) "reduce_coef" is a reduction coefficient intended to + ! make the values of sclrprtp, sclrpthlp, and sclrp2 + ! smaller at the surface. + ! 2) With the reduction coefficient having a value of 0.2, + ! the surface correlation of w & sclr has a value of + ! about 0.845. The correlation is greater if zeta < 0. + ! The correlation has a value greater than 1 if + ! zeta <= -0.212. + ! 3) The surface correlations of both rt & sclr and + ! thl & sclr are 1. + ! Brian Griffin; February 2, 2008. + if ( zeta < 0.0_core_rknd ) then + sclrprtp_sfc(i) & + = reduce_coef & + * ( wpsclrp_sfc(i)*wprtp_sfc / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + sclrpthlp_sfc(i) & + = reduce_coef & + * ( wpsclrp_sfc(i)*wpthlp_sfc / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + sclrp2_sfc(i) & + = reduce_coef & + * ( wpsclrp_sfc(i)**2 / ustar**2 ) & + * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& + (-2.0_core_rknd/3.0_core_rknd) ! Known magic number + else + sclrprtp_sfc(i) & + = reduce_coef & + * 4.0_core_rknd * ( wpsclrp_sfc(i)*wprtp_sfc / ustar**2 ) ! Known magic number + sclrpthlp_sfc(i) & + = reduce_coef & + * 4.0_core_rknd * ( wpsclrp_sfc(i)*wpthlp_sfc / ustar**2 ) ! Known magic number + sclrp2_sfc(i) & + = reduce_coef & + * 4.0_core_rknd * ( wpsclrp_sfc(i)**2 / ustar**2 ) ! Known magic number + end if + end do ! 1,...sclr_dim + end if + + else ! Previous code. + + ! Compute ustar^2 + + ustar2 = sqrt( upwp_sfc * upwp_sfc + vpwp_sfc * vpwp_sfc ) + + ! Compute wstar following Andre et al., 1976 + + if ( wpthlp_sfc > 0._core_rknd ) then + wstar = ( 1.0_core_rknd/T0 * grav * wpthlp_sfc * z_const ) ** (1._core_rknd/3._core_rknd) + else + wstar = 0._core_rknd + end if + + ! Surface friction velocity following Andre et al. 1978 + + uf = sqrt( ustar2 + 0.3_core_rknd * wstar * wstar ) ! Known magic number + uf = max( ufmin, uf ) + + ! Compute estimate for surface second order moments + + wp2_sfc = a_const * uf**2 + up2_sfc = 2.0_core_rknd * a_const * uf**2 ! From Andre, et al. 1978 + vp2_sfc = 2.0_core_rknd * a_const * uf**2 ! " " + ! Vince Larson changed to make correlations between [-1,1] 31 Jan 2008 +! thlp2_sfc = 0.1 * a * ( wpthlp_sfc / uf )**2 +! rtp2_sfc = 0.4 * a * ( wprtp_sfc / uf )**2 +! rtpthlp_sfc = a * ( wpthlp_sfc / uf ) * ( wprtp_sfc / uf ) + ! Notes: 1) With "a" having a value of 1.8, the surface correlations of + ! both w & rt and w & thl have a value of about 0.878. + ! 2) The surface correlation of rt & thl is 0.5. + ! Brian Griffin; February 2, 2008. + + thlp2_sfc = 0.4_core_rknd * a_const * ( wpthlp_sfc / uf )**2 ! Known magic number + + rtp2_sfc = 0.4_core_rknd * a_const * ( wprtp_sfc / uf )**2 ! Known magic number + + rtpthlp_sfc = 0.2_core_rknd * a_const * ( wpthlp_sfc / uf ) & + * ( wprtp_sfc / uf )! Known magic number + + ! End Vince Larson's change. + + ! Passive scalars + if ( sclr_dim > 0 ) then + do i=1, sclr_dim + ! Vince Larson changed coeffs to make correlations between [-1,1]. 31 Jan 2008 +! sclrprtp_sfc(i) & +! = a * (wprtp_sfc / uf) * (wpsclrp_sfc(i) / uf) +! sclrpthlp_sfc(i) & +! = a * (wpthlp_sfc / uf) * (wpsclrp_sfc(i) / uf) +! sclrp2_sfc(i) & +! = sclr_var_coef * a * ( wpsclrp_sfc(i) / uf )**2 + ! Notes: 1) With "a" having a value of 1.8 and "sclr_var_coef" + ! having a value of 0.4, the surface correlation of + ! w & sclr has a value of about 0.878. + ! 2) With "sclr_var_coef" having a value of 0.4, the + ! surface correlations of both rt & sclr and + ! thl & sclr are 0.5. + ! Brian Griffin; February 2, 2008. + + ! We use the following if..then's to make sclr_rt and sclr_thl close to + ! the actual thlp2/rtp2 at the surface. -dschanen 25 Sep 08 + if ( i == iisclr_rt ) then + ! If we are trying to emulate rt with the scalar, then we + ! use the variance coefficient from above + sclrprtp_sfc(i) = 0.4_core_rknd * a_const * (wprtp_sfc / uf) * & + (wpsclrp_sfc(i) / uf)!Known magic number + else + sclrprtp_sfc(i) = 0.2_core_rknd * a_const * (wprtp_sfc / uf) * & + (wpsclrp_sfc(i) / uf)!Known magic number + end if + + if ( i == iisclr_thl ) then + ! As above, but for thetal + sclrpthlp_sfc(i) = 0.4_core_rknd * a_const * (wpthlp_sfc / uf) & + * (wpsclrp_sfc(i) / uf) ! Known magic number + else + sclrpthlp_sfc(i) = 0.2_core_rknd * a_const * (wpthlp_sfc / uf) & + * (wpsclrp_sfc(i) / uf) ! Known magic number + end if + + sclrp2_sfc(i) = sclr_var_coef * a_const * ( wpsclrp_sfc(i) / uf )**2 + + ! End Vince Larson's change. + + end do ! 1,...sclr_dim + end if ! sclr_dim > 0 + + end if + + if ( clubb_at_least_debug_level( 2 ) ) then + + call surface_varnce_check( wp2_sfc, up2_sfc, vp2_sfc, & + thlp2_sfc, rtp2_sfc, rtpthlp_sfc, & + err_code, & + sclrp2_sfc, sclrprtp_sfc, sclrpthlp_sfc ) + +! Error reporting +! Joshua Fasching February 2008 + if ( err_code == clubb_var_equals_NaN ) then + + write(fstderr,*) "Error in surface_varnce" + write(fstderr,*) "Intent(in)" + + write(fstderr,*) "upwp_sfc = ", upwp_sfc + write(fstderr,*) "vpwp_sfc = ", vpwp_sfc + write(fstderr,*) "wpthlp_sfc = ", wpthlp_sfc + write(fstderr,*) "wprtp_sfc = ", wprtp_sfc + + if ( sclr_dim > 0 ) then + write(fstderr,*) "wpsclrp_sfc = ", wpsclrp_sfc + end if + + write(fstderr,*) "Intent(out)" + + write(fstderr,*) "wp2_sfc = ", wp2_sfc + write(fstderr,*) "up2_sfc = ", up2_sfc + write(fstderr,*) "vp2_sfc = ", vp2_sfc + write(fstderr,*) "thlp2_sfc = ", thlp2_sfc + write(fstderr,*) "rtp2_sfc = ", rtp2_sfc + write(fstderr,*) "rtpthlp_sfc = ", rtpthlp_sfc + + if ( sclr_dim > 0 ) then + write(fstderr,*) "sclrp2_sfc = ", sclrp2_sfc + write(fstderr,*) "sclrprtp_sfc = ", sclrprtp_sfc + write(fstderr,*) "sclrpthlp_sfc = ", sclrpthlp_sfc + end if + + end if ! err_code == clubb_var_equals_NaN + + end if ! clubb_at_least_debug_level ( 2 ) + + return + + end subroutine surface_varnce + +!=============================================================================== + +end module crmx_surface_varnce_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 new file mode 100644 index 0000000000..ce5d06c6fe --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 @@ -0,0 +1,654 @@ +! $Id: variables_diagnostic_module.F90 6118 2013-03-25 19:16:42Z storer@uwm.edu $ +module crmx_variables_diagnostic_module + +! Description: +! This module contains definitions of all diagnostic +! arrays used in the single column model, as well as subroutines +! to allocate, deallocate and initialize them. + +! Note that while these are all same dimension, there is a +! thermodynamic and momentum grid and they have different levels +!----------------------------------------------------------------------- + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! derived type + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + private ! Set default scope + + public :: setup_diagnostic_variables, & + cleanup_diagnostic_variables + + + ! Diagnostic variables + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + sigma_sqd_w_zt, & ! PDF width parameter interpolated to t-levs. [-] + Skw_zm, & ! Skewness of w on momentum levels [-] + Skw_zt, & ! Skewness of w on thermodynamic levels [-] + ug, & ! u geostrophic wind [m/s] + vg, & ! v geostrophic wind [m/s] + um_ref, & ! Initial u wind; Michael Falk [m/s] + vm_ref, & ! Initial v wind; Michael Falk [m/s] + thlm_ref, & ! Initial liquid water potential temperature [K] + rtm_ref, & ! Initial total water mixing ratio [kg/kg] + thvm ! Virtual potential temperature [K] + +!!! Important Note !!! +! Do not indent the omp comments, they need to be in the first 4 columns +!!! End Important Note !!! +!$omp threadprivate(sigma_sqd_w_zt, Skw_zm, Skw_zt, ug, vg, & +!$omp um_ref, vm_ref, thlm_ref, rtm_ref, thvm ) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + rsat ! Saturation mixing ratio ! Brian + +!$omp threadprivate(rsat) + + type(pdf_parameter), allocatable, dimension(:), target, public :: & + pdf_params_zm, & ! pdf_params on momentum levels [units vary] + pdf_params_zm_frz !used when l_use_ice_latent = .true. + +!$omp threadprivate(pdf_params_zm) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + Frad, & ! Radiative flux (momentum point) [W/m^2] + radht, & ! SW + LW heating rate [K/s] + Frad_SW_up, & ! SW radiative upwelling flux [W/m^2] + Frad_LW_up, & ! LW radiative upwelling flux [W/m^2] + Frad_SW_down, & ! SW radiative downwelling flux [W/m^2] + Frad_LW_down ! LW radiative downwelling flux [W/m^2] + +!$omp threadprivate(Frad, radht, Frad_SW_up, Frad_SW_down, Frad_LW_up, Frad_LW_down) + +! Second order moments + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + thlprcp, & ! thl'rc' [K kg/kg] + rtprcp, & ! rt'rc' [kg^2/kg^2] + rcp2 ! rc'^2 [kg^2/kg^2] + +!$omp threadprivate(thlprcp, rtprcp, rcp2) + +! Third order moments + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + wpthlp2, & ! w'thl'^2 [m K^2/s] + wp2thlp, & ! w'^2 thl' [m^2 K/s^2] + wprtp2, & ! w'rt'^2 [m kg^2/kg^2] + wp2rtp, & ! w'^2rt' [m^2 kg/kg] + wprtpthlp, & ! w'rt'thl' [m kg K/kg s] + wp2rcp, & ! w'^2 rc' [m^2 kg/kg s^2] + wp3_zm ! w'^3 [m^3/s^3] + +!$omp threadprivate(wpthlp2, wp2thlp, wprtp2, wp2rtp, & +!$omp wprtpthlp, wp2rcp, wp3_zm ) + +! Fourth order moments + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + wp4 ! w'^4 [m^4/s^4] + +!$omp threadprivate(wp4) + +! Buoyancy related moments + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + rtpthvp, & ! rt'thv' [K kg/kg] + thlpthvp, & ! thl'thv' [K^2] + wpthvp, & ! w'thv' [K m/s] + wp2thvp ! w'^2thv' [K m^2/s^2] + +!$omp threadprivate(rtpthvp, thlpthvp, wpthvp, wp2thvp) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + Kh_zt, & ! Eddy diffusivity coefficient on thermodynamic levels [m^2/s] + Kh_zm ! Eddy diffusivity coefficient on momentum levels [m^2/s] + +!$omp threadprivate(Kh_zt, Kh_zm) + +! Mixing lengths + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + Lscale, Lscale_up, Lscale_down ! [m] + +!$omp threadprivate(Lscale, Lscale_up, Lscale_down) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + em, & ! Turbulent Kinetic Energy (TKE) [m^2/s^2] + tau_zm, & ! Eddy dissipation time scale on momentum levels [s] + tau_zt ! Eddy dissipation time scale on thermodynamic levels [s] + +!$omp threadprivate(em, tau_zm, tau_zt) + +! hydrometeors variable array + real( kind = core_rknd ), allocatable, dimension(:,:), public :: hydromet +!$omp threadprivate(hydromet) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + Ncnm ! Cloud nuclei number concentration [num/m^3] +!$omp threadprivate(Ncnm) + + +! Surface data + real( kind = core_rknd ), public :: ustar ! Average value of friction velocity [m/s] + + real( kind = core_rknd ), public :: soil_heat_flux ! Soil Heat Flux [W/m^2] +!$omp threadprivate(ustar, soil_heat_flux) + +! Passive scalar variables + + real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & + wpedsclrp ! w'edsclr' +!$omp threadprivate(wpedsclrp) + + real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & + sclrpthvp, & ! sclr'th_v' + sclrprcp, & ! sclr'rc' + wp2sclrp, & ! w'^2 sclr' + wpsclrp2, & ! w'sclr'^2 + wpsclrprtp, & ! w'sclr'rt' + wpsclrpthlp ! w'sclr'thl' + +!$omp threadprivate(sclrpthvp, sclrprcp, & +!$omp wp2sclrp, wpsclrp2, wpsclrprtp, wpsclrpthlp ) + +! Interpolated variables for tuning +! + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + wp2_zt, & ! w'^2 on thermo. grid [m^2/s^2] + thlp2_zt, & ! thl'^2 on thermo. grid [K^2] + wpthlp_zt, & ! w'thl' on thermo. grid [m K/s] + wprtp_zt, & ! w'rt' on thermo. grid [m kg/(kg s)] + rtp2_zt, & ! rt'^2 on therm. grid [(kg/kg)^2] + rtpthlp_zt, & ! rt'thl' on thermo. grid [kg K/kg] + up2_zt, & ! u'^2 on thermo. grid [m^2/s^2] + vp2_zt, & ! v'^2 on thermo. grid [m^2/s^2] + upwp_zt, & ! u'w' on thermo. grid [m^2/s^2] + vpwp_zt ! v'w' on thermo. grid [m^2/s^2] + +!$omp threadprivate(wp2_zt, thlp2_zt, wpthlp_zt, wprtp_zt, & +!$omp rtp2_zt, rtpthlp_zt, & +!$omp up2_zt, vp2_zt, upwp_zt, vpwp_zt) + + +! Latin Hypercube arrays. Vince Larson 22 May 2005 + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + lh_AKm, & ! Kessler ac estimate [kg/kg/s] + AKm, & ! Exact Kessler ac [kg/kg/s] + AKstd, & ! St dev of exact Kessler ac [kg/kg/s] + AKstd_cld, & ! Stdev of exact w/in cloud ac [kg/kg/s] + lh_rcm_avg, & ! Monte Carlo rcm estimate [kg/kg] + AKm_rcm, & ! Kessler ac based on rcm [kg/kg/s] + AKm_rcc ! Kessler ac based on rcm/cloud_frac [kg/kg/s] + +!$omp threadprivate(lh_AKm, AKm, AKstd, AKstd_cld, lh_rcm_avg, AKm_rcm, & +!$omp AKm_rcc) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + Skw_velocity, & ! Skewness velocity [m/s] + a3_coef, & ! The a3 coefficient from CLUBB eqns [-] + a3_coef_zt ! The a3 coefficient interpolated to the zt grid [-] + +!$omp threadprivate(Skw_velocity, a3_coef, a3_coef_zt) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + wp3_on_wp2, & ! w'^3 / w'^2 on the zm grid [m/s] + wp3_on_wp2_zt ! w'^3 / w'^2 on the zt grid [m/s] + +!$omp threadprivate(wp3_on_wp2, wp3_on_wp2_zt) + + contains + +!----------------------------------------------------------------------- + subroutine setup_diagnostic_variables( nz ) +! Description: +! Allocates and initializes prognostic scalar and array variables +! for the CLUBB model code +!----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + em_min, & ! Constant(s) + zero + + use crmx_parameters_model, only: & + hydromet_dim, & ! Variables + sclr_dim, & + edsclr_dim + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: nz ! Nunber of grid levels [-] + + ! Local Variables + integer :: i + +! --- Allocation --- + + ! Diagnostic variables + + allocate( sigma_sqd_w_zt(1:nz) ) ! PDF width parameter interp. to t-levs. + allocate( Skw_zm(1:nz) ) ! Skewness of w on momentum levels + allocate( Skw_zt(1:nz) ) ! Skewness of w on thermodynamic levels + allocate( ug(1:nz) ) ! u geostrophic wind + allocate( vg(1:nz) ) ! v geostrophic wind + allocate( um_ref(1:nz) ) ! Reference u wind for nudging; Michael Falk, 17 Oct 2007 + allocate( vm_ref(1:nz) ) ! Reference v wind for nudging; Michael Falk, 17 Oct 2007 + allocate( thlm_ref(1:nz) ) ! Reference liquid water potential for nudging + allocate( rtm_ref(1:nz) ) ! Reference total water mixing ratio for nudging + allocate( thvm(1:nz) ) ! Virtual potential temperature + + allocate( rsat(1:nz) ) ! Saturation mixing ratio ! Brian + + allocate( Frad(1:nz) ) ! radiative flux (momentum point) + allocate( Frad_SW_up(1:nz) ) + allocate( Frad_LW_up(1:nz) ) + allocate( Frad_SW_down(1:nz) ) + allocate( Frad_LW_down(1:nz) ) + + allocate( radht(1:nz) ) ! SW + LW heating rate + + ! pdf_params on momentum levels + allocate( pdf_params_zm(1:nz) ) + allocate( pdf_params_zm_frz(1:nz) ) + + ! Second order moments + + allocate( thlprcp(1:nz) ) ! thl'rc' + allocate( rtprcp(1:nz) ) ! rt'rc' + allocate( rcp2(1:nz) ) ! rc'^2 + + ! Third order moments + + allocate( wpthlp2(1:nz) ) ! w'thl'^2 + allocate( wp2thlp(1:nz) ) ! w'^2thl' + allocate( wprtp2(1:nz) ) ! w'rt'^2 + allocate( wp2rtp(1:nz) ) ! w'^2rt' + allocate( wprtpthlp(1:nz) ) ! w'rt'thl' + allocate( wp2rcp(1:nz) ) ! w'^2rc' + + allocate( wp3_zm(1:nz) ) ! w'^3 + + ! Fourth order moments + + allocate( wp4(1:nz) ) + + ! Buoyancy related moments + + allocate( rtpthvp(1:nz) ) ! rt'thv' + allocate( thlpthvp(1:nz) ) ! thl'thv' + allocate( wpthvp(1:nz) ) ! w'thv' + allocate( wp2thvp(1:nz) ) ! w'^2thv' + + allocate( Kh_zt(1:nz) ) ! Eddy diffusivity coefficient: thermo. levels + allocate( Kh_zm(1:nz) ) ! Eddy diffusivity coefficient: momentum levels + + allocate( em(1:nz) ) + allocate( Lscale(1:nz) ) + allocate( Lscale_up(1:nz) ) + allocate( Lscale_down(1:nz) ) + + allocate( tau_zm(1:nz) ) ! Eddy dissipation time scale: momentum levels + allocate( tau_zt(1:nz) ) ! Eddy dissipation time scale: thermo. levels + + + ! Interpolated Variables + allocate( wp2_zt(1:nz) ) ! w'^2 on thermo. grid + allocate( thlp2_zt(1:nz) ) ! thl'^2 on thermo. grid + allocate( wpthlp_zt(1:nz) ) ! w'thl' on thermo. grid + allocate( wprtp_zt(1:nz) ) ! w'rt' on thermo. grid + allocate( rtp2_zt(1:nz) ) ! rt'^2 on thermo. grid + allocate( rtpthlp_zt(1:nz) ) ! rt'thl' on thermo. grid + allocate( up2_zt(1:nz) ) ! u'^2 on thermo. grid + allocate( vp2_zt(1:nz) ) ! v'^2 on thermo. grid + allocate( upwp_zt(1:nz) ) ! u'w' on thermo. grid + allocate( vpwp_zt(1:nz) ) ! v'w' on thermo. grid + + + ! Microphysics Variables + allocate( Ncnm(1:nz) ) + allocate( hydromet(1:nz,1:hydromet_dim) ) ! All hydrometeor fields + + ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 + allocate( lh_AKm(1:nz) ) ! Kessler ac estimate + allocate( AKm(1:nz) ) ! Exact Kessler ac + allocate( AKstd(1:nz) ) ! St dev of exact Kessler ac + allocate( AKstd_cld(1:nz) ) ! St dev of exact w/in cloud Kessler ac + allocate( lh_rcm_avg(1:nz) ) ! Monte Carlo rcm estimate + allocate( AKm_rcm(1:nz) ) ! Kessler ac based on rcm + allocate( AKm_rcc(1:nz) ) ! Kessler ac based on rcm/cloud_frac + ! End of variables for Latin hypercube. + + ! High-order passive scalars + allocate( sclrpthvp(1:nz, 1:sclr_dim) ) + allocate( sclrprcp(1:nz, 1:sclr_dim) ) + + allocate( wp2sclrp(1:nz, 1:sclr_dim) ) + allocate( wpsclrp2(1:nz, 1:sclr_dim) ) + allocate( wpsclrprtp(1:nz, 1:sclr_dim) ) + allocate( wpsclrpthlp(1:nz, 1:sclr_dim) ) + + ! Eddy Diff. Scalars + allocate( wpedsclrp(1:nz, 1:edsclr_dim) ) + + allocate( Skw_velocity(1:nz) ) + + allocate( a3_coef(1:nz) ) + allocate( a3_coef_zt(1:nz) ) + + allocate( wp3_on_wp2(1:nz) ) + allocate( wp3_on_wp2_zt(1:nz) ) + + ! --- Initializaton --- + + ! Diagnostic variables + + sigma_sqd_w_zt = 0.0_core_rknd ! PDF width parameter interp. to t-levs. + Skw_zm = 0.0_core_rknd ! Skewness of w on momentum levels + Skw_zt = 0.0_core_rknd ! Skewness of w on thermodynamic levels + ug = 0.0_core_rknd ! u geostrophic wind + vg = 0.0_core_rknd ! v geostrophic wind + um_ref = 0.0_core_rknd + vm_ref = 0.0_core_rknd + thlm_ref = 0.0_core_rknd + rtm_ref = 0.0_core_rknd + + thvm = 0.0_core_rknd ! Virtual potential temperature + rsat = 0.0_core_rknd ! Saturation mixing ratio ! Brian + + radht = 0.0_core_rknd ! Heating rate + Frad = 0.0_core_rknd ! Radiative flux + Frad_SW_up = 0.0_core_rknd + Frad_LW_up = 0.0_core_rknd + Frad_SW_down = 0.0_core_rknd + Frad_LW_down = 0.0_core_rknd + + + ! pdf_params on momentum levels + pdf_params_zm(:)%w1 = zero + pdf_params_zm(:)%w2 = zero + pdf_params_zm(:)%varnce_w1 = zero + pdf_params_zm(:)%varnce_w2 = zero + pdf_params_zm(:)%rt1 = zero + pdf_params_zm(:)%rt2 = zero + pdf_params_zm(:)%varnce_rt1 = zero + pdf_params_zm(:)%varnce_rt2 = zero + pdf_params_zm(:)%thl1 = zero + pdf_params_zm(:)%thl2 = zero + pdf_params_zm(:)%varnce_thl1 = zero + pdf_params_zm(:)%varnce_thl2 = zero + pdf_params_zm(:)%rrtthl = zero + pdf_params_zm(:)%alpha_thl = zero + pdf_params_zm(:)%alpha_rt = zero + pdf_params_zm(:)%crt1 = zero + pdf_params_zm(:)%crt2 = zero + pdf_params_zm(:)%cthl1 = zero + pdf_params_zm(:)%cthl2 = zero + pdf_params_zm(:)%s1 = zero + pdf_params_zm(:)%s2 = zero + pdf_params_zm(:)%stdev_s1 = zero + pdf_params_zm(:)%stdev_s2 = zero + pdf_params_zm(:)%stdev_t1 = zero + pdf_params_zm(:)%stdev_t2 = zero + pdf_params_zm(:)%covar_st_1 = zero + pdf_params_zm(:)%covar_st_2 = zero + pdf_params_zm(:)%corr_st_1 = zero + pdf_params_zm(:)%corr_st_2 = zero + pdf_params_zm(:)%rsl1 = zero + pdf_params_zm(:)%rsl2 = zero + pdf_params_zm(:)%rc1 = zero + pdf_params_zm(:)%rc2 = zero + pdf_params_zm(:)%cloud_frac1 = zero + pdf_params_zm(:)%cloud_frac2 = zero + pdf_params_zm(:)%mixt_frac = zero + + pdf_params_zm_frz(:)%w1 = zero + pdf_params_zm_frz(:)%w2 = zero + pdf_params_zm_frz(:)%varnce_w1 = zero + pdf_params_zm_frz(:)%varnce_w2 = zero + pdf_params_zm_frz(:)%rt1 = zero + pdf_params_zm_frz(:)%rt2 = zero + pdf_params_zm_frz(:)%varnce_rt1 = zero + pdf_params_zm_frz(:)%varnce_rt2 = zero + pdf_params_zm_frz(:)%thl1 = zero + pdf_params_zm_frz(:)%thl2 = zero + pdf_params_zm_frz(:)%varnce_thl1 = zero + pdf_params_zm_frz(:)%varnce_thl2 = zero + pdf_params_zm_frz(:)%rrtthl = zero + pdf_params_zm_frz(:)%alpha_thl = zero + pdf_params_zm_frz(:)%alpha_rt = zero + pdf_params_zm_frz(:)%crt1 = zero + pdf_params_zm_frz(:)%crt2 = zero + pdf_params_zm_frz(:)%cthl1 = zero + pdf_params_zm_frz(:)%cthl2 = zero + pdf_params_zm_frz(:)%s1 = zero + pdf_params_zm_frz(:)%s2 = zero + pdf_params_zm_frz(:)%stdev_s1 = zero + pdf_params_zm_frz(:)%stdev_s2 = zero + pdf_params_zm_frz(:)%stdev_t1 = zero + pdf_params_zm_frz(:)%stdev_t2 = zero + pdf_params_zm_frz(:)%covar_st_1 = zero + pdf_params_zm_frz(:)%covar_st_2 = zero + pdf_params_zm_frz(:)%corr_st_1 = zero + pdf_params_zm_frz(:)%corr_st_2 = zero + pdf_params_zm_frz(:)%rsl1 = zero + pdf_params_zm_frz(:)%rsl2 = zero + pdf_params_zm_frz(:)%rc1 = zero + pdf_params_zm_frz(:)%rc2 = zero + pdf_params_zm_frz(:)%cloud_frac1 = zero + pdf_params_zm_frz(:)%cloud_frac2 = zero + pdf_params_zm_frz(:)%mixt_frac = zero + + ! Second order moments + thlprcp = 0.0_core_rknd + rtprcp = 0.0_core_rknd + rcp2 = 0.0_core_rknd + + ! Third order moments + wpthlp2 = 0.0_core_rknd + wp2thlp = 0.0_core_rknd + wprtp2 = 0.0_core_rknd + wp2rtp = 0.0_core_rknd + wp2rcp = 0.0_core_rknd + wprtpthlp = 0.0_core_rknd + + wp3_zm = 0.0_core_rknd + + ! Fourth order moments + wp4 = 0.0_core_rknd + + ! Buoyancy related moments + rtpthvp = 0.0_core_rknd ! rt'thv' + thlpthvp = 0.0_core_rknd ! thl'thv' + wpthvp = 0.0_core_rknd ! w'thv' + wp2thvp = 0.0_core_rknd ! w'^2thv' + + ! Eddy diffusivity + Kh_zt = 0.0_core_rknd ! Eddy diffusivity coefficient: thermo. levels + Kh_zm = 0.0_core_rknd ! Eddy diffusivity coefficient: momentum levels + + ! TKE + em = em_min + + ! Length scale + Lscale = 0.0_core_rknd + Lscale_up = 0.0_core_rknd + Lscale_down = 0.0_core_rknd + + ! Dissipation time + tau_zm = 0.0_core_rknd ! Eddy dissipation time scale: momentum levels + tau_zt = 0.0_core_rknd ! Eddy dissipation time scale: thermo. levels + + ! Hydrometer types + Ncnm(1:nz) = 0.0_core_rknd ! Cloud nuclei number concentration (COAMPS) + + do i = 1, hydromet_dim, 1 + hydromet(1:nz,i) = 0.0_core_rknd + end do + + + ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 + lh_AKm = 0.0_core_rknd ! Kessler ac estimate + AKm = 0.0_core_rknd ! Exact Kessler ac + AKstd = 0.0_core_rknd ! St dev of exact Kessler ac + AKstd_cld = 0.0_core_rknd ! St dev of exact w/in cloud Kessler ac + lh_rcm_avg = 0.0_core_rknd ! Monte Carlo rcm estimate + AKm_rcm = 0.0_core_rknd ! Kessler ac based on rcm + AKm_rcc = 0.0_core_rknd ! Kessler ac based on rcm/cloud_frac + + ! Passive scalars + if ( sclr_dim > 0 ) then + sclrpthvp(:,:) = 0.0_core_rknd + sclrprcp(:,:) = 0.0_core_rknd + + wp2sclrp(:,:) = 0.0_core_rknd + wpsclrp2(:,:) = 0.0_core_rknd + wpsclrprtp(:,:) = 0.0_core_rknd + wpsclrpthlp(:,:) = 0.0_core_rknd + + end if + + if ( edsclr_dim > 0 ) then + wpedsclrp(:,:) = 0.0_core_rknd + end if + + Skw_velocity = 0.0_core_rknd + + a3_coef = 0.0_core_rknd + a3_coef_zt = 0.0_core_rknd + + wp3_on_wp2 = 0.0_core_rknd + wp3_on_wp2_zt = 0.0_core_rknd + + return + end subroutine setup_diagnostic_variables + +!------------------------------------------------------------------------ + subroutine cleanup_diagnostic_variables( ) + +! Description: +! Subroutine to deallocate variables defined in module global +!------------------------------------------------------------------------ + + implicit none + + + ! --- Deallocate --- + + deallocate( sigma_sqd_w_zt ) ! PDF width parameter interp. to t-levs. + deallocate( Skw_zm ) ! Skewness of w on momentum levels + deallocate( Skw_zt ) ! Skewness of w on thermodynamic levels + deallocate( ug ) ! u geostrophic wind + deallocate( vg ) ! v geostrophic wind + deallocate( um_ref ) ! u initial + deallocate( vm_ref ) ! v initial + deallocate( thlm_ref ) + deallocate( rtm_ref ) + + deallocate( thvm ) ! virtual potential temperature + deallocate( rsat ) ! saturation mixing ratio ! Brian + + deallocate( Frad ) ! radiative flux (momentum point) + + deallocate( Frad_SW_up ) ! upwelling shortwave radiative flux + deallocate( Frad_LW_up ) ! upwelling longwave radiative flux + deallocate( Frad_SW_down ) ! downwelling shortwave radiative flux + deallocate( Frad_LW_down ) ! downwelling longwave radiative flux + + deallocate( radht ) ! SW + LW heating rate + + deallocate( pdf_params_zm ) + deallocate( pdf_params_zm_frz ) + + ! Second order moments + + deallocate( thlprcp ) ! thl'rc' + deallocate( rtprcp ) ! rt'rc' + deallocate( rcp2 ) ! rc'^2 + + ! Third order moments + + deallocate( wpthlp2 ) ! w'thl'^2 + deallocate( wp2thlp ) ! w'^2thl' + deallocate( wprtp2 ) ! w'rt'^2 + deallocate( wp2rtp ) ! w'^2rt' + deallocate( wprtpthlp ) ! w'rt'thl' + deallocate( wp2rcp ) ! w'^2rc' + + deallocate( wp3_zm ) + + ! Fourth order moments + + deallocate( wp4 ) + + ! Buoyancy related moments + + deallocate( rtpthvp ) ! rt'thv' + deallocate( thlpthvp ) ! thl'thv' + deallocate( wpthvp ) ! w'thv' + deallocate( wp2thvp ) ! w'^2thv' + + deallocate( Kh_zt ) ! Eddy diffusivity coefficient: thermo. levels + deallocate( Kh_zm ) ! Eddy diffusivity coefficient: momentum levels + + deallocate( em ) + deallocate( Lscale ) + deallocate( Lscale_up ) + deallocate( Lscale_down ) + deallocate( tau_zm ) ! Eddy dissipation time scale: momentum levels + deallocate( tau_zt ) ! Eddy dissipation time scale: thermo. levels + + ! Cloud water variables + + deallocate( Ncnm ) + + deallocate( hydromet ) ! Hydrometeor fields + + + ! Interpolated variables for tuning + deallocate( wp2_zt ) ! w'^2 on thermo. grid + deallocate( thlp2_zt ) ! th_l'^2 on thermo. grid + deallocate( wpthlp_zt ) ! w'th_l' on thermo. grid + deallocate( wprtp_zt ) ! w'rt' on thermo. grid + deallocate( rtp2_zt ) ! rt'^2 on thermo. grid + deallocate( rtpthlp_zt ) ! rt'th_l' on thermo. grid + deallocate( up2_zt ) ! u'^2 on thermo. grid + deallocate( vp2_zt ) ! v'^2 on thermo. grid + deallocate( upwp_zt ) ! u'w' on thermo. grid + deallocate( vpwp_zt ) ! v'w' on thermo. grid + + ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 + deallocate( lh_AKm ) ! Kessler ac estimate + deallocate( AKm ) ! Exact Kessler ac + deallocate( AKstd ) ! St dev of exact Kessler ac + deallocate( AKstd_cld ) ! St dev of exact w/in cloud Kessler ac + deallocate( lh_rcm_avg ) ! Monte Carlo rcm estimate + deallocate( AKm_rcm ) ! Kessler ac based on rcm + deallocate( AKm_rcc ) ! Kessler ac based on rcm/cloud_frac + + ! Passive scalars + deallocate( sclrpthvp ) + deallocate( sclrprcp ) + + deallocate( wp2sclrp ) + deallocate( wpsclrp2 ) + deallocate( wpsclrprtp ) + deallocate( wpsclrpthlp ) + + deallocate( wpedsclrp ) + + deallocate( Skw_velocity ) + + deallocate( a3_coef ) + deallocate( a3_coef_zt ) + + deallocate( wp3_on_wp2 ) + deallocate( wp3_on_wp2_zt ) + + return + end subroutine cleanup_diagnostic_variables + +end module crmx_variables_diagnostic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 new file mode 100644 index 0000000000..40b9a3163d --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 @@ -0,0 +1,560 @@ +!----------------------------------------------------------------------- +! $Id: variables_prognostic_module.F90 6117 2013-03-25 19:16:04Z storer@uwm.edu $ +module crmx_variables_prognostic_module + +! This module contains definitions of all prognostic +! arrays used in the single column model, as well as subroutines +! to allocate, deallocate and initialize them. + +! Note that while these are all same dimension, there is a +! thermodynamic grid and a momentum grid, and the grids have +! different points. +!----------------------------------------------------------------------- + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Derived type + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + private ! Set Default Scoping + + public :: & + setup_prognostic_variables, & + cleanup_prognostic_variables + + ! Prognostic variables +! ---> h1g, 2010-06-16 +#ifdef GFDL + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + um, & ! u wind [m/s] + vm, & ! v wind [m/s] + upwp, & ! vertical u momentum flux [m^2/s^2] + vpwp, & ! vertical v momentum flux [m^2/s^2] + up2, & ! u'^2 [m^2/s^2] + vp2, & ! v'^2 [m^2/s^2] + thlm, & ! liquid potential temperature [K] +!---> h1g + temp_clubb, & ! air temperature [K] +!<--- h1g + rtm, & ! total water mixing ratio [kg/kg] + wprtp, & ! w'rt' [(kg/kg) m/s] + wpthlp, & ! w'thl' [m K/s] + wprcp, & ! w'rc' [(kg/kg) m/s] + wp2, & ! w'^2 [m^2/s^2] + wp3, & ! w'^3 [m^3/s^3] + rtp2, & ! rt'^2 [(kg/kg)^2] + thlp2, & ! thl'^2 [K^2] + rtpthlp ! rt'thl' [kg/kg K] +#else + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + um, & ! u wind [m/s] + vm, & ! v wind [m/s] + upwp, & ! vertical u momentum flux [m^2/s^2] + vpwp, & ! vertical v momentum flux [m^2/s^2] + up2, & ! u'^2 [m^2/s^2] + vp2, & ! v'^2 [m^2/s^2] + thlm, & ! liquid potential temperature [K] + rtm, & ! total water mixing ratio [kg/kg] + wprtp, & ! w'rt' [(kg/kg) m/s] + wpthlp, & ! w'thl' [m K/s] + wprcp, & ! w'rc' [(kg/kg) m/s] + wp2, & ! w'^2 [m^2/s^2] + wp3, & ! w'^3 [m^3/s^3] + rtp2, & ! rt'^2 [(kg/kg)^2] + thlp2, & ! thl'^2 [K^2] + rtpthlp ! rt'thl' [kg/kg K] +#endif +! <--- h1g, 2010-06-16 + +!$omp threadprivate(um, vm, upwp, vpwp, up2, vp2) +!$omp threadprivate(thlm, rtm, wprtp, wpthlp, wprcp) +!$omp threadprivate(wp2, wp3, rtp2, thlp2, rtpthlp) + + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + p_in_Pa, & ! Pressure (Pa) (thermodynamic levels) [Pa] + exner, & ! Exner function = ( p / p0 ) ** kappa [-] + rho, & ! Density (thermodynamic levels) [kg/m^3] + rho_zm, & ! Density on momentum levels [kg/m^3] + rho_ds_zm, & ! Dry, static density (momentum levels) [kg/m^3] + rho_ds_zt, & ! Dry, static density (thermodynamic levels) [kg/m^3] + invrs_rho_ds_zm, & ! Inverse dry, static density (momentum levs.) [m^3/kg] + invrs_rho_ds_zt, & ! Inverse dry, static density (thermo. levs.) [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v (momentum levels) [K] + thv_ds_zt, & ! Dry, base-state theta_v (thermodynamic levs.) [K] + thlm_forcing, & ! thlm large-scale forcing [K/s] + rtm_forcing, & ! rtm large-scale forcing [kg/kg/s] + um_forcing, & ! u wind forcing [m/s/s] + vm_forcing, & ! v wind forcing [m/s/s] + wprtp_forcing, & ! forcing (momentum levels) [m*K/s^2] + wpthlp_forcing, & ! forcing (momentum levels) [m*(kg/kg)/s^2] + rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] + thlp2_forcing, & ! forcing (momentum levels) [K^2/s] + rtpthlp_forcing ! forcing (momentum levels) [K*(kg/kg)/s] + +!$omp threadprivate( p_in_Pa, exner, rho, rho_zm, rho_ds_zm, rho_ds_zt, & +!$omp invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & +!$omp thlm_forcing, rtm_forcing, um_forcing, vm_forcing, wprtp_forcing, & +!$omp wpthlp_forcing, rtp2_forcing, thlp2_forcing, rtpthlp_forcing ) + + ! Imposed large scale w + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + wm_zm, & ! w on momentum levels [m/s] + wm_zt ! w on thermodynamic levels [m/s] + +!$omp threadprivate(wm_zm, wm_zt) + + ! Cloud water variables + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + rcm, & ! Cloud water mixing ratio [kg/kg] + cloud_frac, & ! Cloud fraction [-] + ice_supersat_frac, & ! Ice cloud fraction [-] + rcm_in_layer, & ! Cloud water mixing ratio in cloud layer [kg/kg] + cloud_cover ! Cloud cover [-] + +!$omp threadprivate(rcm, cloud_frac, rcm_in_layer, cloud_cover) + + ! Surface fluxes + real( kind = core_rknd ), public :: & + wpthlp_sfc, & ! w'thl' [m K/s] + wprtp_sfc, & ! w'rt' [m kg/(kg s)] + upwp_sfc, vpwp_sfc ! u'w' & v'w' [m^2/s^2] + +!$omp threadprivate(wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc) + + ! Surface fluxes for passive scalars + real( kind = core_rknd ), dimension(:), allocatable, public :: & + wpsclrp_sfc, & ! w'sclr' at surface [units m/s] + wpedsclrp_sfc ! w'edsclr' at surface [units m/s] + +!$omp threadprivate(wpsclrp_sfc, wpedsclrp_sfc) + + ! More surface data + real( kind = core_rknd ), public :: & + T_sfc, & ! surface temperature [K] + p_sfc, & ! surface pressure [Pa] + sens_ht, & ! sensible heat flux [K m/s] + latent_ht ! latent heat flux [m/s] + +!$omp threadprivate(T_sfc, p_sfc, sens_ht, latent_ht) + + ! Passive scalars + real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & + sclrm, & ! Mean passive scalars [units vary] + sclrp2, & ! sclr'^2 [units^2] + sclrprtp, & ! sclr'rt' [units kg/kg] + sclrpthlp, & ! sclr'th_l' [units K] + sclrm_forcing, & ! Scalars' forcing [units/s] + edsclrm, & ! Mean eddy-diffusivity scalars [units vary] + edsclrm_forcing, & ! Eddy-diff. scalars forcing [units/s] + wpsclrp ! w'sclr' [units vary m/s] + +!---> h1g, 2010-06-16 +#ifdef GFDL + real( kind = core_rknd ), target, allocatable, dimension( : , : , : ), public :: & + RH_crit ! critical relative humidity for droplet and ice nucleation +#endif +!<--- h1g, 2010-06-16 + +!$omp threadprivate(sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & +!$omp edsclrm, edsclrm_forcing, wpsclrp) + + ! PDF parameters + real( kind = core_rknd ), target, allocatable, dimension(:), public :: & + sigma_sqd_w ! PDF width parameter (momentum levels) [-] + +!$omp threadprivate(sigma_sqd_w) + + type(pdf_parameter), target, allocatable, dimension(:), public :: & + pdf_params, & + pdf_params_frz !for use when l_use_ice_latent = .true. + +!$omp threadprivate(pdf_params) + + contains +!----------------------------------------------------------------------- + subroutine setup_prognostic_variables( nz ) + +! Description: +! Allocates and Initializes prognostic scalar and array variables +! for the CLUBB parameterization. Variables contained within this module +! will be arguments to the advance_clubb_core subroutine rather than brought +! in through a use statement. + +! References: +! None +!----------------------------------------------------------------------- + use crmx_constants_clubb, only: & + rt_tol, & ! Constant(s) + thl_tol, & + w_tol_sqd, & + zero + + use crmx_parameters_model, only: & + sclr_dim, & ! Variable(s) + edsclr_dim + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + integer, intent(in) :: nz ! Number of grid levels [-] + + integer :: i + +! --- Allocation --- + +! Prognostic variables + + allocate( um(1:nz) ) ! u wind + allocate( vm(1:nz) ) ! v wind + + allocate( upwp(1:nz) ) ! vertical u momentum flux + allocate( vpwp(1:nz) ) ! vertical v momentum flux + + allocate( up2(1:nz) ) + allocate( vp2(1:nz) ) + + allocate( thlm(1:nz) ) ! liquid potential temperature +!---> h1g, 2010-06-16 +#ifdef GFDL + allocate( temp_clubb(1:nz) ) ! air temperature +#endif +!<--- h1g, 2010-06-16 + + allocate( rtm(1:nz) ) ! total water mixing ratio + allocate( wprtp(1:nz) ) ! w'rt' + allocate( wpthlp(1:nz) ) ! w'thl' + allocate( wprcp(1:nz) ) ! w'rc' + allocate( wp2(1:nz) ) ! w'^2 + allocate( wp3(1:nz) ) ! w'^3 + allocate( rtp2(1:nz) ) ! rt'^2 + allocate( thlp2(1:nz) ) ! thl'^2 + allocate( rtpthlp(1:nz) ) ! rt'thlp' + + allocate( p_in_Pa(1:nz) ) ! pressure (pascals) + allocate( exner(1:nz) ) ! exner function + allocate( rho(1:nz) ) ! density: t points + allocate( rho_zm(1:nz) ) ! density: m points + allocate( rho_ds_zm(1:nz) ) ! dry, static density: m-levs + allocate( rho_ds_zt(1:nz) ) ! dry, static density: t-levs + allocate( invrs_rho_ds_zm(1:nz) ) ! inv. dry, static density: m-levs + allocate( invrs_rho_ds_zt(1:nz) ) ! inv. dry, static density: t-levs + allocate( thv_ds_zm(1:nz) ) ! dry, base-state theta_v: m-levs + allocate( thv_ds_zt(1:nz) ) ! dry, base-state theta_v: t-levs + + allocate( thlm_forcing(1:nz) ) ! thlm ls forcing + allocate( rtm_forcing(1:nz) ) ! rtm ls forcing + allocate( um_forcing(1:nz) ) ! u forcing + allocate( vm_forcing(1:nz) ) ! v forcing + allocate( wprtp_forcing(1:nz) ) ! forcing (microphysics) + allocate( wpthlp_forcing(1:nz) ) ! forcing (microphysics) + allocate( rtp2_forcing(1:nz) ) ! forcing (microphysics) + allocate( thlp2_forcing(1:nz) ) ! forcing (microphysics) + allocate( rtpthlp_forcing(1:nz) ) ! forcing (microphysics) + + ! Imposed large scale w + + allocate( wm_zm(1:nz) ) ! momentum levels + allocate( wm_zt(1:nz) ) ! thermodynamic levels + + ! Cloud water variables + + allocate( rcm(1:nz) ) + allocate( cloud_frac(1:nz) ) + allocate( ice_supersat_frac(1:nz) ) + allocate( rcm_in_layer(1:nz) ) + allocate( cloud_cover(1:nz) ) + + ! Passive scalar variables + ! Note that sclr_dim can be 0 + allocate( wpsclrp_sfc(1:sclr_dim) ) + allocate( sclrm(1:nz, 1:sclr_dim) ) + allocate( sclrp2(1:nz, 1:sclr_dim) ) + allocate( sclrm_forcing(1:nz, 1:sclr_dim) ) + allocate( sclrprtp(1:nz, 1:sclr_dim) ) + allocate( sclrpthlp(1:nz, 1:sclr_dim) ) + + allocate( wpedsclrp_sfc(1:edsclr_dim) ) + allocate( edsclrm_forcing(1:nz, 1:edsclr_dim) ) + + allocate( edsclrm(1:nz, 1:edsclr_dim) ) + allocate( wpsclrp(1:nz, 1:sclr_dim) ) + +!---> h1g, 2010-06-16 +#ifdef GFDL + allocate( RH_crit(1:nz, 1:min(1,sclr_dim), 2) ) +#endif +!<--- h1g, 2010-06-16 + + allocate( sigma_sqd_w(1:nz) ) ! PDF width parameter (momentum levels) + + ! Variables for pdf closure scheme + allocate( pdf_params(1:nz) ) + allocate( pdf_params_frz(1:nz) ) + +!--------- Set initial values for array variables --------- + + ! Prognostic variables + + um(1:nz) = 0.0_core_rknd ! u wind + vm (1:nz) = 0.0_core_rknd ! v wind + + upwp(1:nz) = 0.0_core_rknd ! vertical u momentum flux + vpwp(1:nz) = 0.0_core_rknd ! vertical v momentum flux + + up2(1:nz) = w_tol_sqd ! u'^2 + vp2(1:nz) = w_tol_sqd ! v'^2 + wp2(1:nz) = w_tol_sqd ! w'^2 + + thlm(1:nz) = 0.0_core_rknd ! liquid potential temperature + rtm(1:nz) = 0.0_core_rknd ! total water mixing ratio + wprtp(1:nz) = 0.0_core_rknd ! w'rt' + wpthlp(1:nz) = 0.0_core_rknd ! w'thl' + wprcp(1:nz) = 0.0_core_rknd ! w'rc' + wp3(1:nz) = 0.0_core_rknd ! w'^3 + rtp2(1:nz) = rt_tol**2 ! rt'^2 + thlp2(1:nz) = thl_tol**2 ! thl'^2 + rtpthlp(1:nz) = 0.0_core_rknd ! rt'thl' + + p_in_Pa(1:nz)= 0.0_core_rknd ! pressure (Pa) + exner(1:nz) = 0.0_core_rknd ! exner + rho(1:nz) = 0.0_core_rknd ! density on thermo. levels + rho_zm(1:nz) = 0.0_core_rknd ! density on moment. levels + rho_ds_zm(1:nz) = 0.0_core_rknd ! dry, static density: m-levs + rho_ds_zt(1:nz) = 0.0_core_rknd ! dry, static density: t-levs + invrs_rho_ds_zm(1:nz) = 0.0_core_rknd ! inv. dry, static density: m-levs + invrs_rho_ds_zt(1:nz) = 0.0_core_rknd ! inv. dry, static density: t-levs + thv_ds_zm(1:nz) = 0.0_core_rknd ! dry, base-state theta_v: m-levs + thv_ds_zt(1:nz) = 0.0_core_rknd ! dry, base-state theta_v: t-levs + + thlm_forcing(1:nz) = zero ! thlm large-scale forcing + rtm_forcing(1:nz) = zero ! rtm large-scale forcing + um_forcing(1:nz) = zero ! u forcing + vm_forcing(1:nz) = zero ! v forcing + wprtp_forcing(1:nz) = zero ! forcing (microphysics) + wpthlp_forcing(1:nz) = zero ! forcing (microphysics) + rtp2_forcing(1:nz) = zero ! forcing (microphysics) + thlp2_forcing(1:nz) = zero ! forcing (microphysics) + rtpthlp_forcing(1:nz) = zero ! forcing (microphysics) + + ! Imposed large scale w + + wm_zm(1:nz) = 0.0_core_rknd ! Momentum levels + wm_zt(1:nz) = 0.0_core_rknd ! Thermodynamic levels + + ! Cloud water variables + + rcm(1:nz) = 0.0_core_rknd + cloud_frac(1:nz) = 0.0_core_rknd + ice_supersat_frac(1:nz) = 0.0_core_rknd + rcm_in_layer(1:nz) = 0.0_core_rknd + cloud_cover(1:nz) = 0.0_core_rknd + + sigma_sqd_w = 0.0_core_rknd ! PDF width parameter (momentum levels) + + ! Variables for PDF closure scheme + pdf_params(:)%w1 = zero + pdf_params(:)%w2 = zero + pdf_params(:)%varnce_w1 = zero + pdf_params(:)%varnce_w2 = zero + pdf_params(:)%rt1 = zero + pdf_params(:)%rt2 = zero + pdf_params(:)%varnce_rt1 = zero + pdf_params(:)%varnce_rt2 = zero + pdf_params(:)%thl1 = zero + pdf_params(:)%thl2 = zero + pdf_params(:)%varnce_thl1 = zero + pdf_params(:)%varnce_thl2 = zero + pdf_params(:)%rrtthl = zero + pdf_params(:)%alpha_thl = zero + pdf_params(:)%alpha_rt = zero + pdf_params(:)%crt1 = zero + pdf_params(:)%crt2 = zero + pdf_params(:)%cthl1 = zero + pdf_params(:)%cthl2 = zero + pdf_params(:)%s1 = zero + pdf_params(:)%s2 = zero + pdf_params(:)%stdev_s1 = zero + pdf_params(:)%stdev_s2 = zero + pdf_params(:)%stdev_t1 = zero + pdf_params(:)%stdev_t2 = zero + pdf_params(:)%covar_st_1 = zero + pdf_params(:)%covar_st_2 = zero + pdf_params(:)%corr_st_1 = zero + pdf_params(:)%corr_st_2 = zero + pdf_params(:)%rsl1 = zero + pdf_params(:)%rsl2 = zero + pdf_params(:)%rc1 = zero + pdf_params(:)%rc2 = zero + pdf_params(:)%cloud_frac1 = zero + pdf_params(:)%cloud_frac2 = zero + pdf_params(:)%mixt_frac = zero + + pdf_params_frz(:)%w1 = zero + pdf_params_frz(:)%w2 = zero + pdf_params_frz(:)%varnce_w1 = zero + pdf_params_frz(:)%varnce_w2 = zero + pdf_params_frz(:)%rt1 = zero + pdf_params_frz(:)%rt2 = zero + pdf_params_frz(:)%varnce_rt1 = zero + pdf_params_frz(:)%varnce_rt2 = zero + pdf_params_frz(:)%thl1 = zero + pdf_params_frz(:)%thl2 = zero + pdf_params_frz(:)%varnce_thl1 = zero + pdf_params_frz(:)%varnce_thl2 = zero + pdf_params_frz(:)%rrtthl = zero + pdf_params_frz(:)%alpha_thl = zero + pdf_params_frz(:)%alpha_rt = zero + pdf_params_frz(:)%crt1 = zero + pdf_params_frz(:)%crt2 = zero + pdf_params_frz(:)%cthl1 = zero + pdf_params_frz(:)%cthl2 = zero + pdf_params_frz(:)%s1 = zero + pdf_params_frz(:)%s2 = zero + pdf_params_frz(:)%stdev_s1 = zero + pdf_params_frz(:)%stdev_s2 = zero + pdf_params_frz(:)%stdev_t1 = zero + pdf_params_frz(:)%stdev_t2 = zero + pdf_params_frz(:)%covar_st_1 = zero + pdf_params_frz(:)%covar_st_2 = zero + pdf_params_frz(:)%corr_st_1 = zero + pdf_params_frz(:)%corr_st_2 = zero + pdf_params_frz(:)%rsl1 = zero + pdf_params_frz(:)%rsl2 = zero + pdf_params_frz(:)%rc1 = zero + pdf_params_frz(:)%rc2 = zero + pdf_params_frz(:)%cloud_frac1 = zero + pdf_params_frz(:)%cloud_frac2 = zero + pdf_params_frz(:)%mixt_frac = zero + + ! Surface fluxes + wpthlp_sfc = 0.0_core_rknd + wprtp_sfc = 0.0_core_rknd + upwp_sfc = 0.0_core_rknd + vpwp_sfc = 0.0_core_rknd + +! ---> h1g, 2010-06-16 +! initialize critical relative humidity for liquid and ice nucleation +#ifdef GFDL + RH_crit = 1.0_core_rknd +#endif +!<--- h1g, 2010-06-16 + + ! Passive scalars + do i = 1, sclr_dim, 1 + wpsclrp_sfc(i) = 0.0_core_rknd + + sclrm(1:nz,i) = 0.0_core_rknd + sclrp2(1:nz,i) = 0.0_core_rknd + sclrprtp(1:nz,i) = 0.0_core_rknd + sclrpthlp(1:nz,i) = 0.0_core_rknd + sclrm_forcing(1:nz,i) = 0.0_core_rknd + wpsclrp(1:nz,i) = 0.0_core_rknd + end do + + do i = 1, edsclr_dim, 1 + wpedsclrp_sfc(i) = 0.0_core_rknd + + edsclrm(1:nz,i) = 0.0_core_rknd + edsclrm_forcing(1:nz,i) = 0.0_core_rknd + end do + + return + end subroutine setup_prognostic_variables +!----------------------------------------------------------------------- + subroutine cleanup_prognostic_variables + implicit none + + ! Prognostic variables + + deallocate( um ) ! u wind + deallocate( vm ) ! v wind + + deallocate( upwp ) ! vertical u momentum flux + deallocate( vpwp ) ! vertical v momentum flux + + deallocate( up2, vp2 ) + + deallocate( thlm ) ! liquid potential temperature + +!---> h1g, 2010-06-16 +#ifdef GFDL + deallocate( temp_clubb ) +#endif +!<--- h1g, 2010-06-16 + + deallocate( rtm ) ! total water mixing ratio + deallocate( wprtp ) ! w'rt' + deallocate( wpthlp ) ! w'thl' + deallocate( wprcp ) ! w'rc' + deallocate( wp2 ) ! w'^2 + deallocate( wp3 ) ! w'^3 + deallocate( rtp2 ) ! rt'^2 + deallocate( thlp2 ) ! thl'^2 + deallocate( rtpthlp ) ! rt'thl' + + deallocate( p_in_Pa ) ! pressure + deallocate( exner ) ! exner + deallocate( rho ) ! density: t points + deallocate( rho_zm ) ! density: m points + deallocate( rho_ds_zm ) ! dry, static density: m-levs + deallocate( rho_ds_zt ) ! dry, static density: t-levs + deallocate( invrs_rho_ds_zm ) ! inv. dry, static density: m-levs + deallocate( invrs_rho_ds_zt ) ! inv. dry, static density: t-levs + deallocate( thv_ds_zm ) ! dry, base-state theta_v: m-levs + deallocate( thv_ds_zt ) ! dry, base-state theta_v: t-levs + + deallocate( thlm_forcing ) ! thlm large-scale forcing + deallocate( rtm_forcing ) ! rtm large-scale forcing + deallocate( um_forcing ) ! u forcing + deallocate( vm_forcing ) ! v forcing + deallocate( wprtp_forcing ) ! forcing (microphysics) + deallocate( wpthlp_forcing ) ! forcing (microphysics) + deallocate( rtp2_forcing ) ! forcing (microphysics) + deallocate( thlp2_forcing ) ! forcing (microphysics) + deallocate( rtpthlp_forcing ) ! forcing (microphysics) + + ! Imposed large scale w + + deallocate( wm_zm ) ! momentum levels + deallocate( wm_zt ) ! thermodynamic levels + + ! Cloud water variables + + deallocate( rcm ) + deallocate( cloud_frac ) + deallocate( ice_supersat_frac ) + deallocate( rcm_in_layer ) + deallocate( cloud_cover ) + + deallocate( sigma_sqd_w ) ! PDF width parameter (momentum levels) + + ! Variable for pdf closure scheme + deallocate( pdf_params ) + deallocate( pdf_params_frz ) + + ! Passive scalars + deallocate( wpsclrp_sfc, wpedsclrp_sfc ) + deallocate( sclrm ) + deallocate( sclrp2 ) + deallocate( sclrprtp ) + deallocate( sclrpthlp ) + deallocate( sclrm_forcing ) + deallocate( wpsclrp ) + + deallocate( edsclrm ) + deallocate( edsclrm_forcing ) + +!---> h1g, 2010-06-16 +#ifdef GFDL + deallocate( RH_crit ) +#endif +! <--- h1g, 2010-06-16 + + return + end subroutine cleanup_prognostic_variables + +end module crmx_variables_prognostic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 new file mode 100644 index 0000000000..3b1886cbae --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 @@ -0,0 +1,203 @@ +!--------------------------------------------------------------- +! $Id: variables_radiation_module.F90 5982 2012-11-21 19:20:12Z raut@uwm.edu $ +module crmx_variables_radiation_module + +! This module contains definitions of all radiation arrays +! used in the single column model, as well as subroutines to +! allocate, deallocate, and initialize them. +!--------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + + public :: & + setup_radiation_variables, & + cleanup_radiation_variables + + private ! Set Default Scoping + + integer, private, parameter :: dp = selected_real_kind( p=12 ) + + real( kind = core_rknd ), public, dimension(:), allocatable :: & + radht_LW, & ! LW heating rate [K/s] + radht_SW, & ! SW heating rate [K/s] + Frad_SW, & ! SW radiative flux [W/m^2] + Frad_LW ! LW radiative flux [W/m^2] + +!$omp threadprivate(radht_LW, radht_SW, Frad_SW, Frad_LW) + + real(kind = dp), public, dimension(:,:), allocatable :: & + T_in_K, & ! Temperature [K] + rcil, & ! Ice mixing ratio [kg/kg] + o3l ! Ozone mixing ratio [kg/kg] + +!$omp threadprivate(T_in_K, rcil, o3l) + + real(kind = dp), public, dimension(:,:), allocatable :: & + rsnowm_2d,& ! Two-dimensional copies of the input parameters + rcm_in_cloud_2d, & + cloud_frac_2d, & + ice_supersat_frac_2d + +!$omp threadprivate(rsnowm_2d, rcm_in_cloud_2d, cloud_frac_2d) + + real(kind = dp), public, dimension(:,:), allocatable :: & + radht_SW_2d, & ! SW Radiative heating rate [W/m^2] + radht_LW_2d ! LW Radiative heating rate [W/m^2] + +!$omp threadprivate(radht_SW_2d, radht_LW_2d) + + real(kind = dp), public, dimension(:,:), allocatable :: & + Frad_uLW, & ! LW upwelling flux [W/m^2] + Frad_dLW, & ! LW downwelling flux [W/m^2] + Frad_uSW, & ! SW upwelling flux [W/m^2] + Frad_dSW ! SW downwelling flux [W/m^2] + +!$omp threadprivate(Frad_uLW, Frad_dLW, Frad_uSW, Frad_dSW) + + real(kind = dp), public, dimension(:,:), allocatable :: & + fdswcl, & !Downward clear-sky SW flux (W/m^-2). + fuswcl, & !Upward clear-sky SW flux (W/m^-2). + fdlwcl, & !Downward clear-sky LW flux (W/m^-2). + fulwcl !Upward clear-sky LW flux (W/m^-2). + +!$omp threadprivate(fdswcl, fuswcl, fdlwcl, fulwcl) + + ! Constant parameters + integer, private, parameter :: & + nlen = 1, & ! Length of the total domain + slen = 1 ! Length of the sub domain + + contains + + !--------------------------------------------------------------------- + subroutine setup_radiation_variables( nzmax, lin_int_buffer, & + extend_atmos_range_size ) + ! Description: + ! Allocates and initializes prognostic scalar and array variables + ! for the CLUBB model code. + !--------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + core_rknd ! Variable(s) + + implicit none + + ! Input Variables + integer, intent(in) :: & + nzmax, & ! Number of grid levels [-] + lin_int_buffer,& ! Number of interpolated levels between the computational + ! grid and the extended atmosphere [-] + extend_atmos_range_size ! The number of levels in the extended atmosphere [-] + + ! Local Variables + + integer :: rad_zt_dim, rad_zm_dim ! Dimensions of the radiation grid + + !----------------------------BEGIN CODE------------------------------- + + rad_zt_dim = (nzmax-1)+lin_int_buffer+extend_atmos_range_size + rad_zm_dim = (nzmax-1)+lin_int_buffer+extend_atmos_range_size+1 + + + ! --- Allocation --- + + allocate( radht_SW(1:nzmax) ) + allocate( radht_LW(1:nzmax) ) + allocate( Frad_SW(1:nzmax) ) + allocate( Frad_LW(1:nzmax) ) + + allocate( T_in_K(nlen, rad_zt_dim ) ) + allocate( rcil(nlen, rad_zt_dim ) ) + allocate( o3l(nlen, rad_zt_dim ) ) + + allocate( rsnowm_2d(nlen, rad_zt_dim ) ) + allocate( rcm_in_cloud_2d(nlen, rad_zt_dim ) ) + allocate( cloud_frac_2d(nlen, rad_zt_dim ) ) + allocate( ice_supersat_frac_2d(nlen, rad_zt_dim ) ) + + allocate( radht_SW_2d(nlen, rad_zt_dim ) ) + allocate( radht_LW_2d(nlen, rad_zt_dim ) ) + + allocate( Frad_uLW(nlen, rad_zm_dim ) ) + allocate( Frad_dLW(nlen, rad_zm_dim ) ) + allocate( Frad_uSW(nlen, rad_zm_dim ) ) + allocate( Frad_dSW(nlen, rad_zm_dim ) ) + + allocate( fdswcl(slen, rad_zm_dim ) ) + allocate( fuswcl(slen, rad_zm_dim ) ) + allocate( fdlwcl(slen, rad_zm_dim ) ) + allocate( fulwcl(slen, rad_zm_dim ) ) + + + ! --- Initialization --- + + radht_SW = 0.0_core_rknd + radht_LW = 0.0_core_rknd + Frad_SW = 0.0_core_rknd + Frad_LW = 0.0_core_rknd + T_in_K = 0.0_dp + rcil = 0.0_dp + o3l = 0.0_dp + rsnowm_2d = 0.0_dp + rcm_in_cloud_2d = 0.0_dp + cloud_frac_2d = 0.0_dp + ice_supersat_frac_2d = 0.0_dp + radht_SW_2d = 0.0_dp + radht_LW_2d = 0.0_dp + Frad_uLW = 0.0_dp + Frad_dLW = 0.0_dp + Frad_uSW = 0.0_dp + Frad_dSW = 0.0_dp + fdswcl = 0.0_dp + fuswcl = 0.0_dp + fdlwcl = 0.0_dp + fulwcl = 0.0_dp + + end subroutine setup_radiation_variables + + !--------------------------------------------------------------------- + subroutine cleanup_radiation_variables( ) + + ! Description: + ! Subroutine to deallocate variables defined in module global + !--------------------------------------------------------------------- + + implicit none + + ! --- Deallocate --- + + deallocate( radht_SW ) + deallocate( radht_LW ) + deallocate( Frad_SW ) + deallocate( Frad_LW ) + + deallocate( T_in_K ) + deallocate( rcil ) + deallocate( o3l ) + + deallocate( rsnowm_2d ) + deallocate( rcm_in_cloud_2d ) + deallocate( cloud_frac_2d ) + deallocate( ice_supersat_frac_2d ) + + deallocate( radht_SW_2d ) + deallocate( radht_LW_2d ) + + deallocate( Frad_uLW ) + deallocate( Frad_dLW ) + deallocate( Frad_uSW ) + deallocate( Frad_dSW ) + + deallocate( fdswcl ) + deallocate( fuswcl ) + deallocate( fdlwcl ) + deallocate( fulwcl ) + + end subroutine cleanup_radiation_variables + + +end module crmx_variables_radiation_module diff --git a/src/physics/spcam/crm/CLUBB/recl.inc b/src/physics/spcam/crm/CLUBB/recl.inc new file mode 100644 index 0000000000..267b70e4db --- /dev/null +++ b/src/physics/spcam/crm/CLUBB/recl.inc @@ -0,0 +1,26 @@ +!------------------------------------------------------------------------------- +! $Id: recl.inc 5623 2012-01-17 17:55:26Z connork@uwm.edu $ +! Description: +! Preprocessing rules for determining how large an unformatted +! data record is when using Fortran write. This does not affect +! netCDF output at all. + +! Notes: +! New directives will need to be added to port CLUBB GrADS output +! to new compilers that do not use byte size record lengths. + +! Early Alpha processors lacked the ability to work with anything +! smaller than a 32 bit word, so DEC Fortran and its successors +! (Compaq Visual Fortran, newer Intel Fortran, etc.) all use 4 +! byte records. Note that specifying byterecl on Alpha still +! results in a performance hit, even on newer chips. +!------------------------------------------------------------------------------- +#if defined GFDL /* F_RECL should be 4 for the GFDL SCM-CLUBB */ +# define F_RECL 4 +#elif defined __INTEL_COMPILER && __INTEL_COMPILER >= 800 /* Versions of Intel fortran > 8.0_core_rknd */ +# define F_RECL 1 +#elif defined(__alpha) /* Assume 4 byte word on Alpha processors */ +# define F_RECL 1 +#else +# define F_RECL 4 /* Most compilers and computers */ +#endif diff --git a/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 b/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 new file mode 100644 index 0000000000..5caa0589b0 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 @@ -0,0 +1,121 @@ +README for Morrison et al (2005) microphysics. + +The two-moment, five-class bulk microphysical scheme of Morrison et al +(2005) has been ported to SAM through the addition of an interface to +the WRF implementation of Morrison's scheme. Here, SAM directly +interfaces with the 1D version of the scheme in the WRF +implementation. Several microphysical options in the WRF +implementation are accessible here, through the specification of +parameters in the namelist MICRO_M2005, which should be placed in the +prm file and are listed below. The scheme will use an increasing +number of microphysical variables, depending on the options specified +in the PARAMETERS and MICRO_M2005 namelists. + + - QT, total water (vapor + cloud liquid) mass mixing ratio (units: kg/kg) + - NC, cloud water number mixing ratio (units: #/kg), used if dopredictNc=.true. + - QR, rain mass mixing ratio (units: kg/kg), used if doprecip=.true. + - NR, rain number mixing ratio (units: #/kg), used if doprecip=.true. + - QI, cloud ice mass mixing ratio (units: kg/kg), used if doicemicro=.true. + - NI, cloud ice number mixing ratio (units: #/kg), used if doicemicro=.true. + - QS, snow mass mixing ratio (units: kg/kg), used if doicemicro=.true. + - NS, snow number mixing ratio (units: #/kg), used if doicemicro=.true. + - QG, graupel mass mixing ratio (units: kg/kg), used if doicemicro=.true. + - NG, graupel number mixing ratio (units: #/kg), used if doicemicro=.true. + +The scheme will not run for the following combinations of parameters: + + + doprecip=.false. and doicemicro=.true. (doprecip=.false. only works for water clouds) + + dograupel=.true. and doicemicro=.false. (Need ice to make graupel) + + dohail=.true. and dograupel=.false. (Hail is an option for the graupel species) + +Note that the options docloud and doprecip appear in the PARAMETERS +namelist. Other options are in the MICRO_M2005 namelist and are +discussed below. + +MICRO_M2005 namelist options: + +doicemicro (logical, default=.true.): Add cloud ice and snow + microphysical species. Each species will be represented by two + prognostic variables: a mass mixing ratio and a number concentration. + +dograupel (logical, default=.true.): Add graupel as a microphysical + species. Prognostic variables for mass mixing ratio and number + concentration. + +dosb_warm_rain (logical, default=.false.): If true, use Seifert & + Beheng (2001) warm rain parameterization in place of the default + Khairoutdinov & Kogan (2000) scheme. + +dopredictNc (logical, default=.true.): Predict cloud water droplet + number concentration. Manner of droplet activation is controlled by + dospecifyaerosol. + +Nc0 (real, default=100.): If dopredictNc=.false., Nc0 is the cloud + droplet number concentration for all time. If dopredictNc=.true., Nc0 + is the initial cloud droplet number concentration if cloud exists in + the initial sounding. + +dospecifyaerosol (logical, default=.false.): If true, two modes of + aerosol (from which the cloud water droplets will be activated) can be + specified. Otherwise, a power-law activaton scheme is used. + +If dospecifyaerosol=.false., cloud droplet activation is controlled by + (defaults come from maritime values adapted from Rasmussen et al 2002 + by Hugh Morrison, suggested continental values are 1000., 0.5): + + ccnconst (real, default=120.): constant in N_{ccn} = C*S^K + where S is supersaturation. Units are cm^{-3}, I believe. + ccnexpnt (real, default=0.4): exponent in N_{ccn} = C*S^K. + +If dospecifyaerosol=.true., cloud droplet activation is controlled by + (defaults from MPACE, note that aerosol properties are currently set + up for ammonium sulfate): + + aer_rm1 (real, default=0.052): geometric mean radius (in microns) of + aerosol size distribution of aerosol mode 1. + aer_sig1 (real, default=2.04): geometric standard deviation of mode 1. + aer_n1 (real, default=72.2): number concentration (in #/cm3) of mode 1. + + aer_rm2 (real, default=1.3): geometric mean radius (in microns) of + aerosol size distribution of aerosol mode 2. + aer_sig2 (real, default=2.5): geometric standard deviation of mode 2. + aer_n2 (real, default=1.8): number concentration (in #/cm3) of mode 2. + +dosubgridw (logical, default=.false.): NOT IMPLEMENTED YET. In large + grid spacing simulations, this option would allow cloud droplet + activation to incorporate information about subgrid variations in + vertical velocity. + +doarcticicenucl (logical, default=.false): If true, use MPACE + observations for ice nucleation conditions. If false, use + mid-latitude formula from Rasmussen et al (2002). + +docloudedgeactivation (logical, default=.false.): Explanation from + Hugh Morrison in the code: + + If true, neglect droplet activation at lateral cloud edges due to + unresolved entrainment and mixing. Activate at cloud base + or in region with little cloud water using non-equlibrium + supersaturation assuming no initial cloud water. In cloud + interior activate using equilibrium supersaturation + + + If false, assume droplet activation at lateral cloud edges due to + unresolved entrainment and mixing dominates. Activate + droplets everywhere in the cloud using non-equilibrium + supersaturation assuming no initial cloud water, based on + the local sub-grid and/or grid-scale vertical velocity at + the grid point. + +dofix_pgam (logical, default=.false.): Fix the exponent in the Gamma + distribution approximation to the cloud water droplet size + distribution. If true, the value from pgam_fixed is used. If + false, a diagnostic relationship from observations that expressed + the exponent as a function of the number concentration is used: + + pgam = 0.2714 + 0.00057145*Nc where Nc has units of #/cm3 + +pgam_fixed (real, default=5.): Value of exponent used if + dofix_pgam=.true. + + diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 new file mode 100644 index 0000000000..bdbf3b2f5e --- /dev/null +++ b/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 @@ -0,0 +1,373 @@ +module crmx_drop_activation +#ifdef MODAL_AERO +!---------------------------------------------------------------------------------------------------- +! +! Purposes: calcualte dropelt number concentration activated from aerosol particle, used +! in Morrison's two-moment microphysics in SAM. It treats multimode aerosol population, +! and aerosol fields are taken from the modal aerosol treatment in CAM. +! +! Method: This module is adopted from the module of ndrop used in CAM, originally writted by +! Steven Ghan. +! +! Revision history: +! July, 2009: adopted from the module of ndrop used in CAM. +! +!---------------------------------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use modal_aero_data, only: ntot_amode + + implicit none + private + save + + public :: drop_activation_init, drop_activation_Ghan + + real(r8),allocatable :: npv(:) ! number per volume concentration + real(r8),allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol + real(r8),allocatable :: exp45logsig(:) + real(r8),allocatable :: argfactor(:) + real(r8),allocatable :: f1(:),f2(:) ! abdul-razzak functions of width + + real(r8) :: t0 ! reference temperature + real(r8) :: aten + real(r8) :: surften ! surface tension of water w/respect to air (N/m) + real(r8) :: alogten,alog2,alog3,alogaten + real(r8) :: third, twothird, sixth, zero + real(r8) :: sq2, sqpi, pi + +contains +!---------------------------------------------------------------------------------- + +!================================================================================== +subroutine drop_activation_init +!------------------------------------------------------------------------ +! Initialize constants, and prescribed parameters. +!----------------------------------------------------------------------- + use modal_aero_data + use physconst, only: rhoh2o, mwh2o, r_universal + implicit none + + integer l,m + real(r8) arg + +! mathematical constants + + zero=0._r8 + third=1./3._r8 + twothird=2.*third + sixth=1./6._r8 + sq2=sqrt(2._r8) + pi=4._r8*atan(1.0_r8) + sqpi=sqrt(pi) + + t0=273. + surften=0.076_r8 + aten=2.*mwh2o*surften/(r_universal*t0*rhoh2o) + alogaten=log(aten) + alog2=log(2._r8) + alog3=log(3._r8) + + if (.not. allocated(npv)) allocate (npv(ntot_amode)) + if (.not. allocated(alogsig)) allocate (alogsig(ntot_amode)) + if (.not. allocated(exp45logsig)) allocate (exp45logsig(ntot_amode)) + if (.not. allocated(argfactor)) allocate (argfactor(ntot_amode)) + if (.not. allocated(f1)) allocate (f1(ntot_amode)) + if (.not. allocated(f2)) allocate (f2(ntot_amode)) + + do m=1,ntot_amode +! use only if width of size distribution is prescribed + alogsig(m)=log(sigmag_amode(m)) + exp45logsig(m)=exp(4.5*alogsig(m)*alogsig(m)) + argfactor(m)=2./(3.*sqrt(2.)*alogsig(m)) + f1(m)=0.5*exp(2.5*alogsig(m)*alogsig(m)) + f2(m)=1.+0.25*alogsig(m) + end do + + return +end subroutine drop_activation_init +!------------------------------------------------------------------------------------------------------- + +!======================================================================================================= +subroutine drop_activation_Ghan(wnuc4, tair4, rhoair4, & + ndrop4, ines, smaxinout4, k) +!------------------------------------------------------------------------------------------------------- +! +! Purpose and method: calculates number, surface, and mass fraction of aerosols activated as CCN +! calculates flux of cloud droplets, surface area, and aerosol mass into cloud +! assumes an internal mixture within each of up to pmode multiple aerosol modes +! a gaussiam spectrum of updrafts can be treated. + +! mks units + +! Abdul-Razzak and Ghan, A parameterization of aerosol activation. +! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. +! +! Revision history: +! 2009-07-17: Originally written by Gteven Ghan, and adopted by Minghuai Wang. +! +!------------------------------------------------------------------------------------------------------------ + + use physconst, only: rair, epsilo, cpair, rh2o, latvap, gravit, & + rhoh2o, mwh2o, r_universal + use wv_saturation, only: estblf + use physconst, only: epsqs => epsilo + use shr_spfn_mod, only: erf => shr_spfn_erf + use modal_aero_data + use crmx_vars, only: naer, vaer, hgaer + + implicit none + + +! Input + real, intent (in) :: wnuc4 ! updraft velocity (m/s) + real, intent (in) :: tair4 ! air temperature (K) + real, intent (in) :: rhoair4 ! air density (kg/m3) + integer, intent(in) :: ines ! whether non-equillium saturation is used (ines=1: used). + real, intent (inout) :: smaxinout4 ! For ines=1, it is non-equlibrium saturation ratio (input) + ! for ines=0, it is smax calculted from the activation parameterizaiton (output). + integer, intent(in) :: k ! the index of vertical levels. + +! Output + real, intent (out) :: ndrop4 ! activated droplet number concentration + + +! Local + real(r8) :: wnuc ! updraft velocity (m/s) + real(r8) :: tair ! air temperature (K) + real(r8) :: rhoair ! air density (kg/m3) + real(r8) na(ntot_amode) ! aerosol number concentration (/m3) + integer nmode ! number of aerosol modes + real(r8) volume(ntot_amode) ! aerosol volume concentration (m3/m3) + real(r8) hygro(ntot_amode) ! hygroscopicity of aerosol mode + + real(r8) fn(ntot_amode) ! number fraction of aerosols activated + real(r8) fm(ntot_amode) ! mass fraction of aerosols activated + real(r8) fluxn(ntot_amode) ! flux of activated aerosol number fraction into cloud (cm/s) + real(r8) fluxm(ntot_amode) ! flux of activated aerosol mass fraction into cloud (cm/s) + real(r8) flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) + ! rce-comment + ! used for consistency check -- this should match (ekd(k)*zs(k)) + ! also, fluxm/flux_fullact gives fraction of aerosol mass flux + ! that is activated +! local + + real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa) + real(r8) sign(ntot_amode) ! geometric standard deviation of size distribution + real(r8) pres ! pressure (Pa) + real(r8) diff0 ! diffusivity (m2/s) + real(r8) conduct0 ! thermal conductivity (Joule/m/sec/deg) + real(r8) es ! saturation vapor pressure + real(r8) qs ! water vapor saturation mixing ratio + real(r8) dqsdt ! change in qs with temperature + real(r8) dqsdp ! change in qs with pressure + real(r8) g ! thermodynamic function (m2/s) + real(r8) zeta(ntot_amode), eta(ntot_amode) + real(r8) lnsmax ! ln(smax) + real(r8) alpha + real(r8) gamma + real(r8) beta + real(r8) sqrtg(ntot_amode) + real(r8) :: amcube(ntot_amode) ! cube of dry mode radius (m) + real(r8) :: lnsm(ntot_amode) ! ln(smcrit) + real(r8) smc(ntot_amode) ! critical supersaturation for number mode radius + real(r8) alw,sqrtalw + real(r8) smax + real(r8) x,arg + real(r8) xmincoeff + real(r8) z + real(r8) etafactor1,etafactor2(ntot_amode),etafactor2max + real(r8) wmaxf ! maximum update velocity [m/s] + real ndrop_act + integer m,n +! numerical integration parameters + real(r8), parameter :: eps=0.3_r8,fmax=0.99_r8,sds=3._r8 + + real(r8), parameter :: namin=1.e6_r8 ! minimum aerosol number concentration (/m3) + + wnuc = wnuc4 + tair = tair4 + rhoair = rhoair4 + +! Set aerosol fields + na = naer(k, :) + volume = vaer(k, :) + hygro = hgaer(k, :) + + nmode = ntot_amode + wmaxf = 10.0 + + fn(:)=0._r8 + fm(:)=0._r8 + fluxn(:)=0._r8 + fluxm(:)=0._r8 + flux_fullact=0._r8 + ndrop4 = 0. + ndrop_act = 0. + + if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return + + pres=rair*rhoair*tair + diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94 + conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg + es = estblf(tair) + qs = epsilo*es/(pres-(1.0_r8 - epsqs)*es) + dqsdt=latvap/(rh2o*tair*tair)*qs + alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1./(rair*tair)) + gamma=(1+latvap/cpair*dqsdt)/(rhoair*qs) + etafactor2max=1.e10/(alpha*wmaxf)**1.5 ! this should make eta big if na is very small. + + do m=1,nmode + if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then +! number mode radius (m) +! write(6,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m) + amcube(m)=(3.*volume(m)/(4.*pi*exp45logsig(m)*na(m))) ! only if variable size dist +! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 +! should depend on mean radius of mode to account for gas kinetic effects +! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006 +! for approriate size to use for effective diffusivity. + g=1._r8/(rhoh2o/(diff0*rhoair*qs) & + +latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair)-1._r8)) + sqrtg(m)=sqrt(g) + beta=2._r8*pi*rhoh2o*g*gamma + etafactor2(m)=1._r8/(na(m)*beta*sqrtg(m)) + if(hygro(m).gt.1.e-10)then + smc(m)=2.*aten*sqrt(aten/(27.*hygro(m)*amcube(m))) ! only if variable size dist + else + smc(m)=100. + endif +! write(6,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m) + else + g=1._r8/(rhoh2o/(diff0*rhoair*qs) & + +latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair)-1._r8)) + sqrtg(m)=sqrt(g) + smc(m)=1._r8 + etafactor2(m)=etafactor2max ! this should make eta big if na is very small. + endif + lnsm(m)=log(smc(m)) ! only if variable size dist +! write(6,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', & +! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m) + enddo + +! single updraft + + if(wnuc.gt.0._r8)then + + alw=alpha*wnuc + sqrtalw=sqrt(alw) + etafactor1=alw*sqrtalw + + do m=1,nmode + eta(m)=etafactor1*etafactor2(m) + zeta(m)=twothird*sqrtalw*aten/sqrtg(m) + enddo + + call maxsat(zeta,eta,nmode,smc,smax) + + lnsmax=log(smax) + xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 + + do m=1,nmode +! modal + x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) + fn(m)=0.5_r8*(1._r8-erf(x)) + arg=x-1.5_r8*sq2*alogsig(m) + fm(m)=0.5_r8*(1._r8-erf(arg)) + if(wnuc.gt.0._r8)then + fluxn(m)=fn(m)*wnuc + fluxm(m)=fm(m)*wnuc + endif + ndrop_act = ndrop_act + fn(m) * na (m) + enddo + flux_fullact = wnuc + + if(ines.eq.0) then + ndrop4 = ndrop_act + smaxinout4 = smax + else if(ines.eq.1) then +! for non-equlibrium ss + smax = smaxinout4 + lnsmax=log(smax) + xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 + + do m=1,nmode +! modal + x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) + fn(m)=0.5_r8*(1._r8-erf(x)) + arg=x-1.5_r8*sq2*alogsig(m) + fm(m)=0.5_r8*(1._r8-erf(arg)) + if(wnuc.gt.0._r8)then + fluxn(m)=fn(m)*wnuc + fluxm(m)=fm(m)*wnuc + endif + ndrop4 = ndrop4 + fn(m) * na (m) + enddo + flux_fullact = wnuc + ndrop4 = min(ndrop4, ndrop_act) + end if + + endif + +! sensitivity tests: +! ndrop4 = max(ndrop4, 100.*1.0e6) ! the minimum activated droplet number is 100 /cm3 + + return +end subroutine drop_activation_Ghan +!---------------------------------------------------------------------------------------- + +!======================================================================================= + subroutine maxsat(zeta,eta,nmode,smc,smax) + +! calculates maximum supersaturation for multiple +! competing aerosol modes. + +! Abdul-Razzak and Ghan, A parameterization of aerosol activation. +! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. + + implicit none + + integer nmode ! number of modes + real(r8) smc(ntot_amode) ! critical supersaturation for number mode radius + real(r8) zeta(ntot_amode), eta(ntot_amode) + real(r8) smax ! maximum supersaturation + integer m ! mode index + real(r8) sum, g1, g2, g1sqrt, g2sqrt + + do m=1,nmode + if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then +! weak forcing. essentially none activated + smax=1.e-20_r8 + else +! significant activation of this mode. calc activation all modes. + go to 1 + endif + enddo + + return + + 1 continue + + sum=0 + do m=1,nmode + if(eta(m).gt.1.e-20_r8)then + g1=zeta(m)/eta(m) + g1sqrt=sqrt(g1) + g1=g1sqrt*g1 + g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) + g2sqrt=sqrt(g2) + g2=g2sqrt*g2 + sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m)) + else + sum=1.e20_r8 + endif + enddo + + smax=1._r8/sqrt(sum) + + return + +end subroutine maxsat +!-------------------------------------------------------------------------------------- + +#endif +end module crmx_drop_activation + diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 new file mode 100644 index 0000000000..851ecafaf1 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 @@ -0,0 +1,1660 @@ +module crmx_microphysics + +! main interface to Morrison microphysics. +! original implementation by Peter Blossey, UW + +use crmx_params, only: lcond, lsub, fac_cond, fac_sub, ggr + +use crmx_grid, only: nx,ny,nzm,nz, & !grid dimensions; nzm = nz-1 # of scalar lvls + dimx1_s,dimx2_s,dimy1_s,dimy2_s, & ! actual scalar-array dimensions in x,y + dz, adz, dostatis, masterproc, & + doSAMconditionals, dosatupdnconditionals + +use crmx_vars, only: pres, rho, dt, dtn, w, t, tlatqi, condavg_mask, & + ncondavg, condavgname, condavglongname +use crmx_vars, only: tke2, tk2 +use crmx_params, only: doprecip, docloud, doclubb + +use crmx_module_mp_GRAUPEL, only: GRAUPEL_INIT, M2005MICRO_GRAUPEL, & + doicemicro, & ! use ice species (snow/cloud ice/graupel) + dograupel, & ! use graupel + dohail, & ! use graupel + dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization + dopredictNc, & ! prediction of cloud droplet number + aerosol_mode, & ! specify two modes of (sulfate) aerosol +#if (defined CRM && defined MODAL_AERO) + domodal_aero, & ! use modal aerosol from the CAM +#endif +#ifdef CLUBB_CRM + doclubb_tb, & ! use CLUBB as turbulence scheme only, but not cloud scheme, + ! so liquid water is diagnosed from saturation adjustment + doclubb_gridmean, & ! feed grid-mean CLUBB values into Morrision microphysics + doclubb_autoin, & ! use in-cloud values for autoconversion calculations +#endif + dosubgridw, & ! input estimate of subgrid w to microphysics + doarcticicenucl,& ! use arctic parameter values for ice nucleation + docloudedgeactivation,&! activate droplets at cloud edges as well as base + Nc0, & ! initial/specified cloud droplet number conc (#/cm3) + ccnconst, ccnexpnt, & ! parameters for aerosol_mode=1 (powerlaw CCN) + aer_rm1, aer_rm2, & ! two modes of aerosol for aerosol_mode=2 + aer_n1, aer_n2, & ! rm=geometric mean radius (um), n=aerosol conc. (#/cm3) + aer_sig1, aer_sig2, & ! sig=geom standard deviation of aerosol size distn. + dofix_pgam, pgam_fixed ! option to specify pgam (exponent of cloud water's gamma distn) + +#ifdef CRM + use cam_abortutils, only: endrun +#endif + +implicit none + +logical :: isallocatedMICRO = .false. + +integer :: nmicro_fields ! total number of prognostic water vars + +real, allocatable, dimension(:,:,:,:) :: micro_field ! holds mphys quantities + +! indices of water quantities in micro_field, e.g. qv = micro_field(:,:,:,iqv) +integer :: iqv, iqci, iqr, iqs, iqg, incl, inci, inr, ins, ing +integer :: index_water_vapor ! separate water vapor index used by SAM + +real, allocatable, dimension(:) :: lfac +integer, allocatable, dimension(:) :: flag_wmass, flag_precip, flag_number +integer, allocatable, dimension(:) :: flag_micro3Dout + +integer, parameter :: index_cloud_ice = -1 ! historical variable (don't change) + +real, allocatable, dimension(:,:,:) :: fluxbmk, fluxtmk !surface/top fluxes +real, allocatable, dimension(:,:,:) :: reffc, reffi +real, allocatable, dimension(:,:,:) :: cloudliq + +real, allocatable, dimension(:,:) :: & ! statistical arrays + mkwle, & ! resolved vertical flux + mkwsb, & ! SGS vertical flux + mksed, & ! sedimentation vertical flux + mkadv, & ! tendency due to vertical advection + mkdiff, &! tendency due to vertical diffusion + mklsadv, & ! tendency due to large-scale vertical advection + mfrac, & ! fraction of domain with microphysical quantity > 1.e-6 + stend, & ! tendency due to sedimentation + mtend, & ! tendency due to microphysical processes (other than sedimentation) + mstor, & ! storage terms of microphysical variables + trtau ! optical depths of various species + +real, allocatable, dimension(:) :: tmtend + +real :: sfcpcp, sfcicepcp + +! arrays with names/units for microphysical outputs in statistics. +character*3, allocatable, dimension(:) :: mkname +character*80, allocatable, dimension(:) :: mklongname +character*10, allocatable, dimension(:) :: mkunits +real, allocatable, dimension(:) :: mkoutputscale +logical douse_reffc, douse_reffi + +! You can also have some additional, diagnostic, arrays, for example, total +! nonprecipitating cloud water, etc: + +!bloss: array which holds temperature tendency due to microphysics +real, allocatable, dimension(:,:,:), SAVE :: tmtend3d + +#ifdef CRM +real, allocatable, dimension(:) :: qpevp !sink of precipitating water due to evaporation (set to zero here) +real, allocatable, dimension(:) :: qpsrc !source of precipitation microphysical processes (set to mtend) +#endif + +real, allocatable, dimension(:,:,:) :: wvar ! the vertical velocity variance from subgrid-scale motion, + ! which is needed in droplet activation. +#ifdef CRM +! hm 7/26/11 new output +real, public, allocatable, dimension(:,:,:) :: aut1 ! +real, public, allocatable, dimension(:,:,:) :: acc1 ! +real, public, allocatable, dimension(:,:,:) :: evpc1 ! +real, public, allocatable, dimension(:,:,:) :: evpr1 ! +real, public, allocatable, dimension(:,:,:) :: mlt1 ! +real, public, allocatable, dimension(:,:,:) :: sub1 ! +real, public, allocatable, dimension(:,:,:) :: dep1 ! +real, public, allocatable, dimension(:,:,:) :: con1 ! + +real, public, allocatable, dimension(:,:,:) :: aut1a ! +real, public, allocatable, dimension(:,:,:) :: acc1a ! +real, public, allocatable, dimension(:,:,:) :: evpc1a ! +real, public, allocatable, dimension(:,:,:) :: evpr1a ! +real, public, allocatable, dimension(:,:,:) :: mlt1a ! +real, public, allocatable, dimension(:,:,:) :: sub1a ! +real, public, allocatable, dimension(:,:,:) :: dep1a ! +real, public, allocatable, dimension(:,:,:) :: con1a ! +#endif + +!+++mhwangtest +! test water conservation +real, public, allocatable, dimension(:, :) :: sfcpcp2D ! surface precipitation +!---mhwangtest + +CONTAINS + +!---------------------------------------------------------------------- +!!! Read microphysical options from prm file and allocate variables +! +subroutine micro_setparm() + use crmx_vars +#ifdef CLUBB_CRM + use crmx_module_mp_graupel, only: NNUCCD_REDUCE_COEF, NNUCCC_REDUCE_COEF +#endif + implicit none + + integer ierr, ios, ios_missing_namelist, place_holder + + NAMELIST /MICRO_M2005/ & +#ifdef CLUBB_CRM + NNUCCD_REDUCE_COEF, NNUCCC_REDUCE_COEF, & +#endif + doicemicro, & ! use ice species (snow/cloud ice/graupel) + dograupel, & ! use graupel + dohail, & ! graupel species has qualities of hail + dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization in place of KK(2000) + dopredictNc, & ! prediction of cloud droplet number + aerosol_mode, & ! specify two modes of (sulfate) aerosol + dosubgridw, & ! input estimate of subgrid w to microphysics + doarcticicenucl,& ! use arctic parameter values for ice nucleation + docloudedgeactivation,&! activate droplets at cloud edges as well as base + Nc0, & ! initial/specified cloud droplet number conc (#/cm3) + ccnconst, ccnexpnt, & ! parameters for aerosol_mode=1 (powerlaw CCN) + aer_rm1, aer_rm2, & ! two modes of aerosol for aerosol_mode=2 + aer_n1, aer_n2, & ! rm=geometric mean radius (um), n=aerosol conc. (#/cm3) + aer_sig1, aer_sig2, & ! sig=geom standard deviation of aerosol size distn. + dofix_pgam, pgam_fixed, & ! option to specify pgam (exponent of cloud water's gamma distn) + douse_reffc, & ! use computed effective radius in radiation computation + douse_reffi ! use computed effective ice size in radiation computation + + !bloss: Create dummy namelist, so that we can figure out error code + ! for a mising namelist. This lets us differentiate between + ! missing namelists and those with an error within the namelist. + NAMELIST /BNCUIODSBJCB/ place_holder + + ! define default values for namelist variables + doicemicro = .true. ! use ice + dograupel = .true. ! use graupel + dohail = .false. ! graupel species has properties of graupel + dosb_warm_rain = .false. ! use KK (2000) warm rain scheme by default + dopredictNc = .true. ! prognostic cloud droplet number +#if (defined CRM && defined MODAL_AERO) + domodal_aero = .true. ! use modal aerosol +#endif +#ifdef CLUBB_CRM + dosubgridw = .true. ! Use clubb's w'^2 for sgs w + aerosol_mode = 2 ! use lognormal CCN relationship + doarcticicenucl = .false. ! use mid-latitude parameters + docloudedgeactivation = .false. ! activate droplets at cloud base, and edges + doclubb_tb = .false. + doclubb_gridmean = .true. + doclubb_autoin = .false. +#else + aerosol_mode = 2 + dosubgridw = .true. + doarcticicenucl = .false. ! use mid-latitude parameters + docloudedgeactivation = .true. +#endif /*CLUBB_CRM*/ + douse_reffc = .false. ! use computed effective radius in rad computations? + douse_reffi = .false. ! use computed effective radius in rad computations? + + Nc0 = 100. ! default droplet number concentration + + ccnconst = 120. ! maritime value (/cm3), adapted from Rasmussen + ccnexpnt = 0.4 ! et al (2002) by Hugh Morrison et al. Values + ! of 1000. and 0.5 suggested for continental +! aer_rm1 = 0.052 ! two aerosol mode defaults from MPACE (from Hugh) +! aer_sig1 = 2.04 +! aer_n1 = 72.2 +! aer_rm2 = 1.3 +! aer_sig2 = 2.5 +! aer_n2 = 1.8 + + aer_rm1 = 0.052 ! two aerosol mode defaults (from mhwang for testing in global models) + aer_sig1 = 2.04 + aer_n1 = 2500 + aer_rm2 = 1.3 + aer_sig2 = 2.5 + aer_n2 = 1.8 + + dofix_pgam = .false. + pgam_fixed = 5. ! middle range value -- corresponds to radius dispersion ~ 0.4 + + !---------------------------------- + ! Read namelist for microphysics options from prm file: + !------------ +! open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') + + !bloss: get error code for missing namelist (by giving the name for + ! a namelist that doesn't exist in the prm file). +! read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) +! rewind(55) !note that one must rewind before searching for new namelists + + !bloss: read in MICRO_M2005 namelist +! read (55,MICRO_M2005,IOSTAT=ios) + +! if (ios.ne.0) then +! !namelist error checking +! if(ios.ne.ios_missing_namelist) then +! write(*,*) '****** ERROR: bad specification in MICRO_M2005 namelist' +! call task_abort() +! elseif(masterproc) then +! write(*,*) '****************************************************' +! write(*,*) '****** No MICRO_M2005 namelist in prm file *********' +! write(*,*) '****************************************************' +! end if +! end if +! close(55) + + if(.not.doicemicro) dograupel=.false. + + if(dohail.and..NOT.dograupel) then + if(masterproc) write(*,*) 'dograupel must be .true. for dohail to be used.' + call task_abort() + end if + + ! write namelist values out to file for documentation +! if(masterproc) then +! open(unit=55,file='./'//trim(case)//'/'//trim(case)//'_'//trim(caseid)//'.options_namelist', form='formatted', position='append') +! write (unit=55,nml=MICRO_M2005,IOSTAT=ios) +! write(55,*) ' ' +! close(unit=55) +! end if + + ! scale values of parameters for m2005micro + aer_rm1 = 1.e-6*aer_rm1 ! convert from um to m + aer_rm2 = 1.e-6*aer_rm2 + aer_n1 = 1.e6*aer_n1 ! convert from #/cm3 to #/m3 + aer_n2 = 1.e6*aer_n2 + + nmicro_fields = 1 ! start with water vapor and cloud water mass mixing ratio +#ifdef CLUBB_CRM + if(docloud.or.doclubb) then +#else + if(docloud) then +#endif +!bloss/qt nmicro_fields = nmicro_fields + 1 ! add cloud water mixing ratio + if(dopredictNc) nmicro_fields = nmicro_fields + 1 ! add cloud water number concentration (if desired) + end if + if(doprecip) nmicro_fields = nmicro_fields + 2 ! add rain mass and number (if desired) + if(doicemicro) nmicro_fields = nmicro_fields + 4 ! add snow and cloud ice number and mass (if desired) + if(dograupel) nmicro_fields = nmicro_fields + 2 ! add graupel mass and number (if desired) + + ! specify index of various quantities in micro_field array + ! *** note that not all of these may be used if(.not.doicemicro) *** + iqv = 1 ! total water (vapor + cloud liq) mass mixing ratio [kg H2O / kg dry air] +!bloss/qt iqcl = 2 ! cloud water mass mixing ratio [kg H2O / kg dry air] + +!bloss/qt: cloud liquid water no longer prognosed + if(dopredictNc) then + incl = 2 ! cloud water number mixing ratio [#/kg dry air] + iqr = 3 ! rain mass mixing ratio [kg H2O / kg dry air] + inr = 4 ! rain number mixing ratio [#/kg dry air] + iqci = 5 ! cloud ice mass mixing ratio [kg H2O / kg dry air] + inci = 6 ! cloud ice number mixing ratio [#/kg dry air] + iqs = 7 ! snow mass mixing ratio [kg H2O / kg dry air] + ins = 8 ! snow number mixing ratio [#/kg dry air] + iqg = 9 ! graupel mass mixing ratio [kg H2O / kg dry air] + ing = 10 ! graupel number mixing ratio [#/kg dry air] + else + iqr = 2 ! rain mass mixing ratio [kg H2O / kg dry air] + inr = 3 ! rain number mixing ratio [#/kg dry air] + iqci = 4 ! cloud ice mass mixing ratio [kg H2O / kg dry air] + inci = 5 ! cloud ice number mixing ratio [#/kg dry air] + iqs = 6 ! snow mass mixing ratio [kg H2O / kg dry air] + ins = 7 ! snow number mixing ratio [#/kg dry air] + iqg = 8 ! graupel mass mixing ratio [kg H2O / kg dry air] + ing = 9 ! graupel number mixing ratio [#/kg dry air] + end if + + ! stop if icemicro is specified without precip -- we don't support this right now. + if((doicemicro).and.(.not.doprecip)) then + if(masterproc) write(*,*) 'Morrison 2005 Microphysics does not support both doice and .not.doprecip' + call task_abort() + end if + index_water_vapor = iqv ! set SAM water vapor flag + + if(.not.isallocatedMICRO) then + ! allocate microphysical variables + allocate(micro_field(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm,nmicro_fields), & + fluxbmk(nx,ny,nmicro_fields), fluxtmk(nx,ny,nmicro_fields), & + reffc(nx,ny,nzm), reffi(nx,ny,nzm), & + mkwle(nz,nmicro_fields), mkwsb(nz,nmicro_fields), & + mkadv(nz,nmicro_fields), mkdiff(nz,nmicro_fields), & + mklsadv(nz,nmicro_fields), & + stend(nzm,nmicro_fields), mtend(nzm,nmicro_fields), & + mfrac(nzm,nmicro_fields), trtau(nzm,nmicro_fields), & + mksed(nzm,nmicro_fields), tmtend(nzm), & + mstor(nzm,nmicro_fields), & + cloudliq(nx,ny,nzm), & + tmtend3d(nx,ny,nzm), flag_micro3Dout(nmicro_fields), & + flag_wmass(nmicro_fields), flag_precip(nmicro_fields), & + flag_number(nmicro_fields), lfac(nmicro_fields), & + mkname(nmicro_fields), mklongname(nmicro_fields), & + mkunits(nmicro_fields), mkoutputscale(nmicro_fields), STAT=ierr) + +#ifdef CRM + allocate (qpevp(nz), qpsrc(nz), STAT=ierr) +#endif + allocate (wvar(nx,ny,nzm), STAT=ierr) + +#ifdef CRM +! hm 7/26/11, add new output + allocate (aut1(nx,ny,nzm), STAT=ierr) + allocate (acc1(nx,ny,nzm), STAT=ierr) + allocate (evpc1(nx,ny,nzm), STAT=ierr) + allocate (evpr1(nx,ny,nzm), STAT=ierr) + allocate (mlt1(nx,ny,nzm), STAT=ierr) + allocate (sub1(nx,ny,nzm), STAT=ierr) + allocate (dep1(nx,ny,nzm), STAT=ierr) + allocate (con1(nx,ny,nzm), STAT=ierr) + + allocate (aut1a(nx,ny,nzm), STAT=ierr) + allocate (acc1a(nx,ny,nzm), STAT=ierr) + allocate (evpc1a(nx,ny,nzm), STAT=ierr) + allocate (evpr1a(nx,ny,nzm), STAT=ierr) + allocate (mlt1a(nx,ny,nzm), STAT=ierr) + allocate (sub1a(nx,ny,nzm), STAT=ierr) + allocate (dep1a(nx,ny,nzm), STAT=ierr) + allocate (con1a(nx,ny,nzm), STAT=ierr) +#endif + +!+++mhwangtest + allocate (sfcpcp2D(nx,ny), STAT=ierr) +!---mhwangtest + + if(ierr.ne.0) then + write(*,*) 'Failed to allocate microphysical arrays on proc ', rank + call task_abort() + else + isallocatedMICRO = .true. + end if + + ! zero out statistics variables associated with cloud ice sedimentation + ! in Marat's default SAM microphysics + tlatqi = 0. + + ! initialize these arrays + micro_field = 0. + cloudliq = 0. !bloss/qt: auxially cloud liquid water variable, analogous to qn in MICRO_SAM1MOM + fluxbmk = 0. + fluxtmk = 0. + mkwle = 0. + mkwsb = 0. + mkadv = 0. + mkdiff = 0. + mklsadv = 0. + mstor =0. + + wvar = 0. + +#ifdef CRM +! hm 7/26/11, new output + aut1 = 0. + acc1 = 0. + evpc1 = 0. + evpr1 = 0. + mlt1 = 0. + sub1 = 0. + dep1 = 0. + con1 = 0. + aut1a = 0. + acc1a = 0. + evpc1a = 0. + evpr1a = 0. + mlt1a = 0. + sub1a = 0. + dep1a = 0. + con1a = 0. +#endif + + ! initialize flag arrays to all mass, no number, no precip + flag_wmass = 1 + flag_number = 0 + flag_precip = 0 + flag_micro3Dout = 0 + + end if + + compute_reffc = douse_reffc + compute_reffi = douse_reffi + +end subroutine micro_setparm + +!---------------------------------------------------------------------- +!!! Initialize microphysics: +! +! this one is guaranteed to be called by SAM at the +! beginning of each run, initial or restart: +subroutine micro_init() + + use crmx_vars +#if (defined CRM && defined MODAL_AERO) + use crmx_drop_activation, only: drop_activation_init +#endif + + implicit none + + real, dimension(nzm) :: qc0, qi0 + +! Commented out by dschanen UWM 23 Nov 2009 to avoid a linking error +! real, external :: satadj_water + integer :: k + + ! initialize flag arrays + if(dopredictNc) then + ! Cloud droplet number concentration is a prognostic variable + if(doicemicro) then + if(dograupel) then + !bloss/qt: qt, Nc, qr, Nr, qi, Ni, qs, Ns, qg, Ng + flag_wmass = (/1,0,1,0,1,0,1,0,1,0/) + flag_precip = (/0,0,1,1,0,0,1,1,1,1/) + flag_number = (/0,1,0,1,0,1,0,1,0,1/) + else + !bloss/qt: qt, Nc, qr, Nr, qi, Ni, qs, Ns + flag_wmass = (/1,0,1,0,1,0,1,0/) + flag_precip = (/0,0,1,1,0,0,1,1/) + flag_number = (/0,1,0,1,0,1,0,1/) + end if + else + if(doprecip) then + !bloss/qt: qt, Nc, qr, Nr + flag_wmass = (/1,0,1,0/) + flag_precip = (/0,0,1,1/) + flag_number = (/0,1,0,1/) + else + !bloss/qt: qt, Nc + flag_wmass = (/1,0/) + flag_precip = (/0,0/) + flag_number = (/0,1/) + end if + end if + else + ! Cloud droplet number concentration is NOT a prognostic variable + if(doicemicro) then + if(dograupel) then + !bloss/qt: qt, qr, Nr, qi, Ni, qs, Ns, qg, Ng + flag_wmass = (/1,1,0,1,0,1,0,1,0/) + flag_precip = (/0,1,1,0,0,1,1,1,1/) + flag_number = (/0,0,1,0,1,0,1,0,1/) + else + !bloss/qt: qt, qr, Nr, qi, Ni, qs, Ns + flag_wmass = (/1,1,0,1,0,1,0/) + flag_precip = (/0,1,1,0,0,1,1/) + flag_number = (/0,0,1,0,1,0,1/) + end if + else + if(doprecip) then + !bloss/qt: qt, qr, Nr + flag_wmass = (/1,1,0/) + flag_precip = (/0,1,1/) + flag_number = (/0,0,1/) + else + !bloss/qt: only total water variable is needed for no-precip, + ! fixed droplet number, warm cloud and no cloud simulations. + flag_wmass = (/1/) + flag_precip = (/0/) + flag_number = (/0/) + end if + end if + end if + + ! output all microphysical fields to 3D output files if using more than + ! just docloud. Otherwise, rely on basic SAM outputs +#ifdef CLUBB_CRM + if((docloud.OR.doclubb).AND.(doprecip.OR.dopredictNc)) then +#else + if(docloud.AND.(doprecip.OR.dopredictNc)) then +#endif + flag_micro3Dout = 1 + end if + + ! initialize factor for latent heat + lfac(:) = 1. ! use one as default for number species + lfac(iqv) = lcond +!bloss/qt if(docloud) lfac(iqcl) = lcond + if(doprecip) lfac(iqr) = lcond + if(doicemicro) then + lfac(iqci) = lsub + lfac(iqs) = lsub + if(dograupel) lfac(iqg) = lsub + end if + + call graupel_init() ! call initialization routine within mphys module +#if (defined CRM && defined MODAL_AERO) + call drop_activation_init +#endif + + if(nrestart.eq.0) then + +! In SPCAM, do not need this part. +#ifndef CRM + ! compute initial profiles of liquid water - M.K. + call satadj_liquid(nzm,tabs0,q0,qc0,pres*100.) + + ! initialize microphysical quantities + q0 = q0 + qc0 + do k = 1,nzm + micro_field(:,:,k,iqv) = q0(k) + cloudliq(:,:,k) = qc0(k) + tabs(:,:,k) = tabs0(k) + end do + if(dopredictNc) then ! initialize concentration somehow... + do k = 1,nzm + if(q0(k).gt.0.) then + micro_field(:,:,k,incl) = 0.5*ccnconst*1.e6 + end if + end do + end if +#endif ! CRM + +#ifdef CLUBB_CRM + if(docloud.or.doclubb) call micro_diagnose() ! leave this line here +#else + if(docloud) call micro_diagnose() ! leave this here +#endif + + + end if + +end subroutine micro_init + +!---------------------------------------------------------------------- +!!! fill-in surface and top boundary fluxes: +! +! Obviously, for liquid/ice water variables those fluxes are zero. They are not zero +! only for water vapor variable and, possibly, for CCN and IN if you have those. + +subroutine micro_flux() + +use crmx_vars, only: fluxbq, fluxtq +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes +#endif + +fluxbmk(:,:,:) = 0. ! initialize all fluxes at surface to zero +fluxtmk(:,:,:) = 0. ! initialize all fluxes at top of domain to zero +#ifdef CLUBB_CRM +if ( doclubb .and. (doclubb_sfc_fluxes.or.docam_sfc_fluxes) ) then + fluxbmk(:,:,index_water_vapor) = 0.0 ! surface qv (latent heat) flux +else + fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) ! surface qv (latent heat) flux +end if +#else +fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) ! surface qv (latent heat) flux +#endif +fluxtmk(:,:,index_water_vapor) = fluxtq(:,:) ! top of domain qv flux + +end subroutine micro_flux + +!---------------------------------------------------------------------- +!!! compute local microphysics processes (beyond advection and SGS diffusion): +! +! This is the place where the condensation/sublimation, accretion, coagulation, freezing, +! melting, etc., that is all the microphysics processes except for the spatial transport happen. + +! IMPORTANT: You need to use the thermodynamic constants like specific heat, or +! specific heat of condensation, gas constant, etc, the same as in file params.f90 +! Also, you should assume that the conservative thermodynamic variable during these +! proceses is the liquid/ice water static energy: t = tabs + gz - Lc (qc+qr) - Ls (qi+qs+qg) +! It should not be changed during all of your point microphysical processes! + +subroutine micro_proc() + +use crmx_params, only: fac_cond, fac_sub, rgas +use crmx_grid, only: z, zi + +#ifdef CRM +use crmx_vars, only: t, gamaz, precsfc, precssfc, precflux, qpfall, tlat, prec_xy, & +#else +use crmx_vars, only: t, gamaz, precsfc, precflux, qpfall, tlat, prec_xy, & +#endif /*CRM*/ + nstep, nstatis, icycle, total_water_prec + +#ifdef ECPP +use crmx_ecppvars, only: qlsink, qlsink_bf, prain, precr, precsolid, rh, qcloud_bf +#endif + +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, docloud, dosmoke +use crmx_grid, only: nz +use crmx_error_code, only: clubb_at_least_debug_level +use crmx_fill_holes, only: fill_holes_driver +use crmx_clubbvars, only: wp2, cloud_frac, rho_ds_zt, rho_ds_zm, relvarg, accre_enhang ! are used, but not modified here +use crmx_vars, only: qcl ! Used here and updated in micro_diagnose +use crmx_vars, only: prespot ! exner^-1 +use crmx_module_mp_GRAUPEL, only: & + cloud_frac_thresh ! Threshold for using sgs cloud fraction to weight + ! microphysical quantities [%] +use crmx_clubb_precision, only: core_rknd +use crmx_constants_clubb, only: T_freeze_K +use crmx_vars, only: CF3D +#endif + + +real, dimension(nzm) :: & + tmpqcl, tmpqci, tmpqr, tmpqs, tmpqg, tmpqv, & + tmpncl, tmpnci, tmpnr, tmpns, tmpng, & + tmpw, tmpwsub, tmppres, tmpdz, tmptabs, & +! hm 7/26/11, new output + tmpaut,tmpacc,tmpevpc,tmpevpr,tmpmlt, & + tmpsub,tmpdep,tmpcon, & + tmtend1d, & + mtendqcl, mtendqci, mtendqr, mtendqs, mtendqg, mtendqv, & + mtendncl, mtendnci, mtendnr, mtendns, mtendng, & + stendqcl, stendqci, stendqr, stendqs, stendqg, stendqv, & + stendncl, stendnci, stendnr, stendns, stendng, & + effg1d, effr1d, effs1d, effc1d, effi1d + +#ifdef ECPP +real, dimension(nzm) :: C2PREC,QSINK_TMP, CSED,ISED,SSED,GSED,RSED,RH3D ! used for cloud chemistry and wet deposition in ECPP +#endif + +#ifdef CLUBB_CRM +real(kind=core_rknd), dimension(nz) :: & + qv_clip, qcl_clip +real, dimension(nzm) :: cloud_frac_in, ice_cldfrac +real, dimension(nzm) :: liq_cldfrac +real, dimension(nzm) :: relvar ! relative cloud water variance +real, dimension(nzm) :: accre_enhan ! optional accretion enhancement factor for MG +#endif /*CLUBB_CRM*/ + +real, dimension(nzm,nmicro_fields) :: stend1d, mtend1d +real :: tmpc, tmpr, tmpi, tmps, tmpg +integer :: i1, i2, j1, j2, i, j, k, m, n + +real(kind=selected_real_kind(12)) :: tmp_total, tmptot + +! call t_startf ('micro_proc') + +#ifndef CRM +if(mod(nstep-1,nstatis).eq.0.and.icycle.eq.1) then + do j=1,ny + do i=1,nx + precsfc(i,j)=0. ! in SPCAM, done in crm.F90 + end do + end do + do k=1,nzm + precflux(k) = 0. ! in SPCAM, done in crm.F90 + end do +end if +#endif ! end CRM + +if(dostatis) then ! initialize arrays for statistics + mfrac(:,:) = 0. + mtend(:,:) = 0. + trtau(:,:) = 0. +! qpfall(:)=0. ! in SPCAM, done in crm.F90 + tlat(:) = 0. + tmtend3d(:,:,:) = 0. +end if +stend(:,:) = 0. +mksed(:,:) = 0. + +!!$if(doprecip) total_water_prec = total_water_prec + total_water() + +do j = 1,ny + do i = 1,nx + + ! zero out mixing ratios of microphysical species + tmpqv(:) = 0. + tmpqcl(:) = 0. + tmpncl(:) = 0. + tmpqr(:) = 0. + tmpnr(:) = 0. + tmpqci(:) = 0. + tmpnci(:) = 0. + tmpqs(:) = 0. + tmpns(:) = 0. + tmpqg(:) = 0. + tmpng(:) = 0. + + ! get microphysical quantities in this grid column + tmpqv(:) = micro_field(i,j,:,iqv) !bloss/qt: This is total water (qv+qcl) +!bloss/qt: compute below from saturation adjustment. +!bloss/qt tmpqcl(:) = micro_field(i,j,:,iqcl) + if(dopredictNc) tmpncl(:) = micro_field(i,j,:,incl) + if(doprecip) then + tmpqr(:) = micro_field(i,j,:,iqr) + tmpnr(:) = micro_field(i,j,:,inr) + end if + + if(doicemicro) then + tmpqci(:) = micro_field(i,j,:,iqci) + tmpnci(:) = micro_field(i,j,:,inci) + tmpqs(:) = micro_field(i,j,:,iqs) + tmpns(:) = micro_field(i,j,:,ins) + if(dograupel) then + tmpqg(:) = micro_field(i,j,:,iqg) + tmpng(:) = micro_field(i,j,:,ing) + end if + end if + + ! get absolute temperature in this column + !bloss/qt: before saturation adjustment for liquid, + ! this is Tcl = T - (L/Cp)*qcl (the cloud liquid water temperature) + tmptabs(:) = t(i,j,:) & ! liquid water-ice static energy over Cp + - gamaz(:) & ! potential energy + + fac_cond * (tmpqr(:)) & ! bloss/qt: liquid latent energy due to rain only + + fac_sub * (tmpqci(:) + tmpqs(:) + tmpqg(:)) ! ice latent energy + + tmpdz = adz(:)*dz +! tmpw = 0.5*(w(i,j,1:nzm) + w(i,j,2:nz)) ! MK: changed for stretched grids + tmpw = ((zi(2:nz)-z(1:nzm))*w(i,j,1:nzm)+ & + (z(1:nzm)-zi(1:nzm))*w(i,j,2:nz))/(zi(2:nz)-zi(1:nzm)) +#ifdef CLUBB_CRM + ! Added by dschanen on 4 Nov 2008 to account for w_sgs + if ( doclubb .and. dosubgridw ) then + ! Compute w_sgs. Formula is consistent with that used with + ! TKE from MYJ pbl scheme in WRF (see module_mp_graupel.f90). + tmpwsub = sqrt( LIN_INT( real( wp2(i,j,2:nz) ), real( wp2(i,j,1:nzm) ), & + zi(2:nz), zi(1:nzm), z(1:nzm) ) ) + else +! tmpwsub = 0. +! diagnose tmpwsub from tke. +! Notes: tke has to be already prognsotic or diagnostic. + tmpwsub = sqrt(tke2(i,j,:)/3.) ! diagnosed tmpwsub from tke +! diagnose tmpwsub from tk +! tmpwsub = sqrt(2*3.141593)*tk(i,j,:)/(dz*adz(:)) ! from Ghan et al. (1997, JGR). + end if + + if ( doclubb ) then + cloud_frac_in(1:nzm) = cloud_frac(i,j,2:nz) + liq_cldfrac(1:nzm) = cloud_frac(i,j,2:nz) + else + cloud_frac_in(1:nzm) = 0.0 + end if + +#else /* Old code */ +! tmpwsub = 0. +! diagnose tmpwsub from tke. +! Notes: tke has to be already prognsotic or diagnostic. + tmpwsub = sqrt(tke2(i,j,:)/3.) ! diagnosed tmpwsub from tke +! diagnose tmpwsub from tk +! tmpwsub = sqrt(2*3.141593)*tk(i,j,:)/(dz*adz(:)) ! from Ghan et al. (1997, JGR). +#endif + wvar(i,j,:) = tmpwsub(:) + + tmppres(:) = 100.*pres(1:nzm) + + !bloss/qt: saturation adjustment to compute cloud liquid water content. + ! Note: tmpqv holds qv+qcl on input, qv on output. + ! tmptabs hold T-(L/Cp)*qcl on input, T on output. + ! tmpqcl hold qcl on output. + ! tmppres is unchanged on output, should be in Pa. +#ifdef CLUBB_CRM + ! In the CLUBB case, we want to call the microphysics on sub-saturated grid + ! boxes and weight by cloud fraction, therefore we use the CLUBB value of + ! liquid water. -dschanen 23 Nov 2009 + if ( .not. ( docloud .or. dosmoke ) ) then + if(.not.doclubb_tb) then + tmpqcl = cloudliq(i,j,:) ! Liquid updated by CLUBB just prior to this + tmpqv = tmpqv - tmpqcl ! Vapor + tmptabs = tmptabs + fac_cond * tmpqcl ! Update temperature + if(doclubb_gridmean) then + cloud_frac_in(1:nzm) = 0.0 ! to use grid mean for Morrison microphysics, just + ! simply set cloud_frac_in to be zero. + liq_cldfrac(1:nzm) = cloud_frac(i,j,2:nz) + + CF3D(i, j, 1:nzm) = cloud_frac(i, j, 2:nz) + ice_cldfrac(:)= 0.0 + if(doicemicro) then + do k=1, nzm + if(tmpqci(k).gt.1.0e-8) then + ice_cldfrac(k) = 1.0 + end if + if((tmpqcl(k) + tmpqci(k)).gt.1.0e-9) then + CF3D(i,j,k) = (CF3D(i,j,k) * tmpqcl(k) + ice_cldfrac(k) * tmpqci(k)) & + / (tmpqcl(k) + tmpqci(k)) + else + CF3D(i,j,k) = 0.0 + end if + ice_cldfrac(k) = max(CF3D(i,j,k), liq_cldfrac(k)) + end do + endif + end if + else + call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) + cloudliq(i,j,:) = tmpqcl + cloud_frac_in(1:nzm) = 0.0 + end if + else + call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) + end if +#else + call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) +#endif + + +#ifdef ECPP +! save cloud water before microphysics process for the calculation +! of qlsink in ECPP + qcloud_bf(i,j,:) = tmpqcl(:) +#endif /*ECPP*/ + + i1 = 1 ! dummy variables used by WRF convention in subroutine call + i2 = 1 + j1 = 1 + j2 = 1 + +! hm 7/26/11, initialize new output + tmpaut=0. + tmpacc=0. + tmpevpc=0. + tmpevpr=0. + tmpmlt=0. + tmpsub=0. + tmpdep=0. + tmpcon=0. + + mtendqv = 0. + mtendqcl = 0. + mtendqr = 0. + mtendqci = 0. + mtendqs = 0. + mtendqg = 0. + mtendncl = 0. + mtendnr = 0. + mtendnci = 0. + mtendns = 0. + mtendng = 0. + + tmtend1d = 0. + + sfcpcp = 0. + sfcicepcp = 0. + + sfcpcp2D = 0.0 !+++mhwangtest + + effc1d(:) = 10. ! default liquid and ice effective radii + effi1d(:) = 75. + +#ifdef CLUBB_CRM + relvar(:) = 8. + accre_enhan(:) = 1. + if ( doclubb ) then + if ( any( tmpqv < 0. ) ) then + qv_clip(2:nz) = tmpqv(1:nzm) + qv_clip(1) = 0.0_core_rknd + if ( clubb_at_least_debug_level( 1 ) ) then + write(0,*) "M2005 has received a negative water vapor" + end if + call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qv_clip ) + tmpqv = qv_clip(2:nz) + end if + if ( any( tmpqcl < 0. ) ) then + qcl_clip(2:nz) = tmpqcl(1:nzm) + qcl_clip(1) = 0.0_core_rknd + if ( clubb_at_least_debug_level( 1 ) ) then + write(0,*) "M2005 has received a negative liquid water" + end if + call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qcl_clip ) + tmpqcl = qcl_clip(2:nz) + end if + + ! ------------------------------------------------- ! + ! Diagnose relative cloud water variance ! + ! ------------------------------------------------- ! +! relvar(:) = 1.0 ! default +! where (tmpqcl(:) /= 0. .and. qclvar(i,j, :) /= 0.) & +! relvar(:) = min(8.0, max(0.35,tmpqcl(:)**2/qclvar(i,j,:))) +! relvar(:) = min(8.0, max(0.35,tmpqcl(:)**2/qclvar(i,j,:))) + + ! ------------------------------------------------- ! + ! Optional Accretion enhancement factor ! + ! ------------------------------------------------- ! +! accre_enhan(:) = 1.+0.65*(1.0/relvar(:)) + relvar(:) = relvarg(i,j,:) + accre_enhan(:) = accre_enhang(i,j,:) + end if ! doclubb + + ! explanation of variable names: + ! mtend1d: array of 1d profiles of microphysical tendencies (w/o sed.) + ! stend1d: array of 1d profiles of sedimentation tendencies for q* + ! tmp**: on input, current value of **. On output, new value of **. + ! eff*1d: one-dim. profile of effective raduis for * + call m2005micro_graupel(& + mtendqcl,mtendqci,mtendqs,mtendqr, & + mtendncl,mtendnci,mtendns,mtendnr, & + tmpqcl,tmpqci,tmpqs,tmpqr, & + tmpncl,tmpnci,tmpns,tmpnr, & + tmtend1d,mtendqv, & + tmptabs,tmpqv,tmppres,rho,tmpdz,tmpw,tmpwsub, & +! hm 7/26/11, new output + tmpacc,tmpaut,tmpevpc,tmpevpr,tmpmlt, & + tmpsub,tmpdep,tmpcon, & + sfcpcp, sfcicepcp, & + effc1d,effi1d,effs1d,effr1d, & + dtn, & + i1,i2, j1,j2, 1,nzm, i1,i2, j1,j2, 1,nzm, & + mtendqg,mtendng,tmpqg,tmpng,effg1d,stendqg, & + stendqr,stendqci,stendqs,stendqcl,cloud_frac_in, liq_cldfrac, ice_cldfrac, relvar, accre_enhan & ! cloud_frac added by dschanen UWM +#ifdef ECPP + ,C2PREC,QSINK_TMP,CSED,ISED,SSED,GSED,RSED,RH3D & ! mhwang add, for ECPP +#endif + ) + + if ( doclubb ) then + if ( any( tmpqv < 0. ) ) then + qv_clip(2:nz) = tmpqv(1:nzm) + qv_clip(1) = 0.0_core_rknd + if ( clubb_at_least_debug_level( 1 ) ) then + write(0,*) "M2005 has produced a negative water vapor" + end if + call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qv_clip ) + tmpqv = qv_clip(2:nz) + end if + if ( any( tmpqcl < 0. ) ) then + qcl_clip(2:nz) = tmpqcl(1:nzm) + qcl_clip(1) = 0.0_core_rknd + if ( clubb_at_least_debug_level( 1 ) ) then + write(0,*) "M2005 has produced a negative liquid water" + end if + call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qcl_clip ) + tmpqcl = qcl_clip(2:nz) + end if + end if ! doclubb +#else + ! explanation of variable names: + ! mtend1d: array of 1d profiles of microphysical tendencies (w/o sed.) + ! stend1d: array of 1d profiles of sedimentation tendencies for q* + ! tmp**: on input, current value of **. On output, new value of **. + ! eff*1d: one-dim. profile of effective raduis for * + call m2005micro_graupel(& + mtendqcl,mtendqci,mtendqs,mtendqr, & + mtendncl,mtendnci,mtendns,mtendnr, & + tmpqcl,tmpqci,tmpqs,tmpqr, & + tmpncl,tmpnci,tmpns,tmpnr, & + tmtend1d,mtendqv, & + tmptabs,tmpqv,tmppres,rho,tmpdz,tmpw,tmpwsub, & +! hm 7/26/11, new output + tmpacc,tmpaut,tmpevpc,tmpevpr,tmpmlt, & + tmpsub,tmpdep,tmpcon, & + sfcpcp, sfcicepcp, & + effc1d,effi1d,effs1d,effr1d, & + dtn, & + i1,i2, j1,j2, 1,nzm, i1,i2, j1,j2, 1,nzm, & + mtendqg,mtendng,tmpqg,tmpng,effg1d,stendqg, & + stendqr,stendqci,stendqs,stendqcl & +#ifdef ECPP + ,C2PREC,QSINK_TMP,CSED,ISED,SSED,GSED,RSED,RH3D & ! mhwang add, for ECPP +#endif + ) +#endif + +#ifdef CRM +! hm 7/26/11, new output + aut1(i,j,:) = tmpaut(:) + acc1(i,j,:) = tmpacc(:) + evpc1(i,j,:) = tmpevpc(:) + evpr1(i,j,:) = tmpevpr(:) + mlt1(i,j,:) = tmpmlt(:) + sub1(i,j,:) = tmpsub(:) + dep1(i,j,:) = tmpdep(:) + con1(i,j,:) = tmpcon(:) + +! hm 8/31/11, new output for gcm-grid and time-step avg +! rates are summed here over the icycle loop +! note: rates are multiplied by time step, and then +! divided by dt in crm.F90 to get mean rates + aut1a(i,j,:) = aut1a(i,j,:) + aut1(i,j,:)*dtn + acc1a(i,j,:) = acc1a(i,j,:) + acc1(i,j,:)*dtn + evpc1a(i,j,:) = evpc1a(i,j,:) + evpc1(i,j,:)*dtn + evpr1a(i,j,:) = evpr1a(i,j,:) + evpr1(i,j,:)*dtn + mlt1a(i,j,:) = mlt1a(i,j,:) + mlt1(i,j,:)*dtn + sub1a(i,j,:) = sub1a(i,j,:) + sub1(i,j,:)*dtn + dep1a(i,j,:) = dep1a(i,j,:) + dep1(i,j,:)*dtn + con1a(i,j,:) = con1a(i,j,:) + con1(i,j,:)*dtn +#endif + + ! update microphysical quantities in this grid column + if(doprecip) then + total_water_prec = total_water_prec + sfcpcp + + ! take care of surface precipitation + precsfc(i,j) = precsfc(i,j) + sfcpcp/dz + prec_xy(i,j) = prec_xy(i,j) + sfcpcp/dtn/dz +!+++mhwang + sfcpcp2D(i,j) = sfcpcp/dtn/dz +!---mhwang +#ifdef CRM + precssfc(i,j) = precssfc(i,j) + sfcicepcp/dz ! the corect unit of precssfc should be mm/dz +++mhwang +#endif + ! update rain + micro_field(i,j,:,iqr) = tmpqr(:) + micro_field(i,j,:,inr) = tmpnr(:) + else + ! add rain to cloud + tmpqcl(:) = tmpqcl(:) + tmpqr(:) ! add rain mass back to cloud water + tmpncl(:) = tmpncl(:) + tmpnr(:) ! add rain number back to cloud water + + ! zero out rain + tmpqr(:) = 0. + tmpnr(:) = 0. + + ! add rain tendencies to cloud + stendqcl(:) = stendqcl(:) + stendqr(:) + mtendqcl(:) = mtendqcl(:) + mtendqr(:) + mtendncl(:) = mtendncl(:) + mtendnr(:) + + ! zero out rain tendencies + stendqr(:) = 0. + mtendqr(:) = 0. + mtendnr(:) = 0. + end if + + !bloss/qt: update total water and cloud liquid. + ! Note: update of total water moved to after if(doprecip), + ! since no precip moves rain --> cloud liq. + micro_field(i,j,:,iqv) = tmpqv(:) + tmpqcl(:) !bloss/qt: total water + cloudliq(i,j,:) = tmpqcl(:) !bloss/qt: auxilliary cloud liquid water variable + if(dopredictNc) micro_field(i,j,:,incl) = tmpncl(:) + + reffc(i,j,:) = effc1d(:) + + if(doicemicro) then + micro_field(i,j,:,iqci) = tmpqci(:) + micro_field(i,j,:,inci) = tmpnci(:) + micro_field(i,j,:,iqs) = tmpqs(:) + micro_field(i,j,:,ins) = tmpns(:) + if(dograupel) then + micro_field(i,j,:,iqg) = tmpqg(:) + micro_field(i,j,:,ing) = tmpng(:) + end if + reffi(i,j,:) = effi1d(:) + end if + + !===================================================== + ! update liquid-ice static energy due to precipitation + t(i,j,:) = t(i,j,:) & + - dtn*fac_cond*(stendqcl+stendqr) & + - dtn*fac_sub*(stendqci+stendqs+stendqg) + !===================================================== + + if(dostatis) then +!bloss/qt: total water microphysical tendency includes qv and qcl + mtend(:,iqv) = mtend(:,iqv) + mtendqv + mtendqcl +!bloss/qt mtend(:,iqcl) = mtend(:,iqcl) + mtendqcl + if(dopredictNc) mtend(:,incl) = mtend(:,incl) + mtendncl + if(doprecip) then + mtend(:,iqr) = mtend(:,iqr) + mtendqr + mtend(:,inr) = mtend(:,inr) + mtendnr + end if + + if(doicemicro) then + mtend(:,iqci) = mtend(:,iqci) + mtendqci + mtend(:,inci) = mtend(:,inci) + mtendnci + !bloss stend(:,inci) = stend(:,inci) + stendnci + + mtend(:,iqs) = mtend(:,iqs) + mtendqs + mtend(:,ins) = mtend(:,ins) + mtendns + !bloss stend(:,ins) = stend(:,ins) + stendns + + if(dograupel) then + mtend(:,iqg) = mtend(:,iqg) + mtendqg + mtend(:,ing) = mtend(:,ing) + mtendng + !bloss stend(:,ing) = stend(:,ing) + stendng + end if + end if + + do n = 1,nmicro_fields + do k = 1,nzm + if(micro_field(i,j,k,n).ge.1.e-6) mfrac(k,n) = mfrac(k,n)+1. + end do + end do + + ! approximate optical depth = 0.0018*lwp/effrad + ! integrated up to level at which output + tmpc = 0. + tmpr = 0. + tmpi = 0. + tmps = 0. + tmpg = 0. + + do k = 1,nzm + tmpc = tmpc + 0.0018*rho(k)*dz*adz(k)*tmpqcl(k)/(1.e-20+1.e-6*effc1d(k)) + tmpr = tmpr + 0.0018*rho(k)*dz*adz(k)*tmpqr(k)/(1.e-20+1.e-6*effr1d(k)) + !bloss/qt: put cloud liquid optical depth in trtau(:,iqv) + trtau(k,iqv) = trtau(k,iqv) + tmpc + if(doprecip) trtau(k,iqr) = trtau(k,iqr) + tmpr + + if(doicemicro) then + tmpi = tmpi + 0.0018*rho(k)*dz*adz(k)*tmpqci(k)/(1.e-20+1.e-6*effi1d(k)) + tmps = tmps + 0.0018*rho(k)*dz*adz(k)*tmpqs(k)/(1.e-20+1.e-6*effs1d(k)) + tmpg = tmpg + 0.0018*rho(k)*dz*adz(k)*tmpqg(k)/(1.e-20+1.e-6*effg1d(k)) + + trtau(k,iqci) = trtau(k,iqci) + tmpi + trtau(k,iqs) = trtau(k,iqs) + tmps +#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ + if ( dograupel ) then + trtau(k,iqg) = trtau(k,iqg) + tmpg + end if +#else + trtau(k,iqg) = trtau(k,iqg) + tmpg +#endif /* CLUBB */ + end if + end do + + tlat(1:nzm) = tlat(1:nzm) & + - dtn*fac_cond*(stendqcl+stendqr) & + - dtn*fac_sub*(stendqci+stendqs+stendqg) + qpfall(1:nzm) = qpfall(1:nzm) + dtn*(stendqr+stendqs+stendqg) + +#ifdef CRM + qpsrc(1:nzm) = qpsrc(1:nzm) + dtn*(mtendqr+mtendqs+mtendqg) + qpevp(1:nzm) = 0.0 +#endif + + !bloss: temperature tendency (sensible heating) due to phase changes + tmtend3d(i,j,1:nzm) = tmtend1d(1:nzm) + + end if ! dostatis + + stend(:,iqv) = stend(:,iqv) + stendqcl !bloss/qt: iqcl --> iqv + if(doprecip) then + stend(:,iqr) = stend(:,iqr) + stendqr + end if + + if(doicemicro) then + stend(:,iqci) = stend(:,iqci) + stendqci + stend(:,iqs) = stend(:,iqs) + stendqs + if(dograupel) stend(:,iqg) = stend(:,iqg) + stendqg + end if + +#ifdef ECPP + do k=1, nzm + qlsink_bf(i,j,k) = min(1.0/dt, QSINK_TMP(k)) ! /s + rh(i,j,k) = RH3D(k) !0-1 + prain(i,j,k) = C2PREC(K) ! kg/kg/s + if(cloudliq(i,j,k).gt.1.0e-10) then + qlsink(i,j,k) = min(1.0/dt, C2PREC(k)/cloudliq(i,j,k)) + else + qlsink(i,j,k) = 0.0 + end if + end do + precr(i,j,:)=(RSED(:)) ! kg/m2/s + precsolid(i,j,:)=(SSED(:)+GSED(:)) !kg/m2/s leave ISED out for the momenent, and we may want to + ! test it effects in the future. +++mhwang +#endif /*ECPP*/ + + end do ! i = 1,nx +end do ! j = 1,ny + +! back sedimentation flux out from sedimentation tendencies +tmpc = 0. +do k = 1,nzm + m = nz-k + tmpc = tmpc + stend(m,iqv)*rho(m)*dz*adz(m) !bloss/qt: iqcl --> iqv + mksed(m,iqv) = tmpc +end do +precflux(1:nzm) = precflux(1:nzm) - mksed(:,iqv)*dtn/dz + +if(doprecip) then + tmpr = 0. + do k = 1,nzm + m = nz-k + tmpr = tmpr + stend(m,iqr)*rho(m)*dz*adz(m) + mksed(m,iqr) = tmpr + end do + precflux(1:nzm) = precflux(1:nzm) - mksed(:,iqr)*dtn/dz +end if + +if(doicemicro) then + tmpi = 0. + tmps = 0. + tmpg = 0. + do k = 1,nzm + m = nz-k + tmpi = tmpi + stend(m,iqci)*rho(m)*dz*adz(m) + tmps = tmps + stend(m,iqs)*rho(m)*dz*adz(m) +#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ + if ( dograupel ) then + tmpg = tmpg + stend(m,iqg)*rho(m)*dz*adz(m) + else + tmpg = 0. + end if +#else + tmpg = tmpg + stend(m,iqg)*rho(m)*dz*adz(m) +#endif + mksed(m,iqci) = tmpi + mksed(m,iqs) = tmps +#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ + if ( dograupel ) then + mksed(m,iqg) = tmpg + end if +#else + mksed(m,iqg) = tmpg +#endif + end do +#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ + if ( dograupel ) then + precflux(1:nzm) = precflux(1:nzm) & + - (mksed(:,iqci) + mksed(:,iqs) + mksed(:,iqg))*dtn/dz + else + precflux(1:nzm) = precflux(1:nzm) & + - (mksed(:,iqci) + mksed(:,iqs))*dtn/dz + end if +#else + precflux(1:nzm) = precflux(1:nzm) & + - (mksed(:,iqci) + mksed(:,iqs) + mksed(:,iqg))*dtn/dz +#endif +end if + +!!$if(doprecip) total_water_prec = total_water_prec - total_water() + +#ifdef CLUBB_CRM +if (docloud.or.doclubb) call micro_diagnose() ! leave this line here +if(doclubb) then + CF3D(1:nx, 1:ny, 1:nzm) = cloud_frac(1:nx, 1:ny, 2:nzm+1) + if(doicemicro) then + do i=1, nx + do j=1, ny + ice_cldfrac(:) = 0.0 + do k=1, nzm +! Ice cloud fraction: 0 at 0 C, and 100% at -35C. +! ice_cldfrac(k) = -(tmptabs(k)-T_freeze_K)/35.0 +! ice_cldfrac(k) = min(1.0, max(ice_cldfrac(k), 0.0)) + if(micro_field(i,j,k,iqci) .gt. 1.0e-8) then + ice_cldfrac(k) = 1.0 + end if + if(cloudliq(i,j,k) + micro_field(i,j,k,iqci) .gt.1.0e-9) then + CF3D(i,j,k) = (CF3D(i,j,k)* cloudliq(i,j,k) + ice_cldfrac(k) * micro_field(i,j,k,iqci)) & + / (cloudliq(i,j,k) + micro_field(i,j,k,iqci)) + else + CF3D(i,j,k) = 0.0 + end if + end do + end do + end do + endif +endif +#else +if (docloud) call micro_diagnose() ! leave this line here +#endif + +! call t_stopf ('micro_proc') + +end subroutine micro_proc + +!---------------------------------------------------------------------- +!!! Diagnose arrays nessesary for dynamical core and radiation: +! +! This is the pace where the microphysics field that SAM actually cares about +! are diagnosed. + +subroutine micro_diagnose() + +use crmx_vars +#ifdef CLUBB_CRM +use crmx_error_code, only: clubb_at_least_debug_level ! Procedure +use crmx_constants_clubb, only: fstderr, zero_threshold +implicit none +#endif + +real omn, omp +integer i,j,k + +! water vapor = total water - cloud liquid +qv(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqv) & + - cloudliq(1:nx,1:ny,1:nzm) + +#ifdef CLUBB_CRM +do i = 1, nx + do j = 1, ny + do k = 1, nzm + ! Apply local hole-filling to vapor by converting liquid to vapor. Moist + ! static energy should be conserved, so updating temperature is not + ! needed here. -dschanen 31 August 2011 + if ( qv(i,j,k) < zero_threshold ) then + cloudliq(i,j,k) = cloudliq(i,j,k) + qv(i,j,k) + qv(i,j,k) = zero_threshold + if ( cloudliq(i,j,k) < zero_threshold ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Total water at", "i =", i, "j =", j, "k =", k, "is negative.", & + "Applying non-conservative hard clipping." + end if + cloudliq(i,j,k) = zero_threshold + end if ! cloud_liq < 0 + end if ! qv < 0 + end do ! 1.. nzm + end do ! 1.. ny +end do ! 1.. nx +#endif /* CLUBB_CRM */ +! cloud liquid water +qcl(1:nx,1:ny,1:nzm) = cloudliq(1:nx,1:ny,1:nzm) + +! rain water +if(doprecip) qpl(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqr) + +! cloud ice +if(doicemicro) then + qci(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqci) + + if(dograupel) then + qpi(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) & + + micro_field(1:nx,1:ny,1:nzm,iqg) + else + qpi(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) + end if +end if + +end subroutine micro_diagnose + +#ifdef CLUBB_CRM +!--------------------------------------------------------------------- +subroutine micro_update() + +! Description: +! This subroutine essentially does what micro_proc does but does not +! call any microphysics subroutines. We need to do this for the +! single-moment bulk microphysics (SAM1MOM) so that CLUBB gets a +! properly updated value of ice fed in. +! +! -dschanen UWM +!--------------------------------------------------------------------- + + ! Update the dynamical core variables (e.g. qv, qcl) with the value in + ! micro_field. Diffusion, advection, and other processes are applied to + ! micro_field but not the variables in vars.f90 + call micro_diagnose() + + return +end subroutine micro_update + +!--------------------------------------------------------------------- +subroutine micro_adjust( new_qv, new_qc ) +! Description: +! Adjust total water in SAM based on values from CLUBB. +! References: +! None +!--------------------------------------------------------------------- + + use crmx_vars, only: qci + + implicit none + + real, dimension(nx,ny,nzm), intent(in) :: & + new_qv, & ! Water vapor mixing ratio that has been adjusted by CLUBB [kg/kg] + new_qc ! Cloud water mixing ratio that has been adjusted by CLUBB [kg/kg] + + ! Total water mixing ratio + micro_field(1:nx,1:ny,1:nzm,iqv) = new_qv(1:nx,1:ny,1:nzm) & + + new_qc(1:nx,1:ny,1:nzm) + + ! Cloud water mixing ratio + cloudliq(1:nx,1:ny,1:nzm) = new_qc(1:nx,1:ny,1:nzm) + + return +end subroutine micro_adjust + +#endif /*CLUBB_CRM*/ + +!---------------------------------------------------------------------- +!!! functions to compute terminal velocity for precipitating variables: +! +! you need supply functions to compute terminal velocity for all of your +! precipitating prognostic variables. Note that all functions should +! compute vertical velocity given two microphysics parameters var1, var2, +! and temperature, and water vapor (single values, not arrays). Var1 and var2 +! are some microphysics variables like water content and concentration. +! Don't change the number of arguments or their meaning! + +!!$real function term_vel_qr(qr,nr,tabs,rho) +!!$! ....... +!!$end function term_vel_qr +!!$ +!!$real function term_vel_Nr(qr,nr,tabs,rho) +!!$! ....... +!!$end function term_vel_Nr +!!$ +!!$real function term_vel_qs(qs,ns,tabs,rho) +!!$! ....... +!!$end function term_vel_qs + +! etc. + +!---------------------------------------------------------------------- +!!! compute sedimentation +! +! The perpose of this subroutine is to prepare variables needed to call +! the precip_all() for each of the falling hydrometeor varibles +subroutine micro_precip_fall() + +! before calling precip_fall() for each of falling prognostic variables, +! you need to set hydro_type and omega(:,:,:) variables. +! hydro_type can have four values: +! 0 - variable is liquid water mixing ratio +! 1 - hydrometeor is ice mixing ratio +! 2 - hydrometeor is mixture-of-liquid-and-ice mixing ratio. (As in original SAM microphysics). +! 3 - variable is not mixing ratio, but, for example, rain drop concentration +! OMEGA(:,:,:) is used only for hydro_type=2, and is the fraction of liquid phase (0-1). +! for hour hypothetical case, there is no mixed hydrometeor, so omega is not actually used. + +integer hydro_type +real omega(nx,ny,nzm) + +integer i,j,k + +return ! do not need this routine -- sedimentation done in m2005micro. + +!!$! Initialize arrays that accumulate surface precipitation flux +!!$ +!!$ if(mod(nstep-1,nstatis).eq.0.and.icycle.eq.1) then +!!$ do j=1,ny +!!$ do i=1,nx +!!$ precsfc(i,j)=0. +!!$ end do +!!$ end do +!!$ do k=1,nzm +!!$ precflux(k) = 0. +!!$ end do +!!$ end if +!!$ +!!$ do k = 1,nzm ! Initialize arrays which hold precipitation fluxes for stats. +!!$ qpfall(k)=0. +!!$ tlat(k) = 0. +!!$ end do +!!$ +!!$! Compute sedimentation of falling variables: +!!$ +!!$ hydro_type=0 +!!$ call precip_fall(qr, term_vel_qr, hydro_type, omega) +!!$ hydro_type=3 +!!$ call precip_fall(Nr, term_vel_Nr, hydro_type, omega) +!!$ hydro_type=1 +!!$ call precip_fall(qs, term_vel_qs, hydro_type, omega) +!!$ hydro_type=3 +!!$ call precip_fall(Ns, term_vel_Ns, hydro_type, omega) +!!$ hydro_type=1 +!!$ call precip_fall(qg, term_vel_qg, hydro_type, omega) +!!$ hydro_type=3 +!!$ call precip_fall(Ng, term_vel_Ng, hydro_type, omega) +!!$ + + +end subroutine micro_precip_fall + +!---------------------------------------------------------------------- +! called when stepout() called + +subroutine micro_print() + implicit none + integer :: k + + ! print out min/max values of all microphysical variables + do k=1,nmicro_fields + call fminmax_print(trim(mkname(k))//':', & + micro_field(:,:,:,k),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) + end do + +end subroutine micro_print + +!----------------------------------------- +subroutine satadj_liquid(nzm,tabs,qt,qc,pres) + !bloss/qt: Utility routine based on cloud.f90 in + ! MICRO_SAM1MOM that was written by Marat Khairoutdinov. + ! This routine performs a saturation adjustment for + ! cloud liquid water only using a Newton method. + ! While 20 iterations are allowed, most often this + ! routine should exit in five iterations or less. + ! Only a single calculation of the saturation vapor + ! pressure is required in subsaturated air. + + use crmx_module_mp_GRAUPEL, only: polysvp + use crmx_params, only: cp, lcond, rv, fac_cond + implicit none + + integer, intent(in) :: nzm + real, intent(inout), dimension(nzm) :: tabs ! absolute temperature, K + real, intent(inout), dimension(nzm) :: qt ! on input: qt; on output: qv + real, intent(out), dimension(nzm) :: qc ! cloud liquid water, kg/kg + real, intent(in), dimension(nzm) :: pres ! pressure, Pa + + real tabs1, dtabs, thresh, esat1, qsat1, fff, dfff + integer k, niter + + integer, parameter :: maxiter = 20 + + !bloss/qt: quick saturation adjustment to compute cloud liquid water content. + do k = 1,nzm + tabs1 = tabs(k) + esat1 = polysvp(tabs1,0) + qsat1 = 0.622*esat1/ (pres(k) - esat1) + qc(k) = 0. ! no cloud unless qt > qsat + + if (qt(k).gt.qsat1) then + + ! if unsaturated, nothing to do (i.e., qv=qt, T=Tl) --> just exit. + ! if saturated, do saturation adjustment + ! (modeled after Marat's cloud.f90). + + ! generate initial guess based on above calculation of qsat + dtabs = + fac_cond*MAX(0.,qt(k) - qsat1) & + / ( 1. + lcond**2*qsat1/(cp*rv*tabs1**2) ) + tabs1 = tabs1 + dtabs + niter = 1 + + ! convergence threshold: min of 0.01K and latent heating due to + ! condensation of 1% of saturation mixing ratio. + thresh = MIN(0.01, 0.01*fac_cond*qsat1) + + ! iterate while temperature increment > thresh and niter < maxiter + do while((ABS(dtabs).GT.thresh) .AND. (niter.lt.maxiter)) + + esat1 = polysvp(tabs1,0) + qsat1 = 0.622*esat1/ (pres(k) - esat1) ! saturation mixing ratio + + fff = tabs(k) - tabs1 + fac_cond*MAX(0.,qt(k) - qsat1) + dfff = 1. + lcond**2*qsat1/(cp*rv*tabs1**2) + dtabs = fff/dfff + tabs1 = tabs1 + dtabs + + niter = niter + 1 + + end do + + qc(k) = MAX( 0.,tabs1 - tabs(k) )/fac_cond ! cloud liquid mass mixing ratio + qt(k) = qt(k) - qc(k) ! This now holds the water vapor mass mixing ratio. + tabs(k) = tabs1 ! update temperature. + + if(niter.gt.maxiter-1) write(*,*) 'Reached iteration limit in satadj_liquid' + + end if ! qt_in > qsat + + end do ! k = 1,nzm + +end subroutine satadj_liquid + +!----------------------------------------------------------------------- +! Supply function that computes total water in a domain: +! +real(kind=selected_real_kind(12)) function total_water() + + use crmx_vars, only : nstep,nprint,adz,dz,rho + real(kind=selected_real_kind(12)) tmp + integer i,j,k,m + + total_water = 0. + do m=1,nmicro_fields + if(flag_wmass(m).eq.1) then + do k=1,nzm + tmp = 0. + do j=1,ny + do i=1,nx + tmp = tmp + micro_field(i,j,k,m) + end do + end do + total_water = total_water + tmp*adz(k)*dz*rho(k) + end do + end if + end do + +end function total_water + +function Get_reffc() ! liquid water + real, dimension(nx,ny,nzm) :: Get_reffc + Get_reffc = reffc +end function Get_reffc + +function Get_reffi() ! ice + real, dimension(nx,ny,nzm) :: Get_reffi + Get_reffi = reffi +end function Get_reffi +#ifdef CLUBB_CRM +!------------------------------------------------------------------------------- +ELEMENTAL FUNCTION LIN_INT( var_high, var_low, height_high, height_low, height_int ) + +! This function computes a linear interpolation of the value of variable. +! Given two known values of a variable at two height values, the value +! of that variable at a height between those two height levels (rather +! than a height outside of those two height levels) is computed. +! +! Here is a diagram: +! +! ################################ Height high, know variable value +! +! +! +! -------------------------------- Height to be interpolated to; linear interpolation +! +! +! +! +! +! ################################ Height low, know variable value +! +! +! FORMULA: +! +! variable(@ Height interpolation) = +! +! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] +! * (Height interpolation - Height low) + variable(@ Height low) + +! Author: Brian Griffin, UW-Milwaukee +! Modifications: Dave Schanen added the elemental attribute 4 Nov 2008 +! References: None + +IMPLICIT NONE + +! Input Variables +REAL, INTENT(IN):: var_high +REAL, INTENT(IN):: var_low +REAL, INTENT(IN):: height_high +REAL, INTENT(IN):: height_low +REAL, INTENT(IN):: height_int + +! Output Variable +REAL:: LIN_INT + +LIN_INT = ( var_high - var_low ) / ( height_high - height_low ) & + * ( height_int - height_low ) + var_low + + +END FUNCTION LIN_INT +#endif /*CLUBB_CRM*/ +!------------------------------------------------------------------------------ + +end module crmx_microphysics + + + diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 new file mode 100644 index 0000000000..fd945c4a89 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 @@ -0,0 +1,6884 @@ +!WRF:MODEL_LAYER:PHYSICS +!HM: This is version 2 of Hugh Morrison's two moment, five class scheme. +! + +! THIS MODULE CONTAINS THE TWO-MOMENT MICROPHYSICS CODE DESCRIBED BY +! MORRISON ET AL. (2009, MWR) +! recent changes with respect to V1.4 + +! V1.5 +! 1) more pathways to allow hail to form (only affects IHAIL=1 option), from collisions of snow/cloud water +! 2) bug fix to PGAM calculation (multiplication instead of division by air density) + +! V1.6 +! 1) added parameter TMELT for all calculations involving melting point +! 2) replaced hard-wired gas constant for air with parameter value 'R' + +! V1.7 +! 1) modification to minimum mixing ratio in dry conditions, change from 10^-6 to 10^-8 kg/kg +! to improve reflectivity at low mixing ratio amounts +! 2) bug fix to prevent possible division by zero error involving LAMI +! 3) change for liquid saturation vapor pressure, replace old formula with Flatau et al. 1992 + +! V2 +! 1) bug fix to maximum-allowed particle fallspeeds (air density correction factor considered) +! 2) change to comments + +! *** Changes incorporated from WRF: *** +! CHANGES FOR V3.2, RELATIVE TO MOST RECENT (BUG-FIX) CODE FOR V3.1 + +! 1) ADDED ACCELERATED MELTING OF GRAUPEL/SNOW DUE TO COLLISION WITH RAIN, FOLLOWING LIN ET AL. (1983) +! 2) INCREASED MINIMUM LAMBDA FOR RAIN, AND ADDED RAIN DROP BREAKUP FOLLOWING MODIFIED VERSION +! OF VERLINDE AND COTTON (1993) +! 3) CHANGE MINIMUM ALLOWED MIXING RATIOS IN DRY CONDITIONS (RH < 90%), THIS IMPROVES RADAR REFLECTIIVITY +! IN LOW REFLECTIVITY REGIONS +! 4) BUG FIX TO MAXIMUM ALLOWED PARTICLE FALLSPEEDS AS A FUNCTION OF AIR DENSITY +! 5) BUG FIX TO CALCULATION OF LIQUID WATER SATURATION VAPOR PRESSURE (CHANGE IS VERY MINOR) + +! bug fix, 5/12/10 +! 6) bug fix for saturation vapor pressure in low pressure, to avoid division by zero + +! CHANGES FOR V3.3 +! 1) MODIFY FALLSPEED BELOW THE LOWEST LEVEL OF PRECIPITATION, WHICH PREVENTS +! POTENTIAL FOR SPURIOUS ACCUMULATION OF PRECIPITATION DURING SUB-STEPPING FOR SEDIMENTATION +! 2) BUG FIX TO LATENT HEAT RELEASE DUE TO COLLISIONS OF CLOUD ICE WITH RAIN +! 3) CLEAN UP OF COMMENTS IN THE CODE +! additional minor bug fixes and small changes, 5/30/2011 (CLUBB/SAM-CLUBB as of 5 Oct 2011) +! minor revisions by A. Ackerman April 2011: +! 1) replaced kinematic with dynamic viscosity +! 2) replaced scaling by air density for cloud droplet sedimentation +! with viscosity-dependent Stokes expression +! 3) use Ikawa and Saito (1991) air-density scaling for cloud ice +! 4) corrected typo in 2nd digit of ventilation constant F2R + +! Additional fixes +! 5) TEMPERATURE FOR ACCELERATED MELTING DUE TO COLLIIONS OF SNOW AND GRAUPEL +! WITH RAIN SHOULD USE CELSIUS, NOT KELVIN (BUG REPORTED BY K. VAN WEVERBERG) +! 6) NPRACS IS NO SUBTRACTED SUBTRACTED FROM SNOW NUMBER CONCENTRATION, SINCE +! DECREASE IN SNOW NUMBER IS ALREADY ACCOUNTED FOR BY NSMLTS +! 7) MODIFY FALLSPEED BELOW THE LOWEST LEVEL OF PRECIPITATION, WHICH PREVENTS +! POTENTIAL FOR SPURIOUS ACCUMULATION OF PRECIPITATION DURING SUB-STEPPING FOR SEDIMENTATION +! 8) BUG FIX TO LATENT HEAT RELEASE DUE TO COLLISIONS OF CLOUD ICE WITH RAIN +! 9) BUG FIX TO IGRAUP SWITCH FOR NO GRAUPEL/HAIL + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING +! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: +! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. + +MODULE crmx_module_mp_GRAUPEL +!bloss USE module_wrf_error +!bloss USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm ! GT +!bloss USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep ! GT + +! USE module_state_description +#ifdef CLUBB_CRM + use crmx_constants_clubb, only: Lv, Ls, Cp, Rv, Rd, T_freeze_K, rho_lw, grav, EP_2 => ep +#else + ! parameters from SAM and options from wrapper routine. + use crmx_params, only: lcond, lsub, cp, rgas, rv +#endif /*CLUBB_CRM*/ + +#if (defined CRM && defined MODAL_AERO) + use crmx_drop_activation, only: drop_activation_ghan + use cam_abortutils, only: endrun +#endif + + IMPLICIT NONE + +! Adding coefficient term for clex9_oct14 case. This will reduce NNUCCD and NNUCCC +! by some factor to allow cloud to persist at realistic time intervals. + +#ifdef CLUBB_CRM +! REAL, SAVE :: NNUCCD_REDUCE_COEF = 1.0, NNUCCC_REDUCE_COEF = 1.0 + REAL, SAVE :: NNUCCD_REDUCE_COEF = 1.0, NNUCCC_REDUCE_COEF = 1.0e-2 +#endif + +! Change by Marc Pilon on 11/16/11 + + + REAL, PARAMETER :: PI = 3.1415926535897932384626434 + REAL, PARAMETER :: SQRTPI = 0.9189385332046727417803297 + + PUBLIC :: MP_GRAUPEL + PUBLIC :: POLYSVP + + PRIVATE :: GAMMA, DERF1 + PRIVATE :: PI, SQRTPI + PUBLIC :: M2005MICRO_GRAUPEL !bloss + + !bloss: added options that may be set in prm file namelist + ! -- initialized in micrphysics.f90 + logical, public :: & + doicemicro, & ! use ice species (snow/cloud ice/graupel) + dograupel, & ! use graupel + dohail, & ! make graupel species have properties of hail + dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization + dopredictNc, & ! prediction of cloud droplet number + dosubgridw, & ! input estimate of subgrid w to microphysics + doarcticicenucl, & ! use arctic parameter values for ice nucleation + docloudedgeactivation,& ! activate cloud droplets throughout the cloud + dofix_pgam ! option to fix value of pgam (exponent in cloud water gamma distn) + +#ifdef CLUBB_CRM + logical, public :: doclubb_tb ! use clubb as a turbulence scheme only +++mhwang + ! so liquid water is diagnosed based on saturaiton adjustment + logical, public :: doclubb_gridmean ! if .true., grid-mean values from CLUBB feeds into + ! Morrison microphysics + logical, public :: doclubb_autoin ! in-cloud values for autoconversion +#endif + + integer, public :: & + aerosol_mode ! determines aerosol mode used + ! 0 = no aerosol mode + ! 1 = power-law + ! 2 = lognormal +#if (defined CRM && defined MODAL_AERO) + logical, public :: domodal_aero ! use modal aerosol from the CAM +#endif + + real, public :: & + Nc0, & ! specified cloud droplet number conc (#/cm3) + ccnconst, ccnexpnt, & ! dospecifyaerosol=.false. params (powerlaw CCN) + aer_rm1, aer_rm2, & ! two modes of aerosol for dospecifyaer...=.true. + aer_n1, aer_n2, & ! rm=geom mean radius (um), n=aer conc. (#/cm3) + aer_sig1, aer_sig2, & ! sig=geom standard deviation of aer size distn. + pgam_fixed ! fixed value of pgam used if dofix_pgam=.true. + +! SWITCHES FOR MICROPHYSICS SCHEME +! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K +! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA +! There's no IACT = 3 in SAM / SAM-CLUBB as per WRF +#if (defined CRM && defined MODAL_AERO) +! IACT = 3, USE MULTIMODE AEROSOL SIZE DIST to DERIVER CCN SPECTRA +#endif + + INTEGER, PRIVATE :: IACT + +! INUM = 0, PREDICT DROPLET CONCENTRATION +! INUM = 1, ASSUME CONSTANT DROPLET CONCENTRATION + + INTEGER, PRIVATE :: INUM + +! FOR INUM = 1, SET CONSTANT DROPLET CONCENTRATION (CM-3) + REAL, PRIVATE :: NDCNST + +! SWITCH FOR LIQUID-ONLY RUN +! ILIQ = 0, INCLUDE ICE +! ILIQ = 1, LIQUID ONLY, NO ICE + + INTEGER, PRIVATE :: ILIQ + +! SWITCH FOR ICE NUCLEATION +! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE) +! = 1, USE MPACE OBSERVATIONS + + INTEGER, PRIVATE :: INUC + +! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO +! UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE +! AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING +! NON-EQULIBRIUM SUPERSATURATION, +! IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION +! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO +! UNRESOLVED ENTRAINMENT AND MIXING DOMINATES, +! ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM +! SUPERSATURATION, BASED ON THE +! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY +! AT THE GRID POINT + +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) + + INTEGER, PRIVATE :: IBASE + +! INCLUDE SUB-GRID VERTICAL VELOCITY IN DROPLET ACTIVATION +! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION) +! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W + + INTEGER, PRIVATE :: ISUB + +! SWITCH FOR GRAUPEL/NO GRAUPEL +! IGRAUP = 0, INCLUDE GRAUPEL +! IGRAUP = 1, NO GRAUPEL + + INTEGER, PRIVATE :: IGRAUP + +! HM ADDED NEW OPTION FOR HAIL V1.3 +! SWITCH FOR HAIL/GRAUPEL +! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL +! IHAIL = 1, DENSE PRECIPITATING GICE IS HAIL + + INTEGER, PRIVATE :: IHAIL + +! HM ADDED 8/1/08, v1.4 +! SWITCH FOR WARM RAIN SCHEME +! IRAIN = 0, WARM RAIN (AUTO, ACC, SELF-COLL) FROM KHAIROUTIDNOV AND KOGAN (2000) +! IRAIN = 1, WARM RAIN (AUTO, ACC, SELF-COLL) FROM SEIFERT AND BEHENG (2001) + + INTEGER, PRIVATE :: IRAIN + +! PB ADDED 4/13/09 +! SWITCH TO TURN ON/OFF CLOUD LIQUID WATER SATURATION ADJUSTMENT +! WHEN USING TOTAL WATER FORMULATION IN SAM, THE SATURATION +! ADJUSTMENT IS PERFORMED BEFORE CALLING M2005MICRO_GRAUPEL. +! THIS OPTION ALLOWS US TO AVOID PERFORMING IT IN M2005MICRO_GRAUPEL +! UNDER THE THEORY THAT THE OTHER MICROPHYSICAL PROCESSES WILL NOT +! DRIVE IT FAR FROM SATURATION. +! ISATADJ = 0, SATURATION ADJUSTMENT PEROFORMED IN M2005MICRO_GRAUPEL +! ISATADJ = 1, SATURATION ADJUSTMENT _NOT_ PEROFORMED IN M2005MICRO_GRAUPEL + + INTEGER, PRIVATE :: ISATADJ + +! CLOUD MICROPHYSICS CONSTANTS + + REAL, PRIVATE :: AI,AC,AS,AR,AG ! 'A' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP + REAL, PRIVATE :: BI,BC,BS,BR,BG ! 'B' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP + REAL, PRIVATE :: R ! GAS CONSTANT FOR AIR +!bloss REAL, PRIVATE :: RV ! GAS CONSTANT FOR WATER VAPOR +!bloss REAL, PRIVATE :: CP ! SPECIFIC HEAT AT CONSTANT PRESSURE FOR DRY AIR + REAL, PRIVATE :: RHOSU ! STANDARD AIR DENSITY AT 850 MB + REAL, PRIVATE :: RHOW ! DENSITY OF LIQUID WATER + REAL, PRIVATE :: RHOI ! BULK DENSITY OF CLOUD ICE + REAL, PRIVATE :: RHOSN ! BULK DENSITY OF SNOW + REAL, PRIVATE :: RHOG ! BULK DENSITY OF GRAUPEL + REAL, PRIVATE :: AIMM ! PARAMETER IN BIGG IMMERSION FREEZING + REAL, PRIVATE :: BIMM ! PARAMETER IN BIGG IMMERSION FREEZING + REAL, PRIVATE :: ECR ! COLLECTION EFFICIENCY BETWEEN DROPLETS/RAIN AND SNOW/RAIN + REAL, PRIVATE :: DCS ! THRESHOLD SIZE FOR CLOUD ICE AUTOCONVERSION + REAL, PRIVATE :: MI0 ! INITIAL SIZE OF NUCLEATED CRYSTAL + REAL, PRIVATE :: MG0 ! MASS OF EMBRYO GRAUPEL + REAL, PRIVATE :: F1S ! VENTILATION PARAMETER FOR SNOW + REAL, PRIVATE :: F2S ! VENTILATION PARAMETER FOR SNOW + REAL, PRIVATE :: F1R ! VENTILATION PARAMETER FOR RAIN + REAL, PRIVATE :: F2R ! VENTILATION PARAMETER FOR RAIN + REAL, PRIVATE :: G ! GRAVITATIONAL ACCELERATION + REAL, PRIVATE :: QSMALL ! SMALLEST ALLOWED HYDROMETEOR MIXING RATIO + REAL, PRIVATE :: CI,DI,CS,DS,CG,DG ! SIZE DISTRIBUTION PARAMETERS FOR CLOUD ICE, SNOW, GRAUPEL + REAL, PRIVATE :: EII ! COLLECTION EFFICIENCY, ICE-ICE COLLISIONS + REAL, PRIVATE :: ECI ! COLLECTION EFFICIENCY, ICE-DROPLET COLLISIONS + REAL, PRIVATE :: RIN ! RADIUS OF CONTACT NUCLEI (M) +! V1.6 + REAL, PRIVATE :: TMELT ! melting temp (K) +! hm, add for V2.1 + REAL, PRIVATE :: CPW ! SPECIFIC HEAT OF LIQUID WATER + +! CCN SPECTRA FOR IACT = 1 + + REAL, PRIVATE :: C1 ! 'C' IN NCCN = CS^K (CM-3) + REAL, PRIVATE :: K1 ! 'K' IN NCCN = CS^K + +! AEROSOL PARAMETERS FOR IACT = 2 + + REAL, PRIVATE :: MW ! MOLECULAR WEIGHT WATER (KG/MOL) + REAL, PRIVATE :: OSM ! OSMOTIC COEFFICIENT + REAL, PRIVATE :: VI ! NUMBER OF ION DISSOCIATED IN SOLUTION + REAL, PRIVATE :: EPSM ! AEROSOL SOLUBLE FRACTION + REAL, PRIVATE :: RHOA ! AEROSOL BULK DENSITY (KG/M3) + REAL, PRIVATE :: MAP ! MOLECULAR WEIGHT AEROSOL (KG/MOL) + REAL, PRIVATE :: MA ! MOLECULAR WEIGHT OF 'AIR' (KG/MOL) + REAL, PRIVATE :: RR ! UNIVERSAL GAS CONSTANT + REAL, PRIVATE :: BACT ! ACTIVATION PARAMETER + REAL, PRIVATE :: RM1 ! GEOMETRIC MEAN RADIUS, MODE 1 (M) + REAL, PRIVATE :: RM2 ! GEOMETRIC MEAN RADIUS, MODE 2 (M) + REAL, PRIVATE :: NANEW1 ! TOTAL AEROSOL CONCENTRATION, MODE 1 (M^-3) + REAL, PRIVATE :: NANEW2 ! TOTAL AEROSOL CONCENTRATION, MODE 2 (M^-3) + REAL, PRIVATE :: SIG1 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 1 + REAL, PRIVATE :: SIG2 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 2 + REAL, PRIVATE :: F11 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1 + REAL, PRIVATE :: F12 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1 + REAL, PRIVATE :: F21 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2 + REAL, PRIVATE :: F22 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2 + REAL, PRIVATE :: MMULT ! MASS OF SPLINTERED ICE PARTICLE + REAL, PRIVATE :: LAMMAXI,LAMMINI,LAMMAXR,LAMMINR,LAMMAXS,LAMMINS,LAMMAXG,LAMMING + +! CONSTANTS TO IMPROVE EFFICIENCY + + REAL, PRIVATE :: CONS1,CONS2,CONS3,CONS4,CONS5,CONS6,CONS7,CONS8,CONS9,CONS10 + REAL, PRIVATE :: CONS11,CONS12,CONS13,CONS14,CONS15,CONS16,CONS17,CONS18,CONS19,CONS20 + REAL, PRIVATE :: CONS21,CONS22,CONS23,CONS24,CONS25,CONS26,CONS27,CONS28,CONS29,CONS30 + REAL, PRIVATE :: CONS31,CONS32,CONS33,CONS34,CONS35,CONS36,CONS37,CONS38,CONS39,CONS40 + REAL, PRIVATE :: CONS41 + +! v1.4 + REAL, PRIVATE :: dnu(16) + +!..Various radar related variables, from GT + +!..Lookup table dimensions + INTEGER, PARAMETER, PRIVATE:: nbins = 100 + INTEGER, PARAMETER, PRIVATE:: nbr = nbins + INTEGER, PARAMETER, PRIVATE:: nbs = nbins + INTEGER, PARAMETER, PRIVATE:: nbg = nbins + REAL(kind=selected_real_kind(12)), DIMENSION(nbins+1):: ddx + REAL(kind=selected_real_kind(12)), DIMENSION(nbr):: Dr, dtr + REAL(kind=selected_real_kind(12)), DIMENSION(nbs):: Dds, dts + REAL(kind=selected_real_kind(12)), DIMENSION(nbg):: Ddg, dtg + REAL(kind=selected_real_kind(12)), PARAMETER, PRIVATE:: lamda_radar = 0.10 ! in meters + REAL(kind=selected_real_kind(12)), PRIVATE:: K_w, PI5, lamda4 + COMPLEX*16, PRIVATE:: m_w_0, m_i_0 + REAL(kind=selected_real_kind(12)), DIMENSION(nbins+1), PRIVATE:: simpson + REAL(kind=selected_real_kind(12)), DIMENSION(3), PARAMETER, PRIVATE:: basis = & + (/1.d0/3.d0, 4.d0/3.d0, 1.d0/3.d0/) + + INTEGER, PARAMETER, PRIVATE:: slen = 20 + CHARACTER(len=slen), PRIVATE:: & + mixingrulestring_s, matrixstring_s, inclusionstring_s, & + hoststring_s, hostmatrixstring_s, hostinclusionstring_s, & + mixingrulestring_g, matrixstring_g, inclusionstring_g, & + hoststring_g, hostmatrixstring_g, hostinclusionstring_g + + REAL, PARAMETER, PRIVATE:: D0r = 50.E-6 + REAL, PARAMETER, PRIVATE:: D0s = 100.E-6 + REAL, PARAMETER, PRIVATE:: D0g = 100.E-6 + CHARACTER*256:: mp_debug +#ifdef CLUBB_CRM + REAL, PARAMETER, PUBLIC :: cloud_frac_thresh = 0.005 +#endif /* CLUBB_CRM */ + +CONTAINS + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +SUBROUTINE GRAUPEL_INIT +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! THIS SUBROUTINE INITIALIZES ALL PHYSICAL CONSTANTS AMND PARAMETERS +! NEEDED BY THE MICROPHYSICS SCHEME. +! NEEDS TO BE CALLED AT FIRST TIME STEP, PRIOR TO CALL TO MAIN MICROPHYSICS INTERFACE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + IMPLICIT NONE + + integer n,i + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! THE FOLLOWING PARAMETERS ARE USER-DEFINED SWITCHES AND NEED TO BE +! SET PRIOR TO CODE COMPILATION + +! INUM = 0, PREDICT DROPLET CONCENTRATION +! INUM = 1, ASSUME CONSTANT DROPLET CONCENTRATION + + INUM = 1 !bloss: use flag in prm file + if(dopredictNc) then + INUM = 0 + end if + +! FOR INUM = 1, SET CONSTANT DROPLET CONCENTRATION (UNITS OF CM-3) + + NDCNST = Nc0 !bloss: use value from prm file (default=100.) + +! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K +! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) +#if (defined CRM && defined MODAL_AERO) +! IACT = 3, USE MULTIMODE AEROSOL SIZE DIST to DERIVER CCN SPECTRA +#endif + + if( aerosol_mode == 2 ) then !bloss: specify using flag from prm file +#if (defined CRM && defined MODAL_AERO) + if(domodal_aero) then + IACT = 3 + else +#endif + IACT = 2 +#if (defined CRM && defined MODAL_AERO) + endif +#endif + else if( aerosol_mode == 1 ) then + IACT = 1 + else + IACT = 0 + end if + +! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO +! UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE +! AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING +! NON-EQULIBRIUM SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, +! IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION +! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO +! UNRESOLVED ENTRAINMENT AND MIXING DOMINATES, +! ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM +! SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, BASED ON THE +! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY +! AT THE GRID POINT + +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) + + if(docloudedgeactivation) then + IBASE = 2 + else + IBASE = 1 + end if + +! INCLUDE SUB-GRID VERTICAL VELOCITY IN DROPLET ACTIVATION +! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION) +! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W + +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) + + if(dosubgridw) then + ISUB = 0 + else + ISUB = 1 + end if + +! SWITCH FOR LIQUID-ONLY RUN +! ILIQ = 0, INCLUDE ICE +! ILIQ = 1, LIQUID ONLY, NO ICE + + if(doicemicro) then !bloss: specify using flag from prm file + ILIQ = 0 + else + ILIQ = 1 + end if + +! SWITCH FOR ICE NUCLEATION +! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE) +! = 1, USE MPACE OBSERVATIONS (ARCTIC ONLY) + + if(doarcticicenucl) then !bloss: specify using flag from prm file + INUC = 1 + else + INUC = 0 + end if + +! SWITCH FOR GRAUPEL/NO GRAUPEL +! IGRAUP = 0, INCLUDE GRAUPEL +! IGRAUP = 1, NO GRAUPEL + + if(dograupel) then + IGRAUP = 0 + else + IGRAUP = 1 + end if + +! HM ADDED 11/7/07, V1.3 +! SWITCH FOR HAIL/GRAUPEL +! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL +! IHAIL = 1, DENSE PRECIPITATING ICE IS HAIL + + if(dohail) then + IHAIL = 1 + else + IHAIL = 0 + end if + +! HM ADDED 8/1/08, v1.4 +! SWITCH FOR WARM RAIN SCHEME +! IRAIN = 0, WARM RAIN (AUTO, ACC, SELF-COLL) FROM KHAIROUTIDNOV AND KOGAN (2000) +! IRAIN = 1, WARM RAIN (AUTO, ACC, SELF-COLL) FROM SEIFERT AND BEHENG (2001) + + if(dosb_warm_rain) then + IRAIN = 1 + else + IRAIN = 0 + end if + +! PB ADDED 4/13/09. TURN OFF SATURATION ADJUSTMENT WITHIN M2005MICRO_GRAUPEL +! IN TOTAL WATER VERSION. IT NOW TAKES PLACE BEFORE M2005MICRO_GRAUPEL IS CALLED. + +#ifdef CLUBB_CRM +! ISATADJ = 0 ! Enable for CLUBB + ISATADJ = 1 ! When CLUBB is called, saturation adjustment is done in CLUBB, + ! so should we set ISATADJ=1 here? test by Minghuai Wang +++mhwang +#else + ISATADJ = 1 +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! SET PHYSICAL CONSTANTS + +! FALLSPEED PARAMETERS (V=AD^B) + AI = 700. + AC = 3.E7 + AS = 11.72 + AR = 841.99667 + BI = 1. + BC = 2. + BS = 0.41 + BR = 0.8 +! V1.3 + IF (IHAIL.EQ.0) THEN + AG = 19.3 + BG = 0.37 + ELSE ! (MATSUN AND HUGGINS 1980) + AG = 114.5 + BG = 0.5 + END IF + +#ifdef CLUBB_CRM + ! Use CLUBB values for constants + R = Rd + RHOW = rho_lw + TMELT = T_freeze_K + RHOSU = 85000./(R*TMELT) +#else +! CONSTANTS AND PARAMETERS + !bloss: use values from params module + R = rgas +!bloss R = 287.15 +!bloss RV = 465.5 +!bloss CP = 1005. +! V1.6 + TMELT = 273.15 +#endif +! V1.6 + RHOSU = 85000./(R*TMELT) + RHOW = 997. + RHOI = 500. + RHOSN = 100. +! V1.3 + IF (IHAIL.EQ.0) THEN + RHOG = 400. + ELSE + RHOG = 900. + END IF + AIMM = 0.66 + BIMM = 100. + ECR = 1. + DCS = 125.E-6 + MI0 = 4./3.*PI*RHOI*(10.E-6)**3 + MG0 = 1.6E-10 + F1S = 0.86 + F2S = 0.28 + F1R = 0.78 +! V3 5/27/11 +! F2R = 0.32 +! AA revision 4/1/11 + F2R = 0.308 + +#ifdef CLUBB_CRM + G = grav + ! Should this be set to SAM's ggr if CLUBB is not defined? +#else + G = 9.806 +#endif + QSMALL = 1.E-14 + EII = 0.1 + ECI = 0.7 +! HM, ADD FOR V3.2 + CPW = 4218. + +! SIZE DISTRIBUTION PARAMETERS + + CI = RHOI*PI/6. + DI = 3. + CS = RHOSN*PI/6. + DS = 3. + CG = RHOG*PI/6. + DG = 3. + +! RADIUS OF CONTACT NUCLEI + RIN = 0.1E-6 + + MMULT = 4./3.*PI*RHOI*(5.E-6)**3 + +! SIZE LIMITS FOR LAMBDA + + LAMMAXI = 1./1.E-6 + LAMMINI = 1./(2.*DCS+100.E-6) + LAMMAXR = 1./20.E-6 +! LAMMINR = 1./500.E-6 + LAMMINR = 1./2800.E-6 + LAMMAXS = 1./10.E-6 + LAMMINS = 1./2000.E-6 + LAMMAXG = 1./20.E-6 + LAMMING = 1./2000.E-6 + +! CCN SPECTRA FOR IACT = 1 + +! MARITIME +! MODIFIED FROM RASMUSSEN ET AL. 2002 +! NCCN = C*S^K, NCCN IS IN CM-3, S IS SUPERSATURATION RATIO IN % + + K1 = ccnexpnt !bloss: specify using values from prm file + C1 = ccnconst !bloss + +!bloss K1 = 0.4 +!bloss C1 = 120. + +! CONTINENTAL + +! K1 = 0.5 +! C1 = 1000. + +! AEROSOL ACTIVATION PARAMETERS FOR IACT = 2 +! PARAMETERS CURRENTLY SET FOR AMMONIUM SULFATE + + MW = 0.018 + OSM = 1. + VI = 3. + EPSM = 0.7 + RHOA = 1777. + MAP = 0.132 + MA = 0.0284 + RR = 8.3187 + BACT = VI*OSM*EPSM*MW*RHOA/(MAP*RHOW) + +! AEROSOL SIZE DISTRIBUTION PARAMETERS CURRENTLY SET FOR MPACE +! (see morrison et al. 2007, JGR) +! MODE 1 + + RM1 = aer_rm1 !bloss: specify using values from prm file + SIG1 = aer_sig1 + NANEW1 = aer_n1 +!bloss RM1 = 0.052E-6 +!bloss SIG1 = 2.04 +!bloss NANEW1 = 100.0E6 + F11 = 0.5*EXP(2.5*(LOG(SIG1))**2) + F21 = 1.+0.25*LOG(SIG1) + +! MODE 2 + + RM2 = aer_rm2 !bloss: specify using values from prm file + SIG2 = aer_sig2 + NANEW2 = aer_n2 +!bloss RM2 = 1.3E-6 +!bloss SIG2 = 2.5 +!bloss NANEW2 = 1.E6 + F12 = 0.5*EXP(2.5*(LOG(SIG2))**2) + F22 = 1.+0.25*LOG(SIG2) + +! CONSTANTS FOR EFFICIENCY + + CONS1=GAMMA(1.+DS)*CS + CONS2=GAMMA(1.+DG)*CG + CONS3=GAMMA(4.+BS)/6. + CONS4=GAMMA(4.+BR)/6. + CONS5=GAMMA(1.+BS) + CONS6=GAMMA(1.+BR) + CONS7=GAMMA(4.+BG)/6. + CONS8=GAMMA(1.+BG) + CONS9=GAMMA(5./2.+BR/2.) + CONS10=GAMMA(5./2.+BS/2.) + CONS11=GAMMA(5./2.+BG/2.) + CONS12=GAMMA(1.+DI)*CI + CONS13=GAMMA(BS+3.)*PI/4.*ECI + CONS14=GAMMA(BG+3.)*PI/4.*ECI + CONS15=-1108.*EII*PI**((1.-BS)/3.)*RHOSN**((-2.-BS)/3.)/(4.*720.) + CONS16=GAMMA(BI+3.)*PI/4.*ECI + CONS17=4.*2.*3.*RHOSU*PI*ECI*ECI*GAMMA(2.*BS+2.)/(8.*(RHOG-RHOSN)) + CONS18=RHOSN*RHOSN + CONS19=RHOW*RHOW + CONS20=20.*PI*PI*RHOW*BIMM + CONS21=4./(DCS*RHOI) + CONS22=PI*RHOI*DCS**3/6. + CONS23=PI/4.*EII*GAMMA(BS+3.) + CONS24=PI/4.*ECR*GAMMA(BR+3.) + CONS25=PI*PI/24.*RHOW*ECR*GAMMA(BR+6.) + CONS26=PI/6.*RHOW + CONS27=GAMMA(1.+BI) + CONS28=GAMMA(4.+BI)/6. + CONS29=4./3.*PI*RHOW*(25.E-6)**3 + CONS30=4./3.*PI*RHOW + CONS31=PI*PI*ECR*RHOSN + CONS32=PI/2.*ECR + CONS33=PI*PI*ECR*RHOG + CONS34=5./2.+BR/2. + CONS35=5./2.+BS/2. + CONS36=5./2.+BG/2. + CONS37=4.*PI*1.38E-23/(6.*PI*RIN) + CONS38=PI*PI/3.*RHOW + CONS39=PI*PI/36.*RHOW*BIMM + CONS40=PI/6.*BIMM + CONS41=PI*PI*ECR*RHOW + +! v1.4 + dnu(1) = -0.557 + dnu(2) = -0.557 + dnu(3) = -0.430 + dnu(4) = -0.307 + dnu(5) = -0.186 + dnu(6) = -0.067 + dnu(7) = 0.050 + dnu(8) = 0.167 + dnu(9) = 0.282 + dnu(10) = 0.397 + dnu(11) = 0.512 + dnu(12) = 0.626 + dnu(13) = 0.739 + dnu(14) = 0.853 + dnu(15) = 0.966 + dnu(16) = 0.966 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! variables for radar reflecitivity calculations +!..Create bins of rain (from min diameter up to 5 mm). + ddx(1) = D0r*1.0d0 + ddx(nbr+1) = 0.005d0 + do n = 2, nbr + ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbr,kind=kind(0d0)) & + *DLOG(ddx(nbr+1)/ddx(1)) +DLOG(ddx(1))) + enddo + do n = 1, nbr + Dr(n) = DSQRT(ddx(n)*ddx(n+1)) + dtr(n) = ddx(n+1) - ddx(n) + enddo + +!..Create bins of snow (from min diameter up to 2 cm). + Ddx(1) = D0s*1.0d0 + Ddx(nbs+1) = 0.02d0 + do n = 2, nbs + Ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbs,kind=kind(0d0)) & + *DLOG(Ddx(nbs+1)/Ddx(1)) +DLOG(Ddx(1))) + enddo + do n = 1, nbs + Dds(n) = DSQRT(Ddx(n)*Ddx(n+1)) + dts(n) = Ddx(n+1) - Ddx(n) + enddo + +!..Create bins of graupel (from min diameter up to 5 cm). + Ddx(1) = D0g*1.0d0 + Ddx(nbg+1) = 0.05d0 + do n = 2, nbg + Ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbg,kind=kind(0d0)) & + *DLOG(Ddx(nbg+1)/Ddx(1)) +DLOG(Ddx(1))) + enddo + do n = 1, nbg + Ddg(n) = DSQRT(Ddx(n)*Ddx(n+1)) + dtg(n) = Ddx(n+1) - Ddx(n) + enddo + + do i = 1, 256 + mp_debug(i:i) = char(0) + enddo + + call radar_init +#ifndef CLUBB_CRM +! WRITE(0,*) "WARNING: This version of the Morrison microphysics ", & +! "incorporates changes from WRF V3.3 not found in standard SAM." +! STOP "Comment out this stop if you want to run this code anyway." +#endif /* not CLUBB_CRM */ + +END SUBROUTINE GRAUPEL_INIT + +!interface copied from new thompson interface +!and added NC, NS, NR, and NG variables. + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! THIS SUBROUTINE IS MAIN INTERFACE WITH THE TWO-MOMENT MICROPHYSICS SCHEME +! THIS INTERFACE TAKES IN 3D VARIABLES FROM DRIVER MODEL, CONVERTS TO 1D FOR +! CALL TO THE MAIN MICROPHYSICS SUBROUTINE (SUBROUTINE M2005MICRO_GRAUPEL) +! WHICH OPERATES ON 1D VERTICAL COLUMNS. +! 1D VARIABLES FROM THE MAIN MICROPHYSICS SUBROUTINE ARE THEN REASSIGNED BACK TO 3D FOR OUTPUT +! BACK TO DRIVER MODEL USING THIS INTERFACE + +! ******IMPORTANT****** +! THIS CODE ASSUMES THE DRIVER MODEL USES PROCESS-SPLITTING FOR SOLVING THE TIME-DEPENDENT EQS. +! THUS, MODEL VARIABLES ARE UPDATED WITH MICROPHYSICS TENDENCIES INSIDE OF THE MICROPHYSICS +! SCHEME. THESE UPDATED VARIABLES ARE PASSED BACK TO DRIVER MODEL. THIS IS WHY THERE +! ARE NO TENDENCIES PASSED BACK AND FORTH BETWEEN DRIVER AND THE INTERFACE SUBROUTINE + +! AN EXCEPTION IS THE TURBULENT MIXING TENDENCIES FOR DROPLET AND CLOUD ICE NUMBER CONCENTRATIONS +! (NCTEND, NITEND BELOW). FOR APPLICATION IN MODELS OTHER THAN WRF, TURBULENT MIXING TENDENCIES +! CAN BE ADDED TO THE VARIABLES ELSEWHERE (IN DRIVER OR PBL ROUTINE), AND THEN DON'T +! NEED TO BE PASSED INTO THE SUBROUTINE HERE..... + +! FOR QUESTIONS, CONTACT: HUGH MORRISON, E-MAIL: MORRISON@UCAR.EDU, PHONE:303-497-8916 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SUBROUTINE MP_GRAUPEL(ITIMESTEP, & + TH, QV, QC, QR, QI, QS, QG, NI, NC, NS, NR, NG, TKE, NCTEND, & + NITEND,KZH, & + RHO, PII, P, DT_IN, DZ, HT, W, & + RAINNC, RAINNCV, SR & + ,EFFCS,EFFIS & ! HM ADD 4/13/07 + ,refl_10cm & ! GT +!bloss ,grid_clock & ! GT +!bloss ,grid_alarms & ! GT + ,IDS,IDE, JDS,JDE, KDS,KDE & ! domain dims + ,IMS,IME, JMS,JME, KMS,KME & ! memory dims + ,ITS,ITE, JTS,JTE, KTS,KTE & ! tile dims ) + ) + +! QV - water vapor mixing ratio (kg/kg) +! QC - cloud water mixing ratio (kg/kg) +! QR - rain water mixing ratio (kg/kg) +! QI - cloud ice mixing ratio (kg/kg) +! QS - snow mixing ratio (kg/kg) +! QG - graupel mixing ratio (KG/KG) +! NI - cloud ice number concentration (1/kg) +! NC - Droplet Number concentration (1/kg) +! NS - Snow Number concentration (1/kg) +! NR - Rain Number concentration (1/kg) +! NG - Graupel number concentration (1/kg) +! NOTE: RHO AND HT NOT USED BY THIS SCHEME AND DO NOT NEED TO BE PASSED INTO SCHEME!!!! +! P - AIR PRESSURE (PA) +! W - VERTICAL AIR VELOCITY (M/S) +! TH - POTENTIAL TEMPERATURE (K) +! PII - exner function - used to convert potential temp to temp +! DZ - difference in height over interface (m) +! DT_IN - model time step (sec) +! ITIMESTEP - time step counter +! RAINNC - accumulated grid-scale precipitation (mm) +! RAINNCV - one time step grid scale precipitation (mm/time step) +! SR - one time step mass ratio of snow to total precip +! TKE - turbulence kinetic energy (m^2 s-2), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW) +! NCTEND - droplet concentration tendency from pbl (kg-1 s-1) +! NCTEND - CLOUD ICE concentration tendency from pbl (kg-1 s-1) +! KZH - heat eddy diffusion coefficient from YSU scheme (M^2 S-1), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW) +! EFFCS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron) +! EFFIS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron) +! REFL_10CM - CALCULATED RADAR REFLECTIVITY AT 10 CM (DBZ) +!................................ +! GRID_CLOCK, GRID_ALARMS - parameters to limit radar reflectivity calculation only when needed +! otherwise radar reflectivity calculation every time step is too slow +! only needed for coupling with WRF, see code below for details + +! EFFC - DROPLET EFFECTIVE RADIUS (MICRON) +! EFFR - RAIN EFFECTIVE RADIUS (MICRON) +! EFFS - SNOW EFFECTIVE RADIUS (MICRON) +! EFFI - CLOUD ICE EFFECTIVE RADIUS (MICRON) + +! ADDITIONAL OUTPUT FROM MICRO - SEDIMENTATION TENDENCIES, NEEDED FOR LIQUID-ICE STATIC ENERGY + +! QGSTEN - GRAUPEL SEDIMENTATION TEND (KG/KG/S) +! QRSTEN - RAIN SEDIMENTATION TEND (KG/KG/S) +! QISTEN - CLOUD ICE SEDIMENTATION TEND (KG/KG/S) +! QNISTEN - SNOW SEDIMENTATION TEND (KG/KG/S) +! QCSTEN - CLOUD WATER SEDIMENTATION TEND (KG/KG/S) + +! ADDITIONAL INPUT NEEDED BY MICRO +! ********NOTE: WVAR IS SHOULD BE USED IN DROPLET ACTIVATION +! FOR CASES WHEN UPDRAFT IS NOT RESOLVED, EITHER BECAUSE OF +! LOW MODEL RESOLUTION OR CLOUD TYPE + +! WVAR - STANDARD DEVIATION OF SUB-GRID VERTICAL VELOCITY (M/S) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: ids, ide, jds, jde, kds, kde , & + ims, ime, jms, jme, kms, kme , & + its, ite, jts, jte, kts, kte +! Temporary changed from INOUT to IN + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & + qv, qc, qr, qi, qs, qg, ni, nc, ns, nr, TH, NG, effcs, effis + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: & + pii, p, dz, rho, w, tke, nctend, nitend,kzh + REAL, INTENT(IN):: dt_in + INTEGER, INTENT(IN):: ITIMESTEP + + REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & + RAINNC, RAINNCV, SR + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & ! GT + refl_10cm + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: ht + +!bloss TYPE (WRFU_Clock):: grid_clock ! GT +!bloss TYPE (WRFU_Alarm), POINTER:: grid_alarms(:) ! GT + + ! LOCAL VARIABLES + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme):: & + effi, effs, effr, EFFG + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme):: & + T, WVAR, EFFC + + REAL, DIMENSION(kts:kte) :: & + QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D, NC_TEND1D, & + NI_TEND1D, NS_TEND1D, NR_TEND1D, & + QC1D, QI1D, QR1D, NC1D,NI1D, NS1D, NR1D, QS1D, & + T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, RHO1D, W1D, WVAR1D, & + EFFC1D, EFFI1D, EFFS1D, EFFR1D,DZ1D, & + ! HM ADD GRAUPEL + QG_TEND1D, NG_TEND1D, QG1D, NG1D, EFFG1D, & + +! ADD SEDIMENTATION TENDENCIES (UNITS OF KG/KG/S) + QGSTEN,QRSTEN, QISTEN, QNISTEN, QCSTEN, & + +! HM add reflectivity + dbz + + REAL PRECPRT1D, SNOWRT1D + + INTEGER I,K,J + + REAL DT + LOGICAL:: dBZ_tstep ! GT + +! set dbz logical based on grid_clock +!+---+ +! only calculate reflectivity when it is needed for output +! in this instance, logical dbz_tstep is set to .true. +! *******NOTE: FOR COUPLING WITH DRIVER MODEL OTHER THAN WRF, +! THIS BLOCK OF CODE WILL NEED TO BE MODIFIED TO CORRECTLY +! SET WHEN REFLECTIVIITY CALCULATION IS MADE + + dBZ_tstep = .false. +!bloss if ( Is_alarm_tstep(grid_clock, grid_alarms(HISTORY_ALARM)) ) then +!bloss dBZ_tstep = .true. +!bloss endif + + ! Initialize tendencies (all set to 0) and transfer + ! array to local variables + DT = DT_IN + do I=ITS,ITE + do J=JTS,JTE + DO K=KTS,KTE + T(I,K,J) = TH(i,k,j)*PII(i,k,j) + +! wvar is the ST. DEV. OF sub-grid vertical velocity, used for calculating droplet +! activation rates. +! WVAR BE DERIVED EITHER FROM PREDICTED TKE (AS IN MYJ PBL SCHEME), +! OR FROM EDDY DIFFUSION COEFFICIENT KZH (AS IN YSU PBL SCHEME), +! DEPENDING ON THE PARTICULAR pbl SCHEME DRIVER MODEL IS COUPLED WITH +! NOTE: IF MODEL HAS HIGH ENOUGH RESOLUTION TO RESOLVE UPDRAFTS, WVAR IS +! PROBABLY NOT NEEDED + +! for MYJ pbl scheme: +! WVAR(I,K,J) = (0.667*tke(i,k,j))**0.5 +! for YSU pbl scheme: + WVAR(I,K,J) = KZH(I,K,J)/20. + WVAR(I,K,J) = MAX(0.1,WVAR(I,K,J)) + WVAR(I,K,J) = MIN(4.,WVAR(I,K,J)) + +! add tendency from pbl to droplet and cloud ice concentration +! NEEDED FOR WRF TEMPORARILY!!!! +! OTHER DRIVER MODELS MAY ADD TURBULENT DIFFUSION TENDENCY FOR +! SCALARS SOMEWHERE ELSE IN THE MODEL (I.E, NOT IN THE MICROPHYSICS) +! IN THIS CASE THESE 2 LINES BELOW MAY BE REMOVED + nc(i,k,j) = nc(i,k,j)+nctend(i,k,j)*dt + ni(i,k,j) = ni(i,k,j)+nitend(i,k,j)*dt + END DO + END DO + END DO + + do i=its,ite ! i loop (east-west) + do j=jts,jte ! j loop (north-south) + ! + ! Transfer 3D arrays into 1D for microphysical calculations + ! + +! hm , initialize 1d tendency arrays to zero + + do k=kts,kte ! k loop (vertical) + + QC_TEND1D(k) = 0. + QI_TEND1D(k) = 0. + QNI_TEND1D(k) = 0. + QR_TEND1D(k) = 0. + NC_TEND1D(k) = 0. + NI_TEND1D(k) = 0. + NS_TEND1D(k) = 0. + NR_TEND1D(k) = 0. + T_TEND1D(k) = 0. + QV_TEND1D(k) = 0. + + QC1D(k) = QC(i,k,j) + QI1D(k) = QI(i,k,j) + QS1D(k) = QS(i,k,j) + QR1D(k) = QR(i,k,j) + + NC1D(k) = NC(i,k,j) + NI1D(k) = NI(i,k,j) + + NS1D(k) = NS(i,k,j) + NR1D(k) = NR(i,k,j) +! HM ADD GRAUPEL + QG1D(K) = QG(I,K,j) + NG1D(K) = NG(I,K,j) + QG_TEND1D(K) = 0. + NG_TEND1D(K) = 0. + + T1D(k) = T(i,k,j) + QV1D(k) = QV(i,k,j) + P1D(k) = P(i,k,j) + RHO1D(k) = P1D(K)/(R*T1D(K)) + DZ1D(k) = DZ(i,k,j) + W1D(k) = W(i,k,j) + WVAR1D(k) = WVAR(i,k,j) + end do + + !bloss: add extra argument for rho for consistency with below subroutine. + ! done by repeating p1z. + ! diable routine to make sure it is not used. + STOP 'in mp_graupel wrapper routine. Only use m2005micro_graupel()' + +#ifndef CLUBB_CRM +! call m2005micro_graupel(QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D, NC_TEND1D, & +! NI_TEND1D, NS_TEND1D, NR_TEND1D, & +! QC1D, QI1D, QS1D, QR1D, NC1D,NI1D, NS1D, NR1D, & +! T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, RHO1D, DZ1D, W1D, WVAR1D, & +! PRECPRT1D,SNOWRT1D, & +! EFFC1D,EFFI1D,EFFS1D,EFFR1D,DT, & +! IMS,IME, JMS,JME, KMS,KME, & +! ITS,ITE, JTS,JTE, KTS,KTE, & ! HM ADD GRAUPEL +! QG_TEND1D,NG_TEND1D,QG1D,NG1D,EFFG1D, & +! ADD SEDIMENTATION TENDENCIES +! QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN) +#endif /*CLUBB_CRM*/ + ! + ! Transfer 1D arrays back into 3D arrays + ! + do k=kts,kte + +! hm, add tendencies to update global variables +! HM, TENDENCIES FOR Q AND N NOW ADDED IN M2005MICRO, SO WE +! ONLY NEED TO TRANSFER 1D VARIABLES BACK TO 3D + + QC(i,k,j) = QC1D(k) + QI(i,k,j) = QI1D(k) + QS(i,k,j) = QS1D(k) + QR(i,k,j) = QR1D(k) + NC(i,k,j) = NC1D(k) + NI(i,k,j) = NI1D(k) + NS(i,k,j) = NS1D(k) + NR(i,k,j) = NR1D(k) + QG(I,K,j) = QG1D(K) + NG(I,K,j) = NG1D(K) + + T(i,k,j) = T1D(k) + TH(I,K,J) = T(i,k,j)/PII(i,k,j) ! CONVERT TEMP BACK TO POTENTIAL TEMP + QV(i,k,j) = QV1D(k) + + EFFC(i,k,j) = EFFC1D(k) + EFFI(i,k,j) = EFFI1D(k) + EFFS(i,k,j) = EFFS1D(k) + EFFR(i,k,j) = EFFR1D(k) + EFFG(I,K,j) = EFFG1D(K) + +! EFFECTIVE RADIUS FOR RADIATION CODE +! HM, ADD LIMIT TO PREVENT BLOWING UP OPTICAL PROPERTIES, 8/18/07 +! LIMITS ARE FROM THE CAM MODEL APPLIED BY ANDREW GETTELMAN + EFFCS(I,K,J) = MIN(EFFC(I,K,J),16.) + EFFCS(I,K,J) = MAX(EFFCS(I,K,J),4.) + EFFIS(I,K,J) = MIN(EFFI(I,K,J),130.) + EFFIS(I,K,J) = MAX(EFFIS(I,K,J),13.) + + end do + +! hm modified so that m2005 precip variables correctly match wrf precip variables + RAINNC(i,j) = RAINNC(I,J)+PRECPRT1D + RAINNCV(i,j) = PRECPRT1D + SR(i,j) = SNOWRT1D/(PRECPRT1D+1.E-12) + +! add reflectivity calculations +! only calculate if logical parameter dbz_tstep = .true. + + if (dBZ_tstep) then + call calc_refl10cm (qv1d, qr1d, qs1d, qg1d, t1d, p1d, dBZ, & + kts, kte, i, j, nr1d, ns1d, ng1d) + do k = kts, kte + refl_10cm(i,k,j) = dBZ(k) + enddo + endif + + end do + end do + +END SUBROUTINE MP_GRAUPEL + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +#ifdef CLUBB_CRM + SUBROUTINE M2005MICRO_GRAUPEL(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN,NC3DTEN, & + NI3DTEN,NS3DTEN,NR3DTEN,QC3D,QI3D,QNI3D,QR3D,NC3D,NI3D,NS3D,NR3D, & + T3DTEN,QV3DTEN,T3D,QV3D,PRES,RHO,DZQ,W3D,WVAR, & +! hm 7/26/11, new output + acc1d,aut1d,evpc1d,evpr1d,mlt1d,sub1d,dep1d,con1d, & + PRECRT,SNOWRT, & + EFFC,EFFI,EFFS,EFFR,DT, & + IMS,IME, JMS,JME, KMS,KME, & + ITS,ITE, JTS,JTE, KTS,KTE, & ! ADD GRAUPEL + QG3DTEN,NG3DTEN,QG3D,NG3D,EFFG,QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN, & + CF3D, CFL3D, CFI3D, RELVAR, ACCRE_ENHAN & ! Cloud fraction from clubb +#ifdef ECPP + ,C2PREC,QSINK,CSED,ISED,SSED,GSED,RSED, RH3D & ! mhwang added, for ECPP +#endif /*ECPP*/ + ) +#else + SUBROUTINE M2005MICRO_GRAUPEL(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN,NC3DTEN, & + NI3DTEN,NS3DTEN,NR3DTEN,QC3D,QI3D,QNI3D,QR3D,NC3D,NI3D,NS3D,NR3D, & + T3DTEN,QV3DTEN,T3D,QV3D,PRES,RHO,DZQ,W3D,WVAR, & +! hm 7/26/11, new output + acc1d,aut1d,evpc1d,evpr1d,mlt1d,sub1d,dep1d,con1d, & + PRECRT,SNOWRT, & + EFFC,EFFI,EFFS,EFFR,DT, & + IMS,IME, JMS,JME, KMS,KME, & + ITS,ITE, JTS,JTE, KTS,KTE, & ! ADD GRAUPEL + QG3DTEN,NG3DTEN,QG3D,NG3D,EFFG,QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN & +#ifdef ECPP + ,C2PREC,QSINK,CSED,ISED,SSED,GSED,RSED, RH3D & ! mhwang added, for ECPP +#endif /*ECPP*/ + ) +#endif /*CLUBB_CRM*/ +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! THIS PROGRAM IS THE MAIN TWO-MOMENT MICROPHYSICS SUBROUTINE DESCRIBED BY +! MORRISON ET AL. 2005 JAS; MORRISON AND PINTO 2005 JAS. +! ADDITIONAL CHANGE IS ADDITION OF GRAUPEL MICROPHYSICS. +! SCHEME IS DESCRIBED IN DETAIL BY MORRISON ET AL. (MONTHLY WEATHER REVIEW, IN PREP.) + +! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING +! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: +! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. + +! CODE STRUCTURE: MAIN SUBROUTINE IS 'M2005MICRO_GRAUPEL'. ALSO INCLUDED IN THIS FILE IS +! 'FUNCTION POLYSVP', 'FUNCTION DERF1', AND +! 'FUNCTION GAMMA'. + +! NOTE: THIS SUBROUTINE USES 1D ARRAY IN VERTICAL (COLUMN), EVEN THOUGH VARIABLES ARE CALLED '3D'...... + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +! DECLARATIONS + + IMPLICIT NONE + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! THESE VARIABLES BELOW MUST BE LINKED WITH THE MAIN MODEL. +! DEFINE ARRAY SIZES + +! INPUT NUMBER OF GRID CELLS + +! INPUT/OUTPUT PARAMETERS ! DESCRIPTION (UNITS) + INTEGER, INTENT( IN) :: IMS,IME, JMS,JME, KMS,KME, & + ITS,ITE, JTS,JTE, KTS,KTE + + REAL, DIMENSION(KMS:KME) :: QC3DTEN ! CLOUD WATER MIXING RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QI3DTEN ! CLOUD ICE MIXING RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QNI3DTEN ! SNOW MIXING RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QR3DTEN ! RAIN MIXING RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: NC3DTEN ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG/S) + REAL, DIMENSION(KMS:KME) :: NI3DTEN ! CLOUD ICE NUMBER CONCENTRATION (1/KG/S) + REAL, DIMENSION(KMS:KME) :: NS3DTEN ! SNOW NUMBER CONCENTRATION (1/KG/S) + REAL, DIMENSION(KMS:KME) :: NR3DTEN ! RAIN NUMBER CONCENTRATION (1/KG/S) + REAL, DIMENSION(KMS:KME) :: QC3D ! CLOUD WATER MIXING RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: QI3D ! CLOUD ICE MIXING RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: QNI3D ! SNOW MIXING RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: QR3D ! RAIN MIXING RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: NC3D ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG) + REAL, DIMENSION(KMS:KME) :: NI3D ! CLOUD ICE NUMBER CONCENTRATION (1/KG) + REAL, DIMENSION(KMS:KME) :: NS3D ! SNOW NUMBER CONCENTRATION (1/KG) + REAL, DIMENSION(KMS:KME) :: NR3D ! RAIN NUMBER CONCENTRATION (1/KG) + REAL, DIMENSION(KMS:KME) :: T3DTEN ! TEMPERATURE TENDENCY (K/S) + REAL, DIMENSION(KMS:KME) :: QV3DTEN ! WATER VAPOR MIXING RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: T3D ! TEMPERATURE (K) + REAL, DIMENSION(KMS:KME) :: QV3D ! WATER VAPOR MIXING RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: PRES ! ATMOSPHERIC PRESSURE (PA) +!bloss: make rho an input argument + REAL, DIMENSION(KMS:KME), INTENT(IN) :: RHO ! AIR DENSITY + REAL, DIMENSION(KMS:KME) :: DZQ ! DIFFERENCE IN HEIGHT ACROSS LEVEL (m) + REAL, DIMENSION(KMS:KME) :: W3D ! GRID-SCALE VERTICAL VELOCITY (M/S) + REAL, DIMENSION(KMS:KME) :: WVAR ! SUB-GRID VERTICAL VELOCITY (M/S) + +! hm 7/26/11, new output + REAL, DIMENSION(KMS:KME) :: aut1d ! + REAL, DIMENSION(KMS:KME) :: acc1d ! + REAL, DIMENSION(KMS:KME) :: evpc1d ! + REAL, DIMENSION(KMS:KME) :: evpr1d ! + REAL, DIMENSION(KMS:KME) :: mlt1d ! + REAL, DIMENSION(KMS:KME) :: sub1d ! + REAL, DIMENSION(KMS:KME) :: dep1d ! + REAL, DIMENSION(KMS:KME) :: con1d ! + +! HM ADDED GRAUPEL VARIABLES + REAL, DIMENSION(KMS:KME) :: QG3DTEN ! GRAUPEL MIX RATIO TENDENCY (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: NG3DTEN ! GRAUPEL NUMB CONC TENDENCY (1/KG/S) + REAL, DIMENSION(KMS:KME) :: QG3D ! GRAUPEL MIX RATIO (KG/KG) + REAL, DIMENSION(KMS:KME) :: NG3D ! GRAUPEL NUMBER CONC (1/KG) + +! HM, ADD 1/16/07, SEDIMENTATION TENDENCIES FOR MIXING RATIO + + REAL, DIMENSION(KMS:KME) :: QGSTEN ! GRAUPEL SED TEND (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QRSTEN ! RAIN SED TEND (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QISTEN ! CLOUD ICE SED TEND (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QNISTEN ! SNOW SED TEND (KG/KG/S) + REAL, DIMENSION(KMS:KME) :: QCSTEN ! CLOUD WAT SED TEND (KG/KG/S) + + REAL, DIMENSION(KMS:KME) :: NGSTEN ! GRAUPEL SED TEND (#KG/S) + REAL, DIMENSION(KMS:KME) :: NRSTEN ! RAIN SED TEND (#/KG/S) + REAL, DIMENSION(KMS:KME) :: NISTEN ! CLOUD ICE SED TEND (#/KG/S) + REAL, DIMENSION(KMS:KME) :: NSSTEN ! SNOW SED TEND (#/KG/S) + REAL, DIMENSION(KMS:KME) :: NCSTEN ! CLOUD WAT SED TEND (#/KG/S) + +#ifdef CLUBB_CRM +! ADDED BY UWM JAN 7 2008 + REAL, INTENT(IN), DIMENSION(KMS:KME) :: CF3D ! SUBGRID SCALE CLOUD FRACTION + REAL, INTENT(IN), DIMENSION(KMS:KME) :: CFL3D ! SUBGRID SCALE LIQUID CLOUD FRACTION + REAL, INTENT(IN), DIMENSION(KMS:KME) :: CFI3D ! SUBGRID SCALE ICE CLOUD FRACTION (total cloud fraction here) + REAL, INTENT(IN), DIMENSION(KMS:KME) :: RELVAR ! RELATIVE LIQUID WATER VARIANCE + REAL, INTENT(IN), DIMENSION(KMS:KME) :: ACCRE_ENHAN ! ACCRETION ENHANCEMENT FACTOR +#endif +! OUTPUT VARIABLES + + REAL PRECRT ! TOTAL PRECIP PER TIME STEP (mm) + REAL SNOWRT ! SNOW PER TIME STEP (mm) + + REAL, DIMENSION(KMS:KME) :: EFFC ! DROPLET EFFECTIVE RADIUS (MICRON) + REAL, DIMENSION(KMS:KME) :: EFFI ! CLOUD ICE EFFECTIVE RADIUS (MICRON) + REAL, DIMENSION(KMS:KME) :: EFFS ! SNOW EFFECTIVE RADIUS (MICRON) + REAL, DIMENSION(KMS:KME) :: EFFR ! RAIN EFFECTIVE RADIUS (MICRON) + REAL, DIMENSION(KMS:KME) :: EFFG ! GRAUPEL EFFECTIVE RADIUS (MICRON) + +! MODEL INPUT PARAMETERS (FORMERLY IN COMMON BLOCKS) + + REAL DT ! MODEL TIME STEP (SEC) + +#ifdef ECPP + REAL, DIMENSION(KMS:KME) :: C2PREC ! CLOUD WATER SINK rate FROM PRECIPITATION (kg/kg/s) + REAL, DIMENSION(KMS:KME) :: QSINK ! CLOUD WATER SINK rate FROM PRECIPITATION (/s) + REAL, DIMENSION(KMS:KME) :: CSED ! sedimentation flux of cloud water (kg/m2/s) + REAL, DIMENSION(KMS:KME) :: ISED ! sedimentation flux of cloud ice (kg/m2/s) + REAL, DIMENSION(KMS:KME) :: SSED ! sedimentation flux of snow (kg/m2/s) + REAL, DIMENSION(KMS:KME) :: GSED ! sedimentation flux of graupel (kg/m2/s) + REAL, DIMENSION(KMS:KME) :: RSED ! sedimentation flux of rain (kg/m2/s) + REAL, DIMENSION(KMS:KME) :: RH3D ! relative humidity w.r.t water. +#endif /*ECPP*/ + +!..................................................................................................... +! LOCAL VARIABLES: ALL PARAMETERS BELOW ARE LOCAL TO SCHEME AND DON'T NEED TO COMMUNICATE WITH THE +! REST OF THE MODEL. + +! SIZE PARAMETER VARIABLES + + REAL, DIMENSION(KMS:KME) :: LAMC ! SLOPE PARAMETER FOR DROPLETS (M-1) + REAL, DIMENSION(KMS:KME) :: LAMI ! SLOPE PARAMETER FOR CLOUD ICE (M-1) + REAL, DIMENSION(KMS:KME) :: LAMS ! SLOPE PARAMETER FOR SNOW (M-1) + REAL, DIMENSION(KMS:KME) :: LAMR ! SLOPE PARAMETER FOR RAIN (M-1) + REAL, DIMENSION(KMS:KME) :: LAMG ! SLOPE PARAMETER FOR GRAUPEL (M-1) + REAL, DIMENSION(KMS:KME) :: CDIST1 ! PSD PARAMETER FOR DROPLETS + REAL, DIMENSION(KMS:KME) :: N0I ! INTERCEPT PARAMETER FOR CLOUD ICE (KG-1 M-1) + REAL, DIMENSION(KMS:KME) :: N0S ! INTERCEPT PARAMETER FOR SNOW (KG-1 M-1) + REAL, DIMENSION(KMS:KME) :: N0RR ! INTERCEPT PARAMETER FOR RAIN (KG-1 M-1) + REAL, DIMENSION(KMS:KME) :: N0G ! INTERCEPT PARAMETER FOR GRAUPEL (KG-1 M-1) + REAL, DIMENSION(KMS:KME) :: PGAM ! SPECTRAL SHAPE PARAMETER FOR DROPLETS + +! MICROPHYSICAL PROCESSES + + REAL, DIMENSION(KMS:KME) :: NSUBC ! LOSS OF NC DURING EVAP + REAL, DIMENSION(KMS:KME) :: NSUBI ! LOSS OF NI DURING SUB. + REAL, DIMENSION(KMS:KME) :: NSUBS ! LOSS OF NS DURING SUB. + REAL, DIMENSION(KMS:KME) :: NSUBR ! LOSS OF NR DURING EVAP + REAL, DIMENSION(KMS:KME) :: PRD ! DEP CLOUD ICE + REAL, DIMENSION(KMS:KME) :: PRE ! EVAP OF RAIN + REAL, DIMENSION(KMS:KME) :: PRDS ! DEP SNOW + REAL, DIMENSION(KMS:KME) :: NNUCCC ! CHANGE N DUE TO CONTACT FREEZ DROPLETS + REAL, DIMENSION(KMS:KME) :: MNUCCC ! CHANGE Q DUE TO CONTACT FREEZ DROPLETS + REAL, DIMENSION(KMS:KME) :: PRA ! ACCRETION DROPLETS BY RAIN + REAL, DIMENSION(KMS:KME) :: PRC ! AUTOCONVERSION DROPLETS + REAL, DIMENSION(KMS:KME) :: PCC ! COND/EVAP DROPLETS + REAL, DIMENSION(KMS:KME) :: NNUCCD ! CHANGE N FREEZING AEROSOL (PRIM ICE NUCLEATION) + REAL, DIMENSION(KMS:KME) :: MNUCCD ! CHANGE Q FREEZING AEROSOL (PRIM ICE NUCLEATION) + REAL, DIMENSION(KMS:KME) :: MNUCCR ! CHANGE Q DUE TO CONTACT FREEZ RAIN + REAL, DIMENSION(KMS:KME) :: NNUCCR ! CHANGE N DUE TO CONTACT FREEZ RAIN + REAL, DIMENSION(KMS:KME) :: NPRA ! CHANGE IN N DUE TO DROPLET ACC BY RAIN + REAL, DIMENSION(KMS:KME) :: NRAGG ! SELF-COLLECTION OF RAIN + REAL, DIMENSION(KMS:KME) :: NSAGG ! SELF-COLLECTION OF SNOW + REAL, DIMENSION(KMS:KME) :: NPRC ! CHANGE NC AUTOCONVERSION DROPLETS + REAL, DIMENSION(KMS:KME) :: NPRC1 ! CHANGE NR AUTOCONVERSION DROPLETS + REAL, DIMENSION(KMS:KME) :: PRAI ! CHANGE Q ACCRETION CLOUD ICE + REAL, DIMENSION(KMS:KME) :: PRCI ! CHANGE Q AUTOCONVERSION CLOUD ICE BY SNOW + REAL, DIMENSION(KMS:KME) :: PSACWS ! CHANGE Q DROPLET ACCRETION BY SNOW + REAL, DIMENSION(KMS:KME) :: NPSACWS ! CHANGE N DROPLET ACCRETION BY SNOW + REAL, DIMENSION(KMS:KME) :: PSACWI ! CHANGE Q DROPLET ACCRETION BY CLOUD ICE + REAL, DIMENSION(KMS:KME) :: NPSACWI ! CHANGE N DROPLET ACCRETION BY CLOUD ICE + REAL, DIMENSION(KMS:KME) :: NPRCI ! CHANGE N AUTOCONVERSION CLOUD ICE BY SNOW + REAL, DIMENSION(KMS:KME) :: NPRAI ! CHANGE N ACCRETION CLOUD ICE + REAL, DIMENSION(KMS:KME) :: NMULTS ! ICE MULT DUE TO RIMING DROPLETS BY SNOW + REAL, DIMENSION(KMS:KME) :: NMULTR ! ICE MULT DUE TO RIMING RAIN BY SNOW + REAL, DIMENSION(KMS:KME) :: QMULTS ! CHANGE Q DUE TO ICE MULT DROPLETS/SNOW + REAL, DIMENSION(KMS:KME) :: QMULTR ! CHANGE Q DUE TO ICE RAIN/SNOW + REAL, DIMENSION(KMS:KME) :: PRACS ! CHANGE Q RAIN-SNOW COLLECTION + REAL, DIMENSION(KMS:KME) :: NPRACS ! CHANGE N RAIN-SNOW COLLECTION + REAL, DIMENSION(KMS:KME) :: PCCN ! CHANGE Q DROPLET ACTIVATION + REAL, DIMENSION(KMS:KME) :: PSMLT ! CHANGE Q MELTING SNOW TO RAIN + REAL, DIMENSION(KMS:KME) :: EVPMS ! CHNAGE Q MELTING SNOW EVAPORATING + REAL, DIMENSION(KMS:KME) :: NSMLTS ! CHANGE N MELTING SNOW + REAL, DIMENSION(KMS:KME) :: NSMLTR ! CHANGE N MELTING SNOW TO RAIN +! HM ADDED 12/13/06 + REAL, DIMENSION(KMS:KME) :: PIACR ! CHANGE QR, ICE-RAIN COLLECTION + REAL, DIMENSION(KMS:KME) :: NIACR ! CHANGE N, ICE-RAIN COLLECTION + REAL, DIMENSION(KMS:KME) :: PRACI ! CHANGE QI, ICE-RAIN COLLECTION + REAL, DIMENSION(KMS:KME) :: PIACRS ! CHANGE QR, ICE RAIN COLLISION, ADDED TO SNOW + REAL, DIMENSION(KMS:KME) :: NIACRS ! CHANGE N, ICE RAIN COLLISION, ADDED TO SNOW + REAL, DIMENSION(KMS:KME) :: PRACIS ! CHANGE QI, ICE RAIN COLLISION, ADDED TO SNOW + REAL, DIMENSION(KMS:KME) :: EPRD ! SUBLIMATION CLOUD ICE + REAL, DIMENSION(KMS:KME) :: EPRDS ! SUBLIMATION SNOW +! HM ADDED GRAUPEL PROCESSES + REAL, DIMENSION(KMS:KME) :: PRACG ! CHANGE IN Q COLLECTION RAIN BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: PSACWG ! CHANGE IN Q COLLECTION DROPLETS BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: PGSACW ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW + REAL, DIMENSION(KMS:KME) :: PGRACS ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW + REAL, DIMENSION(KMS:KME) :: PRDG ! DEP OF GRAUPEL + REAL, DIMENSION(KMS:KME) :: EPRDG ! SUB OF GRAUPEL + REAL, DIMENSION(KMS:KME) :: EVPMG ! CHANGE Q MELTING OF GRAUPEL AND EVAPORATION + REAL, DIMENSION(KMS:KME) :: PGMLT ! CHANGE Q MELTING OF GRAUPEL + REAL, DIMENSION(KMS:KME) :: NPRACG ! CHANGE N COLLECTION RAIN BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: NPSACWG ! CHANGE N COLLECTION DROPLETS BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: NSCNG ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW + REAL, DIMENSION(KMS:KME) :: NGRACS ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW + REAL, DIMENSION(KMS:KME) :: NGMLTG ! CHANGE N MELTING GRAUPEL + REAL, DIMENSION(KMS:KME) :: NGMLTR ! CHANGE N MELTING GRAUPEL TO RAIN + REAL, DIMENSION(KMS:KME) :: NSUBG ! CHANGE N SUB/DEP OF GRAUPEL + REAL, DIMENSION(KMS:KME) :: PSACR ! CONVERSION DUE TO COLL OF SNOW BY RAIN + REAL, DIMENSION(KMS:KME) :: NMULTG ! ICE MULT DUE TO ACC DROPLETS BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: NMULTRG ! ICE MULT DUE TO ACC RAIN BY GRAUPEL + REAL, DIMENSION(KMS:KME) :: QMULTG ! CHANGE Q DUE TO ICE MULT DROPLETS/GRAUPEL + REAL, DIMENSION(KMS:KME) :: QMULTRG ! CHANGE Q DUE TO ICE MULT RAIN/GRAUPEL + +! TIME-VARYING ATMOSPHERIC PARAMETERS + + REAL, DIMENSION(KMS:KME) :: KAP ! THERMAL CONDUCTIVITY OF AIR + REAL, DIMENSION(KMS:KME) :: EVS ! SATURATION VAPOR PRESSURE + REAL, DIMENSION(KMS:KME) :: EIS ! ICE SATURATION VAPOR PRESSURE + REAL, DIMENSION(KMS:KME) :: QVS ! SATURATION MIXING RATIO + REAL, DIMENSION(KMS:KME) :: QVI ! ICE SATURATION MIXING RATIO + REAL, DIMENSION(KMS:KME) :: QVQVS ! SAUTRATION RATIO + REAL, DIMENSION(KMS:KME) :: QVQVSI! ICE SATURAION RATIO + REAL, DIMENSION(KMS:KME) :: DV ! DIFFUSIVITY OF WATER VAPOR IN AIR + REAL, DIMENSION(KMS:KME) :: XXLS ! LATENT HEAT OF SUBLIMATION + REAL, DIMENSION(KMS:KME) :: XXLV ! LATENT HEAT OF VAPORIZATION + REAL, DIMENSION(KMS:KME) :: CPM ! SPECIFIC HEAT AT CONST PRESSURE FOR MOIST AIR + REAL, DIMENSION(KMS:KME) :: MU ! VISCOCITY OF AIR + REAL, DIMENSION(KMS:KME) :: SC ! SCHMIDT NUMBER + REAL, DIMENSION(KMS:KME) :: XLF ! LATENT HEAT OF FREEZING +!bloss REAL, DIMENSION(KMS:KME) :: RHO ! AIR DENSITY + REAL, DIMENSION(KMS:KME) :: AB ! CORRECTION TO CONDENSATION RATE DUE TO LATENT HEATING + REAL, DIMENSION(KMS:KME) :: ABI ! CORRECTION TO DEPOSITION RATE DUE TO LATENT HEATING + +! TIME-VARYING MICROPHYSICS PARAMETERS + + REAL, DIMENSION(KMS:KME) :: DAP ! DIFFUSIVITY OF AEROSOL + REAL NACNT ! NUMBER OF CONTACT IN + REAL FMULT ! TEMP.-DEP. PARAMETER FOR RIME-SPLINTERING + REAL COFFI ! ICE AUTOCONVERSION PARAMETER + +! FALL SPEED WORKING VARIABLES (DEFINED IN CODE) + + REAL, DIMENSION(KMS:KME) :: DUMI,DUMR,DUMFNI,DUMG,DUMFNG + REAL UNI, UMI,UMR + REAL, DIMENSION(KMS:KME) :: FR, FI, FNI,FG,FNG + REAL RGVM + REAL, DIMENSION(KMS:KME) :: FALOUTR,FALOUTI,FALOUTNI + REAL FALTNDR,FALTNDI,FALTNDNI,RHO2 + REAL, DIMENSION(KMS:KME) :: DUMQS,DUMFNS + REAL UMS,UNS + REAL, DIMENSION(KMS:KME) :: FS,FNS, FALOUTS,FALOUTNS,FALOUTG,FALOUTNG + REAL FALTNDS,FALTNDNS,UNR,FALTNDG,FALTNDNG + REAL, DIMENSION(KMS:KME) :: DUMC,DUMFNC + REAL UNC,UMC,UNG,UMG + REAL, DIMENSION(KMS:KME) :: FC,FALOUTC,FALOUTNC + REAL FALTNDC,FALTNDNC + REAL, DIMENSION(KMS:KME) :: FNC,DUMFNR,FALOUTNR + REAL FALTNDNR + REAL, DIMENSION(KMS:KME) :: FNR + +! FALL-SPEED PARAMETER 'A' WITH AIR DENSITY CORRECTION + + REAL, DIMENSION(KMS:KME) :: AIN,ARN,ASN,ACN,AGN + +! EXTERNAL FUNCTION CALL RETURN VARIABLES + +! REAL GAMMA, ! EULER GAMMA FUNCTION +! REAL POLYSVP, ! SAT. PRESSURE FUNCTION +! REAL DERF1 ! ERROR FUNCTION + +! DUMMY VARIABLES + + REAL DUM,DUM1,DUM2,DUMT,DUMQV,DUMQSS,DUMQSI,DUMS + +! PROGNOSTIC SUPERSATURATION + + REAL DQSDT ! CHANGE OF SAT. MIX. RAT. WITH TEMPERATURE + REAL DQSIDT ! CHANGE IN ICE SAT. MIXING RAT. WITH T + REAL EPSI ! 1/PHASE REL. TIME (SEE M2005), ICE + REAL EPSS ! 1/PHASE REL. TIME (SEE M2005), SNOW + REAL EPSR ! 1/PHASE REL. TIME (SEE M2005), RAIN + REAL EPSG ! 1/PHASE REL. TIME (SEE M2005), GRAUPEL + +! NEW DROPLET ACTIVATION VARIABLES + REAL TAUC ! PHASE REL. TIME (SEE M2005), DROPLETS + REAL TAUR ! PHASE REL. TIME (SEE M2005), RAIN + REAL TAUI ! PHASE REL. TIME (SEE M2005), CLOUD ICE + REAL TAUS ! PHASE REL. TIME (SEE M2005), SNOW + REAL TAUG ! PHASE REL. TIME (SEE M2005), GRAUPEL + REAL DUMACT,DUM3 + +! COUNTING/INDEX VARIABLES + + INTEGER K,NSTEP,N ! ,I + +! LTRUE IS ONLY USED TO SPEED UP THE CODE !! +! LTRUE, SWITCH = 0, NO HYDROMETEORS IN COLUMN, +! = 1, HYDROMETEORS IN COLUMN + + INTEGER LTRUE + +! DROPLET ACTIVATION/FREEZING AEROSOL + + + REAL CT ! DROPLET ACTIVATION PARAMETER + REAL TEMP1 ! DUMMY TEMPERATURE + REAL SAT1 ! DUMMY SATURATION + REAL SIGVL ! SURFACE TENSION LIQ/VAPOR + REAL KEL ! KELVIN PARAMETER + REAL KC2 ! TOTAL ICE NUCLEATION RATE + + REAL CRY,KRY ! AEROSOL ACTIVATION PARAMETERS + +! MORE WORKING/DUMMY VARIABLES + + REAL DUMQI,DUMNI,DC0,DS0,DG0 + REAL DUMQC,DUMQR,RATIO,SUM_DEP,FUDGEF + +! EFFECTIVE VERTICAL VELOCITY (M/S) + REAL WEF + +! WORKING PARAMETERS FOR ICE NUCLEATION + + REAL ANUC,BNUC + +! WORKING PARAMETERS FOR AEROSOL ACTIVATION + + REAL AACT,GAMM,GG,PSI,ETA1,ETA2,SM1,SM2,SMAX,UU1,UU2,ALPHA + +! DUMMY SIZE DISTRIBUTION PARAMETERS + + REAL DLAMS,DLAMR,DLAMI,DLAMC,DLAMG,LAMMAX,LAMMIN + + INTEGER IDROP + +#if (defined CRM && defined MODAL_AERO) + INTEGER INES +#endif + +! v1.4 +! new variables for seifert and beheng warm rain scheme + REAL, DIMENSION(KMS:KME) :: nu + integer dumii + +#ifdef CLUBB_CRM + REAL :: QV_INIT ! Temporary variable for vapor + REAL :: QSAT_INIT ! Temporary variable for saturation + REAL :: TMPQSMALL ! Temporary variable for QSMALL (a lower bound in kg/kg) + REAL :: T3D_INIT ! Temporary variable for T3D (absolute temperature in [K] ) + REAL :: CLDMAXR(KMS:KME) ! Maximum cloudoverlap for rain water + REAL :: CLDMAXALL(KMS:KME) ! Maximum cloudoverlap for all hydrometers +#else + REAL ::EP_2 ! Dry air gas constant over water vapor gas constant [-] + EP_2 = rgas / rv +#endif + + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +! SET LTRUE INITIALLY TO 0 + + LTRUE = 0 + +! V.13 initialize effective radii to default values (from P. Blossey) + effc(kts:kte) = 25. + effi(kts:kte) = 25. + effs(kts:kte) = 25. + effr(kts:kte) = 25. + effg(kts:kte) = 25. + +! 09/19/2011 mhwang Initialize the micropysics process rate for output + acc1d(kms:kme) = 0.0 + aut1d(kms:kme) = 0.0 + evpc1d(kms:kme) = 0.0 + evpr1d(kms:kme) = 0.0 + mlt1d(kms:kme) = 0.0 + sub1d(kms:kme) = 0.0 + dep1d(kms:kme) = 0.0 + con1d(kms:kme) = 0.0 + + PRC(KMS:KME) = 0. + NPRC(KMS:KME) = 0. + NPRC1(KMS:KME) = 0. + PRA(KMS:KME) = 0. + NPRA(KMS:KME) = 0. + NRAGG(KMS:KME) = 0. + PSMLT(KMS:KME) = 0. + NSMLTS(KMS:KME) = 0. + NSMLTR(KMS:KME) = 0. + EVPMS(KMS:KME) = 0. + PCC(KMS:KME) = 0. + PRE(KMS:KME) = 0. + NSUBC(KMS:KME) = 0. + NSUBR(KMS:KME) = 0. + PRACG(KMS:KME) = 0. + NPRACG(KMS:KME) = 0. + PSMLT(KMS:KME) = 0. + EVPMS(KMS:KME) = 0. + PGMLT(KMS:KME) = 0. + EVPMG(KMS:KME) = 0. + PRACS(KMS:KME) = 0. + NPRACS(KMS:KME) = 0. + NGMLTG(KMS:KME) = 0. + NGMLTR(KMS:KME) = 0. + +#ifdef CLUBB_CRM + if(doclubb_gridmean) then +! calculate rain fraction based on the maximum cloud overlap +! This follows Morrison and Gettelman scheme in CAM5 + CLDMAXR(KTE)=CFL3D(KTE) + DO K=KTE-1,KTS,-1 + ! if rain, is smaller than threshold, set cldmax + ! to cloud fraction at current level + if(QR3D(K+1).ge.QSMALL) then + CLDMAXR(K) = max(CLDMAXR(K+1), CFL3D(K)) + else + CLDMAXR(K) = CFL3D(K) + end if + END DO + + CLDMAXALL(KTE)=CFI3D(KTE) + DO K=KTE-1,KTS,-1 + ! if rain, is smaller than threshold, set cldmax + ! to cloud fraction at current level + if(QR3D(K+1).ge.QSMALL.OR.QNI3D(K+1).ge.QSMALL.OR.QG3D(K+1).ge.QSMALL ) then + CLDMAXALL(K) = max(CLDMAXALL(K+1), CFI3D(K)) + else + CLDMAXALL(K) = CFI3D(K) + end if + END DO + endif +#endif + +! ATMOSPHERIC PARAMETERS THAT VARY IN TIME AND HEIGHT + DO K = KTS,KTE + +#ifdef ECPP +! INITIALIZE VARIABLES FOR ECPP OUTPUT TO ZERO + C2PREC(K)=0. + QSINK(K)=0. + CSED(K)=0. + ISED(K)=0. + SSED(K)=0. + GSED(K)=0. + RSED(K)=0. + RH3D(K)=0. +#endif /*ECPP*/ + +#ifdef CLUBB_CRM + XXLV = Lv + XXLS(K) = Ls + CPM(K) = Cp +#else +! LATENT HEAT OF VAPORATION + + XXLV(K) = lcond !bloss 3.1484E6-2370.*T3D(K) + +! LATENT HEAT OF SUBLIMATION + + XXLS(K) = lsub !bloss 3.15E6-2370.*T3D(K)+0.3337E6 + + CPM(K) = cp !bloss CP*(1.+0.887*QV3D(K)) + +#endif +! SATURATION VAPOR PRESSURE AND MIXING RATIO + +! hm, add fix for low pressure, 5/12/10 + EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0)) ! PA + EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1)) ! PA + +! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING + + IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K) + + QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K)) + QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K)) + +#ifdef CLUBB_CRM +! ADDITION BY UWM TO WEIGHT BY SGS CLOUD FRACTION +! We assume that Morrison microphysics only acts within cloud + IF ( CF3D(K) > cloud_frac_thresh ) THEN + T3D_INIT = T3D(K) ! SAVE TEMPERATURE + QV_INIT = QV3D(K) ! SAVE VAPOR + + ! We now set QV3D to be saturated w.r.t liquid at all + ! temperatures -dschanen 15 May 2009 +! IF ( T3D(K) < 273.15 ) THEN +! QV3D(K) = QVI(K) ! SET VAPOR TO ICE SATURATION WITHIN CLOUD +! TMPQSAT = QVI(K) ! Save value +! ELSE + QV3D(K) = QVS(K) ! SET VAPOR TO LIQUID SATURATION WITHIN CLOUD + QSAT_INIT = QVS(K) ! Save value +! END IF + + QC3D(K) = QC3D(K) / CF3D(K) ! Within cloud cloud water mix ratio + + IF ( INUM == 0 ) THEN + NC3D(K) = NC3D(K) / CF3D(K) ! Cloud drop num conc + END IF + + QR3D(K) = QR3D(K) / CF3D(K) ! Rain mix ratio + NR3D(K) = NR3D(K) / CF3D(K) ! Rain num conc + + IF ( ILIQ == 0 ) THEN + QI3D(K) = QI3D(K) / CF3D(K) ! Ice mix ratio + NI3D(K) = NI3D(K) / CF3D(K) ! Ice num conc + QNI3D(K) = QNI3D(K) / CF3D(K) ! Snow mix ratio + NS3D(K) = NS3D(K) / CF3D(K) ! Snow num conc + END IF + IF ( IGRAUP == 0 ) THEN + QG3D(K) = QG3D(K) / CF3D(K) ! Graupel mix ratio + NG3D(K) = NG3D(K) / CF3D(K) ! Graupel num conc + END IF + END IF +#endif + + QVQVS(K) = QV3D(K)/QVS(K) + QVQVSI(K) = QV3D(K)/QVI(K) + +! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER +! V1.3, change limit from 10^-7 to 10^-6 +! V1.7 7/9/09 change limit from 10^-6 to 10^-8 +! this improves reflectivity at low mixing ratios + + IF (QVQVS(K).LT.0.9) THEN + IF (QR3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QR3D(K) + T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) + QR3D(K)=0. + END IF + IF (QC3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QC3D(K) + T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) + QC3D(K)=0. + END IF + END IF + + IF (QVQVSI(K).LT.0.9) THEN + IF (QI3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QI3D(K) + T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) + QI3D(K)=0. + END IF + IF (QNI3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QNI3D(K) + T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) + QNI3D(K)=0. + END IF + IF (QG3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QG3D(K) + T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) + QG3D(K)=0. + END IF + END IF + +! AIR DENSITY + +!bloss: now an input argument RHO(K) = PRES(K)/(R*T3D(K)) + +! HEAT OF FUSION + + XLF(K) = XXLS(K)-XXLV(K) + +!.................................................................. +! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO + + IF (QC3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QC3D(K) + T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) +!---mhwang + QC3D(K) = 0. + NC3D(K) = 0. + EFFC(K) = 0. + END IF + IF (QR3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QR3D(K) + T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) +!---mhwang + QR3D(K) = 0. + NR3D(K) = 0. + EFFR(K) = 0. + END IF + IF (QI3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QI3D(K) + T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QI3D(K) = 0. + NI3D(K) = 0. + EFFI(K) = 0. + END IF + IF (QNI3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QNI3D(K) + T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QNI3D(K) = 0. + NS3D(K) = 0. + EFFS(K) = 0. + END IF + IF (QG3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QG3D(K) + T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QG3D(K) = 0. + NG3D(K) = 0. + EFFG(K) = 0. + END IF + +! INITIALIZE SEDIMENTATION TENDENCIES FOR MIXING RATIO + + QRSTEN(K) = 0. + QISTEN(K) = 0. + QNISTEN(K) = 0. + QCSTEN(K) = 0. + QGSTEN(K) = 0. + + NRSTEN(K) = 0. + NISTEN(K) = 0. + NSSTEN(K) = 0. + NCSTEN(K) = 0. + NGSTEN(K) = 0. + +!.................................................................. +! MICROPHYSICS PARAMETERS VARYING IN TIME/HEIGHT + +! DYNAMIC VISCOSITY OF AIR +! fix 053011 + MU(K) = 1.496E-6*T3D(K)**1.5/(T3D(K)+120.) + +! FALL SPEED WITH DENSITY CORRECTION (HEYMSFIELD AND BENSSEMER 2006) + + DUM = (RHOSU/RHO(K))**0.54 + +! fix 053011 +! AIN(K) = DUM*AI +! AA revision 4/1/11: Ikawa and Saito 1991 air-density correction +! AIN(K) = (RHOSU/RHO(K))**0.35 +! HM bug fix 10/32/2011 + AIN(K) = (RHOSU/RHO(K))**0.35*AI + ARN(K) = DUM*AR + ASN(K) = DUM*AS +! ACN(K) = DUM*AC +! AA revision 4/1/11: temperature-dependent Stokes fall speed + ACN(K) = G*RHOW/(18.*MU(K)) +! HM ADD GRAUPEL 8/28/06 + AGN(K) = DUM*AG + +! V1.7 +! bug fix 7/10/09 +!hm 4/15/09 bug fix, initialize lami to prevent later division by zero + LAMI(K)=0. + +!.................................. +! IF THERE IS NO CLOUD/PRECIP WATER, AND IF SUBSATURATED, THEN SKIP MICROPHYSICS +! FOR THIS LEVEL + + IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL & + .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) THEN + IF (T3D(K).LT.TMELT.AND.QVQVSI(K).LT.0.999) GOTO 200 + IF (T3D(K).GE.TMELT.AND.QVQVS(K).LT.0.999) GOTO 200 + END IF + +! THERMAL CONDUCTIVITY FOR AIR + +! fix 053011 + KAP(K) = 1.414E3*MU(K) + +! DIFFUSIVITY OF WATER VAPOR + + DV(K) = 8.794E-5*T3D(K)**1.81/PRES(K) + +! SCHMIT NUMBER + +! fix 053011 + SC(K) = MU(K)/(RHO(K)*DV(K)) + +! PSYCHOMETIC CORRECTIONS + +! RATE OF CHANGE SAT. MIX. RATIO WITH TEMPERATURE + + DUM = (RV*T3D(K)**2) + + DQSDT = XXLV(K)*QVS(K)/DUM + DQSIDT = XXLS(K)*QVI(K)/DUM + + ABI(K) = 1.+DQSIDT*XXLS(K)/CPM(K) + AB(K) = 1.+DQSDT*XXLV(K)/CPM(K) + +! +!..................................................................... +!..................................................................... +! CASE FOR TEMPERATURE ABOVE FREEZING + + IF (T3D(K).GE.TMELT) THEN + +!...................................................................... +!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER +! INUM = 0, PREDICT DROPLET NUMBER +! INUM = 1, SET CONSTANT DROPLET NUMBER + + IF (INUM.EQ.1) THEN +! CONVERT NDCNST FROM CM-3 TO KG-1 + NC3D(K)=NDCNST*1.E6/RHO(K) + END IF + +! GET SIZE DISTRIBUTION PARAMETERS + +! MELT VERY SMALL SNOW AND GRAUPEL MIXING RATIOS, ADD TO RAIN + IF (QNI3D(K).LT.1.E-6) THEN + QR3D(K)=QR3D(K)+QNI3D(K) + NR3D(K)=NR3D(K)+NS3D(K) + T3D(K)=T3D(K)-QNI3D(K)*XLF(K)/CPM(K) + QNI3D(K) = 0. + NS3D(K) = 0. + END IF + IF (QG3D(K).LT.1.E-6) THEN + QR3D(K)=QR3D(K)+QG3D(K) + NR3D(K)=NR3D(K)+NG3D(K) + T3D(K)=T3D(K)-QG3D(K)*XLF(K)/CPM(K) + QG3D(K) = 0. + NG3D(K) = 0. + END IF + + IF (QC3D(K).LT.QSMALL.AND.QNI3D(K).LT.1.E-8.AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.1.E-8) GOTO 300 + +! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE + + NS3D(K) = MAX(0.,NS3D(K)) + NC3D(K) = MAX(0.,NC3D(K)) + NR3D(K) = MAX(0.,NR3D(K)) + NG3D(K) = MAX(0.,NG3D(K)) + +!...................................................................... +! RAIN + + IF (QR3D(K).GE.QSMALL) THEN + LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) + N0RR(K) = NR3D(K)*LAMR(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMR(K).LT.LAMMINR) THEN + + LAMR(K) = LAMMINR + + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + ELSE IF (LAMR(K).GT.LAMMAXR) THEN + LAMR(K) = LAMMAXR + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + END IF + END IF + +!...................................................................... +! CLOUD DROPLETS + +! MARTIN ET AL. (1994) FORMULA FOR PGAM + + IF (QC3D(K).GE.QSMALL) THEN + + !bloss: option for fixing pgam + if(dofix_pgam) then + pgam(k) = pgam_fixed + else + +! DUM = PRES(K)/(R*T3D(K)) +! V1.5 +#ifndef CLUBB_CRM + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 +#else + if(doclubb_autoin) then + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K)/max(CFL3D(K), cloud_frac_thresh))+0.2714 + else + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 + end if +#endif + + PGAM(K)=1./(PGAM(K)**2)-1. + PGAM(K)=MAX(PGAM(K),2.) + PGAM(K)=MIN(PGAM(K),10.) + + end if +! v1.4 +! interpolate + dumii=int(pgam(k)) + nu(k)=dnu(dumii)+(dnu(dumii+1)-dnu(dumii))* & + (pgam(k)-real(dumii)) + +! CALCULATE LAMC + + LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & + (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) + +! LAMMIN, 60 MICRON DIAMETER +! LAMMAX, 1 MICRON + + LAMMIN = (PGAM(K)+1.)/60.E-6 + LAMMAX = (PGAM(K)+1.)/1.E-6 + + IF (LAMC(K).LT.LAMMIN) THEN + LAMC(K) = LAMMIN + +#ifndef CLUBB_CRM + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 +#else + if(doclubb_autoin) then + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) + else + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + endif +#endif + ELSE IF (LAMC(K).GT.LAMMAX) THEN + LAMC(K) = LAMMAX + +#ifndef CLUBB_CRM + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 +#else + if(doclubb_autoin) then + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) + else + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + end if +#endif + + END IF + + END IF + +!...................................................................... +! SNOW + + IF (QNI3D(K).GE.QSMALL) THEN + LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) + N0S(K) = NS3D(K)*LAMS(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMS(K).LT.LAMMINS) THEN + LAMS(K) = LAMMINS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + + NS3D(K) = N0S(K)/LAMS(K) + + ELSE IF (LAMS(K).GT.LAMMAXS) THEN + + LAMS(K) = LAMMAXS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + + NS3D(K) = N0S(K)/LAMS(K) + END IF + END IF + +!...................................................................... +! GRAUPEL + + IF (QG3D(K).GE.QSMALL) THEN + LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) + N0G(K) = NG3D(K)*LAMG(K) + +! ADJUST VARS + + IF (LAMG(K).LT.LAMMING) THEN + LAMG(K) = LAMMING + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + + ELSE IF (LAMG(K).GT.LAMMAXG) THEN + + LAMG(K) = LAMMAXG + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + END IF + END IF + +!..................................................................... +! ZERO OUT PROCESS RATES + + PRC(K) = 0. + NPRC(K) = 0. + NPRC1(K) = 0. + PRA(K) = 0. + NPRA(K) = 0. + NRAGG(K) = 0. + PSMLT(K) = 0. + NSMLTS(K) = 0. + NSMLTR(K) = 0. + EVPMS(K) = 0. + PCC(K) = 0. + PRE(K) = 0. + NSUBC(K) = 0. + NSUBR(K) = 0. + PRACG(K) = 0. + NPRACG(K) = 0. + PSMLT(K) = 0. + EVPMS(K) = 0. + PGMLT(K) = 0. + EVPMG(K) = 0. + PRACS(K) = 0. + NPRACS(K) = 0. + NGMLTG(K) = 0. + NGMLTR(K) = 0. + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! CALCULATION OF MICROPHYSICAL PROCESS RATES, T > 273.15 K + +!................................................................. +!....................................................................... +! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN +! FORMULA FROM BEHENG (1994) +! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION +! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED +! AS A GAMMA DISTRIBUTION + +! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR + + IF (QC3D(K).GE.1.E-6) THEN + +! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA +! FROM KHAIROUTDINOV AND KOGAN 2000, MWR + + IF (IRAIN.EQ.0) THEN + + PRC(K)=1350.*QC3D(K)**2.47* & + (NC3D(K)/1.e6*RHO(K))**(-1.79) + +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRC(K)=PRC(K) * gamma(RELVAR(K)+2.47)/(gamma(RELVAR(K))*RELVAR(K)**2.47) + PRC(K)=PRC(K) * CFL3D(K)**0.32 ! CFL3D**(1.79-2.47+1) + end if +#endif + +! note: nprc1 is change in Nr, +! nprc is change in Nc + + NPRC1(K) = PRC(K)/CONS29 + NPRC(K) = PRC(K)/(QC3D(k)/NC3D(K)) + + NPRC(K) = MIN(NPRC(K),NC3D(K)/DT) + + ELSE IF (IRAIN.EQ.1) THEN + +! v1.4 +! replace with seifert and beheng + + dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) + dum1 = 600.*dum**0.68*(1.-dum**0.68)**3 + + prc(k) = 9.44e9/(20.*2.6e-7)* & + (nu(k)+2.)*(nu(k)+4.)/(nu(k)+1.)**2* & + (rho(k)*qc3d(k)/1000.)**4/(rho(k)*nc3d(k)/1.e6)**2* & + (1.+dum1/(1.-dum)**2)*1000./rho(k) + + nprc(k) = prc(k)*2./2.6e-7*1000. + nprc1(k) = 0.5*nprc(k) + + END IF + END IF + +!....................................................................... +! HM ADD 12/13/06, COLLECTION OF SNOW BY RAIN ABOVE FREEZING +! FORMULA FROM IKAWA AND SAITO (1991) + + IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN + + UMS = ASN(K)*CONS3/(LAMS(K)**BS) + UMR = ARN(K)*CONS4/(LAMR(K)**BR) + UNS = ASN(K)*CONS5/LAMS(K)**BS + UNR = ARN(K)*CONS6/LAMR(K)**BR + +! SET REASLISTIC LIMITS ON FALLSPEEDS + +! bug fix, 10/08/09 + dum=(rhosu/rho(k))**0.54 + UMS=MIN(UMS,1.2*dum) + UNS=MIN(UNS,1.2*dum) + UMR=MIN(UMR,9.1*dum) + UNR=MIN(UNR,9.1*dum) + + PRACS(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+ & + 0.08*UMS*UMR)**0.5*RHO(K)* & + N0RR(K)*N0S(K)/LAMS(K)**3* & + (5./(LAMS(K)**3*LAMR(K))+ & + 2./(LAMS(K)**2*LAMR(K)**2)+ & + 0.5/(LAMS(K)*LAMR(K)**3))) + +! fix 053011, npracs no longer subtracted from snow +! NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+ & +! 0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)* & +! (1./(LAMR(K)**3*LAMS(K))+ & +! 1./(LAMR(K)**2*LAMS(K)**2)+ & +! 1./(LAMR(K)*LAMS(K)**3)) + + END IF + +! ADD COLLECTION OF GRAUPEL BY RAIN ABOVE FREEZING +! ASSUME ALL RAIN COLLECTION BY GRAUPEL ABOVE FREEZING IS SHED +! ASSUME SHED DROPS ARE 1 MM IN SIZE + + IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN + + UMG = AGN(K)*CONS7/(LAMG(K)**BG) + UMR = ARN(K)*CONS4/(LAMR(K)**BR) + UNG = AGN(K)*CONS8/LAMG(K)**BG + UNR = ARN(K)*CONS6/LAMR(K)**BR + +! SET REASLISTIC LIMITS ON FALLSPEEDS +! bug fix, 10/08/09 + dum=(rhosu/rho(k))**0.54 + UMG=MIN(UMG,20.*dum) + UNG=MIN(UNG,20.*dum) + UMR=MIN(UMR,9.1*dum) + UNR=MIN(UNR,9.1*dum) + +! PRACG IS MIXING RATIO OF RAIN PER SEC COLLECTED BY GRAUPEL/HAIL + PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+ & + 0.08*UMG*UMR)**0.5*RHO(K)* & + N0RR(K)*N0G(K)/LAMR(K)**3* & + (5./(LAMR(K)**3*LAMG(K))+ & + 2./(LAMR(K)**2*LAMG(K)**2)+ & + 0.5/(LAMR(k)*LAMG(k)**3))) + +! ASSUME 1 MM DROPS ARE SHED, GET NUMBER CONC (KG-1) SHED PER SEC + + DUM = PRACG(K)/5.2E-7 + +! GET NUMBER CONC OF RAIN DROPS COLLECTED + + NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+ & + 0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)* & + (1./(LAMR(K)**3*LAMG(K))+ & + 1./(LAMR(K)**2*LAMG(K)**2)+ & + 1./(LAMR(K)*LAMG(K)**3)) + + NPRACG(K)=MAX(NPRACG(K)-DUM,0.) + + END IF + +!....................................................................... +! ACCRETION OF CLOUD LIQUID WATER BY RAIN +! CONTINUOUS COLLECTION EQUATION WITH +! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED + + IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN + +! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM +! KHAIROUTDINOV AND KOGAN 2000, MWR + + IF (IRAIN.EQ.0) THEN + + DUM=(QC3D(K)*QR3D(K)) + PRA(K) = 67.*(DUM)**1.15 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRA(K)=PRA(K) * accre_enhan(K)*gamma(RELVAR(K)+1.15)/(gamma(RELVAR(K))*RELVAR(K)**1.15) + PRA(K) = PRA(K) /(max(CLDMAXR(K), cloud_frac_thresh))**1.15 ! PRA = (QC3D/CFL3D * QR3D/CLDMAXR * CFL3D)**1.15 + end if +#endif + NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K)) + + ELSE IF (IRAIN.EQ.1) THEN + +! v1.4 +! seifert and beheng (2001) formulation + + dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) + dum1 = (dum/(dum+5.e-4))**4 + pra(k) = 5.78e3*rho(k)/1000.*qc3d(k)*qr3d(k)*dum1 + npra(k) = pra(k)*rho(k)/1000.*(nc3d(k)*rho(k)/1.e6)/ & + (qc3d(k)*rho(k)/1000.)*1.e6/rho(k) + + END IF + END IF +!....................................................................... +! SELF-COLLECTION OF RAIN DROPS +! FROM BEHENG(1994) +! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION +! AS DESCRINED ABOVE FOR AUTOCONVERSION + +! v1.4, replace with seifert and beheng (2001) + + IF (QR3D(K).GE.1.E-8) THEN +! include breakup add 10/09/09 + dum1=300.e-6 + if (1./lamr(k).lt.dum1) then + dum=1. + else if (1./lamr(k).ge.dum1) then + dum=2.-exp(2300.*(1./lamr(k)-dum1)) + end if +! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K) + NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K) + END IF + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! CALCULATE EVAP OF RAIN (RUTLEDGE AND HOBBS 1983) + + IF (QR3D(K).GE.QSMALL) THEN + EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)* & + (F1R/(LAMR(K)*LAMR(K))+ & + F2R*(ARN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS9/ & + (LAMR(K)**CONS34)) + ELSE + EPSR = 0. + END IF + +! NO CONDENSATION ONTO RAIN, ONLY EVAP ALLOWED + + IF (QV3D(K).LT.QVS(K)) THEN + PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K) + PRE(K) = MIN(PRE(K),0.) + ELSE + PRE(K) = 0. + END IF +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRE(K) = PRE(K) * max(CLDMAXR(K)-CFL3D(K), 0.0)/max(CLDMAXR(K), cloud_frac_thresh) + if(CFL3D(K).gt.0.10) then ! when there is enough liquid present, no evaporation is allowed + PRE(K) = 0.0 + end if + end if +#endif + +!....................................................................... +! MELTING OF SNOW + +! SNOW MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984 +! IF WATER SUPERSATURATION, SNOW MELTS TO FORM RAIN + + IF (QNI3D(K).GE.1.E-8) THEN + +! fix 053011 +! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN +! DUM = -CPW/XLF(K)*T3D(K)*PRACS(K) +! DUM = -CPW/XLF(K)*(T3D(K)-TMELT)*PRACS(K) + DUM = -CPW/XLF(K)*max(T3D(K)-TMELT, 0.0)*PRACS(K) !+++mhwang 09/20/2011 + +! PSMLT(K)=2.*PI*N0S(K)*KAP(K)*(TMELT-T3D(K))/ & + PSMLT(K)=2.*PI*N0S(K)*KAP(K)*min(TMELT-T3D(K), 0.0)/ & !+++mhwang 09/20/2011 + XLF(K)*RHO(K)*(F1S/(LAMS(K)*LAMS(K))+ & + F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS10/ & + (LAMS(K)**CONS35))+DUM + +! IN WATER SUBSATURATION, SNOW MELTS AND EVAPORATES + + IF (QVQVS(K).LT.1.) THEN + EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)* & + (F1S/(LAMS(K)*LAMS(K))+ & + F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS10/ & + (LAMS(K)**CONS35)) +! bug fix V1.4 + EVPMS(K) = (QV3D(K)-QVS(K))*EPSS/AB(K) + EVPMS(K) = MAX(EVPMS(K),PSMLT(K)) + PSMLT(K) = PSMLT(K)-EVPMS(K) + END IF + END IF + +!....................................................................... +! MELTING OF GRAUPEL + +! GRAUPEL MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984 +! IF WATER SUPERSATURATION, GRAUPEL MELTS TO FORM RAIN + + IF (QG3D(K).GE.1.E-8) THEN + +! fix 053011 +! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN +! DUM = -CPW/XLF(K)*T3D(K)*PRACG(K) +! DUM = -CPW/XLF(K)*(T3D(K)-273.15)*PRACG(K) + DUM = -CPW/XLF(K)*max(T3D(K)-TMELT, 0.0)*PRACG(K) !+++mhwang 10/17/2011 + + PGMLT(K)=2.*PI*N0G(K)*KAP(K)*(TMELT-T3D(K))/ & + XLF(K)*RHO(K)*(F1S/(LAMG(K)*LAMG(K))+ & + F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS11/ & + (LAMG(K)**CONS36))+DUM + +! IN WATER SUBSATURATION, GRAUPEL MELTS AND EVAPORATES + + IF (QVQVS(K).LT.1.) THEN + EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)* & + (F1S/(LAMG(K)*LAMG(K))+ & + F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS11/ & + (LAMG(K)**CONS36)) +! bug fix V1.4 + EVPMG(K) = (QV3D(K)-QVS(K))*EPSG/AB(K) + EVPMG(K) = MAX(EVPMG(K),PGMLT(K)) + PGMLT(K) = PGMLT(K)-EVPMG(K) + END IF + END IF + +! HM, V3.2 +! RESET PRACG AND PRACS TO ZERO, THIS IS DONE BECAUSE THERE IS NO +! TRANSFER OF MASS FROM SNOW AND GRAUPEL TO RAIN DIRECTLY FROM COLLECTION +! ABOVE FREEZING, IT IS ONLY USED FOR ENHANCEMENT OF MELTING AND SHEDDING + + PRACG(K) = 0. + PRACS(K) = 0. + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +! FOR CLOUD ICE, ONLY PROCESSES OPERATING AT T > 273.15 IS +! MELTING, WHICH IS ALREADY CONSERVED DURING PROCESS +! CALCULATION + +! CONSERVATION OF QC + + DUM = (PRC(K)+PRA(K))*DT + + IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN + + RATIO = QC3D(K)/DUM + + PRC(K) = PRC(K)*RATIO + PRA(K) = PRA(K)*RATIO + + END IF + +! CONSERVATION OF SNOW + + DUM = (-PSMLT(K)-EVPMS(K)+PRACS(K))*DT + + IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN + +! NO SOURCE TERMS FOR SNOW AT T > FREEZING + RATIO = QNI3D(K)/DUM + + PSMLT(K) = PSMLT(K)*RATIO + EVPMS(K) = EVPMS(K)*RATIO + PRACS(K) = PRACS(K)*RATIO + + END IF + +! CONSERVATION OF GRAUPEL + + DUM = (-PGMLT(K)-EVPMG(K)+PRACG(K))*DT + + IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN + +! NO SOURCE TERM FOR GRAUPEL ABOVE FREEZING + RATIO = QG3D(K)/DUM + + PGMLT(K) = PGMLT(K)*RATIO + EVPMG(K) = EVPMG(K)*RATIO + PRACG(K) = PRACG(K)*RATIO + + END IF + +! CONSERVATION OF QR +! HM 12/13/06, ADDED CONSERVATION OF RAIN SINCE PRE IS NEGATIVE + + DUM = (-PRACS(K)-PRACG(K)-PRE(K)-PRA(K)-PRC(K)+PSMLT(K)+PGMLT(K))*DT + + IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN + + RATIO = (QR3D(K)/DT+PRACS(K)+PRACG(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K))/ & + (-PRE(K)) + PRE(K) = PRE(K)*RATIO + + END IF + +!.................................... + + QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-EVPMS(K)-EVPMG(K)) + + T3DTEN(K) = T3DTEN(K)+(PRE(K)*XXLV(K)+(EVPMS(K)+EVPMG(K))*XXLS(K)+& + (PSMLT(K)+PGMLT(K)-PRACS(K)-PRACG(K))*XLF(K))/CPM(K) + + QC3DTEN(K) = QC3DTEN(K)+(-PRA(K)-PRC(K)) + QR3DTEN(K) = QR3DTEN(K)+(PRE(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K)) + QNI3DTEN(K) = QNI3DTEN(K)+(PSMLT(K)+EVPMS(K)-PRACS(K)) + QG3DTEN(K) = QG3DTEN(K)+(PGMLT(K)+EVPMG(K)-PRACG(K)) +! fix 053011 +! NS3DTEN(K) = NS3DTEN(K)-NPRACS(K) +! HM, bug fix 5/12/08, npracg is subtracted from nr not ng +! NG3DTEN(K) = NG3DTEN(K) + NC3DTEN(K) = NC3DTEN(K)+ (-NPRA(K)-NPRC(K)) + NR3DTEN(K) = NR3DTEN(K)+ (NPRC1(K)+NRAGG(K)-NPRACG(K)) +#ifdef ECPP +! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC + C2PREC(K) = PRA(K)+PRC(K) + if(QC3D(K).gt.1.0e-10) then + QSINK(K) = min(1.0, C2PREC(K)/QC3D(K)) + else + QSINK(K) = 0.0 + end if +#endif + + IF (PRE(K).LT.0.) THEN + DUM = PRE(K)*DT/QR3D(K) + DUM = MAX(-1.,DUM) + NSUBR(K) = DUM*NR3D(K)/DT + END IF + +! V1.3 move code below to before saturation adjustment + IF (EVPMS(K)+PSMLT(K).LT.0.) THEN + DUM = (EVPMS(K)+PSMLT(K))*DT/QNI3D(K) + DUM = MAX(-1.,DUM) + NSMLTS(K) = DUM*NS3D(K)/DT + END IF + IF (PSMLT(K).LT.0.) THEN + DUM = PSMLT(K)*DT/QNI3D(K) + DUM = MAX(-1.0,DUM) + NSMLTR(K) = DUM*NS3D(K)/DT + END IF + IF (EVPMG(K)+PGMLT(K).LT.0.) THEN + DUM = (EVPMG(K)+PGMLT(K))*DT/QG3D(K) + DUM = MAX(-1.,DUM) + NGMLTG(K) = DUM*NG3D(K)/DT + END IF + IF (PGMLT(K).LT.0.) THEN + DUM = PGMLT(K)*DT/QG3D(K) + DUM = MAX(-1.0,DUM) + NGMLTR(K) = DUM*NG3D(K)/DT + END IF + +! nsubr(k)=0. +! nsubs(k)=0. +! nsubg(k)=0. + + NS3DTEN(K) = NS3DTEN(K)+(NSMLTS(K)) + NG3DTEN(K) = NG3DTEN(K)+(NGMLTG(K)) + NR3DTEN(K) = NR3DTEN(K)+(NSUBR(K)-NSMLTR(K)-NGMLTR(K)) + + 300 CONTINUE + + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + IF(ISATADJ.EQ.0) THEN !PB 4/13/09 + +! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE +! WATER SATURATION + + DUMT = T3D(K)+DT*T3DTEN(K) + DUMQV = QV3D(K)+DT*QV3DTEN(K) +! hm, add fix for low pressure, 5/12/10 + dum=min(0.99*pres(k),POLYSVP(DUMT,0)) + DUMQSS = EP_2*dum/(PRES(K)-dum) + DUMQC = QC3D(K)+DT*QC3DTEN(K) + DUMQC = MAX(DUMQC,0.) + +! SATURATION ADJUSTMENT FOR LIQUID + + DUMS = DUMQV-DUMQSS + PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT +! IF (PCC(K)*DT+DUMQC.LT.0.) THEN +! PCC(K) = -DUMQC/DT +! END IF +!+++mhwang + IF (PCC(K)*DT+QC3D(K)+DT*QC3DTEN(K).LT.0.) THEN + PCC(K) = -(QC3D(K)+DT*QC3DTEN(K))/DT + END IF +!---mhwang + + QV3DTEN(K) = QV3DTEN(K)-PCC(K) + T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K) + QC3DTEN(K) = QC3DTEN(K)+PCC(K) + + END IF + +! hm 7/26/11, new output + + aut1d(k)=prc(k) + acc1d(k)=pra(k) + mlt1d(k)=-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K) + evpr1d(k)=-PRE(K)-EVPMS(K)-EVPMG(K) + if (pcc(k).lt.0.) then + evpc1d(k)=-pcc(k) + else if (pcc(k).gt.0.) then + con1d(k)=pcc(k) + end if + +!....................................................................... +! ACTIVATION OF CLOUD DROPLETS + +!bloss: only do activation if droplet number is predicted +!bloss IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN + IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL.AND.INUM.EQ.0) THEN + +! EFFECTIVE VERTICAL VELOCITY (M/S) + + IF (ISUB.EQ.0) THEN +! ADD SUB-GRID VERTICAL VELOCITY + DUM = W3D(K)+WVAR(K) + +! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S +#ifdef CLUBB_CRM + DUM = MAX(DUM,0.01) +#else + DUM = MAX(DUM,0.10) +#endif + + + ELSE IF (ISUB.EQ.1) THEN + DUM=W3D(K) + END IF + +! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION + IF (DUM.GE.0.001) THEN + + IF (IBASE.EQ.1) THEN + +! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER +! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1) + + IDROP=0 + +! V1.3 USE CURRENT VALUE OF QC FOR IDROP + IF (QC3D(K).LE.0.05E-3/RHO(K)) THEN + IDROP=1 + END IF + IF (K.EQ.1) THEN + IDROP=1 + ELSE IF (K.GE.2) THEN + IF (QC3D(K).GT.0.05E-3/RHO(K).AND. & + QC3D(K-1).LE.0.05E-3/RHO(K-1)) THEN + IDROP=1 + END IF + END IF + + IF (IDROP.EQ.1) THEN +! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER + + IF (IACT.EQ.1) THEN +! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W +! BASED ON TWOMEY 1959 + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN +! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000) + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then + INES = 0 + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + END IF ! IACT + +!............................................................................. + ELSE IF (IDROP.EQ.0) THEN +! ACTIVATE IN CLOUD INTERIOR +! FIND EQUILIBRIUM SUPERSATURATION + + TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K)) + IF (EPSR.GT.1.E-8) THEN + TAUR=1./EPSR + ELSE + TAUR=1.E8 + END IF + + DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM + DUM3=DUM3*TAUC*TAUR/(TAUC+TAUR) + + IF (DUM3/QVS(K).GE.1.E-6) THEN + IF (IACT.EQ.1) THEN + +! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + +! USE POWER LAW CCN SPECTRA + +! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN % + DUM3=DUM3/QVS(K)*100. + + DUM2=C1*DUM3**K1 +! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS + DUM2=MIN(DUM2,DUMACT) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN + +! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2) + +! USE LOGNORMAL AEROSOL + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + +! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION + SMAX = DUM3/QVS(K) + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) + +! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS + DUM2=MIN(DUM2,DUMACT) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then + INES =1 +! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION + SMAX = DUM3/QVS(K) + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + END IF ! IACT + END IF ! DUM3/QVS > 1.E-6 + END IF ! IDROP = 1 + +!....................................................................... + ELSE IF (IBASE.EQ.2) THEN + + IF (IACT.EQ.1) THEN +! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W +! BASED ON TWOMEY 1959 + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then + INES = 0 + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + END IF ! IACT + END IF ! IBASE + END IF ! W > 0.001 + END IF ! QC3D > QSMALL + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION +! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND +! LOSS OF NUMBER CONCENTRATION + +! IF (PCC(K).LT.0.) THEN +! DUM = PCC(K)*DT/QC3D(K) +! DUM = MAX(-1.,DUM) +! NSUBC(K) = DUM*NC3D(K)/DT +! END IF + +! UPDATE TENDENCIES + +! NC3DTEN(K) = NC3DTEN(K)+NSUBC(K) + +!..................................................................... +!..................................................................... + ELSE ! TEMPERATURE < 273.15 + +!...................................................................... +!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER +! INUM = 0, PREDICT DROPLET NUMBER +! INUM = 1, SET CONSTANT DROPLET NUMBER + + IF (INUM.EQ.1) THEN +! CONVERT NDCNST FROM CM-3 TO KG-1 + NC3D(K)=NDCNST*1.E6/RHO(K) + END IF + +! CALCULATE SIZE DISTRIBUTION PARAMETERS +! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE + + NI3D(K) = MAX(0.,NI3D(K)) + NS3D(K) = MAX(0.,NS3D(K)) + NC3D(K) = MAX(0.,NC3D(K)) + NR3D(K) = MAX(0.,NR3D(K)) + NG3D(K) = MAX(0.,NG3D(K)) + +!...................................................................... +! CLOUD ICE + + IF (QI3D(K).GE.QSMALL) THEN + LAMI(K) = (CONS12* & + NI3D(K)/QI3D(K))**(1./DI) + N0I(K) = NI3D(K)*LAMI(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMI(K).LT.LAMMINI) THEN + + LAMI(K) = LAMMINI + + N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 + + NI3D(K) = N0I(K)/LAMI(K) + ELSE IF (LAMI(K).GT.LAMMAXI) THEN + LAMI(K) = LAMMAXI + N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 + + NI3D(K) = N0I(K)/LAMI(K) + END IF + END IF + +!...................................................................... +! RAIN + + IF (QR3D(K).GE.QSMALL) THEN + LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) + N0RR(K) = NR3D(K)*LAMR(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMR(K).LT.LAMMINR) THEN + + LAMR(K) = LAMMINR + + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + ELSE IF (LAMR(K).GT.LAMMAXR) THEN + LAMR(K) = LAMMAXR + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + END IF + END IF + +!...................................................................... +! CLOUD DROPLETS + +! MARTIN ET AL. (1994) FORMULA FOR PGAM + + IF (QC3D(K).GE.QSMALL) THEN + + !bloss: option for fixing pgam + if(dofix_pgam) then + pgam(k) = pgam_fixed + else + +! DUM = PRES(K)/(R*T3D(K)) +! V1.5 +#ifndef CLUBB_CRM + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 +#else + if(doclubb_autoin) then + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K)/max(CFL3D(K), cloud_frac_thresh))+0.2714 + else + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 + end if +#endif + + PGAM(K)=1./(PGAM(K)**2)-1. + PGAM(K)=MAX(PGAM(K),2.) + PGAM(K)=MIN(PGAM(K),10.) + + end if +! v1.4 +! interpolate + dumii=int(pgam(k)) + nu(k)=dnu(dumii)+(dnu(dumii+1)-dnu(dumii))* & + (pgam(k)-real(dumii)) + +! CALCULATE LAMC + + LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & + (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) + +! LAMMIN, 60 MICRON DIAMETER +! LAMMAX, 1 MICRON + + LAMMIN = (PGAM(K)+1.)/60.E-6 + LAMMAX = (PGAM(K)+1.)/1.E-6 + + IF (LAMC(K).LT.LAMMIN) THEN + LAMC(K) = LAMMIN + +#ifndef CLUBB_CRM + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 +#else + if(doclubb_autoin) then + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) + else + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + endif +#endif + + ELSE IF (LAMC(K).GT.LAMMAX) THEN + LAMC(K) = LAMMAX +#ifndef CLUBB_CRM + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 +#else + if(doclubb_autoin) then + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) + else + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + end if +#endif + + END IF + +! TO CALCULATE DROPLET FREEZING + + CDIST1(K) = NC3D(K)/GAMMA(PGAM(K)+1.) + + END IF + +!...................................................................... +! SNOW + + IF (QNI3D(K).GE.QSMALL) THEN + LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) + N0S(K) = NS3D(K)*LAMS(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMS(K).LT.LAMMINS) THEN + LAMS(K) = LAMMINS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + + NS3D(K) = N0S(K)/LAMS(K) + + ELSE IF (LAMS(K).GT.LAMMAXS) THEN + + LAMS(K) = LAMMAXS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + + NS3D(K) = N0S(K)/LAMS(K) + END IF + END IF + +!...................................................................... +! GRAUPEL + + IF (QG3D(K).GE.QSMALL) THEN + LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) + N0G(K) = NG3D(K)*LAMG(K) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMG(K).LT.LAMMING) THEN + LAMG(K) = LAMMING + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + + ELSE IF (LAMG(K).GT.LAMMAXG) THEN + + LAMG(K) = LAMMAXG + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + END IF + END IF + +!..................................................................... +! ZERO OUT PROCESS RATES + + MNUCCC(K) = 0. + NNUCCC(K) = 0. + PRC(K) = 0. + NPRC(K) = 0. + NPRC1(K) = 0. + NSAGG(K) = 0. + PSACWS(K) = 0. + NPSACWS(K) = 0. + PSACWI(K) = 0. + NPSACWI(K) = 0. + PRACS(K) = 0. + NPRACS(K) = 0. + NMULTS(K) = 0. + QMULTS(K) = 0. + NMULTR(K) = 0. + QMULTR(K) = 0. + NMULTG(K) = 0. + QMULTG(K) = 0. + NMULTRG(K) = 0. + QMULTRG(K) = 0. + MNUCCR(K) = 0. + NNUCCR(K) = 0. + PRA(K) = 0. + NPRA(K) = 0. + NRAGG(K) = 0. + PRCI(K) = 0. + NPRCI(K) = 0. + PRAI(K) = 0. + NPRAI(K) = 0. + NNUCCD(K) = 0. + MNUCCD(K) = 0. + PCC(K) = 0. + PRE(K) = 0. + PRD(K) = 0. + PRDS(K) = 0. + EPRD(K) = 0. + EPRDS(K) = 0. + NSUBC(K) = 0. + NSUBI(K) = 0. + NSUBS(K) = 0. + NSUBR(K) = 0. + PIACR(K) = 0. + NIACR(K) = 0. + PRACI(K) = 0. + PIACRS(K) = 0. + NIACRS(K) = 0. + PRACIS(K) = 0. +! HM: ADD GRAUPEL PROCESSES + PRACG(K) = 0. + PSACR(K) = 0. + PSACWG(K) = 0. + PGSACW(K) = 0. + PGRACS(K) = 0. + PRDG(K) = 0. + EPRDG(K) = 0. + NPRACG(K) = 0. + NPSACWG(K) = 0. + NSCNG(K) = 0. + NGRACS(K) = 0. + NSUBG(K) = 0. + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! CALCULATION OF MICROPHYSICAL PROCESS RATES +! ACCRETION/AUTOCONVERSION/FREEZING/MELTING/COAG. +!....................................................................... +! FREEZING OF CLOUD DROPLETS +! ONLY ALLOWED BELOW -4 C + IF (QC3D(K).GE.QSMALL .AND. T3D(K).LT.269.15) THEN + +! NUMBER OF CONTACT NUCLEI (M^-3) FROM MEYERS ET AL., 1992 +! FACTOR OF 1000 IS TO CONVERT FROM L^-1 TO M^-3 + +! MEYERS CURVE + + NACNT = EXP(-2.80+0.262*(TMELT-T3D(K)))*1000. + +! COOPER CURVE +! NACNT = 5.*EXP(0.304*(TMELT-T3D(K))) + +! FLECTHER +! NACNT = 0.01*EXP(0.6*(TMELT-T3D(K))) + +! CONTACT FREEZING + +! MEAN FREE PATH + + DUM = 7.37*T3D(K)/(288.*10.*PRES(K))/100. + +! EFFECTIVE DIFFUSIVITY OF CONTACT NUCLEI +! BASED ON BROWNIAN DIFFUSION + + DAP(K) = CONS37*T3D(K)*(1.+DUM/RIN)/MU(K) + + MNUCCC(K) = CONS38*DAP(K)*NACNT*EXP(LOG(CDIST1(K))+ & + LOG(GAMMA(PGAM(K)+5.))-4.*LOG(LAMC(K))) + NNUCCC(K) = 2.*PI*DAP(K)*NACNT*CDIST1(K)* & + GAMMA(PGAM(K)+2.)/ & + LAMC(K) + +! IMMERSION FREEZING (BIGG 1953) + + MNUCCC(K) = MNUCCC(K)+CONS39* & + EXP(LOG(CDIST1(K))+LOG(GAMMA(7.+PGAM(K)))-6.*LOG(LAMC(K)))* & + EXP(AIMM*(TMELT-T3D(K))) + + NNUCCC(K) = NNUCCC(K)+ & + CONS40*EXP(LOG(CDIST1(K))+LOG(GAMMA(PGAM(K)+4.))-3.*LOG(LAMC(K))) & + *EXP(AIMM*(TMELT-T3D(K))) + +! PUT IN A CATCH HERE TO PREVENT DIVERGENCE BETWEEN NUMBER CONC. AND +! MIXING RATIO, SINCE STRICT CONSERVATION NOT CHECKED FOR NUMBER CONC + + NNUCCC(K) = MIN(NNUCCC(K),NC3D(K)/DT) + + END IF + +#ifdef CLUBB_CRM +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! For the case of clex9_oct14, we need to decrease the ice ! +! nucleation in order for the cloud to persist for realistic ! +! lengths. It is suggested to reduce by a factor of 100 ! +! This coefficient can be changed in the subroutine ! +! init_microphys of the microphys_driver subroutine ! +! ! + NNUCCC(K)=NNUCCC(K)*NNUCCC_REDUCE_COEF +! ! +! Change made by Marc Pilon on 11/16/11 ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +#endif /* CLUBB_CRM */ + + + + +!................................................................. +!....................................................................... +! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN +! FORMULA FROM BEHENG (1994) +! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION +! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED +! AS A GAMMA DISTRIBUTION + +! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR + + IF (QC3D(K).GE.1.E-6) THEN + +! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA +! FROM KHAIROUTDINOV AND KOGAN 2000, MWR + + IF (IRAIN.EQ.0) THEN + PRC(K)=1350.*QC3D(K)**2.47* & + (NC3D(K)/1.e6*RHO(K))**(-1.79) + +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRC(K)=PRC(K) * gamma(RELVAR(K)+2.47)/(gamma(RELVAR(K))*RELVAR(K)**2.47) + PRC(K)=PRC(K) * CFL3D(K)**0.32 ! CFL3D**(1.79-2.47+1) + end if +#endif + +! note: nprc1 is change in Nr, +! nprc is change in Nc + + NPRC1(K) = PRC(K)/CONS29 + NPRC(K) = PRC(K)/(QC3D(K)/NC3D(K)) + + NPRC(K) = MIN(NPRC(K),NC3D(K)/DT) + + ELSE IF (IRAIN.EQ.1) THEN + +! v1.4 +! replace with seifert and beheng + + dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) + dum1 = 600.*dum**0.68*(1.-dum**0.68)**3 + + prc(k) = 9.44e9/(20.*2.6e-7)* & + (nu(k)+2.)*(nu(k)+4.)/(nu(k)+1.)**2* & + (rho(k)*qc3d(k)/1000.)**4/(rho(k)*nc3d(k)/1.e6)**2* & + (1.+dum1/(1.-dum)**2)*1000./rho(k) + + nprc(k) = prc(k)*2./2.6e-7*1000. + nprc1(k) = 0.5*nprc(k) + + END IF + END IF + +!....................................................................... +! SELF-COLLECTION OF DROPLET NOT INCLUDED IN KK2000 SCHEME + +! SNOW AGGREGATION FROM PASSARELLI, 1978, USED BY REISNER, 1998 +! THIS IS HARD-WIRED FOR BS = 0.4 FOR NOW + + IF (QNI3D(K).GE.1.E-8) THEN + NSAGG(K) = CONS15*ASN(K)*RHO(K)** & + ((2.+BS)/3.)*QNI3D(K)**((2.+BS)/3.)* & + (NS3D(K)*RHO(K))**((4.-BS)/3.)/ & + (RHO(K)) + END IF + +!....................................................................... +! ACCRETION OF CLOUD DROPLETS ONTO SNOW/GRAUPEL +! HERE USE CONTINUOUS COLLECTION EQUATION WITH +! SIMPLE GRAVITATIONAL COLLECTION KERNEL IGNORING + +! SNOW + + IF (QNI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN + + PSACWS(K) = CONS13*ASN(K)*QC3D(K)*RHO(K)* & + N0S(K)/ & + LAMS(K)**(BS+3.) + NPSACWS(K) = CONS13*ASN(K)*NC3D(K)*RHO(K)* & + N0S(K)/ & + LAMS(K)**(BS+3.) + + END IF + +!............................................................................ +! COLLECTION OF CLOUD WATER BY GRAUPEL + + IF (QG3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN + + PSACWG(K) = CONS14*AGN(K)*QC3D(K)*RHO(K)* & + N0G(K)/ & + LAMG(K)**(BG+3.) + NPSACWG(K) = CONS14*AGN(K)*NC3D(K)*RHO(K)* & + N0G(K)/ & + LAMG(K)**(BG+3.) + END IF + +!....................................................................... +! HM, ADD 12/13/06 +! CLOUD ICE COLLECTING DROPLETS, ASSUME THAT CLOUD ICE MEAN DIAM > 100 MICRON +! BEFORE RIMING CAN OCCUR +! ASSUME THAT RIME COLLECTED ON CLOUD ICE DOES NOT LEAD +! TO HALLET-MOSSOP SPLINTERING + + IF (QI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN + +! PUT IN SIZE DEPENDENT COLLECTION EFFICIENCY BASED ON STOKES LAW +! FROM THOMPSON ET AL. 2004, MWR + + IF (1./LAMI(K).GE.100.E-6) THEN + + PSACWI(K) = CONS16*AIN(K)*QC3D(K)*RHO(K)* & + N0I(K)/ & + LAMI(K)**(BI+3.) + NPSACWI(K) = CONS16*AIN(K)*NC3D(K)*RHO(K)* & + N0I(K)/ & + LAMI(K)**(BI+3.) + END IF + END IF + +!....................................................................... +! ACCRETION OF RAIN WATER BY SNOW +! FORMULA FROM IKAWA AND SAITO, 1991, USED BY REISNER ET AL, 1998 + + IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN + + UMS = ASN(K)*CONS3/(LAMS(K)**BS) + UMR = ARN(K)*CONS4/(LAMR(K)**BR) + UNS = ASN(K)*CONS5/LAMS(K)**BS + UNR = ARN(K)*CONS6/LAMR(K)**BR + +! SET REASLISTIC LIMITS ON FALLSPEEDS +! bug fix, 10/08/09 + dum=(rhosu/rho(k))**0.54 + UMS=MIN(UMS,1.2*dum) + UNS=MIN(UNS,1.2*dum) + UMR=MIN(UMR,9.1*dum) + UNR=MIN(UNR,9.1*dum) + + PRACS(K) = CONS41*(((1.2*UMR-0.95*UMS)**2+ & + 0.08*UMS*UMR)**0.5*RHO(K)* & + N0RR(K)*N0S(K)/LAMR(K)**3* & + (5./(LAMR(K)**3*LAMS(K))+ & + 2./(LAMR(K)**2*LAMS(K)**2)+ & + 0.5/(LAMR(k)*LAMS(k)**3))) + + NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+ & + 0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)* & + (1./(LAMR(K)**3*LAMS(K))+ & + 1./(LAMR(K)**2*LAMS(K)**2)+ & + 1./(LAMR(K)*LAMS(K)**3)) + +! MAKE SURE PRACS DOESN'T EXCEED TOTAL RAIN MIXING RATIO +! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING +! RIME-SPLINTERING + + PRACS(K) = MIN(PRACS(K),QR3D(K)/DT) + +! COLLECTION OF SNOW BY RAIN - NEEDED FOR GRAUPEL CONVERSION CALCULATIONS +! ONLY CALCULATE IF SNOW AND RAIN MIXING RATIOS EXCEED 0.1 G/KG + +! V1.3 +! ASSUME COLLECTION OF SNOW BY RAIN PRODUCES GRAUPEL NOT HAIL + +! V1.5 +! IF (IHAIL.EQ.0) THEN + IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN + PSACR(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+ & + 0.08*UMS*UMR)**0.5*RHO(K)* & + N0RR(K)*N0S(K)/LAMS(K)**3* & + (5./(LAMS(K)**3*LAMR(K))+ & + 2./(LAMS(K)**2*LAMR(K)**2)+ & + 0.5/(LAMS(K)*LAMR(K)**3))) + END IF +! END IF + + END IF + +!....................................................................... + +! COLLECTION OF RAINWATER BY GRAUPEL, FROM IKAWA AND SAITO 1990, +! USED BY REISNER ET AL 1998 + IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN + + UMG = AGN(K)*CONS7/(LAMG(K)**BG) + UMR = ARN(K)*CONS4/(LAMR(K)**BR) + UNG = AGN(K)*CONS8/LAMG(K)**BG + UNR = ARN(K)*CONS6/LAMR(K)**BR + +! SET REASLISTIC LIMITS ON FALLSPEEDS +! bug fix, 10/08/09 + dum=(rhosu/rho(k))**0.54 + UMG=MIN(UMG,20.*dum) + UNG=MIN(UNG,20.*dum) + UMR=MIN(UMR,9.1*dum) + UNR=MIN(UNR,9.1*dum) + + PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+ & + 0.08*UMG*UMR)**0.5*RHO(K)* & + N0RR(K)*N0G(K)/LAMR(K)**3* & + (5./(LAMR(K)**3*LAMG(K))+ & + 2./(LAMR(K)**2*LAMG(K)**2)+ & + 0.5/(LAMR(k)*LAMG(k)**3))) + + NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+ & + 0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)* & + (1./(LAMR(K)**3*LAMG(K))+ & + 1./(LAMR(K)**2*LAMG(K)**2)+ & + 1./(LAMR(K)*LAMG(K)**3)) + +! MAKE SURE PRACG DOESN'T EXCEED TOTAL RAIN MIXING RATIO +! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING +! RIME-SPLINTERING + + PRACG(K) = MIN(PRACG(K),QR3D(K)/DT) + + END IF + +!....................................................................... +! RIME-SPLINTERING - SNOW +! HALLET-MOSSOP (1974) +! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER + +! DUM1 = MASS OF INDIVIDUAL SPLINTERS + +! HM ADD THRESHOLD SNOW AND DROPLET MIXING RATIO FOR RIME-SPLINTERING +! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS +! THESE THRESHOLDS CORRESPOND WITH GRAUPEL THRESHOLDS IN RH 1984 + +!v1.4 + IF (QNI3D(K).GE.0.1E-3) THEN + IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN + IF (PSACWS(K).GT.0..OR.PRACS(K).GT.0.) THEN + IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN + + IF (T3D(K).GT.270.16) THEN + FMULT = 0. + ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16) THEN + FMULT = (270.16-T3D(K))/2. + ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16) THEN + FMULT = (T3D(K)-265.16)/3. + ELSE IF (T3D(K).LT.265.16) THEN + FMULT = 0. + END IF + +! 1000 IS TO CONVERT FROM KG TO G + +! SPLINTERING FROM DROPLETS ACCRETED ONTO SNOW + + IF (PSACWS(K).GT.0.) THEN + NMULTS(K) = 35.E4*PSACWS(K)*FMULT*1000. + QMULTS(K) = NMULTS(K)*MMULT + +! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS +! THAN WAS RIMED ONTO SNOW + + QMULTS(K) = MIN(QMULTS(K),PSACWS(K)) + PSACWS(K) = PSACWS(K)-QMULTS(K) + + END IF + +! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS + + IF (PRACS(K).GT.0.) THEN + NMULTR(K) = 35.E4*PRACS(K)*FMULT*1000. + QMULTR(K) = NMULTR(K)*MMULT + +! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS +! THAN WAS RIMED ONTO SNOW + + QMULTR(K) = MIN(QMULTR(K),PRACS(K)) + + PRACS(K) = PRACS(K)-QMULTR(K) + + END IF + + END IF + END IF + END IF + END IF + +!....................................................................... +! RIME-SPLINTERING - GRAUPEL +! HALLET-MOSSOP (1974) +! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER + +! DUM1 = MASS OF INDIVIDUAL SPLINTERS + +! HM ADD THRESHOLD SNOW MIXING RATIO FOR RIME-SPLINTERING +! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS + +! V1.3 +! ONLY CALCULATE FOR GRAUPEL NOT HAIL +! V1.5 +! IF (IHAIL.EQ.0) THEN +! v1.4 + IF (QG3D(K).GE.0.1E-3) THEN + IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN + IF (PSACWG(K).GT.0..OR.PRACG(K).GT.0.) THEN + IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN + + IF (T3D(K).GT.270.16) THEN + FMULT = 0. + ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16) THEN + FMULT = (270.16-T3D(K))/2. + ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16) THEN + FMULT = (T3D(K)-265.16)/3. + ELSE IF (T3D(K).LT.265.16) THEN + FMULT = 0. + END IF + +! 1000 IS TO CONVERT FROM KG TO G + +! SPLINTERING FROM DROPLETS ACCRETED ONTO GRAUPEL + + IF (PSACWG(K).GT.0.) THEN + NMULTG(K) = 35.E4*PSACWG(K)*FMULT*1000. + QMULTG(K) = NMULTG(K)*MMULT + +! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS +! THAN WAS RIMED ONTO GRAUPEL + + QMULTG(K) = MIN(QMULTG(K),PSACWG(K)) + PSACWG(K) = PSACWG(K)-QMULTG(K) + + END IF + +! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS + + IF (PRACG(K).GT.0.) THEN + NMULTRG(K) = 35.E4*PRACG(K)*FMULT*1000. + QMULTRG(K) = NMULTRG(K)*MMULT + +! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS +! THAN WAS RIMED ONTO GRAUPEL + + QMULTRG(K) = MIN(QMULTRG(K),PRACG(K)) + PRACG(K) = PRACG(K)-QMULTRG(K) + + END IF + + END IF + END IF + END IF + END IF +! END IF + +!........................................................................ +! CONVERSION OF RIMED CLOUD WATER ONTO SNOW TO GRAUPEL +! ASSUME CONVERTED SNOW FORMS GRAUPEL NOT HAIL +! HAIL ASSUMED TO ONLY FORM BY FREEZING OF RAIN +! OR COLLISIONS OF RAIN WITH CLOUD ICE + +! V1.3 +! V1.5 +! IF (IHAIL.EQ.0) THEN + IF (PSACWS(K).GT.0.) THEN +! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QC > 0.5 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984) + IF (QNI3D(K).GE.0.1E-3.AND.QC3D(K).GE.0.5E-3) THEN + +! PORTION OF RIMING CONVERTED TO GRAUPEL (REISNER ET AL. 1998, ORIGINALLY IS1991) + PGSACW(K) = MIN(PSACWS(K),CONS17*DT*N0S(K)*QC3D(K)*QC3D(K)* & + ASN(K)*ASN(K)/ & + (RHO(K)*LAMS(K)**(2.*BS+2.))) + +! MIX RAT CONVERTED INTO GRAUPEL AS EMBRYO (REISNER ET AL. 1998, ORIG M1990) + DUM = MAX(RHOSN/(RHOG-RHOSN)*PGSACW(K),0.) + +! NUMBER CONCENTRAITON OF EMBRYO GRAUPEL FROM RIMING OF SNOW + NSCNG(K) = DUM/MG0*RHO(K) +! LIMIT MAX NUMBER CONVERTED TO SNOW NUMBER + NSCNG(K) = MIN(NSCNG(K),NS3D(K)/DT) + +! PORTION OF RIMING LEFT FOR SNOW + PSACWS(K) = PSACWS(K) - PGSACW(K) + END IF + END IF + +! CONVERSION OF RIMED RAINWATER ONTO SNOW CONVERTED TO GRAUPEL + + IF (PRACS(K).GT.0.) THEN +! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QR > 0.1 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984) + IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN +! PORTION OF COLLECTED RAINWATER CONVERTED TO GRAUPEL (REISNER ET AL. 1998) + DUM = CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3 & + /(CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3+ & + CONS19*(4./LAMR(K))**3*(4./LAMR(K))**3) + DUM=MIN(DUM,1.) + DUM=MAX(DUM,0.) + PGRACS(K) = (1.-DUM)*PRACS(K) + NGRACS(K) = (1.-DUM)*NPRACS(K) +! LIMIT MAX NUMBER CONVERTED TO MIN OF EITHER RAIN OR SNOW NUMBER CONCENTRATION + NGRACS(K) = MIN(NGRACS(K),NR3D(K)/DT) + NGRACS(K) = MIN(NGRACS(K),NS3D(K)/DT) + +! AMOUNT LEFT FOR SNOW PRODUCTION + PRACS(K) = PRACS(K) - PGRACS(K) + NPRACS(K) = NPRACS(K) - NGRACS(K) +! CONVERSION TO GRAUPEL DUE TO COLLECTION OF SNOW BY RAIN + PSACR(K)=PSACR(K)*(1.-DUM) + END IF + END IF +! END IF + +!....................................................................... +! FREEZING OF RAIN DROPS +! FREEZING ALLOWED BELOW -4 C + + IF (T3D(K).LT.269.15.AND.QR3D(K).GE.QSMALL) THEN + +! IMMERSION FREEZING (BIGG 1953) + MNUCCR(K) = CONS20*NR3D(K)*EXP(AIMM*(TMELT-T3D(K)))/LAMR(K)**3 & + /LAMR(K)**3 + + NNUCCR(K) = PI*NR3D(K)*BIMM*EXP(AIMM*(TMELT-T3D(K)))/LAMR(K)**3 + +! PREVENT DIVERGENCE BETWEEN MIXING RATIO AND NUMBER CONC + NNUCCR(K) = MIN(NNUCCR(K),NR3D(K)/DT) + + END IF + +!....................................................................... +! ACCRETION OF CLOUD LIQUID WATER BY RAIN +! CONTINUOUS COLLECTION EQUATION WITH +! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED + + IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN + +! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM +! KHAIROUTDINOV AND KOGAN 2000, MWR + + IF (IRAIN.EQ.0) THEN + + DUM=(QC3D(K)*QR3D(K)) + PRA(K) = 67.*(DUM)**1.15 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRA(K)=PRA(K) * accre_enhan(K)*gamma(RELVAR(K)+1.15)/(gamma(RELVAR(K))*RELVAR(K)**1.15) + PRA(K) = PRA(K) /(max(CLDMAXR(K), cloud_frac_thresh))**1.15 ! PRA = (QC3D/CFL3D * QR3D/CLDMAXR * CFL3D)**1.15 + end if +#endif + NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K)) + + ELSE IF (IRAIN.EQ.1) THEN + +! v1.4 +! seifert and beheng (2001) formulation + + dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) + dum1 = (dum/(dum+5.e-4))**4 + pra(k) = 5.78e3*rho(k)/1000.*qc3d(k)*qr3d(k)*dum1 + npra(k) = pra(k)*rho(k)/1000.*(nc3d(k)*rho(k)/1.e6)/ & + (qc3d(k)*rho(k)/1000.)*1.e6/rho(k) + + END IF + END IF +!....................................................................... +! SELF-COLLECTION OF RAIN DROPS +! FROM BEHENG(1994) +! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION +! AS DESCRINED ABOVE FOR AUTOCONVERSION + +! v1.4 replace with seifert and beheng (2001) + + IF (QR3D(K).GE.1.E-8) THEN +! include breakup add 10/09/09 + dum1=300.e-6 + if (1./lamr(k).lt.dum1) then + dum=1. + else if (1./lamr(k).ge.dum1) then + dum=2.-exp(2300.*(1./lamr(k)-dum1)) + end if +! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K) + NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K) + END IF + +!....................................................................... +! AUTOCONVERSION OF CLOUD ICE TO SNOW +! FOLLOWING HARRINGTON ET AL. (1995) WITH MODIFICATION +! HERE IT IS ASSUMED THAT AUTOCONVERSION CAN ONLY OCCUR WHEN THE +! ICE IS GROWING, I.E. IN CONDITIONS OF ICE SUPERSATURATION +#ifndef CLUBB_CRM + IF (QI3D(K).GE.1.E-8 .AND.QVQVSI(K).GE.1.) THEN + +! COFFI = 2./LAMI(K) +! IF (COFFI.GE.DCS) THEN + NPRCI(K) = CONS21*(QV3D(K)-QVI(K))*RHO(K) & + *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) + PRCI(K) = CONS22*NPRCI(K) + NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) + +! END IF + END IF +#else + IF(.not.doclubb_gridmean) THEN + IF (QI3D(K).GE.1.E-8 .AND.QVQVSI(K).GE.1.) THEN + +! COFFI = 2./LAMI(K) +! IF (COFFI.GE.DCS) THEN + NPRCI(K) = CONS21*(QV3D(K)-QVI(K))*RHO(K) & + *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) + PRCI(K) = CONS22*NPRCI(K) + NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) + +! END IF + END IF + ELSE ! doclubb_gridmean + IF (QI3D(K).GE.1.E-8) THEN +! inside liquid clouds, using QVS + NPRCI(k) = CONS21*(QVS(K)-QVI(K))*RHO(K) & + *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) * CFL3D(K) +! outside liquid clouds, using ambient QV3D + IF(QVQVSI(K).GE.1.) THEN + NPRCI(k) = NPRCI(k) + CONS21*(QV3D(K)-QVI(K))*RHO(K) & + *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) * (CFI3D(K)-CFL3D(K)) + ENDIF + NPRCI(K) = NPRCI(K)/max(CFI3D(K), cloud_frac_thresh) + PRCI(K) = CONS22*NPRCI(K) + NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) + END IF + END IF +#endif + +!....................................................................... +! ACCRETION OF CLOUD ICE BY SNOW +! FOR THIS CALCULATION, IT IS ASSUMED THAT THE VS >> VI +! AND DS >> DI FOR CONTINUOUS COLLECTION + + IF (QNI3D(K).GE.1.E-8 .AND. QI3D(K).GE.QSMALL) THEN + PRAI(K) = CONS23*ASN(K)*QI3D(K)*RHO(K)*N0S(K)/ & + LAMS(K)**(BS+3.) + NPRAI(K) = CONS23*ASN(K)*NI3D(K)* & + RHO(K)*N0S(K)/ & + LAMS(K)**(BS+3.) + NPRAI(K)=MIN(NPRAI(K),NI3D(K)/DT) + END IF + +!....................................................................... +! HM, ADD 12/13/06, COLLISION OF RAIN AND ICE TO PRODUCE SNOW OR GRAUPEL +! FOLLOWS REISNER ET AL. 1998 +! ASSUMED FALLSPEED AND SIZE OF ICE CRYSTAL << THAN FOR RAIN + + IF (QR3D(K).GE.1.E-8.AND.QI3D(K).GE.1.E-8.AND.T3D(K).LE.TMELT) THEN + +! ALLOW GRAUPEL FORMATION FROM RAIN-ICE COLLISIONS ONLY IF RAIN MIXING RATIO > 0.1 G/KG, +! OTHERWISE ADD TO SNOW + + IF (QR3D(K).GE.0.1E-3) THEN + NIACR(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) & + /LAMR(K)**(BR+3.)*RHO(K) + PIACR(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) & + /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K) + PRACI(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ & + LAMR(K)**(BR+3.)*RHO(K) + NIACR(K)=MIN(NIACR(K),NR3D(K)/DT) + NIACR(K)=MIN(NIACR(K),NI3D(K)/DT) + ELSE + NIACRS(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) & + /LAMR(K)**(BR+3.)*RHO(K) + PIACRS(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) & + /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K) + PRACIS(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ & + LAMR(K)**(BR+3.)*RHO(K) + NIACRS(K)=MIN(NIACRS(K),NR3D(K)/DT) + NIACRS(K)=MIN(NIACRS(K),NI3D(K)/DT) + END IF + END IF + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! NUCLEATION OF CLOUD ICE FROM HOMOGENEOUS AND HETEROGENEOUS FREEZING ON AEROSOL + + IF (INUC.EQ.0) THEN + +! FREEZING OF AEROSOL ONLY ALLOWED BELOW -5 C +! AND ABOVE DELIQUESCENCE THRESHOLD OF 80% +! AND ABOVE ICE SATURATION + +! add threshold according to Greg Thomspon + + if ((QVQVS(K).GE.0.999.and.T3D(K).le.265.15).or. & + QVQVSI(K).ge.1.08) then + +! hm, modify dec. 5, 2006, replace with cooper curve + kc2 = 0.005*exp(0.304*(TMELT-T3D(K)))*1000. ! convert from L-1 to m-3 +! limit to 500 L-1 + kc2 = min(kc2,500.e3) + kc2=MAX(kc2/rho(k),0.) ! convert to kg-1 + + IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN + NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT + MNUCCD(K) = NNUCCD(K)*MI0 + END IF + + END IF + + ELSE IF (INUC.EQ.1) THEN + + IF (T3D(K).LT.TMELT.AND.QVQVSI(K).GT.1.) THEN + + KC2 = 0.16*1000./RHO(K) ! CONVERT FROM L-1 TO KG-1 + IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN + NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT + MNUCCD(K) = NNUCCD(K)*MI0 + END IF + END IF + + END IF + +#ifdef CLUBB_CRM +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! For the case of clex9_oct14, we need to decrease the ice ! +! nucleation in order for the cloud to persist for realistic ! +! lengths. It is suggested to reduce by a factor of 100 ! +! This coefficent can be changed in subroutine init_microphys ! +! in the microphys_driver subroutine. ! +! ! + NNUCCD(K)=NNUCCD(K)*NNUCCD_REDUCE_COEF +! +! Change made by Marc Pilon on 11/16/11 ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +#endif /* CLUBB_CRM */ + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + 101 CONTINUE + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! CALCULATE EVAP/SUB/DEP TERMS FOR QI,QNI,QR + +! NO VENTILATION FOR CLOUD ICE + + IF (QI3D(K).GE.QSMALL) THEN + + EPSI = 2.*PI*N0I(K)*RHO(K)*DV(K)/(LAMI(K)*LAMI(K)) + + ELSE + EPSI = 0. + END IF + + IF (QNI3D(K).GE.QSMALL) THEN + EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)* & + (F1S/(LAMS(K)*LAMS(K))+ & + F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS10/ & + (LAMS(K)**CONS35)) + ELSE + EPSS = 0. + END IF + + IF (QG3D(K).GE.QSMALL) THEN + EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)* & + (F1S/(LAMG(K)*LAMG(K))+ & + F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS11/ & + (LAMG(K)**CONS36)) + + + ELSE + EPSG = 0. + END IF + + IF (QR3D(K).GE.QSMALL) THEN + EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)* & + (F1R/(LAMR(K)*LAMR(K))+ & + F2R*(ARN(K)*RHO(K)/MU(K))**0.5* & + SC(K)**(1./3.)*CONS9/ & + (LAMR(K)**CONS34)) + ELSE + EPSR = 0. + END IF + +! ONLY INCLUDE REGION OF ICE SIZE DIST < DCS +! DUM IS FRACTION OF D*N(D) < DCS + +! LOGIC BELOW FOLLOWS THAT OF HARRINGTON ET AL. 1995 (JAS) + IF (QI3D(K).GE.QSMALL) THEN + DUM=(1.-EXP(-LAMI(K)*DCS)*(1.+LAMI(K)*DCS)) + PRD(K) = EPSI*(QV3D(K)-QVI(K))/ABI(K)*DUM +#ifdef CLUBB_CRM + if(doclubb_gridmean) then +! For ice clouds outside liquid clouds, using ambient QV + PRD(K) = PRD(K) * (CFI3D(K)-CFL3D(K)) +! For ice clouds inside liquid clouds, using saturation vapor pressure over liquid + PRD(K) = PRD(K) + EPSI*(QVS(K)-QVI(K))/ABI(K)*DUM * CFL3D(K) + PRD(K) = PRD(K) / max(CFI3D(K), cloud_frac_thresh) + end if +#endif + ELSE + DUM=0. + END IF +! ADD DEPOSITION IN TAIL OF ICE SIZE DIST TO SNOW IF SNOW IS PRESENT + IF (QNI3D(K).GE.QSMALL) THEN + PRDS(K) = EPSS*(QV3D(K)-QVI(K))/ABI(K)+ & + EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRDS(K) = (EPSS*(QV3D(K)-QVI(K))/ABI(K)*(CLDMAXALL(K)-CFL3D(K))+ & + EPSS*(QVS(K)-QVI(K))/ABI(K) * CFL3D(K))/max(CLDMAXALL(K), cloud_frac_thresh) & + + (EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM)*(CFI3D(K)-CFL3D(K))+ & + EPSI*(QVS(K)-QVI(K))/ABI(K)*(1.-DUM)*CFL3D(K))/max(CFI3D(K), cloud_frac_thresh) + end if +#endif +! OTHERWISE ADD TO CLOUD ICE + ELSE +#ifndef CLUBB_CRM + PRD(K) = PRD(K)+EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) +#else + if(.not.doclubb_gridmean) then + PRD(K) = PRD(K)+EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) + else + PRD(K) = PRD(K)+(EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) * (CFI3D(K) - CFL3D(K)) & + + EPSI*(QVS(K)-QVI(K))/ABI(K)*(1.-DUM) * CFL3D(K))/max(CFI3D(K), cloud_frac_thresh) + end if +#endif + END IF + +! VAPOR DPEOSITION ON GRAUPEL + PRDG(K) = EPSG*(QV3D(K)-QVI(K))/ABI(K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then +! For graupel outside liquid clouds, using ambient QV + PRDG(K) = PRDG(K)*(CLDMAXALL(K)-CFL3D(K)) +! For graueple insdie liquid clouds, using QVS + PRDG(K) = PRDG(K) + EPSG*(QVS(K)-QVI(K))/ABI(K) * CFL3D(K) + PRDG(K) = PRDG(K) / max(CLDMAXALL(K), cloud_frac_thresh) + end if +#endif + +! NO CONDENSATION ONTO RAIN, ONLY EVAP + + IF (QV3D(K).LT.QVS(K)) THEN + PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K) + PRE(K) = MIN(PRE(K),0.) + ELSE + PRE(K) = 0. + END IF + +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + PRE(K) = PRE(K) * max(CLDMAXR(K)-CFL3D(K), 0.0)/max(CLDMAXR(K), cloud_frac_thresh) + if(CFL3D(K).gt.0.10) then ! when there is enough liquid present, + ! no evaporation of rain is allowed + PRE(K) = 0.0 + end if + + end if +#endif + +! MAKE SURE NOT PUSHED INTO ICE SUPERSAT/SUBSAT +! FORMULA FROM REISNER 2 SCHEME + + DUM = (QV3D(K)-QVI(K))/DT + + FUDGEF = 0.9999 + SUM_DEP = PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) + + IF( (DUM.GT.0. .AND. SUM_DEP.GT.DUM*FUDGEF) .OR. & + (DUM.LT.0. .AND. SUM_DEP.LT.DUM*FUDGEF) ) THEN + MNUCCD(K) = FUDGEF*MNUCCD(K)*DUM/SUM_DEP + PRD(K) = FUDGEF*PRD(K)*DUM/SUM_DEP + PRDS(K) = FUDGEF*PRDS(K)*DUM/SUM_DEP + PRDG(K) = FUDGEF*PRDG(K)*DUM/SUM_DEP + ENDIF + +! IF CLOUD ICE/SNOW/GRAUPEL VAP DEPOSITION IS NEG, THEN ASSIGN TO SUBLIMATION PROCESSES + + IF (PRD(K).LT.0.) THEN + EPRD(K)=PRD(K) + PRD(K)=0. + END IF + IF (PRDS(K).LT.0.) THEN + EPRDS(K)=PRDS(K) + PRDS(K)=0. + END IF + IF (PRDG(K).LT.0.) THEN + EPRDG(K)=PRDG(K) + PRDG(K)=0. + END IF + +!....................................................................... +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +! CONSERVATION OF WATER +! THIS IS ADOPTED LOOSELY FROM MM5 RESINER CODE. HOWEVER, HERE WE +! ONLY ADJUST PROCESSES THAT ARE NEGATIVE, RATHER THAN ALL PROCESSES. +! THIS SECTION IS SEPARATED INTO TWO PARTS, IF T < 0 C, T > 0 C +! DUE TO DIFFERENT PROCESSES THAT ACT DEPENDING ON FREEZING/ABOVE FREEZING + +! IF MIXING RATIOS LESS THAN QSMALL, THEN NO DEPLETION OF WATER +! THROUGH MICROPHYSICAL PROCESSES, SKIP CONSERVATION + +! NOTE: CONSERVATION CHECK NOT APPLIED TO NUMBER CONCENTRATION SPECIES. ADDITIONAL CATCH +! BELOW WILL PREVENT NEGATIVE NUMBER CONCENTRATION +! FOR EACH MICROPHYSICAL PROCESS WHICH PROVIDES A SOURCE FOR NUMBER, THERE IS A CHECK +! TO MAKE SURE THAT CAN'T EXCEED TOTAL NUMBER OF DEPLETED SPECIES WITH THE TIME +! STEP + +!****SENSITIVITY - NO ICE + + IF (ILIQ.EQ.1) THEN + MNUCCC(K)=0. + NNUCCC(K)=0. + MNUCCR(K)=0. + NNUCCR(K)=0. + MNUCCD(K)=0. + NNUCCD(K)=0. + END IF + +! ****SENSITIVITY - NO GRAUPEL + IF (IGRAUP.EQ.1) THEN + PRACG(K) = 0. + PSACR(K) = 0. + PSACWG(K) = 0. + PGSACW(K) = 0. + PGRACS(K) = 0. + PRDG(K) = 0. + EPRDG(K) = 0. + EVPMG(K) = 0. + PGMLT(K) = 0. + NPRACG(K) = 0. + NPSACWG(K) = 0. + NSCNG(K) = 0. + NGRACS(K) = 0. + NSUBG(K) = 0. + NGMLTG(K) = 0. + NGMLTR(K) = 0. +! fix 053011 + PIACRS(K)=PIACRS(K)+PIACR(K) + PIACR(K) = 0. + END IF + +! CONSERVATION OF QC + + DUM = (PRC(K)+PRA(K)+MNUCCC(K)+PSACWS(K)+PSACWI(K)+QMULTS(K)+PSACWG(K)+PGSACW(K)+QMULTG(K))*DT + + IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN + RATIO = QC3D(K)/DUM + + PRC(K) = PRC(K)*RATIO + PRA(K) = PRA(K)*RATIO + MNUCCC(K) = MNUCCC(K)*RATIO + PSACWS(K) = PSACWS(K)*RATIO + PSACWI(K) = PSACWI(K)*RATIO + QMULTS(K) = QMULTS(K)*RATIO + QMULTG(K) = QMULTG(K)*RATIO + PSACWG(K) = PSACWG(K)*RATIO + PGSACW(K) = PGSACW(K)*RATIO + END IF + +! CONSERVATION OF QI + + DUM = (-PRD(K)-MNUCCC(K)+PRCI(K)+PRAI(K)-QMULTS(K)-QMULTG(K)-QMULTR(K)-QMULTRG(K) & + -MNUCCD(K)+PRACI(K)+PRACIS(K)-EPRD(K)-PSACWI(K))*DT + + IF (DUM.GT.QI3D(K).AND.QI3D(K).GE.QSMALL) THEN + + RATIO = (QI3D(K)/DT+PRD(K)+MNUCCC(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+ & + MNUCCD(K)+PSACWI(K))/ & + (PRCI(K)+PRAI(K)+PRACI(K)+PRACIS(K)-EPRD(K)) + + PRCI(K) = PRCI(K)*RATIO + PRAI(K) = PRAI(K)*RATIO + PRACI(K) = PRACI(K)*RATIO + PRACIS(K) = PRACIS(K)*RATIO + EPRD(K) = EPRD(K)*RATIO + + END IF + +! CONSERVATION OF QR + + DUM=((PRACS(K)-PRE(K))+(QMULTR(K)+QMULTRG(K)-PRC(K))+(MNUCCR(K)-PRA(K))+ & + PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K))*DT + + IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN + + RATIO = (QR3D(K)/DT+PRC(K)+PRA(K))/ & + (-PRE(K)+QMULTR(K)+QMULTRG(K)+PRACS(K)+MNUCCR(K)+PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K)) + + PRE(K) = PRE(K)*RATIO + PRACS(K) = PRACS(K)*RATIO + QMULTR(K) = QMULTR(K)*RATIO + QMULTRG(K) = QMULTRG(K)*RATIO + MNUCCR(K) = MNUCCR(K)*RATIO + PIACR(K) = PIACR(K)*RATIO + PIACRS(K) = PIACRS(K)*RATIO + PGRACS(K) = PGRACS(K)*RATIO + PRACG(K) = PRACG(K)*RATIO + + END IF + +! CONSERVATION OF QNI +! CONSERVATION FOR GRAUPEL SCHEME + + IF (IGRAUP.EQ.0) THEN + + DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K))*DT + + IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN + + RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K))/(-EPRDS(K)+PSACR(K)) + + EPRDS(K) = EPRDS(K)*RATIO + PSACR(K) = PSACR(K)*RATIO + + END IF + +! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW + ELSE IF (IGRAUP.EQ.1) THEN + + DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K)-MNUCCR(K))*DT + + IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN + + RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K))/(-EPRDS(K)+PSACR(K)) + + EPRDS(K) = EPRDS(K)*RATIO + PSACR(K) = PSACR(K)*RATIO + + END IF + + END IF + +! CONSERVATION OF QG + + DUM = (-PSACWG(K)-PRACG(K)-PGSACW(K)-PGRACS(K)-PRDG(K)-MNUCCR(K)-EPRDG(K)-PIACR(K)-PRACI(K)-PSACR(K))*DT + + IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN + + RATIO = (QG3D(K)/DT+PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PRDG(K)+MNUCCR(K)+PSACR(K)+& + PIACR(K)+PRACI(K))/(-EPRDG(K)) + + EPRDG(K) = EPRDG(K)*RATIO + + END IF + +! TENDENCIES + + QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-PRD(K)-PRDS(K)-MNUCCD(K)-EPRD(K)-EPRDS(K)-PRDG(K)-EPRDG(K)) + +! BUG FIX HM, 3/1/11, INCLUDE PIACR AND PIACRS + T3DTEN(K) = T3DTEN(K)+(PRE(K) & + *XXLV(K)+(PRD(K)+PRDS(K)+ & + MNUCCD(K)+EPRD(K)+EPRDS(K)+PRDG(K)+EPRDG(K))*XXLS(K)+ & + (PSACWS(K)+PSACWI(K)+MNUCCC(K)+MNUCCR(K)+ & + QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+PRACS(K) & + +PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PIACR(K)+PIACRS(K))*XLF(K))/CPM(K) + + QC3DTEN(K) = QC3DTEN(K)+ & + (-PRA(K)-PRC(K)-MNUCCC(K)+PCC(K)- & + PSACWS(K)-PSACWI(K)-QMULTS(K)-QMULTG(K)-PSACWG(K)-PGSACW(K)) + QI3DTEN(K) = QI3DTEN(K)+ & + (PRD(K)+EPRD(K)+PSACWI(K)+MNUCCC(K)-PRCI(K)- & + PRAI(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+MNUCCD(K)-PRACI(K)-PRACIS(K)) + QR3DTEN(K) = QR3DTEN(K)+ & + (PRE(K)+PRA(K)+PRC(K)-PRACS(K)-MNUCCR(K)-QMULTR(K)-QMULTRG(K) & + -PIACR(K)-PIACRS(K)-PRACG(K)-PGRACS(K)) + + IF (IGRAUP.EQ.0) THEN + + QNI3DTEN(K) = QNI3DTEN(K)+ & + (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K)) + NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K)) + QG3DTEN(K) = QG3DTEN(K)+(PRACG(K)+PSACWG(K)+PGSACW(K)+PGRACS(K)+ & + PRDG(K)+EPRDG(K)+MNUCCR(K)+PIACR(K)+PRACI(K)+PSACR(K)) + NG3DTEN(K) = NG3DTEN(K)+(NSCNG(K)+NGRACS(K)+NNUCCR(K)+NIACR(K)) + +! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW + ELSE IF (IGRAUP.EQ.1) THEN + + QNI3DTEN(K) = QNI3DTEN(K)+ & + (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K)) + NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K)+NNUCCR(K)) + + END IF + + NC3DTEN(K) = NC3DTEN(K)+(-NNUCCC(K)-NPSACWS(K) & + -NPRA(K)-NPRC(K)-NPSACWI(K)-NPSACWG(K)) + + NI3DTEN(K) = NI3DTEN(K)+ & + (NNUCCC(K)-NPRCI(K)-NPRAI(K)+NMULTS(K)+NMULTG(K)+NMULTR(K)+NMULTRG(K)+ & + NNUCCD(K)-NIACR(K)-NIACRS(K)) + + NR3DTEN(K) = NR3DTEN(K)+(NPRC1(K)-NPRACS(K)-NNUCCR(K) & + +NRAGG(K)-NIACR(K)-NIACRS(K)-NPRACG(K)-NGRACS(K)) + +! V1.3 move code below to before saturation adjustment + IF (EPRD(K).LT.0.) THEN + DUM = EPRD(K)*DT/QI3D(K) + DUM = MAX(-1.,DUM) + NSUBI(K) = DUM*NI3D(K)/DT + END IF + IF (EPRDS(K).LT.0.) THEN + DUM = EPRDS(K)*DT/QNI3D(K) + DUM = MAX(-1.,DUM) + NSUBS(K) = DUM*NS3D(K)/DT + END IF + IF (PRE(K).LT.0.) THEN + DUM = PRE(K)*DT/QR3D(K) + DUM = MAX(-1.,DUM) + NSUBR(K) = DUM*NR3D(K)/DT + END IF + IF (EPRDG(K).LT.0.) THEN + DUM = EPRDG(K)*DT/QG3D(K) + DUM = MAX(-1.,DUM) + NSUBG(K) = DUM*NG3D(K)/DT + END IF + +! nsubr(k)=0. +! nsubs(k)=0. +! nsubg(k)=0. + + NI3DTEN(K) = NI3DTEN(K)+NSUBI(K) + NS3DTEN(K) = NS3DTEN(K)+NSUBS(K) + NG3DTEN(K) = NG3DTEN(K)+NSUBG(K) + NR3DTEN(K) = NR3DTEN(K)+NSUBR(K) +#ifdef ECPP +! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC + C2PREC(K) = PRA(K)+PRC(K)+PSACWS(K)+QMULTS(K)+QMULTG(K)+PSACWG(K)+ & + PGSACW(K)+MNUCCC(K)+PSACWI(K) + if(QC3D(K).gt.1.0e-10) then + QSINK(K) = min(1.0, C2PREC(K)/QC3D(K)) + else + QSINK(K) = 0.0 + end if +#endif /*ECPP*/ + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + IF(ISATADJ.EQ.0) THEN !PB 4/13/09 + +! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE +! WATER SATURATION + + DUMT = T3D(K)+DT*T3DTEN(K) + DUMQV = QV3D(K)+DT*QV3DTEN(K) +! hm, add fix for low pressure, 5/12/10 + dum=min(0.99*pres(k),POLYSVP(DUMT,0)) + DUMQSS = EP_2*dum/(PRES(K)-dum) + DUMQC = QC3D(K)+DT*QC3DTEN(K) + DUMQC = MAX(DUMQC,0.) + +! SATURATION ADJUSTMENT FOR LIQUID + + DUMS = DUMQV-DUMQSS + PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT +! IF (PCC(K)*DT+DUMQC.LT.0.) THEN +! PCC(K) = -DUMQC/DT +! END IF +!+++mhwang + IF (PCC(K)*DT+QC3D(K)+DT*QC3DTEN(K).LT.0.) THEN + PCC(K) = -(QC3D(K)+DT*QC3DTEN(K))/DT + END IF +!---mhwang + + QV3DTEN(K) = QV3DTEN(K)-PCC(K) + T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K) + QC3DTEN(K) = QC3DTEN(K)+PCC(K) + + END IF + +! hm 7/26/11, new output + + aut1d(k)=prc(k) + acc1d(k)=pra(k) + evpr1d(k)=-PRE(K) + if (pcc(k).lt.0.) then + evpc1d(k)=-pcc(k) + else if (pcc(k).gt.0.) then + con1d(k)=pcc(k) + end if + sub1d(k)=-EPRD(K)-EPRDS(K)-EPRDG(K) + dep1d(k)=PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) +!....................................................................... +! ACTIVATION OF CLOUD DROPLETS + +!bloss: only do activation if droplet number is predicted +!bloss IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN + IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL.AND.INUM.EQ.0) THEN + +! EFFECTIVE VERTICAL VELOCITY (M/S) + + IF (ISUB.EQ.0) THEN +! ADD SUB-GRID VERTICAL VELOCITY + DUM = W3D(K)+WVAR(K) + +! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S +#ifdef CLUBB_CRM + DUM = MAX(DUM,0.01) +#else + DUM = MAX(DUM,0.10) +#endif + + ELSE IF (ISUB.EQ.1) THEN + DUM=W3D(K) + END IF + +! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION + IF (DUM.GE.0.001) THEN + + IF (IBASE.EQ.1) THEN + +! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER +! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1) + + IDROP=0 + +! V1.3 USE CURRENT VALUE OF QC FOR IDROP + IF (QC3D(K).LE.0.05E-3/RHO(K)) THEN + IDROP=1 + END IF + IF (K.EQ.1) THEN + IDROP=1 + ELSE IF (K.GE.2) THEN + IF (QC3D(K).GT.0.05E-3/RHO(K).AND. & + QC3D(K-1).LE.0.05E-3/RHO(K-1)) THEN + IDROP=1 + END IF + END IF + + IF (IDROP.EQ.1) THEN +! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER + + IF (IACT.EQ.1) THEN +! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W +! BASED ON TWOMEY 1959 + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN +! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000) + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then + INES = 0 + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + END IF ! IACT + +!............................................................................. + ELSE IF (IDROP.EQ.0) THEN +! ACTIVATE IN CLOUD INTERIOR +! FIND EQUILIBRIUM SUPERSATURATION + + TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K)) + IF (EPSR.GT.1.E-8) THEN + TAUR=1./EPSR + ELSE + TAUR=1.E8 + END IF + IF (EPSI.GT.1.E-8) THEN + TAUI=1./EPSI + ELSE + TAUI=1.E8 + END IF + IF (EPSS.GT.1.E-8) THEN + TAUS=1./EPSS + ELSE + TAUS=1.E8 + END IF + IF (EPSG.GT.1.E-8) THEN + TAUG=1./EPSG + ELSE + TAUG=1.E8 + END IF + +! EQUILIBRIUM SS INCLUDING BERGERON EFFECT + + DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM + DUM3=(DUM3*TAUC*TAUR*TAUI*TAUS*TAUG- & + (QVS(K)-QVI(K))*(TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS))/ & + (TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS+ & + TAUR*TAUI*TAUS*TAUG+TAUC*TAUI*TAUS*TAUG) + + IF (DUM3/QVS(K).GE.1.E-6) THEN + IF (IACT.EQ.1) THEN + +! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + +! USE POWER LAW CCN SPECTRA + +! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN % + DUM3=DUM3/QVS(K)*100. + + DUM2=C1*DUM3**K1 +! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS + DUM2=MIN(DUM2,DUMACT) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN + +! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2) + +! USE LOGNORMAL AEROSOL + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + +! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION + SMAX = DUM3/QVS(K) + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) + +! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS + DUM2=MIN(DUM2,DUMACT) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then +! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION + SMAX = DUM3/QVS(K) + + INES = 1 + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + + END IF ! IACT + END IF ! DUM3/QVS > 1.E-6 + END IF ! IDROP = 1 + +!....................................................................... + ELSE IF (IBASE.EQ.2) THEN + + IF (IACT.EQ.1) THEN +! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W +! BASED ON TWOMEY 1959 + + DUM=DUM*100. ! CONVERT FROM M/S TO CM/S + DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) + DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 + DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 + + ELSE IF (IACT.EQ.2) THEN + + SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) + AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) + ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) + GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) + + GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & + (T3D(K)*RR)-1.)) + + PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT + + ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) + ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) + + SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 + SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 + + DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) + DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) + + SMAX = 1./(DUM1+DUM2)**0.5 + + UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) + UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) + DUM1 = NANEW1/2.*(1.-DERF1(UU1)) + DUM2 = NANEW2/2.*(1.-DERF1(UU2)) + + DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 + +! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL + + DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0.,DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#if (defined CRM && defined MODAL_AERO) + ELSE if (IACT.EQ.3) then + INES = 0 + CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & + DUM2, INES, SMAX, K) +#ifdef CLUBB_CRM + if(doclubb_gridmean) then + DUM2 = DUM2 * CFL3D(K) + end if +#endif + DUM2 = (DUM2-NC3D(K))/DT + DUM2 = MAX(0., DUM2) + NC3DTEN(K) = NC3DTEN(K)+DUM2 +#endif + END IF ! IACT + END IF ! IBASE + END IF ! W > 0.001 + END IF ! QC3D > QSMALL + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION +! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND +! LOSS OF NUMBER CONCENTRATION + +! IF (PCC(K).LT.0.) THEN +! DUM = PCC(K)*DT/QC3D(K) +! DUM = MAX(-1.,DUM) +! NSUBC(K) = DUM*NC3D(K)/DT +! END IF + + +! nsubr(k)=0. +! nsubs(k)=0. +! nsubg(k)=0. + + END IF !!!!!! TEMPERATURE + +! SWITCH LTRUE TO 1, SINCE HYDROMETEORS ARE PRESENT + LTRUE = 1 + + 200 CONTINUE +#ifdef CLUBB_CRM +! ADDITION BY UWM TO WEIGHT BY SGS CLOUD FRACTION + IF ( CF3D(K) > cloud_frac_thresh ) THEN + + T3D(K) = T3D_INIT + ( T3D(K) - T3D_INIT ) * CF3D(K) ! Absolute temp. + T3DTEN(K) = T3DTEN(K) * CF3D(K) ! Absolute temperature tendency + + QV3D(K) = QV_INIT + ( QV3D(K) - QSAT_INIT ) * CF3D(K) ! Vapor + QV3DTEN(K) = QV3DTEN(K) * CF3D(K) ! Vapor mix ratio time tendency + + QC3D(K) = QC3D(K) * CF3D(K) ! Cloud mix ratio + QC3DTEN(K) = QC3DTEN(K) * CF3D(K) ! Cloud mix ratio time tendency + + IF ( INUM == 0 ) THEN + NC3D(K) = NC3D(K) * CF3D(K) ! Cloud drop num conc + NC3DTEN(K) = NC3DTEN(K) * CF3D(K) ! Cloud drop num conc time tendency + END IF + + QR3D(K) = QR3D(K) * CF3D(K) ! Rain mix ratio + QR3DTEN(K) = QR3DTEN(K) * CF3D(K) ! Rain mix ratio time tendency + + NR3D(K) = NR3D(K) * CF3D(K) ! Rain num conc + NR3DTEN(K) = NR3DTEN(K) * CF3D(K) ! Rain num conc time tendency + + IF ( ILIQ == 0 ) THEN + QI3D(K) = QI3D(K) * CF3D(K) ! Ice mix ratio + QI3DTEN(K) = QI3DTEN(K) * CF3D(K) ! Ice mix ratio time tendency + + NI3D(K) = NI3D(K) * CF3D(K) ! Ice num conc + NI3DTEN(K) = NI3DTEN(K) * CF3D(K) ! Ice num conc time tendency + + QNI3D(K) = QNI3D(K) * CF3D(K) ! Snow mix ratio + QNI3DTEN(K) = QNI3DTEN(K) * CF3D(K) ! Snow mix ratio time tendency + + NS3D(K) = NS3D(K) * CF3D(K) ! Snow num conc + NS3DTEN(K) = NS3DTEN(K) * CF3D(K) ! Snow num conc time tendency + END IF + IF ( IGRAUP == 0 ) THEN + QG3D(K) = QG3D(K) * CF3D(K) ! Graupel mix ratio + QG3DTEN(K) = QG3DTEN(K) * CF3D(K) ! Graupel mix ratio time tendency + + NG3D(K) = NG3D(K) * CF3D(K) ! Graupel num conc + NG3DTEN(K) = NG3DTEN(K) * CF3D(K) ! Graupel num conc time tendency + END IF +! +++mhwang +! add individual microphysical process rates + PRC(K) = PRC(K) * CF3D(K) + PRA(K) = PRA(K) * CF3D(K) + PSMLT(K) = PSMLT(K) * CF3D(K) + EVPMS(K) = EVPMS(K) * CF3D(K) + PRACS(K) = PRACS(K) * CF3D(K) + EVPMG(K) = EVPMG(K) * CF3D(K) + PRACG(K) = PRACG(K) * CF3D(K) + PRE(K) = PRE(K) * CF3D(K) + PGMLT(K) = PGMLT(K) * CF3D(K) + + MNUCCC(K) = MNUCCC(K) * CF3D(K) + PSACWS(K) = PSACWS(K) * CF3D(K) + PSACWI(K) = PSACWI(k) * CF3D(K) + QMULTS(K) = QMULTS(K) * CF3D(K) + QMULTG(K) = QMULTG(K) * CF3D(K) + PSACWG(K) = PSACWG(K) * CF3D(K) + PGSACW(K) = PGSACW(K) * CF3D(K) + + PRD(K) = PRD(K) * CF3D(K) + PRCI(K) = PRCI(K) * CF3D(K) + PRAI(K) = PRAI(K) * CF3D(K) + QMULTR(K) = QMULTR(K) * CF3D(K) + QMULTRG(K) = QMULTRG(K) * CF3D(K) + MNUCCD(K) = MNUCCD(K) * CF3D(K) + PRACI(K) = PRACI(K) * CF3D(K) + PRACIS(K) = PRACIS(K) * CF3D(K) + EPRD(K) = EPRD(K) * CF3D(K) + + MNUCCR(K) = MNUCCR(K) * CF3D(K) + PIACR(K) = PIACR(K) * CF3D(K) + PIACRS(K) = PIACRS(K) * CF3D(K) + PGRACS(K) = PGRACS(K) * CF3D(K) + + PRDS(K) = PRDS(K) * CF3D(K) + EPRDS(K) = EPRDS(K) * CF3D(K) + PSACR(K) = PSACR(K) * CF3D(K) + + PRDG(K) = PRDG(K) * CF3D(K) + EPRDG(K) = EPRDG(K) * CF3D(K) + +! Rain drop number process rates + NPRC1(K) = NPRC1(K)* CF3D(K) + NRAGG(K) = NRAGG(K) * CF3D(K) + NPRACG(K) = NPRACG(K) * CF3D(K) + NSUBR(K) = NSUBR(K) * CF3D(K) + NSMLTR(K) = NSMLTR(K) * CF3D(K) + NGMLTR(K) = NGMLTR(K) * CF3D(K) + NPRACS(K) = NPRACS(K) * CF3D(K) + NNUCCR(K) = NNUCCR(K) * CF3D(K) + NIACR(K) = NIACR(K) * CF3D(K) + NIACRS(K) = NIACRS(K) * CF3D(K) + NGRACS(K) = NGRACS(K) * CF3D(K) + +! hm 7/26/11, new output + aut1d(k)=prc(k) + acc1d(k)=pra(k) + mlt1d(k)=-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K) + evpr1d(k)=-PRE(K)-EVPMS(K)-EVPMG(K) + if (pcc(k).lt.0.) then + evpc1d(k)=-pcc(k) + else if (pcc(k).gt.0.) then + con1d(k)=pcc(k) + end if + sub1d(k)=-EPRD(K)-EPRDS(K)-EPRDG(K) + dep1d(k)=PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) + + END IF ! CF3D(K) > 0.01 +#endif /*CLUBB_CRM*/ + + END DO + +! V1.3 move precip initialization to here +! INITIALIZE PRECIP AND SNOW RATES + + PRECRT = 0. + SNOWRT = 0. + +! IF THERE ARE NO HYDROMETEORS, THEN SKIP TO END OF SUBROUTINE + + IF (LTRUE.EQ.0) GOTO 400 + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +!....................................................................... +! CALCULATE SEDIMENATION +! THE NUMERICS HERE FOLLOW FROM REISNER ET AL. (1998) +! FALLOUT TERMS ARE CALCULATED ON SPLIT TIME STEPS TO ENSURE NUMERICAL +! STABILITY, I.E. COURANT# < 1 + +!....................................................................... + + NSTEP = 1 + +! v3 5/27/11 + DO K = KTE,KTS,-1 + + DUMI(K) = QI3D(K)+QI3DTEN(K)*DT + DUMQS(K) = QNI3D(K)+QNI3DTEN(K)*DT + DUMR(K) = QR3D(K)+QR3DTEN(K)*DT + DUMFNI(K) = NI3D(K)+NI3DTEN(K)*DT + DUMFNS(K) = NS3D(K)+NS3DTEN(K)*DT + DUMFNR(K) = NR3D(K)+NR3DTEN(K)*DT + DUMC(K) = QC3D(K)+QC3DTEN(K)*DT + DUMFNC(K) = NC3D(K)+NC3DTEN(K)*DT + DUMG(K) = QG3D(K)+QG3DTEN(K)*DT + DUMFNG(K) = NG3D(K)+NG3DTEN(K)*DT + +! SWITCH FOR CONSTANT DROPLET NUMBER + IF (INUM.EQ.1) THEN + DUMFNC(K) = NC3D(K) + END IF + +! GET DUMMY LAMDA FOR SEDIMENTATION CALCULATIONS + +! MAKE SURE NUMBER CONCENTRATIONS ARE POSITIVE + DUMFNI(K) = MAX(0.,DUMFNI(K)) + DUMFNS(K) = MAX(0.,DUMFNS(K)) + DUMFNC(K) = MAX(0.,DUMFNC(K)) + DUMFNR(K) = MAX(0.,DUMFNR(K)) + DUMFNG(K) = MAX(0.,DUMFNG(K)) + +!...................................................................... +! CLOUD ICE + + IF (DUMI(K).GE.QSMALL) THEN + DLAMI = (CONS12*DUMFNI(K)/DUMI(K))**(1./DI) + DLAMI=MAX(DLAMI,LAMMINI) + DLAMI=MIN(DLAMI,LAMMAXI) + END IF +!...................................................................... +! RAIN + + IF (DUMR(K).GE.QSMALL) THEN + DLAMR = (PI*RHOW*DUMFNR(K)/DUMR(K))**(1./3.) + DLAMR=MAX(DLAMR,LAMMINR) + DLAMR=MIN(DLAMR,LAMMAXR) + END IF +!...................................................................... +! CLOUD DROPLETS + + IF (DUMC(K).GE.QSMALL) THEN + !bloss: option for fixing pgam + if(dofix_pgam) then + pgam(k) = pgam_fixed + else + +! DUM = PRES(K)/(R*T3D(K)) +! V1.5 + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 + PGAM(K)=1./(PGAM(K)**2)-1. + PGAM(K)=MAX(PGAM(K),2.) + PGAM(K)=MIN(PGAM(K),10.) + + end if + + DLAMC = (CONS26*DUMFNC(K)*GAMMA(PGAM(K)+4.)/(DUMC(K)*GAMMA(PGAM(K)+1.)))**(1./3.) + LAMMIN = (PGAM(K)+1.)/60.E-6 + LAMMAX = (PGAM(K)+1.)/1.E-6 + DLAMC=MAX(DLAMC,LAMMIN) + DLAMC=MIN(DLAMC,LAMMAX) + END IF +!...................................................................... +! SNOW + + IF (DUMQS(K).GE.QSMALL) THEN + DLAMS = (CONS1*DUMFNS(K)/ DUMQS(K))**(1./DS) + DLAMS=MAX(DLAMS,LAMMINS) + DLAMS=MIN(DLAMS,LAMMAXS) + END IF +!...................................................................... +! GRAUPEL + + IF (DUMG(K).GE.QSMALL) THEN + DLAMG = (CONS2*DUMFNG(K)/ DUMG(K))**(1./DG) + DLAMG=MAX(DLAMG,LAMMING) + DLAMG=MIN(DLAMG,LAMMAXG) + END IF + +!...................................................................... +! CALCULATE NUMBER-WEIGHTED AND MASS-WEIGHTED TERMINAL FALL SPEEDS + +! CLOUD WATER + + IF (DUMC(K).GE.QSMALL) THEN + UNC = ACN(K)*GAMMA(1.+BC+PGAM(K))/ (DLAMC**BC*GAMMA(PGAM(K)+1.)) + UMC = ACN(K)*GAMMA(4.+BC+PGAM(K))/ (DLAMC**BC*GAMMA(PGAM(K)+4.)) + ELSE + UMC = 0. + UNC = 0. + END IF + + IF (DUMI(K).GE.QSMALL) THEN + UNI = AIN(K)*CONS27/DLAMI**BI + UMI = AIN(K)*CONS28/(DLAMI**BI) + ELSE + UMI = 0. + UNI = 0. + END IF + + IF (DUMR(K).GE.QSMALL) THEN + UNR = ARN(K)*CONS6/DLAMR**BR + UMR = ARN(K)*CONS4/(DLAMR**BR) + ELSE + UMR = 0. + UNR = 0. + END IF + + IF (DUMQS(K).GE.QSMALL) THEN + UMS = ASN(K)*CONS3/(DLAMS**BS) + UNS = ASN(K)*CONS5/DLAMS**BS + ELSE + UMS = 0. + UNS = 0. + END IF + + IF (DUMG(K).GE.QSMALL) THEN + UMG = AGN(K)*CONS7/(DLAMG**BG) + UNG = AGN(K)*CONS8/DLAMG**BG + ELSE + UMG = 0. + UNG = 0. + END IF + +! SET REALISTIC LIMITS ON FALLSPEED + +! bug fix, 10/08/09 + dum=(rhosu/rho(k))**0.54 + UMS=MIN(UMS,1.2*dum) + UNS=MIN(UNS,1.2*dum) +! v3 5/27/11 +! fix for correction by AA 4/6/11 + UMI=MIN(UMI,1.2*(rhosu/rho(k))**0.35) + UNI=MIN(UNI,1.2*(rhosu/rho(k))**0.35) + UMR=MIN(UMR,9.1*dum) + UNR=MIN(UNR,9.1*dum) + UMG=MIN(UMG,20.*dum) + UNG=MIN(UNG,20.*dum) + + FR(K) = UMR + FI(K) = UMI + FNI(K) = UNI + FS(K) = UMS + FNS(K) = UNS + FNR(K) = UNR + FC(K) = UMC + FNC(K) = UNC + FG(K) = UMG + FNG(K) = UNG + +! V3.3 MODIFY FALLSPEED BELOW LEVEL OF PRECIP + + IF (K.LE.KTE-1) THEN + IF (FR(K).LT.1.E-10) THEN + FR(K)=FR(K+1) + END IF + IF (FI(K).LT.1.E-10) THEN + FI(K)=FI(K+1) + END IF + IF (FNI(K).LT.1.E-10) THEN + FNI(K)=FNI(K+1) + END IF + IF (FS(K).LT.1.E-10) THEN + FS(K)=FS(K+1) + END IF + IF (FNS(K).LT.1.E-10) THEN + FNS(K)=FNS(K+1) + END IF + IF (FNR(K).LT.1.E-10) THEN + FNR(K)=FNR(K+1) + END IF + IF (FC(K).LT.1.E-10) THEN + FC(K)=FC(K+1) + END IF + IF (FNC(K).LT.1.E-10) THEN + FNC(K)=FNC(K+1) + END IF + IF (FG(K).LT.1.E-10) THEN + FG(K)=FG(K+1) + END IF + IF (FNG(K).LT.1.E-10) THEN + FNG(K)=FNG(K+1) + END IF + END IF ! K LE KTE-1 + +! CALCULATE NUMBER OF SPLIT TIME STEPS + + RGVM = MAX(FR(K),FI(K),FS(K),FC(K),FNI(K),FNR(K),FNS(K),FNC(K),FG(K),FNG(K)) +! VVT CHANGED IFIX -> INT (GENERIC FUNCTION) + NSTEP = MAX(INT(RGVM*DT/DZQ(K)+1.),NSTEP) + +! MULTIPLY VARIABLES BY RHO + DUMR(k) = DUMR(k)*RHO(K) + DUMI(k) = DUMI(k)*RHO(K) + DUMFNI(k) = DUMFNI(K)*RHO(K) + DUMQS(k) = DUMQS(K)*RHO(K) + DUMFNS(k) = DUMFNS(K)*RHO(K) + DUMFNR(k) = DUMFNR(K)*RHO(K) + DUMC(k) = DUMC(K)*RHO(K) + DUMFNC(k) = DUMFNC(K)*RHO(K) + DUMG(k) = DUMG(K)*RHO(K) + DUMFNG(k) = DUMFNG(K)*RHO(K) + + END DO + + DO N = 1,NSTEP + + DO K = KTS,KTE + FALOUTR(K) = FR(K)*DUMR(K) + FALOUTI(K) = FI(K)*DUMI(K) + FALOUTNI(K) = FNI(K)*DUMFNI(K) + FALOUTS(K) = FS(K)*DUMQS(K) + FALOUTNS(K) = FNS(K)*DUMFNS(K) + FALOUTNR(K) = FNR(K)*DUMFNR(K) + FALOUTC(K) = FC(K)*DUMC(K) + FALOUTNC(K) = FNC(K)*DUMFNC(K) + FALOUTG(K) = FG(K)*DUMG(K) + FALOUTNG(K) = FNG(K)*DUMFNG(K) + END DO + +! TOP OF MODEL + + K = KTE + FALTNDR = FALOUTR(K)/DZQ(k) + FALTNDI = FALOUTI(K)/DZQ(k) + FALTNDNI = FALOUTNI(K)/DZQ(k) + FALTNDS = FALOUTS(K)/DZQ(k) + FALTNDNS = FALOUTNS(K)/DZQ(k) + FALTNDNR = FALOUTNR(K)/DZQ(k) + FALTNDC = FALOUTC(K)/DZQ(k) + FALTNDNC = FALOUTNC(K)/DZQ(k) + FALTNDG = FALOUTG(K)/DZQ(k) + FALTNDNG = FALOUTNG(K)/DZQ(k) +! ADD FALLOUT TERMS TO EULERIAN TENDENCIES + + QRSTEN(K) = QRSTEN(K)-FALTNDR/NSTEP/RHO(k) + QISTEN(K) = QISTEN(K)-FALTNDI/NSTEP/RHO(k) + NI3DTEN(K) = NI3DTEN(K)-FALTNDNI/NSTEP/RHO(k) + QNISTEN(K) = QNISTEN(K)-FALTNDS/NSTEP/RHO(k) + NS3DTEN(K) = NS3DTEN(K)-FALTNDNS/NSTEP/RHO(k) + NR3DTEN(K) = NR3DTEN(K)-FALTNDNR/NSTEP/RHO(k) + QCSTEN(K) = QCSTEN(K)-FALTNDC/NSTEP/RHO(k) + NC3DTEN(K) = NC3DTEN(K)-FALTNDNC/NSTEP/RHO(k) + QGSTEN(K) = QGSTEN(K)-FALTNDG/NSTEP/RHO(k) + NG3DTEN(K) = NG3DTEN(K)-FALTNDNG/NSTEP/RHO(k) + + NISTEN(K) = NISTEN(K)-FALTNDNI/NSTEP/RHO(k) + NSSTEN(K) = NSSTEN(K)-FALTNDNS/NSTEP/RHO(k) + NRSTEN(K) = NRSTEN(K)-FALTNDNR/NSTEP/RHO(k) + NCSTEN(K) = NCSTEN(K)-FALTNDNC/NSTEP/RHO(k) + NGSTEN(K) = NGSTEN(K)-FALTNDNG/NSTEP/RHO(k) + + DUMR(K) = DUMR(K)-FALTNDR*DT/NSTEP + DUMI(K) = DUMI(K)-FALTNDI*DT/NSTEP + DUMFNI(K) = DUMFNI(K)-FALTNDNI*DT/NSTEP + DUMQS(K) = DUMQS(K)-FALTNDS*DT/NSTEP + DUMFNS(K) = DUMFNS(K)-FALTNDNS*DT/NSTEP + DUMFNR(K) = DUMFNR(K)-FALTNDNR*DT/NSTEP + DUMC(K) = DUMC(K)-FALTNDC*DT/NSTEP + DUMFNC(K) = DUMFNC(K)-FALTNDNC*DT/NSTEP + DUMG(K) = DUMG(K)-FALTNDG*DT/NSTEP + DUMFNG(K) = DUMFNG(K)-FALTNDNG*DT/NSTEP + + DO K = KTE-1,KTS,-1 + FALTNDR = (FALOUTR(K+1)-FALOUTR(K))/DZQ(K) + FALTNDI = (FALOUTI(K+1)-FALOUTI(K))/DZQ(K) + FALTNDNI = (FALOUTNI(K+1)-FALOUTNI(K))/DZQ(K) + FALTNDS = (FALOUTS(K+1)-FALOUTS(K))/DZQ(K) + FALTNDNS = (FALOUTNS(K+1)-FALOUTNS(K))/DZQ(K) + FALTNDNR = (FALOUTNR(K+1)-FALOUTNR(K))/DZQ(K) + FALTNDC = (FALOUTC(K+1)-FALOUTC(K))/DZQ(K) + FALTNDNC = (FALOUTNC(K+1)-FALOUTNC(K))/DZQ(K) + FALTNDG = (FALOUTG(K+1)-FALOUTG(K))/DZQ(K) + FALTNDNG = (FALOUTNG(K+1)-FALOUTNG(K))/DZQ(K) + +! ADD FALLOUT TERMS TO EULERIAN TENDENCIES + + QRSTEN(K) = QRSTEN(K)+FALTNDR/NSTEP/RHO(k) + QISTEN(K) = QISTEN(K)+FALTNDI/NSTEP/RHO(k) + NI3DTEN(K) = NI3DTEN(K)+FALTNDNI/NSTEP/RHO(k) + QNISTEN(K) = QNISTEN(K)+FALTNDS/NSTEP/RHO(k) + NS3DTEN(K) = NS3DTEN(K)+FALTNDNS/NSTEP/RHO(k) + NR3DTEN(K) = NR3DTEN(K)+FALTNDNR/NSTEP/RHO(k) + QCSTEN(K) = QCSTEN(K)+FALTNDC/NSTEP/RHO(k) + NC3DTEN(K) = NC3DTEN(K)+FALTNDNC/NSTEP/RHO(k) + QGSTEN(K) = QGSTEN(K)+FALTNDG/NSTEP/RHO(k) + NG3DTEN(K) = NG3DTEN(K)+FALTNDNG/NSTEP/RHO(k) + + NISTEN(K) = NISTEN(K)+FALTNDNI/NSTEP/RHO(k) + NSSTEN(K) = NSSTEN(K)+FALTNDNS/NSTEP/RHO(k) + NRSTEN(K) = NRSTEN(K)+FALTNDNR/NSTEP/RHO(k) + NCSTEN(K) = NCSTEN(K)+FALTNDNC/NSTEP/RHO(k) + NGSTEN(K) = NGSTEN(K)+FALTNDNG/NSTEP/RHO(k) + + DUMR(K) = DUMR(K)+FALTNDR*DT/NSTEP + DUMI(K) = DUMI(K)+FALTNDI*DT/NSTEP + DUMFNI(K) = DUMFNI(K)+FALTNDNI*DT/NSTEP + DUMQS(K) = DUMQS(K)+FALTNDS*DT/NSTEP + DUMFNS(K) = DUMFNS(K)+FALTNDNS*DT/NSTEP + DUMFNR(K) = DUMFNR(K)+FALTNDNR*DT/NSTEP + DUMC(K) = DUMC(K)+FALTNDC*DT/NSTEP + DUMFNC(K) = DUMFNC(K)+FALTNDNC*DT/NSTEP + DUMG(K) = DUMG(K)+FALTNDG*DT/NSTEP + DUMFNG(K) = DUMFNG(K)+FALTNDNG*DT/NSTEP + +#ifdef ECPP + RSED(K)=RSED(K)+FALOUTR(K)/NSTEP + ISED(K)=ISED(K)+FALOUTI(K)/NSTEP + CSED(K)=CSED(K)+FALOUTC(K)/NSTEP + SSED(K)=SSED(K)+FALOUTS(K)/NSTEP + GSED(K)=GSED(K)+FALOUTG(K)/NSTEP +#endif + + END DO + +! GET PRECIPITATION AND SNOWFALL ACCUMULATION DURING THE TIME STEP +! FACTOR OF 1000 CONVERTS FROM M TO MM, BUT DIVISION BY DENSITY +! OF LIQUID WATER CANCELS THIS FACTOR OF 1000 + + PRECRT = PRECRT+(FALOUTR(KTS)+FALOUTC(KTS)+FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS)) & + *DT/NSTEP + SNOWRT = SNOWRT+(FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS))*DT/NSTEP + + END DO + + DO K=KTS,KTE + +! ADD ON SEDIMENTATION TENDENCIES FOR MIXING RATIO TO REST OF TENDENCIES + + QR3DTEN(K)=QR3DTEN(K)+QRSTEN(K) + QI3DTEN(K)=QI3DTEN(K)+QISTEN(K) + QC3DTEN(K)=QC3DTEN(K)+QCSTEN(K) + QG3DTEN(K)=QG3DTEN(K)+QGSTEN(K) + QNI3DTEN(K)=QNI3DTEN(K)+QNISTEN(K) + +! PUT ALL CLOUD ICE IN SNOW CATEGORY IF MEAN DIAMETER EXCEEDS 2 * dcs + +! V1.7 +!hm 7/9/09 bug fix +! IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.273.15) THEN + IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.TMELT.AND.LAMI(K).GE.1.E-10) THEN + + IF (1./LAMI(K).GE.2.*DCS) THEN + QNI3DTEN(K) = QNI3DTEN(K)+QI3D(K)/DT+ QI3DTEN(K) + NS3DTEN(K) = NS3DTEN(K)+NI3D(K)/DT+ NI3DTEN(K) + QI3DTEN(K) = -QI3D(K)/DT + NI3DTEN(K) = -NI3D(K)/DT + END IF + END IF + +! hm add tendencies here, then call sizeparameter +! to ensure consisitency between mixing ratio and number concentration + + QC3D(k) = QC3D(k)+QC3DTEN(k)*DT + QI3D(k) = QI3D(k)+QI3DTEN(k)*DT + QNI3D(k) = QNI3D(k)+QNI3DTEN(k)*DT + QR3D(k) = QR3D(k)+QR3DTEN(k)*DT + NC3D(k) = NC3D(k)+NC3DTEN(k)*DT + NI3D(k) = NI3D(k)+NI3DTEN(k)*DT + NS3D(k) = NS3D(k)+NS3DTEN(k)*DT + NR3D(k) = NR3D(k)+NR3DTEN(k)*DT + + IF (IGRAUP.EQ.0) THEN + QG3D(k) = QG3D(k)+QG3DTEN(k)*DT + NG3D(k) = NG3D(k)+NG3DTEN(k)*DT + END IF + +! ADD TEMPERATURE AND WATER VAPOR TENDENCIES FROM MICROPHYSICS + T3D(K) = T3D(K)+T3DTEN(k)*DT + QV3D(K) = QV3D(K)+QV3DTEN(k)*DT + +! SATURATION VAPOR PRESSURE AND MIXING RATIO + +! hm, add fix for low pressure, 5/12/10 + EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0)) ! PA + EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1)) ! PA + +! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING + + IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K) + + QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K)) + QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K)) + + QVQVS(K) = QV3D(K)/QVS(K) + QVQVSI(K) = QV3D(K)/QVI(K) + +! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER + +! V1.3, change limit from 10^-7 to 10^-6 +! V1.7 7/9/09 change limit from 10^-6 to 10^-8 + + IF (QVQVS(K).LT.0.9) THEN + IF (QR3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QR3D(K) + T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) + QR3D(K)=0. + END IF + IF (QC3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QC3D(K) + T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) + QC3D(K)=0. + END IF + END IF + + IF (QVQVSI(K).LT.0.9) THEN + IF (QI3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QI3D(K) + T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) + QI3D(K)=0. + END IF + IF (QNI3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QNI3D(K) + T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) + QNI3D(K)=0. + END IF + IF (QG3D(K).LT.1.E-8) THEN + QV3D(K)=QV3D(K)+QG3D(K) + T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) + QG3D(K)=0. + END IF + END IF + +!.................................................................. +! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO + + IF (QC3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QC3D(K) + T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) +!---mhwang + QC3D(K) = 0. + NC3D(K) = 0. + EFFC(K) = 0. + END IF + IF (QR3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QR3D(K) + T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) +!---mhwang + QR3D(K) = 0. + NR3D(K) = 0. + EFFR(K) = 0. + END IF + IF (QI3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QI3D(K) + T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QI3D(K) = 0. + NI3D(K) = 0. + EFFI(K) = 0. + END IF + IF (QNI3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QNI3D(K) + T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QNI3D(K) = 0. + NS3D(K) = 0. + EFFS(K) = 0. + END IF + IF (QG3D(K).LT.QSMALL) THEN +!+++mhwang + QV3D(K)=QV3D(K)+QG3D(K) + T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) +!+++mhwang + QG3D(K) = 0. + NG3D(K) = 0. + EFFG(K) = 0. + END IF + +!.................................. +! IF THERE IS NO CLOUD/PRECIP WATER, THEN SKIP CALCULATIONS + + IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL & + .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) GOTO 500 + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! CALCULATE INSTANTANEOUS PROCESSES + +! ADD MELTING OF CLOUD ICE TO FORM RAIN + + IF (QI3D(K).GE.QSMALL.AND.T3D(K).GE.TMELT) THEN + QR3D(K) = QR3D(K)+QI3D(K) + T3D(K) = T3D(K)-QI3D(K)*XLF(K)/CPM(K) +! hm 7/26/11, new output + mlt1d(k)=mlt1d(k)+qi3d(k)/dt + QI3D(K) = 0. + NR3D(K) = NR3D(K)+NI3D(K) + NI3D(K) = 0. + END IF + +! ****SENSITIVITY - NO ICE + IF (ILIQ.EQ.1) GOTO 778 + +! HOMOGENEOUS FREEZING OF CLOUD WATER + + IF (T3D(K).LE.233.15.AND.QC3D(K).GE.QSMALL) THEN + QI3D(K)=QI3D(K)+QC3D(K) + T3D(K)=T3D(K)+QC3D(K)*XLF(K)/CPM(K) + QC3D(K)=0. +#ifdef CLUBB_CRM +!+++mhwang test how SAM_CLUBB sensitive to this + NI3D(K)=NI3D(K)+NC3D(K) * NNUCCC_REDUCE_COEF ! +#else + NI3D(K)=NI3D(K)+NC3D(K) +#endif + NC3D(K)=0. + END IF + +! HOMOGENEOUS FREEZING OF RAIN + + IF (IGRAUP.EQ.0) THEN + + IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN + QG3D(K) = QG3D(K)+QR3D(K) + T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K) + QR3D(K) = 0. + NG3D(K) = NG3D(K)+ NR3D(K) + NR3D(K) = 0. + END IF + + ELSE IF (IGRAUP.EQ.1) THEN + + IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN + QNI3D(K) = QNI3D(K)+QR3D(K) + T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K) + QR3D(K) = 0. + NS3D(K) = NS3D(K)+NR3D(K) + NR3D(K) = 0. + END IF + + END IF + + 778 CONTINUE + +! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE + + NI3D(K) = MAX(0.,NI3D(K)) + NS3D(K) = MAX(0.,NS3D(K)) + NC3D(K) = MAX(0.,NC3D(K)) + NR3D(K) = MAX(0.,NR3D(K)) + NG3D(K) = MAX(0.,NG3D(K)) + +!...................................................................... +! CLOUD ICE + + IF (QI3D(K).GE.QSMALL) THEN + LAMI(K) = (CONS12* & + NI3D(K)/QI3D(K))**(1./DI) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMI(K).LT.LAMMINI) THEN + + LAMI(K) = LAMMINI + + N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 + + NI3D(K) = N0I(K)/LAMI(K) + ELSE IF (LAMI(K).GT.LAMMAXI) THEN + LAMI(K) = LAMMAXI + N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 + + NI3D(K) = N0I(K)/LAMI(K) + END IF + END IF + +!...................................................................... +! RAIN + + IF (QR3D(K).GE.QSMALL) THEN + LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMR(K).LT.LAMMINR) THEN + + LAMR(K) = LAMMINR + + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + ELSE IF (LAMR(K).GT.LAMMAXR) THEN + LAMR(K) = LAMMAXR + N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) + + NR3D(K) = N0RR(K)/LAMR(K) + END IF + + END IF + +!...................................................................... +! CLOUD DROPLETS + +! MARTIN ET AL. (1994) FORMULA FOR PGAM + + IF (QC3D(K).GE.QSMALL) THEN + + !bloss: option for fixing pgam + if(dofix_pgam) then + pgam(k) = pgam_fixed + else + +! DUM = PRES(K)/(R*T3D(K)) +! V1.5 + PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 + PGAM(K)=1./(PGAM(K)**2)-1. + PGAM(K)=MAX(PGAM(K),2.) + PGAM(K)=MIN(PGAM(K),10.) + + end if + +! CALCULATE LAMC + + LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & + (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) + +! LAMMIN, 60 MICRON DIAMETER +! LAMMAX, 1 MICRON + + LAMMIN = (PGAM(K)+1.)/60.E-6 + LAMMAX = (PGAM(K)+1.)/1.E-6 + + IF (LAMC(K).LT.LAMMIN) THEN + LAMC(K) = LAMMIN + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + + ELSE IF (LAMC(K).GT.LAMMAX) THEN + LAMC(K) = LAMMAX + NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & + LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 + + END IF + + END IF + +!...................................................................... +! SNOW + + IF (QNI3D(K).GE.QSMALL) THEN + LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMS(K).LT.LAMMINS) THEN + LAMS(K) = LAMMINS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + + NS3D(K) = N0S(K)/LAMS(K) + + ELSE IF (LAMS(K).GT.LAMMAXS) THEN + + LAMS(K) = LAMMAXS + N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 + NS3D(K) = N0S(K)/LAMS(K) + END IF + + END IF + +!...................................................................... +! GRAUPEL + + IF (QG3D(K).GE.QSMALL) THEN + LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) + +! CHECK FOR SLOPE + +! ADJUST VARS + + IF (LAMG(K).LT.LAMMING) THEN + LAMG(K) = LAMMING + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + + ELSE IF (LAMG(K).GT.LAMMAXG) THEN + + LAMG(K) = LAMMAXG + N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 + + NG3D(K) = N0G(K)/LAMG(K) + END IF + + END IF + + 500 CONTINUE + +! CALCULATE EFFECTIVE RADIUS + +#ifdef CLUBB_CRM + ! Account for subgrid scale effective droplet radii + IF ( CF3D(K) > cloud_frac_thresh ) THEN + TMPQSMALL = QSMALL / CF3D(K) + ELSE + TMPQSMALL = QSMALL + END IF + + IF (QI3D(K).GE.TMPQSMALL) THEN + EFFI(K) = 3./LAMI(K)/2.*1.E6 + ELSE + EFFI(K) = 25. + END IF + + IF (QNI3D(K).GE.TMPQSMALL) THEN + EFFS(K) = 3./LAMS(K)/2.*1.E6 + ELSE + EFFS(K) = 25. + END IF + + IF (QR3D(K).GE.TMPQSMALL) THEN + EFFR(K) = 3./LAMR(K)/2.*1.E6 + ELSE + EFFR(K) = 25. + END IF + + IF (QC3D(K).GE.TMPQSMALL) THEN + EFFC(K) = GAMMA(PGAM(K)+4.)/ & + GAMMA(PGAM(K)+3.)/LAMC(K)/2.*1.E6 + ELSE + EFFC(K) = 25. + END IF + + IF (QG3D(K).GE.TMPQSMALL) THEN + EFFG(K) = 3./LAMG(K)/2.*1.E6 + ELSE + EFFG(K) = 25. + END IF +#else + IF (QI3D(K).GE.QSMALL) THEN + EFFI(K) = 3./LAMI(K)/2.*1.E6 + ELSE + EFFI(K) = 25. + END IF + + IF (QNI3D(K).GE.QSMALL) THEN + EFFS(K) = 3./LAMS(K)/2.*1.E6 + ELSE + EFFS(K) = 25. + END IF + + IF (QR3D(K).GE.QSMALL) THEN + EFFR(K) = 3./LAMR(K)/2.*1.E6 + ELSE + EFFR(K) = 25. + END IF + + IF (QC3D(K).GE.QSMALL) THEN + EFFC(K) = GAMMA(PGAM(K)+4.)/ & + GAMMA(PGAM(K)+3.)/LAMC(K)/2.*1.E6 + ELSE + EFFC(K) = 25. + END IF + + IF (QG3D(K).GE.QSMALL) THEN + EFFG(K) = 3./LAMG(K)/2.*1.E6 + ELSE + EFFG(K) = 25. + END IF +#endif /*CLUBB_CRM*/ + +! HM ADD 1/10/06, ADD UPPER BOUND ON ICE NUMBER, THIS IS NEEDED +! TO PREVENT VERY LARGE ICE NUMBER DUE TO HOMOGENEOUS FREEZING +! OF DROPLETS, ESPECIALLY WHEN INUM = 1, SET MAX AT 10 CM-3 + NI3D(K) = MIN(NI3D(K),10.E6/RHO(K)) +! ADD BOUND ON DROPLET NUMBER - CANNOT EXCEED AEROSOL CONCENTRATION + IF (INUM.EQ.0.AND.IACT.EQ.2) THEN + NC3D(K) = MIN(NC3D(K),(NANEW1+NANEW2)/RHO(K)) + END IF +! SWITCH FOR CONSTANT DROPLET NUMBER + IF (INUM.EQ.1) THEN +! CHANGE NDCNST FROM CM-3 TO KG-1 + NC3D(K) = NDCNST*1.E6/RHO(K) + END IF +#ifdef CLUBB_CRM +! ADDITION BY UWM TO ENSURE THE POSITIVE DEFINITENESS OF VAPOR WATER MIXING RATIO + CALL POSITIVE_QV_ADJ( QV3D(K), QC3D(K), QR3D(K), QI3D(K), & + QNI3D(K), QG3D(K), T3D(K) ) +#endif /*CLUBB_CRM*/ + +#ifdef ECPP +! calculate relative humidity +! + ! SATURATION VAPOR PRESSURE AND MIXING RATIO + + EVS(K) = POLYSVP(T3D(K),0) ! PA +! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING + QVS(K) = .622*EVS(K)/(PRES(K)-EVS(K)) + QVQVS(K) = QV3D(K)/QVS(K) + RH3D(K)= min(1.0, QVQVS(K)) +#endif /*ECPP*/ + + END DO !!! K LOOP + + 400 CONTINUE + +! ALL DONE !!!!!!!!!!! + RETURN + END SUBROUTINE M2005MICRO_GRAUPEL + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + REAL FUNCTION POLYSVP (T,TYPE) + +!------------------------------------------- + +! COMPUTE SATURATION VAPOR PRESSURE + +! POLYSVP RETURNED IN UNITS OF PA. +! T IS INPUT IN UNITS OF K. +! TYPE REFERS TO SATURATION WITH RESPECT TO LIQUID (0) OR ICE (1) + + IMPLICIT NONE + + REAL DUM + REAL T + INTEGER TYPE + +! REPLACE GOFF-GRATCH WITH FASTER FORMULATION FROM FLATAU ET AL. 1992, TABLE 4 (RIGHT-HAND COLUMN) + +! ice + real a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i + data a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i /& + 6.11147274, 0.503160820, 0.188439774e-1, & + 0.420895665e-3, 0.615021634e-5,0.602588177e-7, & + 0.385852041e-9, 0.146898966e-11, 0.252751365e-14/ + +! liquid + real a0,a1,a2,a3,a4,a5,a6,a7,a8 + +! V1.7 + data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& + 6.11239921, 0.443987641, 0.142986287e-1, & + 0.264847430e-3, 0.302950461e-5, 0.206739458e-7, & + 0.640689451e-10,-0.952447341e-13,-0.976195544e-15/ + real dt + +! ICE + + IF (TYPE.EQ.1) THEN + +! POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654* & +! LOG10(273.16/T)+0.876793*(1.-T/273.16)+ & +! LOG10(6.1071))*100. + + + dt = max(-80.,t-273.16) + polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) + polysvp = polysvp*100. + + END IF + +! LIQUID + + IF (TYPE.EQ.0) THEN + + dt = max(-80.,t-273.16) + polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) + polysvp = polysvp*100. + +! POLYSVP = 10.**(-7.90298*(373.16/T-1.)+ & +! 5.02808*LOG10(373.16/T)- & +! 1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+ & +! 8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+ & +! LOG10(1013.246))*100. + + END IF + + + END FUNCTION POLYSVP + +!------------------------------------------------------------------------------ + + REAL FUNCTION GAMMA(X) +!---------------------------------------------------------------------- +! +! THIS ROUTINE CALCULATES THE GAMMA FUNCTION FOR A REAL ARGUMENT X. +! COMPUTATION IS BASED ON AN ALGORITHM OUTLINED IN REFERENCE 1. +! THE PROGRAM USES RATIONAL FUNCTIONS THAT APPROXIMATE THE GAMMA +! FUNCTION TO AT LEAST 20 SIGNIFICANT DECIMAL DIGITS. COEFFICIENTS +! FOR THE APPROXIMATION OVER THE INTERVAL (1,2) ARE UNPUBLISHED. +! THOSE FOR THE APPROXIMATION FOR X .GE. 12 ARE FROM REFERENCE 2. +! THE ACCURACY ACHIEVED DEPENDS ON THE ARITHMETIC SYSTEM, THE +! COMPILER, THE INTRINSIC FUNCTIONS, AND PROPER SELECTION OF THE +! MACHINE-DEPENDENT CONSTANTS. +! +! +!******************************************************************* +!******************************************************************* +! +! EXPLANATION OF MACHINE-DEPENDENT CONSTANTS +! +! BETA - RADIX FOR THE FLOATING-POINT REPRESENTATION +! MAXEXP - THE SMALLEST POSITIVE POWER OF BETA THAT OVERFLOWS +! XBIG - THE LARGEST ARGUMENT FOR WHICH GAMMA(X) IS REPRESENTABLE +! IN THE MACHINE, I.E., THE SOLUTION TO THE EQUATION +! GAMMA(XBIG) = BETA**MAXEXP +! XINF - THE LARGEST MACHINE REPRESENTABLE FLOATING-POINT NUMBER; +! APPROXIMATELY BETA**MAXEXP +! EPS - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT +! 1.0+EPS .GT. 1.0 +! XMININ - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT +! 1/XMININ IS MACHINE REPRESENTABLE +! +! APPROXIMATE VALUES FOR SOME IMPORTANT MACHINES ARE: +! +! BETA MAXEXP XBIG +! +! CRAY-1 (S.P.) 2 8191 966.961 +! CYBER 180/855 +! UNDER NOS (S.P.) 2 1070 177.803 +! IEEE (IBM/XT, +! SUN, ETC.) (S.P.) 2 128 35.040 +! IEEE (IBM/XT, +! SUN, ETC.) (D.P.) 2 1024 171.624 +! IBM 3033 (D.P.) 16 63 57.574 +! VAX D-FORMAT (D.P.) 2 127 34.844 +! VAX G-FORMAT (D.P.) 2 1023 171.489 +! +! XINF EPS XMININ +! +! CRAY-1 (S.P.) 5.45E+2465 7.11E-15 1.84E-2466 +! CYBER 180/855 +! UNDER NOS (S.P.) 1.26E+322 3.55E-15 3.14E-294 +! IEEE (IBM/XT, +! SUN, ETC.) (S.P.) 3.40E+38 1.19E-7 1.18E-38 +! IEEE (IBM/XT, +! SUN, ETC.) (D.P.) 1.79D+308 2.22D-16 2.23D-308 +! IBM 3033 (D.P.) 7.23D+75 2.22D-16 1.39D-76 +! VAX D-FORMAT (D.P.) 1.70D+38 1.39D-17 5.88D-39 +! VAX G-FORMAT (D.P.) 8.98D+307 1.11D-16 1.12D-308 +! +!******************************************************************* +!******************************************************************* +! +! ERROR RETURNS +! +! THE PROGRAM RETURNS THE VALUE XINF FOR SINGULARITIES OR +! WHEN OVERFLOW WOULD OCCUR. THE COMPUTATION IS BELIEVED +! TO BE FREE OF UNDERFLOW AND OVERFLOW. +! +! +! INTRINSIC FUNCTIONS REQUIRED ARE: +! +! INT, DBLE, EXP, LOG, REAL, SIN +! +! +! REFERENCES: AN OVERVIEW OF SOFTWARE DEVELOPMENT FOR SPECIAL +! FUNCTIONS W. J. CODY, LECTURE NOTES IN MATHEMATICS, +! 506, NUMERICAL ANALYSIS DUNDEE, 1975, G. A. WATSON +! (ED.), SPRINGER VERLAG, BERLIN, 1976. +! +! COMPUTER APPROXIMATIONS, HART, ET. AL., WILEY AND +! SONS, NEW YORK, 1968. +! +! LATEST MODIFICATION: OCTOBER 12, 1989 +! +! AUTHORS: W. J. CODY AND L. STOLTZ +! APPLIED MATHEMATICS DIVISION +! ARGONNE NATIONAL LABORATORY +! ARGONNE, IL 60439 +! +!---------------------------------------------------------------------- + implicit none + INTEGER I,N + LOGICAL PARITY + REAL & + CONV,EPS,FACT,HALF,ONE,RES,SUM,TWELVE, & + TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO + REAL, DIMENSION(7) :: C + REAL, DIMENSION(8) :: P + REAL, DIMENSION(8) :: Q +!---------------------------------------------------------------------- +! MATHEMATICAL CONSTANTS +!---------------------------------------------------------------------- + DATA ONE,HALF,TWELVE,TWO,ZERO/1.0E0,0.5E0,12.0E0,2.0E0,0.0E0/ + + +!---------------------------------------------------------------------- +! MACHINE DEPENDENT PARAMETERS +!---------------------------------------------------------------------- + DATA XBIG,XMININ,EPS/35.040E0,1.18E-38,1.19E-7/,XINF/3.4E38/ +!---------------------------------------------------------------------- +! NUMERATOR AND DENOMINATOR COEFFICIENTS FOR RATIONAL MINIMAX +! APPROXIMATION OVER (1,2). +!---------------------------------------------------------------------- + DATA P/-1.71618513886549492533811E+0,2.47656508055759199108314E+1, & + -3.79804256470945635097577E+2,6.29331155312818442661052E+2, & + 8.66966202790413211295064E+2,-3.14512729688483675254357E+4, & + -3.61444134186911729807069E+4,6.64561438202405440627855E+4/ + DATA Q/-3.08402300119738975254353E+1,3.15350626979604161529144E+2, & + -1.01515636749021914166146E+3,-3.10777167157231109440444E+3, & + 2.25381184209801510330112E+4,4.75584627752788110767815E+3, & + -1.34659959864969306392456E+5,-1.15132259675553483497211E+5/ +!---------------------------------------------------------------------- +! COEFFICIENTS FOR MINIMAX APPROXIMATION OVER (12, INF). +!---------------------------------------------------------------------- + DATA C/-1.910444077728E-03,8.4171387781295E-04, & + -5.952379913043012E-04,7.93650793500350248E-04, & + -2.777777777777681622553E-03,8.333333333333333331554247E-02, & + 5.7083835261E-03/ +!---------------------------------------------------------------------- +! STATEMENT FUNCTIONS FOR CONVERSION BETWEEN INTEGER AND FLOAT +!---------------------------------------------------------------------- + CONV(I) = REAL(I) + PARITY=.FALSE. + FACT=ONE + N=0 + Y=X + IF(Y.LE.ZERO)THEN +!---------------------------------------------------------------------- +! ARGUMENT IS NEGATIVE +!---------------------------------------------------------------------- + Y=-X + Y1=AINT(Y) + RES=Y-Y1 + IF(RES.NE.ZERO)THEN + IF(Y1.NE.AINT(Y1*HALF)*TWO)PARITY=.TRUE. + FACT=-PI/SIN(PI*RES) + Y=Y+ONE + ELSE + RES=XINF + GOTO 900 + ENDIF + ENDIF +!---------------------------------------------------------------------- +! ARGUMENT IS POSITIVE +!---------------------------------------------------------------------- + IF(Y.LT.EPS)THEN +!---------------------------------------------------------------------- +! ARGUMENT .LT. EPS +!---------------------------------------------------------------------- + IF(Y.GE.XMININ)THEN + RES=ONE/Y + ELSE + RES=XINF + GOTO 900 + ENDIF + ELSEIF(Y.LT.TWELVE)THEN + Y1=Y + IF(Y.LT.ONE)THEN +!---------------------------------------------------------------------- +! 0.0 .LT. ARGUMENT .LT. 1.0 +!---------------------------------------------------------------------- + Z=Y + Y=Y+ONE + ELSE +!---------------------------------------------------------------------- +! 1.0 .LT. ARGUMENT .LT. 12.0, REDUCE ARGUMENT IF NECESSARY +!---------------------------------------------------------------------- + N=INT(Y)-1 + Y=Y-CONV(N) + Z=Y-ONE + ENDIF +!---------------------------------------------------------------------- +! EVALUATE APPROXIMATION FOR 1.0 .LT. ARGUMENT .LT. 2.0 +!---------------------------------------------------------------------- + XNUM=ZERO + XDEN=ONE + DO I=1,8 + XNUM=(XNUM+P(I))*Z + XDEN=XDEN*Z+Q(I) + END DO + RES=XNUM/XDEN+ONE + IF(Y1.LT.Y)THEN +!---------------------------------------------------------------------- +! ADJUST RESULT FOR CASE 0.0 .LT. ARGUMENT .LT. 1.0 +!---------------------------------------------------------------------- + RES=RES/Y1 + ELSEIF(Y1.GT.Y)THEN +!---------------------------------------------------------------------- +! ADJUST RESULT FOR CASE 2.0 .LT. ARGUMENT .LT. 12.0 +!---------------------------------------------------------------------- + DO I=1,N + RES=RES*Y + Y=Y+ONE + END DO + ENDIF + ELSE +!---------------------------------------------------------------------- +! EVALUATE FOR ARGUMENT .GE. 12.0, +!---------------------------------------------------------------------- + IF(Y.LE.XBIG)THEN + YSQ=Y*Y + SUM=C(7) + DO I=1,6 + SUM=SUM/YSQ+C(I) + END DO + SUM=SUM/Y-Y+SQRTPI + SUM=SUM+(Y-HALF)*LOG(Y) + RES=EXP(SUM) + ELSE + RES=XINF + GOTO 900 + ENDIF + ENDIF +!---------------------------------------------------------------------- +! FINAL ADJUSTMENTS AND RETURN +!---------------------------------------------------------------------- + IF(PARITY)RES=-RES + IF(FACT.NE.ONE)RES=FACT/RES + 900 GAMMA=RES + RETURN +! ---------- LAST LINE OF GAMMA ---------- + END FUNCTION GAMMA + + + REAL FUNCTION DERF1(X) + IMPLICIT NONE + REAL X + REAL, DIMENSION(0 : 64) :: A, B + REAL W,T,Y + INTEGER K,I + DATA A/ & + 0.00000000005958930743E0, -0.00000000113739022964E0, & + 0.00000001466005199839E0, -0.00000016350354461960E0, & + 0.00000164610044809620E0, -0.00001492559551950604E0, & + 0.00012055331122299265E0, -0.00085483269811296660E0, & + 0.00522397762482322257E0, -0.02686617064507733420E0, & + 0.11283791670954881569E0, -0.37612638903183748117E0, & + 1.12837916709551257377E0, & + 0.00000000002372510631E0, -0.00000000045493253732E0, & + 0.00000000590362766598E0, -0.00000006642090827576E0, & + 0.00000067595634268133E0, -0.00000621188515924000E0, & + 0.00005103883009709690E0, -0.00037015410692956173E0, & + 0.00233307631218880978E0, -0.01254988477182192210E0, & + 0.05657061146827041994E0, -0.21379664776456006580E0, & + 0.84270079294971486929E0, & + 0.00000000000949905026E0, -0.00000000018310229805E0, & + 0.00000000239463074000E0, -0.00000002721444369609E0, & + 0.00000028045522331686E0, -0.00000261830022482897E0, & + 0.00002195455056768781E0, -0.00016358986921372656E0, & + 0.00107052153564110318E0, -0.00608284718113590151E0, & + 0.02986978465246258244E0, -0.13055593046562267625E0, & + 0.67493323603965504676E0, & + 0.00000000000382722073E0, -0.00000000007421598602E0, & + 0.00000000097930574080E0, -0.00000001126008898854E0, & + 0.00000011775134830784E0, -0.00000111992758382650E0, & + 0.00000962023443095201E0, -0.00007404402135070773E0, & + 0.00050689993654144881E0, -0.00307553051439272889E0, & + 0.01668977892553165586E0, -0.08548534594781312114E0, & + 0.56909076642393639985E0, & + 0.00000000000155296588E0, -0.00000000003032205868E0, & + 0.00000000040424830707E0, -0.00000000471135111493E0, & + 0.00000005011915876293E0, -0.00000048722516178974E0, & + 0.00000430683284629395E0, -0.00003445026145385764E0, & + 0.00024879276133931664E0, -0.00162940941748079288E0, & + 0.00988786373932350462E0, -0.05962426839442303805E0, & + 0.49766113250947636708E0 / + DATA (B(I), I = 0, 12) / & + -0.00000000029734388465E0, 0.00000000269776334046E0, & + -0.00000000640788827665E0, -0.00000001667820132100E0, & + -0.00000021854388148686E0, 0.00000266246030457984E0, & + 0.00001612722157047886E0, -0.00025616361025506629E0, & + 0.00015380842432375365E0, 0.00815533022524927908E0, & + -0.01402283663896319337E0, -0.19746892495383021487E0, & + 0.71511720328842845913E0 / + DATA (B(I), I = 13, 25) / & + -0.00000000001951073787E0, -0.00000000032302692214E0, & + 0.00000000522461866919E0, 0.00000000342940918551E0, & + -0.00000035772874310272E0, 0.00000019999935792654E0, & + 0.00002687044575042908E0, -0.00011843240273775776E0, & + -0.00080991728956032271E0, 0.00661062970502241174E0, & + 0.00909530922354827295E0, -0.20160072778491013140E0, & + 0.51169696718727644908E0 / + DATA (B(I), I = 26, 38) / & + 0.00000000003147682272E0, -0.00000000048465972408E0, & + 0.00000000063675740242E0, 0.00000003377623323271E0, & + -0.00000015451139637086E0, -0.00000203340624738438E0, & + 0.00001947204525295057E0, 0.00002854147231653228E0, & + -0.00101565063152200272E0, 0.00271187003520095655E0, & + 0.02328095035422810727E0, -0.16725021123116877197E0, & + 0.32490054966649436974E0 / + DATA (B(I), I = 39, 51) / & + 0.00000000002319363370E0, -0.00000000006303206648E0, & + -0.00000000264888267434E0, 0.00000002050708040581E0, & + 0.00000011371857327578E0, -0.00000211211337219663E0, & + 0.00000368797328322935E0, 0.00009823686253424796E0, & + -0.00065860243990455368E0, -0.00075285814895230877E0, & + 0.02585434424202960464E0, -0.11637092784486193258E0, & + 0.18267336775296612024E0 / + DATA (B(I), I = 52, 64) / & + -0.00000000000367789363E0, 0.00000000020876046746E0, & + -0.00000000193319027226E0, -0.00000000435953392472E0, & + 0.00000018006992266137E0, -0.00000078441223763969E0, & + -0.00000675407647949153E0, 0.00008428418334440096E0, & + -0.00017604388937031815E0, -0.00239729611435071610E0, & + 0.02064129023876022970E0, -0.06905562880005864105E0, & + 0.09084526782065478489E0 / + W = ABS(X) + IF (W .LT. 2.2D0) THEN + T = W * W + K = INT(T) + T = T - K + K = K * 13 + Y = ((((((((((((A(K) * T + A(K + 1)) * T + & + A(K + 2)) * T + A(K + 3)) * T + A(K + 4)) * T + & + A(K + 5)) * T + A(K + 6)) * T + A(K + 7)) * T + & + A(K + 8)) * T + A(K + 9)) * T + A(K + 10)) * T + & + A(K + 11)) * T + A(K + 12)) * W + ELSE IF (W .LT. 6.9D0) THEN + K = INT(W) + T = W - K + K = 13 * (K - 2) + Y = (((((((((((B(K) * T + B(K + 1)) * T + & + B(K + 2)) * T + B(K + 3)) * T + B(K + 4)) * T + & + B(K + 5)) * T + B(K + 6)) * T + B(K + 7)) * T + & + B(K + 8)) * T + B(K + 9)) * T + B(K + 10)) * T + & + B(K + 11)) * T + B(K + 12) + Y = Y * Y + Y = Y * Y + Y = Y * Y + Y = 1 - Y * Y + ELSE + Y = 1 + END IF + IF (X .LT. 0) Y = -Y + DERF1 = Y + END FUNCTION DERF1 + +!+---+-----------------------------------------------------------------+ +! + subroutine radar_init + + IMPLICIT NONE + INTEGER:: n + PI5 = PI*PI*PI*PI*PI + lamda4 = lamda_radar*lamda_radar*lamda_radar*lamda_radar + m_w_0 = m_complex_water_ray (lamda_radar, 0.0d0) + m_i_0 = m_complex_ice_maetzler (lamda_radar, 0.0d0) + K_w = (ABS( (m_w_0*m_w_0 - 1.0) /(m_w_0*m_w_0 + 2.0) ))**2 + + do n = 1, nbins+1 + simpson(n) = 0.0d0 + enddo + do n = 1, nbins-1, 2 + simpson(n) = simpson(n) + basis(1) + simpson(n+1) = simpson(n+1) + basis(2) + simpson(n+2) = simpson(n+2) + basis(3) + enddo + + do n = 1, slen + mixingrulestring_s(n:n) = char(0) + matrixstring_s(n:n) = char(0) + inclusionstring_s(n:n) = char(0) + hoststring_s(n:n) = char(0) + hostmatrixstring_s(n:n) = char(0) + hostinclusionstring_s(n:n) = char(0) + mixingrulestring_g(n:n) = char(0) + matrixstring_g(n:n) = char(0) + inclusionstring_g(n:n) = char(0) + hoststring_g(n:n) = char(0) + hostmatrixstring_g(n:n) = char(0) + hostinclusionstring_g(n:n) = char(0) + enddo + + mixingrulestring_s = 'maxwellgarnett' + hoststring_s = 'air' + matrixstring_s = 'water' + inclusionstring_s = 'spheroidal' + hostmatrixstring_s = 'icewater' + hostinclusionstring_s = 'spheroidal' + + mixingrulestring_g = 'maxwellgarnett' + hoststring_g = 'air' + matrixstring_g = 'water' + inclusionstring_g = 'spheroidal' + hostmatrixstring_g = 'icewater' + hostinclusionstring_g = 'spheroidal' + + end subroutine radar_init +!+---+-----------------------------------------------------------------+ + + COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) + +! Complex refractive Index of Water as function of Temperature T +! [deg C] and radar wavelength lambda [m]; valid for +! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C +! after Ray (1972) + + IMPLICIT NONE + REAL(kind=selected_real_kind(12)), INTENT(IN):: T,lambda + REAL(kind=selected_real_kind(12)):: epsinf,epss,epsr,epsi + REAL(kind=selected_real_kind(12)):: alpha,lambdas,sigma,nenner + COMPLEX*16, PARAMETER:: i = (0d0,1d0) + + epsinf = 5.27137d0 + 0.02164740d0 * T - 0.00131198d0 * T*T + epss = 78.54d+0 * (1.0 - 4.579d-3 * (T - 25.0) & + + 1.190d-5 * (T - 25.0)*(T - 25.0) & + - 2.800d-8 * (T - 25.0)*(T - 25.0)*(T - 25.0)) + alpha = -16.8129d0/(T+273.16) + 0.0609265d0 + lambdas = 0.00033836d0 * exp(2513.98d0/(T+273.16)) * 1e-2 + + nenner = 1.d0+2.d0*(lambdas/lambda)**(1d0-alpha)*sin(alpha*PI*0.5) & + + (lambdas/lambda)**(2d0-2d0*alpha) + epsr = epsinf + ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & + * sin(alpha*PI*0.5)+1d0)) / nenner + epsi = ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & + * cos(alpha*PI*0.5)+0d0)) / nenner & + + lambda*1.25664/1.88496 + + m_complex_water_ray = SQRT(CMPLX(epsr,-epsi)) + + END FUNCTION m_complex_water_ray + +!+---+-----------------------------------------------------------------+ + + COMPLEX*16 FUNCTION m_complex_ice_maetzler(lambda,T) + +! complex refractive index of ice as function of Temperature T +! [deg C] and radar wavelength lambda [m]; valid for +! lambda in [0.0001,30] m; T in [-250.0,0.0] C +! Original comment from the Matlab-routine of Prof. Maetzler: +! Function for calculating the relative permittivity of pure ice in +! the microwave region, according to C. Maetzler, "Microwave +! properties of ice and snow", in B. Schmitt et al. (eds.) Solar +! System Ices, Astrophys. and Space Sci. Library, Vol. 227, Kluwer +! Academic Publishers, Dordrecht, pp. 241-257 (1998). Input: +! TK = temperature (K), range 20 to 273.15 +! f = frequency in GHz, range 0.01 to 3000 + + IMPLICIT NONE + REAL(kind=selected_real_kind(12)), INTENT(IN):: T,lambda + REAL(kind=selected_real_kind(12)):: f,c,TK,B1,B2,b,deltabeta,betam,beta,theta,alfa + + c = 2.99d8 + TK = T + 273.16 + f = c / lambda * 1d-9 + + B1 = 0.0207 + B2 = 1.16d-11 + b = 335.0d0 + deltabeta = EXP(-10.02 + 0.0364*(TK-273.16)) + betam = (B1/TK) * ( EXP(b/TK) / ((EXP(b/TK)-1)**2) ) + B2*f*f + beta = betam + deltabeta + theta = 300. / TK - 1. + alfa = (0.00504d0 + 0.0062d0*theta) * EXP(-22.1d0*theta) + m_complex_ice_maetzler = 3.1884 + 9.1e-4*(TK-273.16) + m_complex_ice_maetzler = m_complex_ice_maetzler & + + CMPLX(0.0d0, (alfa/f + beta*f)) + m_complex_ice_maetzler = SQRT(CONJG(m_complex_ice_maetzler)) + + END FUNCTION m_complex_ice_maetzler +!+---+-----------------------------------------------------------------+ + + subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & + meltratio_outside, m_w, m_i, lambda, C_back, & + mixingrule,matrix,inclusion, & + host,hostmatrix,hostinclusion) + + IMPLICIT NONE + + REAL(kind=selected_real_kind(12)), INTENT(in):: x_g, a_geo, b_geo, fmelt, lambda, & + meltratio_outside + REAL(kind=selected_real_kind(12)), INTENT(out):: C_back + COMPLEX*16, INTENT(in):: m_w, m_i + CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion, & + host, hostmatrix, hostinclusion + + COMPLEX*16:: m_core, m_air + REAL(kind=selected_real_kind(12)):: D_large, D_g, rhog, x_w, xw_a, fm, fmgrenz, & + volg, vg, volair, volice, volwater, & + meltratio_outside_grenz, mra + INTEGER:: error + real :: rho_i, rho_w + + rho_i = 900. + rho_w = 1000. + + +! refractive index of air: + m_air = (1.0d0,0.0d0) + +! Limiting the degree of melting --- for safety: + fm = DMAX1(DMIN1(fmelt, 1.0d0), 0.0d0) +! Limiting the ratio of (melting on outside)/(melting on inside): + mra = DMAX1(DMIN1(meltratio_outside, 1.0d0), 0.0d0) + +! ! The relative portion of meltwater melting at outside should increase +! ! from the given input value (between 0 and 1) +! ! to 1 as the degree of melting approaches 1, +! ! so that the melting particle "converges" to a water drop. +! ! Simplest assumption is linear: + mra = mra + (1.0d0-mra)*fm + + x_w = x_g * fm + + D_g = a_geo * x_g**b_geo + + if (D_g .ge. 1d-12) then + + vg = PI/6. * D_g**3 + rhog = DMAX1(DMIN1(x_g / vg, DBLE(rho_i)), 10.0d0) + vg = x_g / rhog + + meltratio_outside_grenz = 1.0d0 - rhog / rho_w + + if (mra .le. meltratio_outside_grenz) then + !..In this case, it cannot happen that, during melting, all the + !.. air inclusions within the ice particle get filled with + !.. meltwater. This only happens at the end of all melting. + volg = vg * (1.0d0 - mra * fm) + + else + !..In this case, at some melting degree fm, all the air + !.. inclusions get filled with meltwater. + fmgrenz=(rho_i-rhog)/(mra*rho_i-rhog+rho_i*rhog/rho_w) + + if (fm .le. fmgrenz) then + !.. not all air pockets are filled: + volg = (1.0 - mra * fm) * vg + else + !..all air pockets are filled with meltwater, now the + !.. entire ice sceleton melts homogeneously: + volg = (x_g - x_w) / rho_i + x_w / rho_w + endif + + endif + + D_large = (6.0 / PI * volg) ** (1./3.) + volice = (x_g - x_w) / (volg * rho_i) + volwater = x_w / (rho_w * volg) + volair = 1.0 - volice - volwater + + !..complex index of refraction for the ice-air-water mixture + !.. of the particle: + m_core = get_m_mix_nested (m_air, m_i, m_w, volair, volice, & + volwater, mixingrule, host, matrix, inclusion, & + hostmatrix, hostinclusion, error) + if (error .ne. 0) then + C_back = 0.0d0 + return + endif + + !..Rayleigh-backscattering coefficient of melting particle: + C_back = (ABS((m_core**2-1.0d0)/(m_core**2+2.0d0)))**2 & + * PI5 * D_large**6 / lamda4 + + else + C_back = 0.0d0 + endif + + end subroutine rayleigh_soak_wetgraupel +!+---+-----------------------------------------------------------------+ + + complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & + volice, volwater, mixingrule, host, matrix, & + inclusion, hostmatrix, hostinclusion, cumulerror) + + IMPLICIT NONE + + REAL(kind=selected_real_kind(12)), INTENT(in):: volice, volair, volwater + COMPLEX*16, INTENT(in):: m_a, m_i, m_w + CHARACTER(len=*), INTENT(in):: mixingrule, host, matrix, & + inclusion, hostmatrix, hostinclusion + INTEGER, INTENT(out):: cumulerror + + REAL(kind=selected_real_kind(12)):: vol1, vol2 + COMPLEX*16:: mtmp + INTEGER:: error + + !..Folded: ( (m1 + m2) + m3), where m1,m2,m3 could each be + !.. air, ice, or water + + cumulerror = 0 + get_m_mix_nested = CMPLX(1.0d0,0.0d0) + + if (host .eq. 'air') then + + if (matrix .eq. 'air') then + write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + else + vol1 = volice / MAX(volice+volwater,1d-10) + vol2 = 1.0d0 - vol1 + mtmp = get_m_mix (m_a, m_i, m_w, 0.0d0, vol1, vol2, & + mixingrule, matrix, inclusion, error) + cumulerror = cumulerror + error + + if (hostmatrix .eq. 'air') then + get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & + volair, (1.0d0-volair), 0.0d0, mixingrule, & + hostmatrix, hostinclusion, error) + cumulerror = cumulerror + error + elseif (hostmatrix .eq. 'icewater') then + get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & + volair, (1.0d0-volair), 0.0d0, mixingrule, & + 'ice', hostinclusion, error) + cumulerror = cumulerror + error + else + write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & + hostmatrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + endif + endif + + elseif (host .eq. 'ice') then + + if (matrix .eq. 'ice') then + write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + else + vol1 = volair / MAX(volair+volwater,1d-10) + vol2 = 1.0d0 - vol1 + mtmp = get_m_mix (m_a, m_i, m_w, vol1, 0.0d0, vol2, & + mixingrule, matrix, inclusion, error) + cumulerror = cumulerror + error + + if (hostmatrix .eq. 'ice') then + get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & + (1.0d0-volice), volice, 0.0d0, mixingrule, & + hostmatrix, hostinclusion, error) + cumulerror = cumulerror + error + elseif (hostmatrix .eq. 'airwater') then + get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & + (1.0d0-volice), volice, 0.0d0, mixingrule, & + 'air', hostinclusion, error) + cumulerror = cumulerror + error + else + write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & + hostmatrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + endif + endif + + elseif (host .eq. 'water') then + + if (matrix .eq. 'water') then + write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + else + vol1 = volair / MAX(volice+volair,1d-10) + vol2 = 1.0d0 - vol1 + mtmp = get_m_mix (m_a, m_i, m_w, vol1, vol2, 0.0d0, & + mixingrule, matrix, inclusion, error) + cumulerror = cumulerror + error + + if (hostmatrix .eq. 'water') then + get_m_mix_nested = get_m_mix (2.0d0*m_a, mtmp, m_w, & + 0.0d0, (1.0d0-volwater), volwater, mixingrule, & + hostmatrix, hostinclusion, error) + cumulerror = cumulerror + error + elseif (hostmatrix .eq. 'airice') then + get_m_mix_nested = get_m_mix (2.0d0*m_a, mtmp, m_w, & + 0.0d0, (1.0d0-volwater), volwater, mixingrule, & + 'ice', hostinclusion, error) + cumulerror = cumulerror + error + else + write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & + hostmatrix + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + endif + endif + + elseif (host .eq. 'none') then + + get_m_mix_nested = get_m_mix (m_a, m_i, m_w, & + volair, volice, volwater, mixingrule, & + matrix, inclusion, error) + cumulerror = cumulerror + error + + else + write(mp_debug,*) 'GET_M_MIX_NESTED: unknown matrix: ', host + !bloss CALL wrf_debug(150, mp_debug) + cumulerror = cumulerror + 1 + endif + + IF (cumulerror .ne. 0) THEN + write(mp_debug,*) 'GET_M_MIX_NESTED: error encountered' + !bloss CALL wrf_debug(150, mp_debug) + get_m_mix_nested = CMPLX(1.0d0,0.0d0) + endif + + end function get_m_mix_nested + +!+---+-----------------------------------------------------------------+ + + COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & + volwater, mixingrule, matrix, inclusion, error) + + IMPLICIT NONE + + REAL(kind=selected_real_kind(12)), INTENT(in):: volice, volair, volwater + COMPLEX*16, INTENT(in):: m_a, m_i, m_w + CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion + INTEGER, INTENT(out):: error + + error = 0 + get_m_mix = CMPLX(1.0d0,0.0d0) + + if (mixingrule .eq. 'maxwellgarnett') then + if (matrix .eq. 'ice') then + get_m_mix = m_complex_maxwellgarnett(volice, volair, volwater, & + m_i, m_a, m_w, inclusion, error) + elseif (matrix .eq. 'water') then + get_m_mix = m_complex_maxwellgarnett(volwater, volair, volice, & + m_w, m_a, m_i, inclusion, error) + elseif (matrix .eq. 'air') then + get_m_mix = m_complex_maxwellgarnett(volair, volwater, volice, & + m_a, m_w, m_i, inclusion, error) + else + write(mp_debug,*) 'GET_M_MIX: unknown matrix: ', matrix + !bloss CALL wrf_debug(150, mp_debug) + error = 1 + endif + + else + write(mp_debug,*) 'GET_M_MIX: unknown mixingrule: ', mixingrule + !bloss CALL wrf_debug(150, mp_debug) + error = 2 + endif + + if (error .ne. 0) then + write(mp_debug,*) 'GET_M_MIX: error encountered' + !bloss CALL wrf_debug(150, mp_debug) + endif + + END FUNCTION get_m_mix + +!+---+-----------------------------------------------------------------+ + + COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & + m1, m2, m3, inclusion, error) + + IMPLICIT NONE + + COMPLEX*16 :: m1, m2, m3 + REAL(kind=selected_real_kind(12)) :: vol1, vol2, vol3 + CHARACTER(len=*) :: inclusion + + COMPLEX*16 :: beta2, beta3, m1t, m2t, m3t + INTEGER, INTENT(out) :: error + + error = 0 + + if (DABS(vol1+vol2+vol3-1.0d0) .gt. 1d-6) then + write(mp_debug,*) 'M_COMPLEX_MAXWELLGARNETT: sum of the ', & + 'partial volume fractions is not 1...ERROR' + !bloss CALL wrf_debug(150, mp_debug) + m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0) + error = 1 + return + endif + + m1t = m1**2 + m2t = m2**2 + m3t = m3**2 + + if (inclusion .eq. 'spherical') then + beta2 = 3.0d0*m1t/(m2t+2.0d0*m1t) + beta3 = 3.0d0*m1t/(m3t+2.0d0*m1t) + elseif (inclusion .eq. 'spheroidal') then + beta2 = 2.0d0*m1t/(m2t-m1t) * (m2t/(m2t-m1t)*LOG(m2t/m1t)-1.0d0) + beta3 = 2.0d0*m1t/(m3t-m1t) * (m3t/(m3t-m1t)*LOG(m3t/m1t)-1.0d0) + else + write(mp_debug,*) 'M_COMPLEX_MAXWELLGARNETT: ', & + 'unknown inclusion: ', inclusion + !bloss CALL wrf_debug(150, mp_debug) + m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0, kind=kind(0.d0)) + error = 1 + return + endif + + m_complex_maxwellgarnett = & + SQRT(((1.0d0-vol2-vol3)*m1t + vol2*beta2*m2t + vol3*beta3*m3t) / & + (1.0d0-vol2-vol3+vol2*beta2+vol3*beta3)) + + END FUNCTION m_complex_maxwellgarnett + +!+---+-----------------------------------------------------------------+ +!..Compute radar reflectivity assuming 10 cm wavelength radar and using +!.. Rayleigh approximation. Only complication is melted snow/graupel +!.. which we treat as water-coated ice spheres and use Uli Blahak's +!.. library of routines. The meltwater fraction is simply the amount +!.. of frozen species remaining from what initially existed at the +!.. melting level interface. +!+---+-----------------------------------------------------------------+ + subroutine calc_refl10cm (qv1d, qr1d, qs1d, qg1d, t1d, p1d, dBZ, & + kts, kte, ii, jj, nr1d, ns1d, ng1d) + + IMPLICIT NONE + +!..Sub arguments + INTEGER, INTENT(IN):: kts, kte, ii, jj + REAL, DIMENSION(kts:kte), INTENT(IN):: & + qv1d, qr1d, qs1d, qg1d, t1d, p1d, nr1d, ns1d, ng1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ + +!..Local variables + REAL, DIMENSION(kts:kte):: temp, pres, qv, rho + REAL, DIMENSION(kts:kte):: rr, rs, rg,rnr,rns,rng + + REAL(kind=selected_real_kind(12)), DIMENSION(kts:kte):: ilamr, ilamg, N0_r, N0_g,ilams,n0_s + + REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel + + REAL(kind=selected_real_kind(12)):: lamg + REAL(kind=selected_real_kind(12)):: fmelt_s, fmelt_g + + INTEGER:: i, k, k_0 + LOGICAL:: melti + LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg + +!..Single melting snow/graupel particle 70% meltwater on external sfc + REAL(kind=selected_real_kind(12)), PARAMETER:: melt_outside_s = 0.7d0 + REAL(kind=selected_real_kind(12)), PARAMETER:: melt_outside_g = 0.7d0 + + REAL(kind=selected_real_kind(12)):: cback, x, eta, f_d + +! hm added parameter + REAL R1,t_0,dumlams,dumlamr,dumlamg,dumn0s,dumn0r,dumn0g,ocms,obms,ocmg,obmg + + integer n + + R1 = 1.E-12 + t_0 = 273.15 + +!+---+ + + do k = kts, kte + dBZ(k) = -35.0 + enddo + +!+---+-----------------------------------------------------------------+ +!..Put column of data into local arrays. +!+---+-----------------------------------------------------------------+ + do k = kts, kte + temp(k) = t1d(k) + qv(k) = MAX(1.E-10, qv1d(k)) + pres(k) = p1d(k) + rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) + if (qr1d(k) .gt. R1) then + rr(k) = qr1d(k)*rho(k) + L_qr(k) = .true. + else + rr(k) = R1 + L_qr(k) = .false. + endif + if (qs1d(k) .gt. R1) then + rs(k) = qs1d(k)*rho(k) + L_qs(k) = .true. + else + rs(k) = R1 + L_qs(k) = .false. + endif + if (qg1d(k) .gt. R1) then + rg(k) = qg1d(k)*rho(k) + L_qg(k) = .true. + else + rg(k) = R1 + L_qg(k) = .false. + endif + +! hm add number concentration + if (nr1d(k) .gt. R1) then + rnr(k) = nr1d(k)*rho(k) + else + rnr(k) = R1 + endif + if (ns1d(k) .gt. R1) then + rns(k) = ns1d(k)*rho(k) + else + rns(k) = R1 + endif + if (ng1d(k) .gt. R1) then + rng(k) = ng1d(k)*rho(k) + else + rng(k) = R1 + endif + + enddo + +!+---+-----------------------------------------------------------------+ +!..Calculate y-intercept, slope, and useful moments for snow. +!+---+-----------------------------------------------------------------+ + do k = kts, kte + +! compute moments for snow + +! calculate slope and intercept parameter + + dumLAMS = (CONS1*rns(K)/rs(K))**(1./DS) + dumN0S = rns(K)*dumLAMS/rho(k) + +! CHECK FOR SLOPE to make sure min/max bounds are not exceeded + +! ADJUST VARS + + IF (dumLAMS.LT.LAMMINS) THEN + dumLAMS = LAMMINS + dumN0S = dumLAMS**4*rs(K)/CONS1 + ELSE IF (dumLAMS.GT.LAMMAXS) THEN + dumLAMS = LAMMAXS + dumN0S = dumLAMS**4*rs(k)/CONS1 + end if + + ilams(k)=1./dumlams + n0_s(k)=dumn0s + + enddo + +!+---+-----------------------------------------------------------------+ +!..Calculate y-intercept, slope values for graupel. +!+---+-----------------------------------------------------------------+ + + do k = kte, kts, -1 + + +! calculate slope and intercept parameter + + dumLAMg = (CONS2*rng(K)/rg(K))**(1./Dg) + dumN0g = rng(K)*dumLAMg/rho(k) + +! CHECK FOR SLOPE to make sure min/max bounds are not exceeded + +! ADJUST VARS + + IF (dumLAMg.LT.LAMMINg) THEN + dumLAMg = LAMMINg + dumN0g = dumLAMg**4*rg(K)/CONS2 + ELSE IF (dumLAMg.GT.LAMMAXg) THEN + dumLAMg = LAMMAXg + dumN0g = dumLAMg**4*rg(k)/CONS2 + end if + + ilamg(k)=1./dumlamg + n0_g(k)=dumn0g + + enddo + +!+---+-----------------------------------------------------------------+ +!..Calculate y-intercept & slope values for rain. +!+---+-----------------------------------------------------------------+ + + do k = kte, kts, -1 + +! calculate slope and intercept parameter + + dumLAMr = (PI*RHOW*rnr(K)/rr(K))**(1./3.) + dumN0r = rnr(K)*dumLAMr/rho(k) + +! CHECK FOR SLOPE to make sure min/max bounds are not exceeded + +! ADJUST VARS + + IF (dumLAMr.LT.LAMMINr) THEN + dumLAMr = LAMMINr + dumN0r = dumLAMr**4*rr(K)/(PI*RHOW) + ELSE IF (dumLAMr.GT.LAMMAXr) THEN + dumLAMr = LAMMAXr + dumN0r = dumLAMr**4*rr(k)/(PI*RHOW) + end if + + ilamr(k)=1./dumlamr + n0_r(k)=dumn0r + + enddo + + melti = .false. + k_0 = kts + do k = kte-1, kts, -1 + if ( (temp(k).gt. T_0) .and. (rr(k).gt. 0.001e-3) & + .and. ((rs(k+1)+rg(k+1)).gt. 0.01e-3) ) then + k_0 = MAX(k+1, k_0) + melti=.true. + goto 195 + endif + enddo + 195 continue + +!+---+-----------------------------------------------------------------+ +!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) +!.. and non-water-coated snow and graupel when below freezing are +!.. simple. Integrations of m(D)*m(D)*N(D)*dD. +!+---+-----------------------------------------------------------------+ + + do k = kts, kte + ze_rain(k) = 1.e-22 + ze_snow(k) = 1.e-22 + ze_graupel(k) = 1.e-22 + if (L_qr(k)) ze_rain(k) = N0_r(k)*720.*ilamr(k)**7 + + if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & + * (pi*rhosn/6./900.)*(pi*rhosn/6./900.) & + * N0_s(k)*720.*ilams(k)**7 + if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & + * (pi*rhog/6./900.)* (pi*rhog/6./900.) & + * N0_g(k)*720.*ilamg(k)**7 + enddo + +!+---+-----------------------------------------------------------------+ +!..Special case of melting ice (snow/graupel) particles. Assume the +!.. ice is surrounded by the liquid water. Fraction of meltwater is +!.. extremely simple based on amount found above the melting level. +!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting +!.. routines). +!+---+-----------------------------------------------------------------+ + + if (melti .and. k_0.ge.2) then + do k = k_0-1, 1, -1 + +!..Reflectivity contributed by melting snow + fmelt_s = DMIN1(1.0d0-rs(k)/rs(k_0), 1.0d0) + if (fmelt_s.gt.0.01d0 .and. fmelt_s.lt.0.99d0 .and. & + rs(k).gt.R1) then + eta = 0.d0 + obms = 1./ds + ocms = (1./(pi*rhosn/6.))**obms + do n = 1, nbs + x = pi*rhosn/6. * Dds(n)**3 + call rayleigh_soak_wetgraupel (x, DBLE(ocms), DBLE(obms), & + fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, & + CBACK, mixingrulestring_s, matrixstring_s, & + inclusionstring_s, hoststring_s, & + hostmatrixstring_s, hostinclusionstring_s) + f_d = N0_s(k)* DEXP(-Dds(n)/ilams(k)) + eta = eta + f_d * CBACK * simpson(n) * dts(n) + + enddo + ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta) + endif + + +!..Reflectivity contributed by melting graupel + + fmelt_g = DMIN1(1.0d0-rg(k)/rg(k_0), 1.0d0) + if (fmelt_g.gt.0.01d0 .and. fmelt_g.lt.0.99d0 .and. & + rg(k).gt.R1) then + eta = 0.d0 + lamg = 1./ilamg(k) + obmg = 1./dg + ocmg = (1./(pi*rhog/6.))**obmg + do n = 1, nbg + x = pi*rhog/6. * Ddg(n)**3 + call rayleigh_soak_wetgraupel (x, DBLE(ocmg), DBLE(obmg), & + fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, & + CBACK, mixingrulestring_g, matrixstring_g, & + inclusionstring_g, hoststring_g, & + hostmatrixstring_g, hostinclusionstring_g) + f_d = N0_g(k)* DEXP(-lamg*Ddg(n)) + eta = eta + f_d * CBACK * simpson(n) * dtg(n) + enddo + ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta) + endif + + enddo + endif + + do k = kte, kts, -1 + dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18) + enddo + + + end subroutine calc_refl10cm +#ifdef CLUBB_CRM +!------------------------------------------------------------------------------- + SUBROUTINE POSITIVE_QV_ADJ( QV, QC, QR, QI, & + QS, QG, T_IN_K ) +! Description: +! The following was produced by UW-Milwaukee to prevent vapor water mixing +! ratio from becoming negative. This is necessary in the event that a +! process, e.g. depositional growth of ice, causes negative vapor. This +! appears to happen in some circumstances due to the code that will set +! vapor to saturation w.r.t to liquid when we have subgrid scale cloud +! fraction greater than our 1% threshold. + +! References: +! None +!------------------------------------------------------------------------------- + use crmx_constants_clubb, only: Lv, Ls, Cp ! Constant(s) + + IMPLICIT NONE + + ! Constant Parameters + ! The value of epsilon was picked based on how small a 4 bytes float we can + ! add to vapor without it being lost to catastophic round-off. For an 8 + ! byte float a smaller value might be used -dschanen 5 Oct 2009. + REAL, PARAMETER :: & + EPS = 1.E-12 ! Small value of vapor [kg/kg] + + ! Input/Output Variables + REAL, INTENT(INOUT) :: & + QV, & ! Vapor water mixing ratio [kg/kg] + QC, & ! Cloud water mixing ratio [kg/kg] + QR, & ! Rain water mixing ratio [kg/kg] + QI, & ! Ice water mixing ratio [kg/kg] + QS, & ! Snow water mixing ratio [kg/kg] + QG ! Graupel water mixing ratio [kg/kg] + + REAL, INTENT(INOUT) :: & + T_IN_K ! Absolute Temperature [K] + + ! Local Variables + REAL :: & + QT_COND_LIQ, & ! Total water in liquid phase [kg/kg] + QT_COND_ICE, & ! Total water in ice phase [kg/kg] + QT_TOTAL ! Total water ice + liquid [kg/kg] + + REAL :: & + DELTA_QV, DELTA_QT_COND_LIQ, DELTA_QT_COND_ICE, REDUCE_COEF + + ! ---- Begin Code ---- + + ! If vapor is greater than or equal to epsilon, then exit. + IF ( QV >= EPS ) RETURN + +! PRINT *, "BEFORE", QV, QC, QR, QI, QS, QG, T_IN_K + + ! Determine total water + QT_COND_LIQ = QC + QR + + QT_COND_ICE = 0.0 + ! Add ice if it is enabled + IF ( ILIQ == 0 ) THEN + QT_COND_ICE = QT_COND_ICE + QS + QI + END IF + + ! Add graupel if it is enabled + IF ( IGRAUP == 0 ) THEN + QT_COND_ICE = QT_COND_ICE + QG + END IF + + ! Total water mixing ratio = vapor + liquid + ice + QT_TOTAL = QV + QT_COND_LIQ + QT_COND_ICE + + ! If the total water available at this altitude is too small, + ! then we need to apply hole-filling globally instead. + IF ( QT_TOTAL < 2 * EPS ) RETURN + + ! Determine delta qv, the amount to change vapor water mixing ratio by. + DELTA_QV = EPS - QV + + ! Set QV to the minimum value + QV = EPS + + ! Reduce other variables according to the amount we've increased vapor by, + ! in order to conserve total water. + REDUCE_COEF = 1. - ( DELTA_QV / (QT_COND_LIQ + QT_COND_ICE) ) + + ! Compute total change in warm-phase variables + QC = QC * REDUCE_COEF + QR = QR * REDUCE_COEF + + DELTA_QT_COND_LIQ = QT_COND_LIQ - ( QC + QR ) + + ! Compute total change in ice-phase variables + + DELTA_QT_COND_ICE = 0.0 + IF ( ILIQ == 0 ) THEN + QI = QI * REDUCE_COEF + QS = QS * REDUCE_COEF + + IF ( IGRAUP /= 0 ) THEN + DELTA_QT_COND_ICE = QT_COND_ICE - ( QI + QS ) + END IF + END IF + + IF ( IGRAUP == 0 ) THEN + QG = QG * REDUCE_COEF + + DELTA_QT_COND_ICE = QT_COND_ICE - ( QI + QS + QG ) + END IF + + ! Adjust absolute temperature + T_IN_K = T_IN_K - ( Lv / Cp * ( DELTA_QT_COND_LIQ ) ) & + - ( Ls / Cp * ( DELTA_QT_COND_ICE ) ) + +! PRINT *, "AFTER", QV, QC, QR, QI, QS, QG, T_IN_K + RETURN + END SUBROUTINE POSITIVE_QV_ADJ +#endif /*CLUBB_CRM*/ + +END MODULE crmx_module_mp_GRAUPEL diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 new file mode 100644 index 0000000000..749678c89c --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 @@ -0,0 +1,133 @@ + +subroutine cloud + +! Condensation of cloud water/cloud ice. + +use crmx_vars +use crmx_microphysics +use crmx_micro_params +use crmx_params + +implicit none + +integer i,j,k, kb, kc +real dtabs, tabs1, an, bn, ap, bp, om, ag, omp +real fac1,fac2 +real fff,dfff,qsatt,dqsat +real lstarn,dlstarn,lstarp,dlstarp +integer niter + +an = 1./(tbgmax-tbgmin) +bn = tbgmin * an +ap = 1./(tprmax-tprmin) +bp = tprmin * ap +fac1 = fac_cond+(1+bp)*fac_fus +fac2 = fac_fus*ap +ag = 1./(tgrmax-tgrmin) + +!call t_startf ('cloud') + +do k = 1, nzm + do j = 1, ny + do i = 1, nx + + q(i,j,k)=max(0.,q(i,j,k)) + + +! Initail guess for temperature assuming no cloud water/ice: + + + tabs(i,j,k) = t(i,j,k)-gamaz(k) + tabs1=(tabs(i,j,k)+fac1*qp(i,j,k))/(1.+fac2*qp(i,j,k)) + +! Warm cloud: + + if(tabs1.ge.tbgmax) then + + tabs1=tabs(i,j,k)+fac_cond*qp(i,j,k) + qsatt = qsatw_crm(tabs1,pres(k)) + +! Ice cloud: + + elseif(tabs1.le.tbgmin) then + + tabs1=tabs(i,j,k)+fac_sub*qp(i,j,k) + qsatt = qsati_crm(tabs1,pres(k)) + +! Mixed-phase cloud: + + else + + om = an*tabs1-bn + qsatt = om*qsatw_crm(tabs1,pres(k))+(1.-om)*qsati_crm(tabs1,pres(k)) + + endif + + +! Test if condensation is possible: + + + if(q(i,j,k).gt.qsatt) then + + niter=0 + dtabs = 100. + do while(abs(dtabs).gt.0.01.and.niter.lt.10) + if(tabs1.ge.tbgmax) then + om=1. + lstarn=fac_cond + dlstarn=0. + qsatt=qsatw_crm(tabs1,pres(k)) + dqsat=dtqsatw_crm(tabs1,pres(k)) + else if(tabs1.le.tbgmin) then + om=0. + lstarn=fac_sub + dlstarn=0. + qsatt=qsati_crm(tabs1,pres(k)) + dqsat=dtqsati_crm(tabs1,pres(k)) + else + om=an*tabs1-bn + lstarn=fac_cond+(1.-om)*fac_fus + dlstarn=an*fac_fus + qsatt=om*qsatw_crm(tabs1,pres(k))+(1.-om)*qsati_crm(tabs1,pres(k)) + dqsat=om*dtqsatw_crm(tabs1,pres(k))+(1.-om)*dtqsati_crm(tabs1,pres(k)) + endif + if(tabs1.ge.tprmax) then + omp=1. + lstarp=fac_cond + dlstarp=0. + else if(tabs1.le.tprmin) then + omp=0. + lstarp=fac_sub + dlstarp=0. + else + omp=ap*tabs1-bp + lstarp=fac_cond+(1.-omp)*fac_fus + dlstarp=ap*fac_fus + endif + fff = tabs(i,j,k)-tabs1+lstarn*(q(i,j,k)-qsatt)+lstarp*qp(i,j,k) + dfff=dlstarn*(q(i,j,k)-qsatt)+dlstarp*qp(i,j,k)-lstarn*dqsat-1. + dtabs=-fff/dfff + niter=niter+1 + tabs1=tabs1+dtabs + end do + + qsatt = qsatt + dqsat * dtabs + qn(i,j,k) = max(0.,q(i,j,k)-qsatt) + + else + + qn(i,j,k) = 0. + + endif + + tabs(i,j,k) = tabs1 + qp(i,j,k) = max(0.,qp(i,j,k)) ! just in case + + end do + end do +end do + +!call t_stopf ('cloud') + +end subroutine cloud + diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 new file mode 100644 index 0000000000..9e8a22c8db --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 @@ -0,0 +1,88 @@ +module crmx_micro_params + +use crmx_grid, only: nzm + +implicit none + +! Microphysics stuff: + +! Densities of hydrometeors + +real, parameter :: rhor = 1000. ! Density of water, kg/m3 +real, parameter :: rhos = 100. ! Density of snow, kg/m3 +real, parameter :: rhog = 400. ! Density of graupel, kg/m3 +!real, parameter :: rhog = 917. ! hail - Lin 1983 + +! Temperatures limits for various hydrometeors + +real, parameter :: tbgmin = 253.16 ! Minimum temperature for cloud water., K +real, parameter :: tbgmax = 273.16 ! Maximum temperature for cloud ice, K +real, parameter :: tprmin = 268.16 ! Minimum temperature for rain, K +real, parameter :: tprmax = 283.16 ! Maximum temperature for snow+graupel, K +real, parameter :: tgrmin = 223.16 ! Minimum temperature for snow, K +real, parameter :: tgrmax = 283.16 ! Maximum temperature for graupel, K + +! Terminal velocity coefficients + +real, parameter :: a_rain = 842. ! Coeff.for rain term vel +real, parameter :: b_rain = 0.8 ! Fall speed exponent for rain +real, parameter :: a_snow = 4.84 ! Coeff.for snow term vel +real, parameter :: b_snow = 0.25 ! Fall speed exponent for snow +!real, parameter :: a_grau = 40.7! Krueger (1994) ! Coef. for graupel term vel +real, parameter :: a_grau = 94.5 ! Lin (1983) (rhog=400) +!real, parameter :: a_grau = 127.94! Lin (1983) (rhog=917) +real, parameter :: b_grau = 0.5 ! Fall speed exponent for graupel + +! Autoconversion +#ifdef CLUBB_CRM /*microphysical tuning for CLUBB*/ +real, parameter :: qcw0 = 0.6e-3 ! Threshold for water autoconversion, g/g +real, parameter :: qci0 = 1.e-4 ! Threshold for ice autoconversion, g/g +real, parameter :: alphaelq = 10.e-3 ! autoconversion of cloud water rate coef +real, parameter :: betaelq = 6.0e-3 ! autoconversion of cloud ice rate coef +#else +real, parameter :: qcw0 = 1.e-3 ! Threshold for water autoconversion, g/g +real, parameter :: qci0 = 1.e-4 ! Threshold for ice autoconversion, g/g +real, parameter :: alphaelq = 1.e-3 ! autoconversion of cloud water rate coef +real, parameter :: betaelq = 1.e-3 ! autoconversion of cloud ice rate coef +#endif /*CLUBB_CRM*/ + +! Accretion + +real, parameter :: erccoef = 1.0 ! Rain/Cloud water collection efficiency +real, parameter :: esccoef = 1.0 ! Snow/Cloud water collection efficiency +real, parameter :: esicoef = 0.1 ! Snow/cloud ice collection efficiency +real, parameter :: egccoef = 1.0 ! Graupel/Cloud water collection efficiency +real, parameter :: egicoef = 0.1 ! Graupel/Cloud ice collection efficiency + +! Interseption parameters for exponential size spectra + +real, parameter :: nzeror = 8.e6 ! Intercept coeff. for rain +real, parameter :: nzeros = 3.e6 ! Intersept coeff. for snow +real, parameter :: nzerog = 4.e6 ! Intersept coeff. for graupel +!real, parameter :: nzerog = 4.e4 ! hail - Lin 1993 + +real, parameter :: qp_threshold = 1.e-8 ! minimal rain/snow water content + + +! Misc. microphysics variables + +real*4 gam3 ! Gamma function of 3 +real*4 gams1 ! Gamma function of (3 + b_snow) +real*4 gams2 ! Gamma function of (5 + b_snow)/2 +real*4 gams3 ! Gamma function of (4 + b_snow) +real*4 gamg1 ! Gamma function of (3 + b_grau) +real*4 gamg2 ! Gamma function of (5 + b_grau)/2 +real*4 gamg3 ! Gamma function of (4 + b_grau) +real*4 gamr1 ! Gamma function of (3 + b_rain) +real*4 gamr2 ! Gamma function of (5 + b_rain)/2 +real*4 gamr3 ! Gamma function of (4 + b_rain) + +real accrsc(nzm),accrsi(nzm),accrrc(nzm),coefice(nzm) +real accrgc(nzm),accrgi(nzm) +real evaps1(nzm),evaps2(nzm),evapr1(nzm),evapr2(nzm) +real evapg1(nzm),evapg2(nzm) + +real a_bg, a_pr, a_gr + + +end module crmx_micro_params diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 new file mode 100644 index 0000000000..779712df70 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 @@ -0,0 +1,463 @@ +module crmx_microphysics + +! module for original SAM bulk microphysics +! Marat Khairoutdinov, 2006 + +use crmx_grid, only: nx,ny,nzm,nz, dimx1_s,dimx2_s,dimy1_s,dimy2_s ! subdomain grid information +use crmx_params, only: doprecip, docloud, doclubb +use crmx_micro_params +implicit none + +!---------------------------------------------------------------------- +!!! required definitions: + +integer, parameter :: nmicro_fields = 2 ! total number of prognostic water vars + +!!! microphysics prognostic variables are storred in this array: + +real micro_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nmicro_fields) + +integer, parameter :: flag_wmass(nmicro_fields) = (/1,1/) +integer, parameter :: index_water_vapor = 1 ! index for variable that has water vapor +integer, parameter :: index_cloud_ice = 1 ! index for cloud ice (sedimentation) +integer, parameter :: flag_precip(nmicro_fields) = (/0,1/) + +! both variables correspond to mass, not number +integer, parameter :: flag_number(nmicro_fields) = (/0,0/) + +! SAM1MOM 3D microphysical fields are output by default. +integer, parameter :: flag_micro3Dout(nmicro_fields) = (/0,0/) + +real fluxbmk (nx, ny, 1:nmicro_fields) ! surface flux of tracers +real fluxtmk (nx, ny, 1:nmicro_fields) ! top boundary flux of tracers + +!!! these arrays are needed for output statistics: + +real mkwle(nz,1:nmicro_fields) ! resolved vertical flux +real mkwsb(nz,1:nmicro_fields) ! SGS vertical flux +real mkadv(nz,1:nmicro_fields) ! tendency due to vertical advection +real mklsadv(nz,1:nmicro_fields) ! tendency due to large-scale vertical advection +real mkdiff(nz,1:nmicro_fields) ! tendency due to vertical diffusion +real mstor(nz,1:nmicro_fields) ! storage terms of microphysical variables + +!====================================================================== +! UW ADDITIONS + +!bloss: arrays with names/units for microphysical outputs in statistics. +character*3, dimension(nmicro_fields) :: mkname +character*80, dimension(nmicro_fields) :: mklongname +character*10, dimension(nmicro_fields) :: mkunits +real, dimension(nmicro_fields) :: mkoutputscale + +! END UW ADDITIONS +!====================================================================== + +!------------------------------------------------------------------ +! Optional (internal) definitions) + +! make aliases for prognostic variables: +! note that the aliases should be local to microphysics + +real q(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! total nonprecipitating water +real qp(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! total precipitating water +equivalence (q(dimx1_s,dimy1_s,1),micro_field(dimx1_s,dimy1_s,1,1)) +equivalence (qp(dimx1_s,dimy1_s,1),micro_field(dimx1_s,dimy1_s,1,2)) + +real qn(nx,ny,nzm) ! cloud condensate (liquid + ice) + +real qpsrc(nz) ! source of precipitation microphysical processes +real qpevp(nz) ! sink of precipitating water due to evaporation + +real vrain, vsnow, vgrau, crain, csnow, cgrau ! precomputed coefs for precip terminal velocity + +CONTAINS + +! required microphysics subroutines and function: +!---------------------------------------------------------------------- +!!! Read microphysics options from prm file + +subroutine micro_setparm() + ! no user-definable options in SAM1MOM microphysics. +end subroutine micro_setparm + +!---------------------------------------------------------------------- +!!! Initialize microphysics: + + +subroutine micro_init() + +#ifdef CLUBB_CRM + use crmx_params, only: doclubb, doclubbnoninter ! dschanen UWM 21 May 2008 + use crmx_params, only: nclubb +#endif + use crmx_grid, only: nrestart + use crmx_vars, only: q0 + use crmx_params, only: dosmoke + integer k, n +#ifdef CLUBB_CRM +! if ( nclubb /= 1 ) then +! write(0,*) "The namelist parameter nclubb is not equal to 1,", & +! " but SAM single moment microphysics is enabled." +! write(0,*) "This will create unrealistic results in subsaturated grid boxes. ", & +! "Exiting..." +! call task_abort() +! end if +#endif + + a_bg = 1./(tbgmax-tbgmin) + a_pr = 1./(tprmax-tprmin) + a_gr = 1./(tgrmax-tgrmin) + +! if(doprecip) call precip_init() + + if(nrestart.eq.0) then + +#ifndef CRM + micro_field = 0. + do k=1,nzm + q(:,:,k) = q0(k) + end do + qn = 0. +#endif + + fluxbmk = 0. + fluxtmk = 0. + +#ifdef CLUBB_CRM + if ( docloud .or. doclubb ) then +#else + if(docloud) then +#endif +#ifndef CRM + call cloud() +#endif + call micro_diagnose() + end if + if(dosmoke) then + call micro_diagnose() + end if + + end if + + mkwle = 0. + mkwsb = 0. + mkadv = 0. + mkdiff = 0. + mklsadv = 0. + mstor = 0. + + qpsrc = 0. + qpevp = 0. + + mkname(1) = 'QT' + mklongname(1) = 'TOTAL WATER (VAPOR + CONDENSATE)' + mkunits(1) = 'g/kg' + mkoutputscale(1) = 1.e3 + + mkname(2) = 'QP' + mklongname(2) = 'PRECIPITATING WATER' + mkunits(2) = 'g/kg' + mkoutputscale(2) = 1.e3 + +! set mstor to be the inital microphysical mixing ratios + do n=1, nmicro_fields + do k=1, nzm + mstor(k, n) = SUM(micro_field(1:nx,1:ny,k,n)) + end do + end do + +end subroutine micro_init + +!---------------------------------------------------------------------- +!!! fill-in surface and top boundary fluxes: +! +subroutine micro_flux() + + use crmx_vars, only: fluxbq, fluxtq + +#ifdef CLUBB_CRM + ! Added by dschanen UWM + use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes + if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then + ! Add this in later + fluxbmk(:,:,index_water_vapor) = 0.0 + else + fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) + end if +#else + fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) +#endif /*CLUBB_CRM*/ + fluxtmk(:,:,index_water_vapor) = fluxtq(:,:) + +end subroutine micro_flux + +!---------------------------------------------------------------------- +!!! compute local microphysics processes (bayond advection and SGS diffusion): +! +subroutine micro_proc() + + use crmx_grid, only: nstep,dt,icycle + use crmx_params, only: dosmoke +#ifdef CLUBB_CRM + use crmx_params, only: doclubb, doclubbnoninter ! dschanen UWM 21 May 2008 + use crmx_clubbvars, only: cloud_frac + use crmx_vars, only: CF3D + use crmx_grid, only: nzm +#endif + + ! Update bulk coefficient + if(doprecip.and.icycle.eq.1) call precip_init() + + if(docloud) then + call cloud() + if(doprecip) call precip_proc() + call micro_diagnose() + end if + if(dosmoke) then + call micro_diagnose() + end if +#ifdef CLUBB_CRM + if ( doclubb ) then ! -dschanen UWM 21 May 2008 + CF3D(:,:, 1:nzm) = cloud_frac(:,:,2:nzm+1) ! CF3D is used in precip_proc_clubb, + ! so it is set here first +++mhwang +! if(doprecip) call precip_proc() + if(doprecip) call precip_proc_clubb() + call micro_diagnose() + end if +#endif /*CLUBB_CRM*/ + +end subroutine micro_proc + +!---------------------------------------------------------------------- +!!! Diagnose arrays nessesary for dynamical core and statistics: +! +subroutine micro_diagnose() + + use crmx_vars + + real omn, omp + integer i,j,k + + do k=1,nzm + do j=1,ny + do i=1,nx + qv(i,j,k) = q(i,j,k) - qn(i,j,k) + omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) + qcl(i,j,k) = qn(i,j,k)*omn + qci(i,j,k) = qn(i,j,k)*(1.-omn) + omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + qpl(i,j,k) = qp(i,j,k)*omp + qpi(i,j,k) = qp(i,j,k)*(1.-omp) + end do + end do + end do + + + +end subroutine micro_diagnose + +#ifdef CLUBB_CRM +!--------------------------------------------------------------------- +subroutine micro_update() + +! Description: +! This subroutine essentially does what micro_proc does but does not +! call any microphysics subroutines. We need this so that CLUBB gets a +! properly updated value of ice fed in. +! +! dschanen UWM 7 Jul 2008 +!--------------------------------------------------------------------- + +! call cloud() +! call micro_diagnose() + + call micro_diagnose_clubb() + +end subroutine micro_update + +!--------------------------------------------------------------------- +subroutine micro_adjust( new_qv, new_qc ) +! Description: +! Adjust vapor and liquid water. +! Microphysical variables are stored separately in +! SAM's dynamics + CLUBB ( e.g. qv, qcl, qci) and +! SAM's microphysics. (e.g. q and qn). +! This subroutine stores values of qv, qcl updated by CLUBB +! in the single-moment microphysical variables q and qn. +! +! dschanen UWM 20 May 2008 +!--------------------------------------------------------------------- + + use crmx_vars, only: qci + + implicit none + + real, dimension(nx,ny,nzm), intent(in) :: & + new_qv, & ! Water vapor mixing ratio that has been adjusted by CLUBB [kg/kg] + new_qc ! Cloud water mixing ratio that has been adjusted by CLUBB [kg/kg]. + ! For the single moment microphysics, it is liquid + ice + + q(1:nx,1:ny,1:nzm) = new_qv + new_qc ! Vapor + Liquid + Ice + qn(1:nx,1:ny,1:nzm) = new_qc ! Liquid + Ice + + return +end subroutine micro_adjust + +subroutine micro_diagnose_clubb() + + use crmx_vars + use crmx_constants_clubb, only: fstderr, zero_threshold + use crmx_error_code, only: clubb_at_least_debug_level ! Procedur + + real omn, omp + integer i,j,k + + do k=1,nzm + do j=1,ny + do i=1,nx +! For CLUBB, water vapor and liquid water is used +! so set qcl to qn while qci to zero. This also allows us to call CLUBB +! every nclubb th time step (see sgs_proc in sgs.F90) + + qv(i,j,k) = q(i,j,k) - qn(i,j,k) + ! Apply local hole-filling to vapor by converting liquid to vapor. Moist + ! static energy should be conserved, so updating temperature is not + ! needed here. -dschanen 31 August 2011 + if ( qv(i,j,k) < zero_threshold ) then + qn(i,j,k) = qn(i,j,k) + qv(i,j,k) + qv(i,j,k) = zero_threshold + if ( qn(i,j,k) < zero_threshold ) then + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) "Total water at", "i =", i, "j =", j, "k =", k, "is negative.", & + "Applying non-conservative hard clipping." + end if + qn(i,j,k) = zero_threshold + end if ! cloud_liq < 0 + end if ! qv < 0 + + qcl(i,j,k) = qn(i,j,k) + qci(i,j,k) = 0.0 + omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + qpl(i,j,k) = qp(i,j,k)*omp + qpi(i,j,k) = qp(i,j,k)*(1.-omp) + end do + end do + end do + +end subroutine micro_diagnose_clubb + +#endif /*CLUBB_CRM*/ +!---------------------------------------------------------------------- +!!! function to compute terminal velocity for precipitating variables: +! In this particular case there is only one precipitating variable. + +real function term_vel_qp(i,j,k,ind) + + use crmx_vars + integer, intent(in) :: i,j,k,ind + real wmax, omp, omg, qrr, qss, qgg + + term_vel_qp = 0. + if(qp(i,j,k).gt.qp_threshold) then + omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + if(omp.eq.1.) then + term_vel_qp = vrain*(rho(k)*qp(i,j,k))**crain + elseif(omp.eq.0.) then + omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) + qgg=omg*qp(i,j,k) + qss=qp(i,j,k)-qgg + term_vel_qp = (omg*vgrau*(rho(k)*qgg)**cgrau & + +(1.-omg)*vsnow*(rho(k)*qss)**csnow) + else + omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) + qrr=omp*qp(i,j,k) + qss=qp(i,j,k)-qrr + qgg=omg*qss + qss=qss-qgg + term_vel_qp = (omp*vrain*(rho(k)*qrr)**crain & + +(1.-omp)*(omg*vgrau*(rho(k)*qgg)**cgrau & + +(1.-omg)*vsnow*(rho(k)*qss)**csnow)) + endif + end if +end function term_vel_qp + +!---------------------------------------------------------------------- +!!! compute sedimentation +! +subroutine micro_precip_fall() + + use crmx_vars + use crmx_params, only : pi + + real omega(nx,ny,nzm) + integer ind + integer i,j,k + + crain = b_rain / 4. + csnow = b_snow / 4. + cgrau = b_grau / 4. + vrain = a_rain * gamr3 / 6. / (pi * rhor * nzeror) ** crain + vsnow = a_snow * gams3 / 6. / (pi * rhos * nzeros) ** csnow + vgrau = a_grau * gamg3 / 6. / (pi * rhog * nzerog) ** cgrau + + do k=1,nzm + do j=1,ny + do i=1,nx + omega(i,j,k) = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + end do + end do + end do + + call precip_fall(qp, term_vel_qp, 2, omega, ind) + + +end subroutine micro_precip_fall + +!---------------------------------------------------------------------- +! called when stepout() called + +subroutine micro_print() +end subroutine micro_print + +!----------------------------------------------------------------------- +! Supply function that computes total water in a domain: +! +real(kind=selected_real_kind(12)) function total_water() + + use crmx_vars, only : nstep,nprint,adz,dz,rho + real(kind=selected_real_kind(12)) tmp + integer i,j,k,m + + total_water = 0. + do m=1,nmicro_fields + if(flag_wmass(m).eq.1) then + do k=1,nzm + tmp = 0. + do j=1,ny + do i=1,nx + tmp = tmp + micro_field(i,j,k,m) + end do + end do + total_water = total_water + tmp*adz(k)*dz*rho(k) + end do + end if + end do + +end function total_water + +! ------------------------------------------------------------------------------- +! dummy effective radius functions: + +function Get_reffc() ! liquid water + real, pointer, dimension(:,:,:) :: Get_reffc +end function Get_reffc + +function Get_reffi() ! ice + real, pointer, dimension(:,:,:) :: Get_reffi +end function Get_reffi + + +end module crmx_microphysics + + + diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 new file mode 100644 index 0000000000..04dd336d45 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 @@ -0,0 +1,117 @@ + +subroutine precip_init + +! Initialize precipitation related stuff + +use crmx_vars +use crmx_microphysics +use crmx_micro_params +use crmx_params + +implicit none + +real pratio, coef1, coef2,estw,esti,rrr1,rrr2 +real*4 gammafff +external gammafff +integer k + +gam3 = 3. +gamr1 = 3.+b_rain +gamr2 = (5.+b_rain)/2. +gamr3 = 4.+b_rain +gams1 = 3.+b_snow +gams2 = (5.+b_snow)/2. +gams3 = 4.+b_snow +gamg1 = 3.+b_grau +gamg2 = (5.+b_grau)/2. +gamg3 = 4.+b_grau +gam3 = gammafff(gam3) +gamr1 = gammafff(gamr1) +gamr2 = gammafff(gamr2) +gamr3 = gammafff(gamr3) +gams1 = gammafff(gams1) +gams2 = gammafff(gams2) +gams3 = gammafff(gams3) +gamg1 = gammafff(gamg1) +gamg2 = gammafff(gamg2) +gamg3 = gammafff(gamg3) +!if(masterproc) then +! print*,'gam3=',gam3 +! print*,'gamr1,gamr2,gamr3:',gamr1,gamr2,gamr3 +! print*,'gams1,gams2,gams3:',gams1,gams2,gams3 +! print*,'gamg1,gamg2,gamg3:',gamg1,gamg2,gamg3 +!endif +if(nint(gam3).ne.2) then + if(masterproc)print*,'cannot compute gamma-function in precip_init. Exiting...' + call task_abort +end if + +do k=1,nzm + +! pratio = (1000. / pres(k)) ** 0.4 + pratio = sqrt(1.29 / rho(k)) + + rrr1=393./(tabs0(k)+120.)*(tabs0(k)/273.)**1.5 + rrr2=(tabs0(k)/273.)**1.94*(1000./pres(k)) + + estw = 100.*esatw_crm(tabs0(k)) + esti = 100.*esati_crm(tabs0(k)) + +! accretion by snow: + + coef1 = 0.25 * pi * nzeros * a_snow * gams1 * pratio/ & + (pi * rhos * nzeros/rho(k) ) ** ((3+b_snow)/4.) + coef2 = exp(0.025*(tabs0(k) - 273.15)) + accrsi(k) = coef1 * coef2 * esicoef + accrsc(k) = coef1 * esccoef + coefice(k) = coef2 + +! evaporation of snow: + + coef1 =(lsub/(tabs0(k)*rv)-1.)*lsub/(therco*rrr1*tabs0(k)) + coef2 = rv*tabs0(k)/(diffelq*rrr2*esti) + evaps1(k) = 0.65*4.*nzeros/sqrt(pi*rhos*nzeros)/(coef1+coef2)/sqrt(rho(k)) + evaps2(k) = 0.49*4.*nzeros*gams2*sqrt(a_snow/(muelq*rrr1))/ & + (pi*rhos*nzeros)**((5+b_snow)/8.) / (coef1+coef2) & + * rho(k)**((1+b_snow)/8.)*sqrt(pratio) + +! accretion by graupel: + + coef1 = 0.25*pi*nzerog*a_grau*gamg1*pratio/& + (pi*rhog*nzerog/rho(k))**((3+b_grau)/4.) + coef2 = exp(0.025*(tabs0(k) - 273.15)) + accrgi(k) = coef1 * coef2 * egicoef + accrgc(k) = coef1 * egccoef + +! evaporation of graupel: + + coef1 =(lsub/(tabs0(k)*rv)-1.)*lsub/(therco*rrr1*tabs0(k)) + coef2 = rv*tabs0(k)/(diffelq*rrr2*esti) + evapg1(k) = 0.65*4.*nzerog/sqrt(pi*rhog*nzerog)/(coef1+coef2)/sqrt(rho(k)) + evapg2(k) = 0.49*4.*nzerog*gamg2*sqrt(a_grau/(muelq*rrr1))/ & + (pi * rhog * nzerog)**((5+b_grau)/8.) / (coef1+coef2) & + * rho(k)**((1+b_grau)/8.)*sqrt(pratio) + + +! accretion by rain: + + accrrc(k)= 0.25 * pi * nzeror * a_rain * gamr1 * pratio/ & + (pi * rhor * nzeror / rho(k)) ** ((3+b_rain)/4.)* erccoef + +! evaporation of rain: + + coef1 =(lcond/(tabs0(k)*rv)-1.)*lcond/(therco*rrr1*tabs0(k)) + coef2 = rv*tabs0(k)/(diffelq * rrr2 * estw) + evapr1(k) = 0.78 * 2. * pi * nzeror / & + sqrt(pi * rhor * nzeror) / (coef1+coef2) / sqrt(rho(k)) + evapr2(k) = 0.31 * 2. * pi * nzeror * gamr2 * & + 0.89 * sqrt(a_rain/(muelq*rrr1))/ & + (pi * rhor * nzeror)**((5+b_rain)/8.) / (coef1+coef2) & + * rho(k)**((1+b_rain)/8.)*sqrt(pratio) + +end do + + +end subroutine precip_init + + diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 new file mode 100644 index 0000000000..78b750ca89 --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 @@ -0,0 +1,136 @@ + +subroutine precip_proc + +use crmx_vars +use crmx_microphysics +use crmx_micro_params +use crmx_params + +implicit none + +integer i,j,k +real autor, autos, accrr, accris, accrcs, accrig, accrcg +real dq, omn, omp, omg, qsatt +real pows1, pows2, powg1, powg2, powr1, powr2, tmp +real qii, qcc, qrr, qss, qgg + +powr1 = (3 + b_rain) / 4. +powr2 = (5 + b_rain) / 8. +pows1 = (3 + b_snow) / 4. +pows2 = (5 + b_snow) / 8. +powg1 = (3 + b_grau) / 4. +powg2 = (5 + b_grau) / 8. + +!call t_startf ('precip_proc') + +do k=1,nzm + qpsrc(k)=0. + qpevp(k)=0. + do j=1,ny + do i=1,nx + +!------- Autoconversion/accretion + + if(qn(i,j,k)+qp(i,j,k).gt.0.) then + + + omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) + omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) + + if(qn(i,j,k).gt.0.) then + + qcc = qn(i,j,k) * omn + qii = qn(i,j,k) * (1.-omn) + + if(qcc .gt. qcw0) then + autor = alphaelq + else + autor = 0. + endif + + if(qii .gt. qci0) then + autos = betaelq*coefice(k) + else + autos = 0. + endif + + accrr = 0. + if(omp.gt.0.001) then + qrr = qp(i,j,k) * omp + accrr = accrrc(k) * qrr ** powr1 + end if + accrcs = 0. + accris = 0. + if(omp.lt.0.999.and.omg.lt.0.999) then + qss = qp(i,j,k) * (1.-omp)*(1.-omg) + tmp = qss ** pows1 + accrcs = accrsc(k) * tmp + accris = accrsi(k) * tmp + end if + accrcg = 0. + accrig = 0. + if(omp.lt.0.999.and.omg.gt.0.001) then + qgg = qp(i,j,k) * (1.-omp)*omg + tmp = qgg ** powg1 + accrcg = accrgc(k) * tmp + accrig = accrgi(k) * tmp + endif + qcc = (qcc+dtn*autor*qcw0)/(1.+dtn*(accrr+accrcs+accrcg+autor)) + qii = (qii+dtn*autos*qci0)/(1.+dtn*(accris+accrig+autos)) + dq = dtn *(accrr*qcc + autor*(qcc-qcw0)+ & + (accris+accrig)*qii + (accrcs+accrcg)*qcc + autos*(qii-qci0)) + dq = min(dq,qn(i,j,k)) + qp(i,j,k) = qp(i,j,k) + dq + q(i,j,k) = q(i,j,k) - dq + qn(i,j,k) = qn(i,j,k) - dq + qpsrc(k) = qpsrc(k) + dq + + elseif(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then + + qsatt = 0. + if(omn.gt.0.001) qsatt = qsatt + omn*qsatw_crm(tabs(i,j,k),pres(k)) + if(omn.lt.0.999) qsatt = qsatt + (1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) + dq = 0. + if(omp.gt.0.001) then + qrr = qp(i,j,k) * omp + dq = dq + evapr1(k)*sqrt(qrr) + evapr2(k)*qrr**powr2 + end if + if(omp.lt.0.999.and.omg.lt.0.999) then + qss = qp(i,j,k) * (1.-omp)*(1.-omg) + dq = dq + evaps1(k)*sqrt(qss) + evaps2(k)*qss**pows2 + end if + if(omp.lt.0.999.and.omg.gt.0.001) then + qgg = qp(i,j,k) * (1.-omp)*omg + dq = dq + evapg1(k)*sqrt(qgg) + evapg2(k)*qgg**powg2 + end if + dq = dq * dtn * (q(i,j,k) /qsatt-1.) + dq = max(-0.5*qp(i,j,k),dq) + qp(i,j,k) = qp(i,j,k) + dq + q(i,j,k) = q(i,j,k) - dq + qpevp(k) = qpevp(k) + dq + + else + + q(i,j,k) = q(i,j,k) + qp(i,j,k) + qpevp(k) = qpevp(k) - qp(i,j,k) + qp(i,j,k) = 0. + + endif + + endif + + dq = qp(i,j,k) + qp(i,j,k)=max(0.,qp(i,j,k)) + q(i,j,k) = q(i,j,k) + (dq-qp(i,j,k)) + + end do + enddo +enddo + + + +!call t_stopf ('precip_proc') + +end subroutine precip_proc + diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 new file mode 100644 index 0000000000..5a90a032ff --- /dev/null +++ b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 @@ -0,0 +1,202 @@ +#define CLDFRAC +#ifdef CLDFRAC +subroutine precip_proc_clubb + +#ifdef CLUBB_CRM +use crmx_vars +use crmx_microphysics +use crmx_micro_params +use crmx_params +use crmx_vars, only: CF3D + +implicit none + +integer i,j,k +real autor, autos, accrr, accris, accrcs, accrig, accrcg +real dq, omn, omp, omg, qsatt +real pows1, pows2, powg1, powg2, powr1, powr2, tmp +real qii, qcc, qrr, qss, qgg + +real cld3d(nx, ny, nzm), cldmax(nx, ny, nzm) +real cld3d_temp(nx, ny, nzm) +real cloud_frac_thresh +real qclr +real dqpsrc, dqpevp + +powr1 = (3 + b_rain) / 4. +powr2 = (5 + b_rain) / 8. +pows1 = (3 + b_snow) / 4. +pows2 = (5 + b_snow) / 8. +powg1 = (3 + b_grau) / 4. +powg2 = (5 + b_grau) / 8. + +!call t_startf ('precip_proc_clubb') + +! Get cloud fraction of non-precipitating condensate +! and precipitating condensate +cloud_frac_thresh = 0.005 +do j=1, ny + do i=1, nx + do k=nzm, 1, -1 + cld3d(i, j, k) = CF3D(i,j,k) + cld3d_temp(i, j, k) = min(0.999, max(CF3D(i,j,k), cloud_frac_thresh)) + end do + cldmax(i,j,nzm)=cld3d_temp(i,j,nzm) + + do k=nzm-1, 1, -1 + ! if precipitating condensate is smaller than threshold, set cldmax + ! to cloud fraction at current level + if(qp(i, j, k+1).ge.qp_threshold) then + cldmax(i,j,k) = max(cldmax(i,j,k+1), cld3d_temp(i,j,k)) + else + cldmax(i,j,k) = cld3d_temp(i,j,k) + end if + +! if(cld3d(i,j,k).le.cloud_frac_thresh .and. qp(i,j,k).gt.qp_threshold) then +! if(cldmax(i,j,k).lt.0.1) then +! cldmax(i,j,k) = 0.50 +! end if +! end if + end do +! test: assume precipitating hydrometer fill the whole grid box +! cldmax(i,j,:) = 0.999 + + end do +end do + + +do k=1,nzm + qpsrc(k)=0. + qpevp(k)=0. + do j=1,ny + do i=1,nx + dqpsrc = 0.0 + dqpevp = 0.0 + +!------- Autoconversion/accretion + + if(qn(i,j,k)+qp(i,j,k).gt.0.) then + + + omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) + omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) + omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) + +! if(qn(i,j,k).gt.0.) then + if(cld3d(i,j,k).gt.0.) then ! the generation of precipitating condensate + + qcc = qn(i,j,k) * omn /cld3d_temp(i,j,k) + qii = qn(i,j,k) * (1.-omn)/cld3d_temp(i,j,k) + + if(qcc .gt. qcw0) then + autor = alphaelq + else + autor = 0. + endif + + if(qii .gt. qci0) then + autos = betaelq*coefice(k) + else + autos = 0. + endif + + accrr = 0. + if(omp.gt.0.001) then + qrr = qp(i,j,k) * omp / cldmax(i,j,k) + accrr = accrrc(k) * qrr ** powr1 + end if + accrcs = 0. + accris = 0. + if(omp.lt.0.999.and.omg.lt.0.999) then + qss = qp(i,j,k) * (1.-omp)*(1.-omg) / cldmax(i,j,k) + tmp = qss ** pows1 + accrcs = accrsc(k) * tmp + accris = accrsi(k) * tmp + end if + accrcg = 0. + accrig = 0. + if(omp.lt.0.999.and.omg.gt.0.001) then + qgg = qp(i,j,k) * (1.-omp)*omg / cldmax(i,j,k) + tmp = qgg ** powg1 + accrcg = accrgc(k) * tmp + accrig = accrgi(k) * tmp + endif + qcc = (qcc+dtn*autor*qcw0)/(1.+dtn*(accrr+accrcs+accrcg+autor)) + qii = (qii+dtn*autos*qci0)/(1.+dtn*(accris+accrig+autos)) + dq = dtn *(accrr*qcc + autor*(qcc-qcw0)+ & + (accris+accrig)*qii + (accrcs+accrcg)*qcc + autos*(qii-qci0)) + + dq = dq * cld3d(i,j,k) ! convert fro the in-cloud value to grid-mean value + + dq = min(dq,qn(i,j,k)) +! qp(i,j,k) = qp(i,j,k) + dq +! q(i,j,k) = q(i,j,k) - dq +! qn(i,j,k) = qn(i,j,k) - dq + dqpsrc = dq + qpsrc(k) = qpsrc(k) + dq + + end if + + !elseif(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then + ! Evaporation is only allowed when cldmax exceeds cld3d_temp +! if(qp(i,j,k).gt.qp_threshold.and.cldmax(i,j,k).gt.cld3d_temp(i,j,k)) then + if(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then + + qsatt = 0. + if(omn.gt.0.001) qsatt = qsatt + omn*qsatw_crm(tabs(i,j,k),pres(k)) + if(omn.lt.0.999) qsatt = qsatt + (1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) + dq = 0. + if(omp.gt.0.001) then + qrr = qp(i,j,k) * omp /cldmax(i,j,k) + dq = dq + evapr1(k)*sqrt(qrr) + evapr2(k)*qrr**powr2 + end if + if(omp.lt.0.999.and.omg.lt.0.999) then + qss = qp(i,j,k) * (1.-omp)*(1.-omg) / cldmax(i,j,k) + dq = dq + evaps1(k)*sqrt(qss) + evaps2(k)*qss**pows2 + end if + if(omp.lt.0.999.and.omg.gt.0.001) then + qgg = qp(i,j,k) * (1.-omp)*omg /cldmax(i,j,k) + dq = dq + evapg1(k)*sqrt(qgg) + evapg2(k)*qgg**powg2 + end if + +! dq = dq * dtn * (q(i,j,k) /qsatt-1.) + qclr = max(0., (q(i,j,k)-qn(i,j,k)-qsatt * cld3d(i,j,k)))/max(0.001, (1-cld3d(i,j,k))) + qclr = min(qclr, qsatt) + dq = dq * dtn * (qclr/qsatt-1.) + dq = dq * (cldmax(i,j,k) - cld3d_temp(i,j,k)) ! convert this to the grid-mean value + + dq = max(-0.5*qp(i,j,k),dq) +! qp(i,j,k) = qp(i,j,k) + dq +! q(i,j,k) = q(i,j,k) - dq + dqpevp = dq + qpevp(k) = qpevp(k) + dq + + end if + + if(qp(i,j,k).le.qp_threshold .and. cld3d(i,j,k).le.0) then +! q(i,j,k) = q(i,j,k) + qp(i,j,k) + dqpevp = dqpevp - qp(i,j,k) + qpevp(k) = qpevp(k) - qp(i,j,k) +! qp(i,j,k) = 0. + endif + + endif + + qp(i,j,k) = qp(i,j,k) + dqpsrc + dqpevp + q(i,j,k) = q(i,j,k) - dqpsrc - dqpevp + qn(i,j,k) = qn(i,j,k) - dqpsrc + + dq = qp(i,j,k) + qp(i,j,k)=max(0.,qp(i,j,k)) + q(i,j,k) = q(i,j,k) + (dq-qp(i,j,k)) + + end do + enddo +enddo + +!call t_stopf ('precip_proc_clubb') + +#endif /*CLUBB_CRM*/ +end subroutine precip_proc_clubb +#endif + diff --git a/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt b/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt new file mode 100644 index 0000000000..6703aea205 --- /dev/null +++ b/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt @@ -0,0 +1,141 @@ + +Here we merge CRM in SPCAM5 (https://svn-ccsm-models.cgd.ucar.edu/cam1/branches/spcam1_5_00_cam5_2_09_pnnl) +from the version of sam6.8.2 (sam_clubb trunk revision r763) to sam6.10.4 (the pnnl branch of sam_clubb revision tag r1130: + http://carson.math.uwm.edu/repos/sam_repos/branches/sam_clubb_r1061_pnnl) + +steps to do this: +1. compare sam_clubb r763 with the pnnl branch of sam_CLUBB r1130 +2. compare sam_clubb r763 with crm in SPCAM5 +3. compare sam_clubb r1130 with crm in SPCAM5 + +copy r763, r1130 to the src directory (models/atm/cam/src/physics/) + +July 1st, 2013: +advect_mom.F90: no change from spcam5_2_09 +advect_all_scalars.F90: not in r763, so copy it directly from r1130. DONE +./ADV_MPDATA/advect_scalar.F90: remove statistical part + /advect_scalar2D.F90: no change from r1130 + /advect_scalar3D.F90: no change from r1130 + /advection.F90: no change from r1130 +./ADV_UM5/advect_scalar.F90: remove statistical part + /advect_scalar2D.F90: no change from r1130 + /advect_scalar3D.F90: no change from r1130 +The above three files listed under ./crm are removed. + +boudaries.F90: copy "use grid, only: dompi" from r1130. So now boudaries.F90 + are identifical for spcam5_2_09 and r1130. +buoyancy.F90: add betu, betd part from r1130 + +clubb_sgs.F90: Incorporate changes from r1130 + +clubbvars.F90: incorporate changes from r1130 to spcam5_2_09 +clubb_silhs_vars.F90: directly copy it from r1130. This is not enabled in MMF. + +comparess3D.F90: the same as spcam5_2_09. No change. +coriolis.F90: update dvdt formula from r1130. + +crm_module.F90: DONE +crmsurface.F90: the same as spcam5_2_09. surface.F90 in r763 and r1130 are + different, but these differences are not relevant to SPCAM. +crmtracers.F90: the same as spcam5_2_09. No change from r763 to r1130. +damping.F90: No change. Note: the damping of t and micro_filed is removed from + r1130. Need to check with Marat to see whether we should incoroprate + this change to SPCAM5 as well. +diagnose.F90: incorporate changes from r763 to r1130 to spcam5_2_09. + +create two new subdirectories: SGS_TKE; SGS_CLUBBkvhkvm for subgrid treatment +./SGS_TKE/diffuse_mom.F90: the same as that in spcam5_2_09 +./SGS_TKE/diffuse_mom2D.F90: the same as r1130. No clubb-related codes, as + CLUBB-related code is added in a separate directory (SGS_CLUBBkvhkvm) +./SGS_TKE/diffuse_mom3d.F90: the same as r1130. No clubb-related codes, as + CLUBB-related code is added in a separate directory (SGS_CLUBBkvhkvm) +./SGS_TKE/diffuse_scalar.F90: the same as spcam5_2_09 (except tkh from sgs) +./SGS_TKE/diffuse_scalar2D.F90: the same as r1130; +./SGS_TKE/diffuse_scalar3D.F90: the same as r1130; +./SGS_TKE/shear_prod2D.F90: no change from r1130 or spcam5_2_09 +./SGS_TKE/shear_prod3D.F90: no change from r1130 or spcam5_2_09 +./SGS_TKE/tke_full.F90: adopted the one from r1130, but add changes from + spcam5_2_09 in terms of *_crm subroutine. In r763, tke is only updated + if .not.doscalar when dosmagor is true, but in r1130, no such + restriction. +./SGS_TKE/sgs.F90: + i) sgs_setparm: comment out reading namelist + ii) no change in sgs_init. This is now called in crm_module.F90, after + micro_init, and grdf_x, grdf_y, grdf_z are calcluated in + sgs_init. These were calcluated in crm_module.F90 in SPCAM5. + iii) sgs_statistics: this may need to be removed + +./SGS_CLUBBkvhkvm/sgs.F90: add docam_sfc_fluxes flag +./SGS_CLUBBkvhkvm/tke_full.F90: the same as the one from ./SGS_TKE/ +./SGS_CLUBBkvhkvm/diffuse_mom.F90: remove statistics +./SGS_CLUBBkvhkvm/diffuse_mom2D.F90: add docam_sfc_fluxes +./SGS_CLUBBkvhkvm/diffuse_mom2D_xy.F90: remove CLUBB-related. +./SGS_CLUBBkvhkvm/diffuse_mom2D_z.F90: add docam_sfc_fluxes +./SGS_CLUBBkvhkvm/diffuse_mom3D.F90: add docam_sfc_fluxes +./SGS_CLUBBkvhkvm/diffuse_mom3D_xy.F90: remove clubb-related +./SGS_CLUBBkvhkvm/diffuse_mom3D_z.F90: add docam_sfc_fluxes +./SGS_CLUBBkvhkvm/diffuse_scalar.F90: incorporate changes from spcam5_2_09 +./SGS_CLUBBkvhkvm/diffuse_scalar_xy.F90: incorporate changes from spcam5_2_09 +./SGS_CLUBBkvhkvm/diffuse_scalar_z.F90: incorporate chagnes from spcam5_2_09 +./SGS_CLUBBkvhkvm/fluxes_scalar_z.F90: incorporate changes from spcam5_2_09 + +domain.F90: no change from spcam5_2_09 +ftt.F: no change from spcam5_2_09 +forcing.F90: no change from spcam5_2_09 +gammaff.c: no change from spcam5_2_09 (seems not included in r1130 or r763) +grid.F90: Identifical to the one from r1130. There are large difference + between r1130 and r763. Need to double check whether there is any + potential issues. +ice_fall.F90: no change from spcam5_2_09 +init.F90: add qtostor to the one from spcam5_2_09 +kurant.F90: adopt one from r1130 +params.F90: adopt one from r1130, but add CRM-related codes. This is quite + different from r763 and spcam5_2_09. Need to double check to see + whether there is any poential issues +periodic.F90: adopt the one from r1130, and change CLUBB to CLUBB_CRM +precip_fall.F90: No change from spcam5_2_09 +press_grad.F90: the same as spcam5_2_09, but adopte changes from r763 to + r1130 ( a fix by P. Bloss). +press_rhs.F90: the same as the one from r1130 +pressure.F90: the same as the one from spcam5_2_09, but add "use params, only: + dowallx, dowally, docolumn". Probably need to check with Marat to see + whether we need update this. Pressure-related subroutines have littles + change from r763 to r1130. +random.F90: no changes from either spcam5_2_09 or r1130 +sat.F90: the same as spcam5_2_09 (quite different from r1130. But no change + from r763 to r1130). + +NO SETDATA.F90 in spcam5, but sgs_init is called in setdata. + so sgs_inti is called in crm_module.F90 + +setparm.F90: adopt from r1130, and add MMF-related from spcam5_2_09 + Things to note: sgs_setparm; forz and fcor are not caclcualted here in + r1130 any more (they are calculated in setgrid.F), but this is still + kept here. +setperturb.F90: Tke is now treated by calling setperturb_sgs. Otherwise, it is + the same as spcam5_2_09. + +stat_clubb.F90: Copy it from r1130. NO CHANGE YET. NEED TO BE CHANGED + +stepout.F90: No change from spcam5_2_09. It is not used in spcam5. so we may + remove it in the future. +task_init.F90: No change from spcam5_2_09 +task_util_NOMPI.F90: No change from spacm5_2_09 +tke_full.F90: deleted, as this has been added into ./SGS_TKE/ +utils.F90: Incorporate changes from r1130. +vars.F90: Incorporate changes from r1130. fcory(ny) is changed to fcory(0:ny). So the calculation of fcory in +crm_module is changed as well. + +./MICRO_SAM1MOM/cloud.F90: the same as spcam5_2_09 +./MICRO_SAM1MOM/micro_params.F90: the same as spcam5_2_09 +./MICRO_SAM1MOM/microphysics.F90: adopt changes from r1130. + s_ar is removed from micro_precip_fall +./MICRO_SAM1MOM/precip_init.F90: the same as spcam5_2_09 +./MICRO_SAM1MOM/precip_proc.F90: the same as spcam5_2_09 +./MICRO_SAM1MOM/precip_proc_clubb.F90: adopt from r1130 +./MICRO_M2005/microphysics.F90: incorporates changes from r1130 +./MICRO_M2005/module_mp_graupel.F90: incorporate change from r1130. Those + changes are quite minor, except a scaling factor is applied to contact + freezing nucleaiton rate and homogeneous freezing of cloud droplets. + +./CLUBB/: create a new CLUBB directory for the latest CLUBB used in MMF diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 new file mode 100644 index 0000000000..5e76947cfb --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 @@ -0,0 +1,2366 @@ +!------------------------------------------------------------------------------- +! $Id: clubb_sgs.F90 1103 2013-05-14 18:35:02Z minghuai.wang@pnl.gov $ +module crmx_clubb_sgs +#ifdef CLUBB_CRM +! Description: +! Contains function and subroutines for interfacing with the UW Milwaukee +! Single-Column Model and also the CLUBB-SILHS subcolumn generator. + +! References: +! See DOC/CLUBB/clubb_doc/CLUBBeqns.pdf in this directory. +!------------------------------------------------------------------------------- + + use crmx_clubb_core, only: & + setup_clubb_core, advance_clubb_core, & + cleanup_clubb_core + + use crmx_clubb_precision, only: & + time_precision, & ! Constant(s) + core_rknd + + use crmx_domain, only: & + nsubdomains_x, & + nsubdomains_y + + use crmx_clubbvars, only: l_stats_samgrid + + implicit none + + private + + public :: clubb_sgs_setup, advance_clubb_sgs, clubb_sgs_cleanup, & + apply_clubb_sgs_tndcy, apply_clubb_sgs_tndcy_scalars, apply_clubb_sgs_tndcy_mom, t2thetal + + public :: total_energy + + logical, private :: lstats_clubb + + integer, dimension(nsubdomains_x*nsubdomains_y), private :: & + sample_nodes, x_samp, y_samp + + integer, private :: x_samp_node, y_samp_node + +#ifdef CLUBB_LH + integer, private, save :: LH_iter = 0 +#endif /* CLUBB_LH */ + contains +!------------------------------------------------------------------------------- + subroutine clubb_sgs_setup( dt_clubb, latitude, longitude, z, rho, zi, rhow, tv0, tke ) + +! Description: +! Initialize UWM CLUBB. + +! References: +! None +!------------------------------------------------------------------------------- + + ! From the CLUBB directory + use crmx_error_code, only: & + clubb_no_error, set_clubb_debug_level ! Subroutines + + use crmx_parameter_indices, only: & + nparams ! Constant + + use crmx_constants_clubb, only: & + em_min, w_tol_sqd, rt_tol, thl_tol, zero_threshold, & ! Constants + fstderr, fstdout + + use crmx_grid_class, only: & + zm2zt, zt2zm, & ! Functions + gr ! Derived type + + ! These are only needed if we're using a passive scalar + use crmx_array_index, only: & + iisclr_rt, iisclr_thl, iisclr_CO2, & ! [kg/kg]/[K]/[1e6 mol/mol] + iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2 ! " " + + use crmx_parameters_tunable, only: & + read_parameters ! Subroutine + + use crmx_stats_subs, only: & + stats_init ! Subroutine + + use crmx_stat_clubb, only: stats_init_clubb + + use crmx_model_flags, only: & + l_use_boussinesq, & ! Variables + l_tke_aniso + + ! From the SAM directory + use crmx_grid, only: rank, nx, ny, nz, nzm, dx, dy, time, case, caseid, & + nrestart, dimx1_s, dimx2_s, dimy1_s, dimy2_s, ntracers ! Variable(s) + + use crmx_params, only: lcond, cp ! Constants + + use crmx_params, only: doclubb_sfc_fluxes ! Variable(s) +#ifdef CLUBB_LH + use crmx_microphysics, only: & + mkname, nmicro_fields ! Variable(s) + + use crmx_array_index, only: & + iirrainm, iiNrm, iirsnowm, iiricem, iirgraupelm, & ! Variables + iiNcm, iiNsnowm, iiNim, iiNgraupelm + + use latin_hypercube_arrays, only: & + d_variables, & ! Variable + setup_corr_varnce_array ! Procedure + + use crmx_parameters_microphys, only: & + l_lh_vert_overlap, & ! Variable(s) + l_fix_s_t_correlations, & + l_lh_cloud_weighted_sampling, & + LH_microphys_type, & + LH_microphys_disabled, & + LH_microphys_non_interactive, & + LH_microphys_calls, & + LH_seed, & + LH_sequence_length + + use crmx_parameters_microphys, only: & + rrp2_on_rrm2_cloud, & ! Variable(s) + Nrp2_on_Nrm2_cloud, & + Ncp2_on_Ncm2_cloud, & + rrp2_on_rrm2_below, & + Nrp2_on_Nrm2_below, & + Ncp2_on_Ncm2_below + + use crmx_parameters_microphys, only: & + rsnowp2_on_rsnowm2_cloud, & ! Variables + Nsnowp2_on_Nsnowm2_cloud, & + ricep2_on_ricem2_cloud, & + Nicep2_on_Nicem2_cloud, & + rsnowp2_on_rsnowm2_below, & + Nsnowp2_on_Nsnowm2_below, & + ricep2_on_ricem2_below, & + Nicep2_on_Nicem2_below +#else + use crmx_parameters_microphys, only: LH_microphys_type, LH_microphys_disabled +#endif /*CLUBB_LH */ + + use crmx_clubbvars, only: & + upwp, &! u'w'. [m^2/s^2] + vpwp, &! u'w'. [m^2/s^2] + up2, &! u'^2 [m^2/s^2] + vp2, &! v'^2 [m^2/s^2] + wprtp, &! w' r_t'. [(m kg)/(s kg)] + wpthlp, &! w' th_l'. [(m K)/s] + wprcp, &! w' r_c' [(kg/kg) m/s] + wp2, &! w'^2. [m^2/s^2] + rtp2, &! r_t'^2. [(kg/kg)^2] + thlp2, &! th_l'^2. [K^2] + rtpthlp,&! r_t' th_l'. [(kg K)/kg] + wp3 ! w'^3. [m^3/s^3] + + use crmx_clubbvars, only: & + tracer_tndcy, & ! Time tendency of the SAM set of tracers + t_tndcy, & ! CLUBB contribution to moist static energy [K/s] + qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] + qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] + u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] + v_tndcy ! CLUBB contribution to y-wind [m/s^2] + + use crmx_clubbvars, only: & + sclrp2, & ! Passive scalar variance. [{units vary}^2] + sclrpthlp, & ! Passive scalar covariance. [{units vary}^2] + sclrprtp, & ! Passive scalar covariance. [{units vary}^2] + wpsclrp ! w'sclr' [units vary m/s] + + use crmx_clubbvars, only: & + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] + + use crmx_clubbvars, only: & + sclr_tol, & ! Tolerance on high-order scalars + edsclr_dim, & ! Number of eddy-diffusivity scalars + sclr_dim ! Numer of high-order scalars + + use crmx_clubbvars, only: & + tndcy_precision ! Precision of CLUBB's contribution to the tendencies of mean variables + +#ifdef CLUBB_LH + use crmx_clubb_silhs_vars, only: & + LH_rt, & + LH_t, & + X_nl_all_levs, & + LH_sample_point_weights, & + X_mixt_comp_all_levs, & + micro_field_prior, & + LH_micro_field_sum_tndcy, & + LH_micro_field_avg_tndcy + + use crmx_mt95, only: & + genrand_init, & + genrand_intg +#endif + +#ifdef CRM + use crmx_clubbvars, only: lrestart_clubb +#endif + + implicit none + + ! Constant parameters + logical, parameter :: & + l_uv_nudge = .false., & ! Use u/v nudging (not used) + l_implemented = .true. ! Implemented in a host model (always true) + + integer, parameter :: & + grid_type = 2, & ! The 2 option specifies stretched thermodynamic levels + iunit = 50 ! Fortran I/O unit + + character(len=6), parameter :: & + saturation_equation = "flatau" ! Flatau polynomial approximation for SVP + +#ifdef CLUBB_LH + character(len=*), parameter :: & + input_file_cloud = "/silhs_corr_matrix_cloud.in", & + input_file_below = "/silhs_corr_matrix_below.in" + + logical, parameter :: & + doicemicro = .true. +#endif + real(kind=core_rknd), parameter :: & + theta0 = 300._core_rknd, &! Reference temperature [K] + ts_nudge = 86400._time_precision ! Time scale for u/v nudging (not used) [s] + + ! Input Variables + real(kind=time_precision), intent(in) :: & + dt_clubb ! SAM-CLUBB subcycled model timestep [s] + + real, dimension(nx, ny), intent(in) :: & + latitude, & ! Latitudes for SAM's dynamical core [degrees_N] + longitude ! Longitudes for SAM's dynamical core [degrees_E] + + real, dimension(nzm), intent(in) :: & + z, & ! Thermodynamic/Scalar grid in SAM [m] + rho ! Thermodynamic/Scalar density in SAM [kg/m^3] + + real, dimension(nz), intent(in) :: & + zi, & ! Momentum/Vertical Velocity grid in SAM [m] + rhow ! Momentum/Vertical Velocity density in SAM [kg/m^3] + + real, dimension(nzm), intent(in) :: & + tv0 ! Virtual potential temperature from SAM [K] + + real, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm), intent(in) :: & + tke ! SGS TKE [m^2/s] + + ! Local Variables + real(kind=core_rknd), dimension(nparams) :: & + clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) + + ! 1D variables with ghost points at the lowest level + real(kind=core_rknd), dimension(nz) :: & + zt, & ! Thermodynamic grid [m] + zm, & ! Momentum grid [m] + em ! Turbulent kinetic energy [-] + + logical :: l_stats ! Stats enabled (T/F) + + logical :: l_output_rad_files ! stats enabled for radiative fields (T/F) + + real(kind=time_precision) :: & + stats_tsamp, & ! Sampling interval for a single column of CLUBB data [s] + stats_tout ! Output interval for a single column of CLUBB data [s] + + character(len=10) :: stats_fmt ! Format of stats output (netCDF/GrADS) + character(len=250) :: fname_prefix ! Prefix for stats filename + + ! Horizontal grid spacings (i.e., dx and dy), used for computing Lscale_max + real(kind=core_rknd) :: host_dx, host_dy ! [m] + + real(kind=core_rknd), dimension(1) :: & + rlat, rlon ! Latitude and Longitude for stats [degrees] + + integer :: & + err_code, & ! Code for when CLUBB fails + i, j, ig, jg, & ! Loop indices + ilen ! Length of a string + + integer :: hydromet_dim + logical :: l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes +#ifdef CLUBB_LH + integer :: indx +#endif + + namelist /stats_setting/ l_stats_samgrid, l_stats, l_output_rad_files, & + stats_fmt, stats_tsamp, stats_tout, & + sample_nodes, x_samp, y_samp + +#ifdef CLUBB_LH + namelist /clubb_silhs/ LH_microphys_type, LH_microphys_calls, & + LH_sequence_length, LH_seed, l_lh_vert_overlap, l_fix_s_t_correlations, & + l_lh_cloud_weighted_sampling, rrp2_on_rrm2_cloud, & + rrp2_on_rrm2_below, Nrp2_on_Nrm2_cloud, & + Nrp2_on_Nrm2_below, Ncp2_on_Ncm2_cloud, Ncp2_on_Ncm2_below, & + rsnowp2_on_rsnowm2_cloud, Nsnowp2_on_Nsnowm2_cloud, & + ricep2_on_ricem2_cloud, Nicep2_on_Nicem2_cloud, & + rsnowp2_on_rsnowm2_below, Nsnowp2_on_Nsnowm2_below, & + ricep2_on_ricem2_below, Nicep2_on_Nicem2_below +#endif +!------------------------------------------------------------------------------- +! SAM uses an Arakawa C type grid for the 3D quantities. The UWM SCM has an +! additional `ghost' point on the lowest pressure/thermodynamic level. +! i.e. +! +! SAM vert. vel. grid UWM SCM moment. grid +! +! Dimension Elevation Dimension Elevation +! . . . (nz ) . . zi(nz ) . . . (gr%nz ) . . gr%zm(gr%nz ) . . . +! . . . (nz-1) . . zi(nz-1) . . . (gr%nz-1) . . gr%zm(gr%nz-1) . . . +! | | | | +! . . . (1 ) . . zi(1 ) . . . (1 ) . . gr%zm(1 ) . . . +! +! In SAM the lowest grid point on the vertical velocity levels (or `interface' +! levels) is always 0 meters. The UWM SCM supports an arbitrary starting +! point for the momentum grid, but this code assumes 0 meters. +! +! SAM pressure grid UWM SCM thermo. grid +! +! Dimension Elevation Dimension Elevation +! . . . (nz-1) . . z(nz-1) . . . (gr%nz ) . . gr%zt(gr%nz ) . . . +! . . . (nz-2) . . z(nz-2) . . . (gr%nz-1) . . gr%zt(gr%nz-1) . . . +! | | | | +! . . . (1 ) . . z(1 ) . . . (2 ) . . gr%zt(2 ) . . . +! / / / N/A / / N/A / / / (1 ) / / gr%zt(1 ) / / / +! +! Note that the lowest SCM point is below ground. +!------------------------------------------------------------------------------- + + !----- Begin Code ----- + + ! Set the ghost point to be the distance between the first interface level, + ! which is always zero, and the first pressure level. + zt(1) = real( -z(1), kind=core_rknd ) ! [m] + ! All other pressure levels are determined by the host model + zt(2:nz) = real( z(1:nzm), kind=core_rknd ) ! [m] + + zm = real( zi, kind=core_rknd ) + + ! Set the SCM parameters (C2, etc. ) based on default values + !call read_parameters( -99, "", clubb_params ) + + ! Set the SCM parameters (C2, etc. ) based on a namelist +#ifdef CRM + ! Set the SCM parameters (C2, etc. ) based on default values + call read_parameters( -99, "", clubb_params ) +#else + ! Set the SCM parameters (C2, etc. ) based on a namelist + call read_parameters( iunit, "CLUBB_PARAMETERS/tunable_parameters.in", clubb_params ) +#endif + + ! Set the debug level. Level 2 has additional computational expense since + ! it checks the array variables in CLUBB for invalid values. + call set_clubb_debug_level( 0 ) + + host_dx = real( dx, kind=core_rknd ) + host_dy = real( dy, kind=core_rknd ) + + ! These are for emulating total water or thetal for testing purposes + iisclr_rt = -1 + iisclr_thl = -1 + iisclr_CO2 = -1 + + iiedsclr_rt = -1 + iiedsclr_thl = -1 + iiedsclr_CO2 = -1 + + ! Sanity check + if ( sclr_dim > 0 .and. edsclr_dim > 0 ) then + write(fstderr,*) "Only one scalar scheme can be enabled at one time" + call task_abort() + end if + + ! This is the tolerance on total water in the CLUBB SCM + ! Other tracers will need this value set according to their order of + ! magnitude and the units they are in. Keep in mind that the variable + ! sclrp2 will be clipped to a minimum value of sclr_tol^2 + sclr_tol(1:sclr_dim) = 1.e-8_core_rknd ! total water is in kg/kg + + ! Determine whether clubb is applying the surface flux or the host model + ! from the namelist variable doclubb_sfc_fluxes + l_host_applies_sfc_fluxes = .not. doclubb_sfc_fluxes + +#ifdef CLUBB_LH + hydromet_dim = nmicro_fields + 2 +#else + hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements +#endif + + call setup_clubb_core & + ( nz, theta0, ts_nudge, & ! In + hydromet_dim, sclr_dim, & ! In + sclr_tol, edsclr_dim, clubb_params, & ! In + l_host_applies_sfc_fluxes, & ! In + l_uv_nudge, saturation_equation, & ! In + l_implemented, grid_type, zm(2), zm(1), zm(nz), & ! In + zm(1:nz), zt(1:nz), & ! In + host_dx, host_dy, zm(1), & ! In + err_code ) + + if ( err_code /= CLUBB_no_error ) then + write(fstderr,*) "Initialization of CLUBB failed" + call task_abort() + end if + + l_stats_samgrid = .false. + l_output_rad_files = .false. + +#ifndef CRM + open(unit=iunit, file="clubb_stats_sam") + read(unit=iunit, nml=stats_setting) + write(0, *) 'l_stats_samgrid', l_stats_samgrid + close(unit=iunit) +#endif /*CRM*/ + + if(.not.l_stats_samgrid) then ! output clubb statistics from clubb side + ! Initialize stats_setting + l_stats = .false. + stats_fmt = "grads" + stats_tsamp = 60._time_precision + stats_tout = 60._time_precision + sample_nodes(:) = -1 ! Which nodes are outputting a column + x_samp(:) = -1 ! Which x point for the nth node + y_samp(:) = -1 ! Which y point for the nth node + +#ifndef CRM + ! Figure out which node and points we're sampling + open(unit=iunit, file="clubb_stats") + read(unit=iunit, nml=stats_setting) + close(unit=iunit) +#endif /*CRM*/ + + if ( is_a_sample_node( rank ) .and. l_stats ) then + + ! Determine and save the local x and y to write to be written to disk + call get_sample_points( rank, x_samp_node, y_samp_node ) + + ! Figure out the position on the global grid + call task_rank_to_index( rank, ig, jg ) + + ! The filename follows the following format: + ! case_caseid_x_y_ + ! e.g. (variables in single quotes) + ! 'BOMEX'_'64x64x75_scm_LES'_x000'1'_y00'10'_'zt' + fname_prefix = trim( case )//"_"//trim( caseid ) + ilen = len( trim( fname_prefix ) ) + fname_prefix = trim( fname_prefix )//"_x0000_y0000" + write(unit=fname_prefix(ilen+3:ilen+6),fmt='(i4.4)') ig+x_samp_node + write(unit=fname_prefix(ilen+9:ilen+12),fmt='(i4.4)') jg+y_samp_node + rlat = real( latitude(x_samp_node,y_samp_node), kind=core_rknd ) + rlon = real( longitude(x_samp_node,y_samp_node), kind=core_rknd ) + + ! Use a bogus date, since SAM does not track the year, and it would require + ! some work to convert the `day' variable to MMDD format + call stats_init( iunit, fname_prefix, "./OUT_STAT/", l_stats, & + stats_fmt, stats_tsamp, stats_tout, "clubb_stats", & + nz, zt, zm, nz, zt, nz, zm, 1, 4, 1900, & + rlat, rlon, & + time, dt_clubb ) + + ! If CLUBB stats are on for this node, toggle a flag in this module + write(fstdout,*) "CLUBB stats enabled" + lstats_clubb = .true. + else + lstats_clubb = .false. + x_samp_node = -1 + y_samp_node = -1 + end if + end if ! .not. l_stats_samgrid + +#ifdef CLUBB_LH + ! Default values for namelist parameters + LH_microphys_type = LH_microphys_non_interactive + LH_microphys_calls = 2 + LH_sequence_length = 1 + LH_seed = 5489_genrand_intg + l_lh_vert_overlap = .true. + l_fix_s_t_correlations = .true. + l_lh_cloud_weighted_sampling = .true. + + ! Variances / Corrlations here are those used with the RICO case + rrp2_on_rrm2_cloud = 0.766 + rrp2_on_rrm2_below = rrp2_on_rrm2_cloud + Nrp2_on_Nrm2_cloud = 0.429 + Nrp2_on_Nrm2_below = Nrp2_on_Nrm2_cloud + Ncp2_on_Ncm2_cloud = 0.003 + Ncp2_on_Ncm2_below = Ncp2_on_Ncm2_cloud + + ! Made up values for the variance of ice/snow, since we currently lack data + ! for this. + rsnowp2_on_rsnowm2_cloud = 0.766 + Nsnowp2_on_Nsnowm2_cloud = 0.429 + ricep2_on_ricem2_cloud = 1.0 + Nicep2_on_Nicem2_cloud = 1.0 + + rsnowp2_on_rsnowm2_below = 0.766 + Nsnowp2_on_Nsnowm2_below = 0.429 + ricep2_on_ricem2_below = 1.0 + Nicep2_on_Nicem2_below = 1.0 + + ! Read the namelist from the prm file + open(unit=iunit, file=trim( case )//"/prm") + read(unit=iunit, nml=clubb_silhs) + close(unit=iunit) + + if ( LH_microphys_type /= LH_microphys_disabled ) then + iiNcm = -1 ! Initialize to no Nc prediction + + ! Determine total number of sample variates other than t, rt, and w. + do indx = 1, nmicro_fields + select case ( trim( mkname(indx) ) ) + case ( 'QR', 'QP' ) + iirrainm = indx + + case ( 'QI' ) + iiricem = indx + + case ( 'QS' ) + iirsnowm = indx + + case ( 'QG' ) + ! This is not currently sampled, but we need the index to copy the + ! mean from saved microphysics field + iirgraupelm = indx + + case ( 'CONP', 'NR' ) + iiNrm = indx + + case ( 'NI' ) + iiNim = indx + + case ( 'NS' ) + iiNsnowm = indx + + case ( 'NG' ) + ! See note above for QG. + iiNgraupelm = indx + + case ( 'CONC', 'NC' ) + iiNcm = indx + + end select + end do ! 1..n_micro_fields + ! This is for when Ncm not predicted but we would like to output the fixed value + if ( iiNcm == -1 ) then + iiNcm = indx + 1 + end if + + ! Determine d_variables and other LH indices by reading in the correlation + ! files and from indexes determined above + call setup_corr_varnce_array( iirrainm, iiNrm, iiricem, iiNim, iirsnowm, iiNsnowm, & ! In + doicemicro, & ! In + trim( case )//input_file_cloud, & ! In + trim( case )//input_file_below, iunit ) ! In + + ! Allocate based on LH_microphys_calls and d_variables + allocate( LH_rt(nx,ny,nzm,LH_microphys_calls), LH_t(nx,ny,nzm,LH_microphys_calls), & + X_nl_all_levs(nx,ny,nzm,LH_microphys_calls,d_variables), & + X_mixt_comp_all_levs(nx,ny,nzm,LH_microphys_calls), & + LH_sample_point_weights(nx,ny,LH_microphys_calls), & + micro_field_prior(nx,ny,nzm,nmicro_fields), & + LH_micro_field_sum_tndcy(nx,ny,nzm,nmicro_fields), & + LH_micro_field_avg_tndcy(nx,ny,nzm,nmicro_fields) ) + + end if ! LH_microphys_type /= disabled +#else + LH_microphys_type = LH_microphys_disabled ! LH_microphys_type is needed even when LH is + ! not enabled in stats_subs.F90 (stats_finalize) + ! +++mhwang 2013-01 +#endif /*CLUBB_LH*/ + + if(l_stats_samgrid) then ! output clubb statistics in SAM + l_stats = .true. + stats_tsamp = dt_clubb + stats_tout = dt_clubb + call stats_init_clubb(l_stats, l_output_rad_files, stats_tsamp, & + stats_tout, nz, nz, nz, time, dt_clubb) + end if + +#ifdef CRM +!+++mhwang, 2012-02-06 (Minghuai.Wang@pnnl.gov) +! rho_ds_zm, rho_ds_zt, thv_ds_zt, thv_ds_zm, invrs_rho_ds_zm, invrs_rho_ds_zt are needed +! to be copied from those from the GCM at the beginning of each GCM time step. + if (lrestart_clubb) then + ! Set variables for the use of the anelastic equation set in CLUBB. + ! Set the value of dry, static, base-state density. + rho_ds_zm(:) = rhow(:) + rho_ds_zt(2:nz) = rho(1:nzm) + rho_ds_zt(1) = LIN_EXT( rho_ds_zt(3), rho_ds_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) + ! Set the value of dry, base-state theta_v. + thv_ds_zt(2:nz) = tv0(1:nzm) + thv_ds_zt(1) = tv0(1) + thv_ds_zm(:) = zt2zm( thv_ds_zt ) + + ! Set the value of inverse dry, static, base-state density based on the + ! value of dry, static, base-state density. + invrs_rho_ds_zm(:) = 1.0 / rho_ds_zm(:) + invrs_rho_ds_zt(:) = 1.0 / rho_ds_zt(:) + end if +#endif /*CRM*/ + + ! If this is restart run, just return at this point and do not re-initialize + ! any variables as we would a run starting from the beginning. + +#ifndef CRM + if ( nrestart /= 0 ) return +#else + if (lrestart_clubb ) return +#endif + +#ifdef CLUBB_LH + call genrand_init( put=LH_seed ) +#endif + + if ( sclr_dim > 0 ) then + sclrp2 = 0._core_rknd + sclrprtp = 0._core_rknd + sclrpthlp = 0._core_rknd + wpsclrp = 0._core_rknd + end if + + ! Initialize CLUBB's tendencies to 0 + t_tndcy = 0._tndcy_precision + qc_tndcy = 0._tndcy_precision + qv_tndcy = 0._tndcy_precision + u_tndcy = 0._tndcy_precision + v_tndcy = 0._tndcy_precision + + if ( ntracers > 0 ) then + tracer_tndcy = 0._tndcy_precision + end if + + ! SAM's dynamical core is anelastic, so l_use_boussineq should probably be + ! set to false generally, as it is by default in the CLUBB SCM. + if ( l_use_boussinesq ) then + rho_ds_zm(:) = 1._core_rknd + rho_ds_zt(:) = 1._core_rknd + ! Set the value of dry, base-state theta_v. + thv_ds_zm(:) = theta0 + thv_ds_zt(:) = theta0 + else + ! Set variables for the use of the anelastic equation set in CLUBB. + ! Set the value of dry, static, base-state density. + rho_ds_zm(:) = real( rhow(:), kind=core_rknd ) + rho_ds_zt(2:nz) = real( rho(1:nzm), kind=core_rknd ) + rho_ds_zt(1) = LIN_EXT( rho_ds_zt(3), rho_ds_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) + ! Set the value of dry, base-state theta_v. + thv_ds_zt(2:nz) = real( tv0(1:nzm), kind=core_rknd ) + thv_ds_zt(1) = real( tv0(1), kind=core_rknd ) + thv_ds_zm(:) = zt2zm( thv_ds_zt ) + end if + ! Set the value of inverse dry, static, base-state density based on the + ! value of dry, static, base-state density. + invrs_rho_ds_zm(:) = 1.0_core_rknd / rho_ds_zm(:) + invrs_rho_ds_zt(:) = 1.0_core_rknd / rho_ds_zt(:) + + ! Determine the initial value of some variables as in WRF-CLUBB + + wprtp(:,:,:) = 0._core_rknd ! w'rt' + wpthlp(:,:,:) = 0._core_rknd ! w'thl' + wprcp(:,:,:) = 0._core_rknd ! w'rc' + wp3(:,:,:) = 0._core_rknd ! w'^3 + wp2(:,:,:) = w_tol_sqd ! w'^2 + up2(:,:,:) = w_tol_sqd ! u'^2 + vp2(:,:,:) = w_tol_sqd ! v'^2 + rtp2(:,:,:) = rt_tol**2 ! rt'^2 + thlp2(:,:,:) = thl_tol**2 ! thl'^2 + rtpthlp(:,:,:) = 0._core_rknd ! rt'thl' + upwp(:,:,:) = 0._core_rknd ! u'w' + vpwp(:,:,:) = 0._core_rknd ! v'w' + + do i=1, nx, 1 + do j=1, ny, 1 + + ! Extrapolate intial SGS TKE and use it to compute wp2 + ! This value is going to depend on initial noise and whether + ! Smagorinksy diffusion is enabled + em(2:nz) = real( tke(i,j,1:nzm), kind=core_rknd ) + em(1) = LIN_EXT( em(3), em(2), gr%zt(3), gr%zt(2), gr%zt(1) ) + em(1:nz) = max( zt2zm( em(1:nz) ), em_min ) + +! em(:) = 1.0 ! Use this value for comparing DYCOMS II RF02 to the CLUBB SCM. + + !!!! Initialize w'^2 based on initial SGS TKE !!!! + + if ( l_tke_aniso ) then + + ! SGS TKE: em = (1/2) * ( w'^2 + u'^2 + v'^2 ) + ! Evenly divide SGS TKE into its component + ! contributions (w'^2, u'^2, and v'^2). + + wp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) + up2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) + vp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) + + else + + ! Assume isotropy for initialization of wp2 + ! SGS TKE: em = (3/2) * w'^2 + + wp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) + + end if + + end do ! j=1..ny + end do ! i=1..nx + + return + end subroutine clubb_sgs_setup + +!------------------------------------------------------------------------------- + subroutine advance_clubb_sgs( dt_clubb, time_initial, time_current, & + rho, rhow, wsub, u, v, w, qpl, qci, qpi, & + t, qv, qcl ) + +! Description: +! Advance Cloud Layers Unified By Binormals one timestep. + +! References: +! ``A PDF-Based Model for Boundary Layer Clouds. Part I: +! Method and Model Description'' Golaz, et al. (2002) +! JAS, Vol. 59, pp. 3540--3551. +!------------------------------------------------------------------------------- + + ! From SAM + use crmx_grid, only: & + nx, ny, nxp1, nyp1, nz, nzm,&! Local grid dimensions + nx_gl, ny_gl, &! Global grid dimensions + dimx1_s, dimx2_s, dimy1_s, dimy2_s,& ! Scalars dimensions + dimx1_u, dimx2_u, dimy1_u, dimy2_u,& ! U wind dimensions + dimx1_v, dimx2_v, dimy1_v, dimy2_v,& ! V wind dimensions + dimx1_w, dimx2_w, dimy1_w, dimy2_w,& ! W wind dimensions + YES3D, rank, pres, dompi, & + ntracers + + use crmx_params, only: cp, lfus, lsub, & + ug, vg ! ug and vg are scalars, not arrays + + use crmx_params, only: doclubb ! Variable(s) + + use crmx_params, only: latitude0, longitude0 + + use crmx_vars, only: & + fcory, fluxbt, fluxbq, fluxbu, fluxbv, gamaz, prespot ! Variables + + use crmx_microphysics, only: nmicro_fields + + use crmx_clubbvars, only: & + upwp, &! u'w'. [m^2/s^2] + vpwp, &! u'w'. [m^2/s^2] + up2, &! u'^2 [m^2/s^2] + vp2, &! v'^2 [m^2/s^2] + wprtp, &! w' r_t'. [(m kg)/(s kg)] + wpthlp, &! w' th_l'. [(m K)/s] + wprcp, &! w' r_c'. [(kg/kg) m/s] + wp2, &! w'^2. [m^2/s^2] + rtp2, &! r_t'^2. [(kg/kg)^2] + thlp2, &! th_l'^2. [K^2] + rtpthlp, &! r_t' th_l'. [(kg K)/kg] + rcm, &! Cloud water [kg/kg] + cloud_frac, &! Cloud Fraction. [-] + rcm_in_layer,&! rcm in cloud layer [kg/kg] + cloud_cover, &! Cloud Cover [-] + wp3, &! w'^3. [m^3/s^3] + um, &! x-wind [m/s] + vm ! y-wind [m/s] + + use crmx_clubbvars, only: & + khzm, &! eddy diffusivity on momentum grids [m^2/s] + khzt, &! eddy diffusivity on thermo grids [m^2/s] + qclvarg, &! cloud water variance [kg^2/kg^2] + relvarg, &! relative cloud water variance + accre_enhang ! accretion enhancement + + + + use crmx_clubbvars, only: & + sclrp2, & ! Passive scalar variance. [{units vary}^2] + sclrpthlp, & ! Passive scalar covariance. [{units vary}^2] + sclrprtp, & ! Passive scalar covariance. [{units vary}^2] + wpsclrp ! w'sclr' [units vary m/s] + + use crmx_clubbvars, only: & + u_tndcy,& ! CLUBB contribution to the x wind + v_tndcy,& ! CLUBB contribution to the y wind + qv_tndcy,& ! CLUBB contribution to vapor water mixing ratio + qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio + t_tndcy ! CLUBB contribution to moist static energy + + use crmx_clubbvars, only: & + tracer_tndcy ! CLUBB contribution to a set of tracers + + use crmx_clubbvars, only: & + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] + + use crmx_clubbvars, only: & + sclr_dim, & ! Constant(s) + edsclr_dim + + use crmx_clubbvars, only: & + tndcy_precision ! Constant(s) + +#ifndef CRM + use tracers, only: & +#else + use crmx_crmtracers, only: & +#endif + fluxbtr, & + tracer + + ! From CLUBB + use crmx_error_code, only: & + clubb_no_error, & ! Constant + clubb_at_least_debug_level ! Function + + use crmx_grid_class, only: & + zm2zt, zt2zm, & ! Functions + gr ! Derived type + + use crmx_stats_variables, only: & + l_stats, l_stats_samp ! Logicals + + use crmx_stats_subs, only: & + stats_begin_timestep, stats_end_timestep ! Subroutines + + use crmx_stat_clubb, only: stats_end_timestep_clubb + + use crmx_pdf_parameter_module, only: & + pdf_parameter ! Derived type + + use crmx_constants_clubb, only: & + fstderr ! Constant + +#ifdef CLUBB_LH + use crmx_parameters_microphys, only: & + l_lh_vert_overlap, & ! Variable(s) + LH_microphys_type, & + LH_microphys_disabled, & + LH_microphys_non_interactive, & + LH_microphys_calls, & + LH_sequence_length + + use crmx_variables_diagnostic_module, only: & + Lscale ! Variable(s) + + use crmx_fill_holes, only: & + vertical_avg ! Procedure(s) + + use crmx_parameters_model, only: & + hydromet_dim ! Variable(s) + + use crmx_array_index, only: & + iirrainm, iiNrm, iirsnowm, iiricem, & ! Variables + iiNcm, iiNsnowm, iiNim, iiNgraupelm, iirgraupelm + + use latin_hypercube_arrays, only: & + xp2_on_xm2_array_cloud, & ! Variable(s) + xp2_on_xm2_array_below, & + corr_array_cloud, & + corr_array_below, & + d_variables + + use crmx_corr_matrix_module, only: & + iiLH_s_mellor, iiLH_w, & + iiLH_rrain, iiLH_rsnow, iiLH_rice, & + iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Nc + + use latin_hypercube_driver_module, only: & + LH_subcolumn_generator, & ! Procedure(s) + stats_accumulate_LH + + use crmx_stats_subs, only: & + stats_accumulate_hydromet + + use crmx_stat_clubb, only: stats_end_timestep_clubb + + use crmx_microphysics, only: & + conc, micro_field, nmicro_fields ! Variable(s) + + use crmx_clubb_silhs_vars, only: & + LH_rt, & ! Variable(s) + LH_t, & + X_nl_all_levs, & + LH_sample_point_weights, & + X_mixt_comp_all_levs +#endif /*CLUBB_LH*/ + + implicit none + + ! Parameters + logical, parameter :: & + l_implemented = .true., & ! CLUBB is implemented in a host model, so this is true + l_advect = .false. ! Whether to advect around the high-order moments + + real(kind=core_rknd), parameter, dimension(nz) :: & + zero = 0.0_core_rknd ! Field of zeros + + ! Input + real(kind=time_precision), intent(in) :: & + dt_clubb ! Timestep size for CLUBB [s] + + real(kind=time_precision), intent(in) :: & + time_initial, time_current ! Initial and current time [s] + + real, intent(in), dimension(nzm) :: & + rho ! Air density [kg/m^3] + + real, intent(in), dimension(nz) :: & + wsub,&! Imposed vertical velocity [m/s] + rhow ! Density on vert velocity grid [kg/m^3] + + real, intent(in), dimension(dimx1_u:dimx2_u,dimy1_u:dimy2_u,nzm) :: & + u ! u wind [m/s] + + real, intent(in), dimension(dimx1_v:dimx2_v,dimy1_v:dimy2_v,nzm) :: & + v ! v wind [m/s] + + real, intent(in), dimension(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) :: & + w ! Vertical wind [m/s] + + real, intent(in), dimension(nx,ny,nzm) :: & + qpl,& ! Liquid water mixing ratio (precipitation) [kg/kg] + qci,& ! Cloud ice water mixing ratio [kg/kg] + qpi ! Snow + graupel mixing ratio (precip) [kg/kg] + + real, intent(in), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & + t ! Moist static energy [K] + + real, intent(in), dimension(nx,ny,nzm) :: & + qv, & ! Water vapor mixing ratio [kg/kg] + qcl ! Liquid water mixing ratio (condensate) [kg/kg] + + ! Local Variables + real(kind=core_rknd) :: & + wpthlp_sfc, &! w' theta_l' at surface [(m K)/s] + wprtp_sfc, &! w' r_t' at surface [(kg m)/( kg s)] + upwp_sfc, &! u'w' at surface [m^2/s^2] + vpwp_sfc ! v'w' at surface [m^2/s^2] + + real(kind=core_rknd), dimension(nz) :: & + thlm, &! Liquid water potential temperature (theta_l) [K] + rtm, &! Total water mixing ratio [kg/kg] + p_in_Pa, &! Pressure [Pa] + rho_zt, &! Density on pressure levels [kg/m^3] + rho_zm, &! Density on momentum levels [kg/m^3] + exner, &! Exner function [-] + wm_zm, &! Imposed subs. + perturbation w on vertical vel. levels [m/s] + wm_zt, &! Imposed subs. + perturbation w on pressure levels [m/s] + rfrzm ! Total ice-phase water mixing ratios [kg/kg] + + real, dimension(nz) :: & + dum ! Dummy array for advection + + real(kind=core_rknd), allocatable, dimension(:,:) :: & + sclrm, & ! Array for high order passive scalars + sclrm_forcing, & ! Large-scale forcing array for passive scalars + edsclrm, & ! Array for eddy passive scalars + edsclrm_forcing ! Large-scale forcing array for eddy passive scalars + + real(kind=core_rknd), allocatable, dimension(:) :: & + wpedsclrp_sfc, & ! Array for passive scalar surface flux + wpsclrp_sfc ! Array for high order scalar surface flux + + ! Thermo grid versions of variables on the momentum grid + real, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & + wp2_zt, rtp2_zt, thlp2_zt, rtpthlp_zt, & + wprtp_zt, wpthlp_zt, up2_zt, vp2_zt, & + um_r4, vm_r4, um_old, vm_old ! wind arrays + + real(kind=tndcy_precision), dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & + um_change, vm_change ! Change in u/v [m/s^2] + + type(pdf_parameter), allocatable, dimension(:) :: & + pdf_params ! PDF parameters [units vary] + +#ifdef CLUBB_LH + real(kind=core_rknd), dimension(nz,hydromet_dim) :: & + hydromet ! Collection of all microphysics fields [units vary] + + real(kind=core_rknd), dimension(nzm) :: & + Lscale_vert_avg + + real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & + LH_thl +#endif /* CLUBB_LH */ + + real(kind=core_rknd), dimension(nz) :: & + ice_supersat_frac, & + radf + + real(kind=core_rknd), dimension(nz) :: & + khzttemp, khzmtemp + + real(kind=core_rknd), dimension(nz) :: qclvartemp + + integer :: err_code + + ! Array indices + integer :: i, j, k, ig, jg, ip1, jp1, jm1, indx + +#ifdef CLUBB_LH + integer :: km1, kp1 +#endif +!------------------------------------------------------------------------------- + + !----- Begin Code ----- + +#ifndef CRM + call t_startf('advance_clubb') ! For timing +#endif + + ! Initialize err_code to CLUBB_no_error. In the event of the singular + ! matrix, etc. the variable will be set to the appropriate error code + ! within advance_clubb_core + err_code = CLUBB_no_error + + ! Feed nothing into radf (set it to zero) + radf(1:nz) = 0.0_core_rknd + + ! Density is in correct units + rho_zt(2:nz) = real( rho(1:nzm), kind=core_rknd ) + rho_zt(1) = LIN_EXT( rho_zt(3), rho_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) + + rho_zm(1:nz) = real( rhow(1:nz), kind=core_rknd ) + + ! Compute and extrapolate Exner function + exner(2:nz) = 1.0_core_rknd / real( prespot(1:nzm), kind=core_rknd ) + exner(1) = 1.0_core_rknd / LIN_EXT( exner(3), exner(2), gr%zt(3), gr%zt(2), gr%zt(1) ) + + ! Allocate passive scalar arrays + allocate( wpsclrp_sfc(sclr_dim), sclrm(nz,sclr_dim), & + sclrm_forcing(nz,sclr_dim) ) + allocate( wpedsclrp_sfc(edsclr_dim), edsclrm(nz,edsclr_dim), & + edsclrm_forcing(nz,edsclr_dim) ) + + ! Allocate variables for the PDF closure scheme + allocate( pdf_params(1:nz) ) + + um_r4 = 0.0 + vm_r4 = 0.0 + do i = 1, nx, 1 + do j = 1, ny, 1 + + ip1 = min( nxp1, i+1 ) ! This is redundant, but we include it for safety + jp1 = min( nyp1, j+1 ) ! This prevents an array out of bounds error + ! for dvdt in a 2D simulation + + ! Average u-wind (east-west wind) to scalar points. + um_r4(i,j,2:nz) = 0.5 * ( u(i,j,1:nzm) + u(ip1,j,1:nzm) ) + ug +! um_r4(i,j,2:nz) = u(i,j,1:nzm) + ug + + um_r4(i,j,1) = um_r4(i,j,2) + + ! Average v-wind (north-south wind) to scalar points. + vm_r4(i,j,2:nz) = 0.5 * ( v(i,j,1:nzm) + v(i,jp1,1:nzm) ) + vg +! vm_r4(i,j,2:nz) = v(i,j,1:nzm) + vg + + vm_r4(i,j,1) = vm_r4(i,j,2) + end do + end do + + ! Adjust the ghost points to allow for interpolation back on to + ! the u & v grid points +#ifndef CRM + if ( dompi ) then + call task_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+19) + call task_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+20) + else +#endif /*CRM*/ + call bound_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+19) + call bound_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+20) +#ifndef CRM + end if +#endif /*CRM*/ + ! Lower Boundary condition on u/v + um_r4(:,:,1) = um_r4(:,:,2) + vm_r4(:,:,1) = vm_r4(:,:,2) + + ! Preserve value of u and v to calculate total change from CLUBB + um_old = um_r4 + vm_old = vm_r4 + + ! Copy the SAM precision values into CLUBB precision arrays + um = real( um_r4, kind=core_rknd ) + vm = real( vm_r4, kind=core_rknd ) + + do i=1, nx, 1 + + do j=1, ny, 1 + + if(.not.l_stats_samgrid) then ! clubb statistics output from clubb + ! Sample from a single column + if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node & + .and. lstats_clubb ) then + !+++mhwang remove dt_clubb, as with dt_clubb, CLUBB crashed because + ! the number of samples may not be equal to stats_tout/stats_tsamp + ! in stats_end_timestep in stats_subs.F90 + !---mhwang 2013-02 + ! call stats_begin_timestep( time_current-time_initial+dt_clubb ) + call stats_begin_timestep( time_current-time_initial) + else + l_stats_samp = .false. + end if + else ! clubb statistics output from sam + call stats_begin_timestep( time_current-time_initial) + end if + + ! The 2-D flux arrays are already in the correct units + wprtp_sfc = real( fluxbq(i,j), kind=core_rknd ) ! [m kg/kg s] + wpthlp_sfc = real( fluxbt(i,j), kind=core_rknd ) ! [m K/s] +! Vince Larson set sfc momentum flux constant, as a temporary band-aid. +! 25 Feb 2008. + ! These are set for the purposes of computing sfc_var, but this value is + ! not applied to the value of u and v in SAM. + upwp_sfc = real( fluxbu(i,j), kind=core_rknd ) + vpwp_sfc = real( fluxbv(i,j), kind=core_rknd ) +! End of Vince Larson's change + + ! Set the surface flux of the two scalar types to the tracer flux at the + ! bottom of the domain, and set edsclrm to the tracer + do indx = 1, edsclr_dim, 1 + wpedsclrp_sfc(indx) = real( fluxbtr(i,j,indx), kind=core_rknd ) + edsclrm(2:nz,indx) = real( tracer(i,j,1:nzm,indx), kind=core_rknd ) + edsclrm(1,indx) = real( LIN_EXT( edsclrm(3,indx), edsclrm(2,indx), & + gr%zt(3), gr%zt(2), gr%zt(1) ), kind=core_rknd ) + + edsclrm_forcing(1:nz,indx) = 0.0_core_rknd + end do + + do indx = 1, sclr_dim, 1 + wpsclrp_sfc(indx) = real( fluxbtr(i,j,indx), kind=core_rknd ) + sclrm(2:nz,indx) = real( tracer(i,j,1:nzm,indx), kind=core_rknd ) + sclrm(1,indx) = LIN_EXT( sclrm(3,indx), sclrm(2,indx), & + gr%zt(3), gr%zt(2), gr%zt(1) ) + sclrm_forcing(1:nz,indx) = 0.0_core_rknd + end do + + + ! Check for negative values of water vapor being fed from SAM into CLUBB + if ( clubb_at_least_debug_level( 2 ) ) then + do k=1,nzm + if ( qv(i,j,k) < 0. ) then + write(fstderr,*) 'SAM has fed into CLUBB negative rv at grid point i,j,k =', & + i, j, k + end if + end do + + ! Check for negative values of cloud water being fed from SAM into CLUBB + do k=1,nzm + if ( qcl(i,j,k) < 0. ) then + write(fstderr,*) 'SAM has fed into CLUBB negative qcl at grid point i,j.k =', & + i, j, k + end if + end do + end if ! clubb_at_least_debug_level( 2 ) + + ! Total water. Since the SCM does not account for ice, we sum only the + ! non-precipitating liquid and vapor + + ! Total water is the sum of non-precipitating liquid + vapor + rtm(2:nz) = real( qv(i,j,1:nzm) + qcl(i,j,1:nzm), kind=core_rknd ) + rtm(1) = rtm(2) + + ! Cloud water is total non-precipitating liquid + rcm(i,j,2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) + rcm(i,j,1) = 0.0_core_rknd ! No below ground cloud water + + ! Note: t is moist static energy, which is not quite the same as liquid + ! potential temperature. + thlm(2:nz) = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & + qcl(i,j,1:nzm), qpl(i,j,1:nzm), & + qci(i,j,1:nzm), qpi(i,j,1:nzm), & + prespot(1:nzm) ) + thlm(1) = thlm(2) + + ! The w variable requires no extrapolation + + ! Vince Larson added option for l_advect = .true. . 13 Mar 2008. + ! SAM's subroutine 'subsidence' imposes wsub on t, q, u, and v. + ! SAM advects all means using u, v, w. + ! When implemented in a host model, CLUBB imposes wm_zm/wm_zt on higher-order + ! moments but not means. + ! (l_advect=.true.) advects all higher-order moments using u, v, w. + if ( l_advect ) then + wm_zt(1) = 0._core_rknd + wm_zt(2:nz) = real( wsub(1:nzm), kind=core_rknd ) ! Use this if l_advect = .true. + wm_zm = zt2zm( wm_zt ) + else ! l_advect = .false. + ! Higher-order moments are advected vertically but not horizontally. + ! In principle, this could lead to undesirable accumulation. + wm_zt(1) = 0._core_rknd ! Set ghost point to 0. + wm_zt(2:nz) = real( wsub(1:nzm), kind=core_rknd ) ! wsub is on the t-levels + wm_zm(1:nz) = zt2zm( wm_zt ) ! Interpolate imposed subsidence to m-levels + + ! Resolved vertical velocity is on the momentum levels + wm_zm(1:nz) = wm_zm(1:nz) + real( w(i,j,1:nz), kind=core_rknd ) + ! Interpolate resolved w to t-levels + wm_zt(1:nz) = wm_zt + zm2zt( real( w(i,j,1:nz), kind=core_rknd ) ) + end if + ! End Vince Larson's commenting + + ! Add in pressure perturbation, extrapolate, & convert from mb to Pa. + ! Vince Larson of UWM removed perturbation pressure to avoid + ! negative pressure at domain top in ARM9707. 22 Dec 2007. + ! pr(2:nz) = 100. * ( pres(1:nzm) + p(i,j,1:nzm) ) + ! pr(1) = 100. * LIN_EXT( pres(2)+p(i,j,2), pres(1)+p(i,j,1), & + ! gr%zt(3), gr%zt(2), gr%zt(1) ) + P_in_Pa(2:nz) = 100._core_rknd * real( pres(1:nzm), kind=core_rknd ) + P_in_Pa(1) = LIN_EXT( P_in_Pa(3), P_in_Pa(2), & + gr%zt(3), gr%zt(2), gr%zt(1) ) + + ! End Vince Larson's change. + + ! Sum all forms of ice + rfrzm(2:nz) = real( qpi(i,j,1:nzm) + qci(i,j,1:nzm), kind=core_rknd ) + rfrzm(1) = 0._core_rknd + + ! Call the single column model, CLUBB + call advance_clubb_core & + ( l_implemented, dt_clubb, real( fcory(j), kind=core_rknd ), gr%zm(1), & ! In + zero(:), zero(:), zero(:), zero(:), & ! In + sclrm_forcing, edsclrm_forcing, zero(:), & ! In + zero(:), zero(:), zero(:), & ! In + zero(:), wm_zm(:), wm_zt(:), & ! In + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! In + wpsclrp_sfc, wpedsclrp_sfc, & ! In + P_in_Pa(:), rho_zm(:), rho_zt(:), exner(:), & ! In + rho_ds_zm(:), rho_ds_zt(:), invrs_rho_ds_zm(:), & ! In + invrs_rho_ds_zt(:), thv_ds_zm(:), thv_ds_zt(:), & ! In + rfrzm(:), radf, & ! In + um(i,j,:), vm(i,j,:), upwp(i,j,:), vpwp(i,j,:), up2(i,j,:), vp2(i,j,:), & ! In/out + thlm(:), rtm(:), wprtp(i,j,:), wpthlp(i,j,:), & ! In/out + wp2(i,j,:), wp3(i,j,:), rtp2(i,j,:), thlp2(i,j,:), rtpthlp(i,j,:), & ! In/out + sclrm, sclrp2(i,j,:,:), sclrprtp(i,j,:,:), sclrpthlp(i,j,:,:), & ! In/out + wpsclrp(i,j,:,:), edsclrm, err_code, & ! In/out + rcm(i,j,:), wprcp(i,j,:), cloud_frac(i,j,:), ice_supersat_frac, & ! Out + rcm_in_layer(i,j,:), cloud_cover(i,j,:), khzmtemp(:), khzttemp(:), qclvartemp(:), pdf_params ) ! Out + khzt(i,j,1:nzm) = real(khzttemp(2:nz)) + khzm(i,j,1:nzm) = real(khzmtemp(1:nz-1)) + qclvarg(i,j,1:nzm) = real(qclvartemp(2:nz)) + +! diagnose the relative variance of in-cloud water +! The relative variance of in-cloud water follows Guo et al., 2013, J. Climate +! Note this formula is different from what is used in CAM5_CLUBB (Bogenschutz et al., 2013, J. Climate) +! the accretion enhancment follows CAM5_CLUBB +! + do k=1, nzm + relvarg(i,j,k) = 8.0 + accre_enhang(i,j,k) = 1.0 + if(rcm(i,j,k+1).gt.0. .and. qclvartemp(k+1).gt.0) then + relvarg(i,j,k) = real(cloud_frac(i,j,k+1)*qclvartemp(k+1) - (1.-cloud_frac(i,j,k+1))*rcm(i,j,k+1)**2) + if(relvarg(i,j,k).gt. (1.0e-3*(rcm(i,j,k+1)**2)) ) then + relvarg(i,j,k) = real(rcm(i,j,k+1)**2)/relvarg(i,j,k) + else + relvarg(i,j,k) = 1000. + end if + relvarg(i,j,k) = min(1.0, max(0.1, relvarg(i,j,k))) + end if + accre_enhang(i,j,k) = 1.+0.65*(1.0/real(relvarg(i,j,k))) + end do + +#ifdef CLUBB_LH + if ( LH_microphys_type /= LH_microphys_disabled ) then + hydromet = 0._core_rknd + hydromet(2:nz,iiNcm) = real( conc(i,j,1:nzm), kind=core_rknd ) + + if ( iirrainm > 0 ) hydromet(2:nz,iirrainm) = micro_field(i,j,:,iirrainm) + if ( iiNrm > 0 ) hydromet(2:nz,iiNrm) = micro_field(i,j,:,iiNrm) + + if ( iirsnowm > 0 ) hydromet(2:nz,iirsnowm) = micro_field(i,j,:,iirsnowm) + if ( iiNsnowm > 0 ) hydromet(2:nz,iiNsnowm) = micro_field(i,j,:,iiNsnowm) + + if ( iiricem > 0 ) hydromet(2:nz,iiricem) = micro_field(i,j,:,iiricem) + if ( iiNim > 0 ) hydromet(2:nz,iiNim) = micro_field(i,j,:,iiNim) + + ! Note: graupel is not a part of X_nl_all_levs. These lines are + ! strictly for the purpose of outputting graupel from a single column + if ( iirgraupelm > 0 ) hydromet(2:nz,iirgraupelm) = micro_field(i,j,:,iirgraupelm) + if ( iiNgraupelm > 0 ) hydromet(2:nz,iiNgraupelm) = micro_field(i,j,:,iiNgraupelm) + + if ( l_lh_vert_overlap ) then + ! Determine 3pt vertically averaged Lscale + do k = 1, nzm, 1 + kp1 = min( k+1, nz ) + km1 = max( k-1, 1 ) + Lscale_vert_avg(k) = vertical_avg & + ( (kp1-km1+1), rho_ds_zt(km1:kp1), & + Lscale(km1:kp1), gr%invrs_dzt(km1:kp1) ) + end do + else + ! If vertical overlap is disabled, this calculation won't be needed + Lscale_vert_avg = -999. + end if + + call LH_subcolumn_generator & + ( LH_iter, d_variables, LH_microphys_calls, LH_sequence_length, nzm, & ! In + thlm(2:nz), pdf_params(2:nz), wm_zt(2:nz), gr%dzt(2:nz), rcm(i,j,2:nz), & ! In + hydromet(2:nz,iiNcm), rtm(2:nz)-rcm(i,j,2:nz), & ! In + hydromet(2:nz,:), xp2_on_xm2_array_cloud, xp2_on_xm2_array_below, & ! In + corr_array_cloud, corr_array_below, Lscale_vert_avg, & ! In + X_nl_all_levs(i,j,:,:,:), X_mixt_comp_all_levs(i,j,:,:), & ! Out + LH_rt(i,j,:,:), LH_thl, LH_sample_point_weights(i,j,:) )! Out + + ! Convert the thetal sample points into moist static energy sample points + LH_t(i,j,:,:) = convert_thl_to_t_LH( LH_thl, gamaz, prespot, X_nl_all_levs(i,j,:,:,:) ) + + ! Increment the iteration count for the purpose of knowing whether to repeat + LH_iter = LH_iter + 1 + + if(.not.l_stats_samgrid) then + if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node ) then + call stats_accumulate_hydromet( hydromet, rho_ds_zt ) ! In + end if + else + ! will this be corret???+++mhwang + call stats_accumulate_hydromet( hydromet, rho_ds_zt ) + end if + end if +#endif + if(.not.l_stats_samgrid) then ! clubb stastics output in clubb + ! Sample stats from a single column + if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node ) then + call stats_end_timestep( ) + end if + else ! clubb stastics output in sam + call stats_end_timestep_clubb(i, j) + end if + + ! Check if a critical error has occured within the CLUBB model + if ( err_code /= clubb_no_error ) then + call task_rank_to_index( rank, ig, jg ) + write(fstderr,*) "Task #:", rank, err_code + write(fstderr,*) "Single-column model failed at: ", "nx=", i, ";", "ny=", j, ";" + write(fstderr,*) "x global=", i+ig, ";", "y global=", j+jg, ";" + write(fstderr,*) "longitude=", longitude0, "latitude=", latitude0 + call task_abort( ) + end if + + ! If we're not doing a doclubbnoninter run, then we feed the results back + ! into the 3D SAM model arrays. Here we compute the total tendency to + ! allow for subcycling and save compute time. + if ( doclubb ) then + + ! Check for negative values of water vapor + if ( clubb_at_least_debug_level( 2 ) ) then + do k=1,nz + if ( ( rtm(k) - rcm(i,j,k) ) < 0._core_rknd ) then + write(fstderr,*) 'CLUBB has produced negative rvm at grid level k=', k + end if + end do + end if ! clubb_at_least_debug_level( 2 ) + + ! Re-compute vapor for total water and liquid from CLUBB + !qv(i,j,1:nzm) = rtm(2:nz) - rcm(i,j,2:nz) + qv_tndcy(i,j,1:nzm) = & + ( rtm(2:nz) - rcm(i,j,2:nz) - real( qv(i,j,1:nzm), kind=core_rknd ) ) / dt_clubb + + if ( clubb_at_least_debug_level( 2 ) ) then + ! Check for negative values of cloud water + do k=1,nz + if ( rcm(i,j,k) < 0._core_rknd ) then + write(fstderr,*) 'CLUBB has produced negative rcm at grid level k=', k + end if + end do + end if ! clubb_at_least_debug_level( 2 ) + + ! Re-compute qcl based on new rcm + !qcl(i,j,1:nzm) = rcm(i,j,2:nz) + ! Compute tendency of total water due to CLUBB + qc_tndcy(i,j,1:nzm) = ( rcm(i,j,2:nz) - real( qcl(i,j,1:nzm), kind=core_rknd ) ) & + / dt_clubb + + ! Compute moist static energy based on new thetal +! t(i,j,1:nzm) = thetal2t( thlm(2:nz), gamaz(1:nzm), & +! qcl(i,j,1:nzm), qpl(i,j,1:nzm), & +! qci(i,j,1:nzm), qpi(i,j,1:nzm), & +! prespot(1:nzm) ) + + ! Compute tendency of moist static energy due to CLUBB + ! Note that this formula assumes qci/qpl/qpi won't change rapidly in + ! the time between successive clubb calls in order to avoid calling + ! thetal2t on at every SAM timestep -dschanen 27 Oct 08 + t_tndcy(i,j,1:nzm) = & + ( thetal2t( thlm(2:nz), gamaz(1:nzm), rcm(i,j,2:nz), & + qpl(i,j,1:nzm), qci(i,j,1:nzm), qpi(i,j,1:nzm), prespot(1:nzm) ) & + - real( t(i,j,1:nzm), kind=core_rknd ) ) / dt_clubb + + do indx = 1, edsclr_dim + tracer_tndcy(i,j,1:nzm,indx) = & + ( edsclrm(2:nz,indx) - real( tracer(i,j,1:nzm,indx), kind=core_rknd ) ) & + / dt_clubb + end do + + do indx = 1, sclr_dim + tracer_tndcy(i,j,1:nzm,indx) = & + ( sclrm(2:nz,indx) - real( tracer(i,j,1:nzm,indx), kind=core_rknd ) ) / dt_clubb + end do + + end if ! doclubb + + end do ! j + + end do ! i + + ! De-allocate temporary arrays. This is just in case the compiler isn't + ! 100% Fortran 95 compliant and doesn't de-allocate this memory when it + ! leaves the scope of advance_clubb_sgs + deallocate( wpsclrp_sfc, sclrm ) + deallocate( wpedsclrp_sfc, edsclrm ) + deallocate( pdf_params ) + + ! Copy back the value from the CLUBB precision um and vm + um_r4 = real( um ) + vm_r4 = real( vm ) + + if ( doclubb ) then + + ! Adjust the ghost points to allow for interpolation back onto the u & v grid +#ifndef CRM + if ( dompi ) then + call task_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+19) + call task_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+20) + else +#endif /*CRM*/ + call bound_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+19) + call bound_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & + nzm, 3,3,3,3, ntracers+nmicro_fields+20) +#ifndef CRM + end if +#endif + + ! Compute the total change in u due to the CLUBB part of the code + um_change = real( um_r4 - um_old, kind=tndcy_precision ) / dt_clubb + vm_change = real( vm_r4 - vm_old, kind=tndcy_precision ) / dt_clubb + + ! Average the contributions of CLUBB to the wind back on to the u and v grid + ! This has shown to make the model unstable at fine horizontal resolution. + ! To interpolate across subdomain boundaries requires that we + ! transfer information using MPI (via task_exchange). + do i=1, nx, 1 + do j=1, ny, 1 + jm1 = max( dimy1_s, j-1 ) ! For the 2D case vm wind + + ! The horiztontal grid in SAM is always evenly spaced, so we just use + ! 0.5 *( x(n-1)+x(n) ) to interpolate back to the u,v point on the Arakawa C grid + u_tndcy(i,j,1:nzm) = & + 0.4_tndcy_precision * & ! This is a made up coefficient to reduce numerical instability + 0.5_tndcy_precision * & + real( um_change(i,j,2:nz) + um_change(i-1,j,2:nz), kind=tndcy_precision ) + v_tndcy(i,j,1:nzm) = & + 0.4_tndcy_precision * & ! This is a made up coefficient to reduce numerical instability + 0.5_tndcy_precision * & + real( vm_change(i,j,2:nz) + vm_change(i,jm1,2:nz), kind=tndcy_precision ) + + end do ! j + + end do ! i + + end if ! doclubb + + +! Vince Larson attempted to advect higher-order moments horizontally. +! 26 Feb 2008. + +! Horizontal advection of higher-order moments. + +! The following method has the drawback of requiring two interpolations, +! which unnecesarily smooths the fields in the vertical. +! In preparation for advection, interpolate to thermodynamic (scalar) vertical gridpoints. +! (wp3 is already on the thermodynamic gridpoints.) + + +!print*, 'Before advection, wp2(nx,ny,:) =', wp2(nx,ny,:) +! For now we default to not doing this, because the interpolation seems to cause +! and artificial rise in fields such as moisture at a coarse model resolution. +! -dschanen 29 Apr 2008 + if ( l_advect ) then + + do i=1, nx, 1 + do j=1, ny, 1 + + wp2_zt(i,j,:) = real( zm2zt( wp2(i,j,:) ) ) + up2_zt(i,j,:) = real( zm2zt( up2(i,j,:) ) ) + vp2_zt(i,j,:) = real( zm2zt( vp2(i,j,:) ) ) + rtp2_zt(i,j,:) = real( zm2zt( rtp2(i,j,:) ) ) + thlp2_zt(i,j,:) = real( zm2zt( thlp2(i,j,:) ) ) + rtpthlp_zt(i,j,:) = real( zm2zt( rtpthlp(i,j,:) ) ) + wprtp_zt(i,j,:) = real( zm2zt( wprtp(i,j,:) ) ) + wpthlp_zt(i,j,:) = real( zm2zt( wpthlp(i,j,:) ) ) + + end do ! j + end do ! i + +#ifndef CRM + if ( dompi ) then + + call task_exchange( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+10 ) + call task_exchange( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+11 ) + call task_exchange( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+12 ) + call task_exchange( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+13 ) + call task_exchange( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+14 ) + call task_exchange( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+15 ) + call task_exchange( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+16 ) + call task_exchange( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+17 ) + call task_exchange( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+18 ) + else +#endif /*CRM*/ + + call bound_exchange( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+10 ) + call bound_exchange( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+11 ) + call bound_exchange( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+12 ) + call bound_exchange( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+13 ) + call bound_exchange( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+14 ) + call bound_exchange( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+15 ) + call bound_exchange( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+16 ) + call bound_exchange( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+17 ) + call bound_exchange( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & + ntracers+nmicro_fields+18 ) + +#ifndef CRM + end if +#endif + + ! Now call the standard SAM advection subroutine for scalars + call advect_scalar( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + + call advect_scalar( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & + dum(1:nz), dum(1:nz), dum(1:nzm), & + dum(1:nzm), dum(1:nzm), .false. ) + +!print*, 'After advect, wp2_zt(dimx2_s,dimy2_s,:) =', wp2_zt(dimx2_s,dimy2_s,:) +! +!do i=dimx1_s, dimx2_s, 1 +! do j=dimy1_s, dimy2_s, 1 +! if ( any ( rtp2_zt(i,j,:) < 0.0 ) ) then +! print*, 'After advect, rtp2_zt at ', i, j, " = ", rtp2_zt(i,j,:) +! end if +! end do ! i +!end do ! j +! Now interpolate back to momentum gridpoints. +! (wp3 is already on the thermodynamic gridpoints.) +! do i=dimx1_s, dimx2_s, 1 +! do j=dimy1_s, dimy2_s, 1 + do i=1, nx, 1 + do j=1, ny, 1 + + wp2(i,j,:) = zt2zm( real( wp2_zt(i,j,:), kind=core_rknd ) ) + up2(i,j,:) = zt2zm( real( up2_zt(i,j,:), kind=core_rknd ) ) + vp2(i,j,:) = zt2zm( real( vp2_zt(i,j,:), kind=core_rknd ) ) + rtp2(i,j,:) = zt2zm( real( rtp2_zt(i,j,:), kind=core_rknd ) ) + thlp2(i,j,:) = zt2zm( real( thlp2_zt(i,j,:), kind=core_rknd ) ) + rtpthlp(i,j,:) = zt2zm( real( rtpthlp_zt(i,j,:), kind=core_rknd ) ) + wprtp(i,j,:) = zt2zm( real( wprtp_zt(i,j,:), kind=core_rknd ) ) + wpthlp(i,j,:) = zt2zm( real( wpthlp_zt(i,j,:), kind=core_rknd ) ) + + end do ! j + end do ! i + + ! Clip variances where the top point is negative + where ( wp2(:,:,nz) < 0._core_rknd ) wp2(:,:,nz) = 0._core_rknd + where ( up2(:,:,nz) < 0._core_rknd ) up2(:,:,nz) = 0._core_rknd + where ( vp2(:,:,nz) < 0._core_rknd ) vp2(:,:,nz) = 0._core_rknd + where ( rtp2(:,:,nz) < 0._core_rknd ) rtp2(:,:,nz) = 0._core_rknd + where ( thlp2(:,:,nz) < 0._core_rknd ) thlp2(:,:,nz) = 0._core_rknd + + ! Clip variances where the bottom point is negative + where ( wp2(:,:,1) < 0._core_rknd ) wp2(:,:,1) = 0._core_rknd + where ( up2(:,:,1) < 0._core_rknd ) up2(:,:,1) = 0._core_rknd + where ( vp2(:,:,1) < 0._core_rknd ) vp2(:,:,1) = 0._core_rknd + where ( rtp2(:,:,1) < 0._core_rknd ) rtp2(:,:,1) = 0._core_rknd + where ( thlp2(:,:,1) < 0._core_rknd ) thlp2(:,:,1) = 0._core_rknd + + +!do i=1, nx, 1 +! do j=1, ny, 1 +! if ( any ( rtp2(i,j,:) < 0.0 ) ) then +! print*, 'After interp, rtp2 at ', i, j, " = ", rtp2(i,j,:) +! end if +! end do ! i +!end do ! j +! +!print*, 'After interp back, wp2(nx,ny,:) =', wp2(nx,ny,:) +!! End of Vince Larson's changes. + end if ! ladvect + +#ifndef CRM + call t_stopf('advance_clubb') ! For timing +#endif + + return + end subroutine advance_clubb_sgs + +!------------------------------------------------------------------------------- + subroutine apply_clubb_sgs_tndcy( dt, t, qv, qcl, dudt, dvdt ) + + use crmx_grid, only: & + nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & + rank + + use crmx_domain, only: & + ntracers + +#ifndef CRM + use tracers, only: & +#else + use crmx_crmtracers, only: & +#endif + tracer + + use crmx_clubbvars, only: & + u_tndcy, & ! CLUBB contribution to the x wind + v_tndcy, & ! CLUBB contribution to the y wind + t_tndcy, & ! CLUBB contribution to moist static energy + qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio + qv_tndcy ! CLUBB contribution to vapor water mixing ratio + + use crmx_clubbvars, only: & + tracer_tndcy + + use crmx_clubbvars, only: & + sclr_dim, & ! Constant(s) + edsclr_dim + + use crmx_clubbvars, only: & + rho_ds_zt, & ! Variable(s) + rho_ds_zm + + use crmx_error_code, only: clubb_at_least_debug_level + + use crmx_fill_holes, only: fill_holes_driver + + implicit none + + intrinsic :: any + + ! In variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + ! In/Out variables + real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & + t ! Moist static energy [K] + + real, intent(inout), dimension(nx,ny,nzm) :: & + qv, & ! Water vapor mixing ratio [kg/kg] + qcl ! Liquid water mixing ratio (condensate) [kg/kg] + + real, intent(inout), dimension(nxp1,ny,nzm,3) :: & + dudt ! u wind tendency [m/s^2] + + real, intent(inout), dimension(nx,nyp1,nzm,3) :: & + dvdt ! v wind tendency [m/s^2] + + ! Local Variables + real(kind=core_rknd), dimension(nz) :: tmpqv, tmpqcl + + real(kind=core_rknd) :: threshold ! Threshold on clipping [units vary] + + integer :: i, j, ig, jg + + ! --- Begin Code --- + +#ifndef CRM + call t_startf('apply_clubb_sgs_tndcy') ! For timing +#endif + + ! Since dudt/dvdt are already time tendencies, we just add the contribution + ! to the existing SAM contribution + dudt(1:nx,1:ny,1:nzm,na) = dudt(1:nx,1:ny,1:nzm,na) + real( u_tndcy(1:nx,1:ny,1:nzm) ) + dvdt(1:nx,1:ny,1:nzm,na) = dvdt(1:nx,1:ny,1:nzm,na) + real( v_tndcy(1:nx,1:ny,1:nzm) ) + + tmpqv = 0.0_core_rknd + tmpqcl = 0.0_core_rknd + + ! Add clubb tendency to qv, qc, t, and tracers + do i = 1, nx, 1 + do j = 1, ny, 1 + + t(i,j,1:nzm) = t(i,j,1:nzm) + real( dt*t_tndcy(i,j,1:nzm) ) + + tmpqv(2:nz) = real( qv(i,j,1:nzm), kind=core_rknd ) + dt*qv_tndcy(i,j,1:nzm) + tmpqcl(2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) + dt*qc_tndcy(i,j,1:nzm) + + if ( edsclr_dim > 0 .or. sclr_dim > 0 ) then + tracer(i,j,1:nzm,1:ntracers) = tracer(i,j,1:nzm,1:ntracers) & + + real( dt*tracer_tndcy(i,j,1:nzm,1:ntracers) ) + end if + + ! Apply hole-filling scheme to qv as needed + threshold = 0._core_rknd + if ( any( tmpqv(2:nz) < threshold ) ) then + + ! CLUBB's tendency in this column will produce a negative vapor water, + ! so we apply hole-filling + if ( clubb_at_least_debug_level( 1 ) ) then + call task_rank_to_index( rank, ig, jg ) + write(0,*) "Task #:", rank + write(0,*) "Applying hole-filling scheme to vapor water mixing ratio at:", & + "nx=", i, ";", "ny=", j, ";" + write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" + end if + + call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqv ) + + end if + + ! Update qv + qv(i,j,1:nzm) = real( tmpqv(2:nz) ) + + threshold = 0._core_rknd + ! Apply hole-filling scheme to qcl as needed + if ( any( tmpqcl(2:nz) < threshold ) ) then + + ! CLUBB's tendency in this column will produce a negative cloud water, + ! so we apply hole-filling + if ( clubb_at_least_debug_level( 1 ) ) then + call task_rank_to_index( rank, ig, jg ) + write(0,*) "Task #:", rank + write(0,*) "Applying hole-filling scheme to cloud water mixing ratio at:", & + "nx=", i, ";", "ny=", j, ";" + write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" + end if + + call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqcl ) + + end if + + ! Update qcl + qcl(i,j,1:nzm) = real( tmpqcl(2:nz) ) + + end do ! j = 1, ny + end do ! i = 1, nx + +#ifndef CRM + call t_stopf('apply_clubb_sgs_tndcy') ! For timing +#endif + + return + end subroutine apply_clubb_sgs_tndcy + +!------------------------------------------------------------------------------- + subroutine apply_clubb_sgs_tndcy_mom( dudt, dvdt ) + + use crmx_grid, only: & + nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & + rank + + use crmx_clubbvars, only: & + u_tndcy, & ! CLUBB contribution to the x wind + v_tndcy ! CLUBB contribution to the y wind + + implicit none + + intrinsic :: any + + ! In variables + real, intent(inout), dimension(nxp1,ny,nzm,3) :: & + dudt ! u wind tendency [m/s^2] + + real, intent(inout), dimension(nx,nyp1,nzm,3) :: & + dvdt ! v wind tendency [m/s^2] + + ! --- Begin Code --- + +#ifndef CRM + call t_startf('apply_clubb_sgs_tndcy_mom') ! For timing +#endif + + ! Since dudt/dvdt are already time tendencies, we just add the contribution + ! to the existing SAM contribution + dudt(1:nx,1:ny,1:nzm,na) = dudt(1:nx,1:ny,1:nzm,na) + real( u_tndcy(1:nx,1:ny,1:nzm) ) + dvdt(1:nx,1:ny,1:nzm,na) = dvdt(1:nx,1:ny,1:nzm,na) + real( v_tndcy(1:nx,1:ny,1:nzm) ) + +#ifndef CRM + call t_stopf('apply_clubb_sgs_tndcy_mom') ! For timing +#endif + + return + end subroutine apply_clubb_sgs_tndcy_mom + +!------------------------------------------------------------------------------- + subroutine apply_clubb_sgs_tndcy_scalars( dt, t, qv, qcl) + + use crmx_grid, only: & + nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & + rank, adz, dz + + use crmx_params, only: doclubb_sfc_fluxes + + use crmx_vars, only: rho + + use crmx_domain, only: & + ntracers + +#ifndef CRM + use tracers, only: & +#else + use crmx_crmtracers, only: & +#endif + tracer + + use crmx_clubbvars, only: & + t_tndcy, & ! CLUBB contribution to moist static energy + qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio + qv_tndcy ! CLUBB contribution to vapor water mixing ratio + + use crmx_clubbvars, only: & + tracer_tndcy + + use crmx_clubbvars, only: & + sclr_dim, & ! Constant(s) + edsclr_dim + + use crmx_clubbvars, only: & + rho_ds_zt, & ! Variable(s) + rho_ds_zm + + use crmx_error_code, only: clubb_at_least_debug_level + + use crmx_fill_holes, only: fill_holes_driver + + implicit none + + intrinsic :: any + + ! In variables + real(kind=time_precision), intent(in) :: & + dt ! Timestep [s] + + ! In/Out variables + real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & + t ! Moist static energy [K] + + real, intent(inout), dimension(nx,ny,nzm) :: & + qv, & ! Water vapor mixing ratio [kg/kg] + qcl ! Liquid water mixing ratio (condensate) [kg/kg] + + ! Local Variables + real(kind=core_rknd), dimension(nz) :: tmpqv, tmpqcl + + real(kind=core_rknd) :: threshold ! Threshold on clipping [units vary] + + real(kind=core_rknd), dimension(2) :: t_total + + real(kind=core_rknd) :: dt_total + + integer :: i, j, ig, jg, k + + ! --- Begin Code --- + +#ifndef CRM + call t_startf('apply_clubb_sgs_tndcy_scalar') ! For timing +#endif + + tmpqv = 0.0_core_rknd + tmpqcl = 0.0_core_rknd + + ! Add clubb tendency to qv, qc, t, and tracers + do i = 1, nx, 1 + do j = 1, ny, 1 + +! add energy conservation check and fix for CLUBB +! Minghuai Wang, 2012-06 + t_total = 0.0_core_rknd + dt_total = 0.0_core_rknd + t_total(1) = real(sum(t(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) + do k=1, nzm +! t_total(1) = t_total(1) +real(t(i,j,k)*rho(k)*adz(k)*dz, kind=core_rknd) + t(i,j,k) = t(i,j,k) + real( dt*t_tndcy(i,j,k) ) +! t_total(2) = t_total(2) +real(t(i,j,k)*rho(k)*adz(k)*dz, kind=core_rknd) +! dt_total = dt_total + real( dt*t_tndcy(i,j,k)*adz(k)*dz, kind=core_rknd) + end do + t_total(2) = real(sum(t(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) + dt_total = real(sum(dt*t_tndcy(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) + if(abs(t_total(2)-t_total(1))/t_total(1).gt.1.0e-6) then +! write(0, *) 'energy conervation issue in clubb', i,j, & +! abs(t_total(2)-t_total(1))/t_total(1), t_total(1), dt_total + end if + if(.not.doclubb_sfc_fluxes) then + t(i,j,1:nzm) = t(i,j,1:nzm) * real(t_total(1)/t_total(2)) + else + write(0, *) 'need add surface fluxes in energy conservation fix' + stop + end if + + tmpqv(2:nz) = real( qv(i,j,1:nzm), kind=core_rknd ) + dt*qv_tndcy(i,j,1:nzm) + tmpqcl(2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) + dt*qc_tndcy(i,j,1:nzm) + + if ( edsclr_dim > 0 .or. sclr_dim > 0 ) then + tracer(i,j,1:nzm,1:ntracers) = tracer(i,j,1:nzm,1:ntracers) & + + real( dt*tracer_tndcy(i,j,1:nzm,1:ntracers) ) + end if + + ! Apply hole-filling scheme to qv as needed + threshold = 0._core_rknd + if ( any( tmpqv(2:nz) < threshold ) ) then + + ! CLUBB's tendency in this column will produce a negative vapor water, + ! so we apply hole-filling + if ( clubb_at_least_debug_level( 1 ) ) then + call task_rank_to_index( rank, ig, jg ) + write(0,*) "Task #:", rank + write(0,*) "Applying hole-filling scheme to vapor water mixing ratio at:", & + "nx=", i, ";", "ny=", j, ";" + write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" + end if + + call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqv ) + + end if + + ! Update qv + qv(i,j,1:nzm) = real( tmpqv(2:nz) ) + + threshold = 0._core_rknd + ! Apply hole-filling scheme to qcl as needed + if ( any( tmpqcl(2:nz) < threshold ) ) then + + ! CLUBB's tendency in this column will produce a negative cloud water, + ! so we apply hole-filling + if ( clubb_at_least_debug_level( 1 ) ) then + call task_rank_to_index( rank, ig, jg ) + write(0,*) "Task #:", rank + write(0,*) "Applying hole-filling scheme to cloud water mixing ratio at:", & + "nx=", i, ";", "ny=", j, ";" + write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" + end if + + call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqcl ) + + end if + + ! Update qcl + qcl(i,j,1:nzm) = real( tmpqcl(2:nz) ) + + end do ! j = 1, ny + end do ! i = 1, nx + +#ifndef CRM + call t_stopf('apply_clubb_sgs_tndcy_scalar') ! For timing +#endif + + return + end subroutine apply_clubb_sgs_tndcy_scalars + +!------------------------------------------------------------------------------- + subroutine clubb_sgs_cleanup( ) +! Description: +! De-allocate memory and exit. +!------------------------------------------------------------------------------- + use crmx_grid, only: rank + + use crmx_stats_subs, only: stats_finalize + + implicit none + + !----- Begin Code ----- + + call cleanup_clubb_core( .true. ) + + if(.not.l_stats_samgrid) then + if ( is_a_sample_node( rank ) ) then + call stats_finalize( ) + end if + else ! when l_stats_samgrid is .true, does not call stats_finalize + ! as some of variables are allocated yet in this case. + end if + + return + end subroutine clubb_sgs_cleanup + +!------------------------------------------------------------------------------- + elemental function t2thetal( t, gamaz, qcl, qpl, qci, qpi, prespot ) & + result( thl ) +! Description: +! Convert moist static energy into the liquid potential temperature +! used in CLUBB. +!------------------------------------------------------------------------------- + use crmx_params, only: & + fac_cond, & ! Variables + fac_sub + + implicit none + + ! Input variables + real, intent(in) :: & + t, & ! Moist static energy [K] + gamaz, & ! grav/Cp*z [m] + qcl, & ! Cloud water mixing ration [kg/kg] + qpl, & ! Rain water mixing ratio (liquid) [kg/kg] + qci, & ! Cloud water mixing ratio (ice) [kg/kg] + qpi, & ! Snow+Graupel mixing ratio [kg/kg] + prespot ! Exner^-1 [-] + + ! Result + real(kind=core_rknd) :: thl ! Liquid pot. temperature [K] + + real :: tabs ! Absolute temp. [K] + + !----- Begin Code ----- + + ! Compute absolute temperature from t + ! Formula comes from module diagnose. + tabs = t - gamaz + fac_cond * ( qcl + qpl ) + fac_sub * ( qci + qpi ) + + ! Compute thetal (don't include ice because CLUBB doesn't) + thl = real( prespot * ( tabs - fac_cond * qcl ), kind=core_rknd ) + + return + end function t2thetal + +!------------------------------------------------------------------------------- + elemental function thetal2t( thl, gamaz, qcl, qpl, qci, qpi, prespot ) & + result( t ) + +! Description: +! Convert liquid potential temperature into moist static energy. +! References: +! None +!------------------------------------------------------------------------------- + use crmx_params, only: & + fac_cond, & ! Variables + fac_sub + + implicit none + + ! Input Variables + real(kind=core_rknd), intent(in) :: & + thl, & ! Liquid potential temperature [K] + qcl ! Cloud water mixing ration [kg/kg] + + real, intent(in) :: & + gamaz, & ! grav/Cp*z [m] + qpl, & ! Rain water mixing ratio (liquid) [kg/kg] + qci, & ! Cloud water mixing ratio (ice) [kg/kg] + qpi, & ! Snow+Graupel mixing ratio [kg/kg] + prespot ! Exner^-1 [-] + + ! Result + real(kind=core_rknd) :: t ! Moist static energy [K] + + real(kind=core_rknd) :: & + tabs, & ! Absolute temp. [K] + theta ! Pot. temp. [K] + + !----- Begin Code ----- + + ! Compute absolute temperature from thl + ! Use fac_cond since CLUBB's thl does not account for ice + theta = thl + real( prespot * fac_cond, kind=core_rknd ) * qcl + tabs = theta / real( prespot, kind=core_rknd ) + ! Compute moist static energy + ! Formula comes from module diagnose + t = tabs + real( gamaz, kind=core_rknd ) & + - real( fac_cond, kind=core_rknd ) * ( qcl + real( qpl, kind=core_rknd ) ) & + - real( fac_sub * ( qci + qpi ), kind=core_rknd ) + + return + end function thetal2t + +!------------------------------------------------------------------------------- + FUNCTION LIN_EXT( var_high, var_low, height_high, height_low, height_ext ) + +! Author: Brian M. Griffin, UW Milwaukee + +! References: None + +! Description: +! This function computes a linear extension of the value of variable. +! Given two known values of a variable at two height values, the value +! of that variable at a height outside of those two height levels +! (rather than a height between those two height levels) is computed. +! +! Here is a diagram: +! +! -------------------------------- Height to be extended to; linear extension +! +! ################################ Height high, know variable value +! +! +! +! ################################ Height low, know variable value +! +! +! +! -------------------------------- Height to be extended to; linear extension +! +! +! FORMULA: +! +! variable(@ Height extension) = +! +! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] +! * (Height extension - Height high) + variable(@ Height high) +!------------------------------------------------------------------------------- + + IMPLICIT NONE + + ! Input Variables + REAL(kind=core_rknd), INTENT(IN):: var_high + REAL(kind=core_rknd), INTENT(IN):: var_low + REAL(kind=core_rknd), INTENT(IN):: height_high + REAL(kind=core_rknd), INTENT(IN):: height_low + REAL(kind=core_rknd), INTENT(IN):: height_ext + + ! Output Variable + REAL(kind=core_rknd):: lin_ext + + !----- Begin Code ----- + + lin_ext = ( var_high - var_low ) / ( height_high - height_low ) & + * ( height_ext - height_high ) + var_high + + RETURN + END FUNCTION LIN_EXT + + !----------------------------------------------------------------------------- + logical function is_a_sample_node( rank ) + + ! Description: + ! Determine if we're output single-columns stats from this node. + ! References: + ! None + !----------------------------------------------------------------------------- + + implicit none + + ! External + intrinsic :: any, spread, size + + ! Input Variable + integer, intent(in) :: rank + + integer :: iter + + ! ---- Begin Code ---- + + ! Initialize + is_a_sample_node = .false. + + ! Determine if we're sampling a column of stats from this node + do iter = 1, size( sample_nodes ) + if ( sample_nodes(iter) == rank ) then + is_a_sample_node = .true. + exit + end if + end do + + return + end function is_a_sample_node + !----------------------------------------------------------------------------- + subroutine get_sample_points( rank, i, j ) + + ! Description: + ! Output the local x and y location to be output for this particular node. + ! + ! References: + ! None + !----------------------------------------------------------------------------- + + implicit none + + ! Input Variable + integer, intent(in) :: rank + + ! Output Variables + integer, intent(out) :: i, j + + integer :: iter + + ! ---- Begin Code ---- + + i = -1 + j = -1 + do iter = 1, size( sample_nodes ) + if ( sample_nodes(iter) == rank ) then + i = x_samp(iter); j = y_samp(iter) + exit + end if + end do + + return + end subroutine get_sample_points + +#ifdef CLUBB_LH + pure function convert_thl_to_t_LH( LH_thl, gamaz, prespot, X_nl_all_levs ) & + result( LH_t ) + + use crmx_grid, only: nzm + + use crmx_clubb_precision, only: & + dp, & + core_rknd + + use crmx_parameters_microphys, only: & + LH_microphys_calls + + use crmx_corr_matrix_module, only: & + iiLH_s_mellor, & + iiLH_rrain, & + iiLH_rsnow, & + iiLH_rice + + use latin_hypercube_arrays, only: & + d_variables + + implicit none + + ! Input Variables + real(kind=core_rknd), dimension(nzm,LH_microphys_calls), intent(in) :: & + LH_thl ! Sample of thetal [K] + + real, dimension(nzm), intent(in) :: & + gamaz, & ! grav/Cp*z [m] + prespot ! 1/exner [-] + + real(kind=dp), dimension(nzm,LH_microphys_calls,d_variables), intent(in) :: & + X_nl_all_levs ! All lognormal variates [units vary] + + ! Output Variables + real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & + LH_t ! Latin hypercube samples of moist static energy [K] + + ! Local variables + real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & + qcl ! Liquid water [kg/kg] + + real, dimension(nzm,LH_microphys_calls) :: & + qpl, qci, qpi ! Rain, ice, and snow mixing ratio [kg/kg] + + integer :: indx + + ! ---- Begin Code ---- + qcl = 0._core_rknd + qpl = 0._core_rknd + qci = 0._core_rknd + qpi = 0._core_rknd + + if ( iiLH_s_mellor > 0 ) qcl = max( X_nl_all_levs(:,:,iiLH_s_mellor), 0._dp ) + if ( iiLH_rrain > 0 ) qpl = X_nl_all_levs(:,:,iiLH_rrain) + if ( iiLH_rice > 0 ) qci = X_nl_all_levs(:,:,iiLH_rice) + + ! Note: this assumes no graupel samples + if ( iiLH_rsnow > 0 ) qci = X_nl_all_levs(:,:,iiLH_rsnow) + + forall ( indx=1:LH_microphys_calls ) + LH_t(:,indx) = thetal2t( LH_thl(:,indx), gamaz, qcl(:,indx), qpl(:,indx), & + qci(:,indx), qpi(:,indx), prespot ) + end forall + + return + end function convert_thl_to_t_LH +#endif /*CLUBB_LH*/ + +real(8) function total_energy(t) + + use crmx_grid, only: & + nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & + adz, dz + use crmx_vars, only: rho + use crmx_params, only: cp + + implicit none + + real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & + t ! Moist static energy [K] + + real(8) tmp + integer i,j,k,m + + total_energy = 0. + do k=1,nzm + tmp = 0. + do j=1,ny + do i=1,nx + tmp = tmp + t(i,j,k) + end do + end do + total_energy = total_energy + tmp*adz(k)*dz*rho(k) * cp + end do + +end function total_energy + +#endif /*CLUBB_CRM*/ +end module crmx_clubb_sgs diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 new file mode 100644 index 0000000000..e21de0e567 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 @@ -0,0 +1,60 @@ +module crmx_clubb_silhs_vars +#ifdef CLUBB_LH + + use crmx_grid, only: & + nx, & + ny,& + nz,& + nzm,& + dimx1_s,& + dimx2_s,& + dimy1_s,& + dimy2_s + + use crmx_microphysics, only: & + nmicro_fields + + use crmx_clubb_precision, only: & + core_rknd, & ! CLUBB core real kind + dp + + implicit none + + private ! Default scope + + ! Allocatable variables that can change in dimension at runtime + real(kind=core_rknd), public, allocatable, dimension(:,:,:,:) :: & + LH_rt, & ! Latin hypercube samples of total water [kg/kg] + LH_t ! Latin hypercube samples of moist static energy [K] + + real(kind=dp), public, allocatable, dimension(:,:,:,:,:) :: & + X_nl_all_levs ! Lognormally distributed hydrometeors [units vary] + + integer, public, allocatable, dimension(:,:,:,:) :: & + X_mixt_comp_all_levs ! Which mixture component the sample is in + + real(kind=core_rknd), public, allocatable, dimension(:,:,:) :: & + LH_sample_point_weights ! Weights for cloud weighted sampling + + ! Static variables + real(kind=core_rknd), public, dimension(nx,ny,nzm) :: & + LH_t_sum_tndcy, & ! Sum of all t LH tendencies [K/s] + LH_t_avg_tndcy, & ! Average of all t LH tendencies [K/s] + LH_qn_sum_tndcy, & ! Sum of all qn LH tendencies [kg/kg/s] + LH_qn_avg_tndcy ! Average of all qn LH tendencies [kg/kg/s] + + real, public, dimension(nx,ny,nzm) :: & + t_prior, & ! Saved value of t [K] + qn_prior ! Saved value of liquid water [kg/kg] + + real, public, dimension(nx,ny,nz) :: & + w_prior ! Saved value of w [m/s] + + real, public, allocatable, dimension(:,:,:,:) :: & + micro_field_prior ! Saved values of the micro_fields [units vary] + + real(kind=core_rknd), public, allocatable, dimension(:,:,:,:) :: & + LH_micro_field_sum_tndcy, & ! Sum of all micro_field tendencies [units vary/s] + LH_micro_field_avg_tndcy ! Average of all micro_field tendencies [units vary/s] +#endif /*CLUBB_LH*/ +end module crmx_clubb_silhs_vars diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 new file mode 100644 index 0000000000..2edefbb344 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 @@ -0,0 +1,115 @@ +! $Id: clubbvars.F90 1103 2013-05-14 18:35:02Z minghuai.wang@pnl.gov $ +module crmx_clubbvars +#ifdef CLUBB_CRM +! Description: +! This module contains variables that exist in CLUBB but not in SAM + + use crmx_grid, only: & + ntracers, & + nx, & + ny,& + nz,& + nzm,& + dimx1_s,& + dimx2_s,& + dimy1_s,& + dimy2_s,& + nxp1,& + nyp1,& + YES3D + + use crmx_clubb_precision, only: & + core_rknd ! CLUBB core real kind + + implicit none + + private ! Default Scope + + intrinsic :: selected_real_kind, max + + ! Determines whether to use CLUBB's eddy scalar or high order scalar code on + ! a tracer in SAM + ! To enable the passive scalars, set enable_ to 1, + ! and the dimensions for edsclr or sclr will be 1*ntracers. + integer, private, parameter :: & + enable_eddy_scalars = 0, & + enable_high_order_scalars = 0 + + integer, public, parameter :: & + edsclr_dim = enable_eddy_scalars*ntracers, & ! Number of eddy scalars + sclr_dim = enable_high_order_scalars*ntracers ! Number of high order scalars + + integer, parameter, public :: & + tndcy_precision = selected_real_kind( p=12 ) + + real(kind = core_rknd), public, dimension(nx, ny, nz) :: & + upwp, &! u'w'. [m^2/s^2] + vpwp, &! u'w'. [m^2/s^2] + up2, &! u'^2 [m^2/s^2] + vp2, &! v'^2 [m^2/s^2] + wprtp, &! w' r_t'. [(m kg)/(s kg)] + wpthlp, &! w' th_l'. [(m K)/s] + wprcp, &! w' r_c'. [(kg/kg) m/s] + wp2, &! w'^2. [m^2/s^2] + rtp2, &! r_t'^2. [(kg/kg)^2] + thlp2, &! th_l'^2. [K^2] + rtpthlp, &! r_t' th_l'. [(kg K)/kg] + rcm, &! Cloud water [kg/kg] + cloud_frac, &! Cloud Fraction. [-] + rcm_in_layer,&! rcm in cloud layer [kg/kg] + cloud_cover ! Cloud cover [-] + + real, public, dimension(0:nxp1, 1-YES3D:nyp1, nzm) :: & + khzm, &! eddy diffusivity on momentum grids [m^2/s] + khzt, &! eddy diffusivity on thermo grids [m^2/s] + qclvarg, &! cloud water variance [kg^2/kg^2] + relvarg, &! relative cloud water variance + accre_enhang ! accretion enhancement + + + real(kind=core_rknd), public, dimension(nx, ny) :: & + rtm_spurious_source, & ! Spurious source of total water [kg/kg/s] + thlm_spurious_source ! Spurious source of liquid pot. temp. [K/s] + + ! w'^3 is requires additional ghost points on the x and y dimension, + ! for the purposes of horizontal advection. The variables um and vm + ! require them for the purposes of horizontal interpolation. + real(kind=core_rknd), public, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & + wp3,& ! w'^3. [m^3/s^3] + um, & ! x-wind [m/s] + vm ! y-wind [m/s] + + real(tndcy_precision), public, dimension(nx, ny, nzm) :: & + t_tndcy, & ! CLUBB contribution to moist static energy [K/s] + qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] + qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] + u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] + v_tndcy ! CLUBB contribution to y-wind [m/s^2] + + real(tndcy_precision), public, dimension(nx, ny, nzm, ntracers) :: & + tracer_tndcy ! CLUBB contribution to the tracers [{units vary}/s] + + real(kind=core_rknd), public, dimension(nx,ny,nz,sclr_dim) :: & + sclrp2, & ! Passive scalar variance. [{units vary}^2] + sclrpthlp, & ! Passive scalar covariance. [{units vary} K] + sclrprtp, & ! Passive scalar covariance. [{units vary} kg/kg] + wpsclrp ! w'sclr' [units vary m/s] + + real(kind=core_rknd), public, dimension(sclr_dim) :: & + sclr_tol ! Tolerance on passive scalar [units vary] + + real(kind=core_rknd), public, dimension(nz) :: & + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] + + logical, public :: l_stats_samgrid ! Stats on sam grid enabled (T/F) + +#ifdef CRM + logical, public :: lrestart_clubb = .false. +#endif +#endif /*CLUBB_CRM*/ +end module crmx_clubbvars diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 new file mode 100644 index 0000000000..3491c3c4bd --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 @@ -0,0 +1,24 @@ +subroutine diffuse_mom + +! Interface to the diffusion routines + +use crmx_vars +implicit none +integer i,j,k + +!call t_startf ('diffuse_mom') + +if(RUN3D) then +! call diffuse_mom3D() + call diffuse_mom3D_xy() + call diffuse_mom3D_z() +else +! call diffuse_mom2D() + call diffuse_mom2D_xy() + call diffuse_mom2D_z() +endif + +!call t_stopf ('diffuse_mom') + +end subroutine diffuse_mom + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 new file mode 100644 index 0000000000..26de915ad7 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 @@ -0,0 +1,128 @@ + +subroutine diffuse_mom2D + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_z +use crmx_params, only: docolumn +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes +#endif +implicit none + +real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 +real dxz,dzx + +integer i,j,k,ic,ib,kc,kcu +real tkx, tkz, rhoi, iadzw, iadz +real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) + +rdx2=1./dx/dx +rdx25=0.25*rdx2 + +dxz=dx/dz + +j=1 + +if(.not.docolumn) then + + +do k=1,nzm + + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdx251=rdx25 * grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + +end do + +end if + +!------------------------- +rdz=1./dz +dzx=dz/dx + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2=rdz*rdz *grdf_z(k) + rdz25=0.25*rdz2 + do i=1,nx + ib=i-1 + tkz=rdz2*tk(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do i=1,nx + tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) +#ifdef CLUBB_CRM + ! Add in the surface flux later -dschanen UWM 27 Aug 2008 + if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then + fu(i,j,1) = 0.0 ! This is handled by CLUBB + fv(i,j,1) = 0.0 ! " " + else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + end if +#else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) +#endif /*CLUBB_CRM*/ + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) +end do + + +do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi + end do +end do ! k + +do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do +end do ! k + + +end subroutine diffuse_mom2D + + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 new file mode 100644 index 0000000000..5f4605d9e8 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 @@ -0,0 +1,57 @@ + +subroutine diffuse_mom2D_xy + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_z +use crmx_params, only: docolumn +implicit none + +real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 +real dxz,dzx + +integer i,j,k,ic,ib,kc,kcu +real tkx, tkz, rhoi, iadzw, iadz +real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) + +rdx2=1./dx/dx +rdx25=0.25*rdx2 + +dxz=dx/dz + +j=1 + +if(.not.docolumn) then + + +do k=1,nzm + + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdx251=rdx25 * grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + +end do + +end if + +end subroutine diffuse_mom2D_xy + + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 new file mode 100644 index 0000000000..06fe1169f0 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 @@ -0,0 +1,125 @@ + +subroutine diffuse_mom2D_z + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_z +use crmx_params, only: docolumn +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes +use crmx_sgs, only: tk_clubb +#endif +implicit none + +real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 +real dxz,dzx + +integer i,j,k,ic,ib,kc,kcu +real tkx, tkz, rhoi, iadzw, iadz +real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) +real tktemp(0:nxp1, 1-YES3D:nyp1, nzm) + + +#ifndef CLUBB_CRM +tktemp(:, :, :) = tk(:, :, :) +#else +if(doclubb) then +!tktemp(:, :, :) = 0.0 ! the vertical diffusion of moment has been done in CLUBB +!tktemp(:, :, :) = tk_clubb ! We need this for the vertical diffuseion of verttical velocity +! ! As dudt and dvdt are updated in clubb_sgs, dudt and dvdt are not updated here. +tktemp(:, :, :) = tk_clubb * 0.2 ! use 0.2 here, as 0.4 is found too large for + ! 1.9x2.5 MMF simulation, as the explicit time integration scheme + ! is used for moment in SAM and large diffusion term can cause + ! numerical instability +++mhwang + ! +!tktemp(:, :, :) = tk_clubb * 0.00 ! follow what is done in clubb_sgs. +!tktemp(:, :, :) = tk +else +tktemp(:, :, :) = tk(:, :, :) +endif +#endif + +rdx2=1./dx/dx +rdx25=0.25*rdx2 + +j=1 + +!------------------------- +rdz=1./dz +dzx=dz/dx + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2=rdz*rdz *grdf_z(k) + rdz25=0.25*rdz2 + do i=1,nx + ib=i-1 + tkz=rdz2*tktemp(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tktemp(i,j,k)+tktemp(ib,j,k)+tktemp(i,j,kc)+tktemp(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do i=1,nx + tkz=rdz2*grdf_z(nzm)*tktemp(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) +#ifdef CLUBB_CRM + ! Add in the surface flux later -dschanen UWM 27 Aug 2008 + if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then + fu(i,j,1) = 0.0 ! This is handled by CLUBB + fv(i,j,1) = 0.0 ! " " + else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + end if +#else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) +#endif /*CLUBB_CRM*/ + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) +end do + + +do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do i=1,nx +#ifdef CLUBB_CRM +! if(.not. doclubb) then ! when doclubb is true, dudt and dvdt have been updated in clubb_sgs + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi +! end if +#else + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi +#endif + end do +end do ! k + +do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do +end do ! k + + +end subroutine diffuse_mom2D_z + + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 new file mode 100644 index 0000000000..d61d506bb5 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 @@ -0,0 +1,164 @@ + +subroutine diffuse_mom3D + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z +use crmx_params, only: docolumn +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes +#endif +implicit none + +real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 +real rdx21,rdy21,rdx251,rdy251,rdz25 +real dxy,dxz,dyx,dyz,dzx,dzy + +integer i,j,k,ic,ib,jb,jc,kc,kcu +real tkx, tky, tkz, rhoi, iadzw, iadz +real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) + +rdx25=0.25*rdx2 +rdy25=0.25*rdy2 + +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz + + +do k=1,nzm + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + dyz=dy/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdy21=rdy2 * grdf_y(k) + rdx251=rdx25 * grdf_x(k) + rdy251=rdy25 * grdf_y(k) + do j=1,ny + jb=j-1 + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + ib=i-1 + tky=rdy21*tk(i,j,k) + fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) + tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) + fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) + tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) + fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) + end do + end do + +end do + +!------------------------- +rdz=1./dz +dzx=dz/dx +dzy=dz/dy + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2 = rdz*rdz * grdf_z(k) + rdz25 = 0.25*rdz2 + do j=1,ny + jb=j-1 + do i=1,nx + ib=i-1 + tkz=rdz2*tk(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + tkz=rdz25*(tk(i,j,k)+tk(i,jb,k)+tk(i,j,kc)+tk(i,jb,kc)) + fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & + (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do j=1,ny + do i=1,nx + tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) +#ifdef CLUBB_CRM + ! Add in the surface flux later -dschanen UWM 27 Aug 2008 + if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then + fu(i,j,1) = 0.0 ! This is handled by CLUBB + fv(i,j,1) = 0.0 ! " " + else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + end if +#else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) +#endif /*CLUBB*/ + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) + end do + end do + + do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do j=1,ny + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi + end do + end do + end do ! k + + do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do j=1,ny + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do + end do + end do ! k + + +end subroutine diffuse_mom3D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 new file mode 100644 index 0000000000..f294f8e60e --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 @@ -0,0 +1,82 @@ + +subroutine diffuse_mom3D_xy + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z +use crmx_params, only: docolumn +implicit none + +real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 +real rdx21,rdy21,rdx251,rdy251,rdz25 +real dxy,dxz,dyx,dyz,dzx,dzy + +integer i,j,k,ic,ib,jb,jc,kc,kcu +real tkx, tky, tkz, rhoi, iadzw, iadz +real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) + +rdx25=0.25*rdx2 +rdy25=0.25*rdy2 + +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz + + +do k=1,nzm + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + dyz=dy/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdy21=rdy2 * grdf_y(k) + rdx251=rdx25 * grdf_x(k) + rdy251=rdy25 * grdf_y(k) + do j=1,ny + jb=j-1 + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + ib=i-1 + tky=rdy21*tk(i,j,k) + fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) + tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) + fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) + tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) + fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) + end do + end do + +end do + +end subroutine diffuse_mom3D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 new file mode 100644 index 0000000000..31e6232efa --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 @@ -0,0 +1,134 @@ + +subroutine diffuse_mom3D_z + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z +use crmx_params, only: docolumn +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes +use crmx_sgs, only: tk_clubb +#endif +implicit none + +real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 +real rdx21,rdy21,rdx251,rdy251,rdz25 +real dxy,dxz,dyx,dyz,dzx,dzy + +integer i,j,k,ic,ib,jb,jc,kc,kcu +real tkx, tky, tkz, rhoi, iadzw, iadz +real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) +real tktemp(0:nxp1, 1-YES3D:nyp1, nzm) + +#ifndef CLUBB_CRM +tktemp(:, :, :) = tk(:, :, :) +#else +if(doclubb) then +!tktemp(:, :, :) = 0.0 ! the vertical diffusion of moment has been done in CLUBB +!tktemp(:, :, :) = tk_clubb ! We need this for the vertical diffuseion of vertical velocity +! ! As dudt and dvdt are updated in clubb_sgs, dudt and dvdt are not updated here +tktemp(:, :, :) = tk_clubb * 0.2 ! use 0.2 here, as 0.4 is found too large for + ! 1.9x2.5 MMF simulation, as the explicit time integration scheme + ! is used for moment in SAM and large diffusion term can cause + ! numerical instability +++mhwang +else +tktemp(:, :, :) = tk(:, :, :) +endif +#endif + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) + +rdx25=0.25*rdx2 +rdy25=0.25*rdy2 + +!------------------------- +rdz=1./dz +dzx=dz/dx +dzy=dz/dy + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2 = rdz*rdz * grdf_z(k) + rdz25 = 0.25*rdz2 + do j=1,ny + jb=j-1 + do i=1,nx + ib=i-1 + tkz=rdz2*tktemp(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tktemp(i,j,k)+tktemp(ib,j,k)+tktemp(i,j,kc)+tktemp(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + tkz=rdz25*(tktemp(i,j,k)+tktemp(i,jb,k)+tktemp(i,j,kc)+tktemp(i,jb,kc)) + fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & + (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do j=1,ny + do i=1,nx + tkz=rdz2*grdf_z(nzm)*tktemp(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) +#ifdef CLUBB_CRM + ! Add in the surface flux later -dschanen UWM 27 Aug 2008 + if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then + fu(i,j,1) = 0.0 ! This is handled by CLUBB + fv(i,j,1) = 0.0 ! " " + else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + end if +#else + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) +#endif /*CLUBB*/ + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) + end do + end do + + do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do j=1,ny + do i=1,nx +#ifdef CLUBB_CRM +! if(.not. doclubb) then ! when doclubb is true, dudt and dvdt have been updated in clubb_sgs + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi +! end if +#else + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi +#endif + + end do + end do + end do ! k + + + do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do j=1,ny + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do + end do + end do ! k + + +end subroutine diffuse_mom3D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 new file mode 100644 index 0000000000..bf3085be14 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 @@ -0,0 +1,46 @@ +subroutine diffuse_scalar (f,fluxb,fluxt, & + fdiff,flux,f2lediff,f2lediss,fwlediff,doit) + +use crmx_grid +use crmx_vars, only: rho, rhow +use crmx_sgs, only: tkh +implicit none + +! input: +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real flux(nz) +real f2lediff(nz),f2lediss(nz),fwlediff(nz) +real fdiff(nz) +logical doit +! Local +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +integer i,j,k + +!call t_startf ('diffuse_scalars') + +df(:,:,:) = f(:,:,:) + +if(RUN3D) then +! call diffuse_scalar3D (f,fluxb,fluxt,tkh,rho,rhow,flux) + call diffuse_scalar3D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) + call diffuse_scalar3D_z (f,fluxb,fluxt,tkh,rho,rhow,flux) +else +! call diffuse_scalar2D (f,fluxb,fluxt,tkh,rho,rhow,flux) + call diffuse_scalar2D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) + call diffuse_scalar2D_z (f,fluxb,fluxt,tkh,rho,rhow,flux) +endif + +do k=1,nzm + fdiff(k)=0. + do j=1,ny + do i=1,nx + fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) + end do + end do +end do + +!call t_stopf ('diffuse_scalars') + +end subroutine diffuse_scalar diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 new file mode 100644 index 0000000000..d8ff8f7587 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 @@ -0,0 +1,103 @@ +subroutine diffuse_scalar2D (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dosgs +use crmx_sgs,only: grdf_x,grdf_z +implicit none + +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) + +! local +real flx(0:nx,1,0:nzm) +real dfdt(nx,ny,nzm) +real rdx2,rdz2,rdz,rdx5,rdz5,tmp +real dxz,dzx,tkx,tkz,rhoi +integer i,j,k,ib,ic,kc,kb + +if(.not.dosgs.and..not.docolumn) return + +rdx2=1./(dx*dx) +rdz2=1./(dz*dz) +rdz=1./dz +dxz=dx/dz +dzx=dz/dx + +j=1 + +dfdt(:,:,:)=0. + +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + field(0,j,k) = field(1,j,k) + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + field(nx+1,j,k) = field(nx,j,k) + end do + end if + +end if + + +if(.not.docolumn) then + + +do k=1,nzm + + rdx5=0.5*rdx2 *grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + +end do + +end if + +flux(1) = 0. +tmp=1./adzw(nz) +do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k) + dfdt(i,j,k) + end do +end do + +end subroutine diffuse_scalar2D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 new file mode 100644 index 0000000000..8657d61349 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 @@ -0,0 +1,79 @@ +subroutine diffuse_scalar2D_xy (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dosgs +use crmx_sgs,only: grdf_x,grdf_z +implicit none + +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) + +! local +real flx(0:nx,1,0:nzm) +real dfdt(nx,ny,nzm) +real rdx2,rdz2,rdz,rdx5,rdz5,tmp +real dxz,dzx,tkx,tkz,rhoi +integer i,j,k,ib,ic,kc,kb + +if(.not.dosgs.and..not.docolumn) return + +rdx2=1./(dx*dx) +rdz2=1./(dz*dz) +rdz=1./dz +dxz=dx/dz +dzx=dz/dx + +j=1 + +dfdt(:,:,:)=0. + +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + field(0,j,k) = field(1,j,k) + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + field(nx+1,j,k) = field(nx,j,k) + end do + end if + +end if + + +if(.not.docolumn) then + + +do k=1,nzm + + rdx5=0.5*rdx2 *grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + + do i=1,nx + field(i,j,k)=field(i,j,k) + dfdt(i,j,k) * dtn + end do + +end do + +end if + +flux = 0.0 + +end subroutine diffuse_scalar2D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 new file mode 100644 index 0000000000..4d0b6e76f7 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 @@ -0,0 +1,66 @@ +subroutine diffuse_scalar2D_z (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dosgs +use crmx_sgs,only: grdf_x,grdf_z +implicit none + +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) + +! local +real flx(0:nx,1,0:nzm) +real dfdt(nx,ny,nzm) +real rdx2,rdz2,rdz,rdx5,rdz5,tmp +real dxz,dzx,tkx,tkz,rhoi +integer i,j,k,ib,ic,kc,kb + +if(.not.dosgs.and..not.docolumn) return + +rdx2=1./(dx*dx) +rdz2=1./(dz*dz) +rdz=1./dz +dxz=dx/dz +dzx=dz/dx + +j=1 + +dfdt(:,:,:)=0. + +flux(1) = 0. +tmp=1./adzw(nz) +do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k) + dfdt(i,j,k) + end do +end do + +end subroutine diffuse_scalar2D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 new file mode 100644 index 0000000000..f166ee61ea --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 @@ -0,0 +1,177 @@ +subroutine diffuse_scalar3D (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dowally,dosgs +use crmx_sgs, only: grdf_x,grdf_y,grdf_z +implicit none +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) +! local +real flx(0:nx,0:ny,0:nzm) +real dfdt(nx,ny,nz) +real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp +real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi +integer i,j,k,ib,ic,jb,jc,kc,kb + + +if(.not.dosgs) return + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) +rdz2=1./(dz*dz) +rdz=1./dz +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz +dzx=dz/dx +dzy=dz/dy + +dfdt(:,:,:)=0. + +!----------------------------------------- +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + do j=1,ny + field(0,j,k) = field(1,j,k) + end do + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + do j=1,ny + field(nx+1,j,k) = field(nx,j,k) + end do + end do + end if + +end if + +if(dowally) then + + if(rank.lt.nsubdomains_x) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(rank.gt.nsubdomains-nsubdomains_x-1) then + do k=1,nzm + do i=1,ny + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + + + +if(dowally) then + + call task_rank_to_index(rank, ib, jb) + if(jb.eq.0) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(jb.eq.nsubdomains_y-1) then + do k=1,nzm + do i=1,nx + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + +!----------------------------------------- + + +! Horizontal diffusion: + + +do k=1,nzm + + rdx5=0.5*rdx2 * grdf_x(k) + rdy5=0.5*rdy2 * grdf_y(k) + + do j=1,ny + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) + flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) + end do + end do + +end do ! k + + +! Vertical diffusion: + +flux(1) = 0. +tmp=1./adzw(nz) +do j=1,ny + do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) + end do +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do j=1,ny + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do j=1,ny + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k)+dfdt(i,j,k) + end do + end do +end do + +end subroutine diffuse_scalar3D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 new file mode 100644 index 0000000000..e9f0db80c7 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 @@ -0,0 +1,146 @@ +subroutine diffuse_scalar3D_xy (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dowally,dosgs +use crmx_sgs, only: grdf_x,grdf_y,grdf_z +implicit none +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) +! local +real flx(0:nx,0:ny,0:nzm) +real dfdt(nx,ny,nz) +real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp +real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi +integer i,j,k,ib,ic,jb,jc,kc,kb + + +if(.not.dosgs) return + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) +rdz2=1./(dz*dz) +rdz=1./dz +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz +dzx=dz/dx +dzy=dz/dy + +dfdt(:,:,:)=0. + +!----------------------------------------- +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + do j=1,ny + field(0,j,k) = field(1,j,k) + end do + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + do j=1,ny + field(nx+1,j,k) = field(nx,j,k) + end do + end do + end if + +end if + +if(dowally) then + + if(rank.lt.nsubdomains_x) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(rank.gt.nsubdomains-nsubdomains_x-1) then + do k=1,nzm + do i=1,ny + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + + + +if(dowally) then + + call task_rank_to_index(rank, ib, jb) + if(jb.eq.0) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(jb.eq.nsubdomains_y-1) then + do k=1,nzm + do i=1,nx + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + +!----------------------------------------- + + +! Horizontal diffusion: + + +do k=1,nzm + + rdx5=0.5*rdx2 * grdf_x(k) + rdy5=0.5*rdy2 * grdf_y(k) + + do j=1,ny + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) + flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) + end do + end do + + do j=1, ny + do i=1, nx + field(i,j,k) = field(i,j,k) + dfdt(i,j,k) * dtn + end do + end do + +end do ! k + +flux = 0.0 + +end subroutine diffuse_scalar3D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 new file mode 100644 index 0000000000..d8066cc750 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 @@ -0,0 +1,76 @@ +subroutine diffuse_scalar3D_z (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dowally,dosgs +use crmx_sgs, only: grdf_x,grdf_y,grdf_z +implicit none +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) +! local +real flx(0:nx,0:ny,0:nzm) +real dfdt(nx,ny,nz) +real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp +real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi +integer i,j,k,ib,ic,jb,jc,kc,kb + + +if(.not.dosgs) return + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) +rdz2=1./(dz*dz) +rdz=1./dz +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz +dzx=dz/dx +dzy=dz/dy + +dfdt(:,:,:)=0. + +! Vertical diffusion: + +flux(1) = 0. +tmp=1./adzw(nz) +do j=1,ny + do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) + end do +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do j=1,ny + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do j=1,ny + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k)+dfdt(i,j,k) + end do + end do +end do + +end subroutine diffuse_scalar3D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 new file mode 100644 index 0000000000..2d3944e1f4 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 @@ -0,0 +1,53 @@ +subroutine diffuse_scalar_xy (f,fluxb,fluxt, & + fdiff,flux,f2lediff,f2lediss,fwlediff,doit) + +use crmx_grid +use crmx_vars, only: rho, rhow +use crmx_sgs, only: tkh +implicit none + +! input: +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real flux(nz) +real fdiff(nz) +real f2lediff(nz) +real f2lediss(nz) +real fwlediff(nz) +logical doit +! Local +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real f0(nzm),df0(nzm),factor_xy +real r2dx,r2dy,r2dx0,r2dy0,r2dz +integer i,j,k,kb,kc,jb,jc + +!call t_startf ('diffuse_scalars_xy') + + + do k=1,nzm + do j=dimy1_s,dimy2_s + do i=dimx1_s,dimx2_s + df(i,j,k) = f(i,j,k) + end do + end do + end do + +if(RUN3D) then + call diffuse_scalar3D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) +else + call diffuse_scalar2D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) +endif + + do k=1,nzm + fdiff(k)=0. + do j=1,ny + do i=1,nx + fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) + end do + end do + end do + +!call t_stopf ('diffuse_scalars_xy') + +end subroutine diffuse_scalar_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 new file mode 100644 index 0000000000..e74aa7f2b5 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 @@ -0,0 +1,70 @@ +subroutine diffuse_scalar_z (f,fluxb,fluxt, & + fdiff,flux,f2lediff,f2lediss,fwlediff,doit) + +use crmx_grid +use crmx_vars, only: rho, rhow +use crmx_sgs, only: tkh +#ifdef CLUBB_CRM +use crmx_sgs, only: tkh_clubb +use crmx_params, only: doclubb +#endif +implicit none + +! input: +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real flux(nz) +real fdiff(nz) +real f2lediff(nz) +real f2lediss(nz) +real fwlediff(nz) +logical doit +! Local +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkhtemp(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy diffusivity +real f0(nzm),df0(nzm),factor_xy +real f2lediss_z(nzm) +real r2dx,r2dy,r2dx0,r2dy0,r2dz +integer i,j,k,kb,kc,jb,jc + +!call t_startf ('diffuse_scalars_z') + +tkhtemp = 0.0 +#ifndef CLUBB_CRM +tkhtemp(:, :, :) = tkh(:, :, :) +#else +if(doclubb) then + tkhtemp(:, :, :) = tkh_clubb(:, :, :) +else + tkhtemp(:, :, :) = tkh(:, :, :) +endif +#endif + + do k=1,nzm + do j=dimy1_s,dimy2_s + do i=dimx1_s,dimx2_s + df(i,j,k) = f(i,j,k) + end do + end do + end do + + +if(RUN3D) then + call diffuse_scalar3D_z (f,fluxb,fluxt,tkhtemp,rho,rhow,flux) +else + call diffuse_scalar2D_z (f,fluxb,fluxt,tkhtemp,rho,rhow,flux) +endif + + do k=1,nzm + fdiff(k)=0. + do j=1,ny + do i=1,nx + fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) + end do + end do + end do + +!call t_stopf ('diffuse_scalars_z') + +end subroutine diffuse_scalar_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 new file mode 100644 index 0000000000..5cd9b14561 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 @@ -0,0 +1,64 @@ +subroutine fluxes_scalar_z (f,fluxb,fluxt, & + fdiff,flux,f2lediff,f2lediss,fwlediff,doit) + +!-------------------------------------------------------------------- +! This subroutine is only used to apply the surface fluxes for scalars. +! This is needed when surface fluxes are applied in the host model in SAM_CLUBB +! Here tkh is zet to zero so vertical diffusion is not calculated. +! Minghuai Wang, 2013-02 +!--------------------------------------------------------------------- + +use crmx_grid +use crmx_vars, only: rho, rhow +!use sgs, only: tkh +implicit none + +! input: +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real flux(nz) +real fdiff(nz) +real f2lediff(nz) +real f2lediss(nz) +real fwlediff(nz) +logical doit +! Local +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real f0(nzm),df0(nzm),factor_xy +real f2lediss_z(nzm) +real tkh2(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity +real r2dx,r2dy,r2dx0,r2dy0,r2dz +integer i,j,k,kb,kc,jb,jc + +!call t_startf ('fluxes_scalars_z') + +tkh2 = 0.0 + + do k=1,nzm + do j=dimy1_s,dimy2_s + do i=dimx1_s,dimx2_s + df(i,j,k) = f(i,j,k) + end do + end do + end do + + +if(RUN3D) then + call diffuse_scalar3D_z (f,fluxb,fluxt,tkh2,rho,rhow,flux) +else + call diffuse_scalar2D_z (f,fluxb,fluxt,tkh2,rho,rhow,flux) +endif + + do k=1,nzm + fdiff(k)=0. + do j=1,ny + do i=1,nx + fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) + end do + end do + end do + +!call t_stopf ('fluxes_scalars_z') + +end subroutine fluxes_scalar_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 new file mode 100644 index 0000000000..82fb15ad33 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 @@ -0,0 +1,661 @@ +module crmx_sgs + +! module for original SAM subgrid-scale SGS closure (Smagorinsky or 1st-order TKE) +! Marat Khairoutdinov, 2012 + +use crmx_grid, only: nx,nxp1,ny,nyp1,YES3D,nzm,nz,dimx1_s,dimx2_s,dimy1_s,dimy2_s +use crmx_params, only: dosgs +use crmx_vars, only: tke2, tk2 +#ifdef CLUBB_CRM +use crmx_clubbvars, only: khzt, khzm +use crmx_params, only: doclubb +#endif +implicit none + +!---------------------------------------------------------------------- +! Required definitions: + +!!! prognostic scalar (need to be advected arround the grid): + +integer, parameter :: nsgs_fields = 1 ! total number of prognostic sgs vars + +real sgs_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nsgs_fields) + +!!! sgs diagnostic variables that need to exchange boundary information (via MPI): + +#ifndef CLUBB_CRM +integer, parameter :: nsgs_fields_diag = 2 ! total number of diagnostic sgs vars +#else +integer, parameter :: nsgs_fields_diag = 4 ! total number of diagnostic sgs vars +#endif + +! diagnostic fields' boundaries: +integer, parameter :: dimx1_d=0, dimx2_d=nxp1, dimy1_d=1-YES3D, dimy2_d=nyp1 + +real sgs_field_diag(dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm, nsgs_fields_diag) + +logical:: advect_sgs = .false. ! advect prognostics or not, default - not (Smagorinsky) +logical, parameter:: do_sgsdiag_bound = .true. ! exchange boundaries for diagnostics fields + +! SGS fields that output by default (if =1). +integer, parameter :: flag_sgs3Dout(nsgs_fields) = (/0/) +#ifndef CLUBB_CRM +integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0/) +#else +integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0,0,0/) +#endif + +real fluxbsgs (nx, ny, 1:nsgs_fields) ! surface fluxes +real fluxtsgs (nx, ny, 1:nsgs_fields) ! top boundary fluxes + +!!! these arrays may be needed for output statistics: + +real sgswle(nz,1:nsgs_fields) ! resolved vertical flux +real sgswsb(nz,1:nsgs_fields) ! SGS vertical flux +real sgsadv(nz,1:nsgs_fields) ! tendency due to vertical advection +real sgslsadv(nz,1:nsgs_fields) ! tendency due to large-scale vertical advection +real sgsdiff(nz,1:nsgs_fields) ! tendency due to vertical diffusion + +!------------------------------------------------------------------ +! internal (optional) definitions: + +! make aliases for prognostic variables: + +real tke(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE +equivalence (tke(dimx1_s,dimy1_s,1),sgs_field(dimx1_s,dimy1_s,1,1)) + +! make aliases for diagnostic variables: + +real tk (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity +real tkh (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity +equivalence (tk(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,1)) +equivalence (tkh(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,2)) +#ifdef CLUBB_CRM +real tk_clubb (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity +real tkh_clubb (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity +equivalence (tk_clubb(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,3)) +equivalence (tkh_clubb(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,4)) +#endif + +real grdf_x(nzm)! grid factor for eddy diffusion in x +real grdf_y(nzm)! grid factor for eddy diffusion in y +real grdf_z(nzm)! grid factor for eddy diffusion in z + +logical:: dosmagor ! if true, then use Smagorinsky closure + +! Local diagnostics: + +real tkesbbuoy(nz), tkesbshear(nz),tkesbdiss(nz), tkesbdiff(nz) + +CONTAINS + +! required microphysics subroutines and function: +!---------------------------------------------------------------------- +!!! Read microphysics options from prm (namelist) file + +subroutine sgs_setparm() + + use crmx_grid, only: case + implicit none + + integer ierr, ios, ios_missing_namelist, place_holder + + !====================================================================== + ! UW ADDITION + NAMELIST /SGS_TKE/ & + dosmagor ! Diagnostic Smagorinsky closure + + NAMELIST /BNCUIODSBJCB/ place_holder + + dosmagor = .true. ! default + + !---------------------------------- + ! Read namelist for microphysics options from prm file: + !------------ + !open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') + + !read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) + !rewind(55) !note that one must rewind before searching for new namelists + + !read (55,SGS_TKE,IOSTAT=ios) + + advect_sgs = .not.dosmagor + + !if (ios.ne.0) then + ! !namelist error checking + ! if(ios.ne.ios_missing_namelist) then + ! write(*,*) '****** ERROR: bad specification in SGS_TKE namelist' + ! call task_abort() + ! end if + !end if + !close(55) + + ! END UW ADDITION + !====================================================================== + +end subroutine sgs_setparm + +!---------------------------------------------------------------------- +!!! Initialize sgs: + + +subroutine sgs_init() + + use crmx_grid, only: nrestart, dx, dy, dz, adz, masterproc + use crmx_params, only: LES +#ifdef CLUBB_CRM + use crmx_params, only: doclubb +#endif + integer k + + if(nrestart.eq.0) then + + sgs_field = 0. + sgs_field_diag = 0. + + fluxbsgs = 0. + fluxtsgs = 0. + + end if + +! if(masterproc) then +! if(dosmagor) then +! write(*,*) 'Smagorinsky SGS Closure' +! else +! write(*,*) 'Prognostic TKE 1.5-order SGS Closure' +! end if +!#ifdef CLUBB_CRM +! if ( doclubb ) then +! write(*,*) 'CLUBB Parameterization' +! end if +!#endif +! end if + + if(LES) then + do k=1,nzm + grdf_x(k) = dx**2/(adz(k)*dz)**2 + grdf_y(k) = dy**2/(adz(k)*dz)**2 + grdf_z(k) = 1. + end do + else + do k=1,nzm + grdf_x(k) = min(16.,dx**2/(adz(k)*dz)**2) + grdf_y(k) = min(16.,dy**2/(adz(k)*dz)**2) + grdf_z(k) = 1. + end do + end if + + sgswle = 0. + sgswsb = 0. + sgsadv = 0. + sgsdiff = 0. + sgslsadv = 0. + + +end subroutine sgs_init + +!---------------------------------------------------------------------- +!!! make some initial noise in sgs: +! +subroutine setperturb_sgs(ptype) + +use crmx_vars, only: q0, z +integer, intent(in) :: ptype +integer i,j,k + +select case (ptype) + + case(0) + + do k=1,nzm + do j=1,ny + do i=1,nx + if(k.le.4.and..not.dosmagor) then + tke(i,j,k)=0.04*(5-k) + endif + end do + end do + end do + + case(1) + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.6.e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + case(2) + + case(3) ! gcss wg1 smoke-cloud case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.0.5e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + + case(4) ! gcss wg1 arm case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(z(k).le.150..and..not.dosmagor) then + tke(i,j,k)=0.15*(1.-z(k)/150.) + endif + end do + end do + end do + + + case(5) ! gcss wg1 BOMEX case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(z(k).le.3000..and..not.dosmagor) then + tke(i,j,k)=1.-z(k)/3000. + endif + end do + end do + end do + + case(6) ! GCSS Lagragngian ASTEX + + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.6.e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + + case default + +end select + +end subroutine setperturb_sgs + +!---------------------------------------------------------------------- +!!! Estimate Courant number limit for SGS +! + +subroutine kurant_sgs(cfl) + +use crmx_grid, only: dt, dx, dy, dz, adz, adzw +implicit none + +real, intent(out) :: cfl + +integer k +real tkhmax(nz) + +do k = 1,nzm + tkhmax(k) = maxval(tkh(1:nx,1:ny,k)) +end do + +cfl = 0. +do k=1,nzm + cfl = max(cfl, & + 0.5*tkhmax(k)*grdf_z(k)*dt/(dz*adzw(k))**2, & + 0.5*tkhmax(k)*grdf_x(k)*dt/dx**2, & + YES3D*0.5*tkhmax(k)*grdf_y(k)*dt/dy**2) +end do + +end subroutine kurant_sgs + + +!---------------------------------------------------------------------- +!!! compute sgs diffusion of momentum: +! +subroutine sgs_mom() +#ifdef CLUBB_CRM + use crmx_params, only: doclubb + use crmx_clubb_sgs, only: apply_clubb_sgs_tndcy_mom + use crmx_vars, only: dudt, dvdt +#endif + +#ifdef CLUBB_CRM + if ( doclubb ) then +! call apply_clubb_sgs_tndcy_mom & +! ( dudt, dvdt ) ! in/out + endif +#endif /*CLUBB_CRM*/ + + call diffuse_mom() + +end subroutine sgs_mom + +!---------------------------------------------------------------------- +!!! compute sgs diffusion of scalars: +! +subroutine sgs_scalars() + + use crmx_vars + use crmx_microphysics + use crmx_crmtracers + use crmx_params, only: dotracers, doclubb, doclubb_sfc_fluxes, doclubbnoninter, docam_sfc_fluxes +#ifdef CLUBB_CRM + use crmx_clubbvars, only: edsclr_dim, sclr_dim + use crmx_clubb_sgs, only: total_energy + use crmx_clubb_sgs, only: apply_clubb_sgs_tndcy_scalars + use crmx_grid, only: dtn + use crmx_clubb_precision, only: time_precision +#endif /*CLUBB_CRM*/ + implicit none + + real dummy(nz) + real f2lediff_xy(nz), f2lediss_xy(nz), fwlediff_xy(nz) + real f2lediff_z(nz), f2lediss_z(nz), fwlediff_z(nz) + real sdiff_xy(nz), sdiff_z(nz) + real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss + integer k + + +#ifdef CLUBB_CRM + total_energy_evap = total_energy_evap - total_energy(t) +#endif + +! Update for t, qv, qcl from clubb_sgs +#ifdef CLUBB_CRM + if ( doclubb ) then + + ! Recalculate q, qv, qcl based on new micro_fields (updated by horizontal + ! diffusion) + call micro_update() + + ! Then Re-compute q/qv/qcl based on values computed in CLUBB + call apply_clubb_sgs_tndcy_scalars & + ( real( dtn, kind=time_precision), & ! in + t, qv, qcl) ! in/out + + call micro_adjust( qv, qcl ) ! in + end if +#endif /*CLUBB_CRM*/ + + f2lediff_xy = 0.0 + f2lediss_xy = 0.0 + fwlediff_xy = 0.0 + +! call diffuse_scalar(t,fluxbt,fluxtt,tdiff,twsb, & +! t2lediff,t2lediss,twlediff,.true.) + call diffuse_scalar_xy(t,fluxbt,fluxtt,tdiff_xy,twsb, & + f2lediff_xy,f2lediss_xy,fwlediff_xy,.true.) + f2lediff_z =0.0 + f2lediss_z =0.0 + fwlediff_z =0.0 +#ifdef CLUBB_CRM + ! Diffuse moist static energy in the vertical only if CLUBB is not being + ! called + if ( .not. doclubb ) then + call diffuse_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & + f2lediff_z,f2lediss_z,fwlediff_z,.true.) + else ! doclubb + if(doclubb_sfc_fluxes .or. docam_sfc_fluxes) then + ! The flux will be applied in advance_clubb_core, so the 2nd argument + ! is zero. + call fluxes_scalar_z(t,fzero,fluxtt,tdiff_z,twsb, & + f2lediff_z,f2lediss_z,fwlediff_z,.true.) + else + call fluxes_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & + f2lediff_z,f2lediss_z,fwlediff_z,.true.) + end if + end if +#else + call diffuse_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & + f2lediff_z,f2lediss_z,fwlediff_z,.true.) +#endif + + tdiff = tdiff_xy + tdiff_z + + t2lediff = f2lediff_xy + f2lediff_z + t2lediss = f2lediss_xy + f2lediss_z + twlediff = fwlediff_xy + fwlediff_z + +#ifdef CLUBB_CRM + total_energy_evap = total_energy_evap + total_energy(t) +#endif + + if(advect_sgs) then +! call diffuse_scalar(tke,fzero,fzero,dummy,sgswsb, & +! dummy,dummy,dummy,.false.) + call diffuse_scalar_xy(tke,fzero,fzero,dummy,sgswsb, & + dummy,dummy,dummy,.false.) + call diffuse_scalar_z(tke,fzero,fzero,dummy,sgswsb, & + dummy,dummy,dummy,.false.) + end if + + +! +! diffusion of microphysics prognostics: +! + call micro_flux() + + total_water_evap = total_water_evap - total_water() + + do k = 1,nmicro_fields + if( k.eq.index_water_vapor &! transport water-vapor variable no metter what +#ifdef CLUBB_CRM + .or. ( docloud.or.doclubb.or.doclubbnoninter ).and.flag_precip(k).ne.1 & ! transport non-precipitation vars +#else + .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars +#endif + + .or. doprecip.and.flag_precip(k).eq.1 ) then + + fluxbtmp(1:nx,1:ny) = fluxbmk(1:nx,1:ny,k) + fluxttmp(1:nx,1:ny) = fluxtmk(1:nx,1:ny,k) + sdiff_xy = 0.0 + sdiff_z = 0.0 + +! call diffuse_scalar(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & +! mkdiff(:,k),mkwsb(:,k), dummy,dummy,dummy,.false.) + call diffuse_scalar_xy(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & + sdiff_xy,mkwsb(:,k), dummy,dummy,dummy,.false.) + if(k.ne.index_water_vapor) then + call diffuse_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & + sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) + else ! k==index_water_vapor + if(.not. doclubb) then + call diffuse_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & + sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) + else ! doclubb + call fluxes_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & + sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) + end if + end if + mkdiff(:, k) = sdiff_xy + sdiff_z + end if + end do + + total_water_evap = total_water_evap + total_water() + + ! diffusion of tracers: + + if(dotracers) then + + call tracers_flux() + + do k = 1,ntracers + +#ifdef CLUBB_CRM + ! If CLUBB is using the high-order or eddy diffusivity scalars, then + ! we should apply the flux within advance_clubb_core when + ! doclubb_sfc_fluxes is set to true. -dschanen UWM 2 Mar 2010 + if ( ( edsclr_dim > 0 .or. sclr_dim > 0 ) .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then + fluxbtmp = 0. ! Apply surface flux in CLUBB + else + fluxbtmp = fluxbtr(:,:,k) + end if +#else + fluxbtmp = fluxbtr(:,:,k) +#endif /*CLUBB_CRM*/ + fluxttmp = fluxttr(:,:,k) +! call diffuse_scalar(tracer(:,:,:,k),fluxbtmp,fluxttmp, & +! trdiff(:,k),trwsb(:,k), & +! dummy,dummy,dummy,.false.) + call diffuse_scalar_xy(tracer(:,:,:,k),fluxbtmp,fluxttmp, & + trdiff(:,k),trwsb(:,k), & + dummy,dummy,dummy,.false.) + +#ifdef CLUBB_CRM + ! Only diffuse the tracers if CLUBB is either disabled or using the + ! eddy scalars code to diffuse them. + if ( .not. doclubb .or. ( doclubb .and. edsclr_dim < 1 .and. sclr_dim < 1 ) ) then + call diffuse_scalar_z(tracer(:,:,:,k),fluxbtmp,fluxttmp, & + trdiff(:,k),trwsb(:,k), & + dummy,dummy,dummy,.false.) + end if +#else + call diffuse_scalar_z(tracer(:,:,:,k),fluxbtmp,fluxttmp, & + trdiff(:,k),trwsb(:,k), & + dummy,dummy,dummy,.false.) +#endif +!!$ call diffuse_scalar(tracer(:,:,:,k),fluxbtr(:,:,k),fluxttr(:,:,k),trdiff(:,k),trwsb(:,k), & +!!$ dummy,dummy,dummy,.false.) + + end do + + end if + + + +end subroutine sgs_scalars + +!---------------------------------------------------------------------- +!!! compute sgs processes (beyond advection): +! +subroutine sgs_proc() + + use crmx_grid, only: nstep,dt,icycle + use crmx_params, only: dosmoke +#ifdef CLUBB_CRM + use crmx_clubbvars, only: khzt, khzm + use crmx_microphysics + use crmx_params, only: doclubb, doclubbnoninter, nclubb + use crmx_grid, only: dtn, time, dt + use crmx_vars, only: u, v, w, rho, rhow, wsub, qpl, qci, qpi, t, qv, qcl + use crmx_clubb_precision, only: time_precision + use crmx_clubb_sgs, only: advance_clubb_sgs +#endif + +! SGS CLUBB +#ifdef CLUBB_CRM + if ( doclubb .or. doclubbnoninter ) then + ! In case of ice fall, we recompute qci here for the + ! single-moment scheme. Also, subsidence, diffusion and advection have + ! been applied to micro_field but not qv/qcl so they must be updated. + call micro_update() + + ! We call CLUBB here because adjustments to the wind + ! must occur prior to adams() -dschanen 26 Aug 2008 + ! Here we call clubb only if nstep divides the current timestep, + ! or we're on the very first timestep + +! in the case with m2005, clubb is only called in the first subscycle (icycle=1)) + if ( ((nstep == 1 .or. mod( nstep, nclubb ) == 0) .and. & + (icycle == 1)).and.(nclubb .ne. 1) ) then ! call every CRM step, so dt is used + call advance_clubb_sgs & + ( real( dt*real( nclubb ), kind=time_precision), & ! in + real( 0., kind=time_precision ), & ! in + real( time, kind=time_precision ), & ! in + rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in + t, qv, qcl ) ! in + else if(nclubb.eq.1) then ! call every icycle, so dtn is used + call advance_clubb_sgs & + ( real( dtn*real( nclubb ), kind=time_precision), & ! in + real( 0., kind=time_precision ), & ! in + real( time, kind=time_precision ), & ! in + rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in + t, qv, qcl ) ! in + end if ! nstep == 1 .or. mod( nstep, nclubb) == 0 + + end if ! doclubb .or. doclubbnoninter +#endif + +! SGS TKE equation: + + if(dosgs) call tke_full() + + tke2 = tke + tk2 = tk + +#ifdef CLUBB_CRM + if(doclubb) then +! tk = khzt +! tkh = khzt + +! tk_clubb = khzt +! tkh_clubb = khzt + tk_clubb = khzm + tkh_clubb = khzm + end if +#endif + + +end subroutine sgs_proc + +!---------------------------------------------------------------------- +!!! Diagnose arrays nessesary for dynamical core and statistics: +! +subroutine sgs_diagnose() +! None + +end subroutine sgs_diagnose + +!---------------------------------------------------------------------- +! called when stepout() called + +subroutine sgs_print() + + call fminmax_print('tke:',tke,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) + call fminmax_print('tk:',tk,0,nxp1,1-YES3D,nyp1,nzm) + call fminmax_print('tkh:',tkh,0,nxp1,1-YES3D,nyp1,nzm) + +end subroutine sgs_print + +!---------------------------------------------------------------------- +!!! Initialize the list of sgs statistics +! +subroutine sgs_hbuf_init(namelist,deflist,unitlist,status,average_type,count,sgscount) +character(*) namelist(*), deflist(*), unitlist(*) +integer status(*),average_type(*),count,sgscount + +character*8 name +character*80 longname +character*10 units + +#ifdef CLUBB +if (doclubb) then +name = 'TKCLUBB' +longname = 'Eddy diffusivity from CLUBB' +units = 'm2/s' +call add_to_namelist(count,sgscount,name,longname,units,0) + +name = 'TKHCLUBB' +longname = 'Eddy diffusivity from CLUBB' +units = 'm2/s' +call add_to_namelist(count,sgscount,name,longname,units,0) +end if +#endif + +end subroutine sgs_hbuf_init + + +end module crmx_sgs + + + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 new file mode 100644 index 0000000000..50fe343ebe --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 @@ -0,0 +1,109 @@ + +subroutine shear_prod2D(def2) + +use crmx_vars +implicit none + +real def2(nx,ny,nzm) + +real rdx0,rdx,rdx_up,rdx_dn +real rdz,rdzw_up,rdzw_dn +integer i,j,k,ib,ic,kb,kc + +rdx0=1./dx +j=1 + + +do k=2,nzm-1 + + kb=k-1 + kc=k+1 + rdz = 1./(dz*adz(k)) + rdzw_up = 1./(dz*adzw(kc)) + rdzw_dn = 1./(dz*adzw(k)) + rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy + rdx_up=rdx0 * sqrt(dx*rdzw_up) + rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 + & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 ) + + end do +end do ! k + + +k=1 +kc=k+1 + +rdz = 1./(dz*adz(k)) +rdzw_up = 1./(dz*adzw(kc)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdx_up=rdx0 * sqrt(dx*rdzw_up) + +do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + +( (v(i,j ,kc)-v0(kc)-v(i,j,k)+v0(k))*rdzw_up )**2 & + + 0.5 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) +end do + +k=nzm +kc=k+1 +kb=k-1 + +rdz = 1./(dz*adz(k)) +rdzw_dn = 1./(dz*adzw(k)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + + +do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 & + + 0.5 * ( & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + +end do + +end + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 new file mode 100644 index 0000000000..2ecd9c25a6 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 @@ -0,0 +1,155 @@ + +subroutine shear_prod3D(def2) + +use crmx_vars +implicit none + +real def2(nx,ny,nzm) + +real rdx0,rdx,rdx_up,rdx_dn +real rdy0,rdy,rdy_up,rdy_dn +real rdz,rdzw_up,rdzw_dn +integer i,j,k,ib,ic,jb,jc,kb,kc + +rdx0=1./dx +rdy0=1./dy + +do k=2,nzm-1 + + kb=k-1 + kc=k+1 + rdz = 1./(dz*adz(k)) + rdzw_up = 1./(dz*adzw(kc)) + rdzw_dn = 1./(dz*adzw(k)) + rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy + rdy=rdy0 * sqrt(dy*rdz) + rdx_up=rdx0 * sqrt(dx*rdzw_up) + rdy_up=rdy0 * sqrt(dy*rdzw_up) + rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + rdy_dn=rdy0 * sqrt(dy*rdzw_dn) + + do j=1,ny + jb=j-YES3D + jc=j+YES3D + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) + def2(i,j,k)=def2(i,j,k) & + + 0.25 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + def2(i,j,k)=def2(i,j,k) & + + 0.25 * ( & + ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & + (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & + (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 + & + ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & + (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & + (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) + + end do + end do +end do ! k + + +k=1 +kc=k+1 + +rdz = 1./(dz*adz(k)) +rdzw_up = 1./(dz*adzw(kc)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdy=rdy0 * sqrt(dy*rdz) +rdx_up=rdx0 * sqrt(dx*rdzw_up) +rdy_up=rdy0 * sqrt(dy*rdzw_up) + +do j=1,ny + jb=j-YES3D + jc=j+YES3D + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + 0.5 * ( & + ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & + (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & + (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 ) & + + 0.5 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) + + + end do +end do + + +k=nzm +kc=k+1 +kb=k-1 + +rdz = 1./(dz*adz(k)) +rdzw_dn = 1./(dz*adzw(k)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdy=rdy0 * sqrt(dy*rdz) +rdx_dn=rdx0 * sqrt(dx*rdzw_dn) +rdy_dn=rdy0 * sqrt(dy*rdzw_dn) + +do j=1,ny + jb=j-1*YES3D + jc=j+1*YES3D + do i=1,nx + ib=i-1 + ic=i+1 + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + 0.5 * ( & + ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & + (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & + (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) & + + 0.5 * ( & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + end do +end do + +end + diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 new file mode 100644 index 0000000000..8a0bb38481 --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 @@ -0,0 +1,1479 @@ +! $Id: stat_clubb.F90 1070 2013-04-19 20:05:10Z minghuai.wang@pnl.gov $ +module crmx_stat_clubb +#ifdef CLUBB_CRM + use crmx_grid, only: nx, ny, nz, nzm + implicit none + + public :: stats_clubb_update + +#ifdef CLUBB_LH + public stats_clubb_silhs_update +#endif + + public :: stats_end_timestep_clubb, stats_init_clubb +#ifndef CRM + public :: hbuf_stats_init_clubb +#endif + + ! Output arrays for CLUBB statistics + real, allocatable, dimension(:,:,:,:) :: out_zt, out_zm, out_rad_zt, out_rad_zm, & + out_sfc, out_LH_zt, out_LH_sfc + + private + + contains +!--------------------------------------------------------------------------------------------------- + subroutine stats_clubb_update( upwp, vpwp, up2, vp2, wprtp, wpthlp, & + wp2, wp3, rtp2, thlp2, rtpthlp, cloud_frac, rcm, um, vm, t_tndcy, & + qc_tndcy, qv_tndcy,u_tndcy,v_tndcy ) + +! Description: +! Update statistics for CLUBB variables +! +! References: +! None +!--------------------------------------------------------------------------------------------------- + use crmx_grid, only: nx, ny, nzm, nz, dimx1_s, dimx2_s, dimy1_s, dimy2_s + +#ifndef CRM + use hbuffer, only: hbuf_put, hbuf_avg_put +#endif + + ! Modules from CLUBB + use crmx_clubb_precision, only: core_rknd ! Constant + + use crmx_interpolation, only: lin_int ! Procedure(s) + + use crmx_grid_class, only: gr + + use crmx_clubbvars, only: tndcy_precision, l_stats_samgrid + + implicit none + + real(kind=core_rknd), dimension(nx, ny, nz), intent(in) :: & + upwp, &! u'w' [m^2/s^2] + vpwp, &! u'w' [m^2/s^2] + up2, &! u'^2 [m^2/s^2] + vp2, &! v'^2 [m^2/s^2] + wprtp, &! w' r_t' [(m kg)/(s kg)] + wpthlp, &! w' th_l' [(m K)/s] + wp2, &! w'^2 [m^2/s^2] + rtp2, &! r_t'^2 [(kg/kg)^2] + thlp2, &! th_l'^2 [K^2] + rtpthlp, &! r_t' th_l' [(kg K)/kg] + cloud_frac, &! Cloud Fraction [-] + rcm ! Cloud water [kg/kg] + + ! w'^3 is requires additional ghost points on the x and y dimension + real(kind=core_rknd), dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz), intent(in) :: & + wp3,& ! w'^3 [m^3/s^3] + um, & ! x-wind [m/s] + vm ! y-wind [m/s] + + real(tndcy_precision), dimension(nx, ny, nzm), intent(in) :: & + t_tndcy, & ! CLUBB contribution to moist static energy [K/s] + qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] + qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] + u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] + v_tndcy ! CLUBB contribution to y-wind [m/s^2] + + ! Local variables + real, dimension(nzm) :: & + upwp_avg, & + vpwp_avg, & + up2_avg, & + vp2_avg, & + wprtp_avg, & + wpthlp_avg, & + wp2_avg, & + thlp2_avg, & + rtp2_avg, & + rtpthlp_avg,& + sigma_sqd_w_avg, & + Kh_zt_avg, & + tau_zm_avg + + real :: factor_xy + + integer :: i, j, k + + !--------------------------------------------------------- + ! CLUBB variables + ! Notes: The variables located on the vertical velocity levels + ! must be interpolated for the stats grid, which is on the pressure levels. + ! -dschanen 21 Jul 2008 + factor_xy = 1. / real( nx*ny ) + + upwp_avg = 0.0 + vpwp_avg = 0.0 + vp2_avg = 0.0 + up2_avg = 0.0 + wprtp_avg = 0.0 + wpthlp_avg = 0.0 + wp2_avg = 0.0 + + thlp2_avg = 0.0 + rtp2_avg = 0.0 + rtpthlp_avg = 0.0 + + ! Here we omit the ghost point, since the SAM stats don't have one + do i = 1, nx + do j = 1, ny + do k = 1, nzm + upwp_avg(k) = upwp_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), upwp(i,j,k+1), upwp(i,j,k) ) + vpwp_avg(k) = vpwp_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), vpwp(i,j,k+1), vpwp(i,j,k) ) + vp2_avg(k) = vp2_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), vp2(i,j,k+1), vp2(i,j,k) ) + up2_avg(k) = up2_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), up2(i,j,k+1), up2(i,j,k) ) + wprtp_avg(k) = wprtp_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wprtp(i,j,k+1), wprtp(i,j,k) ) + wpthlp_avg(k) = wpthlp_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wpthlp(i,j,k+1), wpthlp(i,j,k) ) + wp2_avg(k) = wp2_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wp2(i,j,k+1), wp2(i,j,k) ) + rtp2_avg(k) = rtp2_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), rtp2(i,j,k+1), rtp2(i,j,k) ) + thlp2_avg(k) = thlp2_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), thlp2(i,j,k+1), thlp2(i,j,k) ) + rtpthlp_avg(k) = rtpthlp_avg(k) & + + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), rtpthlp(i,j,k+1), rtpthlp(i,j,k) ) + end do ! k = 1..nzm + end do ! j = 1..ny + end do ! i = 1..nx + +#ifndef CRM + ! Velocity grid variables + call hbuf_put('UPWP', upwp_avg, factor_xy) + call hbuf_put('VPWP', vpwp_avg, factor_xy) + call hbuf_put('VP2', vp2_avg, factor_xy) + call hbuf_put('UP2', up2_avg, factor_xy) + call hbuf_put('WPRTP', wprtp_avg, factor_xy) + call hbuf_put('WPTHLP', wpthlp_avg, factor_xy) + call hbuf_put('WP2', wp2_avg, factor_xy) + call hbuf_put('RTP2', rtp2_avg, factor_xy) + call hbuf_put('THLP2', thlp2_avg, factor_xy) + call hbuf_put('RTPTHLP', rtpthlp_avg, factor_xy) + + ! CLUBB thermodynamic grid varibles (SAM pressure levels + ghost point) + call hbuf_avg_put('CLD_FRAC', real( cloud_frac(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('RCM', real( rcm(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('UM', real( um(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('VM', real( vm(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('WP3', real( wp3(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) + + ! CLUBB tendency of state variables + call hbuf_avg_put('T_TNDCY', real(t_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('QC_TNDCY', real(qc_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('QV_TNDCY', real(qv_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('U_TNDCY', real(U_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) + call hbuf_avg_put('V_TNDCY', real(V_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) + + if(l_stats_samgrid) then !output clubb statistics in SAM + call hbuf_clubb_output () + end if +#endif + + return + end subroutine stats_clubb_update + +#ifdef CLUBB_LH +!--------------------------------------------------------------------------------------------------- + subroutine stats_clubb_silhs_update( ) + +! Description: +! Update statistics for CLUBB SILHS variables +! +! References: +! None +!--------------------------------------------------------------------------------------------------- + use crmx_grid, only: nx, ny, nzm, nz + + use hbuffer, only: hbuf_put, hbuf_avg_put + + use crmx_microphysics, only: & + nmicro_fields, mkname, index_water_vapor + + ! Modules from CLUBB + use crmx_clubb_precision, only: core_rknd ! Constant + + use crmx_interpolation, only: lin_int ! Procedure(s) + + use crmx_grid_class, only: gr + + use crmx_clubb_silhs_vars, only: & + LH_rt, LH_t, X_nl_all_levs, LH_sample_point_weights, LH_t_avg_tndcy, & + LH_micro_field_avg_tndcy + + use latin_hypercube_arrays, only: & + d_variables + + use crmx_parameters_microphys, only: & + LH_microphys_calls + + use crmx_corr_matrix_module, only: & + iiLH_s_mellor, iiLH_w, & + iiLH_rrain, iiLH_rsnow, iiLH_rice, & + iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Nc + + use crmx_array_index, only: & + iirrainm, iiNrm, iirsnowm, iiricem, & ! Variables + iiNcm, iiNsnowm, iiNim + + implicit none + + ! Local Variables + real, dimension(nx,ny,nzm) :: & + LH_rt_weighted, & + LH_t_weighted + + real, dimension(nx,ny,nzm,d_variables) :: & + X_nl_all_levs_weighted + + character(len=8) :: stat_name + integer :: indx, ivar, k + + ! ---- Begin Code ---- + + ! Determine cloud weighted sample averages + LH_rt_weighted = 0. + LH_t_weighted = 0. + X_nl_all_levs_weighted = 0. + + do indx = 1, LH_microphys_calls + do k = 1, nzm + LH_rt_weighted(:,:,k) = LH_rt_weighted(:,:,k) & + + LH_rt(:,:,k,indx) * LH_sample_point_weights(:,:,indx) + LH_t_weighted(:,:,k) = LH_t_weighted(:,:,k) & + + LH_t(:,:,k,indx) * LH_sample_point_weights(:,:,indx) + + do ivar = 1, d_variables + X_nl_all_levs_weighted(:,:,k,ivar) = X_nl_all_levs_weighted(:,:,k,ivar) & + + X_nl_all_levs(:,:,k,indx,ivar) * LH_sample_point_weights(:,:,indx) + end do + + end do ! k = 1..nzm + end do ! indx = 1..LH_microphys_calls + + LH_rt_weighted = LH_rt_weighted / real( LH_microphys_calls ) + LH_t_weighted = LH_t_weighted / real( LH_microphys_calls ) + X_nl_all_levs_weighted = X_nl_all_levs_weighted / real( LH_microphys_calls ) + + call hbuf_avg_put( 'LH_RT', LH_rt_weighted, 1,nx, 1,ny, nzm, 1. ) + call hbuf_avg_put( 'LH_TL', LH_t_weighted, 1,nx, 1,ny, nzm, 1. ) + + do ivar = 1, d_variables + if ( ivar == iiLH_s_mellor ) then + stat_name = "LH_S_MEL" + else if ( ivar == iiLH_w ) then + stat_name = "LH_W" + else if ( ivar == iiLH_rrain ) then + stat_name = "LH_RRAIN" + else if ( ivar == iiLH_rsnow ) then + stat_name = "LH_RSNOW" + else if ( ivar == iiLH_rice ) then + stat_name = "LH_RICE" + else if ( ivar == iiLH_Nr ) then + stat_name = "LH_NR" + else if ( ivar == iiLH_Nsnow ) then + stat_name = "LH_NSNOW" + else if ( ivar == iiLH_Ni ) then + stat_name = "LH_NI" + else if ( ivar == iiLH_Nc ) then + stat_name = "LH_NC" + end if ! ivar + + call hbuf_avg_put( stat_name, X_nl_all_levs_weighted(:,:,:,ivar), 1,nx, 1,ny, nzm, 1. ) + end do + + ! Tendency averages + + call hbuf_avg_put( 'LH_TL_MC', real( LH_t_avg_tndcy ), & + 1,nx, 1,ny, nzm, 1. ) + + do ivar = 1, nmicro_fields + if ( ivar == index_water_vapor ) then + stat_name = 'LH_RT_MC' + else if ( ivar == iirrainm ) then + stat_name = 'LH_RR_MC' + else if ( ivar == iirsnowm ) then + stat_name = 'LH_RS_MC' + else if ( ivar == iiricem ) then + stat_name = 'LH_RI_MC' + else if ( ivar == iiNim ) then + stat_name = 'LH_NI_MC' + else if ( ivar == iiNrm ) then + stat_name = 'LH_NR_MC' + else if ( ivar == iiNsnowm ) then + stat_name = 'LH_NS_MC' + else + stat_name = '' + end if + if ( stat_name /= '' ) then + call hbuf_avg_put( stat_name, & + real( LH_micro_field_avg_tndcy(:,:,:,ivar) ), & + 1,nx, 1,ny, nzm, 1. ) + end if + end do + + return + end subroutine stats_clubb_silhs_update +#endif /* CLUBB_LH */ + +subroutine stats_init_clubb( l_stats_in, l_output_rad_files_in, stats_tsamp_in, stats_tout_in, & + nzmax, nnrad_zt,nnrad_zm, time_current, delt ) + ! + ! Description: Initializes the statistics saving functionality of + ! the CLUBB model. This is for purpose of SAM-CLUBB interface. Here + ! the traditional stats_init of CLUBB is not called, as it is not compatible + ! with SAM output. This is adopted from clubb_intr.F90 in CAM5.2. + + !----------------------------------------------------------------------- + + + use crmx_stats_variables, only: & + zt, & ! Variables + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & + ztscr21 + + use crmx_stats_variables, only: & + LH_zt, & ! Variable(s) + LH_sfc + + use crmx_stats_variables, only: & + zm, & ! Variables + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & + zmscr15, & + zmscr16, & + zmscr17, & + rad_zt + + use crmx_stats_variables, only: & + rad_zm, & + sfc, & + l_stats, & + l_output_rad_files, & + stats_tsamp, & + stats_tout, & + l_stats_samp, & + l_stats_last, & + fname_rad_zt, & + fname_rad_zm, & + fname_sfc, & + l_netcdf, & + l_grads + + use crmx_clubb_precision, only: & + time_precision, & ! Constant(s) + core_rknd + + use crmx_stats_zm, only: & + nvarmax_zm, & ! Constant(s) + stats_init_zm ! Procedure(s) + + use crmx_stats_zt, only: & + nvarmax_zt, & ! Constant(s) + stats_init_zt ! Procedure(s) + + use crmx_stats_LH_zt, only: & + nvarmax_LH_zt, & ! Constant(s) + stats_init_LH_zt ! Procedure(s) + + use crmx_stats_LH_sfc, only: & + nvarmax_LH_sfc, & ! Constant(s) + stats_init_LH_sfc ! Procedure(s) + + use crmx_stats_rad_zt, only: & + nvarmax_rad_zt, & ! Constant(s) + stats_init_rad_zt ! Procedure(s) + + use crmx_stats_rad_zm, only: & + nvarmax_rad_zm, & ! Constant(s) + stats_init_rad_zm ! Procedure(s) + + use crmx_stats_sfc, only: & + nvarmax_sfc, & ! Constant(s) + stats_init_sfc ! Procedure(s) + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Function + + use crmx_constants_clubb, only: & + fstdout, fstderr, var_length ! Constants + + use crmx_parameters_microphys, only: & + LH_microphys_disabled, & ! Constant + LH_microphys_type ! Variable + + implicit none + + ! Input Variables + + logical, intent(in) :: l_stats_in ! Stats on? T/F + + logical, intent(in) :: l_output_rad_files_in ! Rad Stats on? T/F + + real(kind=time_precision), intent(in) :: & + stats_tsamp_in, & ! Sampling interval [s] + stats_tout_in ! Output interval [s] + + integer, intent(in) :: nzmax ! Grid points in the vertical [count] + integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] + integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] + + real(kind=time_precision), intent(in) :: & + time_current ! Model time [s] + + real(kind=time_precision), intent(in) :: & + delt ! Timestep (dt_main in CLUBB) [s] + + + ! Local Variables + + ! Namelist Variables + + character(len=var_length), dimension(nvarmax_zt) :: & + clubb_vars_zt ! Variables on the thermodynamic levels + + character(len=var_length), dimension(nvarmax_LH_zt) :: & + clubb_vars_LH_zt ! Latin Hypercube variables on the thermodynamic levels + + character(len=var_length), dimension(nvarmax_LH_sfc) :: & + clubb_vars_LH_sfc ! Latin Hypercube variables at the surface + + character(len=var_length), dimension(nvarmax_zm) :: & + clubb_vars_zm ! Variables on the momentum levels + + character(len=var_length), dimension(nvarmax_rad_zt) :: & + clubb_vars_rad_zt ! Variables on the radiation levels + + character(len=var_length), dimension(nvarmax_rad_zm) :: & + clubb_vars_rad_zm ! Variables on the radiation levels + + character(len=var_length), dimension(nvarmax_sfc) :: & + clubb_vars_sfc ! Variables at the model surface + + namelist /clubb_stats_nl/ & + clubb_vars_zt, & + clubb_vars_zm, & + clubb_vars_LH_zt, & + clubb_vars_LH_sfc, & + clubb_vars_rad_zt, & + clubb_vars_rad_zm, & + clubb_vars_sfc + + ! Local Variables + + logical :: l_error + + character(len=200) :: fname, temp1, sub + + integer :: i, ntot, read_status + integer :: iunit + + ! Initialize + l_error = .false. + + ! Set stats_variables variables with inputs from calling subroutine + l_stats = l_stats_in + + l_output_rad_files = l_output_rad_files_in + + stats_tsamp = stats_tsamp_in + stats_tout = stats_tout_in + + if ( .not. l_stats ) then + l_stats_samp = .false. + l_stats_last = .false. + return + end if + + ! Initialize namelist variables + + clubb_vars_zt = '' + clubb_vars_zm = '' + clubb_vars_LH_zt = '' + clubb_vars_LH_sfc = '' + clubb_vars_rad_zt = '' + clubb_vars_rad_zm = '' + clubb_vars_sfc = '' + + ! Read variables to compute from the namelist + ! in SAM, namelist is read on every MPI task, so no need for mpibcast +! if (masterproc) then + iunit= 55 + open(unit=iunit,file="clubb_stats_sam") + read(unit=iunit, nml=clubb_stats_nl, iostat=read_status) + if (read_status /= 0) then + stop 'stats_init_clubb: error reading namelist' + end if + close(unit=iunit) +! end if + +!#ifdef SPMD + ! Broadcast namelist variables +! call mpibcast(clubb_vars_zt, var_length*nvarmax_zt, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_zm, var_length*nvarmax_zm, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_LH_zt, var_length*nvarmax_LH_zt, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_LH_sfc, var_length*nvarmax_LH_sfc, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_rad_zt, var_length*nvarmax_rad_zt, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_rad_zm, var_length*nvarmax_rad_zm, mpichar, 0, mpicom) +! call mpibcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpichar, 0, mpicom) +!#endif + + ! Hardcode these for use in SAM-CLUBB, don't want either + l_netcdf = .false. + l_grads = .false. + + ! Check sampling and output frequencies + + ! The model time step length, delt (which is dtmain), should multiply + ! evenly into the statistical sampling time step length, stats_tsamp. + if ( abs( stats_tsamp/delt - real(floor(stats_tsamp/delt), kind=time_precision ) ) & + > 1.e-8_time_precision ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & + 'delt (which is dtmain). Check the appropriate ', & + 'model.in file.' + write(fstderr,*) 'stats_tsamp = ', stats_tsamp + write(fstderr,*) 'delt = ', delt + endif + + ! Initialize zt (mass points) + + i = 1 + do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_zt(i)) /= 0 & + .and. i <= nvarmax_zt ) + i = i + 1 + write(2001, *) 'i=', i-1, ' clubb_vars_zt ', trim(clubb_vars_zt(i)) + enddo + ntot = i - 1 + if ( ntot == nvarmax_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zt than allowed for by nvarmax_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & + "in the stats namelist, or change nvarmax_zt." + write(fstderr,*) "nvarmax_zt = ", nvarmax_zt + stop "stats_init_clubb: number of zt statistical variables exceeds limit" + endif + + zt%nn = ntot + zt%kk = nzmax + + allocate( zt%z( zt%kk ) ) + + allocate( zt%x( 1, 1, zt%kk, zt%nn ) ) + allocate( zt%n( 1, 1, zt%kk, zt%nn ) ) + allocate( zt%l_in_update( 1, 1, zt%kk, zt%nn ) ) + call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) + + allocate( zt%f%var( zt%nn ) ) + allocate( zt%f%z( zt%kk ) ) + + ! Allocate scratch space + + allocate( ztscr01(zt%kk) ) + allocate( ztscr02(zt%kk) ) + allocate( ztscr03(zt%kk) ) + allocate( ztscr04(zt%kk) ) + allocate( ztscr05(zt%kk) ) + allocate( ztscr06(zt%kk) ) + allocate( ztscr07(zt%kk) ) + allocate( ztscr08(zt%kk) ) + allocate( ztscr09(zt%kk) ) + allocate( ztscr10(zt%kk) ) + allocate( ztscr11(zt%kk) ) + allocate( ztscr12(zt%kk) ) + allocate( ztscr13(zt%kk) ) + allocate( ztscr14(zt%kk) ) + allocate( ztscr15(zt%kk) ) + allocate( ztscr16(zt%kk) ) + allocate( ztscr17(zt%kk) ) + allocate( ztscr18(zt%kk) ) + allocate( ztscr19(zt%kk) ) + allocate( ztscr20(zt%kk) ) + allocate( ztscr21(zt%kk) ) + + ztscr01 = 0.0_core_rknd + ztscr02 = 0.0_core_rknd + ztscr03 = 0.0_core_rknd + ztscr04 = 0.0_core_rknd + ztscr05 = 0.0_core_rknd + ztscr06 = 0.0_core_rknd + ztscr07 = 0.0_core_rknd + ztscr08 = 0.0_core_rknd + ztscr09 = 0.0_core_rknd + ztscr10 = 0.0_core_rknd + ztscr11 = 0.0_core_rknd + ztscr12 = 0.0_core_rknd + ztscr13 = 0.0_core_rknd + ztscr14 = 0.0_core_rknd + ztscr15 = 0.0_core_rknd + ztscr16 = 0.0_core_rknd + ztscr17 = 0.0_core_rknd + ztscr18 = 0.0_core_rknd + ztscr19 = 0.0_core_rknd + ztscr20 = 0.0_core_rknd + ztscr21 = 0.0_core_rknd + + ! Default initialization for array indices for zt + + call stats_init_zt( clubb_vars_zt, l_error ) + + ! Setup output file for LH_zt (Latin Hypercube stats) + + if ( LH_microphys_type /= LH_microphys_disabled ) then + + i = 1 + do while ( ichar(clubb_vars_LH_zt(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_LH_zt(i)) /= 0 & + .and. i <= nvarmax_LH_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_LH_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zt than allowed for by nvarmax_LH_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_LH_zt ", & + "in the stats namelist, or change nvarmax_LH_zt." + write(fstderr,*) "nvarmax_LH_zt = ", nvarmax_LH_zt + stop "stats_init: number of LH_zt statistical variables exceeds limit" + end if + + LH_zt%nn = ntot + LH_zt%kk = nzmax + + allocate( LH_zt%z( LH_zt%kk ) ) +! LH_zt%z = gzt + + allocate( LH_zt%x( 1, 1, LH_zt%kk, LH_zt%nn ) ) + allocate( LH_zt%n( 1, 1, LH_zt%kk, LH_zt%nn ) ) + allocate( LH_zt%l_in_update( 1, 1, LH_zt%kk, LH_zt%nn ) ) + call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) + + allocate( LH_zt%f%var( LH_zt%nn ) ) + allocate( LH_zt%f%z( LH_zt%kk ) ) + + call stats_init_LH_zt( clubb_vars_LH_zt, l_error ) + + i = 1 + do while ( ichar(clubb_vars_LH_sfc(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_LH_sfc(i)) /= 0 & + .and. i <= nvarmax_LH_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_LH_sfc ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "vars_zt than allowed for by nvarmax_LH_sfc." + write(fstderr,*) "Check the number of variables listed for clubb_vars_LH_sfc ", & + "in the stats namelist, or change nvarmax_LH_sfc." + write(fstderr,*) "nvarmax_LH_sfc = ", nvarmax_LH_sfc + stop "stats_init: number of LH_sfc statistical variables exceeds limit" + end if + + LH_sfc%nn = ntot + LH_sfc%kk = 1 + + allocate( LH_sfc%z( LH_sfc%kk ) ) + + allocate( LH_sfc%x( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + allocate( LH_sfc%n( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + allocate( LH_sfc%l_in_update( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) + + call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) + + allocate( LH_sfc%f%var( LH_sfc%nn ) ) + allocate( LH_sfc%f%z( LH_sfc%kk ) ) + + call stats_init_LH_sfc( clubb_vars_LH_sfc, l_error ) + + end if ! LH_microphys_type /= LH_microphys_disabled + + ! Initialize zm (momentum points) + + i = 1 + do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_zm(i)) /= 0 & + .and. i <= nvarmax_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zm than allowed for by nvarmax_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & + "in the stats namelist, or change nvarmax_zm." + write(fstderr,*) "nvarmax_zm = ", nvarmax_zm + stop "stats_init_clubb: number of zm statistical variables exceeds limit" + endif + + zm%nn = ntot + zm%kk = nzmax + + allocate( zm%z( zm%kk ) ) + + allocate( zm%x( 1, 1, zm%kk, zm%nn ) ) + allocate( zm%n( 1, 1, zm%kk, zm%nn ) ) + allocate( zm%l_in_update( 1, 1, zm%kk, zm%nn ) ) + + call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) + + allocate( zm%f%var( zm%nn ) ) + allocate( zm%f%z( zm%kk ) ) + + ! Allocate scratch space + + allocate( zmscr01(zm%kk) ) + allocate( zmscr02(zm%kk) ) + allocate( zmscr03(zm%kk) ) + allocate( zmscr04(zm%kk) ) + allocate( zmscr05(zm%kk) ) + allocate( zmscr06(zm%kk) ) + allocate( zmscr07(zm%kk) ) + allocate( zmscr08(zm%kk) ) + allocate( zmscr09(zm%kk) ) + allocate( zmscr10(zm%kk) ) + allocate( zmscr11(zm%kk) ) + allocate( zmscr12(zm%kk) ) + allocate( zmscr13(zm%kk) ) + allocate( zmscr14(zm%kk) ) + allocate( zmscr15(zm%kk) ) + allocate( zmscr16(zm%kk) ) + allocate( zmscr17(zm%kk) ) + + ! Initialize to 0 + zmscr01 = 0.0_core_rknd + zmscr02 = 0.0_core_rknd + zmscr03 = 0.0_core_rknd + zmscr04 = 0.0_core_rknd + zmscr05 = 0.0_core_rknd + zmscr06 = 0.0_core_rknd + zmscr07 = 0.0_core_rknd + zmscr08 = 0.0_core_rknd + zmscr09 = 0.0_core_rknd + zmscr10 = 0.0_core_rknd + zmscr11 = 0.0_core_rknd + zmscr12 = 0.0_core_rknd + zmscr13 = 0.0_core_rknd + zmscr14 = 0.0_core_rknd + zmscr15 = 0.0_core_rknd + zmscr16 = 0.0_core_rknd + zmscr17 = 0.0_core_rknd + + call stats_init_zm( clubb_vars_zm, l_error ) + + ! Initialize rad_zt (radiation points) + + if (l_output_rad_files) then + + i = 1 + do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_rad_zt(i)) /= 0 & + .and. i <= nvarmax_rad_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & + "in the stats namelist, or change nvarmax_rad_zt." + write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt + stop "stats_init_clubb: number of rad_zt statistical variables exceeds limit" + endif + + rad_zt%nn = ntot + rad_zt%kk = nnrad_zt + + allocate( rad_zt%z( rad_zt%kk ) ) + + allocate( rad_zt%x( 1, 1, rad_zt%kk, rad_zt%nn ) ) + allocate( rad_zt%n( 1, 1, rad_zt%kk, rad_zt%nn ) ) + allocate( rad_zt%l_in_update( 1, 1, rad_zt%kk, rad_zt%nn ) ) + + call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) + + allocate( rad_zt%f%var( rad_zt%nn ) ) + allocate( rad_zt%f%z( rad_zt%kk ) ) + + + call stats_init_rad_zt( clubb_vars_rad_zt, l_error ) + + ! Initialize rad_zm (radiation points) + + i = 1 + do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_rad_zm(i)) /= 0 & + .and. i <= nvarmax_rad_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zm ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & + "in the stats namelist, or change nvarmax_rad_zm." + write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm + stop "stats_init_clubb: number of rad_zm statistical variables exceeds limit" + endif + + rad_zm%nn = ntot + rad_zm%kk = nnrad_zm + + allocate( rad_zm%z( rad_zm%kk ) ) + + allocate( rad_zm%x( 1, 1, rad_zm%kk, rad_zm%nn ) ) + allocate( rad_zm%n( 1, 1, rad_zm%kk, rad_zm%nn ) ) + allocate( rad_zm%l_in_update( 1, 1, rad_zm%kk, rad_zm%nn ) ) + + call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) + + allocate( rad_zm%f%var( rad_zm%nn ) ) + allocate( rad_zm%f%z( rad_zm%kk ) ) + + + call stats_init_rad_zm( clubb_vars_rad_zm, l_error ) + end if ! l_output_rad_files + + + ! Initialize sfc (surface point) + + i = 1 + do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 & + .and. len_trim(clubb_vars_sfc(i)) /= 0 & + .and. i <= nvarmax_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_sfc ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_sfc than allowed for by nvarmax_sfc." + write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & + "in the stats namelist, or change nvarmax_sfc." + write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc + stop "stats_init_clubb: number of sfc statistical variables exceeds limit" + endif + + sfc%nn = ntot + sfc%kk = 1 + + allocate( sfc%z( sfc%kk ) ) + + allocate( sfc%x( 1, 1, sfc%kk, sfc%nn ) ) + allocate( sfc%n( 1, 1, sfc%kk, sfc%nn ) ) + allocate( sfc%l_in_update( 1, 1, sfc%kk, sfc%nn ) ) + + call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) + + allocate( sfc%f%var( sfc%nn ) ) + allocate( sfc%f%z( sfc%kk ) ) + + call stats_init_sfc( clubb_vars_sfc, l_error ) + + ! Check for errors + + if ( l_error ) then + write(fstderr,*) 'stats_init: errors found' + stop + endif + + allocate(out_zt(nx, ny, nz, zt%nn)) + allocate(out_zm(nx, ny, nz, zm%nn)) + allocate(out_sfc(nx, ny, nz, sfc%nn)) + + if(l_output_rad_files) then + allocate(out_rad_zt(nx, ny, nz, rad_zt%nn)) + allocate(out_rad_zm(nx, ny, nz, rad_zm%nn)) + end if + + if(LH_microphys_type /= LH_microphys_disabled ) then + allocate(out_LH_zt(nx, ny, nz, LH_zt%nn)) + allocate(out_LH_sfc(nx, ny, nz, LH_sfc%nn)) + end if + + return + + end subroutine stats_init_clubb +!================================================================================== ! +! ! +!================================================================================== ! +#ifndef CRM + subroutine hbuf_stats_init_clubb(namelist,deflist,unitlist,status,average_type,count,clubbcount) + + use crmx_stats_variables, only: & + zt, LH_zt, zm, rad_zm, rad_zt, sfc, LH_sfc, l_output_rad_files + use crmx_parameters_microphys, only: & + LH_microphys_disabled, & ! Constant + LH_microphys_type ! Variable + + implicit none + + character(*) namelist(*), deflist(*), unitlist(*) + integer status(*),average_type(*),count, clubbcount, n, ii, jj, ncond + + character*8 name + character*80 longname + character*10 units + +! Local variables + integer :: i + character*100 temp1, sub + + clubbcount = 0 + +! Now call add fields + do i = 1, zt%nn + + temp1 = trim(zt%f%var(i)%name) + sub = temp1 +! if (len(temp1) > 16) sub = temp1(1:16) + +! call addfld(trim(sub),trim(zt%f%var(i)%units),nnzp,& +! 'A',trim(zt%f%var(i)%description),phys_decomp) + call add_to_namelist(count, clubbcount, trim(sub), trim(zt%f%var(i)%description), & + trim(zt%f%var(i)%units), 0) + enddo + + do i = 1, zm%nn + + temp1 = trim(zm%f%var(i)%name) + sub = temp1 +! if (len(temp1) > 16) sub = temp1(1:16) + +! call addfld(trim(sub),trim(zm%f%var(i)%units),nnzp,& +! 'A',trim(zm%f%var(i)%description),phys_decomp) + call add_to_namelist(count, clubbcount, trim(sub), trim(zm%f%var(i)%description), & + trim(zm%f%var(i)%units), 0) + enddo + + if (l_output_rad_files) then + do i = 1, rad_zt%nn +! call addfld(trim(rad_zt%f%var(i)%name),trim(rad_zt%f%var(i)%units),nnzp,& +! 'A',trim(rad_zt%f%var(i)%description),phys_decomp) + call add_to_namelist(count, clubbcount, trim(rad_zt%f%var(i)%name), & + trim(rad_zt%f%var(i)%description), trim(rad_zt%f%var(i)%units), 0) + enddo + + do i = 1, rad_zm%nn +! call addfld(trim(rad_zm%f%var(i)%name),trim(rad_zm%f%var(i)%units),nnzp,& +! 'A',trim(rad_zm%f%var(i)%description),phys_decomp) + call add_to_namelist(count, clubbcount, trim(rad_zm%f%var(i)%name), & + trim(rad_zm%f%var(i)%description), trim(rad_zm%f%var(i)%units), 0) + enddo + endif + + if ( LH_microphys_type /= LH_microphys_disabled ) then + do i=1, LH_zt%nn + call add_to_namelist(count, clubbcount, trim(LH_zt%f%var(i)%name), & + trim(LH_zt%f%var(i)%description), trim(LH_zt%f%var(i)%units), 0) + end do + do i=1, LH_sfc%nn + call add_to_namelist(count, clubbcount, trim(LH_sfc%f%var(i)%name), & + trim(LH_sfc%f%var(i)%description), trim(LH_sfc%f%var(i)%units), 0) + end do + endif + + do i = 1, sfc%nn + call add_to_namelist(count, clubbcount, trim(sfc%f%var(i)%name), & + trim(sfc%f%var(i)%description), trim(sfc%f%var(i)%units), 0) + enddo + + return + + end subroutine hbuf_stats_init_clubb + !================================================================================ + + subroutine hbuf_clubb_output() + + use crmx_stats_variables, only: & + zt, LH_zt, zm, rad_zm, rad_zt, sfc, LH_sfc, l_output_rad_files + use crmx_parameters_microphys, only: & + LH_microphys_disabled, & ! Constant + LH_microphys_type ! Variable + use hbuffer, only: hbuf_avg_put + + implicit none + + ! locale variables + integer :: i + character*100 temp1, sub + + do i = 1, zt%nn + call hbuf_avg_put(trim(zt%f%var(i)%name), out_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) + enddo + + do i = 1, zm%nn + !Velocity level. Here we just simplely put the last nz-1 onto the pressure level. + call hbuf_avg_put(trim(zm%f%var(i)%name), out_zm(1:nx, 1:ny, 1:(nz-1), i), & + 1, nx, 1, ny, nzm, 1.) + enddo + + if (l_output_rad_files) then + do i = 1, rad_zt%nn + call hbuf_avg_put(trim(rad_zt%f%var(i)%name), & + out_rad_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) + enddo + + do i = 1, rad_zm%nn + call hbuf_avg_put(trim(rad_zm%f%var(i)%name), & + out_rad_zm(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) + enddo + endif + + if ( LH_microphys_type /= LH_microphys_disabled ) then + do i=1, LH_zt%nn + call hbuf_avg_put(trim(LH_zt%f%var(i)%name), & + out_LH_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) + end do + + do i=1, LH_sfc%nn + ! For simplicity, hbuf_avg_put is also called for surface varialbes. + ! so zeroout values from level 2 to nz + out_LH_sfc(:, :, 2:nz, i) = 0.0 + call hbuf_avg_put(trim(LH_sfc%f%var(i)%name), & + out_LH_sfc(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) + end do + end if + + do i = 1, sfc%nn + ! For simplicity, hbuf_avg_put is also called for surface varialbes. + ! so zeroout values from level 2 to nz + out_sfc(:, :, 2:nz, i) = 0.0 + call hbuf_avg_put(trim(sfc%f%var(i)%name), & + out_sfc(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) + enddo + + return + + end subroutine hbuf_clubb_output +#endif /*CRM*/ + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + !----------------------------------------------------------------------- + subroutine stats_end_timestep_clubb(ix, jy) + + ! Description: Called when the stats timestep has ended. This subroutine + ! is responsible for calling statistics to be written to the output + ! format. + !----------------------------------------------------------------------- + + use crmx_constants_clubb, only: & + fstderr ! Constant(s) + + use crmx_stats_variables, only: & + zt, & ! Variable(s) + LH_zt, & + LH_sfc, & + zm, & + rad_zt, & + rad_zm, & + sfc, & + l_stats_last, & + stats_tsamp, & + stats_tout, & + l_output_rad_files + + use crmx_error_code, only: & + clubb_at_least_debug_level ! Procedure(s) + + use crmx_parameters_microphys, only: & + LH_microphys_disabled ! Constant + + use crmx_parameters_microphys, only: & + LH_microphys_type, & ! Variable(s) + LH_microphys_calls + + + implicit none + + + integer, intent(in) :: ix + integer, intent(in) :: jy + + ! Local Variables + + integer :: i, k + logical :: l_error + + ! ---- Begin Code ---- + + ! Check if it is time to write to file + + if ( .not. l_stats_last ) return + + ! Initialize + l_error = .false. + + ! Look for errors by checking the number of sampling points + ! for each variable in the zt statistics at each vertical level. + do i = 1, zt%nn + do k = 1, zt%kk + + if ( zt%n(1,1,k,i) /= 0 .and. & + zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(zt%f%var(i)%name), ' in zt ', & + 'at k = ', k, & + '; zt%n(',k,',',i,') = ', zt%n(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Look for errors by checking the number of sampling points + ! for each variable in the zm statistics at each vertical level. + do i = 1, zm%nn + do k = 1, zm%kk + + if ( zm%n(1,1,k,i) /= 0 .and. & + zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(zm%f%var(i)%name), ' in zm ', & + 'at k = ', k, & + '; zm%n(',k,',',i,') = ', zm%n(1,1,k,i) + endif + + endif + + enddo + enddo + + if ( LH_microphys_type /= LH_microphys_disabled ) then + ! Look for errors by checking the number of sampling points + ! for each variable in the LH_zt statistics at each vertical level. + do i = 1, LH_zt%nn + do k = 1, LH_zt%kk + + if ( LH_zt%n(1,1,k,i) /= 0 .and. & + LH_zt%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & + LH_zt%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(LH_zt%f%var(i)%name), ' in LH_zt ', & + 'at k = ', k, & + '; LH_zt%n(',k,',',i,') = ', LH_zt%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp + + end do ! k = 1 .. LH_zt%kk + end do ! i = 1 .. LH_zt%nn + + ! Look for errors by checking the number of sampling points + ! for each variable in the LH_zt statistics at each vertical level. + do i = 1, LH_sfc%nn + do k = 1, LH_sfc%kk + + if ( LH_sfc%n(1,1,k,i) /= 0 .and. & + LH_sfc%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & + LH_sfc%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(LH_sfc%f%var(i)%name), ' in LH_sfc ', & + 'at k = ', k, & + '; LH_sfc%n(',k,',',i,') = ', LH_sfc%n(1,1,k,i) + end if ! clubb_at_lest_debug_level 1 + + end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp + + end do ! k = 1 .. LH_sfc%kk + end do ! i = 1 .. LH_sfc%nn + end if ! LH_microphys_type /= LH_microphys_disabled + + + if (l_output_rad_files) then + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zt statistics at each vertical level. + do i = 1, rad_zt%nn + do k = 1, rad_zt%kk + + if ( rad_zt%n(1,1,k,i) /= 0 .and. & + rad_zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(rad_zt%f%var(i)%name), ' in rad_zt ', & + 'at k = ', k, & + '; rad_zt%n(',k,',',i,') = ', rad_zt%n(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Look for errors by checking the number of sampling points + ! for each variable in the rad_zm statistics at each vertical level. + do i = 1, rad_zm%nn + do k = 1, rad_zm%kk + + if ( rad_zm%n(1,1,k,i) /= 0 .and. & + rad_zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(rad_zm%f%var(i)%name), ' in rad_zm ', & + 'at k = ', k, & + '; rad_zm%n(',k,',',i,') = ', rad_zm%n(1,1,k,i) + endif + + endif + + enddo + enddo + end if ! l_output_rad_files + + ! Look for errors by checking the number of sampling points + ! for each variable in the sfc statistics at each vertical level. + do i = 1, sfc%nn + do k = 1, sfc%kk + + if ( sfc%n(1,1,k,i) /= 0 .and. & + sfc%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then + + l_error = .true. ! This will stop the run + + if ( clubb_at_least_debug_level( 1 ) ) then + write(fstderr,*) 'Possible sampling error for variable ', & + trim(sfc%f%var(i)%name), ' in sfc ', & + 'at k = ', k, & + '; sfc%n(',k,',',i,') = ', sfc%n(1,1,k,i) + endif + + endif + + enddo + enddo + + ! Stop the run if errors are found. + if ( l_error ) then + write(fstderr,*) 'Possible statistical sampling error' + write(fstderr,*) 'For details, set debug_level to a value of at ', & + 'least 1 in the appropriate model.in file.' + stop 'stats_end_timestep: error(s) found' + endif + + ! Compute averages + call stats_avg( zt%kk, zt%nn, zt%x, zt%n ) + call stats_avg( zm%kk, zm%nn, zm%x, zm%n ) + if ( LH_microphys_type /= LH_microphys_disabled ) then + call stats_avg( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n ) + call stats_avg( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n ) + end if + if ( l_output_rad_files ) then + call stats_avg( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n ) + call stats_avg( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n ) + end if + call stats_avg( sfc%kk, sfc%nn, sfc%x, sfc%n ) + + ! Here we are not outputting the data, rather reading the stats into + ! arrays which are conformable to CAM output. Also, the data is "flipped" + ! in the vertical level to be the same as CAM output. + do i = 1, zt%nn + do k = 1, zt%kk + out_zt(ix,jy,k,i) = zt%x(1,1,k,i) + if(out_zt(ix,jy,k,i) /= out_zt(ix,jy,k,i)) out_zt(ix,jy,k,i) = 0.0 + enddo + enddo + + do i = 1, zm%nn + do k = 1, zt%kk + out_zm(ix,jy,k,i) = zm%x(1,1,k,i) + if(out_zm(ix,jy,k,i) /= out_zm(ix,jy,k,i)) out_zm(ix,jy,k,i) = 0.0 + enddo + enddo + + if (l_output_rad_files) then + do i = 1, rad_zt%nn + do k = 1, rad_zt%kk + out_rad_zt(ix,jy,k,i) = rad_zt%x(1,1,k,i) + if(out_rad_zt(ix,jy,k,i) /= out_rad_zt(ix,jy,k,i)) out_rad_zt(ix,jy,k,i) = 0.0 + enddo + enddo + + do i = 1, rad_zm%nn + do k = 1, rad_zm%kk + out_rad_zm(ix,jy,k,i) = rad_zm%x(1,1,k,i) + if(out_rad_zm(ix,jy,k,i) /= out_rad_zm(ix,jy,k,i)) out_rad_zm(ix,jy,k,i) = 0.0 + enddo + enddo + endif + + if ( LH_microphys_type /= LH_microphys_disabled ) then + do i=1, LH_zt%nn + do k=1, LH_zt%kk + out_LH_zt(ix,jy,k,i) = LH_zt%x(1,1,k,i) + if(out_LH_zt(ix,jy,k,i) /= out_LH_zt(ix,jy,k,i)) out_LH_zt(ix,jy,k,i) = 0.0 + enddo + enddo + + out_LH_sfc(ix,jy,:,:) = 0.0 + do i=1, LH_sfc%nn + out_LH_sfc(ix,jy,1,i) = LH_sfc%x(1,1,1,i) + if(out_LH_sfc(ix,jy,1,i) /= out_LH_sfc(ix,jy,1,i)) out_LH_sfc(ix,jy,1,i) = 0.0 + end do + endif + + out_sfc(ix, jy, :, :) = 0.0 + do i = 1, sfc%nn + out_sfc(ix,jy,1,i) = sfc%x(1,1,1,i) + if(out_sfc(ix,jy,1,i) /= out_sfc(ix,jy,1,i)) out_sfc(ix,jy,1,i) = 0.0 + enddo + + ! Reset sample fields + call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) + call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) + if (l_output_rad_files) then + call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) + call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) + end if + if ( LH_microphys_type /= LH_microphys_disabled) then + call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) + call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) + end if + call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) + + return + + end subroutine stats_end_timestep_clubb + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + !----------------------------------------------------------------------- + subroutine stats_zero( kk, nn, x, n, l_in_update ) + + ! Description: + ! Initialize stats to zero + !----------------------------------------------------------------------- + + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + + implicit none + + ! Input + integer, intent(in) :: kk, nn + + ! Output + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n + logical, dimension(1,1,kk,nn), intent(out) :: l_in_update + + ! Zero out arrays + + if ( nn > 0 ) then + x(:,:,:,:) = 0.0_stat_rknd + n(:,:,:,:) = 0_stat_nknd + l_in_update(:,:,:,:) = .false. + end if + + return + + end subroutine stats_zero + + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + + !----------------------------------------------------------------------- + subroutine stats_avg( kk, nn, x, n ) + + ! Description: + ! Compute the average of stats fields + !----------------------------------------------------------------------- + use crmx_clubb_precision, only: & + stat_rknd, & ! Variable(s) + stat_nknd + + implicit none + + ! Input + integer, intent(in) :: nn, kk + integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: n + + ! Output + real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: x + + ! Internal + + integer k,m + + ! Compute averages + + do m=1,nn + do k=1,kk + + if ( n(1,1,k,m) > 0 ) then + x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m), kind=stat_rknd ) + end if + + end do + end do + + return + + end subroutine stats_avg +#endif /* CLUBB_CRM*/ +end module crmx_stat_clubb diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 new file mode 100644 index 0000000000..79dd936cdc --- /dev/null +++ b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 @@ -0,0 +1,147 @@ + +subroutine tke_full + +! this subroutine solves the TKE equation + +use crmx_vars +use crmx_sgs +use crmx_params +implicit none + +real def2(nx,ny,nzm) +real grd,betdz,Ck,Ce,Ces,Ce1,Ce2,smix,Pr,Cee,Cs +real buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss +real lstarn, lstarp, bbb, omn, omp +real qsatt,dqsat +integer i,j,k,kc,kb + +!call t_startf('tke_full') + +!Cs = 0.1944 +Cs = 0.15 +Ck=0.1 +Ce=Ck**3/Cs**4 +Ces=Ce/0.7*3.0 + +if(RUN3D) then + call shear_prod3D(def2) +else + call shear_prod2D(def2) +endif + +do k=1,nzm + kb=k-1 + kc=k+1 + + grd=dz*adz(k) + + betdz=bet(k)/dz/(adzw(kc)+adzw(k)) + Ce1=Ce/0.7*0.19 + Ce2=Ce/0.7*0.51 + if(k.eq.1) then + kb=1 + kc=2 + betdz=bet(k)/dz/adzw(kc) + Ce1=Ces/0.7*0.19 + Ce2=Ces/0.7*0.51 + end if + if(k.eq.nzm) then + kb=nzm-1 + kc=nzm + betdz=bet(k)/dz/adzw(k) + Ce1=Ces/0.7*0.19 + Ce2=Ces/0.7*0.51 + end if + tkelediss(k) = 0. + tkesbdiss(k) = 0. + tkesbshear(k)= 0. + tkesbbuoy(k) = 0. + do j=1,ny + do i=1,nx +! SGS buoyancy flux + +!bloss: removed temperature diagnostics for omn. +! - use mass weighted qsat, dqsat and latent heat for cloud +! - separate buoyancy contributions for precipitating water and ice. + + + if(qcl(i,j,k)+qci(i,j,k) .gt. 0.) then + + omn = qcl(i,j,k)/(qcl(i,j,k)+qci(i,j,k)+1.e-20) + lstarn = fac_cond+(1.-omn)*fac_fus + + dqsat = omn*dtqsatw_crm(tabs(i,j,k),pres(k))+ & + (1.-omn)*dtqsati_crm(tabs(i,j,k),pres(k)) + qsatt = omn*qsatw_crm(tabs(i,j,k),pres(k))+(1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) + bbb = 1. + epsv*qsatt-qcl(i,j,k)-qci(i,j,k) -qpl(i,j,k)-qpi(i,j,k)+1.61*tabs(i,j,k)*dqsat + bbb = bbb / (1.+lstarn*dqsat) + buoy_sgs=betdz*(bbb*(t(i,j,kc)-t(i,j,kb)) & + +(bbb*lstarn - (1.+lstarn*dqsat)*tabs(i,j,k))* & + (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & + + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + + (bbb*fac_sub - (1.+fac_sub *dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) +!bloss +(bbb*lstarp - (1.+lstarp*dqsat)*tabs(i,j,k))* & +!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) + else + + bbb = 1.+epsv*qv(i,j,k)-qpl(i,j,k)-qpi(i,j,k) + buoy_sgs=betdz*( bbb*(t(i,j,kc)-t(i,j,kb)) & + +epsv*tabs(i,j,k)* & + (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & + +(bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + +(bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) +!bloss +(bbb*lstarp-tabs(i,j,k))* & +!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) + end if + + if(buoy_sgs.le.0.) then + smix=grd + else + smix=min(grd,max(0.1*grd, sqrt(0.76*tk(i,j,k)/Ck/sqrt(buoy_sgs+1.e-10)))) + end if + + + ratio=smix/grd + Pr=1. +! Pr=1. +2.*ratio + Cee=Ce1+Ce2*ratio + + if(dosmagor) then + + tk(i,j,k)=sqrt(Ck**3/Cee*max(0.,def2(i,j,k)-Pr*buoy_sgs))*smix**2 + tke(i,j,k) = (tk(i,j,k)/(Ck*smix))**2 + a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) + a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs + a_diss=a_prod_sh+a_prod_bu + + else + + tke(i,j,k)=max(0.,tke(i,j,k)) + a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) + a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs + a_diss=min(tke(i,j,k)/(4.*dt),Cee/smix*tke(i,j,k)**1.5) ! cap the diss rate (useful for large time steps + tke(i,j,k)=max(0.,tke(i,j,k)+dtn*(max(0.,a_prod_sh+a_prod_bu)-a_diss)) + tk(i,j,k)=Ck*smix*sqrt(tke(i,j,k)) + + end if + + tkh(i,j,k)=Pr*tk(i,j,k) + + tkelediss(k) = tkelediss(k) - a_prod_sh + tkesbdiss(k) = tkesbdiss(k) + a_diss + tkesbshear(k)= tkesbshear(k)+ a_prod_sh + tkesbbuoy(k) = tkesbbuoy(k) + a_prod_bu + + end do ! i + end do ! j + + tkelediss(k) = tkelediss(k)/float(nx*ny) + + +end do ! k + +!call t_stopf('tke_full') + +end + + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 new file mode 100644 index 0000000000..669f8f6e07 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 @@ -0,0 +1,20 @@ +subroutine diffuse_mom + +! Interface to the diffusion routines + +use crmx_vars +implicit none +integer i,j,k + +!call t_startf ('diffuse_mom') + +if(RUN3D) then + call diffuse_mom3D() +else + call diffuse_mom2D() +endif + +!call t_stopf ('diffuse_mom') + +end subroutine diffuse_mom + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 new file mode 100644 index 0000000000..d336f118b6 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 @@ -0,0 +1,114 @@ + +subroutine diffuse_mom2D + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_z +use crmx_params, only: docolumn +implicit none + +real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 +real dxz,dzx + +integer i,j,k,ic,ib,kc,kcu +real tkx, tkz, rhoi, iadzw, iadz +real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) + +rdx2=1./dx/dx +rdx25=0.25*rdx2 + +dxz=dx/dz + +j=1 + +if(.not.docolumn) then + + +do k=1,nzm + + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdx251=rdx25 * grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + +end do + +end if + +!------------------------- +rdz=1./dz +dzx=dz/dx + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2=rdz*rdz *grdf_z(k) + rdz25=0.25*rdz2 + do i=1,nx + ib=i-1 + tkz=rdz2*tk(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do i=1,nx + tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) +end do + + +do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi + end do +end do ! k + +do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do +end do ! k + + +end subroutine diffuse_mom2D + + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 new file mode 100644 index 0000000000..18df252162 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 @@ -0,0 +1,150 @@ + +subroutine diffuse_mom3D + +! momentum tendency due to SGS diffusion + +use crmx_vars +use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z +use crmx_params, only: docolumn +implicit none + +real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 +real rdx21,rdy21,rdx251,rdy251,rdz25 +real dxy,dxz,dyx,dyz,dzx,dzy + +integer i,j,k,ic,ib,jb,jc,kc,kcu +real tkx, tky, tkz, rhoi, iadzw, iadz +real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) + +rdx25=0.25*rdx2 +rdy25=0.25*rdy2 + +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz + + +do k=1,nzm + kc=k+1 + kcu=min(kc,nzm) + dxz=dx/(dz*adzw(kc)) + dyz=dy/(dz*adzw(kc)) + rdx21=rdx2 * grdf_x(k) + rdy21=rdy2 * grdf_y(k) + rdx251=rdx25 * grdf_x(k) + rdy251=rdy25 * grdf_y(k) + do j=1,ny + jb=j-1 + do i=0,nx + ic=i+1 + tkx=rdx21*tk(i,j,k) + fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) + tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) + fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) + tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) + fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) + end do + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + ib=i-1 + tky=rdy21*tk(i,j,k) + fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) + tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) + fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) + tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) + fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) + dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) + end do + end do + +end do + +!------------------------- +rdz=1./dz +dzx=dz/dx +dzy=dz/dy + +do k=1,nzm-1 + kc=k+1 + uwsb(kc)=0. + vwsb(kc)=0. + iadz = 1./adz(k) + iadzw= 1./adzw(kc) + rdz2 = rdz*rdz * grdf_z(k) + rdz25 = 0.25*rdz2 + do j=1,ny + jb=j-1 + do i=1,nx + ib=i-1 + tkz=rdz2*tk(i,j,k) + fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz + tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) + fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & + (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) + tkz=rdz25*(tk(i,j,k)+tk(i,jb,k)+tk(i,j,kc)+tk(i,jb,kc)) + fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & + (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) + uwsb(kc)=uwsb(kc)+fu(i,j,kc) + vwsb(kc)=vwsb(kc)+fv(i,j,kc) + end do + end do +end do + +uwsb(1) = 0. +vwsb(1) = 0. + +do j=1,ny + do i=1,nx + tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) + fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) + fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) + fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) + fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) + fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) + uwsb(1) = uwsb(1) + fu(i,j,1) + vwsb(1) = vwsb(1) + fv(i,j,1) + end do + end do + + do k=1,nzm + kc=k+1 + rhoi = 1./(rho(k)*adz(k)) + do j=1,ny + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi + end do + end do + end do ! k + + do k=2,nzm + rhoi = 1./(rhow(k)*adzw(k)) + do j=1,ny + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi + end do + end do + end do ! k + + +end subroutine diffuse_mom3D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 new file mode 100644 index 0000000000..a5b48d4fd8 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 @@ -0,0 +1,42 @@ +subroutine diffuse_scalar (f,fluxb,fluxt, & + fdiff,flux,f2lediff,f2lediss,fwlediff,doit) + +use crmx_grid +use crmx_vars, only: rho, rhow +use crmx_sgs, only: tkh +implicit none + +! input: +real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real flux(nz) +real f2lediff(nz),f2lediss(nz),fwlediff(nz) +real fdiff(nz) +logical doit +! Local +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +integer i,j,k + +!call t_startf ('diffuse_scalars') + +df(:,:,:) = f(:,:,:) + +if(RUN3D) then + call diffuse_scalar3D (f,fluxb,fluxt,tkh,rho,rhow,flux) +else + call diffuse_scalar2D (f,fluxb,fluxt,tkh,rho,rhow,flux) +endif + +do k=1,nzm + fdiff(k)=0. + do j=1,ny + do i=1,nx + fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) + end do + end do +end do + +!call t_stopf ('diffuse_scalars') + +end subroutine diffuse_scalar diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 new file mode 100644 index 0000000000..d8ff8f7587 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 @@ -0,0 +1,103 @@ +subroutine diffuse_scalar2D (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dosgs +use crmx_sgs,only: grdf_x,grdf_z +implicit none + +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) + +! local +real flx(0:nx,1,0:nzm) +real dfdt(nx,ny,nzm) +real rdx2,rdz2,rdz,rdx5,rdz5,tmp +real dxz,dzx,tkx,tkz,rhoi +integer i,j,k,ib,ic,kc,kb + +if(.not.dosgs.and..not.docolumn) return + +rdx2=1./(dx*dx) +rdz2=1./(dz*dz) +rdz=1./dz +dxz=dx/dz +dzx=dz/dx + +j=1 + +dfdt(:,:,:)=0. + +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + field(0,j,k) = field(1,j,k) + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + field(nx+1,j,k) = field(nx,j,k) + end do + end if + +end if + + +if(.not.docolumn) then + + +do k=1,nzm + + rdx5=0.5*rdx2 *grdf_x(k) + + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + +end do + +end if + +flux(1) = 0. +tmp=1./adzw(nz) +do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k) + dfdt(i,j,k) + end do +end do + +end subroutine diffuse_scalar2D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 new file mode 100644 index 0000000000..f166ee61ea --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 @@ -0,0 +1,177 @@ +subroutine diffuse_scalar3D (field,fluxb,fluxt,tkh,rho,rhow,flux) + +use crmx_grid +use crmx_params, only: docolumn,dowallx,dowally,dosgs +use crmx_sgs, only: grdf_x,grdf_y,grdf_z +implicit none +! input +real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar +real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity +real fluxb(nx,ny) ! bottom flux +real fluxt(nx,ny) ! top flux +real rho(nzm) +real rhow(nz) +real flux(nz) +! local +real flx(0:nx,0:ny,0:nzm) +real dfdt(nx,ny,nz) +real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp +real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi +integer i,j,k,ib,ic,jb,jc,kc,kb + + +if(.not.dosgs) return + +rdx2=1./(dx*dx) +rdy2=1./(dy*dy) +rdz2=1./(dz*dz) +rdz=1./dz +dxy=dx/dy +dxz=dx/dz +dyx=dy/dx +dyz=dy/dz +dzx=dz/dx +dzy=dz/dy + +dfdt(:,:,:)=0. + +!----------------------------------------- +if(dowallx) then + + if(mod(rank,nsubdomains_x).eq.0) then + do k=1,nzm + do j=1,ny + field(0,j,k) = field(1,j,k) + end do + end do + end if + if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then + do k=1,nzm + do j=1,ny + field(nx+1,j,k) = field(nx,j,k) + end do + end do + end if + +end if + +if(dowally) then + + if(rank.lt.nsubdomains_x) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(rank.gt.nsubdomains-nsubdomains_x-1) then + do k=1,nzm + do i=1,ny + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + + + +if(dowally) then + + call task_rank_to_index(rank, ib, jb) + if(jb.eq.0) then + do k=1,nzm + do i=1,nx + field(i,1-YES3D,k) = field(i,1,k) + end do + end do + end if + if(jb.eq.nsubdomains_y-1) then + do k=1,nzm + do i=1,nx + field(i,ny+YES3D,k) = field(i,ny,k) + end do + end do + end if + +end if + +!----------------------------------------- + + +! Horizontal diffusion: + + +do k=1,nzm + + rdx5=0.5*rdx2 * grdf_x(k) + rdy5=0.5*rdy2 * grdf_y(k) + + do j=1,ny + do i=0,nx + ic=i+1 + tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) + flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) + end do + do i=1,nx + ib=i-1 + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) + end do + end do + + do j=0,ny + jc=j+1 + do i=1,nx + tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) + flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) + end do + end do + do j=1,ny + jb=j-1 + do i=1,nx + dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) + end do + end do + +end do ! k + + +! Vertical diffusion: + +flux(1) = 0. +tmp=1./adzw(nz) +do j=1,ny + do i=1,nx + flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) + flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) + flux(1) = flux(1) + flx(i,j,0) + end do +end do + + +do k=1,nzm-1 + kc=k+1 + flux(kc)=0. + rhoi = rhow(kc)/adzw(kc) + rdz5=0.5*rdz2 * grdf_z(k) + do j=1,ny + do i=1,nx + tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) + flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi + flux(kc) = flux(kc) + flx(i,j,k) + end do + end do +end do + +do k=1,nzm + kb=k-1 + rhoi = 1./(adz(k)*rho(k)) + do j=1,ny + do i=1,nx + dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) + field(i,j,k)=field(i,j,k)+dfdt(i,j,k) + end do + end do +end do + +end subroutine diffuse_scalar3D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 new file mode 100644 index 0000000000..b252482838 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 @@ -0,0 +1,422 @@ +module crmx_sgs + +! module for original SAM subgrid-scale SGS closure (Smagorinsky or 1st-order TKE) +! Marat Khairoutdinov, 2012 + +use crmx_grid, only: nx,nxp1,ny,nyp1,YES3D,nzm,nz,dimx1_s,dimx2_s,dimy1_s,dimy2_s +use crmx_params, only: dosgs +use crmx_vars, only: tke2, tk2 +implicit none + +!---------------------------------------------------------------------- +! Required definitions: + +!!! prognostic scalar (need to be advected arround the grid): + +integer, parameter :: nsgs_fields = 1 ! total number of prognostic sgs vars + +real sgs_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nsgs_fields) + +!!! sgs diagnostic variables that need to exchange boundary information (via MPI): + +integer, parameter :: nsgs_fields_diag = 2 ! total number of diagnostic sgs vars + +! diagnostic fields' boundaries: +integer, parameter :: dimx1_d=0, dimx2_d=nxp1, dimy1_d=1-YES3D, dimy2_d=nyp1 + +real sgs_field_diag(dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm, nsgs_fields_diag) + +logical:: advect_sgs = .false. ! advect prognostics or not, default - not (Smagorinsky) +logical, parameter:: do_sgsdiag_bound = .true. ! exchange boundaries for diagnostics fields + +! SGS fields that output by default (if =1). +integer, parameter :: flag_sgs3Dout(nsgs_fields) = (/0/) +integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0/) + +real fluxbsgs (nx, ny, 1:nsgs_fields) ! surface fluxes +real fluxtsgs (nx, ny, 1:nsgs_fields) ! top boundary fluxes + +!!! these arrays may be needed for output statistics: + +real sgswle(nz,1:nsgs_fields) ! resolved vertical flux +real sgswsb(nz,1:nsgs_fields) ! SGS vertical flux +real sgsadv(nz,1:nsgs_fields) ! tendency due to vertical advection +real sgslsadv(nz,1:nsgs_fields) ! tendency due to large-scale vertical advection +real sgsdiff(nz,1:nsgs_fields) ! tendency due to vertical diffusion + +!------------------------------------------------------------------ +! internal (optional) definitions: + +! make aliases for prognostic variables: + +real tke(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE +equivalence (tke(dimx1_s,dimy1_s,1),sgs_field(dimx1_s,dimy1_s,1,1)) + +! make aliases for diagnostic variables: + +real tk (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity +real tkh (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity +equivalence (tk(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,1)) +equivalence (tkh(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,2)) + + +real grdf_x(nzm)! grid factor for eddy diffusion in x +real grdf_y(nzm)! grid factor for eddy diffusion in y +real grdf_z(nzm)! grid factor for eddy diffusion in z + +logical:: dosmagor ! if true, then use Smagorinsky closure + +! Local diagnostics: + +real tkesbbuoy(nz), tkesbshear(nz),tkesbdiss(nz), tkesbdiff(nz) + +CONTAINS + +! required microphysics subroutines and function: +!---------------------------------------------------------------------- +!!! Read microphysics options from prm (namelist) file + +subroutine sgs_setparm() + + use crmx_grid, only: case + implicit none + + integer ierr, ios, ios_missing_namelist, place_holder + + !====================================================================== + NAMELIST /SGS_TKE/ & + dosmagor ! Diagnostic Smagorinsky closure + + NAMELIST /BNCUIODSBJCB/ place_holder + + dosmagor = .true. ! default + + !---------------------------------- + ! Read namelist for microphysics options from prm file: + !------------ + !open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') + + !read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) + !rewind(55) !note that one must rewind before searching for new namelists + + !read (55,SGS_TKE,IOSTAT=ios) + + advect_sgs = .not.dosmagor + + !if (ios.ne.0) then + ! !namelist error checking + ! if(ios.ne.ios_missing_namelist) then + ! write(*,*) '****** ERROR: bad specification in SGS_TKE namelist' + ! call task_abort() + ! end if + !end if + !close(55) + + ! END UW ADDITION + !====================================================================== + +end subroutine sgs_setparm + +!---------------------------------------------------------------------- +!!! Initialize sgs: + + +subroutine sgs_init() + + use crmx_grid, only: nrestart, dx, dy, dz, adz, masterproc + use crmx_params, only: LES + integer k + + if(nrestart.eq.0) then + + sgs_field = 0. + sgs_field_diag = 0. + + fluxbsgs = 0. + fluxtsgs = 0. + + end if + +! if(masterproc) then +! if(dosmagor) then +! write(*,*) 'Smagorinsky SGS Closure' +! else +! write(*,*) 'Prognostic TKE 1.5-order SGS Closure' +! end if +! end if + + if(LES) then + do k=1,nzm + grdf_x(k) = dx**2/(adz(k)*dz)**2 + grdf_y(k) = dy**2/(adz(k)*dz)**2 + grdf_z(k) = 1. + end do + else + do k=1,nzm + grdf_x(k) = min(16.,dx**2/(adz(k)*dz)**2) + grdf_y(k) = min(16.,dy**2/(adz(k)*dz)**2) + grdf_z(k) = 1. + end do + end if + + sgswle = 0. + sgswsb = 0. + sgsadv = 0. + sgsdiff = 0. + sgslsadv = 0. + + +end subroutine sgs_init + +!---------------------------------------------------------------------- +!!! make some initial noise in sgs: +! +subroutine setperturb_sgs(ptype) + +use crmx_vars, only: q0, z +integer, intent(in) :: ptype +integer i,j,k + +select case (ptype) + + case(0) + + do k=1,nzm + do j=1,ny + do i=1,nx + if(k.le.4.and..not.dosmagor) then + tke(i,j,k)=0.04*(5-k) + endif + end do + end do + end do + + case(1) + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.6.e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + case(2) + + case(3) ! gcss wg1 smoke-cloud case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.0.5e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + + case(4) ! gcss wg1 arm case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(z(k).le.150..and..not.dosmagor) then + tke(i,j,k)=0.15*(1.-z(k)/150.) + endif + end do + end do + end do + + + case(5) ! gcss wg1 BOMEX case + + do k=1,nzm + do j=1,ny + do i=1,nx + if(z(k).le.3000..and..not.dosmagor) then + tke(i,j,k)=1.-z(k)/3000. + endif + end do + end do + end do + + case(6) ! GCSS Lagragngian ASTEX + + + do k=1,nzm + do j=1,ny + do i=1,nx + if(q0(k).gt.6.e-3.and..not.dosmagor) then + tke(i,j,k)=1. + endif + end do + end do + end do + + + case default + +end select + +end subroutine setperturb_sgs + +!---------------------------------------------------------------------- +!!! Estimate Courant number limit for SGS +! + +subroutine kurant_sgs(cfl) + +use crmx_grid, only: dt, dx, dy, dz, adz, adzw +implicit none + +real, intent(out) :: cfl + +integer k +real tkhmax(nz) + +do k = 1,nzm + tkhmax(k) = maxval(tkh(1:nx,1:ny,k)) +end do + +cfl = 0. +do k=1,nzm + cfl = max(cfl, & + 0.5*tkhmax(k)*grdf_z(k)*dt/(dz*adzw(k))**2, & + 0.5*tkhmax(k)*grdf_x(k)*dt/dx**2, & + YES3D*0.5*tkhmax(k)*grdf_y(k)*dt/dy**2) +end do + +end subroutine kurant_sgs + + +!---------------------------------------------------------------------- +!!! compute sgs diffusion of momentum: +! +subroutine sgs_mom() + + call diffuse_mom() + +end subroutine sgs_mom + +!---------------------------------------------------------------------- +!!! compute sgs diffusion of scalars: +! +subroutine sgs_scalars() + + use crmx_vars + use crmx_microphysics + use crmx_crmtracers + use crmx_params, only: dotracers + implicit none + + real dummy(nz) + real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss + integer k + + + call diffuse_scalar(t,fluxbt,fluxtt,tdiff,twsb, & + t2lediff,t2lediss,twlediff,.true.) + + if(advect_sgs) then + call diffuse_scalar(tke,fzero,fzero,dummy,sgswsb, & + dummy,dummy,dummy,.false.) + end if + + +! +! diffusion of microphysics prognostics: +! + call micro_flux() + + total_water_evap = total_water_evap - total_water() + + do k = 1,nmicro_fields + if( k.eq.index_water_vapor &! transport water-vapor variable no metter what + .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars + .or. doprecip.and.flag_precip(k).eq.1 ) then + fluxbtmp(1:nx,1:ny) = fluxbmk(1:nx,1:ny,k) + fluxttmp(1:nx,1:ny) = fluxtmk(1:nx,1:ny,k) + call diffuse_scalar(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & + mkdiff(:,k),mkwsb(:,k), dummy,dummy,dummy,.false.) + end if + end do + + total_water_evap = total_water_evap + total_water() + + ! diffusion of tracers: + + if(dotracers) then + + call tracers_flux() + + do k = 1,ntracers + + fluxbtmp = fluxbtr(:,:,k) + fluxttmp = fluxttr(:,:,k) + call diffuse_scalar(tracer(:,:,:,k),fluxbtmp,fluxttmp, & + trdiff(:,k),trwsb(:,k), & + dummy,dummy,dummy,.false.) +!!$ call diffuse_scalar(tracer(:,:,:,k),fluxbtr(:,:,k),fluxttr(:,:,k),trdiff(:,k),trwsb(:,k), & +!!$ dummy,dummy,dummy,.false.) + + end do + + end if + + + +end subroutine sgs_scalars + +!---------------------------------------------------------------------- +!!! compute sgs processes (beyond advection): +! +subroutine sgs_proc() + + use crmx_grid, only: nstep,dt,icycle + use crmx_params, only: dosmoke + +! SGS TKE equation: + + if(dosgs) call tke_full() + + tke2 = tke + tk2 = tk + +end subroutine sgs_proc + +!---------------------------------------------------------------------- +!!! Diagnose arrays nessesary for dynamical core and statistics: +! +subroutine sgs_diagnose() +! None + +end subroutine sgs_diagnose + +!---------------------------------------------------------------------- +! called when stepout() called + +subroutine sgs_print() + + call fminmax_print('tke:',tke,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) + call fminmax_print('tk:',tk,0,nxp1,1-YES3D,nyp1,nzm) + call fminmax_print('tkh:',tkh,0,nxp1,1-YES3D,nyp1,nzm) + +end subroutine sgs_print + +!---------------------------------------------------------------------- +!!! Initialize the list of sgs statistics +! +subroutine sgs_hbuf_init(namelist,deflist,unitlist,status,average_type,count,sgscount) +character(*) namelist(*), deflist(*), unitlist(*) +integer status(*),average_type(*),count,sgscount + +end subroutine sgs_hbuf_init + + +end module crmx_sgs + + + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 new file mode 100644 index 0000000000..50fe343ebe --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 @@ -0,0 +1,109 @@ + +subroutine shear_prod2D(def2) + +use crmx_vars +implicit none + +real def2(nx,ny,nzm) + +real rdx0,rdx,rdx_up,rdx_dn +real rdz,rdzw_up,rdzw_dn +integer i,j,k,ib,ic,kb,kc + +rdx0=1./dx +j=1 + + +do k=2,nzm-1 + + kb=k-1 + kc=k+1 + rdz = 1./(dz*adz(k)) + rdzw_up = 1./(dz*adzw(kc)) + rdzw_dn = 1./(dz*adzw(k)) + rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy + rdx_up=rdx0 * sqrt(dx*rdzw_up) + rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 + & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 ) + + end do +end do ! k + + +k=1 +kc=k+1 + +rdz = 1./(dz*adz(k)) +rdzw_up = 1./(dz*adzw(kc)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdx_up=rdx0 * sqrt(dx*rdzw_up) + +do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + +( (v(i,j ,kc)-v0(kc)-v(i,j,k)+v0(k))*rdzw_up )**2 & + + 0.5 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) +end do + +k=nzm +kc=k+1 +kb=k-1 + +rdz = 1./(dz*adz(k)) +rdzw_dn = 1./(dz*adzw(k)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + + +do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.5 * ( & + ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 & + + 0.5 * ( & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + +end do + +end + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 new file mode 100644 index 0000000000..2ecd9c25a6 --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 @@ -0,0 +1,155 @@ + +subroutine shear_prod3D(def2) + +use crmx_vars +implicit none + +real def2(nx,ny,nzm) + +real rdx0,rdx,rdx_up,rdx_dn +real rdy0,rdy,rdy_up,rdy_dn +real rdz,rdzw_up,rdzw_dn +integer i,j,k,ib,ic,jb,jc,kb,kc + +rdx0=1./dx +rdy0=1./dy + +do k=2,nzm-1 + + kb=k-1 + kc=k+1 + rdz = 1./(dz*adz(k)) + rdzw_up = 1./(dz*adzw(kc)) + rdzw_dn = 1./(dz*adzw(k)) + rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy + rdy=rdy0 * sqrt(dy*rdz) + rdx_up=rdx0 * sqrt(dx*rdzw_up) + rdy_up=rdy0 * sqrt(dy*rdzw_up) + rdx_dn=rdx0 * sqrt(dx*rdzw_dn) + rdy_dn=rdy0 * sqrt(dy*rdzw_dn) + + do j=1,ny + jb=j-YES3D + jc=j+YES3D + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) + def2(i,j,k)=def2(i,j,k) & + + 0.25 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + def2(i,j,k)=def2(i,j,k) & + + 0.25 * ( & + ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & + (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & + (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 + & + ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & + (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & + (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) + + end do + end do +end do ! k + + +k=1 +kc=k+1 + +rdz = 1./(dz*adz(k)) +rdzw_up = 1./(dz*adzw(kc)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdy=rdy0 * sqrt(dy*rdz) +rdx_up=rdx0 * sqrt(dx*rdzw_up) +rdy_up=rdy0 * sqrt(dy*rdzw_up) + +do j=1,ny + jb=j-YES3D + jc=j+YES3D + do i=1,nx + ib=i-1 + ic=i+1 + + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + 0.5 * ( & + ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & + (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & + ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & + (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 ) & + + 0.5 * ( & + ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & + (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & + ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & + (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) + + + end do +end do + + +k=nzm +kc=k+1 +kb=k-1 + +rdz = 1./(dz*adz(k)) +rdzw_dn = 1./(dz*adzw(k)) +rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy +rdy=rdy0 * sqrt(dy*rdz) +rdx_dn=rdx0 * sqrt(dx*rdzw_dn) +rdy_dn=rdy0 * sqrt(dy*rdzw_dn) + +do j=1,ny + jb=j-1*YES3D + jc=j+1*YES3D + do i=1,nx + ib=i-1 + ic=i+1 + def2(i,j,k)=2.* ( & + ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & + ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & + ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & + + 0.25 * ( & + ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & + ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & + ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & + ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & + + 0.5 * ( & + ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & + (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & + (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) & + + 0.5 * ( & + ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & + (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & + ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & + (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) + end do +end do + +end + diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 new file mode 100644 index 0000000000..79dd936cdc --- /dev/null +++ b/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 @@ -0,0 +1,147 @@ + +subroutine tke_full + +! this subroutine solves the TKE equation + +use crmx_vars +use crmx_sgs +use crmx_params +implicit none + +real def2(nx,ny,nzm) +real grd,betdz,Ck,Ce,Ces,Ce1,Ce2,smix,Pr,Cee,Cs +real buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss +real lstarn, lstarp, bbb, omn, omp +real qsatt,dqsat +integer i,j,k,kc,kb + +!call t_startf('tke_full') + +!Cs = 0.1944 +Cs = 0.15 +Ck=0.1 +Ce=Ck**3/Cs**4 +Ces=Ce/0.7*3.0 + +if(RUN3D) then + call shear_prod3D(def2) +else + call shear_prod2D(def2) +endif + +do k=1,nzm + kb=k-1 + kc=k+1 + + grd=dz*adz(k) + + betdz=bet(k)/dz/(adzw(kc)+adzw(k)) + Ce1=Ce/0.7*0.19 + Ce2=Ce/0.7*0.51 + if(k.eq.1) then + kb=1 + kc=2 + betdz=bet(k)/dz/adzw(kc) + Ce1=Ces/0.7*0.19 + Ce2=Ces/0.7*0.51 + end if + if(k.eq.nzm) then + kb=nzm-1 + kc=nzm + betdz=bet(k)/dz/adzw(k) + Ce1=Ces/0.7*0.19 + Ce2=Ces/0.7*0.51 + end if + tkelediss(k) = 0. + tkesbdiss(k) = 0. + tkesbshear(k)= 0. + tkesbbuoy(k) = 0. + do j=1,ny + do i=1,nx +! SGS buoyancy flux + +!bloss: removed temperature diagnostics for omn. +! - use mass weighted qsat, dqsat and latent heat for cloud +! - separate buoyancy contributions for precipitating water and ice. + + + if(qcl(i,j,k)+qci(i,j,k) .gt. 0.) then + + omn = qcl(i,j,k)/(qcl(i,j,k)+qci(i,j,k)+1.e-20) + lstarn = fac_cond+(1.-omn)*fac_fus + + dqsat = omn*dtqsatw_crm(tabs(i,j,k),pres(k))+ & + (1.-omn)*dtqsati_crm(tabs(i,j,k),pres(k)) + qsatt = omn*qsatw_crm(tabs(i,j,k),pres(k))+(1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) + bbb = 1. + epsv*qsatt-qcl(i,j,k)-qci(i,j,k) -qpl(i,j,k)-qpi(i,j,k)+1.61*tabs(i,j,k)*dqsat + bbb = bbb / (1.+lstarn*dqsat) + buoy_sgs=betdz*(bbb*(t(i,j,kc)-t(i,j,kb)) & + +(bbb*lstarn - (1.+lstarn*dqsat)*tabs(i,j,k))* & + (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & + + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + + (bbb*fac_sub - (1.+fac_sub *dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) +!bloss +(bbb*lstarp - (1.+lstarp*dqsat)*tabs(i,j,k))* & +!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) + else + + bbb = 1.+epsv*qv(i,j,k)-qpl(i,j,k)-qpi(i,j,k) + buoy_sgs=betdz*( bbb*(t(i,j,kc)-t(i,j,kb)) & + +epsv*tabs(i,j,k)* & + (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & + +(bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + +(bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) +!bloss +(bbb*lstarp-tabs(i,j,k))* & +!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) + end if + + if(buoy_sgs.le.0.) then + smix=grd + else + smix=min(grd,max(0.1*grd, sqrt(0.76*tk(i,j,k)/Ck/sqrt(buoy_sgs+1.e-10)))) + end if + + + ratio=smix/grd + Pr=1. +! Pr=1. +2.*ratio + Cee=Ce1+Ce2*ratio + + if(dosmagor) then + + tk(i,j,k)=sqrt(Ck**3/Cee*max(0.,def2(i,j,k)-Pr*buoy_sgs))*smix**2 + tke(i,j,k) = (tk(i,j,k)/(Ck*smix))**2 + a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) + a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs + a_diss=a_prod_sh+a_prod_bu + + else + + tke(i,j,k)=max(0.,tke(i,j,k)) + a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) + a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs + a_diss=min(tke(i,j,k)/(4.*dt),Cee/smix*tke(i,j,k)**1.5) ! cap the diss rate (useful for large time steps + tke(i,j,k)=max(0.,tke(i,j,k)+dtn*(max(0.,a_prod_sh+a_prod_bu)-a_diss)) + tk(i,j,k)=Ck*smix*sqrt(tke(i,j,k)) + + end if + + tkh(i,j,k)=Pr*tk(i,j,k) + + tkelediss(k) = tkelediss(k) - a_prod_sh + tkesbdiss(k) = tkesbdiss(k) + a_diss + tkesbshear(k)= tkesbshear(k)+ a_prod_sh + tkesbbuoy(k) = tkesbbuoy(k) + a_prod_bu + + end do ! i + end do ! j + + tkelediss(k) = tkelediss(k)/float(nx*ny) + + +end do ! k + +!call t_stopf('tke_full') + +end + + diff --git a/src/physics/spcam/crm/crmx_abcoefs.F90 b/src/physics/spcam/crm/crmx_abcoefs.F90 new file mode 100644 index 0000000000..0694eb0143 --- /dev/null +++ b/src/physics/spcam/crm/crmx_abcoefs.F90 @@ -0,0 +1,28 @@ + +subroutine abcoefs + +! coefficients for the Adams-Bashforth scheme + +use crmx_grid + +implicit none + +real alpha, beta + +if(nstep.ge.3.and.nadams.eq.3.or.nrestart.eq.2) then + alpha = dt3(nb) / dt3(na) + beta = dt3(nc) / dt3(na) + ct = (2.+3.* alpha) / (6.* (alpha + beta) * beta) + bt = -(1.+2.*(alpha + beta) * ct)/(2. * alpha) + at = 1. - bt - ct +else if(nstep.ge.2) then + at = 3./2. + bt = -1./2. + ct = 0. +else + at = 1. + bt = 0. + ct = 0. +end if + +end subroutine abcoefs diff --git a/src/physics/spcam/crm/crmx_adams.F90 b/src/physics/spcam/crm/crmx_adams.F90 new file mode 100644 index 0000000000..97b35188fc --- /dev/null +++ b/src/physics/spcam/crm/crmx_adams.F90 @@ -0,0 +1,45 @@ + +subroutine adams + +! Adams-Bashforth scheme + +use crmx_vars + +implicit none + +real dtdx, dtdy, dtdz, rhox, rhoy, rhoz +integer i,j,k + +dtdx = dtn/dx +dtdy = dtn/dy +dtdz = dtn/dz + +do k=1,nzm + rhox = rho(k)*dtdx + rhoy = rho(k)*dtdy + rhoz = rhow(k)*dtdz + do j=1,ny + do i=1,nx + + dudt(i,j,k,nc) = u(i,j,k) + dt3(na) & + *(at*dudt(i,j,k,na)+bt*dudt(i,j,k,nb)+ct*dudt(i,j,k,nc)) + + dvdt(i,j,k,nc) = v(i,j,k) + dt3(na) & + *(at*dvdt(i,j,k,na)+bt*dvdt(i,j,k,nb)+ct*dvdt(i,j,k,nc)) + + dwdt(i,j,k,nc) = w(i,j,k) + dt3(na) & + *(at*dwdt(i,j,k,na)+bt*dwdt(i,j,k,nb)+ct*dwdt(i,j,k,nc)) + + u(i,j,k) = 0.5*(u(i,j,k)+dudt(i,j,k,nc)) * rhox + v(i,j,k) = 0.5*(v(i,j,k)+dvdt(i,j,k,nc)) * rhoy + misc(i,j,k) = 0.5*(w(i,j,k)+dwdt(i,j,k,nc)) + w(i,j,k) = 0.5*(w(i,j,k)+dwdt(i,j,k,nc)) * rhoz + + + end do + end do +end do + +end subroutine adams + + diff --git a/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 b/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 new file mode 100644 index 0000000000..600596d177 --- /dev/null +++ b/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 @@ -0,0 +1,95 @@ + +subroutine advect2_mom_xy + +! momentum tendency due to 2nd-order-central horizontal advection + +use crmx_vars + +implicit none + +real fu(0:nx,1-YES3D:ny,nzm) +real fv(0:nx,1-YES3D:ny,nzm) +real fw(0:nx,1-YES3D:ny,nzm) +real dx25, dy25, irho + +integer i, j, k, kc, kcu, ic, jb, ib, jc + +dx25 = 0.25 / dx +dy25 = 0.25 / dy + + +if(RUN3D) then + +do k = 1,nzm + kc= k+1 + kcu =min(kc, nzm) + irho = 1./(rhow(kc)*adzw(kc)) + + do j = 1, ny + jb = j-1 + do i = 0, nx + ic = i+1 + fu(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(u(i,j,k)+u(ic,j,k)) + fv(i,j,k)=dx25*(u(ic,j,k)+u(ic,jb,k))*(v(i,j,k)+v(ic,j,k)) + fw(i,j,k)=dx25*(u(ic,j,k)*rho(k)*adz(k)+ & + u(ic,j,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(ic,j,kc)) + end do + do i = 1, nx + ib = i-1 + dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na) = dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(ib,j,k)) + end do + end do + + do j = 0, ny + jc = j+1 + do i = 1, nx + ib = i-1 + fu(i,j,k)=dy25*(v(i,jc,k)+v(ib,jc,k))*(u(i,j,k)+u(i,jc,k)) + fv(i,j,k)=dy25*(v(i,jc,k)+v(i,j,k))*(v(i,j,k)+v(i,jc,k)) + fw(i,j,k)=dy25*(v(i,jc,k)*rho(k)*adz(k)+ & + v(i,jc,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(i,jc,kc)) + end do + end do + do j = 1,ny + jb = j-1 + do i = 1, nx + dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k) - fu(i,jb,k)) + dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k) - fv(i,jb,k)) + dwdt(i,j,kc,na)= dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(i,jb,k)) + end do + end do + +end do ! k + + +else + +j=1 + +do k = 1,nzm + kc= k+1 + kcu =min(kc, nzm) + irho = 1./(rhow(kc)*adzw(kc)) + + do i = 0, nx + ic = i+1 + fu(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(u(i,j,k)+u(ic,j,k)) + fv(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(v(i,j,k)+v(ic,j,k)) + fw(i,j,k)=dx25*(u(ic,j,k)*rho(k)*adz(k)+ & + u(ic,j,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(ic,j,kc)) + end do + do i = 1, nx + ib = i-1 + dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k)-fu(ib,j,k)) + dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k)-fv(ib,j,k)) + dwdt(i,j,kc,na) = dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(ib,j,k)) + end do + +end do ! k + +endif + +end subroutine advect2_mom_xy + diff --git a/src/physics/spcam/crm/crmx_advect2_mom_z.F90 b/src/physics/spcam/crm/crmx_advect2_mom_z.F90 new file mode 100644 index 0000000000..be5d42734a --- /dev/null +++ b/src/physics/spcam/crm/crmx_advect2_mom_z.F90 @@ -0,0 +1,93 @@ + +subroutine advect2_mom_z + +! momentum tendency due to the 2nd-order-central vertical advection + +use crmx_vars + +implicit none + + +real fuz(nx,ny,nz),fvz(nx,ny,nz),fwz(nx,ny,nzm) +integer i, j, k, kc, kb +real dz2, dz25, www, rhoi + +dz25=1./(4.*dz) +dz2=dz25*2. + +do j=1,ny + do i=1,nx + fuz(i,j,1) = 0. + fvz(i,j,1) = 0. + fuz(i,j,nz) = 0. + fvz(i,j,nz) = 0. + fwz(i,j,1) = 0. + fwz(i,j,nzm) = 0. + end do +end do + +uwle(1) = 0. +vwle(1) = 0. + +if(RUN3D) then + +do k=2,nzm + kb = k-1 + rhoi = dz25 * rhow(k) + uwle(k) = 0. + vwle(k) = 0. + do j=1,ny + do i=1,nx + fuz(i,j,k) = rhoi*(w(i,j,k)+w(i-1,j,k))*(u(i,j,k)+u(i,j,kb)) + fvz(i,j,k) = rhoi*(w(i,j,k)+w(i,j-1,k))*(v(i,j,k)+v(i,j,kb)) + uwle(k) = uwle(k)+fuz(i,j,k) + vwle(k) = vwle(k)+fvz(i,j,k) + end do + end do +end do + +else + +do k=2,nzm + kb = k-1 + rhoi = dz25 * rhow(k) + uwle(k) = 0. + vwle(k) = 0. + do j=1,ny + do i=1,nx + www = rhoi*(w(i,j,k)+w(i-1,j,k)) + fuz(i,j,k) = www*(u(i,j,k)+u(i,j,kb)) + fvz(i,j,k) = www*(v(i,j,k)+v(i,j,kb)) + uwle(k) = uwle(k)+fuz(i,j,k) + vwle(k) = vwle(k)+fvz(i,j,k) + end do + end do +end do + + +endif + +do k=1,nzm + kc = k+1 + rhoi = 1./(rho(k)*adz(k)) + do j=1,ny + do i=1,nx + dudt(i,j,k,na)=dudt(i,j,k,na)-(fuz(i,j,kc)-fuz(i,j,k))*rhoi + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fvz(i,j,kc)-fvz(i,j,k))*rhoi + fwz(i,j,k)=dz25*(w(i,j,kc)*rhow(kc)+w(i,j,k)*rhow(k))*(w(i,j,kc)+w(i,j,k)) + end do + end do +end do + +do k=2,nzm + kb=k-1 + rhoi = 1./(rhow(k)*adzw(k)) + do j=1,ny + do i=1,nx + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fwz(i,j,k)-fwz(i,j,kb))*rhoi + end do + end do +end do ! k + +end subroutine advect2_mom_z + diff --git a/src/physics/spcam/crm/crmx_advect_all_scalars.F90 b/src/physics/spcam/crm/crmx_advect_all_scalars.F90 new file mode 100644 index 0000000000..f6eb9e0915 --- /dev/null +++ b/src/physics/spcam/crm/crmx_advect_all_scalars.F90 @@ -0,0 +1,73 @@ +subroutine advect_all_scalars() + + use crmx_vars + use crmx_microphysics + use crmx_sgs + use crmx_crmtracers +#ifdef CLUBB_CRM + use crmx_params, only: dotracers, doclubb, doclubbnoninter +#else + use crmx_params, only: dotracers +#endif + implicit none + real dummy(nz) + integer k + + +!--------------------------------------------------------- +! advection of scalars : + + call advect_scalar(t,tadv,twle,t2leadv,t2legrad,twleadv,.true.) + +! +! Advection of microphysics prognostics: +! + + do k = 1,nmicro_fields + if( k.eq.index_water_vapor &! transport water-vapor variable no metter what +#ifdef CLUBB_CRM +!Added preprocessor directives. - nielsenb UWM 30 July 2008 + .or. ( docloud .or. doclubb .or. doclubbnoninter ) .and.flag_precip(k).ne.1 & ! transport non-precipitation vars +#else + .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars +#endif + .or. doprecip.and.flag_precip(k).eq.1 ) & + call advect_scalar(micro_field(:,:,:,k),mkadv(:,k),mkwle(:,k),dummy,dummy,dummy,.false.) + end do + +! +! Advection of sgs prognostics: +! + + if(dosgs.and.advect_sgs) then + do k = 1,nsgs_fields + call advect_scalar(sgs_field(:,:,:,k),sgsadv(:,k),sgswle(:,k),dummy,dummy,dummy,.false.) + end do + end if + + +! +! Precipitation fallout: +! + if(doprecip) then + + total_water_prec = total_water_prec + total_water() + + call micro_precip_fall() + + total_water_prec = total_water_prec - total_water() + + + end if + + ! advection of tracers: + + if(dotracers) then + + do k = 1,ntracers + call advect_scalar(tracer(:,:,:,k),tradv(:,k),trwle(:,k),dummy,dummy,dummy,.false.) + end do + + end if + +end subroutine advect_all_scalars diff --git a/src/physics/spcam/crm/crmx_advect_mom.F90 b/src/physics/spcam/crm/crmx_advect_mom.F90 new file mode 100644 index 0000000000..b1562a09a3 --- /dev/null +++ b/src/physics/spcam/crm/crmx_advect_mom.F90 @@ -0,0 +1,19 @@ +subroutine advect_mom + +use crmx_vars +use crmx_params, only: docolumn + +implicit none +integer i,j,k + +if(docolumn) return + +!call t_startf ('advect_mom') + +call advect2_mom_xy() +call advect2_mom_z() + +!call t_stopf ('advect_mom') + +end subroutine advect_mom + diff --git a/src/physics/spcam/crm/crmx_atmosphere.F90 b/src/physics/spcam/crm/crmx_atmosphere.F90 new file mode 100644 index 0000000000..5f9623b931 --- /dev/null +++ b/src/physics/spcam/crm/crmx_atmosphere.F90 @@ -0,0 +1,71 @@ + + SUBROUTINE Atmosphere(alt, sigma, delta, theta) +! ------------------------------------------------------------------------- +! PURPOSE - Compute the properties of the 1976 standard atmosphere to 86 km. +! AUTHOR - Ralph Carmichael, Public Domain Aeronautical Software +! NOTE - If alt > 86, the values returned will not be correct, but they will +! not be too far removed from the correct values for density. +! The reference document does not use the terms pressure and temperature +! above 86 km. + IMPLICIT NONE +!============================================================================ +! A R G U M E N T S | +!============================================================================ + REAL,INTENT(IN):: alt ! geometric altitude, km. + REAL,INTENT(OUT):: sigma! density/sea-level standard density + REAL,INTENT(OUT):: delta! pressure/sea-level standard pressure + REAL,INTENT(OUT):: theta! temperature/sea-level standard temperature +!============================================================================ +! L O C A L C O N S T A N T S | +!============================================================================ + REAL,PARAMETER:: REARTH = 6369.0 ! radius of the Earth (km) + REAL,PARAMETER:: GMR = 34.163195 ! gas constant + INTEGER,PARAMETER:: NTAB=8! number of entries in the defining tables +!============================================================================ +! L O C A L V A R I A B L E S | +!============================================================================ + INTEGER:: i,j,k ! counters + REAL:: h ! geopotential altitude (km) + REAL:: tgrad, tbase! temperature gradient and base temp of this layer + REAL:: tlocal ! local temperature + REAL:: deltah ! height above base of this layer +!============================================================================ +! L O C A L A R R A Y S ( 1 9 7 6 S T D. A T M O S P H E R E ) | +!============================================================================ + REAL,DIMENSION(NTAB),PARAMETER:: htab= (/0.0, 11.0, 20.0, 32.0, 47.0, 51.0, 71.0,84.852/) + REAL,DIMENSION(NTAB),PARAMETER:: ttab= (/288.15, 216.65, 216.65, 228.65, 270.65, 270.65, 214.65, 186.946/) + REAL,DIMENSION(NTAB),PARAMETER:: ptab= (/1.0, 2.233611e-1, & +5.403295e-2, 8.5666784e-3, 1.0945601e-3, 6.6063531e-4, 3.9046834e-5, 3.68501e-6/) + REAL,DIMENSION(NTAB),PARAMETER:: gtab= (/-6.5, 0.0, 1.0, 2.8, 0.0, -2.8, -2.0, 0.0/) +!---------------------------------------------------------------------------- + h=alt*REARTH/(alt+REARTH)! convert geometric to geopotential altitude + + i=1 + j=NTAB ! setting up for=binary search + DO + k=(i+j)/2 + IF (h < htab(k)) THEN + j=k + ELSE + i=k + END IF + IF (j <= i+1) EXIT + END DO + + tgrad=gtab(i) ! i will be in 1...NTAB-1 + tbase=ttab(i) + deltah=h-htab(i) + tlocal=tbase+tgrad*deltah + theta=tlocal/ttab(1) ! temperature ratio + + IF (tgrad == 0.0) THEN ! pressure ratio + delta=ptab(i)*EXP(-GMR*deltah/tbase) + ELSE + delta=ptab(i)*(tbase/tlocal)**(GMR/tgrad) + END IF + + sigma=delta/theta ! density ratio + RETURN + END Subroutine Atmosphere + + diff --git a/src/physics/spcam/crm/crmx_bound_duvdt.F90 b/src/physics/spcam/crm/crmx_bound_duvdt.F90 new file mode 100644 index 0000000000..ff96184761 --- /dev/null +++ b/src/physics/spcam/crm/crmx_bound_duvdt.F90 @@ -0,0 +1,28 @@ + + +subroutine bound_duvdt + +! Periodic boundary exchange + +use crmx_vars +implicit none + +integer i,j,k + + do k=1,nzm + do j=1,ny + dudt(nxp1,j,k,na) = dudt(1,j,k,na) + end do + end do + + if(RUN3D) then + + do k=1,nzm + do i=1,nx + dvdt(i,nyp1,k,na) = dvdt(i,1,k,na) + end do + end do + + endif + +end subroutine bound_duvdt diff --git a/src/physics/spcam/crm/crmx_bound_exchange.F90 b/src/physics/spcam/crm/crmx_bound_exchange.F90 new file mode 100644 index 0000000000..c327a0f13f --- /dev/null +++ b/src/physics/spcam/crm/crmx_bound_exchange.F90 @@ -0,0 +1,206 @@ +subroutine bound_exchange(f,dimx1,dimx2,dimy1,dimy2,dimz,i_1, i_2, j_1, j_2, id) + +! periodic boundary exchange + + +use crmx_grid +implicit none + +integer dimx1, dimx2, dimy1, dimy2, dimz +integer i_1, i_2, j_1, j_2 +real f(dimx1:dimx2, dimy1:dimy2, dimz) +integer id ! id of the sent field (dummy variable) + +real buffer((nx+ny)*3*nz) ! buffer for sending data + +integer i, j, k, n +integer i1, i2, j1, j2 + +i1 = i_1 - 1 +i2 = i_2 - 1 +j1 = j_1 - 1 +j2 = j_2 - 1 + +!---------------------------------------------------------------------- +! Send buffers to neighbors +!---------------------------------------------------------------------- + + + if(RUN3D) then + +! "North" -> "South": + + n=0 + do k=1,dimz + do j=ny-j1,ny + do i=1,nx + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=-j1,0 + do i=1,nx + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + +! "North-East" -> "South-West": + + n=0 + do k=1,dimz + do j=ny-j1,ny + do i=nx-i1,nx + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=-j1,0 + do i=-i1,0 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + +! "South-East" -> "North-West": + + n=0 + do k=1,dimz + do j=1,1+j2 + do i=nx-i1,nx + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=nyp1,nyp1+j2 + do i=-i1,0 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + +! "South" -> "North": + + n=0 + do k=1,dimz + do j=1,1+j2 + do i=1,nx + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=nyp1,nyp1+j2 + do i=1,nx + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + +! "South-West" -> "North-East": + + n=0 + do k=1,dimz + do j=1,1+j2 + do i=1,1+i2 + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=nyp1,nyp1+j2 + do i=nxp1,nxp1+i2 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + + +! To "North-West" -> "South-East": + + n=0 + do k=1,dimz + do j=ny-j1,ny + do i=1,1+i2 + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=-j1,0 + do i=nxp1,nxp1+i2 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + + + endif + +! "East" -> "West": + + n=0 + do k=1,dimz + do j=1,ny + do i=nx-i1,nx + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=1,ny + do i=-i1,0 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + +! "West" -> "East": + + n=0 + do k=1,dimz + do j=1,ny + do i=1,1+i2 + n = n+1 + buffer(n) = f(i,j,k) + end do + end do + end do + n=0 + do k=1,dimz + do j=1,ny + do i=nxp1,nxp1+i2 + n = n+1 + f(i,j,k) = buffer(n) + end do + end do + end do + + +end subroutine bound_exchange + + diff --git a/src/physics/spcam/crm/crmx_boundaries.F90 b/src/physics/spcam/crm/crmx_boundaries.F90 new file mode 100644 index 0000000000..0a642daab1 --- /dev/null +++ b/src/physics/spcam/crm/crmx_boundaries.F90 @@ -0,0 +1,20 @@ + +subroutine boundaries(flag) + +use crmx_grid, only: dompi + + +implicit none +integer flag + +!call t_startf ('boundaries') + +if(dompi) then + call task_boundaries(flag) +else + call periodic(flag) +end if + +!call t_stopf ('boundaries') + +end subroutine boundaries diff --git a/src/physics/spcam/crm/crmx_buoyancy.F90 b/src/physics/spcam/crm/crmx_buoyancy.F90 new file mode 100644 index 0000000000..8d8ff6a739 --- /dev/null +++ b/src/physics/spcam/crm/crmx_buoyancy.F90 @@ -0,0 +1,34 @@ + +subroutine buoyancy() + +use crmx_vars +use crmx_params +implicit none + +integer i,j,k,kb +real betu, betd + +if(docolumn) return + +do k=2,nzm + kb=k-1 + betu=adz(kb)/(adz(k)+adz(kb)) + betd=adz(k)/(adz(k)+adz(kb)) + do j=1,ny + do i=1,nx + + dwdt(i,j,k,na)=dwdt(i,j,k,na) + & + bet(k)*betu* & + ( tabs0(k)*(epsv*(qv(i,j,k)-qv0(k))-(qcl(i,j,k)+qci(i,j,k)-qn0(k)+qpl(i,j,k)+qpi(i,j,k)-qp0(k))) & + +(tabs(i,j,k)-tabs0(k))*(1.+epsv*qv0(k)-qn0(k)-qp0(k)) ) & + + bet(kb)*betd* & + ( tabs0(kb)*(epsv*(qv(i,j,kb)-qv0(kb))-(qcl(i,j,kb)+qci(i,j,kb)-qn0(kb)+qpl(i,j,kb)+qpi(i,j,kb)-qp0(kb))) & + +(tabs(i,j,kb)-tabs0(kb))*(1.+epsv*qv0(kb)-qn0(kb)-qp0(kb)) ) + + end do ! i + end do ! j +end do ! k + +end subroutine buoyancy + + diff --git a/src/physics/spcam/crm/crmx_compress3D.F90 b/src/physics/spcam/crm/crmx_compress3D.F90 new file mode 100644 index 0000000000..a7686880f0 --- /dev/null +++ b/src/physics/spcam/crm/crmx_compress3D.F90 @@ -0,0 +1,165 @@ +subroutine compress3D (f,nx,ny,nz,name, long_name, units, & + savebin, dompi, rank, nsubdomains) + + +! Compress3D: Compresses a given 3D array into the byte-array +! and writes the latter into a file. + +use crmx_grid, only: output_sep + implicit none +! Input: + +integer nx,ny,nz +real f(nx,ny,nz) +character*(*) name,long_name,units +integer rank,rrr,ttt,irank,nsubdomains +logical savebin, dompi + +! Local: + +integer(2), allocatable :: byte(:) +real(kind=selected_real_kind(6)), allocatable :: byte4(:) +integer size,count + +character(10) value_min(nz), value_max(nz) +character(7) form +integer int_fac, integer_max, integer_min +parameter (int_fac=2,integer_min=-32000, integer_max=32000) +! parameter (int_fac=1,integer_min=-127, integer_max=127) +real f_max,f_min, f_max1, f_min1, scale +integer i,j,k,req + + +! Allocate byte array: + +size=nx*ny*nz +if(savebin) then + allocate (byte4(size)) +else + allocate (byte(size)) +end if +count = 0 + +if(savebin) then + + do k=1,nz + do j=1,ny + do i=1,nx + count = count+1 + byte4(count) = f(i,j,k) + end do + end do + end do + + if(rank.eq.0) then + write(46) name,' ',long_name,' ',units + write(46) (byte4(k),k=1,count) + end if + + if(output_sep) then + if(rank.ne.0) write(46) (byte4(k),k=1,count) + else + do irank = 1, nsubdomains-1 + call task_barrier() + if(irank.eq.rank) then + call task_bsend_float(0,byte4,count,irank) + end if + if(rank.eq.0) then + call task_receive_float(byte4,count,req) + call task_wait(req,rrr,ttt) + write(46) (byte4(k),k=1,count) + end if + end do + end if + + deallocate(byte4) + + +else + + + do k=1,nz + + f_max=-1.e30 + f_min= 1.e30 + do j=1,ny + do i=1,nx + f_max = max(f_max,f(i,j,k)) + f_min = min(f_min,f(i,j,k)) + end do + end do + if(dompi) then + f_max1=f_max + f_min1=f_min + call task_max_real(f_max1,f_max,1) + call task_min_real(f_min1,f_min,1) + endif + + if(abs(f_max).lt.10..and.abs(f_min).lt.10.) then + form='(f10.7)' + else if(abs(f_max).lt.100..and.abs(f_min).lt.100.) then + form='(f10.6)' + else if(abs(f_max).lt.1000..and.abs(f_min).lt.1000.) then + form='(f10.5)' + else if(abs(f_max).lt.10000..and.abs(f_min).lt.10000.) then + form='(f10.4)' + else if(abs(f_max).lt.100000..and.abs(f_min).lt.100000.) then + form='(f10.3)' + else if(abs(f_max).lt.1000000..and.abs(f_min).lt.1000000.) then + form='(f10.2)' + else if(abs(f_max).lt.10000000..and.abs(f_min).lt.10000000.) then + form='(f10.1)' + else if(abs(f_max).lt.100000000..and.abs(f_min).lt.100000000.) then + form='(f10.0)' + else + form='(f10.0)' + f_min=-999. + f_max= 999. + end if + + write(value_max(k),form) f_max + write(value_min(k),form) f_min + + scale = float(integer_max-integer_min)/(f_max-f_min+1.e-20) + + do j=1,ny + do i=1,nx + count=count+1 + byte(count)= integer_min+scale*(f(i,j,k)-f_min) + end do + end do + + end do ! k + + if(rank.eq.0) then + write(46) name,' ',long_name,' ',units,' ',value_max,value_min + write(46) (byte(k),k=1,count) + end if + + if(output_sep) then + if(rank.ne.0) write(46) (byte(k),k=1,count) + else + do irank = 1, nsubdomains-1 + call task_barrier() + if(irank.eq.rank) then + call task_send_character(0,byte,int_fac*count,irank,req) + call task_wait(req,rrr,ttt) + end if + if(rank.eq.0) then + call task_receive_character(byte,int_fac*count,req) + call task_wait(req,rrr,ttt) + write(46) (byte(k),k=1,count) + end if + end do + end if + + deallocate(byte) + + +end if ! savebin + + +call task_barrier() + +end subroutine compress3D + diff --git a/src/physics/spcam/crm/crmx_coriolis.F90 b/src/physics/spcam/crm/crmx_coriolis.F90 new file mode 100644 index 0000000000..13b1707b3e --- /dev/null +++ b/src/physics/spcam/crm/crmx_coriolis.F90 @@ -0,0 +1,48 @@ + +subroutine coriolis + +use crmx_vars + +implicit none + +real u_av, v_av, w_av +integer i,j,k,ib,ic,jb,jc,kc + +if(RUN3D) then + +do k=1,nzm + kc=k+1 + do j=1,ny + jb=j-1 + jc=j+1 + do i=1,nx + ib=i-1 + ic=i+1 + v_av=0.25*(v(i,j,k)+v(i,jc,k)+v(ib,j,k)+v(ib,jc,k)) + w_av=0.25*(w(i,j,kc)+w(ib,j,kc)+w(i,j,k)+w(ib,j,k)) + dudt(i,j,k,na)=dudt(i,j,k,na)+fcory(j)*(v_av-vg0(k))-fcorzy(j)*w_av + u_av=0.25*(u(i,j,k)+u(ic,j,k)+u(i,jb,k)+u(ic,jb,k)) + dvdt(i,j,k,na)=dvdt(i,j,k,na)-0.5*(fcory(j)+fcory(jb))*(u_av-ug0(k)) + end do ! i + end do ! j +end do ! k + +else + +do k=1,nzm + kc=k+1 + do j=1,ny + do i=1,nx + ib=i-1 + ic=i+1 + w_av=0.25*(w(i,j,kc)+w(ib,j,kc)+w(i,j,k)+w(ib,j,k)) + dudt(i,j,k,na)=dudt(i,j,k,na)+fcory(j)*(v(i,j,k)-vg0(k))-fcorzy(j)*w_av + dvdt(i,j,k,na)=dvdt(i,j,k,na)-fcory(j)*(u(i,j,k)-ug0(k)) + end do ! i + end do ! i +end do ! k + +endif + +end subroutine coriolis + diff --git a/src/physics/spcam/crm/crmx_crm_module.F90 b/src/physics/spcam/crm/crmx_crm_module.F90 new file mode 100644 index 0000000000..8e7ea7b3aa --- /dev/null +++ b/src/physics/spcam/crm/crmx_crm_module.F90 @@ -0,0 +1,1792 @@ +module crmx_crm_module +!--------------------------------------------------------------- +! Super-parameterization's main driver +! Marat Khairoutdinov, 2001-2009 +!--------------------------------------------------------------- + +use crmx_setparm_mod, only : setparm + +contains + +subroutine crm (lchnk, icol, & + tl, ql, qccl, qiil, ul, vl, & + ps, pmid, pdel, phis, & + zmid, zint, dt_gl, plev, & + qltend, qcltend, qiltend, sltend, & + u_crm, v_crm, w_crm, t_crm, micro_fields_crm, & + qrad_crm, & + qc_crm, qi_crm, qpc_crm, qpi_crm, prec_crm, & + t_rad, qv_rad, qc_rad, qi_rad, cld_rad, cld3d_crm, & +#ifdef m2005 + nc_rad, ni_rad, qs_rad, ns_rad, wvar_crm, & +! hm 7/26/11 new output + aut_crm, acc_crm, evpc_crm, evpr_crm, mlt_crm, & + sub_crm, dep_crm, con_crm, & +! hm 8/31/11 new output for gcm-grid and time-step avg process rates + aut_crm_a, acc_crm_a, evpc_crm_a, evpr_crm_a, mlt_crm_a, & + sub_crm_a, dep_crm_a, con_crm_a, & +#endif + precc, precl, precsc, precsl, & + cltot, clhgh, clmed, cllow, cld, cldtop, & + gicewp, gliqwp, & + mc, mcup, mcdn, mcuup, mcudn, & + crm_qc, crm_qi, crm_qs, crm_qg, crm_qr, & +#ifdef m2005 + crm_nc, crm_ni, crm_ns, crm_ng, crm_nr, & +#ifdef MODAL_AERO + naermod, vaerosol, hygro, & +#endif +#endif +#ifdef SPCAM_CLUBB_SGS + clubb_buffer, & + crm_cld, & + clubb_tk, clubb_tkh, & + relvar, accre_enhan, qclvar, & +#endif + crm_tk, crm_tkh, & + mu_crm, md_crm, du_crm, eu_crm, ed_crm, jt_crm, mx_crm, & +#ifdef ECPP + abnd, abnd_tf, massflxbnd, acen, acen_tf, & + rhcen, qcloudcen, qicecen, qlsinkcen, precrcen, precsolidcen, & + qlsink_bfcen, qlsink_avgcen, praincen, & + wupthresh_bnd, wdownthresh_bnd, & + wwqui_cen, wwqui_bnd, wwqui_cloudy_cen, wwqui_cloudy_bnd, & +#endif + tkez, tkesgsz, tkz, flux_u, flux_v, flux_qt, fluxsgs_qt,flux_qp, & + pflx, qt_ls, qt_trans, qp_trans, qp_fall, & + qp_evp, qp_src, t_ls, prectend, precstend, & + ocnfrac, wndls, tau00, bflxls, & + fluxu00, fluxv00, fluxt00, fluxq00, & + taux_crm, tauy_crm, z0m, timing_factor, qtot) + +! dolong, doshort, nrad0, & +! latitude00, longitude00, day00, pres00, tabs_s0, case0, & +! radlwup0, radlwdn0, radswup0, radswdn0, radqrlw0, radqrsw0, & +! lwnsxy,swnsxy,lwntxy,swntxy,solinxy,lwnscxy,swnscxy,lwntcxy,swntcxy,lwdsxy,swdsxy) + + +!--------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 +#ifdef SPCAM_CLUBB_SGS + use crmdims, only: nclubbvars +#endif + use phys_grid, only: get_rlon_p, get_rlat_p, get_gcol_all_p + use ppgrid, only: pcols + use crmx_vars + use crmx_params + use crmx_microphysics + use crmx_sgs + use crmx_crmtracers +#ifdef MODAL_AERO + use modal_aero_data, only: ntot_amode +#endif +#ifdef SPCAM_CLUBB_SGS + use crmx_clubb_sgs, only: advance_clubb_sgs, clubb_sgs_setup, clubb_sgs_cleanup, & + apply_clubb_sgs_tndcy, apply_clubb_sgs_tndcy_scalars, apply_clubb_sgs_tndcy_mom, & ! Subroutines + t2thetal ! Functions + use crmx_clubb_sgs, only: total_energy + use crmx_clubbvars, only: edsclr_dim, sclr_dim, rho_ds_zt, rho_ds_zm, & + rtm_spurious_source, thlm_spurious_source + use crmx_clubb_precision, only: time_precision + use crmx_clubbvars, only: up2, vp2, wprtp, wpthlp, wp2, wp3, rtp2, thlp2, rtpthlp, & + upwp, vpwp, cloud_frac, t_tndcy, qc_tndcy, qv_tndcy, u_tndcy, v_tndcy, lrestart_clubb + use crmx_clubbvars, only: rho_ds_zt, rho_ds_zm, thv_ds_zt, thv_ds_zm, & + invrs_rho_ds_zt, invrs_rho_ds_zm + use crmx_clubbvars, only: tracer_tndcy, sclrp2, sclrprtp, sclrpthlp, wpsclrp + use crmx_fill_holes, only: vertical_integral ! Function + use crmx_numerical_check, only: calculate_spurious_source + use crmx_grid_class, only: gr ! Variable + use crmx_clubb_precision, only: core_rknd ! Constants + use crmx_clubbvars, only: relvarg, accre_enhang, qclvarg +#endif /*CLUBB_SGS*/ +#ifdef ECPP + use crmx_ecppvars, only: qlsink, precr, precsolid, & + area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, rh_cen_sum, qcloud_cen_sum, qice_cen_sum, & + qlsink_cen_sum, precr_cen_sum, precsolid_cen_sum, xkhvsum, wup_thresh, wdown_thresh, & + wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & + qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum, qlsink_bf, prain + use crmx_module_ecpp_crm_driver, only: ecpp_crm_stat, ecpp_crm_init, ecpp_crm_cleanup, ntavg1_ss, ntavg2_ss + use crmx_ecppvars, only: NCLASS_CL, ncls_ecpp_in, NCLASS_PR +#endif /*ECPP*/ + + use cam_abortutils, only: endrun + use time_manager, only: get_nstep + + implicit none + +! integer, parameter :: r8 = 8 + +! Input: + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: icol ! column identifier + integer, intent(in) :: plev ! number of levels + real(r8), intent(in) :: ps ! Global grid surface pressure (Pa) + real(r8), intent(in) :: pmid(plev) ! Global grid pressure (Pa) + real(r8), intent(in) :: pdel(plev) ! Layer's pressure thickness (Pa) + real(r8), intent(in) :: phis ! Global grid surface geopotential (m2/s2) + real(r8), intent(in) :: zmid(plev) ! Global grid height (m) + real(r8), intent(in) :: zint(plev+1)! Global grid interface height (m) + real(r8), intent(in) :: qrad_crm(crm_nx, crm_ny, crm_nz) ! CRM rad. heating + real(r8), intent(in) :: dt_gl ! global model's time step + real(r8), intent(in) :: ocnfrac ! area fraction of the ocean + real(r8), intent(in) :: tau00 ! large-scale surface stress (N/m2) + real(r8), intent(in) :: wndls ! large-scale surface wind (m/s) + real(r8), intent(in) :: bflxls ! large-scale surface buoyancy flux (K m/s) + real(r8), intent(in) :: fluxu00 ! surface momenent fluxes [N/m2] + real(r8), intent(in) :: fluxv00 ! surface momenent fluxes [N/m2] + real(r8), intent(in) :: fluxt00 ! surface sensible heat fluxes [K Kg/ (m2 s)] + real(r8), intent(in) :: fluxq00 ! surface latent heat fluxes [ kg/(m2 s)] +! logical, intent(in) :: doshort ! compute shortwave radiation +! logical, intent(in) :: dolong ! compute longwave radiation +! real(r8), intent(in) :: day00 ! initial day +! real(r8), intent(in) :: latitude00 +! real(r8), intent(in) :: longitude00 +! real(r8), intent(in) :: pres00 +! real(r8), intent(in) :: tabs_s0 +! integer , intent(in) :: nrad0 +! character *40 case0 ! 8-symbol id-string to identify a case-name + + +! tl, ql, qccl, qiil, ul, vl are not updated in this subroutine, and set to intent(in), but +! not intent(inout). +++mhwang + real(r8), intent(in) :: tl(plev) ! Global grid temperature (K) + real(r8), intent(in) :: ql(plev) ! Global grid water vapor (g/g) + real(r8), intent(in) :: qccl(plev)! Global grid cloud liquid water (g/g) + real(r8), intent(in) :: qiil(plev)! Global grid cloud ice (g/g) + real(r8), intent(in) :: ul(plev) ! Global grid u (m/s) + real(r8), intent(in) :: vl(plev) ! Global grid v (m/s) + +! Input/Output: +#ifdef SPCAM_CLUBB_SGS + real(r8), intent(inout), target :: clubb_buffer(crm_nx, crm_ny, crm_nz+1,1:nclubbvars) + real(r8), intent(inout) :: crm_cld(crm_nx, crm_ny, crm_nz+1) + real(r8), intent(inout) :: clubb_tk(crm_nx, crm_ny, crm_nz) + real(r8), intent(inout) :: clubb_tkh(crm_nx, crm_ny, crm_nz) + real(r8), intent(inout) :: relvar(crm_nx, crm_ny, crm_nz) + real(r8), intent(inout) :: accre_enhan(crm_nx, crm_ny, crm_nz) + real(r8), intent(inout) :: qclvar(crm_nx, crm_ny, crm_nz) +#endif + real(r8), intent(inout) :: crm_tk(crm_nx, crm_ny, crm_nz) + real(r8), intent(inout) :: crm_tkh(crm_nx, crm_ny, crm_nz) + + real(r8), intent(inout) :: cltot ! shaded cloud fraction + real(r8), intent(inout) :: clhgh ! shaded cloud fraction + real(r8), intent(inout) :: clmed ! shaded cloud fraction + real(r8), intent(inout) :: cllow ! shaded cloud fraction + + +! Output + + real(r8), intent(inout) :: sltend(plev) ! tendency of static energy +! real(r8), intent(inout) :: u_crm (:,:,:) ! CRM v-wind component +! real(r8), intent(inout) :: v_crm (:,:,:) ! CRM v-wind component +! real(r8), intent(inout) :: w_crm (:,:,:) ! CRM w-wind component +! real(r8), intent(inout) :: t_crm (:,:,:) ! CRM temperuture + real(r8), intent(inout) :: u_crm (crm_nx,crm_ny,crm_nz) ! CRM v-wind component + real(r8), intent(inout) :: v_crm (crm_nx,crm_ny,crm_nz) ! CRM v-wind component + real(r8), intent(inout) :: w_crm (crm_nx,crm_ny,crm_nz) ! CRM w-wind component + real(r8), intent(inout) :: t_crm (crm_nx,crm_ny,crm_nz) ! CRM temperuture +! real(r8), intent(inout) :: micro_fields_crm (:,:,:,:) ! CRM total water + real(r8), intent(inout) :: micro_fields_crm (crm_nx,crm_ny,crm_nz,nmicro_fields+1) ! CRM total water + real(r8), intent(inout) :: qltend(plev) ! tendency of water vapor + real(r8), intent(inout) :: qcltend(plev)! tendency of cloud liquid water + real(r8), intent(inout) :: qiltend(plev)! tendency of cloud ice + real(r8), intent(inout) :: t_rad (crm_nx, crm_ny, crm_nz) ! rad temperuture + real(r8), intent(inout) :: qv_rad(crm_nx, crm_ny, crm_nz) ! rad vapor + real(r8), intent(inout) :: qc_rad(crm_nx, crm_ny, crm_nz) ! rad cloud water + real(r8), intent(inout) :: qi_rad(crm_nx, crm_ny, crm_nz) ! rad cloud ice + real(r8), intent(inout) :: cld_rad(crm_nx, crm_ny, crm_nz) ! rad cloud fraction + real(r8), intent(inout) :: cld3d_crm(crm_nx, crm_ny, crm_nz) ! instant 3D cloud fraction +#ifdef m2005 + real(r8), intent(inout) :: nc_rad(crm_nx, crm_ny, crm_nz) ! rad cloud droplet number (#/kg) + real(r8), intent(inout) :: ni_rad(crm_nx, crm_ny, crm_nz) ! rad cloud ice crystal number (#/kg) + real(r8), intent(inout) :: qs_rad(crm_nx, crm_ny, crm_nz) ! rad cloud snow (kg/kg) + real(r8), intent(inout) :: ns_rad(crm_nx, crm_ny, crm_nz) ! rad cloud snow crystal number (#/kg) + real(r8), intent(inout) :: wvar_crm(crm_nx, crm_ny, crm_nz) ! vertical velocity variance (m/s) +! hm 7/26/11 new output + real(r8), intent(inout) :: aut_crm(crm_nx, crm_ny, crm_nz) ! cloud water autoconversion (1/s) + real(r8), intent(inout) :: acc_crm(crm_nx, crm_ny, crm_nz) ! cloud water accretion (1/s) + real(r8), intent(inout) :: evpc_crm(crm_nx, crm_ny, crm_nz) ! cloud water evaporation (1/s) + real(r8), intent(inout) :: evpr_crm(crm_nx, crm_ny, crm_nz) ! rain evaporation (1/s) + real(r8), intent(inout) :: mlt_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel melting (1/s) + real(r8), intent(inout) :: sub_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel sublimation (1/s) + real(r8), intent(inout) :: dep_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel deposition (1/s) + real(r8), intent(inout) :: con_crm(crm_nx, crm_ny, crm_nz) ! cloud water condensation(1/s) +! hm 8/31/11 new output, gcm-grid and time step-avg + real(r8), intent(inout) :: aut_crm_a(plev) ! cloud water autoconversion (1/s) + real(r8), intent(inout) :: acc_crm_a(plev) ! cloud water accretion (1/s) + real(r8), intent(inout) :: evpc_crm_a(plev) ! cloud water evaporation (1/s) + real(r8), intent(inout) :: evpr_crm_a(plev) ! rain evaporation (1/s) + real(r8), intent(inout) :: mlt_crm_a(plev) ! ice, snow, graupel melting (1/s) + real(r8), intent(inout) :: sub_crm_a(plev) ! ice, snow, graupel sublimation (1/s) + real(r8), intent(inout) :: dep_crm_a(plev) ! ice, snow, graupel deposition (1/s) + real(r8), intent(inout) :: con_crm_a(plev) ! cloud water condensation(1/s) +#endif + real(r8), intent(inout) :: precc ! convective precip rate (m/s) + real(r8), intent(inout) :: precl ! stratiform precip rate (m/s) + real(r8), intent(inout) :: cld(plev) ! cloud fraction + real(r8), intent(inout) :: cldtop(plev) ! cloud top pdf + real(r8), intent(inout) :: gicewp(plev) ! ice water path + real(r8), intent(inout) :: gliqwp(plev) ! ice water path + real(r8), intent(inout) :: mc(plev) ! cloud mass flux + real(r8), intent(inout) :: mcup(plev) ! updraft cloud mass flux + real(r8), intent(inout) :: mcdn(plev) ! downdraft cloud mass flux + real(r8), intent(inout) :: mcuup(plev) ! unsat updraft cloud mass flux + real(r8), intent(inout) :: mcudn(plev) ! unsat downdraft cloud mass flux + real(r8), intent(inout) :: crm_qc(plev) ! mean cloud water + real(r8), intent(inout) :: crm_qi(plev) ! mean cloud ice + real(r8), intent(inout) :: crm_qs(plev) ! mean snow + real(r8), intent(inout) :: crm_qg(plev) ! mean graupel + real(r8), intent(inout) :: crm_qr(plev) ! mean rain +#ifdef m2005 + real(r8), intent(inout) :: crm_nc(plev) ! mean cloud water (#/kg) + real(r8), intent(inout) :: crm_ni(plev) ! mean cloud ice (#/kg) + real(r8), intent(inout) :: crm_ns(plev) ! mean snow (#/kg) + real(r8), intent(inout) :: crm_ng(plev) ! mean graupel (#/kg) + real(r8), intent(inout) :: crm_nr(plev) ! mean rain (#/kg) +#ifdef MODAL_AERO + real(r8), intent(in) :: naermod(plev, ntot_amode) ! Aerosol number concentration [/m3] + real(r8), intent(in) :: vaerosol(plev, ntot_amode) ! aerosol volume concentration [m3/m3] + real(r8), intent(in) :: hygro(plev, ntot_amode) ! hygroscopicity of aerosol mode +#endif +#endif + real(r8), intent(inout) :: mu_crm (plev) ! mass flux up + real(r8), intent(inout) :: md_crm (plev) ! mass flux down + real(r8), intent(inout) :: du_crm (plev) ! mass detrainment from updraft + real(r8), intent(inout) :: eu_crm (plev) ! mass entrainment from updraft + real(r8), intent(inout) :: ed_crm (plev) ! mass detrainment from downdraft + real(r8) :: dd_crm (plev) ! mass entraiment from downdraft + real(r8), intent(inout) :: jt_crm ! index of cloud (convection) top + real(r8), intent(inout) :: mx_crm ! index of cloud (convection) bottom + real(r8) :: mui_crm (plev+1) ! mass flux up at the interface + real(r8) :: mdi_crm (plev+1) ! mass flux down at the interface + + real(r8), intent(inout) :: flux_qt(plev) ! nonprecipitating water flux [kg/m2/s] + real(r8), intent(inout) :: fluxsgs_qt(plev) ! sgs nonprecipitating water flux [kg/m2/s] + real(r8), intent(inout) :: tkez(plev) ! tke profile [kg/m/s2] + real(r8), intent(inout) :: tkesgsz(plev) ! sgs tke profile [kg/m/s2] + real(r8), intent(inout) :: tkz(plev) ! tk profile [m2/s] + real(r8), intent(inout) :: flux_u(plev) ! x-momentum flux [m2/s2] + real(r8), intent(inout) :: flux_v(plev) ! y-momentum flux [m2/s2] + real(r8), intent(inout) :: flux_qp(plev) ! precipitating water flux [kg/m2/s or mm/s] + real(r8), intent(inout) :: pflx(plev) ! precipitation flux [m/s] + real(r8), intent(inout) :: qt_ls(plev) ! tendency of nonprec water due to large-scale [kg/kg/s] + real(r8), intent(inout) :: qt_trans(plev)! tendency of nonprec water due to transport [kg/kg/s] + real(r8), intent(inout) :: qp_trans(plev) ! tendency of prec water due to transport [kg/kg/s] + real(r8), intent(inout) :: qp_fall(plev) ! tendency of prec water due to fall-out [kg/kg/s] + real(r8), intent(inout) :: qp_src(plev) ! tendency of prec water due to conversion [kg/kg/s] + real(r8), intent(inout) :: qp_evp(plev) ! tendency of prec water due to evp [kg/kg/s] + real(r8), intent(inout) :: t_ls(plev) ! tendency of lwse due to large-scale [kg/kg/s] ??? + real(r8), intent(inout) :: prectend ! column integrated tendency in precipitating water+ice (kg/m2/s) + real(r8), intent(inout) :: precstend ! column integrated tendency in precipitating ice (kg/m2/s) + real(r8), intent(inout) :: precsc ! convective snow rate (m/s) + real(r8), intent(inout) :: precsl ! stratiform snow rate (m/s) + real(r8), intent(inout):: taux_crm ! zonal CRM surface stress perturbation (N/m2) + real(r8), intent(inout):: tauy_crm ! merid CRM surface stress perturbation (N/m2) + real(r8), intent(inout):: z0m ! surface stress (N/m2) + real(r8), intent(inout):: timing_factor ! crm cpu efficiency + real(r8), intent(inout) :: qc_crm (crm_nx, crm_ny, crm_nz)! CRM cloud water + real(r8), intent(inout) :: qi_crm (crm_nx, crm_ny, crm_nz)! CRM cloud ice + real(r8), intent(inout) :: qpc_crm(crm_nx, crm_ny, crm_nz)! CRM precip water + real(r8), intent(inout) :: qpi_crm(crm_nx, crm_ny, crm_nz)! CRM precip ice + real(r8), intent(inout) :: prec_crm(crm_nx, crm_ny)! CRM precipiation rate +#ifdef ECPP +! at layer center + real(r8), intent(inout) :: acen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for each sub-sub class for full time period + real(r8), intent(inout) :: acen_tf(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for end-portion of time period + real(r8), intent(inout) :: rhcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! relative humidity (0-1) + real(r8), intent(inout) :: qcloudcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water (kg/kg) + real(r8), intent(inout) :: qicecen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud ice (kg/kg) + real(r8), intent(inout) :: qlsinkcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation (/s??) + real(r8), intent(inout) :: precrcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! liquid (rain) precipitation rate (kg/m2/s) + real(r8), intent(inout) :: precsolidcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! solid (rain) precipitation rate (kg/m2/s) + real(r8), intent(inout) :: qlsink_bfcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation calculated + ! cloud water before precipitatinog (/s) + real(r8), intent(inout) :: qlsink_avgcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation calculated + ! from praincen and qlcoudcen averaged over + ! ntavg1_ss time step (/s??) + real(r8), intent(inout) :: praincen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation (kg/kg/s) + real(r8), intent(inout) :: wwqui_cen(plev) ! vertical velocity variance in quiescent class (m2/s2) + real(r8), intent(inout) :: wwqui_cloudy_cen(plev) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) +! at layer boundary + real(r8), intent(inout) :: abnd(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for each sub-sub class for full time period + real(r8), intent(inout) :: abnd_tf(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for end-portion of time period + real(r8), intent(inout) :: massflxbnd(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. + real(r8), intent(inout) :: wupthresh_bnd(plev+1) ! vertical velocity threshold for updraft (m/s) + real(r8), intent(inout) :: wdownthresh_bnd(plev+1) ! vertical velocity threshold for downdraft (m/s) + real(r8), intent(inout) :: wwqui_bnd(plev+1) ! vertical velocity variance in quiescent class (m2/s2) + real(r8), intent(inout) :: wwqui_cloudy_bnd(plev+1) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) +#endif + +! Local space: + real dummy(nz), t00(nz) + real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss + real tln(plev), qln(plev), qccln(plev), qiiln(plev), uln(plev), vln(plev) + real cwp(nx,ny), cwph(nx,ny), cwpm(nx,ny), cwpl(nx,ny) + real(r8) factor_xy, idt_gl + real tmp1, tmp2 + real u2z,v2z,w2z + integer i,j,k,l,ptop,nn,icyc, nstatsteps + integer kx + real(r8), parameter :: umax = 0.5*crm_dx/crm_dt ! maxumum ampitude of the l.s. wind + real(r8), parameter :: wmin = 2. ! minimum up/downdraft velocity for stat + real, parameter :: cwp_threshold = 0.001 ! threshold for cloud condensate for shaded fraction calculation + logical flag_top(nx,ny) + real ustar, bflx, wnd, z0_est, qsat, omg + real colprec,colprecs + real(r8) zs ! surface elevation + integer igstep ! GCM time steps + integer iseed ! seed for random perturbation + integer gcolindex(pcols) ! array of global latitude indices + +#ifdef SPCAM_CLUBB_SGS +!Array indicies for spurious RTM check + +real(kind=core_rknd) :: & + rtm_integral_before(nx,ny), rtm_integral_after(nx,ny), rtm_flux_top, rtm_flux_sfc +real(kind=core_rknd) :: & + thlm_integral_before(nx,ny), thlm_integral_after(nx,ny), thlm_before(nzm), thlm_after(nzm), & + thlm_flux_top, thlm_flux_sfc + +real(kind=core_rknd), dimension(nzm) :: & + rtm_column ! Total water (vapor + liquid) [kg/kg] +#endif + + real cltemp(nx,ny), cmtemp(nx,ny), chtemp(nx, ny), cttemp(nx, ny) + + real(r8), intent(inout) :: qtot(20) + real ntotal_step + +!----------------------------------------------- + + dostatis = .false. ! no statistics are collected. + idt_gl = 1._r8/dt_gl + ptop = plev-nzm+1 + factor_xy = 1._r8/dble(nx*ny) + dummy = 0. + t_rad = 0. + qv_rad = 0. + qc_rad = 0. + qi_rad = 0. + cld_rad = 0. +#ifdef m2005 + nc_rad = 0.0 + ni_rad = 0.0 + qs_rad = 0.0 + ns_rad = 0.0 +#endif + zs=phis/ggr + bflx = bflxls + wnd = wndls + +!----------------------------------------- + igstep = get_nstep() + +#ifdef SPCAM_CLUBB_SGS + if(igstep == 1) then + lrestart_clubb = .false. + else + lrestart_clubb = .true. + endif +#endif + + call task_init () + + call setparm() + +! doshortwave = doshort +! dolongwave = dolong +! day0 = day00-dt_gl/86400. +! latitude = latitude00 +! longitude = longitude00 +! pres0 = pres00 +! tabs_s = tabs_s0 +! case = case0 + + latitude0 = get_rlat_p(lchnk, icol)*57.296_r8 + longitude0 = get_rlon_p(lchnk, icol)*57.296_r8 +! pi = acos(-1.) + if(fcor.eq.-999.) fcor= 4*pi/86400.*sin(latitude0*pi/180.) + fcorz = sqrt(4.*(2*pi/(3600.*24.))**2-fcor**2) + fcory(:) = fcor + fcorzy(:) = fcorz + do j=1,ny + do i=1,nx + latitude(i,j) = latitude0 + longitude(i,j) = longitude0 + end do + end do + + if(ocnfrac.gt.0.5) then + OCEAN = .true. + else + LAND = .true. + end if + +! create CRM vertical grid and initialize some vertical reference arrays: +! + do k = 1, nzm + + z(k) = zmid(plev-k+1) - zint(plev+1) + zi(k) = zint(plev-k+2)- zint(plev+1) + pres(k) = pmid(plev-k+1)/100. + prespot(k)=(1000./pres(k))**(rgas/cp) + bet(k) = ggr/tl(plev-k+1) + gamaz(k)=ggr/cp*z(k) + + end do ! k +! zi(nz) = zint(plev-nz+2) + zi(nz) = zint(plev-nz+2)-zint(plev+1) !+++mhwang, 2012-02-04 + + dz = 0.5*(z(1)+z(2)) + do k=2,nzm + adzw(k) = (z(k)-z(k-1))/dz + end do + adzw(1) = 1. + adzw(nz) = adzw(nzm) +! adz(1) = 1. +! do k=2,nzm-1 +! adz(k) = 0.5*(z(k+1)-z(k-1))/dz +! end do +! adz(nzm) = adzw(nzm) +!+++mhwang fix the adz bug. (adz needs to be consistent with zi) +!2012-02-04 Minghuai Wang (minghuai.wang@pnnl.gov) + do k=1, nzm + adz(k)=(zi(k+1)-zi(k))/dz + end do + + do k = 1,nzm + rho(k) = pdel(plev-k+1)/ggr/(adz(k)*dz) + end do + do k=2,nzm +! rhow(k) = 0.5*(rho(k)+rho(k-1)) +!+++mhwang fix the rhow bug (rhow needes to be consistent with pmid) +!2012-02-04 Minghuai Wang (minghuai.wang@pnnl.gov) + rhow(k) = (pmid(plev-k+2)-pmid(plev-k+1))/ggr/(adzw(k)*dz) + end do + rhow(1) = 2*rhow(2) - rhow(3) +#ifdef SPCAM_CLUBB_SGS /* Fix extropolation for 30 point grid */ + if ( 2*rhow(nzm) - rhow(nzm-1) > 0. ) then + rhow(nz)= 2*rhow(nzm) - rhow(nzm-1) + else + rhow(nz)= sqrt( rhow(nzm) ) + endif +#else + rhow(nz)= 2*rhow(nzm) - rhow(nzm-1) +#endif /*CLUBB_SGS*/ + colprec=0 + colprecs=0 + +! +! Initialize: +! + + +! limit the velocity at the very first step: + + if(u_crm(1,1,1).eq.u_crm(2,1,1).and.u_crm(3,1,2).eq.u_crm(4,1,2)) then + do k=1,nzm + do j=1,ny + do i=1,nx + u_crm(i,j,k) = min( umax, max(-umax,u_crm(i,j,k)) ) + v_crm(i,j,k) = min( umax, max(-umax,v_crm(i,j,k)) )*YES3D + end do + end do + end do + + end if + + u(1:nx,1:ny,1:nzm) = u_crm(1:nx,1:ny,1:nzm) + v(1:nx,1:ny,1:nzm) = v_crm(1:nx,1:ny,1:nzm)*YES3D + w(1:nx,1:ny,1:nzm) = w_crm(1:nx,1:ny,1:nzm) + tabs(1:nx,1:ny,1:nzm) = t_crm(1:nx,1:ny,1:nzm) + micro_field(1:nx,1:ny,1:nzm,1:nmicro_fields) = micro_fields_crm(1:nx,1:ny,1:nzm,1:nmicro_fields) +#ifdef sam1mom + qn(1:nx,1:ny,1:nzm) = micro_fields_crm(1:nx,1:ny,1:nzm,3) +#endif + +#ifdef m2005 + cloudliq(1:nx,1:ny,1:nzm) = micro_fields_crm(1:nx,1:ny,1:nzm,11) +#endif + +#ifdef m2005 + do k=1, nzm +#ifdef MODAL_AERO +! set aerosol data + l=plev-k+1 + naer(k, 1:ntot_amode) = naermod(l, 1:ntot_amode) + vaer(k, 1:ntot_amode) = vaerosol(l, 1:ntot_amode) + hgaer(k, 1:ntot_amode) = hygro(l, 1:ntot_amode) +#endif + do j=1, ny + do i=1, nx +! if(micro_field(i,j,k,iqcl).gt.0) then + if(cloudliq(i,j,k).gt.0) then + if(dopredictNc) then + if( micro_field(i,j,k,incl).eq.0) micro_field(i,j,k,incl) = 1.0e6*Nc0/rho(k) + endif + end if + enddo + enddo + enddo +#endif + + w(:,:,nz)=0. + wsub (:) = 0. !used in clubb, +++mhwang + dudt(:,:,:,1:3) = 0. + dvdt(:,:,:,1:3) = 0. + dwdt(1:nx,1:ny,1:nz,1:3) = 0. + tke(1:nx,1:ny,1:nzm) = 0. + tk(1:nx,1:ny,1:nzm) = 0. + tkh(1:nx,1:ny,1:nzm) = 0. + p(1:nx,1:ny,1:nzm) = 0. + + CF3D(1:nx,1:ny,1:nzm) = 1. + + call micro_init + +! initialize sgs fields + call sgs_init + + do k=1,nzm + + u0(k)=0. + v0(k)=0. + t0(k)=0. + t00(k)=0. + tabs0(k)=0. + q0(k)=0. + qv0(k)=0. +!+++mhwang these are not initialized ?? + qn0(k) = 0.0 + qp0(k) = 0.0 + tke0(k) = 0.0 +!---mhwang + do j=1,ny + do i=1,nx + + t(i,j,k) = tabs(i,j,k)+gamaz(k) & + -fac_cond*qcl(i,j,k)-fac_sub*qci(i,j,k) & + -fac_cond*qpl(i,j,k)-fac_sub*qpi(i,j,k) + + colprec=colprec+(qpl(i,j,k)+qpi(i,j,k))*pdel(plev-k+1) + colprecs=colprecs+qpi(i,j,k)*pdel(plev-k+1) + u0(k)=u0(k)+u(i,j,k) + v0(k)=v0(k)+v(i,j,k) + t0(k)=t0(k)+t(i,j,k) + t00(k)=t00(k)+t(i,j,k)+fac_cond*qpl(i,j,k)+fac_sub*qpi(i,j,k) + tabs0(k)=tabs0(k)+tabs(i,j,k) + q0(k)=q0(k)+qv(i,j,k)+qcl(i,j,k)+qci(i,j,k) + qv0(k) = qv0(k) + qv(i,j,k) + qn0(k) = qn0(k) + qcl(i,j,k) + qci(i,j,k) + qp0(k) = qp0(k) + qpl(i,j,k) + qpi(i,j,k) + tke0(k)=tke0(k)+tke(i,j,k) + + end do + end do + + u0(k) = u0(k) * factor_xy + v0(k) = v0(k) * factor_xy + t0(k) = t0(k) * factor_xy + t00(k) = t00(k) * factor_xy + tabs0(k) = tabs0(k) * factor_xy + q0(k) = q0(k) * factor_xy + qv0(k) = qv0(k) * factor_xy + qn0(k) = qn0(k) * factor_xy + qp0(k) = qp0(k) * factor_xy + tke0(k) = tke0(k) * factor_xy + +#ifdef SPCAM_CLUBB_SGS + ! Update thetav for CLUBB. This is needed when we have a higher model top + ! than is in the sounding, because we subsequently use tv0 to initialize + ! thv_ds_zt/zm, which appear in CLUBB's anelastic buoyancy terms. + ! -dschanen UWM 11 Feb 2010 + tv0(k) = tabs0(k)*prespot(k)*(1.+epsv*q0(k)) +#endif + + l = plev-k+1 + uln(l) = min( umax, max(-umax,ul(l)) ) + vln(l) = min( umax, max(-umax,vl(l)) )*YES3D + ttend(k) = (tl(l)+gamaz(k)- & + fac_cond*(qccl(l)+qiil(l))-fac_fus*qiil(l)-t00(k))*idt_gl + qtend(k) = (ql(l)+qccl(l)+qiil(l)-q0(k))*idt_gl + utend(k) = (uln(l)-u0(k))*idt_gl + vtend(k) = (vln(l)-v0(k))*idt_gl + ug0(k) = uln(l) + vg0(k) = vln(l) + tg0(k) = tl(l)+gamaz(k)-fac_cond*qccl(l)-fac_sub*qiil(l) + qg0(k) = ql(l)+qccl(l)+qiil(l) + + end do ! k + + uhl = u0(1) + vhl = v0(1) + +! estimate roughness length assuming logarithmic profile of velocity near the surface: + + ustar = sqrt(tau00/rho(1)) + z0 = z0_est(z(1),bflx,wnd,ustar) + z0 = max(0.00001,min(1.,z0)) + + timing_factor = 0. + + prectend=colprec + precstend=colprecs + +#ifdef SPCAM_CLUBB_SGS + if(doclubb) then + fluxbu(:, :) = fluxu00/rhow(1) + fluxbv(:, :) = fluxv00/rhow(1) + fluxbt(:, :) = fluxt00/rhow(1) + fluxbq(:, :) = fluxq00/rhow(1) + else + fluxbu(:, :) = 0. + fluxbv(:, :) = 0. + fluxbt(:, :) = 0. + fluxbq(:, :) = 0. + end if +#else + fluxbu=0. + fluxbv=0. + fluxbt=0. + fluxbq=0. +#endif /*CLUBB_SGS*/ + + fluxtu=0. + fluxtv=0. + fluxtt=0. + fluxtq=0. + fzero =0. + precsfc=0. + precssfc=0. + +!--------------------------------------------------- + cld = 0. + cldtop = 0. + gicewp=0 + gliqwp=0 + mc = 0. + mcup = 0. + mcdn = 0. + mcuup = 0. + mcudn = 0. + crm_qc = 0. + crm_qi = 0. + crm_qs = 0. + crm_qg = 0. + crm_qr = 0. +#ifdef m2005 + crm_nc = 0. + crm_ni = 0. + crm_ns = 0. + crm_ng = 0. + crm_nr = 0. +! hm 8/31/11 add new variables + aut_crm_a = 0. + acc_crm_a = 0. + evpc_crm_a = 0. + evpr_crm_a = 0. + mlt_crm_a = 0. + sub_crm_a = 0. + dep_crm_a = 0. + con_crm_a = 0. + +! hm 8/31/11 add new output +! these are increments added to calculate gcm-grid and time-step avg +! note - these values are also averaged over the icycle loop following +! the approach for precsfc + aut1a = 0. + acc1a = 0. + evpc1a = 0. + evpr1a = 0. + mlt1a = 0. + sub1a = 0. + dep1a = 0. + con1a = 0. + +#endif + + mu_crm = 0. + md_crm = 0. + eu_crm = 0. + du_crm = 0. + ed_crm = 0. + dd_crm = 0. + jt_crm = 0. + mx_crm = 0. + + mui_crm = 0. + mdi_crm = 0. + + flux_qt = 0. + flux_u = 0. + flux_v = 0. + fluxsgs_qt = 0. + tkez = 0. + tkesgsz = 0. + tkz = 0. + flux_qp = 0. + pflx = 0. + qt_trans = 0. + qp_trans = 0. + qp_fall = 0. + qp_evp = 0. + qp_src = 0. + qt_ls = 0. + t_ls = 0. + + uwle = 0. + uwsb = 0. + vwle = 0. + vwsb = 0. + qpsrc = 0. + qpevp = 0. + qpfall = 0. + precflux = 0. + + prec_xy = 0.0 + total_water_evap = 0.0 + total_water_prec = 0.0 + tlat = 0.0 + pw_xy = 0.0; cw_xy=0.0; iw_xy = 0.0 + usfc_xy = 0.0; vsfc_xy =0.0; u200_xy =0.0; v200_xy = 0.0; w500_xy = 0.0 + swvp_xy = 0.0; psfc_xy = 0.0; u850_xy = 0.0; v850_xy = 0.0 + +!-------------------------------------------------- +#ifdef sam1mom + if(doprecip) call precip_init() +#endif + + call get_gcol_all_p(lchnk, pcols, gcolindex) + iseed = gcolindex(icol) + if(u(1,1,1).eq.u(2,1,1).and.u(3,1,2).eq.u(4,1,2)) & + call setperturb(iseed) + +#ifndef SPCAM_CLUBB_SGS +!-------------------------- +! do a CLUBB sanity check + if ( doclubb .or. doclubbnoninter ) then + write(0,*) "Cannot call CLUBB if -DCLUBB is not in FFLAGS" + call endrun('crm main') + end if +#endif /*CLUBB_SGS*/ +#ifdef SPCAM_CLUBB_SGS +!------------------------------------------------------------------ +! Do initialization for UWM CLUBB +!------------------------------------------------------------------ + up2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 1) + vp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 2) + wprtp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 3) + wpthlp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 4) + wp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 5) + wp3(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 6) + rtp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 7) + thlp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 8) + rtpthlp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 9) + upwp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 10) + vpwp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 11) + cloud_frac(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 12) + t_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 13) + qc_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 14) + qv_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 15) + u_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 16) + v_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 17) + +! +! since no tracer is carried in the current version of MMF, these +! tracer-related restart varialbes are set to zero. +++mhwang, 2011-08 + tracer_tndcy = 0.0 + sclrp2 = 0.0 + sclrprtp = 0.0 + sclrpthlp = 0.0 + wpsclrp =0.0 + + if((doclubb.and.docloud).or.(.not.doclubb .and. .not.docloud)) then + write(0, *) 'doclubb and docloud can not both be true or be false' + call endrun('crm_clubb2') + end if + if((doclubb_sfc_fluxes.and.docam_sfc_fluxes)) then + write(0, *) 'doclubb_sfc_fluxes and dosam_sfc_fluxes can not both be true' + call endrun('crm_clubb_fluxes') + end if + + if ( doclubb .or. doclubbnoninter ) then + call clubb_sgs_setup( real( dt*real( nclubb ), kind=time_precision), & + latitude, longitude, z, rho, zi, rhow, tv0, tke ) + end if +#endif /*CLUBB_SGS*/ + +#ifdef ECPP +! ntavg1_ss = dt_gl/3 ! one third of GCM time step, 10 minutes + ntavg1_ss = min(600._r8, dt_gl) ! 10 minutes or the GCM timestep, whichever smaller + ! ntavg1_ss = number of seconds to average between computing categories. + ntavg2_ss = dt_gl ! GCM time step + ! ntavg2_ss = number of seconds to average between outputs. + ! This must be a multiple of ntavgt1_ss. +! +! ecpp_crm_init has to be called after ntavg1_ss and ntavg2_ss are set for +! their values are used in ecpp_crm_init. + call ecpp_crm_init() + + qlsink = 0.0 + qlsink_bf = 0.0 + prain = 0.0 + precr = 0.0 + precsolid = 0.0 +#endif /*ECPP*/ + +!+++mhwangtest +! test water conservtion problem + ntotal_step = 0.0 + qtot(:) = 0.0 + qtotmicro(:) = 0.0 + do k=1, nzm + l=plev-k+1 + do j=1, ny + do i=1, nx +#ifdef m2005 + qtot(1) = qtot(1)+((micro_field(i,j,k,iqr)+micro_field(i,j,k,iqs)+micro_field(i,j,k,iqg)) * pdel(l)/ggr)/(nx*ny) +#endif +#ifdef sam1mom + qtot(1) = qtot(1)+(qpl(i,j,k)+qpi(i,j,k)) * pdel(l)/ggr/(nx*ny) +#endif + enddo + enddo + qtot(1) = qtot(1) + (ql(l)+qccl(l)+qiil(l)) * pdel(l)/ggr + enddo +!---mhwangtest + + nstop = dt_gl/dt + dt = dt_gl/nstop + nsave3D = nint(60/dt) +! if(nint(nsave3D*dt).ne.60)then +! print *,'CRM: time step=',dt,' is not divisible by 60 seconds' +! print *,'this is needed for output every 60 seconds' +! stop +! endif + nstep = 0 + nprint = 1 + ncycle = 0 +! nrad = nstop/nrad0 + day=day0 + +!------------------------------------------------------------------ +! Main time loop +!------------------------------------------------------------------ + +do while(nstep.lt.nstop) + + nstep = nstep + 1 + time = time + dt + day = day0 + time/86400. + timing_factor = timing_factor+1 +!------------------------------------------------------------------ +! Check if the dynamical time step should be decreased +! to handle the cases when the flow being locally linearly unstable +!------------------------------------------------------------------ + + ncycle = 1 + + call kurant() + + do icyc=1,ncycle + + icycle = icyc + dtn = dt/ncycle + dt3(na) = dtn + dtfactor = dtn/dt + +!--------------------------------------------- +! the Adams-Bashforth scheme in time + + call abcoefs() + +!--------------------------------------------- +! initialize stuff: + + call zero() + +!----------------------------------------------------------- +! Buoyancy term: + + call buoyancy() + +!+++mhwangtest +! test water conservtion problem + ntotal_step = ntotal_step + 1. +!---mhwangtest + +!------------------------------------------------------------ +! Large-scale and surface forcing: + + call forcing() + + do k=1,nzm + do j=1,ny + do i=1,nx + t(i,j,k) = t(i,j,k) + qrad_crm(i,j,k)*dtn + end do + end do + end do + +!---------------------------------------------------------- +! suppress turbulence near the upper boundary (spange): + + if(dodamping) call damping() + +!--------------------------------------------------------- +! Ice fall-out + +#ifdef SPCAM_CLUBB_SGS + if ( docloud .or. doclubb ) then + call ice_fall() + end if +#else + if(docloud) then + call ice_fall() + end if +#endif /*CLUBB_SGS*/ + +!---------------------------------------------------------- +! Update scalar boundaries after large-scale processes: + + call boundaries(3) + +!--------------------------------------------------------- +! Update boundaries for velocities: + + call boundaries(0) + +!----------------------------------------------- +! surface fluxes: + + if(dosurface) call crmsurface(bflx) + +!----------------------------------------------------------- +! SGS physics: + + if (dosgs) call sgs_proc() + +#ifdef CLUBB_CRM_OLD +!---------------------------------------------------------- +! Do a timestep with CLUBB if enabled: +! -dschanen UWM 16 May 2008 + + if ( doclubb .or. doclubbnoninter ) then + ! In case of ice fall, we recompute qci here for the + ! single-moment scheme. Also, subsidence, diffusion and advection have + ! been applied to micro_field but not qv/qcl so they must be updated. + call micro_update() + end if ! doclubb .or. doclubbnoninter + + if ( doclubb ) then + ! Calculate the vertical integrals for RTM and THLM so we can later + ! calculate whether CLUBB is a spurious source or sink of either. + ! - nielsenb UWM 4 Jun 2010 + do i = 1,nx + do j = 1,ny + rtm_column = qv(i,j,1:nzm) + qcl(i,j,1:nzm) + rtm_integral_before(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & + rtm_column, gr%invrs_dzt(2:nz) ) + + thlm_before = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & + qcl(i,j,1:nzm), qpl(i,j,1:nzm), & + qci(i,j,1:nzm), qpi(i,j,1:nzm), & + prespot(1:nzm) ) + + thlm_integral_before(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & + thlm_before(1:nzm), gr%invrs_dzt(2:nz) ) + end do + end do + ! End vertical integral + + end if ! doclubb + + if ( doclubb .or. doclubbnoninter ) then + + ! We call CLUBB here because adjustments to the wind + ! must occur prior to adams() -dschanen 26 Aug 2008 + ! Here we call clubb only if nstep divides the current timestep, + ! or we're on the very first timestep + if ( nstep == 1 .or. mod( nstep, nclubb ) == 0 ) then + + call advance_clubb_sgs & + ( real( dtn*real( nclubb ), kind=time_precision), & ! in + real( 0., kind=time_precision ), & ! in + real( time, kind=time_precision ), & ! in + rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in + t, qv, qcl ) ! in + end if ! nstep == 1 .or. mod( nstep, nclubb) == 0 + + end if ! doclubb .or. doclubbnoninter + +#endif /*CLUBB_CRM_OLD*/ +!---------------------------------------------------------- +! Fill boundaries for SGS diagnostic fields: + + call boundaries(4) +!----------------------------------------------- +! advection of momentum: + + call advect_mom() + +!---------------------------------------------------------- +! SGS effects on momentum: + + if(dosgs) call sgs_mom() +#ifdef CLUBB_CRM_OLD + if ( doclubb ) then +! call apply_clubb_sgs_tndcy_mom & +! ( dudt, dvdt ) ! in/out + endif +#endif /*CLUBB_CRM_OLD*/ + +!----------------------------------------------------------- +! Coriolis force: + + if(docoriolis) call coriolis() + +!--------------------------------------------------------- +! compute rhs of the Poisson equation and solve it for pressure. + + call pressure() + +!--------------------------------------------------------- +! find velocity field at n+1/2 timestep needed for advection of scalars: +! Note that at the end of the call, the velocities are in nondimensional form. + + call adams() + +!---------------------------------------------------------- +! Update boundaries for all prognostic scalar fields for advection: + + call boundaries(2) + +!--------------------------------------------------------- +! advection of scalars : + + call advect_all_scalars() + +!----------------------------------------------------------- +! Convert velocity back from nondimensional form: + + call uvw() + +!---------------------------------------------------------- +! Update boundaries for scalars to prepare for SGS effects: + + call boundaries(3) + +!--------------------------------------------------------- +! SGS effects on scalars : + + if (dosgs) call sgs_scalars() + +#ifdef CLUBB_CRM_OLD + ! Re-compute q/qv/qcl based on values computed in CLUBB + if ( doclubb ) then + + ! Recalculate q, qv, qcl based on new micro_fields (updated by horizontal + ! diffusion) + call micro_update() + + ! Then Re-compute q/qv/qcl based on values computed in CLUBB + call apply_clubb_sgs_tndcy_scalars & + ( real( dtn, kind=time_precision), & ! in + t, qv, qcl) ! in/out + + call micro_adjust( qv, qcl ) ! in + + ! Calculate the vertical integrals for RTM and THLM again so + ! calculate whether CLUBB is a spurious source or sink of either. + ! - nielsenb UWM 4 Jun 2010 + do i = 1,nx + do j = 1,ny + rtm_flux_top = rho_ds_zm(nz) * wprtp(i,j,nz) + rtm_flux_sfc = rho_ds_zm(1) * fluxbq(i,j) + rtm_column = qv(i,j,1:nzm) + qcl(i,j,1:nzm) + rtm_integral_after(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & + rtm_column, gr%invrs_dzt(2:nz) ) + + rtm_spurious_source(i,j) = calculate_spurious_source( rtm_integral_after(i,j), & + rtm_integral_before(i,j), & + rtm_flux_top, rtm_flux_sfc, & + 0.0_core_rknd, real( dtn, kind=core_rknd) ) + + thlm_flux_top = rho_ds_zm(nz) * wpthlp(i,j,nz) + thlm_flux_sfc = rho_ds_zm(1) * fluxbt(i,j) + + thlm_after = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & + qcl(i,j,1:nzm), qpl(i,j,1:nzm), & + qci(i,j,1:nzm), qpi(i,j,1:nzm), & + prespot(1:nzm) ) + + thlm_integral_after(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & + thlm_after(1:nzm), gr%invrs_dzt(2:nz)) + + thlm_spurious_source(i,j) = calculate_spurious_source( thlm_integral_after(i,j), & + thlm_integral_before(i,j), & + thlm_flux_top, thlm_flux_sfc, & + 0.0_core_rknd, real( dtn, kind=core_rknd )) + end do + end do + ! End spurious source calculation + + end if! doclubb +#endif /*CLUBB_CRM_OLD*/ + +!----------------------------------------------------------- +! Cloud condensation/evaporation and precipitation processes: +#ifdef SPCAM_CLUBB_SGS + if(docloud.or.dosmoke.or.doclubb) call micro_proc() +#else + if(docloud.or.dosmoke) call micro_proc() +#endif /*CLUBB_SGS*/ + +!----------------------------------------------------------- +! Compute diagnostics fields: + + call diagnose() + +!---------------------------------------------------------- +! Rotate the dynamic tendency arrays for Adams-bashforth scheme: + + nn=na + na=nc + nc=nb + nb=nn + + end do ! icycle + +!---------------------------------------------------------- +!---------------------------------------------------------- +#ifdef ECPP +! Here ecpp_crm_stat is called every CRM time step (dt), not every subcycle time step (dtn). +! This is what the original MMF model did (t_rad, qv_rad, ...). Do we want to call ecpp_crm_stat +! every subcycle time step??? +++mhwang + call ecpp_crm_stat() +#endif /*ECPP*/ + + cwp = 0. + cwph = 0. + cwpm = 0. + cwpl = 0. + + flag_top(:,:) = .true. + + cltemp = 0.0; cmtemp = 0.0 + chtemp = 0.0; cttemp = 0.0 + + do k=1,nzm + l = plev-k+1 + do j=1,ny + do i=1,nx + +! hm modify 9/7/11 for end of timestep, GCM-grid scale hydrometeor output +! instead of time-step-averaged +! I also modified this for all q and N variables as well as for sam1mom +! for consistency +!hm crm_qc(l) = crm_qc(l) + qcl(i,j,k) +!hm crm_qi(l) = crm_qi(l) + qci(i,j,k) +!hm crm_qr(l) = crm_qr(l) + qpl(i,j,k) +!hm#ifdef sam1mom +!hm omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) +!hm crm_qg(l) = crm_qg(l) + qpi(i,j,k)*omg +!hm crm_qs(l) = crm_qs(l) + qpi(i,j,k)*(1.-omg) +!hm#else +! crm_qg(l) = crm_qg(l) + qpi(i,j,k) +! crm_qs(l) = crm_qs(l) + 0. ! temporerary solution +!hm crm_qg(l) = crm_qg(l) + micro_field(i,j,k,iqg) +!hm crm_qs(l) = crm_qs(l) + micro_field(i,j,k,iqs) + +!hm crm_nc(l) = crm_nc(l) + micro_field(i,j,k,incl) +!hm crm_ni(l) = crm_ni(l) + micro_field(i,j,k,inci) +!hm crm_nr(l) = crm_nr(l) + micro_field(i,j,k,inr) +!hm crm_ng(l) = crm_ng(l) + micro_field(i,j,k,ing) +!hm crm_ns(l) = crm_ns(l) + micro_field(i,j,k,ins) + +!hm#endif + + tmp1 = rho(nz-k)*adz(nz-k)*dz*(qcl(i,j,nz-k)+qci(i,j,nz-k)) + cwp(i,j) = cwp(i,j)+tmp1 + cttemp(i,j) = max(CF3D(i,j,nz-k), cttemp(i,j)) + if(cwp(i,j).gt.cwp_threshold.and.flag_top(i,j)) then + cldtop(k) = cldtop(k) + 1 + flag_top(i,j) = .false. + end if + if(pres(nz-k).ge.700.) then + cwpl(i,j) = cwpl(i,j)+tmp1 + cltemp(i,j) = max(CF3D(i,j,nz-k), cltemp(i,j)) + else if(pres(nz-k).lt.400.) then + cwph(i,j) = cwph(i,j)+tmp1 + chtemp(i,j) = max(CF3D(i,j,nz-k), chtemp(i,j)) + else + cwpm(i,j) = cwpm(i,j)+tmp1 + cmtemp(i,j) = max(CF3D(i,j,nz-k), cmtemp(i,j)) + end if + + ! qsat = qsatw_crm(tabs(i,j,k),pres(k)) + ! if(qcl(i,j,k)+qci(i,j,k).gt.min(1.e-5,0.01*qsat)) then + tmp1 = rho(k)*adz(k)*dz + if(tmp1*(qcl(i,j,k)+qci(i,j,k)).gt.cwp_threshold) then + cld(l) = cld(l) + CF3D(i,j,k) + if(w(i,j,k+1)+w(i,j,k).gt.2*wmin) then + mcup(l) = mcup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * CF3D(i,j,k) + mcuup(l) = mcuup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * (1.0 - CF3D(i,j,k)) + end if + if(w(i,j,k+1)+w(i,j,k).lt.-2*wmin) then + mcdn(l) = mcdn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * CF3D(i,j,k) + mcudn(l) = mcudn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * (1. - CF3D(i,j,k)) + end if + else + if(w(i,j,k+1)+w(i,j,k).gt.2*wmin) then + mcuup(l) = mcuup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) + end if + if(w(i,j,k+1)+w(i,j,k).lt.-2*wmin) then + mcudn(l) = mcudn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) + end if + end if + + t_rad (i,j,k) = t_rad (i,j,k)+tabs(i,j,k) + qv_rad(i,j,k) = qv_rad(i,j,k)+max(0.,qv(i,j,k)) + qc_rad(i,j,k) = qc_rad(i,j,k)+qcl(i,j,k) + qi_rad(i,j,k) = qi_rad(i,j,k)+qci(i,j,k) + cld_rad(i,j,k) = cld_rad(i,j,k) + CF3D(i,j,k) +#ifdef m2005 + nc_rad(i,j,k) = nc_rad(i,j,k)+micro_field(i,j,k,incl) + ni_rad(i,j,k) = ni_rad(i,j,k)+micro_field(i,j,k,inci) + qs_rad(i,j,k) = qs_rad(i,j,k)+micro_field(i,j,k,iqs) + ns_rad(i,j,k) = ns_rad(i,j,k)+micro_field(i,j,k,ins) +#endif + gliqwp(l)=gliqwp(l)+qcl(i,j,k) + gicewp(l)=gicewp(l)+qci(i,j,k) + + end do + end do + end do + +! Diagnose mass fluxes to drive CAM's convective transport of tracers. +! definition of mass fluxes is taken from Xu et al., 2002, QJRMS. + do k=1, nzm+1 + l=plev+1-k+1 + do j=1, ny + do i=1, nx + if(w(i,j,k).gt.0.) then + kx=max(1, k-1) + qsat = qsatw_crm(tabs(i,j,kx),pres(kx)) + if(qcl(i,j,kx)+qci(i,j,kx).gt.min(1.e-5,0.01*qsat)) then + mui_crm(l) = mui_crm(l)+rhow(k)*w(i,j,k) + end if + else if (w(i,j,k).lt.0.) then + kx=min(k+1, nzm) + qsat = qsatw_crm(tabs(i,j,kx),pres(kx)) + if(qcl(i,j,kx)+qci(i,j,kx).gt.min(1.e-5,0.01*qsat)) then + mdi_crm(l) = mdi_crm(l)+rhow(k)*w(i,j,k) + else if(qpl(i,j,kx)+qpi(i,j,kx).gt.1.0e-4) then + mdi_crm(l) = mdi_crm(l)+rhow(k)*w(i,j,k) + end if + end if + end do + end do + end do + +! do k=1,nzm +! radlwup0(k)=radlwup0(k)+radlwup(k) +! radlwdn0(k)=radlwdn0(k)+radlwdn(k) +! radqrlw0(k)=radqrlw0(k)+radqrlw(k) +! radswup0(k)=radswup0(k)+radswup(k) +! radswdn0(k)=radswdn0(k)+radswdn(k) +! radqrsw0(k)=radqrsw0(k)+radqrsw(k) +! end do + + do j=1,ny + do i=1,nx +! if(cwp(i,j).gt.cwp_threshold) cltot = cltot + 1. +! if(cwph(i,j).gt.cwp_threshold) clhgh = clhgh + 1. +! if(cwpm(i,j).gt.cwp_threshold) clmed = clmed + 1. +! if(cwpl(i,j).gt.cwp_threshold) cllow = cllow + 1. +! use maxmimum cloud overlap to calcluate cltot, clhgh, +! cldmed, and cldlow +++ mhwang + if(cwp(i,j).gt.cwp_threshold) cltot = cltot + cttemp(i,j) + if(cwph(i,j).gt.cwp_threshold) clhgh = clhgh + chtemp(i,j) + if(cwpm(i,j).gt.cwp_threshold) clmed = clmed + cmtemp(i,j) + if(cwpl(i,j).gt.cwp_threshold) cllow = cllow + cltemp(i,j) + end do + end do + +! call stepout() +!---------------------------------------------------------- + end do ! main loop +!---------------------------------------------------------- + + tmp1 = 1._r8/ dble(nstop) + t_rad = t_rad * tmp1 + qv_rad = qv_rad * tmp1 + qc_rad = qc_rad * tmp1 + qi_rad = qi_rad * tmp1 + cld_rad = cld_rad * tmp1 +#ifdef m2005 + nc_rad = nc_rad * tmp1 + ni_rad = ni_rad * tmp1 + qs_rad = qs_rad * tmp1 + ns_rad = ns_rad * tmp1 +#endif + +! no CRM tendencies above its top + + tln(1:ptop-1) = tl(1:ptop-1) + qln(1:ptop-1) = ql(1:ptop-1) + qccln(1:ptop-1)= qccl(1:ptop-1) + qiiln(1:ptop-1)= qiil(1:ptop-1) + uln(1:ptop-1) = ul(1:ptop-1) + vln(1:ptop-1) = vl(1:ptop-1) + +! Compute tendencies due to CRM: + + tln(ptop:plev) = 0. + qln(ptop:plev) = 0. + qccln(ptop:plev)= 0. + qiiln(ptop:plev)= 0. + uln(ptop:plev) = 0. + vln(ptop:plev) = 0. + + colprec=0 + colprecs=0 + do k = 1,nzm + l = plev-k+1 + do i=1,nx + do j=1,ny + colprec=colprec+(qpl(i,j,k)+qpi(i,j,k))*pdel(plev-k+1) + colprecs=colprecs+qpi(i,j,k)*pdel(plev-k+1) + tln(l) = tln(l)+tabs(i,j,k) + qln(l) = qln(l)+qv(i,j,k) + qccln(l)= qccln(l)+qcl(i,j,k) + qiiln(l)= qiiln(l)+qci(i,j,k) + uln(l) = uln(l)+u(i,j,k) + vln(l) = vln(l)+v(i,j,k) + end do ! k + end do + end do ! i + + + tln(ptop:plev) = tln(ptop:plev) * factor_xy + qln(ptop:plev) = qln(ptop:plev) * factor_xy + qccln(ptop:plev) = qccln(ptop:plev) * factor_xy + qiiln(ptop:plev) = qiiln(ptop:plev) * factor_xy + uln(ptop:plev) = uln(ptop:plev) * factor_xy + vln(ptop:plev) = vln(ptop:plev) * factor_xy + + sltend = cp * (tln - tl) * idt_gl + qltend = (qln - ql) * idt_gl + qcltend = (qccln - qccl) * idt_gl + qiltend = (qiiln - qiil) * idt_gl + prectend=(colprec-prectend)/ggr*factor_xy * idt_gl + precstend=(colprecs-precstend)/ggr*factor_xy * idt_gl + +! don't use CRM tendencies from two crm top levels + sltend(ptop:ptop+1) = 0. + qltend(ptop:ptop+1) = 0. + qcltend(ptop:ptop+1) = 0. + qiltend(ptop:ptop+1) = 0. +!------------------------------------------------------------- +! +! Save the last step to the permanent core: + + u_crm (1:nx,1:ny,1:nzm) = u (1:nx,1:ny,1:nzm) + v_crm (1:nx,1:ny,1:nzm) = v (1:nx,1:ny,1:nzm) + w_crm (1:nx,1:ny,1:nzm) = w (1:nx,1:ny,1:nzm) + t_crm (1:nx,1:ny,1:nzm) = tabs(1:nx,1:ny,1:nzm) + micro_fields_crm(1:nx,1:ny,1:nzm,1:nmicro_fields) = micro_field(1:nx,1:ny,1:nzm,1:nmicro_fields) +#ifdef sam1mom + micro_fields_crm(1:nx,1:ny,1:nzm,3) = qn(1:nx,1:ny,1:nzm) +#endif +#ifdef m2005 + micro_fields_crm(1:nx,1:ny,1:nzm,11) = cloudliq(1:nx,1:ny,1:nzm) +#endif + crm_tk(1:nx,1:ny,1:nzm) = tk(1:nx, 1:ny, 1:nzm) + crm_tkh(1:nx,1:ny,1:nzm) = tkh(1:nx, 1:ny, 1:nzm) + cld3d_crm(1:nx, 1:ny, 1:nzm) = CF3D(1:nx, 1:ny, 1:nzm) +#ifdef SPCAM_CLUBB_SGS + clubb_buffer(1:nx, 1:ny, 1:nz, 1) = up2(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 2) = vp2(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 3) = wprtp(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 4) = wpthlp(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 5) = wp2(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 6) = wp3(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 7) = rtp2(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 8) = thlp2(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 9) = rtpthlp(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 10) = upwp(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 11) = vpwp(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nz, 12) = cloud_frac(1:nx, 1:ny, 1:nz) + clubb_buffer(1:nx, 1:ny, 1:nzm, 13) = t_tndcy(1:nx, 1:ny, 1:nzm) + clubb_buffer(1:nx, 1:ny, 1:nzm, 14) = qc_tndcy(1:nx, 1:ny, 1:nzm) + clubb_buffer(1:nx, 1:ny, 1:nzm, 15) = qv_tndcy(1:nx, 1:ny, 1:nzm) + clubb_buffer(1:nx, 1:ny, 1:nzm, 16) = u_tndcy(1:nx, 1:ny, 1:nzm) + clubb_buffer(1:nx, 1:ny, 1:nzm, 17) = v_tndcy(1:nx, 1:ny, 1:nzm) + + crm_cld(1:nx, 1:ny, 1:nz) = cloud_frac(1:nx, 1:ny, 1:nz) + clubb_tk(1:nx,1:ny,1:nzm) = tk_clubb(1:nx, 1:ny, 1:nzm) + clubb_tkh(1:nx,1:ny,1:nzm) = tkh_clubb(1:nx, 1:ny, 1:nzm) + relvar(1:nx, 1:ny, 1:nzm) = relvarg(1:nx, 1:ny, 1:nzm) + accre_enhan(1:nx, 1:ny, 1:nzm) = accre_enhang(1:nx, 1:ny, 1:nzm) + qclvar(1:nx, 1:ny, 1:nzm) = qclvarg(1:nx, 1:ny, 1:nzm) +#endif + + do k=1,nzm + do j=1,ny + do i=1,nx + qc_crm(i,j,k) = qcl(i,j,k) + qi_crm(i,j,k) = qci(i,j,k) + qpc_crm(i,j,k) = qpl(i,j,k) + qpi_crm(i,j,k) = qpi(i,j,k) +#ifdef m2005 + wvar_crm(i,j,k) = wvar(i,j,k) +! hm 7/26/11, new output + aut_crm(i,j,k) = aut1(i,j,k) + acc_crm(i,j,k) = acc1(i,j,k) + evpc_crm(i,j,k) = evpc1(i,j,k) + evpr_crm(i,j,k) = evpr1(i,j,k) + mlt_crm(i,j,k) = mlt1(i,j,k) + sub_crm(i,j,k) = sub1(i,j,k) + dep_crm(i,j,k) = dep1(i,j,k) + con_crm(i,j,k) = con1(i,j,k) +#endif + end do + end do + end do + z0m = z0 + taux_crm = taux0 / dble(nstop) + tauy_crm = tauy0 / dble(nstop) + +!--------------------------------------------------------------- +! +! Diagnostics: + +! hm add 9/7/11, change from GCM-time step avg to end-of-timestep + + do k=1,nzm + l = plev-k+1 + do j=1,ny + do i=1,nx + + crm_qc(l) = crm_qc(l) + qcl(i,j,k) + crm_qi(l) = crm_qi(l) + qci(i,j,k) + crm_qr(l) = crm_qr(l) + qpl(i,j,k) +#ifdef sam1mom + omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) + crm_qg(l) = crm_qg(l) + qpi(i,j,k)*omg + crm_qs(l) = crm_qs(l) + qpi(i,j,k)*(1.-omg) +#else +! crm_qg(l) = crm_qg(l) + qpi(i,j,k) +! crm_qs(l) = crm_qs(l) + 0. ! temporerary solution + crm_qg(l) = crm_qg(l) + micro_field(i,j,k,iqg) + crm_qs(l) = crm_qs(l) + micro_field(i,j,k,iqs) + + crm_nc(l) = crm_nc(l) + micro_field(i,j,k,incl) + crm_ni(l) = crm_ni(l) + micro_field(i,j,k,inci) + crm_nr(l) = crm_nr(l) + micro_field(i,j,k,inr) + crm_ng(l) = crm_ng(l) + micro_field(i,j,k,ing) + crm_ns(l) = crm_ns(l) + micro_field(i,j,k,ins) +#endif + + end do + end do + end do + + cld = min(1._r8,cld/float(nstop)*factor_xy) + cldtop = min(1._r8,cldtop/float(nstop)*factor_xy) + gicewp(:)=gicewp*pdel(:)*1000./ggr/float(nstop)*factor_xy + gliqwp(:)=gliqwp*pdel(:)*1000./ggr/float(nstop)*factor_xy + mcup = mcup / float(nstop) * factor_xy + mcdn = mcdn / float(nstop) * factor_xy + mcuup = mcuup / float(nstop) * factor_xy + mcudn = mcudn / float(nstop) * factor_xy + mc = mcup + mcdn + mcuup + mcudn +! hm 9/7/11 modify for end-of-timestep instead of timestep-avg output +!hm crm_qc = crm_qc / float(nstop) * factor_xy +!hm crm_qi = crm_qi / float(nstop) * factor_xy +!hm crm_qs = crm_qs / float(nstop) * factor_xy +!hm crm_qg = crm_qg / float(nstop) * factor_xy +!hm crm_qr = crm_qr / float(nstop) * factor_xy +!hm#ifdef m2005 +!hm crm_nc = crm_nc / float(nstop) * factor_xy +!hm crm_ni = crm_ni / float(nstop) * factor_xy +!hm crm_ns = crm_ns / float(nstop) * factor_xy +!hm crm_ng = crm_ng / float(nstop) * factor_xy +!hm crm_nr = crm_nr / float(nstop) * factor_xy + + crm_qc = crm_qc * factor_xy + crm_qi = crm_qi * factor_xy + crm_qs = crm_qs * factor_xy + crm_qg = crm_qg * factor_xy + crm_qr = crm_qr * factor_xy +#ifdef m2005 + crm_nc = crm_nc * factor_xy + crm_ni = crm_ni * factor_xy + crm_ns = crm_ns * factor_xy + crm_ng = crm_ng * factor_xy + crm_nr = crm_nr * factor_xy + + +! hm 8/31/11 new output, gcm-grid- and time-step avg +! add loop over i,j do get horizontal avg, and flip vertical array + do k=1,nzm + l = plev-k+1 + do j=1,ny + do i=1,nx + aut_crm_a(l) = aut_crm_a(l) + aut1a(i,j,k) + acc_crm_a(l) = acc_crm_a(l) + acc1a(i,j,k) + evpc_crm_a(l) = evpc_crm_a(l) + evpc1a(i,j,k) + evpr_crm_a(l) = evpr_crm_a(l) + evpr1a(i,j,k) + mlt_crm_a(l) = mlt_crm_a(l) + mlt1a(i,j,k) + sub_crm_a(l) = sub_crm_a(l) + sub1a(i,j,k) + dep_crm_a(l) = dep_crm_a(l) + dep1a(i,j,k) + con_crm_a(l) = con_crm_a(l) + con1a(i,j,k) + end do + end do + end do + +! note, rates are divded by dt to get mean rate over step + aut_crm_a = aut_crm_a / dble(nstop) * factor_xy / dt + acc_crm_a = acc_crm_a / dble(nstop) * factor_xy / dt + evpc_crm_a = evpc_crm_a / dble(nstop) * factor_xy / dt + evpr_crm_a = evpr_crm_a / dble(nstop) * factor_xy / dt + mlt_crm_a = mlt_crm_a / dble(nstop) * factor_xy / dt + sub_crm_a = sub_crm_a / dble(nstop) * factor_xy / dt + dep_crm_a = dep_crm_a / dble(nstop) * factor_xy / dt + con_crm_a = con_crm_a / dble(nstop) * factor_xy / dt + +#endif + precc = 0. + precl = 0. + precsc = 0. + precsl = 0. + do j=1,ny + do i=1,nx +#ifdef sam1mom + precsfc(i,j) = precsfc(i,j)*dz/dt/dble(nstop) + precssfc(i,j) = precssfc(i,j)*dz/dt/dble(nstop) +#endif +#ifdef m2005 +! precsfc and precssfc from the subroutine of micro_proc in M2005 have a unit mm/s/dz +! precsfc(i,j) = precsfc(i,j)*dz/dble(nstop) !mm/s/dz --> mm/s +! precssfc(i,j) = precssfc(i,j)*dz/dble(nstop) !mm/s/dz --> mm/s +! precsfc and precssfc from the subroutine of micro_proc in M2005 have a unit mm/dz + precsfc(i,j) = precsfc(i,j)*dz/dt/dble(nstop) !mm/s/dz --> mm/s + precssfc(i,j) = precssfc(i,j)*dz/dt/dble(nstop) !mm/s/dz --> mm/s + +#endif + if(precsfc(i,j).gt.10./86400.) then + precc = precc + precsfc(i,j) + precsc = precsc + precssfc(i,j) + else + precl = precl + precsfc(i,j) + precsl = precsl + precssfc(i,j) + end if + end do + end do + prec_crm = precsfc/1000. !mm/s --> m/s + precc = precc*factor_xy/1000. + precl = precl*factor_xy/1000. + precsc = precsc*factor_xy/1000. + precsl = precsl*factor_xy/1000. + +!+++mhwangtest +! test water conservtion problem + do k=1, nzm + l=plev-k+1 + do j=1, ny + do i=1, nx +#ifdef m2005 + qtot(9) = qtot(9)+((micro_field(i,j,k,iqr)+micro_field(i,j,k,iqs)+micro_field(i,j,k,iqg)) * pdel(l)/ggr)/(nx*ny) + qtot(9) = qtot(9)+((micro_field(i,j,k,iqv)+micro_field(i,j,k,iqci)) * pdel(l)/ggr)/(nx*ny) +#endif +#ifdef sam1mom + qtot(9) = qtot(9)+((micro_field(i,j,k,1)+micro_field(i,j,k,2)) * pdel(l)/ggr)/(nx*ny) +#endif + enddo + enddo + enddo + qtot(9) = qtot(9) + (precc+precl)*1000 * dt_gl + + if(abs(qtot(9)-qtot(1))/qtot(1).gt.1.0e-6) then +! write(0, *) 'in crm water middle ', igstep, lchnk, icol, qtot(2:8)/ntotal_step, (qtot(5)-qtot(4)) * ntotal_step/qtot(4), & +! (qtot(6)+(precc+precl)*1000 * dt_gl-qtot(5))*ntotal_step/qtot(5) +! write(0, *) 'in crm water middle2 ', igstep, lchnk, icol, qtot(2:8)/ntotal_step, (qtot(8)-qtot(7)) * ntotal_step/qtot(7) +! write(0, *) 'total water (liquid+vapor)', qtot(16:19)/nstop, (qtot(17)-qtot(16)) * ntotal_step/qtot(16), & +! (qtot(18)-qtot(19)) * ntotal_step/qtot(19), +! call endrun('water conservation in crm.F90') + end if +!---mhwangtest + + cltot = cltot *factor_xy/nstop + clhgh = clhgh *factor_xy/nstop + clmed = clmed *factor_xy/nstop + cllow = cllow *factor_xy/nstop + + jt_crm = plev * 1.0 + mx_crm = 1.0 + do k=1, plev + mu_crm(k)=0.5*(mui_crm(k)+mui_crm(k+1)) + md_crm(k)=0.5*(mdi_crm(k)+mdi_crm(k+1)) + mu_crm(k)=mu_crm(k)*ggr/100. !kg/m2/s --> mb/s + md_crm(k)=md_crm(k)*ggr/100. !kg/m2/s --> mb/s + eu_crm(k) = 0. + if(mui_crm(k)-mui_crm(k+1).gt.0) then + eu_crm(k)=(mui_crm(k)-mui_crm(k+1))*ggr/pdel(k) !/s + else + du_crm(k)=-1.0*(mui_crm(k)-mui_crm(k+1))*ggr/pdel(k) !/s + end if + if(mdi_crm(k+1)-mdi_crm(k).lt.0) then + ed_crm(k)=(mdi_crm(k)-mdi_crm(k+1))*ggr/pdel(k) ! /s + else + dd_crm(k)=-1.*(mdi_crm(k)-mdi_crm(k+1))*ggr/pdel(k) !/s + end if + if(abs(mu_crm(k)).gt.1.0e-15.or.abs(md_crm(k)).gt.1.0e-15) then + jt_crm = min(k*1.0_r8, jt_crm) + mx_crm = max(k*1.0_r8, mx_crm) + end if + end do + +!------------------------------------------------------------- +! Fluxes and other stat: +!------------------------------------------------------------- + do k=1,nzm + u2z = 0. + v2z = 0. + w2z = 0. + do j=1,ny + do i=1,nx + u2z = u2z+(u(i,j,k)-u0(k))**2 + v2z = v2z+(v(i,j,k)-v0(k))**2 + w2z = w2z+0.5*(w(i,j,k+1)**2+w(i,j,k)**2) + end do + end do + +!+++mhwang +! mkwsb, mkle, mkadv, mkdiff (also flux_u, flux_v) seem not calculted correclty in the spcam3.5 codes. +! Only values at the last time step are calculated, but is averaged over the entire GCM +! time step. +!---mhwang + + tmp1 = dz/rhow(k) + tmp2 = tmp1/dtn ! dtn is calculated inside of the icyc loop. + ! It seems wrong to use it here ???? +++mhwang + mkwsb(k,:) = mkwsb(k,:) * tmp1*rhow(k) * factor_xy/nstop !kg/m3/s --> kg/m2/s + mkwle(k,:) = mkwle(k,:) * tmp2*rhow(k) * factor_xy/nstop !kg/m3 --> kg/m2/s + mkadv(k,:) = mkadv(k,:) * factor_xy*idt_gl ! kg/kg --> kg/kg/s + mkdiff(k,:) = mkdiff(k,:) * factor_xy*idt_gl ! kg/kg --> kg/kg/s + +! qpsrc, qpevp, qpfall in M2005 are calculated in micro_flux. + qpsrc(k) = qpsrc(k) * factor_xy*idt_gl + qpevp(k) = qpevp(k) * factor_xy*idt_gl + qpfall(k) = qpfall(k) * factor_xy*idt_gl ! kg/kg in M2005 ---> kg/kg/s + precflux(k) = precflux(k) * factor_xy*dz/dt/nstop !kg/m2/dz in M2005 -->kg/m2/s or mm/s (idt_gl=1/dt/nstop) + + l = plev-k+1 + flux_u(l) = (uwle(k) + uwsb(k))*tmp1*factor_xy/nstop + flux_v(l) = (vwle(k) + vwsb(k))*tmp1*factor_xy/nstop +#ifdef sam1mom + flux_qt(l) = mkwle(k,1) + mkwsb(k,1) + fluxsgs_qt(l) = mkwsb(k,1) + flux_qp(l) = mkwle(k,2) + mkwsb(k,2) + qt_trans(l) = mkadv(k,1) + mkdiff(k,1) + qp_trans(l) = mkadv(k,2) + mkdiff(k,2) +#endif +#ifdef m2005 + flux_qt(l) = mkwle(k,1) + mkwsb(k,1) + & + mkwle(k,iqci) + mkwsb(k,iqci) + fluxsgs_qt(l) = mkwsb(k,1) + mkwsb(k,iqci) + flux_qp(l) = mkwle(k,iqr) + mkwsb(k,iqr) + & + mkwle(k,iqs) + mkwsb(k,iqs) + mkwle(k,iqg) + mkwsb(k,iqg) + qt_trans(l) = mkadv(k,1) + mkadv(k,iqci) + & + mkdiff(k,1) + mkdiff(k,iqci) + qp_trans(l) = mkadv(k,iqr) + mkadv(k,iqs) + mkadv(k,iqg) + & + mkdiff(k,iqr) + mkdiff(k,iqs) + mkdiff(k,iqg) +#endif + tkesgsz(l)= rho(k)*sum(tke(1:nx,1:ny,k))*factor_xy + tkez(l)= rho(k)*0.5*(u2z+v2z*YES3D+w2z)*factor_xy + tkesgsz(l) + tkz(l) = sum(tk(1:nx, 1:ny, k)) * factor_xy + pflx(l) = precflux(k)/1000. !mm/s -->m/s + + qp_fall(l) = qpfall(k) + qp_evp(l) = qpevp(k) + qp_src(l) = qpsrc(k) + + qt_ls(l) = qtend(k) + t_ls(l) = ttend(k) + end do + +#ifdef ECPP + abnd=0.0 + abnd_tf=0.0 + massflxbnd=0.0 + acen=0.0 + acen_tf=0.0 + rhcen=0.0 + qcloudcen=0.0 + qicecen=0.0 + qlsinkcen=0.0 + precrcen=0.0 + precsolidcen=0.0 + wupthresh_bnd = 0.0 + wdownthresh_bnd = 0.0 + wwqui_cen = 0.0 + wwqui_bnd = 0.0 + wwqui_cloudy_cen = 0.0 + wwqui_cloudy_bnd = 0.0 + qlsink_bfcen = 0.0 + qlsink_avgcen = 0.0 + praincen = 0.0 +! default is clear, non-precipitating, and quiescent class + abnd(:,1,1,1)=1.0 + abnd_tf(:,1,1,1)=1.0 + acen(:,1,1,1)=1.0 + acen_tf(:,1,1,1)=1.0 + + do k=1, nzm + l=plev-k+1 + acen(l,:,:,:)=area_cen_sum(k,:,1:ncls_ecpp_in,:) + acen_tf(l,:,:,:)=area_cen_final(k,:,1:ncls_ecpp_in,:) + rhcen(l,:,:,:)=rh_cen_sum(k,:,1:ncls_ecpp_in,:) + qcloudcen(l,:,:,:)=qcloud_cen_sum(k,:,1:ncls_ecpp_in,:) + qicecen(l,:,:,:)=qice_cen_sum(k,:,1:ncls_ecpp_in,:) + qlsinkcen(l,:,:,:)=qlsink_cen_sum(k,:,1:ncls_ecpp_in,:) + precrcen(l,:,:,:)=precr_cen_sum(k,:,1:ncls_ecpp_in,:) + precsolidcen(l,:,:,:)=precsolid_cen_sum(k,:,1:ncls_ecpp_in,:) + wwqui_cen(l) = wwqui_cen_sum(k) + wwqui_cloudy_cen(l) = wwqui_cloudy_cen_sum(k) + qlsink_bfcen(l,:,:,:)=qlsink_bf_cen_sum(k,:,1:ncls_ecpp_in,:) + qlsink_avgcen(l,:,:,:)=qlsink_avg_cen_sum(k,:,1:ncls_ecpp_in,:) + praincen(l,:,:,:)=prain_cen_sum(k,:,1:ncls_ecpp_in,:) + end do + do k=1, nzm+1 + l=plev+1-k+1 + abnd(l,:,:,:)=area_bnd_sum(k,:,1:ncls_ecpp_in,:) + abnd_tf(l,:,:,:)=area_bnd_final(k,:,1:ncls_ecpp_in,:) + massflxbnd(l,:,:,:)=mass_bnd_sum(k,:,1:ncls_ecpp_in,:) + wupthresh_bnd(l)=wup_thresh(k) + wdownthresh_bnd(l)=wdown_thresh(k) + wwqui_bnd(l) = wwqui_bnd_sum(k) + wwqui_cloudy_bnd(l) = wwqui_cloudy_bnd_sum(k) + end do +#endif /*ECPP*/ + + timing_factor = timing_factor / nstop + +#ifdef SPCAM_CLUBB_SGS +! Deallocate CLUBB variables, etc. +! -UWM + if ( doclubb .or. doclubbnoninter ) call clubb_sgs_cleanup( ) +#endif +#ifdef ECPP +! Deallocate ECPP variables + call ecpp_crm_cleanup () +#endif /*ECPP*/ + +end subroutine crm +end module crmx_crm_module diff --git a/src/physics/spcam/crm/crmx_crmsurface.F90 b/src/physics/spcam/crm/crmx_crmsurface.F90 new file mode 100644 index 0000000000..f5e3ae17f4 --- /dev/null +++ b/src/physics/spcam/crm/crmx_crmsurface.F90 @@ -0,0 +1,155 @@ + subroutine crmsurface(bflx) + + + use crmx_vars + use crmx_params + + implicit none + + real, intent (in) :: bflx + real u_h0, tau00, tauxm, tauym + real diag_ustar + integer i,j + +!-------------------------------------------------------- + + + if(SFC_FLX_FXD.and..not.SFC_TAU_FXD) then + + uhl = uhl + dtn*utend(1) + vhl = vhl + dtn*vtend(1) + + tauxm = 0. + tauym = 0. + + do j=1,ny + do i=1,nx + u_h0 = max(1.,sqrt((0.5*(u(i+1,j,1)+u(i,j,1))+ug)**2+ & + (0.5*(v(i,j+YES3D,1)+v(i,j,1))+vg)**2)) + tau00 = rho(1) * diag_ustar(z(1),bflx,u_h0,z0)**2 + fluxbu(i,j) = -(0.5*(u(i+1,j,1)+u(i,j,1))+ug-uhl)/u_h0*tau00 + fluxbv(i,j) = -(0.5*(v(i,j+YES3D,1)+v(i,j,1))+vg-vhl)/u_h0*tau00 + tauxm = tauxm + fluxbu(i,j) + tauym = tauym + fluxbv(i,j) + end do + end do + + taux0 = taux0 + tauxm/dble(nx*ny) + tauy0 = tauy0 + tauym/dble(nx*ny) + + end if ! SFC_FLX_FXD + + return + end + + + + + +! ---------------------------------------------------------------------- +! +! DISCLAIMER : this code appears to be correct but has not been +! very thouroughly tested. If you do notice any +! anomalous behaviour then please contact Andy and/or +! Bjorn +! +! Function diag_ustar: returns value of ustar using the below +! similarity functions and a specified buoyancy flux (bflx) given in +! kinematic units +! +! phi_m (zeta > 0) = (1 + am * zeta) +! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) +! +! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) +! +! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface +! Layer, in Workshop on Micormeteorology, pages 67-100. +! +! Code writen March, 1999 by Bjorn Stevens +! +! Code corrected 8th June 1999 (obukhov length was wrong way up, +! so now used as reciprocal of obukhov length) + + real function diag_ustar(z,bflx,wnd,z0) + + implicit none + real, parameter :: vonk = 0.4 ! von Karmans constant + real, parameter :: g = 9.81 ! gravitational acceleration + real, parameter :: am = 4.8 ! " " " + real, parameter :: bm = 19.3 ! " " " + real, parameter :: eps = 1.e-10 ! non-zero, small number + + real, intent (in) :: z ! height where u locates + real, intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) + real, intent (in) :: wnd ! wind speed at z + real, intent (in) :: z0 ! momentum roughness height + + integer :: iterate + real :: lnz, klnz, c1, x, psi1, zeta, rlmo, ustar + + lnz = log(z/z0) + klnz = vonk/lnz + c1 = 3.14159/2. - 3.*log(2.) + + ustar = wnd*klnz + if (bflx /= 0.0) then + do iterate=1,8 + rlmo = -bflx * vonk/(ustar**3 + eps) !reciprocal of + !obukhov length + zeta = min(1.,z*rlmo) + if (zeta > 0.) then + ustar = vonk*wnd /(lnz + am*zeta) + else + x = sqrt( sqrt( 1.0 - bm*zeta ) ) + psi1 = 2.*log(1.0+x) + log(1.0+x*x) - 2.*atan(x) + c1 + ustar = wnd*vonk/(lnz - psi1) + end if + end do + end if + + diag_ustar = ustar + + return + end function diag_ustar +! ---------------------------------------------------------------------- + + + + real function z0_est(z,bflx,wnd,ustar) + +! +! Compute z0 from buoyancy flux, wind, and friction velocity +! +! 2004, Marat Khairoutdinov +! + + implicit none + real, parameter :: vonk = 0.4 ! von Karmans constant + real, parameter :: g = 9.81 ! gravitational acceleration + real, parameter :: am = 4.8 ! " " " + real, parameter :: bm = 19.3 ! " " " + real, parameter :: eps = 1.e-10 ! non-zero, small number + + real, intent (in) :: z ! height where u locates + real, intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) + real, intent (in) :: wnd ! wind speed at z + real, intent (in) :: ustar ! friction velocity + + real :: lnz, klnz, c1, x, psi1, zeta, rlmo + + c1 = 3.14159/2. - 3.*log(2.) + rlmo = -bflx*vonk/(ustar**3+eps) !reciprocal of + zeta = min(1.,z*rlmo) + if (zeta >= 0.) then + psi1 = -am*zeta + else + x = sqrt( sqrt( 1.0 - bm*zeta ) ) + psi1 = 2.*log(1.0+x) + log(1.0+x*x) - 2.*atan(x) + c1 + end if + lnz = max(0.,vonk*wnd/(ustar + eps) + psi1) + z0_est = z*exp(-lnz) + + return + end function z0_est +! ---------------------------------------------------------------------- + diff --git a/src/physics/spcam/crm/crmx_crmtracers.F90 b/src/physics/spcam/crm/crmx_crmtracers.F90 new file mode 100644 index 0000000000..62322267c3 --- /dev/null +++ b/src/physics/spcam/crm/crmx_crmtracers.F90 @@ -0,0 +1,142 @@ +module crmx_crmtracers + + +! This module serves as a template for adding tracer transport in the model. The tracers can be +! chemical tracers, or bin microphysics drop/ice categories, etc. +! The number of tracers is set by the parameter ntracers which is set in domain.f90. +! Also, the logical flag dotracers should be set to .true. in namelist (default is .false.). +! The model will transport the tracers around automatically (advection and SGS diffusion). +! The user must supply the initialization in the subroutine tracers_init() in this module. +! By default, the surface flux of all tracers is zero. Nonzero values can be set in tracers_flux(). +! The local sinks/sources of tracers should be supplied in tracers_physics(). + + + + use crmx_grid + implicit none + + real tracer (dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, 0:ntracers) + real fluxbtr (nx, ny, 0:ntracers) ! surface flux of tracers + real fluxttr (nx, ny, 0:ntracers) ! top boundary flux of tracers + real trwle(nz,0:ntracers) ! resolved vertical flux + real trwsb(nz,0:ntracers) ! SGS vertical flux + real tradv(nz,0:ntracers) ! tendency due to vertical advection + real trdiff(nz,0:ntracers) ! tendency due to vertical diffusion + real trphys(nz,0:ntracers) ! tendency due to physics + character *4 tracername(0:ntracers) + character *10 tracerunits(0:ntracers) + +CONTAINS + + subroutine tracers_init() + + integer k,ntr + character *2 ntrchar + integer, external :: lenstr + + tracer = 0. + fluxbtr = 0. + fluxttr = 0. + +! Add your initialization code here. Default is to set to 0 in setdata.f90. + + if(nrestart.eq.0) then + +! here .... + + end if + +! Specify te tracers' default names: + + ! Default names are TRACER01, TRACER02, etc: + + do ntr = 1,ntracers + write(ntrchar,'(i2)') ntr + do k=1,3-lenstr(ntrchar)-1 + ntrchar(k:k)='0' + end do + tracername(ntr) = 'TR'//ntrchar(1:2) + tracerunits(ntr) = '[TR]' + end do + + end subroutine tracers_init + + + + subroutine tracers_flux() + +! Set surface and top fluxes of tracers. Default is 0 set in setdata.f90 + + end subroutine tracers_flux + + + + subroutine tracers_physics() + + ! add here a call to a subroutine that does something to tracers besides advection and diffusion. + ! The transport is done automatically. + + trphys = 0. ! Default tendency due to physics. You code should compute this to output statistics. + + end subroutine tracers_physics + + + + subroutine tracers_hbuf_init(namelist,deflist,unitlist,status,average_type,count,trcount) + +! Initialize the list of tracers statistics variables written in statistics.f90 + + character(*) namelist(*), deflist(*), unitlist(*) + integer status(*),average_type(*),count,trcount + integer ntr + + + do ntr=1,ntracers + + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr)) + deflist(count) = trim(tracername(ntr)) + unitlist(count) = trim(tracerunits(ntr)) + status(count) = 1 + average_type(count) = 0 + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr))//'FLX' + deflist(count) = 'Total flux of '//trim(tracername(ntr)) + unitlist(count) = trim(tracerunits(ntr))//' kg/m2/s' + status(count) = 1 + average_type(count) = 0 + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr))//'FLXS' + deflist(count) = 'SGS flux of '//trim(tracername(ntr)) + unitlist(count) = trim(tracerunits(ntr))//' kg/m2/s' + status(count) = 1 + average_type(count) = 0 + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr))//'ADV' + deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to vertical advection') + unitlist(count) = trim(tracerunits(ntr))//'/day' + status(count) = 1 + average_type(count) = 0 + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr))//'DIFF' + deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to vertical SGS transport') + unitlist(count) = trim(tracername(ntr))//'/day' + status(count) = 1 + average_type(count) = 0 + count = count + 1 + trcount = trcount + 1 + namelist(count) = trim(tracername(ntr))//'PHYS' + deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to physics') + unitlist(count) = trim(tracername(ntr))//'/day' + status(count) = 1 + average_type(count) = 0 + end do + + end subroutine tracers_hbuf_init + +end module crmx_crmtracers diff --git a/src/physics/spcam/crm/crmx_damping.F90 b/src/physics/spcam/crm/crmx_damping.F90 new file mode 100644 index 0000000000..6d47ecbe4f --- /dev/null +++ b/src/physics/spcam/crm/crmx_damping.F90 @@ -0,0 +1,68 @@ + +subroutine damping + +! "Spange"-layer damping at the domain top region + +use crmx_vars +use crmx_microphysics, only: micro_field, index_water_vapor +implicit none + +real tau_min ! minimum damping time-scale (at the top) +real tau_max ! maxim damping time-scale (base of damping layer) +real damp_depth ! damping depth as a fraction of the domain height +parameter(tau_min=60., tau_max=450., damp_depth=0.4) +real tau(nzm) +integer i, j, k, n_damp + +if(tau_min.lt.2*dt) then + print*,'Error: in damping() tau_min is too small!' + call task_abort() +end if + +do k=nzm,1,-1 + if(z(nzm)-z(k).lt.damp_depth*z(nzm)) then + n_damp=nzm-k+1 + endif +end do + +do k=nzm,nzm-n_damp,-1 + tau(k) = tau_min *(tau_max/tau_min)**((z(nzm)-z(k))/(z(nzm)-z(nzm-n_damp))) + tau(k)=1./tau(k) +end do + +!+++mhwang recalculate grid-mean u0, v0, t0 first, +! as t have been updated. No need for qv0, as +! qv has not been updated yet the calculation of qv0. +do k=1, nzm + u0(k)=0.0 + v0(k)=0.0 + t0(k)=0.0 + do j=1, ny + do i=1, nx + u0(k) = u0(k) + u(i,j,k)/(nx*ny) + v0(k) = v0(k) + v(i,j,k)/(nx*ny) + t0(k) = t0(k) + t(i,j,k)/(nx*ny) + end do + end do +end do +!---mhwang + +do k = nzm, nzm-n_damp, -1 + do j=1,ny + do i=1,nx + dudt(i,j,k,na)= dudt(i,j,k,na)-(u(i,j,k)-u0(k)) * tau(k) + dvdt(i,j,k,na)= dvdt(i,j,k,na)-(v(i,j,k)-v0(k)) * tau(k) + dwdt(i,j,k,na)= dwdt(i,j,k,na)-w(i,j,k) * tau(k) + t(i,j,k)= t(i,j,k)-dtn*(t(i,j,k)-t0(k)) * tau(k) +! In the old version (SAM7.5?) of SAM, water vapor is the prognostic variable for the two-moment microphyscs. +! So the following damping approach can lead to the negative water vapor. +! micro_field(i,j,k,index_water_vapor)= micro_field(i,j,k,index_water_vapor)- & +! dtn*(qv(i,j,k)+qcl(i,j,k)+qci(i,j,k)-q0(k)) * tau(k) +! a simple fix (Minghuai Wang, 2011-08): + micro_field(i,j,k,index_water_vapor)= micro_field(i,j,k,index_water_vapor)- & + dtn*(qv(i,j,k)-qv0(k)) * tau(k) + end do! i + end do! j +end do ! k + +end subroutine damping diff --git a/src/physics/spcam/crm/crmx_diagnose.F90 b/src/physics/spcam/crm/crmx_diagnose.F90 new file mode 100644 index 0000000000..e169eb6aff --- /dev/null +++ b/src/physics/spcam/crm/crmx_diagnose.F90 @@ -0,0 +1,197 @@ +subroutine diagnose + +! Diagnose some useful stuff + +use crmx_vars +use crmx_params +use crmx_sgs, only: sgs_diagnose +implicit none + +integer i,j,k,kb,kc,k200,k500,k850 +real(kind=selected_real_kind(12)) coef, coef1, buffer(nzm,9), buffer1(nzm,8) +real omn, omp, tmp_lwp + +coef = 1./float(nx*ny) + + +k200 = nzm + +do k=1,nzm + u0(k)=0. + v0(k)=0. + t01(k) = tabs0(k) + q01(k) = q0(k) + t0(k)=0. + tabs0(k)=0. + q0(k)=0. + qn0(k)=0. + qp0(k)=0. + p0(k)=0. + kc=min(nzm,k+1) + kb=max(1,k-1) + if(pres(kc).le.200..and.pres(kb).gt.200.) k200=k + coef1 = rho(k)*dz*adz(k)*dtfactor + do j=1,ny + do i=1,nx + tabs(i,j,k) = t(i,j,k)-gamaz(k)+ fac_cond * (qcl(i,j,k)+qpl(i,j,k)) +& + fac_sub *(qci(i,j,k) + qpi(i,j,k)) + u0(k)=u0(k)+u(i,j,k) + v0(k)=v0(k)+v(i,j,k) + p0(k)=p0(k)+p(i,j,k) + t0(k)=t0(k)+t(i,j,k) + tabs0(k)=tabs0(k)+tabs(i,j,k) + q0(k)=q0(k)+qv(i,j,k)+qcl(i,j,k)+qci(i,j,k) + qn0(k) = qn0(k) + qcl(i,j,k) + qci(i,j,k) + qp0(k) = qp0(k) + qpl(i,j,k) + qpi(i,j,k) + + pw_xy(i,j) = pw_xy(i,j)+qv(i,j,k)*coef1 + cw_xy(i,j) = cw_xy(i,j)+qcl(i,j,k)*coef1 + iw_xy(i,j) = iw_xy(i,j)+qci(i,j,k)*coef1 + + end do + end do + u0(k)=u0(k)*coef + v0(k)=v0(k)*coef + t0(k)=t0(k)*coef + tabs0(k)=tabs0(k)*coef + q0(k)=q0(k)*coef + qn0(k)=qn0(k)*coef + qp0(k)=qp0(k)*coef + p0(k)=p0(k)*coef + +end do ! k + +k500 = nzm +do k = 1,nzm + kc=min(nzm,k+1) + if((pres(kc).le.500.).and.(pres(k).gt.500.)) then + if ((500.-pres(kc)).lt.(pres(k)-500.))then + k500=kc + else + k500=k + end if + end if +end do + + +do j=1,ny + do i=1,nx + usfc_xy(i,j) = usfc_xy(i,j) + u(i,j,1)*dtfactor + vsfc_xy(i,j) = vsfc_xy(i,j) + v(i,j,1)*dtfactor + u200_xy(i,j) = u200_xy(i,j) + u(i,j,k200)*dtfactor + v200_xy(i,j) = v200_xy(i,j) + v(i,j,k200)*dtfactor + w500_xy(i,j) = w500_xy(i,j) + w(i,j,k500)*dtfactor + end do +end do + +if(dompi) then + + coef1 = 1./float(nsubdomains) + do k=1,nzm + buffer(k,1) = u0(k) + buffer(k,2) = v0(k) + buffer(k,3) = t0(k) + buffer(k,4) = q0(k) + buffer(k,5) = p0(k) + buffer(k,6) = tabs0(k) + buffer(k,7) = qn0(k) + buffer(k,8) = qp0(k) + end do + call task_sum_real8(buffer,buffer1,nzm*8) + do k=1,nzm + u0(k)=buffer1(k,1)*coef1 + v0(k)=buffer1(k,2)*coef1 + t0(k)=buffer1(k,3)*coef1 + q0(k)=buffer1(k,4)*coef1 + p0(k)=buffer1(k,5)*coef1 + tabs0(k)=buffer1(k,6)*coef1 + qn0(k)=buffer1(k,7)*coef1 + qp0(k)=buffer1(k,8)*coef1 + end do + +end if ! dompi + +qv0 = q0 - qn0 + +!===================================================== +! UW ADDITIONS + +! FIND VERTICAL INDICES OF 850MB, COMPUTE SWVP +k850 = 1 +do k = 1,nzm + if(pres(k).le.850.) then + k850 = k + EXIT + end if +end do + +do k=1,nzm + coef1 = rho(k)*dz*adz(k)*dtfactor + do j=1,ny + do i=1,nx + + ! Saturated water vapor path with respect to water. Can be used + ! with water vapor path (= pw) to compute column-average + ! relative humidity. + swvp_xy(i,j) = swvp_xy(i,j)+qsatw_crm(tabs(i,j,k),pres(k))*coef1 + end do + end do +end do ! k + +! ACCUMULATE AVERAGES OF TWO-DIMENSIONAL STATISTICS +do j=1,ny + do i=1,nx + psfc_xy(i,j) = psfc_xy(i,j) + (100.*pres(1) + p(i,j,1))*dtfactor + + ! 850 mbar horizontal winds + u850_xy(i,j) = u850_xy(i,j) + u(i,j,k850)*dtfactor + v850_xy(i,j) = v850_xy(i,j) + v(i,j,k850)*dtfactor + + end do +end do + +! COMPUTE CLOUD/ECHO HEIGHTS AS WELL AS CLOUD TOP TEMPERATURE +! WHERE CLOUD TOP IS DEFINED AS THE HIGHEST MODEL LEVEL WITH A +! CONDENSATE PATH OF 0.01 kg/m2 ABOVE. ECHO TOP IS THE HIGHEST LEVEL +! WHERE THE PRECIPITATE MIXING RATIO > 0.001 G/KG. + +! initially, zero out heights and set cloudtoptemp to SST +cloudtopheight = 0. +cloudtoptemp = sstxy(1:nx,1:ny) +echotopheight = 0. +do j = 1,ny + do i = 1,nx + ! FIND CLOUD TOP HEIGHT + tmp_lwp = 0. + do k = nzm,1,-1 + tmp_lwp = tmp_lwp + (qcl(i,j,k)+qci(i,j,k))*rho(k)*dz*adz(k) + if (tmp_lwp.gt.0.01) then + cloudtopheight(i,j) = z(k) + cloudtoptemp(i,j) = tabs(i,j,k) + EXIT + end if + end do + ! FIND ECHO TOP HEIGHT + do k = nzm,1,-1 + if (qpl(i,j,k)+qpi(i,j,k).gt.1.e-6) then + echotopheight(i,j) = z(k) + EXIT + end if + end do + end do +end do + +! END UW ADDITIONS +!===================================================== + +!----------------- +! compute some sgs diagnostics: + +call sgs_diagnose() + +!----------------- + +! recompute pressure levels, except at restart (saved levels are used). +!if(dtfactor.ge.0.) call pressz() ! recompute pressure levels + +end subroutine diagnose diff --git a/src/physics/spcam/crm/crmx_domain.F90 b/src/physics/spcam/crm/crmx_domain.F90 new file mode 100644 index 0000000000..4de3be44a6 --- /dev/null +++ b/src/physics/spcam/crm/crmx_domain.F90 @@ -0,0 +1,33 @@ +! Set the domain dimensionality, size and number of subdomains. + +module crmx_domain + + use crmdims + implicit none + + integer, parameter :: YES3D = YES3DVAL ! Domain dimensionality: 1 - 3D, 0 - 2D + integer, parameter :: nx_gl = crm_nx ! Number of grid points in X + integer, parameter :: ny_gl = crm_ny ! Number of grid points in Y + integer, parameter :: nz_gl = crm_nz ! Number of pressure (scalar) levels + integer, parameter :: nsubdomains_x = 1 ! No of subdomains in x + integer, parameter :: nsubdomains_y = 1 ! No of subdomains in y + + + ! define # of points in x and y direction to average for + ! output relating to statistical moments. + ! For example, navgmom_x = 8 means the output will be an 8 times coarser grid than the original. + ! If don't wanna such output, just set them to -1 in both directions. + ! See Changes_log/README.UUmods for more details. + integer, parameter :: navgmom_x = -1 + integer, parameter :: navgmom_y = -1 + + integer, parameter :: ntracers = 0 ! number of transported tracers (dotracers=.true.) + +! Note: +! * nx_gl and ny_gl should be a factor of 2,3, or 5 (see User's Guide) +! * if 2D case, ny_gl = nsubdomains_y = 1 ; +! * nsubdomains_x*nsubdomains_y = total number of processors +! * if one processor is used, than nsubdomains_x = nsubdomains_y = 1; +! * if ntracers is > 0, don't forget to set dotracers to .true. in namelist + +end module crmx_domain diff --git a/src/physics/spcam/crm/crmx_ecppvars.F90 b/src/physics/spcam/crm/crmx_ecppvars.F90 new file mode 100644 index 0000000000..8b45ed4897 --- /dev/null +++ b/src/physics/spcam/crm/crmx_ecppvars.F90 @@ -0,0 +1,52 @@ +module crmx_ecppvars +#ifdef ECPP + implicit none + + public + + integer, public, parameter :: nupdraft_in = 1 ! Number of updraft class + integer, public, parameter :: ndndraft_in = 1 ! Number of dndraft class + integer, public, parameter :: ncls_ecpp_in = 3 ! Number of total number of ecpp transport class + ! = nupdraft_in+1+ndndraft_in + integer, public, parameter :: ncc_in = 2 ! number of clear/cloudy sub-calsses + integer, public, parameter :: nprcp_in = 2 ! Number of non-precipitating/precipitating sub-classes. + + integer, public, parameter :: QUI = 1, & !Quiescent class + UP1 = 2 !First index for upward classes + + integer, public :: DN1, & !First index of downward classes + NCLASS_TR !Num. of transport classes + !Both initialized based on + !runtime settings + + integer, public :: NCLASS_CL = ncc_in, & !Number of cloud classes + CLR = 1, & !Clear sub-class + CLD = 2 !Cloudy sub-class + + integer, public :: NCLASS_PR = nprcp_in, & !Number of precipitaion classes + PRN = 1, & !Not precipitating sub-class + PRY = 2 !Is precipitating sub-class + + + real,dimension(:,:,:), allocatable :: qlsink, precr, precsolid, rh, qlsink_bf, prain, qcloud_bf, qvs + + real,dimension(:,:,:),allocatable :: & + qcloudsum1, qcloud_bfsum1, qrainsum1, qicesum1, qsnowsum1, qgraupsum1, & + qlsinksum1, qlsink_bfsum1, prainsum1, precrsum1, precsolidsum1, precallsum1, & + altsum1, rhsum1, cf3dsum1, wwsum1, wwsqsum1, tkesgssum1, qvssum1 + +! dim1 = z + real,dimension(:),allocatable :: & + xkhvsum, wup_thresh, wdown_thresh, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum + +! dims = (z, cloud sub-class, transport-class, precip sub-class) + real, dimension(:,:,:,:), allocatable :: & + area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & + ent_bnd_sum, rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, prain_cen_sum, qlsink_avg_cen_sum +#endif /*ECPP*/ +end module crmx_ecppvars diff --git a/src/physics/spcam/crm/crmx_forcing.F90 b/src/physics/spcam/crm/crmx_forcing.F90 new file mode 100644 index 0000000000..ebcca7e22f --- /dev/null +++ b/src/physics/spcam/crm/crmx_forcing.F90 @@ -0,0 +1,48 @@ + +subroutine forcing + + use crmx_vars + use crmx_params + use crmx_microphysics, only: micro_field, index_water_vapor, total_water + + implicit none + + real coef,qneg,qpoz, factor + integer i,j,k,nneg + + coef = 1./3600. + + do k=1,nzm + + qpoz = 0. + qneg = 0. + nneg = 0 + + do j=1,ny + do i=1,nx + t(i,j,k)=t(i,j,k) + ttend(k) * dtn + micro_field(i,j,k,index_water_vapor)=micro_field(i,j,k,index_water_vapor) + qtend(k) * dtn + if(micro_field(i,j,k,index_water_vapor).lt.0.) then + nneg = nneg + 1 + qneg = qneg + micro_field(i,j,k,index_water_vapor) + else + qpoz = qpoz + micro_field(i,j,k,index_water_vapor) + end if + dudt(i,j,k,na)=dudt(i,j,k,na) + utend(k) + dvdt(i,j,k,na)=dvdt(i,j,k,na) + vtend(k) + end do + end do + + if(nneg.gt.0.and.qpoz+qneg.gt.0.) then + factor = 1. + qneg/qpoz + do j=1,ny + do i=1,nx + micro_field(i,j,k,index_water_vapor) = max(0.,micro_field(i,j,k,index_water_vapor)*factor) + end do + end do + end if + + end do + +end + diff --git a/src/physics/spcam/crm/crmx_grid.F90 b/src/physics/spcam/crm/crmx_grid.F90 new file mode 100644 index 0000000000..ab8cad1d63 --- /dev/null +++ b/src/physics/spcam/crm/crmx_grid.F90 @@ -0,0 +1,167 @@ +module crmx_grid + +use crmx_domain +use crmx_advection, only: NADV, NADVS + +implicit none + +character(6), parameter :: version = '6.10.4' +character(8), parameter :: version_date = 'Feb 2013' + +integer, parameter :: nx = nx_gl/nsubdomains_x +integer, parameter :: ny = ny_gl/nsubdomains_y +integer, parameter :: nz = nz_gl+1 +integer, parameter :: nzm = nz-1 + +integer, parameter :: nsubdomains = nsubdomains_x * nsubdomains_y + +logical, parameter :: RUN3D = ny_gl.gt.1 +logical, parameter :: RUN2D = .not.RUN3D + +integer, parameter :: nxp1 = nx + 1 +integer, parameter :: nyp1 = ny + 1 * YES3D +integer, parameter :: nxp2 = nx + 2 +integer, parameter :: nyp2 = ny + 2 * YES3D +integer, parameter :: nxp3 = nx + 3 +integer, parameter :: nyp3 = ny + 3 * YES3D +integer, parameter :: nxp4 = nx + 4 +integer, parameter :: nyp4 = ny + 4 * YES3D + +integer, parameter :: dimx1_u = -1 !!-1 -1 -1 -1 +integer, parameter :: dimx2_u = nxp3 !!nxp3 nxp3 nxp3 nxp3 +integer, parameter :: dimy1_u = 1-(2+NADV)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-2*YES3D +integer, parameter :: dimy2_u = nyp2+NADV !!nyp5 nyp4 nyp3 nyp2 +integer, parameter :: dimx1_v = -1-NADV !!-4 -3 -2 -1 +integer, parameter :: dimx2_v = nxp2+NADV !!nxp5 nxp4 nxp3 nxp2 +integer, parameter :: dimy1_v = 1-2*YES3D !!1-2*YES3D 1-2*YES3D 1-2*YES3D 1-2*YES3D +integer, parameter :: dimy2_v = nyp3 !!nyp3 nyp3 nyp3 nyp3 +integer, parameter :: dimx1_w = -1-NADV !!-4 -3 -2 -1 +integer, parameter :: dimx2_w = nxp2+NADV !!nxp5 nxp4 nxp3 nxp2 +integer, parameter :: dimy1_w = 1-(2+NADV)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-2*YES3D +integer, parameter :: dimy2_w = nyp2+NADV !!nyp5 nyp4 nyp3 nyp2 +integer, parameter :: dimx1_s = -2-NADVS !!-4 -3 -2 -2 +integer, parameter :: dimx2_s = nxp3+NADVS !!nxp5 nxp4 nxp3 nxp3 +integer, parameter :: dimy1_s = 1-(3+NADVS)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-3*YES3D +integer, parameter :: dimy2_s = nyp3+NADVS !!nyp5 nyp4 nyp3 nyp3 + +integer, parameter :: ncols = nx*ny +integer, parameter :: nadams = 3 + +! Vertical grid parameters: +real z(nz) ! height of the pressure levels above surface,m +real pres(nzm) ! pressure,mb at scalar levels +real zi(nz) ! height of the interface levels +real presi(nz) ! pressure,mb at interface levels +real adz(nzm) ! ratio of the thickness of scalar levels to dz +real adzw(nz) ! ratio of the thinckness of w levels to dz +real pres0 ! Reference surface pressure, Pa + +integer:: nstep =0! current number of performed time steps +integer ncycle ! number of subcycles over the dynamical timestep +integer icycle ! current subcycle +integer:: na=1, nb=2, nc=3 ! indeces for swapping the rhs arrays for AB scheme +real at, bt, ct ! coefficients for the Adams-Bashforth scheme +real dtn ! current dynamical timestep (can be smaller than dt) +real dt3(3) ! dynamical timesteps for three most recent time steps +real(kind=selected_real_kind(12)):: time=0. ! current time in sec. +real day ! current day (including fraction) +real dtfactor ! dtn/dt + +! MPI staff: +integer rank ! rank of the current subdomain task (default 0) +integer ranknn ! rank of the "northern" subdomain task +integer rankss ! rank of the "southern" subdomain task +integer rankee ! rank of the "eastern" subdomain task +integer rankww ! rank of the "western" subdomain task +integer rankne ! rank of the "north-eastern" subdomain task +integer ranknw ! rank of the "north-western" subdomain task +integer rankse ! rank of the "south-eastern" subdomain task +integer ranksw ! rank of the "south-western" subdomain task +logical dompi ! logical switch to do multitasking +logical masterproc ! .true. if rank.eq.0 + +character(80) case ! id-string to identify a case-name(set in CaseName file) + +logical dostatis ! flag to permit the gathering of statistics +logical dostatisrad ! flag to permit the gathering of radiation statistics +integer nstatis ! the interval between substeps to compute statistics + +logical :: compute_reffc = .false. +logical :: compute_reffi = .false. + +logical notopened2D ! flag to see if the 2D output datafile is opened +logical notopened3D ! flag to see if the 3D output datafile is opened +logical notopenedmom ! flag to see if the statistical moment file is opened + +!----------------------------------------- +! Parameters controled by namelist PARAMETERS + +real:: dx =0. ! grid spacing in x direction +real:: dy =0. ! grid spacing in y direction +real:: dz =0. ! constant grid spacing in z direction (when dz_constant=.true.) +logical:: doconstdz = .false. ! do constant vertical grid spacing set by dz + +integer:: nstop =0 ! time step number to stop the integration +integer:: nelapse =999999999! time step number to elapse before stoping + +real:: dt=0. ! dynamical timestep +real:: day0=0. ! starting day (including fraction) + +integer:: nrad =1 ! frequency of calling the radiation routines +integer:: nprint =1000 ! frequency of printing a listing (steps) +integer:: nrestart =0 ! switch to control starting/restarting of the model +integer:: nstat =1000 ! the interval in time steps to compute statistics +integer:: nstatfrq =50 ! frequency of computing statistics + +logical:: restart_sep =.false. ! write separate restart files for sub-domains +integer:: nrestart_skip =0 ! number of skips of writing restart (default 0) +logical:: output_sep =.false. ! write separate 3D and 2D files for sub-domains + +character(80):: caseid =''! id-string to identify a run +character(80):: caseid_restart =''! id-string for branch restart file +character(80):: case_restart =''! id-string for branch restart file + +logical:: doisccp = .false. +logical:: domodis = .false. +logical:: domisr = .false. +logical:: dosimfilesout = .false. + +logical:: doSAMconditionals = .false. !core updraft,downdraft conditional statistics +logical:: dosatupdnconditionals = .false.!cloudy updrafts,downdrafts and cloud-free +logical:: doscamiopdata = .false.! initialize the case from a SCAM IOP netcdf input file +logical:: dozero_out_day0 = .false. +character(len=120):: iopfile='' +character(256):: rundatadir ='./RUNDATA' ! path to data directory + +integer:: nsave3D =1000 ! frequency of writting 3D fields (steps) +integer:: nsave3Dstart =99999999! timestep to start writting 3D fields +integer:: nsave3Dend =99999999 ! timestep to end writting 3D fields +logical:: save3Dbin =.false. ! save 3D data in binary format(no 2-byte compression) +logical:: save3Dsep =.false. ! use separate file for each time point for2-model +real :: qnsave3D =0. !threshold manimum cloud water(kg/kg) to save 3D fields +logical:: dogzip3D =.false. ! gzip compress a 3D output file +logical:: rad3Dout = .false. ! output additional 3D radiation foelds (like reff) + +integer:: nsave2D =1000 ! frequency of writting 2D fields (steps) +integer:: nsave2Dstart =99999999! timestep to start writting 2D fields +integer:: nsave2Dend =99999999 ! timestep to end writting 2D fields +logical:: save2Dbin =.false. ! save 2D data in binary format, rather than compressed +logical:: save2Dsep =.false. ! write separate file for each time point for 2D output +logical:: save2Davg =.false. ! flag to time-average 2D output fields (default .false.) +logical:: dogzip2D =.false. ! gzip compress a 2D output file if save2Dsep=.true. + +integer:: nstatmom =1000! frequency of writting statistical moment fields (steps) +integer:: nstatmomstart =99999999! timestep to start writting statistical moment fields +integer:: nstatmomend =99999999 ! timestep to end writting statistical moment fields +logical:: savemomsep =.false.! use one file with stat moments for each time point +logical:: savemombin =.false.! save statistical moment data in binary format + +integer:: nmovie =1000! frequency of writting movie fields (steps) +integer:: nmoviestart =99999999! timestep to start writting statistical moment fields +integer:: nmovieend =99999999 ! timestep to end writting statistical moment fields + +logical :: isInitialized_scamiopdata = .false. +logical :: wgls_holds_omega = .false. + +!----------------------------------------- +end module crmx_grid diff --git a/src/physics/spcam/crm/crmx_ice_fall.F90 b/src/physics/spcam/crm/crmx_ice_fall.F90 new file mode 100644 index 0000000000..f16a90ea15 --- /dev/null +++ b/src/physics/spcam/crm/crmx_ice_fall.F90 @@ -0,0 +1,124 @@ + +subroutine ice_fall() + + +! Sedimentation of ice: + +use crmx_vars +use crmx_microphysics, only: micro_field, index_cloud_ice +!use micro_params +use crmx_params + +implicit none + +integer i,j,k, kb, kc, kmax, kmin, ici +real coef,dqi,lat_heat,vt_ice +real omnu, omnc, omnd, qiu, qic, qid, tmp_theta, tmp_phi +real fz(nx,ny,nz) + +kmax=0 +kmin=nzm+1 + +do k = 1,nzm + do j = 1, ny + do i = 1, nx + if(qcl(i,j,k)+qci(i,j,k).gt.0..and. tabs(i,j,k).lt.273.15) then + kmin = min(kmin,k) + kmax = max(kmax,k) + end if + end do + end do +end do + +do k = 1,nzm + qifall(k) = 0. + tlatqi(k) = 0. +end do + +if(index_cloud_ice.eq.-1) return + +!call t_startf ('ice_fall') + +fz = 0. + +! Compute cloud ice flux (using flux limited advection scheme, as in +! chapter 6 of Finite Volume Methods for Hyperbolic Problems by R.J. +! LeVeque, Cambridge University Press, 2002). +do k = max(1,kmin-1),kmax + ! Set up indices for x-y planes above and below current plane. + kc = min(nzm,k+1) + kb = max(1,k-1) + ! CFL number based on grid spacing interpolated to interface i,j,k-1/2 + coef = dtn/(0.5*(adz(kb)+adz(k))*dz) + do j = 1,ny + do i = 1,nx + ! Compute cloud ice density in this cell and the ones above/below. + ! Since cloud ice is falling, the above cell is u (upwind), + ! this cell is c (center) and the one below is d (downwind). + + qiu = rho(kc)*qci(i,j,kc) + qic = rho(k) *qci(i,j,k) + qid = rho(kb)*qci(i,j,kb) + + ! Ice sedimentation velocity depends on ice content. The fiting is + ! based on the data by Heymsfield (JAS,2003). -Marat + vt_ice = min(0.4,8.66*(max(0.,qic)+1.e-10)**0.24) ! Heymsfield (JAS, 2003, p.2607) + + ! Use MC flux limiter in computation of flux correction. + ! (MC = monotonized centered difference). +! if (qic.eq.qid) then + if (abs(qic-qid).lt.1.0e-25) then ! when qic, and qid is very small, qic_qid can still be zero + ! even if qic is not equal to qid. so add a fix here +++mhwang + tmp_phi = 0. + else + tmp_theta = (qiu-qic)/(qic-qid) + tmp_phi = max(0.,min(0.5*(1.+tmp_theta),2.,2.*tmp_theta)) + end if + + ! Compute limited flux. + ! Since falling cloud ice is a 1D advection problem, this + ! flux-limited advection scheme is monotonic. + fz(i,j,k) = -vt_ice*(qic - 0.5*(1.-coef*vt_ice)*tmp_phi*(qic-qid)) + end do + end do +end do +fz(:,:,nz) = 0. + +ici = index_cloud_ice + +do k=max(1,kmin-2),kmax + coef=dtn/(dz*adz(k)*rho(k)) + do j=1,ny + do i=1,nx + ! The cloud ice increment is the difference of the fluxes. + dqi=coef*(fz(i,j,k)-fz(i,j,k+1)) + ! Add this increment to both non-precipitating and total water. + micro_field(i,j,k,ici) = micro_field(i,j,k,ici) + dqi + ! Include this effect in the total moisture budget. + qifall(k) = qifall(k) + dqi + + ! The latent heat flux induced by the falling cloud ice enters + ! the liquid-ice static energy budget in the same way as the + ! precipitation. Note: use latent heat of sublimation. + lat_heat = (fac_cond+fac_fus)*dqi + ! Add divergence of latent heat flux to liquid-ice static energy. + t(i,j,k) = t(i,j,k) - lat_heat + ! Add divergence to liquid-ice static energy budget. + tlatqi(k) = tlatqi(k) - lat_heat + end do + end do +end do + +coef=dtn/dz +do j=1,ny + do i=1,nx + dqi=-coef*fz(i,j,1) + precsfc(i,j) = precsfc(i,j)+dqi + precssfc(i,j) = precssfc(i,j)+dqi + end do +end do + +!call t_stopf ('ice_fall') + +end subroutine ice_fall + diff --git a/src/physics/spcam/crm/crmx_kurant.F90 b/src/physics/spcam/crm/crmx_kurant.F90 new file mode 100644 index 0000000000..502843bff8 --- /dev/null +++ b/src/physics/spcam/crm/crmx_kurant.F90 @@ -0,0 +1,56 @@ + +subroutine kurant + +use crmx_vars +use crmx_sgs, only: kurant_sgs + +implicit none + +integer i, j, k, ncycle1(1),ncycle2(1) +real wm(nz) ! maximum vertical wind velocity +real uhm(nz) ! maximum horizontal wind velocity +real cfl, cfl_sgs + +ncycle = 1 + +wm(nz)=0. +w_max =0. +u_max =0. +do k = 1,nzm + wm(k) = maxval(abs(w(1:nx,1:ny,k))) + uhm(k) = sqrt(maxval(u(1:nx,1:ny,k)**2+YES3D*v(1:nx,1:ny,k)**2)) +end do +w_max=max(w_max,maxval(w(1:nx,1:ny,1:nz))) +u_max=max(u_max,maxval(uhm(1:nzm))) + +cfl = 0. +do k=1,nzm + cfl = max(cfl,uhm(k)*dt*sqrt((1./dx)**2+YES3D*(1./dy)**2), & + max(wm(k),wm(k+1))*dt/(dz*adzw(k)) ) +end do + +call kurant_sgs(cfl_sgs) +cfl = max(cfl,cfl_sgs) + +ncycle = max(1,ceiling(cfl/0.7)) + +if(dompi) then + ncycle1(1)=ncycle + call task_max_integer(ncycle1,ncycle2,1) + ncycle=ncycle2(1) +end if +if(ncycle.gt.4) then + if(masterproc) print *,'the number of cycles exceeded 4.' +!+++ test +++mhwang + write(0, *) 'cfl', cfl, cfl_sgs, latitude(1, 1), longitude(1,1) + do k=1, nzm + write(0, *) 'k=', k, wm(k), uhm(k) + end do + do i=1, nx + write(0, *) 'i=', i, u(i, 1, 4), v(i, 1, 4), tabs(i,1,4) + end do +!---mhwang + call task_abort() +end if + +end subroutine kurant diff --git a/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 b/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 new file mode 100644 index 0000000000..bc1504872b --- /dev/null +++ b/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 @@ -0,0 +1,773 @@ +module crmx_module_ecpp_crm_driver +#ifdef ECPP +!------------------------------------------------------------------------ +! F90 module to prepare CRM output for ECPP module in the MMF model. +! +! This code was written originally by William Gustafson, and is adopted into +! the MMF model by Minghuai Wang (minghuai.wang@pnl.gov), November, 2009. +! +! Assumptiont built into this code: +! +! Open issues: +! - The mask for determining a "moving" or limited spatial average +! is not implemented. +! - The dependencies in Makefile don't work. If a compile fails, +! try "make clean; make" instead to clear out the module files. +! - For uv_in/out, a simple time average is being done and one can +! argue that it should be a weighted average since the number of in +! and out points changes with each time step. The affect is probably +! small for short time averages though. +! - When calculating the standard deviation of vertical velocity, +! each cell is treated equally and the std. dev. is over the 3 dims +! below the cloud tops. We may want to consider weighting each cell +! by either its volume or mass. +! - To get cloud values at vertical cell interface, a simple average +! is being done when an interpolation should technically be done. +! This only affects quiescent cloudy/clear categories. +! - Ditto for getting the density at the vertical cell interface (rho8w). +! +! Differences between the methodology here and in Ferret: +! - When calculating wup_bar and wdown_bar, points with w==0 are ignored +! here and were included in wup in Ferret. +! - Clear fluxes are no longer chopped off at the cloud top. +! - When calculating the std. dev. in and below the cloud, the level +! just above the cloud top is now included so we include w out the +! cloud top. +! - When determining "cloudyother" in Ferret the cloud above the +! interface was used. Now, the average of the cloud above and below +! is used. +! +! William.Gustafson@pnl.gov; 20-Jul-2006 +! v2.0 - Added two-level time averaging, one for the stats and a longer +! period for output. +! v2.1 - 25-Jul-2006; Fixed sign bug with uv_in/out. +! +! v3.0 - aug-sep-2006 - many changes by r.easter and s.ghan +! major change is option for multiple up and downdraft classes +! +! v3.1 - 02-nov-2006 r.easter - replaced uv_in/outsum with u_in/outsum +! & v_in/outsum +! +! v4.0 - 25-Jan-2007, wig; +! - Added areaavgtype switch to output final areas either as +! instantaneous, averaged over the last ntavg1 period of each +! ntavg2 avg, or as averaged over ntavg2. +! - Output areas as average over ntavg2 and also just at end +! of it. +! - Added entrainment averages to output (do not divide by dz). +! +! postproc_wrfout_bb.f90 from postproc_wrfout.f90 - 15-nov-2007, rce; +! - do multiple processings +! +! v5.0 - Nov-2008, wig +! - Major rewrite to include combinations of cloud, precipitation, +! and transport classes +! - Output format changes to multi-dimensional variables based +! on the classes instead of outputting each class separately +! +! 14-Apr-2009, wig: Fixed bug with mode_updnthresh at model top for +! bad calculation of w thresholds. +! +! 16-Apr-2009, wig: Added qcloud weighting to qlsink averages +! +!---------------------------------------------------------------------------------------- + use crmx_ecppvars + use crmx_ecppvars, only: QUI, UP1, DN1, NCLASS_TR, NCLASS_CL, CLR, CLD, NCLASS_PR, PRN, PRY + use cam_abortutils, only: endrun + + public ecpp_crm_stat + public ecpp_crm_init + public ecpp_crm_cleanup + + integer, public :: ntavg1_ss, ntavg2_ss + + private + save + + integer :: nxstag, nystag, nzstag + integer :: itavg1, itavg2, & + ntavg1, ntavg2 + + integer :: mode_updnthresh + integer :: areaavgtype + ! Methodology to compute final area averages: + ! 0 = area categories based on instantaneous + ! values at last time step of ntavg2 + ! 1 = area cat. based on last ntavg1 avgeraging + ! period of each ntavg2 period + ! 2 = area cat. based on average of full ntavg2 + ! period + integer :: plumetype + ! 1 = single plume + ! 2 = two plumes, core and weak + ! 3 = multi-plume, number based on setting of + ! allcomb + logical :: allcomb + ! true if updrafts and downdrafts have all + ! combinations of bases and tops. + real :: cloudthresh, & + prcpthresh, & + downthresh, downthresh2, & + upthresh, upthresh2 + + real :: cloudthresh_trans, & ! the threshold total cloud water for updraft or downdraft + precthresh_trans ! the threshold total rain, snow and graupel for clear, updraft or downdraft + + integer, dimension(:),allocatable :: & + updraftbase, updrafttop, dndrafttop, dndraftbase + integer :: nupdraft, ndndraft + integer :: ndraft_max, nupdraft_max, ndndraft_max + +contains + +!======================================================================================== +subroutine ecpp_crm_init() + + use crmx_grid, only: nx, ny, nzm, dt + use crmx_module_ecpp_stats, only: zero_out_sums1, zero_out_sums2 + use module_ecpp_ppdriver2, only: nupdraft_in, ndndraft_in, ncls_ecpp_in + implicit none + + integer :: kbase, ktop + integer :: m + integer :: nup, ndn + character(len=100) :: msg + + nxstag = nx+1 + nystag = ny+1 + nzstag = nzm+1 + +! ntavg1_ss and ntavg1_ss are defined in crm.F90 in the MMF model. +! ntavg1_ss = dt_gl ! GCM time step +! ntavg1_ss = number of seconds to average between computing categories. +! ntavg2_ss = dt_gl ! GCM time step +! ntavg2_ss = number of seconds to average between outputs. +! This must be a multiple of ntavgt1_ss. + + mode_updnthresh = 16 +! 1 = method originally implemented by Bill G +! wup_thresh = wup_stddev*abs(upthresh) +! wdown_thresh = -wdown_stddev*abs(downthresh) +! 2 = similar to 1, but include the mean wup and wdown +! wup_thresh = wup_bar + wup_stddev*abs(upthresh) +! wdown_thresh = wdown_bar - wdown_stddev*abs(downthresh) +! 3 = user specifies an absolute threshold +! wup_thresh = abs(upthresh) +! wdown_thresh = -abs(downthresh) +! 4 = similar to 1, but do +! wup_thresh = wup_rms*abs(upthresh) +! wdown_thresh = -wdown_rms*abs(downthresh) +! +! 5 = see description in module_ecpp_stats.f90 +! 6, 7 = see descriptions in module_ecpp_stats.f90 +! 8, 9 = see descriptions in module_ecpp_stats.f90 +! 10, 11 = see descriptions in module_ecpp_stats.f90 +! 12, 13 = see descriptions in module_ecpp_stats.f90 + + upthresh = 1. !Multiples of std. dev. to classify as updraft + downthresh = 1. !Multiples of std. dev. to classify as downdraft + upthresh2 = 0.5 ! ...ditto, except for weaker 2nd draft type when plumetype=2 + downthresh2 = 0.5 + +#ifdef CLUBB_CRM + cloudthresh = 2e-7 !Cloud mixing ratio beyond which cell is "cloudy(liquid)" (kg/kg) + ! As now fractional cloudiness is used for classifying cloudy vs. clear, + ! reduce it from 1.0e-6 to 2.0e-7 +#else + cloudthresh = 1e-6 !Cloud mixing ratio beyond which cell is "cloudy(liquid)" (kg/kg) +#endif + + prcpthresh = 1e-6 !Preciptation rate (precr) beyond which cell is raining (kg/m2/s) + ! this is used to classify precipitating vs. nonprecipitating class for wet scavenging. + +!+++mhwang +! high thresholds are used to classify transport classes (following Xu et al., 2002, Q.J.R.M.S. +! + cloudthresh_trans = 1e-5 !Cloud mixing ratio beyond which cell is "cloudy" to classify transport classes (kg/kg) +++mhwang + ! the maxium of cloudthres_trans and 0.01*qvs is used to classify transport class + precthresh_trans = 1e-4 !Preciptation mixing ratio beyond which cell is raining to classify transport classes (kg/kg) !+++mwhang +!---mhwang + + areaavgtype= 1 !final area avg over 0=instantaneous, 1=ntavg1, 2=ntavg2 + plumetype = 1 !1 for single plume, 2 for core and weak plumes, 3 for multiple plumes + allcomb = .false. !true for all combinations of plume bases and tops, false for 1 plume per base + +!---------------------------------------------------------------------------------- +! Sanity check... +!---------------------------------------------------------------------------------- + + if(plumetype>3)then + msg = 'ecpp_crm, plumetype must be <=3' + call endrun(trim(msg)) + endif + + if(plumetype<3 .and. allcomb)then + msg='ecpp_crm, allcomb=true requires plumetype=3' + call endrun(trim(msg)) + endif + + if(areaavgtype>2)then + msg='ecpp_crm, areaavgtype must be <=2' + call endrun(trim(msg)) + endif + + if ((mode_updnthresh < 1) .or. (mode_updnthresh > 17)) then + msg='ecpp_crm, error - must have 1 <= mode_updnthresh <= 17' + call endrun(trim(msg)) + endif + + if( abs(upthresh2) > 0.90*abs(upthresh) ) then + msg='ecpp_crm, error - upthresh2 must be < 0.90*upthresh' + call endrun(trim(msg)) + end if + + if( abs(downthresh2) > 0.90*abs(downthresh) ) then + msg='ecpp_crm, error - downthresh2 must be < 0.90*downthresh' + call endrun(trim(msg)) + end if + +! determine number of updrafts and downdrafts +! +! updraft kbase & ktop definition: +! ww(i,j,k ) > wup_thresh for k=kbase+1:ktop +! <= wup_thresh at k=kbase and k=ktop+1 +! they identify the "T-points" which enclose the updraft "W-points" +! and are affected by the subgrid transport of this updraft +! +! downdraft kbase & ktop definition: +! ww(i,j,k ) < wdown_thresh for k=kbase+1:ktop +! >= wdown_thresh at k=kbase and k=ktop+1 +! they identify the "T-points" which enclose the downdraft "W-points" +! and are affected by the subgrid transport of this downdraft +! +! for both updrafts and downdrafts, +! 1 <= kbase < ktop < nzstag + + nupdraft = 0 + ndndraft = 0 + nupdraft_max = 0 + ndndraft_max = 0 + + select case (plumetype) + case (1) !single plume + nupdraft = 1 + ndndraft = 1 + case (2) !core and weak plumes + nupdraft = 2 + ndndraft = 2 + case (3) + do kbase=1,nzm-1 + if(allcomb)then ! all possible tops + nupdraft=nupdraft+nzm-kbase + else ! one top per base + nupdraft=nupdraft+1 + endif + enddo + do ktop=nzm,2,-1 + if(allcomb)then ! all possible bases + ndndraft=ndndraft+ktop-1 + else ! one base per top + ndndraft=ndndraft+1 + endif + enddo + end select + + nupdraft_max = max( nupdraft_max, nupdraft ) + ndndraft_max = max( ndndraft_max, ndndraft ) + + DN1 = nupdraft + 2 !Setup index of first downdraft class + NCLASS_TR = nupdraft + ndndraft + 1 + + ndraft_max = 1 + nupdraft_max + ndndraft_max + + if(NCLASS_TR.ne.ncls_ecpp_in) then + call endrun('NCLASS_TR should be equal to ncls_ecpp_in') + end if + if((nupdraft.ne.nupdraft_in) .or. (ndndraft.ne.ndndraft_in)) then + call endrun('nupdraft or ndndraft is not set correctly') + end if + + allocate (updraftbase(nupdraft_max), & + updrafttop( nupdraft_max) ) + allocate (dndraftbase(ndndraft_max), & + dndrafttop( ndndraft_max) ) + + select case (plumetype) + case (1) !single plume + updraftbase(1)=1 + updrafttop( 1)=nzm + dndrafttop( 1)=nzm + dndraftbase(1)=1 + case (2) + updraftbase(1:2)=1 + updrafttop( 1:2)=nzm + dndrafttop( 1:2)=nzm + dndraftbase(1:2)=1 + case (3) + m=0 + do kbase=1,nzm-1 + if(allcomb)then ! loop over all possible tops. + do ktop=kbase+1,nzm + m=m+1 + updraftbase(m)=kbase + updrafttop( m)=ktop + enddo + else ! only one top per base + m=m+1 + updraftbase(m)=kbase + updrafttop( m)=nzm + endif + enddo + + m=0 + do ktop=nzm,2,-1 + if(allcomb)then ! loop over all possible bases. + do kbase=ktop-1,1,-1 + m=m+1 + dndrafttop( m)=ktop + dndraftbase(m)=kbase + enddo + else ! only one base per top + m=m+1 + dndrafttop( m)=ktop + dndraftbase(m)=1 + endif + enddo + end select + +!--------------------------------------------------------------------------- +! Allocate arrays +!--------------------------------------------------------------------------- + allocate( qlsink(nx,ny,nzm), precr(nx,ny,nzm), precsolid(nx,ny,nzm), rh(nx, ny, nzm), qvs(nx, ny, nzm)) + + allocate( qlsink_bf(nx, ny, nzm), prain(nx, ny, nzm), qcloud_bf(nx, ny, nzm)) + + allocate( qcloudsum1(nx,ny,nzm), qcloud_bfsum1(nx,ny,nzm), qrainsum1(nx,ny,nzm), & + qicesum1(nx,ny,nzm), qsnowsum1(nx,ny,nzm), qgraupsum1(nx,ny,nzm), & + qlsinksum1(nx,ny,nzm), precrsum1(nx,ny,nzm), & + precsolidsum1(nx,ny,nzm), precallsum1(nx,ny,nzm), & + altsum1(nx,ny,nzm), rhsum1(nx,ny,nzm), cf3dsum1(nx,ny,nzm), & + wwsum1(nx,ny,nzstag), wwsqsum1(nx,ny,nzstag), & + tkesgssum1(nx, ny, nzm), qlsink_bfsum1(nx, ny, nzm), prainsum1(nx, ny, nzm), qvssum1(nx, ny, nzm) ) + + allocate( & + xkhvsum(nzm) ) + + allocate( wwqui_cen_sum(nzm), wwqui_bnd_sum(nzm+1), & + wwqui_cloudy_cen_sum(nzm), wwqui_cloudy_bnd_sum(nzm+1)) + + allocate( wup_thresh(nzm+1), wdown_thresh(nzm+1)) + + allocate( area_bnd_final( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & + area_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & + area_cen_final( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + area_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + mass_bnd_final( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & + mass_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & + mass_cen_final( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + mass_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + ent_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & + rh_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qcloud_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qcloud_bf_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qrain_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qice_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qsnow_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qgraup_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qlsink_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + precr_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + precsolid_cen_sum(nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + precall_cen_sum(nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qlsink_bf_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + qlsink_avg_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & + prain_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR) ) + +! Initialize the running sums. + call zero_out_sums1( qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & + qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & + qlsinksum1(:,:,:), precrsum1(:,:,:), & + precsolidsum1(:,:,:), precallsum1(:,:,:), & + altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & + wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & + qlsink_bfsum1(:,:,:), prainsum1(:,:,:), qvssum1(:,:,:) ) + ndn = ndndraft ; nup = nupdraft + call zero_out_sums2( & + xkhvsum(:), & + wwqui_cen_sum(:), wwqui_bnd_sum(:), wwqui_cloudy_cen_sum(:), wwqui_cloudy_bnd_sum(:), & + area_bnd_final(:,:,1:1+nup+ndn,:), area_bnd_sum(:,:,1:1+nup+ndn,:), & + area_cen_final(:,:,1:1+nup+ndn,:), area_cen_sum(:,:,1:1+nup+ndn,:), & + mass_bnd_final(:,:,1:1+nup+ndn,:), mass_bnd_sum(:,:,1:1+nup+ndn,:), & + mass_cen_final(:,:,1:1+nup+ndn,:), mass_cen_sum(:,:,1:1+nup+ndn,:), & + ent_bnd_sum(:,:,1:1+nup+ndn,:), & + rh_cen_sum(:,:,1:1+nup+ndn,:), & + qcloud_cen_sum(:,:,1:1+nup+ndn,:), qcloud_bf_cen_sum(:,:,1:1+nup+ndn,:), qrain_cen_sum(:,:,1:1+nup+ndn,:), & + qice_cen_sum(:,:,1:1+nup+ndn,:), qsnow_cen_sum(:,:,1:1+nup+ndn,:), & + qgraup_cen_sum(:,:,1:1+nup+ndn,:), & + qlsink_cen_sum(:,:,1:1+nup+ndn,:), precr_cen_sum(:,:,1:1+nup+ndn,:), & + precsolid_cen_sum(:,:,1:1+nup+ndn,:), precall_cen_sum(:,:,1:1+nup+ndn,:), & + qlsink_bf_cen_sum(:,:,1:1+nup+ndn,:), qlsink_avg_cen_sum(:,:,1:1+nup+ndn,:), & + prain_cen_sum(:,:,1:1+nup+ndn,:) ) + + wup_thresh(:) = 0.0 + wdown_thresh(:) = 0.0 + + ntavg1 = ntavg1_ss / dt + ntavg2 = ntavg2_ss / dt + itavg1 = 0 + itavg2 = 0 + +end subroutine ecpp_crm_init +!--------------------------------------------------------------------------------------- + +!======================================================================================= +subroutine ecpp_crm_cleanup () + +! deallocate variables + deallocate (updraftbase, & + updrafttop ) + deallocate (dndraftbase, & + dndrafttop ) + + deallocate( qlsink, precr, precsolid, rh, qvs) + + deallocate( qlsink_bf, prain, qcloud_bf) + + deallocate( qcloudsum1, qcloud_bfsum1, qrainsum1, & + qicesum1, qsnowsum1, qgraupsum1, & + qlsinksum1, precrsum1, & + precsolidsum1, precallsum1, & + altsum1, rhsum1, cf3dsum1, & + wwsum1, wwsqsum1, tkesgssum1, & + qlsink_bfsum1, prainsum1, qvssum1 ) + + deallocate( & + xkhvsum, wup_thresh, wdown_thresh ) + + deallocate(wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum) + + deallocate( area_bnd_final, & + area_bnd_sum, & + area_cen_final, & + area_cen_sum, & + mass_bnd_final, & + mass_bnd_sum, & + mass_cen_final, & + mass_cen_sum, & + ent_bnd_sum, & + rh_cen_sum, & + qcloud_cen_sum, & + qcloud_bf_cen_sum, & + qrain_cen_sum, & + qice_cen_sum, & + qsnow_cen_sum, & + qgraup_cen_sum, & + qlsink_cen_sum, & + precr_cen_sum, & + precsolid_cen_sum, & + precall_cen_sum, & + qlsink_bf_cen_sum, & + qlsink_avg_cen_sum, & + prain_cen_sum ) + +end subroutine ecpp_crm_cleanup +!--------------------------------------------------------------------------------------- + +!======================================================================================== +subroutine ecpp_crm_stat() + + use crmx_module_ecpp_stats + use module_data_ecpp1, only: afrac_cut + use crmx_grid, only: nx, ny, nzm, pres + use crmx_vars, only: w, tabs, p, CF3D + use crmx_sgs, only: tke, tk + use crmx_microphysics, only: micro_field, iqv, iqci, iqr, iqs, iqg, cloudliq + use crmx_module_mp_GRAUPEL, only: POLYSVP +#ifdef CLUBB_CRM + use crmx_clubbvars, only: wp2 + use crmx_sgs, only: tk_clubb +#endif + implicit none + + integer :: i, ierr, i_tidx, j, & + ncnt1, ncnt2 + + integer :: nup, ndn + integer :: kbase, ktop, m + integer :: ii, jj, kk + integer :: icl, icls, ipr + + real,dimension(nx, ny, nzm) :: & + qcloud, qrain, qice, qsnow, qgraup, & + precall, alt, xkhv + real, dimension(nx, ny, nzstag) :: ww, wwsq + + real :: EVS + +!------------------------------------------------------------------------ +! Main code section... +!------------------------------------------------------------------------ + + ndn = ndndraft ; nup = nupdraft + + itavg1 = itavg1 + 1 + itavg2 = itavg2 + 1 + ndn = ndndraft ; nup = nupdraft + +! Get values from SAM cloud fields + qcloud(1:nx,1:ny,1:nzm) = cloudliq(1:nx,1:ny,1:nzm) + qrain(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqr) + qice(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqci) + qsnow(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) + qgraup(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqg) + + precall(:,:,:)= precr(:,:,:) + precsolid(:,:,:) + + do ii=1, nx + do jj=1, ny + do kk=1, nzm + EVS = POLYSVP(tabs(ii,jj,kk),0) ! saturation water vapor pressure (PA) + qvs(ii,jj,kk) = .622*EVS/(pres(kk)*100.-EVS) ! pres(kk) with unit of hPa +! rh(ii,jj,kk) = micro_field(ii,jj,kk,iqv)/QVS ! unit 0-1 +! rh(ii,jj,kk) = min(1.0, rh(ii,jj,kk)) ! RH is diagnosed in microphysics + alt(ii,jj,kk) = 287.*tabs(ii,jj,kk)/(100.*pres(kk)) + + end do + end do + end do + + ww(:,:,:) = w(1:nx,1:ny,1:nzstag) +#ifdef CLUBB_CRM + wwsq(:,:,:) = sqrt(wp2(1:nx, 1:ny, 1:nzstag)) +#else + wwsq(:,:,:) = 0. ! subgrid vertical velocity is not used in the current version of ECPP. +#endif + +#ifdef CLUBB_CRM + xkhv(:,:,:) = tk_clubb(1:nx,1:ny,1:nzm) ! eddy viscosity m2/s +#else + xkhv(:,:,:) = tk(1:nx,1:ny,1:nzm) ! eddy viscosity m2/s +#endif + +!+++mhwangtest +! do ii=1, nx +! do jj=1, ny +! do kk=1, nzm +! if(prain(ii,jj,kk).gt.1.0e-15) then +! if(qcloud_bf(ii,jj,kk)*qlsink_bf(ii,jj,kk)/prain(ii,jj,kk) .lt. 0.90) then +! write(0, *) 'qcloud_bf*qlsink_bf/prain, qlsink_bf, qlsink, qlcoud_bf, qcloud, prain', qcloud_bf(ii,jj,kk)*qlsink_bf(ii,jj,kk)/prain(ii,jj,kk), & +! qlsink_bf(ii, jj, kk) * 86400, qlsink(ii, jj, kk)*86400, qcloud_bf(ii, jj, kk), qcloud(ii, jj, kk), prain(ii, jj, kk) +! end if +! end if +! end do +! end do +! end do +!---mhwangest + + +! Increment the 3-D running sums for averaging period 1. + call rsums1( qcloud, qcloudsum1(:,:,:), & + qcloud_bf, qcloud_bfsum1(:,:,:), & + qrain, qrainsum1(:,:,:), & + qice, qicesum1(:,:,:), & + qsnow, qsnowsum1(:,:,:), & + qgraup, qgraupsum1(:,:,:), & + qlsink, qlsinksum1(:,:,:), & + precr, precrsum1(:,:,:), & + precsolid, precsolidsum1(:,:,:), & + precall, precallsum1(:,:,:), & + alt, altsum1(:,:,:), & + rh, rhsum1(:,:,:), & + CF3D, cf3dsum1(:,:,:), & + ww, wwsum1(:,:,:), & + wwsq, wwsqsum1(:,:,:), & + tke(1:nx,1:ny,1:nzm), tkesgssum1(:,:,:), & + qlsink_bf, qlsink_bfsum1(:,:,:), & + prain, prainsum1(:,:,:), & + qvs, qvssum1(:,:,:) ) + +! Increment the running sums for the level two variables that are not +! already incremented. Consolidate from 3-D to 1-D columns. + call rsums2( & + nx, ny, nzm, & + xkhv, xkhvsum(:) ) + +! Check if we have reached the end of the level 1 time averaging period. + if( mod(itavg1,ntavg1) == 0 ) then + +! Turn the running sums into averages. + if( itavg1 /= 0 ) then + ncnt1 = ntavg1 + else + ncnt1 = 1 + end if + call rsums1ToAvg( ncnt1, qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & + qicesum1(:,:,:), qsnowsum1(:,:,:), & + qgraupsum1(:,:,:), & + qlsinksum1(:,:,:), precrsum1(:,:,:), & + precsolidsum1(:,:,:), precallsum1(:,:,:), & + altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & + wwsum1(:,:,:), wwsqsum1(:,:,:), & + tkesgssum1(:,:,:), qlsink_bfsum1(:,:,:), & + prainsum1(:,:,:), qvssum1(:,:,:) ) + +! Determine draft categories and get running sums of them. + call categorization_stats( .true., & + nx, ny, nzm, nupdraft, ndndraft, ndraft_max, & + mode_updnthresh, upthresh, downthresh, & + upthresh2, downthresh2, cloudthresh, prcpthresh, & + cloudthresh_trans, precthresh_trans, & + qvssum1(:,:,:), & + plumetype, allcomb, & + updraftbase(1:nupdraft), updrafttop(1:nupdraft), & + dndraftbase(1:ndndraft), dndrafttop(1:ndndraft), & + qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & + qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & + qlsinksum1(:,:,:), precrsum1(:,:,:), & + precsolidsum1(:,:,:), precallsum1(:,:,:), & + altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & + wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & + qlsink_bfsum1(:,:,:), prainsum1(:,:,:), & + area_bnd_final(:,:,1:1+ndn+nup,:), area_cen_final(:,:,1:1+ndn+nup,:), & + area_bnd_sum(:,:,1:1+ndn+nup,:), area_cen_sum(:,:,1:1+ndn+nup,:), & + ent_bnd_sum(:,:,1:1+ndn+nup,:), mass_bnd_sum(:,:,1:1+ndn+nup,:), & + rh_cen_sum(:,:,1:1+ndn+nup,:), & + qcloud_cen_sum(:,:,1:1+ndn+nup,:), qcloud_bf_cen_sum(:,:,1:1+ndn+nup,:), qrain_cen_sum(:,:,1:1+ndn+nup,:), & + qice_cen_sum(:,:,1:1+ndn+nup,:), qsnow_cen_sum(:,:,1:1+ndn+nup,:), & + qgraup_cen_sum(:,:,1:1+ndn+nup,:), & + qlsink_cen_sum(:,:,1:1+ndn+nup,:), precr_cen_sum(:,:,1:1+ndn+nup,:), & + precsolid_cen_sum(:,:,1:1+nup+ndn,:), precall_cen_sum(:,:,1:1+nup+ndn,:), & + qlsink_bf_cen_sum(:,:,1:1+nup+ndn,:), prain_cen_sum(:,:,1:1+nup+ndn,:), & + wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & + wup_thresh, wdown_thresh ) + +! If we want final area categories based on the last avg1 period in each +! avg2 then we need to zero out the running sum just created for the areas +! if it is not the last block of time in ntavg2 + if( areaavgtype==1 .and. .not. mod(itavg2,ntavg2)==0 ) then + call zero_out_areas( & + area_bnd_final(:,:,1:1+ndn+nup,:), & + area_cen_final(:,:,1:1+ndn+nup,:) ) + end if + +! Done with time level one averages so zero them out for next period. + call zero_out_sums1( qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & + qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & + qlsinksum1(:,:,:), precrsum1(:,:,:), & + precsolidsum1(:,:,:), precallsum1(:,:,:), & + altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & + wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & + qlsink_bfsum1(:,:,:), prainsum1(:,:,:), qvssum1(:,:,:) ) + + end if !End of time level one averaging period + +! Check if we have reached the end of a level 2 averaging period. + if( mod(itavg2,ntavg2) == 0 ) then + +! Turn the running sums into averages. ncnt1 in this case is the number +! of calls to categorization_stats during the level 2 averaging period, +! which increment the bnd/cen arrays. + if( itavg2 /= 0 ) then + ncnt1 = ntavg2_ss/ntavg1_ss + ncnt2 = ntavg2 + else + ncnt1 = 1 + ncnt2 = 1 + end if + + call rsums2ToAvg( areaavgtype, nx, ny, ncnt1, ncnt2, & + xkhvsum(:), & + wwqui_cen_sum(:), wwqui_bnd_sum(:), wwqui_cloudy_cen_sum(:), wwqui_cloudy_bnd_sum(:), & + area_bnd_final(:,:,1:1+ndn+nup,:), area_bnd_sum(:,:,1:1+ndn+nup,:), & + area_cen_final(:,:,1:1+ndn+nup,:), area_cen_sum(:,:,1:1+ndn+nup,:), & + mass_bnd_final(:,:,1:1+ndn+nup,:), mass_bnd_sum(:,:,1:1+ndn+nup,:), & + mass_cen_final(:,:,1:1+ndn+nup,:), mass_cen_sum(:,:,1:1+ndn+nup,:), & + ent_bnd_sum(:,:,1:1+ndn+nup,:), & + rh_cen_sum(:,:,1:1+ndn+nup,:), & + qcloud_cen_sum(:,:,1:1+ndn+nup,:), qcloud_bf_cen_sum(:,:,1:1+ndn+nup,:), qrain_cen_sum(:,:,1:1+ndn+nup,:), & + qice_cen_sum(:,:,1:1+ndn+nup,:), qsnow_cen_sum(:,:,1:1+ndn+nup,:), & + qgraup_cen_sum(:,:,1:1+ndn+nup,:), & + qlsink_cen_sum(:,:,1:1+ndn+nup,:), precr_cen_sum(:,:,1:1+ndn+nup,:), & + precsolid_cen_sum(:,:,1:1+ndn+nup,:), precall_cen_sum(:,:,1:1+ndn+nup,:), & + qlsink_bf_cen_sum(:,:,1:1+ndn+nup,:), prain_cen_sum(:,:,1:1+ndn+nup,:) ) + +! get in-cloud value for rh, qcloud, qrain, qice, qsnow, qgraup, +! percr, precsolid, and precall. (qlsink is already in-cloud values) + do kk=1, nzm + do icl=1, NCLASS_CL + do icls=1, ncls_ecpp_in + do ipr=1, NCLASS_PR + if(area_cen_sum(kk, icl, icls, ipr).gt.afrac_cut) then + rh_cen_sum(kk,icl,icls,ipr) = rh_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qcloud_cen_sum(kk,icl,icls,ipr) = qcloud_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qcloud_bf_cen_sum(kk,icl,icls,ipr) = qcloud_bf_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qrain_cen_sum(kk,icl,icls,ipr) = qrain_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qice_cen_sum(kk,icl,icls,ipr) = qice_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qsnow_cen_sum(kk,icl,icls,ipr) = qsnow_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + qgraup_cen_sum(kk,icl,icls,ipr) = qgraup_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + precr_cen_sum(kk,icl,icls,ipr) = precr_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + precsolid_cen_sum(kk,icl,icls,ipr) = precsolid_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + precall_cen_sum(kk,icl,icls,ipr) = precall_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + prain_cen_sum(kk,icl,icls,ipr) = prain_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) + if(qcloud_bf_cen_sum(kk,icl,icls,ipr).gt.1.0e-10) then + qlsink_avg_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, & + prain_cen_sum(kk,icl,icls,ipr)/qcloud_bf_cen_sum(kk,icl,icls,ipr)) + else + qlsink_avg_cen_sum(kk,icl,icls,ipr) = 0.0 + end if + qlsink_bf_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, qlsink_bf_cen_sum(kk,icl,icls,ipr)) + qlsink_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, qlsink_cen_sum(kk,icl,icls,ipr)) + else + rh_cen_sum(kk,icl,icls,ipr) = 0.0 + qcloud_cen_sum(kk,icl,icls,ipr) = 0.0 + qcloud_bf_cen_sum(kk,icl,icls,ipr) = 0.0 + qrain_cen_sum(kk,icl,icls,ipr) = 0.0 + qice_cen_sum(kk,icl,icls,ipr) = 0.0 + qsnow_cen_sum(kk,icl,icls,ipr) = 0.0 + qgraup_cen_sum(kk,icl,icls,ipr) = 0.0 + precr_cen_sum(kk,icl,icls,ipr) = 0.0 + precsolid_cen_sum(kk,icl,icls,ipr) = 0.0 + precall_cen_sum(kk,icl,icls,ipr) = 0.0 + qlsink_bf_cen_sum(kk,icl,icls,ipr) = 0.0 + prain_cen_sum(kk,icl,icls,ipr) = 0.0 + qlsink_avg_cen_sum(kk,icl,icls,ipr) = 0.0 + qlsink_bf_cen_sum(kk,icl,icls,ipr) = 0.0 + qlsink_cen_sum(kk,icl,icls,ipr) = 0.0 + end if + end do + end do + end do +! +! calculate vertical velocity variance for quiescent class + if(sum(area_cen_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)).gt.afrac_cut) then + wwqui_cen_sum(kk) = wwqui_cen_sum(kk) / sum(area_cen_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)) + else + wwqui_cen_sum(kk) = 0.0 + end if + if(sum(area_cen_sum(kk,CLD, QUI, 1:NCLASS_PR)).gt.afrac_cut) then + wwqui_cloudy_cen_sum(kk) = wwqui_cloudy_cen_sum(kk) / sum(area_cen_sum(kk, CLD, QUI, 1:NCLASS_PR)) + else + wwqui_cloudy_cen_sum(kk) = 0.0 + end if + + end do ! kk +! +! calcualte vertical velocity variance for quiescent calss at lay boundary + do kk=1, nzm+1 + if(sum(area_bnd_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)).gt.afrac_cut) then + wwqui_bnd_sum(kk) = wwqui_bnd_sum(kk) / sum(area_bnd_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)) + else + wwqui_bnd_sum(kk) = 0.0 + end if + if(sum(area_bnd_sum(kk,CLD, QUI, 1:NCLASS_PR)).gt.afrac_cut) then + wwqui_cloudy_bnd_sum(kk) = wwqui_cloudy_bnd_sum(kk) / sum(area_bnd_sum(kk, CLD, QUI, 1:NCLASS_PR)) + else + wwqui_cloudy_bnd_sum(kk) = 0.0 + end if + end do + + end if !End of level two time averaging period + +end subroutine ecpp_crm_stat + +#endif /*ECPP*/ +end module crmx_module_ecpp_crm_driver diff --git a/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 b/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 new file mode 100644 index 0000000000..b1f7bf909f --- /dev/null +++ b/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 @@ -0,0 +1,1805 @@ +!------------------------------------------------------------------------ +! F90 module to calculate cloud-model stats needed as innput into ECPP. +! +! Routines in this module: +! boundary_inout +! categorization_stats +! cloud_prcp_check +! determine_transport_thresh +! rsums1 +! rsums1ToAvg +! rsums2 +! rsums2ToAvg +! setup_class_masks +! xyrsumof2d +! xyrsumof3d +! zero_out_areas +! zero_out_sums1 +! zero_out_sums2 +! +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: 16-Apr-2009, William.Gustafson@pnl.gov +!------------------------------------------------------------------------ +module crmx_module_ecpp_stats +#ifdef ECPP + + use crmx_ecppvars, only: QUI, UP1, DN1, NCLASS_TR, NCLASS_CL, CLR, CLD, NCLASS_PR, PRN, PRY + use cam_abortutils,only: endrun + implicit none + +contains + +!------------------------------------------------------------------------ +subroutine boundary_inout( & + nx, ny, nz, & + uu, vv, & + u_insum, u_outsum, v_insum, v_outsum ) +! Calculates the average in/out-flow velocities and increments the +! running sum of the results. +! William.Gustafson@pnl.gov; 25-Jul-2006 +!------------------------------------------------------------------------ + integer, intent(in) :: nx, ny, nz + real, dimension(:,:,:), intent(in) :: uu, vv + real, dimension(:), intent(inout) :: u_insum, u_outsum, v_insum, v_outsum + + integer :: i, j, k, nxstag, nystag + real :: spd_in, spd_out + + nxstag = nx+1 + nystag = ny+1 +! +! Running sum of inflow/outflow horizontal velocities... +! +! 02-nov-2006 r.easter +! calculate separate in/outflow along x and y boundaries +! because of possibility of fixed boundary conditions +! and non-square domains +! for u_in & u_out, we want the "lineal" average along +! the west and east boundaries, so divide by ny +! for v_in & v_out, we want the "lineal" average along +! the south and north boundaries, so divide by nx +! previous code version divided by "nin" and "nout" +! which is incorrect +! + do k=1,nz + + spd_in = 0.; spd_out = 0. + do j=1,ny + ! Western boundary + if( uu(1,j,k) >= 0. ) then + spd_in = spd_in + uu(1,j,k) + else + spd_out = spd_out - uu(1,j,k) + end if + + ! Eastern boundary + if( uu(nxstag,j,k) <= 0. ) then + spd_in = spd_in - uu(nxstag,j,k) + else + spd_out = spd_out + uu(nxstag,j,k) + end if + end do !j=ny + u_insum(k) = u_insum(k) + spd_in /real(ny) + u_outsum(k) = u_outsum(k) + spd_out/real(ny) + + spd_in = 0.; spd_out = 0. + do i=1,nx + ! Southern boundary + if( vv(i,1,k) >= 0. ) then + spd_in = spd_in + vv(i,1,k) + else + spd_out = spd_out - vv(i,1,k) + end if + + ! Northern boundary + if( vv(i,nystag,k) <= 0. ) then + spd_in = spd_in - vv(i,nystag,k) + else + spd_out = spd_out + vv(i,nystag,k) + end if + end do !i=nx + v_insum(k) = v_insum(k) + spd_in /real(nx) + v_outsum(k) = v_outsum(k) + spd_out/real(nx) + + end do !k=nz +end subroutine boundary_inout + +!------------------------------------------------------------------------ +subroutine rsums1( qcloud, qcloudsum1, & + qcloud_bf, qcloud_bfsum1, & + qrain, qrainsum1, & + qice, qicesum1, & + qsnow, qsnowsum1, & + qgraup, qgraupsum1, & + qlsink, qlsinksum1, & + precr, precrsum1, & + precsolid, precsolidsum1, & + precall, precallsum1, & + alt, altsum1, & + rh, rhsum1, & + cf3d, cf3dsum1, & + ww, wwsum1, & + wwsq, wwsqsum1, & + tkesgs, tkesgssum1, & + qlsink_bf, qlsink_bfsum1, & + prain, prainsum1, & + qvs, qvssum1 ) + +! Increments 3-D running sums for the variables averaged every +! ntavg1_mm minutes. +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: William.Gustafson@pnl.gof; 25-Nov-2008 +!------------------------------------------------------------------------ + real, dimension(:,:,:), intent(in) :: & + qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & + qlsink, precr, precsolid, precall, & + alt, rh, cf3d, ww, wwsq, tkesgs, qlsink_bf, prain, qvs + real, dimension(:,:,:), intent(inout) :: & + qcloudsum1, qcloud_bfsum1, qrainsum1, & + qicesum1, qsnowsum1, qgraupsum1, & + qlsinksum1, precrsum1, precsolidsum1, precallsum1, & + altsum1, rhsum1, cf3dsum1, wwsum1, wwsqsum1, tkesgssum1, & + qlsink_bfsum1, prainsum1, qvssum1 + + qcloudsum1 = qcloudsum1 + qcloud + qcloud_bfsum1 = qcloud_bfsum1 + qcloud_bf + qrainsum1 = qrainsum1 + qrain + qicesum1 = qicesum1 + qice + qsnowsum1 = qsnowsum1 + qsnow + qgraupsum1 = qgraupsum1 + qgraup + qlsinksum1 = qlsinksum1 + qlsink*qcloud ! Note this is converted back in rsum2ToAvg + precrsum1 = precrsum1 + precr + precsolidsum1 = precsolidsum1 + precsolid + precallsum1 = precallsum1 + precall + altsum1 = altsum1 + alt + rhsum1 = rhsum1 + rh + cf3dsum1 = cf3dsum1 + cf3d + wwsum1 = wwsum1 + ww + wwsqsum1 = wwsqsum1 + wwsq + tkesgssum1 = tkesgssum1 + tkesgs + qlsink_bfsum1 = qlsink_bfsum1 + qlsink_bf*qcloud_bf ! Note this is converted back in rsum2ToAvg + prainsum1 = prainsum1 + prain + qvssum1 = qvssum1 + qvs + +end subroutine rsums1 + + +!------------------------------------------------------------------------ +subroutine rsums1ToAvg( nt, qcloudsum, qcloud_bfsum, qrainsum, & + qicesum, qsnowsum, qgraupsum, & + qlsinksum, precrsum, precsolidsum, precallsum, & + altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum ) +! Turns the columns of running sums into averages for the level one time +! period. +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 +!------------------------------------------------------------------------ + integer, intent(in) :: nt + real, dimension(:,:,:), intent(inout) :: & + qcloudsum, qcloud_bfsum, qrainsum, qicesum, qsnowsum, qgraupsum, & + qlsinksum, precrsum, precsolidsum, precallsum, & + altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum + + real :: ncount + +! print*,"...end of level one averaging period." + + ncount = real(nt) + + qcloudsum = qcloudsum/ncount + qcloud_bfsum = qcloud_bfsum/ncount + qrainsum = qrainsum/ncount + qicesum = qicesum/ncount + qsnowsum = qsnowsum/ncount + qgraupsum = qgraupsum/ncount + qlsinksum = qlsinksum/ncount + precrsum = precrsum/ncount + precsolidsum = precsolidsum/ncount + precallsum = precallsum/ncount + altsum = altsum/ncount + rhsum = rhsum/ncount + cf3dsum = cf3dsum/ncount + wwsum = wwsum/ncount + wwsqsum = wwsqsum/ncount + tkesgssum = tkesgssum/ncount + qlsink_bfsum = qlsink_bfsum/ncount + prainsum = prainsum/ncount + qvssum = qvssum/ncount +end subroutine rsums1ToAvg + +!------------------------------------------------------------------------ +subroutine rsums2( & + nx, ny, nz, & + xkhv, xkhvsum ) +! Increment the running sums for the level 2 time averaging period for +! variables that are not already incremented (i.e. not the area and mass +! flux categories and in/out-flow speed that are already done). The 3-D +! variables are collapsed to 1-D columns. +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 +!------------------------------------------------------------------------ + integer, intent(in) :: nx, ny, nz + real, dimension(:,:,:), intent(in) :: & + xkhv + real, dimension(:), intent(inout) :: & + xkhvsum + + integer :: i +! +! Running sums of the simple variables that will be averaged... +! + + call xyrsumof3d(xkhv,xkhvsum) +end subroutine rsums2 + + +!------------------------------------------------------------------------ +subroutine rsums2ToAvg( areaavgtype, nx, ny, nt1, nt2, & + xkhvsum, & + wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & + area_bnd_final, area_bnd_sum, & + area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, & + mass_cen_final, mass_cen_sum, & + ent_bnd_sum, & + rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, precr_cen_sum, & + precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, prain_cen_sum ) + +! Turns the columns of level two time period running sums into averages. +! Note that variables that the statistics variables use a different +! number of times. +! +! nt1 = time length of average for area and mass for areaavgtype=2 +! nt2 = time length of average for 2nd averaging period (the whole time) +! +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: 16-Apr-2009, wig +!------------------------------------------------------------------------ + integer, intent(in) :: areaavgtype, nx, ny, nt1, nt2 + real, dimension(:), intent(inout) :: & + xkhvsum, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum + real, dimension(:,:,:,:), intent(inout) :: & + area_bnd_final, area_bnd_sum, & + area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, & + mass_cen_final, mass_cen_sum, & + ent_bnd_sum, rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, precr_cen_sum, & + precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, prain_cen_sum + integer :: i, k + real :: ncount2, ncountwind, thesum + +! print*,"...end of level two averaging period." + + ncount2 = real(nx*ny*nt2) + ncountwind = real((nx+1)*ny*nt2) + + xkhvsum = xkhvsum/ncount2 + +! Only touch final areas if doing averages over ntavg2 + if( areaavgtype == 2 ) then + area_bnd_final = area_bnd_final/real(nt1) + area_cen_final = area_cen_final/real(nt1) + end if + + area_bnd_sum = area_bnd_sum/real(nt1) + area_cen_sum = area_cen_sum/real(nt1) + ent_bnd_sum = ent_bnd_sum/real(nt1) + mass_bnd_sum = mass_bnd_sum/real(nt1) + mass_cen_sum = mass_cen_sum/real(nt1) + rh_cen_sum = rh_cen_sum/real(nt1) + qcloud_cen_sum = qcloud_cen_sum/real(nt1) + qcloud_bf_cen_sum = qcloud_bf_cen_sum/real(nt1) + qrain_cen_sum = qrain_cen_sum/real(nt1) + qice_cen_sum = qice_cen_sum/real(nt1) + qsnow_cen_sum = qsnow_cen_sum/real(nt1) + qgraup_cen_sum = qgraup_cen_sum/real(nt1) + do k=1,size(qlsink_cen_sum,1) !Note: must be after qcloud_cen_sum is turned into an avg + ! see rsums1 where qlsink=qlsink*qcloud + thesum = sum(qcloud_cen_sum(k,:,:,:)) + if( thesum > 1e-25 ) then + qlsink_cen_sum(k,:,:,:) = qlsink_cen_sum(k,:,:,:)/thesum/real(nt1) + else + qlsink_cen_sum(k,:,:,:) = 0. + end if + end do + precr_cen_sum = precr_cen_sum/real(nt1) + precsolid_cen_sum = precsolid_cen_sum/real(nt1) + precall_cen_sum = precall_cen_sum/real(nt1) + do k=1,size(qlsink_bf_cen_sum,1) !Note: must be after qcloud_bf_cen_sum is turned into an avg + ! see rsums1 where qlsink=qlsink*qcloud + thesum = sum(qcloud_bf_cen_sum(k,:,:,:)) + if( thesum > 1e-25 ) then + qlsink_bf_cen_sum(k,:,:,:) = qlsink_bf_cen_sum(k,:,:,:)/thesum/real(nt1) + else + qlsink_bf_cen_sum(k,:,:,:) = 0. + end if + end do + + prain_cen_sum = prain_cen_sum/real(nt1) + wwqui_cen_sum = wwqui_cen_sum / real(nt1) + wwqui_bnd_sum = wwqui_bnd_sum / real(nt1) + wwqui_cloudy_cen_sum = wwqui_cloudy_cen_sum / real(nt1) + wwqui_cloudy_bnd_sum = wwqui_cloudy_bnd_sum / real(nt1) + +end subroutine rsums2ToAvg + + +!------------------------------------------------------------------------ +subroutine xyrsumof2d(xin,sumout) +! For a 2-D intput variable (x,y), the x & y dimensions are summed and +! added to a running sum. +! William.Gustafson@pnl.gov; 25-Apr-2006 +!------------------------------------------------------------------------ + real, dimension(:,:), intent(in) :: xin + real, intent(out) :: sumout + + sumout = 0.0 + sumout = sumout + sum(xin(:,:)) +end subroutine xyrsumof2d + + +!------------------------------------------------------------------------ +subroutine xyrsumof3d(xin,sumout) +! For a 3-D intput variable (x,y,z), the x & y dimensions are summed and +! added to a column to return a running sum. +! William.Gustafson@pnl.gov; 26-Jun-2006 +!------------------------------------------------------------------------ + real, dimension(:,:,:), intent(in) :: xin + real, dimension(:), intent(out) :: sumout + + integer :: k + + sumout(:) = 0.0 + do k=1,ubound(sumout,1) + sumout(k) = sumout(k) + sum(xin(:,:,k)) + end do +end subroutine xyrsumof3d + + +!------------------------------------------------------------------------ +subroutine zero_out_areas( & + area_bnd_final, area_cen_final ) +! Zeros out the running sums of final area categories. +! William.Gustafson@pnl.gov; 19-Nov-2008 +!------------------------------------------------------------------------ + real, dimension(:,:,:,:), intent(out) :: & + area_bnd_final, area_cen_final + + area_bnd_final=0. + area_cen_final=0. +end subroutine zero_out_areas + + +!------------------------------------------------------------------------ +subroutine zero_out_sums1( qcloudsum, qcloud_bfsum, qrainsum, & + qicesum, qsnowsum, qgraupsum, & + qlsink, precr, precsolid, precall, & + altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, & + qlsink_bfsum, prainsum, qvssum ) +! Zeros out running sum arrays that are averaged every ntavg1_mm minutes. +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 +!------------------------------------------------------------------------ + real,dimension(:,:,:), intent(out) :: & + qcloudsum, qcloud_bfsum, qrainsum, qicesum, qsnowsum, qgraupsum, & + qlsink, precr, precsolid, precall, & + altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum + + qcloudsum=0. + qcloud_bfsum=0. + qrainsum=0. + qicesum=0. + qsnowsum=0. + qgraupsum=0. + qlsink=0. + precr=0. + precsolid=0. + precall=0. + altsum=0. + rhsum=0. + cf3dsum=0. + wwsum=0. + wwsqsum=0. + tkesgssum=0. + qlsink_bfsum=0.0 + prainsum=0.0 + qvssum=0.0 +end subroutine zero_out_sums1 + + +!------------------------------------------------------------------------ +subroutine zero_out_sums2( & + xkhvsum, & + wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & + area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & + ent_bnd_sum, & + rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, & + precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum ) +! Zeros out running sum arrays that are averaged every ntavg2_mm minutes. +! William.Gustafson@pnl.gov; 20-Jul-2006 +! Last modified: 25-Nov-2008, wig +!------------------------------------------------------------------------ + real,dimension(:), intent(out) :: & + xkhvsum, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum + real,dimension(:,:,:,:), intent(out) :: & + area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & + mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & + ent_bnd_sum, rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, & + precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum + + xkhvsum=0. + wwqui_cen_sum=0. + wwqui_bnd_sum=0. + wwqui_cloudy_cen_sum=0. + wwqui_cloudy_bnd_sum=0. + area_bnd_final=0. + area_bnd_sum=0. + area_cen_final=0. + area_cen_sum=0. + mass_bnd_final=0. + mass_bnd_sum=0. + mass_cen_final=0. + mass_cen_sum=0. + ent_bnd_sum=0. + rh_cen_sum=0. + qcloud_cen_sum=0. + qcloud_bf_cen_sum=0. + qrain_cen_sum=0. + qice_cen_sum=0. + qsnow_cen_sum=0. + qgraup_cen_sum=0. + qlsink_cen_sum=0. + precr_cen_sum=0. + precsolid_cen_sum=0. + precall_cen_sum=0. + qlsink_bf_cen_sum=0. + qlsink_avg_cen_sum=0. + prain_cen_sum=0. +end subroutine zero_out_sums2 + + +!------------------------------------------------------------------------ +subroutine categorization_stats( domass, & + nx, ny, nz, nupdraft, ndndraft, ndraft_max, & + mode_updnthresh, upthresh, downthresh, & + upthresh2, downthresh2, cloudthresh, prcpthresh, & + cloudthresh_trans, precthresh_trans, & + qvs, & + plumetype, allcomb, & +! ctime, & + updraftbase, updrafttop, dndraftbase, dndrafttop, & + qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & + qlsink, precr, precsolid, precall, & + alt, rh, cf3d, ww, wwsq, tkesgs, & + qlsink_bf, prain, & + area_bnd_final, area_cen_final, & + area_bnd_sum, area_cen_sum, ent_bnd_sum, mass_bnd_sum, & + rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, precr_cen_sum, & + precsolid_cen_sum, precall_cen_sum, & + qlsink_bf_cen_sum, prain_cen_sum, & + wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & + wup_thresh, wdown_thresh ) +! +! William.Gustafson@pnl.gov; 25-Nov-2008 +! Last modified: William.Gustafson@pnl.gov; 16-Apr-2009 +!------------------------------------------------------------------------ + use module_data_ecpp1, only: a_quiescn_minaa +! +! Subroutine arguments... +! + logical, intent(in) :: domass !calculate mass fluxes? T/F + integer, intent(in) :: nx, ny, nz, nupdraft, ndndraft, ndraft_max, & + mode_updnthresh, plumetype + logical, intent(in) :: allcomb + real, intent(in) :: & + cloudthresh, prcpthresh, & + downthresh, upthresh, & + downthresh2, upthresh2 + real, intent(in) :: cloudthresh_trans, precthresh_trans +! type(time), intent(in) :: ctime + integer, dimension(:), intent(in) :: & + updraftbase, updrafttop, & + dndraftbase, dndrafttop + real, dimension(:,:,:), intent(in) :: & + qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & + qlsink, precr, precsolid, precall, & + alt, rh, cf3d, ww, wwsq, tkesgs, qlsink_bf, prain, qvs + real, dimension(:,:,:,:), intent(inout) :: & + area_bnd_final, area_cen_final, & + area_bnd_sum, area_cen_sum, ent_bnd_sum, mass_bnd_sum, & + rh_cen_sum, & + qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & + qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & + qlsink_cen_sum, precr_cen_sum, & + precsolid_cen_sum, precall_cen_sum, qlsink_bf_cen_sum, prain_cen_sum + + real, dimension(:), intent(inout) :: wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum + real, dimension(nz+1), intent(out) :: wdown_thresh, wup_thresh +! +! Local vars... +! + real, dimension(nx,ny,nz+1,NCLASS_CL,ndraft_max,NCLASS_PR) :: mask_bnd + real, dimension(nx,ny,nz,NCLASS_CL,ndraft_max,NCLASS_PR) :: mask_cen + real, dimension(nz+1,2) :: wdown_thresh_k, wup_thresh_k + real, dimension(nx,ny,nz) :: cloudmixr, cloudmixr_total, precmixr_total + integer, dimension(nx,ny) :: cloudtop + real, dimension(nz+1) :: wup_rms_k, wup_bar_k, wup_stddev_k & + , wdown_rms_k, wdown_bar_k, wdown_stddev_k + integer :: kup_top, kdown_top ! defined as the maximum level that allows updraft and downdraft + real :: mask, wwrho_k, wwrho_km1 + real, dimension(nz+1) :: rhoair ! layer-averaged air density + real :: wlarge = 1.0e10 ! m/s + real :: tmpa, tmpb + real, dimension(nz) :: thresh_factorbb_up, thresh_factorbb_down + real :: acen_quiesc, acen_up, acen_down, abnd_quiesc, abnd_up, abnd_down + real :: acen_quiesc_minaa + real :: wwqui_bar_cen(nz), wwqui_bar_bnd(nz+1), wwqui_cloudy_bar_cen(nz), wwqui_cloudy_bar_bnd(nz+1) + + integer :: i, icl, ipr, itr, j, k, km0, km1, km2, nxy, nzstag + integer :: iter + + logical :: thresh_calc_not_done + + acen_quiesc_minaa = a_quiescn_minaa + 0.01 + + nxy = nx*ny + nzstag = nz+1 + +! Transport classification is based on total condensate (cloudmixr_total), and +! cloudy (liquid) and clear (non-liquid) classification is based on liquid water, +! because wet deposition, aqueous chemistry, and droplet activaton, all are for liquid clouds. +! +! Minghuai Wang, 2010-04 +! + cloudmixr = qcloud + cloudmixr_total = qcloud + qice + +! total hydrometer (rain, snow, and graupel) + precmixr_total = qrain+qsnow+qgraup + + rhoair(:) = 0.0 + do j=1,ny + do i=1,nx +! +! Get cloud top height +! Cloud top height is used to determine whether there is updraft/downdraft. No updraft and +! downdraft is allowed above the condensate level (both liquid and ice). + cloudtop(i,j) = 1 !Default to bottom level if no cloud in column. + do k=nz,1,-1 + if( cloudmixr_total(i,j,k) >= cloudthresh_trans ) then +! +! 0.01*qvs may be too large at low level. +! if( cloudmixr_total(i,j,k) >= max(0.01*qvs(i,j,k), cloudthresh_trans) ) then + cloudtop(i,j) = k + exit + end if + end do !k +! +! Get layer-averaged air density + do k=1, nzstag + km0 = min(nz,k) + km1 = max(1,k-1) + rhoair(k) = rhoair(k)+0.5*(1.0/alt(i,j,km1) + 1.0/alt(i,j,km0))/real(nxy) + end do + end do !i + end do !j + + call determine_transport_thresh( & + nx, ny, nz, & + mode_updnthresh, upthresh, downthresh, & + upthresh2, downthresh2, cloudthresh, & + ww, rhoair, & + wdown_thresh_k, wup_thresh_k & + , cloudtop & + , wup_rms_k, wup_bar_k, wup_stddev_k & + , wdown_rms_k, wdown_bar_k, wdown_stddev_k & + , kup_top, kdown_top ) + + wdown_thresh(:) = wdown_thresh_k(:,1) + wup_thresh(:) = wup_thresh_k(:,1) + + if ((nupdraft > 1) .or. (ndndraft > 1)) then + call endrun('*** code for thresh_factorbb_up/down needs nup/dndraft = 1') + end if + thresh_factorbb_up(:) = 1.0 ; thresh_factorbb_down(:) = 1.0 + thresh_calc_not_done = .true. + + iter = 0 +thresh_calc_loop: & + do while ( thresh_calc_not_done ) + + iter = iter + 1 +! if quiescent class area was too small on previous iteration, +! then thresh_factor_acen_quiesc will be > 1.0 +! multiply wup/down_thresh_k by this factor to reduce the +! up/downdraft areas and increase the quiescent area + do k = 1, nzstag + if (k == 1) then + tmpa = thresh_factorbb_up(k) + tmpb = thresh_factorbb_down(k) + else if (k == nzstag) then + tmpa = thresh_factorbb_up(k-1) + tmpb = thresh_factorbb_down(k-1) + else + tmpa = maxval( thresh_factorbb_up(k-1:k) ) + tmpb = maxval( thresh_factorbb_down(k-1:k) ) + end if + wup_thresh_k( k,:) = wup_thresh_k( k,:) * tmpa + wdown_thresh_k(k,:) = wdown_thresh_k(k,:) * tmpb + end do ! k + + do k=1, max(1, kup_top-1) + wup_thresh(k) = wup_thresh_k(k,1) + end do + do k=1, max(1, kdown_top-1) + wdown_thresh(k) = wdown_thresh_k(k,1) + end do + + do k=1, nzstag + if(wup_thresh(k).lt.0.05) then + write(0,*) 'erros in wup_thresh', k, wup_thresh_k(:,1), thresh_factorbb_up(:) + call endrun('wup_thresh errors in ecpp_stat') + end if + end do +! +! fix a bug in the WRF_ECPP, Minghuai Wang, 2009-12. +! set wdown_thresh_k and wup_thresh_k to be an extreme value +! above updraft (kup_top) and downdraft top(kdown_top). +! This will make sure there is no updraft or downdraft above kup_top and kdown_top +! + do k=kup_top, nz+1 + wup_thresh_k(k, :) = wlarge + end do + do k=kdown_top, nz+1 + wdown_thresh_k(k,:) = -1. * wlarge + end do + + call setup_class_masks( & + nx, ny, nz, nupdraft, ndndraft, ndraft_max, & + cloudmixr, cf3d, precall, ww, & + wdown_thresh_k, wup_thresh_k, & + cloudthresh, prcpthresh, & + mask_bnd, mask_cen, & + cloudmixr_total, cloudthresh_trans, precthresh_trans, & + qvs, precmixr_total ) + +! +! ( code added on 14-dec-2009 to guarantee quiescent class +! area > acen_quiesc_minaa ) +! at each level +! calculate total fractional area for quiescent class +! using the current level-1 averages +! if (acen_quiesc < acen_quiesc_minaa), increase the +! thresh_factorbb_up/down(k) by factor of 1.5 or 1.2 +! (also, if acen_down > acen_up, increase thresh_factorbb_up by less +! + thresh_calc_not_done = .false. + do k = 1,nz + acen_quiesc = sum( mask_cen( 1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR) ) + acen_quiesc = max( acen_quiesc/real(nxy), 0.0 ) + acen_up = sum( mask_cen( 1:nx, 1:ny, k, 1:NCLASS_CL, UP1, 1:NCLASS_PR) ) + acen_up = max( acen_up/real(nxy), 0.0 ) + acen_down = max( (1.0 - acen_quiesc - acen_up), 0.0 ) + + abnd_quiesc = sum( mask_bnd( 1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR) ) + abnd_quiesc = max( abnd_quiesc/real(nxy), 0.0 ) + abnd_up = sum( mask_bnd( 1:nx, 1:ny, k, 1:NCLASS_CL, UP1, 1:NCLASS_PR) ) + abnd_up = max( abnd_up/real(nxy), 0.0 ) + abnd_down = max( (1.0 - abnd_quiesc - abnd_up), 0.0 ) + + if (min(acen_quiesc, abnd_quiesc) < acen_quiesc_minaa) then + thresh_calc_not_done = .true. + if (acen_down > acen_up ) then + tmpa = acen_up/acen_down + else if (abnd_down > abnd_up ) then + tmpa = abnd_up/abnd_down + else + tmpa = 1.0 + end if + if (min(acen_quiesc,abnd_quiesc) < 0.5*acen_quiesc_minaa) then + thresh_factorbb_down(k) = thresh_factorbb_down(k)*1.5 + thresh_factorbb_up(k) = thresh_factorbb_up(k)*max(1.5*tmpa, 1.25) + else + thresh_factorbb_down(k) = thresh_factorbb_down(k)*1.25 + thresh_factorbb_up(k) = thresh_factorbb_up(k)*max(1.25*tmpa, 1.125) + end if + if(iter.gt.5) then + write(0, *) 'warning: The number of iteration is larger than 5 in ecpp_stat', 'iter=', iter , & + 'acen_quiesc=', acen_quiesc, 'acen_up=', acen_up, 'k=', k, & + 'wthreshdown=', wdown_thresh_k(k,1), 'wthreshup=', wup_thresh_k(k,1) +! call endrun('The number of iteration is larger than 10 in ecpp_stat') + end if + end if + end do ! k + +! thresh_calc_not_done = .false. ! not use this iteration method +++mhwang + + end do thresh_calc_loop + + wwqui_bar_cen(:) = 0.0 + wwqui_cloudy_bar_cen(:) = 0.0 + wwqui_bar_bnd(:) = 0.0 + wwqui_cloudy_bar_bnd(:) = 0.0 + + XYCLASSLOOPS: do j = 1,ny + do i = 1,nx + do ipr = 1,NCLASS_PR + do itr = 1,ndraft_max + do icl = 1,NCLASS_CL +! +! We now have enough information to aggregate the variables into domain +! averages by class. Do this first for the cell centers... +! + do k = 1,nz + mask = mask_cen(i,j,k,icl,itr,ipr)/real(nxy) + + area_cen_final(k,icl,itr,ipr) = area_cen_final(k,icl,itr,ipr) + mask + + if( domass ) then + area_cen_sum(k,icl,itr,ipr) = area_cen_sum(k,icl,itr,ipr) + mask + rh_cen_sum(k,icl,itr,ipr) = rh_cen_sum(k,icl,itr,ipr) + rh(i,j,k)*mask + qcloud_cen_sum(k,icl,itr,ipr) = qcloud_cen_sum(k,icl,itr,ipr) + qcloud(i,j,k)*mask + qcloud_bf_cen_sum(k,icl,itr,ipr) = qcloud_bf_cen_sum(k,icl,itr,ipr) + qcloud_bf(i,j,k)*mask + qrain_cen_sum(k,icl,itr,ipr) = qrain_cen_sum(k,icl,itr,ipr) + qrain(i,j,k)*mask + qice_cen_sum(k,icl,itr,ipr) = qice_cen_sum(k,icl,itr,ipr) + qice(i,j,k)*mask + qsnow_cen_sum(k,icl,itr,ipr) = qsnow_cen_sum(k,icl,itr,ipr) + qsnow(i,j,k)*mask + qgraup_cen_sum(k,icl,itr,ipr) = qgraup_cen_sum(k,icl,itr,ipr) + qgraup(i,j,k)*mask + qlsink_cen_sum(k,icl,itr,ipr) = qlsink_cen_sum(k,icl,itr,ipr) + qlsink(i,j,k)*mask + precr_cen_sum(k,icl,itr,ipr) = precr_cen_sum(k,icl,itr,ipr) + precr(i,j,k)*mask + precsolid_cen_sum(k,icl,itr,ipr) = precsolid_cen_sum(k,icl,itr,ipr) + precsolid(i,j,k)*mask + precall_cen_sum(k,icl,itr,ipr) = precall_cen_sum(k,icl,itr,ipr) + precall(i,j,k)*mask + qlsink_bf_cen_sum(k,icl,itr,ipr) = qlsink_bf_cen_sum(k,icl,itr,ipr) + qlsink_bf(i,j,k)*mask + prain_cen_sum(k,icl,itr,ipr) = prain_cen_sum(k,icl,itr,ipr) + prain(i,j,k)*mask +! +! calculate the mean vertical velocity over the quiescent class +++mhwang +! + if(itr.eq.QUI) then + wwqui_bar_cen(k) = wwqui_bar_cen(k)+(ww(i,j,k)+ww(i,j,k+1))*0.5*mask + if(icl.eq.CLD) then + wwqui_cloudy_bar_cen(k)=wwqui_cloudy_bar_cen(k)+(ww(i,j,k)+ww(i,j,k+1))*0.5*mask + end if + end if + + end if + end do !k +! +! Now, we can do a similar aggregation for the cell boundaries. Here, we +! will also calculate the mass flux and entrainment. +! + do k = 1,nzstag + mask = mask_bnd(i,j,k,icl,itr,ipr)/real(nxy) + + area_bnd_final(k,icl,itr,ipr) = area_bnd_final(k,icl,itr,ipr) + mask + + if( domass ) then + !NOTE: technically we should interpolate and not do a simple + ! average to get density at the cell interface + km0 = min(nz,k) + km1 = max(1,k-1) + km2 = max(1,k-2) + wwrho_k = 0.5*(1.0/alt(i,j,km1) + 1.0/alt(i,j,km0))*ww(i,j,k) + wwrho_km1 = 0.5*(1.0/alt(i,j,km2) + 1.0/alt(i,j,km1))*ww(i,j,km1) + + area_bnd_sum(k,icl,itr,ipr) = area_bnd_sum(k,icl,itr,ipr) + mask + mass_bnd_sum(k,icl,itr,ipr) = mass_bnd_sum(k,icl,itr,ipr) + wwrho_k*mask + ent_bnd_sum(k,icl,itr,ipr) = ent_bnd_sum(k,icl,itr,ipr) + max(0., wwrho_k-wwrho_km1)*mask + +! +! calculate the mean vertical velocity over the quiescent class +++mhwang +! + if(itr.eq.QUI) then + wwqui_bar_bnd(k) = wwqui_bar_bnd(k)+ww(i,j,k)*mask + if(icl.eq.CLD) then + wwqui_cloudy_bar_bnd(k)=wwqui_cloudy_bar_bnd(k)+ww(i,j,k)*mask + end if + end if + + end if + end do !k + + end do !icl + end do !itr + end do !pr + end do !i + end do XYCLASSLOOPS !j + +! +! calcualte vertical velocity variance for quiescent class (total and cloudy) +++mhwang +! + do k=1, nz + if(sum(mask_cen(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)).ge.0.5) then + wwqui_bar_cen(k) = wwqui_bar_cen(k)* real(nxy) /sum(mask_cen(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)) + else + wwqui_bar_cen(k) = 0.0 + end if + if(sum(mask_cen(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)).ge.0.5) then + wwqui_cloudy_bar_cen(k) = wwqui_cloudy_bar_cen(k)* real(nxy) /sum(mask_cen(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)) + else + wwqui_cloudy_bar_cen(k) = 0.0 + end if + end do + do k=1, nzstag + if(sum(mask_bnd(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)).ge.0.5) then + wwqui_bar_bnd(k) = wwqui_bar_bnd(k)* real(nxy) /sum(mask_bnd(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)) + else + wwqui_bar_bnd(k) = 0.0 + end if + if(sum(mask_bnd(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)).ge.0.5) then + wwqui_cloudy_bar_bnd(k) = wwqui_cloudy_bar_bnd(k)* real(nxy) /sum(mask_bnd(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)) + else + wwqui_cloudy_bar_bnd(k) = 0.0 + end if + end do + + QUIELOOPS: do j = 1,ny + do i = 1,nx + do ipr = 1,NCLASS_PR + do icl = 1,NCLASS_CL + + do k = 1,nz + mask = mask_cen(i,j,k,icl,QUI,ipr)/real(nxy) + +! +! calculate the vertical velocity variance over the quiescent class +++mhwang +! wwqui_bar_cen is used in for both all sky and cloudy sky. +! when wwqui_cloudy_bar_cen was used for cloudy sky, wwqui_cloudy_cen_sum will be smaller than wwqui_cen_sum. +! +#ifdef CLUBB_CRM + wwqui_cen_sum(k) = wwqui_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 + mask * & + (wwsq(i,j,k)+wwsq(i,j,k+1))**2/4. +#else + wwqui_cen_sum(k) = wwqui_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 + mask * & + tkesgs(i,j,k)/3. +#endif + if(icl.eq.CLD) then +#ifdef CLUBB_CRM + wwqui_cloudy_cen_sum(k)=wwqui_cloudy_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 & + + mask * (wwsq(i,j,k)+wwsq(i,j,k+1))**2/4. +#else + wwqui_cloudy_cen_sum(k)=wwqui_cloudy_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 & + + mask * tkesgs(i,j,k)/3. +#endif + end if + end do !k + +! +! Now, we can do a similar aggregation for the cell boundaries. +! + do k = 1,nzstag + mask = mask_bnd(i,j,k,icl,QUI,ipr)/real(nxy) + + !NOTE: technically we should interpolate and not do a simple + ! average to get density at the cell interface + km0 = min(nz,k) + km1 = max(1,k-1) +! +! calculate the mean vertical velocity over the quiescent class +++mhwang +! wwqui_bar_bnd is used in both all sky and cloudy sky. +! when wwqui_cloudy_bar_bnd was used for cloudy sky, wwqui_cloudy_bnd_sum will be smaller than wwqui_bnd_sum. +! +#ifdef CLUBB_CRM + wwqui_bnd_sum(k) = wwqui_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * wwsq(i,j,k)**2 +#else + wwqui_bnd_sum(k) = wwqui_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * (tkesgs(i,j,km0)+& + tkesgs(i,j,km1)) * 0.5/3. +#endif + if(icl.eq.CLD) then +#ifdef CLUBB_CRM + wwqui_cloudy_bnd_sum(k)=wwqui_cloudy_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * & + wwsq(i,j,k)**2 +#else + wwqui_cloudy_bnd_sum(k)=wwqui_cloudy_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * & + (tkesgs(i,j,km0)+tkesgs(i,j,km1)) * 0.5/3. +#endif + end if + + end do !k + + end do !icl + end do !pr + end do !i + end do QUIELOOPS !j + +! testing small queiscent fraction +++mhwang + do k=1, nz + if(sum(area_cen_final(k,:,1,:)).lt.1.0e-3) then + write(0, *) 'ecpp, area_cen_final, quiescent', sum(area_cen_final(k,:,1,:)), k, area_cen_final(k,:,1,:), & + wdown_thresh_k(k,1), wup_thresh_k(k,1) + write(0, *) 'ecpp, area_cen_final, quiescent, wwk', ww(:,:,k), i, wup_rms_k(k), wup_bar_k(k), wup_stddev_k(k) + write(0, *) 'ecpp, area_cen_final, quiescent, wwk+1', ww(:,:,k+1), i, wup_rms_k(k+1), wup_bar_k(k+1), wup_stddev_k(k+1) +! call endrun('area_cen_final less then 1.0-e3') + end if + end do +! ---mhwang +end subroutine categorization_stats + +!------------------------------------------------------------------------ +subroutine determine_transport_thresh( & + nx, ny, nz, & + mode_updnthresh, upthresh, downthresh, & + upthresh2, downthresh2, cloudthresh, & +! ctime, & + ww, rhoair, & + wdown_thresh_k, wup_thresh_k & + , cloudtop & + , wup_rms_k, wup_bar_k, wup_stddev_k & + , wdown_rms_k, wdown_bar_k, wdown_stddev_k & + , kup_top, kdown_top) +! +! Deterines the velocity thresholds used to indicate whether a cell's +! motion is up, down, or quiescent. This is down for two threshold values +! in each direction by level. A dozen options are available on how this +! is done as documented below and at the top of postproc_wrfout. +! +! William.Gustafosn@pnl.gov; 11-Sep-2008 +! Modified: William.Gustafosn@pnl.gov; 14-Apr-2009 +!------------------------------------------------------------------------ +! use timeroutines +! +! Soubroutine arguments... +! + integer, intent(in) :: nx, ny, nz, mode_updnthresh + real, intent(in) :: & + cloudthresh, & + downthresh, upthresh, & + downthresh2, upthresh2 +! type(time), intent(in) :: ctime + real, dimension(:,:,:), intent(in) :: & + ww + real, dimension(nz+1), intent(in) :: rhoair + real, dimension(nz+1,2), intent(out) :: wdown_thresh_k, wup_thresh_k + integer, dimension(nx,ny), intent(in) :: cloudtop + real, dimension(nz+1), intent(out) :: wup_rms_k, wup_bar_k, wup_stddev_k, wdown_bar_k, wdown_rms_k, wdown_stddev_k + integer, intent(out) :: kup_top, kdown_top ! defined as the maximum level that allows updraft and downdraft +! +! Local vars... +! + real, dimension(nz+1) :: & + tmpveca, tmpvecb, & +! wdown_bar_k, wdown_rms_k, wdown_stddev_k, & +! wup_bar_k, wup_rms_k, wup_stddev_k, & + wup_rms_ksmo, wdown_rms_ksmo + real :: tmpsuma, tmpsumb, tmpw, tmpw_minval, & + wdown_bar, wdown_rms, wdown_stddev, & + wup_bar, wup_rms, wup_stddev + integer, dimension(nx,ny) :: & + cloudtop_upaa, cloudtop_upbb, cloudtop_downaa, cloudtop_downbb + integer, dimension(nz+1) :: nup_k, ndown_k + integer :: i, ib, ic, & + j, jb, jc, & + k, kk, kup_center, kdown_center + integer :: ndown, nup + integer :: ijdel, ijdel_cur, ijdel_upaa, ijdel_upbb, ijdel_downaa, ijdel_downbb + +! Calc cloudtop_upaa(i,j) = max( cloudtop(i-del:i+del,j-del:j+del) ) +! and similar for cloudtop_upbb, cloudtop_downaa/bb +! (assume periodic BC here) + ijdel_upaa = 0 ; ijdel_downaa = 0 + ijdel_upbb = 0 ; ijdel_downbb = 0 + if ((mode_updnthresh == 12) .or. (mode_updnthresh == 13)) then +! ijdel_... = 1 corresponds to 3x3 stencil + ijdel_upaa = 1 ; ijdel_downaa = 1 + ijdel_upbb = 1 ; ijdel_downbb = 1 + end if + ijdel = max( ijdel_upaa, ijdel_upbb, ijdel_downaa, ijdel_downbb ) + + if (ijdel > 0) then + do j = 1, ny + do i = 1, nx + cloudtop_upaa(i,j) = cloudtop(i,j) + cloudtop_downaa(i,j) = cloudtop(i,j) + cloudtop_upbb(i,j) = cloudtop(i,j) + cloudtop_downbb(i,j) = cloudtop(i,j) + do jb = j-ijdel, j+ijdel + jc = jb + if (jc < 1) jc = jc + ny + if (jc > ny) jc = jc - ny + do ib = i-ijdel, i+ijdel + ic = ib + if (ic < 1) ic = ic + nx + if (ic > nx) ic = ic - nx + ijdel_cur = max( iabs(ib-i), iabs(jb-j) ) +! cloudtop_downaa calculated over a (2*ijdel_downaa+1)**2 stencil + if (ijdel_cur <= ijdel_downaa) & + cloudtop_downaa(i,j) = max( cloudtop_downaa(i,j), cloudtop(ic,jc) ) +! cloudtop_upaa calculated over a (2*ijdel_upaa+1)**2 stencil + if (ijdel_cur <= ijdel_upaa) & + cloudtop_upaa(i,j) = max( cloudtop_upaa(i,j), cloudtop(ic,jc) ) +! cloudtop_downbb, cloudtop_upbb similarly + if (ijdel_cur <= ijdel_downbb) & + cloudtop_downbb(i,j) = max( cloudtop_downbb(i,j), cloudtop(ic,jc) ) + if (ijdel_cur <= ijdel_upbb) & + cloudtop_upbb(i,j) = max( cloudtop_upbb(i,j), cloudtop(ic,jc) ) + end do ! ib + end do ! jb +! add on 1 level as a "margin of error" + cloudtop_upaa( i,j) = min( cloudtop_upaa( i,j)+1, nz ) + cloudtop_downaa(i,j) = min( cloudtop_downaa(i,j)+1, nz ) + cloudtop_upbb( i,j) = min( cloudtop_upbb( i,j)+1, nz ) + cloudtop_downbb(i,j) = min( cloudtop_downbb(i,j)+1, nz ) + end do ! i + end do ! j + end if ! (ijdel > 0) + +! new coding here and below +! cloudtop_up/downaa - only grid cells with k<=cloudtop_up/downaa +! are used for calc of wup_rms and wdn_rms +! cloudtop_up/downbb - only grid cells with k<=cloudtop_up/downbb +! can be classified as up/downdraft + if ((mode_updnthresh == 12) .or. (mode_updnthresh == 13)) then +! mode_updnthresh >= 12 is a newer, more consistent usage of cloudtop info +! the cloudtop_upaa/upbb/downaa/downbb values are identical, +! and they correspond to the max cloudtop(i,j) over a 3x3 stencil +! only grid cells with k <= this "local" cloudtop can be up/downdraft grids + continue + else +! mode_updnthresh /= 12,13 corresponds to pre 11-jan-2008 versions of preprocessor +! where only grid cells with k <= cloudtop(i,j) are used for calc of wup/dn_rms, +! but any grid cells can be up/dn [even those with k >> cloudtop(i,j)] + cloudtop_upaa(:,:) = cloudtop(:,:) + cloudtop_downaa(:,:) = cloudtop(:,:) + cloudtop_upbb(:,:) = nz + cloudtop_downbb(:,:) = nz + end if + +! +! Get standard deviation of up and down vertical velocity below the +! cloud tops. For now, each cell is treated equally. We may want to +! consider weighting each cell by its volume or mass. +! + ! Get the mean values first for wup and wdown + ndown = 0; nup = 0 + wdown_bar = 0.; wup_bar = 0. + ndown_k(:) = 0; nup_k(:) = 0 + wdown_bar_k(:) = 0.; wup_bar_k(:) = 0. + kup_top = 1; kdown_top= 1 + do j=1,ny + do i=1,nx + do k=1,cloudtop_upaa(i,j)+1 !Plus 1 is so we get w across top of cloud. + !It is dimmensionally ok since w is dimmed nz+1 + !We intentially ignore when w==0 as to not bias one direction + !over the other for the count. This differs from the Ferret code which + !assigns w=0 to up values. + if( ww(i,j,k) > 0. ) then + nup = nup + 1 + wup_bar = wup_bar + ww(i,j,k) + nup_k(k) = nup_k(k) + 1 + wup_bar_k(k) = wup_bar_k(k) + ww(i,j,k) + kup_top = max(kup_top, k) + end if + end do + do k=1,cloudtop_downaa(i,j)+1 + if( ww(i,j,k) < 0. ) then + ndown = ndown + 1 + wdown_bar = wdown_bar + ww(i,j,k) + ndown_k(k) = ndown_k(k) + 1 + wdown_bar_k(k) = wdown_bar_k(k) + ww(i,j,k) + kdown_top = max(kdown_top, k) + end if + end do + + end do + end do + if( nup > 0 ) wup_bar = wup_bar / nup + if( ndown > 0 ) wdown_bar = wdown_bar / ndown + do k = 1, nz+1 + if( nup_k(k) > 0 ) wup_bar_k(k) = wup_bar_k(k) / nup_k(k) + if( ndown_k(k) > 0 ) wdown_bar_k(k) = wdown_bar_k(k) / ndown_k(k) + end do + + !Now, we can get the std. dev. of wup and wdown. + wdown_stddev = 0.; wup_stddev = 0. + wdown_stddev_k(:) = 0.; wup_stddev_k(:) = 0. + do j=1,ny + do i=1,nx + do k=1,cloudtop_upaa(i,j)+1 !Plus 1 is so we get w across top of cloud. + !We intentionally ignore when w==0 as to not bias one direction + !over the other. + if( ww(i,j,k) > 0. ) then + wup_stddev = wup_stddev + (wup_bar-ww(i,j,k))**2 + wup_stddev_k(k) = wup_stddev_k(k) + (wup_bar_k(k)-ww(i,j,k))**2 + end if + end do + do k=1,cloudtop_downaa(i,j)+1 + if( ww(i,j,k) < 0. ) then + wdown_stddev = wdown_stddev + (wdown_bar-ww(i,j,k))**2 + wdown_stddev_k(k) = wdown_stddev_k(k) + (wdown_bar_k(k)-ww(i,j,k))**2 + end if + end do + end do + end do + if( nup > 0 ) wup_stddev = sqrt(wup_stddev / nup) + if( ndown > 0 ) wdown_stddev = sqrt(wdown_stddev / ndown) + wup_rms = sqrt( wup_bar**2 + wup_stddev**2 ) + wdown_rms = sqrt( wdown_bar**2 + wdown_stddev**2 ) + do k = 1, nz+1 + if( nup_k(k) > 0 ) wup_stddev_k(k) = sqrt(wup_stddev_k(k) / nup_k(k)) + if( ndown_k(k) > 0 ) wdown_stddev_k(k) = sqrt(wdown_stddev_k(k) / ndown_k(k)) + wup_rms_k(k) = sqrt( wup_bar_k(k)**2 + wup_stddev_k(k)**2 ) + wdown_rms_k(k) = sqrt( wdown_bar_k(k)**2 + wdown_stddev_k(k)**2 ) + end do + +! calculated smoothed (3-point) wup/down_rms + tmpveca(:) = wup_rms_k( :) + tmpvecb(:) = wdown_rms_k(:) + do k = 2, nz + wup_rms_ksmo( k) = 0.0 + wdown_rms_ksmo(k) = 0.0 + tmpsuma = 0.0 + do kk = max(k-1,2), min(k+1,nz) + wup_rms_ksmo( k) = wup_rms_ksmo( k) + tmpveca(kk) + wdown_rms_ksmo(k) = wdown_rms_ksmo(k) + tmpvecb(kk) + tmpsuma = tmpsuma + 1.0 + end do + tmpsuma = max(tmpsuma,1.0) + wup_rms_ksmo( k) = wup_rms_ksmo( k)/tmpsuma + wdown_rms_ksmo(k) = wdown_rms_ksmo(k)/tmpsuma + end do + wup_rms_ksmo( 1) = wup_rms_ksmo( 2) + wdown_rms_ksmo(1) = wdown_rms_ksmo(2) + wup_rms_ksmo( nz+1) = wup_rms_ksmo( nz) + wdown_rms_ksmo(nz+1) = wdown_rms_ksmo(nz) + +! print "(2a,2(2x,3f8.4))", & +! " ...wup_bar,std,rms; wdown_bar,std,rms ", & +! wup_bar, wup_stddev, wup_rms, wdown_bar, wdown_stddev, wdown_rms +! if (mode_updnthresh >= 5) then +! print "(a/(15f7.3))", & +! " ... wup_rms_k(2:nz)", (wup_rms_k(k), k=2,nz) +! print "(a/(15f7.3))", & +! " ...wdown_rms_k(2:nz)", (wdown_rms_k(k), k=2,nz) +! end if + +! +! Get masks to determine (cloud vs. clear) (up vs. down vs. other) categories. +! Vertical velocities are checked on the cell vertical interfaces to determine +! if they pass the threshold criteria. Clouds below the interface are then +! used for updrafts and above the int. for downdrafts. Quiescent (other) +! drafts use an average of the cloud above and below the interface to +! determine cloudiness. +! + select case ( mode_updnthresh ) + case ( 1 ) + wup_thresh_k( :,1) = wup_stddev*abs(upthresh) + wdown_thresh_k(:,1) = -wdown_stddev*abs(downthresh) + wup_thresh_k( :,2) = wup_stddev*abs(upthresh2) + wdown_thresh_k(:,2) = -wdown_stddev*abs(downthresh2) + case ( 2 ) + wup_thresh_k( :,1) = wup_bar + wup_stddev*abs(upthresh) + wdown_thresh_k(:,1) = wdown_bar - wdown_stddev*abs(downthresh) + wup_thresh_k( :,2) = wup_bar + wup_stddev*abs(upthresh2) + wdown_thresh_k(:,2) = wdown_bar - wdown_stddev*abs(downthresh2) + case ( 3 ) + wup_thresh_k( :,1) = abs(upthresh) + wdown_thresh_k(:,1) = -abs(downthresh) + wup_thresh_k( :,2) = abs(upthresh2) + wdown_thresh_k(:,2) = -abs(downthresh2) + case ( 4 ) + wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) + wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) + wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) + wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) + + case ( 5 ) +! For mode_updnthresh = 5, use a weighted average of wup_rms & wup_rms_ksmo(k) +! because wup_rms_ksmo will be zero (or close to it) at many levels + wup_thresh_k( :,1) = (0.25*wup_rms +0.75*wup_rms_ksmo( :))*abs(upthresh) + wdown_thresh_k(:,1) = -(0.25*wdown_rms+0.75*wdown_rms_ksmo(:))*abs(downthresh) + wup_thresh_k( :,2) = (0.25*wup_rms +0.75*wup_rms_ksmo( :))*abs(upthresh2) + wdown_thresh_k(:,2) = -(0.25*wdown_rms+0.75*wdown_rms_ksmo(:))*abs(downthresh2) + + case ( 6, 7 ) +! For mode_updnthresh = 6 & 7, like case 4 except when k <= "updraft center k", +! use minimum of wup_rms and wup_rms_k for updraft threshold + wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) + wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) + wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) + wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) + + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz + tmpw = wup_rms_k(k) + if (mode_updnthresh == 7) tmpw = wup_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kup_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, kup_center + tmpw = wup_rms_k(k) + if (mode_updnthresh == 7) tmpw = wup_rms_ksmo(k) + tmpw = max( tmpw, tmpw_minval ) + tmpw = min( tmpw, wup_rms ) + wup_thresh_k(k,1) = tmpw*abs(upthresh) + wup_thresh_k(k,2) = tmpw*abs(upthresh2) + end do + + case ( 8, 9 ) +! For mode_updnthresh = 8 & 9, like case 6, 7 except that updraft and +! downdraft are treated similarly. So when k >= "downdraft center k", +! use minimum of wdown_rms and wdown_rms_k for downdraft threshold + wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) + wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) + wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) + wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) + + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 9) tmpw = wup_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kup_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, kup_center + tmpw = wup_rms_k(k) + if (mode_updnthresh == 9) tmpw = wup_rms_ksmo(k) + tmpw = max( tmpw, tmpw_minval ) + tmpw = min( tmpw, wup_rms ) + wup_thresh_k(k,1) = tmpw*abs(upthresh) + wup_thresh_k(k,2) = tmpw*abs(upthresh2) + end do + + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 9) tmpw = wdown_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kdown_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = kdown_center, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 9) tmpw = wdown_rms_ksmo(k) + tmpw = max( tmpw, tmpw_minval ) + tmpw = min( tmpw, wdown_rms ) + wdown_thresh_k(k,1) = -tmpw*abs(downthresh) + wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) + end do + + case ( 14, 15 ) +! case 14 & 15 -- added on 10-dec-2009 +! updraft and k > "updraft center k", wup_rms +! updraft and k <= "updraft center k", use min( wup_rms_k, wup_rms ) +! downdraft and k > "downdraft center k", wdown_rms +! downdraft and k <= "downdraft center k", min( use wdown_rms_k, wdown_rms ) +! The idea is to have a higher threshold in upper troposphere to +! filter out gravity waves motions + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 15) tmpw = wup_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kup_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 15) tmpw = wup_rms_ksmo(k) + if (k > kup_center) then + tmpw = wup_rms + else + tmpw = min( tmpw, wup_rms ) + end if + tmpw = max( tmpw, tmpw_minval ) + wup_thresh_k(k,1) = tmpw*abs(upthresh) + wup_thresh_k(k,2) = tmpw*abs(upthresh2) + end do + + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 15) tmpw = wdown_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kdown_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 15) tmpw = wdown_rms_ksmo(k) + if (k > kdown_center) then + tmpw = wdown_rms + else + tmpw = min( tmpw, wdown_rms ) + end if + tmpw = max( tmpw, tmpw_minval ) + wdown_thresh_k(k,1) = -tmpw*abs(downthresh) + wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) + end do + + case ( 16, 17 ) +! case 16 & 17 -- added on 10-dec-2009 +! updraft and k > "updraft center k", use max( wup_rms_k, wup_rms ) +! updraft and k <= "updraft center k", use wup_rms_k +! downdraft and k > "downdraft center k", use max( wdown_rms_k, wdown_rms ) +! downdraft and k <= "downdraft center k", use wdown_rms_k +! The idea is to have a higher threshold in upper troposphere to +! filter out gravity waves motions + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 17) tmpw = wup_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kup_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 17) tmpw = wup_rms_ksmo(k) + if (k > kup_center) tmpw = max( tmpw, wup_rms ) + tmpw = max( tmpw, tmpw_minval ) + wup_thresh_k(k,1) = tmpw*abs(upthresh) + wup_thresh_k(k,2) = tmpw*abs(upthresh2) + end do + + tmpsuma = 0.0 ; tmpsumb = 1.0e-30 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 17) tmpw = wdown_rms_ksmo(k) + tmpw = max(1.0e-4,tmpw) + tmpw = tmpw * rhoair(k) + tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw + end do + kdown_center = nint(tmpsuma/tmpsumb) + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 17) tmpw = wdown_rms_ksmo(k) + if (k > kdown_center) tmpw = max( tmpw, wdown_rms ) + tmpw = max( tmpw, tmpw_minval ) + wdown_thresh_k(k,1) = -tmpw*abs(downthresh) + wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) + end do + + case ( 10, 11, 12, 13 ) +! For mode_updnthresh = 10, 11, use wup_rms_k and wdown_rms_k at all +! levels (or the w---_rms_ksmo) + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wup_rms_k(k) + if (mode_updnthresh == 11) tmpw = wup_rms_ksmo(k) + if (mode_updnthresh == 13) tmpw = wup_rms_ksmo(k) + tmpw = max( tmpw, tmpw_minval ) + wup_thresh_k(k,1) = tmpw*abs(upthresh) + wup_thresh_k(k,2) = tmpw*abs(upthresh2) + end do + tmpw_minval = 0.10 + do k = 1, nz+1 + tmpw = wdown_rms_k(k) + if (mode_updnthresh == 11) tmpw = wdown_rms_ksmo(k) + if (mode_updnthresh == 13) tmpw = wdown_rms_ksmo(k) + tmpw = max( tmpw, tmpw_minval ) + wdown_thresh_k(k,1) = -tmpw*abs(downthresh) + wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) + end do + + case default + call endrun('determine_transport_thresh error - must have 1 <= mode_updnthresh <= 11') + end select + +end subroutine determine_transport_thresh + + +!------------------------------------------------------------------------ +subroutine setup_class_masks( & + nx, ny, nz, nupdraft, ndndraft, ndraft_max, & + cloudmixr, cf3d, precall, ww, & + wdown_thresh_k, wup_thresh_k, & + cloudthresh, prcpthresh, & + mask_bnd, mask_cen, & + cloudmixr_total, cloudthresh_trans, precthresh_trans, & + qvs, precmixr_total ) +! +! Sets up the masks used for determining quiescent/up/down, clear/cloudy, +! and non-precipitatin/precipitating classes. +! +! William.Gustafosn@pnl.gov; 20-Nov-2008 +! Last modified: William.Gustafson@pnl.gov; 16-Apr-2009 + +! Modification by Minghuai Wang (Minghuai.Wang@pnl.gov), April 23, 2010 +! use total condensate (liquid+ice), different condensate and precipitating thresholds +! to classify transport classes. +! See Xu et al., 2002, Q.J.R.M.S. +! + +!------------------------------------------------------------------------ +! +! Soubroutine arguments... +! + integer, intent(in) :: nx, ny, nz, nupdraft, ndndraft, ndraft_max + real, dimension(:,:,:), intent(in) :: & + cloudmixr, cf3d, precall, ww + real, dimension(nz+1,2), intent(in) :: wdown_thresh_k, wup_thresh_k + real, intent(in) :: cloudthresh, prcpthresh + real, dimension(nx,ny,nz+1,NCLASS_CL,ndraft_max,NCLASS_PR), & + intent(out) :: mask_bnd + real, dimension(nx,ny,nz,NCLASS_CL,ndraft_max,NCLASS_PR), & + intent(out) :: mask_cen + real, dimension( :, :, :), intent(in) :: cloudmixr_total ! total condensate (liquid+ice) + real, intent(in) :: cloudthresh_trans, precthresh_trans ! threshold for transport classes + real, dimension( :, :, :), intent(in) :: qvs, precmixr_total +! +! Local vars... +! + integer, dimension(nz+1,nupdraft) :: maskup + integer, dimension(nz+1,ndndraft) :: maskdn + integer, dimension(nz+1) :: maskqu, & + maskcld_bnd, maskclr_bnd, maskpry_bnd, maskprn_bnd + integer, dimension(nz) :: maskcld, maskclr, maskpry, maskprn + integer :: i, itr, icl, ipr, j, k, m, nzstag + real :: cloudthresh_trans_temp, precthresh_trans_temp + + nzstag = nz+1 +! +! Initialize the masks to zero and then we will accumulate values into +! them as we identify the various classes. +! + mask_bnd = 0. + mask_cen = 0. +! +! Loop over the horizontal dimensions... +! + XYLOOPS : do j = 1,ny + do i=1,nx +! +! Set initial mask values for the vertical cell boundaries... +! + maskup = 0 + maskdn = 0 + maskqu = 0 + maskcld = 0 + maskclr = 0 + maskcld_bnd = 0 + maskclr_bnd = 0 + maskpry = 0 + maskprn = 0 + maskpry_bnd = 0 + maskprn_bnd = 0 + + if( nupdraft > 2 .or. ndndraft > 2 ) then + call endrun('OOPS. Cannot have more than 2 updraft or 2 downdraft categories right now.') + end if + + do k = 1,nzstag + + !Transport upward at cell boundaries... + !We have to take into account the possibility of multiple + !updraft categories. At this point, we handle only the + !cases of one or two categories. We do not yet handle the + !allcomb option. + ! + ! updraft only exist in cloudy area or precipitating clear area ++++mhwang + cloudthresh_trans_temp = cloudthresh_trans +! cloudthresh_trans_temp = max(cloudthresh_trans, 0.01 * (qvs(i,j,max(k-1,1))+qvs(i,j,min(k,nz)))*0.5) + if( (cloudmixr_total(i,j,max(k-1,1))+cloudmixr_total(i,j,min(k,nz)))*0.5 > cloudthresh_trans_temp & +! .or. (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh_trans) then !+++mhwang + .or. (precmixr_total(i,j,max(k-1,1))+precmixr_total(i,j,min(k,nz)))*0.5 > precthresh_trans) then !+++mhwang + select case (nupdraft) + case (1) !Only one threshold + if( ww(i,j,k) > wup_thresh_k(k,1) ) then + maskup(k,1) = 1 + end if + case (2) !Two thresholds, assumes 1st is stronger wind + if( ww(i,j,k) > wup_thresh_k(k,1) ) then + maskup(k,1) = 1 + else if( ww(i,j,k) > wup_thresh_k(k,2) & + .and. ww(i,j,k) <= wup_thresh_k(k,1) ) then + maskup(k,2) = 1 + end if + end select + end if ! end cloudmixr_total +++mhwang + + !Transport downward at cell boundaries... + ! + ! downdraft only exist in cloudy area or precipitating clear area +++mhwang + if( (cloudmixr_total(i,j,max(k-1,1))+cloudmixr_total(i,j,min(k,nz)))*0.5 > cloudthresh_trans_temp & +! .or. (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh_trans) then !+++mhwang + .or. (precmixr_total(i,j,max(k-1,1))+precmixr_total(i,j,min(k,nz)))*0.5 > precthresh_trans) then !+++mhwang + select case (ndndraft) + case (1) !Only one threshold + if( ww(i,j,k) < wdown_thresh_k(k,1) ) then + maskdn(k,1) = 1 + end if + case (2) !Two thresholds, assumes 1st is stronger wind + if( ww(i,j,k) < wdown_thresh_k(k,1) ) then + maskdn(k,1) = 1 + else if( ww(i,j,k) < wdown_thresh_k(k,2) & + .and. ww(i,j,k) >= wdown_thresh_k(k,1) ) then + maskdn(k,2) = 1 + end if + end select + end if ! end cloudmixr_total, and precall +++mhwang + + !Transport quiescent at cell boundaries if neither up or + !down triggered... + if( sum(maskup(k,:))+sum(maskdn(k,:)) < 1 ) then + maskqu(k) = 1 + end if + + ! Cloudy or clear at cell boundaries... + if( (cloudmixr(i,j,max(k-1,1))+cloudmixr(i,j,min(k,nz)))*0.5 > cloudthresh ) then + maskcld_bnd(k) = 1 + else + maskclr_bnd(k) = 1 + end if + + ! Raining or not at cell boundaries... + if( (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh ) then + maskpry_bnd(k) = 1 + else + maskprn_bnd(k) = 1 + end if + + end do !k + do k = 1,nz + + ! Cloudy or clear at cell centers... + if( cloudmixr(i,j,k) > cloudthresh ) then + maskcld(k) = 1 + else + maskclr(k) = 1 + end if + + ! Raining or not at cell centers... + if( precall(i,j,k) > prcpthresh ) then + maskpry(k) = 1 + else + maskprn(k) = 1 + end if + + end do !k +! +! Now, use the initial boundary masks by class to generate a combined +! mask for the cell boundaries. +! + do k = 1,nzstag + + !Upward, or at least upward quiescent + if( sum(maskup(k,:)) > 0 .or. & + (maskqu(k) > 0 .and. ww(i,j,k) > 0) ) then + + !Are we are here because of maskup? If so, then we need to + !parse the correct updraft category. + if( maskqu(k) < 1 ) then + itr = UP1 + maxloc(maskup(k,:),1)-1 + else + itr = QUI + end if + + !For upward motion, determine cloud and precip characteristics + !based on the cell-center values below the boundary. + if( k==1 ) then + icl = CLR + ipr = PRN + else + call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k-1, icl, & + "setup_class_masks: bnd cloud up") + call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k-1, ipr, & + "setup_class_masks: bnd prcp up") + end if + + !Downward, or at least downward quiescent + else if( sum(maskdn(k,:)) > 0 .or. & + (maskqu(k) > 0 .and. ww(i,j,k) < 0) ) then + + !Are we here because of maskdn? If so, then we need to + !parse the correct downdraft category. + if( maskqu(k) < 1 ) then + itr = DN1 + maxloc(maskdn(k,:),1)-1 + else + itr = QUI + end if + + !For downward motion, determine cloud and precip characteristics + !based on the cell-center values above the boundary. + if( k==nzstag ) then + icl = CLR + ipr = PRN + else + call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k, icl, & + "setup_class_masks: bnd cloud down") + call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k, ipr, & + "setup_class_masks: bnd prcp down") + end if + + !Quiescent with w=0. Use the cell-center values averaged + !surrounding the boundary for the cloud/prcp states. + else + itr = QUI + call cloud_prcp_check(maskcld_bnd, CLD, maskclr_bnd, CLR, k, icl, & + "setup_class_masks: bnd cloud quiescent") + call cloud_prcp_check(maskpry_bnd, PRY, maskprn_bnd, PRN, k, ipr, & + "setup_class_masks: bnd prcp quiescent") + end if + +! +++mhwang +! Total condensate and different thresholds are used to classify transport classes. So the following change +! is not needed anymore. Minghuai Wang, 2010-04-23. +! +! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. +! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. +! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) +! if(icl.eq.CLR .and. ipr.eq.PRN) then +! itr = QUI +! end if +!---mhwang + + !We have all the class indices determined so now we can set + !the correct mask location to 1. +! mask_bnd(i,j,k,icl,itr,ipr) = 1. +! use fractioal cloudiness in SAM + if(icl.eq.CLR) then + mask_bnd(i,j,k,icl,itr,ipr) = 1. + else if(icl.eq.CLD) then + mask_bnd(i,j,k,CLD,itr,ipr) = (cf3d(i,j,max(k-1,1))+cf3d(i,j,min(k, nz)))*0.5 + mask_bnd(i,j,k,CLR,itr,ipr) = 1. - (cf3d(i,j,max(k-1,1))+cf3d(i,j,min(k, nz)))*0.5 + end if + + + end do !k-loop mask for boundaries +! +! Now, use the initial boundary masks by class to generate a combined +! mask for the cell centers. We determine the transport class based on +! splitting the cell conceptually in half with the upper boundary +! influencing the top half of the cell and the bottom boundary the bottom +! half. Each contributes either 0 or 0.5 of the total contribution of the +! cell's transport. e.g. if both boundaries are upward, then the cell is +! fully an "up" transport cell. If the two boundaries are opposite, then +! the cell is weighted half in each direction for the masking. +! + do k = 1,nz + + !Get the cloud/prcp characteristics at cell center. + call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k, icl) + call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k, ipr) + + !Look at the bottom boundary first and determine it's + !contribution to the cell center transport class. + if( sum(maskup(k,:)) > 0 ) then + itr = UP1 + maxloc(maskup(k,:),1)-1 + else if( sum(maskdn(k,:)) > 0 ) then + itr = DN1 + maxloc(maskdn(k,:),1)-1 + else if( maskqu(k) > 0 ) then + itr = QUI + else + call endrun("ERROR: setup_class_masks: We should not be in this place for cell bottoms.") + stop + end if + +! +++mhwang +! ! Total condensate and different thresholds are used to classify transport classes. So the following change +! is not needed anymore. Minghuai Wang, 2010-04-23. + +! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. +! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. +! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) +! if(icl.eq.CLR .and. ipr.eq.PRN) then +! itr = QUI +! end if +!---mhwang + + !We have what we need for the cell bottom classes so increment + !the center mask for the bottom half... +! mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 +! Use fractional cloudiness at SAM + if(icl.eq.CLR) then + mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 + else if(icl.eq.CLD) then + mask_cen(i,j,k,CLD,itr,ipr) = mask_cen(i,j,k,CLD,itr,ipr) + (cf3d(i,j,k))*0.5 + mask_cen(i,j,k,CLR,itr,ipr) = mask_cen(i,j,k,CLR,itr,ipr) + (1. - cf3d(i,j,k)) * 0.5 + end if + + !Next, look at the top boundary and determine it's + !contribution to the cell center transport class. + if( sum(maskup(k+1,:)) > 0 ) then + itr = UP1 + maxloc(maskup(k+1,:),1)-1 + else if( sum(maskdn(k+1,:)) > 0 ) then + itr = DN1 + maxloc(maskdn(k+1,:),1)-1 + else if( maskqu(k+1) > 0 ) then + itr = QUI + else + call endrun("ERROR: setup_class_masks: We should not be in this place for cell tops.") + end if + +! +++mhwang +! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. +! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. +! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) +! if(icl.eq.CLR .and. ipr.eq.PRN) then +! itr = QUI +! end if +!---mhwang + + !We have what we need for the cell top classes so increment + !the center mask for the top half... +! mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 +! use fractional cloudiness in SAM + if(icl.eq.CLR) then + mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 + else if(icl.eq.CLD) then + mask_cen(i,j,k,CLD,itr,ipr) = mask_cen(i,j,k,CLD,itr,ipr) + (cf3d(i,j,k))*0.5 + mask_cen(i,j,k,CLR,itr,ipr) = mask_cen(i,j,k,CLR,itr,ipr) + (1. - cf3d(i,j,k)) * 0.5 + end if + + end do !k-loop mask for centers + + end do + end do XYLOOPS +end subroutine setup_class_masks + + +!------------------------------------------------------------------------ +subroutine cloud_prcp_check(mask1, flag1, mask2, flag2, k, iout, msg) +! +! Assigns the flag associated with the mask value that is true to the +! output index. The masks are assumed to be 1-D arrays and k is the +! position in the array to check. +! William.Gustafson@pnl.gov; 11-Sep-2008 +!------------------------------------------------------------------------ +! +! Soubroutine arguments... +! + integer, dimension(:), intent(in) :: mask1, mask2 + integer, intent(in) :: flag1, flag2, k + integer, intent(out) :: iout + character(len=*), optional :: msg +! +! Local var... +! + integer :: n +! +! Sanity check +! + n = ubound(mask1,1) + if( k < 1 .or. k > n) then + write(0, *) 'cloud_prcp_check', 'k =',k, ' n =',n + call endrun('ERROR: k out of bounds in cloud_prcp_check') + end if +! +! Whichever mask has the value 1 has the associated flag put into iout +! + if( mask1(k) > 0 .and. mask2(k) < 1 ) then + iout = flag1 + else if( mask2(k) > 0 .and. mask1(k) < 1) then + iout = flag2 + else + write(0, *) 'cloud_prcp_check', 'k =', k + call endrun("ERROR: neither mask dominates in cloud_prcp_check") + end if + +end subroutine cloud_prcp_check + +#endif /*ECPP*/ +end module crmx_module_ecpp_stats + diff --git a/src/physics/spcam/crm/crmx_params.F90 b/src/physics/spcam/crm/crmx_params.F90 new file mode 100644 index 0000000000..f825374c30 --- /dev/null +++ b/src/physics/spcam/crm/crmx_params.F90 @@ -0,0 +1,180 @@ +module crmx_params + +use crmx_grid, only: nzm +#ifdef CLUBB_CRM +! Use the CLUBB values for these constants for consistency +use crmx_constants_clubb, only: Cp_clubb => Cp, grav_clubb => grav, Lv_clubb => Lv, Lf_clubb => Lf, & + Ls_clubb => Ls, Rv_clubb => Rv, Rd_clubb => Rd, pi_clubb => pi +#else + +#ifdef CRM +use shr_const_mod, only: shr_const_rdair, shr_const_cpdair, shr_const_latvap, & + shr_const_latice, shr_const_latsub, shr_const_rgas, & + shr_const_mwwv, shr_const_stebol, shr_const_tkfrz, & + shr_const_mwdair, shr_const_g, shr_const_karman, & + shr_const_rhofw +#endif /*CRM*/ + +#endif + +implicit none + +! Constants: + +#ifdef CLUBB_CRM +! Define Cp, ggr, etc. in module constants_clubb +real, parameter :: cp = Cp_clubb +real, parameter :: ggr = grav_clubb +real, parameter :: lcond = Lv_clubb +real, parameter :: lfus = Lf_clubb +real, parameter :: lsub = Ls_clubb +real, parameter :: rv = Rv_clubb +real, parameter :: rgas= Rd_clubb +#else +#ifndef CRM +real, parameter :: cp = 1004. ! Specific heat of air, J/kg/K +real, parameter :: ggr = 9.81 ! Gravity acceleration, m/s2 +real, parameter :: lcond = 2.5104e+06 ! Latent heat of condensation, J/kg +real, parameter :: lfus = 0.3336e+06 ! Latent heat of fusion, J/kg +real, parameter :: lsub = 2.8440e+06 ! Latent heat of sublimation, J/kg +real, parameter :: rv = 461. ! Gas constant for water vapor, J/kg/K +real, parameter :: rgas = 287. ! Gas constant for dry air, J/kg/K +#else +real, parameter :: cp = shr_const_cpdair +real, parameter :: ggr = shr_const_g +real, parameter :: lcond = shr_const_latvap +real, parameter :: lfus = shr_const_latice +real, parameter :: lsub = lcond + lfus +real, parameter :: rv = shr_const_rgas/shr_const_mwwv +real, parameter :: rgas = shr_const_rdair +#endif +#endif +real, parameter :: diffelq = 2.21e-05 ! Diffusivity of water vapor, m2/s +real, parameter :: therco = 2.40e-02 ! Thermal conductivity of air, J/m/s/K +real, parameter :: muelq = 1.717e-05 ! Dynamic viscosity of air + +real, parameter :: fac_cond = lcond/cp +real, parameter :: fac_fus = lfus/cp +real, parameter :: fac_sub = lsub/cp + +#ifdef CLUBB_CRM +real, parameter :: pi = pi_clubb +#else +real, parameter :: pi = 3.141592653589793 +#endif + +! +! internally set parameters: + +real epsv ! = (1-eps)/eps, where eps= Rv/Ra, or =0. if dosmoke=.true. +logical:: dosubsidence = .false. +real fcorz ! Vertical Coriolis parameter +real coszrs + +!---------------------------------------------- +! Parameters set by PARAMETERS namelist: +! Initialized to default values. +!---------------------------------------------- + +real:: ug = 0. ! Velocity of the Domain's drift in x direction +real:: vg = 0. ! Velocity of the Domain's drift in y direction +real:: fcor = -999. ! Coriolis parameter +real:: longitude0 = 0. ! latitude of the domain's center +real:: latitude0 = 0. ! longitude of the domain's center +real:: nxco2 = 1 ! factor to modify co2 concentration +logical:: doradlat = .false. +logical:: doradlon = .false. + +real(kind=selected_real_kind(12)):: tabs_s =0. ! surface temperature,K +real:: delta_sst = 0. ! amplitude of sin-pattern of sst about tabs_s (ocean_type=1) +real:: depth_slab_ocean = 2. ! thickness of the slab-ocean (m) +real:: Szero = 0. ! mean ocean transport (W/m2) +real:: deltaS = 0. ! amplitude of linear variation of ocean transport (W/m2) +real:: timesimpleocean = 0. ! time to start simple ocean + +real:: fluxt0 =0. ! surface sensible flux, Km/s +real:: fluxq0 =0. ! surface latent flux, m/s +real:: tau0 =0. ! surface stress, m2/s2 +real:: z0 =0.035 ! roughness length +real:: soil_wetness =1.! wetness coeff for soil (from 0 to 1.) +integer:: ocean_type =0 ! type of SST forcing +logical:: cem =.false. ! flag for Cloud Ensemble Model +logical:: les =.false. ! flag for Large-Eddy Simulation +logical:: ocean =.false. ! flag indicating that surface is water +logical:: land =.false. ! flag indicating that surface is land +logical:: sfc_flx_fxd =.false. ! surface sensible flux is fixed +logical:: sfc_tau_fxd =.false.! surface drag is fixed + +real:: timelargescale =0. ! time to start large-scale forcing + +! nudging boundaries (between z1 and z2, where z2 > z1): +real:: nudging_uv_z1 =-1., nudging_uv_z2 = 1000000. +real:: nudging_t_z1 =-1., nudging_t_z2 = 1000000. +real:: nudging_q_z1 =-1., nudging_q_z2 = 1000000. +real:: tauls = 99999999. ! nudging-to-large-scaler-profile time-scale +real:: tautqls = 99999999.! nudging-to-large-scaler-profile time-scale for scalars + +logical:: dodamping = .false. +logical:: doupperbound = .false. +logical:: docloud = .false. +logical:: doclubb = .false. ! Enabled the CLUBB parameterization (interactively) +logical:: doclubb_sfc_fluxes = .false. ! Apply the surface fluxes within the CLUBB code rather than SAM +logical:: doclubbnoninter = .false. ! Enable the CLUBB parameterization (non-interactively) +logical:: docam_sfc_fluxes = .false. ! Apply the surface fluxes within CAM +logical:: doprecip = .false. +logical:: dolongwave = .false. +logical:: doshortwave = .false. +logical:: dosgs = .false. +logical:: docoriolis = .false. +logical:: docoriolisz = .false. +logical:: dofplane = .true. +logical:: dosurface = .false. +logical:: dolargescale = .false. +logical:: doradforcing = .false. +logical:: dosfcforcing = .false. +logical:: doradsimple = .false. +logical:: donudging_uv = .false. +logical:: donudging_tq = .false. +logical:: donudging_t = .false. +logical:: donudging_q = .false. +logical:: doensemble = .false. +logical:: dowallx = .false. +logical:: dowally = .false. +logical:: docolumn = .false. +logical:: docup = .false. +logical:: doperpetual = .false. +logical:: doseasons = .false. +logical:: doradhomo = .false. +logical:: dosfchomo = .false. +logical:: dossthomo = .false. +logical:: dodynamicocean = .false. +logical:: dosolarconstant = .false. +logical:: dotracers = .false. +logical:: dosmoke = .false. +logical:: notracegases = .false. + +! Specify solar constant and zenith angle for perpetual insolation. +! Based onn Tompkins and Graig (1998) +! Note that if doperpetual=.true. and dosolarconstant=.false. +! the insolation will be set to the daily-averaged value on day0. +real:: solar_constant = 685. ! solar constant (in W/m2) +real:: zenith_angle = 51.7 ! zenith angle (in degrees) + +integer:: nensemble =0 ! the number of subensemble set of perturbations +integer:: perturb_type = 0 ! type of initial noise in setperturb() +integer:: nclubb = 1 ! SAM timesteps per CLUBB timestep +! Initial bubble parameters. Activated when perturb_type = 2 + real:: bubble_x0 = 0. + real:: bubble_y0 = 0. + real:: bubble_z0 = 0. + real:: bubble_radius_hor = 0. + real:: bubble_radius_ver = 0. + real:: bubble_dtemp = 0. + real:: bubble_dq = 0. + +real uhl ! current large-scale velocity in x near sfc +real vhl ! current large-scale velocity in y near sfc +real :: taux0 = 0. ! surface stress in x, m2/s2 +real :: tauy0 = 0. ! surface stress in y, m2/s2 + +end module crmx_params diff --git a/src/physics/spcam/crm/crmx_periodic.F90 b/src/physics/spcam/crm/crmx_periodic.F90 new file mode 100644 index 0000000000..d0126e21ee --- /dev/null +++ b/src/physics/spcam/crm/crmx_periodic.F90 @@ -0,0 +1,107 @@ + +subroutine periodic(flag) + +use crmx_vars +use crmx_microphysics +use crmx_sgs +use crmx_params, only: dotracers, dosgs +use crmx_crmtracers +#ifdef CLUBB_CRM +use crmx_params, only: doclubb, doclubbnoninter +#endif +implicit none + +integer flag, i + +if(flag.eq.0) then + + call bound_exchange(u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm,1,1,1,1,1) + call bound_exchange(v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm,1,1,1,1,2) + ! use w at the top level - 0s anyway - to exchange the sst boundaries (for + ! surface fluxes call + w(1:nx,1:ny,nz) = sstxy(1:nx,1:ny) + call bound_exchange(w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz,1,1,1,1,3) + sstxy(0:nx,1-YES3D:ny) = w(0:nx,1-YES3D:ny,nz) + w(0:nx+1,1-YES3D:ny+YES3D,nz) = 0. + +endif + + +if(flag.eq.2) then + + call bound_exchange(u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm,2,3,2+NADV,2+NADV,1) + call bound_exchange(v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm,2+NADV,2+NADV,2,3,2) + call bound_exchange(w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz,2+NADV,2+NADV,2+NADV,2+NADV,3) + + call bound_exchange(t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,3+NADVS,3+NADVS,3+NADVS,3+NADVS,4) + do i = 1,nsgs_fields + if(dosgs.and.advect_sgs) & + call bound_exchange(sgs_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & + 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+i) + end do + do i = 1,nmicro_fields + if( i.eq.index_water_vapor & +#ifdef CLUBB_CRM + ! Vince Larson (UWM) changed so that bound_exchange is called even if + ! docloud = .false. and doclubb = .true. 11 Nov 2007 + .or. (docloud.or.doclubb.or.doclubbnoninter) .and.flag_precip(i).ne.1 & +#else + .or. docloud.and.flag_precip(i).ne.1 & +#endif + .or. doprecip.and.flag_precip(i).eq.1 ) & + call bound_exchange(micro_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & + 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+nsgs_fields+nsgs_fields_diag+i) + end do + if(dotracers) then + do i=1,ntracers + call bound_exchange(tracer(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & + 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+nsgs_fields+nsgs_fields_diag+nmicro_fields+i) + end do + end if + +endif + +if(flag.eq.3) then + + call bound_exchange(t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,1,1,1,1,4) + do i = 1,nsgs_fields + if(dosgs.and.advect_sgs) & + call bound_exchange(sgs_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,1,1,1,1,4+i) + end do + do i = 1,nmicro_fields + if( i.eq.index_water_vapor & +#ifdef CLUBB_CRM + ! Vince Larson (UWM) changed so that bound_exchange is called even if + ! docloud = .false. and doclubb = .true. 11 Nov 2007 + .or. (docloud.or.doclubb.or.doclubbnoninter) .and.flag_precip(i).ne.1 & +#else + .or. docloud.and.flag_precip(i).ne.1 & +#endif + .or. doprecip.and.flag_precip(i).eq.1 ) & + call bound_exchange(micro_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & + 1,1,1,1,4+nsgs_fields+nsgs_fields_diag+i) + end do + if(dotracers) then + do i=1,ntracers + call bound_exchange(tracer(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & + 1,1,1,1,4+nsgs_fields+nsgs_fields_diag+nmicro_fields+i) + end do + end if + +endif + +if(flag.eq.4) then + + do i = 1,nsgs_fields_diag + if(dosgs.and.do_sgsdiag_bound) & + call bound_exchange(sgs_field_diag(:,:,:,i),dimx1_d,dimx2_d,dimy1_d,dimy2_d,nzm, & + 1+dimx1_d,dimx2_d-nx,YES3D+dimy1_d,1-YES3D+dimy2_d-ny,4+nsgs_fields+i) + end do + +end if + + + + +end subroutine periodic + diff --git a/src/physics/spcam/crm/crmx_precip_fall.F90 b/src/physics/spcam/crm/crmx_precip_fall.F90 new file mode 100644 index 0000000000..fb81395cee --- /dev/null +++ b/src/physics/spcam/crm/crmx_precip_fall.F90 @@ -0,0 +1,229 @@ +subroutine precip_fall(qp, term_vel, hydro_type, omega, ind) + +! positively definite monotonic advection with non-oscillatory option +! and gravitational sedimentation + +use crmx_vars +use crmx_params +implicit none + + + +real qp(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! falling hydrometeor +integer hydro_type ! 0 - all liquid, 1 - all ice, 2 - mixed +real omega(nx,ny,nzm) ! = 1: liquid, = 0: ice; = 0-1: mixed : used only when hydro_type=2 +integer ind + +! Terminal velocity fnction + +real, external :: term_vel ! terminal velocity function + + +! Local: + +real mx(nzm),mn(nzm), lfac(nz) +real www(nz),fz(nz) +real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) +real f0(nzm),df0(nzm) +real eps +integer i,j,k,kc,kb +logical nonos + +real y,pp,pn +pp(y)= max(0.,y) +pn(y)=-min(0.,y) + +real lat_heat, wmax + +real wp(nzm), tmp_qp(nzm), irhoadz(nzm), iwmax(nzm), rhofac(nzm), prec_cfl +integer nprec, iprec +real flagstat + +!-------------------------------------------------------- + +!call t_startf ('precip_fall') + +eps = 1.e-10 +nonos = .true. + + do k = 1,nzm + rhofac(k) = sqrt(1.29/rho(k)) + irhoadz(k) = 1./(rho(k)*adz(k)) ! Useful factor + kb = max(1,k-1) + wmax = dz*adz(kb)/dtn ! Velocity equivalent to a cfl of 1.0. + iwmax(k) = 1./wmax + end do + +! Add sedimentation of precipitation field to the vert. vel. + +do j=1,ny + do i=1,nx + + ! Compute precipitation velocity and flux column-by-column + + prec_cfl = 0. + + do k=1,nzm + + select case (hydro_type) + case(0) + lfac(k) = fac_cond + flagstat = 1. + case(1) + lfac(k) = fac_sub + flagstat = 1. + case(2) + lfac(k) = fac_cond + (1-omega(i,j,k))*fac_fus + flagstat = 1. + case(3) + lfac(k) = 0. + flagstat = 0. + case default + if(masterproc) then + print*, 'unknown hydro_type in precip_fall. exitting ...' + call task_abort + end if + end select + + wp(k)=rhofac(k)*term_vel(i,j,k,ind) + prec_cfl = max(prec_cfl,wp(k)*iwmax(k)) ! Keep column maximum CFL + wp(k) = -wp(k)*rhow(k)*dtn/dz + + end do ! k + + fz(nz)=0. + www(nz)=0. + lfac(nz)=0 + + ! If maximum CFL due to precipitation velocity is greater than 0.9, + ! take more than one advection step to maintain stability. + if (prec_cfl.gt.0.9) then + nprec = CEILING(prec_cfl/0.9) + do k = 1,nzm + ! wp already includes factor of dt, so reduce it by a + ! factor equal to the number of precipitation steps. + wp(k) = wp(k)/float(nprec) + end do + else + nprec = 1 + end if + + do iprec = 1,nprec + + do k = 1,nzm + tmp_qp(k) = qp(i,j,k) ! Temporary array for qp in this column + end do + + !----------------------------------------- + + if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + mx(k)=max(tmp_qp(kb),tmp_qp(kc),tmp_qp(k)) + mn(k)=min(tmp_qp(kb),tmp_qp(kc),tmp_qp(k)) + end do + + end if ! nonos + + ! loop over iterations + + do k=1,nzm + ! Define upwind precipitation flux + fz(k)=tmp_qp(k)*wp(k) + end do + + do k=1,nzm + kc=k+1 + tmp_qp(k)=tmp_qp(k)-(fz(kc)-fz(k))*irhoadz(k) !Update temporary qp + end do + + do k=1,nzm + ! Also, compute anti-diffusive correction to previous + ! (upwind) approximation to the flux + kb=max(1,k-1) + ! The precipitation velocity is a cell-centered quantity, + ! since it is computed from the cell-centered + ! precipitation mass fraction. Therefore, a reformulated + ! anti-diffusive flux is used here which accounts for + ! this and results in reduced numerical diffusion. + www(k) = 0.5*(1.+wp(k)*irhoadz(k)) & + *(tmp_qp(kb)*wp(kb) - tmp_qp(k)*wp(k)) ! works for wp(k)<0 + end do + + !---------- non-osscilatory option --------------- + + if(nonos) then + + do k=1,nzm + kc=min(nzm,k+1) + kb=max(1,k-1) + mx(k)=max(tmp_qp(kb),tmp_qp(kc),tmp_qp(k),mx(k)) + mn(k)=min(tmp_qp(kb),tmp_qp(kc),tmp_qp(k),mn(k)) + end do + + do k=1,nzm + kc=min(nzm,k+1) + mx(k)=rho(k)*adz(k)*(mx(k)-tmp_qp(k))/(pn(www(kc)) + pp(www(k))+eps) + mn(k)=rho(k)*adz(k)*(tmp_qp(k)-mn(k))/(pp(www(kc)) + pn(www(k))+eps) + end do + + do k=1,nzm + kb=max(1,k-1) + ! Add limited flux correction to fz(k). + fz(k) = fz(k) & ! Upwind flux + + pp(www(k))*min(1.,mx(k), mn(kb)) & + - pn(www(k))*min(1.,mx(kb),mn(k)) ! Anti-diffusive flux + end do + + endif ! nonos + + ! Update precipitation mass fraction and liquid-ice static + ! energy using precipitation fluxes computed in this column. + do k=1,nzm + kc=k+1 + ! Update precipitation mass fraction. + ! Note that fz is the total flux, including both the + ! upwind flux and the anti-diffusive correction. + qp(i,j,k)=qp(i,j,k)-(fz(kc)-fz(k))*irhoadz(k) + qpfall(k)=qpfall(k)-(fz(kc)-fz(k))*irhoadz(k)*flagstat ! For qp budget + lat_heat = -(lfac(kc)*fz(kc)-lfac(k)*fz(k))*irhoadz(k) + t(i,j,k)=t(i,j,k)-lat_heat + tlat(k)=tlat(k)-lat_heat ! For energy budget + precflux(k) = precflux(k) - fz(k)*flagstat ! For statistics + end do + precsfc(i,j) = precsfc(i,j) - fz(1)*flagstat ! For statistics + precssfc(i,j) = precssfc(i,j) - fz(1)*(1.-omega(i,j,1))*flagstat ! For statistics + prec_xy(i,j) = prec_xy(i,j) - fz(1)*flagstat ! For 2D output + + if (iprec.lt.nprec) then + + ! Re-compute precipitation velocity using new value of qp. + do k=1,nzm + wp(k) = rhofac(k)*term_vel(i,j,k,ind) + ! Decrease precipitation velocity by factor of nprec + wp(k) = -wp(k)*rhow(k)*dtn/dz/float(nprec) + ! Note: Don't bother checking CFL condition at each + ! substep since it's unlikely that the CFL will + ! increase very much between substeps when using + ! monotonic advection schemes. + end do + + fz(nz)=0. + www(nz)=0. + lfac(nz)=0. + + end if + + end do !iprec + + end do +end do + + +!call t_stopf ('precip_fall') + +end subroutine precip_fall + + diff --git a/src/physics/spcam/crm/crmx_press_grad.F90 b/src/physics/spcam/crm/crmx_press_grad.F90 new file mode 100644 index 0000000000..f8dbd12da5 --- /dev/null +++ b/src/physics/spcam/crm/crmx_press_grad.F90 @@ -0,0 +1,69 @@ + +subroutine press_grad + +! pressure term of the momentum equations + +use crmx_vars +use crmx_params, only: dowallx, dowally +implicit none + +real *8 rdx,rdy,rdz +integer i,j,k,kb,jb,ib + +rdx=1./dx +rdy=1./dy + +do k=1,nzm + kb=max(1,k-1) + rdz = 1./(dz*adzw(k)) + do j=1,ny + jb=j-YES3D + do i=1,nx + ib=i-1 + dudt(i,j,k,na)=dudt(i,j,k,na)-(p(i,j,k)-p(ib,j,k))*rdx + dvdt(i,j,k,na)=dvdt(i,j,k,na)-(p(i,j,k)-p(i,jb,k))*rdy + dwdt(i,j,k,na)=dwdt(i,j,k,na)-(p(i,j,k)-p(i,j,kb))*rdz + end do ! i + end do ! j +end do ! k + +do k=1,nzm + do j=1-YES3D,ny !bloss: 0,n* fixes computation of dp/d* in stats. + do i=0,nx + p(i,j,k)=p(i,j,k)*rho(k) ! convert p'/rho to p' + end do + end do +end do + +if(dowallx.and.mod(rank,nsubdomains_x).eq.0) then + + do k=1,nzm + do j=1,ny + dudt(1,j,k,na) = 0. + end do + end do + +end if + +if(dowally.and.RUN3D.and.rank.lt.nsubdomains_x) then + + do k=1,nzm + do i=1,nx + dvdt(i,1,k,na) = 0. + end do + end do + +end if + +if(dompi) then + call task_bound_duvdt() +else + call bound_duvdt() +endif + +call task_barrier() + +end subroutine press_grad + + + diff --git a/src/physics/spcam/crm/crmx_press_rhs.F90 b/src/physics/spcam/crm/crmx_press_rhs.F90 new file mode 100644 index 0000000000..215a06bc13 --- /dev/null +++ b/src/physics/spcam/crm/crmx_press_rhs.F90 @@ -0,0 +1,105 @@ + +subroutine press_rhs + +! right-hand-side of the Poisson equation for pressure + +use crmx_vars +use crmx_params, only: dowallx, dowally + +implicit none + + +real *8 dta,rdx,rdy,rdz,btat,ctat,rup,rdn +integer i,j,k,ic,jc,kc + +if(dowallx.and.mod(rank,nsubdomains_x).eq.0) then + + do k=1,nzm + do j=1,ny + dudt(1,j,k,na) = 0. + end do + end do + +end if + +if(dowally.and.RUN3D.and.rank.lt.nsubdomains_x) then + + do k=1,nzm + do i=1,nx + dvdt(i,1,k,na) = 0. + end do + end do + +end if + + +if(dompi) then + call task_bound_duvdt() +else + call bound_duvdt() +endif + +dta=1./dt3(na)/at +rdx=1./dx +rdy=1./dy +btat=bt/at +ctat=ct/at + +if(RUN3D) then + +do k=1,nzm + kc=k+1 + rdz=1./(adz(k)*dz) + rup = rhow(kc)/rho(k)*rdz + rdn = rhow(k)/rho(k)*rdz + do j=1,ny + jc=j+1 + do i=1,nx + ic=i+1 + p(i,j,k)=(rdx*(u(ic,j,k)-u(i,j,k))+ & + rdy*(v(i,jc,k)-v(i,j,k))+ & + (w(i,j,kc)*rup-w(i,j,k)*rdn) )*dta + & + (rdx*(dudt(ic,j,k,na)-dudt(i,j,k,na))+ & + rdy*(dvdt(i,jc,k,na)-dvdt(i,j,k,na))+ & + (dwdt(i,j,kc,na)*rup-dwdt(i,j,k,na)*rdn) ) + & + btat*(rdx*(dudt(ic,j,k,nb)-dudt(i,j,k,nb))+ & + rdy*(dvdt(i,jc,k,nb)-dvdt(i,j,k,nb))+ & + (dwdt(i,j,kc,nb)*rup-dwdt(i,j,k,nb)*rdn) ) + & + ctat*(rdx*(dudt(ic,j,k,nc)-dudt(i,j,k,nc))+ & + rdy*(dvdt(i,jc,k,nc)-dvdt(i,j,k,nc))+ & + (dwdt(i,j,kc,nc)*rup-dwdt(i,j,k,nc)*rdn) ) + p(i,j,k)=p(i,j,k)*rho(k) + end do + end do +end do + + +else + +j=1 + +do k=1,nzm + kc=k+1 + rdz=1./(adz(k)*dz) + rup = rhow(kc)/rho(k)*rdz + rdn = rhow(k)/rho(k)*rdz + do i=1,nx + ic=i+1 + p(i,j,k)=(rdx*(u(ic,j,k)-u(i,j,k))+ & + (w(i,j,kc)*rup-w(i,j,k)*rdn) )*dta + & + (rdx*(dudt(ic,j,k,na)-dudt(i,j,k,na))+ & + (dwdt(i,j,kc,na)*rup-dwdt(i,j,k,na)*rdn) ) + & + btat*(rdx*(dudt(ic,j,k,nb)-dudt(i,j,k,nb))+ & + (dwdt(i,j,kc,nb)*rup-dwdt(i,j,k,nb)*rdn) ) + & + ctat*(rdx*(dudt(ic,j,k,nc)-dudt(i,j,k,nc))+ & + (dwdt(i,j,kc,nc)*rup-dwdt(i,j,k,nc)*rdn) ) + p(i,j,k)=p(i,j,k)*rho(k) + end do +end do + + +endif + +call task_barrier() + +end subroutine press_rhs diff --git a/src/physics/spcam/crm/crmx_pressure.F90 b/src/physics/spcam/crm/crmx_pressure.F90 new file mode 100644 index 0000000000..d8376e782d --- /dev/null +++ b/src/physics/spcam/crm/crmx_pressure.F90 @@ -0,0 +1,517 @@ +! Non-blocking receives before blocking sends + +subroutine pressure + +! Original pressure solver based on horizontal slabs +! (C) 1998, 2002 Marat Khairoutdinov +! Works only when the number of slabs is equal to the number of processors. +! Therefore, the number of processors shouldn't exceed the number of levels nzm +! Also, used for a 2D version +! For more processors for the given number of levels and 3D, use pressure_big + +use crmx_vars +use crmx_params, only: dowallx, dowally, docolumn +implicit none + + +integer, parameter :: npressureslabs = nsubdomains +integer, parameter :: nzslab = max(1,nzm / npressureslabs) +integer, parameter :: nx2=nx_gl+2, ny2=ny_gl+2*YES3D +integer, parameter :: n3i=3*nx_gl/2+1,n3j=3*ny_gl/2+1 + +real f(nx2,ny2,nzslab) ! global rhs and array for FTP coefficeients +real ff(nx+1,ny+2*YES3D,nzm) ! local (subdomain's) version of f +real buff_slabs(nxp1,nyp2,nzslab,npressureslabs) +real buff_subs(nxp1,nyp2,nzslab,nsubdomains) +real bufp_slabs(0:nx,1-YES3D:ny,nzslab,npressureslabs) +real bufp_subs(0:nx,1-YES3D:ny,nzslab,nsubdomains) +common/tmpstack/f,ff,buff_slabs,buff_subs +equivalence (buff_slabs,bufp_slabs) +equivalence (buff_subs,bufp_subs) + +real work(nx2,ny2),trigxi(n3i),trigxj(n3j) ! FFT stuff +integer ifaxj(100),ifaxi(100) + +real(kind=selected_real_kind(12)) a(nzm),b,c(nzm),e,fff(nzm) +real(kind=selected_real_kind(12)) xi,xj,xnx,xny,ddx2,ddy2,pii,factx,facty,eign +real(kind=selected_real_kind(12)) alfa(nzm-1),beta(nzm-1) + +integer reqs_in(nsubdomains) +integer i, j, k, id, jd, m, n, it, jt, ii, jj, tag, rf +integer nyp22, n_in, count +integer iii(0:nx_gl),jjj(0:ny_gl) +logical flag(nsubdomains) +integer iwall,jwall +integer,parameter :: DBL = selected_real_kind(12) + +! check if the grid size allows the computation: + +if(nsubdomains.gt.nzm) then + if(masterproc) print*,'pressure_orig: nzm < nsubdomains. STOP' + call task_abort +endif + +if(mod(nzm,npressureslabs).ne.0) then + if(masterproc) print*,'pressure_orig: nzm/npressureslabs is not round number. STOP' + call task_abort +endif + +!----------------------------------------------------------------- + +if(docolumn) return + +if(dowallx) then + iwall=1 +else + iwall=0 +end if +if(RUN2D) then + nyp22=1 + jwall=0 +else + nyp22=nyp2 + if(dowally) then + jwall=2 + else + jwall=0 + end if +endif + +!----------------------------------------------------------------- +! Compute the r.h.s. of the Poisson equation for pressure + +call press_rhs() + + +!----------------------------------------------------------------- +! Form the horizontal slabs of right-hand-sides of Poisson equation +! for the global domain. Request sending and receiving tasks. + +! iNon-blocking receive first: + +n_in = 0 +do m = 0,nsubdomains-1 + + if(rank.lt.npressureslabs.and.m.ne.nsubdomains-1) then + + n_in = n_in + 1 + call task_receive_float(bufp_subs(0,1-YES3D,1,n_in), & + nzslab*nxp1*nyp1,reqs_in(n_in)) + flag(n_in) = .false. + + endif + + if(rank.lt.npressureslabs.and.m.eq.nsubdomains-1) then + + call task_rank_to_index(rank,it,jt) + n = rank*nzslab + do k = 1,nzslab + do j = 1,ny + do i = 1,nx + f(i+it,j+jt,k) = p(i,j,k+n) + end do + end do + end do + endif + +end do ! m + + +! Blocking send now: + + +do m = 0,nsubdomains-1 + + if(m.lt.npressureslabs.and.m.ne.rank) then + + n = m*nzslab + 1 + call task_bsend_float(m,p(0,1-YES3D,n),nzslab*nxp1*nyp1, 33) + endif + +end do ! m + + +! Fill slabs when receive buffers are full: + +count = n_in +do while (count .gt. 0) + do m = 1,n_in + if(.not.flag(m)) then + call task_test(reqs_in(m), flag(m), rf, tag) + if(flag(m)) then + count=count-1 + call task_rank_to_index(rf,it,jt) + do k = 1,nzslab + do j = 1,ny + do i = 1,nx + f(i+it,j+jt,k) = bufp_subs(i,j,k,m) + end do + end do + end do + endif + endif + end do +end do + + +!------------------------------------------------- +! Perform Fourier transformation for a slab: + +if(rank.lt.npressureslabs) then + + call fftfax_crm(nx_gl,ifaxi,trigxi) + if(RUN3D) call fftfax_crm(ny_gl,ifaxj,trigxj) + + do k=1,nzslab + + call fft991_crm(f(1,1,k),work,trigxi,ifaxi,1,nx2,nx_gl,ny_gl,-1) + + if(RUN3D) then + call fft991_crm(f(1,1,k),work,trigxj,ifaxj,nx2,1,ny_gl,nx_gl+1,-1) + end if + + end do + +endif + + +! Synchronize all slabs: + +call task_barrier() + +!------------------------------------------------- +! Send Fourier coeffiecients back to subdomains: + +! Non-blocking receive first: + +n_in = 0 +do m = 0, nsubdomains-1 + + call task_rank_to_index(m,it,jt) + + if(rank.lt.npressureslabs.and.m.eq.rank) then + + n = rank*nzslab + do k = 1,nzslab + do j = 1,nyp22-jwall + do i = 1,nxp1-iwall + ff(i,j,k+n) = f(i+it,j+jt,k) + end do + end do + end do + + end if + + if(m.lt.npressureslabs-1.or.m.eq.npressureslabs-1 & + .and.rank.ge.npressureslabs) then + + n_in = n_in + 1 + call task_receive_float(buff_slabs(1,1,1,n_in), & + nzslab*nxp1*nyp22,reqs_in(n_in)) + flag(n_in) = .false. + endif + +end do ! m + +! Blocking send now: + +do m = 0, nsubdomains-1 + + call task_rank_to_index(m,it,jt) + + if(rank.lt.npressureslabs.and.m.ne.rank) then + + do k = 1,nzslab + do j = 1,nyp22 + do i = 1,nxp1 + buff_subs(i,j,k,1) = f(i+it,j+jt,k) + end do + end do + end do + + call task_bsend_float(m, buff_subs(1,1,1,1),nzslab*nxp1*nyp22,44) + + endif + +end do ! m + + + +! Fill slabs when receive buffers are complete: + + +count = n_in +do while (count .gt. 0) + do m = 1,n_in + if(.not.flag(m)) then + call task_test(reqs_in(m), flag(m), rf, tag) + if(flag(m)) then + count=count-1 + n = rf*nzslab + do k = 1,nzslab + do j=1,nyp22 + do i=1,nxp1 + ff(i,j,k+n) = buff_slabs(i,j,k,m) + end do + end do + end do + endif + endif + end do +end do + +!------------------------------------------------- +! Solve the tri-diagonal system for Fourier coeffiecients +! in the vertical for each subdomain: + +do k=1,nzm + a(k)=rhow(k)/(adz(k)*adzw(k)*dz*dz) + c(k)=rhow(k+1)/(adz(k)*adzw(k+1)*dz*dz) +end do + +call task_rank_to_index(rank,it,jt) + +ddx2=1._DBL/(dx*dx) +ddy2=1._DBL/(dy*dy) +pii = acos(-1._DBL) +xnx=pii/nx_gl +xny=pii/ny_gl +do j=1,nyp22-jwall + if(dowally) then + jd=j+jt-1 + facty = 1.d0 + else + jd=(j+jt-0.1)/2. + facty = 2.d0 + end if + xj=jd + do i=1,nxp1-iwall + if(dowallx) then + id=i+it-1 + factx = 1.d0 + else + id=(i+it-0.1)/2. + factx = 2.d0 + end if + fff(1:nzm) = ff(i,j,1:nzm) + xi=id + eign=(2._DBL*cos(factx*xnx*xi)-2._DBL)*ddx2+ & + (2._DBL*cos(facty*xny*xj)-2._DBL)*ddy2 + if(id+jd.eq.0) then + b=1._DBL/(eign*rho(1)-a(1)-c(1)) + alfa(1)=-c(1)*b + beta(1)=fff(1)*b + else + b=1._DBL/(eign*rho(1)-c(1)) + alfa(1)=-c(1)*b + beta(1)=fff(1)*b + end if + do k=2,nzm-1 + e=1._DBL/(eign*rho(k)-a(k)-c(k)+a(k)*alfa(k-1)) + alfa(k)=-c(k)*e + beta(k)=(fff(k)-a(k)*beta(k-1))*e + end do + + fff(nzm)=(fff(nzm)-a(nzm)*beta(nzm-1))/ & + (eign*rho(nzm)-a(nzm)+a(nzm)*alfa(nzm-1)) + + do k=nzm-1,1,-1 + fff(k)=alfa(k)*fff(k+1)+beta(k) + end do + ff(i,j,1:nzm) = fff(1:nzm) + + end do +end do + +call task_barrier() + +!----------------------------------------------------------------- +! Send the Fourier coefficient to the tasks performing +! the inverse Fourier transformation: + +! Non-blocking receive first: + +n_in = 0 +do m = 0,nsubdomains-1 + + if(rank.lt.npressureslabs.and.m.ne.nsubdomains-1) then + n_in = n_in + 1 + call task_receive_float(buff_subs(1,1,1,n_in), & + nzslab*nxp1*nyp22, reqs_in(n_in)) + flag(n_in) = .false. + endif + + if(rank.lt.npressureslabs.and.m.eq.nsubdomains-1) then + + call task_rank_to_index(rank,it,jt) + n = rank*nzslab + do k = 1,nzslab + do j = 1,nyp22-jwall + do i = 1,nxp1-iwall + f(i+it,j+jt,k) = ff(i,j,k+n) + end do + end do + end do + + endif + +end do ! m + +! Blocking send now: + +do m = 0,nsubdomains-1 + + if(m.lt.npressureslabs.and.m.ne.rank) then + n = m*nzslab+1 + call task_bsend_float(m,ff(1,1,n),nzslab*nxp1*nyp22, 33) + endif + +end do ! m + + +! Fill slabs when receive buffers are full: + + +count = n_in +do while (count .gt. 0) + do m = 1,n_in + if(.not.flag(m)) then + call task_test(reqs_in(m), flag(m), rf, tag) + if(flag(m)) then + count=count-1 + call task_rank_to_index(rf,it,jt) + do k = 1,nzslab + do j = 1,nyp22-jwall + do i = 1,nxp1-iwall + f(i+it,j+jt,k) = buff_subs(i,j,k,m) + end do + end do + end do + endif + endif + end do +end do + +!------------------------------------------------- +! Perform inverse Fourier transformation: + +if(rank.lt.npressureslabs) then + + do k=1,nzslab + + if(RUN3D) then + call fft991_crm(f(1,1,k),work,trigxj,ifaxj,nx2,1,ny_gl,nx_gl+1,+1) + end if + + call fft991_crm(f(1,1,k),work,trigxi,ifaxi,1,nx2,nx_gl,ny_gl,+1) + + end do + +endif + +call task_barrier() + +!----------------------------------------------------------------- +! Fill the pressure field for each subdomain: + +do i=1,nx_gl + iii(i)=i +end do +iii(0)=nx_gl +do j=1,ny_gl + jjj(j)=j +end do +jjj(0)=ny_gl + +! Non-blocking receive first: + +n_in = 0 +do m = 0, nsubdomains-1 + + call task_rank_to_index(m,it,jt) + + if(m.lt.npressureslabs-1.or. & + m.eq.npressureslabs-1.and.rank.ge.npressureslabs) then + + n_in = n_in + 1 + call task_receive_float(bufp_slabs(0,1-YES3D,1,n_in), & + nzslab*nxp1*nyp1, reqs_in(n_in)) + flag(n_in) = .false. + + endif + + if(rank.lt.npressureslabs.and.m.eq.rank) then + + n = rank*nzslab + do k = 1,nzslab + do j = 1-YES3D,ny + jj=jjj(j+jt) + do i = 0,nx + ii=iii(i+it) + p(i,j,k+n) = f(ii,jj,k) + end do + end do + end do + + end if + +end do ! m + + +! Blocking send now: + +do m = 0, nsubdomains-1 + + call task_rank_to_index(m,it,jt) + + if(rank.lt.npressureslabs.and.m.ne.rank) then + + do k = 1,nzslab + do j = 1-YES3D,ny + jj=jjj(j+jt) + do i = 0,nx + ii=iii(i+it) + bufp_subs(i,j,k,1) = f(ii,jj,k) + end do + end do + end do + + call task_bsend_float(m, bufp_subs(0,1-YES3D,1,1), nzslab*nxp1*nyp1,44) + + endif + +end do ! m + +! Fill the receive buffers: + +count = n_in +do while (count .gt. 0) + do m = 1,n_in + if(.not.flag(m)) then + call task_test(reqs_in(m), flag(m), rf, tag) + if(flag(m)) then + count=count-1 + n = rf*nzslab + do k = 1,nzslab + do j=1-YES3D,ny + do i=0,nx + p(i,j,k+n) = bufp_slabs(i,j,k,m) + end do + end do + end do + endif + endif + end do +end do + + +call task_barrier() + +! Add pressure gradient term to the rhs of the momentum equation: + +call press_grad() + +end + + + diff --git a/src/physics/spcam/crm/crmx_random.F90 b/src/physics/spcam/crm/crmx_random.F90 new file mode 100644 index 0000000000..7e0172527b --- /dev/null +++ b/src/physics/spcam/crm/crmx_random.F90 @@ -0,0 +1,62 @@ +! Simple randaom number generator in the range [0,1] +! ranset_(iseed) initializes with iseed +! ranf_() returns next random numer + + + + + real function ranf_() + implicit none + real rand_ +! ranf_ = rand_(0) + call random_number(ranf_) + return + end + + + subroutine ranset_(iseed) + implicit none + real rand_,ranf_ + integer iseed, i, m, nsteps +! i = rand_(1) ! reinitialize (reset) + nsteps = iseed*10000 + do i = 1,nsteps + m = ranf_() +! m = rand_(0) + end do + return + end + + + + + + real function rand_(iseed) + implicit none + integer iseed + integer ia1, ia0, ia1ma0, ic, ix1, ix0, iy0, iy1 + save ia1, ia0, ia1ma0, ic, ix1, ix0 + data ix1, ix0, ia1, ia0, ia1ma0, ic/0,0,1536,1029,507,1731/ + if (iseed.ne.0) then + ia1 = 1536 + ia0 = 1029 + ia1ma0 = 507 + ic = 1731 + ix1 = 0 + ix0 = 0 + rand_ = 0 + else + iy0 = ia0*ix0 + iy1 = ia1*ix1 + ia1ma0*(ix0-ix1) + iy0 + iy0 = iy0 + ic + ix0 = mod (iy0, 2048) + iy1 = iy1 + (iy0-ix0)/2048 + ix1 = mod (iy1, 2048) + rand_ = ix1*2048 + ix0 + rand_ = rand_ / 4194304. + end if + return + end + + + diff --git a/src/physics/spcam/crm/crmx_sat.F90 b/src/physics/spcam/crm/crmx_sat.F90 new file mode 100644 index 0000000000..fb74141d07 --- /dev/null +++ b/src/physics/spcam/crm/crmx_sat.F90 @@ -0,0 +1,122 @@ + +! Saturation vapor pressure and mixing ratio. +! Based on Flatau et.al, (JAM, 1992:1507) - valid for T > -80C +! sat. vapor over ice below -80C - used Murphy and Koop (2005) +! For water below -80C simply assumed esw/esi = 2. +! des/dT below -80C computed as a finite difference of es + +real function esatw_crm(t) +implicit none +real t ! temperature (K) +real a0,a1,a2,a3,a4,a5,a6,a7,a8 +data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& + 6.105851, 0.4440316, 0.1430341e-1, & + 0.2641412e-3, 0.2995057e-5, 0.2031998e-7, & + 0.6936113e-10, 0.2564861e-13,-0.3704404e-15/ +! 6.11239921, 0.443987641, 0.142986287e-1, & +! 0.264847430e-3, 0.302950461e-5, 0.206739458e-7, & +! 0.640689451e-10, -0.952447341e-13,-0.976195544e-15/ +real dt + dt = t-273.16 +if(dt.gt.-80.) then + esatw_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) +else + esatw_crm = 2.*0.01*exp(9.550426 - 5723.265/t + 3.53068*Log(t) - 0.00728332*t) +end if +end + + + +real function qsatw_crm(t,p) +implicit none +real t ! temperature (K) +real p ! pressure (mb) +real esat_crm,esatw_crm +esat_crm = esatw_crm(t) +qsatw_crm = 0.622 * esat_crm/max(esat_crm,p-esat_crm) +end + + +real function dtesatw_crm(t) +implicit none +real t ! temperature (K) +real a0,a1,a2,a3,a4,a5,a6,a7,a8 +data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& + 0.443956472, 0.285976452e-1, 0.794747212e-3, & + 0.121167162e-4, 0.103167413e-6, 0.385208005e-9, & + -0.604119582e-12, -0.792933209e-14, -0.599634321e-17/ +real dt,esatw_crm +dt = t-273.16 +if(dt.gt.-80.) then + dtesatw_crm = a0 + dt* (a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) +else + dtesatw_crm = esatw_crm(t+1)-esatw_crm(t) +end if + +end + + +real function dtqsatw_crm(t,p) +implicit none +real t ! temperature (K) +real p ! pressure (mb) +real dtesatw_crm +dtqsatw_crm = 0.622*dtesatw_crm(t)/p +end + + +real function esati_crm(t) +implicit none +real t ! temperature (K) +real a0,a1,a2,a3,a4,a5,a6,a7,a8 +data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& + 6.11147274, 0.503160820, 0.188439774e-1, & + 0.420895665e-3, 0.615021634e-5,0.602588177e-7, & + 0.385852041e-9, 0.146898966e-11, 0.252751365e-14/ +real dt +dt = t-273.16 +if(dt.gt.-80.) then + esati_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) +else + esati_crm = 0.01*exp(9.550426 - 5723.265/t + 3.53068*Log(t) - 0.00728332*t) +end if +end + + + +real function qsati_crm(t,p) +implicit none +real t ! temperature (K) +real p ! pressure (mb) +real esat_crm,esati_crm +esat_crm=esati_crm(t) +qsati_crm=0.622 * esat_crm/max(esat_crm,p-esat_crm) +end + + +real function dtesati_crm(t) +implicit none +real t ! temperature (K) +real a0,a1,a2,a3,a4,a5,a6,a7,a8 +data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & + 0.503223089, 0.377174432e-1,0.126710138e-2, & + 0.249065913e-4, 0.312668753e-6, 0.255653718e-8, & + 0.132073448e-10, 0.390204672e-13, 0.497275778e-16/ +real dt,esati_crm +dt = t-273.16 +if(dt.gt.-80.) then + dtesati_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) +else + dtesati_crm = esati_crm(t+1.)-esati_crm(t) +end if +end + + +real function dtqsati_crm(t,p) +implicit none +real t ! temperature (K) +real p ! pressure (mb) +real dtesati_crm +dtqsati_crm=0.622*dtesati_crm(t)/p +end + diff --git a/src/physics/spcam/crm/crmx_setparm.F90 b/src/physics/spcam/crm/crmx_setparm.F90 new file mode 100644 index 0000000000..e843b22621 --- /dev/null +++ b/src/physics/spcam/crm/crmx_setparm.F90 @@ -0,0 +1,140 @@ +module crmx_setparm_mod + +contains + +subroutine setparm + +! initialize parameters: + +use crmx_vars +!use micro_params +use crmx_params +use crmx_microphysics, only: micro_setparm +use crmx_sgs, only: sgs_setparm + +implicit none + +integer icondavg, ierr + +!NAMELIST /PARAMETERS/ dodamping, doupperbound, docloud, doprecip, & +! dolongwave, doshortwave, dosgs, & +! docoriolis, dosurface, dolargescale, doradforcing, & +! nadams,fluxt0,fluxq0,tau0,tabs_s,z0,tauls,nelapse, & +! dt, dx, dy, fcor, ug, vg, nstop, caseid, & +! nstat, nstatfrq, nprint, nrestart, doradsimple, & +! nsave3D, nsave3Dstart, nsave3Dend, dosfcforcing, & +! donudging_uv, donudging_tq, dosmagor, doscalar, & +! timelargescale, longitude0, latitude0, day0, nrad, & +! CEM,LES,OCEAN,LAND,SFC_FLX_FXD,SFC_TAU_FXD, soil_wetness, & +! doensemble, nensemble, doxy, dowallx, dowally, & +! nsave2D, nsave2Dstart, nsave2Dend, qnsave3D, & +! docolumn, save2Dbin, save2Davg, save3Dbin, & +! save2Dsep, save3Dsep, dogzip2D, dogzip3D, restart_sep, & +! doseasons, doperpetual, doradhomo, dosfchomo, doisccp, & +! dodynamicocean, ocean_type, & +! dosolarconstant, solar_constant, zenith_angle, rundatadir, & +! dotracers, output_sep, perturb_type, & +! doSAMconditionals, dosatupdnconditionals, & +! doscamiopdata, iopfile, dozero_out_day0, & +! nstatmom, nstatmomstart, nstatmomend, savemomsep, savemombin, & +! nmovie, nmoviestart, nmovieend, nrestart_skip, & +! bubble_x0,bubble_y0,bubble_z0,bubble_radius_hor, & +! bubble_radius_ver,bubble_dtemp,bubble_dq, dosmoke, & +! doclubb, doclubbnoninter, doclubb_sfc_fluxes, & ! added by dschanen UWM +! docam_sfc_fluxes ! added by mhwang + + + +!---------------------------------- +! Read namelist variables from the standard input: +!------------ + +!open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') +!read (55,PARAMETERS) +!close(55) + + doprecip = .true. + dosgs = .true. + dosurface = .true. + dodamping = .true. + dt = CRM_DT + dx = CRM_DX + dy = CRM_DY + CEM = .true. +#ifndef CLUBB_CRM + doclubb = .false. ! then docloud must be .true. + docloud = .true. +#else + doclubb = .true. ! then docloud must be .false. + docloud = .false. + doclubbnoninter = .false. + doclubb_sfc_fluxes = .false. + docam_sfc_fluxes = .true. ! update variables in cam, neither in sam nor in clubb +++mhwang + nclubb = 3 + +#ifdef sam1mom +! for sam1mom, nclubb needs to be 1. +! see comments in ./MICRO_SAM1MOM/microphysics.F90 + nclubb = 3 +#endif + +#endif + rank = 0 ! in MMF model, rank = 0 +!------------------------------------ +! Set parameters + + + ! Allow only special cases for separate output: + + output_sep = output_sep.and.RUN3D + if(output_sep) save2Dsep = .true. + + if(RUN2D) dy=dx + + if(RUN2D.and.YES3D.eq.1) then + print*,'Error: 2D run and YES3D is set to 1. Exitting...' + call task_abort() + endif + if(RUN3D.and.YES3D.eq.0) then + print*,'Error: 3D run and YES3D is set to 0. Exitting...' + call task_abort() + endif +#ifdef CLUBB_CRM + if ( dx >= 1000. .and. LES ) then + print*,'Error: Horizonatal grid spacing is >= 1000. meters' + print*,'but LES is true. Use CEM mode for coarse resolutions.' + call task_abort() + end if +#endif + + if(fcor.eq.-999.) fcor= 4*pi/86400.*sin(latitude0*pi/180.) + fcorz = sqrt(4.*(2*pi/(3600.*24.))**2-fcor**2) + + if(ny.eq.1) dy=dx + dtn = dt + + notopened2D = .true. + notopened3D = .true. + +! call zero_instr_diag() ! initialize instruments output + call sgs_setparm() ! read in SGS options from prm file. + call micro_setparm() ! read in microphysical options from prm file. + + if(dosmoke) then + epsv=0. + else + epsv=0.61 + endif + + if(navgmom_x.lt.0.or.navgmom_y.lt.0) then + nstatmom = 1 + nstatmomstart = 99999999 + nstatmomend = 999999999 + end if + + if(tautqls.eq.99999999.) tautqls = tauls + + masterproc = rank.eq.0 + +end subroutine setparm +end module crmx_setparm_mod diff --git a/src/physics/spcam/crm/crmx_setperturb.F90 b/src/physics/spcam/crm/crmx_setperturb.F90 new file mode 100644 index 0000000000..88bbabeed4 --- /dev/null +++ b/src/physics/spcam/crm/crmx_setperturb.F90 @@ -0,0 +1,59 @@ + +subroutine setperturb(iseed) + +! Random noise +! This surboutine has been updated for SPCAM5 (Minghuai.Wang@pnnl.gov, April, 2012). +! Now the random generator is seeded based on the global column id, which gets rid +! of the dependence of the SPCAM reulst on pcols. + +use crmx_vars +use crmx_sgs, only: setperturb_sgs + +implicit none + +integer, intent(in) :: iseed + +integer i,j,k +real rrr,ranf_ +integer, allocatable :: rndm_seed(:) +integer :: rndm_seed_sz +real :: t02(nzm) +real :: tke02(nzm) + +!call ranset_(30*rank) +call random_seed(size=rndm_seed_sz) +allocate(rndm_seed(rndm_seed_sz)) + +rndm_seed = iseed +call random_seed(put=rndm_seed) + +call setperturb_sgs(0) ! set sgs fields + +t02 = 0.0 +tke02 = 0.0 +do k=1,nzm + do j=1,ny + do i=1,nx + rrr=1.-2.*ranf_() + + if(k.le.5) then + t(i,j,k)=t(i,j,k)+0.02*rrr*(6-k) + endif + t02(k) = t02(k) + t(i,j,k)/(nx*ny) + end do + end do + +! energy conservation +++mhwang (2012-06) + do j=1, ny + do i=1, nx + if(k.le.5) then + t(i,j,k) = t(i,j,k) * t0(k)/t02(k) + end if + end do + end do +end do + +deallocate(rndm_seed) + +end + diff --git a/src/physics/spcam/crm/crmx_stepout.F90 b/src/physics/spcam/crm/crmx_stepout.F90 new file mode 100644 index 0000000000..0c7f66bc0f --- /dev/null +++ b/src/physics/spcam/crm/crmx_stepout.F90 @@ -0,0 +1,196 @@ +subroutine stepout(nstatsteps) + +use crmx_vars +!use rad, only: qrad +use crmx_sgs, only: tk, sgs_print +use crmx_crmtracers +use crmx_microphysics, only: micro_print +use crmx_params +implicit none + +integer i,j,k,ic,jc,nstatsteps +integer n +real div, divmax, divmin +real rdx, rdy, rdz, coef +integer im,jm,km +real wmax, qnmax(1), qnmax1(1) +real(kind=selected_real_kind(12)) buffer(6), buffer1(6) +real(kind=selected_real_kind(12)) qi0(nzm) + +#ifdef CLUBB_CRM +real(8) buffer_e(7), buffer1_e(7) +#endif + + + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! Print stuff out: + +!call t_startf ('print_out') + +if(masterproc) print *,'NSTEP = ',nstep,' NCYCLE=',ncycle + +if(mod(nstep,nprint).eq.0) then + + + divmin=1.e20 + divmax=-1.e20 + + rdx = 1./dx + rdy = 1./dy + + wmax=0. + do k=1,nzm + coef = rho(k)*adz(k)*dz + rdz = 1./coef + if(ny.ne.1) then + do j=1,ny-1*YES3D + jc = j+1*YES3D + do i=1,nx-1 + ic = i+1 + div = (u(ic,j,k)-u(i,j,k))*rdx + (v(i,jc,k)-v(i,j,k))*rdy + & + (w(i,j,k+1)*rhow(k+1)-w(i,j,k)*rhow(k))*rdz + divmax = max(divmax,div) + divmin = min(divmin,div) + if(w(i,j,k).gt.wmax) then + wmax=w(i,j,k) + im=i + jm=j + km=k + endif + end do + end do + else + j = 1 + do i=1,nx-1 + ic = i+1 + div = (u(ic,j,k)-u(i,j,k))*rdx +(w(i,j,k+1)*rhow(k+1)-w(i,j,k)*rhow(k))*rdz + divmax = max(divmax,div) + divmin = min(divmin,div) + if(w(i,j,k).gt.wmax) then + wmax=w(i,j,k) + im=i + jm=j + km=k + endif + end do + endif + end do + + if(dompi) then + buffer(1) = total_water_before + buffer(2) = total_water_after + buffer(3) = total_water_evap + buffer(4) = total_water_prec + buffer(5) = total_water_ls +#ifdef CLUBB_CRM + buffer(6) = total_water_clubb + + buffer_e(1) = total_energy_before + buffer_e(2) = total_energy_after + buffer_e(3) = total_energy_evap + buffer_e(4) = total_energy_prec + buffer_e(5) = total_energy_ls + buffer_e(6) = total_energy_clubb + buffer_e(7) = total_energy_rad +#endif + call task_sum_real8(buffer, buffer1,6) + total_water_before = buffer1(1) + total_water_after = buffer1(2) + total_water_evap = buffer1(3) + total_water_prec = buffer1(4) + total_water_ls = buffer1(5) +#ifdef CLUBB_CRM + total_water_clubb = buffer1(6) + + call task_sum_real8(buffer_e, buffer1_e,7) + total_energy_before = buffer1_e(1) + total_energy_after = buffer1_e(2) + total_energy_evap = buffer1_e(3) + total_energy_prec = buffer1_e(4) + total_energy_ls = buffer1_e(5) + total_energy_clubb = buffer1_e(6) + total_energy_rad = buffer1_e(7) +#endif + end if + +!print*,rank,minval(u(1:nx,1:ny,:)),maxval(u(1:nx,1:ny,:)) +!print*,rank,'min:',minloc(u(1:nx,1:ny,:)) +!print*,rank,'max:',maxloc(u(1:nx,1:ny,:)) + +!if(masterproc) then + +!print*,'--->',tk(27,1,1) +!print*,'tk->:' +!write(6,'(16f7.2)')((tk(i,1,k),i=1,16),k=nzm,1,-1) +!print*,'p->:' +!write(6,'(16f7.2)')((p(i,1,k),i=1,16),k=nzm,1,-1) +!print*,'u->:' +!write(6,'(16f7.2)')((u(i,1,k),i=1,16),k=nzm,1,-1) +!print*,'v->:' +!write(6,'(16f7.2)')((v(i,1,k),i=1,16),k=nzm,1,-1) +!print*,'w->:' +!write(6,'(16f7.2)')((w(i,1,k),i=1,16),k=nzm,1,-1) +!print*,'qcl:' +!write(6,'(16f7.2)')((qcl(i,13,k)*1000.,i=1,16),k=30,1,-1) +!print*,'qpl:' +!write(6,'(16f7.2)')((qpl(i,13,k)*1000.,i=1,16),k=30,1,-1) +!print*,'qrad:' +!write(6,'(16f7.2)')((qrad(i,13,k)*3600.,i=1,16),k=30,1,-1) +!print*,'qv:' +!write(6,'(16f7.2)')((qv(i,13,k)*1000.,i=1,16),k=30,1,-1) +!print*,'tabs:' +!write(6,'(16f7.2)')((tabs(i,13,k),i=1,16),k=30,1,-1) +! +!end if + +!-------------------------------------------------------- + if(masterproc) then + + print*,'DAY = ',day + write(6,*) 'NSTEP=',nstep + write(6,*) 'div:',divmax,divmin + if(.not.dodynamicocean) write(6,*) 'SST=',tabs_s + write(6,*) 'surface pressure=',pres0 + + endif + + call fminmax_print('u:',u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm) + call fminmax_print('v:',v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm-5) + call fminmax_print('w:',w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz) + call fminmax_print('p:',p,0,nx,1-YES3D,ny,nzm) + call fminmax_print('t:',t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) + call fminmax_print('tabs:',tabs,1,nx,1,ny,nzm) + call fminmax_print('qv:',qv,1,nx,1,ny,nzm) + if(dosgs) call sgs_print() +#ifdef CLUBB_CRM + if(docloud.or.doclubb) then +#else + if(docloud) then +#endif /*CLUBB_CRM*/ + call fminmax_print('qcl:',qcl,1,nx,1,ny,nzm) + call fminmax_print('qci:',qci,1,nx,1,ny,nzm) + call micro_print() + end if + if(doprecip) then + call fminmax_print('qpl:',qpl,1,nx,1,ny,nzm) + call fminmax_print('qpi:',qpi,1,nx,1,ny,nzm) + end if +! if(dolongwave.or.doshortwave) call fminmax_print('qrad(K/day):',qrad*86400.,1,nx,1,ny,nzm) + if(dotracers) then + do k=1,ntracers + call fminmax_print(trim(tracername(k))//':',tracer(:,:,:,k),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) + end do + end if + call fminmax_print('shf:',fluxbt*cp*rhow(1),1,nx,1,ny,1) + call fminmax_print('lhf:',fluxbq*lcond*rhow(1),1,nx,1,ny,1) + call fminmax_print('uw:',fluxbu,1,nx,1,ny,1) + call fminmax_print('vw:',fluxbv,1,nx,1,ny,1) + call fminmax_print('sst:',sstxy,0,nx,1-YES3D,ny,1) + +end if ! (mod(nstep,nprint).eq.0) + +!call t_stopf ('print_out') + +end diff --git a/src/physics/spcam/crm/crmx_task_init.F90 b/src/physics/spcam/crm/crmx_task_init.F90 new file mode 100644 index 0000000000..0280dba2f4 --- /dev/null +++ b/src/physics/spcam/crm/crmx_task_init.F90 @@ -0,0 +1,69 @@ +subroutine task_init + +! Check things, initialize multitasking: + +use crmx_grid +implicit none + +integer itasks,ntasks + +if(YES3D .ne. 1 .and. YES3D .ne. 0) then + print*,'YES3D is not 1 or 0. STOP' + stop +endif + +if(YES3D .eq. 1 .and. ny_gl .lt. 4) then + print*,'ny_gl is too small for a 3D case.STOP' + stop +endif + +if(YES3D .eq. 0 .and. ny_gl .ne. 1) then + print*,'ny_gl should be 1 for a 2D case. STOP' + stop +endif + +if(nsubdomains.eq.1) then + + rank =0 + ntasks = 1 + dompi = .false. + +else + +! call task_start(rank, ntasks) + +! dompi = .true. + +! call systemf('hostname') + +! if(ntasks.ne.nsubdomains) then +! if(masterproc) print *,'number of processors is not equal to nsubdomains!',& +! ' ntasks=',ntasks,' nsubdomains=',nsubdomains +! call task_abort() +! endif + +! call task_barrier() + +! call task_ranks() + +end if ! nsubdomains.eq.1 + +#ifndef CRM +do itasks=0,nsubdomains-1 + call task_barrier() + if(itasks.eq.rank) then + open(8,file='./CaseName',status='old',form='formatted') + read(8,'(a)') case + close (8) + endif +end do +#endif /*CRM*/ + +masterproc = rank.eq.0 + +#ifndef CRM +if(masterproc) print *,'number of MPI tasks:',ntasks +#endif /*CRM*/ + + +end diff --git a/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 b/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 new file mode 100644 index 0000000000..b2c9b4e8c9 --- /dev/null +++ b/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 @@ -0,0 +1,230 @@ + + subroutine task_start(rank,numtasks) + integer rank,numtasks + print*, 'MPI call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_abort() + print*,'Aborting the program...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_finish() + print*,'program is finished...' + stop + end + +!---------------------------------------------------------------------- + subroutine task_barrier() + return + end + +!---------------------------------------------------------------------- + + subroutine task_bcast_float(rank_from,buffer,length) + implicit none + integer rank_from ! broadcasting task's rank + real buffer(*) ! buffer of data + integer length ! buffers' length + print*, 'MPIsndf call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_send_float(rank_to,buffer,length,tag,request) + implicit none + integer rank_to ! receiving task's rank + real buffer(*) ! buffer of data + integer length ! buffers' length + integer tag ! tag of the message + integer request ! request id + print*, 'MPIsndf call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_send_integer(rank_to,buffer,length,tag,request) + implicit none + integer rank_to ! receiving task's rank + integer buffer(*) ! buffer of data + integer length ! buffers' length + integer tag ! tag of the message + integer request + print*, 'MPIsndi call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_send_character(rank_to,buffer,length,tag,request) + implicit none + integer rank_to ! receiving task's rank + character*1 buffer(*) ! buffer of data + integer length ! buffers' length + integer tag ! tag of the message + integer request + print*, 'MPIsndi call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_receive_float(buffer,length,request) + real buffer(*) ! buffer of data + integer length ! buffers' length + integer request + print*, 'MPIrcvf call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_receive_charcater(buffer,length,request) + character*1 buffer(*) ! buffer of data + integer length ! buffers' length + integer request + print*, 'MPIrcvi call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_receive_integer(buffer,length,request) + integer buffer(*) ! buffer of data + integer length ! buffers' length + integer request + print*, 'MPIrcvi call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_bsend_float(rank_to,buffer,length,tag) + integer rank_to ! receiving task's rank + real buffer(*) ! buffer of data + integer length ! buffers' length + integer tag ! tag of the message + print*, 'MPI call from a single task program! Exiting...' + stop + return + end + +!---------------------------------------------------------------------- + subroutine task_wait(request,rank,tag) + integer request + integer rank, tag + return + end + +!---------------------------------------------------------------------- + + subroutine task_waitall(count,reqs,ranks,tags) + integer count,reqs(count) + integer ranks(count),tags(count) + return + end + +!---------------------------------------------------------------------- + subroutine task_test(request,flag,rank,tag) + integer request + integer rank, tag + logical flag + print*, 'MPItst call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_sum_real(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end + +!---------------------------------------------------------------------- + + subroutine task_sum_real8(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_sum_integer(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_max_real(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + return + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_max_integer(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_min_real(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_min_integer(buffer1,buffer2,length) + real buffer1(*) ! buffer of data + real buffer2(*) ! buffer of data + integer length ! buffers' length + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + + subroutine task_receive_character(buffer,length,request) + character*1 buffer(*) ! buffer of data + integer length ! buffers' length + integer request + print*, 'MPI call from a single task program! Exiting...' + stop + end +!---------------------------------------------------------------------- + subroutine task_rank_to_index (rank,i,j) + integer rank, i, j + i=0 + j=0 + end +!---------------------------------------------------------------------- + subroutine task_bound_duvdt () + return + end +!---------------------------------------------------------------------- + subroutine task_boundaries(flag) + integer flag + end + + diff --git a/src/physics/spcam/crm/crmx_utils.F90 b/src/physics/spcam/crm/crmx_utils.F90 new file mode 100644 index 0000000000..1a9acaecb0 --- /dev/null +++ b/src/physics/spcam/crm/crmx_utils.F90 @@ -0,0 +1,145 @@ +integer function lenstr (string) + +! returns string's length ignoring the rightmost blank and null characters + +implicit none +character *(*) string +integer k +lenstr = 0 +do k = 1,len(string) + if (string(k:k).ne.' '.and.string(k:k).ne.char(0)) then + lenstr = lenstr+1 + end if +end do +111 return +end + + + +subroutine averageXY(f,dimx1,dimx2,dimy1,dimy2,dimz,fm) + +use crmx_grid +implicit none +integer dimx1, dimx2, dimy1, dimy2, dimz +real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm) +real(kind=selected_real_kind(12)) ff,factor +integer i,j,k +factor = 1./dble(nx*ny) +do k =1,nzm + ff = 0. + do j =1,ny + do i =1,nx + ff = ff + f(i,j,k) + end do + end do + ff = ff*factor + fm(k) = real(ff) +end do +end + + +subroutine averageXY_MPI(f,dimx1,dimx2,dimy1,dimy2,dimz,fm) + +use crmx_grid +implicit none +integer dimx1, dimx2, dimy1, dimy2, dimz +real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm) +real(kind=selected_real_kind(12)) fm1(nzm),fm2(nzm),factor +integer i,j,k +factor = 1./dble(nx*ny) +do k =1,nzm + fm1(k) = 0. + do j =1,ny + do i =1,nx + fm1(k) = fm1(k) + f(i,j,k) + end do + end do + fm1(k) = fm1(k) * factor +end do +if(dompi) then + do k =1,nzm + fm2(k) = fm1(k) + end do + call task_sum_real8(fm2,fm1,nzm) + do k=1,nzm + fm(k)=real(fm1(k)/dble(nsubdomains)) + end do +else + do k=1,nzm + fm(k)=real(fm1(k)) + end do +endif +end + + + + +subroutine fminmax_print(name,f,dimx1,dimx2,dimy1,dimy2,dimz) + +use crmx_grid +implicit none +integer dimx1, dimx2, dimy1, dimy2, dimz +real f(dimx1:dimx2, dimy1:dimy2, dimz),fmn(nz),fmx(nz) +character *(*) name +real fmin(1),fmax(1),fff(1) +integer i,j,k + +do k=1,dimz + if(dimx2.eq.1.and.dimy2.eq.1) then + fmn(k) = f(1,1,k) + fmx(k) = f(1,1,k) + else + fmn(k) = 1.e30 + fmx(k) =-1.e30 + do j=1,ny + do i=1,nx + fmn(k) = min(fmn(k),f(i,j,k)) + fmx(k) = max(fmx(k),f(i,j,k)) + end do + enddo + end if +enddo +fmin(1) = 1.e30 +fmax(1) =-1.e30 +do k=1,dimz + fmin(1) = min(fmin(1),fmn(k)) + fmax(1) = max(fmax(1),fmx(k)) +end do + +if(dompi) then + fff(1)=fmax(1) + call task_max_real(fff(1),fmax(1),1) + fff(1)=fmin(1) + call task_min_real(fff(1),fmin(1),1) +end if +if(masterproc) print *,name,fmin,fmax +end + + + + +subroutine setvalue(f,n,f0) +implicit none +integer n +real f(n), f0 +integer k +do k=1,n + f(k)=f0 +end do +end + +! determine number of byte in a record in direct access files (can be anything, from 1 to 8): +! can't assume 1 as it is compiler and computer dependent +integer function bytes_in_rec() +implicit none +character*8 str +integer n, err +open(1,status ='scratch',access ='direct',recl=1) +do n = 1,8 + write(1,rec=1,iostat=err) str(1:n) + if (err.ne.0) exit + bytes_in_rec = n +enddo +close(1,status='delete') +end + diff --git a/src/physics/spcam/crm/crmx_uvw.F90 b/src/physics/spcam/crm/crmx_uvw.F90 new file mode 100644 index 0000000000..2edaa17e70 --- /dev/null +++ b/src/physics/spcam/crm/crmx_uvw.F90 @@ -0,0 +1,13 @@ +subroutine uvw + +! update the velocity field + +use crmx_vars +use crmx_params +implicit none + +u(1:nx,1:ny,1:nzm) = dudt(1:nx,1:ny,1:nzm,nc) +v(1:nx,1:ny,1:nzm) = dvdt(1:nx,1:ny,1:nzm,nc) +w(1:nx,1:ny,1:nzm) = dwdt(1:nx,1:ny,1:nzm,nc) + +end subroutine uvw diff --git a/src/physics/spcam/crm/crmx_vars.F90 b/src/physics/spcam/crm/crmx_vars.F90 new file mode 100644 index 0000000000..f85feeb1e3 --- /dev/null +++ b/src/physics/spcam/crm/crmx_vars.F90 @@ -0,0 +1,259 @@ +module crmx_vars + +use crmx_grid +#ifdef CRM +#ifdef MODAL_AERO +use modal_aero_data, only: ntot_amode +#endif +#endif + +implicit none +!-------------------------------------------------------------------- +! prognostic variables: + +real u (dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) ! x-wind +real v (dimx1_v:dimx2_v, dimy1_v:dimy2_v, nzm) ! y-wind +real w (dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) ! z-wind +real t (dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! liquid/ice water static energy + +!-------------------------------------------------------------------- +! diagnostic variables: + +real p (0:nx, (1-YES3D):ny, nzm) ! perturbation pressure (from Poison eq) +real tabs (nx, ny, nzm) ! temperature +real qv (nx, ny, nzm) ! water vapor +real qcl (nx, ny, nzm) ! liquid water (condensate) +real qpl (nx, ny, nzm) ! liquid water (precipitation) +real qci (nx, ny, nzm) ! ice water (condensate) +real qpi (nx, ny, nzm) ! ice water (precipitation) + +real tke2(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE +real tk2 (0:nxp1, (1-YES3D):nyp1, nzm) ! SGS eddyviscosity + +!-------------------------------------------------------------------- +! time-tendencies for prognostic variables + +real dudt (nxp1, ny, nzm, 3) +real dvdt (nx, nyp1, nzm, 3) +real dwdt (nx, ny, nz, 3) + +!---------------------------------------------------------------- +! Temporary storage array: + + real misc(nx, ny, nz) +!------------------------------------------------------------------ +! fluxes at the top and bottom of the domain: + +real fluxbu (nx, ny), fluxbv (nx, ny), fluxbt (nx, ny) +real fluxbq (nx, ny), fluxtu (nx, ny), fluxtv (nx, ny) +real fluxtt (nx, ny), fluxtq (nx, ny), fzero (nx, ny) +real precsfc(nx,ny) ! surface precip. rate +real precssfc(nx,ny) ! surface ice precip. rate + +!----------------------------------------------------------------- +! profiles + +real t0(nzm), q0(nzm), qv0(nzm), tabs0(nzm), tl0(nzm), & + tv0(nzm), u0(nzm), v0(nzm), & + tg0(nzm), qg0(nzm), ug0(nzm), vg0(nzm), p0(nzm), & + tke0(nzm), t01(nzm), q01(nzm), qp0(nzm), qn0(nzm) +!---------------------------------------------------------------- +! "observed" (read from snd file) surface characteristics + +real sstobs, lhobs, shobs +!---------------------------------------------------------------- +! Domain top stuff: + +real gamt0 ! gradient of t() at the top,K/m +real gamq0 ! gradient of q() at the top,g/g/m + +!----------------------------------------------------------------- +! reference vertical profiles: + +real prespot(nzm) ! (1000./pres)**R/cp +real rho(nzm) ! air density at pressure levels,kg/m3 +real rhow(nz) ! air density at vertical velocity levels,kg/m3 +real bet(nzm) ! = ggr/tv0 +real gamaz(nzm) ! ggr/cp*z +real wsub(nz) ! Large-scale subsidence velocity,m/s +real qtend(nzm) ! Large-scale tendency for total water +real ttend(nzm) ! Large-scale tendency for temp. +real utend(nzm) ! Large-scale tendency for u +real vtend(nzm) ! Large-scale tendency for v + + +!--------------------------------------------------------------------- +! Large-scale and surface forcing: + +integer nlsf ! number of large-scale forcing profiles +integer nrfc ! number of radiative forcing profiles +integer nsfc ! number of surface forcing profiles +integer nsnd ! number of observed soundings +integer nzlsf ! number of large-scale forcing profiles +integer nzrfc ! number of radiative forcing profiles +integer nzsnd ! number of observed soundings + +real, allocatable :: dqls(:,:) ! Large-scale tendency for total water +real, allocatable :: dtls(:,:) ! Large-scale tendency for temp. +real, allocatable :: ugls(:,:) ! Large-scale wind in X-direction +real, allocatable :: vgls(:,:) ! Large-scale wind in Y-direction +real, allocatable :: wgls(:,:) ! Large-scale subsidence velocity,m/s +real, allocatable :: pres0ls(:)! Surface pressure, mb +real, allocatable :: zls(:,:) ! Height +real, allocatable :: pls(:,:) ! Pressure +real, allocatable :: dayls(:) ! Large-scale forcing arrays time (days) +real, allocatable :: dtrfc(:,:)! Radiative tendency for pot. temp. +real, allocatable :: dayrfc(:) ! Radiative forcing arrays time (days) +real, allocatable :: prfc(:,:) ! Pressure/Height +real, allocatable :: sstsfc(:) ! SSTs +real, allocatable :: shsfc(:) ! Sensible heat flux,W/m2 +real, allocatable :: lhsfc(:) ! Latent heat flux,W/m2 +real, allocatable :: tausfc(:) ! Surface drag,m2/s2 +real, allocatable :: daysfc(:) ! Surface forcing arrays time (days) +real, allocatable :: usnd(:,:) ! Observed zonal wind +real, allocatable :: vsnd(:,:) ! Observed meriod wind +real, allocatable :: tsnd(:,:) ! Observed Abs. temperature +real, allocatable :: qsnd(:,:) ! Observed Moisture +real, allocatable :: zsnd(:,:) ! Height +real, allocatable :: psnd(:,:) ! Pressure +real, allocatable :: daysnd(:) ! number of sounding samples + +!--------------------------------------------------------------------- +! Horizontally varying stuff (as a function of xy) +! +real sstxy(0:nx,(1-YES3D):ny) ! surface temperature xy-distribution +real fcory(0:ny) ! Coriolis parameter xy-distribution +real fcorzy(ny) ! z-Coriolis parameter xy-distribution +real latitude(nx,ny) ! latitude (degrees) +real longitude(nx,ny) ! longitude(degrees) +real prec_xy(nx,ny) ! mean precip. rate for outout +real shf_xy(nx,ny) ! mean precip. rate for outout +real lhf_xy(nx,ny) ! mean precip. rate for outout +real lwns_xy(nx,ny) ! mean net lw at SFC +real swns_xy(nx,ny) ! mean net sw at SFC +real lwnsc_xy(nx,ny) ! clear-sky mean net lw at SFC +real swnsc_xy(nx,ny) ! clear-sky mean net sw at SFC +real lwnt_xy(nx,ny) ! mean net lw at TOA +real swnt_xy(nx,ny) ! mean net sw at TOA +real lwntc_xy(nx,ny) ! clear-sky mean net lw at TOA +real swntc_xy(nx,ny) ! clear-sky mean net sw at TOA +real solin_xy(nx,ny) ! solar TOA insolation +real pw_xy(nx,ny) ! precipitable water +real cw_xy(nx,ny) ! cloud water path +real iw_xy(nx,ny) ! ice water path +real cld_xy(nx,ny) ! cloud frequency +real u200_xy(nx,ny) ! u-wind at 200 mb +real usfc_xy(nx,ny) ! u-wind at at the surface +real v200_xy(nx,ny) ! v-wind at 200 mb +real vsfc_xy(nx,ny) ! v-wind at the surface +real w500_xy(nx,ny) ! w at 500 mb +real qocean_xy(nx,ny) ! ocean cooling in W/m2 + +!---------------------------------------------------------------------- +! Vertical profiles of quantities sampled for statitistics purposes: + +real & + twle(nz), twsb(nz), precflux(nz), & + uwle(nz), uwsb(nz), vwle(nz), vwsb(nz), & + radlwup(nz), radlwdn(nz), radswup(nz), radswdn(nz), & + radqrlw(nz), radqrsw(nz), w_max, u_max, s_acld, s_acldcold, s_ar, s_arthr, s_sst, & + s_acldl, s_acldm, s_acldh, ncmn, nrmn, z_inv, z_cb, z_ct, z_cbmn, z_ctmn, & + z2_inv, z2_cb, z2_ct, cwpmean, cwp2, precmean, prec2, precmax, nrainy, ncloudy, & + s_acldisccp, s_acldlisccp, s_acldmisccp, s_acldhisccp, s_ptopisccp, & + s_acldmodis, s_acldlmodis, s_acldmmodis, s_acldhmodis, s_ptopmodis, & + s_acldmisr, s_ztopmisr, s_relmodis, s_reimodis, s_lwpmodis, s_iwpmodis, & + s_tbisccp, s_tbclrisccp, s_acldliqmodis, s_acldicemodis, & + s_cldtauisccp,s_cldtaumodis,s_cldtaulmodis,s_cldtauimodis,s_cldalbisccp, & + s_flns,s_flnt,s_flntoa,s_flnsc,s_flntoac,s_flds,s_fsns, & + s_fsnt,s_fsntoa,s_fsnsc,s_fsntoac,s_fsds,s_solin, & + tkeleadv(nz), tkelepress(nz), tkelediss(nz), tkelediff(nz),tkelebuoy(nz), & + t2leadv(nz),t2legrad(nz),t2lediff(nz),t2leprec(nz),t2lediss(nz), & + q2leadv(nz),q2legrad(nz),q2lediff(nz),q2leprec(nz),q2lediss(nz), & + twleadv(nz),twlediff(nz),twlepres(nz),twlebuoy(nz),twleprec(nz), & + qwleadv(nz),qwlediff(nz),qwlepres(nz),qwlebuoy(nz),qwleprec(nz), & + momleadv(nz,3),momlepress(nz,3),momlebuoy(nz,3), & + momlediff(nz,3),tadv(nz),tdiff(nz),tlat(nz), tlatqi(nz),qifall(nz),qpfall(nz) +real tdiff_xy(nz), tdiff_z(nz), ttest0(nzm), ttest1(nz), ttest2(nz, 10) !+++mhwang test + + +! register functions: + + +real, external :: esatw_crm,esati_crm,dtesatw_crm,dtesati_crm +real, external :: qsatw_crm,qsati_crm,dtqsatw_crm,dtqsati_crm +integer, external :: lenstr, bytes_in_rec + +! energy conservation diagnostics: + + real(kind=selected_real_kind(12)) total_water_before, total_water_after + real(kind=selected_real_kind(12)) total_water_evap, total_water_prec, total_water_ls +!#ifdef CLUBB_CRM + real(kind=selected_real_kind(12)) total_water_clubb + real(kind=selected_real_kind(12)) total_energy_before, total_energy_after + real(kind=selected_real_kind(12)) total_energy_evap, total_energy_prec, total_energy_ls + real(kind=selected_real_kind(12)) total_energy_clubb, total_energy_rad +!#endif + real(kind=selected_real_kind(12)) qtotmicro(5) ! total water for water conservation test in microphysics +++mhwang + +!=========================================================================== +! UW ADDITIONS + +! conditional average statistics, subsumes cloud_factor, core_factor, coredn_factor +integer :: ncondavg, icondavg_cld, icondavg_cor, icondavg_cordn, & + icondavg_satdn, icondavg_satup, icondavg_env +real, allocatable :: condavg_factor(:,:) ! replaces cloud_factor, core_factor +real, allocatable :: condavg_mask(:,:,:,:) ! indicator array for various conditional averages +character(LEN=8), allocatable :: condavgname(:) ! array of short names +character(LEN=25), allocatable :: condavglongname(:) ! array of long names + +real qlsvadv(nzm) ! Large-scale vertical advection tendency for total water +real tlsvadv(nzm) ! Large-scale vertical advection tendency for temperature +real ulsvadv(nzm) ! Large-scale vertical advection tendency for zonal velocity +real vlsvadv(nzm) ! Large-scale vertical advection tendency for meridional velocity + +real qnudge(nzm) ! Nudging of horiz.-averaged total water profile +real tnudge(nzm) ! Nudging of horiz.-averaged temperature profile +real unudge(nzm) ! Nudging of horiz.-averaged zonal velocity +real vnudge(nzm) ! Nudging of horiz.-averaged meridional velocity + +real qstor(nzm) ! Storage of horiz.-averaged total water profile +real tstor(nzm) ! Storage of horiz.-averaged temperature profile +real ustor(nzm) ! Storage of horiz.-averaged zonal velocity +real vstor(nzm) ! Storage of horiz.-averaged meridional velocity +real qtostor(nzm) ! Storage of horiz.-averaged total water profile (vapor + liquid) + +real utendcor(nzm) ! coriolis acceleration of zonal velocity +real vtendcor(nzm) ! coriolis acceleration of meridional velocity + +real CF3D(1:nx, 1:ny, 1:nzm) ! Cloud fraction + ! =1.0 when there is no fractional cloudiness scheme + ! = cloud fraction produced by fractioal cloudiness scheme when avaiable + +! 850 mbar horizontal winds +real u850_xy(nx,ny) ! zonal velocity at 850 mb +real v850_xy(nx,ny) ! meridional velocity at 850 mb + +! Surface pressure +real psfc_xy(nx,ny) ! pressure (in millibar) at lowest grid point + +! Saturated water vapor path, useful for computing column relative humidity +real swvp_xy(nx,ny) ! saturated water vapor path (wrt water) + +! Cloud and echo top heights, and cloud top temperature (instantaneous) +real cloudtopheight(nx,ny), echotopheight(nx,ny), cloudtoptemp(nx,ny) + +! END UW ADDITIONS +!=========================================================================== +! Initial bubble parameters. Activated when perturb_type = 2 + real bubble_x0 + real bubble_y0 + real bubble_z0 + real bubble_radius_hor + real bubble_radius_ver + real bubble_dtemp + real bubble_dq + real, allocatable :: naer(:,:) ! Aerosol number concentration [/m3] + real, allocatable :: vaer(:,:) ! aerosol volume concentration [m3/m3] + real, allocatable :: hgaer(:,:) ! hygroscopicity of aerosol mode + +end module crmx_vars diff --git a/src/physics/spcam/crm/crmx_zero.F90 b/src/physics/spcam/crm/crmx_zero.F90 new file mode 100644 index 0000000000..a3510da024 --- /dev/null +++ b/src/physics/spcam/crm/crmx_zero.F90 @@ -0,0 +1,16 @@ + +subroutine zero + +use crmx_vars +use crmx_microphysics, only : total_water + +implicit none + +integer k + +dudt(:,:,:,na) = 0. +dvdt(:,:,:,na) = 0. +dwdt(:,:,:,na) = 0. +misc(:,:,:) = 0. + +end diff --git a/src/physics/spcam/crm/fft.F b/src/physics/spcam/crm/fft.F new file mode 100644 index 0000000000..2d02fbd981 --- /dev/null +++ b/src/physics/spcam/crm/fft.F @@ -0,0 +1,787 @@ + subroutine fft991_crm(a,work,trigs,ifax,inc,jump,n,lot,isign) + dimension a(*),work(*),trigs(*),ifax(*) +c +c subroutine "fft991" - multiple real/half-complex periodic +c fast fourier transform +c +c same as fft99 except that ordering of data corresponds to +c that in mrfft2 +c +c procedure used to convert to half-length complex transform +c is given by cooley, lewis and welch (j. sound vib., vol. 12 +c (1970), 315-337) +c +c a is the array containing input and output data +c work is an area of size (n+1)*lot +c trigs is a previously prepared list of trig function values +c ifax is a previously prepared list of factors of n/2 +c inc is the increment within each data 'vector' +c (e.g. inc=1 for consecutively stored data) +c jump is the increment between the start of each data vector +c n is the length of the data vectors +c lot is the number of data vectors +c isign = +1 for transform from spectral to gridpoint +c = -1 for transform from gridpoint to spectral +c +c ordering of coefficients: +c a(0),b(0),a(1),b(1),a(2),b(2),...,a(n/2),b(n/2) +c where b(0)=b(n/2)=0; (n+2) locations required +c +c ordering of data: +c x(0),x(1),x(2),...,x(n-1) +c +c vectorization is achieved on cray by doing the transforms in +c parallel +c +c *** n.b. n is assumed to be an even number +c +c definition of transforms: +c ------------------------- +c +c isign=+1: x(j)=sum(k=0,...,n-1)(c(k)*exp(2*i*j*k*pi/n)) +c where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) +c +c isign=-1: a(k)=(1/n)*sum(j=0,...,n-1)(x(j)*cos(2*j*k*pi/n)) +c b(k)=-(1/n)*sum(j=0,...,n-1)(x(j)*sin(2*j*k*pi/n)) +c +c +c + nfax=ifax(1) + nx=n+1 + nh=n/2 + ink=inc+inc + if (isign.eq.+1) go to 30 +c +c if necessary, transfer data to work area + igo=50 + if (mod(nfax,2).eq.1) goto 40 + ibase=1 + jbase=1 + do 20 l=1,lot + i=ibase + j=jbase +cdir$ ivdep + do 10 m=1,n + work(j)=a(i) + i=i+inc + j=j+1 + 10 continue + ibase=ibase+jump + jbase=jbase+nx + 20 continue +c + igo=60 + go to 40 +c +c preprocessing (isign=+1) +c ------------------------ +c + 30 continue + call fft99a_crm(a,work,trigs,inc,jump,n,lot) + igo=60 +c +c complex transform +c ----------------- +c + 40 continue + ia=1 + la=1 + do 80 k=1,nfax + if (igo.eq.60) go to 60 + 50 continue + call vpassm_crm(a(ia),a(ia+inc),work(1),work(2),trigs, + * ink,2,jump,nx,lot,nh,ifax(k+1),la) + igo=60 + go to 70 + 60 continue + call vpassm_crm(work(1),work(2),a(ia),a(ia+inc),trigs, + * 2,ink,nx,jump,lot,nh,ifax(k+1),la) + igo=50 + 70 continue + la=la*ifax(k+1) + 80 continue +c + if (isign.eq.-1) go to 130 +c +c if necessary, transfer data from work area + if (mod(nfax,2).eq.1) go to 110 + ibase=1 + jbase=1 + do 100 l=1,lot + i=ibase + j=jbase +cdir$ ivdep + do 90 m=1,n + a(j)=work(i) + i=i+1 + j=j+inc + 90 continue + ibase=ibase+nx + jbase=jbase+jump + 100 continue +c +c fill in zeros at end + 110 continue + ib=n*inc+1 +cdir$ ivdep + do 120 l=1,lot + a(ib)=0.0 + a(ib+inc)=0.0 + ib=ib+jump + 120 continue + go to 140 +c +c postprocessing (isign=-1): +c -------------------------- +c + 130 continue + call fft99b_crm(work,a,trigs,inc,jump,n,lot) +c + 140 continue + return + end + + + + + + subroutine fftfax_crm(n,ifax,trigs) + dimension ifax(13),trigs(*) +c +c mode 3 is used for real/half-complex transforms. it is possible +c to do complex/complex transforms with other values of mode, but +c documentation of the details were not available when this routine +c was written. +c + data mode /3/ + call fax_crm (ifax, n, mode) + i = ifax(1) +cgsp if (ifax(i+1) .gt. 5 .or. n .le. 4) ifax(1) = -99 +cgsp if (ifax(1) .le. 0 )call uliber(33,'fftfax -- invalid n', 20) + call fftrig_crm (trigs, n, mode) + return + end + + + + + + subroutine fax_crm(ifax,n,mode) + dimension ifax(*) + nn=n + if (iabs(mode).eq.1) go to 10 + if (iabs(mode).eq.8) go to 10 + nn=n/2 + if ((nn+nn).eq.n) go to 10 + ifax(1)=-99 + return + 10 k=1 +c test for factors of 4 + 20 if (mod(nn,4).ne.0) go to 30 + k=k+1 + ifax(k)=4 + nn=nn/4 + if (nn.eq.1) go to 80 + go to 20 +c test for extra factor of 2 + 30 if (mod(nn,2).ne.0) go to 40 + k=k+1 + ifax(k)=2 + nn=nn/2 + if (nn.eq.1) go to 80 +c test for factors of 3 + 40 if (mod(nn,3).ne.0) go to 50 + k=k+1 + ifax(k)=3 + nn=nn/3 + if (nn.eq.1) go to 80 + go to 40 +c now find remaining factors + 50 l=5 + inc=2 +c inc alternately takes on values 2 and 4 + 60 if (mod(nn,l).ne.0) go to 70 + k=k+1 + ifax(k)=l + nn=nn/l + if (nn.eq.1) go to 80 + go to 60 + 70 l=l+inc + inc=6-inc + go to 60 + 80 ifax(1)=k-1 +c ifax(1) contains number of factors + nfax=ifax(1) +c sort factors into ascending order + if (nfax.eq.1) go to 110 + do 100 ii=2,nfax + istop=nfax+2-ii + do 90 i=2,istop + if (ifax(i+1).ge.ifax(i)) go to 90 + item=ifax(i) + ifax(i)=ifax(i+1) + ifax(i+1)=item + 90 continue + 100 continue + 110 continue + return + end + + + + + + subroutine fftrig_crm(trigs,n,mode) + dimension trigs(*) + pi=2.0*asin(1.0) + imode=iabs(mode) + nn=n + if (imode.gt.1.and.imode.lt.6) nn=n/2 + del=(pi+pi)/float(nn) + l=nn+nn + do 10 i=1,l,2 + angle=0.5*float(i-1)*del + trigs(i)=cos(angle) + trigs(i+1)=sin(angle) + 10 continue + if (imode.eq.1) return + if (imode.eq.8) return + del=0.5*del + nh=(nn+1)/2 + l=nh+nh + la=nn+nn + do 20 i=1,l,2 + angle=0.5*float(i-1)*del + trigs(la+i)=cos(angle) + trigs(la+i+1)=sin(angle) + 20 continue + if (imode.le.3) return + del=0.5*del + la=la+nn + if (mode.eq.5) go to 40 + do 30 i=2,nn + angle=float(i-1)*del + trigs(la+i)=2.0*sin(angle) + 30 continue + return + 40 continue + del=0.5*del + do 50 i=2,n + angle=float(i-1)*del + trigs(la+i)=sin(angle) + 50 continue + return + end + + + + + + + + + + + subroutine fft99a_crm(a,work,trigs,inc,jump,n,lot) + dimension a(*),work(*),trigs(*) +c +c subroutine fft99a - preprocessing step for fft99, isign=+1 +c (spectral to gridpoint transform) +c + nh=n/2 + nx=n+1 + ink=inc+inc +c +c a(0) and a(n/2) + ia=1 + ib=n*inc+1 + ja=1 + jb=2 +cdir$ ivdep + do 10 l=1,lot + work(ja)=a(ia)+a(ib) + work(jb)=a(ia)-a(ib) + ia=ia+jump + ib=ib+jump + ja=ja+nx + jb=jb+nx + 10 continue +c +c remaining wavenumbers + iabase=2*inc+1 + ibbase=(n-2)*inc+1 + jabase=3 + jbbase=n-1 +c + do 30 k=3,nh,2 + ia=iabase + ib=ibbase + ja=jabase + jb=jbbase + c=trigs(n+k) + s=trigs(n+k+1) +cdir$ ivdep + do 20 l=1,lot + work(ja)=(a(ia)+a(ib))- + * (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) + work(jb)=(a(ia)+a(ib))+ + * (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) + work(ja+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))+ + * (a(ia+inc)-a(ib+inc)) + work(jb+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))- + * (a(ia+inc)-a(ib+inc)) + ia=ia+jump + ib=ib+jump + ja=ja+nx + jb=jb+nx + 20 continue + iabase=iabase+ink + ibbase=ibbase-ink + jabase=jabase+2 + jbbase=jbbase-2 + 30 continue +c + if (iabase.ne.ibbase) go to 50 +c wavenumber n/4 (if it exists) + ia=iabase + ja=jabase +cdir$ ivdep + do 40 l=1,lot + work(ja)=2.0*a(ia) + work(ja+1)=-2.0*a(ia+inc) + ia=ia+jump + ja=ja+nx + 40 continue +c + 50 continue + return + end + + + + + + subroutine fft99b_crm(work,a,trigs,inc,jump,n,lot) + dimension work(*),a(*),trigs(*) +c +c subroutine fft99b - postprocessing step for fft99, isign=-1 +c (gridpoint to spectral transform) +c + nh=n/2 + nx=n+1 + ink=inc+inc +c +c a(0) and a(n/2) + scale=1.0/float(n) + ia=1 + ib=2 + ja=1 + jb=n*inc+1 +cdir$ ivdep + do 10 l=1,lot + a(ja)=scale*(work(ia)+work(ib)) + a(jb)=scale*(work(ia)-work(ib)) + a(ja+inc)=0.0 + a(jb+inc)=0.0 + ia=ia+nx + ib=ib+nx + ja=ja+jump + jb=jb+jump + 10 continue +c +c remaining wavenumbers + scale=0.5*scale + iabase=3 + ibbase=n-1 + jabase=2*inc+1 + jbbase=(n-2)*inc+1 +c + do 30 k=3,nh,2 + ia=iabase + ib=ibbase + ja=jabase + jb=jbbase + c=trigs(n+k) + s=trigs(n+k+1) +cdir$ ivdep + do 20 l=1,lot + a(ja)=scale*((work(ia)+work(ib)) + * +(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) + a(jb)=scale*((work(ia)+work(ib)) + * -(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) + a(ja+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1))) + * +(work(ib+1)-work(ia+1))) + a(jb+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1))) + * -(work(ib+1)-work(ia+1))) + ia=ia+nx + ib=ib+nx + ja=ja+jump + jb=jb+jump + 20 continue + iabase=iabase+2 + ibbase=ibbase-2 + jabase=jabase+ink + jbbase=jbbase-ink + 30 continue +c + if (iabase.ne.ibbase) go to 50 +c wavenumber n/4 (if it exists) + ia=iabase + ja=jabase + scale=2.0*scale +cdir$ ivdep + do 40 l=1,lot + a(ja)=scale*work(ia) + a(ja+inc)=-scale*work(ia+1) + ia=ia+nx + ja=ja+jump + 40 continue +c + 50 continue + return + end + + + + subroutine vpassm_crm + & (a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la) + dimension a(*),b(*),c(*),d(*),trigs(*) +c +c subroutine "vpassm" - multiple version of "vpassa" +c performs one pass through data +c as part of multiple complex fft routine +c a is first real input vector +c b is first imaginary input vector +c c is first real output vector +c d is first imaginary output vector +c trigs is precalculated table of sines " cosines +c inc1 is addressing increment for a and b +c inc2 is addressing increment for c and d +c inc3 is addressing increment between a"s & b"s +c inc4 is addressing increment between c"s & d"s +c lot is the number of vectors +c n is length of vectors +c ifac is current factor of n +c la is product of previous factors +c + data sin36/0.587785252292473/,cos36/0.809016994374947/, + * sin72/0.951056516295154/,cos72/0.309016994374947/, + * sin60/0.866025403784437/ +c + m=n/ifac + iink=m*inc1 + jink=la*inc2 + jump=(ifac-1)*jink + ibase=0 + jbase=0 + igo=ifac-1 + if (igo.gt.4) return + go to (10,50,90,130),igo +c +c coding for factor 2 +c + 10 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + do 20 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 15 ijk=1,lot + c(ja+j)=a(ia+i)+a(ib+i) + d(ja+j)=b(ia+i)+b(ib+i) + c(jb+j)=a(ia+i)-a(ib+i) + d(jb+j)=b(ia+i)-b(ib+i) + i=i+inc3 + j=j+inc4 + 15 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 20 continue + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do 40 k=la1,m,la + kb=k+k-2 + c1=trigs(kb+1) + s1=trigs(kb+2) + do 30 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 25 ijk=1,lot + c(ja+j)=a(ia+i)+a(ib+i) + d(ja+j)=b(ia+i)+b(ib+i) + c(jb+j)=c1*(a(ia+i)-a(ib+i))-s1*(b(ia+i)-b(ib+i)) + d(jb+j)=s1*(a(ia+i)-a(ib+i))+c1*(b(ia+i)-b(ib+i)) + i=i+inc3 + j=j+inc4 + 25 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 30 continue + jbase=jbase+jump + 40 continue + return +c +c coding for factor 3 +c + 50 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + do 60 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 55 ijk=1,lot + c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) + c(jb+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i))) + c(jc+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i))) + d(jb+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i))) + d(jc+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i))) + i=i+inc3 + j=j+inc4 + 55 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 60 continue + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do 80 k=la1,m,la + kb=k+k-2 + kc=kb+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + do 70 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 65 ijk=1,lot + c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) + c(jb+j)= + * c1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i)))) + * -s1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) + d(jb+j)= + * s1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i)))) + * +c1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) + c(jc+j)= + * c2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i)))) + * -s2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) + d(jc+j)= + * s2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i)))) + * +c2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) + i=i+inc3 + j=j+inc4 + 65 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 70 continue + jbase=jbase+jump + 80 continue + return +c +c coding for factor 4 +c + 90 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + id=ic+iink + jd=jc+jink + do 100 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 95 ijk=1,lot + c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) + c(jc+j)=(a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i)) + d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) + d(jc+j)=(b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i)) + c(jb+j)=(a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i)) + c(jd+j)=(a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i)) + d(jb+j)=(b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i)) + d(jd+j)=(b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i)) + i=i+inc3 + j=j+inc4 + 95 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 100 continue + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do 120 k=la1,m,la + kb=k+k-2 + kc=kb+kb + kd=kc+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + c3=trigs(kd+1) + s3=trigs(kd+2) + do 110 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 105 ijk=1,lot + c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) + d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) + c(jc+j)= + * c2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) + * -s2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) + d(jc+j)= + * s2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) + * +c2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) + c(jb+j)= + * c1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) + * -s1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) + d(jb+j)= + * s1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) + * +c1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) + c(jd+j)= + * c3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) + * -s3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) + d(jd+j)= + * s3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) + * +c3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) + i=i+inc3 + j=j+inc4 + 105 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 110 continue + jbase=jbase+jump + 120 continue + return +c +c coding for factor 5 +c + 130 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + id=ic+iink + jd=jc+jink + ie=id+iink + je=jd+jink + do 140 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 135 ijk=1,lot + c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) + c(jb+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) + c(je+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) + d(jb+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) + d(je+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) + c(jc+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) + c(jd+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) + d(jc+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) + d(jd+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) + i=i+inc3 + j=j+inc4 + 135 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 140 continue + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do 160 k=la1,m,la + kb=k+k-2 + kc=kb+kb + kd=kc+kb + ke=kd+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + c3=trigs(kd+1) + s3=trigs(kd+2) + c4=trigs(ke+1) + s4=trigs(ke+2) + do 150 l=1,la + i=ibase + j=jbase +cdir$ ivdep + do 145 ijk=1,lot + c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) + c(jb+j)= + * c1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) + * -s1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + d(jb+j)= + * s1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) + * +c1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + c(je+j)= + * c4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) + * -s4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + d(je+j)= + * s4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) + * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) + * +c4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) + * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + c(jc+j)= + * c2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) + * -s2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + d(jc+j)= + * s2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) + * +c2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + c(jd+j)= + * c3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) + * -s3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + d(jd+j)= + * s3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) + * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) + * +c3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) + * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + i=i+inc3 + j=j+inc4 + 145 continue + ibase=ibase+inc1 + jbase=jbase+inc2 + 150 continue + jbase=jbase+jump + 160 continue + return + end + + + + + diff --git a/src/physics/spcam/crm/gammafff.c b/src/physics/spcam/crm/gammafff.c new file mode 100644 index 0000000000..67f30643c4 --- /dev/null +++ b/src/physics/spcam/crm/gammafff.c @@ -0,0 +1,18 @@ +/* + gamma-function for Fortran + (C) Marat Khairoutdinov */ + +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +float gammafff(float *x) {return (float)exp(lgamma(*x));} + +float gammafff_(float *x) {return (float)exp(lgamma(*x));} + +#ifdef __cplusplus +} +#endif diff --git a/src/physics/spcam/crm_physics.F90 b/src/physics/spcam/crm_physics.F90 new file mode 100644 index 0000000000..cad1652235 --- /dev/null +++ b/src/physics/spcam/crm_physics.F90 @@ -0,0 +1,2480 @@ +module crm_physics +!----------------------------------------------------------------------- +! Purpose: +! +! Provides the CAM interface to the crm code. +! +! Revision history: +! June, 2009, Minghuai Wang: +! crm_physics_tend +! July, 2009, Minghuai Wang: m2005_effradius +! +!--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, pverp +#ifdef CRM + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_tend + use constituents, only: cnst_add, cnst_get_ind, cnst_set_spec_class, cnst_spec_class_cldphysics, & + cnst_spec_class_gas, cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst +#ifdef m2005 + use module_ecpp_ppdriver2, only: papampollu_init + use crmx_ecppvars, only: NCLASS_CL,ncls_ecpp_in,NCLASS_PR +#endif + + implicit none + private + save + + character(len=2) :: spcam_direction='NS' ! SPCAM 2D orientation + + public :: crm_physics_tend, crm_physics_register, crm_physics_init + public :: crm_implements_cnst, crm_init_cnst + public :: m2005_effradius + + integer :: crm_u_idx, crm_v_idx, crm_w_idx, crm_t_idx + integer :: crm_qt_idx, crm_nc_idx, crm_qr_idx, crm_nr_idx, crm_qi_idx, crm_ni_idx + integer :: crm_qs_idx, crm_ns_idx, crm_qg_idx, crm_ng_idx, crm_qc_idx, crm_qp_idx, crm_qn_idx + integer :: crm_t_rad_idx, crm_qv_rad_idx, crm_qc_rad_idx, crm_qi_rad_idx, crm_cld_rad_idx + integer :: crm_nc_rad_idx, crm_ni_rad_idx, crm_qs_rad_idx, crm_ns_rad_idx, crm_qrad_idx + integer :: crm_qaerwat_idx, crm_dgnumwet_idx + integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx + integer :: prec_sed_idx, snow_sed_idx, prec_pcw_idx, snow_pcw_idx + integer :: cldo_idx, cld_idx, cldtop_idx + integer :: rei_idx, rel_idx, rprdtot_idx, nevapr_idx, prain_idx + integer :: wsedl_idx, dei_idx, des_idx, mu_idx, lambdac_idx + integer :: rate1_cw2pr_st_idx + integer :: qme_idx, icwmrdp_idx, rprddp_idx, icwmrsh_idx, rprdsh_idx + integer :: nevapr_shcu_idx, nevapr_dpcu_idx, ast_idx + integer :: fice_idx,acldy_cen_idx, cmfmc_sh_idx + integer :: clubb_buffer_idx, tk_crm_idx, tke_idx, kvm_idx, kvh_idx, pblh_idx, tpert_idx + integer :: sh_frac_idx, dp_frac_idx + + integer :: & + ixcldliq, &! cloud liquid amount index + ixcldice, &! cloud ice amount index + ixnumliq, &! cloud liquid number index + ixnumice ! cloud ice water index + + integer :: nmodes + + integer, parameter :: ncnst = 4 ! Number of constituents + integer :: ncnst_use + character(len=8), parameter :: & ! Constituent names + cnst_names(ncnst) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/) + + logical :: use_spcam, prog_modal_aero, do_clubb_sgs + logical :: is_spcam_m2005, is_spcam_sam1mom + + integer :: crm_nx_ny + +#endif + +!======================================================================================================== +contains +!======================================================================================================== + +!--------------------------------------------------------------------------------------------------------- +subroutine crm_physics_register() +#ifdef CRM +!------------------------------------------------------------------------------------------------------- +! +! Purpose: add necessary fileds into physics buffer +! +!-------------------------------------------------------------------------------------------------------- + use spmd_utils, only: masterproc + use physconst, only: mwdry, cpair + use physics_buffer, only: dyn_time_lvls, pbuf_add_field, dtype_r8 + use phys_control, only: phys_getopts, cam_physpkg_is + use crmdims, only: crm_nx, crm_ny, crm_nz, crm_dx, crm_dy, crm_dt, nclubbvars + use cam_history_support,only: add_hist_coord + use crmx_setparm_mod, only: setparm + use rad_constituents, only: rad_cnst_get_info + + is_spcam_m2005 = cam_physpkg_is('spcam_m2005') + is_spcam_sam1mom = cam_physpkg_is('spcam_sam1mom') + + call phys_getopts( use_spcam_out = use_spcam) + call phys_getopts( prog_modal_aero_out = prog_modal_aero) + call phys_getopts( do_clubb_sgs_out = do_clubb_sgs) + + call rad_cnst_get_info(0, nmodes=nmodes) + + ! Register microphysics constituents and save indices. + + ncnst_use = 2 + call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, & + longname='Grid box averaged cloud ice amount', is_convtran1=.true.) + if (is_spcam_m2005) then + call cnst_add(cnst_names(3), mwdry, cpair, 0._r8, ixnumliq, & + longname='Grid box averaged cloud liquid number', is_convtran1=.false.) + call cnst_add(cnst_names(4), mwdry, cpair, 0._r8, ixnumice, & + longname='Grid box averaged cloud ice number', is_convtran1=.false.) + ncnst_use = 4 + end if + + if(masterproc) then + print*,'_________________________________________' + print*,'_ Super-parameterization run ____________' + print*,'crm_nx=',crm_nx,' crm_ny=',crm_ny,' crm_nz=',crm_nz + print*,'crm_dx=',crm_dx,' crm_dy=',crm_dy,' crm_dt=',crm_dt + if (is_spcam_sam1mom) print*,'Microphysics: SAM1MOM' + if (is_spcam_m2005) print*,'Microphysics: M2005' + print*,'_________________________________________' + end if + + if (do_clubb_sgs) then + call pbuf_add_field('CLUBB_BUFFER','global', dtype_r8, (/pcols,crm_nx,crm_ny,crm_nz+1,nclubbvars/), clubb_buffer_idx) + call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) + call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx) + call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) + call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols, pverp/), pblh_idx) + call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols, pverp/), tpert_idx) + end if + + call setparm() + + call pbuf_add_field('CRM_U', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_u_idx) + call pbuf_add_field('CRM_V', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_v_idx) + call pbuf_add_field('CRM_W', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_w_idx) + call pbuf_add_field('CRM_T', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_t_idx) + call pbuf_add_field('CLDO', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), cldo_idx) + call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), cld_idx) + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), ast_idx) + + call pbuf_add_field('CRM_T_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_t_rad_idx) + call pbuf_add_field('CRM_QV_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qv_rad_idx) + call pbuf_add_field('CRM_QC_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qc_rad_idx) + call pbuf_add_field('CRM_QI_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qi_rad_idx) + call pbuf_add_field('CRM_CLD_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_cld_rad_idx) + call pbuf_add_field('CRM_QRAD', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qrad_idx) + + call pbuf_add_field('PREC_DP', 'physpkg', dtype_r8, (/pcols/), prec_dp_idx) + call pbuf_add_field('SNOW_DP', 'physpkg', dtype_r8, (/pcols/), snow_dp_idx) + call pbuf_add_field('PREC_SH', 'physpkg', dtype_r8, (/pcols/), prec_sh_idx) + call pbuf_add_field('SNOW_SH', 'physpkg', dtype_r8, (/pcols/), snow_sh_idx) + call pbuf_add_field('PREC_SED', 'physpkg', dtype_r8, (/pcols/), prec_sed_idx) + call pbuf_add_field('SNOW_SED', 'physpkg', dtype_r8, (/pcols/), snow_sed_idx) + call pbuf_add_field('PREC_PCW', 'physpkg', dtype_r8, (/pcols/), prec_pcw_idx) + call pbuf_add_field('SNOW_PCW', 'physpkg', dtype_r8, (/pcols/), snow_pcw_idx) + call pbuf_add_field('CLDTOP', 'physpkg', dtype_r8, (/pcols,1/), cldtop_idx ) + call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8, (/pcols,pver/), rprdtot_idx ) + call pbuf_add_field('ICWMRSH', 'physpkg' ,dtype_r8, (/pcols,pver/), icwmrsh_idx ) + call pbuf_add_field('RPRDSH', 'physpkg' ,dtype_r8, (/pcols,pver/), rprdsh_idx ) + call pbuf_add_field('NEVAPR_SHCU', 'physpkg' ,dtype_r8, (/pcols,pver/), nevapr_shcu_idx ) + call pbuf_add_field('ICWMRDP', 'physpkg', dtype_r8, (/pcols,pver/), icwmrdp_idx) + call pbuf_add_field('RPRDDP', 'physpkg', dtype_r8, (/pcols,pver/), rprddp_idx) + call pbuf_add_field('NEVAPR_DPCU', 'physpkg', dtype_r8, (/pcols,pver/), nevapr_dpcu_idx) + call pbuf_add_field('REI', 'physpkg', dtype_r8, (/pcols,pver/), rei_idx) + call pbuf_add_field('REL', 'physpkg', dtype_r8, (/pcols,pver/), rel_idx) + call pbuf_add_field('NEVAPR', 'physpkg', dtype_r8, (/pcols,pver/), nevapr_idx) + call pbuf_add_field('PRAIN', 'physpkg', dtype_r8, (/pcols,pver/), prain_idx) + call pbuf_add_field('WSEDL', 'physpkg', dtype_r8, (/pcols,pver/), wsedl_idx) + call pbuf_add_field('QME', 'physpkg', dtype_r8, (/pcols,pver/), qme_idx) + call pbuf_add_field('DEI', 'physpkg', dtype_r8, (/pcols,pver/), dei_idx) + call pbuf_add_field('DES', 'physpkg', dtype_r8, (/pcols,pver/), des_idx) + call pbuf_add_field('MU', 'physpkg', dtype_r8, (/pcols,pver/), mu_idx) + call pbuf_add_field('LAMBDAC', 'physpkg', dtype_r8, (/pcols,pver/), lambdac_idx) + call pbuf_add_field('CMFMC_SH', 'physpkg' ,dtype_r8, (/pcols,pverp/), cmfmc_sh_idx ) + + call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) + + if (prog_modal_aero) then + call pbuf_add_field('RATE1_CW2PR_ST','physpkg', dtype_r8, (/pcols,pver/), rate1_cw2pr_st_idx) + call pbuf_add_field('CRM_QAERWAT', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz, nmodes/), crm_qaerwat_idx) + call pbuf_add_field('CRM_DGNUMWET', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz, nmodes/), crm_dgnumwet_idx) + endif + + if (is_spcam_m2005) then + call pbuf_add_field('CRM_NC_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nc_rad_idx) + call pbuf_add_field('CRM_NI_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ni_rad_idx) + call pbuf_add_field('CRM_QS_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qs_rad_idx) + call pbuf_add_field('CRM_NS_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ns_rad_idx) + + ! Fields for crm_micro array + call pbuf_add_field('CRM_QT', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qt_idx) + call pbuf_add_field('CRM_NC', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nc_idx) + call pbuf_add_field('CRM_QR', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qr_idx) + call pbuf_add_field('CRM_NR', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nr_idx) + call pbuf_add_field('CRM_QI', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qi_idx) + call pbuf_add_field('CRM_NI', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ni_idx) + call pbuf_add_field('CRM_QS', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qs_idx) + call pbuf_add_field('CRM_NS', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ns_idx) + call pbuf_add_field('CRM_QG', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qg_idx) + call pbuf_add_field('CRM_NG', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ng_idx) + call pbuf_add_field('CRM_QC', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qc_idx) + else + call pbuf_add_field('CRM_QT', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qt_idx) + call pbuf_add_field('CRM_QP', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qp_idx) + call pbuf_add_field('CRM_QN', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qn_idx) + endif + + + if (is_spcam_m2005) then + call pbuf_add_field('TK_CRM', 'global', dtype_r8, (/pcols, pver/), tk_crm_idx) + ! total (all sub-classes) cloudy fractional area in previous time step + call pbuf_add_field('ACLDY_CEN', 'global', dtype_r8, (/pcols,pver/), acldy_cen_idx) + endif + +! Adding crm dimensions to cam history + call add_hist_coord('crm_nx' ,crm_nx, 'CRM NX') + call add_hist_coord('crm_ny' ,crm_ny, 'CRM NY') + call add_hist_coord('crm_nz' ,crm_nz, 'CRM NZ') + call add_hist_coord('crm_z1' ,crm_nz+1,'CRM_Z1') + + call add_hist_coord('pverp' ,pverp, 'pverp ') + call add_hist_coord('pver' ,pver, 'pver ') + +! ifdef needed because of NCLASS_CL +#ifdef m2005 + call add_hist_coord('NCLASS_CL' ,NCLASS_CL,'NCLASS_CL') + call add_hist_coord('ncls_ecpp_in' ,ncls_ecpp_in,'ncls_ecpp_in') + call add_hist_coord('NCLASS_PR' ,NCLASS_PR,'NCLASS_PR') +#endif + +#endif + +end subroutine crm_physics_register +!========================================================================================================= + +subroutine crm_physics_init(pbuf2d) +!------------------------------------------------------------------------------------------------------- +! +! Purpose: initialize some variables, and add necessary fileds into output fields +! +!-------------------------------------------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index +#ifdef CRM + use physconst, only: tmelt, cpair, rh2o, latvap, latice + use constituents, only: pcnst, cnst_species_class, cnst_spec_class_gas + use cam_history, only: addfld, add_default, horiz_only + use crmdims, only: crm_nx, crm_ny, crm_nz + use ndrop, only: ndrop_init + use gas_wetdep_opts, only: gas_wetdep_method + use micro_mg_utils, only: micro_mg_utils_init + use time_manager, only: is_first_step + + use cam_history, only: fieldname_len +#ifdef MODAL_AERO + use modal_aero_data, only: cnst_name_cw, ntot_amode, & + lmassptr_amode, lmassptrcw_amode, & + nspec_amode, numptr_amode, numptrcw_amode +#endif + +#endif + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +#ifdef CRM + integer :: l, lphase, lspec + character(len=fieldname_len+3) :: fieldname + character(128) :: long_name + character(8) :: unit + +! local variables + integer :: i, m, mm + integer :: icldphy ! index for cloud physic species (water vapor and cloud hydrometers) + + character(len=128):: errstring ! return status (non-blank for error return) + + crm_nx_ny = crm_nx*crm_ny + + !------------------------- + ! Make sure gas_wetdep_method is set to 'MOZ' as 'NEU' is not currently supported by SPCAM + ! 'MOZ' for spcam_sam1mom + ! 'OFF' for spcam_m2005 + if (is_spcam_sam1mom) then + if (gas_wetdep_method /= 'MOZ') call endrun( "crm_physics: gas_wetdep_method must be set to 'MOZ' ") + elseif (is_spcam_m2005) then + if (gas_wetdep_method /= 'OFF') call endrun( "crm_physics: gas_wetdep_method must be set to 'OFF' ") + else + call endrun( "crm_physics: don't know how gas_wetdep_method should be set") + endif + + !------------------------- + ! Initialize the micro_mg_utils + ! Value of dcs in MG 1.0 is 400.e-6_r8 + call micro_mg_utils_init(r8, rh2o, cpair, tmelt, latvap, latice, 400.e-6_r8, errstring) + + !------------------------- + ! Register general history fields + do m = 1, ncnst_use + call cnst_get_ind(cnst_names(m), mm) + if ( any(mm == (/ ixcldliq, ixcldice /)) ) then + ! mass mixing ratios + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg ', cnst_longname(mm)) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s ', trim(cnst_name(mm))//' surface flux') + else if ( any(mm == (/ ixnumliq, ixnumice /)) ) then + ! number concentrations + call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg ', cnst_longname(mm)) + call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s ', trim(cnst_name(mm))//' surface flux') + else + call endrun( "crm_physics: Could not call addfld for constituent with unknown units.") + endif + end do + + do m=1, pcnst + if(cnst_name(m) == 'DMS') then + call addfld('DMSCONV', (/ 'lev' /), 'A', 'kg/kg/s', 'DMS tendency from ZM convection') + end if + if(cnst_name(m) == 'SO2') then + call addfld('SO2CONV', (/ 'lev' /), 'A', 'kg/kg/s', 'SO2 tendency from ZM convection') + end if + end do + + call addfld ('CRM_TK', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from CRM') + call addfld ('CRM_TKH', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from CRM') + + call addfld ('SPCLD3D ', (/ 'lev' /), 'A', 'fraction', 'cloud fraction on GCM grids') + call addfld ('MU_CRM ', (/ 'lev' /), 'A', 'Pa/s', 'mass flux up from CRM') + call addfld ('MD_CRM ', (/ 'lev' /), 'A', 'Pa/s', 'mass flux down from CRM') + call addfld ('DU_CRM ', (/ 'lev' /), 'A', '/s', 'detrainment from updraft from CRM') + call addfld ('EU_CRM ', (/ 'lev' /), 'A', '/s', 'entraiment rate from updraft') + call addfld ('ED_CRM ', (/ 'lev' /), 'A', '/s', 'entraiment rate from downdraft') + call addfld ('SPQRL ', (/ 'lev' /), 'A', 'K/s', 'long-wave heating rate') + call addfld ('SPQRS ', (/ 'lev' /), 'A', 'K/s', 'short-wave heating rate') + call addfld ('LENGC ', (/ 'ilev' /), 'A', 'm ', 'Mixing length scale for the calcuation of vertical difusivity') + + call addfld ('SPKVH ',(/ 'ilev' /), 'A', 'm2/s ', 'Vertical diffusivity used in dropmixnuc in the MMF call') + call addfld ('SPLCLOUD ',(/ 'lev' /), 'A', ' ', 'Liquid cloud fraction') + call add_default ('SPKVH ', 1, ' ') + call add_default ('SPLCLOUD ', 1, ' ') + + call addfld ('SPCLDTOT', horiz_only, 'A', 'fraction', 'Vertically-integrated total cloud from CRM' ) + call addfld ('SPCLDLOW', horiz_only, 'A', 'fraction', 'Vertically-integrated low cloud from CRM' ) + call addfld ('SPCLDMED', horiz_only, 'A', 'fraction', 'Vertically-integrated mid-level cloud from CRM' ) + call addfld ('SPCLDHGH', horiz_only, 'A', 'fraction', 'Vertically-integrated high cloud from CRM' ) + call add_default ('SPCLDTOT', 1, ' ') + call add_default ('SPCLDLOW', 1, ' ') + call add_default ('SPCLDMED', 1, ' ') + call add_default ('SPCLDHGH', 1, ' ') + + call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldliq))//' after physics' ) + call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldliq))//' before physics' ) + call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldice))//' after physics' ) + call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldice))//' before physics' ) + + call addfld ('PRES ',(/ 'lev' /), 'A', 'Pa ','Pressure' ) + call addfld ('DPRES ',(/ 'lev' /), 'A', 'Pa ','Pressure thickness of layer' ) + call addfld ('SPDT ',(/ 'lev' /), 'A', 'K/s ','T tendency due to CRM' ) + call addfld ('SPDQ ',(/ 'lev' /), 'A', 'kg/kg/s ','Q tendency due to CRM' ) + call addfld ('SPDQC ',(/ 'lev' /), 'A', 'kg/kg/s ','QC tendency due to CRM' ) + call addfld ('SPDQI ',(/ 'lev' /), 'A', 'kg/kg/s ','QI tendency due to CRM' ) + call addfld ('SPMC ',(/ 'lev' /), 'A', 'kg/m2/s ','Total mass flux from CRM' ) + call addfld ('SPMCUP ',(/ 'lev' /), 'A', 'kg/m2/s ','Updraft mass flux from CRM' ) + call addfld ('SPMCDN ',(/ 'lev' /), 'A', 'kg/m2/s ','Downdraft mass flux from CRM' ) + call addfld ('SPMCUUP ',(/ 'lev' /), 'A', 'kg/m2/s ','Unsaturated updraft mass flux from CRM' ) + call addfld ('SPMCUDN ',(/ 'lev' /), 'A', 'kg/m2/s ','Unsaturated downdraft mass flux from CRM') + call addfld ('SPQC ',(/ 'lev' /), 'A', 'kg/kg ','Cloud water from CRM' ) + call addfld ('SPQI ',(/ 'lev' /), 'A', 'kg/kg ','Cloud ice from CRM' ) + call addfld ('SPQS ',(/ 'lev' /), 'A', 'kg/kg ','Snow from CRM' ) + call addfld ('SPQG ',(/ 'lev' /), 'A', 'kg/kg ','Graupel from CRM' ) + call addfld ('SPQR ',(/ 'lev' /), 'A', 'kg/kg ','Rain from CRM' ) + call addfld ('SPQTFLX ',(/ 'lev' /), 'A', 'kg/m2/s ','Nonprecip. water flux from CRM' ) + call addfld ('SPUFLX ',(/ 'lev' /), 'A', 'm2/s2 ','x-momentum flux from CRM' ) + call addfld ('SPVFLX ',(/ 'lev' /), 'A', 'm2/s2 ','y-momentum flux from CRM' ) + call addfld ('SPQTFLXS',(/ 'lev' /), 'A', 'kg/m2/s ','SGS Nonprecip. water flux from CRM' ) + call addfld ('SPTKE ',(/ 'lev' /), 'A', 'kg/m/s2 ','Total TKE in CRM' ) + call addfld ('SPTKES ',(/ 'lev' /), 'A', 'kg/m/s2 ','SGS TKE in CRM' ) + call addfld ('SPTK ',(/ 'lev' /), 'A', 'm2/s ','SGS TK in CRM' ) + call addfld ('SPQPFLX ',(/ 'lev' /), 'A', 'kg/m2/s ','Precip. water flux from CRM' ) + call addfld ('SPPFLX ',(/ 'lev' /), 'A', 'm/s ','Precipitation flux from CRM' ) + call addfld ('SPQTLS ',(/ 'lev' /), 'A', 'kg/kg/s ','L.S. Vapor Tendency from CRM' ) + call addfld ('SPQTTR ',(/ 'lev' /), 'A', 'kg/kg/s ','Nonprec. water transport from CRM' ) + call addfld ('SPQPTR ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water transport from CRM' ) + call addfld ('SPQPEVP ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water evaporation from CRM' ) + call addfld ('SPQPFALL',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water fall-out from CRM' ) + call addfld ('SPQPSRC ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water source from CRM' ) + call addfld ('SPTLS ',(/ 'lev' /), 'A', 'kg/kg/s ','L.S. LIWSE Tendency from CRM' ) + call addfld ('TIMINGF ', horiz_only, 'A', ' ','CRM CPU usage efficiency: 1 - ideal' ) + call addfld ('CLOUDTOP',(/ 'lev' /), 'A', ' ','Cloud Top PDF' ) + + !------------------------- + ! Register m2005 history fields + if (is_spcam_m2005) then + call addfld ('SPNC ',(/ 'lev' /), 'A', '/kg ','Cloud water dropet number from CRM') + call addfld ('SPNI ',(/ 'lev' /), 'A', '/kg ','Cloud ice crystal number from CRM') + call addfld ('SPNS ',(/ 'lev' /), 'A', '/kg ','Snow particle number from CRM') + call addfld ('SPNG ',(/ 'lev' /), 'A', '/kg ','Graupel particle number from CRM') + call addfld ('SPNR ',(/ 'lev' /), 'A', '/kg ','Rain particle number from CRM') + call add_default ('SPNC ', 1, ' ') + call add_default ('SPNI ', 1, ' ') + call add_default ('SPNS ', 1, ' ') + call add_default ('SPNG ', 1, ' ') + call add_default ('SPNR ', 1, ' ') + + call addfld ('CRM_FLIQ ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Liquid' ) + call addfld ('CRM_FICE ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Ice' ) + call addfld ('CRM_FRAIN',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Rain' ) + call addfld ('CRM_FSNOW',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Snow' ) + call addfld ('CRM_FGRAP',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Graupel' ) + call addfld ('CRM_QS ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Snow mixing ratio from CRM' ) + call addfld ('CRM_QG ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Graupel mixing ratio from CRM' ) + call addfld ('CRM_QR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Rain mixing ratio from CRM' ) + + call addfld ('CRM_NC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Cloud water dropet number from CRM' ) + call addfld ('CRM_NI ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Cloud ice crystal number from CRM' ) + call addfld ('CRM_NS ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Snow particle number from CRM' ) + call addfld ('CRM_NG ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Graupel particle number from CRM' ) + call addfld ('CRM_NR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Rain particle number from CRM' ) + + ! below is for *instantaneous* crm output + call addfld ('CRM_AUT ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Autoconversion cloud waterfrom CRM' ) + call addfld ('CRM_ACC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Accretion cloud water from CRM' ) + call addfld ('CRM_EVPC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Evaporation cloud water from CRM' ) + call addfld ('CRM_EVPR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Evaporation rain from CRM' ) + call addfld ('CRM_MLT ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Melting ice snow graupel from CRM' ) + call addfld ('CRM_SUB ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Sublimation ice snow graupel from CRM' ) + call addfld ('CRM_DEP ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Deposition ice snow graupel from CRM' ) + call addfld ('CRM_CON ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Condensation cloud water from CRM' ) + + ! below is for *gcm-grid and time-step-avg* process output + call addfld ('A_AUT ',(/ 'lev' /), 'A', '/s ','Avg autoconversion cloud water from CRM' ) + call addfld ('A_ACC ',(/ 'lev' /), 'A', '/s ','Avg accretion cloud water from CRM' ) + call addfld ('A_EVPC ',(/ 'lev' /), 'A', '/s ','Avg evaporation cloud water from CRM' ) + call addfld ('A_EVPR ',(/ 'lev' /), 'A', '/s ','Avg evaporation rain from CRM' ) + call addfld ('A_MLT ',(/ 'lev' /), 'A', '/s ','Avg melting ice snow graupel from CRM' ) + call addfld ('A_SUB ',(/ 'lev' /), 'A', '/s ','Avg sublimation ice snow graupel from CRM' ) + call addfld ('A_DEP ',(/ 'lev' /), 'A', '/s ','Avg deposition ice snow graupel from CRM' ) + call addfld ('A_CON ',(/ 'lev' /), 'A', '/s ','Avg condensation cloud water from CRM' ) + + call addfld ('CRM_REL ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale droplet effective radius') + call addfld ('CRM_REI ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale ice crystal effective radius') + call addfld ('CRM_DEI ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale Mitchell ice effective diameter') + call addfld ('CRM_DES ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale snow effective diameter') + call addfld ('CRM_MU ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', & + 'cloud scale droplet size distribution shape parameter for radiation') + call addfld ('CRM_LAMBDA',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', & + 'cloud scale slope of droplet distribution for radiation') + call addfld ('CRM_TAU ', (/'crm_nx','crm_ny','crm_nz'/), 'A', '1', 'cloud scale cloud optical depth' ) + call addfld ('CRM_WVAR' , (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm/s', 'vertical velocity variance from CRM') + + call addfld ('CRM_FSNT', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA shortwave fluxes at CRM grids') + call addfld ('CRM_FSNTC', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA clear-sky shortwave fluxes at CRM grids') + call addfld ('CRM_FSNS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net surface shortwave fluxes at CRM grids') + call addfld ('CRM_FSNSC', (/'crm_nx','crm_ny'/), 'A', 'unitless', & + 'net surface clear-sky shortwave fluxes at CRM grids') + call addfld ('CRM_FLNT', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA longwave fluxes at CRM grids') + call addfld ('CRM_FLNTC', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA clear-sky longwave fluxes at CRM grids') + call addfld ('CRM_FLNS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net surface longwave fluxes at CRM grids') + call addfld ('CRM_FLNSC', (/'crm_nx','crm_ny'/), 'A', 'unitless', & + 'net surface clear-sky longwave fluxes at CRM grids') + + call addfld ('CRM_AODVIS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 550nm in CRM grids',& + flag_xyfill=.true.) + call addfld ('CRM_AOD400', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 400nm in CRM grids',& + flag_xyfill=.true.) + call addfld ('CRM_AOD700', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 700nm in CRM grids', & + flag_xyfill=.true.) + call addfld ('CRM_AODVISZ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'unitless', & + 'Aerosol optical depth at each layer at 500nm in CRM grids', flag_xyfill=.true.) + call addfld ('AOD400', horiz_only, 'A', 'unitless', 'Aerosol optical depth at 400nm', & + flag_xyfill=.true.) + call addfld ('AOD700', horiz_only, 'A', 'unitless', 'Aerosol optical depth at 700nm', & + flag_xyfill=.true.) + call add_default ('AOD400', 1, ' ') + call add_default ('AOD700', 1, ' ') + endif + + !------------------------- + ! Register CLUBB history fields + if (do_clubb_sgs) then + call addfld ('UP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'u prime ^2 from clubb') + call addfld ('VP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'v prime ^2 from clubb') + call addfld ('WPRTP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'mkg/skg', 'w prime * rt prime from clubb') + call addfld ('WPTHLP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'mK/s', 'w prime * th_l prime from clubb') + call addfld ('WP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'w prime ^2 from clubb') + call addfld ('WP3 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^3/s^3', 'w prime ^3 from clubb') + call addfld ('RTP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', '(kg/kg)2', 'r_t prime ^2 from clubb') + call addfld ('THLP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'K^2', 'th_l_prime ^2 from clubb') + call addfld ('RTPTHLP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kgK/kg', 'r_t prime * th_l prime from clubb') + call addfld ('UPWP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'u prime * w prime from clubb') + call addfld ('VPWP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'v prime * w prime from clubb') + call addfld ('CRM_CLD ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'fraction', 'cloud fraction from clubb') + call addfld ('T_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'K/s', 't tendency from clubb') + call addfld ('QV_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kg/kg/s', 'water vapor tendency from clubb') + call addfld ('QC_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kg/kg/s', 'liquid condensate tendency from clubb') + call addfld ('CLUBB_TK', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from clubb') + call addfld ('CLUBB_TKH', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from clubb') + call addfld ('CRM_RELVAR', (/'crm_nx','crm_ny','crm_nz'/), 'A', '', 'cloud water relative variance from clubb') + call addfld ('ACCRE_ENHAN', (/'crm_nx','crm_ny','crm_nz'/), 'A', '', 'Accretion enhancment from clubb') + call addfld ('QCLVAR', (/'crm_nx','crm_ny','crm_nz'/), 'A', '(kg/kg)^2', 'cloud water variance from clubb') + ! add GCM-scale output + call addfld ('SPUP2', (/ 'lev' /), 'A', 'm^2/s^2', 'u prime ^2 from clubb on GCM grids') + call addfld ('SPVP2', (/ 'lev' /), 'A', 'm^2/s^2', 'v prime ^2 from clubb on GCM grids') + call addfld ('SPWPRTP', (/ 'lev' /), 'A', 'mkg/skg', 'w prime * rt prime from clubb on GCM grids') + call addfld ('SPWPTHLP', (/ 'lev' /), 'A', 'mK/s', 'w prime * th_l prime from clubb on GCM grids') + call addfld ('SPWP2', (/ 'lev' /), 'A', 'm^2/s^2', 'w prime ^2 from clubb on GCM grids') + call addfld ('SPWP3', (/ 'lev' /), 'A', 'm^3/s^3', 'w prime ^3 from clubb on GCM grids') + call addfld ('SPRTP2', (/ 'lev' /), 'A', '(kg/kg)2', 'r_t prime ^2 from clubb on GCM grids') + call addfld ('SPTHLP2', (/ 'lev' /), 'A', 'K^2', 'th_l_prime ^2 from clubb on GCM grids') + call addfld ('SPRTPTHLP', (/ 'lev' /), 'A', 'kgK/kg', 'r_t prime * th_l prime from clubb on GCM grids') + call addfld ('SPUPWP', (/ 'lev' /), 'A', 'm^2/s^2', 'u prime * w prime from clubb on GCM grids') + call addfld ('SPVPWP', (/ 'lev' /), 'A', 'm^2/s^2', 'v prime * w prime from clubb on GCM grids') + call addfld ('SPCRM_CLD ', (/ 'lev' /), 'A', 'fraction', 'cloud fraction from clubb on GCM grids') + call addfld ('SPT_TNDCY ', (/ 'lev' /), 'A', 'K/s', 't tendency from clubb on GCM grids') + call addfld ('SPQV_TNDCY ', (/ 'lev' /), 'A', 'kg/kg/s', 'water vapor tendency from clubb on GCM grids') + call addfld ('SPQC_TNDCY ', (/ 'lev' /), 'A', 'kg/kg/s', 'liquid condensate tendency from clubb on GCM grids') + call addfld ('SPCLUBB_TK', (/ 'lev' /), 'A', 'm^2/s', 'Eddy viscosity from clubb on GCM grids') + call addfld ('SPCLUBB_TKH', (/ 'lev' /), 'A', 'm^2/s', 'Eddy viscosity from clubb on GCM grids') + call addfld ('SPRELVAR', (/ 'lev' /), 'A', '', 'cloud water relative variance from clubb on GCM grids') + call addfld ('SPACCRE_ENHAN',(/ 'lev' /), 'A', '', 'Accretion enhancment from clubb on GCM grids') + call addfld ('SPQCLVAR', (/ 'lev' /), 'A', '', 'cloud water variance from clubb on GCM grids') + endif + + + !------------------------- + ! Register ECPP history fields + ! ifdef needed because of ECPP parameters such as NCLASS_CL and ncls_ecpp_in and papampollu_init +#ifdef m2005 + if (is_spcam_m2005) then + + call papampollu_init () + + call addfld ('ABND ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & + 'cloud fraction for each sub-sub class for full time period at layer boundary') + call addfld ('ABND_TF ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & + 'cloud fraction for each sub-sub class for end-portion of time period at layer boundary') + call addfld ('MASFBND ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & + 'sub-class vertical mass flux (kg/m2/s) at layer boundary') + call addfld ('ACEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & + 'cloud fraction for each sub-sub class for full time period at layer center') + call addfld ('ACEN_TF ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & + 'cloud fraction for each sub-sub class for end-portion of time period at layer center') + call addfld ('RHCEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & + 'relative humidity for each sub-sub calss at layer center') + call addfld ('QCCEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg', & + 'cloud water for each sub-sub class at layer center') + call addfld ('QICEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg', & + 'cloud ice for each sub-sub class at layer center') + call addfld ('QSINK_AFCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & + 'cloud water loss rate from precip. using cloud water after precip. for each sub-sub class at layer center') + call addfld ('QSINK_BFCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & + 'cloud water loss rate from precip. using cloud water before precip. for each sub-sub class at layer center') + call addfld ('QSINK_AVGCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & + 'cloud water loss rate from precip. using averaged cloud water and precip. rate for each sub-sub class at layer center') + call addfld ('PRAINCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg/s', & + ' cloud water loss rate from precipitation (kg/kg/s) for each sub-sub class at layer center') + call addfld ('PRECRCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & + 'liquid (rain) precipitation rate for each sub-sub class at layer center') + call addfld ('PRECSCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & + 'solid (snow, graupel,...) precipitation rate for each sub-sub class at layer center') + call addfld ('WUPTHRES', (/ 'ilev' /), 'A', 'm/s', 'vertical velocity threshold for updraft') + call addfld ('WDNTHRES', (/ 'ilev' /), 'A', 'm/s', 'vertical velocity threshold for dndraft') + call addfld ('WWQUI_CEN', (/ 'lev' /), 'A', 'm2/s2', 'vertical velocity variance in the quiescent class, layer center') + call addfld ('WWQUI_CLD_CEN', (/ 'lev' /), 'A', 'm2/s2', & + 'vertical velocity variance in the cloudy quiescent class, layer center') + call addfld ('WWQUI_BND', (/ 'ilev' /), 'A', 'm2/s2', & + 'vertical velocity variance in the quiescent class, layer boundary') + call addfld ('WWQUI_CLD_BND', (/ 'ilev' /), 'A', 'm2/s2', & + 'vertical velocity variance in the cloudy quiescent class, layer boundary') + endif +#endif + + !------------------------- + ! Register modal aerosol history fields + ! ifdef needed because of use of cnst_name_cw which not defined if not modal aerosols +#ifdef MODAL_AERO + if (prog_modal_aero) then + + call ndrop_init() + + do m=1, pcnst + if(cnst_species_class(m).eq.cnst_spec_class_gas) then + fieldname = trim(cnst_name(m)) // '_mixnuc1sp' + long_name = trim(cnst_name(m)) // ' dropmixnuc mixnuc column tendency in the mmf one ' + call addfld( fieldname, horiz_only, 'A', unit, long_name) + call add_default( fieldname, 1, ' ' ) + end if + end do + + endif + +#endif + + ! These variables do not vary in CRM + call pbuf_set_field (pbuf2d, prec_dp_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, prec_sh_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, snow_sh_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, snow_dp_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, prec_sed_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, snow_sed_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, prec_pcw_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, snow_pcw_idx, 0.0_r8) + + + call addfld ('CRM_U ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM x-wind' ) + call addfld ('CRM_V ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM y-wind' ) + call addfld ('CRM_W ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM z-wind' ) + call addfld ('CRM_T ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K ', 'CRM Temperature' ) + call addfld ('CRM_QV ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Water Vapor' ) + call addfld ('CRM_QC ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Cloud Water' ) + call addfld ('CRM_QI ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Cloud Ice' ) + call addfld ('CRM_QPC ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Precipitating Water' ) + call addfld ('CRM_QPI ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Precipitating Ice' ) + call addfld ('CRM_PREC',(/'crm_nx','crm_ny'/), 'I', 'm/s ', 'CRM Precipitation Rate' ) + call addfld ('CRM_QRS ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K/s ', 'CRM Shortwave radiative heating rate') + call addfld ('CRM_QRL ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K/s ', 'CRM Longwave radiative heating rate' ) + + call add_default ('SPDT ', 1, ' ') + call add_default ('SPDQ ', 1, ' ') + call add_default ('SPDQC ', 1, ' ') + call add_default ('SPDQI ', 1, ' ') + call add_default ('SPMC ', 1, ' ') + call add_default ('SPMCUP ', 1, ' ') + call add_default ('SPMCDN ', 1, ' ') + call add_default ('SPMCUUP ', 1, ' ') + call add_default ('SPMCUDN ', 1, ' ') + call add_default ('SPQC ', 1, ' ') + call add_default ('SPQI ', 1, ' ') + call add_default ('SPQS ', 1, ' ') + call add_default ('SPQG ', 1, ' ') + call add_default ('SPQR ', 1, ' ') + call add_default ('SPQTFLX ', 1, ' ') + call add_default ('SPQTFLXS', 1, ' ') + call add_default ('SPTKE ', 1, ' ') + call add_default ('SPTKES ', 1, ' ') + call add_default ('SPTK ', 1, ' ') + call add_default ('SPQPFLX ', 1, ' ') + call add_default ('SPPFLX ', 1, ' ') + call add_default ('SPQTLS ', 1, ' ') + call add_default ('SPQTTR ', 1, ' ') + call add_default ('SPQPTR ', 1, ' ') + call add_default ('SPQPEVP ', 1, ' ') + call add_default ('SPQPFALL', 1, ' ') + call add_default ('SPQPSRC ', 1, ' ') + call add_default ('SPTLS ', 1, ' ') + call add_default ('CLOUDTOP', 1, ' ') + call add_default ('TIMINGF ', 1, ' ') + + sh_frac_idx = pbuf_get_index('SH_FRAC') + dp_frac_idx = pbuf_get_index('DP_FRAC') + call pbuf_set_field (pbuf2d, sh_frac_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, dp_frac_idx, 0.0_r8) + + call pbuf_set_field (pbuf2d, cmfmc_sh_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, rprdsh_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, icwmrsh_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, nevapr_shcu_idx, 0.0_r8) + + call pbuf_set_field (pbuf2d, icwmrdp_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, fice_idx, 0.0_r8) + + call pbuf_set_field (pbuf2d, prain_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, rprdtot_idx, 0.0_r8) + call pbuf_set_field (pbuf2d, nevapr_idx, 0.0_r8) + + if (is_first_step()) then + call pbuf_set_field (pbuf2d, ast_idx, 0.0_r8) + end if +#endif +end subroutine crm_physics_init + +!========================================================================================================= + +function crm_implements_cnst(name) + + ! Return true if specified constituent is implemented by the + ! microphysics package + + character(len=*), intent(in) :: name ! constituent name + logical :: crm_implements_cnst ! return value + +#ifdef CRM + !----------------------------------------------------------------------- + + crm_implements_cnst = any(name == cnst_names) + +#endif +end function crm_implements_cnst + +!=============================================================================== + +subroutine crm_init_cnst(name, q) + + ! Initialize the microphysics constituents, if they are + ! not read from the initial file. + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(out) :: q(:,:) ! mass mixing ratio (gcol, plev) + !----------------------------------------------------------------------- + +#ifdef CRM + if (crm_implements_cnst(name)) q = 0.0_r8 +#endif + +end subroutine crm_init_cnst + +!=============================================================================== + +!--------------------------------------------------------------------------------------------------------- + subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf, cam_in) + +!------------------------------------------------------------------------------------------ +! Purpose: to update state from CRM physics. +! +! Revision history: +! +! June, 2009, Minghuai Wang: +! These codes are taken out from tphysbc.F90 +! in the spcam3.5, developed by Marat Khairoutdinov +! (mkhairoutdin@ms.cc.sunysb.edu). Here we try to follow the procedure +! in 'Interface to Column Physics and Chemistry packages' to implement +! the CRM physics. +! July, 13, 2009, Minghuai Wang: +! Hydrometer numbers are outputed from SAM when Morrison's microphysics is used, +! and will be used in the radiative transfer code to calculate radius. +! July, 15, 2009, Minghuai Wang: +! Get modal aerosol, and use it in the SAM. +! +!------------------------------------------------------------------------------------------- +#ifdef CRM + use shr_spfn_mod, only: gamma => shr_spfn_gamma + use time_manager, only: is_first_step, get_nstep + use cam_history, only: outfld + use perf_mod + use crmdims, only: crm_nx, crm_ny, crm_nz + use physconst, only: cpair, latvap, gravit + use constituents, only: pcnst, cnst_get_ind + use crmx_crm_module, only: crm + use crmx_microphysics, only: nmicro_fields + use physconst, only: latvap + use check_energy, only: check_energy_chng + use phys_grid, only: get_rlat_all_p, get_rlon_all_p, get_lon_all_p, get_lat_all_p + use modal_aero_calcsize, only: modal_aero_calcsize_sub + use micro_mg_utils, only: size_dist_param_liq, mg_liq_props, mincld, qsmall + +#ifdef MODAL_AERO + use crmclouds_camaerosols, only: crmclouds_mixnuc_tend, spcam_modal_aero_wateruptake_dr + use ndrop, only: loadaer +#endif +#ifdef m2005 + use module_ecpp_ppdriver2, only: parampollu_driver2 + use crmx_ecppvars, only: NCLASS_CL, ncls_ecpp_in, NCLASS_PR + use module_data_ecpp1, only: dtstep_pp_input +#endif +#ifdef SPCAM_CLUBB_SGS + use cloud_cover_diags, only: cloud_cover_diags_out + use pkg_cldoptics, only: cldovrlap +#endif + +#endif + + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, dyn_time_lvls, pbuf_get_field + use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, physics_ptend_init, & + physics_state_copy, physics_ptend_sum, physics_ptend_scale + use camsrfexch, only: cam_in_t + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(physics_ptend ), intent(out) :: ptend + type(physics_buffer_desc),pointer :: pbuf(:) + type (cam_in_t), intent(in) :: cam_in + +#ifdef CRM + + type(physics_state) :: state_loc ! local copy of state + type(physics_tend) :: tend_loc ! local copy of tend + type(physics_ptend) :: ptend_loc ! local copy of ptend + + ! convective precipitation variables + real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection [m/s] + real(r8), pointer :: snow_dp(:) ! snow from ZM convection [m/s] + + real(r8), pointer :: nc_rad(:,:,:,:) ! rad cloud water droplet number [#/kg] + real(r8), pointer :: ni_rad(:,:,:,:) ! rad cloud ice crystal number [#/kg] + real(r8), pointer :: qs_rad(:,:,:,:) ! rad cloud snow mass [kg/kg] + real(r8), pointer :: ns_rad(:,:,:,:) ! rad cloud snow crystal number [#/kg] + real(r8), pointer :: cld_rad(:,:,:,:) ! cloud fraction + + real(r8), pointer :: t_rad (:,:,:,:) ! rad temperuture + real(r8), pointer :: qv_rad(:,:,:,:) ! rad vapor + real(r8), pointer :: qc_rad(:,:,:,:) ! rad cloud water + real(r8), pointer :: qi_rad(:,:,:,:) ! rad cloud ice + real(r8), pointer :: crm_qrad(:,:,:,:) + real(r8), pointer :: clubb_buffer (:,:,:,:,:) + + real(r8),pointer :: cldtop_pbuf(:) ! cloudtop location for pbuf + + real(r8),pointer :: tk_crm_ecpp(:,:) + real(r8),pointer :: acldy_cen_tbeg(:,:) ! cloud fraction + real(r8), pointer, dimension(:,:) :: cldo + +! +!--------------------------- Local variables ----------------------------------------------------------- +! + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + + integer nstep ! time steps + + real(r8) qc_crm (pcols,crm_nx, crm_ny, crm_nz) + real(r8) qi_crm (pcols,crm_nx, crm_ny, crm_nz) + real(r8) qpc_crm(pcols,crm_nx, crm_ny, crm_nz) + real(r8) qpi_crm(pcols,crm_nx, crm_ny, crm_nz) + + real(r8),allocatable :: crm_cld(:,:,:,:) + real(r8),allocatable :: clubb_tk(:,:,:,:) + real(r8),allocatable :: clubb_tkh(:,:,:,:) + real(r8),allocatable :: relvar(:,:,:,:) + real(r8),allocatable :: accre_enhan(:,:,:,:) + real(r8),allocatable :: qclvar(:,:,:,:) + + real(r8) crm_tk(pcols,crm_nx, crm_ny, crm_nz) + real(r8) crm_tkh(pcols,crm_nx, crm_ny, crm_nz) + real(r8) cld3d_crm(pcols, crm_nx, crm_ny, crm_nz) ! 3D instaneous cloud fraction + real(r8) prec_crm(pcols,crm_nx, crm_ny) + real(r8) mctot(pcols,pver) ! total cloud mass flux + real(r8) mcup(pcols,pver) ! cloud updraft mass flux + real(r8) mcdn(pcols,pver) ! cloud downdraft mass flux + real(r8) mcuup(pcols,pver) ! unsaturated updraft mass flux + real(r8) mcudn(pcols,pver) ! unsaturated downdraft mass flux + real(r8) spqc(pcols,pver) ! cloud water + real(r8) spqi(pcols,pver) ! cloud ice + real(r8) spqs(pcols,pver) ! snow + real(r8) spqg(pcols,pver) ! graupel + real(r8) spqr(pcols,pver) ! rain + real(r8) spnc(pcols,pver) ! cloud water droplet (#/kg) + real(r8) spni(pcols,pver) ! cloud ice crystal number (#/kg) + real(r8) spns(pcols,pver) ! snow particle number (#/kg) + real(r8) spng(pcols,pver) ! graupel particle number (#/kg) + real(r8) spnr(pcols,pver) ! rain particle number (#/kg) + real(r8) wvar_crm (pcols,crm_nx, crm_ny, crm_nz) ! vertical velocity variance (m/s) + + real(r8) aut_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water autoconversion (1/s) + real(r8) acc_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water accretion by rain (1/s) + real(r8) evpc_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water evaporation (1/s) + real(r8) evpr_crm (pcols,crm_nx, crm_ny, crm_nz) ! Rain evaporation (1/s) + real(r8) mlt_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel melting (1/s) + real(r8) sub_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel sublimation (1/s) + real(r8) dep_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel deposition (1/s) + real(r8) con_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water condensation (1/s) + real(r8) aut_crm_a (pcols,pver) ! Cloud water autoconversion (1/s) + real(r8) acc_crm_a (pcols,pver) ! Cloud water accretion by rain (1/s) + real(r8) evpc_crm_a (pcols,pver) ! Cloud water evaporation (1/s) + real(r8) evpr_crm_a (pcols,pver) ! Rain evaporation (1/s) + real(r8) mlt_crm_a (pcols,pver) ! Ice, snow, graupel melting (1/s) + real(r8) sub_crm_a (pcols,pver) ! Ice, snow, graupel sublimation (1/s) + real(r8) dep_crm_a (pcols,pver) ! Ice, snow, graupel deposition (1/s) + real(r8) con_crm_a (pcols,pver) ! Cloud water condensation (1/s) + + real(r8) flux_qt(pcols,pver) ! nonprecipitating water flux + real(r8) flux_u(pcols,pver) ! x-momentum flux + real(r8) flux_v(pcols,pver) ! y-momentum flux + real(r8) fluxsgs_qt(pcols,pver) ! sgs nonprecipitating water flux + real(r8) tkez(pcols,pver) ! tke profile [kg/m/s2] + real(r8) tkesgsz(pcols,pver) ! sgs tke profile [kg/m/s2] + real(r8) flux_qp(pcols,pver) ! precipitating water flux + real(r8) precflux(pcols,pver) ! precipitation flux + real(r8) qt_ls(pcols,pver) ! water tendency due to large-scale + real(r8) qt_trans(pcols,pver) ! nonprecip water tendency due to transport + real(r8) qp_trans(pcols,pver) ! precip water tendency due to transport + real(r8) qp_fall(pcols,pver) ! precip water tendency due to fall-out + real(r8) qp_evp(pcols,pver) ! precip water tendency due to evap + real(r8) qp_src(pcols,pver) ! precip water tendency due to conversion + real(r8) t_ls(pcols,pver) ! tendency of crm's liwse due to large-scale + real(r8) cldtop(pcols,pver) + real(r8) cwp (pcols,pver) ! in-cloud cloud (total) water path (kg/m2) + real(r8) gicewp(pcols,pver) ! grid-box cloud ice water path (g/m2) + real(r8) gliqwp(pcols,pver) ! grid-box cloud liquid water path (g/m2) + real(r8) gwp (pcols,pver) ! grid-box cloud (total) water path (kg/m2) + real(r8) tgicewp(pcols) ! Vertically integrated ice water path (kg/m2 + real(r8) tgliqwp(pcols) ! Vertically integrated liquid water path (kg/m2) + real(r8) cicewp(pcols,pver) ! in-cloud cloud ice water path (kg/m2) + real(r8) cliqwp(pcols,pver) ! in-cloud cloud liquid water path (kg/m2) + real(r8) tgwp (pcols) ! Vertically integrated (total) cloud water path (kg/m2) + real(r8) precc(pcols) ! convective precipitation [m/s] + real(r8) precl(pcols) ! large scale precipitation [m/s] + real(r8) precsc(pcols) ! convecitve snow [m/s] + real(r8) precsl(pcols) ! convective snow [m/s] + real(r8) cltot(pcols) ! Diagnostic total cloud cover + real(r8) cllow(pcols) ! Diagnostic low cloud cover + real(r8) clmed(pcols) ! Diagnostic mid cloud cover + real(r8) clhgh(pcols) ! Diagnostic hgh cloud cover + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + real(r8) ul(pver) + real(r8) vl(pver) + + real(r8) :: mu_crm(pcols,pver) + real(r8) :: md_crm(pcols,pver) + real(r8) :: du_crm(pcols,pver) + real(r8) :: eu_crm(pcols,pver) + real(r8) :: ed_crm(pcols,pver) + real(r8) :: tk_crm(pcols,pver) + real(r8) :: jt_crm(pcols) + real(r8) :: mx_crm(pcols) + real(r8) :: ideep_crm(pcols) + + + integer itim + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + + real(r8),allocatable :: na(:) ! aerosol number concentration [/m3] + real(r8),allocatable :: va(:) ! aerosol voume concentration [m3/m3] + real(r8),allocatable :: hy(:) ! aerosol bulk hygroscopicity + real(r8),allocatable :: naermod(:,:) ! Aerosol number concentration [/m3] + real(r8),allocatable :: vaerosol(:,:) ! aerosol volume concentration [m3/m3] + real(r8),allocatable :: hygro(:,:) ! hygroscopicity of aerosol mode + integer phase ! phase to determine whether it is interstitial, cloud-borne, or the sum. + + real(r8) cs(pcols, pver) ! air density [kg/m3] + + real(r8),allocatable :: qicecen(:,:,:,:,:) ! cloud ice (kg/kg) + real(r8),allocatable :: qlsink_afcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated + ! cloud water before precipitatinog (/s) + real(r8),allocatable :: qlsink_bfcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated + ! cloud water before precipitatinog (/s) + real(r8),allocatable :: qlsink_avgcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated + ! from praincen and qlcoudcen averaged over + ! ntavg1_ss time step (/s) + real(r8),allocatable :: praincen(:,:,:,:,:) ! cloud water loss rate from precipitation (kg/kg/s) + real(r8),allocatable :: wupthresh_bnd(:,:) + real(r8),allocatable :: wdownthresh_bnd(:,:) + + ! CRM column radiation stuff: + real(r8) prectend(pcols) ! tendency in precipitating water and ice + real(r8) precstend(pcols) ! tendency in precipitating ice + real(r8) icesink(pcols) ! sink of + real(r8) tau00 ! surface stress + real(r8) wnd ! surface wnd + real(r8) bflx ! surface buoyancy flux (Km/s) + real(r8) taux_crm(pcols) ! zonal CRM surface stress perturbation + real(r8) tauy_crm(pcols) ! merid CRM surface stress perturbation + real(r8) z0m(pcols) ! surface momentum roughness length + real(r8), pointer, dimension(:,:) :: qrs, qrl ! rad heating rates + real(r8), pointer, dimension(:,:,:,:) :: crm_u + real(r8), pointer, dimension(:,:,:,:) :: crm_v + real(r8), pointer, dimension(:,:,:,:) :: crm_w + real(r8), pointer, dimension(:,:,:,:) :: crm_t + real(r8), pointer, dimension(:,:,:,:) :: crm_qt + real(r8), pointer, dimension(:,:,:,:) :: crm_qp + real(r8), pointer, dimension(:,:,:,:) :: crm_qn + real(r8), pointer, dimension(:,:,:,:) :: crm_nc + real(r8), pointer, dimension(:,:,:,:) :: crm_qr + real(r8), pointer, dimension(:,:,:,:) :: crm_nr + real(r8), pointer, dimension(:,:,:,:) :: crm_qi + real(r8), pointer, dimension(:,:,:,:) :: crm_ni + real(r8), pointer, dimension(:,:,:,:) :: crm_qs + real(r8), pointer, dimension(:,:,:,:) :: crm_ns + real(r8), pointer, dimension(:,:,:,:) :: crm_qg + real(r8), pointer, dimension(:,:,:,:) :: crm_ng + real(r8), pointer, dimension(:,:,:,:) :: crm_qc + + real(r8), allocatable, dimension(:,:,:,:,:) :: crm_micro + + integer :: pblh_idx + real(r8), pointer, dimension(:) :: pblh + + real(r8), pointer, dimension(:,:) :: wsedl + + real(r8),allocatable :: acen(:,:,:,:,:) ! cloud fraction for each sub-sub class for full time period + real(r8),allocatable :: acen_tf(:,:,:,:,:) ! cloud fraction for end-portion of time period + real(r8),allocatable :: rhcen(:,:,:,:,:) ! relative humidity (0-1) + real(r8),allocatable :: qcloudcen(:,:,:,:,:) ! cloud water (kg/kg) + real(r8),allocatable :: qlsinkcen(:,:,:,:,:) ! cloud water loss rate from precipitation (/s??) + real(r8),allocatable :: precrcen(:,:,:,:,:) ! liquid (rain) precipitation rate (kg/m2/s) + real(r8),allocatable :: precsolidcen(:,:,:,:,:) ! solid (rain) precipitation rate (kg/m2/s) + real(r8),allocatable :: wwqui_cen(:,:) ! vertical velocity variance in quiescent class (m2/s2) + real(r8),allocatable :: wwqui_cloudy_cen(:,:) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) + ! at layer boundary + real(r8),allocatable :: abnd(:,:,:,:,:) ! cloud fraction for each sub-sub class for full time period + real(r8),allocatable :: abnd_tf(:,:,:,:,:) ! cloud fraction for end-portion of time period + real(r8),allocatable :: massflxbnd(:,:,:,:,:) ! sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. + real(r8),allocatable :: wwqui_bnd(:,:) ! vertical velocity variance in quiescent class (m2/s2) + real(r8),allocatable :: wwqui_cloudy_bnd(:,:) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) + + integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions + real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + + real(r8), allocatable :: spup2(:,:) + real(r8), allocatable :: spvp2(:,:) + real(r8), allocatable :: spwprtp(:,:) + real(r8), allocatable :: spwpthlp(:,:) + real(r8), allocatable :: spwp2(:,:) + real(r8), allocatable :: spwp3(:,:) + real(r8), allocatable :: sprtp2(:,:) + real(r8), allocatable :: spthlp2(:,:) + real(r8), allocatable :: sprtpthlp(:,:) + real(r8), allocatable :: spupwp(:,:) + real(r8), allocatable :: spvpwp(:,:) + real(r8), allocatable :: spcrm_cld(:,:) + real(r8), allocatable :: spt_tndcy(:,:) + real(r8), allocatable :: spqv_tndcy(:,:) + real(r8), allocatable :: spqc_tndcy(:,:) + real(r8), allocatable :: spclubb_tk(:,:) + real(r8), allocatable :: spclubb_tkh(:,:) + real(r8), allocatable :: sprelvar(:,:) + real(r8), allocatable :: spaccre_enhan(:,:) + real(r8), allocatable :: spqclvar(:,:) + + real(r8) :: spcld3d (pcols,pver) + + real(r8) :: tmp4d(pcols,crm_nx, crm_ny, crm_nz) + real(r8) :: tmp2d(pcols,pver) + + ! Surface fluxes + real(r8) :: fluxu0 ! surface momenment fluxes + real(r8) :: fluxv0 ! surface momenment fluxes + real(r8) :: fluxt0 ! surface sensible heat fluxes + real(r8) :: fluxq0 ! surface latent heat fluxes + real(r8) :: dtstep_pp ! time step for the ECPP (seconds) + integer :: necpp ! the number of GCM time step in which ECPP is called once. + + + real(r8) radflux(pcols) ! radiative fluxes from radiation calculation (qrs + qrl) + + real(r8) qtot(pcols, 3) ! total water + real(r8) qt_hydro(pcols, 2) ! total hydrometer + real(r8) qt_cloud(pcols, 3) ! total cloud water + real(r8) qtv(pcols, 3) ! total water vapor + real(r8) qli_hydro(pcols, 2) ! column-integraetd rain + snow + graupel + real(r8) qi_hydro(pcols, 2) ! column-integrated snow water + graupel water + real(r8) sfactor + + real(r8) zero(pcols) ! zero + real(r8) timing_factor(pcols) ! factor for crm cpu-usage: 1 means no subcycling + + real(r8) qtotcrm(pcols, 20) ! the toal water calculated in crm.F90 + + real(r8), parameter :: rhow = 1000._r8 + real(r8), parameter :: bc = 2._r8 + real(r8) :: t, mu, acn, dumc, dunc, pgam, lamc + real(r8) :: dunc_arr(pcols,pver) + + integer ii, jj + integer iii + integer i, k, m + integer ifld + logical :: ls, lu, lv, lq(pcnst) + + zero = 0.0_r8 +!======================================================== +!======================================================== +! CRM (Superparameterization). +! Author: Marat Khairoutdinov (mkhairoutdin@ms.cc.sunysb.edu) +!======================================================== + + call t_startf ('crm') + + allocate(crm_micro(pcols,crm_nx,crm_ny,crm_nz,nmicro_fields+1)) + + ! Initialize stuff: + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + ls = .TRUE. + lq(:) = .FALSE. + lq(1) = .TRUE. + lq(ixcldliq) = .TRUE. + lq(ixcldice) = .TRUE. + lu = .FALSE. + lv = .FALSE. + call physics_ptend_init(ptend, state%psetcols, 'crm', lu=lu, lv=lv, ls=ls, lq=lq) ! Initialize output physics_ptend object + call physics_ptend_init(ptend_loc, state%psetcols, 'crm', lu=lu, lv=lv, ls=ls, lq=lq) ! Initialize local physics_ptend object + + nstep = get_nstep() + + lchnk = state%lchnk + ncol = state%ncol + + itim = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim/), kount=(/pcols,pver,1/)) + + call physics_state_copy(state, state_loc) + tend_loc = tend + + !------------------------- + ! Set up general fields + call pbuf_get_field (pbuf, crm_u_idx, crm_u) + call pbuf_get_field (pbuf, crm_v_idx, crm_v) + call pbuf_get_field (pbuf, crm_w_idx, crm_w) + call pbuf_get_field (pbuf, crm_t_idx, crm_t) + call pbuf_get_field (pbuf, crm_qrad_idx, crm_qrad) + call pbuf_get_field (pbuf, crm_t_rad_idx, t_rad) + call pbuf_get_field (pbuf, crm_qv_rad_idx, qv_rad) + call pbuf_get_field (pbuf, crm_qc_rad_idx, qc_rad) + call pbuf_get_field (pbuf, crm_qi_rad_idx, qi_rad) + call pbuf_get_field (pbuf, crm_cld_rad_idx, cld_rad) + + call pbuf_get_field (pbuf, prec_dp_idx, prec_dp) + call pbuf_get_field (pbuf, snow_dp_idx, snow_dp) + + + !------------------------- + ! setup CLUBB fields + if (do_clubb_sgs) then + allocate(nmxrgn (pcols)) + allocate(pmxrgn (pcols,pverp)) + allocate(spup2 (pcols, pver)) + allocate(spvp2 (pcols, pver)) + allocate(spwprtp (pcols, pver)) + allocate(spwpthlp (pcols, pver)) + allocate(spwp2 (pcols, pver)) + allocate(spwp3 (pcols, pver)) + allocate(sprtp2 (pcols, pver)) + allocate(spthlp2 (pcols, pver)) + allocate(sprtpthlp (pcols, pver)) + allocate(spupwp (pcols, pver)) + allocate(spvpwp (pcols, pver)) + allocate(spcrm_cld (pcols, pver)) + allocate(spt_tndcy (pcols, pver)) + allocate(spqv_tndcy (pcols, pver)) + allocate(spqc_tndcy (pcols, pver)) + allocate(spclubb_tk (pcols, pver)) + allocate(spclubb_tkh (pcols, pver)) + allocate(sprelvar (pcols, pver)) + allocate(spaccre_enhan (pcols, pver)) + allocate(spqclvar (pcols, pver)) + allocate(crm_cld (pcols,crm_nx, crm_ny, crm_nz+1)) + allocate(clubb_tk (pcols,crm_nx, crm_ny, crm_nz)) + allocate(clubb_tkh (pcols,crm_nx, crm_ny, crm_nz)) + allocate(relvar (pcols,crm_nx, crm_ny, crm_nz)) + allocate(accre_enhan (pcols,crm_nx, crm_ny, crm_nz)) + allocate(qclvar (pcols,crm_nx, crm_ny, crm_nz)) + + call pbuf_get_field (pbuf, clubb_buffer_idx, clubb_buffer) + + endif + + !------------------------- + ! Setup m2005 fields + if (is_spcam_m2005) then + allocate(na (pcols)) + allocate(va (pcols)) + allocate(hy (pcols)) + allocate(naermod (pver, nmodes)) + allocate(vaerosol (pver, nmodes)) + allocate(hygro (pver, nmodes)) + + call pbuf_get_field(pbuf, crm_nc_rad_idx, nc_rad) + call pbuf_get_field(pbuf, crm_ni_rad_idx, ni_rad) + call pbuf_get_field(pbuf, crm_qs_rad_idx, qs_rad) + call pbuf_get_field(pbuf, crm_ns_rad_idx, ns_rad) + call pbuf_get_field(pbuf, crm_qt_idx, crm_qt) + call pbuf_get_field(pbuf, crm_nc_idx, crm_nc) + call pbuf_get_field(pbuf, crm_qr_idx, crm_qr) + call pbuf_get_field(pbuf, crm_nr_idx, crm_nr) + call pbuf_get_field(pbuf, crm_qi_idx, crm_qi) + call pbuf_get_field(pbuf, crm_ni_idx, crm_ni) + call pbuf_get_field(pbuf, crm_qs_idx, crm_qs) + call pbuf_get_field(pbuf, crm_ns_idx, crm_ns) + call pbuf_get_field(pbuf, crm_qg_idx, crm_qg) + call pbuf_get_field(pbuf, crm_ng_idx, crm_ng) + call pbuf_get_field(pbuf, crm_qc_idx, crm_qc) + + !------------------------- + ! Setup sam1mom fields + else if (is_spcam_sam1mom) then + call pbuf_get_field(pbuf, crm_qt_idx, crm_qt) + call pbuf_get_field(pbuf, crm_qp_idx, crm_qp) + call pbuf_get_field(pbuf, crm_qn_idx, crm_qn) + endif + + + !------------------------- + ! Setup ECPP fields + ! ifdef needed because of use of NCLASS_CL +#ifdef m2005 + if (is_spcam_m2005) then + allocate(acen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(acen_tf (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(rhcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(qcloudcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(qlsinkcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(precrcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(precsolidcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(wwqui_cen (pcols, pver)) + allocate(wwqui_cloudy_cen (pcols, pver)) + + ! at layer boundary + allocate(abnd (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(abnd_tf (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(massflxbnd (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(wwqui_bnd (pcols, pver+1)) + allocate(wwqui_cloudy_bnd (pcols, pver+1)) + + allocate(qicecen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(qlsink_afcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(qlsink_bfcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(qlsink_avgcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(praincen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) + allocate(wupthresh_bnd (pcols, pverp)) + allocate(wdownthresh_bnd (pcols, pverp)) + + call pbuf_get_field(pbuf, tk_crm_idx, tk_crm_ecpp) + call pbuf_get_field(pbuf, acldy_cen_idx, acldy_cen_tbeg) + + if(is_first_step())then + acldy_cen_tbeg(:ncol,:) = cld(:ncol, :) + end if + + end if +#endif + + !------------------------- + ! Initialize all aerosol and gas species + ! When ECPP is used, dropmixnuc and all transport(deep and shallow) are done in ECPP. + if (is_spcam_sam1mom) then + state_loc%q(:ncol, :pver, :pcnst) = 1.e-36_r8 + ! set the values which SPCAM uses back to state + state_loc%q(:ncol, :pver, 1) = state%q(:ncol, :pver, 1) + state_loc%q(:ncol, :pver, ixcldice) = state%q(:ncol, :pver, ixcldice) + state_loc%q(:ncol, :pver, ixcldliq) = state%q(:ncol, :pver, ixcldliq) + endif + + !------------------------- + !------------------------- + ! On the first_step, initialize values only and do not call CRM + !------------------------- + !------------------------- + if(is_first_step()) then + do k=1,crm_nz + m = pver-k+1 + do i=1,ncol + + if (spcam_direction == 'NS') then + if(crm_ny.eq.1) then ! change domain orientation only for 2D CRM + crm_u(i,:,:,k) = state_loc%v(i,m) + crm_v(i,:,:,k) = state_loc%u(i,m) + else + crm_u(i,:,:,k) = state_loc%u(i,m) + crm_v(i,:,:,k) = state_loc%v(i,m) + end if + else if( spcam_direction == 'WE') then + crm_u(i,:,:,k) = state_loc%u(i,m) + crm_v(i,:,:,k) = state_loc%v(i,m) + endif + + crm_w(i,:,:,k) = 0._r8 + crm_t(i,:,:,k) = state_loc%t(i,m) + + if (is_spcam_sam1mom) then + crm_qt(i,:,:,k) = state_loc%q(i,m,1)+state_loc%q(i,m,ixcldliq)+state_loc%q(i,m,ixcldice) + crm_qp(i,:,:,k) = 0.0_r8 + crm_qn(i,:,:,k) = state_loc%q(i,m,ixcldliq)+state_loc%q(i,m,ixcldice) + + else if (is_spcam_m2005) then + crm_qt(i,:,:,k) = state_loc%q(i,m,1)+state_loc%q(i,m,ixcldliq) + crm_nc(i,:,:,k) = 0.0_r8 + crm_qr(i,:,:,k) = 0.0_r8 + crm_nr(i,:,:,k) = 0.0_r8 + crm_qi(i,:,:,k) = state_loc%q(i,m,ixcldice) + crm_ni(i,:,:,k) = 0.0_r8 + crm_qs(i,:,:,k) = 0.0_r8 + crm_ns(i,:,:,k) = 0.0_r8 + crm_qg(i,:,:,k) = 0.0_r8 + crm_ng(i,:,:,k) = 0.0_r8 + crm_qc(i,:,:,k) = state_loc%q(i,m,ixcldliq) + + + nc_rad(i,:,:,k) = 0._r8 + ni_rad(i,:,:,k) = 0._r8 + qs_rad(i,:,:,k) = 0.0_r8 + ns_rad(i,:,:,k) = 0.0_r8 + wvar_crm(i,:,:,k) = 0.0_r8 + aut_crm(i,:,:,k) = 0.0_r8 + acc_crm(i,:,:,k) = 0.0_r8 + evpc_crm(i,:,:,k) = 0.0_r8 + evpr_crm(i,:,:,k) = 0.0_r8 + mlt_crm(i,:,:,k) = 0.0_r8 + sub_crm(i,:,:,k) = 0.0_r8 + dep_crm(i,:,:,k) = 0.0_r8 + con_crm(i,:,:,k) = 0.0_r8 + endif + + if (do_clubb_sgs) then + ! In the inital run, variables are set in clubb_sgs_setup at the first time step + clubb_buffer(i,:,:,k,:) = 0.0_r8 + endif + + crm_qrad (i,:,:,k) = 0._r8 + qc_crm (i,:,:,k) = 0._r8 + qi_crm (i,:,:,k) = 0._r8 + qpc_crm(i,:,:,k) = 0._r8 + qpi_crm(i,:,:,k) = 0._r8 + t_rad (i,:,:,k) = state_loc%t(i,m) + qv_rad (i,:,:,k) = state_loc%q(i,m,1) + qc_rad (i,:,:,k) = 0._r8 + qi_rad (i,:,:,k) = 0._r8 + cld_rad(i,:,:,k) = 0._r8 + end do + end do + + ! use radiation from grid-cell mean radctl on first time step + prec_crm (:,:,:) = 0._r8 + ptend_loc%q(:,:,1) = 0._r8 + ptend_loc%q(:,:,ixcldliq) = 0._r8 + ptend_loc%q(:,:,ixcldice) = 0._r8 + ptend_loc%s(:,:) = 0._r8 + precc(:) = 0._r8 + precl(:) = 0._r8 + precsc(:) = 0._r8 + precsl(:) = 0._r8 + cltot(:) = 0._r8 + clhgh(:) = 0._r8 + clmed(:) = 0._r8 + cllow(:) = 0._r8 + cld(:,:) = 0._r8 + cldtop(:,:) = 0._r8 + gicewp(:,:) = 0._r8 + gliqwp(:,:) = 0._r8 + mctot(:,:) = 0._r8 + mcup(:,:) = 0._r8 + mcdn(:,:) = 0._r8 + mcuup(:,:) = 0._r8 + mcudn(:,:) = 0._r8 + spqc(:,:) = 0._r8 + spqi(:,:) = 0._r8 + spqs(:,:) = 0._r8 + spqg(:,:) = 0._r8 + spqr(:,:) = 0._r8 + cld3d_crm (:,:,:,:) = 0._r8 + flux_qt(:,:) = 0._r8 + flux_u(:,:) = 0._r8 + flux_v(:,:) = 0._r8 + fluxsgs_qt(:,:) = 0._r8 + tkez(:,:) = 0._r8 + tkesgsz(:,:) = 0._r8 + flux_qp(:,:) = 0._r8 + precflux(:,:) = 0._r8 + qt_ls(:,:) = 0._r8 + qt_trans(:,:) = 0._r8 + qp_trans(:,:) = 0._r8 + qp_fall(:,:) = 0._r8 + qp_evp(:,:) = 0._r8 + qp_src(:,:) = 0._r8 + z0m(:) = 0._r8 + taux_crm(:) = 0._r8 + tauy_crm(:) = 0._r8 + t_ls(:,:) = 0._r8 + + + if (is_spcam_m2005) then + spnc(:,:) = 0._r8 + spni(:,:) = 0._r8 + spns(:,:) = 0._r8 + spng(:,:) = 0._r8 + spnr(:,:) = 0._r8 + aut_crm_a(:,:) = 0._r8 + acc_crm_a(:,:) = 0._r8 + evpc_crm_a(:,:) = 0._r8 + evpr_crm_a(:,:) = 0._r8 + mlt_crm_a(:,:) = 0._r8 + sub_crm_a(:,:) = 0._r8 + dep_crm_a(:,:) = 0._r8 + con_crm_a(:,:) = 0._r8 + abnd = 0.0_r8 + abnd_tf = 0.0_r8 + massflxbnd = 0.0_r8 + acen = 0.0_r8 + acen_tf = 0.0_r8 + rhcen = 0.0_r8 + qcloudcen = 0.0_r8 + qicecen = 0.0_r8 + qlsinkcen = 0.0_r8 + precrcen = 0.0_r8 + precsolidcen = 0.0_r8 + wupthresh_bnd = 0.0_r8 + wdownthresh_bnd = 0.0_r8 + qlsink_afcen = 0.0_r8 + qlsink_bfcen = 0.0_r8 + qlsink_avgcen = 0.0_r8 + praincen = 0.0_r8 + + ! default is clear, non-precipitating, and quiescent class + abnd(:,:,1,1,1) = 1.0_r8 + abnd_tf(:,:,1,1,1) = 1.0_r8 + acen(:,:,1,1,1) = 1.0_r8 + acen_tf(:,:,1,1,1) = 1.0_r8 + wwqui_cen = 0.0_r8 + wwqui_bnd = 0.0_r8 + wwqui_cloudy_cen = 0.0_r8 + wwqui_cloudy_bnd = 0.0_r8 + tk_crm = 0.0_r8 + + ! turbulence + cs(:ncol, 1:pver) = state_loc%pmid(:ncol, 1:pver)/(287.15_r8*state_loc%t(:ncol, 1:pver)) + + endif + + !------------------------- + !------------------------- + ! not is_first_step + !------------------------- + !------------------------- + + else + ptend_loc%q(:,:,1) = 0._r8 + ptend_loc%q(:,:,ixcldliq) = 0._r8 + ptend_loc%q(:,:,ixcldice) = 0._r8 + ptend_loc%s(:,:) = 0._r8 + cwp = 0._r8 + gicewp = 0._r8 + gliqwp = 0._r8 + cltot = 0._r8 + clhgh = 0._r8 + clmed = 0._r8 + cllow = 0._r8 + + qc_crm = 0._r8 + qi_crm = 0._r8 + qpc_crm = 0._r8 + qpi_crm = 0._r8 + prec_crm = 0._r8 + + ! Populate the internal crm_micro array + if (is_spcam_sam1mom) then + crm_micro(:,:,:,:,1) = crm_qt(:,:,:,:) + crm_micro(:,:,:,:,2) = crm_qp(:,:,:,:) + crm_micro(:,:,:,:,3) = crm_qn(:,:,:,:) + else if (is_spcam_m2005) then + crm_micro(:,:,:,:,1) = crm_qt(:,:,:,:) + crm_micro(:,:,:,:,2) = crm_nc(:,:,:,:) + crm_micro(:,:,:,:,3) = crm_qr(:,:,:,:) + crm_micro(:,:,:,:,4) = crm_nr(:,:,:,:) + crm_micro(:,:,:,:,5) = crm_qi(:,:,:,:) + crm_micro(:,:,:,:,6) = crm_ni(:,:,:,:) + crm_micro(:,:,:,:,7) = crm_qs(:,:,:,:) + crm_micro(:,:,:,:,8) = crm_ns(:,:,:,:) + crm_micro(:,:,:,:,9) = crm_qg(:,:,:,:) + crm_micro(:,:,:,:,10) = crm_ng(:,:,:,:) + crm_micro(:,:,:,:,11) = crm_qc(:,:,:,:) + + ! initialize gcm-time-step-avg output at start of each time step + aut_crm_a = 0.0_r8 + acc_crm_a = 0.0_r8 + evpc_crm_a = 0.0_r8 + evpr_crm_a = 0.0_r8 + mlt_crm_a = 0.0_r8 + sub_crm_a = 0.0_r8 + dep_crm_a = 0.0_r8 + con_crm_a = 0.0_r8 + endif + + call t_startf ('crm_call') + + do m=1,crm_nz + k = pver-m+1 + do i = 1,ncol + crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) / state_loc%pdel(i,k) ! for energy conservation + end do + end do + + if (is_spcam_m2005) then + cs(1:ncol, 1:pver) = state_loc%pmid(1:ncol, 1:pver)/(287.15_r8*state_loc%t(1:ncol, 1:pver)) + end if + + do i = 1,ncol + + tau00 = sqrt(cam_in%wsx(i)**2 + cam_in%wsy(i)**2) + wnd = sqrt(state_loc%u(i,pver)**2 + state_loc%v(i,pver)**2) + bflx = cam_in%shf(i)/cpair + 0.61_r8*state_loc%t(i,pver)*cam_in%lhf(i)/latvap + fluxu0 = cam_in%wsx(i) !N/m2 + fluxv0 = cam_in%wsy(i) !N/m2 + fluxt0 = cam_in%shf(i)/cpair ! K Kg/ (m2 s) + fluxq0 = cam_in%lhf(i)/latvap ! Kg/(m2 s) + + ! + ! calculate total water before calling crm + ! total hydrometer water (rain, snow, and graupel) + if (is_spcam_m2005) then + qt_hydro(i, 1) = 0.0_r8 + qli_hydro(i, 1) = 0.0_r8 + qi_hydro(i, 1) = 0.0_r8 + do m=1, crm_nz + k=pver-m+1 + do ii=1, crm_nx + do jj=1, crm_ny + qt_hydro(i,1) = qt_hydro(i,1)+(crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + qli_hydro(i,1) = qli_hydro(i,1)+(crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + qi_hydro(i,1) = qi_hydro(i,1)+(crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * state_loc%pdel(i,k)/gravit + end do + end do + end do + qt_hydro(i,1) = qt_hydro(i,1) / (crm_nx_ny) + qli_hydro(i,1) = qli_hydro(i,1) / (crm_nx_ny) + qi_hydro(i,1) = qi_hydro(i,1) / (crm_nx_ny) + + ! total cloud water and total water vapor + qt_cloud(i,1) = 0._r8 + qtv(i,1) = 0._r8 + do k=1, pver + qt_cloud(i,1) = qt_cloud(i,1) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit + qtv(i,1) = qtv(i,1) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit + end do + + ! total water + qtot(i,1) = qt_hydro(i,1) + qt_cloud(i,1) + qtv(i,1) + + else if (is_spcam_sam1mom) then + qli_hydro(i, 1) = 0.0_r8 + qi_hydro(i, 1) = 0.0_r8 + do m=1, crm_nz + k=pver-m+1 + do ii=1, crm_nx + do jj=1, crm_ny + sfactor = max(0._r8,min(1._r8,(crm_t(i,ii,jj,m)-268.16_r8)*1._r8/(283.16_r8-268.16_r8))) + qli_hydro(i,1) = qli_hydro(i,1)+crm_qp(i,ii,jj,m) * state_loc%pdel(i,k)/gravit + qi_hydro(i,1) = qi_hydro(i,1)+crm_qp(i,ii,jj,m) * (1-sfactor) * state_loc%pdel(i,k)/gravit + end do + end do + end do + qli_hydro(i,1) = qli_hydro(i,1) / (crm_nx_ny) + qi_hydro(i,1) = qi_hydro(i,1) / (crm_nx_ny) + + ! total cloud water and total water vapor, and energy + qt_cloud(i,1) = 0._r8 + qtv(i,1) = 0._r8 + do k=1, pver + qt_cloud(i,1) = qt_cloud(i,1) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit + qtv(i,1) = qtv(i,1) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit + end do + endif + +! ifdef required because of loadaer +#ifdef MODAL_AERO + if (prog_modal_aero) then + do k=1, pver + phase = 1 ! interstital aerosols only + do m=1, nmodes + call loadaer( & + state_loc, pbuf, i, i, k, & + m, cs, phase, na, va, & + hy) + naermod(k, m) = na(i) + vaerosol(k, m) = va(i) + hygro(k, m) = hy(i) + end do + end do + endif +#endif + + if (spcam_direction == 'NS') then + if(crm_ny.eq.1) then + ul(:) = state_loc%v(i,:) ! change orientation only if 2D CRM + vl(:) = state_loc%u(i,:) + else + ul(:) = state_loc%u(i,:) + vl(:) = state_loc%v(i,:) + end if + else if (spcam_direction == 'WE') then + ul(:) = state_loc%u(i,:) + vl(:) = state_loc%v(i,:) + endif + + call crm (lchnk, i, & + state_loc%t(i,:), state_loc%q(i,:,1), state_loc%q(i,:,ixcldliq), state_loc%q(i,:,ixcldice), & + ul(:), vl(:), & + state_loc%ps(i), state_loc%pmid(i,:), state_loc%pdel(i,:), state_loc%phis(i), & + state_loc%zm(i,:), state_loc%zi(i,:), ztodt, pver, & + ptend_loc%q(i,:,1), ptend_loc%q(i,:,ixcldliq),ptend_loc%q(i,:,ixcldice), ptend_loc%s(i,:), & + crm_u(i,:,:,:), crm_v(i,:,:,:), crm_w(i,:,:,:), crm_t(i,:,:,:), crm_micro(i,:,:,:,:), & + crm_qrad(i,:,:,:), & + qc_crm(i,:,:,:), qi_crm(i,:,:,:), qpc_crm(i,:,:,:), qpi_crm(i,:,:,:), & + prec_crm(i,:,:), t_rad(i,:,:,:), qv_rad(i,:,:,:), & + qc_rad(i,:,:,:), qi_rad(i,:,:,:), cld_rad(i,:,:,:), cld3d_crm(i, :, :, :), & +#ifdef m2005 + nc_rad(i,:,:,:), ni_rad(i,:,:,:), qs_rad(i,:,:,:), ns_rad(i,:,:,:), wvar_crm(i,:,:,:), & + aut_crm(i,:,:,:), acc_crm(i,:,:,:), evpc_crm(i,:,:,:), evpr_crm(i,:,:,:), mlt_crm(i,:,:,:), & + sub_crm(i,:,:,:), dep_crm(i,:,:,:), con_crm(i,:,:,:), & + aut_crm_a(i,:), acc_crm_a(i,:), evpc_crm_a(i,:), evpr_crm_a(i,:), mlt_crm_a(i,:), & + sub_crm_a(i,:), dep_crm_a(i,:), con_crm_a(i,:), & +#endif + precc(i), precl(i), precsc(i), precsl(i), & + cltot(i), clhgh(i), clmed(i), cllow(i), cld(i,:), cldtop(i,:), & + gicewp(i,:), gliqwp(i,:), & + mctot(i,:), mcup(i,:), mcdn(i,:), mcuup(i,:), mcudn(i,:), & + spqc(i,:), spqi(i,:), spqs(i,:), spqg(i,:), spqr(i,:), & +#ifdef m2005 + spnc(i,:), spni(i,:), spns(i,:), spng(i,:), spnr(i,:), & +#ifdef MODAL_AERO + naermod, vaerosol, hygro, & +#endif +#endif +#ifdef SPCAM_CLUBB_SGS + clubb_buffer(i,:,:,:,:), & + crm_cld(i,:, :, :), & + clubb_tk(i, :, :, :), clubb_tkh(i, :, :, :), & + relvar(i,:, :, :), accre_enhan(i, :, :, :), qclvar(i, :, :, :), & +#endif + crm_tk(i, :, :, :), crm_tkh(i, :, :, :), & + mu_crm(i,:), md_crm(i,:), du_crm(i,:), eu_crm(i,:), & + ed_crm(i,:), jt_crm(i), mx_crm(i), & +#ifdef m2005 + abnd(i,:,:,:,:), abnd_tf(i,:,:,:,:), massflxbnd(i,:,:,:,:), acen(i,:,:,:,:), acen_tf(i,:,:,:,:), & + rhcen(i,:,:,:,:), qcloudcen(i,:,:,:,:), qicecen(i,:,:,:,:), qlsink_afcen(i,:,:,:,:), & + precrcen(i,:,:,:,:), precsolidcen(i,:,:,:,:), & + qlsink_bfcen(i,:,:,:,:), qlsink_avgcen(i,:,:,:,:), praincen(i,:,:,:,:), & + wupthresh_bnd(i,:), wdownthresh_bnd(i,:), & + wwqui_cen(i,:), wwqui_bnd(i,:), wwqui_cloudy_cen(i,:), wwqui_cloudy_bnd(i,:), & +#endif + tkez(i,:), tkesgsz(i,:), tk_crm(i, :), & + flux_u(i,:), flux_v(i,:), flux_qt(i,:), fluxsgs_qt(i,:), flux_qp(i,:), & + precflux(i,:), qt_ls(i,:), qt_trans(i,:), qp_trans(i,:), qp_fall(i,:), & + qp_evp(i,:), qp_src(i,:), t_ls(i,:), prectend(i), precstend(i), & + cam_in%ocnfrac(i), wnd, tau00, bflx, & + fluxu0, fluxv0, fluxt0, fluxq0, & + taux_crm(i), tauy_crm(i), z0m(i), timing_factor(i), qtotcrm(i, :) ) + + ! Retrieve the values back out of the internal crm array structure + if (is_spcam_sam1mom) then + crm_qt(i,:,:,:) = crm_micro(i,:,:,:,1) + crm_qp(i,:,:,:) = crm_micro(i,:,:,:,2) + crm_qn(i,:,:,:) = crm_micro(i,:,:,:,3) + else if (is_spcam_m2005) then + crm_qt(i,:,:,:) = crm_micro(i,:,:,:,1) + crm_nc(i,:,:,:) = crm_micro(i,:,:,:,2) + crm_qr(i,:,:,:) = crm_micro(i,:,:,:,3) + crm_nr(i,:,:,:) = crm_micro(i,:,:,:,4) + crm_qi(i,:,:,:) = crm_micro(i,:,:,:,5) + crm_ni(i,:,:,:) = crm_micro(i,:,:,:,6) + crm_qs(i,:,:,:) = crm_micro(i,:,:,:,7) + crm_ns(i,:,:,:) = crm_micro(i,:,:,:,8) + crm_qg(i,:,:,:) = crm_micro(i,:,:,:,9) + crm_ng(i,:,:,:) = crm_micro(i,:,:,:,10) + crm_qc(i,:,:,:) = crm_micro(i,:,:,:,11) + endif + end do ! i (loop over ncol) + + call t_stopf('crm_call') + + ! There is no separate convective and stratiform precip for CRM: + precc(:ncol) = precc(:ncol) + precl(:ncol) + precl(:ncol) = 0._r8 + precsc(:ncol) = precsc(:ncol) + precsl(:ncol) + precsl(:ncol) = 0._r8 + + prec_dp(:ncol)= precc(:ncol) + snow_dp(:ncol)= precsc(:ncol) + + do m=1,crm_nz + k = pver-m+1 + do i = 1,ncol + crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) * state_loc%pdel(i,k) ! for energy conservation + end do + end do + + call outfld('PRES ',state_loc%pmid ,pcols ,lchnk ) + call outfld('DPRES ',state_loc%pdel ,pcols ,lchnk ) + call outfld('CRM_U ',crm_u ,pcols ,lchnk ) + call outfld('CRM_V ',crm_v ,pcols ,lchnk ) + call outfld('CRM_W ',crm_w ,pcols ,lchnk ) + call outfld('CRM_T ',crm_t ,pcols ,lchnk ) + call outfld('CRM_QC ',qc_crm ,pcols ,lchnk ) + call outfld('CRM_QI ',qi_crm ,pcols ,lchnk ) + call outfld('CRM_QPC ',qpc_crm ,pcols ,lchnk ) + call outfld('CRM_QPI ',qpi_crm ,pcols ,lchnk ) + call outfld('CRM_PREC',prec_crm ,pcols ,lchnk ) + call outfld('CRM_TK ', crm_tk(:, :, :, :) ,pcols ,lchnk ) + call outfld('CRM_TKH', crm_tkh(:, :, :, :) ,pcols ,lchnk ) + + if (is_spcam_sam1mom) then + tmp4d(:ncol,:,:,:) = crm_qt(:ncol,:,:,:)-qc_crm(:ncol,:,:,:)-qi_crm(:ncol,:,:,:) + call outfld('CRM_QV ',tmp4d,pcols ,lchnk ) + else if (is_spcam_m2005) then + tmp4d(:ncol,:,:,:) = crm_qt(:ncol,:,:,:)-qc_crm(:ncol,:,:,:) + call outfld('CRM_QV ',tmp4d, pcols ,lchnk ) + endif + + + if (is_spcam_m2005) then + call outfld('CRM_NC ', crm_nc ,pcols ,lchnk) + call outfld('CRM_NI ', crm_ni ,pcols ,lchnk) + call outfld('CRM_NR ', crm_nr ,pcols ,lchnk) + call outfld('CRM_NS ', crm_ns ,pcols ,lchnk) + call outfld('CRM_NG ', crm_ng ,pcols ,lchnk) + call outfld('CRM_WVAR', wvar_crm ,pcols ,lchnk) + call outfld('CRM_QR ', crm_qr ,pcols ,lchnk) + call outfld('CRM_QS ', crm_qs ,pcols ,lchnk) + call outfld('CRM_QG ', crm_qg ,pcols ,lchnk) + call outfld('CRM_AUT', aut_crm ,pcols ,lchnk) + call outfld('CRM_ACC', acc_crm ,pcols ,lchnk) + call outfld('CRM_EVPC', evpc_crm ,pcols ,lchnk) + call outfld('CRM_EVPR', evpr_crm ,pcols ,lchnk) + call outfld('CRM_MLT', mlt_crm ,pcols ,lchnk) + call outfld('CRM_SUB', sub_crm ,pcols ,lchnk) + call outfld('CRM_DEP', dep_crm ,pcols ,lchnk) + call outfld('CRM_CON', con_crm ,pcols ,lchnk) + + ! output for time-mean-avg + call outfld('A_AUT', aut_crm_a , pcols ,lchnk) + call outfld('A_ACC', acc_crm_a , pcols ,lchnk) + call outfld('A_EVPC', evpc_crm_a , pcols ,lchnk) + call outfld('A_EVPR', evpr_crm_a , pcols ,lchnk) + call outfld('A_MLT', mlt_crm_a , pcols ,lchnk) + call outfld('A_SUB', sub_crm_a , pcols ,lchnk) + call outfld('A_DEP', dep_crm_a , pcols ,lchnk) + call outfld('A_CON', con_crm_a , pcols ,lchnk) + endif + + if(do_clubb_sgs) then + call outfld('UP2 ' , clubb_buffer(:, :, :, :, 1) ,pcols ,lchnk) + call outfld('VP2 ' , clubb_buffer(:, :, :, :, 2) ,pcols ,lchnk) + call outfld('WPRTP ' , clubb_buffer(:, :, :, :, 3) ,pcols ,lchnk) + call outfld('WPTHLP ' , clubb_buffer(:, :, :, :, 4) ,pcols ,lchnk) + call outfld('WP2 ' , clubb_buffer(:, :, :, :, 5) ,pcols ,lchnk) + call outfld('WP3 ' , clubb_buffer(:, :, :, :, 6) ,pcols ,lchnk) + call outfld('RTP2 ' , clubb_buffer(:, :, :, :, 7) ,pcols ,lchnk) + call outfld('THLP2 ' , clubb_buffer(:, :, :, :, 8) ,pcols ,lchnk) + call outfld('RTPTHLP ' , clubb_buffer(:, :, :, :, 9) ,pcols ,lchnk) + call outfld('UPWP ' , clubb_buffer(:, :, :, :, 10) ,pcols ,lchnk) + call outfld('VPWP ' , clubb_buffer(:, :, :, :, 11) ,pcols ,lchnk) + call outfld('CRM_CLD ' , clubb_buffer(:, :, :, :, 12) ,pcols ,lchnk) + call outfld('T_TNDCY ' , clubb_buffer(:, :, :, :, 13) ,pcols ,lchnk) + call outfld('QC_TNDCY' , clubb_buffer(:, :, :, :, 14) ,pcols ,lchnk) + call outfld('QV_TNDCY' , clubb_buffer(:, :, :, :, 15) ,pcols ,lchnk) + call outfld('CLUBB_TK ', clubb_tk(:, :, :, :) ,pcols ,lchnk) + call outfld('CLUBB_TKH', clubb_tkh(:, :, :, :) ,pcols ,lchnk) + call outfld('CRM_RELVAR', relvar(:, :, :, :) ,pcols ,lchnk) + call outfld('QCLVAR' , qclvar(:, :, :, :) ,pcols ,lchnk) + call outfld('ACCRE_ENHAN', accre_enhan(:, :, :, :) ,pcols ,lchnk) + + spup2 = 0.0_r8; spvp2 = 0.0_r8; spwprtp = 0.0_r8; spwpthlp = 0.0_r8 + spwp2 = 0.0_r8; spwp3 = 0.0_r8; sprtp2 = 0.0_r8; spthlp2 = 0.0_r8 + sprtpthlp = 0.0_r8; spupwp = 0.0_r8; spvpwp = 0.0_r8; spcrm_cld = 0.0_r8 + spt_tndcy = 0.0_r8; spqc_tndcy = 0.0_r8; spqv_tndcy = 0.0_r8 + spclubb_tk = 0.0_r8; spclubb_tkh = 0.0_r8 + sprelvar = 0.0_r8; spaccre_enhan = 0.0_r8; spqclvar = 0.0_r8 + + do i=1, ncol + do jj=1, crm_ny + do ii=1, crm_nx + do m=1, crm_nz+1 + k = pver-m+1 + spup2(i,k) = spup2(i,k) + clubb_buffer(i, ii, jj, m, 1) / (crm_nx_ny) + spvp2(i,k) = spvp2(i,k) + clubb_buffer(i, ii, jj, m, 2) / (crm_nx_ny) + spwprtp(i,k) = spwprtp(i,k) + clubb_buffer(i, ii, jj, m, 3) / (crm_nx_ny) + spwpthlp(i,k) = spwpthlp(i,k) + clubb_buffer(i, ii, jj, m, 4) / (crm_nx_ny) + spwp2(i,k) = spwp2(i,k) + clubb_buffer(i, ii, jj, m, 5) / (crm_nx_ny) + spwp3(i,k) = spwp3(i,k) + clubb_buffer(i, ii, jj, m, 6) / (crm_nx_ny) + sprtp2(i,k) = sprtp2(i,k) + clubb_buffer(i, ii, jj, m, 7) / (crm_nx_ny) + spthlp2(i,k) = spthlp2(i,k) + clubb_buffer(i, ii, jj, m, 8) / (crm_nx_ny) + sprtpthlp(i,k) = sprtpthlp(i,k) + clubb_buffer(i, ii, jj, m, 9) / (crm_nx_ny) + spupwp(i,k) = spupwp(i,k) + clubb_buffer(i, ii, jj, m, 10) / (crm_nx_ny) + spupwp(i,k) = spupwp(i,k) + clubb_buffer(i, ii, jj, m, 11) / (crm_nx_ny) + spcrm_cld(i,k) = spcrm_cld(i,k) + clubb_buffer(i, ii, jj, m, 12) / (crm_nx_ny) + spt_tndcy(i,k) = spt_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 13) / (crm_nx_ny) + spqc_tndcy(i,k) = spqc_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 14) / (crm_nx_ny) + spqv_tndcy(i,k) = spqv_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 15) / (crm_nx_ny) + end do + do m=1, crm_nz + k = pver-m+1 + spclubb_tk(i,k) = spclubb_tk(i,k) + clubb_tk(i, ii, jj, m) / (crm_nx_ny) + spclubb_tkh(i,k) = spclubb_tkh(i,k) + clubb_tkh(i, ii, jj, m) / (crm_nx_ny) + sprelvar(i,k) = sprelvar(i,k) + relvar(i, ii, jj, m) / (crm_nx_ny) + spaccre_enhan(i,k) = spaccre_enhan(i,k) + accre_enhan(i, ii, jj, m) / (crm_nx_ny) + spqclvar(i,k) = spqclvar(i,k) + qclvar(i, ii, jj, m) / (crm_nx_ny) + end do + end do + end do + end do + + call outfld('SPUP2', spup2 ,pcols ,lchnk) + call outfld('SPVP2', spvp2 ,pcols ,lchnk) + call outfld('SPWPRTP', spwprtp ,pcols ,lchnk) + call outfld('SPWPTHLP', spwpthlp ,pcols ,lchnk) + call outfld('SPWP2', spwp2 ,pcols ,lchnk) + call outfld('SPWP3', spwp3 ,pcols ,lchnk) + call outfld('SPRTP2', sprtp2 ,pcols ,lchnk) + call outfld('SPTHLP2', spthlp2 ,pcols ,lchnk) + call outfld('SPRTPTHLP', sprtpthlp ,pcols ,lchnk) + call outfld('SPUPWP', spupwp ,pcols ,lchnk) + call outfld('SPVPWP', spvpwp ,pcols ,lchnk) + call outfld('SPCRM_CLD', spcrm_cld ,pcols ,lchnk) + call outfld('SPT_TNDCY', spt_tndcy ,pcols ,lchnk) + call outfld('SPQC_TNDCY', spqc_tndcy ,pcols ,lchnk) + call outfld('SPQV_TNDCY', spqv_tndcy ,pcols ,lchnk) + call outfld('SPCLUBB_TK ', spclubb_tk ,pcols ,lchnk) + call outfld('SPCLUBB_TKH', spclubb_tkh ,pcols ,lchnk) + call outfld('SPRELVAR', sprelvar ,pcols, lchnk) + call outfld('SPACCRE_ENHAN', spaccre_enhan ,pcols, lchnk) + call outfld('SPQCLVAR', spqclvar ,pcols, lchnk) + endif ! if do_clubb_sgs + + spcld3d = 0.0_r8 + do i=1, ncol + do jj=1, crm_ny + do ii=1, crm_nx + do m=1, crm_nz + k = pver-m+1 + spcld3d(i,k) = spcld3d(i,k) + cld3d_crm(i,ii,jj,m) / (crm_nx_ny) + end do + end do + end do + end do + call outfld('SPCLD3D', spcld3d, pcols, lchnk) + + ifld = pbuf_get_index('QRL') + call pbuf_get_field(pbuf, ifld, qrl) + ifld = pbuf_get_index('QRS') + call pbuf_get_field(pbuf, ifld, qrs) + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)/state_loc%pdel(i,k) + qrl(i,k) = qrl(i,k)/state_loc%pdel(i,k) + end do + end do + + ! + ! add radiation tendencies to levels above CRM domain and 2 top CRM levels + ! The radiation tendencies in the top 4 GCM levels are set to be zero in the CRM + ptend_loc%s(:ncol, :pver-crm_nz+2) = qrs(:ncol,:pver-crm_nz+2)+qrl(:ncol,:pver-crm_nz+2) + + + ! calculate the radiative fluxes from the radiation calculation + ! This will be used to check energe conservations + radflux(:) = 0.0_r8 + do k=1, pver + do i=1, ncol + radflux(i) = radflux(i) + (qrs(i,k)+qrl(i,k)) * state_loc%pdel(i,k)/gravit + end do + end do + + ftem(:ncol,:pver) = (ptend_loc%s(:ncol,:pver)-qrs(:ncol,:pver)-qrl(:ncol,:pver))/cpair + + tmp2d(:ncol,:) = qrl(:ncol,:)/cpair + call outfld('SPQRL ',tmp2d ,pcols ,lchnk) + + tmp2d(:ncol,:) = qrs(:ncol,:)/cpair + call outfld('SPQRS ',tmp2d ,pcols ,lchnk) + + call outfld('SPDT ',ftem ,pcols ,lchnk) + call outfld('SPDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk) + call outfld('SPDQC ',ptend_loc%q(1,1,ixcldliq) ,pcols ,lchnk) + call outfld('SPDQI ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk) + call outfld('SPMC ',mctot ,pcols ,lchnk) + call outfld('SPMCUP ',mcup ,pcols ,lchnk) + call outfld('SPMCDN ',mcdn ,pcols ,lchnk) + call outfld('SPMCUUP ',mcuup ,pcols ,lchnk) + call outfld('SPMCUDN ',mcudn ,pcols ,lchnk) + call outfld('SPQC ',spqc ,pcols ,lchnk) + call outfld('SPQI ',spqi ,pcols ,lchnk) + call outfld('SPQS ',spqs ,pcols ,lchnk) + call outfld('SPQG ',spqg ,pcols ,lchnk) + call outfld('SPQR ',spqr ,pcols ,lchnk) + call outfld('SPQTFLX ',flux_qt ,pcols ,lchnk) + call outfld('SPUFLX ',flux_u ,pcols ,lchnk) + call outfld('SPVFLX ',flux_v ,pcols ,lchnk) + call outfld('SPTKE ',tkez ,pcols ,lchnk) + call outfld('SPTKES ',tkesgsz ,pcols ,lchnk) + call outfld('SPTK ',tk_crm ,pcols ,lchnk) + call outfld('SPQTFLXS',fluxsgs_qt ,pcols ,lchnk) + call outfld('SPQPFLX ',flux_qp ,pcols ,lchnk) + call outfld('SPPFLX ',precflux ,pcols ,lchnk) + call outfld('SPQTLS ',qt_ls ,pcols ,lchnk) + call outfld('SPQTTR ',qt_trans ,pcols ,lchnk) + call outfld('SPQPTR ',qp_trans ,pcols ,lchnk) + call outfld('SPQPEVP ',qp_evp ,pcols ,lchnk) + call outfld('SPQPFALL',qp_fall ,pcols ,lchnk) + call outfld('SPQPSRC ',qp_src ,pcols ,lchnk) + call outfld('SPTLS ',t_ls ,pcols ,lchnk) + call outfld('CLOUDTOP',cldtop ,pcols ,lchnk) + call outfld('TIMINGF ',timing_factor ,pcols ,lchnk) + + if (is_spcam_m2005) then + call outfld('SPNC ',spnc ,pcols ,lchnk) + call outfld('SPNI ',spni ,pcols ,lchnk) + call outfld('SPNS ',spns ,pcols ,lchnk) + call outfld('SPNG ',spng ,pcols ,lchnk) + call outfld('SPNR ',spnr ,pcols ,lchnk) + endif + + if (.not. do_clubb_sgs) then + call outfld('CLDTOT ',cltot ,pcols,lchnk) + call outfld('CLDHGH ',clhgh ,pcols,lchnk) + call outfld('CLDMED ',clmed ,pcols,lchnk) + call outfld('CLDLOW ',cllow ,pcols,lchnk) + call outfld('CLOUD ',cld, pcols,lchnk) + end if + + ! + ! Compute liquid water paths (for diagnostics only) + tgicewp(:ncol) = 0._r8 + tgliqwp(:ncol) = 0._r8 + do k=1,pver + do i = 1,ncol + cicewp(i,k) = gicewp(i,k) * 1.0e-3_r8 / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. g/m2 --> kg/m2 + cliqwp(i,k) = gliqwp(i,k) * 1.0e-3_r8 / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. g/m2 --> kg/m2 + tgicewp(i) = tgicewp(i) + gicewp(i,k) *1.0e-3_r8 ! grid cell mean ice water path. g/m2 --> kg/m2 + tgliqwp(i) = tgliqwp(i) + gliqwp(i,k) *1.0e-3_r8 ! grid cell mean ice water path. g/m2 --> kg/m2 + end do + end do + tgwp(:ncol) = tgicewp(:ncol) + tgliqwp(:ncol) + gwp(:ncol,:pver) = gicewp(:ncol,:pver) + gliqwp(:ncol,:pver) + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + + + call outfld('SPCLDTOT',cltot ,pcols,lchnk) + call outfld('SPCLDHGH',clhgh ,pcols,lchnk) + call outfld('SPCLDMED',clmed ,pcols,lchnk) + call outfld('SPCLDLOW',cllow ,pcols,lchnk) + + if(do_clubb_sgs) then + ! Determine parameters for maximum/random overlap +#ifdef SPCAM_CLUBB_SGS + call cldovrlap(lchnk, ncol, state%pint, cld, nmxrgn, pmxrgn) + call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) +#endif + deallocate(pmxrgn) + deallocate(nmxrgn) + deallocate(spup2) + deallocate(spvp2) + deallocate(spwprtp) + deallocate(spwpthlp) + deallocate(spwp2) + deallocate(spwp3) + deallocate(sprtp2) + deallocate(spthlp2) + deallocate(sprtpthlp) + deallocate(spupwp) + deallocate(spvpwp) + deallocate(spcrm_cld) + deallocate(spt_tndcy) + deallocate(spqv_tndcy) + deallocate(spqc_tndcy) + deallocate(spclubb_tk) + deallocate(spclubb_tkh) + deallocate(sprelvar) + deallocate(spaccre_enhan) + deallocate(spqclvar) + deallocate(crm_cld) + deallocate(clubb_tk) + deallocate(clubb_tkh) + deallocate(relvar) + deallocate(accre_enhan) + deallocate(qclvar) + endif + + call outfld('CLOUDTOP',cldtop, pcols,lchnk) + call outfld('GCLDLWP' ,gwp , pcols,lchnk) + call outfld('TGCLDCWP',tgwp , pcols,lchnk) + call outfld('TGCLDLWP',tgliqwp, pcols,lchnk) + call outfld('TGCLDIWP',tgicewp, pcols,lchnk) + call outfld('ICLDTWP' ,cwp , pcols,lchnk) + call outfld('ICLDIWP' ,cicewp , pcols,lchnk) + + ! Calculate fields which are needed elsewhere in CAM + call pbuf_get_Field(pbuf, ast_idx, cld) ! AST gets values in cld + + ! Find the cldtop for the physics buffer looking for the first location that has a value in the CRM cldtop field + call pbuf_get_field(pbuf, cldtop_idx, cldtop_pbuf) + cldtop_pbuf = pver + do i=1,ncol + do k=1,pver + if (cldtop(i,k) > 1._r8/(crm_nx_ny)) then + cldtop_pbuf(i)=k + exit + end if + end do + end do + + cs(:ncol, 1:pver) = state_loc%pmid(:ncol, 1:pver) / (287.15_r8*state_loc%t(:ncol, 1:pver)) + + call pbuf_get_Field(pbuf, wsedl_idx, wsedl) + if (is_spcam_m2005) then + dunc_arr(:,:) = state_loc%q(:,:,ixnumliq)/ max(mincld,cld(:,:)) + else + dunc_arr(:ncol,1:pver) = 100.e6_r8 / cs(:ncol,1:pver) + end if + do i=1,ncol + do k=1,pver + t = state_loc%t(i,k) + mu = 1.496e-6_r8 * t**1.5_r8/(t+120._r8) + acn = gravit*rhow/(18._r8*mu) + dumc = min( state_loc%q(i,k,ixcldliq) / max(mincld,cld(i,k)),0.005_r8 ) + dunc = dunc_arr(i,k) + call size_dist_param_liq(mg_liq_props, dumc,dunc,cs(i,k),pgam,lamc) + if (dumc >= qsmall) then + wsedl(i,k)=acn*gamma(4._r8+bc+pgam)/(lamc**bc*gamma(pgam+4._r8)) + else + wsedl(i,k)=0._r8 + endif + end do + end do + + if (is_spcam_m2005) then + + ! For convective transport + do i=1, ncol + ideep_crm(i) = i*1.0_r8 + end do + endif + call outfld('MU_CRM ', mu_crm, pcols, lchnk) + call outfld('MD_CRM ', md_crm, pcols, lchnk) + call outfld('EU_CRM ', eu_crm, pcols, lchnk) + call outfld('DU_CRM ', du_crm, pcols, lchnk) + call outfld('ED_CRM ', ed_crm, pcols, lchnk) + +! NAG requires ifdef because tk_crm_ecpp dereferened when not allocated +#ifdef m2005 + if (is_spcam_m2005) then + + qlsinkcen = qlsink_avgcen + + ! copy local tk_crm into pbuf copy + tk_crm_ecpp = tk_crm + + call outfld('ACEN ' , acen , pcols, lchnk) + call outfld('ABND ' , abnd , pcols, lchnk) + call outfld('ACEN_TF ' , acen_tf , pcols, lchnk) + call outfld('ABND_TF ' , abnd_tf , pcols, lchnk) + call outfld('MASFBND ' , massflxbnd , pcols, lchnk) + call outfld('RHCEN ' , rhcen , pcols, lchnk) + call outfld('QCCEN ' , qcloudcen , pcols, lchnk) + call outfld('QICEN ' , qicecen , pcols, lchnk) + call outfld('QSINK_AFCEN' , qlsink_afcen , pcols, lchnk) + call outfld('PRECRCEN' , precrcen , pcols, lchnk) + call outfld('PRECSCEN' , precsolidcen , pcols, lchnk) + call outfld('WUPTHRES' , wupthresh_bnd , pcols, lchnk) + call outfld('WDNTHRES' , wdownthresh_bnd , pcols, lchnk) + call outfld('WWQUI_CEN' , wwqui_cen , pcols, lchnk) + call outfld('WWQUI_CLD_CEN', wwqui_cloudy_cen , pcols, lchnk) + call outfld('WWQUI_BND' , wwqui_bnd , pcols, lchnk) + call outfld('WWQUI_CLD_BND', wwqui_cloudy_bnd , pcols, lchnk) + call outfld('QSINK_BFCEN' , qlsink_bfcen , pcols, lchnk) + call outfld('QSINK_AVGCEN' , qlsink_avgcen , pcols, lchnk) + call outfld('PRAINCEN' , praincen , pcols, lchnk) + endif +#endif + + if (is_spcam_m2005) then + call cnst_get_ind('NUMLIQ', ixnumliq) + call cnst_get_ind('NUMICE', ixnumice) + ptend_loc%lq(ixnumliq) = .TRUE. + ptend_loc%lq(ixnumice) = .TRUE. + ptend_loc%q(:, :, ixnumliq) = 0._r8 + ptend_loc%q(:, :, ixnumice) = 0._r8 + + do i = 1, ncol + do k=1, crm_nz + m= pver-k+1 + do ii=1, crm_nx + do jj=1, crm_ny + ptend_loc%q(i,m,ixnumliq) = ptend_loc%q(i,m,ixnumliq) + crm_nc(i,ii,jj,k) + ptend_loc%q(i,m,ixnumice) = ptend_loc%q(i,m,ixnumice) + crm_ni(i,ii,jj,k) + end do + end do + ptend_loc%q(i,m,ixnumliq) = (ptend_loc%q(i,m,ixnumliq)/(crm_nx_ny) - state_loc%q(i,m,ixnumliq))/ztodt + ptend_loc%q(i,m,ixnumice) = (ptend_loc%q(i,m,ixnumice)/(crm_nx_ny) - state_loc%q(i,m,ixnumice))/ztodt + end do + end do + end if + + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + + call physics_update(state_loc, ptend_loc, ztodt, tend_loc) + + ! calculate column water of rain, snow and graupel + if(is_spcam_m2005) then + do i=1, ncol + qt_hydro(i, 2) = 0.0_r8 + qli_hydro(i, 2) = 0.0_r8 + qi_hydro(i, 2) = 0.0_r8 + qtot(i, 3) = 0.0_r8 + qt_cloud(i, 3) = 0.0_r8 + qtv(i, 3) = 0.0_r8 + do m=1, crm_nz + k=pver-m+1 + do ii=1, crm_nx + do jj=1, crm_ny + qt_hydro(i,2) = qt_hydro(i,2) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + qli_hydro(i,2) = qli_hydro(i,2) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + qi_hydro(i,2) = qi_hydro(i,2) + (crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + qtot(i, 3) = qtot(i,3) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + (crm_qt(i,ii,jj,m)+crm_qi(i,ii,jj,m)) * state_loc%pdel(i,k)/gravit + qt_cloud(i, 3) = qt_cloud(i, 3) + (crm_qt(i,ii,jj,m)+crm_qi(i,ii,jj,m)) * & + state_loc%pdel(i,k)/gravit + end do + end do + end do + qt_hydro(i,2) = qt_hydro(i,2) / (crm_nx_ny) + qli_hydro(i,2) = qli_hydro(i,2) / (crm_nx_ny) + qi_hydro(i,2) = qi_hydro(i,2) / (crm_nx_ny) + qtot(i, 3) = qtot(i, 3) / (crm_nx_ny) + qt_cloud(i, 3) = qt_cloud(i, 3) / (crm_nx_ny) + end do + else if(is_spcam_sam1mom) then + do i=1, ncol + qli_hydro(i, 2) = 0.0_r8 + qi_hydro(i, 2) = 0.0_r8 + do m=1, crm_nz + k=pver-m+1 + do ii=1, crm_nx + do jj=1, crm_ny + sfactor = max(0._r8,min(1._r8,(crm_t(i,ii,jj,m)-268.16_r8)*1._r8/(283.16_r8-268.16_r8))) + qli_hydro(i,2) = qli_hydro(i,2)+crm_qp(i,ii,jj,m) * state_loc%pdel(i,k)/gravit + qi_hydro(i,2) = qi_hydro(i,2) +crm_qp(i,ii,jj,m) * (1-sfactor) * state_loc%pdel(i,k)/gravit + end do + end do + end do + qli_hydro(i,2) = qli_hydro(i,2) / (crm_nx_ny) + qi_hydro(i,2) = qi_hydro(i,2) / (crm_nx_ny) + + ! total cloud water and total water vapor, and energy + qt_cloud(i,2) = 0._r8 + qtv(i,2) = 0._r8 + do k=1, pver + qt_cloud(i,2) = qt_cloud(i,2) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit + qtv(i,2) = qtv(i,2) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit + end do + end do + end if + + ! check water and energy conservation + call check_energy_chng(state_loc, tend_loc, "crm_tend", nstep, ztodt, zero, & + prec_dp(:ncol)+(qli_hydro(:ncol,2)-qli_hydro(:ncol,1))/ztodt/1000._r8, & + snow_dp(:ncol)+(qi_hydro(:ncol,2)-qi_hydro(:ncol,1))/ztodt/1000._r8, radflux) + + ! + ! calculate total water after crm update + ! total hydrometer water (rain, snow, and graupel) + if (is_spcam_m2005) then + do i=1, ncol + + ! total cloud water and total water vapor + qt_cloud(i,2) = 0._r8 + qtv(i,2) = 0._r8 + do k=1, pver + qt_cloud(i,2) = qt_cloud(i,2) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit + qtv(i,2) = qtv(i,2) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit + end do + ! total water + qtot(i,2) = qt_hydro(i,2) + qt_cloud(i,2) + qtv(i,2) + + ! to check water conservations + if(abs((qtot(i,2)+(precc(i)+precl(i))*1000_r8*ztodt)-qtot(i,1))/qtot(i,1).gt.1.0e-5_r8) then + write(0, *) 'water before crm call', i, lchnk, qtot(i,1), qtv(i,1), qt_cloud(i,1), qt_hydro(i,1) + write(0, *) 'water after crm call', i, lchnk, qtot(i,2)+(precc(i)+precl(i))*1000*ztodt, & + qtv(i,2), qt_cloud(i,2), qt_hydro(i,2), (precc(i)+precl(i))*1000*ztodt + write(0, *) 'water, nstep, crm call2', nstep, i, lchnk, & + ((qtot(i,2)+(precc(i)+precl(i))*1000_r8*ztodt)-qtot(i,1))/qtot(i,1) + write(0, *) 'water, calcualted in crm.F90', i, lchnk, qtotcrm(i, 1), qtotcrm(i, 9), & + qtot(i, 3)+(precc(i)+precl(i))*1000_r8*ztodt, qt_cloud(i, 3), qtv(i,2)+qt_cloud(i,2) + write(0, *) 'water, temperature', i, lchnk, state_loc%t(i,pver) + end if + end do ! end i + endif + + end if ! (is_first_step()) + + call t_stopf('crm') + +! ifdef needed because of use of dtstep_pp_input and spcam_modal_aero_wateruptake_dr +#ifdef m2005 + if (is_spcam_m2005) then + call t_startf('bc_aerosols_mmf') + + where(qc_rad(:ncol,:,:,:crm_nz)+qi_rad(:ncol,:,:,:crm_nz) > 1.0e-10_r8) + cld_rad(:ncol,:,:,:crm_nz) = cld_rad(:ncol,:,:,:crm_nz) + elsewhere + cld_rad(:ncol,:,:,:crm_nz) = 0.0_r8 + endwhere + + ! temporarily turn on all lq, so it is allocated + lq(:) = .true. + call physics_ptend_init(ptend_loc, state_loc%psetcols, 'crm_physics', lq=lq) + + ! set all ptend%lq to false as they will be set in modal_aero_calcsize_sub + ptend%lq(:) = .false. + call modal_aero_calcsize_sub (state_loc, ptend_loc, ztodt, pbuf) + call spcam_modal_aero_wateruptake_dr(state_loc, pbuf) + + ! Wet deposition is done in ECPP, + ! So tendency from wet depostion is not updated in mz_aero_wet_intr (mz_aerosols_intr.F90) + ! tendency from other parts of crmclouds_aerosol_wet_intr are still updated here. + + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + call physics_update(state_loc, ptend_loc, ztodt, tend_loc) + + + pblh_idx = pbuf_get_index('pblh') + call pbuf_get_field(pbuf, pblh_idx, pblh) + + ! + ! ECPP is called at every 3rd GCM time step. + ! GCM time step is 10 minutes, and ECPP time step is 30 minutes. + ! + dtstep_pp = dtstep_pp_input + necpp = dtstep_pp/ztodt + + ! Only call ECPP every necpp th time step + ! !!!BE CAUTIOUS (Minghuai Wang, 2017-02)!!!!: + ! ptend_loc from crmclouds_mixnuc_tend and parampollu_driver2 has + ! to be multiplied by necpp, as the updates in state occure in tphysbc_spcam, + ! and the normal time step used in tphysbc_spcam is short + ! and ECPP time step is longer (by a facotr of ncecpp). + ! Otherwise, this will lead to underestimation in wet scavenging. + ! + if(nstep.ne.0 .and. mod(nstep, necpp).eq.0) then + call t_startf('crmclouds_mixnuc') + + call crmclouds_mixnuc_tend (state_loc, ptend_loc, dtstep_pp, cam_in%cflx, pblh, pbuf, & + wwqui_cen, wwqui_cloudy_cen, wwqui_bnd, wwqui_cloudy_bnd) + + ! scale ptend_loc by necpp + call physics_ptend_scale(ptend_loc, necpp*1.0_r8, ncol) + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + call physics_update(state_loc, ptend_loc, ztodt, tend_loc) + call t_stopf('crmclouds_mixnuc') + + call t_startf('ecpp') + call parampollu_driver2(state_loc, ptend_loc, pbuf, dtstep_pp, dtstep_pp, & + acen, abnd, acen_tf, abnd_tf, massflxbnd, & + rhcen, qcloudcen, qlsinkcen, precrcen, precsolidcen, acldy_cen_tbeg ) + ! scale ptend_loc by necpp + call physics_ptend_scale(ptend_loc, necpp*1.0_r8, ncol) + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + call physics_update(state_loc, ptend_loc, ztodt, tend_loc) + call t_stopf ('ecpp') + end if + + + call t_stopf('bc_aerosols_mmf') + endif ! /*m2005*/ +#endif + + ! save for old cloud fraction in the MMF simulations + cldo(:ncol, :) = cld(:ncol, :) + + deallocate(crm_micro) + + if (is_spcam_m2005) then + deallocate(acen) + deallocate(acen_tf) + deallocate(rhcen) + deallocate(qcloudcen) + deallocate(qlsinkcen) + deallocate(precrcen) + deallocate(precsolidcen) + deallocate(wwqui_cen) + deallocate(wwqui_cloudy_cen) + deallocate(abnd) + deallocate(abnd_tf) + deallocate(massflxbnd) + deallocate(wwqui_bnd) + deallocate(wwqui_cloudy_bnd) + deallocate(qicecen) + deallocate(qlsink_afcen) + deallocate(qlsink_bfcen) + deallocate(qlsink_avgcen) + deallocate(praincen) + deallocate(wupthresh_bnd) + deallocate(wdownthresh_bnd) + + deallocate(na) + deallocate(va) + deallocate(hy) + deallocate(naermod) + deallocate(vaerosol) + deallocate(hygro) + end if + +#endif + +end subroutine crm_physics_tend + +!===================================================================================================== + +subroutine m2005_effradius(ql, nl,qi,ni,qs, ns, cld, pres, tk, effl, effi, effl_fn, deffi, lamcrad, pgamrad, des) +!----------------------------------------------------------------------------------------------------- +! +! This subroutine is used to calculate droplet and ice crystal effective radius, which will be used +! in the CAM radiation code. The method to calcualte effective radius is taken out of the Morrision's +! two momenent scheme from M2005MICRO_GRAUPEL. It is also very similar with the subroutine of effradius in +! the module of cldwat2m in the CAM source codes. +! +! Adopted by Minghuai Wang (Minghuai.Wang@pnl.gov). +! +!----------------------------------------------------------------------------------------------------- + ! ----------------------------------------------------------- ! + ! Calculate effective radius for pass to radiation code ! + ! If no cloud water, default value is 10 micron for droplets, ! + ! 25 micron for cloud ice. ! + ! Be careful of the unit of effective radius : [micro meter] ! + ! ----------------------------------------------------------- ! + use shr_spfn_mod, only: gamma => shr_spfn_gamma + implicit none + + real(r8), intent(in) :: ql ! Mean LWC of pixels [ kg/kg ] + real(r8), intent(in) :: nl ! Grid-mean number concentration of cloud liquid droplet [#/kg] + real(r8), intent(in) :: qi ! Mean IWC of pixels [ kg/kg ] + real(r8), intent(in) :: ni ! Grid-mean number concentration of cloud ice droplet [#/kg] + real(r8), intent(in) :: qs ! mean snow water content [kg/kg] + real(r8), intent(in) :: ns ! Mean snow crystal number concnetration [#/kg] + real(r8), intent(in) :: cld ! Physical stratus fraction + real(r8), intent(in) :: pres ! Air pressure [Pa] + real(r8), intent(in) :: tk ! air temperature [K] + + real(r8), intent(out) :: effl ! Effective radius of cloud liquid droplet [micro-meter] + real(r8), intent(out) :: effi ! Effective radius of cloud ice droplet [micro-meter] + real(r8), intent(out) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 + real(r8), intent(out) :: deffi ! ice effective diameter for optics (radiation) + real(r8), intent(out) :: pgamrad ! gamma parameter for optics (radiation) + real(r8), intent(out) :: lamcrad ! slope of droplet distribution for optics (radiation) + real(r8), intent(out) :: des ! snow effective diameter for optics (radiation) [micro-meter] + +#ifdef CRM + real(r8) qlic ! In-cloud LWC [kg/m3] + real(r8) qiic ! In-cloud IWC [kg/m3] + real(r8) nlic ! In-cloud liquid number concentration [#/kg] + real(r8) niic ! In-cloud ice number concentration [#/kg] + + real(r8) cldm ! Constrained stratus fraction [no] + real(r8) mincld ! Minimum stratus fraction [no] + + real(r8) lami, laml, lammax, lammin, pgam, lams, lammaxs, lammins + + real(r8) dcs !autoconversion size threshold [meter] + real(r8) di, ci ! cloud ice mass-diameter relationship + real(r8) ds, cs ! snow crystal mass-diameter relationship + real(r8) qsmall + real(r8) rho ! air density [kg/m3] + real(r8) rhow ! liquid water density [kg/m3] + real(r8) rhoi ! ice density [kg/m3] + real(r8) rhos ! snow density [kg/m3] + real(r8) res ! effective snow diameters + real(r8) pi + + ! ---------------- ! + ! Main computation ! + ! ---------------- ! + + pi = 3.1415926535897932384626434_r8 + qsmall = 1.0e-14_r8 ! in the SAM source code (module_mp_graupel) + rhow = 997._r8 ! in module_mp_graupel, SAM + rhoi = 500._r8 ! in both CAM and SAM + + dcs = 125.e-6_r8 ! in module_mp_graupel, SAM + ci = rhoi * pi/6._r8 + di = 3._r8 + + ! for snow water + rhos = 100._r8 ! in both SAM and CAM5 + cs = rhos*pi/6._r8 + ds = 3._r8 + + + rho = pres / (287.15_r8*tk) ! air density [kg/m3] + + mincld = 0.0001_r8 + cldm = max(cld,mincld) + qlic = min(5.e-3_r8,max(0._r8,ql/cldm)) + qiic = min(5.e-3_r8,max(0._r8,qi/cldm)) + nlic = max(nl,0._r8)/cldm + niic = max(ni,0._r8)/cldm + +!------------------------------------------------------ +! Effective diameters of snow crystals +!------------------------------------------------------ + if(qs.gt.1.0e-7_r8) then + lammaxs=1._r8/10.e-6_r8 + lammins=1._r8/2000.e-6_r8 + lams = (gamma(1._r8+ds)*cs * ns/qs)**(1._r8/ds) + lams = min(lammaxs,max(lams,lammins)) + res = 1.5_r8/lams*1.0e6_r8 + else + res = 500._r8 + end if + + ! + ! from Hugh Morrision: rhos/917 accouts for assumptions about + ! ice density in the Mitchell optics. + ! + des = res * rhos/917._r8 *2._r8 + + ! ------------------------------------- ! + ! Effective radius of cloud ice droplet ! + ! ------------------------------------- ! + + if( qiic.ge.qsmall ) then + niic = min(niic,qiic*1.e20_r8) + lammax = 1._r8/1.e-6_r8 ! in module_mp_graupel, SAM + lammin = 1._r8/(2._r8*dcs+100.e-6_r8) ! in module_mp_graupel, SAM + lami = (gamma(1._r8+di)*ci*niic/qiic)**(1._r8/di) + lami = min(lammax,max(lami,lammin)) + effi = 1.5_r8/lami*1.e6_r8 + else + effi = 25._r8 + endif + + !--hm ice effective radius for david mitchell's optics + !--ac morrison indicates that this is effective diameter + !--ac morrison indicates 917 (for the density of pure ice..) + deffi = effi *rhoi/917._r8*2._r8 + + ! ---------------------------------------- ! + ! Effective radius of cloud liquid droplet ! + ! ---------------------------------------- ! + + if( qlic.ge.qsmall ) then + ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). + ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) + nlic = min(nlic,qlic*1.e20_r8) + + ! set the minimum droplet number as 20/cm3. + + pgam = 0.0005714_r8*(nlic*rho/1.e6_r8) + 0.2714_r8 + pgam = 1._r8/(pgam**2)-1._r8 + pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM + laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) + lammin = (pgam+1._r8)/50.e-6_r8 ! in cldwat2m, CAM + lammax = (pgam+1._r8)/2.e-6_r8 ! in cldwat2m, CAM ! cldwat2m should be used, + ! if lammax is too large, this will lead to crash in + ! src/physics/rrtmg/cloud_rad_props.F90 because + ! klambda-1 can be zero in gam_liquid_lw and gam_liquid_sw + ! and g_lambda(kmu,klambda-1) will not be defined. + + laml = min(max(laml,lammin),lammax) + effl = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM + lamcrad = laml + pgamrad = pgam + else + ! chose 10. over 25, since 10 is a more reasonable value for liquid droplet + effl = 10._r8 ! in cldwat2m, CAM + lamcrad = 0.0_r8 + pgamrad = 0.0_r8 + endif + + ! ---------------------------------------------------------------------- ! + ! Recalculate effective radius for constant number, in order to separate ! + ! first and second indirect effects. Assume constant number of 10^8 kg-1 ! + ! ---------------------------------------------------------------------- ! + + nlic = 1.e8_r8 + if( qlic.ge.qsmall ) then + ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). + ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) + nlic = min(nlic,qlic*1.e20_r8) + pgam = 0.0005714_r8*(nlic/1.e6_r8/rho) + 0.2714_r8 + pgam = 1._r8/(pgam**2)-1._r8 + pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM + laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) + lammin = (pgam+1._r8)/60.e-6_r8 ! in module_mp_graupel, SAM + lammax = (pgam+1._r8)/1.e-6_r8 ! in module_mp_graupel, SAM + + laml = min(max(laml,lammin),lammax) + effl_fn = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM + else + ! chose 10. over 25, since 10 is a more reasonable value for liquid droplet. + effl_fn = 10._r8 ! in cldwat2m, CAM + endif + + return +#endif +end subroutine m2005_effradius + +end module crm_physics diff --git a/src/physics/spcam/crmclouds_camaerosols.F90 b/src/physics/spcam/crmclouds_camaerosols.F90 new file mode 100644 index 0000000000..5b480a8329 --- /dev/null +++ b/src/physics/spcam/crmclouds_camaerosols.F90 @@ -0,0 +1,744 @@ +module crmclouds_camaerosols +#if (defined CRM) +#if (defined MODAL_AERO) +!--------------------------------------------------------------------------------------------- +! Purpose: +! +! Provides the necessary subroutines to use cloud fields from the CRM model to drive the +! aerosol-related subroutines in CAM. Several taskes: +! i) to fill the physics buffers with those diagnosed from the CRM clouds. +! ii) to provide the interface for some physics prcoesses, such as droplet activaiton, +! and convetive transport. +! +! An alternative (and better?) approach is to use the ECPP (explicit-cloud parameterized-pollutant). +! This will be done later. +! +! Revision history: +! July, 27, 2009: Minghuai Wang +! +!-------------------------------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid + use cam_abortutils, only: endrun + use crmdims, only: crm_nx, crm_ny, crm_nz + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx + use physics_types, only: physics_state, physics_state_copy, physics_ptend + use ref_pres, only: top_lev => clim_modal_aero_top_lev + use wv_saturation, only: qsat_water + implicit none + private + save + + public :: spcam_modal_aero_wateruptake_dr + public :: crmclouds_mixnuc_tend + public :: crmclouds_diag + public :: crmclouds_convect_tend + +!====================================================================================================== +contains + +subroutine spcam_modal_aero_wateruptake_dr(state,pbuf) + +!----------------------------------------------------------------------- +! +! SPCAM specific driver for modal aerosol water uptake code. +! +!----------------------------------------------------------------------- + + use time_manager, only: is_first_step + use modal_aero_wateruptake,only: modal_aero_wateruptake_sub + use physconst, only: pi, rhoh2o + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_props, rad_cnst_get_aer_props + + + ! Arguments + type(physics_state), target, intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + ! local variables + + real(r8), parameter :: third = 1._r8/3._r8 + real(r8), parameter :: pi43 = pi*4.0_r8/3.0_r8 + + integer :: ncol ! number of columns + + integer :: i, k, m + integer :: nmodes + integer :: nspec + integer :: mm + + integer :: dgnumwet_idx, qaerwat_idx, wetdens_ap_idx, cld_idx + + integer :: dgnum_idx = 0 + integer :: hygro_idx = 0 + integer :: dryvol_idx = 0 + integer :: dryrad_idx = 0 + integer :: drymass_idx = 0 + integer :: so4dryvol_idx = 0 + integer :: naer_idx = 0 + + real(r8), allocatable :: wtrvol_grid(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) + real(r8), allocatable :: wetvol_grid(:,:,:) ! single-particle-mean wet volume (m3) + real(r8), allocatable :: ncount_clear(:,:,:) ! to count the fraction of clear sky part + + real(r8), pointer :: h2ommr_crm(:,:,:,:) ! specfic humidity in CRM domain + real(r8), pointer :: t_crm(:,:,:,:) ! temperature at the CRM domain + real(r8), pointer :: cldn_crm(:,:,:,:) ! cloud fraction in CRM domain + real(r8), pointer :: qaerwat_crm(:, :, :, :, :) ! aerosol water at CRM domain + real(r8), pointer :: dgncur_awet_crm(:, :, :, :, :) ! wet mode diameter at CRM domain + + real(r8),allocatable :: es_crm(:) ! saturation vapor pressure + real(r8),allocatable :: qs_crm(:) ! saturation specific humidity + real(r8),allocatable :: cldnt(:,:) ! temporal variables + real(r8),allocatable :: rh_crm(:,:,:,:) ! Relative humidity at the CRM grid + real(r8),allocatable :: specdens_1(:) + + real(r8),pointer :: dgncur_a(:,:,:) + real(r8),pointer :: drymass(:,:,:) + real(r8),pointer :: dryrad(:,:,:) + + + real(r8), pointer :: dgncur_awet(:,:,:) + real(r8), pointer :: wetdens(:,:,:) + real(r8), pointer :: qaerwat(:,:,:) + + real(r8), pointer :: h2ommr(:,:) ! specific humidity + real(r8), pointer :: t(:,:) ! temperatures (K) + real(r8), pointer :: pmid(:,:) ! layer pressure (Pa) + real(r8), pointer :: cldn(:,:) ! layer cloud fraction (0-1) + + real(r8), allocatable :: maer(:,:,:) ! aerosol wet mass MR (including water) (kg/kg-air) + real(r8), allocatable :: wetvol(:,:,:) ! single-particle-mean wet volume (m3) + real(r8), allocatable :: wtrvol(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) + real(r8), allocatable :: wtpct(:,:,:) ! sulfate aerosol composition, weight % H2SO4 + real(r8), allocatable :: sulden(:,:,:) ! sulfate aerosol mass density (g/cm3) + + real(r8), pointer :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) + real(r8), pointer :: naer(:,:,:) ! aerosol number MR (bounded!) (#/kg-air) + real(r8), pointer :: dryvol(:,:,:) ! single-particle-mean dry volume (m3) + real(r8), pointer :: so4dryvol(:,:,:) ! dry volume of sulfate in single aerosol (m3) + + real(r8) :: specdens, so4specdens + integer :: troplev(pcols) + + real(r8), allocatable :: rhcrystal(:) + real(r8), allocatable :: rhdeliques(:) + + real(r8) :: es(pcols) ! saturation vapor pressure + real(r8) :: qs(pcols) ! saturation specific humidity + + + + real(r8) :: rh(pcols,pver) ! relative humidity (0-1) + + + real(r8), allocatable :: wetrad(:,:,:) ! wet radius of aerosol (m) + + integer :: ii, jj, l + integer :: idx + integer :: itim_old + + + !----------------------------------------------------------------------- + + ncol = state%ncol + + call rad_cnst_get_info(0, nmodes=nmodes) + + allocate(& + es_crm(pcols), & + qs_crm(pcols), & + cldnt(pcols, pver), & + rh_crm(pcols, crm_nx, crm_ny, pver), & + wtrvol_grid(pcols,pver,nmodes), & + wetvol_grid(pcols,pver,nmodes), & + ncount_clear(pcols,pver,nmodes), & + dgncur_a(pcols,pver,nmodes), & + drymass(pcols,pver,nmodes), & + specdens_1(nmodes) ) + + allocate( & + wetrad(pcols,pver,nmodes), & + wetvol(pcols,pver,nmodes), & + wtrvol(pcols,pver,nmodes), & + wtpct(pcols,pver,nmodes), & + sulden(pcols,pver,nmodes), & + rhcrystal(nmodes), & + rhdeliques(nmodes) ) + + wtpct(:,:,:) = 75._r8 + sulden(:,:,:) = 1.923_r8 + + dgnum_idx = pbuf_get_index('DGNUM') + hygro_idx = pbuf_get_index('HYGRO') + dryvol_idx = pbuf_get_index('DRYVOL') + dryrad_idx = pbuf_get_index('DRYRAD') + drymass_idx = pbuf_get_index('DRYMASS') + so4dryvol_idx = pbuf_get_index('SO4DRYVOL') + naer_idx = pbuf_get_index('NAER') + dgnumwet_idx = pbuf_get_index('DGNUMWET') + qaerwat_idx = pbuf_get_index('QAERWAT') + wetdens_ap_idx = pbuf_get_index('WETDENS_AP') + cld_idx = pbuf_get_index('CLD') + + + idx = pbuf_get_index('CRM_QV_RAD') + call pbuf_get_field (pbuf, idx, h2ommr_crm) + idx = pbuf_get_index('CRM_T_RAD') + call pbuf_get_field (pbuf, idx, t_crm) + idx = pbuf_get_index('CRM_CLD_RAD') + call pbuf_get_field (pbuf, idx, cldn_crm) + idx = pbuf_get_index('CRM_QAERWAT') + call pbuf_get_field (pbuf, idx, qaerwat_crm) + idx = pbuf_get_index('CRM_DGNUMWET') + call pbuf_get_field (pbuf, idx, dgncur_awet_crm) + + ncount_clear = 0.0_r8 + wtrvol_grid = 0.0_r8 + wetvol_grid = 0.0_r8 + + call pbuf_get_field(pbuf, hygro_idx, hygro) + call pbuf_get_field(pbuf, dryvol_idx, dryvol) + call pbuf_get_field(pbuf, dryrad_idx, dryrad) + call pbuf_get_field(pbuf, drymass_idx, drymass) + call pbuf_get_field(pbuf, so4dryvol_idx, so4dryvol) + call pbuf_get_field(pbuf, naer_idx, naer) + + call pbuf_get_field(pbuf, dgnum_idx, dgncur_a ) + call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet ) + call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat) + + dgncur_awet(:,:,:) = dgncur_a(:,:,:) + qaerwat = 0._r8 + + h2ommr => state%q(:,:,1) + t => state%t + pmid => state%pmid + + do m = 1, nmodes + ! get mode properties + call rad_cnst_get_mode_props(0, m, rhcrystal=rhcrystal(m), rhdeliques=rhdeliques(m)) + ! get mode info + call rad_cnst_get_info(0, m, nspec=nspec) + + do l = 1, nspec + + ! get species interstitial mixing ratio ('a') + call rad_cnst_get_aer_props(0, m, l, density_aer=specdens) + + if (l == 1) then + ! save off these values to be used as defaults + specdens_1(m) = specdens + end if + + end do + + end do + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + do jj = 1, crm_ny + do ii = 1, crm_nx + do k = top_lev, pver + mm=pver-k+1 + call qsat_water(t(:ncol,k), pmid(:ncol,k), es(:ncol), qs(:ncol)) + do i = 1, ncol + if (qs(i) > h2ommr(i,k)) then + rh(i,k) = h2ommr(i,k)/qs(i) + else + rh(i,k) = 0.98_r8 + endif + rh(i,k) = max(rh(i,k), 0.0_r8) + rh(i,k) = min(rh(i,k), 0.98_r8) + if (cldn(i,k) .lt. 1.0_r8) then + rh(i,k) = (rh(i,k) - cldn(i,k)) / (1.0_r8 - cldn(i,k)) ! clear portion + end if + rh(i,k) = max(rh(i,k), 0.0_r8) + end do + + if (mm <= crm_nz) call qsat_water(t_crm(:ncol,ii,jj,mm), & + pmid(:ncol,k), es_crm(:ncol), qs_crm(:ncol)) + do i = 1, ncol + rh_crm(i, ii, jj, k) = rh(i,k) + if(mm.le.crm_nz) then + rh_crm(i, ii, jj, k) = h2ommr_crm(i,ii,jj,mm)/qs_crm(i) + rh_crm(i, ii, jj, k) = max(rh_crm(i, ii, jj, k), 0.0_r8) + rh_crm(i, ii, jj, k) = min(rh_crm(i, ii, jj, k), 0.98_r8) + if(cldn_crm(i, ii, jj, mm).gt.0.5_r8) then + ! aerosol water uptake is not calculaed at overcast sky in MMF + rh_crm(i, ii, jj, k) = 0.0_r8 + end if + end if + + rh(i,k) = rh_crm(i, ii, jj, k) + cldnt(i, k) = cldn(i,k) + mm=pver-k+1 + if(mm.le.crm_nz) then + cldnt(i,k) = cldn_crm(i, ii, jj, mm) + end if + + do m=1,nmodes + ncount_clear(i,k,m) = ncount_clear(i,k,m) + (1._r8 - cldnt(i,k)) + end do + end do + end do + + call modal_aero_wateruptake_sub( & + ncol, nmodes, rhcrystal, rhdeliques, dryrad, & + hygro, rh, dryvol, so4dryvol, so4specdens, tropLev, & + wetrad, wetvol, wtrvol, sulden, wtpct) + do m = 1, nmodes + do k = top_lev, pver + do i = 1, ncol + dgncur_awet(i,k,m) = dgncur_a(i,k,m) * (wetrad(i,k,m)/dryrad(i,k,m)) + if(k.ge.pver-crm_nz+1) then + qaerwat_crm(i,ii,jj,pver-k+1,m) = rhoh2o*naer(i,k,m)*wtrvol(i,k,m) + dgncur_awet_crm(i,ii,jj,pver-k+1,m) = dgncur_awet(i,k,m) + end if + wtrvol_grid(i,k,m) = wtrvol_grid(i,k,m) + wtrvol(i,k,m)*(1._r8-cldnt(i,k)) + wetvol_grid(i,k,m) = wetvol_grid(i,k,m) + wetvol(i,k,m)*(1._r8-cldnt(i,k)) + qaerwat(i,k,m) = qaerwat(i,k,m)+ rhoh2o*naer(i,k,m)*wtrvol(i,k,m) * (1-cldnt(i,k)) + + end do + end do + end do + end do + end do + + do m = 1, nmodes + do k = 1, pver + do i = 1, ncol + + if(ncount_clear(i,k,m).gt.1.0e-10_r8) then + qaerwat(i,k,m) = qaerwat(i,k,m)/ncount_clear(i,k,m) + wetvol_grid(i,k,m)=wetvol_grid(i,k,m)/ncount_clear(i,k,m) + wtrvol_grid(i,k,m)=wtrvol_grid(i,k,m)/ncount_clear(i,k,m) + if (wetvol_grid(i,k,m) > 1.0e-30_r8) then + wetdens(i,k,m) = (drymass(i,k,m) + & + rhoh2o*wtrvol_grid(i,k,m))/wetvol_grid(i,k,m) + else + wetdens(i,k,m) = specdens_1(m) + end if + wetrad(i,k,m) = max(dryrad(i,k,m), (wetvol_grid(i,k,m)/pi43)**third) + dgncur_awet(i,k,m) = dgncur_a(i,k,m)* & + (wetrad(i,k,m)/dryrad(i,k,m)) + else + dgncur_awet(i,k,m) = dgncur_a(i,k,m) + qaerwat(i,k,m) = 0.0_r8 + wetdens(i,k,m) = specdens_1(m) + end if + end do ! ncol + end do ! pver + end do ! nmodes + + + + deallocate(& + es_crm, & + qs_crm, & + cldnt, & + rh_crm, & + wtrvol_grid, & + wetvol_grid, & + ncount_clear ) + + deallocate(wetrad, wetvol, wtrvol, wtpct, sulden, rhcrystal, rhdeliques, specdens_1) + +end subroutine spcam_modal_aero_wateruptake_dr + + +!------------------------------------------------------------------------------------------------------ +subroutine crmclouds_mixnuc_tend (state, ptend, dtime, cflx, pblht, pbuf, & + wwqui_cen, wwqui_cloudy_cen, wwqui_bnd, wwqui_cloudy_bnd ) +!----------------------------------------------------------------------------------------------------- +! +! Purpose: to calculate aerosol tendency from dropelt activation and mixing. +! Adopted from mmicro_pcond in cldwat2m.F90 +! +!------------------------------------------------------------------------------------------------------ + use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field + use physconst, only: gravit, rair, karman + use constituents, only: cnst_get_ind, pcnst, cnst_species_class, cnst_spec_class_gas + use time_manager, only: is_first_step + use cam_history, only: outfld + use ndrop, only: dropmixnuc + use modal_aero_data + use rad_constituents, only: rad_cnst_get_info + +! Input + type(physics_state), intent(in) :: state ! state variables + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: pblht(pcols) ! PBL height (meter) + real(r8), intent(in) :: dtime ! timestep + real(r8), intent(in) :: cflx(pcols,pcnst) ! constituent flux from surface + real(r8), intent(in) :: wwqui_cen(pcols, pver) ! vertical velocity variance in quiescent class (m2/s2) + real(r8), intent(in) :: wwqui_cloudy_cen(pcols, pver) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) + real(r8), intent(in) :: wwqui_bnd(pcols, pver+1) ! vertical velocity variance in quiescent class (m2/s2) + real(r8), intent(in) :: wwqui_cloudy_bnd(pcols, pver+1) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) + +! output + type(physics_ptend), intent(out) :: ptend ! package tendencies + +! Local variables + integer i,k,m, k1, k2 + integer ifld, itim + integer ixcldliq, ixcldice, ixnumliq + integer l,lnum,lnumcw,lmass,lmasscw + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: nmodes + + real(r8) :: nc(pcols, pver) ! droplet number concentration (#/kg) + real(r8) :: nctend(pcols, pver) ! change in droplet number concentration + real(r8) :: omega(pcols, pver) ! grid-averaaged vertical velocity + real(r8) :: qc(pcols, pver) ! liquid water content (kg/kg) + real(r8) :: qi(pcols, pver) ! ice water content (kg/kg) + real(r8) :: lcldn(pcols, pver) + real(r8) :: lcldo(pcols, pver) + real(r8) :: cldliqf(pcols, pver) + + real(r8) :: wsub(pcols, pver) ! subgrid vertical velocity + real(r8) :: ekd_crm(pcols, pverp) ! diffusivity + real(r8) :: kkvh_crm(pcols, pverp) ! eddy diffusivity + real(r8) :: zs(pcols, pver) ! inverse of distance between levels (meter) + real(r8) :: dz(pcols, pver) ! layer depth (m) + real(r8) :: cs(pcols, pver) ! air density + real(r8) :: lc(pcols, pverp) ! mixing length (m) + real(r8) :: zheight(pcols, pverp) ! height at lay interface (m) + + real(r8) :: alc(pcols, pverp) ! asymptotic length scale (m) + real(r8) :: tendnd(pcols, pver) ! tendency of cloud droplet number concentrations (not used in the MMF) + + real(r8),allocatable :: factnum(:,:,:) ! activation fraction for aerosol number + + real(r8) :: qcld, qsmall + + logical :: dommf=.true. ! value insignificant, if present, means that dropmixnuc is called the mmf part. + +! Variables in the physics buffer: + real(r8), pointer, dimension(:,:) :: cldn ! cloud fractin at the current time step + real(r8), pointer, dimension(:,:) :: cldo ! cloud fraction at the previous time step + real(r8), pointer, dimension(:,:) :: acldy_cen ! liquid cloud fraction at the previous time step from ECPP + real(r8), pointer, dimension(:,:) :: kkvh ! vertical diffusivity + real(r8), pointer, dimension(:,:) :: tke ! turbulence kenetic energy + real(r8), pointer, dimension(:,:) :: tk_crm ! m2/s + + logical :: lq(pcnst) + + lchnk = state%lchnk + ncol = state%ncol + + qsmall = 1.e-18_r8 + + call rad_cnst_get_info(0, nmodes=nmodes) + allocate(factnum(pcols,pver,nmodes)) + + lq(:) = .false. + do m=1,ntot_amode + lnum=numptr_amode(m) + if(lnum>0)then + lq(lnum)= .true. + endif + do l=1,nspec_amode(m) + lmass=lmassptr_amode(l,m) + lq(lmass)= .true. + enddo + enddo + + call physics_ptend_init(ptend,state%psetcols,'crmclouds_mixnuc', lq=lq) + +! +! In the MMF model, turbulent mixing for tracer species are turned off in tphysac. +! So the turbulent for gas species mixing are added here. +! + do m=1, pcnst + if(cnst_species_class(m).eq.cnst_spec_class_gas) then + ptend%lq(m) = .true. + end if + end do + + itim = pbuf_old_tim_idx () + ifld = pbuf_get_index ('CLD') + call pbuf_get_field(pbuf, ifld, cldn, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index ('CLDO') + call pbuf_get_field(pbuf, ifld, cldo, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index ('ACLDY_CEN') + call pbuf_get_field(pbuf, ifld, acldy_cen) + ifld = pbuf_get_index('kvh') + call pbuf_get_field(pbuf, ifld, kkvh) + + ifld=pbuf_get_index('tke') + call pbuf_get_field(pbuf, ifld, tke) + + ifld = pbuf_get_index('TK_CRM') + call pbuf_get_field(pbuf, ifld, tk_crm) + + + if (is_first_step()) then + kkvh(:,:)= 0.0_r8 + tke(:,:) = 0.0_r8 + endif + + do i=1, ncol + do k=1, pver-1 + zs(i,k) = 1._r8/(state%zm(i,k)-state%zm(i,k+1)) + end do + zs(i,pver) = zs(i,pver-1) + +! calculate height at layer interface (simple calculation) + zheight(i,pverp) = 0.0_r8 + do k=pver, 1, -1 + zheight(i,k) = zheight(i,k+1) + state%pdel(i,k)/state%pmid(i,k)*(rair*state%t(i,k)/gravit) + end do + +! calculate mixing length +! from Holtslag and Boville, 1993, J. Climate. +! + do k=1, pverp + if(zheight(i,k).le.pblht(i)) then + alc(i,k) = 300._r8 + else + alc(i,k) = 30._r8+270._r8*exp(1._r8-zheight(i,k)/pblht(i)) + endif + lc(i,k) = alc(i,k)*karman*zheight(i,k)/(alc(i,k)+karman*zheight(i,k)) + enddo + end do + + call outfld('LENGC', lc, pcols, lchnk) + + kkvh_crm = 0._r8 + do i=1, ncol + do k=1, pver + +! from vertical variance in the quiescent class, which excldues +! the contribution from strong updraft and downdraft. + wsub(i,k) = sqrt(wwqui_cloudy_cen(i,k)) ! use variance in cloudy quiescent area + wsub(i,k) = min(wsub(i,k), 10._r8) + wsub(i,k) = max(0.20_r8, wsub(i,k)) + end do ! end k + + do k=1, pver+1 + + k1=min(k, pver) + k2=max(k-1, 1) +! +! calculate ekd_crm from wsub in the cloudy quiescent class (following a part of ndrop.F90) + ekd_crm(i,k) = min(10.0_r8, max(0.20_r8, sqrt(wwqui_cloudy_bnd(i,k))))* lc(i,k) + kkvh_crm(i,k) = ekd_crm(i,k) + +! set kkvh to kkvh_crm so this will be used in dropmixnuc in the mmf call + kkvh(i,k) = kkvh_crm(i,k) + + end do !end k + + end do + + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMLIQ', ixnumliq) + + qc(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + qi(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + nc(:ncol,:pver) = state%q(:ncol,:pver,ixnumliq) + cldliqf(:,:) = 1._r8 + lcldn(:,:) = 0._r8 + lcldo(:,:) = 0._r8 + + + do k=1,pver + do i=1,ncol + qcld=qc(i,k)+qi(i,k) + if(qcld.gt.qsmall)then + +#ifdef ECPP +! +! When ECPP is called, activation associated with cloud fraction change is treated in ECPP. +! so set two cloud fractio be the same here. +! But ECPP still did not treat activation associated with turbulent scale motion, and is +! done in dropmixnuc + lcldn(i,k)=acldy_cen(i,k) + lcldo(i,k)=acldy_cen(i,k) +#else + lcldn(i,k)=cldn(i,k)*qc(i,k)/qcld + lcldo(i,k)=cldo(i,k)*qc(i,k)/qcld +#endif + else + lcldn(i,k)=0._r8 + lcldo(i,k)=0._r8 + endif + enddo + enddo + +! should we set omega to be zero ?? + omega(:ncol, :) = state%omega(:ncol, :) + + call dropmixnuc(state, ptend, dtime, pbuf, wsub, lcldn, lcldo, cldliqf, tendnd, factnum, dommf ) + +! this part is moved into tphysbc after aerosol stuffs. +! + + deallocate(factnum) + +end subroutine crmclouds_mixnuc_tend +!====================================================================================================== + +!------------------------------------------------------------------------------------------------------ +subroutine crmclouds_convect_tend(state, ptend, ztodt, pbuf) +!----------------------------------------------------------------- +! +! Purpose: to do convective transport of tracer species using the cloud fields from CRM and using the +! subroutine of convtran. +! +! Minghuai Wang, July, 2009: adopted from zm_conv_tend_2 +! +!------------------------------------------------------------------------------------------------------ + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use time_manager, only: get_nstep + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field + use constituents, only: pcnst, cnst_get_ind + use zm_conv, only: convtran + use error_messages, only: alloc_err + +! Arguments +! Input variables: + type(physics_state), intent(in ) :: state ! Physics state variables + real(r8), intent(in) :: ztodt + +! Output variables: + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + +! Local variables + integer :: i, lchnk, istat + integer :: ncol + integer :: nstep + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + real(r8), dimension(pcols,pver) :: dpdry + real(r8), dimension(pcols,pver) :: dp ! layer thickness in mbs (between upper/lower interface). + real(r8), dimension(pcols) :: dsubcld ! wg layer thickness in mbs between lcl and maxi. + +! physics buffer fields + integer itim, ifld + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + + + real(r8), pointer, dimension(:,:) :: mu !(pcols,pver,begchunk:endchunk) + real(r8), pointer, dimension(:,:) :: eu !(pcols,pver,begchunk:endchunk) + real(r8), pointer, dimension(:,:) :: du !(pcols,pver,begchunk:endchunk) + real(r8), pointer, dimension(:,:) :: md !(pcols,pver,begchunk:endchunk) + real(r8), pointer, dimension(:,:) :: ed !(pcols,pver,begchunk:endchunk) + + real(r8), pointer, dimension(:) :: jtr8 !(pcols,begchunk:endchunk) + ! wg top level index of deep cumulus convection. + real(r8), pointer, dimension(:) :: maxgr8 !(pcols,begchunk:endchunk) + ! wg gathered values of maxi. + real(r8), pointer, dimension(:) :: ideepr8 !(pcols,begchunk:endchunk) + ! w holds position of gathered points vs longitude index + + integer :: jt(pcols) + integer :: maxg(pcols) + integer :: ideep(pcols) + integer :: lengath !(begchunk:endchunk) + logical :: lq(pcnst) + +! +! Initialize +! + + lq(:) = .true. + lq(1) = .false. + lq(ixcldice) = .false. + lq(ixcldliq) = .false. + + call physics_ptend_init(ptend,state%psetcols,'convtran2',lq=lq) + +! +! Associate pointers with physics buffer fields +! + ifld = pbuf_get_index('FRACIS') + call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols,pver,pcnst/) ) + + ifld = pbuf_get_index('MU_CRM') + call pbuf_get_field(pbuf, ifld, mu) + ifld = pbuf_get_index('MD_CRM') + call pbuf_get_field(pbuf, ifld, md) + ifld = pbuf_get_index('DU_CRM') + call pbuf_get_field(pbuf, ifld, du) + ifld = pbuf_get_index('EU_CRM') + call pbuf_get_field(pbuf, ifld, eu) + ifld = pbuf_get_index('ED_CRM') + call pbuf_get_field(pbuf, ifld, ed) + ifld = pbuf_get_index('JT_CRM') + call pbuf_get_field(pbuf, ifld, jtr8) + ifld = pbuf_get_index('MX_CRM') + call pbuf_get_field(pbuf, ifld, maxgr8) + ifld = pbuf_get_index('IDEEP_CRM') + call pbuf_get_field(pbuf, ifld, ideepr8) + + +! Transport all constituents except cloud water and ice +! + + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + +! +! Convective transport of all trace species except cloud liquid +! and cloud ice done here because we need to do the scavenging first +! to determine the interstitial fraction. +! + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + +! Is this ok to get the index??? + jt = int(jtr8+0.5_r8) + maxg = int(maxgr8+0.5_r8) + ideep = int(ideepr8+0.5_r8) + +! calculate lengath from ideep + lengath = 0 + do i=1, ncol + if(ideep(i).ge.1) then + lengath = lengath + 1 + endif + end do + +! +! initialize dpdry for call to convtran +! it is used for tracers of dry smixing ratio type +! + dpdry = 0._r8 + do i = 1,lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + dp(i,:) = state%pdel(ideep(i),:)/100._r8 + end do + +! dsubdld is not used in convtran, and is set to be zero. + dsubcld = 0._r8 + + + call convtran (lchnk, & + ptend%lq,state%q, pcnst, mu(:,:), md(:,:), & + du(:,:), eu(:,:), ed(:,:), dp(:,:), dsubcld(:), & + jt(:),maxg(:),ideep(:), 1, lengath, & + nstep, fracis, ptend%q, dpdry, ztodt ) + +end subroutine crmclouds_convect_tend +!===================================================================================================== + +!------------------------------------------------------------------------------------------------------ +subroutine crmclouds_diag + +end subroutine crmclouds_diag +!====================================================================================================== + +#endif +#endif /*CRM*/ + +end module crmclouds_camaerosols diff --git a/src/physics/spcam/crmdims.F90 b/src/physics/spcam/crmdims.F90 new file mode 100644 index 0000000000..a1765db60c --- /dev/null +++ b/src/physics/spcam/crmdims.F90 @@ -0,0 +1,11 @@ +module crmdims +#ifdef CRM + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + + integer, parameter :: nclubbvars = 17 + + integer, parameter :: crm_nx=SPCAM_NX, crm_ny=SPCAM_NY, crm_nz=SPCAM_NZ + real(r8), parameter :: crm_dx=SPCAM_DX, crm_dy=SPCAM_DX, crm_dt=SPCAM_DT +#endif +end module crmdims diff --git a/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 b/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 new file mode 100644 index 0000000000..6d2d9b3290 --- /dev/null +++ b/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 @@ -0,0 +1,660 @@ +module ecpp_modal_aero_activate + +!----------------------------------------------------------------- +! Module interface of aerosol activaiton used in the ECPP treatment +! in the MMF model +! Adopted from ndrop.F90 and from the similar one used in the ECPP +! for the WRF-chem model written by Dick Easter +! +! Minghuai Wang, 2009-11 +!------------------------------------------------------------------ + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use constituents, only: pcnst + + implicit none + + public parampollu_tdx_activate1 + public parampollu_tdx_activate_intface + +contains + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_activate1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, activate_onoff_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_old, & + mfbnd_use, & + ar_bnd_tavg, & + ent_airamt, & + ido_actres_horz, fmact_horz, fnact_horz, & + fmact_vert, fnact_vert, mfbnd_quiescn_up ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_activate1 calculates number and mass activation +! fractions associated with vertical and horizontal transfer +! between subclasses +! +!----------------------------------------------------------------------- + + use module_data_mosaic_asect, only: maxd_asize, maxd_atype, & + nsize_aer, ntype_aer + + use module_data_radm2, only: epsilc + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, wbnd_bar +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! dzcen - layer thicknesses (m) +! + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + integer, intent(in) :: ifrom_where +! 1,2 - from area_change; 10 - from main_integ + integer, intent(in) :: activate_onoff_use +! 1-99 - calc real fmact,fnact +! 200 - set fmact = fmact_testa, ... +! other - set fmact,fnact = 0.0 +! ALSO, ido_actres_horz is set correctly when activate_onoff_use > 0 +! but is set to zero when activate_onoff_use <= 0 + + integer, intent(in) :: ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_old + + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + ar_bnd_tavg, mfbnd_use + + real(r8), intent(in), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt + + integer, intent(out), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & + ido_actres_horz +! ido_actres_horz(iccaa,jclsaa,iccbb,jclsbb) is associated with air moving +! into sub-class (iccaa,jclsaa) from sub-class (iccbb,jclsbb) +! ido_actres_horz = +1 or +2 if activation, -1 if resuspension, 0 otherwise +! note that its values are independent of k (i.e., they only depend on the source and +! destination sub-classes) +! the fnact and fmact do depend on k + + real(r8), intent(out), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, & + 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + fmact_horz, fnact_horz +! fmact_horz(m,n,jclsaa,iccbb,jclsbb,k) and fnact(...) are associated with air moving +! into sub-class (icc=2,jclsaa,k) from sub-class (iccbb,jclsbb,k) + + real(r8), optional, intent(out), dimension( 1:maxd_asize, 1:maxd_atype, kts:ktecen ) :: & + fmact_vert, fnact_vert +! fnact_vert(m,n,k) and fmact(...) are associated with (quiescent, clear, layer k-1) air moving +! into (quiescent, cloudy, layer k) + + real(r8), optional, intent(in), dimension( kts:ktebnd, 0:2, 0:2 ) :: & + mfbnd_quiescn_up + + +! local variables + integer :: icc, iccb, iccy, ido_actres_tmp, ihorzvert, itmpa + integer :: jcls, jclsy, jj + integer :: k, l + integer :: m, n + + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpt + real(r8) :: wbar_tmp, wmix_tmp + + real(r8), dimension( 1:maxd_asize, 1:maxd_atype ) :: & + fnact_tmp, fmact_tmp + real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 2 ) :: & + fnact_testa, fmact_testa + + +! initialize fnact/fmact to zero + ido_actres_horz(:,:,:,:) = 0 + fmact_horz(:,:,:,:,:,:) = 0.0_r8 + fnact_horz(:,:,:,:,:,:) = 0.0_r8 + if ( present(fmact_vert) ) fmact_vert(:,:,:) = 0.0_r8 + if ( present(fnact_vert) ) fnact_vert(:,:,:) = 0.0_r8 + + if (activate_onoff_use <= 0) return + + +! temporary values for testing purposes + fmact_testa(:,:,:) = 0.0_r8 + fnact_testa(:,:,:) = 0.0_r8 + + fmact_testa(1,1:3,1) = (/ 0.50_r8, 0.90_r8, 0.95_r8 /) ! updraft_r8 + fnact_testa(1,1:3,1) = (/ 0.40_r8, 0.80_r8, 0.90_r8 /) + fmact_testa(1,1:3,2) = (/ 0.30_r8, 0.80_r8, 0.90_r8 /) ! quiescent + fnact_testa(1,1:3,2) = (/ 0.20_r8, 0.60_r8, 0.80_r8 /) + +! +! horizontal transfer +! + +! first set ido_actres_horz +! note again: ido_actres_horz(icc,jcls,iccy,jclsy) is from iccy,jclsy to icc,jcls + do jclsy = 1, ncls_use + do iccy = 1, 2 + do jcls = 1, ncls_use + do icc = 1, 2 + + if (icc == 1) then + if (iccy == 1) then + ! clear --> clear -- do nothing (no activation or resuspension) + cycle + else + ! cloudy --> clear -- do resuspension + ido_actres_horz(icc,jcls,iccy,jclsy) = -1 + end if + + else + if (iccy == 1) then + ! clear --> cloudy -- do activation for into updrafts & quiescent + ! do nothing for into downdrafts + if (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp) & + ido_actres_horz(icc,jcls,iccy,jclsy) = 1 + else + ! cloudy --> cloudy -- do (re)activation for into updrafts + ! do nothing for into downdrafts & quiescent + ! if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) & + ! ido_actres_horz(icc,jcls,iccy,jclsy) = 2 + end if + end if + + end do ! icc + end do ! jcls + end do ! iccy + end do ! jclsy + + + +! next calc activation fractions +horz_k_loop: & + do k = kts, ktecen + +horz_jcls_loop: & + do jcls = 1, ncls_use + icc = 2 + +horz_jclsy_loop: & + do jclsy = 1, ncls_use + +horz_iccy_loop: & + do iccy = 1, 2 + + if (ent_airamt(icc,jcls,iccy,jclsy,k) <= 0.0_r8) cycle horz_iccy_loop + + if (jcls == jcls_qu) then +! quiescent class +! it can entrain from quiescent, updraft, dndraft +! do activation for entrain from clear-any + if (iccy == 2) cycle horz_iccy_loop ! only activate clear --> cloudy + + else if (mtype_updnenv_use(icc,jcls) == mtype_dndraft_ecpp) then +! downdraft class +! it can entrain from quiescent, dndraft +! do activation for none of these + cycle horz_iccy_loop + + else +! updraft class +! it can entrain from quiescent, updraft +! do activation for entrain from any-quiescent and clear-updraft + if (jclsy == jcls_qu) then + continue + else if ( (iccy == 1) .and. & + (mtype_updnenv_use(iccy,jclsy) == & + mtype_updraft_ecpp) ) then + continue + else + cycle horz_iccy_loop + end if + end if + + if (activate_onoff_use == 200) then ! use the fmnact_tst values + jj = 1 + if (jcls == jcls_qu) jj = 2 + fmact_horz(:,:,jcls,iccy,jclsy,k) = fmact_testa(:,:,jj) + fnact_horz(:,:,jcls,iccy,jclsy,k) = fnact_testa(:,:,jj) + end if + + if (activate_onoff_use < 100) then ! calculate "real" values +! stop '*** parampollu_tdx_activate1 - cannot do activate_onoff_use < 100' + + tmpa = 0.5_r8*(mfbnd_use(k,icc,jcls)+mfbnd_use(k+1,icc,jcls)) + tmpb = 0.5_r8*(ar_bnd_tavg(k,icc,jcls)+ar_bnd_tavg(k+1,icc,jcls)) + if (tmpb > 0.0_r8) then + if (abs(tmpa) > abs(tmpb)*w_draft_max) then + wbar_tmp = w_draft_max + else + wbar_tmp = tmpa/tmpb + end if + else + wbar_tmp = 0.0_r8 + end if + wbar_tmp = wbar_tmp + 0.5_r8*(wbnd_bar(k)+wbnd_bar(k+1)) + wmix_tmp = 0.0_r8 + if (max(wbar_tmp,wmix_tmp) <= 0.0_r8) cycle horz_iccy_loop + + ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) + ihorzvert = 1 + + call parampollu_tdx_activate_intface( & + ktau, ktau_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, ncls_use, & + it, jt, kts,ktebnd,ktecen, & + k, iccy, jclsy, jcls, & + activate_onoff_use, ido_actres_tmp, & + ihorzvert, ifrom_where, & + chem_sub_old, & + tcen_bar(k), rhocen_bar(k), & + wbar_tmp, wmix_tmp, & + fmact_testa, fnact_testa, & + fmact_tmp, fnact_tmp ) + + fmact_horz(:,:,jcls,iccy,jclsy,k) = fmact_tmp(:,:) + fnact_horz(:,:,jcls,iccy,jclsy,k) = fnact_tmp(:,:) + end if + + end do horz_iccy_loop + end do horz_jclsy_loop + end do horz_jcls_loop + end do horz_k_loop + +! write(*,'(a,i4,1p,4e10.2)') 'tdx_activate1 horz min/max', ifrom_where, & +! minval(fmact_horz(:,:,:,:,:,:)), maxval(fmact_horz(:,:,:,:,:,:)), & +! minval(fnact_horz(:,:,:,:,:,:)), maxval(fnact_horz(:,:,:,:,:,:)) + + +! +! vertical transfer +! in up/dndrafts, vertical transport is clear<-->clear or cloudy<-->cloudy +! so no activation +! in quiescent, can have clear<-->cloudy +! do activation for clear(k-1)-->cloud(k) +! + if ( present(fmact_vert) .and. present(fnact_vert) ) then + +vert_k_loop: & + do k = kts, ktecen + if (k == kts) cycle vert_k_loop + + jcls = jcls_qu + icc = 2 + jclsy = jcls_qu + iccy = 1 + +! mfbnd_quiescn_up(k,iccy,icc) is upwards mass flux from iccy to icc +! at bottom of layer k + if (mfbnd_quiescn_up(k,iccy,icc) <= 0.0_r8) cycle vert_k_loop + + if (activate_onoff_use == 200) then ! use the fmnact_tst values + jj = 2 + fmact_vert(:,:,k) = fmact_testa(:,:,jj) + fnact_vert(:,:,k) = fnact_testa(:,:,jj) + end if + + if (activate_onoff_use < 100) then ! calculate "real" values +! stop '*** parampollu_tdx_activate1 - cannot do activate_onoff_use < 100' + + tmpa = mfbnd_use(k,iccy,jclsy) + tmpb = ar_bnd_tavg(k,iccy,jclsy) + if (tmpb > 0.0_r8) then + if (abs(tmpa) > abs(tmpb)*w_draft_max) then + wbar_tmp = w_draft_max + else + wbar_tmp = tmpa/tmpb + end if + else + wbar_tmp = 0.0_r8 + end if + wbar_tmp = wbar_tmp + wbnd_bar(k) + wmix_tmp = 0.0_r8 + if (max(wbar_tmp,wmix_tmp) <= 0.0_r8) cycle vert_k_loop + + ido_actres_tmp = 1 + + tmpt = 0.5_r8*( tcen_bar(k) + tcen_bar(max(k-1,kts)) ) + + ido_actres_tmp = 1 + ihorzvert = 2 + + call parampollu_tdx_activate_intface( & + ktau, ktau_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, ncls_use, & + it, jt, kts,ktebnd,ktecen, & + k-1, iccy, jclsy, jcls, & + activate_onoff_use, ido_actres_tmp, & + ihorzvert, ifrom_where, & + chem_sub_old, & + tmpt, rhobnd_bar(k), & + wbar_tmp, wmix_tmp, & + fmact_testa, fnact_testa, & + fmact_tmp, fnact_tmp ) + + fmact_vert(:,:,k) = fmact_tmp(:,:) + fnact_vert(:,:,k) = fnact_tmp(:,:) + end if + + end do vert_k_loop + +! write(*,'(a,i4,1p,4e10.2)') 'tdx_activate1 vert min/max', ifrom_where, & +! minval(fmact_vert(:,:,:)), maxval(fmact_vert(:,:,:)), & +! minval(fnact_vert(:,:,:)), maxval(fnact_vert(:,:,:)) + + end if ! ( present(fmact_vert) .and. present(fnact_vert) ) + + + + return + end subroutine parampollu_tdx_activate1 + + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_activate_intface( & + ktau, ktau_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, ncls_use, & + i, j, kts,ktebnd,ktecen, & + k, iccy, jclsy, jcls, & + activate_onoff_use, ido_actres, & + ihorzvert, ifrom_where, & + chem_sub_old, & + tempair_in, rhoair_in, & + wbar_in, wmix_in, & + fmact_testa, fnact_testa, & + fmact, fnact ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_activate1 calculates number and mass activation +! fractions associated with vertical and horizontal transfer +! between subclasses +! +!----------------------------------------------------------------------- + + use module_data_mosaic_asect, only: & + maxd_acomp, maxd_asize, maxd_atype, & + ncomp_aer, nsize_aer, ntype_aer, & + nphase_aer, ai_phase, cw_phase, & + numptr_aer, massptr_aer, sigmag_aer + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + + use ndrop, only: activate_modal + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + i, j, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + integer, intent(in) :: & + k, iccy, jclsy, jcls + + real(r8), intent(in) :: tempair_in, rhoair_in, wbar_in, wmix_in +! tempair - temperature (k) +! rhoair - air density (kg/m3) + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + integer, intent(in) :: ncls_use + + integer, intent(in) :: activate_onoff_use +! 1-99 - calc real fmact,fnact +! 200 - set fmact = fmact_testa, ... +! other - set fmact,fnact = 0.0 + integer, intent(in) :: ido_actres, ihorzvert, ifrom_where + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_old + + real(r8), intent(in), dimension( 1:maxd_asize, 1:maxd_atype, 2 ) :: & + fnact_testa, fmact_testa + + real(r8), intent(out), dimension( 1:maxd_asize, 1:maxd_atype ) :: & + fmact, fnact + + +! local variables + integer :: iphase, jj, l, ll, lun, m, n + integer, save :: ifrom_where_save, ktau_save + data ifrom_where_save, ktau_save / -1, -1 / + + real(r8) :: factscale, flux_fullact + real(r8) :: rhoair + real(r8) :: sumhygro, sumvol + real(r8) :: tempair, tmpc + real(r8) :: wbar, wdiab, wmin, wmax, wmix, wmixmin + + real(r8) :: raercol( 1:1, 1:num_chem_ecpp ) + + real(r8) :: raer (1:pcnst) ! interstitial aerosols + real(r8) :: qqcw (1:pcnst) ! interstitial aerosols + + real(r8), dimension( 1:maxd_asize, 1:maxd_atype ) :: & + fn, fs, fm, fluxn, fluxs, fluxm, hygro, & + maerosol_tot, maerosol_totcw, & + naerosol, naerosolcw, & + vaerosol, vaerosolcw, sigmag + + real(r8), dimension( 1:maxd_acomp, 1:maxd_asize, 1:maxd_atype ) :: & + maerosol, maerosolcw + + + +! initialize fnact/fmact to zero + fmact(:,:) = 0.0_r8 + fnact(:,:) = 0.0_r8 + +! special testing cases + if ((activate_onoff_use <= 0) .or. (activate_onoff_use >= 100)) then + return + else if (activate_onoff_use == 81) then + return + else if (activate_onoff_use == 82) then + jj = 1 + if (jcls == jcls_qu) jj = 2 + fmact(:,:) = fmact_testa(:,:,jj) + fnact(:,:) = fnact_testa(:,:,jj) + return + end if + +! +! calc activation fractions +! + tempair = tempair_in + rhoair = rhoair_in + wbar = wbar_in + wmix = wmix_in + + wmixmin = 0.2_r8 + ! do single updraft, forced to wbar >= wmixmin + wbar = max( wbar+wmix, wmixmin ) + wmix = 0.0_r8 + + wmin = 0.0_r8 + wmax = 50.0_r8 + wdiab = 0.0_r8 + +! load raercol (with units conversion) and calculate hygro + raercol(:,:) = 0.0_r8 + + raer(1:pcnst) = chem_sub_old(k,iccy,jclsy,1:pcnst) + qqcw(1:pcnst) = chem_sub_old(k,iccy,jclsy,pcnst+1:2*pcnst) + +! do loadaer calls + do n=1,ntype_aer + do m=1,nsize_aer(n) + + if(ido_actres ==2 ) then + iphase = 3 + else + iphase = 1 + end if + call loadaer0D (raer, qqcw, n, rhoair, ai_phase, & + naerosol(m,n), vaerosol(m,n), hygro(m,n)) + sigmag(m, n) = sigmag_aer(m,n) + enddo ! m + enddo ! n + +! do activate call + m = 1 ! for the CAM modal aeosol, nsize_aer is always 1. + call activate_modal( wbar, wmix, wdiab, wmin, wmax, tempair, rhoair, & + naerosol(m,:), ntype_aer, & + vaerosol(m,:), hygro(m,:), & + fn(m,:), fm(m,:), fluxn(m,:), fluxm(m,:), flux_fullact ) + +! load results + fmact(:,:) = fm(:,:) + fnact(:,:) = fn(:,:) + +! diagnostics + lun = ldiagaa_ecpp(125) + if ((idiagaa_ecpp(125) > 0) .and. (lun > 0)) then + + if ((ktau /= ktau_save) .or. (ifrom_where /= ifrom_where_save)) & + write(lun,'(//a,4i8)') & + 'activate_intface - ktau, ifrom_where =', ktau, ifrom_where + ktau_save = ktau + ifrom_where_save = ifrom_where + + write(lun,'(2i3,2x,2i2,2x,4i2, 1p,2x,3e8.1, 0p,3x,3f7.3, 2(3x,4f6.3))') & + jcls, k, jclsy, iccy, ido_actres, ihorzvert, maxd_asize, maxd_atype, & + naerosol(1,1:3)*1.0e-6_r8, wbar_in, wmix_in, wbar, fmact(1,1:3), fnact(1,1:3) + write(lun,'(8x,a, 1p,2x,4e10.2)') ' vaerosol', vaerosol(1,1:3) + write(lun,'(8x,a, 1p,2x,4e10.2)') ' hygro ', hygro(1,1:3) + write(lun,'(8x,a, 1p,2x,6e10.2)') ' t,rho', tempair, rhoair + + end if + + + return + end subroutine parampollu_tdx_activate_intface +!========================================================================================================== + +!---------------------------------------------------------------------------------------------------------- + subroutine loadaer0D(raer,qqcw,m,cs, phase, & + naerosol, vaerosol, hygro ) +!------------------------------------------------------------------------- +! This subroutine is adopted from loadaer in ndrop.F90. It is 2D in ndrop.F90, +! but it is 0D here (single point). So that we do not need to define arrays with +! pcols, pver. +! Minghuai Wang, 2009-11 +!------------------------------------------------------------------------- + use modal_aero_data + + implicit none + +! load aerosol number, volume concentrations, and bulk hygroscopicity + + real(r8), intent(in) :: raer(pcnst) ! aerosol mass, number mixing ratios + real(r8), intent(in) :: qqcw(pcnst) ! cloud-borne aerosol mass, number mixing ratios + integer, intent(in) :: m ! m=mode index + real(r8), intent(in) :: cs ! air density (kg/m3) + integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum + real(r8), intent(out) :: naerosol ! interstitial number conc (/m3) + real(r8), intent(out) :: vaerosol ! interstitial+activated volume conc (m3/m3) + real(r8), intent(out) :: hygro ! bulk hygroscopicity of mode + +! internal + + real(r8) vol ! aerosol volume mixing ratio + integer i,lnum,lnumcw,l,lmass,lmasscw + + vaerosol=0._r8 + hygro=0._r8 + + do l=1,nspec_amode(m) + lmass=lmassptr_amode(l,m) ! interstitial + lmasscw=lmassptrcw_amode(l,m) ! cloud-borne + if(phase.eq.3)then + vol=max(raer(lmass)+qqcw(lmasscw),0._r8)/specdens_amode(l,m) + elseif(phase.eq.2)then + vol=max(qqcw(lmasscw),0._r8)/specdens_amode(l,m) + elseif(phase.eq.1)then + vol=max(raer(lmass),0._r8)/specdens_amode(l,m) + else + write(6,*)'phase=',phase,' in loadaer' + call endrun('phase error in loadaer') + endif + vaerosol=vaerosol+vol + hygro=hygro+vol*spechygro(l,m) + enddo + if (vaerosol > 1.0e-30_r8) then ! +++xl add 8/2/2007 + hygro=hygro/(vaerosol) + vaerosol=vaerosol*cs + else + hygro=0.0_r8 + vaerosol=0.0_r8 + endif + + lnum=numptr_amode(m) + lnumcw=numptrcw_amode(m) +! aerosol number predicted + if(phase.eq.3)then + naerosol=(raer(lnum)+qqcw(lnumcw))*cs + elseif(phase.eq.2)then + naerosol=qqcw(lnumcw)*cs + else + naerosol=raer(lnum)*cs + endif +! adjust number so that dgnumlo < dgnum < dgnumhi + naerosol = max( naerosol, vaerosol*voltonumbhi_amode(m) ) + naerosol = min( naerosol, vaerosol*voltonumblo_amode(m) ) + + return + end subroutine loadaer0D +!============================================================================================ + +end module ecpp_modal_aero_activate diff --git a/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 b/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 new file mode 100644 index 0000000000..66ff95b967 --- /dev/null +++ b/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 @@ -0,0 +1,700 @@ +module ecpp_modal_cloudchem + +!----------------------------------------------------------------- +! Module interface for cloud chemistry used in the ECPP treatment +! in the MMF model +! Adopted the similar one used in the ECPP +! for the WRF-chem model written by Dick Easter +! +! Minghuai Wang, 2009-11 +!------------------------------------------------------------------ + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + + implicit none + + public parampollu_tdx_cldchem + +contains + +!----------------------------------------------------------------------- + +subroutine parampollu_tdx_cldchem( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + itstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & + aqso4_h2o2, aqso4_o3, xphlwc3d, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol,pbuf ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_cldchem does cloud chemistry +! for one main-integ time sub-step +! +! incoming chem_sub_new holds current sub-class mixing ratios +! outgoing chem_sub_new holds updated sub-class mixing ratios +! +! In the beginning of the subroutine, the vertical coordinate (from bottom to top in ECPP) +! is converted into the one used in CAM: from the top to the bottom. And at the end of the +! subroutine, the vertical coordinate is converted back. +! +!----------------------------------------------------------------------- + + use module_data_ecpp1, only: p_qv, p_qc + + use module_data_radm2, only: epsilc + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + massptr_aer, maxd_asize, maxd_atype, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer + + use module_data_ecpp1 + + use mo_setsox, only : setsox + use mo_mass_xforms, only : mmr2vmr, vmr2mmr + use modal_aero_rename, only : modal_aero_rename_sub + use modal_aero_data, only : ntot_amode + use physconst, only: gravit + use ppgrid, only: pcols, pver + use time_manager, only: get_nstep + use mo_mean_mass, only: set_mean_mass + use chem_mods, only: gas_pcnst, nfs, indexm + use mo_setinv, only : setinv + use constituents, only: pcnst + use mo_gas_phase_chemdr, only: map2chm + use chemistry, only: imozart + use physics_buffer, only: physics_buffer_desc + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, itstep_sub, & + it, jt, kts, ktebnd, ktecen, & + itstep_hybrid +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_sub +! dtstep - main model time step (s) +! dtstep_sub - sub time step (s) currently used in ecpp main-integ routine + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, wbnd_bar, zbnd +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! zbnd - elevation (m) at layer boundaries +! dzcen - layer thicknesses (m) + + real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + integer, intent(in) :: ncls_ecpp, ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_new + + real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & + del_chem_clm_cldchem + + real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & + del_chem_clm_rename + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem3d ! 3D change from aqueous chemistry + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_rename3d ! 3D change from modal merging + + real(r8), intent(inout) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + real(r8), intent(inout), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & + xphlwc3d ! pH value multiplied by lwc + + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + ardz_cen_old, ardz_cen_new, acen_tavg_use, acen_prec_use + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 + + real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + type(physics_buffer_desc), pointer :: pbuf(:) + + + +! local variables + + integer :: icc, iccpp, iccpp1, iccpp2, ipp + integer :: jcls + integer :: k, kk, l, km + integer :: numgas_aqfrac + integer :: p1st + integer :: m, n + integer :: im, in, lnumcw + integer :: ncol + integer :: empty_troplev(pcols) = -99 ! This variable is not used in the modal_aero_rename_no_acc_crs_sub (which is + ! called witin modal_aero_rename_sub) when moal_accum_coars_exch is false + + real(r8) :: tmpa, tmpa1, tmpa2, tmpb1, tmpb2, tmpq, tmpq1, tmpq2, tmpx, tmpx2, tmpy, tmpy2 + real(r8) :: dtmpchem + + real(r8), parameter :: qcldwtr_cutoff = 1.0e-6_r8 + real(r8), parameter :: yph = 4.5_r8 ! in the MMF model, for ECPP, ph value is fixed at 4.5 + real(r8) :: dt_tmp + + real(r8), allocatable :: p_tmp(:,:,:), t_tmp(:,:,:), rho_tmp(:,:,:), & + alt_tmp(:,:,:), cldfra_tmp(:,:,:), & + qlsink_tmp(:,:,:), precr_tmp(:,:,:), & + precs_tmp(:,:,:), precg_tmp(:,:,:), preci_tmp(:,:,:) + real(r8), allocatable :: chem_tmpa(:,:,:,:), chem_tmpb(:,:,:,:), chem_tmpc(:,:,:,:) + + real(r8), allocatable :: cwat_tmp(:,:,:) + real(r8), allocatable :: pdel_tmp(:,:,:) + + real(r8), allocatable :: aqso4_tmp(:,:) + real(r8), allocatable :: aqh2so4_tmp(:,:) + real(r8), allocatable :: aqso4_h2o2_tmp(:) + real(r8), allocatable :: aqso4_o3_tmp(:) + real(r8), allocatable :: xphlwc_tmp(:,:) + real(r8), allocatable :: aqso4_h2o2_3dtmp(:,:) + real(r8), allocatable :: aqso4_o3_3dtmp(:,:) + + real(r8), allocatable :: mmr(:, :), vmr(:,:), mmrcw(:, :), vmrcw(:, :) + real(r8), allocatable :: vmr_3d(:,:,:), vmrcw_3d(:,:, :) + real(r8), allocatable :: vmr_sv1(:,:), vmrcw_sv1(:,:) + real(r8), allocatable :: mbar(:) + real(r8), allocatable :: mmr_3d(:, :, :), mmrcw_3d(:, :, :), mbar_3d(:, :) + real(r8), allocatable :: cldnum(:,:) + + real(r8) :: invariants_full(pcols, pver, nfs) + real(r8) :: t_full(pcols, pver) + real(r8) :: pmid_full(pcols, pver) + real(r8) :: h2ovmr_full(pcols, pver) + real(r8) :: vmr_full(pcols, pver, gas_pcnst) + + real(r8), allocatable :: qsrflx_full(:, :,:), qqcwsrflx_full(:, :,:) + integer :: nsrflx + integer :: nstep + integer :: jsrflx_rename + integer :: latndx_full(pcols, pver) + integer :: lonndx_full(pcols, pver) + real(r8) :: pdel_full(pcols, pver) + real(r8) :: dqdt(pver, gas_pcnst) + real(r8) :: dqdt_other(pver, gas_pcnst) + real(r8) :: dqqcwdt(pver, gas_pcnst) + real(r8) :: dqqcwdt_other(pver, gas_pcnst) + logical :: dotendrn(gas_pcnst) + logical :: dotendqqcwrn(gas_pcnst) + logical :: is_dorename_atik + logical :: dorename_atik(pver) + + p1st = param_first_ecpp + numgas_aqfrac = num_chem_ecpp + + nsrflx = 2 + jsrflx_rename = 2 + nstep = get_nstep() + + +! +! load arrays for interfacing with cloud chemistry subroutine +! +! use the wrfchem "i" index for the ecpp icc & ipp sub-class indices +! use the wrfchem "j" index for the ecpp jcls class index +! all the temporary real*4 arrays must be dimensioned kts:ktebnd +! + allocate ( p_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( t_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( rho_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( alt_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( cldfra_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( qlsink_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( precr_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( precs_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( precg_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( preci_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( cwat_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( pdel_tmp( 1:4,kts:ktecen,1:ncls_use) ) + allocate ( chem_tmpa( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) + allocate ( chem_tmpb( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) + allocate ( chem_tmpc( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) + + allocate ( mmr(kts:ktecen,1:gas_pcnst) ) + allocate ( vmr(kts:ktecen,1:gas_pcnst) ) + allocate ( mmrcw(kts:ktecen,1:gas_pcnst) ) + allocate ( vmrcw(kts:ktecen,1:gas_pcnst) ) + allocate ( vmr_sv1(kts:ktecen,1:gas_pcnst) ) + allocate ( vmrcw_sv1(kts:ktecen,1:gas_pcnst) ) + allocate ( mbar(kts:ktecen) ) + allocate ( cldnum(1,kts:ktecen) ) + allocate ( vmr_3d(1,kts:ktecen,1:gas_pcnst) ) + allocate ( vmrcw_3d(1,kts:ktecen,1:gas_pcnst) ) + allocate ( mmr_3d(1, kts:ktecen,1:gas_pcnst) ) + allocate ( mmrcw_3d(1, kts:ktecen, 1:gas_pcnst) ) + allocate ( mbar_3d(1, kts:ktecen) ) + + allocate (aqso4_tmp(1, ntot_amode)) + allocate (aqh2so4_tmp(1, ntot_amode)) + allocate (aqso4_h2o2_tmp(1)) + allocate (aqso4_o3_tmp(1)) + allocate (xphlwc_tmp(1,kts:ktecen)) + allocate (aqso4_h2o2_3dtmp(1,kts:ktecen)) + allocate (aqso4_o3_3dtmp(1,kts:ktecen)) + + allocate (qsrflx_full(pcols, gas_pcnst, nsrflx)) + allocate (qqcwsrflx_full(pcols, gas_pcnst, nsrflx)) + +! chem_tmpa, chem_tmpb and chem_tmpc start from bottom to top, just as chem_sub_new +! But mmr, mmrcw are reordered, starts from top to the bottom for aqueous chemistry at CAM. + do l = 1, num_chem_ecpp + do jcls = 1, ncls_use + do kk = kts, ktecen + k = min( kk, ktecen ) + do icc = 1, 2 + do ipp = 1, 2 + iccpp = 2*(icc-1) + ipp + chem_tmpa(iccpp,k,jcls,l) = chem_sub_new(k,icc,jcls,l) + end do + end do + end do + end do + end do + chem_tmpb(:,:,:,:) = chem_tmpa(:,:,:,:) + chem_tmpc(:,:,:,:) = chem_tmpa(:,:,:,:) + +! +! prepare fields for aqueous chemistry at CAM. + do kk = kts, ktecen + k = min( kk, ktecen ) +! +! vertical coordinate is from bottom to top in the ECPP, +! so convert it to from top to the bottom for aqueous chemistry at CAM. + km = ktecen-k+1 + p_tmp(1:4,k,1:ncls_use) = pcen_bar(km) + t_tmp(1:4,k,1:ncls_use) = tcen_bar(km) + rho_tmp(1:4,k,1:ncls_use) = rhocen_bar(km) + alt_tmp(1:4,k,1:ncls_use) = 1.0_r8/rhocen_bar(km) + pdel_tmp(1:4,k,1:ncls_use) = rhocen_bar(km)*dzcen(km)*gravit + end do + + cldfra_tmp(:,:,:) = 0.0_r8 + qlsink_tmp(:,:,:) = 0.0_r8 + precr_tmp(:,:,:) = 0.0_r8 + precg_tmp(:,:,:) = 0.0_r8 + precs_tmp(:,:,:) = 0.0_r8 + preci_tmp(:,:,:) = 0.0_r8 + cwat_tmp(:,:,:) = 0.0_r8 + + do jcls = 1, ncls_use + do k = kts, ktecen +! +! vertical coordinate is from bottom to top in the ECPP, +! so convert it to from top to the bottom for aqueous chemistry at CAM. + km = ktecen-k+1 + do icc = 1, 2 + do ipp = 1, 2 + iccpp = 2*(icc-1) + ipp + if (ipp == 1) then + tmpa = acen_tavg_use(km,icc,jcls) - acen_prec_use(km,icc,jcls) + else + tmpa = acen_prec_use(km,icc,jcls) + end if + tmpq = qcloud_sub2(km,icc,jcls,ipp) + if ((tmpa > afrac_cut_0p5) .and. (tmpq > qcldwtr_cutoff)) then + qlsink_tmp(iccpp,k,jcls) = qlsink_sub2(km,icc,jcls,ipp) + cwat_tmp(iccpp,k,jcls) = tmpq + end if + + if (icc == 2) then + if(tmpa > afrac_cut_0p5) then + cldfra_tmp(iccpp,k,jcls) = 1.0_r8 + end if + end if + + precr_tmp(iccpp,k,jcls) = precr_sub2(km,icc,jcls,ipp) + precs_tmp(iccpp,k,jcls) = precs_sub2(km,icc,jcls,ipp) + end do + end do + end do + end do + + + dt_tmp = dtstep_sub + + if (cldchem_onoff_ecpp > 0) then + + do jcls = 1, ncls_use + do icc = 2, 2 ! In clear sky, cloud chemistry and renaming are not called. + do ipp = 1, 2 + iccpp = 2*(icc-1) + ipp + ncol = 1 + + !---------------------------------------------------------------------- + ! calculate cldnum from cloud borne aerosol particles + ! Vertical coordinate is from bottom to top in the ECPP for chem_tempb, + ! so convert it to from top to the bottom for aqueous chemistry at CAM. + !---------------------------------------------------------------------- + cldnum(1,:) = 0.0_r8 + do in=1, ntype_aer + do im=1, nsize_aer(in) + lnumcw = numptr_aer(im, in, cw_phase) + do k=kts, ktecen + km=ktecen-k+1 + cldnum(1,k) = cldnum(1,k)+chem_tmpb(iccpp,km,jcls,lnumcw) + end do + end do + end do + + !----------------------------------------------------------------------- + ! ... map incoming concentrations to working array + ! Vertical coordinate is from bottom to top in the ECPP for chem_tempb, + ! so convert it to from top to the bottom for aqueous chemistry at CAM. + !----------------------------------------------------------------------- + mmr(:, :) = 0.0_r8 + mmrcw(:, :) = 0.0_r8 + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + do k = kts, ktecen + km = ktecen-k+1 + mmr(k,n) = chem_tmpb(iccpp,km,jcls,m) + mmrcw(k,n) = chem_tmpb(iccpp,km,jcls,m+pcnst) + end do + end if + end do + + !----------------------------------------------------------------------- + ! ... Set atmosphere mean mass + !----------------------------------------------------------------------- + mmr_3d(1, :, :) = mmr(:, :) + call set_mean_mass( ncol, mmr_3d, mbar_3d ) + mbar(:) = mbar_3d(1, :) + + !----------------------------------------------------------------------- + ! ... Xform from mmr to vmr + !----------------------------------------------------------------------- + vmr_3d(1, :, :) = vmr(:, :) + mmr_3d(1, :, :) = mmr(:, :) + mmrcw_3d(1, :, :) = mmrcw(:, :) + vmrcw_3d(1, :, :) = vmrcw(:, :) + call mmr2vmr( mmr_3d, vmr_3d, mbar_3d, ncol ) + call mmr2vmr( mmrcw_3d, vmrcw_3d, mbar_3d, ncol ) + + vmr_sv1 = vmr_3d(1,:,:) + vmrcw_sv1 = vmrcw_3d(1,:,:) + + vmr(:,:) = vmr_3d(1,:,:) + vmrcw(:,:) = vmrcw_3d(1,:,:) + + !----------------------------------------------------------------------- + ! ... Set the "invariants" + !----------------------------------------------------------------------- + h2ovmr_full(:, :) = 0.0_r8 ! h2ommr is not used in CAM aqueous chemistry, so set it to zero here. + do kk = kts, ktecen + k = min( kk, ktecen) + t_full(:, k) = t_tmp(iccpp, k,jcls) + pmid_full(:, k) = p_tmp(iccpp, k, jcls) + do n=1, gas_pcnst + vmr_full(:, k, n) = vmr(k, n) + end do + end do + call setinv( invariants_full(:it,:,:), t_full, h2ovmr_full(:it,:), vmr_full(:it,:,:), pmid_full, it, jt, pbuf) ! jt=lchnk + + !-------------------------------------------------------------------------- + ! ... Aqueous chemistry + !-------------------------------------------------------------------------- + call setsox( ncol, & ! ncol + jt, & ! lchnk + imozart-1,& ! loffset + dt_tmp, & ! dtime + p_tmp(iccpp:iccpp, :, jcls), & ! press + pdel_tmp(iccpp:iccpp, :, jcls), & ! pdel + t_tmp(iccpp:iccpp, :, jcls), & ! tfld + mbar_3d, & ! mbar(1,:) + cwat_tmp(iccpp:iccpp, :, jcls), & ! lwc + cldfra_tmp(iccpp:iccpp, :, jcls), & ! cldfrc + cldnum, & ! cldnum + invariants_full(it:it,:,indexm), & ! xhnm + invariants_full(it:it,:,:), & ! invariants + vmrcw_3d, & ! qcw + vmr_3d, & ! qin + xphlwc_tmp, & + aqso4_tmp, & + aqh2so4_tmp, & + aqso4_h2o2_tmp, & + aqso4_o3_tmp, & + yph, & + aqso4_h2o2_3dtmp, & + aqso4_o3_3dtmp ) + + !----------------------------------------------------------------------- + ! ... Xform from vmr to mmr + !----------------------------------------------------------------------- + vmr(:,:) = vmr_3d(1,:,:) + vmrcw(:,:) = vmrcw_3d(1,:,:) + call vmr2mmr( vmr, mmr_3d, mbar, ncol ) + call vmr2mmr( vmrcw, mmrcw_3d, mbar, ncol ) + mmr(:, :) = mmr_3d(1, :, :) + mmrcw(:, :) = mmrcw_3d(1, :, :) + + !----------------------------------------------------------------------- + ! ... Form the tendencies + ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, + ! so convert it to from bottom to the top in the ECPP for chem_tmpb. + !----------------------------------------------------------------------- + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + do k = kts, ktecen + km = ktecen-k+1 + chem_tmpb(iccpp, k,jcls,m) = mmr(km,n) + chem_tmpb(iccpp, k,jcls,m+pcnst) = mmrcw(km,n) + end do + end if + end do + + do k = kts, ktecen + km = ktecen-k+1 ! acen is defined in the ECPP (from bottom to top) + if (ipp == 1) then + tmpa = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) + else + tmpa = acen_prec_use(k,icc,jcls) + end if + if (tmpa > afrac_cut_0p5) then + aqso4_h2o2 = aqso4_h2o2+tmpa * aqso4_h2o2_3dtmp(1, km)*dt_tmp + aqso4_o3 = aqso4_o3 + tmpa * aqso4_o3_3dtmp(1, km)*dt_tmp + end if +! +! xphlwc_tmp is defined in CAM( top to bottom), and xphlwc3d is defined in ECPP (bottom to top) + xphlwc3d(k,icc,jcls,ipp) = xphlwc3d(k,icc,jcls,ipp) + xphlwc_tmp(1,km) * tmpa + + end do + +!----------------------------------------------------------------------------- +! ----- renaming: modal aerosol mode merging ------ +!----------------------------------------------------------------------------- + if(rename_onoff_ecpp > 0) then + do kk = kts, ktecen + k = min( kk, ktecen) + pdel_full(:, k) = p_tmp(iccpp, k, jcls) + end do + latndx_full(:,:) = 1 + lonndx_full(:,:) = 1 + qsrflx_full(:,:,:) = 0.0_r8 + qqcwsrflx_full(:,:,:) = 0.0_r8 + dotendrn(:) = .false. + dotendqqcwrn(:) = .false. + dorename_atik(:) = .true. + is_dorename_atik = .true. + dqdt (:,:) = 0.0_r8 + dqqcwdt(:,:) = 0.0_r8 + dqdt_other(:,:)=(vmr-vmr_sv1)/dt_tmp + dqqcwdt_other(:,:)=(vmrcw-vmrcw_sv1)/dt_tmp + + call modal_aero_rename_sub('ecpp_modal_cloudchem', jt, & + ncol, nstep, & + imozart-1, dt_tmp, & + pdel_full, empty_troplev, & + dotendrn, vmr, & + dqdt, dqdt_other, & + dotendqqcwrn, vmrcw, & + dqqcwdt, dqqcwdt_other, & + is_dorename_atik, dorename_atik, & + jsrflx_rename, nsrflx, & + qsrflx_full, qqcwsrflx_full ) + vmr = vmr + dqdt * dt_tmp + vmrcw = vmrcw + dqqcwdt * dt_tmp + + !----------------------------------------------------------------------- + ! ... Xform from vmr to mmr + !----------------------------------------------------------------------- + call vmr2mmr( vmr, mmr_3d, mbar, ncol ) + call vmr2mmr( vmrcw, mmrcw_3d, mbar, ncol ) + mmr(:, :) = mmr_3d(1, :, :) + mmrcw(:, :) = mmrcw_3d(1, :, :) + + !----------------------------------------------------------------------- + ! ... Form the tendencies + ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, + ! so convert it to from bottom to the top in the ECPP for chem_tmpb. + !----------------------------------------------------------------------- + do m = 1,pcnst + n = map2chm(m) + if( n > 0 ) then + do k = kts, ktecen + km = ktecen-k+1 + chem_tmpc(iccpp, k,jcls,m) = mmr(km,n) + chem_tmpc(iccpp, k,jcls,m+pcnst) = mmrcw(km,n) + end do + end if + end do + + + end if ! (rename_onoff_ecpp > 0) + + end do + end do + end do + + do l = p1st, num_chem_ecpp + tmpx = 0.0_r8 + tmpx2 = 0.0_r8 + do k = kts, ktecen + tmpy = 0.0_r8 + tmpy2 = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do ipp = 1, 2 + iccpp = 2*(icc-1) + ipp + if (ipp == 1) then + tmpa = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) + else + tmpa = acen_prec_use(k,icc,jcls) + end if + + if (tmpa > afrac_cut_0p5) then + tmpq = (chem_tmpb(iccpp,k,jcls,l) - chem_tmpa(iccpp,k,jcls,l)) + tmpy = tmpy + tmpa*tmpq + del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+tmpa*tmpq + else + del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+0.0_r8 + end if + + if(rename_onoff_ecpp > 0 ) then + if (tmpa > afrac_cut_0p5) then + tmpq = (chem_tmpc(iccpp,k,jcls,l) - chem_tmpb(iccpp,k,jcls,l)) + tmpy2 = tmpy2 + tmpa*tmpq + del_rename3d(k,icc,jcls,ipp,l)=del_rename3d(k,icc,jcls,ipp,l)+tmpa*tmpq + else + del_rename3d(k,icc,jcls,ipp,l)=del_rename3d(k,icc,jcls,ipp,l)+0.0_r8 + end if + end if ! (rename_onoff_ecpp > 0.) + + end do ! ipp + end do ! icc + end do ! jcls + tmpx = tmpx + tmpy*rhodz_cen(k) + if(rename_onoff_ecpp > 0 ) tmpx2 = tmpx2+tmpy2 * rhodz_cen(k) + end do ! k + + del_chem_clm_cldchem(l) = del_chem_clm_cldchem(l) + tmpx + if(rename_onoff_ecpp > 0 ) & + del_chem_clm_rename(l) = del_chem_clm_rename(l) + tmpx2 + end do ! l + + end if ! (cldchem_onoff_ecpp > 0) + + if ((cldchem_onoff_ecpp > 0)) then + + do l = p1st, num_chem_ecpp + do k = kts, ktecen + do jcls = 1, ncls_use + do icc = 1, 2 + tmpa1 = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) + tmpa2 = acen_prec_use(k,icc,jcls) + if ((tmpa1 <= afrac_cut_0p5) .and. (tmpa2 <= afrac_cut_0p5)) cycle + + iccpp1 = 2*(icc-1) + 1 + iccpp2 = 2*(icc-1) + 2 + + if(rename_onoff_ecpp > 0 ) then + if ((tmpa1 > afrac_cut_0p5) .and. (tmpa2 > afrac_cut_0p5)) then + tmpb1 = max( 0.0_r8, min( 1.0_r8, (tmpa1/(tmpa1+tmpa2)) ) ) + tmpb2 = 1.0_r8 - tmpb1 + tmpq1 = chem_tmpa(iccpp1,k,jcls,l)*tmpb1 & + + chem_tmpa(iccpp2,k,jcls,l)*tmpb2 + tmpq2 = chem_tmpc(iccpp1,k,jcls,l)*tmpb1 & + + chem_tmpc(iccpp2,k,jcls,l)*tmpb2 + else if (tmpa1 > afrac_cut_0p5) then + tmpq1 = chem_tmpa(iccpp1,k,jcls,l) + tmpq2 = chem_tmpc(iccpp1,k,jcls,l) + else + tmpq1 = chem_tmpa(iccpp2,k,jcls,l) + tmpq2 = chem_tmpc(iccpp2,k,jcls,l) + end if + else ! no renaming + if ((tmpa1 > afrac_cut_0p5) .and. (tmpa2 > afrac_cut_0p5)) then + tmpb1 = max( 0.0_r8, min( 1.0_r8, (tmpa1/(tmpa1+tmpa2)) ) ) + tmpb2 = 1.0_r8 - tmpb1 + tmpq1 = chem_tmpa(iccpp1,k,jcls,l)*tmpb1 & + + chem_tmpa(iccpp2,k,jcls,l)*tmpb2 + tmpq2 = chem_tmpb(iccpp1,k,jcls,l)*tmpb1 & + + chem_tmpb(iccpp2,k,jcls,l)*tmpb2 + else if (tmpa1 > afrac_cut_0p5) then + tmpq1 = chem_tmpa(iccpp1,k,jcls,l) + tmpq2 = chem_tmpb(iccpp1,k,jcls,l) + else + tmpq1 = chem_tmpa(iccpp2,k,jcls,l) + tmpq2 = chem_tmpb(iccpp2,k,jcls,l) + end if + end if ! (rename_onoff_ecpp > 0) + if (tmpq1 /= tmpq2) chem_sub_new(k,icc,jcls,l) = tmpq2 + + end do ! icc + end do ! jcls + end do ! k + end do ! l + + end if ! ((cldchem_onoff_ecpp > 0)) + + + deallocate ( p_tmp, t_tmp, rho_tmp, alt_tmp, & + cldfra_tmp, & + qlsink_tmp, & + precr_tmp, precs_tmp, precg_tmp, preci_tmp ) + deallocate ( chem_tmpa, chem_tmpb, chem_tmpc) + deallocate ( mmr, mmrcw, vmr, vmrcw, vmr_sv1, vmrcw_sv1, & + mbar, cldnum, mmr_3d, mmrcw_3d, mbar_3d, & + qsrflx_full, qqcwsrflx_full) + + deallocate ( cwat_tmp, pdel_tmp, vmr_3d, vmrcw_3d, & + aqso4_tmp, aqh2so4_tmp, aqso4_h2o2_tmp, & + aqso4_o3_tmp, xphlwc_tmp, aqso4_h2o2_3dtmp, & + aqso4_o3_3dtmp) + return + end subroutine parampollu_tdx_cldchem + +end module ecpp_modal_cloudchem diff --git a/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 b/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 new file mode 100644 index 0000000000..862f45278c --- /dev/null +++ b/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 @@ -0,0 +1,1898 @@ +module ecpp_modal_wetscav + +!----------------------------------------------------------------- +! Module interface for cloud chemistry used in the ECPP treatment +! in the MMF model +! Adopted the similar one used in the ECPP +! for the WRF-chem model written by Dick Easter +! +! Minghuai Wang, 2009-11 +!------------------------------------------------------------------ + use shr_kind_mod, only: r8 => shr_kind_r8 + use perf_mod + use cam_abortutils, only: endrun + + implicit none + + public parampollu_tdx_wetscav_2 + +contains + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_wetscav_2( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + itstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & +! rhobnd_bar, zbnd, wbnd_bar, & not needed ? +! chem_bar, & not needed ? +! ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & +! kdraft_bot_use, kdraft_top_use, & not needed ? +! mtype_updnenv_use, & not needed ? + chem_sub_new, & + del_chem_clm_wetscav, & + del_wetscav3d, del_wetresu3d, & +! ardz_cen_old, ardz_cen_new, & not needed ? + rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & +! chem_bar_iccfactor, & not needed ? + activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_wetscav_2 does wet scavenging of aerosols only +! for one main-integ time sub-step +! +! incoming chem_sub_new holds current sub-class mixing ratios +! outgoing chem_sub_new holds updated sub-class mixing ratios +! +!----------------------------------------------------------------------- + +! use module_state_description, only: p_qv, p_qc + +! use module_data_radm2, only: epsilc + +! use module_data_mosaic_asect, only: ai_phase, cw_phase, & +! massptr_aer, maxd_asize, maxd_atype, & +! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & +! waterptr_aer + use module_data_mosaic_asect, only: & + ai_phase, cw_phase, & + massptr_aer, maxd_asize, maxd_atype, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer + + use module_data_ecpp1 + +! use module_ecpp_hoststuff, only: config_flags_ecpp + +! use module_mosaic_wetscav, only: wetscav_cbmz_mosaic + +! use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & +! parampollu_1clm_set_opts + + implicit none + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, itstep_sub, & + it, jt, kts, ktebnd, ktecen + integer, intent(in) :: itstep_hybrid +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & + idiagbb_wetscav + + real(r8), intent(in) :: dtstep, dtstep_sub +! dtstep - main model time step (s) +! dtstep_sub - sub time step (s) currently used in ecpp main-integ routine + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen +! real(r8), intent(in), dimension( kts:ktebnd ) :: & +! rhobnd_bar, wbnd_bar, zbnd +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! zbnd - elevation (m) at layer boundaries +! dzcen - layer thicknesses (m) + +! real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & +! chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + integer, intent(in) :: ncls_use +! integer, intent(in) :: ncls_ecpp + +! integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & +! kdraft_bot_use, kdraft_top_use, & +! mtype_updnenv_use + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_new + + real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & + del_chem_clm_wetscav +! del_chem_clm_wetscav(l) = & +! sum( rhodz_cen(kts:ktecen) * ( del_wetscav3d(kts:ktecen,1:2,1:ncls_use,1:2,l) & +! + del_wetresu3d(kts:ktecen,1:2,1:ncls_use,1:2,l) ) ) + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_wetscav3d, del_wetresu3d +! del_wetscav3d = acen * (change to chem_sub due to uptake by precip) +! the change for the current time sub-step is added to this array, so the array holds +! the cummulative change over multiple time steps +! this is always negative (or zero), and units are (kg/m^2) +! del_wetresu3d = acen * (change to chem_sub due to resuspension from precip evaporation) +! this is always positive (or zero), and units are (kg/m^2) +! +! units for del_wetscav/resu3d will be (kg/m^2) or (#/m^2) in cam, +! where all tracer mixing ratios are (kg/kgair) +! in wrfchem, units are (ug/m^2) and (#/m^2) for aerosol mass and number +! for gases, they are (mg/m^2) AFTER one applies a molecular weight ratio +! the important thing is that their sum is always equal to the column burden change, +! where column burden = sum_over_k[ (mixing ratio)*(air density, kg/m^3)*(dz, m) ] + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg_use, acen_prec_use +! ardz_cen_old, ardz_cen_new, + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 + +! real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + + + +! local variables + integer, parameter :: nwdt = 1 + + integer :: icc, icc_g, icc_l, iphase, ipp, ipp_l, ipp_g + integer :: jcls, jcls_g, jcls_l + integer :: k, kk, km1, kp1 + integer :: l, ll, lun142 + integer :: lgas_scav(1:num_chem_ecpp) + integer :: m, mwdt + integer :: n + integer, parameter :: maxgas_scav = 4 + integer :: ngas_scav + integer :: p1st + integer :: inwdt + + logical :: skip_aer_resu, skip_gas_scav + logical, dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + is_active, is_precp, is_ptgain, is_ptloss, is_rain +! is_active = .true. if sub-subarea has acen > afrac_cut_0p5 +! is_precp = .true. if sub-subarea has prtb > prsmall +! is_ptgain = .true. prtb increases from k+1 to k for the sub-subarea +! is_ptloss = .true. prtb decreases from k+1 to k for the sub-subarea + logical, dimension( 1:2, 1:maxcls_ecpp, 1:2 ) :: & + ltmp_aa3d + + real(r8) :: delprtb_gtot, delprtb_ltot, delprtb_xtot + real(r8) :: dt_scav + real(r8) :: flxdt, flxdt_kp1 + real(r8) :: qgcx, qgcx_bgn + real(r8) :: frac_scav + real(r8) :: prsmall + real(r8) :: rate_scav + real(r8) :: scavcoef + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpq + real(r8) :: tmpx, tmpx2, tmpy, tmpy2 + real(r8) :: tmpa1, tmpa2, tmpb1, tmpb2, tmpq1, tmpq2 + real(r8) :: tmp_ardzcen, tmpvol + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + chem_tmpa, chem_tmpb + real(r8), dimension( 1:num_chem_ecpp ) :: curdel_chem_clm_wetscav + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:max_wetdiagtype, 1:num_chem_ecpp ) :: & + delchem_wetscav, delchem_wetresu +! delchem_wetscav = [ change to chem from wet scavenging over dt_scav ] ] * acen_tmp * rhodz_cen +! so units are (kg/m^2) +! delchem_wetresu = similar, but change from resuspension (due to precip evap) + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:max_wetdiagtype, 1:num_chem_ecpp ) :: & + chem_prflxdt, chem_prflxdt_xfer +! chem_prflxdt = [ downwards flux of precip-borne-tracers (kg/m^2/s) for subarea +! if it were spread over the entire host-code grid cell area ] * dt_scav +! so units are (kg/m^2) +! chem_prflxdt_xfer = net transfer of chem_prflxdt into subarea from other subareas + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: acen_tmp +! acen_tmp = fractional at layer centers for all 2 X 3 X 2 sub-subareas + real(r8), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: prra, prsa, prta, prtb +! prta = total (liquid + solid) precip rate (kg/m^2/s) within the subarea +! prra, prsa = liquid, solid precip rate (kg/m^2/s) within the subarea +! prtb = prta*acen_tmp = subarea precip rate +! if it were spread over the entire host-code grid cell area + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + delprtb, delprtb_g, delprtb_l +! depprtb = change in prtb from k+1 to k (kg/m^2/s) +! depprtb_g = increase in prtb from k+1 to k +! depprtb_l = abs( decrease in prtb from k+1 to k ) + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_evap_prtb + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & + 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_xfer_prtb + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & + 1:2, 1:maxcls_ecpp, 1:2 ) :: fxaa_evap_prtb +! frac_evap_prtb = fraction of precip (and precip-borne aerosols) entering the +! top of a subarea that is evaporated/resuspended +! frac_xfer_prtb = fraction of precip (and precip-borne aerosols) entering the +! top of a subarea that is transferred to another subarea +! (the first set of icc,jcls,ipp indices are the "xfer from" subarea) +! (the second set of icc,jcls,ipp indices are the "xfer to " subarea) + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:maxd_asize, 1:maxd_atype ) :: & + scavcoef_num, scavcoef_vol +! scavcoef_vol = below-cloud scavenging coeficient for volume (1/mm) +! scavcoef_num = below-cloud scavenging coeficient for number (1/mm) +! when precip rate = xxx kg/m2/s == xxx mm/s, the scavenging rate (1/s) = scavcoef*xxx + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, maxgas_scav ) :: & + gasscav_aa, gasscav_bb + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + gasscav_cc + + + call t_startf('ecpp_wetscav_init') +! write(*,'(a)') 'wetscav_2 doing part 1 stuff' + + lun142 = -1 + if (idiagaa_ecpp(142) > 0) lun142 = ldiagaa_ecpp(142) + if (idiagbb_wetscav <= 0) lun142 = -1 + + p1st = param_first_ecpp + dt_scav = dtstep_sub + + mwdt = 1 + + skip_gas_scav = .false. ! flag for gas scavenging on/off + if (wetscav_onoff_ecpp < 400) skip_gas_scav = .true. + skip_aer_resu = .false. ! flag for aerosol resuspension on/off + if (wetscav_onoff_ecpp == 310) skip_aer_resu = .true. + if (wetscav_onoff_ecpp == 410) skip_aer_resu = .true. + +! load chem_tmpa array + chem_tmpa = 0.0_r8 + do l = p1st, num_chem_ecpp + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + chem_tmpa(k,icc,jcls,1:2,l) = chem_sub_new(k,icc,jcls,l) + end do + end do + end do + end do + chem_tmpb(:,:,:,:,:) = chem_tmpa(:,:,:,:,:) + + curdel_chem_clm_wetscav(:) = 0.0_r8 + delchem_wetscav(:,:,:,:,:,:) = 0.0_r8 + delchem_wetresu(:,:,:,:,:,:) = 0.0_r8 + chem_prflxdt(:,:,:,:,:,:) = 0.0_r8 + chem_prflxdt_xfer(:,:,:,:,:,:) = 0.0_r8 + + +! precip rates -- 1.0 kgwtr/m^2/s = 1.0e-3 m3wtr/m^2/s = 1.0e-3 m/s +! 7.06e-5 kg/m^2/s = 7.06e-8 m/s = 0.01 inch/h +! 1.00e-7 kg/m^2/s = 1.00e-10 m/s = (0.01 inch/h) * 0.0014 is a very small precip rate! + prsmall = 1.0e-7_r8 + +! load precip rates for each icc,jcls,ipp subarea + prta(:,:,:,:) = 0.0_r8 + prtb(:,:,:,:) = 0.0_r8 + prra(:,:,:,:) = 0.0_r8 + prsa(:,:,:,:) = 0.0_r8 + acen_tmp(:,:,:,:) = 0.0_r8 + + is_active(:,:,:,:) = .false. + is_precp(:,:,:,:) = .false. + is_ptgain(:,:,:,:) = .false. + is_ptloss(:,:,:,:) = .false. + is_rain(:,:,:,:) = .false. + + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + tmpa = max( 0.0_r8, acen_tavg_use(k,icc,jcls) ) + tmpb = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) + tmpb = min( tmpa, tmpb ) + + if (tmpa <= afrac_cut_0p5) then ! both ipp=1&2 have near-zero area + continue + else if (tmpb <= afrac_cut_0p5) then ! ipp=2 has near-zero area + is_active(k,icc,jcls,1) = .true. + acen_tmp(k,icc,jcls,1) = tmpa + prta(k,icc,jcls,1) = precr_sub2(k,icc,jcls,1) + precs_sub2(k,icc,jcls,1) + prtb(k,icc,jcls,1) = prta(k,icc,jcls,1)*acen_tmp(k,icc,jcls,1) + else if (tmpa-tmpb <= afrac_cut_0p5) then ! ipp=1 has near-zero area + is_active(k,icc,jcls,2) = .true. + acen_tmp(k,icc,jcls,2) = tmpb + prta(k,icc,jcls,2) = precr_sub2(k,icc,jcls,2) + precs_sub2(k,icc,jcls,2) + prtb(k,icc,jcls,2) = prta(k,icc,jcls,2)*acen_tmp(k,icc,jcls,2) + else ! both ipp=1&2 have areas > threshold + is_active(k,icc,jcls,1) = .true. + acen_tmp(k,icc,jcls,1) = tmpa-tmpb + prta(k,icc,jcls,1) = precr_sub2(k,icc,jcls,1) + precs_sub2(k,icc,jcls,1) + prtb(k,icc,jcls,1) = prta(k,icc,jcls,1)*acen_tmp(k,icc,jcls,1) + is_active(k,icc,jcls,2) = .true. + acen_tmp(k,icc,jcls,2) = tmpb + prta(k,icc,jcls,2) = precr_sub2(k,icc,jcls,2) + precs_sub2(k,icc,jcls,2) + prtb(k,icc,jcls,2) = prta(k,icc,jcls,2)*acen_tmp(k,icc,jcls,2) + end if + + do ipp = 1, 2 + if ( is_active(k,icc,jcls,ipp) ) then + prtb(k,icc,jcls,ipp) = prta(k,icc,jcls,ipp)*acen_tmp(k,icc,jcls,ipp) + if (prtb(k,icc,jcls,ipp) > prsmall) then + is_precp(k,icc,jcls,ipp) = .true. + prsa(k,icc,jcls,ipp) = precs_sub2(k,icc,jcls,ipp) + if (precr_sub2(k,icc,jcls,ipp)*acen_tmp(k,icc,jcls,ipp) > prsmall) then + prra(k,icc,jcls,ipp) = precr_sub2(k,icc,jcls,ipp) + is_rain(k,icc,jcls,ipp) = .true. + end if + else + prta(k,icc,jcls,ipp) = 0.0_r8 + prtb(k,icc,jcls,ipp) = 0.0_r8 + end if + end if + end do + end do + end do + end do + call t_stopf('ecpp_wetscav_init') + + +! +! calculate the fractions of precip (and precip-borne aerosols) +! entering the top of a subarea that are either +! > evaporated/resuspended or +! > transferred to another subarea +! + call t_startf('ecpp_wetscav_precip_evap') + call wetscav_2_precip_evap_xfer( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + is_active, is_precp, is_ptgain, is_ptloss, & + acen_tmp, prtb, frac_evap_prtb, frac_xfer_prtb, & + fxaa_evap_prtb ) + call t_stopf('ecpp_wetscav_precip_evap') + + +! +! calculate below-cloud scavenging coeficients for interstitial aerosols +! + call t_startf('ecpp_wetscav_bcscav') + call wetscav_2_bcscavcoef( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + rh_sub2, & + is_active, is_precp, & + chem_tmpa, scavcoef_num, scavcoef_vol ) + call t_stopf('ecpp_wetscav_bcscav') + + +! +! calculate stuff for below-cloud gas scavenging +! + call t_startf('ecpp_wetscav_gascav') + call wetscav_2_gasscav( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + dt_scav, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + is_active, is_precp, is_rain, & + maxgas_scav, ngas_scav, lgas_scav, & + acen_tmp, prra, & + qcloud_sub2, qlsink_sub2, & + gasscav_aa, gasscav_bb, gasscav_cc ) + call t_stopf('ecpp_wetscav_gascav') + + +! +! +! now calculate +! in-cloud & below-cloud aerosol wet removal +! below-cloud resuspension from evaporating precip +! +! + call t_startf('ecpp_wetscav_main') +wetscav_main_kloop_aa: & + do k = ktecen, kts, -1 + + +! set precip-borne_flux to that of layer above + if (k < ktecen) then + chem_prflxdt(k,:,:,:,:,:) = chem_prflxdt(k+1,:,:,:,:,:) + end if + if (wetscav_onoff_ecpp < 200) cycle wetscav_main_kloop_aa + + +! +! do transfer of precip-borne tracers between subareas +! and resuspension from evaporation +! + if (k < ktecen) then +! loop over the "losing" subareas + do jcls_l = 1, ncls_use + do ipp_l = 1, 2 + do icc_l = 1, 2 + if ( .not. is_ptloss(k,icc_l,jcls_l,ipp_l) ) cycle + +! loop over the "gaining" subareas, +! transferring chem_prflxdt from losing to gaining subarea + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + if ( .not. is_ptgain(k,icc_g,jcls_g,ipp_g) ) cycle + tmpa = frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) + if (tmpa <= 0.0_r8) cycle + do l = p1st, num_chem_ecpp + if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle + tmpb = chem_prflxdt(k+1,icc_l,jcls_l,ipp_l,mwdt,l)*tmpa + chem_prflxdt(k ,icc_g,jcls_g,ipp_g,mwdt,l) = & + chem_prflxdt(k ,icc_g,jcls_g,ipp_g,mwdt,l) + tmpb + chem_prflxdt(k ,icc_l,jcls_l,ipp_l,mwdt,l) = & + chem_prflxdt(k ,icc_l,jcls_l,ipp_l,mwdt,l) - tmpb + + chem_prflxdt_xfer(k ,icc_g,jcls_g,ipp_g,mwdt,l) = & + chem_prflxdt_xfer(k ,icc_g,jcls_g,ipp_g,mwdt,l) + tmpb + chem_prflxdt_xfer(k ,icc_l,jcls_l,ipp_l,mwdt,l) = & + chem_prflxdt_xfer(k ,icc_l,jcls_l,ipp_l,mwdt,l) - tmpb + end do + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + +! do resuspension from evaporation here + tmpa = frac_evap_prtb(k,icc_l,jcls_l,ipp_l) + if (tmpa <= 0.0_r8) cycle + + tmp_ardzcen = acen_tmp(k,icc_l,jcls_l,ipp_l)*rhodz_cen(k) + do l = p1st, num_chem_ecpp + if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle + if ( skip_aer_resu .and. (inmw_of_aerosol(l) > 0)) cycle + tmpd = chem_prflxdt(k+1,icc_l,jcls_l,ipp_l,mwdt,l)*tmpa + delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) = & + delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) + tmpd + chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) = & + chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) - tmpd + + if ( is_active(k,icc_l,jcls_l,ipp_l) ) then +! normally resuspend into (k,icc_l,jcls_l,ipp_l) + chem_tmpb(k,icc_l,jcls_l,ipp_l,l) = & + chem_tmpb(k,icc_l,jcls_l,ipp_l,l) + tmpd/tmp_ardzcen + else +! if (k,icc_l,jcls_l,ipp_l) is not active (acen_tmp ~= 0), then resuspend +! uniformly across all active subareas +! (tmpd/rhodz_cen(k)) is the delta(chem) spread over the entire grid area + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + tmpf = fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) + if (tmpf <= afrac_cut_0p5) cycle + chem_tmpb(k,icc_g,jcls_g,ipp_g,l) = & + chem_tmpb(k,icc_g,jcls_g,ipp_g,l) + tmpd/(tmpf*rhodz_cen(k)) + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + end if + end do ! l + + end do ! icc_l + end do ! ipp_l + end do ! jcls_l + end if ! (k < kte_cen) + + +! +! do additional resuspension for gases +! currently gases are only in rain (none in solid precip), +! and the previous resuspension involves total precip +! if rain ~= zero in a subarea, then resuspend any rainborne gases +! + if ((k < ktecen) .and. ( .not. skip_gas_scav )) then + do jcls_l = 1, ncls_use + do ipp_l = 1, 2 + do icc_l = 1, 2 + if ( is_rain(k,icc_l,jcls_l,ipp_l) ) cycle + + tmp_ardzcen = acen_tmp(k,icc_l,jcls_l,ipp_l)*rhodz_cen(k) + if ( .not. is_active(k,icc_l,jcls_l,ipp_l) ) then + tmpf = 0.0_r8 + ltmp_aa3d(:,:,:) = .false. + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + if ( .not. is_active(k,icc_g,jcls_g,ipp_g) ) cycle + if ((jcls_g == jcls_l) .and. & + (ipp_g == ipp_l) .and. (icc_g == icc_l)) cycle + tmpf = tmpf + acen_tmp(k,icc_g,jcls_g,ipp_g) + ltmp_aa3d(icc_g,jcls_g,ipp_g) = .true. + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + end if + + do ll = 1, ngas_scav + l = lgas_scav(ll) + if ((l < p1st) .or. (l > num_chem_ecpp)) cycle + tmpd = chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) + if (tmpd <= 0.0_r8) cycle + + delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) = & + delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) + tmpd + chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) = 0.0_r8 + + if ( is_active(k,icc_l,jcls_l,ipp_l) ) then +! resuspend into (k,icc_l,jcls_l,ipp_l) + chem_tmpb(k,icc_l,jcls_l,ipp_l,l) = & + chem_tmpb(k,icc_l,jcls_l,ipp_l,l) + tmpd/tmp_ardzcen + else +! (k,icc_l,jcls_l,ipp_l) is not active, so resuspend across all active subareas + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + if ( .not. ltmp_aa3d(icc_g,jcls_g,ipp_g) ) cycle + chem_tmpb(k,icc_g,jcls_g,ipp_g,l) = & + chem_tmpb(k,icc_g,jcls_g,ipp_g,l) + tmpd/rhodz_cen(k) + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + end if + end do ! ll + + end do ! icc_l + end do ! ipp_l + end do ! jcls_l + end if ! ((k < ktecen) .and. ( .not. skip_gas_scav )) + + +! +! calc in-cloud scavenging of activated aerosols +! + do jcls = 1, ncls_use + do ipp = 1, 2 + do icc = 1, 2 +! cycle ! *** skip for testing + if ( .not. is_active(k,icc,jcls,ipp) ) cycle + if ( .not. is_precp( k,icc,jcls,ipp) ) cycle + + frac_scav = max( 0.0_r8, min( 1.0_r8, qlsink_sub2(k,icc,jcls,ipp)*dt_scav ) ) + tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) + + iphase = cw_phase + do n = 1, ntype_aer + do m = 1, nsize_aer(n) + do ll = 0, ncomp_aer(n) + if (ll == 0) then + l = numptr_aer(m,n,iphase) + else + l = massptr_aer(ll,m,n,iphase) + end if + if ((l < p1st) .or. (l > num_chem_ecpp)) cycle + + tmpa = frac_scav*chem_tmpb(k,icc,jcls,ipp,l) + chem_tmpb(k,icc,jcls,ipp,l) = chem_tmpb(k,icc,jcls,ipp,l) - tmpa + + tmpb = tmpa*tmp_ardzcen + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) - tmpb + chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = & + chem_prflxdt(k,icc,jcls,ipp,mwdt,l) + tmpb + end do ! ll + end do ! m + end do ! n + end do ! icc + end do ! ipp + end do ! jcls + + +! +! calc below-cloud scavenging of interstitial aerosols +! + do jcls = 1, ncls_use + do ipp = 1, 2 + do icc = 1, 2 +! cycle ! *** skip for testing + if ( .not. is_active(k,icc,jcls,ipp) ) cycle + if ( .not. is_precp( k,icc,jcls,ipp) ) cycle + + tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) + + iphase = ai_phase + do n = 1, ntype_aer + do m = 1, nsize_aer(n) + do ll = 0, ncomp_aer(n) + if (ll == 0) then + l = numptr_aer(m,n,iphase) + scavcoef = scavcoef_num(k,icc,jcls,ipp,m,n) + else + l = massptr_aer(ll,m,n,iphase) + scavcoef = scavcoef_vol(k,icc,jcls,ipp,m,n) + end if + if ((l < p1st) .or. (l > num_chem_ecpp)) cycle +! scavcoef = 0.01_r8 ! use simple constant value +! scavcoef = 0.0_r8 ! turn off below-cloud scav + + rate_scav = prta(k,icc,jcls,ipp)*scavcoef + frac_scav = 1.0_r8 - exp( -rate_scav*dt_scav ) + frac_scav = max( 0.0_r8, min( 1.0_r8, frac_scav ) ) + + tmpa = frac_scav*chem_tmpb(k,icc,jcls,ipp,l) + chem_tmpb(k,icc,jcls,ipp,l) = chem_tmpb(k,icc,jcls,ipp,l) - tmpa + + tmpb = tmpa*tmp_ardzcen + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) - tmpb + chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = & + chem_prflxdt(k,icc,jcls,ipp,mwdt,l) + tmpb + end do ! ll + end do ! m + end do ! n + end do ! icc + end do ! ipp + end do ! jcls + + +! +! calc gas scavenging +! + if ( .not. skip_gas_scav ) then + do jcls = 1, ncls_use + do ipp = 1, 2 + do icc = 1, 2 +! cycle ! *** skip for testing + if ( .not. is_rain(k,icc,jcls,ipp) ) cycle + tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) + + do ll = 1, ngas_scav + l = lgas_scav(ll) + if ((l < p1st) .or. (l > num_chem_ecpp)) cycle + + flxdt_kp1 = chem_prflxdt(k,icc,jcls,ipp,mwdt,l) + qgcx_bgn = chem_tmpb(k,icc,jcls,ipp,l) + tmpa = gasscav_aa(k,icc,jcls,ipp,ll) + tmpb = gasscav_bb(k,icc,jcls,ipp,ll) + tmpc = gasscav_cc(k,icc,jcls,ipp) + tmpe = tmpb + tmpc + tmpa*tmpc + +! this is the solution to the 2 final equations in subr wetscav_2_gasscav + flxdt = flxdt_kp1*((1.0_r8 + tmpa)*tmpc/tmpe) + qgcx_bgn*(tmpa/tmpe) + qgcx = qgcx_bgn*((1.0_r8 + tmpa*(tmpb/tmpe))/(1.0_r8 + tmpa)) & + + flxdt_kp1*(tmpc*(tmpb/tmpe)) + + chem_tmpb(k,icc,jcls,ipp,l) = qgcx + chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = flxdt + tmpf = (qgcx - qgcx_bgn)*tmp_ardzcen + if (tmpf > 0.0_r8) then + delchem_wetresu(k,icc,jcls,ipp,mwdt,l) = & + delchem_wetresu(k,icc,jcls,ipp,mwdt,l) + tmpf + else + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & + delchem_wetscav(k,icc,jcls,ipp,mwdt,l) + tmpf + end if + end do ! ll + + end do ! icc + end do ! ipp + end do ! jcls + end if ! ( .not. skip_gas_scav ) + + + end do wetscav_main_kloop_aa + call t_stopf('ecpp_wetscav_main') + + + call t_startf('ecpp_wetscav_endcopy') +! +! load new chem mixratios into chem_sub_new (only if wetscav_onoff_ecpp >= 300) +! calc overall changes to column burdens (only if wetscav_onoff_ecpp >= 200) +! + if (wetscav_onoff_ecpp >= 200) then + + do l = p1st, num_chem_ecpp + if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle + tmpx = 0.0_r8 ; tmpx2 = 0.0_r8 + do k = kts, ktecen + tmpy = 0.0_r8 ; tmpy2 = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + tmpb = 0.0_r8 + tmpc = 0.0_r8 + do ipp = 1, 2 + tmpa = acen_tmp(k,icc,jcls,ipp) + if ( is_active(k,icc,jcls,ipp) ) then + tmpy = tmpy + tmpa*(chem_tmpb(k,icc,jcls,ipp,l) & + - chem_tmpa(k,icc,jcls,ipp,l)) + tmpb = tmpb + tmpa*chem_tmpb(k,icc,jcls,ipp,l) + tmpc = tmpc + tmpa + end if + tmpd = 0.0_r8 + do inwdt=1, nwdt + tmpd = tmpd + delchem_wetscav(k,icc,jcls,ipp,inwdt,l) /rhodz_cen(k) + end do + del_wetscav3d(k,icc,jcls,ipp,l) = del_wetscav3d(k,icc,jcls,ipp,l) + tmpd + tmpe = 0.0_r8 + do inwdt=1, nwdt + tmpe = tmpe + delchem_wetresu(k,icc,jcls,ipp,inwdt,l) /rhodz_cen(k) + end do + del_wetresu3d(k,icc,jcls,ipp,l) = del_wetresu3d(k,icc,jcls,ipp,l) + tmpe + tmpy2 = tmpy2 + tmpd + tmpe + end do ! ipp + if ((acen_tavg_use(k,icc,jcls) > afrac_cut_0p5) .and. & + (tmpc > 0.0_r8) .and. (wetscav_onoff_ecpp >= 300)) then + chem_sub_new(k,icc,jcls,l) = max( 0.0_r8, tmpb )/tmpc + end if + end do ! icc + end do ! jcls + tmpx = tmpx + tmpy*rhodz_cen(k) + tmpx2 = tmpx2 + tmpy2*rhodz_cen(k) + end do ! k + curdel_chem_clm_wetscav(l) = tmpx + ! *** increment del_chem_clm_wetscav with tmpx2 (new way) + ! instead of tmpx (old way) + del_chem_clm_wetscav(l) = del_chem_clm_wetscav(l) + tmpx2 + end do ! l + + end if ! (wetscav_onoff_ecpp >= 200) + call t_stopf('ecpp_wetscav_endcopy') + + call t_startf('ecpp_wetscav_enddiag') +! +! diagnostic checks on the new arrays to see that they are "making sense" +! + if (lun142 > 0) then + + do l = p1st, num_chem_ecpp + + write(lun142,'(//a,i5)') 'diags for species l =', l + + if (lun142 == -999888777) then ! *** skip for testing + + write(lun142,'(a,i5)') 'chem_tmpa for icc=ipp=2 & grid-avg; chem_tmpb ...; b-a ...' + icc = 2 ; ipp = 2 + do k = ktecen, kts, -1 + write(lun142,'(i3,1p,3(2x,4e10.3))') k, & + ( chem_tmpa(k,icc,jcls,ipp,l), jcls=1,ncls_use ), & + sum( chem_tmpa(k,1:2,1:ncls_use,1:2,l)* & + acen_tmp(k,1:2,1:ncls_use,1:2) ), & + ( chem_tmpb(k,icc,jcls,ipp,l), jcls=1,ncls_use ), & + sum( chem_tmpb(k,1:2,1:ncls_use,1:2,l)* & + acen_tmp(k,1:2,1:ncls_use,1:2) ), & + ( (chem_tmpb(k,icc,jcls,ipp,l) - & + chem_tmpa(k,icc,jcls,ipp,l)), jcls=1,ncls_use ), & + sum( ( chem_tmpb(k,1:2,1:ncls_use,1:2,l) - & + chem_tmpa(k,1:2,1:ncls_use,1:2,l) )* & + acen_tmp(k,1:2,1:ncls_use,1:2) ) + end do + + write(lun142,'(/a,i5)') & + 'delchem_wetscav for icc=ipp=2 & grid-avg; delchem_wetresu ...; chem_prflxdt_xfer ...' + icc = 2 ; ipp = 2 + do k = ktecen, kts, -1 + write(lun142,'(i3,1p,3(2x,4e10.3))') k, & + ( delchem_wetscav( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & + sum( delchem_wetscav( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & + ( delchem_wetresu( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & + sum( delchem_wetresu( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & + ( chem_prflxdt_xfer(k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & + sum( chem_prflxdt_xfer(k,1:2,1:ncls_use,1:2,1:nwdt,l) ) + end do + + write(lun142,'(/a,i5)') & + 'chem_prflxdt for icc=ipp=2 & grid-avg; conserve check stuff' + icc = 2 ; ipp = 2 + do k = ktecen, kts, -1 + kp1 = min(k+1,ktecen) ; tmpa = kp1 - k + write(lun142,'(i3,1p,3(2x,4e10.3))') k, & + ( chem_prflxdt( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & + sum( chem_prflxdt( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & + ( chem_prflxdt( kp1,icc,jcls,ipp,mwdt,l)*tmpa & + - chem_prflxdt( k,icc,jcls,ipp,mwdt,l) & + - delchem_wetscav( k,icc,jcls,ipp,mwdt,l) & + - delchem_wetresu( k,icc,jcls,ipp,mwdt,l) & + + chem_prflxdt_xfer(k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & + sum( chem_prflxdt( kp1,1:2,1:ncls_use,1:2,1:nwdt,l)*tmpa & + - chem_prflxdt( k,1:2,1:ncls_use,1:2,1:nwdt,l) & + - delchem_wetscav( k,1:2,1:ncls_use,1:2,1:nwdt,l) & + - delchem_wetresu( k,1:2,1:ncls_use,1:2,1:nwdt,l) & + + chem_prflxdt_xfer(k,1:2,1:ncls_use,1:2,1:nwdt,l) ) + end do + + end if ! (lun142 == -999888777) + + write(lun142,'(/2a,i5)') & + 'sum( delchem_wetscav ), sum( delchem_wetresu ), sum( both ),', & + ' curdel_chem_clm_wetscav, (4)-(5)/max(...)' + tmpa = sum( delchem_wetscav( kts:ktecen,1:2,1:ncls_use,1:2,1:nwdt,l) ) + tmpb = sum( delchem_wetresu( kts:ktecen,1:2,1:ncls_use,1:2,1:nwdt,l) ) + tmpc = tmpa + tmpb + tmpd = curdel_chem_clm_wetscav(l) + tmpe = (tmpc - tmpd)/max( abs(tmpc), abs(tmpd), 1.0e-38_r8 ) + write(lun142,'(1p,3(2x,2e11.3))') & + tmpa, tmpb, tmpc, tmpd, tmpe +! if (l == 2) write(lun142,'(3a)') 'qakee - ktau, it_hyb, it_sub, l', & +! 'sum( delchem_wetscav ), sum( delchem_wetresu ), sum( both ),', & +! ' curdel_chem_clm_wetscav, (4)-(5)/max(...)' +! if (l >= 39) write(lun142,'(a,4i4,1p,3(2x,2e11.3))') & +! 'qakee', ktau, itstep_hybrid, itstep_sub, l, & +! tmpa, tmpb, tmpc, tmpd, tmpe + + write(lun142,'(/2a,i5)') & + 'sum( del_wetscav3d ), sum( del_wetresu3d ), sum( both ),', & + ' del_chem_clm_wetscav, (4)-(5)/max(...)' + tmpa = 0.0_r8 ; tmpb = 0.0_r8 + do k = kts, ktecen + tmpa = tmpa + sum( del_wetscav3d(k,1:2,1:ncls_use,1:2,l) ) * rhodz_cen(k) + tmpb = tmpb + sum( del_wetresu3d(k,1:2,1:ncls_use,1:2,l) ) * rhodz_cen(k) + end do + tmpc = tmpa + tmpb + tmpd = del_chem_clm_wetscav(l) + tmpe = (tmpc - tmpd)/max( abs(tmpc), abs(tmpd), 1.0e-38_r8 ) + write(lun142,'(1p,3(2x,2e11.3))') & + tmpa, tmpb, tmpc, tmpd, tmpe +! if (l == 2) write(lun142,'(3a)') 'qakff - ktau, it_hyb, it_sub, l', & +! 'sum( del_wetscav3d ), sum( del_wetresu3d ), sum( both ),', & +! ' del_chem_clm_wetscav, (4)-(5)/max(...)' +! if (l >= 39) write(lun142,'(a,4i4,1p,3(2x,2e11.3))') & +! 'qakff', ktau, itstep_hybrid, itstep_sub, l, & +! tmpa, tmpb, tmpc, tmpd, tmpe + + end do ! l + + write(lun142,'(//a,i5)') 'qlsink*dt_scav for icc=ipp=2; qcloud ...; ardzcen ...' + icc = 2 ; ipp = 2 + do k = ktecen, kts, -1 + write(lun142,'(i3,1p,4(2x,3e10.3))') k, & + ( qlsink_sub2(k,icc,jcls,ipp)*dt_scav, jcls=1,ncls_use ), & + ( qcloud_sub2(k,icc,jcls,ipp), jcls=1,ncls_use ), & + ( acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k), jcls=1,ncls_use ) + end do + + write(lun142,'(//a,i5)') 'prta for icc=ipp=2; prtb ...; delprtb ...' + icc = 2 ; ipp = 2 + do k = ktecen, kts, -1 + write(lun142,'(i3,1p,4(2x,3e10.3))') k, & + ( prta(k,icc,jcls,ipp), jcls=1,ncls_use ), & + ( prtb(k,icc,jcls,ipp), jcls=1,ncls_use ), & + ( prtb(k,icc,jcls,ipp)-prtb(k+1,icc,jcls,ipp), jcls=1,ncls_use ) + end do + + end if ! (lun142 > 0) + + call t_stopf('ecpp_wetscav_enddiag') + + +! write(*,'(a)') 'wetscav_2 DONE' + return + end subroutine parampollu_tdx_wetscav_2 + + + +!----------------------------------------------------------------------- + subroutine wetscav_2_gasscav( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + dt_scav, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + is_active, is_precp, is_rain, & + maxgas_scav, ngas_scav, lgas_scav, & + acen_tmp, prra, & + qcloud_sub2, qlsink_sub2, & + gasscav_aa, gasscav_bb, gasscav_cc ) + + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! wetscav_2_gasscav does pre-calculations for in-cloud and below-cloud +! of gases (h2o2, so2, and nh3) by rain +! the results are applied in subr parampollu_tdx_wetscav_2 +! +! main assumptions +! reversible scavenging of gases +! prescribed pH for rainwater and cloudwater +! no aqueous phase reactions are treated here +!----------------------------------------------------------------------- + +! use module_state_description, only: p_qv, p_qc + +! use module_data_radm2, only: epsilc + + use module_data_mosaic_asect, only: & + ai_phase, dens_aer, hygro_aer, & + massptr_aer, maxd_asize, maxd_atype, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & + dcen_sect, dhi_sect, dlo_sect, sigmag_aer, & + volumhi_sect, volumlo_sect + + use module_data_ecpp1 + + use constituents, only: cnst_get_ind + + use module_ecpp_util, only: ecpp_error_fatal + + implicit none + +! arguments +! ( for definitions see subr parampollu_tdx_wetscav_2 ) + integer, intent(in) :: & + ktau, ktau_pp, itstep_sub, & + it, jt, kts, ktebnd, ktecen + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & + idiagbb_wetscav + + real(r8), intent(in) :: dtstep, dtstep_sub, dt_scav + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + + integer, intent(in) :: ncls_use + + logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + is_active, is_precp, is_rain + + integer, intent(in) :: maxgas_scav + integer, intent(out) :: ngas_scav + integer, intent(out), dimension( 1:maxgas_scav ) :: & + lgas_scav + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + acen_tmp, qcloud_sub2, qlsink_sub2 + + real(r8), intent(in), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + prra + + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, maxgas_scav ) :: & + gasscav_aa, gasscav_bb + + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + gasscav_cc + + + +! local variables + integer :: icc, ipp + integer :: itmpa + integer :: jcls + integer :: k + integer :: ll, lun143 + integer :: m + integer :: n + integer :: p1st + +! real(r8), parameter :: piover6 = 3.14159265358979323846_r8/6.0_r8 + real(r8), parameter :: qcldwtr_cutoff = 1.0e-6_r8 + real(r8), parameter :: tmp8over9 = 8.0_r8/9.0_r8 + + real(r8) :: frac_c, frac_g + real(r8) :: hen1c(maxgas_scav), hen1r(maxgas_scav) + real(r8) :: hen2c(maxgas_scav), hen2r(maxgas_scav) + real(r8) :: heffcx(maxgas_scav), heffrx(maxgas_scav) + real(r8) :: hionc, hionr + real(r8) :: kxf_cr, kxf_gcr, kxf_gr(maxgas_scav) + real(r8) :: qcwtr, qrwtr + real(r8) :: scavrate_hno3 + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg + real(r8) :: vfallr + + +! pointers for gases that are scavenged + p1st = param_first_ecpp + + ngas_scav = 4 + if (ngas_scav > maxgas_scav) then + write(*,*) 'subr wetscav_2_gasscav -- ngas_scav > maxgas_scav', & + ngas_scav > maxgas_scav + call ecpp_error_fatal( lunout, & + 'subr wetscav_2_gasscav -- ngas_scav > maxgas_scav' ) + end if + + lgas_scav(:) = -1 + + call cnst_get_ind( 'so2', itmpa, .false. ) + if (itmpa <= 0) call cnst_get_ind( 'SO2', itmpa, .false. ) + if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(1) = itmpa + + call cnst_get_ind( 'h2o2', itmpa, .false. ) + if (itmpa <= 0) call cnst_get_ind( 'H2O2', itmpa, .false. ) + if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(2) = itmpa + + call cnst_get_ind( 'nh3', itmpa, .false. ) + if (itmpa <= 0) call cnst_get_ind( 'NH3', itmpa, .false. ) + if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(3) = itmpa + + call cnst_get_ind( 'h2so4', itmpa, .false. ) + if (itmpa <= 0) call cnst_get_ind( 'H2SO4', itmpa, .false. ) + if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(4) = itmpa + +! write(*,'(a,10i5)') 'wetscav_2_gasscav - ngas_scav', ngas_scav +! write(*,'(a,10i5)') 'wetscav_2_gasscav - lgas_scav', lgas_scav(1:maxgas_scav) +! if (ngas_scav /= -13579) stop + + +! +! treatment of gas scavenging (by rain) +! +! primary assumptions are +! gases are reversibly scavenging in rain (e.g., transfer from gas to rain +! and transfer from rain to gas are both treated) +! rainborne gases are treated a locally steady-state, but vary with height +! cloudborne gases in equilibrium with the "interstitial gases" +! and are collected by rain +! pH for the cloud and rainwater are prescribed +! aqueous chemical reaction in rain are not treated +! +! define +! qrx = mixing ratio of rainborne species x (kg-x/kg-air) +! qcx = mixing ratio of cloudborne species x (kg-x/kg-air) +! qgx = mixing ratio of gaseous species x (kg-x/kg-air) +! qgcx = qgx + qcx +! +! the above are defined for each vertical layer and each ecpp subarea +! (in wrf-chem, they are units are actually mg-x/kg-air after a molecular weight +! ratio is applied, but the equations work anyway) +! +! basic equations: +! +! d[acen*rho*qgcx]/dt = acen*rho*[ -kxf_gr*(qgx - qrx/heffrx) - kxf_ct*qcx ] +! +! d[acen*rho*vfallr*qrx]/dz = acen*rho*[ -kxf_gr*(qgx - qrx/heffrx) - kxf_ct*qcx ] +! +! qcx = heffcx*qgx +! +! where +! acen = fractional area of subarea +! rho = air density (kg-air/m^3) +! vfallr = rain fall velocity (m/s, and positive) +! kxf_gr = mass transfer coefficient for gas <--> rain (1/s) +! a power-law curve fit to Schwarz and Levine (19xx) is used +! kxf_ct = rate of collection of cloudwater by rainwater (1/s) == qlsink +! heffrx, heffcx = gaseous-rainborne and gaseous-cloudborne equilibirum partitioning +! coefficients (i.e., modified effective henry law constants) with units of +! [(mol-x/kg-h2o)/(mol-x/kg-air)] == [(kg-x/kg-h2o)/(kg-x/kg-air)] +! +! define +! frac_c = heffcx/(1 + heffgx) so qcx = frac_c*qgcx +! frac_g = 1 - frac_c so qgx = frac_g*qgcx +! kxf_gcr = frac_g*kxf_gr + frac_c*kxf_cr +! +! then +! +! d[acen*rho*qgcx]/dt = acen*rho*[ -kxf_gcr*qgcx + kxf_gr*qrx/heffrx) ] +! +! d[acen*rho*vfallr*qrx]/dz = acen*rho*[ -kxf_gcr*qgcx + kxf_gr*qrx/heffrx) ] +! +! define +! dt = time step ( = ecpp sub time step ) +! flxdt = acen*rho*vfallr*qrx*dt = chem_prflxdt of subr parampollu_tdx_wetscav_2 +! +! then +! +! d[acen*rho*qgcx]/dt = -[acen*rho*kxf_gcr]*qgcx + [kxf_gr/(heffrx*vfallr*dt)]*flxdt +! +! d[flxdt]/dz = -[acen*rho*kxf_gcr*dt]*qgcx + [kxf_gr/(heffrx*vfallr)]*flxdt +! +! now define +! dt = time step (s) +! dz = thickness of layer k (m) +! qgcx = qgcx in layer k at end of time step +! qgcx_bgn = qgcx in layer k at beginning of time step +! flxdt = flxdt in layer k at end of time step +! flxdt_kp1 = flxdt in layer k+1 at end of time step +! +! and use the following finite differencing which is implicit in time +! +! (acen*rho)*(qgcx - qgcx_o)/dt = -[acen*rho*kxf_gcr]*qgcx + [kxf_gr/(heffrx*vfallr*dt)]*flxdt +! which yields +! qgcx*[1 + kxf_gcr*dt] + flxdt*[-kxf_gr/(heffrx*vfallr*acen*rho)] = qgcx_bgn +! +! (flxdt+kp1 - flxdt)/dz = -[acen*rho*kxf_gcr*dt]*qgcx + [kxf_gr/(heffrx*vfallr)]*flxdt +! which yields +! qgcx*[-kxf_gcr*dt] + flxdt*[1/(dz*acen*rho) + kxf_gr/(heffrx*vfallr*acen*rho)] = flxdt_kp1*[1/(dz*acen*rho)] +! +! define +! aa = kxf_gcr*dt +! bb = kxf_gr/(heffrx*vfallr*acen*rho) +! cc = 1/(dz*acen*rho) +! +! then +! qgcx*[1 + aa] + flxdt*[-bb] = qgcx_bgn +! qgcx*[-aa] + flxdt*[cc + bb] = flxdt_kp1*[cc] +! +! these 2 equations are solved in the gas-scavenging section of subr parampollu_tdx_wetscav_2, +! starting at ktecen (where flxdt_kp1 = ) +! the purpose of this routine (subr wetscav_2_gasscav) is to provide the aa, bb, and cc +! + + + lun143 = -1 + if (idiagaa_ecpp(143) > 0) lun143 = ldiagaa_ecpp(143) + if (idiagbb_wetscav /= 1) lun143 = -1 + +! hionr, hionc = prescribed hydrogen ion concentrations (mol/liter-h2o) +! for rainwater and cloudwater + hionr = 10.0_r8**(-5.0_r8) + hionc = 10.0_r8**(-4.5_r8) + +! calculate information needed for the gas scavenging equations +main_kloop_aa: & + do k = kts, ktecen + + do ipp = 1, 2 + do jcls = 1, ncls_use + do icc = 1, 2 + + if ( .not. is_rain(k,icc,jcls,ipp) ) cycle + if (lun143 > 0) write(lun143,'(/a,5i5)') 'wetscav_2_gasscav', & + ktau, k, icc, jcls, ipp + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'aaaa stuff ', & + tcen_bar(k), pcen_bar(k), rhocen_bar(k), dzcen(k), dt_scav + + +! calculate rain fallspeed and rainwater mixing ratio using Kessler (1969) + tmpa = prra(k,icc,jcls,ipp) ! rain precip rate (kg/m^2/s) + tmpb = sqrt( 1.22_r8/rhocen_bar(k) ) ! density factor for fallspeed +! tmpc = first guess rain water conc (kg/m^3) from Kessler (1969) + tmpc = (tmpa/(12.11_r8*tmpb))**tmp8over9 +! vfallr = rain mean fallspeed (m/s) from its definition, but forced to >= 1 m/s + vfallr = max( 1.0_r8, (tmpa/tmpc) ) +! qrwtr = rain water mixing ratio (kg/kgair) from its definition + qrwtr = tmpa/(vfallr*rhocen_bar(k)) + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'rain stuff ', & + prra(k,icc,jcls,ipp), acen_tmp(k,icc,jcls,ipp), & + tmpa, tmpb, tmpc, vfallr, qrwtr + +! qcwtr = cloud water mixing ratio (kg/kgair) from its definition + qcwtr = qcloud_sub2(k,icc,jcls,ipp) + if (qcwtr > qcldwtr_cutoff) then + kxf_cr = max( 0.0_r8, qlsink_sub2(k,icc,jcls,ipp) ) + else + qcwtr = 0.0_r8 + kxf_cr = 0.0_r8 + end if + + +! gas-liquid partitioning coefficients +! +! hen1 = effective henry law constant at prescribed ph +! [(mol-x/liter-h2o)/atm] = [(mol-x/kg-h2o)/atm] + hen1r(:) = 0.0_r8 + hen1c(:) = 0.0_r8 + tmpa = (1.0_r8/tcen_bar(k)) - (1.0_r8/298.16_r8) + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') '0000 hen1 ', & + tcen_bar(k), tmpa, qrwtr, qcwtr +! so2 + tmpb = 1.23_r8*exp(3150.0_r8*tmpa) ! henry law constant + tmpc = 1.3e-2_r8*exp(1960.0_r8*tmpa) ! 1st dissociation constant + hen1r(1) = tmpb*(1.0_r8 + tmpc/hionr) ! effective henry + hen1c(1) = tmpb*(1.0_r8 + tmpc/hionc) ! effective henry + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'so2 hen1 ', & + tmpb, tmpc, hen1r(1), hen1c(1) +! h2o2 + tmpb = 7.45e4_r8*exp(7300.0_r8*tmpa) ! henry law constant + hen1r(2) = tmpb + hen1c(2) = tmpb + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'h2o2 hen1 ', & + tmpb, 0.0_r8, hen1r(2), hen1c(2) +!+++mhwang +! set hen1r and hen1d of so2 to be the same as H2O2, which is what used +! in the conventional NCAR CAM. +! Minghuai Wang (Minghuai.Wang@pnl.gov), 2010-02 +! hen1r(1) = hen1r(2) +! hen1c(1) = hen1c(2) +!---mhwang + +! nh3 + tmpb = 6.21e1_r8*exp(4110.0_r8*tmpa) ! henry law constant + tmpc = 1.7e-5_r8*exp(-450.0_r8*tmpa) ! 1st dissociation constant + tmpd = 1.0e-14_r8*exp(-6710.0_r8*tmpa) ! water dissociation constant + hen1r(3) = tmpb*(1.0_r8 + (tmpc/tmpd)*hionr) ! effective henry + hen1c(3) = tmpb*(1.0_r8 + (tmpc/tmpd)*hionc) ! effective henry + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'nh3 hen1 ', & + tmpb, tmpc, hen1r(3), hen1c(3) +! h2so4 (values are from CAPRAM website) + tmpb = 8.7e11_r8 ! henry law constant + tmpc = 1.0e3_r8 ! 1st dissociation constant + hen1r(4) = tmpb*(1.0_r8 + tmpc/hionr) ! effective henry + hen1c(4) = tmpb*(1.0_r8 + tmpc/hionc) ! effective henry + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'h2so4 hen1 ', & + tmpb, tmpc, hen1r(4), hen1c(4) + +! hen2 = like hen1 but units = [(mol-x/kg-h2o)/(mol-x/kg-air)] +! ax atm of x = ax*p0 Pa of x = ax*p0/pair (mol-x/mol-air) +! = ax*p0/(pair*0.029) (mol-x/kg-air) + tmpa = (pcen_bar(k)/1.01325e5_r8)*0.028966_r8 + hen2r(1:ngas_scav) = hen1r(1:ngas_scav)*tmpa + hen2c(1:ngas_scav) = hen1c(1:ngas_scav)*tmpa + +! heffrx,cx units = [(mol-x/kg-air)/(mol-x/kg-air)] and includes +! rainwater,cloudwater mixing ratio factor + heffrx(1:ngas_scav) = hen2r(1:ngas_scav)*qrwtr + heffcx(1:ngas_scav) = hen2c(1:ngas_scav)*qcwtr + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'heffrx,cx ', & + heffrx(1:4), heffcx(1:4) + + +! gas-rain mass transfer rates +! +! scavrate_hno3 = rain scavenging rate for hno3 (1/s) +! this is power law fit to levine and schwartz (1982, atmos environ) +! results, with temperature and pressure adjustments + tmpa = prra(k,icc,jcls,ipp)*3600.0_r8 ! precip rate in mm/hr = kg/m^2/hr + scavrate_hno3 = 6.262e-5_r8*(tmpa**0.7366_r8) & + * ((tcen_bar(k)/298.0_r8)**1.12_r8) & + * ((1.01325e5_r8/pcen_bar(k))**.75_r8) +! for other gases, multiply hno3 rate by ratio of gas diffusivities + kxf_gr(1) = scavrate_hno3*1.08_r8 ! so2 + kxf_gr(2) = scavrate_hno3*1.38_r8 ! h2o2 + kxf_gr(3) = scavrate_hno3*1.59_r8 ! nh3 + kxf_gr(4) = scavrate_hno3*0.80_r8 ! h2so4 + if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'kxf_gr,cr ', & + kxf_gr(1:4), kxf_cr + + +! aa, bb, and cc coefficients of the 2 final equations + tmpa = acen_tmp(k,icc,jcls,ipp)*rhocen_bar(k) +! cc = 1/(dz*acen*rho) + gasscav_cc(k,icc,jcls,ipp) = 1.0_r8/(dzcen(k)*tmpa) + + do ll = 1, ngas_scav + frac_c = heffcx(ll)/(1.0_r8 + heffcx(ll)) + frac_g = 1.0_r8 - frac_c + kxf_gcr = frac_g*kxf_gr(ll) + frac_c*kxf_cr +! aa = kxf_gcr*dt + gasscav_aa(k,icc,jcls,ipp,ll) = kxf_gcr*dt_scav + +! bb = kxf_gr/(heffrx*vfallr*acen*rho) + gasscav_bb(k,icc,jcls,ipp,ll) = kxf_gr(ll)/(heffrx(ll)*vfallr*tmpa) +! setting gasscav_bb=0 (heffrx = infinity) gives irreversible scavenging +! gasscav_bb(k,icc,jcls,ipp,ll) = 0.0 + + if (lun143 > 0) write(lun143,'(a,i1,1p,8e11.3)') 'aa/bb/cc ', & + ll, gasscav_aa(k,icc,jcls,ipp,ll), gasscav_bb(k,icc,jcls,ipp,ll), & + gasscav_cc(k,icc,jcls,ipp), frac_g, frac_c, kxf_gcr + end do ! l + + + + end do ! icc + end do ! jcls + end do ! ipp + + end do main_kloop_aa + + + return + end subroutine wetscav_2_gasscav + + + +!----------------------------------------------------------------------- + subroutine wetscav_2_bcscavcoef( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + rh_sub2, & + is_active, is_precp, & + chem_tmpa, scavcoef_num, scavcoef_vol ) + + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! wetscav_2_bcscavcoef calculates below-cloud scavenging coefficents +! similar to subr modal_aero_bcscavcoef_get +! +!----------------------------------------------------------------------- + +! use module_state_description, only: p_qv, p_qc + +! use module_data_radm2, only: epsilc + +! use module_data_mosaic_asect, only: ai_phase, cw_phase, & +! massptr_aer, maxd_asize, maxd_atype, & +! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & +! waterptr_aer + use module_data_mosaic_asect, only: & + ai_phase, dens_aer, hygro_aer, & + massptr_aer, maxd_asize, maxd_atype, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & + dcen_sect, dhi_sect, dlo_sect, sigmag_aer, & + volumhi_sect, volumlo_sect + + use modal_aero_wateruptake, only: modal_aero_kohler + + use aero_model, only: & + calc_1_impact_rate, & + get_dlndg_nimptblgrow, nimptblgrow_mind, nimptblgrow_maxd, & + get_scavimptblnum, get_scavimptblvol + + use modal_aero_data,only: ntot_amode + + use module_data_ecpp1 + +! use module_ecpp_hoststuff, only: config_flags_ecpp + +! use module_mosaic_wetscav, only: wetscav_cbmz_mosaic + +! use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & +! parampollu_1clm_set_opts + + implicit none + +! arguments +! ( for definitions see subr parampollu_tdx_wetscav_2 ) + integer, intent(in) :: & + ktau, ktau_pp, itstep_sub, & + it, jt, kts, ktebnd, ktecen + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & + idiagbb_wetscav + + real(r8), intent(in) :: dtstep, dtstep_sub + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar + + integer, intent(in) :: ncls_use + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2 + + logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + is_active, is_precp + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + chem_tmpa + + real(r8), intent(inout), & + dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:maxd_asize, 1:maxd_atype ) :: & + scavcoef_num, scavcoef_vol +! scavcoef_vol = below-cloud scavenging coeficient for volume (1/mm) +! scavcoef_num = below-cloud scavenging coeficient for number (1/mm) +! when precip rate = xxx kg/m2/s == xxx mm/s, the scavenging rate (1/s) = scavcoef*xxx + + +! local variables + integer :: icc, ipp + integer :: jcls, jgrow + integer :: k + integer :: l, ll, lun142 + integer :: m + integer :: n + integer :: p1st + + real(r8) :: dgratio + real(r8) :: dry_dens, dry_diam, dry_mass, dry_volu + real(r8) :: dry_mass_cut, dry_volu_cut + real(r8) :: fact_leng, fact_mass + real(r8), parameter :: onethird = 1.0_r8/3.0_r8 + real(r8), parameter :: piover6 = 3.14159265358979323846_r8/6.0_r8 + real(r8) :: scavimpnum, scavimpvol + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg + real(r8) :: tmpflo, tmpfhi + real(r8) :: tmp_hygro, tmp_num, tmp_rdry, tmp_rwet, tmp_rh + real(r8) :: watr_mass, wet_dens, wet_diam, wet_volu + real(r8) :: xgrow + real(r8) :: rdry_in_mak(1), hygro_mak(1), s_mak(1), rwet_out_mak(1) + + real(r8) :: scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) + real(r8) :: scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) + +! NOTE ON UNITS +! +! hostcode wrfchem cam +! mass mixing ratios ug/kg kg/kg +! dry/wet_mass g/kgair kg/kgair +! dens_aer g/cm^3 kg/m^3 +! dry/wet_volu cm^3/kgair m^3/kgair +! volumlo/hi_sect cm^3 m^3 +! dcen_sect cm m +! dry/wet_diam cm m +! + if ( hostcode_is_wrfchem ) then + fact_mass = 1.0e-6_r8 ! ug/kgair --> g/kgair + fact_leng = 1.0e-2_r8 ! cm --> m + dry_mass_cut = 1.0e-26_r8 ! g/kgair = 1.0e-20 ug/kgair + dry_volu_cut = 1.0e-26_r8 ! cm^3/kgair + else + fact_mass = 1.0_r8 ! kg/kgair, unchanged + fact_leng = 1.0_r8 ! m, unchanged + dry_mass_cut = 1.0e-29_r8 ! kg/kgair = 1.0e-20 ug/kgair + dry_volu_cut = 1.0e-32_r8 ! m^3/kgair + end if + +! +! calc below-cloud scavenging coefficients of interstitial aerosols +! + scavcoef_num(:,:,:,:,:,:) = 0.0_r8 + scavcoef_vol(:,:,:,:,:,:) = 0.0_r8 + + + scavimptblvol = get_scavimptblvol() + scavimptblnum = get_scavimptblnum() + + do k = kts, ktecen + do jcls = 1, ncls_use + do ipp = 1, 2 +icc_loop: & + do icc = 1, 2 + if ( .not. is_active(k,icc,jcls,ipp) ) cycle +! if ( .not. is_precp( k,icc,jcls,ipp) ) cycle + + lun142 = 0 +! if ((ktau == 1) .and. (k == 5)) lun142 = 142 + if (k == 5) lun142 = 142 + if (idiagbb_wetscav <= 0) lun142 = -1 + + +! calc below-cloud scavenging coefficients for each aerosol mode + do n = 1, ntype_aer + do m = 1, nsize_aer(n) + +! calc dry mass and dry volume mixing ratios + dry_volu = 0.0_r8 + dry_mass = 0.0_r8 + tmp_hygro = 0.0_r8 + do l = 1, ncomp_aer(n) + tmpa = chem_tmpa(k,icc,jcls,ipp,massptr_aer(l,m,n,ai_phase)) + dry_mass = dry_mass + tmpa + dry_volu = dry_volu + tmpa/dens_aer(l,n) + tmp_hygro = tmp_hygro + (tmpa/dens_aer(l,n))*hygro_aer(l,n) + end do + dry_mass = dry_mass*fact_mass ! g/kgair OR kg/kgair + dry_volu = dry_volu*fact_mass ! cm^3/kgair OR m^3/kgair + +! if negligible aerosol is present at this size and type, cycle + if ((dry_mass < dry_mass_cut) .or. (dry_volu < dry_volu_cut)) then + ! BUT FIRST set dgn_dry/wet and chem_sub( ... water ... ) to default values + cycle + end if + +! calc volume-mean dry diameter + tmp_num = chem_tmpa(k,icc,jcls,ipp,numptr_aer(m,n,ai_phase)) + if (dry_volu <= tmp_num*volumlo_sect(m,n)) then + dry_diam = dlo_sect(m,n) + else if (dry_volu >= tmp_num*volumhi_sect(m,n)) then + dry_diam = dhi_sect(m,n) + else + dry_diam = (dry_volu/(tmp_num*piover6))**onethird + end if + +! calc volume-mean wet diameter + tmp_hygro = tmp_hygro*fact_mass/dry_volu + tmp_rh = max( 0.0_r8, min( 0.99_r8, rh_sub2(k,icc,jcls,ipp) ) ) + tmp_rdry = dry_diam*0.5_r8*fact_leng ! cm OR m --> m + tmp_rwet = tmp_rdry + + rdry_in_mak(1) = tmp_rdry + hygro_mak(1) = tmp_hygro + s_mak(1) = tmp_rh + rwet_out_mak(1) = tmp_rwet +! call modal_aero_kohler( tmp_rdry, tmp_hygro, tmp_rh, tmp_rwet, 1, 1 ) + call modal_aero_kohler( rdry_in_mak, hygro_mak, s_mak, rwet_out_mak, 1) + tmp_rwet = rwet_out_mak(1) + + wet_diam = tmp_rwet*2.0_r8/fact_leng ! m --> cm OR m + wet_diam = min( wet_diam, dry_diam*100.0_r8, 50.0e-6_r8/fact_leng ) + wet_diam = max( wet_diam, dry_diam ) + +! wet_diam = dry_diam ! force water == 0 (for testing) + + wet_volu = dry_volu * (wet_diam/dry_diam)**3 ! cm^3/kgair + watr_mass = max( 0.0_r8, (wet_volu-dry_volu) ) ! g/kgair, as rho_water = 1.0 g/cm^3 +! *** eventually should store this in some array that can be used by cam3 +! for now, leave it alone +! chem_tmpa(k,icc,jcls,ipp,waterptr_aer(m,n)) = watr_mass/fact_mass + + wet_dens = (dry_mass + watr_mass)/wet_volu + dry_dens = dry_mass/dry_volu + +! compute impaction scavenging removal amount for volume +! interpolate table values using log of (actual-wet-size)/(base-dry-size) + +! in the bcscavcoef_get routine, dgratio = dgnum_wet/dgnum_amode +! BUT dgnum_wet/dgnum_amode = (b*dgnum_wet)/(b*dgnum_amode) = dvolmean_wet/dcen_sect +! where b = exp( 1.5 * (log(sigmag)**2) ) +! dgratio = ((wet_volu/dry_volu)**onethird) * (dry_diam/dcen_sect(m,n)) + dgratio = wet_diam/dcen_sect(m,n) + + if ((dgratio .ge. 0.99_r8) .and. (dgratio .le. 1.01_r8)) then + scavimpvol = scavimptblvol(0,m) + scavimpnum = scavimptblnum(0,m) + else + xgrow = log( dgratio ) / get_dlndg_nimptblgrow() + jgrow = int( xgrow ) + if (xgrow .lt. 0._r8) jgrow = jgrow - 1 + if (jgrow .lt. nimptblgrow_mind) then + jgrow = nimptblgrow_mind + xgrow = jgrow + else + jgrow = min( jgrow, nimptblgrow_maxd-1 ) + end if + + tmpfhi = xgrow - jgrow + tmpfhi = max( 0.0_r8, min( 1.0_r8, tmpfhi ) ) + tmpflo = 1.0_r8 - tmpfhi + scavimpvol = tmpflo*scavimptblvol(jgrow,m) + & + tmpfhi*scavimptblvol(jgrow+1,m) + scavimpnum = tmpflo*scavimptblnum(jgrow,m) + & + tmpfhi*scavimptblnum(jgrow+1,m) + end if + + !impaction scavenging removal amount for volume + scavcoef_vol(k,icc,jcls,ipp,m,n) = exp( scavimpvol ) + !impaction scavenging removal amount to number + scavcoef_num(k,icc,jcls,ipp,m,n) = exp( scavimpnum ) + +! test diagnostics + if (lun142 > 0) then + write(lun142,'(/a,8i4)') 'wetscav_2_bcscavcoef diags', & + ktau, k, jcls, ipp, icc, n, m + tmpb = sigmag_aer(m,n) + tmpg = log( sigmag_aer(m,n) ) + tmpg = exp( 1.5_r8*tmpg*tmpg ) + tmpa = dcen_sect(m,n)*dgratio/tmpg + tmpc = dens_aer(1,n) ! bcscavcoef_init uses this + if ( .not. hostcode_is_wrfchem ) then + tmpa = tmpa*1.0e2_r8 ! m --> cm + tmpc = tmpc*1.0e-3_r8 ! kg/m^3 --> g/cm^3 + end if + tmpd = 273.16_r8 ! bcscavcoef_init uses this + tmpe = 0.75e6_r8 ! bcscavcoef_init uses this +! call calc_1_impact_rate( & +! dg0, sigmag, rhoaero, temp, press, & +! scavratenum, scavratevol, lunerr ) + call calc_1_impact_rate( & + tmpa, tmpb, tmpc, tmpd, tmpe, & + tmpf, tmpg, lun142 ) + write(lun142,'(1p,8e11.3)') dgratio, & + tmpa, tmpb, tmpc, tmpd, tmpe + write(lun142,'(1p,8e11.3)') & + scavcoef_num(k,icc,jcls,ipp,m,n), tmpf, & + scavcoef_vol(k,icc,jcls,ipp,m,n), tmpg + write(lun142,'(1p,8e11.3)') & + dry_mass, dry_volu, wet_volu, dry_diam, wet_diam, tmp_rh, & + chem_tmpa(k,icc,jcls,ipp,numptr_aer(m,n,ai_phase)) + end if + + end do ! m + end do ! n + + end do icc_loop ! icc + end do ! ipp + end do ! jcls + end do ! k + + +! write(*,'(a)') 'wetscav_2_bcscavcoef DONE' + return + end subroutine wetscav_2_bcscavcoef + + + +!----------------------------------------------------------------------- + subroutine wetscav_2_precip_evap_xfer( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + is_active, is_precp, is_ptgain, is_ptloss, & + acen_tmp, prtb, frac_evap_prtb, frac_xfer_prtb, & + fxaa_evap_prtb ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! wetscav_2_precip_evap_xfer calculates the fractions of precip +! (and precip-borne aerosols) entering the top of a subarea that are either +! > evaporated/resuspended or +! > transferred to another subarea +! +!----------------------------------------------------------------------- + +! use module_state_description, only: p_qv, p_qc + +! use module_data_radm2, only: epsilc + +! use module_data_mosaic_asect, only: ai_phase, cw_phase, & +! massptr_aer, maxd_asize, maxd_atype, & +! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & +! waterptr_aer + + use module_data_ecpp1 + + implicit none + +! subr arguments + integer, intent(in) :: & + ktau, ktau_pp, itstep_sub, & + it, jt, kts, ktebnd, ktecen + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & + idiagbb_wetscav + integer, intent(in) :: ncls_use + + real(r8), intent(in) :: dtstep, dtstep_sub + + logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + is_active, is_precp + logical, intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + is_ptgain, is_ptloss + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: acen_tmp + real(r8), intent(in), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: prtb + + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_evap_prtb + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & + 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_xfer_prtb + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & + 1:2, 1:maxcls_ecpp, 1:2 ) :: fxaa_evap_prtb +! frac_evap_prtb = fraction of precip (and precip-borne aerosols) entering the +! top of a subarea that is evaporated/resuspended +! frac_xfer_prtb = fraction of precip (and precip-borne aerosols) entering the +! top of a subarea that is transferred to another subarea +! (the first set of icc,jcls,ipp indices are the "xfer from" subarea) +! (the second set of icc,jcls,ipp indices are the "xfer to " subarea) + +! local variables + integer :: icc, icc_g, icc_l, iphase, ipp, ipp_l, ipp_g + integer :: jcls, jcls_g, jcls_l + integer :: k, km1 + integer :: lun141 + integer :: m + + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg, tmph + real(r8) :: tmpvecb(100), tmpvece(100), tmpvecf(100) + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + delprtb, delprtb_g, delprtb_l + real(r8), dimension( kts:ktecen ) :: & + delprtb_gtot, delprtb_ltot, delprtb_xtot, & + frac_evap, frac_xferg, frac_xferl + + + lun141 = -1 + if (idiagaa_ecpp(141) > 0) lun141 = ldiagaa_ecpp(141) + if (idiagbb_wetscav <= 0) lun141 = -1 + + is_ptloss(kts:ktecen,1:2,1:ncls_use,1:2) = .false. + is_ptgain(kts:ktecen,1:2,1:ncls_use,1:2) = .false. + + frac_evap_prtb(kts:ktecen,1:2,1:ncls_use,1:2) = 0.0_r8 + frac_xfer_prtb(kts:ktecen,1:2,1:ncls_use,1:2, 1:2,1:ncls_use,1:2) = 0.0_r8 + fxaa_evap_prtb(kts:ktecen,1:2,1:ncls_use,1:2, 1:2,1:ncls_use,1:2) = 0.0_r8 + + delprtb_gtot(:) = 0.0_r8 ; delprtb_ltot(:) = 0.0_r8 ; delprtb_xtot(:) = 0.0_r8 + frac_evap(:) = 0.0_r8 ; frac_xferg(:) = 0.0_r8 ; frac_xferl(:) = 0.0_r8 + +main_kloop_aa: & + do k = ktecen, kts, -1 + +! +! calculate the fractions of precip (and precip-borne aerosols) +! entering the top of a subarea that are either +! > evaporated/resuspended or +! > transferred to another subarea +! +! this is a bit tricky because we do not have evaporation information, +! and a decrease in precip from k+1 to k for one subarea +! can be due to that precip being classified as in another subarea +! +! approach here is to calculate precip loss and gains (from k+1 to k) +! for each subarea, then try to balance them out +! any "unbalanced" loss is treated as true evaporation +! + + do ipp = 1, 2 + do jcls = 1, ncls_use + do icc = 1, 2 +! delprtb = change in subarea precip from k+1 to k +! delprtb_g = gain in subarea precip from k+1 to k +! delprtb_l = loss in subarea precip from k+1 to k, but sign is positive + delprtb(k,icc,jcls,ipp) = prtb(k, icc,jcls,ipp) & + - prtb(k+1,icc,jcls,ipp) + delprtb_g(k,icc,jcls,ipp) = max( 0.0_r8, delprtb(k,icc,jcls,ipp) ) + delprtb_l(k,icc,jcls,ipp) = max( 0.0_r8, -delprtb(k,icc,jcls,ipp) ) + if (delprtb_g(k,icc,jcls,ipp) > 0.0_r8) is_ptgain(k,icc,jcls,ipp) = .true. + if (delprtb_l(k,icc,jcls,ipp) > 0.0_r8) is_ptloss(k,icc,jcls,ipp) = .true. + end do + end do + end do + +! delprtb_gtot = sum of delprtb_g over all subareas ; similar for depltrb_ltot + delprtb_gtot(k) = sum( delprtb_g(k,1:2,1:ncls_use,1:2) ) + delprtb_ltot(k) = sum( delprtb_l(k,1:2,1:ncls_use,1:2) ) +! delprtb_xtot = is amount of precip loss that can be balance by precip gain + delprtb_xtot(k) = min( delprtb_gtot(k), delprtb_ltot(k) ) + + if (delprtb_gtot(k) > 0.0_r8) then + frac_xferg(k) = delprtb_xtot(k) / delprtb_gtot(k) + frac_xferg(k) = max( 0.0_r8, min( 1.0_r8, frac_xferg(k) ) ) + end if + + if (delprtb_ltot(k) <= 0.0_r8) cycle main_kloop_aa ! bypass next steps if no loss + + frac_xferl(k) = delprtb_xtot(k) / delprtb_ltot(k) + frac_xferl(k) = max( 0.0_r8, min( 1.0_r8, frac_xferl(k) ) ) + frac_evap(k) = 1.0_r8 - frac_xferl(k) + + +! do calcs associated with balancing of precip loss and gain +! current approach is that there is no preferred pairing of +! "losing" and "gaining" subareas +! one might want to pair the clear and cloud subareas of a +! transport class first -- something to think about in the future +! *** this code is incomplete *** +! +! loop over the "losing" subareas + do jcls_l = 1, ncls_use + do ipp_l = 1, 2 + do icc_l = 1, 2 + if ( .not. is_ptloss(k,icc_l,jcls_l,ipp_l) ) cycle + tmpa = delprtb_l(k,icc_l,jcls_l,ipp_l)/prtb(k+1,icc_l,jcls_l,ipp_l) + frac_evap_prtb(k,icc_l,jcls_l,ipp_l) = frac_evap(k)*tmpa + +! loop over the "gaining" subareas + if (frac_xferl(k) <= 1.0e-7_r8) cycle + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + if ( .not. is_ptgain(k,icc_g,jcls_g,ipp_g) ) cycle + tmpb = delprtb_g(k,icc_g,jcls_g,ipp_g)/delprtb_gtot(k) + frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) = & + frac_xferl(k)*tmpa*tmpb + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + +! if a subarea exists ( is_active ) and has precip>0 at k+1, +! but does not exist at k, then the evaporated/resuspended material +! from the losing subarea must go to other subareas +! the fxaa_evap_prtb are used for this + if ( .not. is_active(k,icc_l,jcls_l,ipp_l) ) then + tmpf = 0.0_r8 + do jcls_g = 1, ncls_use + do ipp_g = 1, 2 + do icc_g = 1, 2 + if ( .not. is_active(k,icc_g,jcls_g,ipp_g) ) cycle + if ((jcls_g == jcls_l) .and. & + (ipp_g == ipp_l) .and. (icc_g == icc_l)) cycle + tmpf = tmpf + acen_tmp(k,icc_g,jcls_g,ipp_g) + fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) = 1.0_r8 + end do ! icc_g + end do ! ipp_g + end do ! jcls_g + fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, 1:2,1:ncls_use,1:2) = & + fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, 1:2,1:ncls_use,1:2)*tmpf + end if + + end do ! icc_l + end do ! ipp_l + end do ! jcls_l + + + end do main_kloop_aa + + +! +! diagnostics for testing +! +! first set shows main arrays that can be inspected visually + if (lun141 > 0) then + + tmph = 3600.0_r8 + do k = ktecen, kts, -1 + + write(lun141,'(a,i3)') 'k =', k + + tmpa = delprtb_ltot(k) - delprtb_xtot(k) + tmpb = sum( frac_evap_prtb(k,1:2,1:ncls_use,1:2)*prtb(k+1,1:2,1:ncls_use,1:2) ) + write(lun141,'(a,2f9.5,2x,3f9.5,2x,2f9.5)') 'frac_xferl/evap, delg/l/xtot=', frac_xferl(k), frac_evap(k), & + 3600.0_r8*delprtb_gtot(k), 3600.0_r8*delprtb_ltot(k), 3600.0_r8*delprtb_xtot(k), & + 3600.0_r8*tmpa, 3600.0_r8*tmpb + + write(lun141,'(a,3(2x,4f9.5))') 'acen =', (((acen_tmp(k,icc,jcls,ipp), icc=1,2), ipp=1,2), jcls=1,ncls_use) + write(lun141,'(a,3(2x,4f9.5))') 'prtb =', (((prtb(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) + write(lun141,'(a,3(2x,4f9.5))') 'delprtb =', (((delprtb(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) + write(lun141,'(a,3(2x,4f9.5))') 'delprtb_g =', (((delprtb_g(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) + write(lun141,'(a,3(2x,4f9.5))') 'delprtb_l =', (((delprtb_l(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) + icc_l = 2 ; ipp_l = 2 ; icc_g = 2 ; ipp_g = 2 + write(lun141,'(a,3(2x,4f9.5))') 'frac_ev/xf =', ( frac_evap_prtb(k,icc_l,jcls_l,ipp_l), & + ( frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g), jcls_g=1,ncls_use), jcls_l=1,ncls_use) + + end do + + +! second set does "conservation checks" +! is prtb(k) equal to [prtb(k+1) + gains - losses] ? + do k = ktecen, kts, -1 + + write(lun141,'(a,i3)') 'k =', k + +! here check sum( prtb ) over all subareas + tmpa = sum( prtb(k+1,1:2,1:ncls_use,1:2) ) + tmpb = sum( prtb(k ,1:2,1:ncls_use,1:2) ) + tmpc = tmpa + delprtb_gtot(k) - delprtb_ltot(k) + tmpd = tmpa + delprtb_gtot(k)*(1.0_r8 - frac_xferg(k)) - delprtb_ltot(k)*(1.0_r8 - frac_xferl(k)) + tmpe = (tmpb-tmpc)*tmph ! absolute error in mm/h + tmpf = (tmpb-tmpd)*tmph + tmpe = (tmpb-tmpc)/max(tmpa,tmpb,1.0e-30_r8) ! relative error + tmpf = (tmpb-tmpd)/max(tmpa,tmpb,1.0e-30_r8) + write(lun141,'(a,1p,2e10.2)') 'relerr1/2 =', tmpe, tmpf + +! here check prtb for each subarea + m = 0 + do jcls = 1, ncls_use + do ipp = 1, 2 + do icc = 1, 2 + tmpa = prtb(k+1,icc,jcls,ipp) + tmpb = prtb(k ,icc,jcls,ipp) + tmpc = tmpa + delprtb_g(k,icc,jcls,ipp) - delprtb_l(k,icc,jcls,ipp) + if ( is_ptgain(k,icc,jcls,ipp) ) then + tmpd = tmpa + delprtb_g(k,icc,jcls,ipp)*(1.0_r8 - frac_xferg(k)) & + + sum( frac_xfer_prtb(k,1:2,1:ncls_use,1:2,icc,jcls,ipp)*prtb(k+1,1:2,1:ncls_use,1:2) ) + else if ( is_ptloss(k,icc,jcls,ipp) ) then + tmpd = tmpa - prtb(k+1,icc,jcls,ipp)*( frac_evap_prtb(k,icc,jcls,ipp) & + + sum( frac_xfer_prtb(k,icc,jcls,ipp,1:2,1:ncls_use,1:2) ) ) + else + tmpd = tmpb + end if + tmpe = (tmpb-tmpc)*tmph ! absolute error in mm/h + tmpf = (tmpb-tmpd)*tmph + tmpe = (tmpb-tmpc)/max(tmpa,tmpb,1.0e-30_r8) ! relative error + tmpf = (tmpb-tmpd)/max(tmpa,tmpb,1.0e-30_r8) + m = m + 1 + tmpvece(m) = tmpe + tmpvecf(m) = tmpf + tmpvecb(m) = tmpb*tmph + end do + end do + end do + write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvecb =', tmpvecb(1:m) + write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvece =', tmpvece(1:m) + write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvecf =', tmpvecf(1:m) + + end do ! k = ktecen, kts, -1 + + end if ! (lun141 > 0) + + + end subroutine wetscav_2_precip_evap_xfer + + +end module ecpp_modal_wetscav + diff --git a/src/physics/spcam/ecpp/module_data_ecpp1.F90 b/src/physics/spcam/ecpp/module_data_ecpp1.F90 new file mode 100644 index 0000000000..3c64e259b7 --- /dev/null +++ b/src/physics/spcam/ecpp/module_data_ecpp1.F90 @@ -0,0 +1,229 @@ +! file module_data_ecpp1.F +!----------------------------------------------------------------------- + + module module_data_ecpp1 + + use shr_kind_mod, only: r8=>shr_kind_r8 + +! integer, parameter :: r4=4 +! integer, parameter :: r8=8 + + +! following are used to dimension several arrays +! declared in module_ecpp_ppdriver.F with "save" +! in mmf framework, these arrays will be subr parameters +! in wrf-chem framework, doing this is just too much trouble +! because of registry limitations + integer, parameter :: its_ecpptmp=1 + integer, parameter :: ite_ecpptmp=1 + integer, parameter :: jts_ecpptmp=1 + integer, parameter :: jte_ecpptmp=1 + integer, parameter :: kts_ecpptmp=1 + integer, parameter :: kte_ecpptmp=51 + integer, parameter :: ktebnd_ecpptmp=kte_ecpptmp + integer, parameter :: ktecen_ecpptmp=kte_ecpptmp-1 + integer, parameter :: num_chem_ecpptmp=101 + + +! maximum number of ecpp transport classes, used for dimensioning various arrays + integer, parameter :: maxcls_ecpp=3 + integer, parameter :: maxsub_ecpp=maxcls_ecpp + +! maximum number of "precipitation types" for wetscav diagnostics +! currently this is 1 +! the wetscav diagnostics are done for each subarea type, so +! have info on where (up, down, quiescent) the scavenging happens. +! however, they do no account for the fact that precip formed +! in updraft can fall (or shift) into quiescent, etc. +! eventually it might be 2, so would have diagnostics involving +! where precip is formed -- quiescent versus (convective) up/downdrafts) + integer, parameter :: max_wetdiagtype = 1 + +! set this to .false. for cam3-mmf + logical, parameter :: hostcode_is_wrfchem = .false. + + +! these are possible values for mtype_updnenv_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm + integer, parameter :: mtype_updraft_ecpp=1 + integer, parameter :: mtype_dndraft_ecpp=2 + integer, parameter :: mtype_quiescn_ecpp=3 + integer, parameter :: mtype_upempty_ecpp=-1 + integer, parameter :: mtype_dnempty_ecpp=-2 + integer, parameter :: mtype_quempty_ecpp=-3 + +! these are possible values for mtype_clrcldy_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm + integer, parameter :: mtype_iscloud_ecpp=11 + integer, parameter :: mtype_nocloud_ecpp=0 + +! these are possible values for mtype_precip_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm + integer, parameter :: mtype_isprecip_ecpp=21 + integer, parameter :: mtype_noprecip_ecpp=0 + + +! this flag determines whether updraft & dndraft profiles are calculated +! using the "primed" mass fluxes or "full" mass fluxes + integer, save :: ppopt_updn_prof_aa +! these are possible values for the flag + integer, parameter :: ppopt_updn_prof_aa_wfull=2001 + integer, parameter :: ppopt_updn_prof_aa_wprime=2002 + + +! this flag determines whether quiescent subarea mass fluxes are +! provided by the host or calculated in the ppm + integer, save :: ppopt_quiescn_mf + integer, parameter :: ppopt_quiescn_mf_byhost=2101 +! these are possible values for the flag + integer, parameter :: ppopt_quiescn_mf_byppmx1=2101 + + +! this flag determines how the quiescent subarea mixing ratios +! are obtained for source-sink calculations + integer, save :: ppopt_quiescn_sosi +! these are possible values for the flag +! 2201 -- qe = qbar + integer, parameter :: ppopt_quiescn_sosi_x1=2201 +! 2202 -- ae*qe = max( 0.0, (qbar-au*qu-ad*qd) ) + integer, parameter :: ppopt_quiescn_sosi_x2=2202 + + +! this flag determines how the subgrid vertical fluxes (and the +! finite differencing for flux divergence) is calculated + integer, save :: ppopt_chemtend_wq +! these are possible values for the flag +! 2301 -- vertflux = mu*qu + md*qd - (mu+md)*qbar; +! upstream approach for qbar at layer boundaries + integer, parameter :: ppopt_chemtend_wq_wfullx1=2301 +! 2302 -- vertflux = mu'*qu + md'*qd - (mu'+md')*qbar; +! upstream approach for qbar at layer boundaries + integer, parameter :: ppopt_chemtend_wq_wprimex1=2302 + + +! this flag determines how the sub-time-step for integrating the +! d(qbar)/dt equation is determined +! (use sub-timesteps to keep courant number < 1 and +! avoid negative mixing ratios) + integer, save :: ppopt_chemtend_dtsub +! these are possible values for the flag + integer, parameter :: ppopt_chemtend_dtsub_x1=2401 +! 2401 -- dumcournomax = max( dumcourentmax, dumcouroutbmax ) + integer, parameter :: ppopt_chemtend_dtsub_x2=2402 +! 2402 -- dumcournomax = max( dumcourentmax, dumcouroutamax, +! dumcouroutbmax ) + integer, parameter :: ppopt_chemtend_dtsub_x3=2403 +! 2403 -- dtstep_sub = largest value that does not produce +! negative mixing ratios + + +! this flag determines how frequently xxx +! is called to calculate up & dndraft profiles and source/sinks + integer, save :: ppopt_chemtend_updnfreq +! these are possible values for the flag + integer, parameter :: ppopt_chemtend_updnfreq_x1=2501 +! 2501 -- called just once, when istep_sub=1 + integer, parameter :: ppopt_chemtend_updnfreq_x2=2502 +! 2502 -- called for each istep_sub + + + integer, parameter :: lunout = 0 + + +! index of quiescent transport class + integer, parameter :: jcls_quiescn = 1 + integer, parameter :: jcls_qu = jcls_quiescn + + +! subarea-average vertical mass fluxes (kg/m2/s) smaller than this +! are treated as zero +! largest expected flux is ~1 (rho=1, w=10, afrac=0.1) +! so could expect truncation errors between 1e-7 and 1e-6 + real(r8), parameter :: mf_smallaa = 1.0e-6_r8 + + +! subarea-average vertical mass fluxes (kg/m2/s) smaller than +! aw_draft_cut*rho are treated as zero +! note that with a*w = 1e-4 m/s, dz over 1 day = 8.6 m which +! is small +! real(r8), parameter :: aw_draft_cut = 1.0e-4_r8 ! m/s +!! maximum expected updraft +! real(r8), parameter :: w_draft_max = 50.0_r8 ! m/s +!! fractional areas below afrac_cut are ignored +! real(r8), parameter :: afrac_cut = aw_draft_cut/w_draft_max +! real(r8), parameter :: afrac_cut_bb = afrac_cut*0.5_r8 +! real(r8), parameter :: afrac_cut_0p5 = afrac_cut*0.5_r8 +! real(r8), parameter :: afrac_cut_0p2 = afrac_cut*0.2_r8 +! real(r8), parameter :: afrac_cut_0p1 = afrac_cut*0.1_r8 + + real(r8), save :: aw_draft_cut = 1.0e-4_r8 ! m/s +! maximum expected updraft + real(r8), save :: w_draft_max = 50.0_r8 ! m/s +! fractional areas below afrac_cut are ignored + real(r8), save :: afrac_cut + real(r8), save :: afrac_cut_bb, afrac_cut_0p5, afrac_cut_0p2, afrac_cut_0p1 + + +! draft lifetime (s) + real(r8), save :: draft_lifetime + +! activat_onoff_ecpp - if positive, do aerosol activation in ecpp +! (set to +1 for normal runs) + integer, save :: activat_onoff_ecpp + +! cldchem_onoff_ecpp - if positive, do aerosol activation in ecpp +! (set to +1 for normal runs) + integer, save :: cldchem_onoff_ecpp + +! rename_onoff_ecpp - if positive, do aerosol activation in ecpp +! (set to +1 for normal runs) + integer, save :: rename_onoff_ecpp + +! wetscav_onoff_ecpp - if positive, do aerosol activation in ecpp +! (set to +1 for normal runs) + integer, save :: wetscav_onoff_ecpp + +! iflag_ecpp_startup_acw_partition - when positive, do +! "special partitioning" of cloudborne and interstitial aerosol to +! clear and cloudy subareas (cloudy gets less interstitial than clear) +! in subr parampollu_tdx_startup +! for normal runs, set this to +1 + integer, save :: iflag_ecpp_startup_acw_partition + +! iflag_ecpp_startup_host_chemtend - when positive, apply +! host changes to chem mixing ratios (e.g., emissions, gas chem) +! in subr parampollu_tdx_startup +! for normal runs, set this to +1 + integer, save :: iflag_ecpp_startup_host_chemtend + +! iflag_ecpp_test_bypass_1 used for early testing - +! when positive, bypass the parampollu_td--- routine +! for normal runs, set this to 0 + integer, save :: iflag_ecpp_test_bypass_1 + +! iflag_ecpp_test_fixed_fcloud used for (early) testing with various fixed cloud fracs +! for normal runs, set this to zero + integer, save :: iflag_ecpp_test_fixed_fcloud + +! "method" flag for parameterized-pollutants module +! (set to +2223 for normal runs and in mmf) + integer, save :: parampollu_opt + +! minimum fractional area for total quiescent class + real(r8), save :: a_quiescn_minaa = 0.60_r8 ! min area for initial total quiescent + real(r8), save :: a_quiescn_minbb = 0.30_r8 ! min area for final total quiescent + + + integer, save :: num_chem_ecpp, param_first_ecpp + + integer, save :: num_chem + integer, save :: p_qc + integer, save :: p_qv + + integer, save :: p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & + p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 + +! time step for the ECPP +! It is fixed to be 1800 s. The GCM time step can be less than 1800s. +! For example, if GCM time step is 600s, ECPP will be called at every third GCM time step + real(r8), parameter :: dtstep_pp_input = 1800.0_r8 + + end module module_data_ecpp1 + diff --git a/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 b/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 new file mode 100644 index 0000000000..e07cb29f44 --- /dev/null +++ b/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 @@ -0,0 +1,131 @@ +!********************************************************************************** +! This computer software was prepared by Battelle Memorial Institute, hereinafter +! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of +! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY, +! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE. +! +! MOSAIC module: see module_mosaic_driver.F for information and terms of use +!********************************************************************************** + module module_data_mosaic_asect + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + +!----------------------------------------------------------------------- +! +! The variables in this module provide a means of organizing and accessing +! aerosol species in the "chem" array by their chemical component, +! size bin (or mode), "type", and "phase" +! +! Their purpose is to allow flexible coding of process modules, +! compared to "hard-coding" using the chem array p_xxx indices +! (e.g., p_so4_a01, p_so4_a02, ...; p_num_a01, ...) +! +!----------------------------------------------------------------------- +! +! rce & sg 2004-dec-03 - added phase and type capability, +! which changed this module almost completely +! +!----------------------------------------------------------------------- +! +! maxd_atype = maximum allowable number of aerosol types +! maxd_asize = maximum allowable number of aerosol size bins +! maxd_acomp = maximum allowable number of chemical components +! in each aerosol size bin +! maxd_aphase = maximum allowable number of aerosol phases +! (gas, cloud, ice, rain, ...) +! +! ntype_aer = number of aerosol types +! The aerosol type will allow treatment of an externally mixed +! aerosol. The current MOSAIC code has only 1 type, with the implicit +! assumption of internal mixing. Eventually, multiple types +! could treat fresh primary BC/OC, fresh SO4 from nucleation, +! aged BC/OC/SO4/... mixture, soil dust, sea salt, ... +! +! nphase_aer = number of aerosol phases +! +! ai_phase = phase (p) index for interstitial (unactivated) aerosol particles +! cw_phase = phase (p) index for aerosol particles in cloud water +! ci_phase = phase (p) index for aerosol particles in cloud ice +! rn_phase = phase (p) index for aerosol particles in rain +! sn_phase = phase (p) index for aerosol particles in snow +! gr_phase = phase (p) index for aerosol particles in graupel +! [Note: the value of "xx_phase" will be between 1 and nphase_aer +! for phases that are active in a simulation. The others +! will have non-positive values.] +! +! nsize_aer(t) = number of aerosol size bins for aerosol type t +! +! ncomp_aer(t) = number of "regular" chemical components for aerosol type t +! +! massptr_aer(c,s,t,p) = the position/index in the chem array for mixing- +! ratio for chemical component c, size bin s, type t, and phase p. +! +! numptr_aer(s,t,p) = the position/index in the chem array for mixing- +! ratio of particle number for size bin s, type t, and phase p. +! +!----------------------------------------------------------------------- +! +! dens_aer(c,t) = dry density (g/cm^3) of aerosol chemical component +! c of type t +! [Note: dens_aer(c,t) == dens_mastercomp_aer(mastercompptr_aer(c,t)) +! The dens_mastercomp_aer is used in some initialization routines. +! The dens_aer is used in most other places because of convenience.] +! +!----------------------------------------------------------------------- +! +! volumlo_sect(s,t) = 1-particle volume (cm^3) at lower boundary of section m +! volumhi_sect(s,t) = 1-particle volume (cm^3) at upper boundary of section m +! volumcen_sect(s,t)= 1-particle volume (cm^3) at "center" of section m +! +! [Note: the "center" values are defined as follows: +! volumcen_sect == 0.5*(volumlo_sect + volumhi_sect) +! == (pi/6) * (dcen_sect**3) ] +! +! +!----------------------------------------------------------------------- + + integer, save :: maxd_atype = 0 + integer, save :: maxd_asize = 0 + integer, save :: maxd_acomp = 0 + integer, save :: maxd_aphase = 0 + + integer, save :: ai_phase = -999888777 + integer, save :: cw_phase = -999888777 +! integer, save :: ci_phase = -999888777 +! integer, save :: rn_phase = -999888777 +! integer, save :: sn_phase = -999888777 +! integer, save :: gr_phase = -999888777 + + integer, save :: ntype_aer = 0 ! number of types + integer, save :: nphase_aer = 0 ! number of phases + + integer, allocatable :: & + nsize_aer (:), & ! number of size bins + ncomp_aer (:), & ! number of chemical components + massptr_aer( :, :, :, :), & + ! index for mixing ratio + numptr_aer( :, :, :) ! index for the number mixing ratio + + real(r8), allocatable :: dens_aer(:,:) ! aerosol density + real(r8), allocatable :: hygro_aer(:,:) ! hygroscopicity + real(r8), allocatable :: sigmag_aer(:,:) ! geometric standard deviation for aerosol + +! added by Yang Zhang + real(r8), allocatable :: & + volumhi_sect(:,:), & + volumlo_sect(:,:), & + dcen_sect(:,:), & + dlo_sect(:,:), & + dhi_sect(:,:) + +! flag for aerosols +++mhwang + logical, allocatable :: is_aerosol(:) ! true if field is aerosol (any phase) + + integer, allocatable :: & + iphase_of_aerosol(:), isize_of_aerosol(:), itype_of_aerosol(:), & + inmw_of_aerosol(:), laicwpair_of_aerosol(:) + + end module module_data_mosaic_asect diff --git a/src/physics/spcam/ecpp/module_data_radm2.F90 b/src/physics/spcam/ecpp/module_data_radm2.F90 new file mode 100644 index 0000000000..7408bc7249 --- /dev/null +++ b/src/physics/spcam/ecpp/module_data_radm2.F90 @@ -0,0 +1,178 @@ +!WRF:MODEL_LAYER:CHEMICS +! + MODULE module_data_radm2 + + use shr_kind_mod, only: r8 => shr_kind_r8 + + IMPLICIT NONE +! REAL(r8), PARAMETER :: epsilc = 1.E-16_r8 + REAL(r8), PARAMETER :: epsilc = 1.E-12_r8 + +!--- for radm solver +! .. Parameters .. + INTEGER, PARAMETER :: ldiag = 18, lpred = 39, lss = 2, & + lump = 4, naqre = 70, nreacj = 21, nreack = 140, & + ntroe = 7, numchem_radm = 41 + INTEGER, PARAMETER :: lspec = lpred + lss + INTEGER, DIMENSION(1:NTROE) :: itroe = (/11, 22, 10, 15, 21, 24, 28/) +! +! +! + INTEGER, PARAMETER :: lso2=1 + INTEGER, PARAMETER :: lsulf=2 + INTEGER, PARAMETER :: lno2=3 + INTEGER, PARAMETER :: lno=4 + INTEGER, PARAMETER :: lo3=5 + INTEGER, PARAMETER :: lhno3=6 + INTEGER, PARAMETER :: lh2o2=7 + INTEGER, PARAMETER :: lald=8 + INTEGER, PARAMETER :: lhcho=9 + INTEGER, PARAMETER :: lop1=10 + INTEGER, PARAMETER :: lop2=11 + INTEGER, PARAMETER :: lpaa=12 + INTEGER, PARAMETER :: lora1=13 + + INTEGER, PARAMETER :: lora2=14 + INTEGER, PARAMETER :: lnh3=15 + INTEGER, PARAMETER :: ln2o5=16 + INTEGER, PARAMETER :: lno3=17 + INTEGER, PARAMETER :: lpan=18 + INTEGER, PARAMETER :: lhc3=19 + INTEGER, PARAMETER :: lhc5=20 + INTEGER, PARAMETER :: lhc8=21 + + INTEGER, PARAMETER :: leth=22 + INTEGER, PARAMETER :: lco=23 + INTEGER, PARAMETER :: lol2=24 + INTEGER, PARAMETER :: lolt=25 + INTEGER, PARAMETER :: loli=26 + INTEGER, PARAMETER :: ltol=27 + INTEGER, PARAMETER :: lxyl=28 + INTEGER, PARAMETER :: laco3=29 + + INTEGER, PARAMETER :: ltpan=30 + INTEGER, PARAMETER :: lhono=31 + INTEGER, PARAMETER :: lhno4=32 + INTEGER, PARAMETER :: lket=33 + INTEGER, PARAMETER :: lgly=34 + INTEGER, PARAMETER :: lmgly=35 + INTEGER, PARAMETER :: ldcb=36 + INTEGER, PARAMETER :: lonit=37 + + INTEGER, PARAMETER :: lcsl=38 + INTEGER, PARAMETER :: liso=39 + INTEGER, PARAMETER :: lho=40 + INTEGER, PARAMETER :: lho2=41 +! parameters for timestep, integration + INTEGER, DIMENSION(1:lpred) :: intgrt = (/1, 1, 1, 0, 1, & + 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, & + 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1 /) +! INTEGER, DIMENSION(1:lspec) :: qdtc = (/0, 0, 1, 0, 1, & +! 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, & +! 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, & +! 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, & +! 0, 0, 0, 0, 0, 0 /) + INTEGER, DIMENSION(1:lspec) :: qdtc = (/1, 1, 1, 0, 1, & + 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, & + 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 0, 0 /) +! max, min values, + INTEGER :: itrdu +! + REAL(r8), DIMENSION(1:lspec) :: cmin =(/(1.E-16_r8,itrdu=1,lspec)/) +! + REAL(r8), DIMENSION(1:lspec) :: cmax=(/1._r8, 1._r8, 1._r8, 1._r8, .2_r8, & + 3._r8, .05_r8, .01_r8, .01_r8, .01_r8, .05_r8, .01_r8, .05_r8, .05_r8,.05_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8,.0001_r8, .1_r8, & + 1._r8, .001_r8, .01_r8, .01_r8, .01_r8, .01_r8/) + +! +! +! + INTEGER, PARAMETER :: lo3p=1 + INTEGER, PARAMETER :: lo1d=2 + INTEGER, PARAMETER :: ltco3=3 + INTEGER, PARAMETER :: lhc3p=4 + INTEGER, PARAMETER :: lhc5p=5 + INTEGER, PARAMETER :: lhc8p=6 + + INTEGER, PARAMETER :: lol2p=7 + INTEGER, PARAMETER :: loltp=8 + INTEGER, PARAMETER :: lolip=9 + INTEGER, PARAMETER :: ltolp=10 + INTEGER, PARAMETER :: lxylp=11 + INTEGER, PARAMETER :: lethp=12 + INTEGER, PARAMETER :: lketp=13 + INTEGER, PARAMETER :: loln=14 + + INTEGER, PARAMETER :: lxo2=15 + INTEGER, PARAMETER :: lxno2=16 + INTEGER, PARAMETER :: lxho=17 + INTEGER, PARAMETER :: lmo2=18 +! +! + INTEGER, PARAMETER :: lnox=1 + INTEGER, PARAMETER :: lhox=2 + INTEGER, PARAMETER :: lpao3=3 + INTEGER, PARAMETER :: ln2n3=4 +! .. + REAL(r8), PARAMETER :: ch4=1.7_r8 + REAL(r8), PARAMETER :: co2=350._r8 + REAL(r8), PARAMETER :: n2=7.81E5_r8 + REAL(r8), PARAMETER :: o2=2.09E5_r8 + REAL(r8), PARAMETER :: pi=3.141592654_r8 + +! .. + REAL(r8) :: afac(2), & + bfac(2), const(3), eor(nreack), & + thafac(nreack), & + xk0300(ntroe), & + xkf300(ntroe), xmtroe(ntroe), xntroe(ntroe) + +! .. +! .. Data Statements .. + DATA thafac/0.00_r8, 6.50E-12_r8, 1.80E-11_r8, 3.20E-11_r8, 2.20E-10_r8, 2.00E-12_r8, & + 1.60E-12_r8, 1.10E-14_r8, 3.70E-12_r8, 4*0.00_r8, 3.30E-12_r8, 0.00_r8, 3.30E-19_r8, & + 1.40E-13_r8, 1.70E-11_r8, 2.50E-14_r8, 2.50E-12_r8, 2*0.00_r8, 2.00E-21_r8, 2*0.00_r8, & + 1.30E-12_r8, 4.60E-11_r8, 2*0.00_r8, 6.95E-18_r8, 1.37E-17_r8, 1.59E-11_r8, 1.73E-11_r8, & + 3.64E-11_r8, 2.15E-12_r8, 5.32E-12_r8, 1.07E-11_r8, 2.10E-12_r8, 1.89E-11_r8, 4.00E-11_r8, & + 9.00E-12_r8, 6.87E-12_r8, 1.20E-11_r8, 1.15E-11_r8, 1.70E-11_r8, 2.80E-11_r8, 1.00E-11_r8, & + 1.00E-11_r8, 1.00E-11_r8, 6.85E-18_r8, 1.55E-11_r8, 2.55E-11_r8, 2.80E-12_r8, 1.95E+16_r8, & + 4.70E-12_r8, 1.95E+16_r8, 4.20E-12_r8, 4.20E-12_r8, 0.00_r8, 4.20E-12_r8, 0.00_r8, & + 4.20E-12_r8, 0.00_r8, 10*4.20E-12_r8, 6.00E-13_r8, 1.40E-12_r8, 6.00E-13_r8, 1.40E-12_r8, & + 1.40E-12_r8, 2.20E-11_r8, 2.00E-12_r8, 1.00E-11_r8, 3.23E-11_r8, 5.81E-13_r8, 1.20E-14_r8, & + 1.32E-14_r8, 7.29E-15_r8, 1.23E-14_r8, 14*7.70E-14_r8, 1.90E-13_r8, 1.40E-13_r8, & + 4.20E-14_r8, 3.40E-14_r8, 2.90E-14_r8, 1.40E-13_r8, 1.40E-13_r8, 1.70E-14_r8, 1.70E-14_r8, & + 9.60E-13_r8, 1.70E-14_r8, 1.70E-14_r8, 9.60E-13_r8, 3.40E-13_r8, 1.00E-13_r8, 8.40E-14_r8, & + 7.20E-14_r8, 3.40E-13_r8, 3.40E-13_r8, 4.20E-14_r8, 4.20E-14_r8, 1.19E-12_r8, 4.20E-14_r8, & + 4.20E-14_r8, 1.19E-12_r8, 7.70E-14_r8, 1.70E-14_r8, 4.20E-14_r8, 3.60E-16_r8, 4.20E-12_r8, & + 4.20E-12_r8, 7.70E-14_r8, 1.70E-14_r8, 4.20E-14_r8, 3.60E-16_r8, 0.00_r8, 1.70E-14_r8, & + 4.20E-14_r8, 3.60E-16_r8/ +! .. +! constants for RADM2 rate coefficients + DATA eor/0._r8, -120._r8, -110._r8, -70._r8, 0._r8, 1400._r8, 940._r8, 500._r8, -240._r8, 0._r8, 0._r8, & + 0._r8, 0._r8, 200._r8, 0._r8, -530._r8, 2500._r8, -150._r8, 1230._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, & + -380._r8, -230._r8, 0._r8, 0._r8, 1280._r8, 444._r8, 540._r8, 380._r8, 380._r8, -411._r8, -504._r8, & + -549._r8, -322._r8, -116._r8, 0._r8, 0._r8, -256._r8, 745._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, & + 444._r8, 540._r8, -409._r8, -181._r8, 13543._r8, 0._r8, 13543._r8, -180._r8, -180._r8, 0._r8, -180._r8, & + 0._r8, -180._r8, 0._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, & + -180._r8, -180._r8, 2058._r8, 1900._r8, 2058._r8, 1900._r8, 1900._r8, 0._r8, 2923._r8, 1895._r8, & + 975._r8, 0._r8, 2633._r8, 2105._r8, 1136._r8, 2013._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, & + -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, & + -1300._r8, -1300._r8, 25* -220._r8, -1300._r8, -220._r8, -220._r8, -220._r8, -180._r8, -180._r8, & + -1300._r8, -220._r8, -220._r8, 0._r8, 0._r8, -220._r8, -220._r8, -220._r8/ + + DATA xk0300/1.8E-31_r8, 2.2E-30_r8, 1.8E-31_r8, 7.E-31_r8, 2.2E-30_r8, 2.6E-30_r8, 3.E-31_r8/ + DATA xntroe/3.2_r8, 4.3_r8, 3.2_r8, 2.6_r8, 4.3_r8, 3.2_r8, 3.3_r8/ + DATA xkf300/4.7E-12_r8, 1.5E-12_r8, 4.7E-12_r8, 1.5E-11_r8, 1.5E-12_r8, 2.4E-11_r8, & + 1.5E-12_r8/ + DATA xmtroe/1.4_r8, 0.5_r8, 1.4_r8, 2*.5_r8, 1.3_r8, 0._r8/ + DATA afac/2.1E-27_r8, 1.1E-27_r8/ + DATA bfac/10900._r8, 11200._r8/ + DATA const/7.34E21_r8, 4.4E17_r8, 3.23E33_r8/ + + END MODULE module_data_radm2 diff --git a/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 b/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 new file mode 100644 index 0000000000..86455f33ab --- /dev/null +++ b/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 @@ -0,0 +1,1454 @@ +module module_ecpp_ppdriver2 + +!------------------------------------------------------------------------------------- +! Purpose: +! Provide the CAM interface to the Explicit-Cloud Parameterized-Pollutant hygrid +! approach for aerosol-cloud interactions in the MMF models. +! +! This module was adopted from the one written for the WRF-chem by Dick Easter. +! +! Minghuai Wang (Minghuai.Wang@pnl.gov), 2009-11 +!--------------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use constituents, only: pcnst, cnst_name, cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas + use crmclouds_camaerosols, only: ecpp_mixnuc_tend => crmclouds_mixnuc_tend + use cam_abortutils, only: endrun + + use crmx_ecppvars, only: nupdraft_in, ndndraft_in, ncls_ecpp_in, ncc_in, nprcp_in + use module_data_ecpp1 + use module_data_mosaic_asect + + implicit none + + public :: parampollu_driver2 + public :: papampollu_init + public :: ecpp_mixnuc_tend + +!+++mhwang follow what done in ndrop.F90. this is for qqcw +! ptr2d_t is used to create arrays of pointers to 2D fields +type ptr2d_t + real(r8), pointer :: fldcw(:,:) +end type ptr2d_t + + contains + +!----------------------------------------------------------------------------------------------- +! +! rce 2005-mar-10 - created +! +!------------------------------------------------------------------------------------------------ + subroutine papampollu_init ( ) +!------------------------------------------------------------------------------------------------ +! +! initialize some data used in ECPP, and map aerosol inforation in cam4 into mosaic. +! +! Minghuai Wang, 2009-11 +!------------------------------------------------------------------------------------------------- + use cam_history, only: addfld, add_default, horiz_only + use modal_aero_data + use module_ecpp_td2clm, only: set_of_aerosol_stuff + use module_ecpp_util, only: parampollu_1clm_set_opts + use phys_control, only: phys_getopts + +! Local variables + integer :: n, ll + integer :: ichem, ichem2 + real(r8) :: pi + real(r8) :: tmpa + logical :: history_aerosol + +! get history_aerosol + call phys_getopts(history_aerosol_out = history_aerosol) + +! calculate pi + pi = 4._r8*atan(1._r8) + +! +! set pp options (should this be done from driver?) +! + + num_chem_ecpp = 2* pcnst + num_chem = num_chem_ecpp + param_first_ecpp = 1 ! set to 1 as this can change + p_qv = 1 + p_qc = 2 + + allocate (is_aerosol(1:num_chem_ecpp)) + allocate (iphase_of_aerosol(1:num_chem_ecpp)) + allocate (isize_of_aerosol(1:num_chem_ecpp)) + allocate (itype_of_aerosol(1:num_chem_ecpp)) + allocate (inmw_of_aerosol(1:num_chem_ecpp)) + allocate (laicwpair_of_aerosol(1:num_chem_ecpp)) + +! +! Map the modal aerosol information in modal_aero_data.F90 to module_data_mosaic_asect.F90 +! In the ECPP written for the WRF-chem, it used the MOSAIC aerosol data. MOSAIC have different +! classifications, and use aeroso types, aerosol size bins, chemical components, and aerosol phases +! to describe aerosols. In the CAM4's modal aerosol treatment, it use aerosol modes, and chemical +! components to describe aerosols, and interstial and cloud-borne aerosols are separately tracked. +! When the ECPP codes are ported from the WRF-chem into the MMF model (CAM4.0_SAM), +! the MOSAIC's description of the aerosols are kept, in order to minimize +! the codes changes, but the aerosol information in CAM4.0 is mapped into the MOSAIC one in the +! following way: aeroso type is equivalent to aerosol modes in CAM4, and aerosol size is one for each aerosol type, +! and the aerosol chemical composition is just the same as that in CAM4. Interstitial aerosols in CAM4 is put into +! the phase 1, and cloud-borne aerosol in CAM4 is put into the pase 2. -Minghuai Wang (minghuai.wang@pnl.gov) +! + maxd_atype = ntot_amode + maxd_asize = 1 + maxd_acomp = nspec_max + maxd_aphase = 2 + + ai_phase = 1 ! index for interstial aerosols + cw_phase = 2 ! index for cloud-borne aerosols + + ntype_aer = ntot_amode + nphase_aer = 2 + + allocate (nsize_aer( 1:maxd_atype )) + allocate (ncomp_aer( 1:maxd_atype )) + allocate (massptr_aer( 1:maxd_acomp, 1:maxd_asize, 1:maxd_atype, 1:maxd_aphase )) + allocate (numptr_aer( 1:maxd_asize, 1:maxd_atype, 1:maxd_aphase )) + allocate (dens_aer( 1:maxd_acomp, 1:maxd_atype )) + allocate (hygro_aer( 1:maxd_acomp, 1:maxd_atype )) + allocate (volumhi_sect( 1:maxd_asize, 1:maxd_atype )) + allocate (volumlo_sect( 1:maxd_asize, 1:maxd_atype )) + allocate (sigmag_aer( 1:maxd_asize, 1:maxd_atype )) + allocate (dcen_sect(1:maxd_asize, 1:maxd_atype )) + allocate (dlo_sect(1:maxd_asize, 1:maxd_atype )) + allocate (dhi_sect(1:maxd_asize, 1:maxd_atype )) + + + nsize_aer(1:maxd_atype) = 1 + ncomp_aer(1:maxd_atype) = nspec_amode(1:ntot_amode) + + massptr_aer(1:maxd_acomp, 1, 1:maxd_atype, 1) = lmassptr_amode(1:nspec_max, 1:ntot_amode) + massptr_aer(1:maxd_acomp, 1, 1:maxd_atype, 2) = lmassptrcw_amode(1:nspec_max, 1:ntot_amode) + pcnst + + numptr_aer(1, 1:maxd_atype, 1) = numptr_amode(1:ntot_amode) + numptr_aer(1, 1:maxd_atype, 2) = numptrcw_amode(1:ntot_amode) + pcnst + + do n=1, ntype_aer + do ll=1, ncomp_aer(n) + dens_aer(ll, n) = specdens_amode(ll, n) + hygro_aer(ll, n) = spechygro(ll, n) + end do + + sigmag_aer(1, n) = sigmag_amode(n) + +! Notes: +! the tmpa factor is because +! dcen_sect, dlo_sect, dhi_sect are used as, +! and are compared to, volume-mean diameters +! dgnum_amode, dgnumlo_amode, dgnumhi_amode are used as, +! and are compared to, number-distribution geometric-mean diameters +! volume_mixing_ratio/(number_mixing_ratio*pi/6) +! = volume_mean_diameter**3 +! = (number_geometric_mean_diameter*tmpa)**3 + + tmpa = exp( 1.5_r8 * log(sigmag_amode(n))**2 ) + dcen_sect(1, n) = dgnum_amode(n)*tmpa + dlo_sect( 1, n) = dgnumlo_amode(n)*tmpa + dhi_sect( 1, n) = dgnumhi_amode(n)*tmpa + + volumlo_sect(1, n) = pi/6 * (dgnumlo_amode(n)*tmpa)**3 + volumhi_sect(1, n) = pi/6 * (dgnumhi_amode(n)*tmpa)**3 + end do + + afrac_cut = aw_draft_cut/w_draft_max + afrac_cut_bb = afrac_cut*0.5_r8 + afrac_cut_0p5 = afrac_cut*0.5_r8 + afrac_cut_0p2 = afrac_cut*0.2_r8 + afrac_cut_0p1 = afrac_cut*0.1_r8 + +! set flags + activat_onoff_ecpp = 1 ! droplet activation; 1 turns on activation + cldchem_onoff_ecpp = 1 ! cloud chemistry + rename_onoff_ecpp = 1 ! renaming (modal merging) + + wetscav_onoff_ecpp = 400 ! wet removable 400 turn on wet scaving + +! set convection lifetime + draft_lifetime = 7200 ! seconds, 2 hours lifetime for the momement + +! set flag for a/c partition + iflag_ecpp_startup_acw_partition = 1 ! 1 to turn on a/c parition + +! set flag for whether update changs from host codes + iflag_ecpp_startup_host_chemtend = 0 + +! set other flags + iflag_ecpp_test_bypass_1 = 0 + iflag_ecpp_test_fixed_fcloud = 0 + + parampollu_opt = 2223 ! method flag for parameterized-pollutants module + +! +! set pp options (should this be done from driver?) +! + call parampollu_1clm_set_opts( & + ppopt_updn_prof_aa_wfull, & + ppopt_quiescn_mf_byppmx1, & + ppopt_quiescn_sosi_x1, & + ppopt_chemtend_wq_wfullx1, & + ppopt_chemtend_dtsub_x1, & + ppopt_chemtend_updnfreq_x1 ) + +! +! some other initialization +! + call set_of_aerosol_stuff(is_aerosol, & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol ) + +! add fields into history file + do ichem=param_first_ecpp, pcnst + if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(ichem) == cnst_spec_class_gas )) then + if(trim(cnst_name(ichem))//'EP' == 'EP') then + write(0, *) ichem, trim(cnst_name(ichem))//'EP' + call endrun('ecpp init1') + end if + call addfld(trim(cnst_name(ichem))//'EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from ECPP' ) + call addfld(trim(cnst_name(ichem))//'ACHEM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from aqueous chemistry in ECPP' ) + call addfld(trim(cnst_name(ichem))//'RENM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from renaming in ECPP' ) + call addfld(trim(cnst_name(ichem))//'ACT_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from activation/resuspension in ECPP' ) + call addfld(trim(cnst_name(ichem))//'WET_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from wet removable in ECPP' ) + call addfld(trim(cnst_name(ichem))//'WRESU_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from resuspension in wet removable in ECPP') + call addfld(trim(cnst_name(ichem))//'CONV_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name(ichem))//' tendency from convective tansport in ECPP') + + call addfld(trim(cnst_name(ichem))//'SFEP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFACHEM_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFRENM_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFACT_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFWET_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFWRESU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP' ) + call addfld(trim(cnst_name(ichem))//'SFCONV_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP' ) + +! Quiescent class + call addfld(trim(cnst_name(ichem))//'SFACHQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (quiescent)' ) + call addfld(trim(cnst_name(ichem))//'SFREMQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (quiescent)' ) + call addfld(trim(cnst_name(ichem))//'SFACTQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (quiescent)' ) + call addfld(trim(cnst_name(ichem))//'SFWETQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (quiescent)' ) + call addfld(trim(cnst_name(ichem))//'SFRESQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (quiescent)' ) + call addfld(trim(cnst_name(ichem))//'SFCONQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (quiescent)' ) + +! Updraft class + call addfld(trim(cnst_name(ichem))//'SFACHUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (updraft)' ) + call addfld(trim(cnst_name(ichem))//'SFREMUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (updraft)' ) + call addfld(trim(cnst_name(ichem))//'SFACTUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (updraft)' ) + call addfld(trim(cnst_name(ichem))//'SFWETUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (updraft)' ) + call addfld(trim(cnst_name(ichem))//'SFRESUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (updraft)') + call addfld(trim(cnst_name(ichem))//'SFCONUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (updraft)' ) + +! Downdraft class + call addfld(trim(cnst_name(ichem))//'SFACHDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (downdraft)' ) + call addfld(trim(cnst_name(ichem))//'SFREMDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (downdraft)' ) + call addfld(trim(cnst_name(ichem))//'SFACTDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (downdraft)' ) + call addfld(trim(cnst_name(ichem))//'SFWETDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (downdraft)' ) + call addfld(trim(cnst_name(ichem))//'SFRESDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (downdraft)' ) + call addfld(trim(cnst_name(ichem))//'SFCONDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (downdraft)' ) + endif + + end do + do ichem=param_first_ecpp, pcnst + if(.not. (cnst_name_cw(ichem) == ' ')) then + call addfld(trim(cnst_name_cw(ichem))//'EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'ACHEM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from aqueous chemistry in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'RENM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from renaming in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'ACT_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from activation/resuspension in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'WET_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from wet removable in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'WRESU_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from resuspension in wet removable in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'CONV_EP', (/ 'lev' /), 'A', 'kg/kg/s', & + trim(cnst_name_cw(ichem))//' tendency from convective tansport in ECPP' ) + + call addfld(trim(cnst_name_cw(ichem))//'SFEP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFACHEM_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFRENM_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming chemistry in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFACT_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFWET_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFWRESU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from resuspension in wet removable in ECPP' ) + call addfld(trim(cnst_name_cw(ichem))//'SFCONV_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP' ) + +! Quiescent class + call addfld(trim(cnst_name_cw(ichem))//'SFACHQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (quiescent)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFREMQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (quiescent)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFACTQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (quiescent)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFWETQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (quiescent)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFRESQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (quiescent)') + call addfld(trim(cnst_name_cw(ichem))//'SFCONQU_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (quiescent)' ) + +! Updraft class + call addfld(trim(cnst_name_cw(ichem))//'SFACHUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (updraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFREMUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (updraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFACTUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (updraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFWETUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (updraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFRESUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (updraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFCONUP_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (updraft)' ) + +! Downdraft class + call addfld(trim(cnst_name_cw(ichem))//'SFACHDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (downdraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFREMDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (downdraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFACTDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (downdraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFWETDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (downdraft)' ) + call addfld(trim(cnst_name_cw(ichem))//'SFRESDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (downdraft)') + call addfld(trim(cnst_name_cw(ichem))//'SFCONDN_EP', horiz_only, 'A', 'kg/m2/s', & + trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (downdraft)' ) + + end if + end do + + call addfld('AQSO4_H2O2_EP', horiz_only, 'A', 'kg/m2/s', 'SO4 aqueous phase chemistry due to H2O2 (kg/m2/s) in ECPP' ) + call addfld('AQSO4_O3_EP', horiz_only, 'A', 'kg/m2/s', 'SO4 aqueous phase chemistry due to O3 (kg/m2/s) in ECPP' ) + call addfld('XPH_LWC_EP', (/ 'lev' /), 'A', ' ', 'pH value multiplied by lwc in ECPP') + + if(history_aerosol) then + call add_default('AQSO4_H2O2_EP', 1, ' ') + call add_default('AQSO4_O3_EP', 1, ' ') + call add_default('XPH_LWC_EP', 1, ' ') + end if + + if(history_aerosol) then + do ichem=param_first_ecpp, pcnst + if(.not. (cnst_name_cw(ichem) == ' ')) then + call add_default(trim(cnst_name_cw(ichem))//'SFEP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFACHEM_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFRENM_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFACT_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFWET_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFWRESU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFCONV_EP', 1, ' ') + + call add_default(trim(cnst_name_cw(ichem))//'SFACHQU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFREMQU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFACTQU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFWETQU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFRESQU_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFCONQU_EP', 1, ' ') + + call add_default(trim(cnst_name_cw(ichem))//'SFACHUP_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFREMUP_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFACTUP_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFWETUP_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFRESUP_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFCONUP_EP', 1, ' ') + + call add_default(trim(cnst_name_cw(ichem))//'SFACHDN_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFREMDN_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFACTDN_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFWETDN_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFRESDN_EP', 1, ' ') + call add_default(trim(cnst_name_cw(ichem))//'SFCONDN_EP', 1, ' ') + end if + + if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(ichem) == cnst_spec_class_gas )) then + call add_default(trim(cnst_name(ichem))//'SFEP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFACHEM_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFRENM_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFACT_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFWET_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFWRESU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFCONV_EP', 1, ' ') + + call add_default(trim(cnst_name(ichem))//'SFACHQU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFREMQU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFACTQU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFWETQU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFRESQU_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFCONQU_EP', 1, ' ') + + call add_default(trim(cnst_name(ichem))//'SFACHUP_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFREMUP_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFACTUP_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFWETUP_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFRESUP_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFCONUP_EP', 1, ' ') + + call add_default(trim(cnst_name(ichem))//'SFACHDN_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFREMDN_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFACTDN_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFWETDN_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFRESDN_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'SFCONDN_EP', 1, ' ') + end if + + end do + +! for test purpose, additional 3D tendency + do ichem=param_first_ecpp, pcnst + if(trim(cnst_name(ichem)) == 'DMS' .or. trim(cnst_name(ichem)) == 'SO2' .or. & + trim(cnst_name(ichem)) == 'so4_a1') then + call add_default(trim(cnst_name(ichem))//'EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'ACHEM_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'RENM_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'ACT_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'WET_EP', 1, ' ') + call add_default(trim(cnst_name(ichem))//'CONV_EP', 1, ' ') + end if + end do + end if ! end history_aerosol + + end subroutine papampollu_init +!================================================================================================== + +!-------------------------------------------------------------------------------------------------- + subroutine parampollu_driver2( & + state, ptend, pbuf, & + dtstep_in, dtstep_pp_in, & + acen_3d, abnd_3d, & + acen_tf_3d, abnd_tf_3d, & + massflxbnd_3d, & + rhcen_3d, qcloudcen_3d, qlsinkcen_3d, & + precrcen_3d, precsolidcen_3d, & + acldy_cen_tbeg_3d & + ) + +! modules from CAM + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field + use physconst, only: gravit + use time_manager, only: get_nstep, is_first_step + use constituents, only: cnst_name + use cam_history, only: outfld +#ifdef MODAL_AERO + use modal_aero_data, only: ntot_amode, cnst_name_cw, qqcw_get_field +#endif + +! modules from ECPP + use module_ecpp_td2clm, only: parampollu_td240clm + + implicit none + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_driver2 is the interface between wrf-chem and the +! parameterized pollutants "1 column" routine +! +! main inputs are +! aerosol and trace gas mixing ratios for a subset of the +! host-code domain +! ecpp (sub-grid) cloud statistics for the same subset of domain +! main outputs are +! updated aerosol and trace gas mixing ratios, with changes due +! to sub-grid vertical transport, activation/resuspension, +! cloud chemistry, and wet removal +! +!----------------------------------------------------------------------- + +! subr arguments + + real(r8), intent(in) :: dtstep_in, dtstep_pp_in +! dtstep_in - main model time step (s) +! dtstep_pp_in - time step (s) for "parameterized pollutants" calculations + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! individual parameterization + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + real(r8), intent(in), dimension( pcols, pverp, 1:ncc_in, 1:ncls_ecpp_in, 1:nprcp_in ) :: & + abnd_3d, abnd_tf_3d, massflxbnd_3d + real(r8), intent(in), dimension( pcols, pver, 1:ncc_in, 1:ncls_ecpp_in, 1:nprcp_in ) :: & + acen_3d, acen_tf_3d, rhcen_3d, & + qcloudcen_3d, qlsinkcen_3d, precrcen_3d, precsolidcen_3d +! *** note - these are not "3d" now but probably will be in the mmf code +! abnd_3d and abnd_tf_3d - sub-class fractional area (--) at layer bottom boundary +! abnd_3d is average for full time period (=dtstep_pp_in) +! abnd_tf_3d is average for end-portion of time period +! acen_3d and acen_tf_3d - sub-class fractional area (--) at layer center +! acen_3d is average for full time period (=dtstep_pp_in) +! acen_tf_3d is average for end-portion of time period +! massflxbnd_3d - sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. +! *** note - These are calculated using wfull, not wprime. +! rhcen_3d - relative humidity (0-1) at layer center +! qcloudcen_3d - cloud water mixing ratio (kg/kg) at layer center +! qlsinkcen_3d - cloud-water first-order loss rate to precipitation (/s) at layer center +! precrcen_3d - liquid (rain) precipitation rate (kg/m2/s) at layer center +! precsolidcen_3d - solid (snow,graupel,...) precipitation rate (kg/m2/s) at layer center + + real(r8), intent(inout), dimension( pcols, pver) :: acldy_cen_tbeg_3d +! acldy_cen_tbeg_3d = total (all sub-classes) cloudy fractional area +! on input, = value from end of the previous time step +! on output, = value from end of the current time step + +!----------------------------------------------------------------------- +! local variables + integer :: ncol, lchnk + integer :: mbuf + integer :: id + integer :: i, icc, ipass, ipp, itmpa, it, ichem, ichem2 + integer :: j, jclrcld, jcls, jclsaa, jclsbb, jt + integer :: nstep, nstep_pp + integer :: k, ka, kb, lk + integer :: l, ll, levdbg_err, levdbg_info + integer :: lun, lun60, lun61, lun131, lun132, lun133, lun134, lun135 + integer :: n, ncls_ecpp, nupdraft, ndndraft + integer :: itmpcnt(pver+1,4) + integer :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + integer, dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp + + real(r8) :: dtstep, dtstep_pp + real(r8) :: tmpa, tmpb, tmpc, tmpd + real(r8) :: za, zb, zc + + integer, dimension( 1:nupdraft_in ) :: & + kupdraftbase, kupdrafttop + integer, dimension( 1:ndndraft_in ) :: & + kdndraftbase, kdndrafttop +! kupdraftbase, kupdrafttop - lower-most and upper-most level for each updraft class +! *** note1- these refer to layer centers, not layer boundaries. Thus +! acen > 0 for kupdraftbase:kupdrafttop and = 0 at other k +! abnd > 0 for kupdraftbase+1:kupdrafttop and = 0 at other k +! massflxbnd > 0 for kupdraftbase+1:kupdrafttop and = 0 at other k +! kdndraftbase, kdndrafttop - lower-most and upper-most level for each downdraft class +! *** note2- these get checked/adjusted later, so simply setting k--draftbase = kts +! and k--drafttop = ktecen is OK + + real(r8) :: tcen_bar (pver) ! temperature at layer centers (K) + real(r8) :: pcen_bar (pver) ! pressure at layer centers (K) + real(r8) :: rhocen_bar (pver) ! air density at layer centers (kg/m3) + real(r8) :: dzcen (pver) ! layer depth (m) + real(r8) :: wcen_bar (pver) ! vertical velocity at layer centers (m/s) + real(r8) :: rhobnd_bar (pverp) ! air density at layer boundaries (kg/m3) + real(r8) :: zbnd (pverp) ! elevation at layer boundaries (m) ???elevation or height???? + real(r8) :: wbnd_bar (pverp) ! vertical velocity at layer boundaries (m/s) + + real(r8) :: chem_bar (pver, 1:num_chem_ecpp) ! mixing ratios of trace gase (ppm) and aerosol species + ! (ug/kg for mass species, #/kg for number species) +#ifdef MODAL_AERO +! real(r8), pointer, dimension(:, :, :) :: qqcw ! cloud-borne aerosol + type(ptr2d_t) :: qqcw(pcnst) +! real(r8) :: qqcwold(pcols, pver, pcnst) +#endif + real(r8), dimension( pverp, 0:2, 0:maxcls_ecpp ) :: & + abnd_tavg, abnd_tfin, mfbnd + real(r8), dimension( pver, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg, acen_tfin, acen_tbeg, acen_prec + real(r8), dimension( pver, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 + real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem, & ! tendency of chem_sub from aqueous chemistry + del_rename, & ! tendency of chem_sub from renaming. + del_wetscav, & ! tendency of chem_sub from wet deposition + del_wetresu + + real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate, & ! tendency of chem_sub from activation/resuspension + del_conv ! tendency of chem_sub from convective transport + + real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem3d, & ! tendency of chem_sub from aqueous chemistry + del_rename3d, & ! tendency of chem_sub from renaming. + del_wetscav3d, & ! tendency of chem_sub from wet deposition + del_wetresu3d ! tendency of chem_sub from resuspension in wet deposition + + real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3d, & ! tendency of chem_sub from activation/resuspension + del_conv3d ! tendency of chem_sub from convective transport + + real(r8), dimension(pcols) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2/s) + aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2/s) + + real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:2) :: xphlwc ! pH value multiplied by lwc + real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:2) :: xphlwc3d + real(r8), dimension(pcols, pver) :: xphlwc_gcm + + + real(r8), dimension(pcols, pver, 1:num_chem_ecpp) :: & + ptend_cldchem, ptend_rename, ptend_wetscav, ptend_wetresu, ptend_activate, ptend_conv ! tendency at GCM grids + + real(r8), dimension(pcols, pver, 1:maxcls_ecpp, 1:num_chem_ecpp) :: & + ptend_activate_cls, & ! activation tendency for sub transport class + ptend_cldchem_cls, & ! aqueous chemistry + ptend_rename_cls, & ! renaming + ptend_wetscav_cls, & ! wet deposition + ptend_wetresu_cls, & ! resuspension + ptend_conv_cls ! convective transport + + real(r8), dimension(pcols, 1:maxcls_ecpp, 1:num_chem_ecpp) :: & + ptend_activate_cls_col, & ! column-integrated activation tendency for sub transport class + ptend_cldchem_cls_col, & ! aqueous chemistry + ptend_rename_cls_col, & ! renaming + ptend_wetscav_cls_col, & ! wet deposition + ptend_wetresu_cls_col, & ! resuspension + ptend_conv_cls_col ! convective transport + + + real(r8), dimension(pcols, 1:num_chem_ecpp) :: & + ptend_cldchem_col, ptend_rename_col, ptend_wetscav_col, ptend_wetresu_col, ptend_activate_col, ptend_conv_col, & + ptendq_col ! column-integrated tendency + + real(r8), dimension(pcols, pver, 1:pcnst) :: ptend_qqcw ! tendency for cloud-borne aerosols + + real(r8), dimension(pcols, 1:num_chem_ecpp) :: del_chem_col_cldchem, del_chem_col_rename, del_chem_col_wetscav ! column tendency calcuated in ECPP + + character(len=100) :: msg + logical :: lq(pcnst) + +!----------------------------------------------------------------------- +! set flags that turn diagnostic output on/off +! +! for a specific output to be "on", both the +! idiagaa_ecpp(--) and ldiagaa_ecpp(--) be positive +! the ldiagaa_ecpp(--) is the output unit number +! +! 60 - from subr parampollu_driver2 +! short messages on entry and exit +! 61 - from subr parampollu_driver2 +! "rcetestpp diagnostics" block +! 62 - from subr parampollu_td240clm +! short messages on entry and exit, and showing sub-time-step +! 63 - from subr parampollu_check_adjust_inputs +! shows some summary statistics about the check/adjust process +! 115, 116, 117 - from subr parampollu_1clm_dumpaa +! shows various statistics on transport class and subarea +! fractional areas and mass fluxes +! 116 is before call to parampollu_check_adjust_inputs +! 117 is after 1st call to parampollu_check_adjust_inputs +! 115 is after 2nd call to parampollu_check_adjust_inputs +! 118 - from subr parampollu_tdx_main_integ and parampollu_tdx_area_change +! diagnostics involving changes to species 9 in those subrs +! 119 - from subr parampollu_tdx_cleanup +! diagnostics involving changes to species 9 in that subr +! 121 - from subr parampollu_tdx_cleanup +! diagnostics involving mass conservation +! 122 - from subr parampollu_tdx_entdet_sub1 and parampollu_tdx_entdet_diag01 +! diagnostics involving entrainment/detrainment and area changes +! 123 - from subr parampollu_tdx_entdet_sub1 +! diagnostics involving entrainment/detrainment and area changes +! 124 - from subr parampollu_tdx_main_integ +! diagnostics involving sub-time-step for "main integration", +! related to stability and courant number +! 125 - from subr parampollu_tdx_activate_intface +! diagnostics involving aerosol activation and associated vertical velocities +! 131-135 - from subr parampollu_driver2 +! shows various statistics on transport class and subarea +! fractional areas and mass fluxes +! 141-143 - from subr parampollu_tdx_wetscav_2 +! diagnostics for the "new" wetscav code designed for the mmf-with-ecpp +! 155 - from subr parampollu_check_adjust_inputs +! shows "history" of acen_tavg_use thru the check/adjust process +! 161, 162, 164 - from subr parampollu_tdx_startup & parampollu_tdx_partition_acw +! involves partitioning of cloudborne/interstitial aerosol between clear +! and cloudy subareas + +! + idiagaa_ecpp(:) = 0 +! idiagaa_ecpp(60:63) = 1 + idiagaa_ecpp(60:63) = -1 + idiagaa_ecpp(115:119) = 1 ; idiagaa_ecpp(118) = 111 + idiagaa_ecpp(121:125) = 1 + idiagaa_ecpp(131:135) = 1 + idiagaa_ecpp(141:143) = 1 + + idiagaa_ecpp(155) = 1 + idiagaa_ecpp(161) = 1 ; idiagaa_ecpp(162) = 1 ; idiagaa_ecpp(164) = 1 + + idiagaa_ecpp(131:135) = -1 ! not output in the MMF model + idiagaa_ecpp(115:117) = -1 ! not dump the original field in parampollu_td240clm + idiagaa_ecpp(118:119) = -1 + idiagaa_ecpp(121:125) = -1 + idiagaa_ecpp(141:143) = -1 + idiagaa_ecpp(165:167) = -1 + idiagaa_ecpp(164) = -1 + idiagaa_ecpp(161) = -1 + idiagaa_ecpp(162) = -1 + + idiagaa_ecpp(121) = -1 + + do i = 1, 199 + ldiagaa_ecpp(i) = i + end do + ldiagaa_ecpp(60:69) = 6 + ldiagaa_ecpp(62) = 62 + +!----------------------------------------------------------------------- + + lun60 = -1 + if (idiagaa_ecpp(60) > 0) lun60 = ldiagaa_ecpp(60) + lun61 = -1 + if (idiagaa_ecpp(61) > 0) lun61 = ldiagaa_ecpp(61) + lun131 = -1 + if (idiagaa_ecpp(131) > 0) lun131 = ldiagaa_ecpp(131) + lun132 = -1 + if (idiagaa_ecpp(132) > 0) lun132 = ldiagaa_ecpp(132) + lun133 = -1 + if (idiagaa_ecpp(133) > 0) lun133 = ldiagaa_ecpp(133) + lun134 = -1 + if (idiagaa_ecpp(134) > 0) lun134 = ldiagaa_ecpp(134) + lun135 = -1 + if (idiagaa_ecpp(135) > 0) lun135 = ldiagaa_ecpp(135) + + + ncol = state%ncol + lchnk = state%lchnk + + lq(:) = .false. + do ichem=param_first_ecpp, pcnst + if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(ichem) == cnst_spec_class_gas )) then + lq(ichem)=.true. + end if + end do + call physics_ptend_init(ptend, state%psetcols,'ecpp',lq=lq) + ptend%q(:,:,:) = 0.0_r8 + + dtstep = dtstep_in + dtstep_pp = dtstep_pp_in + +!rcetestpp diagnostics -------------------------------------------------- + if (lun61 > 0) then + write(lun61,93010) ' ' + write(lun61,93010) 'rcetestpp diagnostics from parampollu_driver2' + write(lun61,93020) 'dtstep, dtstep_pp ', & + dtstep, dtstep_pp +93010 format( a, 8(1x,i6) ) +93020 format( a, 8(1p,e14.6) ) + end if ! (lun61 > 0) +!rcetestpp diagnostics -------------------------------------------------- + + if (num_chem_ecpptmp < num_chem_ecpp) then + msg = '*** parampollu_driver -- bad num_chem_ecpptmp' + call endrun(msg) + end if + +! check for valid ncls_ecpptmp + nupdraft = nupdraft_in + ndndraft = ndndraft_in + ncls_ecpp = (nupdraft + ndndraft + 1) + if (ncls_ecpp > maxcls_ecpp) then + write(msg,'(a,2(1x,i6))') & + '*** parampollu_driver - ncls_ecpp > maxcls_ecpp, values =', & + ncls_ecpp, maxcls_ecpp + call endrun( msg ) + end if + if (ncls_ecpp /= ncls_ecpp_in) then + write(msg,'(a,2(1x,i8))') & + '*** parampollu_driver -- bad ncls_ecpp_in', & + ncls_ecpp_in, ncls_ecpp + call endrun( msg ) + end if + +! on very first time step, initialize acldy_cen_tbeg +! +! *** this code should probably go into parampollu_init0 (or somewhere else) + nstep = get_nstep() + nstep_pp = nstep + if (is_first_step()) then + acldy_cen_tbeg_3d(:,:) = 0.0_r8 + + do k = 1, pver + do i = 1, ncol + tmpa = 0.0_r8 ; tmpb = 0.0_r8 + do ipp = 1, nprcp_in + do jcls = 1, ncls_ecpp + tmpa = tmpa + max( 0.0_r8, acen_3d(i,k,1,jcls,ipp) ) + tmpb = tmpb + max( 0.0_r8, acen_3d(i,k,2,jcls,ipp) ) + end do + end do + + if (abs(tmpa+tmpb-1.0_r8) > 1.0e-3_r8) then + write(msg,'(a,3i5,1pe15.7)') & + '*** parampollu_driver -- bad acen_tbeg - i,j,k,acen', & + i, j, k, (tmpa+tmpb) + call endrun(msg) + end if + tmpa = tmpa/(tmpa+tmpb) + + tmpa = 1.0_r8 ! force to initially clear -- might want to change this + +! when iflag_ecpp_test_fixed_fcloud = 2/3/4/5, force acen_tbeg 100%/0%/70%/30% clear + if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & + (iflag_ecpp_test_fixed_fcloud <= 5)) then + if (iflag_ecpp_test_fixed_fcloud == 2) then + tmpa = 1.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 3) then + tmpa = 0.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 4) then + tmpa = 0.7_r8 + else + tmpa = 0.3_r8 + end if + end if + + acldy_cen_tbeg_3d(i,k) = 1.0_r8 - tmpa + end do + end do + end if + + +! set some variables to their wrf-chem "standard" values + levdbg_err = 0 + levdbg_info = 15 + +#ifdef MODAL_AERO +! mbuf = pbuf_get_fld_idx( 'QQCW' ) +! if ( associated(pbuf(mbuf)%fld_ptr) ) then +! qqcw => pbuf(mbuf)%fld_ptr( 1, 1:pcols, 1:pver, lchnk, 1:pcnst ) +! else +! call endrun( 'pbuf for QQCW not allocated in aerosol_wet_intr' ) +! end if +!+++mhwang 2012-02-22 +! qqcw_get_field is no longer used in ndrop.F90. Make sure +! it is still valid !!!! + do i=1,pcnst + qqcw(i)%fldcw => qqcw_get_field(pbuf, i,lchnk,.true.) + end do +#endif + +! loop over columns + do 2910 i = 1, ncol +! +! load column arrays +! + zbnd(1) = 0.0_r8 + wbnd_bar(1) = 0.0_r8 + do k=pver, 1, -1 + tcen_bar(pver-k+1) = state%t(i,k) + pcen_bar(pver-k+1) = state%pmid(i,k) + +! dry air density is calcualted, because tracer mixing ratios are defined with respect to dry air in CAM. + rhocen_bar(pver-k+1) = state%pmiddry(i,k)/(287.0_r8*state%t(i,k)) + + wbnd_bar(pver-k+2) = -1*state%omega(i,k)/(rhocen_bar(pver-k+1)*gravit) + +! pressure vertical velocity (Pa/s) to height vertical velocity (m/s) + dzcen(pver-k+1) = state%pdeldry(i,k)/gravit/rhocen_bar(pver-k+1) + + zbnd(pver-k+2) = zbnd(pver-k+1) + dzcen(pver-k+1) + end do + + do k = 1, pver+1 + ka = max( 1, min(pver-1, k-1 ) ) + kb = ka + 1 + za = 0.5_r8*(zbnd(ka) + zbnd(ka+1)) + zb = 0.5_r8*(zbnd(kb) + zbnd(kb+1)) + rhobnd_bar(k) = rhocen_bar(ka) & + + (rhocen_bar(kb)-rhocen_bar(ka))*(zbnd(k)-za)/(zb-za) + end do + + chem_bar(:,:) = 0.0_r8 +! Load chem + do k=pver, 1, -1 + do ichem = 1, num_chem_ecpp + if(ichem.le.pcnst) then + chem_bar(pver-k+1, ichem) = state%q(i, k, ichem) +#ifdef MODAL_AERO + else +! chem_bar(pver-k+1, ichem) = qqcw(i, k, ichem-pcnst) + if(associated(qqcw(ichem-pcnst)%fldcw)) then + chem_bar(pver-k+1, ichem) = qqcw(ichem-pcnst)%fldcw(i, k) + else + chem_bar(pver-k+1, ichem) = 0.0_r8 + end if +#endif + end if + end do + end do + +! +! load transport-class arrays +! + +! load other/quiescent + jcls = 1 + + kupdraftbase = 1 + kupdrafttop = pver + kdndraftbase = 1 + kdndrafttop = pver + + kdraft_bot_ecpp( 1:2,jcls) = 1 + kdraft_top_ecpp( 1:2,jcls) = pver + mtype_updnenv_ecpp(1:2,jcls) = mtype_quiescn_ecpp + +! load updrafts + do n = 1, nupdraft + jcls = jcls + 1 + + kdraft_bot_ecpp( 1:2,jcls) = max( kupdraftbase(n), 1 ) + kdraft_top_ecpp( 1:2,jcls) = min( kupdrafttop(n), pver ) + mtype_updnenv_ecpp(1:2,jcls) = mtype_updraft_ecpp + end do + +! load downdrafts + do n = 1, ndndraft + jcls = jcls + 1 + + kdraft_bot_ecpp( 1:2,jcls) = max( kdndraftbase(n), 1 ) + kdraft_top_ecpp( 1:2,jcls) = min( kdndrafttop(n), pver ) + mtype_updnenv_ecpp(1:2,jcls) = mtype_dndraft_ecpp + end do + +! load mfbnd and "area" arrays for all classes + mfbnd( :,:,:) = 0.0_r8 + abnd_tavg(:,:,:) = 0.0_r8 + abnd_tfin(:,:,:) = 0.0_r8 + acen_tavg(:,:,:) = 0.0_r8 + acen_tfin(:,:,:) = 0.0_r8 + + do jcls = 1, ncls_ecpp + do icc = 1, 2 + do k = 1, pver+1 + lk=pver+1-k+1 + mfbnd( lk,icc,jcls) = massflxbnd_3d(i, k,icc,jcls,1) & + + massflxbnd_3d(i, k,icc,jcls,2) + abnd_tavg(lk,icc,jcls) = abnd_3d(i, k,icc,jcls,1) & + + abnd_3d(i, k,icc,jcls,2) + abnd_tfin(lk,icc,jcls) = abnd_tf_3d(i, k,icc,jcls,1) & + + abnd_tf_3d(i, k,icc,jcls,2) + end do ! k + end do ! icc + end do ! jcls + +! load these arrays + acen_prec( :,:,: ) = 0.0_r8 + qcloud_sub2(:,:,:,:) = 0.0_r8 + qlsink_sub2(:,:,:,:) = 0.0_r8 + precr_sub2( :,:,:,:) = 0.0_r8 + precs_sub2( :,:,:,:) = 0.0_r8 + rh_sub2( :,:,:,:) = 0.0_r8 + do k=1, pver + lk=pver-k+1 + acen_tavg( lk,1:2,1:ncls_ecpp ) = acen_3d(i, k,1:2,1:ncls_ecpp,1)+ & + acen_3d(i, k,1:2,1:ncls_ecpp,2) + acen_tfin( lk,1:2,1:ncls_ecpp ) = acen_tf_3d(i, k,1:2,1:ncls_ecpp,1)+ & + acen_tf_3d(i, k,1:2,1:ncls_ecpp,2) + acen_prec( lk,1:2,1:ncls_ecpp ) = acen_3d(i, k,1:2,1:ncls_ecpp,2) + qcloud_sub2(lk,1:2,1:ncls_ecpp,1:2) = qcloudcen_3d(i, k,1:2,1:ncls_ecpp,1:2) + qlsink_sub2(lk,1:2,1:ncls_ecpp,1:2) = qlsinkcen_3d(i, k,1:2,1:ncls_ecpp,1:2) + precr_sub2( lk,1:2,1:ncls_ecpp,1:2) = precrcen_3d(i, k,1:2,1:ncls_ecpp,1:2) + precs_sub2( lk,1:2,1:ncls_ecpp,1:2) = precsolidcen_3d(i, k,1:2,1:ncls_ecpp,1:2) + rh_sub2( lk,1:2,1:ncls_ecpp,1:2) = rhcen_3d(i, k,1:2,1:ncls_ecpp,1:2) + if( sum(acen_tfin( lk,1:2,jcls_qu)).lt.0.05_r8) then + write(0, *) 'test acen_tfin < 0.40', sum(acen_tfin( lk,1:2,jcls_qu)), pcen_bar(lk), i,lk !+++mhwang + end if + end do + +! force kdraft_top > kdraft_bot +! (note: need to change the wrf3d post-processor so this is not needed) + do jcls = 1, ncls_ecpp + do jclrcld = 1, 2 + kdraft_top_ecpp(jclrcld,jcls) = max( kdraft_top_ecpp(jclrcld,jcls), & + kdraft_bot_ecpp(jclrcld,jcls)+1 ) + if (kdraft_top_ecpp(jclrcld,jcls) .gt. pver) then + kdraft_top_ecpp(jclrcld,jcls) = pver + kdraft_bot_ecpp(jclrcld,jcls) = pver-1 + end if + end do + end do + +! load acen_tbeg from 3d saved values + acen_tbeg(:,:,:) = 0.0_r8 + jcls = 1 + do k=1, pver + lk=pver-k+1 + acen_tbeg(lk,2,jcls) = acldy_cen_tbeg_3d(i,k) + acen_tbeg(lk,1,jcls) = 1.0_r8 - acen_tbeg(lk,2,jcls) + end do + +! start of temporary diagnostics ------------------------------ + do ipass = 1, 3 + + do ll = 131, 133 + lun = -1 + if (ll == 131) lun = lun131 + if (ll == 132) lun = lun132 + if (ll == 133) lun = lun133 + if (lun <= 0) cycle + + write(lun,*) + if (ipass .eq. 1) then + n = nupdraft + write(lun,'(a,3i5)') 'updrafts, nup, ktau', n, nstep, nstep_pp + else if (ipass .eq. 2) then + n = ndndraft + write(lun,'(a,3i5)') 'dndrafts, nup, ktau', n, nstep, nstep_pp + else + n = ncls_ecpp + write(lun,'(a,3i5)') 'quiescents, ncls_ecpp, ktau', n, nstep, nstep_pp + end if + end do + + do ka = (2*((pver+1)/2)-1), 1, -2 + tmpa = 0.0_r8 + tmpb = 0.0_r8 + tmpc = 0.0_r8 + tmpd = 0.0_r8 + kb = ka+1 +! kb = ka + + if (ipass .eq. 1) then + jclsaa = 1 + 1 + jclsbb = 1 + nupdraft + else if (ipass .eq. 2) then + jclsaa = 1 + nupdraft + 1 + jclsbb = 1 + nupdraft + ndndraft + else + jclsaa = 1 + jclsbb = 1 + end if + do ipp = 1, 2 + do jcls = jclsaa, jclsbb + tmpa = tmpa + abnd_3d(i,ka,1,jcls,ipp) + abnd_3d(i,kb,1,jcls,ipp) + tmpb = tmpb + abnd_3d(i,ka,2,jcls,ipp) + abnd_3d(i,kb,2,jcls,ipp) + tmpc = tmpc + massflxbnd_3d(i,ka,1,jcls,ipp) + massflxbnd_3d(i,kb,1,jcls,ipp) + tmpd = tmpd + massflxbnd_3d(i,ka,2,jcls,ipp) + massflxbnd_3d(i,kb,2,jcls,ipp) + end do + end do + + tmpa = tmpa*0.5_r8 ; tmpb = tmpb*0.5_r8 ; + tmpc = tmpc*0.5_r8 ; tmpd = tmpd*0.5_r8 + if (lun131 > 0) & + write(lun131,'(i3,2(3x,1p,3e10.2))') ka, & + tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) + + tmpa = tmpa*100.0_r8 ; tmpb = tmpb*100.0_r8 + tmpc = tmpc*100.0_r8 ; tmpd = tmpd*100.0_r8 + if (lun132 > 0) & + write(lun132,'(i3,2(2x, 3f8.3))') ka, & + tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) + + if (lun133 > 0) & + write(lun133,'(i3,2(2x, 3f7.2))') ka, & + tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) + end do ! ka + end do ! ipass + + + if (lun134 > 0) then + do n = 1, nupdraft + write(lun134,'(/a,5i5)') 'updraft -- n, kbase, ktop, ktaus', & + n, kupdraftbase(n), kupdrafttop(n), nstep, nstep_pp + do k = pver+1, 1, -1 + jcls = 1 + n + write(lun134,'(i3,2(2x,2f10.5))') k, & + sum(abnd_3d(i,k,1,jcls,1:2))*100.0_r8, sum(abnd_3d(i,k,2,jcls,1:2))*100.0_r8, & + sum(massflxbnd_3d(i,k,1,jcls,1:2))*100.0_r8, & + sum(massflxbnd_3d(i,k,2,jcls,1:2))*100.0_r8 + end do + end do + + do n = 1, ndndraft + write(lun134,'(/a,5i5)') 'dndraft -- n, kbase, ktop, ktaus', & + n, kdndraftbase(n), kdndrafttop(n), nstep, nstep_pp + do k = pver+1, 1, -1 + jcls = 1 + nupdraft + n + write(lun134,'(i3,2(2x,2f10.5))') k, & + sum(abnd_3d(i,k,1,jcls,1:2))*100.0_r8, sum(abnd_3d(i,k,2,jcls,1:2))*100.0_r8, & + sum(massflxbnd_3d(i,k,1,jcls,1:2))*100.0_r8, & + sum(massflxbnd_3d(i,k,2,jcls,1:2))*100.0_r8 + end do + end do + end if ! (lun134 > 0) + + + if (lun135 > 0) then + itmpcnt(:,:) = 0 + do n = 1, nupdraft + write(lun135,'(/a,5i5)') 'updraft -- n, kbase, ktop, ktaus', & + n, kupdraftbase(n), kupdrafttop(n), nstep, nstep_pp + do k = pver+1, 1, -1 + jcls = 1 + n + tmpa = sum(abnd_3d(i,k,1,jcls,1:2)) + tmpb = sum(abnd_3d(i,k,2,jcls,1:2)) + tmpc = sum(massflxbnd_3d(i,k,1,jcls,1:2)) + tmpd = sum(massflxbnd_3d(i,k,2,jcls,1:2)) + write(lun135,'(i3,2(2x,1p,2e10.2))') k, tmpa, tmpb, tmpc, tmpd + if (tmpa .gt. 0.0_r8) itmpcnt(k,1) = itmpcnt(k,1) + 1 + if (tmpb .gt. 0.0_r8) itmpcnt(k,2) = itmpcnt(k,2) + 1 + if (tmpc .gt. 0.0_r8) itmpcnt(k,3) = itmpcnt(k,3) + 1 + if (tmpd .gt. 0.0_r8) itmpcnt(k,4) = itmpcnt(k,4) + 1 + end do + end do + write(lun135,'(/a,5i5)') 'updraft non-zero counts -- ktaus', & + nstep, nstep_pp + do k = pver+1, 1, -1 + write(lun135,'(i3,2(5x,2i5))') k, itmpcnt(k,1:4) + end do + + itmpcnt(:,:) = 0 + do n = 1, ndndraft + write(lun135,'(/a,5i5)') 'dndraft -- n, kbase, ktop, ktaus', & + n, kdndraftbase(n), kdndrafttop(n), nstep, nstep_pp + do k = pver+1, 1, -1 + jcls = 1 + nupdraft + n + tmpa = sum(abnd_3d(i,k,1,jcls,1:2)) + tmpb = sum(abnd_3d(i,k,2,jcls,1:2)) + tmpc = sum(massflxbnd_3d(i,k,1,jcls,1:2)) + tmpd = sum(massflxbnd_3d(i,k,2,jcls,1:2)) + write(lun135,'(i3,2(2x,1p,2e10.2))') k, tmpa, tmpb, tmpc, tmpd + if (tmpa .gt. 0.0_r8) itmpcnt(k,1) = itmpcnt(k,1) + 1 + if (tmpb .gt. 0.0_r8) itmpcnt(k,2) = itmpcnt(k,2) + 1 + if (tmpc .lt. 0.0_r8) itmpcnt(k,3) = itmpcnt(k,3) + 1 + if (tmpd .lt. 0.0_r8) itmpcnt(k,4) = itmpcnt(k,4) + 1 + end do + end do + write(lun135,'(/a,5i5)') 'dndraft non-zero counts -- ktaus', & + nstep, nstep_pp + do k = pver+1, 1, -1 + write(lun135,'(i3,2(5x,2i5))') k, itmpcnt(k,1:4) + end do + end if ! (lun135 > 0) +! end of temporary diagnostics ------------------------------ + +! +! do parameterized pollutant calculations on current column +! + itmpa = parampollu_opt + + if ((itmpa == 2220) .or. & + (itmpa == 2223)) then + if (lun60 > 0) write(lun60,93010) & + 'calling parampollu_td240clm - i=', i +! write (0, *) i, lchnk, 'before parampollu_td240clm', nstep + call parampollu_td240clm( & + nstep, dtstep, nstep_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd, & + abnd_tavg, acen_tavg, acen_tfin, acen_tbeg, & + acen_prec, rh_sub2, & + qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2, & + del_cldchem, del_rename, & + del_wetscav, del_wetresu, & + del_activate, del_conv, & + del_chem_col_cldchem(i,:), del_chem_col_rename(i, :), del_chem_col_wetscav(i, :), & + aqso4_h2o2(i), aqso4_o3(i), xphlwc, & + i, lchnk, 1,pver+1,pver, pbuf & + ) +! write (0, *) i, lchnk, 'after parampollu_td240clm', nstep + + aqso4_h2o2(i) = aqso4_h2o2(i)/dtstep + aqso4_o3(i) = aqso4_o3(i)/dtstep + + else + end if + + +! +! put selected arrays back into 3d arrays +! + if (itmpa > 0) then + + do k = 1, pver + lk=pver-k+1 + acldy_cen_tbeg_3d(i,k) = sum( acen_tfin(lk,2,1:ncls_ecpp) ) + end do + +! Interstial species + ptend_qqcw(i,:,:) = 0.0_r8 + do k=1, pver + lk=pver-k+1 + do ichem=param_first_ecpp, pcnst + if (ptend%lq(ichem)) then + ptend%q(i,k,ichem)= (chem_bar(lk, ichem)-state%q(i,k,ichem))/dtstep + end if +! ptend_qqcw(i,k,ichem)=(chem_bar(lk, ichem+pcnst)-qqcw(i,k,ichem))/dtstep +! qqcw(i,k,ichem) = chem_bar(lk, ichem+pcnst) + if(associated(qqcw(ichem)%fldcw)) then + ptend_qqcw(i,k,ichem)=(chem_bar(lk, ichem+pcnst)-qqcw(ichem)%fldcw(i,k))/dtstep + qqcw(ichem)%fldcw(i,k) = chem_bar(lk, ichem+pcnst) + else + ptend_qqcw(i,k,ichem)= 0.0_r8 + endif + end do + del_cldchem3d(i,k,:,:,:,:) = del_cldchem(lk,:,:,:,:)/dtstep + del_rename3d(i,k,:,:,:,:) = del_rename(lk,:,:,:,:)/dtstep + del_wetscav3d(i,k,:,:,:,:) = del_wetscav(lk,:,:,:,:)/dtstep + del_wetresu3d(i,k,:,:,:,:) = del_wetresu(lk,:,:,:,:)/dtstep + del_activate3d(i,k,:,:,:) = del_activate(lk,:,:,:)/dtstep + del_conv3d(i,k,:,:,:) = del_conv(lk,:,:,:)/dtstep + xphlwc3d(i,k,:,:,:) = xphlwc(lk,:,:,:) + end do +! cloud borne species + + end if + +2910 continue + + + ptend_cldchem = 0.0_r8 + ptend_rename = 0.0_r8 + ptend_wetscav = 0.0_r8 + ptend_wetresu = 0.0_r8 + ptend_activate=0.0_r8 + ptend_conv = 0.0_r8 + xphlwc_gcm = 0.0_r8 + + ptend_cldchem_cls = 0.0_r8 + ptend_rename_cls = 0.0_r8 + ptend_wetscav_cls = 0.0_r8 + ptend_wetresu_cls = 0.0_r8 + ptend_activate_cls=0.0_r8 + ptend_conv_cls = 0.0_r8 + + ptend_cldchem_col = 0.0_r8 + ptend_rename_col = 0.0_r8 + ptend_wetscav_col = 0.0_r8 + ptend_wetresu_col = 0.0_r8 + ptend_activate_col=0.0_r8 + ptend_conv_col = 0.0_r8 + ptendq_col = 0.0_r8 + + ptend_cldchem_cls_col = 0.0_r8 + ptend_rename_cls_col = 0.0_r8 + ptend_wetscav_cls_col = 0.0_r8 + ptend_wetresu_cls_col = 0.0_r8 + ptend_activate_cls_col=0.0_r8 + ptend_conv_cls_col = 0.0_r8 + + do i=1, ncol + do k=1, pver + do jcls = 1, ncls_ecpp + do icc = 1, 2 +! tendency at GCM grids + do ipp=1, 2 + ptend_cldchem(i,k,:) = ptend_cldchem(i,k,:)+del_cldchem3d(i,k,icc,jcls,ipp,:) + ptend_rename(i,k,:) = ptend_rename(i,k,:)+del_rename3d(i,k,icc,jcls,ipp,:) + ptend_wetscav(i,k,:) = ptend_wetscav(i,k,:)+del_wetscav3d(i,k,icc,jcls,ipp,:) + ptend_wetresu(i,k,:) = ptend_wetresu(i,k,:)+del_wetresu3d(i,k,icc,jcls,ipp,:) + xphlwc_gcm(i,k) = xphlwc_gcm(i,k) + xphlwc3d(i,k,icc,jcls,ipp) +! tendency at each transport class: + ptend_cldchem_cls(i,k,jcls,:) = ptend_cldchem_cls(i,k,jcls,:)+del_cldchem3d(i,k,icc,jcls,ipp,:) + ptend_rename_cls(i,k,jcls,:) = ptend_rename_cls(i,k,jcls,:)+del_rename3d(i,k,icc,jcls,ipp,:) + ptend_wetscav_cls(i,k,jcls,:) = ptend_wetscav_cls(i,k,jcls,:)+del_wetscav3d(i,k,icc,jcls,ipp,:) + ptend_wetresu_cls(i,k,jcls,:) = ptend_wetresu_cls(i,k,jcls,:)+del_wetresu3d(i,k,icc,jcls,ipp,:) + end do + + ptend_activate(i,k,:) = ptend_activate(i,k,:)+del_activate3d(i,k,icc,jcls,:) + ptend_activate_cls(i,k,jcls, :) = ptend_activate_cls(i,k,jcls, :) + del_activate3d(i,k,icc,jcls,:) + ptend_conv(i,k,:) = ptend_conv(i,k,:)+del_conv3d(i,k,icc,jcls,:) + ptend_conv_cls(i,k,jcls,:) = ptend_conv_cls(i,k,jcls,:)+del_conv3d(i,k,icc,jcls,:) + end do ! end icc + end do ! end jcls + +! column-integrated tendency + ptend_cldchem_col(i,:) = ptend_cldchem_col(i,:)+ptend_cldchem(i,k,:)*state%pdeldry(i,k)/gravit + ptend_rename_col(i,:) = ptend_rename_col(i,:)+ptend_rename(i,k,:)*state%pdeldry(i,k)/gravit + ptend_wetscav_col(i,:) = ptend_wetscav_col(i,:)+ptend_wetscav(i,k,:)*state%pdeldry(i,k)/gravit + ptend_wetresu_col(i,:) = ptend_wetresu_col(i,:)+ptend_wetresu(i,k,:)*state%pdeldry(i,k)/gravit + ptend_activate_col(i,:) = ptend_activate_col(i,:)+ptend_activate(i,k,:)*state%pdeldry(i,k)/gravit + ptend_conv_col(i,:) = ptend_conv_col(i,:)+ptend_conv(i,k,:)*state%pdeldry(i,k)/gravit + + ptend_cldchem_cls_col(i,:,:) = ptend_cldchem_cls_col(i,:,:)+ptend_cldchem_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + ptend_rename_cls_col(i,:,:) = ptend_rename_cls_col(i,:,:)+ptend_rename_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + ptend_wetscav_cls_col(i,:,:) = ptend_wetscav_cls_col(i,:,:)+ptend_wetscav_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + ptend_wetresu_cls_col(i,:,:) = ptend_wetresu_cls_col(i,:,:)+ptend_wetresu_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + ptend_activate_cls_col(i,:,:) = ptend_activate_cls_col(i,:,:)+ptend_activate_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + ptend_conv_cls_col(i,:,:) = ptend_conv_cls_col(i,:,:)+ptend_conv_cls(i,k,:,:)*state%pdeldry(i,k)/gravit + + + ptendq_col(i,param_first_ecpp:pcnst) = ptendq_col(i,param_first_ecpp:pcnst)+ & + ptend%q(i,k,param_first_ecpp:pcnst)*state%pdeldry(i,k)/gravit + ptendq_col(i,param_first_ecpp+pcnst:pcnst+pcnst) = ptendq_col(i,param_first_ecpp+pcnst:pcnst+pcnst)+ & + ptend_qqcw(i,k,param_first_ecpp:pcnst)*state%pdeldry(i,k)/gravit + end do + end do + + do ichem=param_first_ecpp, pcnst + if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & + (cnst_species_class(ichem) == cnst_spec_class_gas )) then + call outfld(trim(cnst_name(ichem))//'EP', ptend%q(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'ACHEM_EP', ptend_cldchem(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'RENM_EP', ptend_rename(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'ACT_EP', ptend_activate(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'WET_EP', ptend_wetscav(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'WRESU_EP', ptend_wetresu(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'CONV_EP', ptend_conv(:,:,ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFEP', ptendq_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACHEM_EP', ptend_cldchem_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFRENM_EP', ptend_rename_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACT_EP', ptend_activate_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFWET_EP', ptend_wetscav_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFWRESU_EP', ptend_wetresu_col(:,ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFCONV_EP', ptend_conv_col(:,ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFACHQU_EP', ptend_cldchem_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACHUP_EP', ptend_cldchem_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACHDN_EP', ptend_cldchem_cls_col(:,3, ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFREMQU_EP', ptend_rename_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFREMUP_EP', ptend_rename_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFREMDN_EP', ptend_rename_cls_col(:,3, ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFACTQU_EP', ptend_activate_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACTUP_EP', ptend_activate_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFACTDN_EP', ptend_activate_cls_col(:,3, ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFWETQU_EP', ptend_wetscav_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFWETUP_EP', ptend_wetscav_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFWETDN_EP', ptend_wetscav_cls_col(:,3, ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFRESQU_EP', ptend_wetresu_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFRESUP_EP', ptend_wetresu_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFRESDN_EP', ptend_wetresu_cls_col(:,3, ichem), pcols, lchnk) + + call outfld(trim(cnst_name(ichem))//'SFCONQU_EP', ptend_conv_cls_col(:,1, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFCONUP_EP', ptend_conv_cls_col(:,2, ichem), pcols, lchnk) + call outfld(trim(cnst_name(ichem))//'SFCONDN_EP', ptend_conv_cls_col(:,3, ichem), pcols, lchnk) + end if + end do + + do ichem=param_first_ecpp, pcnst + ichem2=ichem+pcnst + if(.not. (cnst_name_cw(ichem) == ' ')) then + call outfld(trim(cnst_name_cw(ichem))//'EP', ptend_qqcw(:,:,ichem), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'ACHEM_EP', ptend_cldchem(:,:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'RENM_EP', ptend_rename(:,:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'ACT_EP', ptend_activate(:,:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'WET_EP', ptend_wetscav(:,:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'WRESU_EP', ptend_wetresu(:,:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'CONV_EP', ptend_conv(:,:,ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFEP', ptendq_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACHEM_EP', ptend_cldchem_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFRENM_EP', ptend_rename_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACT_EP', ptend_activate_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFWET_EP', ptend_wetscav_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFWRESU_EP', ptend_wetresu_col(:,ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFCONV_EP', ptend_conv_col(:,ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFACTQU_EP', ptend_activate_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACTUP_EP', ptend_activate_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACTDN_EP', ptend_activate_cls_col(:,3, ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFACHQU_EP', ptend_cldchem_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACHUP_EP', ptend_cldchem_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFACHDN_EP', ptend_cldchem_cls_col(:,3, ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFREMQU_EP', ptend_rename_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFREMUP_EP', ptend_rename_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFREMDN_EP', ptend_rename_cls_col(:,3, ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFWETQU_EP', ptend_wetscav_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFWETUP_EP', ptend_wetscav_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFWETDN_EP', ptend_wetscav_cls_col(:,3, ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFRESQU_EP', ptend_wetresu_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFRESUP_EP', ptend_wetresu_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFRESDN_EP', ptend_wetresu_cls_col(:,3, ichem2), pcols, lchnk) + + call outfld(trim(cnst_name_cw(ichem))//'SFCONQU_EP', ptend_conv_cls_col(:,1, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFCONUP_EP', ptend_conv_cls_col(:,2, ichem2), pcols, lchnk) + call outfld(trim(cnst_name_cw(ichem))//'SFCONDN_EP', ptend_conv_cls_col(:,3, ichem2), pcols, lchnk) + + do i=1, ncol + do k=1, pver +! if(cnst_name_cw(ichem) == 'bc_c1') then +! if(abs(ptend_wetscav(i, k, ichem2)).gt.1.0e-16 .and. qqcwold(i, k, ichem).gt. 1.0e-13) then +! if(abs(ptend_conv(i, k, ichem2)).lt.1.0e-20 .and. abs(ptend_activate(i, k, ichem2)).lt.1.0e-20) then +! write(0, *) 'nstep, ecpp wet, qqcw', nstep, qqcwold(i, k, ichem), qqcw(i,k,ichem), state%q(i, k, ichem), & +! ptend_wetscav(i, k, ichem2)*1800, ptend_wetscav(i, k, ichem2)*86400/qqcwold(i, k, ichem) +! write(0, *) 'ecpp acen', acen_3d(i, k,2,1:ncls_ecpp,1), acen_3d(i, k,2,1:ncls_ecpp,2) +! write(0, *) 'ecpp qlsink' , qlsinkcen_3d(i, k,2,1:ncls_ecpp,1)*86400, qlsinkcen_3d(i, k,2,1:ncls_ecpp,2)*86400 +! write(0, *) 'ecpp wetscav', del_wetscav3d(i,k,2,1:ncls_ecpp,1, ichem2)*1800, & +! del_wetscav3d(i,k,2,1:ncls_ecpp,2, ichem2)*1800 + +! call endrun('ptend_conv error') +! end if +! end if +! if(abs(ptend_conv_col(i, ichem2)).gt.1.0e-15) then +! write(0, *) 'ptend_conv error', ptend_wetresu_col(i,ichem2)+ptend_wetscav_col(i,ichem2), & +! ptend_cldchem_col(i,ichem2), ptend_activate_col(i,ichem2), ptend_conv_col(i,ichem2), & +! ptendq_col(i,ichem2) +! write(0, *) 'ptend_conv error2' , del_chem_col_wetscav(i, ichem2)/dtstep, del_chem_col_cldchem(i,ichem2)/dtstep +! write(0, *) 'ptend_conv error3' , ptendq_col(i,ichem2), & +! ptend_wetresu_col(i,ichem2)+ptend_wetscav_col(i,ichem2) & +! +ptend_cldchem_col(i,ichem2)+ptend_activate_col(i,ichem2), & +! del_chem_col_wetscav(i, ichem2)/dtstep+ptend_cldchem_col(i,ichem2)+ptend_activate_col(i,ichem2) +! call endrun('ptend_conv error') +! end if +! end if + end do + end do + end if + end do + + call outfld('AQSO4_H2O2_EP', aqso4_h2o2, pcols, lchnk) + call outfld('AQSO4_O3_EP', aqso4_o3, pcols, lchnk) + call outfld('XPH_LWC_EP', xphlwc_gcm, pcols, lchnk) + +! +! qqcw is updated above, and q is upated in tphysbc +! + + return + end subroutine parampollu_driver2 +!------------------------------------------------------------------------- + +!------------------------------------------------------------------------- +end module module_ecpp_ppdriver2 diff --git a/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 b/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 new file mode 100644 index 0000000000..2e2d9e43a2 --- /dev/null +++ b/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 @@ -0,0 +1,5149 @@ + module module_ecpp_td2clm + + use ecpp_modal_aero_activate, only: parampollu_tdx_activate1 + use ecpp_modal_cloudchem, only: parampollu_tdx_cldchem + use ecpp_modal_wetscav, only: parampollu_tdx_wetscav_2 + use perf_mod + use cam_abortutils, only: endrun + use physics_buffer, only : physics_buffer_desc + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + + integer, parameter :: jgrp_up=2, jgrp_dn=3 + + + contains + +!----------------------------------------------------------------------- +! +! rce 2005-mar-10 - created +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + subroutine parampollu_td240clm( & + ktau, dtstep, ktau_pp_in, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd_ecpp, & + abnd_tavg_ecpp, acen_tavg_ecpp, & + acen_tfin_ecpp, acen_tbeg_ecpp, acen_prec_ecpp, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & + del_cldchem3d, del_rename3d, & + del_wetscav3d, del_wetresu3d, & + del_activate3d, del_conv3d, & + del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & + aqso4_h2o2, aqso4_o3, xphlwc3d, & + it, jt, kts,ktebnd,ktecen, pbuf ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_td240clm is a top level routine for doing +! ecpp parameterized pollutants calculations on a single column +! of the host-code grid +! +! this version uses the hybrid time-dependent up/dndraft formulation +! the up and dndrafts are time-dependent, rather than steady state, +! with a lifetime equal "draft_lifetime" +! in the hybrid formulation, the host-code column is conceptually +! divided into ntstep_hybrid == (draft_lifetime/dtstep_pp) pieces +! time integrations over dtstep_pp are done for each piece, sequentially +! the up and downdrafts start "fresh" in the first piece +! at the end of each "piece integration", the up and downdrafts are +! shifted into the next piece +! the the drafts evolve over time = draft_lifetime, but different +! pieces of the environment are affected by different aged drafts +! the hybrid approach avoids two problems of the original time-dependent +! up/dndraft formulation: +! (a) having to store draft information (specifically aerosol mixing +! ratios in the drafts sub-classes) from one host-code time-step to +! the next +! (b) having to determine when drafts should be re-initialized +! +!----------------------------------------------------------------------- + + + use module_data_mosaic_asect, only: ai_phase, cw_phase, nphase_aer + + use module_data_ecpp1 + + use module_data_mosaic_asect, only: is_aerosol, iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & + parampollu_1clm_set_opts + + use cam_abortutils, only: endrun + +! arguments + integer, intent(in) :: & + ktau, ktau_pp_in, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp_in - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) +! these control diagnostic output + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, wbnd_bar, zbnd +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! zbnd - elevation (m) at layer boundaries +! dzcen - layer thicknesses (m) + + real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + +! NOTE - tcen_bar through chem_bar are all grid-cell averages +! (on the host-code grid) + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp +! kdraft_bot_ecpp = lowest layer in/thru which sub-area transport occurs +! = lowest layer for which massflux != 0 at layer upper boundary +! OR areafrac != 0 at layer center +! >= kts +! kdraft_top_ecpp = highest layer in/thru which sub-area transport occurs +! = highest layer for which massflux != 0 at layer lower boundary +! OR areafrac != 0 at layer center +! <= kte-1 +! mtype_updnenv_ecpp - transport-class (updraft, downdraft, or quiescent) + + real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + abnd_tavg_ecpp, mfbnd_ecpp +! real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & +! acen_tavg_ecpp, acen_tbeg_ecpp, acen_prec_ecpp + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg_ecpp, acen_tbeg_ecpp, acen_prec_ecpp + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tfin_ecpp +! abnd_tavg_ecpp - sub-class fractional area (--) at layer bottom boundary +! acen_tavg_ecpp, acen_tbeg_ecpp, acen_tfin_ecpp - sub-class fractional area (--) +! at layer centers +! _tavg_ is average for full time period (=dtstep_pp_in) +! _tbeg_ is average at beginning of time period +! _tfin_ is average for end-portion of time period +! acen_prec_ecpp - fractional area (---) of the portion of a sub-class that +! has precipitation +! 0 <= acen_prec_ecpp(:,:,:)/acen_tavg_ecpp(:,:,:) <= 1 +! mfbnd_ecpp - sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. +! +! NOTE 1 - these 6 xxx_ecpp arrays contain statistics from the crm +! post-processor or interface. +! Each array has a xxx_use array that contains "checked and adjusted values", +! and those values are the ones that are used. +! NOTE 2 - indexing for these arrays +! the first index is vertical layer +! the second index (0:2): 1=clear, 2=cloudy, and 0=clear+cloudy combined +! the third index is transport class + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 +! rh_sub2 - relative humidity (0-1) at layer center +! qcloud_sub2 - cloud water mixing ratio (kg/kg) at layer center +! qlsink_sub2 - cloud-water first-order loss rate to precipitation (kg/kg/s) at layer center +! precr_sub2 - liquid (rain) precipitation rate (kg/m2/s) at layer center +! precsolid_sub2 - solid (snow,graupel,...) precipitation rate (kg/m2/s) at layer center +! +! NOTE - indexing for these arrays +! the first index is vertical layer +! the second index (0:2) is: 1=clear, 2=cloudy +! the third index is transport class +! the fourth index (0:2) is: 1=non-precipitating, 2=precipitating + + real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem3d, & ! 3D change in chem_sub from aqueous chemistry + del_rename3d, & ! 3D change in chem_sub from renaming (modal merging) + del_wetscav3d, & ! 3D change in chem_sub from wet deposition + del_wetresu3d + + real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3d ! 3D change in chem_sub from activation/resuspension + + real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_conv3d ! 3D change in chem_sub from convective transport + + real(r8), intent(out) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & + xphlwc3d ! pH value multiplied by lwc + + real(r8), intent(out), dimension( 1:num_chem_ecpp ) :: del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav + type(physics_buffer_desc), pointer :: pbuf(:) + +! local variables + integer :: activate_onoff_use + integer :: icc, iccy, idiag, & + ipass_area_change, ipass_check_adjust_inputs, & + itstep_hybrid + integer :: jcls, jclsbb, jgrp, jgrpbb + integer :: k, ktau_pp + integer :: l, laa, lbb, ll, lun, lun62 + integer :: ncls_use, ntstep_hybrid + + integer, dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8) :: draft_area_fudge, draft_area_fudge_1m + real(r8) :: tmpa + real(r8) :: tmpd, tmpe, tmpf, tmpg, tmph + real(r8) :: tmpveca(100) + real(r8), save :: tmpvecsva(100), tmpvecsvb(100), tmpvecsvc(100) + + real(r8), dimension( kts:ktebnd ) :: wbnd_bar_use + + real(r8), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + abnd_tavg_use, mfbnd_use, & + abnd_tavg_usex1, mfbnd_usex1, & + ar_bnd_tavg + + real(r8), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg_usex1, acen_tbeg_usex1, acen_tfin_usex1, & + acen_tavg_use, acen_tbeg_use, acen_tfin_use, acen_prec_use, & + ardz_cen_tbeg, ardz_cen_tfin, & + ardz_cen_tavg, & + ardz_cen_old, ardz_cen_new + + real(r8), dimension( kts:ktebnd, 0:2, 0:2 ) :: & + mfbnd_quiescn_up, mfbnd_quiescn_dn + + real(r8), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_cls + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_new, chem_sub_beg, chem_sub_ac1sv, chem_sub_hysum + + real(r8), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor + + real(r8), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3da ! 3D change in chem_sub from activation/resuspension + + + + character(len=120) :: msg + + + ktau_pp = 10 + + lun62 = -1 + if (idiagaa_ecpp(62) > 0) lun62 = ldiagaa_ecpp(62) + + activate_onoff_use = 0 + if ( (nphase_aer >= 2) .and. & + (ai_phase > 0) .and. (cw_phase > 0) ) & + activate_onoff_use = activat_onoff_ecpp + +! in sub-classes with area ~= 0, chem_sub is set to chem_bar +! EXCEPT for aerosol species, where activated=0 in clear, +! and activated=interstitial=0.5*chem_bar in cloudy + chem_bar_iccfactor(:,:) = 1.0_r8 + if (activate_onoff_use > 0) then + do l = param_first_ecpp, num_chem_ecpp + if ( is_aerosol(l) ) then + if (iphase_of_aerosol(l) == ai_phase) then + chem_bar_iccfactor(2,l) = 1.0_r8 + else if (iphase_of_aerosol(l) == cw_phase) then + chem_bar_iccfactor(2,l) = 1.0_r8 + chem_bar_iccfactor(1,l) = 1.0_r8 + end if + end if + end do + end if + +! +! output the original fields with same format as ppboxmakeinp01 +! + ll = 116 + lun = ldiagaa_ecpp(ll) + if ((idiagaa_ecpp(ll) > 0) .and. (lun > 0)) then + call parampollu_1clm_dumpaa( & + ktau, dtstep, ktau_pp, dtstep_pp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd_ecpp, abnd_tavg_ecpp, & + acen_tavg_ecpp, acen_tbeg_ecpp, acen_tfin_ecpp, & + it, jt, kts,ktebnd,ktecen, & + lun ) + end if + + +! +! check and adjust input information +! and do startup calcs (for this parampollu timestep) +! + do ipass_check_adjust_inputs = 1, 2 + + call parampollu_check_adjust_inputs( & + ipass_check_adjust_inputs, & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd_ecpp, abnd_tavg_ecpp, & + acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp, & + wbnd_bar_use, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & + abnd_tavg_use, & + acen_tavg_use, acen_tfin_use, acen_prec_use, & + rhodz_cen, & + it, jt, kts,ktebnd,ktecen ) + +! do startup calcs (for this parampollu timestep) + if (ipass_check_adjust_inputs == 1) then + acen_tbeg_use(:,:,:) = acen_tbeg_ecpp(:,:,:) + else + call parampollu_tdx_startup( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + rhocen_bar, dzcen, & + chem_bar, chem_cls, & + ncls_ecpp, & + acen_tbeg_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + chem_sub_beg, & + acen_tbeg_use, ardz_cen_tbeg, rhodz_cen, & + activate_onoff_use, & + iphase_of_aerosol, laicwpair_of_aerosol ) + end if + +! output the adjusted fields with same format as ppboxmakeinp01 + if (ipass_check_adjust_inputs == 1) then + acen_tavg_usex1(:,:,:) = acen_tavg_use(:,:,:) + acen_tfin_usex1(:,:,:) = acen_tfin_use(:,:,:) + abnd_tavg_usex1(:,:,:) = abnd_tavg_use(:,:,:) + mfbnd_usex1( :,:,:) = mfbnd_use( :,:,:) + ll = 117 + else + ll = 115 + end if + + lun = ldiagaa_ecpp(ll) + if ((idiagaa_ecpp(ll) > 0) .and. (lun > 0)) then + call parampollu_1clm_dumpaa( & + ktau, dtstep, ktau_pp, dtstep_pp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar_use, & + chem_bar, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + mfbnd_use, abnd_tavg_use, & + acen_tavg_use, acen_tbeg_use, acen_tfin_use, & + it, jt, kts,ktebnd,ktecen, & + lun ) + end if + + end do ! ipass_check_adjust_inputs + + + +! *** temporary exit + if (iflag_ecpp_test_bypass_1 > 0) return + + +! save values in these arrays + acen_tbeg_usex1(:,:,:) = acen_tbeg_use(:,:,:) + chem_sub_new(:,:,:,:) = chem_sub_beg(:,:,:,:) + + del_activate3d(:,:,:,:) = 0.0_r8 + +! calc "area*rho*dz" and "area*rho" arrays + ardz_cen_tavg(:,:,:) = 0.0_r8 + ardz_cen_tfin(:,:,:) = 0.0_r8 + ar_bnd_tavg(:,:,:) = 0.0_r8 + do k = kts, ktebnd + do icc = 0, 2 + ar_bnd_tavg( k,icc,0:ncls_use) = abnd_tavg_use(k,icc,0:ncls_use)*rhobnd_bar(k) + if (k > ktecen) cycle + ardz_cen_tavg(k,icc,0:ncls_use) = acen_tavg_use(k,icc,0:ncls_use)*rhodz_cen(k) + ardz_cen_tfin(k,icc,0:ncls_use) = acen_tfin_use(k,icc,0:ncls_use)*rhodz_cen(k) + end do + end do + + +! +! apply area changes (acen_tbeg_use --> ... --> acen_tfin_use) here +! parampollu_opt == 2220 +! apply area changes in one step, before 15000 loop +! parampollu_opt == 2223 +! apply area changes in two steps, before and after 15000 loop +! + ardz_cen_old(:,:,:) = ardz_cen_tbeg(:,:,:) + if (parampollu_opt == 2220) then + ardz_cen_new(:,:,:) = ardz_cen_tfin(:,:,:) + else if (parampollu_opt == 2223) then + ardz_cen_new(:,:,:) = ardz_cen_tavg(:,:,:) + else + stop + end if + +! note about parampollu_tdx_area_change and parampollu_tdx_main_integ +! initial values are taken from chem_sub_new +! final values are put into chem_sub_new + ipass_area_change = 1 + call parampollu_tdx_area_change( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ipass_area_change, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_activate3d, & + mfbnd_use, ar_bnd_tavg, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + + + +! save current chem_sub values + chem_sub_ac1sv(:,:,:,:) = 0.0_r8 + chem_sub_ac1sv(kts:ktecen,1:2,1:ncls_use,1:num_chem_ecpp) = & + chem_sub_new(kts:ktecen,1:2,1:ncls_use,1:num_chem_ecpp) +! initialize chem_sub hybrid-sum + chem_sub_hysum(:,:,:,:) = 0.0_r8 + + ntstep_hybrid = nint( draft_lifetime / dtstep ) + ntstep_hybrid = max( 1, ntstep_hybrid ) + if (lun62 > 0) write(lun62,'(a,2i10)') & + 'parampollu_td240clm - ktau, ntstep_hybrid', & + ktau, ntstep_hybrid + + + del_chem_clm_cldchem(:) = 0.0_r8 + del_chem_clm_rename(:) = 0.0_r8 + del_cldchem3d(:,:,:,:,:) = 0.0_r8 + del_rename3d(:,:,:,:,:) = 0.0_r8 + del_chem_clm_wetscav(:) = 0.0_r8 + del_wetscav3d(:,:,:,:,:) = 0.0_r8 + del_wetresu3d(:,:,:,:,:) = 0.0_r8 + del_activate3da(:,:,:,:) = 0.0_r8 + + aqso4_h2o2 = 0.0_r8 + aqso4_o3 = 0.0_r8 + xphlwc3d(:,:,:,:) = 0.0_r8 + +itstep_hybrid_loop: & + do itstep_hybrid = 1, ntstep_hybrid + ktau_pp = itstep_hybrid + 100 + +! +! main integration +! + ardz_cen_old(:,:,:) = ardz_cen_new(:,:,:) + + call parampollu_tdx_main_integ( & + ktau, dtstep, ktau_pp, dtstep_pp, & + itstep_hybrid, ntstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & + del_cldchem3d, del_rename3d, & + del_wetscav3d, del_wetresu3d, & + del_activate3da, & + aqso4_h2o2, aqso4_o3, xphlwc3d, & + mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & + ar_bnd_tavg, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol, pbuf ) + + + do l = param_first_ecpp, num_chem_ecpp + do jcls = 1, ncls_use +! increment chem_sub_hysum + if ((jcls == jcls_qu) .or. (itstep_hybrid == ntstep_hybrid)) then +! for quiescent (all steps) or up/dndrafts (final step), use chem_sub_new + chem_sub_hysum(kts:ktecen,1:2,jcls,l) = & + chem_sub_hysum(kts:ktecen,1:2,jcls,l) + & + chem_sub_new(kts:ktecen,1:2,jcls,l) + else +! for up/dndrafts (all but final step), use chem_sub_ac1sv + chem_sub_hysum(kts:ktecen,1:2,jcls,l) = & + chem_sub_hysum(kts:ktecen,1:2,jcls,l) + & + chem_sub_ac1sv(kts:ktecen,1:2,jcls,l) + end if + +! on all but final step, prepare for next main_integ by +! restoring jcls_qu to chem_sub_ac1sv values + if ((jcls == jcls_qu) .and. (itstep_hybrid < ntstep_hybrid)) then + chem_sub_new( kts:ktecen,1:2,jcls,l) = & + chem_sub_ac1sv(kts:ktecen,1:2,jcls,l) + end if + +! on (after) final step, convert chem_sub_hysum to an average +! and load into chem_sub_new + if (itstep_hybrid == ntstep_hybrid) then + tmpa = 1.0_r8/ntstep_hybrid + chem_sub_new( kts:ktecen,1:2,jcls,l) = & + chem_sub_hysum(kts:ktecen,1:2,jcls,l)*tmpa + end if + + end do ! jcls + end do ! l + + + end do itstep_hybrid_loop + + tmpa = ntstep_hybrid ; tmpa = 1.0_r8/tmpa + del_chem_clm_cldchem(:) = del_chem_clm_cldchem(:)*tmpa + del_chem_clm_rename(:) = del_chem_clm_rename(:)*tmpa + del_cldchem3d(:,:,:,:,:) = del_cldchem3d(:,:,:,:,:) * tmpa + del_rename3d(:,:,:,:,:) = del_rename3d(:,:,:,:,:) * tmpa + del_chem_clm_wetscav(:) = del_chem_clm_wetscav(:)*tmpa + del_wetscav3d(:,:,:,:,:) = del_wetscav3d(:,:,:,:,:)*tmpa + del_wetresu3d(:,:,:,:,:) = del_wetresu3d(:,:,:,:,:)*tmpa + del_activate3d(:,:,:,:) = del_activate3d(:,:,:,:) + del_activate3da(:,:,:,:) * tmpa + + aqso4_h2o2 = aqso4_h2o2 * tmpa + aqso4_o3 = aqso4_o3 * tmpa + xphlwc3d(:,:,:,:) = xphlwc3d(:,:,:,:) * tmpa + + + ktau_pp = 20 + + +! when parampollu_opt == 2223, do 2nd half of area change here + if (parampollu_opt == 2223) then + ipass_area_change = 2 + ardz_cen_old(:,:,:) = ardz_cen_new(:,:,:) + ardz_cen_new(:,:,:) = ardz_cen_tfin(:,:,:) + + call parampollu_tdx_area_change( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ipass_area_change, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_activate3d, & + mfbnd_use, ar_bnd_tavg, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + + end if + + +! do "cleanup" + call parampollu_tdx_cleanup( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + chem_bar, chem_cls, & + ncls_ecpp, & + acen_tfin_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + chem_sub_beg, chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_wetscav, & + del_cldchem3d, del_rename3d, & + del_wetscav3d, del_wetresu3d, & + del_activate3d, del_conv3d, & + acen_tbeg_use, acen_tfin_use, rhodz_cen, & + activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + + +! output precip info +! + if (ktau <= 1) then + tmpvecsva(:) = 0.0_r8 ; tmpvecsvb(:) = 0.0_r8 ; tmpvecsvc(:) = 0.0_r8 + end if + tmpveca(:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + tmpe = max( 0.0_r8, acen_prec_use(kts,icc,jcls) ) + tmpf = max( 0.0_r8, acen_tavg_use(kts,icc,jcls) - tmpe ) + tmpg = max( 0.0_r8, precr_sub2(kts,icc,jcls,2) ) + & + max( 0.0_r8, precs_sub2(kts,icc,jcls,2) ) + tmph = max( 0.0_r8, precr_sub2(kts,icc,jcls,1) ) + & + max( 0.0_r8, precs_sub2(kts,icc,jcls,1) ) + tmpveca(1) = tmpveca(1) + tmpg + tmpveca(2) = tmpveca(2) + tmph + tmpveca(3) = tmpveca(3) + tmpg*tmpe + tmpveca(4) = tmpveca(4) + tmph*tmpf + do k = kts, ktecen + tmpe = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) + tmpf = max( 0.0_r8, acen_tavg_use(k,icc,jcls) - tmpe ) + tmpg = max( 0.0_r8, precr_sub2(k,icc,jcls,2) ) + & + max( 0.0_r8, precs_sub2(k,icc,jcls,2) ) + tmph = max( 0.0_r8, precr_sub2(k,icc,jcls,1) ) + & + max( 0.0_r8, precs_sub2(k,icc,jcls,1) ) + tmpa = tmpg*tmpe + tmph*tmpf + end do + end do + end do + + if (mod(ktau,18) == 0 .and. ktau.ge.1) then + tmpa = 3600.0_r8/ktau ! converts accumulated precip to time avg and mm/h + end if + + if (mod(ktau,18) == 0 .and. ktau.ge.1) then + do k = kts, ktecen, 5 + tmpveca(:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + tmpe = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) + tmpf = max( 0.0_r8, acen_tavg_use(k,icc,jcls) - tmpe ) + tmpveca(1) = tmpveca(1) + & + tmpe*max( 0.0_r8, rh_sub2(k,icc,jcls,2) ) + & + tmpf*max( 0.0_r8, rh_sub2(k,icc,jcls,1) ) + tmpveca(2) = tmpveca(2) + & + tmpe*max( 0.0_r8, precr_sub2(k,icc,jcls,2) ) + & + tmpf*max( 0.0_r8, precr_sub2(k,icc,jcls,1) ) + tmpveca(3) = tmpveca(3) + & + tmpe*max( 0.0_r8, precs_sub2(k,icc,jcls,2) ) + & + tmpf*max( 0.0_r8, precs_sub2(k,icc,jcls,1) ) + tmpveca(4) = tmpveca(4) + & + tmpe*max( 0.0_r8, qcloud_sub2(k,icc,jcls,2) ) + & + tmpf*max( 0.0_r8, qcloud_sub2(k,icc,jcls,1) ) + end do + end do + tmpveca(3) = tmpveca(3) + tmpveca(2) + end do + end if + +! +! all done +! + if (lun62 > 0) write(lun62,*) '*** leaving parampollu_td240clm' + return + end subroutine parampollu_td240clm + + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_main_integ( & + ktau, dtstep, ktau_pp, dtstep_pp, & + itstep_hybrid, ntstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & + del_cldchem3d, del_rename3d, & + del_wetscav3d, del_wetresu3d, & + del_activate3d, & + aqso4_h2o2, aqso4_o3, xphlwc3d, & + mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & + ar_bnd_tavg, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol, pbuf ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_main_integ does the "main integration" +! of the trace-species conservation equations over time-step dtstep_pp +! +! incoming chem_sub_new holds current sub-class mixing ratios +! outgoing chem_sub_new holds updated sub-class mixing ratios +! +! treats +! sub-grid vertical transport and associated horizontal exchange +! (entrainment and detrainment) +! activation/resuspension +! cloud chemistry and wet removal +! +! does not treat +! horizontal exchange associated with sub-class area changes +! +!----------------------------------------------------------------------- + + use module_data_radm2, only: epsilc + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + massptr_aer, maxd_asize, maxd_atype, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + itstep_hybrid, ntstep_hybrid, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, wbnd_bar, zbnd +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! zbnd - elevation (m) at layer boundaries +! dzcen - layer thicknesses (m) + + real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + integer, intent(in) :: ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_new + + real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem3d, & ! 3D change from aqueous chemistry + del_rename3d, & ! 3D change from renaming (modal merging) + del_wetscav3d, & ! 3D change from wet deposition + del_wetresu3d + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3d ! 3D change from activation/resuspension + + real(r8), intent(inout) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + real(r8), intent(inout), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & + xphlwc3d ! pH value multiplied by lwc + + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + mfbnd_use, ar_bnd_tavg + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + ardz_cen_old, ardz_cen_new, acen_tavg_use, acen_prec_use + + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:2 ) :: & + mfbnd_quiescn_up, mfbnd_quiescn_dn + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & + rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 + + real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + type(physics_buffer_desc), pointer :: pbuf(:) + + + +! local variables + integer, parameter :: activate_onoff_testaa = 1 + integer :: icc, iccb, iccy, ido_actres_tmp, ifrom_where, & + itstep_sub, itmpa, iupdn + integer :: idiag118_pt1, idiag118_pt2, idiag118_pt3 + integer :: idiagbb_wetscav + integer :: jcls, jclsy + integer :: k, kb, l, la, laa, lbb, lc, lun118, lun124 + integer :: m, n, ntstep_sub + integer, save :: ntstep_sub_sum = 0 + integer :: p1st + + integer, dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & + ido_actres_horz + + logical :: not_aicw + + real(r8) :: ardz_cut + real(r8) :: dtstep_sub + real(r8) :: tmpa, tmpb, tmpc, tmpd + real(r8) :: tmpcourout, tmpcourmax + real(r8) :: tmp_ardz, tmp_del_ardz + real(r8) :: tmp_ardzqa, tmp_del_ardzqa + real(r8) :: tmp_ardzqc, tmp_del_ardzqc + real(r8) :: tmp_del_ardzqa_act, tmp_del_ardzqc_act + real(r8) :: tmp_fmnact + real(r8) :: tmp_qyla, tmp_qylc + real(r8) :: tmp2dxa(0:2,0:maxcls_ecpp), tmp2dxb(0:2,0:maxcls_ecpp) + real(r8) :: xntstep_sub_inv + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_old + real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_tot, det_airamt_tot + real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt, det_airamt + real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + fmact_horz, fnact_horz + real(r8), dimension( 1:maxd_asize, 1:maxd_atype, kts:ktecen ) :: & + fmact_vert, fnact_vert + real(r8), dimension( kts:ktebnd, 0:maxcls_ecpp, 1:num_chem_ecpp ) :: & + tmpverta, tmphoriz + + real(r8) :: frc_ent_act ! the fraction of updraft entrainment that may experince activation +++mhwang + real(r8) :: frc_tmp + real(r8) :: abnd_up ! cloud fraction in the upper boundary + real(r8) :: abnd_dn ! cloud fraction in the lower boundary + + call t_startf('ecpp_mainintegr') + + p1st = param_first_ecpp + + idiag118_pt1 = 10 * mod( max(idiagaa_ecpp(118),0)/1, 10 ) + idiag118_pt2 = 10 * mod( max(idiagaa_ecpp(118),0)/10, 10 ) + idiag118_pt3 = 10 * mod( max(idiagaa_ecpp(118),0)/100, 10 ) + + lun124 = -1 + if (idiagaa_ecpp(124) > 0) lun124 = ldiagaa_ecpp(124) + + idiagbb_wetscav = 0 + +! +! calc entrain/detrain amounts +! +! first calc net (entrainment-detrainment) amount = area change + ent_airamt_tot(:,:,:) = 0.0_r8 + det_airamt_tot(:,:,:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + tmpa = max( ardz_cen_new(k,icc,jcls), ardz_cen_old(k,icc,jcls) ) + if (tmpa < ardz_cut) cycle ! k loop + + if (jcls /= jcls_qu) then +! this is for area change +! tmpb = ardz_cen_new(k,icc,jcls) - ardz_cen_old(k,icc,jcls) +! this is for vertical mass flux divergence/convergence + tmpb = (mfbnd_use(k+1,icc,jcls) - mfbnd_use(k,icc,jcls))*dtstep_pp + if (tmpb > 0.0_r8) then + ent_airamt_tot(icc,jcls,k) = tmpb + else if (tmpb < 0.0_r8) then + det_airamt_tot(icc,jcls,k) = -tmpb + end if + + else + ! +mfbnd_quiescn_up(k+1,icc,0 ) is upwards outflow from sub-class + ! at top of layer (and is >= 0) + ! +mfbnd_quiescn_dn(k+1,0 ,icc) is dnwards inflow to sub-class + ! at top of layer (and is <= 0) + ! -mfbnd_quiescn_up(k ,0, ,icc) is upwards inflow to sub-class + ! at bottom of layer (and is <= 0) + ! -mfbnd_quiescn_dn(k ,icc,0 ) is dnwards outflow from sub-class + ! at bottom of layer (and is >= 0) + ! tmpb = net vertical in/outflows + ! (positive if net outflow, negative if net inflow) + tmpb = ( mfbnd_quiescn_up(k+1,icc,0 ) & + + mfbnd_quiescn_dn(k+1,0 ,icc) & + - mfbnd_quiescn_up(k ,0 ,icc) & + - mfbnd_quiescn_dn(k ,icc,0 ) )*dtstep_pp + if (tmpb > 0.0_r8) then + ent_airamt_tot(icc,jcls,k) = tmpb + else if (tmpb < 0.0_r8) then + det_airamt_tot(icc,jcls,k) = -tmpb + end if + + end if + end do + end do + end do + +! next calc detailed ent/det amounts + call t_startf('ecpp_entdet') + ifrom_where = 10 + call parampollu_tdx_entdet_sub1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + ent_airamt_tot, det_airamt_tot, & + ent_airamt, det_airamt ) + call t_stopf('ecpp_entdet') + + +! +! calc activation/resuspension fractions associated with ent/det +! and vertical transport +! + if (activate_onoff_use > 0) then + call t_startf('ecpp_activate') + ifrom_where = 10 + call parampollu_tdx_activate1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, activate_onoff_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + mfbnd_use, & + ar_bnd_tavg, & + ent_airamt, & + ido_actres_horz, fmact_horz, fnact_horz, & + fmact_vert, fnact_vert, mfbnd_quiescn_up ) + call t_stopf('ecpp_activate') + end if + + +! +! determine number of integration sub-steps +! calc "outflow" courant number for each sub-class +! = (sum of outflow air-mass fluxes) * dt / ardz_cen +! calc tmpcourmax = maximum outflow courant number +! for all layers and sub-classes +! select ntstep_sub (number of integration sub-steps) so that +! (tmpcourmax/ntstep_sub) <= 1.0 +! + if (lun124 > 0) & + write( lun124, '(/a,2i5/a)' ) 'new courout stuff -- ktau, ktau_pp', ktau, ktau_pp, & + 'k, tmpcouroutc(qu), tmpcouroutb(up), tmpcouroutb(dn)' + tmp2dxb(:,:) = -1.0_r8 + tmpcourmax = 0.0_r8 + do k = ktecen, kts, -1 + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + +! tmpa = (air-mass leaving sub-class over dtstep_pp by vertical mass flux) + if (jcls == jcls_qu) then + tmpa = mfbnd_quiescn_up(k+1,icc,0) - mfbnd_quiescn_dn(k,icc,0) + else + tmpa = max(0.0_r8,mfbnd_use(k+1,icc,jcls)) + max(0.0_r8,-mfbnd_use(k,icc,jcls)) + end if + tmpa = tmpa*dtstep_pp +! tmpb = tmpa + (air-mass leaving sub-class over dtstep_pp by horizontal detrainment) + tmpb = tmpa + max(0.0_r8,det_airamt_tot(icc,jcls,k)) + +! (area*rho*dz) is fixed at ardz_cen_new during the integration loop + tmp_ardz = ardz_cen_new(k,icc,jcls) + + if (tmp_ardz < ardz_cut) then + tmpcourout = 0.0_r8 + else if (tmpb > 1.0e3_r8*tmp_ardz) then + tmpcourout = 1.0e3_r8 + else + tmpcourout = tmpb/tmp_ardz + end if + + tmpcourmax = max( tmpcourmax, tmpcourout ) + tmp2dxa(icc,jcls) = tmpcourout + tmp2dxb(icc,jcls) = max( tmp2dxb(icc,jcls), tmpcourout ) + end do ! icc + end do ! jcls + if (lun124 > 0) & + write( lun124, '(i3,1p,3e12.4,2x,3e12.4)' ) k, (tmp2dxa(iccy,1:3), iccy=1,2) + end do ! k + if (lun124 > 0) & + write( lun124, '( a,1p,3e12.4,2x,3e12.4)' ) 'max', (tmp2dxb(iccy,1:3), iccy=1,2) + + if (tmpcourmax > 1.0_r8) then + tmpa = max( 0.0_r8, tmpcourmax-1.0e-7_r8 ) + ntstep_sub = 1 + int( tmpa ) + else + ntstep_sub = 1 + end if + ntstep_sub_sum = ntstep_sub_sum + ntstep_sub + dtstep_sub = dtstep_pp/ntstep_sub + xntstep_sub_inv = 1.0_r8/ntstep_sub + + lun118 = -1 + if (idiag118_pt2 > 0) lun118 = ldiagaa_ecpp(118) + if (lun118 > 0) then + write(lun118,'(a,1p,2e12.4,2i12)') & + ' tmpcourmax, dtstep_sub, nstep_sub =', tmpcourmax, dtstep_sub, & + ntstep_sub, ntstep_sub_sum + end if + if (lun124 > 0) & + write( lun124, '(a,1p,2e12.4,2i12)' ) & + ' tmpcourmax, dtstep_sub, nstep_sub =', tmpcourmax, dtstep_sub, & + ntstep_sub, ntstep_sub_sum + + + +! +! do multiple integration sub-steps +! apply vertical transport and balancing entrainment/detrainment +! +! area change is done elsewhere, so area is fixed at ardz_cen_new +! during the integration loop +! +main_itstep_sub_loop: & + do itstep_sub = 1, ntstep_sub + + call t_startf('ecpp_vertical') + +! copy "current" chem_sub values to chem_sub_old + chem_sub_old(:,:,:,:) = chem_sub_new(:,:,:,:) + + + tmpverta(:,:,:) = 0.0_r8 + tmphoriz( :,:,:) = 0.0_r8 + +! calculate "transport" changes to chem_sub over one time sub-step +! (vertical transport and horizontal exchange, including activation/resuspension) +main_trans_jcls_loop: & + do jcls = 1, ncls_use +main_trans_icc_loop: & + do icc = 1, 2 +main_trans_k_loop: & + do k = kts, ktecen + + +! if area ~= 0, then just set chem_sub_new to chem_bar + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + if (ardz_cen_new(k,icc,jcls) < ardz_cut) then + do l = param_first_ecpp, num_chem_ecpp + chem_sub_new(k,icc,jcls,l) = & + chem_bar(k,l)*chem_bar_iccfactor(icc,l) + end do + cycle main_trans_k_loop + end if + + +! la loop goes over all species +! for la = non-aerosol species, loop is executed with lc=0 +! for la = interstitial aerosol species, loop is excecuted with +! lc=activated counterpart +! for la = activated aerosol species, loop is skipped +main_trans_la_loop: & + do la = p1st, num_chem_ecpp + + tmp_del_ardzqa_act = 0.0_r8 + tmp_del_ardzqc_act = 0.0_r8 + + lc = 0 + l = -999888777 + not_aicw = .true. +! if (activate_onoff_use > 999888777) then + if (activate_onoff_use > 0) then + if (iphase_of_aerosol(la) == ai_phase) then + lc = laicwpair_of_aerosol(la) + not_aicw = .false. + else if (iphase_of_aerosol(la) == cw_phase) then + cycle main_trans_la_loop + end if + end if + if ((lc < p1st) .or. (lc > num_chem_ecpp)) lc = -999888777 + m = isize_of_aerosol(la) ; if (m <= 0) m = -999888777 + n = itype_of_aerosol(la) ; if (n <= 0) n = -999888777 + + tmp_ardz = ardz_cen_old(k,icc,jcls) + tmp_ardzqa = chem_sub_old(k,icc,jcls,la)*tmp_ardz + tmp_ardzqc = 0.0_r8 + if (lc > 0) & + tmp_ardzqc = chem_sub_old(k,icc,jcls,lc)*tmp_ardz + +! subtract detrainment loss (no activation/resuspension here) + tmp_del_ardz = -det_airamt_tot(icc,jcls,k)*xntstep_sub_inv + if (tmp_del_ardz < 0.0_r8) then + tmp_ardz = tmp_ardz + tmp_del_ardz + tmp_ardzqa = tmp_ardzqa + chem_sub_old(k,icc,jcls,la)*tmp_del_ardz + tmphoriz(k,jcls,la) = tmphoriz(k,jcls,la) & + + chem_sub_old(k,icc,jcls,la)*tmp_del_ardz + if (lc > 0) then + tmp_ardzqc = tmp_ardzqc + chem_sub_old(k,icc,jcls,lc)*tmp_del_ardz + tmphoriz(k,jcls,lc) = tmphoriz(k,jcls,lc) & + + chem_sub_old(k,icc,jcls,lc)*tmp_del_ardz + end if + end if + +! add entrainment contributions (need activation/resuspension here) +! +!+++mhwang +! Calculate the fraction of entrainment that may expericence activations. +! (we assume only the new cloudy updraft may experience activation, and +! old updraft do not experience activation +! Minghuai Wang, 2010-05 + frc_ent_act = 1.0_r8 + if(mtype_updnenv_use(icc, jcls) == mtype_updraft_ecpp) then + abnd_up = 0.0_r8 + abnd_dn = 0.0_r8 + if(rhobnd_bar(k+1).gt.1.0e-10_r8) then + abnd_up = ar_bnd_tavg(k+1, icc, jcls)/rhobnd_bar(k+1) + end if + if(rhobnd_bar(k).gt.1.0e-10_r8) then + abnd_dn = ar_bnd_tavg(k, icc, jcls)/rhobnd_bar(k) + end if + if(k.eq.kts) then + frc_ent_act = 1.0_r8 + else if(abnd_up.gt.1.0e-5_r8) then + frc_ent_act = 1.0_r8 - min(1.0_r8, abnd_dn/abnd_up) + + if(mfbnd_use(k+1, icc, jcls).gt.1.0e-20_r8) then + frc_tmp = max(1.0e-5_r8, 1.0_r8-mfbnd_use(k, icc, jcls)/mfbnd_use(k+1, icc, jcls)) + frc_ent_act = min(1.0_r8, frc_ent_act / frc_tmp) + endif + end if + end if ! end mtype_updnenv_use +!---mhwang + + +entrain_jclsy_loop: & + do jclsy = 1, ncls_use +entrain_iccy_loop: & + do iccy = 1, 2 + tmp_del_ardz = ent_airamt(icc,jcls,iccy,jclsy,k)*xntstep_sub_inv + if (tmp_del_ardz <= 0.0_r8) cycle entrain_iccy_loop + + if ( not_aicw ) then + ido_actres_tmp = 0 + else + ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) + end if + + tmp_qyla = chem_sub_old(k,iccy,jclsy,la) + if (lc > 0) then + tmp_qylc = chem_sub_old(k,iccy,jclsy,lc) + else + tmp_qylc = 0.0_r8 + end if + tmp_ardz = tmp_ardz + tmp_del_ardz + + if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing +!+++mhwangtest +! turn activation in entrainment off +! ido_actres_tmp = 0 ! +++mhwangtest + + if (ido_actres_tmp == 0) then + ! non aicw-aerosol species OR no activation or resuspension + tmp_del_ardzqa = tmp_qyla*tmp_del_ardz + tmp_del_ardzqc = tmp_qylc*tmp_del_ardz + + else if (ido_actres_tmp > 0) then + ! activation of (la+lc) + if (inmw_of_aerosol(la) == 1) then +! tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) + tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) * frc_ent_act !+++mhwang + else +! tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) + tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) * frc_ent_act ! +++mhwang + end if + if (ido_actres_tmp == 2) then + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmp_del_ardz + tmp_del_ardzqc = (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmp_del_ardz + else + tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz + tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz + end if + + else + ! resuspension of lc + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz + tmp_del_ardzqc = 0.0_r8 + + end if + + tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa + tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc + tmphoriz(k,jcls,la) = tmphoriz(k,jcls,la) + tmp_del_ardzqa + if (lc > 0) & + tmphoriz(k,jcls,lc) = tmphoriz(k,jcls,lc) + tmp_del_ardzqc + +! change from activation/resuspension + tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) + if (lc > 0) & + tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) + + end do entrain_iccy_loop + end do entrain_jclsy_loop + + + if (jcls == jcls_qu) then +! quiescent class -- calc change to layer k mixrat due to vertical transport at lower boundary +! mfbnd_quiescn_up(k,icc1,icc2) is upwards mass flux from icc1 to icc2 +! at bottom of layer k +! mfbnd_quiescn_dn(k,icc1,icc2) is downwards ... +! activation/resuspension calcs +! k-1,clear to k,cloudy - do activation +! k-1,cloudy to k,clear - do resuspension +! k,either to k-1,either - are just calculating loss to k here, so no act/res needed +vert_botqu_iupdn_loop: & + do iupdn = 1, 2 + if (k <= kts) cycle vert_botqu_iupdn_loop ! skip k=kts +vert_botqu_iccy_loop: & + do iccy = 1, 2 + ! kb & iccy refer to the layer and sub-class from which + ! air and tracer mass are leaving + ido_actres_tmp = 0 + if (iupdn == 1) then + ! air is going from kb=k-1,iccb=iccy=1:2 to k,icc + tmp_del_ardz = mfbnd_quiescn_up(k,iccy,icc)*dtstep_sub + kb = k - 1 + iccb = iccy + if (not_aicw .eqv. .false.) then + if ((iccy == 1) .and. (icc == 2)) then + ido_actres_tmp = 1 + else if ((iccy == 2) .and. (icc == 1)) then + ido_actres_tmp = -1 + end if + end if + else + ! air is going from kb=k,iccb=icc to k-1,iccy=1:2 + ! since this is a loss from k, we can calc iccy=1&2 + ! together using mfbnd_quiescn_dn(k,icc,0) + if (iccy > 1) cycle vert_botqu_iccy_loop + tmp_del_ardz = mfbnd_quiescn_dn(k,icc,0)*dtstep_sub + kb = k + iccb = icc + end if + + if (tmp_del_ardz == 0.0_r8) cycle vert_botqu_iccy_loop + + tmp_qyla = chem_sub_old(kb,iccb,jcls,la) + if (lc > 0) then + tmp_qylc = chem_sub_old(kb,iccb,jcls,lc) + else + tmp_qylc = 0.0_r8 + end if + + tmp_ardz = tmp_ardz + tmp_del_ardz + + if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing +!+++mhwangtest +! turn activation in entrainment off +! ido_actres_tmp = 0 ! +++mhwangtest + if (ido_actres_tmp == 0) then + ! non aicw-aerosol species OR no activation or resuspension + tmp_del_ardzqa = tmp_qyla*tmp_del_ardz + tmp_del_ardzqc = tmp_qylc*tmp_del_ardz + + else if (ido_actres_tmp > 0) then + ! activation of (la+lc) + if (inmw_of_aerosol(la) == 1) then + tmp_fmnact = fnact_vert(m,n,k) + else + tmp_fmnact = fmact_vert(m,n,k) + end if + tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz + tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz + + else + ! resuspension of lc + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz + tmp_del_ardzqc = 0.0_r8 + + end if + + tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa + tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc + if (icc == 1) then + tmpverta(k,jcls,la) = tmpverta(k,jcls,la) + tmp_del_ardzqa + if (lc > 0) & + tmpverta(k,jcls,lc) = tmpverta(k,jcls,lc) + tmp_del_ardzqc + end if + +! change from activation/resuspension + tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) + if (lc > 0) & + tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) + + ! with "pgf90 -O2", code seg-faulted until following statement + ! was added. (note that it is do-nothing, since la>0 always) + if (la < 0) write(*,*) & + 'vert_botqu gggg - icc,iupdn,ido', iccy, iupdn, ido_actres_tmp + end do vert_botqu_iccy_loop + end do vert_botqu_iupdn_loop + +! quiescent class -- calc change to layer k mixrat due to vertical transport at upper boundary +! mfbnd_quiescn_up(k+1,icc1,icc2) is upwards mass flux from icc1 to icc2 +! at top of layer k +! mfbnd_quiescn_dn(k+1,icc1,icc2) is downwards ... +! activation/resuspension calcs +! k+1,clear to k,cloudy - downwards motion so skip activation ??? +! k+1,cloudy to k,clear - do resuspension +! k,either to k+1,either - are just calculating loss to k here, so no act/res needed +vert_topqu_iupdn_loop: & + do iupdn = 1, 2 + if (k >= ktebnd-1) cycle vert_topqu_iupdn_loop ! skip k=ktebnd-1,ktebnd +vert_topqu_iccy_loop: & + do iccy = 1, 2 + ido_actres_tmp = 0 + if (iupdn == 1) then + ! air is going from kb=k,iccb=icc to k+1,iccy=1:2 + ! since this is a loss from k, we can calc iccy=1&2 + ! together using mfbnd_quiescn_up(k+1,icc,0) + if (iccy > 1) cycle vert_topqu_iccy_loop + tmp_del_ardz = -mfbnd_quiescn_up(k+1,icc,0)*dtstep_sub + kb = k + iccb = icc + else + ! air is going from kb=k+1,iccb=iccy=1:2 to k,icc + tmp_del_ardz = -mfbnd_quiescn_dn(k+1,iccy,icc)*dtstep_sub + kb = k+1 + iccb = iccy + if (not_aicw .eqv. .false.) then + if ((iccy == 2) .and. (icc == 1)) then + ido_actres_tmp = -1 + end if + end if + end if + + if (tmp_del_ardz == 0.0_r8) cycle vert_topqu_iccy_loop + + tmp_qyla = chem_sub_old(kb,iccb,jcls,la) + if (lc > 0) then + tmp_qylc = chem_sub_old(kb,iccb,jcls,lc) + else + tmp_qylc = 0.0_r8 + end if + + tmp_ardz = tmp_ardz + tmp_del_ardz + + if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing +!+++mhwangtest +! turn activation in entrainment off +! ido_actres_tmp = 0 ! +++mhwangtest + if (ido_actres_tmp == 0) then + ! non aicw-aerosol species OR no activation or resuspension + tmp_del_ardzqa = tmp_qyla*tmp_del_ardz + tmp_del_ardzqc = tmp_qylc*tmp_del_ardz + + else if (ido_actres_tmp > 0) then + ! activation of (la+lc) + if (inmw_of_aerosol(la) == 1) then + tmp_fmnact = fnact_vert(m,n,k) + else + tmp_fmnact = fmact_vert(m,n,k) + end if + tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz + tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz + + else + ! resuspension of lc + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz + tmp_del_ardzqc = 0.0_r8 + + end if + + tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa + tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc + +! change from activation/resuspension + tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) + if (lc > 0) & + tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) + + ! with "pgf90 -O2", code seg-faulted until following statement + ! was added. (note that it is do-nothing, since la>0 always) + if (la < 0) write(*,*) & + 'vert_topqu gggg - icc,iupdn,ido', iccy, iupdn, ido_actres_tmp + end do vert_topqu_iccy_loop + end do vert_topqu_iupdn_loop + + + else +! up/dndraft class -- add/subtract vertical transport at lower boundary +! no activation/resuspension here as the vertical transport within up/dndrafts +! is clear-->clear or cloudy-->cloudy. (The within up/dndraft +! clear<-->cloudy is done by ent/detrainment.) + if (k > kts) then + tmp_del_ardz = mfbnd_use(k,icc,jcls)*dtstep_sub + if (abs(tmp_del_ardz) > 0.0_r8) then + if (tmp_del_ardz > 0.0_r8) then + kb = k - 1 + else + kb = k + end if + tmp_ardz = tmp_ardz + tmp_del_ardz + tmp_ardzqa = tmp_ardzqa + chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz + if (lc > 0) & + tmp_ardzqc = tmp_ardzqc + chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz + if (icc == 1) then + tmpverta(k,jcls,la) = chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz + if (lc > 0) & + tmpverta(k,jcls,lc) = chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz + end if + end if + end if ! (k > kts) +! up/dndraft class -- add/subtract vertical transport at upper boundary + if (k < ktebnd-1) then + tmp_del_ardz = -mfbnd_use(k+1,icc,jcls)*dtstep_sub + if (abs(tmp_del_ardz) > 0.0_r8) then + if (tmp_del_ardz > 0.0_r8) then + kb = k + 1 + else + kb = k + end if + tmp_ardz = tmp_ardz + tmp_del_ardz + tmp_ardzqa = tmp_ardzqa + chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz + if (lc > 0) & + tmp_ardzqc = tmp_ardzqc + chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz + end if + end if ! (k < ktebnd-1) + + end if ! (jcls == jcls_qu) + + +! new mixing ratio + chem_sub_new(k,icc,jcls,la) = tmp_ardzqa/ardz_cen_new(k,icc,jcls) + if (lc > 0) & + chem_sub_new(k,icc,jcls,lc) = tmp_ardzqc/ardz_cen_new(k,icc,jcls) + +! change in mixing ratio (*fraction) from activation/resuspension + del_activate3d(k,icc,jcls,la) = del_activate3d(k,icc,jcls,la)+tmp_del_ardzqa_act/rhodz_cen(k) + if (lc > 0) & + del_activate3d(k,icc,jcls,lc) = del_activate3d(k,icc,jcls,lc)+tmp_del_ardzqc_act/rhodz_cen(k) + + end do main_trans_la_loop + + end do main_trans_k_loop + end do main_trans_icc_loop + end do main_trans_jcls_loop + + +! fort.118 diagnostics + lun118 = -1 + if (idiag118_pt3 > 0) then + if (idiag118_pt3 >= 10) lun118 = ldiagaa_ecpp(118) + if (itstep_sub == ntstep_sub) lun118 = ldiagaa_ecpp(118) + end if + if (lun118 > 0) then + do l = param_first_ecpp, num_chem_ecpp + if ((l == 9) .or. (l == 9)) then + + write(lun118,'(/a,3i5)') 'new_main_integ pt3 ktau_pp, istep_sub, l =', ktau_pp, itstep_sub, l + write(lun118,'(2a)') & + '(chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=2,1,-1); ', & + 'updr ardz_cen_new and w; dumverta/b, dumhoriz for updr then env' + + icc = 1 + tmpc = 1.0_r8/dtstep_sub + do k = ktecen, kts, -1 + tmpa = 0.0_r8 + if (ar_bnd_tavg(k,icc,jgrp_up) > 0.0_r8) & + tmpa = mfbnd_use(k,icc,jgrp_up)/ar_bnd_tavg(k,icc,jgrp_up) + write(lun118,'(i3,1p,3(1x,2e10.3),2(1x,3e10.3))') k, & + ( chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=2,1,-1 ), & + ardz_cen_new(k,icc,jgrp_up), tmpa, & + ( tmpverta(k,jcls,l)*tmpc, & + (tmpverta(k,jcls,l)-tmpverta(k+1,jcls,l))*tmpc, & + tmphoriz(k,jcls,l)*tmpc, jcls=2,1,-1 ) + end do ! k + + end if ! (l == ...) + end do ! l + end if ! (lun118 > 0) + + call t_stopf('ecpp_vertical') + + end do main_itstep_sub_loop + +! +! +++mhwang +! move cloud chemistry and wetscavenging outside of istep_sub_loop +! inside of the itstep_sub_loop is too expanseive +! Minghuai Wang, 2010-04-28 +! + itstep_sub = 1 + dtstep_sub = dtstep_pp + +! calculate cloud chemistry changes to chem_sub over one time sub-step +! call t_startf('ecpp_cldchem') +! call parampollu_tdx_cldchem( & +! ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & +! itstep_hybrid, & +! idiagaa_ecpp, ldiagaa_ecpp, & +! tcen_bar, pcen_bar, rhocen_bar, dzcen, & +! rhobnd_bar, zbnd, wbnd_bar, & +! chem_bar, & +! ncls_ecpp, & +! it, jt, kts,ktebnd,ktecen, & +! ncls_use, & +! kdraft_bot_use, kdraft_top_use, & +! mtype_updnenv_use, & +! chem_sub_new, & +! del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & +! aqso4_h2o2, aqso4_o3, xphlwc3d, & +! ardz_cen_old, ardz_cen_new, rhodz_cen, & +! acen_tavg_use, acen_prec_use, & +! rh_sub2, qcloud_sub2, qlsink_sub2, & +! precr_sub2, precs_sub2, & +! chem_bar_iccfactor, activate_onoff_use, & +! iphase_of_aerosol, isize_of_aerosol, & +! itype_of_aerosol, inmw_of_aerosol, & +! laicwpair_of_aerosol ) +! call t_stopf('ecpp_cldchem') + + +! calculate wet removal changes to chem_sub over one time sub-step + + if (wetscav_onoff_ecpp >= 100) then + call t_startf('ecpp_wetscav') +! write(*,'(a,3i8)') 'main integ calling wetscav_2', ktau, ktau_pp, itstep_sub + call parampollu_tdx_wetscav_2( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + itstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & +! rhobnd_bar, zbnd, wbnd_bar, & not needed ? +! chem_bar, & not needed ? +! ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & +! kdraft_bot_use, kdraft_top_use, & not needed ? +! mtype_updnenv_use, & not needed ? + chem_sub_new, & + del_chem_clm_wetscav, & + del_wetscav3d, del_wetresu3d, & +! ardz_cen_old, ardz_cen_new, & not needed ? + rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & +! chem_bar_iccfactor, & not needed ? + activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) +! write(*,'(a,3i8)') 'main integ backfrm wetscav_2', ktau, ktau_pp, itstep_sub + call t_stopf('ecpp_wetscav') + end if ! (wetscav_onoff_ecpp >= 100) + +! calculate cloud chemistry changes to chem_sub over one time sub-step + call t_startf('ecpp_cldchem') + call parampollu_tdx_cldchem( & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + itstep_hybrid, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & + aqso4_h2o2, aqso4_o3, xphlwc3d, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + acen_tavg_use, acen_prec_use, & + rh_sub2, qcloud_sub2, qlsink_sub2, & + precr_sub2, precs_sub2, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol, pbuf ) + call t_stopf('ecpp_cldchem') + +! end do main_itstep_sub_loop + + call t_stopf('ecpp_mainintegr') + + + return + end subroutine parampollu_tdx_main_integ + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_area_change( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ipass_area_change, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + del_activate3d, & + mfbnd_use, ar_bnd_tavg, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + chem_bar_iccfactor, activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_area_change does +! horizontal exchange associated with sub-class area changes +! +! incoming chem_sub_new holds current sub-class mixing ratios +! outgoing chem_sub_new holds updated sub-class mixing ratios +! +!----------------------------------------------------------------------- + + use module_data_radm2, only: epsilc + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + maxd_asize, maxd_atype + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, wbnd_bar +! tcen_bar - temperature (K) at layer centers +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! pcen_bar - air pressure (Pa) at layer centers +! wbnd_bar - vertical velocity (m/s) at layer boundaries +! dzcen - layer thicknesses (m) + + real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + integer, intent(inout) :: ipass_area_change + integer, intent(in) :: ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_new + + real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3d + + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + mfbnd_use, ar_bnd_tavg + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + ardz_cen_old, ardz_cen_new + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + + +! local variables + integer :: icc, iccy, ido_actres_tmp, ifrom_where, itmpa + integer :: idiag118_pt3 + integer :: jcls, jclsy + integer :: k + integer :: l, la, laa, lbb, lc, lun118 + integer :: m, n + integer :: p1st + + integer, dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & + ido_actres_horz + + logical :: not_aicw + + real(r8) :: ardz_cut + real(r8) :: tmpa, tmpb, tmpc, tmpd + real(r8) :: tmp_fmnact, tmp_qyla, tmp_qylc + real(r8) :: tmpvecd(0:maxcls_ecpp), tmpvece(0:maxcls_ecpp) + real(r8) :: tmp_del_ardzqa, tmp_del_ardzqc + real(r8) :: tmp_del_ardzqa_act, tmp_del_ardzqc_act + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_old + real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_tot, det_airamt_tot + real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt, det_airamt + real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + fmact_horz, fnact_horz + + + + p1st = param_first_ecpp + idiag118_pt3 = 10 * mod( max(idiagaa_ecpp(118),0)/100, 10 ) + +! +! calc entrain/detrain amounts +! +! first calc net (entrainment-detrainment) amount = area change + ent_airamt_tot(:,:,:) = 0.0_r8 + det_airamt_tot(:,:,:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + tmpa = max( ardz_cen_new(k,icc,jcls), ardz_cen_old(k,icc,jcls) ) + if (tmpa >= ardz_cut) then + tmpb = ardz_cen_new(k,icc,jcls) - ardz_cen_old(k,icc,jcls) + if (tmpb > 0.0_r8) then + ent_airamt_tot(icc,jcls,k) = tmpb + else if (tmpb < 0.0_r8) then + det_airamt_tot(icc,jcls,k) = -tmpb + end if + end if + end do + end do + end do + +! next calc detailed ent/det amounts + ifrom_where = ipass_area_change + call parampollu_tdx_entdet_sub1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + ent_airamt_tot, det_airamt_tot, & + ent_airamt, det_airamt ) + + +! +! calc activation/resuspension fractions associated with ent/det +! + if (activate_onoff_use > 0) then + ifrom_where = ipass_area_change + call parampollu_tdx_activate1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, wbnd_bar, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, activate_onoff_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + chem_sub_new, & + mfbnd_use, & + ar_bnd_tavg, & + ent_airamt, & + ido_actres_horz, fmact_horz, fnact_horz ) + end if + + +! copy chem_sub_new (= incoming current chem_sub values) into chem_sub_old + chem_sub_old(:,:,:,:) = chem_sub_new(:,:,:,:) + +! calculate new chem_sub +main_jcls_loop: & + do jcls = 1, ncls_use +main_icc_loop: & + do icc = 1, 2 +main_k_loop: & + do k = kts, ktecen + +! if entrainment and detrainment) both ~= 0, then no change + if ( (ent_airamt_tot(icc,jcls,k) < 1.0e-30_r8) .and. & + (det_airamt_tot(icc,jcls,k) < 1.0e-30_r8) ) cycle + +! if new area ~= 0, then just set chem_sub_new to chem_bar + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + if (ardz_cen_new(k,icc,jcls) < ardz_cut) then + do l = p1st, num_chem_ecpp + chem_sub_new(k,icc,jcls,l) = & + chem_bar(k,l)*chem_bar_iccfactor(icc,l) + end do + cycle main_k_loop + end if + +! la loop goes over all species +! for la = non-aerosol species, loop is executed with lc=0 +! for la = interstitial aerosol species, loop is excecuted with +! lc=activated counterpart +! for la = activated aerosol species, loop is skipped +main_la_loop: & + do la = p1st, num_chem_ecpp + + tmp_del_ardzqa_act = 0.0_r8 + tmp_del_ardzqc_act = 0.0_r8 + + lc = 0 + not_aicw = .true. + if (activate_onoff_use > 0) then + if (iphase_of_aerosol(la) == ai_phase) then + lc = laicwpair_of_aerosol(la) + not_aicw = .false. + else if (iphase_of_aerosol(la) == cw_phase) then + cycle main_la_loop + end if + end if + if ((lc < p1st) .or. (lc > num_chem_ecpp)) lc = -999888777 + +! tmpd = (original area) - (detrainment to all others) + tmpd = ardz_cen_old(k,icc,jcls) - det_airamt_tot(icc,jcls,k) + tmpd = max( tmpd, 0.0_r8 ) + +! tmpa holds sum_of( mix_ratio * area ) for interstitial +! tmpc holds sum_of( mix_ratio * area ) for activated + tmpa = chem_sub_old(k,icc,jcls,la)*tmpd + if (lc > 0) & + tmpc = chem_sub_old(k,icc,jcls,lc)*tmpd + +! add entrainment contributions + do jclsy = 1, ncls_use + do iccy = 1, 2 + tmpd = ent_airamt(icc,jcls,iccy,jclsy,k) + if (tmpd <= 0.0_r8) cycle + + if ( not_aicw ) then + ido_actres_tmp = 0 + else + ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) + end if + + tmp_qyla = chem_sub_old(k,iccy,jclsy,la) + if (lc > 0) then + tmp_qylc = chem_sub_old(k,iccy,jclsy,lc) + else + tmp_qylc = 0.0_r8 + end if + + if (ido_actres_tmp == 0) then + ! non aicw-aerosol species OR no activation or resuspension +! tmpa = tmpa + tmp_qyla*tmpd +! tmpc = tmpc + tmp_qylc*tmpd + tmp_del_ardzqa = tmp_qyla*tmpd + tmp_del_ardzqc = tmp_qylc*tmpd + + else if (ido_actres_tmp > 0) then + ! activation of (la+lc) + m = isize_of_aerosol(la) + n = itype_of_aerosol(la) + if (inmw_of_aerosol(la) == 1) then + tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) + else + tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) + end if + if (ido_actres_tmp == 2) then +! tmpa = tmpa + (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmpd +! tmpc = tmpc + (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmpd + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmpd + tmp_del_ardzqc = (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmpd + else +! tmpa = tmpa + (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmpd +! tmpc = tmpc + (tmp_qyla*tmp_fmnact + tmp_qylc)*tmpd + tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmpd + tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmpd + end if + + else + ! resuspension of lc +! tmpa = tmpa + (tmp_qyla+tmp_qylc)*tmpd + tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmpd + tmp_del_ardzqc = 0.0_r8 + + end if + tmpa = tmpa + tmp_del_ardzqa + if (lc > 0) & + tmpc = tmpc + tmp_del_ardzqc + +! change from activation/resuspension + tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmpd) + if (lc > 0) & + tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmpd) + end do ! iccy + end do ! jclsy + chem_sub_new(k,icc,jcls,la) = tmpa/ardz_cen_new(k,icc,jcls) + if (lc > 0) & + chem_sub_new(k,icc,jcls,lc) = tmpc/ardz_cen_new(k,icc,jcls) + +! change in mixing ratio (*fraction) from activation/resuspension + del_activate3d(k,icc,jcls,la) = del_activate3d(k,icc,jcls,la)+tmp_del_ardzqa_act/rhodz_cen(k) + if (lc > 0) & + del_activate3d(k,icc,jcls,lc) = del_activate3d(k,icc,jcls,lc)+tmp_del_ardzqc_act/rhodz_cen(k) + + end do main_la_loop + + end do main_k_loop + end do main_icc_loop + end do main_jcls_loop + + +! diagnostics + lun118 = -1 + if (idiag118_pt3 >= 10) lun118 = ldiagaa_ecpp(118) + if (lun118 > 0) then + l = 9 + icc = 1 + write(lun118,'(/a,2i5,a,3i5)') 'pt3 ppopt, ipass', parampollu_opt, & + ipass_area_change, ' ktau_pp, istep_sub, l =', ktau_pp, -1, l + write(lun118,'(2a)') '(chem_sub_old(k,icc,jcls,l), ', & + 'chem_sub_new(k,icc,jcls,l), jcls=1,3); up,dn,env a_cen_tmpa/tmpb' + do k = ktecen, kts, -1 + write(lun118,'(i3,1p,7(1x,2e10.3))') k, & + (chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=1,3), & + (ardz_cen_old(k,icc,jcls)/rhodz_cen(k), ardz_cen_new(k,icc,jcls)/rhodz_cen(k), jcls=1,3) + end do + end if ! (lun118 > 0) + + + + return + end subroutine parampollu_tdx_area_change + + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_entdet_sub1( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + ncls_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, ifrom_where, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + ardz_cen_old, ardz_cen_new, rhodz_cen, & + ent_airamt_tot, det_airamt_tot, & + ent_airamt, det_airamt ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_entdet_sub1 calculates +! the "horizontal exchange coefficients" associated with +! area changes or vertical mass fluxes +! +! the net (entrainment-detrainment) for each sub-class is +! obtained trivially +! determining where the entrainment comes from, and where +! the detrainment goes to, is much more involved +! +!----------------------------------------------------------------------- + + use module_data_radm2, only: epsilc + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + integer, intent(in) :: ifrom_where + integer, intent(in) :: ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + ardz_cen_old, ardz_cen_new + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + real(r8), intent(inout), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_tot, det_airamt_tot +! ent_airamt_tot(icc,jcls,k) is the total detrainment into layer k, +! sub-class icc, class jcls from all other sub-classes +! det_airamt_tot(icc,jcls,k) is the total detrainment from layer k, +! sub-class icc, class jcls to all other sub-classes +! units are (kg/m2) +! +! define entdet_net == ent_airamt_tot - det_airamt_tot +! for "area-change" ent/det, entdet_net = rho*dz*d(area) where +! d(area) is the fractional area change over the time-step +! for "vertical-transport" ent/det, entdet_net = d(mfbnd)*dtstep where +! d(mfbnd) is the change in vertical mass flux across a layer +! (mfbnd at layer top minus mfbnd at layer bottom) +! +! up and dndrafts +! in the current formulation, each draft either entrains or detrains +! at a given level, but not both simultaneously +! for incoming ent/det_airamt_tot, one will be >= 0 and the other will be =0 +! the outgoing ent/det_airamt_tot will be unchanged +! quiescent class +! the quiescent class can entrain and detrain simultaneously at a given level +! for incoming ent/det_airamt_tot, one will be >= 0 and will hold the +! net (entrainment-detrainment) +! the outgoing ent/det_airamt_tot can both be >0 +! + + real(r8), intent(out), & + dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt, det_airamt +! ent_airamt(iccaa,jclsaa,iccbb,jclsbb,k) is (positive) the entrainment amount +! into sub-class (iccaa,jclsaa,k) from sub-class (iccbb,jclsbb,k) +! det_airamt(iccaa,jclsaa,iccbb,jclsbb,k) is (positive) the detrainment amount +! from sub-class (iccaa,jclsaa,k) into sub-class (iccbb,jclsbb,k) +! units for both are (kg/m2) + + +! local variables + integer :: icc, iccy, itmpa + integer :: jcls, jclsy + integer :: jgrp, jgrpy, jgrp_of_jcls(1:maxcls_ecpp) + integer :: k + integer :: l, laa, lbb, lunaa, lunbb + integer :: m + + logical, dimension( 1:2, 1:maxcls_ecpp ) :: & + empty_old, empty_new, empty_oldnew + + real(r8) :: tmpa4, tmpb4 + + real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_sv1, det_airamt_sv1 + real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_tot_sv0, det_airamt_tot_sv0, & + ent_airamt_tot_sv1, det_airamt_tot_sv1 + real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & + ecls_aa, dcls_aa + real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & + ecls_aaunasi, dcls_aaunasi + real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & + dcls_aalimit + real(r8), dimension( 1:2, 1:3, 1:2, 1:3 ) :: & + egrp_aa, dgrp_aa + real(r8), dimension( 1:2, 1:3 ) :: & + egrp_aaunasi, dgrp_aaunasi + + real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ecls_aaunasi_sv2, dcls_aaunasi_sv2 + real(r8), dimension( 1:2, 1:3, kts:ktecen ) :: & + egrp_aaunasi_sv2, dgrp_aaunasi_sv2 + + integer, dimension(3), save :: & + ecls_aaunasi_worst_i=0, dcls_aaunasi_worst_i=0, & + ecls_aaunasi_worst_j=0, dcls_aaunasi_worst_j=0, & + ecls_aaunasi_worst_k=0, dcls_aaunasi_worst_k=0, & + ecls_aaunasi_worst_ktau=0, dcls_aaunasi_worst_ktau=0, & + egrp_aaunasi_worst_i=0, dgrp_aaunasi_worst_i=0, & + egrp_aaunasi_worst_j=0, dgrp_aaunasi_worst_j=0, & + egrp_aaunasi_worst_k=0, dgrp_aaunasi_worst_k=0, & + egrp_aaunasi_worst_ktau=0, dgrp_aaunasi_worst_ktau=0 + real(r8), dimension(3), save :: & + ecls_aaunasi_worst=0.0_r8, dcls_aaunasi_worst=0.0_r8, & + egrp_aaunasi_worst=0.0_r8, dgrp_aaunasi_worst=0.0_r8 + + real(r8) :: ardz_cut + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf + real(r8) :: tmpmatbb(0:2,0:2) + real(r8) :: tmpmatff(1:2,1:2) + real(r8) :: tmpvecbb(0:maxcls_ecpp), tmpvecgg(0:maxcls_ecpp) + + +! diagnostics to fort.122 at selected timesteps + lunaa = -1 +! if ( (ktau <= 10) .or. & +! (ktau == 581) .or. & +! (ktau == 818) ) lunaa = 122 + if ( (ktau <= 10) .or. & + (ktau == 210) .or. & + (ktau == 682) ) lunaa = ldiagaa_ecpp(122) + if (idiagaa_ecpp(122) <= 0) lunaa = -1 + +! save the incoming values of ent/det_airamt_tot + ent_airamt_tot_sv0(:,:,:) = ent_airamt_tot(:,:,:) + det_airamt_tot_sv0(:,:,:) = det_airamt_tot(:,:,:) + +! +! do a very simple calculation that mimics previous code +! up and dndrafts entrain-from and detrain-too +! the quiescent class with the same icc +! (currently the simple calculation results are only used for diagnostic +! purposes, but turning them off would mess up the diagnostics.) +! + ent_airamt(:,:,:,:,:) = 0.0_r8 + det_airamt(:,:,:,:,:) = 0.0_r8 + +entdet_main_kloop_bb: & + do k = kts, ktecen + + do jcls = 1, ncls_use + do icc = 1, 2 + if (jcls == jcls_qu) cycle ! skip quiescent + + tmpa4 = ent_airamt_tot(icc,jcls,k) + if (tmpa4 > 0.0_r8) then + ent_airamt( icc,jcls, icc,jcls_qu, k) = tmpa4 + det_airamt( icc,jcls_qu, icc,jcls, k) = tmpa4 + end if + + tmpa4 = det_airamt_tot(icc,jcls,k) + if (tmpa4 > 0.0_r8) then + det_airamt( icc,jcls, icc,jcls_qu, k) = tmpa4 + ent_airamt( icc,jcls_qu, icc,jcls, k) = tmpa4 + end if + + end do ! icc + end do ! jcls + + end do entdet_main_kloop_bb + + + do k = kts, ktecen + + do jcls = 1, ncls_use + do icc = 1, 2 + tmpa4 = 0.0_r8 + tmpb4 = 0.0_r8 + if (k < ktebnd) then + do jclsy = 1, ncls_use + do iccy = 1, 2 + tmpa4 = tmpa4 + ent_airamt( icc,jcls, iccy,jclsy, k) + tmpb4 = tmpb4 + det_airamt( icc,jcls, iccy,jclsy, k) + end do + end do + end if + ent_airamt_tot(icc,jcls,k) = tmpa4 + det_airamt_tot(icc,jcls,k) = tmpb4 + end do ! icc + end do ! jcls + + end do ! k + + ent_airamt_sv1(:,:,:,:,:) = ent_airamt(:,:,:,:,:) + det_airamt_sv1(:,:,:,:,:) = det_airamt(:,:,:,:,:) + ent_airamt_tot_sv1(:,:,:) = ent_airamt_tot(:,:,:) + det_airamt_tot_sv1(:,:,:) = det_airamt_tot(:,:,:) +! end of simple calculation + + + +! +! +! do the full calculation of horizontal exchanges +! +! + +! reload the incoming values of ent/det_airamt_tot + ent_airamt_tot(:,:,:) = ent_airamt_tot_sv0(:,:,:) + det_airamt_tot(:,:,:) = det_airamt_tot_sv0(:,:,:) + +! calc the jgrp_of_jcls array + icc = 1 + do jcls = 1, ncls_use + if (mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) then + jgrp_of_jcls(jcls) = 1 + else if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then + jgrp_of_jcls(jcls) = 2 + else + jgrp_of_jcls(jcls) = 3 + end if + end do + if (lunaa > 0) write(lunaa,'(a,10(2x,2i3))') & + 'jcls and jgrp_of_cls', (jcls, jgrp_of_jcls(jcls), jcls=1,ncls_use) + + ent_airamt(:,:,:,:,:) = 0.0_r8 + det_airamt(:,:,:,:,:) = 0.0_r8 + + ecls_aaunasi_sv2(:,:,:) = 0.0_r8 + egrp_aaunasi_sv2(:,:,:) = 0.0_r8 + dcls_aaunasi_sv2(:,:,:) = 0.0_r8 + dgrp_aaunasi_sv2(:,:,:) = 0.0_r8 + + +entdet_main_kloop_aa: & + do k = kts, ktecen + + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + + empty_old(:,:) = .false. + empty_new(:,:) = .false. + empty_oldnew(:,:) = .false. + if (lunaa > 0) write(lunaa,'(/a)') 'k, jcls, emptyold/new/oldnew for icc=1 then icc=2' + do jcls = 1, ncls_use + do icc = 1, 2 + if (ardz_cen_old(k,icc,jcls) < ardz_cut) empty_old(icc,jcls) = .true. + if (ardz_cen_new(k,icc,jcls) < ardz_cut) empty_new(icc,jcls) = .true. + empty_oldnew(icc,jcls) = empty_old(icc,jcls) .and. empty_new(icc,jcls) + end do + if (lunaa > 0) write(lunaa,'(2i3,2(3x,3l3))') k, jcls, & + (empty_old(icc,jcls), empty_new(icc,jcls), empty_oldnew(icc,jcls), icc=1,2) + end do + + if (lunaa > 0) then + write(lunaa,'(/a,1p,10e16.8)') 'ardz_cut,rdz', ardz_cut, rhodz_cen(k) + write(lunaa,'( a,1p,10e16.8)') 'ardz_cen_old', ardz_cen_old(k,0,0), ardz_cen_old(k,1:2,1:3) + write(lunaa,'( a,1p,10e16.8)') 'ardz_cen_new', ardz_cen_new(k,0,0), ardz_cen_new(k,1:2,1:3) + write(lunaa,'( a,1p,10e16.8)') 'new-old ', (ardz_cen_new(k,0,0)-ardz_cen_new(k,0,0)), & + (ardz_cen_new(k,1:2,1:3)-ardz_cen_old(k,1:2,1:3)) + tmpa = 1.0_r8/rhodz_cen(k) + tmpb = sum( ardz_cen_old(k,1:2,1:3) ) + tmpc = sum( ardz_cen_new(k,1:2,1:3) ) + write(lunaa,'( a,1p,10e16.8)') 'area_cen_old', tmpa*tmpb, tmpa*ardz_cen_old(k,1:2,1:3) + write(lunaa,'( a,1p,10e16.8)') 'area_cen_new', tmpa*tmpc, tmpa*ardz_cen_new(k,1:2,1:3) + write(lunaa,'( a,1p,10e16.8)') 'new-old ', tmpa*(tmpc-tmpb), & + tmpa*(ardz_cen_new(k,1:2,1:3)-ardz_cen_old(k,1:2,1:3)) + write(lunaa,'( a/1p,4(1x,3e11.3))') 'ardz_cen_old(0:2,0:3)', ardz_cen_old(k,0:2,0:3) + write(lunaa,'( a/1p,4(1x,3e11.3))') 'ardz_cen_new(0:2,0:3)', ardz_cen_new(k,0:2,0:3) + end if + + +! step 1 +! initialize class and group "assigned" ent/det arrays to zero +! initialize class "unassigned" ent/det arrays to ent/det_airamt_tot +! calc group "unassigned" arrays by summing over classes +! +! *************************************************************** +! should check here that total ent = total det (with very small error allowed) +! then adjust them to be even closer +! *************************************************************** + ecls_aa(:,:,:,:) = 0.0_r8 + dcls_aa(:,:,:,:) = 0.0_r8 + egrp_aa(:,:,:,:) = 0.0_r8 + dgrp_aa(:,:,:,:) = 0.0_r8 + egrp_aaunasi( :,:) = 0.0_r8 + dgrp_aaunasi( :,:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + ecls_aaunasi(icc,jcls) = ent_airamt_tot(icc,jcls,k) + dcls_aaunasi(icc,jcls) = det_airamt_tot(icc,jcls,k) + jgrp = jgrp_of_jcls(jcls) + egrp_aaunasi(icc,jgrp) = egrp_aaunasi(icc,jgrp) + ecls_aaunasi(icc,jcls) + dgrp_aaunasi(icc,jgrp) = dgrp_aaunasi(icc,jgrp) + dcls_aaunasi(icc,jcls) + if (ifrom_where < 10) then + ! for area-change, detrainment is limited to initial subarea mass + dcls_aalimit(icc,jcls) = ardz_cen_old(k,icc,jcls) + else + dcls_aalimit(icc,jcls) = 1.0e30_r8 + end if + end do + end do + call parampollu_tdx_entdet_diag01( & + 1, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + +! step 2 +! for up and dndrafts, if cloudy is entraining and clear is detraining +! (or vice-versa), then assign as much as possible of the ent/det +! as "clear up/dndraft" <--> "cloudy up/dndraft" + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle + jgrp = jgrp_of_jcls(jcls) + jclsy = jcls + jgrpy = jgrp_of_jcls(jclsy) + do icc = 1, 2 + iccy = 3 - icc + if ( empty_old(icc ,jcls ) ) cycle + if ( empty_new(iccy,jclsy) ) cycle + tmpa = min( dcls_aaunasi(icc,jcls), ecls_aaunasi(iccy,jcls) ) + if (tmpa > 0.0_r8) then + dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa + ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa + dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa + dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa + ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa + + dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa + egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa + dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa + egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa + end if + end do ! icc + end do ! jcls + call parampollu_tdx_entdet_diag01( & + 2, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + +! step 3 +! for up and dndraft detrainment, assign as much as possible of the det +! as "clear up/dndraft" <--> "clear quiescent" +! and "cloudy up/dndraft" <--> "cloudy quiescent" + do icc = 1, 2 + iccy = icc + jclsy = jcls_qu + jgrpy = jgrp_of_jcls(jclsy) + + ! tmpb = unassigned detrain from all up/dndraft + tmpb = dgrp_aaunasi(icc,2) + dgrp_aaunasi(icc,3) + ! tmpc = portion of tmpb that will be assigned in this step + tmpc = min( tmpb, egrp_aaunasi(icc,1) ) + if (tmpc <= 0.0_r8) cycle + + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle + if ( empty_old(icc ,jcls ) ) cycle + if ( empty_new(iccy,jclsy) ) cycle + jgrp = jgrp_of_jcls(jcls ) + + ! tmpf is fraction of total-unassigned-draft detrainment due to this jcls + tmpf = min( dcls_aaunasi(icc,jcls), tmpb ) / max( 1.0e-30_r8, tmpb ) + ! tmpa is portion of tmpc applied to this jcls + tmpa = tmpf*tmpc + tmpa = min( tmpa, dcls_aaunasi(icc ,jcls ), ecls_aaunasi(iccy,jclsy) ) + if (tmpa > 0.0_r8) then + dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa + ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa + dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa + dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa + ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa + + dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa + egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa + dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa + egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa + end if + end do ! icc + end do ! jcls + call parampollu_tdx_entdet_diag01( & + 3, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + +! step 4 +! for up and dndraft detrainment, assign any remaining detrainment to +! quiescent based on the clear/cloudy quiescent areas + + ! tmpvecgg(1) = fraction of quiescent class that is clear (using new areas) + tmpvecgg(1) = ardz_cen_new(k,1,jcls_qu)/ardz_cen_new(k,0,jcls_qu) + tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) + ! tmpvecgg(2) = fraction of quiescent class that is cloudy (using new areas) + tmpvecgg(2) = 1.0_r8 - tmpvecgg(1) + tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) + + ! tmpmatbb(0,0) = unassigned detrain from all up/dndraft + ! tmpmatbb(1,0) = portion of tmpmatbb(0,0) from clear draft to all quiescent + tmpmatbb(1,0) = sum( dgrp_aaunasi(1,2:3) ) + ! tmpmatbb(2,0) = portion of tmpmatbb(0,0) from cloudy draft to all quiescent + tmpmatbb(2,0) = sum( dgrp_aaunasi(2,2:3) ) + tmpmatbb(0,0) = tmpmatbb(1,0) + tmpmatbb(2,0) + + if (tmpmatbb(0,0) > 1.0e-30_r8) then + + ! tmpmatbb(0,1) = portion of tmpmatbb(0,0) from all draft to clear quiescent + ! tmpmatbb(0,2) = portion of tmpmatbb(0,0) from all draft to cloudy quiescent + tmpmatbb(0,1:2) = tmpmatbb(0,0)*tmpvecgg(1:2) + + ! this step can drive the ecls_aaunasi of a quiescent negative, + ! and the negative entrainment gets converted to positive detrainment + ! (from one quiescent subarea to the other) + ! when doing area-change, check that this will not make + ! dcls_aaunasi exceed dcls_aalimit + if (ifrom_where < 10) then + tmpvecbb(1:2) = tmpmatbb(0,1:2) + jclsy = jcls_qu + do iccy = 2, 1, -1 + if (tmpvecbb(iccy) > ecls_aaunasi(iccy,jclsy)) then + tmpd = dcls_aaunasi(iccy,jclsy) & + + (tmpvecbb(iccy) - ecls_aaunasi(iccy,jclsy)) + if (tmpd > dcls_aalimit(iccy,jclsy)) then + tmpvecbb(iccy) = tmpvecbb(iccy) & + - (tmpd - dcls_aalimit(iccy,jclsy)) + tmpvecbb(iccy) = max( 0.0_r8, tmpvecbb(iccy) ) + tmpvecbb(3-iccy) = tmpmatbb(0,0) - tmpvecbb(iccy) + end if + end if + end do + tmpmatbb(0,1:2) = tmpvecbb(1:2) + end if + + ! tmpmatbb(1,1) = portion of tmpmatbb(0,0) from clear draft to clear quiescent + tmpmatbb(1,1) = min( tmpmatbb(0,1), tmpmatbb(1,0) ) + ! tmpmatbb(1,2) = portion of tmpmatbb(0,0) from clear draft to cloudy quiescent + tmpmatbb(1,2) = max( 0.0_r8, (tmpmatbb(1,0) - tmpmatbb(1,1)) ) + + ! tmpmatbb(2,2) = portion of tmpmatbb(0,0) from cloudy draft to cloudy quiescent + tmpmatbb(2,2) = min( tmpmatbb(0,2), tmpmatbb(2,0) ) + ! tmpmatbb(2,1) = portion of tmpmatbb(0,0) from cloudy draft to clear quiescent + tmpmatbb(2,1) = max( 0.0_r8, (tmpmatbb(2,0) - tmpmatbb(2,2)) ) + + tmpmatff(1,2) = tmpmatbb(1,2) / max( 1.0e-37_r8, tmpmatbb(1,0) ) + tmpmatff(1,2) = max( 0.0_r8, min( 1.0_r8, tmpmatff(1,2) ) ) + tmpmatff(1,1) = 1.0_r8 - tmpmatff(1,2) + tmpmatff(1,1) = max( 0.0_r8, min( 1.0_r8, tmpmatff(1,1) ) ) + + tmpmatff(2,2) = tmpmatbb(2,2) / max( 1.0e-37_r8, tmpmatbb(2,0) ) + tmpmatff(2,2) = max( 0.0_r8, min( 1.0_r8, tmpmatff(2,2) ) ) + tmpmatff(2,1) = 1.0_r8 - tmpmatff(2,2) + tmpmatff(2,1) = max( 0.0_r8, min( 1.0_r8, tmpmatff(2,1) ) ) + +! *** now need to apply these *** + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle ! do jcls + jgrp = jgrp_of_jcls(jcls) + jclsy = jcls_qu + jgrpy = jgrp_of_jcls(jclsy) + do icc = 1, 2 + tmpc = dcls_aaunasi(icc,jcls) + if (tmpc <= 0.0_r8) cycle ! do icc + + do iccy = 1, 2 + if ( empty_old(icc,jcls) ) cycle ! do iccy + if ( empty_new(iccy,jclsy) ) cycle ! do iccy + + tmpa = tmpmatff(icc,iccy) * tmpc + if (tmpa <= 0.0_r8) cycle ! do iccy + + dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa + ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa + dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa + dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa + ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa + + dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa + egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa + dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa + egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa + + ! if unassigned entrainment from quiescent goes negative, + ! convert this to positive unassigned detrainment + if (ecls_aaunasi(iccy,jclsy) < 0.0_r8) then + dcls_aaunasi(iccy,jclsy) = dcls_aaunasi(iccy,jclsy) - ecls_aaunasi(iccy,jclsy) + ecls_aaunasi(iccy,jclsy) = 0.0_r8 + end if + if (egrp_aaunasi(iccy,jgrpy) < 0.0_r8) then + dgrp_aaunasi(iccy,jgrpy) = dgrp_aaunasi(iccy,jgrpy) - egrp_aaunasi(iccy,jgrpy) + egrp_aaunasi(iccy,jgrpy) = 0.0_r8 + end if + end do ! iccy + end do ! icc + end do ! jcls + + end if ! (tmpmatbb(0,0) > 1.0e-30_r8) + call parampollu_tdx_entdet_diag01( & + 4, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + +! step 5 +! up and dndraft entrainment +! do this in a much simpler manner +! all up and dndraft entrainment comes from quiescent +! contributions from clear and cloudy quiescent are proportional to +! their fractional areas (tmpvecgg(1) & tmpvecgg(2)) + ! tmpvecgg(1) = fraction of quiescent class that is clear (using old areas) + tmpvecgg(1) = ardz_cen_old(k,1,jcls_qu)/ardz_cen_old(k,0,jcls_qu) + tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) + ! tmpvecgg(2) = fraction of quiescent class that is cloudy (using old areas) + tmpvecgg(2) = 1.0_r8 - tmpvecgg(1) + tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) + + jclsy = jcls_qu + jgrpy = jgrp_of_jcls(jclsy) + + ! when doing area-change, check that this will not make + ! dcls_aalimit negative for either quiescent subarea + if (ifrom_where < 10) then + ! total unassigned entrainment to up/dndrafts + tmpa = sum( egrp_aaunasi(1:2,2:3) ) + ! amount of detrainment that will come from quiescent iccy=1,2 + tmpvecbb(1:2) = tmpa*tmpvecgg(1:2) + jclsy = jcls_qu + do iccy = 2, 1, -1 + if (tmpvecbb(iccy) > dcls_aalimit(iccy,jclsy)) then + tmpvecbb(iccy) = dcls_aalimit(iccy,jclsy) + tmpvecbb(3-iccy) = tmpa - tmpvecbb(iccy) + end if + end do + tmpvecgg(2) = tmpvecbb(2)/max( 1.0e-37_r8, tmpa ) + tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) + tmpvecgg(1) = 1.0_r8 - tmpvecgg(2) + tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) + end if + + do jcls = 1, ncls_use + do icc = 1, 2 + iccy = 0 + if (jcls == jcls_qu) cycle + if ( empty_new(icc ,jcls ) ) cycle + jgrp = jgrp_of_jcls(jcls ) + + ! tmpa is unassigned-draft entrainment due to this icc,jcls + tmpa = ecls_aaunasi(icc,jcls) + if (tmpa > 0.0_r8) then + do iccy = 1, 2 + if ( empty_old(iccy,jclsy) ) cycle + if (tmpvecgg(iccy) <= 0.0_r8) cycle + ! tmpb is portion of tmpa coming from iccy,jclsy + tmpb = tmpa*tmpvecgg(iccy) + + ecls_aaunasi(icc ,jcls ) = ecls_aaunasi(icc ,jcls ) - tmpb + dcls_aaunasi(iccy,jclsy) = dcls_aaunasi(iccy,jclsy) - tmpb + dcls_aalimit(iccy,jclsy) = dcls_aalimit(iccy,jclsy) - tmpb + ecls_aa(icc ,jcls ,iccy,jclsy) = ecls_aa(icc ,jcls ,iccy,jclsy) + tmpb + dcls_aa(iccy,jclsy,icc ,jcls ) = dcls_aa(iccy,jclsy,icc ,jcls ) + tmpb + + egrp_aaunasi(icc ,jgrp ) = egrp_aaunasi(icc ,jgrp ) - tmpb + dgrp_aaunasi(iccy,jgrpy) = dgrp_aaunasi(iccy,jgrpy) - tmpb + egrp_aa(icc ,jgrp ,iccy,jgrpy) = egrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpb + dgrp_aa(iccy,jgrpy,icc ,jgrp ) = dgrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpb + + ! if unassigned detrainment from quiescent goes negative, + ! convert this to positive unassigned entrainment + if (dcls_aaunasi(iccy,jclsy) < 0.0_r8) then + ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - dcls_aaunasi(iccy,jclsy) + dcls_aaunasi(iccy,jclsy) = 0.0_r8 + end if + if (dgrp_aaunasi(iccy,jgrpy) < 0.0_r8) then + egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - dgrp_aaunasi(iccy,jgrpy) + dgrp_aaunasi(iccy,jgrpy) = 0.0_r8 + end if + end do ! iccy + end if ! (tmpa > 0.0) + end do ! icc + end do ! jcls + call parampollu_tdx_entdet_diag01( & + 5, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + +! step 6 +! quiescent clear <--> quiescent cloudy exchanges +! if clear is detraining and cloudy is entraining, then assign as much as +! possible of the det/ent as "clear quiescent" --> "cloudy quiescent" +! if cloudy is detraining and clear is entraining, then assign as much as +! possible of the det/ent as "cloudy quiescent" --> "clear quiescent" + do jcls = 1, ncls_use + if (jcls /= jcls_qu) cycle + jgrp = jgrp_of_jcls(jcls) + jclsy = jcls + jgrpy = jgrp_of_jcls(jclsy) + do icc = 1, 2 + iccy = 3 - icc + if ( empty_old(icc ,jcls ) ) cycle + if ( empty_new(iccy,jclsy) ) cycle + tmpa = min( dcls_aaunasi(icc,jcls), ecls_aaunasi(iccy,jcls) ) + if (tmpa > 0.0_r8) then + dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa + ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa + dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa + ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa + + dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa + egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa + dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa + egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa + end if + end do ! icc + end do ! jcls + call parampollu_tdx_entdet_diag01( & + 6, lunaa, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + + +! load the current-k ent/det values for each class into ent/det_airamt + ent_airamt(:,:,:,:,k) = ecls_aa(:,:,:,:) + det_airamt(:,:,:,:,k) = dcls_aa(:,:,:,:) + + ecls_aaunasi_sv2(:,:,k) = ecls_aaunasi(:,:) + egrp_aaunasi_sv2(:,:,k) = egrp_aaunasi(:,:) + dcls_aaunasi_sv2(:,:,k) = dcls_aaunasi(:,:) + dgrp_aaunasi_sv2(:,:,k) = dgrp_aaunasi(:,:) + + +! calc largest unassigned ent/det + m = 1 + if (ifrom_where == 10) m = 2 + if (ifrom_where == 2) m = 3 + do jcls = 1, ncls_use + do icc = 1, 2 + if (abs(ecls_aaunasi(icc,jcls)) > abs(ecls_aaunasi_worst(m))) then + ecls_aaunasi_worst(m) = ecls_aaunasi(icc,jcls) + ecls_aaunasi_worst_i(m) = icc + ecls_aaunasi_worst_j(m) = jcls + ecls_aaunasi_worst_k(m) = k + ecls_aaunasi_worst_ktau(m) = ktau + end if + if (abs(dcls_aaunasi(icc,jcls)) > abs(dcls_aaunasi_worst(m))) then + dcls_aaunasi_worst(m) = dcls_aaunasi(icc,jcls) + dcls_aaunasi_worst_i(m) = icc + dcls_aaunasi_worst_j(m) = jcls + dcls_aaunasi_worst_k(m) = k + dcls_aaunasi_worst_ktau(m) = ktau + end if + jgrp = jcls + if (jgrp > 3) cycle + if (abs(egrp_aaunasi(icc,jgrp)) > abs(egrp_aaunasi_worst(m))) then + egrp_aaunasi_worst(m) = egrp_aaunasi(icc,jgrp) + egrp_aaunasi_worst_i(m) = icc + egrp_aaunasi_worst_j(m) = jgrp + egrp_aaunasi_worst_k(m) = k + egrp_aaunasi_worst_ktau(m) = ktau + end if + if (abs(dgrp_aaunasi(icc,jgrp)) > abs(dgrp_aaunasi_worst(m))) then + dgrp_aaunasi_worst(m) = dgrp_aaunasi(icc,jgrp) + dgrp_aaunasi_worst_i(m) = icc + dgrp_aaunasi_worst_j(m) = jgrp + dgrp_aaunasi_worst_k(m) = k + dgrp_aaunasi_worst_ktau(m) = ktau + end if + end do + end do + + + + end do entdet_main_kloop_aa + + +! now calc ent/det_airamt_tot + do k = kts, ktecen + + do jcls = 1, ncls_use + do icc = 1, 2 + tmpa = 0.0_r8 + tmpb = 0.0_r8 + if (k < ktebnd) then + do jclsy = 1, ncls_use + do iccy = 1, 2 + tmpa = tmpa + ent_airamt( icc,jcls, iccy,jclsy, k) + tmpb = tmpb + det_airamt( icc,jcls, iccy,jclsy, k) + end do + end do + end if + ent_airamt_tot(icc,jcls,k) = tmpa + det_airamt_tot(icc,jcls,k) = tmpb + end do ! icc + end do ! jcls + + end do ! k + + +! diagnostic output + if (lunaa > 0) then + do k = kts, ktecen + + write(lunaa,'(/a,3i5)') 'bb parampollu_tdx_entdet_sub1 - ktau, ifrom_where, k', ktau, ifrom_where, k + + write(lunaa,'(a)') 'ent_airamt_tot simple/full' + write(lunaa,'(1p,10e11.3)') ent_airamt_tot_sv1(1:2,1:ncls_use,k) + write(lunaa,'(1p,10e11.3)') ent_airamt_tot( 1:2,1:ncls_use,k) + do jcls = 1, ncls_use + write(lunaa,'(a,i3,a,i3)') 'ent_airamt simple/full for icc,jcls= 1', jcls, ' and 2', jcls + write(lunaa,'(1p,6e11.3,4x,6e11.3)') (ent_airamt_sv1(icc,jcls,1:2,1:ncls_use,k), icc=1,2) + write(lunaa,'(1p,6e11.3,4x,6e11.3)') (ent_airamt( icc,jcls,1:2,1:ncls_use,k), icc=1,2) + end do + + write(lunaa,'(a)') 'det_airamt_tot simple/full' + write(lunaa,'(1p,10e11.3)') det_airamt_tot_sv1(1:2,1:ncls_use,k) + write(lunaa,'(1p,10e11.3)') det_airamt_tot( 1:2,1:ncls_use,k) + do jcls = 1, ncls_use + write(lunaa,'(a,i3,a,i3)') 'det_airamt simple/full for icc,jcls= 1', jcls, ' and 2', jcls + write(lunaa,'(1p,6e11.3,4x,6e11.3)') (det_airamt_sv1(icc,jcls,1:2,1:ncls_use,k), icc=1,2) + write(lunaa,'(1p,6e11.3,4x,6e11.3)') (det_airamt( icc,jcls,1:2,1:ncls_use,k), icc=1,2) + end do + + write(lunaa,'(a)') 'final ecls_aaunasi & egrp_aaunasi // final dcls_aaunasi & dgrp_aaunasi' + write(lunaa,'(1p,6e11.3,4x,6e11.3)') ecls_aaunasi_sv2(1:2,1:ncls_use,k), egrp_aaunasi_sv2(1:2,1:3,k) + write(lunaa,'(1p,6e11.3,4x,6e11.3)') dcls_aaunasi_sv2(1:2,1:ncls_use,k), dgrp_aaunasi_sv2(1:2,1:3,k) + + end do ! k = kts, kte + end if ! (lunaa > 0) + + + lunbb = -1 + if ((parampollu_opt == 2223) .and. (ifrom_where == 2)) lunbb = ldiagaa_ecpp(123) + if ((parampollu_opt == 2220) .and. (ifrom_where == 10)) lunbb = ldiagaa_ecpp(123) + lunbb = ldiagaa_ecpp(123) + if (idiagaa_ecpp(123) <= 0) lunbb = -1 + + if (lunbb > 0) then + write(lunbb,'(/a,3i5)') 'parampollu_tdx_entdet_sub1 - ktau, ifrom_where', ktau, ifrom_where + + do m = 1, 3 + write(lunbb,'(a,i3)') 'm =', m + write(lunbb,'(a,2(3x,3i3,i5,1p,e11.3))') & + 'ecls_aaunasi_worst i/j/k/ktau/val & dcls', & + ecls_aaunasi_worst_i(m), ecls_aaunasi_worst_j(m), ecls_aaunasi_worst_k(m), & + ecls_aaunasi_worst_ktau(m), ecls_aaunasi_worst(m), & + dcls_aaunasi_worst_i(m), dcls_aaunasi_worst_j(m), dcls_aaunasi_worst_k(m), & + dcls_aaunasi_worst_ktau(m), dcls_aaunasi_worst(m) + write(lunbb,'(a,2(3x,3i3,i5,1p,e11.3))') & + 'egrp_aaunasi_worst i/j/k/ktau/val & dgrp', & + egrp_aaunasi_worst_i(m), egrp_aaunasi_worst_j(m), egrp_aaunasi_worst_k(m), & + egrp_aaunasi_worst_ktau(m), egrp_aaunasi_worst(m), & + dgrp_aaunasi_worst_i(m), dgrp_aaunasi_worst_j(m), dgrp_aaunasi_worst_k(m), & + dgrp_aaunasi_worst_ktau(m), dgrp_aaunasi_worst(m) + end do + + end if ! (lunbb > 0) + + +! restore saved values +! ent_airamt(:,:,:,:,:) = ent_airamt_sv1(:,:,:,:,:) +! det_airamt(:,:,:,:,:) = det_airamt_sv1(:,:,:,:,:) +! ent_airamt_tot(:,:,:) = ent_airamt_tot_sv1(:,:,:) +! det_airamt_tot(:,:,:) = det_airamt_tot_sv1(:,:,:) + + + return + end subroutine parampollu_tdx_entdet_sub1 + + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_entdet_diag01( & + istep, lun, & + ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & + ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & + det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & + dcls_aalimit ) + + use module_data_ecpp1 + + integer :: istep, lun, ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use + real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & + ent_airamt_tot_sv1, det_airamt_tot_sv1 + real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & + ecls_aa, dcls_aa + real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & + ecls_aaunasi, dcls_aaunasi, dcls_aalimit + real(r8), dimension( 1:2, 1:3, 1:2, 1:3 ) :: & + egrp_aa, dgrp_aa + real(r8), dimension( 1:2, 1:3 ) :: & + egrp_aaunasi, dgrp_aaunasi + + integer :: icc, jcls + + if (lun <= 0) return + + write(lun,'(/a,i1,a,3i5)') 'aa', istep, ' parampollu_tdx_entdet_sub1 - ktau, ifrom_where, k', ktau, ifrom_where, k + + write(lun,'(/i3,a)') istep, '=istep - ent_airamt_tot_sv1' + write(lun,'(1p,10e16.8)') ent_airamt_tot_sv1(1:2,1:ncls_use,k) + write(lun,'(i3,a)') istep, '=istep - ecls_aaunasi after' + write(lun,'(1p,10e16.8)') ecls_aaunasi(1:2,1:ncls_use) + write(lun,'(i3,a)') istep, '=istep - egrp_aaunasi after' + write(lun,'(1p,10e16.8)') egrp_aaunasi(1:2,1:3) + do jcls = 1, ncls_use + write(lun,'(i3,a,i3,a,i3)') istep, '=istep - ecls_aa after for icc,jcls= 1', jcls, ' and 2', jcls + write(lun,'(1p,6e16.8)') (ecls_aa(icc,jcls,1:2,1:ncls_use), icc=1,2) + if (jcls > 3) cycle + write(lun,'(i3,a,i3,a,i3)') istep, '=istep - egrp_aa after for icc,jcls= 1', jcls, ' and 2', jcls + write(lun,'(1p,6e16.8)') (egrp_aa(icc,jcls,1:2,1:3), icc=1,2) + end do + + write(lun,'(/i3,a)') istep, '=istep - det_airamt_tot_sv1' + write(lun,'(1p,10e16.8)') det_airamt_tot_sv1(1:2,1:ncls_use,k) + write(lun,'(i3,a)') istep, '=istep - dcls_aalimit after' + write(lun,'(1p,10e16.8)') dcls_aalimit(1:2,1:ncls_use) + write(lun,'(i3,a)') istep, '=istep - dcls_aaunasi after' + write(lun,'(1p,10e16.8)') dcls_aaunasi(1:2,1:ncls_use) + write(lun,'(i3,a)') istep, '=istep - dgrp_aaunasi after' + write(lun,'(1p,10e16.8)') dgrp_aaunasi(1:2,1:3) + do jcls = 1, ncls_use + write(lun,'(i3,a,i3,a,i3)') istep, '=istep - dcls_aa after for icc,jcls= 1', jcls, ' and 2', jcls + write(lun,'(1p,6e16.8)') (dcls_aa(icc,jcls,1:2,1:ncls_use), icc=1,2) + if (jcls > 3) cycle + write(lun,'(i3,a,i3,a,i3)') istep, '=istep - dgrp_aa after for icc,jcls= 1', jcls, ' and 2', jcls + write(lun,'(1p,6e16.8)') (dgrp_aa(icc,jcls,1:2,1:3), icc=1,2) + end do + + return + end subroutine parampollu_tdx_entdet_diag01 + +!----------------------------------------------------------------------- + subroutine set_of_aerosol_stuff(is_aerosol, & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! sets following arrays +! +! is_aerosol : logical variable, whether it is an aeroosl speices or not +! +! iphase_of_aerosol(l) = 0 for non-aerosol species +! = ai/cw/..._phase for aerosol species +! isize_of_aerosol(l) = 0 for non-aerosol species +! = size/bin index for aerosol species +! itype_of_aerosol(l) = 0 for non-aerosol species +! = type index for aerosol species +! inmw_of_aerosol(l) = 0 for non-aerosol species +! = 1/2/3 for aerosol number/mass/water species +! laicwpair_of_aerosol(l) = -999888777 for non-aerosol species +! = species index of corresponding ai/cw species +! +!----------------------------------------------------------------------- + +! use module_configure, only: chem_dname_table + + use module_data_ecpp1, only: num_chem_ecpp, param_first_ecpp + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + massptr_aer, & + ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer + +! arguments + integer, intent(out), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + logical, intent(out) :: is_aerosol(1:num_chem_ecpp) + +! local variables + integer :: j, j2, l, l2, ll, m, n + integer, save :: ientry = 0 + character(len=16) :: tmpname + + is_aerosol (:) = .false. + iphase_of_aerosol(:) = 0 + isize_of_aerosol(:) = 0 + itype_of_aerosol(:) = 0 + laicwpair_of_aerosol(:) = -999888777 + inmw_of_aerosol(:) = 0 + + do j = 1, nphase_aer + do n = 1, ntype_aer + do m = 1, nsize_aer(n) + do ll = 0, ncomp_aer(n) + + l = -999888777 + if (ll == 0) then + l = numptr_aer(m,n,j) + else if (ll <= ncomp_aer(n)) then + l = massptr_aer(ll,m,n,j) + end if + if ((l >= param_first_ecpp) .and. (l <= num_chem_ecpp)) then + is_aerosol(l) = .true. + iphase_of_aerosol(l) = j + isize_of_aerosol(l) = m + itype_of_aerosol(l) = n + if (ll == 0) then + inmw_of_aerosol(l) = 1 + else if (ll <= ncomp_aer(n)) then + inmw_of_aerosol(l) = 2 + else + inmw_of_aerosol(l) = 3 + end if + end if + + if ( (nphase_aer >= 2) .and. & + (ai_phase > 0) .and. (cw_phase > 0) ) then + if (j == ai_phase) then + j2 = cw_phase + else if (j == cw_phase) then + j2 = ai_phase + else + cycle + end if + end if + if (ll == 0) then + l2 = numptr_aer(m,n,j2) + else if (ll <= ncomp_aer(n)) then + l2 = massptr_aer(ll,m,n,j2) + else + cycle + end if + if ((l >= param_first_ecpp) .and. (l <= num_chem_ecpp) .and. & + (l2 >= param_first_ecpp) .and. (l2 <= num_chem_ecpp)) & + laicwpair_of_aerosol(l) = l2 + + end do + end do + end do + end do + + if (ientry == 0) then + do l = param_first_ecpp, num_chem_ecpp +! tmpname = chem_dname_table(1,l) +! write(*,'(2a,6i5)') 'iphase, isize, itype, inmw, l, laicw_pairptr ', tmpname, & + write(*,'(a,l2,7i5)') 'iphase, isize, itype, inmw, l, laicw_pairptr ', & + is_aerosol(l), iphase_of_aerosol(l), isize_of_aerosol(l), itype_of_aerosol(l), & + inmw_of_aerosol(l), l, max(-999,laicwpair_of_aerosol(l)) + end do + end if + ientry = 1 + + return + end subroutine set_of_aerosol_stuff + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_startup( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + rhocen_bar, dzcen, & + chem_bar, chem_cls, & + ncls_ecpp, & + acen_tbeg, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + chem_sub_beg, & + acen_tbeg_use, ardz_cen_tbeg, rhodz_cen, & + activate_onoff_use, & + iphase_of_aerosol, laicwpair_of_aerosol ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_startup does some "startup" calculations +! +! re-initializes the acen_tbeg to all-quiescent and the +! chem_cls to chem_bar at the re-init time (if this is turned on) +! +! calculates chem_sub from chem_cls (which involves some assumptions +! for the interstial and activated aerosols) +! +!----------------------------------------------------------------------- + +! use module_state_descption, only: & +! p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & +! p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 +! use module_data_ecpp1, only: & +! p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & +! p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 + + use module_data_radm2, only: epsilc + + use module_data_mosaic_asect, only: ai_phase, cw_phase + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + rhocen_bar, dzcen +! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries +! dzcen - layer thicknesses (m) +! + real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + real(r8), intent(inout), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_cls + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tbeg + + integer, intent(in) :: ncls_use + + real(r8), intent(inout), & + dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_beg + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tbeg_use, ardz_cen_tbeg + + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, laicwpair_of_aerosol + + +! local variables + integer :: icc, itmpa, jcls, jclsbb + integer :: k, l, la, laa, lbb, lc + integer :: lun161, lun162, lun164 + integer :: p1st + + real(r8) :: tmpa, tmpb, tmpqbarold + real(r8), dimension( 0:2 ) :: tmp_acen + real(r8), dimension( 1:num_chem_ecpp ) :: tmp_chem_cls + real(r8), dimension( 1:2, 1:num_chem_ecpp ) :: tmp_chem_sub + + + + p1st = param_first_ecpp + lun161 = -1 + if (idiagaa_ecpp(161) > 0) lun161 = ldiagaa_ecpp(161) + lun162 = -1 + if (idiagaa_ecpp(162) > 0) lun162 = ldiagaa_ecpp(162) + lun164 = -1 + if (idiagaa_ecpp(164) > 0) lun164 = ldiagaa_ecpp(164) + +! do sums of fractional areas over clear/cloudy and classes + do k = kts, ktecen + do jcls = 1, ncls_use + acen_tbeg(k,0,jcls) = sum( acen_tbeg(k,1:2,jcls) ) + end do + do icc = 0, 2 + tmpa = 0.0_r8 + do jclsbb = 2, ncls_use+1 + ! sum order is [2,3,...,ncls,1] instead of [1,2,...,ncls] + jcls = mod(jclsbb-1,ncls_use) + 1 + tmpa = tmpa + acen_tbeg(k,icc,jcls) + end do + acen_tbeg(k,icc,0) = tmpa + end do + end do + + +! +! with hybrid-time-dependent drafts, always do reinit calcs +! +! set all chem_cls = chem_bar for all species and levels + chem_cls(:,:,:) = 0.0_r8 + do l = 1, num_chem_ecpp + do jcls = 1, ncls_use + do k = kts, ktecen + chem_cls(k,jcls,l) = chem_bar(k,l) + end do + end do + end do + +! set up/dndraft areas to zero +! set quiescent areas to overall clear/cloudy fractions + do k = kts, ktecen + tmpa = acen_tbeg(k,1,0) ! this is total clear area (all classes) + tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) + +! force 100%/0%/70%/30% clear when iflag_ecpp_test_fixed_fcloud = 2/3/4/5 + if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & + (iflag_ecpp_test_fixed_fcloud <= 5)) then + if (iflag_ecpp_test_fixed_fcloud == 2) then + tmpa = 1.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 3) then + tmpa = 0.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 4) then + tmpa = 0.7_r8 + else + tmpa = 0.3_r8 + end if + end if + + acen_tbeg(k,:,:) = 0.0_r8 + acen_tbeg(k,0,jcls_qu) = 1.0_r8 + acen_tbeg(k,1,jcls_qu) = tmpa + acen_tbeg(k,2,jcls_qu) = 1.0_r8-tmpa + acen_tbeg(k,0:2,0) = acen_tbeg(k,0:2,jcls_qu) + end do + + +! +! update the chem_cls values based on "host-code" changes to chem_bar +! when iflag_ecpp_startup_host_chemtend > 0 + if (iflag_ecpp_startup_host_chemtend > 0) then + do l = p1st, num_chem_ecpp + do k = kts, ktecen + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do jcls = 1, ncls_use + tmpa = tmpa + acen_tbeg(k,0,jcls)*chem_cls(k,jcls,l) + tmpb = tmpb + acen_tbeg(k,0,jcls) + end do + tmpqbarold = tmpa/max(tmpb,0.99_r8) + if (tmpqbarold < 1.01_r8*max(epsilc,1.0e-20_r8)) then + chem_cls(k,1:ncls_use,l) = chem_bar(k,l) + else if (chem_bar(k,l) > tmpqbarold) then + chem_cls(k,1:ncls_use,l) = chem_cls(k,1:ncls_use,l) + (chem_bar(k,l)-tmpqbarold) + else + chem_cls(k,1:ncls_use,l) = chem_cls(k,1:ncls_use,l) * (chem_bar(k,l)/tmpqbarold) + end if + end do + end do + end if + + +! do chem_sub_beg <-- chem_cls and acen_tbeg_use <-- acen_tbeg +! TODO - for aerosols, special treatment for "a" and "cw" in clear/cloudy sub-classes + acen_tbeg_use(:,:,:) = acen_tbeg(:,:,:) + chem_sub_beg(:,:,:,:) = 0.0_r8 + + do k = kts, ktecen + do jcls = 0, ncls_use + ardz_cen_tbeg(k,0:2,jcls) = acen_tbeg_use(k,0:2,jcls)*rhodz_cen(k) + end do + end do + + do jcls = 1, ncls_use + do k = kts, ktecen + do l = p1st, num_chem_ecpp + chem_sub_beg(k,1:2,jcls,l) = chem_cls(k,jcls,l) + end do + end do + end do + +! for aerosols, special treatment for "a" and "cw" in clear/cloudy sub-classes + if ((activate_onoff_use > 0) .and. (iflag_ecpp_startup_acw_partition > 0)) then + +acwxx1_jcls_loop: & + do jcls = 1, ncls_use +acwxx1_k_loop: & + do k = kts, ktecen + + ! clear subarea ~= 0 --> all cloudy + ! no special treatment in this case + if (acen_tbeg_use(k,1,jcls) < afrac_cut_0p5) cycle acwxx1_k_loop + + ! cloudy subarea ~= 0 and clear subarea > 0 + ! resuspend any cloudborne material + if (acen_tbeg_use(k,2,jcls) < afrac_cut_0p5) then + do la = p1st, num_chem_ecpp + if (iphase_of_aerosol(la) /= ai_phase) cycle + lc = laicwpair_of_aerosol(la) + if (lc < p1st) cycle + if (iphase_of_aerosol(lc) /= cw_phase) cycle + + tmpa = chem_cls(k,jcls,la) + chem_cls(k,jcls,lc) + chem_sub_beg(k,1:2,jcls,la) = tmpa + chem_sub_beg(k,1:2,jcls,lc) = 0.0_r8 + chem_cls(k,jcls,la) = tmpa + chem_cls(k,jcls,lc) = 0.0_r8 + end do ! la + cycle acwxx1_k_loop + end if + + ! at this point, clear and cloudy subareas > 0 + tmp_acen(0:2) = acen_tbeg_use(k,0:2,jcls) + tmp_chem_cls(p1st:num_chem_ecpp) = chem_cls(k,jcls,p1st:num_chem_ecpp) + tmp_chem_sub(1:2,p1st:num_chem_ecpp) = chem_sub_beg(k,1:2,jcls,p1st:num_chem_ecpp) + + if (lun164 > 0) & + write(lun164,'(/a,8i5)') 'aa ktau,jcls,k ', ktau,jcls,k + call parampollu_tdx_partition_acw( & + tmp_acen, tmp_chem_cls, tmp_chem_sub, & + ktau, it, jt, k, jcls, lun164 ) + + chem_sub_beg(k,1:2,jcls,p1st:num_chem_ecpp) = tmp_chem_sub(1:2,p1st:num_chem_ecpp) + + end do acwxx1_k_loop + end do acwxx1_jcls_loop + + end if ! ((activate_onoff_use > 0) .and. (iflag_ecpp_startup_acw_partition > 0)) + + if ((lun161 > 0) .and. (kts > -1)) then +! la = p_num_a03 ; lc = p_num_cw03 +! write(lun161,'(/a,4i6)') 'startup - ktau, l_num_ac03', ktau, la, lc, laicwpair_of_aerosol(la) +! la = p_oin_a03 ; lc = p_oin_cw03 +! if (lun162 > 0) & +! write(lun162,'(/a,4i6)') 'startup - ktau, l_oin_ac03', ktau, la, lc, laicwpair_of_aerosol(la) +! do k = min(10,ktecen), kts, -1 + +! write(lun161,'(i2,2(1x,2l1),2(2x, 2x,2(2x,2f11.8)))') k, & +! (( (acen_tbeg_use(k,icc,jcls)>afrac_cut_0p5), icc=1,2 ), jcls=1,2 ), & +! (( acen_tbeg_use(k,icc,jcls), icc=1,2 ), jcls=1,2 ) + +! la = p_num_a01 ; lc = p_num_cw01 ; tmpa = 1.0e-9 +! la = p_num_a03 ; lc = p_num_cw03 ; tmpa = 1.0e-6 +! write(lun161,'(i2, 1x,a5, 2(3x,f6.3,2(1x,3f6.3)))') k, 'num_3', & +! ( tmpa*chem_bar(k,l), & +! ( tmpa*chem_cls(k,jcls,l), tmpa*chem_sub_beg(k,1:2,jcls,l), jcls=1,2 ), & +! l=la,lc,lc-la ) +! la = p_oin_a01 ; lc = p_oin_cw01 ; tmpa = 1.0 +! la = p_oin_a03 ; lc = p_oin_cw03 ; tmpa = 1.0 +! write(lun161,'(i2, 1x,a5, 2(3x,f6.3,2(1x,3f6.3)))') k, 'oin_3', & +! ( tmpa*chem_bar(k,l), & +! ( tmpa*chem_cls(k,jcls,l), tmpa*chem_sub_beg(k,1:2,jcls,l), jcls=1,2 ), & +! l=la,lc,lc-la ) + +! end do + end if ! ((lun161 > 0) .and. (kts > -1)) + + + return + end subroutine parampollu_tdx_startup + + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_partition_acw( & + acen, chem_cls, chem_sub, & + ktau, i, j, k, jcls, lun164 ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_partition_acw paritions interstitial ("a") and +! activate/cloudborne ("cw") aerosol species to the clear and cloudy +! fractions of a grid cell (or grid cell transport-class) +! +!----------------------------------------------------------------------- + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + ncomp_aer, nsize_aer, ntype_aer, & + massptr_aer, numptr_aer, & !waterptr_aer, & + dens_aer, volumlo_sect, volumhi_sect + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & + parampollu_1clm_set_opts + +! arguments + integer, intent(in) :: & + ktau, i, j, k, jcls, lun164 +! ktau - time step number +! [i, k, j] - spatial (x,z,y) indices for grid cell + + real(r8), intent(in), dimension( 0:2 ) :: acen + + real(r8), intent(in), dimension( 1:num_chem_ecpp ) :: chem_cls + + real(r8), intent(inout), dimension( 1:2, 1:num_chem_ecpp ) :: chem_sub + + +! local variables + integer :: iphase, isize, itmpa, itype + integer :: la, lc, ll + + real(r8) :: fx, fy + real(r8) :: q_a_x, q_a_y, q_a_bar, & + q_c_x, q_c_y, q_c_bar, & + q_ac_x, q_ac_y, q_ac_bar, & + qn_a_x, qn_a_y, qn_a_bar, & + qn_a_x_sv, qn_a_y_sv, & + qv_a_x, qv_a_y, qv_a_bar + real(r8) :: tmpa + + character(len=120) :: msg + + + + if (min(acen(1),acen(2)) < afrac_cut_0p5) then + write(msg,'(a,i10,3i5,1p,2e12.4)') & + '*** parampollu_tdx_partition_acw - bad acen(1:2)', & + ktau, i, j, k, acen(1:2) + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + return + end if + fy = acen(2)/(acen(1)+acen(2)) + fx = 1.0_r8 - fy + +! main loops over aerosol types and sizes + do itype = 1, ntype_aer + do isize = 1, nsize_aer(itype) + +! first partition number and dry-mass species +! in a manner that attempts to get the "a+cw" mixing ratios +! in clear and cloudy subareas to be equal the +! cell/class average (clear+cloudy) "a+cw" mixing ratios + qv_a_x = 0.0_r8 ; qv_a_y = 0.0_r8 + do ll = 0, ncomp_aer(itype) + if (ll == 0) then + la = numptr_aer(isize,itype,ai_phase) + lc = numptr_aer(isize,itype,cw_phase) + else + la = massptr_aer(ll,isize,itype,ai_phase) + lc = massptr_aer(ll,isize,itype,cw_phase) + end if + +! nomenclature for q_... +! a = interstitial; c = cloudborne; ac = a+c +! x = in clear subarea; y = in cloudy subarea; +! bar = average over both subareas +! +! following always hold +! q_ac_any == q_a_any + q_c_any +! q_any_bar == q_any_x*fx + q_any_y*fy +! + q_a_bar = max( 0.0_r8, chem_cls(la) ) + q_c_bar = max( 0.0_r8, chem_cls(lc) ) + q_ac_bar = q_a_bar + q_c_bar + q_c_y = q_c_bar/fy + q_c_x = 0.0_r8 + q_a_y = max( 0.0_r8, (q_ac_bar - q_c_y) ) + q_a_x = max( 0.0_r8, (q_a_bar - q_a_y*fy)/fx ) + +! if ((k <= 5) .and. (isize == 1) .and. (ll == 3)) then + if ((k <= 5) .and. (isize == 3) .and. (ll==3 .or. ll==0)) then + if (lun164 > 0) then + write(lun164,'(/a,8i5)') 'bb ktau,jcls,k,isize,ll', ktau,jcls,k,isize,ll + write(lun164,'(a,1p,8e12.4)') 'acen1/2, fx/y', acen(1:2), fx, fy + write(lun164,'(a,1p,8e12.4)') 'chem_cls ', chem_cls(la), chem_cls(lc) + write(lun164,'(a,1p,8e12.4)') 'chem_sub old ', chem_sub(1:2,la), chem_sub(1:2,lc) + end if + end if + chem_sub(1,la) = q_a_x + chem_sub(2,la) = q_a_y + chem_sub(1,lc) = q_c_x + chem_sub(2,lc) = q_c_y +! if ((k <= 5) .and. (isize == 1) .and. (ll == 3)) then + if ((k <= 5) .and. (isize == 3) .and. (ll==3 .or. ll==0)) then + if (lun164 > 0) & + write(lun164,'(a,1p,8e12.4)') 'chem_sub new ', chem_sub(1:2,la), chem_sub(1:2,lc) + end if + + if (ll == 0) then + qn_a_x = q_a_x + qn_a_y = q_a_y + else + qv_a_x = qv_a_x + q_a_x/dens_aer(ll,itype) + qv_a_y = qv_a_y + q_a_y/dens_aer(ll,itype) + end if + end do + qv_a_x = qv_a_x*1.0e-6_r8 ! because mass mixratios are ug/kg, + qv_a_y = qv_a_y*1.0e-6_r8 ! and want volume mixratio in cm3-aerosol/kg + +! now check that the partitioning has not produced an out-of-bounds size +! (size = mean 1-particle volume) for interstitial in clear or cloudy subareas +! if this has occurred, then partition the number differently + qv_a_bar = qv_a_x*fx + qv_a_y*fy + qn_a_bar = qn_a_x*fx + qn_a_y*fy + qn_a_x_sv = qn_a_x ; qn_a_y_sv = qn_a_y + if ( (qv_a_bar <= 1.0e-30_r8) .or. & + (qv_a_bar <= qn_a_bar*volumlo_sect(isize,itype)) .or. & + (qv_a_bar >= qn_a_bar*volumhi_sect(isize,itype)) ) then + ! neglible dry volume, or size already out-of-bounds + tmpa = max(qv_a_bar,1.0e-35_r8) + qn_a_x = qn_a_bar * ( max(qv_a_x,0.5e-35_r8) / tmpa ) + qn_a_y = qn_a_bar * ( max(qv_a_y,0.5e-35_r8) / tmpa ) + if (qv_a_bar <= 1.0e-30_r8) then + itmpa = 1 + else if (qv_a_bar <= qn_a_bar*volumlo_sect(isize,itype)) then + itmpa = 2 + else + itmpa = 3 + end if + + else if (qv_a_x <= qn_a_x*volumlo_sect(isize,itype)) then + ! size to small in clear subarea + qn_a_x = qv_a_x/volumlo_sect(isize,itype) + qn_a_y = max( 0.0_r8, (qn_a_bar - qn_a_x*fx)/fy ) + itmpa = 4 + else if (qv_a_y <= qn_a_y*volumlo_sect(isize,itype)) then + ! size to small in cloudy subarea + qn_a_y = qv_a_y/volumlo_sect(isize,itype) + qn_a_x = max( 0.0_r8, (qn_a_bar - qn_a_y*fy)/fx ) + itmpa = 5 + + else if (qv_a_x >= qn_a_x*volumhi_sect(isize,itype)) then + ! size to large in clear subarea + qn_a_x = qv_a_x/volumhi_sect(isize,itype) + qn_a_y = max( 0.0_r8, (qn_a_bar - qn_a_x*fx)/fy ) + itmpa = 6 + else if (qv_a_y >= qn_a_y*volumhi_sect(isize,itype)) then + ! size to large in cloudy subarea + qn_a_y = qv_a_y/volumhi_sect(isize,itype) + qn_a_x = max( 0.0_r8, (qn_a_bar - qn_a_y*fy)/fx ) + itmpa = 7 + else + itmpa = 0 + end if + la = numptr_aer(isize,itype,ai_phase) + chem_sub(1,la) = qn_a_x + chem_sub(2,la) = qn_a_y + if ((k <= 5) .and. (isize == 3)) then + if ((itmpa==5) .and. (qv_a_y>0.0_r8)) itmpa=8 + if ((itmpa==5) .and. (qn_a_y>0.0_r8)) itmpa=9 + if (lun164 > 0) then + write(lun164,'(/i1,a,1p,8e12.4)') itmpa, ' final num_a', chem_sub(1:2,la) + write(lun164,'( 13x,1p,8e12.4)') qn_a_x_sv, qn_a_y_sv, qn_a_bar, qv_a_x, qv_a_y + end if + end if + +! aerosol water - do this for now, but it should be improved +! comment out now, need to check with Dick Easter. +++mhwang +! +! la = waterptr_aer(isize,itype) +! tmpa = max(qv_a_bar,1.0e-35) +! chem_sub(1,la) = ( max(qv_a_x,0.5e-35) / tmpa ) * chem_cls(la) +! chem_sub(2,la) = ( max(qv_a_y,0.5e-35) / tmpa ) * chem_cls(la) + + end do + end do + + + + return + end subroutine parampollu_tdx_partition_acw + +!----------------------------------------------------------------------- + subroutine parampollu_tdx_cleanup( & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + chem_bar, chem_cls, & + ncls_ecpp, & + acen_tfin_ecpp, & + it, jt, kts,ktebnd,ktecen, & + ncls_use, & + chem_sub_beg, chem_sub_new, & + del_chem_clm_cldchem, del_chem_clm_wetscav, & + del_cldchem3d, del_rename3d, & + del_wetdep3d, del_wetresu3d, & + del_activate3d, del_conv3d, & + acen_tbeg_use, acen_tfin_use, rhodz_cen, & + activate_onoff_use, & + iphase_of_aerosol, isize_of_aerosol, & + itype_of_aerosol, inmw_of_aerosol, & + laicwpair_of_aerosol ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_tdx_cleanup does some final "cleanup" calculations +! +! calculates final chem_cls and chem_bar from the final chem_sub +! +! calculates beginning and final column-average mixing ratios +! and checks for mass conservation +! +!----------------------------------------------------------------------- + + use module_data_mosaic_asect, only: ai_phase, cw_phase, & + nsize_aer, massptr_aer, numptr_aer + + use module_data_radm2, only: epsilc + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar +! chem_bar - mixing ratios of trace gase (ppm) and aerosol species +! (ug/kg for mass species, #/kg for number species) + + real(r8), intent(inout), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_cls + + integer, intent(in) :: ncls_ecpp +! ncls_ecpp - number of ecpp transport classes in the grid column + + + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tfin_ecpp + + integer, intent(in) :: ncls_use + + real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + chem_sub_beg, chem_sub_new + + real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & + del_chem_clm_cldchem, del_chem_clm_wetscav + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & + del_cldchem3d, del_rename3d, del_wetdep3d, del_wetresu3d + + real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_activate3d + + real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & + del_conv3d + + real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tbeg_use, acen_tfin_use + + real(r8), intent(in), dimension( kts:ktecen ) :: rhodz_cen + + integer, intent(in) :: activate_onoff_use + + integer, intent(in), dimension( 1:num_chem_ecpp ) :: & + iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & + inmw_of_aerosol, laicwpair_of_aerosol + + + +! local variables + integer :: ia, ib, icc + integer :: jcls, jclsbb + integer :: k + integer :: l, la, laa, lbb, lc, lewa, lewc, lun119, lun121 + integer :: laicwpair_flagaa + integer, save :: ktaueww = 0 + + real(r8) :: air_clmmass + real(r8) :: chem_cutoff_aa + real(r8) :: tmpa, tmpb, tmpe, tmpew, tmpx, tmpy, tmpz + real(r8) :: tmpa_clmavg(1:6), tmpw_clmavg(1:6) + real(r8) :: tmpveca( kts:ktecen ), tmpvecb( kts:ktecen ) + real(r8) :: tmpvece(1:6) + real(r8), save :: tmpeww = 0.0_r8 + + real(r8), dimension( 1:6, 1:num_chem_ecpp ) :: chem_clmavg + real(r8), dimension( kts:ktecen, 1:num_chem_ecpp ) :: chem_bar_beg + + + + lun121 = -1 + if (idiagaa_ecpp(121) > 0) lun121 = ldiagaa_ecpp(121) + + del_conv3d = 0.0_r8 +! calculate initial clmmass and del_conv3d + air_clmmass = sum( rhodz_cen(kts:ktecen) ) + do l = param_first_ecpp, num_chem_ecpp + tmpveca(:) = 0.0_r8 ; tmpvecb(:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + tmpveca(k) = tmpveca(k) + acen_tbeg_use(k,icc,jcls)*chem_cls( k, jcls,l) + tmpvecb(k) = tmpvecb(k) + acen_tbeg_use(k,icc,jcls)*chem_sub_beg(k,icc,jcls,l) + end do + end do + end do + chem_clmavg(1,l) = sum( rhodz_cen(kts:ktecen)*chem_bar(kts:ktecen,l) ) + chem_clmavg(2,l) = sum( rhodz_cen(kts:ktecen)*tmpveca(kts:ktecen) ) + chem_clmavg(3,l) = sum( rhodz_cen(kts:ktecen)*tmpvecb(kts:ktecen) ) + end do + if ((ktau < 0) .and. (lun121 > 0)) then + l = 17 + icc = 1 +! write(lun121,*) 'ktau, l, ncls_use', ktau, l, ncls_use +! write(lun121,*) 'k, old chem_bar, old chem_cls, chem_sub_beg, acen_tbeg_use' +! do k = ktecen, kts, -1 +! write(lun121,'(i3,1p,e12.5,3(3x,3e12.5))') k, chem_bar(k,l), & +! chem_cls(k,1:3,l), chem_sub_beg(k,icc,1:3,l), acen_tbeg_use(k,icc,1:3) +! end do + end if +! if (ktau > 1) stop + + +! do acen_tfin_ecpp <-- acen_tfin_use + acen_tfin_ecpp(:,:,:) = acen_tfin_use(:,:,:) + + +! compute new chem_cls (class-avg mix ratios) and chem_bar (grid-avg mix ratios) + chem_bar_beg(:,:) = chem_bar(:,:) + do l = param_first_ecpp, num_chem_ecpp + do k = kts, ktecen + + tmpa = 0.0_r8 ; tmpb = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + tmpa = tmpa + acen_tfin_use(k,icc,jcls)* & + max(0.0_r8,chem_sub_new(k,icc,jcls,l)) + tmpb = tmpb + acen_tfin_use(k,icc,jcls) + + del_conv3d(k,icc,jcls,l) = (acen_tfin_use(k,icc,jcls)*max(0.0_r8, chem_sub_new(k,icc,jcls,l)) & + - acen_tbeg_use(k,icc,jcls)*chem_sub_beg(k,icc,jcls,l)) & + - del_activate3d(k,icc,jcls,l) & + - del_cldchem3d(k,icc,jcls,1,l)-del_cldchem3d(k,icc,jcls,2,l) & + - del_rename3d(k,icc,jcls,1,l)-del_rename3d(k,icc,jcls,2,l) & + - del_wetdep3d(k,icc,jcls,1,l)-del_wetdep3d(k,icc,jcls,2,l) & + - del_wetresu3d(k,icc,jcls,1,l)-del_wetresu3d(k,icc,jcls,2,l) + end do + end do +! chem_bar(k,l) = max(0.0_r8,tmpa)/tmpb + chem_bar(k,l) = tmpa ! chem_bar is used to calcualte q tendency at the MMF model, + ! so keep it consistent with del_conv3d + + do jcls = 1, ncls_use + tmpa = 0.0_r8 ; tmpb = 0.0_r8 + do icc = 1, 2 + tmpa = tmpa + acen_tfin_use(k,icc,jcls)* & + max(0.0_r8,chem_sub_new(k,icc,jcls,l)) + tmpb = tmpb + acen_tfin_use(k,icc,jcls) + end do + if (tmpb >= afrac_cut_0p5) then + chem_cls(k,jcls,l) = max(0.0_r8,tmpa)/tmpb + else + chem_cls(k,jcls,l) = chem_bar(k,l) + end if + end do + + end do + end do + + +! calculate final clmmass + do l = param_first_ecpp, num_chem_ecpp + tmpveca(:) = 0.0_r8 ; tmpvecb(:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + tmpveca(k) = tmpveca(k) + acen_tfin_use(k,icc,jcls)*chem_cls( k, jcls,l) + tmpvecb(k) = tmpvecb(k) + acen_tfin_use(k,icc,jcls)*chem_sub_new(k,icc,jcls,l) + end do + end do + end do + chem_clmavg(4,l) = sum( rhodz_cen(kts:ktecen)*chem_bar(kts:ktecen,l) ) + chem_clmavg(5,l) = sum( rhodz_cen(kts:ktecen)*tmpveca(kts:ktecen) ) + chem_clmavg(6,l) = sum( rhodz_cen(kts:ktecen)*tmpvecb(kts:ktecen) ) + chem_clmavg(1:6,l) = chem_clmavg(1:6,l)/air_clmmass + end do + if ((ktau < 0) .and. (lun121 > 0)) then + l = 17 + icc = 1 +! write(lun121,*) 'ktau, l, ncls_use', ktau, l, ncls_use +! write(lun121,*) 'k, new chem_bar, new chem_cls, chem_sub_new, acen_tfin_use' + do k = ktecen, kts, -1 +! write(lun121,'(i3,1p,e12.5,3(3x,3e12.5))') k, chem_bar(k,l), & +! chem_cls(k,1:3,l), chem_sub_new(k,icc,1:3,l), acen_tfin_use(k,icc,1:3) + end do + end if +! if (ktau > 5) stop + if ((ktau < 5) .and. (lun121 > 0)) then + l = 9 +! write(lun121,'(/a,3i5)') 'ktau, l, ncls_use ', ktau, l, ncls_use +! write(lun121,'(a)') 'k, ((chem_sub_beg(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), icc=1,2), jcls=1,...) ' + do k = ktecen, kts, -1 +! write(lun121,'(i3,1p,6(2x,2e10.3))') k, & +! ((chem_sub_beg(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), icc=1,2), jcls=1,ncls_use) + end do + end if + + +! diagnostic output to unit 121 + if (lun121 > 0) then + +! write(lun121,'(/a,2i6)') 'parampollu_1clm clmmass check - ktau, ktau_pp =', & +! ktau, ktau_pp + lewa = 0 + lewc = 0 + tmpew = 0.0_r8 + chem_cutoff_aa = 3.0_r8*epsilc + laicwpair_flagaa = 0 + if ( (activate_onoff_use > 0) .and. & + (activate_onoff_use /=100) ) laicwpair_flagaa = 2 + do la = param_first_ecpp, num_chem_ecpp + l = -999888777 + lc = 0 + if (laicwpair_flagaa == 2) then + if (iphase_of_aerosol(la) == ai_phase) then + lc = laicwpair_of_aerosol(la) + else if (iphase_of_aerosol(la) == cw_phase) then + cycle + end if + end if + if ((lc < param_first_ecpp) .or. (lc > num_chem_ecpp)) lc = 0 + + ! these are the 3 initial and 3 final values of column-average mixing ratio + ! for the current species (or species la-lc pair) + tmpa_clmavg(1:6) = chem_clmavg(1:6,la) + if (lc > 0) tmpa_clmavg(1:6) = tmpa_clmavg(1:6) + chem_clmavg(1:6,lc) + + ! for the 3 final values, subtract off the change from cldchem and wetscav + tmpa = del_chem_clm_cldchem(la) + del_chem_clm_wetscav(la) + if (lc > 0) tmpa = tmpa + del_chem_clm_cldchem(lc) + del_chem_clm_wetscav(lc) + tmpa = tmpa/air_clmmass + tmpa_clmavg(4:6) = tmpa_clmavg(4:6) - tmpa + + do ia = 1, 6 + ib = mod(ia,6) + 1 + tmpa = tmpa_clmavg(ia) + tmpb = tmpa_clmavg(ib) + tmpvece(ia) = abs( tmpa-tmpb ) & + / max( abs(tmpa), abs(tmpb), 1.0e-30_r8 ) + end do + tmpx = maxval( tmpa_clmavg(1:6) ) + tmpy = minval( tmpa_clmavg(1:6) ) + tmpz = max( abs(tmpx), abs(tmpy), 1.0e-30_r8 ) + ! ignore species with max,min( clmavg mixratios ) < chem_cutoff_aa + if (tmpz >= chem_cutoff_aa) then + tmpe = abs( tmpx-tmpy ) / tmpz + else + tmpe = 0.0_r8 + end if + if (tmpe > tmpew) then + tmpew = tmpe + lewa = la + lewc = lc + tmpw_clmavg(:) = tmpa_clmavg(:) + end if + + if (tmpe > 1.0e-12_r8 ) then + write(lun121,'(a,2i3,1p,2(3x,6e10.2))') 'la/c=', la, lc, & + tmpa_clmavg(1:6), tmpvece(1:6) + + write(0,'(a,2i3,1p,2(3x,6e10.2))') 'mass convervation error in ecpp, la/c=', la, lc, & + tmpa_clmavg(1:6), tmpvece(1:6) + call endrun('mass convervation error in ecpp_cleanup') + end if + end do + if (tmpew > tmpeww) then + tmpeww = tmpew + ktaueww = ktau + end if + if (lewa > 0) then + write(lun121,'(a,2i3,1p,e10.2,10x,2i6,e10.2)') 'worst clmmass error - la/c=', & + lewa, lewc, tmpew, ktau, ktaueww, tmpeww + write(lun121,'(a,1p,6e14.6)') 'chem_clmavg(1:6,l)', tmpw_clmavg(1:6) + end if + + end if ! (lun121 > 0) + + +! diagnostic output to unit 119 + lun119 = -1 + if (idiagaa_ecpp(119) > 0) lun119 = ldiagaa_ecpp(119) + if (lun119 > 0) then + write(lun119,'(/a,2i5)') 'parampollu_1clm - pt2 ktau, ktau_pp =', ktau, ktau_pp +! do laa = param_first_ecpp, num_chem_ecpp, 3 +! lbb = min( laa+2, num_chem_ecpp ) +! do laa = param_first_ecpp, num_chem_ecpp, 4 +! lbb = min( laa+3, num_chem_ecpp ) + do laa = 9, 9 + lbb = min( laa+3, num_chem_ecpp ) + write(lun119,'(/a,4i5)') 'ktau, ktau_pp, laa, lbb =', ktau, ktau_pp, laa, lbb + write(lun119,'(a)') ' k, chem_bar_beg, chem_bar' + do k = ktecen, kts, -1 +! write(lun119,'(i2,4(2x,2f9.5))') k, & + write(lun119,'(i2,4(2x,1p,2e10.2))') k, & + (chem_bar_beg(k,l), chem_bar(k,l), l=laa, lbb) + end do +! write(lun119,'(i2,4(2x,2f9.5))') -1, & + write(lun119,'(i2,4(2x,1p,2e10.2))') -1, & + (chem_clmavg(2,l), chem_clmavg(5,l), l=laa, lbb) +! write(lun119,'(i2,1p,4e20.5))') -2, & + write(lun119,'(i2,4(2x,1p,e20.2))') -2, & + ( (chem_clmavg(2,l)-chem_clmavg(5,l)), l=laa, lbb) + end do + end if ! (lun119 > 0) + + + return + end subroutine parampollu_tdx_cleanup + + + +!----------------------------------------------------------------------- + subroutine parampollu_check_adjust_inputs( & + ipass_check_adjust_inputs, & + ktau, dtstep, ktau_pp, dtstep_pp, & + idiagaa_ecpp, ldiagaa_ecpp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd_ecpp, abnd_tavg_ecpp, & + acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp, & + wbnd_bar_use, & + ncls_use, & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use, & + mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & + abnd_tavg_use, & + acen_tavg_use, acen_tfin_use, acen_prec_use, & + rhodz_cen, & + it, jt, kts,ktebnd,ktecen ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_check_adjust_inputs does checking and adjustment +! of several of the ecpp arrays +! +! fractional areas less than afrac_cut are set to zero +! up and downdraft mass fluxes less than ... are set to zero +! remaining fractional areas are adjusted so that the sum is 1.0 +! +! all mass fluxes are set to zero at/above k_max_wnonzero +! up and downdraft mass fluxes and areas are set to zero at/above k_max_updndraft +! cloud fractional areas are set to zero at/above k_max_clouds +! +! the checks and adjustment are designed to eliminate "problems" in +! the input/incoming arrays that might cause the rest of the +! parampollu code to fail +! +!----------------------------------------------------------------------- + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ipass_check_adjust_inputs, & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations + +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, zbnd, wbnd_bar + + real(r8), intent(inout), dimension( kts:ktebnd ) :: & + wbnd_bar_use + + real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar + + integer, intent(in) :: ncls_ecpp + integer, intent(inout) :: ncls_use + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp + integer, intent(inout), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_use, kdraft_top_use, & + mtype_updnenv_use + + real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + mfbnd_ecpp, abnd_tavg_ecpp + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + mfbnd_use, abnd_tavg_use + real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp + real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg_use, acen_tfin_use, acen_prec_use + real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:2 ) :: & + mfbnd_quiescn_up, mfbnd_quiescn_dn + real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen + + +! local variables + integer :: k_max_updndraft + integer :: k_max_clouds + integer :: k_max_wnonzero + + integer :: i, icc, itmpa, itmpb + integer :: ido_downdr_area_zeroout, ido_updndr_area_adjust, ipass_2_changes + integer :: ispecial_check_acen_tfin + integer :: ja, jb + integer :: jcls, jclsbb + integer :: jclsicc, jclsicc_noc, jclsicc_cld + integer :: k, ka, kb, ktmpa, ktmpb + integer :: lun63, lun141, lun155 + integer :: ncls_noc, ncls_cld + integer :: nchanges(10) + integer :: kdraft_bot_tmp(1:2,1:maxcls_ecpp), kdraft_top_tmp(1:2,1:maxcls_ecpp) + integer :: mtype_updnenv_tmp(1:2,1:maxcls_ecpp) + + real(r8) :: ardz_cut ! sub-class fractional areas below this value are set to zero + real(r8) :: arw_draft_cut ! mass fluxes below this value are set to zero + real(r8) :: a_sum_toleraa = 1.0e-5_r8 ! tolerance for abs(sum(axxx) - 1.0) + real(r8) :: afrac_noc, afrac_cld + real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpq, tmpu + real(r8) :: tmp_afrac + real(r8) :: tmp_mfa, tmp_mfb + real(r8) :: tmp_tola, tmp_tolb + real(r8) :: tmpvecaa(0:ktebnd), tmpvecbb(0:ktebnd), tmpvecdd(0:ktebnd) + real(r8) :: tmp0202aa(0:2,0:2) + real(r8) :: updndr_area_adjust + + character(len=100) :: msg + character(len=10) :: area_name10(1:3) = & + (/ 'abnd_tavg ', 'acen_tavg ', 'acen_tfin ' /) + + + lun63 = -1 + if (idiagaa_ecpp(63) > 0) lun63 = ldiagaa_ecpp(63) + lun141 = -1 + if (idiagaa_ecpp(141) > 0) lun141 = ldiagaa_ecpp(141) + lun155 = -1 + if (idiagaa_ecpp(155) > 0) lun155 = ldiagaa_ecpp(155) + + if ((ipass_check_adjust_inputs /= 1) .and. & + (ipass_check_adjust_inputs /= 2)) return + + +! force w = 0 at kbnd >= k_max_wnonzero +! (note - doing k_max_wnonzero = ktebnd-1 would probably be ok) + k_max_wnonzero = ktebnd-1 + +! force up/dn draft mf & afrac = 0 at kbnd,kcen >= k_max_updndraft +! (note - currently set k_max_updndraft & _kclouds to almost top of domain) + k_max_updndraft = ktebnd-1 + +! force cloud fraction = 0 at kbnd,kcen >= k_max_clouds + k_max_clouds = ktebnd-1 + + nchanges(:) = 0 + + +!----------------------------------------------------- +! when ipass_check_adjust_inputs == 2, +! skip to he beginning of the special stuff for ipass_check_adjust_inputs == 2 + if (ipass_check_adjust_inputs == 2) goto 20000 +!----------------------------------------------------- + + +! +! copy from "_ecpp" arrays to "_use" arrays +! + ncls_use = ncls_ecpp + + kdraft_bot_use(:,:) = kdraft_bot_ecpp(:,:) + kdraft_top_use(:,:) = kdraft_top_ecpp(:,:) + + mtype_updnenv_use(:,:) = mtype_updnenv_ecpp(:,:) + + wbnd_bar_use(:) = wbnd_bar(:) + + mfbnd_use(:,:,:) = mfbnd_ecpp(:,:,:) + abnd_tavg_use(:,:,:) = max( abnd_tavg_ecpp(:,:,:), 0.0_r8 ) + acen_tavg_use(:,:,:) = max( acen_tavg_ecpp(:,:,:), 0.0_r8 ) + acen_tfin_use(:,:,:) = max( acen_tfin_ecpp(:,:,:), 0.0_r8 ) +! acen_tavg_use(kte,:,:) = 0.0 +! acen_tfin_use(kte,:,:) = 0.0 + +! calc rhodz_cen + rhodz_cen(kts:ktecen) = rhocen_bar(kts:ktecen)*dzcen(kts:ktecen) + + +! check that +! the mtype_updnenv_use are valid +! there is exactly one of each quiescent transport class (cloudy, clear) + jclsicc_noc = -1 + jclsicc_cld = -1 + ncls_noc = 0 + ncls_cld = 0 + msg = ' ' + + do jcls = 1, ncls_use + do icc = 1, 2 + jclsicc = jcls*10 + icc + if ((mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) .and. & + (icc == 1)) then + jclsicc_noc = jclsicc + ncls_noc = ncls_noc + 1 + end if + if ((mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) .and. & + (icc == 2)) then + jclsicc_cld = jclsicc + ncls_cld = ncls_cld + 1 + end if + + if ( ((jcls == jcls_qu) .and. & + (mtype_updnenv_use(icc,jcls) /= mtype_quiescn_ecpp)) .or. & + ((jcls /= jcls_qu) .and. & + (mtype_updnenv_use(icc,jcls) /= mtype_updraft_ecpp) .and. & + (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp)) ) then + write( msg, '(a,5(1x,i5))' ) & + '*** parampollu_check_adjust_inputs - bad mtype_updnenv', & + it, jt, jcls, icc, mtype_updnenv_use(icc,jcls) + call ecpp_message( lunout, msg ) + end if + end do + end do + + if ((jclsicc_noc <= 0) .or. (ncls_noc > 1)) then + write(msg,'(a,2(1x,i5))') & + '*** parampollu_check_adjust_inputs - bad jclsicc_noc, ncls_noc =', & + jclsicc_noc, ncls_noc + call ecpp_message( lunout, msg ) + end if + if ((jclsicc_cld <= 0) .or. (ncls_cld > 1)) then + write(msg,'(a,2(1x,i5))') & + '*** parampollu_check_adjust_inputs - bad jclsicc_cld, ncls_cld =', & + jclsicc_cld, ncls_cld + call ecpp_message( lunout, msg ) + end if + if (msg /= ' ') call ecpp_error_fatal( lunout, msg ) + + + if ((ktau==4) .and. (lun155 > 0)) then + write(lun155,'(/a,3i5)') 'aaa', ktau, ipass_check_adjust_inputs + write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) + end if +! *** this is for testing +! when iflag_ecpp_test_fixed_fcloud == 2/3/4/5, +! set clear fractions to 1.0/0.0/0.7/0.3 +! set cloudy fractions to 0.0/1.0/0.3/0.7 +! +! *** also set k_max_clouds=kte+1 so that it has no effect +! + if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & + (iflag_ecpp_test_fixed_fcloud <= 5)) then + k_max_clouds = ktebnd+1 + + if (iflag_ecpp_test_fixed_fcloud == 2) then + tmpvecaa(1) = 1.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 3) then + tmpvecaa(1) = 0.0_r8 + else if (iflag_ecpp_test_fixed_fcloud == 4) then + tmpvecaa(1) = 0.7_r8 + else + tmpvecaa(1) = 0.3_r8 + end if + tmpvecaa(2) = 1.0_r8 - tmpvecaa(1) + + do k = kts, ktebnd + do jcls = 1, ncls_use + tmpa = sum( mfbnd_use(k,1:2,jcls) ) + mfbnd_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) + + tmpa = sum( abnd_tavg_use(k,1:2,jcls) ) + abnd_tavg_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) + + if (k > ktecen) cycle + + tmpa = sum( acen_tavg_use(k,1:2,jcls) ) + acen_tavg_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) + + tmpa = sum( acen_tfin_use(k,1:2,jcls) ) + acen_tfin_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) + end do ! jcls + end do ! k + end if ! ((iflag_ecpp_test_fixed_fcloud >= 2) .and. (iflag_ecpp_test_fixed_fcloud <= 5)) + + +! check that fractional areas sum to 1.0 (within small tolerance) +! then normalize to exactly 1.0 +! also check and total quiescent areas are each >= a_quiescn_minaa + do k = kts, ktebnd + do jcls = 1, ncls_use + abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) + if (k > ktecen) cycle + acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) + acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) + end do + do icc = 0, 2 + abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) + if (k > ktecen) cycle + acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) + acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) + end do + + do i = 1, 3 + if ((i >= 2) .and. (k > ktecen)) cycle + if (i == 1) then + tmpa = abnd_tavg_use(k,0,0) + else if (i == 2) then + tmpa = acen_tavg_use(k,0,0) + else + tmpa = acen_tfin_use(k,0,0) + end if + if (abs(tmpa-1.0_r8) < a_sum_toleraa) cycle + write(msg,'(2a,i5,1pe15.7)') & + '*** parampollu_check_adjust_inputs - bad ', & + area_name10(i), k, tmpa + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + end do + + tmpa = abnd_tavg_use(k,0,0) + abnd_tavg_use(k,0:2,0:ncls_use) = abnd_tavg_use(k,0:2,0:ncls_use)/tmpa + if (k <= ktecen) then + tmpa = acen_tavg_use(k,0,0) + acen_tavg_use(k,0:2,0:ncls_use) = acen_tavg_use(k,0:2,0:ncls_use)/tmpa + tmpa = acen_tfin_use(k,0,0) + acen_tfin_use(k,0:2,0:ncls_use) = acen_tfin_use(k,0:2,0:ncls_use)/tmpa + end if + + do i = 1, 3 + if ((i >= 2) .and. (k > ktecen)) cycle + jcls = jcls_qu + if (i == 1) then + tmpa = abnd_tavg_use(k,0,jcls) + else if (i == 2) then + tmpa = acen_tavg_use(k,0,jcls) + else + tmpa = acen_tfin_use(k,0,jcls) + end if + msg = ' ' + if (tmpa < a_quiescn_minaa) then + write(msg,'(2a,i5,1p,2e10.2)') & + '*** parampollu_check_adjust_inputs - a_quiescent(v1) too small ', & + area_name10(i), k, tmpa, a_quiescn_minaa + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + end if + end do + + end do + + +! eliminate cloudy subareas when k >= k_max_clouds + do k = kts, ktebnd + if (k < k_max_clouds) cycle + mfbnd_use( k,1,0:ncls_use) = mfbnd_use( k,1,0:ncls_use) & + + mfbnd_use( k,2,0:ncls_use) + mfbnd_use( k,2,0:ncls_use) = 0.0_r8 + abnd_tavg_use(k,1,0:ncls_use) = abnd_tavg_use(k,1,0:ncls_use) & + + abnd_tavg_use(k,2,0:ncls_use) + abnd_tavg_use(k,2,0:ncls_use) = 0.0_r8 + if (k > ktecen) cycle + acen_tavg_use(k,1,0:ncls_use) = acen_tavg_use(k,1,0:ncls_use) & + + acen_tavg_use(k,2,0:ncls_use) + acen_tavg_use(k,2,0:ncls_use) = 0.0_r8 + acen_tfin_use(k,1,0:ncls_use) = acen_tfin_use(k,1,0:ncls_use) & + + acen_tfin_use(k,2,0:ncls_use) + acen_tfin_use(k,2,0:ncls_use) = 0.0_r8 + end do + + +! at k = kts and k >= k_max_wnonzero +! set mfbnd and wbnd_bar = 0 +! set areas = 0 for drafts (at kts set abnd=0 but allow acen>0) + do k = kts, ktebnd + if ((k > kts) .and. (k < k_max_wnonzero)) cycle + + mfbnd_use(k,:,:) = 0.0_r8 + wbnd_bar_use(k) = 0.0_r8 + + do jcls = 1, ncls_use + if (jcls == jcls_qu) then + abnd_tavg_use(k,0:2,jcls) = abnd_tavg_use(k,0:2,0) + if ((k == kts) .or. (k > ktecen)) cycle + acen_tavg_use(k,0:2,jcls) = acen_tavg_use(k,0:2,0) + acen_tfin_use(k,0:2,jcls) = acen_tfin_use(k,0:2,0) + else + abnd_tavg_use(k,0:2,jcls) = 0.0_r8 + if ((k == kts) .or. (k > ktecen)) cycle + acen_tavg_use(k,0:2,jcls) = 0.0_r8 + acen_tfin_use(k,0:2,jcls) = 0.0_r8 + end if + end do + end do + + +! at k >= k_max_updndraft +! set mfbnd = 0 and areas = 0 for drafts +! set mfbnd = abnd*wbnd_bar*rhobnd_bar for quiescents + do k = kts, ktebnd + if ((k < k_max_updndraft) .or. (k >= k_max_wnonzero)) cycle + + do jcls = 1, ncls_use + if (jcls == jcls_qu) then + abnd_tavg_use(k,0:2,jcls) = abnd_tavg_use(k,0:2,0) + mfbnd_use(k,1:2,jcls) = & + abnd_tavg_use(k,1:2,jcls)*wbnd_bar_use(k)*rhobnd_bar(k) + if (k > ktecen) cycle + acen_tavg_use(k,0:2,jcls) = acen_tavg_use(k,0:2,0) + acen_tfin_use(k,0:2,jcls) = acen_tfin_use(k,0:2,0) + else + abnd_tavg_use(k,0:2,jcls) = 0.0_r8 + mfbnd_use(k,0:2,jcls) = 0.0_r8 + if (k > ktecen) cycle + acen_tavg_use(k,0:2,jcls) = 0.0_r8 + acen_tfin_use(k,0:2,jcls) = 0.0_r8 + end if + end do + end do + + + if ((ktau==4) .and. (lun155 > 0)) then + write(lun155,'(/a,3i5)') 'bbb', ktau, ipass_check_adjust_inputs + write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) + end if +! +! check updraft/dndraft +! + do 3590 jcls = 1, ncls_use + if (jcls == jcls_qu) goto 3590 + + do 3490 icc = 1, 2 + jclsicc = jcls*10 + icc + +! check kts <= kdraft_bot <= ktecen +! and kdraft_bot < kdraft_top <= ktecen + if ( (kdraft_bot_use(icc,jcls) < kts) .or. & + (kdraft_bot_use(icc,jcls) > ktecen) .or. & + (kdraft_top_use(icc,jcls) <= kdraft_bot_use(icc,jcls)) .or. & + (kdraft_top_use(icc,jcls) > ktecen) ) then + msg = '*** parampollu_check_adjust_inputs - ' // & + 'bad up/dndraft kdraft_bot/_top' + call ecpp_message( lunout, msg ) + write( msg, '(a,4(1x,i5))' ) 'it, jt, jclsicc, mtype_updnenv =', & + it, jt, jclsicc, icc, mtype_updnenv_use(icc,jcls) + call ecpp_message( lunout, msg ) + write( msg, '(a,2(1x,i5),2(1x,i10))' ) & + 'kts, ktebnd, kdraft_bot, kdraft_top =', & + kts, ktebnd, kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + end if + +! check/adjust mbfnd_use and abnd_tavg_use +! if either is below the cut-off value, set both to zero +! also set both to zero outside of [kdraft_bot_use, kdraft_top_use] +! set the kdraft_bot/top_use +! +! note that kdraft_bot/top define bottom/top for layer centers +! for layer boundaries, the up/dndraft mfbnd and abnd are zero +! at the bottom of kdraft_bot and at the top of kdraft_top +! + ktmpa = -999888777 ; ktmpb = -999888778 + do k = kts, ktebnd + arw_draft_cut = aw_draft_cut*rhobnd_bar(k) + + tmp_mfa = mfbnd_use(k,icc,jcls) + tmp_mfb = tmp_mfa + tmpa = abnd_tavg_use(k,icc,jcls) + tmpb = tmpa + + if ( (k <= kdraft_bot_use(icc,jcls)) .or. & + (k > kdraft_top_use(icc,jcls)) .or. & + (k == kts) ) then + tmp_mfb = 0.0_r8 + else + if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then + if ( tmp_mfa < arw_draft_cut) tmp_mfb = 0.0_r8 + else + if (-tmp_mfa < arw_draft_cut) tmp_mfb = 0.0_r8 + end if + if (abnd_tavg_use(k,icc,jcls) < afrac_cut) tmp_mfb = 0.0_r8 + end if + + if (tmp_mfb /= 0.0_r8) then + tmpb = max( tmpb, afrac_cut ) + else + tmpb = 0.0_r8 + end if + + mfbnd_use(k,icc,jcls) = tmp_mfb + abnd_tavg_use(k,icc,jcls) = tmpb + if (tmp_mfb /= 0.0_r8) then + if (ktmpa <= 0) ktmpa = k-1 + ktmpb = k + end if + +! set change counts +! increment/decrement abnd of quiescent class if up/dndraft abnd has changed + if (tmp_mfb /= tmp_mfa) then + nchanges(1) = nchanges(1) + 1 + end if + if (tmpb /= tmpa) then + nchanges(2) = nchanges(2) + 1 + abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & + + (tmpa-tmpb) + end if + + end do + + kdraft_bot_use(icc,jcls) = ktmpa + kdraft_top_use(icc,jcls) = ktmpb + +! check/adjust acen_tavg_use +! set acen_tavg to zero outside of kdraft_bot:kdraft_top +! set acen_tavg to zero if abnd_tavg=0 at both layer boundaries (14-apr-2009) + do k = kts, ktecen + tmpa = acen_tavg_use(k,icc,jcls) + tmpb = tmpa + + if ( (k < kdraft_bot_use(icc,jcls)) .or. & + (k > kdraft_top_use(icc,jcls)) ) then + tmpb = 0.0_r8 + else + tmpe = 0.5_r8*( abnd_tavg_use(k, icc,jcls) + & + abnd_tavg_use(k+1,icc,jcls) ) + if (tmpe > 0.0_r8) then + tmpb = max( afrac_cut, tmpe ) + else + tmpb = 0.0_r8 + end if + end if + + if (tmpb /= tmpa) then + nchanges(3) = nchanges(3) + 1 + acen_tavg_use(k,icc,jcls_qu) = & + acen_tavg_use(k,icc,jcls_qu) + (tmpa-tmpb) + end if + + acen_tavg_use(k,icc,jcls) = tmpb + end do + +! check/adjust acen_tfin_use +! set acen_tfin to zero if it is < afrac_cut or if k >= k_max_updndraft +! set acen_tfin to zero if acen_tavg=0 (14-apr-2009) +! for case of parampollu_opt == 2220, but iflag_ecpp_test_fixed_fcloud /= 2,3,4,5 +! do not allow acen_tfin=0 if acen_tavg>0 +! (14-apr-2009 -- do similar for all parampollu_opt) + ispecial_check_acen_tfin = 0 + if (parampollu_opt == 2220) then + ispecial_check_acen_tfin = 1 + if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & + (iflag_ecpp_test_fixed_fcloud <= 5)) ispecial_check_acen_tfin = 0 + end if + if (ispecial_check_acen_tfin <= 0) then + ispecial_check_acen_tfin = 2 + if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & + (iflag_ecpp_test_fixed_fcloud <= 5)) ispecial_check_acen_tfin = 0 + end if + + do k = kts, ktecen + tmpa = acen_tfin_use(k,icc,jcls) + tmpb = tmpa + + if ((tmpa < afrac_cut) .or. & + (k >= k_max_updndraft)) then + tmpb = 0.0_r8 + end if + if (acen_tavg_use(k,icc,jcls) <= 0.0_r8) then + tmpb = 0.0_r8 + end if + + if (ispecial_check_acen_tfin > 0) then + if (tmpb < afrac_cut) then + if (acen_tavg_use(k,icc,jcls) >= afrac_cut) then + if (ispecial_check_acen_tfin == 2) then + tmpb = max( 0.5_r8*acen_tavg_use(k,icc,jcls), afrac_cut ) + else + tmpb = acen_tavg_use(k,icc,jcls) + end if + end if + end if + end if + + if (tmpb /= tmpa) then + nchanges(4) = nchanges(4) + 1 + acen_tfin_use(k,icc,jcls_qu) = & + acen_tfin_use(k,icc,jcls_qu) + (tmpa-tmpb) + end if + + acen_tfin_use(k,icc,jcls) = tmpb + end do + +! for empty sub-class (mfbnd/abnd/acen=0 at all levels), +! set kdraft_bot/top_use to ktecen + if ((kdraft_bot_use(icc,jcls) < -999888000) .and. & + (kdraft_top_use(icc,jcls) < -999888000)) then + kdraft_bot_use(icc,jcls) = ktecen + kdraft_top_use(icc,jcls) = ktecen + end if + +3490 continue + +! sum clear and cloudy mfbnd_use + do k = kts, ktebnd + mfbnd_use(k,0,jcls) = sum( mfbnd_use(k,1:2,jcls) ) + end do + +3590 continue + + +! +! check/adjust quiescent transport-class +! + + if ((ktau==4) .and. (lun155 > 0)) then + write(lun155,'(/a,3i5)') 'ccc', ktau, ipass_check_adjust_inputs + write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) + end if +! first set to zero any areas that are < afrac_cut + do k = kts, ktebnd + do i = 1, 3 + jcls = jcls_qu + if ((i >= 2) .and. (k > ktecen)) cycle + + if (i == 1) then + tmpvecaa(0:2) = abnd_tavg_use(k,0:2,jcls) + else if (i == 2) then + tmpvecaa(0:2) = acen_tavg_use(k,0:2,jcls) + else + tmpvecaa(0:2) = acen_tfin_use(k,0:2,jcls) + end if + + tmpvecbb(0:2) = tmpvecaa(0:2) + tmpvecbb(0) = tmpvecbb(1) + tmpvecbb(2) + do icc = 1, 2 + if (tmpvecbb(icc) < afrac_cut) then + tmpvecbb(3-icc) = tmpvecbb(0) + tmpvecbb(icc) = 0.0_r8 + end if + end do + +! for case of parampollu_opt == 2220, but iflag_ecpp_test_fixed_fcloud /= 2,3,4,5 +! do not allow acen_tfin=0 if acen_tavg>0 + if ((i == 3) .and. (ispecial_check_acen_tfin > 0)) then + do icc = 1, 2 + if (tmpvecbb(icc) < afrac_cut) then + if (acen_tavg_use(k,icc,jcls) >= afrac_cut) then + tmpvecbb(icc) = acen_tavg_use(k,icc,jcls) + tmpvecbb(3-icc) = tmpvecbb(0) - tmpvecbb(icc) + end if + end if + end do + end if + + if ((tmpvecbb(1) < 0.0_r8) .or. & + (tmpvecbb(2) < 0.0_r8) .or. & + (tmpvecbb(0) < a_quiescn_minbb)) then +! at this point, the total (adjusted) quiescent area is too small + write(msg,'(a,1p,3e12.4)') & + ' tmpvecaa(0:2) = v1 quiescent areas =', tmpvecaa(0:2) + call ecpp_message( lunout, msg ) + write(msg,'(a,1p,3e12.4)') & + ' tmpvecbb(0:2) = v2 quiescent areas =', tmpvecbb(0:2) + call ecpp_message( lunout, msg ) + + write(msg,'(2a,2i5)') & + '*** parampollu_check_adjust_inputs - a_quiescent(v2) too small ', & + area_name10(i), k, i + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + end if + + if (i == 1) then + abnd_tavg_use(k,0:2,jcls) = tmpvecbb(0:2) + else if (i == 2) then + acen_tavg_use(k,0:2,jcls) = tmpvecbb(0:2) + else + acen_tfin_use(k,0:2,jcls) = tmpvecbb(0:2) + end if + end do ! i = 1, 3 + end do ! k = kts, ktebnd + + +! recalc summed area fractions + do k = kts, ktebnd + do jcls = 1, ncls_use + abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) + if (k > ktecen) cycle + acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) + acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) + end do + do icc = 0, 2 + abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) + if (k > ktecen) cycle + acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) + acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) + end do + end do ! k = kts, ktebnd + + +! calc kdraft_bot_use & kdraft_top_use + jcls = jcls_qu + do icc = 1, 2 + ktmpa = -999888777 ; ktmpb = -999888778 + do k = kts, ktecen + if (acen_tavg_use(k,icc,jcls) > 0.0_r8) then + if (ktmpa <= 0) ktmpa = k + ktmpb = k + end if + end do + kdraft_bot_use(icc,jcls) = ktmpa + kdraft_top_use(icc,jcls) = ktmpb + end do + +! normally allow cloudy quiescent to be empty +! if iflag_ecpp_test_fixed_fcloud=3 (special testing), allow clear quiescent to be empty + icc = 2 + if (iflag_ecpp_test_fixed_fcloud == 3) icc = 1 + if ((kdraft_bot_use(icc,jcls) < -999888000) .and. & + (kdraft_top_use(icc,jcls) < -999888000)) then + kdraft_bot_use(icc,jcls) = ktecen + kdraft_top_use(icc,jcls) = ktecen + end if + +! check for validity of kdraft_bot_use & kdraft_top_use + ka = min( kdraft_bot_use(1,jcls), kdraft_bot_use(2,jcls) ) + kb = max( kdraft_top_use(1,jcls), kdraft_top_use(2,jcls) ) + do icc = 1, 2 + if ( (kdraft_bot_use(icc,jcls) < kts) .or. & + (kdraft_bot_use(icc,jcls) > ktecen) .or. & + (kdraft_bot_use(icc,jcls) > kdraft_top_use(icc,jcls)) .or. & + (kdraft_top_use(icc,jcls) > ktecen) .or. & + (ka /= kts) .or. & + (kb /= ktecen) ) then + jclsicc = jcls*10 + icc + msg = '*** parampollu_check_adjust_inputs - ' // & + 'bad quiescent transport-class kdraft_bot/top_use' + call ecpp_message( lunout, msg ) + write( msg, '(a,4(1x,i5))' ) 'it, jt, jclsicc, mtype_updnenv =', & + it, jt, jclsicc, mtype_updnenv_use(icc,jcls) + call ecpp_message( lunout, msg ) + write( msg, '(a,2(1x,i5),2(1x,i10))' ) & + 'kts, ktebnd, kdraft_bot, kdraft_top =', & + kts, ktebnd, kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) + call ecpp_message( lunout, msg ) + call ecpp_error_fatal( lunout, msg ) + end if + end do + + +!----------------------------------------------------- +! here ipass_check_adjust_inputs == 1 +! skip over the special stuff for ipass_check_adjust_inputs == 2 +!----------------------------------------------------- + if ((ktau==4) .and. (lun155 > 0)) then + write(lun155,'(/a,3i5)') 'ddd', ktau, ipass_check_adjust_inputs + write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) + end if + goto 30000 + + +!----------------------------------------------------- +! special stuff for ipass_check_adjust_inputs == 2 +!----------------------------------------------------- +20000 continue + ipass_2_changes = 0 + + +! for testing only -- reduce up/dndraft areas +! *** NOTE / TODO - in the "new" code, this may not work correctly + ido_updndr_area_adjust = 0 + if (ido_updndr_area_adjust > 0) then + ipass_2_changes = ipass_2_changes + 1 + + updndr_area_adjust = 1.0_r8 + tmpb = 1.0_r8 - updndr_area_adjust + do k = kts, ktebnd + do icc = 0, 2 + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle + + abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & + + abnd_tavg_use(k,icc,jcls )*tmpb + abnd_tavg_use(k,icc,jcls ) = abnd_tavg_use(k,icc,jcls )*updndr_area_adjust + + if (k > ktecen) cycle + + acen_tavg_use(k,icc,jcls_qu) = acen_tavg_use(k,icc,jcls_qu) & + + acen_tavg_use(k,icc,jcls )*tmpb + acen_tavg_use(k,icc,jcls ) = acen_tavg_use(k,icc,jcls )*updndr_area_adjust + + acen_tfin_use(k,icc,jcls_qu) = acen_tfin_use(k,icc,jcls_qu) & + + acen_tfin_use(k,icc,jcls )*tmpb + acen_tfin_use(k,icc,jcls ) = acen_tfin_use(k,icc,jcls )*updndr_area_adjust + + end do + end do + end do + end if ! (ido_updndr_area_adjust > 0) + + +! for testing only -- zero out downdraft +! *** NOTE / TODO - in the "new" code, this may not work correctly + ido_downdr_area_zeroout = 0 + if (ido_downdr_area_zeroout > 0) then + ipass_2_changes = ipass_2_changes + 1 + + do k = kts, ktebnd + do icc = 0, 2 + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle + if (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp) cycle + + abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & + + abnd_tavg_use(k,icc,jcls ) + abnd_tavg_use(k,icc,jcls ) = 0.0_r8 + + mfbnd_use( k,icc,jcls_qu) = mfbnd_use( k,icc,jcls_qu) & + + mfbnd_use( k,icc,jcls ) + mfbnd_use( k,icc,jcls ) = 0.0_r8 + + if (k > ktecen) cycle + + acen_tavg_use(k,icc,jcls_qu) = acen_tavg_use(k,icc,jcls_qu) & + + acen_tavg_use(k,icc,jcls ) + acen_tavg_use(k,icc,jcls ) = 0.0_r8 + + acen_tfin_use(k,icc,jcls_qu) = acen_tfin_use(k,icc,jcls_qu) & + + acen_tfin_use(k,icc,jcls ) + acen_tfin_use(k,icc,jcls ) = 0.0_r8 + end do + end do + end do + end if ! (ido_downdr_area_zeroout > 0) + + +! if (ipass_2_changes == 0) return + + +!----------------------------------------------------- +! common stuff for ipass_check_adjust_inputs == 1,2 +!----------------------------------------------------- +30000 continue +! +! check/adjust quiescent abnd_tavg_use (and mfbnd_use) +! +! before 15-jul-2008 code +! code above may have set afrac_bnd=0 in some transport-class +! now adjust afrac_bnd in quiescent transport-class so that +! all-transport-class-sum = 1.0 +! +! on/after 15-jul-2008 code +! the post-processor does not correctly identify the clear versus +! cloudy parts of the quiescent abnd_tavg +! (it calcs an average qcloud for 2 layers adjacent to the boundary, +! and if qcloud in either layer exceeds cutoff, then the average +! will too (almost always), so this is biased) +! so instead, set these based on the clear/cloud quiescent acen_tavg_use +! also, apportion the quiescent mfbnd_use similarly +! + mfbnd_quiescn_up(:,:,:) = 0.0_r8 + mfbnd_quiescn_dn(:,:,:) = 0.0_r8 + + jcls = jcls_qu + do k = kts, ktecen +! first calc tmpvecdd(k) = fraction of layer-k quiescent-class that is clear + ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 + if ((acen_tavg_use(k,1,jcls) >= ardz_cut) .and. & + (acen_tavg_use(k,2,jcls) >= ardz_cut)) then + ! clear and cloudy both > 0 + tmpvecdd(k) = acen_tavg_use(k,1,jcls)/acen_tavg_use(k,0,jcls) + tmpvecdd(k) = max( 0.0_r8, min( 1.0_r8, tmpvecdd(k) ) ) + else if (acen_tavg_use(k,2,jcls) >= ardz_cut) then + ! only cloudy > 0 + tmpvecdd(k) = 0.0_r8 + else + ! only clear > 0 + tmpvecdd(k) = 1.0_r8 + end if + end do + + + do k = kts+1, ktecen +! calc (total quiescent "w-prime" mass flux) = - (sum of up/dndraft mass fluxes) + tmp_mfa = 0.0_r8 + do jcls = 1, ncls_use + if (jcls == jcls_qu) cycle + mfbnd_use(k,0,jcls) = sum( mfbnd_use(k,1:2,jcls) ) + tmp_mfa = tmp_mfa + mfbnd_use(k,0,jcls) + end do + jcls = jcls_qu + mfbnd_use(k,0,jcls) = -tmp_mfa + +! partition total quiescent mass flux to clear/cloudy using the +! quiescent clear/cloud amounts in the "upwind" layer + if (mfbnd_use(k,0,jcls) < 0.0_r8) then + tmpvecaa(1) = tmpvecdd(k) ! upwind is layer above + tmpvecbb(1) = tmpvecdd(k-1) ! downwind is layer below + else + tmpvecaa(1) = tmpvecdd(k-1) ! upwind is layer below + tmpvecbb(1) = tmpvecdd(k) ! downwind is layer above + end if + tmpvecaa(2) = 1.0_r8 - tmpvecaa(1) + tmpvecbb(2) = 1.0_r8 - tmpvecbb(1) + + mfbnd_use(k,1:2,jcls) = mfbnd_use(k,0,jcls)*tmpvecaa(1:2) +! same for abnd + abnd_tavg_use(k,1:2,jcls) = abnd_tavg_use(k,0,jcls)*tmpvecaa(1:2) + +! do other sums + do icc = 0, 2 + mfbnd_use( k,icc,0) = sum( mfbnd_use( k,icc,1:ncls_use) ) + abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) + end do + + +! now calculate more detailed up and down fluxes +! mfbnd_quiescn_up(k,jccfrom,jcctooo) is mbbnd from (k,jccfrom) to (k+1,jcctooo) +! with jccfrom=0/1/2=both/clear/cloudy; and jcctooo=0/1/2=similar +! +! the clear-->both and cloudy-->both are already determined +! the clear-->clear and cloudy-->cloudy are calculated maximum overlap +! of cloudy and clear regions +! the clear-->cloudy and cloudy-->clear are simply what is left +! +! tmpvecaa holds clear/cloudy fractions of the upwind layer +! tmpvecbb holds clear/cloudy fractions of the downwind layer + jcls = jcls_qu + tmp0202aa(0:2,0) = mfbnd_use(k,0:2,jcls) + tmp0202aa(0:2,1:2) = 0.0_r8 + do ja = 1, 2 + jb = 3-ja + tmpa = 0.0_r8 + if (tmpvecaa(ja) > 0.0_r8) & + tmpa = min(tmpvecbb(ja),tmpvecaa(ja))/tmpvecaa(ja) + tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) + tmp0202aa(ja,ja) = tmp0202aa(ja,0)*tmpa + tmp0202aa(ja,jb) = tmp0202aa(ja,0)*(1.0_r8-tmpa) + end do + do jb = 1, 2 + tmp0202aa(0,jb) = sum( tmp0202aa(1:2,jb) ) + end do + if (mfbnd_use(k,0,jcls) < 0.0_r8) then + mfbnd_quiescn_dn(k,0:2,0:2) = tmp0202aa(0:2,0:2) + else if (mfbnd_use(k,0,jcls) > 0.0_r8) then + mfbnd_quiescn_up(k,0:2,0:2) = tmp0202aa(0:2,0:2) + end if + +! if ((ipass_check_adjust_inputs == 2) .and. (lun141 > 0)) then +! if (k == kts+1) write( 141, '(/a,2i5)' ) & +! 'mfbnd_quiescn at ktau, ipass =', ktau, ipass_check_adjust_inputs +! write( 141, '(i3,1p,2e11.3,2(2x,4e11.3))' ) k, mfbnd_use(k,1:2,jcls), & +! mfbnd_quiescn_up(k,1:2,1:2), mfbnd_quiescn_dn(k,1:2,1:2) +! end if + + end do ! k = kts+1, ktecen + + +! for "empty" drafts, reset the kbot & ktop, and also the mtype_updnenv_use +! +! *** currently the reset of mtype_updnenv_use is deactivated + kdraft_bot_tmp(:,:) = kdraft_bot_use(:,:) + kdraft_top_tmp(:,:) = kdraft_top_use(:,:) + mtype_updnenv_tmp(:,:) = mtype_updnenv_use(:,:) + if (lun63 > 0) write(lun63,'(a/2a)') & + 'parampollu_check_adjust_inputs transport-class summary', & + ' jcls mcc, mf/af nonzero, mtype_tmp/use, ', & + 'kbase/top_inp, kbase/top_tmp, kbase/top_use' + do jcls = 1, ncls_use + do icc = 1, 2 + itmpa = 0 + itmpb = 0 + do k = kts, ktebnd + if (mfbnd_use(k,icc,jcls) /= 0.0_r8) itmpa = itmpa + 1 + if (abnd_tavg_use(k,icc,jcls) /= 0.0_r8) itmpb = itmpb + 1 + end do + if (itmpa+itmpb <= 0) then + kdraft_bot_use(icc,jcls) = ktecen + kdraft_top_use(icc,jcls) = ktecen +! if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then +! mtype_updnenv_use(icc,jcls) = mtype_upempty_ecpp +! else if (mtype_updnenv_use(icc,jcls) == mtype_dndraft_ecpp) then +! mtype_updnenv_use(icc,jcls) = mtype_dnempty_ecpp +! else +! mtype_updnenv_use(icc,jcls) = mtype_quempty_ecpp +! end if + end if + if (lun63 > 0) write(lun63,'(2i5,5(5x,2i5))') & + jcls, icc, itmpa, itmpb, & + mtype_updnenv_tmp(icc,jcls), mtype_updnenv_use(icc,jcls), & + kdraft_bot_ecpp(icc,jcls), kdraft_top_ecpp(icc,jcls), & + kdraft_bot_tmp(icc,jcls), kdraft_top_tmp(icc,jcls), & + kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) + end do + end do + + +! now adjust area with precipitation + acen_prec_use(:,:,:) = 0.0_r8 + do jcls = 1, ncls_use + do icc = 1, 2 + do k = kts, ktecen + if (acen_tavg_use(k,icc,jcls) < afrac_cut) cycle + if (acen_prec_ecpp(k,icc,jcls) < afrac_cut) cycle + + tmpa = acen_prec_ecpp(k,icc,jcls) ! portion of sub-area with precip + tmpb = acen_tavg_use(k,icc,jcls) - tmpa ! portion of sub-area without precip + if (tmpb < afrac_cut) tmpa = acen_tavg_use(k,icc,jcls) + acen_prec_use(k,icc,jcls) = tmpa + end do + end do + end do + + +! final recalc summed area fractions + do k = kts, ktebnd + do jcls = 1, ncls_use + abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) + if (k > ktecen) cycle + acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) + acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) + acen_prec_use(k,0,jcls) = sum( acen_prec_use(k,1:2,jcls) ) + end do + do icc = 0, 2 + abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) + if (k > ktecen) cycle + acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) + acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) + acen_prec_use(k,icc,0) = sum( acen_prec_use(k,icc,1:ncls_use) ) + end do + end do + + + if (lun63 > 0) then + write(lun63,'(a,i2)') 'parampollu_check_adjust_inputs -- ipass =', & + ipass_check_adjust_inputs + do k = 1, 10 + write(lun63,'(a,i2,a,i10)') ' nchanges(', k, ') =', nchanges(k) + end do + end if ! (lun63 > 0) + + + if ((ktau==4) .and. (lun155 > 0)) then + write(lun155,'(/a,3i5)') 'eee', ktau, ipass_check_adjust_inputs + write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) + end if + + return + end subroutine parampollu_check_adjust_inputs + + + +!----------------------------------------------------------------------- + subroutine parampollu_1clm_dumpaa( & + ktau, dtstep, ktau_pp, dtstep_pp, & + tcen_bar, pcen_bar, rhocen_bar, dzcen, & + rhobnd_bar, zbnd, wbnd_bar, & + chem_bar, & + ncls_ecpp, & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp, & + mfbnd, abnd_tavg, & + acen_tavg, acen_tbeg, acen_tfin, & + it, jt, kts,ktebnd,ktecen, & + lun ) + +!----------------------------------------------------------------------- +! DESCRIPTION +! +! parampollu_1clm_dumpaa does a diagnostic print of +! numerous ecpp arrays +! +!----------------------------------------------------------------------- + + use module_data_ecpp1 + + use module_ecpp_util, only: ecpp_error_fatal, ecpp_message + +! arguments + integer, intent(in) :: & + ktau, ktau_pp, & + it, jt, kts, ktebnd, ktecen, & + lun +! ktau - time step number +! ktau_pp - time step number for "parameterized pollutants" calculations + +! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" +! chem_driver and routines under it do calculations +! over these spatial indices. + + real(r8), intent(in) :: dtstep, dtstep_pp +! dtstep - main model time step (s) +! dtstep_pp - time step (s) for "parameterized pollutants" calculations + + real(r8), intent(in), dimension( kts:ktecen ) :: & + tcen_bar, pcen_bar, rhocen_bar, dzcen + real(r8), intent(in), dimension( kts:ktebnd ) :: & + rhobnd_bar, zbnd, wbnd_bar + + real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & + chem_bar + + integer, intent(in) :: ncls_ecpp + + integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & + kdraft_bot_ecpp, kdraft_top_ecpp, & + mtype_updnenv_ecpp + + real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & + mfbnd, abnd_tavg + real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & + acen_tavg, acen_tbeg, acen_tfin + + character(len=8), dimension( kts:ktebnd ) :: dumchar8 + + +! local variables + integer :: iclrcld + integer :: itmp_mtype_clrcldy(1:2) + integer :: jcls, jclsaa, jclsbb + integer :: k, l + + real(r8) :: duma + real(r8), dimension( kts:ktebnd ) :: dumarr1, dumarr2, dumarr3, dumarr4, dumarr5 + + +! +! output with same format as ppboxmakeinp01 +! +9400 format( a ) +9410 format( 5i15 ) +9415 format( a, i10 ) +9416 format( a, 5i10 ) +!9420 format( 5(1pe15.7) ) +9420 format( 5(1pe12.4) ) + + if (lun <= 0) return + + + itmp_mtype_clrcldy(1) = mtype_nocloud_ecpp + itmp_mtype_clrcldy(2) = mtype_iscloud_ecpp + +! write(lun,9400) 'output from ppboxmakeinp01' + write(lun,9400) + write(lun,9400) + write(lun,9416) 'output from ppboxmakeinp01 - ktau, ktau_pp', & + ktau, ktau_pp + + write(lun,9400) 'kts, kte, ncls_ecpp_clm' + write(lun,9410) kts, ktebnd, ncls_ecpp + + write(lun,9410) num_chem_ecpp + + write(lun,9400) 'rho,z,w bnd' + do k = kts, ktebnd + write(lun,9420) rhobnd_bar(k), & + zbnd(k), wbnd_bar(k) + end do + + write(lun,9400) 'p,t,rho cen' + do k = kts, ktecen + write(lun,9420) pcen_bar(k), tcen_bar(k), rhocen_bar(k) + end do + + do l = 1, num_chem_ecpp + write(lun,9415) 'chem ', l + write(lun,9420) (chem_bar(k,l), k=kts,ktecen) + end do + + do jcls = 1, ncls_ecpp + do iclrcld = 1, 2 + write(lun,9416) 'jcls, iclrcld // mtype a,b,c; kdraft a,b', jcls, iclrcld + write(lun,9410) & + mtype_updnenv_ecpp(iclrcld,jcls), & + itmp_mtype_clrcldy(iclrcld), mtype_noprecip_ecpp, & + kdraft_bot_ecpp(iclrcld,jcls), kdraft_top_ecpp(iclrcld,jcls) + + write(lun,9416) 'afrac', jcls, iclrcld + write(lun,9420) (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) + + write(lun,9416) 'mf', jcls, iclrcld + write(lun,9420) (mfbnd(k,iclrcld,jcls), k=kts,ktebnd) + end do + end do + + + write(lun,'(/a)') 'baraa' + write(lun,'(a)') ' k z(km) p(mb) rho t(C) w(cm/s)' + do k = ktebnd, kts, -1 + if (k < ktebnd) then + duma = zbnd(k) + 0.5_r8*dzcen(k) + write(lun,'(i2,2x,f8.3,f8.1,f8.4,f8.1, 8x)') & + k, duma*1.0e-3_r8, pcen_bar(k)*1.0e-2_r8, rhocen_bar(k), tcen_bar(k)-273.16_r8 + end if + duma = k-0.5_r8 + write(lun,'( f4.1,f8.3, 8x,f8.4, 8x,f8.2)') & + duma, zbnd(k)*1.0e-3_r8, rhobnd_bar(k), wbnd_bar(k)*1.0e2_r8 + end do + write(lun,'(a)') ' k z(km) p(mb) rho t(C) w(cm/s)' + + write(lun,'(/a)') 'draftaa' + do jcls = 1, ncls_ecpp + do iclrcld = 1, 2 + write(lun,'(/a,7i5)') 'draftbb - ktau_pp, jcls, iclrcld, updn, clrcldy, top, bot =', & + ktau_pp, jcls, iclrcld, & + mtype_updnenv_ecpp(iclrcld,jcls), itmp_mtype_clrcldy(iclrcld), & + kdraft_bot_ecpp(iclrcld,jcls), kdraft_top_ecpp(iclrcld,jcls) + + write(lun,'(a)') 'afrac' + do k = kts, ktebnd + duma = abnd_tavg(k,iclrcld,jcls) + if (duma == 0.0_r8) then + dumchar8(k) = ' 0. ' + else if (abs(duma) >= 5.0e-5_r8) then + write(dumchar8(k),'(f8.4)') duma + else + write(dumchar8(k),'(1p,e8.0)') duma + end if + end do + write(lun,'(15a)') (dumchar8(k), k=kts,ktebnd) + + do k = kts, ktebnd + duma = max( 1.0e-10_r8, abnd_tavg(k,iclrcld,jcls) ) + dumarr1(k) = mfbnd(k,iclrcld,jcls)/(rhobnd_bar(k)*duma) + end do + write(lun,'(a)') 'w' + write(lun,'(15f8.4)') (dumarr1(k), k=kts,ktebnd) + + write(lun,'(a)') 'mfbnd' + write(lun,'(1p,10e12.5)') (mfbnd(k,iclrcld,jcls), k=kts,ktebnd) + + write(lun,'(a)') 'abnd_tavg' + write(lun,'(1p,10e12.5)') (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) +! write(lun,'(1p,15e8.1 )') (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) + + write(lun,'(a)') 'acen_tavg' + write(lun,'(1p,10e12.5)') (acen_tavg(k,iclrcld,jcls), k=kts,ktecen) + + write(lun,'(a)') 'acen_tbeg' + write(lun,'(1p,10e12.5)') (acen_tbeg(k,iclrcld,jcls), k=kts,ktecen) + + write(lun,'(a)') 'acen_tfin' + write(lun,'(1p,10e12.5)') (acen_tfin(k,iclrcld,jcls), k=kts,ktecen) + + end do + end do + + do k = kts, ktebnd + dumarr1(k) = 0.0_r8 + dumarr2(k) = 0.0_r8 + dumarr3(k) = 0.0_r8 + dumarr4(k) = 0.0_r8 + dumarr5(k) = 0.0_r8 + do jcls = 1, ncls_ecpp + do iclrcld = 1, 2 + dumarr1(k) = dumarr1(k) + mfbnd(k,iclrcld,jcls) + dumarr2(k) = dumarr2(k) + abnd_tavg(k,iclrcld,jcls) + if (k > ktecen) cycle + dumarr3(k) = dumarr3(k) + acen_tavg(k,iclrcld,jcls) + dumarr4(k) = dumarr4(k) + acen_tbeg(k,iclrcld,jcls) + dumarr5(k) = dumarr5(k) + acen_tfin(k,iclrcld,jcls) + end do + end do + duma = max( 1.0e-10_r8, dumarr2(k) ) + dumarr1(k) = dumarr1(k)/(rhobnd_bar(k)*duma) + end do + write(lun,'(/a,4i5)') 'draftbb - ktau_pp, all subs =', & + ktau_pp + write(lun,'(a)') 'wbar' + write(lun,'(12f10.5)') (wbnd_bar(k), k=kts,ktebnd) + write(lun,'(a)') '(mfbnd summed over all subs)/rhobnd' + write(lun,'(12f10.5)') (dumarr1(k), k=kts,ktebnd) + write(lun,'(a)') '(abnd_tavg-1) summed over all subs' + write(lun,'(1p,12e10.2)') ((dumarr2(k)-1.0_r8), k=kts,ktebnd) + write(lun,'(a)') '(acen_tavg-1) summed over all subs' + write(lun,'(1p,12e10.2)') ((dumarr3(k)-1.0_r8), k=kts,ktecen) + write(lun,'(a)') '(acen_tbeg-1) summed over all subs' + write(lun,'(1p,12e10.2)') ((dumarr4(k)-1.0_r8), k=kts,ktecen) + write(lun,'(a)') '(acen_tfin-1) summed over all subs' + write(lun,'(1p,12e10.2)') ((dumarr5(k)-1.0_r8), k=kts,ktecen) + + + do jclsaa = 1, ncls_ecpp, 3 + jclsbb = min( jclsaa+2, ncls_ecpp ) + write(lun,'(/a,3i5)') 'draftcc - ktau_pp, jclsaa, jclsbb', & + ktau_pp, jclsaa, jclsbb + write(lun,'(a)') & + 'k, acen_tavg(k,1:2,jclsaa:jclsbb), mfbnd(k+1,1:2,jclsaa:jclsbb)' + do k = ktecen, kts, -1 + write(lun,'(i3,2x,3(1x,2f8.5),2x,1p,3(1x,2e10.2))') k, & + acen_tavg(k,1:2,jclsaa:jclsbb), & + mfbnd(k,1:2,jclsaa:jclsbb) + end do + end do + + + + return + end subroutine parampollu_1clm_dumpaa + + + +!----------------------------------------------------------------------- + end module module_ecpp_td2clm diff --git a/src/physics/spcam/ecpp/module_ecpp_util.F90 b/src/physics/spcam/ecpp/module_ecpp_util.F90 new file mode 100644 index 0000000000..5318fd75bd --- /dev/null +++ b/src/physics/spcam/ecpp/module_ecpp_util.F90 @@ -0,0 +1,112 @@ +!#********************************************************************************** +! This computer software was prepared by Battelle Memorial Institute, hereinafter +! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of +! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY, +! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE. +! +! miscellaneous debuging routines for CBMZ and MOSAIC +!********************************************************************************** + module module_ecpp_util + + use cam_abortutils, only: endrun + + contains + +!----------------------------------------------------------------------- + subroutine ecpp_debugmsg( lun, level, str ) +! +! when lun > 0, writes "str" to unit "lun" +! when lun <= 0, passes "str" on to wrf_debug +! + implicit none +! subr arguments + integer, intent(in) :: lun, level + character(len=*), intent(in) :: str +! local variables + integer n + + n = max( 1, len_trim(str) ) + if (lun .ge. 0) then + write(lun,'(a)') str(1:n) + else + call endrun( str(1:n) ) + end if + return + end subroutine ecpp_debugmsg + + +!----------------------------------------------------------------------- + subroutine ecpp_message( lun, str ) +! +! when lun > 0, writes "str" to unit "lun" +! when lun <= 0, passes "str" on to wrf_message +! + implicit none +! subr arguments + integer, intent(in) :: lun + character(len=*), intent(in) :: str +! local variables + integer n + + n = max( 1, len_trim(str) ) + if (lun .ge. 0) then + write(lun,'(a)') str(1:n) + else + call endrun( str(1:n) ) + end if + return + end subroutine ecpp_message + + +!----------------------------------------------------------------------- + subroutine ecpp_error_fatal( lun, str ) +! +! when lun > 0, writes "str" to unit "lun" +! then (always) passes "str" on to wrf_error_fatal +! + implicit none +! subr arguments + integer, intent(in) :: lun + character(len=*), intent(in) :: str +! local variables + integer n + + n = max( 1, len_trim(str) ) + call endrun( str(1:n) ) + return + end subroutine ecpp_error_fatal + + +!----------------------------------------------------------------------- + subroutine parampollu_1clm_set_opts( & + xppopt_updn_prof_aa, & + xppopt_quiescn_mf, xppopt_quiescn_sosi, & + xppopt_chemtend_wq, xppopt_chemtend_dtsub, & + xppopt_chemtend_updnfreq ) + + use module_data_ecpp1 + + implicit none + + +! subr arguments + integer, intent(in) :: & + xppopt_updn_prof_aa, & + xppopt_quiescn_mf, xppopt_quiescn_sosi, & + xppopt_chemtend_wq, xppopt_chemtend_dtsub, & + xppopt_chemtend_updnfreq + + + ppopt_updn_prof_aa = xppopt_updn_prof_aa + ppopt_quiescn_mf = xppopt_quiescn_mf + ppopt_quiescn_sosi = xppopt_quiescn_sosi + ppopt_chemtend_wq = xppopt_chemtend_wq + ppopt_chemtend_dtsub = xppopt_chemtend_dtsub + ppopt_chemtend_updnfreq = xppopt_chemtend_updnfreq + + + return + end subroutine parampollu_1clm_set_opts + +!----------------------------------------------------------------------- + end module module_ecpp_util diff --git a/src/physics/spcam/spcam_drivers.F90 b/src/physics/spcam/spcam_drivers.F90 new file mode 100644 index 0000000000..91a90aa28b --- /dev/null +++ b/src/physics/spcam/spcam_drivers.F90 @@ -0,0 +1,2396 @@ +module spcam_drivers + + +use camsrfexch, only: cam_out_t, cam_in_t +use ppgrid, only: pcols, pver +use camsrfexch , only: cam_export +use shr_kind_mod, only: r8 => shr_kind_r8 +#ifdef CRM +use crmdims, only: crm_nx, crm_ny, crm_nz +#endif +use radiation, only: rad_out_t +use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index +use physics_types, only: physics_state, physics_state_copy, physics_ptend +use pkg_cldoptics, only: cldems, cldovrlap, cldefr +use phys_grid, only: get_rlat_all_p, get_rlon_all_p +use cam_history, only: outfld +use cam_history_support, only : fillvalue + +implicit none +save +private + +type rad_avgdata_type_sam1mom + real(r8), allocatable :: solin_m(:) ! Solar incident flux + real(r8), allocatable :: fsntoa_m(:) ! Net solar flux at TOA + real(r8), allocatable :: fsutoa_m(:) ! upwelling solar flux at TOA + real(r8), allocatable :: fsntoac_m(:) ! Clear sky net solar flux at TOA + real(r8), allocatable :: fsnirt_m(:) ! Near-IR flux absorbed at toa + real(r8), allocatable :: fsnrtc_m(:) ! Clear sky near-IR flux absorbed at toa + real(r8), allocatable :: fsnirtsq_m(:) ! Near-IR flux absorbed at toa >= 0.7 microns + real(r8), allocatable :: fsntc_m(:) ! Clear sky total column abs solar flux + real(r8), allocatable :: fsnsc_m(:) ! Clear sky surface abs solar flux + real(r8), allocatable :: fsdsc_m(:) ! Clear sky surface downwelling solar flux + real(r8), allocatable :: flut_m(:) ! Upward flux at top of model + real(r8), allocatable :: flutc_m(:) ! Upward Clear Sky flux at top of model + real(r8), allocatable :: flntc_m(:) ! Clear sky lw flux at model top + real(r8), allocatable :: flnsc_m(:) ! Clear sky lw flux at srf (up-down) + real(r8), allocatable :: fldsc_m(:) ! Clear sky lw flux at srf (down) + real(r8), allocatable :: flwds_m(:) ! Down longwave flux at surface + real(r8), allocatable :: fsns_m(:) ! Surface solar absorbed flux + real(r8), allocatable :: fsnr_m(:) + real(r8), allocatable :: fsnt_m(:) ! Net column abs solar flux at model top + real(r8), allocatable :: flns_m(:) ! Srf longwave cooling (up-down) flux + real(r8), allocatable :: flnt_m(:) ! Net outgoing lw flux at model top + real(r8), allocatable :: flnr_m(:) + real(r8), allocatable :: fsds_m(:) ! Surface solar down flux + real(r8), allocatable :: fln200_m(:) ! net longwave flux interpolated to 200 mb + real(r8), allocatable :: fln200c_m(:) ! net clearsky longwave flux interpolated to 200 mb + real(r8), allocatable :: fsn200_m(:) ! fns interpolated to 200 mb + real(r8), allocatable :: fsn200c_m(:) ! fcns interpolated to 200 mb + real(r8), allocatable :: sols_m(:) ! Solar downward visible direct to surface + real(r8), allocatable :: soll_m(:) ! Solar downward near infrared direct to surface + real(r8), allocatable :: solsd_m(:) ! Solar downward visible diffuse to surface + real(r8), allocatable :: solld_m(:) ! Solar downward near infrared diffuse to surface + real(r8), allocatable :: qrs_m(:,:) + real(r8), allocatable :: qrl_m(:,:) + real(r8), allocatable :: qrsc_m(:,:) + real(r8), allocatable :: qrlc_m(:,:) + real(r8), allocatable :: rel_crm(:,:,:,:) + real(r8), allocatable :: rei_crm(:,:,:,:) + real(r8), allocatable :: qrl_crm(:,:,:,:) + real(r8), allocatable :: qrs_crm(:,:,:,:) + real(r8), allocatable :: fsdtoa_m(:) ! Solar input = Flux Solar Downward Top of Atmosphere + real(r8), allocatable :: flds_m(:) ! Down longwave flux at surface + + real(r8), pointer :: t_rad (:,:,:,:) ! rad temperuture + real(r8), pointer :: qv_rad(:,:,:,:) ! rad vapor + real(r8), pointer :: qc_rad(:,:,:,:) ! rad cloud water + real(r8), pointer :: qi_rad(:,:,:,:) ! rad cloud ice + real(r8), pointer :: crm_qrad(:,:,:,:) ! rad heating + + real(r8), allocatable :: tot_cld_vistau_m(:,:) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: tot_icld_vistau_m(:,:) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: liq_icld_vistau_m(:,:) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: ice_icld_vistau_m(:,:) ! in-cld ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: nct_tot_icld_vistau_m(:,:) ! the number of CRM columns that has in-cloud visible sw optical depth + real(r8), allocatable :: nct_liq_icld_vistau_m(:,:) ! the number of CRM column that has liq in-cloud visible sw optical depth + real(r8), allocatable :: nct_ice_icld_vistau_m(:,:) ! the number of CRM column that has ice in-cloud visible sw optical depth + + ! Just used in m2005 -- needed for compilation only + real(r8), allocatable :: snow_icld_vistau_m(:,:) ! snow in-cloud visible sw optical depth for output on history files + real(r8), allocatable :: nct_snow_icld_vistau_m(:,:) ! the number of CRM column that has snow in-cloud visible sw optical depth + real(r8), allocatable :: crm_aodvisz(:,:,:,:) ! layer aerosol optical depth at 550nm at CRM grids + real(r8), allocatable :: crm_aodvis(:,:,:) ! AOD at 550nm at CRM grids + real(r8), allocatable :: crm_aod400(:,:,:) ! AOD at 400nm at CRM grids + real(r8), allocatable :: crm_aod700(:,:,:) ! AOD at 700nm at CRM grids + real(r8), allocatable :: aod400(:) ! AOD at 400nm at CRM grids + real(r8), allocatable :: aod700(:) ! AOD at 700nm at CRM grids + real(r8), allocatable :: cld_tau_crm(:,:,:,:) + real(r8), allocatable :: crm_fsnt(:,:,:) ! net shortwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_fsntc(:,:,:) ! net clear-sky shortwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_fsns(:,:,:) ! net shortwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_fsnsc(:,:,:) ! net clear-sky shortwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_flnt(:,:,:) ! net longwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_flntc(:,:,:) ! net clear-sky longwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_flns(:,:,:) ! net longwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_flnsc(:,:,:) ! net clear-sky longwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_swcf(:,:,:) ! shortwave cloud forcing at CRM grids +end type rad_avgdata_type_sam1mom + +type rad_avgdata_type_m2005 + real(r8),allocatable :: solin_m(:) ! Solar incident flux + real(r8),allocatable :: fsntoa_m(:) ! Net solar flux at TOA + real(r8),allocatable :: fsutoa_m(:) ! upwelling solar flux at TOA + real(r8),allocatable :: fsntoac_m(:) ! Clear sky net solar flux at TOA + real(r8),allocatable :: fsnirt_m(:) ! Near-IR flux absorbed at toa + real(r8),allocatable :: fsnrtc_m(:) ! Clear sky near-IR flux absorbed at toa + real(r8),allocatable :: fsnirtsq_m(:) ! Near-IR flux absorbed at toa >= 0.7 microns + real(r8),allocatable :: fsntc_m(:) ! Clear sky total column abs solar flux + real(r8),allocatable :: fsnsc_m(:) ! Clear sky surface abs solar flux + real(r8),allocatable :: fsdsc_m(:) ! Clear sky surface downwelling solar flux + real(r8),allocatable :: flut_m(:) ! Upward flux at top of model + real(r8),allocatable :: flutc_m(:) ! Upward Clear Sky flux at top of model + real(r8),allocatable :: flntc_m(:) ! Clear sky lw flux at model top + real(r8),allocatable :: flnsc_m(:) ! Clear sky lw flux at srf (up-down) + real(r8),allocatable :: fldsc_m(:) ! Clear sky lw flux at srf (down) + real(r8),allocatable :: flwds_m(:) ! Down longwave flux at surface + real(r8),allocatable :: fsns_m(:) ! Surface solar absorbed flux + real(r8),allocatable :: fsnr_m(:) + real(r8),allocatable :: fsnt_m(:) ! Net column abs solar flux at model top + real(r8),allocatable :: flns_m(:) ! Srf longwave cooling (up-down) flux + real(r8),allocatable :: flnt_m(:) ! Net outgoing lw flux at model top + real(r8),allocatable :: flnr_m(:) + real(r8),allocatable :: fsds_m(:) ! Surface solar down flux + real(r8),allocatable :: fln200_m(:) ! net longwave flux interpolated to 200 mb + real(r8),allocatable :: fln200c_m(:) ! net clearsky longwave flux interpolated to 200 mb + real(r8),allocatable :: fsn200_m(:) ! fns interpolated to 200 mb + real(r8),allocatable :: fsn200c_m(:) ! fcns interpolated to 200 mb + real(r8),allocatable :: sols_m(:) ! Solar downward visible direct to surface + real(r8),allocatable :: soll_m(:) ! Solar downward near infrared direct to surface + real(r8),allocatable :: solsd_m(:) ! Solar downward visible diffuse to surface + real(r8),allocatable :: solld_m(:) ! Solar downward near infrared diffuse to surface + real(r8),allocatable :: qrs_m(:,:) + real(r8),allocatable :: qrl_m(:,:) + real(r8),allocatable :: qrsc_m(:,:) + real(r8),allocatable :: qrlc_m(:,:) + real(r8),allocatable :: su_m(:,:,:) ! shortwave spectral flux up + real(r8),allocatable :: sd_m(:,:,:) ! shortwave spectral flux down + real(r8),allocatable :: lu_m(:,:,:) ! longwave spectral flux up + real(r8),allocatable :: ld_m(:,:,:) ! longwave spectral flux down + real(r8),pointer :: su(:,:,:) ! shortwave spectral flux up + real(r8),pointer :: sd(:,:,:) ! shortwave spectral flux down + real(r8),pointer :: lu(:,:,:) ! longwave spectral flux up + real(r8),pointer :: ld(:,:,:) ! longwave spectral flux down + real(r8), allocatable :: dei_crm(:,:,:,:) ! cloud scale ice effective diameter for optics + real(r8), allocatable :: mu_crm(:,:,:,:) ! cloud scale gamma parameter for optics + real(r8), allocatable :: lambdac_crm(:,:,:,:) ! cloud scale slope of droplet distribution for optics + real(r8), allocatable :: des_crm(:,:,:,:) ! cloud scale snow crystal diameter (micro-meter) + real(r8), allocatable :: rel_crm(:,:,:,:) + real(r8), allocatable :: rei_crm(:,:,:,:) + real(r8), allocatable :: cld_tau_crm(:,:,:,:) + real(r8), allocatable :: qrl_crm(:,:,:,:) + real(r8), allocatable :: qrs_crm(:,:,:,:) + real(r8), allocatable :: crm_fsnt(:,:,:) ! net shortwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_fsntc(:,:,:) ! net clear-sky shortwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_fsns(:,:,:) ! net shortwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_fsnsc(:,:,:) ! net clear-sky shortwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_flnt(:,:,:) ! net longwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_flntc(:,:,:) ! net clear-sky longwave fluxes at TOA at CRM grids + real(r8), allocatable :: crm_flns(:,:,:) ! net longwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_flnsc(:,:,:) ! net clear-sky longwave fluxes at surface at CRM grids + real(r8), allocatable :: crm_swcf(:,:,:) ! shortwave cloud forcing at CRM grids + + + real(r8), allocatable :: crm_aodvisz(:,:,:,:) ! layer aerosol optical depth at 550nm at CRM grids + real(r8), allocatable :: crm_aodvis(:,:,:) ! AOD at 550nm at CRM grids + real(r8), allocatable :: crm_aod400(:,:,:) ! AOD at 400nm at CRM grids + real(r8), allocatable :: crm_aod700(:,:,:) ! AOD at 700nm at CRM grids + real(r8), allocatable :: aod400(:) ! AOD at 400nm at CRM grids + real(r8), allocatable :: aod700(:) ! AOD at 700nm at CRM grids + + real(r8), pointer :: t_rad (:,:,:) ! rad temperuture + real(r8), pointer :: qv_rad(:,:,:) ! rad vapor + real(r8), pointer :: qc_rad(:,:,:) ! rad cloud water + real(r8), pointer :: qi_rad(:,:,:) ! rad cloud ice + real(r8), pointer :: crm_qrad(:,:,:) ! rad heating + + real(r8), allocatable :: tot_cld_vistau_m(:,:) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: tot_icld_vistau_m(:,:) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: liq_icld_vistau_m(:,:) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: ice_icld_vistau_m(:,:) ! in-cld ice cloud optical depth (only during day, night = fillvalue) + real(r8), allocatable :: nct_tot_icld_vistau_m(:,:) ! the number of CRM columns that has in-cloud visible sw optical depth + real(r8), allocatable :: nct_liq_icld_vistau_m(:,:) ! the number of CRM column that has liq in-cloud visible sw optical depth + real(r8), allocatable :: nct_ice_icld_vistau_m(:,:) ! the number of CRM column that has ice in-cloud visible sw optical depth + + ! These do not need N_DIAG dimension + real(r8),allocatable :: snow_tau(:,:,:) ! snow extinction optical depth + + real(r8),allocatable :: snow_lw_abs (:,:,:) ! snow absorption optics depth (LW) + + ! Just used in m2005 + real(r8),allocatable :: snow_icld_vistau_m(:,:) ! snow in-cloud visible sw optical depth for output on history files + real(r8),allocatable :: nct_snow_icld_vistau_m(:,:) ! the number of CRM column that has snow in-cloud visible sw optical depth + + +end type rad_avgdata_type_m2005 + +public :: tphysbc_spcam, spcam_register, spcam_init + +integer :: dei_idx = -1 +integer :: mu_idx = -1 +integer :: lambdac_idx = -1 +integer :: des_idx = -1 +integer :: dgnumwet_crm_idx = -1 +integer :: qaerwat_crm_idx = -1 +integer :: rel_idx = -1 +integer :: rei_idx = -1 +integer :: landm_idx = -1 +integer :: iciwp_idx = -1 +integer :: iclwp_idx = -1 +integer :: icswp_idx = -1 +integer :: cld_idx = -1 +integer :: dgnumwet_idx = -1 +integer :: qaerwat_idx = -1 +integer :: crm_t_rad_idx = -1 +integer :: crm_qc_rad_idx = -1 +integer :: crm_qi_rad_idx = -1 +integer :: crm_qv_rad_idx = -1 +integer :: crm_qrad_idx = -1 +integer :: crm_cld_rad_idx = -1 +integer :: crm_nc_rad_idx = -1 +integer :: crm_ni_rad_idx = -1 +integer :: crm_qs_rad_idx = -1 +integer :: crm_ns_rad_idx = -1 +integer :: cicewp_idx = -1 +integer :: cliqwp_idx = -1 +integer :: cldemis_idx = -1 +integer :: cldtau_idx = -1 +integer :: pmxrgn_idx = -1 +integer :: nmxrgn_idx = -1 +integer :: qrs_idx = -1 +integer :: qrl_idx = -1 +integer :: fsns_idx = -1 +integer :: fsnt_idx = -1 +integer :: flns_idx = -1 +integer :: flnt_idx = -1 +integer :: fsds_idx = -1 +integer :: cldfsnow_idx = -1 + +! Minghuai - todo -- CAC note +! These values will be "averaged" as appropriate and stored back in the pbuf +! They should no longer be "saved" -- Probably will want to put in rad_avgdata structure +! Email from Minghaui - 10/10/14 said to put on todo list as he did not have +! time to address it now +! real(r8),allocatable :: cicewp(:,:) +! real(r8),allocatable :: cliqwp(:,:) +! real(r8),allocatable :: rel(:,:) +! real(r8),allocatable :: rei(:,:) +! real(r8),allocatable :: dei(:,:) +! real(r8),allocatable :: mu(:,:) +! real(r8),allocatable :: lambdac(:,:) +! real(r8),allocatable :: des(:,:) +! real(r8),allocatable :: cld(:,:) ! cloud fraction +! real(r8),allocatable :: cldfsnow(:,:) ! cloud fraction of just "snow clouds- whatever they are" +! real(r8),allocatable :: csnowp(:,:) +! real(r8),allocatable :: dgnumwet(:,:,:) ! number mode diameter +! real(r8),allocatable :: qaerwat(:,:,:) ! aerosol water + + +integer :: nmodes +logical :: is_spcam_m2005, is_spcam_sam1mom +logical :: prog_modal_aero + +contains +subroutine tphysbc_spcam (ztodt, state, & + tend, pbuf, & + cam_out, cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Evaluate and apply physical processes that are calculated BEFORE + ! coupling to land, sea, and ice models. + ! + ! Processes currently included are: + ! + ! o Resetting Negative Tracers to Positive + ! o Global Mean Total Energy Fixer + ! o Dry Adjustment + ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection + ! o Stratiform Macro-Microphysics + ! o Wet Scavenging of Aerosol + ! o Radiation + ! + ! Method: + ! + ! Each parameterization should be implemented with this sequence of calls: + ! 1) Call physics interface + ! 2) Check energy + ! 3) Call physics_update + ! See Interface to Column Physics and Chemistry Packages + ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html + ! + !----------------------------------------------------------------------- + + use physics_buffer, only : pbuf_old_tim_idx, dyn_time_lvls + use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & + physics_state_check + use dadadj_cam, only: dadadj_tend + use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write + use cam_history, only: outfld + use constituents, only: pcnst, qmin, cnst_get_ind + use time_manager, only: get_nstep + use check_energy, only: check_energy_chng, check_energy_fix + use check_energy, only: check_tracers_data, check_tracers_init + use dycore, only: dycore_is + use radiation, only: radiation_tend + use cloud_diagnostics, only: cloud_diagnostics_calc + use perf_mod + use tropopause, only: tropopause_output + use cam_abortutils, only: endrun +#ifdef CRM + use crm_physics, only: crm_physics_tend +#endif + use phys_control, only: phys_getopts + use sslt_rebin, only: sslt_rebin_adv + use qneg_module, only: qneg3 + + implicit none + + ! + ! Arguments + ! + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + + +#ifdef CRM + ! + !---------------------------Local workspace----------------------------- + ! + + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + type(physics_state) :: state_loc + + integer :: nstep ! current timestep number + + real(r8) :: net_flx(pcols) + + real(r8) cldn(pcols,pver) + + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + + integer i ! index + integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + + ! physics buffer fields to compute tendencies for stratiform package + integer itim_old, ifld + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + + + ! physics buffer fields for total energy and mass adjustment + real(r8), pointer, dimension(: ) :: teout + real(r8), pointer, dimension(:,:) :: qini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: dtcore + + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + + + ! energy checking variables + real(r8) :: zero(pcols) ! array of zeros + real(r8) :: flx_heat(pcols) + type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes + + logical :: state_debug_checks ! Debug physics_state. + + + type(rad_avgdata_type_sam1mom) :: rad_avgdata_sam1mom + type(rad_avgdata_type_m2005) :: rad_avgdata_m2005 + type(rad_out_t) :: rd + + integer :: teout_idx, qini_idx, cldliqini_idx, cldiceini_idx + integer :: ii, jj + !----------------------------------------------------------------------- + call t_startf('bc_init') + zero = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + + teout_idx = pbuf_get_index('TEOUT') + qini_idx = pbuf_get_index('QINI') + cldliqini_idx = pbuf_get_index('CLDLIQINI') + cldiceini_idx = pbuf_get_index('CLDICEINI') + + call phys_getopts(state_debug_checks_out=state_debug_checks) + + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) + + call pbuf_get_field(pbuf, qini_idx, qini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + + ifld = pbuf_get_index('DTCORE') + call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ifld = pbuf_get_index('FRACIS') + call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + fracis (:ncol,:,1:pcnst) = 1._r8 + + ! Set physics tendencies to 0 + tend %dTdt(:ncol,:pver) = 0._r8 + tend %dudt(:ncol,:pver) = 0._r8 + tend %dvdt(:ncol,:pver) = 0._r8 + + call qneg3('TPHYSBCb',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,state%q ) + + ! Validate state coming from the dynamics. + if (state_debug_checks) & + call physics_state_check(state, name="before tphysbc (dycore?)") + ! + ! Dump out "before physics" state + ! + call diag_state_b4_phys_write (state) + + ! compute mass integrals of input tracers state + call check_tracers_init(state, tracerint) + + call t_stopf('bc_init') + + !=================================================== + ! Global mean total energy fixer + !=================================================== + call t_startf('energy_fixer') + + if (dycore_is('LR') .or. dycore_is('SE')) then + call check_energy_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) + call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call outfld('EFIX', flx_heat, pcols,lchnk) + end if + ! Save state for convective tendency calculations. + call diag_conv_tend_ini(state, pbuf) + + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + + + call outfld('TEOUT', teout , pcols, lchnk ) + call outfld('TEINP', state%te_ini, pcols, lchnk ) + call outfld('TEFIX', state%te_cur, pcols, lchnk ) + + ! T tendency due to dynamics + if( nstep > dyn_time_lvls-1 ) then + dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/(ztodt) + call outfld( 'DTCORE', dtcore, pcols, lchnk ) + end if + + call t_stopf('energy_fixer') + + call sslt_rebin_adv(pbuf, state) + + ! + !=================================================== + ! Dry adjustment + ! This code block is not a good example of interfacing a parameterization + !=================================================== + call t_startf('dry_adjustment') + + call dadadj_tend (ztodt, state, ptend) + call physics_update(state, ptend, ztodt, tend) + + call t_stopf('dry_adjustment') + + ! ------------------------------------------------------------------------------- + ! Call cloud resolving model + ! ------------------------------------------------------------------------------- + + call crm_physics_tend(ztodt, state, tend, ptend, pbuf, cam_in) + call physics_update(state, ptend, ztodt, tend) + + !=================================================== + ! Moist physical parameteriztions complete: + ! send dynamical variables, and derived variables to history file + !=================================================== + + call t_startf('bc_history_write') + call diag_phys_writeout(state, cam_out%psl) + call diag_conv(state, ztodt, pbuf) + + call t_stopf('bc_history_write') + + !=================================================== + ! Write cloud diagnostics on history file + !=================================================== + + if (is_spcam_sam1mom) then + call spcam_radiation_setup_sam1mom(cam_in, cldn, state, pbuf, rad_avgdata_sam1mom, state_loc) + else if (is_spcam_m2005) then + call spcam_radiation_setup_m2005(state, pbuf, rad_avgdata_m2005, state_loc) + end if + + call t_startf('bc_cld_diag_history_write') + + call cloud_diagnostics_calc(state, pbuf) + + call t_stopf('bc_cld_diag_history_write') + + !=================================================== + ! Radiation computations + !=================================================== + call t_startf('radiation') + + if (is_spcam_sam1mom) then + do jj=1,crm_ny + do ii=1,crm_nx + call spcam_radiation_col_setup_sam1mom(ii, jj, state_loc, pbuf, rad_avgdata_sam1mom) + call radiation_tend(state_loc, ptend, pbuf, & + cam_out, cam_in, & + net_flx, rd) + call spcam_radiation_col_finalize_sam1mom(state, ii, jj, pbuf, rd, cam_out, rad_avgdata_sam1mom) + end do + end do + call spcam_radiation_finalize_sam1mom(cam_in, state, pbuf, rad_avgdata_sam1mom, cam_out, cldn, net_flx, ptend) + + else if(is_spcam_m2005) then + do jj=1,crm_ny + do ii=1,crm_nx + call spcam_radiation_col_setup_m2005(ii, jj, ixcldice, ixcldliq, state_loc, pbuf, rad_avgdata_m2005) + call radiation_tend(state_loc, ptend, pbuf, & + cam_out, cam_in, & + net_flx, rd) + call spcam_radiation_col_finalize_m2005(state, ii, jj, pbuf, rd, cam_out, rad_avgdata_m2005) + end do + end do + call spcam_radiation_finalize_m2005(cam_in, state, pbuf, rad_avgdata_m2005, cam_out, net_flx, ptend) + end if + + ! Set net flux used by spectral dycores + do i=1,ncol + tend%flx_net(i) = net_flx(i) + end do + + ! don't add radiative tendency to GCM temperature in case of superparameterization + ! as it was added above as part of crm tendency. + ptend%s = 0._r8 + + call physics_update(state, ptend, ztodt, tend) + + call check_energy_chng(state, tend, "spradheat", nstep, ztodt, zero, zero, zero, zero) + + call t_stopf('radiation') + + ! Diagnose the location of the tropopause and its location to the history file(s). + call t_startf('tropopause') + call tropopause_output(state) + call t_stopf('tropopause') + + ! Save atmospheric fields to force surface models + call t_startf('cam_export') + call cam_export (state,cam_out,pbuf) + call t_stopf('cam_export') + + ! Write export state to history file + call t_startf('diag_export') + call diag_export(cam_out) + call t_stopf('diag_export') + +#endif +end subroutine tphysbc_spcam + +!=============================================================================== + +subroutine spcam_register() + use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls ! is dyn_time_lvls needed ??? + use phys_control, only: cam_physpkg_is +#ifdef CRM + use crm_physics, only: crm_physics_register + use crmx_vars, only: naer, vaer, hgaer + use crmx_grid +#ifdef MODAL_AERO + use modal_aero_data, only: ntot_amode + + allocate(naer(nzm, ntot_amode)) ! Aerosol number concentration [/m3] + allocate(vaer(nzm, ntot_amode)) ! aerosol volume concentration [m3/m3] + allocate(hgaer(nzm, ntot_amode)) ! hygroscopicity of aerosol mode +#endif + + + call crm_physics_register() + +#endif + + is_spcam_m2005 = cam_physpkg_is('spcam_m2005') + is_spcam_sam1mom = cam_physpkg_is('spcam_sam1mom') + + if (is_spcam_m2005) then + call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) + call pbuf_add_field('CLDFSNOW', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) + endif + +end subroutine spcam_register + +!=============================================================================== + +subroutine spcam_init(pbuf2d) + use physics_buffer, only: pbuf_get_index + use phys_control, only: phys_getopts +#ifdef CRM + use crm_physics, only: crm_physics_init +#endif + use rad_constituents, only: rad_cnst_get_info + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +#ifdef CRM + + call phys_getopts(prog_modal_aero_out = prog_modal_aero) + + call rad_cnst_get_info(0, nmodes=nmodes) + + dei_idx = pbuf_get_index('DEI') + mu_idx = pbuf_get_index('MU') + lambdac_idx = pbuf_get_index('LAMBDAC') + des_idx = pbuf_get_index('DES') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + landm_idx = pbuf_get_index('LANDM') + cld_idx = pbuf_get_index('CLD') + qrs_idx = pbuf_get_index('QRS') + qrl_idx = pbuf_get_index('QRL') + fsns_idx = pbuf_get_index('FSNS') + fsds_idx = pbuf_get_index('FSDS') + fsnt_idx = pbuf_get_index('FSNT') + flnt_idx = pbuf_get_index('FLNT') + flns_idx = pbuf_get_index('FLNS') + + crm_t_rad_idx = pbuf_get_index('CRM_T_RAD') + crm_qc_rad_idx = pbuf_get_index('CRM_QC_RAD') + crm_qi_rad_idx = pbuf_get_index('CRM_QI_RAD') + crm_qv_rad_idx = pbuf_get_index('CRM_QV_RAD') + crm_qrad_idx = pbuf_get_index('CRM_QRAD') + crm_cld_rad_idx = pbuf_get_index('CRM_CLD_RAD') + + + if (is_spcam_sam1mom) then + cldemis_idx = pbuf_get_index('CLDEMIS') + cldtau_idx = pbuf_get_index('CLDTAU') + cicewp_idx = pbuf_get_index('CICEWP') + cliqwp_idx = pbuf_get_index('CLIQWP') + pmxrgn_idx = pbuf_get_index('PMXRGN') + nmxrgn_idx = pbuf_get_index('NMXRGN') + else if (is_spcam_m2005) then + iciwp_idx = pbuf_get_index('ICIWP') + iclwp_idx = pbuf_get_index('ICLWP') + crm_nc_rad_idx = pbuf_get_index('CRM_NC_RAD') + crm_ni_rad_idx = pbuf_get_index('CRM_NI_RAD') + crm_qs_rad_idx = pbuf_get_index('CRM_QS_RAD') + crm_ns_rad_idx = pbuf_get_index('CRM_NS_RAD') + end if + + if (prog_modal_aero) then + dgnumwet_idx = pbuf_get_index('DGNUMWET') + qaerwat_idx = pbuf_get_index('QAERWAT') + dgnumwet_crm_idx = pbuf_get_index('CRM_DGNUMWET') + qaerwat_crm_idx = pbuf_get_index('CRM_QAERWAT') + end if + + ! Initialize the crm_physics layer + call crm_physics_init(pbuf2d) + +#endif +end subroutine spcam_init + +!=============================================================================== + +subroutine spcam_radiation_setup_m2005(state, pbuf, rad_avgdata, state_loc) + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_old_tim_idx + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + + type(rad_avgdata_type_m2005), intent(out) :: rad_avgdata + type(physics_state), intent(out) :: state_loc + +#ifdef m2005 + real(r8), pointer, dimension(:, :) :: cicewp + real(r8), pointer, dimension(:, :) :: cliqwp + real(r8), pointer, dimension(:, :) :: csnowp + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" + real(r8), pointer, dimension(:, :) :: dei ! ice effective diameter for optics (radiation) + real(r8), pointer, dimension(:, :) :: mu ! gamma parameter for optics (radiation) + real(r8), pointer, dimension(:, :) :: lambdac ! slope of droplet distribution for optics (radiation) + real(r8), pointer, dimension(:, :) :: des ! snow crystatl diameter for optics (mirometer, radiation) + + integer :: ncol ! number of atmospheric columns + integer :: itim_old + + ncol = state%ncol + + call physics_state_copy(state, state_loc) + + allocate(rad_avgdata%solin_m (pcols)) + allocate(rad_avgdata%fsntoa_m (pcols)) + allocate(rad_avgdata%fsutoa_m (pcols)) + allocate(rad_avgdata%fsntoac_m (pcols)) + allocate(rad_avgdata%fsnirt_m (pcols)) + allocate(rad_avgdata%fsnrtc_m (pcols)) + allocate(rad_avgdata%fsnirtsq_m (pcols)) + allocate(rad_avgdata%fsntc_m (pcols)) + allocate(rad_avgdata%fsnsc_m (pcols)) + allocate(rad_avgdata%fsdsc_m (pcols)) + allocate(rad_avgdata%flut_m (pcols)) + allocate(rad_avgdata%flutc_m (pcols)) + allocate(rad_avgdata%flntc_m (pcols)) + allocate(rad_avgdata%flnsc_m (pcols)) + allocate(rad_avgdata%fldsc_m (pcols)) + allocate(rad_avgdata%flwds_m (pcols)) + allocate(rad_avgdata%fsns_m (pcols)) + allocate(rad_avgdata%fsnr_m (pcols)) + allocate(rad_avgdata%fsnt_m (pcols)) + allocate(rad_avgdata%flns_m (pcols)) + allocate(rad_avgdata%flnt_m (pcols)) + allocate(rad_avgdata%flnr_m (pcols)) + allocate(rad_avgdata%fsds_m (pcols)) + allocate(rad_avgdata%fln200_m (pcols)) + allocate(rad_avgdata%fln200c_m (pcols)) + allocate(rad_avgdata%fsn200_m (pcols)) + allocate(rad_avgdata%fsn200c_m (pcols)) + allocate(rad_avgdata%sols_m (pcols)) + allocate(rad_avgdata%soll_m (pcols)) + allocate(rad_avgdata%solsd_m (pcols)) + allocate(rad_avgdata%solld_m (pcols)) + allocate(rad_avgdata%qrs_m (pcols,pver)) + allocate(rad_avgdata%qrl_m (pcols,pver)) + allocate(rad_avgdata%qrsc_m (pcols,pver)) + allocate(rad_avgdata%qrlc_m (pcols,pver)) + allocate(rad_avgdata%rel_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%rei_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%cld_tau_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%qrl_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%qrs_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%crm_fsnt (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsntc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsns (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsnsc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flnt (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flntc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flns (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flnsc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_swcf (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aodvisz (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%crm_aodvis (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aod400 (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aod700 (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%aod400 (pcols)) + allocate(rad_avgdata%aod700 (pcols)) + + allocate(rad_avgdata%tot_cld_vistau_m (pcols,pver)) + allocate(rad_avgdata%tot_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%liq_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%ice_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%nct_tot_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%nct_liq_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%nct_ice_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%snow_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%nct_snow_icld_vistau_m(pcols,pver)) + + allocate(rad_avgdata%dei_crm(pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%mu_crm(pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%lambdac_crm(pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%des_crm(pcols, crm_nx, crm_ny, crm_nz)) + + call pbuf_get_field(pbuf, iciwp_idx, cicewp) + call pbuf_get_field(pbuf, iclwp_idx, cliqwp) + call pbuf_get_field(pbuf, icswp_idx, csnowp) + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, dei_idx, dei) + call pbuf_get_field(pbuf, mu_idx, mu) + call pbuf_get_field(pbuf, lambdac_idx, lambdac) + call pbuf_get_field(pbuf, des_idx, des) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + + ! Initialize the summation values + + rad_avgdata%solin_m = 0._r8 + rad_avgdata%fsntoa_m = 0._r8 + rad_avgdata%fsutoa_m = 0._r8 + rad_avgdata%fsntoac_m = 0._r8 + rad_avgdata%fsnirt_m = 0._r8 + rad_avgdata%fsnrtc_m = 0._r8 + rad_avgdata%fsnirtsq_m = 0._r8 + rad_avgdata%fsntc_m = 0._r8 + rad_avgdata%fsnsc_m = 0._r8 + rad_avgdata%fsdsc_m = 0._r8 + rad_avgdata%flut_m = 0._r8 + rad_avgdata%flutc_m = 0._r8 + rad_avgdata%flntc_m = 0._r8 + rad_avgdata%flnsc_m = 0._r8 + rad_avgdata%fldsc_m = 0._r8 + rad_avgdata%flwds_m = 0._r8 + rad_avgdata%fsns_m = 0._r8 + rad_avgdata%fsnt_m = 0._r8 + rad_avgdata%flns_m = 0._r8 + rad_avgdata%flnt_m = 0._r8 + rad_avgdata%flnr_m = 0._r8 + rad_avgdata%fsds_m = 0._r8 + rad_avgdata%fsnr_m = 0._r8 + rad_avgdata%fln200_m = 0._r8 + rad_avgdata%fln200c_m = 0._r8 + rad_avgdata%fsn200_m = 0._r8 + rad_avgdata%fsn200c_m = 0._r8 + rad_avgdata%sols_m = 0._r8 + rad_avgdata%soll_m = 0._r8 + rad_avgdata%solsd_m = 0._r8 + rad_avgdata%solld_m = 0._r8 + rad_avgdata%qrs_m = 0._r8 + rad_avgdata%qrl_m = 0._r8 + rad_avgdata%qrsc_m = 0._r8 + rad_avgdata%qrlc_m = 0._r8 + rad_avgdata%qrs_crm = 0._r8 + rad_avgdata%qrl_crm = 0._r8 + rad_avgdata%cld_tau_crm = 0.0_r8 + rad_avgdata%crm_aodvisz = 0._r8 + rad_avgdata%crm_aodvis = 0._r8 + + rad_avgdata%crm_aod400 = 0._r8 ; rad_avgdata%crm_aod700 = 0._r8 + rad_avgdata%aod400 = 0._r8 ; rad_avgdata%aod700 = 0._r8 + rad_avgdata%crm_fsnt = 0._r8 ; rad_avgdata%crm_fsntc = 0._r8 + rad_avgdata%crm_fsns = 0._r8 ; rad_avgdata%crm_fsnsc = 0._r8 + rad_avgdata%crm_flnt = 0._r8 ; rad_avgdata%crm_flntc = 0._r8 + rad_avgdata%crm_flns = 0._r8 ; rad_avgdata%crm_flnsc = 0._r8 + rad_avgdata%crm_swcf = 0._r8 + + + rad_avgdata%tot_cld_vistau_m = 0._r8 + rad_avgdata%tot_icld_vistau_m = 0._r8 ; rad_avgdata%nct_tot_icld_vistau_m = 0._r8 + rad_avgdata%liq_icld_vistau_m = 0._r8 ; rad_avgdata%nct_liq_icld_vistau_m = 0._r8 + rad_avgdata%ice_icld_vistau_m = 0._r8 ; rad_avgdata%nct_ice_icld_vistau_m = 0._r8 + rad_avgdata%snow_icld_vistau_m = 0._r8 ; rad_avgdata%nct_snow_icld_vistau_m = 0._r8 + + ! Initialize the pbuf values + lambdac = 0.0_r8 + des = 0.0_r8 + cicewp(1:ncol,1:pver) = 0.0_r8 + cliqwp(1:ncol,1:pver) = 0.0_r8 + csnowp(1:ncol,1:pver) = 0.0_r8 + cld = 0.0_r8 + cldfsnow = 0.0_r8 + rel = 0.0_r8 + rei = 0.0_r8 + dei = 0.0_r8 + mu = 0.0_r8 + +#endif +end subroutine spcam_radiation_setup_m2005 + +!=============================================================================== + +subroutine spcam_radiation_col_setup_m2005(ii, jj, ixcldice, ixcldliq, state_loc, pbuf, rad_avgdata) + + use physics_buffer, only: pbuf_old_tim_idx + use physconst, only: gravit +#ifdef CRM + use crm_physics, only: m2005_effradius +#endif + + + integer, intent(in) :: ii,jj + integer, intent(in) :: ixcldice, ixcldliq ! constituent indices for cloud liq and ice water. + + type(physics_state), intent(inout) :: state_loc + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata + +#ifdef m2005 + real(r8),pointer :: nc_rad(:,:,:,:) ! rad cloud water droplet number (#/kg) + real(r8),pointer :: ni_rad(:,:,:,:) ! rad cloud ice crystal nubmer (#/kg) + real(r8),pointer :: qs_rad(:,:,:,:) ! rad cloud snow crystal mass (kg/kg) + real(r8),pointer :: ns_rad(:,:,:,:) ! rad cloud snow crystal nubmer (#/kg) + + + real(r8),pointer :: t_rad (:,:,:,:) ! rad temperuture + real(r8),pointer :: qv_rad(:,:,:,:) ! rad vapor + real(r8),pointer :: qc_rad(:,:,:,:) ! rad cloud water + real(r8),pointer :: qi_rad(:,:,:,:) ! rad cloud ice + real(r8),pointer :: crm_qrad(:,:,:,:) ! rad heating + real(r8),pointer :: cld_rad(:,:,:,:) ! rad cloud fraction + + + real(r8), pointer, dimension(:,:) :: cicewp + real(r8), pointer, dimension(:,:) :: cliqwp + real(r8), pointer, dimension(:,:) :: csnowp + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" + real(r8), pointer, dimension(:,:) :: dei ! ice effective diameter for optics (radiation) + real(r8), pointer, dimension(:,:) :: mu ! gamma parameter for optics (radiation) + real(r8), pointer, dimension(:,:) :: lambdac ! slope of droplet distribution for optics (radiation) + real(r8), pointer, dimension(:,:) :: des ! snow crystatl diameter for optics (mirometer, radiation) + real(r8), pointer, dimension(:,:,:) :: dgnumwet ! number mode diameter + real(r8), pointer, dimension(:,:,:) :: qaerwat ! aerosol water + + real(r8),pointer, dimension(:,:,:,:,:) :: qaerwat_crm ! aerosol water + real(r8),pointer, dimension(:,:,:,:,:) :: dgnumwet_crm ! wet mode dimaeter + + real(r8) :: qtot + real(r8) :: effl ! droplet effective radius [micrometer] + real(r8) :: effi ! ice crystal effective radius [micrometer] + real(r8) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 + + real(r8) :: deffi ! ice effective diameter for optics (radiation) + real(r8) :: lamc ! slope of droplet distribution for optics (radiation) + real(r8) :: pgam ! gamma parameter for optics (radiation) + real(r8) :: dest ! snow crystal effective diameters for optics (radiation) (micro-meter) + + + integer :: itim_old + integer :: m, k, i + integer :: ncol ! number of atmospheric columns + + ncol = state_loc%ncol + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, dei_idx, dei) + call pbuf_get_field(pbuf, mu_idx, mu) + call pbuf_get_field(pbuf, lambdac_idx, lambdac) + call pbuf_get_field(pbuf, des_idx, des) + if (prog_modal_aero) then + call pbuf_get_field(pbuf, dgnumwet_crm_idx, dgnumwet_crm) + call pbuf_get_field(pbuf, qaerwat_crm_idx, qaerwat_crm) + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat) + endif + + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + + call pbuf_get_field(pbuf, crm_t_rad_idx, t_rad) + call pbuf_get_field(pbuf, crm_qc_rad_idx, qc_rad) + call pbuf_get_field(pbuf, crm_qi_rad_idx, qi_rad) + call pbuf_get_field(pbuf, crm_qv_rad_idx, qv_rad) + call pbuf_get_field(pbuf, crm_qrad_idx, crm_qrad) + call pbuf_get_field(pbuf, crm_cld_rad_idx, cld_rad) + + crm_qrad=0._r8 + + + call pbuf_get_field(pbuf, iciwp_idx, cicewp) + call pbuf_get_field(pbuf, iclwp_idx, cliqwp) + call pbuf_get_field(pbuf, icswp_idx, csnowp) + + call pbuf_get_field(pbuf, crm_nc_rad_idx, nc_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) + call pbuf_get_field(pbuf, crm_ni_rad_idx, ni_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) + call pbuf_get_field(pbuf, crm_qs_rad_idx, qs_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) + call pbuf_get_field(pbuf, crm_ns_rad_idx, ns_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) + + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + + do m=1,crm_nz + k = pver-m+1 + do i=1,ncol + + qtot = qc_rad(i,ii,jj,m) + qi_rad(i,ii,jj,m) + if(qtot.gt.1.e-9_r8) then + cld(i,k) = min(0.99_r8, cld_rad(i,ii,jj,m)) + + ! In-cloud ice water path. + cicewp(i,k) = qi_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.01_r8,cld(i,k)) + ! In-cloud liquid water path. + cliqwp(i,k) = qc_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.01_r8,cld(i,k)) + else + cld(i,k) = 0._r8 + cicewp(i,k) = 0._r8 ! In-cloud ice water path. + cliqwp(i,k) = 0._r8 ! In-cloud liquid water path. + end if + + ! + ! snow water-related variables: + ! snow water is an important component in m2005 microphysics, and is therefore taken + ! account in the radiative calculation (snow water path is several times larger than ice water path in m2005 globally). + ! + if( qs_rad(i, ii, jj, m).gt.1.0e-7_r8) then + cldfsnow(i,k) = 0.99_r8 + csnowp(i,k) = qs_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.001_r8,cldfsnow(i,k)) + else + cldfsnow(i,k) = 0.0_r8 + csnowp(i,k) = 0.0_r8 + end if + + + ! update ice water, liquid water, water vapor, and temperature in state_loc + state_loc%q(i,k,ixcldice) = qi_rad(i,ii,jj,m) + state_loc%q(i,k,ixcldliq) = qc_rad(i,ii,jj,m) + state_loc%q(i,k,1) = max(1.e-9_r8,qv_rad(i,ii,jj,m)) + state_loc%t(i,k) = t_rad(i, ii, jj, m) + + ! Using CRM scale aerosol water to calculate aerosol optical depth. + ! Here we assume no aerosol water uptake at cloudy sky at CRM grids. + ! This is not really phyisically correct. But if we assume 100% of relative humidity for + ! aerosol water uptake, this will bias 'AODVIS' to be large, since 'AODVIS' is used + ! to compare with observated clear sky AOD. In the future, AODVIS is needed to be calcualted + ! from clear sky CRM AOD only. But before this is done, we will assume no water uptake at CCRM + ! cloudy grids (The radiative effects of this assumption will be small, since in cloudy sky, + ! aerosol effects is small anyway. + ! + if (prog_modal_aero) then + qaerwat(i, k, 1:nmodes) = qaerwat_crm(i, ii, jj, m, 1:nmodes) + dgnumwet(i, k, 1:nmodes) = dgnumwet_crm(i, ii, jj, m, 1:nmodes) + endif + end do ! i + end do ! m + + + ! update effective radius + do m=1,crm_nz + k = pver-m+1 + do i=1,ncol + + call m2005_effradius(qc_rad(i,ii,jj,m), nc_rad(i,ii,jj,m), qi_rad(i,ii,jj,m), & + ni_rad(i,ii,jj,m), qs_rad(i,ii,jj,m), ns_rad(i,ii,jj,m), & + 1.0_r8, state_loc%pmid(i,k), state_loc%t(i,k), effl, effi, effl_fn, deffi, lamc, pgam, dest) + + rel(i,k) = effl + rei(i,k) = effi + dei(i,k) = deffi + mu(i,k) = pgam + lambdac(i,k) = lamc + des(i,k) = dest + + rad_avgdata%dei_crm(i,ii,jj,m) = dei(i,k) + rad_avgdata%mu_crm(i,ii,jj,m) = mu(i,k) + rad_avgdata%lambdac_crm(i,ii,jj,m) = lambdac(i,k) + rad_avgdata%des_crm(i,ii,jj,m) = des(i,k) + rad_avgdata%rel_crm(i,ii,jj,m) = rel(i,k) + rad_avgdata%rei_crm(i,ii,jj,m) = rei(i,k) + end do + end do + +#endif +end subroutine spcam_radiation_col_setup_m2005 + +!=============================================================================== + +subroutine spcam_radiation_finalize_m2005(cam_in, state, pbuf, rad_avgdata, cam_out, net_flx, ptend) + + use physconst, only: cpair + use rad_constituents,only: rad_cnst_out + + use physconst, only: cappa + use radiation_data, only: rad_data_write + use radheat, only: radheat_tend + use time_manager, only: get_curr_calday + use physics_buffer, only: pbuf_old_tim_idx + use radheat, only: radheat_tend + use orbit, only: zenith + + type(cam_in_t), intent(in) :: cam_in + type(physics_state), intent(in) :: state + + + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata + type(cam_out_t), intent(inout) :: cam_out + + real(r8), intent(inout) :: net_flx(pcols) + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + + + +#ifdef m2005 + + real(r8), parameter :: factor_xy = 1._r8/dble(crm_nx*crm_ny) + + real(r8), pointer, dimension(:,:) :: cicewp + real(r8), pointer, dimension(:,:) :: cliqwp + real(r8), pointer, dimension(:,:) :: csnowp + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: landm + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" + real(r8), pointer, dimension(:,:) :: dei ! ice effective diameter for optics (radiation) + real(r8), pointer, dimension(:,:) :: mu ! gamma parameter for optics (radiation) + real(r8), pointer, dimension(:,:) :: lambdac ! slope of droplet distribution for optics (radiation) + real(r8), pointer, dimension(:,:) :: des ! snow crystatl diameter for optics (mirometer, radiation) + real(r8), pointer, dimension(:,:,:) :: dgnumwet ! number mode diameter + real(r8), pointer, dimension(:,:,:) :: qaerwat ! aerosol water + real(r8), pointer, dimension(:,:,:,:) :: crm_qrad ! rad heating + real(r8), pointer, dimension(:,:) :: qrs + real(r8), pointer, dimension(:,:) :: qrl + real(r8), pointer, dimension(:) :: fsns ! Surface solar absorbed flux + real(r8), pointer, dimension(:) :: fsnt ! Net column abs solar flux at model top + real(r8), pointer, dimension(:) :: flns ! Srf longwave cooling (up-down) flux + real(r8), pointer, dimension(:) :: flnt ! Net outgoing lw flux at model top + real(r8), pointer, dimension(:) :: fsds ! Surface solar down flux + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer :: itim_old + integer :: i, k, m + + integer, dimension(pcols) :: IdxNite ! Indicies of night coumns + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + real(r8) :: calday ! current calendar day + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + + + lchnk = state%lchnk + ncol = state%ncol + + calday = get_curr_calday() + + ! + ! Cosine solar zenith angle for current time step + ! + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + call zenith (calday, clat, clon, coszrs, ncol) + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + + + ! Shortwave + + ftem(:ncol,:pver) = rad_avgdata%qrs_m(:ncol,:pver)/cpair + call outfld('QRS'//' ',ftem ,pcols,lchnk) + ftem(:ncol,:pver) = rad_avgdata%qrsc_m(:ncol,:pver)/cpair + call outfld('QRSC'//' ',ftem ,pcols,lchnk) + call outfld('SOLIN'//' ',rad_avgdata%solin_m(:) ,pcols,lchnk) + call outfld('FSDS'//' ',rad_avgdata%fsds_m(:) ,pcols,lchnk) + call outfld('FSNIRTOA'//' ',rad_avgdata%fsnirt_m(:),pcols,lchnk) + call outfld('FSNRTOAC'//' ',rad_avgdata%fsnrtc_m(:),pcols,lchnk) + call outfld('FSNRTOAS'//' ',rad_avgdata%fsnirtsq_m(:),pcols,lchnk) + call outfld('FSNT'//' ',rad_avgdata%fsnt_m(:) ,pcols,lchnk) + call outfld('FSNS'//' ',rad_avgdata%fsns_m(:) ,pcols,lchnk) + call outfld('FSNTC'//' ',rad_avgdata%fsntc_m(:) ,pcols,lchnk) + call outfld('FSNSC'//' ',rad_avgdata%fsnsc_m(:) ,pcols,lchnk) + call outfld('FSDSC'//' ',rad_avgdata%fsdsc_m(:) ,pcols,lchnk) + call outfld('FSNTOA'//' ',rad_avgdata%fsntoa_m(:),pcols,lchnk) + call outfld('FSUTOA'//' ',rad_avgdata%fsutoa_m(:),pcols,lchnk) + call outfld('FSNTOAC'//' ',rad_avgdata%fsntoac_m(:),pcols,lchnk) + call outfld('SOLS'//' ',rad_avgdata%sols_m(:) ,pcols,lchnk) + call outfld('SOLL'//' ',rad_avgdata%soll_m(:) ,pcols,lchnk) + call outfld('SOLSD'//' ',rad_avgdata%solsd_m(:) ,pcols,lchnk) + call outfld('SOLLD'//' ',rad_avgdata%solld_m(:) ,pcols,lchnk) + call outfld('FSN200'//' ',rad_avgdata%fsn200_m(:),pcols,lchnk) + call outfld('FSN200C'//' ',rad_avgdata%fsn200c_m(:),pcols,lchnk) + call outfld('SWCF'//' ',rad_avgdata%fsntoa_m(:)-rad_avgdata%fsntoac_m(:) ,pcols,lchnk) + call outfld('FSNR'//' ',rad_avgdata%fsnr_m(:) ,pcols,lchnk) + + do i = 1, nnite + rad_avgdata%crm_aodvis(idxnite(i), :, :) = fillvalue + rad_avgdata%crm_aod400(idxnite(i), :, :) = fillvalue + rad_avgdata%crm_aod700(idxnite(i), :, :) = fillvalue + rad_avgdata%aod400(idxnite(i)) = fillvalue + rad_avgdata%aod700(idxnite(i)) = fillvalue + rad_avgdata%crm_aodvisz(idxnite(i), :, :, :) = fillvalue + rad_avgdata%tot_cld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%tot_icld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%liq_icld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%ice_icld_vistau_m(IdxNite(i),:) = fillvalue + if (cldfsnow_idx > 0) then + rad_avgdata%snow_icld_vistau_m(IdxNite(i),:) = fillvalue + endif + end do + + call outfld('CRM_FSNT', rad_avgdata%crm_fsnt, pcols, lchnk) + call outfld('CRM_FSNTC', rad_avgdata%crm_fsntc, pcols, lchnk) + call outfld('CRM_FSNS', rad_avgdata%crm_fsns, pcols, lchnk) + call outfld('CRM_FSNSC', rad_avgdata%crm_fsnsc, pcols, lchnk) + call outfld('CRM_AODVIS', rad_avgdata%crm_aodvis, pcols, lchnk) + call outfld('CRM_AOD400', rad_avgdata%crm_aod400, pcols, lchnk) + call outfld('CRM_AOD700', rad_avgdata%crm_aod700, pcols, lchnk) + call outfld('AOD400', rad_avgdata%aod400, pcols, lchnk) + call outfld('AOD700', rad_avgdata%aod700, pcols, lchnk) + call outfld('CRM_AODVISZ', rad_avgdata%crm_aodvisz, pcols, lchnk) + call outfld('TOT_CLD_VISTAU', rad_avgdata%tot_cld_vistau_m, pcols, lchnk) + call outfld('TOT_ICLD_VISTAU', rad_avgdata%tot_icld_vistau_m, pcols, lchnk) + call outfld('LIQ_ICLD_VISTAU', rad_avgdata%liq_icld_vistau_m, pcols, lchnk) + call outfld('ICE_ICLD_VISTAU', rad_avgdata%ice_icld_vistau_m, pcols, lchnk) + if (cldfsnow_idx > 0) then + call outfld('SNOW_ICLD_VISTAU', rad_avgdata%snow_icld_vistau_m, pcols, lchnk) + endif + + ! Longwave + call outfld('QRL'//' ',rad_avgdata%qrl_m (:ncol,:)/cpair,ncol,lchnk) + call outfld('QRLC'//' ',rad_avgdata%qrlc_m(:ncol,:)/cpair,ncol,lchnk) + call outfld('FLNT'//' ',rad_avgdata%flnt_m(:) ,pcols,lchnk) + call outfld('FLUT'//' ',rad_avgdata%flut_m(:) ,pcols,lchnk) + call outfld('FLUTC'//' ',rad_avgdata%flutc_m(:) ,pcols,lchnk) + call outfld('FLNTC'//' ',rad_avgdata%flntc_m(:) ,pcols,lchnk) + call outfld('FLNS'//' ',rad_avgdata%flns_m(:) ,pcols,lchnk) + + call outfld('FLDSC'//' ',rad_avgdata%fldsc_m(:) ,pcols,lchnk) + call outfld('FLNSC'//' ',rad_avgdata%flnsc_m(:) ,pcols,lchnk) + call outfld('LWCF'//' ',rad_avgdata%flutc_m(:)-rad_avgdata%flut_m(:) ,pcols,lchnk) + call outfld('FLN200'//' ',rad_avgdata%fln200_m(:),pcols,lchnk) + call outfld('FLN200C'//' ',rad_avgdata%fln200c_m(:),pcols,lchnk) + call outfld('FLDS'//' ',rad_avgdata%flwds_m(:) ,pcols,lchnk) + call outfld('FLNR'//' ',rad_avgdata%flnr_m(:),pcols,lchnk) + + call outfld('CRM_FLNT', rad_avgdata%crm_flnt, pcols, lchnk) + call outfld('CRM_FLNTC', rad_avgdata%crm_flntc, pcols, lchnk) + call outfld('CRM_FLNS', rad_avgdata%crm_flns, pcols, lchnk) + call outfld('CRM_FLNSC', rad_avgdata%crm_flnsc, pcols, lchnk) + + call outfld('CRM_REL', rad_avgdata%rel_crm, pcols, lchnk) + call outfld('CRM_REI', rad_avgdata%rei_crm, pcols, lchnk) + call outfld('CRM_MU', rad_avgdata%mu_crm, pcols, lchnk) + call outfld('CRM_DEI', rad_avgdata%dei_crm, pcols, lchnk) + call outfld('CRM_DES', rad_avgdata%des_crm, pcols, lchnk) + call outfld('CRM_LAMBDA', rad_avgdata%lambdac_crm, pcols, lchnk) + call outfld('CRM_TAU', rad_avgdata%cld_tau_crm, pcols, lchnk) + call outfld('CRM_QRL', rad_avgdata%qrl_crm, pcols, lchnk) + call outfld('CRM_QRS', rad_avgdata%qrs_crm, pcols, lchnk) + + + + do i=1, ncol + do k=1, pver + rad_avgdata%tot_cld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k) * factor_xy + if(rad_avgdata%nct_tot_icld_vistau_m(i,k).ge. 0.1_r8) then + rad_avgdata%tot_icld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k)/rad_avgdata%nct_tot_icld_vistau_m(i,k) + else + rad_avgdata%tot_icld_vistau_m(i,k) = 0.0_r8 + end if + + if(rad_avgdata%nct_liq_icld_vistau_m(i,k).ge. 0.1_r8) then + rad_avgdata%liq_icld_vistau_m(i,k) = rad_avgdata%liq_icld_vistau_m(i,k)/rad_avgdata%nct_liq_icld_vistau_m(i,k) + else + rad_avgdata%liq_icld_vistau_m(i,k) = 0.0_r8 + end if + + if(rad_avgdata%nct_ice_icld_vistau_m(i,k).ge. 0.1_r8) then + rad_avgdata%ice_icld_vistau_m(i,k) = rad_avgdata%ice_icld_vistau_m(i,k)/rad_avgdata%nct_ice_icld_vistau_m(i,k) + else + rad_avgdata%ice_icld_vistau_m(i,k) = 0.0_r8 + end if + + if(rad_avgdata%nct_snow_icld_vistau_m(i,k).ge. 0.1_r8) then + rad_avgdata%snow_icld_vistau_m(i,k) = rad_avgdata%snow_icld_vistau_m(i,k)/rad_avgdata%nct_snow_icld_vistau_m(i,k) + else + rad_avgdata%snow_icld_vistau_m(i,k) = 0.0_r8 + end if + + end do + end do + + ! Output aerosol mmr + call rad_cnst_out(0, state, pbuf) + + + ! restore to the non-spcam values + + call pbuf_get_field(pbuf, iciwp_idx, cicewp) + call pbuf_get_field(pbuf, iclwp_idx, cliqwp) + call pbuf_get_field(pbuf, icswp_idx, csnowp) + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, landm_idx, landm) + call pbuf_get_field(pbuf, dei_idx, dei) + call pbuf_get_field(pbuf, mu_idx, mu) + call pbuf_get_field(pbuf, lambdac_idx, lambdac) + call pbuf_get_field(pbuf, des_idx, des) + call pbuf_get_field(pbuf, crm_qrad_idx, crm_qrad) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + + if (prog_modal_aero) then + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + endif + + do m=1,crm_nz + k = pver-m+1 + do i = 1,ncol + ! for energy conservation + crm_qrad(i,:,:,m) = (rad_avgdata%qrs_crm(i,:,:,m)+rad_avgdata%qrl_crm(i,:,:,m)) * state%pdel(i,k) + end do + end do + + ! output rad inputs and resulting heating rates + call rad_data_write( pbuf, state, cam_in, coszrs ) + + ! Compute net radiative heating tendency + call radheat_tend(state, pbuf, ptend, rad_avgdata%qrl_m(:,:), rad_avgdata%qrs_m(:,:), rad_avgdata%fsns_m(:), & + rad_avgdata%fsnt_m(:), rad_avgdata%flns_m(:), rad_avgdata%flnt_m(:), cam_in%asdir, net_flx) + + ! Compute heating rate for dtheta/dt + do k=1,pver + do i=1,ncol + ftem(i,k) = (rad_avgdata%qrs_m(i,k) + rad_avgdata%qrl_m(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR ',ftem ,pcols ,lchnk ) + + ! convert radiative heating rates to Q*dp for energy conservation + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + do k =1 , pver + do i = 1, ncol + qrs(i,k) = rad_avgdata%qrs_m(i,k)*state%pdel(i,k) + qrl(i,k) = rad_avgdata%qrl_m(i,k)*state%pdel(i,k) + end do + end do + + ! Output icall=0 (climate) + cam_out%flwds(:ncol) = rad_avgdata%flwds_m(:ncol) + cam_out%netsw(:ncol) = rad_avgdata%fsns_m(:ncol) + cam_out%sols(:ncol) = rad_avgdata%sols_m(:ncol) + cam_out%soll(:ncol) = rad_avgdata%soll_m(:ncol) + cam_out%solsd(:ncol) = rad_avgdata%solsd_m(:ncol) + cam_out%solld(:ncol) = rad_avgdata%solld_m(:ncol) + + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + fsns(:ncol) = rad_avgdata%fsns_m(:ncol) + fsnt(:ncol) = rad_avgdata%fsnt_m(:ncol) + flns(:ncol) = rad_avgdata%flns_m(:ncol) + flnt(:ncol) = rad_avgdata%flnt_m(:ncol) + fsds(:ncol) = rad_avgdata%fsds_m(:ncol) + + deallocate(rad_avgdata%solin_m) + deallocate(rad_avgdata%fsntoa_m) + deallocate(rad_avgdata%fsutoa_m) + deallocate(rad_avgdata%fsntoac_m) + deallocate(rad_avgdata%fsnirt_m) + deallocate(rad_avgdata%fsnrtc_m) + deallocate(rad_avgdata%fsnirtsq_m) + deallocate(rad_avgdata%fsntc_m) + deallocate(rad_avgdata%fsnsc_m) + deallocate(rad_avgdata%fsdsc_m) + deallocate(rad_avgdata%flut_m) + deallocate(rad_avgdata%flutc_m) + deallocate(rad_avgdata%flntc_m) + deallocate(rad_avgdata%flnsc_m) + deallocate(rad_avgdata%fldsc_m) + deallocate(rad_avgdata%flwds_m) + deallocate(rad_avgdata%fsns_m) + deallocate(rad_avgdata%fsnr_m) + deallocate(rad_avgdata%fsnt_m) + deallocate(rad_avgdata%flns_m) + deallocate(rad_avgdata%flnt_m) + deallocate(rad_avgdata%flnr_m) + deallocate(rad_avgdata%fsds_m) + deallocate(rad_avgdata%fln200_m) + deallocate(rad_avgdata%fln200c_m) + deallocate(rad_avgdata%fsn200_m) + deallocate(rad_avgdata%fsn200c_m) + deallocate(rad_avgdata%sols_m) + deallocate(rad_avgdata%soll_m) + deallocate(rad_avgdata%solsd_m) + deallocate(rad_avgdata%solld_m) + deallocate(rad_avgdata%qrs_m) + deallocate(rad_avgdata%qrl_m) + deallocate(rad_avgdata%qrsc_m) + deallocate(rad_avgdata%qrlc_m) + deallocate(rad_avgdata%rel_crm) + deallocate(rad_avgdata%rei_crm) + deallocate(rad_avgdata%cld_tau_crm) + deallocate(rad_avgdata%qrl_crm) + deallocate(rad_avgdata%qrs_crm) + deallocate(rad_avgdata%crm_fsnt) + deallocate(rad_avgdata%crm_fsntc) + deallocate(rad_avgdata%crm_fsns) + deallocate(rad_avgdata%crm_fsnsc) + deallocate(rad_avgdata%crm_flnt) + deallocate(rad_avgdata%crm_flntc) + deallocate(rad_avgdata%crm_flns) + deallocate(rad_avgdata%crm_flnsc) + deallocate(rad_avgdata%crm_swcf) + deallocate(rad_avgdata%crm_aodvisz) + deallocate(rad_avgdata%crm_aodvis) + deallocate(rad_avgdata%crm_aod400) + deallocate(rad_avgdata%crm_aod700) + deallocate(rad_avgdata%aod400) + deallocate(rad_avgdata%aod700) + + deallocate(rad_avgdata%tot_cld_vistau_m) + deallocate(rad_avgdata%tot_icld_vistau_m) + deallocate(rad_avgdata%liq_icld_vistau_m) + deallocate(rad_avgdata%ice_icld_vistau_m) + deallocate(rad_avgdata%nct_tot_icld_vistau_m) + + deallocate(rad_avgdata%nct_liq_icld_vistau_m) + deallocate(rad_avgdata%nct_ice_icld_vistau_m) + deallocate(rad_avgdata%snow_icld_vistau_m) + deallocate(rad_avgdata%nct_snow_icld_vistau_m) + + deallocate(rad_avgdata%dei_crm) + deallocate(rad_avgdata%mu_crm) + deallocate(rad_avgdata%lambdac_crm) + deallocate(rad_avgdata%des_crm) + +#endif +end subroutine spcam_radiation_finalize_m2005 + +!=============================================================================== + +subroutine spcam_radiation_col_finalize_m2005(state, ii, jj, pbuf, rd, cam_out, rad_avgdata) + + use physconst, only: cpair + use physics_buffer, only: pbuf_old_tim_idx + use radiation, only: radiation_do + use cam_history, only: hist_fld_active + + type(physics_state), intent(in) :: state + integer, intent(in) :: ii + integer, intent(in) :: jj + type(physics_buffer_desc), pointer :: pbuf(:) + type(rad_out_t), intent(in) :: rd + type(cam_out_t), intent(inout) :: cam_out + + type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata + +#ifdef m2005 + + real(r8), parameter :: cgs2mks = 1.e-3_r8 + real(r8), parameter :: factor_xy = 1._r8/dble(crm_nx*crm_ny) + + integer :: i, k, m + integer :: ncol + integer :: itim_old + + logical :: dosw, dolw + + real(r8), pointer, dimension(:,:) :: qrs, qrl, cld + real(r8), pointer, dimension(:) :: fsds, fsns, fsnt, flns, flnt + + ncol = state%ncol + + dosw = radiation_do('sw') ! do shortwave heating calc this timestep? + dolw = radiation_do('lw') ! do longwave heating calc this timestep? + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + ! convert radiative heating rates from Q*dp for energy conservation + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)/state%pdel(i,k) + qrl(i,k) = qrl(i,k)/state%pdel(i,k) + end do + end do + + do m=1,crm_nz + k = pver-m+1 + do i=1,ncol + rad_avgdata%cld_tau_crm(i,ii,jj,m)= rd%cld_tau_cloudsim(i,k) + end do ! i + end do ! m + + if (dosw) then + + do i=1, ncol + rad_avgdata%qrs_m(i,:pver) = rad_avgdata%qrs_m(i,:pver) + qrs(i,:pver) *factor_xy + rad_avgdata%fsds_m(i) = rad_avgdata%fsds_m(i) + fsds(i) *factor_xy + rad_avgdata%fsnt_m(i) = rad_avgdata%fsnt_m(i) + fsnt(i) *factor_xy + rad_avgdata%fsns_m(i) = rad_avgdata%fsns_m(i) + fsns(i) *factor_xy + rad_avgdata%qrsc_m(i,:pver) = rad_avgdata%qrsc_m(i,:pver) + rd%qrsc(i,:pver) *factor_xy + rad_avgdata%solin_m(i) = rad_avgdata%solin_m(i) + rd%solin(i) *factor_xy + rad_avgdata%fsnirt_m(i) = rad_avgdata%fsnirt_m(i) + rd%fsnirt(i) *factor_xy + rad_avgdata%fsnrtc_m(i) = rad_avgdata%fsnrtc_m(i) + rd%fsnrtc(i) *factor_xy + rad_avgdata%fsnirtsq_m(i) = rad_avgdata%fsnirtsq_m(i) + rd%fsnirtsq(i) *factor_xy + rad_avgdata%fsntc_m(i) = rad_avgdata%fsntc_m(i) + rd%fsntc(i) *factor_xy + rad_avgdata%fsnsc_m(i) = rad_avgdata%fsnsc_m(i) + rd%fsnsc(i) *factor_xy + rad_avgdata%fsdsc_m(i) = rad_avgdata%fsdsc_m(i) + rd%fsdsc(i) *factor_xy + rad_avgdata%fsntoa_m(i) = rad_avgdata%fsntoa_m(i) + rd%fsntoa(i) *factor_xy + rad_avgdata%fsutoa_m(i) = rad_avgdata%fsutoa_m(i) + rd%fsutoa(i) *factor_xy + rad_avgdata%fsntoac_m(i) = rad_avgdata%fsntoac_m(i) + rd%fsntoac(i) *factor_xy + rad_avgdata%sols_m(i) = rad_avgdata%sols_m(i) + cam_out%sols(i) *factor_xy + rad_avgdata%soll_m(i) = rad_avgdata%soll_m(i) + cam_out%soll(i) *factor_xy + rad_avgdata%solsd_m(i) = rad_avgdata%solsd_m(i) + cam_out%solsd(i) *factor_xy + rad_avgdata%solld_m(i) = rad_avgdata%solld_m(i) + cam_out%solld(i) *factor_xy + rad_avgdata%fsn200_m(i) = rad_avgdata%fsn200_m(i) + rd%fsn200(i) *factor_xy + rad_avgdata%fsn200c_m(i) = rad_avgdata%fsn200c_m(i) + rd%fsn200c(i) *factor_xy + if (hist_fld_active('FSNR')) then + rad_avgdata%fsnr_m(i) = rad_avgdata%fsnr_m(i) + rd%fsnr(i) *factor_xy + end if + rad_avgdata%crm_fsnt(i, ii, jj) = fsnt(i) + rad_avgdata%crm_fsntc(i,ii,jj) = rd%fsntc(i) + rad_avgdata%crm_fsns(i, ii, jj) = fsns(i) + rad_avgdata%crm_fsnsc(i,ii,jj) = rd%fsnsc(i) + rad_avgdata%crm_swcf(i,ii,jj) = rd%fsntoa(i) - rd%fsntoac(i) + rad_avgdata%crm_aodvis(i,ii,jj) = sum(rd%aer_tau550(i, :)) + rad_avgdata%crm_aod400(i,ii,jj) = sum(rd%aer_tau400(i, :)) + rad_avgdata%crm_aod700(i,ii,jj) = sum(rd%aer_tau700(i, :)) + rad_avgdata%aod400(i) = rad_avgdata%aod400(i)+rad_avgdata%crm_aod400(i,ii,jj) * factor_xy + rad_avgdata%aod700(i) = rad_avgdata%aod700(i)+rad_avgdata%crm_aod700(i,ii,jj) * factor_xy + end do + do m=1,crm_nz + k = pver-m+1 + rad_avgdata%qrs_crm(:ncol,ii,jj,m) = qrs(:ncol,k) / cpair + rad_avgdata%crm_aodvisz(:ncol, ii, jj, m) = rd%aer_tau550(:ncol,k) + end do + + do i=1, ncol + do k=1, pver + if(rd%tot_icld_vistau(i,k).gt.1.0e-10_r8) then + rad_avgdata%tot_icld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k) + & + rd%tot_icld_vistau(i,k)*cld(i,k) + rad_avgdata%nct_tot_icld_vistau_m(i,k) = rad_avgdata%nct_tot_icld_vistau_m(i,k) + cld(i,k) + end if + if(rd%liq_icld_vistau(i,k).gt.1.0e-10_r8) then + rad_avgdata%liq_icld_vistau_m(i,k) = rad_avgdata%liq_icld_vistau_m(i,k) + & + rd%liq_icld_vistau(i,k)*cld(i,k) + rad_avgdata%nct_liq_icld_vistau_m(i,k) = rad_avgdata%nct_liq_icld_vistau_m(i,k) + cld(i,k) + end if + if(rd%ice_icld_vistau(i,k).gt.1.0e-10_r8) then + rad_avgdata%ice_icld_vistau_m(i,k) = rad_avgdata%ice_icld_vistau_m(i,k) + & + rd%ice_icld_vistau(i,k)*cld(i,k) + rad_avgdata%nct_ice_icld_vistau_m(i,k) = rad_avgdata%nct_ice_icld_vistau_m(i,k) + cld(i,k) + end if + if(rd%snow_icld_vistau(i,k).gt.1.0e-10_r8) then + rad_avgdata%snow_icld_vistau_m(i,k) = rad_avgdata%snow_icld_vistau_m(i,k) + & + rd%snow_icld_vistau(i,k) + rad_avgdata%nct_snow_icld_vistau_m(i,k) = rad_avgdata%nct_snow_icld_vistau_m(i,k) + 1 + end if + end do + end do + end if ! dosw + + if (dolw) then + + do i=1, ncol + rad_avgdata%qrl_m(i,:pver) = rad_avgdata%qrl_m(i,:pver) + qrl(i,:pver)*factor_xy + rad_avgdata%qrlc_m(i,:pver) = rad_avgdata%qrlc_m(i,:pver) + rd%qrlc(i,:pver)*factor_xy + rad_avgdata%flnt_m(i) = rad_avgdata%flnt_m(i) + flnt(i) *factor_xy + rad_avgdata%flut_m(i) = rad_avgdata%flut_m(i)+rd%flut(i) *factor_xy + rad_avgdata%flutc_m(i) = rad_avgdata%flutc_m(i)+rd%flutc(i) *factor_xy + rad_avgdata%flntc_m(i) = rad_avgdata%flntc_m(i)+rd%flntc(i) *factor_xy + rad_avgdata%flns_m(i) = rad_avgdata%flns_m(i) + flns(i) *factor_xy + rad_avgdata%flnsc_m(i) = rad_avgdata%flnsc_m(i)+rd%flnsc(i) *factor_xy + rad_avgdata%fldsc_m(i) = rad_avgdata%fldsc_m(i)+rd%fldsc(i) *factor_xy + rad_avgdata%flwds_m(i) = rad_avgdata%flwds_m(i)+cam_out%flwds(i) *factor_xy + rad_avgdata%fln200_m(i) = rad_avgdata%fln200_m(i)+rd%fln200(i) *factor_xy + rad_avgdata%fln200c_m(i) = rad_avgdata%fln200c_m(i)+rd%fln200c(i) *factor_xy + if (hist_fld_active('FLNR')) then + rad_avgdata%flnr_m(i) = rad_avgdata%flnr_m(i)+rd%flnr(i) *factor_xy + end if + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + rad_avgdata%crm_flnt(i, ii, jj) = flnt(i) + rad_avgdata%crm_flntc(i,ii,jj) = rd%flntc(i) + rad_avgdata%crm_flns(i, ii, jj) = flns(i) + rad_avgdata%crm_flnsc(i,ii,jj) = rd%flnsc(i) + do m=1,crm_nz + k = pver-m+1 + rad_avgdata%qrl_crm(:ncol,ii,jj,m) = qrl(:ncol,k) / cpair + end do + + end do + + end if !dolw + + +#endif + +end subroutine spcam_radiation_col_finalize_m2005 + +!=============================================================================== + +subroutine spcam_radiation_setup_sam1mom(cam_in, cldn, state, pbuf, rad_avgdata, state_loc) + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_old_tim_idx + + type(cam_in_t), intent(in) :: cam_in + real(r8), dimension(:,:), intent(out) :: cldn + type(physics_state), intent(in) :: state + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + + type(rad_avgdata_type_sam1mom) :: rad_avgdata + type(physics_state), intent(inout) :: state_loc + +#ifdef sam1mom + real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity + real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth + real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path + real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path + + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:) :: landm ! land fraction ramp + + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: itim_old + + ncol = state%ncol + lchnk = state%lchnk + + + call physics_state_copy(state, state_loc) + + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ! Save the grid level cld values as cld will be overwritten with each crm-scale level value during radiation + cldn = cld + + allocate(rad_avgdata%solin_m (pcols)) + allocate(rad_avgdata%fsntoa_m (pcols)) + allocate(rad_avgdata%fsutoa_m (pcols)) + allocate(rad_avgdata%fsntoac_m (pcols)) + allocate(rad_avgdata%fsnirt_m (pcols)) + allocate(rad_avgdata%fsnrtc_m (pcols)) + allocate(rad_avgdata%fsnirtsq_m (pcols)) + allocate(rad_avgdata%fsntc_m (pcols)) + allocate(rad_avgdata%fsnsc_m (pcols)) + allocate(rad_avgdata%fsdsc_m (pcols)) + allocate(rad_avgdata%flut_m (pcols)) + allocate(rad_avgdata%flutc_m (pcols)) + allocate(rad_avgdata%flntc_m (pcols)) + allocate(rad_avgdata%flnsc_m (pcols)) + allocate(rad_avgdata%fldsc_m (pcols)) + allocate(rad_avgdata%flwds_m (pcols)) + allocate(rad_avgdata%fsns_m (pcols)) + allocate(rad_avgdata%fsnr_m (pcols)) + allocate(rad_avgdata%fsnt_m (pcols)) + allocate(rad_avgdata%flns_m (pcols)) + allocate(rad_avgdata%flnt_m (pcols)) + allocate(rad_avgdata%flnr_m (pcols)) + allocate(rad_avgdata%fsds_m (pcols)) + allocate(rad_avgdata%fln200_m (pcols)) + allocate(rad_avgdata%fln200c_m (pcols)) + allocate(rad_avgdata%fsn200_m (pcols)) + allocate(rad_avgdata%fsn200c_m (pcols)) + allocate(rad_avgdata%sols_m (pcols)) + allocate(rad_avgdata%soll_m (pcols)) + allocate(rad_avgdata%solsd_m (pcols)) + allocate(rad_avgdata%solld_m (pcols)) + allocate(rad_avgdata%qrs_m (pcols,pver)) + allocate(rad_avgdata%qrl_m (pcols,pver)) + allocate(rad_avgdata%qrsc_m (pcols,pver)) + allocate(rad_avgdata%qrlc_m (pcols,pver)) + allocate(rad_avgdata%rel_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%rei_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%cld_tau_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%qrl_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%qrs_crm (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%crm_fsnt (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsntc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsns (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_fsnsc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flnt (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flntc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flns (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_flnsc (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_swcf (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aodvisz (pcols, crm_nx, crm_ny, crm_nz)) + allocate(rad_avgdata%crm_aodvis (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aod400 (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%crm_aod700 (pcols, crm_nx, crm_ny)) + allocate(rad_avgdata%aod400 (pcols)) + allocate(rad_avgdata%aod700 (pcols)) + allocate(rad_avgdata%fsdtoa_m (pcols)) + allocate(rad_avgdata%flds_m (pcols)) + + allocate(rad_avgdata%tot_cld_vistau_m ( pcols,pver)) + allocate(rad_avgdata%tot_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%liq_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%ice_icld_vistau_m (pcols,pver)) + allocate(rad_avgdata%nct_tot_icld_vistau_m(pcols,pver)) + allocate(rad_avgdata%nct_liq_icld_vistau_m(pcols,pver)) + allocate(rad_avgdata%nct_ice_icld_vistau_m(pcols,pver)) + + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, landm_idx, landm) + call pbuf_get_field(pbuf, crm_t_rad_idx, rad_avgdata%t_rad) + call pbuf_get_field(pbuf, crm_qc_rad_idx, rad_avgdata%qc_rad) + call pbuf_get_field(pbuf, crm_qi_rad_idx, rad_avgdata%qi_rad) + call pbuf_get_field(pbuf, crm_qv_rad_idx, rad_avgdata%qv_rad) + call pbuf_get_field(pbuf, crm_qrad_idx, rad_avgdata%crm_qrad) + + + ! pbuf cloud properties set in cloud_diagnostics + call pbuf_get_field(pbuf, cicewp_idx, cicewp) + call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) + call pbuf_get_field(pbuf, cldemis_idx, emis) + call pbuf_get_field(pbuf, cldtau_idx, cldtau) + + + rad_avgdata%solin_m = 0._r8 + rad_avgdata%fsntoa_m = 0._r8 + rad_avgdata%fsutoa_m = 0._r8 + rad_avgdata%fsntoac_m = 0._r8 + rad_avgdata%fsnirt_m = 0._r8 + rad_avgdata%fsnrtc_m = 0._r8 + rad_avgdata%fsnirtsq_m = 0._r8 + rad_avgdata%fsntc_m = 0._r8 + rad_avgdata%fsdtoa_m = 0._r8 + rad_avgdata%fsnsc_m = 0._r8 + rad_avgdata%fsdsc_m = 0._r8 + rad_avgdata%flut_m = 0._r8 + rad_avgdata%flutc_m = 0._r8 + rad_avgdata%flntc_m = 0._r8 + rad_avgdata%flnsc_m = 0._r8 + rad_avgdata%flds_m = 0._r8 + rad_avgdata%fldsc_m = 0._r8 + rad_avgdata%fsns_m = 0._r8 + rad_avgdata%fsnt_m = 0._r8 + rad_avgdata%flns_m = 0._r8 + rad_avgdata%flnt_m = 0._r8 + rad_avgdata%flnr_m = 0._r8 + rad_avgdata%fsds_m = 0._r8 + rad_avgdata%fsnr_m = 0._r8 + rad_avgdata%fln200_m = 0._r8 + rad_avgdata%fln200c_m = 0._r8 + rad_avgdata%fsn200_m = 0._r8 + rad_avgdata%fsn200c_m = 0._r8 + rad_avgdata%sols_m = 0._r8 + rad_avgdata%soll_m = 0._r8 + rad_avgdata%solsd_m = 0._r8 + rad_avgdata%solld_m = 0._r8 + rad_avgdata%qrs_m = 0._r8 + rad_avgdata%qrl_m = 0._r8 + rad_avgdata%qrsc_m = 0._r8 + rad_avgdata%qrlc_m = 0._r8 + rad_avgdata%qrs_crm = 0._r8 + rad_avgdata%qrl_crm = 0._r8 + + rad_avgdata%tot_cld_vistau_m =0._r8 + rad_avgdata%tot_icld_vistau_m=0._r8 ; rad_avgdata%nct_tot_icld_vistau_m=0._r8 + rad_avgdata%liq_icld_vistau_m=0._r8 ; rad_avgdata%nct_liq_icld_vistau_m=0._r8 + rad_avgdata%ice_icld_vistau_m=0._r8 ; rad_avgdata%nct_ice_icld_vistau_m=0._r8 + + + ! Compute effective sizes + call cldefr(lchnk, ncol, cam_in%landfrac, state%t, rel, rei, state%ps, state%pmid, landm, cam_in%icefrac, cam_in%snowhland) + + cicewp(1:ncol,1:pver) = 0._r8 + cliqwp(1:ncol,1:pver) = 0._r8 + +#endif +end subroutine spcam_radiation_setup_sam1mom + +!=============================================================================== + +subroutine spcam_radiation_col_setup_sam1mom(ii, jj, state_loc, pbuf, rad_avgdata) + + use physics_buffer, only: pbuf_old_tim_idx + use physconst, only: gravit + + integer,intent(in) :: ii,jj + + type(physics_state), intent(inout) :: state_loc + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata + +#ifdef sam1mom + + real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity + real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth + real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path + real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path + + real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) + real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) + real(r8), pointer, dimension(:,:,:,:) :: cld_rad ! rad cloud fraction + real(r8), pointer, dimension(:,:) :: pmxrgn ! Maximum values of pressure for each + ! maximally overlapped region. + ! 0->pmxrgn(i,1) is range of pressure for + ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for + ! 2nd region, etc + integer, pointer, dimension(:) :: nmxrgn ! pbuf pointer to Number of maximally overlapped regions + + real(r8) :: qtot + real(r8), dimension(pcols,pver) :: fice + real(r8), dimension(pcols,pver) :: tmp + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + + integer :: itim_old + integer :: m, k, i + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + + lchnk = state_loc%lchnk + ncol = state_loc%ncol + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn) + call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn) + call pbuf_get_field(pbuf, rel_idx, rel) + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, crm_cld_rad_idx, cld_rad) + + call pbuf_get_field(pbuf, crm_t_rad_idx, rad_avgdata%t_rad) + call pbuf_get_field(pbuf, crm_qc_rad_idx, rad_avgdata%qc_rad) + call pbuf_get_field(pbuf, crm_qi_rad_idx, rad_avgdata%qi_rad) + call pbuf_get_field(pbuf, crm_qv_rad_idx, rad_avgdata%qv_rad) + call pbuf_get_field(pbuf, crm_qrad_idx, rad_avgdata%crm_qrad) + + + ! pbuf cloud properties set in cloud_diagnostics + call pbuf_get_field(pbuf, cicewp_idx, cicewp) + call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) + call pbuf_get_field(pbuf, cldemis_idx, emis) + call pbuf_get_field(pbuf, cldtau_idx, cldtau) + + fice(1:ncol,1:pver-crm_nz) = 0._r8 + + do m=1,crm_nz + k = pver-m+1 + do i=1,ncol + + qtot = rad_avgdata%qc_rad(i,ii,jj,m) + rad_avgdata%qi_rad(i,ii,jj,m) + if(qtot.gt.1.e-9_r8) then + fice(i,k) = rad_avgdata%qi_rad(i,ii,jj,m)/qtot + ! In case CRM produces fractional cloudiness + cld(i,k) = min(0.99_r8, cld_rad(i,ii,jj,m)) + + cicewp(i,k) = rad_avgdata%qi_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit*1000.0_r8 & + / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = rad_avgdata%qc_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit*1000.0_r8 & + / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. + else + fice(i,k)=0._r8 + cld(i,k)=0._r8 + cicewp(i,k) = 0._r8 ! In-cloud ice water path. + cliqwp(i,k) = 0._r8 ! In-cloud liquid water path. + end if + end do ! i + end do ! m + + ! Cloud emissivity. + + tmp(:ncol,:) = cicewp(:ncol,:) + cliqwp(:ncol,:) + call cldems(lchnk, ncol, tmp, fice, rei, emis, cldtau) + + call cldovrlap(lchnk, ncol, state_loc%pint, cld, nmxrgn, pmxrgn) + + ! Setup the trad and qvrad variables (now in state) + do m=1,crm_nz + k = pver-m+1 + do i=1,ncol + state_loc%q(i,k,1) = max(1.e-9_r8,rad_avgdata%qv_rad(i,ii,jj,m)) + state_loc%t(i,k) = rad_avgdata%t_rad(i,ii,jj,m) + end do + end do + + +#endif +end subroutine spcam_radiation_col_setup_sam1mom + +!=============================================================================== + +subroutine spcam_radiation_finalize_sam1mom(cam_in, state, pbuf, rad_avgdata, cam_out, cldn, net_flx, ptend) + + use physconst, only: cpair + use rad_constituents,only: rad_cnst_out + + use physconst, only: cappa + use radiation_data, only: rad_data_write + use radheat, only: radheat_tend + use time_manager, only: get_curr_calday + use physics_buffer, only: pbuf_old_tim_idx + use orbit, only: zenith + + type(cam_in_t), intent(in) :: cam_in + type(physics_state), intent(in) :: state + + + type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) + type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata + type(cam_out_t), intent(inout) :: cam_out + real(r8), dimension(:,:), intent(in) :: cldn + real(r8), intent(inout) :: net_flx(pcols) + + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + +#ifdef sam1mom + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i, k, m + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + + real(r8), pointer, dimension(:,:) :: qrs, qrl, cld + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + real(r8), pointer :: fsds(:) ! Surface solar down flux + + + + real(r8) :: calday ! current calendar day + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + real(r8) :: factor_xy + + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns + integer, dimension(pcols) :: IdxNite ! Indicies of night coumns + integer :: itim_old + + lchnk = state%lchnk + ncol = state%ncol + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + + factor_xy = 1._r8/dble(crm_nx*crm_ny) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ! Reassign the grid level cld values since cld was overwritten with each crm-scale level value during radiation + cld = cldn + + + do m=1,crm_nz + k = pver-m+1 + do i = 1,ncol + ! for energy conservation + rad_avgdata%crm_qrad(i,:,:,m) = (rad_avgdata%qrs_crm(i,:,:,m)+rad_avgdata%qrl_crm(i,:,:,m)) * state%pdel(i,k) + end do + end do + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + fsns = rad_avgdata%fsns_m(:) + fsnt = rad_avgdata%fsnt_m(:) + flns = rad_avgdata%flns_m(:) + flnt = rad_avgdata%flnt_m(:) + fsds = rad_avgdata%fsds_m(:) + + calday = get_curr_calday() + + ! Cosine solar zenith angle for current time step + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + call zenith (calday, clat, clon, coszrs, ncol) + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + cam_out%sols(:ncol) = rad_avgdata%sols_m(:ncol) + cam_out%soll(:ncol) = rad_avgdata%soll_m(:ncol) + cam_out%solsd(:ncol) = rad_avgdata%solsd_m(:ncol) + cam_out%solld(:ncol) = rad_avgdata%solld_m(:ncol) + + call outfld('CRM_QRS ',rad_avgdata%qrs_crm,pcols,lchnk) + call outfld('QRS ',rad_avgdata%qrs_m(:,:)/cpair ,pcols,lchnk) + call outfld('QRSC ',rad_avgdata%qrsc_m/cpair,pcols,lchnk) + call outfld('SOLIN ',rad_avgdata%solin_m(:) ,pcols,lchnk) + call outfld('FSDS ',rad_avgdata%fsds_m(:) ,pcols,lchnk) + call outfld('FSNIRTOA',rad_avgdata%fsnirt_m(:),pcols,lchnk) + call outfld('FSNRTOAC',rad_avgdata%fsnrtc_m(:),pcols,lchnk) + call outfld('FSNRTOAS',rad_avgdata%fsnirtsq_m(:),pcols,lchnk) + call outfld('FSNT ',rad_avgdata%fsnt_m(:) ,pcols,lchnk) + call outfld('FSDTOA ',rad_avgdata%fsdtoa_m(:),pcols,lchnk) + call outfld('FSNS ',rad_avgdata%fsns_m(:) ,pcols,lchnk) + call outfld('FSNTC ',rad_avgdata%fsntc_m(:) ,pcols,lchnk) + call outfld('FSNSC ',rad_avgdata%fsnsc_m(:) ,pcols,lchnk) + call outfld('FSDSC ',rad_avgdata%fsdsc_m(:) ,pcols,lchnk) + call outfld('FSNTOA ',rad_avgdata%fsntoa_m(:),pcols,lchnk) + call outfld('FSUTOA ',rad_avgdata%fsutoa_m(:),pcols,lchnk) + call outfld('FSNTOAC ',rad_avgdata%fsntoac_m(:),pcols,lchnk) + call outfld('SOLS ',cam_out%sols ,pcols,lchnk) + call outfld('SOLL ',cam_out%soll ,pcols,lchnk) + call outfld('SOLSD ',cam_out%solsd ,pcols,lchnk) + call outfld('SOLLD ',cam_out%solld ,pcols,lchnk) + call outfld('FSN200 ',rad_avgdata%fsn200_m(:),pcols,lchnk) + call outfld('FSN200C ',rad_avgdata%fsn200c_m(:),pcols,lchnk) + call outfld('FSNR' ,rad_avgdata%fsnr_m(:) ,pcols,lchnk) + call outfld('SWCF ',rad_avgdata%fsntoa_m(:ncol)-rad_avgdata%fsntoac_m(:ncol) ,pcols,lchnk) + + do i=1, Nday + do k=1, pver + rad_avgdata%tot_cld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) * factor_xy + if(rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then + rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k)/& + rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) + else + rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = 0.0_r8 + end if + if(rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then + rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%liq_icld_vistau_m(IdxDay(i),k)/& + rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) + else + rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = 0.0_r8 + end if + if(rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then + rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%ice_icld_vistau_m(IdxDay(i),k)/& + rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) + else + rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = 0.0_r8 + end if + end do + end do + + ! add fillvalue for night columns + do i = 1, Nnite + rad_avgdata%tot_cld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%tot_icld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%liq_icld_vistau_m(IdxNite(i),:) = fillvalue + rad_avgdata%ice_icld_vistau_m(IdxNite(i),:) = fillvalue + end do + + call outfld ('TOT_CLD_VISTAU ',rad_avgdata%tot_cld_vistau_m ,pcols,lchnk) + call outfld ('TOT_ICLD_VISTAU ',rad_avgdata%tot_icld_vistau_m ,pcols,lchnk) + call outfld ('LIQ_ICLD_VISTAU ',rad_avgdata%liq_icld_vistau_m ,pcols,lchnk) + call outfld ('ICE_ICLD_VISTAU ',rad_avgdata%ice_icld_vistau_m ,pcols,lchnk) + + + ! Longwave + cam_out%flwds(:) = rad_avgdata%flds_m(:) + call outfld('CRM_QRL ',rad_avgdata%qrl_crm, pcols, lchnk) + call outfld('QRL ',rad_avgdata%qrl_m(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRLC ',rad_avgdata%qrlc_m(:ncol,:)/cpair, ncol, lchnk) + call outfld('FLNT ',rad_avgdata%flnt_m , pcols, lchnk) + call outfld('FLUT ',rad_avgdata%flut_m, pcols, lchnk) + call outfld('FLUTC ',rad_avgdata%flutc_m, pcols, lchnk) + call outfld('FLNTC ',rad_avgdata%flntc_m, pcols, lchnk) + call outfld('FLNS ',rad_avgdata%flns_m, pcols, lchnk) + call outfld('FLDS ',rad_avgdata%flds_m, pcols, lchnk) + call outfld('FLNSC ',rad_avgdata%flnsc_m, pcols, lchnk) + call outfld('FLDSC ',rad_avgdata%fldsc_m, pcols, lchnk) + call outfld('LWCF ',rad_avgdata%flutc_m-rad_avgdata%flut_m, pcols, lchnk) + call outfld('FLN200 ',rad_avgdata%fln200_m, pcols, lchnk) + call outfld('FLN200C ',rad_avgdata%fln200c_m, pcols, lchnk) + call outfld('FLNR ' ,rad_avgdata%flnr_m, pcols, lchnk) + + ! Output aerosol mmr + call rad_cnst_out(0, state, pbuf) + + ! output rad inputs and resulting heating rates + call rad_data_write( pbuf, state, cam_in, coszrs ) + + ! Compute net radiative heating tendency + call radheat_tend(state, pbuf, ptend, rad_avgdata%qrl_m, rad_avgdata%qrs_m, rad_avgdata%fsns_m, & + rad_avgdata%fsnt_m, rad_avgdata%flns_m, rad_avgdata%flnt_m, cam_in%asdir, net_flx) + + ! Compute heating rate for dtheta/dt + do k=1,pver + do i=1,ncol + ftem(i,k) = (rad_avgdata%qrs_m(i,k) + rad_avgdata%qrl_m(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR ',ftem ,pcols ,lchnk ) + + do k =1 , pver + do i = 1, ncol + qrs(i,k) = rad_avgdata%qrs_m(i,k)*state%pdel(i,k) + qrl(i,k) = rad_avgdata%qrl_m(i,k)*state%pdel(i,k) + end do + end do + + cam_out%netsw(:ncol) = rad_avgdata%fsns_m(:ncol) + cam_out%flwds(:ncol) = rad_avgdata%flds_m(:ncol) + + deallocate(rad_avgdata%solin_m) + deallocate(rad_avgdata%fsntoa_m) + deallocate(rad_avgdata%fsutoa_m) + deallocate(rad_avgdata%fsntoac_m) + deallocate(rad_avgdata%fsnirt_m) + deallocate(rad_avgdata%fsnrtc_m) + deallocate(rad_avgdata%fsnirtsq_m) + deallocate(rad_avgdata%fsntc_m) + deallocate(rad_avgdata%fsnsc_m) + deallocate(rad_avgdata%fsdsc_m) + deallocate(rad_avgdata%flut_m) + deallocate(rad_avgdata%flutc_m) + deallocate(rad_avgdata%flntc_m) + deallocate(rad_avgdata%flnsc_m) + deallocate(rad_avgdata%fldsc_m) + deallocate(rad_avgdata%flwds_m) + deallocate(rad_avgdata%fsns_m) + deallocate(rad_avgdata%fsnr_m) + deallocate(rad_avgdata%fsnt_m) + deallocate(rad_avgdata%flns_m) + deallocate(rad_avgdata%flnt_m) + deallocate(rad_avgdata%flnr_m) + deallocate(rad_avgdata%fsds_m) + deallocate(rad_avgdata%fln200_m) + deallocate(rad_avgdata%fln200c_m) + deallocate(rad_avgdata%fsn200_m) + deallocate(rad_avgdata%fsn200c_m) + deallocate(rad_avgdata%sols_m) + deallocate(rad_avgdata%soll_m) + deallocate(rad_avgdata%solsd_m) + deallocate(rad_avgdata%solld_m) + deallocate(rad_avgdata%qrs_m) + deallocate(rad_avgdata%qrl_m) + deallocate(rad_avgdata%qrsc_m) + deallocate(rad_avgdata%qrlc_m) + deallocate(rad_avgdata%rel_crm) + deallocate(rad_avgdata%rei_crm) + deallocate(rad_avgdata%cld_tau_crm) + deallocate(rad_avgdata%qrl_crm) + deallocate(rad_avgdata%qrs_crm) + deallocate(rad_avgdata%crm_fsnt) + deallocate(rad_avgdata%crm_fsntc) + deallocate(rad_avgdata%crm_fsns) + deallocate(rad_avgdata%crm_fsnsc) + deallocate(rad_avgdata%crm_flnt) + deallocate(rad_avgdata%crm_flntc) + deallocate(rad_avgdata%crm_flns) + deallocate(rad_avgdata%crm_flnsc) + deallocate(rad_avgdata%crm_swcf) + deallocate(rad_avgdata%crm_aodvisz) + deallocate(rad_avgdata%crm_aodvis) + deallocate(rad_avgdata%crm_aod400) + deallocate(rad_avgdata%crm_aod700) + deallocate(rad_avgdata%aod400) + deallocate(rad_avgdata%aod700) + deallocate(rad_avgdata%fsdtoa_m) + deallocate(rad_avgdata%flds_m) + + deallocate(rad_avgdata%tot_cld_vistau_m) + deallocate(rad_avgdata%tot_icld_vistau_m) + deallocate(rad_avgdata%liq_icld_vistau_m) + deallocate(rad_avgdata%ice_icld_vistau_m) + deallocate(rad_avgdata%nct_tot_icld_vistau_m) + deallocate(rad_avgdata%nct_liq_icld_vistau_m) + deallocate(rad_avgdata%nct_ice_icld_vistau_m) +#endif + +end subroutine spcam_radiation_finalize_sam1mom + +subroutine spcam_radiation_col_finalize_sam1mom(state, ii, jj, pbuf, rd, cam_out, rad_avgdata) + + use physconst, only: cpair + use physics_buffer, only: pbuf_old_tim_idx + use orbit, only: zenith + use time_manager, only: get_curr_calday + use radiation, only: radiation_do + + type(physics_state), intent(in) :: state + integer, intent(in) :: ii + integer, intent(in) :: jj + type(physics_buffer_desc), pointer :: pbuf(:) + type(rad_out_t), intent(in) :: rd + type(cam_out_t), intent(inout) :: cam_out + + real(r8), parameter :: cgs2mks = 1.e-3_r8 + + type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata + +#ifdef sam1mom + + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + real(r8), pointer :: fsds(:) ! Surface solar down flux + + integer :: itim_old + integer :: ncol + integer :: i, m, k, lchnk + + + logical :: dosw, dolw + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns + + + real(r8) :: calday ! current calendar day + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + real(r8) :: factor_xy + + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:,:) :: qrs + real(r8), pointer, dimension(:,:) :: qrl + + ncol = state%ncol + lchnk = state%lchnk + + calday = get_curr_calday() + + ! Cosine solar zenith angle for current time step + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + call zenith (calday, clat, clon, coszrs, ncol) + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + end if + end do + + dosw = radiation_do('sw') ! do shortwave heating calc this timestep? + dolw = radiation_do('lw') ! do longwave heating calc this timestep? + + factor_xy = 1._r8/dble(crm_nx*crm_ny) + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qrs_idx,qrs) + call pbuf_get_field(pbuf, qrl_idx,qrl) + call pbuf_get_field(pbuf, qrl_idx,qrl) + + ! convert radiative heating rates from Q*dp for energy conservation + do k =1 , pver + do i = 1, ncol + qrs(i,k) = qrs(i,k)/state%pdel(i,k) + qrl(i,k) = qrl(i,k)/state%pdel(i,k) + end do + end do + + if (dosw) then + call pbuf_get_field(pbuf, fsds_idx, fsds) + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + do i=1,ncol + rad_avgdata%fsds_m(i) = rad_avgdata%fsds_m(i) +fsds(i) *factor_xy + rad_avgdata%fsns_m(i) = rad_avgdata%fsns_m(i) +fsns(i) *factor_xy + rad_avgdata%fsnt_m(i) = rad_avgdata%fsnt_m(i) +fsnt(i) *factor_xy + + rad_avgdata%solin_m(i) = rad_avgdata%solin_m(i) +rd%solin(i)*factor_xy + rad_avgdata%fsnirt_m(i) = rad_avgdata%fsnirt_m(i) +rd%fsnirt(i)*factor_xy + rad_avgdata%fsnrtc_m(i) = rad_avgdata%fsnrtc_m(i) +rd%fsnrtc(i)*factor_xy + rad_avgdata%fsnirtsq_m(i)= rad_avgdata%fsnirtsq_m(i)+rd%fsnirtsq(i)*factor_xy + rad_avgdata%fsdtoa_m(i) = rad_avgdata%fsdtoa_m(i) +rd%fsdtoa(i)*factor_xy + rad_avgdata%fsntc_m(i) = rad_avgdata%fsntc_m(i) +rd%fsntc(i)*factor_xy + rad_avgdata%fsnsc_m(i) = rad_avgdata%fsnsc_m(i) +rd%fsnsc(i)*factor_xy + rad_avgdata%fsdsc_m(i) = rad_avgdata%fsdsc_m(i) +rd%fsdsc(i)*factor_xy + rad_avgdata%fsntoa_m(i) = rad_avgdata%fsntoa_m(i) +rd%fsntoa(i)*factor_xy + rad_avgdata%fsutoa_m(i) = rad_avgdata%fsutoa_m(i) +rd%fsutoa(i)*factor_xy + rad_avgdata%fsntoac_m(i) = rad_avgdata%fsntoac_m(i) +rd%fsntoac(i)*factor_xy + + ! sols, soll, solsd, solld have unit of mks, so no conversion is needed + rad_avgdata%sols_m(i) = rad_avgdata%sols_m(i) +cam_out%sols(i) *factor_xy + rad_avgdata%soll_m(i) = rad_avgdata%soll_m(i) +cam_out%soll(i) *factor_xy + rad_avgdata%solsd_m(i) = rad_avgdata%solsd_m(i) +cam_out%solsd(i) *factor_xy + rad_avgdata%solld_m(i) = rad_avgdata%solld_m(i) +cam_out%solld(i) *factor_xy + + rad_avgdata%fsn200_m(i) = rad_avgdata%fsn200_m(i) +rd%fsn200(i) *factor_xy + rad_avgdata%fsn200c_m(i) = rad_avgdata%fsn200c_m(i) +rd%fsn200c(i) *factor_xy + rad_avgdata%fsnr_m(i) = rad_avgdata%fsnr_m(i) +rd%fsnr(i) *factor_xy + end do + rad_avgdata%qrs_m(:ncol,:pver) = rad_avgdata%qrs_m(:ncol,:pver) + qrs(:ncol,:pver) *factor_xy + rad_avgdata%qrsc_m(:ncol,:pver) = rad_avgdata%qrsc_m(:ncol,:pver) + rd%qrsc(:ncol,:pver)*factor_xy + do m=1,crm_nz + k = pver-m+1 + rad_avgdata%qrs_crm(:ncol,ii,jj,m) = qrs(:ncol,k) / cpair + end do + do i=1, Nday + do k=1, pver + if((rd%liq_icld_vistau(IdxDay(i),k)+rd%ice_icld_vistau(IdxDay(i),k)).gt.1.0e-10_r8) then + rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) + & + (rd%liq_icld_vistau(IdxDay(i),k)+rd%ice_icld_vistau(IdxDay(i),k)) * cld(i,k) + rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) + cld(i,k) + end if + if(rd%liq_icld_vistau(IdxDay(i),k).gt.1.0e-10_r8) then + rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) + & + rd%liq_icld_vistau(IdxDay(i),k) * cld(i,k) + rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) + cld(i,k) + end if + if(rd%ice_icld_vistau(IdxDay(i),k).gt.1.0e-10_r8) then + rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) + & + rd%ice_icld_vistau(IdxDay(i),k) * cld(i,k) + rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) + cld(i,k) + end if + end do + end do + end if ! dosw + + if (dolw) then + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + do i=1,ncol + rad_avgdata%flns_m(i) = rad_avgdata%flns_m(i) +flns(i) *factor_xy + rad_avgdata%flnt_m(i) = rad_avgdata%flnt_m(i) +flnt(i) *factor_xy + + rad_avgdata%flut_m(i) = rad_avgdata%flut_m(i) +rd%flut(i) *factor_xy + rad_avgdata%flutc_m(i) = rad_avgdata%flutc_m(i) +rd%flutc(i) *factor_xy + rad_avgdata%flds_m(i) = rad_avgdata%flds_m(i) +cam_out%flwds(i) *factor_xy + rad_avgdata%fldsc_m(i) = rad_avgdata%fldsc_m(i) +rd%fldsc(i) *factor_xy + rad_avgdata%flntc_m(i) = rad_avgdata%flntc_m(i) +rd%flntc(i) *factor_xy + rad_avgdata%fln200_m(i) = rad_avgdata%fln200_m(i) +rd%fln200(i) *factor_xy + rad_avgdata%fln200c_m(i) = rad_avgdata%fln200c_m(i) +rd%fln200c(i) *factor_xy + rad_avgdata%flnsc_m(i) = rad_avgdata%flnsc_m(i) +rd%flnsc(i) *factor_xy + rad_avgdata%flnr_m(i) = rad_avgdata%flnr_m(i) +rd%flnr(i) *factor_xy + end do + rad_avgdata%qrl_m(:ncol,:pver) = rad_avgdata%qrl_m(:ncol,:pver) + qrl(:ncol,:pver) *factor_xy + rad_avgdata%qrlc_m(:ncol,:pver) = rad_avgdata%qrlc_m(:ncol,:pver) + rd%qrlc(:ncol,:pver) *factor_xy + + do m=1,crm_nz + k = pver-m+1 + rad_avgdata%qrl_crm(:ncol,ii,jj,m) = qrl(:ncol,k) / cpair + end do + end if + + do m=1,crm_nz + k = pver-m+1 + do i = 1,ncol + ! for energy conservation + rad_avgdata%crm_qrad(i,ii,jj,m) = (rad_avgdata%qrs_crm(i,ii,jj,m)+rad_avgdata%qrl_crm(i,ii,jj,m)) * state%pdel(i,k) + end do + end do + +#endif +end subroutine spcam_radiation_col_finalize_sam1mom + +end module spcam_drivers diff --git a/src/physics/waccm/efield.F90 b/src/physics/waccm/efield.F90 new file mode 100644 index 0000000000..4f1eb75e06 --- /dev/null +++ b/src/physics/waccm/efield.F90 @@ -0,0 +1,1575 @@ + + module efield +!------------------------------------------------------------------------------ +! description: calculates the electric potential for a given year, +! day of year,UT, F10.7, B_z(K_p) +! - low/midlatitudes electric potential is from an empirical model from +! L.Scherliess ludger@gaim.cass.usu.edu +! - high latitude electric potential is from Weimer96 model +! - the transition zone is smoothed +! - output is the horizontal global electric field in magnetic coordinates direction +! at every magnetic local time grid point expressed in degrees (0 deg-0MLT; 360deg 24 MLT) +! +! input +! integer :: iday, ! day number of year +! iyear ! year +! real(r8):: ut, ! universal time +! F10.7, ! solar flux (see ionosphere module) +! bz ! component of IMF (see ionosphere module) +! output +! real(r8) :: & +! ed1(0:nmlon,0:nmlat), & ! zonal electric field Ed1 [V/m] +! ed2(0:nmlon,0:nmlat) ! meridional electric field Ed2/sin I_m [V/m] +! +! notes: +! +! - !to be done (commented out): input S_a F10.7/ Kp from WACCM and calculate B_z +! from these inputs +! - assume regular geomagnetic grid +! - uses average year 365.24 days/year 30.6001 day/mo s. Weimer +! - get_tilt works only for iyear >= 1900 +! - Weimer model 1996, Dan Weimer (not with the updates from B.Emery) +! - fixed parameters: B_z, B_y units nT CHANGE THIS +! F10.7 +! - we assume that the reference height is 300km for the emperical potential model +! - as a first approximation the electric field is constant in height +! WATCH what is the upper boundary condition in WACCM +! - for all the calculation done here we set the reference height to the same +! value as in tiegcm (hr=130km) +! - 12/15/03 input value iseasav : replaced by day -> month and day of month +! - 12/15/03 S_aM calculated according to Scherliess draft paper and added +! S_aM(corrected) = 90*(S_aM+1) to get variation in fig 1 Scherliess draft +! +! Author: A. Maute Dec 2003 am 12/30/03 +!------------------------------------------------------------------------------ + + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use wei96, only: gecmp, ReadCoef, EpotVal, adjust, get_tilt, SetModel + use solar_parms_data, only: f107d=>solar_parms_f107 + + implicit none + + public :: efield_init, & ! interface routine + get_efield ! interface routine + public :: ed1, & ! zonal electric field Ed1 [V/m] + ed2, & ! meridional electric field Ed2 [V/m] + potent, & ! electric potential [V] + nmlon, nmlat, & ! dimension of mag. grid + dlatm, dlonm, & ! grid spacing of mag. grid + ylonm, ylatm ! magnetic longitudes/latitudes (deg) + private + + integer :: & + iday, & ! day number of year + iyear, & ! year + iday_m, & ! day of month + imo ! month + real(r8) :: ut ! universal time + +!------------------------------------------------------------------------------ +! solar parameters +!------------------------------------------------------------------------------ + real(r8) :: by ! By component of IMF [nT] + real(r8) :: bz ! Bz component of IMF [nT] +!------------------------------------------------------------------------------ +! mag. grid dimensions (assumed resolution of 2deg) +!------------------------------------------------------------------------------ + integer, parameter :: & + nmlon = 180, & ! mlon + nmlat = 90, & ! mlat + nmlath= nmlat/2, & ! mlat/2 + nmlonh= nmlon/2, & ! mlon/2 + nmlonp1 = nmlon+1, & ! mlon+1 + nmlatp1 = nmlat+1 ! mlat+1 + + real(r8) :: & + ylatm(0:nmlat), & ! magnetic latitudes (deg) + ylonm(0:nmlon), & ! magnetic longitudes (deg) + dlonm, & ! delon lon grid spacing + dlatm ! delat lat grid spacing + +!------------------------------------------------------------------------------ +! array on magnetic grid: +!------------------------------------------------------------------------------ + real(r8) :: & + potent(0:nmlon,0:nmlat), & ! electric potential [V] + ed1(0:nmlon,0:nmlat), & ! zonal electric field Ed1 [V/m] + ed2(0:nmlon,0:nmlat) ! meridional electric field Ed2/sin I_m [V/m] + + real(r8) :: & + day ! iday+ut + + logical, parameter :: iutav=.false. ! .true. means UT-averaging + ! .false. means no UT-averaging + real(r8), parameter :: & + v_sw = 400._r8 ! solar wind velocity [km/s] + +!------------------------------------------------------------------------------ +! boundary for Weimer +!------------------------------------------------------------------------------ + real(r8), parameter :: bnd_wei = 44._r8 ! colat. [deg] + integer :: nmlat_wei + +!------------------------------------------------------------------------------ +! flag for choosing factors for empirical low latitude model +!------------------------------------------------------------------------------ + integer, parameter :: iseasav = 0 ! flag for season + +!------------------------------------------------------------------------------ +! constants: +!------------------------------------------------------------------------------ + real(r8), parameter :: & + r_e = 6.371e6_r8, & ! radius_earth [m] (same as for apex.F90) + h_r = 130.0e3_r8, & ! reference height [m] (same as for apex.F90) + dy2yr= 365.24_r8, & ! day per avg. year used in Weimer + dy2mo= 30.6001_r8 ! day per avg. month used in Weimer + + real(r8) :: & + rtd , & ! radians -> deg + dtr, & ! deg -> radians + sqr2, & + dy2rd, & ! 2*pi/365.24 average year + deg2mlt, & ! for mlon to deg + sinIm_mag(0:nmlat) ! sinIm + + integer :: jmin, jmax ! latitude index for interpolation of + ! northward e-field ed2 at mag. equator + +!------------------------------------------------------------------------------ +! for spherical harmonics +!------------------------------------------------------------------------------ + integer, parameter :: & + nm = 19, & + mm = 18, & + nmp = nm + 1, & + mmp = mm + 1 + + real(r8) :: r(0:nm,0:mm) ! R_n^m + real(r8) :: pmopmmo(0:mm) ! sqrt(1+1/2m) + +!------------------------------------------------------------------------------ +! index for factors f_m(mlt),f_l(UT),f_-k(d) +!------------------------------------------------------------------------------ + integer, parameter :: ni = 1091 ! for n=12 m=-18:18 + integer :: imax ! max number of index + integer,dimension(0:ni) :: & + kf, & + lf, & + mf, & + nf, & + jf + real(r8) :: ft(1:3,0:2) ! used for f_-k(season,k) + + real(r8) :: a_klnm(0:ni) ! A_klm + real(r8) :: a_lf(0:ni) ! A_klmn^lf for minimum & + real(r8) :: a_hf(0:ni) ! A_klmn^hf for maximum + +!------------------------------------------------------------------------------ +! high_latitude boundary +!------------------------------------------------------------------------------ + real(r8), parameter :: & + ef_max = 0.015_r8, & ! max e-field for high latitude boundary location [V/m] + lat_sft = 54._r8 ! shift of highlat_bnd to 54 deg + integer :: ilat_sft ! index of shift for high latitude boundary + integer, parameter :: nmax_sin = 2 ! max. wave number to be represented + logical, parameter :: debug =.false. + + contains + + subroutine efield_init(efield_lflux_file, efield_hflux_file, efield_wei96_file) +!----------------------------------------------------------------------- +! Purpose: read in and set up coefficients needed for electric field +! calculation (independent of time & geog. location) +! +! Method: +! +! Author: A. Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + character(len=*), intent(in) :: efield_lflux_file + character(len=*), intent(in) :: efield_hflux_file + character(len=*), intent(in) :: efield_wei96_file + + call constants ! calculate constants +!----------------------------------------------------------------------- +! low/midlatitude potential from Scherliess model +!----------------------------------------------------------------------- + call read_acoef (efield_lflux_file, efield_hflux_file) ! read in A_klnm for given S_aM + call index_quiet ! set up index for f_m(mlt),f_l(UT),f_-k(d) + call prep_fk ! set up the constant factors for f_k + call prep_pnm ! set up the constant factors for P_n^m & dP/d phi +!----------------------------------------------------------------------- +! following part should be independent of time & location if IMF constant +!----------------------------------------------------------------------- + call ReadCoef (efield_wei96_file) + + end subroutine efield_init + + subroutine get_efield +!----------------------------------------------------------------------- +! Purpose: calculates the global electric potential field on the +! geomagnetic grid (MLT in deg) and derives the electric field +! +! Method: +! +! Author: A. Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + + use time_manager, only : get_curr_calday, get_curr_date + use mag_parms, only : get_mag_parms + use mo_apex, only : geomag_year + + integer :: tod ! time of day [s] + +!----------------------------------------------------------------------- +! get current calendar day of year & date components +! valid at end of current timestep +!----------------------------------------------------------------------- + iday = get_curr_calday() ! day of year + call get_curr_date (iyear,imo,iday_m,tod) ! year, time of day [sec] + iyear = int(geomag_year) + + if( iyear < 1900 ) then + write(iulog,"(/,'>>> get_efield: year < 1900 not possible: year=',i5)") iyear + call endrun + end if + + ut = tod/3600._r8 ! UT of day [sec] + +!----------------------------------------------------------------------- +! get mag parms +!----------------------------------------------------------------------- + call get_mag_parms( by = by, bz = bz ) + +!----------------------------------------------------------------------- +! ajust S_a +!----------------------------------------------------------------------- + call adj_S_a +!----------------------------------------------------------------------- +! calculate global electric potential +!----------------------------------------------------------------------- + call GlobalElPotential + +!----------------------------------------------------------------------- +! calculate derivative of global electric potential +!----------------------------------------------------------------------- + call DerivPotential + + end subroutine get_efield + + subroutine GlobalElPotential +!----------------------------------------------------------------------- +! Purpose: calculates the global electric potential field on the +! geomagnetic grid (MLT in deg) +! +! Method: rewritten code from Luedger Scherliess (11/20/99 LS) +! routine to calculate the global electric potential in magnetic +! Apex coordinates (Latitude and MLT). +! High Latitude Model is Weimer 1996. +! Midlatitude model is Scherliess 1999. +! Interpolation in a transition region at about 60 degree +! magnetic apex lat +! +! Author: A. Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: ilon, ilat, idlat + integer :: ihlat_bnd(0:nmlon) ! high latitude boundary + integer :: itrans_width(0:nmlon) ! width of transition zone + real(r8) :: mlat, mlat_90, pot + real(r8) :: pot_midlat(0:nmlon,0:nmlat) ! potential from L. Scherliess model + real(r8) :: pot_highlat(0:nmlon,0:nmlat) ! potential from Weimer model + real(r8) :: pot_highlats(0:nmlon,0:nmlat) ! smoothed potential from Weimer model + +!----------------------------------------------------------------------- +! convert to date and day +!----------------------------------------------------------------------- + day = iday + ut/24._r8 + +!----------------------------------------------------------------------- +! low/midlatitude electric potential - empirical model Scherliess 1999 +!----------------------------------------------------------------------- +!$omp parallel do private(ilat, ilon, mlat, pot) + do ilat = 0,nmlath ! Calculate only for one magn. hemisphere + mlat = ylatm(ilat) ! mag. latitude + do ilon = 0,nmlon ! lon. loop + call efield_mid( mlat, ylonm(ilon), pot ) + pot_midlat(ilon,ilat+nmlath) = pot ! SH/NH symmetry + pot_midlat(ilon,nmlath-ilat) = pot + end do + end do + +!----------------------------------------------------------------------- +! hight latitude potential from Weimer model +! at the poles Weimer potential is not longitudinal dependent +!----------------------------------------------------------------------- + call prep_weimer ! calculate IMF angle & magnitude, tilt + +!$omp parallel do private(ilat, ilon, mlat_90, pot) + do ilat = 0,nmlat_wei ! Calculate only for one magn. hemisphere + mlat_90 = 90._r8 - ylatm(ilat) ! mag. latitude + do ilon = 0,nmlon + pot = 1000._r8*EpotVal( mlat_90, ylonm(ilon)*deg2mlt ) ! calculate potential (kv -> v) +!----------------------------------------------------------------------- +! NH/SH symmetry +!----------------------------------------------------------------------- + pot_highlat(ilon,ilat) = pot + pot_highlat(ilon,nmlat-ilat) = pot + pot_highlats(ilon,ilat) = pot + pot_highlats(ilon,nmlat-ilat) = pot + end do + end do + +!----------------------------------------------------------------------- +! weighted smoothing of high latitude potential +!----------------------------------------------------------------------- + idlat = 2 ! smooth over -2:2 = 5 grid points + call pot_latsmo( pot_highlats, idlat ) +!----------------------------------------------------------------------- +! calculate the height latitude bounday ihl_bnd +! 1. calculate E field from weimar model +! boundary is set where the total electric field exceeds +! 0.015 V/m (corresp. approx. to 300 m/s) +! 2. moved halfways to 54 deg +! output : index 0-pole nmlath-equator +!----------------------------------------------------------------------- + call highlat_getbnd( ihlat_bnd ) +!----------------------------------------------------------------------- +! 3. adjust high latitude boundary sinusoidally +! calculate width of transition zone +!----------------------------------------------------------------------- + call bnd_sinus( ihlat_bnd, itrans_width ) +!----------------------------------------------------------------------- +! 4. ajust high latitude potential to low latitude potential +!----------------------------------------------------------------------- + call highlat_adjust( pot_highlats, pot_highlat, pot_midlat, ihlat_bnd ) +!----------------------------------------------------------------------- +! interpolation of high and low/midlatitude potential in the +! transition zone and put it into global potent array +!----------------------------------------------------------------------- + call interp_poten( pot_highlats, pot_highlat, pot_midlat, ihlat_bnd, itrans_width) +!----------------------------------------------------------------------- +! potential weighted smoothing in latitude +!----------------------------------------------------------------------- + idlat = 2 ! smooth over -2:2 = 5 grid points + call pot_latsmo2( potent, idlat ) +!----------------------------------------------------------------------- +! potential smoothing in longitude +!----------------------------------------------------------------------- + idlat = nmlon/48 ! smooth over -idlat:idlat grid points + call pot_lonsmo( potent, idlat ) + +!----------------------------------------------------------------------- +! output +!----------------------------------------------------------------------- +! output ( change later to netcdf file) +! do ilat=0,nmlat +! do ilon=0,nmlon +! write(iulog,'(4(x,f12.5))') ylatm(ilat),ylonm(ilon), & +! potent(ilon,ilat),potent(ilon,nmlat-ilat) +! write(iulog,'(4(x,f12.5))') ylatm(ilat),ylonm(ilon), & +! potent(ilon,ilat),potent(ilon,nmlat-ilat) +! write(iulog,'(f10.3)') potent(ilon,ilat) +! end do +! end do + + end subroutine GlobalElPotential + + subroutine ff( ph, mt, f ) +!----------------------------------------------------------------------- +! Purpose: calculate F for normalized associated Legendre polynomial P_n^m +! Ref.: Richmond J.Atm.Ter.Phys. 1974 +! +! Method: f_m(phi) = sqrt(2) sin(m phi) m > 0 +! = 1 m = 0 +! = sqrt(2) cos(m phi) m < 0 +! +! Author: A. Maute Nov 2003 am 11/18/03 +!----------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! dummy arguments +!----------------------------------------------------------------------- + integer,intent(in) :: mt + real(r8),intent(in) :: ph ! geo. longitude of 0SLT (ut*15) + real(r8),intent(out) :: f(-mt:mt) + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: m, mmo + real(r8) :: sp, cp + + sp = sin( ph/rtd ) + cp = cos( ph/rtd ) + f(0) = 1.e0_r8 + + f(-1) = sqr2*cp + f(1) = sqr2*sp + do m = 2,mt + mmo = m - 1 + f(m) = f(-mmo)*sp + cp*f(mmo) + f(-m) = f(-mmo)*cp - sp*f(mmo) + end do + + end subroutine ff + + subroutine pnm( ct, p ) +!---------------------------------------------------------------------------- +! Purpose: normalized associated Legendre polynomial P_n^m +! Ref.: Richmond J.Atm.Ter.Phys. 1974 +! Method: +! P_m^m = sqrt(1+1/2m)*si*P_m-1^m-1 m>0 +! P_n^m = [cos*P_n-1^m - R_n-1^m*P_n-2^m ]/R_n^m n>m>=0 +! dP/d phi = n*cos*P_n^m/sin-(2*n+1)*R_n^m*P_n-1^m/sin n>=m>=0 +! R_n^m = sqrt[ (n^2-m^2)/(4n^2-1) ] +! +! Author: A. Maute Nov 2003 am 11/18/03 +!---------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! dummy arguments +!----------------------------------------------------------------------- + real(r8), intent(inout) :: ct ! cos(colat) + real(r8), intent(inout) :: p(0:nm,0:mm) + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: mp, m, n + real(r8) :: pm2, st + +! ct = min( ct,.99_r8 ) ! cos(colat) + st = sqrt( 1._r8 - ct*ct ) ! sin(colat) + + p(0,0) = 1._r8 + do mp = 1,mmp ! m+1=1,mm+1 + m = mp - 1 + if( m >= 1 ) then + p(m,m) = pmopmmo(m)*p(m-1,m-1)*st + end if + pm2 = 0._r8 + do n = mp,nm ! n=m+1,N + p(n,m) = (ct*p(n-1,m) - r(n-1,m)*pm2)/r(n,m) + pm2 = p(n-1,m) + end do + end do + + end subroutine pnm + + subroutine prep_pnm +!---------------------------------------------------------------------------- +! Purpose: constant factors for normalized associated Legendre polynomial P_n^m +! Ref.: Richmond J.Atm.Ter.Phys. 1974 +! +! Method: +! PmoPmmo(m) = sqrt(1+1/2m) +! R_n^m = sqrt[ (n^2-m^2)/(4n^2-1) ] +! +! Author: A. Maute Nov 2003 am 11/18/03 +!---------------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: mp, m, n + real(r8) :: xms, xns, den + + do mp = 1, mmp ! m+1 = 1,mm+1 + m = mp - 1 + xms = m*m + if( mp /= 1 ) then + pmopmmo(m) = sqrt( 1._r8 + .5_r8/M ) + end if + do n = m,nm ! n = m,N + xns = n*n + den = max(4._r8*xns - 1._r8,1._r8) + r(n,m) = sqrt( (xns - xms)/den ) + end do + end do + + end subroutine prep_pnm + + subroutine index_quiet +!---------------------------------------------------------------------------- +! Purpose: set up index for factors f_m(mlt),f_l(UT),f_-k(d) to +! describe the electric potential Phi for the empirical model +! +! Method: +! Phi = sum_k sum_l sum_m sum_n [ A_klmn * P_n^m *f_m(mlt)*f_l(UT)*f_-k(d)] +! - since the electric potential is symmetric about the equator +! n+m odd terms are set zero resp. not used +! - in the summation for calculation Phi the index have the following +! range n=1,12 and m=-n,n, k=0,2 l=-2,2 +! +! Author: A. Maute Nov 2003 am 11/18/03 +!---------------------------------------------------------------------------- + + implicit none + +!---------------------------------------------------------------------------- +! ... local variables +!---------------------------------------------------------------------------- + integer :: i, j, k, l, n, m + + i = 0 ! initialize + j = 1 + do k = 2,0,-1 + do l = -2,2 + if( k == 2 .and. abs(l) == 2 ) then + cycle + end if + do n = 1,12 + do m = -18,18 + if( abs(m) <= n ) then ! |m| < n + if( (((n-m)/2)*2) == (n-m) ) then ! only n+m even + if( n-abs(m) <= 9 ) then ! n-|m| <= 9 why? + kf(i) = 2-k + lf(i) = l + nf(i) = n + mf(i) = m + jf(i) = j + i = i + 1 ! counter + end if + end if + end if + end do ! m + end do ! n + end do ! l + end do ! k + + imax = i - 1 + if(imax /= ni ) then ! check if imax == ni + write(iulog,'(a19,i5,a18,i5)') 'index_quiet: imax= ',imax, & + ' not equal to ni =',ni + call endrun('index_quiet ERROR') + end if + if(debug) write(iulog,*) 'imax=',imax + + end subroutine index_quiet + + subroutine read_acoef (efield_lflux_file, efield_hflux_file) +!---------------------------------------------------------------------------- +! Purpose: +! 1. read in coefficients A_klmn^lf for solar cycle minimum and +! A_klmn^hf for maximum +! 2. adjust S_a (f107d) such that if S_a<80 or S_a > 220 it has reasonable numbers +! S_aM = [atan{(S_a-65)^2/90^2}-a90]/[a180-a90] +! a90 = atan [(90-65)/90]^2 +! a180 = atan [(180-65)/90]^2 +! 3. inter/extrapolation of the coefficient to the actual flux which is +! given by the user +! A_klmn = S_aM [A_klmn^hf-A_klmn^lf]/90. + 2*A_klmn^lf-A_klmn^hf +! +! Method: +! +! Author: A. Maute Nov 2003 am 11/19/03 +!---------------------------------------------------------------------------- + + use ioFileMod, only : getfil + use units, only : getunit, freeunit + + character(len=*), intent(in) :: efield_lflux_file + character(len=*), intent(in) :: efield_hflux_file + + integer :: ios,unit + character (len=256):: locfn + +!---------------------------------------------------------------------------- +! get coefficients file for solar minimum: +!---------------------------------------------------------------------------- + unit = getunit() + call getfil( efield_lflux_file, locfn, 0 ) + +!---------------------------------------------------------------------------- +! open datafile with coefficients A_klnm +!---------------------------------------------------------------------------- + if (debug) write(iulog,*) 'read_acoef: open file ',trim(locfn),' unit ',unit + open(unit=unit,file=trim(locfn), & + status = 'old',iostat = ios) + if(ios.gt.0) then + write(iulog,*) 'read_acoef: error in opening coeff_lf file',' unit ',unit + call endrun + end if + +!---------------------------------------------------------------------------- +! read datafile with coefficients A_klnm +!---------------------------------------------------------------------------- + if (debug) write(iulog,*) 'read_acoef: read file ',trim(locfn),' unit ',unit + read(unit,*,iostat = ios) a_lf + if(ios.gt.0) then + write(iulog,*) 'read_acoef: error in reading coeff_lf file',' unit ',unit + call endrun + end if + +!---------------------------------------------------------------------------- +! close & free unit +!---------------------------------------------------------------------------- + close(unit) + call freeunit(unit) + if (debug) write(iulog,*) 'read_acoef: free unit ',unit + +!---------------------------------------------------------------------------- +! get coefficients file for solar maximum: +!---------------------------------------------------------------------------- + unit = getunit() + call getfil( efield_hflux_file, locfn, 0 ) + +!---------------------------------------------------------------------------- +! open datafile with coefficients A_klnm +!---------------------------------------------------------------------------- + if (debug) write(iulog,*) 'read_acoef: open file ',trim(locfn),' unit ',unit + open(unit=unit,file=trim(locfn), & + status = 'old',iostat = ios) + if(ios.gt.0) then + write(iulog,*) 'read_acoef: error in opening coeff_hf file',' unit ',unit + call endrun + end if + +!---------------------------------------------------------------------------- +! read datafile with coefficients A_klnm +!---------------------------------------------------------------------------- + if (debug) write(iulog,*) 'read_acoef: read file ',trim(locfn) + read(unit,*,iostat = ios) a_hf + if(ios.gt.0) then + write(iulog,*) 'read_acoef: error in reading coeff_hf file',' unit ',unit + call endrun + end if + +!---------------------------------------------------------------------------- +! close & free unit +!---------------------------------------------------------------------------- + close(unit) + call freeunit(unit) + if (debug) write(iulog,*) 'read_acoef: free unit ',unit + + end subroutine read_acoef + + subroutine adj_S_a +!---------------------------------------------------------------------------- +! adjust S_a -> S_aM eqn.8-11 Scherliess draft +!---------------------------------------------------------------------------- + + implicit none + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: i + real(r8) :: x2, y2, a90, a180, S_aM + + x2 = 90._r8*90._r8 + y2 = (90._r8 - 65._r8) + y2 = y2*y2 + a90 = atan2(y2,x2) + y2 = (180._r8 - 65._r8) + y2 = y2*y2 + a180 = atan2(y2,x2) +! y2 = (S_a-65._r8) + y2 = (f107d - 65._r8) + y2 = y2*y2 + S_aM = (atan2(y2,x2) - a90)/(a180 - a90) + S_aM = 90._r8*(1._r8 + S_aM) + if(debug) write(iulog,*) 'f107d=',f107d,' S_aM =',S_aM + if(debug) write(iulog,*) 'By=',by + +!---------------------------------------------------------------------------- +! inter/extrapolate to S_a (f107d) +!---------------------------------------------------------------------------- + do i = 0,ni ! eqn.8 Scherliess draft + a_klnm(i) = S_aM*(a_hf(i) - a_lf(i))/90._r8 + 2._r8*a_lf(i) - a_hf(i) +! for testing like in original code +! a_klnm(i)=S_a*(a_hf(i)-a_lf(i))/90.+2.*a_lf(i)-a_hf(i) +! a_klnm(i)=f107d*(a_hf(i)-a_lf(i))/90.+2.*a_lf(i)-a_hf(i) + end do + + end subroutine adj_S_a + + subroutine constants +!---------------------------------------------------------------------------- +! Purpose: set up constant values (e.g. magnetic grid, convertion +! constants etc) +! +! Method: +! +! Author: A. Maute Nov 2003 am 11/19/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: i,j + real(r8) :: fac,lat + + rtd = 180._r8/pi ! radians -> deg + dtr = pi/180._r8 ! deg -> radians + sqr2 = sqrt(2.e0_r8) + dy2rd = 2._r8*pi/dy2yr ! 2*pi/365.24 average year + deg2mlt = 24._r8/360._r8 ! convert degrees to MLT hours + +!---------------------------------------------------------------------------- +! Set grid deltas: +!---------------------------------------------------------------------------- + dlatm = 180._r8/nmlat + dlonm = 360._r8/nmlon + +!---------------------------------------------------------------------------- +! Set magnetic latitude array +!---------------------------------------------------------------------------- + do j = 0,nmlat + ylatm(j) = j*dlatm + lat = (ylatm(j) - 90._r8)*dtr + fac = cos(lat) ! sinIm = 2*sin(lam_m)/sqrt[4-3*cos^2(lam_m)] + fac = 4._r8 - 3._r8*fac*fac + fac = 2._r8/sqrt( fac ) + sinIm_mag(j) = fac*sin( lat ) + end do + +!---------------------------------------------------------------------------- +! Set magnetic longitude array +!---------------------------------------------------------------------------- + do i = 0,nmlon + ylonm(i) = i*dlonm + end do ! i=1,nmlonp1 + +!---------------------------------------------------------------------------- +! find boundary index for weimer +!---------------------------------------------------------------------------- + do j = 0,nmlat + nmlat_wei = j + if( bnd_wei <= ylatm(j) ) then + exit + end if + end do + +!---------------------------------------------------------------------------- +! find latitudinal shift +!---------------------------------------------------------------------------- + do j = 0,nmlat + ilat_sft = j + if( lat_sft <= ylatm(j) ) then + exit + end if + end do + +!---------------------------------------------------------------------------- +! find index for linear interpolation of ed2 at mag.equator +! use 12 deg - same as in TIEGCM +!---------------------------------------------------------------------------- + do j = 0,nmlat + lat = ylatm(j) - 90._r8 + if( lat <= -12._r8 ) then + jmin = j + else if( lat > 12._r8 ) then + jmax = j + exit + end if + end do + + end subroutine constants + + subroutine prep_fk +!---------------------------------------------------------------------------- +! Purpose: set up constants factors for f_-k(day) used for empirical model +! to calculate the electric potential +! +! Method: +! +! Author: A. Maute Nov 2003 am 11/19/03 +!---------------------------------------------------------------------------- + + ft(1,0) = .75_r8*sqrt( 6.e0_r8 )/pi + ft(1,1) = 2.e0_r8*ft(1,0) + ft(1,2) = 1.e0_r8 + ft(2,0) = ft(1,0) + ft(2,1) = -ft(1,1) + ft(2,2) = 1.e0_r8 + ft(3,0) = ft(2,1) + ft(3,1) = 0._r8 + ft(3,2) = 1.e0_r8 + + end subroutine prep_fk + + subroutine set_fkflfs( fk, fl, fs ) +!---------------------------------------------------------------------------- +! Purpose: set f_-k(day) depending on seasonal flag used for empirical model +! to calculate the electric potential +! +! Method: +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + real(r8), intent(out) :: & + fk(0:2), & ! f_-k(day) + fl(-2:2), & ! f_l(ut) + fs(2) ! f_s(f10.7) +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: lp + real(r8) :: ang + real(r8) :: lon_ut + +!---------------------------------------------------------------------------- +! f_-k(day) +! use factors for iseasav == 0 - Scherliess had iseasav as an input parameter +!---------------------------------------------------------------------------- + lp = iseasav + if( iseasav == 0 ) then + ang = (day + 9._r8)*dy2rd + fk(0) = sqr2*cos( 2._r8*ang ) + fk(1) = sqr2*cos( ang ) + fk(2) = 1._r8 + else if( iseasav >= 1 .and. iseasav <= 3 ) then + fk(0) = ft(lp,0) + fk(1) = ft(lp,1) + fk(2) = ft(lp,2) + else if( iseasav == 4 ) then + fk(0) =0._r8 + fk(1) =0._r8 + fk(2) =1._r8 + end if + +!---------------------------------------------------------------------------- +! f_l(ut) +!---------------------------------------------------------------------------- + lon_ut = 15._r8*ut ! 15.*mlt - xmlon + 69. + call ff( lon_ut, 2, fl ) + if( iutav ) then ! UT-averaging + + ang = fl(0) + fl(:) = 0._r8 + fl(0) = ang + + end if + +!---------------------------------------------------------------------------- +! f_s(f10.7) only fs(1) used +!---------------------------------------------------------------------------- + fs(1) = 1._r8 +! fs(2) = S_a + fs(2) = f107d + + end subroutine set_fkflfs + + subroutine efield_mid( mlat, mlon, pot ) +!---------------------------------------------------------------------------- +! Purpose: calculate the electric potential for low and +! midlatitudes from an empirical model (Scherliess 1999) +! +! Method: +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + real(r8), intent(in) :: mlat, mlon + real(r8), intent(out) :: pot ! electric potential (V) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: i, mp, np, nn + real(r8) :: mod_mlat, ct, x + real(r8) :: fk(0:2) ! f_-k(day) + real(r8) :: fl(-2:2) ! f_l(ut) + real(r8) :: fs(2) ! f_s(f10.7) + real(r8) :: f(-18:18) + real(r8) :: p(0:nm,0:mm) ! P_n^m spherical harmonics + + pot = 0._r8 ! initialize + + mod_mlat = mlat + if( abs(mlat) <= 0.5_r8 ) then + mod_mlat = 0.5_r8 ! avoid geomag.equator + end if + +!---------------------------------------------------------------------------- +! set f_-k, f_l, f_s depending on seasonal flag +!---------------------------------------------------------------------------- + call set_fkflfs( fk, fl, fs ) + +!---------------------------------------------------------------------------- +! spherical harmonics +!---------------------------------------------------------------------------- + ct = cos( (90._r8 - mod_mlat)*dtr ) ! magnetic colatitude + call pnm( ct, p ) ! calculate P_n^m + call ff( mlon, 18, f ) ! calculate f_m (phi) why 18 if N=12 + + do i = 0,imax + mp = mf(i) + np = nf(i) + nn = abs(mp) ! P_n^m = P_n^-m + x = a_klnm(i)* fl(lf(i)) * fk(kf(i)) * fs(jf(i)) + pot = pot + x*f(mp)*p(np,nn) + end do + + end subroutine efield_mid + + subroutine prep_weimer +!---------------------------------------------------------------------------- +! Purpose: for Weimer model calculate IMF angle, IMF magnitude +! tilt of earth +! +! Method: using functions and subroutines from Weimer Model 1996 +! output: angle, & ! IMF angle +! bt, & ! IMF magnitude +! tilt ! tilt of earth +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + real(r8) :: & + angle, & ! IMF angle + bt, & ! IMF magnitude + tilt ! tilt of earth + + if( by == 0._r8 .and. bz == 0._r8) then + angle = 0._r8 + else + angle = atan2( by,bz ) + end if + + angle = angle*rtd + call adjust( angle ) + bt = sqrt( by*by + bz*bz ) +!---------------------------------------------------------------------------- +! use month and day of month - calculated with average no.of days per month +! as in Weimer +!---------------------------------------------------------------------------- + if(debug) write(iulog,*) 'prep_weimer: day->day of month',iday,imo,iday_m,ut + tilt = get_tilt( iyear, imo, iday_m, ut ) + + if(debug) then + write(iulog,"(/,'efield prep_weimer:')") + write(iulog,*) ' Bz =',bz + write(iulog,*) ' By =',by + write(iulog,*) ' Bt =',bt + write(iulog,*) ' angle=',angle + write(iulog,*) ' VSW =',v_sw + write(iulog,*) ' tilt =',tilt + end if + + call SetModel( angle, bt, tilt, v_sw ) + + end subroutine prep_weimer + + subroutine pot_latsmo( pot, idlat ) ! pots == pot_highlats +!---------------------------------------------------------------------------- +! Purpose: smoothing in latitude of potential +! +! Method: weighted smoothing in latitude +! assume regular grid spacing +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(in) :: idlat + real(r8), intent(inout) :: pot(0:nmlon,0:nmlat) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: ilat, id + real(r8) :: wgt, del + real(r8) :: w(-idlat:idlat) +! real(r8) :: pot_smo(0:nmlat) ! temp array for smooth. potential + real(r8) :: pot_smo(0:nmlon,0:nmlat_wei) ! temp array for smooth. potential + +!---------------------------------------------------------------------------- +! weighting factors (regular grid spacing) +!---------------------------------------------------------------------------- + wgt = 0._r8 + do id = -idlat,idlat + del = abs(id)*dlatm ! delta lat_m + w(id) = 1._r8/(del + 1._r8) + wgt = wgt + w(id) + end do + wgt = 1._r8/wgt + +! do ilon = 0,nmlon +! do ilat = idlat,nmlat_wei-idlat +! do ilat = idlat,nmlat-idlat +! pot_smo(ilat) = 0._r8 +! do id = -idlat,idlat ! org. was degree now grid points +! pot_smo(ilat) = pot_smo(ilat) + w(id)*pot(ilon,ilat+id) +! write(iulog,"('pot_latsmo: ilon=',i3,' ilat=',i3,' id=',i3,' pot(ilon,ilat+id)=',e12.4)") ilon,ilat,id,pot(ilon,ilat+id) +! end do +! pot_smo(ilat) = pot_smo(ilat)*wgt +! pot_smo(nmlat-ilat) = pot_smo(ilat) +! end do +! pot(ilon,idlat:nmlat-idlat) = & ! copy back into pot +! pot_smo(idlat:nmlat-idlat) +! pot(ilon,idlat:nmlat_wei-idlat) = pot_smo(idlat:nmlat_wei-idlat) +! pot(ilon,nmlat-nmlat_wei+idlat:nmlat) = pot_smo(nmlat-nmlat_wei+idlat:nmlat) +! pot(ilon,nmlat-nmlat_wei+idlat:nmlat-idlat) = pot_smo(nmlat-nmlat_wei+idlat:nmlat-idlat) +! end do + +!$omp parallel do private(ilat) + do ilat = idlat,nmlat_wei-idlat + pot_smo(:,ilat) = matmul( pot(:,ilat-idlat:ilat+idlat),w )*wgt + end do + + do ilat = idlat,nmlat_wei-idlat + pot(:,ilat) = pot_smo(:,ilat) + pot(:,nmlat-ilat) = pot_smo(:,ilat) + end do + + end subroutine pot_latsmo + + subroutine pot_latsmo2( pot, idlat ) +!---------------------------------------------------------------------------- +! Purpose: smoothing in latitude of potential +! +! Method: weighted smoothing in latitude +! assume regular grid spacing +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(in) :: idlat + real(r8), intent(inout) :: pot(0:nmlon,0:nmlat) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: ilat, id + real(r8) :: wgt, del + real(r8) :: w(-idlat:idlat) +! real(r8) :: pot_smo(0:nmlat) ! temp array for smooth. potential + real(r8) :: pot_smo(0:nmlon,0:nmlath) ! temp array for smooth. potential + +!---------------------------------------------------------------------------- +! weighting factors (regular grid spacing) +!---------------------------------------------------------------------------- + wgt = 0._r8 + do id = -idlat,idlat + del = abs(id)*dlatm ! delta lat_m + w(id) = 1._r8/(del + 1._r8) + wgt = wgt + w(id) + end do + wgt = 1._r8/wgt + +! do ilon = 0,nmlon +! do ilat = idlat,nmlath-idlat ! ilat = 5:175 +! pot_smo(ilat) = 0._r8 +! do id = -idlat,idlat ! org. was degree now grid points +! pot_smo(ilat) = pot_smo(ilat) + w(id)*pot(ilon,ilat+id) +! end do +! pot_smo(ilat) = pot_smo(ilat)*wgt +! end do +! pot(ilon,idlat:nmlath-idlat) = pot_smo(idlat:nmlath-idlat) ! copy back into pot +! end do + +!$omp parallel do private(ilat) + do ilat = idlat,nmlath-idlat + pot_smo(:,ilat) = matmul( pot(:,ilat-idlat:ilat+idlat),w )*wgt + end do + + do ilat = idlat,nmlath-idlat + pot(:,ilat) = pot_smo(:,ilat) + end do + + end subroutine pot_latsmo2 + + subroutine pot_lonsmo( pot, idlon ) +!---------------------------------------------------------------------------- +! Purpose: smoothing in longitude of potential +! +! Method: weighted smoothing in longitude +! assume regular grid spacing +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(in) :: idlon + real(r8), intent(inout) :: pot(0:nmlon,0:nmlat) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: ilon, ilat, id + real(r8) :: wgt, del + real(r8) :: w(-idlon:idlon) + real(r8) :: tmp(-idlon:nmlon+idlon) ! temp array for smooth. potential + +!---------------------------------------------------------------------------- +! weighting factors (regular grid spacing) +!---------------------------------------------------------------------------- + wgt = 0._r8 + do id = -idlon,idlon + del = abs(id)*dlonm ! delta lon_m + w(id) = 1._r8/(del + 1._r8) + wgt = wgt + w(id) + end do + wgt = 1._r8/wgt + +!---------------------------------------------------------------------------- +! averaging +!---------------------------------------------------------------------------- +! do ilon = 0,nmlon +! do ilat = 0,nmlath +! pot_smo(ilat) = 0._r8 +! do id = -idlon,idlon ! org. was degree now grid points +! iabs = ilon + id +! if( iabs > nmlon ) then +! iabs = iabs - nmlon ! test if wrap around +! end if +! if( iabs < 0 ) then +! iabs = iabs + nmlon ! test if wrap around +! end if +! pot_smo(ilat) = pot_smo(ilat) + w(id)*pot(iabs,ilat) +! end do +! pot_smo(ilat) = pot_smo(ilat)*wgt +! pot(ilon,ilat) = pot_smo(ilat) ! copy back into pot +! pot(ilon,nmlat-ilat) = pot_smo(ilat) ! copy back into pot +! end do +! end do + +!$omp parallel do private(ilat,ilon,tmp) + do ilat = 0,nmlath + tmp(0:nmlon) = pot(0:nmlon,ilat) + tmp(-idlon:-1) = pot(nmlon-idlon:nmlon-1,ilat) + tmp(nmlon+1:nmlon+idlon) = pot(1:idlon,ilat) + do ilon = 0,nmlon + pot(ilon,ilat) = dot_product( tmp(ilon-idlon:ilon+idlon),w )*wgt + pot(ilon,nmlat-ilat) = pot(ilon,ilat) + end do + end do + + end subroutine pot_lonsmo + + subroutine highlat_getbnd( ihlat_bnd ) +!---------------------------------------------------------------------------- +! Purpose: calculate the height latitude bounday index ihl_bnd +! +! Method: +! 1. calculate E field from weimar model +! boundary is set where the total electric field exceeds +! 0.015 V/m (corresp. approx. to 300 m/s) +! 2. moved halfways to 54 deg not necessarily equatorwards as in the +! original comment from L. Scherliess- or? +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(out) :: ihlat_bnd(0:nmlon) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer :: ilon, ilat, ilat_sft_rvs + real(r8) :: mlat, mlt, es, ez, e_tot + + ilat_sft_rvs = nmlath - ilat_sft ! pole =0, equ=90 +!$omp parallel do private(ilat,ilon,mlt,mlat,es,ez,e_tot) + do ilon = 0,nmlon ! long. + ihlat_bnd(ilon) = 0 + mlt = ylonm(ilon)*deg2mlt ! mag.local time ? + do ilat = nmlat_wei+1,0,-1 ! lat. loop moving torwards pole + mlat = 90._r8 - ylatm(ilat) ! mag. latitude pole = 90 equator = 0 + call gecmp( mlat, mlt, es, ez ) ! get electric field + e_tot = sqrt( es**2 + ez**2 ) + if( abs(e_tot) >= ef_max ) then ! e-filed > limit -> boundary + ihlat_bnd(ilon) = ilat - (ilat - ilat_sft_rvs)/2 ! shift boundary to lat_sft (54deg) + exit + end if + end do + end do + +! write(iulog,"('highlat_getbnd: ihlat_bnd=',/,(12i6))") ihlat_bnd + + end subroutine highlat_getbnd + + subroutine bnd_sinus( ihlat_bnd, itrans_width ) +!---------------------------------------------------------------------------- +! Purpose: +! 1. adjust high latitude boundary (ihlat_bnd) sinusoidally +! 2. width of transition zone from midlatitude potential to high latitude +! potential (itrans_width) +! +! Method: +! 1.adjust boundary sinusoidally +! max. wave number to be represented nmax_sin +! RHS(mi) = Sum_phi Sum_(mi=-nmax_sin)^_(mi=nmax_sin) f_mi(phi)*hlat_bnd(phi) +! U(mi,mk) = Sum_phi Sum_(mi=-nmax_sin)^_(mi=nmax_sin) f_mi(phi) * +! Sum_(mk=-nmax_sin)^_(mk=nmax_sin) f_mk(phi) +! single values decomposition of U +! solving U*LSG = RHS +! calculating hlat_bnd: +! hlat_bnd = Sum_(mi=-nmax_sin)^_(mi=nmax_sin) f_mi(phi)*LSG(mi) +! +! 2. width of transition zone from midlatitude potential to high latitude +! potential +! trans_width(phi)=8.-2.*cos(phi) +! +! Author: A. Maute Nov 2003 am 11/20/03 +!---------------------------------------------------------------------------- + + use sv_decomp, only : svdcmp, svbksb + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(inout) :: ihlat_bnd(0:nmlon) ! loaction of boundary + integer, intent(out) :: itrans_width(0:nmlon) ! width of transition zone + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + integer, parameter :: nmax_a = 2*nmax_sin+1 ! absolute array length + integer, parameter :: ishf = nmax_sin+1 + integer :: ilon, i, i1, j, bnd + real(r8) :: sum + real(r8) :: rhs(nmax_a) + real(r8) :: lsg(nmax_a) + real(r8) :: u(nmax_a,nmax_a) + real(r8) :: v(nmax_a,nmax_a) + real(r8) :: w(nmax_a,nmax_a) + real(r8) :: f(-nmax_sin:nmax_sin,0:nmlon) + +!---------------------------------------------------------------------------- +! Sinusoidal Boundary calculation +!---------------------------------------------------------------------------- + rhs(:) = 0._r8 + lsg(:) = 0._r8 + u(:,:) = 0._r8 + v(:,:) = 0._r8 + w(:,:) = 0._r8 + + do ilon = 0,nmlon ! long. + bnd = nmlath - ihlat_bnd(ilon) ! switch from pole=0 to pole =90 + call ff( ylonm(ilon), nmax_sin, f(-nmax_sin,ilon) ) + do i = -nmax_sin,nmax_sin + i1 = i + ishf + rhs(i1) = rhs(i1) + f(i,ilon) * bnd +! write(iulog,*) 'rhs ',ilon,i1,bnd,f(i,ilon),rhs(i+ishf) + do j = -nmax_sin,nmax_sin + u(i1,j+ishf) = u(i1,j+ishf) + f(i,ilon)*f(j,ilon) +! write(iulog,*) 'u ',ilon,i1,j+ishf,u(i+ishf,j+ishf) + end do + end do + end do + +! if (debug) write(iulog,*) ' Single Value Decomposition' + call svdcmp( u, nmax_a, nmax_a, nmax_a, nmax_a, w, v ) + +! if (debug) write(iulog,*) ' Solving' + call svbksb( u, w, v, nmax_a, nmax_a, nmax_a, nmax_a, rhs, lsg ) +! + do ilon = 0,nmlon ! long. +! sum = 0._r8 + sum = dot_product( lsg(-nmax_sin+ishf:nmax_sin+ishf),f(-nmax_sin:nmax_sin,ilon) ) +! do i = -nmax_sin,nmax_sin +! sum = sum + lsg(i+ishf)*f(i,ilon) +! end do + ihlat_bnd(ilon) = nmlath - int( sum + .5_r8 ) ! closest point + itrans_width(ilon) = int( 8._r8 - 2._r8*cos( ylonm(ilon)*dtr ) + .5_r8 )/dlatm ! 6 to 10 deg. + end do +! write(iulog,"('bnd_sinus: ihlat_bnd=',/,(12i6))") ihlat_bnd +! write(iulog,"('bnd_sinus: itrans_width=',/,(12i6))") itrans_width + + end subroutine bnd_sinus + + subroutine highlat_adjust( pot_highlats, pot_highlat, pot_midlat, ihlat_bnd ) +!---------------------------------------------------------------------------- +! Purpose: Adjust mid/low latitude electric potential and high latitude +! potential such that there are continous across the mid to high +! latitude boundary +! +! Method: +! 1. integrate Phi_low/mid(phi,bnd) along the boundary mid to high latitude +! 2. integrate Phi_high(phi,bnd) along the boundary mid to high latitude +! 3. adjust Phi_high by delta = +! Int_phi Phi_high(phi,bnd) d phi/360. - Int_phi Phi_low/mid(phi,bnd) d phi/360. +! +! Author: A. Maute Nov 2003 am 11/21/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(in) :: ihlat_bnd(0:nmlon) ! boundary mid to high latitude + real(r8), intent(in) :: pot_midlat(0:nmlon,0:nmlat) ! low/mid latitude potentail + real(r8), intent(inout) :: pot_highlat(0:nmlon,0:nmlat) ! high_lat potential + real(r8), intent(inout) :: pot_highlats(0:nmlon,0:nmlat) ! high_lat potential! smoothed high_lat potential + +!---------------------------------------------------------------------------- +! local: +!---------------------------------------------------------------------------- + integer :: ilon, ilat, ilatS, ibnd60, ibnd_hl + real(r8) :: pot60, pot_hl, del + +!---------------------------------------------------------------------------- +! 1. integrate Phi_low/mid(phi,bnd) along the boundary mid to high latitude +! 2. integrate Phi_high(phi,bnd) along the boundary mid to high latitude +!---------------------------------------------------------------------------- + pot60 = 0._r8 + pot_hl = 0._r8 + do ilon = 1,nmlon ! long. ! bnd -> eq to pole 0:90 + ibnd60 = nmlat - ihlat_bnd(ilon) ! 0:180 pole to pole + ibnd_hl = ihlat_bnd(ilon) ! colatitude + pot60 = pot60 + pot_midlat(ilon,ibnd60) + pot_hl = pot_hl + pot_highlats(ilon,ibnd_hl) + end do + pot60 = pot60/(nmlon) + pot_hl = pot_hl/(nmlon) + + if (debug) write(iulog,*) 'Mid-Latitude Boundary Potential =',pot60 + if (debug) write(iulog,*) 'High-Latitude Boundary Potential=',pot_hl + +!---------------------------------------------------------------------------- +! 3. adjust Phi_high by delta = +! Int_phi Phi_high(phi,bnd) d phi/360. - Int_phi Phi_low/mid(phi,bnd) d phi/360. +!---------------------------------------------------------------------------- + del = pot_hl - pot60 + +!$omp parallel do private(ilat,ilon,ilats) + do ilat = 0,nmlat_wei ! colatitude + ilats = nmlat - ilat + do ilon = 0,nmlon + pot_highlat(ilon,ilat) = pot_highlat(ilon,ilat) - del + pot_highlat(ilon,ilats) = pot_highlat(ilon,ilats) - del + pot_highlats(ilon,ilat) = pot_highlats(ilon,ilat) - del + pot_highlats(ilon,ilats) = pot_highlats(ilon,ilats) - del + end do + end do + + end subroutine highlat_adjust + + subroutine interp_poten( pot_highlats, pot_highlat, pot_midlat, & + ihlat_bnd, itrans_width ) +!---------------------------------------------------------------------------- +! Purpose: construct a smooth global electric potential field +! +! Method: construct one global potential field +! 1. low/mid latitude: |lam| < bnd-trans_width +! Phi(phi,lam) = Phi_low(phi,lam) +! 2. high latitude: |lam| > bnd+trans_width +! Phi(phi,lam) = Phi_hl(phi,lam) +! 3. transition zone: bnd-trans_width <= lam <= bnd+trans_width +! a. interpolate between high and low/midlatitude potential +! Phi*(phi,lam) = 1/15*[ 5/(2*trans_width) * {Phi_low(phi,bnd-trans_width)* +! [-lam+bnd+trans_width] + Phi_hl(phi,bnd+trans_width)* +! [lam-bnd+trans_width]} + 10/(2*trans_width) {Phi_low(phi,lam)* +! [-lam+bnd+trans_width] + Phi_hl(phi,lam)* +! [lam-bnd+trans_width]}] +! b. Interpolate between just calculated Potential and the high latitude +! potential in a 3 degree zone poleward of the boundary: +! bnd+trans_width < lam <= bnd+trans_width+ 3 deg +! Phi(phi,lam) = 1/3 { [3-(lam-bnd-trans_width)]* Phi*(phi,lam) + +! [lam-bnd-trans_width)]* Phi_hl*(phi,lam) } +! +! Author: A. Maute Nov 2003 am 11/21/03 +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +! ... dummy arguments +!---------------------------------------------------------------------------- + integer, intent(in) :: ihlat_bnd(0:nmlon) + integer, intent(in) :: itrans_width(0:nmlon) + real(r8), intent(in) :: pot_highlats(0:nmlon,0:nmlat) + real(r8), intent(in) :: pot_highlat(0:nmlon,0:nmlat) + real(r8), intent(in) :: pot_midlat(0:nmlon,0:nmlat) + +!---------------------------------------------------------------------------- +! local variables +!---------------------------------------------------------------------------- + real(r8), parameter :: fac = 1._r8/3._r8 + integer :: ilon, ilat + integer :: ibnd, tw, hb1, hb2, lat_ind + integer :: j1, j2 + real(r8) :: a, b, b1, b2 + real(r8) :: wrk1, wrk2 + +!$omp parallel do private(ilat,ilon,ibnd,tw) + do ilon = 0,nmlon + ibnd = ihlat_bnd(ilon) ! high latitude boundary index + tw = itrans_width(ilon) ! width of transition zone (index) +!---------------------------------------------------------------------------- +! 1. low/mid latitude: |lam| < bnd-trans_width +! Phi(phi,lam) = Phi_low(phi,lam) +!---------------------------------------------------------------------------- + do ilat = 0,nmlath-(ibnd+tw+1) + potent(ilon,nmlath+ilat) = pot_midlat(ilon,nmlath+ilat) + potent(ilon,nmlath-ilat) = pot_midlat(ilon,nmlath+ilat) + end do +!---------------------------------------------------------------------------- +! 2. high latitude: |lam| > bnd+trans_width +! Phi(phi,lam) = Phi_hl(phi,lam) +!---------------------------------------------------------------------------- + do ilat = 0,ibnd-tw-1 + potent(ilon,ilat) = pot_highlats(ilon,nmlat-ilat) + potent(ilon,nmlat-ilat) = pot_highlats(ilon,nmlat-ilat) + end do + end do +!---------------------------------------------------------------------------- +! 3. transition zone: bnd-trans_width <= lam <= bnd+trans_width +!---------------------------------------------------------------------------- +! a. interpolate between high and low/midlatitude potential +! update only southern hemisphere (northern hemisphere is copied +! after smoothing) +!---------------------------------------------------------------------------- +!$omp parallel do private(ilat,ilon,ibnd,tw,a,b,b1,b2,hb1,hb2,lat_ind,j1,j2,wrk1,wrk2) + do ilon = 0,nmlon + ibnd = ihlat_bnd(ilon) ! high latitude boundary index + tw = itrans_width(ilon) ! width of transition zone (index) + a = 1._r8/(2._r8*tw) + b1 = (nmlath - ibnd + tw)*a + b2 = (nmlath - ibnd - tw)*a + hb1 = nmlath - (ibnd + tw) + j1 = nmlath - hb1 + hb2 = nmlath - (ibnd - tw) + j2 = nmlath - hb2 + wrk1 = pot_midlat(ilon,j1) + wrk2 = pot_highlats(ilon,j2) +! write(iulog,*) 'pot_all ',ilon,hb1,hb2,nmlath -ibnd,tw + do ilat = ibnd-tw,ibnd+tw + lat_ind = nmlath - ilat + potent(ilon,ilat) = & + fac*((wrk1 + 2._r8*pot_midlat(ilon,ilat))*(b1 - a*lat_ind) & + + (wrk2 + 2._r8*pot_highlats(ilon,ilat))*(a*lat_ind - b2)) + potent(ilon,nmlat-ilat) = potent(ilon,ilat) + end do +!---------------------------------------------------------------------------- +! b. Interpolate between just calculated Potential and the high latitude +! potential in a 3 degree zone poleward of the boundary +!---------------------------------------------------------------------------- + do ilat = hb2+1,nmlath + a = max( 3._r8/dlatm - (ilat - hb2 - 1),0._r8 ) + b = 3._r8/dlatm - a + potent(ilon,nmlath-ilat) = (a*potent(ilon,nmlath-ilat) & + + b*pot_highlat(ilon,nmlath-ilat))/3._r8*dlatm + potent(ilon,nmlath+ilat) = potent(ilon,nmlath-ilat) + end do + end do + + end subroutine interp_poten + + subroutine DerivPotential +!----------------------------------------------------------------------- +! Purpose: calulates the electric field [V/m] from the electric potential +! +! Method: Richmond [1995] eqn 5.9-5.10 +! ed1(:,:) = Ed1 = - 1/[R cos lam_m] d PHI/d phi_m +! ed2(:,:) = Ed2 = 1/R d PHI/d lam_m /sin I_m +! R = R_e + h_r we assume a reference height of 130 km which is also +! used in the TIEGCM code +! +! Author: A. Maute Dec 2003 am 12/16/03 +!----------------------------------------------------------------------- + + integer :: i, j, ip1f, ip2f, ip3f + real(r8) :: coslm, r, fac, wrk + real(r8) :: wrk1d(0:nmlon) + + r = r_e + h_r ! earth radius + reference height [m] +!----------------------------------------------------------------------- +! ed2= Ed2 is the equatorward/downward component of the electric field, at all +! geomagnetic grid points (central differencing) +!----------------------------------------------------------------------- + fac = .5_r8/(dlatm*dtr*r) +!$omp parallel do private(j, i, wrk ) + do j = 1,nmlath-1 ! southern hemisphere + wrk = fac/sinIm_mag(j) + do i = 0,nmlon + ed2(i,j) = (potent(i,j+1) - potent(i,j-1))*wrk + end do + end do + +!$omp parallel do private(j, i, wrk ) + do j = nmlath+1,nmlat-1 ! northern hemisphere + wrk = fac/sinIm_mag(j) + do i = 0,nmlon + ed2(i,j) = (potent(i,j+1) - potent(i,j-1))*wrk + end do + end do + +!----------------------------------------------------------------------- +! Interpolate of ed2 between between -12 <= lam_m <= 12 degrees: +!----------------------------------------------------------------------- + wrk1d(:) = ed2(:,jmax) - ed2(:,jmin) + do j = jmin+1,jmax-1 + fac = (ylatm(j) - ylatm(jmin))/(ylatm(jmax) - ylatm(jmin)) + do i = 0,nmlon + ed2(i,j) = ed2(i,jmin) + fac*wrk1d(i) + end do + end do + +!----------------------------------------------------------------------- +! ed1= Ed1 is the zonal component of the electric field, at all +! geomagnetic grid points (central differencing) +!----------------------------------------------------------------------- + fac = .5_r8/(dlonm*dtr*r) +!$omp parallel do private(j, i, wrk, coslm ) + do j = 1,nmlat-1 + coslm = ylatm(j) - 90._r8 + coslm = cos( coslm*dtr ) + wrk = fac/coslm + do i = 1,nmlon-1 + ed1(i,j) = -(potent(i+1,j) - potent(i-1,j))*wrk + end do + i = 0 + ed1(i,j) = -(potent(i+1,j) - potent(nmlon-1,j))*wrk + ed1(nmlon,j) = ed1(i,j) + end do + +!----------------------------------------------------------------------- +! Poles: +!----------------------------------------------------------------------- + do i = 0,nmlon + ip1f = i + nmlon/4 + if( ip1f > nmlon ) then + ip1f = ip1f - nmlon + end if + ip2f = i + nmlon/2 + if( ip2f > nmlon ) then + ip2f = ip2f - nmlon + end if + ip3f = i + 3*nmlon/4 + if( ip3f > nmlon ) then + ip3f = ip3f - nmlon + end if + ed1(i,0) = .25_r8*(ed1(i,1) - ed1(ip2f,1) + ed2(ip1f,1) - ed2(ip3f,1)) + ed1(i,nmlat) = .25_r8*(ed1(i,nmlat-1) - ed1(ip2f,nmlat-1) & + + ed2(ip1f,nmlat-1) - ed2(ip3f,nmlat-1)) + ed2(i,0) = .25_r8*(ed2(i,1) - ed2(ip2f,1) - ed1(ip1f,1) + ed1(ip3f,1)) + ed2(i,nmlat) = .25_r8*(ed2(i,nmlat-1) - ed2(ip2f,nmlat-1) & + - ed1(ip1f,nmlat-1) + ed1(ip3f,nmlat-1)) + end do + + end subroutine DerivPotential + + end module efield diff --git a/src/physics/waccm/exbdrift.F90 b/src/physics/waccm/exbdrift.F90 new file mode 100644 index 0000000000..8474cf7583 --- /dev/null +++ b/src/physics/waccm/exbdrift.F90 @@ -0,0 +1,419 @@ + + module exbdrift +!---------------------------------------------------------------------- +! description: calculates ExB drift velocities UI,VI,WI +! uses the electric field which is calculated in module efield +! on a regular magnetic grid (MLT deg/ mag. latitude) +! +! 0. initilize called before time-loop (exbdrift_init) +! every timestep and every processor +! 1. map from magn. grid to geographic grid WACCM (map_mag2geo) +! 2. rotate e-field (rot_efield) +! 3. calculate ExB drift velocities ui,vi,wi [m/s] (iondrift) +! +! input ed1,ed2, & ! zonal/meridional elect. field [V/m] +! nmlon,nmlat, & ! dimension of mag. grid +! dlatm,dlonm, & ! grid spacing of mag. grid +! ylatm,ylonm ! magnetic MLT deg./latitudes (deg) +! +! ExB electromagnetic drift velocity [m/s] (east,north,upward) +! These are output to the physics buffer. +! real(r8) :: ui,vi,wi +! +! notes: +! - assume regular magnetic grid for the e-field (0:360 MLT/0:90) -> mapping +! +! Author: A. Maute Dec 2003 +! B. Foster adding physics buffer Feb, 2004. +!---------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + + use ppgrid , only: pcols, pver + use cam_logfile, only: iulog + + use efield, only : & ! inputs from efield module + ed1, ed2, & ! global zonal/meridional elect. field [V/m] + potent, & ! electric potential [V] + nmlon, nmlat, & ! dimension of mag. grid + dlatm, dlonm, & ! grid spacing of mag. grid + ylatm, ylonm ! magnetic longitudes,latitudes (deg) (0:nmlat),(0:nmlon) + use apex, only : apex_subsol, apex_magloctm + use cam_history, only: outfld, addfld, add_default, horiz_only ! for history saves + + implicit none + + private + + save + +!---------------------------------------------------------------------- +! Public interfaces: +!---------------------------------------------------------------------- + public :: exbdrift_init + public :: exbdrift_register ! register drift velocities with pbuf + public :: exbdrift_ion_vels ! updates empirical ion drift velocities (in pbuf) + +!---------------------------------------------------------------------- +! Indices to drift velocities in physics buffer: +!---------------------------------------------------------------------- + integer :: ndx_ui, ndx_vi, ndx_wi + real(r8), parameter :: rtd = 180._r8/pi ! radians to degrees + real(r8), parameter :: hr2d = 360._r8/24._r8 + + logical, parameter :: debug =.true. + + contains + + subroutine exbdrift_init( empirical_ion_vels ) +!----------------------------------------------------------------------- +! Purpose: Prepare fields for histories. +! +! Method: +! +! Author: A. Maute Dec 2003 am 12/30/03 +!----------------------------------------------------------------------- + + use phys_control, only: phys_getopts + + logical, intent(in) :: empirical_ion_vels + + logical :: history_waccm + + + call phys_getopts(history_waccm_out=history_waccm) + +!----------------------------------------------------------------------- +! Add mag field output to master field list: +!----------------------------------------------------------------------- + call addfld('EF_EAST', horiz_only,'I','V/m', 'eastward electric field') + call addfld('EF_WEST', horiz_only,'I','V/m', 'northward electric field') + call addfld('EF_UP', horiz_only,'I','V/m', 'upward electric field') + call addfld('EF1_MAP', horiz_only,'I','V/m', 'map. mag. eastward ef') + call addfld('EF2_MAP', horiz_only,'I','V/m', 'map. mag. northward ef') + call addfld('EPOTEN', horiz_only,'I','V', 'Electric Potential') +!----------------------------------------------------------------------- +! Write these fields to WACCM history by default: +!----------------------------------------------------------------------- + if (history_waccm .and. empirical_ion_vels) then + call add_default ('EPOTEN ' , 1, ' ') + end if + + end subroutine exbdrift_init + + subroutine exbdrift_register + + use physics_buffer, only : pbuf_add_field, dtype_r8 + +!----------------------------------------------------------------------- +! Register drift velocity outputs with physics buffer: +! +! Ion velocities are 2d fields in pbuf (no vertical dimension), +! so fdim = mdim = ldim = 1. +! Indices are saved as module data above. +!----------------------------------------------------------------------- + + call pbuf_add_field("UI", "global", dtype_r8, (/pcols,pver/), ndx_ui) + call pbuf_add_field("VI", "global", dtype_r8, (/pcols,pver/), ndx_vi) + call pbuf_add_field("WI", "global", dtype_r8, (/pcols,pver/), ndx_wi) + + end subroutine exbdrift_register + + subroutine exbdrift_ion_vels( lchnk, ncol, pbuf) + use physics_buffer, only : physics_buffer_desc +!----------------------------------------------------------------------- +! Purpose: calculate ion drift velocities [m/s] +! +! Method: v = E x B/B^2 +! +! Author: A. Maute Dec 2003 am 12/30/03 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol ! np. of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + + type(physics_buffer_desc), pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8) :: ed1_geo(ncol), & ! electric field on geographic grid [V/m] + ed2_geo(ncol), & + epot_geo(ncol) ! electric potential on geographic grid + real(r8) :: elfld(3,ncol) ! electric field in geog. direction on geographic grid [V/m] + real(r8) :: mlt(ncol) ! mag.local time of WACCM geo. grid point + +!----------------------------------------------------------------------- +! calculate the magn. local time of WACCM geogr. grid points +!----------------------------------------------------------------------- + call cal_mlt( mlt, lchnk, ncol ) +!----------------------------------------------------------------------- +! map the electric field from regular mag.grid to WACCM grid +!----------------------------------------------------------------------- + call map_mag2geo( mlt, lchnk, ncol, ed1_geo, ed2_geo, epot_geo ) +!----------------------------------------------------------------------- +! rotate the electric field in geographic direction +!----------------------------------------------------------------------- + call rot_efield( lchnk, ncol, ed1_geo, ed2_geo, elfld ) +!----------------------------------------------------------------------- +! calculate ExB drift velocities ui,vi,wi [m/s] +!----------------------------------------------------------------------- + call iondrift( lchnk, ncol, elfld, pbuf) + + end subroutine exbdrift_ion_vels + + subroutine map_mag2geo( mlt, lchnk, pcol, ed1_geo, ed2_geo, epot_geo ) +!----------------------------------------------------------------------- +! Purpose: map electric field from regular magnetic grid +! to WACCM physics geographic grid +! +! Method: bilinear interpolation +! assumptions: magnetic grid regular (MLT[deg]=0:360 deg/lat=0:180 deg) +! ed1_geo(:,:) = Ed1_geo <- mapping of - 1/[R cos lam_m] d PHI/d phi_m +! ed2_geo(:,:) = Ed2_geo <- mapping of 1/R d PHI/d lam_m/ sinIm +! +! Author: A.Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + + use mo_apex, only: alatm ! apex mag latitude at each geographic grid point (radians) + +!----------------------------------------------------------------------- +! dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: pcol ! np. of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(in) :: mlt(pcol) ! mag.local time of WACCM geo. grid point + real(r8), intent(out) :: & + ed1_geo(pcol), & ! electric field on geog. grid + ed2_geo(pcol), & ! electric field on geog. grid + epot_geo(pcol) ! electric potential on geog grid + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: i, iphi1, iphi2, ilam1, ilam2 + real(r8) :: t, u, collat, collon + + + do i = 1,pcol + collat = alatm(i,lchnk)*rtd ! mag lats (deg) [-90:90] + collon = mlt(i)*hr2d ! mlt (deg) [0:360] + iphi1 = int(collon/dlonm) ! indices of the 4 surrounding points (regular mag. grid + iphi2 = iphi1 + 1 ! with dlonm/dlatm deg grid spacing) + ilam1 = int( (collat + 90._r8)/dlatm ) + ilam2 = ilam1 + 1 + if(iphi1 == nmlon ) then ! boundaries + iphi1 = nmlon -1 + iphi2 = nmlon + end if + if(ilam1 == nmlat ) then + ilam1 = nmlat-1 + ilam2 = nmlat + end if + if(collon == 360._r8) then + collon= 0._r8 + iphi1 = 0 + iphi2 = 1 + end if + + t = (collon - ylonm(iphi1))/(ylonm(iphi2) - ylonm(iphi1)) + u = (collat + 90._r8 - ylatm(ilam1))/(ylatm(ilam2) - ylatm(ilam1)) + ed1_geo(i) = (1._r8 - t)*(1._r8 - u)*ed1(iphi1,ilam1) + & + t*(1._r8 - u)* ed1(iphi2,ilam1) + & + t*u* ed1(iphi2,ilam2) + & + (1._r8 - t)*u* ed1(iphi1,ilam2) + ed2_geo(i) = (1._r8 - t)*(1._r8 - u)*ed2(iphi1,ilam1) + & + t*(1._r8 - u)* ed2(iphi2,ilam1) + & + t*u* ed2(iphi2,ilam2) + & + (1._r8 - t)*u* ed2(iphi1,ilam2) + epot_geo(i)= (1._r8 - t)*(1._r8 - u)*potent(iphi1,ilam1) + & + t*(1._r8 - u)* potent(iphi2,ilam1) + & + t*u* potent(iphi2,ilam2) + & + (1._r8 - t)*u* potent(iphi1,ilam2) + end do ! i = 1,pcol + + call outfld( 'EF1_MAP', ed1_geo, pcol, lchnk) + call outfld( 'EF2_MAP', ed2_geo, pcol, lchnk) + call outfld( 'EPOTEN', epot_geo, pcol, lchnk) + + end subroutine map_mag2geo + + subroutine rot_efield( lchnk, pcol, ed1_geo, ed2_geo, elfld ) +!----------------------------------------------------------------------- +! Purpose: rotate the electric field to get geographic east and westward direction +! +! Method: Richmond: J Geomag. Geoelectr. [1995] eqn. (4.5) +! rotation of the electric field to get geog. eastward and downward/equatorward +! E(k) = d_1(k)*ed1_geo + d_2(k)*ed2_geo for k = 1,3 +! +! Author: A. Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + + use mo_apex, only: d1vec, d2vec ! base vectors (3,pcols,begchunk:endchunk) + +!----------------------------------------------------------------------- +! dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: pcol ! np. of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(in ) :: ed1_geo(pcol),ed2_geo(pcol) ! electric field on geog. grid + real(r8), intent(out) :: elfld(3,pcol) ! electric field on geog. grid geog. direction + +!----------------------------------------------------------------------- +! local +!----------------------------------------------------------------------- + integer :: i, k + + do i = 1,pcol + do k = 1,3 + elfld(k,i) = ed1_geo(i)*d1vec(k,i,lchnk) + & + ed2_geo(i)*d2vec(k,i,lchnk) + end do + end do + + call outfld( 'EF_EAST', elfld(1,:), pcol, lchnk) + call outfld( 'EF_WEST', elfld(2,:), pcol, lchnk) + call outfld( 'EF_UP', elfld(3,:), pcol, lchnk) + + end subroutine rot_efield + + subroutine iondrift( lchnk, pcol, elfld, pbuf) +!----------------------------------------------------------------------- +! Purpose: calculate ion drift velocity +! +! Method: v_i = ExB/B^2 +! for high altitudes where collisionfrequency mue_in << omega_i and +! mue_en,vert << omega_e +! v_i,vert = v_e,vert = v_E +! B magnetic field component from apex code +! bnorth northward gauss +! beast eastward gauss +! bdown downward gauss -> for upward component -bdown +! bmag magnitude gauss +! +! Author: A. Maute Dec 2003 am 12/17/03 +!----------------------------------------------------------------------- + + use mo_apex, only: beast, bnorth, bdown, bmag ! component of B-field, |B| [Gauss] + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + + +!----------------------------------------------------------------------- +! dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: pcol ! np. of atmospheric columns + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: elfld(3,pcol) ! electric field on geog. grid geog. direction +!----------------------------------------------------------------------- +! Ion velocities are saved in physics buffer: +!----------------------------------------------------------------------- + + type(physics_buffer_desc), pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + integer :: i + real(r8) :: fac + real(r8), pointer :: ui(:,:), vi(:,:), wi(:,:) + +!----------------------------------------------------------------------- +! Set local pointers to respective fields in pbuf: +!----------------------------------------------------------------------- + call pbuf_get_field(pbuf, ndx_ui, ui ) + call pbuf_get_field(pbuf, ndx_vi, vi ) + call pbuf_get_field(pbuf, ndx_wi, wi ) + + do i = 1,pcol ! number of columns in each chunk +!----------------------------------------------------------------------- +! Magnitude of magnetic field bmag [nT] is from apex module. +!----------------------------------------------------------------------- + fac = 1.e9_r8/bmag(i,lchnk)**2 ! nT to T (nT in denominator) + ui(i,:) = -(elfld(2,i)*bdown(i,lchnk) + elfld(3,i)*bnorth(i,lchnk)) + vi(i,:) = elfld(3,i)*beast(i,lchnk) + elfld(1,i)*bdown(i,lchnk) + wi(i,:) = elfld(1,i)*bnorth(i,lchnk) - elfld(2,i)*beast(i,lchnk) + ui(i,:) = ui(i,:)*fac + vi(i,:) = vi(i,:)*fac + wi(i,:) = wi(i,:)*fac + end do ! i = 1,pcol + +#ifdef SW_DEBUG + if( lchnk == 25 ) then + write(iulog,*) ' ' + write(iulog,*) '---------------------------------------' + write(iulog,*) 'iondrift: elfld @ lchnk,i = ',lchnk,' 14' + write(iulog,'(1p,3g15.7)') elfld(:,14) + write(iulog,*) 'iondrift: bdown,bnorth,beast,bmag @ lchnk,i = ',lchnk,' 14' + write(iulog,'(1p,4g15.7)') bdown(14,lchnk), bnorth(14,lchnk), beast(14,lchnk), bmag(14,lchnk) + write(iulog,*) '---------------------------------------' + write(iulog,*) ' ' + end if +#endif + + end subroutine iondrift + + subroutine cal_mlt( mlt, lchnk, ncol ) + +!------------------------------------------------------------------------------- +! Purpose: calculate the magnetic local time of WACCM geog. point +! +! Method: using the location of the geomagnetic dipole north pole, +! the subsolar point location and the apex longitude of the +! geographic WACCM point the magn. local time can be calculated +! subroutines from Roy Barnes HAO Feb. 2004 +! +! Author: A. Maute Feb 2004 +!------------------------------------------------------------------------------- + + use mo_apex, only: & + alonm, & ! apex mag longitude at each geographic grid point (radians) + colatp, & ! geocentric colatitude of geomagnetic dipole north pole (deg) + elonp ! East longitude of geomagnetic dipole north pole (deg) + use time_manager, only : get_curr_calday, get_curr_date + use mo_apex, only : geomag_year +!------------------------------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------------------------------- + integer, intent(in) :: ncol ! np. of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(out) :: mlt(ncol) ! mag.local time of WACCM geo. grid point + +!------------------------------------------------------------------------------- +! local arguments +!------------------------------------------------------------------------------- + integer :: i + integer :: iyear, iday, ihr, imn, imo, iday_m, tod ! time of day [s] + real(r8) :: collonm, sbsllat, sbsllon, sec + +!------------------------------------------------------------------------------- +! get current calendar day of year & date components +! valid at end of current timestep +!------------------------------------------------------------------------------- + call get_curr_date (iyear,imo,iday_m,tod) ! year, time of day [sec] + iyear = int(geomag_year) + iday = get_curr_calday() ! day of year + + ihr = tod/3600 + imn = mod( tod,3600 )/60 + sec = tod - 60*(ihr*60 + imn) + +!------------------------------------------------------------------------------- +! find subsolar geographic latitude and longitude +!------------------------------------------------------------------------------- + call apex_subsol( iyear, iday, ihr, imn, sec, sbsllat, sbsllon ) + +!------------------------------------------------------------------------------- +! computes magnetic local time +!------------------------------------------------------------------------------- + do i = 1,ncol + collonm = alonm(i,lchnk)*rtd ! mag lons (deg) + call apex_magloctm( collonm, sbsllat, sbsllon, colatp, elonp, mlt(i) ) + end do + + end subroutine cal_mlt + + end module exbdrift diff --git a/src/physics/waccm/iondrag.F90 b/src/physics/waccm/iondrag.F90 new file mode 100644 index 0000000000..92ee507659 --- /dev/null +++ b/src/physics/waccm/iondrag.F90 @@ -0,0 +1,1415 @@ + +module iondrag + !------------------------------------------------------------------------------- + ! Purpose: + ! Calculate ion drag tendency and apply to horizontal velocities. + ! Also calculate joule heating tendency and apply to neutral temperature. + ! + ! Subroutines: + ! iondrag_init (initialize module) + ! iondrag_calc (calculate ion drag tensors) + ! iondrag_tend (ion drag tendency) + ! qjoule_tend (joule heating) + ! + ! Calling sequence: + ! inti + ! iondrag_init + ! tphysac + ! iondrag_calc + ! iondrag_tend + ! qjoule_tend + ! + ! Dependencies: + ! Magnetic field from apex module + ! ExB ion drifts from exbdrift module + ! + ! Author: + ! B. Foster Feb, 2004 + ! + !------------------------------------------------------------------------------- + + use shr_kind_mod ,only: r8 => shr_kind_r8 + use ppgrid ,only: pcols, pver, begchunk, endchunk + use cam_history ,only: addfld, add_default, outfld, horiz_only + use physics_types,only: physics_state, physics_ptend, physics_ptend_init + + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field + use perf_mod ,only: t_startf, t_stopf + use cam_logfile ,only: iulog + + use interpolate_data, only: lininterp + use spmd_utils, only: masterproc + + use phys_control, only: waccmx_is + use cam_abortutils,only: endrun + + implicit none + + save + + private ! Make default type private to the module + + !------------------------------------------------------------------------------- + ! Public interfaces: + !------------------------------------------------------------------------------- + public :: iondrag_register ! Register variables in pbuf physics buffer + public :: iondrag_init ! Initialization + public :: iondrag_calc ! ion drag tensors lxx,lyy,lxy,lyx + public :: iondrag_readnl + public :: iondrag_timestep_init + public :: iondrag_inidat + public :: do_waccm_ions + + interface iondrag_calc + module procedure iondrag_calc_ions + module procedure iondrag_calc_ghg + end interface + + !------------------------------------------------------------------------------- + ! Private data + !------------------------------------------------------------------------------- + + ! Namelist variables + character(len=256) :: efield_lflux_file = 'coeff_lflux.dat' + character(len=256) :: efield_hflux_file = 'coeff_hflux.dat' + character(len=256) :: efield_wei96_file = 'wei96.cofcnts' + logical :: empirical_ion_velocities = .true. + + real(r8),parameter :: amu = 1.6605387e-27_r8 ! atomic mass unit (kg) + + integer :: ntop_lev = 1 + integer :: nbot_lev = 0 + integer :: id_xo2, id_xo1 ! indices to tn and major sp + integer :: id_o2p, id_op, id_nop ! indices to ions + integer :: id_elec, id_n + + !Physics buffer indices + integer :: PedConduct_idx = 0 + integer :: HallConduct_idx = 0 + integer :: ui_idx = 0 ! index to zonal drift from edynamo + integer :: vi_idx = 0 ! index to meridional drift from edynamo + integer :: wi_idx = 0 ! index to vertical drift from edynamo + integer :: indxTe = -1 ! pbuf index for electron temperature + integer :: indxTi = -1 ! pbuf index for ion temperature + + logical :: xo2_slvd, xo1_slvd, o2p_slvd, op_slvd, nop_slvd + + real(r8) :: rmass_op ! mass of O+ (g/mole) + real(r8) :: rmass_o2p ! mass of O2+ (g/mole) + real(r8) :: rmass_nop ! mass of NO+ (g/mole) + real(r8) :: rmass_o1 ! mass of O (g/mole) + real(r8) :: rmass_o2 ! mass of O2 (g/mole) + real(r8) :: rmass_n2 ! mass of N2 (g/mole) + + !------------------------------------------------------------------------------- + ! Inverted masses (for multiply in loops rather than divide): + !------------------------------------------------------------------------------- + real(r8) :: rmi_o1 + real(r8) :: rmi_o2 + real(r8) :: rmi_n2 + real(r8) :: rmi_op + real(r8) :: rmi_o2p + real(r8) :: rmi_nop + real(r8) :: rmi_op_kg + real(r8) :: rmi_o2p_kg + real(r8) :: rmi_nop_kg + + ! GHG + !------------------------------------------------------------------------- + + ! Private data + integer, parameter :: plevtiod = 97 + + real(r8) alamxx(plevtiod) + real(r8) alamxy(plevtiod) + + real(r8) pshtiod(plevtiod) ! TIME pressure scale height + real(r8) pshccm(pver) ! CCM pressure scale height + + real(r8) alamxxi(pver) ! alamxx interpolated to waccm grid + real(r8) alamxyi(pver) ! alamxy interpoalted to waccm grid + + logical doiodrg + logical, protected :: do_waccm_ions = .false. + + ! + ! Data statement for ALAMXX + ! + data alamxx / & + 0.13902E-17_r8, 0.22222E-17_r8, 0.34700E-17_r8, 0.53680E-17_r8, 0.83647E-17_r8, & + 0.13035E-16_r8, 0.20254E-16_r8, 0.31415E-16_r8, 0.48944E-16_r8, 0.75871E-16_r8, & + 0.11584E-15_r8, 0.17389E-15_r8, 0.25786E-15_r8, 0.37994E-15_r8, 0.58088E-15_r8, & + 0.95179E-15_r8, 0.19052E-14_r8, 0.47869E-14_r8, 0.14284E-13_r8, 0.45584E-13_r8, & + 0.14756E-12_r8, 0.48154E-12_r8, 0.14844E-11_r8, 0.39209E-11_r8, 0.83886E-11_r8, & + 0.14213E-10_r8, 0.20304E-10_r8, 0.27449E-10_r8, 0.39276E-10_r8, 0.59044E-10_r8, & + 0.83683E-10_r8, 0.11377E-09_r8, 0.14655E-09_r8, 0.19059E-09_r8, 0.28338E-09_r8, & + 0.46326E-09_r8, 0.73966E-09_r8, 0.11785E-08_r8, 0.18789E-08_r8, 0.31037E-08_r8, & + 0.53919E-08_r8, 0.97251E-08_r8, 0.17868E-07_r8, 0.33041E-07_r8, 0.61265E-07_r8, & + 0.11406E-06_r8, 0.20912E-06_r8, 0.39426E-06_r8, 0.76691E-06_r8, 0.15113E-05_r8, & + 0.29545E-05_r8, 0.55644E-05_r8, 0.97208E-05_r8, 0.16733E-04_r8, 0.28101E-04_r8, & + 0.36946E-04_r8, 0.44277E-04_r8, 0.50982E-04_r8, 0.57526E-04_r8, 0.64190E-04_r8, & + 0.71471E-04_r8, 0.80311E-04_r8, 0.96121E-04_r8, 0.11356E-03_r8, 0.14131E-03_r8, & + 0.18695E-03_r8, 0.26058E-03_r8, 0.36900E-03_r8, 0.50812E-03_r8, 0.66171E-03_r8, & + 0.80763E-03_r8, 0.92583E-03_r8, 0.10038E-02_r8, 0.10382E-02_r8, 0.10333E-02_r8, & + 0.99732E-03_r8, 0.93994E-03_r8, 0.86984E-03_r8, 0.79384E-03_r8, 0.71691E-03_r8, & + 0.64237E-03_r8, 0.57224E-03_r8, 0.50761E-03_r8, 0.44894E-03_r8, 0.39624E-03_r8, & + 0.34929E-03_r8, 0.30767E-03_r8, 0.27089E-03_r8, 0.23845E-03_r8, 0.20985E-03_r8, & + 0.18462E-03_r8, 0.16233E-03_r8, 0.14260E-03_r8, 0.12510E-03_r8, 0.10955E-03_r8, & + 0.95699E-04_r8, 0.83347E-04_r8/ + + ! + ! Data statement for ALAMXY + ! + data alamxy / & + 0.74471E-24_r8, 0.22662E-23_r8, 0.69004E-23_r8, 0.20345E-22_r8, 0.58465E-22_r8, & + 0.16542E-21_r8, 0.46240E-21_r8, 0.12795E-20_r8, 0.35226E-20_r8, 0.96664E-20_r8, & + 0.26650E-19_r8, 0.76791E-19_r8, 0.25710E-18_r8, 0.10897E-17_r8, 0.56593E-17_r8, & + 0.30990E-16_r8, 0.16792E-15_r8, 0.85438E-15_r8, 0.40830E-14_r8, 0.18350E-13_r8, & + 0.79062E-13_r8, 0.33578E-12_r8, 0.13348E-11_r8, 0.45311E-11_r8, 0.12443E-10_r8, & + 0.27052E-10_r8, 0.49598E-10_r8, 0.86072E-10_r8, 0.15807E-09_r8, 0.30480E-09_r8, & + 0.55333E-09_r8, 0.96125E-09_r8, 0.15757E-08_r8, 0.25896E-08_r8, 0.48209E-08_r8, & + 0.96504E-08_r8, 0.18494E-07_r8, 0.34296E-07_r8, 0.61112E-07_r8, 0.10738E-06_r8, & + 0.18747E-06_r8, 0.32054E-06_r8, 0.52872E-06_r8, 0.83634E-06_r8, 0.12723E-05_r8, & + 0.18748E-05_r8, 0.26362E-05_r8, 0.36986E-05_r8, 0.52079E-05_r8, 0.72579E-05_r8, & + 0.98614E-05_r8, 0.12775E-04_r8, 0.15295E-04_r8, 0.18072E-04_r8, 0.20959E-04_r8, & + 0.19208E-04_r8, 0.16285E-04_r8, 0.13628E-04_r8, 0.11784E-04_r8, 0.11085E-04_r8, & + 0.11916E-04_r8, 0.14771E-04_r8, 0.20471E-04_r8, 0.29426E-04_r8, 0.42992E-04_r8, & + 0.62609E-04_r8, 0.90224E-04_r8, 0.12870E-03_r8, 0.18281E-03_r8, 0.26029E-03_r8, & + 0.37224E-03_r8, 0.53254E-03_r8, 0.75697E-03_r8, 0.10623E-02_r8, 0.14660E-02_r8, & + 0.19856E-02_r8, 0.26393E-02_r8, 0.34473E-02_r8, 0.44327E-02_r8, 0.56254E-02_r8, & + 0.70672E-02_r8, 0.88174E-02_r8, 0.10960E-01_r8, 0.13613E-01_r8, 0.16934E-01_r8, & + 0.21137E-01_r8, 0.26501E-01_r8, 0.33388E-01_r8, 0.42263E-01_r8, 0.53716E-01_r8, & + 0.68491E-01_r8, 0.87521E-01_r8, 0.11196E+00_r8, 0.14320E+00_r8, 0.18295E+00_r8, & + 0.23321E+00_r8, 0.29631E+00_r8/ + + logical :: ionvels_read_from_file = .false. + +contains + +!============================================================================== + + subroutine iondrag_register +!----------------------------------------------------------------------- +! Register E and B fields. +! +! Register iondrag variables with physics buffer: +! +! Hall and Pedersen conductivities +! +! pcols dimension and lchnk assumed here +! +!----------------------------------------------------------------------- + use exbdrift, only: exbdrift_register + use physics_buffer, only: pbuf_add_field, dtype_r8 + + ! E and B fields + call exbdrift_register() + + if ( waccmx_is("ionosphere") ) then + ! Pedersen Conductivity and Hall Conductivity + call pbuf_add_field('PedConduct', 'physpkg', dtype_r8, (/pcols,pver/), PedConduct_idx ) + call pbuf_add_field('HallConduct', 'physpkg', dtype_r8, (/pcols,pver/), HallConduct_idx) + end if + + end subroutine iondrag_register + +!================================================================================================ + + subroutine iondrag_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, masterprocid, mpicom, mpi_character, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'iondrag_readnl' + + namelist /iondrag_nl/ efield_lflux_file, efield_hflux_file, efield_wei96_file, empirical_ion_velocities + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'iondrag_nl', status=ierr) + if (ierr == 0) then + read(unitn, iondrag_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + + call mpi_bcast (efield_lflux_file, len(efield_lflux_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast (efield_hflux_file, len(efield_hflux_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast (efield_wei96_file, len(efield_wei96_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast (empirical_ion_velocities, 1, mpi_logical, masterprocid, mpicom, ierr) + + end subroutine iondrag_readnl + + !================================================================================================ + + subroutine iondrag_init( pref_mid ) + use constituents, only: cnst_get_ind + use short_lived_species, only: slvd_index + + !------------------------------------------------------------------------------- + ! Iondrag initialization, called from inti.F90. + !------------------------------------------------------------------------------- + + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + real(r8), intent(in) :: pref_mid(pver) + + integer :: k, err + + integer :: cnst_ids(7) + + doiodrg = .false. + do_waccm_ions = .false. + + !------------------------------------------------------------------------------- + ! find lower bnd for iondrag + !------------------------------------------------------------------------------- + if( pref_mid(1) < 0.1_r8 ) then + do k = 1, pver + if (pref_mid(k) < 50._r8) nbot_lev = k + end do + end if + + if (nbot_lev > 0) then + doiodrg = .true. + endif + + if ( .not. doiodrg .and. masterproc ) then + write(iulog,*) ' ' + write(iulog,*) 'iondrag_init: Does not have waccm level. Ion drag does not apply. ' + write(iulog,*) ' ' + return + endif + + if( masterproc ) then + write(iulog,*) ' ' + write(iulog,*) 'iondrag_init: nbot_lev,press = ',nbot_lev,pref_mid(nbot_lev) + write(iulog,*) ' ' + end if + + call cnst_get_ind( 'e', id_elec, abort=.false. ) + if (id_elec < 0) then + id_elec = slvd_index( 'e' ) + endif + call cnst_get_ind( 'Op', id_op, abort=.false. ) + if (id_op < 0) then + id_op = slvd_index( 'Op' ) + if (id_op > 0) then + op_slvd = .true. + endif + else + op_slvd = .false. + endif + call cnst_get_ind( 'O2p', id_o2p, abort=.false. ) + if (id_o2p < 0) then + id_o2p = slvd_index( 'O2p' ) + if (id_o2p > 0) then + o2p_slvd = .true. + endif + else + o2p_slvd = .false. + endif + call cnst_get_ind( 'NOp', id_nop, abort=.false. ) + if (id_nop < 0) then + id_nop = slvd_index( 'NOp' ) + if (id_nop > 0) then + nop_slvd = .true. + endif + else + nop_slvd = .false. + endif + call cnst_get_ind( 'O', id_xo1, abort=.false. ) + if (id_xo1 < 0) then + id_xo1 = slvd_index( 'O' ) + if (id_xo1 > 0) then + xo1_slvd = .true. + endif + else + xo1_slvd = .false. + endif + call cnst_get_ind( 'O2', id_xo2, abort=.false. ) + if (id_xo2 < 0) then + id_xo2 = slvd_index( 'O2' ) + if (id_xo2 > 0) then + xo2_slvd = .true. + endif + else + xo2_slvd = .false. + endif + call cnst_get_ind( 'N', id_n, abort=.false. ) + if (id_n < 0) then + id_n = slvd_index( 'N' ) + endif + + cnst_ids = (/ id_elec, id_op, id_o2p, id_nop, id_xo1, id_xo2, id_n /) + + if ( all( cnst_ids > 0 ) ) then + do_waccm_ions = .true. + endif + + if ( do_waccm_ions ) then + call ions_init + else + call ghg_init(pref_mid) + endif + + if (.not.doiodrg) return + + ! Add to masterfield list + call addfld('UIONTEND',(/ 'lev' /),'A','M/S2','u-tendency due to ion drag') + call addfld('VIONTEND',(/ 'lev' /),'A','M/S2','v-tendency due to ion drag') + +! +! Indices to 3d ion drifts : + ui_idx = pbuf_get_index('UI') + vi_idx = pbuf_get_index('VI') + wi_idx = pbuf_get_index('WI') + + indxTe = pbuf_get_index( 'TElec',errcode=err ) + indxTi = pbuf_get_index( 'TIon',errcode=err ) + + end subroutine iondrag_init + + !================================================================================================ + subroutine ions_init + + use efield, only: efield_init + use exbdrift, only: exbdrift_init + use mo_chem_utls, only: get_spc_ndx + use chem_mods, only: adv_mass + use mo_chem_utls, only: get_inv_ndx + use chem_mods, only: fix_mass + use phys_control, only: phys_getopts + + !------------------------------------------------------------------------------- + ! local variables + !------------------------------------------------------------------------------- + integer :: id + + logical :: history_waccm + + call phys_getopts(history_waccm_out=history_waccm) + + !------------------------------------------------------------------------------- + ! initialize related packages: electric field + !------------------------------------------------------------------------------- + + call efield_init (efield_lflux_file, efield_hflux_file, efield_wei96_file) + call exbdrift_init( empirical_ion_velocities ) + + id = get_spc_ndx('Op') + rmass_op = adv_mass(id) + id = get_spc_ndx('O2p') + rmass_o2p = adv_mass(id) + id = get_spc_ndx('NOp') + rmass_nop = adv_mass(id) + id = get_spc_ndx('O') + rmass_o1 = adv_mass(id) + id = get_spc_ndx('O2') + rmass_o2 = adv_mass(id) + id = get_inv_ndx('N2') + rmass_n2 = fix_mass(id) + + rmi_o1 = 1._r8/rmass_o1 + rmi_o2 = 1._r8/rmass_o2 + rmi_n2 = 1._r8/rmass_n2 + rmi_op = 1._r8/rmass_op + rmi_o2p = 1._r8/rmass_o2p + rmi_nop = 1._r8/rmass_nop + rmi_op_kg = 1._r8/(rmass_op *amu) + rmi_o2p_kg = 1._r8/(rmass_o2p*amu) + rmi_nop_kg = 1._r8/(rmass_nop*amu) + + !------------------------------------------------------------------------------- + ! Set up fields to history files. + !------------------------------------------------------------------------------- + call addfld('BNORTH', horiz_only, 'I', 'nT', 'northward component of magnetic field (nT)') + call addfld('BEAST' , horiz_only, 'I', 'nT', 'eastward component of magnetic field (nT)') + call addfld('BDOWN' , horiz_only, 'I', 'nT', 'downward component of magnetic field (nT)') + call addfld('BMAG' , horiz_only, 'I', 'nT', 'magnetic field magnitude (nT)' ) + + call addfld('QIONSUM', (/ 'lev' /), 'I','S-1' ,'Ion prod sum') + call addfld('ELECDEN', (/ 'lev' /), 'I','CM-3','NE (ion sum)') + call addfld('SIGMAPED', (/ 'lev' /), 'I', 'siemens/m', 'Pederson conductivity' ) + call addfld('SIGMAHAL', (/ 'lev' /), 'I', 'siemens/m', 'Hall conductivity' ) + call addfld('LAMDA1' , (/ 'lev' /), 'I' ,'S-1','LAMDA PED') + call addfld('LAMDA2' , (/ 'lev' /), 'I' ,'S-1','LAMDA HALL') + + call addfld('LXX', (/ 'lev' /), 'I','S-1','LXX') + call addfld('LYY', (/ 'lev' /), 'I','S-1','LYY') + call addfld('LXY', (/ 'lev' /), 'I','S-1','LXY') + call addfld('LYX', (/ 'lev' /), 'I','S-1','LYX') + + ! + ! Joule heating, and tn before and after joule heating tendencies are applied: + ! + call addfld( 'QJOULE', (/ 'lev' /), 'I', 'K/s' , 'Joule Heat' ) ! joule heating + if (history_waccm) then + call add_default( 'QJOULE ', 1, ' ' ) ! joule heating (K/s) + end if +! +! 3d drifts from either edynamo or exbdrift. +! + if (empirical_ion_velocities) then + call addfld('UI',(/ 'lev' /),'I','m/s', 'UI Zonal empirical ExB drift from exbdrift') + call addfld('VI',(/ 'lev' /),'I','m/s', 'VI Meridional empirical ExB drift from exbdrift') + call addfld('WI',(/ 'lev' /),'I','m/s', 'WI Vertical empirical ExB drift from exbdrift') + endif + + end subroutine ions_init + + !======================================================================== + + subroutine ghg_init (pref_mid) + + ! + ! initialization for ion drag calculation + ! + + !------------------Input arguments--------------------------------------- + + real(r8), intent(in) :: pref_mid(pver) ! model ref pressure at midpoint + + !-----------------local workspace--------------------------------------- + integer k + integer kinv + + real(r8) rpsh ! ref pressure scale height + + real(r8), parameter :: preftgcm = 5.e-5_r8 ! TIME GCM reference pressure (Pa) + + !------------------------------------------------------------------------ + + ! With the defualt values of nbot_lev and ntop_lev, ion drag calcualtion are NOT carried out + nbot_lev=0 + ntop_lev=1 + + do k = 1, pver + rpsh=log(1e5_r8/pref_mid(k)) + if (rpsh .gt. 14._r8) nbot_lev = k + end do + if (nbot_lev .gt. ntop_lev) doiodrg=.true. + if (masterproc) then + write(iulog,fmt='(a15)') 'From IONDRAGI:' + write(iulog,fmt='(1a12,1i10)') 'NTOP_LEV =',ntop_lev + write(iulog,fmt='(1a12,1i10)') 'NBOT_LEV =',nbot_lev + write(iulog,*) 'IONDRAG flag is',doiodrg + endif + if (.not.doiodrg) return + + ! obtain TIME/GCM pressure scale height + pshtiod(1)=-17._r8 + do k=2,plevtiod + pshtiod(k)=pshtiod(k-1)+0.25_r8 + enddo + + ! map TIME-psh into CCM-psh + pshtiod=pshtiod-log(preftgcm/1E5_r8) + + ! CCM psh + ! note that vertical indexing is inverted with respect to CCM standard + do k=1,pver + kinv=pver-k+1 + pshccm(kinv)=log(1e5_r8/pref_mid(k)) + enddo + + ! vertical interpolation + write(iulog,*) ' ' + write(iulog,*) 'iondragi: before lininterp for alamxx' + write(iulog,*) ' nlatin,nlatout =',plevtiod,pver + write(iulog,*) ' yin' + write(iulog,'(1p,5g15.8)') pshtiod + write(iulog,*) ' yout' + write(iulog,'(1p,5g15.8)') pshccm + write(iulog,*) ' ' + + call lininterp (alamxx ,pshtiod,plevtiod, alamxxi ,pshccm,pver) + + call lininterp (alamxy ,pshtiod,plevtiod, alamxyi ,pshccm,pver) + + ! invert indeces back to CCM convention + alamxxi(1:pver)=alamxxi(pver:1:-1) + alamxyi(1:pver)=alamxyi(pver:1:-1) + + return + + end subroutine ghg_init + + !================================================================================================ + + subroutine iondrag_timestep_init + use efield, only: get_efield + + if (do_waccm_ions) then + ! Compute the electric field + call t_startf ('efield') + call get_efield + call t_stopf ('efield') + endif + + end subroutine iondrag_timestep_init + + !================================================================================================ + subroutine iondrag_calc_ions( lchnk, ncol, state, ptend, pbuf, delt ) + !------------------------------------------------------------------------------- + ! Calculate ion drag tensors lxx,lyy,lxy,lyx. + ! Also calculate Pedersen and Hall conductivities. + ! This is called from tphysac. + !------------------------------------------------------------------------------- + + use mo_apex,only: & ! (pcols,begchunk:endchunk) + bnorth, & ! northward component of magnetic field (nT) + beast, & ! eastward component of magnetic field (nT) + bdown, & ! downward component of magnetic field (nT) + bmag ! magnetic field magnitude (nT) + use physconst, only: avogad, boltz + use chemistry, only: imozart + use mo_mean_mass, only: set_mean_mass + use exbdrift, only: exbdrift_ion_vels + use short_lived_species, only: slvd_pbf_ndx => pbf_idx + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field + use time_manager, only : is_first_step + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + integer,intent(in) :: lchnk ! current chunk index + integer,intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: delt ! time step (s) + type(physics_state), intent(in), target :: state ! Physics state variables + type(physics_ptend), intent(out) :: ptend ! Physics tendencies + + type(physics_buffer_desc), pointer :: pbuf(:) + + !------------------------------------------------------------------------------- + ! Local variables + !------------------------------------------------------------------------------- + integer :: i,k ! loop indices + + real(r8) :: sqrt_te ! sqrt(te) + real(r8) :: sqrt_tnti ! sqrt(tnti) + real(r8) :: wrk + real(r8),parameter :: dipmin = 0.17_r8 ! minimum dip angle (tuneable) + real(r8),parameter :: emass = 9.1093819e-31_r8 ! electron mass (kg) + real(r8),parameter :: qe = 1.6021765e-19_r8 ! electronic charge (coulombs) + real(r8),parameter :: colfac = 1.5_r8 ! collision factor (tuneable) + real(r8),parameter :: boltzmann = 1.e7_r8 * boltz + real(r8),parameter :: avo = avogad*1.e-3_r8 ! (molecules/mole) + ! real(r8),parameter :: rmass_op = 15.9989_r8 ! mass of O+ + ! real(r8),parameter :: rmass_o2p = 31.9983_r8 ! mass of O2+ + ! real(r8),parameter :: rmass_nop = 30.0056_r8 ! mass of NO+ + ! real(r8),parameter :: rmass_o1 = 16._r8 ! mass of O + ! real(r8),parameter :: rmass_o2 = 32._r8 ! mass of O2 + ! real(r8),parameter :: rmass_n2 = 28._r8 ! mass of N2 + + !------------------------------------------------------------------------------- + ! Inverted masses (for multiply in loops rather than divide): + !------------------------------------------------------------------------------- + ! real(r8),parameter :: rmi_o1 = 1._r8/rmass_o1 + ! real(r8),parameter :: rmi_o2 = 1._r8/rmass_o2 + ! real(r8),parameter :: rmi_n2 = 1._r8/rmass_n2 + ! real(r8),parameter :: rmi_op = 1._r8/rmass_op + ! real(r8),parameter :: rmi_o2p = 1._r8/rmass_o2p + ! real(r8),parameter :: rmi_nop = 1._r8/rmass_nop + ! real(r8),parameter :: rmi_op_kg = 1._r8/(rmass_op *amu) + ! real(r8),parameter :: rmi_o2p_kg = 1._r8/(rmass_o2p*amu) + ! real(r8),parameter :: rmi_nop_kg = 1._r8/(rmass_nop*amu) + + real(r8), target :: tn(pcols,pver) ! neutral gas temperature (deg K) + real(r8) :: xo2 (pcols,pver) ! O2 (mmr) + real(r8) :: xo1 (pcols,pver) ! O (mmr) + real(r8) :: xn2 (pcols,pver) ! N2 (mmr) + real(r8) :: o2p (pcols,pver) ! O2+ (mmr) + real(r8) :: op (pcols,pver) ! O+ (mmr) + real(r8) :: nop (pcols,pver) ! NO+ (mmr) + real(r8) :: barm (pcols,pver) ! mean molecular weight (g/mole) + real(r8) :: xnmbar (pcols,pver) ! for unit conversion to volume density + real(r8) :: tnti (pcols,pver) ! average of tn and ti + real(r8) :: o2_cm3 (pcols,pver) ! o2 volume density (cm-3) + real(r8) :: o1_cm3 (pcols,pver) ! o volume density (cm-3) + real(r8) :: n2_cm3 (pcols,pver) ! n2 volume density (cm-3) + real(r8) :: o2p_cm3 (pcols,pver) ! O2+ (cm-3) + real(r8) :: op_cm3 (pcols,pver) ! O+ (cm-3) + real(r8) :: nop_cm3 (pcols,pver) ! NO+ (cm-3) + real(r8) :: ne_sigmas(pcols,pver) ! electron density for conductivities + real(r8) :: lamda1 (pcols,pver) ! sigped*b**2/rho + real(r8) :: lamda2 (pcols,pver) ! sighal*b**2/rho + real(r8) :: lxxnorot(pcols,pver) ! XX before rotation + real(r8) :: lyynorot(pcols,pver) ! YY before rotation + real(r8) :: lxynorot(pcols,pver) ! XY before rotation + + !------------------------------------------------------------------------------- + ! Ion-neutral momentum transfer collision frequencies. + ! rnu_xxx_xx = ratio of collision to gyro-frequences for O2+, O+, NO+. + !------------------------------------------------------------------------------- + real(r8) :: rnu_o2p_o2(pcols,pver) ! O2+ ~ O2 collision freq (resonant, T dependent) + real(r8) :: rnu_op_o2 (pcols,pver) ! O+ ~ O2 collision freq (non-resonant) + real(r8) :: rnu_nop_o2(pcols,pver) ! NO+ ~ O2 collision freq (non-resonant) + real(r8) :: rnu_o2p_o (pcols,pver) ! O2+ ~ O collision freq (non-resonant) + real(r8) :: rnu_op_o (pcols,pver) ! O+ ~ O collision freq (resonant, T dependent) + real(r8) :: rnu_nop_o (pcols,pver) ! NO+ ~ O collision freq (non-resonant) + real(r8) :: rnu_o2p_n2(pcols,pver) ! O2+ ~ N2 collision freq (non-resonant) + real(r8) :: rnu_op_n2 (pcols,pver) ! O+ ~ N2 collision freq (non-resonant) + real(r8) :: rnu_nop_n2(pcols,pver) ! NO+ ~ N2 collision freq (non-resonant) + real(r8) :: rnu_o2p (pcols,pver) ! [[o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~n2]n(n2)]/w(o2p) + real(r8) :: rnu_op (pcols,pver) ! [[op ~o2]n(o2)+[op ~o]n(o)+[op ~n2]n(n2)]/w(op ) + real(r8) :: rnu_nop (pcols,pver) ! [[nop~o2]n(o2)+[nop~o]n(o)+[nop~n2]n(n2)]/w(nop) + real(r8) :: rnu_ne (pcols,pver) ! electron ~ neutral collision frequency (s-1) + + real(r8) :: press (pcols) ! pressure at interface levels (dyne/cm^2) + real(r8) :: qe_fac (pcols) ! unit conversion factor for conductivities + real(r8) :: dipmag (pcols) ! magnetic dip angle + real(r8) :: decmag (pcols) ! magnetic declination + real(r8) :: btesla (pcols) ! magnetic field (teslas) + real(r8) :: sindip (pcols) ! sin(dipmag) + real(r8) :: sin2dip (pcols) ! sindip^2 + real(r8) :: sindec (pcols) ! sin(decmag) + real(r8) :: cosdec (pcols) ! cos(decmag) + real(r8) :: sin2dec (pcols) ! sindec^2 + real(r8) :: cos2dec (pcols) ! cosdec^2 + real(r8) :: omega_o2p (pcols) ! angular gyrofrequency for o2+ (s-1) + real(r8) :: omega_op (pcols) ! angular gyrofrequency for o+ (s-1) + real(r8) :: omega_nop (pcols) ! angular gyrofrequency for no+ (s-1) + real(r8) :: omega_e (pcols) ! electron angular gyrofrequency (s-1) + real(r8) :: omega_o2p_inv(pcols) ! inverse of o2+ gyrofrequency + real(r8) :: omega_op_inv (pcols) ! inverse of o+ gyrofrequency + real(r8) :: omega_nop_inv(pcols) ! inverse of no+ gyrofrequency + real(r8) :: omega_e_inv (pcols) ! inverse of electron gyrofrequency + + !------------------------------------------------------------------------------- + ! Ion drag coefficients output: + !------------------------------------------------------------------------------- + real(r8) :: lxx(pcols,pver) ! lambda XX coefficients (s-1) + real(r8) :: lyy(pcols,pver) ! lambda YY coefficients (s-1) + real(r8) :: lxy(pcols,pver) ! lambda XY coefficients (s-1) + real(r8) :: lyx(pcols,pver) ! lambda YX coefficients (s-1) + + !------------------------------------------------------------------------------- + ! Conductivities output: + !------------------------------------------------------------------------------- + real(r8) :: sigma_ped (pcols,pver) ! pedersen conductivity (siemens/m) + real(r8) :: sigma_hall(pcols,pver) ! hall conductivity (siemens/m) + + real(r8) :: qout(pcols,pver) ! temp for outfld + + real(r8), dimension(:,:), pointer :: q_xo1, q_xo2, q_o2p, q_op, q_nop + + real(r8), dimension(:,:), pointer :: tE ! electron temperature in pbuf (K) + real(r8), dimension(:,:), pointer :: tI ! ion temperature in pbuf (K) + + if (.not.doiodrg) return + + call outfld ('BNORTH', bnorth(:,lchnk), pcols, lchnk ) + call outfld ('BEAST' , beast(:,lchnk), pcols, lchnk ) + call outfld ('BDOWN' , bdown(:,lchnk), pcols, lchnk ) + call outfld ('BMAG' , bmag(:,lchnk), pcols, lchnk ) + + if ( xo1_slvd ) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, q_xo1, start=(/1,1,id_xo1/), kount=(/pcols,pver,1/) ) + else + q_xo1 => state%q(:,:,id_xo1) + endif + if ( xo2_slvd ) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, q_xo2, start=(/1,1,id_xo2/), kount=(/pcols,pver,1/) ) + else + q_xo2 => state%q(:,:,id_xo2) + endif + if ( o2p_slvd ) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, q_o2p, start=(/1,1,id_o2p/), kount=(/pcols,pver,1/) ) + else + q_o2p => state%q(:,:,id_o2p) + endif + if ( op_slvd ) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, q_op, start=(/1,1,id_op/), kount=(/pcols,pver,1/) ) + else + q_op => state%q(:,:,id_op) + endif + if ( nop_slvd ) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, q_nop, start=(/1,1,id_nop/), kount=(/pcols,pver,1/) ) + else + q_nop => state%q(:,:,id_nop) + endif + + !------------------------------------------------------------------------------- + ! Define local tn and major species from state (mmr): + !------------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + tn (i,k) = state%t(i,k) + xo2(i,k) = q_xo2(i,k) ! o2 (mmr) + xo1(i,k) = q_xo1(i,k) ! o (mmr) + xn2(i,k) = 1._r8 - (xo2(i,k) + xo1(i,k)) ! n2 (mmr) + xn2(i,k) = max( 1.e-20_r8,xn2(i,k) ) + o2p(i,k) = q_o2p(i,k) ! o2+ (mmr) + op (i,k) = q_op(i,k) ! o+ (mmr) + nop(i,k) = q_nop(i,k) ! no+ (mmr) + end do + end do + + !-------------------------------------------------------------------------------------------------- + ! For WACCM-X, grab electron (TE) and ion (TI) temperatures from pbuf from ionosphere module + !-------------------------------------------------------------------------------------------------- + if ( indxTe>0 .and. indxTi>0 .and. .not. is_first_step() ) then + call pbuf_get_field(pbuf, indxTe, tE) + call pbuf_get_field(pbuf, indxTi, tI) + else + tE => tn + tI => tn + endif + + qout(:ncol,:) = o2p(:ncol,:) + op(:ncol,:) + nop(:ncol,:) + call outfld ('QIONSUM ', qout, pcols, lchnk) + + !------------------------------------------------------------------------------- + ! calculate empirical ExB drift velocities if not using edynamo drifts + ! (if edynamo calculated the drifts, then they are already in pbuf%ui, etc.) + !------------------------------------------------------------------------------- + if (empirical_ion_velocities .or. (is_first_step().and..not.ionvels_read_from_file)) then + call t_startf ( 'exbdrift_ion_vels' ) + call exbdrift_ion_vels( lchnk, ncol, pbuf) + call t_stopf ( 'exbdrift_ion_vels' ) + endif + + !------------------------------------------------------------------------------- + + do i = 1,ncol + btesla(i) = bmag(i,lchnk)*1.e-9_r8 ! nT to teslas (see bmag in apex module) + !------------------------------------------------------------------------------- + ! Angular gyrofrequency of O+, O2+ and NO+ (s-1): + !------------------------------------------------------------------------------- + omega_op (i) = qe*btesla(i)*rmi_op_kg + omega_o2p(i) = qe*btesla(i)*rmi_o2p_kg + omega_nop(i) = qe*btesla(i)*rmi_nop_kg + !------------------------------------------------------------------------------- + ! Electron angular gyrofrequency (s-1): + !------------------------------------------------------------------------------- + omega_e(i) = qe*btesla(i)/emass + !------------------------------------------------------------------------------- + ! Invert now, so we can multiply rather than divide in loops below: + !------------------------------------------------------------------------------- + omega_op_inv (i) = 1._r8/omega_op(i) + omega_o2p_inv(i) = 1._r8/omega_o2p(i) + omega_nop_inv(i) = 1._r8/omega_nop(i) + omega_e_inv(i) = 1._r8/omega_e(i) + !------------------------------------------------------------------------------- + ! Magnetic field geometry (used below in rotation of lambdas): + !------------------------------------------------------------------------------- + dipmag(i) = atan( bdown(i,lchnk)/sqrt(bnorth(i,lchnk)**2+beast(i,lchnk)**2) ) + decmag(i) = -atan2( beast(i,lchnk),bnorth(i,lchnk) ) + cosdec(i) = cos( decmag(i) ) + sindec(i) = sin( decmag(i) ) + if( abs(dipmag(i)) >= dipmin ) then + sindip(i) = sin(dipmag(i)) + else + if( dipmag(i) >= 0._r8 ) then + sindip(i) = sin( dipmin ) + else + sindip(i) = sin( -dipmin ) + end if + end if + sin2dip(i) = sindip(i)**2 + sin2dec(i) = sindec(i)**2 + cos2dec(i) = cosdec(i)**2 + end do + + ! write(iulog,"('iondrag: btesla=', /,(6e12.4))") btesla + ! write(iulog,"('iondrag: bdown=', /,(6e12.4))") bdown(:,lchnk) + ! write(iulog,"('iondrag: beast=', /,(6e12.4))") beast(:,lchnk) + ! write(iulog,"('iondrag: bnorth=', /,(6e12.4))") bnorth(:,lchnk) + ! write(iulog,"('iondrag: omega_o2p=',/,(6e12.4))") omega_o2p + ! write(iulog,"('iondrag: omega_op=' ,/,(6e12.4))") omega_op + ! write(iulog,"('iondrag: omega_nop=',/,(6e12.4))") omega_nop + + !------------------------------------------------------------------------------- + ! Ion-neutral momentum transfer collision frequency coefficients: + !------------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + tnti(i,k) = 0.5_r8*(tI(i,k) + tn(i,k)) ! ave of tn & ti + sqrt_tnti = sqrt( tnti(i,k) ) + wrk = log10( tnti(i,k) ) + !------------------------------------------------------------------------------- + ! Collision frequency coefficients with O2 (cm3/s): + !------------------------------------------------------------------------------- + rnu_o2p_o2(i,k) = 2.59e-11_r8*sqrt_tnti & ! O2+ ~ O2 (resonant) + *(1._r8 - .073_r8*wrk)**2 + rnu_op_o2 (i,k) = 6.64e-10_r8 ! O+ ~ O2 + rnu_nop_o2(i,k) = 4.27e-10_r8 ! NO+ ~ O2 + !------------------------------------------------------------------------------- + ! Collision frequency coefficients with O (cm3/s): + !------------------------------------------------------------------------------- + rnu_o2p_o(i,k) = 2.31e-10_r8 ! O2+ ~ O + rnu_op_o (i,k) = 3.67e-11_r8*sqrt_tnti & ! O+ ~ O (resonant) + *(1._r8 - .064_r8*wrk)**2*colfac + rnu_nop_o(i,k) = 2.44e-10_r8 ! NO+ ~ O + !------------------------------------------------------------------------------- + ! Collision frequency coefficients with N2 (cm3/s): + !------------------------------------------------------------------------------- + rnu_o2p_n2(i,k) = 4.13e-10_r8 ! O2+ ~ N2 + rnu_op_n2 (i,k) = 6.82e-10_r8 ! O+ ~ N2 + rnu_nop_n2(i,k) = 4.34e-10_r8 ! NO+ ~ N2 + end do + end do + + !------------------------------------------------------------------------------- + ! Sub set_mean_mass (mo_mean_mass.F90) returns barm(ncol,pver) in g/mole, + ! however, set_mean_mass sometimes returns zero in top(?) four values + ! of the column, so barm is calculated here, see below. + ! + ! call set_mean_mass(ncol, state%q(1,1,imozart), barm) + ! + ! Major species and ion number densities (mmr to cm-3): + !------------------------------------------------------------------------------- + + call set_mean_mass( ncol, state%q(:,:,imozart:), barm ) + + do k = 1,pver + do i = 1,ncol + press(i) = 10._r8*state%pmid(i,k) ! from Pa to dyne/cm^2 + ! barm(i,k) = 1._r8 / (xo2(i,k)*rmi_o2 + xo1(i,k)*rmi_o1 + xn2(i,k)*rmi_n2) + xnmbar(i,k) = press(i)*barm(i,k)/(boltzmann*tn(i,k)) + o2_cm3(i,k) = xo2(i,k)*xnmbar(i,k)*rmi_o2 ! o2 (cm-3) + o1_cm3(i,k) = xo1(i,k)*xnmbar(i,k)*rmi_o1 ! o (cm-3) + n2_cm3(i,k) = xn2(i,k)*xnmbar(i,k)*rmi_n2 ! n2 (cm-3) + o2p_cm3(i,k) = o2p(i,k)*xnmbar(i,k)*rmi_o2p ! o2+ (cm-3) + op_cm3 (i,k) = op (i,k)*xnmbar(i,k)*rmi_op ! o+ (cm-3) + nop_cm3(i,k) = nop(i,k)*xnmbar(i,k)*rmi_nop ! no+ (cm-3) +! +!---------------------------------------------------------------------------------- +! Use sum of the 3 major ion number densities (as in tiegcm) +!---------------------------------------------------------------------------------- +! + ne_sigmas(i,k) = op_cm3(i,k) + o2p_cm3(i,k) + nop_cm3(i,k) + end do + end do + + !------------------------------------------------------------------------------- + ! Multiply collision freq by neutral number density and sum for each ion: + ! + ! rnu_o2p = [[o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~n2]n(n2)]/w(o2p) + ! rnu_op = [[op ~o2]n(o2)+[op ~o]n(o)+[op ~n2]n(n2)]/w(op ) + ! rnu_nop = [[nop~o2]n(o2)+[nop~o]n(o)+[nop~n2]n(n2)]/w(nop) + !------------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + rnu_o2p(i,k) = rnu_o2p_o2(i,k)*o2_cm3(i,k) & + + rnu_o2p_o (i,k)*o1_cm3(i,k) & + + rnu_o2p_n2(i,k)*n2_cm3(i,k) + rnu_op (i,k) = rnu_op_o2 (i,k)*o2_cm3(i,k) & + + rnu_op_o (i,k)*o1_cm3(i,k) & + + rnu_op_n2 (i,k)*n2_cm3(i,k) + rnu_nop(i,k) = rnu_nop_o2(i,k)*o2_cm3(i,k) & + + rnu_nop_o (i,k)*o1_cm3(i,k) & + + rnu_nop_n2(i,k)*n2_cm3(i,k) + !------------------------------------------------------------------------------- + ! Electron collision frequency (s-1): + !------------------------------------------------------------------------------- + sqrt_te = sqrt(tE(i,k)) + rnu_ne(i,k) = & + 2.33e-11_r8*n2_cm3(i,k)*tE(i,k)*(1._r8 - 1.21e-4_r8*tE(i,k)) & + + 1.82e-10_r8*o2_cm3(i,k)*sqrt_te*(1._r8 + 3.60e-2_r8*sqrt_te) & + + 8.90e-11_r8*o1_cm3(i,k)*sqrt_te*(1._r8 + 5.70e-4_r8*tE(i,k)) + end do + end do + + !------------------------------------------------------------------------------- + ! Ratio of collision to gyro frequencies for o2+, o+, no+, ne: + !------------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + rnu_o2p(i,k) = rnu_o2p(i,k)*omega_o2p_inv(i) + rnu_op (i,k) = rnu_op (i,k)*omega_op_inv (i) + rnu_nop(i,k) = rnu_nop(i,k)*omega_nop_inv(i) + rnu_ne (i,k) = rnu_ne (i,k)*omega_e_inv (i) + end do + end do + + !------------------------------------------------------------------------------- + ! Calculate pedersen and Hall conductivities (siemens/m): + ! + ! Qe_fac: 1.e6 to convert number densities from cm-3 to m-3: + !------------------------------------------------------------------------------- + qe_fac(:ncol) = qe*1.e6_r8/btesla(:ncol) + + do k = 1,pver + do i = 1,ncol + + !------------------------------------------------------------------------------- + ! Pedersen conductivity (siemens/m): + !------------------------------------------------------------------------------- + sigma_ped(i,k) = qe_fac(i) & + *((op_cm3 (i,k)*rnu_op (i,k)/(1._r8 + rnu_op (i,k)**2)) & + + (o2p_cm3 (i,k)*rnu_o2p(i,k)/(1._r8 + rnu_o2p(i,k)**2)) & + + (nop_cm3 (i,k)*rnu_nop(i,k)/(1._r8 + rnu_nop(i,k)**2)) & + + (ne_sigmas(i,k)*rnu_ne (i,k)/(1._r8 + rnu_ne (i,k)**2))) + !------------------------------------------------------------------------------- + ! Hall conductivity (siemens/m): + !------------------------------------------------------------------------------- + sigma_hall(i,k) = qe_fac(i) & + *(ne_sigmas(i,k)/(1._r8 + rnu_ne (i,k)**2) & + - op_cm3 (i,k)/(1._r8 + rnu_op (i,k)**2) & + - o2p_cm3 (i,k)/(1._r8 + rnu_o2p(i,k)**2) & + - nop_cm3 (i,k)/(1._r8 + rnu_nop(i,k)**2)) + end do + end do + + call outfld ('ELECDEN ',ne_sigmas ,pcols,lchnk) + call outfld ('SIGMAPED',sigma_ped ,pcols,lchnk) + call outfld ('SIGMAHAL',sigma_hall,pcols,lchnk) + + !-------------------------------------------------------------------------------------------- + ! Save conductivities in physics buffer using pointer for access in ionosphere module + !-------------------------------------------------------------------------------------------- + if ( waccmx_is('ionosphere') ) then + call pbuf_set_field(pbuf, PedConduct_idx, sigma_ped(1:ncol,1:pver), start=(/1,1/), kount=(/ncol,pver/) ) + call pbuf_set_field(pbuf, HallConduct_idx, sigma_hall(1:ncol,1:pver), start=(/1,1/), kount=(/ncol,pver/) ) + endif + + do k = 1,pver + do i = 1,ncol + wrk = btesla(i)**2*avo*1.e-3_r8/xnmbar(i,k) + lamda1(i,k) = sigma_ped(i,k)*wrk + lamda2(i,k) = sigma_hall(i,k)*wrk + end do + end do + + call outfld ('LAMDA1',lamda1,pcols,lchnk) + call outfld ('LAMDA2',lamda2,pcols,lchnk) + + do k = 1,pver + do i = 1,ncol + lxxnorot(i,k) = lamda1(i,k) + lyynorot(i,k) = lamda1(i,k)*sin2dip(i) + lxynorot(i,k) = lamda2(i,k)*sindip(i) + end do + end do + + !------------------------------------------------------------------------------- + ! Rotate lambdas from local magnetic to geographic coordinates: + !------------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + lxx(i,k) = lxxnorot(i,k)*cos2dec(i) + lyynorot(i,k)*sin2dec(i) + lyy(i,k) = lyynorot(i,k)*cos2dec(i) + lxxnorot(i,k)*sin2dec(i) + wrk = (lyynorot(i,k) - lxxnorot(i,k))*sindec(i)*cosdec(i) + lyx(i,k) = lxynorot(i,k) - wrk + lxy(i,k) = lxynorot(i,k) + wrk + end do + end do + + call outfld ('LXX ',lxx,pcols,lchnk) + call outfld ('LYY ',lyy,pcols,lchnk) + call outfld ('LXY ',lxy,pcols,lchnk) + call outfld ('LYX ',lyx,pcols,lchnk) + + call physics_ptend_init(ptend, state%psetcols, "ion drag", lu=.true., lv=.true., ls=.true.) + + !------------------------------------------------------------------------------- + ! Calculate ion drag tendencies and apply to neutral velocities: + !------------------------------------------------------------------------------- + call iondrag_tend( lchnk, ncol, state, ptend, pbuf, & + lxx, lyy, lxy, lyx, delt ) + + !------------------------------------------------------------------------------- + ! Calculate joule heating tendency and apply to temperature: + !------------------------------------------------------------------------------- + call jouleheat_tend( lchnk, ncol, state, ptend, pbuf, & + lxx, lyy, lxy, lyx ) + + end subroutine iondrag_calc_ions + + !========================================================================= + + subroutine iondrag_calc_ghg (lchnk,ncol,state,ptend) + + use phys_grid, only: get_rlat_all_p + use cam_history, only: outfld + use physics_types, only: physics_ptend_init + + + ! + ! This subroutine calculates ion drag using globally uniform + ! ion drag tensor: + ! + ! |alamxx alamxy | + ! | | + ! lambda=| | + ! | | + ! |alamyx alamyy | + ! + ! alamxx and alamxy are provided is data statements + ! alamyy is obtaine from alamxx: + ! + ! + ! alamyy = alamxx (sin(DIP_ANGLE))**2 + ! + ! where + ! + ! DIP_ANGLE = arctan(2.*tan(clat)) + ! + + !--------------------Input arguments------------------------------------ + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + + type(physics_state), intent(in) :: state + type(physics_ptend ), intent(out) :: ptend + + + + !---------------------Local workspace------------------------------------- + + real(r8) :: clat(pcols) ! latitudes(radians) for columns + + real(r8) alamyyi ! ALAMYY + real(r8) dipan ! dip angle + real(r8) dut(pcols,pver) + real(r8) dvt(pcols,pver) + + integer i + integer k + + !------------------------------------------------------------------------- + + if (.not.doiodrg) then + call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update + return + end if + + call physics_ptend_init(ptend, state%psetcols, "ion drag", lu=.true., lv=.true.) + + call get_rlat_all_p(lchnk, pcols, clat) + + ! calculate zonal wind drag + dut(:,:)=0.0_r8 + do i=1,ncol + do k=ntop_lev,nbot_lev + dut(i,k)=-alamxyi(k)*state%v(i,k)-alamxxi(k)*state%u(i,k) + enddo + enddo + + ! calculate meridional wind drag + dvt(:,:)=0.0_r8 + do i=1,ncol + dipan=atan(2._r8*tan(clat(i))) + do k=ntop_lev,nbot_lev + alamyyi=alamxxi(k)*(sin(dipan))**2._r8 + dvt(i,k)=+alamxyi(k)*state%u(i,k)-alamyyi*state%v(i,k) + enddo + enddo + + do i=1,ncol + do k=ntop_lev,nbot_lev + ptend%u(i,k)=dut(i,k) + ptend%v(i,k)=dvt(i,k) + enddo + enddo + + ! Write out tendencies + call outfld('UIONTEND ',dut ,pcols ,lchnk ) + call outfld('VIONTEND ',dvt ,pcols ,lchnk ) + + return + end subroutine iondrag_calc_ghg + + !=================================================================================== + + subroutine iondrag_tend( lchnk, ncol, state, ptend, pbuf, & + lxx, lyy, lxy, lyx, delt ) + + !------------------------------------------------------------------------------- + ! Calculate tendencies in U and V from ion drag tensors, which were + ! calculated by sub iondrag_calc (module data lxx,lyy,lxy,lyx). + ! This is called from sub iondrag_calc. + !------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + integer,intent(in) :: lchnk ! current chunk index + integer,intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: lxx(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lyy(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lxy(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lyx(pcols,pver) ! ion drag tensor + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! Physics tendencies + + type(physics_buffer_desc), pointer :: pbuf(:) + + + !------------------------------------------------------------------------------- + ! Local variables + !------------------------------------------------------------------------------- + integer :: i, k + real(r8) :: dti + real(r8) :: detr + real(r8) :: us, vs + real(r8) :: l11, l12, l21, l22 + real(r8) :: dui(pcols,pver) ! zonal ion drag tendency + real(r8) :: dvi(pcols,pver) ! meridional ion drag tendency + real(r8), pointer :: ui(:,:) ! pointer to 3d zonal ion drift from edynamo + real(r8), pointer :: vi(:,:) ! pointer to 3d meridional ion drift from edynamo + real(r8), pointer :: wi(:,:) ! pointer to 3d vertical ion drift from edynamo + + !------------------------------------------------------------------------------- + ! Get ion ExB drift from physics buffer (they were defined by either the exbdrift + ! module in chemistry (2d), or the dynamo module in dynamics dpie_coupling (3d), + ! depending on the switch empirical_ion_velocities. If using dynamo drifts, + ! they were put into pbuf by dp_coupling. If using empirical exbdrifts, then + ! they are redundant in the vertical dimension (i.e., 2d only). + !------------------------------------------------------------------------------- + call pbuf_get_field(pbuf, ui_idx, ui) + call pbuf_get_field(pbuf, vi_idx, vi) + call pbuf_get_field(pbuf, wi_idx, wi) + + dti = 1._r8/delt + !------------------------------------------------------------------------------- + ! Zonal (du) and meridional (dv) wind drag, using ExB drift velocities + ! from exbdrift module (pbuf): + !------------------------------------------------------------------------------- + do k = ntop_lev,nbot_lev + do i = 1,ncol + !------------------------------------------------------------------------------- + ! 2/28/04 btf: + ! Full ion-drag, using lambdas and ExB drifts. + ! This should succeed with bz = 0 (efield module) + ! Runs: + ! bz=-5, nstep=24 min, nsplit=4 (6 min dynamics): crashed after 2 days. + ! bz=-5, nstep=24 min, nsplit=6 (4 min dynamics): 5 day run succeeded. + ! See comments in efield module re bz < 0 (efield.F90). + ! Ion drifts are from edynamo if use_dynamo_drifts=true, exbdrift otherwise. + !------------------------------------------------------------------------------- + us = ui(i,k) - state%u(i,k) + vs = vi(i,k) - state%v(i,k) + + !------------------------------------------------------------------------------- + ! Exclude ue,ve drift momentum source to avoid crashes when bz < 0 and + ! full 30 min timestep (partial ion-drag): + !------------------------------------------------------------------------------- + l11 = dti + lxx(i,k) + l12 = lxy(i,k) + l21 = -lyx(i,k) + l22 = dti + lyy(i,k) + detr = dti/(l11*l22 - l12*l21) + dui(i,k) = dti*(detr*(l12*vs - l22*us) + us) + dvi(i,k) = dti*(detr*(l21*us - l11*vs) + vs) + end do + end do + + !------------------------------------------------------------------------------- + ! Apply to model tendencies: + !------------------------------------------------------------------------------- + do k = ntop_lev,nbot_lev + !------------------------------------------------------------------------------- + ! Ion drag tendencies: + !------------------------------------------------------------------------------- + ptend%u(:ncol,k) = dui(:ncol,k) + ptend%v(:ncol,k) = dvi(:ncol,k) + !------------------------------------------------------------------------------- + ! Turn off ion drag tendency: + !------------------------------------------------------------------------------- + ! ptend%u(:ncol,k) = 0._r8 + ! ptend%v(:ncol,k) = 0._r8 + end do + do k = nbot_lev+1,pver + dui(:ncol,k) = 0._r8 + dvi(:ncol,k) = 0._r8 + ptend%u(:ncol,k) = 0._r8 + ptend%v(:ncol,k) = 0._r8 + end do + +! +! Ion drifts are either empirical (use_dynamo_drifts==false), or from edynamo +! (use_dynamo_drifts==true). See addfld calls in this source file. +! If empirical, the drifts will be 2d (i.e., redundant in the vertical dimension) +! + if (empirical_ion_velocities) then + call outfld ( 'UI', ui, pcols, lchnk ) + call outfld ( 'VI', vi, pcols, lchnk ) + call outfld ( 'WI', wi, pcols, lchnk ) + endif + + call outfld ( 'UIONTEND', dui, pcols, lchnk ) ! u ion drag tendency + call outfld ( 'VIONTEND', dvi, pcols, lchnk ) ! v ion drag tendency + + end subroutine iondrag_tend + + !================================================================================================ + subroutine jouleheat_tend( lchnk, ncol, state, ptend, pbuf, & + lxx, lyy, lxy, lyx ) + !------------------------------------------------------------------------------- + ! Calculate tendencies in T due to joule heating. + ! This is called from sub iondrag_calc. + !------------------------------------------------------------------------------- + + use physconst, only: pi,cpairv + use phys_grid, only: get_rlon_p, get_rlat_p + + !------------------------------------------------------------------------------- + ! dummy arguments + !------------------------------------------------------------------------------- + integer,intent(in) :: lchnk ! current chunk index + integer,intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: lxx(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lyy(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lxy(pcols,pver) ! ion drag tensor + real(r8), intent(in) :: lyx(pcols,pver) ! ion drag tensor + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! Physics tendencies (inout) + + type(physics_buffer_desc), pointer :: pbuf(:) + + !------------------------------------------------------------------------------- + ! Local variables + !------------------------------------------------------------------------------- + integer :: k, i + integer :: max_ind(2) + real(r8) :: us, vs + real(r8) :: max_q + real(r8) :: qjoule(pcols,pver) ! joule heating + real(r8) :: qout(pcols,pver) ! temp for outfld + real(r8), pointer :: ui(:,:) ! pointer to pbuf + real(r8), pointer :: vi(:,:) ! pointer to pbuf + + logical, parameter :: debug = .false. + + !------------------------------------------------------------------------------- + ! Get ion velocities from physics buffer (they were defined by exbdrift module) + ! Ion velocities are 2d arrays, i.e., no vertical dimension. + !------------------------------------------------------------------------------- + call pbuf_get_field(pbuf, ui_idx, ui ) + call pbuf_get_field(pbuf, vi_idx, vi ) + + do k = ntop_lev,nbot_lev + ! write(iulog,"('qjoule: k=',i3,' u=',/,(6e12.4))") k,state%u(:,k) + ! write(iulog,"('qjoule: k=',i3,' v=',/,(6e12.4))") k,state%v(:,k) + ! write(iulog,"('qjoule: k=',i3,' lxx=',/,(6e12.4))") k,lxx(:,k) + ! write(iulog,"('qjoule: k=',i3,' lxy=',/,(6e12.4))") k,lxy(:,k) + ! write(iulog,"('qjoule: k=',i3,' lyx=',/,(6e12.4))") k,lyx(:,k) + ! write(iulog,"('qjoule: k=',i3,' lyy=',/,(6e12.4))") k,lyy(:,k) + do i = 1,ncol + us = ui(i,k) - state%u(i,k) + vs = vi(i,k) - state%v(i,k) + qjoule(i,k) = us*us*lxx(i,k) + us*vs*(lxy(i,k) - lyx(i,k)) + vs*vs*lyy(i,k) + ptend%s(i,k) = qjoule(i,k) ! joule heating tendency + ! ptend%s(i,k) = 0._r8 ! no joule heating tendency + end do + ! write(iulog,"('qjoule: k=',i3,' qjoule(:,k)=',/,(6e12.4))") k,qjoule(:,k) + end do + do k = nbot_lev+1,pver + qjoule(:ncol,k) = 0._r8 + ptend%s(:ncol,k) = 0._r8 ! no joule heating tendency + end do + + sw_debug: if (debug) then + max_q = 100._r8*maxval( abs( qjoule(:ncol,ntop_lev:nbot_lev) )/state%t(:ncol,ntop_lev:nbot_lev) ) + max_ind(:) = maxloc( abs( qjoule(:ncol,ntop_lev:nbot_lev) )/state%t(:ncol,ntop_lev:nbot_lev) ) + i = max_ind(1) + k = max_ind(2) + if( lchnk == 25 ) then + i = 14 + k = 3 + write(iulog,*) ' ' + write(iulog,*) '-------------------------------------------------------' + write(iulog,*) 'jouleheat_tend: lon,lat = ',get_rlon_p(lchnk,14)*180._r8/pi, get_rlat_p(lchnk,14)*180._r8/pi + write(iulog,*) 'jouleheat_tend: dt,t,max% dt/t = ',qjoule(i,k)/cpairv(i,k,lchnk),state%t(i,k),max_q, & + ' @ lchnk,i,k = ',lchnk,max_ind(:) + write(iulog,*) 'jouleheat_tend: lxx,xy,yx,yy = ',lxx(i,k),lxy(i,k),lyx(i,k),lyy(i,k) + write(iulog,*) 'jouleheat_tend: u,ui,v,vi = ',state%u(i,k),ui(i,k),state%v(i,k),vi(i,k) + write(iulog,*) 'jouleheat_tend: us,vs = ',ui(i,k) - state%u(i,k),vi(i,k) - state%v(i,k) + write(iulog,*) 'jouleheat_tend: du,dv = ',ptend%u(i,k),ptend%v(i,k) + write(iulog,*) 'jouleheat_tend: dt' + write(iulog,'(1p,5g15.7)') qjoule(max_ind(1),ntop_lev:nbot_lev)/cpairv(max_ind(1),ntop_lev:nbot_lev,lchnk) + write(iulog,*) '-------------------------------------------------------' + write(iulog,*) ' ' + ! stop 'diagnostics' + end if + endif sw_debug + + qout(:ncol,:) = qjoule(:ncol,:)/cpairv(:ncol,:,lchnk) + + call outfld ( 'QJOULE', qout, pcols, lchnk ) + + end subroutine jouleheat_tend + +!============================================================================== + + subroutine iondrag_inidat(ncid_ini, pbuf2d) + + use pio, only: file_desc_t + use ncdio_atm,only: infld + use infnan, only: nan, assignment(=) + use cam_grid_support, only : cam_grid_check, cam_grid_id, cam_grid_get_dim_names + use physics_buffer, only : pbuf_set_field + + ! args + type(file_desc_t), intent(inout) :: ncid_ini ! Initial condition file id + type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Physics buffer + + ! local vars + real(r8), pointer :: ui_tmp(:,:,:) + real(r8), pointer :: vi_tmp(:,:,:) + real(r8), pointer :: wi_tmp(:,:,:) + real(r8) :: nanval + integer :: grid_id + character(len=4) :: dim1name, dim2name + character(len=*), parameter :: subname='iondrag_inidat' + logical :: found_ui, found_vi, found_wi + + allocate(ui_tmp(pcols,pver,begchunk:endchunk)) + allocate(vi_tmp(pcols,pver,begchunk:endchunk)) + allocate(wi_tmp(pcols,pver,begchunk:endchunk)) + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + call infld( 'UI',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + ui_tmp, found_ui, gridname='physgrid') + call infld( 'VI',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + vi_tmp, found_vi, gridname='physgrid') + call infld( 'WI',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + wi_tmp, found_wi, gridname='physgrid') + + ionvels_read_from_file = found_ui .and. found_vi .and. found_wi + + ui_idx = pbuf_get_index('UI') + vi_idx = pbuf_get_index('VI') + wi_idx = pbuf_get_index('WI') + + if (ionvels_read_from_file) then + call pbuf_set_field(pbuf2d, ui_idx, ui_tmp) + call pbuf_set_field(pbuf2d, vi_idx, vi_tmp) + call pbuf_set_field(pbuf2d, wi_idx, wi_tmp) + else + nanval=nan + call pbuf_set_field(pbuf2d, ui_idx, nanval) + call pbuf_set_field(pbuf2d, vi_idx, nanval) + call pbuf_set_field(pbuf2d, wi_idx, nanval) + endif + + deallocate( ui_tmp ) + deallocate( vi_tmp ) + deallocate( wi_tmp ) + + end subroutine iondrag_inidat + +end module iondrag diff --git a/src/physics/waccm/mag_parms.F90 b/src/physics/waccm/mag_parms.F90 new file mode 100644 index 0000000000..4cf4b21860 --- /dev/null +++ b/src/physics/waccm/mag_parms.F90 @@ -0,0 +1,80 @@ + + module mag_parms + + use shr_kind_mod, only : r8 => shr_kind_r8 + use solar_parms_data, only : wkp=>solar_parms_kp, wf107=>solar_parms_f107 + use wei05sc, only : ctpoten_weimer + use cam_abortutils, only : endrun + + implicit none + + private + public :: get_mag_parms + public :: mag_parms_setopts + + character(len=16), public, protected :: highlat_potential_model = 'none' + + contains + + subroutine mag_parms_setopts( potential_model ) + character(len=*), intent(in) :: potential_model + + if ( .not.(trim(potential_model).eq.'heelis' .or. trim(potential_model).eq.'weimer') ) then + call endrun('mag_parms_setopts: potential_model must be heelis or weimer') + endif + + highlat_potential_model = trim(potential_model) + end subroutine mag_parms_setopts + + subroutine get_mag_parms( by, bz, hpower, ctpoten ) +!--------------------------------------------------------------- +! ... retrieve magnetic field parmaters +!--------------------------------------------------------------- + + implicit none + +!--------------------------------------------------------------- +! ... dummy arguments +!--------------------------------------------------------------- + real(r8), optional, intent(out) :: by + real(r8), optional, intent(out) :: bz + real(r8), optional, intent(out) :: hpower + real(r8), optional, intent(out) :: ctpoten + + if( present( by ) ) then + by = 0._r8 + end if + if( present( bz ) ) then + bz = .433726_r8 - wkp*(.0849999_r8*wkp + .0810363_r8) & + + wf107*(.00793738_r8 - .00219316_r8*wkp) + end if +! modified by LQIAN, 2008 +! for wkp<=7: formula given by Zhang Yongliang based on TIMED/GUVI +! for wkp>7: power is 153.13 when wkp=7 from Zhang's formula, +! assume power is 300.(based on NOAA satellites) when wkp=9 +! do linear interporation in between + if( present( hpower ) ) then + if (wkp <=7._r8) hpower = 16.82_r8*exp(0.32_r8*wkp)-4.86_r8 + if (wkp > 7._r8) hpower = 153.13_r8+(wkp-7._r8)/ & + (9._r8-7._r8)*(300._r8-153.13_r8) + + end if +! +! modified by LQIAN, 2008 +! formula given by Wenbin based on data fitting +! +! 9/18/15 btf: If Weimer model was used for high-latitude potential, +! then use ctpoten that was returned by weimer (see sub weimer05 in +! wei05sc.F90, called by dpie_coupling.F90) +! + if( present( ctpoten ) ) then + if (trim(highlat_potential_model) == 'weimer') then + ctpoten = ctpoten_weimer + else + ctpoten = 15._r8+15._r8*wkp + 0.8_r8*wkp**2 + endif + end if + + end subroutine get_mag_parms + + end module mag_parms diff --git a/src/physics/waccm/mo_aurora.F90 b/src/physics/waccm/mo_aurora.F90 new file mode 100644 index 0000000000..c088b531e2 --- /dev/null +++ b/src/physics/waccm/mo_aurora.F90 @@ -0,0 +1,1178 @@ + + module mo_aurora +!----------------------------------------------------------------------- +! +! Auroral oval parameterization. See reference: +! R.G. Roble, E.C. Ridley +! An auroral model for the NCAR thermospheric general circulation model (TGCM) +! Annales Geophysicae,5A, (6), 369-382, 1987. +! +! The aurora oval is a circle in auroral circle coordinates. Auroral circle +! coordinates are offset from magnetic coordinates by offa degrees (radians) +! towards 0 MLT and by dskofa degrees (radians) towards dusk (18 MLT). +! The aurora assumes a Maxwellian in energy, so that the characteristic +! energy is half of the mean energy (or mean energy = 2*alfa, where alfa +! is the characteristic energy). The Maxwellian is approximated in the +! aion subroutine. +! The aurora oval is assumed to be a Gaussian in auroral latitude, with +! peak values on the day (=1) and night (=2) sides that change from one to +! the other using cosines of the auroral longitude coordinate. +! There is provision for a low energy (~75 eV) aurora at the location of the +! regular (~1-6 keV) aurora in order to simulate the energy flux found +! at higher altitudes that is non-Maxwellian, but the flux is usually +! set to zero (1.e-80). +! There is provision for a proton (MeV) aurora, but the flux is usually +! set to zero (1.e-20). +! The drizzle is a constant low energy electron flux over the polar cap, +! which goes to 1/e over twice the half-width of the aurora at the +! radius of the aurora. +! The cusp is a low energy electron flux centered over the dayside convection +! entrance at phid at the convection reversal boundary theta0. The cusp +! falls off over 5 degrees in latitude and over 20 degrees in longitude +! to 1/e values of the peak at the center. +! 1.e-20 and 1.e-80 are used to give a near zero answer. +! +! The polar drizzle and cusp electron energies are low, and soft particles +! have great influence on the over-all thermospheric and ionospheric +! structure, especially on the electron density profiles at mid-latitudes +! and in winter since low energy electrons produce ionization at high +! altitudes where loss rates are very low. (Comment by Wenbin Wang.) +! The original energies for drizzle and cusp were alfad=0.75, alfac=0.5 keV. +! The original guess at energy fluxes were: ed=0.1+2.0*power/100.,ec=0.1+0.9*power/100. +! The next guess at energy fluxes were: ed=0.01+0.2*power/100., ec=0.01+0.09*power/100. +! The values below reflect higher estimates for the electron energy (lower alt) +! +! Calling sequence (all subs in mo_aurora, mo_aurora.F): +! 1) sub aurora_cons called once per time step from advance. +! 2) sub aurora called from dynamics, inside parallel latitude scan. +! 3) subs aurora_cusp and aurora_heat called from sub aurora. +! 4) sub aurora_ions called from sub aurora. +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use mo_constants, only: pi, & + gask => rgas_cgs + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + implicit none + + interface aurora + module procedure aurora_prod + module procedure aurora_hrate + end interface + + save + + integer, parameter :: isouth = 1 + integer, parameter :: inorth = 2 + + ! g = 8.7 m/s^2? Because this is 400 km up? + real(r8), parameter :: grav = 870._r8 ! (cm/s^2) + + integer :: lev1 = 1 + real(r8), parameter :: twopi = 2._r8*pi + real(r8) :: rmass_o1 + real(r8) :: rmass_o2 + real(r8) :: rmass_n2 + real(r8) :: rmassinv_o1 + real(r8) :: rmassinv_o2 + real(r8) :: rmassinv_n2 + real(r8), parameter :: dtr = pi/180._r8 + +!----------------------------------------------------------------------- +! ... polar drizzle parameters: +! alfad: Characteristic Maxwellian energy of drizzle electrons (keV) +! ed : Column energy input of drizzle electrons (ergs/cm**2/s) +! fd : Electron particle flux of drizzle electrons (particles/cm**2/s) +!----------------------------------------------------------------------- + real(r8), parameter :: alfad = 0.5_r8 + real(r8) :: ed + real(r8) :: fd ! set in sub aurora_ions + +!----------------------------------------------------------------------- +! ... polar cusp parameters: +! alfac: Characteristic Maxwellian energy of polar cusp electons (keV) +! ec : Column energy input of polar cusp electrons (ergs/cm**2/s) +! fc : Electron particle flux of polar cusp electrons (particles/cm**2/s) +!----------------------------------------------------------------------- + real(r8), parameter :: alfac = 0.1_r8 + real(r8) :: ec + real(r8) :: fc ! set in sub aurora_ions + +!----------------------------------------------------------------------- +! e1: Peak energy flux in noon sector of the aurora (ergs/cm**2/s) +! e2: Peak energy flux in midnight sector of the aurora (ergs/cm**2/s) +! h1: Gaussian half-width of the noon auroral oval in degrees +! h2: Gaussian half-width of the midnight auroral oval in degrees +!----------------------------------------------------------------------- + real(r8) :: & + e1, e2, & ! set in sub aurora_cons (function of hem power) + h1, h2 ! set in sub aurora_cons (function of hem power) + +!----------------------------------------------------------------------- +! ... additional auroral parameters +!----------------------------------------------------------------------- + real(r8) :: & + alfa0, & ! average of noon and midnight characteristic Maxw energies + ralfa,ralfa2, & ! difference ratios of characteristic energies + rrote, & ! clockwise rotation from noon of peak dayside energy flux (e1) + rroth, & ! clockwise rotation from noon of dayside h1 Gaussian half-width + h0, & ! average of noon and midnight Gaussian half-widths + rh, & ! difference ratio of half-widths (rh=(h2-h1)/(h2+h1)) + e0,e20, & ! e0 = average of noon and midnight electrons + ree,re2, & ! difference ratios of peak energy fluxes (ree=(e2-e1)/(e2+e1)) + alfa20 ! average of noon and midnight char energies for high alt aurora + real(r8) :: & + theta0(2), & ! convection reversal boundary in radians + offa(2), & ! offset of oval towards 0 MLT relative to magnetic pole (rad) + dskofa(2), & ! offset of oval in radians towards 18 MLT (f(By)) + phid(2), & ! dayside convection entrance in MLT converted to radians (f(By)) + rrad(2) ! radius of auroral circle in radians + real(r8) :: ctpoten ! cross-cap potential (kV) + real(r8) :: byimf ! BY component of IMF (nT) + + + private + public :: aurora_inti, aurora_timestep_init, aurora + public :: aurora_register + + logical :: aurora_active = .false. + integer :: indxAIPRS = -1 + + real(r8) :: byloc ! local By + real(r8), parameter :: h2deg = 15._r8 ! hour to degree + + contains + + + !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + subroutine aurora_register + use ppgrid, only : pver,pcols + use physics_buffer, only : pbuf_add_field, dtype_r8 + + ! add ionization rates to phys buffer for waccmx ionosphere module + + call pbuf_add_field('AurIPRateSum' , 'physpkg', dtype_r8, (/pcols,pver/), indxAIPRS) ! Sum of ion auroral production rates for O2 + + endsubroutine aurora_register + + subroutine aurora_inti +!----------------------------------------------------------------------- +! ... initialize aurora module +!----------------------------------------------------------------------- + + use ppgrid, only : pver + use constituents, only : cnst_get_ind, cnst_mw + use ref_pres, only : pref_mid + use mo_chem_utls, only : get_spc_ndx + use cam_history, only : addfld, horiz_only + + implicit none + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k, m + real(r8), parameter :: e = 1.e-10_r8 + + real(r8) :: plb + real(r8) :: alfa_1, alfa_2, alfa21, alfa22 + real(r8) :: e21, e22 + + integer :: op_ndx,o2p_ndx,np_ndx,n2p_ndx,e_ndx + + byloc = 0._r8 + + op_ndx = get_spc_ndx( 'Op' ) + o2p_ndx = get_spc_ndx( 'O2p' ) + np_ndx = get_spc_ndx( 'Np' ) + n2p_ndx = get_spc_ndx( 'N2p' ) + e_ndx = get_spc_ndx( 'e' ) + + aurora_active = op_ndx > 0 .and. o2p_ndx > 0 .and. np_ndx > 0 .and. n2p_ndx > 0 .and. e_ndx > 0 & + .and. pref_mid(1) < 0.1_r8 ! need high-top + + if (.not. aurora_active) return + +!----------------------------------------------------------------------- +! ... initialize module variables +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! ... set molecular weights +!----------------------------------------------------------------------- + call cnst_get_ind( 'O2', m ) + rmass_o2 = cnst_mw(m) + rmassinv_o2 = 1._r8/rmass_o2 + call cnst_get_ind( 'O', m ) + rmass_o1 = cnst_mw(m) + rmassinv_o1 = 1._r8/rmass_o1 + call cnst_get_ind( 'N', m ) + rmass_n2 = 2._r8*cnst_mw(m) + rmassinv_n2 = 1._r8/rmass_n2 + + offa(isouth) = 1.0_r8*dtr + offa(inorth) = 1.0_r8*dtr + phid(isouth) = (9.39_r8 + 0.21_r8*byloc - 12._r8) * h2deg * dtr + phid(inorth) = (9.39_r8 - 0.21_r8*byloc - 12._r8) * h2deg * dtr + alfa_1 = 1.5_r8 + alfa_2 = 2._r8 + +!----------------------------------------------------------------------- +! Values from 10/05/94 HPI estimates (50% or more higher than old estimates): +! alfa_1 = amin1(1.5,1.25+0.05*plevel) +! alfa_2 = 1.2 + 0.095*plevel +!----------------------------------------------------------------------- + alfa0 = 0.5_r8*(alfa_1 + alfa_2) + ralfa = (alfa_2 - alfa_1) / (alfa_1 + alfa_2 + e) + alfa21 = 0.075_r8 + alfa22 = 0.075_r8 + alfa20 = 0.5_r8 * (alfa21 + alfa22) + ralfa2 = (alfa22 - alfa21) / (alfa21 + alfa22 + e) + e21 = 1.e-80_r8 + e22 = 1.e-80_r8 + e20 = 0.5_r8 * (e21 + e22) + re2 = (e22 - e21) / (e21 + e22) + +!----------------------------------------------------------------------- +! ... set auroral lower bndy index +!----------------------------------------------------------------------- + plb = 5.e-4_r8*exp( 7._r8 ) * .1_r8 ! Pa + do k = 1,pver + if( pref_mid(k) >= plb ) then + lev1 = k-1 + exit + end if + end do + + if (masterproc) write(iulog,*) ' ' + if (masterproc) write(iulog,*) 'aurora_inti: aurora will go down to lev,p = ',lev1,pref_mid(lev1) + if (masterproc) write(iulog,*) ' ' + +!----------------------------------------------------------------------- +! Report to stdout: +!----------------------------------------------------------------------- +#ifdef AURORA_DIAGS + write(iulog,"(/,'aurora_cons:')") +! write(iulog,"(' cusp: alfac=',f8.3,' ec=',f8.3,' fc=',e10.4)") & +! alfac,ec,fc +! write(iulog,"(' drizzle: alfad=',f8.3,' ed=',f8.3,' fd=',e10.4)") & +! alfad,ed,fd + write(iulog,"(' half-widths = h1,h2=',2f10.3)") h1,h2 + write(iulog,"(' energy flux = e1,e2=',2f10.3)") e1,e2 + write(iulog,"(' add_sproton = ',l1)") add_sproton + write(iulog,"(' ')") +#endif + call addfld('ALATM', horiz_only, 'I','degrees', & + 'Magnetic latitude at each geographic coordinate') + call addfld('ALONM', horiz_only, 'I','degrees', & + 'Magnetic longitude at each geographic coordinate') + call addfld( 'QSUM', (/ 'lev' /), 'I','/s', & + 'total ion production' ) + + end subroutine aurora_inti + + subroutine aurora_timestep_init +!----------------------------------------------------------------------- +! ... per timestep initialization +!----------------------------------------------------------------------- + + use mag_parms, only : get_mag_parms + use spmd_utils, only : masterproc + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8) :: power, plevel + real(r8) :: roth, rote, rcp, rhp + real(r8) :: arad + real(r8), parameter :: convert = 3.1211e8_r8 + + if (.not. aurora_active) return + +!----------------------------------------------------------------------- +! ... get hemispheric power +!----------------------------------------------------------------------- + call get_mag_parms( by = byimf, hpower = power, ctpoten = ctpoten ) +#ifdef AURORA_DIAGS + if( masterproc ) then + write(iulog,*) '----------------------------------------' + write(iulog,*) 'aurora_timestep_init: by,power,ctpoten = ',byimf,power,ctpoten + write(iulog,*) '----------------------------------------' + end if +#endif + + if( power >= 1.0_r8 ) then + plevel = 2.09_r8*log( power ) + else + plevel = 0._r8 + end if + +! +! Add limits to byimf if use the Heelis convection pattern,this is to have +! asymmetric dawn and dusk convection cells and By effect. Adapted from TIEGCM. +! This is for now just a hook, since in the current setting byimf is likely 0. +! + byloc = byimf ! init local from original namelist input +! If (potential_model == 'HEELIS') then + if (byloc > 7.0_r8) byloc = 7.0_r8 + if (byloc < -11.0_r8) byloc = -11.0_r8 +! endif + +!----------------------------------------------------------------------- +! h1 = Gaussian half-width of the noon auroral oval in degrees +! h2 = Gaussian half-width of the midnight auroral oval in degrees +!----------------------------------------------------------------------- +! produce realistic oval compared to NOAA empirical auroral oval and TIMED/GUVI +! h1 formula given by Wenbin base on POLARVIS image; +! h2 formula based on Emery et al original auroral parameterization report + h1 = min(2.35_r8, 0.83_r8 + 0.33_r8*plevel) + h2 = 2.5_r8+0.025_r8*max(power,55._r8)+0.01_r8*min(0._r8,power-55._r8) + +!----------------------------------------------------------------------- +! Values from corrections to Emery et al Parameterization report: +! h1 = amin1(2.35, 0.83 + 0.33*plevel) +! h2 = 2.87 + 0.15*plevel +!----------------------------------------------------------------------- + + rh = (h2 - h1) / (h1 + h2) + h0 = 0.5_r8 * (h1 + h2) * dtr + + theta0(isouth) = (-3.80_r8 + 8.48_r8*(ctpoten**.1875_r8))*dtr + theta0(inorth) = theta0(isouth) + dskofa(isouth) = 0._r8 + dskofa(inorth) = dskofa(isouth) + +! roth = MLT of max width of aurora in hours +! rote = MLT of max energy flux of aurora in hours + + roth = 0.81_r8 - 0.06_r8 * plevel + rote = 0.17_r8 - 0.04_r8 * plevel + +! Convert MLT from hours to degrees to radians + + rroth = roth * h2deg * dtr + rrote = rote * h2deg * dtr + +!----------------------------------------------------------------------- +! e1 = energy flux in the noon sector of the aurora (ergs/cm**2/s) +! e2 = energy flux in the midnight sector of the aurora (ergs/cm**2/s) +!----------------------------------------------------------------------- +! produce realistic oval compared to NOAA empirical auroral oval and TIMED/GUVI +! e1 formula given by Wenbin base on POLARVIS image; +! e2 formula based on Emery et al original auroral parameterization report +!----------------------------------------------------------------------- + e1 = max(0.50_r8, -2.15_r8 + 0.62_r8*plevel) + e2=1._r8+0.11_r8*power + +!----------------------------------------------------------------------- +! ed : Column energy input of drizzle electrons (ergs/cm**2/s) +! ec : Column energy input of polar cusp electrons (ergs/cm**2/s) +!----------------------------------------------------------------------- + ed = .0012_r8+.0006_r8*power + ec = (0.24_r8+0.0067_r8*power)/5._r8 + +!----------------------------------------------------------------------- +! Set cusp and drizzle parameters: +! (conversion between particle number density and characteristic +! energy and column energy input) +!----------------------------------------------------------------------- + fc = convert * ec / alfac + fd = convert * ed / alfad + +!----------------------------------------------------------------------- +! Values from corrections to Emery et al Parameterization report: +!----------------------------------------------------------------------- + e0 = 0.5_r8 * (e1 + e2) + ree = (e2 - e1) / (e1 + e2) + + rhp = 14.20_r8 + 0.96_r8*plevel + rcp = -0.43_r8 + 9.69_r8 * (ctpoten**.1875_r8) + arad = max( rcp,rhp ) + rrad(isouth) = arad*dtr + rrad(inorth) = arad*dtr + + end subroutine aurora_timestep_init + + subroutine aurora_prod( tn, o2, o1, mbar, rlats, & + qo2p, qop, qn2p, qnp, pmid, & + lchnk, calday, ncol, rlons, pbuf ) +!----------------------------------------------------------------------- +! ... auroral parameterization driver +!----------------------------------------------------------------------- + + use mo_apex, only : alatm, alonm ! magnetic latitude,longitude grid (radians) + use mo_apex, only : maglon0 + use ppgrid, only : pcols, pver + use cam_history, only : outfld + use physics_buffer,only: physics_buffer_desc + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: & + ncol, & ! column count + lchnk ! chunk index + real(r8), intent(in) :: & + calday ! calendar day of year + real(r8), intent(in) :: & + tn(pcols,pver), & ! neutral gas temperature (K) + o2(ncol,pver), & ! O2 concentration (kg/kg) + o1(ncol,pver), & ! O concentration (kg/kg) + mbar(ncol,pver) ! mean molecular weight (g/mole) + real(r8), intent(in) :: & + pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: & + rlats(ncol), & ! column latitudes (radians) + rlons(ncol) + real(r8), intent(out) :: & + qo2p(ncol,pver), & ! o2+ production + qop(ncol,pver), & ! o+ production + qn2p(ncol,pver), & ! n2+ production + qnp(ncol,pver) ! n+ production + + type(physics_buffer_desc),pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: i, k + integer :: hemis(ncol) + real(r8) :: r2d + real(r8) :: ofda, cosofa, sinofa, aslona + real(r8) :: dlat_aur(ncol) + real(r8) :: dlon_aur(ncol) + real(r8) :: colat(ncol) + real(r8) :: sinlat(ncol) + real(r8) :: coslat(ncol) + real(r8) :: coslon(ncol) + real(r8) :: sinlon(ncol) + real(r8) :: alon(ncol) + real(r8) :: cusp(ncol) + real(r8) :: alfa(ncol) + real(r8) :: alfa2(ncol) + real(r8) :: flux(ncol) + real(r8) :: flux2(ncol) + real(r8) :: drizl(ncol) + real(r8) :: qteaur(ncol) ! for electron temperature + logical :: do_aurora(ncol) + + real(r8) :: dayfrac, rotation + + if (.not. aurora_active) return + +!----------------------------------------------------------------------- +! ... initialize ion production +!----------------------------------------------------------------------- + do k = 1,pver + qo2p(:,k) = 0._r8 + qop(:,k) = 0._r8 + qn2p(:,k) = 0._r8 + qnp(:,k) = 0._r8 + end do + + r2d = 180._r8/pi + +!----------------------------------------------------------------------- +! ... output mag lons, lats +!----------------------------------------------------------------------- + call outfld( 'ALONM', r2d*alonm(:ncol,lchnk), pcols, lchnk ) + call outfld( 'ALATM', r2d*alatm(:ncol,lchnk), pcols, lchnk ) + +!----------------------------------------------------------------------- +! ... check latitudes, and return if all below 30 deg +!----------------------------------------------------------------------- + do_aurora(:) = abs( rlats(:) ) > pi/6._r8 + if( all( .not. do_aurora(:) ) ) then + return + end if + +!----------------------------------------------------------------------- +! ... set rotation based on sun location +!----------------------------------------------------------------------- + dayfrac = (calday - int(calday)) + rotation = maglon0 + dayfrac*twopi-pi + + do i = 1,ncol + if( do_aurora(i) ) then + dlat_aur(i) = alatm(i,lchnk) + dlon_aur(i) = alonm(i,lchnk) + rotation ! rotate it + if( dlon_aur(i) > pi ) then + dlon_aur(i) = dlon_aur(i) - twopi + else if( dlon_aur(i) < -pi ) then + dlon_aur(i) = dlon_aur(i) + twopi + end if + if( dlat_aur(i) > 0._r8 ) then + hemis(i) = 2 + else + hemis(i) = 1 + end if +!----------------------------------------------------------------------- +! ... find auroral circle coordinates +!----------------------------------------------------------------------- + ofda = sqrt( offa(hemis(i))**2 + dskofa(hemis(i))**2) + cosofa = cos( ofda ) + sinofa = sin( ofda ) + aslona = asin( dskofa(hemis(i))/ofda ) + sinlat(i) = sin( abs( dlat_aur(i) ) ) + coslat(i) = cos( dlat_aur(i) ) + sinlon(i) = sin( dlon_aur(i) + aslona ) + coslon(i) = cos( dlon_aur(i) + aslona ) + colat(i) = acos( cosofa*sinlat(i) - sinofa*coslat(i)*coslon(i)) + alon(i) = mod( atan2( sinlon(i)*coslat(i),sinlat(i)*sinofa & + + cosofa*coslat(i)*coslon(i) ) - aslona + 3._r8*pi,twopi) - pi + end if + end do +#ifdef AURORA_DIAGS + write(iulog,*) '-----------------------------------------------------' + write(iulog,*) 'aurora: diagnostics for lchnk = ',lchnk + write(iulog,*) ' geo lats' + write(iulog,'(1p,5g15.7)') r2d*rlats(:ncol) + write(iulog,*) ' geo lons' + write(iulog,'(1p,5g15.7)') r2d*rlons(:ncol) + write(iulog,*) ' mag lats' + write(iulog,'(1p,5g15.7)') r2d*dlat_aur(:ncol) + write(iulog,*) ' mag lons' + write(iulog,'(1p,5g15.7)') r2d*alonm(:ncol,lchnk) + write(iulog,*) ' mag table lons' + write(iulog,'(1p,5g15.7)') r2d*dlon_aur(:ncol) + write(iulog,*) ' min,max mag lons = ',r2d*minval(alonm(:ncol,lchnk)),r2d*maxval(alonm(:ncol,lchnk)) + write(iulog,*) '-----------------------------------------------------' +#endif + +!----------------------------------------------------------------------- +! ... make cusp +!----------------------------------------------------------------------- + call aurora_cusp( cusp, do_aurora, hemis, colat, alon, ncol ) + +!----------------------------------------------------------------------- +! ... make alfa, flux, and drizzle +!----------------------------------------------------------------------- + call aurora_heat( flux, flux2, alfa, alfa2, & + qteaur, drizl, do_aurora, hemis, & + alon, colat, ncol ) + +!----------------------------------------------------------------------- +! ... auroral additions to ionization rates +!----------------------------------------------------------------------- + call aurora_ions( drizl, cusp, alfa, alfa2, & + flux, flux2, tn, o2, & + o1, mbar, qo2p, qop, qn2p, & + qnp, pmid, do_aurora, ncol, lchnk, pbuf ) + + end subroutine aurora_prod + + subroutine aurora_hrate( tn, mbar, rlats, & + aur_hrate, cpair, pmid, lchnk, calday, & + ncol, rlons ) +!----------------------------------------------------------------------- +! ... auroral parameterization driver +!----------------------------------------------------------------------- + + use mo_apex, only : alatm, alonm ! magnetic latitude,longitude grid (radians) + use mo_apex, only : maglon0 + use ppgrid, only : pcols, pver + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: & + ncol, & ! column count + lchnk ! chunk index + real(r8), intent(in) :: & + calday ! calendar day of year + real(r8), intent(in) :: & + tn(pcols,pver), & ! neutral gas temperature (K) + mbar(ncol,pver) ! mean molecular weight (g/mole) + real(r8), intent(in) :: & + cpair(ncol,pver) ! specific heat capacity (J/K/kg) + real(r8), intent(in) :: & + pmid(pcols,pver) ! midpoint pressure (Pa) + real(r8), intent(in) :: & + rlats(ncol), & ! column latitudes (radians) + rlons(ncol) + real(r8), intent(out) :: & + aur_hrate(ncol,pver) ! auroral heating rate + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: aur_therm = 807._r8 + real(r8), parameter :: jkcal = 4184._r8 + real(r8), parameter :: aur_heat_eff = .05_r8 + real(r8), parameter :: aur_hconst = 1.e3_r8*jkcal*aur_therm*aur_heat_eff + + integer :: i, k + integer :: hemis(ncol) + real(r8) :: r2d + real(r8) :: ofda, cosofa, sinofa, aslona + real(r8) :: dlat_aur(ncol) + real(r8) :: dlon_aur(ncol) + real(r8) :: colat(ncol) + real(r8) :: sinlat(ncol) + real(r8) :: coslat(ncol) + real(r8) :: coslon(ncol) + real(r8) :: sinlon(ncol) + real(r8) :: alon(ncol) + real(r8) :: cusp(ncol) + real(r8) :: alfa(ncol) + real(r8) :: alfa2(ncol) + real(r8) :: flux(ncol) + real(r8) :: flux2(ncol) + real(r8) :: drizl(ncol) + real(r8) :: qteaur(ncol) ! for electron temperature + real(r8) :: qsum(ncol,pver) ! total ion production (1/s) + logical :: do_aurora(ncol) + + real(r8) :: dayfrac, rotation + +!----------------------------------------------------------------------- +! ... initialize ion production +!----------------------------------------------------------------------- + do k = 1,pver + aur_hrate(:,k) = 0._r8 + end do + + if (.not. aurora_active) return + + r2d = 180._r8/pi + +!----------------------------------------------------------------------- +! ... check latitudes, and return if all below 32.5 deg +!----------------------------------------------------------------------- + do_aurora(:) = abs( rlats(:) ) > pi/6._r8 + if( all( .not. do_aurora(:) ) ) then + return + end if + +!----------------------------------------------------------------------- +! ... set rotation based on sun location +!----------------------------------------------------------------------- + dayfrac = (calday - int(calday)) + rotation = maglon0 + dayfrac*twopi-pi + + do i = 1,ncol + if( do_aurora(i) ) then + dlat_aur(i) = alatm(i,lchnk) + dlon_aur(i) = alonm(i,lchnk) + rotation ! rotate it + if( dlon_aur(i) > pi ) then + dlon_aur(i) = dlon_aur(i) - twopi + else if( dlon_aur(i) < -pi ) then + dlon_aur(i) = dlon_aur(i) + twopi + end if + if( dlat_aur(i) > 0._r8 ) then + hemis(i) = 2 + else + hemis(i) = 1 + end if +!----------------------------------------------------------------------- +! ... find auroral circle coordinates +!----------------------------------------------------------------------- + ofda = sqrt( offa(hemis(i))**2 + dskofa(hemis(i))**2) + cosofa = cos( ofda ) + sinofa = sin( ofda ) + aslona = asin( dskofa(hemis(i))/ofda ) + sinlat(i) = sin( abs( dlat_aur(i) ) ) + coslat(i) = cos( dlat_aur(i) ) + sinlon(i) = sin( dlon_aur(i) + aslona ) + coslon(i) = cos( dlon_aur(i) + aslona ) + colat(i) = acos( cosofa*sinlat(i) - sinofa*coslat(i)*coslon(i)) + alon(i) = mod( atan2( sinlon(i)*coslat(i),sinlat(i)*sinofa & + + cosofa*coslat(i)*coslon(i) ) - aslona + 3._r8*pi,twopi) - pi + end if + end do +#ifdef AURORA_DIAGS + write(iulog,*) '-----------------------------------------------------' + write(iulog,*) 'aurora: diagnostics for lchnk = ',lchnk + write(iulog,*) ' geo lats' + write(iulog,'(1p,5g15.7)') r2d*rlats(:ncol) + write(iulog,*) ' geo lons' + write(iulog,'(1p,5g15.7)') r2d*rlons(:ncol) + write(iulog,*) ' mag lats' + write(iulog,'(1p,5g15.7)') r2d*dlat_aur(:ncol) + write(iulog,*) ' mag lons' + write(iulog,'(1p,5g15.7)') r2d*alonm(:ncol,lchnk) + write(iulog,*) ' mag table lons' + write(iulog,'(1p,5g15.7)') r2d*dlon_aur(:ncol) + write(iulog,*) ' min,max mag lons = ',r2d*minval(alonm(:ncol,lchnk)),r2d*maxval(alonm(:ncol,lchnk)) + write(iulog,*) '-----------------------------------------------------' +#endif + +!----------------------------------------------------------------------- +! ... make cusp +!----------------------------------------------------------------------- + call aurora_cusp( cusp, do_aurora, hemis, colat, alon, ncol ) + +!----------------------------------------------------------------------- +! ... make alfa, flux, and drizzle +!----------------------------------------------------------------------- + call aurora_heat( flux, flux2, alfa, alfa2, & + qteaur, drizl, do_aurora, hemis, & + alon, colat, ncol ) + +!----------------------------------------------------------------------- +! ... auroral additions to ionization rates +!----------------------------------------------------------------------- + call total_ion_prod( drizl, cusp, alfa, alfa2, & + flux, flux2, tn, & + mbar, qsum, pmid, do_aurora, & + ncol ) + +!----------------------------------------------------------------------- +! ... form auroral heating rate +!----------------------------------------------------------------------- + do k = 1,pver + aur_hrate(:,k) = aur_hconst * qsum(:,k) / (cpair(:,k) * mbar(:,k)) + end do + + end subroutine aurora_hrate + + subroutine aurora_cusp( cusp, do_aurora, hemis, colat, alon, ncol ) +!----------------------------------------------------------------------- +! ... calculate horizontal variation of polar cusp heating +!----------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: hemis(ncol) + real(r8), intent(in) :: colat(ncol) + real(r8), intent(in) :: alon(ncol) + real(r8), intent(out) :: cusp(ncol) + logical, intent(in) :: do_aurora(ncol) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: s5 =.08726646_r8, & + s20 =.34906585_r8 + + where( do_aurora(:) ) + cusp(:) = (exp( -((theta0(hemis(:)) - colat(:))/s5)**2 ) & + + exp( -((pi - theta0(hemis(:)) - colat(:))/s5)**2) ) & + *exp( -(atan2( sin(alon(:) - phid(hemis(:))), cos(alon(:) - phid(hemis(:))) )/s20)**2 ) + elsewhere + cusp(:) = 0._r8 + endwhere + + end subroutine aurora_cusp + + subroutine aurora_heat( flux, flux2, alfa, alfa2, & + qteaur, drizl, do_aurora, hemis, & + alon, colat, ncol ) +!----------------------------------------------------------------------- +! ... calculate alfa, flux, and drizzle +!----------------------------------------------------------------------- + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: hemis(ncol) + real(r8), intent(in) :: colat(ncol) + real(r8), intent(in) :: alon(ncol) + real(r8), intent(inout) :: flux(ncol) + real(r8), intent(inout) :: flux2(ncol) + real(r8), intent(inout) :: drizl(ncol) + real(r8), intent(inout) :: qteaur(ncol) + real(r8), intent(inout) :: alfa(ncol) + real(r8), intent(inout) :: alfa2(ncol) + logical, intent(in) :: do_aurora(ncol) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), dimension(ncol) :: & + coslamda, & ! cos(angle from throat) + halfwidth, & ! oval half-width + wrk, & ! temp wrk array + dtheta ! latitudinal variation (Gaussian) + +!----------------------------------------------------------------------- +! Low-energy protons: +! +! alfap0 = 0.5*(alfap1+alfap2) +! e0p = 0.5*(pe1+pe2) +! +! coslamda = cos(lamda) +! halfwidth = auroral half width +! dtheta = colat-theta0(ihem) +! alfa = electron energy +!----------------------------------------------------------------------- + where( do_aurora(:) ) + coslamda(:) = cos( atan2( sin( alon(:) - rrote ),cos( alon(:) - rrote ) ) ) +!----------------------------------------------------------------------- +! ... auroral oval half-width (equation (1) in Roble,1987): +!----------------------------------------------------------------------- + halfwidth(:) = h0*(1._r8 - rh*cos( atan2( sin(alon(:) - rroth),cos( alon(:) - rroth ) ) ) ) + dtheta(:) = colat(:) - rrad(hemis(:)) + endwhere +!----------------------------------------------------------------------- +! ... characteristic energy (equation (2) in Roble,1987): +!----------------------------------------------------------------------- + if( alfa0 > .01_r8 ) then + where( do_aurora(:) ) + alfa(:) = alfa0*(1._r8 - ralfa*coslamda(:)) + endwhere + else + alfa(:) = 0._r8 + end if + + where( do_aurora(:) ) +!----------------------------------------------------------------------- +! ... flux, drizzle, alfa2, flux2 +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... energy flux (equation (3) in Roble,1987): +!----------------------------------------------------------------------- + wrk(:) = exp( -(dtheta(:)/halfwidth(:))**2 ) + flux(:) = e0*(1._r8 - ree*coslamda(:))*wrk(:) / (2._r8*alfa(:)*1.602e-9_r8) + drizl(:) = exp( -((dtheta(:) + abs(dtheta(:)))/(2._r8*h0))**2 ) + alfa2(:) = alfa20*(1._r8 - ralfa2*coslamda(:)) + flux2(:) = e20*(1._r8 - re2*coslamda(:))*wrk(:) / (2._r8*alfa2(:)*1.602e-9_r8) +!----------------------------------------------------------------------- +! ... for electron temperature (used in settei): +!----------------------------------------------------------------------- + qteaur(:) = -7.e8_r8*wrk(:) + endwhere + + end subroutine aurora_heat + + subroutine aurora_ions( drizl, cusp, alfa1, alfa2, & + flux1, flux2, tn, o2, & + o1, mbar, qo2p, qop, qn2p, & + qnp, pmid, do_aurora, ncol, lchnk, pbuf ) +!----------------------------------------------------------------------- +! ... calculate auroral additions to ionization rates +!----------------------------------------------------------------------- + + use ppgrid, only : pcols, pver + use cam_history, only : outfld + + use physics_buffer,only: physics_buffer_desc, pbuf_get_field + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + real(r8), intent(in), dimension(ncol) :: & + drizl, & + cusp, & + alfa1, & + alfa2, & + flux1, & + flux2 + real(r8), dimension(pcols,pver), intent(in) :: & + tn, & ! midpoint neutral temperature (K) + pmid ! midpoint pressure (Pa) + real(r8), dimension(ncol,pver), intent(in) :: & + o2, & ! midpoint o2 concentration (kg/kg) + o1, & ! midpoint o concentration (kg/kg) + mbar ! mean molecular mass (g/mole) + real(r8), dimension(ncol,pver), intent(inout) :: & + qo2p, & ! o2p prod from aurora (molecules/cm^3/s) + qop, & ! op prod from aurora (molecules/cm^3/s) + qn2p, & ! n2p prod from aurora (molecules/cm^3/s) + qnp ! np prod from aurora (molecules/cm^3/s) + logical, intent(in) :: do_aurora(ncol) + + type(physics_buffer_desc),pointer :: pbuf(:) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: const0 = 1.e-20_r8 + + integer :: k + real(r8), dimension(ncol) :: & + p0ez, & + press, & ! pressure at interface levels (dyne/cm^2) + tempi, & ! temperature at interface levels (K) + xalfa1, & + xalfa2, & + xcusp, & + xdrizl, & ! input to sub aion + cusp_ion, & + drizl_ion, & ! output from sub aion + alfa1_ion, & + alfa2_ion, & + barm_t, & + qsum, & + denom, & + barm, & + falfa1, & + falfa2, & + fcusp, & + fdrizl, & + xn2 + real(r8), dimension(ncol) :: & + qo2p_aur, & + qop_aur, & + qn2p_aur ! auroral ionization for O2+, O+, N2+ + real(r8) :: qia(5) ! low energy proton source (not in use, 1/02) + real(r8) :: wrk(ncol,pver) + + real(r8), pointer :: aurIPRateSum(:,:) ! Pointer to pbuf auroral ion production sum for O2+,O+,N2+ (s-1 cm-3) + + qia(:) = 0._r8 + wrk(:,:) = 0._r8 + + !----------------------------------------------------------- + ! Point to production rates array in physics buffer where + ! rates will be stored for ionosphere module access. Also, + ! initialize rates to zero before column loop since only + ! daylight values are filled + !----------------------------------------------------------- + if (indxAIPRS>0) then + call pbuf_get_field(pbuf, indxAIPRS, aurIPRateSum) + aurIPRateSum(:,:) = 0._r8 + endif + +level_loop : & + do k = 1,lev1 + where( do_aurora(:) ) + press(:ncol) = 10._r8*pmid(:ncol,k) ! from Pa to dyne/cm^2 + tempi(:ncol) = tn(:ncol,k) + barm(:) = mbar(:,k) + p0ez(:) = (press(:)/(grav*4.e-6_r8))**.606_r8 + xalfa1(:) = p0ez(:)/alfa1(:) + xalfa2(:) = p0ez(:)/alfa2(:) + xcusp (:) = p0ez(:)/alfac + xdrizl(:) = p0ez(:)/alfad + +!----------------------------------------------------------------------- +! ... initialize (whole array operations): +!----------------------------------------------------------------------- + alfa1_ion(:) = const0 + alfa2_ion(:) = const0 + cusp_ion(:) = const0 + drizl_ion(:) = const0 + endwhere +!----------------------------------------------------------------------- +! ... auroral electrons +!----------------------------------------------------------------------- + call aion( xalfa1, alfa1_ion, do_aurora, ncol ) + call aion( xalfa2, alfa2_ion, do_aurora, ncol ) + call aion( xcusp , cusp_ion, do_aurora, ncol ) + call aion( xdrizl, drizl_ion, do_aurora, ncol ) + where( do_aurora(:) ) + falfa1(:) = alfa1(:)*flux1(:) ! s7 + falfa2(:) = alfa2(:)*flux2(:) ! s8 + fcusp (:) = cusp(:)*alfac*fc ! s9 + fdrizl(:) = drizl(:)*alfad*fd ! s10 + qsum(:) = falfa1(:)*alfa1_ion(:) & ! s7*s3 + + falfa2(:)*alfa2_ion(:) & ! s8*s4 + + fcusp(:)*cusp_ion (:) & ! s9*s5 + + fdrizl(:)*drizl_ion(:) ! s10*s6 + endwhere + +!----------------------------------------------------------------------- +! ... form production +!----------------------------------------------------------------------- + where( do_aurora(:) ) + barm_t(:) = grav*barm(:)/(35.e-3_r8*gask*tempi(:)) + qsum(:) = qsum(:)*barm_t(:) ! s1 = s1*s11 + wrk(:,k) = qsum(:) +!----------------------------------------------------------------------- +! ... denominator of equations (13-16) in Roble,1987. +!----------------------------------------------------------------------- + xn2(:) = max( (1._r8 - o2(:,k) - o1(:,k)),1.e-8_r8 ) + denom(:) = 0.92_r8*xn2(:)*rmassinv_n2 & + + 1.5_r8*o2(:,k) *rmassinv_o2 + 0.56_r8*o1(:,k) *rmassinv_o1 +!----------------------------------------------------------------------- +! ... production of O2+ (equation (15) in Roble,1987): +!----------------------------------------------------------------------- + qo2p_aur(:) = qsum(:)*o2(:,k)/(rmass_o2*denom(:)) + qia(2) +!----------------------------------------------------------------------- +! ... production of O+ (equation (16) in Roble,1987): +!----------------------------------------------------------------------- + qop_aur(:) = qsum(:)*(.5_r8 *o2(:,k)*rmassinv_o2 & + + .56_r8*o1(:,k)*rmassinv_o1)/denom(:) + qia(3) +!----------------------------------------------------------------------- +! ... production of N2+ (equation (13) in Roble,1987) +!----------------------------------------------------------------------- + qn2p_aur(:) = qsum(:)*.7_r8*xn2(:)/(rmass_n2*denom(:)) + qia(1) + qo2p(:,k) = qo2p(:,k) + qo2p_aur(:) + qop(:,k) = qop(:,k) + qop_aur(:) + qn2p(:,k) = qn2p(:,k) + qn2p_aur(:) + qnp(:,k) = qnp (:,k) + .22_r8/.7_r8 * qn2p_aur(:) + endwhere + end do level_loop + + !---------------------------------------------------------------- + ! Store the sum of the ion production rates in pbuf to be used + ! in the ionosx module + !---------------------------------------------------------------- + if (indxAIPRS>0) then + + aurIPRateSum(1:ncol,1:pver) = wrk(1:ncol,1:pver) + + endif + + call outfld( 'QSUM', wrk, ncol, lchnk ) + + end subroutine aurora_ions + + subroutine total_ion_prod( drizl, cusp, alfa1, alfa2, & + flux1, flux2, tn, & + mbar, tpions, pmid, do_aurora, & + ncol ) +!----------------------------------------------------------------------- +! ... calculate auroral additions to ionization rates +!----------------------------------------------------------------------- + + use ppgrid, only : pcols, pver + + implicit none + +!----------------------------------------------------------------------- +! ... dummy arguments +!----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in), dimension(ncol) :: & + drizl, & + cusp, & + alfa1, & + alfa2, & + flux1, & + flux2 + real(r8), dimension(pcols,pver), intent(in) :: & + tn, & ! midpoint neutral temperature (K) + pmid ! midpoint pressure (Pa) + real(r8), dimension(ncol,pver), intent(in) :: & + mbar ! mean molecular mass (g/mole) + real(r8), dimension(ncol,pver), intent(inout) :: & + tpions ! total ion production (1/s) + logical, intent(in) :: do_aurora(ncol) + +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + real(r8), parameter :: const0 = 1.e-20_r8 + + integer :: k + real(r8), dimension(ncol) :: & + p0ez, & + press, & ! pressure at interface levels (dyne/cm^2) + tempi, & ! temperature at interface levels (K) + xalfa1, & + xalfa2, & + xcusp, & + xdrizl, & ! input to sub aion + cusp_ion, & + drizl_ion, & ! output from sub aion + alfa1_ion, & + alfa2_ion, & + barm_t, & + qsum, & + barm, & + falfa1, & + falfa2, & + fcusp + + tpions(:,:) = 0._r8 + +level_loop : & + do k = 1,lev1 + where( do_aurora(:) ) + press(:ncol) = 10._r8*pmid(:ncol,k) ! from Pa to dyne/cm^2 + tempi(:ncol) = tn(:ncol,k) + barm(:) = mbar(:,k) + p0ez(:) = (press(:)/(grav*4.e-6_r8))**.606_r8 + xalfa1(:) = p0ez(:)/alfa1(:) + xalfa2(:) = p0ez(:)/alfa2(:) + xcusp (:) = p0ez(:)/alfac + xdrizl(:) = p0ez(:)/alfad + +!----------------------------------------------------------------------- +! ... initiliaze (whole array operations): +!----------------------------------------------------------------------- + alfa1_ion(:) = const0 + alfa2_ion(:) = const0 + cusp_ion(:) = const0 + drizl_ion(:) = const0 + endwhere +!----------------------------------------------------------------------- +! ... auroral electrons +!----------------------------------------------------------------------- + call aion( xalfa1, alfa1_ion, do_aurora, ncol ) + call aion( xalfa2, alfa2_ion, do_aurora, ncol ) + call aion( xcusp , cusp_ion, do_aurora, ncol ) + call aion( xdrizl, drizl_ion, do_aurora, ncol ) + where( do_aurora(:) ) + falfa1(:) = alfa1(:)*flux1(:) ! s7 + falfa2(:) = alfa2(:)*flux2(:) ! s8 + fcusp (:) = cusp(:)*alfac*fc ! s9 + qsum(:) = falfa1(:)*alfa1_ion(:) & ! s7*s3 + + falfa2(:)*alfa2_ion(:) & ! s8*s4 + + fcusp(:)*cusp_ion (:) & ! s9*s5 + + drizl(:)*drizl_ion(:) ! s10*s6 + endwhere + +!----------------------------------------------------------------------- +! ... form production +!----------------------------------------------------------------------- + where( do_aurora(:) ) + barm_t(:) = grav*barm(:)/(35.e-3_r8*gask*tempi(:)) + tpions(:,k) = qsum(:)*barm_t(:) ! s1 = s1*s11 + endwhere + end do level_loop + + end subroutine total_ion_prod + + subroutine aion( si, so, do_aurora, ncol ) +!----------------------------------------------------------------------- +! Calculates integrated f(x) needed for total auroral ionization. +! See equations (10-12) in Roble,1987. +! Coefficients for equation (12) of Roble,1987 are in variable cc +! (revised since 1987): +! Uses the identity x**y = exp(y*ln(x)) for performance +! (fewer (1/2) trancendental functions are required). +!------------------------------------------------------------------------ + + implicit none + +!------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------ + integer, intent(in) :: ncol + real(r8), intent(in) :: si(ncol) + real(r8), intent(out) :: so(ncol) + logical, intent(in) :: do_aurora(ncol) + +!------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------ + real(r8), parameter :: cc(8) = & + (/ 3.2333134511131_r8 , 2.5658873458085_r8 , 2.2540957232641_r8 , & + 0.72971983372673_r8, 1.1069072431948_r8 , 1.7134937681128_r8 , & + 1.8835442312993_r8 , 0.86472135072090_r8 /) + + real(r8) :: xlog(ncol) + + where( do_aurora(:) ) + xlog(:) = log( si(:) ) + so(:) = cc(1)*exp( cc(2)*xlog(:) - cc(3)*exp( cc(4)*xlog(:) ) ) & + + cc(5)*exp( cc(6)*xlog(:) - cc(7)*exp( cc(8)*xlog(:) ) ) + elsewhere + so(:) = 0._r8 + endwhere + + end subroutine aion + + end module mo_aurora diff --git a/src/physics/waccm/nlte_fomichev.F90 b/src/physics/waccm/nlte_fomichev.F90 new file mode 100644 index 0000000000..0e18172562 --- /dev/null +++ b/src/physics/waccm/nlte_fomichev.F90 @@ -0,0 +1,2559 @@ +module nlte_fomichev + +! +! provides calculation of non-LTE heating rates by Fomichev parameterization +! + use ppgrid, only: pcols, pver, pverp + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: r_universal, rearth, avogad, boltz, pi + use chem_surfvals, only: chem_surfvals_get + use cam_abortutils, only: endrun + use phys_grid, only: get_rlon_p, get_rlat_p + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + implicit none + private + save + +! Public interfaces + public & + nlte_fomichev_init, & + nlte_fomichev_calc, & + nocooling, & + o3pcooling + +! Private module data + +! +! Fomichev radiation parameters +! + integer :: nrfmc,nrfmg,nrfm,nrfmnlte,nrfmlte,nrfmlteo3,nrfmltelv,nrfmco2 + + parameter (nrfmc=59) ! no. of levels of Fomichev parameterization (2-16.5 by 0.25) + parameter (nrfmg=8) ! no. of levels between ground and first calculated level (0-1.75 by 0.25) + parameter (nrfm=nrfmc+nrfmg) ! total no. of levels of Fomichev paramterization + parameter (nrfmnlte=17) ! no. of levels of NLTE calculation + 1(b.c. at 12.5) + parameter (nrfmlte=43) ! no. of levels of LTE calculation + parameter (nrfmlteo3=35) ! no. of levels of LTE calculation - O3 ONLY! + parameter (nrfmltelv=9) ! no. of levels used in the LTE integral + parameter (nrfmco2=4) ! no. of CO2 precalculated profiles + + integer i,ix,js + + real(r8) :: o1_mw ! O molecular weight + real(r8) :: o2_mw ! O2 molecular weight + real(r8) :: o3_mw ! O3 molecular weight + real(r8) :: co2_mw ! CO2 molecular weight + real(r8) :: n2_mw ! N2 molecular weight + real(r8) :: no_mw ! NO molecular weight + +! Physical constants is cgs units + real(r8), parameter :: akbl=boltz*1e7_r8 ! Boltzman constant + real(r8), parameter :: anav=avogad*1e-3_r8 ! Avogadro Number + real(r8), parameter :: grav0=980._r8 ! gravitational constant + real(r8) :: arad ! planet's radius (cm) + real(r8), parameter :: ur=r_universal*1e4_r8 ! universal gas constant (R_star) + + real(r8), parameter :: a10=1.5988_r8 ! reaction constant + real(r8), parameter :: const=2.63187E11_r8 ! reaction constant + real(r8), parameter :: constb=9.08795e9_r8 ! reaction constant + + real(r8), parameter :: ptop_co2cool=7.42e-3_r8 ! top pressure level for co2 cool calculation (Pa) + integer :: ktop_co2cool ! the level index defining the top of CO2 cool calculation + +!VERTICAL GRIDs to be used in IR scheme +!XR(67) - pressure scale heights, psh's, (=0-16.5) at which input parameter +! should be given + real(r8) xr(nrfm) + +!DATA for "LTE" parameterization (x=2-12.5) +!IG(9) - indexes of level which should be used to account for the internal +! atmospheric heat exchange +!AO3(35,9) - coefficients for O3 scheme to calculate cooling rate in +! "erg/g/s" at levels x=2-10.5 (with a step of 0.25) +!CO2O(4) - vmr for basic CO2 +!"LTE-coefficients" for CO2 scheme using to calculate cooling rate in +!"erg/g/s" in region x=2-12.5 (with a step of 0.25). To account for internal +!heat exchange 9 level in atmosphere are needed. +! A150, B150(43,9) - for 150ppm of CO2 +! A360, B360(43,9) - for 360ppm of CO2 +! A540, B540(43,9) - for 540ppm of CO2 +! A720, B720(43,9) - for 720ppm of CO2 + integer ig(nrfmltelv) + + real(r8) a150(nrfmlte,nrfmltelv) + real(r8) b150(nrfmlte,nrfmltelv) + real(r8) a360(nrfmlte,nrfmltelv) + real(r8) b360(nrfmlte,nrfmltelv) + real(r8) a540(nrfmlte,nrfmltelv) + real(r8) b540(nrfmlte,nrfmltelv) + real(r8) a720(nrfmlte,nrfmltelv) + real(r8) b720(nrfmlte,nrfmltelv) + real(r8) co2o(nrfmco2) + +!DATA for NLTE parameterization CO2 (x=12.5-16.5) +!UCO2RO, ALO(51) - CO2 column amount and corresponding escape functions +! (eventually, their log) +!COR150, COR360, COR540, COR720(6) - correction to escape functions to +! calculate coefficients for the reccurence formula between x=12.5 and 13.75 +!UCO2CO(6) - CO2 column amount at x=12.5-13.75 (step - 0.25) for 360 ppm +! to be used to correct escape functions in this region + real(r8) uco2ro(51) + real(r8) alo(51) + real(r8) cor150(6) + real(r8) cor360(6) + real(r8) cor540(6) + real(r8) cor720(6) + real(r8) uco2co(6) + real(r8) ao3(nrfmlteo3,nrfmltelv) + + data (xr(i), i=1,67)/ & + 0.0_r8, 0.25_r8, 0.5_r8, 0.75_r8, 1.0_r8, 1.25_r8, 1.5_r8, 1.75_r8, 2.0_r8, 2.25_r8, 2.5_r8, 2.75_r8, & + 3.0_r8, 3.25_r8, 3.5_r8, 3.75_r8, 4.0_r8, 4.25_r8, 4.5_r8, 4.75_r8, 5.0_r8, 5.25_r8, 5.5_r8, 5.75_r8, & + 6.0_r8, 6.25_r8, 6.5_r8, 6.75_r8, 7.0_r8, 7.25_r8, 7.5_r8, 7.75_r8, 8.0_r8, 8.25_r8, 8.5_r8, 8.75_r8, & + 9.0_r8, 9.25_r8, 9.5_r8, 9.75_r8,10.0_r8,10.25_r8,10.5_r8,10.75_r8,11.0_r8,11.25_r8,11.5_r8,11.75_r8, & + 12.0_r8,12.25_r8,12.5_r8,12.75_r8,13.0_r8,13.25_r8,13.5_r8,13.75_r8,14.0_r8,14.25_r8,14.5_r8,14.75_r8, & + 15.0_r8,15.25_r8,15.5_r8,15.75_r8,16.0_r8,16.25_r8,16.5_r8/ + + data (ig(i),i=1,9)/-25,-12,-7,-3,-1,0,1,3,6/ + + + data (co2o(i),i=1,4)/150.e-6_r8, 360.e-6_r8, 540.e-6_r8, 720.e-6_r8/ + + data (uco2co(i),i=1,6) /2.546953e+16_r8,1.913609e+16_r8,1.425730e+16_r8, & + 1.052205e+16_r8,7.700499e+15_r8,5.596946e+15_r8/ + data (cor150(i),i=1,6) /2.530798e-01_r8,2.048590e-01_r8,1.050616e-01_r8, & + 9.172653e-02_r8,4.528593e-02_r8,3.384089e-02_r8/ + data (cor360(i),i=1,6) /4.848122e-01_r8,4.224252e-01_r8,2.958043e-01_r8, & + 2.067767e-01_r8,1.244037e-01_r8,5.792163e-02_r8/ + data (cor540(i),i=1,6) /6.263170e-01_r8,5.332695e-01_r8,3.773434e-01_r8, & + 2.592216e-01_r8,1.514242e-01_r8,6.889337e-02_r8/ + data (cor720(i),i=1,6) /7.248522e-01_r8,6.199704e-01_r8,4.525580e-01_r8, & + 3.046277e-01_r8,1.787235e-01_r8,7.953181e-02_r8/ + + data (uco2ro(i),i=1,51) /2.699726e+11_r8,5.810773e+11_r8,1.106722e+12_r8, & + 1.952319e+12_r8,3.306797e+12_r8,5.480155e+12_r8,8.858565e+12_r8,1.390142e+13_r8,& + 2.129301e+13_r8,3.209300e+13_r8,4.784654e+13_r8,7.091442e+13_r8,1.052353e+14_r8,& + 1.565317e+14_r8,2.320320e+14_r8,3.415852e+14_r8,4.986668e+14_r8,7.212717e+14_r8,& + 1.033831e+15_r8,1.469497e+15_r8,2.073209e+15_r8,2.905406e+15_r8,4.044901e+15_r8,& + 5.596946e+15_r8,7.700499e+15_r8,1.052205e+16_r8,1.425730e+16_r8,1.913609e+16_r8,& + 2.546953e+16_r8,3.366464e+16_r8,4.421144e+16_r8,5.775381e+16_r8,7.514254e+16_r8,& + 9.747013e+16_r8,1.261393e+17_r8,1.629513e+17_r8,2.102188e+17_r8,2.709114e+17_r8,& + 3.488423e+17_r8,4.489076e+17_r8,5.773939e+17_r8,7.423736e+17_r8,9.542118e+17_r8,& + 1.226217e+18_r8,1.575480e+18_r8,2.023941e+18_r8,2.599777e+18_r8,3.339164e+18_r8,& + 4.288557e+18_r8,5.507602e+18_r8,7.072886e+18_r8/ + + data (alo(i),i=1,51) /-2.410106e-04_r8,-5.471415e-04_r8,-1.061586e-03_r8, & + -1.879789e-03_r8,-3.166020e-03_r8,-5.185436e-03_r8,-8.216667e-03_r8, & + -1.250894e-02_r8,-1.838597e-02_r8,-2.631114e-02_r8,-3.688185e-02_r8, & + -5.096491e-02_r8,-7.004056e-02_r8,-9.603746e-02_r8,-1.307683e-01_r8, & + -1.762946e-01_r8,-2.350226e-01_r8,-3.095215e-01_r8,-4.027339e-01_r8, & + -5.178570e-01_r8,-6.581256e-01_r8,-8.265003e-01_r8,-1.024684e+00_r8, & + -1.252904e+00_r8,-1.509470e+00_r8,-1.788571e+00_r8,-2.081700e+00_r8, & + -2.379480e+00_r8,-2.675720e+00_r8,-2.967325e+00_r8,-3.252122e+00_r8, & + -3.530485e+00_r8,-3.803720e+00_r8,-4.072755e+00_r8,-4.338308e+00_r8, & + -4.601048e+00_r8,-4.861585e+00_r8,-5.120370e+00_r8,-5.377789e+00_r8, & + -5.634115e+00_r8,-5.889388e+00_r8,-6.143488e+00_r8,-6.396436e+00_r8, & + -6.648774e+00_r8,-6.901465e+00_r8,-7.155207e+00_r8,-7.409651e+00_r8, & + -7.663536e+00_r8,-7.915682e+00_r8,-8.165871e+00_r8,-8.415016e+00_r8/ + + data ((ao3(ix,js),js=1,9),ix=1,10)/ & + 5.690e+09_r8, 0.000e+00_r8, 1.962e+09_r8, 5.015e+09_r8, 7.105e+09_r8,-3.952e+10_r8,& + 8.916e+09_r8, 1.204e+09_r8, 5.434e+09_r8, 4.997e+09_r8, 0.000e+00_r8, 2.168e+09_r8,& + 4.981e+09_r8, 7.327e+09_r8,-3.855e+10_r8, 9.296e+09_r8, 1.326e+09_r8, 4.575e+09_r8,& + 4.179e+09_r8, 0.000e+00_r8, 2.198e+09_r8, 4.594e+09_r8, 7.780e+09_r8,-3.689e+10_r8,& + 9.624e+09_r8, 1.107e+09_r8, 3.736e+09_r8, 3.469e+09_r8, 0.000e+00_r8, 1.941e+09_r8,& + 3.921e+09_r8, 8.423e+09_r8,-3.508e+10_r8, 9.859e+09_r8, 8.736e+08_r8, 3.058e+09_r8,& + 2.930e+09_r8, 0.000e+00_r8, 1.649e+09_r8, 3.378e+09_r8, 8.985e+09_r8,-3.362e+10_r8,& + 9.941e+09_r8, 8.110e+08_r8, 2.367e+09_r8, 2.020e+09_r8, 3.866e+08_r8, 1.368e+09_r8,& + 3.049e+09_r8, 9.452e+09_r8,-3.249e+10_r8, 1.010e+10_r8, 6.212e+08_r8, 2.117e+09_r8,& + 1.652e+09_r8, 3.711e+08_r8, 1.175e+09_r8, 2.747e+09_r8, 9.818e+09_r8,-3.165e+10_r8,& + 1.014e+10_r8, 5.470e+08_r8, 1.843e+09_r8, 1.391e+09_r8, 3.497e+08_r8, 1.033e+09_r8,& + 2.570e+09_r8, 1.008e+10_r8,-3.102e+10_r8, 1.017e+10_r8, 5.121e+08_r8, 1.552e+09_r8,& + 1.197e+09_r8, 3.329e+08_r8, 9.689e+08_r8, 2.427e+09_r8, 1.024e+10_r8,-3.056e+10_r8,& + 1.011e+10_r8, 4.521e+08_r8, 1.312e+09_r8, 9.961e+08_r8, 3.390e+08_r8, 9.867e+08_r8,& + 2.375e+09_r8, 1.032e+10_r8,-3.033e+10_r8, 1.011e+10_r8, 5.322e+08_r8, 1.178e+09_r8/ + + data ((ao3(ix,js),js=1,9),ix=11,20)/ & + 8.408e+08_r8, 4.922e+08_r8, 9.226e+08_r8, 2.358e+09_r8, 1.039e+10_r8,-3.030e+10_r8,& + 1.004e+10_r8, 5.551e+08_r8, 1.141e+09_r8, 7.250e+08_r8, 5.353e+08_r8, 9.493e+08_r8,& + 2.497e+09_r8, 1.040e+10_r8,-3.047e+10_r8, 9.971e+09_r8, 8.389e+08_r8, 9.122e+08_r8,& + 6.484e+08_r8, 5.214e+08_r8, 1.014e+09_r8, 2.625e+09_r8, 1.038e+10_r8,-3.058e+10_r8,& + 9.903e+09_r8, 7.720e+08_r8, 9.455e+08_r8, 5.785e+08_r8, 4.987e+08_r8, 1.037e+09_r8,& + 2.694e+09_r8, 1.039e+10_r8,-3.089e+10_r8, 9.698e+09_r8, 1.068e+09_r8, 8.903e+08_r8,& + 5.272e+08_r8, 4.955e+08_r8, 1.194e+09_r8, 2.998e+09_r8, 1.026e+10_r8,-3.160e+10_r8,& + 9.466e+09_r8, 1.239e+09_r8, 9.659e+08_r8, 4.891e+08_r8, 5.131e+08_r8, 1.299e+09_r8,& + 3.456e+09_r8, 1.016e+10_r8,-3.275e+10_r8, 9.003e+09_r8, 1.593e+09_r8, 1.083e+09_r8,& + 4.643e+08_r8, 5.668e+08_r8, 1.500e+09_r8, 4.096e+09_r8, 9.972e+09_r8,-3.422e+10_r8,& + 8.345e+09_r8, 1.790e+09_r8, 1.256e+09_r8, 4.461e+08_r8, 6.391e+08_r8, 1.870e+09_r8,& + 4.881e+09_r8, 9.608e+09_r8,-3.621e+10_r8, 7.386e+09_r8, 2.105e+09_r8, 1.460e+09_r8,& + 6.471e+08_r8, 1.536e+08_r8, 2.567e+09_r8, 5.909e+09_r8, 9.088e+09_r8,-3.844e+10_r8,& + 6.248e+09_r8, 2.173e+09_r8, 1.536e+09_r8, 5.377e+08_r8, 1.101e+08_r8, 3.474e+09_r8,& + 6.992e+09_r8, 8.333e+09_r8,-4.065e+10_r8, 4.979e+09_r8, 2.019e+09_r8, 1.594e+09_r8/ + + data ((ao3(ix,js),js=1,9),ix=21,30)/ & + 7.064e+08_r8, 1.346e+08_r8, 4.535e+09_r8, 7.814e+09_r8, 7.361e+09_r8,-4.248e+10_r8,& + 3.786e+09_r8, 1.733e+09_r8, 1.431e+09_r8, 1.210e+09_r8, 2.133e+08_r8, 5.772e+09_r8,& + 8.402e+09_r8, 6.184e+09_r8,-4.400e+10_r8, 2.883e+09_r8, 1.530e+09_r8, 1.163e+09_r8,& + 2.121e+09_r8, 3.450e+08_r8, 7.111e+09_r8, 8.611e+09_r8, 4.874e+09_r8,-4.499e+10_r8,& + 2.055e+09_r8, 1.126e+09_r8, 8.840e+08_r8, 3.393e+09_r8, 5.066e+08_r8, 8.176e+09_r8,& + 8.419e+09_r8, 3.777e+09_r8,-4.573e+10_r8, 1.418e+09_r8, 8.927e+08_r8, 6.356e+08_r8,& + 4.838e+09_r8, 6.534e+08_r8, 9.188e+09_r8, 7.895e+09_r8, 2.746e+09_r8,-4.628e+10_r8,& + 9.548e+08_r8, 6.033e+08_r8, 4.810e+08_r8, 5.852e+09_r8, 1.286e+09_r8, 9.867e+09_r8,& + 7.121e+09_r8, 2.046e+09_r8,-4.663e+10_r8, 6.643e+08_r8, 4.034e+08_r8, 2.258e+08_r8,& + 6.624e+09_r8, 2.439e+09_r8, 1.044e+10_r8, 5.950e+09_r8, 1.380e+09_r8,-4.691e+10_r8,& + 4.209e+08_r8, 2.635e+08_r8, 2.211e+08_r8, 7.030e+09_r8, 3.865e+09_r8, 1.055e+10_r8,& + 4.781e+09_r8, 1.009e+09_r8,-4.708e+10_r8, 3.238e+08_r8, 2.107e+08_r8, 1.094e+08_r8,& + 8.099e+09_r8, 4.843e+09_r8, 1.065e+10_r8, 3.732e+09_r8, 6.798e+08_r8,-4.719e+10_r8,& + 1.852e+08_r8, 1.233e+08_r8, 1.513e+08_r8, 8.382e+09_r8, 6.426e+09_r8, 1.018e+10_r8,& + 2.771e+09_r8, 4.593e+08_r8,-4.726e+10_r8, 1.084e+08_r8, 8.368e+07_r8, 0.000e+00_r8/ + + data ((ao3(ix,js),js=1,9),ix=31,35)/ & + 9.545e+09_r8, 7.667e+09_r8, 9.429e+09_r8, 1.927e+09_r8, 3.143e+08_r8,-4.731e+10_r8,& + 7.075e+07_r8, 5.179e+07_r8, 0.000e+00_r8, 1.036e+10_r8, 9.146e+09_r8, 8.014e+09_r8,& + 1.355e+09_r8, 2.280e+08_r8,-4.734e+10_r8, 4.459e+07_r8, 3.463e+07_r8, 0.000e+00_r8,& + 1.180e+10_r8, 1.021e+10_r8, 6.725e+09_r8, 9.575e+08_r8, 1.091e+08_r8,-4.736e+10_r8,& + 3.018e+07_r8, 2.000e+07_r8, 0.000e+00_r8, 8.878e+09_r8, 7.184e+09_r8, 3.569e+09_r8,& + 4.023e+08_r8, 4.656e+07_r8,-3.079e+10_r8, 1.374e+07_r8, 0.000e+00_r8, 0.000e+00_r8,& + 4.652e+09_r8, 3.469e+09_r8, 1.385e+09_r8, 1.114e+08_r8, 1.368e+07_r8,-1.421e+10_r8,& + 3.553e+06_r8, 0.000e+00_r8, 0.000e+00_r8/ + + data ((a150(ix,js),js=1,9),ix=1,5)/ & + 2.5035e+01_r8, 0.0000e+00_r8, 9.4137e+01_r8, 2.4765e+03_r8, 3.2467e+03_r8, & + -1.1090e+04_r8, 4.0701e+02_r8, 2.1062e+03_r8, 6.1997e+02_r8, 3.1497e+01_r8, & + 0.0000e+00_r8, 1.5661e+02_r8, 3.1886e+03_r8, 3.0556e+03_r8,-1.2560e+04_r8, & + 2.1713e+02_r8, 2.2157e+03_r8, 7.7184e+02_r8, 3.6209e+01_r8, 0.0000e+00_r8, & + 2.5391e+02_r8, 3.8867e+03_r8, 2.8525e+03_r8,-1.4009e+04_r8,-3.8903e+00_r8, & + 2.2576e+03_r8, 9.1027e+02_r8, 3.9456e+01_r8, 0.0000e+00_r8, 4.0539e+02_r8, & + 4.4674e+03_r8, 2.6199e+03_r8,-1.5203e+04_r8,-2.0232e+02_r8, 2.2454e+03_r8, & + 1.0123e+03_r8, 4.3855e+01_r8, 0.0000e+00_r8, 6.3518e+02_r8, 4.9490e+03_r8, & + 2.3873e+03_r8,-1.6282e+04_r8,-4.0148e+02_r8, 2.2334e+03_r8, 1.0983e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=6,10)/ & + 1.4880e+01_r8, 5.2053e+01_r8, 8.8187e+02_r8, 5.4055e+03_r8, 2.1311e+03_r8, & + -1.7305e+04_r8,-5.7150e+02_r8, 2.2465e+03_r8, 1.1736e+03_r8, 1.8779e+01_r8, & + 8.2377e+01_r8, 1.1180e+03_r8, 5.7943e+03_r8, 1.8908e+03_r8,-1.8247e+04_r8, & + -7.1038e+02_r8, 2.3030e+03_r8, 1.2335e+03_r8, 2.3004e+01_r8, 1.2959e+02_r8, & + 1.3044e+03_r8, 6.1369e+03_r8, 1.6879e+03_r8,-1.9121e+04_r8,-8.4776e+02_r8, & + 2.4019e+03_r8, 1.2764e+03_r8, 2.7051e+01_r8, 1.9749e+02_r8, 1.4427e+03_r8, & + 6.4390e+03_r8, 1.4997e+03_r8,-1.9896e+04_r8,-9.8529e+02_r8, 2.5405e+03_r8, & + 1.2946e+03_r8, 3.0107e+01_r8, 2.8477e+02_r8, 1.5605e+03_r8, 6.6846e+03_r8, & + 1.3469e+03_r8,-2.0582e+04_r8,-1.1115e+03_r8, 2.7010e+03_r8, 1.2951e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=11,15)/ & + 3.3100e+01_r8, 3.8721e+02_r8, 1.6772e+03_r8, 6.8908e+03_r8, 1.2666e+03_r8, & + -2.1299e+04_r8,-1.2333e+03_r8, 2.9002e+03_r8, 1.2922e+03_r8, 3.6769e+01_r8, & + 5.0026e+02_r8, 1.8186e+03_r8, 7.0844e+03_r8, 1.2377e+03_r8,-2.2143e+04_r8, & + -1.3997e+03_r8, 3.1384e+03_r8, 1.3038e+03_r8, 4.0958e+01_r8, 6.2580e+02_r8, & + 1.9791e+03_r8, 7.3078e+03_r8, 1.1888e+03_r8,-2.3138e+04_r8,-1.5839e+03_r8, & + 3.4194e+03_r8, 1.3343e+03_r8, 4.5506e+01_r8, 7.5175e+02_r8, 2.1209e+03_r8, & + 7.5851e+03_r8, 1.1225e+03_r8,-2.4221e+04_r8,-1.8076e+03_r8, 3.7350e+03_r8, & + 1.3778e+03_r8, 5.0606e+01_r8, 8.8360e+02_r8, 2.2346e+03_r8, 7.9275e+03_r8, & + 1.0078e+03_r8,-2.5290e+04_r8,-2.0653e+03_r8, 4.0577e+03_r8, 1.4264e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=16,20)/ & + 5.6331e+01_r8, 1.0256e+03_r8, 2.3251e+03_r8, 8.3240e+03_r8, 8.5705e+02_r8, & + -2.6376e+04_r8,-2.3440e+03_r8, 4.3896e+03_r8, 1.4827e+03_r8, 6.2586e+01_r8, & + 1.1799e+03_r8, 2.4192e+03_r8, 8.7537e+03_r8, 7.1111e+02_r8,-2.7532e+04_r8, & + -2.6284e+03_r8, 4.7408e+03_r8, 1.5489e+03_r8, 6.9499e+01_r8, 1.3513e+03_r8, & + 2.5385e+03_r8, 9.2024e+03_r8, 5.9855e+02_r8,-2.8837e+04_r8,-2.9066e+03_r8, & + 5.1230e+03_r8, 1.6315e+03_r8, 9.8718e+01_r8, 1.4643e+03_r8, 2.7198e+03_r8, & + 9.6727e+03_r8, 5.6542e+02_r8,-3.0324e+04_r8,-3.1708e+03_r8, 5.5386e+03_r8, & + 1.7411e+03_r8, 1.4214e+02_r8, 1.5587e+03_r8, 2.9412e+03_r8, 1.0183e+04_r8, & + 6.2959e+02_r8,-3.2074e+04_r8,-3.4238e+03_r8, 5.9832e+03_r8, 1.8906e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=21,25)/ & + 2.0882e+02_r8, 1.6315e+03_r8, 3.1941e+03_r8, 1.0757e+04_r8, 8.0531e+02_r8, & + -3.4141e+04_r8,-3.6662e+03_r8, 6.4368e+03_r8, 2.0964e+03_r8, 3.0513e+02_r8, & + 1.6987e+03_r8, 3.4635e+03_r8, 1.1429e+04_r8, 1.0747e+03_r8,-3.6585e+04_r8, & + -3.8843e+03_r8, 6.8932e+03_r8, 2.3807e+03_r8, 4.3086e+02_r8, 1.7634e+03_r8, & + 3.7650e+03_r8, 1.2253e+04_r8, 1.4449e+03_r8,-3.9487e+04_r8,-4.0949e+03_r8, & + 7.3521e+03_r8, 2.7604e+03_r8, 5.6228e+02_r8, 1.8545e+03_r8, 4.0922e+03_r8, & + 1.3286e+04_r8, 1.8655e+03_r8,-4.2969e+04_r8,-4.3141e+03_r8, 7.7726e+03_r8, & + 3.3137e+03_r8, 6.5591e+02_r8, 1.9789e+03_r8, 4.4192e+03_r8, 1.4473e+04_r8, & + 2.2732e+03_r8,-4.6758e+04_r8,-4.5119e+03_r8, 8.1060e+03_r8, 4.0069e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=26,31)/ & + 7.1489e+02_r8, 2.1391e+03_r8, 4.7555e+03_r8, 1.5792e+04_r8, 2.6329e+03_r8, & + -5.0784e+04_r8,-4.6936e+03_r8, 8.3781e+03_r8, 4.7906e+03_r8, 7.5917e+02_r8, & + 2.3306e+03_r8, 5.1321e+03_r8, 1.7236e+04_r8, 2.9779e+03_r8,-5.5179e+04_r8, & + -4.8828e+03_r8, 8.7136e+03_r8, 5.5138e+03_r8, 8.1061e+02_r8, 2.5462e+03_r8, & + 5.5725e+03_r8, 1.8761e+04_r8, 3.3368e+03_r8,-6.0007e+04_r8,-5.0788e+03_r8, & + 9.1950e+03_r8, 6.1026e+03_r8, 8.6939e+02_r8, 2.7684e+03_r8, 6.1037e+03_r8, & + 2.0165e+04_r8, 3.7711e+03_r8,-6.4792e+04_r8,-5.2866e+03_r8, 9.9049e+03_r8, & + 6.1727e+03_r8, 9.4294e+02_r8, 3.0123e+03_r8, 6.6875e+03_r8, 2.1225e+04_r8, & + 4.4266e+03_r8,-6.9341e+04_r8,-5.5392e+03_r8, 1.1040e+04_r8, 5.5220e+03_r8, & + 1.0189e+03_r8, 3.2497e+03_r8, 7.2300e+03_r8, 2.0698e+04_r8, 5.1305e+03_r8, & + -7.1191e+04_r8,-5.7478e+03_r8, 1.2510e+04_r8, 3.5534e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=32,37)/ & + 1.1449e+03_r8, 3.7084e+03_r8, 7.4630e+03_r8, 1.9495e+04_r8, 5.5511e+03_r8, & + -7.3819e+04_r8,-5.4997e+03_r8, 1.4972e+04_r8, 2.3195e+03_r8, 1.2999e+03_r8, & + 4.3325e+03_r8, 7.4755e+03_r8, 1.6338e+04_r8, 5.1750e+03_r8,-7.5166e+04_r8, & + -4.4753e+03_r8, 1.7530e+04_r8, 2.4555e+03_r8, 1.4512e+03_r8, 5.0331e+03_r8, & + 7.0224e+03_r8, 1.5180e+04_r8, 3.2675e+03_r8,-7.8134e+04_r8,-3.0385e+03_r8, & + 2.0430e+04_r8, 2.7439e+03_r8, 1.5838e+03_r8, 5.7655e+03_r8, 6.0092e+03_r8, & + 1.4199e+04_r8, 5.0935e+03_r8,-8.0938e+04_r8,-3.1873e+03_r8, 2.1397e+04_r8, & + 2.3826e+03_r8, 1.6805e+03_r8, 6.6768e+03_r8, 4.2956e+03_r8, 1.4811e+04_r8, & + 8.4327e+03_r8,-8.6256e+04_r8,-4.1912e+03_r8, 2.2919e+04_r8, 1.4885e+03_r8, & + 1.7701e+03_r8, 7.7803e+03_r8, 3.4348e+03_r8, 1.8569e+04_r8, 1.3687e+04_r8, & + -1.0164e+05_r8,-6.1459e+03_r8, 2.7017e+04_r8, 1.4367e+03_r8/ + + data ((a150(ix,js),js=1,9),ix=38,43)/ & + 2.1081e+03_r8, 9.8559e+03_r8, 3.3385e+03_r8, 2.5453e+04_r8, 1.9163e+04_r8, & + -1.3508e+05_r8,-7.9100e+03_r8, 4.0371e+04_r8, 3.1637e+03_r8, 2.5117e+03_r8, & + 1.2043e+04_r8, 2.9837e+03_r8, 3.0525e+04_r8, 2.1190e+04_r8,-1.6547e+05_r8, & + -1.0361e+04_r8, 5.5753e+04_r8, 6.3850e+03_r8, 2.7271e+03_r8, 1.3131e+04_r8, & + 1.4005e+03_r8, 3.1777e+04_r8, 1.8261e+04_r8,-1.7548e+05_r8,-1.2891e+04_r8, & + 6.4744e+04_r8, 9.9029e+03_r8, 2.4817e+03_r8, 1.2549e+04_r8, 1.2521e+03_r8, & + 3.2506e+04_r8, 1.5901e+04_r8,-1.6344e+05_r8,-1.7080e+04_r8, 5.9506e+04_r8, & + 7.9804e+03_r8, 2.0450e+03_r8, 1.1403e+04_r8, 3.8851e+03_r8, 3.7098e+04_r8, & + 1.3215e+04_r8,-1.5453e+05_r8,-2.1257e+04_r8, 5.2256e+04_r8, 5.4705e+03_r8, & + 1.7609e+03_r8, 1.1782e+04_r8, 7.3394e+03_r8, 3.6003e+04_r8, 5.7292e+03_r8, & + -1.4489e+05_r8,-2.1518e+04_r8, 4.7419e+04_r8, 2.0765e+03_r8/ + + data ((b150(ix,js),js=1,9),ix=1,5)/ & + 3.5399e+03_r8, 0.0000e+00_r8, 6.0508e+03_r8, 5.9109e+04_r8, 2.4118e+04_r8, & + -1.8103e+05_r8,-7.3845e+02_r8, 1.8008e+04_r8, 1.7036e+04_r8, 3.1195e+03_r8, & + 0.0000e+00_r8, 6.9773e+03_r8, 5.7201e+04_r8, 2.0239e+04_r8,-1.7100e+05_r8, & + -2.3973e+03_r8, 1.8321e+04_r8, 1.5737e+04_r8, 3.0408e+03_r8, 0.0000e+00_r8, & + 9.0810e+03_r8, 5.5104e+04_r8, 1.3930e+04_r8,-1.6106e+05_r8,-4.9406e+03_r8, & + 1.6082e+04_r8, 1.4928e+04_r8, 3.2990e+03_r8, 0.0000e+00_r8, 1.3161e+04_r8, & + 5.6155e+04_r8, 1.0436e+04_r8,-1.6715e+05_r8,-7.0673e+03_r8, 1.5202e+04_r8, & + 1.5529e+04_r8, 3.5043e+03_r8, 0.0000e+00_r8, 1.8035e+04_r8, 5.4916e+04_r8, & + 7.8353e+03_r8,-1.7025e+05_r8,-8.4919e+03_r8, 1.4317e+04_r8, 1.5764e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=6,10)/ & + 1.8653e+03_r8, 2.7059e+03_r8, 1.9745e+04_r8, 5.4113e+04_r8, 5.9014e+03_r8, & + -1.7121e+05_r8,-9.3646e+03_r8, 1.3888e+04_r8, 1.5667e+04_r8, 2.0888e+03_r8, & + 3.6216e+03_r8, 1.9181e+04_r8, 5.2430e+04_r8, 4.3250e+03_r8,-1.6730e+05_r8, & + -9.8248e+03_r8, 1.3662e+04_r8, 1.5012e+04_r8, 2.2582e+03_r8, 4.7714e+03_r8, & + 1.7132e+04_r8, 4.9716e+04_r8, 2.5383e+03_r8,-1.5818e+05_r8,-1.0089e+04_r8, & + 1.3299e+04_r8, 1.3889e+04_r8, 2.4496e+03_r8, 6.2997e+03_r8, 1.5321e+04_r8, & + 4.8636e+04_r8, 9.3940e+02_r8,-1.5318e+05_r8,-1.0680e+04_r8, 1.3768e+04_r8, & + 1.2975e+04_r8, 2.7048e+03_r8, 8.2966e+03_r8, 1.4669e+04_r8, 4.9707e+04_r8, & + -6.8884e+02_r8,-1.5464e+05_r8,-1.1834e+04_r8, 1.4872e+04_r8, 1.2636e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=11,15)/ & + 3.0080e+03_r8, 1.0337e+04_r8, 1.4758e+04_r8, 5.1024e+04_r8,-2.2171e+03_r8, & + -1.5788e+05_r8,-1.3463e+04_r8, 1.6569e+04_r8, 1.2308e+04_r8, 3.3257e+03_r8, & + 1.2025e+04_r8, 1.5122e+04_r8, 5.1259e+04_r8,-3.7550e+03_r8,-1.5938e+05_r8, & + -1.5169e+04_r8, 1.8104e+04_r8, 1.1931e+04_r8, 3.6784e+03_r8, 1.3370e+04_r8, & + 1.5491e+04_r8, 5.0380e+04_r8,-5.6000e+03_r8,-1.5854e+05_r8,-1.6538e+04_r8, & + 1.9311e+04_r8, 1.1575e+04_r8, 4.0171e+03_r8, 1.4413e+04_r8, 1.5479e+04_r8, & + 4.8944e+04_r8,-7.1724e+03_r8,-1.5614e+05_r8,-1.7640e+04_r8, 2.0517e+04_r8, & + 1.1214e+04_r8, 4.3161e+03_r8, 1.5290e+04_r8, 1.5284e+04_r8, 4.8663e+04_r8, & + -7.7645e+03_r8,-1.5691e+05_r8,-1.8632e+04_r8, 2.2492e+04_r8, 1.1169e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=16,20)/ & + 4.6114e+03_r8, 1.6154e+04_r8, 1.4979e+04_r8, 4.9364e+04_r8,-7.9418e+03_r8, & + -1.6022e+05_r8,-1.9786e+04_r8, 2.5014e+04_r8, 1.1385e+04_r8, 4.8886e+03_r8, & + 1.7121e+04_r8, 1.4681e+04_r8, 5.0603e+04_r8,-8.0295e+03_r8,-1.6487e+05_r8, & + -2.1104e+04_r8, 2.7565e+04_r8, 1.1912e+04_r8, 5.1220e+03_r8, 1.8151e+04_r8, & + 1.4554e+04_r8, 5.2649e+04_r8,-8.0370e+03_r8,-1.7162e+05_r8,-2.2730e+04_r8, & + 3.0243e+04_r8, 1.2705e+04_r8, 6.9450e+03_r8, 1.4807e+04_r8, 1.6724e+04_r8, & + 5.6069e+04_r8,-8.0590e+03_r8,-1.8189e+05_r8,-2.4936e+04_r8, 3.3115e+04_r8, & + 1.4017e+04_r8, 9.4904e+03_r8, 1.0887e+04_r8, 1.9534e+04_r8, 6.0737e+04_r8, & + -8.1973e+03_r8,-1.9502e+05_r8,-2.7754e+04_r8, 3.5773e+04_r8, 1.5904e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=21,25)/ & + 1.3201e+04_r8, 6.7672e+03_r8, 2.2982e+04_r8, 6.6827e+04_r8,-8.7998e+03_r8, & + -2.1116e+05_r8,-3.1231e+04_r8, 3.7848e+04_r8, 1.8559e+04_r8, 1.8353e+04_r8, & + 2.9582e+03_r8, 2.7018e+04_r8, 7.4757e+04_r8,-1.0238e+04_r8,-2.3087e+05_r8, & + -3.5386e+04_r8, 3.9278e+04_r8, 2.2035e+04_r8, 2.4236e+04_r8,-7.1673e+00_r8, & + 3.1406e+04_r8, 8.4123e+04_r8,-1.2597e+04_r8,-2.5210e+05_r8,-3.9944e+04_r8, & + 3.9900e+04_r8, 2.5639e+04_r8, 2.8899e+04_r8,-1.8050e+03_r8, 3.5598e+04_r8, & + 9.3624e+04_r8,-1.6264e+04_r8,-2.7076e+05_r8,-4.3916e+04_r8, 3.8269e+04_r8, & + 2.9577e+04_r8, 3.2228e+04_r8,-2.3769e+03_r8, 4.1189e+04_r8, 1.0710e+05_r8, & + -2.1940e+04_r8,-2.9820e+05_r8,-4.9133e+04_r8, 3.6912e+04_r8, 3.4890e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=26,31)/ & + 3.4901e+04_r8,-1.7054e+03_r8, 4.9616e+04_r8, 1.2729e+05_r8,-2.9857e+04_r8, & + -3.4296e+05_r8,-5.6738e+04_r8, 3.7392e+04_r8, 4.2347e+04_r8, 3.7694e+04_r8, & + 2.6968e+02_r8, 6.1729e+04_r8, 1.5470e+05_r8,-4.0354e+04_r8,-4.0768e+05_r8, & + -6.7248e+04_r8, 4.0115e+04_r8, 5.1589e+04_r8, 4.0809e+04_r8, 4.1844e+03_r8, & + 7.8173e+04_r8, 1.8915e+05_r8,-5.3538e+04_r8,-4.9425e+05_r8,-8.0910e+04_r8, & + 4.5420e+04_r8, 6.2215e+04_r8, 4.3379e+04_r8, 1.0525e+04_r8, 9.9171e+04_r8, & + 2.2658e+05_r8,-6.7757e+04_r8,-5.9481e+05_r8,-9.6665e+04_r8, 5.4277e+04_r8, & + 6.9248e+04_r8, 4.5667e+04_r8, 1.9161e+04_r8, 1.2399e+05_r8, 2.5979e+05_r8, & + -8.0920e+04_r8,-6.9722e+05_r8,-1.1391e+05_r8, 6.8928e+04_r8, 6.7840e+04_r8, & + 4.8149e+04_r8, 2.9647e+04_r8, 1.5197e+05_r8, 2.6905e+05_r8,-9.0125e+04_r8, & + -7.6851e+05_r8,-1.3001e+05_r8, 8.9270e+04_r8, 4.9048e+04_r8/ + + data ((b150(ix,js),js=1,9),ix=32,37)/ & + 5.1966e+04_r8, 4.5702e+04_r8, 1.7720e+05_r8, 2.6058e+05_r8,-9.9247e+04_r8, & + -8.4400e+05_r8,-1.4248e+05_r8, 1.1906e+05_r8, 3.5837e+04_r8, 5.7382e+04_r8, & + 6.7581e+04_r8, 1.9871e+05_r8, 2.1424e+05_r8,-1.0592e+05_r8,-9.0196e+05_r8, & + -1.4324e+05_r8, 1.4835e+05_r8, 3.8639e+04_r8, 6.3804e+04_r8, 9.4177e+04_r8, & + 2.0441e+05_r8, 1.9644e+05_r8,-1.3089e+05_r8,-9.7326e+05_r8,-1.3977e+05_r8, & + 1.7913e+05_r8, 4.3016e+04_r8, 7.0638e+04_r8, 1.2395e+05_r8, 1.8916e+05_r8, & + 1.7195e+05_r8,-1.1044e+05_r8,-1.0265e+06_r8,-1.4544e+05_r8, 1.9545e+05_r8, & + 3.6843e+04_r8, 7.6839e+04_r8, 1.6172e+05_r8, 1.4909e+05_r8, 1.6911e+05_r8, & + -7.5704e+04_r8,-1.0973e+06_r8,-1.5936e+05_r8, 2.1662e+05_r8, 2.4064e+04_r8, & + 8.3232e+04_r8, 2.0819e+05_r8, 1.2835e+05_r8, 2.0677e+05_r8,-3.6307e+04_r8, & + -1.2961e+06_r8,-1.9272e+05_r8, 2.6288e+05_r8, 2.1977e+04_r8/ + data ((b150(ix,js),js=1,9),ix=38,43)/ & + 9.6157e+04_r8, 2.8562e+05_r8, 1.1966e+05_r8, 2.8749e+05_r8,-1.2237e+04_r8, & + -1.7528e+06_r8,-2.4263e+05_r8, 4.0970e+05_r8, 4.1317e+04_r8, 1.1357e+05_r8, & + 3.7596e+05_r8, 9.8652e+04_r8, 3.6598e+05_r8, 1.6096e+04_r8,-2.2962e+06_r8, & + -2.8607e+05_r8, 6.2929e+05_r8, 7.4848e+04_r8, 1.2829e+05_r8, 4.4149e+05_r8, & + 4.2542e+04_r8, 4.3449e+05_r8, 3.5764e+04_r8,-2.7327e+06_r8,-3.1740e+05_r8, & + 8.5228e+05_r8, 1.2250e+05_r8, 1.2481e+05_r8, 4.3349e+05_r8, 3.3622e+04_r8, & + 4.8685e+05_r8, 7.3970e+04_r8,-2.7619e+06_r8,-3.5847e+05_r8, 8.7436e+05_r8, & + 1.0368e+05_r8, 1.0994e+05_r8, 3.7480e+05_r8, 1.2328e+05_r8, 6.1220e+05_r8, & + 7.4486e+04_r8,-2.8231e+06_r8,-4.3841e+05_r8, 8.4803e+05_r8, 7.9803e+04_r8, & + 1.0138e+05_r8, 3.7276e+05_r8, 2.4376e+05_r8, 7.1193e+05_r8, 1.4092e+05_r8, & + -3.3243e+06_r8,-4.4325e+05_r8, 1.0532e+06_r8, 3.2305e+04_r8/ + + data ((a360(ix,js),js=1,9),ix=1,5)/ & + 1.7094e+01_r8, 0.0000e+00_r8, 8.2972e+01_r8, 2.5829e+03_r8, 4.4982e+03_r8, & + -1.3393e+04_r8, 9.4326e+02_r8, 2.8560e+03_r8, 5.4669e+02_r8, 2.2911e+01_r8, & + 0.0000e+00_r8, 1.4184e+02_r8, 3.4315e+03_r8, 4.6065e+03_r8,-1.5742e+04_r8, & + 7.9383e+02_r8, 3.2302e+03_r8, 7.5442e+02_r8, 2.7345e+01_r8, 0.0000e+00_r8, & + 2.3163e+02_r8, 4.3474e+03_r8, 4.7106e+03_r8,-1.8243e+04_r8, 5.5670e+02_r8, & + 3.4688e+03_r8, 9.8490e+02_r8, 3.0814e+01_r8, 0.0000e+00_r8, 3.7251e+02_r8, & + 5.2547e+03_r8, 4.7045e+03_r8,-2.0572e+04_r8, 3.1055e+02_r8, 3.5462e+03_r8, & + 1.2007e+03_r8, 3.5494e+01_r8, 0.0000e+00_r8, 5.9797e+02_r8, 6.1381e+03_r8, & + 4.5752e+03_r8,-2.2700e+04_r8,-9.7490e-02_r8, 3.5437e+03_r8, 1.3996e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=6,10)/ & + 9.1340e+00_r8, 4.8891e+01_r8, 8.6264e+02_r8, 7.0522e+03_r8, 4.2702e+03_r8, & + -2.4662e+04_r8,-3.0600e+02_r8, 3.5640e+03_r8, 1.5687e+03_r8, 1.2880e+01_r8, & + 8.0570e+01_r8, 1.1535e+03_r8, 7.8722e+03_r8, 3.8761e+03_r8,-2.6396e+04_r8, & + -5.6181e+02_r8, 3.6560e+03_r8, 1.7011e+03_r8, 1.7276e+01_r8, 1.3152e+02_r8, & + 1.4156e+03_r8, 8.5681e+03_r8, 3.5175e+03_r8,-2.7925e+04_r8,-8.2205e+02_r8, & + 3.8262e+03_r8, 1.7943e+03_r8, 2.1698e+01_r8, 2.0535e+02_r8, 1.6357e+03_r8, & + 9.1928e+03_r8, 3.1758e+03_r8,-2.9308e+04_r8,-1.0872e+03_r8, 4.0624e+03_r8, & + 1.8441e+03_r8, 2.5396e+01_r8, 2.9819e+02_r8, 1.8384e+03_r8, 9.7178e+03_r8, & + 2.8742e+03_r8,-3.0523e+04_r8,-1.3368e+03_r8, 4.3248e+03_r8, 1.8525e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=11,15)/ & + 2.8749e+01_r8, 4.0334e+02_r8, 2.0531e+03_r8, 1.0151e+04_r8, 2.6704e+03_r8, & + -3.1682e+04_r8,-1.5687e+03_r8, 4.6207e+03_r8, 1.8353e+03_r8, 3.2301e+01_r8, & + 5.2404e+02_r8, 2.3304e+03_r8, 1.0546e+04_r8, 2.5451e+03_r8,-3.2994e+04_r8, & + -1.8650e+03_r8, 4.9665e+03_r8, 1.8239e+03_r8, 3.6168e+01_r8, 6.6265e+02_r8, & + 2.6543e+03_r8, 1.0920e+04_r8, 2.3793e+03_r8,-3.4430e+04_r8,-2.1422e+03_r8, & + 5.3802e+03_r8, 1.8279e+03_r8, 4.0172e+01_r8, 8.1883e+02_r8, 2.9511e+03_r8, & + 1.1315e+04_r8, 2.2543e+03_r8,-3.6037e+04_r8,-2.4455e+03_r8, 5.8820e+03_r8, & + 1.8575e+03_r8, 4.4122e+01_r8, 9.9436e+02_r8, 3.1962e+03_r8, 1.1812e+04_r8, & + 2.1571e+03_r8,-3.7838e+04_r8,-2.7947e+03_r8, 6.4488e+03_r8, 1.9130e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=16,20)/ & + 4.8635e+01_r8, 1.1934e+03_r8, 3.3757e+03_r8, 1.2365e+04_r8, 2.0383e+03_r8, & + -3.9649e+04_r8,-3.1911e+03_r8, 7.0180e+03_r8, 1.9862e+03_r8, 5.4146e+01_r8, & + 1.4193e+03_r8, 3.5325e+03_r8, 1.2990e+04_r8, 1.9202e+03_r8,-4.1577e+04_r8, & + -3.6210e+03_r8, 7.5891e+03_r8, 2.0823e+03_r8, 6.0556e+01_r8, 1.6705e+03_r8, & + 3.6979e+03_r8, 1.3664e+04_r8, 1.8183e+03_r8,-4.3643e+04_r8,-4.0505e+03_r8, & + 8.1520e+03_r8, 2.1988e+03_r8, 8.8450e+01_r8, 1.8763e+03_r8, 3.9281e+03_r8, & + 1.4427e+04_r8, 1.7944e+03_r8,-4.6000e+04_r8,-4.4724e+03_r8, 8.7616e+03_r8, & + 2.3413e+03_r8, 1.3066e+02_r8, 2.0515e+03_r8, 4.2101e+03_r8, 1.5254e+04_r8, & + 1.8910e+03_r8,-4.8678e+04_r8,-4.8678e+03_r8, 9.4122e+03_r8, 2.5201e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=21,25)/ & + 1.9627e+02_r8, 2.1888e+03_r8, 4.5373e+03_r8, 1.6134e+04_r8, 2.1484e+03_r8, & + -5.1718e+04_r8,-5.2303e+03_r8, 1.0080e+04_r8, 2.7544e+03_r8, 2.9253e+02_r8, & + 2.2999e+03_r8, 4.9057e+03_r8, 1.7119e+04_r8, 2.5685e+03_r8,-5.5267e+04_r8, & + -5.5588e+03_r8, 1.0805e+04_r8, 3.0452e+03_r8, 4.2069e+02_r8, 2.4046e+03_r8, & + 5.3221e+03_r8, 1.8287e+04_r8, 3.1724e+03_r8,-5.9480e+04_r8,-5.8650e+03_r8, & + 1.1590e+04_r8, 3.4422e+03_r8, 5.6565e+02_r8, 2.5471e+03_r8, 5.7802e+03_r8, & + 1.9750e+04_r8, 3.9225e+03_r8,-6.4671e+04_r8,-6.1721e+03_r8, 1.2437e+04_r8, & + 4.0778e+03_r8, 6.8164e+02_r8, 2.7280e+03_r8, 6.2513e+03_r8, 2.1474e+04_r8, & + 4.7161e+03_r8,-7.0534e+04_r8,-6.4551e+03_r8, 1.3250e+04_r8, 5.0017e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=26,31)/ & + 7.5815e+02_r8, 2.9531e+03_r8, 6.7397e+03_r8, 2.3465e+04_r8, 5.5030e+03_r8, & + -7.7007e+04_r8,-6.7321e+03_r8, 1.4003e+04_r8, 6.2391e+03_r8, 8.1943e+02_r8, & + 3.2232e+03_r8, 7.2806e+03_r8, 2.5738e+04_r8, 6.2592e+03_r8,-8.4190e+04_r8, & + -7.0625e+03_r8, 1.4724e+04_r8, 7.6781e+03_r8, 8.8343e+02_r8, 3.5281e+03_r8, & + 7.9013e+03_r8, 2.8287e+04_r8, 6.9149e+03_r8,-9.2081e+04_r8,-7.4700e+03_r8, & + 1.5391e+04_r8, 9.1934e+03_r8, 9.6259e+02_r8, 3.8750e+03_r8, 8.6310e+03_r8, & + 3.0544e+04_r8, 7.4519e+03_r8,-9.9873e+04_r8,-7.8232e+03_r8, 1.5896e+04_r8, & + 1.0647e+04_r8, 1.0657e+03_r8, 4.2669e+03_r8, 9.4391e+03_r8, 3.1950e+04_r8, & + 7.2098e+03_r8,-1.0632e+05_r8,-7.8389e+03_r8, 1.6552e+04_r8, 1.1656e+04_r8, & + 1.1918e+03_r8, 4.7413e+03_r8, 1.0192e+04_r8, 2.9994e+04_r8, 6.6001e+03_r8, & + -1.0795e+05_r8,-7.1220e+03_r8, 1.7021e+04_r8, 1.1715e+04_r8/ + + data ((a360(ix,js),js=1,9),ix=32,37)/ & + 1.3448e+03_r8, 5.3049e+03_r8, 1.0804e+04_r8, 2.8152e+04_r8, 3.0057e+03_r8, & + -1.0807e+05_r8,-5.8296e+03_r8, 1.9545e+04_r8, 1.0393e+04_r8, 1.5321e+03_r8, & + 6.0282e+03_r8, 1.1182e+04_r8, 2.4855e+04_r8, 3.6060e+03_r8,-1.0871e+05_r8, & + -5.2856e+03_r8, 2.0777e+04_r8, 8.2516e+03_r8, 1.7158e+03_r8, 6.8949e+03_r8, & + 1.0920e+04_r8, 2.3437e+04_r8, 1.3298e+03_r8,-1.1132e+05_r8,-4.5135e+03_r8, & + 2.5203e+04_r8, 6.1970e+03_r8, 1.9016e+03_r8, 7.9667e+03_r8, 9.9618e+03_r8, & + 2.0525e+04_r8, 4.2817e+03_r8,-1.1362e+05_r8,-5.0031e+03_r8, 2.7194e+04_r8, & + 4.4984e+03_r8, 2.1244e+03_r8, 9.3828e+03_r8, 7.5590e+03_r8, 1.9678e+04_r8, & + 7.0220e+03_r8,-1.2033e+05_r8,-4.9126e+03_r8, 3.1851e+04_r8, 3.8717e+03_r8, & + 2.3664e+03_r8, 1.1265e+04_r8, 5.6693e+03_r8, 2.1491e+04_r8, 1.1265e+04_r8, & + -1.3697e+05_r8,-5.7812e+03_r8, 4.0486e+04_r8, 2.9647e+03_r8/ + + data ((a360(ix,js),js=1,9),ix=38,43)/ & + 2.7913e+03_r8, 1.4030e+04_r8, 4.8102e+03_r8, 2.6050e+04_r8, 1.3722e+04_r8, & + -1.7247e+05_r8,-5.1546e+03_r8, 5.9806e+04_r8, 4.0151e+03_r8, 3.2048e+03_r8, & + 1.6855e+04_r8, 3.8414e+03_r8, 3.0267e+04_r8, 1.8679e+04_r8,-2.0901e+05_r8, & + -5.4977e+03_r8, 7.7718e+04_r8, 5.9062e+03_r8, 3.4514e+03_r8, 1.8244e+04_r8, & + 1.8858e+03_r8, 3.4031e+04_r8, 2.2001e+04_r8,-2.3196e+05_r8,-6.1386e+03_r8, & + 8.9356e+04_r8, 7.6331e+03_r8, 3.1735e+03_r8, 1.7858e+04_r8, 1.5239e+03_r8, & + 3.9874e+04_r8, 3.0144e+04_r8,-2.3702e+05_r8,-1.2064e+04_r8, 8.4326e+04_r8, & + 5.9467e+03_r8, 2.8899e+03_r8, 1.7226e+04_r8, 3.6062e+03_r8, 5.0991e+04_r8, & + 3.8346e+04_r8,-2.5185e+05_r8,-1.9277e+04_r8, 8.1480e+04_r8, 4.3808e+03_r8, & + 2.6308e+03_r8, 1.9510e+04_r8, 6.6321e+03_r8, 5.9251e+04_r8, 3.5217e+04_r8, & + -2.6413e+05_r8,-2.5896e+04_r8, 8.2704e+04_r8, 2.2345e+03_r8/ + + data ((b360(ix,js),js=1,9),ix=1,5)/ & + 3.3220e+03_r8, 0.0000e+00_r8, 7.3567e+03_r8, 7.6803e+04_r8, 3.6454e+04_r8, & + -2.4080e+05_r8, 4.5492e+03_r8, 1.9812e+04_r8, 2.4305e+04_r8, 3.2356e+03_r8, & + 0.0000e+00_r8, 8.9320e+03_r8, 7.6994e+04_r8, 3.5834e+04_r8,-2.4231e+05_r8, & + 2.8598e+03_r8, 2.5713e+04_r8, 2.2445e+04_r8, 3.4175e+03_r8, 0.0000e+00_r8, & + 1.2232e+04_r8, 7.7599e+04_r8, 2.9999e+04_r8,-2.4245e+05_r8,-8.9565e+02_r8, & + 2.5185e+04_r8, 2.2348e+04_r8, 3.8227e+03_r8, 0.0000e+00_r8, 1.8057e+04_r8, & + 7.7878e+04_r8, 2.1680e+04_r8,-2.4276e+05_r8,-4.7738e+03_r8, 2.1046e+04_r8, & + 2.3454e+04_r8, 4.1639e+03_r8, 0.0000e+00_r8, 2.5061e+04_r8, 7.5590e+04_r8, & + 1.6597e+04_r8,-2.4395e+05_r8,-7.3727e+03_r8, 1.8454e+04_r8, 2.4034e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=6,10)/ & + 2.0226e+03_r8, 3.6553e+03_r8, 2.7663e+04_r8, 7.4402e+04_r8, 1.3451e+04_r8, & + -2.4500e+05_r8,-9.0677e+03_r8, 1.7600e+04_r8, 2.4039e+04_r8, 2.3371e+03_r8, & + 4.9460e+03_r8, 2.6742e+04_r8, 7.3298e+04_r8, 1.1572e+04_r8,-2.4282e+05_r8, & + -1.0360e+04_r8, 1.8247e+04_r8, 2.3128e+04_r8, 2.5821e+03_r8, 6.5452e+03_r8, & + 2.3738e+04_r8, 7.1130e+04_r8, 9.2331e+03_r8,-2.3376e+05_r8,-1.1453e+04_r8, & + 1.8905e+04_r8, 2.1477e+04_r8, 2.8407e+03_r8, 8.7467e+03_r8, 2.1169e+04_r8, & + 6.9967e+04_r8, 6.3343e+03_r8,-2.2645e+05_r8,-1.2747e+04_r8, 1.9798e+04_r8, & + 2.0046e+04_r8, 3.1777e+03_r8, 1.1663e+04_r8, 2.0303e+04_r8, 7.1744e+04_r8, & + 3.4971e+03_r8,-2.2845e+05_r8,-1.4826e+04_r8, 2.1600e+04_r8, 1.9387e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=11,15)/ & + 3.5824e+03_r8, 1.4759e+04_r8, 2.0870e+04_r8, 7.5297e+04_r8, 1.1064e+03_r8, & + -2.3739e+05_r8,-1.7845e+04_r8, 2.4720e+04_r8, 1.8972e+04_r8, 4.0208e+03_r8, & + 1.7477e+04_r8, 2.2103e+04_r8, 7.8013e+04_r8,-1.3374e+03_r8,-2.4578e+05_r8, & + -2.1347e+04_r8, 2.7998e+04_r8, 1.8416e+04_r8, 4.4998e+03_r8, 1.9891e+04_r8, & + 2.3925e+04_r8, 8.0263e+04_r8,-4.0759e+03_r8,-2.5531e+05_r8,-2.4750e+04_r8, & + 3.1873e+04_r8, 1.7813e+04_r8, 4.9537e+03_r8, 2.1855e+04_r8, 2.5057e+04_r8, & + 8.0524e+04_r8,-6.6805e+03_r8,-2.5945e+05_r8,-2.7552e+04_r8, 3.5276e+04_r8, & + 1.6945e+04_r8, 5.3966e+03_r8, 2.3717e+04_r8, 2.5315e+04_r8, 7.9668e+04_r8, & + -8.9218e+03_r8,-2.5948e+05_r8,-2.9806e+04_r8, 3.8224e+04_r8, 1.5980e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=16,20)/ & + 5.8192e+03_r8, 2.5593e+04_r8, 2.5201e+04_r8, 8.0720e+04_r8,-9.4973e+03_r8, & + -2.6599e+05_r8,-3.1836e+04_r8, 4.2603e+04_r8, 1.5458e+04_r8, 6.2188e+03_r8, & + 2.7630e+04_r8, 2.4953e+04_r8, 8.2660e+04_r8,-9.0242e+03_r8,-2.7596e+05_r8, & + -3.3635e+04_r8, 4.7478e+04_r8, 1.5519e+04_r8, 6.5500e+03_r8, 2.9757e+04_r8, & + 2.5013e+04_r8, 8.6318e+04_r8,-7.6888e+03_r8,-2.9146e+05_r8,-3.5697e+04_r8, & + 5.3080e+04_r8, 1.6177e+04_r8, 8.8577e+03_r8, 2.6042e+04_r8, 2.7715e+04_r8, & + 9.1263e+04_r8,-5.6446e+03_r8,-3.1026e+05_r8,-3.8081e+04_r8, 5.8972e+04_r8, & + 1.7414e+04_r8, 1.2119e+04_r8, 2.1474e+04_r8, 3.1224e+04_r8, 9.7933e+04_r8, & + -3.2719e+03_r8,-3.3360e+05_r8,-4.1185e+04_r8, 6.4976e+04_r8, 1.9369e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=21,25)/ & + 1.6921e+04_r8, 1.6598e+04_r8, 3.5627e+04_r8, 1.0752e+05_r8,-5.1939e+02_r8, & + -3.6518e+05_r8,-4.5432e+04_r8, 7.1580e+04_r8, 2.2536e+04_r8, 2.3498e+04_r8, & + 1.2022e+04_r8, 4.0689e+04_r8, 1.2032e+05_r8, 2.3753e+03_r8,-4.0492e+05_r8, & + -5.0818e+04_r8, 7.8740e+04_r8, 2.7036e+04_r8, 3.1012e+04_r8, 8.2263e+03_r8, & + 4.6120e+04_r8, 1.3578e+05_r8, 5.0895e+03_r8,-4.4899e+05_r8,-5.7140e+04_r8, & + 8.5635e+04_r8, 3.2388e+04_r8, 3.6715e+04_r8, 5.6657e+03_r8, 5.0954e+04_r8, & + 1.5158e+05_r8, 6.0793e+03_r8,-4.8814e+05_r8,-6.2938e+04_r8, 8.8307e+04_r8, & + 3.9590e+04_r8, 4.0345e+04_r8, 4.5077e+03_r8, 5.6889e+04_r8, 1.7253e+05_r8, & + 4.4000e+03_r8,-5.3621e+05_r8,-7.0080e+04_r8, 8.9426e+04_r8, 5.0068e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=26,31)/ & + 4.3147e+04_r8, 4.5945e+03_r8, 6.5637e+04_r8, 2.0208e+05_r8,-1.4353e+03_r8, & + -6.0197e+05_r8,-8.0122e+04_r8, 9.0303e+04_r8, 6.4638e+04_r8, 4.5803e+04_r8, & + 6.1820e+03_r8, 7.8481e+04_r8, 2.4208e+05_r8,-1.2292e+04_r8,-6.9085e+05_r8, & + -9.4005e+04_r8, 9.2021e+04_r8, 8.2655e+04_r8, 4.8930e+04_r8, 9.7251e+03_r8, & + 9.6788e+04_r8, 2.9438e+05_r8,-2.8855e+04_r8,-8.0949e+05_r8,-1.1269e+05_r8, & + 9.5309e+04_r8, 1.0409e+05_r8, 5.2153e+04_r8, 1.5736e+04_r8, 1.2112e+05_r8, & + 3.5047e+05_r8,-4.9630e+04_r8,-9.4867e+05_r8,-1.3405e+05_r8, 9.9646e+04_r8, & + 1.2758e+05_r8, 5.5289e+04_r8, 2.5000e+04_r8, 1.5248e+05_r8, 4.0443e+05_r8, & + -7.8986e+04_r8,-1.1015e+06_r8,-1.5585e+05_r8, 1.0908e+05_r8, 1.4991e+05_r8, & + 5.8421e+04_r8, 3.7738e+04_r8, 1.8933e+05_r8, 4.1350e+05_r8,-1.1087e+05_r8, & + -1.2104e+06_r8,-1.6912e+05_r8, 1.1441e+05_r8, 1.6453e+05_r8/ + + data ((b360(ix,js),js=1,9),ix=32,37)/ & + 6.2520e+04_r8, 5.6218e+04_r8, 2.3453e+05_r8, 4.2779e+05_r8,-1.7334e+05_r8, & + -1.3347e+06_r8,-1.8177e+05_r8, 1.4998e+05_r8, 1.6136e+05_r8, 6.7847e+04_r8, & + 8.0624e+04_r8, 2.7957e+05_r8, 3.9240e+05_r8,-1.8747e+05_r8,-1.4391e+06_r8, & + -1.9884e+05_r8, 1.7445e+05_r8, 1.3890e+05_r8, 7.4315e+04_r8, 1.1285e+05_r8, & + 3.1347e+05_r8, 3.8243e+05_r8,-2.4294e+05_r8,-1.5620e+06_r8,-2.2047e+05_r8, & + 2.3239e+05_r8, 1.1589e+05_r8, 8.1983e+04_r8, 1.5529e+05_r8, 3.2509e+05_r8, & + 3.1830e+05_r8,-2.2382e+05_r8,-1.6485e+06_r8,-2.4782e+05_r8, 2.6696e+05_r8, & + 9.0607e+04_r8, 9.1461e+04_r8, 2.1130e+05_r8, 2.8260e+05_r8, 2.8233e+05_r8, & + -2.0994e+05_r8,-1.7623e+06_r8,-2.6761e+05_r8, 3.2415e+05_r8, 7.9589e+04_r8, & + 1.0184e+05_r8, 2.8912e+05_r8, 2.4285e+05_r8, 2.8782e+05_r8,-1.9263e+05_r8, & + -2.0088e+06_r8,-3.0816e+05_r8, 4.3060e+05_r8, 6.2821e+04_r8/ + + data ((b360(ix,js),js=1,9),ix=38,43)/ & + 1.1806e+05_r8, 4.0223e+05_r8, 2.2517e+05_r8, 3.3973e+05_r8,-2.3078e+05_r8, & + -2.5372e+06_r8,-3.5716e+05_r8, 6.5288e+05_r8, 7.7642e+04_r8, 1.3586e+05_r8, & + 5.2631e+05_r8, 1.8982e+05_r8, 3.9760e+05_r8,-2.1883e+05_r8,-3.1397e+06_r8, & + -4.0467e+05_r8, 8.8836e+05_r8, 1.0255e+05_r8, 1.5133e+05_r8, 6.1562e+05_r8, & + 1.0783e+05_r8, 4.8241e+05_r8,-1.6362e+05_r8,-3.6844e+06_r8,-4.1372e+05_r8, & + 1.1113e+06_r8, 1.2212e+05_r8, 1.5195e+05_r8, 6.5082e+05_r8, 7.2539e+04_r8, & + 6.3688e+05_r8, 5.3880e+04_r8,-4.1600e+06_r8,-4.5347e+05_r8, 1.2093e+06_r8, & + 9.2240e+04_r8, 1.4336e+05_r8, 6.1671e+05_r8, 1.2423e+05_r8, 8.1556e+05_r8, & + 1.3919e+05_r8,-4.2989e+06_r8,-5.6767e+05_r8, 1.1435e+06_r8, 6.9843e+04_r8, & + 1.3071e+05_r8, 6.5514e+05_r8, 1.9799e+05_r8, 8.8504e+05_r8, 9.0991e+04_r8, & + -4.2280e+06_r8,-6.1482e+05_r8, 1.0996e+06_r8, 3.0361e+04_r8/ + + data ((a540(ix,js),js=1,9),ix=1,5)/ & + 1.4046e+01_r8, 0.0000e+00_r8, 8.4121e+01_r8, 2.7000e+03_r8, 4.9855e+03_r8, & + -1.4428e+04_r8, 1.1932e+03_r8, 3.1112e+03_r8, 5.2292e+02_r8, 1.8382e+01_r8, & + 0.0000e+00_r8, 1.3808e+02_r8, 3.5508e+03_r8, 5.2498e+03_r8,-1.7036e+04_r8, & + 1.1096e+03_r8, 3.6461e+03_r8, 7.1571e+02_r8, 2.2854e+01_r8, 0.0000e+00_r8, & + 2.2670e+02_r8, 4.5327e+03_r8, 5.5670e+03_r8,-2.0072e+04_r8, 9.0698e+02_r8, & + 4.0662e+03_r8, 9.6773e+02_r8, 2.6788e+01_r8, 0.0000e+00_r8, 3.6639e+02_r8, & + 5.5619e+03_r8, 5.8004e+03_r8,-2.3126e+04_r8, 6.7679e+02_r8, 4.2755e+03_r8, & + 1.2365e+03_r8, 3.1310e+01_r8, 0.0000e+00_r8, 5.8732e+02_r8, 6.6192e+03_r8, & + 5.8620e+03_r8,-2.5990e+04_r8, 3.3715e+02_r8, 4.3206e+03_r8, 1.5084e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=6,10)/ & + 6.4043e+00_r8, 4.6835e+01_r8, 8.5364e+02_r8, 7.7821e+03_r8, 5.6476e+03_r8, & + -2.8674e+04_r8,-3.2399e+01_r8, 4.3542e+03_r8, 1.7554e+03_r8, 9.6264e+00_r8, & + 7.8879e+01_r8, 1.1548e+03_r8, 8.8791e+03_r8, 5.2330e+03_r8,-3.1025e+04_r8, & + -3.5404e+02_r8, 4.4739e+03_r8, 1.9480e+03_r8, 1.3550e+01_r8, 1.3075e+02_r8, & + 1.4391e+03_r8, 9.8097e+03_r8, 4.8032e+03_r8,-3.2995e+04_r8,-6.8661e+02_r8, & + 4.6960e+03_r8, 2.0777e+03_r8, 1.7714e+01_r8, 2.0669e+02_r8, 1.6861e+03_r8, & + 1.0641e+04_r8, 4.3793e+03_r8,-3.4751e+04_r8,-1.0292e+03_r8, 5.0045e+03_r8, & + 2.1496e+03_r8, 2.1444e+01_r8, 3.0070e+02_r8, 1.9210e+03_r8, 1.1366e+04_r8, & + 3.9995e+03_r8,-3.6335e+04_r8,-1.3571e+03_r8, 5.3448e+03_r8, 2.1701e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=11,15)/ & + 2.4860e+01_r8, 4.0590e+02_r8, 2.1813e+03_r8, 1.1988e+04_r8, 3.7302e+03_r8, & + -3.7857e+04_r8,-1.6700e+03_r8, 5.7183e+03_r8, 2.1533e+03_r8, 2.8308e+01_r8, & + 5.2176e+02_r8, 2.5305e+03_r8, 1.2550e+04_r8, 3.5359e+03_r8,-3.9488e+04_r8, & + -2.0723e+03_r8, 6.1238e+03_r8, 2.1332e+03_r8, 3.2231e+01_r8, 6.6569e+02_r8, & + 2.9583e+03_r8, 1.3080e+04_r8, 3.2613e+03_r8,-4.1264e+04_r8,-2.4406e+03_r8, & + 6.6123e+03_r8, 2.1193e+03_r8, 3.6139e+01_r8, 8.3147e+02_r8, 3.3614e+03_r8, & + 1.3578e+04_r8, 3.0508e+03_r8,-4.3167e+04_r8,-2.8085e+03_r8, 7.2030e+03_r8, & + 2.1301e+03_r8, 4.0256e+01_r8, 1.0297e+03_r8, 3.7022e+03_r8, 1.4171e+04_r8, & + 2.9128e+03_r8,-4.5336e+04_r8,-3.2104e+03_r8, 7.8946e+03_r8, 2.1776e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=16,20)/ & + 4.4889e+01_r8, 1.2599e+03_r8, 3.9615e+03_r8, 1.4830e+04_r8, 2.8030e+03_r8, & + -4.7625e+04_r8,-3.6641e+03_r8, 8.6225e+03_r8, 2.2558e+03_r8, 5.0015e+01_r8, & + 1.5224e+03_r8, 4.1757e+03_r8, 1.5557e+04_r8, 2.7204e+03_r8,-5.0044e+04_r8, & + -4.1690e+03_r8, 9.3569e+03_r8, 2.3618e+03_r8, 5.6369e+01_r8, 1.8214e+03_r8, & + 4.3850e+03_r8, 1.6354e+04_r8, 2.6560e+03_r8,-5.2643e+04_r8,-4.6917e+03_r8, & + 1.0073e+04_r8, 2.4979e+03_r8, 8.3103e+01_r8, 2.0790e+03_r8, 4.6427e+03_r8, & + 1.7254e+04_r8, 2.6678e+03_r8,-5.5501e+04_r8,-5.2101e+03_r8, 1.0809e+04_r8, & + 2.6617e+03_r8, 1.2393e+02_r8, 2.3045e+03_r8, 4.9515e+03_r8, 1.8262e+04_r8, & + 2.8040e+03_r8,-5.8738e+04_r8,-5.7019e+03_r8, 1.1579e+04_r8, 2.8680e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=21,25)/ & + 1.8908e+02_r8, 2.4870e+03_r8, 5.3135e+03_r8, 1.9357e+04_r8, 3.1110e+03_r8, & + -6.2419e+04_r8,-6.1562e+03_r8, 1.2371e+04_r8, 3.1342e+03_r8, 2.8397e+02_r8, & + 2.6277e+03_r8, 5.7304e+03_r8, 2.0564e+04_r8, 3.6012e+03_r8,-6.6647e+04_r8, & + -6.5563e+03_r8, 1.3212e+04_r8, 3.4531e+03_r8, 4.1265e+02_r8, 2.7604e+03_r8, & + 6.2057e+03_r8, 2.1959e+04_r8, 4.3164e+03_r8,-7.1623e+04_r8,-6.9163e+03_r8, & + 1.4129e+04_r8, 3.8711e+03_r8, 5.5908e+02_r8, 2.9304e+03_r8, 6.7324e+03_r8, & + 2.3661e+04_r8, 5.2276e+03_r8,-7.7697e+04_r8,-7.2578e+03_r8, 1.5148e+04_r8, & + 4.5144e+03_r8, 6.7735e+02_r8, 3.1384e+03_r8, 7.2790e+03_r8, 2.5647e+04_r8, & + 6.2256e+03_r8,-8.4578e+04_r8,-7.5573e+03_r8, 1.6206e+04_r8, 5.4499e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=26,31)/ & + 7.6095e+02_r8, 3.3936e+03_r8, 7.8572e+03_r8, 2.7951e+04_r8, 7.2729e+03_r8, & + -9.2312e+04_r8,-7.8460e+03_r8, 1.7305e+04_r8, 6.7468e+03_r8, 8.2152e+02_r8, & + 3.6897e+03_r8, 8.4910e+03_r8, 3.0565e+04_r8, 8.3712e+03_r8,-1.0096e+05_r8, & + -8.1788e+03_r8, 1.8426e+04_r8, 8.3335e+03_r8, 8.9734e+02_r8, 4.0371e+03_r8, & + 9.2179e+03_r8, 3.3541e+04_r8, 9.4243e+03_r8,-1.1068e+05_r8,-8.6295e+03_r8, & + 1.9539e+04_r8, 1.0194e+04_r8, 9.8654e+02_r8, 4.4310e+03_r8, 1.0051e+04_r8, & + 3.6202e+04_r8, 1.0341e+04_r8,-1.2033e+05_r8,-9.0465e+03_r8, 2.0323e+04_r8, & + 1.2170e+04_r8, 1.1010e+03_r8, 4.8898e+03_r8, 1.0979e+04_r8, 3.8051e+04_r8, & + 1.0183e+04_r8,-1.2865e+05_r8,-9.1689e+03_r8, 2.1141e+04_r8, 1.3739e+04_r8, & + 1.2523e+03_r8, 5.4507e+03_r8, 1.1845e+04_r8, 3.6056e+04_r8, 9.2641e+03_r8, & + -1.3103e+05_r8,-8.5702e+03_r8, 2.1465e+04_r8, 1.4032e+04_r8/ + + data ((a540(ix,js),js=1,9),ix=32,37)/ & + 1.4290e+03_r8, 6.1493e+03_r8, 1.2630e+04_r8, 3.4660e+04_r8, 4.6113e+03_r8, & + -1.3253e+05_r8,-7.6923e+03_r8, 2.5385e+04_r8, 1.1814e+04_r8, 1.6393e+03_r8, & + 6.9603e+03_r8, 1.3045e+04_r8, 3.1292e+04_r8, 5.0250e+03_r8,-1.3241e+05_r8, & + -8.0218e+03_r8, 2.7248e+04_r8, 8.1799e+03_r8, 1.8422e+03_r8, 7.9125e+03_r8, & + 1.2850e+04_r8, 2.9919e+04_r8, 1.6539e+03_r8,-1.3374e+05_r8,-7.5523e+03_r8, & + 3.2067e+04_r8, 5.4650e+03_r8, 2.0556e+03_r8, 9.1198e+03_r8, 1.1952e+04_r8, & + 2.6229e+04_r8, 5.4064e+03_r8,-1.3513e+05_r8,-8.5919e+03_r8, 3.3805e+04_r8, & + 3.3909e+03_r8, 2.3195e+03_r8, 1.0765e+04_r8, 9.4232e+03_r8, 2.4680e+04_r8, & + 7.8282e+03_r8,-1.4260e+05_r8,-8.1716e+03_r8, 3.9314e+04_r8, 3.2746e+03_r8, & + 2.6741e+03_r8, 1.3056e+04_r8, 7.3683e+03_r8, 2.5901e+04_r8, 1.1853e+04_r8, & + -1.6172e+05_r8,-8.6679e+03_r8, 4.9358e+04_r8, 3.1283e+03_r8/ + + data ((a540(ix,js),js=1,9),ix=38,43)/ & + 3.1274e+03_r8, 1.6190e+04_r8, 6.6171e+03_r8, 2.9852e+04_r8, 1.3996e+04_r8, & + -2.0033e+05_r8,-7.1656e+03_r8, 7.0586e+04_r8, 5.0072e+03_r8, 3.5342e+03_r8, & + 1.9357e+04_r8, 5.6559e+03_r8, 3.3611e+04_r8, 1.7828e+04_r8,-2.3702e+05_r8, & + -6.2284e+03_r8, 8.8163e+04_r8, 7.3170e+03_r8, 3.7834e+03_r8, 2.0965e+04_r8, & + 3.2588e+03_r8, 3.7010e+04_r8, 2.1189e+04_r8,-2.5903e+05_r8,-5.8621e+03_r8, & + 9.8554e+04_r8, 8.6223e+03_r8, 3.5046e+03_r8, 2.0797e+04_r8, 1.9896e+03_r8, & + 4.3329e+04_r8, 3.0815e+04_r8,-2.6553e+05_r8,-1.1030e+04_r8, 9.3433e+04_r8, & + 6.0978e+03_r8, 3.3389e+03_r8, 2.0607e+04_r8, 2.5567e+03_r8, 5.6928e+04_r8, & + 4.3500e+04_r8,-2.8735e+05_r8,-1.7834e+04_r8, 8.9701e+04_r8, 3.7020e+03_r8, & + 3.2675e+03_r8, 2.3717e+04_r8, 3.5488e+03_r8, 7.1174e+04_r8, 4.9418e+04_r8, & + -3.1866e+05_r8,-2.5099e+04_r8, 9.4302e+04_r8, 1.5043e+03_r8/ + + data ((b540(ix,js),js=1,9),ix=1,5)/ & + 2.9709e+03_r8, 0.0000e+00_r8, 7.2631e+03_r8, 8.2400e+04_r8, 4.6777e+04_r8, & + -2.6896e+05_r8, 8.8736e+03_r8, 2.2636e+04_r8, 2.6978e+04_r8, 3.1238e+03_r8, & + 0.0000e+00_r8, 9.6559e+03_r8, 8.7263e+04_r8, 4.5581e+04_r8,-2.8113e+05_r8, & + 6.5338e+03_r8, 3.0570e+04_r8, 2.5612e+04_r8, 3.4594e+03_r8, 0.0000e+00_r8, & + 1.3781e+04_r8, 9.1771e+04_r8, 4.2054e+04_r8,-2.9581e+05_r8, 2.4720e+03_r8, & + 3.2871e+04_r8, 2.6461e+04_r8, 3.9369e+03_r8, 0.0000e+00_r8, 2.0602e+04_r8, & + 9.1745e+04_r8, 3.0580e+04_r8,-2.9239e+05_r8,-2.5695e+03_r8, 2.6492e+04_r8, & + 2.8006e+04_r8, 4.3495e+03_r8, 0.0000e+00_r8, 2.8814e+04_r8, 8.7356e+04_r8, & + 2.1482e+04_r8,-2.8467e+05_r8,-6.3525e+03_r8, 2.1028e+04_r8, 2.8623e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=6,10)/ & + 2.0005e+03_r8, 4.0531e+03_r8, 3.1958e+04_r8, 8.4074e+04_r8, 1.6201e+04_r8, & + -2.7909e+05_r8,-8.6225e+03_r8, 1.8720e+04_r8, 2.8409e+04_r8, 2.3629e+03_r8, & + 5.5993e+03_r8, 3.1028e+04_r8, 8.2417e+04_r8, 1.3922e+04_r8,-2.7599e+05_r8, & + -1.0282e+04_r8, 1.9284e+04_r8, 2.7425e+04_r8, 2.6727e+03_r8, 7.5414e+03_r8, & + 2.7733e+04_r8, 8.1705e+04_r8, 1.1962e+04_r8,-2.7148e+05_r8,-1.1901e+04_r8, & + 2.0897e+04_r8, 2.5922e+04_r8, 2.9924e+03_r8, 1.0195e+04_r8, 2.4967e+04_r8, & + 8.2254e+04_r8, 9.0794e+03_r8,-2.6878e+05_r8,-1.3758e+04_r8, 2.2862e+04_r8, & + 2.4609e+04_r8, 3.3628e+03_r8, 1.3635e+04_r8, 2.4057e+04_r8, 8.5280e+04_r8, & + 5.7370e+03_r8,-2.7339e+05_r8,-1.6337e+04_r8, 2.5177e+04_r8, 2.4060e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=11,15)/ & + 3.7910e+03_r8, 1.7353e+04_r8, 2.4740e+04_r8, 8.9874e+04_r8, 2.8386e+03_r8, & + -2.8470e+05_r8,-2.0176e+04_r8, 2.9246e+04_r8, 2.3552e+04_r8, 4.2537e+03_r8, & + 2.0528e+04_r8, 2.6524e+04_r8, 9.4192e+04_r8,-1.9538e+02_r8,-2.9713e+05_r8, & + -2.4840e+04_r8, 3.3537e+04_r8, 2.3038e+04_r8, 4.7553e+03_r8, 2.3449e+04_r8, & + 2.8849e+04_r8, 9.7935e+04_r8,-3.3681e+03_r8,-3.1112e+05_r8,-2.9373e+04_r8, & + 3.8841e+04_r8, 2.2236e+04_r8, 5.2435e+03_r8, 2.5812e+04_r8, 3.0777e+04_r8, & + 1.0004e+05_r8,-6.4184e+03_r8,-3.2110e+05_r8,-3.3387e+04_r8, 4.3876e+04_r8, & + 2.1211e+04_r8, 5.7016e+03_r8, 2.8053e+04_r8, 3.1613e+04_r8, 1.0025e+05_r8, & + -9.2545e+03_r8,-3.2451e+05_r8,-3.6675e+04_r8, 4.8014e+04_r8, 1.9899e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=16,20)/ & + 6.1442e+03_r8, 3.0360e+04_r8, 3.1866e+04_r8, 1.0151e+05_r8,-1.0762e+04_r8, & + -3.3154e+05_r8,-3.9524e+04_r8, 5.3002e+04_r8, 1.8817e+04_r8, 6.5885e+03_r8, & + 3.3054e+04_r8, 3.1916e+04_r8, 1.0396e+05_r8,-1.0604e+04_r8,-3.4429e+05_r8, & + -4.1917e+04_r8, 5.8965e+04_r8, 1.8358e+04_r8, 6.9707e+03_r8, 3.5930e+04_r8, & + 3.2193e+04_r8, 1.0817e+05_r8,-8.9122e+03_r8,-3.6374e+05_r8,-4.4279e+04_r8, & + 6.5938e+04_r8, 1.8630e+04_r8, 9.5116e+03_r8, 3.2665e+04_r8, 3.5521e+04_r8, & + 1.1452e+05_r8,-5.9078e+03_r8,-3.9000e+05_r8,-4.7090e+04_r8, 7.3913e+04_r8, & + 1.9693e+04_r8, 1.3035e+04_r8, 2.8272e+04_r8, 3.9666e+04_r8, 1.2272e+05_r8, & + -1.9538e+03_r8,-4.2149e+05_r8,-5.0485e+04_r8, 8.2204e+04_r8, 2.1617e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=21,25)/ & + 1.8173e+04_r8, 2.3394e+04_r8, 4.4584e+04_r8, 1.3380e+05_r8, 2.9300e+03_r8, & + -4.6142e+05_r8,-5.4863e+04_r8, 9.1181e+04_r8, 2.4808e+04_r8, 2.5309e+04_r8, & + 1.8719e+04_r8, 5.0230e+04_r8, 1.4885e+05_r8, 8.6209e+03_r8,-5.1236e+05_r8, & + -6.0511e+04_r8, 1.0139e+05_r8, 2.9436e+04_r8, 3.3629e+04_r8, 1.4750e+04_r8, & + 5.6231e+04_r8, 1.6736e+05_r8, 1.4927e+04_r8,-5.7045e+05_r8,-6.7277e+04_r8, & + 1.1217e+05_r8, 3.5060e+04_r8, 3.9981e+04_r8, 1.1960e+04_r8, 6.1755e+04_r8, & + 1.8744e+05_r8, 2.0137e+04_r8,-6.2674e+05_r8,-7.3834e+04_r8, 1.1934e+05_r8, & + 4.3078e+04_r8, 4.4113e+04_r8, 1.0697e+04_r8, 6.8456e+04_r8, 2.1400e+05_r8, & + 2.3263e+04_r8,-6.9595e+05_r8,-8.2136e+04_r8, 1.2566e+05_r8, 5.5471e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=26,31)/ & + 4.7268e+04_r8, 1.0742e+04_r8, 7.7893e+04_r8, 2.5024e+05_r8, 2.2431e+04_r8, & + -7.8521e+05_r8,-9.3714e+04_r8, 1.3164e+05_r8, 7.3653e+04_r8, 5.0261e+04_r8, & + 1.2320e+04_r8, 9.1514e+04_r8, 2.9871e+05_r8, 1.5721e+04_r8,-9.0003e+05_r8, & + -1.0984e+05_r8, 1.3732e+05_r8, 9.7259e+04_r8, 5.3382e+04_r8, 1.5997e+04_r8, & + 1.1025e+05_r8, 3.6030e+05_r8, 1.6491e+03_r8,-1.0428e+06_r8,-1.3104e+05_r8, & + 1.4263e+05_r8, 1.2572e+05_r8, 5.6536e+04_r8, 2.2075e+04_r8, 1.3502e+05_r8, & + 4.2540e+05_r8,-1.9356e+04_r8,-1.2017e+06_r8,-1.5497e+05_r8, 1.4620e+05_r8, & + 1.5667e+05_r8, 5.9668e+04_r8, 3.1332e+04_r8, 1.6712e+05_r8, 4.8760e+05_r8, & + -5.2497e+04_r8,-1.3721e+06_r8,-1.7921e+05_r8, 1.5491e+05_r8, 1.8500e+05_r8, & + 6.3128e+04_r8, 4.4306e+04_r8, 2.0538e+05_r8, 5.0036e+05_r8,-8.8315e+04_r8, & + -1.5009e+06_r8,-1.9544e+05_r8, 1.6286e+05_r8, 2.0060e+05_r8/ + + data ((b540(ix,js),js=1,9),ix=32,37)/ & + 6.7252e+04_r8, 6.1350e+04_r8, 2.4981e+05_r8, 5.1866e+05_r8,-1.7393e+05_r8, & + -1.6079e+06_r8,-2.1616e+05_r8, 2.0514e+05_r8, 1.8421e+05_r8, 7.2523e+04_r8, & + 8.7077e+04_r8, 3.0032e+05_r8, 4.9795e+05_r8,-1.9374e+05_r8,-1.7488e+06_r8, & + -2.5154e+05_r8, 2.5270e+05_r8, 1.4108e+05_r8, 7.8557e+04_r8, 1.2085e+05_r8, & + 3.4369e+05_r8, 5.0559e+05_r8,-2.7072e+05_r8,-1.8995e+06_r8,-2.8633e+05_r8, & + 3.2697e+05_r8, 1.0954e+05_r8, 8.6092e+04_r8, 1.6790e+05_r8, 3.6976e+05_r8, & + 4.3787e+05_r8,-2.5173e+05_r8,-2.0235e+06_r8,-3.3252e+05_r8, 3.7066e+05_r8, & + 7.9724e+04_r8, 9.6434e+04_r8, 2.3315e+05_r8, 3.3902e+05_r8, 3.9461e+05_r8, & + -2.5455e+05_r8,-2.2059e+06_r8,-3.6308e+05_r8, 4.4700e+05_r8, 8.0952e+04_r8, & + 1.0946e+05_r8, 3.2289e+05_r8, 3.0583e+05_r8, 3.8625e+05_r8,-2.5579e+05_r8, & + -2.5156e+06_r8,-4.1451e+05_r8, 5.7253e+05_r8, 7.8418e+04_r8/ + + data ((b540(ix,js),js=1,9),ix=38,43)/ & + 1.2692e+05_r8, 4.4886e+05_r8, 3.0244e+05_r8, 4.2615e+05_r8,-3.1844e+05_r8, & + -3.1255e+06_r8,-4.6924e+05_r8, 8.2340e+05_r8, 1.1046e+05_r8, 1.4441e+05_r8, & + 5.8243e+05_r8, 2.7541e+05_r8, 4.7182e+05_r8,-3.3649e+05_r8,-3.7185e+06_r8, & + -5.1067e+05_r8, 1.0440e+06_r8, 1.4277e+05_r8, 1.5916e+05_r8, 6.7402e+05_r8, & + 1.8070e+05_r8, 5.5047e+05_r8,-2.9324e+05_r8,-4.2164e+06_r8,-5.1434e+05_r8, & + 1.2427e+06_r8, 1.5864e+05_r8, 1.6012e+05_r8, 7.2380e+05_r8, 1.1475e+05_r8, & + 7.1511e+05_r8,-6.9798e+04_r8,-4.6914e+06_r8,-5.4151e+05_r8, 1.3302e+06_r8, & + 1.1012e+05_r8, 1.5471e+05_r8, 7.0419e+05_r8, 1.1310e+05_r8, 8.8568e+05_r8, & + 2.4896e+04_r8,-4.6768e+06_r8,-6.3312e+05_r8, 1.1713e+06_r8, 6.4977e+04_r8, & + 1.5021e+05_r8, 7.9025e+05_r8, 1.1779e+05_r8, 1.0507e+06_r8, 1.1771e+05_r8, & + -4.9507e+06_r8,-6.8570e+05_r8, 1.1955e+06_r8, 2.3632e+04_r8/ + + data ((a720(ix,js),js=1,9),ix=1,5)/ & + 1.1000e+01_r8, 0.0000e+00_r8, 8.1568e+01_r8, 2.8044e+03_r8, 5.3898e+03_r8, & + -1.5286e+04_r8, 1.3891e+03_r8, 3.3052e+03_r8, 5.0976e+02_r8, 1.5350e+01_r8, & + 0.0000e+00_r8, 1.3680e+02_r8, 3.6955e+03_r8, 5.7560e+03_r8,-1.8147e+04_r8, & + 1.3596e+03_r8, 3.9557e+03_r8, 6.9200e+02_r8, 1.9863e+01_r8, 0.0000e+00_r8, & + 2.2561e+02_r8, 4.7049e+03_r8, 6.2084e+03_r8,-2.1486e+04_r8, 1.1961e+03_r8, & + 4.5137e+03_r8, 9.4594e+02_r8, 2.4344e+01_r8, 0.0000e+00_r8, 3.6564e+02_r8, & + 5.7723e+03_r8, 6.6036e+03_r8,-2.4949e+04_r8, 9.9205e+02_r8, 4.8226e+03_r8, & + 1.2417e+03_r8, 2.8832e+01_r8, 0.0000e+00_r8, 5.8203e+02_r8, 6.9163e+03_r8, & + 6.8325e+03_r8,-2.8322e+04_r8, 6.4255e+02_r8, 4.9144e+03_r8, 1.5622e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=6,10)/ & + 4.8883e+00_r8, 4.4839e+01_r8, 8.4544e+02_r8, 8.2527e+03_r8, 6.7546e+03_r8, & + -3.1641e+04_r8, 2.3650e+02_r8, 4.9722e+03_r8, 1.8764e+03_r8, 7.5913e+00_r8, & + 7.6632e+01_r8, 1.1494e+03_r8, 9.5596e+03_r8, 6.3700e+03_r8,-3.4538e+04_r8, & + -1.2944e+02_r8, 5.1143e+03_r8, 2.1263e+03_r8, 1.1092e+01_r8, 1.2916e+02_r8, & + 1.4465e+03_r8, 1.0700e+04_r8, 5.9160e+03_r8,-3.6968e+04_r8,-5.1496e+02_r8, & + 5.3844e+03_r8, 2.2995e+03_r8, 1.5051e+01_r8, 2.0677e+02_r8, 1.7088e+03_r8, & + 1.1710e+04_r8, 5.4364e+03_r8,-3.9056e+04_r8,-9.2065e+02_r8, 5.7632e+03_r8, & + 2.3914e+03_r8, 1.8844e+01_r8, 3.0261e+02_r8, 1.9641e+03_r8, 1.2606e+04_r8, & + 4.9993e+03_r8,-4.0960e+04_r8,-1.3152e+03_r8, 6.1798e+03_r8, 2.4231e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=11,15)/ & + 2.2391e+01_r8, 4.0801e+02_r8, 2.2543e+03_r8, 1.3383e+04_r8, 4.6738e+03_r8, & + -4.2763e+04_r8,-1.6992e+03_r8, 6.6211e+03_r8, 2.4071e+03_r8, 2.5971e+01_r8, & + 5.2138e+02_r8, 2.6560e+03_r8, 1.4114e+04_r8, 4.4287e+03_r8,-4.4726e+04_r8, & + -2.1995e+03_r8, 7.0889e+03_r8, 2.3855e+03_r8, 2.9763e+01_r8, 6.6460e+02_r8, & + 3.1664e+03_r8, 1.4809e+04_r8, 4.0645e+03_r8,-4.6843e+04_r8,-2.6537e+03_r8, & + 7.6437e+03_r8, 2.3613e+03_r8, 3.3666e+01_r8, 8.3830e+02_r8, 3.6616e+03_r8, & + 1.5430e+04_r8, 3.7727e+03_r8,-4.9054e+04_r8,-3.0909e+03_r8, 8.3082e+03_r8, & + 2.3574e+03_r8, 3.7748e+01_r8, 1.0512e+03_r8, 4.0875e+03_r8, 1.6120e+04_r8, & + 3.5818e+03_r8,-5.1529e+04_r8,-3.5443e+03_r8, 9.0933e+03_r8, 2.3920e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=16,20)/ & + 4.2296e+01_r8, 1.3036e+03_r8, 4.4196e+03_r8, 1.6881e+04_r8, 3.4671e+03_r8, & + -5.4229e+04_r8,-4.0449e+03_r8, 9.9546e+03_r8, 2.4679e+03_r8, 4.7480e+01_r8, & + 1.5965e+03_r8, 4.6912e+03_r8, 1.7692e+04_r8, 3.4059e+03_r8,-5.7053e+04_r8, & + -4.6035e+03_r8, 1.0823e+04_r8, 2.5794e+03_r8, 5.3627e+01_r8, 1.9302e+03_r8, & + 4.9402e+03_r8, 1.8564e+04_r8, 3.3780e+03_r8,-6.0042e+04_r8,-5.1911e+03_r8, & + 1.1665e+04_r8, 2.7244e+03_r8, 7.9167e+01_r8, 2.2283e+03_r8, 5.2269e+03_r8, & + 1.9564e+04_r8, 3.4343e+03_r8,-6.3324e+04_r8,-5.7858e+03_r8, 1.2522e+04_r8, & + 2.9022e+03_r8, 1.1948e+02_r8, 2.4959e+03_r8, 5.5584e+03_r8, 2.0703e+04_r8, & + 3.6185e+03_r8,-6.7027e+04_r8,-6.3585e+03_r8, 1.3402e+04_r8, 3.1300e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=21,25)/ & + 1.8391e+02_r8, 2.7146e+03_r8, 5.9441e+03_r8, 2.1967e+04_r8, 3.9800e+03_r8, & + -7.1233e+04_r8,-6.8930e+03_r8, 1.4300e+04_r8, 3.4242e+03_r8, 2.7904e+02_r8, & + 2.8863e+03_r8, 6.3937e+03_r8, 2.3372e+04_r8, 4.5327e+03_r8,-7.6066e+04_r8, & + -7.3642e+03_r8, 1.5250e+04_r8, 3.7769e+03_r8, 4.0911e+02_r8, 3.0443e+03_r8, & + 6.9146e+03_r8, 2.4981e+04_r8, 5.3338e+03_r8,-8.1711e+04_r8,-7.7825e+03_r8, & + 1.6272e+04_r8, 4.2287e+03_r8, 5.5647e+02_r8, 3.2369e+03_r8, 7.4969e+03_r8, & + 2.6902e+04_r8, 6.3584e+03_r8,-8.8522e+04_r8,-8.1632e+03_r8, 1.7400e+04_r8, & + 4.8989e+03_r8, 6.7746e+02_r8, 3.4639e+03_r8, 8.1044e+03_r8, 2.9116e+04_r8, & + 7.4937e+03_r8,-9.6201e+04_r8,-8.4797e+03_r8, 1.8601e+04_r8, 5.8474e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=26,31)/ & + 7.6419e+02_r8, 3.7351e+03_r8, 8.7528e+03_r8, 3.1669e+04_r8, 8.7109e+03_r8, & + -1.0484e+05_r8,-8.7688e+03_r8, 1.9909e+04_r8, 7.1538e+03_r8, 8.3217e+02_r8, & + 4.0555e+03_r8, 9.4681e+03_r8, 3.4560e+04_r8, 1.0047e+04_r8,-1.1462e+05_r8, & + -9.0931e+03_r8, 2.1351e+04_r8, 8.7935e+03_r8, 9.1301e+02_r8, 4.4297e+03_r8, & + 1.0290e+04_r8, 3.7864e+04_r8, 1.1445e+04_r8,-1.2584e+05_r8,-9.5391e+03_r8, & + 2.2897e+04_r8, 1.0786e+04_r8, 1.0164e+03_r8, 4.8721e+03_r8, 1.1249e+04_r8, & + 4.0878e+04_r8, 1.2767e+04_r8,-1.3731e+05_r8,-9.9925e+03_r8, 2.4149e+04_r8, & + 1.3084e+04_r8, 1.1415e+03_r8, 5.3815e+03_r8, 1.2293e+04_r8, 4.2941e+04_r8, & + 1.2877e+04_r8,-1.4705e+05_r8,-1.0110e+04_r8, 2.5288e+04_r8, 1.5084e+04_r8, & + 1.2975e+03_r8, 5.9819e+03_r8, 1.3226e+04_r8, 4.0585e+04_r8, 1.1739e+04_r8, & + -1.4918e+05_r8,-9.3569e+03_r8, 2.5526e+04_r8, 1.5795e+04_r8/ + + data ((a720(ix,js),js=1,9),ix=32,37)/ & + 1.4828e+03_r8, 6.7270e+03_r8, 1.4083e+04_r8, 3.9252e+04_r8, 6.2124e+03_r8, & + -1.5042e+05_r8,-8.4580e+03_r8, 2.9972e+04_r8, 1.3334e+04_r8, 1.7053e+03_r8, & + 7.6200e+03_r8, 1.4682e+04_r8, 3.6183e+04_r8, 5.9149e+03_r8,-1.5116e+05_r8, & + -9.3969e+03_r8, 3.2817e+04_r8, 9.0065e+03_r8, 1.9276e+03_r8, 8.6904e+03_r8, & + 1.4523e+04_r8, 3.5751e+04_r8, 2.4091e+03_r8,-1.5492e+05_r8,-1.0156e+04_r8, & + 3.9419e+04_r8, 4.9338e+03_r8, 2.1451e+03_r8, 1.0040e+04_r8, 1.3698e+04_r8, & + 3.1820e+04_r8, 7.1113e+03_r8,-1.5760e+05_r8,-1.1397e+04_r8, 3.9737e+04_r8, & + 3.4762e+03_r8, 2.4469e+03_r8, 1.1859e+04_r8, 1.0944e+04_r8, 2.9494e+04_r8, & + 8.8440e+03_r8,-1.6440e+05_r8,-9.9882e+03_r8, 4.4020e+04_r8, 4.6728e+03_r8, & + 2.8411e+03_r8, 1.4376e+04_r8, 8.8420e+03_r8, 3.0261e+04_r8, 1.2589e+04_r8, & + -1.8408e+05_r8,-9.3312e+03_r8, 5.2682e+04_r8, 6.4506e+03_r8/ + + data ((a720(ix,js),js=1,9),ix=38,43)/ & + 3.3274e+03_r8, 1.7805e+04_r8, 8.3315e+03_r8, 3.4132e+04_r8, 1.3953e+04_r8, & + -2.2590e+05_r8,-7.2006e+03_r8, 7.6708e+04_r8, 8.4541e+03_r8, 3.7593e+03_r8, & + 2.1296e+04_r8, 7.4382e+03_r8, 3.7788e+04_r8, 1.7525e+04_r8,-2.6251e+05_r8, & + -6.7751e+03_r8, 9.5562e+04_r8, 9.7409e+03_r8, 4.0215e+03_r8, 2.3146e+04_r8, & + 4.4673e+03_r8, 3.9980e+04_r8, 1.9665e+04_r8,-2.8011e+05_r8,-6.2491e+03_r8, & + 1.0617e+05_r8, 9.7124e+03_r8, 3.7615e+03_r8, 2.3278e+04_r8, 2.4201e+03_r8, & + 4.5810e+04_r8, 2.9998e+04_r8,-2.8413e+05_r8,-1.1164e+04_r8, 9.8953e+04_r8, & + 6.3735e+03_r8, 3.7240e+03_r8, 2.3588e+04_r8, 2.0106e+03_r8, 6.0596e+04_r8, & + 4.6732e+04_r8,-3.1152e+05_r8,-1.7614e+04_r8, 9.4606e+04_r8, 3.4489e+03_r8, & + 3.7961e+03_r8, 2.6755e+04_r8, 2.3096e+03_r8, 7.7763e+04_r8, 5.7709e+04_r8, & + -3.5374e+05_r8,-2.4401e+04_r8, 1.0057e+05_r8, 8.7498e+02_r8/ + + data ((b720(ix,js),js=1,9),ix=1,5)/ & + 2.8378e+03_r8, 0.0000e+00_r8, 7.4867e+03_r8, 8.7260e+04_r8, 4.9146e+04_r8, & + -2.8306e+05_r8, 1.0229e+04_r8, 2.1829e+04_r8, 2.9344e+04_r8, 3.0405e+03_r8, & + 0.0000e+00_r8, 1.0134e+04_r8, 9.3386e+04_r8, 4.9056e+04_r8,-2.9980e+05_r8, & + 8.3963e+03_r8, 3.1439e+04_r8, 2.7751e+04_r8, 3.4447e+03_r8, 0.0000e+00_r8, & + 1.4768e+04_r8, 9.9677e+04_r8, 4.7199e+04_r8,-3.2228e+05_r8, 4.6847e+03_r8, & + 3.5809e+04_r8, 2.8838e+04_r8, 3.9763e+03_r8, 0.0000e+00_r8, 2.2241e+04_r8, & + 1.0162e+05_r8, 3.8195e+04_r8,-3.2951e+05_r8,-3.5761e+02_r8, 3.1367e+04_r8, & + 3.1066e+04_r8, 4.4566e+03_r8, 0.0000e+00_r8, 3.1280e+04_r8, 9.7135e+04_r8, & + 2.7683e+04_r8,-3.2113e+05_r8,-4.8036e+03_r8, 2.4666e+04_r8, 3.2099e+04_r8/ + + data ((b720(ix,js),js=1,9),ix=6,10)/ & + 1.9920e+03_r8, 4.3042e+03_r8, 3.4960e+04_r8, 9.2325e+04_r8, 1.9550e+04_r8, & + -3.0863e+05_r8,-7.8736e+03_r8, 2.0414e+04_r8, 3.1867e+04_r8, 2.3607e+03_r8, & + 6.0047e+03_r8, 3.4158e+04_r8, 9.0097e+04_r8, 1.6570e+04_r8,-3.0384e+05_r8, & + -9.9396e+03_r8, 2.0701e+04_r8, 3.0825e+04_r8, 2.7001e+03_r8, 8.1576e+03_r8, & + 3.0612e+04_r8, 8.9617e+04_r8, 1.4401e+04_r8,-2.9982e+05_r8,-1.1977e+04_r8, & + 2.2595e+04_r8, 2.9273e+04_r8, 3.0360e+03_r8, 1.1081e+04_r8, 2.7697e+04_r8, & + 9.1658e+04_r8, 1.1561e+04_r8,-3.0089e+05_r8,-1.4403e+04_r8, 2.5524e+04_r8, & + 2.8020e+04_r8, 3.4215e+03_r8, 1.4885e+04_r8, 2.6879e+04_r8, 9.6042e+04_r8, & + 7.9992e+03_r8,-3.0885e+05_r8,-1.7495e+04_r8, 2.8632e+04_r8, 2.7565e+04_r8/ + + data ((b720(ix,js),js=1,9),ix=11,15)/ & + 3.8631e+03_r8, 1.9005e+04_r8, 2.7888e+04_r8, 1.0225e+05_r8, 4.8521e+03_r8, & + -3.2437e+05_r8,-2.2097e+04_r8, 3.3740e+04_r8, 2.7150e+04_r8, 4.3522e+03_r8, & + 2.2605e+04_r8, 3.0259e+04_r8, 1.0826e+05_r8, 1.4579e+03_r8,-3.4145e+05_r8, & + -2.7813e+04_r8, 3.9189e+04_r8, 2.6718e+04_r8, 4.8734e+03_r8, 2.5856e+04_r8, & + 3.3158e+04_r8, 1.1340e+05_r8,-2.1817e+03_r8,-3.5946e+05_r8,-3.3255e+04_r8, & + 4.5530e+04_r8, 2.5944e+04_r8, 5.3812e+03_r8, 2.8555e+04_r8, 3.5608e+04_r8, & + 1.1671e+05_r8,-5.6934e+03_r8,-3.7309e+05_r8,-3.8155e+04_r8, 5.1594e+04_r8, & + 2.4865e+04_r8, 5.8581e+03_r8, 3.1107e+04_r8, 3.6904e+04_r8, 1.1784e+05_r8, & + -9.1119e+03_r8,-3.7911e+05_r8,-4.2332e+04_r8, 5.6614e+04_r8, 2.3383e+04_r8/ + + data ((b720(ix,js),js=1,9),ix=16,20)/ & + 6.3262e+03_r8, 3.3720e+04_r8, 3.7274e+04_r8, 1.1891e+05_r8,-1.1690e+04_r8, & + -3.8488e+05_r8,-4.5891e+04_r8, 6.1655e+04_r8, 2.1870e+04_r8, 6.8035e+03_r8, & + 3.6904e+04_r8, 3.7600e+04_r8, 1.2174e+05_r8,-1.2075e+04_r8,-3.9908e+05_r8, & + -4.8826e+04_r8, 6.8095e+04_r8, 2.1052e+04_r8, 7.2152e+03_r8, 4.0328e+04_r8, & + 3.8374e+04_r8, 1.2712e+05_r8,-1.0373e+04_r8,-4.2320e+05_r8,-5.1740e+04_r8, & + 7.6305e+04_r8, 2.0951e+04_r8, 9.8640e+03_r8, 3.7426e+04_r8, 4.2372e+04_r8, & + 1.3471e+05_r8,-6.8135e+03_r8,-4.5532e+05_r8,-5.4983e+04_r8, 8.5856e+04_r8, & + 2.1689e+04_r8, 1.3560e+04_r8, 3.3322e+04_r8, 4.7176e+04_r8, 1.4419e+05_r8, & + -1.7431e+03_r8,-4.9373e+05_r8,-5.8662e+04_r8, 9.5890e+04_r8, 2.3540e+04_r8/ + + data ((b720(ix,js),js=1,9),ix=21,25)/ & + 1.8962e+04_r8, 2.8655e+04_r8, 5.2627e+04_r8, 1.5648e+05_r8, 4.6977e+03_r8, & + -5.4094e+05_r8,-6.3178e+04_r8, 1.0669e+05_r8, 2.6814e+04_r8, 2.6434e+04_r8, & + 2.4076e+04_r8, 5.8634e+04_r8, 1.7285e+05_r8, 1.2578e+04_r8,-5.9982e+05_r8, & + -6.8826e+04_r8, 1.1902e+05_r8, 3.1514e+04_r8, 3.5147e+04_r8, 2.0130e+04_r8, & + 6.5020e+04_r8, 1.9328e+05_r8, 2.1789e+04_r8,-6.6785e+05_r8,-7.5631e+04_r8, & + 1.3244e+05_r8, 3.7235e+04_r8, 4.1827e+04_r8, 1.7320e+04_r8, 7.0904e+04_r8, & + 2.1618e+05_r8, 3.0623e+04_r8,-7.3675e+05_r8,-8.2378e+04_r8, 1.4290e+05_r8, & + 4.5585e+04_r8, 4.6294e+04_r8, 1.6071e+04_r8, 7.8131e+04_r8, 2.4682e+05_r8, & + 3.8078e+04_r8,-8.2274e+05_r8,-9.1157e+04_r8, 1.5361e+05_r8, 5.8726e+04_r8/ + + data ((b720(ix,js),js=1,9),ix=26,31)/ & + 4.9878e+04_r8, 1.6065e+04_r8, 8.8228e+04_r8, 2.8824e+05_r8, 4.2519e+04_r8, & + -9.3298e+05_r8,-1.0344e+05_r8, 1.6515e+05_r8, 7.8533e+04_r8, 5.3229e+04_r8, & + 1.7740e+04_r8, 1.0255e+05_r8, 3.4331e+05_r8, 4.1675e+04_r8,-1.0732e+06_r8, & + -1.2083e+05_r8, 1.7696e+05_r8, 1.0553e+05_r8, 5.6585e+04_r8, 2.1720e+04_r8, & + 1.2220e+05_r8, 4.1397e+05_r8, 3.3029e+04_r8,-1.2465e+06_r8,-1.4427e+05_r8, & + 1.8802e+05_r8, 1.3975e+05_r8, 5.9316e+04_r8, 2.8288e+04_r8, 1.4733e+05_r8, & + 4.8733e+05_r8, 1.5630e+04_r8,-1.4301e+06_r8,-1.7016e+05_r8, 1.9433e+05_r8, & + 1.7788e+05_r8, 6.2252e+04_r8, 3.8013e+04_r8, 1.8011e+05_r8, 5.5712e+05_r8, & + -1.8402e+04_r8,-1.6194e+06_r8,-1.9622e+05_r8, 2.0377e+05_r8, 2.1356e+05_r8, & + 6.5578e+04_r8, 5.1423e+04_r8, 2.1882e+05_r8, 5.6668e+05_r8,-5.8779e+04_r8, & + -1.7453e+06_r8,-2.1194e+05_r8, 2.1181e+05_r8, 2.3210e+05_r8/ + + data ((b720(ix,js),js=1,9),ix=32,37)/ & + 6.9606e+04_r8, 6.8196e+04_r8, 2.6312e+05_r8, 5.9063e+05_r8,-1.5744e+05_r8, & + -1.8524e+06_r8,-2.3319e+05_r8, 2.6085e+05_r8, 2.1170e+05_r8, 7.5218e+04_r8, & + 9.4375e+04_r8, 3.1888e+05_r8, 5.8441e+05_r8,-1.8982e+05_r8,-2.0276e+06_r8, & + -2.8095e+05_r8, 3.2730e+05_r8, 1.5852e+05_r8, 8.1818e+04_r8, 1.2971e+05_r8, & + 3.6827e+05_r8, 6.1914e+05_r8,-2.8165e+05_r8,-2.2420e+06_r8,-3.4355e+05_r8, & + 4.3737e+05_r8, 1.0553e+05_r8, 8.9628e+04_r8, 1.7800e+05_r8, 4.0374e+05_r8, & + 5.5218e+05_r8,-2.6089e+05_r8,-2.4102e+06_r8,-4.0173e+05_r8, 4.6432e+05_r8, & + 8.6117e+04_r8, 1.0036e+05_r8, 2.4647e+05_r8, 3.7601e+05_r8, 4.9780e+05_r8, & + -2.7995e+05_r8,-2.6053e+06_r8,-4.2444e+05_r8, 5.1942e+05_r8, 1.1274e+05_r8, & + 1.1449e+05_r8, 3.4157e+05_r8, 3.5045e+05_r8, 4.8110e+05_r8,-2.9572e+05_r8, & + -2.9462e+06_r8,-4.6715e+05_r8, 6.1840e+05_r8, 1.4715e+05_r8/ + + data ((b720(ix,js),js=1,9),ix=38,43)/ & + 1.3273e+05_r8, 4.7433e+05_r8, 3.6299e+05_r8, 5.2029e+05_r8,-3.8660e+05_r8, & + -3.6364e+06_r8,-5.3004e+05_r8, 9.1163e+05_r8, 1.8527e+05_r8, 1.5094e+05_r8, & + 6.1556e+05_r8, 3.4710e+05_r8, 5.6221e+05_r8,-4.2073e+05_r8,-4.2353e+06_r8, & + -5.8904e+05_r8, 1.1559e+06_r8, 2.0012e+05_r8, 1.6568e+05_r8, 7.1379e+05_r8, & + 2.4118e+05_r8, 6.1735e+05_r8,-3.9948e+05_r8,-4.6347e+06_r8,-5.9224e+05_r8, & + 1.3508e+06_r8, 1.8977e+05_r8, 1.6599e+05_r8, 7.6711e+05_r8, 1.5253e+05_r8, & + 7.5990e+05_r8,-2.0122e+05_r8,-4.9316e+06_r8,-6.2692e+05_r8, 1.3721e+06_r8, & + 1.2698e+05_r8, 1.6400e+05_r8, 7.6327e+05_r8, 1.1905e+05_r8, 9.5620e+05_r8, & + -5.0089e+04_r8,-5.0316e+06_r8,-7.0061e+05_r8, 1.2124e+06_r8, 6.6342e+04_r8, & + 1.6539e+05_r8, 8.6958e+05_r8, 9.0836e+04_r8, 1.1753e+06_r8, 8.8077e+04_r8, & + -5.4751e+06_r8,-7.6386e+05_r8, 1.2589e+06_r8, 2.1098e+04_r8/ + + real(r8) :: o3pxfac(pver) ! o3p cooling masking factors on WACCM vertical grids + + logical :: apply_co2_limit = .false. + integer :: k1mb = 0 + +!================================================================================================ +contains +!================================================================================================ + + subroutine nlte_fomichev_init ( co2_mwi, n2_mwi, o1_mwi, o2_mwi, o3_mwi, no_mwi, apply_co2_limit_in ) + use interpolate_data, only : lininterp + use ref_pres, only : pref_edge, pref_mid + +! +! Original version from Ray Roble +! First adapted to CCM by F. Sassi - November 1999 +! +!--------------------------------------------------------------------------------- +! input: +! RCO2 - CO2 volume mixing in the region below x=12.5 +! initial data from BLOCK DATA PCO2O3 come through common blocks + +! output: parameterization coefficients for both, the matrix parameterization +! (is used between x=2 and 12.5) and reccurence formula. +! AMAT,BMAT(43,9) - coefficients for the matrix parameterization + +!----------------------------------------------------------------- + + real(r8), intent(in) :: o1_mwi ! O molecular weight + real(r8), intent(in) :: o2_mwi ! O2 molecular weight + real(r8), intent(in) :: o3_mwi ! O3 molecular weight + real(r8), intent(in) :: co2_mwi ! CO2 molecular weight + real(r8), intent(in) :: n2_mwi ! N2 molecular weight + real(r8), intent(in) :: no_mwi ! NO molecular weight + logical, intent(in) :: apply_co2_limit_in + + real(r8), parameter :: p0=5.e-5_r8 ! TIE-GCM reference pressure in Pa + integer, parameter :: tgcmlevs = 29 + real(r8) :: pz(tgcmlevs) ! TIE-GCM pressure grids (single resolution,pz=-7...7,dpz=0.5 ), dimensionless + real(r8) :: pp(tgcmlevs) ! convert pz to Pascal + real(r8) :: xfac0(tgcmlevs) ! masking factors on TIE-GCM pressure grids + integer :: k + + apply_co2_limit = apply_co2_limit_in + find_k1mb: do k = 1, pverp + ! Find 1 mbar (or 100 Pa) level. + if (pref_edge(k) > 100._r8) then + k1mb = k + exit find_k1mb + endif + end do find_k1mb + if (masterproc) then + write(iulog,'(a,l8)') 'nlte_fomichev_init: apply_co2_limit: ',apply_co2_limit + write(iulog,'(a,i6,g12.6)') 'nlte_fomichev_init: check CO2 mixing ratios above 1-mbar level: ',k1mb,pref_mid(k1mb) + endif + +! set molecular weights + co2_mw = co2_mwi + n2_mw = n2_mwi + o1_mw = o1_mwi + o2_mw = o2_mwi + o3_mw = o3_mwi + no_mw = no_mwi + + ktop_co2cool = 1 + do k=1,pver + if (pref_mid(k) < ptop_co2cool) ktop_co2cool = k + enddo + + ! op3cooling masking factor (from Kockarts and Peetermans [1981] + xfac0(1:3)=.01_r8 + xfac0(4:10)=(/.05_r8,.1_r8,.2_r8,.4_r8,.55_r8,.7_r8,.75_r8/) + xfac0(11:tgcmlevs) = .8_r8 + + ! convert TIE-GCM pressure grid to Pascal + + pz(1)=-7.0_r8 + do k=2,tgcmlevs + pz(k)=pz(k-1)+0.5_r8 + enddo + do k=1,tgcmlevs + pp(k)=p0*exp(-pz(k)) + enddo + call lininterp( xfac0(tgcmlevs:1:-1), pp(tgcmlevs:1:-1), tgcmlevs, o3pxfac, pref_mid, pver ) + do k=1,pver + if (pref_mid(k) > pp(1)) then + o3pxfac(k)=0._r8 + else if (pref_mid(k) <= pp(tgcmlevs)) then + o3pxfac(k)=xfac0(tgcmlevs) + endif + enddo + + end subroutine nlte_fomichev_init + + subroutine set_matrices( amat, bmat ) + + implicit none +! calculate coefficients for the matrix paramerization: + + real(r8), intent(out) :: amat(nrfmlte,nrfmltelv) + real(r8), intent(out) :: bmat(nrfmlte,nrfmltelv) + +!----------------------------------------------------------------- +! Local vars: + real(r8) :: rco2 + real(r8) :: co2int(4), a + integer :: i,j,isgn + + rco2 = chem_surfvals_get('CO2VMR') + + amat(1:nrfmlte,1:nrfmltelv)=0.0_r8 + bmat(1:nrfmlte,1:nrfmltelv)=0.0_r8 + do i = 1,nrfmlte + do j = 1,nrfmltelv + + if((i.le.5).and.(j.eq.2)) goto 1 + isgn = int(sign(1._r8,a150(i,j))+sign(1._r8,a360(i,j))+ & + sign(1._r8,a540(i,j))+sign(1._r8,a720(i,j))) + co2int(1)=a150(i,j)/co2o(1) + co2int(2)=a360(i,j)/co2o(2) + co2int(3)=a540(i,j)/co2o(3) + co2int(4)=a720(i,j)/co2o(4) + if(isgn.eq.-4) then + co2int(1) = log(-co2int(1)) + co2int(2) = log(-co2int(2)) + co2int(3) = log(-co2int(3)) + co2int(4) = log(-co2int(4)) + a = -exp(a18lin(rco2,co2o,co2int,1,4)) + else if (isgn.eq.4) then + co2int(1) = log(co2int(1)) + co2int(2) = log(co2int(2)) + co2int(3) = log(co2int(3)) + co2int(4) = log(co2int(4)) + a = exp(a18lin(rco2,co2o,co2int,1,4)) + else + call a18int(co2o,co2int,rco2,a,4,1) + end if + amat(i,j)=a*rco2 + + isgn = int(sign(1._r8,b150(i,j))+sign(1._r8,b360(i,j))+ & + sign(1._r8,b540(i,j))+sign(1._r8,b720(i,j))) + co2int(1)=b150(i,j)/co2o(1) + co2int(2)=b360(i,j)/co2o(2) + co2int(3)=b540(i,j)/co2o(3) + co2int(4)=b720(i,j)/co2o(4) + if(isgn.eq.-4) then + co2int(1) = log(-co2int(1)) + co2int(2) = log(-co2int(2)) + co2int(3) = log(-co2int(3)) + co2int(4) = log(-co2int(4)) + a = -exp(a18lin(rco2,co2o,co2int,1,4)) + else if (isgn.eq.4) then + co2int(1) = log(co2int(1)) + co2int(2) = log(co2int(2)) + co2int(3) = log(co2int(3)) + co2int(4) = log(co2int(4)) + a = exp(a18lin(rco2,co2o,co2int,1,4)) + else + call a18int(co2o,co2int,rco2,a,4,1) + end if + bmat(i,j)=a*rco2 +1 continue + enddo + enddo + + return + endsubroutine set_matrices + + +!================================================================================================== + + subroutine nlte_fomichev_calc (lchnk,ncol,pmid,pint,t,xo2,xo,xo3,xn2,xco2,coolf,& + co2cool_out, o3cool_out, c2scool_out ) + use time_manager, only: get_nstep + +! +! author: F. Sassi (Dec, 1999) +! +!------------------------------------------------------------------ +! +! This is routine prep arrays to be passed to Fomichev' scheme +! +! RADFMCINTI should have been called at the beginning of the run to +! create arrays used in this parameterization. +! +! Concentrations in input are expected in mass mixing ratios +! and are converted to volume mixing ratios +! +! Because Fomichev scheme has its own grid which runs from +! ground upward, arrays are prepared with vertical indexing +! inverted with respect to the CCM convention. However, +! arrays in input are expected in the standard convention +! (i.e., top is level 1). +! +! The pressures at mid-points and interfaces need to be known +! Conversion to normalized X coordinate is carried out here. +! +! Cooling rates are calculated in units of +! +! dT +! COOLF = Cp --- +! dt +! +! where Cp is the specific heat (ergs g^-1 K^-1), dT/dt is the +! temperature tendency (K s^-1). Therefore, units of cooling +! are +! +! (erg g^-1 K^-1) (K s^-1) = cm^2 s^-3 +! +! COOLF is converted to J/kg/s before output. +! +! +!***************************************************************** +! +!----------------------------------------------------------------- +implicit none +!----------------------------------------------------------------- + +! Input variables + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + + real(r8), intent(in) :: pmid(pcols,pver) ! model pressure at mid-point + real(r8), intent(in) :: pint(pcols,pverp) ! model pressure at interfaces + real(r8), intent(in) :: t(pcols,pver) ! Neutral temperature (K) + real(r8), intent(in) :: xco2(pcols,pver) ! CO2 profile + real(r8), intent(in) :: xn2(pcols,pver) ! N2 profile + real(r8), intent(in) :: xo3(pcols,pver) ! O3 profile + real(r8), intent(in) :: xo(pcols,pver) ! O profile + real(r8), intent(in) :: xo2(pcols,pver) ! O2 profile + +! Output variables + real(r8), intent(out) :: coolf(pcols,pver) ! Total cooling + real(r8), intent(out) :: co2cool_out(pcols,pver) ! CO2 cooling + real(r8), intent(out) :: o3cool_out(pcols,pver) ! O3 cooling + real(r8), intent(out) :: c2scool_out(pcols,pver) ! Cooling to Space + +! Local variables + + real(r8) rmo2 ! O2 molecular weight + real(r8) rmo ! O molecular weight + real(r8) rmn2 ! N2 molecular weight + real(r8) rmco2 ! CO2 molecular weight + real(r8) rmo3 ! O3 molecular weight + real(r8) xnorm(pcols,pver) ! normalized X p.s.h. at midpoints + real(r8) xnori(pcols,pverp) ! normalized X p.s.h. at interfaces + real(r8) dxnorm(pcols,pver) ! xnorm(k+1)-xnorm(k) + real(r8) presm(pcols,pver) ! pressure at midpoint (dyn/cm^2) + real(r8) presi(pcols,pverp) ! pressure at interfaces (dyn/cm^2) + real(r8) dpi(pcols,pver) ! pressure diff. between interfaces (dyn/cm^2) + real(r8) mwair(pcols,pver) ! mean air molecular weight (g/mole) + real(r8) ndenair(pcols,pver) ! mean air number density (cm**-3) + real(r8) colco2(pcols,pver) ! CO2 column number density + real(r8) uco2(pcols,nrfm) ! column CO2 + real(r8) dummyg(pver) ! dummy + real(r8) dummyx(pver) ! dummy + real(r8) dummyf(nrfm) ! dummy + real(r8) hco2(pcols,nrfm) ! CO2 cooling in Fomichev grid + real(r8) ho3(pcols,nrfm) ! O3 cooling in Fomichev grid + real(r8) tf(pcols,nrfm) ! neutral temp interpolated to Fomichev grid + real(r8) vn2f(pcols,nrfm) ! N2 vmr interpolated to Fomichev grid + real(r8) vo3f(pcols,nrfm) ! O3 vmr interpolated to Fomichev grid + real(r8) vof(pcols,nrfm) ! O vmr interpolated to Fomichev grid + real(r8) vco2f(pcols,nrfm) ! CO2 vmr interpolated to Fomichev grid + real(r8) vo2f(pcols,nrfm) ! O2 vmr interpolated to Fomichev grid + real(r8) mwairf(pcols,nrfm) ! Mean air molecular weight interpolated to Fomichev grid + real(r8) ndenf(pcols,nrfm) ! Mean air no. density interpolated to Fomichev grid + real(r8) flux(pcols) ! Flux boundary condition for cool-to-space + real(r8) vo2(pcols,pver) ! O2 vmr + real(r8) vo(pcols,pver) ! O vmr + real(r8) vo3(pcols,pver) ! O3 vmr + real(r8) vn2(pcols,pver) ! N2 vmr + real(r8) vco2(pcols,pver) ! CO2 vmr + real(r8) co2cooln(pcols,pver) ! CO2 cooling + real(r8) o3cooln(pcols,pver) ! O3 cooling + real(r8) hc2s(pcols,pver) ! cool to space heating + real(r8) ps0 ! Reference (surface) pressure + real(r8) ti(pcols,pver) ! T(PVER:1:-1) + real(r8) alam(pcols,nrfm) ! LAMBDA + real(r8) djm(pcols,nrfm) ! DJM in recurrence formula + real(r8) dj0(pcols,nrfm) ! DJ0 in recurrence formula + real(r8) aajm(pcols,nrfm) ! AAJM in recurrrence formula + real(r8) aaj0(pcols,nrfm) ! AJJ0 in recurrence formula + real(r8) zhgt(pcols,pver) ! approx. elevation in cm + real(r8) grav(pcols,pver) ! accelration of gravity in cm/s^2 + real(r8) :: wrk(pcols) + + integer k + integer i + integer kinv ! inverted vertical index (bottom up) + real(r8), parameter :: co2_limit = 720.e-6_r8 + integer :: nstep + character(len=200) :: errmsg + real(r8) :: latdeg, londeg + +!---------------------------------------------------------------- + +! Define molecular weights + rmco2 = co2_mw + rmo3 = o3_mw + rmo2 = o2_mw + rmo = o1_mw + rmn2 = n2_mw + + + coolf(1:ncol,1:pver)=0.0_r8 + + arad=rearth*1e2_r8 ! initialize planet's radius (cm) + +!----------------------------------------------------------------- +! The pressure at mid point is converted to normalized x coordinate +! X = LN (P0 / PRES) +! where P0 = 1e6 dyn/cm^2 ; PRES is in dyn/cm^2 +! Note: to convert from Pa to dyn/cm^2, multyply by 10 +!----------------------------------------------------------------- + ps0=1.000e6_r8 + do k=1,pver + kinv = pver-k+1 + do i=1,ncol + presm(i,k) = pmid(i,kinv)*10._r8 + xnorm(i,k) = log(ps0/presm(i,k)) +! Calculate pressure at interfaces + presi(i,k) = pint(i,kinv+1)*10._r8 + xnori(i,k) = log(ps0/presi(i,k)) + enddo + enddo + presi(:ncol,pverp) = pint(:ncol,1)*10._r8 + xnori(:ncol,pverp) = log(ps0/presi(:ncol,pverp)) + +!----------------------------------------------------------------- +! Calculate layer thikcness (DPI). +! For each pressure interface the following is true: +! +! Pint(k) = P0 * exp (-Xint(k)) +! +! Thus, +! +! DPI(k)= Pint(k)-Pint(k+1)= P0 * exp (-Xint(k)) * DX +! +! where, +! +! DX = 1 - exp ( - (Xint(k+1)-Xint(k)) ) +! +!----------------------------------------------------------------- + do k=pver,1,-1 + do i=1,ncol + dxnorm(i,k)=xnori(i,k+1)-xnori(i,k) + enddo + enddo + +! Pressure difference between interfaces (positive downward) + do k=1,pver + do i=1,ncol + dpi(i,k)=ps0*exp(-xnorm(i,k))*(1._r8-exp(-dxnorm(i,k))) + enddo + enddo + +!----------------------------------------------------------------- +! Calculate molecular weight (g/mol) of mean air MWAIR: +! +! MWAIR= 1. / [ Sum(i) MMR(i)/MW(i) ] +! +! where MMR(i) are mass mixing ratio of O2, +! O, N2, and MW(i) are the corresponding +! molecular weights. +!----------------------------------------------------------------- + mwair(1:ncol,1:pver)=0.0_r8 + do k=1,pver + kinv=pver-k+1 + do i=1,ncol + mwair(i,k)=1._r8/ ( & + xo2(i,kinv)/rmo2 & + +xo(i,kinv)/rmo & + +xn2(i,kinv)/rmn2 & + +xo3(i,kinv)/rmo3 & + +xco2(i,kinv)/rmco2 & + ) + enddo + enddo + +! +! Elevation is calculated via integration of +! the hydrostatic equation +! +! +! Sum(k) g(k) dz = Sum(k) PHI(k) +! +! where +! g0*a^2 +! g(k)= ------ +! (a+z)^2 +! +! where g0=980 cm/s^2;a=6.37e8 +! +! and +! +! UR * T(i) DPI(i) +! PHI(k) = Sum(i=1,k) ------ ---- +! MW(i) P(i) +! +! where UR is the gas universal constant, T is temperature, +! MW is the mean air molecular weight, DPI is the pressure +! layer thickness and P is the mid-point pressure +! Then, +! +! PHI * a +! z = --------- +! (a*g0-PHI) +! +! do i=1,ncol +! phi=0.0 +! do k=1,pver +! kinv=pver-k+1 +! phi=phi+ur*t(i,kinv)/(mwair(i,k))*dpi(i,k)/presm(i,k) +! zhgt(i,k)=phi*arad/(arad*grav0-phi) +! grav(i,k)=grav0*(arad/(arad+zhgt(i,k)))**2 +! enddo +! enddo + + wrk(:ncol) = 0._r8 + + do k=1,pver + kinv=pver-k+1 + do i=1,ncol + wrk(i) = wrk(i) + ur*t(i,kinv)/(mwair(i,k))*dpi(i,k)/presm(i,k) + zhgt(i,k) = wrk(i)*arad/(arad*grav0 - wrk(i)) + grav(i,k) = grav0*(arad/(arad + zhgt(i,k)))**2 + enddo + enddo + + do k = 1,pver + kinv=pver-k+1 + do i=1,ncol +!----------------------------------------------------------------- +! Convert mmr to vmr +!----------------------------------------------------------------- + vo2 (i,k) = xo2 (i,kinv) *mwair(i,k)/rmo2 + vo (i,k) = xo (i,kinv) *mwair(i,k)/rmo + vo3 (i,k) = xo3 (i,kinv) *mwair(i,k)/rmo3 + vn2 (i,k) = xn2 (i,kinv) *mwair(i,k)/rmn2 + vco2(i,k) = xco2(i,kinv) *mwair(i,k)/rmco2 + +! CGB - The Formichev scheme was not designed to support CO2 > 720 ppmv, so +! limit the amount of CO2 used to 720 ppmv. This keeps the model stable, but +! may yield an incorrect scientific result. It would be nice to extend this +! routine to support higher CO2 values. Putting the limiter here means that +! that the other constituents will have their proper mixing ratio caclulated +! (i.e. the mwair is correct), but vco2 will be limited. Abort the run if CO2 +! exceeds the limit at altitudes above 1 mbar unless apply_co2_limit=.true. + + if (vco2(i,k)>co2_limit) then + nstep = get_nstep() + latdeg = get_rlat_p(lchnk,i)*180._r8/pi + londeg = get_rlon_p(lchnk,i)*180._r8/pi + write(errmsg,fmt='(a,i12,2(i6),g12.4,2(f8.2),g12.4)') & + 'nlte_fomichev_calc: CO2 has exceeded the limit: nstep,i,k,press(Pa),lon,lat,vco2(vmr)=',& + nstep,i,kinv, pmid(i,kinv), londeg, latdeg, vco2(i,k) + write(iulog,*) trim(errmsg) + if ((.not.apply_co2_limit) .and. (kinv co2_limit ) + vco2(:ncol,:) = co2_limit + end where + +!----------------------------------------------------------------- +! Calculate CO2 vertical column above each level +! +! At each mid-point vertical level (j), the following sum is calculated +! +! +! COLCO2(j) = Sum_(i=ztop:j:-1) NDENAIR(I)*VCO2(I)*DZ = ... +! +! ANAV * VCO2(I) +! = Sum_(i=pver:j:-1) ---------------- * DP +! GRAV * MWAIR(I) +! +! where ANAV is the Avogadro no., VCO2 is CO2 vmr, GRAV is the +! accelaration of gravity, MWAIR is mean molecular weight, DP +! is the pressure increment downward. +! As boundary condition at PVER, it is assumed that VCO2 +! and NDENAIR stay constant above that level. +!----------------------------------------------------------------- +! do i=1,ncol +! colco2(i,pver)=anav/grav(i,pver)*vco2(i,pver)/mwair(i,pver)*dpi(i,pver) +! do k=pver-1,1,-1 +! colco2(i,k)=colco2(i,k+1) & +! +anav/grav(i,k)*vco2(i,k)/mwair(i,k)*dpi(i,k) +! enddo +! enddo + + colco2(:ncol,pver) = anav/grav(:ncol,pver)*vco2(:ncol,pver) & + /mwair(:ncol,pver)*dpi(:ncol,pver) + do k=pver-1,1,-1 + do i=1,ncol + colco2(i,k)=colco2(i,k+1) & + +anav/grav(i,k)*vco2(i,k)/mwair(i,k)*dpi(i,k) + enddo + enddo + +!----------------------------------------------------------------- +! Linear interpolation from CCM grid defined in XNORM(1:PVER) +! to Fomichev grid defined in XR(1:NRFM) +! Interpolation is carried out using mod PRFLINV which +! is adapted from A18LINV (originally written for TIME/GCM). +! All fields are interpolated. If XR levels are beyond the +! limit of the actual CCM grid, zero values are inserted in +! the interpolated arrays. Proper handling of the arrays is done +! in VICCOOLN. +!----------------------------------------------------------------- + +!----------------------------------------------------------------- +! Create TI array which contains T(PVER:1:-1) +!----------------------------------------------------------------- + ti(1:ncol,1:pver)=t(1:ncol,pver:1:-1) + + do i=1,ncol + + dummyx(1:pver)=xnorm(i,1:pver) + +! Temperature + dummyg(1:pver)=ti(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + tf(i,1:nrfm)=dummyf(1:nrfm) + +! O3 + dummyg(1:pver)=vo3(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + vo3f(i,1:nrfm)=dummyf(1:nrfm) + +! O2 + dummyg(1:pver)=vo2(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + vo2f(i,1:nrfm)=dummyf(1:nrfm) + +! N2 + dummyg(1:pver)=vn2(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + vn2f(i,1:nrfm)=dummyf(1:nrfm) + +! O + dummyg(1:pver)=vo(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + vof(i,1:nrfm)=dummyf(1:nrfm) + +! CO2 + dummyg(1:pver)=vco2(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + vco2f(i,1:nrfm)=dummyf(1:nrfm) + +! COLCO2 + dummyg(1:pver)=colco2(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + uco2(i,1:nrfm)=dummyf(1:nrfm) + +! DEN + dummyg(1:pver)=ndenair(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + ndenf(i,1:nrfm)=dummyf(1:nrfm) + +! AM + dummyg(1:pver)=mwair(i,1:pver) + call a18linvne (xr,dummyf,dummyx,dummyg,pver,nrfm) + mwairf(i,1:nrfm)=dummyf(1:nrfm) + + enddo + + +! Use recurrence relation to calculate AL coefficents + call recur (ncol,uco2,tf,vn2f,vo2f,vof,ndenf,alam,djm,dj0,aajm,aaj0) + + +! Do LTE and NLTE parts of cooling + call viccooln (ncol,alam,djm,dj0,aajm,aaj0,tf,vco2f,vo3f,mwairf,flux,hco2,ho3) + + +! Interpolate from Fomichev grid to CCM grid + do i=1,ncol + dummyx(1:pver)=xnorm(i,1:pver) + +! HCO2 + dummyf(1:nrfm)=hco2(i,1:nrfm) + call a18linvne (dummyx,dummyg,xr,dummyf,nrfm,pver) + co2cooln(i,1:pver)=dummyg(1:pver) + +! HO3 + dummyf(1:nrfm)=ho3(i,1:nrfm) + call a18linvne (dummyx,dummyg,xr,dummyf,nrfm,pver) + o3cooln(i,1:pver)=dummyg(1:pver) + + enddo + +! Do cool-to-space component of cooling + call cool2space (ncol,ti,mwair,vn2,vo2,vo,vco2,ndenair,xnorm,flux,hc2s) + +! Calculate total cooling + + ! Above ptop_co2cool use cool to space approx. + do k=1,ktop_co2cool-1 + kinv=pver-k+1 + do i=1,ncol + ! Convert to J/kg/s + coolf(i,k) = (o3cooln(i,kinv) + hc2s(i,kinv)) * 1.e-4_r8 + enddo + enddo + ! Below ptop_co2cool use nlte calculation + do k=ktop_co2cool,pver + kinv=pver-k+1 + do i=1,ncol + ! Convert to J/kg/s + coolf(i,k) = (co2cooln(i,kinv) + o3cooln(i,kinv)) * 1.e-4_r8 + enddo + enddo + + ! diagnostics ... + do k=1,pver + kinv=pver-k+1 + co2cool_out(:ncol,k) = co2cooln(:ncol,kinv) * 1.e-4_r8 + o3cool_out(:ncol,k) = o3cooln(:ncol,kinv) * 1.e-4_r8 + c2scool_out(:ncol,k) = hc2s(:ncol,kinv) * 1.e-4_r8 + enddo + + return + end subroutine nlte_fomichev_calc + +!==================================================================================== + + subroutine a18linvne (x,y,xn,yn,n,imax) + + implicit none + +! **** +! **** This procedure performs linear interpolation within the +! **** table defined by the N points (XN(NN),Y(NN)). +! **** Where: +! **** +! **** NN = 1,N,1 +! **** +! **** XN(NN) < XN(NN+1) for NN = 1,N-1 +! **** +! **** Parameters: +! **** +! **** X(IMAX) = array of IMAX x-values at which linear +! **** interpolation is required +! **** +! **** XN(N) = array of N abscissae at which function values +! **** are given +! **** +! **** YN(N) = function values corresponding to abscissae, +! **** XN(N) +! **** +! **** Output: +! **** +! **** Y(IMAX) The IMAX interpolated values are +! **** returned in this array +! **** +! +! It has been modified as follows: +! if points X are outside the range X(1)..X(N), the last values +! are assigned. That is +! IF X(I) > XN(N) THEN Y(I)=YN(N) +! IF X(I) < XN(1) THEN Y(I)=YN(1) +! + +! Arguments + integer, intent(in) :: imax + integer, intent(in) :: n + real(r8), intent(out) :: y(imax) + real(r8), intent(in) :: x(imax) + real(r8), intent(in) :: xn(n) + real(r8), intent(in) :: yn(n) + + +! Local variables + integer kk(imax) + integer nn + integer i + +! **** +! **** Where: +! **** Y(IMAX) is vector output +! **** +! **** KK is work space +! **** +! **** +! **** Initialize array KK +! **** + + do i = 1,imax + kk(i) = 0 + enddo + +! **** +! **** Locate interval in (XN,YN) in table containing X(I) +! **** + + do nn = 1,n-1 + do i = 1,imax + kk(i) = merge(nn+1,kk(i),(xn(nn+1)-x(i))*(x(i)-xn(nn))>=0._r8) + enddo + enddo + +! **** +! **** Check for +! **** +! **** X(I) < XN(1), X(I) > X(N) +! **** +! **** and use linear extrapolation if necessary +! **** + + do i = 1,imax + kk(i) = merge(-1,kk(i),xn(1)-x(i)>=0._r8) + kk(i) = merge(-2,kk(i),x(i)-xn(n)>=0._r8) + enddo + +! **** +! **** Perform interpolation prescribed above +! **** + + y(:) = 0._r8 + + do i = 1,imax + + if (kk(i).gt.0) then + + y(i) = ( & + yn(kk(i)-1)*(xn(kk(i))-x(i)) & + + yn(kk(i))*(x(i)-xn(kk(i)-1)) & + )/(xn(kk(i))-xn(kk(i)-1)) + + else if (kk(i).eq.-1) then + + y(i)=yn(1) + + else if (kk(i).eq.-2) then + + y(i)=yn(n) + + endif + + enddo + + return + end subroutine a18linvne + + +!======================================================================================= + + subroutine recur (ncol,uco2,tf,vn2f,vo2f,vof,ndenf,alam,djm,dj0,aajm,aaj0) + +! Originally written by R. Roble, modified by F. Sassi (Nov., 1999) + +!----------------------------------------------------------------- +implicit none +!----------------------------------------------------------------- + + + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: UCO2(pcols,nrfm) + real(r8), intent(in) :: tf(pcols,nrfm) + real(r8), intent(in) :: vn2f(pcols,nrfm) + real(r8), intent(in) :: vo2f(pcols,nrfm) + real(r8), intent(in) :: vof(pcols,nrfm) + real(r8), intent(in) :: ndenf(pcols,nrfm) + + real(r8), intent(out) :: alam(pcols,nrfm) + real(r8), intent(out) :: djm(pcols,nrfm) + real(r8), intent(out) :: dj0(pcols,nrfm) + real(r8), intent(out) :: aajm(pcols,nrfm) + real(r8), intent(out) :: aaj0(pcols,nrfm) + + real(r8) CO2INT(nrfmco2) + real(r8) UREF(nrfmco2) + real(r8) A(pcols) + real(r8) COR(pcols) + real(r8) UC(pcols) + real(r8) al(pcols,nrfm) + + real(r8) tt + real(r8) y + real(r8) zn2 + real(r8) zo2 + real(r8) zz + real(r8) rko + + integer ks + integer i + integer k + integer km + + +!****this constant should be moved to an intialization routine + +! +! +! **** UCO2 (CO2 COLUMN AMOUNT) FOR CO2 +! +! +! **** CALCULATE COEFICIENTS FOR THE RECCURENCE FORMULA: +! +! **** BETWEEN X=12.5 AND 13.75 THESE COEFFICIENTS (AL) ARE +! **** CALCULATED USING CORRECTIONS TO THE ESCAPE FUNCTION. +! **** STARTING FROM X=14.00 AND ABOVE THE PARAMETERIZATION +! **** COEFFICIENTS ARE EQUAL TO THE ESCAPE FUNCTION. +! + + al(1:ncol,1:nrfm)=0.0_r8 + ks=0 + do k=1,nrfm + + if (xr(k).ge.12.5_r8 .and. xr(k).le.13.75_r8) then + ks=ks+1 + + co2int(1) = cor150(ks) + co2int(2) = cor360(ks) + co2int(3) = cor540(ks) + co2int(4) = cor720(ks) + uref(1) = uco2co(ks)*150._r8/360._r8 + uref(2) = uco2co(ks) + uref(3) = uco2co(ks)*540._r8/360._r8 + uref(4) = uco2co(ks)*720._r8/360._r8 + do i=1,ncol + uc(i) = uco2(i,k) + enddo + call a18linv(uc,a,uco2ro,alo,51,ncol) + call a18linv(uc,cor,uref,co2int,4,ncol) + do i=1,ncol + al(i,k) = exp(cor(i)+a(i)) + enddo + + endif + enddo + + do k=1,nrfm + + if (xr(k).ge.14.00_r8) then + + do i=1,ncol + uc(i) = uco2(i,k) + enddo + call a18linv(uc,a,uco2ro,alo,51,ncol) + do i=1,ncol + al(i,k) = exp(a(i)) + enddo + + endif + + enddo + +! +! Calculate ALAM +! + alam(1:ncol,1:nrfm)=0.0_r8 + do k=1,nrfm + +! ALAM is used only for p.s.h. >= 12.5 +! If the current level is below 12.5 s.h., then do nothing + if (xr(k).ge.12.5_r8) then + + do i=1,ncol + +! +! **** CO2-O2 AND CO2-N2 V-T CONSTANTS +! + tt = tf(i,k) + y = tt**(-1._r8/3._r8) + zn2 = 5.5e-17_r8*sqrt(tt)+6.7e-10_r8*exp(-83.8_r8*y) + zo2 = 1.e-15_r8*exp(23.37_r8-230.9_r8*y+564._r8*y*y) + rko = 3.0e-12_r8 + +! +! **** COLLISIONAL DEACTIVATION RATE: +! + zz = (vn2f(i,k)*zn2 + vo2f(i,k)*zo2 + vof (i,k)*rko)*ndenf(i,k) + +! +! **** +! + alam(i,k) = a10/( a10+zz ) + + enddo ! end-loop in longitude + + endif + + enddo ! end-loop in levels + +! Calculate coefficients of recurrence formula +! This coefficients are used for 12.75=< p.s.h.=<16.5 +! Outside this range do nothing +! It uses ALAM (p.s.h. >= 12.5) + + djm(1:ncol,1:nrfm)=0.0_r8 + dj0(1:ncol,1:nrfm)=0.0_r8 + aajm(1:ncol,1:nrfm)=0.0_r8 + aaj0(1:ncol,1:nrfm)=0.0_r8 + do k=1,nrfm + + if (xr(k).ge.12.75_r8 .and. xr(k).le.16.5_r8) then + + km=k-1 + + do i=1,ncol + + djm(i,k) = +.25_r8*(3._r8*al(i,km) + al(i,k) ) + dj0(i,k) = +.25_r8*( al(i,km) + 3._r8*al(i,k) ) + + aajm(i,k) = 1._r8-alam(i,km) * ( 1._r8-djm(i,k) ) + aaj0(i,k) = 1._r8-alam(i,k ) * ( 1._r8-dj0(i,k) ) + + enddo ! end-loop in longitude + + endif + + enddo ! end-loop in levels + + return + end subroutine recur + +!====================================================================================== + + subroutine a18linv (x,y,xn,yn,n,imax) + + implicit none + +! **** +! **** This procedure performs linear interpolation within the +! **** table defined by the N points (XN(NN),Y(NN)). +! **** Where: +! **** +! **** NN = 1,N,1 +! **** +! **** XN(NN) < XN(NN+1) for NN = 1,N-1 +! **** +! **** Parameters: +! **** +! **** X(IMAX) = array of IMAX x-values at which linear +! **** interpolation is required +! **** +! **** XN(N) = array of N abscissae at which function values +! **** are given +! **** +! **** YN(N) = function values corresponding to abscissae, +! **** XN(N) +! **** +! **** Output: +! **** +! **** Y(IMAX) The IMAX interpolated values are +! **** returned in this array +! **** + +! Input variables + integer imax + integer n + real(r8) y(imax) + real(r8) x(imax) + real(r8) xn(n) + real(r8) yn(n) + + integer i + +! Local variables + integer KK(IMAX) + integer NN + +! **** +! **** Where: +! **** Y(IMAX) is vector output +! **** +! **** KK is work space +! **** +! **** +! **** Initialize array KK +! **** + + do i = 1,imax + kk(i) = 0 + enddo + +! **** +! **** Locate interval in (XN,YN) in table containing X(I) +! **** + + do nn = 1,n-1 + do i = 1,imax + kk(i) = merge(nn+1,kk(i),(xn(nn+1)-x(i))*(x(i)-xn(nn))>=0._r8) + enddo + enddo + +! **** +! **** Check for +! **** +! **** X(I) < XN(1), X(I) > X(N) +! **** +! **** and use linear extrapolation if necessary +! **** + + do i = 1,imax + kk(i) = merge(2,kk(i),xn(1)-x(i)>=0._r8) + kk(i) = merge(n,kk(i),x(i)-xn(n)>=0._r8) + enddo + +! **** +! **** Perform interpolation prescribed above +! **** + + do i = 1,imax + y(i) = (yn(kk(i)-1)*(xn(kk(i))-x(i)) + yn(kk(i))* & + (x(i)-xn(kk(i)-1)))/(xn(kk(i))-xn(kk(i)-1)) + enddo + + return + end subroutine a18linv + + +!======================================================================================== + + subroutine viccooln (ncol,alam,djm,dj0,aajm,aaj0,tv,co2,o3,am,flux,hco2,ho3 ) + +! +! Original version from Ray Roble. +! Adapted to CCM by F. Sassi (Nov. 1999) +! + +!----------------------------------------------------------------- +implicit none +!----------------------------------------------------------------- + +! +! **** This is the mod that calculates LTE and NLTE components +! **** of the cooling rates. +! + +! XL(17) - the parameters for NLTE region (12.5 <= X <= 16.5) + +! Input variables + + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: tv(pcols,nrfm) ! neutral temp interpolated to Fomichev grid + real(r8), intent(in) :: o3(pcols,nrfm) ! O3 vmr interpolated to Fomichev grid + real(r8), intent(in) :: am(pcols,nrfm) ! Mean air molecular weight interpolated to Fomichev grid + real(r8), intent(in) :: co2(pcols,nrfm) ! CO2 vmr interpolated to Fomichev grid + real(r8), intent(in) :: djm(pcols,nrfm) ! DJM coefficient in recurrence formula + real(r8), intent(in) :: dj0(pcols,nrfm) ! DJ0 coefficient in recurrence formula + real(r8), intent(in) :: aajm(pcols,nrfm) ! AAJM coefficient in recurrence formula + real(r8), intent(in) :: aaj0(pcols,nrfm) ! AAJ0 coefficient in recurrence formula + real(r8), intent(in) :: alam(pcols,nrfm) ! LAMBDA + + +! Local variables + real(r8) FU(pcols,nrfm) + real(r8) FO3(pcols,nrfm) + real(r8) H1(pcols) + real(r8) H2(pcols) + real(r8) H3(pcols) + + integer jj + integer k + integer i + integer ks + integer jjs + + +! Output variables + real(r8), intent(out) :: flux(pcols) ! Flux boundary condition for cool-to-space + real(r8), intent(out) :: hco2(pcols,nrfm) ! CO2 cooling in Fomichev grid + real(r8), intent(out) :: ho3(pcols,nrfm) ! O3 cooling in Fomichev grid + + real(r8) :: amat(nrfmlte,nrfmltelv) + real(r8) :: bmat(nrfmlte,nrfmltelv) + +!-------------------------------------------------------------------- +! update the amat and bmat matrices with time-dependent surf CO2 +!-------------------------------------------------------------------- + call set_matrices(amat,bmat) + + + hco2(1:ncol,1:nrfm)=0.0_r8 + ho3(1:ncol,1:nrfm)=0.0_r8 + flux(1:ncol)=0.0_r8 + +! +! grid levels for height integration (p.s.h. distance = 0.25*IG) +! + + do k=1,nrfm + do i=1,ncol + fu(i,k)=exp(-960.217_r8/tv(i,k)) + fo3(i,k)=exp(-1500._r8/tv(i,k)) + enddo + enddo + +! +! calculate the heating rates for layer below s.h.p. = 12.5 +! 15 um CO2 + 9.6 um O3: +! +! +! **** COOLING RATE IN BOTH O3 AND CO2 BANDS (X=2-10.5) MATRIX +! **** APPROACH +! + +! Adding KS=K+8 maps NFRMC into NFRM + do k=1,5 + ks = k+8 + do i=1,ncol + h2(i) = (amat(k,1)+bmat(k,1)*fu(i,ks))*fu(i,1) + h3(i) = ao3(k,1)*fo3(i,1) + enddo + do jj=3,nrfmltelv + jjs = ks+ig(jj) + do i=1,ncol + h2(i) = h2(i)+(amat(k,jj)+bmat(k,jj)*fu(i,ks))*fu(i,jjs) + h3(i) = h3(i)+ao3(k,jj)*fo3(i,jjs) + enddo + enddo + do i=1,ncol + hco2(i,ks) = h2(i) + ho3(i,ks) = h3(i)*o3(i,ks) + enddo + enddo + + do k=6,18 + ks = k+8 + do i=1,ncol + h2(i) = (amat(k,1)+bmat(k,1)*fu(i,ks))*fu(i,1) + h3(i) = ao3(k,1)*fo3(i,1) + enddo + do jj=2,nrfmltelv + jjs = ks+ig(jj) + do i=1,ncol + h2(i) = h2(i)+(amat(k,jj)+bmat(k,jj)*fu(i,ks))*fu(i,jjs) + h3(i) = h3(i)+ao3(k,jj)*fo3(i,jjs) + enddo + enddo + do i=1,ncol + hco2(i,ks) = h2(i) + ho3(i,ks) = h3(i)*o3(i,ks) + enddo + enddo + + do k=19,35 + ks = k+8 + do i=1,ncol + h2(i) = 0._r8 + h3(i) = 0._r8 + enddo + do jj=1,nrfmltelv + jjs = ks+ig(jj) + do i=1,ncol + h2(i) = h2(i)+(amat(k,jj)+bmat(k,jj)*fu(i,ks))*fu(i,jjs) + h3(i) = h3(i)+ao3(k,jj)*fo3(i,jjs) + enddo + enddo + do i=1,ncol + hco2(i,ks) = h2(i) + ho3(i,ks) = h3(i)*o3(i,ks) + enddo + enddo + +! +! **** COOLING RATE IN CO2 BANDS (X=10.75-12.5, MATRIX APPROACH) +! + do k=36,43 + + ks = k+8 + + do i=1,ncol + h2(i) = 0._r8 + enddo + + do jj=1,nrfmltelv + jjs = ks+ig(jj) + do i=1,ncol + h2(i) = h2(i) + ( amat(k,jj) + bmat(k,jj)*fu(i,ks) ) * fu(i,jjs) + enddo + enddo + + do i=1,ncol + hco2(i,ks) = h2(i) + ho3(i,ks) = 0._r8 + enddo + + enddo + + +! Define boundary condition at XR=12.5 for recurrence formula + do k=1,nrfm + if (xr(k).eq.12.5_r8) then + do i=1,ncol + h1(i)=hco2(i,k)/(co2(i,k)*(1._r8-alam(i,k))*constb) + enddo + endif + enddo + + +! Do the rest of the XR domain +! (transition region 12.75 <= p.s.h. <= 16.5) + do k=1,nrfm + + if (xr(k).ge.12.75_r8 .and. xr(k).le.16.5_r8) then + + do i=1,ncol + + h2(i) = ( aajm(i,k)*h1(i) + djm(i,k)*fu(i,k-1) & + - dj0(i,k)*fu(i,k) ) / aaj0(i,k) + + hco2(i,k) = h2(i)*co2(i,k)*(1._r8-alam(i,k))/am(i,k)*const + ho3(i,k) = 0._r8 + + h1(i) = h2(i) + + enddo ! next longitude + + if (xr(k).eq.16.5_r8) then + +! Calculate FLUX at the top of the transition region (XR=16.5) + do i=1,ncol + flux(i) = h2(i) + fu(i,nrfm) + enddo + + + endif + + endif + + enddo ! next NLTE level + + + return + end subroutine viccooln + +!============================================================================================ + + subroutine cool2space (ncol,t,mwair,vn2,vo2,vo,vco2,ndenair,xnorm,flux,hc2s) + +! +! Adapted from Ray Roble's model by F. Sassi (Nov. 1999) +! +! Performs cool-to-space cooling calculations +! This mod operates on the same vertical grid of the GCM +! +!----------------------------------------------------------------- +implicit none +!----------------------------------------------------------------- + + +! Input variables + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: t(pcols,pver) ! neutral temperature + real(r8), intent(in) :: vn2(pcols,pver) ! N2 vmr + real(r8), intent(in) :: vo2(pcols,pver) ! O2 vmr + real(r8), intent(in) :: vco2(pcols,pver) ! CO2 vmr + real(r8), intent(in) :: vo(pcols,pver) ! O vmr + real(r8), intent(in) :: ndenair(pcols,pver) ! mean air no. density + real(r8), intent(in) :: mwair(pcols,pver) ! mean air molecular weight + real(r8), intent(in) :: flux(pcols) ! Radiative flux at the top of the NLTE region + real(r8), intent(in) :: xnorm(pcols,pver) ! p.s.h. + +! Output variables + real(r8), intent(out) :: hc2s(pcols,pver) ! cool-to-space cooling + +! Local variables + real(r8) tt + real(r8) y + real(r8) zn2 + real(r8) zo2 + real(r8) zz + real(r8) alam + real(r8) rko + + integer k + integer i + +! **** +! **** CO2 COOL-TO-SPACE APPROXIMATION +! **** + + + hc2s(1:ncol,1:pver)=0.0_r8 + do k = 1,pver + + do i=1,ncol + + if (xnorm(i,k) .gt. 16.5_r8) then + + tt = t(i,k) + y = tt**(-1._r8/3._r8) + zn2 = 5.5e-17_r8*sqrt(tt) + 6.7e-10_r8 * exp(-83.8_r8*y) + zo2 = 1.0e-15_r8*exp(23.37_r8 - 230.9_r8*y + 564._r8*y*y) + rko=3.0e-12_r8 + +! +! **** COLLISIONAL DEACTIVATION RATE: +! + zz = (vn2(i,k)*zn2 + vo2(i,k)*zo2 + vo (i,k)*rko)*ndenair(i,k) + +! +! **** +! + alam = a10/(a10+zz) + hc2s(i,k) = const/mwair(i,k)*vco2(i,k)*(1._r8-alam) & + *(flux(i)-exp(-960.217_r8/tt)) + + endif + + enddo ! end-loop in longitude + + enddo ! end-loop in levels + + return + end subroutine cool2space + + +!===================================================================== + + +real(r8) function a18lin (x,xn,yn,m,n) + +! input: +! X - argument for which a value of function should be found +! XN(N),YN(N) - values of function YN(N) at XN(N) grid. X(N) should be +! ordered so that X(I-1) < X(I). +! output: +! A18LIN - value of function for X + + implicit none + +! +! Args: + integer,intent(in) :: m,n + real(r8),intent(in) :: x + real(r8),intent(in) :: xn(n) + real(r8),intent(in) :: yn(n) +! +! Local: + integer :: k,i + + k=m-1 + the_loop: do i=m,n + k=k+1 + if (x-xn(i).le.0._r8) exit the_loop + enddo the_loop + if(k.eq.1) k=2 + +! k has been found so that xn(k).le.x.lt.xn(k+1) + + a18lin=(yn(k)-yn(k-1))/(xn(k)-xn(k-1))*(x-xn(k))+yn(k) + + return + + end function a18lin + +!============================================================================= + + + subroutine a18int(x1,y1,x2,y2,n1,n2) + +! +! third order spline interpolation +! input argument and function: X1(1:N1),Y1(1:N1) +! output argument and function: X2(1:N2)X2(1:N2),Y2(1:N2) +! the necessary conditionts are: X1(I) < X1(I+1), and the same for X2 array. +! + + implicit none +! +! Args: + integer, intent(in) :: n1 + integer, intent(in) :: n2 + real(r8), intent(in) :: x1(n1) + real(r8), intent(in) :: y1(n1) + real(r8), intent(in) :: x2 + real(r8), intent(out) :: y2 +! +! Local: + real(r8) :: a(150),e(150),f(150),h(150),h2,h1,f1,f2,f3,g + integer :: nvs,k,kr,l +! + h2=x1(1) + nvs=n1-1 + do 1 k=1,nvs + h1=h2 + h2=x1(k+1) + h(k)=h2-h1 + 1 continue + a(1)=0._r8 + a(n1)=0._r8 + e(n1)=0._r8 + f(n1)=0._r8 + h1=h(n1-1) + f1=y1(n1-1) + f2=y1(n1) + do 2 kr=2,nvs + k=nvs+2-kr + h2=h1 + h1=h(k-1) + f3=f2 + f2=f1 + f1=y1(k-1) + g=1._r8/(h2*e(k+1)+2._r8*(h1+h2)) + e(k)=-h1*g + f(k)=(3._r8*((f3-f2)/h2-(f2-f1)/h1)-h2*f(k+1))*g + 2 continue + g=0._r8 + do 3 k=2,nvs + g=e(k)*g+f(k) + a(k)=g + 3 continue + l=1 +!$$$ do 4 i=1,n2 +!$$$ g=x2(i) + g=x2 + do 6 k=l,nvs + if(g.gt.x1(k+1)) goto 6 + l=k + goto 5 + 6 continue + l=nvs + 5 g=g-x1(l) + h2=h(l) + f2=y1(l) + f1=h2**2 + f3=g**2 + y2=f2+g/h2*(y1(l+1)-f2-(a(l+1)*(f1-f3)+ & + a(l)*(2._r8*f1-3._r8*g*h2+f3))/3._r8) +!$$$ 4 continue + return + end subroutine a18int + +!================================================================================================== + + subroutine nocooling(ncol,t,pmid,nommr,o1mmr,o2mmr,o3mmr,n2mmr,nocool) + +! +! Calculate NO cooling (ref: Kockarts, GRL, vol. 7, pp 137-140, 1980) +! + + integer, intent(in) :: ncol ! number of column in chunck + + real(r8), intent(in) :: t(pcols,pver) ! neutral gas temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! model pressure at midpoints (Pa) + real(r8), intent(in) :: nommr(pcols,pver) ! NO (in mmr) + real(r8), intent(in) :: o1mmr(pcols,pver) ! O (in mmr) + real(r8), intent(in) :: o2mmr(pcols,pver) ! O2 (in mmr) + real(r8), intent(in) :: o3mmr(pcols,pver) ! O3 (in mmr) + real(r8), intent(in) :: n2mmr(pcols,pver) ! N2 (in mmr) + + real(r8), intent(out) :: nocool(pcols,pver) ! NO-cooling (K/S) + +! Local space + real(r8) :: mwair(pcols,pver) ! mean molecular weight + real(r8) :: pres_cgs(pcols,pver) ! pressure in cgs units + real(r8) :: nair(pcols,pver) ! mean air number density (molecules/cm3) + real(r8) :: o1vmr(pcols,pver) ! O (vmr) + real(r8) :: o2vmr(pcols,pver) ! O2 (vmr) + real(r8) :: no_conc ! NO concentration divided by mean air density + real(r8) :: no_deact ! effective NO deactivation rate multiplied by air concentration + + real(r8), parameter :: o1_rate = 2.7e-11_r8 ! O1 reaction rate (units????) + real(r8), parameter :: o2_rate = 2.4e-14_r8 ! O2 reaction rate (units????) + real(r8), parameter :: phot_e = 3.726e-13_r8 ! photon energy at 5.3 mum (erg) + real(r8), parameter :: trans_prob = 13.3_r8 ! Einstein transition probability + + integer :: i,k +!--------------------------------------------------------------------------------- + +! Calculate mean air molecular weight + do k=1, pver + do i=1, ncol + mwair(i,k) = 1._r8 / & + (o2mmr(i,k) /o2_mw + (o1mmr(i,k)+o3mmr(i,k))/o1_mw + n2mmr(i,k)/n2_mw) + end do + end do + + do k=1,pver + do i=1,ncol +! convert mmr to vmr + o1vmr(i,k) = o1mmr(i,k) * mwair(i,k) / o1_mw + o2vmr(i,k) = o2mmr(i,k) * mwair(i,k) / o2_mw +! Convert pressure to cgs units + pres_cgs(i,k) = pmid(i,k) * 10._r8 +! calculate mean air number density + nair(i,k) = anav * pres_cgs(i,k) / (ur*t(i,k)) + end do + end do + +!---------------------------------------------------------------------------------- +! NO cooling +!---------------------------------------------------------------------------------- + do k=1,pver + do i=1,ncol +!---------------------------------------------------------------------------------- +! calcualte effective NO deactivation rate times mean air concentration +!---------------------------------------------------------------------------------- + no_deact = nair(i,k) * (o1_rate * o1vmr(i,k) + o2_rate * o2vmr(i,k) ) +!---------------------------------------------------------------------------------- +! calculate NO concentration: +! +! Na +! n(NO) = mmr(NO) * ------ * rho(air) +! M(NO) +! +! where M(NO) is NO molecular weight and rho(air) is mean air density. +! However, in order to produce a heating in energy per unit mass, we need +! to divide by rho(air) at the end. Therefore, rho(air) IS NOT INCLUDED IN +! THE CALCULATION OF n(NO). +!---------------------------------------------------------------------------------- + no_conc = anav * nommr(i,k) / no_mw +!---------------------------------------------------------------------------------- +! Heating calculation. It produces a heating in erg/g/s. +! convert to J/kg/s +!---------------------------------------------------------------------------------- + nocool(i,k) = -1.e-4_r8 * phot_e * trans_prob * no_conc & + * (no_deact / (no_deact + trans_prob)) * exp(-2700._r8/t(i,k)) + enddo + enddo + + +! + end subroutine nocooling + +!================================================================================================== + + subroutine o3pcooling( ncol, t, o1mmr, o3pcool ) + ! + ! Adapted from TIE-GCM + ! Original equation is from Bates [1951] + ! Masking factors are from Kockarts and Peetermans [1981] + ! + + integer, intent(in) :: ncol ! number of column in chunck + + real(r8), intent(in) :: t(pcols,pver) ! neutral gas temperature (K) + real(r8), intent(in) :: o1mmr(pcols,pver) ! O (in mmr) + + real(r8), intent(out) :: o3pcool(pcols,pver) ! O(3p)-cooling (K/S) + + ! Local space + + integer :: i,k + real(r8) :: invtemp(ncol,pver) + real(r8) :: work1(ncol,pver) + real(r8) :: work2(ncol,pver) + real(r8) :: anavfac + + real(r8),parameter :: & + an(3) = (/0.835E-18_r8, 0.6_r8, 0.2_r8/), & + bn(3) = (/228._r8,228._r8,325._r8/) ! coefficients in Bates equation + + invtemp(:ncol,:) = 1.0_r8/t(:ncol,:) + anavfac = anav/o1_mw + + do k=1,pver + do i=1,ncol + work1(i,k) = an(1)*o3pxfac(k)*anavfac + work1(i,k) = work1(i,k)*o1mmr(i,k)*exp(-bn(1)*invtemp(i,k)) + work2(i,k) = 1._r8 + an(2)*exp(-bn(2)*invtemp(i,k)) & + + an(3)*exp(-bn(3)*invtemp(i,k)) + o3pcool(i,k) = -work1(i,k)/work2(i,k) ! erg/g/s + o3pcool(i,k) = o3pcool(i,k) * 1E-04_r8 ! convert units from erg/g/s to J/kg/s + enddo + enddo + + end subroutine o3pcooling + +end module nlte_fomichev diff --git a/src/physics/waccm/nlte_lw.F90 b/src/physics/waccm/nlte_lw.F90 new file mode 100644 index 0000000000..ff795ce881 --- /dev/null +++ b/src/physics/waccm/nlte_lw.F90 @@ -0,0 +1,360 @@ +module nlte_lw + +! +! interface for calculation of non-LTE heating rates +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver + use pmgrid, only: plev + use rad_constituents, only: rad_cnst_get_gas, rad_cnst_get_info + use nlte_fomichev, only: nlte_fomichev_init, nlte_fomichev_calc, nocooling, o3pcooling + use waccm_forcing, only: waccm_forcing_init, waccm_forcing_adv, get_cnst + use cam_logfile, only: iulog + + implicit none + private + save + +! Public interfaces + public & + nlte_init, & + nlte_timestep_init, & + nlte_tend + +! Private module data + +! namelist variables + logical :: nlte_use_mo ! Determines which constituents are used from NLTE calculations +! = .true. uses MOZART constituents +! = .false. uses constituents from bnd dataset cftgcm + + logical :: use_data_o3 + logical :: use_waccm_forcing = .false. + + real(r8) :: o3_mw ! O3 molecular weight + +! indexes of required constituents in model constituent array + integer :: ico2 ! CO2 index + integer :: io1 ! O index + integer :: io2 ! O2 index + integer :: io3 ! O3 index + integer :: ih ! H index + integer :: ino ! NO index + +! merge limits for data ozone + integer :: nbot_mlt ! bottom of pure tgcm range + integer :: ntop_cam ! bottom of merge range + real(r8):: wt_o3_mrg(pver) ! merge weights for cam o3 + +!================================================================================================ +contains +!================================================================================================ + + subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) +! +! Initialize the nlte parameterizations and tgcm forcing data, if required +!------------------------------------------------------------------------ + use constituents, only: cnst_mw, cnst_get_ind + use physconst, only: mwco2 + use cam_history, only: add_default, addfld + use mo_waccm_hrates, only: has_hrates + use phys_control, only: phys_getopts + + real(r8), intent(in) :: pref_mid(plev) + logical, intent(in) :: nlte_use_mo_in + logical, intent(in) :: nlte_limit_co2 + + real(r8) :: o1_mw ! O molecular weight + real(r8) :: o2_mw ! O2 molecular weight + real(r8) :: co2_mw ! CO2 molecular weight + real(r8) :: n2_mw ! N2 molecular weight + real(r8) :: no_mw ! NO molecular weight + + real(r8) :: psh(pver) ! pressure scale height + real(r8) :: pshmn ! lower range of merge + real(r8) :: pshmx ! upper range of merge + real(r8) :: pshdd ! scale + integer :: k ! index + logical :: rad_use_data_o3 + logical :: history_waccm +!---------------------------------------------------------------------------------------- + + call phys_getopts(history_waccm_out=history_waccm) + +! Set flag to use mozart (or tgcm) consituents + nlte_use_mo = nlte_use_mo_in + + ! ask rad_constituents module whether the O3 used in the climate + ! calculation is from data + call rad_cnst_get_info(0, use_data_o3=rad_use_data_o3) + + ! Use data ozone if nlte_use_mo=false, or if nlte_use_mo=true and the flag to use data ozone + ! for the interactive radiation calculation has been set to .true. in the rad_constituents module + use_data_o3 = .false. + if ( .not. nlte_use_mo .or. & + (nlte_use_mo .and. rad_use_data_o3) ) use_data_o3 = .true. + +! Define merge weights for data ozone + if (use_data_o3) then + pshmn=7.0_r8 + pshmx=8.5_r8 + pshdd=1.0_r8 + + nbot_mlt = 0 + ntop_cam = 0 + do k = 1, plev + psh(k) = log(1e5_r8/pref_mid(k)) + if (psh(k) >= pshmx) nbot_mlt = k + if (psh(k) >= pshmn) ntop_cam = k+1 + end do + + wt_o3_mrg(:) = 0._r8 + do k = nbot_mlt+1, ntop_cam-1 + wt_o3_mrg(k) = 1._r8 - tanh( (psh(k)-pshmn)/pshdd ) + enddo + write(iulog,*) 'NLTE data ozone merge range is ', nbot_mlt+1, ntop_cam-1 + write(iulog,*) 'NLTE data ozone merge weights are ', wt_o3_mrg(nbot_mlt+1 : ntop_cam-1) + + call addfld ('O3MRG',(/ 'lev' /), 'A','mol/mol','merged (eUV+CAM) O3 vmr') + + end if + +! Get molecular weights and constituent indexes + if (nlte_use_mo) then + + call cnst_get_ind( 'CO2', ico2 ) + call cnst_get_ind( 'O', io1 ) + call cnst_get_ind( 'O2', io2 ) + call cnst_get_ind( 'O3', io3 ) + call cnst_get_ind( 'H', ih ) + call cnst_get_ind( 'NO', ino ) + + co2_mw= cnst_mw(ico2) + o1_mw = cnst_mw(io1) + o2_mw = cnst_mw(io2) + o3_mw = cnst_mw(io3) + no_mw = cnst_mw(ino) + n2_mw = 28._r8 + + else + + co2_mw = mwco2 + o1_mw = 16._r8 + o2_mw = 32._r8 + o3_mw = 48._r8 + no_mw = 30._r8 + n2_mw = 28._r8 + + end if + + use_waccm_forcing = use_data_o3 .or. (.not.nlte_use_mo) .or. (.not. has_hrates) + +! Initialize Fomichev parameterization + call nlte_fomichev_init (co2_mw, n2_mw, o1_mw, o2_mw, o3_mw, no_mw, nlte_limit_co2) + +! Initialize waccm forcing data + if (use_waccm_forcing) then + call waccm_forcing_init () + endif + + if (masterproc) then + + if (nlte_use_mo) then + write(iulog,*) 'NLTE constituents are obtained from the MOZART chemistry module' + else + write(iulog,*) 'NLTE constituents are obtained from boundary dataset' + endif + end if + +! add to masterfield list + call addfld ('QRLNLTE',(/ 'lev' /), 'A','K/s','Non-LTE LW heating (includes QNO and QO3P)') + call addfld ('QNO', (/ 'lev' /), 'A','K/s','NO cooling') + call addfld ('QCO2', (/ 'lev' /), 'A','K/s','CO2 cooling') + call addfld ('QO3', (/ 'lev' /), 'A','K/s','O3 cooling') + call addfld ('QHC2S', (/ 'lev' /), 'A','K/s','Cooling to Space') + call addfld ('QO3P', (/ 'lev' /), 'A','K/s','O3P cooling') + +! add output to default output for primary history tapes + if (history_waccm) then + call add_default ('QRLNLTE', 1, ' ') + call add_default ('QNO ', 1, ' ') + call add_default ('QCO2', 1, ' ') + call add_default ('QO3', 1, ' ') + call add_default ('QHC2S',1, ' ') + call add_default ('QO3P ', 1, ' ') + end if + + end subroutine nlte_init + +!======================================================================= + + subroutine nlte_timestep_init(state, pbuf2d) + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + +! +! Time interpolation of waccm forcing fields to the current time +! +!------------------------------------------------------------------------ + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + +!---------------------------Local workspace-------------------------------------- + + if (use_waccm_forcing) then + call waccm_forcing_adv (state, pbuf2d) + endif + + return + end subroutine nlte_timestep_init + +!================================================================================================ + + subroutine nlte_tend(state, pbuf, qrlf) +! +! Driver for nlte calculations +!------------------------------------------------------------------------- + use physconst, only: mwdry, cpairv + use physics_types, only: physics_state + use physics_buffer, only : physics_buffer_desc + use cam_history, only: outfld + +! Arguments + type(physics_state), target, intent(in) :: state ! Physics state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(out) :: qrlf(pcols,pver) ! nlte longwave heating rate + +! Local workspace for waccm + integer :: lchnk ! chunk identifier + integer :: ncol ! no. of columns in chunk + + real(r8) :: nocool (pcols,pver) ! NO cooling + real(r8) :: o3pcool (pcols,pver) ! O3P cooling + real(r8) :: qout (pcols,pver) ! temp for outfld + real(r8) :: co2cool(pcols,pver), o3cool(pcols,pver), c2scool(pcols,pver) + + real(r8), pointer, dimension(:,:) :: xco2mmr ! CO2 mmr + real(r8), pointer, dimension(:,:) :: xommr ! O mmr + real(r8), pointer, dimension(:,:) :: xo2mmr ! O2 mmr + real(r8), pointer, dimension(:,:) :: xo3mmr ! O3 mmr + real(r8), pointer, dimension(:,:) :: xhmmr ! H mmr + real(r8), pointer, dimension(:,:) :: xnommr ! NO mmr + real(r8), pointer, dimension(:,:) :: xn2mmr ! N2 mmr + + real(r8), target :: n2mmr (pcols,pver) ! N2 mmr + real(r8), target :: o3mrg(pcols,pver) ! merged O3 + real(r8), pointer, dimension(:,:) :: to3mmr ! O3 mmr (tgcm) + + integer :: k + +!------------------------------------------------------------------------ + + lchnk = state%lchnk + ncol = state%ncol + +! Get radiatively active ozone + call rad_cnst_get_gas(0, 'O3', state, pbuf, xo3mmr) + if (use_data_o3) then + call get_cnst (lchnk, o3=to3mmr) + call merge_o3 (ncol, xo3mmr, to3mmr, o3mrg) + qout(:ncol,:) = o3mrg(:ncol,:)*mwdry/o3_mw + call outfld ('O3MRG', qout, pcols,lchnk) + xo3mmr => o3mrg(:,:) + end if + + if (nlte_use_mo) then + +! Get relevant constituents from the chemistry module + xco2mmr => state%q(:,:,ico2) + xommr => state%q(:,:,io1) + xo2mmr => state%q(:,:,io2) + xhmmr => state%q(:,:,ih) + xnommr => state%q(:,:,ino) + + else + + call get_cnst (lchnk, co2=xco2mmr, o1=xommr, o2=xo2mmr, no=xnommr, h=xhmmr) + + endif + + do k = 1,pver + n2mmr (:ncol,k) = 1._r8 - (xommr(:ncol,k) + xo2mmr(:ncol,k) + xhmmr(:ncol,k)) + enddo + xn2mmr => n2mmr(:,:) + +! do non-LTE parameterization + call nlte_fomichev_calc (lchnk,ncol,state%pmid,state%pint,state%t, & + xo2mmr,xommr,xo3mmr,xn2mmr,xco2mmr,qrlf,co2cool,o3cool,c2scool) + +! do NO cooling + call nocooling (ncol, state%t, state%pmid, xnommr,xommr,xo2mmr,xo3mmr,xn2mmr,nocool) + +! do O3P cooling + call o3pcooling (ncol, state%t, xommr, o3pcool) + + do k = 1,pver + qrlf(:ncol,k) = qrlf(:ncol,k) + nocool(:ncol,k) + o3pcool(:ncol,k) + end do + + qout(:ncol,:) = nocool(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QNO' , qout, pcols, lchnk) + qout(:ncol,:) = o3pcool(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QO3P' , qout, pcols, lchnk) + qout(:ncol,:) = qrlf(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QRLNLTE', qout, pcols, lchnk) + + qout(:ncol,:) = co2cool(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QCO2', qout, pcols, lchnk) + qout(:ncol,:) = o3cool(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QO3', qout, pcols, lchnk) + qout(:ncol,:) = c2scool(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QHC2S', qout, pcols, lchnk) + + end subroutine nlte_tend + +!====================================================================================== + + subroutine merge_o3 (ncol, o3cam, o3mlt, o3mrg) +! +! Merges CAM O3 (usually climatology) with mesosphere/lower thermosphere O3 (usually TIME/GCM) +! +!------------------Input arguments---------------------------------------------- + + integer, intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: o3mlt(pcols,pver) ! MLT O3 mmr + real(r8), intent(in) :: o3cam(pcols,pver) ! CAM O3 mmr + real(r8), intent(out) :: o3mrg(pcols,pver) ! merged product + +!---------------------------Local Workspace-------------------------------------------- + + integer k ! index + +!------------------------------------------------------------------------------------- + +! combine ozone profiles of TIME/GCM with CAM + +! load TIME/GCM above NBOT_MLT + do k = 1, nbot_mlt + o3mrg(:ncol,k) = o3mlt(:ncol,k) + end do + +! merge + do k=nbot_mlt+1,ntop_cam-1 + o3mrg(:ncol,k) = (1._r8 - wt_o3_mrg(k)) * o3cam(:ncol,k) + wt_o3_mrg(k) * o3mlt(:ncol,k) + end do + +! load CAM below NTOP_CAM + do k=ntop_cam,pver + o3mrg(:ncol,k) = o3cam(:ncol,k) + end do + + end subroutine merge_o3 + +end module nlte_lw diff --git a/src/physics/waccm/qbo.F90 b/src/physics/waccm/qbo.F90 new file mode 100644 index 0000000000..3500774511 --- /dev/null +++ b/src/physics/waccm/qbo.F90 @@ -0,0 +1,972 @@ + +module qbo +!-------------------------------------------------------------------- +! This module performes a relaxation towards either a cyclic idealized +! QBO sequence derived from observations (here:28months) or towards +! observed equatorial wind data +! +! Author: Katja Matthes +! Date: February 2005 +! +! implementation into WACCM standard version, K. Matthes, October 2005 +! 3 possibilities: +! default: no QBO relaxation +! options: 1. cyclic QBO time series, currently a 28month sequence available: qbocyclic28months.nc +! 2. observed QBO time series, currently CCMVal QBO series, extended: qboseries_ext.nc +! 3. fixed QBOe or QBOw phase, currently : qboeast.nc, qbowest.nc +! +!-------------------------------------------------------------------- +! modified by Anne Smith, December 2009 +! +! Now accepts alternative input in the form of Fourier coefficients. +! In this case, the QBO wind is calculated from the expression +! u_qbo(k,n) = ubar_qbo(k) + sum_n[fcos_qbo(k,n) * cos(ffreq_qbo(n)*(cday-cday_ref)) +! + fsin_qbo(k,n) * sin(ffreq_qbo(n)*(cday-cday_ref))] +! where cday is day of model run +! cday_ref is a reference date so that historical data line up correctly +! k is level index +! n is coefficient index +! sum_n is the sum over n +!--------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver + use time_manager, only: get_curr_date, get_curr_calday + use phys_grid, only: get_rlat_p + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use bnddyi_mod, only: bnddyi + + implicit none + + private + save + +!--------------------------------------------------------------------- +! Public methods +!--------------------------------------------------------------------- + public :: qbo_readnl ! read namelist + public :: qbo_init ! initialize qbo package + public :: qbo_timestep_init ! interpolate to current time + public :: qbo_relax ! relax zonal mean wind + +!--------------------------------------------------------------------- +! Private module data +!--------------------------------------------------------------------- + integer,parameter :: qbo_dypm = 30 ! days in a cyclic qbo "month" + + integer :: nm, np ! Indices for previous, next month + integer :: np1 = 0 ! tempory for next time index of dataset + integer :: ktop ! Model layers within qbo region + integer :: kbot ! Model layers within qbo region + integer :: timesiz ! size of time dimension on dataset + integer :: levsiz ! size of lev dimension on dataset + integer :: qbo_mons ! length of cyclic qbo in months + integer :: delt ! time step in seconds + real(r8) :: qbo_days ! length of cyclic qbo in days + integer, allocatable :: date_qbo(:) ! Date on qbo dataset (YYYYMMDD) (timesiz) + integer, allocatable :: secd_qbo(:) ! seconds of date (0-86399) (timesiz) + + real(r8) :: cdaym ! dataset calendar day previous month + real(r8) :: cdayp ! dataset calendar day next month + real(r8),allocatable :: u_qbo(:,:) ! qbo winds(pver,timesiz) + real(r8),allocatable :: tauz(:) + real(r8) :: u_tstep(pver) ! qbo winds for this time step + + integer :: coefsiz ! size of coefficient dimension on fft dataset + real(r8) :: cday_ref ! reference day for fft input + real(r8),allocatable :: ubar_qbo(:) ! qbo mean winds(pver) + real(r8),allocatable :: fcos_qbo(:,:) ! qbo cosine coefficients(pver,coefsiz) + real(r8),allocatable :: fsin_qbo(:,:) ! qbo sine coefficients(pver,coefsiz) + real(r8),allocatable :: ffreq_qbo(:) ! frequencies for expanding qbo coefficients (coefsiz) + + ! Index into physics buffer for zonal mean zonal wind + integer :: uzm_idx = -1 + +! +! Options for controlling QBO relaxation +! + character(len=256) :: qbo_forcing_file = "" + logical,public :: qbo_use_forcing = .FALSE. ! .TRUE. => this package is active + logical :: qbo_cyclic = .FALSE. ! .TRUE. => assume cyclic qbo data + + logical :: has_monthly_data = .TRUE. ! .TRUE. => data file has monthly winds + ! .FALSE.=> data file has fft coefficients + + +contains + +!================================================================================================ + + subroutine qbo_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'qbo_readnl' + + namelist /qbo_nl/ qbo_use_forcing, qbo_forcing_file, qbo_cyclic + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'qbo_nl', status=ierr) + if (ierr == 0) then + read(unitn, qbo_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! Check to make sure forcing file was set if qbo forcing is on. + if (qbo_use_forcing .and. trim(qbo_forcing_file) == "") then + call endrun(subname // ':: qbo forcing is on but no forcing & + &file was set.') + end if + end if + +#ifdef SPMD + call mpibcast (qbo_forcing_file, len(qbo_forcing_file ), mpichar, 0, mpicom) + call mpibcast (qbo_use_forcing, 1, mpilog, 0, mpicom) + call mpibcast (qbo_cyclic, 1, mpilog, 0, mpicom) +#endif + + end subroutine qbo_readnl + +!================================================================================================ + + + subroutine qbo_init +!--------------------------------------------------------------------- +! initialize qbo module +!--------------------------------------------------------------------- + use physics_buffer, only: pbuf_get_index + use time_manager, only : get_step_size + use ref_pres, only : pref_mid + use phys_control, only : phys_getopts + use cam_history, only : addfld, add_default + use wrap_nf +#if (defined SPMD ) + use mpishorthand +#endif + +!--------------------------------------------------------------------- +! Local workspace +!--------------------------------------------------------------------- + real(r8), parameter :: hPa2Pa = 100._r8 + + integer :: yr, mon, day ! components of a date + integer :: ncsec ! current time of day [seconds] + integer :: ncid ! netcdf ID for input dataset + integer :: astat ! allocate status + + integer :: k,kk ! vertical interpolation indexes + integer :: levdimid ! netcdf id for level dimension + integer :: timdimid ! netcdf id for time dimension + integer :: levid ! netcdf id for level variable + integer :: dateid ! netcdf id for date variable + integer :: secdid ! netcdf id for seconds variable + integer :: uqboid ! netcdf id for qbo wind variable + + real(r8) :: fac1, fac2 ! interpolation factors + real(r8) :: calday ! current calendar day + real(r8) :: cday ! current day (in cycle, if cycling) + real(r8), allocatable :: p_inp(:) ! qbo pressure levels(levsiz) + real(r8), allocatable :: u_inp(:,:) ! input qbo winds(levsiz,timesiz) have to be sorted + ! from top to bottom like winds in model + + integer :: fftdimid ! netcdf id for fft coefficient dimension + integer :: ubarqboid ! netcdf id for mean wind variable + integer :: cosqboid ! netcdf id for cosine coefficient variable + integer :: sinqboid ! netcdf id for sine coefficient variable + integer :: freqqboid ! netcdf id for fft frequency variable + integer :: refdatid ! netcdf id for reference date + + integer :: ref_date ! date corresponding to beginning of QBO data + integer :: yr_ref ! year for reference day + real(r8), allocatable :: ubar_inp(:) ! input time-mean winds for fft input (levsiz) + real(r8), allocatable :: cosq_inp(:,:) ! input cosine coefficients for fft input (levsiz,coefsiz) + real(r8), allocatable :: sinq_inp(:,:) ! input sine coefficients for fft input (levsiz,coefsiz) + + logical :: found + + logical :: history_waccm + + if( .not. qbo_use_forcing ) then + return + end if + + call phys_getopts(history_waccm_out=history_waccm) + +!--------------------------------------------------------------------- +! SPMD: Master does all the work of reading files. Sends needed info to slaves +!--------------------------------------------------------------------- + if( masterproc ) then +!--------------------------------------------------------------------- +! Get qbo file +!--------------------------------------------------------------------- + call wrap_open( qbo_forcing_file, NF90_NOERR, ncid ) + write(iulog,*) 'qbo_init: successfully opened ',trim(qbo_forcing_file) +!--------------------------------------------------------------------- +! Figure out if the file contains qbo winds by month or fft coefficients +! by looking for the variable DATE +!--------------------------------------------------------------------- + call wrap_inq_varid( ncid, 'date' , dateid, abort=.false. ) + + if (dateid > 0) then + has_monthly_data=.true. + else + has_monthly_data=.false. + end if + write(iulog,*) 'has_monthly_data=', has_monthly_data + +!--------------------------------------------------------------------- +! Get and check dimension info +!--------------------------------------------------------------------- + if (has_monthly_data) then + call wrap_inq_dimid( ncid, 'level' , levdimid ) + call wrap_inq_dimid( ncid, 'time', timdimid ) + + call wrap_inq_dimlen( ncid, levdimid, levsiz ) + call wrap_inq_dimlen( ncid, timdimid, timesiz ) + + call wrap_inq_varid( ncid, 'date' , dateid ) + call wrap_inq_varid( ncid, 'secs' , secdid ) + call wrap_inq_varid( ncid, 'qbo' , uqboid ) + call wrap_inq_varid( ncid, 'level', levid ) + else + call wrap_inq_dimid( ncid, 'level' , levdimid ) + call wrap_inq_dimid( ncid, 'ncoef', fftdimid ) + + call wrap_inq_dimlen( ncid, levdimid, levsiz ) + call wrap_inq_dimlen( ncid, fftdimid, coefsiz ) + + call wrap_inq_varid( ncid, 'ref_date', refdatid ) + + call wrap_inq_varid( ncid, 'ubar' , ubarqboid ) + call wrap_inq_varid( ncid, 'cosqbo' , cosqboid ) + call wrap_inq_varid( ncid, 'sinqbo' , sinqboid ) + call wrap_inq_varid( ncid, 'freqqbo', freqqboid ) + call wrap_inq_varid( ncid, 'level' , levid ) + end if + end if + + +!--------------------------------------------------------------------- +! Broadcast the logical flag has_monthly_data +!--------------------------------------------------------------------- +#if (defined SPMD ) + call mpibcast( has_monthly_data, 1, mpilog, 0, mpicom ) +#endif + + if (.not.has_monthly_data) then +!--------------------------------------------------------------------- +! Broadcast coefsiz +!--------------------------------------------------------------------- +#if (defined SPMD ) + call mpibcast( coefsiz, 1, mpiint, 0, mpicom ) +#endif + end if + + if (has_monthly_data) then +#if (defined SPMD ) +!--------------------------------------------------------------------- +! Broadcast the time size to all tasks for case with monthly input +!--------------------------------------------------------------------- + call mpibcast( timesiz, 1, mpiint, 0, mpicom ) +#endif + + delt = get_step_size() + if( qbo_cyclic ) then + qbo_mons = timesiz + qbo_days = qbo_mons*qbo_dypm + end if + + allocate( date_qbo(timesiz), secd_qbo(timesiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate date_qbo ... secd_qbo; error = ',astat + call endrun + end if + end if +!--------------------------------------------------------------------- +! Get input variables +!--------------------------------------------------------------------- +master_proc : & + if( masterproc ) then +!--------------------------------------------------------------------- +! Allocate arrays, depending on type of input data: monthly or fft +!--------------------------------------------------------------------- + if (has_monthly_data) then + allocate( u_inp(levsiz,timesiz), p_inp(levsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate u_inp ... p_inp; error = ',astat + call endrun + end if + astat = nf90_get_var( ncid, uqboid, u_inp ) + if (astat/=NF90_NOERR) then + write(iulog,*) "QBO: NF90_GET_VAR: error reading varid =", uqboid + call endrun + end if + call wrap_get_var_realx( ncid, levid , p_inp ) + else + allocate( p_inp(levsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate p_inp; error = ',astat + call endrun + end if + allocate( ubar_inp(levsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate ubar_inp; error = ',astat + call endrun + end if + allocate( cosq_inp(levsiz,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate cosq_inp; error = ',astat + call endrun + end if + allocate( sinq_inp(levsiz,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate sinq_inp; error = ',astat + call endrun + end if + allocate( ffreq_qbo(coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate ffreq_qbo; error = ',astat + call endrun + end if + call wrap_get_var_realx( ncid, levid , p_inp ) + call wrap_get_var_realx( ncid, ubarqboid, ubar_inp ) + astat = nf90_get_var( ncid, cosqboid, cosq_inp ) + if (astat/=NF90_NOERR) then + write(iulog,*) "QBO: NF90_GET_VAR: error reading varid =", cosqboid + call endrun + end if + astat = nf90_get_var( ncid, sinqboid, sinq_inp ) + if (astat/=NF90_NOERR) then + write(iulog,*) "QBO: NF90_GET_VAR: error reading varid =", sinqboid + call endrun + end if + call wrap_get_var_realx( ncid, freqqboid, ffreq_qbo ) + call wrap_get_scalar_int(ncid, refdatid, ref_date ) + + call bnddyi( ref_date, 0, cday_ref ) + yr_ref = ref_date/10000 + cday_ref = cday_ref + yr_ref*365._r8 + + end if + +!--------------------------------------------------------------------- +! Convert from millibars to pascals +!--------------------------------------------------------------------- + p_inp(:) = p_inp(:)*hPa2Pa + write(iulog,*) 'qbo_init: p_inp', p_inp/hPa2Pa + + if (has_monthly_data) then + call wrap_get_var_int( ncid, dateid, date_qbo ) + call wrap_get_var_int( ncid, secdid, secd_qbo ) + + write(iulog,*) 'qbo_init: u_inp', u_inp(:,1) + end if + +!--------------------------------------------------------------------- +! Find first model layer within qbo range +!--------------------------------------------------------------------- + do ktop = 1,pver + if( pref_mid(ktop) >= p_inp(1) ) then + exit + end if + end do + write(iulog,*) 'qbo_init: ktop = ', ktop, pref_mid(ktop)/hPa2Pa + +!--------------------------------------------------------------------- +! Find last model layer within qbo range +!--------------------------------------------------------------------- + do kbot = pver,ktop,-1 + if( pref_mid(kbot) <= p_inp(levsiz) ) then + exit + end if + end do + write(iulog,*) 'qbo_init: kbot = ', kbot, pref_mid(kbot)/hPa2Pa + + if (has_monthly_data) then + allocate( u_qbo(ktop:kbot,timesiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate u_qbo; error = ',astat + call endrun + end if + else + allocate( ubar_qbo(ktop:kbot), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate ubar_qbo; error = ',astat + call endrun + end if + allocate( fcos_qbo(ktop:kbot,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate fcos_qbo; error = ',astat + call endrun + end if + allocate( fsin_qbo(ktop:kbot,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate fsin_qbo; error = ',astat + call endrun + end if + end if +!--------------------------------------------------------------------- +! Vertically interpolate input winds to model reference pressures +!--------------------------------------------------------------------- + do k = ktop,kbot + do kk = 1,levsiz-1 + if( p_inp(kk+1) > pref_mid(k) ) then + exit + end if + end do + fac1 = (pref_mid(k) - p_inp(kk+1)) / (p_inp(kk) - p_inp(kk+1)) + fac2 = (p_inp(kk) - pref_mid(k) ) / (p_inp(kk) - p_inp(kk+1)) + if (has_monthly_data) then + u_qbo(k,:) = u_inp(kk,:)*fac1 + u_inp(kk+1,:)*fac2 + else + ubar_qbo(k) = ubar_inp(kk)*fac1 + ubar_inp(kk+1)*fac2 + fcos_qbo(k,:) = cosq_inp(kk,:)*fac1 + cosq_inp(kk+1,:)*fac2 + fsin_qbo(k,:) = sinq_inp(kk,:)*fac1 + sinq_inp(kk+1,:)*fac2 + endif + end do + + if (has_monthly_data) then + deallocate( u_inp, p_inp ) + write(iulog,*) 'qbo_init: u', u_qbo(ktop:kbot,1) + else + deallocate( p_inp ) + deallocate( ubar_inp ) + deallocate( cosq_inp ) + deallocate( sinq_inp ) + write(iulog,*) 'qbo_init: fcos_qbo', fcos_qbo(ktop:kbot,1) + end if + + +!--------------------------------------------------------------------- +! Dates are not used for cyclic QBO +!--------------------------------------------------------------------- + if( has_monthly_data .and. qbo_cyclic ) then + secd_qbo(:) = 0 + date_qbo(:) = 0 + end if + end if master_proc + +#if (defined SPMD ) +!--------------------------------------------------------------------- +! Broadcast the vertical limits +!--------------------------------------------------------------------- + call mpibcast( ktop, 1, mpiint, 0, mpicom ) + call mpibcast( kbot, 1, mpiint, 0, mpicom ) +#endif + + if( .not. masterproc ) then + if (has_monthly_data) then + allocate( u_qbo(ktop:kbot,timesiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate u_qbo; error = ',astat + call endrun + end if + else + allocate( ubar_qbo(ktop:kbot), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate ubar_qbo; error = ',astat + call endrun + end if + allocate( fcos_qbo(ktop:kbot,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate fcos_qbo; error = ',astat + call endrun + end if + allocate( fsin_qbo(ktop:kbot,coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate fsin_qbo; error = ',astat + call endrun + end if + allocate( ffreq_qbo(coefsiz), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate ffreq_qbo; error = ',astat + call endrun + end if + end if + end if + +!--------------------------------------------------------------------- +! Broadcast input data to all tasks +!--------------------------------------------------------------------- + kk = kbot-ktop+1 + if (has_monthly_data) then +#if (defined SPMD ) + call mpibcast( u_qbo , (kbot-ktop+1)*timesiz, mpir8, 0, mpicom ) + call mpibcast( date_qbo, timesiz, mpiint, 0, mpicom ) + call mpibcast( secd_qbo, timesiz, mpiint, 0, mpicom ) +#endif + else +#if (defined SPMD ) + call mpibcast( cday_ref , 1, mpir8, 0, mpicom ) +#endif +#if (defined SPMD ) + call mpibcast( ubar_qbo , (kbot-ktop+1), mpir8, 0, mpicom ) + call mpibcast( fcos_qbo , (kbot-ktop+1)*coefsiz, mpir8, 0, mpicom ) + call mpibcast( fsin_qbo , (kbot-ktop+1)*coefsiz, mpir8, 0, mpicom ) +#endif +#if (defined SPMD ) + call mpibcast( ffreq_qbo , coefsiz, mpir8, 0, mpicom ) +#endif + endif + +!--------------------------------------------------------------------- +! setup vertical factor +!--------------------------------------------------------------------- + allocate( tauz(ktop-1:kbot+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'qbo_init: failed to allocate tauz; error = ',astat + call endrun + end if + + tauz(ktop-1) = 2._r8 + tauz(kbot+1) = 2._r8 + tauz(ktop:kbot) = 1._r8 + +!--------------------------------------------------------------------- +! Get current day of year and date +!--------------------------------------------------------------------- + calday = get_curr_calday() + call get_curr_date( yr, mon, day, ncsec ) + if (masterproc) write(iulog,*) 'qbo_init: get_curr_date = ', yr,mon,day,ncsec + +!--------------------------------------------------------------------- +! Set current day in run or in qbo cycle +!--------------------------------------------------------------------- + cday = calday + yr*365._r8 + if (masterproc) write(iulog,*) 'qbo_init: cday = ', cday + if( has_monthly_data .and. qbo_cyclic ) then + cday = mod( cday,qbo_days ) + end if + if (masterproc) write(iulog,*) 'qbo_init: cday = ', cday + + if( has_monthly_data ) then + if( qbo_cyclic ) then +!--------------------------------------------------------------------- +! Set up cyclic qbo +!--------------------------------------------------------------------- +! Set past and future month indexes +!--------------------------------------------------------------------- + if( cday == 0._r8 ) then + nm = qbo_mons - 1 + np = qbo_mons + else + nm = cday / qbo_dypm + np = mod( nm,qbo_mons ) + 1 + if( nm == 0 ) then + nm = qbo_mons + end if + end if + if (masterproc) write(iulog,*) 'qbo_init: nm,np = ', nm,np +!--------------------------------------------------------------------- +! Set past and future days for data, generate day for cyclic data +!--------------------------------------------------------------------- + cdayp = np * qbo_dypm + cdaym = nm * qbo_dypm + else +!--------------------------------------------------------------------- +! Set up noncyclic qbo +!--------------------------------------------------------------------- + found = .false. + do nm = 1, timesiz-1 + np = nm+1 + call bnddyi( date_qbo(nm), secd_qbo(nm), cdaym ) + call bnddyi( date_qbo(np), secd_qbo(np), cdayp ) + yr = date_qbo(nm)/10000 + cdaym = cdaym + yr*365._r8 + yr = date_qbo(np)/10000 + cdayp = cdayp + yr*365._r8 + if (masterproc) write(iulog,*) 'qbo_init: nm, date_qbo(nm), date_qbo(np), cdaym, cdayp = ', & + nm, date_qbo(nm), date_qbo(np), cdaym, cdayp + if( cday >= cdaym .and. cday < cdayp ) then + found = .true. + exit + end if + end do + if( .not. found ) then + call endrun( 'QBO_INIT: failed to find bracketing dates' ) + end if + end if + if (masterproc) write(iulog,*) 'qbo_init: cdaym,cdayp = ', cdaym,cdayp + endif + +!--------------------------------------------------------------------- +! Initialize output buffer for two fields: QBO forcing wind and wind tendency of qbo relaxation +!---------------------------------------------------------------------- +! +!---------------------------------------------------------------------- + call addfld ('QBOTEND',(/ 'lev' /), 'A','M/S/S','Wind tendency from QBO relaxation') + call addfld ('QBO_U0', (/ 'lev' /), 'A','M/S','Specified wind used for QBO') + + if (history_waccm) then + call add_default ('QBOTEND', 1, ' ') + call add_default ('QBO_U0', 1, ' ') + end if + +!---------------------------------------------------------------------- +! Get zonal mean zonal wind index in pbuf. +!---------------------------------------------------------------------- + uzm_idx = pbuf_get_index("UZM") + + if (masterproc) write(iulog,*) 'end of qbo_init' + + end subroutine qbo_init + +!================================================================================================ + + subroutine qbo_timestep_init +!----------------------------------------------------------------------- +! +! Purpose: Interpolate QBO zonal wind to current time +! +! Method: Linear interpolation between dates on QBO file, +! vertically and horizontally +! +! Author: +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Local variables +!----------------------------------------------------------------------- + integer :: k ! level index + integer :: yr, mon, day ! components of a date + integer :: yrl, monl, dayl ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + integer :: ncsecl ! current time of day [seconds] + + real(r8) :: fact1, fact2 ! time interpolation factors + real(r8) :: calday ! day of year at end of present time step + real(r8) :: caldayl ! day of year at begining of present time step + real(r8) :: cday ! day within qbo period at end of present time step + real(r8) :: cdayl ! day within qbo period at begining of present time step + real(r8) :: deltat ! time difference (days) between cdaym and cdayp + + integer :: n ! coefficient index + real(r8) :: ccc ! cosine term for expanding coefficients + real(r8) :: sss ! sine term for expanding coefficients + + logical :: new_interval ! flag for new time interval + +has_qbo_forcing : & + if( qbo_use_forcing ) then +!----------------------------------------------------------------------- +! Get current day of year and date +!----------------------------------------------------------------------- + caldayl = get_curr_calday( -delt ) + call get_curr_date( yrl, monl, dayl, ncsecl, -delt ) + calday = get_curr_calday() + call get_curr_date( yr, mon, day, ncsec ) + ncdate = yr*10000 + mon*100 + day +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: calday = ', calday + write(iulog,*) 'qbo_timestep_init: ncdate = ', ncdate +#endif + +!----------------------------------------------------------------------- +! Set current day in run or in qbo cycle +!----------------------------------------------------------------------- + cday = calday + yr*365._r8 + cdayl = caldayl + yrl*365._r8 +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: cday = ', cday +#endif + + if( has_monthly_data ) then +!----------------------------------------------------------------------- +! Time interpolation for cases with monthly input data +!----------------------------------------------------------------------- + if( .not. qbo_cyclic ) then + new_interval = cday > cdayp + else + cday = mod( cday,qbo_days ) + cdayl = mod( cdayl,qbo_days ) + if( cday > cdayl ) then + new_interval = cday > cdayp + else + new_interval = .true. + end if + end if +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: cday = ', cday +#endif +!----------------------------------------------------------------------- +! If model time is past current forward timeslice, then switch to next one. +! If qbo_cyclic = .true. interpolation between end and beginning of data (np == 1). +! Note that np is never 1 when qbo_cyclic is .false. +!----------------------------------------------------------------------- +next_interval : & + if( new_interval ) then + +!----------------------------------------------------------------------- +! Increment index of future time sample +!----------------------------------------------------------------------- + if( qbo_cyclic ) then + np1 = mod( np,qbo_mons ) + 1 + else + np1 = np + 1 + end if + if( np1 > timesiz ) then + call endrun ('QBO_TIMESTEP_INIT: Attempt to go past end of QBO data') + end if +!----------------------------------------------------------------------- +! Set indexes into u table +!----------------------------------------------------------------------- + nm = np + np = np1 +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: nm,np = ', nm,np + write(iulog,*) 'qbo_timestep_init: date_qbo(np), secd_qbo(np) = ', date_qbo(np), secd_qbo(np) +#endif + +!----------------------------------------------------------------------- +! Set past and future days for data, generate day for cyclic data +!----------------------------------------------------------------------- + cdaym = cdayp + if( qbo_cyclic ) then + cdayp = np * qbo_dypm + else + call bnddyi( date_qbo(np), secd_qbo(np), cdayp ) + yr = date_qbo(np)/10000 + cdayp = cdayp + yr*365._r8 + end if +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: cdaym,cdayp = ', cdaym,cdayp +#endif + if( np /= 1 .and. cday > cdayp ) then + write(iulog,*) 'qbo_timestep_init: Input qbo for date',date_qbo(np),' sec ',secd_qbo(np), & + 'does not exceed model date',ncdate,' sec ',ncsec,' Stopping.' + call endrun + end if + end if next_interval + +!----------------------------------------------------------------------- +! Determine time interpolation factors. Account for December-January +! interpolation if dataset is being cycled. +!----------------------------------------------------------------------- + if( qbo_cyclic .and. np == 1 ) then ! Dec-Jan interpolation + deltat = cdayp + qbo_days - cdaym + if (cday > cdayp) then ! We are in December + fact1 = (cdayp + qbo_days - cday)/deltat + fact2 = (cday - cdaym)/deltat + else ! We are in January + fact1 = (cdayp - cday)/deltat + fact2 = (cday + qbo_days - cdaym)/deltat + end if + else + deltat = cdayp - cdaym + fact1 = (cdayp - cday )/deltat + fact2 = (cday - cdaym)/deltat + end if +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: fact1,fact2 = ', fact1, fact2 +#endif + +!----------------------------------------------------------------------- +! Time interpolation +!----------------------------------------------------------------------- + do k = ktop, kbot + u_tstep(k) = u_qbo(k,nm)*fact1 + u_qbo(k,np)*fact2 + end do + if( ktop > 1 ) then + u_tstep(ktop-1) = u_tstep(ktop) + end if + if( kbot < pver ) then + u_tstep(kbot+1) = u_tstep(kbot) + end if + + else + +!----------------------------------------------------------------------- +! Wind at this timestep for fft input data +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Set past and future days for data, generate winds for current day from fft data +!----------------------------------------------------------------------- + + do k = ktop, kbot + u_tstep(k) = ubar_qbo(k) + end do + do n=1,coefsiz + ccc = cos(ffreq_qbo(n)*(cday-cday_ref)) + sss = sin(ffreq_qbo(n)*(cday-cday_ref)) + do k = ktop, kbot + u_tstep(k) = u_tstep(k) + fcos_qbo(k,n)*ccc + fsin_qbo(k,n)*sss + end do + end do + if( ktop > 1 ) then + u_tstep(ktop-1) = u_tstep(ktop) + end if + if( kbot < pver ) then + u_tstep(kbot+1) = u_tstep(kbot) + end if + end if + +#ifdef QBO_DIAGS + write(iulog,*) 'qbo_timestep_init: u_tstep ', u_tstep(ktop:kbot) +#endif + + end if has_qbo_forcing + + end subroutine qbo_timestep_init + +!================================================================================================ + + subroutine qbo_relax( state, pbuf, ptend ) + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use cam_history, only: outfld +!------------------------------------------------------------------------ +! relax zonal mean wind towards qbo sequence +!------------------------------------------------------------------------ + +!-------------------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies + +!-------------------------------------------------------------------------------- +! Local variables +!-------------------------------------------------------------------------------- + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i, k ! loop indices + integer :: kl, ku ! loop indices + + real(r8) :: tauxi(pcols) ! latitudes in radians for present chunk + real(r8) :: tauzz + real(r8) :: u + real(r8) :: rlat ! latitudes in radians for present chunk + real(r8) :: crelax ! relaxation constant + + real(r8), parameter :: tconst = 10._r8 ! relaxation time constant in days + real(r8), parameter :: tconst1 = tconst * 86400._r8 + real(r8) :: qbo_u0(pcols,pver) ! QBO wind used for driving parameterization + + ! Zonal mean zonal wind from pbuf. + real(r8), pointer :: uzm(:,:) + + lchnk = state%lchnk + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, 'qbo', lu=.true.) + +has_qbo_forcing : & + if( qbo_use_forcing ) then + + call pbuf_get_field(pbuf, uzm_idx, uzm) + + kl = max( 1,ktop-1 ) + ku = min( pver,kbot+1 ) +!-------------------------------------------------------------------------------- +! get latitude in radians for present chunk +!-------------------------------------------------------------------------------- + do i = 1,ncol + rlat = get_rlat_p( lchnk, i ) + tauxi(i) = tconst1*taux( rlat ) + end do + + qbo_u0(:,:) = 0._r8 + + do k = kl,ku + tauzz = tauz(k) + u = u_tstep(k) + do i = 1,ncol +!-------------------------------------------------------------------------------- +! determine relaxation constant +!-------------------------------------------------------------------------------- + crelax = tauxi(i)*tauzz + if( crelax /= 0._r8 ) then + crelax = 1._r8 / crelax +!-------------------------------------------------------------------------------- +! do relaxation of zonal mean wind +!-------------------------------------------------------------------------------- + + if(u < 50.0_r8) then + ptend%u(i,k) = crelax * (u - uzm(i,k)) + end if + end if +!-------------------------------------------------------------------------------- +! variable representing QBO wind +!-------------------------------------------------------------------------------- + if((u < 50.0_r8) .and. (crelax /= 0._r8)) then + qbo_u0(i,k) = u/tauzz/tauxi(i)*tconst1 + end if + end do + end do + +!-------------------------------------------------------------------------------- +!output tendency of relaxation to monthly ('h1') output file +!-------------------------------------------------------------------------------- + call outfld( 'QBOTEND', ptend%u(:,:), pcols, lchnk ) + +!-------------------------------------------------------------------------------- +!output specified QBO wind to h0 output file +!-------------------------------------------------------------------------------- + call outfld( 'QBO_U0', qbo_u0, pcols, lchnk ) + end if has_qbo_forcing + + end subroutine qbo_relax + +!================================================================================================ + + function taux( rlat ) +!------------------------------------------------------------------------ +! calculates relaxation constant in latitude +!------------------------------------------------------------------------ + +!------------------------------------------------------------------------ +! ... dummy arguments +!------------------------------------------------------------------------ + real(r8), intent(in) :: rlat ! latitude in radians for present chunk + +!------------------------------------------------------------------------ +! ... local variables +!------------------------------------------------------------------------ + real(r8), parameter :: factor = 1._r8/(2._r8*0.174532925_r8*0.174532925_r8) + real(r8) :: alat ! abs rlat + +!------------------------------------------------------------------------ +! ... function declaration +!------------------------------------------------------------------------ + real(r8) :: taux ! relaxation constant in latitude + + + alat = abs( rlat ) + if( alat <= .035_r8 ) then +!------------------------------------------------------------------------ +! rlat=0.035 (latitude in radians): rlat*180/pi=2 degrees, around equator full relaxation +!------------------------------------------------------------------------ + taux = 1._r8 + else if( alat <= .384_r8) then +!------------------------------------------------------------------------ +! from 6 to 22 degrees latitude weakening of relaxation with Gaussian distribution +! half width=10° => in radians: 0.174532925 +!------------------------------------------------------------------------ + taux = exp( rlat*rlat*factor ) + else +!------------------------------------------------------------------------ +! other latitudes no relaxation +!------------------------------------------------------------------------ + taux = 0._r8 + end if + + end function taux + +end module qbo diff --git a/src/physics/waccm/radheat.F90 b/src/physics/waccm/radheat.F90 new file mode 100644 index 0000000000..5aa4ddfc83 --- /dev/null +++ b/src/physics/waccm/radheat.F90 @@ -0,0 +1,424 @@ + +module radheat +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +! Change weighting function for RRTMG: A J Conley +!----------------------------------------------------------------------- + +! Use a cubic polynomial over the domain from minimum pressure to maximum pressure +! Cubic polynomial is chosen so that derivative is zero at minimum and maximum pressures +! and is monotonically increasing from zero at minimum pressure to one at maximum pressure + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physconst, only: gravit, cpairv + use perf_mod + use cam_logfile, only: iulog + + implicit none + private + save + +! Public interfaces + public & + radheat_readnl, &! + radheat_init, &! + radheat_timestep_init, &! + radheat_tend ! return net radiative heating + + public :: radheat_disable_waccm ! disable waccm heating in the upper atm + +! Namelist variables + logical :: nlte_use_mo = .true. ! Determines which constituents are used from NLTE calculations + ! = .true. uses prognostic constituents + ! = .false. uses constituents from prescribed dataset waccm_forcing_file + logical :: nlte_limit_co2 = .false. ! if true apply upper limit to co2 in the Formichev scheme + +! Private variables for merging heating rates + real(r8):: qrs_wt(pver) ! merge weight for cam solar heating + real(r8):: qrl_wt(pver) ! merge weight for cam long wave heating + + logical :: waccm_heating + logical :: waccm_heating_on = .true. + + ! sw merge region + ! highest altitude (lowest pressure) of merge region (Pa) + real(r8) :: min_pressure_sw= 5._r8 + ! lowest altitude (lowest pressure) of merge region (Pa) + real(r8) :: max_pressure_sw=50._r8 + real(r8) :: delta_merge_sw ! range of merge region + real(r8) :: midpoint_sw ! midpoint of merge region + + ! lw merge region + ! highest altitude (lowest pressure) of merge region (Pa) + real(r8) :: min_pressure_lw= 5._r8 + ! lowest altitude (highest pressure) of merge region (Pa) + real(r8) :: max_pressure_lw=50._r8 + real(r8) :: delta_merge_lw ! range of merge region + real(r8) :: midpoint_lw ! midpoint of merge region + + integer :: ntop_qrs_cam ! top level for pure cam solar heating + +!=============================================================================== +contains +!=============================================================================== + + subroutine radheat_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cam_abortutils, only: endrun + use spmd_utils, only : mpicom, masterprocid, mpi_logical + + use waccm_forcing, only: waccm_forcing_readnl + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'radheat_readnl' + + namelist /radheat_nl/ nlte_use_mo, nlte_limit_co2 + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'radheat_nl', status=ierr) + if (ierr == 0) then + read(unitn, radheat_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + + call mpi_bcast (nlte_use_mo, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (nlte_limit_co2, 1, mpi_logical, masterprocid, mpicom, ierr) + + ! Have waccm_forcing read its namelist as well. + call waccm_forcing_readnl(nlfile) + + end subroutine radheat_readnl + +!================================================================================================ + + subroutine radheat_init(pref_mid) + + use nlte_lw, only: nlte_init + use cam_history, only: add_default, addfld + use phys_control, only: phys_getopts + + ! args + + real(r8), intent(in) :: pref_mid(pver) ! mid point reference pressure + + ! local vars + + real(r8) :: psh(pver) ! pressure scale height + integer :: k + logical :: camrt + + character(len=16) :: rad_pkg + logical :: history_scwaccm_forcing + logical :: history_waccm + +!----------------------------------------------------------------------- + + + call phys_getopts(radiation_scheme_out=rad_pkg, & + history_waccm_out=history_waccm, & + history_scwaccm_forcing_out=history_scwaccm_forcing) + camrt = rad_pkg == 'CAMRT' .or. rad_pkg == 'camrt' + + ! set max/min pressures for merging regions. + + if (camrt) then + min_pressure_sw = 1e5_r8*exp(-10._r8) + max_pressure_sw = 1e5_r8*exp(-9._r8) + min_pressure_lw = 1e5_r8*exp(-10._r8) + max_pressure_lw = 1e5_r8*exp(-8.57_r8) + else + min_pressure_sw = 5._r8 + max_pressure_sw = 50._r8 + min_pressure_lw = 5._r8 + max_pressure_lw = 50._r8 + endif + + delta_merge_sw = max_pressure_sw - min_pressure_sw + delta_merge_lw = max_pressure_lw - min_pressure_lw + + midpoint_sw = (max_pressure_sw + min_pressure_sw)/2._r8 + midpoint_lw = (max_pressure_lw + min_pressure_lw)/2._r8 + + do k=1,pver + + ! pressure scale heights for camrt merging (waccm4) + psh(k)=log(1e5_r8/pref_mid(k)) + + if ( pref_mid(k) .le. min_pressure_sw ) then + qrs_wt(k) = 0._r8 + else if( pref_mid(k) .ge. max_pressure_sw) then + qrs_wt(k) = 1._r8 + else + if (camrt) then + ! camrt + qrs_wt(k) = 1._r8 - tanh( (psh(k) - 9._r8)/.75_r8 ) + else + ! rrtmg + qrs_wt(k) = 0.5_r8 + 1.5_r8*((pref_mid(k)-midpoint_sw)/delta_merge_sw) & + - 2._r8*((pref_mid(k)-midpoint_sw)/delta_merge_sw)**3._r8 + endif + endif + + if ( pref_mid(k) .le. min_pressure_lw ) then + qrl_wt(k)= 0._r8 + else if( pref_mid(k) .ge. max_pressure_lw) then + qrl_wt(k)= 1._r8 + else + if (camrt) then + ! camrt + qrl_wt(k) = 1._r8 - tanh( (psh(k) - 8.57_r8) / 0.71_r8 ) + else + ! rrtmg + qrl_wt(k) = 0.5_r8 + 1.5_r8*((pref_mid(k)-midpoint_lw)/delta_merge_lw) & + - 2._r8*((pref_mid(k)-midpoint_lw)/delta_merge_lw)**3._r8 + endif + endif + + end do + + ! determine upppermost level that is purely solar heating (no MLT chem heationg) + ntop_qrs_cam = 0 + do k=pver,1,-1 + if (qrs_wt(k)==1._r8) ntop_qrs_cam = k + enddo + + if (masterproc) then + write(iulog,*) 'RADHEAT_INIT: pref_mid', pref_mid(:) + write(iulog,*) 'RADHEAT_INIT: QRS_WT ', qrs_wt(:) + write(iulog,*) 'RADHEAT_INIT: QRL_WT ', qrl_wt(:) + end if + + ! WACCM heating if top-most layer is above merge region + waccm_heating = (pref_mid(1) .le. min_pressure_sw) + + if (masterproc) then + write(iulog,*) 'WACCM Heating is computed (true/false): ',waccm_heating + end if + + if (waccm_heating) then + call nlte_init(pref_mid, nlte_use_mo, nlte_limit_co2) + endif + +! Add history variables to master field list + call addfld ('QRL_TOT',(/ 'lev' /), 'A','K/s','Merged LW heating: QRL+QRLNLTE') + call addfld ('QRS_TOT',(/ 'lev' /), 'A','K/s','Merged SW heating: QRS+QCP+QRS_EUV+QRS_CO2NIR+QRS_AUR+QTHERMAL') + + call addfld ('QRS_TOT_24_COS',(/ 'lev' /), 'A','K/s','SW heating 24hr. cos coeff.') + call addfld ('QRS_TOT_24_SIN',(/ 'lev' /), 'A','K/s','SW heating 24hr. sin coeff.') + call addfld ('QRS_TOT_12_COS',(/ 'lev' /), 'A','K/s','SW heating 12hr. cos coeff.') + call addfld ('QRS_TOT_12_SIN',(/ 'lev' /), 'A','K/s','SW heating 12hr. sin coeff.') + call addfld ('QRS_TOT_08_COS',(/ 'lev' /), 'A','K/s','SW heating 8hr. cos coeff.') + call addfld ('QRS_TOT_08_SIN',(/ 'lev' /), 'A','K/s','SW heating 8hr. sin coeff.') + +! Add default history variables to files + if (history_waccm) then + call add_default ('QRL_TOT', 1, ' ') + call add_default ('QRS_TOT', 1, ' ') + end if + if (history_scwaccm_forcing) then + call add_default ('QRS_TOT', 8, ' ') + end if + + end subroutine radheat_init + +!================================================================================================ + + subroutine radheat_timestep_init (state, pbuf2d) + + use nlte_lw, only: nlte_timestep_init + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use physics_buffer, only : physics_buffer_desc + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + if (waccm_heating) then + call nlte_timestep_init (state, pbuf2d) + endif + + end subroutine radheat_timestep_init + +!================================================================================================ + + subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, asdir, net_flx) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +! +! This routine provides the waccm hook for computing nonLTE cooling and +! eUV heating. +!----------------------------------------------------------------------- + + use cam_history, only: outfld + use nlte_lw, only: nlte_tend + use mo_waccm_hrates, only: waccm_hrates, has_hrates + use waccm_forcing, only: get_solar + + use physics_buffer, only : physics_buffer_desc + use tidal_diag, only: get_tidal_coeffs + +! Arguments + type(physics_state), intent(in) :: state ! Physics state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencie + real(r8), intent(in) :: qrl(pcols,pver) ! longwave heating + real(r8), intent(in) :: qrs(pcols,pver) ! shortwave heating + real(r8), intent(in) :: fsns(pcols) ! Surface solar absorbed flux + real(r8), intent(in) :: fsnt(pcols) ! Net column abs solar flux at model top + real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux + real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top + real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo + real(r8), intent(out) :: net_flx(pcols) + +! Local variables + integer :: i, k + integer :: ncol ! number of atmospheric columns + integer :: lchnk ! chunk identifier + real(r8) :: qrl_mrg(pcols,pver) ! merged LW heating + real(r8) :: qrl_mlt(pcols,pver) ! M/LT longwave heating rates + real(r8) :: qrs_mrg(pcols,pver) ! merged SW heating + real(r8) :: qrs_mlt(pcols,pver) ! M/LT solar heating rates + real(r8) :: qout(pcols,pver) ! temp for outfld call + real(r8) :: dcoef(6) ! for tidal component of heating + +!----------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + call physics_ptend_init(ptend, state%psetcols, 'radheat', ls=.true.) + +! WACCM interactive heating rate + if (waccm_heating.and.waccm_heating_on) then + call t_startf( 'hrates' ) + if (has_hrates) then + call waccm_hrates(ncol, state, asdir, ntop_qrs_cam-1, qrs_mlt, pbuf) + else + call get_solar(ncol, lchnk, qrs_mlt) + endif + call t_stopf( 'hrates' ) + else + qrs_mlt(:,:) = 0._r8 + endif + +! Merge cam solar heating for lower atmosphere with M/LT heating + call merge_qrs (ncol, qrs, qrs_mlt, qrs_mrg, cpairv(:,:,lchnk)) + qout(:ncol,:) = qrs_mrg(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QRS_TOT', qout, pcols, lchnk) + +! Output tidal coefficients of total SW heating + call get_tidal_coeffs( dcoef ) + call outfld( 'QRS_TOT_24_SIN', qout(:ncol,:)*dcoef(1), ncol, lchnk ) + call outfld( 'QRS_TOT_24_COS', qout(:ncol,:)*dcoef(2), ncol, lchnk ) + call outfld( 'QRS_TOT_12_SIN', qout(:ncol,:)*dcoef(3), ncol, lchnk ) + call outfld( 'QRS_TOT_12_COS', qout(:ncol,:)*dcoef(4), ncol, lchnk ) + call outfld( 'QRS_TOT_08_SIN', qout(:ncol,:)*dcoef(5), ncol, lchnk ) + call outfld( 'QRS_TOT_08_COS', qout(:ncol,:)*dcoef(6), ncol, lchnk ) + + if (waccm_heating.and.waccm_heating_on) then + call t_startf( 'nltedrv' ) + call nlte_tend(state, pbuf, qrl_mlt) + call t_stopf( 'nltedrv' ) + else + qrl_mlt(:,:) = 0._r8 + endif + +! Merge cam long wave heating for lower atmosphere with M/LT (nlte) heating + call merge_qrl (ncol, qrl, qrl_mlt, qrl_mrg) + qout(:ncol,:) = qrl_mrg(:ncol,:)/cpairv(:ncol,:,lchnk) + call outfld ('QRL_TOT', qout, pcols, lchnk) + + ptend%s(:ncol,:) = qrs_mrg(:ncol,:) + qrl_mrg(:ncol,:) + + net_flx = 0._r8 + do k = 1, pver + do i = 1, ncol + net_flx(i) = net_flx(i) + ptend%s(i,k)*state%pdel(i,k)/gravit + end do + end do + + end subroutine radheat_tend + +!================================================================================================ + subroutine radheat_disable_waccm() + waccm_heating_on = .false. + end subroutine radheat_disable_waccm +!================================================================================================ + + subroutine merge_qrs (ncol, hcam, hmlt, hmrg, cpair) +! +! Merges short wave heating rates +! + implicit none + +!-----------------Input arguments----------------------------------- + integer ncol + + real(r8), intent(in) :: hmlt(pcols,pver) ! Upper atmosphere heating rates + real(r8), intent(in) :: hcam(pcols,pver) ! CAM heating rate + real(r8), intent(out) :: hmrg(pcols,pver) ! merged heating rates + real(r8), intent(in) :: cpair(pcols,pver) ! Specific heat of dry air + +!-----------------Local workspace------------------------------------ + + integer k + + do k = 1, pver + hmrg(:ncol,k) = qrs_wt(k)*hcam(:ncol,k) + (1._r8 - qrs_wt(k))*cpair(:ncol,k)*hmlt(:ncol,k) + end do + + end subroutine merge_qrs + +!================================================================================================== + + subroutine merge_qrl (ncol, hcam, hmlt, hmrg) +! +! Merges long wave heating rates +! +!-----------------Input arguments----------------------------------- + integer ncol + + real(r8), intent(in) :: hmlt(pcols,pver) ! Upper atmosphere heating rates + real(r8), intent(in) :: hcam(pcols,pver) ! CAM heating rate + real(r8), intent(out) :: hmrg(pcols,pver) ! merged heating rates + +!-----------------Local workspace------------------------------------ + + integer k + +!-------------------------------------------------------------------- + + do k = 1, pver + hmrg(:ncol,k) = qrl_wt(k) * hcam(:ncol,k) + (1._r8-qrl_wt(k)) * hmlt(:ncol,k) + end do + + end subroutine merge_qrl + +end module radheat diff --git a/src/physics/waccm/waccm_forcing.F90 b/src/physics/waccm/waccm_forcing.F90 new file mode 100644 index 0000000000..f4251f29a8 --- /dev/null +++ b/src/physics/waccm/waccm_forcing.F90 @@ -0,0 +1,288 @@ +module waccm_forcing +!================================================================================================ +! +! Provides WACCM forcing data for use without interactive chemistry +! -- for GHG chemistry +! +! FVITT 21 Mar 2011 -- creation +! +!================================================================================================ + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + + use tracer_data, only : trfld, trfile + use ppgrid, only : pcols, pver + use ppgrid, only : begchunk, endchunk + use spmd_utils, only : masterproc + + implicit none + private + save + +! Public interfaces + public :: waccm_forcing_init + public :: waccm_forcing_adv + public :: get_cnst ! return prescribed constituents for nlte + public :: get_solar ! return prescribed net solar heating rate + public :: waccm_forcing_readnl + +! Private module data + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + integer, parameter :: N_FLDS = 7 + integer, parameter :: N_MMRS = 6 + + character(len=256) :: filename = '' + character(len=256) :: filelist = '' + character(len=256) :: datapath = '' + character(len=32) :: datatype = 'CYCLICAL' + logical :: rmv_file = .false. + + integer :: cycle_yr = 0 + integer :: fixed_ymd = 0 + integer :: fixed_tod = 0 + + integer :: o1_ndx=1, o2_ndx=2, o3_ndx=3, no_ndx=4, h_ndx=5, co2_ndx=6, qrs_ndx=7 + character(len=16) :: specifier(N_FLDS) = (/ 'O ','O2 ','O3 ', 'NO ', 'H ','CO2 ', 'QRS_TOT' /) + real(r8), parameter :: molmass(N_MMRS) = (/ 15.99940_r8, 31.99880_r8, 47.99820_r8, 30.00614_r8, 1.007400_r8, 44.00980_r8 /) + +!================================================================================================ +contains +!================================================================================================ + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine waccm_forcing_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'prescribed_aero_readnl' + + character(len=16) :: waccm_forcing_specifier(N_FLDS) + character(len=256) :: waccm_forcing_file + character(len=256) :: waccm_forcing_filelist + character(len=256) :: waccm_forcing_datapath + character(len=32) :: waccm_forcing_type + logical :: waccm_forcing_rmfile + integer :: waccm_forcing_cycle_yr + integer :: waccm_forcing_fixed_ymd + integer :: waccm_forcing_fixed_tod + + namelist /waccm_forcing_nl/ & + waccm_forcing_specifier, & + waccm_forcing_file, & + waccm_forcing_filelist, & + waccm_forcing_datapath, & + waccm_forcing_type, & + waccm_forcing_rmfile, & + waccm_forcing_cycle_yr, & + waccm_forcing_fixed_ymd, & + waccm_forcing_fixed_tod + !----------------------------------------------------------------------------- + + ! Initialize namelist variables from local module variables. + waccm_forcing_specifier= specifier + waccm_forcing_file = filename + waccm_forcing_filelist = filelist + waccm_forcing_datapath = datapath + waccm_forcing_type = datatype + waccm_forcing_rmfile = rmv_file + waccm_forcing_cycle_yr = cycle_yr + waccm_forcing_fixed_ymd= fixed_ymd + waccm_forcing_fixed_tod= fixed_tod + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'waccm_forcing_nl', status=ierr) + if (ierr == 0) then + read(unitn, waccm_forcing_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(waccm_forcing_specifier,len(waccm_forcing_specifier(1))*N_FLDS, mpichar, 0, mpicom) + call mpibcast(waccm_forcing_file, len(waccm_forcing_file), mpichar, 0, mpicom) + call mpibcast(waccm_forcing_filelist, len(waccm_forcing_filelist), mpichar, 0, mpicom) + call mpibcast(waccm_forcing_datapath, len(waccm_forcing_datapath), mpichar, 0, mpicom) + call mpibcast(waccm_forcing_type, len(waccm_forcing_type), mpichar, 0, mpicom) + call mpibcast(waccm_forcing_rmfile, 1, mpilog, 0, mpicom) + call mpibcast(waccm_forcing_cycle_yr, 1, mpiint, 0, mpicom) + call mpibcast(waccm_forcing_fixed_ymd,1, mpiint, 0, mpicom) + call mpibcast(waccm_forcing_fixed_tod,1, mpiint, 0, mpicom) +#endif + + ! Update module variables with user settings. + specifier = waccm_forcing_specifier + filename = waccm_forcing_file + filelist = waccm_forcing_filelist + datapath = waccm_forcing_datapath + datatype = waccm_forcing_type + rmv_file = waccm_forcing_rmfile + cycle_yr = waccm_forcing_cycle_yr + fixed_ymd = waccm_forcing_fixed_ymd + fixed_tod = waccm_forcing_fixed_tod + + end subroutine waccm_forcing_readnl + + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + subroutine waccm_forcing_init() + + use tracer_data, only : trcdata_init + use cam_history, only : addfld + + implicit none + + integer :: i + + + allocate(file%in_pbuf(size(specifier))) + file%in_pbuf(:) = .false. + call trcdata_init( specifier, filename, filelist, datapath, fields, file, & + rmv_file, cycle_yr, fixed_ymd, fixed_tod, datatype) + + do i = 1,N_FLDS + call addfld( 'WFRC_'//trim(fields(i)%fldnam), (/ 'lev' /), 'I', fields(i)%units, 'for waccm forcing' ) + enddo + + return + end subroutine waccm_forcing_init + +!======================================================================= + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ + subroutine waccm_forcing_adv (state, pbuf2d) + + use tracer_data, only : advance_trcdata + use physics_types,only : physics_state + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz ! J/K/molecule + use physics_buffer, only : physics_buffer_desc + + implicit none + + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + integer :: c,ncol,i + real(r8) :: to_mmr(pcols,pver) + + call advance_trcdata( fields, file, state, pbuf2d ) + + ! set the tracer fields with the correct units + do i = 1,N_FLDS + + do c = begchunk,endchunk + ncol = state(c)%ncol + + if ( i<=N_MMRS ) then + + select case ( to_lower(trim(fields(i)%units(:GLC(fields(i)%units)))) ) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + to_mmr(:ncol,:) = (molmass(i)*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) + case ('kg/kg','mmr') + to_mmr(:ncol,:) = 1._r8 + case ('mol/mol','mole/mole','vmr','fraction') + to_mmr(:ncol,:) = molmass(i)/mwdry + case default + print*, 'waccm_forcing_adv: units = ',trim(fields(i)%units) ,' are not recognized' + call endrun('waccm_forcing_adv: units are not recognized') + end select + + call outfld( 'WFRC_'//trim(fields(i)%fldnam), fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk ) + + fields(i)%data(:ncol,:,c) = to_mmr(:ncol,:) * fields(i)%data(:ncol,:,c) + else + call outfld( 'WFRC_'//trim(fields(i)%fldnam), fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk ) + endif + + enddo + enddo + + return + end subroutine waccm_forcing_adv + + +!================================================================================================ + + subroutine get_cnst (lchnk, co2, o1, o2, no, h, o3) +! +! Get mass mixing ratios specified from input dataset for used in Fomichev routines +!------------------------------------------------------------------------- + +! Arguments + integer, intent(in) :: lchnk ! chunk identifier + + real(r8), optional, pointer, dimension(:,:) :: co2 + real(r8), optional, pointer, dimension(:,:) :: o1 + real(r8), optional, pointer, dimension(:,:) :: o2 + real(r8), optional, pointer, dimension(:,:) :: no + real(r8), optional, pointer, dimension(:,:) :: h + real(r8), optional, pointer, dimension(:,:) :: o3 + +!------------------------------------------------------------------------ + + if (present(co2)) then + co2 => fields(co2_ndx)%data(:,:,lchnk) + endif + if (present(o1)) then + o1 => fields(o1_ndx )%data(:,:,lchnk) + endif + if (present(o2)) then + o2 => fields(o2_ndx )%data(:,:,lchnk) + endif + if (present(no)) then + no => fields(no_ndx )%data(:,:,lchnk) + endif + if (present(h)) then + h => fields(h_ndx )%data(:,:,lchnk) + endif + if (present(o3)) then + o3 => fields(o3_ndx)%data(:,:,lchnk) + endif + + end subroutine get_cnst + +!================================================================================================ + + subroutine get_solar (ncol, lchnk, qrs_mlt) +! +! Get M/LT solar heating rates specified from input dataset +!------------------------------------------------------------------------- + +! Arguments + integer, intent(in) :: ncol ! no. of columns in chunk + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(out) :: qrs_mlt(:,:) ! M/LT solar heating rates + +! Local workspace + integer :: k + +!------------------------------------------------------------------------ + + qrs_mlt(:ncol,:) = fields(qrs_ndx)%data(:ncol,:,lchnk) + + end subroutine get_solar + +end module waccm_forcing diff --git a/src/physics/waccm/wei05sc.F90 b/src/physics/waccm/wei05sc.F90 new file mode 100644 index 0000000000..b65016e5a3 --- /dev/null +++ b/src/physics/waccm/wei05sc.F90 @@ -0,0 +1,10 @@ +module wei05sc +! Stub version + + use shr_kind_mod ,only: r8 => shr_kind_r8 + + implicit none + + real(r8),parameter :: ctpoten_weimer = huge(1.0_r8) + +end module wei05sc diff --git a/src/physics/waccm/wei96.F90 b/src/physics/waccm/wei96.F90 new file mode 100644 index 0000000000..05246ab90d --- /dev/null +++ b/src/physics/waccm/wei96.F90 @@ -0,0 +1,1059 @@ +module wei96 + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use cam_abortutils,only: endrun + + implicit none + private + public :: gecmp, ReadCoef, EpotVal, adjust, get_tilt, SetModel + + real(r8) :: alamn, alamx, alamr, stpd, stp2, cstp, sstp + INTEGER ML,MM + REAL(r8) Coef(0:1,0:8,0:3),pi + INTEGER MaxL,MaxM,MaxN + REAL(r8) Cn( 0:3 , 0:1 , 0:4 , 0:1 , 0:8 , 0:3 ) + real(r8) cx(9), st(6), ct(6), am(3,3,11) + +contains + +! +! Purpose: +! Subroutines to calculate the electric potentials from the Weimer '96 model of +! the polar cap ionospheric electric potentials. +! +! Method: +! +! To use, first call subroutine ReadCoef once. +! Next, call SetModel with the specified input parameters. +! The function EpotVal(gLAT,gMLT) can then be used repeatively to get the +! electric potential at the desired location in geomagnetic coordinates. +! Subroutines to calculate the electric potentials from the Weimer '96 model of +! the polar cap ionospheric electric potentials. +! +! +! Author: A. Maute Dec 2003 +! This code is protected by copyright and is +! distributed for research or educational use only. +! Commerical use without written permission from Dan Weimer/MRC is prohibited. +! +!*********************** Copyright 1996, Dan Weimer/MRC *********************** +!================================================================================================ + + real(r8) FUNCTION EpotVal(gLAT,gMLT) +! +!----------------------------------------------------------------------- +! Return the value of the electric potential in kV at +! corrected geomagnetic coordinates gLAT (degrees) and gMLT (hours). +! +! Must first call ReadCoef and SetModel to set up the model coeficients for +! the desired values of Bt, IMF clock angle, Dipole tilt angle, and SW Vel. +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(in) :: gLAT,gMLT +! +!---------------------------Local variables----------------------------- +! + integer limit,l,m + + Real(r8) Theta,Phi,Z,ct,Phim + real(r8) r + REAL(r8) Plm(0:20,0:20) +! +!----------------------------------------------------------------------- +! + r=90._r8-gLAT + IF(r .LT. 45._r8)THEN + Theta=r*pi/45._r8 + Phi=gMLT*pi/12._r8 + Z=Coef(0,0,0) + ct=COS(Theta) + CALL Legendre(ct,ML,MM,Plm) + DO l=1,ML + Z=Z + Coef(0,l,0)*Plm(l,0) + IF(l.LT.MM)THEN + limit=l + ELSE + limit=MM + ENDIF + DO m=1,limit + phim=phi*m + Z=Z + Coef(0,l,m)*Plm(l,m)*COS(phim) + & + Coef(1,l,m)*Plm(l,m)*SIN(phim) + ENDDO + ENDDO + ELSE + Z=0._r8 + ENDIF + EpotVal=Z + RETURN + END FUNCTION EpotVal + +!================================================================================================ + + SUBROUTINE ReadCoef (wei96_file) +! +!----------------------------------------------------------------------- +! +! Read in the data file with the model coefficients +! +!*********************** Copyright 1996, Dan Weimer/MRC *********************** +! +! NCAR addition (Jan 97): initialize constants used in GECMP +!----------------------------------------------------------------------- +! + use ioFileMod, only : getfil + use units, only : getunit, freeunit + +! +! ALAMN = Absolute min latitude (deg) of model +! ALAMX = Absolute max latitude (deg) for normal gradient calc. +! STPD = Angular dist (deg) of step @ 300km above earth (r=6371km) +! STP2 = Denominator in gradient calc + +! +!------------------------------Arguments-------------------------------- +! + character(len=*), intent(in) :: wei96_file +! +!-----------------------------Parameters------------------------------ +! + real(r8) d2r, r2d + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) +! +!---------------------------Local variables----------------------------- +! + INTEGER unit,ios + integer ll, mm, k, m, klimit, kk, nn, ii, i, n, ilimit, mlimit, l + + REAL(r8) C(0:3) + real(r8) stpr, step + + character(len=256) :: locfn + logical, parameter :: debug = .false. +! +!----------------------------------------------------------------------- +! + STEP = 10._r8 + STPR = STEP/6671._r8 + STPD = STPR*R2D + STP2 = 2._r8*STEP + CSTP = COS (STPR) + SSTP = SQRT (1._r8 - CSTP*CSTP) + ALAMN = 45._r8 + ALAMX = 90._r8 - STPD + ALAMR = ALAMN*D2R +! End NCAR addition +! +! get coeff_file + unit= getunit() + if (debug) write(iulog,*) 'Weimer: getting file ',trim(wei96_file),' unit ',unit + call getfil( wei96_file, locfn, 0 ) +! + if (debug) write(iulog,*) 'Weimer: opening file ',trim(locfn),' unit ',unit + OPEN(unit=unit,file=trim(locfn), & + status = 'old',iostat = ios) + if(ios.gt.0) then + write(iulog,*) 'Weimer: error in opening wei96.cofcnts',' unit ',unit + call endrun + endif + + 900 FORMAT(A15) + 1000 FORMAT(3I8) + 2000 FORMAT(3I2) + 3000 FORMAT(2I2,4E15.6) + + if (debug) write(iulog,*) 'Weimer: reading file ',trim(locfn),' unit ',unit + READ(unit,1000,iostat = ios) MaxL,MaxM,MaxN + if(ios.gt.0) then + write(iulog,*) 'ReadCoef: error in reading wei96.cofcnts file',' unit ',unit + call endrun + endif + DO l=0,MaxL + IF(l.LT.MaxM)THEN + mlimit=l + ELSE + mlimit=MaxM + ENDIF + DO m=0,mlimit + IF(m.LT.1)THEN + klimit=0 + ELSE + klimit=1 + ENDIF + DO k=0,klimit + READ(unit,2000,iostat = ios) ll,mm,kk + if(ios.gt.0) then + write(iulog,*) 'ReadCoef: error in reading wei96.cofcnts file',' unit ',unit + call endrun + endif + IF(ll.NE.l .OR. mm.NE.m .OR. kk.NE.k)THEN + WRITE(IULOG,*)'Data File Format Error' + CALL ENDRUN + ENDIF + DO n=0,MaxN + IF(n.LT.1)THEN + ilimit=0 + ELSE + ilimit=1 + ENDIF + DO i=0,ilimit + READ(unit,3000,iostat = ios) nn,ii,C + if(ios.gt.0) then + write(iulog,*) 'ReadCoef: error in reading', & + ' wei96.cofcnts file',' unit ',unit + call endrun + endif + IF(nn.NE.n .OR. ii.NE.i)THEN + WRITE(IULOG,*)'Data File Format Error' + CALL ENDRUN + ENDIF + Cn(0,i,n,k,l,m)=C(0) + Cn(1,i,n,k,l,m)=C(1) + Cn(2,i,n,k,l,m)=C(2) + Cn(3,i,n,k,l,m)=C(3) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO +! + close(unit) + call freeunit(unit) +! + RETURN + END SUBROUTINE ReadCoef + +!================================================================================================ + + real(r8) FUNCTION FSVal(omega,MaxN,FSC) +! +!----------------------------------------------------------------------- +! Evaluate a Sine/Cosine Fourier series for N terms up to MaxN +! at angle omega, given the coefficients in FSC +! +!*********************** Copyright 1996, Dan Weimer/MRC *********************** +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + INTEGER, intent(in) :: MaxN + REAL(r8), intent(in) :: omega,FSC(0:1,0:*) +! +!---------------------------Local variables----------------------------- +! + INTEGER n + REAL(r8) Y,theta +! +!----------------------------------------------------------------------- +! + Y=0._r8 + DO n=0,MaxN + theta=omega*n + Y=Y + FSC(0,n)*COS(theta) + FSC(1,n)*SIN(theta) + ENDDO + FSVal=Y + RETURN + END FUNCTION FSVal + +!================================================================================================ + + SUBROUTINE SetModel(angle,Bt,Tilt,SWVel) +! +!----------------------------------------------------------------------- +! Calculate the complete set of spherical harmonic coefficients, +! given an arbitrary IMF angle (degrees from northward toward +Y), +! magnitude Bt (nT), dipole tilt angle (degrees), +! and solar wind velocity (km/sec). +! Sets the Coef +! +!*********************** Copyright 1996, Dan Weimer/MRC *********************** +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(in) :: angle,Bt,Tilt,SWVel +! +!---------------------------Local variables----------------------------- +! + integer n, k, ilimit, i, klimit, l, m, mlimit + REAL(r8) FSC(0:1,0:4), omega, sintilt +! +!----------------------------------------------------------------------- +! + pi=2._r8*ASIN(1._r8) + ML=MaxL + MM=MaxM + SinTilt=SIN(Tilt*pi/180._r8) +! SinTilt=SIND(Tilt) + + omega=angle*pi/180._r8 + + fsc(1,0) = 0._r8 + DO l=0,MaxL + IF(l.LT.MaxM)THEN + mlimit=l + ELSE + mlimit=MaxM + ENDIF + DO m=0,mlimit + IF(m.LT.1)THEN + klimit=0 + ELSE + klimit=1 + ENDIF + DO k=0,klimit +! Retrieve the regression coefficients and evaluate the function +! as a function of Bt,Tilt,and SWVel to get each Fourier coefficient. + DO n=0,MaxN + IF(n.LT.1)THEN + ilimit=0 + ELSE + ilimit=1 + ENDIF + DO i=0,ilimit + FSC(i,n)=Cn(0,i,n,k,l,m) + Bt*Cn(1,i,n,k,l,m) + & + SinTilt*Cn(2,i,n,k,l,m) + SWVel*Cn(3,i,n,k,l,m) + ENDDO + ENDDO +! Next evaluate the Fourier series as a function of angle. + Coef(k,l,m)=FSVal(omega,MaxN,FSC) + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE SetModel + +!================================================================================================ + + SUBROUTINE LEGENDRE(x,lmax,mmax,Plm) +! +!----------------------------------------------------------------------- +! compute Associate Legendre Function P_l^m(x) +! for all l up to lmax and all m up to mmax. +! returns results in array Plm +! if X is out of range ( abs(x)>1 ) then value is returned as if x=1. +! +!*********************** Copyright 1996, Dan Weimer/MRC *********************** +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + integer, intent(in) :: lmax, mmax + real(r8), intent(in) :: x + real(r8), intent(out) :: Plm(0:20,0:20) +! +!---------------------------Local variables----------------------------- +! + integer m, lm2, l + real(r8) xx, fact +! +!----------------------------------------------------------------------- +! + DO l=0,20 + DO m=0,20 + Plm(l,m)=0._r8 + ENDDO + ENDDO + xx=MIN(x,1._r8) + xx=MAX(xx,-1._r8) + IF(lmax .LT. 0 .OR. mmax .LT. 0 .OR. mmax .GT. lmax )THEN + write(iulog,*)'Bad arguments to Legendre' + RETURN + ENDIF +! First calculate all Pl0 for l=0 to l + Plm(0,0)=1._r8 + IF(lmax.GT.0)Plm(1,0)=xx + IF (lmax .GT. 1 )THEN + DO L=2,lmax + Plm(L,0)=( (2._r8*L-1)*xx*Plm(L-1,0) - (L-1)*Plm(L-2,0) )/L + ENDDO + ENDIF + IF (mmax .EQ. 0 )RETURN + fact=SQRT( (1._r8-xx)*(1._r8+xx) ) + DO M=1,mmax + DO L=m,lmax + lm2=MAX(L-2,0) + Plm(L,M)=Plm(lm2,M) - ( 2*L-1)*fact*Plm(L-1,M-1) + ENDDO + ENDDO + RETURN + END SUBROUTINE LEGENDRE + +!================================================================================================ + +!*********************** Copyright 1996, Dan Weimer/MRC *********************** + +!CC NCAR MODIFIED (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! The following routines (translib.for) were added to return the dipole tilt. C +! GET_TILT was initially a procedure (TRANS), here it has been changed into C +! a function which returns the dipole tilt. C +! Barbara Emery (emery@ncar.ucar.edu) and William Golesorkhi, HAO/NCAR (3/96) C +!CC NCAR MODIFIED (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +! COORDINATE TRANSFORMATION UTILITIES +!********************************************************************** + real(r8) FUNCTION GET_TILT(YEAR,MONTH,DAY,HOUR) +! +!----------------------------------------------------------------------- +!CC NCAR MODIFIED (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! The following line initially was: C +! SUBROUTINE TRANS(YEAR,MONTH,DAY,HOUR,IDBUG) C +! It has been changed to return the dipole tilt from this function call. C +!CC NCAR MODIFIED (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! +! THIS SUBROUTINE DERIVES THE ROTATION MATRICES AM(I,J,K) FOR 11 +! TRANSFORMATIONS, IDENTIFIED BY K. +! K=1 TRANSFORMS GSE to GEO +! K=2 " GEO to MAG +! K=3 " GSE to MAG +! K=4 " GSE to GSM +! K=5 " GEO to GSM +! K=6 " GSM to MAG +! K=7 " GSE to GEI +! K=8 " GEI to GEO +! K=9 " GSM to SM +! K=10 " GEO to SM +! K=11 " MAG to SM +! +! IF IDBUG IS NOT 0, THEN OUTPUTS DIAGNOSTIC INFORMATION TO +! FILE UNIT=IDBUG +! +! The formal names of the coordinate systems are: +! GSE - Geocentric Solar Ecliptic +! GEO - Geographic +! MAG - Geomagnetic +! GSM - Geocentric Solar Magnetospheric +! SM - Solar Magnetic +! +! THE ARRAY CX(I) ENCODES VARIOUS ANGLES, STORED IN DEGREES +! ST(I) AND CT(I) ARE SINES & COSINES. +! +! Program author: D. R. Weimer +! +! Some of this code has been copied from subroutines which had been +! obtained from D. Stern, NASA/GSFC. Other formulas are from "Space +! Physics Coordinate Transformations: A User Guide" by M. Hapgood (1991). +! +! The formulas for the calculation of Greenwich mean sidereal time (GMST) +! and the sun's location are from "Almanac for Computers 1990", +! U.S. Naval Observatory. +! +!----------------------------------------------------------------------- +! + +! +!------------------------------Arguments-------------------------------- +! + INTEGER, intent(in) :: YEAR, MONTH, DAY + REAL(r8), intent(in) :: HOUR +! +!-----------------------------Parameters------------------------------ +! + + real(r8), parameter :: th0=11.19_r8 + real(r8), parameter :: ph0=-70.76_r8 + + INTEGER GSEGEO,GEOGSE,GEOMAG,MAGGEO + INTEGER GSEMAG,MAGGSE,GSEGSM,GSMGSE + INTEGER GEOGSM,GSMGEO,GSMMAG,MAGGSM + INTEGER GSEGEI,GEIGSE,GEIGEO,GEOGEI + INTEGER GSMSM,SMGSM,GEOSM,SMGEO,MAGSM,SMMAG + + PARAMETER (GSEGEO= 1,GEOGSE=-1,GEOMAG= 2,MAGGEO=-2) + PARAMETER (GSEMAG= 3,MAGGSE=-3,GSEGSM= 4,GSMGSE=-4) + PARAMETER (GEOGSM= 5,GSMGEO=-5,GSMMAG= 6,MAGGSM=-6) + PARAMETER (GSEGEI= 7,GEIGSE=-7,GEIGEO= 8,GEOGEI=-8) + PARAMETER (GSMSM = 9,SMGSM =-9,GEOSM =10,SMGEO=-10) + PARAMETER (MAGSM =11,SMMAG =-11) +! +!---------------------------Local variables----------------------------- +! + integer IDBUG + integer j, k, jd, iyr, i, mjd + + REAL(r8) UT, T0, GMSTD, GMSTH, ECLIP, MA, LAMD, SUNLON, pi + real(r8) b32, b33, b3 +! +!----------------------------------------------------------------------- +! + pi=2._r8*ASIN(1._r8) +!CC NCAR MODIFICATION (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! IDBUG=0 to prevent printing data to the screen or writing data to a file. C + IDBUG = 0 +!CC NCAR MODIFICATION (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + IF(YEAR.LT.1900)THEN + IYR=1900+YEAR + ELSE + IYR=YEAR + ENDIF + UT=HOUR + JD=JULDAY(MONTH,DAY,IYR) + MJD=JD-2400001 + T0=(real(MJD,r8)-51544.5_r8)/36525.0_r8 + GMSTD=100.4606184_r8 + 36000.770_r8*T0 + 3.87933E-4_r8*T0*T0 + & + 15.0410686_r8*UT + CALL ADJUST(GMSTD) + GMSTH=GMSTD*24._r8/360._r8 + ECLIP=23.439_r8 - 0.013_r8*T0 + MA=357.528_r8 + 35999.050_r8*T0 + 0.041066678_r8*UT + CALL ADJUST(MA) + LAMD=280.460_r8 + 36000.772_r8*T0 + 0.041068642_r8*UT + CALL ADJUST(LAMD) + SUNLON=LAMD + (1.915_r8-0.0048_r8*T0)*SIN(MA*pi/180._r8) + 0.020_r8* & + SIN(2._r8*MA*pi/180._r8) + CALL ADJUST(SUNLON) + IF(IDBUG.NE.0)THEN + WRITE(IDBUG,*) YEAR,MONTH,DAY,HOUR + WRITE(IDBUG,*) 'MJD=',MJD + WRITE(IDBUG,*) 'T0=',T0 + WRITE(IDBUG,*) 'GMSTH=',GMSTH + WRITE(IDBUG,*) 'ECLIPTIC OBLIQUITY=',ECLIP + WRITE(IDBUG,*) 'MEAN ANOMALY=',MA + WRITE(IDBUG,*) 'MEAN LONGITUDE=',LAMD + WRITE(IDBUG,*) 'TRUE LONGITUDE=',SUNLON + ENDIF + + CX(1)= GMSTD + CX(2) = ECLIP + CX(3) = SUNLON + CX(4) = TH0 + CX(5) = PH0 +! Derived later: +! CX(6) = Dipole tilt angle +! CX(7) = Angle between sun and magnetic pole +! CX(8) = Subsolar point latitude +! CX(9) = Subsolar point longitude + + DO I=1,5 + ST(I) = SIN(CX(I)*pi/180._r8) + CT(I) = COS(CX(I)*pi/180._r8) + ENDDO +! + AM(1,1,GSEGEI) = CT(3) + AM(1,2,GSEGEI) = -ST(3) + AM(1,3,GSEGEI) = 0._r8 + AM(2,1,GSEGEI) = ST(3)*CT(2) + AM(2,2,GSEGEI) = CT(3)*CT(2) + AM(2,3,GSEGEI) = -ST(2) + AM(3,1,GSEGEI) = ST(3)*ST(2) + AM(3,2,GSEGEI) = CT(3)*ST(2) + AM(3,3,GSEGEI) = CT(2) +! + AM(1,1,GEIGEO) = CT(1) + AM(1,2,GEIGEO) = ST(1) + AM(1,3,GEIGEO) = 0._r8 + AM(2,1,GEIGEO) = -ST(1) + AM(2,2,GEIGEO) = CT(1) + AM(2,3,GEIGEO) = 0._r8 + AM(3,1,GEIGEO) = 0._r8 + AM(3,2,GEIGEO) = 0._r8 + AM(3,3,GEIGEO) = 1._r8 +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSEGEO) = AM(I,1,GEIGEO)*AM(1,J,GSEGEI) + & + AM(I,2,GEIGEO)*AM(2,J,GSEGEI) + AM(I,3,GEIGEO)*AM(3,J,GSEGEI) + ENDDO + ENDDO +! + AM(1,1,GEOMAG) = CT(4)*CT(5) + AM(1,2,GEOMAG) = CT(4)*ST(5) + AM(1,3,GEOMAG) =-ST(4) + AM(2,1,GEOMAG) =-ST(5) + AM(2,2,GEOMAG) = CT(5) + AM(2,3,GEOMAG) = 0._r8 + AM(3,1,GEOMAG) = ST(4)*CT(5) + AM(3,2,GEOMAG) = ST(4)*ST(5) + AM(3,3,GEOMAG) = CT(4) +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSEMAG) = AM(I,1,GEOMAG)*AM(1,J,GSEGEO) + & + AM(I,2,GEOMAG)*AM(2,J,GSEGEO) + AM(I,3,GEOMAG)*AM(3,J,GSEGEO) + ENDDO + ENDDO +! + B32 = AM(3,2,GSEMAG) + B33 = AM(3,3,GSEMAG) + B3 = SQRT(B32*B32+B33*B33) + IF (B33.LE.0._r8) B3 = -B3 +! + AM(2,2,GSEGSM) = B33/B3 + AM(3,3,GSEGSM) = AM(2,2,GSEGSM) + AM(3,2,GSEGSM) = B32/B3 + AM(2,3,GSEGSM) =-AM(3,2,GSEGSM) + AM(1,1,GSEGSM) = 1._r8 + AM(1,2,GSEGSM) = 0._r8 + AM(1,3,GSEGSM) = 0._r8 + AM(2,1,GSEGSM) = 0._r8 + AM(3,1,GSEGSM) = 0._r8 +! + DO I=1,3 + DO J=1,3 + AM(I,J,GEOGSM) = AM(I,1,GSEGSM)*AM(J,1,GSEGEO) + & + AM(I,2,GSEGSM)*AM(J,2,GSEGEO) + AM(I,3,GSEGSM)*AM(J,3,GSEGEO) + ENDDO + ENDDO +! + DO I=1,3 + DO J=1,3 + AM(I,J,GSMMAG) = AM(I,1,GEOMAG)*AM(J,1,GEOGSM) + & + AM(I,2,GEOMAG)*AM(J,2,GEOGSM) + AM(I,3,GEOMAG)*AM(J,3,GEOGSM) + ENDDO + ENDDO +! + ST(6) = AM(3,1,GSEMAG) + CT(6) = SQRT(1._r8-ST(6)*ST(6)) + CX(6) = ASIN(ST(6)*pi/180._r8) + + AM(1,1,GSMSM) = CT(6) + AM(1,2,GSMSM) = 0._r8 + AM(1,3,GSMSM) = -ST(6) + AM(2,1,GSMSM) = 0._r8 + AM(2,2,GSMSM) = 1._r8 + AM(2,3,GSMSM) = 0._r8 + AM(3,1,GSMSM) = ST(6) + AM(3,2,GSMSM) = 0._r8 + AM(3,3,GSMSM) = CT(6) +! + DO I=1,3 + DO J=1,3 + AM(I,J,GEOSM) = AM(I,1,GSMSM)*AM(1,J,GEOGSM) + & + AM(I,2,GSMSM)*AM(2,J,GEOGSM) + AM(I,3,GSMSM)*AM(3,J,GEOGSM) + ENDDO + ENDDO +! + DO I=1,3 + DO J=1,3 + AM(I,J,MAGSM) = AM(I,1,GSMSM)*AM(J,1,GSMMAG) + & + AM(I,2,GSMSM)*AM(J,2,GSMMAG) + AM(I,3,GSMSM)*AM(J,3,GSMMAG) + ENDDO + ENDDO + +! + CX(7)=ATAN2( AM(2,1,11) , AM(1,1,11) ) + + CX(7)=CX(7)*180._r8/pi + CX(8)=ASIN( AM(3,1,1)*pi/180._r8 ) + CX(9)=ATAN2( AM(2,1,1) , AM(1,1,1) ) + CX(9)=CX(9)*180._r8/pi + + IF(IDBUG.NE.0)THEN + WRITE(IDBUG,*) 'Dipole tilt angle=',CX(6) + WRITE(IDBUG,*) 'Angle between sun and magnetic pole=',CX(7) + WRITE(IDBUG,*) 'Subsolar point latitude=',CX(8) + WRITE(IDBUG,*) 'Subsolar point longitude=',CX(9) + + DO K=1,11 + WRITE(IDBUG,1001) K + DO I=1,3 + WRITE(IDBUG,1002) (AM(I,J,K),J=1,3) + ENDDO + ENDDO + 1001 FORMAT(' ROTATION MATRIX ',I2) + 1002 FORMAT(3F9.5) + ENDIF + +!CC NCAR MODIFICATION (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! The next line was added to return the dipole tilt from this function call. C + GET_TILT = CX(6) +!CC NCAR MODIFICATION (3/96) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + RETURN + END FUNCTION GET_TILT + +!================================================================================================ + + SUBROUTINE ROTATE (X,Y,Z,I) +! +!----------------------------------------------------------------------- +! THIS SUBROUTINE APPLIES TO THE VECTOR (X,Y,Z) THE ITH ROTATION +! MATRIX AM(N,M,I) GENERATED BY SUBROUTINE TRANS +! IF I IS NEGATIVE, THEN THE INVERSE ROTATION IS APPLIED +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + integer, intent(in) :: i + REAL(r8), intent(inout) :: X,Y,Z +! +!---------------------------Local variables----------------------------- +! + REAL(r8) A(3) +! +!----------------------------------------------------------------------- +! + A(1)=X + A(2)=Y + A(3)=Z + CALL ROTATEV(A,A,I) + X=A(1) + Y=A(2) + Z=A(3) + + RETURN + END SUBROUTINE ROTATE + +!================================================================================================ + + SUBROUTINE ROTATEV (A,B,I) +! +!----------------------------------------------------------------------- +! THIS SUBROUTINE APPLIES TO THE VECTOR A(3) THE ITH ROTATION +! MATRIX AM(N,M,I) GENERATED BY SUBROUTINE TRANS +! AND OUTPUTS THE CONVERTED VECTOR B(3), WITH NO CHANGE TO A. +! IF I IS NEGATIVE, THEN THE INVERSE ROTATION IS APPLIED +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + integer, intent(in) :: i + REAL(r8), intent(in) :: A(3) + REAL(r8), intent(out) :: B(3) +! +!---------------------------Local variables----------------------------- +! + integer id, j + real(r8) xa, ya, za +! +!----------------------------------------------------------------------- +! + IF(I.EQ.0 .OR. IABS(I).GT.11)THEN + WRITE(IULOG,*)'ROTATEV CALLED WITH UNDEFINED TRANSFORMATION' + CALL ENDRUN + ENDIF + + XA = A(1) + YA = A(2) + ZA = A(3) + IF(I.GT.0)THEN + ID=I + DO J=1,3 + B(J) = XA*AM(J,1,ID) + YA*AM(J,2,ID) + ZA*AM(J,3,ID) + ENDDO + ELSE + ID=-I + DO J=1,3 + B(J) = XA*AM(1,J,ID) + YA*AM(2,J,ID) + ZA*AM(3,J,ID) + ENDDO + ENDIF + RETURN + END SUBROUTINE ROTATEV + +!================================================================================================ + + SUBROUTINE FROMCART(R,LAT,LONG,POS) +! +!----------------------------------------------------------------------- +! CONVERT CARTESIAN COORDINATES POS(3) +! TO SPHERICAL COORDINATES R, LATITUDE, AND LONGITUDE (DEGREES) +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(out) :: R, LAT, LONG + REAL(r8), intent(in) :: POS(3) +! +!---------------------------Local variables----------------------------- +! + real(r8) pi +! +!----------------------------------------------------------------------- +! + pi=2._r8*ASIN(1._r8) + R=SQRT(POS(1)*POS(1) + POS(2)*POS(2) + POS(3)*POS(3)) + IF(R.EQ.0._r8)THEN + LAT=0._r8 + LONG=0._r8 + ELSE + LAT=ASIN(POS(3)*pi/180._r8/R) + LONG=ATAN2(POS(2),POS(1)) + LONG=LONG*180._r8/pi + ENDIF + RETURN + END SUBROUTINE FROMCART + +!================================================================================================ + + SUBROUTINE TOCART(R,LAT,LONG,POS) +! +!----------------------------------------------------------------------- +! CONVERT SPHERICAL COORDINATES R, LATITUDE, AND LONGITUDE (DEGREES) +! TO CARTESIAN COORDINATES POS(3) +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(in) :: R, LAT, LONG + REAL(r8), intent(out) :: POS(3) +! +!---------------------------Local variables----------------------------- +! + real(r8) pi, stc, ctc, sf, cf +! +!----------------------------------------------------------------------- +! + pi=2._r8*ASIN(1._r8) + STC = SIN(LAT*pi/180._r8) + CTC = COS(LAT*pi/180._r8) + SF = SIN(LONG*pi/180._r8) + CF = COS(LONG*pi/180._r8) + POS(1) = R*CTC*CF + POS(2) = R*CTC*SF + POS(3) = R*STC + RETURN + END SUBROUTINE TOCART + +!================================================================================================ + + SUBROUTINE ADJUST(ANGLE) +! +!----------------------------------------------------------------------- +! ADJUST AN ANGLE IN DEGREES TO BE IN RANGE OF 0 TO 360. +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + real(r8), intent(inout) :: angle +! +!----------------------------------------------------------------------- +! + 10 CONTINUE + IF(ANGLE.LT.0._r8)THEN + ANGLE=ANGLE+360._r8 + GOTO 10 + ENDIF + 20 CONTINUE + IF(ANGLE.GE.360._r8)THEN + ANGLE=ANGLE-360._r8 + GOTO 20 + ENDIF + RETURN + END SUBROUTINE ADJUST + +!================================================================================================ + + INTEGER FUNCTION JULDAY(MM,ID,IYYY) +! +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + integer, intent(in) :: mm, id + integer, intent(inout) :: iyyy +! +!-----------------------------Parameters------------------------------ +! + integer igreg + PARAMETER (IGREG=15+31*(10+12*1582)) +! +!---------------------------Local variables----------------------------- +! + integer ja, jm, jy +! +!----------------------------------------------------------------------- +! +! IF (IYYY.EQ.0) PAUSE 'There is no Year Zero.' + IF (IYYY.LT.0) IYYY=IYYY+1 + IF (MM.GT.2) THEN + JY=IYYY + JM=MM+1 + ELSE + JY=IYYY-1 + JM=MM+13 + ENDIF + JULDAY=INT(365.25_r8*JY)+INT(30.6001_r8*JM)+ID+1720995 + IF (ID+31*(MM+12*IYYY).GE.IGREG) THEN + JA=INT(0.01_r8*JY) + JULDAY=JULDAY+2-JA+INT(0.25_r8*JA) + ENDIF + RETURN + END FUNCTION JULDAY + +!================================================================================================ + + real(r8) FUNCTION MLT(MagLong) +! +!----------------------------------------------------------------------- +! given magnetic longitude in degrees, return Magnetic Local Time +! assuming that TRANS has been called with the date & time to calculate +! the rotation matrices. +! +! btf 11/06/03: +! Call sub adjust instead of referencing it as a function +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(in) :: MagLong +! +!---------------------------Local variables----------------------------- +! + REAL(r8) angle, rotangle +! +!----------------------------------------------------------------------- +! + RotAngle=CX(7) +! MLT=ADJUST(Maglong+RotAngle+180.)/15. + angle = Maglong+RotAngle+180._r8 + call adjust(angle) + mlt = angle/15._r8 + RETURN + END FUNCTION MLT + +!================================================================================================ + + real(r8) FUNCTION MagLong(MLT) +! +!----------------------------------------------------------------------- +! return magnetic longitude in degrees, given Magnetic Local Time +! assuming that TRANS has been called with the date & time to calculate +! the rotation matrices. +! +! btf 11/06/03: +! Call sub adjust instead of referencing it as a function +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + REAL(r8), intent(in) :: MLT +! +!---------------------------Local variables----------------------------- +! + REAL(r8) angle, rotangle +! +!----------------------------------------------------------------------- +! + RotAngle=CX(7) + angle=MLT*15._r8-RotAngle-180._r8 +! MagLong=ADJUST(angle) + call adjust(angle) + MagLong = angle + RETURN + END FUNCTION MagLong + +!================================================================================================ + + SUBROUTINE SunLoc(SunLat,SunLong) +! +!----------------------------------------------------------------------- +! Return latitude and longitude of sub-solar point. +! Assumes that TRANS has previously been called with the +! date & time to calculate the rotation matrices. +!----------------------------------------------------------------------- +! +! +!------------------------------Arguments-------------------------------- +! + Real(r8), intent(out) :: SunLat,SunLong +! +!----------------------------------------------------------------------- +! + SunLong=CX(9) + SunLat=CX(8) + RETURN + END SUBROUTINE SunLoc + +!================================================================================================ + + SUBROUTINE GECMP (AMLA,RMLT,ET,EP) +! +!----------------------------------------------------------------------- +! Get Electric field components for the Weimer electrostatic +! potential model. Before use, first load coefficients (CALL +! READCOEF) and initialize model conditions (CALL SETMODEL). +! +! INPUTS: +! AMLA = Absolute value of magnetic latitude (deg) +! RMLT = Magnetic local time (hours). +! RETURNS: +! ET = Etheta (magnetic equatorward*) E field component (V/m) +! EP = Ephi (magnetic eastward) E field component (V/m) +! +! * ET direction is along the magnetic meridian away from the +! current hemisphere; i.e., when ET > 0, the direction is +! southward when RMLA > 0 +! northward when RMLA < 0 +! +! NCAR addition (Jan 97). R.Barnes +!----------------------------------------------------------------------- +! +!------------------------------Arguments-------------------------------- +! + real(r8), intent(inout) :: amla + real(r8), intent(in) :: rmlt + real(r8), intent(out) :: et, ep +! +!-----------------------------Parameters------------------------------ +! + real(r8) d2r, r2d + PARAMETER ( D2R = 0.0174532925199432957692369076847_r8 , & + R2D = 57.2957795130823208767981548147_r8) +! +!---------------------------Local variables----------------------------- +! + real(r8) p1, p2 + real(r8) xmlt, xmlt1, kpol, dphi, amla1 +! +!----------------------------------------------------------------------- +! + ET = -99999._r8 + EP = -99999._r8 + IF (AMLA .LT. 0._r8) GO TO 100 + +! Calculate -(latitude gradient) by stepping 10 km along the +! meridian in each direction (flipping coordinates when going +! over pole to keep lat <= 90). + KPOL = 0 + XMLT = RMLT + 10 XMLT1 = XMLT + AMLA1 = AMLA + STPD + IF (AMLA1 .GT. 90._r8) THEN + AMLA1 = 180._r8 - AMLA1 + XMLT1 = XMLT1 + 12._r8 + ENDIF + P1 = EPOTVAL (AMLA1 ,XMLT1) + P2 = EPOTVAL (AMLA-STPD,XMLT ) + IF (KPOL .EQ. 1) GO TO 20 + ET = (P1 - P2) / STP2 + +! Calculate -(lon gradient). For most latitudes, step along a +! great circle. However, limit minimum latitude to the model +! minimum (distorting the path onto a latitude line). Also, +! avoid a divide by zero at the pole avoid by using Art's trick +! where Ephi(90,lon) = Etheta(90,lon+90) + IF (AMLA .LT. ALAMX) THEN + AMLA1 = MAX (ASIN(SIN(AMLA*D2R)*CSTP) , ALAMR) + DPHI = ASIN (SSTP/SIN(AMLA1))*R2D + AMLA1 = AMLA1*R2D + P1 = EPOTVAL (AMLA1,XMLT+DPHI) + P2 = EPOTVAL (AMLA1,XMLT-DPHI) + ELSE + AMLA = 90._r8 + XMLT = XMLT + 6._r8 + KPOL = 1 + GO TO 10 + ENDIF + 20 EP = (P2 - P1) / STP2 + IF (KPOL .EQ. 1) EP = -EP + +! Below model minimum lat, the potential is value at min lat + IF (AMLA .LT. ALAMN) THEN + ET = 0._r8 + EP = EP * COS(ALAMR)/COS(AMLA*D2R) + ENDIF + + 100 RETURN + END SUBROUTINE GECMP + +!================================================================================================ +end module wei96 diff --git a/src/physics/waccmx/ion_electron_temp.F90 b/src/physics/waccmx/ion_electron_temp.F90 new file mode 100644 index 0000000000..034b80c7a1 --- /dev/null +++ b/src/physics/waccmx/ion_electron_temp.F90 @@ -0,0 +1,1422 @@ +module ion_electron_temp + +!--------------------------------------------------------------------------------- +! Purpose: +! +! Module to compute the ion/electron temperature and dry static heating +! +! Authors: Joe McInerney/Hanli Liu/Art Richmond +! +!--------------------------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 ! Real kind to declare variables + use ppgrid, only : pcols, pver, pverp ! Dimensions and chunk bounds + use cam_history, only : outfld, hist_fld_active ! Routine to output fields to history files + use cam_control_mod,only : initial_run + use physics_types, only : physics_state, & ! Structures containing physics state variables + physics_ptend, & ! Structures containing physics tendency variables + physics_ptend_init ! Routine to initialize physics tendency variables + use physics_buffer, only : pbuf_add_field, & ! + pbuf_get_index,dtype_r8, & ! + physics_buffer_desc, & ! + pbuf_get_field, & ! Needed to access physics buffer + pbuf_set_field + use mo_jeuv, only : nIonRates ! Number of ionization rates in mo_photo + use shr_const_mod, only : kboltz => shr_const_boltz, & + pi => shr_const_pi ! Boltzmann constant and pi + use chem_mods, only : adv_mass ! Array holding mass values for short lived species + use cam_abortutils, only : endrun + use mo_chem_utls, only : get_spc_ndx ! Routine to get index of adv_mass array for short lived species + use constituents, only : cnst_get_ind, cnst_mw ! Routines to get molecular weights for constituents + use solar_parms_data, only : f107=>solar_parms_f107 ! 10.7 cm solar flux + + implicit none + + save + + private ! Make default type private to the module + + !------------------------ + ! PUBLIC: interfaces + !------------------------ + public :: ion_electron_temp_init ! Initialization + public :: ion_electron_temp_register ! Registration of ionosphere variables in pbuf physics buffer + public :: ion_electron_temp_inidat ! Get fields from initial condition file into physics buffer + public :: ion_electron_temp_tend ! Calculate tendencies for extended model ionosphere + + !------------------------------------------------------------------------ + ! PRIVATE: Rest of the data and interfaces are private to this module + !------------------------------------------------------------------------ + real(r8), parameter :: kboltz_ev = 8.617E-5_r8 ! Boltzmann constant (eV/K) + real(r8), parameter :: temax = 7.0E3_r8 ! maximum electron temperature (K) + real(r8), parameter :: dayOPFlux = 2.0E8_r8 ! Daytime O+ flux at upper boundary ( + real(r8), parameter :: nightOPFlux = -2.0E8_r8 ! Nighttime O+ flux at upper boundary ( + + real(r8), parameter :: rads2Degs = 180._r8/pi ! radians to degrees + + type ionos_state + + real(r8), dimension(pcols) :: cosZenAngR ! cosine of zenith angle (radians) + real(r8), dimension(pcols) :: zenAngD ! zenith angle (degrees) + + real(r8), dimension(pcols,pver) :: bNorth3d ! northward component of magnetic field units? + real(r8), dimension(pcols,pver) :: bEast3d ! eastward component of magnetic field + real(r8), dimension(pcols,pver) :: bDown3d ! downward component of magnetic field + + real(r8), dimension(pcols,pver,nIonRates) :: ionPRates ! ionization rates temporary array (s-1 cm-3) + real(r8), dimension(pcols,pver) :: sumIonPRates ! Sum of ionization rates for O+,O2+,N+,N2+,NO+ (s-2 cm-3) + + real(r8), dimension(pcols,pver) :: dipMag ! dip angle for each column (radians) + real(r8), dimension(pcols,pver) :: dipMagD ! dip angle for each column (degrees) + + real(r8), dimension(pcols,pverp) :: tNInt ! Interface Temperature (K) + + real(r8), dimension(pcols,pver) :: ndensN2 ! N2 number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensO2 ! O2 number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensO1 ! O number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensNO ! NO number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensN1 ! N number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensE ! E electron number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensOp ! O plus number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensO2p ! O2 plus ion number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensNOp ! NO plus ion number density (cm-3) + + real(r8), dimension(pcols,pver) :: sourceg4 ! g4 source term for electron/ion temperature update + + real(r8), dimension(pcols,pverp) :: rairvi ! Constituent dependent gas constant on interface levels + + end type ionos_state + +! private data + real(r8) :: rMassOp ! O+ molecular weight kg/kmol + +contains + +!============================================================================== + + subroutine ion_electron_temp_init(pbuf2d) + +!----------------------------------------------------------------------- +! Time independent initialization for ionosphere simulation. +!----------------------------------------------------------------------- + + use cam_history, only : horiz_only, addfld, add_default ! Routines and variables for adding fields to history output + use phys_control, only : phys_getopts !Method used to get flag for waccmx ionosphere output variables + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: indxTi ! pbuf index for ion temperature + integer :: indxTe ! pbuf index for electron temperature + + logical :: history_waccmx + integer :: indxOp,sIndxOp ! state%q or pbuf index for O+ mixing ratio + + if (initial_run) then + indxTi = pbuf_get_index( 'TIon' ) + indxTe = pbuf_get_index( 'TElec' ) + call pbuf_set_field(pbuf2d, indxTi, 0.0_r8) + call pbuf_set_field(pbuf2d, indxTe, 0.0_r8) + end if + + call phys_getopts(history_waccmx_out=history_waccmx) + + !------------------------------------------------------------------------------- + ! Add history variables for ionosphere + !------------------------------------------------------------------------------- + call addfld ('TElec&IC' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') + call addfld ('TIon&IC' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') + call addfld ('TElec' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') + call addfld ('TIon' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') + call addfld ('QIN' ,(/ 'lev' /), 'I', 'J/kg/s', 'Ion-neutral Heating') + call addfld ('QEN' ,(/ 'lev' /), 'I', ' ', 'Electron-neutral Heating') + call addfld ('QEI' ,(/ 'lev' /), 'I', ' ', 'Electron-ion Heating') + call addfld ('LOSS_g3' ,(/ 'lev' /), 'I', ' ', 'Loss Term g3') + call addfld ('LOSS_EI' ,(/ 'lev' /), 'I', ' ', 'Loss Term EI') + call addfld ('LOSS_IN' ,(/ 'lev' /), 'I', ' ', 'Loss Term IN') + call addfld ('SOURCER' ,(/ 'lev' /), 'I', ' ', 'SOURCER') + call addfld ('SOURCEEff' ,(/ 'lev' /), 'I', ' ', 'SOURCEEff') + call addfld ('AURIPRATESUM' ,(/ 'lev' /), 'I', ' ', 'Auroral ionization') + + call addfld ('OpI' ,(/ 'lev' /), 'I', ' ', 'O+ Ionosphere') + call addfld ('eI' ,(/ 'lev' /), 'I', ' ', 'e Ionosphere') + call addfld ('ElecColDens' ,horiz_only , 'I', 'TECU', 'Electron Column Density') + + call add_default ('TElec&IC' , 0, ' ') + call add_default ('TIon&IC' , 0, ' ') + + !------------------------------------------------------------------------------- + ! Set default values for ionosphere history variables + !------------------------------------------------------------------------------- + if (history_waccmx) then + call add_default ('TElec' , 1, ' ') + call add_default ('TIon' , 1, ' ') + call add_default ('QIN' , 1, ' ') + call add_default ('QEN' , 1, ' ') + call add_default ('QEI' , 1, ' ') + call add_default ('SOURCER' , 1, ' ') + call add_default ('SOURCEEff' , 1, ' ') + call add_default ('AURIPRATESUM' , 1, ' ') + end if + + call cnst_get_ind( 'Op', indxOp, abort=.false. ) + if (indxOp > 0) then + rMassOp = cnst_mw(indxOP) + else + sIndxOp = get_spc_ndx( 'Op' ) + if (sIndxOp > 0) then + rMassOp = adv_mass(sIndxOp) + else + call endrun('update_teti: Cannot find short-lived index for Op in update_teti') + endif + endif + + end subroutine ion_electron_temp_init + +!============================================================================== + + subroutine ion_electron_temp_register + + !----------------------------------------------------------------------- + ! Register ionosphere variables with physics buffer: + ! + ! Ion production rates pcols,pver,nIonRates, + ! so firstdim = 1 middledim = pver lastdim = nIonRates. + ! + ! pcols dimension and lchnk assumed here + ! + !----------------------------------------------------------------------- + + integer :: idx + + !------------------------------------------------------------------------------ + ! Electron temperature in physics buffer (global so can write to history files) + !------------------------------------------------------------------------------ + call pbuf_add_field('TElec','global',dtype_r8,(/pcols,pver/),idx) + + !-------------------------------------------------------------------------- + ! Ion temperature in physics buffer (global so can write to history files) + !-------------------------------------------------------------------------- + call pbuf_add_field('TIon', 'global',dtype_r8,(/pcols,pver/),idx) + + end subroutine ion_electron_temp_register + +!============================================================================== + + subroutine ion_electron_temp_inidat(ncid_ini, pbuf2d) + + !----------------------------------------------------------------------- + ! Grab fields from initial condition file and put in physics buffer + !----------------------------------------------------------------------- + + use pio, only : file_desc_t + use cam_grid_support, only : cam_grid_check, cam_grid_id + use cam_grid_support, only : cam_grid_get_dim_names + use cam_abortutils, only : endrun + use physics_buffer, only : pbuf_get_index, pbuf_set_field + use ncdio_atm, only : infld + use ppgrid, only : pcols, pver, begchunk, endchunk + use spmd_utils, only : masterproc + use cam_logfile, only : iulog ! Output unit for run.out file + + type(file_desc_t), intent(inout) :: ncid_ini ! Initial condition file id + type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Physics buffer + + integer :: index_te, index_ti ! Indices to find ion and electron temperature in pbuf + integer :: grid_id + character(len=4) :: dim1name, dim2name + logical :: found + real(r8),pointer :: tE(:,:,:) ! Electron temperature pointer + real(r8),pointer :: tI(:,:,:) ! Ion temperature pointer + integer :: ierr + character(len=*), parameter :: subname='ION_ELECTRON_TEMP_INIDAT' + + found = .false. + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + index_te = pbuf_get_index('TElec',errcode=ierr) + index_ti = pbuf_get_index('TIon',errcode=ierr) + + if (index_te>0) then + !--------------------------------------------------------------------------------- + ! Electron temperature in to physics buffer. If not found use neutral temperature + !--------------------------------------------------------------------------------- + allocate(tE(pcols,pver,begchunk:endchunk)) + call infld( 'TElec',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tE, found, gridname='physgrid') + + if (.not.found) then + if (masterproc) write(iulog,*) 'ion_electron_temp_inidat: Could not find electron temperature in ic file. ' & + // 'Using neutral temperature' + call infld( 'T',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tE, found, gridname='physgrid') + endif + + call pbuf_set_field(pbuf2d, index_te, tE) + + deallocate(tE) + endif + + if (index_ti>0) then + !---------------------------------------------------------------------------- + ! Ion temperature in to physics buffer. If not found use neutral temperature + !---------------------------------------------------------------------------- + allocate(tI(pcols,pver,begchunk:endchunk)) + call infld( 'TIon',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tI, found, gridname='physgrid') + + if (.not.found) then + if (masterproc) write(iulog,*) 'ion_electron_temp_inidat: Could not find ion temperature in ic file. ' & + // 'Using neutral temperature' + call infld( 'T',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tI, found, gridname='physgrid') + endif + + call pbuf_set_field(pbuf2d, index_ti, tI) + + deallocate(tI) + endif + + end subroutine ion_electron_temp_inidat + +!============================================================================== + + subroutine ion_electron_temp_tend(state, ptend, pbuf, ztodt) + + !------------------------------------------------------------------------------------- + ! Calculate dry static energy and O+ tendency for extended ionosphere simulation + !------------------------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------- + + use physics_types, only : physics_ptend_sum + + type(physics_state), intent(in) :: state ! physics state structure + type(physics_ptend), intent(inout) :: ptend ! parameterization tendency structure + type(physics_buffer_desc),pointer :: pbuf(:) ! physics buffer + + real(r8), intent(in) :: ztodt ! Physics time step + +!---------------------------Local storage------------------------------- + + type(physics_ptend) :: ptend_loc ! Local parameterization tendencies + type(ionos_state) :: istate ! ionosphere state structure + + integer :: lchnk ! Chunk number + integer :: ncol ! Number of columns in chunk + + integer :: teTiBot ! bottom of ionosphere calculations + + integer :: indxTe ! pbuf index for electron temperature + integer :: indxTi ! pbuf index for ion temperature + + real(r8), dimension(:,:), pointer :: tE ! Pointer to electron temperature in pbuf (K) + real(r8), dimension(:,:), pointer :: tI ! Pointer to ion temperature in pbuf (K) + + logical :: ls + + !---------------------------------------------------------------- + ! Get number of this chunk + !---------------------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + + !------------------------------------------------------------ + ! Initialize data needed in the ionosphere calculations + !------------------------------------------------------------ + call update_istate(state, pbuf, istate, teTiBot) + + !------------------------------------------------------------------------------------------------------------------- + ! Get electron temperature from physics buffer. + !------------------------------------------------------------------------------------------------------------------- + indxTe = pbuf_get_index( 'TElec' ) + call pbuf_get_field(pbuf, indxTe, tE) + + indxTi = pbuf_get_index( 'TIon' ) + call pbuf_get_field(pbuf, indxTi, tI) + + ls = .TRUE. + call physics_ptend_init(ptend_loc, state%psetcols, 'ionosphere', ls=ls) + + !----------------------------------------------------------------- + ! Get electron temperature and update dry static energy tendency + !----------------------------------------------------------------- + call update_teti(state, ptend%s, ptend_loc%s, ztodt, istate, tE, tI, teTiBot) + + call physics_ptend_sum(ptend_loc, ptend, ncol) + + !-------------------------------------------------------------- + ! Make Te and Ti fields available for output to history files + !-------------------------------------------------------------- + call outfld ('TElec&IC', tE, pcols, lchnk) + call outfld ('TIon&IC' , tI, pcols, lchnk) + call outfld ('TElec' , tE, pcols, lchnk) + call outfld ('TIon' , tI, pcols, lchnk) + + return + + end subroutine ion_electron_temp_tend + +!=============================================================================== + + subroutine update_istate(state, pbuf, istate, teTiBot) + + !--------------------------------------------------------------------------------------- + ! Time independent initialization for extended ionosphere simulation called in phys_init + ! of physpkg module which is called in cam_comp module + !--------------------------------------------------------------------------------------- + use mo_apex, only : bnorth, beast, bdown ! Magnetic field components + use time_manager, only : get_curr_calday ! Routine to get current calendar day + use physconst, only : rairv, mbarv, rearth ! Constituent dependent rair and mbar + use ref_pres, only : press_lim_idx + use orbit, only : zenith + + use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species + + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + type(physics_state), intent(in), target :: state ! physics state structure + type(ionos_state), intent(inout), target :: istate ! ionosphere state structure + + integer, intent(out) :: teTiBot ! bottom of ionosphere calculations + +!---------------------------Local storage------------------------------- + integer,parameter :: nCnst = 9 ! Number of species needed from state%q or pbuf + + integer :: lchnk ! Chunk number + integer :: ncol ! Number of columns in current chunk + + integer :: indxIR ! pbuf index for ionization rates + integer :: indxAIPRS ! pbuf index for aurora ion production rate sum + + integer :: indxCnst ! Constituent index used in cslculating densities + + integer :: indxSLvd ! index of pbuf to access short lived species + integer :: sIndx ! index of adv_mass for any short lived species to access constituent mass + + integer :: iVer ! Counter for vertical loops + integer :: iCol ! Counter for column loops + integer :: iIonR ! Counter for ionization rates loops + integer :: iCnst ! Counter for constituent loop + + integer :: indxSP ! pbuf index for Pedersen Conductivity + integer :: indxSH ! pbuf index for Hall Conductivity + + real(r8), parameter :: teTiBotPres = 50._r8 ! Pressure above which electron/ion temperature are calculated in WACCM-X. (Pa) + + character(len = 3), dimension(nCnst) :: cCnst + + real(r8), dimension(:,:), pointer :: sigma_ped ! Pointer to Pedersen Conductivity in pbuf (siemens/m) from module iondrag + real(r8), dimension(:,:), pointer :: sigma_hall ! Pointer to Hall Conductivity in pbuf (siemens/m) + + real(r8), dimension(:,:), pointer :: mmrP ! Pointer to access short lived species in pbuf + + real(r8), dimension(:),pointer :: geoLatR ! Latitude (radians) Make ncol because zenith aurora are ncol + real(r8), dimension(:),pointer :: geoLonR ! Longitude (radians) + + real(r8), dimension(:,:),pointer :: pMid ! Midpoint pressure (Pa) + real(r8), dimension(:,:),pointer :: tN ! Neutral temperature (K) + + real(r8), dimension(:,:),pointer :: tNInt ! Interface Temperture (K) + + real(r8), dimension(:),pointer :: cosZenAngR ! cosine of zenith angle (radians) + real(r8), dimension(:),pointer :: zenAngD ! zenith angle (degrees) + + real(r8), dimension(:,:),pointer :: bNorth3d ! northward component of magnetic field units? + real(r8), dimension(:,:),pointer :: bEast3d ! eastward component of magnetic field + real(r8), dimension(:,:),pointer :: bDown3d ! downward component of magnetic field + + real(r8), dimension(pcols,pver) :: sourceR ! R term of source g4 calculation + real(r8), dimension(pcols,pver) :: sourceEff ! Efficiency term of source g4 calculation + + real(r8), dimension(:,:),pointer :: rairvi ! Constituent dependent gas constant + + real(r8), dimension(:,:),pointer :: dipMag ! dip angle for each column (radians) + real(r8), dimension(:,:),pointer :: dipMagD ! dip angle for each column (degrees) + + real(r8), parameter :: rMassN2 = 28._r8 ! N2 molecular weight kg/kmol + real(r8) :: rMass ! Constituent molecular weight kg/kmol + + real(r8), dimension(pcols,pver) :: mmrN2 ! N2 mass mixing ratio kg/kg + real(r8), dimension(pcols,pver) :: mmrO2 ! O2 mass mixing ratio kg/kg + real(r8), dimension(pcols,pver) :: mmrO1 ! O mass mixing ratio kg/kg + + real(r8), dimension(pcols,pver) :: mmr ! Constituent mass mixing ratio kg/kg + + real(r8), dimension(:,:),pointer :: ndensN2 ! N2 number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensO2 ! O2 number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensO1 ! O number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensN1 ! N number density (cm-3) + real(r8), dimension(pcols,pver) :: ndensE ! E electron number density (cm-3) + + real(r8), dimension(:,:) ,pointer :: ndens ! Constituent number density (cm-3) + + real(r8), dimension(:,:,:),pointer :: ionRates ! Pointer to ionization rates for O+,O2+,N+,N2+,NO+ in pbuf (s-1) + ! (from modules mo_jeuv and mo_jshort) + + real(r8), dimension(:,:,:),pointer :: ionPRates ! ionization rates temporary array (s-1 cm-3) + real(r8), dimension(:,:) ,pointer :: sumIonPRates ! Sum of ionization rates for O+,O2+,N+,N2+,NO+ (s-1 cm-3) + + real(r8), dimension(:,:) ,pointer :: aurIPRateSum ! Auroral ion production sum for O2+,O+,N2+ (s-1 cm-3 from module mo_aurora) + + real(r8), dimension(:,:) ,pointer :: sourceg4 ! g4 source term for electron/ion temperature update + + real(r8) :: calDay ! current calendar day + + !real(r8), dimension(pcols,pver) :: tempout ! temporary scratch output array + + real(r8), dimension(pcols,pver) :: zGeom ! Geometric altitude (cm) + real(r8), dimension(pcols,pver) :: zThickness ! Geometric altitude thickness (cm) + real(r8), dimension(pcols) :: eColDens ! Electron column density (TECU = 1E16 m-2) + +!-------------------------------------------------------------------------------- + + sourceR = 0._r8 + sourceEff = 0._r8 + + mmrN2 = 0._r8 + mmrO2 = 0._r8 + mmrO1 = 0._r8 + mmr = 0._r8 + + ndensO2(:,:) = 0._r8 + ndensO1(:,:) = 0._r8 + ndensN1(:,:) = 0._r8 + ndensE(:,:) = 0._r8 + + sourceR(:,:) = 0._r8 + sourceEff(:,:) = 0._r8 + + !tempout(:,:) = 0._r8 + + !-------------------------------------------------------------------------------------- + ! Get lchnk from state + !-------------------------------------------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + + !------------------------------------------------------------------------------------------------------ + ! Set the bottom of the ionosphere calculations at around 50 Pascals or 0.5 hectopascals(millibars). + ! teTiBotPres is in Pascals. + !------------------------------------------------------------------------------------------------------ + teTiBot = press_lim_idx(teTiBotPres, top=.false.) + + !---------------------------------------------------------------- + ! Get latitude and longitude of each column in this chunk + !---------------------------------------------------------------- + geoLatR => state%lat(1:ncol) + geoLonR => state%lon(1:ncol) + + !------------------------------------------------------------------------------------------------------- + ! Need to get midpoint and interface pressure and neutral temperature from state structure (pcols,pver) + !------------------------------------------------------------------------------------------------------- + pMid => state%pmid(1:ncol,1:pver) + tN => state%t(1:ncol,1:pver) + + tNInt => istate%tNInt(1:ncol,1:pverp) + cosZenAngR => istate%cosZenAngR(1:ncol) + zenAngD => istate%zenAngD(1:ncol) + + bNorth3d => istate%bNorth3d(1:ncol,1:pver) + bEast3d => istate%bEast3d(1:ncol,1:pver) + bDown3d => istate%bDown3d(1:ncol,1:pver) + + rairvi => istate%rairvi(1:ncol,1:pverp) + + dipMag => istate%dipMag(1:ncol,1:pver) + dipMagD => istate%dipMagD(1:ncol,1:pver) + + ndensN2 => istate%ndensN2(1:ncol,1:pver) + + ionPRates => istate%ionPRates(1:ncol,1:pver,1:nIonRates) + sumIonPRates => istate%sumIonPRates(1:ncol,1:pver) + + sourceg4 => istate%sourceg4(1:ncol,1:pver) + + !------------------------------------------------------------------------------------- + ! Calculate neutral temperature on interface levels. tN vertical dimension is pver + !------------------------------------------------------------------------------------- + do iVer = 2, pver + + do iCol = 1, ncol + + tNInt(iCol,iVer) = 0.5_r8 * tN(iCol,iVer) + 0.5_r8 * tN(iCol,iVer-1) + + enddo + enddo + + do iCol = 1, ncol + tNInt(iCol,1) = 1.5_r8 * tNInt(iCol,2) - 0.5_r8 * tNInt(iCol,3) + enddo + do iCol = 1, ncol + tNInt(iCol,pverp) = 1.5_r8 * tNInt(iCol,pver) - 0.5_r8 * tNInt(iCol,pver-1) + enddo + + !-------------------------------------------------------------- + ! Get zenith angle + !-------------------------------------------------------------- + calDay = get_curr_calday() + call zenith(calDay,geoLatR(1:ncol),geoLonR(1:ncol),cosZenAngR(1:ncol),ncol) + + do iCol = 1, ncol + + zenAngD(iCol) = ACOS(cosZenAngR(iCol)) * rads2Degs + + enddo + + !--------------------------------------------------------------------------------------- + ! Expand magnetic field components in vertical to make 3D, pcols,pver,begchunk:endchunk + ! These are used in calculation of magnetic dip angle and magnetic declination angle so + ! store in local ionosphere module structure. + !--------------------------------------------------------------------------------------- + do iVer = 1, pver + + do iCol = 1, ncol + + bNorth3d(iCol,iVer) = bnorth(iCol,lchnk) + bEast3d(iCol,iVer) = beast(iCol,lchnk) + bDown3d(iCol,iVer) = bdown(iCol,lchnk) + + enddo + + enddo + + !------------------------------------------------------------------------ + ! Get constituent dependent gas constant and derive on interface levels + !------------------------------------------------------------------------ + do iVer = 2, pver + do iCol = 1, ncol + rairvi(iCol,iVer) = 0.5_r8 * rairv(iCol,iVer-1,lchnk) + 0.5_r8 * rairv(iCol,iVer,lchnk) + enddo + enddo + + do iCol = 1, ncol + rairvi(iCol,1) = 1.5_r8 * rairvi(iCol,2) - 0.5_r8 * rairvi(iCol,3) + enddo + do iCol = 1, ncol + rairvi(iCol,pverp) = 1.5_r8 * rairvi(iCol,pver) - 0.5_r8 * rairvi(iCol,pver-1) + enddo + + !------------------------------------------------------------------------------- + ! Need to get dip angle from magnetic field components + !------------------------------------------------------------------------------- + do iVer = 1, pver + do iCol = 1, ncol + dipMag(iCol,iVer) = ATAN(bDown3d(iCol,iVer) / SQRT(bNorth3d(iCol,iVer)**2 + bEast3d(iCol,iVer)**2)) + if (dipMag(iCol,iVer) < 0.17_r8 .and. dipMag(iCol,iVer) > 0._r8 ) dipMag(iCol,iVer) = 0.17_r8 + if (dipMag(iCol,iVer) > -0.17_r8 .and. dipMag(iCol,iVer) < 0._r8 ) dipMag(iCol,iVer) = 0.17_r8 + dipMagD(iCol,iVer) = dipMag(iCol,iVer) * rads2Degs + enddo + enddo + + !------------------------------------------------------------------------------------------- + ! Set up constituents to be accessed here from pbuf or state%q. + !------------------------------------------------------------------------------------------- + cCnst = (/'O ','O2 ','NO ','H ','N ','e ','Op ','O2p','NOp'/) + + do iCnst = 1, nCnst + + !-------------------------------------- + ! Assign density to istate array + !-------------------------------------- + if (cCnst(iCnst) == 'O ') ndens => istate%ndensO1(1:ncol,1:pver) + if (cCnst(iCnst) == 'O2 ') ndens => istate%ndensO2(1:ncol,1:pver) + if (cCnst(iCnst) == 'NO ') ndens => istate%ndensNO(1:ncol,1:pver) + if (cCnst(iCnst) == 'N ') ndens => istate%ndensN1(1:ncol,1:pver) + if (cCnst(iCnst) == 'e ') ndens => istate%ndensE(1:ncol,1:pver) + if (cCnst(iCnst) == 'Op ') ndens => istate%ndensOp(1:ncol,1:pver) + if (cCnst(iCnst) == 'O2p') ndens => istate%ndensO2p(1:ncol,1:pver) + if (cCnst(iCnst) == 'NOp') ndens => istate%ndensNOp(1:ncol,1:pver) + + !------------------------------------------------------------------------------------------- + ! Set flag and get field mmr whether each constituent is short-lived(pbuf) or not(state%q). + !------------------------------------------------------------------------------------------- + call cnst_get_ind( TRIM(cCnst(iCnst)), indxCnst, abort=.false. ) + if (indxCnst < 0) then + indxSlvd = slvd_index( TRIM(cCnst(iCnst)) ) + if (indxSLvd > 0) then + call pbuf_get_field(pbuf, slvd_pbf_ndx, mmrP, start=(/1,1,indxSLvd/), kount=(/pcols,pver,1/) ) + mmr(1:ncol,1:pver) = mmrP(1:ncol,1:pver) + sIndx = get_spc_ndx( TRIM(cCnst(iCnst)) ) + rMass = adv_mass(sIndx) + endif + else + mmr(1:ncol,1:pver) = state%q(1:ncol,1:pver,indxCnst) + rMass = cnst_mw(indxCnst) + endif + + !-------------------------------------------------------------------------------------------------------------- + ! Need to get number density (cgs units) from mass mixing ratio. mbarv is kg/mole, same as rMass units + ! kg/kg * (kg/mole)/(kg/mole) * (Pa or N/m*m)/((Joules/K or N*m/K) * (K)) = m-3 * 1E-06 = cm-3 + !--------------------------------------------------------------------------------------------------------------- + ndens(1:ncol,1:pver) = mmr(1:ncol,1:pver) * mbarv(1:ncol,1:pver,lchnk) / rMass * & + pMid(1:ncol,1:pver) / (kboltz * tN(1:ncol,1:pver)) * 1.E-06_r8 + + if (cCnst(iCnst) == 'O ') then + mmrO1(1:ncol,1:pver) = mmr(1:ncol,1:pver) + ndensO1(1:ncol,1:pver) = ndens(1:ncol,1:pver) + endif + if (cCnst(iCnst) == 'O2 ') then + mmrO2(1:ncol,1:pver) = mmr(1:ncol,1:pver) + ndensO2(1:ncol,1:pver) = ndens(1:ncol,1:pver) + endif + if (cCnst(iCnst) == 'N ') ndensN1(1:ncol,1:pver) = ndens(1:ncol,1:pver) + if (cCnst(iCnst) == 'e ') ndensE(1:ncol,1:pver) = ndens(1:ncol,1:pver) + + !---------------------------------------------------------------------------- + ! Calculate N2 density from O2 and O and assign to istate array + !---------------------------------------------------------------------------- + if (iCnst == nCnst) then + + mmrN2(1:ncol,1:pver) = 1._r8 - (mmrO2(1:ncol,1:pver) + mmrO1(1:ncol,1:pver)) + mmrN2(1:ncol,1:pver) = MAX(1.e-20_r8,mmrN2(1:ncol,1:pver)) + ndensN2(1:ncol,1:pver) = mmrN2(1:ncol,1:pver) * mbarv(1:ncol,1:pver,lchnk) / rMassN2 * & + pMid(1:ncol,1:pver) / (kboltz * tN(1:ncol,1:pver)) * 1.E-06_r8 + + endif + + enddo ! nCnst + + if (hist_fld_active('ElecColDens')) then + !--------------------------------------- + ! Calculate electron column density + !--------------------------------------- + !------------------------------------------------------------------------------ + ! Convert geopotential altitude in meters to geometric altitude in centimeters + !------------------------------------------------------------------------------ + zGeom(1:ncol,1:pver) = state%zm(1:ncol,1:pver) * (1._r8 + state%zm(1:ncol,1:pver) / rearth) * 100._r8 + + !------------------------------------------------------------ + ! Calculate vertical thickness at each level in centimeters + !------------------------------------------------------------ + do iVer = 2, pver-1 + + zThickness(1:ncol,iVer) = (zGeom(1:ncol,iVer-1) - zGeom(1:ncol,iVer+1)) / 2._r8 + + enddo + + zThickness(1:ncol,1) = (1.5_r8 * zThickness(1:ncol,2)) - (0.5_r8 * zThickness(1:ncol,3)) + zThickness(1:ncol,pver) = (1.5_r8 * zThickness(1:ncol,pver-1)) - (0.5_r8 * zThickness(1:ncol,pver-2)) + + !---------------------------------------------------------------------------------- + ! Calculate electron column density converting from cm-2 to TEC units (1E16 m-2) + ! and make available for history output + !---------------------------------------------------------------------------------- + eColDens(1:ncol) = sum(ndensE(1:ncol,:) * zThickness(1:ncol,:), dim=2) / 1.E12_r8 + + call outfld('ElecColDens', eColDens, pcols, lchnk) + endif + + !------------------------------------------------------------------------------------ + ! Get ionization rates from physics buffer which were calculated in mo_jeuv and + ! mo_jshort modules. Rates array dimensions are pcols, pver, nIonRates. Units s-1 + !------------------------------------------------------------------------------------ + indxIR = pbuf_get_index( 'IonRates' ) + call pbuf_get_field(pbuf, indxIR, ionRates) + + !---------------------------------------------------------------------------------------------- + ! Need to convert these ionization rates to ion production rates by multiplying number density + ! of neutral species appropriate from reactions in mo_jeuv(jeuv) and mo_jshort(jshort)(for NO) + !---------------------------------------------------------------------------------------------- + do iVer = 1, pver + do iCol = 1, ncol + + do iIonR = 1, nIonRates + IF (iIonR <= 3) ionPRates(iCol,iVer,iIonR) = ionRates(iCol,iVer,iIonR) * ndensO1(iCol,iVer) + IF (iIonR == 4) ionPRates(iCol,iVer,iIonR) = ionRates(iCol,iVer,iIonR) * ndensN1(iCol,iVer) + IF ((iIonR == 5) .OR. (iIonR >= 7 .AND. iIonR <= 9)) & + ionPRates(iCol,iVer,iIonR) = ionRates(iCol,iVer,iIonR) * ndensO2(iCol,iVer) + IF (iIonR == 6 .OR. iIonR == 10 .OR. iIonR == 11) & + ionPRates(iCol,iVer,iIonR) = ionRates(iCol,iVer,iIonR) * ndensN2(iCol,iVer) + enddo + + !---------------------------------------------- + ! Sum ion production rates all reactions + !---------------------------------------------- + sumIonPRates(iCol,iVer) = SUM(ionPRates(iCol,iVer,1:11)) + + enddo + enddo + + !------------------------------------------------------------------------------------------- + ! Get aurora ion production rate sum from physics buffer which were calculated in mo_aurora + ! module. Rate array dimensions are pcols, pver. Units s-1 cm-3 + !------------------------------------------------------------------------------------------- + indxAIPRS = pbuf_get_index( 'AurIPRateSum' ) + call pbuf_get_field(pbuf, indxAIPRS, aurIPRateSum) + + !------------------------------------------------------------------------------------------------- + ! Calculate electron heating rate which is a source in electron/ion temperature derivation + !------------------------------------------------------------------------------------------------- + do iVer = 1, teTiBot + do iCol = 1, ncol + sourceR(iCol,iVer) = LOG( ndensE(iCol,iVer) / (ndensO2(iCol,iVer) + ndensN2(iCol,iVer) + & + 0.1_r8 * ndensO1(iCol,iVer)) ) + sourceEff(iCol,iVer) = EXP( -(12.75_r8 + 6.941_r8 * sourceR(iCol,iVer) + 1.166_r8 * sourceR(iCol,iVer)**2 + & + 0.08043_r8 * sourceR(iCol,iVer)**3 + 0.001996_r8 * sourceR(iCol,iVer)**4) ) + + !------------------------------------------------------------------------------- + ! Calculate g4 source term for electron temperature update + !------------------------------------------------------------------------------- + sourceg4(iCol,iVer) = (sumIonPRates(iCol,iVer) + aurIPRateSum(iCol,iVer)) * sourceEff(iCol,iVer) + + enddo + + enddo + + call outfld ('SOURCER' , sourceR , pcols, lchnk) + call outfld ('SOURCEEff' , sourceEff , pcols, lchnk) + call outfld ('AURIPRATESUM', aurIPRateSum, pcols, lchnk) + + !---------------------------------------------------------------------------------------------- + ! Get Pedersen and Hall Conductivities from physics buffer which were calculated in iondrag + ! module. Conductivity array dimensions are pcols, pver + !------------------------------------------------------------------------------- + indxSP = pbuf_get_index( 'PedConduct' ) + indxSH = pbuf_get_index( 'HallConduct' ) + call pbuf_get_field(pbuf, indxSP, sigma_ped) + call pbuf_get_field(pbuf, indxSH, sigma_hall) + + return + + end subroutine update_istate +! +!=============================================================================== + + subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTiBot) + + !----------------------------------------------------------------------- + ! Routine to compute the electron and ion temperature + !----------------------------------------------------------------------- + + use physconst, only : gravit ! Gravity (m/s2) + use physconst, only : rairv, mbarv ! Constituent dependent rair and mbar + +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(in), target :: state ! physics state structure + type(ionos_state), intent(in), target :: istate ! ionosphere state structure + + real(r8), dimension(pcols,pver), intent(in) :: dSETendIn ! dry static energy tendency + real(r8), dimension(pcols,pver), intent(out) :: dSETendOut ! dry static energy tendency + + real(r8), intent(in) :: ztodt ! physics time step + + real(r8), dimension(:,:), pointer, intent(inout) :: tE ! Pointer to electron temperature in pbuf (K) + real(r8), dimension(:,:), pointer, intent(inout) :: tI ! Pointer to ion temperature in pbuf (K) + + integer, intent(in) :: teTiBot ! bottom of ionosphere calculations + +!---------------------------Local storage------------------------------- + integer, parameter :: maxIter = 6 ! maximum number of iterations to solve for electron/ion temperature + + integer :: lchnk ! Chunk number + integer :: ncol ! Number of atmospheric columns + integer :: teTiBotP ! bottom of ionosphere calculations plus one more level + + integer :: iVer ! Counter for vertical loops + integer :: iCol ! Counter for column loops + integer :: iter ! Counter for iteration loop + + real(r8), parameter :: Kec1 = 7.5E5_r8 ! c1 constant for calculation of electron conductivity(Ke) + real(r8), parameter :: Kec2 = 3.22E4_r8 ! c2 constant for calculation of electron conductivity(Ke) + real(r8), parameter :: stepweight = 1.0_r8 ! weight of previous and current times step for diagonals + real(r8), parameter :: sToQConv = 6.24E15_r8 ! Conversion from J/kg/s to ev/g/s + + real(r8), parameter :: lossc5 = 1.21E-4_r8 ! c5 constant needed for loss term g3 for electron temperature update + real(r8), parameter :: lossc7 = 3.6E-2_r8 ! c7 constant needed for loss term g3 for electron temperature update + real(r8), parameter :: lossc9 = 5.7E-4_r8 ! c9 constant needed for loss term g3 for electron temperature update + real(r8), parameter :: lossc13 = 7.E-5_r8 ! c13 constant needed for loss term g3 for electron temperature update + + real(r8), parameter :: lossc4pCoef = 1.77E-19_r8 + real(r8), parameter :: lossc6pCoef = 1.21E-18_r8 + real(r8), parameter :: lossc8pCoef = 7.9E-19_r8 + real(r8), parameter :: lossc10pCoef = 1.3E-4_r8 + real(r8), parameter :: lossc11pCoef = 3.125E-21_r8 + real(r8), parameter :: lossc12pCoef = 3.4E-12_r8 + real(r8), parameter :: lossc14pCoef = 1.57E-12_r8 + real(r8), parameter :: lossc15pCoef = 2.9E-14_r8 + real(r8), parameter :: lossc16pCoef = 6.9E-14_r8 + real(r8), parameter :: lossc3pC1 = 3.2E-8_r8 + real(r8), parameter :: lossc3pC2 = 15._r8 + real(r8), parameter :: lossc3pC3 = 0.53_r8 + + real(r8), parameter :: losscinCoef1 = 6.6e-14_r8 + real(r8), parameter :: losscinCoef2 = 5.8e-14_r8 + real(r8), parameter :: losscinCoef3 = 0.21e-14_r8 + real(r8), parameter :: losscinCoef4 = 5.9e-14_r8 + real(r8), parameter :: losscinCoef5 = 5.45e-14_r8 + real(r8), parameter :: losscinCoef6 = 4.5e-14_r8 + real(r8), parameter :: losscinCoef7 = 5.8e-14_r8 + real(r8), parameter :: losscinCoef8 = 0.14e-14_r8 + real(r8), parameter :: losscinCoef9 = 4.4e-14_r8 + + real(r8), parameter :: FeDCoef1 = -5.0E+7_r8 + real(r8), parameter :: FeDCoef2 = 4.0E+7_r8 + + real(r8), parameter :: losscACoef1 = 5.71E-8_r8 + real(r8), parameter :: losscACoef2 = -3352.6_r8 + real(r8), parameter :: losscACoef3 = 2.0E-7_r8 + real(r8), parameter :: losscACoef4 = -4605.2_r8 + real(r8), parameter :: losscACoef5 = 2.53E-6_r8 + real(r8), parameter :: losscACoef6 = -17620._r8 + + real(r8), parameter :: loss10pCoef = 3200._r8 + real(r8), parameter :: lossc12pC1 = 0.4_r8 + real(r8), parameter :: lossc12pC2 = 150._r8 + + real(r8), parameter :: losscf2dC1 = 2.4E+4_r8 + real(r8), parameter :: losscf2dC2 = 0.3_r8 + real(r8), parameter :: losscf2dC3 = 1500._r8 + real(r8), parameter :: losscf2dC4 = 1.947E-5_r8 + real(r8), parameter :: losscf2dC5 = 4000._r8 + + real(r8), parameter :: losscf2C1 = 3000._r8 + + real(r8), parameter :: losscf3c1 = -22713._r8 + + real(r8), parameter :: f1Ted1C1 = 2.82E-17_r8 + real(r8), parameter :: f1Ted1C2 = 3.41E-21_r8 + + real(r8), parameter :: f1Ted2C1 = 2.2E-16_r8 + real(r8), parameter :: f1Ted2C2 = 7.92E-18_r8 + + real(r8), parameter :: f1Ted3C1 = 1.1E-16_r8 + real(r8), parameter :: f1Ted3C2 = 5.7E-4_r8 + + real(r8) :: wrk1 ! 2/3/kboltz_ev + real(r8) :: FeDB ! B term of electron heat flux of UB + real(r8) :: FeD ! Day time flux + real(r8) :: FeN ! Night time flux + real(r8) :: f1Ted1 ! d1 of f1(Te) calculation used to get electron conductivity + real(r8) :: f1Ted2 ! d2 of f1(Te) calculation used to get electron conductivity + real(r8) :: f1Ted3 ! d3 of f1(Te) calculation used to get electron conductivity + real(r8) :: f1Te + + real(r8), dimension(:,:), pointer :: pMid ! Midpoint pressure (Pa) + real(r8), dimension(:,:), pointer :: tN ! Neutral temperature (K) + real(r8), dimension(pcols,pver) :: tEPrevI ! Electron temperature from previous iteration (K) + + real(r8), dimension(:,:), pointer :: pInt ! Interface pressure (Pa) + real(r8), dimension(:,:), pointer :: tNInt ! Interface Temperture (K) + real(r8), dimension(:,:), pointer :: rairvi ! Constituent dependent gas constant on interface levels + + real(r8), dimension(:,:), pointer :: ndensN2 ! N2 number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensO2 ! O2 number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensO1 ! O number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensE ! E electron number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensOp ! O plus number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensO2p ! O2 plus ion number density (cm-3) + real(r8), dimension(:,:), pointer :: ndensNOp ! NO plus ion number density (cm-3) + + real(r8), dimension(:,:), pointer :: sourceg4 ! g4 source term for electron/ion temperature update + + real(r8), dimension(:,:), pointer :: dipMag ! dip angle for each column (radians) + real(r8), dimension(:,:), pointer :: dipMagD ! dip angle for each column (degrees) + + real(r8), dimension(:), pointer :: zenAngD ! zenith angle (degrees) + + real(r8), dimension(pcols) :: FeUB ! electron heat flux at upper boundary + + real(r8), dimension(pver) :: sqrtTE ! Square root of electron temperature + + real(r8), dimension(pver) :: Ke ! electron conductivity + + real(r8), dimension(pverp) :: Kei ! electron conductivity interface levels + + real(r8), dimension(pcols,pver) :: lossc4p ! c4 prime of Lc(eN2) component of loss term + real(r8), dimension(pcols,pver) :: lossceN2 ! Lc(eN2) component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc6p ! c6 prime of Lc(eO2) component of loss term equation + real(r8), dimension(pcols,pver) :: lossceO2 ! Lc(eO2) component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc8p ! c8 prime of Lc(eO) component of loss term equation + real(r8), dimension(pcols,pver) :: lossceO1 ! Lc(eO) component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc10p ! c10 prime of Lc(eN2) component of loss term equation + real(r8), dimension(pcols,pver) :: losscA ! A of Lc(eN2)v component of loss term equation + real(r8), dimension(pcols,pver) :: tENDiff ! Difference between electron and neutral temperatures + real(r8), dimension(pcols,pver) :: lossceN2v ! Lc(eN2)v component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc11p ! c11 prime of Lc(eO2)v component of loss term equation + real(r8), dimension(pcols,pver) :: lossceO2v ! Lc(eO2)v component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc12p ! c12 prime of Lc(eO)f component of loss term equation + real(r8), dimension(pcols,pver) :: lossceOf ! Lc(eO)f component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc14p ! c14 prime of Lc(eO)1D component of loss term equation + real(r8), dimension(pcols,pver) :: losscf2d ! d of f2 of Lc(eO)1D component of loss term equation + real(r8), dimension(pcols,pver) :: losscf2 ! f2 of Lc(eO)1D component of loss term equation + real(r8), dimension(pcols,pver) :: losscf3 ! f3 of Lc(eO)1D component of loss term equation + real(r8), dimension(pcols,pver) :: lossceO1D ! Lc(eO)1D component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc15p ! c15 prime of Lc(eN2)Rot component of loss term equation + real(r8), dimension(pcols,pver) :: lossceN2Rot ! Lc(eN2)Rot component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc16p ! c16 prime of Lc(eO2)Rot component of loss term equation + real(r8), dimension(pcols,pver) :: lossceO2Rot ! Lc(eO2)Rot component of loss term equation + + real(r8), dimension(pcols,pver) :: lossc3p ! c3 prime of Lc(ei) component of loss term equation + real(r8), dimension(pcols,pver) :: losscei ! Lc(ei) component of loss term equation + real(r8), dimension(pcols,pver) :: losscin ! ion-neutral heating coeff. + + real(r8), dimension(pcols,pver) :: lossg3 ! g3 loss term for Te tendency + + real(r8), dimension(pcols,pverp) :: delZi ! Delta z: interfaces + real(r8), dimension(pcols,pver) :: delZ ! Delta z: midpoints + + real(r8), dimension(pcols,pver) :: qjoule ! joule heating + real(r8), dimension(pcols,pver) :: qen ! electron-neutral heating + real(r8), dimension(pcols,pver) :: qei ! electron-ion Coulomb heating + real(r8), dimension(pcols,pver) :: qin ! ion-neutral heating + real(r8), dimension(pcols,pver) :: rho ! mass density + + real(r8), dimension(pcols,pver) :: wrk2 + + real(r8), dimension(teTiBot) :: subdiag ! subdiagonal values for Te tendency solving + real(r8), dimension(teTiBot) :: superdiag ! superdiagonal values for Te tendency solving + real(r8), dimension(teTiBot) :: diag ! diagonal values for Te tendency solving + real(r8), dimension(teTiBot) :: rHS ! RHS of electron temperature update + real(r8), dimension(teTiBot) :: tETemp ! temporary electron temperature array for input to tridag + + logical, dimension(pcols) :: colConv ! flag for column converging + logical :: converged ! Flag for convergence in electron temperature calculation iteration loop + + !--------------------------------------------------------------------------------------------------------- + ! Initialize arrays to zero and column convergence logical to .false. + !--------------------------------------------------------------------------------------------------------- + + sqrtTE(:) = 0._r8 + Ke(:) = 0._r8 + Kei(:) = 0._r8 + lossc4p(:,:) = 0._r8 + lossceN2(:,:) = 0._r8 + lossc6p(:,:) = 0._r8 + lossceO2(:,:) = 0._r8 + lossc8p(:,:) = 0._r8 + lossceO1(:,:) = 0._r8 + lossc10p(:,:) = 0._r8 + losscA(:,:) = 0._r8 + tENDiff(:,:) = 0._r8 + lossceN2v(:,:) = 0._r8 + lossc11p(:,:) = 0._r8 + lossceO2v(:,:) = 0._r8 + lossc12p(:,:) = 0._r8 + lossceOf(:,:) = 0._r8 + lossc14p(:,:) = 0._r8 + losscf2d(:,:) = 0._r8 + losscf2(:,:) = 0._r8 + losscf3(:,:) = 0._r8 + lossceO1D(:,:) = 0._r8 + lossc15p(:,:) = 0._r8 + lossceN2Rot(:,:) = 0._r8 + lossc16p(:,:) = 0._r8 + lossceO2Rot(:,:) = 0._r8 + lossc3p(:,:) = 0._r8 + losscei(:,:) = 0._r8 + losscin(:,:) = 0._r8 + lossg3(:,:) = 0._r8 + delZi(:,:) = 0._r8 + delZ(:,:) = 0._r8 + subDiag(:) = 0._r8 + superDiag(:) = 0._r8 + diag(:) = 0._r8 + rHS(:) = 0._r8 + teTemp(:) = 0._r8 + qjoule(:,:) = 0._r8 + qei(:,:) = 0._r8 + qen(:,:) = 0._r8 + qin(:,:) = 0._r8 + rho(:,:) = 0._r8 + dSETendOut = 0._r8 + colConv(:) = .false. + + !-------------------------------------------------------------------------------------- + ! Get lchnk and ncol from state + !-------------------------------------------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + + !------------------------------------------- + ! Calculate some commonly used variables + !------------------------------------------- + wrk1 = 2._r8 / 3._r8/ kboltz_ev + teTiBotP = teTiBot + 1 + + !------------------------------------------------------------------------------------------------------- + ! Need to get midpoint and interface pressure and neutral temperature from state structure (ncol,teTiBot) + !------------------------------------------------------------------------------------------------------- + pMid => state%pmid(1:ncol,1:pver) + tN => state%t(1:ncol,1:pver) + rho(1:ncol,1:pver) = pMid(1:ncol,1:pver)/rairv(1:ncol,1:pver,lchnk)/tN(1:ncol,1:pver) * 1.E-3_r8 ! convert to g/cm3 + + qjoule(1:ncol,1:teTiBot) = dSETendIn(1:ncol,1:teTiBot) * sToQConv ! convert from J/kg/s to ev/g/s + + pInt => state%pint(1:ncol,1:pverp) + tNInt => istate%tNInt(1:ncol,1:pverp) + rairvi => istate%rairvi(1:ncol,1:pverp) + + !---------------------------------------------------------------- + ! Get variables needed from the ionosphere state structure + !---------------------------------------------------------------- + ndensO2 => istate%ndensO2(1:ncol,1:pver) + ndensO1 => istate%ndensO1(1:ncol,1:pver) + ndensE => istate%ndensE(1:ncol,1:pver) + ndensOp => istate%ndensOp(1:ncol,1:pver) + ndensO2p => istate%ndensO2p(1:ncol,1:pver) + ndensNOp => istate%ndensNOp(1:ncol,1:pver) + ndensN2 => istate%ndensN2(1:ncol,1:pver) + + sourceg4 => istate%sourceg4(1:ncol,1:pver) + + dipMag => istate%dipMag(1:ncol,1:pver) + dipMagD => istate%dipMagD(1:ncol,1:pver) + + zenAngD => istate%zenAngD(1:ncol) + + !------------------------------------------------------------------------------------------------------------------- + ! Set electron temperature limits + !------------------------------------------------------------------------------------------------------------------- + tE(1:ncol,1:pver) = MAX(tN(1:ncol,1:pver),tE(1:ncol,1:pver)) + tE(1:ncol,1:pver) = MIN(temax,tE(1:ncol,1:pver)) + + tI(1:ncol,1:pver) = MAX(tN(1:ncol,1:pver),ti(1:ncol,1:pver)) + tI(1:ncol,1:pver) = MIN(ti(1:ncol,1:pver),tE(1:ncol,1:pver)) + + ! set Te and Ti to Tn below the levels where this module applies + tE(1:ncol,teTiBotP:pver) = tN(1:ncol,teTiBotP:pver) + tI(1:ncol,teTiBotP:pver) = tN(1:ncol,teTiBotP:pver) + + wrk2(1:ncol,1:teTiBot) = ndensE(1:ncol,1:teTiBot)/wrk1/(SIN(dipMag(1:ncol,1:teTiBot)))**2._r8 + + !----------------------------------------------------------------------------- + ! Get terms needed for loss term g3 for electron temperature update which do + ! not need to be updated in iteration loop. + !----------------------------------------------------------------------------- + do iCol = 1, ncol + + if (.not. colConv(iCol)) then + do iVer = 1, teTiBot + + lossc4p(iCol,iVer) = lossc4pCoef * ndensN2(iCol,iVer) * ndensE(iCol,iVer) ! e-N2 elastic collision + lossc6p(iCol,iVer) = lossc6pCoef * ndensO2(iCol,iVer) * ndensE(iCol,iVer) ! e-O2 elastic collision + lossc8p(iCol,iVer) = lossc8pCoef * ndensO1(iCol,iVer) * ndensE(iCol,iVer) ! e-O elastic collision + lossc10p(iCol,iVer) = lossc10pCoef * ndensN2(iCol,iVer) * ndensE(iCol,iVer) ! e-N2(vib) + lossc11p(iCol,iVer) = lossc11pCoef * ndensO2(iCol,iVer) * ndensE(iCol,iVer) ! e-O2(vib) + lossc12p(iCol,iVer) = lossc12pCoef * ndensO1(iCol,iVer) * ndensE(iCol,iVer) ! e-O (fine) + lossc14p(iCol,iVer) = lossc14pCoef * ndensO1(iCol,iVer) * ndensE(iCol,iVer) ! e-O(1D) + lossc15p(iCol,iVer) = lossc15pCoef * ndensN2(iCol,iVer) * ndensE(iCol,iVer) ! e-N2(rot) + lossc16p(iCol,iVer) = lossc16pCoef * ndensO2(iCol,iVer) * ndensE(iCol,iVer) ! e-O2(rot) + lossc3p(iCol,iVer) = lossc3pC1 * lossc3pC2 * (ndensOP(iCol,iVer) + & + 0.5_r8 * ndensO2P(iCol,iVer) + lossc3pC3 * ndensNOP(iCol,iVer)) * ndensE(iCol,iVer) ! e-i + + losscin(iCol,iVer) = (losscinCoef1*ndensN2(iCol,iVer) + losscinCoef2*ndensO2(iCol,iVer) & + + losscinCoef3*ndensO1(iCol,iVer)*SQRT(2._r8*tN(iCol,iVer)))*ndensOP(iCol,iVer) & + +(losscinCoef4*ndensN2(iCol,iVer) + losscinCoef5*ndensO2(iCol,iVer) & + + losscinCoef6*ndensO1(iCol,iVer))*ndensNOP(iCol,iVer) & + +(losscinCoef7*ndensN2(iCol,iVer) + losscinCoef8*ndensO2(iCol,iVer)*SQRT(tN(iCol,iVer)) & + + losscinCoef9*ndensO1(iCol,iVer)) * ndensO2P(iCol,iVer) + + + enddo !iVer loop + + !---------------------------------------------------------------------------------- + ! Calculate upper boundary heat flux + !---------------------------------------------------------------------------------- + if (ABS(dipMagD(iCol,1)) < 40.0_r8) FeDB = 0.5_r8 * & + (1._r8 + SIN(pi * (ABS(dipMagD(iCol,1)) - 20.0_r8) /40.0_r8)) + + if (ABS(dipMagD(iCol,1)) >= 40.0_r8) FeDB = 1._r8 + + FeD = FeDCoef1 * f107 * FeDB - FeDCoef2 * f107 + FeN = .5_r8 * FeD + !--------------------------------------------------- + ! Set upper boundary condition for right hand side + !--------------------------------------------------- + if (zenAngD(iCol) <= 80.0_r8) FeUB(iCol) = FeD + if (zenAngD(iCol) > 80.0_r8 .AND. zenAngD(iCol) < 100.0_r8) FeUB(iCol) = 0.5_r8 * (FeD + FeN) & + + 0.5_r8 * (FeD - FeN) * & + COS(pi * ((zenAngD(iCol) - 80.0_r8) / 20.0_r8)) + if (zenAngD(iCol) >= 100.0_r8) FeUB(iCol) = FeN + + !------------------------------------------------------------------------------------------ + ! Calculate thickness terms for vertical derivative + !------------------------------------------------------------------------------------------ + do iVer = 1, teTiBot + + delZ(iCol,iVer) = (pInt(iCol,iVer+1) - pInt(iCol,iVer)) * rairv(iCol,iVer,lchnk) * & + tN(iCol,iVer) / pMid(iCol,iVer) / gravit + + enddo + + do iVer = 2, teTiBotP ! Assuming teTiBotP < pverp + delZi(iCol,iVer) = (pMid(iCol,iVer) - pMid(iCol,iVer-1)) * rairvi(iCol,iVer) * & + tNInt(iCol,iVer) / pInt(iCol,iVer) / gravit + enddo + delZi(iCol,1) = 1.5_r8*delZi(iCol,2) - .5_r8*delZi(iCol,3) + + !---------------------------------------------------------- + ! Convert delZ variables from meters to centimeters + !---------------------------------------------------------- + delZi(iCol,1:teTiBotP) = delZi(iCol,1:teTiBotP)*100._r8 + delZ(iCol,1:teTiBot) = delZ(iCol,1:teTiBot)*100._r8 + + endif ! Column not converged + + enddo !iCol loop + + !------------------------------------------------------------------------------------------------------- + ! Iterate to calculate new electron temperature. + ! Time splitting is used: first solve the heating/cooling equation, then solve the diffusion equations. + ! Also, set convergence flag to false and iterate until true or 6 iterations, whichever comes first + !------------------------------------------------------------------------------------------------------- + converged = .false. + iter = 0 + do while (.not. converged .and. iter < maxIter) + + !-------------------------------------------------------------------------------------------------------- + ! Increment iteration loop counter and save electron temperature from previous iteration for convergence + ! test at end of interation loop. Also, take square root of electron temperature to be used later + !-------------------------------------------------------------------------------------------------------- + iter = iter + 1 + + tEPrevI(1:ncol,1:teTiBot) = tE(1:ncol,1:teTiBot) + + !-------------------------------------------------------------------------------------------------------- + ! Loop over columns then vertical levels and call tridiagonal solver for each column to get electron + ! temperature + !-------------------------------------------------------------------------------------------------------- + do iCol = 1, ncol + + if (.not. colConv(iCol)) then + + sqrtTE(1:teTiBot) = SQRT(tE(iCol,1:teTiBot)) + + do iVer = 1, teTiBot + + !----------------------------------------------------------------------------- + ! Get loss term g3 for electron temperature update. Need to calculate + ! constituent dependent loss terms which make up g3 + !----------------------------------------------------------------------------- + lossceN2(iCol,iVer) = lossc4p(iCol,iVer) * (1._r8 - lossc5 * tE(iCol,iVer)) * tE(iCol,iVer) + lossceO2(iCol,iVer) = lossc6p(iCol,iVer) * (1._r8 + lossc7 * sqrtTE(iVer)) * sqrtTE(iVer) + lossceO1(iCol,iVer) = lossc8p(iCol,iVer) * (1._r8 + lossc9 * tE(iCol,iVer)) * sqrtTE(iVer) + + if (tE(iCol,iVer) < 1000.0_r8) then + losscA(iCol,iVer) = losscACoef1 * EXP(losscACoef2 / tE(iCol,iVer)) + endif + if (tE(iCol,iVer) >= 1000.0_r8 .AND. tE(iCol,iVer) <= 2000.0_r8) then + losscA(iCol,iVer) = losscACoef3 * EXP(losscACoef4 / tE(iCol,iVer)) + endif + if (tE(iCol,iVer) > 2000.0_r8) then + losscA(iCol,iVer) = losscACoef5 * sqrtTE(iVer) * EXP(losscACoef6 / tE(iCol,iVer)) + endif + + tENDiff(iCol,iVer) = tE(iCol,iVer) - tN(iCol,iVer) + if (ABS(tENDiff(iCol,iVer)) < 0.1_r8) tENDiff(iCol,iVer) = 0.1_r8 + + lossceN2v(iCol,iVer) = lossc10p(iCol,iVer) * losscA(iCol,iVer) * & + (1._r8 - EXP(loss10pCoef * (1._r8 / tE(iCol,iVer) - 1._r8 / tN(iCol,iVer)))) / tENDiff(iCol,iVer) + lossceO2v(iCol,iVer) = lossc11p(iCol,iVer) * tE(iCol,iVer) * tE(iCol,iVer) + lossceOf(iCol,iVer) = lossc12p(iCol,iVer) * (1._r8 - lossc13 * tE(iCol,iVer)) * & + (lossc12pC1 + lossc12pC2 / tE(iCol,iVer)) / tN(iCol,iVer) + losscf2d(iCol,iVer) = losscf2dC1 + losscf2dC2 * (tE(iCol,iVer) - losscf2dC3) - & + losscf2dC4 * (tE(iCol,iVer) - losscf2dC3) * (tE(iCol,iVer) - losscf2dC5) + losscf2(iCol,iVer) = losscf2d(iCol,iVer) * (1._r8 / losscf2C1 - 1._r8 / tE(iCol,iVer)) + losscf3(iCol,iVer) = losscf3c1 * (1._r8 / tN(iCol,iVer) - 1._r8 / tE(iCol,iVer)) + lossceO1D(iCol,iVer) = lossc14p(iCol,iVer) * EXP(losscf2(iCol,iVer)) * & + (1._r8 - EXP(losscf3(iCol,iVer))) / tENDiff(iCol,iVer) + lossceN2Rot(iCol,iVer) = lossc15p(iCol,iVer) / sqrtTE(iVer) + lossceO2Rot(iCol,iVer) = lossc16p(iCol,iVer) / sqrtTE(iVer) + + losscei(iCol,iVer) = lossc3p(iCol,iVer) / tE(iCol,iVer)**1.5_r8 + + !------------------------------------------------ + ! Loss term: lossg3*tE/sin(I)^2 + !------------------------------------------------ + lossg3(iCol,iVer) = lossceN2(iCol,iVer) + lossceO2(iCol,iVer) + lossceO1(iCol,iVer) + lossceN2v(iCol,iVer) & + + lossceO2v(iCol,iVer) + lossceOf(iCol,iVer) + lossceO1D(iCol,iVer) & + + lossceN2Rot(iCol,iVer) + lossceO2Rot(iCol,iVer) + + enddo !iVer loop + + endif ! Column not converged + + enddo ! End of column loop + + !----------------------------------------------------- + ! Calculate thermal conductivity of electron gas + !----------------------------------------------------- + do iCol = 1, ncol + + if (.not. colConv(iCol)) then + + sqrtTE(1:teTiBot) = SQRT(tE(iCol,1:teTiBot)) + + do iVer = 1, teTiBot + + f1Ted1 = f1Ted1C1 * sqrtTE(iVer) - f1Ted1C2 * tE(iCol,iVer)**1.5_r8 + f1Ted2 = f1Ted2C1 + f1Ted2C2 * sqrtTE(iVer) + f1Ted3 = f1Ted3C1 * (1._r8 + f1Ted3C2 * tE(iCol,iVer)) + + f1Te = ndensN2(iCol,iVer) / ndensE(iCol,iVer) * f1Ted1 + ndensO2(iCol,iVer) / & + ndensE(iCol,iVer) * f1Ted2 + ndensO1(iCol,iVer) / ndensE(iCol,iVer) * f1Ted3 + + !----------------------------------------------------------------------------- + ! Calculate electron conductivity using parameters set in module and f1(Te) + !----------------------------------------------------------------------------- + Ke(iVer) = Kec1 * tE(iCol,iVer)**2.5_r8 / (1._r8 + Kec2 * tE(iCol,iVer)**2._r8 * f1Te) + + enddo !iVer loop + + !---------------------------------------------------------------------- + ! Get electron conductivity at interface levels to be used later + !---------------------------------------------------------------------- + do iVer = 2,teTiBot + Kei(iVer) = SQRT(Ke(iVer-1)*Ke(iVer)) + enddo + Kei(1) = 1.5_r8*Kei(2)-.5_r8*Kei(3) + Kei(teTiBotP) = 1.5_r8*Kei(teTiBot)-.5_r8*Kei(teTiBot-1) + + !------------------------------------------------------------------------------------------------------ + ! Derive subdiagonal, superdiagonal, and diagonal as input to solver for electron temperature tendency + !------------------------------------------------------------------------------------------------------ + do iVer = 2, teTiBot-1 + subDiag(iVer) = -Kei(iVer) / delZi(iCol,iVer) / delZ(iCol,iVer) + superDiag(iVer) = -Kei(iVer+1) / delZi(iCol,iVer+1) / delZ(iCol,iVer) + diag(iVer) = wrk2(iCol,iVer)/ztodt + (lossg3(iCol,iVer)+losscei(iCol,iVer))/SIN(dipMag(iCol,iVer))**2._r8 & + -subDiag(iVer)-superDiag(iVer) + rHS(iVer) = tE(iCol,iVer) * wrk2(iCol,iVer)/ztodt + sourceg4(iCol,iVer)/SIN(dipMag(iCol,iVer))**2._r8 & + +(lossg3(iCol,iVer)*tN(iCol,iVer)+losscei(iCol,iVer)*ti(iCol,iVer))/SIN(dipMag(iCol,iVer))**2._r8 + enddo !iVer loop + + !------------------------------------------------------------------------------------- + ! Calculate diagonal, superdiagonal, and right hand side upper boundary values + !------------------------------------------------------------------------------------- + superDiag(1) = -Kei(2) / delZi(iCol,2) / delZ(iCol,1) + diag(1) = wrk2(iCol,1)/ztodt - superDiag(1) + rHS(1) = tE(iCol,1) * wrk2(iCol,1) / ztodt - FeUB(iCol) / delZ(iCol,1) + + !--------------------------------------------------------------------------------------------- + ! Calculate subdiagonal, diagonal, superdiagonal, and right hand side lower boundary values + !--------------------------------------------------------------------------------------------- + subDiag(teTiBot) = -Kei(teTiBot) / delZi(iCol,teTiBot) / delZ(iCol,teTiBot) + superDiag(teTiBot) = -Kei(teTiBotP) / delZi(iCol,teTiBotP) / delZ(iCol,teTiBot) + diag(teTiBot) = wrk2(iCol,teTiBot)/ztodt & + + (lossg3(iCol,teTiBot)+losscei(iCol,teTiBot))/SIN(dipMag(iCol,teTiBot))**2._r8 & + - subDiag(teTiBot)-superDiag(teTiBot) + rHS(teTiBot) = tE(iCol,teTiBot) * wrk2(iCol,teTiBot)/ztodt & + + sourceg4(iCol,teTiBot)/SIN(dipMag(iCol,teTiBot))**2._r8 & + + (lossg3(iCol,teTiBot)*tN(iCol,teTiBot)+losscei(iCol,teTiBot)*ti(iCol,teTiBot)) & + / SIN(dipMag(iCol,teTiBot))**2._r8 - superDiag(teTiBot) * tN(iCol,teTiBotP) + + !------------------------------------------------- + ! Call solver to get electron temperature update + !------------------------------------------------- + call tridag(subDiag,diag,superDiag,rHS,tETemp,teTiBot) + + tE(iCol,1:teTiBot) = tETemp(1:teTiBot) + do iVer = 1,teTiBot + tE(iCol,iVer) = min(temax,tE(iCol,iVer)) + tE(iCol,iVer) = max(tN(iCol,iVer),tE(iCol,iVer)) + enddo + + !--------------------------------------------------------------------------------------------------------- + ! Calculate ion temperature from electron temperature, ion-neutral and electron-ion loss terms, neutral + ! temperature, mass density and joule heating. Set minimum value to neutral temperature and maximum + ! value to electron temperature for each column and vertical level + !--------------------------------------------------------------------------------------------------------- + do iVer = 1,teTiBot + ti(iCol,iVer) = (losscei(iCol,iVer) * tE(iCol,iVer) + losscin(iCol,iVer) * tN(iCol,iVer) + & + rho(iCol,iVer) * qjoule(iCol,iVer) * mbarv(iCol,iVer,lchnk) / (mbarv(iCol,iVer,lchnk)+rMassOp)) / & + (losscei(iCol,iVer) + losscin(iCol,iVer)) + ti(iCol,iVer) = max(tN(iCol,iVer),ti(iCol,iVer)) + ti(iCol,iVer) = min(tE(iCol,iVer),ti(iCol,iVer)) + enddo + + !-------------------------------------------------------------------------------------------------------- + ! Check for convergence which is a change of electron temperature ratio to previous loop for all levels + ! and columns of less than 0.05K. Had to modify this to do convergence check on each column since + ! checking all columns in a chunk gives different answers depending on number of tasks and tasks per node. + !-------------------------------------------------------------------------------------------------------- + if (ALL(ABS(tE(iCol,1:teTiBot) / tEPrevI(iCol,1:teTiBot) - 1._r8) < 0.05_r8)) then + + colConv(iCol) = .true. + + endif + + endif ! Column not converged + + enddo ! iCol loop + !-------------------------------------------------------------- + ! Check to see if all columns have converged and set flag + !-------------------------------------------------------------- + if (ALL(colConv(1:ncol))) converged = .true. + + enddo ! End of iteration loop + + !-------------------------------------------------------------------------------------------------------- + ! Calculate electron-neutral heating and electron-ion Coulomb heating. Then update dry static energy. + !-------------------------------------------------------------------------------------------------------- + do iVer = 1, teTiBot + do iCol = 1, ncol + sqrtTE(iVer) = SQRT(tE(iCol,iVer)) + lossceN2(iCol,iVer) = lossc4p(iCol,iVer) * (1._r8 - lossc5 * tE(iCol,iVer)) * tE(iCol,iVer) + lossceO2(iCol,iVer) = lossc6p(iCol,iVer) * (1._r8 + lossc7 * sqrtTE(iVer)) * sqrtTE(iVer) + lossceO1(iCol,iVer) = lossc8p(iCol,iVer) * (1._r8 + lossc9 * tE(iCol,iVer)) * sqrtTE(iVer) + enddo + enddo + + qen(1:ncol,1:teTiBot) = (lossceN2(1:ncol,1:teTiBot)+lossceO2(1:ncol,1:teTiBot)+lossceO1(1:ncol,1:teTiBot)+ & + lossceN2v(1:ncol,1:teTiBot)+lossceO2v(1:ncol,1:teTiBot)+lossceOf(1:ncol,1:teTiBot)+ & + lossceO1D(1:ncol,1:teTiBot)+lossceN2Rot(1:ncol,1:teTiBot)+lossceO2Rot(1:ncol,1:teTiBot))* & + (tE(1:ncol,1:teTiBot)-tN(1:ncol,1:teTiBot)) / rho(1:ncol,1:teTiBot) + qei(1:ncol,1:teTiBot) = losscei(1:ncol,1:teTiBot) * (tE(1:ncol,1:teTiBot)-ti(1:ncol,1:teTiBot)) / rho(1:ncol,1:teTiBot) + qin(1:ncol,1:teTiBot) = losscin(1:ncol,1:teTiBot) * (tI(1:ncol,1:teTiBot)-tN(1:ncol,1:teTiBot)) / rho(1:ncol,1:teTiBot) + + dSETendOut(1:ncol,1:teTiBot) = (qei(1:ncol,1:teTiBot)+qen(1:ncol,1:teTiBot)) / sToQConv + + call outfld ('QEN', qen, pcols, lchnk) + call outfld ('QEI', qei, pcols, lchnk) + call outfld ('QIN', qin, pcols, lchnk) + + return + + end subroutine update_teti + +!----------------------------------------------------------------------- +! Simple tridiagonal solver routine +!----------------------------------------------------------------------- + + SUBROUTINE tridag(a,b,c,r,u,n) + + INTEGER,INTENT(IN) :: n + REAL(r8),INTENT(IN) :: a(n),b(n),c(n),r(n) + REAL(r8),INTENT(INOUT) :: u(n) + !------------------------------ + ! Local variables + !------------------------------ + INTEGER j + REAL(r8) :: bet,gam(n) + + if(b(1).eq.0._r8) call endrun('ion_electron_temp: bt(1)=0 in tridag') + bet=b(1) + u(1)=r(1)/bet + do j=2,n + gam(j)=c(j-1)/bet + bet=b(j)-a(j)*gam(j) + if(bet.eq.0._r8) call endrun('ion_electron_temp: bet=0 in tridag') + u(j)=(r(j)-a(j)*u(j-1))/bet + end do + + do j=n-1,1,-1 + u(j)=u(j)-gam(j+1)*u(j+1) + end do + + return + + END SUBROUTINE tridag + +end module ion_electron_temp diff --git a/src/physics/waccmx/majorsp_diffusion.F90 b/src/physics/waccmx/majorsp_diffusion.F90 new file mode 100644 index 0000000000..bef8bffa82 --- /dev/null +++ b/src/physics/waccmx/majorsp_diffusion.F90 @@ -0,0 +1,858 @@ +module majorsp_diffusion + +!-------------------------------------------------------------------------- +! This module computes the diffusion of major species (O2 and O) mass mixing +! ratio. This routine computes both the molecular and eddy diffusivity. This +! is adapted from the major species diffusion calculation of TIME-GCM. +! +! Calling sequence: +! initialization: +! init +! call mspd_init +! +! interfacing: +! tphysac +! (after vertical_diffusion_tend) +! call mspd_intr +! call mspdiff +! +!---------------------------Code history-------------------------------- +! Adapted from TIME-GCM (comp.F): H.-L. Liu, Nov 2003 +!-------------------------------------------------------------------------- + + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use constituents, only: pcnst, cnst_name, cnst_get_ind, cnst_mw + use cam_history, only: outfld + + implicit none + + private ! Make default type private to the module + save +!----------------------- +! Public interfaces +!----------------------- + public mspd_init ! Initialization + public mspd_intr ! Full routine +!----------------------- +! Private data +!----------------------- + + real(r8) :: rmass_o2, rmass_o1, rmass_n2 ! molecular weight kg/kmol + real(r8) :: rmassinv_o2, rmassinv_o1, rmassinv_n2 ! 1/rmass_o2... + real(r8) :: phi(2,3) ! mutual diffusion constants of + ! major constituents + real(r8) :: delta(2,2) ! unit matrix + + real(r8), parameter :: t00=273._r8 ! reference temperature + real(r8), parameter :: ptref=5.e-5_r8 ! thermosphere reference pressure (Pa) + real(r8), parameter :: tau=1.86e3_r8 ! diffusive time constant (sec). + real(r8), parameter :: protonmass=1.6726e-27_r8 ! Proton mass (kg) + real(r8), parameter :: mmrMin=1.e-20_r8 ! lower limit of o2 and o mixing ratio + real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of o2, o, and h mixing ratios + + integer :: indx_O2 ! cnst index for o2 + integer :: indx_O ! cnst index for o + integer :: indx_H ! cnst index for h + integer, parameter :: io2=1, io1=2 ! local indices to o2 , o respectively + logical :: fixed_ubc(2) ! flag for fixed upper boundary condition + + real(r8) :: o2mmr_ubc(pcols) ! MMR of O2 at top boundary (specified) + real(r8) :: ommr_ubc(pcols) ! MMR of O at top boundary + + character(len=8), private :: mjdiffnam(2) ! names of v-diff tendencies + +contains + +!=============================================================================== + subroutine mspd_init() + + !------------------------------------------------------------------------------- + ! Define constants and coeficient matrices, phi and delta, in the initialization. + !------------------------------------------------------------------------------- + use constituents, only: cnst_mw, cnst_fixed_ubc + use cam_history, only: addfld, add_default + use phys_control, only: phys_getopts + + !------------------------------Arguments-------------------------------- + + !---------------------------Local storage------------------------------- + logical :: history_waccmx + + call phys_getopts(history_waccmx_out=history_waccmx) + + !----------------------------------------------------------- + ! Get required molecular weights + !----------------------------------------------------------- + call cnst_get_ind('O2', indx_O2, abort=.true.) + call cnst_get_ind('O', indx_O, abort=.true.) + call cnst_get_ind('H', indx_H, abort=.true.) + + rmass_o2 = cnst_mw(indx_O2) + rmass_o1 = cnst_mw(indx_O) + rmass_n2 = 28._r8 + + rmassinv_o2 = 1._r8/rmass_o2 + rmassinv_o1 = 1._r8/rmass_o1 + rmassinv_n2 = 1._r8/rmass_n2 + + !-------------------------------------------------------------------- + ! Get fixed upper boundary flags and set vertical range for diffusion + !-------------------------------------------------------------------- + fixed_ubc(io2) = cnst_fixed_ubc(indx_O2) + fixed_ubc(io1) = cnst_fixed_ubc(indx_O) + + !------------------------------------------------ + ! Set diffusion constants and setup matrix + !------------------------------------------------ + phi(:,1)=(/0._r8 ,0.673_r8/) + phi(:,2)=(/1.35_r8,0._r8 /) + phi(:,3)=(/1.11_r8,0.769_r8/) + delta(:,1)=(/1._r8,0._r8/) + delta(:,2)=(/0._r8,1._r8/) + + ! Set names of major diffusion tendencies and declare them as history variables + mjdiffnam(1) = 'MD'//cnst_name(indx_O2) + call addfld (mjdiffnam(1),(/ 'lev' /), 'A','kg/kg/s','Major diffusion of '//cnst_name(indx_O2)) + mjdiffnam(2) = 'MD'//cnst_name(indx_O) + call addfld (mjdiffnam(2),(/ 'lev' /), 'A','kg/kg/s','Major diffusion of '//cnst_name(indx_O)) + + call addfld ('MBARV' , (/ 'lev' /),'I','g/mole','Variable Mean Mass') + + if (history_waccmx) then + call add_default (mjdiffnam(1), 1, ' ') + call add_default (mjdiffnam(2), 1, ' ') + call add_default ('MBARV', 1, ' ') + end if + + end subroutine mspd_init + +!=============================================================================== + subroutine mspd_intr(ztodt ,state ,ptend) + +!------------------------------------------------------------------------------- +! interface routine. output tendency. +!------------------------------------------------------------------------------- + use physics_types, only: physics_state, physics_ptend + use upper_bc, only: ubc_get_vals + use physconst, only: rairv, mbarv + +!------------------------------Arguments-------------------------------- + real(r8), intent(in) :: ztodt ! 2 delta-t + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! indivdual parameterization tendencies +!---------------------------Local storage------------------------------- + real(r8) :: rztodt ! 1/ztodt + real(r8) :: tendo2o(pcols,pver,2) ! temporary array for o2 and o tendency + real(r8) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) + real(r8) :: ubc_t(pcols) ! upper bndy temperature (K) + real(r8) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i, k ! indexing integers + + !-------------------------------------------------------------------------------------------- + ! local constants + !-------------------------------------------------------------------------------------------- + rztodt = 1._r8/ztodt + lchnk = state%lchnk + ncol = state%ncol + + !---------------------------------------------------------------------------------------------- + ! Store the o2 and o tendencies calculated from vertical_diffusion (due to eddy diffusion only) + !---------------------------------------------------------------------------------------------- + tendo2o(:ncol,:,io2) = ptend%q(:ncol,:,indx_O2) + tendo2o(:ncol,:,io1) = ptend%q(:ncol,:,indx_O) + + !---------------------------------------------------------------------- + ! Operate on copies of the input states, convert to tendencies at end. + !---------------------------------------------------------------------- + ptend%q(:ncol,:,indx_O2) = state%q(:ncol,:,indx_O2) + ptend%q(:ncol,:,indx_O) = state%q(:ncol,:,indx_O) + + if (fixed_ubc(io2) .or. fixed_ubc(io1)) then + !------------------------------------------- + ! set upper boundary values of O2 and O MMR. + !------------------------------------------- + call ubc_get_vals( lchnk, ncol, state%pint, state%zi, state%t, state%q, & + state%omega, state%phis, ubc_t, ubc_mmr, ubc_flux ) + o2mmr_ubc(:ncol) = ubc_mmr(:ncol,indx_O2) + ommr_ubc(:ncol) = ubc_mmr(:ncol,indx_O) + endif + + ! Since this is a combined tendency, retain the old name for output + ! and debugging purposes. + ptend%name = trim(ptend%name)//"+mspd" + ptend%lq(indx_O2) = .TRUE. + ptend%lq(indx_O) = .TRUE. + !--------------------------------------------- + ! Call the major species diffusion subroutine. + !--------------------------------------------- + call mspdiff (lchnk ,ncol , & + state%t ,ptend%q ,state%pmid ,state%pint , & + state%pdel ,ztodt ,rairv(:,:,lchnk), mbarv(:,:,lchnk)) + + !--------------------------------------------- + ! Update O2 and O tendencies and output + !--------------------------------------------- + do k=1,pver + do i=1,ncol + ptend%q(i,k,indx_O2) = (ptend%q(i,k,indx_O2)-state%q(i,k,indx_O2))*rztodt & + +tendo2o(i,k,io2) + ptend%q(i,k,indx_O) = (ptend%q(i,k,indx_O)-state%q(i,k,indx_O))*rztodt & + +tendo2o(i,k,io1) + enddo + enddo + + call outfld(mjdiffnam(1),ptend%q(1,1,indx_O2),pcols,lchnk) + call outfld(mjdiffnam(2),ptend%q(1,1,indx_O),pcols,lchnk) + + end subroutine mspd_intr + + +!=============================================================================== + subroutine mspdiff (lchnk ,ncol , & + t ,q ,pmid ,pint , & + pdel ,ztodt ,rairv ,mbarv) +!----------------------------------------------------------------------- +! Driver routine to compute major species diffusion (O2 and O). + +! Turbulent diffusivities and boundary layer nonlocal transport terms are +! obtained from the turbulence module. +!---------------------------Arguments------------------------------------ + use ref_pres, only: lev0 => nbot_molec + use physconst, only: gravit + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: t(pcols,pver) ! temperature input + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures + real(r8), intent(in) :: pdel(pcols,pver) ! thickness between interfaces + real(r8), intent(in) :: ztodt ! 2 delta-t + real(r8), intent(in) :: rairv(pcols,pver) ! composition dependent gas "constant" + real(r8), intent(in) :: mbarv(pcols,pver) ! composition dependent mean mass + + real(r8), intent(inout) :: q(pcols,pver,pcnst) ! constituents + +!---------------------------Local storage------------------------------- + real(r8) :: o2(pcols,pver), o1(pcols,pver) ! o2, o1 mixing ratio (kg/kg moist air) + real(r8) :: h_atom(pcols,pver) ! H mixing ratio + real(r8) :: rztodt ! 1/ztodt + real(r8) :: dz(pcols,pver) ! log-pressure interval between interfaces + real(r8) :: rdz(pcols,pver) ! 1./dz, defined on midpoints + real(r8) :: dzmid(pcols,pverp) ! log-pressure interval between midpoints + real(r8) :: rdzmid(pcols,pverp) ! 1./dzmid, defined on interfaces + real(r8) :: ak(pcols,2,2,2) ! coefficient matrix "Alfa" + real(r8) :: ep(pcols,2,2) ! coefficient matrix + real(r8) :: difk(pcols,pverp) ! eddy diffusion normalized by scale height (1/sec) + real(r8) :: expzm(pcols,pver) ! exp(-z)=pmid/ptref + real(r8) :: expzi(pcols,pverp) ! exp(-z)=pint/ptref + real(r8) :: wks1(pcols) + real(r8) :: wks3(pcols),wks4(pcols) ! temporary working arrays + real(r8) :: psclht(pcols,pverp) ! pressure scale height + real(r8) :: p_ubc(pcols) ! extrapolated pressure at upper boundary level, pmid(1)^2=pmid(2)*p_ubc + real(r8) :: rair_ubc(pcols) ! extrapolated rair at upper boundary level + real(r8) :: mbar_ubc(pcols) ! extrapolated mbar at upper boundary level + real(r8) :: flb(pcols,2) ! lower boundary condition for o2 and o, now + ! calculated locally. + real(r8) :: fub(pcols,2) ! upper boundary condition for o2 and o, now + ! calculated locally. + real(r8) :: fk(pcols,2) ! temporary working array for rhs + real(r8) :: pk(pcols,2,2) ! temp array for coefficients on lower diagonal + real(r8) :: rk(pcols,2,2) ! temp array for coefficients on upper diagonal + real(r8) :: qk(pcols,2,2) ! temp array for coefficients on diagonal + real(r8) :: apk(2,2,pcols,pver) ! coefficients on lower diagonal + real(r8) :: ark(2,2,pcols,pver) ! coefficients on upper diagonal + real(r8) :: aqk(2,2,pcols,pver) ! coefficients on diagonal + real(r8) :: rfk(2,pcols,pver) ! rhs of the array equation + real(r8) :: betawk(2,2,pcols,pver) ! working arrays for blktri solver. + real(r8) :: gammawk(2,2,pcols,pver) ! working arrays for blktri solver. + real(r8) :: ywk(2,pcols,pver) ! working arrays for blktri solver. + real(r8) :: xwk(2,pcols,pver) ! working arrays for blktri solver. + integer :: nlevs ! number of levels + real(r8) :: t_ubc(pcols) ! Temperature at top boundary + integer :: i, k, km, kp, m, ktmp, isp, kk, kr + + !--------------------------------------------------- + ! Set vertical grid and get time step for diffusion + !--------------------------------------------------- + nlevs = lev0 + rztodt = 1._r8/ztodt + + !------------------------------------------------------ + ! Get species to diffuse and set upper/lower boundaries + !------------------------------------------------------ + o2(:ncol,:) = q(:ncol,:,indx_O2) + o1(:ncol,:) = q(:ncol,:,indx_O) + h_atom(:ncol,:) = q(:ncol,:,indx_H) + + flb(:ncol,1) = o2(:ncol,lev0+1) ! fixed lower boundary condition + flb(:ncol,2) = o1(:ncol,lev0+1) + if(fixed_ubc(io2).or.fixed_ubc(io1)) then + fub(:ncol,1) = o2mmr_ubc(:ncol) ! fixed upper boundary condition + fub(:ncol,2) = ommr_ubc(:ncol) + endif + + !------------------------------------------------------------------ + ! Get log-pressure intervals between midpoints and interface points + !------------------------------------------------------------------ + dz(:ncol,:) = pdel(:ncol,:)/pmid(:ncol,:) + rdz(:ncol,:) = 1._r8/dz(:ncol,:) + do k=2,pver + do i=1,ncol + dzmid(i,k) = (pmid(i,k)-pmid(i,k-1))/pint(i,k) + rdzmid(i,k) = 1._r8/dzmid(i,k) + enddo + enddo + do i=1,ncol + p_ubc(i) = pmid(i,1)*pmid(i,1)/pmid(i,2) + dzmid(i,1) = (pmid(i,1)-p_ubc(i))/pint(i,1) + rdzmid(i,1) = 1._r8/dzmid(i,1) + enddo + do i=1,ncol + dzmid(i,pverp) = dzmid(i,pver) + rdzmid(i,pverp) = 1._r8/dzmid(i,pverp) + enddo + + !------------------------------------------------------------------ + ! Get log-pressure intervals between midpoints and interface points + !------------------------------------------------------------------ + expzi(:ncol,:) = pint(:ncol,:)/ptref + expzm(:ncol,:) = pmid(:ncol,:)/ptref + + !------------------------------------------------------------------ + ! Get pressure scale height + !------------------------------------------------------------------ + do k=2,pver + do i=1,ncol + psclht(i,k) = .5_r8*(rairv(i,k)*t(i,k)+rairv(i,k-1)*t(i,k-1))/gravit + enddo + enddo + do i=1,ncol + rair_ubc(i) = 1.5_r8*rairv(i,1)-.5_r8*rairv(i,2) + t_ubc(i) = 1.5_r8*t(i,1)-.5_r8*t(i,2) + psclht(i,1) = .5_r8*(rairv(i,1)*t(i,1)+rair_ubc(i)*t_ubc(i))/gravit + psclht(i,pverp) = psclht(i,pver) + enddo + + !------------------------------------------------------------------ + ! Initialize scale height normalized eddy diffusion + !------------------------------------------------------------------ + do k=1,pverp + do i=1,ncol + difk(i,k) = 0._r8 ! eddy diffusion already calculated in vertical_diffusion + enddo + enddo + + call outfld ('MBARV', mbarv(:,:), pcols, lchnk) + + !------------------------------------------------------------------ + ! Set up mean mass working array + !------------------------------------------------------------------ + ! ep, ak at the interface level immediately below midpoint level nbot_molec + + ! WKS4 = .5*(DMBAR/DZ)/MBAR + do i=1,ncol + wks4(i) = (mbarv(i,lev0)-mbarv(i,lev0+1))/ & + (dzmid(i,lev0+1)*(mbarv(i,lev0+1)+mbarv(i,lev0))) + enddo + + !----------------------------------- + ! Calculate coefficient matrices + !----------------------------------- + km = 1 + kp = 2 + do i=1, ncol + ep(i,io2,kp) = 1._r8-(2._r8/(mbarv(i,lev0+1)+mbarv(i,lev0)))* & + (rmass_o2+(mbarv(i,lev0)-mbarv(i,lev0+1))*rdzmid(i,lev0+1)) + ep(i,io1,kp) = 1._r8-(2._r8/(mbarv(i,lev0+1)+mbarv(i,lev0)))* & + (rmass_o1+(mbarv(i,lev0)-mbarv(i,lev0+1))*rdzmid(i,lev0+1)) + enddo + + + do m=1,2 + do i=1,ncol + ak(i,io2,m,kp) = & + -delta(io2,m)*(phi(io1,3)+(phi(io1,io2)-phi(io1,3))* & + .5_r8*(o2(i,lev0+1)+o2(i,lev0)))-(1._r8-delta(io2,m))* & + (phi(io2,m)-phi(io2,3))*.5_r8*(o2(i,lev0+1)+o2(i,lev0)) + ak(i,io1,m,kp) = & + -delta(io1,m)*(phi(io2,3)+(phi(io2,io1)-phi(io2,3))* & + .5_r8*(o1(i,lev0+1)+o1(i,lev0)))-(1._r8-delta(io1,m))* & + (phi(io1,m)-phi(io1,3))*.5_r8*(o1(i,lev0+1)+o1(i,lev0)) + enddo + enddo +! +! WKS1=MBAR/M3*(T00/(T0+T))*0.25/(TAU*DET(ak)) ak at the interface level +! immediately below midpoint level nbot_molec. + do i=1,ncol + wks1(i) = 0.5_r8*(mbarv(i,lev0+1)+mbarv(i,lev0))*rmassinv_n2* & + (2._r8*t00/(t(i,lev0+1)+t(i,lev0)))**0.25_r8/ & + (tau*(ak(i,1,1,kp)*ak(i,2,2,kp)-ak(i,1,2,kp)*ak(i,2,1,kp))) + enddo +! +! Complete calculation of ak at the interface level immediately below midpoint +! level nbot_molec. + do m=1,2 + do i=1,ncol + ak(i,io2,m,kp) = ak(i,io2,m,kp)*wks1(i) + ak(i,io1,m,kp) = ak(i,io1,m,kp)*wks1(i) + enddo + enddo + + km = 1 + kp = 2 + do k=lev0,2,-1 + ktmp = km + km = kp + kp = ktmp + do i=1,ncol + ep(i,io2,kp) = 1._r8-(2._r8/(mbarv(i,k)+mbarv(i,k-1)))*(rmass_o2+ & + (mbarv(i,k-1)-mbarv(i,k))*rdzmid(i,k)) + ep(i,io1,kp) = 1._r8-(2._r8/(mbarv(i,k)+mbarv(i,k-1)))*(rmass_o1+ & + (mbarv(i,k-1)-mbarv(i,k))*rdzmid(i,k)) + enddo + + do m=1,2 + do i=1,ncol + ak(i,io2,m,kp) = & + -delta(io2,m)*(phi(io1,3)+(phi(io1,io2)-phi(io1,3))* & + .5_r8*(o2(i,k)+o2(i,k-1)))- & + (1._r8-delta(io2,m))*(phi(io2,m)-phi(io2,3))* & + .5_r8*(o2(i,k)+o2(i,k-1)) + + ak(i,io1,m,kp) = & + -delta(io1,m)*(phi(io2,3)+(phi(io2,io1)-phi(io2,3))* & + .5_r8*(o1(i,k)+o1(i,k-1)))- & + (1._r8-delta(io1,m))*(phi(io1,m)-phi(io1,3))* & + .5_r8*(o1(i,k)+o1(i,k-1)) + + enddo + enddo + + !--------------------------------------------- + ! Calculate coefficients for diagonals and rhs + !--------------------------------------------- +! +! WKS1=MBAR/M3*(T00/(T0+T))**0.25/(TAU*DET(ALFA)) + do i=1,ncol + wks1(i) = 0.5_r8*(mbarv(i,k)+mbarv(i,k-1))*rmassinv_n2* & + (2._r8*t00/(t(i,k)+t(i,k-1)))**0.25_r8/ & + (tau*(ak(i,1,1,kp)*ak(i,2,2,kp)-ak(i,1,2,kp)*ak(i,2,1,kp))) + wks3(i) = wks4(i) + wks4(i) = (mbarv(i,k-1)-mbarv(i,k))/ & + (dzmid(i,k)*(mbarv(i,k)+mbarv(i,k-1))) + enddo + +! +! FINISH CALCULATING AK(K+1/2) AND GENERATE PK, QK, RK + do m=1,2 + do isp=io2,io1 + do i=1,ncol + ak(i,isp,m,kp) = ak(i,isp,m,kp)*wks1(i) + + pk(i,isp,m) = (ak(i,isp,m,km)*(rdzmid(i,k+1)+ep(i,m,km)/2._r8)- & + expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)- & + wks3(i))*delta(isp,m))*rdz(i,k) + + rk(i,isp,m) = (ak(i,isp,m,kp)*(rdzmid(i,k)-ep(i,m,kp)/2._r8)- & + expzi(i,k)*difk(i,k)*(rdzmid(i,k)+ & + wks4(i))*delta(isp,m))*rdz(i,k) + + qk(i,isp,m) = -(ak(i,isp,m,km)*(rdzmid(i,k+1)-ep(i,m,km)/2._r8)+ & + ak(i,isp,m,kp)*(rdzmid(i,k)+ep(i,m,kp)/2._r8))*rdz(i,k)+ & + ((expzi(i,k)*difk(i,k)*(rdzmid(i,k)-wks4(i))+ & + expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)+wks3(i)))* & + rdz(i,k)+expzm(i,k)*rztodt)*delta(isp,m) + + enddo + enddo + enddo + + do i=1,ncol + fk(i,io2) = expzm(i,k)*o2(i,k)*rztodt + fk(i,io1) = expzm(i,k)*o1(i,k)*rztodt + enddo + + !---------------------------- + ! Lower boundary + !---------------------------- + if (k==lev0) then + do m=1,2 + do i=1,ncol + fk(i,io2) = fk(i,io2)-pk(i,io2,m)*flb(i,m) + fk(i,io1) = fk(i,io1)-pk(i,io1,m)*flb(i,m) + pk(i,:,m) = 0._r8 + enddo + enddo + endif + + kr = lev0-k+1 + + do i=1,ncol + do m=1,2 + do kk=1,2 + apk(kk,m,i,kr) = pk(i,kk,m) + aqk(kk,m,i,kr) = qk(i,kk,m) + ark(kk,m,i,kr) = rk(i,kk,m) + enddo + enddo + enddo + + do i=1,ncol + rfk(io2,i,kr) = fk(i,io2) + rfk(io1,i,kr) = fk(i,io1) + enddo + + enddo + + !---------------------------- + ! Upper boundary + !---------------------------- + k=1 + ktmp = km + km = kp + kp = ktmp + if(fixed_ubc(io2).or.fixed_ubc(io1)) then + do i=1,ncol + mbar_ubc(i) = 1._r8/(o2mmr_ubc(i)*rmassinv_o2+ommr_ubc(i)*rmassinv_o1+ & + (1._r8-o2mmr_ubc(i)-ommr_ubc(i))*rmassinv_n2) + ep(i,io2,kp) = 1._r8-(2._r8/(mbarv(i,k)+mbar_ubc(i)))*(rmass_o2+ & + (mbar_ubc(i)-mbarv(i,k))*rdzmid(i,k)) + ep(i,io1,kp) = 1._r8-(2._r8/(mbarv(i,k)+mbar_ubc(i)))*(rmass_o1+ & + (mbar_ubc(i)-mbarv(i,k))*rdzmid(i,k)) + enddo + + do m=1,2 + do i=1,ncol + ak(i,io2,m,kp) = & + -delta(io2,m)*(phi(io1,3)+(phi(io1,io2)-phi(io1,3))* & + .5_r8*(o2(i,k)+o2mmr_ubc(i)))- & + (1._r8-delta(io2,m))*(phi(io2,m)-phi(io2,3))* & + .5_r8*(o2(i,k)+o2mmr_ubc(i)) + + ak(i,io1,m,kp) = & + -delta(io1,m)*(phi(io2,3)+(phi(io2,io1)-phi(io2,3))* & + .5_r8*(o1(i,k)+ommr_ubc(i)))- & + (1._r8-delta(io1,m))*(phi(io1,m)-phi(io1,3))* & + .5_r8*(o1(i,k)+ommr_ubc(i)) + + enddo + enddo + +! +! WKS1=MBAR/M3*(T00/(T0+T))**0.25/(TAU*DET(ALFA)) + do i=1,ncol + wks1(i) = 0.5_r8*(mbarv(i,k)+mbar_ubc(i))*rmassinv_n2* & + (2._r8*t00/(t(i,k)+t_ubc(i)))**0.25_r8/ & + (tau*(ak(i,1,1,kp)*ak(i,2,2,kp)-ak(i,1,2,kp)*ak(i,2,1,kp))) + wks3(i) = wks4(i) + wks4(i) = (mbar_ubc(i)-mbarv(i,k))/ & + (dzmid(i,k)*(mbarv(i,k)+mbar_ubc(i))) + enddo + +! +! FINISH CALCULATING AK(K+1/2) AND GENERATE PK, QK, RK + do m=1,2 + do isp=io2,io1 + do i=1,ncol + ak(i,isp,m,kp) = ak(i,isp,m,kp)*wks1(i) + + pk(i,isp,m) = (ak(i,isp,m,km)*(rdzmid(i,k+1)+ep(i,m,km)/2._r8)- & + expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)- & + wks3(i))*delta(isp,m))*rdz(i,k) + + rk(i,isp,m) = (ak(i,isp,m,kp)*(rdzmid(i,k)-ep(i,m,kp)/2._r8)- & + expzi(i,k)*difk(i,k)*(rdzmid(i,k)+ & + wks4(i))*delta(isp,m))*rdz(i,k) + + qk(i,isp,m) = -(ak(i,isp,m,km)*(rdzmid(i,k+1)-ep(i,m,km)/2._r8)+ & + ak(i,isp,m,kp)*(rdzmid(i,k)+ep(i,m,kp)/2._r8))*rdz(i,k)+ & + ((expzi(i,k)*difk(i,k)*(rdzmid(i,k)-wks4(i))+ & + expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)+wks3(i)))* & + rdz(i,k)+expzm(i,k)*rztodt)*delta(isp,m) + + enddo + enddo + enddo + + do i=1,ncol + fk(i,io2) = expzm(i,k)*o2(i,k)*rztodt + fk(i,io1) = expzm(i,k)*o1(i,k)*rztodt + enddo + do m=1,2 + do i=1,ncol + fk(i,io2) = fk(i,io2)-rk(i,io2,m)*fub(i,m) + fk(i,io1) = fk(i,io1)-rk(i,io1,m)*fub(i,m) + rk(i,:,m) = 0._r8 + enddo + enddo + + else + + do i=1,ncol + wks3(i) = wks4(i) + enddo + do m=1,2 + do isp=io2,io1 + do i=1,ncol + pk(i,isp,m) = (ak(i,isp,m,km)*(rdzmid(i,k+1)+ep(i,m,km)/2._r8)- & + expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)- & + wks3(i))*delta(isp,m))*rdz(i,k) + + qk(i,isp,m) = -(ak(i,isp,m,km)*(rdzmid(i,k+1)-ep(i,m,km)/2._r8)) & + *rdz(i,k)+ & + (expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)+wks3(i))* & + rdz(i,k)+expzm(i,k)*rztodt)*delta(isp,m) + + enddo + enddo + enddo + + do i=1,ncol + fk(i,io2) = expzm(i,k)*o2(i,k)*rztodt + fk(i,io1) = expzm(i,k)*o1(i,k)*rztodt + enddo + + endif + + kr = lev0-k+1 + + do i=1,ncol + do m=1,2 + do kk=1,2 + apk(kk,m,i,kr) = pk(i,kk,m) + aqk(kk,m,i,kr) = qk(i,kk,m) + ark(kk,m,i,kr) = rk(i,kk,m) + enddo + enddo + enddo + + do i=1,ncol + rfk(io2,i,kr) = fk(i,io2) + rfk(io1,i,kr) = fk(i,io1) + enddo + + !------------------------------------ + ! Call solver to get diffused species + !------------------------------------ + call blktri(apk,aqk,ark,rfk,pcols,1,ncol,pver,1,nlevs, & + betawk, gammawk, ywk, xwk) + + do k=lev0,1,-1 + kr = lev0-k+1 + do i=1,ncol + o2(i,k) = xwk(1,i,kr) + o1(i,k) = xwk(2,i,kr) + enddo + enddo + + !--------------------------------------------------------------- + ! Ensure non-negative O2 and O and check for N2 greater than one + !--------------------------------------------------------------- + do i=1,ncol + do k=1,lev0 + + if (o2(i,k) < mmrMin) o2(i,k) = mmrMin + if (o1(i,k) < mmrMin) o1(i,k) = mmrMin + + if(1._r8-mmrMin-o2(i,k)-o1(i,k)-h_atom(i,k) < 0._r8) then + o2(i,k) = o2(i,k)*((1._r8-N2mmrMin-h_atom(i,k))/(o2(i,k)+o1(i,k))) + o1(i,k) = o1(i,k)*((1._r8-N2mmrMin-h_atom(i,k))/(o2(i,k)+o1(i,k))) + endif + enddo + enddo + + q(:ncol,:,indx_O2) = o2(:ncol,:) + q(:ncol,:,indx_O) = o1(:ncol,:) + + end subroutine mspdiff + + +!=============================================================================== + SUBROUTINE BLKTRI(A,B,C,F,IF,I1,I2,KF,K1,K2,BETA,GAMMA,Y,X) + implicit none +! **** +! **** This procedure solves (I2-I1+1) tridiagonal block matrix +! **** systems in which all blocks are 2 x 2 matrices. +! **** +! **** Each system may be written: +! **** +! **** A(K) * X(K-1) + B(K) * X(K) + Z(K) * X(K+1) = F(K) +! **** +! **** where: +! **** +! **** K = K1,K2,1 +! **** +! **** A(K), B(K), C(K) are given (2 x 2) matrices. +! **** +! **** The F(k) are given two componente vectors. +! **** +! **** The system is to be solved for the two component +! **** vectors, X(K). +! **** +! **** A(K1) = C(K2) = 0. +! **** +! **** BETA(K), GAMMA(K), (K = K1,K2,1), are work space for +! **** (2 x 2) matrices. +! **** +! **** Y(K), (K = K1,K2,1), is work space for two component +! **** vectors. +! **** +! **** Algorithm: (See Isaacson and Keller p55) +! **** +! **** Forward sweep from K = K1 to K = K2: +! **** +! **** BETA(K1) = B(K1)**(-1) +! **** +! **** Y(K1) = BETA(K1)*F(K1) +! **** +! **** GAMMA(K) = BETA(K)*C(K), K = K1,(K2-1),1 +! **** +! **** BETA(K) = (B(K) - A(K)*GAMMA(K-1))**(-1), +! **** K = K1+1,K2,1 +! **** +! **** Y(K) = BETA(K)*(F(K) - A(K)*Y(K-1)), +! **** K = K1+1,K2,1 +! **** +! **** Backward sweep, K = K2,K1,-1 +! **** +! **** X(K2) = Y(K2) +! **** +! **** X(K) = Y(K) - GAMMA(K)*X(K+1), K = K2-1,K1,-1 +! **** +! **** Dimension statements: +! **** +! **** Block matrices are dimensioned thus: +! **** +! **** MATRIX(2,2,IF,KF) +! **** +! **** Two component vectors are similarly treated: +! **** +! **** VECTOR(2,IF,KF) +! **** +! **** Our block matrix scheme spans the range, (K = K1,K2,1), +! **** where (1 .LE. K1 .LT. K2 .LE. KF) +! **** +! **** Similarly, we are solving (I1-I2+1) systems +! **** simultaneously as the index, I, spans the range, +! **** (I = I1,I2,1), where (1 .LE. I1 .LT. I2 .LE. IF) +! **** +! **** +! **** Dimension statements: +! SUBROUTINE BLKTRI(A,B,C,F,IF,I1,I2,KF,K1,K2,BETA,GAMMA,Y,X) +! **** +! Args: + integer,intent(in) :: if,i1,i2,kf,k1,k2 + real(r8),intent(in) :: a(2,2,if,kf), b(2,2,if,kf), c(2,2,if,kf), & + f(2,if,kf) + real(r8),intent(out) :: beta(2,2,if,kf), gamma(2,2,if,kf), & + y(2,if,kf), x(2,if,kf) +! +! DIMENSION A(2,2,IF,KF), B(2,2,IF,KF), C(2,2,IF,KF), F(2,IF,KF), +! 1 BETA(2,2,IF,KF), GAMMA(2,2,IF,KF), Y(2,IF,KF), X(2,IF,KF) +! +! Local: + integer :: i,k +! **** +! **** Lower boundary at K = K1 +! **** + DO I = I1,I2 +! **** +! **** Y(1,I,K1) = determinant(B(K1)) +! **** + Y(1,I,K1) = B(1,1,I,K1)*B(2,2,I,K1) - B(1,2,I,K1)*B(2,1,I,K1) +! **** +! **** BETA(K1) = B(K1)**(-1) +! **** + BETA(1,1,I,K1) = B(2,2,I,K1)/Y(1,I,K1) + BETA(1,2,I,K1) = -B(1,2,I,K1)/Y(1,I,K1) + BETA(2,1,I,K1) = -B(2,1,I,K1)/Y(1,I,K1) + BETA(2,2,I,K1) = B(1,1,I,K1)/Y(1,I,K1) +! **** +! **** Y(K1) = BETA(K1)*F(K1) +! **** + Y(1,I,K1) = BETA(1,1,I,K1)*F(1,I,K1) + BETA(1,2,I,K1)*F(2,I,K1) + Y(2,I,K1) = BETA(2,1,I,K1)*F(1,I,K1) + BETA(2,2,I,K1)*F(2,I,K1) + ENDDO +! **** +! **** Now deal with levels (K1+1),K2,1 +! **** + DO K = K1+1,K2 + DO I = I1,I2 +! **** +! **** GAMMA(K-1) = BETA(K-1)*C(K-1) +! **** + GAMMA(1,1,I,K-1) = BETA(1,1,I,K-1)*C(1,1,I,K-1) + & + BETA(1,2,I,K-1)*C(2,1,I,K-1) + GAMMA(1,2,I,K-1) = BETA(1,1,I,K-1)*C(1,2,I,K-1) + & + BETA(1,2,I,K-1)*C(2,2,I,K-1) + GAMMA(2,1,I,K-1) = BETA(2,1,I,K-1)*C(1,1,I,K-1) + & + BETA(2,2,I,K-1)*C(2,1,I,K-1) + GAMMA(2,2,I,K-1) = BETA(2,1,I,K-1)*C(1,2,I,K-1) + & + BETA(2,2,I,K-1)*C(2,2,I,K-1) +! **** +! **** GAMMA(K) = B(K) - A(K)*GAMMA(K-1) +! **** + GAMMA(1,1,I,K) = B(1,1,I,K) - A(1,1,I,K)*GAMMA(1,1,I,K-1) - & + A(1,2,I,K)*GAMMA(2,1,I,K-1) + GAMMA(1,2,I,K) = B(1,2,I,K) - A(1,1,I,K)*GAMMA(1,2,I,K-1) - & + A(1,2,I,K)*GAMMA(2,2,I,K-1) + GAMMA(2,1,I,K) = B(2,1,I,K) - A(2,1,I,K)*GAMMA(1,1,I,K-1) - & + A(2,2,I,K)*GAMMA(2,1,I,K-1) + GAMMA(2,2,I,K) = B(2,2,I,K) - A(2,1,I,K)*GAMMA(1,2,I,K-1) - & + A(2,2,I,K)*GAMMA(2,2,I,K-1) +! **** +! **** Y(1,I,K) = determinant(GAMMA(K)) +! **** + Y(1,I,K) = GAMMA(1,1,I,K)*GAMMA(2,2,I,K) - & + GAMMA(1,2,I,K)*GAMMA(2,1,I,K) +! **** +! **** BETA(K) = GAMMA(K)**(-1) +! **** + BETA(1,1,I,K) = GAMMA(2,2,I,K)/Y(1,I,K) + BETA(1,2,I,K) = -GAMMA(1,2,I,K)/Y(1,I,K) + BETA(2,1,I,K) = -GAMMA(2,1,I,K)/Y(1,I,K) + BETA(2,2,I,K) = GAMMA(1,1,I,K)/Y(1,I,K) +! **** +! **** X(K) = F(K) - A(K)*Y(K-1) +! **** + X(1,I,K) = F(1,I,K) - A(1,1,I,K)*Y(1,I,K-1) - & + A(1,2,I,K)*Y(2,I,K-1) + X(2,I,K) = F(2,I,K) - A(2,1,I,K)*Y(1,I,K-1) - & + A(2,2,I,K)*Y(2,I,K-1) +! **** +! **** Y(K) = BETA(K)*X(K) +! **** + Y(1,I,K) = BETA(1,1,I,K)*X(1,I,K) + BETA(1,2,I,K)*X(2,I,K) + Y(2,I,K) = BETA(2,1,I,K)*X(1,I,K) + BETA(2,2,I,K)*X(2,I,K) + ENDDO + ENDDO +! **** +! **** Backward sweep to determine final solution, X(K) for +! **** K = K2,K1,-1 +! **** +! **** X(K2) = Y(K2) +! **** + DO I = I1,I2 + X(1,I,K2) = Y(1,I,K2) + X(2,I,K2) = Y(2,I,K2) + ENDDO +! **** +! **** X(K) = Y(K) - GAMMA(K)*X(K+1) +! **** + DO K = K2-1,K1,-1 + DO I = I1,I2 + X(1,I,K) = Y(1,I,K) - GAMMA(1,1,I,K)*X(1,I,K+1) - & + GAMMA(1,2,I,K)*X(2,I,K+1) + X(2,I,K) = Y(2,I,K) - GAMMA(2,1,I,K)*X(1,I,K+1) - & + GAMMA(2,2,I,K)*X(2,I,K+1) + + ENDDO + ENDDO + RETURN + END SUBROUTINE BLKTRI + +end module majorsp_diffusion diff --git a/src/unit_drivers/aur/unit_driver.F90 b/src/unit_drivers/aur/unit_driver.F90 new file mode 100644 index 0000000000..8c9c5e9df2 --- /dev/null +++ b/src/unit_drivers/aur/unit_driver.F90 @@ -0,0 +1,157 @@ +!================================================================================ +! aurora unit test driver +!================================================================================ +module unit_driver + + use shr_kind_mod, only: r8=>SHR_KIND_R8 + use ppgrid, only: pcols, pver, begchunk, endchunk + + implicit none + private + save + + public :: unit_driver_init + public :: unit_driver_run + +contains + + !============================================================================== + !============================================================================== + subroutine unit_driver_init + use cam_history, only : addfld, horiz_only + + call addfld( 'Tempr', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'O2vmr', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'O1vmr', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'qo2p', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'qop', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'qn2p', (/ 'lev' /), 'I', '/s ', ' ') + call addfld( 'qnp', (/ 'lev' /), 'I', '/s ', ' ') + + call addfld('BNORTH',horiz_only, 'I','GAUSS', 'Northward component of magnetic field') + call addfld('BEAST', horiz_only, 'I','GAUSS', 'Eastward component of magnetic field') + call addfld('BDOWN', horiz_only, 'I','GAUSS', 'Downward component of magnetic field') + call addfld('BMAG', horiz_only, 'I','GAUSS', 'Magnetic field magnitude') + + call addfld('D1VEC', horiz_only, 'I', ' ', ' ') + call addfld('D2VEC', horiz_only, 'I', ' ', ' ') + + end subroutine unit_driver_init + + !============================================================================== + !============================================================================== + subroutine unit_driver_run(indata, phys_state, pbuf2d, cam_out, cam_in, recno) + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use camsrfexch, only: cam_out_t, cam_in_t + use drv_input_data, only: drv_input_data_t + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk + use shr_const_mod, only: shr_const_cpdair + use time_manager, only: get_curr_calday + use physconst, only: mwdry + + use mo_aurora, only: aurora_timestep_init, aurora + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use ref_pres, only: pref_mid + use drv_input_data, only: drv_input_data_read + use cam_history, only: outfld + use mo_apex, only: bnorth, beast, bdown, bmag + use mo_apex, only: d1vec, d2vec + + type(drv_input_data_t), intent(inout) :: indata + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: recno + + real(r8) :: mbar(pcols,pver,begchunk:endchunk) + real(r8) :: tfld(pcols,pver,begchunk:endchunk) + real(r8) :: o1vmr(pcols,pver,begchunk:endchunk) + real(r8) :: o2vmr(pcols,pver,begchunk:endchunk) + real(r8) :: o1mmr(pcols,pver) + real(r8) :: o2mmr(pcols,pver) + real(r8) :: press(pcols,pver) + + real(r8) :: rlats(pcols) + real(r8) :: rlons(pcols) + + real(r8) :: qo2p(pcols,pver) + real(r8) :: qop(pcols,pver) + real(r8) :: qn2p(pcols,pver) + real(r8) :: qnp(pcols,pver) + + + real(r8) :: calday + + integer :: c, ncol, k + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),parameter :: mwo1 = 16._r8 + real(r8),parameter :: mwo2 = 32._r8 + + real(r8) :: aur_hrate(pcols,pver) ! chunk auroral heating rate + real(r8) :: cpair(pcols,pver) ! specific heat capacity (J/K/kg) + + tfld = drv_input_data_read(indata, 'T', 'lev', pver, recno, abort=.true.) + o1vmr = drv_input_data_read(indata, 'O', 'lev', pver, recno, abort=.true.) + o2vmr = drv_input_data_read(indata, 'O2', 'lev', pver, recno, abort=.true.) + + mbar = mwdry + + call aurora_timestep_init + + do k=1,pver + press(:,k) = pref_mid(k) + enddo + + !----------------------------------------------------------------------- + ! get current calendar day of year + !----------------------------------------------------------------------- + calday = get_curr_calday( ) + + cpair(:,:) = shr_const_cpdair + +!$OMP PARALLEL DO PRIVATE ( c, pbuf, ncol, rlats, rlons,qo2p,qop,qn2p,qnp ) + do c=begchunk,endchunk + + ncol = phys_state(c)%ncol + + o1mmr(:ncol,:) = o1vmr(:ncol,:,c)*mwo1/mwdry + o2mmr(:ncol,:) = o2vmr(:ncol,:,c)*mwo2/mwdry + + call get_rlat_all_p( c, ncol, rlats(:ncol) ) + call get_rlon_all_p( c, ncol, rlons(:ncol) ) + + pbuf => pbuf_get_chunk(pbuf2d, c) + + call aurora( tfld(:pcols,:,c), o2mmr(:ncol,:), o1mmr(:ncol,:), mbar(:ncol,:,c), rlats(:ncol), & + qo2p(:ncol,:),qop(:ncol,:),qn2p(:ncol,:),qnp(:ncol,:), & + press(:,:), c, calday, ncol, rlons(:ncol), pbuf ) + + call outfld( 'Tempr', tfld(:ncol,:,c), ncol, c ) + call outfld( 'O2vmr', o2vmr(:ncol,:,c), ncol, c ) + call outfld( 'O1vmr', o1vmr(:ncol,:,c), ncol, c ) + call outfld( 'qo2p', qo2p(:ncol,:), ncol, c ) + call outfld( 'qop', qop (:ncol,:), ncol, c ) + call outfld( 'qn2p', qn2p(:ncol,:), ncol, c ) + call outfld( 'qnp', qnp (:ncol,:), ncol, c ) + + call outfld('BNORTH', bnorth(:ncol,c), ncol, c ) + call outfld('BEAST', beast(:ncol,c), ncol, c ) + call outfld('BDOWN', bdown(:ncol,c), ncol, c ) + call outfld('BMAG', bmag(:ncol,c), ncol, c ) + call outfld('D1VEC', d1vec(1,:ncol,c), ncol, c ) + call outfld('D2VEC', d2vec(1,:ncol,c), ncol, c ) + + call aurora( tfld(:pcols,:,c), o2mmr(:ncol,:), o1mmr(:ncol,:), mbar(:ncol,:,c), rlats(:ncol), & + aur_hrate(:ncol,:), cpair(:ncol,:), & + press(:,:), c, calday, ncol, rlons(:ncol) ) + + call outfld( 'QRS_AUR', aur_hrate(:ncol,:), ncol, c ) + + end do + + end subroutine unit_driver_run + +end module unit_driver diff --git a/src/unit_drivers/drv_input_data.F90 b/src/unit_drivers/drv_input_data.F90 new file mode 100644 index 0000000000..62782ae087 --- /dev/null +++ b/src/unit_drivers/drv_input_data.F90 @@ -0,0 +1,319 @@ +!================================================================================ +! utility module for driver input data +!================================================================================ +module drv_input_data + + use shr_kind_mod, only: r8=>SHR_KIND_R8, cl=>SHR_KIND_CL, cs=>SHR_KIND_CS + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use cam_logfile, only: iulog + use pio, only: file_desc_t + use time_manager, only: get_step_size + + implicit none + private + save + + public :: drv_input_data_open + public :: drv_input_data_read + public :: drv_input_data_close + public :: drv_input_data_freq + public :: drv_input_data_t + public :: drv_input_data_get + + public :: drv_input_4d_t + public :: drv_input_3d_t + public :: drv_input_2d_t + public :: drv_input_2di_t + + interface drv_input_data_get + module procedure get_data3d + module procedure get_data2d + module procedure get_idata2d + end interface + + real(r8) :: drv_input_data_freq != nan + + type drv_input_data_t + integer :: ntimes + integer, allocatable :: dates(:) + integer, allocatable :: secs(:) + real(r8), allocatable :: times(:) + type(file_desc_t) :: piofile + endtype drv_input_data_t + + type drv_input_4d_t + real(r8), pointer :: array(:,:,:) + endtype drv_input_4d_t + type drv_input_3d_t + real(r8), pointer :: array(:,:) + endtype drv_input_3d_t + type drv_input_2d_t + real(r8), pointer :: array(:) + endtype drv_input_2d_t + type drv_input_2di_t + integer, pointer :: array(:) + endtype drv_input_2di_t + + character(len=4) :: lonname = ' ' + character(len=4) :: latname = ' ' + + interface drv_input_data_read + module procedure drv_input_data_read_2d + module procedure drv_input_data_read_3d + end interface + +contains + +!================================================================================= +!================================================================================= + subroutine drv_input_data_open( infile, indata ) + + use cam_pio_utils, only: cam_pio_openfile + use pio, only: PIO_NOCLOBBER, pio_inq_dimid, pio_inq_dimlen + use pio, only: pio_inq_varid, pio_get_var + use pio, only: pio_seterrorhandling, PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR + use dyn_grid, only: get_horiz_grid_dim_d + + implicit none + + character(len=*), intent(in) :: infile + type(drv_input_data_t), intent(out) :: indata + + integer :: id, ierr + integer :: hdim1_d,hdim2_d, nlons + integer :: dtime + integer :: data_dtime + character(len=*), parameter :: sub = 'drv_input_data_open: ' + + dtime = get_step_size() + + ! open file and get fileid + ! + call cam_pio_openfile( indata%piofile, infile, PIO_NOCLOBBER) + + if(masterproc) write(iulog,*) sub // 'opened: ',trim(infile) + + ! + ! check horizontal grid ... + ! + call pio_seterrorhandling( indata%piofile, PIO_BCAST_ERROR) + lonname = 'ncol' + latname = ' ' + ierr = pio_inq_dimid( indata%piofile, lonname, id ) + if (ierr/=PIO_NOERR) then + lonname = 'lon' + latname = 'lat' + endif + + ierr = pio_inq_dimid( indata%piofile, lonname, id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for lonname') + ierr = pio_inq_dimlen( indata%piofile, id, nlons ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for lonname') + + call get_horiz_grid_dim_d(hdim1_d,hdim2_d) + + if (hdim1_d /= nlons) then + call endrun('drv_input_data_open: input file has incorrect horizontal resolution') + endif + + ! + ! get time/date info ... + ! + ierr = pio_inq_dimid( indata%piofile, 'time', id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for time') + ierr = pio_inq_dimlen( indata%piofile, id, indata%ntimes ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for time') + + allocate( indata%dates(indata%ntimes), indata%secs(indata%ntimes), indata%times(indata%ntimes) ) + + ierr = pio_inq_varid( indata%piofile, 'date', id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for date') + ierr = pio_get_var( indata%piofile, id, indata%dates ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for date') + + ierr = pio_inq_varid( indata%piofile, 'datesec', id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for datesec') + ierr = pio_get_var( indata%piofile, id, indata%secs ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for datesec') + + ierr = pio_inq_varid( indata%piofile, 'time', id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for time') + ierr = pio_get_var( indata%piofile, id, indata%times ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for time') + + ierr = pio_inq_varid( indata%piofile, 'mdt', id ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for mdt') + ierr = pio_get_var( indata%piofile, id, data_dtime ) + if (ierr/=PIO_NOERR) call endrun(sub//'failed to get value for mdt') + + call pio_seterrorhandling( indata%piofile, PIO_INTERNAL_ERROR) + + if ( .not. (data_dtime == dtime)) then + write( iulog, * ) sub//'data mdt does not match dtime... use dtime = ', data_dtime + call endrun(sub//'data mdt does not match dtime.') + endif + + end subroutine drv_input_data_open + +!================================================================================================ +!================================================================================================ + subroutine drv_input_data_close(indata) + use pio, only: pio_closefile + implicit none + + type(drv_input_data_t), intent(inout) :: indata + + deallocate( indata%dates, indata%secs, indata%times ) + + call pio_closefile( indata%piofile ) + + end subroutine drv_input_data_close + + !================================================================================= + !================================================================================= + function drv_input_data_read_2d( indata, fldname, recno, abort ) result(field_array) + use ncdio_atm, only: infld + + implicit none + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: fldname + integer, intent(in) :: recno + logical, optional,intent(in) :: abort + + logical :: found, abort_run + real(r8) :: field_array(pcols,begchunk:endchunk) + + abort_run = .false. + if (present(abort)) then + abort_run = abort + endif + + call infld( fldname, indata%piofile, trim(lonname), trim(latname), 1,pcols, begchunk,endchunk, & + field_array, found, gridname='physgrid',timelevel=recno) + + if (.not.found) then + if ( abort_run ) then + call endrun('drv_input_data_read_2d: did not find '// trim(fldname)) + else + if (masterproc) write( iulog, * ) 'drv_input_data_read_2d: ' // trim(fldname) // ' set to zero ' + field_array = 0._r8 + endif + endif + + endfunction drv_input_data_read_2d + + !================================================================================= + !================================================================================= + function drv_input_data_read_3d( indata, fldname, vertname, vertsize, recno, abort ) result(field_array) + use ncdio_atm, only: infld + implicit none + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: fldname + character(len=*), intent(in) :: vertname + integer, intent(in) :: vertsize + integer, intent(in) :: recno + logical, optional,intent(in) :: abort + + logical :: found, abort_run + real(r8) :: field_array(pcols,vertsize,begchunk:endchunk) + + real(r8), allocatable :: tmp_array(:,:,:) + + abort_run = .false. + if (present(abort)) then + abort_run = abort + endif + + call infld( fldname, indata%piofile, lonname, vertname, latname, 1,pcols, 1,vertsize, begchunk,endchunk, & + field_array, found, gridname='physgrid',timelevel=recno) + + if (.not.found) then + if ( abort_run ) then + call endrun('drv_input_data_read_3d: did not find '// trim(fldname)) + else + if (masterproc) write( iulog, * ) 'drv_input_data_read_3d: ' // trim(fldname) // ' set to zero ' + field_array = 0._r8 + endif + endif + + endfunction drv_input_data_read_3d + + !================================================================================================ + !================================================================================================ + subroutine get_data3d(indata, infld_name, lev_name, nlev, recno, chunk_ptrs) + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: infld_name + character(len=*), intent(in) :: lev_name + integer, intent(in) :: nlev + integer, intent(in) :: recno + type(drv_input_3d_t), intent(inout) :: chunk_ptrs(begchunk:endchunk) + + real(r8), allocatable :: data (:,:,:) + + integer :: c, ncol + + allocate( data (pcols, nlev, begchunk:endchunk) ) + + data = drv_input_data_read( indata, infld_name, lev_name, nlev, recno ) + do c=begchunk,endchunk + chunk_ptrs(c)%array(:,:) = data(:,:,c) + enddo + + deallocate( data ) + + end subroutine get_data3d + + !================================================================================================ + !================================================================================================ + subroutine get_data2d(indata, infld_name, recno, chunk_ptrs) + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: infld_name + integer, intent(in) :: recno + type(drv_input_2d_t), intent(inout) :: chunk_ptrs(begchunk:endchunk) + + real(r8), allocatable :: data (:,:) + + integer :: c, ncol + + allocate( data (pcols, begchunk:endchunk) ) + + data = drv_input_data_read( indata, infld_name, recno ) + do c=begchunk,endchunk + chunk_ptrs(c)%array(:) = data(:,c) + enddo + + deallocate( data ) + + end subroutine get_data2d + + !================================================================================================ + !================================================================================================ + subroutine get_idata2d(indata, infld_name, recno, chunk_ptrs) + + type(drv_input_data_t), intent(inout) :: indata + character(len=*), intent(in) :: infld_name + integer, intent(in) :: recno + type(drv_input_2di_t), intent(inout) :: chunk_ptrs(begchunk:endchunk) + + real(r8), allocatable :: data (:,:) + + integer :: c, ncol + + allocate( data (pcols, begchunk:endchunk) ) + + data = drv_input_data_read(indata, infld_name, recno ) + do c=begchunk,endchunk + chunk_ptrs(c)%array(:) = int(data(:,c)) + enddo + + deallocate( data ) + + end subroutine get_idata2d + +end module drv_input_data diff --git a/src/unit_drivers/offline_driver.F90 b/src/unit_drivers/offline_driver.F90 new file mode 100644 index 0000000000..9432fa9757 --- /dev/null +++ b/src/unit_drivers/offline_driver.F90 @@ -0,0 +1,186 @@ +!================================================================================ +! offline unit driver utility module +! +!================================================================================ +module offline_driver + + use shr_kind_mod, only: r8=>SHR_KIND_R8, cl=>SHR_KIND_CL + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use drv_input_data, only: drv_input_data_t + use drv_input_data, only: drv_input_data_open, drv_input_data_close + use tracer_data, only: incr_filename + + implicit none + private + save + + public :: offline_driver_init + public :: offline_driver_run + public :: offline_driver_dorun + public :: offline_driver_readnl + public :: offline_driver_reg + + integer :: recno = 1 + logical, protected :: offline_driver_dorun = .false. + + character(len=cl) :: current_file = ' ' + character(len=cl) :: next_file = ' ' + character(len=cl) :: offline_driver_fileslist = ' ' + + type(drv_input_data_t) :: curr_indata + +contains + +!================================================================================ +!================================================================================ + subroutine offline_driver_reg() + use unit_driver, only: unit_driver_reg + call unit_driver_reg() + end subroutine offline_driver_reg + +!================================================================================ +!================================================================================ + subroutine offline_driver_run( phys_state, pbuf2d, cam_out, cam_in ) + + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use camsrfexch, only: cam_out_t, cam_in_t + use physics_buffer, only: physics_buffer_desc + use time_manager, only: get_curr_date + use unit_driver, only: unit_driver_run + + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: yr, mon, day + integer :: curr_model_date, curr_model_tod + logical :: active_step + + if (.not.offline_driver_dorun) return + + ! check model date/time against input data date/time + call get_curr_date(yr, mon, day, curr_model_tod) + curr_model_date = yr*10000 + mon*100 + day + if ( recno <= curr_indata%ntimes ) then + active_step = curr_model_date==curr_indata%dates(recno) .and. curr_model_tod==curr_indata%secs(recno) + else + active_step = .false. + endif + + if (active_step) then + + call unit_driver_run(curr_indata, phys_state, pbuf2d, cam_out, cam_in, recno) + + recno = recno+1 + + if ( recno > curr_indata%ntimes ) then + call drv_input_data_close(curr_indata) + current_file = next_file + if ( current_file/='NOT_FOUND' ) then + call drv_input_data_open( current_file, curr_indata ) + recno = 1 + next_file = incr_filename( current_file, filenames_list=offline_driver_fileslist, abort=.false.) + endif + endif + + endif + + end subroutine offline_driver_run + +!================================================================================ +!================================================================================ + subroutine offline_driver_init() + use unit_driver, only: unit_driver_init + use drv_input_data, only: drv_input_data_freq + use shr_const_mod, only: SHR_CONST_CDAY + use infnan, only: nan, assignment(=) + + type(drv_input_data_t) :: next_indata + + if (.not.offline_driver_dorun) return + + call drv_input_data_open( current_file, curr_indata ) + + drv_input_data_freq = nan + + if (curr_indata%ntimes>1) then + drv_input_data_freq = (curr_indata%times(2) - curr_indata%times(1))*SHR_CONST_CDAY ! seconds + else + if ( next_file/='NOT_FOUND' ) then + call drv_input_data_open( next_file, next_indata ) + drv_input_data_freq = (next_indata%times(1) - curr_indata%times(1))*SHR_CONST_CDAY ! seconds + call drv_input_data_close(next_indata) + endif + endif + + call unit_driver_init() + + endsubroutine offline_driver_init + +!================================================================================= +!================================================================================= + subroutine offline_driver_readnl( nlfile ) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use cam_abortutils, only: endrun + use mpishorthand + + ! arguments + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + integer :: unitn, ierr + + character(len=cl) :: offline_driver_infile = ' ' + + namelist /offline_driver_nl/ offline_driver_infile, offline_driver_fileslist + + if (masterproc) then + + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'offline_driver_nl', status=ierr) + if (ierr == 0) then + read(unitn, offline_driver_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('offline_driver_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + end if + +#ifdef SPMD + call mpibcast (offline_driver_infile, len(offline_driver_infile), mpichar, 0, mpicom) + call mpibcast (offline_driver_fileslist, len(offline_driver_fileslist), mpichar, 0, mpicom) +#endif + + current_file = 'NOT_FOUND' + next_file = 'NOT_FOUND' + offline_driver_dorun = .false. + + if ( len_trim(offline_driver_infile) > 0 ) then + current_file = trim(offline_driver_infile) + elseif ( len_trim(offline_driver_fileslist) > 0 ) then + current_file = incr_filename( offline_driver_infile, filenames_list=offline_driver_fileslist ) + else + offline_driver_dorun = .false. + return + endif + + if ( trim(current_file)/='NOT_FOUND' .and. len_trim(current_file) > 0 ) then + offline_driver_dorun = .true. + if ( len_trim(offline_driver_fileslist) > 0 ) then + next_file = incr_filename( current_file, filenames_list=offline_driver_fileslist, abort=.false.) + endif + endif + + endsubroutine offline_driver_readnl + +end module offline_driver diff --git a/src/unit_drivers/rad/README b/src/unit_drivers/rad/README new file mode 100644 index 0000000000..755283c529 --- /dev/null +++ b/src/unit_drivers/rad/README @@ -0,0 +1,12 @@ +Parallel Offline Radiation Tool (PORT) + +Creators : + Andrew Conley (aconley.ucar.edu) + Francis Vitt (fvitt@ucar.edu) + +Only the CAMRT radiation package is supportted by PORT. + +To configure PORT use the CAM configure option: + -offline_drv rad + + diff --git a/src/unit_drivers/rad/unit_driver.F90 b/src/unit_drivers/rad/unit_driver.F90 new file mode 100644 index 0000000000..858ada35b6 --- /dev/null +++ b/src/unit_drivers/rad/unit_driver.F90 @@ -0,0 +1,109 @@ +!================================================================================ +! radiation unit driver +!================================================================================ +module unit_driver + + use shr_kind_mod, only: r8=>SHR_KIND_R8 + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use cam_logfile, only: iulog + + implicit none + private + save + + public :: unit_driver_run + public :: unit_driver_init + public :: unit_driver_reg + +contains + +!================================================================================ +!================================================================================ + subroutine unit_driver_reg + use radiation_data, only: rad_data_enable + + call rad_data_enable() + + end subroutine unit_driver_reg + +!================================================================================ +!================================================================================ + subroutine unit_driver_run( indata, phys_state, pbuf2d, cam_out, cam_in, recno) + use physics_types, only: physics_state + use physics_types, only: physics_ptend + use ppgrid, only: begchunk, endchunk + use time_manager, only: timemgr_set_date_time + use drv_input_data, only: drv_input_data_t + use camsrfexch, only: cam_out_t, cam_in_t + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk + use radiation_data, only: rad_data_read + use solar_data, only: solar_data_advance + + implicit none + + type(drv_input_data_t), intent(inout) :: indata + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: recno + + integer :: c ! chunk index + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Solar irradiance + call solar_data_advance() + + ! get data needed to drive radiation ... + call rad_data_read( indata, phys_state, pbuf2d, cam_in, recno=recno ) + +!$OMP PARALLEL DO PRIVATE ( c, pbuf ) + do c=begchunk,endchunk + + pbuf => pbuf_get_chunk(pbuf2d, c) + call unit_driver_exec ( phys_state(c), pbuf, cam_out(c), cam_in(c) ) + + end do + + end subroutine unit_driver_run + +!================================================================================ +!================================================================================ + subroutine unit_driver_exec ( state, pbuf, cam_out, cam_in ) + use physics_types, only: physics_state + use physics_types, only: physics_ptend, physics_ptend_dealloc, physics_update + use camsrfexch, only: cam_out_t, cam_in_t + use physics_buffer, only: physics_buffer_desc + use radiation, only: radiation_tend + + type(physics_state), intent(inout) :: state + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(inout) :: cam_in + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + type(physics_ptend) :: ptend + real(r8) :: net_flx(pcols) + + call radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx) + + call physics_ptend_dealloc(ptend) + + end subroutine unit_driver_exec + +!================================================================================ +!================================================================================ + subroutine unit_driver_init + use radheat, only: radheat_disable_waccm + + implicit none + + call radheat_disable_waccm() + + end subroutine unit_driver_init + +end module unit_driver diff --git a/src/unit_drivers/stub/unit_driver.F90 b/src/unit_drivers/stub/unit_driver.F90 new file mode 100644 index 0000000000..185d41e262 --- /dev/null +++ b/src/unit_drivers/stub/unit_driver.F90 @@ -0,0 +1,46 @@ +!================================================================================ +! stub unit driver +!================================================================================ +module unit_driver + + use shr_kind_mod, only: r8=>SHR_KIND_R8 + + implicit none + private + save + + public :: unit_driver_run + public :: unit_driver_init + public :: unit_driver_reg + +contains + + !================================================================================ + !================================================================================ + subroutine unit_driver_reg + end subroutine unit_driver_reg + + !============================================================================== + !============================================================================== + subroutine unit_driver_run(indata, phys_state, pbuf2d, cam_out, cam_in, recno) + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use camsrfexch, only: cam_out_t, cam_in_t + use physics_buffer, only: physics_buffer_desc + use drv_input_data, only: drv_input_data_t + + type(drv_input_data_t), intent(inout) :: indata + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(in) :: recno + + end subroutine unit_driver_run + + !============================================================================== + !============================================================================== + subroutine unit_driver_init + end subroutine unit_driver_init + +end module unit_driver diff --git a/src/utils/CMakeLists.txt b/src/utils/CMakeLists.txt new file mode 100644 index 0000000000..e89d9a104f --- /dev/null +++ b/src/utils/CMakeLists.txt @@ -0,0 +1,4 @@ +# Append sources from this directory to the cam_sources list. +list(APPEND cam_sources coords_1d.F90 linear_1d_operators.F90) + +sourcelist_to_parent(cam_sources) diff --git a/src/utils/bnddyi.F90 b/src/utils/bnddyi.F90 new file mode 100644 index 0000000000..97eaf3e765 --- /dev/null +++ b/src/utils/bnddyi.F90 @@ -0,0 +1,60 @@ +module bnddyi_mod + +implicit none + +private + +public :: bnddyi + +contains + +subroutine bnddyi (ncdate, ncsec, doy) +!----------------------------------------------------------------------- +! +! Purpose: Convert date and seconds of day to floating point calendar day, for +! boundary dataset handling +! +! Method: Use table of days per month to do conversion +! +! Author: CCM Core Group +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +!--------------------------Arguments------------------------------------ +! +! Arguments +! + integer, intent(in) :: ncdate ! Current date as yymmdd or yyyymmdd + integer, intent(in) :: ncsec ! Seconds of day for current date + + real(r8), intent(out) :: doy ! Day of year +! +! Local Variables +! + integer mnth ! Month number + integer mday ! Day number of month + integer jdcon(12) ! Starting day number for each month + save jdcon + data jdcon/0,31,59,90,120,151,181,212,243,273,304,334/ +! +! Decode month and day +! + mnth = mod(ncdate,10000)/100 + if (mnth < 1 .or. mnth > 12) then + write(iulog,*)'BNDDYI: Bad month index=', mnth + call endrun + end if + mday = mod(ncdate,100) + doy = jdcon(mnth) + mday + ncsec/86400._r8 + + if (doy < 1._r8 .or. doy > 366._r8) then + write(iulog,*)'BNDDYI: bad day of year = ',doy + call endrun + end if +! + return +end subroutine bnddyi + +end module bnddyi_mod diff --git a/src/utils/buffer.F90.in b/src/utils/buffer.F90.in new file mode 100644 index 0000000000..c8fde307fd --- /dev/null +++ b/src/utils/buffer.F90.in @@ -0,0 +1,284 @@ +module buffer + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! LOW level handler for f90 arrays. + ! + ! Author: J. Edwards + ! + ! This file is used with genf90.pl to generate buffer.F90 + ! + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8, r4=> shr_kind_r4, i4=> shr_kind_i4 + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + implicit none + private + ! The maximum number of dims in a fortran array +#define MAXDIMS 7 + + + type buffer_field_default_type + private + real(r8), pointer :: data(:,:,:,:,:,:,:) => null() + end type buffer_field_default_type + + ! TYPE int,double,real + type buffer_field_{TYPE} + private + {VTYPE}, pointer :: data(:,:,:,:,:,:,:) => null() + end type buffer_field_{TYPE} + + integer(i4), parameter,public :: dtype_i4=1 + real(r8), parameter,public :: dtype_r8=1_r8 + real(r4), parameter,public :: dtype_r4=1_r4 + + interface buffer_field_deallocate + ! TYPE int,double,real + module procedure buffer_field_deallocate_{TYPE} + end interface + + interface buffer_field_allocate + ! TYPE int,double,real + module procedure buffer_field_allocate_{TYPE} + end interface + + interface buffer_set_field + ! TYPE int,double,real + module procedure buffer_set_field_const_{TYPE} + ! DIMS 1,2,3,4,5,6,7 + ! TYPE int,double,real + module procedure buffer_set_field_{DIMS}d_{TYPE} + end interface + + interface buffer_get_field_ptr + ! DIMS 1,2,3,4,5,6,7 + ! TYPE int,double,real + module procedure buffer_get_field_ptr_{DIMS}d_{TYPE} + end interface + + public :: buffer_field_deallocate, buffer_field_allocate, buffer_set_field, buffer_get_field_ptr, buffer_field_default_type + public :: buffer_field_is_alloc + + +CONTAINS + +! TYPE int,double,real + subroutine buffer_field_deallocate_{TYPE}(bfg, dtype) + + type(buffer_field_default_type),intent(inout) :: bfg + {VTYPE}, intent(in) :: dtype + + type(buffer_field_{TYPE}) :: b1 + + b1 = transfer(bfg, b1) + + if(.not.associated(b1%data)) then + call endrun('Attempt to deallocate unassociated array ptr') + end if + + deallocate(b1%data) + + nullify(bfg%data) + + end subroutine buffer_field_deallocate_{TYPE} + + logical function buffer_field_is_alloc(bfg) + type(buffer_field_default_type),intent(in) :: bfg + + buffer_field_is_alloc = associated(bfg%data) + + end function buffer_field_is_alloc + + +! TYPE int,double,real + subroutine buffer_field_allocate_{TYPE} (bfg, dimsizes, dtype) + + type(buffer_field_default_type),intent(inout) :: bfg + integer, intent(in) :: dimsizes(:) + integer :: alldimsizes( MAXDIMS ) + {VTYPE}, intent(in) :: dtype + integer :: ierr + + type(buffer_field_{TYPE}) :: b1 + + alldimsizes(:) = 1 + alldimsizes(1:size(dimsizes)) = dimsizes + + if(associated(bfg%data)) then + call endrun('Attempt to allocate array to associated ptr') + end if + + allocate(b1%data(alldimsizes(1),alldimsizes(2),alldimsizes(3),alldimsizes(4),& + alldimsizes(5),alldimsizes(6),alldimsizes(7)),stat=ierr) + + if(ierr/=0) then + call endrun("allocate failed") + end if + + bfg = transfer(b1,bfg) + + end subroutine buffer_field_allocate_{TYPE} + + ! TYPE int,double,real + subroutine buffer_set_field_const_{TYPE}(bfg, const, start,kount) + type(buffer_field_default_type) :: bfg + {VTYPE}, intent(in) :: const + integer, intent(in), optional :: start(:),kount(:) + + type(buffer_field_{TYPE}) :: ptr + + integer :: i, ns, strt(7), fin(7), cnt(7) + + ptr = transfer(bfg, ptr) + + if(present(start).and.present(kount)) then + strt(:) = 1 + cnt = shape(ptr%data) + + ns = size(start) + strt(1:ns) = start + + fin = strt+cnt-1 + + do i=1,ns + fin(i) = strt(i)+kount(i)-1 + if(strt(i)<1 .or. fin(i)>cnt(i)) then + call endrun('Start plus kount exceeds dimension bounds') + endif + enddo + + + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& + strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=const + else + ptr%data = const + endif + + end subroutine buffer_set_field_const_{TYPE} + + !========================================================================================= + ! + ! Given a physics_buffer chunk and an index return a pointer to a field chunk + ! + ! + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6,7 + subroutine buffer_get_field_ptr_{DIMS}d_{TYPE}(bfg, field, start,kount) + type(buffer_field_default_type), intent(in) :: bfg + {VTYPE}, pointer :: field{DIMSTR} + integer, intent(in), optional :: start(:), kount(:) + type(buffer_field_{TYPE}), target :: ptr + + integer :: ns, strt(7), fin(7), cnt(7) + + ptr = transfer(bfg, ptr) + + + strt(:) = 1 + cnt = shape(ptr%data) + + if(present(start)) then + ns = size(start) + strt(1:ns) = start + end if + if(present(kount)) then + cnt(1:ns) = kount + end if + fin = strt+cnt-1 + +#if ({DIMS}==1) + field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) +#elif ({DIMS}==2) + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) +#elif ({DIMS}==3) + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) +#elif ({DIMS}==4) + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) +#elif ({DIMS}==5) + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) +#elif ({DIMS}==6) + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& + strt(5):fin(5),strt(6):fin(6),strt(7)) +#else + field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& + strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) +#endif + + end subroutine buffer_get_field_ptr_{DIMS}d_{TYPE} + + ! TYPE int,double,real + ! DIMS 1,2,3,4,5,6,7 + subroutine buffer_set_field_{DIMS}d_{TYPE}(bfg,field,start,kount) + type(buffer_field_default_type) :: bfg + {VTYPE},intent(in) :: field{DIMSTR} + integer,intent(in),optional :: start(:),kount(:) + type(buffer_field_{TYPE}) :: ptr + + integer :: i, nc, strt(7), fin(7), cnt(7) + + ptr = transfer(bfg,ptr) + if(present(start).and.present(kount)) then + strt(:) = 1 + cnt = shape(ptr%data) + + nc=size(start) + strt(1:nc) = start + fin = strt+cnt-1 + + do i=1,nc + fin(i) = strt(i)+kount(i)-1 + if(strt(i)<1 .or. fin(i)>cnt(i)) then + call endrun('Start plus kount exceeds dimension bounds') + endif + enddo + + +#if ({DIMS}==1) + ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field +#elif ({DIMS}==2) + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field +#elif ({DIMS}==3) + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field +#elif ({DIMS}==4) + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field +#elif ({DIMS}==5) + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field +#elif ({DIMS}==6) + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& + strt(5):fin(5),strt(6):fin(6),strt(7))=field +#else + ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& + strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field +#endif + else +#if ({DIMS}==1) + ptr%data(:,1,1,1,1,1,1) = field +#elif({DIMS}==2) + ptr%data(:,:,1,1,1,1,1) = field +#elif({DIMS}==3) + ptr%data(:,:,:,1,1,1,1) = field +#elif({DIMS}==4) + ptr%data(:,:,:,:,1,1,1) = field +#elif({DIMS}==5) + ptr%data(:,:,:,:,:,1,1) = field +#elif({DIMS}==6) + ptr%data(:,:,:,:,:,:,1) = field +#else + ptr%data = field +#endif + end if + end subroutine buffer_set_field_{DIMS}d_{TYPE} + + + +end module buffer + + + + + diff --git a/src/utils/cam_abortutils.F90 b/src/utils/cam_abortutils.F90 new file mode 100644 index 0000000000..33c1128262 --- /dev/null +++ b/src/utils/cam_abortutils.F90 @@ -0,0 +1,11 @@ +module cam_abortutils + + use shr_sys_mod, only: endrun => shr_sys_abort + + implicit none + private + save + + public :: endrun + +end module cam_abortutils diff --git a/src/utils/cam_aqua/cpl/ocn_comp_mct.F90 b/src/utils/cam_aqua/cpl/ocn_comp_mct.F90 new file mode 100644 index 0000000000..b3e000ee36 --- /dev/null +++ b/src/utils/cam_aqua/cpl/ocn_comp_mct.F90 @@ -0,0 +1,328 @@ +module ocn_comp_mct + + use mct_mod + use esmf + use seq_flds_mod + use seq_cdata_mod + use seq_infodata_mod + use seq_timemgr_mod + use perf_mod + + use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl + use physconst, only: pi + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + + use phys_grid, only: get_ncols_p,get_rlat_all_p,get_rlon_all_p, & + get_area_all_p,ngcols, get_gcol_p, get_nlcols_p + use ppgrid, only: pcols,begchunk,endchunk + use ocn_types, only: ocn_out_t + use ocn_comp + use spmd_utils, only : iam + implicit none + private + save + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public ocn_init_mct ! Initialization method + public ocn_run_mct ! Run method + public ocn_final_mct ! Finalization method + +!-------------------------------------------------------------------------- +! Private interfaces +!-------------------------------------------------------------------------- + + private :: ocn_SetgsMap_mct + private :: ocn_export_mct + +!-------------------------------------------------------------------------- +! Private data +!-------------------------------------------------------------------------- + + type(ocn_out_t), pointer :: ocn_out(:) + + integer :: index_o2x_So_t + + +!=============================================================== +contains +!=============================================================== + + subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) + + !---------------------------------------------------------- + ! + ! Arguments + ! + type(ESMF_Clock), intent(inout) :: EClock + type(seq_cdata), intent(inout) :: cdata_o + type(mct_aVect), intent(inout) :: x2o_o, o2x_o + character(len=*), optional, intent(in) :: NLFilename + ! + ! Local variables + ! + integer :: OCNID + integer :: mpicom_ocn + type(mct_gsMap), pointer :: gsMap_ocn + type(mct_gGrid), pointer :: dom_o + type(seq_infodata_type), pointer :: infodata + integer :: lsize + + !---------------------------------------------------------- + ! + ! Set cdata pointers + ! + call seq_cdata_setptrs(cdata_o,ID=OCNID, mpicom=mpicom_ocn, & + gsMap=gsMap_ocn, dom=dom_o, infodata=infodata) + ! + ! Initialize ocn model + ! + call ocn_init( ocn_out ) + ! + ! Initialize MCT gsMap, domain and attribute vectors + ! + call ocn_SetgsMap_mct( mpicom_ocn, OCNID, gsMap_ocn ) + lsize = mct_gsMap_lsize(gsMap_ocn, mpicom_ocn) + ! + ! Initialize mct domain + ! + call ocn_domain_mct( lsize, gsMap_ocn, dom_o ) + ! + ! Inialize mct attribute vectors + ! + call mct_aVect_init(x2o_o, rList=seq_flds_x2o_fields, lsize=lsize) + call mct_aVect_zero(x2o_o) + + call mct_aVect_init(o2x_o, rList=seq_flds_o2x_fields, lsize=lsize) + index_o2x_So_t = mct_avect_indexra(o2x_o,'So_t') + call mct_aVect_zero(o2x_o) + ! + ! Create initial ocn export state + ! + call ocn_export_mct( ocn_out, o2x_o ) + call seq_infodata_PutData( infodata, ocn_prognostic=.false., ocnrof_prognostic=.false.) + + + end subroutine ocn_init_mct + +!========================================================================== + + subroutine ocn_run_mct ( EClock, cdata_o, x2o_o, o2x_o) + + !---------------------------------------------------------- + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata_o + type(mct_aVect) , intent(inout) :: x2o_o + type(mct_aVect) , intent(inout) :: o2x_o + !---------------------------------------------------------- + + ! Run ocean model + + call t_startf ('ocn_run') + call ocn_run( ocn_out ) + call t_stopf ('ocn_run') + + ! Extract export state + + call t_startf ('ocn_export') + call ocn_export_mct (ocn_out, o2x_o ) + call t_stopf ('ocn_export') + + end subroutine ocn_run_mct + +!========================================================================== + + subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o) + + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata_o + type(mct_aVect) , intent(inout) :: x2o_o + type(mct_aVect) , intent(inout) :: o2x_o + + ! ********************* + ! does nothing + ! ********************* + end subroutine ocn_final_mct + +!========================================================================== + + subroutine ocn_export_mct( ocn_out, o2x_o ) + + !------------------------------------------------------------------- + implicit none + type(ocn_out_t), intent(in) :: ocn_out(begchunk:endchunk) + type(mct_aVect), intent(inout) :: o2x_o + + integer :: i,c,ig ! indices + integer :: ncols ! number of columns + !----------------------------------------------------------------------- + + ig=1 + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + o2x_o%rAttr(index_o2x_So_t,ig) = ocn_out(c)%ts(i) + ig=ig+1 + end do + end do + + end subroutine ocn_export_mct + +!========================================================================== + + subroutine ocn_SetgsMap_mct( mpicom_ocn, OCNID, gsMap_ocn ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: mpicom_ocn + integer , intent(in) :: OCNID + type(mct_gsMap), intent(out) :: gsMap_ocn + ! + ! Local Variables + ! + integer, allocatable :: gindex(:) + integer :: i, startpoint, j, sizebuf, n, c, ncols, gcol, nlcols + !------------------------------------------------------------------- + + ! Determine global seg map + + sizebuf=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + sizebuf = sizebuf+1 + end do + end do + + allocate(gindex(sizebuf)) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + n=n+1 + gindex(n) = get_gcol_p(c,i) + end do + end do + nlcols = get_nlcols_p() + call mct_gsMap_init( gsMap_ocn, gindex, mpicom_ocn, OCNID, nlcols, ngcols ) + + deallocate(gindex) + + end subroutine ocn_SetgsMap_mct + +!=============================================================================== + + subroutine ocn_domain_mct( lsize, gsMap_o, dom_o ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: lsize + type(mct_gsMap), intent(inout) :: gsMap_o + type(mct_ggrid), intent(inout) :: dom_o + ! + ! Local Variables + ! + integer :: n,j,i,c,ncols ! indices + real(r8) :: lats(pcols) ! array of global latitude indices + real(r8) :: lons(pcols) ! array of global longitude indices + real(r8) :: area(pcols) ! area in radians squared for each grid point + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + real(r8), parameter :: radtodeg = 180.0_r8/pi + !------------------------------------------------------------------- + ! + ! Initialize domain type + ! + call mct_gGrid_init( GGrid=dom_o, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_o, iam, idata) + call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize) + call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_o,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_o,"mask" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"frac" ,data,lsize) + ! + ! Fill in correct values for domain components + ! + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, ncols, lats) + do i=1,ncols + n = n+1 + data(n) = lats(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_o,"lat",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlon_all_p(c, ncols, lons) + do i=1,ncols + n = n+1 + data(n) = lons(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_o,"lon",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_area_all_p(c, ncols, area) + do i=1,ncols + n = n+1 + data(n) = area(i) + end do + end do + call mct_gGrid_importRAttr(dom_o,"area",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + n = n+1 + data(n) = 1._r8 ! mask for aqua_planet + end do + end do + call mct_gGrid_importRAttr(dom_o,"mask",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + n = n+1 + data(n) = 1._r8 ! frac for aqua_planet + end do + end do + call mct_gGrid_importRAttr(dom_o,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine ocn_domain_mct + +end module ocn_comp_mct diff --git a/src/utils/cam_aqua/ocn_comp.F90 b/src/utils/cam_aqua/ocn_comp.F90 new file mode 100644 index 0000000000..140f9e1d7c --- /dev/null +++ b/src/utils/cam_aqua/ocn_comp.F90 @@ -0,0 +1,350 @@ +module ocn_comp + +! Implements the fixed analytic SST options. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: tmelt, pi +use ppgrid, only: pcols, begchunk, endchunk +use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p +use ocn_types, only: ocn_out_t + +use cam_abortutils, only: endrun + +implicit none +save +private + +public :: ocn_init ! Initialization method +public :: ocn_run ! Run method + +integer :: aqua_planet_sst ! option for analytic SST + +real(r8), allocatable :: sst(:,:) + +!========================================================================================= +CONTAINS +!========================================================================================= + +subroutine ocn_init(ocn_out) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, mpicom, mstrid=>masterprocid, mpi_integer + + ! arguements + type(ocn_out_t), pointer :: ocn_out(:) + + ! local variables + integer :: unitn, ierr + integer :: ncol, c, i + + namelist /aquap_nl/ aqua_planet_sst + + character(len=*), parameter :: sub = 'ocn_init' + !------------------------------------------------------------------------------- + + ! read aquaplanet namelist + if (masterproc) then + unitn = getunit() + open( unitn, file='aquap_in', status='old' ) + call find_group_name(unitn, 'aquap_nl', status=ierr) + if (ierr == 0) then + read(unitn, aquap_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(aqua_planet_sst, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: aqua_planet_sst") + + ! set the analytic SST + + if (.not.allocated(sst)) then + allocate(sst(pcols,begchunk:endchunk)) + endif + + call prescribed_sst() + + ! initialize the export object + + allocate(ocn_out(begchunk:endchunk)) + + do c = begchunk, endchunk + ocn_out(c)%ts(:) = 0.0_r8 + end do + + do c = begchunk,endchunk + ncol = get_ncols_p(c) + do i = 1, ncol + ocn_out(c)%ts(i) = sst(i,c) + tmelt + end do + end do + +end subroutine ocn_init + +!========================================================================================= + +subroutine ocn_run( ocn_out ) + + type(ocn_out_t), intent(inout) :: ocn_out(begchunk:endchunk) + + ! local variables + integer :: ncol, i, c + !------------------------------------------------------------------------------- + + do c = begchunk, endchunk + ncol = get_ncols_p(c) + do i = 1, ncol + ocn_out(c)%ts(i) = sst(i,c) + tmelt + end do + end do + +end subroutine ocn_run + +!========================================================================================= + +subroutine prescribed_sst() + + ! local + integer :: sst_option + + real(r8), parameter :: pio180 = pi/180._r8 + + ! Parameters for zonally symmetric experiments + real(r8), parameter :: t0_max = 27._r8 + real(r8), parameter :: t0_min = 0._r8 + real(r8), parameter :: maxlat = 60._r8*pio180 + real(r8), parameter :: shift = 5._r8*pio180 + real(r8), parameter :: shift9 = 10._r8*pio180 + real(r8), parameter :: shift10 = 15._r8*pio180 + + ! Parameters for zonally asymmetric experiments + real(r8), parameter :: t0_max6 = 1._r8 + real(r8), parameter :: t0_max7 = 3._r8 + real(r8), parameter :: latcen = 0._r8*pio180 + real(r8), parameter :: loncen = 0._r8*pio180 + real(r8), parameter :: latrad6 = 15._r8*pio180 + real(r8), parameter :: latrad8 = 30._r8*pio180 + real(r8), parameter :: lonrad = 30._r8*pio180 + + integer :: lchnk, i, ncols + real(r8) :: tmp, tmp1, rlat(pcols), rlon(pcols) + !------------------------------------------------------------------------------- + + sst_option = aqua_planet_sst + + ! Control + + if (sst_option < 1 .or. sst_option > 10) then + call endrun ('prescribed_sst: ERROR: sst_option must be between 1 and 10') + end if + + if (sst_option == 1 .or. sst_option == 6 .or. & + sst_option == 7 .or. sst_option == 8 ) then + + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + + ! Flat + + if (sst_option == 2) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = 1._r8 - tmp*tmp*tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + + ! Qobs + + if (sst_option == 3) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = (2._r8 - tmp*tmp*tmp*tmp - tmp*tmp)*0.5_r8 + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + + ! Peaked + + if (sst_option == 4) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else + tmp = (maxlat - abs(rlat(i)))/maxlat + tmp1 = 1._r8 - tmp + sst(i,lchnk) = t0_max*tmp + t0_min*tmp1 + end if + end do + end do + end if + + ! Control-5N + + if (sst_option == 5) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else if (rlat(i) > shift) then + tmp = sin((rlat(i)-shift)*pi*0.5_r8/(maxlat-shift)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift)*pi*0.5_r8/(maxlat+shift)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + + ! 1KEQ + + if (sst_option == 6) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + call get_rlon_all_p(lchnk, pcols, rlon) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)-latcen) <= latrad6) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad6) + tmp1 = tmp1*tmp1 + tmp = abs(rlon(i)-loncen) + tmp = min(tmp , 2._r8*pi-tmp) + if(tmp <= lonrad) then + tmp = cos(tmp*pi*0.5_r8/lonrad) + tmp = tmp*tmp + sst(i,lchnk) = sst(i,lchnk) + t0_max6*tmp*tmp1 + end if + end if + end do + end do + end if + + ! 3KEQ + + if (sst_option == 7) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + call get_rlon_all_p(lchnk, pcols, rlon) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)-latcen) <= latrad6) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad6) + tmp1 = tmp1*tmp1 + tmp = abs(rlon(i)-loncen) + tmp = min(tmp , 2._r8*pi-tmp) + if (tmp <= lonrad) then + tmp = cos(tmp*pi*0.5_r8/lonrad) + tmp = tmp*tmp + sst(i,lchnk) = sst(i,lchnk) + t0_max7*tmp*tmp1 + end if + end if + end do + end do + end if + + ! 3KW1 + + if (sst_option == 8) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + call get_rlon_all_p(lchnk, pcols, rlon) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)-latcen) <= latrad8) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad8) + tmp1 = tmp1*tmp1 + tmp = cos(rlon(i)-loncen) + sst(i,lchnk) = sst(i,lchnk) + t0_max7*tmp*tmp1 + end if + end do + end do + end if + + ! Control-10N + + if (sst_option == 9) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else if (rlat(i) > shift9) then + tmp = sin((rlat(i)-shift9)*pi*0.5_r8/(maxlat-shift9)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift9)*pi*0.5_r8/(maxlat+shift9)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + + ! Control-15N + + if (sst_option == 10) then + do lchnk = begchunk, endchunk + call get_rlat_all_p(lchnk, pcols, rlat) + ncols = get_ncols_p(lchnk) + do i = 1, ncols + if (abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + else if(rlat(i) > shift10) then + tmp = sin((rlat(i)-shift10)*pi*0.5_r8/(maxlat-shift10)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift10)*pi*0.5_r8/(maxlat+shift10)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + +end subroutine prescribed_sst + +end module ocn_comp diff --git a/src/utils/cam_aqua/ocn_types.F90 b/src/utils/cam_aqua/ocn_types.F90 new file mode 100644 index 0000000000..6af0f1cd5a --- /dev/null +++ b/src/utils/cam_aqua/ocn_types.F90 @@ -0,0 +1,12 @@ +module ocn_types + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols + implicit none + public + + type ocn_out_t + real(r8) :: ts(pcols) ! surface temperature + end type ocn_out_t + +end module ocn_types diff --git a/src/utils/cam_dom/ocn_comp.F90 b/src/utils/cam_dom/ocn_comp.F90 new file mode 100644 index 0000000000..19a802ce3d --- /dev/null +++ b/src/utils/cam_dom/ocn_comp.F90 @@ -0,0 +1,536 @@ +module ocn_comp + !----------------------------------------------------------------------- + ! + ! Method: CAM Data Ocean Model + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: tmelt + use shr_sys_mod, only: shr_sys_abort + + use cam_logfile, only: iulog + use cam_control_mod, only: initial_run, restart_run, aqua_planet + use ppgrid, only: pcols, begchunk, endchunk + use phys_grid, only: read_chunk_from_field, write_field_from_chunk, & + gather_chunk_to_field, get_ncols_p, scatter_field_to_chunk + use units, only: getunit, freeunit + use ioFileMod, only: opnfil, getfil + + + use ocn_time_manager, only: get_step_size, get_nstep, get_curr_calday, & + is_end_curr_day, is_first_step, & + timemgr_write_restart, timemgr_read_restart, & + timemgr_restart, timemgr_init + use ocn_types, only: ocn_out_t, frac_t, ocn_types_alloc + use ocn_spmd + use sst_data, only: sstini, sstint, sst, sstcyc + use perf_mod + use pio + use cam_pio_utils, only : cam_pio_openfile + ! + implicit none + private ! By default everything private to this module +#include + save + ! + ! Public methods + ! + public ocn_init ! Initialization method + public ocn_run ! Run method + public ocn_final ! Finalization method + public ocn_write_restart + public ocn_read_restart + ! + ! Private module data + ! + integer :: nrf = -1 ! logical unit number for ocn restart dataset + integer :: nrpf = -1 ! logical unit number for ocn restart pointer file + integer, parameter :: nlen = 256 ! Length of character strings + character(len=nlen) :: dom_branch_file = ' ' ! full pathname of restart file to branch from + character(len=nlen) :: rest_pfile = './rpointer.ocn' ! restart pointer file contains name of most recently + character(len=nlen) :: bndtvs ! sst file + character(len=nlen) :: focndomain ! ocn domain file + + type(frac_t), allocatable, public :: frac(:) + type(file_desc_t) :: ncid_sst ! netcdf file handle for sst file + + +!======================================================================= +contains +!======================================================================= + + subroutine ocn_init( mpicom_ocn, ocn_out, & + start_ymd, start_tod, ref_ymd, ref_tod, stop_ymd, stop_tod, & + perpetual_run, perpetual_ymd, calendar) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Initialization method for CAM data ocean model. + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: mpicom_ocn + type(ocn_out_t), pointer :: ocn_out(:) + integer, intent(in) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(in) :: start_tod ! Start time of day (sec) + integer, intent(in) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(in) :: ref_tod ! Reference time of day (sec) + integer, intent(in) :: stop_ymd ! Stop date (YYYYMMDD) + integer, intent(in) :: stop_tod ! Stop time of day (sec) + logical, intent(in) :: perpetual_run ! If in perpetual mode or not + integer, intent(in) :: perpetual_ymd ! Perpetual date (YYYYMMDD) + character(len=256), intent(in) :: calendar ! Calendar type + ! + ! Local variables + ! + integer :: ncol ! number of columns + integer :: c ! Chunk loop index + integer :: i ! Column loop index + integer :: ierr ! error status + integer :: unitn ! namelist unit + character(len=256) :: locfn ! netcdf local filename to open + ! + namelist /dom_inparm/ sstcyc, dom_branch_file, rest_pfile, bndtvs, focndomain + !-------------------------------------------------------------------------------- + ! + ! Allocate dynamic memory + ! + call ocn_types_alloc( ocn_out ) + call ocn_alloc( ) + ! + ! Initialize ocn MPI communicator + ! + call ocn_spmd_init( mpicom_ocn ) + ! + ! Read ocn namelist + ! + sstcyc = .true. + if (masterproc) then + unitn = getunit() + write(iulog,*) 'Read in camdom namelist from file= ocn_in' + open( unitn, file='ocn_in', status='old' ) + ierr = 1 + do while ( ierr /= 0 ) + read(unitn, dom_inparm, iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( 'ocn_comp encountered end-of-file on namelist read' ) + endif + end do + call freeunit( unitn ) + if (sstcyc) then + write(iulog,*)'SST dataset will be reused for each model year' + else + write(iulog,*)'SST dataset will not be cycled' + end if + end if + call mpi_bcast(sstcyc, 1, MPI_LOGICAL,0,mpicom_ocn,ierr) + call mpi_bcast(focndomain, nlen, MPI_CHARACTER, 0, mpicom, ierr) + call mpi_bcast(dom_branch_file, nlen, MPI_CHARACTER, 0, mpicom, ierr) + call mpi_bcast(rest_pfile, nlen, MPI_CHARACTER, 0, mpicom, ierr) + call mpi_bcast(bndtvs, nlen, MPI_CHARACTER, 0, mpicom, ierr) + ! + ! Data ocean model + ! + if (initial_run) then + call ocn_read_inidat( ) + else + call ocn_read_restart( ocn_out, stop_ymd, stop_tod ) + end if + ! + ! Obtain time-variant sst datatset + ! + if (.not. aqua_planet) then + call getfil(bndtvs, locfn) + call cam_pio_openfile(ncid_sst, locfn, 0) + endif + ! + ! Initialize ocean surface datasets + ! + call sstini(ncid_sst) + if (is_first_step()) then + call sstint(ncid_sst, prev_timestep=.true.) + else + call sstint(ncid_sst, prev_timestep=.false.) + end if + ! + ! Determine initial surface temperature + ! + if (is_first_step()) then + do c = begchunk,endchunk + ncol = get_ncols_p(c) + do i = 1, ncol + ocn_out(c)%ts(i) = sst(i,c) + tmelt + end do + end do + end if + + end subroutine ocn_init + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_run( ocn_out ) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Run method for CAM ocean surface fluxes. + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(ocn_out_t), intent(inout) :: ocn_out(begchunk:endchunk) + ! + ! Local variables + ! + integer :: ncol ! number of columns in chunk + integer :: i ! Column index + integer :: c ! chunk index + !----------------------------------------------------------------------- + ! + ! Get SST from dataset + ! + call t_startf ('sstint') + call sstint (ncid_sst) + call t_stopf ('sstint') + ! + ! convert ts units from degC to degK over open ocean + ! + do c=begchunk,endchunk + ncol = get_ncols_p(c) + do i = 1,ncol + ocn_out(c)%ts(i) = sst(i,c) + tmelt + end do + end do + + end subroutine ocn_run + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_final( ocn_out ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Finalization of cam data ocean + ! + !----------------------------------------------------------------------- + type(ocn_out_t), pointer :: ocn_out(:) + + deallocate (ocn_out) + + end subroutine ocn_final + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_alloc() + !----------------------------------------------------------------------- + ! + ! Purpose: + ! CAM Data Ocean module data allocatation. + ! + !----------------------------------------------------------------------- + integer :: c + + allocate (frac(begchunk:endchunk)) + do c = begchunk,endchunk + frac(c)%land(:) = 0._r8 + end do + + end subroutine ocn_alloc + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_read_inidat() + !----------------------------------------------------------------------- + ! + ! Purpose: + ! CAM Data model read of initial data. + ! + !----------------------------------------------------------------------- + use scamMod, only: scmlon,scmlat,single_column + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use ncdio_atm, only : infld + ! + ! Local variables + ! + logical :: readvar ! inquiry: true => variable exists on file + type(file_desc_t) :: ncid_landfrac ! netcdf file id + integer :: c, ncols ! column indices + type(file_desc_t) :: ncid_dom ! netcdf file id + real(r8), pointer :: arr2d(:,:) ! temporary 2D array + character(len=16) :: fieldname ! field name + character(len=256) :: locfn ! netcdf local filename to open + integer :: closelatidx + integer :: closelonidx + integer :: fracid,rcode + real(r8) :: closelat,closelon + + !----------------------------------------------------------------------- + + allocate ( arr2d(1:pcols,begchunk:endchunk) ) + + if (aqua_planet) then + arr2d(:,:) = 1._r8 + else + call getfil(focndomain, locfn) + call cam_pio_openfile(ncid_dom, locfn, 0) + if (single_column) then + call shr_scam_getCloseLatLon(ncid_dom%fh,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) + rcode = pio_inq_varid(ncid_dom, 'frac', fracid) + rcode = pio_get_var(ncid_dom,fracid,(/closelonidx,closelatidx/),(/1,1/),arr2d) + else + fieldname = 'frac' + call infld(fieldname, ncid_dom, 'ni', 'nj', 1, pcols, begchunk,& + endchunk, arr2d ,readvar, gridname='physgrid') +! call read_domain (fieldname, ncid_dom, 'ni', 'nj', 'xc','yc',& +! 1, pcols, begchunk, endchunk, arr2d, readvar) + if(.not. readvar) call shr_sys_abort('dom: error in reading LANDFRAC') + end if + call pio_closefile(ncid_dom) + end if + do c = begchunk, endchunk + ncols = get_ncols_p(c) + ! first convert from ocn fraction to land fraction + frac(c)%land(:ncols) = 1._r8 - arr2d(:ncols,c) + end do + + deallocate ( arr2d ) + + end subroutine ocn_read_inidat + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_write_restart( fname, ocn_out ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Write the CAM ocean surface restart file out. + ! + !----------------------------------------------------------------------- + ! + ! Input arguments + ! + character(len=nlen), intent(in) :: fname ! restart filename + type(ocn_out_t) , intent(in) :: ocn_out(begchunk:endchunk) + ! + ! Local workspace + ! + real(r8) :: tmpfield(pcols,begchunk:endchunk) ! temporary + integer :: i ! loop index + !----------------------------------------------------------------------- + + if (masterproc) then + if ( nrf == -1 ) nrf = getunit() + call opnfil(fname, nrf, 'u') + endif + + do i=begchunk,endchunk + tmpfield(:,i) = frac(i)%land(:) + end do + call write_field_from_chunk(nrf,1,1,1,tmpfield) + + ! write time manager restart + + if (masterproc) then + call timemgr_write_restart(nrf) + end if + + if (masterproc) then + close (nrf) + + if ( nrpf == -1 ) nrpf = getunit() + call opnfil(rest_pfile, nrpf, 'f') + rewind nrpf + write (nrpf,'(a)') trim(fname) + close(nrpf) + write(iulog,*)'(ocn_write_restart): successfully wrote local restart pointer file ',trim(rest_pfile) + end if + + end subroutine ocn_write_restart + + ! + !----------------------------------------------------------------------- + ! + + subroutine ocn_read_restart(ocn_out, stop_ymd, stop_tod) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Read the CAM ocean surface restart file in. + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(ocn_out_t), intent(inout) :: ocn_out(begchunk:endchunk) + integer , intent(in) :: stop_ymd ! Stop date (YYYYMMDD) + integer , intent(in) :: stop_tod ! Stop time of day (sec) + ! + ! Local workspace + ! + real(r8) :: tmpfield(pcols,begchunk:endchunk) + integer :: i ! loop index + integer :: ncol ! number of vertical columns + character(len=nlen) :: fname ! restart filename + character(len=nlen) :: pname ! restart full pathname + !----------------------------------------------------------------------- + + ! Only read the restart pointer file for a restart run. + + if (masterproc) then + if (restart_run) then + nrpf = getunit() + call opnfil (rest_pfile, nrpf, 'f', status="old") + read (nrpf,'(a)') pname + close(nrpf) + else + if ( trim(dom_branch_file) == '' )then + call shr_sys_abort ('ocn_read_restart: dom_branch_file is empty') + end if + if ( dom_branch_file(1:1) /= '/' )then + call shr_sys_abort ('ocn_read_restart: dom_branch_file is not an absolute pathname') + end if + if ( len_trim(dom_branch_file) > nlen )then + call shr_sys_abort ('ocn_read_restart: dom_branch_file is too long :'//dom_branch_file) + end if + pname = trim(dom_branch_file) + end if + call getfil(pname, fname) + nrf = getunit() + call opnfil(fname, nrf, 'u') + endif + + call read_chunk_from_field(nrf,1,1,1,tmpfield) + do i = begchunk,endchunk + ncol = get_ncols_p(i) + frac(i)%land(:ncol) = tmpfield(:ncol,i) + end do + + ! Restart the time manager. + + if (masterproc) then + call timemgr_read_restart(nrf) + end if + call timemgr_restart( stop_ymd=stop_ymd, stop_tod=stop_tod ) + + if (masterproc) then + close(nrf) + end if + + end subroutine ocn_read_restart + +! +!----------------------------------------------------------------------- +! + + subroutine read_domain(varname, ncid , dimlonnam, dimlatnam, lonnam, latnam, & + dim1b, dim1e, dim2b, dim2e, field, readvar) + use cam_abortutils, only : endrun + !----------------------------------------------------------------------- + ! + ! Arguments + ! + character(len=*), intent(in) :: varname ! variable name + type(file_desc_t) , intent(inout) :: ncid ! input unit + character(len=*), intent(in) :: dimlonnam ! name of longitude dimension of field on file + character(len=*), intent(in) :: dimlatnam ! name of latitude dimension of field on file + character(len=*), intent(in) :: lonnam ! name of longitude variable of field on file + character(len=*), intent(in) :: latnam ! name of latitude variable of field on file + integer , intent(in) :: dim1b ! start of first dimension of array to be returned + integer , intent(in) :: dim1e ! end of first dimension of array to be returned + integer , intent(in) :: dim2b ! start of second dimension of array to be returned + integer , intent(in) :: dim2e ! end of second dimension of array to be returned + real(r8) , intent(out) :: field(dim1b:dim1e,dim2b:dim2e) ! array to be returned (decomposed or global) + logical , intent(out) :: readvar ! true => variable is on initial dataset + ! + ! local variables + ! + integer :: i,j ! index + integer :: ierr ! error status + integer :: varid ! variable id + integer :: dimlon, dimlat ! lon, lat, lev dimension lengths + integer :: tmptype + integer :: ndims ! number of dimensions + integer :: dims(PIO_MAX_VAR_DIMS) ! variable shape + integer :: londimid, latdimid ! Dimension ID's + integer :: strt(3) ! start lon, lat, time indices for netcdf 2-d + integer :: cnt (3) ! lon, lat, time counts for netcdf 2-d + data strt/3*1/ ! + data cnt /1,1,1/ ! 2-d arrs + real(r8), pointer :: tmp(:,:) ! input data + logical :: readvar_tmp ! if true, variable is on tape + character(len=PIO_MAX_NAME) tmpname + character(len=32) :: subname='read_domain' ! subroutine name + + !----------------------------------------------------------------------- + ! +! call check_var(ncid, varname, varid, readvar_tmp) +! if (readvar_tmp) then +! ierr = pio_inq_dimid (ncid, dimlonnam, londimid) +! ierr = pio_inq_dimlen (ncid, londimid , dimlon) +! ierr = pio_inq_dimid (ncid, dimlatnam, latdimid) +! ierr = pio_inq_dimlen (ncid, latdimid , dimlat) + + ! Check order of dimensions in variable +! ierr = pio_inq_varndims(ncid, varid,ndims) +! ierr = pio_inq_vardimid (ncid, varid, dims(1:ndims)) +! if (dims(1) /= londimid .or. dims(2) /= latdimid .or. ndims > 3) then +! write(iulog,*) trim(subname), ' Error: Bad number of dims or ordering while reading field ', trim(varname) +! call endrun() +! end if + + ! Allocate memory and read variable +! cnt(1) = dimlon +! cnt(2) = dimlat +! allocate ( tmp(dimlon,dimlat) ) +! ierr = pio_get_var (ncid, varid, strt, cnt, tmp) + + + + +! end if ! end of readvar_tmp + + end subroutine read_domain + ! + !----------------------------------------------------------------------- + ! + subroutine check_var(ncid, varname, varid, readvar) + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(file_desc_t), intent(inout) :: ncid + character(len=*), intent(in) :: varname + integer, intent(out) :: varid + logical, intent(out) :: readvar + ! + ! Local Variables + ! + integer :: ret ! return value + !----------------------------------------------------------------------- + readvar = .true. + call pio_seterrorhandling(ncid, pio_bcast_error) + ret = pio_inq_varid (ncid, varname, varid) + call pio_seterrorhandling(ncid, pio_internal_error) + if (ret/=PIO_NOERR) then + if (masterproc) then + write(iulog,*)'CHECK_VAR Warning: variable ',trim(varname),' is not on initial dataset' + end if + readvar = .false. + end if + end subroutine check_var + +end module ocn_comp diff --git a/src/utils/cam_dom/ocn_comp_mct.F90 b/src/utils/cam_dom/ocn_comp_mct.F90 new file mode 100644 index 0000000000..8818c62b31 --- /dev/null +++ b/src/utils/cam_dom/ocn_comp_mct.F90 @@ -0,0 +1,432 @@ +module ocn_comp_mct + + use mct_mod + use esmf + use seq_flds_mod + use seq_cdata_mod + use seq_infodata_mod + use seq_timemgr_mod + + use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl + use physconst, only: pi + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + + use phys_grid, only: get_ncols_p,get_rlat_all_p,get_rlon_all_p, & + get_area_all_p,ngcols, get_gcol_p + use ppgrid, only: pcols,begchunk,endchunk + use cam_logfile, only: iulog + use cam_control_mod, only: initial_run + + use ocn_types, only: ocn_out_t + use ocn_comp, only: ocn_init, ocn_run, ocn_write_restart, ocn_read_restart, frac + use ocn_spmd, only: masterproc, iam + use ocn_time_manager, only: get_curr_date, get_nstep, advance_timestep, is_first_step, & + timemgr_init + use ocn_filenames, only: restart_filename + use perf_mod + + implicit none + private + save + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public ocn_init_mct ! Initialization method + public ocn_run_mct ! Run method + public ocn_final_mct ! Finalization method + +!-------------------------------------------------------------------------- +! Private interfaces +!-------------------------------------------------------------------------- + + private :: ocn_SetgsMap_mct + private :: ocn_export_mct + +!-------------------------------------------------------------------------- +! Private data +!-------------------------------------------------------------------------- + + type(ocn_out_t), pointer :: ocn_out(:) + integer :: index_o2x_So_t + + + +!=============================================================== +contains +!=============================================================== + + subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) + + !---------------------------------------------------------- + ! + ! Arguments + ! + type(ESMF_Clock), intent(inout) :: EClock + type(seq_cdata), intent(inout) :: cdata_o + type(mct_aVect), intent(inout) :: x2o_o, o2x_o + character(len=*), optional, intent(in) :: NLFilename ! Namelist filename + ! + ! Local variables + ! + integer :: OCNID + integer :: mpicom_ocn + type(mct_gsMap), pointer :: gsMap_ocn + type(mct_gGrid), pointer :: dom_o + type(seq_infodata_type), pointer :: infodata ! Input init object + integer :: c, ncols, i, lsize + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! Reference time of day (sec) + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time of day (sec) + logical :: perpetual_run ! If in perpetual mode or not + integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) + character(len=256) :: calendar ! Calendar type + integer :: dtime ! Time-step + !---------------------------------------------------------- + ! + ! Set cdata pointers + ! + call seq_cdata_setptrs(cdata_o,ID=OCNID, mpicom=mpicom_ocn, & + gsMap=gsMap_ocn, dom=dom_o, infodata=infodata) + ! + ! Initialize time manager. + ! + call seq_timemgr_EClockGetData(EClock, start_ymd=start_ymd, & + start_tod=start_tod, ref_ymd=ref_ymd, & + ref_tod=ref_tod, stop_ymd=stop_ymd, & + stop_tod=stop_tod, dtime=dtime, & + calendar=calendar ) + + call seq_infodata_GetData(infodata, & + perpetual=perpetual_run, & + perpetual_ymd=perpetual_ymd) + + if (initial_run)then + call timemgr_init( calendar_in=calendar, start_ymd=start_ymd, & + start_tod=start_tod, ref_ymd=ref_ymd, & + ref_tod=ref_tod, stop_ymd=stop_ymd, & + stop_tod=stop_tod, dtime_in=dtime, & + perpetual_run=perpetual_run, & + perpetual_ymd=perpetual_ymd ) + end if + ! + ! Initialize ocn model + ! + call ocn_init( mpicom_ocn, ocn_out, & + start_ymd, start_tod, ref_ymd, ref_tod, stop_ymd, stop_tod, & + perpetual_run, perpetual_ymd, calendar) + ! + ! Initialize MCT gsMap, domain and attribute vectors + ! + call ocn_SetgsMap_mct( mpicom_ocn, OCNID, gsMap_ocn ) + lsize = mct_gsMap_lsize(gsMap_ocn, mpicom_ocn) + ! + ! Initialize mct domain + ! + call ocn_domain_mct( lsize, gsMap_ocn, dom_o ) + ! + ! Inialize mct attribute vectors + ! + call mct_aVect_init(x2o_o, rList=seq_flds_x2o_fields, lsize=lsize) + call mct_aVect_zero(x2o_o) + + call mct_aVect_init(o2x_o, rList=seq_flds_o2x_fields, lsize=lsize) + index_o2x_So_t = mct_avect_indexra(o2x_o,'So_t') + call mct_aVect_zero(o2x_o) + ! + ! Create initial ocn export state + ! + if (is_first_step()) then + call advance_timestep() ! first timestep skipped in ocean models + else + call ocn_run( ocn_out ) + end if + call ocn_export_mct( ocn_out, o2x_o ) + call seq_infodata_PutData( infodata, ocn_prognostic=.false., ocnrof_prognostic=.false.) + + end subroutine ocn_init_mct + +!========================================================================== + + subroutine ocn_run_mct ( EClock, cdata_o, x2o_o, o2x_o) + + !---------------------------------------------------------- + ! + ! Arguments + ! + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata_o + type(mct_aVect) , intent(inout) :: x2o_o + type(mct_aVect) , intent(inout) :: o2x_o + ! + ! Local variables + ! + logical :: rstwr ! .true. ==> write a restart file + logical :: rstwr_sync ! .true. ==> write a restart file + integer :: ymd ! Current date (YYYYMMDD) + integer :: yr ! Current year + integer :: mon ! Current month + integer :: day ! Current day + integer :: tod ! Current time of day (sec) + integer :: ymd_sync ! Current year of sync clock + integer :: tod_sync ! Time of day + integer :: stop_ymd ! stop time (YYYYMMDD) + integer :: stop_tod ! stop time (sec) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + character(len=shr_kind_cl) :: fname ! restart filename + character(len=*), parameter :: SubName = "ocn_run_mct" + !---------------------------------------------------------- + ! Determine if time to write restarts and if time to end + + rstwr_sync = seq_timemgr_RestartAlarmIsOn(EClock) + + rstwr = .false. + if (rstwr_sync) rstwr = .true. + + ! Advance ocn timestep + + call advance_timestep() + + ! Write restart if appropriate + ! Note that time manager does not advance clock on restart (if restart is written after + ! time step is advanced) - this is done in ocn_comp_init + + if (rstwr) then + call t_startf ('ocn_write_restart') + call seq_timemgr_EClockGetData( EClock, curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync, curr_tod=tod_sync ) + fname = restart_filename( yr_sync, mon_sync, day_sync, tod_sync ) + call ocn_write_restart( fname, ocn_out ) + call t_stopf ('ocn_write_restart') + end if + + ! Run ocean model + + call t_startf ('ocn_run') + call ocn_run( ocn_out ) + call t_stopf ('ocn_run') + + ! Extract export state + + call t_startf ('ocn_export') + call ocn_export_mct (ocn_out, o2x_o ) + call t_stopf ('ocn_export') + + ! Check that internal clock is in sync with master clock + + call get_curr_date(yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' dom ymd=',ymd ,' don tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call shr_sys_abort( SubName//":: Internal SOM ocean model clock not in sync with Sync Clock") + end if + + end subroutine ocn_run_mct + +!========================================================================== + + subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o) + + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata_o + type(mct_aVect) , intent(inout) :: x2o_o + type(mct_aVect) , intent(inout) :: o2x_o + ! ********************* + ! fill this in + ! ********************* + end subroutine ocn_final_mct + +!========================================================================== + + subroutine ocn_export_mct( ocn_out, o2x_o ) + + !------------------------------------------------------------------- + implicit none + type(ocn_out_t), intent(in) :: ocn_out(begchunk:endchunk) + type(mct_aVect), intent(inout) :: o2x_o + + integer :: i,c,ig ! indices + integer :: ncols ! number of columns + !----------------------------------------------------------------------- + + ig=1 + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + o2x_o%rAttr(index_o2x_So_t,ig) = ocn_out(c)%ts(i) + ig=ig+1 + end do + end do + + end subroutine ocn_export_mct + +!========================================================================== + + subroutine ocn_SetgsMap_mct( mpicom_ocn, OCNID, gsMap_ocn ) + use phys_grid, only : get_nlcols_p + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: mpicom_ocn + integer , intent(in) :: OCNID + type(mct_gsMap), intent(out) :: gsMap_ocn + ! + ! Local Variables + ! + integer, allocatable :: gindex(:) + integer :: i, startpoint, j, sizebuf, n, c, ncols + integer :: ier + integer :: gcol, nlcols + !------------------------------------------------------------------- + + ! Determine global seg map + + sizebuf=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + sizebuf = sizebuf+1 + end do + end do + + allocate(gindex(sizebuf)) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i = 1,ncols + n=n+1 + gindex(n) = get_gcol_p(c,i) + end do + end do + nlcols = get_nlcols_p() + call mct_gsMap_init( gsMap_ocn, gindex, mpicom_ocn, OCNID, nlcols, ngcols ) + + deallocate(gindex) + + end subroutine ocn_SetgsMap_mct + +!=============================================================================== + + subroutine ocn_domain_mct( lsize, gsMap_o, dom_o ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: lsize + type(mct_gsMap), intent(inout) :: gsMap_o + type(mct_ggrid), intent(inout) :: dom_o + ! + ! Local Variables + ! + integer :: n,j,i,c,ncols ! indices + real(r8) :: lats(pcols) ! array of global latitude indices + real(r8) :: lons(pcols) ! array of global longitude indices + real(r8) :: area(pcols) ! area in radians squared for each grid point + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + real(r8), parameter :: radtodeg = 180.0_r8/pi + !------------------------------------------------------------------- + ! + ! Initialize domain type + ! + call mct_gGrid_init( GGrid=dom_o, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_o, iam, idata) + call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize) + call mct_gGrid_importIAttr(dom_o,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_o,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_o,"mask" ,data,lsize) + call mct_gGrid_importRAttr(dom_o,"frac" ,data,lsize) + ! + ! Fill in correct values for domain components + ! + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, ncols, lats) + do i=1,ncols + n = n+1 + data(n) = lats(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_o,"lat",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlon_all_p(c, ncols, lons) + do i=1,ncols + n = n+1 + data(n) = lons(i)*radtodeg + end do + end do + call mct_gGrid_importRAttr(dom_o,"lon",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_area_all_p(c, ncols, area) + do i=1,ncols + n = n+1 + data(n) = area(i) + end do + end do + call mct_gGrid_importRAttr(dom_o,"area",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + n = n+1 + if (frac(c)%land(i) < 1._r8) then + data(n) = 1._r8 ! mask + else + data(n) = 0._r8 + end if + end do + end do + call mct_gGrid_importRAttr(dom_o,"mask",data,lsize) + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + n = n+1 + data(n) = 1._r8 - frac(c)%land(i) + end do + end do + call mct_gGrid_importRAttr(dom_o,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine ocn_domain_mct + +end module ocn_comp_mct diff --git a/src/utils/cam_dom/ocn_filenames.F90 b/src/utils/cam_dom/ocn_filenames.F90 new file mode 100644 index 0000000000..e14d354b67 --- /dev/null +++ b/src/utils/cam_dom/ocn_filenames.F90 @@ -0,0 +1,136 @@ +module ocn_filenames + +!----------------------------------------------------------------------- +! +! DESCRIPTION +! Module and methods to handle filenames needed for the model. This +! includes input filenames, and most output filenames that the model +! uses. All filenames that the model uses will use methods or data +! constructed by this module. In some cases (such as the cam_history module) +! other modules or routines will store the actual filenames used, but +! this module is used to determine the names. +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: shr_kind_cs, shr_kind_cl + use shr_sys_mod, only: shr_sys_abort + use cam_control_mod, only: caseid + + implicit none + + integer, parameter :: nlen = shr_kind_cl ! String length + +CONTAINS + + character(len=nlen) function restart_filename( year, month, day, sec, case ) + + !----------------------------------------------------------------------- + ! + ! !DESCRIPTION: Create a filename from a filename specifyer. The + ! filename specifyer includes codes for setting things such as the + ! year, month, day, seconds in day, caseid, and tape number. This + ! routine is private to filenames.F90 + ! + ! Interpret filename specifyer string with: + ! + ! %c for case, + ! %t for optional number argument sent into function + ! %y for year + ! %m for month + ! %d for day + ! %s for second + ! %% for the "%" character + ! + ! If the filename specifyer has spaces " ", they will be trimmed out + ! of the resulting filename. + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: year ! Simulation year + integer , intent(in) :: month ! Simulation month + integer , intent(in) :: day ! Simulation day + integer , intent(in) :: sec ! Seconds into current simulation day + character(len=*), intent(in), optional :: case ! Optional casename + ! + ! Local variables + ! + character(len=nlen) :: string ! Temporary character string + character(len=nlen) :: format ! Format character string + integer :: i, n ! Loop variables + logical :: done + character(len=nlen) :: filename_spec = '%c.camdom.r.%y-%m-%d-%s' ! ocn restarts + !----------------------------------------------------------------------- + + if ( len_trim(filename_spec) == 0 )then + call shr_sys_abort ('RESTART_FILENAME: filename specifier is empty') + end if + if ( index(trim(filename_spec)," ") /= 0 )then + call shr_sys_abort ('RESTART_FILENAME: filename specifier can not contain a space:'//trim(filename_spec)) + end if + ! + ! Go through each character in the filename specifyer and interpret if special string + ! + i = 1 + restart_filename = '' + do while ( i <= len_trim(filename_spec) ) + ! + ! If following is an expansion string + ! + if ( filename_spec(i:i) == "%" )then + i = i + 1 + select case( filename_spec(i:i) ) + case( 'c' ) ! caseid + if ( present(case) )then + string = trim(case) + else + string = trim(caseid) + end if + case( 'y' ) ! year + if ( year > 99999 ) then + format = '(i6.6)' + else if ( year > 9999 ) then + format = '(i5.5)' + else + format = '(i4.4)' + end if + write(string,format) year + case( 'm' ) ! month + write(string,'(i2.2)') month + case( 'd' ) ! day + write(string,'(i2.2)') day + case( 's' ) ! second + write(string,'(i5.5)') sec + case( '%' ) ! percent character + string = "%" + case default + call shr_sys_abort ('RESTART_FILENAME: Invalid expansion character: '//filename_spec(i:i)) + end select + ! + ! Otherwise take normal text up to the next "%" character + ! + else + n = index( filename_spec(i:), "%" ) + if ( n == 0 ) n = len_trim( filename_spec(i:) ) + 1 + if ( n == 0 ) exit + string = filename_spec(i:n+i-2) + i = n + i - 2 + end if + if ( len_trim(restart_filename) == 0 )then + restart_filename = trim(string) + else + if ( (len_trim(restart_filename)+len_trim(string)) >= nlen )then + call shr_sys_abort ('RESTART_FILENAME: Resultant filename too long') + end if + restart_filename = trim(restart_filename) // trim(string) + end if + i = i + 1 + end do + if ( len_trim(restart_filename) == 0 )then + call shr_sys_abort('RESTART_FILENAME: Resulting filename is empty') + end if + +end function restart_filename + +end module ocn_filenames diff --git a/src/utils/cam_dom/ocn_spmd.F90 b/src/utils/cam_dom/ocn_spmd.F90 new file mode 100644 index 0000000000..05f05eb604 --- /dev/null +++ b/src/utils/cam_dom/ocn_spmd.F90 @@ -0,0 +1,66 @@ +module ocn_spmd + + !----------------------------------------------------------------------- + ! MPI initialization (number of cpus, processes, tids, etc) + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + + + implicit none + private +#include + save + + ! Default settings valid even if there is no spmd + + logical, public :: masterproc ! proc 0 logical for printing msgs + integer, public :: iam ! processor number + integer, public :: npes ! number of processors for ocn + integer, public :: mpicom ! communicator group for ocn + + public ocn_spmd_init + +contains + + subroutine ocn_spmd_init( ocn_mpicom ) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: ocn_mpicom + ! + ! Local variables + ! + integer :: ier + !----------------------------------------------------------------------- + + ! Initialize mpi and set communication group + + mpicom = ocn_mpicom + +#if (defined SPMD) + ! Get my processor id + + call mpi_comm_rank(mpicom, iam, ier) + if (iam==0) then + masterproc = .true. + else + masterproc = .false. + end if + + ! Get number of processors + + call mpi_comm_size(mpicom, npes, ier) + +#else + + iam = 0 + masterproc = .true. + npes = 1 + +#endif + + end subroutine ocn_spmd_init + +end module ocn_spmd diff --git a/src/utils/cam_dom/ocn_time_manager.F90 b/src/utils/cam_dom/ocn_time_manager.F90 new file mode 100644 index 0000000000..042fa0121b --- /dev/null +++ b/src/utils/cam_dom/ocn_time_manager.F90 @@ -0,0 +1,1229 @@ +module ocn_time_manager + + use shr_kind_mod, only: r8 => shr_kind_r8, SHR_KIND_CS + use shr_cal_mod, only: shr_cal_noleap, shr_cal_gregorian + use string_utils, only: to_upper + use cam_abortutils, only: endrun + use ESMF + use ocn_spmd + use cam_logfile, only: iulog + + implicit none + private +#include + save + +! Public methods + + public ::& + timemgr_init, &! time manager initialization + advance_timestep, &! increment timestep number + get_step_size, &! return step size in seconds + get_nstep, &! return timestep number + get_curr_date, &! return date components at end of current timestep + get_prev_date, &! return date components at beginning of current timestep + get_start_date, &! return components of the start date + get_ref_date, &! return components of the reference date + get_perp_date, &! return components of the perpetual date, and current time of day + get_curr_time, &! return components of elapsed time since reference date at end of current timestep + get_prev_time, &! return components of elapsed time since reference date at beg of current timestep + get_curr_calday, &! return calendar day at end of current timestep + get_calday, &! return calendar day from input date + is_first_step, &! return true on first step of initial run + is_first_restart_step, &! return true on first step of restart or branch run + is_end_curr_day, &! return true on last timestep in current day + is_end_curr_month, &! return true on last timestep in current month + is_last_step, &! return true on last timestep + is_perpetual, &! return true if perpetual calendar is in use + timemgr_is_caltype, &! return true if incoming calendar type string matches actual calendar type in use + timemgr_write_restart, &! write info to file needed to restart the time manager + timemgr_read_restart, &! read info from file needed to restart the time manager + timemgr_restart, &! restart the time manager + timemgr_check_restart, &! check that restart agrees with input clock info + timemgr_datediff, &! calculate difference between two time instants + timemgr_time_ge, &! check if time2 is later than or equal to time1 + timemgr_time_inc ! increment time instant by a given interval + +! Public data for namelist input + + integer, parameter :: uninit_int = -999999999 + integer, public ::& + dtime = uninit_int ! timestep in seconds + + ! Private module data + + type(ESMF_Calendar), target :: tm_cal ! calendar + type(ESMF_Clock) :: tm_clock ! Model clock + type(ESMF_Time) :: tm_perp_date ! perpetual date + + integer ::& ! Data required to restart time manager: + rst_nstep = uninit_int, &! current step number + rst_step_days = uninit_int, &! days component of timestep size + rst_step_sec = uninit_int, &! timestep size seconds + rst_start_ymd = uninit_int, &! start date + rst_start_tod = uninit_int, &! start time of day + rst_stop_ymd = uninit_int, &! stop date + rst_stop_tod = uninit_int, &! stop time of day + rst_ref_ymd = uninit_int, &! reference date + rst_ref_tod = uninit_int, &! reference time of day + rst_curr_ymd = uninit_int, &! current date + rst_curr_tod = uninit_int, &! current time of day + rst_perp_ymd = uninit_int ! perpetual date + character(len=32) :: rst_calendar ! Calendar + logical ::& + rst_perp_cal = .false. ! true when using perpetual calendar + + character(len=32) :: calendar ! Calendar type + logical :: tm_first_restart_step = .false. ! true for first step of a restart or branch run + logical :: tm_perp_calendar = .false. ! true when using perpetual calendar + integer :: cal_type = uninit_int ! calendar type + +!========================================================================================= +contains +!========================================================================================= + +subroutine timemgr_init( calendar_in, start_ymd, start_tod, ref_ymd, & + ref_tod, stop_ymd, stop_tod, dtime_in, & + perpetual_run, perpetual_ymd ) + +! Initialize the ESMF time manager. +! +! NOTE - Assumptions: +! 1) The namelist variables have been set before this routine is called. (set in control/parse_namelist.F90) +! Arguments + character(len=*), intent(IN) :: calendar_in ! Calendar type + integer, intent(IN) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(IN) :: start_tod ! Start time of day (sec) + integer, intent(IN) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(IN) :: ref_tod ! Reference time of day (sec) + integer, intent(IN) :: stop_ymd ! Stop date (YYYYMMDD) + integer, intent(IN) :: stop_tod ! Stop time of day (sec) + integer, intent(IN) :: dtime_in ! Time-step + logical, intent(IN) :: perpetual_run ! If in perpetual mode or not + integer, intent(IN) :: perpetual_ymd ! Perpetual date (YYYYMMDD) + +! Local variables + character(len=*), parameter :: sub = 'timemgr_init' + integer :: rc ! return code + type(ESMF_Time) :: start_date ! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: curr_date ! temporary date used in logic + type(ESMF_Time) :: ref_date ! reference date for time coordinate +!---------------------------------------------------------------------------------------- + +! Initalize calendar type. + + calendar = trim(calendar_in) + + call init_calendar() + +! Initalize start date. + + start_date = TimeSetymd( start_ymd, start_tod, "start_date" ) + +! Initalize stop date. + + stop_date = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) + +! Initalize reference date for time coordinate. + + ref_date = TimeSetymd( ref_ymd, ref_tod, "ref_date" ) + + curr_date = start_date + +! Initialize clock and stop date + + dtime = dtime_in + call initialize_clock( start_date, ref_date, curr_date, stop_date ) + +! Initialize date used for perpetual calendar day calculation. + + if ( perpetual_run ) then + tm_perp_calendar = .true. + tm_perp_date = TimeSetymd( perpetual_ymd, 0, "tm_perp_date" ) + end if + +! Print configuration summary to log file (stdout). + + if (masterproc) then + call timemgr_print() + end if + +end subroutine timemgr_init + +!========================================================================================= + +subroutine initialize_clock( start_date, ref_date, curr_date, stop_date ) +! +! Purpose: Initialize the clock based on the start_date, ref_date, and curr_date +! as well as the settings from the namelist specifying the time to stop +! +! Input variables + type(ESMF_Time), intent(inout) :: start_date ! start date for run + type(ESMF_Time), intent(in) :: ref_date ! reference date for time coordinate + type(ESMF_Time), intent(inout) :: curr_date ! current date (equal to start_date) + type(ESMF_Time), intent(inout) :: stop_date ! stop date for run + +! Local variables + character(len=*), parameter :: sub = 'initialize_clock' + type(ESMF_TimeInterval) :: step_size ! timestep size + type(ESMF_Time) :: current ! current date (from clock) + integer :: yr, mon, day, tod ! Year, month, day, and second as integers + integer :: rc ! return code + + if ( mod(86400,dtime) /= 0 ) then +!!!! call endrun (sub//': timestep must divide evenly into 1 day') + end if + + call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') + + if ( stop_date <= start_date ) then + write(iulog,*)sub, ': stop date must be specified later than start date: ' + call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call endrun + end if + if ( curr_date >= stop_date ) then + write(iulog,*)sub, ': stop date must be specified later than current date: ' + call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call endrun + end if + +! Initialize the clock + + tm_clock = ESMF_ClockCreate("OCN Time-manager clock", step_size, start_date, & + stopTime=stop_date, refTime=ref_date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockSetup') + +! Advance clock to the current time (in case of a restart) + + call ESMF_ClockGet(tm_clock, currTime=current, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + do while( curr_date > current ) + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + call ESMF_ClockGet(tm_clock, currTime=current ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + end do +end subroutine initialize_clock + +!========================================================================================= + +function TimeSetymd( ymd, tod, desc ) +! +! Set the time by an integer as YYYYMMDD and integer seconds in the day +! + integer, intent(in) :: ymd ! Year, month, day YYYYMMDD + integer, intent(in) :: tod ! Time of day in seconds + character(len=*), intent(in) :: desc ! Description of time to set + + type(ESMF_Time) :: TimeSetymd ! Return value + + character(len=*), parameter :: sub = 'TimeSetymd' + integer :: yr, mon, day ! Year, month, day as integers + integer :: rc ! return code + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > 24*3600) )then + write(iulog,*) sub//': error yymmdd is a negative number or time-of-day out of bounds', & + ymd, tod + call endrun + end if + yr = ymd / 10000 + mon = (ymd - yr*10000) / 100 + day = ymd - yr*10000 - mon*100 + call ESMF_TimeSet( TimeSetymd, yy=yr, mm=mon, dd=day, s=tod, & + calendar=tm_cal, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet: setting '//trim(desc)) +end function TimeSetymd + +!========================================================================================= + +integer function TimeGetymd( date, tod ) +! +! Get the date and time of day in ymd from ESMF Time. +! + type(ESMF_Time), intent(inout) :: date ! Input date to convert to ymd + integer, intent(out), optional :: tod ! Time of day in seconds + + character(len=*), parameter :: sub = 'TimeGetymd' + integer :: yr, mon, day + integer :: rc ! return code + + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + TimeGetymd = yr*10000 + mon*100 + day + if ( present( tod ) )then + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + end if + if ( yr < 0 )then + write(iulog,*) sub//': error year is less than zero', yr + call endrun + end if +end function TimeGetymd + +!========================================================================================= + +subroutine timemgr_restart( stop_ymd, stop_tod ) + +! Restart the ESMF time manager. +! +! NOTE - Assumptions: +! 1) Restart data have been read on the master process before this routine is called. +! 2) Stopping time has been set and input to this routine. +! Arguments + integer, intent(IN) :: stop_ymd ! Stop date (YYYYMMDD) + integer, intent(IN) :: stop_tod ! Stop time of day (sec) + +! Local variables + character(len=*), parameter :: sub = 'timemgr_restart' + integer :: rc ! return code + type(ESMF_Time) :: start_date ! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: ref_date ! reference date + type(ESMF_Time) :: curr_date ! date of data in restart file +!----------------------------------------------------------------------------------------- + + call mpi_bcast(rst_calendar, len(rst_calendar), MPI_CHARACTER, 0, mpicom, rc) + call mpi_bcast(rst_step_sec, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_start_ymd, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_start_tod, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_stop_ymd, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_stop_tod, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_ref_ymd, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_ref_tod, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_curr_ymd, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_curr_tod, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_perp_ymd, 1, MPI_INTEGER, 0, mpicom, rc) + call mpi_bcast(rst_perp_cal, 1, MPI_LOGICAL, 0, mpicom, rc) + + calendar = trim(rst_calendar) + +! Initialize calendar type. + + call init_calendar( ) + +! Initialize the timestep. + + dtime = rst_step_sec + +! Initialize start date. + + start_date = TimeSetymd( rst_start_ymd, rst_start_tod, "start_date" ) + +! Initialize stop date. + + stop_date = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) + +! Initialize current date. + + curr_date = TimeSetymd( rst_curr_ymd, rst_curr_tod, "curr_date" ) + +! Initialize ref date. + + ref_date = TimeSetymd( rst_ref_ymd, rst_ref_tod, "ref_date" ) + +! Initialize clock and the stop date + + call initialize_clock( start_date, ref_date, curr_date, stop_date ) + +! Set flag that this is the first timestep of the restart run. + + tm_first_restart_step = .true. + +! Initialize date used for perpetual calendar day calculation. + + if ( rst_perp_cal ) then + tm_perp_date = TimeSetymd( rst_perp_ymd, 0, "tm_perp_date" ) + tm_perp_calendar = .true. + end if + +! Print configuration summary to log file (stdout). + + if (masterproc) then + call timemgr_print() + end if + +end subroutine timemgr_restart + +!========================================================================================= + +subroutine timemgr_check_restart( calendar_in, start_ymd, start_tod, ref_ymd, & + ref_tod, dtime_in, perpetual_run, perpetual_ymd ) + +! Check that time-manager restart agrees with input clock information primitives. +! +! Arguments + character(len=*), intent(IN) :: calendar_in ! Calendar type + integer, intent(IN) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(IN) :: start_tod ! Start time of day (sec) + integer, intent(IN) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(IN) :: ref_tod ! Reference time of day (sec) + integer, intent(IN) :: dtime_in ! Time-step + logical, intent(IN) :: perpetual_run ! If in perpetual mode or not + integer, intent(IN) :: perpetual_ymd ! Perpetual date (YYYYMMDD) + +! Local variables + character(len=*), parameter :: sub = 'timemgr_check_restart' +!----------------------------------------------------------------------------------------- + + ! Check that input agrees with data on restart file + + if ( (rst_start_ymd /= start_ymd) .or. (rst_start_tod /= start_tod) )then + call endrun( sub//': input start date does not agree with restart' ) + end if + if ( (rst_ref_ymd /= ref_ymd) .or. (rst_ref_tod /= ref_tod) )then + call endrun( sub//': input start date does not agree with restart' ) + end if + if ( rst_perp_cal .neqv. perpetual_run )then + call endrun( sub//': input perpetual mode does not agree with restart' ) + end if + if ( rst_step_sec /= dtime_in )then + call endrun( sub//': input dtime does not agree with restart' ) + end if + if ( trim(rst_calendar) /= trim(calendar_in) )then + write(iulog,*) 'Input calendar: ', trim(calendar_in) + write(iulog,*) 'Restart calendar: ', trim(rst_calendar) + call endrun( sub//': input calendar does not agree with restart' ) + end if + if ( perpetual_run )then + if ( (rst_perp_ymd /= perpetual_ymd) )then + call endrun( sub//': input perpetual date does not agree with restart' ) + end if + end if + +end subroutine timemgr_check_restart + +!========================================================================================= + +subroutine init_calendar( ) +! +! Initialize calendar +! +! Local variables + character(len=*), parameter :: sub = 'init_calendar' + type(ESMF_CalKind_Flag) :: cal_type ! calendar type + character(len=len(calendar)) :: caltmp + integer :: rc ! return code + + caltmp = to_upper(trim(calendar) ) + if ( trim(caltmp) == trim(shr_cal_noleap) ) then + cal_type = ESMF_CALKIND_NOLEAP + else if ( trim(caltmp) == trim(shr_cal_gregorian) ) then + cal_type = ESMF_CALKIND_GREGORIAN + else + write(iulog,*)sub,': unrecognized calendar specified: ',calendar + call endrun + end if + tm_cal = ESMF_CalendarCreate( name=caltmp, calkindflag=cal_type, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_CalendarSet') +end subroutine init_calendar + +!========================================================================================= + +subroutine timemgr_print() + +! Local variables + character(len=*), parameter :: sub = 'timemgr_print' + integer :: rc + integer :: yr, mon, day + integer ::& ! Data required to restart time manager: + nstep = uninit_int, &! current step number + step_sec = uninit_int, &! timestep size seconds + start_yr = uninit_int, &! start year + start_mon = uninit_int, &! start month + start_day = uninit_int, &! start day of month + start_tod = uninit_int, &! start time of day + stop_yr = uninit_int, &! stop year + stop_mon = uninit_int, &! stop month + stop_day = uninit_int, &! stop day of month + stop_tod = uninit_int, &! stop time of day + ref_yr = uninit_int, &! reference year + ref_mon = uninit_int, &! reference month + ref_day = uninit_int, &! reference day of month + ref_tod = uninit_int, &! reference time of day + curr_yr = uninit_int, &! current year + curr_mon = uninit_int, &! current month + curr_day = uninit_int, &! current day of month + curr_tod = uninit_int ! current time of day + integer(ESMF_KIND_I8) :: step_no + type(ESMF_Time) :: start_date! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: curr_date ! date of data in restart file + type(ESMF_Time) :: ref_date ! reference date + type(ESMF_TimeInterval) :: step ! Time-step +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & + refTime=ref_date, stopTime=stop_date, timeStep=step, & + advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + + write(iulog,*)' ********** CAM-DOM Time Manager Configuration **********' + + call ESMF_TimeIntervalGet( step, s=step_sec, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + call ESMF_TimeGet( start_date, yy=start_yr, mm=start_mon, dd=start_day, & + s=start_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( stop_date, yy=stop_yr, mm=stop_mon, dd=stop_day, & + s=stop_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( ref_date, yy=ref_yr, mm=ref_mon, dd=ref_day, s=ref_tod, & + rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( curr_date, yy=curr_yr, mm=curr_mon, dd=curr_day, & + s=curr_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + write(iulog,*)' Calendar type: ',trim(calendar) + write(iulog,*)' Timestep size (seconds): ', step_sec + write(iulog,*)' Start date (yr mon day tod): ', start_yr, start_mon, & + start_day, start_tod + write(iulog,*)' Stop date (yr mon day tod): ', stop_yr, stop_mon, & + stop_day, stop_tod + write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & + ref_day, ref_tod + write(iulog,*)' Current step number: ', nstep + write(iulog,*)' Current date (yr mon day tod): ', curr_yr, curr_mon, & + curr_day, curr_tod + + if ( tm_perp_calendar ) then + call ESMF_TimeGet( tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + write(iulog,*)' Use perpetual diurnal cycle date (yr mon day): ', & + yr, mon, day + end if + + write(iulog,*)' ************************************************' + +end subroutine timemgr_print +!========================================================================================= + +subroutine advance_timestep() + +! Increment the timestep number. + +! Local variables + character(len=*), parameter :: sub = 'advance_timestep' + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + +! Set first step flag off. + + tm_first_restart_step = .false. + +end subroutine advance_timestep +!========================================================================================= + +integer function get_step_size() + +! Return the step size in seconds. + +! Local variables + character(len=*), parameter :: sub = 'get_step_size' + type(ESMF_TimeInterval) :: step_size ! timestep size + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, timeStep=step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + call ESMF_TimeIntervalGet(step_size, s=get_step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockTimeIntervalGet') + +end function get_step_size +!========================================================================================= + +integer function get_nstep() + +! Return the timestep number. + +! Local variables + character(len=*), parameter :: sub = 'get_nstep' + integer :: rc + integer(ESMF_KIND_I8) :: step_no +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + get_nstep = step_no + +end function get_nstep +!========================================================================================= + +subroutine get_curr_date(yr, mon, day, tod, offset) + +! Return date components valid at end of current timestep with an optional +! offset (positive or negative) in seconds. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + +! Local variables + character(len=*), parameter :: sub = 'get_curr_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_curr_date +!========================================================================================= + +subroutine get_perp_date(yr, mon, day, tod, offset) + +! Return time of day valid at end of current timestep and the components +! of the perpetual date (with an optional offset (positive or negative) in seconds. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + +! Local variables + character(len=*), parameter :: sub = 'get_perp_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: DelTime +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + ! Get time of day add it to perpetual date + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet(DelTime, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + DelTime + if ( present(offset) )then + call ESMF_TimeIntervalSet(DelTime, s=offset, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + DelTime + end if + ! Get time of day from the result + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + + ! Get the date from the fixed perpetual date (in case it overflows to next day) + call ESMF_TimeGet(tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + +end subroutine get_perp_date +!========================================================================================= + +subroutine get_prev_date(yr, mon, day, tod) + +! Return date components valid at beginning of current timestep. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_prev_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_prev_date +!========================================================================================= + +subroutine get_start_date(yr, mon, day, tod) + +! Return date components valid at beginning of initial run. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_start_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, startTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_start_date +!========================================================================================= + +subroutine get_ref_date(yr, mon, day, tod) + +! Return date components of the reference date. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_ref_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, refTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_ref_date +!========================================================================================= + +subroutine get_curr_time(days, seconds) + +! Return time components valid at end of current timestep. +! Current time is the time interval between the current date and the reference date. + +! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + +! Local variables + character(len=*), parameter :: sub = 'get_curr_time' + integer :: rc + type(ESMF_Time) :: cdate, rdate + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=cdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_ClockGet( tm_clock, refTime=rdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + diff = cdate - rdate + + call ESMF_TimeIntervalGet(diff, d=days, s=seconds, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + +end subroutine get_curr_time +!========================================================================================= + +subroutine get_prev_time(days, seconds) + +! Return time components valid at beg of current timestep. +! prev time is the time interval between the prev date and the reference date. + +! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + +! Local variables + character(len=*), parameter :: sub = 'get_prev_time' + integer :: rc + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for prevTime') + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for refTime') + diff = date - ref_date + call ESMF_TimeIntervalGet( diff, d=days, s=seconds, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeintervalGet') + +end subroutine get_prev_time +!========================================================================================= + +function get_curr_calday(offset) + +! Return calendar day at end of current timestep with optional offset. +! Calendar day 1.0 = 0Z on Jan 1. + +! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. +! Return value + real(r8) :: get_curr_calday + +! Local variables + character(len=*), parameter :: sub = 'get_curr_calday' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off, diurnal + integer :: year, month, day, tod +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + if ( tm_perp_calendar ) then +! Get current time-of-day from clock + call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') +! Get date from perpetual date add time-of-day to it + call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + diurnal +!!!! write(iulog,*) ' tod = ', tod +!!!! call ESMF_TimePrint( date, "string" ) + end if + + call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') +! +! WARNING: Gregorian calendar fakes day 366 +! +! The zenith angle calculation is only capable of using a 365-day calendar. +! If a Gregorian calendar is being used, the last day of a leap year (day 366) +! is sent to the model as a repetition of the previous day (day 365). +! This is done by decrementing calday by 1 immediately below. +! bundy, July 2008 +! + if (( get_curr_calday > 366.0_r8 ) .and. ( get_curr_calday <= 367.0_r8 ) & + .and. (timemgr_is_caltype(trim(shr_cal_gregorian)))) then + get_curr_calday = get_curr_calday - 1.0_r8 + endif + + if ( (get_curr_calday < 1.0_r8) .or. (get_curr_calday > 366.0_r8) )then + write(iulog,*) 'ocn '//sub//' calday = ', get_curr_calday + if ( present(offset) ) write(iulog,*) 'offset = ', offset + call endrun( sub//': error get_curr_calday out of bounds' ) + end if + +end function get_curr_calday +!========================================================================================= + +function get_calday(ymd, tod) + +! Return calendar day corresponding to specified time instant. +! Calendar day 1.0 = 0Z on Jan 1. + +! Arguments + integer, intent(in) :: & + ymd, &! date in yearmmdd format + tod ! time of day (seconds past 0Z) + +! Return value + real(r8) :: get_calday + +! Local variables + character(len=*), parameter :: sub = 'get_calday' + integer :: rc ! return code + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + date = TimeSetymd( ymd, tod, "get_calday" ) + call ESMF_TimeGet( date, dayOfYear_r8=get_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +! +! WARNING: Gregorian calendar fakes day 366 +! +! The zenith angle calculation is only capable of using a 365-day calendar. +! If a Gregorian calendar is being used, the last day of a leap year (day 366) +! is sent to the model as a repetition of the previous day (day 365). +! This is done by decrementing calday by 1 immediately below. +! bundy, July 2008 +! + if (( get_calday > 366.0_r8 ) .and. ( get_calday <= 367.0_r8 ) & + .and. (timemgr_is_caltype(trim(shr_cal_gregorian)))) then + get_calday = get_calday - 1.0_r8 + endif + + if ( (get_calday < 1.0_r8) .or. (get_calday > 366.0_r8) )then + write(iulog,*) 'ocn calday = ', get_calday + call endrun( sub//': error calday out of range' ) + end if + +end function get_calday +!========================================================================================= + +logical function timemgr_is_caltype( cal_in ) + +! Return true if incoming calendar type string matches actual calendar type in use + + character(len=*), intent(in) :: cal_in + +!----------------------------------------------------------------------------------------- + + timemgr_is_caltype = ( to_upper(trim(calendar)) == to_upper(trim(cal_in)) ) + +end function timemgr_is_caltype +!========================================================================================= + +function is_end_curr_day() + +! Return true if current timestep is last timestep in current day. + +! Return value + logical :: is_end_curr_day + +! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) +!----------------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_day = (tod == 0) + +end function is_end_curr_day +!========================================================================================= + +logical function is_end_curr_month() + +! Return true if current timestep is last timestep in current month. + +! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) +!----------------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_month = (day == 1 .and. tod == 0) + +end function is_end_curr_month +!========================================================================================= + +logical function is_first_step() + +! Return true on first step of initial run only. + +! Local variables + character(len=*), parameter :: sub = 'is_first_step' + integer :: rc + integer :: nstep + integer(ESMF_KIND_I8) :: step_no +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + is_first_step = (nstep == 0) + +end function is_first_step +!========================================================================================= + +logical function is_first_restart_step() + +! Return true on first step of restart run only. + +!----------------------------------------------------------------------------------------- + + is_first_restart_step = tm_first_restart_step + +end function is_first_restart_step +!========================================================================================= + +logical function is_last_step() + +! Return true on last timestep. + +! Local variables + character(len=*), parameter :: sub = 'is_last_step' + type(ESMF_Time) :: stop_date + type(ESMF_Time) :: curr_date + type(ESMF_TimeInterval) :: time_step + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, stopTime=stop_date, & + currTime=curr_date, TimeStep=time_step, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + if ( curr_date+time_step > stop_date ) then + is_last_step = .true. + else + is_last_step = .false. + end if + +end function is_last_step +!========================================================================================= + +logical function is_perpetual() + +! Return true on last timestep. + +!----------------------------------------------------------------------------------------- + + is_perpetual = tm_perp_calendar + +end function is_perpetual +!========================================================================================= + +subroutine timemgr_write_restart(ftn_unit) + +! Write information needed on restart to a binary Fortran file. +! It is assumed that this routine is called only from the master proc if in SPMD mode. + +! Arguments + integer, intent(in) :: ftn_unit ! Fortran unit number + +! Local variables + character(len=*), parameter :: sub = 'timemgr_write_restart' + integer :: rc ! return code + integer :: rst_perp_cal_int = 0 + type(ESMF_Time) :: start_date ! Starting date + type(ESMF_Time) :: stop_date ! Date of stop time + type(ESMF_Time) :: curr_date ! Current date + type(ESMF_Time) :: ref_date ! reference date for time coordinate +!----------------------------------------------------------------------------------------- + if ( tm_perp_calendar ) then + rst_perp_ymd = TimeGetymd( tm_perp_date ) + rst_perp_cal = tm_perp_calendar + end if + + call ESMF_ClockGet( tm_clock, startTime=start_date, stopTime=stop_date, & + currTime=curr_date, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + rst_calendar = trim(calendar) + rst_step_sec = dtime + rst_start_ymd = TimeGetymd( start_date, tod=rst_start_tod ) + rst_stop_ymd = TimeGetymd( stop_date, tod=rst_stop_tod ) + rst_ref_ymd = TimeGetymd( ref_date, tod=rst_ref_tod ) + rst_curr_ymd = TimeGetymd( curr_date, tod=rst_curr_tod ) + + if ( rst_perp_cal ) rst_perp_cal_int = 1 + + write(ftn_unit, iostat=rc) rst_calendar, rst_nstep, rst_step_days, rst_step_sec,& + rst_start_ymd, rst_start_tod, rst_stop_ymd, rst_stop_tod, rst_ref_ymd, & + rst_ref_tod, rst_curr_ymd, rst_curr_tod, rst_perp_ymd, rst_perp_cal_int + + if (rc /= 0 ) then + write(iulog,*) 'WRITE iostat= ',rc,' on i/o unit = ',ftn_unit + call endrun ('TIMEMGR_WRITE_RESTART') + end if + +end subroutine timemgr_write_restart +!========================================================================================= + +subroutine timemgr_read_restart(ftn_unit) + +! Read information needed to restart from a binary Fortran file. +! It is assumed that this routine is called only from the master proc if in SPMD mode. + +! Arguments + integer, intent(in) :: ftn_unit ! Fortran unit number + +! Local variables + character(len=*), parameter :: sub = 'timemgr_read_restart' + integer :: rc ! return code + integer :: rst_perp_cal_int +!----------------------------------------------------------------------------------------- + + read(ftn_unit, iostat=rc) rst_calendar, rst_nstep, rst_step_days, rst_step_sec,& + rst_start_ymd, rst_start_tod, rst_stop_ymd, rst_stop_tod, rst_ref_ymd, & + rst_ref_tod, rst_curr_ymd, rst_curr_tod, rst_perp_ymd, rst_perp_cal_int + + if (rc /= 0 ) then + write(iulog,*) 'READ iostat= ',rc,' on i/o unit = ',ftn_unit + call endrun ('TIMEMGR_READ_RESTART') + end if + + if ( rst_perp_cal_int /= 0 ) then + rst_perp_cal = .true. + else + rst_perp_cal = .false. + end if + +end subroutine timemgr_read_restart +!========================================================================================= + +subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) + +! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. + +! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + real(r8) :: days ! (ymd2,tod2)-(ymd1,tod1) in days + +! Local variables + character(len=*), parameter :: sub = 'timemgr_datediff' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + date1 = TimeSetymd( ymd1, tod1, "date1" ) + date2 = TimeSetymd( ymd2, tod2, "date2" ) + diff = date2 - date1 + call ESMF_TimeIntervalGet( diff, d_r8=days, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + +end subroutine timemgr_datediff +!========================================================================================= + +subroutine timemgr_time_ge(ymd1, tod1, ymd2, tod2, time2_ge_time1) + +! time2_ge_time1 is set to true if (ymd2,tod2) is later than or equal to (ymd1,tod1) + +! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + logical :: time2_ge_time1 + +! Local variables + character(len=*), parameter :: sub = 'timemgr_time_ge' + integer :: rc ! return code + + type(ESMF_Time) :: time1, time2 +!----------------------------------------------------------------------------------------- + + time1 = TimeSetymd( ymd1, tod1, "date1" ) + time2 = TimeSetymd( ymd2, tod2, "date2" ) + time2_ge_time1 = (time2 >= time1) + +end subroutine timemgr_time_ge + +!========================================================================================= + +subroutine timemgr_time_inc(ymd1, tod1, ymd2, tod2, inc_s, inc_h, inc_d) + +! Increment the time instant (ymd1,tod1) by an interval and return the resulting +! time instant (ymd2,tod2). + + ! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1 ! time of day relative to date1 (seconds past 0Z) + + integer, intent(out) ::& + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + integer, intent(in), optional ::& + inc_s, &! number of seconds in interval + inc_h, &! number of hours in interval + inc_d ! number of days in interval + + ! Local variables + character(len=*), parameter :: sub = 'timemgr_time_inc' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: t_interval + integer :: year, month, day +!----------------------------------------------------------------------------------------- + + ! set esmf time object + date1 = TimeSetymd( ymd1, tod1, "date1" ) + + ! set esmf time interval object + if (present(inc_s)) then + call ESMF_TimeIntervalSet(t_interval, s=inc_s, rc=rc) + else if (present(inc_h)) then + call ESMF_TimeIntervalSet(t_interval, h=inc_h, rc=rc) + else if (present(inc_d)) then + call ESMF_TimeIntervalSet(t_interval, d=inc_d, rc=rc) + else + call endrun(sub//': one of the args inc_s, inc_h, or inc_d must be set') + end if + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + + ! increment the time instant + date2 = date1 + t_interval + + ! extract the time components + call ESMF_TimeGet(date2, yy=year, mm=month, dd=day, s=tod2, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + ymd2 = year*10000 + month*100 + day + +end subroutine timemgr_time_inc + +!========================================================================================= + +subroutine chkrc(rc, mes) + integer, intent(in) :: rc ! return code from time management library + character(len=*), intent(in) :: mes ! error message + if ( rc == ESMF_SUCCESS ) return + write(iulog,*) mes + call endrun ('CHKRC') +end subroutine chkrc + +end module ocn_time_manager diff --git a/src/utils/cam_dom/ocn_types.F90 b/src/utils/cam_dom/ocn_types.F90 new file mode 100644 index 0000000000..ebf924ab6a --- /dev/null +++ b/src/utils/cam_dom/ocn_types.F90 @@ -0,0 +1,31 @@ +module ocn_types + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, begchunk, endchunk + implicit none + public + + type frac_t + real(r8) :: land(pcols) + end type frac_t + + type ocn_out_t + real(r8) :: ts(pcols) ! surface temperature + end type ocn_out_t + +contains + + subroutine ocn_types_alloc(ocn_out) + + type(ocn_out_t), pointer :: ocn_out(:) + + integer :: c + + allocate (ocn_out(begchunk:endchunk)) + do c = begchunk,endchunk + ocn_out(c)%ts (:) = 0.0_r8 + end do + + end subroutine ocn_types_alloc + +end module ocn_types diff --git a/src/utils/cam_dom/sst_data.F90 b/src/utils/cam_dom/sst_data.F90 new file mode 100644 index 0000000000..a6fcf36fb3 --- /dev/null +++ b/src/utils/cam_dom/sst_data.F90 @@ -0,0 +1,714 @@ +!----------------------------------------------------------------------- +! +! BOP +! +! !MODULE: sst_data +! +! !DESCRIPTION: Module to handle dealing with the Sea-Surface Temperature +! datasets. This module also figures out the location of +! sea-ice from these datasets where it is assumed that +! seawater at freezing or below is a flag for the existence of sea-ice. +! SST datasets that are created for use with the stand-alone CCM should +! take this into account and set grid-points where sea-ice fraction is +! greater than 50% to -1.8C and ensure that other grid points where sea-ice +! is less than 50% have SST's greater than -1.8C. +! +! Public interfaces: +! +! sstini -- Initialization and reading of dataset. +! sstint -- Interpolate dataset SST to current time. +! +!----------------------------------------------------------------------- + +module sst_data +! +! USES: +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_scam_mod, only: shr_scam_GetCloseLatLon + + use pmgrid, only: plon, plat + use ppgrid, only: pcols, begchunk, endchunk + use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p,& + scatter_field_to_chunk + use cam_abortutils, only: endrun + use cam_control_mod, only: aqua_planet + use error_messages, only: alloc_err + use interpolate_data, only: get_timeinterp_factors + use bnddyi_mod, only: bnddyi + + use scamMod, only: scmlon,scmlat,isrestart,single_column + + use ocn_spmd + use ocn_time_manager, only: get_curr_date, get_curr_calday, & + is_perpetual, get_perp_date, & + get_step_size, is_first_step + use physconst, only: pi + use cam_logfile, only: iulog + use pio + + implicit none + private ! By default all data is private to this module + save +! +! ! PUBLIC DATA: +! + logical, public :: sstcyc ! If false, do not cycle sst dataset(assume multiyear) + public :: sst +! +! +! ! PUBLIC MEMBER FUNCTIONS: + ! + public sstini ! Initialization + public sstint ! Time interpolation of SST data + +!=============================================================================== +!EOP +!=============================================================================== +!----------------------------------------------------------------------- +! PRIVATE: Everything else is private to this module +!----------------------------------------------------------------------- + real(r8), parameter :: daysperyear = 365.0_r8 ! Number of days in a year + + real(r8), allocatable, dimension(:,:,:) :: & + sstbdy ! SST values on boundary dataset (pcols,begchunk:endchunk,2) + real(r8), allocatable, dimension(:,:) :: & + sst ! Interpolated model sst values (pcols,begchunk:endchunk) + real(r8) :: cdaysstm ! Calendar day for prv. month SST values read in + real(r8) :: cdaysstp ! Calendar day for nxt. month SST values read in + + integer :: nm,np ! Array indices for prv., nxt month sst data + integer :: lonsiz ! size of longitude dimension on sst dataset + integer :: levsiz ! size of level dimension on sst dataset + integer :: latsiz ! size of latitude dimension on sst dataset + integer :: timesiz ! size of time dimension on sst dataset + integer :: np1 ! current forward time index of sst dataset + integer, allocatable :: date_sst(:)! Date on sst dataset (YYYYMMDD) + integer, allocatable :: sec_sst(:) ! seconds of date on sst dataset (0-86399) + integer :: ret + integer :: closelatidx,closelonidx + real(r8):: srfdata + real(r8):: closelat,closelon + + real(r8), parameter :: tsice = -1.7999_r8 ! Freezing point of sea ice degrees C + ! Use this with global sst data + character(len=*), parameter :: fieldname='SST_cpl' +!=============================================================================== +CONTAINS +!=============================================================================== + +!====================================================================== +! PUBLIC ROUTINES: Following routines are publically accessable +!====================================================================== + +!----------------------------------------------------------------------- +! +! BOP +! +! !IROUTINE: sstini +! +! !DESCRIPTION: +! +! Initialize the procedure for specifying sea surface temperatures +! Do initial read of time-varying sst boundary dataset, reading two +! consecutive months on either side of the current model date. +! +! Method: +! +! Author: L.Bath +! +!----------------------------------------------------------------------- +! +! !INTERFACE +! +subroutine sstini(ncid_sst) + use ncdio_atm, only : infld +! +! EOP +! +!---------------------------Common blocks------------------------------- + type(file_desc_t), intent(inout) :: ncid_sst +!---------------------------Local variables----------------------------- + integer dtime ! timestep size [seconds] + integer dateid ! netcdf id for date variable + integer secid ! netcdf id for seconds variable + integer londimid ! netcdf id for longitude variable + integer latdimid ! netcdf id for latitude variable + integer latid ! netcdf id for latitude variable + integer timeid ! netcdf id for time variable + integer cnt3(3) ! array of counts for each dimension + integer strt3(3) ! array of starting indices + integer n ! indices + integer j ! latitude index + integer istat ! error return + integer :: yr, mon, day ! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + integer :: ret ! return code + real(r8) calday ! calendar day (includes yr if no cycling) + real(r8) caldayloc ! calendar day (includes yr if no cycling) + real(r8) xvar(plon,plat,2) ! work space + integer :: ierr + logical :: readvar + +!----------------------------------------------------------------------- + ! + ! Initialize time indices + ! + nm = 1 + np = 2 + ! + ! Allocate space for data. + ! + ! + if (.not.allocated(sst)) then + allocate( sst(pcols,begchunk:endchunk), stat=istat ) + call alloc_err( istat, 'sstini', 'sst', & + pcols*(endchunk-begchunk+1) ) + endif + + if(aqua_planet) then + call prescribed_sst() + return + end if + if (.not.allocated(sstbdy)) then + allocate( sstbdy(pcols,begchunk:endchunk,2), stat=istat ) + call alloc_err( istat, 'sstini', 'sstbdy', & + pcols*(endchunk-begchunk+1)*2 ) + endif + + ! + ! Use year information only if not cycling sst dataset + ! + if (is_first_step()) then + dtime = get_step_size() + dtime = -dtime + calday = get_curr_calday(offset=dtime) + else + calday = get_curr_calday() + endif + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + if (is_first_step()) then + call get_curr_date(yr, mon, day, ncsec,offset=dtime) + else + call get_curr_date(yr, mon, day, ncsec) + endif + end if + ncdate = yr*10000 + mon*100 + day + if (sstcyc) then + calday = get_curr_calday() + caldayloc = calday + else + caldayloc = calday + yr*daysperyear + end if + ! + ! Get and check dimension info + ! + ierr = pio_inq_dimid( ncid_sst, 'lon', londimid ) + ierr = pio_inq_dimid( ncid_sst, 'time', timeid ) + ierr = pio_inq_dimid( ncid_sst, 'lat', latdimid ) + ierr = pio_inq_dimlen( ncid_sst, londimid, lonsiz ) + + if (.not. single_column .and. lonsiz /= plon ) then + write(iulog,*)'SSTINI: lonsiz=',lonsiz,' must = plon=',plon + call endrun + end if + ierr = pio_inq_dimlen( ncid_sst, latdimid, latsiz ) + if (.not. single_column .and. latsiz /= plat ) then + write(iulog,*)'SSTINI: latsiz=',latsiz,' must = plat=',plat + call endrun + endif + ierr = pio_inq_dimlen( ncid_sst, timeid, timesiz ) + ierr = pio_inq_varid( ncid_sst, 'date', dateid ) + ierr = pio_inq_varid( ncid_sst, 'datesec', secid ) + ierr = pio_inq_varid( ncid_sst, 'lat', latid ) + ! + ! Retrieve entire date and sec variables. + ! + + allocate(date_sst(timesiz), sec_sst(timesiz)) + ierr = pio_get_var (ncid_sst,dateid,date_sst) + ierr = pio_get_var (ncid_sst,secid,sec_sst) + if (sstcyc) then + if (timesiz<12) then + write(iulog,*)'SSTINI: ERROR' + write(iulog,*)'When cycling sst, sst data set must have 12' + write(iulog,*)'consecutive months of data starting with Jan' + write(iulog,*)'Current dataset has only ',timesiz,' months' + call endrun + end if + do n = 1,12 + if (mod(date_sst(n),10000)/100/=n) then + write(iulog,*)'SSTINI: ERROR' + write(iulog,*)'When cycling sst, sst data set must have 12' + write(iulog,*)'consecutive months of data starting with Jan' + write(iulog,*)'Month ',n,' of sst data set is out of order' + call endrun + end if + end do + end if + + + if (single_column) then + call shr_scam_GetCloseLatLon(ncid_sst%fh,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) + strt3(1) = closelonidx + strt3(2) = closelatidx + strt3(3) = 1 + cnt3(1) = 1 + cnt3(2) = 1 + cnt3(3) = 1 + else + strt3(1) = 1 + strt3(2) = 1 + strt3(3) = 1 + cnt3(1) = lonsiz + cnt3(2) = latsiz + cnt3(3) = 1 + endif + + ! + ! Special code for interpolation between December and January + ! + if (sstcyc) then + n = 12 + np1 = 1 + call bnddyi(date_sst(n ), sec_sst(n ), cdaysstm) + call bnddyi(date_sst(np1), sec_sst(np1), cdaysstp) + + if (caldayloc<=cdaysstp .or. caldayloc>cdaysstm) then + call infld(fieldname, ncid_sst, 'lon', 'lat', 1, pcols, begchunk,& + endchunk, sstbdy(:,:,nm) ,readvar, gridname='physgrid', timelevel=n) + call infld(fieldname, ncid_sst, 'lon', 'lat', 1, pcols, begchunk,& + endchunk, sstbdy(:,:,np) ,readvar, gridname='physgrid', timelevel=np1) + goto 10 + end if + end if + ! + ! Normal interpolation between consecutive time slices. + ! + do n=1,timesiz-1 + np1 = n + 1 + call bnddyi(date_sst(n ), sec_sst(n ), cdaysstm) + call bnddyi(date_sst(np1), sec_sst(np1), cdaysstp) + if (.not.sstcyc) then + yr = date_sst(n)/10000 + cdaysstm = cdaysstm + yr*daysperyear + yr = date_sst(np1)/10000 + cdaysstp = cdaysstp + yr*daysperyear + end if + if (caldayloc>cdaysstm .and. caldayloc<=cdaysstp) then + call infld(fieldname, ncid_sst, 'lon', 'lat', 1, pcols, begchunk,& + endchunk, sstbdy(:,:,nm) ,readvar, gridname='physgrid', timelevel=n) + call infld(fieldname, ncid_sst, 'lon', 'lat', 1, pcols, begchunk,& + endchunk, sstbdy(:,:,np) ,readvar, gridname='physgrid', timelevel=np1) + goto 10 + end if + end do + write(iulog,*)'SSTINI: Failed to find dates bracketing ncdate, ncsec=', ncdate, ncsec + call endrun +10 continue + write(iulog,*)'SSTINI: Read sst data for dates ',date_sst(n),sec_sst(n), & + ' and ',date_sst(np1),sec_sst(np1) + + return +end subroutine sstini + +!----------------------------------------------------------------------- +! +! BOP +! +! !IROUTINE: sstint +! +! !DESCRIPTION: +! +! if "aqua_planet", specify SST's analytically (Jerry Olson). +! Otherwise, time interpolate SST's to current time, reading in new monthly data if +! necessary. +! Method: +! +! Author: L.Bath +! +!----------------------------------------------------------------------- +! +! !INTERFACE: +! +subroutine sstint(ncid_sst, prev_timestep) + use ncdio_atm, only : infld + ! + ! !INPUT PARAMETERS: + ! + type(file_desc_t), intent(inout) :: ncid_sst + logical, intent(in), optional :: prev_timestep ! If using previous timestep, set to true + ! + ! EOP + ! + !---------------------------Local variables----------------------------- + integer dtime ! timestep size [seconds] + integer cnt3(3) ! array of counts for each dimension + integer strt3(3) ! array of starting indices + integer i,j,lchnk ! indices + integer ncol ! number of columns in current chunk + integer ntmp ! temporary + real(r8) fact1, fact2 ! time interpolation factors + integer :: yr, mon, day! components of a date + integer :: ncdate ! current date in integer format [yyyymmdd] + integer :: ncsec ! current time of day [seconds] + real(r8) :: calday ! current calendar day + real(r8) caldayloc ! calendar day (includes yr if no cycling) + real(r8) deltat ! time (days) between interpolating sst data + real(r8) xvar(plon,plat,2) ! work space + integer :: ierr + logical :: readvar + logical :: previous ! If using previous timestep, set to true + ! + !----------------------------------------------------------------------- + ! + if (aqua_planet) return + + ! + ! Use year information only if a multiyear dataset + ! + if ( .not. present(prev_timestep) ) then + previous = .false. + else + previous = prev_timestep + end if + if (previous .and. is_first_step()) then + dtime = get_step_size() + dtime = -dtime + calday = get_curr_calday(offset=dtime) + else + calday = get_curr_calday() + endif + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + if (previous .and. is_first_step()) then + call get_curr_date(yr, mon, day, ncsec,offset=dtime) + else + call get_curr_date(yr, mon, day, ncsec) + endif + end if + ncdate = yr*10000 + mon*100 + day + if (sstcyc) then + calday = get_curr_calday() + caldayloc = calday + else + caldayloc = calday + yr*daysperyear + end if + + if (masterproc) then + if (single_column) then + call shr_scam_GetCloseLatLon(ncid_sst%fh,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) + strt3(1) = closelonidx + strt3(2) = closelatidx + strt3(3) = 1 + cnt3(1) = 1 + cnt3(2) = 1 + cnt3(3) = 1 + else + strt3(1) = 1 + strt3(2) = 1 + strt3(3) = 1 + cnt3(1) = lonsiz + cnt3(2) = latsiz + cnt3(3) = 1 + endif + endif + ! + ! If model time is past current forward sst timeslice, read in the next + ! timeslice for time interpolation. Messy logic is for sstcyc = .true. + ! interpolation between December and January (np1==1). Note that + ! np1 is never 1 when sstcyc is .false. + ! + if (caldayloc > cdaysstp .and. .not. (np1==1 .and. caldayloc>cdaysstm)) then + if (sstcyc) then + np1 = mod(np1,12) + 1 + else + np1 = np1 + 1 + end if + if (np1 > timesiz) then + call endrun ('SSTINT: Attempt to read past end of SST dataset') + end if + cdaysstm = cdaysstp + call bnddyi(date_sst(np1), sec_sst(np1), cdaysstp) + + if (.not.sstcyc) then + yr = date_sst(np1)/10000 + cdaysstp = cdaysstp + yr*daysperyear + end if + + if (.not. (np1 == 1 .or. caldayloc <= cdaysstp)) then + if (masterproc) then + write(iulog,*)'SSTINT: Input sst for date', date_sst(np1), ' sec ', sec_sst(np1), & + ' does not exceed model date', ncdate, ' sec ', ncsec, ' Stopping.' + end if + call endrun () + end if + + ntmp = nm + nm = np + np = ntmp + + strt3(3) = np1 + + call infld(fieldname, ncid_sst, 'lon', 'lat', 1, pcols, begchunk,& + endchunk, sstbdy(:,:,np) ,readvar, gridname='physgrid', timelevel=np1) + if (masterproc) write(iulog,*)'SSTINT: Read sst for date (yyyymmdd) ',date_sst(np1), ' sec ',sec_sst(np1) + end if + ! + ! Determine time interpolation factors. + ! + call get_timeinterp_factors (sstcyc, np1, cdaysstm, cdaysstp, caldayloc, & + fact1, fact2, 'SSTINT:') + + do lchnk=begchunk,endchunk + ncol = get_ncols_p(lchnk) + do i=1,ncol + sst(i,lchnk) = sstbdy(i,lchnk,nm)*fact1 + sstbdy(i,lchnk,np)*fact2 + end do + end do + +end subroutine sstint + +subroutine prescribed_sst + implicit none + integer,parameter :: sst_option = 1 + + real(r8), parameter :: pio180 = pi/180._r8 + ! + ! Parameters for zonally symmetric experiments + ! + + real(r8), parameter :: t0_max = 27._r8 + real(r8), parameter :: t0_min = 0._r8 + real(r8), parameter :: maxlat = 60._r8*pio180 + real(r8), parameter :: shift = 5._r8*pio180 + real(r8), parameter :: shift9 = 10._r8*pio180 + real(r8), parameter :: shift10 = 15._r8*pio180 + ! + ! Parameters for zonally asymmetric experiments + ! + real(r8), parameter :: t0_max6 = 1._r8 + real(r8), parameter :: t0_max7 = 3._r8 + real(r8), parameter :: latcen = 0._r8*pio180 + real(r8), parameter :: loncen = 0._r8*pio180 + real(r8), parameter :: latrad6 = 15._r8*pio180 + real(r8), parameter :: latrad8 = 30._r8*pio180 + real(r8), parameter :: lonrad = 30._r8*pio180 + + integer :: lchnk, i, ncols + real(r8) :: tmp, tmp1, rlat(pcols), rlon(pcols) + ! + ! Control + ! + if(sst_option .lt. 1 .or. sst_option .gt. 10) then + call endrun ('SSTINT: sst_option must be between 1 and 10') + endif + if(sst_option == 1 .or. sst_option == 6 .or. & + sst_option == 7 .or. sst_option == 8 ) then + + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk)=t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk)=tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + ! + ! Flat + ! + if(sst_option == 2) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk)=t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = 1._r8 - tmp*tmp*tmp*tmp + sst(i,lchnk)=tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + ! + ! Qobs + ! + if(sst_option == 3) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk)=t0_min + else + tmp = sin(rlat(i)*pi*0.5_r8/maxlat) + tmp = (2._r8 - tmp*tmp*tmp*tmp - tmp*tmp)*0.5_r8 + sst(i,lchnk)=tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + ! + ! Peaked + ! + if(sst_option == 4) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk)=t0_min + else + tmp = (maxlat - abs(rlat(i)))/maxlat + tmp1 = 1._r8 - tmp + sst(i,lchnk)= t0_max*tmp + t0_min*tmp1 + end if + end do + end do + end if + ! + ! Control-5N + ! + if(sst_option == 5) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk)=t0_min + else if(rlat(i) > shift) then + tmp = sin((rlat(i)-shift)*pi*0.5_r8/(maxlat-shift)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift)*pi*0.5_r8/(maxlat+shift)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + ! + ! 1KEQ + ! + if(sst_option == 6) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + call get_rlon_all_p(lchnk,pcols,rlon) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)-latcen) <= latrad6) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad6) + tmp1 = tmp1*tmp1 + tmp = abs(rlon(i)-loncen) + tmp = min(tmp , 2._r8*pi-tmp) + if(tmp <= lonrad) then + tmp = cos(tmp*pi*0.5_r8/lonrad) + tmp = tmp*tmp + sst(i,lchnk) = sst(i,lchnk) + t0_max6*tmp*tmp1 + end if + end if + end do + end do + end if + ! + ! 3KEQ + ! + if(sst_option == 7) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + call get_rlon_all_p(lchnk,pcols,rlon) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)-latcen) <= latrad6) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad6) + tmp1 = tmp1*tmp1 + tmp = abs(rlon(i)-loncen) + tmp = min(tmp , 2._r8*pi-tmp) + if(tmp <= lonrad) then + tmp = cos(tmp*pi*0.5_r8/lonrad) + tmp = tmp*tmp + sst(i,lchnk) = sst(i,lchnk) + t0_max7*tmp*tmp1 + end if + end if + end do + end do + end if + ! + ! 3KW1 + ! + if(sst_option == 8) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + call get_rlon_all_p(lchnk,pcols,rlon) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)-latcen) <= latrad8) then + tmp1 = cos((rlat(i)-latcen)*pi*0.5_r8/latrad8) + tmp1 = tmp1*tmp1 + tmp = cos(rlon(i)-loncen) + sst(i,lchnk) = sst(i,lchnk) + t0_max7*tmp*tmp1 + end if + end do + end do + end if + ! + ! Control-10N + ! + if(sst_option == 9) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + elseif(rlat(i) > shift9) then + tmp = sin((rlat(i)-shift9)*pi*0.5_r8/(maxlat-shift9)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift9)*pi*0.5_r8/(maxlat+shift9)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + end if + ! + ! Control-15N + ! + if(sst_option == 10) then + do lchnk=begchunk,endchunk + call get_rlat_all_p(lchnk,pcols,rlat) + ncols = get_ncols_p(lchnk) + do i=1,ncols + if(abs(rlat(i)) > maxlat) then + sst(i,lchnk) = t0_min + elseif(rlat(i) > shift10) then + tmp = sin((rlat(i)-shift10)*pi*0.5_r8/(maxlat-shift10)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + else + tmp = sin((rlat(i)-shift10)*pi*0.5_r8/(maxlat+shift10)) + tmp = 1._r8 - tmp*tmp + sst(i,lchnk) = tmp*(t0_max - t0_min) + t0_min + end if + end do + end do + endif +end subroutine prescribed_sst + +end module sst_data + diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 new file mode 100644 index 0000000000..a1c5022cb9 --- /dev/null +++ b/src/utils/cam_grid_support.F90 @@ -0,0 +1,4206 @@ +module cam_grid_support + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, max_chars=>shr_kind_cl + use shr_kind_mod, only: i8=>shr_kind_i8, i4=>shr_kind_i4 + use shr_sys_mod, only: shr_sys_flush + use pio, only: iMap=>PIO_OFFSET_KIND, var_desc_t + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_pio_utils, only: cam_pio_handle_error + use cam_map_utils, only: cam_filemap_t + + implicit none + private + + public iMap + + integer, parameter, public :: max_hcoordname_len = 16 + real(r8), parameter :: grid_fill_value = -900.0_r8 + !--------------------------------------------------------------------------- + ! + ! horiz_coord_t: Information for horizontal dimension attributes + ! + !--------------------------------------------------------------------------- + type, public :: horiz_coord_t + private + character(len=max_hcoordname_len) :: name = '' ! coordinate name + character(len=max_hcoordname_len) :: dimname = '' ! dimension name + ! NB: If dimname is blank, it is assumed to be name + integer :: dimsize = 0 ! global size of dimension + character(len=max_chars) :: long_name = '' ! 'long_name' attribute + character(len=max_chars) :: units = '' ! 'units' attribute + real(r8), pointer :: values(:) => NULL() ! dim values (local if map) + integer(iMap), pointer :: map(:) => NULL() ! map (dof) for dist. coord + logical :: latitude ! .false. means longitude + real(r8), pointer :: bnds(:,:) => NULL() ! bounds, if present + type(var_desc_t), pointer :: vardesc => NULL() ! If we are to write coord + type(var_desc_t), pointer :: bndsvdesc => NULL() ! If we are to write bounds + contains + procedure :: get_coord_len => horiz_coord_len + procedure :: num_elem => horiz_coord_num_elem + procedure :: global_size => horiz_coord_find_size + procedure :: get_coord_name => horiz_coord_name + procedure :: get_dim_name => horiz_coord_dim_name + procedure :: get_long_name => horiz_coord_long_name + procedure :: get_units => horiz_coord_units + procedure :: write_attr => write_horiz_coord_attr + procedure :: write_var => write_horiz_coord_var + end type horiz_coord_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_t: Auxiliary quantity for a CAM grid + ! + !--------------------------------------------------------------------------- + type, abstract :: cam_grid_attribute_t + character(len=max_hcoordname_len) :: name = '' ! attribute name + character(len=max_chars) :: long_name = '' ! attribute long_name + type(var_desc_t), pointer :: vardesc => NULL() +! We aren't going to use this until we sort out PGI issues + class(cam_grid_attribute_t), pointer :: next => NULL() + contains + procedure :: cam_grid_attr_init + procedure(write_cam_grid_attr), deferred :: write_attr + procedure(write_cam_grid_attr), deferred :: write_val + procedure(print_attr_spec), deferred :: print_attr + procedure :: print_attr_base + end type cam_grid_attribute_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_0d_int_t: Global integral attribute + ! + !--------------------------------------------------------------------------- + type, extends(cam_grid_attribute_t) :: cam_grid_attribute_0d_int_t + integer :: ival + contains + procedure :: cam_grid_attr_init_0d_int + procedure :: write_attr => write_cam_grid_attr_0d_int + procedure :: write_val => write_cam_grid_val_0d_int + procedure :: print_attr => print_attr_0d_int + end type cam_grid_attribute_0d_int_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_0d_char_t: Global string attribute + ! + !--------------------------------------------------------------------------- + type, extends(cam_grid_attribute_t) :: cam_grid_attribute_0d_char_t + character(len=max_chars) :: val + contains + procedure :: cam_grid_attr_init_0d_char + procedure :: write_attr => write_cam_grid_attr_0d_char + procedure :: write_val => write_cam_grid_val_0d_char + procedure :: print_attr => print_attr_0d_char + end type cam_grid_attribute_0d_char_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_1d_int_t: 1-d integer attribute + ! + !--------------------------------------------------------------------------- + type, extends(cam_grid_attribute_t) :: cam_grid_attribute_1d_int_t + character(len=max_hcoordname_len) :: dimname ! attribute dimension + integer :: dimsize ! Global array/map size + integer, pointer :: values(:) => NULL() + integer(iMap), pointer :: map(:) => NULL() ! map (dof) for I/O + contains + procedure :: cam_grid_attr_init_1d_int + procedure :: write_attr => write_cam_grid_attr_1d_int + procedure :: write_val => write_cam_grid_val_1d_int + procedure :: print_attr => print_attr_1d_int + end type cam_grid_attribute_1d_int_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_1d_r8_t: 1-d real*8 attribute + ! + !--------------------------------------------------------------------------- + type, extends(cam_grid_attribute_t) :: cam_grid_attribute_1d_r8_t + character(len=max_hcoordname_len) :: dimname ! attribute dimension + integer :: dimsize ! Global array/map size + real(r8), pointer :: values(:) => NULL() + integer(iMap), pointer :: map(:) => NULL() ! map (dof) for I/O + contains + procedure :: cam_grid_attr_init_1d_r8 + procedure :: write_attr => write_cam_grid_attr_1d_r8 + procedure :: write_val => write_cam_grid_val_1d_r8 + procedure :: print_attr => print_attr_1d_r8 + end type cam_grid_attribute_1d_r8_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attr_ptr_t: linked list of CAM grid attributes + ! + !--------------------------------------------------------------------------- + type :: cam_grid_attr_ptr_t + private + class(cam_grid_attribute_t), pointer :: attr => NULL() + type(cam_grid_attr_ptr_t), pointer :: next => NULL() + contains + private + procedure, public :: initialize => initializeAttrPtr + procedure, public :: getAttr => getAttrPtrAttr + procedure, public :: getNext => getAttrPtrNext + procedure, public :: setNext => setAttrPtrNext + end type cam_grid_attr_ptr_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_t: Information for a CAM grid (defined by a dycore) + ! + !--------------------------------------------------------------------------- + type :: cam_grid_t + character(len=max_hcoordname_len) :: name = '' ! grid name + integer :: id ! e.g., dyn_decomp + type(horiz_coord_t), pointer :: lat_coord => NULL() ! Latitude coord + type(horiz_coord_t), pointer :: lon_coord => NULL() ! Longitude coord + logical :: unstructured ! Is this needed? + logical :: block_indexed ! .false. for lon/lat + logical :: attrs_defined = .false. + logical :: zonal_grid = .false. + type(cam_filemap_t), pointer :: map => null() ! global dim map (dof) + type(cam_grid_attr_ptr_t), pointer :: attributes => NULL() + contains + procedure :: print_cam_grid + procedure :: is_unstructured => cam_grid_unstructured + procedure :: is_block_indexed => cam_grid_block_indexed + procedure :: is_zonal_grid => cam_grid_zonal_grid + procedure :: coord_lengths => cam_grid_get_dims + procedure :: coord_names => cam_grid_coord_names + procedure :: dim_names => cam_grid_dim_names + procedure :: num_elem => cam_grid_local_size + procedure :: set_map => cam_grid_set_map + procedure :: get_patch_mask => cam_grid_get_patch_mask + procedure :: get_lon_lat => cam_grid_get_lon_lat + procedure :: find_src_dims => cam_grid_find_src_dims + procedure :: find_dest_dims => cam_grid_find_dest_dims + procedure :: find_dimids => cam_grid_find_dimids + procedure :: get_decomp => cam_grid_get_pio_decomp + procedure :: read_darray_2d_int => cam_grid_read_darray_2d_int + procedure :: read_darray_3d_int => cam_grid_read_darray_3d_int + procedure :: read_darray_2d_double => cam_grid_read_darray_2d_double + procedure :: read_darray_3d_double => cam_grid_read_darray_3d_double + procedure :: read_darray_2d_real => cam_grid_read_darray_2d_real + procedure :: read_darray_3d_real => cam_grid_read_darray_3d_real + procedure :: write_darray_2d_int => cam_grid_write_darray_2d_int + procedure :: write_darray_3d_int => cam_grid_write_darray_3d_int + procedure :: write_darray_2d_double => cam_grid_write_darray_2d_double + procedure :: write_darray_3d_double => cam_grid_write_darray_3d_double + procedure :: write_darray_2d_real => cam_grid_write_darray_2d_real + procedure :: write_darray_3d_real => cam_grid_write_darray_3d_real + end type cam_grid_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_patch_t: Information for a patch of a CAM grid + ! + !--------------------------------------------------------------------------- + type, public :: cam_grid_patch_t + private + integer :: grid_id = -1 ! grid containing patch points + integer :: global_size = 0 ! var patch dim size + integer :: global_lat_size = 0 ! lat patch dim size + integer :: global_lon_size = 0 ! lon patch dim size + integer :: num_points = 0 ! task-local size + real(r8) :: lon_range(2) + real(r8) :: lat_range(2) + logical :: collected_columns ! Output unstructured + type(cam_filemap_t), pointer :: mask => null() ! map for active pts + integer(iMap), pointer :: latmap(:) => null() ! map for patch coords + integer(iMap), pointer :: lonmap(:) => null() ! map for patch coords + real(r8), pointer :: lonvals(:) => null() ! For collected output + real(r8), pointer :: latvals(:) => null() ! For collected output + contains + procedure :: gridid => cam_grid_patch_get_id + procedure :: get_axis_names => cam_grid_patch_get_axis_names + procedure :: get_coord_long_name => cam_grid_patch_get_coord_long_name + procedure :: get_coord_units => cam_grid_patch_get_coord_units + procedure :: set_patch => cam_grid_patch_set_patch + procedure :: get_decomp => cam_grid_patch_get_decomp + procedure :: compact => cam_grid_patch_compact + procedure :: active_cols => cam_grid_patch_get_active_cols + procedure :: write_coord_vals => cam_grid_patch_write_vals + procedure :: grid_index => cam_grid_patch_get_grid_index + procedure :: deallocate => cam_grid_patch_deallocate +!!XXgoldyXX: PGI workaround? +! COMPILER_BUG(goldy, 2014-11-28, pgi <= 14.9); Commented code should work +! procedure :: global_size_map => cam_grid_patch_get_global_size_map +! procedure :: global_size_axes => cam_grid_patch_get_global_size_axes +! generic :: get_global_size => global_size_map, global_size_axes + procedure :: cam_grid_patch_get_global_size_map + procedure :: cam_grid_patch_get_global_size_axes + generic :: get_global_size => cam_grid_patch_get_global_size_map, cam_grid_patch_get_global_size_axes + end type cam_grid_patch_t + + !--------------------------------------------------------------------------- + ! + ! cam_grid_header_info_t: Hold NetCDF dimension information for a CAM grid + ! + !--------------------------------------------------------------------------- + type, public :: cam_grid_header_info_t + private + integer :: grid_id = -1 ! e.g., dyn_decomp + integer, allocatable :: hdims(:) ! horizontal dimension ids + type(var_desc_t), pointer :: lon_varid => NULL() ! lon coord variable + type(var_desc_t), pointer :: lat_varid => NULL() ! lat coord variable + contains + procedure :: get_gridid => cam_grid_header_info_get_gridid + procedure :: set_gridid => cam_grid_header_info_set_gridid + procedure :: set_hdims => cam_grid_header_info_set_hdims + procedure :: num_hdims => cam_grid_header_info_num_hdims + procedure :: get_hdimid => cam_grid_header_info_hdim + !!XXgoldyXX: Maybe replace this with horiz_coords for patches? + procedure :: set_varids => cam_grid_header_info_set_varids + procedure :: get_lon_varid => cam_grid_header_info_lon_varid + procedure :: get_lat_varid => cam_grid_header_info_lat_varid + procedure :: deallocate => cam_grid_header_info_deallocate + end type cam_grid_header_info_t + + !--------------------------------------------------------------------------- + ! + ! END: types BEGIN: interfaces for types + ! + !--------------------------------------------------------------------------- + + ! Abstract interface for write_attr procedure of cam_grid_attribute_t class + ! NB: This will not compile on some pre-13 Intel compilers + ! (fails on 12.1.0.233 on Frankfurt, passes on 13.0.1.117 on Yellowstone) + abstract interface + subroutine write_cam_grid_attr(attr, File) + use pio, only: file_desc_t + import :: cam_grid_attribute_t + ! Dummy arguments + class(cam_grid_attribute_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File ! PIO file Handle + end subroutine write_cam_grid_attr + end interface + + ! Abstract interface for print_attr procedure of cam_grid_attribute_t class + abstract interface + subroutine print_attr_spec(this) + import :: cam_grid_attribute_t + ! Dummy arguments + class(cam_grid_attribute_t), intent(in) :: this + end subroutine print_attr_spec + end interface + + !! Grid variables + integer, parameter :: maxhgrids = 16 ! arbitrary limit + integer, save :: registeredhgrids = 0 + type(cam_grid_t), save :: cam_grids(maxhgrids) + + public :: horiz_coord_create + + ! Setup and I/O functions for grids rely on the grid's ID, not its index. + public :: cam_grid_register, cam_grid_attribute_register + public :: cam_grid_attribute_copy + public :: cam_grid_write_attr, cam_grid_write_var + public :: cam_grid_read_dist_array, cam_grid_write_dist_array + ! Access functions for grids rely on the grid's ID or name, not its index. + public :: cam_grid_dimensions, cam_grid_num_grids + public :: cam_grid_check ! T/F if grid ID exists + public :: cam_grid_id ! Grid ID (decomp) or -1 if error + public :: cam_grid_get_local_size + public :: cam_grid_get_file_dimids + public :: cam_grid_get_decomp + public :: cam_grid_get_gcid + public :: cam_grid_get_array_bounds + public :: cam_grid_get_coord_names, cam_grid_get_dim_names + public :: cam_grid_has_blocksize, cam_grid_get_block_count + public :: cam_grid_get_latvals, cam_grid_get_lonvals + public :: cam_grid_get_coords + public :: cam_grid_is_unstructured, cam_grid_is_block_indexed + public :: cam_grid_attr_exists + public :: cam_grid_is_zonal + ! Functions for dealing with patch masks + public :: cam_grid_compute_patch + + interface cam_grid_attribute_register + module procedure add_cam_grid_attribute_0d_int + module procedure add_cam_grid_attribute_0d_char + module procedure add_cam_grid_attribute_1d_int + module procedure add_cam_grid_attribute_1d_r8 + end interface + + interface cam_grid_dimensions + module procedure cam_grid_dimensions_id + module procedure cam_grid_dimensions_name + end interface + + interface cam_grid_get_dim_names + module procedure cam_grid_get_dim_names_id + module procedure cam_grid_get_dim_names_name + end interface + + interface cam_grid_read_dist_array + module procedure cam_grid_read_dist_array_2d_int + module procedure cam_grid_read_dist_array_3d_int + module procedure cam_grid_read_dist_array_2d_double + module procedure cam_grid_read_dist_array_3d_double + module procedure cam_grid_read_dist_array_2d_real + module procedure cam_grid_read_dist_array_3d_real + end interface + + interface cam_grid_write_dist_array + module procedure cam_grid_write_dist_array_2d_int + module procedure cam_grid_write_dist_array_3d_int + module procedure cam_grid_write_dist_array_2d_double + module procedure cam_grid_write_dist_array_3d_double + module procedure cam_grid_write_dist_array_2d_real + module procedure cam_grid_write_dist_array_3d_real + end interface + + ! Private interfaces + interface get_cam_grid_index + module procedure get_cam_grid_index_char ! For lookup by name + module procedure get_cam_grid_index_int ! For lookup by ID + end interface + +contains + +!!####################################################################### +!! +!! Horizontal coordinate functions +!! +!!####################################################################### + + integer function horiz_coord_find_size(this, dimname) result(dimsize) + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + character(len=*), intent(in) :: dimname + + dimsize = -1 + if (len_trim(this%dimname) == 0) then + if(trim(dimname) == trim(this%name)) then + dimsize = this%dimsize + end if + else + if(trim(dimname) == trim(this%dimname)) then + dimsize = this%dimsize + end if + end if + + end function horiz_coord_find_size + + integer function horiz_coord_num_elem(this) + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + + if (associated(this%values)) then + horiz_coord_num_elem = size(this%values) + else + horiz_coord_num_elem = 0 + end if + + end function horiz_coord_num_elem + + subroutine horiz_coord_len(this, clen) + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + integer, intent(out) :: clen + + clen = this%dimsize + end subroutine horiz_coord_len + + subroutine horiz_coord_name(this, name) + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + character(len=*), intent(out) :: name + + if (len(name) < len_trim(this%name)) then + call endrun('horiz_coord_name: input name too short') + end if + name = trim(this%name) + end subroutine horiz_coord_name + + subroutine horiz_coord_dim_name(this, dimname) + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + character(len=*), intent(out) :: dimname + + if (len_trim(this%dimname) > 0) then + ! We have a separate dimension name (e.g., ncol) + if (len(dimname) < len_trim(this%dimname)) then + call endrun('horiz_coord_dimname: input name too short') + end if + dimname = trim(this%dimname) + else + ! No dimension name so we use the coordinate's name + ! i.e., The dimension name is the same as the coordinate variable + if (len(dimname) < len_trim(this%name)) then + call endrun('horiz_coord_dimname: input name too short') + end if + dimname = trim(this%name) + end if + end subroutine horiz_coord_dim_name + + subroutine horiz_coord_long_name(this, name) + + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + character(len=*), intent(out) :: name + + if (len(name) < len_trim(this%long_name)) then + call endrun('horiz_coord_long_name: input name too short') + else + name = trim(this%long_name) + end if + + end subroutine horiz_coord_long_name + + subroutine horiz_coord_units(this, units) + + ! Dummy arguments + class(horiz_coord_t), intent(in) :: this + character(len=*), intent(out) :: units + + if (len(units) < len_trim(this%units)) then + call endrun('horiz_coord_units: input units too short') + else + units = trim(this%units) + end if + + end subroutine horiz_coord_units + + function horiz_coord_create(name, dimname, dimsize, long_name, units, & + lbound, ubound, values, map, bnds) result(newcoord) + + ! Dummy arguments + character(len=*), intent(in) :: name + character(len=*), intent(in) :: dimname + integer, intent(in) :: dimsize + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + ! NB: Sure, pointers would have made sense but . . . PGI + integer, intent(in) :: lbound + integer, intent(in) :: ubound + real(r8), intent(in) :: values(lbound:ubound) + integer(iMap), intent(in), optional :: map(ubound-lbound+1) + real(r8), intent(in), optional :: bnds(2,lbound:ubound) + type(horiz_coord_t), pointer :: newcoord + + allocate(newcoord) + + newcoord%name = trim(name) + newcoord%dimname = trim(dimname) + newcoord%dimsize = dimsize + newcoord%long_name = trim(long_name) + newcoord%units = trim(units) + ! Figure out if this is a latitude or a longitude using CF standard + ! http://cfconventions.org/Data/cf-conventions/cf-conventions-1.6/build/cf-conventions.html#latitude-coordinate + ! http://cfconventions.org/Data/cf-conventions/cf-conventions-1.6/build/cf-conventions.html#longitude-coordinate + if ( (trim(units) == 'degrees_north') .or. & + (trim(units) == 'degree_north') .or. & + (trim(units) == 'degree_N') .or. & + (trim(units) == 'degrees_N') .or. & + (trim(units) == 'degreeN') .or. & + (trim(units) == 'degreesN')) then + newcoord%latitude = .true. + else if ((trim(units) == 'degrees_east') .or. & + (trim(units) == 'degree_east') .or. & + (trim(units) == 'degree_E') .or. & + (trim(units) == 'degrees_E') .or. & + (trim(units) == 'degreeE') .or. & + (trim(units) == 'degreesE')) then + newcoord%latitude = .false. + else + call endrun("horiz_coord_create: unsupported units: '"//trim(units)//"'") + end if + allocate(newcoord%values(lbound:ubound)) + if (ubound >= lbound) then + newcoord%values(:) = values(:) + end if + + if (present(map)) then + if (ANY(map < 0)) then + call endrun("horiz_coord_create "//trim(name)//": map vals < 0") + end if + allocate(newcoord%map(ubound - lbound + 1)) + if (ubound >= lbound) then + newcoord%map(:) = map(:) + end if + else + nullify(newcoord%map) + end if + + if (present(bnds)) then + allocate(newcoord%bnds(2, lbound:ubound)) + if (ubound >= lbound) then + newcoord%bnds = bnds + end if + else + nullify(newcoord%bnds) + end if + + end function horiz_coord_create + + !--------------------------------------------------------------------------- + ! + ! write_horiz_coord_attr + ! + ! Write the dimension and coordinate attributes for a horizontal grid + ! coordinate. + ! + !--------------------------------------------------------------------------- + + subroutine write_horiz_coord_attr(this, File, dimid_out) + use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double + use pio, only: pio_bcast_error, pio_seterrorhandling, pio_inq_varid + use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var + + ! Dummy arguments + class(horiz_coord_t), intent(inout) :: this + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(out) :: dimid_out + + ! Local variables + type(var_desc_t) :: vardesc + character(len=max_hcoordname_len) :: dimname + integer :: dimid ! PIO dimension ID + integer :: bnds_dimid ! PIO dim ID for bounds + integer :: err_handling + integer :: ierr + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + ! Make sure the dimension exists in the file + call this%get_dim_name(dimname) + call cam_pio_def_dim(File, trim(dimname), this%dimsize, dimid, & + existOK=.true.) + ! Should we define the variable? + ierr = pio_inq_varid(File, trim(this%name), vardesc) + if (ierr /= PIO_NOERR) then + ! Variable not already defined, it is up to us to define the variable + if (associated(this%vardesc)) then + ! This should not happen (i.e., internal error) + call endrun('write_horiz_coord_attr: vardesc already allocated for '//trim(dimname)) + end if + allocate(this%vardesc) + call cam_pio_def_var(File, trim(this%name), pio_double, & + (/ dimid /), this%vardesc, existOK=.false.) + ierr= pio_put_att(File, this%vardesc, '_FillValue', grid_fill_value) + call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_horiz_coord_attr') + ! long_name + ierr=pio_put_att(File, this%vardesc, 'long_name', trim(this%long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_horiz_coord_attr') + ! units + ierr=pio_put_att(File, this%vardesc, 'units', trim(this%units)) + call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_horiz_coord_attr') + ! Take care of bounds if they exist + if (associated(this%bnds)) then + allocate(this%bndsvdesc) + ierr=pio_put_att(File, this%vardesc, 'bounds', trim(this%name)//'_bnds') + call cam_pio_handle_error(ierr, 'Error writing "'//trim(this%name)//'_bnds" attr in write_horiz_coord_attr') + call cam_pio_def_dim(File, 'nbnd', 2, bnds_dimid, existOK=.true.) + call cam_pio_def_var(File, trim(this%name)//'_bnds', pio_double, & + (/ bnds_dimid, dimid /), this%bndsvdesc, existOK=.false.) + call cam_pio_handle_error(ierr, 'Error defining "'//trim(this%name)//'bnds" in write_horiz_coord_attr') + ! long_name + ierr=pio_put_att(File, this%bndsvdesc, 'long_name', trim(this%name)//' bounds') + call cam_pio_handle_error(ierr, 'Error writing bounds "long_name" attr in write_horiz_coord_attr') + ! fill value + ierr= pio_put_att(File, this%vardesc, '_FillValue', grid_fill_value) + call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_horiz_coord_attr') + ! units + ierr=pio_put_att(File, this%bndsvdesc, 'units', trim(this%units)) + call cam_pio_handle_error(ierr, 'Error writing bounds "units" attr in write_horiz_coord_attr') + end if ! There are bounds for this coordinate + end if ! We define the variable + + if (present(dimid_out)) then + dimid_out = dimid + end if + + ! Back to old error handling + call pio_seterrorhandling(File, err_handling) + + end subroutine write_horiz_coord_attr + + !--------------------------------------------------------------------------- + ! + ! write_horiz_coord_var + ! + ! Write the coordinate values for this coordinate + ! + !--------------------------------------------------------------------------- + + subroutine write_horiz_coord_var(this, File) + use cam_pio_utils, only: cam_pio_get_decomp + use pio, only: file_desc_t, pio_double, iosystem_desc_t + use pio, only: pio_put_var, pio_write_darray + use pio, only: pio_bcast_error, pio_seterrorhandling + !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! + !!XXgoldyXX: The issue is cam_pio_utils depending on stuff in this module + use pio, only: pio_initdecomp, io_desc_t, pio_freedecomp, pio_syncfile + use cam_instance, only: atm_id + use shr_pio_mod, only: shr_pio_getiosys + !!XXgoldyXX: End of this part of the hack + + ! Dummy arguments + class(horiz_coord_t), intent(inout) :: this + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variables + character(len=120) :: errormsg + integer :: ierr + integer :: ldims(1) + integer :: fdims(1) + integer :: err_handling + type(io_desc_t) :: iodesc + !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! + type(iosystem_desc_t), pointer :: piosys + !!XXgoldyXX: End of this part of the hack + + ! Check to make sure we are supposed to write this var + if (associated(this%vardesc)) then + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + ! Write out the values for this dimension variable + if (associated(this%map)) then + ! This is a distributed variable, use pio_write_darray +#if 0 + ldims(1) = this%num_elem() + call this%get_coord_len(fdims(1)) + allocate(iodesc) + call cam_pio_get_decomp(iodesc, ldims, fdims, PIO_DOUBLE, this%map) + call pio_write_darray(File, this%vardesc, iodesc, this%values, ierr, fillval=grid_fill_value) + nullify(iodesc) ! CAM PIO system takes over memory management of iodesc +#else + !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! + piosys => shr_pio_getiosys(atm_id) + call pio_initdecomp(piosys, pio_double, (/this%dimsize/), this%map, & + iodesc) + call pio_write_darray(File, this%vardesc, iodesc, this%values, & + ierr, fillval=grid_fill_value) + call pio_syncfile(File) + call pio_freedecomp(File, iodesc) + ! Take care of bounds if they exist + if (associated(this%bnds) .and. associated(this%bndsvdesc)) then + call pio_initdecomp(piosys, pio_double, (/2, this%dimsize/), & + this%map, iodesc) + call pio_write_darray(File, this%bndsvdesc, iodesc, this%bnds, & + ierr, fillval=grid_fill_value) + call pio_syncfile(File) + call pio_freedecomp(File, iodesc) + end if +#endif + !!XXgoldyXX: End of this part of the hack + else + ! This is a local variable, pio_put_var should work fine + ierr = pio_put_var(File, this%vardesc, this%values) + ! Take care of bounds if they exist + if (associated(this%bnds) .and. associated(this%bndsvdesc)) then + ierr = pio_put_var(File, this%bndsvdesc, this%bnds) + end if + end if + write(errormsg, *) 'Error writing variable values for ',trim(this%name),& + ' in write_horiz_coord_var' + call cam_pio_handle_error(ierr, errormsg) + + ! Back to old error handling + call pio_seterrorhandling(File, err_handling) + + ! We are done with this variable descriptor, reset for next file + deallocate(this%vardesc) + nullify(this%vardesc) + ! Same with the bounds descriptor + if (associated(this%bndsvdesc)) then + deallocate(this%bndsvdesc) + nullify(this%bndsvdesc) + end if + end if ! Do we write the variable? + + end subroutine write_horiz_coord_var + +!!####################################################################### +!! +!! CAM grid functions +!! +!!####################################################################### + + integer function get_cam_grid_index_char(gridname) + ! Dummy arguments + character(len=*), intent(in) :: gridname + ! Local variables + integer :: i + + get_cam_grid_index_char = -1 + do i = 1, registeredhgrids + if(trim(gridname) == trim(cam_grids(i)%name)) then + get_cam_grid_index_char = i + exit + end if + end do + + end function get_cam_grid_index_char + + integer function get_cam_grid_index_int(gridid) + ! Dummy arguments + integer, intent(in) :: gridid + ! Local variables + integer :: i + + get_cam_grid_index_int = -1 + do i = 1, registeredhgrids + if(gridid == cam_grids(i)%id) then + get_cam_grid_index_int = i + exit + end if + end do + + end function get_cam_grid_index_int + + subroutine find_cam_grid_attr(gridind, name, attr) + ! Dummy arguments + integer, intent(in) :: gridind + character(len=*), intent(in) :: name + class(cam_grid_attribute_t), pointer, intent(out) :: attr + ! Local variable + type(cam_grid_attr_ptr_t), pointer :: attrPtr + + nullify(attr) + attrPtr => cam_grids(gridind)%attributes + do while (associated(attrPtr)) +!!XXgoldyXX: Is this not working in PGI? +! attr => attrPtr%getAttr() + attr => attrPtr%attr + if (trim(name) == trim(attr%name)) then + exit + else +!!XXgoldyXX: Is this not working in PGI? +! attrPtr => attrPtr%getNext() + attrPtr => attrPtr%next + nullify(attr) + end if + end do + return ! attr should be NULL if not found + end subroutine find_cam_grid_attr + + logical function cam_grid_attr_exists(gridname, name) + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(in) :: name + ! Local variables + class(cam_grid_attribute_t), pointer :: attr + integer :: gridind + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind > 0) then + call find_cam_grid_attr(gridind, name, attr) + cam_grid_attr_exists = associated(attr) + nullify(attr) + else + call endrun('cam_grid_attr_exists: Bad grid name, "'//trim(gridname)//'"') + end if + end function cam_grid_attr_exists + + integer function num_cam_grid_attrs(gridind) + ! Dummy arguments + integer, intent(in) :: gridind + + ! Local variables + class(cam_grid_attr_ptr_t), pointer :: attrPtr + + num_cam_grid_attrs = 0 + attrPtr => cam_grids(gridind)%attributes + do while (associated(attrPtr)) + num_cam_grid_attrs = num_cam_grid_attrs + 1 +!!XXgoldyXX: Is this not working in PGI? +! attrPtr => attrPtr%getNext() + attrPtr => attrPtr%next + end do + end function num_cam_grid_attrs + + subroutine cam_grid_register(name, id, lat_coord, lon_coord, map, & + unstruct, block_indexed, zonal_grid, src_in, dest_in) + ! Dummy arguments + character(len=*), intent(in) :: name + integer, intent(in) :: id + type(horiz_coord_t), pointer, intent(in) :: lat_coord + type(horiz_coord_t), pointer, intent(in) :: lon_coord + integer(iMap), pointer, intent(in) :: map(:,:) + logical, optional, intent(in) :: unstruct + logical, optional, intent(in) :: block_indexed + logical, optional, intent(in) :: zonal_grid + integer, optional, intent(in) :: src_in(2) + integer, optional, intent(in) :: dest_in(2) + + ! Local variables + character(len=max_hcoordname_len) :: latdimname, londimname + character(len=120) :: errormsg + integer :: i + integer :: src(2), dest(2) + character(len=*), parameter :: subname = 'CAM_GRID_REGISTER' + + ! For a values grid, we do not allow multiple calls + if (get_cam_grid_index(trim(name)) > 0) then + call endrun(trim(subname)//': Grid, '//trim(name)//', already exists') + else if (get_cam_grid_index(id) > 0) then + i = get_cam_grid_index(id) + write(errormsg, '(4a,i5,3a)') trim(subname), ': Attempt to add grid, ', & + trim(name), ' with id = ', id, ', however, grid ', & + trim(cam_grids(i)%name), ' already has that ID' + call endrun(trim(errormsg)) + else if (registeredhgrids >= maxhgrids) then + call endrun(trim(subname)//": Too many grids") + else + registeredhgrids = registeredhgrids + 1 + cam_grids(registeredhgrids)%name = trim(name) + cam_grids(registeredhgrids)%id = id + ! Quick sanity checks to make sure these aren't mixed up + if (.not. lat_coord%latitude) then + call endrun(subname//': lat_coord is not a latitude coordinate') + end if + if (lon_coord%latitude) then + call endrun(subname//': lon_coord is not a longitude coordinate') + end if + cam_grids(registeredhgrids)%lat_coord => lat_coord + cam_grids(registeredhgrids)%lon_coord => lon_coord + call lat_coord%get_dim_name(latdimname) + call lon_coord%get_dim_name(londimname) + if (present(unstruct)) then + cam_grids(registeredhgrids)%unstructured = unstruct + else + if (trim(latdimname) == trim(londimname)) then + cam_grids(registeredhgrids)%unstructured = .true. + else + cam_grids(registeredhgrids)%unstructured = .false. + end if + end if + if (present(block_indexed)) then + cam_grids(registeredhgrids)%block_indexed = block_indexed + else + cam_grids(registeredhgrids)%block_indexed = cam_grids(registeredhgrids)%unstructured + end if + if (present(zonal_grid)) then + ! Check the size of the longitude coordinate + call lon_coord%get_coord_len(i) + if (i /= 1) then + call endrun(subname//': lon_coord is not of size 1 for a zonal grid') + end if + cam_grids(registeredhgrids)%zonal_grid = zonal_grid + else + cam_grids(registeredhgrids)%zonal_grid = .false. + end if + if (associated(cam_grids(registeredhgrids)%map)) then + call endrun(trim(subname)//": new grid map should not be associated") + end if + if (present(src_in)) then + src = src_in + else + src(1) = 1 + src(2) = -1 + end if + if (present(dest_in)) then + dest = dest_in + else + dest(1) = 1 + if (cam_grids(registeredhgrids)%unstructured) then + dest(2) = 0 + else + dest(2) = 2 + end if + end if + allocate(cam_grids(registeredhgrids)%map) + call cam_grids(registeredhgrids)%map%init(map, & + cam_grids(registeredhgrids)%unstructured, src, dest) + call cam_grids(registeredhgrids)%print_cam_grid() + end if + + end subroutine cam_grid_register + + subroutine print_cam_grid(this) + class(cam_grid_t) :: this + + type(cam_grid_attr_ptr_t), pointer :: attrPtr + class(cam_grid_attribute_t), pointer :: attr + if (masterproc) then + write(iulog, '(3a,i4,4a,3(a,l2))') 'Grid: ', trim(this%name), & + ', ID = ', this%id, & + ', lat coord = ', trim(this%lat_coord%name), & + ', lon coord = ', trim(this%lon_coord%name), & + ', unstruct = ', this%unstructured, & + ', block_ind = ', this%block_indexed, & + ', zonal_grid = ', this%zonal_grid + attrPtr => this%attributes + do while (associated(attrPtr)) +!!XXgoldyXX: Is this not working in PGI? +! attr => attrPtr%getAttr() + attr => attrPtr%attr + call attr%print_attr() +!!XXgoldyXX: Is this not working in PGI? +! attrPtr => attrPtr%getNext() + attrPtr => attrPtr%next + end do + end if + end subroutine print_cam_grid + + integer function cam_grid_num_grids() + cam_grid_num_grids = registeredhgrids + end function cam_grid_num_grids + + ! Return .true. iff id represents a valid CAM grid + logical function cam_grid_check(id) + ! Dummy argument + integer, intent(in) :: id + + cam_grid_check = ((get_cam_grid_index(id) > 0) .and. & + (get_cam_grid_index(id) <= cam_grid_num_grids())) + end function cam_grid_check + + integer function cam_grid_id(name) + ! Dummy argument + character(len=*), intent(in) :: name + + ! Local variable + integer :: index + + index = get_cam_grid_index(name) + if (index > 0) then + cam_grid_id = cam_grids(index)%id + else + cam_grid_id = -1 + end if + + end function cam_grid_id + + ! Return the size of a local array for grid, ID. + ! With no optional argument, return the basic 2D array size + ! nlev represents levels or the total column size (product(mdims)) + integer function cam_grid_get_local_size(id, nlev) + + ! Dummy arguments + integer, intent(in) :: id + integer, optional, intent(in) :: nlev + + ! Local variables + integer :: gridid + character(len=128) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + cam_grid_get_local_size = cam_grids(gridid)%num_elem() + if (present(nlev)) then + cam_grid_get_local_size = cam_grid_get_local_size * nlev + end if + else + write(errormsg, *) 'cam_grid_get_local_size: Bad grid ID, ', id + call endrun(errormsg) + end if + + end function cam_grid_get_local_size + + ! Given some array information, find the dimension NetCDF IDs on for this grid + subroutine cam_grid_get_file_dimids(id, File, dimids) + use pio, only: file_desc_t + + ! Dummy arguments + integer, intent(in) :: id + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(out) :: dimids(:) + + ! Local variables + integer :: gridid + character(len=128) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%find_dimids(File, dimids) + else + write(errormsg, *) 'cam_grid_get_file_dimids: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_get_file_dimids + + ! Given some array information, find or compute a PIO decomposition + subroutine cam_grid_get_decomp(id, field_lens, file_lens, dtype, iodesc, & + field_dnames, file_dnames) + use pio, only: io_desc_t + + ! Dummy arguments + integer, intent(in) :: id + integer, intent(in) :: field_lens(:) ! Array dim sizes + integer, intent(in) :: file_lens(:) ! File dim sizes + integer, intent(in) :: dtype + type(io_desc_t), pointer, intent(out) :: iodesc + character(len=*), optional, intent(in) :: field_dnames(:) + character(len=*), optional, intent(in) :: file_dnames(:) + + ! Local variables + integer :: gridid + character(len=128) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%get_decomp(field_lens, file_lens, dtype, iodesc, & + field_dnames, file_dnames) + else + write(errormsg, *) 'cam_grid_get_decomp: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_get_decomp + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_2d_int + ! + ! Interface function for the grid%read_darray_2d_int method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_2d_int(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_2d_int(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_2d_int: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_2d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_3d_int + ! + ! Interface function for the grid%read_darray_2d_ method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_3d_int(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_3d_int(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_3d_int: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_3d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_2d_double + ! + ! Interface function for the grid%read_darray_2d_double method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_2d_double(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_2d_double(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_2d_double: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_2d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_3d_double + ! + ! Interface function for the grid%read_darray_3d_double method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_3d_double(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_3d_double(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_3d_double: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_3d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_2d_real + ! + ! Interface function for the grid%read_darray_2d_real method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_2d_real(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_2d_real(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_2d_real: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_2d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_dist_array_3d_real + ! + ! Interface function for the grid%read_darray_3d_real method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_dist_array_3d_real(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%read_darray_3d_real(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_read_dist_array_3d_real: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_read_dist_array_3d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_2d_int + ! + ! Interface function for the grid%write_darray_2d_int method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_2d_int(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_2d_int(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_2d_int: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_2d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_3d_int + ! + ! Interface function for the grid%write_darray_3d_int method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_3d_int(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_3d_int(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_3d_int: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_3d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_2d_double + ! + ! Interface function for the grid%write_darray_2d_double method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_2d_double(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_2d_double(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_2d_double: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_2d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_3d_double + ! + ! Interface function for the grid%write_darray_3d_double method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_3d_double(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_3d_double(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_3d_double: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_3d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_2d_real + ! + ! Interface function for the grid%write_darray_2d_real method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_2d_real(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_2d_real(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_2d_real: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_2d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_dist_array_3d_real + ! + ! Interface function for the grid%write_darray_3d_real method + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_dist_array_3d_real(File, id, adims, fdims, hbuf, varid) + use pio, only: file_desc_t + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: id + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variable + integer :: gridid + character(len=120) :: errormsg + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%write_darray_3d_real(File, adims, fdims, hbuf, varid) + else + write(errormsg, *) 'cam_grid_write_dist_array_3d_real: Bad grid ID, ', id + call endrun(errormsg) + end if + + end subroutine cam_grid_write_dist_array_3d_real + + subroutine cam_grid_get_gcid(id, gcid) + + ! Dummy arguments + integer, intent(in) :: id + integer(iMap), pointer :: gcid(:) + + ! Local variables + integer :: gridid + integer :: fieldbounds(2,2) + integer :: fieldlens(2) + integer :: filelens(2) + type(cam_filemap_t), pointer :: map + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + map => cam_grids(gridid)%map + call cam_grids(gridid)%coord_lengths(filelens) + call map%array_bounds(fieldbounds) + fieldlens(:) = fieldbounds(:,2) - fieldbounds(:,1) + 1 + call map%get_filemap(fieldlens, filelens, gcid) + else + call endrun('cam_grid_get_gcid: Bad grid ID') + end if + end subroutine cam_grid_get_gcid + + subroutine cam_grid_get_array_bounds(id, dims) + + ! Dummy arguments + integer, intent(in) :: id + integer, intent(inout) :: dims(:,:) + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + if (.not. associated(cam_grids(gridid)%map)) then + call endrun('cam_grid_get_array_bounds: Grid, '//trim(cam_grids(gridid)%name)//', has no map') + else + call cam_grids(gridid)%map%array_bounds(dims) + end if + else + call endrun('cam_grid_get_array_bounds: Bad grid ID') + end if + + end subroutine cam_grid_get_array_bounds + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_coord_names: Return the names of the grid axes + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_coord_names(id, lon_name, lat_name) + + ! Dummy arguments + integer, intent(in) :: id + character(len=*), intent(out) :: lon_name + character(len=*), intent(out) :: lat_name + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%coord_names(lon_name, lat_name) + else + call endrun('cam_grid_get_coord_names: Bad grid ID') + end if + + end subroutine cam_grid_get_coord_names + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_dim_names: Return the names of the grid axes dimensions. + ! Note that these may be the same + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_dim_names_id(id, name1, name2) + + ! Dummy arguments + integer, intent(in) :: id + character(len=*), intent(out) :: name1 + character(len=*), intent(out) :: name2 + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%dim_names(name1, name2) + else + call endrun('cam_grid_get_dim_names_id: Bad grid ID') + end if + + end subroutine cam_grid_get_dim_names_id + + subroutine cam_grid_get_dim_names_name(gridname, name1, name2) + + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(out) :: name1 + character(len=*), intent(out) :: name2 + + ! Local variables + integer :: gridind + character(len=120) :: errormsg + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind < 0) then + write(errormsg, *) 'No CAM grid with name = ', trim(gridname) + call endrun('cam_grid_get_dim_names_name: '//errormsg) + else + call cam_grids(gridind)%dim_names(name1, name2) + end if + + end subroutine cam_grid_get_dim_names_name + + logical function cam_grid_has_blocksize(id) + + ! Dummy arguments + integer, intent(in) :: id + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + if (.not. associated(cam_grids(gridid)%map)) then + call endrun('cam_grid_has_blocksize: Grid, '//trim(cam_grids(gridid)%name)//', has no map') + else + cam_grid_has_blocksize = cam_grids(gridid)%map%has_blocksize() + end if + else + call endrun('cam_grid_has_blocksize: Bad grid ID') + end if + end function cam_grid_has_blocksize + + ! Return the number of active columns in the block specified by block_id + integer function cam_grid_get_block_count(id, block_id) result(ncol) + + ! Dummy arguments + integer, intent(in) :: id + integer, intent(in) :: block_id + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + if (.not. associated(cam_grids(gridid)%map)) then + call endrun('cam_grid_get_block_count: Grid, '//trim(cam_grids(gridid)%name)//', has no map') + else + ncol = cam_grids(gridid)%map%blocksize(block_id) + end if + else + call endrun('cam_grid_get_block_count: Bad grid ID') + end if + end function cam_grid_get_block_count + + function cam_grid_get_latvals(id) result(latvals) + + ! Dummy argument + integer, intent(in) :: id + real(r8), pointer :: latvals(:) + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + if (.not. associated(cam_grids(gridid)%lat_coord%values)) then + nullify(latvals) + else + latvals => cam_grids(gridid)%lat_coord%values + end if + else + call endrun('cam_grid_get_latvals: Bad grid ID') + end if + end function cam_grid_get_latvals + + function cam_grid_get_lonvals(id) result(lonvals) + + ! Dummy arguments + integer, intent(in) :: id + real(r8), pointer :: lonvals(:) + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + if (.not. associated(cam_grids(gridid)%lon_coord%values)) then + nullify(lonvals) + else + lonvals => cam_grids(gridid)%lon_coord%values + end if + else + call endrun('cam_grid_get_lonvals: Bad grid ID') + end if + end function cam_grid_get_lonvals + + ! Find the longitude and latitude of a range of map entries + ! beg and end are the range of the first source index. blk is a block or chunk index + subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat) + + ! Dummy arguments + integer, intent(in) :: id + integer, intent(in) :: beg + integer, intent(in) :: end + integer, intent(in) :: blk + real(r8), intent(inout) :: lon(:) + real(r8), intent(inout) :: lat(:) + + ! Local variables + integer :: gridid + integer :: i + gridid = get_cam_grid_index(id) + if (gridid > 0) then + do i = beg, end + if (cam_grids(gridid)%is_unstructured()) then + call endrun('cam_grid_get_coords: Not implemented') + else + call endrun('cam_grid_get_coords: Not implemented') + end if + end do + else + call endrun('cam_grid_get_coords: Bad grid ID') + end if + end subroutine cam_grid_get_coords + + logical function cam_grid_is_unstructured(id) result(unstruct) + + ! Dummy arguments + integer, intent(in) :: id + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + unstruct = cam_grids(gridid)%is_unstructured() + else + call endrun('cam_grid_is_unstructured: Bad grid ID') + end if + end function cam_grid_is_unstructured + + logical function cam_grid_is_block_indexed(id) result(block_indexed) + + ! Dummy arguments + integer, intent(in) :: id + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + block_indexed = cam_grids(gridid)%is_block_indexed() + else + call endrun('s: Bad grid ID') + end if + end function cam_grid_is_block_indexed + + logical function cam_grid_is_zonal(id) result(zonal) + + ! Dummy arguments + integer, intent(in) :: id + + ! Local variables + integer :: gridid + gridid = get_cam_grid_index(id) + if (gridid > 0) then + zonal = cam_grids(gridid)%is_zonal_grid() + else + call endrun('s: Bad grid ID') + end if + end function cam_grid_is_zonal + + ! Compute or update a grid patch mask + subroutine cam_grid_compute_patch(id, patch, lonl, lonu, latl, latu, cco) + + ! Dummy arguments + integer, intent(in) :: id + type(cam_grid_patch_t), intent(inout) :: patch + real(r8), intent(in) :: lonl + real(r8), intent(in) :: lonu + real(r8), intent(in) :: latl + real(r8), intent(in) :: latu + logical, intent(in) :: cco ! Collect columns? + + ! Local variables + integer :: gridid + + gridid = get_cam_grid_index(id) + if (gridid > 0) then + call cam_grids(gridid)%get_patch_mask(lonl, lonu, latl, latu, patch, cco) + else + call endrun('cam_grid_compute_patch: Bad grid ID') + end if + + end subroutine cam_grid_compute_patch + +!!####################################################################### +!! +!! CAM grid attribute functions +!! +!!####################################################################### + + subroutine cam_grid_attr_init(this, name, long_name, next) + ! Dummy arguments + class(cam_grid_attribute_t) :: this + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + class(cam_grid_attribute_t), pointer :: next + + this%name = trim(name) + this%long_name = trim(long_name) + this%next => next + end subroutine cam_grid_attr_init + + subroutine print_attr_base(this) + ! Dummy arguments + class(cam_grid_attribute_t), intent(in) :: this + if (masterproc) then + write(iulog, '(5a)') 'Attribute: ', trim(this%name), ", long name = '", & + trim(this%long_name), "'" + end if + end subroutine print_attr_base + + subroutine cam_grid_attr_init_0d_int(this, name, long_name, val) + ! Dummy arguments + class(cam_grid_attribute_0d_int_t) :: this + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + integer, intent(in) :: val + +! call this%cam_grid_attr_init(name, '') + this%name = trim(name) + this%long_name = trim(long_name) + this%ival = val + end subroutine cam_grid_attr_init_0d_int + + subroutine print_attr_0d_int(this) + ! Dummy arguments + class(cam_grid_attribute_0d_int_t), intent(in) :: this + + call this%print_attr_base() + if (masterproc) then + write(iulog, *) ' value = ', this%ival + end if + end subroutine print_attr_0d_int + + subroutine cam_grid_attr_init_0d_char(this, name, long_name, val) + ! Dummy arguments + class(cam_grid_attribute_0d_char_t) :: this + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: val + +! call this%cam_grid_attr_init(name, '') + this%name = trim(name) + this%long_name = trim(long_name) + this%val = trim(val) + end subroutine cam_grid_attr_init_0d_char + + subroutine print_attr_0d_char(this) + ! Dummy arguments + class(cam_grid_attribute_0d_char_t), intent(in) :: this + + call this%print_attr_base() + if (masterproc) then + write(iulog, *) ' value = ', trim(this%val) + end if + end subroutine print_attr_0d_char + + subroutine cam_grid_attr_init_1d_int(this, name, long_name, dimname, & + dimsize, values, map) + ! Dummy arguments + class(cam_grid_attribute_1d_int_t) :: this + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: dimname + integer, intent(in) :: dimsize + integer, target, intent(in) :: values(:) + integer(iMap), optional, target, intent(in) :: map(:) + +! call this%cam_grid_attr_init(trim(name), trim(long_name)) + if (len_trim(name) > max_hcoordname_len) then + call endrun('cam_grid_attr_1d_int: name too long') + end if + this%name = trim(name) + if (len_trim(long_name) > max_chars) then + call endrun('cam_grid_attr_1d_int: long_name too long') + end if + this%long_name = trim(long_name) + + if (len_trim(dimname) > max_hcoordname_len) then + call endrun('cam_grid_attr_1d_int: dimname too long') + end if + this%dimname = trim(dimname) + this%dimsize = dimsize + this%values => values + ! Fill in the optional map + if (present(map)) then + allocate(this%map(size(map))) + this%map(:) = map(:) + else + nullify(this%map) + end if + end subroutine cam_grid_attr_init_1d_int + + subroutine cam_grid_attr_init_1d_r8(this, name, long_name, dimname, & + dimsize, values, map) + ! Dummy arguments + class(cam_grid_attribute_1d_r8_t) :: this + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: dimname + integer, intent(in) :: dimsize + real(r8), target, intent(in) :: values(:) + integer(iMap), optional, target, intent(in) :: map(:) + +! call this%cam_grid_attr_init(trim(name), trim(long_name), next) + this%name = trim(name) + this%long_name = trim(long_name) + + this%dimname = trim(dimname) + this%dimsize = dimsize + this%values => values + ! Fill in the optional map + if (present(map)) then + allocate(this%map(size(map))) + this%map(:) = map(:) + else + nullify(this%map) + end if + end subroutine cam_grid_attr_init_1d_r8 + + subroutine print_attr_1d_int(this) + ! Dummy arguments + class(cam_grid_attribute_1d_int_t), intent(in) :: this + call this%print_attr_base() + if (masterproc) then + write(iulog, *) ' dimname = ', trim(this%dimname) + end if + end subroutine print_attr_1d_int + + subroutine print_attr_1d_r8(this) + ! Dummy arguments + class(cam_grid_attribute_1d_r8_t), intent(in) :: this + call this%print_attr_base() + if (masterproc) then + write(iulog, *) ' dimname = ', trim(this%dimname) + end if + end subroutine print_attr_1d_r8 + + subroutine insert_grid_attribute(gridind, attr) + integer, intent(in) :: gridind + class(cam_grid_attribute_t), pointer :: attr + + ! Push a new attribute onto the grid + type(cam_grid_attr_ptr_t), pointer :: attrPtr + + allocate(attrPtr) + call attrPtr%initialize(attr) + call attrPtr%setNext(cam_grids(gridind)%attributes) + cam_grids(gridind)%attributes => attrPtr + call attrPtr%attr%print_attr() + end subroutine insert_grid_attribute + + subroutine add_cam_grid_attribute_0d_int(gridname, name, long_name, val) + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + integer, intent(in) :: val + + ! Local variables + type(cam_grid_attribute_0d_int_t), pointer :: attr + class(cam_grid_attribute_t), pointer :: attptr + character(len=120) :: errormsg + integer :: gridind + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind > 0) then + call find_cam_grid_attr(gridind, trim(name), attptr) + if (associated(attptr)) then + ! Attribute found, can't add it again! + write(errormsg, '(4a)') & + 'add_cam_grid_attribute_0d_int: attribute ', trim(name), & + ' already exists for ', cam_grids(gridind)%name + call endrun(errormsg) + else + ! Need a new attribute. + allocate(attr) + call attr%cam_grid_attr_init_0d_int(trim(name), trim(long_name), val) + attptr => attr + call insert_grid_attribute(gridind, attptr) + end if + else + write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_int: grid ', & + trim(gridname), ' was not found' + call endrun(errormsg) + end if +! call cam_grids(gridind)%print_cam_grid() + end subroutine add_cam_grid_attribute_0d_int + + subroutine add_cam_grid_attribute_0d_char(gridname, name, val) + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(in) :: name + character(len=*), intent(in) :: val + + ! Local variables + type(cam_grid_attribute_0d_char_t), pointer :: attr + class(cam_grid_attribute_t), pointer :: attptr + character(len=120) :: errormsg + integer :: gridind + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind > 0) then + call find_cam_grid_attr(gridind, trim(name), attptr) + if (associated(attptr)) then + ! Attribute found, can't add it again! + write(errormsg, '(4a)') & + 'add_cam_grid_attribute_0d_char: attribute ', trim(name), & + ' already exists for ', cam_grids(gridind)%name + call endrun(errormsg) + else + ! Need a new attribute. + allocate(attr) + call attr%cam_grid_attr_init_0d_char(trim(name), '', val) + attptr => attr + call insert_grid_attribute(gridind, attptr) + end if + else + write(errormsg, '(3a)') 'add_cam_grid_attribute_0d_char: grid ', & + trim(gridname), ' was not found' + call endrun(errormsg) + end if +! call cam_grids(gridind)%print_cam_grid() + end subroutine add_cam_grid_attribute_0d_char + + subroutine add_cam_grid_attribute_1d_int(gridname, name, long_name, & + dimname, values, map) + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: dimname + integer, intent(in), target :: values(:) + integer(iMap), intent(in), target, optional :: map(:) + + ! Local variables + type(cam_grid_attribute_1d_int_t), pointer :: attr + class(cam_grid_attribute_t), pointer :: attptr + character(len=120) :: errormsg + integer :: gridind + integer :: dimsize + + nullify(attr) + nullify(attptr) + gridind = get_cam_grid_index(trim(gridname)) + if (gridind > 0) then + call find_cam_grid_attr(gridind, trim(name), attptr) + if (associated(attptr)) then + ! Attribute found, can't add it again! + write(errormsg, '(4a)') & + 'add_cam_grid_attribute_1d_int: attribute ', trim(name), & + ' already exists for ', cam_grids(gridind)%name + call endrun(errormsg) + else + ! Need a new attribute. + dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname)) + if (dimsize < 1) then + dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname)) + end if + if (dimsize < 1) then + write(errormsg, *) 'add_cam_grid_attribute_1d_int: attribute ', & + 'dimension ', trim(dimname), ' for ', trim(name), ', not found' + call endrun(errormsg) + end if + allocate(attr) + call attr%cam_grid_attr_init_1d_int(trim(name), trim(long_name), & + trim(dimname), dimsize, values, map) + attptr => attr + call insert_grid_attribute(gridind, attptr) + end if + else + write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_int: grid ', & + trim(gridname), ' was not found' + call endrun(errormsg) + end if +! call cam_grids(gridind)%print_cam_grid() + end subroutine add_cam_grid_attribute_1d_int + + subroutine add_cam_grid_attribute_1d_r8(gridname, name, long_name, & + dimname, values, map) + ! Dummy arguments + character(len=*), intent(in) :: gridname + character(len=*), intent(in) :: name + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: dimname + real(r8), intent(in), target :: values(:) + integer(iMap), intent(in), target, optional :: map(:) + + ! Local variables + type(cam_grid_attribute_1d_r8_t), pointer :: attr + class(cam_grid_attribute_t), pointer :: attptr + character(len=120) :: errormsg + integer :: gridind + integer :: dimsize + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind > 0) then + call find_cam_grid_attr(gridind, trim(name), attptr) + if (associated(attptr)) then + ! Attribute found, can't add it again! + write(errormsg, '(4a)') & + 'add_cam_grid_attribute_1d_r8: attribute ', trim(name), & + ' already exists for ', cam_grids(gridind)%name + call endrun(errormsg) + else + ! Need a new attribute. + dimsize = cam_grids(gridind)%lat_coord%global_size(trim(dimname)) + if (dimsize < 1) then + dimsize = cam_grids(gridind)%lon_coord%global_size(trim(dimname)) + end if + if (dimsize < 1) then + write(errormsg, *) 'add_cam_grid_attribute_1d_r8: attribute ', & + 'dimension ', trim(dimname), ' for ', trim(name), ', not found' + call endrun(errormsg) + end if + allocate(attr) + call attr%cam_grid_attr_init_1d_r8(trim(name), trim(long_name), & + trim(dimname), dimsize, values, map) + attptr => attr + call insert_grid_attribute(gridind, attptr) + end if + else + write(errormsg, '(3a)') 'add_cam_grid_attribute_1d_r8: grid ', & + trim(gridname), ' was not found' + call endrun(errormsg) + end if +! call cam_grids(gridind)%print_cam_grid() + end subroutine add_cam_grid_attribute_1d_r8 + +!!####################################################################### +!! +!! CAM grid attribute pointer (list node) functions +!! +!!####################################################################### + + subroutine initializeAttrPtr(this, attr) + ! Dummy arguments + class(cam_grid_attr_ptr_t) :: this + class(cam_grid_attribute_t), target :: attr + + if (associated(this%next)) then + if (masterproc) then + write(iulog, *) 'WARNING: Overwriting attr pointer for cam_grid_attr_ptr_t' + end if + end if + this%attr => attr + end subroutine initializeAttrPtr + + function getAttrPtrAttr(this) + ! Dummy variable + class(cam_grid_attr_ptr_t) :: this + class(cam_grid_attribute_t), pointer :: getAttrPtrAttr + + getAttrPtrAttr => this%attr + end function getAttrPtrAttr + + function getAttrPtrNext(this) + ! Dummy arguments + class(cam_grid_attr_ptr_t) :: this + type(cam_grid_attr_ptr_t), pointer :: getAttrPtrNext + + getAttrPtrNext => this%next + end function getAttrPtrNext + + subroutine setAttrPtrNext(this, next) + ! Dummy arguments + class(cam_grid_attr_ptr_t) :: this + type(cam_grid_attr_ptr_t), pointer :: next + + if (associated(this%next)) then + if (masterproc) then + write(iulog, *) 'WARNING: Overwriting next pointer for cam_grid_attr_ptr_t' + end if + end if + this%next => next + end subroutine setAttrPtrNext + + !--------------------------------------------------------------------------- + ! + ! write_cam_grid_attr_0d_int + ! + ! Write a grid attribute + ! + !--------------------------------------------------------------------------- + + subroutine write_cam_grid_attr_0d_int(attr, File) + use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_int, & + pio_inq_att, PIO_GLOBAL + use cam_pio_utils, only: cam_pio_def_var + + ! Dummy arguments + class(cam_grid_attribute_0d_int_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variables + character(len=120) :: errormsg + integer :: attrtype + integer(imap) :: attrlen + integer :: ierr + + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is associated, that grid defined the attribute + if (.not. associated(attr%vardesc)) then + if (len_trim(attr%long_name) > 0) then + ! This 0d attribute is a scalar variable with a long_name attribute + ! First, define the variable + allocate(attr%vardesc) + call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc, & + existOK=.false.) + ierr= pio_put_att(File, attr%vardesc, '_FillValue', int(grid_fill_value)) + call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_0d_int') + ierr=pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_0d_int') + else + ! This 0d attribute is a global attribute + ! Check to see if the attribute already exists in the file + ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen) + if (ierr /= PIO_NOERR) then + ! Time to define the attribute + ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%ival) + call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_int') + end if + end if + end if + + end subroutine write_cam_grid_attr_0d_int + + !--------------------------------------------------------------------------- + ! + ! write_cam_grid_attr_0d_char + ! + ! Write a grid attribute + ! + !--------------------------------------------------------------------------- + + subroutine write_cam_grid_attr_0d_char(attr, File) + use pio, only: file_desc_t, pio_put_att, pio_noerr, & + pio_inq_att, PIO_GLOBAL + + ! Dummy arguments + class(cam_grid_attribute_0d_char_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variables + character(len=120) :: errormsg + integer :: attrtype + integer(imap) :: attrlen + integer :: ierr + + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is associated, that grid defined the attribute + if (.not. associated(attr%vardesc)) then + ! The 0d char attributes are global attribues + ! Check to see if the attribute already exists in the file + ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen) + if (ierr /= PIO_NOERR) then + ! Time to define the variable + ierr = pio_put_att(File, PIO_GLOBAL, trim(attr%name), attr%val) + call cam_pio_handle_error(ierr, 'Unable to define attribute in write_cam_grid_attr_0d_char') + end if + end if + + end subroutine write_cam_grid_attr_0d_char + + !--------------------------------------------------------------------------- + ! + ! write_cam_grid_attr_1d_int + ! + ! Write a grid attribute + ! + !--------------------------------------------------------------------------- + + subroutine write_cam_grid_attr_1d_int(attr, File) + use pio, only: file_desc_t, pio_put_att, pio_noerr + use pio, only: pio_inq_dimid, pio_int + use cam_pio_utils, only: cam_pio_def_var + + ! Dummy arguments + class(cam_grid_attribute_1d_int_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variables + integer :: dimid ! PIO dimension ID + character(len=120) :: errormsg + integer :: ierr + + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is associated, that grid defined the attribute + if (.not. associated(attr%vardesc)) then + ! Check to see if the dimension already exists in the file + ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) + if (ierr /= PIO_NOERR) then + ! The dimension has not yet been defined. This is an error + ! NB: It should have been defined as part of a coordinate + write(errormsg, *) 'write_cam_grid_attr_1d_int: dimension, ', & + trim(attr%dimname), ', does not exist' + call endrun(errormsg) + end if + ! Time to define the variable + allocate(attr%vardesc) + call cam_pio_def_var(File, trim(attr%name), pio_int, (/dimid/), & + attr%vardesc, existOK=.false.) + ierr= pio_put_att(File, attr%vardesc, '_FillValue', int(grid_fill_value)) + call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_1d_int') + ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int') + end if + + end subroutine write_cam_grid_attr_1d_int + + !--------------------------------------------------------------------------- + ! + ! write_cam_grid_attr_1d_r8 + ! + ! Write a grid attribute + ! + !--------------------------------------------------------------------------- + + subroutine write_cam_grid_attr_1d_r8(attr, File) + use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double, & + pio_inq_dimid + use cam_pio_utils, only: cam_pio_def_var + + ! Dummy arguments + class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File ! PIO file Handle + + ! Local variables + integer :: dimid ! PIO dimension ID + character(len=120) :: errormsg + integer :: ierr + + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is associated, that grid defined the attribute + if (.not. associated(attr%vardesc)) then + ! Check to see if the dimension already exists in the file + ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) + if (ierr /= PIO_NOERR) then + ! The dimension has not yet been defined. This is an error + ! NB: It should have been defined as part of a coordinate + write(errormsg, *) 'write_cam_grid_attr_1d_r8: dimension, ', & + trim(attr%dimname), ', does not exist' + call endrun(errormsg) + end if + ! Time to define the variable + allocate(attr%vardesc) + call cam_pio_def_var(File, trim(attr%name), pio_double, (/dimid/), & + attr%vardesc, existOK=.false.) + ! fill value + ierr = pio_put_att(File, attr%vardesc, '_FillValue', grid_fill_value) + call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_1d_r8') + ! long_name + ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8') + end if + + end subroutine write_cam_grid_attr_1d_r8 + + !--------------------------------------------------------------------------- + ! + ! cam_grid_attribute_copy + ! + ! Copy an attribute from a source grid to a destination grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_attribute_copy(src_grid, dest_grid, attribute_name) + ! Dummy arguments + character(len=*), intent(in) :: src_grid + character(len=*), intent(in) :: dest_grid + character(len=*), intent(in) :: attribute_name + + ! Local variables + character(len=120) :: errormsg + integer :: src_ind, dest_ind + class(cam_grid_attribute_t), pointer :: attr + + ! Find the source and destination grid indices + src_ind = get_cam_grid_index(trim(src_grid)) + dest_ind = get_cam_grid_index(trim(dest_grid)) + + call find_cam_grid_attr(dest_ind, trim(attribute_name), attr) + if (associated(attr)) then + ! Attribute found, can't add it again! + write(errormsg, '(4a)') 'CAM_GRID_ATTRIBUTE_COPY: attribute ', & + trim(attribute_name),' already exists for ',cam_grids(dest_ind)%name + call endrun(errormsg) + else + call find_cam_grid_attr(src_ind, trim(attribute_name), attr) + if (associated(attr)) then + ! Copy the attribute + call insert_grid_attribute(dest_ind, attr) + else + write(errormsg, '(4a)') ": Did not find attribute, '", & + trim(attribute_name), "' in ", cam_grids(src_ind)%name + call endrun("CAM_GRID_ATTRIBUTE_COPY"//errormsg) + end if + end if + + end subroutine cam_grid_attribute_copy + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_attr + ! + ! Write the dimension and coordinate attributes for the horizontal history + ! coordinates. + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_attr(File, grid_id, header_info) + use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling + use pio, only: pio_inq_dimid + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, intent(in) :: grid_id + type(cam_grid_header_info_t), intent(inout) :: header_info + + ! Local variables + integer :: gridind + class(cam_grid_attribute_t), pointer :: attr + type(cam_grid_attr_ptr_t), pointer :: attrPtr + integer :: dimids(2) + integer :: err_handling + + gridind = get_cam_grid_index(grid_id) + !! Fill this in to make sure history finds grid + header_info%grid_id = grid_id + + if (allocated(header_info%hdims)) then + ! This shouldn't happen but, no harm, no foul + deallocate(header_info%hdims) + end if + + if (associated(header_info%lon_varid)) then + ! This could be a sign of bad memory management + call endrun('CAM_GRID_WRITE_ATTR: lon_varid should be NULL') + end if + if (associated(header_info%lat_varid)) then + ! This could be a sign of bad memory management + call endrun('CAM_GRID_WRITE_ATTR: lat_varid should be NULL') + end if + + ! Only write this grid if not already defined + if (cam_grids(gridind)%attrs_defined) then + ! We need to fill out the hdims info for this grid + call cam_grids(gridind)%find_dimids(File, dimids) + if (dimids(2) < 0) then + allocate(header_info%hdims(1)) + header_info%hdims(1) = dimids(1) + else + allocate(header_info%hdims(2)) + header_info%hdims(1:2) = dimids(1:2) + end if + else + ! Write the horizontal coord attributes first so that we have the dims + call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2)) + call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1)) + + if (dimids(2) == dimids(1)) then + allocate(header_info%hdims(1)) + else + allocate(header_info%hdims(2)) + header_info%hdims(2) = dimids(2) + end if + header_info%hdims(1) = dimids(1) + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + attrPtr => cam_grids(gridind)%attributes + do while (associated(attrPtr)) +!!XXgoldyXX: Is this not working in PGI? +! attr => attrPtr%getAttr() + attr => attrPtr%attr + call attr%write_attr(File) +!!XXgoldyXX: Is this not working in PGI? +! attrPtr => attrPtr%getNext() + attrPtr => attrPtr%next + end do + + ! Back to previous I/O error handling + call pio_seterrorhandling(File, err_handling) + + cam_grids(gridind)%attrs_defined = .true. + end if + + end subroutine cam_grid_write_attr + + subroutine write_cam_grid_val_0d_int(attr, File) + use pio, only: file_desc_t, pio_inq_varid, pio_put_var + + ! Dummy arguments + class(cam_grid_attribute_0d_int_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File + + ! Local variables + character(len=120) :: errormsg + integer :: ierr + + ! We only write this var if it is a variable + if (associated(attr%vardesc)) then + ierr = pio_put_var(File, attr%vardesc, attr%ival) + call cam_pio_handle_error(ierr, 'Error writing value in write_cam_grid_val_0d_int') + deallocate(attr%vardesc) + nullify(attr%vardesc) + end if + + end subroutine write_cam_grid_val_0d_int + + subroutine write_cam_grid_val_0d_char(attr, File) + use pio, only: file_desc_t + + ! Dummy arguments + class(cam_grid_attribute_0d_char_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File + + ! This subroutine is a stub because global attributes are written + ! in define mode + return + end subroutine write_cam_grid_val_0d_char + + subroutine write_cam_grid_val_1d_int(attr, File) + use pio, only: file_desc_t, pio_put_var, pio_int, & + pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + use cam_pio_utils, only: cam_pio_newdecomp + + ! Dummy arguments + class(cam_grid_attribute_1d_int_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File + + ! Local variables + character(len=120) :: errormsg + integer :: ierr + type(io_desc_t), pointer :: iodesc + + nullify(iodesc) + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is not associated, another grid write the values + if (associated(attr%vardesc)) then + ! Write out the values for this dimension variable + if (associated(attr%map)) then + ! This is a distributed variable, use pio_write_darray + allocate(iodesc) + call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_int) + call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr, fillval=int(grid_fill_value)) + call pio_freedecomp(File, iodesc) + deallocate(iodesc) + nullify(iodesc) + else + ! This is a local variable, pio_put_var should work fine + ierr = pio_put_var(File, attr%vardesc, attr%values) + end if + call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_int') + deallocate(attr%vardesc) + nullify(attr%vardesc) + end if + + end subroutine write_cam_grid_val_1d_int + + subroutine write_cam_grid_val_1d_r8(attr, File) + use pio, only: file_desc_t, pio_put_var, pio_double, & + pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + use cam_pio_utils, only: cam_pio_newdecomp + + ! Dummy arguments + class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr + type(file_desc_t), intent(inout) :: File + + ! Local variables + character(len=120) :: errormsg + integer :: ierr + type(io_desc_t), pointer :: iodesc + + nullify(iodesc) + ! Since more than one grid can share an attribute, assume that if the + ! vardesc is not associated, another grid write the values + if (associated(attr%vardesc)) then + ! Write out the values for this dimension variable + if (associated(attr%map)) then + ! This is a distributed variable, use pio_write_darray + allocate(iodesc) + call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_double) + call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr, fillval=grid_fill_value) + call pio_freedecomp(File, iodesc) + deallocate(iodesc) + nullify(iodesc) + else + ! This is a local variable, pio_put_var should work fine + ierr = pio_put_var(File, attr%vardesc, attr%values) + end if + call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_r8') + deallocate(attr%vardesc) + nullify(attr%vardesc) + end if + + end subroutine write_cam_grid_val_1d_r8 + + subroutine cam_grid_write_var(File, grid_id) + use pio, only: file_desc_t, pio_bcast_error, pio_seterrorhandling + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, intent(in) :: grid_id + + ! Local variables + integer :: gridind + integer :: err_handling + class(cam_grid_attribute_t), pointer :: attr + type(cam_grid_attr_ptr_t), pointer :: attrPtr + + gridind = get_cam_grid_index(grid_id) + ! Only write if not already done + if (cam_grids(gridind)%attrs_defined) then + ! Write the horizontal coorinate values + call cam_grids(gridind)%lon_coord%write_var(File) + call cam_grids(gridind)%lat_coord%write_var(File) + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + ! Write out the variable values for each grid attribute + attrPtr => cam_grids(gridind)%attributes + do while (associated(attrPtr)) +!!XXgoldyXX: Is this not working in PGI? +! attr => attrPtr%getAttr() + attr => attrPtr%attr + call attr%write_val(File) +!!XXgoldyXX: Is this not working in PGI? +! attrPtr => attrPtr%getNext() + attrPtr => attrPtr%next + end do + + ! Back to previous I/O error handling + call pio_seterrorhandling(File, err_handling) + + cam_grids(gridind)%attrs_defined = .false. + end if + + end subroutine cam_grid_write_var + + logical function cam_grid_block_indexed(this) + class(cam_grid_t) :: this + + cam_grid_block_indexed = this%block_indexed + end function cam_grid_block_indexed + + logical function cam_grid_zonal_grid(this) + class(cam_grid_t) :: this + + cam_grid_zonal_grid = this%zonal_grid + end function cam_grid_zonal_grid + + logical function cam_grid_unstructured(this) + class(cam_grid_t) :: this + + cam_grid_unstructured = this%unstructured + end function cam_grid_unstructured + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_dims: Return the dimensions of the grid + ! For lon/lat grids, this is (nlon, nlat) + ! For unstructured grids, this is (ncols, 1) + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_dims(this, dims) + ! Dummy arguments + class(cam_grid_t) :: this + integer, intent(inout) :: dims(2) + + if (this%is_unstructured()) then + call this%lon_coord%get_coord_len(dims(1)) + dims(2) = 1 + else + call this%lon_coord%get_coord_len(dims(1)) + call this%lat_coord%get_coord_len(dims(2)) + end if + + end subroutine cam_grid_get_dims + + !--------------------------------------------------------------------------- + ! + ! cam_grid_coord_names: Return the names of the grid axes + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_coord_names(this, lon_name, lat_name) + ! Dummy arguments + class(cam_grid_t) :: this + character(len=*), intent(out) :: lon_name + character(len=*), intent(out) :: lat_name + + call this%lon_coord%get_coord_name(lon_name) + call this%lat_coord%get_coord_name(lat_name) + + end subroutine cam_grid_coord_names + + !--------------------------------------------------------------------------- + ! + ! cam_grid_dim_names: Return the names of the dimensions of the grid axes. + ! Note that these may be the same + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_dim_names(this, name1, name2) + ! Dummy arguments + class(cam_grid_t) :: this + character(len=*), intent(out) :: name1 + character(len=*), intent(out) :: name2 + + call this%lon_coord%get_dim_name(name1) + call this%lat_coord%get_dim_name(name2) + + end subroutine cam_grid_dim_names + + !--------------------------------------------------------------------------- + ! + ! cam_grid_dimensions_id: Return the dimensions of the grid + ! For lon/lat grids, this is (nlon, nlat) + ! For unstructured grids, this is (ncols, 1) + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_dimensions_id(gridid, dims, rank) + ! Dummy arguments + integer, intent(in) :: gridid + integer, intent(inout) :: dims(2) + integer, optional, intent(out) :: rank + + ! Local variables + integer :: index + character(len=max_hcoordname_len) :: dname1, dname2 + character(len=120) :: errormsg + + index = get_cam_grid_index(gridid) + if (index < 0) then + write(errormsg, *) 'No CAM grid with ID =', gridid + call endrun(errormsg) + else + call cam_grids(index)%coord_lengths(dims) + end if + if (present(rank)) then + call cam_grids(index)%dim_names(dname1, dname2) + if (trim(dname1) == trim(dname2)) then + rank = 1 + else + rank = 2 + end if + end if + + end subroutine cam_grid_dimensions_id + + !--------------------------------------------------------------------------- + ! + ! cam_grid_dimensions_name: Return the dimensions of the grid + ! For lon/lat grids, this is (nlon, nlat) + ! For unstructured grids, this is (ncols, 1) + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_dimensions_name(gridname, dims, rank) + ! Dummy arguments + character(len=*), intent(in) :: gridname + integer, intent(inout) :: dims(2) + integer, optional, intent(out) :: rank + + ! Local variables + integer :: gridind + character(len=max_hcoordname_len) :: dname1, dname2 + character(len=120) :: errormsg + + gridind = get_cam_grid_index(trim(gridname)) + if (gridind < 0) then + write(errormsg, *) 'No CAM grid with name = ', trim(gridname) + call endrun(errormsg) + else + call cam_grids(gridind)%coord_lengths(dims) + end if + if (present(rank)) then + call cam_grids(gridind)%dim_names(dname1, dname2) + if (trim(dname1) == trim(dname2)) then + rank = 1 + else + rank = 2 + end if + end if + + end subroutine cam_grid_dimensions_name + + !--------------------------------------------------------------------------- + ! + ! cam_grid_set_map: Set a grid's distribution map + ! This maps the local grid elements to global file order + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_set_map(this, map, src, dest) + use spmd_utils, only: mpi_sum, mpi_integer, mpicom + ! Dummy arguments + class(cam_grid_t) :: this + integer(iMap), pointer :: map(:,:) + integer, intent(in) :: src(2) ! decomp info + integer, intent(in) :: dest(2) ! Standard dim(s) in file + + ! Local variables + integer :: dims(2) + integer :: dstrt, dend + integer :: gridlen, gridloc, ierr + + ! Check to make sure the map meets our needs + call this%coord_lengths(dims) + dend = size(map, 1) + ! We always have to have one source and one destination + if (dest(2) > 0) then + dstrt = dend - 1 + else + dstrt = dend + end if + if ((src(2) /= 0) .and. (dstrt < 3)) then + call endrun('cam_grid_set_map: src & dest too large for map') + else if (dstrt < 2) then + call endrun('cam_grid_set_map: dest too large for map') + ! No else needed + end if + if (dstrt == dend) then + gridloc = count(map(dend,:) /= 0) + else + gridloc = count((map(dstrt,:) /= 0) .and. (map(dend,:) /= 0)) + end if + call MPI_Allreduce(gridloc, gridlen, 1, MPI_INTEGER, MPI_SUM, mpicom, ierr) + if (gridlen /= product(dims)) then + call endrun('cam_grid_set_map: Bad map size for '//trim(this%name)) + else + if (.not. associated(this%map)) then + allocate(this%map) + end if + call this%map%init(map, this%unstructured, src, dest) + end if + end subroutine cam_grid_set_map + + !--------------------------------------------------------------------------- + ! + ! cam_grid_local_size: return the local size of a 2D array on this grid + ! + !--------------------------------------------------------------------------- + integer function cam_grid_local_size(this) + + ! Dummy argument + class(cam_grid_t) :: this + + ! Local variable + character(len=128) :: errormsg + + if (.not. associated(this%map)) then + write(errormsg, *) 'Grid, '//trim(this%name)//', has no map' + call endrun('cam_grid_local_size: '//trim(errormsg)) + else + cam_grid_local_size = this%map%num_elem() + end if + + end function cam_grid_local_size + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_lon_lat: Find the latitude and longitude for a given + ! grid map index. Note if point is not mapped + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_lon_lat(this, index, lon, lat, isMapped) + + ! Dummy arguments + class(cam_grid_t) :: this + integer, intent(in) :: index + real(r8), intent(out) :: lon + real(r8), intent(out) :: lat + logical, intent(out) :: isMapped + + ! Local variables + integer :: latindex, lonindex + character(len=*), parameter :: subname = "cam_grid_get_lon_lat" + + if (this%block_indexed) then + lonindex = index + latindex = index + isMapped = this%map%is_mapped(index) + else + call this%map%coord_vals(index, lonindex, latindex, isMapped) + end if + + !!XXgoldyXX: May be able to relax all the checks + if ( (latindex < LBOUND(this%lat_coord%values, 1)) .or. & + (latindex > UBOUND(this%lat_coord%values, 1))) then + call endrun(trim(subname)//": index out of range for latvals") + else + lat = this%lat_coord%values(latindex) + end if + + if ( (lonindex < LBOUND(this%lon_coord%values, 1)) .or. & + (lonindex > UBOUND(this%lon_coord%values, 1))) then + call endrun(trim(subname)//": index out of range for lonvals") + else + lon = this%lon_coord%values(lonindex) + end if + + end subroutine cam_grid_get_lon_lat + + !--------------------------------------------------------------------------- + ! + ! cam_grid_find_src_dims: Find the correct src array dims for this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_find_src_dims(this, field_dnames, src_out) + ! Dummy arguments + class(cam_grid_t) :: this + character(len=*), intent(in) :: field_dnames(:) + integer, pointer :: src_out(:) + + ! Local variables + integer :: i, j + integer :: num_coords + character(len=max_hcoordname_len) :: coord_dimnames(2) + + call this%dim_names(coord_dimnames(1), coord_dimnames(2)) + if (associated(src_out)) then + deallocate(src_out) + nullify(src_out) + end if + if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then + num_coords = 1 + else + num_coords = 2 + end if + allocate(src_out(2)) ! Currently, all cases have two source dims + do i = 1, num_coords + do j = 1, size(field_dnames) + if (trim(field_dnames(j)) == trim(coord_dimnames(i))) then + src_out(i) = j + end if + end do + end do + if (num_coords < 2) then + src_out(2) = -1 ! Assume a block structure for unstructured grids + end if + + end subroutine cam_grid_find_src_dims + + !--------------------------------------------------------------------------- + ! + ! cam_grid_find_dest_dims: Find the correct file array dims for this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_find_dest_dims(this, file_dnames, dest_out) + ! Dummy arguments + class(cam_grid_t) :: this + character(len=*), intent(in) :: file_dnames(:) + integer, pointer :: dest_out(:) + + ! Local variables + integer :: i, j + integer :: num_coords + character(len=max_hcoordname_len) :: coord_dimnames(2) + + call this%dim_names(coord_dimnames(1), coord_dimnames(2)) + if (associated(dest_out)) then + deallocate(dest_out) + nullify(dest_out) + end if + if (trim(coord_dimnames(1)) == trim(coord_dimnames(2))) then + num_coords = 1 + else + num_coords = 2 + end if + allocate(dest_out(num_coords)) + dest_out = 0 + do i = 1, num_coords + do j = 1, size(file_dnames) + if (trim(file_dnames(j)) == trim(coord_dimnames(i))) then + dest_out(i) = j + end if + end do + end do + + end subroutine cam_grid_find_dest_dims + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_pio_decomp: Find or create a PIO decomp on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_pio_decomp(this, field_lens, file_lens, dtype, & + iodesc, field_dnames, file_dnames) + use pio, only: io_desc_t + use cam_pio_utils, only: cam_pio_get_decomp, calc_permutation + + ! Dummy arguments + class(cam_grid_t) :: this + integer, intent(in) :: field_lens(:) + integer, intent(in) :: file_lens(:) + integer, intent(in) :: dtype + type(io_desc_t), pointer, intent(out) :: iodesc + character(len=*), optional, intent(in) :: field_dnames(:) + character(len=*), optional, intent(in) :: file_dnames(:) + + ! Local variables + integer, pointer :: src_in(:) + integer, pointer :: dest_in(:) + integer, allocatable :: permutation(:) + logical :: is_perm + character(len=128) :: errormsg + + nullify(src_in) + nullify(dest_in) + is_perm = .false. + if (.not. associated(this%map)) then + write(errormsg, *) 'Grid, '//trim(this%name)//', has no map' + call endrun('cam_grid_get_pio_decomp: '//trim(errormsg)) + else + if (present(field_dnames)) then + call this%find_src_dims(field_dnames, src_in) + end if + if (present(file_dnames)) then + call this%find_dest_dims(file_dnames, dest_in) + end if + if (present(file_dnames) .and. present(field_dnames)) then + ! This only works if the arrays are the same size + if (size(file_dnames) == size(field_dnames)) then + allocate(permutation(size(file_dnames))) + call calc_permutation(file_dnames, field_dnames, permutation, is_perm) + end if + end if + ! Call cam_pio_get_decomp with the appropriate options + if (present(field_dnames) .and. present(file_dnames)) then + if (is_perm) then + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, & + this%map, field_dist_in=src_in, file_dist_in=dest_in, & + permute=permutation) + else + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, & + this%map, field_dist_in=src_in, file_dist_in=dest_in) + end if + else if (present(field_dnames)) then + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, & + this%map, field_dist_in=src_in) + else if (present(file_dnames)) then + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, & + this%map, file_dist_in=dest_in) + else + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%map) + end if + end if + if (associated(src_in)) then + deallocate(src_in) + nullify(src_in) + end if + if (associated(dest_in)) then + deallocate(dest_in) + nullify(dest_in) + end if + if (allocated(permutation)) then + deallocate(permutation) + end if + + end subroutine cam_grid_get_pio_decomp + + !------------------------------------------------------------------------------- + ! + ! cam_grid_find_dimids: Find the dimension NetCDF IDs on for this grid + ! + !------------------------------------------------------------------------------- + subroutine cam_grid_find_dimids(this, File, dimids) + use pio, only: file_desc_t, pio_noerr, pio_inq_dimid + use pio, only: pio_seterrorhandling, pio_bcast_error + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(out) :: dimids(:) + + ! Local vaariables + integer :: dsize, ierr + integer :: err_handling + character(len=max_hcoordname_len) :: dimname1, dimname2 + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + call this%dim_names(dimname1, dimname2) + if (size(dimids) < 1) then + call endrun('CAM_GRID_FIND_DIMIDS: dimids must have positive size') + end if + dimids = -1 + ! Check the first dimension + ierr = pio_inq_dimid(File, trim(dimname1), dimids(1)) + if(ierr /= PIO_NOERR) then + call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname1)//', does not exist on file') + end if + if (trim(dimname1) /= trim(dimname2)) then + ! Structured grid, find second dimid + if (size(dimids) < 2) then + call endrun('CAM_GRID_FIND_DIMIDS: dimids too small for '//trim(this%name)) + end if + ierr = pio_inq_dimid(File, trim(dimname2), dimids(2)) + if(ierr /= PIO_NOERR) then + call endrun('CAM_GRID_FIND_DIMIDS: '//trim(this%name)//' dimension, '//trim(dimname2)//', does not exist on file') + end if + end if + + ! Back to whatever error handling was running before this routine + call pio_seterrorhandling(File, err_handling) + + end subroutine cam_grid_find_dimids + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_2d_int: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_2d_int(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_int: Error reading variable') + end subroutine cam_grid_read_darray_2d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_3d_int: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_3d_int(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray, PIO_INT + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_int: Error reading variable') + end subroutine cam_grid_read_darray_3d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_2d_double: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_2d_double(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray + use pio, only: PIO_DOUBLE + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_double: Error reading variable') + end subroutine cam_grid_read_darray_2d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_3d_double: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_3d_double(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray + use pio, only: PIO_DOUBLE + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_3d_double: Error reading variable') + end subroutine cam_grid_read_darray_3d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_2d_real: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_2d_real(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray + use pio, only: PIO_REAL + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(out) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_real: Error reading variable') + end subroutine cam_grid_read_darray_2d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_read_darray_3d_real: Read a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_read_darray_3d_real(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t, pio_read_darray + use pio, only: PIO_REAL + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(out) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map) + call pio_read_darray(File, varid, iodesc, hbuf, ierr) + call cam_pio_handle_error(ierr, 'cam_grid_read_darray_2d_: Error reading variable') + end subroutine cam_grid_read_darray_3d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_2d_int: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_2d_int(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_INT + + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=int(grid_fill_value)) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_int: Error writing variable') + end subroutine cam_grid_write_darray_2d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_3d_int: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_3d_int(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_INT + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + integer, intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_INT, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=int(grid_fill_value)) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_int: Error writing variable') + end subroutine cam_grid_write_darray_3d_int + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_2d_double: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_2d_double(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_DOUBLE + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=grid_fill_value) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_double: Error writing variable') + end subroutine cam_grid_write_darray_2d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_3d_double: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_3d_double(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_DOUBLE + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r8), intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_DOUBLE, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=grid_fill_value) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_double: Error writing variable') + + end subroutine cam_grid_write_darray_3d_double + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_2d_real: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_2d_real(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_REAL + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(in) :: hbuf(:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=real(grid_fill_value)) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_2d_real: Error writing variable') + end subroutine cam_grid_write_darray_2d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_write_darray_3d_real: Write a variable defined on this grid + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_write_darray_3d_real(this, File, adims, fdims, hbuf, varid) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_REAL + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + integer, intent(in) :: adims(:) + integer, intent(in) :: fdims(:) + real(r4), intent(in) :: hbuf(:,:,:) + type(var_desc_t), intent(inout) :: varid + + ! Local variables + type(io_desc_t), pointer :: iodesc + integer :: ierr + + nullify(iodesc) + call cam_pio_get_decomp(iodesc, adims, fdims, PIO_REAL, this%map) + call pio_write_darray(File, varid, iodesc, hbuf, ierr, fillval=real(grid_fill_value)) + call cam_pio_handle_error(ierr, 'cam_grid_write_darray_3d_real: Error writing variable') + end subroutine cam_grid_write_darray_3d_real + + !--------------------------------------------------------------------------- + ! + ! cam_grid_get_patch_mask: Compute a map which is defined for locations + ! within the input patch. + ! + !--------------------------------------------------------------------------- + subroutine cam_grid_get_patch_mask(this, lonl, lonu, latl, latu, patch, cco) + use spmd_utils, only: mpi_min, mpi_max, mpi_real8, mpicom + use physconst, only: pi + + ! Dummy arguments + class(cam_grid_t) :: this + real(r8), intent(in) :: lonl, lonu ! Longitude bounds + real(r8), intent(in) :: latl, latu ! Latitude bounds + type(cam_grid_patch_t), intent(inout) :: patch + logical, intent(in) :: cco ! Collect columns? + + ! Local arguments + real(r8) :: mindist, minlondist + real(r8) :: dist, temp1, temp2 ! Test distance calc + real(r8) :: londeg, latdeg + real(r8) :: lon, lat + real(r8) :: londeg_min, latdeg_min + real(r8) :: lonmin, lonmax, latmin, latmax + integer :: minind ! Location of closest point + integer :: mapind ! Grid map index + integer :: latind, lonind + integer :: ierr ! For MPI calls + integer :: dims(2) ! Global dim sizes + integer :: gridloc ! local size of grid + logical :: unstructured ! grid type + logical :: findClosest ! .false. == patch output + logical :: isMapped ! .true. iff point in map + + real(r8), parameter :: maxangle = pi / 4.0_r8 + real(r8), parameter :: deg2rad = pi / 180.0_r8 + real(r8), parameter :: maxtol = 0.99999_r8 ! max cos value + real(r8), parameter :: maxlat = pi * maxtol / 2.0_r8 + character(len=*), parameter :: subname = 'cam_grid_get_patch_mask' + + if (.not. associated(this%map)) then + call endrun('cam_grid_get_patch_mask: Grid, '//trim(this%name)//', has no map') + end if + gridloc = this%map%num_elem() + unstructured = this%is_unstructured() + call this%coord_lengths(dims) + if (associated(patch%mask)) then + if (patch%mask%num_elem() /= gridloc) then + ! The mask needs to be the same size as the map + call endrun(subname//': mask is incorrect size') + ! No else, just needed a check + ! In particular, we are not zeroing the mask since multiple calls with + ! the same mask can be used for collected-column output + ! NB: Compacting the mask must be done after all calls (for a + ! particular mask) to this function. + end if + if (patch%collected_columns .neqv. cco) then + call endrun(subname//': collected_column mismatch') + end if + else + if (associated(patch%latmap)) then + call endrun(subname//': unallocated patch has latmap') + end if + if (associated(patch%lonmap)) then + call endrun(subname//': unallocated patch has lonmap') + end if + call patch%set_patch(lonl, lonu, latl, latu, cco, this%id, this%map) + if (patch%mask%num_elem() /= gridloc) then + ! Basic check to make sure the copy worked + call endrun(subname//': grid map is invalid') + end if + call patch%mask%clear() + ! Set up the lat/lon maps + if (cco) then + ! For collected column output, we need to collect coordinates and values + allocate(patch%latmap(patch%mask%num_elem())) + patch%latmap = 0 + allocate(patch%latvals(patch%mask%num_elem())) + patch%latvals = 91.0_r8 + allocate(patch%lonmap(patch%mask%num_elem())) + patch%lonmap = 0 + allocate(patch%lonvals(patch%mask%num_elem())) + patch%lonvals = 361.0_r8 + else + if (associated(this%lat_coord%values)) then + allocate(patch%latmap(LBOUND(this%lat_coord%values, 1):UBOUND(this%lat_coord%values, 1))) + patch%latmap = 0 + else + nullify(patch%latmap) + end if + if (associated(this%lon_coord%values)) then + allocate(patch%lonmap(LBOUND(this%lon_coord%values, 1):UBOUND(this%lon_coord%values, 1))) + patch%lonmap = 0 + else + nullify(patch%lonmap) + end if + end if + end if + + ! We have to iterate through each grid point to check + ! We have four cases, structured vs. unstructured grid * + ! patch area vs. closest column + ! Note that a 1-d patch 'area' is not allowed for unstructured grids + findClosest = .false. + ! Make sure our search items are in order + lonmin = min(lonl, lonu) + lonmax = max(lonl, lonu) + latmin = min(latl, latu) + latmax = max(latl, latu) + if (lonl == lonu) then + if (latl == latu) then + findClosest = .true. + else if (unstructured) then + call endrun(subname//': 1-D patch (lon) not allowed for unstructured grids') + else + ! Find closest lon line to lonu + ! This is a lat lon grid so it should have coordinate axes + lonmin = 365.0_r8 + mindist = 365.0_r8 + if (associated(this%lon_coord%values)) then + do lonind = LBOUND(this%lon_coord%values, 1), UBOUND(this%lon_coord%values, 1) + dist = abs(this%lon_coord%values(lonind) - lonu) + if (dist < mindist) then + lonmin = this%lon_coord%values(lonind) + mindist = dist + end if + end do + end if + ! Get the global minimum + dist = mindist + call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr) + if (dist == mindist) then + ! We have a ringer so use only that longitude + lonmax = lonmin + else + ! We don't have a minimum dist so count no points + lonmax = lonmin - 1.0_r8 + end if + end if + else if (latl == latu) then + if (unstructured) then + call endrun(subname//': 1-D patch (lat) not allowed for unstructured grids') + else + ! Find closest lat line to latu + ! This is a lat lon grid so it should have coordinate axes + latmin = 91.0_r8 + mindist = 181.0_r8 + if (associated(this%lat_coord%values)) then + do latind = LBOUND(this%lat_coord%values, 1), UBOUND(this%lat_coord%values, 1) + dist = abs(this%lat_coord%values(latind) - latl) + if (dist < mindist) then + latmin = this%lat_coord%values(latind) + mindist = dist + end if + end do + end if + ! Get the global minimum + dist = mindist + call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr) + if (dist == mindist) then + ! We have a ringer so use only that latitude + latmax = latmin + else + ! We don't have a minimum dist so count no points + latmax = latmin - 1.0_r8 + end if + end if + end if + + ! Convert to radians + lonmin = lonmin * deg2rad + lonmax = lonmax * deg2rad + latmin = latmin * deg2rad + latmax = latmax * deg2rad + ! Loop through all the local grid elements and find the closest match + ! (or all matches depending on the value of findClosest) + minind = -1 + londeg_min = 361.0_r8 + latdeg_min = 91.0_r8 + mindist = 2.0_r8 * pi + + do mapind = 1, patch%mask%num_elem() + call this%get_lon_lat(mapind, londeg, latdeg, isMapped) + if (isMapped) then + lon = londeg * deg2rad + lat = latdeg * deg2rad + if (findClosest) then + ! Use the Spherical Law of Cosines to find the great-circle distance. + ! Might as well use the unit sphere since we just want differences + if ( (abs(lat - latmin) <= maxangle) .and. & + (abs(lon - lonmin) <= maxangle)) then + ! maxangle could be pi but why waste all those trig functions? + ! XXgoldyXX: What should we use for maxangle given coarse Eul grids? + if ((lat == latmin) .and. (lon == lonmin)) then + dist = 0.0_r8 + else + temp1 = (sin(latmin) * sin(lat)) + & + (cos(latmin) * cos(lat) * cos(lon - lonmin)) + if (temp1 > maxtol) then + ! Use haversine formula + temp1 = sin(latmin - lat) + temp2 = sin((lonmin - lon) / 2.0_r8) + dist = 2.0_r8 * asin((temp1*temp1) + (cos(latmin)*cos(lat)*temp2*temp2)) + else + dist = acos(temp1) + end if + end if + if ( (dist < mindist) .or. & + ((dist == mindist) .and. & + (abs(lon - lonmin) < abs(londeg_min*deg2rad - lonmin)))) then + minind = mapind + mindist = dist + londeg_min = londeg + latdeg_min = latdeg + end if + end if + else + if ( (latmin <= lat) .and. (lat <= latmax) .and. & + (lonmin <= lon) .and. (lon <= lonmax)) then + if (patch%mask%num_elem() >= mapind) then + if (.not. patch%mask%is_mapped(mapind)) then + call patch%mask%copy_elem(this%map, mapind) + patch%num_points = patch%num_points + 1 + if (cco) then + if (patch%num_points > size(patch%latvals, 1)) then + call endrun(subname//': Number of cols larger than mask!?') + end if + call this%map%coord_dests(mapind, lonind, latind) + if (latind > 0) then + ! Grid is structured, get unique index + lonind = lonind + (latind * dims(1)) + end if + patch%latmap(patch%num_points) = lonind + patch%latvals(patch%num_points) = latdeg + patch%lonmap(patch%num_points) = lonind + patch%lonvals(patch%num_points) = londeg + else if ((this%block_indexed) .or. unstructured) then + call this%map%coord_dests(mapind, lonind, latind) + if (latind == 0) then + latind = lonind + end if + if (associated(patch%latmap)) then + patch%latmap(mapind) = latind + end if + if (associated(patch%lonmap)) then + patch%lonmap(mapind) = lonind + end if + else + call this%map%coord_vals(mapind, lonind, latind) + if (associated(patch%latmap)) then + patch%latmap(latind) = latind + end if + if (associated(patch%lonmap)) then + patch%lonmap(lonind) = lonind + end if + end if + ! else do nothing, we already found this point + end if + else + call endrun(subname//': PE has patch points but mask too small') + end if + end if + end if ! findClosest + end if ! isMapped + end do + if (findClosest) then + ! We need to find the minimum mindist and use only that value + dist = mindist + call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, ierr) + ! Special case for pole points + if (latdeg_min > 90.0_r8) then + temp1 = 0.0_r8 + else + temp1 = abs(latdeg_min*deg2rad) + end if + call MPI_allreduce(temp1, lat, 1, mpi_real8, mpi_max, mpicom, ierr) + if ((abs(latmin) > maxlat) .or. (lat > maxlat)) then + if (dist == mindist) then + ! Only distance winners can compete + lon = abs(londeg_min - lonl) + else + lon = 361.0_r8 + end if + call MPI_allreduce(lon, minlondist, 1, mpi_real8, mpi_min, mpicom, ierr) + ! Kill the losers + if (lon /= minlondist) then + dist = dist + 1.0_r8 + end if + end if + ! Now, only task(s) which have real minimum distance should set their mask + ! minind test allows for no match + if (dist == mindist) then + if (minind < 0) then + call endrun("cam_grid_get_patch_mask: No closest point found!!") + else + if (patch%mask%num_elem() >= minind) then + if (.not. patch%mask%is_mapped(minind)) then + call patch%mask%copy_elem(this%map, minind) + patch%num_points = patch%num_points + 1 + if (cco) then + if (patch%num_points > size(patch%latvals, 1)) then + call endrun(subname//': Number of columns larger than mask!?') + end if + call this%map%coord_dests(minind, lonind, latind) + if (latind > 0) then + ! Grid is structured, get unique index + lonind = lonind + (latind * dims(1)) + end if + patch%latmap(patch%num_points) = lonind + patch%latvals(patch%num_points) = latdeg_min + patch%lonmap(patch%num_points) = lonind + patch%lonvals(patch%num_points) = londeg_min + else if ((this%block_indexed) .or. unstructured) then + call this%map%coord_dests(minind, lonind, latind) + if (latind == 0) then + latind = lonind + end if + if (associated(patch%latmap)) then + patch%latmap(minind) = latind + end if + if (associated(patch%lonmap)) then + patch%lonmap(minind) = lonind + end if + else + call this%map%coord_vals(minind, lonind, latind) + if (associated(patch%latmap)) then + patch%latmap(latind) = latind + end if + if (associated(patch%lonmap)) then + patch%lonmap(lonind) = lonind + end if + end if + ! else do nothing, we already found this point + end if + else + call endrun(subname//': PE has patch closest point but mask too small') + end if + end if + end if + end if ! findClosest + + end subroutine cam_grid_get_patch_mask + + !--------------------------------------------------------------------------- + ! + ! Grid Patch functions + ! + !--------------------------------------------------------------------------- + + integer function cam_grid_patch_get_id(this) result(id) + + ! Dummy argument + class(cam_grid_patch_t) :: this + + id = this%grid_id + end function cam_grid_patch_get_id + + subroutine cam_grid_patch_get_global_size_map(this, gsize) + + ! Dummy arguments + class(cam_grid_patch_t), intent(in) :: this + integer, intent(out) :: gsize + + gsize = this%global_size + + end subroutine cam_grid_patch_get_global_size_map + + subroutine cam_grid_patch_get_global_size_axes(this, latsize, lonsize) + + ! Dummy arguments + class(cam_grid_patch_t), intent(in) :: this + integer, intent(out) :: latsize + integer, intent(out) :: lonsize + + latsize = this%global_lat_size + lonsize = this%global_lon_size + + end subroutine cam_grid_patch_get_global_size_axes + + ! cam_grid_patch_get_axis_names + ! Collect or compute unique names for the latitude and longitude axes + ! If the grid is unstructured or col_output is .true., the column + ! dimension name is also generated (e.g., ncol) + subroutine cam_grid_patch_get_axis_names(this, lat_name, lon_name, & + col_name, col_output) + + ! Dummy arguments + class(cam_grid_patch_t) :: this + character(len=*), intent(out) :: lat_name + character(len=*), intent(out) :: lon_name + character(len=*), intent(out) :: col_name + logical, intent(in) :: col_output + + ! Local variable + integer :: index + character(len=120) :: errormsg + character(len=max_hcoordname_len) :: grid_name + logical :: unstruct + + if (cam_grid_check(this%grid_id)) then + index = this%grid_index() + unstruct = cam_grids(index)%is_unstructured() + ! Get coordinate and dim names + call cam_grids(index)%lat_coord%get_coord_name(lat_name) + call cam_grids(index)%lon_coord%get_coord_name(lon_name) + grid_name = cam_grids(index)%name + if (col_output .or. unstruct) then + ! In this case, we are using collect_column_output on a lat/lon grid + col_name = 'ncol_'//trim(grid_name) + lat_name = trim(lat_name)//'_'//trim(grid_name) + lon_name = trim(lon_name)//'_'//trim(grid_name) + else + ! Separate patch output for a lat/lon grid + col_name = '' + lat_name = trim(lat_name)//'_'//trim(grid_name) + lon_name = trim(lon_name)//'_'//trim(grid_name) + end if + else + write(errormsg, *) 'Bad grid ID:', this%grid_id + call endrun('cam_grid_patch_get_axis_names: '//errormsg) + end if + + end subroutine cam_grid_patch_get_axis_names + + subroutine cam_grid_patch_get_coord_long_name(this, axis, name) + + ! Dummy arguments + class(cam_grid_patch_t) :: this + character(len=*), intent(in) :: axis + character(len=*), intent(out) :: name + + ! Local variable + character(len=120) :: errormsg + integer :: index + + if (cam_grid_check(this%grid_id)) then + index = this%grid_index() + if (trim(axis) == 'lat') then + call cam_grids(index)%lat_coord%get_long_name(name) + else if (trim(axis) == 'lon') then + call cam_grids(index)%lon_coord%get_long_name(name) + else + write(errormsg, *) 'Bad axis name:', axis + call endrun('cam_grid_patch_get_coord_long_name: '//errormsg) + end if + else + write(errormsg, *) 'Bad grid ID:', this%grid_id + call endrun('cam_grid_patch_get_coord_long_name: '//errormsg) + end if + + end subroutine cam_grid_patch_get_coord_long_name + + subroutine cam_grid_patch_get_coord_units(this, axis, units) + + ! Dummy arguments + class(cam_grid_patch_t) :: this + character(len=*), intent(in) :: axis + character(len=*), intent(out) :: units + + ! Local variable + character(len=120) :: errormsg + integer :: index + + if (cam_grid_check(this%grid_id)) then + index = this%grid_index() + if (trim(axis) == 'lat') then + call cam_grids(index)%lat_coord%get_units(units) + else if (trim(axis) == 'lon') then + call cam_grids(index)%lon_coord%get_units(units) + else + write(errormsg, *) 'Bad axis name:', axis + call endrun('cam_grid_patch_get_coord_units: '//errormsg) + end if + else + write(errormsg, *) 'Bad grid ID:', this%grid_id + call endrun('cam_grid_patch_get_coord_units: '//errormsg) + end if + + end subroutine cam_grid_patch_get_coord_units + + subroutine cam_grid_patch_set_patch(this, lonl, lonu, latl, latu, cco, id, map) + + ! Dummy arguments + class(cam_grid_patch_t) :: this + real(r8), intent(in) :: lonl, lonu ! Longitude bounds + real(r8), intent(in) :: latl, latu ! Latitude bounds + logical, intent(in) :: cco ! Collect columns? + integer, intent(in) :: id + type(cam_filemap_t), intent(in) :: map + + this%grid_id = id + this%lon_range(1) = lonl + this%lon_range(2) = lonu + this%lat_range(1) = latl + this%lat_range(2) = latu + this%collected_columns = cco + if (.not. associated(this%mask)) then + allocate(this%mask) + end if + call this%mask%copy(map) + call this%mask%new_index() + + end subroutine cam_grid_patch_set_patch + + subroutine cam_grid_patch_get_decomp(this, field_lens, file_lens, dtype, & + iodesc, file_dest_in) + use pio, only: io_desc_t + use cam_pio_utils, only: cam_pio_get_decomp + + ! Dummy arguments + class(cam_grid_patch_t) :: this + integer, intent(in) :: field_lens(:) + integer, intent(in) :: file_lens(:) + integer, intent(in) :: dtype + type(io_desc_t), pointer, intent(out) :: iodesc + integer, optional, intent(in) :: file_dest_in(:) + + call cam_pio_get_decomp(iodesc, field_lens, file_lens, dtype, this%mask, & + file_dist_in=file_dest_in) + + end subroutine cam_grid_patch_get_decomp + + subroutine cam_grid_patch_compact(this, collected_output) + use spmd_utils, only: mpi_sum, mpi_integer, mpicom + use shr_mpi_mod, only: shr_mpi_chkerr + + ! Dummy arguments + class(cam_grid_patch_t) :: this + logical, optional, intent(in) :: collected_output + + ! Local variables + integer :: index ! Our grid's index + logical :: dups_ok + + index = this%grid_index() + if (index > 0) then + dups_ok = cam_grids(index)%is_unstructured() + else + ! This is probably an error condition but someone else will catch it first + dups_ok = .false. + end if + if (present(collected_output)) then + dups_ok = dups_ok .or. collected_output + end if + call this%mask%compact(this%lonmap, this%latmap, & + num_lons=this%global_lon_size, num_lats=this%global_lat_size, & + num_mapped=this%global_size, columnize=collected_output, & + dups_ok_in=dups_ok) + + end subroutine cam_grid_patch_compact + + subroutine cam_grid_patch_get_active_cols(this, lchnk, active, srcdim_in) + + ! Dummy arguments + class(cam_grid_patch_t) :: this + integer, intent(in) :: lchnk + logical, intent(out) :: active(:) + integer, optional, intent(in) :: srcdim_in + + if (.not. associated(this%mask)) then + call endrun('cam_grid_patch_get_active_cols: No mask') + else + call this%mask%active_cols(lchnk, active, srcdim_in) + end if + + end subroutine cam_grid_patch_get_active_cols + + ! cam_grid_patch_write_vals: Write lat and lon coord values to File + subroutine cam_grid_patch_write_vals(this, File, header_info) + use pio, only: file_desc_t, io_desc_t + use pio, only: pio_write_darray, PIO_DOUBLE + use pio, only: pio_initdecomp, pio_freedecomp + use cam_pio_utils, only: cam_pio_handle_error, pio_subsystem + + ! Dummy arguments + class(cam_grid_patch_t) :: this + type(file_desc_t), intent(inout) :: File ! PIO file handle + type(cam_grid_header_info_t), intent(inout) :: header_info + + ! Local variables + type(io_desc_t) :: iodesc + type(var_desc_t), pointer :: vdesc + real(r8), pointer :: coord_p(:) + real(r8), pointer :: coord(:) + integer(iMap), pointer :: map(:) + integer :: field_lens(1) + integer :: file_lens(1) + integer :: ierr + + nullify(vdesc) + nullify(coord_p) + nullify(coord) + nullify(map) + if (this%grid_id /= header_info%get_gridid()) then + call endrun('CAM_GRID_PATCH_WRITE_VALS: Grid id mismatch') + end if + ! Write out lon + if (associated(this%lonmap)) then + field_lens(1) = size(this%lonmap, 1) + map => this%lonmap + else + field_lens(1) = 0 + allocate(map(0)) + end if + file_lens(1) = this%global_lon_size + !! XXgoldyXX: Think about caching these decomps + call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc) + if (associated(this%lonvals)) then + coord => this%lonvals + else + coord_p => cam_grid_get_lonvals(this%grid_id) + if (associated(coord_p)) then + coord => coord_p + else + allocate(coord(0)) + end if + end if + vdesc => header_info%get_lon_varid() + call pio_write_darray(File, vdesc, iodesc, coord, ierr, fillval=grid_fill_value) + call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing longitude') + if (.not. associated(this%lonmap)) then + deallocate(map) + nullify(map) + end if + if (.not. (associated(coord_p) .or. associated(this%lonvals))) then + deallocate(coord) + nullify(coord) + end if + ! Write out lat + if (associated(this%latmap)) then + field_lens(1) = size(this%latmap, 1) + map => this%latmap + else + field_lens(1) = 0 + allocate(map(0)) + end if + file_lens(1) = this%global_lat_size + !! XXgoldyXX: Think about caching these decomps + call pio_initdecomp(pio_subsystem, pio_double, file_lens, map, iodesc) + + if (associated(this%latvals)) then + coord => this%latvals + else + coord_p => cam_grid_get_latvals(this%grid_id) + if (associated(coord_p)) then + coord => coord_p + else + allocate(coord(0)) + end if + end if + vdesc => header_info%get_lat_varid() + call pio_write_darray(File, vdesc, iodesc, coord, ierr, fillval=grid_fill_value) + call cam_pio_handle_error(ierr, 'cam_grid_patch_write_vals: Error writing latitude') + if (.not. associated(this%latmap)) then + deallocate(map) + nullify(map) + end if + if (.not. (associated(coord_p) .or. associated(this%latvals))) then + deallocate(coord) + nullify(coord) + end if + call pio_freedecomp(File, iodesc) + + end subroutine cam_grid_patch_write_vals + + integer function cam_grid_patch_get_grid_index(this) result(index) + ! Dummy argument + class(cam_grid_patch_t) :: this + + ! Local variable + integer :: i + + index = -1 + ! Find the grid index associated with our grid_id which is a decomp + do i = 1, cam_grid_num_grids() + if (cam_grids(i)%id == this%grid_id) then + index = i + exit + end if + end do + + end function cam_grid_patch_get_grid_index + + subroutine cam_grid_patch_deallocate(this) + ! Dummy argument + class(cam_grid_patch_t) :: this + + if (associated(this%mask)) then + deallocate(this%mask) + nullify(this%mask) + end if + + end subroutine cam_grid_patch_deallocate + + integer function cam_grid_header_info_get_gridid(this) result(id) + ! Dummy argument + class(cam_grid_header_info_t) :: this + + id = this%grid_id + + end function cam_grid_header_info_get_gridid + + subroutine cam_grid_header_info_set_gridid(this, id) + ! Dummy argument + class(cam_grid_header_info_t) :: this + integer, intent(in) :: id + + this%grid_id = id + + end subroutine cam_grid_header_info_set_gridid + + subroutine cam_grid_header_info_set_hdims(this, hdim1, hdim2) + ! Dummy arguments + class(cam_grid_header_info_t) :: this + integer, intent(in) :: hdim1 + integer, optional, intent(in) :: hdim2 + + ! Local variables + integer :: hdsize + + if (present(hdim2)) then + hdsize = 2 + else + hdsize = 1 + end if + + if (allocated(this%hdims)) then + ! This can happen, for instance on opening a new version of the file + if (size(this%hdims) /= hdsize) then + call endrun('cam_grid_header_info_set_hdims: hdims is wrong size') + end if + else + allocate(this%hdims(hdsize)) + end if + this%hdims(1) = hdim1 + if (present(hdim2)) then + this%hdims(2) = hdim2 + end if + + end subroutine cam_grid_header_info_set_hdims + + integer function cam_grid_header_info_num_hdims(this) result(num) + ! Dummy argument + class(cam_grid_header_info_t) :: this + + if (allocated(this%hdims)) then + num = size(this%hdims) + else + num = 0 + end if + + end function cam_grid_header_info_num_hdims + + integer function cam_grid_header_info_hdim(this, index) result(id) + ! Dummy arguments + class(cam_grid_header_info_t) :: this + integer, intent(in) :: index + + ! Local variable + character(len=120) :: errormsg + + if (allocated(this%hdims)) then + if ((index >= 1) .and. (index <= size(this%hdims))) then + id = this%hdims(index) + else + write(errormsg, '(a,i0,a)') 'Index out of range, (',index,')' + call endrun('cam_grid_header_info_hdim: '//errormsg) + end if + else + write(errormsg, '(a)') 'No hdims allocated' + call endrun('cam_grid_header_info_hdim: '//errormsg) + end if + + end function cam_grid_header_info_hdim + + subroutine cam_grid_header_info_set_varids(this, lon_varid, lat_varid) + + ! Dummy arguments + class(cam_grid_header_info_t) :: this + type(var_desc_t), pointer :: lon_varid + type(var_desc_t), pointer :: lat_varid + + if (associated(this%lon_varid)) then + deallocate(this%lon_varid) + nullify(this%lon_varid) + end if + this%lon_varid => lon_varid + if (associated(this%lat_varid)) then + deallocate(this%lat_varid) + nullify(this%lat_varid) + end if + this%lat_varid => lat_varid + + end subroutine cam_grid_header_info_set_varids + + function cam_grid_header_info_lon_varid(this) result(id) + + ! Dummy arguments + class(cam_grid_header_info_t) :: this + type(var_desc_t), pointer :: id + + id => this%lon_varid + + end function cam_grid_header_info_lon_varid + + function cam_grid_header_info_lat_varid(this) result(id) + + ! Dummy arguments + class(cam_grid_header_info_t) :: this + type(var_desc_t), pointer :: id + + id => this%lat_varid + + end function cam_grid_header_info_lat_varid + + subroutine cam_grid_header_info_deallocate(this) + ! Dummy argument + class(cam_grid_header_info_t) :: this + + this%grid_id = -1 + if (allocated(this%hdims)) then + deallocate(this%hdims) + end if + if (associated(this%lon_varid)) then + deallocate(this%lon_varid) + nullify(this%lon_varid) + end if + if (associated(this%lat_varid)) then + deallocate(this%lat_varid) + nullify(this%lat_varid) + end if + + end subroutine cam_grid_header_info_deallocate + +end module cam_grid_support diff --git a/src/utils/cam_map_utils.F90 b/src/utils/cam_map_utils.F90 new file mode 100644 index 0000000000..591fa9ff6c --- /dev/null +++ b/src/utils/cam_map_utils.F90 @@ -0,0 +1,1217 @@ +module cam_map_utils + use pio, only: iMap=>PIO_OFFSET_KIND + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +!!XXgoldyXX: v +use spmd_utils, only: npes, iam, mpicom, masterproc +use shr_sys_mod, only: shr_sys_flush +!!XXgoldyXX: ^ + + implicit none + private + + public iMap + +!!XXgoldyXX: v +logical, public, save :: goldy_debug = .false. +!!XXgoldyXX: ^ + integer, private, save :: unique_map_index = 0 + integer, private, parameter :: max_srcs = 2 + integer, private, parameter :: max_dests = 2 + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_t: Information for a CAM map (between data array and + ! NetCDF file) + ! + ! The map targets one or two dimensions of the NetCDF file. + ! The 2-D map is useful for blocks of data (2 dimensions of array which + ! map to one or two dimensions in the NetCDF file). For a 1-1 mapping, + ! the first dimension is of size 3 (instead of 4). + ! map(1, i) = index value of first src (e.g., lon, ncol) + ! map(2, i) = index value of second src (e.g., lat, chunk) + ! map(3, i) = global offset of first dest (e.g., lon, ncol) + ! map(4, i) = global offset of second dest (e.g., lat, NA) + ! src is the array dimension position corresponding to the map dimension + ! in normal (not permuted) arrays. + ! A negative pos denotes counting backwards from the last array dimension + ! dest entries are the NetCDF dimension positions (must be increasing) + ! It is an error to have src(1) == src(2). + ! + !--------------------------------------------------------------------------- + type, public :: cam_filemap_t + private + integer :: index = 0 + integer(iMap), pointer :: map(:,:) => NULL() + integer :: src(max_srcs) = 0 + integer :: dest(max_dests) = 0 + integer(iMap) :: limits(max_srcs,2) = -1 + integer :: nmapped = -1 + integer, pointer :: blcksz(:) => NULL() !e.g.,ncol(lchnk) + contains + procedure :: init => cam_filemap_init + procedure :: get_index => cam_filemap_getIndex + procedure :: new_index => cam_filemap_newIndex + procedure :: clear => cam_filemap_clear + procedure :: copy => cam_filemap_copy + procedure :: copy_elem => cam_filemap_copyElem + procedure :: num_elem => cam_filemap_size + procedure :: is_mapped => cam_filemap_isMapped + procedure :: num_mapped => cam_filemap_numMapped + procedure :: map_val => cam_filemap_mapVal + procedure :: coord_vals => cam_filemap_coordVals + procedure :: coord_dests => cam_filemap_coordDests + procedure :: get_filemap => cam_filemap_get_filemap + procedure :: has_blocksize => cam_filemap_has_blocksize + procedure :: blocksize => cam_filemap_get_blocksize + procedure :: array_bounds => cam_filemap_get_array_bounds + procedure :: active_cols => cam_filemap_get_active_cols + procedure :: columnize => cam_filemap_columnize + procedure :: compact => cam_filemap_compact +!!XXgoldyXX: Cleanup when working +! procedure :: init_latlon => cam_filemap_init_latlon +! procedure :: init_unstruct => cam_filemap_init_unstruct +! generic, public :: init => init_latlon, init_unstruct + end type cam_filemap_t + + !--------------------------------------------------------------------------- + ! + ! END: types BEGIN: private interfaces + ! + !--------------------------------------------------------------------------- + +contains + +!!####################################################################### +!! +!! index sorting routines: +!! XXgoldyXX: Move to generic location? +!! +!!####################################################################### + + subroutine index_sort_vector(data, indices, compressval, dups_ok_in) + use spmd_utils, only: mpi_integer, mpi_integer8, iam, mpicom, npes + use shr_mpi_mod, only: shr_mpi_chkerr + use cam_abortutils, only: endrun + use m_MergeSorts, only: IndexSet, IndexSort + + ! Dummy arguments + integer(iMap), pointer, intent(in) :: data(:) + integer, pointer, intent(inout) :: indices(:) + integer(iMap), optional, intent(in) :: compressval + logical, optional, intent(in) :: dups_ok_in + + ! Local variables + integer :: num_elem ! # mapped elements + integer :: num_active ! # mapped pes + integer :: ierr + integer :: i + integer :: lb, ub + integer :: mycnt, my_first_elem + integer :: mpi_group_world + integer :: mpi_sort_group + integer :: mpi_sort_comm + integer :: my_sort_rank + integer, allocatable :: sort_pes(:) + integer, allocatable :: displs(:) + integer, allocatable :: recvcounts(:) + integer(iMap), allocatable :: elements(:) + integer(iMap), allocatable :: local_elem(:) + integer, allocatable :: ind(:) + integer, allocatable :: temp(:) + logical :: dups_ok ! .true. iff duplicates OK + character(len=*), parameter :: subname = 'INDEX_SORT_VECTOR' + + ! Allow duplicate values? + if (present(dups_ok_in)) then + dups_ok = dups_ok_in + if ((.not. dups_ok) .and. (.not. present(compressval))) then + call endrun(trim(subname)//': dups_ok=.false. requires a compressval') + end if + else + dups_ok = .true. + end if + + ! The patch mapped values are in the number space of the master grid. + ! They need to be compressed to go from 1 to the number of elements in the + ! patch. + ! Figure out the mapped elements in my portion of the patch mask + if (.not. associated(data)) then + mycnt = 0 + allocate(local_elem(mycnt)) + allocate(ind(mycnt)) + num_elem = 0 + lb = 0 + ub = -1 + else if (present(compressval)) then + mycnt = COUNT(data /= compressval) + allocate(local_elem(mycnt)) + allocate(ind(mycnt)) + num_elem = 0 + lb = LBOUND(data, 1) + ub = UBOUND(data, 1) + do i = lb, ub + if (data(i) /= compressval) then + num_elem = num_elem + 1 + local_elem(num_elem) = data(i) + ind(num_elem) = i + end if + end do + else + lb = LBOUND(data, 1) + ub = UBOUND(data, 1) + mycnt = size(data) + allocate(local_elem(mycnt)) + local_elem(1:mycnt) = data(lb:ub) + num_elem = mycnt + end if + + ! Find the tasks which have elements in this patch + ! temp used for # elements per PE + allocate(temp(0:npes-1)) + call MPI_allgather(mycnt, 1, MPI_integer, temp, 1, MPI_integer, & + mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allgather elements') + num_active = COUNT(temp > 0) + if (num_active > 1) then + allocate(sort_pes(num_active)) + allocate(recvcounts(num_active)) + allocate(displs(num_active)) + num_elem = 0 + displs(1) = 0 + ! Find the number of mapped elements and number of pes in this patch + my_sort_rank = -1 + do i = 0, npes - 1 + if (temp(i) > 0) then + num_elem = num_elem + 1 + if (num_elem > num_active) then + call endrun(subname//": overrun of sort_pes array") + end if + sort_pes(num_elem) = i + if (iam == i) then + my_sort_rank = num_elem - 1 + my_first_elem = displs(num_elem) + 1 + end if + recvcounts(num_elem) = temp(i) + if (num_elem < num_active) then + displs(num_elem + 1) = displs(num_elem) + recvcounts(num_elem) + end if + end if + end do + if (num_elem < num_active) then + call endrun(subname//": underrun of sort_pes array") + end if + if (my_sort_rank >= 0) then + num_elem = SUM(temp) ! Total number of elements to sort + else + num_elem = 0 + end if + deallocate(temp) ! Cleanup + ! Make a group with the active PEs + call MPI_comm_group(mpicom, mpi_group_world, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_comm_group mpi_group_world') + call MPI_group_incl(mpi_group_world, num_active, sort_pes, & + mpi_sort_group, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_group_incl sort_pes') + ! Make a new communicator with the active PEs + call MPI_comm_create(mpicom, mpi_sort_group, mpi_sort_comm, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_comm_create mpi_sort_comm') + ! Collect all the elements for sorting (only active tasks now) + allocate(elements(num_elem)) + if (mycnt > 0) then + call MPI_allgatherv(local_elem, mycnt, MPI_integer8, & + elements, recvcounts, displs, MPI_integer8, mpi_sort_comm, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allgatherv') + ! Clean up for active PEs only + call MPI_comm_free(mpi_sort_comm, ierr) + end if + ! General clean up + call MPI_group_free(mpi_sort_group, ierr) + deallocate(recvcounts) + deallocate(displs) + else if (mycnt > 0) then + ! We are the only PE with patch info + num_elem = mycnt + allocate(elements(size(local_elem))) + elements = local_elem + my_first_elem = 1 + end if + ! At this point, num_elem should always be the local # of items to sort + if (num_elem > 0) then + ! Sanity check + if (size(elements) < num_elem) then + call endrun(trim(subname)//": size(elements) must be >= num_elem") + end if + !! Do the sort, recvcounts will be the temporary index array + allocate(recvcounts(size(elements))) + allocate(displs(size(recvcounts))) + call IndexSet(num_elem, recvcounts) + call IndexSort(num_elem, recvcounts, elements, descend=.false.) + ! Compress recvcounts (repeat data values) + displs = 0 + do i = 1, num_elem - 1 + if (elements(recvcounts(i)) == elements(recvcounts(i + 1))) then + displs(i + 1) = displs(i) + 1 + else + displs(i + 1) = displs(i) + end if + end do + ! Unload recvcounts into indices. Assume indices is initialized w/ default + do i = 1, num_elem + if ( (recvcounts(i) >= my_first_elem) .and. & + (recvcounts(i) < (my_first_elem + mycnt))) then + if (.not. dups_ok) then + ! Use our indirect access to set the correct indices location + ! ind array already has lb offset included + ! Eliminate duplicate values + if ((i > 1) .and. (displs(i) > displs(MAX((i - 1),1)))) then + indices(ind(recvcounts(i) - my_first_elem + 1)) = compressval + else + indices(ind(recvcounts(i) - my_first_elem + 1)) = i - displs(i) + end if + else if (allocated(ind)) then + indices(ind(recvcounts(i) - my_first_elem + 1)) = i - displs(i) + else + ! recvcounts points directly at a local location + ! NB: repeat data values all get same index + indices(recvcounts(i) - my_first_elem + lb) = i - displs(i) + end if + end if + end do + deallocate(recvcounts) + deallocate(displs) + end if + + if (allocated(ind)) then + deallocate(ind) + end if + if (allocated(elements)) then + deallocate(elements) + end if + deallocate(local_elem) + + end subroutine index_sort_vector + +!!####################################################################### +!! +!! CAM grid mapping functions +!! +!!####################################################################### + + integer function cam_filemap_getIndex(this) + ! Dummy variable + class(cam_filemap_t) :: this + + cam_filemap_getIndex = this%index + + end function cam_filemap_getIndex + + subroutine cam_filemap_newIndex(this) + ! Dummy variable + class(cam_filemap_t) :: this + + unique_map_index = unique_map_index + 1 + this%index = unique_map_index + + end subroutine cam_filemap_newIndex + + subroutine cam_filemap_init(this, pemap, unstruct, src, dest) + ! Dummy arguments + class(cam_filemap_t) :: this + integer(iMap), pointer :: pemap(:,:) ! Map elem for this PE + logical, intent(in) :: unstruct + integer, intent(in) :: src(:) + integer, optional, intent(in) :: dest(:) + + ! Local variables + integer :: i ! Loop index + integer :: index + + ! This shouldn't happen but maybe we will decide to reuse these + if (associated(this%map)) then + deallocate(this%map) + nullify(this%map) + end if + + ! Check in case these ever change (because algorithm then must be modified) + if ((max_srcs /= 2) .or. (max_dests /= 2)) then + call endrun('cam_filemap_init: max_src or max_dest modified') + end if + + ! Some items are simply copied + if (associated(pemap)) then + this%map => pemap + else + nullify(this%map) + end if + this%src = src + if (present(dest)) then + ! Structred grids will likely always have dest = (1, 2) but maybe . . . + this%dest = dest + else if (unstruct) then + ! Unstructured grids are (so far) always spread along the first dimension + this%dest(1) = 1 + this%dest(2) = 0 + else + this%dest(1) = 1 + this%dest(2) = 2 + end if + ! We may have holes in the 'block' decomposition which is specified by + ! having src(2) < 0. + ! NB: This is currently a special purpose hack in that it is purely + ! convention that the last dimension specifies the block index and + ! that those blocks may not be filled. + ! The proper way to generalize this functionality is to allow + ! src(1) to also be < 0 and to look for holes there as well + if (associated(this%map)) then + do i = 1, max_srcs + if (ANY(this%map(i,:) > 0)) then + ! Min of all src(i) values + this%limits(i, 1) = MINVAL(this%map(i,:), mask=(this%map(i,:)>0)) + ! Max of all src(i) values + this%limits(i, 2) = MAXVAL(this%map(i,:), mask=(this%map(i,:)>0)) + else + this%limits(i,1) = 0 + this%limits(i,2) = -1 + end if + end do + + this%nmapped = 0 + do index = 1, this%num_elem() + if ((this%dest(1) > 0) .and. (this%map(max_srcs+1, index) > 0)) then + if (this%dest(2) > 0) then + ! Can't do this test unless we know the dim 2 is large enough + if (this%map(max_srcs+2, index) > 0) then + this%nmapped = this%nmapped + 1 + end if + else + this%nmapped = this%nmapped + 1 + end if + end if + end do + else + this%limits(:,1) = 0 + this%limits(:,2) = -1 + this%nmapped = 0 + end if + if (src(max_srcs) < 0) then + ! This shouldn't happen but maybe we will decide to reuse these + if (associated(this%blcksz)) then + deallocate(this%blcksz) + nullify(this%blcksz) + end if + allocate(this%blcksz(this%limits(max_srcs,1):this%limits(max_srcs,2))) + this%blcksz = 0 + do i = 1, this%num_elem() + index = this%map(max_srcs, i) + if (this%is_mapped(i)) then + this%blcksz(index) = this%blcksz(index) + 1 + end if + end do + end if + + call this%new_index() + + end subroutine cam_filemap_init + + subroutine cam_filemap_clear(this) + ! Dummy arguments + class(cam_filemap_t) :: this + + if (associated(this%map)) then + this%map = 0 + end if + this%limits(:,1) = 0 + this%limits(:,2) = -1 + this%nmapped = 0 + + ! Update the index in case a decomp was made with the old values + call this%new_index() + + end subroutine cam_filemap_clear + + subroutine cam_filemap_copy(this, map) + ! Dummy arguments + class(cam_filemap_t) :: this + type(cam_filemap_t), intent(in) :: map + + ! This shouldn't happen but maybe we will decide to reuse these + if (associated(this%map)) then + deallocate(this%map) + nullify(this%map) + end if + + if (associated(map%map)) then + allocate(this%map(size(map%map, 1), size(map%map, 2))) + if (map%num_elem() > 0) then + this%map = map%map + end if + else + nullify(this%map) + end if + this%src = map%src + this%dest = map%dest + this%limits = map%limits + this%nmapped = map%nmapped + + ! This shouldn't happen but maybe we will decide to reuse these + if (associated(this%blcksz)) then + deallocate(this%blcksz) + nullify(this%blcksz) + end if + if (associated(map%blcksz)) then + allocate(this%blcksz(size(map%blcksz))) + this%blcksz = map%blcksz + end if + + ! Even a copy has to have a unique index + call this%new_index() + + end subroutine cam_filemap_copy + + subroutine cam_filemap_copyElem(this, map, index) + ! Dummy arguments + class(cam_filemap_t) :: this + type(cam_filemap_t), intent(in) :: map + integer, intent(in) :: index + + if (this%is_mapped(index)) then + this%nmapped = this%nmapped - 1 + end if + this%map(:, index) = map%map(:, index) + if (this%is_mapped(index)) then + this%nmapped = this%nmapped + 1 + end if + + end subroutine cam_filemap_copyElem + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_size: Total number of elements in the map + ! + !--------------------------------------------------------------------------- + integer function cam_filemap_size(this) + ! Dummy variable + class(cam_filemap_t) :: this + + if (associated(this%map)) then + cam_filemap_size = size(this%map,2) + else + cam_filemap_size = 0 + end if + end function cam_filemap_size + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_isMapped: Return .true. iff the index value is mapped + ! + !--------------------------------------------------------------------------- + elemental logical function cam_filemap_isMapped(this, index) + ! Dummy arguments + class(cam_filemap_t), intent(in) :: this + integer, intent(in) :: index + + if (associated(this%map)) then + cam_filemap_isMapped = (this%map(3, index) > 0) + if ((size(this%map, 1) > 3) .and. cam_filemap_isMapped) then + cam_filemap_isMapped = (this%map(4, index) > 0) + ! No else needed + end if + else + cam_filemap_isMapped = .false. + end if + + end function cam_filemap_isMapped + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_numMapped: Number of elements in the map with non-zero entries + ! + !--------------------------------------------------------------------------- + integer function cam_filemap_numMapped(this) + ! Dummy variable + class(cam_filemap_t) :: this + + if (associated(this%map)) then + cam_filemap_numMapped = this%nmapped + else + cam_filemap_numMapped = 0 + end if + end function cam_filemap_numMapped + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_mapVal: Calculate an offset value from a map + ! + !--------------------------------------------------------------------------- + integer(iMap) function cam_filemap_mapVal(this, index, dsize, dest_in) + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: index + integer(iMap), intent(in) :: dsize(:) + integer, optional, intent(in) :: dest_in(:) + + ! Local variables + integer :: d(max_dests) + + if (associated(this%map)) then + if (present(dest_in)) then + d = dest_in + else + d = this%dest + end if + if (this%map(3, index) > 0) then + cam_filemap_mapVal = ((this%map(3, index) - 1) * dsize(d(1))) + 1 + if (size(this%map, 1) > 3) then + if (this%map(4, index) > 0) then + cam_filemap_mapVal = ((this%map(4, index) - 1) * dsize(d(2))) + & + cam_filemap_mapVal ! No +1 because it is offset from map(3,:) + else + cam_filemap_mapVal = 0 + end if + ! No else needed + end if + else + cam_filemap_mapVal = 0 + end if + else + cam_filemap_mapVal = 0 + end if + end function cam_filemap_mapVal + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_coordVals: Find coord indices matching map index + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_coordVals(this, index, lonIndex, latIndex, isMapped) + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: index + integer, intent(out) :: lonIndex + integer, intent(out) :: latIndex + logical, optional, intent(out) :: isMapped + + if (associated(this%map)) then + if (size(this%map,1) > (max_srcs + 1)) then + lonIndex = this%map(1, index) + latIndex = this%map(2, index) + else + lonIndex = index + latIndex = index + end if + if (present(isMapped)) then + isMapped = this%is_mapped(index) + end if + else if (present(isMapped)) then + lonIndex = 0 + latIndex = 0 + isMapped = .false. + else + call endrun("cam_filemap_coordVals: must have map or pass isMapped") + end if + end subroutine cam_filemap_coordVals + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_coordDests: Find coord indices matching map index + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_coordDests(this, index, lonIndex, latIndex, isMapped) + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: index + integer, intent(out) :: lonIndex + integer, intent(out) :: latIndex + logical, optional, intent(out) :: isMapped + + if (associated(this%map)) then + lonIndex = this%map(max_srcs + 1, index) + if (size(this%map,1) > (max_srcs + 1)) then + latIndex = this%map(max_srcs + 2, index) + else + latIndex = 0 + end if + if (present(isMapped)) then + isMapped = this%is_mapped(index) + end if + else if (present(isMapped)) then + lonIndex = 0 + latIndex = 0 + isMapped = .false. + else + call endrun("cam_filemap_coordDests: must have map or pass isMapped") + end if + end subroutine cam_filemap_coordDests + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_get_filemap: Create the mapping between an array and a file + ! This is the workhorse function for creating a PIO decomp DOF + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & + src_in, dest_in, permutation_in) + + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: fieldlens(:) + integer, intent(in) :: filelens(:) + integer(iMap), pointer :: filemap(:) + integer, optional, intent(in) :: src_in(:) + integer, optional, intent(in) :: dest_in(:) + integer, optional, intent(in) :: permutation_in(:) + + ! Local variables + integer :: srclens(7) ! field dim lens + integer :: srccnt ! Rank of fieldlens + integer(iMap), allocatable :: dsize(:) + integer :: mapind(max_srcs) ! Source index for map + integer, allocatable :: src_ind(:) ! Map src to file dims + integer :: fmind, j + integer(iMap) :: mapSize, mapPos, pos, fileSize + integer :: mapcnt ! Dimension count + integer :: locsize ! Total local # elements + integer :: tind, tlen ! Temporarys + integer :: i1, i2, i3, i4, i5, i6, i7 + integer :: i(7) + + ! This shouldn't happen but, who knows what evil lurks in the hearts of SEs + if (associated(filemap)) then + deallocate(filemap) + nullify(filemap) + end if + + ! + fileSize = product(filelens) + srccnt = size(fieldlens) + srclens(1:srccnt) = fieldlens(1:srccnt) + if (srccnt < 7) then + srclens(srccnt+1:7) = 1 + end if + + ! Allocate output filemap (dof) + allocate(filemap(product(fieldlens))) + filemap = 0 + + ! Find map source dimensions in input array + mapPos = 1 ! To compare against map size + mapind = 0 + if (present(src_in)) then + mapcnt = size(src_in) ! Just used until end of loop below + if (mapcnt > max_srcs) then + call endrun('cam_filemap_get_filemap: src_in too large') + end if + end if + do j = 1, max_srcs + if (present(src_in)) then + if (mapcnt >= j) then + if (src_in(j) < 0) then + mapind(j) = srccnt + src_in(j) + 1 + else + mapind(j) = src_in(j) + end if + end if + else + ! A src == 0 means that map dimension is not used + if (this%src(j) /= 0) then + ! src < 0 is count from last array dim + if (this%src(j) < 0) then + mapind(j) = srccnt + this%src(j) + 1 + else + mapind(j) = this%src(j) + end if + end if + end if + if (mapind(j) > 0) then + mapPos = mapPos * srclens(mapind(j)) ! To compare against map size + end if + end do + mapcnt = COUNT(mapind /= 0) + + ! Check that map matches dims + ! Since patch maps are compressed, we can't do an equal compare but + ! it is still an error if the map has more elements than the array + mapSize = this%num_elem() + if (mapPos < this%num_mapped()) then + call endrun('cam_filemap_get_filemap: Map size too large for array dims') + end if + + ! dsize is a global offset for each dimension + allocate(dsize(size(filelens))) + dsize(1) = 1 + do j = 1, size(filelens) - 1 + dsize(j + 1) = dsize(j) * filelens(j) + end do + + ! src_ind maps each source dimension to the corresponding file dimension + allocate(src_ind(srccnt)) + if (present(permutation_in)) then + if (size(permutation_in) /= size(src_ind)) then + call endrun('cam_filemap_get_filemap: permutation_in must have same rank as fieldlens') + end if + src_ind = permutation_in + else + src_ind = 0 + fmind = 1 ! Here fmind is first available permutation slot + do j = 1, srccnt + ! We need to find the offset location for each non-mapped src dimension + if (ANY(mapind == j)) then + continue + else + ! Find the next available output dimension + if (present(dest_in)) then + do while (ANY(dest_in == fmind)) + fmind = fmind + 1 + if (fmind > size(dsize)) then + call endrun('cam_filemap_get_filemap: permutation calculation dest_in error') + end if + end do + else + do while (ANY(this%dest == fmind)) + fmind = fmind + 1 + if (fmind > size(dsize)) then + call endrun('cam_filemap_get_filemap: permutation calculation dest error') + end if + end do + end if + if (fmind > size(dsize)) then + call endrun('cam_filemap_get_filemap: permutation calculation error') + end if + src_ind(j) = fmind + fmind = fmind + 1 + end if + end do + end if + + ! Step through the map and fill in local positions for each entry + fmind = 1 + do i7 = 1, srclens(7) + i(7) = i7 + do i6 = 1, srclens(6) + i(6) = i6 + do i5 = 1, srclens(5) + i(5) = i5 + do i4 = 1, srclens(4) + i(4) = i4 + do i3 = 1, srclens(3) + i(3) = i3 + do i2 = 1, srclens(2) + i(2) = i2 + do i1 = 1, srclens(1) + i(1) = i1 + pos = 0 ! Offset from map pos so starts at zero + tind = 1 ! Offset into the map + tlen = 1 + do j = 1, srccnt + if (ANY(mapind == j)) then + ! j is a distributed field dimension index + tind = tind + ((i(j) - 1) * tlen) + tlen = tlen * srclens(j) + else + ! j is a local field dimension index + pos = pos + ((i(j) - 1) * dsize(src_ind(j))) + end if + end do + if (tind > mapSize) then + call endrun('cam_filemap_get_filemap: internal error, tind') + end if + mapPos = this%map_val(tind, dsize, dest_in) + if ((mapPos > 0) .and. ((pos + mapPos) > fileSize)) then + call endrun('cam_filemap_get_filemap: internal error, pos') + end if + if ((pos + mapPos) < 0) then + call endrun('cam_filemap_get_filemap: internal error, mpos') + end if + if (mapPos > 0) then + filemap(fmind) = pos + mapPos + else + ! This element is not mapped + filemap(fmind) = 0 + end if + fmind = fmind + 1 + end do + end do + end do + end do + end do + end do + end do + if ((fmind - 1) /= size(filemap)) then + call endrun('cam_filemap_get_filemap: internal error, fmind') + end if + deallocate(dsize) + end subroutine cam_filemap_get_filemap + + integer function cam_filemap_get_blocksize(this, block_id) + + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: block_id + + if (.not. this%has_blocksize()) then + call endrun('cam_filemap_get_blocksize: filemap has no blocks') + else if ((block_id < LBOUND(this%blcksz, 1)) .or. & + (block_id > UBOUND(this%blcksz, 1))) then + call endrun('cam_filemap_get_blocksize: block_id out of range') + else + cam_filemap_get_blocksize = this%blcksz(block_id) + end if + end function cam_filemap_get_blocksize + + logical function cam_filemap_has_blocksize(this, lbnd, ubnd) + + ! Dummy arguments + class(cam_filemap_t) :: this + integer, optional, intent(out) :: lbnd + integer, optional, intent(out) :: ubnd + + cam_filemap_has_blocksize = associated(this%blcksz) + if (present(lbnd)) then + lbnd = LBOUND(this%blcksz, 1) + end if + if (present(ubnd)) then + ubnd = UBOUND(this%blcksz, 1) + end if + + end function cam_filemap_has_blocksize + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_get_array_bounds: Sets grid bounds for the relevant array + ! Only modifies the dimensions corresponding to the map's src + ! dims should be sized (rank,2) with the second dimension used + ! to store lower(1) and upper(2) bounds + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_get_array_bounds(this, dims) + + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(inout) :: dims(:,:) + + ! Local variables + integer :: rank ! rank of target array + integer :: i ! Loop variable + + rank = size(dims,1) + if (size(dims,2) < 2) then + call endrun('cam_filemap_get_array_bounds: second dim of dims must be 2') + end if + + if (MAXVAL(this%limits(1:max_srcs, 1:2)) > HUGE(kind(dims))) then + call endrun('cam_filemap_get_array_bounds: limits too large') + end if + do i = 1, max_srcs + if (this%src(i) > 0) then + if (this%src(i) > rank) then + call endrun('cam_filemap_get_array_bounds: rank too small') + else +!!XXgoldyXX: Maybe modify definition of this%limits? +! dims(i, 1:2) = INT(this%limits(i, 1:2), kind=kind(dims)) + if (associated(this%map)) then + if (size(this%map) > 0) then + dims(i, 1) = MINVAL(this%map(i,:)) + dims(i, 2) = MAXVAL(this%map(i,:)) + else + dims(i, 1) = 0 + dims(i, 2) = -1 + end if + else + dims(i, 1) = 0 + dims(i, 2) = -1 + end if + end if + else if (this%src(i) < 0) then +!!XXgoldyXX: Maybe modify definition of this%limits? +! dims(rank + this%src(i) + 1, 1:2) = INT(this%limits(i, 1:2), kind=kind(dims)) + if (associated(this%map)) then + if (size(this%map) > 0) then + dims(rank + this%src(i) + 1, 1) = MINVAL(this%map(i,:)) + dims(rank + this%src(i) + 1, 2) = MAXVAL(this%map(i,:)) + else + dims(rank + this%src(i) + 1, 1) = 0 + dims(rank + this%src(i) + 1, 2) = -1 + end if + else + dims(rank + this%src(i) + 1, 1) = 0 + dims(rank + this%src(i) + 1, 2) = -1 + end if + ! No else (zero means unused position) + end if + end do + end subroutine cam_filemap_get_array_bounds + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_get_active_cols: Find which columns are active in a dimension + ! Because we normally decompose columns (blocks or chunks) in the + ! last dimension, we default to that dimension + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_get_active_cols(this, colnum, active, srcdim_in) + + ! Dummy arguments + class(cam_filemap_t) :: this + integer, intent(in) :: colnum + logical, intent(out) :: active(:) + integer, optional, intent(in) :: srcdim_in + + ! Local variables + integer :: srcdim + + if (present(srcdim_in)) then + srcdim = srcdim_in + else + srcdim = max_srcs + end if + + ! Sanity checks + if ((srcdim < 1) .or. (srcdim > max_srcs)) then + call endrun('cam_filemap_get_active_cols: srcdim out of range') + else if (this%src(srcdim) >= 0) then + call endrun('cam_filemap_get_active_cols: Invalid srcdim') + else if (size(active) < size(this%map, (3 - srcdim))) then + call endrun('cam_filemap_get_active_cols: active too small') + else if (colnum < LBOUND(this%map, srcdim)) then + call endrun('cam_filemap_get_active_cols: colnum too small') + else if (colnum > UBOUND(this%map, srcdim)) then + call endrun('cam_filemap_get_active_cols: colnum too large') + ! else OK + end if + + active = .false. +!!XXgoldyXX: This is probably completely wrong. What we want is column info + select case(srcdim) + case (1) + active(1:size(this%map, 2)) = (this%map(colnum,:) > 0) + case (2) + active(1:size(this%map, 1)) = (this%map(:,colnum) > 0) + case default + call endrun('cam_filemap_get_active_cols: Invalid srcdim?!?') + end select + end subroutine cam_filemap_get_active_cols + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_columnize: Convert lon/lat map to ncol + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_columnize(this) + use spmd_utils, only: mpi_sum, mpi_integer, mpicom + use shr_mpi_mod, only: shr_mpi_chkerr + + ! Dummy argument + class(cam_filemap_t) :: this + + ! Local variables + integer :: i, j + integer :: lmax(2) + integer :: maxind(2) + integer :: offset(2) + integer :: ierr + integer(iMap), pointer :: newmap(:,:) => NULL() + character(len=*), parameter :: subname = 'CAM_FILEMAP_COLUMNIZE' + ! Create a new map with same size and ordering + ! We need the max lon/lat for calculating global offsets + lmax = 0 + if (associated(this%map)) then + if (size(this%map, 1) == max_srcs) then + call endrun(trim(subname)//': must have at least 1 destination coord') + else if (size(this%map, 1) > (max_srcs + 2)) then + call endrun(trim(subname)//': has more than 2 destination coords') + end if + if (size(this%map, 2) > 0) then + lmax(1) = MAXVAL(this%map(max_srcs + 1, :)) + if (size(this%map, 1) == (max_srcs + 2)) then + lmax(2) = MAXVAL(this%map(max_srcs + 2, :)) + end if + end if + end if + call MPI_allreduce(lmax(1), maxind(1), 1, MPI_integer, mpi_sum, mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allreduce maxlon') + call MPI_allreduce(lmax(2), maxind(2), 1, MPI_integer, mpi_sum, mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allreduce maxlat') + if (associated(this%map)) then + if (size(this%map, 1) == (max_srcs + 2))then + ! Create the new map + allocate(newmap(max_srcs + 1, size(this%map, 2))) + ! Who's on first? + if (ANY(this%dest(1:2) <= 0)) then + call endrun(trim(subname)//': can only handle positive dest indices') + else if (this%dest(1) < this%dest(2)) then + offset(1) = 1 + offset(2) = maxind(1) + else if (this%dest(1) > this%dest(2)) then + offset(1) = maxind(2) + offset(2) = 1 + else + call endrun(trim(subname)//': dest indices cannot be equal') + end if + do i = 1, size(newmap, 2) + newmap(1:max_srcs, i) = this%map(1:max_srcs, i) + j = ((this%map(max_srcs+1, i) * offset(1)) + & + (this%map(max_srcs+2, i) * offset(2))) + newmap(max_srcs+1, i) = j + end do + ! Replace our map with the new one + deallocate(this%map) + this%map => newmap + nullify(newmap) + ! Fixup dest + this%dest(1) = 1 + this%dest(2:) = 0 + ! no else (do nothing if already ncol) + end if ! End if lon/lat map + end if + + end subroutine cam_filemap_columnize + + !--------------------------------------------------------------------------- + ! + ! cam_filemap_compact: Pack all active elements into a 1-based file order + ! Also pack latitude and longitude maps + ! + !--------------------------------------------------------------------------- + subroutine cam_filemap_compact(this, lonmap, latmap, & + num_lons, num_lats, num_mapped, columnize, dups_ok_in) + use spmd_utils, only: mpi_sum, mpi_integer, mpicom + use shr_mpi_mod, only: shr_mpi_chkerr + + ! Dummy arguments + class(cam_filemap_t) :: this + integer(iMap), pointer :: lonmap(:) + integer(iMap), pointer :: latmap(:) + integer, optional, intent(out) :: num_lons + integer, optional, intent(out) :: num_lats + integer, optional, intent(out) :: num_mapped + logical, optional, intent(in) :: columnize ! Convert to ncol + logical, optional, intent(in) :: dups_ok_in ! Dup coords OK + + ! Local variables + integer :: i, j + integer :: ierr + integer(iMap), pointer :: data(:) => NULL() + integer, pointer :: indices(:) => NULL() + integer :: tmp_size + logical :: dok + character(len=*), parameter :: subname = 'CAM_FILEMAP_COMPACT' + + !! Possibly convert lon/lat map to ncol + if (present(columnize)) then + if (columnize) then + call this%columnize() + end if + end if + !! Are duplicate coordinate indices (lat/lon) OK? + if (present(dups_ok_in)) then + dok = dups_ok_in + else + dok = .false. + end if + ! Get a global index sort of mapped elements. + do i = 1, max_dests + if (this%dest(i) > 0) then + if (associated(this%map)) then + if (size(this%map, 1) >= max_srcs + i) then + data => this%map(max_srcs + i, :) + else + nullify(data) + end if + else + nullify(data) + end if + ! Allocate indices if necessary + if (associated(indices)) then + deallocate(indices) + nullify(indices) + end if + if (associated(data)) then + allocate(indices(LBOUND(data, 1):UBOUND(data, 1))) + indices = 0 + else + allocate(indices(0)) + end if + end if + call index_sort_vector(data, indices, compressval=0_iMap) + if (associated(data) .and. associated(indices)) then + data = indices + end if + end do + if (associated(indices)) then + deallocate(indices) + nullify(indices) + end if + ! Get a global index sort of lat and lon maps + !! Compress latmap + if (associated(latmap)) then + ! Allocate indices + allocate(indices(LBOUND(latmap, 1):UBOUND(latmap, 1))) + indices = 0 + end if + call index_sort_vector(latmap, indices, compressval=0_iMap, dups_ok_in=dok) + if (associated(latmap)) then + latmap = indices + deallocate(indices) + nullify(indices) + end if + !! Compress lonmap + if (associated(lonmap)) then + allocate(indices(LBOUND(lonmap, 1):UBOUND(lonmap, 1))) + indices = 0 + end if + call index_sort_vector(lonmap, indices, compressval=0_iMap, dups_ok_in=dok) + if (associated(lonmap)) then + lonmap = indices + deallocate(indices) + nullify(indices) + end if + + if (present(num_mapped)) then + if (this%num_elem() > 0) then + ! Total number of mapped elements + allocate(indices(this%num_elem())) + indices = [ (i, i = 1, size(indices)) ] + tmp_size = COUNT(this%is_mapped(indices)) + deallocate(indices) + nullify(indices) + else + tmp_size = 0 + end if + call MPI_allreduce(tmp_size, num_mapped, 1, MPI_integer, & + mpi_sum, mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allreduce num_mapped') + if (num_mapped <= 0) then + call endrun(trim(subname)//': num_mapped <= 0') + end if + end if + if (present(num_lons)) then + if (associated(lonmap)) then + tmp_size = COUNT(lonmap /= 0) + else + tmp_size = 0 + end if + call MPI_allreduce(tmp_size, num_lons, 1, MPI_integer, & + mpi_sum, mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allreduce num_lons') + if (num_lons <= 0) then + call endrun(trim(subname)//': numlons <= 0') + end if + end if + if (present(num_lats)) then + if (associated(latmap)) then + tmp_size = COUNT(latmap /= 0) + else + tmp_size = 0 + end if + call MPI_allreduce(tmp_size, num_lats, 1, MPI_integer, & + mpi_sum, mpicom, ierr) + call shr_mpi_chkerr(ierr, subname//': MPI_allreduce num_lats') + if (num_lats <= 0) then + call endrun(trim(subname)//': numlats <= 0') + end if + end if + + end subroutine cam_filemap_compact + +end module cam_map_utils diff --git a/src/utils/cam_pio_utils.F90 b/src/utils/cam_pio_utils.F90 new file mode 100644 index 0000000000..859572c6f8 --- /dev/null +++ b/src/utils/cam_pio_utils.F90 @@ -0,0 +1,1692 @@ +! Utility functions in support of PIO io interface +module cam_pio_utils + + use pio, only: io_desc_t, iosystem_desc_t, file_desc_t, var_desc_t + use pio, only: pio_freedecomp, pio_rearr_subset, pio_rearr_box + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_logfile, only: iulog + use perf_mod, only: t_startf, t_stopf + use spmd_utils, only: masterproc + + implicit none + private + save + + public :: cam_pio_createfile ! Create a new NetCDF file for PIO writing + public :: cam_pio_openfile ! Open an existing NetCDF file + public :: cam_pio_closefile ! Close an open PIO file handle + public :: cam_pio_fileexists ! Check if file exists + public :: cam_pio_newdecomp ! Create a new PIO decompsition (mapping) + public :: init_pio_subsystem ! called from cam_comp + public :: cam_pio_get_decomp ! Find an existing decomp or create a new one + public :: cam_pio_handle_error ! If error, print a custom error message + + public :: cam_permute_array + public :: calc_permutation + + ! Convenience interfaces + public :: cam_pio_def_dim + public :: cam_pio_def_var + public :: cam_pio_get_var + + ! General utility + public :: cam_pio_var_info + public :: cam_pio_find_var + public :: cam_pio_check_var + + public :: clean_iodesc_list + + ! For help debugging code + public :: cam_pio_dump_field + + integer :: pio_iotype + integer :: pio_rearranger + + ! This variable should be private ? + type(iosystem_desc_t), pointer, public :: pio_subsystem => null() + + ! Some private string length parameters + integer, parameter :: errormsg_str_len = 128 + + ! The iodesc_list allows us to cache existing PIO decompositions + ! The tag needs the dim lengths, the dtype and map id (+ optional permutation) + integer, parameter :: tag_len = 48 + type iodesc_list + character(tag_len) :: tag + type(io_desc_t), pointer :: iodesc => NULL() + type(iodesc_list), pointer :: next => NULL() + end type iodesc_list + + type(iodesc_list), target :: iodesc_list_top + + ! Create a special type to hold a var_desc_t pointer so we can have an + ! array of them + type, public :: vdesc_ptr + type(var_desc_t), pointer :: vd => NULL() + end type vdesc_ptr + + interface cam_pio_def_var + module procedure cam_pio_def_var_0d + module procedure cam_pio_def_var_md + end interface + + interface cam_pio_get_var + module procedure cam_pio_get_var_2d_r8 + module procedure cam_pio_get_var_2d_r8_perm + module procedure cam_pio_get_var_3d_r8 + module procedure cam_pio_get_var_3d_r8_perm + end interface + + interface calc_permutation + module procedure calc_permutation_int + module procedure calc_permutation_char + end interface + + interface cam_permute_array + module procedure permute_array_int + module procedure permute_array_r8 + end interface + + interface cam_pio_dump_field + module procedure dump_field_2d_d + module procedure dump_field_3d_d + module procedure dump_field_4d_d + module procedure dump_field_6d_d + end interface + +contains + + ! use_scam_limits is a private interface used to gather information about + ! single-column usage and limits for use by the cam_pio_get_var interfaces + ! This still only works for lat/lon dycores + logical function use_scam_limits(File, start, kount, dimnames) + use shr_scam_mod, only: shr_scam_getCloseLatLon + use scamMod, only: scmlat, scmlon, single_column + use cam_abortutils, only: endrun + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File + integer, intent(inout) :: start(:) + integer, intent(inout) :: kount(:) + character(len=*), optional, intent(in) :: dimnames(:) + + ! Local variables + character(len=*), parameter :: subname='USE_SCAM_LIMITS' + real(r8) :: closelat, closelon + integer :: latidx, lonidx + integer :: i + logical :: latfound + + use_scam_limits = single_column + if (use_scam_limits) then + call shr_scam_getCloseLatLon(File, scmlat, scmlon, closelat, closelon, & + latidx, lonidx) + if (present(dimnames)) then + if (trim(dimnames(1)) == 'lon') then + start(1) = lonidx ! First dim always lon for Eulerian dycore + ! This could be generalized -- for now, stick with single column + kount(1) = 1 + else + call endrun(trim(subname)//': lon should be first dimension') + end if + latfound = .false. + do i = 2, size(dimnames) + if (size(start) < i) then + call endrun(trim(subname)//': start too small') + end if + if (trim(dimnames(i)) == 'lat') then + start(i) = latidx + ! This could be generalized -- for now, stick with single column + kount(i) = 1 + latfound = .true. + end if + end do + if (.not. latfound) then + call endrun(trim(subname)//': lat dimension not found') + end if + else + ! No dimnames, assume standard positions (lon,lat) + start(1) = lonidx + start(2) = latidx + ! This could be generalized -- for now, stick with single column + kount(1:2) = 1 + end if + end if + + end function use_scam_limits + + ! calc_permutation: Calculate a permutation array if filedims and arraydims + ! are in a different order + ! E.g.: If filedims is (lon, lat, lev, time) and + ! arraydims is (lon, lev, lat), then + ! perm is (1, 3, 2) and isperm is set to .true. + subroutine calc_permutation_int(filedims, arraydims, perm, isperm) + use cam_abortutils, only: endrun + + ! Dummy variables + integer, intent(in) :: filedims(:) + integer, intent(in) :: arraydims(:) + integer, intent(out) :: perm(:) + logical, intent(out) :: isperm + + ! Local variables + character(len=*), parameter :: subname='CALC_PERMUTATION_INT' + integer :: i, j + integer :: adims, fdims + + perm = 0 + isperm = .false. + adims = size(arraydims) + fdims = size(filedims) + + if (size(perm) < adims) then + call endrun(trim(subname)//': perm smaller than arraydims') + end if + + if (fdims < adims) then + call endrun(trim(subname)//': filedims smaller than arraydims') + end if + + do i = 1, adims + if (arraydims(i) == filedims(i)) then + perm(i) = i + else + isperm = .true. + do j = 1, fdims + if (arraydims(i) == filedims(j)) then + perm(i) = j + exit + else if (j == fdims) then + call endrun(trim(subname)//': No match for array dimension') + ! No else, just try the next j index + end if + end do + end if + end do + + end subroutine calc_permutation_int + + subroutine calc_permutation_char(filedims, arraydims, perm, isperm) + use cam_abortutils, only: endrun + + ! Dummy variables + character(len=*), intent(in) :: filedims(:) + character(len=*), intent(in) :: arraydims(:) + integer, intent(out) :: perm(:) + logical, intent(out) :: isperm + + ! Local variables + character(len=*), parameter :: subname='CALC_PERMUTATION_CHAR' + integer :: i, j + integer :: adims, fdims + + perm = 0 + isperm = .false. + adims = size(arraydims) + fdims = size(filedims) + + if (size(perm) < adims) then + call endrun(trim(subname)//': perm smaller than arraydims') + end if + + if (fdims < adims) then + call endrun(trim(subname)//': filedims smaller than arraydims') + end if + + ILOOP : do i = 1, adims + if (trim(arraydims(i)) == trim(filedims(i))) then + perm(i) = i + else + isperm = .true. + do j = 1, fdims + if (trim(arraydims(i)) == trim(filedims(j))) then + perm(i) = j + exit + else if (j == fdims) then + ! We have no match but for character strings, just say no perm + isperm = .false. + exit ILOOP + ! No else, just try the next j index + end if + end do + end if + end do ILOOP + + end subroutine calc_permutation_char + + subroutine permute_array_int(array, perm) + + ! Dummy arguments + integer, intent(inout) :: array(:) + integer, intent(in) :: perm(:) + + ! Local variables + integer, allocatable :: temp(:) + integer :: nelem, i + + nelem = size(array) + allocate(temp(nelem)) + temp = array + do i = 1, nelem + array(i) = temp(perm(i)) + end do + + deallocate(temp) + end subroutine permute_array_int + + subroutine permute_array_r8(array, perm) + + ! Dummy arguments + real(r8), intent(inout) :: array(:) + integer, intent(in) :: perm(:) + + ! Local variables + real(r8), allocatable :: temp(:) + integer :: nelem, i + + nelem = size(array) + allocate(temp(nelem)) + temp = array + do i = 1, nelem + array(i) = temp(perm(i)) + end do + + deallocate(temp) + end subroutine permute_array_r8 + + subroutine cam_pio_handle_error(ierr, errorstr) + use cam_abortutils, only: endrun + use pio, only: pio_noerr + + ! Dummy arguments + integer, intent(in) :: ierr + character(len=*), intent(in) :: errorstr + + ! Local variables + character(len=256) :: errormsg + + if (ierr /= PIO_NOERR) then + write(errormsg, '(a,i6,2a)') '(PIO:', ierr, ') ', trim(errorstr) + call endrun(errormsg) + end if + + end subroutine cam_pio_handle_error + + !----------------------------------------------------------------------- + ! + ! cam_pio_var_info: Retrieve variable properties + ! + !----------------------------------------------------------------------- + subroutine cam_pio_var_info(ncid, varid, ndims, dimids, dimlens, dimnames, varname, unlimDimID) + use pio, only: PIO_inq_varndims, PIO_inq_vardimid, PIO_inq_dimlen + use pio, only: PIO_inquire, PIO_inq_dimname + use pio, only: PIO_seterrorhandling, PIO_BCAST_ERROR + use cam_abortutils, only: endrun + + + ! Dummy arguments + type(file_desc_t), intent(inout) :: ncid + type(var_desc_t), intent(in) :: varid + integer, intent(out) :: ndims + integer, intent(out) :: dimids(:) + integer, intent(out) :: dimlens(:) + character(len=*), optional, intent(out) :: dimnames(:) + integer, optional, intent(out) :: unlimDimID + character(len=*), optional, intent(in) :: varname + + ! Local variables + integer :: ret ! PIO return value + integer :: i + integer :: err_handling + character(len=128) :: errsuff + !----------------------------------------------------------------------- + ! We will handle errors for this routine + + call PIO_seterrorhandling(ncid, PIO_BCAST_ERROR, err_handling) + + dimids = -1 + ndims = 0 + dimlens = 0 + + if (present(varname)) then + errsuff = ' for '//trim(varname) + else + errsuff = '' + end if + ! Check dimensions + ret = PIO_inq_varndims(ncid, varid, ndims) + call cam_pio_handle_error(ret, 'CAM_PIO_VAR_INFO: Error with num dimensions') + if (size(dimids) < ndims) then + call endrun('CAM_PIO_VAR_INFO: dimids too small'//trim(errsuff)) + end if + ret = PIO_inq_vardimid(ncid, varid, dimids(1:ndims)) + call cam_pio_handle_error(ret, 'CAM_PIO_VAR_INFO: Error with inq dim ids'//trim(errsuff)) + if (size(dimlens) < ndims) then + call endrun('CAM_PIO_VAR_INFO: dimlens too small'//trim(errsuff)) + end if + do i = 1, ndims + ret = PIO_inq_dimlen(ncid, dimids(i), dimlens(i)) + call cam_pio_handle_error(ret, 'CAM_PIO_VAR_INFO: Error with inq dimlens') + if (present(dimnames)) then + ret = PIO_inq_dimname(ncid, dimids(i), dimnames(i)) + call cam_pio_handle_error(ret, 'CAM_PIO_VAR_INFO: Error with inq dimnames') + end if + end do + if (present(unlimDimID)) then + ret = PIO_inquire(ncid, unlimitedDimID=unlimDimID) + call cam_pio_handle_error(ret, 'CAM_PIO_VAR_INFO: Error with inquire') + end if + call PIO_seterrorhandling(ncid, err_handling) + + end subroutine cam_pio_var_info + + subroutine cam_pio_find_var(ncid, varname, varid, found) + use pio, only: pio_inq_varid, pio_noerr + use pio, only: PIO_seterrorhandling, PIO_BCAST_ERROR + + ! Dummy arguments + type(file_desc_t), intent(inout) :: ncid + character(len=*), intent(in) :: varname + type(var_desc_t), intent(out) :: varid + logical, intent(out) :: found + + ! Local variables + integer :: ret ! PIO return value + integer :: err_handling + + !----------------------------------------------------------------------- + ! We will handle errors for this routine + + call PIO_seterrorhandling(ncid, PIO_BCAST_ERROR, err_handling) + ret = PIO_inq_varid(ncid, trim(varname), varid) + found = (ret == PIO_NOERR) + call PIO_seterrorhandling(ncid, err_handling) + + end subroutine cam_pio_find_var + + + !----------------------------------------------------------------------- + ! + ! cam_pio_check_var: Make sure var exists and retrieve properties + ! + !----------------------------------------------------------------------- + subroutine cam_pio_check_var(ncid, varname, varid, ndims, dimids, dimlens, & + readvar, dimnames) + use pio, only: PIO_inq_varid, PIO_NOERR + use pio, only: PIO_seterrorhandling, PIO_BCAST_ERROR + use shr_sys_mod, only: shr_sys_flush ! Standardized system subroutines + + ! Dummy arguments + type(file_desc_t), intent(inout) :: ncid + character(len=*), intent(in) :: varname + type(var_desc_t), intent(out) :: varid + integer, intent(out) :: ndims + integer, intent(out) :: dimids(:) + integer, intent(out) :: dimlens(:) + logical, intent(out) :: readvar + character(len=*), optional, intent(out) :: dimnames(:) + + ! Local variables + integer :: ret ! PIO return value + integer :: err_handling + + !----------------------------------------------------------------------- + ! We will handle errors for this routine + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, err_handling) + + dimids = -1 + ndims = 0 + dimlens = 0 + ret = PIO_inq_varid(ncid, trim(varname), varid) + if (ret /= PIO_NOERR) then + readvar = .false. + if (masterproc) then + write(iulog,*)'CAM_PIO_CHECK_VAR INFO: variable ',trim(varname),' is not on file' + call shr_sys_flush(iulog) + end if + else + readvar = .true. + call cam_pio_var_info(ncid, varid, ndims, dimids, dimlens, & + dimnames=dimnames, varname=varname) + end if + call pio_seterrorhandling(ncid, err_handling) + + end subroutine cam_pio_check_var + + subroutine init_pio_subsystem() + use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype + use cam_instance, only: atm_id + + pio_subsystem => shr_pio_getiosys(atm_id) + pio_iotype = shr_pio_getiotype(atm_id) + + if (masterproc) then + write(iulog,*)' ' + write(iulog,*)'Initialize PIO subsystem:' + write(iulog,*)' iotype = ', pio_iotype + end if + + end subroutine init_pio_subsystem + + ! cam_pio_get_decomp: retrieve or create a PIO decomposition for the field + ! described by ldims and dtype where dims is the field's + ! local shape. + ! fdims is the shape of the field in a NetCDF file. + ! map describes the mapping of the distributed dimensions + ! field_dist_in is used if the dimensions of the + ! field array are not in map order + ! file_dist_in is used if the dimensions of the + ! field on file are not in map order + ! + subroutine cam_pio_get_decomp(iodesc, ldims, fdims, dtype, map, & + field_dist_in, file_dist_in, permute) + use pio, only: pio_offset_kind + use cam_abortutils, only: endrun + use cam_map_utils, only: cam_filemap_t + + ! Dummy arguments + type(io_desc_t), pointer :: iodesc ! intent(out) + integer, intent(in) :: ldims(:) ! Local array + integer, intent(in) :: fdims(:) ! File dims + integer, intent(in) :: dtype + type(cam_filemap_t), target, intent(in) :: map + integer, optional, intent(in) :: field_dist_in(:) + integer, optional, intent(in) :: file_dist_in(:) + integer, optional, intent(in) :: permute(:) + + ! Local variables + logical :: found + integer :: i + integer(PIO_OFFSET_KIND), pointer :: dof(:) + type(iodesc_list), pointer :: iodesc_p + character(len=errormsg_str_len) :: errormsg + + call t_startf('get_decomp') + + nullify(iodesc_p) + nullify(dof) + call find_iodesc(ldims, fdims, dtype, map, iodesc_p, found, perm=permute) + + if (.not. found) then + ! Create a new iodesc + if(masterproc) then + write(iulog,*) 'Creating new decomp: ', iodesc_p%tag + end if + + call t_startf('get_filemap') + call map%get_filemap(ldims, fdims, dof, & + src_in=field_dist_in, dest_in=file_dist_in, permutation_in=permute) + call t_stopf('get_filemap') + if (any(fdims == 0)) then + ! Quick sanity check + write(errormsg, *) 'bad fdims, ',fdims + call endrun('cam_pio_get_decomp: '//errormsg) + end if + if (associated(iodesc_p%iodesc)) then + ! Quick sanity check + call endrun('cam_pio_get_decomp: iodesc already allocated') + end if + allocate(iodesc_p%iodesc) + call t_startf('newdecomp') + call cam_pio_newdecomp(iodesc_p%iodesc, fdims, dof, dtype) + call t_stopf('newdecomp') + + deallocate(dof) + nullify(dof) + end if + ! At this point, we should have a decomp, assign iodesc + iodesc => iodesc_p%iodesc + nullify(iodesc_p) + + call t_stopf('get_decomp') + + end subroutine cam_pio_get_decomp + + subroutine cam_pio_newdecomp(iodesc, dims, dof, dtype) + use pio, only: pio_initdecomp, pio_offset_kind, pio_iotype_pnetcdf + + type(io_desc_t), pointer :: iodesc + integer, intent(in) :: dims(:) + integer(kind=PIO_OFFSET_KIND), intent(in) :: dof(:) + integer, intent(in) :: dtype + + if(pio_iotype == pio_iotype_pnetcdf) then + pio_rearranger = PIO_REARR_SUBSET + else + pio_rearranger = PIO_REARR_BOX + endif + + call pio_initdecomp(pio_subsystem, dtype, dims, dof, iodesc, & + rearr=pio_rearranger) + + end subroutine cam_pio_newdecomp + + subroutine find_iodesc(ldimlens, fdimlens, dtype, map, iodesc_p, found, perm) + use cam_abortutils, only: endrun + use cam_map_utils, only: cam_filemap_t + + ! Dummy arguments + integer, intent(in) :: ldimlens(:) + integer, intent(in) :: fdimlens(:) + integer, intent(in) :: dtype + type(cam_filemap_t), intent(in) :: map + type(iodesc_list), pointer :: iodesc_p + logical, intent(out) :: found + integer, optional, intent(in) :: perm(:) + + ! Local variables + type(iodesc_list), pointer :: curr, prev + integer :: i + integer :: lcnt + integer :: fcnt + integer :: mapind + integer :: nperm + character(len=128) :: form + character(len=tag_len) :: tag + character(len=*), parameter :: formc = 'i0,"(i0,""!""),""!"",",' + character(len=*), parameter :: forme = '"""d"",i0,""!i"",i0,""!"""' + character(len=*), parameter :: form2 = '("(",'//formc//formc//forme//',")")' + character(len=*), parameter :: form3 = '("(",'//formc//formc//formc//forme//',")")' + + found = .false. + curr => iodesc_list_top + + ! Retrieve the (hopefully) unique tag for this iodesc + ! If a decomp was created using an earlier version of the map (hey, that + ! might happen), we won't find it using this search because the current + ! index is part of the search tag + mapind = map%get_index() + lcnt = size(ldimlens) + fcnt = size(fdimlens) + if (present(perm)) then + if (size(perm) /= lcnt) then + write(form, '(i0,a,i0)') size(perm), ', should be ', lcnt + call endrun('FIND_IODESC: perm has wrong size, '//form) + end if + nperm = lcnt + else + nperm = 0 + end if + if (present(perm)) then + write(form, form3) lcnt, fcnt, nperm + write(tag, form) (ldimlens(i),i=1,lcnt), (fdimlens(i),i=1,fcnt), (perm(i),i=1,lcnt), dtype, mapind + else + write(form, form2) lcnt, fcnt + write(tag, form) (ldimlens(i),i=1,lcnt), (fdimlens(i),i=1,fcnt), dtype, mapind + end if + + do while(associated(curr) .and. (.not. found)) + if(trim(tag) == trim(curr%tag)) then + found = .true. + iodesc_p => curr + else + prev => curr + curr => curr%next + end if + end do + if(.not. found) then + ! We didn't find a match, make sure there is an unused iodesc_list + ! object at the end of the list for the new decomp to be stored + curr => prev + if(associated(curr%iodesc)) then + allocate(curr%next) + curr => curr%next + nullify(curr%iodesc) ! Should already be null but . . . + nullify(curr%next) ! Should already be null but . . . + end if + ! This should be an unused object at the end of the list + curr%tag = tag + iodesc_p => curr + end if +! if(masterproc) write(iulog,*) 'Using decomp: ',curr%tag + + end subroutine find_iodesc + + + ! cam_pio_def_dim: Define a NetCDF dimension using the PIO interface + subroutine cam_pio_def_dim(File, name, size, dimid, existOK) + use cam_abortutils, only: endrun + use pio, only: pio_inq_dimid, pio_def_dim, pio_inq_dimlen, PIO_NOERR + use pio, only: PIO_seterrorhandling, PIO_BCAST_ERROR + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file Handle + character(len=*), intent(in) :: name ! Dimension name + integer, intent(in) :: size ! Dimension length + integer, intent(out) :: dimid ! NetCDF dimension ID + logical, optional, intent(in) :: existOK ! OK if dim defined + + ! Local variables + logical :: ok_if_dim_exists + integer :: ierr + integer :: err_handling + integer :: dimlen + character(len=errormsg_str_len) :: errormsg + character(len=*), parameter :: subname = 'cam_pio_def_dim' + + if (present(existOK)) then + ok_if_dim_exists = existOK + else + ok_if_dim_exists = .false. + end if + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + + ierr = pio_inq_dimid(File, trim(name), dimid) + if (ierr == PIO_NOERR) then + if (.not. ok_if_dim_exists) then + write(errormsg, *) ': A dimension already exists for ', trim(name) + call endrun(trim(subname)//errormsg) + else + ! It is OK for the dimension to exist but it better have the same size + ierr = pio_inq_dimlen(File, dimid, dimlen) + if (ierr /= PIO_NOERR) then + write(errormsg, '(2a,i0,2a)') trim(subname), ': Error ', ierr, & + ' finding dimension length for ', trim(name) + call endrun(errormsg) + else if (dimlen /= size) then + write(errormsg, '(3a,2(i0,a))') ': Size mismatch for dimension, ', & + trim(name), ': ', dimlen, ' (current), ', size, ' (desired)' + call endrun(trim(subname)//errormsg) + ! No else, existing dimension is OK + end if + end if + else + ! inq_dimid returned an error, define the dimension + ierr = pio_def_dim(File, trim(name), size, dimid) + call cam_pio_handle_error(ierr, trim(subname)//': Unable to define dimension '//trim(name)) + end if + + ! Back to whatever error handling was running before this routine + call pio_seterrorhandling(File, err_handling) + + end subroutine cam_pio_def_dim + + ! cam_pio_def_var_0d: Define a NetCDF variable using the PIO interface + subroutine cam_pio_def_var_0d(File, name, dtype, vardesc, existOK) + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file Handle + character(len=*), intent(in) :: name ! Variable name + integer, intent(in) :: dtype ! e.g., pio_int + type(var_desc_t), intent(inout) :: vardesc ! Variable descriptor + logical, optional, intent(in) :: existOK ! OK if var defined + + ! Local variables + integer :: dimids(0) + + call cam_pio_def_var(File, trim(name), dtype, dimids, vardesc, existOK) + end subroutine cam_pio_def_var_0d + + ! cam_pio_def_var_md: Define a NetCDF variable using the PIO interface + subroutine cam_pio_def_var_md(File, name, dtype, dimids, vardesc, existOK) + use cam_abortutils, only: endrun + use pio, only: pio_inq_varid, pio_def_var, PIO_NOERR + use pio, only: PIO_seterrorhandling, PIO_BCAST_ERROR + + ! Dummy arguments + type(file_desc_t), intent(inout) :: File ! PIO file Handle + character(len=*), intent(in) :: name ! Variable name + integer, intent(in) :: dtype ! e.g., pio_int + integer, intent(in) :: dimids(:) ! NetCDF dim IDs + type(var_desc_t), intent(inout) :: vardesc ! Var descriptor + logical, optional, intent(in) :: existOK ! OK if var defined + + ! Local variables + integer :: ierr + integer :: err_handling + logical :: ok_if_var_exists + character(len=errormsg_str_len) :: errormsg + character(len=*), parameter :: subname = 'cam_pio_def_var' + + if (present(existOK)) then + ok_if_var_exists = existOK + else + ok_if_var_exists = .false. + end if + + ! We will handle errors for this routine + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + + ! Check to see if the variable already exists in the file + ierr = pio_inq_varid(File, name, vardesc) + if (ierr == PIO_NOERR) then + if (.not. ok_if_var_exists) then + write(errormsg, *) ': A variable already exists for ', trim(name) + call endrun(trim(subname)//errormsg) + end if + else + ! OK to define the variable + if (size(dimids) > 0) then + ierr = pio_def_var(File, trim(name), dtype, dimids, vardesc) + else + ierr = pio_def_var(File, trim(name), dtype, vardesc) + end if + call cam_pio_handle_error(ierr, trim(subname)//': Unable to define variable '//trim(name)) + end if + + ! Back to whatever error handling was running before this routine + call pio_seterrorhandling(File, err_handling) + + end subroutine cam_pio_def_var_md + + subroutine cam_pio_get_var_2d_r8(varname, File, field, start, kount, found) + use cam_abortutils, only: endrun + use pio, only: file_desc_t, var_desc_t, pio_get_var, PIO_MAX_NAME + use pio, only: pio_inq_dimname + + ! Dummy arguments + character(len=*), intent(in) :: varname + type(file_desc_t), intent(inout) :: File ! PIO file Handle + real(r8), intent(inout) :: field(:,:) + integer, optional, intent(in) :: start(2) + integer, optional, intent(in) :: kount(2) + logical, optional, intent(out) :: found + + ! Local variables + character(len=*), parameter :: subname = 'cam_pio_get_var_2d_r8' + character(len=PIO_MAX_NAME) :: tmpname + type(var_desc_t) :: varid ! Var descriptor + integer :: ierr + integer :: strt(3) + integer :: cnt(3) + integer :: ndims + integer :: dimids(3) + logical :: exists + character(len=PIO_MAX_NAME) :: filedims(4) + + if ( (present(start) .and. (.not. present(kount))) .or. & + (present(kount) .and. (.not. present(start)))) then + call endrun(trim(subname)//': start and kount must both be present') + end if + + call cam_pio_find_var(File, trim(varname), varid, exists) + if (present(found)) then + found = exists + else if (.not. exists) then + call endrun(trim(subname)//': '//trim(varname)//' not found') + end if + if (exists) then + call cam_pio_var_info(File, varid, ndims, dimids, cnt, dimnames=filedims, varname=varname) + + if (present(start)) then + ! start and kount override other options and are not error checked + strt(1:2) = start(1:2) + strt(3) = 1 + cnt(1:2) = kount(1:2) + cnt(3) = 1 + else + strt = 1 ! cnt set by cam_pio_var_info + exists = use_scam_limits(File, strt, cnt,filedims) + end if + if (ndims == 3) then + ierr = pio_inq_dimname(File, dimids(3), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + else + ierr = pio_get_var(File, varid, strt, cnt, field) + end if + else if (ndims == 2) then + ierr = pio_get_var(File, varid, strt, cnt, field) + else if (ndims == 1) then + ierr = pio_get_var(File, varid, strt(1:1), cnt(1:1), field(:,1)) + else + call endrun(trim(subname)//': Incorrect variable rank') + end if + end if + + end subroutine cam_pio_get_var_2d_r8 + + subroutine cam_pio_get_var_2d_r8_perm(varname, File, arraydims, field, & + start, kount, found) + use cam_abortutils, only: endrun + use pio, only: file_desc_t, var_desc_t, pio_get_var, PIO_MAX_NAME + + ! Dummy arguments + character(len=*), intent(in) :: varname + type(file_desc_t), intent(inout) :: File ! PIO file Handle + character(len=*), intent(in) :: arraydims(2) + real(r8), intent(inout) :: field(:,:) + integer, optional, intent(in) :: start(2) + integer, optional, intent(in) :: kount(2) + logical, optional, intent(out) :: found + + ! Local variables + character(len=*), parameter :: subname = 'cam_pio_get_var_2d_r8_perm' + type(var_desc_t) :: varid ! Var descriptor + integer :: ierr + integer :: i, j, ind(2) + integer :: strt(3) + integer :: cnt(3) + integer :: ndims + integer :: dimids(3) + integer :: perm(2) + logical :: isperm + logical :: exists + real(r8), allocatable :: tmp_fld(:,:) + character(len=PIO_MAX_NAME) :: filedims(3) + + if ( (present(start) .and. (.not. present(kount))) .or. & + (present(kount) .and. (.not. present(start)))) then + call endrun(trim(subname)//': start and kount must both be present') + end if + + call cam_pio_find_var(File, trim(varname), varid, exists) + + if (present(found)) then + found = exists + else if (.not. exists) then + call endrun(trim(subname)//': '//trim(varname)//' not found') + end if + if (exists) then + call cam_pio_var_info(File, varid, ndims, dimids, cnt, & + dimnames=filedims, varname=varname) + + if (present(start)) then + ! start and kount override other options and are not error checked + strt(1:2) = start + strt(3) = 1 + cnt(1:2) = kount + else + strt = 1 ! cnt set by cam_pio_var_info + exists = use_scam_limits(File, strt, cnt,filedims) + end if + if ( ((ndims == 2) .and. (trim(filedims(2)) /= 'time')) .or. & + ((ndims == 3) .and. (trim(filedims(3)) == 'time'))) then + call calc_permutation(filedims(1:2), arraydims, perm, isperm) + if (isperm) then + allocate(tmp_fld(cnt(1), cnt(2))) + ierr = pio_get_var(File, varid, strt(1:ndims), cnt(1:ndims), tmp_fld) + do j = 1, cnt(2) + ind(2) = j + do i = 1, cnt(1) + ind(1) = i + field(ind(perm(1)), ind(perm(2))) = tmp_fld(i, j) + end do + end do + else + ierr = pio_get_var(File, varid, strt(1:ndims), cnt(1:ndims), field) + end if + else + call endrun(trim(subname)//': Incorrect variable rank') + end if + end if + + end subroutine cam_pio_get_var_2d_r8_perm + + subroutine cam_pio_get_var_3d_r8(varname, File, field, start, kount, found) + use cam_abortutils, only: endrun + use pio, only: file_desc_t, var_desc_t, pio_get_var, PIO_MAX_NAME + use pio, only: pio_inq_dimname + + ! Dummy arguments + character(len=*), intent(in) :: varname + type(file_desc_t), intent(inout) :: File ! PIO file Handle + real(r8), intent(inout) :: field(:,:,:) + integer, optional, intent(in) :: start(3) + integer, optional, intent(in) :: kount(3) + logical, optional, intent(out) :: found + + ! Local variables + character(len=*), parameter :: subname = 'cam_pio_get_var_3d_r8' + character(len=PIO_MAX_NAME) :: tmpname + type(var_desc_t) :: varid ! Var descriptor + integer :: ierr + integer :: strt(4) + integer :: cnt(4) + integer :: ndims + integer :: dimids(4) + logical :: exists + character(len=PIO_MAX_NAME) :: filedims(4) + + if ( (present(start) .and. (.not. present(kount))) .or. & + (present(kount) .and. (.not. present(start)))) then + call endrun(trim(subname)//': start and kount must both be present') + end if + + call cam_pio_find_var(File, trim(varname), varid, exists) + + if (present(found)) then + found = exists + else if (.not. exists) then + call endrun(trim(subname)//': '//trim(varname)//' not found') + end if + if (exists) then + call cam_pio_var_info(File, varid, ndims, dimids, cnt,dimnames=filedims, varname=varname) + + if (present(start)) then + ! start and kount override other options and are not error checked + strt(1:3) = start(1:3) + strt(4) = 1 + cnt(1:3) = kount(1:3) + cnt(4) = 1 + else + strt = 1 ! cnt set by cam_pio_var_info + exists = use_scam_limits(File, strt, cnt,filedims) + end if + + if (ndims == 4) then + ierr = pio_inq_dimname(File, dimids(4), tmpname) + if (trim(tmpname) /= 'time') then + call endrun(trim(subname)//': dimension mismatch for '//trim(varname)) + else + ierr = pio_get_var(File, varid, strt, cnt, field) + end if + else if (ndims == 3) then + ierr = pio_get_var(File, varid, strt, cnt, field) + else if (ndims == 2) then + ierr = pio_get_var(File, varid, strt(1:ndims), cnt(1:ndims), field(:,:,1)) + else + call endrun(trim(subname)//': Incorrect variable rank') + end if + end if + + end subroutine cam_pio_get_var_3d_r8 + + subroutine cam_pio_get_var_3d_r8_perm(varname, File, arraydims, field, & + start, kount, found) + use cam_abortutils, only: endrun + use pio, only: file_desc_t, var_desc_t, pio_get_var, PIO_MAX_NAME + + ! Dummy arguments + character(len=*), intent(in) :: varname + type(file_desc_t), intent(inout) :: File ! PIO file Handle + character(len=*), intent(in) :: arraydims(3) + real(r8), intent(inout) :: field(:,:,:) + integer, optional, intent(in) :: start(3) + integer, optional, intent(in) :: kount(3) + logical, optional, intent(out) :: found + + ! Local variables + character(len=*), parameter :: subname = 'cam_pio_get_var_3d_r8_perm' + type(var_desc_t) :: varid ! Var descriptor + integer :: ierr + integer :: i, j, k, ind(3) + integer :: strt(4) + integer :: cnt(4) + integer :: ndims + integer :: dimids(4) + integer :: perm(3) + logical :: exists + logical :: isperm + real(r8), allocatable :: tmp_fld(:,:,:) + character(len=PIO_MAX_NAME) :: filedims(4) + + if ( (present(start) .and. (.not. present(kount))) .or. & + (present(kount) .and. (.not. present(start)))) then + call endrun(trim(subname)//': start and kount must both be present') + end if + + call cam_pio_find_var(File, trim(varname), varid, exists) + + if (present(found)) then + found = exists + else if (.not. exists) then + call endrun(trim(subname)//': '//trim(varname)//' not found') + end if + if (exists) then + call cam_pio_var_info(File, varid, ndims, dimids, cnt, & + dimnames=filedims, varname=varname) + + if (present(start)) then + ! start and kount override other options and are not error checked + strt(1:3) = start + strt(4) = 1 + cnt(1:3) = kount + else + strt = 1 ! cnt set by cam_pio_var_info + exists = use_scam_limits(File, strt, cnt,filedims) + end if + + if ( ((ndims == 3) .and. (trim(filedims(3)) /= 'time')) .or. & + ((ndims == 4) .and. (trim(filedims(4)) == 'time'))) then + call calc_permutation(filedims(1:3), arraydims, perm, isperm) + if (isperm) then + allocate(tmp_fld(cnt(1), cnt(2), cnt(3))) + ierr = pio_get_var(File, varid, strt(1:ndims), cnt(1:ndims), tmp_fld) + do k = 1, cnt(3) + ind(3) = k + do j = 1, cnt(2) + ind(2) = j + do i = 1, cnt(1) + ind(1) = i + field(ind(perm(1)), ind(perm(2)), ind(perm(3))) = tmp_fld(i, j, k) + end do + end do + end do + else + ierr = pio_get_var(File, varid, strt(1:ndims), cnt(1:ndims), field) + end if + else + call endrun(trim(subname)//': Incorrect variable rank') + end if + end if + + end subroutine cam_pio_get_var_3d_r8_perm + + ! clean_iodesc_list: Deallocate all entries in the iodesc list + subroutine clean_iodesc_list() + type(iodesc_list), pointer :: this, prev + + if(associated(iodesc_list_top%iodesc)) then + ! iodesc_list_top is not allocated so leave it (just empty) + this => iodesc_list_top + iodesc_list_top%tag = '' + call pio_freedecomp(pio_subsystem, this%iodesc) + deallocate(this%iodesc) + nullify(this%iodesc) + this => this%next + nullify(iodesc_list_top%next) + + ! All the other list items were allocated, blow them away + do while(associated(this)) + call pio_freedecomp(pio_subsystem, this%iodesc) + deallocate(this%iodesc) + prev => this + this => this%next + deallocate(prev) + end do + end if + end subroutine clean_iodesc_list + + subroutine cam_pio_createfile(file, fname, mode_in) + use pio, only : pio_createfile, file_desc_t, pio_noerr, pio_clobber, & + pio_64bit_offset, pio_iotask_rank + use cam_abortutils, only : endrun + + ! Dummy arguments + type(file_desc_t), intent(inout) :: file + character(len=*), intent(in) :: fname + integer, optional, intent(in) :: mode_in + + ! Local variables + integer :: ierr + integer :: mode + + mode = ior(PIO_CLOBBER, PIO_64BIT_OFFSET) + if (present(mode_in)) then + mode = ior(mode, mode_in) + end if + + ierr = pio_createfile(pio_subsystem, file, pio_iotype, fname, mode) + + if(ierr /= PIO_NOERR) then + call endrun('Failed to open file,'//trim(fname)//', to write') + else if(pio_iotask_rank(pio_subsystem) == 0) then + write(iulog, *) 'Opened file ', trim(fname), ' to write', file%fh + end if + + end subroutine cam_pio_createfile + + subroutine cam_pio_openfile(file, fname, mode) + use pio, only: pio_openfile, file_desc_t, pio_noerr, pio_iotask_rank + use cam_abortutils, only: endrun + + type(file_desc_t), intent(inout), target :: file + character(len=*), intent(in) :: fname + integer, intent(in) :: mode + + integer :: ierr + + ierr = pio_openfile(pio_subsystem, file, pio_iotype, fname, mode) + + if(ierr/= PIO_NOERR) then + call endrun('Failed to open restart file to read') + else if(pio_iotask_rank(pio_subsystem) == 0) then + write(iulog,*) 'Opened existing file ', trim(fname), file%fh + end if + + end subroutine cam_pio_openfile + + subroutine cam_pio_closefile(file) + + use pio, only : pio_closefile, file_desc_t + + type(file_desc_t), intent(inout), target :: file + + call pio_closefile(file) + + end subroutine cam_pio_closefile + + logical function cam_pio_fileexists(fname) + use pio, only: pio_openfile, file_desc_t, pio_noerr, PIO_NOWRITE + use pio, only: pio_seterrorhandling, PIO_BCAST_ERROR + use pio, only : pio_closefile + + character(len=*), intent(in) :: fname + + type(file_desc_t) :: file + integer :: ierr + integer :: err_handling + + ! We will handle errors for this routine + + call pio_seterrorhandling(pio_subsystem, PIO_BCAST_ERROR, err_handling) + + ierr = pio_openfile(pio_subsystem, file, pio_iotype, fname, PIO_NOWRITE) + cam_pio_fileexists = (ierr == PIO_NOERR) + if (cam_pio_fileexists) then + call pio_closefile(file) + end if + + ! Back to whatever error handling was running before this routine + call pio_seterrorhandling(File, err_handling) + + end function cam_pio_fileexists + + subroutine find_dump_filename(fieldname, filename) + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + character(len=*), intent(inout) :: filename + + ! Local variable + integer :: fnum + + ! Find an unused filename for this variable + filename = trim(fieldname)//'_dump_1.nc' + fnum = 1 + do while (cam_pio_fileexists(trim(filename))) + fnum = fnum + 1 + write(filename, '(2a,i0,a)') trim(fieldname), '_dump_', fnum, '.nc' + end do + end subroutine find_dump_filename + + subroutine dump_field_2d_d(fieldname, dim1b, dim1e, dim2b, dim2e, field, & + compute_maxdim_in, fill_value) + use pio, only: pio_offset_kind + use pio, only: pio_double, pio_int, pio_write_darray + use pio, only: pio_put_att, pio_initdecomp, pio_enddef + use spmd_utils, only: iam, npes, mpi_max, mpi_integer, mpicom + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + integer, intent(in) :: dim1b + integer, intent(in) :: dim1e + integer, intent(in) :: dim2b + integer, intent(in) :: dim2e + real(r8), target, intent(in) :: field(dim1b:dim1e,dim2b:dim2e) + logical, optional, intent(in) :: compute_maxdim_in + real(r8), optional, intent(in) :: fill_value + + ! Local variables + type(file_desc_t) :: file + type(var_desc_t) :: vdesc + type(var_desc_t) :: bnddesc + type(io_desc_t) :: iodesc + character(len=64) :: filename + real(r8) :: fillval + integer(PIO_OFFSET_KIND), allocatable :: ldof(:) + integer :: dimids(3) + integer :: bnddimid + integer :: bounds(4) + integer :: dimsizes(3) + integer :: ierr + integer :: i, j, m, lsize + logical :: compute_maxdim + + ! Find an unused filename for this variable + call find_dump_filename(fieldname, filename) + + ! Should we compute max dim sizes or assume they are all the same? + if (present(compute_maxdim_in)) then + compute_maxdim = compute_maxdim_in + else + compute_maxdim = .true. + end if + + if (present(fill_value)) then + fillval = fill_value + else + fillval = -900._r8 + end if + + ! Open the file for writing + call cam_pio_createfile(file, trim(filename)) + + ! Define dimensions + if (compute_maxdim) then + call MPI_allreduce((dim1e - dim1b + 1), dimsizes(1), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim2e - dim2b + 1), dimsizes(2), 1, MPI_integer, & + mpi_max, mpicom, ierr) + else + dimsizes(1) = dim1e - dim1b + 1 + dimsizes(2) = dim2e - dim2b + 1 + end if + dimsizes(3) = npes + do i = 1, size(dimids, 1) + write(filename, '(a,i0)') 'dim', i + call cam_pio_def_dim(file, trim(filename), dimsizes(i), dimids(i)) + end do + call cam_pio_def_dim(file, 'bounds', size(bounds, 1), bnddimid) + ! Define the variables + call cam_pio_def_var(file, trim(fieldname), pio_double, dimids, vdesc) + call cam_pio_def_var(file, 'field_bounds', pio_int, & + (/ bnddimid, dimids(size(dimids, 1)) /), bnddesc) + if (present(fill_value)) then + ierr = pio_put_att(file, vdesc, '_FillValue', fill_value) + end if + ierr = pio_enddef(file) + + ! Compute the variable decomposition and write field + lsize = product(dimsizes(1:2)) + allocate(ldof((dim2e - dim2b + 1) * (dim1e - dim1b + 1))) + m = 0 + do j = dim2b, dim2e + do i = dim1b, dim1e + m = m + 1 + ldof(m) = (iam * lsize) + (dimsizes(1)*(j - dim2b)) + (i - dim1b + 1) + end do + end do + call pio_initdecomp(pio_subsystem, PIO_DOUBLE, dimsizes, ldof, iodesc) + call pio_write_darray(file, vdesc, iodesc, & + field(dim1b:dim1e,dim2b:dim2e), ierr, fillval) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + ! Compute the bounds decomposition and write field bounds + bounds(1) = dim1b + bounds(2) = dim1e + bounds(3) = dim2b + bounds(4) = dim2e + dimsizes(1) = size(bounds, 1) + dimsizes(2) = npes + allocate(ldof(size(bounds, 1))) + do i = 1, size(bounds, 1) + ldof(i) = (iam * size(bounds, 1)) + i + end do + call pio_initdecomp(pio_subsystem, PIO_INT, dimsizes(1:2), ldof, iodesc) + call pio_write_darray(file, bnddesc, iodesc, bounds, ierr, -900) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + + ! All done + call cam_pio_closefile(file) + end subroutine dump_field_2d_d + + subroutine dump_field_3d_d(fieldname, dim1b, dim1e, dim2b, dim2e, & + dim3b, dim3e, field, compute_maxdim_in, fill_value) + use pio, only: pio_offset_kind + use pio, only: pio_double, pio_int, pio_write_darray + use pio, only: pio_put_att, pio_initdecomp, pio_enddef + use spmd_utils, only: iam, npes, mpi_max, mpi_integer, mpicom + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + integer, intent(in) :: dim1b + integer, intent(in) :: dim1e + integer, intent(in) :: dim2b + integer, intent(in) :: dim2e + integer, intent(in) :: dim3b + integer, intent(in) :: dim3e + real(r8), target, intent(in) :: field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e) + logical, optional, intent(in) :: compute_maxdim_in + real(r8), optional, intent(in) :: fill_value + + ! Local variables + type(file_desc_t) :: file + type(var_desc_t) :: vdesc + type(var_desc_t) :: bnddesc + type(io_desc_t) :: iodesc + character(len=64) :: filename + real(r8) :: fillval + integer(PIO_OFFSET_KIND), allocatable :: ldof(:) + integer :: dimids(4) + integer :: bnddimid + integer :: bounds(6) + integer :: dimsizes(4) + integer :: ierr + integer :: i, j, k, m, lsize + logical :: compute_maxdim + + ! Find an unused filename for this variable + call find_dump_filename(fieldname, filename) + + ! Should we compute max dim sizes or assume they are all the same? + if (present(compute_maxdim_in)) then + compute_maxdim = compute_maxdim_in + else + compute_maxdim = .true. + end if + + if (present(fill_value)) then + fillval = fill_value + else + fillval = -900._r8 + end if + + ! Open the file for writing + call cam_pio_createfile(file, trim(filename)) + + ! Define dimensions + if (compute_maxdim) then + call MPI_allreduce((dim1e - dim1b + 1), dimsizes(1), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim2e - dim2b + 1), dimsizes(2), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim3e - dim3b + 1), dimsizes(3), 1, MPI_integer, & + mpi_max, mpicom, ierr) + else + dimsizes(1) = dim1e - dim1b + 1 + dimsizes(2) = dim2e - dim2b + 1 + dimsizes(3) = dim3e - dim3b + 1 + end if + dimsizes(4) = npes + do i = 1, size(dimids, 1) + write(filename, '(a,i0)') 'dim', i + call cam_pio_def_dim(file, trim(filename), dimsizes(i), dimids(i)) + end do + call cam_pio_def_dim(file, 'bounds', size(bounds, 1), bnddimid) + ! Define the variables + call cam_pio_def_var(file, trim(fieldname), pio_double, dimids, vdesc) + call cam_pio_def_var(file, 'field_bounds', pio_int, & + (/ bnddimid, dimids(size(dimids, 1)) /), bnddesc) + ierr = pio_put_att(file, vdesc, '_FillValue', fillval) + ierr = pio_enddef(file) + + ! Compute the variable decomposition + lsize = product(dimsizes(1:3)) + allocate(ldof((dim3e-dim3b+1) * (dim2e-dim2b+1) * (dim1e-dim1b+1))) + m = 0 + do k = dim3b, dim3e + do j = dim2b, dim2e + do i = dim1b, dim1e + m = m + 1 + ldof(m) = (iam * lsize) + (i - dim1b + 1) + & + (dimsizes(1)*((j - dim2b) + (dimsizes(2)*(k - dim3b)))) + end do + end do + end do + call pio_initdecomp(pio_subsystem, PIO_DOUBLE, dimsizes, ldof, iodesc) + call pio_write_darray(file, vdesc, iodesc, & + field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e), ierr, fillval) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + ! Compute the bounds decomposition and write field bounds + bounds(1) = dim1b + bounds(2) = dim1e + bounds(3) = dim2b + bounds(4) = dim2e + bounds(5) = dim3b + bounds(6) = dim3e + dimsizes(1) = size(bounds, 1) + dimsizes(2) = npes + allocate(ldof(size(bounds, 1))) + do i = 1, size(bounds, 1) + ldof(i) = (iam * size(bounds, 1)) + i + end do + call pio_initdecomp(pio_subsystem, PIO_INT, dimsizes(1:2), ldof, iodesc) + call pio_write_darray(file, bnddesc, iodesc, bounds, ierr, -900) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + + ! All done + call cam_pio_closefile(file) + end subroutine dump_field_3d_d + + subroutine dump_field_4d_d(fieldname, dim1b, dim1e, dim2b, dim2e, & + dim3b, dim3e, dim4b, dim4e, field, compute_maxdim_in, fill_value) + use pio, only: pio_offset_kind + use pio, only: pio_double, pio_int, pio_write_darray + use pio, only: pio_put_att, pio_initdecomp, pio_enddef + use spmd_utils, only: iam, npes, mpi_max, mpi_integer, mpicom + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + integer, intent(in) :: dim1b + integer, intent(in) :: dim1e + integer, intent(in) :: dim2b + integer, intent(in) :: dim2e + integer, intent(in) :: dim3b + integer, intent(in) :: dim3e + integer, intent(in) :: dim4b + integer, intent(in) :: dim4e + real(r8), target, intent(in) :: field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e,dim4b:dim4e) + logical, optional, intent(in) :: compute_maxdim_in + real(r8), optional, intent(in) :: fill_value + + ! Local variables + type(file_desc_t) :: file + type(var_desc_t) :: vdesc + type(var_desc_t) :: bnddesc + type(io_desc_t) :: iodesc + character(len=64) :: filename + real(r8) :: fillval + integer(PIO_OFFSET_KIND), allocatable :: ldof(:) + integer :: dimids(5) + integer :: bnddimid + integer :: bounds(8) + integer :: dimsizes(5) + integer :: ierr + integer :: i, j, k, l, m, lsize + logical :: compute_maxdim + + ! Find an unused filename for this variable + call find_dump_filename(fieldname, filename) + + ! Should we compute max dim sizes or assume they are all the same? + if (present(compute_maxdim_in)) then + compute_maxdim = compute_maxdim_in + else + compute_maxdim = .true. + end if + + if (present(fill_value)) then + fillval = fill_value + else + fillval = -900._r8 + end if + + ! Open the file for writing + call cam_pio_createfile(file, trim(filename)) + + ! Define dimensions + if (compute_maxdim) then + call MPI_allreduce((dim1e - dim1b + 1), dimsizes(1), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim2e - dim2b + 1), dimsizes(2), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim3e - dim3b + 1), dimsizes(3), 1, MPI_integer, & + mpi_max, mpicom, ierr) + call MPI_allreduce((dim4e - dim4b + 1), dimsizes(4), 1, MPI_integer, & + mpi_max, mpicom, ierr) + else + dimsizes(1) = dim1e - dim1b + 1 + dimsizes(2) = dim2e - dim2b + 1 + dimsizes(3) = dim3e - dim3b + 1 + dimsizes(4) = dim4e - dim4b + 1 + end if + dimsizes(5) = npes + do i = 1, size(dimids, 1) + write(filename, '(a,i0)') 'dim', i + call cam_pio_def_dim(file, trim(filename), dimsizes(i), dimids(i)) + end do + call cam_pio_def_dim(file, 'bounds', size(bounds, 1), bnddimid) + ! Define the variables + call cam_pio_def_var(file, trim(fieldname), pio_double, dimids, vdesc) + call cam_pio_def_var(file, 'field_bounds', pio_int, & + (/ bnddimid, dimids(size(dimids, 1)) /), bnddesc) + ierr = pio_put_att(file, vdesc, '_FillValue', fillval) + ierr = pio_enddef(file) + + ! Compute the variable decomposition + lsize = product(dimsizes(1:4)) + allocate(ldof((dim4e-dim4b+1) * (dim3e-dim3b+1) * (dim2e-dim2b+1) * (dim1e-dim1b+1))) + m = 0 + do l = dim4b, dim4e + do k = dim3b, dim3e + do j = dim2b, dim2e + do i = dim1b, dim1e + m = m + 1 + ldof(m) = (iam * lsize) + (i - dim1b + 1) + & + (dimsizes(1)*((j - dim2b) + & + (dimsizes(2)*((k - dim3b) + dimsizes(3)*(l - dim4b))))) + end do + end do + end do + end do + call pio_initdecomp(pio_subsystem, PIO_DOUBLE, dimsizes, ldof, iodesc) + call pio_write_darray(file, vdesc, iodesc, & + field(dim1b:dim1e,dim2b:dim2e,dim3b:dim3e,dim4b:dim4e), ierr, fillval) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + ! Compute the bounds decomposition and write field bounds + bounds(1) = dim1b + bounds(2) = dim1e + bounds(3) = dim2b + bounds(4) = dim2e + bounds(5) = dim3b + bounds(6) = dim3e + bounds(7) = dim4b + bounds(8) = dim4e + dimsizes(1) = size(bounds, 1) + dimsizes(2) = npes + allocate(ldof(size(bounds, 1))) + do i = 1, size(bounds, 1) + ldof(i) = (iam * size(bounds, 1)) + i + end do + call pio_initdecomp(pio_subsystem, PIO_INT, dimsizes(1:2), ldof, iodesc) + call pio_write_darray(file, bnddesc, iodesc, bounds, ierr, -900) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + + ! All done + call cam_pio_closefile(file) + end subroutine dump_field_4d_d + + subroutine dump_field_6d_d(fieldname, dimbs, dimes, field, & + compute_maxdim_in, fill_value) + use pio, only: pio_offset_kind + use pio, only: pio_double, pio_int, pio_write_darray + use pio, only: pio_put_att, pio_initdecomp, pio_enddef + use spmd_utils, only: iam, npes, mpi_max, mpi_integer, mpicom + + ! Dummy arguments + character(len=*), intent(in) :: fieldname + integer, intent(in) :: dimbs(:) + integer, intent(in) :: dimes(:) + real(r8), target, intent(in) :: field(:,:,:,:,:,:) + logical, optional, intent(in) :: compute_maxdim_in + real(r8), optional, intent(in) :: fill_value + + ! Local variables + type(file_desc_t) :: file + type(var_desc_t) :: vdesc + type(var_desc_t) :: bnddesc + type(io_desc_t) :: iodesc + character(len=64) :: filename + real(r8) :: fillval + integer(PIO_OFFSET_KIND), allocatable :: ldof(:) + integer :: dimids(7) + integer :: bnddimid + integer :: bounds(14) + integer :: dimsizes(7) + integer :: ierr + integer :: i1, i2, i3, i4, i5, i6, i(6) + integer :: ind, lsize, j + logical :: compute_maxdim + + ! Find an unused filename for this variable + call find_dump_filename(fieldname, filename) + + ! Should we compute max dim sizes or assume they are all the same? + if (present(compute_maxdim_in)) then + compute_maxdim = compute_maxdim_in + else + compute_maxdim = .true. + end if + + if (present(fill_value)) then + fillval = fill_value + else + fillval = -900._r8 + end if + + ! Open the file for writing + call cam_pio_createfile(file, trim(filename)) + + ! Define dimensions + if (compute_maxdim) then + do i1 = 1, 6 + call MPI_allreduce((dimes(i1) - dimbs(i1) + 1), dimsizes(i1), 1, & + MPI_integer, mpi_max, mpicom, ierr) + end do + else + do i1 = 1, 6 + dimsizes(i1) = dimes(i1) - dimbs(i1) + 1 + end do + end if + dimsizes(7) = npes + do ind = 1, 7 + write(filename, '(a,i0)') 'dim', ind + call cam_pio_def_dim(file, trim(filename), dimsizes(ind), dimids(ind)) + end do + call cam_pio_def_dim(file, 'bounds', size(bounds, 1), bnddimid) + ! Define the variables + call cam_pio_def_var(file, 'field_bounds', pio_int, & + (/ bnddimid, dimids(size(dimids, 1)) /), bnddesc) + call cam_pio_def_var(file, trim(fieldname), pio_double, dimids, vdesc) + ierr = pio_put_att(file, vdesc, '_FillValue', fillval) + ierr = pio_enddef(file) + + ! Compute the variable decomposition + lsize = 1 + do ind = 1, 6 + lsize = lsize * (dimes(ind) - dimbs(ind) + 1) + end do + allocate(ldof(lsize)) + ind = 0 + do i6 = dimbs(6), dimes(6) + i(6) = i6 + do i5 = dimbs(5), dimes(5) + i(5) = i5 + do i4 = dimbs(4), dimes(4) + i(4) = i4 + do i3 = dimbs(3), dimes(3) + i(3) = i3 + do i2 = dimbs(2), dimes(2) + i(2) = i2 + do i1 = dimbs(1), dimes(1) + i(1) = i1 + ind = ind + 1 + ldof(ind) = iam + do j = 6, 1, -1 + ldof(ind) = (ldof(ind) * dimsizes(j)) + (i(j) - dimbs(j)) + end do + end do + end do + end do + end do + end do + end do + call pio_initdecomp(pio_subsystem, PIO_DOUBLE, dimsizes, ldof, iodesc) + call pio_write_darray(file, vdesc, iodesc, & + field(dimbs(1):dimes(1),dimbs(2):dimes(2),dimbs(3):dimes(3), & + dimbs(4):dimes(4),dimbs(5):dimes(5),dimbs(6):dimes(6)), ierr, fillval) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + ! Compute the bounds decomposition and write field bounds + do ind = 1, 6 + bounds(2*ind - 1) = dimbs(ind) + bounds(2*ind) = dimes(ind) + end do + bounds(13) = 1 + bounds(14) = npes + dimsizes(1) = size(bounds, 1) + dimsizes(2) = npes + allocate(ldof(size(bounds, 1))) + do ind = 1, size(bounds, 1) + ldof(ind) = (iam * size(bounds, 1)) + ind + end do + call pio_initdecomp(pio_subsystem, PIO_INT, dimsizes(1:2), ldof, iodesc) + call pio_write_darray(file, bnddesc, iodesc, bounds, ierr, -900) + call pio_freedecomp(file, iodesc) + deallocate(ldof) + + ! All done + call cam_pio_closefile(file) + + end subroutine dump_field_6d_d + +end module cam_pio_utils diff --git a/src/utils/coords_1d.F90 b/src/utils/coords_1d.F90 new file mode 100644 index 0000000000..c854cecabb --- /dev/null +++ b/src/utils/coords_1d.F90 @@ -0,0 +1,151 @@ +module coords_1d + +! This module defines the Coords1D type, which is intended to to cache +! commonly used information derived from a collection of sets of 1-D +! coordinates. + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +private +save + +public :: Coords1D + +type :: Coords1D + ! Number of sets of coordinates in the object. + integer :: n = 0 + ! Number of coordinates in each set. + integer :: d = 0 + + ! All fields below will be allocated with first dimension "n". + ! The second dimension is d+1 for ifc, d for mid, del, and rdel, and + ! d-1 for dst and rdst. + + ! Cell interface coordinates. + real(r8), allocatable :: ifc(:,:) + ! Coordinates at cell mid-points. + real(r8), allocatable :: mid(:,:) + ! Width of cells. + real(r8), allocatable :: del(:,:) + ! Distance between cell midpoints. + real(r8), allocatable :: dst(:,:) + ! Reciprocals: 1/del and 1/dst. + real(r8), allocatable :: rdel(:,:) + real(r8), allocatable :: rdst(:,:) + contains + procedure :: section + procedure :: finalize +end type Coords1D + +interface Coords1D + module procedure new_Coords1D_from_fields + module procedure new_Coords1D_from_int +end interface + +contains + +! Constructor to create an object from existing data. +function new_Coords1D_from_fields(ifc, mid, del, dst, & + rdel, rdst) result(coords) + real(r8), USE_CONTIGUOUS intent(in) :: ifc(:,:) + real(r8), USE_CONTIGUOUS intent(in) :: mid(:,:) + real(r8), USE_CONTIGUOUS intent(in) :: del(:,:) + real(r8), USE_CONTIGUOUS intent(in) :: dst(:,:) + real(r8), USE_CONTIGUOUS intent(in) :: rdel(:,:) + real(r8), USE_CONTIGUOUS intent(in) :: rdst(:,:) + type(Coords1D) :: coords + + coords = allocate_coords(size(ifc, 1), size(ifc, 2) - 1) + + coords%ifc = ifc + coords%mid = mid + coords%del = del + coords%dst = dst + coords%rdel = rdel + coords%rdst = rdst + +end function new_Coords1D_from_fields + +! Constructor if you only have interface coordinates; derives all the other +! fields. +function new_Coords1D_from_int(ifc) result(coords) + real(r8), USE_CONTIGUOUS intent(in) :: ifc(:,:) + type(Coords1D) :: coords + + coords = allocate_coords(size(ifc, 1), size(ifc, 2) - 1) + + coords%ifc = ifc + coords%mid = 0.5_r8 * (ifc(:,:coords%d)+ifc(:,2:)) + coords%del = coords%ifc(:,2:) - coords%ifc(:,:coords%d) + coords%dst = coords%mid(:,2:) - coords%mid(:,:coords%d-1) + coords%rdel = 1._r8/coords%del + coords%rdst = 1._r8/coords%dst + +end function new_Coords1D_from_int + +! Create a new Coords1D object that is a subsection of some other object, +! e.g. if you want only the first m coordinates, use d_bnds=[1, m]. +! +! Originally this used pointers, but it was found to actually be cheaper +! in practice just to make a copy, especially since pointers can impede +! optimization. +function section(self, n_bnds, d_bnds) + class(Coords1D), intent(in) :: self + integer, intent(in) :: n_bnds(2), d_bnds(2) + type(Coords1D) :: section + + section = allocate_coords(n_bnds(2)-n_bnds(1)+1, d_bnds(2)-d_bnds(1)+1) + + section%ifc = self%ifc(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)+1) + section%mid = self%mid(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) + section%del = self%del(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) + section%dst = self%dst(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)-1) + section%rdel = self%rdel(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) + section%rdst = self%rdst(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)-1) + +end function section + +! Quick utility to get allocate each array with the correct size. +function allocate_coords(n, d) result(coords) + integer, intent(in) :: n, d + type(Coords1D) :: coords + + coords%n = n + coords%d = d + + allocate(coords%ifc(coords%n,coords%d+1)) + allocate(coords%mid(coords%n,coords%d)) + allocate(coords%del(coords%n,coords%d)) + allocate(coords%dst(coords%n,coords%d-1)) + allocate(coords%rdel(coords%n,coords%d)) + allocate(coords%rdst(coords%n,coords%d-1)) + +end function allocate_coords + +! Deallocate and reset to initial state. +subroutine finalize(self) + class(Coords1D), intent(inout) :: self + + self%n = 0 + self%d = 0 + + call guarded_deallocate(self%ifc) + call guarded_deallocate(self%mid) + call guarded_deallocate(self%del) + call guarded_deallocate(self%dst) + call guarded_deallocate(self%rdel) + call guarded_deallocate(self%rdst) + +contains + + subroutine guarded_deallocate(array) + real(r8), allocatable :: array(:,:) + + if (allocated(array)) deallocate(array) + + end subroutine guarded_deallocate + +end subroutine finalize + +end module coords_1d diff --git a/src/utils/datetime.F90 b/src/utils/datetime.F90 new file mode 100644 index 0000000000..0a288d0aa1 --- /dev/null +++ b/src/utils/datetime.F90 @@ -0,0 +1,53 @@ +module datetime_mod + +implicit none + +private + +public :: datetime + +contains + + subroutine datetime(cdate, ctime) +!----------------------------------------------------------------------- +! +! Purpose: +! +! A generic Date and Time routine +! +! Author: CCM Core group +! +!----------------------------------------------------------------------- +! +! $Id$ +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +!-----------------------------Arguments--------------------------------- + character , intent(out) :: cdate*8 + character , intent(out) :: ctime*8 +!----------------------------------------------------------------------- +! +!---------------------------Local Variables------------------------------ + integer, dimension(8) :: values + character :: date*8, time*10, zone*5 +!----------------------------------------------------------------------- + + call date_and_time (date, time, zone, values) + cdate(1:2) = date(5:6) + cdate(3:3) = '/' + cdate(4:5) = date(7:8) + cdate(6:6) = '/' + cdate(7:8) = date(3:4) + ctime(1:2) = time(1:2) + ctime(3:3) = ':' + ctime(4:5) = time(3:4) + ctime(6:6) = ':' + ctime(7:8) = time(5:6) + + return + end subroutine datetime + +end module datetime_mod diff --git a/src/utils/dtypes.h b/src/utils/dtypes.h new file mode 100644 index 0000000000..9076cf0f75 --- /dev/null +++ b/src/utils/dtypes.h @@ -0,0 +1,5 @@ +#define TYPEDOUBLE 102 +#define TYPEINT 103 +#define TYPETEXT 100 +#define TYPELONG 104 +#define TYPEREAL 101 diff --git a/src/utils/error_messages.F90 b/src/utils/error_messages.F90 new file mode 100644 index 0000000000..a2a64bca91 --- /dev/null +++ b/src/utils/error_messages.F90 @@ -0,0 +1,151 @@ +module error_messages + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! General purpose routines for issuing error messages. + ! + ! Author: B. Eaton + ! + !----------------------------------------------------------------------- + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + save + private + public :: & + alloc_err, &! Issue error message after non-zero return from an allocate statement. + handle_err, &! Issue error message after non-zero return from anything + handle_ncerr ! Handle error returns from netCDF library procedures. + + ! If an error message string is not empty, abort with that string as the + ! error message. + public :: handle_errmsg + +!############################################################################## +contains +!############################################################################## + + subroutine alloc_err( istat, routine, name, nelem ) + + !----------------------------------------------------------------------- + ! Purpose: + ! Issue error message after non-zero return from an allocate statement. + ! + ! Author: B. Eaton + !----------------------------------------------------------------------- + + integer, intent(in) ::& + istat ! status from allocate statement + character(len=*), intent(in) ::& + routine, &! routine that called allocate + name ! name of array + integer, intent(in) ::& + nelem ! number of elements attempted to allocate + !----------------------------------------------------------------------- + + if ( istat .ne. 0 ) then + write(iulog,*)'ERROR trying to allocate memory in routine: ' & + //trim(routine) + write(iulog,*)' Variable name: '//trim(name) + write(iulog,*)' Number of elements: ',nelem + call endrun ('ALLOC_ERR') + end if + + return + + end subroutine alloc_err + +!############################################################################## + + subroutine handle_err( istat, msg ) + + !----------------------------------------------------------------------- + ! Purpose: + ! Issue error message after non-zero return from anything. + ! + ! Author: T. Henderson + !----------------------------------------------------------------------- + + integer, intent(in) :: istat ! status, zero = "no error" + character(len=*), intent(in) :: msg ! error message to print + !----------------------------------------------------------------------- + + if ( istat .ne. 0 ) then + call endrun (trim(msg)) + end if + + return + + end subroutine handle_err + +!############################################################################## + + subroutine handle_ncerr( ret, mes, line ) + + !----------------------------------------------------------------------- + ! Purpose: + ! Check netCDF library function return code. If error detected + ! issue error message then abort. + ! + ! Author: B. Eaton + !----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + use netcdf +!----------------------------------------------------------------------- + + integer, intent(in) ::& + ret ! return code from netCDF library routine + character(len=*), intent(in) ::& + mes ! message to be printed if error detected + integer, intent(in), optional :: line + !----------------------------------------------------------------------- + + if ( ret .ne. NF90_NOERR ) then + if(present(line)) then + write(iulog,*) mes, line + else + write(iulog,*) mes + end if + write(iulog,*) nf90_strerror( ret ) + call endrun ('HANDLE_NCERR') + endif + + return + + end subroutine handle_ncerr + +!############################################################################## + + subroutine handle_errmsg(errmsg, subname, extra_msg) + + ! String that is asserted to be null. + character(len=*), intent(in) :: errmsg + ! Name of procedure generating the message. + character(len=*), intent(in), optional :: subname + ! Additional message from the procedure calling this one. + character(len=*), intent(in), optional :: extra_msg + + if (trim(errmsg) /= "") then + + if (present(extra_msg)) & + write(iulog,*) "handle_errmsg: & + &Message from caller: ",trim(extra_msg) + + if (present(subname)) then + call endrun("ERROR: handle_errmsg: "// & + trim(subname)//": "//trim(errmsg)) + else + call endrun("ERROR: handle_errmsg: "// & + "Error message received from routine: "//trim(errmsg)) + end if + + end if + + end subroutine handle_errmsg + +!############################################################################## + +end module error_messages diff --git a/src/utils/fft99.F90 b/src/utils/fft99.F90 new file mode 100644 index 0000000000..5392764ab8 --- /dev/null +++ b/src/utils/fft99.F90 @@ -0,0 +1,1264 @@ +! FFT99F +! +! PURPOSE PERFORMS MULTIPLE FAST FOURIER TRANSFORMS. THIS PACKAGE +! WILL PERFORM A NUMBER OF SIMULTANEOUS REAL/HALF-COMPLEX +! PERIODIC FOURIER TRANSFORMS OR CORRESPONDING INVERSE +! TRANSFORMS, I.E. GIVEN A SET OF REAL DATA VECTORS, THE +! PACKAGE RETURNS A SET OF 'HALF-COMPLEX' FOURIER +! COEFFICIENT VECTORS, OR VICE VERSA. THE LENGTH OF THE +! TRANSFORMS MUST BE AN EVEN NUMBER GREATER THAN 4 THAT HAS +! NO OTHER FACTORS EXCEPT POSSIBLY POWERS OF 2, 3, AND 5. +! THIS IS AN ALL FORTRAN VERSION OF THE CRAYLIB PACKAGE +! THAT IS MOSTLY WRITTEN IN CAL. +! +! THE PACKAGE FFT99F CONTAINS SEVERAL USER-LEVEL ROUTINES: +! +! SUBROUTINE SET99 +! AN INITIALIZATION ROUTINE THAT MUST BE CALLED ONCE +! BEFORE A SEQUENCE OF CALLS TO THE FFT ROUTINES +! (PROVIDED THAT N IS NOT CHANGED). +! +! SUBROUTINES FFT99 AND FFT991 +! TWO FFT ROUTINES THAT RETURN SLIGHTLY DIFFERENT +! ARRANGEMENTS OF THE DATA IN GRIDPOINT SPACE. +! +! +! ACCESS THIS FORTRAN VERSION MAY BE ACCESSED WITH +! +! *FORTRAN,P=XLIB,SN=FFT99F +! +! TO ACCESS THE CRAY OBJECT CODE, CALLING THE USER ENTRY +! POINTS FROM A CRAY PROGRAM IS SUFFICIENT. THE SOURCE +! FORTRAN AND CAL CODE FOR THE CRAYLIB VERSION MAY BE +! ACCESSED USING +! +! FETCH P=CRAYLIB,SN=FFT99 +! FETCH P=CRAYLIB,SN=CAL99 +! +! USAGE LET N BE OF THE FORM 2**P * 3**Q * 5**R, WHERE P .GE. 1, +! Q .GE. 0, AND R .GE. 0. THEN A TYPICAL SEQUENCE OF +! CALLS TO TRANSFORM A GIVEN SET OF REAL VECTORS OF LENGTH +! N TO A SET OF 'HALF-COMPLEX' FOURIER COEFFICIENT VECTORS +! OF LENGTH N IS +! +! DIMENSION IFAX(13),TRIGS(3*N/2+1),A(M*(N+2)), +! + WORK(M*(N+1)) +! +! CALL SET99 (TRIGS, IFAX, N) +! CALL FFT99 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) +! +! SEE THE INDIVIDUAL WRITE-UPS FOR SET99, FFT99, AND +! FFT991 BELOW, FOR A DETAILED DESCRIPTION OF THE +! ARGUMENTS. +! +! HISTORY THE PACKAGE WAS WRITTEN BY CLIVE TEMPERTON AT ECMWF IN +! NOVEMBER, 1978. IT WAS MODIFIED, DOCUMENTED, AND TESTED +! FOR NCAR BY RUSS REW IN SEPTEMBER, 1980. +! +!----------------------------------------------------------------------- +! +! SUBROUTINE SET99 (TRIGS, IFAX, N) +! +! PURPOSE A SET-UP ROUTINE FOR FFT99 AND FFT991. IT NEED ONLY BE +! CALLED ONCE BEFORE A SEQUENCE OF CALLS TO THE FFT +! ROUTINES (PROVIDED THAT N IS NOT CHANGED). +! +! ARGUMENT IFAX(13),TRIGS(3*N/2+1) +! DIMENSIONS +! +! ARGUMENTS +! +! ON INPUT TRIGS +! A FLOATING POINT ARRAY OF DIMENSION 3*N/2 IF N/2 IS +! EVEN, OR 3*N/2+1 IF N/2 IS ODD. +! +! IFAX +! AN INTEGER ARRAY. THE NUMBER OF ELEMENTS ACTUALLY USED +! WILL DEPEND ON THE FACTORIZATION OF N. DIMENSIONING +! IFAX FOR 13 SUFFICES FOR ALL N LESS THAN A MILLION. +! +! N +! AN EVEN NUMBER GREATER THAN 4 THAT HAS NO PRIME FACTOR +! GREATER THAN 5. N IS THE LENGTH OF THE TRANSFORMS (SEE +! THE DOCUMENTATION FOR FFT99 AND FFT991 FOR THE +! DEFINITIONS OF THE TRANSFORMS). +! +! ON OUTPUT IFAX +! CONTAINS THE FACTORIZATION OF N/2. IFAX(1) IS THE +! NUMBER OF FACTORS, AND THE FACTORS THEMSELVES ARE STORED +! IN IFAX(2),IFAX(3),... IF SET99 IS CALLED WITH N ODD, +! OR IF N HAS ANY PRIME FACTORS GREATER THAN 5, IFAX(1) +! IS SET TO -99. +! +! TRIGS +! AN ARRAY OF TRIGONOMETRIC FUNCTION VALUES SUBSEQUENTLY +! USED BY THE FFT ROUTINES. +! +!----------------------------------------------------------------------- +! +! SUBROUTINE FFT991 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) +! AND +! SUBROUTINE FFT99 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) +! +! PURPOSE PERFORM A NUMBER OF SIMULTANEOUS REAL/HALF-COMPLEX +! PERIODIC FOURIER TRANSFORMS OR CORRESPONDING INVERSE +! TRANSFORMS, USING ORDINARY SPATIAL ORDER OF GRIDPOINT +! VALUES (FFT991) OR EXPLICIT CYCLIC CONTINUITY IN THE +! GRIDPOINT VALUES (FFT99). GIVEN A SET +! OF REAL DATA VECTORS, THE PACKAGE RETURNS A SET OF +! 'HALF-COMPLEX' FOURIER COEFFICIENT VECTORS, OR VICE +! VERSA. THE LENGTH OF THE TRANSFORMS MUST BE AN EVEN +! NUMBER THAT HAS NO OTHER FACTORS EXCEPT POSSIBLY POWERS +! OF 2, 3, AND 5. THESE VERSION OF FFT991 AND FFT99 ARE +! OPTIMIZED FOR USE ON THE CRAY-1. +! +! ARGUMENT A(M*(N+2)), WORK(M*(N+1)), TRIGS(3*N/2+1), IFAX(13) +! DIMENSIONS +! +! ARGUMENTS +! +! ON INPUT A +! AN ARRAY OF LENGTH M*(N+2) CONTAINING THE INPUT DATA +! OR COEFFICIENT VECTORS. THIS ARRAY IS OVERWRITTEN BY +! THE RESULTS. +! +! WORK +! A WORK ARRAY OF DIMENSION M*(N+1) +! +! TRIGS +! AN ARRAY SET UP BY SET99, WHICH MUST BE CALLED FIRST. +! +! IFAX +! AN ARRAY SET UP BY SET99, WHICH MUST BE CALLED FIRST. +! +! INC +! THE INCREMENT (IN WORDS) BETWEEN SUCCESSIVE ELEMENTS OF +! EACH DATA OR COEFFICIENT VECTOR (E.G. INC=1 FOR +! CONSECUTIVELY STORED DATA). +! +! JUMP +! THE INCREMENT (IN WORDS) BETWEEN THE FIRST ELEMENTS OF +! SUCCESSIVE DATA OR COEFFICIENT VECTORS. ON THE CRAY-1, +! TRY TO ARRANGE DATA SO THAT JUMP IS NOT A MULTIPLE OF 8 +! (TO AVOID MEMORY BANK CONFLICTS). FOR CLARIFICATION OF +! INC AND JUMP, SEE THE EXAMPLES BELOW. +! +! N +! THE LENGTH OF EACH TRANSFORM (SEE DEFINITION OF +! TRANSFORMS, BELOW). +! +! M +! THE NUMBER OF TRANSFORMS TO BE DONE SIMULTANEOUSLY. +! +! ISIGN +! = +1 FOR A TRANSFORM FROM FOURIER COEFFICIENTS TO +! GRIDPOINT VALUES. +! = -1 FOR A TRANSFORM FROM GRIDPOINT VALUES TO FOURIER +! COEFFICIENTS. +! +! ON OUTPUT A +! IF ISIGN = +1, AND M COEFFICIENT VECTORS ARE SUPPLIED +! EACH CONTAINING THE SEQUENCE: +! +! A(0),B(0),A(1),B(1),...,A(N/2),B(N/2) (N+2 VALUES) +! +! THEN THE RESULT CONSISTS OF M DATA VECTORS EACH +! CONTAINING THE CORRESPONDING N+2 GRIDPOINT VALUES: +! +! FOR FFT991, X(0), X(1), X(2),...,X(N-1),0,0. +! FOR FFT99, X(N-1),X(0),X(1),X(2),...,X(N-1),X(0). +! (EXPLICIT CYCLIC CONTINUITY) +! +! WHEN ISIGN = +1, THE TRANSFORM IS DEFINED BY: +! X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) +! AND I=SQRT (-1) +! +! IF ISIGN = -1, AND M DATA VECTORS ARE SUPPLIED EACH +! CONTAINING A SEQUENCE OF GRIDPOINT VALUES X(J) AS +! DEFINED ABOVE, THEN THE RESULT CONSISTS OF M VECTORS +! EACH CONTAINING THE CORRESPONDING FOURIER COFFICIENTS +! A(K), B(K), 0 .LE. K .LE N/2. +! +! WHEN ISIGN = -1, THE INVERSE TRANSFORM IS DEFINED BY: +! C(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*EXP(-2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND I=SQRT(-1) +! +! A CALL WITH ISIGN=+1 FOLLOWED BY A CALL WITH ISIGN=-1 +! (OR VICE VERSA) RETURNS THE ORIGINAL DATA. +! +! NOTE: THE FACT THAT THE GRIDPOINT VALUES X(J) ARE REAL +! IMPLIES THAT B(0)=B(N/2)=0. FOR A CALL WITH ISIGN=+1, +! IT IS NOT ACTUALLY NECESSARY TO SUPPLY THESE ZEROS. +! +! EXAMPLES GIVEN 19 DATA VECTORS EACH OF LENGTH 64 (+2 FOR EXPLICIT +! CYCLIC CONTINUITY), COMPUTE THE CORRESPONDING VECTORS OF +! FOURIER COEFFICIENTS. THE DATA MAY, FOR EXAMPLE, BE +! ARRANGED LIKE THIS: +! +! FIRST DATA A(1)= . . . A(66)= A(70) +! VECTOR X(63) X(0) X(1) X(2) ... X(63) X(0) (4 EMPTY LOCATIONS) +! +! SECOND DATA A(71)= . . . A(140) +! VECTOR X(63) X(0) X(1) X(2) ... X(63) X(0) (4 EMPTY LOCATIONS) +! +! AND SO ON. HERE INC=1, JUMP=70, N=64, M=19, ISIGN=-1, +! AND FFT99 SHOULD BE USED (BECAUSE OF THE EXPLICIT CYCLIC +! CONTINUITY). +! +! ALTERNATIVELY THE DATA MAY BE ARRANGED LIKE THIS: +! +! FIRST SECOND LAST +! DATA DATA DATA +! VECTOR VECTOR VECTOR +! +! A(1)= A(2)= A(19)= +! +! X(63) X(63) . . . X(63) +! A(20)= X(0) X(0) . . . X(0) +! A(39)= X(1) X(1) . . . X(1) +! . . . +! . . . +! . . . +! +! IN WHICH CASE WE HAVE INC=19, JUMP=1, AND THE REMAINING +! PARAMETERS ARE THE SAME AS BEFORE. IN EITHER CASE, EACH +! COEFFICIENT VECTOR OVERWRITES THE CORRESPONDING INPUT +! DATA VECTOR. +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ + +!================================================================================================ + + SUBROUTINE FFT99(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) +! +!----------------------------------------------------------------------- +! SUBROUTINE "FFT99" - MULTIPLE FAST REAL PERIODIC TRANSFORM +! CORRESPONDING TO OLD SCALAR ROUTINE FFT9 +! PROCEDURE USED TO CONVERT TO HALF-LENGTH COMPLEX TRANSFORM +! IS GIVEN BY COOLEY, LEWIS AND WELCH (J. SOUND VIB., VOL. 12 +! (1970), 315-337) +! +! A IS THE ARRAY CONTAINING INPUT AND OUTPUT DATA +! WORK IS AN AREA OF SIZE (N+1)*LOT +! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES +! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N/2 +! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' +! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) +! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR +! N IS THE LENGTH OF THE DATA VECTORS +! LOT IS THE NUMBER OF DATA VECTORS +! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT +! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL +! +! ORDERING OF COEFFICIENTS: +! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) +! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED +! +! ORDERING OF DATA: +! X(N-1),X(0),X(1),X(2),...,X(N),X(0) +! I.E. EXPLICIT CYCLIC CONTINUITY; (N+2) LOCATIONS REQUIRED +! +! VECTORIZATION IS ACHIEVED ON CRAY BY DOING THE TRANSFORMS IN +! PARALLEL +! +! *** N.B. N IS ASSUMED TO BE AN EVEN NUMBER +! +! DEFINITION OF TRANSFORMS: +! ------------------------- +! +! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) +! +! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) +! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer IFAX(13), inc, jump, n, lot, isign + real(r8) A(LOT* (N+2) ), WORK(LOT*(N+1)), TRIGS(3*N/2+1) +! +!---------------------------Local variables----------------------------- +! + integer i, j, k, l, m, ia, ib, la, ink, nh, nx, nfax + integer ibase, jbase, igo +! +!----------------------------------------------------------------------- +! + NFAX=IFAX(1) + NX=N+1 + NH=N/2 + INK=INC+INC + IF (ISIGN.EQ.+1) GO TO 30 +! +! IF NECESSARY, TRANSFER DATA TO WORK AREA + IGO=50 + IF (MOD(NFAX,2).EQ.1) GOTO 40 + IBASE=INC+1 + JBASE=1 + DO 20 L=1,LOT + I=IBASE + J=JBASE + DO 10 M=1,N + WORK(J)=A(I) + I=I+INC + J=J+1 + 10 CONTINUE + IBASE=IBASE+JUMP + JBASE=JBASE+NX + 20 CONTINUE +! + IGO=60 + GO TO 40 +! +! PREPROCESSING (ISIGN=+1) +! ------------------------ +! + 30 CONTINUE + CALL FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) + IGO=60 +! +! COMPLEX TRANSFORM +! ----------------- +! + 40 CONTINUE + IA=INC+1 + LA=1 + DO 80 K=1,NFAX + IF (IGO.EQ.60) GO TO 60 + 50 CONTINUE + CALL VPASSM(A(IA),A(IA+INC),WORK(1),WORK(2),TRIGS, & + INK,2,JUMP,NX,LOT,NH,IFAX(K+1),LA) + IGO=60 + GO TO 70 + 60 CONTINUE + CALL VPASSM(WORK(1),WORK(2),A(IA),A(IA+INC),TRIGS, & + 2,INK,NX,JUMP,LOT,NH,IFAX(K+1),LA) + IGO=50 + 70 CONTINUE + LA=LA*IFAX(K+1) + 80 CONTINUE +! + IF (ISIGN.EQ.-1) GO TO 130 +! +! IF NECESSARY, TRANSFER DATA FROM WORK AREA + IF (MOD(NFAX,2).EQ.1) GO TO 110 + IBASE=1 + JBASE=IA + DO 100 L=1,LOT + I=IBASE + J=JBASE + DO 90 M=1,N + A(J)=WORK(I) + I=I+1 + J=J+INC + 90 CONTINUE + IBASE=IBASE+NX + JBASE=JBASE+JUMP + 100 CONTINUE +! +! FILL IN CYCLIC BOUNDARY POINTS + 110 CONTINUE + IA=1 + IB=N*INC+1 + DO 120 L=1,LOT + A(IA)=A(IB) + A(IB+INC)=A(IA+INC) + IA=IA+JUMP + IB=IB+JUMP + 120 CONTINUE + GO TO 140 +! +! POSTPROCESSING (ISIGN=-1): +! -------------------------- +! + 130 CONTINUE + CALL FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) +! + 140 CONTINUE + RETURN + END SUBROUTINE FFT99 + +!================================================================================================ + + SUBROUTINE FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) +! +!----------------------------------------------------------------------- +! SUBROUTINE FFT99A - PREPROCESSING STEP FOR FFT99, ISIGN=+1 +! (SPECTRAL TO GRIDPOINT TRANSFORM) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer inc, jump, n, lot + real(r8) A(*), WORK(*), TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer iabase, ibbase, jabase, jbbase, ia, ib, ink + integer ja, jb, k, l, nh, nx + real(r8) c, s +! +!----------------------------------------------------------------------- +! + NH=N/2 + NX=N+1 + INK=INC+INC +! +! A(0) AND A(N/2) + IA=1 + IB=N*INC+1 + JA=1 + JB=2 + DO 10 L=1,LOT + WORK(JA)=A(IA)+A(IB) + WORK(JB)=A(IA)-A(IB) + IA=IA+JUMP + IB=IB+JUMP + JA=JA+NX + JB=JB+NX + 10 CONTINUE +! +! REMAINING WAVENUMBERS + IABASE=2*INC+1 + IBBASE=(N-2)*INC+1 + JABASE=3 + JBBASE=N-1 +! + DO 30 K=3,NH,2 + IA=IABASE + IB=IBBASE + JA=JABASE + JB=JBBASE + C=TRIGS(N+K) + S=TRIGS(N+K+1) + DO 20 L=1,LOT + WORK(JA)=(A(IA)+A(IB))- & + (S*(A(IA)-A(IB))+C*(A(IA+INC)+A(IB+INC))) + WORK(JB)=(A(IA)+A(IB))+ & + (S*(A(IA)-A(IB))+C*(A(IA+INC)+A(IB+INC))) + WORK(JA+1)=(C*(A(IA)-A(IB))-S*(A(IA+INC)+A(IB+INC)))+ & + (A(IA+INC)-A(IB+INC)) + WORK(JB+1)=(C*(A(IA)-A(IB))-S*(A(IA+INC)+A(IB+INC)))- & + (A(IA+INC)-A(IB+INC)) + IA=IA+JUMP + IB=IB+JUMP + JA=JA+NX + JB=JB+NX + 20 CONTINUE + IABASE=IABASE+INK + IBBASE=IBBASE-INK + JABASE=JABASE+2 + JBBASE=JBBASE-2 + 30 CONTINUE +! + IF (IABASE.NE.IBBASE) GO TO 50 +! WAVENUMBER N/4 (IF IT EXISTS) + IA=IABASE + JA=JABASE + DO 40 L=1,LOT + WORK(JA)=2.0_r8*A(IA) + WORK(JA+1)=-2.0_r8*A(IA+INC) + IA=IA+JUMP + JA=JA+NX + 40 CONTINUE +! + 50 CONTINUE + RETURN + END SUBROUTINE FFT99A + +!================================================================================================ + + SUBROUTINE FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) +! +!----------------------------------------------------------------------- +! SUBROUTINE FFT99B - POSTPROCESSING STEP FOR FFT99, ISIGN=-1 +! (GRIDPOINT TO SPECTRAL TRANSFORM) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer inc, jump, n, lot + real(r8) WORK(*), A(*), TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer iabase, ibbase, jabase, jbbase, ia, ib, ink + integer ja, jb, k, l, nh, nx + real(r8) scale, s, c +! +!----------------------------------------------------------------------- +! + NH=N/2 + NX=N+1 + INK=INC+INC +! +! A(0) AND A(N/2) + SCALE=1.0_r8/real(N,r8) + IA=1 + IB=2 + JA=1 + JB=N*INC+1 + DO 10 L=1,LOT + A(JA)=SCALE*(WORK(IA)+WORK(IB)) + A(JB)=SCALE*(WORK(IA)-WORK(IB)) + A(JA+INC)=0.0_r8 + A(JB+INC)=0.0_r8 + IA=IA+NX + IB=IB+NX + JA=JA+JUMP + JB=JB+JUMP + 10 CONTINUE +! +! REMAINING WAVENUMBERS + SCALE=0.5_r8*SCALE + IABASE=3 + IBBASE=N-1 + JABASE=2*INC+1 + JBBASE=(N-2)*INC+1 +! + DO 30 K=3,NH,2 + IA=IABASE + IB=IBBASE + JA=JABASE + JB=JBBASE + C=TRIGS(N+K) + S=TRIGS(N+K+1) + DO 20 L=1,LOT + A(JA)=SCALE*((WORK(IA)+WORK(IB)) & + +(C*(WORK(IA+1)+WORK(IB+1))+S*(WORK(IA)-WORK(IB)))) + A(JB)=SCALE*((WORK(IA)+WORK(IB)) & + -(C*(WORK(IA+1)+WORK(IB+1))+S*(WORK(IA)-WORK(IB)))) + A(JA+INC)=SCALE*((C*(WORK(IA)-WORK(IB))-S*(WORK(IA+1)+WORK(IB+1))) & + +(WORK(IB+1)-WORK(IA+1))) + A(JB+INC)=SCALE*((C*(WORK(IA)-WORK(IB))-S*(WORK(IA+1)+WORK(IB+1))) & + -(WORK(IB+1)-WORK(IA+1))) + IA=IA+NX + IB=IB+NX + JA=JA+JUMP + JB=JB+JUMP + 20 CONTINUE + IABASE=IABASE+2 + IBBASE=IBBASE-2 + JABASE=JABASE+INK + JBBASE=JBBASE-INK + 30 CONTINUE +! + IF (IABASE.NE.IBBASE) GO TO 50 +! WAVENUMBER N/4 (IF IT EXISTS) + IA=IABASE + JA=JABASE + SCALE=2.0_r8*SCALE + DO 40 L=1,LOT + A(JA)=SCALE*WORK(IA) + A(JA+INC)=-SCALE*WORK(IA+1) + IA=IA+NX + JA=JA+JUMP + 40 CONTINUE +! + 50 CONTINUE + RETURN + END SUBROUTINE FFT99B + +!================================================================================================ + + SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) +! +!----------------------------------------------------------------------- +! SUBROUTINE "FFT991" - MULTIPLE REAL/HALF-COMPLEX PERIODIC +! FAST FOURIER TRANSFORM +! +! SAME AS FFT99 EXCEPT THAT ORDERING OF DATA CORRESPONDS TO +! THAT IN MRFFT2 +! +! PROCEDURE USED TO CONVERT TO HALF-LENGTH COMPLEX TRANSFORM +! IS GIVEN BY COOLEY, LEWIS AND WELCH (J. SOUND VIB., VOL. 12 +! (1970), 315-337) +! +! A IS THE ARRAY CONTAINING INPUT AND OUTPUT DATA +! WORK IS AN AREA OF SIZE (N+1)*LOT +! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES +! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N/2 +! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' +! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) +! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR +! N IS THE LENGTH OF THE DATA VECTORS +! LOT IS THE NUMBER OF DATA VECTORS +! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT +! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL +! +! ORDERING OF COEFFICIENTS: +! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) +! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED +! +! ORDERING OF DATA: +! X(0),X(1),X(2),...,X(N-1) +! +! VECTORIZATION IS ACHIEVED ON CRAY BY DOING THE TRANSFORMS IN +! PARALLEL +! +! *** N.B. N IS ASSUMED TO BE AN EVEN NUMBER +! +! DEFINITION OF TRANSFORMS: +! ------------------------- +! +! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) +! +! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) +! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer IFAX(13), inc, jump, n, lot, isign + real(r8) A(*), WORK(*), TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer ibase, jbase, i, j, ia, ib, igo, ink, k + integer l, la, m, nh, nfax, nx +! +!----------------------------------------------------------------------- +! + NFAX=IFAX(1) + NX=N+1 + NH=N/2 + INK=INC+INC + IF (ISIGN.EQ.+1) GO TO 30 +! +! IF NECESSARY, TRANSFER DATA TO WORK AREA + IGO=50 + IF (MOD(NFAX,2).EQ.1) GOTO 40 + IBASE=1 + JBASE=1 + DO 20 L=1,LOT + I=IBASE + J=JBASE + DO 10 M=1,N + WORK(J)=A(I) + I=I+INC + J=J+1 + 10 CONTINUE + IBASE=IBASE+JUMP + JBASE=JBASE+NX + 20 CONTINUE +! + IGO=60 + GO TO 40 +! +! PREPROCESSING (ISIGN=+1) +! ------------------------ +! + 30 CONTINUE + CALL FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) + IGO=60 +! +! COMPLEX TRANSFORM +! ----------------- +! + 40 CONTINUE + IA=1 + LA=1 + DO 80 K=1,NFAX + IF (IGO.EQ.60) GO TO 60 + 50 CONTINUE + CALL VPASSM(A(IA),A(IA+INC),WORK(1),WORK(2),TRIGS, & + INK,2,JUMP,NX,LOT,NH,IFAX(K+1),LA) + IGO=60 + GO TO 70 + 60 CONTINUE + CALL VPASSM(WORK(1),WORK(2),A(IA),A(IA+INC),TRIGS, & + 2,INK,NX,JUMP,LOT,NH,IFAX(K+1),LA) + IGO=50 + 70 CONTINUE + LA=LA*IFAX(K+1) + 80 CONTINUE +! + IF (ISIGN.EQ.-1) GO TO 130 +! +! IF NECESSARY, TRANSFER DATA FROM WORK AREA + IF (MOD(NFAX,2).EQ.1) GO TO 110 + IBASE=1 + JBASE=1 + DO 100 L=1,LOT + I=IBASE + J=JBASE + DO 90 M=1,N + A(J)=WORK(I) + I=I+1 + J=J+INC + 90 CONTINUE + IBASE=IBASE+NX + JBASE=JBASE+JUMP + 100 CONTINUE +! +! FILL IN ZEROS AT END + 110 CONTINUE + IB=N*INC+1 + DO 120 L=1,LOT + A(IB)=0.0_r8 + A(IB+INC)=0.0_r8 + IB=IB+JUMP + 120 CONTINUE + GO TO 140 +! +! POSTPROCESSING (ISIGN=-1): +! -------------------------- +! + 130 CONTINUE + CALL FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) +! + 140 CONTINUE + RETURN + END SUBROUTINE FFT991 + +!================================================================================================ + + SUBROUTINE SET99 (TRIGS, IFAX, N) +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer n, IFAX(13) + real(r8) TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer i +! +! MODE 3 IS USED FOR REAL/HALF-COMPLEX TRANSFORMS. IT IS POSSIBLE +! TO DO COMPLEX/COMPLEX TRANSFORMS WITH OTHER VALUES OF MODE, BUT +! DOCUMENTATION OF THE DETAILS WERE NOT AVAILABLE WHEN THIS ROUTINE +! WAS WRITTEN. +! + integer mode + DATA MODE /3/ +! +!----------------------------------------------------------------------- +! + CALL FAX (IFAX, N, MODE) + I = IFAX(1) + IF (IFAX(I+1) .GT. 5 .OR. N .LE. 4) IFAX(1) = -99 + IF (IFAX(1) .LE. 0 ) THEN + write(iulog,*) ' SET99 -- INVALID N' + STOP 'SET99' + ENDIF + CALL FFTRIG (TRIGS, N, MODE) + RETURN + END SUBROUTINE SET99 + +!================================================================================================ + + SUBROUTINE FAX(IFAX,N,MODE) +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer IFAX(10), n, mode +! +!---------------------------Local variables----------------------------- +! + integer ii, nfax, inc, item, i, istop, l, k, nn +! +!----------------------------------------------------------------------- +! + NN=N + IF (IABS(MODE).EQ.1) GO TO 10 + IF (IABS(MODE).EQ.8) GO TO 10 + NN=N/2 + IF ((NN+NN).EQ.N) GO TO 10 + IFAX(1)=-99 + RETURN + 10 K=1 +! TEST FOR FACTORS OF 4 + 20 IF (MOD(NN,4).NE.0) GO TO 30 + K=K+1 + IFAX(K)=4 + NN=NN/4 + IF (NN.EQ.1) GO TO 80 + GO TO 20 +! TEST FOR EXTRA FACTOR OF 2 + 30 IF (MOD(NN,2).NE.0) GO TO 40 + K=K+1 + IFAX(K)=2 + NN=NN/2 + IF (NN.EQ.1) GO TO 80 +! TEST FOR FACTORS OF 3 + 40 IF (MOD(NN,3).NE.0) GO TO 50 + K=K+1 + IFAX(K)=3 + NN=NN/3 + IF (NN.EQ.1) GO TO 80 + GO TO 40 +! NOW FIND REMAINING FACTORS + 50 L=5 + INC=2 +! INC ALTERNATELY TAKES ON VALUES 2 AND 4 + 60 IF (MOD(NN,L).NE.0) GO TO 70 + K=K+1 + IFAX(K)=L + NN=NN/L + IF (NN.EQ.1) GO TO 80 + GO TO 60 + 70 L=L+INC + INC=6-INC + GO TO 60 + 80 IFAX(1)=K-1 +! IFAX(1) CONTAINS NUMBER OF FACTORS + NFAX=IFAX(1) +! SORT FACTORS INTO ASCENDING ORDER + IF (NFAX.EQ.1) GO TO 110 + DO 100 II=2,NFAX + ISTOP=NFAX+2-II + DO 90 I=2,ISTOP + IF (IFAX(I+1).GE.IFAX(I)) GO TO 90 + ITEM=IFAX(I) + IFAX(I)=IFAX(I+1) + IFAX(I+1)=ITEM + 90 CONTINUE + 100 CONTINUE + 110 CONTINUE + RETURN + END SUBROUTINE FAX + +!================================================================================================ + + SUBROUTINE FFTRIG(TRIGS,N,MODE) +! +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer n, mode + real(r8) TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer i, l, la, nh, imode, nn + real(r8) del, pi, angle +! +!----------------------------------------------------------------------- +! + PI=2.0_r8*ASIN(1.0_r8) + IMODE=IABS(MODE) + NN=N + IF (IMODE.GT.1.AND.IMODE.LT.6) NN=N/2 + DEL=(PI+PI)/real(NN,r8) + L=NN+NN + DO 10 I=1,L,2 + ANGLE=0.5_r8*real(I-1,r8)*DEL + TRIGS(I)=COS(ANGLE) + TRIGS(I+1)=SIN(ANGLE) + 10 CONTINUE + IF (IMODE.EQ.1) RETURN + IF (IMODE.EQ.8) RETURN + DEL=0.5_r8*DEL + NH=(NN+1)/2 + L=NH+NH + LA=NN+NN + DO 20 I=1,L,2 + ANGLE=0.5_r8*real(I-1,r8)*DEL + TRIGS(LA+I)=COS(ANGLE) + TRIGS(LA+I+1)=SIN(ANGLE) + 20 CONTINUE + IF (IMODE.LE.3) RETURN + DEL=0.5_r8*DEL + LA=LA+NN + IF (MODE.EQ.5) GO TO 40 + DO 30 I=2,NN + ANGLE=real(I-1,r8)*DEL + TRIGS(LA+I)=2.0_r8*SIN(ANGLE) + 30 CONTINUE + RETURN + 40 CONTINUE + DEL=0.5_r8*DEL + DO 50 I=2,N + ANGLE=real(I-1,r8)*DEL + TRIGS(LA+I)=SIN(ANGLE) + 50 CONTINUE + RETURN + END SUBROUTINE FFTRIG + +!================================================================================================ + + SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) +! +!----------------------------------------------------------------------- +! SUBROUTINE "VPASSM" - MULTIPLE VERSION OF "VPASSA" +! PERFORMS ONE PASS THROUGH DATA +! AS PART OF MULTIPLE COMPLEX FFT ROUTINE +! A IS FIRST REAL INPUT VECTOR +! B IS FIRST IMAGINARY INPUT VECTOR +! C IS FIRST REAL OUTPUT VECTOR +! D IS FIRST IMAGINARY OUTPUT VECTOR +! TRIGS IS PRECALCULATED TABLE OF SINES " COSINES +! INC1 IS ADDRESSING INCREMENT FOR A AND B +! INC2 IS ADDRESSING INCREMENT FOR C AND D +! INC3 IS ADDRESSING INCREMENT BETWEEN A"S & B"S +! INC4 IS ADDRESSING INCREMENT BETWEEN C"S & D"S +! LOT IS THE NUMBER OF VECTORS +! N IS LENGTH OF VECTORS +! IFAC IS CURRENT FACTOR OF N +! LA IS PRODUCT OF PREVIOUS FACTORS +!----------------------------------------------------------------------- +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +!------------------------------Arguments-------------------------------- +! + integer inc1, inc2, inc3, inc4, lot, n, ifac, la + real(r8) A(*),B(*),C(*),D(*),TRIGS(*) +! +!---------------------------Local variables----------------------------- +! + integer ie, je, ke, kd, ib, ja, ia, i, l, jb, igo, jink + integer iink, m, jbase, ibase, jump, j, kc, jc, jd, id + integer ic, k, la1, ijk, kb + + real(r8) s3, c3, s4, c4, c2, s2, s1, c1 + + real(r8) sin36, cos36, sin72, cos72, sin60 + DATA SIN36/0.587785252292473_r8/,COS36/0.809016994374947_r8/, & + SIN72/0.951056516295154_r8/,COS72/0.309016994374947_r8/, & + SIN60/0.866025403784437_r8/ +! +!----------------------------------------------------------------------- +! + M=N/IFAC + IINK=M*INC1 + JINK=LA*INC2 + JUMP=(IFAC-1)*JINK + IBASE=0 + JBASE=0 + IGO=IFAC-1 + IF (IGO.GT.4) RETURN + GO TO (10,50,90,130),IGO +! +! CODING FOR FACTOR 2 +! + 10 IA=1 + JA=1 + IB=IA+IINK + JB=JA+JINK + DO 20 L=1,LA + I=IBASE + J=JBASE + DO 15 IJK=1,LOT + C(JA+J)=A(IA+I)+A(IB+I) + D(JA+J)=B(IA+I)+B(IB+I) + C(JB+J)=A(IA+I)-A(IB+I) + D(JB+J)=B(IA+I)-B(IB+I) + I=I+INC3 + J=J+INC4 + 15 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 20 CONTINUE + IF (LA.EQ.M) RETURN + LA1=LA+1 + JBASE=JBASE+JUMP + DO 40 K=LA1,M,LA + KB=K+K-2 + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + DO 30 L=1,LA + I=IBASE + J=JBASE + DO 25 IJK=1,LOT + C(JA+J)=A(IA+I)+A(IB+I) + D(JA+J)=B(IA+I)+B(IB+I) + C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)-B(IB+I)) + D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)-B(IB+I)) + I=I+INC3 + J=J+INC4 + 25 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 30 CONTINUE + JBASE=JBASE+JUMP + 40 CONTINUE + RETURN +! +! CODING FOR FACTOR 3 +! + 50 IA=1 + JA=1 + IB=IA+IINK + JB=JA+JINK + IC=IB+IINK + JC=JB+JINK + DO 60 L=1,LA + I=IBASE + J=JBASE + DO 55 IJK=1,LOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) + D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) + C(JB+J)=(A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I))) + C(JC+J)=(A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I))) + D(JB+J)=(B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I))) + D(JC+J)=(B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I))) + I=I+INC3 + J=J+INC4 + 55 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 60 CONTINUE + IF (LA.EQ.M) RETURN + LA1=LA+1 + JBASE=JBASE+JUMP + DO 80 K=LA1,M,LA + KB=K+K-2 + KC=KB+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + DO 70 L=1,LA + I=IBASE + J=JBASE + DO 65 IJK=1,LOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) + D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) + C(JB+J)= & + C1*((A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) & + -S1*((B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) + D(JB+J)= & + S1*((A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) & + +C1*((B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) + C(JC+J)= & + C2*((A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) & + -S2*((B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) + D(JC+J)= & + S2*((A(IA+I)-0.5_r8*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) & + +C2*((B(IA+I)-0.5_r8*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) + I=I+INC3 + J=J+INC4 + 65 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 70 CONTINUE + JBASE=JBASE+JUMP + 80 CONTINUE + RETURN +! +! CODING FOR FACTOR 4 +! + 90 IA=1 + JA=1 + IB=IA+IINK + JB=JA+JINK + IC=IB+IINK + JC=JB+JINK + ID=IC+IINK + JD=JC+JINK + DO 100 L=1,LA + I=IBASE + J=JBASE + DO 95 IJK=1,LOT + C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) + C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) + D(JA+J)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) + D(JC+J)=(B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I)) + C(JB+J)=(A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I)) + C(JD+J)=(A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I)) + D(JB+J)=(B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I)) + D(JD+J)=(B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I)) + I=I+INC3 + J=J+INC4 + 95 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 100 CONTINUE + IF (LA.EQ.M) RETURN + LA1=LA+1 + JBASE=JBASE+JUMP + DO 120 K=LA1,M,LA + KB=K+K-2 + KC=KB+KB + KD=KC+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + DO 110 L=1,LA + I=IBASE + J=JBASE + DO 105 IJK=1,LOT + C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) + D(JA+J)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) + C(JC+J)= & + C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & + -S2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) + D(JC+J)= & + S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & + +C2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) + C(JB+J)= & + C1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) & + -S1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) + D(JB+J)= & + S1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) & + +C1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) + C(JD+J)= & + C3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) & + -S3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) + D(JD+J)= & + S3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) & + +C3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) + I=I+INC3 + J=J+INC4 + 105 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 110 CONTINUE + JBASE=JBASE+JUMP + 120 CONTINUE + RETURN +! +! CODING FOR FACTOR 5 +! + 130 IA=1 + JA=1 + IB=IA+IINK + JB=JA+JINK + IC=IB+IINK + JC=JB+JINK + ID=IC+IINK + JD=JC+JINK + IE=ID+IINK + JE=JD+JINK + DO 140 L=1,LA + I=IBASE + J=JBASE + DO 135 IJK=1,LOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) + D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) + C(JB+J)=(A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I))) + C(JE+J)=(A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I))) + D(JB+J)=(B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I))) + D(JE+J)=(B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I))) + C(JC+J)=(A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I))) + C(JD+J)=(A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I))) + D(JC+J)=(B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I))) + D(JD+J)=(B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I))) + I=I+INC3 + J=J+INC4 + 135 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 140 CONTINUE + IF (LA.EQ.M) RETURN + LA1=LA+1 + JBASE=JBASE+JUMP + DO 160 K=LA1,M,LA + KB=K+K-2 + KC=KB+KB + KD=KC+KB + KE=KD+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + C4=TRIGS(KE+1) + S4=TRIGS(KE+2) + DO 150 L=1,LA + I=IBASE + J=JBASE + DO 145 IJK=1,LOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) + D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) + C(JB+J)= & + C1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & + -S1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) + D(JB+J)= & + S1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & + +C1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) + C(JE+J)= & + C4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & + -S4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) + D(JE+J)= & + S4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & + +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & + +C4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & + -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) + C(JC+J)= & + C2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & + -S2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) + D(JC+J)= & + S2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & + +C2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) + C(JD+J)= & + C3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & + -S3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) + D(JD+J)= & + S3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & + +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & + +C3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & + -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) + I=I+INC3 + J=J+INC4 + 145 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC2 + 150 CONTINUE + JBASE=JBASE+JUMP + 160 CONTINUE + RETURN + END SUBROUTINE VPASSM + +!=============================================================================== + + diff --git a/src/utils/gauaw_mod.F90 b/src/utils/gauaw_mod.F90 new file mode 100644 index 0000000000..8d6f337b76 --- /dev/null +++ b/src/utils/gauaw_mod.F90 @@ -0,0 +1,252 @@ +module gauaw_mod +!----------------------------------------------------------------------- +! +! Purpose: +! +! Module to calculate the Gaussian Weights. Public interface is +! the subroutine "gauaw( a, w, k )". +! +! Method: +! +! The algorithm is described in Davis and Rabinowitz, +! Journal of Research of the NBS, V 56, Jan 1956. +! +! Author: David Williamson, Jim Hack +! +!----------------------------------------------------------------------- + use cam_abortutils, only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + +#ifdef NO_R16 + integer,parameter :: r16= selected_real_kind(12) ! 8 byte real +#else + integer,parameter :: r16= selected_real_kind(24) ! 16 byte real +#endif + + save + +! +! Public subroutines +! + + public gauaw + +! +! Variables private to routines inside this module +! + + real(r16), private :: pi ! value of pi + real(r16), private, parameter :: one = 1.0_r16 ! 1. in real(r16). Needed by atan + +! +! Functions private to routines inside this module +! + + private bsslzr + +contains + + subroutine gauaw(a, w, k) +!----------------------------------------------------------------------- +! +! Calculate sine of latitudes a(k) and weights w(k) for the gaussian +! quadrature. The algorithm is described in Davis and Rabinowitz, +! Journal of Research of the NBS, V 56, Jan 1956. +! The zeros of the bessel function j0, which are obtained from bsslzr, +! are used as a first guess for the abscissa. +! +! Modified 1/23/97 by Jim Rosinski to use real*16 arithmetic in order to +! achieve (nearly) identical weights and latitudes on all machines. +! +!---------------------------Code history-------------------------------- +! +! Original version: CCM1 +! Standardized: L. Bath, Jun 1992 +! L. Buja, Feb 1996 +! Reviewed: D. Williamson, J. Hack, Aug 1992 +! D. Williamson, J. Hack, Feb 1996 +! +!----------------------------------------------------------------------- +! +! $Id$ +! $Author$ +! +!----------------------------------------------------------------------- + implicit none +!------------------------------Arguments-------------------------------- +! + integer , intent(in) :: k ! number of latitudes pole to pole + real(r8), intent(out) :: a(k) ! sine of latitudes + real(r8), intent(out) :: w(k) ! gaussian weights +! +!---------------------------Local workspace----------------------------- +! + real(r16) sinlat(k) ! sine of latitudes + real(r16) wgt(k) ! gaussian weights + + real(r16) eps ! convergence criterion + real(r16) c ! constant combination + real(r16) fk ! real k + real(r16) xz ! abscissa estimate + real(r16) pkm1 ! | + real(r16) pkm2 ! |-polynomials + real(r16) pkmrk ! | + real(r16) pk ! | + real(r16) sp ! current iteration latitude increment + real(r16) avsp ! |sp| + real(r16) fn ! real n +#ifdef NO_R16 + parameter (eps = 1.e-15_r16) +#else + parameter (eps = 1.e-27_r16) +#endif + + integer kk ! k/2 (number of latitudes in hemisphere) + integer is ! latitude index + integer iter ! iteration counter + integer n,l ! indices +! +!----------------------------------------------------------------------- +! + pi = 4._r16*atan(one) +! +! The value eps, used for convergence tests in the iterations, +! can be changed. Newton iteration is used to find the abscissas. +! + c = (1._r16-(2._r16/pi)**2)*0.25_r16 + fk = k + kk = k/2 + call bsslzr(sinlat,kk) + do is=1,kk + xz = cos(sinlat(is)/(((fk+0.5_r16)**2+c)**0.5_r16)) +! +! This is the first approximation to xz +! + iter = 0 + 10 continue + pkm2 = 1._r16 + pkm1 = xz + iter = iter + 1 + if (iter.gt.10) then +! +! Error exit +! + call endrun ('GAUAW: no convergence in 10 iterations') + end if +! +! Computation of the legendre polynomial +! + do n=2,k + fn = n + pk = ((2._r16*fn-1._r16)*xz*pkm1-(fn-1._r16)*pkm2)/fn + pkm2 = pkm1 + pkm1 = pk + enddo + pkm1 = pkm2 + pkmrk = (fk*(pkm1-xz*pk))/(1._r16-xz**2) + sp = pk/pkmrk + xz = xz - sp + avsp = abs(sp) + if (avsp.gt.eps) go to 10 + sinlat(is) = xz + wgt(is) = (2._r16*(1._r16-xz**2))/(fk*pkm1)**2 + end do +! + if (k.ne.kk*2) then +! +! For odd k computation of weight at the equator +! + sinlat(kk+1) = 0._r16 + pk = 2._r16/fk**2 + do n=2,k,2 + fn = n + pk = pk*fn**2/(fn-1._r16)**2 + end do + wgt(kk+1) = pk + end if +! +! Complete the sets of abscissas and weights, using the symmetry. +! Also note truncation from real(r16) to real*8 +! + do n=1,kk + l = k + 1 - n + a(n) = sinlat(n) + a(l) = -sinlat(n) + + w(n) = wgt(n) + w(l) = wgt(n) + end do + + return + end subroutine gauaw + + + +!=========================================================================== + + subroutine bsslzr(bes, n) +!----------------------------------------------- +! M o d u l e s +!----------------------------------------------- +! +! Return n zeros (or if n>50, approximate zeros), of the Bessel function +! j0,in the array bes. The first 50 zeros will be given exactly, and the +! remaining zeros are computed by extrapolation,and therefore not exact. +! +! Modified 1/23/97 by Jim Rosinski to use real*16 arithmetic +! +!---------------------------Code history-------------------------------- +! +! Original version: CCM1 +! Standardized: J. Rosinski, June 1992 +! Reviewed: J. Hack, D. Williamson, August 1992 +! Reviewed: J. Hack, D. Williamson, April 1996 +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------- +! D u m m y A r g u m e n t s +!----------------------------------------------- + integer , intent(in) :: n + real(r16) , intent(inout) :: bes(n) +!----------------------------------------------- +! L o c a l V a r i a b l e s +!----------------------------------------------- + integer :: j, nn + real(r16), dimension(50) :: bz + + save bz +!----------------------------------------------- +!------------------------------Arguments-------------------------------- +! +! +!---------------------------Local workspace----------------------------- +! +! + data bz/ 2.4048255577_r16, 5.5200781103_r16, 8.6537279129_r16, 11.7915344391_r16, & + 14.9309177086_r16, 18.0710639679_r16, 21.2116366299_r16, 24.3524715308_r16, & + 27.4934791320_r16, 30.6346064684_r16, 33.7758202136_r16, 36.9170983537_r16, & + 40.0584257646_r16, 43.1997917132_r16, 46.3411883717_r16, 49.4826098974_r16, & + 52.6240518411_r16, 55.7655107550_r16, 58.9069839261_r16, 62.0484691902_r16, & + 65.1899648002_r16, 68.3314693299_r16, 71.4729816036_r16, 74.6145006437_r16, & + 77.7560256304_r16, 80.8975558711_r16, 84.0390907769_r16, 87.1806298436_r16, & + 90.3221726372_r16, 93.4637187819_r16, 96.6052679510_r16, 99.7468198587_r16, & + 102.8883742542_r16, 106.0299309165_r16, 109.1714896498_r16, 112.3130502805_r16, & + 115.4546126537_r16, 118.5961766309_r16, 121.7377420880_r16, 124.8793089132_r16, & + 128.0208770059_r16, 131.1624462752_r16, 134.3040166383_r16, 137.4455880203_r16, & + 140.5871603528_r16, 143.7287335737_r16, 146.8703076258_r16, 150.0118824570_r16, & + 153.1534580192_r16, 156.2950342685_r16/ +! + nn = n + if (n > 50) then + bes(50) = bz(50) + do j = 51, n + bes(j) = bes(j-1) + pi + end do + nn = 49 + endif + bes(:nn) = bz(:nn) + return + end subroutine bsslzr + +end module gauaw_mod diff --git a/src/utils/gmean_mod.F90 b/src/utils/gmean_mod.F90 new file mode 100644 index 0000000000..79ab89ec48 --- /dev/null +++ b/src/utils/gmean_mod.F90 @@ -0,0 +1,310 @@ +module gmean_mod + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Perform mixed layer global calculations for energy conservation checks. + ! + ! Methods: + ! Reproducible (nonscalable): + ! Gather to a master processor who does all the work. + ! Reproducible (scalable): + ! Convert to fixed point (integer representation) to enable + ! reproducibility when using MPI collectives. Results compared with + ! a nonreproducible (but scalable) algorithm using floating point + ! and MPI_Allreduce to verify the results are good enough. + ! + ! Author: Byron Boville from SOM code by Jim Rosinski/Bruce Briegleb + ! Modified: P. Worley to aggregate calculations (4/04) + ! Modified: J. White/P. Worley to introduce scalable algorithms; + ! B. Eaton to remove dycore-specific dependencies and to + ! introduce gmean_mass (10/07) + ! Modified: P. Worley to replace in-place implementation with call + ! to repro_sum. + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc, mpicom, MPI_REAL8 + use ppgrid, only: pcols, begchunk, endchunk + use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded, & + shr_reprosum_reldiffmax, shr_reprosum_recompute + use perf_mod + use cam_logfile, only: iulog + + implicit none + private + save + + public :: gmean ! compute global mean of 2D fields on physics decomposition + + interface gmean + module procedure gmean_arr + module procedure gmean_scl + end interface gmean + + private :: gmean_float_repro + private :: gmean_fixed_repro + +CONTAINS + + ! + !======================================================================== + ! + + subroutine gmean_arr (arr, arr_gmean, nflds) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics + ! chunked decomposition + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: arr(pcols,begchunk:endchunk,nflds) + ! Input array, chunked + real(r8), intent(out):: arr_gmean(nflds) ! global means + ! + ! Local workspace + ! + real(r8) :: rel_diff(2,nflds) ! relative differences between + ! 'fast' reproducible and + ! nonreproducible means + integer :: ifld ! field index + logical :: write_warning + ! + !----------------------------------------------------------------------- + ! + call t_startf ('gmean_fixed_repro') + call gmean_fixed_repro(arr, arr_gmean, rel_diff, nflds) + call t_stopf ('gmean_fixed_repro') + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = masterproc + if ( shr_reprosum_tolExceeded('gmean', nflds, write_warning, & + iulog, rel_diff) ) then + if ( shr_reprosum_recompute ) then + do ifld=1,nflds + if ( rel_diff(1,ifld) > shr_reprosum_reldiffmax ) then + call t_startf ('gmean_float_repro') + call gmean_float_repro(arr(:,:,ifld), arr_gmean(ifld), 1) + call t_stopf ('gmean_float_repro') + endif + enddo + endif + endif + + return + end subroutine gmean_arr + + ! + !======================================================================== + ! + + subroutine gmean_scl (arr, gmean) + use phys_grid, only : get_ncols_p + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics + ! chunked decomposition + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + real(r8), intent(in) :: arr(pcols,begchunk:endchunk) + ! Input array, chunked + real(r8), intent(out):: gmean ! global means + ! + ! Local workspace + ! + integer, parameter :: nflds = 1 + real(r8) :: gmean_array(nflds) + real(r8) :: array(pcols,begchunk:endchunk,nflds) + integer :: ncols, lchnk + + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + array(:ncols,lchnk,1) = arr(:ncols,lchnk) + enddo + call gmean_arr(array,gmean_array,nflds) + gmean = gmean_array(1) + + end subroutine gmean_scl + +! +!======================================================================== +! + + subroutine gmean_float_repro (arr, arr_gmean, nflds) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the global mean of each field in "arr" in the physics +! chunked decomposition - all work is done on the masterproc to avoid +! order of operations differences and assure bfb reproducibility. +! +!----------------------------------------------------------------------- + + use dycore, only: dycore_is + use phys_grid, only: gather_chunk_to_field + use dyn_grid, only: get_horiz_grid_dim_d, get_horiz_grid_d, get_dyn_grid_parm_real1d + use physconst, only: pi +! +! Arguments +! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: & + arr(pcols,begchunk:endchunk,nflds) ! Input array, chunked + real(r8), intent(out):: arr_gmean(nflds) ! global means +! +! Local workspace +! + real(r8), pointer :: w(:) + real(r8) :: zmean ! zonal mean value + real(r8) :: tmean ! temp global mean value + integer :: i, j, ifld, n ! longitude, latitude, field, + ! and global column indices + integer :: hdim1, hdim2 ! dimensions of rectangular horizontal + ! grid data structure, If 1D data + ! structure, then hdim2_d == 1. + integer :: ngcols ! global column count (all) + + integer :: ierr ! MPI error return + ! rectangular version of arr + real(r8), allocatable :: arr_field(:,:,:) + + ! column integration weight (from dynamics) + real(r8), dimension(:), allocatable :: wght_d + +! +!----------------------------------------------------------------------- +! + call get_horiz_grid_dim_d(hdim1, hdim2) + allocate(arr_field(hdim1,hdim2,nflds)) + + arr_field(:,:,:) = 0.0_r8 + call gather_chunk_to_field (1, 1, nflds, hdim1, arr, arr_field) + + if (masterproc) then + + if (dycore_is('UNSTRUCTURED')) then + + ngcols = hdim1*hdim2 + allocate ( wght_d(1:ngcols) ) + + wght_d = 0.0_r8 + call get_horiz_grid_d(ngcols, wght_d_out=wght_d) + + do ifld=1,nflds + arr_gmean(ifld) = 0._r8 + do j=1,hdim2 + do i=1,hdim1 + n = (j-1)*hdim1 + i + arr_gmean(ifld) = arr_gmean(ifld) + & + arr_field(i,j,ifld)*wght_d(n) + end do + end do + arr_gmean(ifld) = arr_gmean(ifld) / (4.0_r8 * pi) + end do + + deallocate ( wght_d ) + + else + w => get_dyn_grid_parm_real1d('w') + do ifld=1,nflds + tmean = 0._r8 + do j=1,hdim2 + zmean = 0._r8 + do i=1,hdim1 + zmean = zmean + arr_field(i,j,ifld) + end do + tmean = tmean + zmean * 0.5_r8*w(j)/hdim1 + end do + arr_gmean(ifld) = tmean + end do + + end if + + end if + + call mpi_bcast (arr_gmean, nflds, MPI_REAL8, 0, mpicom, ierr) + deallocate(arr_field) + + return + + end subroutine gmean_float_repro + +! +!======================================================================== +! + subroutine gmean_fixed_repro (arr, arr_gmean, rel_diff, nflds) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the global mean of each field in "arr" in the physics +! chunked decomposition with a reproducible yet scalable implementation +! based on a fixed-point algorithm. +! +!----------------------------------------------------------------------- + use phys_grid, only : get_ncols_p, get_wght_all_p, ngcols_p, & + get_nlcols_p + use physconst, only: pi +! +! Arguments +! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: & + arr(pcols,begchunk:endchunk,nflds) ! Input array, chunked + real(r8), intent(out):: arr_gmean(nflds) ! global means + real(r8), intent(out):: rel_diff(2,nflds) ! relative and absolute + ! differences between + ! reproducible and nonreproducible + ! means +! +! Local workspace +! + integer :: lchnk, i, ifld ! chunk, column, field indices + integer :: ncols ! number of columns in current chunk + integer :: count ! summand count + integer :: ierr ! MPI error return + + real(r8) :: wght(pcols) ! column for integration weights + real(r8), allocatable :: xfld(:,:) ! weighted summands + integer :: nlcols +! +!----------------------------------------------------------------------- +! + nlcols = get_nlcols_p() + allocate(xfld(nlcols, nflds)) + +! pre-weight summands + do ifld=1,nflds + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + call get_wght_all_p(lchnk, ncols, wght) + do i=1,ncols + count = count + 1 + xfld(count,ifld) = arr(i,lchnk,ifld)*wght(i) + end do + end do + end do + +! call fixed-point algorithm + call shr_reprosum_calc (xfld, arr_gmean, count, nlcols, nflds, & + gbl_count=ngcols_p, commid=mpicom, rel_diff=rel_diff) + + deallocate(xfld) +! final normalization + arr_gmean(:) = arr_gmean(:) / (4.0_r8 * pi) + + return + + end subroutine gmean_fixed_repro + +end module gmean_mod diff --git a/src/utils/hycoef.F90 b/src/utils/hycoef.F90 new file mode 100644 index 0000000000..f08ff711e1 --- /dev/null +++ b/src/utils/hycoef.F90 @@ -0,0 +1,394 @@ +module hycoef + +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc +use pmgrid, only: plev, plevp +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use pio, only: file_desc_t, var_desc_t, & + pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & + pio_double, pio_def_dim, pio_def_var, & + pio_put_var, pio_get_var, & + pio_seterrorhandling, PIO_BCAST_ERROR, PIO_NOERR + +implicit none +private +save + +!----------------------------------------------------------------------- +! +! Purpose: Hybrid level definitions: p = a*p0 + b*ps +! interfaces p(k) = hyai(k)*ps0 + hybi(k)*ps +! midpoints p(k) = hyam(k)*ps0 + hybm(k)*ps +! +!----------------------------------------------------------------------- + +real(r8), public, target :: hyai(plevp) ! ps0 component of hybrid coordinate - interfaces +real(r8), public, target :: hyam(plev) ! ps0 component of hybrid coordinate - midpoints +real(r8), public, target :: hybi(plevp) ! ps component of hybrid coordinate - interfaces +real(r8), public, target :: hybm(plev) ! ps component of hybrid coordinate - midpoints + +real(r8), public :: etamid(plev) ! hybrid coordinate - midpoints + +real(r8), public :: hybd(plev) ! difference in b (hybi) across layers +real(r8), public :: hypi(plevp) ! reference pressures at interfaces +real(r8), public :: hypm(plev) ! reference pressures at midpoints +real(r8), public :: hypd(plev) ! reference pressure layer thickness + +real(r8), public, protected :: ps0 = 1.0e5_r8 ! Base state surface pressure (pascals) +real(r8), public, protected :: psr = 1.0e5_r8 ! Reference surface pressure (pascals) + +real(r8), target :: alev(plev) ! level values (pascals) for 'lev' coord +real(r8), target :: ailev(plevp) ! interface level values for 'ilev' coord + +integer, public :: nprlev ! number of pure pressure levels at top + +public hycoef_init + +type(var_desc_t) :: hyam_desc, hyai_desc, hybm_desc, hybi_desc, p0_desc +public init_restart_hycoef, write_restart_hycoef + +!======================================================================= +contains +!======================================================================= + +subroutine hycoef_init(file, psdry) + + use cam_history_support, only: add_hist_coord, add_vert_coord, formula_terms_t + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Defines the locations of model interfaces from input data in the + ! hybrid coordinate scheme. Actual pressure values of model level + ! interfaces are determined elsewhere from the fields set here. + ! + ! Method: + ! the following fields are set: + ! hyai fraction of reference pressure used for interface pressures + ! hyam fraction of reference pressure used for midpoint pressures + ! hybi fraction of surface pressure used for interface pressures + ! hybm fraction of surface pressure used for midpoint pressures + ! hybd difference of hybi's + ! hypi reference state interface pressures + ! hypm reference state midpoint pressures + ! hypd reference state layer thicknesses + ! hypdln reference state layer thicknesses (log p) + ! hyalph distance from interface to level (used in integrals) + ! prsfac log pressure extrapolation factor (used to compute psl) + ! + ! Author: B. Boville + ! + !----------------------------------------------------------------------- + + ! arguments + type(file_desc_t), intent(inout) :: file + logical, optional, intent(in) :: psdry ! set true when coordinate is based + ! on dry surface pressure + + ! local variables + integer :: k ! Level index + logical :: dry_coord + real(r8) :: amean, bmean, atest, btest, eps + type(formula_terms_t) :: formula_terms ! For the 'lev' and 'ilev' coords + !----------------------------------------------------------------------- + + ! check for dry pressure coordinate (default is moist) + dry_coord = .false. + if (present(psdry)) dry_coord = psdry + + ! read hybrid coeficients + call hycoef_read(file) + + ! Set layer locations + nprlev = 0 + do k=1,plev + + ! Interfaces. Set nprlev to the interface above, the first time a + ! nonzero surface pressure contribution is found. "nprlev" + ! identifies the lowest pure pressure interface. + + if (nprlev==0 .and. hybi(k).ne.0.0_r8) nprlev = k - 1 + end do + + ! Set nprlev if no nonzero b's have been found. All interfaces are + ! pure pressure. A pure pressure model requires other changes as well. + if (nprlev==0) nprlev = plev + 2 + + ! Set delta sigma part of layer thickness and reference state midpoint + ! pressures + do k=1,plev + hybd(k) = hybi(k+1) - hybi(k) + hypm(k) = hyam(k)*ps0 + hybm(k)*psr + etamid(k) = hyam(k) + hybm(k) + end do + + ! Reference state interface pressures + do k=1,plevp + hypi(k) = hyai(k)*ps0 + hybi(k)*psr + end do + + ! Reference state layer thicknesses + do k=1,plev + hypd(k) = hypi(k+1) - hypi(k) + end do + + ! Test that A's and B's at full levels are arithmetic means of A's and + ! B's at interfaces + eps = 1.e-05_r8 + do k = 1,plev + amean = ( hyai(k+1) + hyai(k) )*0.5_r8 + bmean = ( hybi(k+1) + hybi(k) )*0.5_r8 + if(amean == 0._r8 .and. hyam(k) == 0._r8) then + atest = 0._r8 + else + atest = abs( amean - hyam(k) )/ ( 0.5_r8*( abs(amean + hyam(k)) ) ) + endif + if(bmean == 0._r8 .and. hybm(k) == 0._r8) then + btest = 0._r8 + else + btest = abs( bmean - hybm(k) )/ ( 0.5_r8*( abs(bmean + hybm(k)) ) ) + endif + if (atest > eps) then + if (masterproc) then + write(iulog,9850) + write(iulog,*)'k,atest,eps=',k,atest,eps + end if + end if + + if (btest > eps) then + if (masterproc) then + write(iulog,9850) + write(iulog,*)'k,btest,eps=',k,btest,eps + end if + end if + end do + + ! Add the information for the 'lev' and 'ilev' mdim history coordinates + ! + ! The hybrid coordinate used by the SE dycore is based on a dry surface + ! pressure. Hence it is the dry pressure rather than actual pressure + ! that is computed by the formula_terms attribute. This coordinate is + ! not described by the formula + ! atmosphere_hybrid_sigma_pressure_coordinate since the formula + ! associated with that name uses actual pressure values. Furthermore, + ! the actual pressure field cannot be reconstructed from the hybrid + ! coefficients and the surface pressure field. Hence in the case of a + ! dry coordinate we add neither the standard_name nor the formula_terms + ! attributes to the lev and ilev coordinates. + + ! 0.01 converts Pascals to millibars + alev(:plev) = 0.01_r8*ps0*(hyam(:plev) + hybm(:plev)) + ailev(:plevp) = 0.01_r8*ps0*(hyai(:plevp) + hybi(:plevp)) + + if (dry_coord) then + call add_vert_coord('lev', plev, & + 'hybrid level at midpoints (1000*(A+B))', 'hPa', alev, & + positive='down') + call add_hist_coord('hyam', plev, & + 'hybrid A coefficient at layer midpoints', '1', hyam, dimname='lev') + call add_hist_coord('hybm', plev, & + 'hybrid B coefficient at layer midpoints', '1', hybm, dimname='lev') + else + + formula_terms%a_name = 'hyam' + formula_terms%a_long_name = 'hybrid A coefficient at layer midpoints' + formula_terms%a_values => hyam + formula_terms%b_name = 'hybm' + formula_terms%b_long_name = 'hybrid B coefficient at layer midpoints' + formula_terms%b_values => hybm + formula_terms%p0_name = 'P0' + formula_terms%p0_long_name = 'reference pressure' + formula_terms%p0_units = 'Pa' + formula_terms%p0_value = ps0 + formula_terms%ps_name = 'PS' + + call add_vert_coord('lev', plev, & + 'hybrid level at midpoints (1000*(A+B))', 'hPa', alev, & + positive='down', & + standard_name='atmosphere_hybrid_sigma_pressure_coordinate', & + formula_terms=formula_terms) + end if + + if (dry_coord) then + call add_vert_coord('ilev', plevp, & + 'hybrid level at interfaces (1000*(A+B))', 'hPa', ailev, & + positive='down') + call add_hist_coord('hyai', plevp, & + 'hybrid A coefficient at layer interfaces', '1', hyai, dimname='ilev') + call add_hist_coord('hybi', plevp, & + 'hybrid B coefficient at layer interfaces', '1', hybi, dimname='ilev') + else + formula_terms%a_name = 'hyai' + formula_terms%a_long_name = 'hybrid A coefficient at layer interfaces' + formula_terms%a_values => hyai + formula_terms%b_name = 'hybi' + formula_terms%b_long_name = 'hybrid B coefficient at layer interfaces' + formula_terms%b_values => hybi + formula_terms%p0_name = 'P0' + formula_terms%p0_long_name = 'reference pressure' + formula_terms%p0_units = 'Pa' + formula_terms%p0_value = ps0 + formula_terms%ps_name = 'PS' + + call add_vert_coord('ilev', plevp, & + 'hybrid level at interfaces (1000*(A+B))', 'hPa', ailev, & + positive='down', & + standard_name='atmosphere_hybrid_sigma_pressure_coordinate', & + formula_terms=formula_terms) + end if + + if (masterproc) then + write(iulog,'(a)')' Layer Locations (*1000) ' + do k=1,plev + write(iulog,9800)k,hyai(k),hybi(k),hyai(k)+hybi(k) + write(iulog,9810) hyam(k), hybm(k), hyam(k)+hybm(k) + end do + + write(iulog,9800)plevp,hyai(plevp),hybi(plevp),hyai(plevp)+hybi(plevp) + write(iulog,9820) + do k=1,plev + write(iulog,9830) k, hypi(k) + write(iulog,9840) hypm(k), hypd(k) + end do + write(iulog,9830) plevp, hypi(plevp) + end if + +9800 format( 1x, i3, 3p, 3(f10.4,10x) ) +9810 format( 1x, 3x, 3p, 3(10x,f10.4) ) +9820 format(1x,'reference pressures (Pa)') +9830 format(1x,i3,f15.4) +9840 format(1x,3x,15x,2f15.4) +9850 format('HYCOEF: A and/or B vertical level coefficients at full',/, & + ' levels are not the arithmetic mean of half-level values') + +end subroutine hycoef_init + +!======================================================================= + +subroutine init_restart_hycoef(File, vdimids) + + type(file_desc_t), intent(inout) :: File + integer, intent(out) :: vdimids(:) + + ! PIO traps errors internally, no need to check ierr + + integer :: ierr + + ierr = PIO_Def_Dim(File, 'lev', plev, vdimids(1)) + ierr = PIO_Def_Dim(File, 'ilev', plevp, vdimids(2)) + + ierr = pio_def_var(File, 'hyai', pio_double, vdimids(2:2), hyai_desc) + ierr = pio_def_var(File, 'hyam', pio_double, vdimids(1:1), hyam_desc) + ierr = pio_def_var(File, 'hybi', pio_double, vdimids(2:2), hybi_desc) + ierr = pio_def_var(File, 'hybm', pio_double, vdimids(1:1), hybm_desc) + + ierr = pio_def_var(File, 'P0', pio_double, p0_desc) + +end subroutine init_restart_hycoef + +!======================================================================= + +subroutine write_restart_hycoef(file) + + type(file_desc_t), intent(inout) :: File + + ! PIO traps errors internally, no need to check ierr + + integer :: ierr + + ierr = pio_put_var(File, hyai_desc, hyai) + ierr = pio_put_var(File, hyam_desc, hyam) + ierr = pio_put_var(File, hybi_desc, hybi) + ierr = pio_put_var(File, hybm_desc, hybm) + + ierr = pio_put_var(File, p0_desc, ps0) + +end subroutine write_restart_hycoef + +!======================================================================= + +subroutine hycoef_read(File) + + ! This code is used both for initial and restart reading. + + type(file_desc_t), intent(inout) :: File + + integer :: flev, filev, lev_dimid, ierr + integer :: pio_errtype + + type(var_desc_t) :: p0_desc + + character(len=*), parameter :: routine = 'hycoef_read' + !---------------------------------------------------------------------------- + + ! PIO traps errors internally, no need to check ierr + + ierr = PIO_Inq_DimID(File, 'lev', lev_dimid) + ierr = PIO_Inq_dimlen(File, lev_dimid, flev) + if (plev /= flev) then + write(iulog,*) routine//': ERROR: file lev does not match model. lev (file, model):',flev, plev + call endrun(routine//': ERROR: file lev does not match model.') + end if + + ierr = PIO_Inq_DimID(File, 'ilev', lev_dimid) + ierr = PIO_Inq_dimlen(File, lev_dimid, filev) + if (plevp /= filev) then + write(iulog,*) routine//':ERROR: file ilev does not match model plevp (file, model):',filev, plevp + call endrun(routine//':ERROR: file ilev does not match model.') + end if + + ierr = pio_inq_varid(File, 'hyai', hyai_desc) + ierr = pio_inq_varid(File, 'hyam', hyam_desc) + ierr = pio_inq_varid(File, 'hybi', hybi_desc) + ierr = pio_inq_varid(File, 'hybm', hybm_desc) + + ierr = pio_get_var(File, hyai_desc, hyai) + ierr = pio_get_var(File, hybi_desc, hybi) + ierr = pio_get_var(File, hyam_desc, hyam) + ierr = pio_get_var(File, hybm_desc, hybm) + + if (masterproc) then + write(iulog,*) routine//': read hyai, hybi, hyam, hybm' + end if + + ! Check whether file contains value for P0. If it does then use it + + ! Set PIO to return error codes. + call pio_seterrorhandling(file, PIO_BCAST_ERROR, pio_errtype) + + ierr = pio_inq_varid(file, 'P0', p0_desc) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(file, p0_desc, ps0) + if (ierr /= PIO_NOERR) then + call endrun(routine//': reading P0.') + end if + psr = ps0 + + if (masterproc) then + write(iulog,*) routine//': read P0 value: ', ps0 + end if + + end if + + ! Put the error handling back the way it was + call pio_seterrorhandling(file, pio_errtype) + +#if ( defined OFFLINE_DYN ) + ! make sure top interface is non zero for fv dycore + if (hyai(1) .eq. 0._r8) then + if (hybm(1) .ne. 0.0_r8) then + hyai(1) = hybm(1)*1.e-2_r8 + else if (hyam(1) .ne. 0.0_r8) then + hyai(1) = hyam(1)*1.e-2_r8 + else + call endrun('Not able to set hyai(1) to non-zero.') + end if + end if +#endif + +end subroutine hycoef_read + +!======================================================================= + +end module hycoef diff --git a/src/utils/infnan.F90 b/src/utils/infnan.F90 new file mode 100644 index 0000000000..f963d3b7a0 --- /dev/null +++ b/src/utils/infnan.F90 @@ -0,0 +1,33 @@ +module infnan + + ! Relabel shr_infnan public members, just for the convenience + ! of having shorter names. + +use shr_infnan_mod, only: & + isnan => shr_infnan_isnan, & + isinf => shr_infnan_isinf, & + isposinf => shr_infnan_isposinf, & + isneginf => shr_infnan_isneginf, & + nan => shr_infnan_nan, & + inf => shr_infnan_inf, & + posinf => shr_infnan_posinf, & + neginf => shr_infnan_neginf, & + assignment(=) + +implicit none +private +save + +! Weird thing here: if you make the module public, +! ifort 12 has an ICE. But ifort 13 has been fixed. +public :: isnan +public :: isinf +public :: isposinf +public :: isneginf +public :: nan +public :: inf +public :: posinf +public :: neginf +public :: assignment(=) + +end module infnan diff --git a/src/utils/interpolate_data.F90 b/src/utils/interpolate_data.F90 new file mode 100644 index 0000000000..142e3600ed --- /dev/null +++ b/src/utils/interpolate_data.F90 @@ -0,0 +1,1230 @@ +module interpolate_data +! Description: +! Routines for interpolation of data in latitude, longitude and time. +! +! Author: Gathered from a number of places and put into the current format by Jim Edwards +! +! Modules Used: +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + implicit none + private +! +! Public Methods: +! + + public :: interp_type, lininterp, vertinterp, bilin, get_timeinterp_factors + public :: lininterp_init, lininterp_finish + type interp_type + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + end type interp_type + interface lininterp + module procedure lininterp_original + module procedure lininterp_full1d + module procedure lininterp1d + module procedure lininterp2d2d + module procedure lininterp2d1d + module procedure lininterp3d2d + end interface + +integer, parameter, public :: extrap_method_zero = 0 +integer, parameter, public :: extrap_method_bndry = 1 +integer, parameter, public :: extrap_method_cycle = 2 + +contains + subroutine lininterp_full1d (arrin, yin, nin, arrout, yout, nout) + integer, intent(in) :: nin, nout + real(r8), intent(in) :: arrin(nin), yin(nin), yout(nout) + real(r8), intent(out) :: arrout(nout) + type (interp_type) :: interp_wgts + + call lininterp_init(yin, nin, yout, nout, extrap_method_bndry, interp_wgts) + call lininterp1d(arrin, nin, arrout, nout, interp_wgts) + call lininterp_finish(interp_wgts) + + end subroutine lininterp_full1d + + subroutine lininterp_init(yin, nin, yout, nout, extrap_method, interp_wgts, & + cyclicmin, cyclicmax) +! +! Description: +! Initialize a variable of type(interp_type) with weights for linear interpolation. +! this variable can then be used in calls to lininterp1d and lininterp2d. +! yin is a 1d array of length nin of locations to interpolate from - this array must +! be monotonic but can be increasing or decreasing +! yout is a 1d array of length nout of locations to interpolate to, this array need +! not be ordered +! extrap_method determines how to handle yout points beyond the bounds of yin +! if 0 set values outside output grid to 0 +! if 1 set to boundary value +! if 2 set to cyclic boundaries +! optional values cyclicmin and cyclicmax can be used to set the bounds of the +! cyclic mapping - these default to 0 and 360. +! + + integer, intent(in) :: nin + integer, intent(in) :: nout + real(r8), intent(in) :: yin(:) ! input mesh + real(r8), intent(in) :: yout(:) ! output mesh + integer, intent(in) :: extrap_method ! if 0 set values outside output grid to 0 + ! if 1 set to boundary value + ! if 2 set to cyclic boundaries + real(r8), intent(in), optional :: cyclicmin, cyclicmax + + type (interp_type), intent(out) :: interp_wgts + real(r8) :: cmin, cmax + real(r8) :: extrap + real(r8) :: dyinwrap + real(r8) :: ratio + real(r8) :: avgdyin + integer :: i, j, icount + integer :: jj + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + logical :: increasing + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nin.lt.2) then + call endrun('LININTERP: Must have at least 2 input points for interpolation') + end if + if(present(cyclicmin)) then + cmin=cyclicmin + else + cmin=0_r8 + end if + if(present(cyclicmax)) then + cmax=cyclicmax + else + cmax=360_r8 + end if + if(cmax<=cmin) then + call endrun('LININTERP: cyclic min value must be < max value') + end if + increasing=.true. + icount = 0 + do j=1,nin-1 + if (yin(j).gt.yin(j+1)) icount = icount + 1 + end do + if(icount.eq.nin-1) then + increasing = .false. + icount=0 + endif + if (icount.gt.0) then + call endrun('LININTERP: Non-monotonic input coordinate array found') + end if + allocate(interp_wgts%jjm(nout), & + interp_wgts%jjp(nout), & + interp_wgts%wgts(nout), & + interp_wgts%wgtn(nout)) + + jjm => interp_wgts%jjm + jjp => interp_wgts%jjp + wgts => interp_wgts%wgts + wgtn => interp_wgts%wgtn + + ! + ! Initialize index arrays for later checking + ! + jjm = 0 + jjp = 0 + + extrap = 0._r8 + select case (extrap_method) + case (extrap_method_zero) + ! + ! For values which extend beyond boundaries, set weights + ! such that values will be 0. + ! + do j=1,nout + if(increasing) then + if (yout(j).lt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 0._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + else if (yout(j).gt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 0._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + end if + else + if (yout(j).gt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 0._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + else if (yout(j).lt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 0._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + end if + end if + end do + case (extrap_method_bndry) + ! + ! For values which extend beyond boundaries, set weights + ! such that values will just be copied. + ! + do j=1,nout + if(increasing) then + if (yout(j).le.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + else if (yout(j).gt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + end if + else + if (yout(j).gt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + else if (yout(j).le.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap = extrap + 1._r8 + end if + end if + end do + case (extrap_method_cycle) + ! + ! For values which extend beyond boundaries, set weights + ! for circular boundaries + ! + dyinwrap = yin(1) + (cmax-cmin) - yin(nin) + avgdyin = abs(yin(nin)-yin(1))/(nin-1._r8) + ratio = dyinwrap/avgdyin + if (ratio < 0.9_r8 .or. ratio > 1.1_r8) then + write(iulog,*) 'Lininterp: Bad dyinwrap value =',dyinwrap,& + ' avg=', avgdyin, yin(1),yin(nin) + call endrun('interpolate_data') + end if + + do j=1,nout + if(increasing) then + if (yout(j) <= yin(1)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin) - yin(nin))/dyinwrap + else if (yout(j) > yin(nin)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)+(cmax-cmin)-yout(j))/dyinwrap + wgtn(j) = (yout(j)-yin(nin))/dyinwrap + end if + else + if (yout(j) > yin(1)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin) - yin(nin))/dyinwrap + else if (yout(j) <= yin(nin)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)+(cmax-cmin)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin)-yin(nin))/dyinwrap + end if + + endif + end do + end select + + ! + ! Loop though output indices finding input indices and weights + ! + if(increasing) then + do j=1,nout + do jj=1,nin-1 + if (yout(j).gt.yin(jj) .and. yout(j).le.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + else + do j=1,nout + do jj=1,nin-1 + if (yout(j).le.yin(jj) .and. yout(j).gt.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + end if + + ! + ! Check that interp/extrap points have been found for all outputs + ! + icount = 0 + do j=1,nout + if (jjm(j).eq.0 .or. jjp(j).eq.0) icount = icount + 1 + ratio=wgts(j)+wgtn(j) + if((ratio<0.9_r8.or.ratio>1.1_r8).and.extrap_method.ne.0) then + write(iulog,*) j, wgts(j),wgtn(j),jjm(j),jjp(j), increasing,extrap_method + call endrun('Bad weight computed in LININTERP_init') + end if + end do + if (icount.gt.0) then + call endrun('LININTERP: Point found without interp indices') + end if + + end subroutine lininterp_init + + subroutine lininterp1d (arrin, n1, arrout, m1, interp_wgts) + !----------------------------------------------------------------------- + ! + ! Purpose: Do a linear interpolation from input mesh to output + ! mesh with weights as set in lininterp_init. + ! + ! + ! Author: Jim Edwards + ! + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1 ! number of input latitudes + integer, intent(in) :: m1 ! number of output latitudes + + real(r8), intent(in) :: arrin(n1) ! input array of values to interpolate + type(interp_type), intent(in) :: interp_wgts + real(r8), intent(out) :: arrout(m1) ! interpolated array + + ! + ! Local workspace + ! + integer j ! latitude indices + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + + + jjm => interp_wgts%jjm + jjp => interp_wgts%jjp + wgts => interp_wgts%wgts + wgtn => interp_wgts%wgtn + + ! + ! Do the interpolation + ! + do j=1,m1 + arrout(j) = arrin(jjm(j))*wgts(j) + arrin(jjp(j))*wgtn(j) + end do + + return + end subroutine lininterp1d + + subroutine lininterp2d2d(arrin, n1, n2, arrout, m1, m2, wgt1, wgt2) + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1, n2, m1, m2 + real(r8), intent(in) :: arrin(n1,n2) ! input array of values to interpolate + type(interp_type), intent(in) :: wgt1, wgt2 + real(r8), intent(out) :: arrout(m1,m2) ! interpolated array + ! + ! locals + ! + integer i,j ! indices + integer, pointer :: iim(:), jjm(:) + integer, pointer :: iip(:), jjp(:) + + real(r8), pointer :: wgts1(:), wgts2(:) + real(r8), pointer :: wgtn1(:), wgtn2(:) + + real(r8) :: arrtmp(n1,m2) + + + jjm => wgt2%jjm + jjp => wgt2%jjp + wgts2 => wgt2%wgts + wgtn2 => wgt2%wgtn + + iim => wgt1%jjm + iip => wgt1%jjp + wgts1 => wgt1%wgts + wgtn1 => wgt1%wgtn + + do j=1,m2 + do i=1,n1 + arrtmp(i,j) = arrin(i,jjm(j))*wgts2(j) + arrin(i,jjp(j))*wgtn2(j) + end do + end do + + do j=1,m2 + do i=1,m1 + arrout(i,j) = arrtmp(iim(i),j)*wgts1(i) + arrtmp(iip(i),j)*wgtn1(i) + end do + end do + + end subroutine lininterp2d2d + subroutine lininterp2d1d(arrin, n1, n2, arrout, m1, wgt1, wgt2, fldname) + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1, n2, m1 + real(r8), intent(in) :: arrin(n1,n2) ! input array of values to interpolate + type(interp_type), intent(in) :: wgt1, wgt2 + real(r8), intent(out) :: arrout(m1) ! interpolated array + character(len=*), intent(in), optional :: fldname(:) + ! + ! locals + ! + integer i ! indices + integer, pointer :: iim(:), jjm(:) + integer, pointer :: iip(:), jjp(:) + + real(r8), pointer :: wgts(:), wgte(:) + real(r8), pointer :: wgtn(:), wgtw(:) + + jjm => wgt2%jjm + jjp => wgt2%jjp + wgts => wgt2%wgts + wgtn => wgt2%wgtn + + iim => wgt1%jjm + iip => wgt1%jjp + wgtw => wgt1%wgts + wgte => wgt1%wgtn + + do i=1,m1 + arrout(i) = arrin(iim(i),jjm(i))*wgtw(i)*wgts(i)+arrin(iip(i),jjm(i))*wgte(i)*wgts(i) + & + arrin(iim(i),jjp(i))*wgtw(i)*wgtn(i)+arrin(iip(i),jjp(i))*wgte(i)*wgtn(i) + end do + + + end subroutine lininterp2d1d + subroutine lininterp3d2d(arrin, n1, n2, n3, arrout, m1, len1, wgt1, wgt2) + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1, n2, n3, m1, len1 ! m1 is to len1 as ncols is to pcols + real(r8), intent(in) :: arrin(n1,n2,n3) ! input array of values to interpolate + type(interp_type), intent(in) :: wgt1, wgt2 + real(r8), intent(out) :: arrout(len1, n3) ! interpolated array + + ! + ! locals + ! + integer i, k ! indices + integer, pointer :: iim(:), jjm(:) + integer, pointer :: iip(:), jjp(:) + + real(r8), pointer :: wgts(:), wgte(:) + real(r8), pointer :: wgtn(:), wgtw(:) + + jjm => wgt2%jjm + jjp => wgt2%jjp + wgts => wgt2%wgts + wgtn => wgt2%wgtn + + iim => wgt1%jjm + iip => wgt1%jjp + wgtw => wgt1%wgts + wgte => wgt1%wgtn + + do k=1,n3 + do i=1,m1 + arrout(i,k) = arrin(iim(i),jjm(i),k)*wgtw(i)*wgts(i)+arrin(iip(i),jjm(i),k)*wgte(i)*wgts(i) + & + arrin(iim(i),jjp(i),k)*wgtw(i)*wgtn(i)+arrin(iip(i),jjp(i),k)*wgte(i)*wgtn(i) + end do + end do + + end subroutine lininterp3d2d + + + + + subroutine lininterp_finish(interp_wgts) + type(interp_type) :: interp_wgts + + deallocate(interp_wgts%jjm, & + interp_wgts%jjp, & + interp_wgts%wgts, & + interp_wgts%wgtn) + + nullify(interp_wgts%jjm, & + interp_wgts%jjp, & + interp_wgts%wgts, & + interp_wgts%wgtn) + end subroutine lininterp_finish + + subroutine lininterp_original (arrin, yin, nlev, nlatin, arrout, & + yout, nlatout) + !----------------------------------------------------------------------- + ! + ! Purpose: Do a linear interpolation from input mesh defined by yin to output + ! mesh defined by yout. Where extrapolation is necessary, values will + ! be copied from the extreme edge of the input grid. Vectorization is over + ! the vertical (nlev) dimension. + ! + ! Method: Check validity of input, then determine weights, then do the N-S interpolation. + ! + ! Author: Jim Rosinski + ! Modified: Jim Edwards so that there is no requirement of monotonacity on the yout array + ! + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: nlev ! number of vertical levels + integer, intent(in) :: nlatin ! number of input latitudes + integer, intent(in) :: nlatout ! number of output latitudes + + real(r8), intent(in) :: arrin(nlev,nlatin) ! input array of values to interpolate + real(r8), intent(in) :: yin(nlatin) ! input mesh + real(r8), intent(in) :: yout(nlatout) ! output mesh + + real(r8), intent(out) :: arrout(nlev,nlatout) ! interpolated array + ! + ! Local workspace + ! + integer j, jj ! latitude indices + integer jjprev ! latitude indices + integer k ! level index + integer icount ! number of values + + real(r8) extrap ! percent grid non-overlap + ! + ! Dynamic + ! + integer :: jjm(nlatout) + integer :: jjp(nlatout) + + real(r8) :: wgts(nlatout) + real(r8) :: wgtn(nlatout) + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nlatin.lt.2) then + call endrun('LININTERP: Must have at least 2 input points for interpolation') + end if + + icount = 0 + do j=1,nlatin-1 + if (yin(j).gt.yin(j+1)) icount = icount + 1 + end do + + + if (icount.gt.0) then + call endrun('LININTERP: Non-monotonic coordinate array(s) found') + end if + ! + ! Initialize index arrays for later checking + ! + do j=1,nlatout + jjm(j) = 0 + jjp(j) = 0 + end do + ! + ! For values which extend beyond N and S boundaries, set weights + ! such that values will just be copied. + ! + extrap = 0._r8 + + do j=1,nlatout + if (yout(j).le.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap=extrap+1._r8 + else if (yout(j).gt.yin(nlatin)) then + jjm(j) = nlatin + jjp(j) = nlatin + wgts(j) = 1._r8 + wgtn(j) = 0._r8 + extrap=extrap+1._r8 + endif + end do + + ! + ! Loop though output indices finding input indices and weights + ! + do j=1,nlatout + do jj=1,nlatin-1 + if (yout(j).gt.yin(jj) .and. yout(j).le.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + ! + ! Check that interp/extrap points have been found for all outputs + ! + icount = 0 + do j=1,nlatout + if (jjm(j).eq.0 .or. jjp(j).eq.0) then + icount = icount + 1 + end if + end do + if (icount.gt.0) then + call endrun('LININTERP: Point found without interp indices') + end if + ! + ! Do the interpolation + ! + do j=1,nlatout + do k=1,nlev + arrout(k,j) = arrin(k,jjm(j))*wgts(j) + arrin(k,jjp(j))*wgtn(j) + end do + end do + + return + end subroutine lininterp_original + + + subroutine bilin (arrin, xin, yin, nlondin, nlonin, & + nlevdin, nlev, nlatin, arrout, xout, & + yout, nlondout, nlonout, nlevdout, nlatout) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! + ! Do a bilinear interpolation from input mesh defined by xin, yin to output + ! mesh defined by xout, yout. Circularity is assumed in the x-direction so + ! input x-grid must be in degrees east and must start from Greenwich. When + ! extrapolation is necessary in the N-S direction, values will be copied + ! from the extreme edge of the input grid. Vectorization is over the + ! longitude dimension. Input grid is assumed rectangular. Output grid + ! is assumed ragged, i.e. xout is a 2-d mesh. + ! + ! Method: Interpolate first in longitude, then in latitude. + ! + ! Author: Jim Rosinski + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: nlondin ! longitude dimension of input grid + integer, intent(in) :: nlonin ! number of real longitudes (input) + integer, intent(in) :: nlevdin ! vertical dimension of input grid + integer, intent(in) :: nlev ! number of vertical levels + integer, intent(in) :: nlatin ! number of input latitudes + integer, intent(in) :: nlatout ! number of output latitudes + integer, intent(in) :: nlondout ! longitude dimension of output grid + integer, intent(in) :: nlonout(nlatout) ! number of output longitudes per lat + integer, intent(in) :: nlevdout ! vertical dimension of output grid + + real(r8), intent(in) :: arrin(nlondin,nlevdin,nlatin) ! input array of values to interpolate + real(r8), intent(in) :: xin(nlondin) ! input x mesh + real(r8), intent(in) :: yin(nlatin) ! input y mesh + real(r8), intent(in) :: xout(nlondout,nlatout) ! output x mesh + real(r8), intent(in) :: yout(nlatout) ! output y mesh + ! + ! Output arguments + ! + real(r8), intent(out) :: arrout(nlondout,nlevdout,nlatout) ! interpolated array + ! + ! Local workspace + ! + integer :: i, ii, iw, ie, iiprev ! longitude indices + integer :: j, jj, js, jn, jjprev ! latitude indices + integer :: k ! level index + integer :: icount ! number of bad values + + real(r8) :: extrap ! percent grid non-overlap + real(r8) :: dxinwrap ! delta-x on input grid for 2-pi + real(r8) :: avgdxin ! avg input delta-x + real(r8) :: ratio ! compare dxinwrap to avgdxin + real(r8) :: sum ! sum of weights (used for testing) + ! + ! Dynamic + ! + integer :: iim(nlondout) ! interpolation index to the left + integer :: iip(nlondout) ! interpolation index to the right + integer :: jjm(nlatout) ! interpolation index to the south + integer :: jjp(nlatout) ! interpolation index to the north + + real(r8) :: wgts(nlatout) ! interpolation weight to the north + real(r8) :: wgtn(nlatout) ! interpolation weight to the north + real(r8) :: wgte(nlondout) ! interpolation weight to the north + real(r8) :: wgtw(nlondout) ! interpolation weight to the north + real(r8) :: igrid(nlonin) ! interpolation weight to the north + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nlonin < 2 .or. nlatin < 2) then + call endrun ('BILIN: Must have at least 2 input points for interpolation') + end if + + if (xin(1) < 0._r8 .or. xin(nlonin) > 360._r8) then + call endrun ('BILIN: Input x-grid must be between 0 and 360') + end if + + icount = 0 + do i=1,nlonin-1 + if (xin(i) >= xin(i+1)) icount = icount + 1 + end do + + do j=1,nlatin-1 + if (yin(j) >= yin(j+1)) icount = icount + 1 + end do + + do j=1,nlatout-1 + if (yout(j) >= yout(j+1)) icount = icount + 1 + end do + + do j=1,nlatout + do i=1,nlonout(j)-1 + if (xout(i,j) >= xout(i+1,j)) icount = icount + 1 + end do + end do + + if (icount > 0) then + call endrun ('BILIN: Non-monotonic coordinate array(s) found') + end if + + if (yout(nlatout) <= yin(1) .or. yout(1) >= yin(nlatin)) then + call endrun ('BILIN: No overlap in y-coordinates') + end if + + do j=1,nlatout + if (xout(1,j) < 0._r8 .or. xout(nlonout(j),j) > 360._r8) then + call endrun ('BILIN: Output x-grid must be between 0 and 360') + end if + + if (xout(nlonout(j),j) <= xin(1) .or. & + xout(1,j) >= xin(nlonin)) then + call endrun ('BILIN: No overlap in x-coordinates') + end if + end do + ! + ! Initialize index arrays for later checking + ! + do j=1,nlatout + jjm(j) = 0 + jjp(j) = 0 + end do + ! + ! For values which extend beyond N and S boundaries, set weights + ! such that values will just be copied. + ! + do js=1,nlatout + if (yout(js) > yin(1)) exit + jjm(js) = 1 + jjp(js) = 1 + wgts(js) = 1._r8 + wgtn(js) = 0._r8 + end do + + do jn=nlatout,1,-1 + if (yout(jn) <= yin(nlatin)) exit + jjm(jn) = nlatin + jjp(jn) = nlatin + wgts(jn) = 1._r8 + wgtn(jn) = 0._r8 + end do + ! + ! Loop though output indices finding input indices and weights + ! + jjprev = 1 + do j=js,jn + do jj=jjprev,nlatin-1 + if (yout(j) > yin(jj) .and. yout(j) <= yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1) - yout(j)) / (yin(jj+1) - yin(jj)) + wgtn(j) = (yout(j) - yin(jj)) / (yin(jj+1) - yin(jj)) + goto 30 + end if + end do + call endrun ('BILIN: Failed to find interp values') +30 jjprev = jj + end do + + dxinwrap = xin(1) + 360._r8 - xin(nlonin) + ! + ! Check for sane dxinwrap values. Allow to differ no more than 10% from avg + ! + avgdxin = (xin(nlonin)-xin(1))/(nlonin-1._r8) + ratio = dxinwrap/avgdxin + if (ratio < 0.9_r8 .or. ratio > 1.1_r8) then + write(iulog,*)'BILIN: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin + call endrun + end if + ! + ! Check that interp/extrap points have been found for all outputs, and that + ! they are reasonable (i.e. within 32-bit roundoff) + ! + icount = 0 + do j=1,nlatout + if (jjm(j) == 0 .or. jjp(j) == 0) icount = icount + 1 + sum = wgts(j) + wgtn(j) + if (sum < 0.99999_r8 .or. sum > 1.00001_r8) icount = icount + 1 + if (wgts(j) < 0._r8 .or. wgts(j) > 1._r8) icount = icount + 1 + if (wgtn(j) < 0._r8 .or. wgtn(j) > 1._r8) icount = icount + 1 + end do + + if (icount > 0) then + call endrun ('BILIN: something bad in latitude indices or weights') + end if + ! + ! Do the bilinear interpolation + ! + do j=1,nlatout + ! + ! Initialize index arrays for later checking + ! + do i=1,nlondout + iim(i) = 0 + iip(i) = 0 + end do + ! + ! For values which extend beyond E and W boundaries, set weights such that + ! values will be interpolated between E and W edges of input grid. + ! + do iw=1,nlonout(j) + if (xout(iw,j) > xin(1)) exit + iim(iw) = nlonin + iip(iw) = 1 + wgtw(iw) = (xin(1) - xout(iw,j)) /dxinwrap + wgte(iw) = (xout(iw,j)+360._r8 - xin(nlonin))/dxinwrap + end do + + do ie=nlonout(j),1,-1 + if (xout(ie,j) <= xin(nlonin)) exit + iim(ie) = nlonin + iip(ie) = 1 + wgtw(ie) = (xin(1)+360._r8 - xout(ie,j)) /dxinwrap + wgte(ie) = (xout(ie,j) - xin(nlonin))/dxinwrap + end do + ! + ! Loop though output indices finding input indices and weights + ! + iiprev = 1 + do i=iw,ie + do ii=iiprev,nlonin-1 + if (xout(i,j) > xin(ii) .and. xout(i,j) <= xin(ii+1)) then + iim(i) = ii + iip(i) = ii + 1 + wgtw(i) = (xin(ii+1) - xout(i,j)) / (xin(ii+1) - xin(ii)) + wgte(i) = (xout(i,j) - xin(ii)) / (xin(ii+1) - xin(ii)) + goto 60 + end if + end do + call endrun ('BILIN: Failed to find interp values') +60 iiprev = ii + end do + + icount = 0 + do i=1,nlonout(j) + if (iim(i) == 0 .or. iip(i) == 0) icount = icount + 1 + sum = wgtw(i) + wgte(i) + if (sum < 0.99999_r8 .or. sum > 1.00001_r8) icount = icount + 1 + if (wgtw(i) < 0._r8 .or. wgtw(i) > 1._r8) icount = icount + 1 + if (wgte(i) < 0._r8 .or. wgte(i) > 1._r8) icount = icount + 1 + end do + + if (icount > 0) then + write(iulog,*)'BILIN: j=',j,' Something bad in longitude indices or weights' + call endrun + end if + ! + ! Do the interpolation, 1st in longitude then latitude + ! + do k=1,nlev + do i=1,nlonin + igrid(i) = arrin(i,k,jjm(j))*wgts(j) + arrin(i,k,jjp(j))*wgtn(j) + end do + + do i=1,nlonout(j) + arrout(i,k,j) = igrid(iim(i))*wgtw(i) + igrid(iip(i))*wgte(i) + end do + end do + end do + + + return + end subroutine bilin + +!========================================================================================= + +subroutine vertinterp(ncol, ncold, nlev, pin, pout, arrin, arrout, & + extrapolate, ln_interp, ps, phis, tbot) + + ! Vertically interpolate input array to output pressure level. The + ! interpolation is linear in either pressure (the default) or ln pressure. + ! + ! If above the top boundary then return top boundary value. + ! + ! If below bottom boundary then use bottom boundary value, or optionally + ! for T or Z use the extrapolation algorithm from ECMWF (which was taken + ! from the NCL code base). + + use physconst, only: rair, rga + + !------------------------------Arguments-------------------------------- + integer, intent(in) :: ncol ! number active columns + integer, intent(in) :: ncold ! column dimension + integer, intent(in) :: nlev ! vertical dimension + real(r8), intent(in) :: pin(ncold,nlev) ! input pressure levels + real(r8), intent(in) :: pout ! output pressure level + real(r8), intent(in) :: arrin(ncold,nlev) ! input array + real(r8), intent(out) :: arrout(ncold) ! output array (interpolated) + + character(len=1), optional, intent(in) :: extrapolate ! either 'T' or 'Z' + logical, optional, intent(in) :: ln_interp ! set true to interolate + ! in ln(pressure) + real(r8), optional, intent(in) :: ps(ncold) ! surface pressure + real(r8), optional, intent(in) :: phis(ncold) ! surface geopotential + real(r8), optional, intent(in) :: tbot(ncold) ! temperature at bottom level + + !---------------------------Local variables----------------------------- + real(r8) :: alpha + logical :: linear_interp + logical :: do_extrapolate_T, do_extrapolate_Z + + integer :: i,k ! indices + integer :: kupper(ncold) ! Level indices for interpolation + real(r8) :: dpu ! upper level pressure difference + real(r8) :: dpl ! lower level pressure difference + logical :: found(ncold) ! true if input levels found + logical :: error ! error flag + !---------------------------------------------------------------------------- + + alpha = 0.0065_r8*rair*rga + + do_extrapolate_T = .false. + do_extrapolate_Z = .false. + if (present(extrapolate)) then + + if (extrapolate == 'T') do_extrapolate_T = .true. + if (extrapolate == 'Z') do_extrapolate_Z = .true. + + if (.not. do_extrapolate_T .and. .not. do_extrapolate_Z) then + call endrun ('VERTINTERP: extrapolate must be T or Z') + end if + if (.not. present(ps)) then + call endrun ('VERTINTERP: ps required for extrapolation') + end if + if (.not. present(phis)) then + call endrun ('VERTINTERP: phis required for extrapolation') + end if + if (do_extrapolate_Z) then + if (.not. present(tbot)) then + call endrun ('VERTINTERP: extrapolate must be T or Z') + end if + end if + end if + + linear_interp = .true. + if (present(ln_interp)) then + if (ln_interp) linear_interp = .false. + end if + + do i = 1, ncol + found(i) = .false. + kupper(i) = 1 + end do + error = .false. + + ! Find indices of upper pressure bound + do k = 1, nlev - 1 + do i = 1, ncol + if ((.not. found(i)) .and. pin(i,k)= pin(i,nlev)) then + + if (do_extrapolate_T) then + ! use ECMWF algorithm to extrapolate T + arrout(i) = extrapolate_T() + + else if (do_extrapolate_Z) then + ! use ECMWF algorithm to extrapolate Z + arrout(i) = extrapolate_Z() + + else + ! use bottom value + arrout(i) = arrin(i,nlev) + end if + + else if (found(i)) then + if (linear_interp) then + ! linear interpolation in p + dpu = pout - pin(i,kupper(i)) + dpl = pin(i,kupper(i)+1) - pout + arrout(i) = (arrin(i,kupper(i))*dpl + arrin(i,kupper(i)+1)*dpu)/(dpl + dpu) + else + ! linear interpolation in ln(p) + arrout(i) = arrin(i,kupper(i)) + (arrin(i,kupper(i)+1) - arrin(i,kupper(i)))* & + log(pout/pin(i,kupper(i))) / & + log(pin(i,kupper(i)+1)/pin(i,kupper(i))) + end if + else + error = .true. + end if + end do + + ! Error check + if (error) then + call endrun ('VERTINTERP: ERROR FLAG') + end if + +contains + + !====================================================================================== + + real(r8) function extrapolate_T() + + ! local variables + real(r8) :: sixth + real(r8) :: tstar + real(r8) :: hgt + real(r8) :: alnp + real(r8) :: t0 + real(r8) :: tplat + real(r8) :: tprime0 + !------------------------------------------------------------------------- + + sixth = 1._r8 / 6._r8 + tstar = arrin(i,nlev)*(1._r8 + alpha*(ps(i)/pin(i,nlev) - 1._r8)) + hgt = phis(i)*rga + + if (hgt < 2000._r8) then + alnp = alpha*log(pout/ps(i)) + else + t0 = tstar + 0.0065_r8*hgt + tplat = min(t0, 298._r8) + + if (hgt <= 2500._r8) then + tprime0 = 0.002_r8*((2500._r8 - hgt)*t0 + & + (hgt - 2000._r8)*tplat) + else + tprime0 = tplat + end if + + if (tprime0 < tstar) then + alnp = 0._r8 + else + alnp = rair*(tprime0 - tstar)/phis(i) * log(pout/ps(i)) + end if + + end if + + extrapolate_T = tstar*(1._r8 + alnp + 0.5_r8*alnp**2 + sixth*alnp**3) + + end function extrapolate_T + + !====================================================================================== + + real(r8) function extrapolate_Z() + + ! local variables + real(r8) :: sixth + real(r8) :: hgt + real(r8) :: tstar + real(r8) :: t0 + real(r8) :: alph + real(r8) :: alnp + !------------------------------------------------------------------------- + + sixth = 1._r8 / 6._r8 + hgt = phis(i)*rga + tstar = tbot(i)*(1._r8 + alpha*(ps(i)/pin(i,nlev) - 1._r8)) + t0 = tstar + 0.0065_r8*hgt + + if (tstar <= 290.5_r8 .and. t0 > 290.5_r8) then + alph = rair/phis(i) * (290.5_r8 - tstar) + + else if (tstar > 290.5_r8 .and. t0 > 290.5_r8) then + alph = 0._r8 + tstar = 0.5_r8*(290.5_r8 + tstar) + + else + alph = alpha + + end if + + if (tstar < 255._r8) then + tstar = 0.5_r8*(tstar + 255._r8) + end if + alnp = alph*log(pout/ps(i)) + + extrapolate_Z = hgt - rair*tstar*rga*log(pout/ps(i))* & + (1._r8 + 0.5_r8*alnp + sixth*alnp**2) + + end function extrapolate_Z + +end subroutine vertinterp + +!========================================================================================= + + subroutine get_timeinterp_factors (cycflag, np1, cdayminus, cdayplus, cday, & + fact1, fact2, str) + !--------------------------------------------------------------------------- + ! + ! Purpose: Determine time interpolation factors (normally for a boundary dataset) + ! for linear interpolation. + ! + ! Method: Assume 365 days per year. Output variable fact1 will be the weight to + ! apply to data at calendar time "cdayminus", and fact2 the weight to apply + ! to data at time "cdayplus". Combining these values will produce a result + ! valid at time "cday". Output arguments fact1 and fact2 will be between + ! 0 and 1, and fact1 + fact2 = 1 to roundoff. + ! + ! Author: Jim Rosinski + ! + !--------------------------------------------------------------------------- + implicit none + ! + ! Arguments + ! + logical, intent(in) :: cycflag ! flag indicates whether dataset is being cycled yearly + + integer, intent(in) :: np1 ! index points to forward time slice matching cdayplus + + real(r8), intent(in) :: cdayminus ! calendar day of rearward time slice + real(r8), intent(in) :: cdayplus ! calendar day of forward time slice + real(r8), intent(in) :: cday ! calenar day to be interpolated to + real(r8), intent(out) :: fact1 ! time interpolation factor to apply to rearward time slice + real(r8), intent(out) :: fact2 ! time interpolation factor to apply to forward time slice + + character(len=*), intent(in) :: str ! string to be added to print in case of error (normally the callers name) + ! + ! Local workspace + ! + real(r8) :: deltat ! time difference (days) between cdayminus and cdayplus + real(r8), parameter :: daysperyear = 365._r8 ! number of days in a year + ! + ! Initial sanity checks + ! + if (np1 == 1 .and. .not. cycflag) then + call endrun ('GETFACTORS:'//str//' cycflag false and forward month index = Jan. not allowed') + end if + + if (np1 < 1) then + call endrun ('GETFACTORS:'//str//' input arg np1 must be > 0') + end if + + if (cycflag) then + if ((cday < 1._r8) .or. (cday > (daysperyear+1._r8))) then + write(iulog,*) 'GETFACTORS:', str, ' bad cday=',cday + call endrun () + end if + else + if (cday < 1._r8) then + write(iulog,*) 'GETFACTORS:', str, ' bad cday=',cday + call endrun () + end if + end if + ! + ! Determine time interpolation factors. Account for December-January + ! interpolation if dataset is being cycled yearly. + ! + if (cycflag .and. np1 == 1) then ! Dec-Jan interpolation + deltat = cdayplus + daysperyear - cdayminus + if (cday > cdayplus) then ! We are in December + fact1 = (cdayplus + daysperyear - cday)/deltat + fact2 = (cday - cdayminus)/deltat + else ! We are in January + fact1 = (cdayplus - cday)/deltat + fact2 = (cday + daysperyear - cdayminus)/deltat + end if + else + deltat = cdayplus - cdayminus + fact1 = (cdayplus - cday)/deltat + fact2 = (cday - cdayminus)/deltat + end if + + if (.not. valid_timeinterp_factors (fact1, fact2)) then + write(iulog,*) 'GETFACTORS: ', str, ' bad fact1 and/or fact2=', fact1, fact2 + call endrun () + end if + + return + end subroutine get_timeinterp_factors + + logical function valid_timeinterp_factors (fact1, fact2) + !--------------------------------------------------------------------------- + ! + ! Purpose: check sanity of time interpolation factors to within 32-bit roundoff + ! + !--------------------------------------------------------------------------- + implicit none + + real(r8), intent(in) :: fact1, fact2 ! time interpolation factors + + valid_timeinterp_factors = .true. + + ! The fact1 .ne. fact1 and fact2 .ne. fact2 comparisons are to detect NaNs. + if (abs(fact1+fact2-1._r8) > 1.e-6_r8 .or. & + fact1 > 1.000001_r8 .or. fact1 < -1.e-6_r8 .or. & + fact2 > 1.000001_r8 .or. fact2 < -1.e-6_r8 .or. & + fact1 .ne. fact1 .or. fact2 .ne. fact2) then + + valid_timeinterp_factors = .false. + end if + + return + end function valid_timeinterp_factors + +end module interpolate_data diff --git a/src/utils/intp_util.F90 b/src/utils/intp_util.F90 new file mode 100644 index 0000000000..511fe2e209 --- /dev/null +++ b/src/utils/intp_util.F90 @@ -0,0 +1,53 @@ +module intp_util + +implicit none + +private + +public :: findplb + +contains + +!####################################################################### + +subroutine findplb( x, nx, xval, index ) + + !----------------------------------------------------------------------- + ! Purpose: + ! "find periodic lower bound" + ! Search the input array for the lower bound of the interval that + ! contains the input value. The returned index satifies: + ! x(index) .le. xval .lt. x(index+1) + ! Assume the array represents values in one cycle of a periodic coordinate. + ! So, if xval .lt. x(1), or xval .ge. x(nx), then the index returned is nx. + ! + ! Author: B. Eaton + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + integer, intent(in) :: nx ! size of x + real(r8), intent(in) :: x(nx) ! strictly increasing array + real(r8), intent(in) :: xval ! value to be searched for in x + + integer, intent(out) :: index + + ! Local variables: + integer i + !----------------------------------------------------------------------- + + if ( xval .lt. x(1) .or. xval .ge. x(nx) ) then + index = nx + return + end if + + do i = 2, nx + if ( xval .lt. x(i) ) then + index = i-1 + return + end if + end do + +end subroutine findplb + +end module intp_util diff --git a/src/utils/ioFileMod.F90 b/src/utils/ioFileMod.F90 new file mode 100644 index 0000000000..c013d8aa7f --- /dev/null +++ b/src/utils/ioFileMod.F90 @@ -0,0 +1,182 @@ +module ioFileMod +!--------------------------------------------------------------------- +! +! Purpose: +! +! Input/Output file manipulations. Mind file on archival system, or local +! disk etc. +! +! Author: Mariana Vertenstein +! +!--------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + implicit none + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + private + + public getfil ! Get file from archive + public opnfil ! Open file + +!-------------------------------------------------------------------------- +! Private interfaces +!-------------------------------------------------------------------------- + +!======================================================================= + contains +!======================================================================= + +subroutine getfil(fulpath, locfn, iflag, lexist) + + ! -------------------------------------------------------------------- + ! Determine whether file is on local disk. + ! . first check current working directory + ! . next check full pathname[fulpath] on disk + ! . by default, abort if file not found. Setting optional iflag arg + ! to 1 overrides this behavior, and in that case the optional lexist + ! arg is used to return status of whether the file was found or not. + ! -------------------------------------------------------------------- + + ! ------------------------ arguments ----------------------------------- + character(len=*), intent(in) :: fulpath ! full pathname on local disk + character(len=*), intent(out) :: locfn ! local file name if found in working directory, + ! set to fulpath if not found in working dir. + integer, optional, intent(in) :: iflag ! set iflag=1 to return control to caller if + ! file not found. default is to abort. + logical, optional, intent(out) :: lexist ! When iflag=1 then getfil will return whether the + ! file is found or not. This flag is set .true. + ! if the file is found, otherwise .false. + + ! ------------------------ local variables --------------------------- + integer :: i ! loop index + integer :: klen ! length of fulpath character string + integer :: maxlen ! length of locfn input variable + integer :: ierr ! error status + logical :: lexist_in ! true if local file exists + logical :: abort_on_failure + ! -------------------------------------------------------------------- + + abort_on_failure = .true. + if (present(iflag)) then + if (iflag==1) abort_on_failure = .false. + end if + maxlen = len(locfn) + + ! first check if file is in current working directory. + + ! get local file name from full name: start at end. look for first "/" + + klen = len_trim(fulpath) + i = index(fulpath, '/', back=.true.) + + if ((klen-i) > maxlen) then + if (abort_on_failure) then + call endrun('(GETFIL): local filename variable is too short for path length') + else + if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen-i,maxlen + if (present(lexist)) lexist = .false. + return + end if + end if + + locfn = fulpath(i+1:klen) + if (len_trim(locfn) == 0) then + call endrun ('(GETFIL): local filename has zero length') + else if (masterproc) then + write(iulog,*)'(GETFIL): attempting to find local file ', trim(locfn) + end if + + inquire(file=locfn, exist=lexist_in) + if (present(lexist)) lexist = lexist_in + if (lexist_in) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), ' in current working directory' + return + end if + + ! second check for full pathname on disk + + if (klen > maxlen) then + if (abort_on_failure) then + call endrun('(GETFIL): local filename variable is too short for path length') + else + if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen,maxlen + if (present(lexist)) lexist = .false. + return + end if + end if + + locfn = trim(fulpath) + inquire(file=locfn, exist=lexist_in) + if (present(lexist)) lexist = lexist_in + if (lexist_in) then + if (masterproc) write(iulog,*)'(GETFIL): using ',trim(fulpath) + return + else + if (masterproc) write(iulog,*)'(GETFIL): all tries to get file have been unsuccessful: ',trim(fulpath) + if (abort_on_failure) then + call endrun ('GETFIL: FAILED to get '//trim(fulpath)) + else + return + endif + endif + +end subroutine getfil + +!======================================================================= + + + subroutine opnfil (locfn, iun, form, status) + +!----------------------------------------------------------------------- +! open file locfn in unformatted or formatted form on unit iun +!----------------------------------------------------------------------- + +! ------------------------ input variables --------------------------- + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted. f = formatted + character(len=*), optional, intent(in):: status !file status +! -------------------------------------------------------------------- + +! ------------------------ local variables --------------------------- + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted + character(len=11) st !file status: old or unknown +! -------------------------------------------------------------------- + + if (len_trim(locfn) == 0) then + call endrun ('(OPNFIL): local filename has zero length') + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + if ( present(status) ) then + st = status + else + st = "unknown" + end if + open (unit=iun,file=locfn,status=st, form=ft,iostat=ioe) + if (ioe /= 0) then + if(masterproc) write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), ' on unit ',iun,' ierr=',ioe + call endrun ('opnfil') + else + if(masterproc) write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), ' on unit= ',iun + end if + + return + end subroutine opnfil + +!======================================================================= + + +end module ioFileMod diff --git a/src/utils/linear_1d_operators.F90 b/src/utils/linear_1d_operators.F90 new file mode 100644 index 0000000000..f0b6211d49 --- /dev/null +++ b/src/utils/linear_1d_operators.F90 @@ -0,0 +1,1180 @@ +module linear_1d_operators + +! This module provides the type "TriDiagOp" to represent operators on a 1D +! grid as tridiagonal matrices, and related types to represent boundary +! conditions. +! +! The focus is on solving diffusion equations with a finite volume method +! in one dimension, but other utility operators are provided, e.g. a second +! order approximation to the first derivative. +! +! In order to allow vectorization to occur, as well as to avoid unnecessary +! copying/reshaping of data in CAM, TriDiagOp actually represents a +! collection of independent operators that can be applied to collections of +! independent data; the innermost index is over independent systems (e.g. +! CAM columns). +! +! A simple example: +! ! First derivative operator +! op = first_derivative(coords) +! ! Convert data to its derivative (extrapolate at boundaries). +! call op%apply(data) +! +! With explicit boundary conditions: +! op = first_derivative(coords, & +! l_bndry=BoundaryFixedFlux(), & +! r_bndry=BoundaryFixedLayer(layer_distance)) +! call op%apply(data, & +! l_cond=BoundaryFlux(flux, dt, thickness), & +! r_cond=BoundaryData(boundary)) +! +! Implicit solution example: +! ! Construct diffusion matrix. +! op = diffusion_operator(coords, d) +! call op%lmult_as_diag(-dt) +! call op%add_to_diag(1._r8) +! ! Decompose in order to invert the operation. +! decomp = TriDiagDecomp(op) +! ! Diffuse data for one time step (fixed flux boundaries). +! call decomp%left_div(data) + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_log_mod, only: errMsg => shr_log_errMsg +use shr_sys_mod, only: shr_sys_abort +use coords_1d, only: Coords1D + +implicit none +private +save + +! Main type. +public :: TriDiagOp +public :: operator(+) +public :: operator(-) + +! Decomposition used for inversion (left division). +public :: TriDiagDecomp + +! Multiplies by 0. +public :: zero_operator + +! Construct identity. +public :: identity_operator + +! Produce a TriDiagOp that is simply a diagonal matrix. +public :: diagonal_operator + +! For solving the diffusion-advection equation with implicit Euler. +public :: diffusion_operator +public :: advection_operator + +! Derivatives accurate to second order on a non-uniform grid. +public :: first_derivative +public :: second_derivative + +! Boundary condition types. +public :: BoundaryType +public :: BoundaryZero +public :: BoundaryFirstOrder +public :: BoundaryExtrapolate +public :: BoundaryFixedLayer +public :: BoundaryFixedFlux + +! Boundary data types. +public :: BoundaryCond +public :: BoundaryNoData +public :: BoundaryData +public :: BoundaryFlux + +! TriDiagOp represents operators that can work between nearest neighbors, +! with some extra logic at the boundaries. The implementation is a +! tridiagonal matrix plus boundary info. +type :: TriDiagOp + private + ! The number of independent systems. + integer, public :: nsys + ! The size of the matrix (number of grid cells). + integer, public :: ncel + ! Super-, sub-, and regular diagonals. + real(r8), allocatable :: spr(:,:) + real(r8), allocatable :: sub(:,:) + real(r8), allocatable :: diag(:,:) + ! Buffers to hold boundary data; Details depend on the type of boundary + ! being used. + real(r8), allocatable :: left_bound(:) + real(r8), allocatable :: right_bound(:) + contains + ! Applies the operator to a set of data. + procedure :: apply => apply_tridiag + ! Given the off-diagonal elements, fills in the diagonal so that the + ! operator will have the constant function as an eigenvector with + ! eigenvalue 0. This is used internally as a utility for construction of + ! derivative operators. + procedure :: deriv_diag => make_tridiag_deriv_diag + ! Add/substract another tridiagonal from this one in-place (without + ! creating a temporary object). + procedure :: add => add_in_place_tridiag_ops + procedure :: subtract => subtract_in_place_tridiag_ops + ! Add input vector or scalar to the diagonal. + procedure :: scalar_add_tridiag + procedure :: diagonal_add_tridiag + generic :: add_to_diag => scalar_add_tridiag, diagonal_add_tridiag + ! Treat input vector (or scalar) as if it was the diagonal of an + ! operator, and multiply this operator on the left by that value. + procedure :: scalar_lmult_tridiag + procedure :: diagonal_lmult_tridiag + generic :: lmult_as_diag => & + scalar_lmult_tridiag, diagonal_lmult_tridiag + ! Deallocate and reset. + procedure :: finalize => tridiag_finalize +end type TriDiagOp + +interface operator(+) + module procedure add_tridiag_ops +end interface operator(+) + +interface operator(-) + module procedure subtract_tridiag_ops +end interface operator(-) + +interface TriDiagOp + module procedure new_TriDiagOp +end interface TriDiagOp + +! +! Boundary condition types for the operators. +! +! Note that BoundaryFixedLayer and BoundaryFixedFlux are the only options +! supported for backwards operation (i.e. decomp%left_div). The others are +! meant for direct application only (e.g. to find a derivative). +! +! BoundaryZero means that the operator fixes boundaries to 0. +! BoundaryFirstOrder means a one-sided approximation for the first +! derivative. +! BoundaryExtrapolate means that a second order approximation will be used, +! even at the boundaries. Boundary points do this by using their next- +! nearest neighbor to extrapolate. +! BoundaryFixedLayer means that there's an extra layer outside of the given +! grid, which must be specified when applying/inverting the operator. +! BoundaryFixedFlux is intended to provide a fixed-flux condition for +! typical advection/diffusion operators. It tweaks the edge condition +! to work on an input current rather than a value. +! +! The different types were originally implemented through polymorphism, but +! PGI required this to be done via enum instead. +integer, parameter :: zero_bndry = 0 +integer, parameter :: first_order_bndry = 1 +integer, parameter :: extrapolate_bndry = 2 +integer, parameter :: fixed_layer_bndry = 3 +integer, parameter :: fixed_flux_bndry = 4 + +type :: BoundaryType + private + integer :: bndry_type = fixed_flux_bndry + real(r8), allocatable :: edge_width(:) + contains + procedure :: make_left + procedure :: make_right + procedure :: finalize => boundary_type_finalize +end type BoundaryType + +abstract interface + subroutine deriv_seed(del_minus, del_plus, sub, spr) + import :: r8 + real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) + real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) + real(r8), USE_CONTIGUOUS intent(out) :: sub(:) + real(r8), USE_CONTIGUOUS intent(out) :: spr(:) + end subroutine deriv_seed +end interface + +interface BoundaryZero + module procedure new_BoundaryZero +end interface BoundaryZero + +interface BoundaryFirstOrder + module procedure new_BoundaryFirstOrder +end interface BoundaryFirstOrder + +interface BoundaryExtrapolate + module procedure new_BoundaryExtrapolate +end interface BoundaryExtrapolate + +interface BoundaryFixedLayer + module procedure new_BoundaryFixedLayer +end interface BoundaryFixedLayer + +interface BoundaryFixedFlux + module procedure new_BoundaryFixedFlux +end interface BoundaryFixedFlux + +! +! Data for boundary conditions themselves. +! +! "No data" conditions perform extrapolation, if BoundaryExtrapolate was +! the boundary type used to construct the operator. +! +! "Data" conditions contain extra data, which effectively extends the +! system with an extra cell. +! +! "Flux" conditions contain prescribed fluxes. +! +! The condition you can use depends on the boundary type from above that +! was used in the operator's construction. For BoundaryFixedLayer use +! BoundaryData. For BoundaryFixedFlux use BoundaryFlux. For everything +! else, use BoundaryNoData. + +! The switches using this enumeration used to be unnecessary due to use of +! polymorphism, but this had to be backed off due to insufficient PGI +! support for type extension. +integer, parameter :: no_data_cond = 0 +integer, parameter :: data_cond = 1 +integer, parameter :: flux_cond = 2 + +type :: BoundaryCond + private + integer :: cond_type = no_data_cond + real(r8), allocatable :: edge_data(:) + contains + procedure :: apply_left + procedure :: apply_right + procedure :: finalize => boundary_cond_finalize +end type BoundaryCond + +! Constructors for different types of BoundaryCond. +interface BoundaryNoData + module procedure new_BoundaryNoData +end interface BoundaryNoData + +interface BoundaryData + module procedure new_BoundaryData +end interface BoundaryData + +interface BoundaryFlux + module procedure new_BoundaryFlux +end interface BoundaryFlux + +! Opaque type to hold a tridiagonal matrix decomposition. +! +! Method used is similar to Richtmyer and Morton (1967,pp 198-201), but +! the order of iteration is reversed, leading to A and C being swapped, and +! some differences in the indexing. +type :: TriDiagDecomp + private + integer :: nsys = 0 + integer :: ncel = 0 + ! These correspond to A_k, E_k, and 1 / (B_k - A_k * E_{k+1}) + real(r8), allocatable :: ca(:,:) + real(r8), allocatable :: ze(:,:) + real(r8), allocatable :: dnom(:,:) +contains + procedure :: left_div => decomp_left_div + procedure :: finalize => decomp_finalize +end type TriDiagDecomp + +interface TriDiagDecomp + module procedure new_TriDiagDecomp +end interface TriDiagDecomp + +contains + +! Operator that sets to 0. +function zero_operator(nsys, ncel) result(op) + ! Sizes for operator. + integer, intent(in) :: nsys, ncel + + type(TriDiagOp) :: op + + op = TriDiagOp(nsys, ncel) + + op%spr = 0._r8 + op%sub = 0._r8 + op%diag = 0._r8 + op%left_bound = 0._r8 + op%right_bound = 0._r8 + +end function zero_operator + +! Operator that does nothing. +function identity_operator(nsys, ncel) result(op) + ! Sizes for operator. + integer, intent(in) :: nsys, ncel + + type(TriDiagOp) :: op + + op = TriDiagOp(nsys, ncel) + + op%spr = 0._r8 + op%sub = 0._r8 + op%diag = 1._r8 + op%left_bound = 0._r8 + op%right_bound = 0._r8 + +end function identity_operator + +! Create an operator that just does an element-wise product by some data. +function diagonal_operator(diag) result(op) + ! Data to multiply by. + real(r8), USE_CONTIGUOUS intent(in) :: diag(:,:) + + type(TriDiagOp) :: op + + op = TriDiagOp(size(diag, 1), size(diag, 2)) + + op%spr = 0._r8 + op%sub = 0._r8 + op%diag = diag + op%left_bound = 0._r8 + op%right_bound = 0._r8 + +end function diagonal_operator + +! Diffusion matrix operator constructor. Given grid coordinates, a set of +! diffusion coefficients, and boundaries, creates a matrix corresponding +! to a finite volume representation of the operation: +! +! d/dx (d_coef * d/dx) +! +! This differs from what you would get from combining the first and second +! derivative operations, which would be more appropriate for a finite +! difference scheme that does not use grid cell averages. +function diffusion_operator(coords, d_coef, l_bndry, r_bndry) & + result(op) + ! Grid cell locations. + type(Coords1D), intent(in) :: coords + ! Diffusion coefficient defined on interfaces. + real(r8), USE_CONTIGUOUS intent(in) :: d_coef(:,:) + ! Objects representing the kind of boundary on each side. + class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry + ! Output operator. + type(TriDiagOp) :: op + + ! Selectors to implement default boundary. + class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc + ! Fixed flux is default, no allocation/deallocation needed. + type(BoundaryType), target :: bndry_default + + ! Level index. + integer :: k + + if (present(l_bndry)) then + l_bndry_loc => l_bndry + else + l_bndry_loc => bndry_default + end if + + if (present(r_bndry)) then + r_bndry_loc => r_bndry + else + r_bndry_loc => bndry_default + end if + + ! Allocate the operator. + op = TriDiagOp(coords%n, coords%d) + + ! d_coef over the distance to the next cell gives you the matrix term for + ! flux of material between cells. Dividing by cell thickness translates + ! this to a tendency on the concentration. Hence the basic pattern is + ! d_coef*rdst*rdel. + ! + ! Boundary conditions for a fixed layer simply extend this by calculating + ! the distance to the midpoint of the extra edge layer. + + select case (l_bndry_loc%bndry_type) + case (fixed_layer_bndry) + op%left_bound = 2._r8*d_coef(:,1)*coords%rdel(:,1) / & + (l_bndry_loc%edge_width+coords%del(:,1)) + case default + op%left_bound = 0._r8 + end select + + do k = 1, coords%d-1 + op%spr(:,k) = d_coef(:,k+1)*coords%rdst(:,k)*coords%rdel(:,k) + op%sub(:,k) = d_coef(:,k+1)*coords%rdst(:,k)*coords%rdel(:,k+1) + end do + + select case (r_bndry_loc%bndry_type) + case (fixed_layer_bndry) + op%right_bound = 2._r8*d_coef(:,coords%d+1)*coords%rdel(:,coords%d) / & + (r_bndry_loc%edge_width+coords%del(:,coords%d)) + case default + op%right_bound = 0._r8 + end select + + ! Above, we found all off-diagonals. Now get the diagonal. + call op%deriv_diag() + +end function diffusion_operator + +! Advection matrix operator constructor. Similar to diffusion_operator, it +! constructs an operator A corresponding to: +! +! A y = d/dx (-v_coef * y) +! +! Again, this is targeted at representing this operator acting on grid-cell +! averages in a finite volume scheme, rather than a literal representation. +function advection_operator(coords, v_coef, l_bndry, r_bndry) & + result(op) + ! Grid cell locations. + type(Coords1D), intent(in) :: coords + ! Advection coefficient (effective velocity). + real(r8), USE_CONTIGUOUS intent(in) :: v_coef(:,:) + ! Objects representing the kind of boundary on each side. + class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry + ! Output operator. + type(TriDiagOp) :: op + + ! Selectors to implement default boundary. + class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc + ! Fixed flux is default, no allocation/deallocation needed. + type(BoundaryType), target :: bndry_default + + ! Negative derivative of v. + real(r8) :: v_deriv(coords%n,coords%d) + + if (present(l_bndry)) then + l_bndry_loc => l_bndry + else + l_bndry_loc => bndry_default + end if + + if (present(r_bndry)) then + r_bndry_loc => r_bndry + else + r_bndry_loc => bndry_default + end if + + ! Allocate the operator. + op = TriDiagOp(coords%n, coords%d) + + ! Construct the operator in two stages using the product rule. First + ! create (-v * d/dx), then -dv/dx, and add the two. + ! + ! For the first part, we want to interpolate to interfaces (weighted + ! average involving del/2*dst), multiply by -v to get flux, then divide + ! by cell thickness, which gives a concentration tendency: + ! + ! (del/(2*dst))*(-v_coef)/del + ! + ! Simplifying gives -v_coef*rdst*0.5, as seen below. + + select case (l_bndry_loc%bndry_type) + case (fixed_layer_bndry) + op%left_bound = v_coef(:,1) / & + (l_bndry_loc%edge_width+coords%del(:,1)) + case default + op%left_bound = 0._r8 + end select + + op%sub = v_coef(:,2:coords%d)*coords%rdst*0.5_r8 + op%spr = -op%sub + + select case (r_bndry_loc%bndry_type) + case (fixed_layer_bndry) + op%right_bound = v_coef(:,coords%d+1) / & + (r_bndry_loc%edge_width+coords%del(:,coords%d)) + case default + op%right_bound = 0._r8 + end select + + ! Above, we found all off-diagonals. Now get the diagonal. This must be + ! done at this specific point, since the other half of the operator is + ! not "derivative-like" in the sense of yielding 0 for a constant input. + call op%deriv_diag() + + ! The second half of the operator simply involves taking a first-order + ! derivative of v. Since v is on the interfaces, just use: + ! (v(k+1) - v(k))*rdel(k) + v_deriv(:,1) = v_coef(:,2)*coords%rdel(:,1) + + select case (l_bndry_loc%bndry_type) + case (fixed_layer_bndry) + v_deriv(:,1) = v_deriv(:,1) - v_coef(:,1)*coords%rdel(:,1) + end select + + v_deriv(:,2:coords%d-1) = (v_coef(:,3:coords%d) - & + v_coef(:,2:coords%d-1))*coords%rdel(:,2:coords%d-1) + + v_deriv(:,coords%d) = -v_coef(:,coords%d)*coords%rdel(:,coords%d) + + select case (r_bndry_loc%bndry_type) + case (fixed_layer_bndry) + v_deriv(:,coords%d) = v_deriv(:,coords%d) & + + v_coef(:,coords%d+1)*coords%del(:,coords%d) + end select + + ! Combine the two pieces. + op%diag = op%diag - v_deriv + +end function advection_operator + +! Second order approximation to the first and second derivatives on a non- +! uniform grid. +! +! Both operators are constructed with the same method, except for a "seed" +! function that takes local distances between points to create the +! off-diagonal terms. +function first_derivative(grid_spacing, l_bndry, r_bndry) result(op) + ! Distances between points. + real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) + ! Boundary conditions. + class(BoundaryType), intent(in), optional :: l_bndry, r_bndry + ! Output operator. + type(TriDiagOp) :: op + + op = deriv_op_from_seed(grid_spacing, first_derivative_seed, & + l_bndry, r_bndry) + +end function first_derivative + +subroutine first_derivative_seed(del_minus, del_plus, sub, spr) + ! Distances to next and previous point. + real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) + real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) + ! Off-diagonal matrix terms. + real(r8), USE_CONTIGUOUS intent(out) :: sub(:) + real(r8), USE_CONTIGUOUS intent(out) :: spr(:) + + real(r8) :: del_sum(size(del_plus)) + + del_sum = del_plus + del_minus + + sub = - del_plus / (del_minus*del_sum) + spr = del_minus / (del_plus*del_sum) + +end subroutine first_derivative_seed + +function second_derivative(grid_spacing, l_bndry, r_bndry) result(op) + ! Distances between points. + real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) + ! Boundary conditions. + class(BoundaryType), intent(in), optional :: l_bndry, r_bndry + ! Output operator. + type(TriDiagOp) :: op + + op = deriv_op_from_seed(grid_spacing, second_derivative_seed, & + l_bndry, r_bndry) + +end function second_derivative + +subroutine second_derivative_seed(del_minus, del_plus, sub, spr) + ! Distances to next and previous point. + real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) + real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) + ! Off-diagonal matrix terms. + real(r8), USE_CONTIGUOUS intent(out) :: sub(:) + real(r8), USE_CONTIGUOUS intent(out) :: spr(:) + + real(r8) :: del_sum(size(del_plus)) + + del_sum = del_plus + del_minus + + sub = 2._r8 / (del_minus*del_sum) + spr = 2._r8 / (del_plus*del_sum) + +end subroutine second_derivative_seed + +! Brains behind the first/second derivative functions. +function deriv_op_from_seed(grid_spacing, seed, l_bndry, r_bndry) result(op) + ! Distances between points. + real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) + ! Function to locally construct matrix elements. + procedure(deriv_seed) :: seed + ! Boundary conditions. + class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry + ! Output operator. + type(TriDiagOp) :: op + + ! Selectors to implement default boundary. + class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc + ! Fixed flux is default, no allocation/deallocation needed. + type(BoundaryType), target :: bndry_default + + integer :: k + + if (present(l_bndry)) then + l_bndry_loc => l_bndry + else + l_bndry_loc => bndry_default + end if + + if (present(r_bndry)) then + r_bndry_loc => r_bndry + else + r_bndry_loc => bndry_default + end if + + ! Number of grid points is one greater than the spacing. + op = TriDiagOp(size(grid_spacing, 1), size(grid_spacing, 2) + 1) + + ! Left boundary condition. + call l_bndry_loc%make_left(grid_spacing, seed, & + op%left_bound, op%spr(:,1)) + + do k = 2, op%ncel-1 + call seed(grid_spacing(:,k-1), grid_spacing(:,k), & + op%sub(:,k-1), op%spr(:,k)) + end do + + ! Right boundary condition. + call r_bndry_loc%make_right(grid_spacing, seed, & + op%sub(:,op%ncel-1), op%right_bound) + + ! Above, we found all off-diagonals. Now get the diagonal. + call op%deriv_diag() + +end function deriv_op_from_seed + +! Boundary constructors. Most simply set an internal flag, but +! BoundaryFixedLayer accepts an argument representing the distance to the +! location where the extra layer is defined. + +function new_BoundaryZero() result(new_bndry) + type(BoundaryType) :: new_bndry + + new_bndry%bndry_type = zero_bndry + +end function new_BoundaryZero + +function new_BoundaryFirstOrder() result(new_bndry) + type(BoundaryType) :: new_bndry + + new_bndry%bndry_type = first_order_bndry + +end function new_BoundaryFirstOrder + +function new_BoundaryExtrapolate() result(new_bndry) + type(BoundaryType) :: new_bndry + + new_bndry%bndry_type = extrapolate_bndry + +end function new_BoundaryExtrapolate + +function new_BoundaryFixedLayer(width) result(new_bndry) + real(r8), USE_CONTIGUOUS intent(in) :: width(:) + type(BoundaryType) :: new_bndry + + new_bndry%bndry_type = fixed_layer_bndry + new_bndry%edge_width = width + +end function new_BoundaryFixedLayer + +function new_BoundaryFixedFlux() result(new_bndry) + type(BoundaryType) :: new_bndry + + new_bndry%bndry_type = fixed_flux_bndry + +end function new_BoundaryFixedFlux + +! The make_left and make_right methods implement the boundary conditions +! using an input seed. + +subroutine make_left(self, grid_spacing, seed, term1, term2) + class(BoundaryType), intent(in) :: self + real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) + procedure(deriv_seed) :: seed + real(r8), USE_CONTIGUOUS intent(out) :: term1(:) + real(r8), USE_CONTIGUOUS intent(out) :: term2(:) + + real(r8) :: del_plus(size(term1)), del_minus(size(term1)) + + select case (self%bndry_type) + case (zero_bndry) + term1 = 0._r8 + term2 = 0._r8 + case (first_order_bndry) + ! To calculate to first order, just use a really huge del_minus (i.e. + ! pretend that there's a point so far away it doesn't matter). + del_plus = grid_spacing(:,1) + del_minus = del_plus * 4._r8 / epsilon(1._r8) + call seed(del_minus, del_plus, term1, term2) + case (extrapolate_bndry) + ! To extrapolate from the boundary, use distance from the nearest + ! neighbor (as usual) and the second nearest neighbor (with a negative + ! sign, since we are using two points on the same side). + del_plus = grid_spacing(:,1) + del_minus = - (grid_spacing(:,1) + grid_spacing(:,2)) + call seed(del_minus, del_plus, term1, term2) + case (fixed_layer_bndry) + ! Use edge value to extend the grid. + del_plus = grid_spacing(:,1) + del_minus = self%edge_width + call seed(del_minus, del_plus, term1, term2) + case (fixed_flux_bndry) + ! Treat grid as uniform, but then zero out the contribution from data + ! on one side (since it will be prescribed). + del_plus = grid_spacing(:,1) + del_minus = del_plus + call seed(del_minus, del_plus, term1, term2) + term1 = 0._r8 + case default + call shr_sys_abort("Invalid boundary type at "// & + errMsg(__FILE__, __LINE__)) + end select + +end subroutine make_left + +subroutine make_right(self, grid_spacing, seed, term1, term2) + class(BoundaryType), intent(in) :: self + real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) + procedure(deriv_seed) :: seed + real(r8), USE_CONTIGUOUS intent(out) :: term1(:) + real(r8), USE_CONTIGUOUS intent(out) :: term2(:) + + real(r8) :: del_plus(size(term1)), del_minus(size(term1)) + + select case (self%bndry_type) + case (zero_bndry) + term1 = 0._r8 + term2 = 0._r8 + case (first_order_bndry) + ! Use huge del_plus, analogous to how left boundary works. + del_minus = grid_spacing(:,size(grid_spacing, 2)) + del_plus = del_minus * 4._r8 / epsilon(1._r8) + call seed(del_minus, del_plus, term1, term2) + case (extrapolate_bndry) + ! Same strategy as left boundary, but reversed. + del_plus = - (grid_spacing(:,size(grid_spacing, 2) - 1) + & + grid_spacing(:,size(grid_spacing, 2))) + del_minus = grid_spacing(:,size(grid_spacing, 2)) + call seed(del_minus, del_plus, term1, term2) + case (fixed_layer_bndry) + ! Use edge value to extend the grid. + del_plus = self%edge_width + del_minus = grid_spacing(:,size(grid_spacing, 2)) + call seed(del_minus, del_plus, term1, term2) + case (fixed_flux_bndry) + ! Uniform grid, but with edge zeroed. + del_plus = grid_spacing(:,size(grid_spacing, 2)) + del_minus = del_plus + call seed(del_minus, del_plus, term1, term2) + term2 = 0._r8 + case default + call shr_sys_abort("Invalid boundary type at "// & + errMsg(__FILE__, __LINE__)) + end select + +end subroutine make_right + +subroutine boundary_type_finalize(self) + class(BoundaryType), intent(inout) :: self + + self%bndry_type = fixed_flux_bndry + if (allocated(self%edge_width)) deallocate(self%edge_width) + +end subroutine boundary_type_finalize + +! Constructor for TriDiagOp; this just sets the size and allocates +! arrays. +type(TriDiagOp) function new_TriDiagOp(nsys, ncel) + + integer, intent(in) :: nsys, ncel + + new_TriDiagOp%nsys = nsys + new_TriDiagOp%ncel = ncel + + allocate(new_TriDiagOp%spr(nsys,ncel-1), & + new_TriDiagOp%sub(nsys,ncel-1), & + new_TriDiagOp%diag(nsys,ncel), & + new_TriDiagOp%left_bound(nsys), & + new_TriDiagOp%right_bound(nsys)) + +end function new_TriDiagOp + +! Deallocator for TriDiagOp. +subroutine tridiag_finalize(self) + class(TriDiagOp), intent(inout) :: self + + self%nsys = 0 + self%ncel = 0 + + if (allocated(self%spr)) deallocate(self%spr) + if (allocated(self%sub)) deallocate(self%sub) + if (allocated(self%diag)) deallocate(self%diag) + if (allocated(self%left_bound)) deallocate(self%left_bound) + if (allocated(self%right_bound)) deallocate(self%right_bound) + +end subroutine tridiag_finalize + +! Boundary condition constructors. + +function new_BoundaryNoData() result(new_cond) + type(BoundaryCond) :: new_cond + + new_cond%cond_type = no_data_cond + ! No edge data, so leave it unallocated. + +end function new_BoundaryNoData + +function new_BoundaryData(data) result(new_cond) + real(r8), USE_CONTIGUOUS intent(in) :: data(:) + type(BoundaryCond) :: new_cond + + new_cond%cond_type = data_cond + new_cond%edge_data = data + +end function new_BoundaryData + +function new_BoundaryFlux(flux, dt, spacing) result(new_cond) + real(r8), USE_CONTIGUOUS intent(in) :: flux(:) + real(r8), intent(in) :: dt + real(r8), USE_CONTIGUOUS intent(in) :: spacing(:) + type(BoundaryCond) :: new_cond + + new_cond%cond_type = flux_cond + new_cond%edge_data = flux*dt/spacing + +end function new_BoundaryFlux + +! Application of input data. +! +! When no data is input, assume that any bound term is applied to the +! third element in from the edge for extrapolation. Boundary conditions +! that don't need any edge data at all can then simply set the boundary +! terms to 0. + +function apply_left(self, bound_term, array) result(delta_edge) + class(BoundaryCond), intent(in) :: self + real(r8), USE_CONTIGUOUS intent(in) :: bound_term(:) + real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) + real(r8) :: delta_edge(size(array, 1)) + + select case (self%cond_type) + case (no_data_cond) + delta_edge = bound_term*array(:,3) + case (data_cond) + delta_edge = bound_term*self%edge_data + case (flux_cond) + delta_edge = self%edge_data + case default + call shr_sys_abort("Invalid boundary condition at "// & + errMsg(__FILE__, __LINE__)) + end select + +end function apply_left + +function apply_right(self, bound_term, array) result(delta_edge) + class(BoundaryCond), intent(in) :: self + real(r8), USE_CONTIGUOUS intent(in) :: bound_term(:) + real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) + real(r8) :: delta_edge(size(array, 1)) + + select case (self%cond_type) + case (no_data_cond) + delta_edge = bound_term*array(:,size(array, 2)-2) + case (data_cond) + delta_edge = bound_term*self%edge_data + case (flux_cond) + delta_edge = self%edge_data + case default + call shr_sys_abort("Invalid boundary condition at "// & + errMsg(__FILE__, __LINE__)) + end select + +end function apply_right + +subroutine boundary_cond_finalize(self) + class(BoundaryCond), intent(inout) :: self + + self%cond_type = no_data_cond + if (allocated(self%edge_data)) deallocate(self%edge_data) + +end subroutine boundary_cond_finalize + +! Apply an operator and return the new data. +function apply_tridiag(self, array, l_cond, r_cond) result(output) + ! Operator to apply. + class(TriDiagOp), intent(in) :: self + ! Data to act on. + real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) + ! Objects representing boundary conditions. + class(BoundaryCond), target, intent(in), optional :: l_cond, r_cond + ! Function result. + real(r8) :: output(size(array, 1), size(array, 2)) + + ! Local objects to implement default. + class(BoundaryCond), pointer :: l_cond_loc, r_cond_loc + ! Default state is no data, no allocation/deallocation needed. + type(BoundaryCond), target :: cond_default + + ! Level index. + integer :: k + + if (present(l_cond)) then + l_cond_loc => l_cond + else + l_cond_loc => cond_default + end if + + if (present(r_cond)) then + r_cond_loc => r_cond + else + r_cond_loc => cond_default + end if + + ! Left boundary. + output(:,1) = self%diag(:,1)*array(:,1) + & + self%spr(:,1)*array(:,2) + & + l_cond_loc%apply_left(self%left_bound, array) + + do k = 2, self%ncel-1 + output(:,k) = & + self%sub(:,k-1)*array(:,k-1) + & + self%diag(:,k)*array(:,k ) + & + self%spr(:,k)*array(:,k+1) + end do + + ! Right boundary. + output(:,self%ncel) = & + self%sub(:,self%ncel-1)*array(:,self%ncel-1) + & + self%diag(:,self%ncel)*array(:,self%ncel) + & + r_cond_loc%apply_right(self%right_bound, array) + +end function apply_tridiag + +! Fill in the diagonal for a TriDiagOp for a derivative operator, where +! the off diagonal elements are already filled in. +subroutine make_tridiag_deriv_diag(self) + + class(TriDiagOp), intent(inout) :: self + + ! If a derivative operator operates on a constant function, it must + ! return 0 everywhere. To force this, make sure that all rows add to + ! zero in the matrix. + self%diag(:,:self%ncel-1) = - self%spr + self%diag(:,self%ncel) = - self%right_bound + self%diag(:,1) = self%diag(:,1) - self%left_bound + self%diag(:,2:) = self%diag(:,2:) - self%sub + +end subroutine make_tridiag_deriv_diag + +! Sum two TriDiagOp objects into a new one; this is just the addition of +! all the entries. +function add_tridiag_ops(op1, op2) result(new_op) + + type(TriDiagOp), intent(in) :: op1, op2 + type(TriDiagOp) :: new_op + + new_op = op1 + + call new_op%add(op2) + +end function add_tridiag_ops + +subroutine add_in_place_tridiag_ops(self, other) + + class(TriDiagOp), intent(inout) :: self + class(TriDiagOp), intent(in) :: other + + self%spr = self%spr + other%spr + self%sub = self%sub + other%sub + self%diag = self%diag + other%diag + + self%left_bound = self%left_bound + other%left_bound + self%right_bound = self%right_bound + other%right_bound + +end subroutine add_in_place_tridiag_ops + +! Subtract two TriDiagOp objects. +function subtract_tridiag_ops(op1, op2) result(new_op) + + type(TriDiagOp), intent(in) :: op1, op2 + type(TriDiagOp) :: new_op + + new_op = op1 + + call new_op%subtract(op2) + +end function subtract_tridiag_ops + +! Subtract two TriDiagOp objects. +subroutine subtract_in_place_tridiag_ops(self, other) + + class(TriDiagOp), intent(inout) :: self + class(TriDiagOp), intent(in) :: other + + self%spr = self%spr - other%spr + self%sub = self%sub - other%sub + self%diag = self%diag - other%diag + + self%left_bound = self%left_bound - other%left_bound + self%right_bound = self%right_bound - other%right_bound + +end subroutine subtract_in_place_tridiag_ops + +! Equivalent to adding a multiple of the identity. +subroutine scalar_add_tridiag(self, constant) + + class(TriDiagOp), intent(inout) :: self + real(r8), intent(in) :: constant + + self%diag = self%diag + constant + +end subroutine scalar_add_tridiag + +! Equivalent to adding the diagonal operator constructed from diag_array. +subroutine diagonal_add_tridiag(self, diag_array) + + class(TriDiagOp), intent(inout) :: self + real(r8), USE_CONTIGUOUS intent(in) :: diag_array(:,:) + + self%diag = self%diag + diag_array + +end subroutine diagonal_add_tridiag + +! Multiply a scalar by an array. +subroutine scalar_lmult_tridiag(self, constant) + + class(TriDiagOp), intent(inout) :: self + real(r8), intent(in) :: constant + + self%spr = self%spr * constant + self%sub = self%sub * constant + self%diag = self%diag * constant + + self%left_bound = self%left_bound * constant + self%right_bound = self%right_bound * constant + +end subroutine scalar_lmult_tridiag + +! Multiply in an array as if it contained the entries of a diagonal matrix +! being multiplied from the left. +subroutine diagonal_lmult_tridiag(self, diag_array) + + class(TriDiagOp), intent(inout) :: self + real(r8), USE_CONTIGUOUS intent(in) :: diag_array(:,:) + + self%spr = self%spr * diag_array(:,:self%ncel-1) + self%sub = self%sub * diag_array(:,2:) + self%diag = self%diag * diag_array(:,:) + + self%left_bound = self%left_bound * diag_array(:,1) + self%right_bound = self%right_bound * diag_array(:,self%ncel) + +end subroutine diagonal_lmult_tridiag + +! Decomposition constructor +! +! The equation to be solved later (with left_div) is: +! - A(k)*q(k+1) + B(k)*q(k) - C(k)*q(k-1) = D(k) +! +! The solution (effectively via LU decomposition) has the form: +! E(k) = C(k) / (B(k) - A(k)*E(k+1)) +! F(k) = (D(k) + A(k)*F(k+1)) / (B(k) - A(k)*E(k+1)) +! q(k) = E(k) * q(k-1) + F(k) +! +! Unlike Richtmyer and Morton, E and F are defined by iterating backward +! down to level 1, and then q iterates forward. +! +! E can be calculated and stored now, without knowing D. +! To calculate F later, we store A and the denominator. +function new_TriDiagDecomp(op, graft_decomp) result(decomp) + type(TriDiagOp), intent(in) :: op + type(TriDiagDecomp), intent(in), optional :: graft_decomp + + type(TriDiagDecomp) :: decomp + + integer :: k + + if (present(graft_decomp)) then + decomp%nsys = graft_decomp%nsys + decomp%ncel = graft_decomp%ncel + else + decomp%nsys = op%nsys + decomp%ncel = op%ncel + end if + + ! Simple allocation with no error checking. + allocate(decomp%ca(decomp%nsys,decomp%ncel)) + allocate(decomp%dnom(decomp%nsys,decomp%ncel)) + allocate(decomp%ze(decomp%nsys,decomp%ncel)) + + ! decomp%ca is simply the negative of the tridiagonal's superdiagonal. + decomp%ca(:,:op%ncel-1) = -op%spr + decomp%ca(:,op%ncel) = -op%right_bound + + if (present(graft_decomp)) then + ! Copy in graft_decomp beyond op%ncel. + decomp%ca(:,op%ncel+1:) = graft_decomp%ca(:,op%ncel+1:) + decomp%dnom(:,op%ncel+1:) = graft_decomp%dnom(:,op%ncel+1:) + decomp%ze(:,op%ncel+1:) = graft_decomp%ze(:,op%ncel+1:) + ! Fill in dnom edge value. + decomp%dnom(:,op%ncel) = 1._r8 / (op%diag(:,op%ncel) - & + decomp%ca(:,op%ncel)*decomp%ze(:,op%ncel+1)) + else + ! If no grafting, the edge value of dnom comes from the diagonal. + decomp%dnom(:,op%ncel) = 1._r8 / op%diag(:,op%ncel) + end if + + do k = op%ncel - 1, 1, -1 + decomp%ze(:,k+1) = - op%sub(:,k) * decomp%dnom(:,k+1) + decomp%dnom(:,k) = 1._r8 / & + (op%diag(:,k) - decomp%ca(:,k)*decomp%ze(:,k+1)) + end do + + ! Don't multiply edge level by denom, because we want to leave it up to + ! the BoundaryCond object to decide what this means in left_div. + decomp%ze(:,1) = -op%left_bound + +end function new_TriDiagDecomp + +! Left-division (multiplication by inverse) using a decomposed operator. +! +! See the comment above for the constructor for a quick explanation of the +! intermediate variables. The "q" argument is "D(k)" on input and "q(k)" on +! output. +subroutine decomp_left_div(decomp, q, l_cond, r_cond) + + ! Decomposed matrix. + class(TriDiagDecomp), intent(in) :: decomp + ! Data to left-divide by the matrix. + real(r8), USE_CONTIGUOUS intent(inout) :: q(:,:) + ! Objects representing boundary conditions. + class(BoundaryCond), intent(in), optional :: l_cond, r_cond + + ! "F" from the equation above. + real(r8) :: zf(decomp%nsys,decomp%ncel) + + ! Level index. + integer :: k + + ! Include boundary conditions. + if (present(l_cond)) then + q(:,1) = q(:,1) + l_cond%apply_left(decomp%ze(:,1), q) + end if + + if (present(r_cond)) then + q(:,decomp%ncel) = q(:,decomp%ncel) + & + r_cond%apply_right(decomp%ca(:,decomp%ncel), q) + end if + + zf(:,decomp%ncel) = q(:,decomp%ncel) * decomp%dnom(:,decomp%ncel) + + do k = decomp%ncel - 1, 1, -1 + zf(:,k) = (q(:,k) + decomp%ca(:,k)*zf(:,k+1)) * decomp%dnom(:,k) + end do + + ! Perform back substitution + + q(:,1) = zf(:,1) + + do k = 2, decomp%ncel + q(:,k) = zf(:,k) + decomp%ze(:,k)*q(:,k-1) + end do + +end subroutine decomp_left_div + +! Decomposition deallocation. +subroutine decomp_finalize(decomp) + class(TriDiagDecomp), intent(inout) :: decomp + + decomp%nsys = 0 + decomp%ncel = 0 + + if (allocated(decomp%ca)) deallocate(decomp%ca) + if (allocated(decomp%dnom)) deallocate(decomp%dnom) + if (allocated(decomp%ze)) deallocate(decomp%ze) + +end subroutine decomp_finalize + +end module linear_1d_operators diff --git a/src/utils/marsaglia.F90 b/src/utils/marsaglia.F90 new file mode 100644 index 0000000000..8e95ce7944 --- /dev/null +++ b/src/utils/marsaglia.F90 @@ -0,0 +1,43 @@ +module marsaglia +! public domain code +! made available from http://www.fortran.com/ +! downloaded by pjr on 03/16/04 +! converted to vector form, functions inlined by pjr,mvr on 05/10/2004 + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +save +private +public :: kissvec + +contains + subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) +! The KISS (Keep It Simple Stupid) random number generator. Combines: +! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32. +! (2) A 3-shift shift-register generator, period 2^32-1, +! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59 +! Overall period>2^123; +! + implicit none + REAL(r8), DIMENSION (:), INTENT(INOUT) :: ran_arr + INTEGER, DIMENSION(:), INTENT(INOUT) :: seed1,seed2,seed3,seed4 + integer :: i,sz,kiss + integer :: m, k, n + +! inline function + m(k, n) = ieor (k, ishft (k, n) ) + + sz = SIZE(ran_arr) + DO i = 1, sz + seed1(i) = 69069 * seed1(i) + 1327217885 + seed2(i) = m (m (m (seed2(i), 13), - 17), 5) + seed3(i) = 18000 * iand (seed3(i), 65535) + ishft (seed3(i), - 16) + seed4(i) = 30903 * iand (seed4(i), 65535) + ishft (seed4(i), - 16) + kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16) + seed4(i) + ran_arr(i) = kiss*2.328306e-10_r8 + 0.5_r8 + end do + + end subroutine kissvec + +end module marsaglia diff --git a/src/utils/mpishorthand.F b/src/utils/mpishorthand.F new file mode 100644 index 0000000000..a8b475aec3 --- /dev/null +++ b/src/utils/mpishorthand.F @@ -0,0 +1,45 @@ +!----------------------------------------------------------------------------------- +! +! Purpose: +! +! Data and parameters used for MPI. Some shorthand variables with shorter +! names than the standard MPI parameters. Also some variables used for heap +! management. +! +! Note: The #include of "mpif.h" which is typically in f77 fixed format means that +! this module MUST be in fixed format. +! +! Author: Jim Rosinski +! +! $Id$ +! +!----------------------------------------------------------------------------------- + module mpishorthand + public +#if (defined SPMD) +#include + +! +! Need to set as variables rather than parameters since some MPI implementations +! set values for MPI tags at run time +! + integer, public :: mpiint ! MPI integers + integer, public :: mpii8 ! MPI integers for i8 + integer, public :: mpichar ! MPI character data + integer, public :: mpilog ! MPI logical data + integer, public :: mpir4 ! MPI real data for r4 + integer, public :: mpir8 ! MPI real data + integer, public :: mpic16 ! MPI complex data + integer, public :: mpicom ! MPI communication + integer, public :: mpipk ! MPI packed data + integer, public :: mpimax ! MPI max operator +! +! Common info for heap manager +! + integer, public:: nsend = 0 ! Number of MPI messages sent + integer, public:: nrecv = 0 ! Number of MPI messages received + integer, public:: nwsend = 0 ! Number of MPI words sent + integer, public:: nwrecv = 0 ! Number of MPI words received + +#endif + end module mpishorthand diff --git a/src/utils/namelist_utils.F90 b/src/utils/namelist_utils.F90 new file mode 100644 index 0000000000..c12dfad2d6 --- /dev/null +++ b/src/utils/namelist_utils.F90 @@ -0,0 +1,6 @@ +module namelist_utils + +use shr_nl_mod, only: & + find_group_name => shr_nl_find_group_name + +end module namelist_utils diff --git a/src/utils/orbit.F90 b/src/utils/orbit.F90 new file mode 100644 index 0000000000..bb110f578e --- /dev/null +++ b/src/utils/orbit.F90 @@ -0,0 +1,56 @@ +module orbit + +contains + +subroutine zenith(calday ,clat , clon ,coszrs ,ncol, dt_avg ) +!----------------------------------------------------------------------- +! +! Purpose: +! Compute cosine of solar zenith angle for albedo and radiation +! computations. +! +! Method: +! +! +! +! Author: J. Kiehl +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_orb_mod + use cam_control_mod, only: lambm0, obliqr, eccen, mvelpp + implicit none + +!------------------------------Arguments-------------------------------- +! +! Input arguments +! + integer, intent(in) :: ncol ! number of positions + real(r8), intent(in) :: calday ! Calendar day, including fraction + real(r8), intent(in) :: clat(ncol) ! Current centered latitude (radians) + real(r8), intent(in) :: clon(ncol) ! Centered longitude (radians) + real(r8), intent(in), optional :: dt_avg ! if present, time step to use for the shr_orb_cosz calculation +! +! Output arguments +! + real(r8), intent(out) :: coszrs(ncol) ! Cosine solar zenith angle +! +!---------------------------Local variables----------------------------- +! + integer i ! Position loop index + real(r8) delta ! Solar declination angle in radians + real(r8) eccf ! Earth orbit eccentricity factor +! +!----------------------------------------------------------------------- +! + call shr_orb_decl (calday ,eccen ,mvelpp ,lambm0 ,obliqr , & + delta ,eccf ) +! +! Compute local cosine solar zenith angle, +! + do i=1,ncol + coszrs(i) = shr_orb_cosz( calday, clat(i), clon(i), delta, dt_avg ) + end do + +end subroutine zenith +end module orbit diff --git a/src/utils/physconst.F90 b/src/utils/physconst.F90 new file mode 100644 index 0000000000..7670cd22b4 --- /dev/null +++ b/src/utils/physconst.F90 @@ -0,0 +1,404 @@ +module physconst + +! Physical constants. Use csm_share values whenever available. + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: shr_const_g, shr_const_stebol, shr_const_tkfrz, & + shr_const_mwdair, shr_const_rdair, shr_const_mwwv, & + shr_const_latice, shr_const_latvap, shr_const_cpdair, & + shr_const_rhofw, shr_const_cpwv, shr_const_rgas, & + shr_const_karman, shr_const_pstd, shr_const_rhodair,& + shr_const_avogad, shr_const_boltz, shr_const_cpfw, & + shr_const_rwv, shr_const_zvir, shr_const_pi, & + shr_const_rearth, shr_const_sday, shr_const_cday, & + shr_const_spval, shr_const_omega, shr_const_cpvir, & + shr_const_tktrip, shr_const_cpice + use shr_flux_mod, only: shr_flux_adjust_constants + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use cam_abortutils, only: endrun +use constituents, only: pcnst + +implicit none +private +save + +public :: physconst_readnl +public :: physconst_init +public :: physconst_update +public :: physconst_calc_kappav + +! Constants based off share code or defined in physconst + +real(r8), public, parameter :: avogad = shr_const_avogad ! Avogadro's number (molecules/kmole) +real(r8), public, parameter :: boltz = shr_const_boltz ! Boltzman's constant (J/K/molecule) +real(r8), public, parameter :: cday = shr_const_cday ! sec in calendar day ~ sec +real(r8), public, parameter :: cpliq = shr_const_cpfw ! specific heat of fresh h2o (J/K/kg) +real(r8), public, parameter :: cpice = shr_const_cpice ! specific heat of ice (J/K/kg) +real(r8), public, parameter :: karman = shr_const_karman ! Von Karman constant +real(r8), public, parameter :: latice = shr_const_latice ! Latent heat of fusion (J/kg) +real(r8), public, parameter :: latvap = shr_const_latvap ! Latent heat of vaporization (J/kg) +real(r8), public, parameter :: pi = shr_const_pi ! 3.14... +real(r8), public, parameter :: pstd = shr_const_pstd ! Standard pressure (Pascals) +real(r8), public, parameter :: r_universal = shr_const_rgas ! Universal gas constant (J/K/kmol) +real(r8), public, parameter :: rhoh2o = shr_const_rhofw ! Density of liquid water (STP) +real(r8), public, parameter :: spval = shr_const_spval !special value +real(r8), public, parameter :: stebol = shr_const_stebol ! Stefan-Boltzmann's constant (W/m^2/K^4) +real(r8), public, parameter :: h2otrip = shr_const_tktrip ! Triple point temperature of water (K) + +real(r8), public, parameter :: c0 = 2.99792458e8_r8 ! Speed of light in a vacuum (m/s) +real(r8), public, parameter :: planck = 6.6260755e-34_r8 ! Planck's constant (J.s) + +! Molecular weights +real(r8), public, parameter :: mwco2 = 44._r8 ! molecular weight co2 +real(r8), public, parameter :: mwn2o = 44._r8 ! molecular weight n2o +real(r8), public, parameter :: mwch4 = 16._r8 ! molecular weight ch4 +real(r8), public, parameter :: mwf11 = 136._r8 ! molecular weight cfc11 +real(r8), public, parameter :: mwf12 = 120._r8 ! molecular weight cfc12 +real(r8), public, parameter :: mwo3 = 48._r8 ! molecular weight O3 +real(r8), public, parameter :: mwso2 = 64._r8 +real(r8), public, parameter :: mwso4 = 96._r8 +real(r8), public, parameter :: mwh2o2 = 34._r8 +real(r8), public, parameter :: mwdms = 62._r8 +real(r8), public, parameter :: mwnh4 = 18._r8 + + +! modifiable physical constants for aquaplanet + +real(r8), public, protected :: gravit = shr_const_g ! gravitational acceleration (m/s**2) +real(r8), public, protected :: sday = shr_const_sday ! sec in siderial day ~ sec +real(r8), public, protected :: mwh2o = shr_const_mwwv ! molecular weight h2o +real(r8), public, protected :: cpwv = shr_const_cpwv ! specific heat of water vapor (J/K/kg) +real(r8), public, protected :: mwdry = shr_const_mwdair ! molecular weight dry air +real(r8), public, protected :: cpair = shr_const_cpdair ! specific heat of dry air (J/K/kg) +real(r8), public, protected :: rearth = shr_const_rearth ! radius of earth (m) +real(r8), public, protected :: tmelt = shr_const_tkfrz ! Freezing point of water (K) + +!--------------- Variables below here are derived from those above ----------------------- + +real(r8), public, protected :: rga = 1._r8/shr_const_g ! reciprocal of gravit +real(r8), public, protected :: ra = 1._r8/shr_const_rearth ! reciprocal of earth radius +real(r8), public, protected :: omega = shr_const_omega ! earth rot ~ rad/sec +real(r8), public, protected :: rh2o = shr_const_rwv ! Water vapor gas constant ~ J/K/kg +real(r8), public, protected :: rair = shr_const_rdair ! Dry air gas constant ~ J/K/kg +real(r8), public, protected :: epsilo = shr_const_mwwv/shr_const_mwdair ! ratio of h2o to dry air molecular weights +real(r8), public, protected :: zvir = shr_const_zvir ! (rh2o/rair) - 1 +real(r8), public, protected :: cpvir = shr_const_cpvir ! CPWV/CPDAIR - 1.0 +real(r8), public, protected :: rhodair = shr_const_rhodair ! density of dry air at STP ~ kg/m^3 +real(r8), public, protected :: cappa = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair ! R/Cp +real(r8), public, protected :: ez ! Coriolis expansion coeff -> omega/sqrt(0.375) +real(r8), public, protected :: Cpd_on_Cpv = shr_const_cpdair/shr_const_cpwv + +!--------------- Variables below here are for WACCM-X ----------------------- +real(r8), public, dimension(:,:,:), pointer :: cpairv ! composition dependent specific heat at constant pressure +real(r8), public, dimension(:,:,:), pointer :: rairv ! composition dependent gas "constant" +real(r8), public, dimension(:,:,:), pointer :: cappav ! rairv/cpairv +real(r8), public, dimension(:,:,:), pointer :: mbarv ! composition dependent atmosphere mean mass +real(r8), public, dimension(:,:,:), pointer :: kmvis ! molecular viscosity kg/m/s +real(r8), public, dimension(:,:,:), pointer :: kmcnd ! molecular conductivity J/m/s/K + +real(r8) :: o2_mwi, o_mwi, h_mwi, n2_mwi ! inverse molecular weights +integer :: o2_ndx=-1, o_ndx=-1, h_ndx=-1 ! constituent indexes + +!================================================================================================ +contains +!================================================================================================ + +! Read namelist variables. +subroutine physconst_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'physconst_readnl' + logical :: newg, newsday, newmwh2o, newcpwv, newmwdry, newcpair, newrearth, newtmelt + + ! Physical constants needing to be reset (ie. for aqua planet experiments) + namelist /physconst_nl/ gravit, sday, mwh2o, cpwv, mwdry, cpair, rearth, tmelt + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'physconst_nl', status=ierr) + if (ierr == 0) then + read(unitn, physconst_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(gravit, 1, mpir8, 0, mpicom) + call mpibcast(sday, 1, mpir8, 0, mpicom) + call mpibcast(mwh2o, 1, mpir8, 0, mpicom) + call mpibcast(cpwv, 1, mpir8, 0, mpicom) + call mpibcast(mwdry, 1, mpir8, 0, mpicom) + call mpibcast(cpair, 1, mpir8, 0, mpicom) + call mpibcast(rearth, 1, mpir8, 0, mpicom) + call mpibcast(tmelt, 1, mpir8, 0, mpicom) +#endif + + newg = gravit .ne. shr_const_g + newsday = sday .ne. shr_const_sday + newmwh2o = mwh2o .ne. shr_const_mwwv + newcpwv = cpwv .ne. shr_const_cpwv + newmwdry = mwdry .ne. shr_const_mwdair + newcpair = cpair .ne. shr_const_cpdair + newrearth= rearth .ne. shr_const_rearth + newtmelt = tmelt .ne. shr_const_tkfrz + + if (newg .or. newsday .or. newmwh2o .or. newcpwv .or. newmwdry .or. newrearth .or. newtmelt) then + if (masterproc) then + write(iulog,*)'****************************************************************************' + write(iulog,*)'*** New Physical Constant Values set via namelist ***' + write(iulog,*)'*** ***' + write(iulog,*)'*** Physical Constant Old Value New Value ***' + if (newg) write(iulog,*)'*** GRAVIT ',shr_const_g,gravit,'***' + if (newsday) write(iulog,*)'*** SDAY ',shr_const_sday,sday,'***' + if (newmwh2o) write(iulog,*)'*** MWH20 ',shr_const_mwwv,mwh2o,'***' + if (newcpwv) write(iulog,*)'*** CPWV ',shr_const_cpwv,cpwv,'***' + if (newmwdry) write(iulog,*)'*** MWDRY ',shr_const_mwdair,mwdry,'***' + if (newcpair) write(iulog,*)'*** CPAIR ',shr_const_cpdair,cpair,'***' + if (newrearth) write(iulog,*)'*** REARTH ',shr_const_rearth,rearth,'***' + if (newtmelt) write(iulog,*)'*** TMELT ',shr_const_tkfrz,tmelt,'***' + write(iulog,*)'****************************************************************************' + end if + rga = 1._r8/gravit + ra = 1._r8/rearth + omega = 2.0_R8*pi/sday + cpvir = cpwv/cpair - 1._r8 + epsilo = mwh2o/mwdry + + ! rair and rh2o have to be defined before any of the variables that use them + + rair = r_universal/mwdry + rh2o = r_universal/mwh2o + + cappa = rair/cpair + rhodair = pstd/(rair*tmelt) + zvir = (rh2o/rair)-1.0_R8 + ez = omega / sqrt(0.375_r8) + Cpd_on_Cpv = cpair/cpwv + + ! Adjust constants in shr_flux_mod. + call shr_flux_adjust_constants(zvir=zvir, cpvir=cpvir, gravit=gravit) + + else + ez = omega / sqrt(0.375_r8) + end if + +end subroutine physconst_readnl + +!=============================================================================== + +subroutine physconst_init() + use constituents, only: cnst_get_ind, cnst_mw + + integer :: n_ndx + integer :: ierr + real(r8) :: o2_mw, o_mw, h_mw, n_mw + + !------------------------------------------------------------------------------- + ! Allocate constituent dependent properties + !------------------------------------------------------------------------------- + allocate( cpairv(pcols,pver,begchunk:endchunk), & + rairv(pcols,pver,begchunk:endchunk), & + cappav(pcols,pver,begchunk:endchunk), & + mbarv(pcols,pver,begchunk:endchunk), & + kmvis(pcols,pverp,begchunk:endchunk), & + kmcnd(pcols,pverp,begchunk:endchunk), stat=ierr ) + if ( ierr /= 0 ) call endrun('physconst: allocate failed in physconst_init') + + !------------------------------------------------------------------------------- + ! Initialize constituent dependent properties + !------------------------------------------------------------------------------- + cpairv(:pcols,:pver,begchunk:endchunk) = cpair + rairv(:pcols,:pver,begchunk:endchunk) = rair + cappav(:pcols,:pver,begchunk:endchunk) = rair/cpair + mbarv(:pcols,:pver,begchunk:endchunk) = mwdry + + call cnst_get_ind('O2',o2_ndx,abort=.false.) + call cnst_get_ind('O' ,o_ndx, abort=.false.) + call cnst_get_ind('H' ,h_ndx, abort=.false.) + call cnst_get_ind('N' ,n_ndx, abort=.false.) + + if (o2_ndx>0) then + o2_mw = cnst_mw(o2_ndx) + o2_mwi = 1.0_r8/o2_mw + endif + if (o_ndx>0) then + o_mw = cnst_mw(o_ndx) + o_mwi = 1.0_r8/o_mw + endif + if (h_ndx>0) then + h_mw = cnst_mw(h_ndx) + h_mwi = 1.0_r8/h_mw + endif + if (n_ndx>0) then + n_mw = cnst_mw(n_ndx) + n2_mwi = 0.5_r8/n_mw + endif + +end subroutine physconst_init + +!=============================================================================== + + subroutine physconst_update(mmr, t, lchnk, ncol) + +!----------------------------------------------------------------------- +! Update the physics "constants" that vary +!----------------------------------------------------------------------- + +!------------------------------Arguments-------------------------------------------------------------- + + real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! constituents q array from state structure + real(r8), intent(in) :: t(pcols,pver) ! temperature t array from state structure + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns +! +!---------------------------Local storage------------------------------------------------------------- + integer :: i,k ! column,level,constituent indices + + real(r8):: mmro, mmro2, mmrh, mmrn2 ! Mass mixing ratios of O, O2, H, and N + real(r8):: mbarvi, tint ! Mean mass, temperature, and specific heat on interface levels + real(r8):: dof1, dof2 ! Degress of freedom for cpairv calculation + real(r8):: kv1, kv2, kv3, kv4 ! Coefficients for kmvis calculation + real(r8):: kc1, kc2, kc3, kc4 ! Coefficients for kmcnd calculation + !-------------------------------------------- + ! Set constants needed for updates + !-------------------------------------------- + dof1 = 5._r8 + dof2 = 7._r8 + kv1 = 4.03_r8 + kv2 = 3.42_r8 + kv3 = 3.9_r8 + kv4 = 0.69_r8 + kc1 = 56._r8 + kc2 = 56._r8 + kc3 = 75.9_r8 + kc4 = 0.69_r8 + + if (o2_ndx<0 .or. o_ndx<0 .or. h_ndx<0) then + call endrun('physconst_update: ERROR -- needed constituents are not available') + endif + + !-------------------------------------------- + ! update cpairv, rairv, mbarv, and cappav + !-------------------------------------------- + do k=1,pver + do i=1,ncol + mmro = mmr(i,k, o_ndx) + mmro2 = mmr(i,k, o2_ndx) + mmrh = mmr(i,k, h_ndx) + mmrn2 = 1._r8-mmro-mmro2-mmrh + mbarv(i,k,lchnk) = 1._r8/( mmro *o_mwi + & + mmro2*o2_mwi + & + mmrn2*n2_mwi + & + mmrh *h_mwi ) + rairv(i,k,lchnk) = shr_const_rgas / mbarv(i,k,lchnk) + cpairv(i,k,lchnk) = 0.5_r8*shr_const_rgas & + * ( dof1*mmro *o_mwi + & + dof2*mmro2*o2_mwi + & + dof2*mmrn2*n2_mwi + & + dof1*mmrh *h_mwi ) + + cappav(i,k,lchnk) = rairv(i,k,lchnk)/cpairv(i,k,lchnk) + enddo + enddo + + do k=2,pver + do i=1,ncol + mmro = .5_r8*(mmr(i,k-1, o_ndx)+mmr(i,k,o_ndx)) + mmro2 = .5_r8*(mmr(i,k-1, o2_ndx)+mmr(i,k,o2_ndx)) + mmrn2 = 1._r8-mmro-mmro2 + mbarvi = .5_r8*(mbarv(i,k-1,lchnk)+mbarv(i,k,lchnk)) + tint = .5_r8*(t(i,k-1)+t(i,k)) + + kmvis(i,k,lchnk) = (kv1*mmro2*o2_mwi+ & + kv2*mmrn2*n2_mwi+ & + kv3*mmro*o_mwi)*mbarvi* & + tint**kv4 * 1.e-7_r8 + kmcnd(i,k,lchnk) = (kc1*mmro2*o2_mwi+ & + kc2*mmrn2*n2_mwi+ & + kc3*mmro*o_mwi)*mbarvi* & + tint**kc4 * 1.e-5_r8 + enddo + enddo + do i=1,ncol + kmvis(i,1,lchnk) = 1.5_r8*kmvis(i,2,lchnk)-.5_r8*kmvis(i,3,lchnk) + kmcnd(i,1,lchnk) = 1.5_r8*kmcnd(i,2,lchnk)-.5_r8*kmcnd(i,3,lchnk) + kmvis(i,pverp,lchnk) = kmvis(i,pver,lchnk) + kmcnd(i,pverp,lchnk) = kmcnd(i,pver,lchnk) + enddo + + end subroutine physconst_update + +!=============================================================================== + + subroutine physconst_calc_kappav( i0,i1,j0,j1,k0,k1,ntotq, tracer, kappav, cpv ) + + ! args + integer, intent(in) :: i0,i1,j0,j1,k0,k1, ntotq + real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,ntotq) ! Tracer array + real(r8), intent(out) :: kappav(i0:i1,j0:j1,k0:k1) + real(r8), optional, intent(out) :: cpv(i0:i1,j0:j1,k0:k1) + + ! local vars + integer :: i,j,k + real(r8), dimension(i0:i1,j0:j1,k0:k1) :: rgas_var, cp_var, mmro, mmro2, mmrh, mmrn2 + + real(r8), parameter :: dof1 = 5.0_r8 ! Degrees of freedom for cpair3v calculation + real(r8), parameter :: dof2 = 7.0_r8 ! Degrees of freedom for cpair3v calculation + + if (o2_ndx<0 .or. o_ndx<0 .or. h_ndx<0) then + call endrun('physconst_calc_kappav: ERROR -- things are not initialized') + endif + + !----------------------------------------------------------------------- + ! Calculate constituent dependent specific heat, gas constant and cappa + !----------------------------------------------------------------------- +!$omp parallel do private(i,j,k) + do k = k0,k1 + do j = j0,j1 + do i = i0,i1 + mmro(i,j,k) = tracer(i,j,k,o_ndx) + mmro2(i,j,k) = tracer(i,j,k,o2_ndx) + mmrh(i,j,k) = tracer(i,j,k,h_ndx) + mmrn2(i,j,k) = 1._r8-mmro(i,j,k)-mmro2(i,j,k)-mmrh(i,j,k) + + rgas_var(i,j,k) = shr_const_rgas & + * ( mmro (i,j,k)*o_mwi + & + mmro2(i,j,k)*o2_mwi + & + mmrn2(i,j,k)*n2_mwi + & + mmrh (i,j,k)*h_mwi ) + + cp_var(i,j,k) = 0.5_r8*shr_const_rgas & + * ( dof1*mmro (i,j,k)*o_mwi + & + dof2*mmro2(i,j,k)*o2_mwi + & + dof2*mmrn2(i,j,k)*n2_mwi + & + dof1*mmrh (i,j,k)*h_mwi ) + + kappav(i,j,k) = rgas_var(i,j,k)/cp_var(i,j,k) + + enddo + enddo + enddo + + if (present(cpv)) then + cpv(:,:,:) = cp_var(:,:,:) + endif + + end subroutine physconst_calc_kappav + +end module physconst diff --git a/src/utils/pilgrim/Makefile b/src/utils/pilgrim/Makefile new file mode 100644 index 0000000000..7e300fb39e --- /dev/null +++ b/src/utils/pilgrim/Makefile @@ -0,0 +1,104 @@ +#------------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#------------------------------------------------------------------------- +# +# !ROUTINE: Makefile +# +# !DESCRIPTION: +# +# Makefile for GFIO Library and documentation. +# You must enter +# +# ./configure +# +# before attempting to make anything in this Makefile. +# +# !SEE ALSO: +# +# configure +# Makefile.conf.* +# +# +# !REVISION HISTORY: +# +# 14Mar02 Sawyer Adapted previous Makefile for FVDAS +# +# +#----------------------------------------------------------------------- +# +# System Dependent Parameters +# --------------------------- + +COREROOT = ../../.. +COREBIN = $(COREROOT)/bin +CORELIB = $(COREROOT)/lib +COREINC = $(COREROOT)/include +COREETC = $(COREROOT)/etc + +CP = /bin/cp -p +RANLIB = touch +MKDIR = mkdir -p + +PILGRIMLIB = libpilgrim.a +SEQSRCS = debugutilitiesmodule.F90 \ + decompmodule.F90 ghostmodule.F90 +PUMSRCS = mod_comm.F90 parutilitiesmodule.F90 \ + redistributemodule.F90 puminterfaces.F90 +CSRCS = memstuff.c mp_assign_to_cpu.c + +SEQOBJS = ${SEQSRCS:.F90=.o} +PUMOBJS = ${PUMSRCS:.F90=.o} +COBJS = ${CSRCS:.c=.o} + +OPTIONS = $(_IMPI) + +.SUFFIXES: .F90 .c .o +# ------------------------------------------------------------------- + +include Makefile.conf + +All: mpi + +all: mpi + +mpi: spmdclean library parutil + +mlp: spmdclean library mlpparutil + +tests: mpi + (cd unit_testers; make tests) + +library: $(SEQOBJS) + -@${RM} -f $(PILGRIMLIB) + $(AR) $(PILGRIMLIB) $(SEQOBJS) + +parutil: $(PUMOBJS) + $(AR) $(PILGRIMLIB) $(PUMOBJS) + +mlpparutil: $(COBJS) + $(FC) $(FFLAGS) $(DFLAGS) $(OPTIONS) -DUSE_MLP -c $(PUMSRCS) + $(AR) $(PILGRIMLIB) $(PUMOBJS) $(COBJS) + +# Export library (fvDAS specific) +# ------------------------------- +export: mpi + $(MKDIR) $(CORELIB) $(COREINC)/pilgrim + $(CP) libpilgrim.a $(CORELIB) + $(CP) *.[Mm][Oo][Dd] $(COREINC)/pilgrim + $(RANLIB) $(CORELIB)/libpilgrim.a + +.F90.o: + $(FC) $(FFLAGS) $(DFLAGS) $(OPTIONS) -c $< + +.c.o: + ${CC} ${INCLUDE} ${CFLAGS} -DUSE_MLP $(OPTIONS) -c $< + +clean: + -@${RM} -f $(PILGRIMLIB) $(SEQOBJS) $(PUMOBJS) $(COBJS) *~ *.mod *.MOD + -@${RM} -rf rii_files + +libclean: + -@${RM} -f $(PILGRIMLIB) + +spmdclean: + -@${RM} -f $(PUMOBJS) diff --git a/src/utils/pilgrim/Makefile.conf.AIX b/src/utils/pilgrim/Makefile.conf.AIX new file mode 100644 index 0000000000..ae885e7127 --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.AIX @@ -0,0 +1,45 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.IRIX64 +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - W. Sawyer - From Hermes version +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = mpxlf90 +FFLAGS = -qsuffix=f=f90:cpp=F90 -cpp -qxlf77=intxor -qrealsize=8 -qintsize=4 -qarch=auto -qhot -O2 +DFLAGS = -WF,-DSPMD -WF,-DSTAND_ALONE + +CC = cc +CFLAGS = -O3 -qrealsize=8 -qintsize=4 -DIRIX64 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +_LMPI = +_lMPI = -lmpi +_IMPI = -I/usr/include + +LD = $(FC) +LDFLAGS = -O3 +AR = ar -clr +RM = rm + +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/Makefile.conf.IRIX64 b/src/utils/pilgrim/Makefile.conf.IRIX64 new file mode 100644 index 0000000000..66c557cbc8 --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.IRIX64 @@ -0,0 +1,45 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.IRIX64 +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - W. Sawyer - From Hermes version +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = f90 +FFLAGS = -O3 -64 -cpp -mp -extend_source -DIRIX64 -I. +DFLAGS = -DSPMD -DSTAND_ALONE + +CC = cc +CFLAGS = -64 -DIRIX64 -O2 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +_LMPI = +_lMPI = -lmpi +_IMPI = + +LD = $(FC) +LDFLAGS = -mp -64 +AR = ar -clr +RM = rm + +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/Makefile.conf.Linux b/src/utils/pilgrim/Makefile.conf.Linux new file mode 100644 index 0000000000..71d5241219 --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.Linux @@ -0,0 +1,46 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.Linux +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - Sawyer - Initial code (adapted from gfio) +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = lf95 +FFLAGS = -O -fw -Am -X9 -w -CcdRR8 -Kfast,eval,fastlib,auto +#FFLAGS = -O -fw -Am -X9 -w -CcdRR8 +DFLAGS = -DSPMD -DSTAND_ALONE + +CC = gcc +CFLAGS = -DLinux -O2 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +_LMPI = -L/usr/local/mpich-1.2.1-ffc/lib +_lMPI = -lmpich +_IMPI = -I/usr/local/mpich-1.2.1-ffc/include + +LD = $(FC) +LDFLAGS = + +AR = ar -r +RM = rm -f +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/Makefile.conf.Linux.FFC b/src/utils/pilgrim/Makefile.conf.Linux.FFC new file mode 100644 index 0000000000..49ec2dc1dc --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.Linux.FFC @@ -0,0 +1,46 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.Linux +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - Sawyer - Initial code (adapted from gfio) +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = f90 +FFLAGS = -O -fw -Am -X9 -w -CcdRR8 -Kfast,eval,fastlib,auto +#FFLAGS = -O -fw -Am -X9 -w -CcdRR8 +DFLAGS = -DSPMD -DSTAND_ALONE + +CC = gcc +CFLAGS = -DLinux -O2 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +_LMPI = -L/usr/local/mpich-1.2.1-ffc/lib +_lMPI = -lmpich +_IMPI = -I/usr/local/mpich-1.2.1-ffc/include + +LD = $(FC) +LDFLAGS = + +AR = ar -r +RM = rm -f +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/Makefile.conf.Linux.LF95 b/src/utils/pilgrim/Makefile.conf.Linux.LF95 new file mode 100644 index 0000000000..92e0845ff4 --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.Linux.LF95 @@ -0,0 +1,42 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.Linux +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - Sawyer - Initial code (adapted from gfio) +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = lf95 +FFLAGS = -O -fw -Am -X9 -w -CcdRR8 -Kfast,eval,fastlib,auto +#FFLAGS = -O -fw -Am -X9 -w -CcdRR8 +DFLAGS = -DSPMD -DSTAND_ALONE + +CC = gcc +CFLAGS = -DLinux -O2 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +LD = $(FC) +LDFLAGS = + +AR = ar -r +RM = rm -f +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/Makefile.conf.Linux.PGI b/src/utils/pilgrim/Makefile.conf.Linux.PGI new file mode 100644 index 0000000000..9559564b2c --- /dev/null +++ b/src/utils/pilgrim/Makefile.conf.Linux.PGI @@ -0,0 +1,45 @@ +#!/bin/make +#----------------------------------------------------------------------- +# NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +#----------------------------------------------------------------------- +# !IROUTINE: Makefile.conf.Linux +# +# !DESCRIPTION: +# An included local make configuration. See file Makefile for +# detailed `make' procedure. This shell has been built to override +# the default environments (including commands) defined in file +# Makefile. +# +# + `uname -a` = "OSF1 molotov V3.2 17 alpha" +# +# !CALLING SEQUENCE: +# % ln -s Makefile.OSF1 Makefile.conf +# % make ... +# +# !SEE ALSO: Makefile +# +# !REVISION HISTORY: (`cvs log <>' for more) +# 14Mar02 - Sawyer - Adapted from gfio +# +#----------------------------------------------------------------------- + +# Environments +# ============ + +FC = pgf90 +FFLAGS = -O -Mextend -r8 -byteswapio +DFLAGS = -DSPMD -DSTAND_ALONE + +CC = gcc +CFLAGS = -DLinux -O2 -DFORTRANUNDERSCORE -DSET_CPUS -DPIN_CPUS + +_LMPI = -L/usr/local/mpich-1.2.1-pgi/lib +_lMPI = -lmpich +_IMPI = -I/usr/local/mpich-1.2.1-pgi/include + +LD = $(FC) +LDFLAGS = +AR = ar -r +RM = rm + +#.---------------------------------------------------------------------- diff --git a/src/utils/pilgrim/README b/src/utils/pilgrim/README new file mode 100644 index 0000000000..704d8380df --- /dev/null +++ b/src/utils/pilgrim/README @@ -0,0 +1,71 @@ + PILGRIM Library + --------------- + +This directory contains a prototype for Parallel Library for Grid +Manipulations. Note that it is neither complete nor does it +necessarily contain components which are a baseline for future +development. At any one time this directory will contain prototypes +and unit tests, some of which can be used for benchmarking purposes. + +As of 15 March 2002, this directory contains: + + README This file + Makefile The makefile + Makefile.conf.XXXX Configurations for various platforms + configure Script to set up for your platform + debug.h Debugging macros used in PILGRIM + debugutilitiesmodule.F90 Debugging utilities + decompmodule.F90 Decomposition utilities + ghostmodule.F90 Ghosting utilities + parutilitiesmodule.F90 High level communication primitives + redistributemodule.F90 Redistribute module + memstuff.c SGI specific utilities + mp_assign_to_cpu.c SGI specific utilities + mod_comm.F90 Basic communication primitives + unit_testers Directory containing unit testers + pilgrim.h Include file + +Installation: +------------- + + 1) Run ./configure -- this will create Makefile.conf, a + link to the appropriate Makefile.conf.XXXXX file. + If the appropriate Makefile.conf.XXXXX for your + architecture does not exist, create one from one + of the other examples and please mail it to the + author, sawyer@dao.gsfc.nasa.gov + + 2) Some editting of Makefile.conf might be necessary. + For example, you may have to change the values + of _LMPI (location of the MPI library), _lMPI + (name of the MPI library), and _IMPI (location + of the MPI include files, e.g. mpif.h). + + 3) Type "make". This should build "libpilgrim.a". + + 4) Optional: + + cd unit_testers + make tests + + mpirun -np nnnn XXXXXest + +Documentation, usage: +--------------------- + + Please consult DAO office not 1998-008 for more information: + + http://dao.gsfc.nasa.gov/pages/officenotes_1998.html + + Unfortunately this is rather outdated -- there have been many + developments since this was published. For more recent information: + + http://www.iac.ethz.ch/staff/sawyer/pilgrim.html + + + For a wide array of programming examples, please look at + the unit testers: + + unit_testers/*test.F90 + +WS, sawyer@dao.gsfc.nasa.gov, 2002.03.15 diff --git a/src/utils/pilgrim/configure b/src/utils/pilgrim/configure new file mode 100755 index 0000000000..3009250e1a --- /dev/null +++ b/src/utils/pilgrim/configure @@ -0,0 +1,51 @@ +#!/bin/csh +# +# Creates configuration Makefile. Before attempting to make anything +# in this directory, enter +# +# ./configure +# +# !REVISION HISTORY +# +# 14mar02 Sawyer Initial code (adapted from gfio/configure) +# +#..................................................................... + +if ( $#argv >= 1 ) then + cd ../include + if($status) exit 1 + echo "Usage: " + echo " configure " + echo " " + exit 1 +endif + +# First try a site specific Makefile.conf +# --------------------------------------- + set makeconf = Makefile.conf.`uname -n` + +# If there is no such a thing, try an Architecture dependent +# ---------------------------------------------------------- + if ( ! (-e $makeconf) ) set makeconf = Makefile.conf.`uname -s` + + +# Just make the symlink() +# ----------------------- + if ( -e $makeconf ) then + rm -f Makefile.conf + ln -s $makeconf Makefile.conf + echo " " + echo "configure: successful configuration - Makefile.conf is $makeconf" + echo " " + + else + echo " " + echo error: cannot find site or arch dependent Makefile.conf + echo " " + exit 1 + + endif + +# All done +# -------- + exit 0 diff --git a/src/utils/pilgrim/debug.h b/src/utils/pilgrim/debug.h new file mode 100644 index 0000000000..319bde00c6 --- /dev/null +++ b/src/utils/pilgrim/debug.h @@ -0,0 +1,60 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +!------------------------------------------------------------------------- +!BOP +! +! !INCLUDE: Debug.h --- Debugging Macros +! +! !DESCRIPTION: +! +! The following CPP macros define the calls to the F90ass, Enter +! and Leave in DebugUtilitiesModule.F if the -DDEBUG\_ON option +! is set on the compile line. The line \#include makes +! use of these facilities. In production compilations where +! DEBUG\_ON is not set, Debug.h defines blank lines and thus +! does not affect code performance. +! +! Note that, unlike other include statements, "Debug.h" must be +! included {\it before} the IMPLICIT NONE statement (since +! "Debug.h" contains a USE DebugUtilitiesModule statement). +! +! Compile options used: {\tt DEBUG\_ON} +! +! !SEE ALSO: +! +! DebugUtilitiesModule.F - Debugging module (implementation) +! +! !REVISION HISTORY: +! +! 97.09.30 Sawyer Creation +! 98.03.09 Sawyer Renamed Debug.h, prepared for Walkthrough +! 98.09.03 Sawyer DEBUG_ON does not work with f90 -cpp on SGI +! +!EOP +!------------------------------------------------------------------------- +!BOC +#if defined( DEBUG_ON ) && !defined( IRIX64 ) +! +! This include file is unusual in that it MUST BE PLACED BEFORE +! IMPLICIT NONE, not it the usual location for include files +! + USE DebugUtilitiesModule, ONLY: DumAssert, DumEnter, DumLeave +#endif + +#if defined( DEBUG_ON ) && !defined( IRIX64 ) +#define CPP_ASSERT_INFO(cond_) PRINT *, "Assert: ", cond_," l:", __LINE__ +#define CPP_ASSERT_F90(cond_) CALL DumAssert(cond_,__FILE__,__LINE__) +#else +#define CPP_ASSERT_INFO(cond_) ! PRINT *, "Assert: ", Excised Test," l:", __LINE__ +#define CPP_ASSERT_F90(cond_) ! CALL DumAssert(Excised Test,__FILE__,__LINE__) +#endif + +#if defined( DEBUG_ON ) && !defined( IRIX64 ) +#define CPP_ENTER_PROCEDURE(ROUTINE_NAME) CALL DumEnter( ROUTINE_NAME ) +#define CPP_LEAVE_PROCEDURE(ROUTINE_NAME) CALL DumLeave( ROUTINE_NAME ) +#else +#define CPP_ENTER_PROCEDURE(ROUTINE_NAME) ! CALL DumEnter( ROUTINE_NAME ) +#define CPP_LEAVE_PROCEDURE(ROUTINE_NAME) ! CALL DumLeave( ROUTINE_NAME ) +#endif +!EOC +!------------------------------------------------------------------------- diff --git a/src/utils/pilgrim/debugutilitiesmodule.F90 b/src/utils/pilgrim/debugutilitiesmodule.F90 new file mode 100644 index 0000000000..34932fdace --- /dev/null +++ b/src/utils/pilgrim/debugutilitiesmodule.F90 @@ -0,0 +1,253 @@ +!------------------------------------------------------------------------- +! Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- + MODULE debugutilitiesmodule +!BOP +! +! !MODULE: debugutilitiesmodule +! +! !USES: +#if defined( STAND_ALONE ) +# define iulog 6 +#else + use cam_logfile, only: iulog +#endif + IMPLICIT NONE + +#define MAX_STACK_LEVEL 20 +#define MAX_STRING_LEN 40 +! +! !PUBLIC MEMBER FUNCTIONS: + PUBLIC DumAssert, DumEnter, DumLeave + +! +! !DESCRIPTION: +! +! This module provides the basic utilities to support debugging +! +! \begin{tabular}{|l|l|} \hline \hline +! DumAssert & Make an assertion \\ \hline +! DumEnter & Tracing: enter a subroutine \\ \hline +! DumLeave & Tracing: leave a subroutine \\ \hline +! \end{tabular} +! +! The DumAssert makes an assertion (i.e., claims that a boolean +! argument is true) for a given line of code in a given source +! file. DumEnter and DumLeave to be used as a pair and placed at the +! beginning and end of routines to be traced. +! +! It is not intended for the user to make use of these routines +! directly but rather in conjunction with the CPP macros defined +! in the "Debug.h" file in the INCLUDE directory. The CPP +! macros define the calls to the three above-mention routines if +! the -DDEBUG\_ON option is set on the compile line. The line +! \#include "Debug.h" statement in any routine which makes use +! of these facilities. In production compilations where DEBUG\_ON +! is not set, "Debug.h" defines blank lines and thus does not +! affect code performance. The CPP definition of DEBUG\_LEVEL in +! the compile line, e.g., -DDEBUG\_LEVEL=2, denotes the level +! of debugging performed. A higher level performs all the +! debugging at the lower levels and then some. +! +! Note that, unlike other include statements, "Debug.h" must be +! included {\it before} the IMPLICIT NONE statement (since "Debug.h" +! contains a USE DebugModule statement. +! +! Compile options used: {\tt MPI\_VER}, {\tt DEBUG\_LEVEL} +! +! !LOCAL VARIABLES: + CHARACTER(len=MAX_STRING_LEN) :: TraceStack( MAX_STACK_LEVEL ) + INTEGER :: StackLevel = 0 +! +! !REVISION HISTORY: +! 97.09.30 Sawyer Creation +! 98.03.09 Sawyer Added documentation for walkthrough +! 01.02.12 Sawyer Converted to free format +! +! !BUGS: +! +!EOP + CONTAINS +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: DumAssert --- Raise Assertion +! +! !INTERFACE: + SUBROUTINE DumAssert ( Condition, FileName, Linenumber ) +! +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + LOGICAL, INTENT(IN) :: Condition ! Condition asserted + CHARACTER(*), INTENT(IN) :: FileName ! Source file + INTEGER, INTENT( IN ) :: LineNumber ! Source line + +! !DESCRIPTION: +! Condition is claimed by the calling Routine in Filename at +! Linenumber to be true. If it is, do nothing. If not, print +! as much information as possible. +! +! \begin{tabular}{|c|l|} \hline \hline +! {\bf Debug Level} & {\bf Action} \\ \hline \hline +! 0 & Return immediately \\ \hline +! 1 & Print assertion failed \\ \hline +! 2 & Print assertion failed and trace stack \\ \hline +! \end{tabular} +! +! !LOCAL VARIABLES: + INTEGER I, MyID, Ierror +! +! !SYSTEM ROUTINES: +! +! !REVISION HISTORY: +! 97.09.30 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC + +#if !defined(DEBUG_LEVEL) +#define DEBUG_LEVEL 1 +#endif + +#if ( DEBUG_LEVEL > 0 ) + IF (.NOT. Condition) THEN + write(iulog,*) 'Assertion failed:', & + ' source file: ', FileName, & + ' source line: ', LineNumber +! +! Check if trace available +! +#if ( DEBUG_LEVEL > 1 ) + PRINT *, "Printing Trace: " + DO I = 1, StackLevel + PRINT *, "Level ", StackLevel, & + " Called ", TraceStack( StackLevel ) + ENDDO +#endif + ENDIF +#endif + RETURN +!EOC + END SUBROUTINE DumAssert +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: DumEnter --- Tracing: Enter a Subroutine +! +! !INTERFACE: + SUBROUTINE DumEnter ( RoutineName ) +! +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + CHARACTER(*), INTENT(IN) :: RoutineName ! Source file + +! !DESCRIPTION: +! This routine marks the beginning of a region to be traced, +! usually a subroutine. +! +! \begin{tabular}{|c|l|} \hline \hline +! {\bf Debug Level} & {\bf Action} \\ \hline \hline +! 0 & Return immediately \\ \hline +! 1 & Perform bookkeeping \\ \hline +! 2 & Perform bookkeeping, print trace \\ \hline +! \end{tabular} +! +! !LOCAL VARIABLES: + INTEGER MyID, Ierror +! !REVISION HISTORY: +! 97.09.30 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +#if !defined(DEBUG_LEVEL) +#define DEBUG_LEVEL 1 +#endif + +#if ( DEBUG_LEVEL > 0 ) + StackLevel = StackLevel + 1 + IF ( StackLevel .GT. MAX_STACK_LEVEL ) THEN + PRINT *, "StackLevel overflow: ", StackLevel, " Stopping" + STOP + ENDIF + TraceStack( StackLevel ) = RoutineName +#if ( DEBUG_LEVEL > 1 ) + PRINT *, "Level ", StackLevel, " Entering ", RoutineName +#endif +#endif + RETURN +!EOC + END SUBROUTINE DumEnter +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: DumLeave --- Tracing: Leave a Subroutine +! +! !INTERFACE: + SUBROUTINE DumLeave ( RoutineName ) +! +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + CHARACTER(*), INTENT(IN) :: RoutineName ! Source file + +! !DESCRIPTION: +! Tracing facility: leave a subroutine, remove the history trail. +! Depending on the debugging level, do nothing (0), update the +! stack only (1), or update stack and print trace message (2) to +! stdout. The CALL to Leave should be placed just before every +! egress of the subroutine (hopefully the exit point is unique). +! +! \begin{tabular}{|c|l|} \hline \hline +! {\bf Debug Level} & {\bf Action} \\ \hline \hline +! 0 & Return immediately \\ \hline +! 1 & Perform bookkeeping, consistency check \\ \hline +! 2 & Bookkeeping, consistency, print trace \\ \hline +! \end{tabular} +! +! !LOCAL VARIABLES: + INTEGER MyID, Ierror +! !REVISION HISTORY: +! 97.09.30 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +#if !defined(DEBUG_LEVEL) +#define DEBUG_LEVEL 1 +#endif + +#if ( DEBUG_LEVEL > 0 ) +! +! Make sure that the Enter and Leave correspond +! + IF ( TraceStack(StackLevel) .NE. RoutineName ) THEN + PRINT *, "Expected: ", TraceStack(StackLevel), & + & "Got: ", RoutineName, " STOPPING " + STOP + ENDIF +#if ( DEBUG_LEVEL > 1 ) + PRINT *, "Level ", StackLevel, " Leaving ", RoutineName +#endif + IF ( StackLevel .LE. 0 ) THEN + PRINT *, "StackLevel underflow: ", StackLevel, " Stopping" + STOP + ENDIF + TraceStack( StackLevel ) = "" + StackLevel = StackLevel - 1 +#endif + RETURN +!EOC + END SUBROUTINE DumLeave +!----------------------------------------------------------------------- + + END MODULE debugutilitiesmodule diff --git a/src/utils/pilgrim/decompmodule.F90 b/src/utils/pilgrim/decompmodule.F90 new file mode 100644 index 0000000000..79db80dd81 --- /dev/null +++ b/src/utils/pilgrim/decompmodule.F90 @@ -0,0 +1,1767 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- + MODULE decompmodule +!BOP +! +! !MODULE: decompmodule +! +! !USES: +#if defined( STAND_ALONE ) +# define iulog 6 +#else + use cam_logfile, only: iulog +#endif +#include "debug.h" + + IMPLICIT NONE + +! +! !DESCRIPTION: +! +! This module provides the DecompType and its create and destroy +! routines. +! \begin{center} +! \begin{tabular}{|l|l|} \hline \hline +! DecompType & Type to describe a decomposition \\ \hline +! DecompDefined & True iff given decomposition is defined\\ \hline +! DecompFree & Destroy a decomposition \\ \hline +! DecompCopy & Copy decomposition to newly created one\\ \hline +! DecompPermute & Permute decomposition \\ \hline +! DecompRegular1D & Create a 1-D decomposition \\ \hline +! DecompRegular2D & Create a 2-D decomposition \\ \hline +! DecompRegular3D & Create a 3-D decomposition \\ \hline +! DecompRegular4D & Create a 4-D decomposition \\ \hline +! DecompCreateIrr & Create an irregular 1-D decomposition \\ \hline +! DecompCreateTags & Create a decomposition from Pe and Tags \\ \hline +! DecompGlobalToLocal& Map a global index to a local one \\ \hline +! DecompLocalToGlobal& Map a local index to a global one \\ +! \hline \hline +! \end{tabular} +! \end{center} +! +! The decomposition type contains the sizes of the global array, +! the number of entries on each PE, and for each PE a list +! of "runs", i.e., the starting and finishing global indices +! or "tags" whose inclusive array section resides on that PE. +! Clearly this method of decomposition is only efficient if +! there are long runs, i.e., long array sections which are +! mapped to one PE. A random decomposition will cause poor +! results. +! +! The decomposition is thus very efficient for 1-D, 2-D or 3-D +! block distributions (particularly for 1-D distributions, where +! there is one "run" per processor). Problems may occur for +! an irregular decomposition (which is by definition 1-D). If +! there is little correspondence between the global indices of the +! entries and the actual decomposition (e.g., the tags are +! assigned randomly), then there will be many runs, most +! containing only one tag, and the resulting instance of +! DecompType will be very large. Fortunately, most applications +! assign tags to entries in some sort of contiguous fashion, +! which is then quite appropriate for this data structure. +! +! All numbering of multi-dimensional arrays is ROW-MAJOR, that +! is, first in the X direction and then in the Y (and then, +! if appropriate, in Z). This is true for both the 2-D and +! 3-D data sets as also the Cartesian description of the PEs. +! +! There is one glaring feature of DecompType. It is +! supposed to be a `one-size-fits-all' description of the +! decomposition (with the exception of the random indexing +! mentioned above). Unfortunately, to describe 2-D and 3-D +! regions, it is necessary to carry additional dimension +! information in order have complete information for the +! mapping. This means that 2-D and 3-D decompositions +! inherently carry more information than a 1-D decomposition. +! Thus it {\it is} possible to use a decomposition created +! with the Regular2D or Regular3D routines to describe the +! corresponding decomposition when the 2-D or 3-D array is +! viewed as a 1-D array, but it is clearly {\it not} +! possible to use a decomposition created with Regular1D +! to describe the decomposition of a 2-D or 3-D array +! --- the appropriate information just is not there. +! +! !REVISION HISTORY: +! 97.07.22 Sawyer Creation +! 97.09.01 Sawyer Release date +! 97.11.06 Sawyer Addition of row and column communicators +! 97.01.24 Sawyer Added support for non-MPI derived types solution +! 97.01.29 Sawyer Minor revisions for production service +! 98.01.30 Sawyer Added DecompCopy +! 98.02.04 Sawyer Removed Comm, CommRow and CommCol from DecompType +! 98.03.13 Sawyer Removed DecompTypeOld, brushed up for walkthrough +! 98.03.19 Sawyer Minor corrections after walkthrough +! 98.05.02 Sawyer Added DecompPermute +! 98.05.11 Sawyer Removed Permutation from all but DecompPermute +! 99.01.19 Sawyer Minor cleaning +! 00.07.07 Sawyer Removed DimSizes; decomp is now 1D only +! 00.11.12 Sawyer Added DecompCreateTags and DecompInfo +! 01.02.03 Sawyer Updated for free format; corrected DecompCreateTags +! 01.03.20 Sawyer Added DecompRegular3DOrder +! 02.12.04 Sawyer Added DecompDefined, optimized DecompGlobalToLocal +! 02.12.06 Sawyer Bug in new DecompGlobalToLocal (remove out of bounds check) +! 02.12.08 Sawyer Another bug: calculate the Offsets field correctly +! 02.12.23 Sawyer Added DecompRegular4D +! +! !PUBLIC TYPES: + PUBLIC DecompType, DecompCreate, DecompFree + PUBLIC DecompCopy, DecompPermute, DecompDefined + PUBLIC DecompGlobalToLocal, DecompLocalToGlobal, DecompInfo + + INTERFACE DecompCreate + MODULE PROCEDURE DecompRegular1D + MODULE PROCEDURE DecompRegular2D + MODULE PROCEDURE DecompRegular3D + MODULE PROCEDURE DecompRegular3DOrder + MODULE PROCEDURE DecompRegular4D + MODULE PROCEDURE DecompCreateIrr + MODULE PROCEDURE DecompCreateTags + END INTERFACE + + INTERFACE DecompGlobalToLocal + MODULE PROCEDURE DecompG2L + MODULE PROCEDURE DecompG2LVector + END INTERFACE + + INTERFACE DecompLocalToGlobal + MODULE PROCEDURE DecompL2G + MODULE PROCEDURE DecompL2GVector + END INTERFACE + +! Decomposition info + + TYPE Lists + INTEGER, POINTER :: StartTags(:) => null() ! Start of tag run + INTEGER, POINTER :: EndTags(:) => null() ! End of tag run + INTEGER, POINTER :: Offsets(:) => null() ! Local offsets for efficiency + END TYPE Lists + + TYPE DecompType + LOGICAL :: Defined ! Is it defined? + INTEGER :: GlobalSize ! Size in each dimension + INTEGER, POINTER :: NumEntries(:) => null() ! Number of entries per PE + TYPE(Lists), POINTER :: Head(:) => null() ! Array of pointers + END TYPE DecompType + +!EOP + CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: DecompDefined --- Is the decomp type defined? +! +! !INTERFACE: + LOGICAL FUNCTION DecompDefined ( Decomp ) +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ):: Decomp ! Decomp information + +! +! !DESCRIPTION: +! Returns true if Decomp has been created but not yet destroyed +! +! !REVISION HISTORY: +! 02.12.04 Sawyer Creation from GhostDefined +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! + CPP_ENTER_PROCEDURE( "DECOMPDEFINED" ) + DecompDefined = Decomp%Defined + CPP_LEAVE_PROCEDURE( "DECOMPDEFINED" ) + + RETURN +!EOC + END FUNCTION DecompDefined +!----------------------------------------------------------------------- + + +!--------------------------------------------------------------------- +!BOP +! !IROUTINE: DecompFree --- Free a decomposition +! +! !INTERFACE: + SUBROUTINE DecompFree ( Decomp ) +! !USES: + IMPLICIT NONE + +! !INPUT/OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( INOUT ):: Decomp ! Decomp information +! +! !DESCRIPTION: +! Free the decomposition -- deallocate the data structures. +! +! !SYSTEM ROUTINES: +! ASSOCIATED, DEALLOCATE +! +! !REVISION HISTORY: +! 98.01.30 Sawyer Creation +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, NPEs +! + CPP_ENTER_PROCEDURE( "DECOMPFREE" ) + + IF ( ASSOCIATED( Decomp%NumEntries ) ) & + DEALLOCATE( Decomp%NumEntries ) + IF ( ASSOCIATED( Decomp%Head ) ) THEN + NPEs = SIZE( Decomp%Head ) + DO I = 1, NPEs +! +! Copy the number of entries on each PE +! + IF ( ASSOCIATED( Decomp%Head(I)%StartTags ) ) & + DEALLOCATE( Decomp%Head(I)%StartTags ) + IF ( ASSOCIATED( Decomp%Head(I)%EndTags ) ) & + DEALLOCATE( Decomp%Head(I)%EndTags ) + IF ( ASSOCIATED( Decomp%Head(I)%Offsets ) ) & + DEALLOCATE( Decomp%Head(I)%Offsets ) + ENDDO + DEALLOCATE( Decomp%Head ) + ENDIF + Decomp%Defined = .FALSE. + + CPP_LEAVE_PROCEDURE( "DECOMPFREE" ) + RETURN +!EOC + END SUBROUTINE DecompFree +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompCopy --- Copy one decomposition to another +! +! !INTERFACE: + SUBROUTINE DecompCopy ( DecompIn, DecompOut ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: DecompIn ! Decomp information +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: DecompOut ! Decomp information +! +! !DESCRIPTION: +! +! Creates an output decomposition and copies the DecompIn input values +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.01.30 Sawyer Creation +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, J, NDims, NPEs, NRuns +! + CPP_ENTER_PROCEDURE( "DECOMPCOPY" ) +! +! Copy the size of the global array +! + DecompOut%GlobalSize = DecompIn%GlobalSize + +! +! Allocate the number of entries and list head arrays +! + NPEs = SIZE( DecompIn%NumEntries ) + CPP_ASSERT_F90( SIZE( DecompIn%Head ) .EQ. NPEs ) + ALLOCATE( DecompOut%NumEntries( NPEs ) ) + ALLOCATE( DecompOut%Head( NPEs ) ) + + DO I = 1, NPEs +! +! Copy the number of entries on each PE +! + DecompOut%NumEntries( I ) = DecompIn%NumEntries( I ) + NRuns = SIZE( DecompIn%Head( I )%StartTags ) + CPP_ASSERT_F90( SIZE( DecompIn%Head( I )%EndTags ) .EQ. NRuns ) +! +! Allocate and copy the array of runs +! + ALLOCATE( DecompOut%Head(I)%StartTags( NRuns ) ) + ALLOCATE( DecompOut%Head(I)%EndTags( NRuns ) ) + ALLOCATE( DecompOut%Head(I)%Offsets( NRuns ) ) + DO J = 1, NRuns + DecompOut%Head(I)%StartTags(J) = DecompIn%Head(I)%StartTags(J) + DecompOut%Head(I)%EndTags(J) = DecompIn%Head(I)%EndTags(J) + DecompOut%Head(I)%Offsets(J) = DecompIn%Head(I)%Offsets(J) + ENDDO + ENDDO + DecompOut%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPCOPY" ) + RETURN +!EOC + END SUBROUTINE DecompCopy +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompPermute --- Permute one decomposition to another +! +! !INTERFACE: + SUBROUTINE DecompPermute ( Permutation, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER :: Permutation( : ) ! Permutation + +! !INPUT/OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( INOUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! +! Permutes the PE assignment of a given decomposition. Confusion will +! always arise about whether this is a forward or backward +! transformation. Picture it this way: draw the array and slice it +! up as indicated by the distribution. The resulting boxes are of +! course indexed by natural numbering 1, 2, 3, 4, ... (these are +! the virtual one-based PEs). Now write the true PE numbering +! (one-based) as you would like it. The resulting array is Perm. +! +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.05.02 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER, POINTER :: NumEntries(:)! Number of entries + TYPE(Lists), POINTER :: Head(:) ! Array of pointers + INTEGER :: I, J, NPEs, NRuns, TruePE +! + CPP_ENTER_PROCEDURE( "DECOMPPERMUTE" ) +! +! Allocate the number of entries and list head arrays +! + NPEs = SIZE( Decomp%NumEntries ) + ALLOCATE( NumEntries( NPEs ) ) + DO I = 1, NPEs + TruePE = Permutation( I ) + NumEntries( TruePE ) = Decomp%NumEntries( I ) + ENDDO +! +! Deallocate old NumEntries and put the new pointer in its place +! + DEALLOCATE( Decomp%NumEntries ) + Decomp%NumEntries => NumEntries + NULLIFY( NumEntries ) + +! +! Allocate and set the permuted Lists called with pointer Head +! + ALLOCATE( Head( NPEs ) ) + DO I = 1, NPEs + TruePE = Permutation( I ) + NRuns = SIZE( Decomp%Head(I)%StartTags ) + CPP_ASSERT_F90( SIZE( Decomp%Head(I)%EndTags ) .EQ. NRuns ) +! +! Allocate and permute the array of runs +! + ALLOCATE( Head(TruePE)%StartTags(NRuns) ) + ALLOCATE( Head(TruePE)%EndTags(NRuns) ) + ALLOCATE( Head(TruePE)%Offsets(NRuns) ) + DO J = 1, NRuns + Head(TruePE)%StartTags(J) = Decomp%Head(I)%StartTags(J) + Head(TruePE)%EndTags(J) = Decomp%Head(I)%EndTags(J) + Head(TruePE)%Offsets(J) = Decomp%Head(I)%Offsets(J) + ENDDO + ENDDO +! +! Deallocate the arrays of starting and ending tags +! + DO I = 1, NPEs + DEALLOCATE( Decomp%Head(I)%StartTags ) + DEALLOCATE( Decomp%Head(I)%EndTags ) + DEALLOCATE( Decomp%Head(I)%Offsets ) + ENDDO +! +! Deallocate the heads to the Lists +! + DEALLOCATE( Decomp%Head ) + +! +! Link the new head to that in the decomposition +! + Decomp%Head => Head + + NULLIFY( Head ) + + CPP_LEAVE_PROCEDURE( "DECOMPPERMUTE" ) + RETURN +!EOC + END SUBROUTINE DecompPermute +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompRegular1D --- Create a decomposition for a 1-D grid +! +! !INTERFACE: + SUBROUTINE DecompRegular1D ( NPEs, Dist, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEs ! Number of PEs + INTEGER, INTENT( IN ) :: Dist(:) ! Distribution in X +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! !DESCRIPTION: +! Creates a variable block decomposition for a regular 1-D grid +! (this is also known as a "block-general" distribution). The +! decomposition is given through the Dist distribution +! which contains the number of entries on each PE. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.01.19 Sawyer Creation +! 98.01.22 Sawyer Corrections, TESTED +! 98.05.11 Sawyer Removed Perm from arglist -- see DecompPermute +! 00.07.07 Sawyer Removed use of DimSizes(:) array +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, Counter +! + CPP_ENTER_PROCEDURE( "DECOMPREGULAR1D" ) +! + CPP_ASSERT_F90( NPEs .EQ. SIZE( Dist ) ) +! +! The head contains NPEs pointers to the tag lists. +! + Decomp%GlobalSize = SUM(Dist) + ALLOCATE( Decomp%NumEntries( NPEs ) ) + ALLOCATE( Decomp%Head( NPEs ) ) + Counter = 0 + DO I = 1, NPEs + Decomp%NumEntries(I) = Dist(I) +! +! Since this is a regular distribution there is only one run of tags per PE. +! + NULLIFY( Decomp%Head(I)%StartTags ) + NULLIFY( Decomp%Head(I)%EndTags ) + NULLIFY( Decomp%Head(I)%Offsets ) + ALLOCATE( Decomp%Head(I)%StartTags(1) ) + ALLOCATE( Decomp%Head(I)%EndTags(1) ) + ALLOCATE( Decomp%Head(I)%Offsets(1) ) +! +! The starting and ending tags are immediately determined from +! the decomposition arrays +! + Decomp%Head(I)%StartTags(1) = Counter+1 + Counter = Counter + Dist(I) + Decomp%Head(I)%EndTags(1) = Counter + Decomp%Head(I)%Offsets(1) = 0 ! Offset in local segment + ENDDO + + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPREGULAR1D" ) + RETURN +!EOC + END SUBROUTINE DecompRegular1D +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompRegular2D --- Create a decomposition for a 2-D grid +! +! !INTERFACE: + SUBROUTINE DecompRegular2D( NPEsX, NPEsY, Xdist, Ydist, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEsX ! Number of PEs in X + INTEGER, INTENT( IN ) :: NPEsY ! Number of PEs in Y + INTEGER, INTENT( IN ) :: Xdist(:) ! Distribution in X + INTEGER, INTENT( IN ) :: Ydist(:) ! Distribution in Y +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! Creates a variable block-block decomposition for a regular +! 2-D grid. The decomposition is given through the Xdist and +! Ydist distributions, which contain the number of entries on +! each PE in that dimension. This routine thus defines +! a rectangular "checkerboard" distribution. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.01.19 Sawyer Creation +! 98.01.22 Sawyer Corrections, TESTED +! 98.05.11 Sawyer Removed Perm from arglist -- see DecompPermute +! 00.07.07 Sawyer Removed use of DimSizes(:) array +! +! !BUGS: +! This routine makes the assumption that the sum of the +! distribution in each dimension adds up to the total +! number of entries in that dimension. It will cause +! problems if the actual local arrays are over- or +! under-allocated. For example, if the local array is +! allocated statically for the maximum size of the +! array on any processor, problems will occur on those +! PEs which have less than the maximum. +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: TruePE, I, J, K, Counter1, Counter2, SizeX, SizeY +! + CPP_ENTER_PROCEDURE( "DECOMPREGULAR2D" ) +! +! Some sanity checks +! + CPP_ASSERT_F90( NPEsX .EQ. SIZE( Xdist ) ) + CPP_ASSERT_F90( NPEsY .EQ. SIZE( Ydist ) ) +! +! The head contains NPEs pointers to the tag lists. +! + SizeX = SUM(Xdist) + SizeY = SUM(Ydist) + Decomp%GlobalSize = SizeX * SizeY + ALLOCATE( Decomp%NumEntries( NPEsX*NPEsY ) ) + ALLOCATE( Decomp%Head( NPEsX*NPEsY ) ) + Counter1 = 0 + DO J = 1, NPEsY + DO I = 1, NPEsX +! +! WARNING!!!! The definition of the PE is Row-major ordering +! + TruePE = ( J-1 ) * NPEsX + I + +! +! The number of entries is the product of the local X, Y, Z allotment +! + Decomp%NumEntries(TruePE) = Xdist(I)*Ydist(J) +! +! For each Y there is a separate run +! + NULLIFY( Decomp%Head(TruePE)%StartTags ) + NULLIFY( Decomp%Head(TruePE)%EndTags ) + NULLIFY( Decomp%Head(TruePE)%Offsets ) + ALLOCATE( Decomp%Head(TruePE)%StartTags(Ydist(J)) ) + ALLOCATE( Decomp%Head(TruePE)%EndTags(Ydist(J)) ) + ALLOCATE( Decomp%Head(TruePE)%Offsets(Ydist(J)) ) + Counter2 = Counter1 + DO K = 1, Ydist(J) +! +! Since this is a regular distribution the definition of +! tags is dictated by Xdist(I), and appears Ydist(J) times +! +! + Decomp%Head(TruePE)%StartTags(K) = Counter2 + 1 + Decomp%Head(TruePE)%EndTags(K) = Counter2 + Xdist(I) + Counter2 = Counter2 + SizeX + ENDDO + Counter1 = Counter1 + Xdist(I) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Ydist(J)-1) since already one layer has been added in. +! Implicit assumption that SizeX = SUM( Xdist ) +! + Counter1 = Counter1 + SizeX*(Ydist(J)-1) + ENDDO +! +! Calculate offsets +! + DO I=1, NPEsX*NPEsY + IF ( SIZE(Decomp%Head(I)%StartTags) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, SIZE(Decomp%Head(I)%StartTags) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPREGULAR2D" ) + RETURN +!EOC + END SUBROUTINE DecompRegular2D +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompRegular3D --- Create a decomposition for a 3-D grid +! +! !INTERFACE: + SUBROUTINE DecompRegular3D ( NPEsX, NPEsY, NPEsZ, & + Xdist, Ydist, Zdist, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEsX ! Number of PEs in X + INTEGER, INTENT( IN ) :: NPEsY ! Number of PEs in Y + INTEGER, INTENT( IN ) :: NPEsZ ! Number of PEs in Z + INTEGER, INTENT( IN ) :: Xdist(:) ! Distribution in X + INTEGER, INTENT( IN ) :: Ydist(:) ! Distribution in Y + INTEGER, INTENT( IN ) :: Zdist(:) ! Distribution in Z +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! Creates a decomposition for a regular 3-D grid. The +! decomposition is given through the Xdist, Ydist, and Zdist +! distributions, which contain the number of entries on +! each PE in that dimension. This routine thus defines +! a parallelopiped (SOMA-block) distribution. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.01.19 Sawyer Creation +! 98.05.11 Sawyer Removed Perm from arglist -- see DecompPermute +! 00.07.07 Sawyer Removed use of Sizes(:) array +! +! !BUGS: +! This routine makes the assumption that the sum of the +! distribution in each dimension adds up to the total +! number of entries in that dimension. It will cause +! problems if the actual local arrays are over- or +! under-allocated. For example, if the local array is +! allocated statically for the maximum size of the +! array on any processor, problems will occur on those +! PEs which have less than the maximum. +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: TruePE, Counter1, Counter2, Counter3 + INTEGER :: I, J, K, L, M, N, SizeX, SizeY, SizeZ +! + CPP_ENTER_PROCEDURE( "DECOMPREGULAR3D" ) +! +! Some sanity checks +! +! + CPP_ASSERT_F90( NPEsX .EQ. SIZE( Xdist ) ) + CPP_ASSERT_F90( NPEsY .EQ. SIZE( Ydist ) ) + CPP_ASSERT_F90( NPEsZ .EQ. SIZE( Zdist ) ) +! +! The head contains NPEs pointers to the tag lists. +! + SizeX = SUM(Xdist) + SizeY = SUM(Ydist) + SizeZ = SUM(Zdist) + Decomp%GlobalSize = SizeX * SizeY * SizeZ + ALLOCATE( Decomp%NumEntries( NPEsX*NPEsY*NPEsZ ) ) + ALLOCATE( Decomp%Head( NPEsX*NPEsY*NPEsZ ) ) + Counter1 = 0 + DO K = 1, NPEsZ + DO J = 1, NPEsY + DO I = 1, NPEsX +! +! WARNING!!!! The definition of the PE is Row-major ordering +! + TruePE = (K-1)*NPEsX*NPEsY + (J-1)*NPEsX + I + NULLIFY( Decomp%Head(TruePE)%StartTags ) + NULLIFY( Decomp%Head(TruePE)%EndTags ) + NULLIFY( Decomp%Head(TruePE)%Offsets ) +! +! The number of entries is the product of the local X, Y, Z allotment +! + Decomp%NumEntries(TruePE) = Xdist(I)*Ydist(J)*Zdist(K) +! +! For each Z there are Y separate runs +! + ALLOCATE( Decomp%Head(TruePE)%StartTags(Ydist(J)*Zdist(K)) ) + ALLOCATE( Decomp%Head(TruePE)%EndTags(Ydist(J)*Zdist(K)) ) + ALLOCATE( Decomp%Head(TruePE)%Offsets(Ydist(J)*Zdist(K)) ) + Counter2 = Counter1 + L = 0 + DO N = 1, Zdist(K) + Counter3 = Counter2 + DO M = 1, Ydist(J) +! +! Since this is a regular distribution the definition of +! tags is dictated by Xdist(I), and appears Ydist(J) times +! +! + L = L + 1 + Decomp%Head(TruePE)%StartTags(L) = Counter3 + 1 + Decomp%Head(TruePE)%EndTags(L) = Counter3 + Xdist(I) + Counter3 = Counter3 + SizeX + ENDDO + Counter2 = Counter2 + SizeX*SizeY + ENDDO + Counter1 = Counter1 + Xdist(I) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Ydist(J)-1) since already one X layer has been added in. +! Implicit assumption that SizeX = SUM( Xdist ) +! + Counter1 = Counter1 + SizeX*(Ydist(J)-1) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Zdist(K)-1) since already one X-Y layer has been added in. +! Implicit assumption that SizeY = SUM( Ydist ) +! + Counter1 = Counter1 + SizeX*SizeY*(Zdist(K)-1) + ENDDO +! +! Calculate offsets +! + DO I=1, NPEsX*NPEsY*NPEsZ + IF ( SIZE(Decomp%Head(I)%StartTags) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, SIZE(Decomp%Head(I)%StartTags) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPREGULAR3D" ) + RETURN +!EOC + END SUBROUTINE DecompRegular3D +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompRegular3Dorder --- Create a decomposition for a 3-D grid +! +! !INTERFACE: + SUBROUTINE DecompRegular3Dorder( Order, NPEsX, NPEsY, NPEsZ, & + Xdist, Ydist, Zdist, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + CHARACTER(3), INTENT( IN ) :: Order ! Dim. ordering + INTEGER, INTENT( IN ) :: NPEsX ! Number of PEs in X + INTEGER, INTENT( IN ) :: NPEsY ! Number of PEs in Y + INTEGER, INTENT( IN ) :: NPEsZ ! Number of PEs in Z + INTEGER, INTENT( IN ) :: Xdist(:) ! Distribution in X + INTEGER, INTENT( IN ) :: Ydist(:) ! Distribution in Y + INTEGER, INTENT( IN ) :: Zdist(:) ! Distribution in Z +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! !DESCRIPTION: +! Creates a variable block-block-block decomposition for a regular +! 3-D grid, where the ordering of the PEs can be explicitly given +! (see next paragraph). The decomposition is given through the +! Xdist, Ydist, and Zdist distributions, which contain the number +! of entries on each PE in that dimension. This routine thus defines +! a parallelopiped (SOMA-block) distribution. +! +! With the string argument Order, the order of counting in the +! 3d PE space can be specified. There are six possible values: +! "xyz", "xzy", "yxz", "yzx", "zxy", and "zyx". +! +! The same as DecompRegular3Dorder could also be achieved by +! using DecompRegular3D and then permuting the PE ownership +! with DecompPermute. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 01.03.20 Sawyer Creation from DecompRegular3Dzy, added ordering +! +! !BUGS: +! Not yet tested +! +!EOP +!--------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: TruePE, Counter1, Counter2, Counter3 + INTEGER :: I, J, K, L, M, N, SizeX, SizeY, SizeZ + INTEGER :: Imult, Jmult, Kmult +! + CPP_ENTER_PROCEDURE( "DECOMPREGULAR3DORDER" ) +! +! Some sanity checks +! +! + CPP_ASSERT_F90( NPEsX .EQ. SIZE( Xdist ) ) + CPP_ASSERT_F90( NPEsY .EQ. SIZE( Ydist ) ) + CPP_ASSERT_F90( NPEsZ .EQ. SIZE( Zdist ) ) + + IF ( Order=="xyz" ) THEN +! Looks like: TruePE = (K-1)*NPEsX*NPEsY + (J-1)*NPEsX + (I-1) + 1 + Imult = 1 + Jmult = NPEsX + Kmult = NPEsX*NPEsY + ELSE IF ( Order=="xzy" ) THEN +! Looks like: TruePE = (J-1)*NPEsX*NPEsZ + (K-1)*NPEsX + (I-1) + 1 + Imult = 1 + Jmult = NPEsX*NPEsZ + Kmult = NPEsX + ELSE IF ( Order=="yxz" ) THEN +! Looks like: TruePE = (K-1)*NPEsY*NPEsX + (I-1)*NPEsY + (J-1) + 1 + Imult = NPEsY + Jmult = 1 + Kmult = NPEsX*NPEsY + ELSE IF ( Order=="yzx" ) THEN +! Looks like: TruePE = (I-1)*NPEsY*NPEsZ + (K-1)*NPEsY + (J-1) + 1 + Imult = NPEsY*NPEsZ + Jmult = 1 + Kmult = NPEsY + ELSE IF ( Order=="zxy" ) THEN +! Looks like: TruePE = (J-1)*NPEsX*NPEsZ + (I-1)*NPEsZ + (K-1) + 1 + Imult = NPEsZ + Jmult = NPEsX*NPEsZ + Kmult = 1 + ELSE IF ( Order=="zyx" ) THEN +! Looks like: TruePE = (I-1)*NPEsY*NPEsZ + (J-1)*NPEsZ + (K-1) + 1 + Imult = NPEsY*NPEsZ + Jmult = NPEsZ + Kmult = 1 + ELSE +! Looks like: TruePE = (K-1)*NPEsX*NPEsY + (J-1)*NPEsX + (I-1) + 1 + write(iulog,*) "Warning: DecompCreate3Dorder", Order, "not supported" + write(iulog,*) " Continuing with XYZ ordering" + Imult = 1 + Jmult = NPEsX + Kmult = NPEsX*NPEsY + ENDIF + +! +! The head contains NPEs pointers to the tag lists. +! + SizeX = SUM(Xdist) + SizeY = SUM(Ydist) + SizeZ = SUM(Zdist) + Decomp%GlobalSize = SizeX * SizeY * SizeZ + ALLOCATE( Decomp%NumEntries( NPEsX*NPEsY*NPEsZ ) ) + ALLOCATE( Decomp%Head( NPEsX*NPEsY*NPEsZ ) ) + Counter1 = 0 + + DO K = 1, NPEsZ + DO J = 1, NPEsY + DO I = 1, NPEsX +! +! WARNING!!!! The definition of the PE is Row-major ordering +! + + TruePE = (I-1)*Imult + (J-1)*Jmult + (K-1)*Kmult + 1 +! +! The number of entries is the product of the local X, Y, Z allotment +! + Decomp%NumEntries(TruePE) = Xdist(I)*Ydist(J)*Zdist(K) +! +! For each Z there are Y separate runs +! + ALLOCATE( Decomp%Head(TruePE)%StartTags(Ydist(J)*Zdist(K)) ) + ALLOCATE( Decomp%Head(TruePE)%EndTags(Ydist(J)*Zdist(K)) ) + ALLOCATE( Decomp%Head(TruePE)%Offsets(Ydist(J)*Zdist(K)) ) + Counter2 = Counter1 + L = 0 + DO N = 1, Zdist(K) + Counter3 = Counter2 + DO M = 1, Ydist(J) +! +! Since this is a regular distribution the definition of +! tags is dictated by Xdist(I), and appears Ydist(J) times +! +! + L = L + 1 + Decomp%Head(TruePE)%StartTags(L) = Counter3 + 1 + Decomp%Head(TruePE)%EndTags(L) = Counter3 + Xdist(I) + Counter3 = Counter3 + SizeX + ENDDO + Counter2 = Counter2 + SizeX*SizeY + ENDDO + Counter1 = Counter1 + Xdist(I) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Ydist(J)-1) since already one X layer has been added in. +! Implicit assumption that SizeX = SUM( Xdist ) +! + Counter1 = Counter1 + SizeX*(Ydist(J)-1) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Zdist(K)-1) since already one X-Y layer has been added in. +! Implicit assumption that SizeY = SUM( Ydist ) +! + Counter1 = Counter1 + SizeX*SizeY*(Zdist(K)-1) + ENDDO +! +! Calculate offsets +! + DO I=1, NPEsX*NPEsY*NPEsZ + IF ( SIZE(Decomp%Head(I)%StartTags) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, SIZE(Decomp%Head(I)%StartTags) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPREGULAR3DORDER" ) + RETURN +!EOC + END SUBROUTINE DecompRegular3DOrder +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompRegular4D --- Create a decomposition for a 3-D grid +! +! !INTERFACE: + SUBROUTINE DecompRegular4D ( NPEsX, NPEsY, NPEsZ, NPEsT, & + Xdist, Ydist, Zdist, Tdist, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEsX ! Number of PEs in X + INTEGER, INTENT( IN ) :: NPEsY ! Number of PEs in Y + INTEGER, INTENT( IN ) :: NPEsZ ! Number of PEs in Z + INTEGER, INTENT( IN ) :: NPEsT ! Number of PEs in T + INTEGER, INTENT( IN ) :: Xdist(:) ! Distribution in X + INTEGER, INTENT( IN ) :: Ydist(:) ! Distribution in Y + INTEGER, INTENT( IN ) :: Zdist(:) ! Distribution in Z + INTEGER, INTENT( IN ) :: Tdist(:) ! Distribution in T +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! Creates a decomposition for a regular 4-D grid. The +! decomposition is given through the Xdist, Ydist, Zdist, Tdist +! distributions, which contain the number of entries on +! each PE in that dimension. This routine thus defines +! a parallelopiped (SOMA-block) distribution. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 02.12.23 Sawyer Creation from DecompRegular4D +! +! !BUGS: +! This routine makes the assumption that the sum of the +! distribution in each dimension adds up to the total +! number of entries in that dimension. It will cause +! problems if the actual local arrays are over- or +! under-allocated. For example, if the local array is +! allocated statically for the maximum size of the +! array on any processor, problems will occur on those +! PEs which have less than the maximum. +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: TruePE, Counter1, Counter2, Counter3, Counter4 + INTEGER :: I, J, K, L, M, N, P, T, SizeX, SizeY, SizeZ, SizeT +! + CPP_ENTER_PROCEDURE( "DECOMPREGULAR4D" ) +! +! Some sanity checks +! +! + CPP_ASSERT_F90( NPEsX .EQ. SIZE( Xdist ) ) + CPP_ASSERT_F90( NPEsY .EQ. SIZE( Ydist ) ) + CPP_ASSERT_F90( NPEsZ .EQ. SIZE( Zdist ) ) + CPP_ASSERT_F90( NPEsT .EQ. SIZE( Tdist ) ) +! +! The head contains NPEs pointers to the tag lists. +! + SizeX = SUM(Xdist) + SizeY = SUM(Ydist) + SizeZ = SUM(Zdist) + SizeT = SUM(Tdist) + Decomp%GlobalSize = SizeX * SizeY * SizeZ * SizeT + ALLOCATE( Decomp%NumEntries( NPEsX*NPEsY*NPEsZ*NPEsT ) ) + ALLOCATE( Decomp%Head( NPEsX*NPEsY*NPEsZ*NPEsT ) ) + Counter1 = 0 + DO T = 1, NPEsT + DO K = 1, NPEsZ + DO J = 1, NPEsY + DO I = 1, NPEsX +! +! WARNING!!!! The definition of the PE is Row-major ordering +! + TruePE = (T-1)*NPEsX*NPEsY*NPEsZ + & + (K-1)*NPEsX*NPEsY + (J-1)*NPEsX + I + NULLIFY( Decomp%Head(TruePE)%StartTags ) + NULLIFY( Decomp%Head(TruePE)%EndTags ) + NULLIFY( Decomp%Head(TruePE)%Offsets ) +! +! The number of entries is the product of the local X, Y, Z allotment +! + Decomp%NumEntries(TruePE) = & + Xdist(I)*Ydist(J)*Zdist(K)*Tdist(T) +! +! For each Z there are Y separate runs +! + ALLOCATE( Decomp%Head(TruePE)%StartTags(Ydist(J)*Zdist(K)*Tdist(T)) ) + ALLOCATE( Decomp%Head(TruePE)%EndTags(Ydist(J)*Zdist(K)*Tdist(T)) ) + ALLOCATE( Decomp%Head(TruePE)%Offsets(Ydist(J)*Zdist(K)*Tdist(T)) ) + Counter2 = Counter1 ! Base address + L = 0 + DO P = 1, Tdist(T) + Counter3 = Counter2 + DO N = 1, Zdist(K) + Counter4 = Counter3 + DO M = 1, Ydist(J) +! +! Since this is a regular distribution the definition of +! tags is dictated by Xdist(I), and appears Ydist(J) times +! +! + L = L + 1 + Decomp%Head(TruePE)%StartTags(L) = Counter4 + 1 + Decomp%Head(TruePE)%EndTags(L) = Counter4 + Xdist(I) + Counter4 = Counter4 + SizeX + ENDDO + Counter3 = Counter3 + SizeX*SizeY + ENDDO + Counter2 = Counter2 + SizeX*SizeY*SizeZ + ENDDO + Counter1 = Counter1 + Xdist(I) ! Increment base address + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Ydist(J)-1) since already one X layer has been added in. +! Implicit assumption that SizeX = SUM( Xdist ) +! + Counter1 = Counter1 + SizeX*(Ydist(J)-1) + ENDDO +! +! Align the counter such that it points to the start of the next +! block. (Zdist(K)-1) since already one X-Y layer has been added in. +! Implicit assumption that SizeY = SUM( Ydist ) +! + Counter1 = Counter1 + SizeX*SizeY*(Zdist(K)-1) + ENDDO + Counter1 = Counter1 + SizeX*SizeY*SizeZ*(Tdist(T)-1) + ENDDO +! +! Calculate offsets +! + DO I=1, NPEsX*NPEsY*NPEsZ*NPEsT + IF ( SIZE(Decomp%Head(I)%StartTags) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, SIZE(Decomp%Head(I)%StartTags) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPREGULAR4D" ) + RETURN +!EOC + END SUBROUTINE DecompRegular4D +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompCreateIrr --- Decomposition for an irregular mesh +! +! !INTERFACE: + SUBROUTINE DecompCreateIrr( NPEs, Pe, TotalPts, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEs ! Number of PEs + INTEGER, INTENT( IN ) :: Pe(:) ! Processor location + INTEGER, INTENT( IN ) :: TotalPts ! Number of points +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! Creates a decomposition for a irregular 1-D mesh. The +! decomposition is given through the number of points and +! an array containing the PE which each point is mapped to. +! This mapping naturally assumes that the local numbering +! is incrementally increasing as points are mapped to PEs. +! This assumption is sufficient for most applications, but +! another irregular mapping routine is available for more +! complex cases. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 98.01.19 Sawyer Creation, with requirements from Jay Larson +! 98.11.02 Sawyer Rewritten to requirements for Andrea Molod +! 00.07.07 Sawyer Removed use of DimSizes(:) array +! 00.11.12 Sawyer Changed argument order for overloading +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, J, PEhold + INTEGER :: Counter( NPEs ) +! + CPP_ENTER_PROCEDURE( "DECOMPCREATEIRR" ) +! + CPP_ASSERT_F90( TotalPts .LE. SIZE( PE ) ) + +! +! The head contains NPEs pointers to the tag lists. +! + Decomp%GlobalSize = TotalPts + ALLOCATE( Decomp%NumEntries( NPEs ) ) + ALLOCATE( Decomp%Head( NPEs ) ) +! +! Perform over all points in the mapping +! + PEhold= -1 + Counter = 0 + Decomp%NumEntries = 0 + DO I=1, TotalPts + CPP_ASSERT_F90( ( PE( I ) .LT. NPEs .AND. PE( I ) .GE. 0 ) ) + IF ( PE( I ) .NE. PEhold ) THEN + PEhold = PE( I ) + Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1 + ENDIF + Decomp%NumEntries(PEHold+1) = Decomp%NumEntries(PEHold+1) + 1 + ENDDO + DO I=1, NPEs +! +! Now the amount of space to allocate is known. It is acceptable +! to in allocated an array of size 0 (F90 Handbook, Section 6.5.1) +! + ALLOCATE( Decomp%Head(I)%StartTags(Counter(I)) ) + ALLOCATE( Decomp%Head(I)%EndTags(Counter(I)) ) + ALLOCATE( Decomp%Head(I)%Offsets(Counter(I)) ) + ENDDO +! +! Perform over all points in the mapping +! + PEhold= -1 + Counter = 0 + DO I=1, TotalPts + IF ( PE( I ) .NE. PEhold ) THEN +! +! If not first entry, close up shop on previous run +! + IF ( I .GT. 1 ) THEN + Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = I-1 + ENDIF + PEhold = PE( I ) + Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1 + Decomp%Head(PEhold+1)%StartTags(Counter(PEhold+1)) = I + ENDIF + ENDDO +! +! Clean up shop for the final run +! + IF ( TotalPts .GT. 0 ) THEN + Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = TotalPts + ENDIF + +! +! Calculate offsets +! + DO I=1, NPEs + IF ( Counter(I) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, Counter(I) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPCREATEIRR" ) + RETURN +!EOC + END SUBROUTINE DecompCreateIrr +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompCreateTags --- Decomposition from Pe and Tags +! +! !INTERFACE: + SUBROUTINE DecompCreateTags(Npes, Pe, TotalPts, Tags, Decomp ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: NPEs ! Number of PEs + INTEGER, INTENT( IN ) :: Pe(:) ! Processor location + INTEGER, INTENT( IN ) :: TotalPts ! Number of points + INTEGER, INTENT( IN ) :: Tags(:) ! Global index +! +! !OUTPUT PARAMETERS: + TYPE(DecompType), INTENT( OUT ) :: Decomp ! Decomp information +! +! +! !DESCRIPTION: +! Creates a decomposition for a irregular mesh from the +! Pe ownership and the Tags. This is a simple extension of +! DecompCreateIrr (previously DecompIrregular1D) but is +! much more dangerous, since the user can define the Tags +! (global indices) arbitrarily. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation from DecompCreateIrr +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, J, PEhold, LastTag + INTEGER :: Counter( NPEs ) +! + CPP_ENTER_PROCEDURE( "DECOMPCREATETAGS" ) +! + CPP_ASSERT_F90( TotalPts .LE. SIZE( PE ) ) + CPP_ASSERT_F90( TotalPts .LE. SIZE( Tags ) ) + +! +! The head contains NPEs pointers to the tag lists. +! + Decomp%GlobalSize = TotalPts + ALLOCATE( Decomp%NumEntries( NPEs ) ) + ALLOCATE( Decomp%Head( NPEs ) ) +! +! Perform over all points in the mapping +! + PEhold = -1 + LastTag = -999999999 + Counter = 0 + Decomp%NumEntries = 0 + DO I=1, TotalPts + CPP_ASSERT_F90( PE( I ) .LT. NPEs .AND. PE( I ) .GE. 0 ) + IF ( LastTag==0 .OR. Tags(I)/=LastTag+1 .OR. PE(I)/=PEhold ) THEN + PEhold = PE( I ) + Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1 + ENDIF + Decomp%NumEntries(PEHold+1) = Decomp%NumEntries(PEHold+1) + 1 + LastTag = Tags(I) + ENDDO + + DO I=1, NPEs +! +! Now the amount of space to allocate is known. It is acceptable +! to in allocated an array of size 0 (F90 Handbook, Section 6.5.1) +! + ALLOCATE( Decomp%Head(I)%StartTags(Counter(I)) ) + ALLOCATE( Decomp%Head(I)%EndTags(Counter(I)) ) + ALLOCATE( Decomp%Head(I)%Offsets(Counter(I)) ) + ENDDO + +! +! Perform over all points in the domain +! + PEhold = -1 + LastTag = -999999999 + Counter = 0 + DO I=1, TotalPts + IF ( LastTag==0 .OR. Tags(I)/=LastTag+1 .OR. PE(I)/=PEhold ) THEN +! +! If not first entry, close up shop on previous run +! + IF ( I .GT. 1 ) THEN + Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = LastTag + ENDIF + PEhold = PE( I ) + Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1 + Decomp%Head(PEhold+1)%StartTags(Counter(PEhold+1)) = Tags(I) + ENDIF + LastTag = Tags(I) + ENDDO +! +! Clean up shop for the final run +! + IF ( TotalPts .GT. 0 ) THEN + Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) =Tags(TotalPts) + ENDIF + +! +! Calculate offsets +! + DO I=1, NPEs + IF ( Counter(I) > 0 ) THEN + Decomp%Head(I)%Offsets(1) = 0 + DO J=2, Counter(I) + Decomp%Head(I)%Offsets(J) = Decomp%Head(I)%Offsets(J-1) + & + Decomp%Head(I)%EndTags(J-1) - Decomp%Head(I)%StartTags(J-1) + 1 + ENDDO + ENDIF + ENDDO + Decomp%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "DECOMPCREATETAGS" ) + RETURN +!EOC + END SUBROUTINE DecompCreateTags +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompG2L --- Map global index to local and PE +! +! !INTERFACE: + SUBROUTINE DecompG2L ( Decomp, Global, Local, Pe ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Global ! Global index +! +! !OUTPUT PARAMETERS: + + INTEGER, INTENT( OUT ) :: Local ! Local index + INTEGER, INTENT( OUT ) :: Pe ! Pe location +! +! +! !DESCRIPTION: +! Given a decomposition and a global index, this routine returns +! the local index and PE location of that global tag. If the +! global index is not found, Local = 0, Pe = -1 is returned. +! +! Note that this routine is not efficient by any stretch of the +! imagination --- only one index can be converted at a time. +! In addition, a search procedure must be performed, whose +! efficiency is inversely proportional to the size of the decomposition +! (in particular, to the number of "runs"). Conceptually this +! mapping should be used only once in the program for +! initialization, and subsequently all calculations should take +! place using local indices. +! +! !SYSTEM ROUTINES: +! SIZE +! +! !REVISION HISTORY: +! 98.03.20 Sawyer Creation +! 01.03.17 Sawyer Test for Global==0 (undefined element) +! 02.11.22 Sawyer Optimized by caching previously used block +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER, SAVE :: Ipe = 0 ! Initial process ID + INTEGER, SAVE :: J = 0 ! Initial DO loop value + INTEGER :: Ipeold, Jold, PEsize, Jsize +! + CPP_ENTER_PROCEDURE( "DECOMPG2L" ) + +! +! Search over all the PEs +! + Pe = -1 + Local = 0 + IF ( Global == 0 ) RETURN ! quick return + PEsize = SIZE( Decomp%Head ) + IF ( Ipe >= PEsize ) Ipe = 0 + Ipeold= Ipe +PEs: DO ! Loop over all PEs starting + Jsize = SIZE( Decomp%Head(Ipe+1)%StartTags ) + IF ( J >= Jsize ) J = 0 + Jold = J ! from the PE used previously +Blocks: DO WHILE (Jsize > 0) ! Loop through data segments + IF ( Global >= Decomp%Head(Ipe+1)%StartTags(J+1) .AND. & + Global <= Decomp%Head(Ipe+1)%EndTags(J+1) ) THEN + Local = Decomp%Head(Ipe+1)%Offsets(J+1) + Global - & + Decomp%Head(Ipe+1)%StartTags(J+1) + 1 + Pe = Ipe + EXIT PEs ! Global tag has been found + ELSE + J = MOD(J+1,Jsize) ! Increment the block index + ENDIF + IF ( J == Jold ) EXIT Blocks ! Global tag not on this PE + ENDDO Blocks + Ipe = MOD(Ipe+1,PEsize) ! Increment the pe number + J = 0 + IF ( Ipe == Ipeold ) EXIT PEs ! Global tag not found on any PE + ENDDO PEs + + CPP_ASSERT_F90( Local .LE. Decomp%NumEntries(Pe+1) ) + + CPP_LEAVE_PROCEDURE( "DECOMPG2L" ) + RETURN +! +!EOC + END SUBROUTINE DecompG2L +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompG2LVector --- Map global index to local and PE +! +! !INTERFACE: + SUBROUTINE DecompG2LVector ( Decomp, N, Global, Local, Pe ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ):: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: N ! Number of indices + INTEGER, INTENT( IN ) :: Global(:) ! Global index +! +! !OUTPUT PARAMETERS: + + INTEGER, INTENT( OUT ) :: Local(:) ! Local index + INTEGER, INTENT( OUT ) :: Pe(:) ! Pe location +! +! +! !DESCRIPTION: +! Given a decomposition and a global index, this routine returns +! the local index and PE location of that global tag. If the +! global index is not found, Local = 0, Pe = -1 is returned. +! +! Note that this routine is not efficient by any stretch of the +! imagination --- only one index can be converted at a time. +! In addition, a search procedure must be performed, whose +! efficiency is inversely proportional to the size of the decomposition +! (in particular, to the number of "runs"). Conceptually this +! mapping should be used only once in the program for +! initialization, and subsequently all calculations should take +! place using local indices. +! +! !SYSTEM ROUTINES: +! SIZE +! +! !REVISION HISTORY: +! 02.11.09 Sawyer Creation from decompglobaltolocal +! 02.11.22 Sawyer Optimized by caching previously used block +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER, SAVE :: J = 0 ! Initial value + INTEGER, SAVE :: Ipe = 0 ! Initial value + INTEGER :: I, Ipeold, Jold, PEsize, Jsize +! + CPP_ENTER_PROCEDURE( "DECOMPG2LVECTOR" ) + + PEsize = SIZE( Decomp%Head ) +! +! Search over all the PEs +! + DO I=1, N + Pe(I) = -1 + Local(I) = 0 + IF ( Global(I) == 0 ) CYCLE + IF ( Ipe >= PEsize ) Ipe = 0 + Ipeold= Ipe +PEs: DO WHILE ( PEsize > 0 ) ! Loop over all PEs starting + Jsize = SIZE( Decomp%Head(Ipe+1)%StartTags ) + IF ( J >= Jsize ) J = 0 + Jold = J ! from the PE used previously +Blocks: DO WHILE (Jsize > 0) ! Loop through data segments + IF ( Global(I) >= Decomp%Head(Ipe+1)%StartTags(J+1) .AND. & + Global(I) <= Decomp%Head(Ipe+1)%EndTags(J+1) ) THEN + Local(I) = Decomp%Head(Ipe+1)%Offsets(J+1) + Global(I) - & + Decomp%Head(Ipe+1)%StartTags(J+1) + 1 + Pe(I) = Ipe + EXIT PEs ! Global tag has been found + ELSE + J = MOD(J+1,Jsize) ! Increment the block index + ENDIF + IF ( J == Jold ) EXIT Blocks ! Global tag not on this PE + ENDDO Blocks + Ipe = MOD(Ipe+1,PEsize) ! Increment the pe number + J = 0 + IF ( Ipe == Ipeold ) EXIT PEs ! Global tag not found on any PE + ENDDO PEs + + CPP_ASSERT_F90( Local(I) .LE. Decomp%NumEntries(Pe(I)+1) ) + + ENDDO + CPP_LEAVE_PROCEDURE( "DECOMPG2LVECTOR" ) + RETURN +! +!EOC + END SUBROUTINE DecompG2LVector +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompL2G --- Map global index to local and PE +! +! !INTERFACE: + SUBROUTINE DecompL2G ( Decomp, Local, Pe, Global ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Local ! Local index + INTEGER, INTENT( IN ) :: Pe ! Pe location +! +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Global ! Global index +! +! +! !DESCRIPTION: +! Given a decomposition and a local-pe index pair, this routine +! returns the 2-D global index. If the local index is not found, +! 0 is returned. +! +! Note that this routine is not efficient by any stretch of the +! imagination --- only one index can be converted at a time. +! In addition, a search procedure must be performed, whose +! efficiency is inversely proportional to the size of the +! decomposition (in particular, to the number of "runs"). +! Conceptually this mapping should be used only once in the +! program for initialization, and subsequently all calculations +! should take place using local indices. +! +! !SYSTEM ROUTINES: +! SIZE +! +! !REVISION HISTORY: +! 98.03.20 Sawyer Creation +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: J, Counter + LOGICAL :: Found +! + CPP_ENTER_PROCEDURE( "DECOMPL2G" ) + CPP_ASSERT_F90( Pe .GE. 0 ) + CPP_ASSERT_F90( Pe .LT. SIZE(Decomp%Head) ) + CPP_ASSERT_F90( Local .GT. 0 ) + CPP_ASSERT_F90( Local .LE. Decomp%NumEntries(Pe+1) ) + + Counter = 0 + Found = .FALSE. + J = 0 + DO WHILE ( .NOT. Found ) + J = J+1 + Counter = Counter + Decomp%Head(Pe+1)%EndTags(J) - & + Decomp%Head(Pe+1)%StartTags(J) + 1 + IF ( Local .LE. Counter ) THEN + Found = .TRUE. +! +! The following calculation is not immediately obvious. Think about it +! + Global = Local - Counter + Decomp%Head(Pe+1)%EndTags(J) + Found = .TRUE. + ELSEIF ( J .GE. SIZE( Decomp%Head(Pe+1)%StartTags ) ) THEN +! +! Emergency brake +! + Found = .TRUE. + Global = 0 + ENDIF + ENDDO + + CPP_LEAVE_PROCEDURE( "DECOMPL2G" ) + RETURN +! +!EOC + END SUBROUTINE DecompL2G +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompL2GVector --- Map global index to local and PE +! +! !INTERFACE: + SUBROUTINE DecompL2GVector ( Decomp, N, Local, Pe, Global ) +! !USES: + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: N ! Number of indices + INTEGER, INTENT( IN ) :: Local(:)! Local index + INTEGER, INTENT( IN ) :: Pe(:) ! Pe location +! +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Global(:) ! Global index +! +! +! !DESCRIPTION: +! Given a decomposition and a local-pe index pair, this routine +! returns the 2-D global index. If the local index is not found, +! 0 is returned. +! +! Note that this routine is not efficient by any stretch of the +! imagination --- only one index can be converted at a time. +! In addition, a search procedure must be performed, whose +! efficiency is inversely proportional to the size of the +! decomposition (in particular, to the number of "runs"). +! Conceptually this mapping should be used only once in the +! program for initialization, and subsequently all calculations +! should take place using local indices. +! +! !SYSTEM ROUTINES: +! SIZE +! +! !REVISION HISTORY: +! 02.11.09 Sawyer Creation from decomplocaltoglobal +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: I, J, Counter + LOGICAL :: Found +! + CPP_ENTER_PROCEDURE( "DECOMPL2GVECTOR" ) + DO I=1,N + CPP_ASSERT_F90( Pe(I) .GE. 0 ) + CPP_ASSERT_F90( Pe(I) .LT. SIZE(Decomp%Head) ) + CPP_ASSERT_F90( Local(I) .GT. 0 ) + CPP_ASSERT_F90( Local(I) .LE. Decomp%NumEntries(Pe(I)+1) ) + + Counter = 0 + Found = .FALSE. + J = 0 + DO WHILE ( .NOT. Found ) + J = J+1 + Counter = Counter + Decomp%Head(Pe(I)+1)%EndTags(J) - & + Decomp%Head(Pe(I)+1)%StartTags(J) + 1 + IF ( Local(I) .LE. Counter ) THEN + Found = .TRUE. +! +! The following calculation is not immediately obvious. Think about it +! + Global(I) = Local(I) - Counter + Decomp%Head(Pe(I)+1)%EndTags(J) + Found = .TRUE. + ELSEIF ( J .GE. SIZE( Decomp%Head(Pe(I)+1)%StartTags ) ) THEN +! +! Emergency brake +! + Found = .TRUE. + Global(I) = 0 + ENDIF + ENDDO + ENDDO + + CPP_LEAVE_PROCEDURE( "DECOMPL2GVECTOR" ) + RETURN +! +!EOC + END SUBROUTINE DecompL2GVector +!------------------------------------------------------------------------ + + +!------------------------------------------------------------------------ +!BOP +! !IROUTINE: DecompInfo --- Information about decomposition +! +! !INTERFACE: + SUBROUTINE DecompInfo( Decomp, Npes, TotalPts ) +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ):: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Npes ! Npes in decomposition + INTEGER, INTENT( OUT ) :: TotalPts ! Total points in domain +! +! +! !DESCRIPTION: +! Return information about the decomposition: the number of +! PEs over which the domain is decomposed, and the size of +! the domain. +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC +! +! + CPP_ENTER_PROCEDURE( "DECOMPINFO" ) + + Npes = SIZE( Decomp%Head ) + TotalPts = Decomp%GlobalSize + + CPP_LEAVE_PROCEDURE( "DECOMPINFO" ) + RETURN +!EOC + END SUBROUTINE DecompInfo +!------------------------------------------------------------------------ + + END MODULE decompmodule + diff --git a/src/utils/pilgrim/ghostmodule.F90 b/src/utils/pilgrim/ghostmodule.F90 new file mode 100644 index 0000000000..81d12f7e2f --- /dev/null +++ b/src/utils/pilgrim/ghostmodule.F90 @@ -0,0 +1,1049 @@ +!------------------------------------------------------------------------ +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------ + MODULE ghostmodule +!BOP +! +! !MODULE: ghostmodule +! +! !USES: + USE decompmodule, ONLY : DecompType +#include "debug.h" +#include "pilgrim.h" + IMPLICIT NONE + +! +! !DESCRIPTION: +! +! This module provides the basic support for "ghost regions". In +! reality the ghost region just subset of the global domain +! described by a decomposition (pro memoria: a decomposition +! describes a partition of a global index space over a number +! of PEs; this is inherently non-overlapping). +! +! It contains the following public types and routines. +! \begin{center} +! \begin{tabular}{|l|l|} \hline \hline +! GhostType & Type to describe ghosted local vector \\ \hline +! GhostFree & Destroy a ghost definition \\ \hline +! GhostCreate & Copy ghost definition to newly created one\\ \hline +! GhostInfo & Returns some information about the region \\ \hline +! \hline \hline +! \end{tabular} +! \end{center} +! +! GhostCreate is overloaded to support different types of domains: +! +! \begin{center} +! \begin{tabular}{|l|l|} \hline \hline +! GhostCopy & Copy a ghost region \\ \hline +! GhostRegular1D & Define a subset of a 1D domain \\ \hline +! GhostRegular2D & Define a subset of a 2D domain \\ \hline +! GhostRegular3D & Define a subset of a 3D domain \\ \hline +! GhostRegular4D & Define a subset of a 4D domain \\ \hline +! GhostIrregular & Define a subset of an irregular domain \\ \hline +! \hline \hline +! \end{tabular} +! \end{center} +! +! Generally one will use the GhostCreate routine which corresponds +! to the underlying decomposition; e.g., if the decomposition was +! defined with DecompRegular3D you would probably use GhostRegular3D +! to define the ghost region. But since decompositions and ghost +! regions are generic, i.e., one-size-fits-all, this is not a requirement. +! Be very careful if you use non-corresponding routines! +! +! The ghost type contains a decomposition which describes the +! {\it non-overlapping} distribution of the global domain +! (this is a replicated data structure with complete information +! about all data structures on all PEs). Its other components are +! a list of the global indices of the on the boundary +! (not replicated), and a description of the mapping of the ghosted +! local region to global indices. +! +! This module is communication-free and is a foundation +! for ParUtilitiesModule. Since GhostType is local to the +! PE, the modules routines can and should be called with +! non-replicated data structures. Before boundary communication +! takes place, the communication pattern derived from the ghost regions +! must be created (see ParUtilitiesModule). +! +! !REVISION HISTORY: +! 00.11.10 Sawyer Creation +! 01.02.07 Sawyer Improvements; added Border to GhostType +! 01.02.12 Sawyer Converted to free format +! 02.08.27 Zaslavsky Changed intent from OUT to INOUT for objects of +! GhostType +! 02.12.23 Sawyer Added GhostRegular4D +! +! !PUBLIC TYPES: + PUBLIC GhostType + PUBLIC GhostFree + PUBLIC GhostCreate + PUBLIC GhostInfo + + INTERFACE GhostCreate + MODULE PROCEDURE GhostCopy + MODULE PROCEDURE GhostIrregular + MODULE PROCEDURE GhostRegular1D + MODULE PROCEDURE GhostRegular2D + MODULE PROCEDURE GhostRegular3D + MODULE PROCEDURE GhostRegular4D + END INTERFACE + +! Decomposition info + + TYPE GhostType + LOGICAL :: Defined! Is it defined? + TYPE(DecompType) :: Decomp ! Decomposition of global partition + TYPE(DecompType) :: Local ! Decomposition of local region + TYPE(DecompType) :: Border ! Decomposition of local segment + END TYPE GhostType + +!EOP + CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostFree --- Free a ghosted region +! +! !INTERFACE: + SUBROUTINE GhostFree ( Ghost ) +! !USES: + USE decompmodule, ONLY : DecompFree + IMPLICIT NONE + +! !INPUT/OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ):: Ghost ! Ghost information + +! +! !DESCRIPTION: +! Free the ghost decomposition -- deallocate the data structures. +! +! !SYSTEM ROUTINES: +! ASSOCIATED, DEALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! + CPP_ENTER_PROCEDURE( "GHOSTFREE" ) + + IF ( Ghost%Defined ) THEN + CALL DecompFree( Ghost%Border ) + CALL DecompFree( Ghost%Local ) + CALL DecompFree( Ghost%Decomp ) + Ghost%Defined = .FALSE. + ENDIF + + CPP_LEAVE_PROCEDURE( "GHOSTFREE" ) + RETURN +!EOC + END SUBROUTINE GhostFree +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostDefined --- Is the ghost type de +! +! !INTERFACE: + LOGICAL FUNCTION GhostDefined ( Ghost ) +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + TYPE(GhostType), INTENT( IN ):: Ghost ! Ghost information + +! +! !DESCRIPTION: +! Returns true if Ghost has been created but not yet destroyed +! +! !REVISION HISTORY: +! 02.07.18 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! + CPP_ENTER_PROCEDURE( "GHOSTDEFINED" ) + GhostDefined = Ghost%Defined + CPP_LEAVE_PROCEDURE( "GHOSTDEFINED" ) + + RETURN +!EOC + END FUNCTION GhostDefined +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostCopy --- Copy one decomposition to another +! +! !INTERFACE: + SUBROUTINE GhostCopy ( GhostIn, GhostOut ) +! !USES: + USE decompmodule, ONLY : DecompCopy + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(GhostType), INTENT( IN ) :: GhostIn ! Ghost information +! +! !OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ) :: GhostOut ! Ghost information +! +! !DESCRIPTION: +! +! Creates an output ghost definition and copies GhostIn to it +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, Nsize + + CPP_ENTER_PROCEDURE( "GHOSTCOPY" ) + + CALL DecompCopy( GhostIn%Decomp, GhostOut%Decomp ) + CALL DecompCopy( GhostIn%Local, GhostOut%Local ) + CALL DecompCopy( GhostIn%Border, GhostOut%Border ) + GhostOut%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTCOPY" ) + RETURN +!EOC + END SUBROUTINE GhostCopy +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostIrregular --- Create a ghost definition for 1-D grid +! +! !INTERFACE: + SUBROUTINE GhostIrregular( Decomp, Id, LocalSize, Tags, Ghost ) +! !USES: + USE decompmodule, ONLY : DecompCreate, DecompCopy, & + DecompGlobalToLocal, DecompInfo + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Id ! Local PE identifer + INTEGER, INTENT( IN ) :: LocalSize ! Size of local segment + INTEGER, INTENT( IN ) :: Tags(:) ! Global tags +! +! !OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition +! +! +! !DESCRIPTION: +! Creates a ghost definition for a ghosted array given by +! the PEs and Tags of the local points. Note that none of the +! array bounds can be outside the global domain! +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +! !BUGS: +! None of the array bounds can be outside of the global domain! +! This is significant if the local region is on the edge of the +! domain, and, in other words, the ghost region cannot cover +! empty space. This limitation may be relaxed in the future. +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, NPEs, GlobalSize, Local, Cnt, Ipe + INTEGER, ALLOCATABLE :: Pe(:), Other(:) +! +! + CPP_ENTER_PROCEDURE( "GHOSTIRREGULAR" ) +! +! Allocate the basic data structures +! + CALL DecompInfo( Decomp, Npes, GlobalSize ) + + ALLOCATE( Pe( LocalSize ) ) + ALLOCATE( Other( LocalSize ) ) + +! +! Use decompmodule to create global and local portions of Ghost +! The local version is only on the local processor "0" + + Other = Id + CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local ) + +! +! Perform over all points local segment +! + Cnt = 0 + DO I= 1, LocalSize + CALL DecompGlobalToLocal( Decomp, Tags(I), Local, Ipe ) + CPP_ASSERT_F90( (Local .GT. 0) .AND. (ipe .GE. 0) ) + IF ( Ipe .ne. id ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = Tags(I) + Pe( Cnt ) = Ipe + ENDIF + ENDDO + +! +! Define the border regions. Presumably Cnt << LocalSize +! + + CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border ) + +! +! Copy the decomposition too +! + CALL DecompCopy( Decomp, Ghost%Decomp ) + +! Clean up + + DEALLOCATE( Pe ) + DEALLOCATE( Other ) + Ghost%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTIRREGULAR" ) + RETURN +!EOC + END SUBROUTINE GhostIrregular +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostRegular1D --- Create a ghost definition for 1-D grid +! +! !INTERFACE: + SUBROUTINE GhostRegular1D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, & + Ghost ) +! !USES: + USE decompmodule, ONLY : DecompCreate, DecompCopy, & + DecompGlobalToLocal, DecompInfo + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Id ! Local PE identifer + INTEGER, INTENT( IN ) :: Xglobal! Total in X + INTEGER, INTENT( IN ) :: Xfrom ! Low index in X + INTEGER, INTENT( IN ) :: Xto ! High index in X + LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X? +! +! !OUTPUT PARAMETERS:p + TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition +! +! +! !DESCRIPTION: +! Creates a ghost definition for a regular 1-D array with the +! array bounds Xfrom:Xto. +! +! If the array bounds are outside of the global domain they may +! be wrapped around back into the global domain (variable Xwrap). +! If the region is not wrapped, it is advisable that the ghost +! region end at the boundary (which usually requires +! special case treatment depending on the PE number). If +! it does not end at the boundary, undefined points are +! introduced. +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +! !BUGS: +! +! There are certain limitations to ghost regions which can be +! avoided by clean programming practices. If the ghosted region +! wraps back onto core regions of the same PE, problems can arise. +! The simple case -- a ghosted region on 1 PE -- is supported in +! most cases. However, if it wraps back onto the local PE +! in such a way that more than one ghost points is mapped to +! one core domain global index, then the code may fail. Note +! that this is rarely the case if the ghost regions are small +! and enough processors are used to avoid wrapping back on the +! local one. +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, L, NPEs, GlobalSize, LocalSize, Cnt, Local, Ipe + INTEGER :: Global + INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:) +! +! + CPP_ENTER_PROCEDURE( "GHOSTREGULAR1D" ) + +! +! Allocate the basic data structures +! + CALL DecompInfo( Decomp, NPEs, GlobalSize ) + CPP_ASSERT_F90( GlobalSize .EQ. Xglobal ) + + LocalSize = Xto - Xfrom + 1 + CPP_ASSERT_F90( LocalSize .GE. 0 ) + + ALLOCATE( Pe( LocalSize ) ) + ALLOCATE( Tags( LocalSize ) ) + ALLOCATE( Other( LocalSize ) ) + +! +! Perform over all points local segment +! + Cnt = 0 + L = 0 + DO I = Xfrom, Xto + L = L + 1 + Global = MODULO(I-1,Xglobal)+1 ! Wrap around condition + IF (Xwrap .OR. Global==I) THEN + Tags(L) = Global ! Global Tags + CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe ) + IF ( Ipe .ne. Id .AND. Ipe .GE. 0 ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = Global ! Local Tags + Pe( Cnt ) = Ipe + ENDIF +! +! Special case: the domain wraps-around onto the same PE. This is +! very tricky: the ghost points are distinguished from their true +! local core domain counterparts by a minus sign. This makes the +! address space in both Ghost%Border and Ghost%Local unique +! + IF ( Ipe .eq. Id .AND. I .ne. Global ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = -Global ! Local Tags + Pe( Cnt ) = Ipe + Tags(L) = -Global ! Global Tags (mark ghost region!) + ENDIF + ELSE + Tags(L) = 0 + ENDIF + ENDDO + +! +! Perform over all points local segment +! + CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border ) + +! +! Use decompmodule to create global and local portions of Ghost +! The local version is only on the local PE +! + Other = Id + CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local ) + +! +! Copy the decomposition too +! + CALL DecompCopy( Decomp, Ghost%Decomp ) + +! Clean up + + DEALLOCATE( Other ) + DEALLOCATE( Tags ) + DEALLOCATE( Pe ) + + Ghost%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTREGULAR1D" ) + RETURN +!EOC + END SUBROUTINE GhostRegular1D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostRegular2D --- Create a ghost definition for 2-D grid +! +! !INTERFACE: + SUBROUTINE GhostRegular2D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, & + Yglobal, Yfrom, Yto, Ywrap, Ghost ) +! !USES: + USE decompmodule, ONLY : DecompCreate, DecompCopy, & + DecompGlobalToLocal, DecompInfo + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Id ! Local PE identifer + INTEGER, INTENT( IN ) :: Xglobal! Total in X + INTEGER, INTENT( IN ) :: Xfrom ! Low index in X + INTEGER, INTENT( IN ) :: Xto ! High index in X + LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X? + INTEGER, INTENT( IN ) :: Yglobal! Total in X + INTEGER, INTENT( IN ) :: Yfrom ! Distribution in X + INTEGER, INTENT( IN ) :: Yto ! Distribution in Y + LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y? + +! +! !OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition +! +! +! !DESCRIPTION: +! Creates a ghost definition for a regular 2-D array with the +! array bounds Xfrom:Xto,Yfrom:Yto. +! +! If the array bounds are outside of the global domain they may +! be wrapped around back into the global domain (Xwrap, Ywrap). +! If the region is not wrapped, it is advisable that the ghost +! region end at the boundary (which usually requires +! special case treatment depending on the PE number). If +! it does not end at the boundary, undefined points are +! introduced. +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +! !BUGS: +! +! There are certain limitations to ghost regions which can be +! avoided by clean programming practices. If the ghosted region +! wraps back onto core regions of the same PE, problems can arise. +! The simple case -- a ghosted region on 1 PE -- is supported in +! most cases. However, if it wraps back onto the local PE +! in such a way that more than one ghost points is mapped to +! one core domain global index, then the code may fail. Note +! that this is rarely the case if the ghost regions are small +! and enough processors are used to avoid wrapping back on the +! local one. +! +! WARNING: If the domain wraps around in both X and Y there is a +! the code should be run with at least 2 PEs so that in one of the +! two dimensions there is no wrap-around onto the same PE. +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, J, L, Ipe, Npes, GlobalSize, LocalSize + INTEGER :: Global, Cnt, Local, Xtrue, Ytrue + INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:) +! +! + CPP_ENTER_PROCEDURE( "GHOSTREGULAR2D" ) + +! +! Allocate the basic data structures +! + CALL DecompInfo( Decomp, Npes, GlobalSize ) + CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal ) + + LocalSize = (Xto - Xfrom + 1)*(Yto - Yfrom + 1) + CPP_ASSERT_F90( LocalSize .GE. 0 ) + ALLOCATE( Pe( LocalSize ) ) + ALLOCATE( Tags( LocalSize ) ) + ALLOCATE( Other( LocalSize ) ) +! +! Perform over all points local segment +! + Cnt = 0 + L = 0 + DO J= Yfrom, Yto + Ytrue = MODULO(J-1,Yglobal) + 1 + DO I= Xfrom, Xto + Xtrue = MODULO(I-1,Xglobal) + 1 + L = L + 1 + Global = (Ytrue-1)*Xglobal + Xtrue + IF ( (Xwrap.OR.(Xtrue==I)) .AND. (Ywrap.OR.(Ytrue==J)) ) THEN + Tags( L ) = Global + CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe ) + IF ( Ipe .ne. Id .AND. Ipe .GE. 0 ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = Global ! Local Tags + Pe( Cnt ) = Ipe + ENDIF +! +! Special case: the domain wraps-around onto the same PE. This is +! very tricky: the ghost points are distinguished from their true +! local core domain counterparts by a minus sign. This makes the +! address space in both Ghost%Border and Ghost%Local unique +! + IF ( Ipe.EQ.Id .AND. ( I.NE.Xtrue .OR. J.NE.Ytrue ) ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = -Global ! Local Tags + Pe( Cnt ) = Ipe + Tags(L) = -Global ! Global Tags (mark ghost region!) + ENDIF + ELSE + Tags(L) = 0 + ENDIF + ENDDO + ENDDO + +! +! Perform over all points local segment +! + CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border ) + +! +! Use decompmodule to create global and local portions of Ghost +! The local version is only on the local PE +! + Other = Id + CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local ) + +! +! Copy the decomposition too +! + CALL DecompCopy( Decomp, Ghost%Decomp ) + +! Clean up + + DEALLOCATE( Other ) + DEALLOCATE( Tags ) + DEALLOCATE( Pe ) + + Ghost%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTREGULAR2D" ) + RETURN +!EOC + END SUBROUTINE GhostRegular2D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostRegular3D --- Create a ghost definition for 3-D grid +! +! !INTERFACE: + SUBROUTINE GhostRegular3D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, & + Yglobal, Yfrom, Yto, Ywrap, & + Zglobal, Zfrom, Zto, Zwrap, Ghost ) +! !USES: + USE decompmodule, ONLY : DecompCreate, DecompCopy, & + DecompGlobalToLocal, DecompInfo + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Id ! Local PE identifer + INTEGER, INTENT( IN ) :: Xglobal! Total in X + INTEGER, INTENT( IN ) :: Xfrom ! Low index in X + INTEGER, INTENT( IN ) :: Xto ! High index in X + LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X? + INTEGER, INTENT( IN ) :: Yglobal! Total in Y + INTEGER, INTENT( IN ) :: Yfrom ! Distribution in Y + INTEGER, INTENT( IN ) :: Yto ! Distribution in Y + LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y? + INTEGER, INTENT( IN ) :: Zglobal! Total in Z + INTEGER, INTENT( IN ) :: Zfrom ! Distribution in Z + INTEGER, INTENT( IN ) :: Zto ! Distribution in Z + LOGICAL, INTENT( IN ) :: Zwrap ! Wrap in Z? +! +! !OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition +! +! +! !DESCRIPTION: +! Creates a ghost definition for a regular 3-D array with the +! array bounds Xfrom:Xto,Yfrom:Yto,Zfrom:Zto. +! +! If the array bounds are outside of the global domain they may +! be wrapped around back into the global domain (Xwrap, Ywrap). +! If the region is not wrapped, it is advisable that the ghost +! region end at the boundary (which usually requires +! special case treatment depending on the PE number). If +! it does not end at the boundary, undefined points are +! introduced. +! +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +! !BUGS: +! There are certain limitations to ghost regions which can be +! avoided by clean programming practices. If the ghosted region +! wraps back onto core regions of the same PE, problems can arise. +! The simple case -- a ghosted region on 1 PE -- is supported in +! most cases. However, if it wraps back onto the local PE +! in such a way that more than one ghost points is mapped to +! one core domain global index, then the code may fail. Note +! that this is rarely the case if the ghost regions are small +! and enough processors are used to avoid wrapping back on the +! local one. +! +! WARNING: If the domain wraps around in two of the three dims +! the code should be run with at least 2 PEs so that in one of the +! two dimensions there is no wrap-around onto the same PE. If it +! wraps around in all three dimensions it should be run on at least +! 4 PEs. Note these are extremely rare toriodal cases. +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, J, K, L, Ipe, Npes, GlobalSize, LocalSize + INTEGER :: Global, Cnt, Local, Xtrue, Ytrue, Ztrue + LOGICAL :: IsX, IsY, IsZ + INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:) +! +! + CPP_ENTER_PROCEDURE( "GHOSTREGULAR3D" ) + +! +! Allocate the basic data structures +! + CALL DecompInfo( Decomp, Npes, GlobalSize ) + CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal*Zglobal ) + + LocalSize = (Xto-Xfrom+1) * (Yto-Yfrom+1) * (Zto-Zfrom+1) + + CPP_ASSERT_F90( LocalSize .GE. 0 ) + ALLOCATE( Pe( LocalSize ) ) + ALLOCATE( Tags( LocalSize ) ) + ALLOCATE( Other( LocalSize ) ) +! +! Perform over all points local segment +! + Cnt = 0 + L = 0 + DO K = Zfrom, Zto + Ztrue = MODULO(K-1,Zglobal) + 1 + DO J = Yfrom, Yto + Ytrue = MODULO(J-1,Yglobal) + 1 + DO I = Xfrom, Xto + Xtrue = MODULO(I-1,Xglobal) + 1 + L = L + 1 + Global = ((Ztrue-1)*Yglobal+(Ytrue-1))*Xglobal+Xtrue +! +! Check to see if this is an defined global index +! + CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe ) + CPP_ASSERT_F90( (Local .GT. 0) .AND. (Ipe .GE. 0) ) +! +! The wrapping case: mark as undefined + + IsX = Xtrue/=I + IsY = Ytrue/=J + IsZ = Ztrue/=K + IF ( (.NOT.Xwrap.AND.IsX) .OR. (.NOT.Ywrap.AND.IsY) & + .OR. (.NOT.Zwrap.AND.IsZ) ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = 0 ! Local Tags + Pe( Cnt ) = Ipe + Tags( L ) = 0 + ELSE IF ( Ipe .ne. Id ) THEN +! +! Boundary case: Global is in a ghost region not belonging +! to this PE. Mark it in the border data structure (Arrays Other and Pe) +! + Cnt = Cnt + 1 + Other( Cnt ) = Global ! Local Tags + Pe( Cnt ) = Ipe + Tags( L ) = Global + ELSE IF ( Ipe==Id .AND. (IsX.OR.IsY.OR.IsZ) ) THEN +! +! Special case: the domain wraps-around onto the same PE. This is +! very tricky: the ghost points are distinguished from their true +! local core domain counterparts by a minus sign. This makes the +! address space in both Ghost%Border and Ghost%Local unique +! + Cnt = Cnt + 1 + Other( Cnt ) = -Global ! Local Tags + Pe( Cnt ) = Ipe + Tags(L) = -Global ! Global Tags (mark ghost region!) + ELSE + Tags( L ) = Global + ENDIF + ENDDO + ENDDO + ENDDO + CPP_ASSERT_F90( LocalSize==L ) +! +! Perform over all points local segment +! + CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border ) + +! +! Use decompmodule to create global and local portions of Ghost +! The local version is only on the local PE +! + Other = Id + CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local ) + +! +! Copy the decomposition too +! + CALL DecompCopy( Decomp, Ghost%Decomp ) + +! Clean up + + DEALLOCATE( Other ) + DEALLOCATE( Tags ) + DEALLOCATE( Pe ) + + Ghost%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTREGULAR3D" ) + RETURN +!EOC + END SUBROUTINE GhostRegular3D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostRegular4D --- Create a ghost definition for 4-D grid +! +! !INTERFACE: + SUBROUTINE GhostRegular4D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, & + Yglobal, Yfrom, Yto, Ywrap, & + Zglobal, Zfrom, Zto, Zwrap, & + Tglobal, Tfrom, Tto, Twrap, Ghost ) +! !USES: + USE decompmodule, ONLY : DecompCreate, DecompCopy, & + DecompGlobalToLocal, DecompInfo + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + INTEGER, INTENT( IN ) :: Id ! Local PE identifer + INTEGER, INTENT( IN ) :: Xglobal! Total in X + INTEGER, INTENT( IN ) :: Xfrom ! Low index in X + INTEGER, INTENT( IN ) :: Xto ! High index in X + LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X? + INTEGER, INTENT( IN ) :: Yglobal! Total in Y + INTEGER, INTENT( IN ) :: Yfrom ! Distribution in Y + INTEGER, INTENT( IN ) :: Yto ! Distribution in Y + LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y? + INTEGER, INTENT( IN ) :: Zglobal! Total in Z + INTEGER, INTENT( IN ) :: Zfrom ! Distribution in Z + INTEGER, INTENT( IN ) :: Zto ! Distribution in Z + LOGICAL, INTENT( IN ) :: Zwrap ! Wrap in Z? + INTEGER, INTENT( IN ) :: Tglobal! Total in T + INTEGER, INTENT( IN ) :: Tfrom ! Distribution in T + INTEGER, INTENT( IN ) :: Tto ! Distribution in T + LOGICAL, INTENT( IN ) :: Twrap ! Wrap in T? +! +! !OUTPUT PARAMETERS: + TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition +! +! +! !DESCRIPTION: +! Creates a ghost definition for a regular 3-D array with the +! array bounds Xfrom:Xto,Yfrom:Yto,Zfrom:Zto,Tfrom:Tto. +! +! If the array bounds are outside of the global domain they may +! be wrapped around back into the global domain (Xwrap, Ywrap). +! If the region is not wrapped, it is advisable that the ghost +! region end at the boundary (which usually requires +! special case treatment depending on the PE number). If +! it does not end at the boundary, undefined points are +! introduced. +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !REVISION HISTORY: +! 02.12.23 Sawyer Creation from GhostRegular3D +! +! !BUGS: +! There are certain limitations to ghost regions which can be +! avoided by clean programming practices. If the ghosted region +! wraps back onto core regions of the same PE, problems can arise. +! The simple case -- a ghosted region on 1 PE -- is supported in +! most cases. However, if it wraps back onto the local PE +! in such a way that more than one ghost points is mapped to +! one core domain global index, then the code may fail. Note +! that this is rarely the case if the ghost regions are small +! and enough processors are used to avoid wrapping back on the +! local one. +! +! WARNING: If the domain wraps around in two of the three dims +! the code should be run with at least 2 PEs so that in one of the +! two dimensions there is no wrap-around onto the same PE. If it +! wraps around in all three dimensions it should be run on at least +! 4 PEs. Note these are extremely rare toriodal cases. +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: I, J, K, L, M, Ipe, Npes, GlobalSize, LocalSize + INTEGER :: Global, Cnt, Local, Xtrue, Ytrue, Ztrue, Ttrue + LOGICAL :: IsX, IsY, IsZ, IsT + INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:) +! +! + CPP_ENTER_PROCEDURE( "GHOSTREGULAR4D" ) + +! +! Allocate the basic data structures +! + CALL DecompInfo( Decomp, Npes, GlobalSize ) + CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal*Zglobal*Tglobal ) + + LocalSize = (Xto-Xfrom+1)*(Yto-Yfrom+1)*(Zto-Zfrom+1)*(Tto-Tfrom+1) + + CPP_ASSERT_F90( LocalSize .GE. 0 ) + ALLOCATE( Pe( LocalSize ) ) + ALLOCATE( Tags( LocalSize ) ) + ALLOCATE( Other( LocalSize ) ) +! +! Perform over all points local segment +! + Cnt = 0 + M = 0 + DO L = Tfrom, Tto + Ttrue = MODULO(L-1,Tglobal) + 1 + DO K = Zfrom, Zto + Ztrue = MODULO(K-1,Zglobal) + 1 + DO J = Yfrom, Yto + Ytrue = MODULO(J-1,Yglobal) + 1 + DO I = Xfrom, Xto + Xtrue = MODULO(I-1,Xglobal) + 1 + M = M + 1 + Global = (((Ttrue-1)*Zglobal+(Ztrue-1))*Yglobal+(Ytrue-1)) & + *Xglobal+Xtrue +! +! Check to see if this is an defined global index +! + CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe ) + CPP_ASSERT_F90( (Local .GT. 0) .AND. (Ipe .GE. 0) ) +! +! The wrapping case: mark as undefined + + IsX = Xtrue/=I + IsY = Ytrue/=J + IsZ = Ztrue/=K + IsT = Ttrue/=L + IF ( (.NOT.Xwrap.AND.IsX) .OR. (.NOT.Ywrap.AND.IsY) & + .OR. (.NOT.Zwrap.AND.IsZ) .OR. (.NOT.Twrap.AND.IsT) ) THEN + Cnt = Cnt + 1 + Other( Cnt ) = 0 ! Local Tags + Pe( Cnt ) = Ipe + Tags(M) = 0 + ELSE IF ( Ipe .ne. Id ) THEN +! +! Boundary case: Global is in a ghost region not belonging +! to this PE. Mark it in the border data structure (Arrays Other and Pe) +! + Cnt = Cnt + 1 + Other( Cnt ) = Global ! Local Tags + Pe( Cnt ) = Ipe + Tags(M) = Global + ELSE IF ( Ipe==Id .AND. (IsX.OR.IsY.OR.IsZ.OR.IsT) ) THEN +! +! Special case: the domain wraps-around onto the same PE. This is +! very tricky: the ghost points are distinguished from their true +! local core domain counterparts by a minus sign. This makes the +! address space in both Ghost%Border and Ghost%Local unique +! + Cnt = Cnt + 1 + Other( Cnt ) = -Global ! Local Tags + Pe( Cnt ) = Ipe + Tags(M) = -Global ! Global Tags (mark ghost region!) + ELSE + Tags(M) = Global + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CPP_ASSERT_F90( LocalSize==M ) +! +! Perform over all points local segment +! + CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border ) + +! +! Use decompmodule to create global and local portions of Ghost +! The local version is only on the local PE +! + Other = Id + CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local ) + +! +! Copy the decomposition too +! + CALL DecompCopy( Decomp, Ghost%Decomp ) + +! Clean up + + DEALLOCATE( Other ) + DEALLOCATE( Tags ) + DEALLOCATE( Pe ) + + Ghost%Defined = .TRUE. + + CPP_LEAVE_PROCEDURE( "GHOSTREGULAR4D" ) + RETURN +!EOC + END SUBROUTINE GhostRegular4D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GhostInfo --- Information about ghosted decompostion +! +! !INTERFACE: + SUBROUTINE GhostInfo( Ghost, Npes, & + GlobalSize, LocalSize, BorderSize ) +! !USES: + USE decompmodule, ONLY : DecompInfo + IMPLICIT NONE + +! !INPUT PARAMETERS: + TYPE(GhostType), INTENT( IN ):: Ghost ! Ghost information + +! !INPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Npes ! Number of Pes + INTEGER, INTENT( OUT ) :: GlobalSize ! Size of global domain + INTEGER, INTENT( OUT ) :: LocalSize ! Size of ghosted local region + INTEGER, INTENT( OUT ) :: BorderSize ! Size of border +! +! !DESCRIPTION: +! Return information about the ghosted region +! +! !SYSTEM ROUTINES: +! +! !REVISION HISTORY: +! 00.11.12 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! + CPP_ENTER_PROCEDURE( "GHOSTINFO" ) + + CALL DecompInfo( Ghost%Decomp, Npes, GlobalSize ) + CALL DecompInfo( Ghost%Local, Npes, LocalSize ) + CALL DecompInfo( Ghost%Border, Npes, BorderSize ) + + CPP_LEAVE_PROCEDURE( "GHOSTINFO" ) + RETURN +!EOC + END SUBROUTINE GhostInfo +!----------------------------------------------------------------------- + + END MODULE ghostmodule diff --git a/src/utils/pilgrim/memstuff.c b/src/utils/pilgrim/memstuff.c new file mode 100644 index 0000000000..3c08556695 --- /dev/null +++ b/src/utils/pilgrim/memstuff.c @@ -0,0 +1,279 @@ +#if defined (USE_MLP) +#include +#include +#include +#include +#include +#include +#include + +#define CACHE_LINE_SIZE 128 +#define SECTION_ROUND (1024*1024) +#define BARRIER_AREA_ROUND (16*1024) +#define round_up(n, round) (((n + (round - 1)) / round) * round) + +#if defined ( PGI ) || defined ( LAHEY ) +#define ROUND (1024*1024) + +volatile long long *__prior_counter_ptr; +volatile long long *__current_counter_ptr; +#endif + + +/**********************************************************************/ +/**********************************************************************/ +/* Barrier */ +/**********************************************************************/ +#if defined ( PGI ) || defined ( LAHEY ) + + +char *_lock_filename = "./_lock_file"; +void +_lock(void) /*This part will be implemented by semaphore later, BW */ +{ + unsigned long long num_attempts = 0; + int fd; + + while ((fd = creat(_lock_filename, 0)) == -1) { + if (errno != EACCES) { + perror("Failed to creat _lock_file"); + exit(1); + } +/* if ((++num_attempts % 100000) == 0) { */ + if ((++num_attempts % 100000) == 0) { + fprintf(stderr, "%lld lock attemps have failed on %s\n" + "(Perhaps an old copy of the file was not deleted?)\n", + num_attempts, _lock_filename); + } + } + close(fd); +} + +void +_unlock(void) /*This part will be implemented by semaphore later, BW */ +{ + if (unlink(_lock_filename) == -1) { + perror("unlink of _lock_file"); + exit(1); + } +} + +void +mlp_barrier__(int *n_ptr) +{ + long long target_value = *n_ptr + *__prior_counter_ptr; + long long new_value; + +/* printf("getpid = %d \n", getpid()); */ +/* printf("target_value = %d for %d \n", target_value, getpid()); */ + _lock(); + { + new_value = *__current_counter_ptr + 1; + *__current_counter_ptr = new_value; + } + _unlock(); + + if (new_value == target_value) { + *__prior_counter_ptr = target_value; + } + while (*__prior_counter_ptr != target_value) { + /* spin */ ; + } +} + +#else + + +/* Note: FAN_IN is arbitrary - it does not need to be a power of two. +** By using a power of two, the compiler can optimize the arithmetic. +** FAN_IN of 2 would be a binary tree, FAN_IN of 4 a quad tree, etc. +*/ +#define FAN_IN 4 +#define MAX_PROCESSES 1024 + + +typedef struct { + volatile unsigned long long current_value; + unsigned long long pad1[CACHE_LINE_SIZE/sizeof(unsigned long long) - 1]; + volatile unsigned long long previous_value; + unsigned long long pad2[CACHE_LINE_SIZE/sizeof(unsigned long long) - 1]; +} __mlp_join_line_type; + +__mlp_join_line_type *__ptr_mlp_join_area; + + + + + +/* +** Barrier wait for n processes with id's 0 .. n-1 +** +** Each block of FAN_IN processes increments a different counter. When +** all the procs in that block have reported in, the group counter one +** level up is incremented. When all the groups on that level have reported +** in, the next higher level counter is incremented. When everyone has +** reported in, notification is propagated back down and we are done. +** +** Note: we must acquire the target_value *before* we __add_and_fetch +** the counter to avoid a race condition. +** +** By using 64bit monotonic counters, we do not need to reset the counts. +** This saves memory transactions. The code as written does NOT assume +** FAN_IN is a power of two; we rely on the compiler to simplify the +** arithmetic where possible and appropriate. +** (we use unsigned values to make this more clear to the compiler). +*/ + + + +/* Recurse up the barrier tree */ +/* Note that the id's are zero-based */ +void +__mlp_sync_step( + __mlp_join_line_type *base, + unsigned int my_id, + unsigned int last_id) +{ + unsigned int last_group = last_id / FAN_IN; + unsigned int my_group = my_id / FAN_IN; + unsigned int my_group_size = + (my_group < last_group) ? FAN_IN : (last_id % FAN_IN) + 1; + + __mlp_join_line_type *ptr_my_group = base + my_group; + + unsigned long long target_value = + ptr_my_group->previous_value + my_group_size; + + unsigned long long value = + __add_and_fetch(&(ptr_my_group->current_value), 1ULL); + + if (value < target_value) { + /* I am not the last process of my group that needs to get here */ + /* Spin until previous_value is set by the last member of the group */ + while (ptr_my_group->previous_value < target_value) /* spin */ ; + } + else { + /* I was the last process in my group to reach this sync point. */ + + /* If we are not already at the top level, then sync one level up */ + if (last_group != 0) { + __mlp_sync_step(base + last_group + 1, my_group, last_group); + } + + /* Propagate notification downwards to other processes in my group */ + ptr_my_group->previous_value = target_value; + } +} + + +void +mlp_barrier_(unsigned int *ptr_my_id, unsigned int *ptr_num_procs) +{ + __mlp_sync_step(__ptr_mlp_join_area, *ptr_my_id, *ptr_num_procs - 1); +} + +#endif + +/**********************************************************************/ +/**********************************************************************/ +/* End Barrier */ +/**********************************************************************/ + + + + + + + +/**********************************************************************/ +/**********************************************************************/ +/* Allocate and Initialize the shared memory */ +/**********************************************************************/ +void +mlp_getmem_(long long *n_ptr, long long size[], long long pointer[]) +{ + int fd, i, n = *n_ptr; + unsigned long long total_size = 0; + char buf[100]; + char *mmap_addr; +#if defined ( IRIX64 ) + unsigned long barrier_area_size = 0; + unsigned long num_groups_this_level = 0; +#endif + + for (i=0; i=0; i--) { + __ptr_mlp_join_area[i].current_value = 0; + __ptr_mlp_join_area[i].previous_value = 0; + } + mmap_addr += barrier_area_size; +#endif + + /* Parcel out the space */ + for (i=0; i ga\_r8 - for use with real*8 types +! \item r4\_win -> ga\_r4 - for use with real*4 types +! \item i4\_win -> ga\_i4 - for use with integer*4 types +! \end{itemize} +! +! note: MPI routines need 2 buffers per GA, ga\_\_s & ga\_\_r +! ga\_\_r is used for the windows +! +! \paragraph{Compilation} +! +! This module contains several precompile options: +! +! \begin{itemize} +! \item {\tt STAND_ALONE}: Use as stand-alone library (if +! defined) or as part of CAM (if +! undefined) +! \item {\tt MODCM_TIMING}: Turn on CAM timing routines (only +! available if compiled in CAM framework) +! \item {\tt _OPENMP}: Implicit token (controlled by +! compiler) to enable OpenMP +! \end{itemize} +! +! +! \paragraph{Usage} +! +! NOTE - must call PILGRIM routine parinit to initialize before +! making any other calls. +! +! The public members of this module are: +! +! \begin{itemize} +! \item {\tt mp\_init}: Initialize module +! \item {\tt mp\_exit}: Exit module +! \item {\tt mp\_send4d\_ns}: Ghost 4D array on north/south +! \item {\tt mp\_recv4d\_ns}: Complete 4D N/S ghost operation +! \item {\tt mp\_send2\_ns}: Ghost 2 3D arrays on north/south +! \item {\tt mp\_recv2\_ns}: Complete 2x3D N/S ghost operation +! \item {\tt mp\_send3d}: Send 3D general ghost region +! \item {\tt mp\_recv3d}: Complete 3D general ghost operation +! \item {\tt mp\_send3d\_2}: Send 2x3D general ghost regions +! \item {\tt mp\_recv3d\_2}: Complete 2x3D general ghost operation +! \item {\tt get\_partneroffset}:Offset for remote write +! \item {\tt mp\_sendirr}: Initiate all-to-all send of parcels +! \item {\tt mp\_recvirr}: Complete all-to-all chunk commun. +! \end{itemize} +! +! There are variants of some of these routines for r4 and i4 data types. +! There are other public routines, but these are only used internally +! in PILGRIM, and they should not be called by user applications. +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.04.16 Putman Modified for Global Array code +! 2002.04.16 Putman Added ProTeX documentation +! 2002.05.28 Putman Added use of precision module +! 2003.06.24 Sawyer Minor additions for use with mod_irreg +! 2004.01.08 Sawyer Removed older functionality, no longer needed +! 2004.02.10 Mirin Major restructuring and simplification. Documentation +! 2004.03.06 Sawyer Additional documentation; cosmetics +! 2005.03.20 Sawyer Added extensive support for real*4 +! 2005.10.12 Worley Improved vectorization of buffer copies and general clean-up +! 2006.05.15 Mirin Make dynamic allocation the default; general clean-up. +! !USES: +#if defined( STAND_ALONE ) +# define iulog 6 +#else + use cam_logfile, only: iulog +#endif + +! +! Performance bug work around for Gemini interconnect +! +#ifdef _NO_MPI_RSEND +#define MPI_RSEND MPI_SEND +#define mpi_rsend mpi_send +#define MPI_IRSEND MPI_ISEND +#define mpi_irsend mpi_isend +#endif + +! +! Mod_comm has option for stand-alone use as well as within CAM +! + +#if defined ( SPMD ) + +#if defined( STAND_ALONE ) +# define r8 selected_real_kind(12) +# define r4 selected_real_kind( 6) +# define i8 selected_int_kind(13) +# define i4 selected_int_kind( 6) +# define PLON 144 +# define PLAT 91 +# define PLEV 26 +# define PCNST 1 +#else + use shr_kind_mod, only : r8 => shr_kind_r8, r4 => shr_kind_r4, & + i8 => shr_kind_i8, i4 => shr_kind_i4 +#endif +#if defined( MODCM_TIMING ) + use perf_mod +#endif + + implicit none + +#include "mpif.h" + +! !PUBLIC MEMBER FUNCTIONS: + public mp_init, mp_exit, & + mp_send4d_ns, mp_recv4d_ns, mp_send4d_ns_r4, mp_recv4d_ns_r4, & + mp_send2_ns, mp_recv2_ns, mp_send3d_2, mp_recv3d_2, & + mp_send3d, mp_recv3d, mp_sendirr, mp_recvirr, & + mp_sendirr_r4, mp_recvirr_r4, mp_sendirr_i4, mp_recvirr_i4, & + mp_swapirr, mp_swapirr_i4, mp_barrier, & + get_partneroffset, mp_r8, mp_r4, mp_i4, & + mp_sendtrirr, mp_recvtrirr, mp_swaptrirr + public modcam_method, modcam_geopk, modcam_gatscat, modcam_npryz, modcam_maxirr + +! !PRIVATE MEMBER FUNCTIONS: + private ceil2 ! copy of routine in atm/cam/src/utils/spmdutils + private pair ! copy of routine in atm/cam/src/utils/spmdutils + +!------------------------------------------------------------------------------ +! type declaration for describing an arbitrary number of contiguous parcels +! this is for irregular communications +!------------------------------------------------------------------------------ + type blockdescriptor + integer :: method ! transpose method + integer :: type ! Ptr to MPI derived type + integer, pointer :: displacements(:) ! Offsets in local segment + integer, pointer :: blocksizes(:) ! Block sizes to transfer + integer :: partneroffset ! Aggregated partner offset + integer :: partnertype ! Ptr to partner's MPI derived type + integer :: Nparcels ! size( displacements ) + integer :: Tot_Size ! sum ( blocksizes ) + end type blockdescriptor + +! Transpose methods (method) +! 0 for contiguous temporary buffer +! 1 for direct communication (derived types) + +! The variables immediately below refer specifically to mpi derived types + INTEGER, ALLOCATABLE, SAVE :: InHandle(:, :) + INTEGER, ALLOCATABLE, SAVE :: OutHandle(:, :) + INTEGER, SAVE :: BegTrf = 0 ! Ongoing overlapped begintransfer # + INTEGER, SAVE :: EndTrf = 0 ! Ongoing overlapped endtransfer # + INTEGER, SAVE :: MaxTrf = 0 ! Max no. active Mp_sendirr derived type messages + +! !PUBLIC DATA MEMBERS: + integer, SAVE:: gid ! PE id + integer(i4), SAVE:: masterpro = 0 ! Master process id + integer(i4), SAVE:: numpro ! Permanent No. of PEs + integer(i4), SAVE:: numcomm ! Local No. of PEs + integer(i4), SAVE:: numcpu ! No. of threads + integer, SAVE:: commglobal ! Global Communicator + integer, SAVE:: Max_Nparcels = 0 ! Maximum number of parcels in + ! single blockdescriptor + +!------------------------------------------------------------------------------ +! Local parameters +!------------------------------------------------------------------------------ + integer, parameter:: nbuf = 2 ! Max No. of sends per call +! mp_send4d_ns has two sends per call (full border regions to north and south) +! mp_send2_ns has four sends per call (2 directions and 2 variables); however, +! only one ghost latitude is sent, so nbuf=2 suffices as long as nghost +! is greater than 1. +! mp_send3d has one send per call (border region in one direction). +! mp_send3d_2 has two sends per call (2 variables, border region in one direction). + integer, parameter:: nghost = 3 ! No. of ghost indices + integer, parameter:: max_nq = 1 ! No. of tracers simultaneously + ! border communicated; can be + ! overridden with dynamic storage + integer, parameter:: max_trac = PCNST ! No. of tracers + integer, parameter:: max_call = 2 ! Max No. of back-to-back... + ! ...mp_send calls +! Currently, CAM has at most two overlapping border communication calls +! The above variable is relevant for contiguous irregular communications + + integer, parameter:: idimsize = PLON*nghost*(PLEV+1)*max_nq + ! Size of MPI buffer region + ! in mp_send/mp_recv calls, used + ! to determine offset in GA + integer, parameter:: platg = PLAT + 2*nghost + integer, parameter :: mp_r4 = MPI_REAL + integer, parameter :: mp_r8 = MPI_DOUBLE_PRECISION + integer, parameter :: mp_i4 = MPI_INTEGER + +!------------------------------------------------------------------------------ +! Local variables +!------------------------------------------------------------------------------ + + integer, SAVE:: max_irr = 0 ! Max No. active Mp_sendirr calls with window + integer ierror + integer, SAVE:: sizet1, sizer8, sizer4, sizei4 + +! CAM-specific variables + integer, SAVE:: tracmax, tracbmax, dpvarmax, totvar + integer, SAVE:: phys_transpose_mod + integer, SAVE:: idimsizz + integer, SAVE:: modcam_method, modcam_geopk, modcam_gatscat + integer, SAVE:: modcam_npryz(4), modcam_tagoffset, modcam_maxirr + integer, parameter :: phys_transpose_modmin = 11 + integer, parameter :: phys_transpose_vars = 7 + data phys_transpose_mod / -1 / + data modcam_method / -1 / + data modcam_geopk / -1 / + data modcam_gatscat / -1 / + data modcam_npryz / -1, -1, -1, -1 / + data modcam_tagoffset / 0 / + data modcam_maxirr / -1 / +! +! tracmax is the maximum number of tracers simultaneously transposed within dynamics (set to 1) +! (except in dynamics-physics transposes) +! tracbmax is the maximum number of tracers simultaneously border communicated +! dpvarmax is the number of variables communicated in dynamics-physics transposes +! totvar is the maximum number of variables simultaneously transposed +! phys_transpose_mod is the communication method for dynamics/physics transposes; admissable values +! are >= phys_transpose_modmin; it is communicated from CAM when such transposes +! are requested. +! phys_transpose_vars is the number of non-tracer variables transposed between dynamics and +! physics instantiations in CAM. +! modcam_method, modcam_geopk and modcam_gatscat correspond to mod_method, mod_geopk and +! mod_gatscat in CAM. +! modcam_npryz corresponds to npr_yz in CAM. +! modcam_maxirr corresonds to mod_maxirr in CAM. + +!------------------------------------------------------------------------------ +! Variables to control global array locations and window synchronization +!------------------------------------------------------------------------------ + integer win_count ! Counts No. of windows in use + integer igosouth, igonorth ! Index of latitudinal send direction + integer ifromsouth, ifromnorth ! Index of latitudinal recv direction + +!------------------------------------------------------------------------------ +! Local type declaration for mp_windows +!------------------------------------------------------------------------------ + type window + integer :: id ! Window id + integer :: size ! Size of global window (point based) + integer :: ncall_s ! Count send calls on window + integer :: ncall_r ! Count recv calls on window + integer :: offset_s ! Starting position in GA send + integer :: offset_r ! Starting position in GA recv + integer :: dest ! For use with send calls + integer :: src ! For use with recv calls + integer :: size_r ! Size of incoming message + integer :: nsend ! Send counter + integer :: nrecv ! Receive post counter + integer :: nread ! Receive confirm counter + integer, pointer :: sqest(:) ! Send handle + integer, pointer :: rqest(:) ! Receive handle + end type window + +!------------------------------------------------------------------------------ +! Beginning Global Array variable declaration: +!------------------------------------------------------------------------------ + + type (window) :: r8_win + type (window) :: r4_win + type (window) :: i4_win + type (window) :: t1_win + +! Upper bound on ratio of local to average storage over subdomains. +! This takes into account different sized subdomains. + + real*8, parameter :: alloc_slack_factor = 1.2_r8 + +! +! window variable declarations +! + real(r8), allocatable, SAVE:: ga_t1_r(:) + real(r8), allocatable, SAVE:: ga_t1_s(:) + real(r8), allocatable, SAVE:: ga_r8_r(:) + real(r8), allocatable, SAVE:: ga_r8_s(:) + real(r4), allocatable, SAVE:: ga_r4_r(:) + real(r4), allocatable, SAVE:: ga_r4_s(:) + integer(i4), allocatable, SAVE:: ga_i4_r(:) + integer(i4), allocatable, SAVE:: ga_i4_s(:) +! +! auxiliary variable declarations +! + integer, SAVE:: Status(MPI_STATUS_SIZE) + integer, allocatable, SAVE:: Stats(:) +! +!EOP +!------------------------------------------------------------------------------ + contains +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_init --- Initialize SPMD parallel communication +! +! !INTERFACE: + subroutine mp_init( comm, npryzxy, mod_method, mod_geopk, mod_gatscat, mod_maxirr ) +! +! !INPUT PARAMETERS: + integer, optional :: comm ! communicator + integer, optional, intent(in) :: npryzxy(4) ! 2D decomposition + integer, optional, intent(in) :: mod_method ! CAM optimization + integer, optional, intent(in) :: mod_geopk ! CAM optimization + integer, optional, intent(in) :: mod_gatscat ! CAM optimization + integer, optional, intent(in) :: mod_maxirr ! CAM optimization +! !DESCRIPTION: +! +! Initialize SPMD parallel communication. It is recommended that +! COMM (main communicator) and NPRYZXY (2D decomposition) be set. +! +! Set the mod* variables only if you are acquainted with their +! meaning (default is 0). +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Array code +! 2002.04.09 Putman Added ProTeX documentation +! 2002.08.06 Sawyer Added optional communicator input argument +! 2006.06.15 Sawyer Added CAM-dependent optional arguments +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer mysize + integer using_window, vertical_lines, latitude_lines + integer local_dynamic_storage, numpro_use + real*8 geopkrat, one, ghostrat + +! Initialize MPI; allow for general communicator + if ( present(comm) ) then + call mpi_start( comm ) + else + call mpi_start( MPI_COMM_WORLD ) + endif +! Initialize OpenMP + call omp_start +! +! Adopt 2D decomposition if provided. +! + modcam_npryz = (/ 1,1,1,1 /) ! Default value (sequential) + if ( present( npryzxy ) ) then + modcam_npryz(1:4) = npryzxy(1:4) + modcam_tagoffset = modcam_npryz(3) * modcam_npryz(4) + endif + if (gid .eq. 0) then + write (iulog,*) 'MOD_COMM - modcam_npryz = ', & + modcam_npryz(1), modcam_npryz(2), & + modcam_npryz(3), modcam_npryz(4) + write (iulog,*) 'MOD_COMM - modcam_tagoffset = ', modcam_tagoffset + endif + +! +! Set CAM optimization variables +! +! modcam_method refers to irregular communications for transposes +! modcam_geopk refers to irregular communications for the geopotential +! modcam_gatscat refers to irregular communications for gather/scatters +! For any of these, a value of 0 means source data will be gathered into a contiguous +! buffer (window), communicated to a contiguous buffer (window) in the target, and +! then scattered to its final destination; a value of 1 means MPI derived types will +! be used (hence not requiring window storage). +! modcam_maxirr refers to maximum number of irregular communications to be active at once + modcam_method = 0 ! Default value + modcam_geopk = 0 ! Default value + modcam_gatscat = 0 ! Default value + modcam_maxirr = 1 ! Default value + if ( present( mod_method ) ) modcam_method = mod_method + if ( present( mod_geopk ) ) modcam_geopk = mod_geopk + if ( present( mod_gatscat ) ) modcam_gatscat = mod_gatscat + if ( present( mod_maxirr ) ) modcam_maxirr = mod_maxirr + + if (gid .eq. 0) then + write(iulog,*) 'MOD_COMM - modcam_method modcam_geopk modcam_gatscat modcam_maxirr = ', & + modcam_method, modcam_geopk, modcam_gatscat, modcam_maxirr + endif + +! +! End CAM optimizations +! + + MaxTrf = modcam_maxirr + max_irr = modcam_maxirr + + win_count = 0 +! +!************************************************************************* +! local_dynamic_storage is set to 1 when window storage is based on locally dimensioned +! arrays, 0 otherwise; this occurs when modcam_gatscat equals 1, as it is only the +! gather/scatters that require global storage. +!************************************************************************* +! + local_dynamic_storage = 0 + if (modcam_gatscat .eq. 1) local_dynamic_storage = 1 + +!************************************************************************* +! Override original strategy, as only single 2D lat-lon variables (rather +! than 3D with multiple tracers) are used for gather/scatters; +! set local_dynamic_storage to 1 always, and then allow for gather +! of 2D lat-lon variable in inidat. +!************************************************************************* + + local_dynamic_storage = 1 + + allocate( Stats(MAX(nbuf,numpro)*MAX(max_call,max_irr)*MPI_STATUS_SIZE) ) + allocate( InHandle(numpro,MaxTrf) ) + allocate( OutHandle(numpro,MaxTrf) ) + + idimsizz = idimsize + if (local_dynamic_storage .eq. 1) then + if (gid .eq. 0) write(iulog,*) 'Using local dynamic storage for mod_comm window' + else + if (gid .eq. 0) write(iulog,*) 'Using global dynamic storage for mod_comm window' + endif +! +! Dynamically allocate target global arrays +! +!************************************************************************* +! Compute additional storage due to ghost latitudes being included in some +! transposes. Allow 3 ghost points on each side. The required storage +! could be (6+L)/L times the original storage, where L is the number of +! latitude lines in the subdomain. Ghost points can also occur in the +! vertical due to edge quantities, but this would not occur simultaneously +! with ghost points in latitude; the extra storage due to vertical ghost +! points is not nearly as great as with latitude. +!************************************************************************* + using_window = 1 ! This is a local variable + if (modcam_method .eq. 1) using_window = 0 + one = real(1,r8) + ghostrat = one + if (using_window .eq. 1 .and. local_dynamic_storage .eq. 1) then + latitude_lines = real(PLAT,r8)/real(modcam_npryz(1),r8) + ghostrat = real(6+latitude_lines,r8)/real(latitude_lines,r8) + endif + if (gid .eq. 0) write(iulog,*) 'Mod_comm - ghostrat = ', ghostrat + +!************************************************************************* +! Compute extent to which required window storage for geopotential computation +! exceeds that of transpose - relevant only for local dynamic storage, +! since with global storage there will be enough space anyway; also, +! this applies only when using window; further, this applies only when +! the CAM variable geopktrans equals 1, though we do not test for that here. +! The geopotential calculation sends a latitude line to every other process +! either vertically above or below the given process; there can be +! at most modcam_npryz(2)-1 such target processes; compared to transposes +! (which send all vertical lines), the amount of data sent is expressed +! as the ratio geopkrat; our concern is making the window (whose size +! is computed based on transposes) large enough, so we must multiply its +! size by geopkrat; we never shrink the window, so geopkrat >= 1. +!************************************************************************* + using_window = 1 ! This is a local variable + if (modcam_geopk .eq. 1) using_window = 0 + one = real(1,r8) + geopkrat = one + if (using_window .eq. 1 .and. local_dynamic_storage .eq. 1) then + vertical_lines = ceiling(real(PLEV,r8)/real(modcam_npryz(2),r8)) + geopkrat = real(modcam_npryz(2)-1,r8)/real(vertical_lines,r8) + geopkrat = max(geopkrat,one) + endif + if (gid .eq. 0) write(iulog,*) 'Mod_comm - geopkrat = ', geopkrat + +!************************************************************************* +! beginning of CAM totvar computation +!************************************************************************* + +! CAM contains two kinds of transposes. The most commonly referred to transposes +! refer to those which connect the xy and yz decompositions. Depending on +! the physics decomposition, CAM might additionally compute transposes between +! the dynamics and physics; this depends on the variable phys_loadbalance. +! Furthermore, these transposes might or might not be computed using mod_comm. +! The former transposes are generally performed one variable at a time; the +! latter transposes combine all variables to be transposed, including the +! full complement of tracers. The maximum number of variables to be +! simultaneously subject to irregular communications is dependent on +! whether or not mod_comm is used to compute dynamics-physics transposes +! and could depend on the number of tracers. + +! Compute maximum number of variables to be simultaneously subject +! to irregular communications (e.g., transposed variables based on CAM) +! and store in the variable 'totvar'. + +! Tracmax is the number of tracers simultaneously transposed within dynamics; +! Tracbmax is the number of tracers simultaneously border comunicated within trac2d; +! both of these are currently hardwired to 1. + tracmax = 1 + tracbmax = 1 + totvar = tracmax + +! Now consider dynamics-physics transposes in CAM dp_coupling (dpvarmax) +! If phys_transpose_mod is still -1, that means it has not been updated +! by CAM and hence mod_comm will not be used for dynamics-physics transposes. +! (NOTE: phys_transpose_mod is computed in phys_grid_setopts in phys_grid.F90.) + +! Also note that the logic involving phys_transpose_mod and phys_transpose_modmin +! must remain consistent with the coding in phys_grid.F90. Additionally, +! phys_transpose_vars must remain consistent with the coding in dp_coupling.F90. +! (See above declaration and initialization for CAM-specific variables.) + +! (begin dpvarmax calculation) + + if (phys_transpose_mod .eq. -1) then + if (gid .eq. 0) write(iulog,*) & + '(MOD_COMM) - mod_comm not being used for dynamcis-physics transposes' + dpvarmax = 0 +! +! If phys_transpose_mod is >= phys_transpose_modmin, that is a signal that mod_comm is to be used +! for dynamics/physics transposes in CAM. In that case, one must allocate enough window +! storage for those transposes. Presently, the number of such simultaneously transposed +! variables equals phys_transpose_vars plus the number of constituents. +! + elseif (phys_transpose_mod .ge. phys_transpose_modmin) then + dpvarmax = phys_transpose_vars + max_trac + else + dpvarmax = 0 + endif + +! (end dpvarmax calculation) + +! totvar is the maximum of (1) the number of tracers to be simultaneously transposed +! within the dynamics, and (2) the number of variables to be transposed between +! dynamics and physics instantiations in CAM + + totvar = max(totvar, dpvarmax) + +!************************************************************************* +! end of CAM totvar computation +!************************************************************************* + + if (gid .eq. 0) write(iulog,*) 'Mod_comm - tracmax dpvarmax totvar tracbmax = ', & + tracmax, dpvarmax, totvar, tracbmax + + idimsizz = (idimsize/max_nq)*tracbmax + sizet1 = idimsizz*nbuf*max_call +! Adjust window sizes for geopotential and/or ghost points + sizer8 = PLON*platg*(PLEV+1)*totvar*max(geopkrat,ghostrat)*max_irr + sizer4 = PLON*platg*(PLEV+1)*totvar*max(geopkrat,ghostrat)*max_irr + sizei4 = PLON*PLAT*PLEV*max_irr + +! Compute local storage requirement for irregular communications by dividing +! global requirement by the number of tasks. Allow slack factor to account +! for nonuniformity of decomposition and ghost zones. Not valid for global +! operations such as gathers and scatters when local windows are used. + if (local_dynamic_storage .eq. 1) then + numpro_use = modcam_npryz(1) * modcam_npryz(2) + sizer8 = ceiling( alloc_slack_factor*real(sizer8,r8)/real(numpro_use,r8) ) + +! Allow for gather of single 2D lat-lon variable in inidat. + if (modcam_gatscat .eq. 0) sizer8 = max( sizer8, PLON*PLAT*max_irr ) + + sizer4 = ceiling( alloc_slack_factor*real(sizer4,r8)/real(numpro_use,r8) ) +! The only i4 irregular communications in CAM occur in io_dist. + sizei4 = 1 + endif + +# if defined ( NOR4 ) + sizer4 = 1 + if (gid .eq. 0) write(iulog,*) 'Mod_comm - r4 windows disabled' +# endif + + using_window = 1 ! This is a local variable + if (modcam_method .eq. 1 .and. modcam_geopk .eq. 1) using_window = 0 + if (using_window .eq. 0) then + if (gid .eq. 0) write(iulog,*) 'Mod_comm - r8 and r4 windows set to trivial size' + sizer8 = 1 + sizer4 = 1 + endif + +! Allocate global storage + + allocate( ga_t1_r(sizet1) ) + allocate( ga_t1_s(sizet1) ) + allocate( ga_r8_r(sizer8) ) + allocate( ga_r8_s(sizer8) ) + allocate( ga_r4_r(sizer4) ) + allocate( ga_r4_s(sizer4) ) + allocate( ga_i4_r(sizei4) ) + allocate( ga_i4_s(sizei4) ) + +! Initialize windows + + mysize = sizet1 + call win_init_r8(comm, t1_win, ga_t1_r, mysize) + if (gid .eq. 0) write(iulog,*) 'Mod_comm t1_win window size = ', mysize + + mysize = sizer8 + call win_init_r8(comm, r8_win, ga_r8_r, mysize) + if (gid .eq. 0) write(iulog,*) 'Mod_comm r8_win window size = ', mysize + + mysize = sizer4 + call win_init_r4(comm, r4_win, ga_r4_r, mysize) + if (gid .eq. 0) write(iulog,*) 'Mod_comm r4_win window size = ', mysize + + mysize = sizei4 + call win_init_i4(comm, i4_win, ga_i4_r, mysize) + if (gid .eq. 0) write(iulog,*) 'Mod_comm i4_win window size = ', mysize + + igosouth = 0 + igonorth = 1 + ifromsouth = 1 + ifromnorth = 0 + +!EOC + end subroutine mp_init +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_exit --- End SPMD parallel communication +! +! !INTERFACE: + subroutine mp_exit( comm ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !DESCRIPTION: +! +! End SPMD parallel communication +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Array code +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC + call MPI_FINALIZE (ierror) + return +!EOC + end subroutine mp_exit +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: omp_start --- Start openMP parallelism +! +! !INTERFACE: + subroutine omp_start +! !DESCRIPTION: +! +! Start openMP parallelism +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer ios, n, nowpro, nowcpu + +! Compute number of OpenMP threads + +#if defined(_OPENMP) + + integer omp_get_num_threads +!$omp parallel + numcpu = omp_get_num_threads() +!$omp end parallel + +#else + numcpu = 1 +#endif + +!EOC + end subroutine omp_start +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mpi_start --- Start MPI parallelism +! +! !INTERFACE: + subroutine mpi_start( comm ) +! !INPUT PARAMETERS: + integer :: comm ! communicator +! !DESCRIPTION: +! +! Start MPI parallelism +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! 02.08.06 Sawyer Added communicator input arguments +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + logical flag + integer npthreads + + call MPI_INITIALIZED( flag, ierror ) + if ( .not. flag ) then + call MPI_INIT( ierror ) + comm = MPI_COMM_WORLD + endif + + call MPI_COMM_RANK (comm, gid, ierror) + call MPI_COMM_SIZE (comm, numpro, ierror) + call MPI_COMM_DUP (comm, commglobal, ierror) +!EOC + end subroutine mpi_start +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: win_init_r8 --- Initialize real*8 communication window +! +! !INTERFACE: + subroutine win_init_r8(comm, win, ga, isize) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize + real(r8), intent(in) :: ga(isize) +! !OUTPUT PARAMETERS: + type (window), intent(inout) :: win +! !DESCRIPTION: +! +! Initialize real*8 communication window +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + + win_count = win_count + 1 + win%id = win_count + win%size = isize + win%ncall_s = 0 + win%ncall_r = 0 + win%nsend = 0 + win%nrecv = 0 + win%nread = 0 + allocate( win%sqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) + allocate( win%rqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) +!EOC + end subroutine win_init_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: win_init_r4 --- Initialize real*4 communication window +! +! !INTERFACE: + subroutine win_init_r4(comm, win, ga, isize) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize + real(r4), intent(in) :: ga(isize) +! !OUTPUT PARAMETERS: + type (window), intent(inout) :: win +! !DESCRIPTION: +! +! Initialize real*4 communication window +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + + win_count = win_count + 1 + win%id = win_count + win%size = isize + win%ncall_s = 0 + win%ncall_r = 0 + win%nsend = 0 + win%nrecv = 0 + win%nread = 0 + allocate( win%sqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) + allocate( win%rqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) +!EOC + end subroutine win_init_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: win_init_i4 --- Initialize integer*4 communication window +! +! !INTERFACE: + subroutine win_init_i4(comm, win, ga, isize) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize + integer(i4), intent(in) :: ga(isize) +! !OUTPUT PARAMETERS: + type (window), intent(inout) :: win +! !DESCRIPTION: +! +! Initialize integer*4 communication window +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + + win_count = win_count + 1 + win%id = win_count + win%size = isize + win%ncall_s = 0 + win%ncall_r = 0 + win%nsend = 0 + win%nrecv = 0 + win%nread = 0 + allocate( win%sqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) + allocate( win%rqest(MAX(nbuf,numpro)*MAX(max_call,max_irr)) ) +!EOC + end subroutine win_init_i4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_send4d_ns --- Send 4d north/south ghost latitudes (real*8) +! +! !INTERFACE: + subroutine mp_send4d_ns(comm, im, jm, km, nq, jfirst, jlast, kfirst, klast, & + ng_s, ng_n, q) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km, nq + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast + integer, intent(in):: ng_s ! southern zones to ghost + integer, intent(in):: ng_n ! northern zones to ghost + real(r8), intent(in):: q(im,jfirst-ng_s:jlast+ng_n,kfirst:klast,nq) +! +! !DESCRIPTION: +! +! Send 4d north/south ghost latitudes +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Arrays code +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: gidu + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Open(comm, t1_win) + +! Send to south + if ( jfirst > 1 ) then + t1_win%src = gidu - 1 + t1_win%offset_r = ifromsouth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + t1_win%size_r = im*ng_s*(klast-kfirst+1)*nq + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%dest = gidu - 1 + t1_win%offset_s = igosouth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8(comm, q, t1_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jfirst, jfirst+ng_n-1, kfirst, klast, 1, nq, & + ga_t1_s, ga_t1_r ) + endif +! Send to north + if ( jlast < jm ) then + t1_win%src = gidu + 1 + t1_win%offset_r = ifromnorth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + t1_win%size_r = im*ng_n*(klast-kfirst+1)*nq + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%dest = gidu + 1 + t1_win%offset_s = igonorth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8(comm, q, t1_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jlast-ng_s+1, jlast, kfirst, klast, 1, nq, & + ga_t1_s, ga_t1_r ) + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_send4d_ns +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recv4d_ns --- Receive 4d north/south ghost latitudes (real*8) +! +! !INTERFACE: + subroutine mp_recv4d_ns(comm, im, jm, km, nq, jfirst, jlast, kfirst, klast, & + ng_s, ng_n, q) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km, nq + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast + integer, intent(in):: ng_s ! southern zones to ghost + integer, intent(in):: ng_n ! northern zones to ghost +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: q(im,jfirst-ng_s:jlast+ng_n,kfirst:klast,nq) +! +! !DESCRIPTION: +! +! Receive 4d north/south ghost latitudes +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Arrays code +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: gidu + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Close(comm, t1_win) + +! Recv from south + if ( jfirst > 1 ) then + t1_win%src = gidu-1 + t1_win%offset_r = ifromsouth*idimsizz + (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8(comm, q, t1_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jfirst-ng_s, jfirst-1, kfirst, klast, 1, nq, & + ga_t1_r ) + endif +! Recv from north + if ( jlast < jm ) then + t1_win%src = gidu+1 + t1_win%offset_r = ifromnorth*idimsizz + (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8(comm, q, t1_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jlast+1, jlast+ng_n, kfirst, klast, 1, nq, & + ga_t1_r ) + endif + + call Win_Finalize(comm, t1_win) + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recv4d_ns +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_send4d_ns_r4 --- Send 4d north/south ghost latitudes (real*4) +! +! !INTERFACE: + subroutine mp_send4d_ns_r4(comm, im, jm, km, nq, jfirst, jlast, kfirst, klast, & + ng_s, ng_n, q) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km, nq + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast + integer, intent(in):: ng_s ! southern zones to ghost + integer, intent(in):: ng_n ! northern zones to ghost + real(r4), intent(in):: q(im,jfirst-ng_s:jlast+ng_n,kfirst:klast,nq) +! +! !DESCRIPTION: +! +! Send 4d north/south ghost latitudes +! +! !REVISION HISTORY: +! 2005.03.20 Sawyer Creation from mp_send4d_ns +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: gidu + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: mp_send4d_ns_r4 - r4 windows disabled - exiting' + stop +#endif + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Open(comm, r4_win) + +! Send to south + if ( jfirst > 1 ) then + r4_win%src = gidu - 1 + r4_win%offset_r = ifromsouth*idimsizz + (r4_win%ncall_s-1)*idimsizz*nbuf + r4_win%size_r = im*ng_s*(klast-kfirst+1)*nq + call Ga_RecvInit_r4(comm, r4_win, ga_r4_r) + r4_win%dest = gidu - 1 + r4_win%offset_s = igosouth*idimsizz + (r4_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r4(comm, q, r4_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jfirst, jfirst+ng_n-1, kfirst, klast, 1, nq, & + ga_r4_s, ga_r4_r ) + endif +! Send to north + if ( jlast < jm ) then + r4_win%src = gidu + 1 + r4_win%offset_r = ifromnorth*idimsizz + (r4_win%ncall_s-1)*idimsizz*nbuf + r4_win%size_r = im*ng_n*(klast-kfirst+1)*nq + call Ga_RecvInit_r4(comm, r4_win, ga_r4_r) + r4_win%dest = gidu + 1 + r4_win%offset_s = igonorth*idimsizz + (r4_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r4(comm, q, r4_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jlast-ng_s+1, jlast, kfirst, klast, 1, nq, & + ga_r4_s, ga_r4_r ) + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_send4d_ns_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recv4d_ns_r4 --- Receive 4d north/south ghost latitudes (real*4) +! +! !INTERFACE: + subroutine mp_recv4d_ns_r4(comm, im, jm, km, nq, jfirst, jlast, kfirst, klast, & + ng_s, ng_n, q) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km, nq + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast + integer, intent(in):: ng_s ! southern zones to ghost + integer, intent(in):: ng_n ! northern zones to ghost +! !OUTPUT PARAMETERS: + real(r4), intent(inout):: q(im,jfirst-ng_s:jlast+ng_n,kfirst:klast,nq) +! +! !DESCRIPTION: +! +! Receive 4d north/south ghost latitudes (real*4) +! +! !REVISION HISTORY: +! 2005.03.20 Sawyer Creation from mp_recv4d_ns +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: gidu + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: mp_recv4d_ns_r4 - r4 windows disabled - exiting' + stop +#endif + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Close(comm, r4_win) + +! Recv from south + if ( jfirst > 1 ) then + r4_win%src = gidu-1 + r4_win%offset_r = ifromsouth*idimsizz + (r4_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r4(comm, q, r4_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jfirst-ng_s, jfirst-1, kfirst, klast, 1, nq, & + ga_r4_r ) + endif +! Recv from north + if ( jlast < jm ) then + r4_win%src = gidu+1 + r4_win%offset_r = ifromnorth*idimsizz + (r4_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r4(comm, q, r4_win, im, jm, km, nq, & + 1, im, jfirst-ng_s, jlast+ng_n, kfirst, klast, 1, nq, & + 1, im, jlast+1, jlast+ng_n, kfirst, klast, 1, nq, & + ga_r4_r ) + endif + + call Win_Finalize(comm, r4_win) + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recv4d_ns_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_send2_ns --- Send 2 variables north/south ghost latitudes +! +! !INTERFACE: + subroutine mp_send2_ns(comm, im, jm, km, jfirst, jlast, kfirst, klast, & + nd, q1, q2) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast !careful: klast might be klast+1 + integer, intent(in):: nd + real(r8), intent(in):: q1(im,jfirst-nd:jlast+nd,kfirst:klast) + real(r8), intent(in):: q2(im,jfirst-nd:jlast+nd,kfirst:klast) +! +! !DESCRIPTION: +! +! Send 2 variables north/south ghost latitudes +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Arrays code +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: gidu + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Open(comm, t1_win) + +! Send to south + if ( jfirst > 1 ) then + t1_win%src = gidu - 1 + t1_win%size_r = im*(klast-kfirst+1) + t1_win%offset_r = ifromsouth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%offset_r = t1_win%offset_r + im*(klast-kfirst+1) + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%dest = gidu - 1 + t1_win%offset_s = igosouth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8( comm, q1, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 1, 1, & + 1, im, jfirst, jfirst, kfirst, klast, 1, 1, & + ga_t1_s, ga_t1_r ) + t1_win%offset_s = t1_win%offset_s + im*(klast-kfirst+1) + call Ga_Put4d_r8( comm, q2, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 2, 2, & + 1, im, jfirst, jfirst, kfirst, klast, 2, 2, & + ga_t1_s, ga_t1_r ) + endif +! Send to north + if ( jlast < jm ) then + t1_win%src = gidu + 1 + t1_win%size_r = im*(klast-kfirst+1) + t1_win%offset_r = ifromnorth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%offset_r = t1_win%offset_r + im*(klast-kfirst+1) + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%dest = gidu + 1 + t1_win%offset_s = igonorth*idimsizz + (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8( comm, q1, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 1, 1, & + 1, im, jlast, jlast, kfirst, klast, 1, 1, & + ga_t1_s, ga_t1_r ) + t1_win%offset_s = t1_win%offset_s + im*(klast-kfirst+1) + call Ga_Put4d_r8( comm, q2, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 2, 2, & + 1, im, jlast, jlast, kfirst, klast, 2, 2, & + ga_t1_s, ga_t1_r ) + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_send2_ns +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recv2_ns --- Receive 2 variables north/south ghost latitudes +! +! !INTERFACE: + subroutine mp_recv2_ns(comm, im, jm, km, jfirst, jlast, kfirst, klast, & + nd, q1, q2) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: im, jm, km + integer, intent(in):: jfirst, jlast + integer, intent(in):: kfirst, klast !careful: klast might be klast+1 + integer, intent(in):: nd +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: q1(im,jfirst-nd:jlast+nd,kfirst:klast) + real(r8), intent(inout):: q2(im,jfirst-nd:jlast+nd,kfirst:klast) +! +! !DESCRIPTION: +! +! Receive 2 variables north/south ghost latitudes +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.02.15 Putman Modified for Global Arrays code +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + integer j + integer :: gidu + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_RANK (comm, gidu, ierror) + + call Win_Close(comm, t1_win) + +! Recv from south + if ( jfirst > 1 ) then + j = jfirst - 1 + t1_win%src = gidu - 1 + t1_win%offset_r = ifromsouth*idimsizz + (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8( comm, q1, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 1, 1, & + 1, im, j, j, kfirst, klast, 1, 1, & + ga_t1_r ) + t1_win%offset_r = t1_win%offset_r + im*(klast-kfirst+1) + call Ga_Get4d_r8( comm, q2, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 2, 2, & + 1, im, j, j, kfirst, klast, 2, 2, & + ga_t1_r ) + endif +! Recv from north + if ( jlast < jm ) then + j = jlast + 1 + t1_win%src = gidu + 1 + t1_win%offset_r = ifromnorth*idimsizz + (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8( comm, q1, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 1, 1, & + 1, im, j, j, kfirst, klast, 1, 1, & + ga_t1_r ) + t1_win%offset_r = t1_win%offset_r + im*(klast-kfirst+1) + call Ga_Get4d_r8( comm, q2, t1_win, im, jm, km, 2, & + 1, im, jfirst-nd, jlast+nd, kfirst, klast, 2, 2, & + 1, im, j, j, kfirst, klast, 2, 2, & + ga_t1_r ) + endif + + call Win_Finalize(comm, t1_win) + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recv2_ns +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_send3d --- Send ghost region +! +! !INTERFACE: + subroutine mp_send3d(comm, dest, src, im, jm, km, if, il, jf, jl, kf, kl, & + i1, i2, j1, j2, k1, k2, q) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: dest, src + integer, intent(in):: im, jm, km + integer, intent(in):: if, il, jf, jl, kf, kl + integer, intent(in):: i1, i2, j1, j2, k1, k2 + real(r8), intent(in):: q(if:il, jf:jl, kf:kl) +! +! !DESCRIPTION: +! +! Send a general 3d real*8 ghost region +! +! !REVISION HISTORY: +! 02.04.15 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, numcomm, ierror) + + call Win_Open(comm, t1_win) + +! Init Recv src + if ( src >= 0 .and. src < numcomm ) then ! is PE in valid range? + t1_win%src = src + t1_win%size_r = (i2-i1+1)*(j2-j1+1)*(k2-k1+1) ! chunk size + t1_win%offset_r = (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + endif +! Send ghost region + if ( dest >= 0 .and. dest < numcomm ) then + t1_win%dest = dest + t1_win%offset_s = (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8( comm, q, t1_win, im, jm, km, 1, & + if, il, jf, jl, kf, kl, 1, 1, & + i1, i2, j1, j2, k1, k2, 1, 1, ga_t1_s, ga_t1_r ) + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_send3d +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recv3d --- Recv ghost region +! +! !INTERFACE: + subroutine mp_recv3d(comm, src, im, jm, km, if, il, jf, jl, kf, kl, & + i1, i2, j1, j2, k1, k2, qout) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: src + integer, intent(in):: im, jm, km + integer, intent(in):: if, il, jf, jl, kf, kl + integer, intent(in):: i1, i2, j1, j2, k1, k2 +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: qout(if:il, jf:jl, kf:kl) +! +! !DESCRIPTION: +! +! Recv a general 3d real*8 ghost region +! +! !REVISION HISTORY: +! 02.04.15 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, numcomm, ierror) + + call Win_Close(comm, t1_win) + +! Recv from src + if ( src >= 0 .and. src < numcomm ) then ! is PE in valid range? + t1_win%src = src + t1_win%offset_r = (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8( comm, qout, t1_win, im, jm, km, 1, & + if, il, jf, jl, kf, kl, 1, 1, & + i1, i2, j1, j2, k1, k2, 1, 1, ga_t1_r ) + endif + + call Win_Finalize(comm, t1_win) + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recv3d +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_send3d_2 --- Send 2 ghost regions +! +! !INTERFACE: + subroutine mp_send3d_2(comm, dest, src, im, jm, km, if, il, jf, jl, kf, kl, & + i1, i2, j1, j2, k1, k2, q1, q2) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: dest, src + integer, intent(in):: im, jm, km + integer, intent(in):: if, il, jf, jl, kf, kl + integer, intent(in):: i1, i2, j1, j2, k1, k2 + real(r8), intent(in):: q1(if:il, jf:jl, kf:kl) + real(r8), intent(in):: q2(if:il, jf:jl, kf:kl) +! +! !DESCRIPTION: +! +! Send two general 3d real*8 ghost region +! +! !REVISION HISTORY: +! 02.04.15 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, numcomm, ierror) + + call Win_Open(comm, t1_win) + +! Init Recv src + if ( src >= 0 .and. src < numcomm ) then ! is PE in valid range? + t1_win%src = src + t1_win%size_r = (i2-i1+1)*(j2-j1+1)*(k2-k1+1) ! chunk size + t1_win%offset_r = (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + t1_win%offset_r = t1_win%offset_r + t1_win%size_r + call Ga_RecvInit_r8(comm, t1_win, ga_t1_r) + endif +! Send ghost region + if ( dest >= 0 .and. dest < numcomm ) then + t1_win%dest = dest + t1_win%offset_s = (t1_win%ncall_s-1)*idimsizz*nbuf + call Ga_Put4d_r8( comm, q1, t1_win, im, jm, km, 2, & + if, il, jf, jl, kf, kl, 1, 1, & + i1, i2, j1, j2, k1, k2, 1, 1, ga_t1_s, ga_t1_r ) + t1_win%offset_s = t1_win%offset_s + (i2-i1+1)*(j2-j1+1)*(k2-k1+1) + call Ga_Put4d_r8( comm, q2, t1_win, im, jm, km, 2, & + if, il, jf, jl, kf, kl, 2, 2, & + i1, i2, j1, j2, k1, k2, 2, 2, ga_t1_s, ga_t1_r ) + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_send3d_2 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recv3d_2 --- Recv 2 ghost regions +! +! !INTERFACE: + subroutine mp_recv3d_2(comm, src, im, jm, km, if, il, jf, jl, kf, kl, & + i1, i2, j1, j2, k1, k2, qout1, qout2) +! +! !INPUT PARAMETERS: + integer, intent(in):: comm ! communicator + integer, intent(in):: src + integer, intent(in):: im, jm, km + integer, intent(in):: if, il, jf, jl, kf, kl + integer, intent(in):: i1, i2, j1, j2, k1, k2 +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: qout1(if:il, jf:jl, kf:kl) + real(r8), intent(inout):: qout2(if:il, jf:jl, kf:kl) +! +! !DESCRIPTION: +! +! Recv two general 3d real*8 ghost regions +! +! !REVISION HISTORY: +! 02.04.15 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, numcomm, ierror) + + call Win_Close(comm, t1_win) + +! Recv from src + if ( src >= 0 .and. src < numcomm ) then ! is PE in valid range? + t1_win%src = src + t1_win%offset_r = (t1_win%ncall_r-1)*idimsizz*nbuf + call Ga_Get4d_r8( comm, qout1, t1_win, im, jm, km, 2, & + if, il, jf, jl, kf, kl, 1, 1, & + i1, i2, j1, j2, k1, k2, 1, 1, ga_t1_r ) + t1_win%offset_r = t1_win%offset_r + (i2-i1+1)*(j2-j1+1)*(k2-k1+1) + call Ga_Get4d_r8( comm, qout2, t1_win, im, jm, km, 2, & + if, il, jf, jl, kf, kl, 2, 2, & + i1, i2, j1, j2, k1, k2, 2, 2, ga_t1_r ) + endif + + call Win_Finalize(comm, t1_win) + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recv3d_2 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_barrier --- Synchronize all SPMD processes +! +! !INTERFACE: + subroutine mp_barrier (comm) +! +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !DESCRIPTION: +! +! Synchronize all SPMD processes +! +! !REVISION HISTORY: +! 2001.09.01 Lin +! 2002.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC + + call MPI_BARRIER(comm, ierror) + +!EOC + end subroutine mp_barrier +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Win_Open --- Open a communication window +! +! !INTERFACE: + subroutine Win_Open(comm, win) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !OUTPUT PARAMETERS: + type(window), intent(inout):: win +! +! !DESCRIPTION: +! +! Begin a communication epoch, by opening a comm window. +! Update number of send calls on the window (win%ncall_s). +! Barrier synchronzize if necessary. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC + + win%ncall_s = win%ncall_s + 1 + +!EOC + end subroutine Win_Open +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Win_Close --- Close a communication window +! +! !INTERFACE: + subroutine Win_Close(comm, win) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !OUTPUT PARAMETERS: + type(window), intent(inout):: win +! +! !DESCRIPTION: +! +! End a communication epoch, by closing a comm window. +! Update number of receive calls on the window (win%ncall_r). +! Barrier synchronzize if necessary. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC + + win%ncall_r = win%ncall_r + 1 + +!EOC + end subroutine Win_Close +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Win_Finalize --- Reset a communication window after a comm epoch. +! +! !INTERFACE: + subroutine Win_Finalize(comm, win) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !OUTPUT PARAMETERS: + type(window), intent(inout):: win +! +! !DESCRIPTION: +! +! Complete a communication epoch and reset a comm window. +! Barrier synchronzize if necessary. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC + + if (win%ncall_s == win%ncall_r) then + call MPI_WAITALL(win%nsend, win%sqest, Stats, ierror) + win%nsend = 0 + win%nrecv = 0 + win%nread = 0 + win%ncall_s = 0 + win%ncall_r = 0 + endif + +!EOC + end subroutine Win_Finalize +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Put4d_r8 --- Write to real*8 4d global array +! +! !INTERFACE: + subroutine Ga_Put4d_r8 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga_s, ga_r ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + real(r8), intent(in) :: q(ifrom:ito,jfrom:jto,kfrom:kto,nqfrom:nqto) + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: ga_s(win%size) + real(r8), intent(inout):: ga_r(win%size) +! +! !DESCRIPTION: +! +! Write to real*8 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + + integer send_tag, qsize + integer :: gidu + + call MPI_COMM_RANK (comm, gidu, ierror) + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + +! Begin Non-Blocking Sends + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_s) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + ga_s(inc+i) = q(i,j,k,iq) + enddo + enddo + enddo + enddo + + qsize = (i2-i1+1)*(j2-j1+1)*(k2-k1+1)*(nq2-nq1+1) + send_tag = gidu + win%nsend = win%nsend + 1 + call MPI_ISEND(ga_s(win%offset_s+1), qsize, mp_r8, win%dest, & + send_tag, comm, win%sqest(win%nsend), ierror) + +!EOC + end subroutine Ga_Put4d_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_RecvInit_r8 --- Initiate real*8 Non-Blocking receive +! +! !INTERFACE: + subroutine Ga_RecvInit_r8( comm, win, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window +! !OUTPUT PARAMETERS: + real(r8), intent(inout):: ga(win%size) +! +! !DESCRIPTION: +! +! Initiate real*8 Non-Blocking receive +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! 03.06.06 Sawyer Added else clause +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer qsize, recv_tag + + if (win%size >= win%offset_r + win%size_r) then + recv_tag = win%src + qsize = win%size_r + win%nrecv = win%nrecv + 1 + call MPI_IRECV(ga(win%offset_r+1), qsize, mp_r8, win%src, & + recv_tag, comm, win%rqest(win%nrecv), ierror) + else + write(iulog,*) "Fatal ga_recvinit_r8: receive window out of space - exiting" + write(iulog,*) 'gid win%size win%offset_r win%size_r = ', gid, & + win%size, win%offset_r, win%size_r + stop + endif + +!EOC + end subroutine Ga_RecvInit_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Get4d_r8 --- Read from real*8 4d global array +! +! !INTERFACE: + subroutine Ga_Get4d_r8 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + real(r8), intent(in) :: ga(win%size) +! !OUTPUT PARAMETERS: + real(r8), intent(inout) :: q(ifrom:ito, jfrom:jto, kfrom:kto, nqfrom:nqto) +! +! !DESCRIPTION: +! +! Read from real*8 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + win%nread = win%nread + 1 + call MPI_WAIT(win%rqest(win%nread), Status, ierror) + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_r) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + q(i,j,k,iq) = ga(inc+i) + enddo + enddo + enddo + enddo + +!EOC + end subroutine Ga_Get4d_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Put4d_r4 --- Write to real*4 4d global array +! +! !INTERFACE: + subroutine Ga_Put4d_r4 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga_s, ga_r ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + real(r4), intent(in) :: q(ifrom:ito,jfrom:jto,kfrom:kto,nqfrom:nqto) + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 +! !OUTPUT PARAMETERS: + real(r4), intent(inout):: ga_s(win%size) + real(r4), intent(inout):: ga_r(win%size) +! +! !DESCRIPTION: +! +! Write to real*4 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + + integer send_tag, qsize + integer :: gidu + + call MPI_COMM_RANK (comm, gidu, ierror) + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: Ga_Put4d_r4 - r4 windows disabled - exiting' + stop +#endif + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + +! Begin Non-Blocking Sends + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_s) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + ga_s(inc+i) = q(i,j,k,iq) + enddo + enddo + enddo + enddo + + qsize = (i2-i1+1)*(j2-j1+1)*(k2-k1+1)*(nq2-nq1+1) + send_tag = gidu + win%nsend = win%nsend + 1 + call MPI_ISEND(ga_s(win%offset_s+1), qsize, mp_r4, win%dest, & + send_tag, comm, win%sqest(win%nsend), ierror) + +!EOC + end subroutine Ga_Put4d_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_RecvInit_r4 --- Initiate real*4 Non-Blocking receive +! +! !INTERFACE: + subroutine Ga_RecvInit_r4( comm, win, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window +! !OUTPUT PARAMETERS: + real(r4), intent(inout):: ga(win%size) +! +! !DESCRIPTION: +! +! Initiate real*8 Non-Blocking receive +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! 03.06.06 Sawyer Added else clause +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer qsize, recv_tag + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: Ga_RecvInit_r4 - r4 windows disabled - exiting' + stop +#endif + + if (win%size >= win%offset_r + win%size_r) then + recv_tag = win%src + qsize = win%size_r + win%nrecv = win%nrecv + 1 + call MPI_IRECV(ga(win%offset_r+1), qsize, mp_r4, win%src, & + recv_tag, comm, win%rqest(win%nrecv), ierror) + else + write(iulog,*) "Fatal ga_recvinit_r4: receive window out of space - exiting" + write(iulog,*) 'gid win%size win%offset_r win%size_r = ', gid, & + win%size, win%offset_r, win%size_r + stop + endif + +!EOC + end subroutine Ga_RecvInit_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Get4d_r4 --- Read from real*4 4d global array +! +! !INTERFACE: + subroutine Ga_Get4d_r4 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + real(r4), intent(in) :: ga(win%size) +! !OUTPUT PARAMETERS: + real(r4), intent(inout) :: q(ifrom:ito, jfrom:jto, kfrom:kto, nqfrom:nqto) +! +! !DESCRIPTION: +! +! Read from real*8 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: Ga_Get4d_r4 - r4 windows disabled - exiting' + stop +#endif + + win%nread = win%nread + 1 + call MPI_WAIT(win%rqest(win%nread), Status, ierror) + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_r) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + q(i,j,k,iq) = ga(inc+i) + enddo + enddo + enddo + enddo + +!EOC + end subroutine Ga_Get4d_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Put4d_i4 --- Write to integer*4 4d global array +! +! !INTERFACE: + subroutine Ga_Put4d_i4 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga_s, ga_r ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + integer(i4), intent(in) :: q(ifrom:ito,jfrom:jto,kfrom:kto,nqfrom:nqto) + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 +! !OUTPUT PARAMETERS: + integer(i4), intent(inout):: ga_s(win%size) + integer(i4), intent(inout):: ga_r(win%size) +! +! !DESCRIPTION: +! +! Write to integer*4 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + + integer send_tag, qsize + integer :: gidu + + call MPI_COMM_RANK (comm, gidu, ierror) + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + +! Begin Non-Blocking Sends + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_s) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + ga_s(inc+i) = q(i,j,k,iq) + enddo + enddo + enddo + enddo + + qsize = (i2-i1+1)*(j2-j1+1)*(k2-k1+1)*(nq2-nq1+1) + send_tag = gidu + win%nsend = win%nsend + 1 + call MPI_ISEND(ga_s(win%offset_s+1), qsize, mp_i4, win%dest, & + send_tag, comm, win%sqest(win%nsend), ierror) + +!EOC + end subroutine Ga_Put4d_i4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_RecvInit_i4 --- Initiate integer*4 Non-Blocking receive +! +! !INTERFACE: + subroutine Ga_RecvInit_i4( comm, win, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window +! !OUTPUT PARAMETERS: + integer(i4), intent(inout):: ga(win%size) +! +! !DESCRIPTION: +! +! Initiate integer*4 Non-Blocking receive +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! 06.05.21 Mirin Added else clause +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer qsize, recv_tag + + if (win%size >= win%offset_r + win%size_r) then + recv_tag = win%src + qsize = win%size_r + win%nrecv = win%nrecv + 1 + call MPI_IRECV(ga(win%offset_r+1), qsize, mp_i4, win%src, & + recv_tag, comm, win%rqest(win%nrecv), ierror) + else + write(iulog,*) "Fatal ga_recvinit_i4: receive window out of space - exiting" + write(iulog,*) 'gid win%size win%offset_r win%size_r = ', gid, & + win%size, win%offset_r, win%size_r + stop + endif +!EOC + end subroutine Ga_RecvInit_i4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Get4d_i4 --- Read from integer*4 4d global array +! +! !INTERFACE: + subroutine Ga_Get4d_i4 ( comm, q, win, im, jm, km, nq, & + ifrom, ito, jfrom, jto, kfrom, kto, & + nqfrom, nqto, i1, i2, j1, j2, k1, k2, & + nq1, nq2, ga ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(window), intent(inout) :: win ! Global Array Window + integer, intent(in) :: im, jm, km, nq + integer, intent(in) :: i1, i2, j1, j2, k1, k2, nq1, nq2 + integer, intent(in) :: ifrom, ito, jfrom, jto, kfrom, kto, nqfrom, nqto + integer(i4), intent(in) :: ga(win%size) +! !OUTPUT PARAMETERS: + integer(i4), intent(inout) :: q(ifrom:ito, jfrom:jto, kfrom:kto, nqfrom:nqto) +! +! !DESCRIPTION: +! +! Read from integer*4 4d global array. +! +! !REVISION HISTORY: +! 02.02.15 Putman +! 02.04.09 Putman Added ProTeX documentation +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer i, j, k, iq, inc, inc1 + integer i_length, j_length, k_length, ij_length, ijk_length + + win%nread = win%nread + 1 + call MPI_WAIT(win%rqest(win%nread), Status, ierror) + + i_length = i2-i1+1 + j_length = j2-j1+1 + k_length = k2-k1+1 + ij_length = i_length*j_length + ijk_length = i_length*j_length*k_length + + do iq = nq1, nq2 +!$omp parallel do private(i,j,k,inc,inc1) + do k = k1, k2 + inc1 = (win%offset_r) + ((iq-nq1)*ijk_length) & + + ((k-k1)*ij_length) -i1+1 + do j = j1, j2 + inc = inc1 + (j-j1)*i_length + do i = i1, i2 + q(i,j,k,iq) = ga(inc+i) + enddo + enddo + enddo + enddo + +!EOC + end subroutine Ga_Get4d_i4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Broadcast_r8 --- Broadcast an real*8 1d global array +! +! !INTERFACE: + subroutine Ga_Broadcast_r8 ( comm, q, isize ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize +! !OUTPUT PARAMETERS: + real(r8), intent(inout) :: q(isize) +! +! !DESCRIPTION: +! +! Broadcast an real*8 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + + call MPI_BCAST(q, isize, mp_r8, 0, comm, ierror) + +!EOC + end subroutine Ga_Broadcast_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Broadcast_r4 --- Broadcast an real*4 1d global array +! +! !INTERFACE: + subroutine Ga_Broadcast_r4 ( comm, q, isize ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize +! !OUTPUT PARAMETERS: + real(r4), intent(inout) :: q(isize) +! +! !DESCRIPTION: +! +! Broadcast an real*4 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: Ga_Broadcast_r4 - r4 windows disabled - exiting' + stop +#endif + + call MPI_BCAST(q, isize, mp_r4, 0, comm, ierror) + +!EOC + end subroutine Ga_Broadcast_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_Broadcast_i4 --- Broadcast an integer*4 1d global array +! +! !INTERFACE: + subroutine Ga_Broadcast_i4 ( comm, q, isize ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: isize +! !OUTPUT PARAMETERS: + integer(i4), intent(inout) :: q(isize) +! +! !DESCRIPTION: +! +! Broadcast an integer*4 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + + call MPI_BCAST(q, isize, mp_i4, 0, comm, ierror) + +!EOC + end subroutine Ga_Broadcast_i4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_AllToAll_r8 --- All to All of an real*8 1d global array +! +! !INTERFACE: + subroutine Ga_AllToAll_r8 ( comm, q, Gsize, Lsize, istart ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: Gsize ! Global size of array + integer, intent(in) :: Lsize ! size of Local portion + integer, intent(in) :: istart ! starting point +! !OUTPUT PARAMETERS: + real(r8), intent(inout) :: q(Gsize) +! +! !DESCRIPTION: +! +! All to All of a real*8 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + + call MPI_ALLGATHER(q(istart), Lsize, mp_r8, q, Lsize, mp_r8, comm, ierror) + +!EOC + end subroutine Ga_AllToAll_r8 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_AllToAll_r4 --- All to All of an real*4 1d global array +! +! !INTERFACE: + subroutine Ga_AllToAll_r4 ( comm, q, Gsize, Lsize, istart ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: Gsize ! Global size of array + integer, intent(in) :: Lsize ! size of Local portion + integer, intent(in) :: istart ! starting point +! !OUTPUT PARAMETERS: + real(r4), intent(inout) :: q(Gsize) +! +! !DESCRIPTION: +! +! All to All of an real*4 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + +#if defined ( NOR4 ) + write(iulog,*) 'Mod_comm: Ga_AllToAll_r4 - r4 windows disabled - exiting' + stop +#endif + + call MPI_ALLGATHER(q(istart), Lsize, mp_r4, q, Lsize, mp_r4, comm, ierror) + +!EOC + end subroutine Ga_AllToAll_r4 +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: Ga_AllToAll_i4 --- All to All of an integer*4 1d global array +! +! !INTERFACE: + subroutine Ga_AllToAll_i4 ( comm, q, Gsize, Lsize, istart ) +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + integer, intent(in) :: Gsize ! Global size of array + integer, intent(in) :: Lsize ! size of Local portion + integer, intent(in) :: istart ! starting point +! !OUTPUT PARAMETERS: + integer(i4), intent(inout) :: q(Gsize) +! +! !DESCRIPTION: +! +! All to All of an integer*4 1d global array. +! +! !REVISION HISTORY: +! 03.04.02 Putman +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! !LOCAL VARIABLES: + + call MPI_ALLGATHER(q(istart), Lsize, mp_i4, q, Lsize, mp_i4, comm, ierror) + +!EOC + end subroutine Ga_AllToAll_i4 +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: get_partneroffset --- Computes partneroffset/type from descriptor +! +! !INTERFACE: + subroutine get_partneroffset ( comm, send_bl, recv_bl ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator +! !INPUT/OUTPUT PARAMETERS: + type(blockdescriptor), intent(inout) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(inout) :: recv_bl(:) ! receive blocks + +! +! !DESCRIPTION: +! Compute partneroffsets/types from other blockdescriptor +! information. Used exclusively for irregular communication +! in PILGRIM. +! +! !REVISION HISTORY: +! 03.10.31 Mirin Creation +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + + integer :: i, j, k, ns, pos, por, numpsq, ierror + integer :: ami(numpro,numpro), am(numpro,numpro) + integer mod_method, num_s, num_r + + num_s = size(send_bl) + num_r = size(recv_bl) + + do j = 1, num_s + send_bl(j)%partneroffset = 0 + send_bl(j)%partnertype = MPI_DATATYPE_NULL + enddo + do j = 1, num_r + recv_bl(j)%partneroffset = 0 + recv_bl(j)%partnertype = MPI_DATATYPE_NULL + enddo + + end subroutine get_partneroffset +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_sendirr --- Initiate communication of contiguous parcels +! +! !INTERFACE: + subroutine mp_sendirr ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + real(r8), intent(in) :: q1in(*) ! input array + real(r8), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: q1out(*) ! output array + real(r8), optional, intent(out) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications here and placing +! wait points in mp_recvirr; if 1, call swap routine with p2p messages; if 2, call swap +! routine with a2a messages. +! Modc(2): if 1, then apply handshaking (don't send until corresponding receive is posted) +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! Modc(4): maximum number of outstanding requests (applies to swap routines only) +! +! !REVISION HISTORY: +! 02.08.13 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Use partneroffset +! 03.06.24 Sawyer Integrated Use_Mpi_Types; added qout +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer ipe, qsize, offset, blocksize, nparcels, offset_s, offset_r, ierr, mod_method + integer p, mysize, nthpc, minsize, nthrd, pn, pt, tmpsize, unitsize, offset_0 + integer i, j, send_tag, recv_tag, num_s, num_r + integer :: offset_v (Max_Nparcels) + integer :: hs_snd, hs_rcv(numpro), hs_rcvids(numpro) + integer ipe2, ceil2num + integer onetwo + logical twovar + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_pid + + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swapirr unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + + onetwo = 1 + twovar = .false. + if (present(q2in)) then + onetwo = 2 + twovar = .true. + endif + + if (sw_local .gt. 0) then + sw_alltoall = (sw_local .eq. 2) + if (present(q2in)) then + call mp_swapirr(comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + else + call mp_swapirr(comm, send_bl, recv_bl, q1in, q1out, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + endif + else + + call MPI_COMM_RANK (comm, comm_pid, ierr) + + hs_snd = 1 + ceil2num = ceil2(numpro) + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_s = r8_win%ncall_s + 1 + if (mod_method .gt. 0) then +! +! mpi derived types + if (r8_win%ncall_s .gt. MaxTrf-onetwo+1) then + write(iulog,*) "mp_sendirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_s MaxTrf = ", r8_win%ncall_s, MaxTrf + stop + endif +! +! MPI: Irecv over all processes +! + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + if (ipe-1 /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, ipe-1, comm_pid, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + OutHandle(:,r8_win%ncall_s) = MPI_REQUEST_NULL + if (twovar) OutHandle(:,r8_win%ncall_s+1) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle +! +! Receive the buffers with MPI_Irecv. Non-blocking +! + if ( recv_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + recv_tag = ipe-1 + modcam_tagoffset + call mpi_irecv( q1out, 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,r8_win%ncall_s), ierr ) + if (twovar) then + call mpi_irecv( q2out, 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,r8_win%ncall_s+1), ierr ) + endif + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, ipe-1, ipe-1, comm, ierr ) + endif + endif + enddo + +! +! MPI: Isend/Send over all processes; use risend/rsend with hs +! + InHandle(:,r8_win%ncall_s) = MPI_REQUEST_NULL + if (twovar) InHandle(:,r8_win%ncall_s+1) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + +! +! Send the individual buffers with non-blocking sends +! + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + send_tag = comm_pid + modcam_tagoffset + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call mpi_rsend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_irsend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + endif + if (twovar) then + if (send_local) then + call mpi_rsend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_irsend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s+1), ierr ) + endif + endif + else + if (send_local) then + call mpi_send( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_isend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + endif + if (twovar) then + if (send_local) then + call mpi_send( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_isend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s+1), ierr ) + endif + endif + endif + endif + enddo + else + +! temporary contiguous buffers + + if (r8_win%ncall_s .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_sendirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! issue call to receive data in global receive buffer + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + offset_r = offset_0 + + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = onetwo*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + send_tag = comm_pid + modcam_tagoffset + if (r8_win%dest /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, r8_win%dest, send_tag, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = onetwo*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + r8_win%src = ipe-1 + if (onetwo*unitsize >= offset_r-offset_0) then + recv_tag = r8_win%src + modcam_tagoffset + qsize = r8_win%size_r + r8_win%nrecv = r8_win%nrecv + 1 + call MPI_IRECV(ga_r8_r(r8_win%offset_r+1), qsize, mp_r8, r8_win%src, & + recv_tag, comm, r8_win%rqest(r8_win%nrecv), ierror) + if (hs_local) then + if (r8_win%src /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, r8_win%src, recv_tag, comm, ierror) + endif + else + write(iulog,*) "Fatal mp_sendirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo + +! gather data into global send buffer + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = onetwo*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + r8_win%offset_s = offset_s + offset_s = offset_s + qsize + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_sendirr: send window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + offset_v(1) = r8_win%offset_s + do j = 2, send_bl(ipe)%nparcels + offset_v(j) = offset_v(j-1) + send_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, send_bl(ipe)%nparcels + do i = 1, send_bl(ipe)%blocksizes(j) + ga_r8_s(offset_v(j)+i) = q1in(send_bl(ipe)%displacements(j)+i) + enddo + enddo + if (twovar) then + do j = 1, send_bl(ipe)%nparcels + do i = 1, send_bl(ipe)%blocksizes(j) + ga_r8_s(send_bl(ipe)%Tot_Size+offset_v(j)+i) = q2in(send_bl(ipe)%displacements(j)+i) + enddo + enddo + endif + +! nonblocking send + send_tag = comm_pid + modcam_tagoffset + r8_win%nsend = r8_win%nsend + 1 + if (hs_local) then + if (r8_win%dest /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call MPI_RSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_IRSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + else + if (send_local) then + call MPI_SEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_ISEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + endif + endif + enddo + + endif ! mod_method + + if (twovar) r8_win%ncall_s = r8_win%ncall_s + 1 + + endif ! sw_local + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + + end subroutine mp_sendirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recvirr --- Finalize communication of contiguous parcels +! +! !INTERFACE: + subroutine mp_recvirr ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + real(r8), intent(in) :: q1in(*) ! input array + real(r8), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests +! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout) :: q1out(*) ! output array + real(r8), optional, intent(inout) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Complete transfer of a generalized region initiated by {\tt mp\_sendirr}. +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications in mp_sendirr and +! placing wait points here; otherwise don't do anything - mp_swapirr is called from mp_sendirr. +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! +! !REVISION HISTORY: +! 02.08.15 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Now using packed arrays for MPI2 +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! +!EOP +!------------------------------------------------------------------------------ +!BOC + integer :: ipe, blocksize, offset_r, mod_method + integer unitsize, offset_0 + integer Ierr + integer InStats(numpro*MPI_STATUS_SIZE) + integer OutStats(numpro*MPI_STATUS_SIZE) + integer i, j, num_r, num_s + integer :: offset_v (Max_Nparcels) + integer ipe2, ceil2num + integer onetwo + logical twovar + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_size, comm_pid + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swapirr (hence return) unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + +! Return if swap_irr + if (sw_local .gt. 0) return + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + onetwo = 1 + twovar = .false. + if (present(q2in)) then + onetwo = 2 + twovar = .true. + endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + + ceil2num = ceil2(numpro) + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_r = r8_win%ncall_r + 1 + + if (mod_method .gt. 0) then + +! mpi derived types + if (r8_win%ncall_r .gt. MaxTrf-onetwo+1) then + write(iulog,*) "mp_recvirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_r MaxTrf = ", r8_win%ncall_r, MaxTrf + stop + endif + + if (num_s .gt. 0 .and. (.not. send_local)) then + CALL MPI_WAITALL( comm_size, InHandle(:,r8_win%ncall_r), InStats, Ierr ) + if (twovar) then + CALL MPI_WAITALL( comm_size, InHandle(:,r8_win%ncall_r+1), InStats, Ierr ) + endif + endif + if (num_r .gt. 0) then + CALL MPI_WAITALL( comm_size, OutHandle(:,r8_win%ncall_r), OutStats, Ierr ) + if (twovar) then + CALL MPI_WAITALL( comm_size, OutHandle(:,r8_win%ncall_r+1), OutStats, Ierr ) + endif + endif + + else + +! temporary contiguous buffer / global window + + if (r8_win%ncall_r .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_recvirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_r max_irr = ", r8_win%ncall_r, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! scatter data from global receive buffer to final destination + offset_0 = (r8_win%ncall_r-1)*unitsize + offset_r = offset_0 + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = onetwo*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + if (offset_r-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_recvirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + r8_win%nread = r8_win%nread + 1 + call MPI_WAIT(r8_win%rqest(r8_win%nread), Status, ierr) + + offset_v(1) = r8_win%offset_r + do j = 2, recv_bl(ipe)%Nparcels + offset_v(j) = offset_v(j-1) + recv_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, recv_bl(ipe)%Nparcels + do i = 1, recv_bl(ipe)%blocksizes(j) + q1out(recv_bl(ipe)%displacements(j)+i) = ga_r8_r(offset_v(j)+i) + enddo + enddo + if (twovar) then + do j = 1, recv_bl(ipe)%Nparcels + do i = 1, recv_bl(ipe)%blocksizes(j) + q2out(recv_bl(ipe)%displacements(j)+i) = ga_r8_r(recv_bl(ipe)%Tot_Size+offset_v(j)+i) + enddo + enddo + endif + + endif + enddo + + if ((r8_win%ncall_s == r8_win%ncall_r + onetwo - 1) .and. (.not. send_local)) then + call MPI_WAITALL(r8_win%nsend, r8_win%sqest, Stats, ierror) + endif + + endif ! mod_method .gt. 0 + + if (twovar) r8_win%ncall_r = r8_win%ncall_r + 1 + + if (r8_win%ncall_s == r8_win%ncall_r) then + r8_win%nsend = 0 + r8_win%nrecv = 0 + r8_win%nread = 0 + r8_win%ncall_s = 0 + r8_win%ncall_r = 0 + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recvirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_sendirr_r4 --- Initiate communication of contiguous parcels - r4 +! +! !INTERFACE: + subroutine mp_sendirr_r4 ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + real(r4), intent(in) :: q1in(*) ! input array + real(r4), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + +! !OUTPUT PARAMETERS: + real(r4), intent(out) :: q1out(*) ! output array + real(r4), optional, intent(out) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications here and placing +! wait points in mp_recvirr; if 1, call swap routine with p2p messages; if 2, call swap +! routine with a2a messages. +! Modc(2): if 1, then apply handshaking (don't send until corresponding receive is posted) +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! Modc(4): maximum number of outstanding requests (applies to swap routines only) +! +! !REVISION HISTORY: +! 02.08.13 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Use partneroffset +! 03.06.24 Sawyer Integrated Use_Mpi_Types; added qout +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin No-op version +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! + write(iulog,*) 'Mod_comm: mp_sendirr_r4 - r4 no longer supported - exiting' + stop + +!EOC + end subroutine mp_sendirr_r4 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recvirr_r4 --- Finalize communication of contiguous parcels - r4 +! +! !INTERFACE: + subroutine mp_recvirr_r4 ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + real(r4), intent(in) :: q1in(*) ! input array + real(r4), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests +! !INPUT/OUTPUT PARAMETERS: + real(r4), intent(inout) :: q1out(*) ! output array + real(r4), optional, intent(inout) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Complete transfer of a generalized region initiated by {\tt mp\_sendirr}. +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications in mp_sendirr and +! placing wait points here; otherwise don't do anything - mp_swapirr is called from mp_sendirr. +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! +! !REVISION HISTORY: +! 02.08.15 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Now using packed arrays for MPI2 +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin No-op version +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! + write(iulog,*) 'Mod_comm: mp_recvirr_r4 - r4 no longer supported - exiting' + stop + +!EOC + end subroutine mp_recvirr_r4 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_sendirr_i4 --- Initiate communication of contiguous parcels - i4 +! +! !INTERFACE: + subroutine mp_sendirr_i4 ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer(i4), intent(in) :: q1in(*) ! input array + integer(i4), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + +! !OUTPUT PARAMETERS: + integer(i4), intent(out) :: q1out(*) ! output array + integer(i4), optional, intent(out) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications here and placing +! wait points in mp_recvirr; if 1, call swap routine with p2p messages; if 2, call swap +! routine with a2a messages. +! Modc(2): if 1, then apply handshaking (don't send until corresponding receive is posted) +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! Modc(4): maximum number of outstanding requests (applies to swap routines only) +! +! !REVISION HISTORY: +! 02.08.13 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Use partneroffset +! 03.06.24 Sawyer Integrated Use_Mpi_Types; added qout +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer ipe, qsize, offset, blocksize, nparcels, offset_s, offset_r, ierr, mod_method + integer p, mysize, nthpc, minsize, nthrd, pn, pt, tmpsize, unitsize, offset_0 + integer i, j, send_tag, recv_tag, num_s, num_r + integer :: offset_v (Max_Nparcels) + integer :: hs_snd, hs_rcv(numpro), hs_rcvids(numpro) + integer ipe2, ceil2num + integer onetwo + logical twovar + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_pid + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .false. + maxreq_local = -1 + endif + +! Do not call mp_swapirr_i4 unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + + onetwo = 1 + twovar = .false. + if (present(q2in)) then + onetwo = 2 + twovar = .true. + endif + + if (sw_local .gt. 0) then + sw_alltoall = (sw_local .eq. 2) + if (present(q2in)) then + call mp_swapirr_i4(comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + else + call mp_swapirr_i4(comm, send_bl, recv_bl, q1in, q1out, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + endif + else + + call MPI_COMM_RANK (comm, comm_pid, ierr) + + hs_snd = 1 + ceil2num = ceil2(numpro) + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + mod_method = recv_bl(1)%method + + i4_win%ncall_s = i4_win%ncall_s + 1 + if (mod_method .gt. 0) then +! +! mpi derived types + if (i4_win%ncall_s .gt. MaxTrf-onetwo+1) then + write(iulog,*) "mp_sendirr_i4: derived type handle count exceeded - exiting" + write(iulog,*) "i4_win%ncall_s MaxTrf = ", i4_win%ncall_s, MaxTrf + stop + endif +! +! MPI: Irecv over all processes +! + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + if (ipe-1 /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, ipe-1, comm_pid, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + OutHandle(:,i4_win%ncall_s) = MPI_REQUEST_NULL + if (twovar) OutHandle(:,i4_win%ncall_s+1) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle +! +! Receive the buffers with MPI_Irecv. Non-blocking +! + if ( recv_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + recv_tag = ipe-1 + modcam_tagoffset + call mpi_irecv( q1out, 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,i4_win%ncall_s), ierr ) + if (twovar) then + call mpi_irecv( q2out, 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,i4_win%ncall_s+1), ierr ) + endif + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, ipe-1, ipe-1, comm, ierr ) + endif + endif + enddo + +! +! MPI: Isend/Send over all processes; use risend/rsend with hs +! + InHandle(:,i4_win%ncall_s) = MPI_REQUEST_NULL + if (twovar) InHandle(:,i4_win%ncall_s+1) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + +! +! Send the individual buffers with non-blocking sends +! + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + send_tag = comm_pid + modcam_tagoffset + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call mpi_rsend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_irsend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,i4_win%ncall_s), ierr ) + endif + if (twovar) then + if (send_local) then + call mpi_rsend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_irsend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,i4_win%ncall_s+1), ierr ) + endif + endif + else + if (send_local) then + call mpi_send( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_isend( q1in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,i4_win%ncall_s), ierr ) + endif + if (twovar) then + if (send_local) then + call mpi_send( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + else + call mpi_isend( q2in, 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,i4_win%ncall_s+1), ierr ) + endif + endif + endif + endif + enddo + else + +! temporary contiguous buffers + + if (i4_win%ncall_s .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_sendirr_i4: insufficient window storage - exiting" + write(iulog,*) "i4_win%ncall_s max_irr = ", i4_win%ncall_s, max_irr + stop + endif + unitsize = i4_win%size/max_irr + +! issue call to receive data in global receive buffer + offset_0 = (i4_win%ncall_s-1)*unitsize + offset_s = offset_0 + offset_r = offset_0 + + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = onetwo*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + i4_win%dest = ipe-1 + send_tag = comm_pid + modcam_tagoffset + if (i4_win%dest /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, i4_win%dest, send_tag, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + i4_win%size_r = onetwo*recv_bl(ipe)%Tot_Size + if (i4_win%size_r .ne. 0) then + i4_win%offset_r = offset_r + offset_r = offset_r + i4_win%size_r + i4_win%src = ipe-1 + if (onetwo*unitsize >= offset_r-offset_0) then + recv_tag = i4_win%src + modcam_tagoffset + qsize = i4_win%size_r + i4_win%nrecv = i4_win%nrecv + 1 + call MPI_IRECV(ga_i4_r(i4_win%offset_r+1), qsize, mp_i4, i4_win%src, & + recv_tag, comm, i4_win%rqest(i4_win%nrecv), ierror) + if (hs_local) then + if (i4_win%src /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, i4_win%src, recv_tag, comm, ierror) + endif + else + write(iulog,*) "Fatal mp_sendirr_i4: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo +! gather data into global send buffer + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = onetwo*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + i4_win%dest = ipe-1 + i4_win%offset_s = offset_s + offset_s = offset_s + qsize + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_sendirr_i4: send window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + offset_v(1) = i4_win%offset_s + do j = 2, send_bl(ipe)%nparcels + offset_v(j) = offset_v(j-1) + send_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, send_bl(ipe)%nparcels + do i = 1, send_bl(ipe)%blocksizes(j) + ga_i4_s(offset_v(j)+i) = q1in(send_bl(ipe)%displacements(j)+i) + enddo + enddo + if (twovar) then + do j = 1, send_bl(ipe)%nparcels + do i = 1, send_bl(ipe)%blocksizes(j) + ga_i4_s(send_bl(ipe)%Tot_Size+offset_v(j)+i) = q2in(send_bl(ipe)%displacements(j)+i) + enddo + enddo + endif + +! nonblocking send + send_tag = comm_pid + modcam_tagoffset + i4_win%nsend = i4_win%nsend + 1 + if (hs_local) then + if (i4_win%dest /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call MPI_RSEND(ga_i4_s(i4_win%offset_s+1), qsize, mp_i4, i4_win%dest, & + send_tag, comm, ierr) + else + call MPI_IRSEND(ga_i4_s(i4_win%offset_s+1), qsize, mp_i4, i4_win%dest, & + send_tag, comm, i4_win%sqest(i4_win%nsend), ierr) + endif + else + if (send_local) then + call MPI_SEND(ga_i4_s(i4_win%offset_s+1), qsize, mp_i4, i4_win%dest, & + send_tag, comm, ierr) + else + call MPI_ISEND(ga_i4_s(i4_win%offset_s+1), qsize, mp_i4, i4_win%dest, & + send_tag, comm, i4_win%sqest(i4_win%nsend), ierr) + endif + endif + endif + enddo + + endif ! mod_method + + if (twovar) i4_win%ncall_s = i4_win%ncall_s + 1 + + endif ! sw_local + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + + end subroutine mp_sendirr_i4 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recvirr_i4 --- Finalize communication of contiguous parcels - i4 +! +! !INTERFACE: + subroutine mp_recvirr_i4 ( comm, send_bl, recv_bl, q1in, q1out, q2in, q2out, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer(i4), intent(in) :: q1in(*) ! input array + integer(i4), optional, intent(in) :: q2in(*) ! second input array + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + +! !INPUT/OUTPUT PARAMETERS: + integer(i4), intent(inout) :: q1out(*) ! output array + integer(i4), optional, intent(inout) :: q2out(*) ! second output array +! +! !DESCRIPTION: +! Complete transfer of a generalized region initiated by {\tt mp\_sendirr}. +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications in mp_sendirr and +! placing wait points here; otherwise don't do anything - mp_swapirr is called from mp_sendirr. +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! +! !REVISION HISTORY: +! 02.08.15 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Now using packed arrays for MPI2 +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! +!EOP +!------------------------------------------------------------------------------ +!BOC + integer :: ipe, blocksize, offset_r, mod_method + integer unitsize, offset_0 + integer Ierr + integer InStats(numpro*MPI_STATUS_SIZE) + integer OutStats(numpro*MPI_STATUS_SIZE) + integer i, j, num_r, num_s + integer :: offset_v (Max_Nparcels) + integer ipe2, ceil2num + integer onetwo + logical twovar + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_size, comm_pid + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .false. + maxreq_local = -1 + endif + +! Do not call mp_swapirr_i4 (hence return) unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + +! Return if swap_irr + if (sw_local .gt. 0) return + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + onetwo = 1 + twovar = .false. + if (present(q2in)) then + onetwo = 2 + twovar = .true. + endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + + ceil2num = ceil2(numpro) + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + mod_method = recv_bl(1)%method + + i4_win%ncall_r = i4_win%ncall_r + 1 + + if (mod_method .gt. 0) then + +! mpi derived types + if (i4_win%ncall_r .gt. MaxTrf-onetwo+1) then + write(iulog,*) "mp_recvirr_i4: derived type handle count exceeded - exiting" + write(iulog,*) "i4_win%ncall_r MaxTrf = ", i4_win%ncall_r, MaxTrf + stop + endif + + if (num_s .gt. 0 .and. (.not. send_local)) then + CALL MPI_WAITALL( comm_size, InHandle(:,i4_win%ncall_r), InStats, Ierr ) + if (twovar) then + CALL MPI_WAITALL( comm_size, InHandle(:,i4_win%ncall_r+1), InStats, Ierr ) + endif + endif + if (num_r .gt. 0) then + CALL MPI_WAITALL( comm_size, OutHandle(:,i4_win%ncall_r), OutStats, Ierr ) + if (twovar) then + CALL MPI_WAITALL( comm_size, OutHandle(:,i4_win%ncall_r+1), OutStats, Ierr ) + endif + endif + + else + +! temporary contiguous buffer / global window + + if (i4_win%ncall_r .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_recvirr_i4: insufficient window storage - exiting" + write(iulog,*) "i4_win%ncall_r max_irr = ", i4_win%ncall_r, max_irr + stop + endif + unitsize = i4_win%size/max_irr + +! scatter data from global receive buffer to final destination + offset_0 = (i4_win%ncall_r-1)*unitsize + offset_r = offset_0 + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + i4_win%size_r = onetwo*recv_bl(ipe)%Tot_Size + if (i4_win%size_r .ne. 0) then + i4_win%offset_r = offset_r + offset_r = offset_r + i4_win%size_r + if (offset_r-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_recvirr_i4: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + i4_win%nread = i4_win%nread + 1 + call MPI_WAIT(i4_win%rqest(i4_win%nread), Status, ierr) + + offset_v(1) = i4_win%offset_r + do j = 2, recv_bl(ipe)%Nparcels + offset_v(j) = offset_v(j-1) + recv_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, recv_bl(ipe)%Nparcels + do i = 1, recv_bl(ipe)%blocksizes(j) + q1out(recv_bl(ipe)%displacements(j)+i) = ga_i4_r(offset_v(j)+i) + enddo + enddo + if (twovar) then + do j = 1, recv_bl(ipe)%Nparcels + do i = 1, recv_bl(ipe)%blocksizes(j) + q2out(recv_bl(ipe)%displacements(j)+i) = ga_i4_r(recv_bl(ipe)%Tot_Size+offset_v(j)+i) + enddo + enddo + endif + + endif + enddo + + if ((i4_win%ncall_s == i4_win%ncall_r + onetwo - 1) .and. (.not. send_local)) then + call MPI_WAITALL(i4_win%nsend, i4_win%sqest, Stats, ierror) + endif + + endif ! mod_method .gt. 0 + + if (twovar) i4_win%ncall_r = i4_win%ncall_r + 1 + + if (i4_win%ncall_s == i4_win%ncall_r) then + i4_win%nsend = 0 + i4_win%nrecv = 0 + i4_win%nread = 0 + i4_win%ncall_s = 0 + i4_win%ncall_r = 0 + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recvirr_i4 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_swapirr --- Write r8 contiguous parcels to global array +! using XOR swap ordering +! +! !INTERFACE: + subroutine mp_swapirr ( comm, send_bl, recv_bl, a1in, a1out, & + a2in, a2out, sw_handshake, sw_maxreq, & + sw_alltoall, sw_send ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + real(r8), intent(in) :: a1in(*) ! local data segment + real(r8), optional, intent(in) :: a2in(*) ! local data segment + logical, optional, intent(in) :: sw_handshake ! use flow control and + ! ready send + integer, optional, intent(in) :: sw_maxreq ! maximum number of outstanding + ! MPI requests + logical, optional, intent(in) :: sw_alltoall ! use mpi_alltoall + logical, optional, intent(in) :: sw_send ! use mpi_send instead of isend + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: a1out(*) ! local output segment + real(r8), optional, intent(out) :: a2out(*) ! local output segment +! +! !DESCRIPTION: +! XOR-ordered version of all-to-all communication +! +! WARNING: mod_comm parameter max_irr might need to be set larger than expected +! when swapping two variables; specifically, max_irr must be at least +! as large as the incoming r8_win%ncall_s + the number of variables to +! be swapped +! +! !REVISION HISTORY: +! 08.06.30 Worley original: derived from mp_sendirr, but using +! swapm logic and XOR swap order +! 08.08.22 Worley removed swapm; reimplemented with native MPI, +! added flow control/ready send option and maxreq +! throttling, added alltoall option +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: i, j, p, istep, num_s, num_r + integer :: comm_pid, comm_size, steps, ierr + integer :: ipe, offset_s, offset_r, offset_0, unitsize, onetwo + + integer :: arr_sndlths(0:numpro-1), arr_rcvlths(0:numpro-1) + integer :: sndlths(0:numpro-1), sdispls(0:numpro-1) + integer :: rcvlths(0:numpro-1), rdispls(0:numpro-1) + integer :: swapids(numpro) + integer :: sndids(numpro) ! nonblocking MPI send request ids + integer :: rcvids(numpro) ! nonblocking MPI recv request ids + integer :: hs_snd, hs_rcv(numpro)! handshake variables (send/receive) + integer :: hs_rcvids(numpro) ! nonblocking MPI handshake recv request ids + integer :: InStats(numpro*MPI_STATUS_SIZE) + integer :: OutStats(numpro*MPI_STATUS_SIZE) + + integer :: offset_v + + integer :: rstep + + integer :: maxreq, maxreqh + logical :: handshake, alltoall, sendd + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + +! num_s = 0 if this process is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this process is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + if ( present(a2in) .and. (.not. present(a2out)) ) then + write(iulog,*) "Fatal mp_swapirr: a2in specified, but a2out missing - exiting" + stop + endif + + if ( (.not. present(a2in)) .and. present(a2out)) then + write(iulog,*) "Fatal mp_swapirr: a2out specified, but a2in missing - exiting" + stop + endif + + if ( present(sw_handshake) ) then + handshake = sw_handshake + hs_snd = 1 + else + handshake = .false. + endif + + if ( present(sw_alltoall) ) then + alltoall = sw_alltoall + else + alltoall = .false. + endif + + if ( present(sw_send) ) then + sendd = sw_send + else + sendd = .false. + endif + + onetwo = 1 + if (present(a2in)) onetwo = 2 + unitsize = r8_win%size/max_irr + +! advance to unused portion of storage window + r8_win%ncall_s = r8_win%ncall_s + 1 + + if (r8_win%ncall_s .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_swapirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + +! calculate send lengths and displacements + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + sndlths(:) = 0 + sdispls(:) = 0 + arr_sndlths(:) = 0 + do ipe=1, num_s + sndlths(ipe-1) = send_bl(ipe)%Tot_Size + sdispls(ipe-1) = offset_s + if (sndlths(ipe-1) .ne. 0) then + + ! pack first array + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_swapirr: send window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + arr_sndlths(ipe-1) = sndlths(ipe-1) + + ! calculate for second array (if it exists) + if ( present(a2in) ) then + + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_swapirr: send window out of space - exiting" + write(iulog,*) '2 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + sndlths(ipe-1) = sndlths(ipe-1) + arr_sndlths(ipe-1) + + endif + + endif + enddo + +! calculate receive lengths and displacements + offset_r = offset_0 + rcvlths(:) = 0 + rdispls(:) = 0 + arr_rcvlths(:) = 0 + do ipe=1, num_r + rcvlths(ipe-1) = recv_bl(ipe)%Tot_Size + rdispls(ipe-1) = offset_r + if (rcvlths(ipe-1) .ne. 0) then + + offset_r = offset_r + rcvlths(ipe-1) + if (onetwo*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swapirr: receive window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + arr_rcvlths(ipe-1) = rcvlths(ipe-1) + + ! compute for second array (if it exists) + if ( present(a2out) ) then + + offset_r = offset_r + rcvlths(ipe-1) + if (onetwo*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swapirr: receive window out of space - exiting" + write(iulog,*) '2 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + rcvlths(ipe-1) = rcvlths(ipe-1) + arr_rcvlths(ipe-1) + + endif + + endif + enddo + +! Calculate swap partners and number of steps in point-to-point +! implementations of alltoall algorithm. + steps = 0 + do ipe=1,ceil2(comm_size)-1 + p = pair(comm_size,ipe,comm_pid) + if (p >= 0) then + if (sndlths(p) > 0 .or. rcvlths(p) > 0) then + steps = steps + 1 + swapids(steps) = p + end if + end if + end do + + if (.not. alltoall) then + + sndids(1:steps) = MPI_REQUEST_NULL + rcvids(1:steps) = MPI_REQUEST_NULL + + if (steps .eq. 0) then + maxreq = 0 + maxreqh = 0 + elseif (steps .eq. 1) then + maxreq = 1 + maxreqh = 1 + else + if ( present(sw_maxreq) ) then + if ((sw_maxreq .le. steps) .and. (sw_maxreq .ge. 0)) then + maxreq = sw_maxreq + if (maxreq > 1) then + maxreqh = maxreq/2 + else + maxreq = 2 + maxreqh = 1 + endif + else + maxreq = steps + maxreqh = steps + endif + else + maxreq = steps + maxreqh = steps + endif + endif + +! Post initial handshake receive requests + if (handshake) then + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv ( hs_rcv(istep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(istep), ierr ) + endif + enddo + endif + +! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv ( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(istep), ierr ) + if (handshake) then + call mpi_send( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + enddo + rstep = maxreq +! + endif + +! gather data into global send buffer + do istep=1,steps + p = swapids(istep) + + if (sndlths(p) .ne. 0) then + offset_v = sdispls(p) + do j = 1, send_bl(p+1)%nparcels + do i = 1, send_bl(p+1)%blocksizes(j) + ga_r8_s(offset_v+i) = a1in(send_bl(p+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + + ! pack second array (if it exists) + if ( present(a2in) ) then + offset_v = sdispls(p) + arr_sndlths(p) + do j = 1, send_bl(p+1)%nparcels + do i = 1, send_bl(p+1)%blocksizes(j) + ga_r8_s(offset_v+i) = a2in(send_bl(p+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + endif + + endif + + if (.not. alltoall) then + +! Submit new i(r)send request + offset_s = sdispls(p)+1 + if (sndlths(p) > 0) then + if (handshake) then + call mpi_wait( hs_rcvids(istep), MPI_STATUS_IGNORE, ierr ) + if (sendd) then + call mpi_rsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_irsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + else + if (sendd) then + call mpi_send ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_isend ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + endif + endif + + if (istep > maxreqh) then +! Wait for oldest irecv request to complete + call mpi_wait( rcvids(istep-maxreqh), OutStats, ierr ) + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + +! Submit a new handshake irecv request + if (handshake) then + if (sndlths(p) > 0) then + call mpi_irecv( hs_rcv(rstep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(rstep), ierr ) + endif + endif + +! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(rstep), ierr ) + if (handshake) then + call mpi_send ( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + endif + +! Wait for outstanding i(r)send request to complete + if (.not. sendd) then + call mpi_wait( sndids(istep-maxreqh), InStats, ierr ) + endif + endif +! + endif +! + enddo + +! local copy to send buffer + if (sndlths(comm_pid) .ne. 0) then + + offset_v = sdispls(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + ga_r8_s(offset_v+i) = a1in(send_bl(comm_pid+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + + ! pack second array (if it exists) + if ( present(a2in) ) then + offset_v = sdispls(comm_pid) + arr_sndlths(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + ga_r8_s(offset_v+i) = a2in(send_bl(comm_pid+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + endif + + if (.not. alltoall) then + ga_r8_r(rdispls(comm_pid)+1:rdispls(comm_pid)+rcvlths(comm_pid)) = & + ga_r8_s(sdispls(comm_pid)+1:sdispls(comm_pid)+sndlths(comm_pid)) + endif + + endif + + if (alltoall) then + call mpi_alltoallv (ga_r8_s, sndlths, sdispls, mp_r8, & + ga_r8_r, rcvlths, rdispls, mp_r8, & + comm, ierror) + endif + +! local copy from receive buffer + if (rcvlths(comm_pid) .ne. 0) then + + offset_v = rdispls(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + a1out(recv_bl(comm_pid+1)%displacements(j)+i) = ga_r8_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + + ! scatter data for second array (if it exists) + if ( present(a2out) ) then + offset_v = rdispls(comm_pid) + arr_rcvlths(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + a2out(recv_bl(comm_pid+1)%displacements(j)+i) = ga_r8_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + endif + + endif + +! scatter data from global receive buffer to final destination + do istep=1,steps + p = swapids(istep) + + if (.not. alltoall) then + if (istep > steps-maxreqh) then + call mpi_wait( rcvids(istep), OutStats, ierr ) + endif + endif + + if (rcvlths(p) .ne. 0) then + + offset_v = rdispls(p) + do j = 1, recv_bl(p+1)%Nparcels + do i = 1, recv_bl(p+1)%blocksizes(j) + a1out(recv_bl(p+1)%displacements(j)+i) = ga_r8_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + ! scatter data for second array (if it exists) + if ( present(a2out) ) then + + offset_v = rdispls(p) + arr_rcvlths(p) + do j = 1, recv_bl(p+1)%Nparcels + do i = 1, recv_bl(p+1)%blocksizes(j) + a2out(recv_bl(p+1)%displacements(j)+i) = ga_r8_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + endif + + endif + enddo + +! Wait for any outstanding send requests to complete. + if (.not. alltoall .and. .not. sendd) then + call mpi_waitall( maxreqh, sndids(steps-maxreqh+1), InStats, ierr ) + endif + +! clean-up +! make used portion of storage window available for reuse + r8_win%ncall_s = r8_win%ncall_s - 1 + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_swapirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_swapirr_i4 --- Write i4 contiguous parcels to global array +! using XOR swap ordering +! +! !INTERFACE: + subroutine mp_swapirr_i4 ( comm, send_bl, recv_bl, a1in, a1out, & + a2in, a2out, sw_handshake, sw_maxreq, & + sw_alltoall, sw_send ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer(i4), intent(in) :: a1in(*) ! input array + integer(i4), optional, intent(in) :: a2in(*) ! second input array + logical, optional, intent(in) :: sw_handshake ! use flow control and + ! ready send + integer, optional, intent(in) :: sw_maxreq ! maximum number of outstanding + ! MPI requests + logical, optional, intent(in) :: sw_alltoall ! use mpi_alltoall + logical, optional, intent(in) :: sw_send ! use mpi_send instead of isend + +! !OUTPUT PARAMETERS: + integer(i4), intent(out) :: a1out(*) ! output array + integer(i4), optional, intent(out) :: a2out(*) ! second output array +! +! !DESCRIPTION: +! XOR-ordered version of all-to-all communication +! +! WARNING: mod_comm parameter max_irr might need to be set larger than expected +! when swapping two variables; specifically, max_irr must be at least +! as large as the incoming i4_win%ncall_s + the number of variables to +! be swapped +! +! !REVISION HISTORY: +! 08.06.30 Worley original: derived from mp_sendirr, but using +! swapm logic and XOR swap order +! 08.08.22 Worley removed swapm; reimplemented with native MPI, +! added flow control/ready send option and maxreq +! throttling, added alltoall option +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: i, j, p, istep, num_s, num_r + integer :: comm_pid, comm_size, steps, ierr + integer :: ipe, offset_s, offset_r, offset_0, unitsize, onetwo + + integer :: arr_sndlths(0:numpro-1), arr_rcvlths(0:numpro-1) + integer :: sndlths(0:numpro-1), sdispls(0:numpro-1) + integer :: rcvlths(0:numpro-1), rdispls(0:numpro-1) + integer :: swapids(numpro) + integer :: sndids(numpro) ! nonblocking MPI send request ids + integer :: rcvids(numpro) ! nonblocking MPI recv request ids + integer :: hs_snd, hs_rcv(numpro)! handshake variables (send/receive) + integer :: hs_rcvids(numpro) ! nonblocking MPI handshake recv request ids + integer :: InStats(numpro*MPI_STATUS_SIZE) + integer :: OutStats(numpro*MPI_STATUS_SIZE) + + integer :: offset_v + + integer :: rstep + + integer :: maxreq, maxreqh + logical :: handshake, alltoall, sendd + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + +! num_s = 0 if this process is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this process is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + if ( present(a2in) .and. (.not. present(a2out)) ) then + write(iulog,*) "Fatal mp_swapirr_i4: a2in specified, but a2out missing - exiting" + stop + endif + + if ( (.not. present(a2in)) .and. present(a2out)) then + write(iulog,*) "Fatal mp_swapirr_i4: a2out specified, but a2in missing - exiting" + stop + endif + + if ( present(sw_handshake) ) then + handshake = sw_handshake + hs_snd = 1 + else + handshake = .false. + endif + + if ( present(sw_alltoall) ) then + alltoall = sw_alltoall + else + alltoall = .false. + endif + + if ( present(sw_send) ) then + sendd = sw_send + else + sendd = .false. + endif + + onetwo = 1 + if (present(a2in)) onetwo = 2 + unitsize = i4_win%size/max_irr + +! advance to unused portion of storage window + i4_win%ncall_s = i4_win%ncall_s + 1 + + if (i4_win%ncall_s .gt. max_irr-onetwo+1) then + write(iulog,*) "mp_swapirr_i4: insufficient window storage - exiting" + write(iulog,*) "i4_win%ncall_s max_irr = ", i4_win%ncall_s, max_irr + stop + endif + +! calculate send lengths and displacements + offset_0 = (i4_win%ncall_s-1)*unitsize + offset_s = offset_0 + sndlths(:) = 0 + sdispls(:) = 0 + arr_sndlths(:) = 0 + do ipe=1, num_s + sndlths(ipe-1) = send_bl(ipe)%Tot_Size + sdispls(ipe-1) = offset_s + if (sndlths(ipe-1) .ne. 0) then + + ! pack first array + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_swapirr_i4: send window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + arr_sndlths(ipe-1) = sndlths(ipe-1) + + ! calculate for second array (if it exists) + if ( present(a2in) ) then + + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. onetwo*unitsize) then + write(iulog,*) "Fatal mp_swapirr_i4: send window out of space - exiting" + write(iulog,*) '2 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + sndlths(ipe-1) = sndlths(ipe-1) + arr_sndlths(ipe-1) + + endif + + endif + enddo + +! calculate receive lengths and displacements + offset_r = offset_0 + rcvlths(:) = 0 + rdispls(:) = 0 + arr_rcvlths(:) = 0 + do ipe=1, num_r + rcvlths(ipe-1) = recv_bl(ipe)%Tot_Size + rdispls(ipe-1) = offset_r + if (rcvlths(ipe-1) .ne. 0) then + + offset_r = offset_r + rcvlths(ipe-1) + if (onetwo*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swapirr_i4: receive window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + arr_rcvlths(ipe-1) = rcvlths(ipe-1) + + ! compute for second array (if it exists) + if ( present(a2out) ) then + + offset_r = offset_r + rcvlths(ipe-1) + if (onetwo*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swapirr_i4: receive window out of space - exiting" + write(iulog,*) '2 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + rcvlths(ipe-1) = rcvlths(ipe-1) + arr_rcvlths(ipe-1) + + endif + + endif + enddo + +! Calculate swap partners and number of steps in point-to-point +! implementations of alltoall algorithm. + steps = 0 + do ipe=1,ceil2(comm_size)-1 + p = pair(comm_size,ipe,comm_pid) + if (p >= 0) then + if (sndlths(p) > 0 .or. rcvlths(p) > 0) then + steps = steps + 1 + swapids(steps) = p + end if + end if + end do + + if (.not. alltoall) then + + sndids(1:steps) = MPI_REQUEST_NULL + rcvids(1:steps) = MPI_REQUEST_NULL + + if (steps .eq. 0) then + maxreq = 0 + maxreqh = 0 + elseif (steps .eq. 1) then + maxreq = 1 + maxreqh = 1 + else + if ( present(sw_maxreq) ) then + if ((sw_maxreq .le. steps) .and. (sw_maxreq .ge. 0)) then + maxreq = sw_maxreq + if (maxreq > 1) then + maxreqh = maxreq/2 + else + maxreq = 2 + maxreqh = 1 + endif + else + maxreq = steps + maxreqh = steps + endif + else + maxreq = steps + maxreqh = steps + endif + endif + +! Post initial handshake receive requests + if (handshake) then + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv ( hs_rcv(istep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(istep), ierr ) + endif + enddo + endif + +! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv ( ga_i4_r(offset_r), rcvlths(p), mp_i4, & + p, p, comm, rcvids(istep), ierr ) + if (handshake) then + call mpi_send( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + enddo + rstep = maxreq +! + endif + +! gather data into global send buffer + do istep=1,steps + p = swapids(istep) + + if (sndlths(p) .ne. 0) then + offset_v = sdispls(p) + do j = 1, send_bl(p+1)%nparcels + do i = 1, send_bl(p+1)%blocksizes(j) + ga_i4_s(offset_v+i) = a1in(send_bl(p+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + + ! pack second array (if it exists) + if ( present(a2in) ) then + offset_v = sdispls(p) + arr_sndlths(p) + do j = 1, send_bl(p+1)%nparcels + do i = 1, send_bl(p+1)%blocksizes(j) + ga_i4_s(offset_v+i) = a2in(send_bl(p+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + endif + + endif + + if (.not. alltoall) then + +! Submit new i(r)send request + offset_s = sdispls(p)+1 + if (sndlths(p) > 0) then + if (handshake) then + call mpi_wait( hs_rcvids(istep), MPI_STATUS_IGNORE, ierr ) + if (sendd) then + call mpi_rsend( ga_i4_s(offset_s), sndlths(p), mp_i4, & + p, comm_pid, comm, ierr ) + else + call mpi_irsend( ga_i4_s(offset_s), sndlths(p), mp_i4, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + else + if (sendd) then + call mpi_send ( ga_i4_s(offset_s), sndlths(p), mp_i4, & + p, comm_pid, comm, ierr ) + else + call mpi_isend ( ga_i4_s(offset_s), sndlths(p), mp_i4, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + endif + endif + + if (istep > maxreqh) then +! Wait for oldest irecv request to complete + call mpi_wait( rcvids(istep-maxreqh), OutStats, ierr ) + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + +! Submit a new handshake irecv request + if (handshake) then + if (sndlths(p) > 0) then + call mpi_irecv( hs_rcv(rstep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(rstep), ierr ) + endif + endif + +! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( ga_i4_r(offset_r), rcvlths(p), mp_i4, & + p, p, comm, rcvids(rstep), ierr ) + if (handshake) then + call mpi_send ( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + endif + +! Wait for outstanding i(r)send request to complete + if (.not. sendd) then + call mpi_wait( sndids(istep-maxreqh), InStats, ierr ) + endif + endif +! + endif +! + enddo + +! local copy to send buffer + if (sndlths(comm_pid) .ne. 0) then + + offset_v = sdispls(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + ga_i4_s(offset_v+i) = a1in(send_bl(comm_pid+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + + ! pack second array (if it exists) + if ( present(a2in) ) then + offset_v = sdispls(comm_pid) + arr_sndlths(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + ga_i4_s(offset_v+i) = a2in(send_bl(comm_pid+1)%displacements(j)+i) + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + endif + + if (.not. alltoall) then + ga_i4_r(rdispls(comm_pid)+1:rdispls(comm_pid)+rcvlths(comm_pid)) = & + ga_i4_s(sdispls(comm_pid)+1:sdispls(comm_pid)+sndlths(comm_pid)) + endif + + endif + + if (alltoall) then + call mpi_alltoallv (ga_i4_s, sndlths, sdispls, mp_i4, & + ga_i4_r, rcvlths, rdispls, mp_i4, & + comm, ierror) + endif + +! local copy from receive buffer + if (rcvlths(comm_pid) .ne. 0) then + + offset_v = rdispls(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + a1out(recv_bl(comm_pid+1)%displacements(j)+i) = ga_i4_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + + ! scatter data for second array (if it exists) + if ( present(a2out) ) then + offset_v = rdispls(comm_pid) + arr_rcvlths(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + a2out(recv_bl(comm_pid+1)%displacements(j)+i) = ga_i4_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + endif + + endif + +! scatter data from global receive buffer to final destination + do istep=1,steps + p = swapids(istep) + + if (.not. alltoall) then + if (istep > steps-maxreqh) then + call mpi_wait( rcvids(istep), OutStats, ierr ) + endif + endif + + if (rcvlths(p) .ne. 0) then + + offset_v = rdispls(p) + do j = 1, recv_bl(p+1)%Nparcels + do i = 1, recv_bl(p+1)%blocksizes(j) + a1out(recv_bl(p+1)%displacements(j)+i) = ga_i4_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + ! scatter data for second array (if it exists) + if ( present(a2out) ) then + + offset_v = rdispls(p) + arr_rcvlths(p) + do j = 1, recv_bl(p+1)%Nparcels + do i = 1, recv_bl(p+1)%blocksizes(j) + a2out(recv_bl(p+1)%displacements(j)+i) = ga_i4_r(offset_v+i) + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + endif + + endif + enddo + +! Wait for any outstanding send requests to complete. + if (.not. alltoall .and. .not. sendd) then + call mpi_waitall( maxreqh, sndids(steps-maxreqh+1), InStats, ierr ) + endif + +! clean-up +! make used portion of storage window available for reuse + i4_win%ncall_s = i4_win%ncall_s - 1 + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_swapirr_i4 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: pair +! +! !INTERFACE: + integer function pair(np,p,k) +! +! !INPUT PARAMETERS: + integer :: np + integer :: p + integer :: k +! !DESCRIPTION: +! +! Bitwise XOR of arguments p and k, if less than upper bound np +! +! !REVISION HISTORY: +! 2008.08.21 Worley Imported from spmdutils +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer q +! + q = ieor(p,k) + if ( q > np-1 ) then + pair = -1 + else + pair = q + endif + + return + +!EOC + end function pair +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: ceil2 +! +! !INTERFACE: + integer function ceil2(n) +! +! !INPUT PARAMETERS: + integer :: n +! !DESCRIPTION: +! +! Smallest power of 2 greater than or equal to the argument +! +! !REVISION HISTORY: +! 2008.08.21 Worley Imported from spmdutils +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer p + + p=1 + do while ( p < n ) + p=p*2 + enddo + ceil2=p + + return +!EOC + end function ceil2 +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +# if defined( MOD_ASSUMED_SIZE ) +!BOP +! !ROUTINE: mp_sendtrirr --- Initiate communication of contiguous tracer parcels +! +! !INTERFACE: + subroutine mp_sendtrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + real(r8), intent(in) :: qin(*) ! input tracer array + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(*) ! output tracer array +! +! !DESCRIPTION: +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications here and placing +! wait points in mp_recvtrirr; if 1, call swap routine with p2p messages; if 2, call swap +! routine with a2a messages. +! Modc(2): if 1, then apply handshaking (don't send until corresponding receive is posted) +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! Modc(4): maximum number of outstanding requests (applies to swap routines only) +! +! !REVISION HISTORY: +! 02.08.13 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Use partneroffset +! 03.06.24 Sawyer Integrated Use_Mpi_Types; added qout +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer ipe, qsize, offset, blocksize, nparcels, offset_s, offset_r, ierr, mod_method + integer p, mysize, nthpc, minsize, nthrd, pn, pt, tmpsize, unitsize, offset_0 + integer i, j, send_tag, recv_tag, num_s, num_r, m + integer :: offset_v (Max_Nparcels) + integer :: hs_snd, hs_rcv(numpro), hs_rcvids(numpro) + integer ipe2, ceil2num + integer numtr, numtrm + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_pid + integer ijks, ijkr, ij + + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swaptrirr unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + + if (sw_local .gt. 0) then + sw_alltoall = (sw_local .eq. 2) + call mp_swaptrirr(comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + else + + call MPI_COMM_RANK (comm, comm_pid, ierr) + + hs_snd = 1 + ceil2num = ceil2(numpro) + + numtrm = mend - mbeg + numtr = numtrm + 1 + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_s = r8_win%ncall_s + 1 + + ijks =(klasts-kfirsts+1)*(jlasts-jfirsts+1)*(ilasts-ifirsts+1) + ijkr =(klastr-kfirstr+1)*(jlastr-jfirstr+1)*(ilastr-ifirstr+1) + + if (mod_method .gt. 0) then +! +! mpi derived types + if (r8_win%ncall_s .gt. MaxTrf-numtrm) then + write(iulog,*) "mp_sendtrirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_s MaxTrf = ", r8_win%ncall_s, MaxTrf + stop + endif +! +! MPI: Irecv over all processes +! + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + if (ipe-1 /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, ipe-1, comm_pid, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + OutHandle(:,r8_win%ncall_s:r8_win%ncall_s+numtrm) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle +! +! Receive the buffers with MPI_Irecv. Non-blocking +! + if ( recv_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + recv_tag = ipe-1 + modcam_tagoffset + do m = mbeg, mend + call mpi_irecv( qout((m-1)*ijkr+1), 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,r8_win%ncall_s+m-mbeg), ierr ) + enddo + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, ipe-1, ipe-1, comm, ierr ) + endif + endif + enddo + +! +! MPI: Isend/Send over all processes; use risend/rsend with hs +! + InHandle(:,r8_win%ncall_s:r8_win%ncall_s+numtrm) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + +! +! Send the individual buffers with non-blocking sends +! + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + send_tag = comm_pid + modcam_tagoffset + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + do m = mbeg, mend + call mpi_rsend( qin((m-1)*ijks+1), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + enddo + else + do m = mbeg, mend + call mpi_irsend( qin((m-1)*ijks+1), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + enddo + endif + else + if (send_local) then + do m = mbeg, mend + call mpi_send( qin((m-1)*ijks+1), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + enddo + else + do m = mbeg, mend + call mpi_isend( qin((m-1)*ijks+1), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + enddo + endif + endif + endif + enddo + else + +! temporary contiguous buffers + + if (r8_win%ncall_s .gt. max_irr-numtrm) then + write(iulog,*) "mp_sendtrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! issue call to receive data in global receive buffer + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + offset_r = offset_0 + + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = numtr*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + send_tag = comm_pid + modcam_tagoffset + if (r8_win%dest /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, r8_win%dest, send_tag, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = numtr*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + r8_win%src = ipe-1 + if (numtr*unitsize >= offset_r-offset_0) then + recv_tag = r8_win%src + modcam_tagoffset + qsize = r8_win%size_r + r8_win%nrecv = r8_win%nrecv + 1 + call MPI_IRECV(ga_r8_r(r8_win%offset_r+1), qsize, mp_r8, r8_win%src, & + recv_tag, comm, r8_win%rqest(r8_win%nrecv), ierror) + if (hs_local) then + if (r8_win%src /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, r8_win%src, recv_tag, comm, ierror) + endif + else + write(iulog,*) "Fatal mp_sendtrirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo +! gather data into global send buffer + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = numtr*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + r8_win%offset_s = offset_s + offset_s = offset_s + qsize + if (offset_s-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_sendtrirr: send window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + offset_v(1) = r8_win%offset_s + do j = 2, send_bl(ipe)%nparcels + offset_v(j) = offset_v(j-1) + send_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, send_bl(ipe)%nparcels + do m = mbeg, mend + do i = 1, send_bl(ipe)%blocksizes(j) + ij = send_bl(ipe)%displacements(j)+i + ga_r8_s(send_bl(ipe)%Tot_Size*(m-mbeg)+offset_v(j)+i) = qin((m-1)*ijks+ij) + enddo + enddo + enddo + +! nonblocking send + send_tag = comm_pid + modcam_tagoffset + r8_win%nsend = r8_win%nsend + 1 + if (hs_local) then + if (r8_win%dest /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call MPI_RSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_IRSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + else + if (send_local) then + call MPI_SEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_ISEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + endif + endif + enddo + + endif ! mod_method + + r8_win%ncall_s = r8_win%ncall_s + numtrm + + endif ! sw_local + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + + end subroutine mp_sendtrirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recvtrirr --- Finalize communication of contiguous tracer parcels +! +! !INTERFACE: + subroutine mp_recvtrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + real(r8), intent(in) :: qin(*) ! input tracer array +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(*) ! output tracer array +! +! !DESCRIPTION: +! Complete transfer of a generalized region initiated by {\tt mp\_sendtrirr}. +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications in mp_sendtrirr and +! placing wait points here; otherwise don't do anything - mp_swaptrirr is called from mp_sendirr. +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! +! !REVISION HISTORY: +! 02.08.15 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Now using packed arrays for MPI2 +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! +!EOP +!------------------------------------------------------------------------------ +!BOC + integer :: ipe, blocksize, offset_r, mod_method + integer unitsize, offset_0 + integer Ierr + integer InStats(numpro*MPI_STATUS_SIZE) + integer OutStats(numpro*MPI_STATUS_SIZE) + integer i, j, num_r, num_s, m + integer :: offset_v (Max_Nparcels) + integer ipe2, ceil2num + integer numtr, numtrm + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_size, comm_pid + integer ijks, ijkr, ij + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swaptrirr (hence return) unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + +! Return if swap_irr + if (sw_local .gt. 0) return + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + + ceil2num = ceil2(numpro) + + numtrm = mend - mbeg + numtr = numtrm + 1 + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_r = r8_win%ncall_r + 1 + + ijks =(klasts-kfirsts+1)*(jlasts-jfirsts+1)*(ilasts-ifirsts+1) + ijkr =(klastr-kfirstr+1)*(jlastr-jfirstr+1)*(ilastr-ifirstr+1) + + if (mod_method .gt. 0) then + +! mpi derived types + if (r8_win%ncall_r .gt. MaxTrf-numtrm) then + write(iulog,*) "mp_recvtrirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_r MaxTrf = ", r8_win%ncall_r, MaxTrf + stop + endif + + if (num_s .gt. 0 .and. (.not. send_local)) then + do m = mbeg, mend + CALL MPI_WAITALL( comm_size, InHandle(:,r8_win%ncall_r+m-mbeg), InStats, Ierr ) + enddo + endif + if (num_r .gt. 0) then + do m = mbeg, mend + CALL MPI_WAITALL( comm_size, OutHandle(:,r8_win%ncall_r+m-mbeg), OutStats, Ierr ) + enddo + endif + + else + +! temporary contiguous buffer / global window + + if (r8_win%ncall_r .gt. max_irr-numtrm) then + write(iulog,*) "mp_recvtrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_r max_irr = ", r8_win%ncall_r, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! scatter data from global receive buffer to final destination + offset_0 = (r8_win%ncall_r-1)*unitsize + offset_r = offset_0 + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = numtr*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + if (offset_r-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_recvtrirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + r8_win%nread = r8_win%nread + 1 + call MPI_WAIT(r8_win%rqest(r8_win%nread), Status, ierr) + + offset_v(1) = r8_win%offset_r + do j = 2, recv_bl(ipe)%Nparcels + offset_v(j) = offset_v(j-1) + recv_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, recv_bl(ipe)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(ipe)%blocksizes(j) + ij = recv_bl(ipe)%displacements(j)+i + qout((m-1)*ijkr+ij) = ga_r8_r(recv_bl(ipe)%Tot_Size*(m-mbeg)+offset_v(j)+i) + enddo + enddo + enddo + + endif + enddo + + if ((r8_win%ncall_s == r8_win%ncall_r + numtrm) .and. (.not. send_local)) then + call MPI_WAITALL(r8_win%nsend, r8_win%sqest, Stats, ierror) + endif + + endif ! mod_method .gt. 0 + + r8_win%ncall_r = r8_win%ncall_r + numtrm + + if (r8_win%ncall_s == r8_win%ncall_r) then + r8_win%nsend = 0 + r8_win%nrecv = 0 + r8_win%nread = 0 + r8_win%ncall_s = 0 + r8_win%ncall_r = 0 + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recvtrirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_swaptrirr --- Write r8 contiguous parcels to global array +! using XOR swap ordering - for multiple tracers +! +! !INTERFACE: + subroutine mp_swaptrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + sw_handshake, sw_maxreq, sw_alltoall, sw_send ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + logical, optional, intent(in) :: sw_handshake ! use flow control and + ! ready send + integer, optional, intent(in) :: sw_maxreq ! maximum number of outstanding + ! MPI requests + logical, optional, intent(in) :: sw_alltoall ! use mpi_alltoall + logical, optional, intent(in) :: sw_send ! use mpi_send instead of isend + real(r8), intent(in) :: qin(*) ! input tracer array + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(*) ! output tracer array +! +! !DESCRIPTION: +! +! XOR-ordered version of all-to-all communication +! +! WARNING: mod_comm parameter max_irr might need to be set larger than expected +! when swapping multiple variables; specifically, max_irr must be at least +! as large as the incoming r8_win%ncall_s + the number of variables to +! be swapped +! +! !REVISION HISTORY: +! 08.06.30 Worley original: derived from mp_sendirr, but using +! swapm logic and XOR swap order +! 08.08.22 Worley removed swapm; reimplemented with native MPI, +! added flow control/ready send option and maxreq +! throttling, added alltoall option +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: i, j, p, istep, num_s, num_r + integer :: comm_pid, comm_size, steps, ierr + integer :: ipe, offset_s, offset_r, offset_0, unitsize + + integer :: sndlths(0:numpro-1), sdispls(0:numpro-1) + integer :: rcvlths(0:numpro-1), rdispls(0:numpro-1) + integer :: swapids(numpro) + integer :: sndids(numpro) ! nonblocking MPI send request ids + integer :: rcvids(numpro) ! nonblocking MPI recv request ids + integer :: hs_snd, hs_rcv(numpro)! handshake variables (send/receive) + integer :: hs_rcvids(numpro) ! nonblocking MPI handshake recv request ids + integer :: InStats(numpro*MPI_STATUS_SIZE) + integer :: OutStats(numpro*MPI_STATUS_SIZE) + + integer :: offset_v + + integer :: rstep + + integer :: maxreq, maxreqh + logical :: handshake, alltoall, sendd + integer :: numtr, numtrm, m + integer ijks, ijkr, ij + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + +! num_s = 0 if this process is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this process is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + if ( present(sw_handshake) ) then + handshake = sw_handshake + hs_snd = 1 + else + handshake = .false. + endif + + if ( present(sw_alltoall) ) then + alltoall = sw_alltoall + else + alltoall = .false. + endif + + if ( present(sw_send) ) then + sendd = sw_send + else + sendd = .false. + endif + + numtrm = mend - mbeg + numtr = numtrm + 1 + + ijks =(klasts-kfirsts+1)*(jlasts-jfirsts+1)*(ilasts-ifirsts+1) + ijkr =(klastr-kfirstr+1)*(jlastr-jfirstr+1)*(ilastr-ifirstr+1) + + unitsize = r8_win%size/max_irr + +! advance to unused portion of storage window + r8_win%ncall_s = r8_win%ncall_s + 1 + + if (r8_win%ncall_s .gt. max_irr-numtrm) then + write(iulog,*) "mp_swaptrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + +! calculate send lengths and displacements + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + sndlths(:) = 0 + sdispls(:) = 0 + do ipe=1, num_s + sndlths(ipe-1) = numtr*send_bl(ipe)%Tot_Size + sdispls(ipe-1) = offset_s + if (sndlths(ipe-1) .ne. 0) then + + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_swaptrirr: send window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + endif + enddo + +! calculate receive lengths and displacements + offset_r = offset_0 + rcvlths(:) = 0 + rdispls(:) = 0 + do ipe=1, num_r + rcvlths(ipe-1) = numtr*recv_bl(ipe)%Tot_Size + rdispls(ipe-1) = offset_r + if (rcvlths(ipe-1) .ne. 0) then + + offset_r = offset_r + rcvlths(ipe-1) + if (numtr*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swaptrirr: receive window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo + +! Calculate swap partners and number of steps in point-to-point +! implementations of alltoall algorithm. + steps = 0 + do ipe=1,ceil2(comm_size)-1 + p = pair(comm_size,ipe,comm_pid) + if (p >= 0) then + if (sndlths(p) > 0 .or. rcvlths(p) > 0) then + steps = steps + 1 + swapids(steps) = p + end if + end if + end do + + if (.not. alltoall) then + + sndids(1:steps) = MPI_REQUEST_NULL + rcvids(1:steps) = MPI_REQUEST_NULL + + if (steps .eq. 0) then + maxreq = 0 + maxreqh = 0 + elseif (steps .eq. 1) then + maxreq = 1 + maxreqh = 1 + else + if ( present(sw_maxreq) ) then + if ((sw_maxreq .le. steps) .and. (sw_maxreq .ge. 0)) then + maxreq = sw_maxreq + if (maxreq > 1) then + maxreqh = maxreq/2 + else + maxreq = 2 + maxreqh = 1 + endif + else + maxreq = steps + maxreqh = steps + endif + else + maxreq = steps + maxreqh = steps + endif + endif + +! Post initial handshake receive requests + if (handshake) then + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv ( hs_rcv(istep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(istep), ierr ) + endif + enddo + endif + +! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv ( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(istep), ierr ) + if (handshake) then + call mpi_send( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + enddo + rstep = maxreq +! + endif + +! gather data into global send buffer + do istep=1,steps + p = swapids(istep) + + if (sndlths(p) .ne. 0) then + offset_v = sdispls(p) + do j = 1, send_bl(p+1)%nparcels + do m = mbeg, mend + do i = 1, send_bl(p+1)%blocksizes(j) + ij = send_bl(p+1)%displacements(j)+i + ga_r8_s(send_bl(p+1)%Tot_Size*(m-mbeg)+offset_v+i) = qin((m-1)*ijks+ij) + enddo + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + endif + + if (.not. alltoall) then + +! Submit new i(r)send request + offset_s = sdispls(p)+1 + if (sndlths(p) > 0) then + if (handshake) then + call mpi_wait( hs_rcvids(istep), MPI_STATUS_IGNORE, ierr ) + if (sendd) then + call mpi_rsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_irsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + else + if (sendd) then + call mpi_send ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_isend ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + endif + endif + + if (istep > maxreqh) then +! Wait for oldest irecv request to complete + call mpi_wait( rcvids(istep-maxreqh), OutStats, ierr ) + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + +! Submit a new handshake irecv request + if (handshake) then + if (sndlths(p) > 0) then + call mpi_irecv( hs_rcv(rstep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(rstep), ierr ) + endif + endif + +! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(rstep), ierr ) + if (handshake) then + call mpi_send ( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + endif + +! Wait for outstanding i(r)send request to complete + if (.not. sendd) then + call mpi_wait( sndids(istep-maxreqh), InStats, ierr ) + endif + endif +! + endif +! + enddo + +! local copy to send buffer + if (sndlths(comm_pid) .ne. 0) then + + offset_v = sdispls(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do m = mbeg, mend + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + ij = send_bl(comm_pid+1)%displacements(j)+i + ga_r8_s(send_bl(comm_pid+1)%Tot_Size*(m-mbeg)+offset_v+i) = qin((m-1)*ijks+ij) + enddo + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + + if (.not. alltoall) then + ga_r8_r(rdispls(comm_pid)+1:rdispls(comm_pid)+rcvlths(comm_pid)) = & + ga_r8_s(sdispls(comm_pid)+1:sdispls(comm_pid)+sndlths(comm_pid)) + endif + + endif + + if (alltoall) then + call mpi_alltoallv (ga_r8_s, sndlths, sdispls, mp_r8, & + ga_r8_r, rcvlths, rdispls, mp_r8, & + comm, ierror) + endif + +! local copy from receive buffer + if (rcvlths(comm_pid) .ne. 0) then + + offset_v = rdispls(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + ij = recv_bl(comm_pid+1)%displacements(j)+i + qout((m-1)*ijkr+ij) = ga_r8_r(recv_bl(comm_pid+1)%Tot_Size*(m-mbeg)+offset_v+i) + enddo + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + + endif + +! scatter data from global receive buffer to final destination + do istep=1,steps + p = swapids(istep) + + if (.not. alltoall) then + if (istep > steps-maxreqh) then + call mpi_wait( rcvids(istep), OutStats, ierr ) + endif + endif + + if (rcvlths(p) .ne. 0) then + + offset_v = rdispls(p) + do j = 1, recv_bl(p+1)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(p+1)%blocksizes(j) + ij = recv_bl(p+1)%displacements(j)+i + qout((m-1)*ijkr+ij) = ga_r8_r(recv_bl(p+1)%Tot_Size*(m-mbeg)+offset_v+i) + enddo + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + endif + enddo + +! Wait for any outstanding send requests to complete. + if (.not. alltoall .and. .not. sendd) then + call mpi_waitall( maxreqh, sndids(steps-maxreqh+1), InStats, ierr ) + endif + +! clean-up +! make used portion of storage window available for reuse + r8_win%ncall_s = r8_win%ncall_s - 1 + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_swaptrirr +# endif +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +# if defined( MOD_SPECIFIED_SHAPE ) +!BOP +! !ROUTINE: mp_sendtrirr --- Initiate communication of contiguous tracer parcels +! +! !INTERFACE: + subroutine mp_sendtrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + real(r8), intent(in) :: qin(ifirsts:ilasts,jfirsts:jlasts,kfirsts:klasts,1:mq) ! input tracer array + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(ifirstr:ilastr,jfirstr:jlastr,kfirstr:klastr,1:mq) ! output tracer array +! +! !DESCRIPTION: +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications here and placing +! wait points in mp_recvtrirr; if 1, call swap routine with p2p messages; if 2, call swap +! routine with a2a messages. +! Modc(2): if 1, then apply handshaking (don't send until corresponding receive is posted) +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! Modc(4): maximum number of outstanding requests (applies to swap routines only) +! +! !REVISION HISTORY: +! 02.08.13 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Use partneroffset +! 03.06.24 Sawyer Integrated Use_Mpi_Types; added qout +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! 09.10.07 Worley eliminated mpi_recv from handshake logic +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer ipe, qsize, offset, blocksize, nparcels, offset_s, offset_r, ierr, mod_method + integer p, mysize, nthpc, minsize, nthrd, pn, pt, tmpsize, unitsize, offset_0 + integer i, j, send_tag, recv_tag, num_s, num_r, m + integer :: offset_v (Max_Nparcels) + integer :: hs_snd, hs_rcv(numpro), hs_rcvids(numpro) + integer ipe2, ceil2num + integer numtr, numtrm + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_pid + integer ip, jp, kp, mp, ir, jr, jir, mt + + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swaptrirr unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + + if (sw_local .gt. 0) then + sw_alltoall = (sw_local .eq. 2) + call mp_swaptrirr(comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + sw_handshake=hs_local, sw_maxreq=maxreq_local, & + sw_alltoall=sw_alltoall, sw_send=send_local) + else + + call MPI_COMM_RANK (comm, comm_pid, ierr) + + hs_snd = 1 + ceil2num = ceil2(numpro) + + numtrm = mend - mbeg + numtr = numtrm + 1 + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_s = r8_win%ncall_s + 1 + if (mod_method .gt. 0) then +! +! mpi derived types + if (r8_win%ncall_s .gt. MaxTrf-numtrm) then + write(iulog,*) "mp_sendtrirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_s MaxTrf = ", r8_win%ncall_s, MaxTrf + stop + endif +! +! MPI: Irecv over all processes +! + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + if (ipe-1 /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, ipe-1, comm_pid, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + OutHandle(:,r8_win%ncall_s:r8_win%ncall_s+numtrm) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle +! +! Receive the buffers with MPI_Irecv. Non-blocking +! + if ( recv_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + recv_tag = ipe-1 + modcam_tagoffset + do m = mbeg, mend + call mpi_irecv( qout(:,:,:,m), 1, recv_bl(ipe)%type, ipe-1, recv_tag, & + comm, OutHandle(ipe,r8_win%ncall_s+m-mbeg), ierr ) + enddo + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, ipe-1, ipe-1, comm, ierr ) + endif + endif + enddo + +! +! MPI: Isend/Send over all processes; use risend/rsend with hs +! + InHandle(:,r8_win%ncall_s:r8_win%ncall_s+numtrm) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + +! +! Send the individual buffers with non-blocking sends +! + if ( send_bl(ipe)%type /= MPI_DATATYPE_NULL ) then + send_tag = comm_pid + modcam_tagoffset + if (hs_local) then + if (ipe-1 /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + do m = mbeg, mend + call mpi_rsend( qin(:,:,:,m), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + enddo + else + do m = mbeg, mend + call mpi_irsend( qin(:,:,:,m), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + enddo + endif + else + if (send_local) then + do m = mbeg, mend + call mpi_send( qin(:,:,:,m), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, ierr ) + enddo + else + do m = mbeg, mend + call mpi_isend( qin(:,:,:,m), 1, send_bl(ipe)%type, ipe-1, send_tag, & + comm, InHandle(ipe,r8_win%ncall_s), ierr ) + enddo + endif + endif + endif + enddo + else + +! temporary contiguous buffers + + jr = jlasts - jfirsts + 1 + ir = ilasts - ifirsts + 1 + jir = jr * ir + if (r8_win%ncall_s .gt. max_irr-numtrm) then + write(iulog,*) "mp_sendtrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! issue call to receive data in global receive buffer + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + offset_r = offset_0 + + if (hs_local) then + hs_rcvids(:) = MPI_REQUEST_NULL + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = numtr*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + send_tag = comm_pid + modcam_tagoffset + if (r8_win%dest /= comm_pid) & + call MPI_IRECV ( hs_rcv(ipe), 1, mp_i4, r8_win%dest, send_tag, comm, & + hs_rcvids(ipe), ierr ) + endif + enddo + endif + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = numtr*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + r8_win%src = ipe-1 + if (numtr*unitsize >= offset_r-offset_0) then + recv_tag = r8_win%src + modcam_tagoffset + qsize = r8_win%size_r + r8_win%nrecv = r8_win%nrecv + 1 + call MPI_IRECV(ga_r8_r(r8_win%offset_r+1), qsize, mp_r8, r8_win%src, & + recv_tag, comm, r8_win%rqest(r8_win%nrecv), ierror) + if (hs_local) then + if (r8_win%src /= comm_pid) & + call MPI_SEND ( hs_snd, 1, mp_i4, r8_win%src, recv_tag, comm, ierror) + endif + else + write(iulog,*) "Fatal mp_sendtrirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo +! gather data into global send buffer + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_s) cycle + qsize = numtr*send_bl(ipe)%Tot_Size + if (qsize .ne. 0) then + r8_win%dest = ipe-1 + r8_win%offset_s = offset_s + offset_s = offset_s + qsize + if (offset_s-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_sendtrirr: send window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + + offset_v(1) = r8_win%offset_s + do j = 2, send_bl(ipe)%nparcels + offset_v(j) = offset_v(j-1) + send_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, send_bl(ipe)%nparcels + do m = mbeg, mend + do i = 1, send_bl(ipe)%blocksizes(j) + mp = send_bl(ipe)%displacements(j)+i + kp = kfirsts + (mp-1)/jir + mt = (kp-kfirsts)*jir + jp = jfirsts + (mp-mt-1)/ir + ip = mp-mt - (jp-jfirsts)*ir + ifirsts-1 + ga_r8_s(send_bl(ipe)%Tot_Size*(m-mbeg)+offset_v(j)+i) = qin(ip,jp,kp,m) + enddo + enddo + enddo + +! nonblocking send + send_tag = comm_pid + modcam_tagoffset + r8_win%nsend = r8_win%nsend + 1 + if (hs_local) then + if (r8_win%dest /= comm_pid) & + call MPI_WAIT ( hs_rcvids(ipe), MPI_STATUS_IGNORE, ierr ) + if (send_local) then + call MPI_RSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_IRSEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + else + if (send_local) then + call MPI_SEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, ierr) + else + call MPI_ISEND(ga_r8_s(r8_win%offset_s+1), qsize, mp_r8, r8_win%dest, & + send_tag, comm, r8_win%sqest(r8_win%nsend), ierr) + endif + endif + endif + enddo + + endif ! mod_method + + r8_win%ncall_s = r8_win%ncall_s + numtrm + + endif ! sw_local + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + + end subroutine mp_sendtrirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_recvtrirr --- Finalize communication of contiguous tracer parcels +! +! !INTERFACE: + subroutine mp_recvtrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + modc ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + integer, optional, intent(in) :: modc(4) ! 1: classical, swap p2p, swap a2a + ! 2: handshake + ! 3: send vs isend + ! 4: max number of outstanding requests + real(r8), intent(in) :: qin(ifirsts:ilasts,jfirsts:jlasts,kfirsts:klasts,1:mq) ! input tracer array +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(ifirstr:ilastr,jfirstr:jlastr,kfirstr:klastr,1:mq) ! output tracer array +! +! !DESCRIPTION: +! Complete transfer of a generalized region initiated by {\tt mp\_sendtrirr}. +! Communicate a number of contiguous parcels to/from arbitrary set of PEs. +! Modc(1): if 0, use original approach of posting all communications in mp_sendtrirr and +! placing wait points here; otherwise don't do anything - mp_swaptrirr is called from mp_sendirr. +! Modc(3): if 1, then use blocking send; otherwise use nonblocking send +! +! !REVISION HISTORY: +! 02.08.15 Sawyer Creation +! 02.11.06 Mirin Optimizations +! 03.03.03 Sawyer Now using packed arrays for MPI2 +! 04.02.24 Mirin Various mpi2 options +! 08.09.18 Mirin Major overhaul, to include approaches from Mirin and Worley +! +!EOP +!------------------------------------------------------------------------------ +!BOC + integer :: ipe, blocksize, offset_r, mod_method + integer unitsize, offset_0 + integer Ierr + integer InStats(numpro*MPI_STATUS_SIZE) + integer OutStats(numpro*MPI_STATUS_SIZE) + integer i, j, num_r, num_s, m + integer :: offset_v (Max_Nparcels) + integer ipe2, ceil2num + integer numtr, numtrm + integer sw_local, maxreq_local + logical hs_local, send_local + logical sw_alltoall + integer comm_size, comm_pid + integer ip, jp, kp, mp, ir, jr, jir, mt + + if (present(modc)) then + sw_local = modc(1) + hs_local = (modc(2) .eq. 1) + send_local = (modc(3) .eq. 1) + maxreq_local = modc(4) + else + sw_local = 0 + hs_local = .true. + send_local = .true. + maxreq_local = -1 + endif + +! Do not call mp_swaptrirr (hence return) unless mod_method equals 0 + mod_method = recv_bl(1)%method + if (mod_method .gt. 0) sw_local = 0 + +! Return if swap_irr + if (sw_local .gt. 0) return + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + + ceil2num = ceil2(numpro) + + numtrm = mend - mbeg + numtr = numtrm + 1 + +! num_s = 0 if this processes is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this processes is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + r8_win%ncall_r = r8_win%ncall_r + 1 + + if (mod_method .gt. 0) then + +! mpi derived types + if (r8_win%ncall_r .gt. MaxTrf-numtrm) then + write(iulog,*) "mp_recvtrirr: derived type handle count exceeded - exiting" + write(iulog,*) "r8_win%ncall_r MaxTrf = ", r8_win%ncall_r, MaxTrf + stop + endif + + if (num_s .gt. 0 .and. (.not. send_local)) then + do m = mbeg, mend + CALL MPI_WAITALL( comm_size, InHandle(:,r8_win%ncall_r+m-mbeg), InStats, Ierr ) + enddo + endif + if (num_r .gt. 0) then + do m = mbeg, mend + CALL MPI_WAITALL( comm_size, OutHandle(:,r8_win%ncall_r+m-mbeg), OutStats, Ierr ) + enddo + endif + + else + +! temporary contiguous buffer / global window + + jr = jlastr - jfirstr + 1 + ir = ilastr - ifirstr + 1 + jir = jr * ir + if (r8_win%ncall_r .gt. max_irr-numtrm) then + write(iulog,*) "mp_recvtrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_r max_irr = ", r8_win%ncall_r, max_irr + stop + endif + unitsize = r8_win%size/max_irr + +! scatter data from global receive buffer to final destination + offset_0 = (r8_win%ncall_r-1)*unitsize + offset_r = offset_0 + + do ipe2=1, ceil2num + ipe = ieor(ipe2-1,comm_pid) + 1 + if (ipe .gt. num_r) cycle + r8_win%size_r = numtr*recv_bl(ipe)%Tot_Size + if (r8_win%size_r .ne. 0) then + r8_win%offset_r = offset_r + offset_r = offset_r + r8_win%size_r + if (offset_r-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_recvtrirr: receive window out of space - exiting" + write(iulog,*) 'comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + + r8_win%nread = r8_win%nread + 1 + call MPI_WAIT(r8_win%rqest(r8_win%nread), Status, ierr) + + offset_v(1) = r8_win%offset_r + do j = 2, recv_bl(ipe)%Nparcels + offset_v(j) = offset_v(j-1) + recv_bl(ipe)%blocksizes(j-1) + enddo + + do j = 1, recv_bl(ipe)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(ipe)%blocksizes(j) + mp = recv_bl(ipe)%displacements(j)+i + kp = kfirstr + (mp-1)/jir + mt = (kp-kfirstr)*jir + jp = jfirstr + (mp-mt-1)/ir + ip = mp-mt - (jp-jfirstr)*ir + ifirstr-1 + qout(ip,jp,kp,m) = ga_r8_r(recv_bl(ipe)%Tot_Size*(m-mbeg)+offset_v(j)+i) + enddo + enddo + enddo + + endif + enddo + + if ((r8_win%ncall_s == r8_win%ncall_r + numtrm) .and. (.not. send_local)) then + call MPI_WAITALL(r8_win%nsend, r8_win%sqest, Stats, ierror) + endif + + endif ! mod_method .gt. 0 + + r8_win%ncall_r = r8_win%ncall_r + numtrm + + if (r8_win%ncall_s == r8_win%ncall_r) then + r8_win%nsend = 0 + r8_win%nrecv = 0 + r8_win%nread = 0 + r8_win%ncall_s = 0 + r8_win%ncall_r = 0 + endif + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_recvtrirr +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +!BOP +! !ROUTINE: mp_swaptrirr --- Write r8 contiguous parcels to global array +! using XOR swap ordering - for multiple tracers +! +! !INTERFACE: + subroutine mp_swaptrirr ( comm, send_bl, recv_bl, qin, qout, mbeg, mend, mq, & + ifirsts, ilasts, jfirsts, jlasts, kfirsts, klasts, & + ifirstr, ilastr, jfirstr, jlastr, kfirstr, klastr, & + sw_handshake, sw_maxreq, sw_alltoall, sw_send ) + +! !INPUT PARAMETERS: + integer, intent(in) :: comm ! communicator + type(blockdescriptor), intent(in) :: send_bl(:) ! send blocks + type(blockdescriptor), intent(in) :: recv_bl(:) ! receive blocks + integer, intent(in) :: mbeg ! initial tracer index + integer, intent(in) :: mend ! final tracer index + integer, intent(in) :: mq ! total tracer indices + integer, intent(in) :: ifirsts ! first I index of source + integer, intent(in) :: ilasts ! last I index of source + integer, intent(in) :: jfirsts ! first j index of source + integer, intent(in) :: jlasts ! last j index of source + integer, intent(in) :: kfirsts ! first k index of source + integer, intent(in) :: klasts ! last k index of source + integer, intent(in) :: ifirstr ! first I index of target + integer, intent(in) :: ilastr ! last I index of target + integer, intent(in) :: jfirstr ! first j index of target + integer, intent(in) :: jlastr ! last j index of target + integer, intent(in) :: kfirstr ! first k index of target + integer, intent(in) :: klastr ! last k index of target + logical, optional, intent(in) :: sw_handshake ! use flow control and + ! ready send + integer, optional, intent(in) :: sw_maxreq ! maximum number of outstanding + ! MPI requests + logical, optional, intent(in) :: sw_alltoall ! use mpi_alltoall + logical, optional, intent(in) :: sw_send ! use mpi_send instead of isend + real(r8), intent(in) :: qin(ifirsts:ilasts,jfirsts:jlasts,kfirsts:klasts,1:mq) ! input tracer array + +! !OUTPUT PARAMETERS: + real(r8), intent(out) :: qout(ifirstr:ilastr,jfirstr:jlastr,kfirstr:klastr,1:mq) ! output tracer array +! +! !DESCRIPTION: +! +! XOR-ordered version of all-to-all communication +! +! WARNING: mod_comm parameter max_irr might need to be set larger than expected +! when swapping multiple variables; specifically, max_irr must be at least +! as large as the incoming r8_win%ncall_s + the number of variables to +! be swapped +! +! !REVISION HISTORY: +! 08.06.30 Worley original: derived from mp_sendirr, but using +! swapm logic and XOR swap order +! 08.08.22 Worley removed swapm; reimplemented with native MPI, +! added flow control/ready send option and maxreq +! throttling, added alltoall option +! +! !BUGS: +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + integer :: i, j, p, istep, num_s, num_r + integer :: comm_pid, comm_size, steps, ierr + integer :: ipe, offset_s, offset_r, offset_0, unitsize + + integer :: sndlths(0:numpro-1), sdispls(0:numpro-1) + integer :: rcvlths(0:numpro-1), rdispls(0:numpro-1) + integer :: swapids(numpro) + integer :: sndids(numpro) ! nonblocking MPI send request ids + integer :: rcvids(numpro) ! nonblocking MPI recv request ids + integer :: hs_snd, hs_rcv(numpro)! handshake variables (send/receive) + integer :: hs_rcvids(numpro) ! nonblocking MPI handshake recv request ids + integer :: InStats(numpro*MPI_STATUS_SIZE) + integer :: OutStats(numpro*MPI_STATUS_SIZE) + + integer :: offset_v + + integer :: rstep + + integer :: maxreq, maxreqh + logical :: handshake, alltoall, sendd + integer :: ip, jp, kp, mp, irs, jrs, jirs, mt + integer :: numtr, numtrm, irr, jrr, jirr, m + +#if defined( MODCM_TIMING ) + call t_startf('mod_comm communication') +#endif + + call MPI_COMM_SIZE (comm, comm_size, ierr) + call MPI_COMM_RANK (comm, comm_pid, ierr) + +! num_s = 0 if this process is not part of the sending decomposition + num_s = size(send_bl) + if (send_bl(1)%Nparcels == -1) then + num_s = 0 + endif + +! num_r = 0 if this process is not part of the receiving decomposition + num_r = size(recv_bl) + if (recv_bl(1)%Nparcels == -1) then + num_r = 0 + endif + + if ( present(sw_handshake) ) then + handshake = sw_handshake + hs_snd = 1 + else + handshake = .false. + endif + + if ( present(sw_alltoall) ) then + alltoall = sw_alltoall + else + alltoall = .false. + endif + + if ( present(sw_send) ) then + sendd = sw_send + else + sendd = .false. + endif + + numtrm = mend - mbeg + numtr = numtrm + 1 + jrs = jlasts - jfirsts + 1 + irs = ilasts - ifirsts + 1 + jirs = jrs * irs + jrr = jlastr - jfirstr + 1 + irr = ilastr - ifirstr + 1 + jirr = jrr * irr + + unitsize = r8_win%size/max_irr + +! advance to unused portion of storage window + r8_win%ncall_s = r8_win%ncall_s + 1 + + if (r8_win%ncall_s .gt. max_irr-numtrm) then + write(iulog,*) "mp_swaptrirr: insufficient window storage - exiting" + write(iulog,*) "r8_win%ncall_s max_irr = ", r8_win%ncall_s, max_irr + stop + endif + +! calculate send lengths and displacements + offset_0 = (r8_win%ncall_s-1)*unitsize + offset_s = offset_0 + sndlths(:) = 0 + sdispls(:) = 0 + do ipe=1, num_s + sndlths(ipe-1) = numtr*send_bl(ipe)%Tot_Size + sdispls(ipe-1) = offset_s + if (sndlths(ipe-1) .ne. 0) then + + offset_s = offset_s + sndlths(ipe-1) + if (offset_s-offset_0 .gt. numtr*unitsize) then + write(iulog,*) "Fatal mp_swaptrirr: send window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_s offset_0 = ', comm_pid, & + ipe, unitsize, offset_s, offset_0 + stop + endif + endif + enddo + +! calculate receive lengths and displacements + offset_r = offset_0 + rcvlths(:) = 0 + rdispls(:) = 0 + do ipe=1, num_r + rcvlths(ipe-1) = numtr*recv_bl(ipe)%Tot_Size + rdispls(ipe-1) = offset_r + if (rcvlths(ipe-1) .ne. 0) then + + offset_r = offset_r + rcvlths(ipe-1) + if (numtr*unitsize < offset_r-offset_0) then + write(iulog,*) "Fatal mp_swaptrirr: receive window out of space - exiting" + write(iulog,*) '1 comm_pid ipe unitsize offset_r offset_0 = ', comm_pid, & + ipe, unitsize, offset_r, offset_0 + stop + endif + endif + enddo + +! Calculate swap partners and number of steps in point-to-point +! implementations of alltoall algorithm. + steps = 0 + do ipe=1,ceil2(comm_size)-1 + p = pair(comm_size,ipe,comm_pid) + if (p >= 0) then + if (sndlths(p) > 0 .or. rcvlths(p) > 0) then + steps = steps + 1 + swapids(steps) = p + end if + end if + end do + + if (.not. alltoall) then + + sndids(1:steps) = MPI_REQUEST_NULL + rcvids(1:steps) = MPI_REQUEST_NULL + + if (steps .eq. 0) then + maxreq = 0 + maxreqh = 0 + elseif (steps .eq. 1) then + maxreq = 1 + maxreqh = 1 + else + if ( present(sw_maxreq) ) then + if ((sw_maxreq .le. steps) .and. (sw_maxreq .ge. 0)) then + maxreq = sw_maxreq + if (maxreq > 1) then + maxreqh = maxreq/2 + else + maxreq = 2 + maxreqh = 1 + endif + else + maxreq = steps + maxreqh = steps + endif + else + maxreq = steps + maxreqh = steps + endif + endif + +! Post initial handshake receive requests + if (handshake) then + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv ( hs_rcv(istep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(istep), ierr ) + endif + enddo + endif + +! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv ( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(istep), ierr ) + if (handshake) then + call mpi_send( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + enddo + rstep = maxreq +! + endif + +! gather data into global send buffer + do istep=1,steps + p = swapids(istep) + + if (sndlths(p) .ne. 0) then + offset_v = sdispls(p) + do j = 1, send_bl(p+1)%nparcels + do m = mbeg, mend + do i = 1, send_bl(p+1)%blocksizes(j) + mp = send_bl(p+1)%displacements(j)+i + kp = kfirsts + (mp-1)/jirs + mt = (kp-kfirsts)*jirs + jp = jfirsts + (mp-mt-1)/irs + ip = mp-mt - (jp-jfirsts)*irs + ifirsts-1 + ga_r8_s(send_bl(p+1)%Tot_Size*(m-mbeg)+offset_v+i) = qin(ip,jp,kp,m) + enddo + enddo + offset_v = offset_v + send_bl(p+1)%blocksizes(j) + enddo + endif + + if (.not. alltoall) then + +! Submit new i(r)send request + offset_s = sdispls(p)+1 + if (sndlths(p) > 0) then + if (handshake) then + call mpi_wait( hs_rcvids(istep), MPI_STATUS_IGNORE, ierr ) + if (sendd) then + call mpi_rsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_irsend( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + else + if (sendd) then + call mpi_send ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, ierr ) + else + call mpi_isend ( ga_r8_s(offset_s), sndlths(p), mp_r8, & + p, comm_pid, comm, sndids(istep), ierr ) + endif + endif + endif + + if (istep > maxreqh) then +! Wait for oldest irecv request to complete + call mpi_wait( rcvids(istep-maxreqh), OutStats, ierr ) + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + +! Submit a new handshake irecv request + if (handshake) then + if (sndlths(p) > 0) then + call mpi_irecv( hs_rcv(rstep), 1, mp_i4, p, comm_pid, comm, & + hs_rcvids(rstep), ierr ) + endif + endif + +! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( ga_r8_r(offset_r), rcvlths(p), mp_r8, & + p, p, comm, rcvids(rstep), ierr ) + if (handshake) then + call mpi_send ( hs_snd, 1, mp_i4, p, p, comm, & + ierr ) + endif + endif + endif + +! Wait for outstanding i(r)send request to complete + if (.not. sendd) then + call mpi_wait( sndids(istep-maxreqh), InStats, ierr ) + endif + endif +! + endif +! + enddo + +! local copy to send buffer + if (sndlths(comm_pid) .ne. 0) then + + offset_v = sdispls(comm_pid) + do j = 1, send_bl(comm_pid+1)%nparcels + do m = mbeg, mend + do i = 1, send_bl(comm_pid+1)%blocksizes(j) + mp = send_bl(comm_pid+1)%displacements(j)+i + kp = kfirsts + (mp-1)/jirs + mt = (kp-kfirsts)*jirs + jp = jfirsts + (mp-mt-1)/irs + ip = mp-mt - (jp-jfirsts)*irs + ifirsts-1 + ga_r8_s(send_bl(comm_pid+1)%Tot_Size*(m-mbeg)+offset_v+i) = qin(ip,jp,kp,m) + enddo + enddo + offset_v = offset_v + send_bl(comm_pid+1)%blocksizes(j) + enddo + + if (.not. alltoall) then + ga_r8_r(rdispls(comm_pid)+1:rdispls(comm_pid)+rcvlths(comm_pid)) = & + ga_r8_s(sdispls(comm_pid)+1:sdispls(comm_pid)+sndlths(comm_pid)) + endif + + endif + + if (alltoall) then + call mpi_alltoallv (ga_r8_s, sndlths, sdispls, mp_r8, & + ga_r8_r, rcvlths, rdispls, mp_r8, & + comm, ierror) + endif + +! local copy from receive buffer + if (rcvlths(comm_pid) .ne. 0) then + + offset_v = rdispls(comm_pid) + do j = 1, recv_bl(comm_pid+1)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(comm_pid+1)%blocksizes(j) + mp = recv_bl(comm_pid+1)%displacements(j)+i + kp = kfirstr + (mp-1)/jirr + mt = (kp-kfirstr)*jirr + jp = jfirstr + (mp-mt-1)/irr + ip = mp-mt - (jp-jfirstr)*irr + ifirstr-1 + qout(ip,jp,kp,m) = ga_r8_r(recv_bl(comm_pid+1)%Tot_Size*(m-mbeg)+offset_v+i) + enddo + enddo + offset_v = offset_v + recv_bl(comm_pid+1)%blocksizes(j) + enddo + + endif + +! scatter data from global receive buffer to final destination + do istep=1,steps + p = swapids(istep) + + if (.not. alltoall) then + if (istep > steps-maxreqh) then + call mpi_wait( rcvids(istep), OutStats, ierr ) + endif + endif + + if (rcvlths(p) .ne. 0) then + + offset_v = rdispls(p) + do j = 1, recv_bl(p+1)%Nparcels + do m = mbeg, mend + do i = 1, recv_bl(p+1)%blocksizes(j) + mp = recv_bl(p+1)%displacements(j)+i + kp = kfirstr + (mp-1)/jirr + mt = (kp-kfirstr)*jirr + jp = jfirstr + (mp-mt-1)/irr + ip = mp-mt - (jp-jfirstr)*irr + ifirstr-1 + qout(ip,jp,kp,m) = ga_r8_r(recv_bl(p+1)%Tot_Size*(m-mbeg)+offset_v+i) + enddo + enddo + offset_v = offset_v + recv_bl(p+1)%blocksizes(j) + enddo + + endif + enddo + +! Wait for any outstanding send requests to complete. + if (.not. alltoall .and. .not. sendd) then + call mpi_waitall( maxreqh, sndids(steps-maxreqh+1), InStats, ierr ) + endif + +! clean-up +! make used portion of storage window available for reuse + r8_win%ncall_s = r8_win%ncall_s - 1 + +#if defined( MODCM_TIMING ) + call t_stopf('mod_comm communication') +#endif + +!EOC + end subroutine mp_swaptrirr +# endif +!------------------------------------------------------------------------------ +#endif + end module mod_comm + diff --git a/src/utils/pilgrim/mp_assign_to_cpu.c b/src/utils/pilgrim/mp_assign_to_cpu.c new file mode 100644 index 0000000000..eed3d901fb --- /dev/null +++ b/src/utils/pilgrim/mp_assign_to_cpu.c @@ -0,0 +1,291 @@ +#if defined (IRIX64) && defined(PIN_CPUS) +#define SN0 1 +#define SN0XXL 1 +#define _KMEMUSER 1 + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* #include */ +#include + + +/**********************************************************************/ +/* cpuset info */ + +id_type_t +__get_current_cpuset_name(void) +{ + cpuset_request_t req; + /* cpuset_qname_t *names = (cpuset_qname_t*) &(req.csr_u.cs_qname); */ + + req.request = CPUSET_QUERY_CURRENT; + if (sysmp(MP_CPUSET, &req) == -1) { + /* Not in a cpuset */ + return -1; + } + /* return (id_type_t) (names->qname); */ + return (id_type_t) (req.csr_u.cs_qname.qname); +} + + + +int +__get_cpus_in_cpuset(id_type_t cpuset_id, cpuid_t *cpuset) +{ + cpuset_request_t req; + cpuset_queue_t* cs = (cpuset_queue_t*) &(req.csr_u.cs_queue); + + cs->queue = cpuset_id; + cs->cpuid = (uint64_t) cpuset; + + req.request = CPUSET_QUERY_CPUS; + if (sysmp(MP_CPUSET, &req)) { + fprintf(stderr, "Could not get status for cpuset 0x%llx\n", + (unsigned long long int) cpuset_id); + perror("sysmp"); + return -1; + } + + return cs->count; +} + + + +/* cpuset should already be zeroed on input +** (since we don't know how long it is, we don't do it) +*/ +int +__get_cpus_in_my_cpuset(cpuid_t *cpuset) +{ + id_type_t cpuset_name; + int count = 0; + + cpuset_name = __get_current_cpuset_name(); + if (cpuset_name != (id_type_t) -1) { + count = __get_cpus_in_cpuset(cpuset_name, cpuset); + if (count < 0) count = 0; + } + return count; +} + + + + +/*************************************************************************/ +/* nodemask info */ + +int +__get_nodes_in_my_nodemask(char *nodemask) +{ + cnodemask_t sys_nodemask; + int i, rtn_value = 0; + + bzero(&sys_nodemask, sizeof(sys_nodemask)); + + if(pmoctl(PMO_GETNODEMASK_UINT64,&sys_nodemask,sizeof(sys_nodemask)) < 0) { + perror("pmoctl(PMO_GETNODEMASK_UINT64)"); + exit(1); + } + + for (i = 0; i < MAX_COMPACT_NODES; i++) { + if (CNODEMASK_TSTB(sys_nodemask, i) != 0) { + nodemask[i] = 1; + rtn_value++; + } + } + + return rtn_value; +} + + +/**************************************************************************/ + + + + + +void +__compute_placement(int my_rank, int *cpu, int *memory) +{ + long ncpus = sysmp(MP_NPROCS); + char *nodemask = alloca((unsigned int)ncpus); + cnodeid_t *cpu_node_mapping = alloca((unsigned int)(ncpus*sizeof(cnodeid_t))); + cpuid_t *cpuset = alloca((unsigned int)(ncpus*sizeof(cpuid_t))); + int i, cpuset_size; + + *cpu = -1; + *memory = -1; + bzero(nodemask, ncpus); + bzero(cpu_node_mapping, ncpus*sizeof(cnodeid_t)); + + + /* Construct a list of the cpus assigned to this job. If we + ** are in a miser_cpuset, use that. If not, use the nodemask + ** to construct the list (all jobs always have a nodemask). + ** + ** Once constructed, simply index the list with my_rank. + ** We index from the top down, so that if the cpu list is larger + ** than the number of cpus we are actually using, the unused cpus + ** will be the smaller numbered ones. This helps the default case + ** by saving cpu-0 for last (and hopefully, not using it at all). + */ + + /* Ask the kernel for the cpu -> node mapping */ + if (sysmp(MP_NUMA_GETCPUNODEMAP, + (void *)cpu_node_mapping, sizeof(cnodeid_t) * ncpus) != 0) + { + perror("Could not get cpu->node mapping sysmp(MP_NUMA_GETCPUNODEMAP)"); + exit(1); + } + + + if ((cpuset_size = __get_cpus_in_my_cpuset(cpuset)) <= 0) { + /* not in a cpuset */ + if (__get_nodes_in_my_nodemask(nodemask) <= 0) { + fprintf(stderr, "Warning: invalid nodemask in __compute_placement\n"); + return; + } + else { + /* Make a compact list of cpus under the nodemask */ + for (i = 0, cpuset_size = 0; i < ncpus; i++) { + if (nodemask[cpu_node_mapping[i]]) { + cpuset[cpuset_size] = i; + cpuset_size++; + } + } + if (cpuset_size <= 0) { + fprintf(stderr, "Warning: No cpus found under nodemask ???\n"); + return; + } + } + } + + + if (my_rank >= cpuset_size) { + fprintf(stderr, "Warning: more mp processes than available cpus (%d)\n", + cpuset_size); + my_rank = my_rank % cpuset_size; + } + + *cpu = cpuset[my_rank]; + *memory = cpu_node_mapping[*cpu]; + +} + + + + +/* Note that this is a general routine; the cpu and the memory */ +/* do NOT need to be on the same node (although that is faster) */ +void +__place_process(int cpu_to_use, int memory_to_use) +{ + pmo_handle_t mld, mldset; + raff_info_t affinity_info; + char name[PATH_MAX+1]; + pid_t my_pid = getpid(); + int status; + + /* First, create an mld (a singleton mldset) ... */ + if((mld = mld_create(0, 16*1024)) < 0) { + perror("mld_create(0, 16*1024)"); + exit(1); + } + if ((mldset = mldset_create(&mld, 1)) < 0) { + perror("mldset_create(&mld, 1)"); + exit(1); + } + + /* ... now place the mld onto the requested node ... */ + sprintf(name, "/hw/nodenum/%d", memory_to_use); + affinity_info.resource = name; + affinity_info.reslen = (unsigned short) strlen(name); + affinity_info.restype = RAFFIDT_NAME; + affinity_info.radius = 0; + affinity_info.attr = RAFFATTR_ATTRACTION; + + status = mldset_place(mldset, TOPOLOGY_PHYSNODES, + &affinity_info, 1, RQMODE_MANDATORY); + if (status != 0) { + /* If MANDATORY fails, try again with ADVISORY */ + status = mldset_place(mldset, TOPOLOGY_PHYSNODES, + &affinity_info, 1, RQMODE_ADVISORY); + if (status != 0) { + perror("mldset_place(RQMODE_ADVISORY)"); + exit(1); + } + } + + /* ... and link the process to the mld. */ + if (process_mldlink(my_pid, mld, RQMODE_MANDATORY) < 0) { + if (process_mldlink(my_pid, mld, RQMODE_ADVISORY) < 0) { + perror("process_mldlink(RQMODE_ADVISORY)"); + exit(1); + } + } + + /* Now force the process to run on the requested cpu */ + sysmp(MP_RUNANYWHERE); /* Break any previous affinity */ + if (sysmp(MP_MUSTRUN, cpu_to_use) < 0) { + perror("sysmp(MP_MUSTRUN)"); + exit(1); + } + +} + + + + +void +__mp_assign_to_cpu(uint32_t relative_cpu) +{ + int cpu_to_use, memory_to_use; + + __compute_placement(relative_cpu, &cpu_to_use, &memory_to_use); + + if ((cpu_to_use == -1) || (memory_to_use == -1)) return; + + __place_process(cpu_to_use, memory_to_use); +} + + +/* The FORTRAN entry point */ +void +mp_assign_to_cpu_(uint32_t *relative_cpu) +{ __mp_assign_to_cpu(*relative_cpu); } + + + +void +oinker_(void) +{ + sysmp(MP_RUNANYWHERE); /* Break any previous affinity */ +} + + +void +unoinker_(void) +{ + int cpu_to_use, memory_to_use; + __compute_placement(0, &cpu_to_use, &memory_to_use); + + /* Now force the process to run on the requested cpu */ + sysmp(MP_RUNANYWHERE); /* Break any previous affinity */ + if (sysmp(MP_MUSTRUN, cpu_to_use) < 0) { + perror("sysmp(MP_MUSTRUN)"); + exit(1); + } +} +#endif diff --git a/src/utils/pilgrim/parutilitiesmodule.F90 b/src/utils/pilgrim/parutilitiesmodule.F90 new file mode 100644 index 0000000000..a746a3ef64 --- /dev/null +++ b/src/utils/pilgrim/parutilitiesmodule.F90 @@ -0,0 +1,5104 @@ +#if !defined(STAND_ALONE) +#endif +#define _SMEMORY 1 +!----------------------------------------------------------------------- +! Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!----------------------------------------------------------------------- + MODULE parutilitiesmodule +#if defined( SPMD ) +!BOP +! +! !MODULE: parutilitiesmodule +! +! !USES: +#if defined( STAND_ALONE ) +# define iulog 6 +#else + use cam_logfile, only: iulog +#endif +#if !defined(STAND_ALONE) + USE shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8, & + r4 => shr_kind_r4 +#endif + USE mod_comm, ONLY : commglobal, gid, numpro, blockdescriptor, max_nparcels +#include "debug.h" + IMPLICIT NONE +#include "mpif.h" +#include "pilgrim.h" + +! +! !PUBLIC DATA MEMBERS: + PUBLIC Gsize + PUBLIC INT4, REAL4, REAL8 + PUBLIC SUMOP, MAXOP, MINOP, BCSTOP + + + INTEGER,SAVE :: GSize ! Size of communicator CommGlobal + ! Equivalent to mod_comm::numpro +#define CPP_SUM_OP 101 +#define CPP_MAX_OP 102 +#define CPP_MIN_OP 103 +#define CPP_BCST_OP 104 + + INTEGER,SAVE :: INT4 = MPI_INTEGER + INTEGER,SAVE :: REAL4 = MPI_REAL + INTEGER,SAVE :: REAL8 = MPI_DOUBLE_PRECISION + INTEGER,SAVE :: SUMOP = MPI_SUM + INTEGER,SAVE :: MAXOP = MPI_MAX + INTEGER,SAVE :: MINOP = MPI_MIN + INTEGER,SAVE :: BCSTOP = CPP_BCST_OP + +! !PUBLIC MEMBER FUNCTIONS: + PUBLIC ParPatternType + + TYPE ParPatternType + INTEGER :: Comm ! Communicator + INTEGER :: Iam ! My rank in communicator + INTEGER :: Size ! Size of communicator + TYPE(BlockDescriptor), POINTER :: SendDesc(:) ! Array of descriptors + TYPE(BlockDescriptor), POINTER :: RecvDesc(:) ! Array of descriptors + END TYPE ParPatternType + + +#ifdef _SMEMORY + TYPE ParInfoType + INTEGER :: numRecvSeg ! number of received segments + INTEGER :: numSendSeg ! number of send segments + INTEGER :: maxNumSeg ! maximum number of segments over all processors + INTEGER :: numRecvNeigh ! number of receive neighbors + INTEGER :: numSendNeigh ! number of send neighbors + END TYPE ParInfoType +#endif + + PUBLIC ParInit, ParSplit, ParFree, ParExit + PUBLIC ParScatter, ParGather + PUBLIC ParBeginTransfer, ParEndTransfer + PUBLIC ParExchangeVector, ParCollective + PUBLIC ParPatternCreate, ParPatternFree + + INTERFACE ParPatternCreate + MODULE PROCEDURE ParPatternCopy + MODULE PROCEDURE ParPatternGhost + MODULE PROCEDURE ParPatternDecompToDecomp + MODULE PROCEDURE ParPatternDecompToGhost + MODULE PROCEDURE ParPatternGhostToDecomp + MODULE PROCEDURE ParPatternGhostToGhost + END INTERFACE + + INTERFACE ParScatter + MODULE PROCEDURE ParScatterReal + MODULE PROCEDURE ParScatterReal4 + MODULE PROCEDURE ParScatterInt + END INTERFACE + + INTERFACE ParGather + MODULE PROCEDURE ParGatherReal + MODULE PROCEDURE ParGatherReal4 + MODULE PROCEDURE ParGatherInt + END INTERFACE + + INTERFACE ParBeginTransfer + MODULE PROCEDURE ParBeginTransferReal + MODULE PROCEDURE ParBeginTransferPattern1D + MODULE PROCEDURE ParBeginTransferPattern1Dint + MODULE PROCEDURE ParBeginTransferPattern2D + MODULE PROCEDURE ParBeginTransferPattern3D + MODULE PROCEDURE ParBeginTransferPattern4D +! MODULE PROCEDURE ParBeginTransferInt + END INTERFACE + + INTERFACE ParEndTransfer + MODULE PROCEDURE ParEndTransferReal + MODULE PROCEDURE ParEndTransferPattern1D + MODULE PROCEDURE ParEndTransferPattern1Dint + MODULE PROCEDURE ParEndTransferPattern2D + MODULE PROCEDURE ParEndTransferPattern3D + MODULE PROCEDURE ParEndTransferPattern4D +! MODULE PROCEDURE ParEndTransferInt + END INTERFACE + + INTERFACE ParExchangeVector + MODULE PROCEDURE ParExchangeVectorReal + MODULE PROCEDURE ParExchangeVectorReal4 + MODULE PROCEDURE ParExchangeVectorInt + END INTERFACE + + INTERFACE ParCollective + MODULE PROCEDURE ParCollectiveBarrier + MODULE PROCEDURE ParCollective0D + MODULE PROCEDURE ParCollective1D + MODULE PROCEDURE ParCollective1DReal4 + MODULE PROCEDURE ParCollective2D + MODULE PROCEDURE ParCollective2DReal4 + MODULE PROCEDURE ParCollective3D + MODULE PROCEDURE ParCollective0DInt + MODULE PROCEDURE ParCollective0DStr + MODULE PROCEDURE ParCollective1DInt + MODULE PROCEDURE ParCollective1DStr + MODULE PROCEDURE ParCollective2DInt + END INTERFACE + +#ifdef _SMEMORY + INTERFACE ParCalcInfo + MODULE PROCEDURE ParCalcInfoDecompToGhost + MODULE PROCEDURE ParCalcInfoDecompToDecomp + MODULE PROCEDURE ParCalcInfoGhostToGhost + MODULE PROCEDURE ParCalcInfoGhostToDecomp + END INTERFACE +#endif + +! +! !DESCRIPTION: +! +! This module provides the basic utilities to support parallelism +! on a distributed or shared memory multiprocessor. +! +! \begin{center} +! \begin{tabular}{|l|l|} \hline \hline +! ParInit & Initialize the parallel system \\ \hline +! ParExit & Exit from the parallel system \\ \hline +! ParSplit & Create a Compute grid of PEs \\ \hline +! ParFree & Free a split communicator \\ \hline +! ParScatter & Scatter global slice to local slices \\ \hline +! ParGather & Gather local slices to one global \\ \hline +! ParBeginTransfer & Initiate an all-to-all packet transfer \\ \hline +! ParEndTransfer & Complete an all-to-all packet transfer \\ \hline +! ParExchangeVector & Complete an all-to-all packet transfer \\ \hline +! ParCollective & Collective operation across communicator \\ \hline +! \end{tabular} +! \end{center} +! \vspace{2mm} +! +! Other utilities can be added to this module as needs evolve. +! +! Conceptually the intention is to aggregate as many of the +! MPI communication calls as possible into a well-maintained +! module. This will help avoid the occurrence of MPI spaghetti +! code. +! +! This module is tailored to GEOS DAS and implements the +! design of Lucchesi/Mirin/Sawyer/Larson. +! +! !REVISION HISTORY: +! 97.02.01 Sawyer Creation +! 97.07.22 Sawyer Removal of DecompType related subroutines +! 97.08.13 Sawyer Added ParScatter/Gather for Integers +! 97.09.26 Sawyer Additions of Sparse communication primitives +! 97.12.01 Sawyer Changed all MPI_SSEND to MPI_ISEND +! 97.12.23 Lucchesi Added member variables IsIONode and InterComm +! 98.01.06 Sawyer Additions from RL for I/O Nodes +! 98.02.02 Sawyer Added the Cartesian data members +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.02.23 Sawyer Added ghosting utilities +! 98.02.25 Sawyer Modified interface of BeginTransfer +! 98.03.03 Sawyer Added Global ID number to public data members +! 98.03.25 Sawyer Added documentation for walkthrough +! 98.04.16 Sawyer Removed all use of MPI_CART (CommRow redefined) +! 98.07.23 Sawyer Added ParGhost, ParPoleDot; ParBegin/EndGhost out +! 98.09.15 Sawyer Added ParMerge, ParPoleGhost +! 98.09.17 Sawyer Added ParSum, removed ParPoleDot +! 99.01.18 Sawyer Minor cleaning +! 99.03.04 Sawyer Revised SHMEM concept for Transfer +! 99.04.22 Sawyer Removed COMMON for handles -- they are +! always used in same program unit. +! 99.05.21 Sawyer Reintroduced barriers in Scatter/Gather +! 99.06.03 Sawyer USE_SHMEM revisions +! 99.12.10 Sawyer ParInit now sets GID, Gsize +! 99.12.13 Sawyer Version slimmed down for FVCCM release +! 00.06.14 Sawyer Precision module now used +! 00.07.07 Sawyer Removed 2D scatter/gather; simplified API +! 00.07.30 Sawyer Full implementation with shared memory +! 00.08.09 Sawyer Replaced ParSum with ParCollective +! 00.08.28 Sawyer Moved LLNL 2D data to LLNL2DModule; new MLP impl +! 01.02.04 Sawyer Added PatternType and related routines +! 01.02.12 Sawyer Converted to free format +! 02.10.30 Sawyer Welded with mod_comm +! 03.03.06 Sawyer Fix parpatterncreate for MPI2; use MPI_DATATYPE_NULL +! 05.10.12 Worley Support for vectorization modifications in mod_comm +! 06.03.01 Sawyer Merged CAM and GEOS5 versions +! 07.01.05 Mirin Eliminated direct use of Gsize +! 07.09.04 Dennis Reduced temporary memory usage +! +! !BUGS: +! There are several MPI_Barriers at locations in the code. +! These avoid potential race conditions which probably only occur +! if the number of real processors is less than the number of +! message passing processes. Remove these barriers at your own risk +! +!EOP + + INTEGER, SAVE :: InHandle(MAX_PAX, MAX_SMP, MAX_TRF) + INTEGER, SAVE :: OutHandle(MAX_PAX,MAX_SMP, MAX_TRF) + INTEGER, SAVE :: BegTrf = 0 ! Ongoing overlapped begintransfer # + INTEGER, SAVE :: EndTrf = 0 ! Ongoing overlapped endtransfer # + LOGICAL, SAVE :: Initialized = .FALSE. ! Flag for initialization of parutilitiesmodule. + + CONTAINS +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParInit --- Initialize the parallel execution +! +! !INTERFACE: + SUBROUTINE ParInit ( Comm, npryzxy, mod_method, mod_geopk, mod_gatscat, mod_maxirr ) +! +! !USES: + USE mod_comm, ONLY : mp_init + IMPLICIT NONE +! !INPUT PARAMETERS: + INTEGER, OPTIONAL :: Comm + INTEGER, OPTIONAL, INTENT(IN) :: npryzxy(4) ! 2D decompositions + INTEGER, OPTIONAL, INTENT(IN) :: mod_method ! CAM optimization + INTEGER, OPTIONAL, INTENT(IN) :: mod_geopk ! CAM optimization + INTEGER, OPTIONAL, INTENT(IN) :: mod_gatscat ! CAM optimization + INTEGER, OPTIONAL, INTENT(IN) :: mod_maxirr ! CAM max simul. trsps. + +! +! !DESCRIPTION: +! Initializes the system. In MPI mode, call MPI\_INIT if not done +! already. If the optional arguments are not provided, default +! values will be chosen. But it is advisable to provide COMM +! (main communicator) and NPRYZXY (internal 2D decomposition). +! +! !SYSTEM ROUTINES: +! MPI_INITIALIZED, MPI_INIT +! +! !REVISION HISTORY: +! 97.03.20 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.07.03 Sawyer Reformulated documentation +! 00.07.23 Sawyer Added shared memory arena implementation +! 02.10.30 Sawyer Now uses mp_init from mod_comm +! 06.06.15 Sawyer Added CAM optimizations (passed to mod_comm) +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! Initialize mod_comm + + IF (.NOT. Initialized) THEN + CALL mp_init( Comm, npryzxy, mod_method, mod_geopk, mod_gatscat, mod_maxirr ) + Gsize = numpro ! Support PILGRIM's Gsize for now + Initialized = .TRUE. + ENDIF + + RETURN +!EOC + END SUBROUTINE ParInit +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParExit --- Finalize the parallel execution +! +! !INTERFACE: + SUBROUTINE ParExit ( Comm ) + +! !USES: + USE mod_comm, ONLY: mp_exit + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, OPTIONAL :: Comm + +! !DESCRIPTION: +! All PEs, compute nodes and IO nodes alike meet here to terminate +! themselves. If someone does not check in, everything will hang +! here. +! +! This routine is the very {\em last} thing which is executed! +! +! !LOCAL VARIABLES: + INTEGER Ierror +! +! !SYSTEM ROUTINES: +! MPI_BARRIER, MPI_FINALIZE +! +! !REVISION HISTORY: +! 97.03.20 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.07.03 Sawyer Reformulated documentation +! 00.07.23 Sawyer Added shared memory arena implementation +! 02.08.13 Sawyer Incorporated mod_comm for low level comm. +! +!EOP +!----------------------------------------------------------------------- +!BOC + CALL mp_exit(Comm) + RETURN +!EOC + END SUBROUTINE ParExit +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParSplit --- Split into group for I/O and computation +! +! !INTERFACE: + SUBROUTINE ParSplit( InComm, Color, InID, Comm, MyID, Nprocs ) +! +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator to split + INTEGER, INTENT( IN ) :: Color ! Group label + INTEGER, INTENT( IN ) :: InID ! Input ID + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Comm ! Split communicator + INTEGER, INTENT( OUT ) :: MyID ! Group label + INTEGER, INTENT( OUT ) :: Nprocs ! Number of PEs in my group +! +! !DESCRIPTION: +! This routine splits the PEs into groups. This is currently only +! supported in MPI mode. Read the chapter on MPI\_COMM\_SPLIT +! thoroughly. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SPLIT, MPI_COMM_SIZE, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.03.20 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.07.03 Sawyer Reformulated documentation +! 97.12.01 Sawyer Xnodes and Ynodes are explicit arguments +! 97.12.23 Lucchesi Added call to MPI_INTERCOMM_CREATE +! 98.01.06 Sawyer Additions from RL for I/O Nodes +! 98.02.02 Sawyer Added the Cartesian information +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.04.16 Sawyer Removed all use of MPI_CART (CommRow redefined) +! 99.01.10 Sawyer CommRow now defined for all rows +! 00.07.09 Sawyer Removed 2D computational mesh +! 00.08.08 Sawyer Redefined as wrapper to mpi_comm_split +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Ierror + + CPP_ENTER_PROCEDURE( "PARSPLIT" ) +! +! Split the communicators +! + CALL MPI_COMM_SPLIT( InComm, Color, InID, Comm, Ierror ) + IF ( Comm .ne. MPI_COMM_NULL ) THEN + CALL MPI_COMM_RANK( Comm, MyID, Ierror ) + CALL MPI_COMM_SIZE( Comm, Nprocs, Ierror ) + ELSE +! +! This PE does not participate: mark with impossible values +! + MyID = -1 + Nprocs = -1 + ENDIF + + CPP_LEAVE_PROCEDURE( "PARSPLIT" ) + RETURN +!EOC + END SUBROUTINE ParSplit +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParFree --- Free a communicator +! +! !INTERFACE: + SUBROUTINE ParFree( InComm ) +! +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER InComm + +! +! !DESCRIPTION: +! This routine frees a communicator created with ParSplit +! +! !REVISION HISTORY: +! 97.09.11 Sawyer Creation, to complement ParSplit +! 00.07.24 Sawyer Revamped ParMerge into a free communicator +! +! !LOCAL VARIABLES: + INTEGER Ierror +! +!EOP +!----------------------------------------------------------------------- +!BOC + CPP_ENTER_PROCEDURE( "PARFREE" ) +! + CALL MPI_COMM_FREE( InComm, Ierror ) + CPP_LEAVE_PROCEDURE( "PARFREE" ) + RETURN +!EOC + END SUBROUTINE ParFree +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternCopy --- Duplicate/replicate a comm pattern +! +! !INTERFACE: + SUBROUTINE ParPatternCopy( InComm, PatternIn, PatternOut, Multiplicity ) +! +! !USES: + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(ParPatternType), INTENT( IN ) :: PatternIn ! Comm Pattern + INTEGER, INTENT( IN ), OPTIONAL :: Multiplicity + +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: PatternOut ! Comm Pattern +! +! !DESCRIPTION: +! This routine duplicates a given communication pattern. +! +! Optionally a multiplicity can be added. This replicates the +! communication pattern Mult times, that is for the case that +! the data structures are replicated in the final dimension +! Mult times. A typical example is a pattern describing a 2D +! array, e.g. a a lat-lon decomposition, which will be used +! to copy a 3D lat-lon-lev array. The strides (e.g. the number +! of elements in one plane) of the source (send) and target +! (recv) arrays are now calculated internally. +! +! !SYSTEM ROUTINES: +! MPI_TYPE_UB, MPI_TYPE_HVECTOR, MPI_TYPE_COMMIT +! +! !REVISION HISTORY: +! 03.03.20 Sawyer Creation +! 03.06.26 Sawyer Removed StrideSend/Recv from API +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Stride_S, Stride_R, Mult, Iam, GroupSize, Ipe, Ierror + INTEGER Disp, Length, I, J, ub, method + + CPP_ENTER_PROCEDURE( "PARPATTERNCOPY" ) + + method = PatternIn%RecvDesc(1)%method + +! +! Decide if this is a simple copy, or a multiple replication +! + IF ( present(Multiplicity) ) THEN + Mult = Multiplicity + ELSE + Mult = 1 + ENDIF + + CALL MPI_COMM_DUP( PatternIn%Comm, PatternOut%Comm, Ierror ) + CALL MPI_COMM_SIZE( PatternIn%Comm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( PatternIn%Comm, Iam, Ierror ) + + PatternOut%Iam = Iam + PatternOut%Size = GroupSize + + ALLOCATE( PatternOut%SendDesc( GroupSize ) ) + ALLOCATE( PatternOut%RecvDesc( GroupSize ) ) + + PatternOut%SendDesc(:)%method = PatternIn%SendDesc(:)%method + PatternOut%RecvDesc(:)%method = PatternIn%RecvDesc(:)%method +! +! Determine the strides which are by construction the maximum upper +! bound of all the derived types. This is due to the fact that +! there are no 'holes' in the data types: even if one PE does not +! send to any other PEs, it will still have a data type for 'sending' +! data to itself. +! + Stride_S = 0 + Stride_R = 0 + DO Ipe=1, GroupSize + IF ( PatternIn%SendDesc(Ipe)%type /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_UB( PatternIn%SendDesc(Ipe)%type, ub, ierror ) + Stride_S = max(Stride_S,ub) + ENDIF + IF ( PatternIn%RecvDesc(Ipe)%type /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_UB( PatternIn%RecvDesc(Ipe)%type, ub, ierror ) + Stride_R = max(Stride_R,ub) + ENDIF + ENDDO + +! +! Determine the output data types +! + DO Ipe=1, GroupSize + IF ( PatternIn%SendDesc(ipe)%type /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_HVECTOR( Mult, 1, Stride_S, PatternIn%SendDesc(Ipe)%type,& + PatternOut%SendDesc(Ipe)%type, Ierror ) + CALL MPI_TYPE_COMMIT( PatternOut%SendDesc(Ipe)%type, Ierror ) + ELSE + PatternOut%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + IF ( PatternIn%RecvDesc(Ipe)%type /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_HVECTOR( Mult, 1, Stride_R, PatternIn%RecvDesc(Ipe)%type,& + PatternOut%RecvDesc(Ipe)%type, Ierror ) + CALL MPI_TYPE_COMMIT( PatternOut%RecvDesc(Ipe)%type, Ierror ) + ELSE + PatternOut%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + ENDDO + +! +! Determine the stride, which is the sum of all the blocksizes for all +! the derived types (there are no 'holes'). +! + Stride_S = 0 + Stride_R = 0 + DO Ipe=1, GroupSize + Stride_S = Stride_S + sum( PatternIn%SendDesc(ipe)%BlockSizes(:) ) + Stride_R = Stride_R + sum( PatternIn%RecvDesc(ipe)%BlockSizes(:) ) + ENDDO + + DO ipe=1, GroupSize + Length = SIZE(PatternIn%SendDesc(ipe)%BlockSizes) + ALLOCATE( PatternOut%SendDesc(ipe)%Displacements(Length*Mult) ) + ALLOCATE( PatternOut%SendDesc(ipe)%BlockSizes(Length*Mult) ) +#if defined( DEBUG_PARPATTERNCOPY ) + write(iulog,*) "Multiplicity", Mult + write(iulog,*) "Old send blocksizes", PatternIn%SendDesc(ipe)%BlockSizes +#endif + DO i=1, Length + Disp = PatternIn%SendDesc(ipe)%Displacements(i) + DO j=1, Mult + PatternOut%SendDesc(ipe)%BlockSizes(i+(j-1)*Length) = & + PatternIn%SendDesc(ipe)%BlockSizes(i) + PatternOut%SendDesc(ipe)%Displacements(i+(j-1)*Length) = Disp + Disp = Disp + Stride_S + ENDDO + ENDDO + PatternOut%SendDesc(ipe)%Nparcels = & + size (PatternOut%SendDesc(ipe)%Displacements) + PatternOut%SendDesc(ipe)%Tot_Size = & + sum (PatternOut%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, PatternOut%SendDesc(ipe)%Nparcels) +#if defined( DEBUG_PARPATTERNCOPY ) + write(iulog,*) "Send blocksizes", PatternOut%SendDesc(ipe)%BlockSizes + write(iulog,*) "Old recv blocksizes", PatternIn%RecvDesc(ipe)%BlockSizes +#endif + Length = SIZE(PatternIn%RecvDesc(ipe)%BlockSizes) + ALLOCATE( PatternOut%RecvDesc(ipe)%Displacements(Length*Mult) ) + ALLOCATE( PatternOut%RecvDesc(ipe)%BlockSizes(Length*Mult) ) + DO i=1, Length + Disp = PatternIn%RecvDesc(ipe)%Displacements(i) + DO j=1, Mult + PatternOut%RecvDesc(ipe)%BlockSizes(i+(j-1)*Length) = & + PatternIn%RecvDesc(ipe)%BlockSizes(i) + PatternOut%RecvDesc(ipe)%Displacements(i+(j-1)*Length) = Disp + Disp = Disp + Stride_R + ENDDO + ENDDO + PatternOut%RecvDesc(ipe)%Nparcels = & + size (PatternOut%RecvDesc(ipe)%Displacements) + PatternOut%RecvDesc(ipe)%Tot_Size = & + sum (PatternOut%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, PatternOut%RecvDesc(ipe)%Nparcels) +#if defined( DEBUG_PARPATTERNCOPY ) + write(iulog,*) "Recv blocksizes", PatternOut%RecvDesc(ipe)%BlockSizes +#endif + ENDDO + + CALL get_partneroffset( InComm, PatternOut%SendDesc, PatternOut%RecvDesc ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNCOPY" ) + RETURN +!EOC + END SUBROUTINE ParPatternCopy +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternGhost --- Create pattern for given ghosting +! +! !INTERFACE: + SUBROUTINE ParPatternGhost( InComm, Ghost, Pattern, mod_method, T ) +! +! !USES: + USE decompmodule, ONLY : DecompGlobalToLocal, DecompLocalToGlobal + USE ghostmodule, ONLY : GhostType, GhostInfo + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(GhostType), INTENT( IN ) :: Ghost ! # of PEs + INTEGER, INTENT( IN ), OPTIONAL :: mod_method ! contiguous or derived type + INTEGER, INTENT( IN ), OPTIONAL :: T ! + +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine contructs a communication pattern from the ghost +! region definition. That is, the resulting communication pattern +! can be used in ParBegin/EndTransfer with the ghosted arrays as +! inputs. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_COMM_DUP +! MPI_TYPE_INDEXED, MPI_TYPE_COMMIT (depending on method) +! +! !REVISION HISTORY: +! 01.02.10 Sawyer Creation +! 01.06.02 Sawyer Renamed ParPatternGhost +! 02.06.27 Sawyer Added data type "T" as optional argument +! 03.03.04 Sawyer Set partneroffsets field +! 03.11.11 Mirin Added optional argument mod_method +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER i, j, ipe, pe, Iam, GroupSize, Num, Length, Ptr, Ierror + INTEGER Global, End, Local, GlobalSize, LocalSize, BorderSize + INTEGER DataType + INTEGER, ALLOCATABLE :: InVector(:), OutVector(:) + INTEGER, ALLOCATABLE :: LenInVector(:), LenOutVector(:) + INTEGER :: method + + CPP_ENTER_PROCEDURE( "PARPATTERNGHOST" ) + + IF (present(T)) THEN + DataType = T + ELSE + DataType = CPP_MPI_REAL8 + ENDIF + + IF (present(mod_method)) THEN + method = mod_method + ELSE + method = 0 ! Default method - see mod_comm for description + ENDIF +! +! First request the needed ghost values from other processors. +! + CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + + Pattern%Iam = Iam + Pattern%Size = GroupSize + + ALLOCATE( Pattern%SendDesc( GroupSize ) ) + ALLOCATE( Pattern%RecvDesc( GroupSize ) ) + + Pattern%SendDesc(:)%method = method + Pattern%RecvDesc(:)%method = method + +! +! Temporary variables +! + ALLOCATE( LenInVector( GroupSize ) ) + ALLOCATE( LenOutVector( GroupSize ) ) + + CALL GhostInfo( Ghost,GroupSize,GlobalSize,LocalSize,BorderSize ) + ALLOCATE( InVector( 2*BorderSize ) ) + ALLOCATE( OutVector( 2*LocalSize ) ) + +! +! A rather complicated loop to define the local ghost region. +! The concept is the following: go through all the points in the +! border data structure. It contains global indices of the points +! which have to be copied over from neighboring PEs. These indices +! are collected into InVector for transmission to those PEs, in +! effect informing them of the local PEs requirements. +! +! A special case is supported: if the ghost domain wraps around +! onto the domain of the local PE! This is very tricky, because +! the index space in both Ghost%Border and Ghost%Local MUST be +! unique for DecompGlobalToLocal to work. Solution: ghost +! points are marked with the negative value of the needed domain +! value in both Ghost%Border and Ghost%Local. These are "snapped +! over" to the true global index with the ABS function, so that +! they can be subsequently found in the true local domain. +! + j = 1 + DO ipe=1, GroupSize + Num = SIZE(Ghost%Border%Head(ipe)%StartTags) + Length = 0 + DO i = 1, Num + Global = Ghost%Border%Head(ipe)%StartTags(i) + IF ( Global /= 0 ) THEN + Length = Length + 1 + End = Ghost%Border%Head(ipe)%EndTags(i) + InVector(j) = ABS(Global) + InVector(j+1) = ABS(End) + CALL DecompGlobalToLocal( Ghost%Local, Global, Local, Pe ) + OutVector(Length) = Local-1 ! Zero-based address + OutVector(Length+Num) = End - Global+1 ! Parcel size + j = j + 2 + ENDIF + ENDDO + LenInVector(ipe) = 2*Length + +! +! Set the receive buffer descriptor +! +#if defined(DEBUG_PARPATTERNGHOST) + write(iulog,*) "Iam",Iam,"Pe",Ipe-1,"Lens",OutVector(Num+1:Num+Length), & + "Displacements", OutVector(1:Length) +#endif + + IF ( Length > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Length, OutVector(Num+1), OutVector, & + DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%RecvDesc(ipe)%type = Ptr + ELSE + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Length) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Length) ) + DO i=1, Length + Pattern%RecvDesc(ipe)%Displacements(i) = OutVector(i) + Pattern%RecvDesc(ipe)%BlockSizes(i) = OutVector(Num+i) + ENDDO + Pattern%RecvDesc(ipe)%Nparcels = & + size (Pattern%RecvDesc(ipe)%Displacements) + Pattern%RecvDesc(ipe)%Tot_Size = & + sum (Pattern%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%RecvDesc(ipe)%Nparcels) + + ENDDO + +! +! Everybody exchanges the needed information +! +#if defined(DEBUG_PARPATTERNGHOST) + write(iulog,*) "iam", iam, "In", LenInVector, & + InVector( 1:SUM(LenInVector) ) +#endif + CALL ParExchangeVectorInt( InComm, LenInVector, InVector, & + LenOutVector, OutVector ) +#if defined(DEBUG_PARPATTERNGHOST) + write(iulog,*) "iam", iam, "Out", LenOutVector, & + OutVector( 1:SUM(LenOutVector) ) +#endif + +! +! Now everyone has the segments which need to be sent to the +! immediate neighbors. Save these in PatternType. +! + j = 1 + DO ipe = 1, GroupSize + Num = LenOutVector(ipe) / 2 + DO i = 1, Num + CALL DecompGlobalToLocal( Ghost%Local,OutVector(j),Local,pe ) + InVector(i) = Local-1 + InVector(i+Num) = OutVector(j+1) - OutVector(j) + 1 + j = j + 2 + ENDDO +#if defined(DEBUG_PARPATTERNGHOST) + write(iulog,*) "Iam", Iam, "To", ipe-1, "InVector", & + InVector(1:Num), "block size", InVector(Num+1:2*Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, InVector(Num+1), InVector, & + DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%SendDesc(ipe)%type = Ptr + ELSE + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%SendDesc(ipe)%Displacements(i) = InVector(i) + Pattern%SendDesc(ipe)%BlockSizes(i) = InVector(Num+i) + ENDDO + Pattern%SendDesc(ipe)%Nparcels = & + size (Pattern%SendDesc(ipe)%Displacements) + Pattern%SendDesc(ipe)%Tot_Size = & + sum (Pattern%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%SendDesc(ipe)%Nparcels) + + ENDDO + + CALL get_partneroffset( InComm, Pattern%SendDesc, Pattern%RecvDesc ) + +! +! Clean up the locally allocate variables +! + DEALLOCATE( OutVector ) + DEALLOCATE( InVector ) + DEALLOCATE( LenOutVector ) + DEALLOCATE( LenInVector ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNGHOST" ) + RETURN +!EOC + END SUBROUTINE ParPatternGhost +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternDecompToDecomp --- Create pattern between decomps +! +! !INTERFACE: + SUBROUTINE ParPatternDecompToDecomp( InComm, DA, DB, Pattern, mod_method, T ) +! +! !USES: + USE decompmodule, ONLY : DecompType, DecompGlobalToLocal, DecompInfo + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(DecompType), INTENT( IN ) :: DA ! Source Decomp Desc + TYPE(DecompType), INTENT( IN ) :: DB ! Target Decomp Desc + INTEGER, INTENT( IN ), OPTIONAL :: mod_method ! contiguous or derived type + INTEGER, INTENT( IN ), OPTIONAL :: T ! + +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine contructs a communication pattern for a +! transformation from one decomposition to another, i.e., a +! so-called "transpose". The resulting communication pattern +! can be used in ParBegin/EndTransfer with the decomposed +! arrays as inputs. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_COMM_DUP +! MPI_TYPE_INDEXED, MPI_TYPE_COMMIT (depending on method) +! +! !REVISION HISTORY: +! 01.05.29 Sawyer Creation from RedistributeCreate +! 01.07.13 Sawyer Rewritten to minimize DecompGlobalToLocal +! 02.07.16 Sawyer Added data type T +! 03.11.11 Mirin Added optional argument mod_method +! 07.03.11 Mirin Generalized to different sized decompositions +! 07.09.04 Dennis Reduced amount of temporary memory usage +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER I, J, Tag, Local, Pe, LenB, JB, Ipe, Num, Inc, Off + INTEGER Ptr ! Pointer type + INTEGER GroupSize, Iam, Ierror, DataType + INTEGER OldPe, TotalPtsA, NpesA, TotalPtsB, NpesB + INTEGER :: method + INTEGER :: nCount,maxCount,ierr,sz + INTEGER :: lenBjmd,nNeigh,maxLenB,maxNeigh +#ifdef _SMEMORY + TYPE (ParInfoType) :: Info +#endif + + INTEGER, ALLOCATABLE :: Count(:) ! # segments for each recv PE + INTEGER, ALLOCATABLE :: CountOut(:) ! # segments for each send PE + + INTEGER, ALLOCATABLE :: DisplacementsA(:) ! Generic displacements + INTEGER, ALLOCATABLE :: BlockSizesA(:) ! Generic block sizes + INTEGER, ALLOCATABLE :: LocalA(:) ! Generic Local indices + + INTEGER, ALLOCATABLE :: DisplacementsB(:) ! Displacements for B + INTEGER, ALLOCATABLE :: BlockSizesB(:) ! Block sizes for B + INTEGER, ALLOCATABLE :: LocalB(:) ! Local indices for B + INTEGER, ALLOCATABLE :: PeB(:) ! Processor element numbers + + CPP_ENTER_PROCEDURE( "PARPATTERNDECOMPTODECOMP" ) + + IF (present(T)) THEN + DataType = T + ELSE + DataType = CPP_MPI_REAL8 + ENDIF + + IF (present(mod_method)) THEN + method = mod_method + ELSE + method = 0 ! Default method - see mod_comm for description + ENDIF + +! Assume this routine is called by processes [ 0,max(NpesA,NpesB) ) + + CALL DecompInfo( DA, NpesA, TotalPtsA ) + CALL DecompInfo( DB, NpesB, TotalPtsB ) + + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror ) + +#ifdef _SMEMORY +! Calculate info about the pattern + call ParCalcInfo(InComm,DA,DB, Info) + TotalPtsA=Info%maxNumSeg + TotalPtsB=Info%maxNumSeg +#endif + + Pattern%Size = GroupSize + Pattern%Iam = Iam +! +! Allocate the number of entries and list head arrays +! + +! +! Allocate the patterns +! + ALLOCATE( Pattern%SendDesc( NpesB ) ) + Pattern%SendDesc(:)%method = method + if (iam .ge. NpesA) then + do ipe = 1, NpesB + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(1) ) + Pattern%SendDesc(ipe)%Tot_Size = -1 + Pattern%SendDesc(ipe)%Nparcels = -1 + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%SendDesc(ipe)%Displacements(1) = -1 + Pattern%SendDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + + ALLOCATE( Pattern%RecvDesc( NpesA ) ) + Pattern%RecvDesc(:)%method = method + if (iam .ge. NpesB) then + do ipe = 1, NpesA + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(1) ) + Pattern%RecvDesc(ipe)%Tot_Size = -1 + Pattern%RecvDesc(ipe)%Nparcels = -1 + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%RecvDesc(ipe)%Displacements(1) = -1 + Pattern%RecvDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + +! +! Local allocations +! + ALLOCATE( DisplacementsA( TotalPtsA ) ) ! Allocate for worst case + ALLOCATE( BlockSizesA( TotalPtsA ) ) ! Allocate for worst case + ALLOCATE( LocalA( TotalPtsA ) ) ! Allocate for worst case + + ALLOCATE( DisplacementsB( TotalPtsB ) ) ! Allocate for worst case + ALLOCATE( BlockSizesB( TotalPtsB ) ) ! Allocate for worst case + ALLOCATE( LocalB( TotalPtsB ) ) ! Allocate for worst case + ALLOCATE( PeB( TotalPtsB ) ) ! Allocate for worst case + + ALLOCATE( Count( GroupSize ) ) + ALLOCATE( CountOut( GroupSize ) ) + + JB = 0 + Count = 0 + LenB = 0 + LocalA = 0 ! (needed for parexchangevector later) + BlocksizesA = 0 ! (needed for parexchangevector later) + + Num = 0 + Inc = 0 + + if (iam .lt. NpesB) then + +! +! Parse through all the tags in the local segment + DO J = 1, SIZE( DB%Head(iam+1)%StartTags ) + OldPe = -1 ! Set PE undefined + DO Tag=DB%Head(iam+1)%StartTags(J), DB%Head(iam+1)%EndTags(J) +! +! Determine the index and PE of this entry on A. This might be inlined later +! + CALL DecompGlobalToLocal( DA, Tag, Local, Pe ) + +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + IF ( Pe /= OldPe ) THEN + OldPe = Pe + IF ( jb > 0 ) THEN + BlockSizesB(jb) = LenB + LenB = 0 + ENDIF + jb = jb+1 ! increment the segment index + DisplacementsB(jb) = Inc ! Zero-based offset of local segment + LocalB(jb) = Local-1 ! The local index (zero-based) + PeB(jb) = Pe ! Note the ID of the sender + Count(Pe+1) = Count(Pe+1)+1 ! Increment counter of segments + ENDIF + LenB = LenB+1 ! Good -- segment is getting longer + Inc = Inc+1 ! Increment local index + ENDDO + ENDDO +! +! Clean up +! + IF ( jb>0 ) BlockSizesB(jb) = LenB +#if defined(DEBUG_PARPATTERNDECOMPTODECOMP) + write(iulog,*) iam, "BlockSizes", BlockSizesB(1:jb), DisplacementsB(1:jb), PeB(1:jb), Count +#endif + + CPP_ASSERT_F90( JB .LE. TotalPtsB ) +! +! Now create the pattern from the displacements and block sizes +! + Inc = 0 + DO ipe = 1, NpesA +! +! Find the segments which are relevant for the sender ipe +! Make compact arrays BlockSizes and Displacements +! + DO j = 1, jb + IF ( PeB(j) == ipe-1 ) THEN + Inc = Inc + 1 + BlockSizesA(Inc) = BlockSizesB(j) + DisplacementsA(Inc) = DisplacementsB(j) + LocalA(Inc) = LocalB(j) + ENDIF + ENDDO + ENDDO + CPP_ASSERT_F90( Inc .LE. TotalPtsA ) + +! +! Create the receiver communication pattern +! + Off = 0 + DO ipe = 1, NpesA + Num = Count(ipe) + if(Num >0) then +#if defined(DEBUG_PARPATTERNDECOMPTODECOMP) + write(iulog,*) "Receiver Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsA(Off+1:Off+Num), & + "BlockSizes", BlockSizesA(Off+1:Off+Num) +#endif + endif + IF ( Num > 0 .and. method > 0 ) THEN + + CALL MPI_TYPE_INDEXED( Num, BlockSizesA(Off+1), & + DisplacementsA(Off+1), & + DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%RecvDesc(ipe)%type = Ptr + ELSE + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%RecvDesc(ipe)%Displacements(i) = DisplacementsA(i+Off) + Pattern%RecvDesc(ipe)%BlockSizes(i) = BlockSizesA(i+Off) + ENDDO + Pattern%RecvDesc(ipe)%Nparcels = & + size (Pattern%RecvDesc(ipe)%Displacements) + Pattern%RecvDesc(ipe)%Tot_Size = & + sum (Pattern%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%RecvDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesB) + +! +! Now communicate what the receiver is expecting from the sender +! + CALL ParExchangeVectorInt( InComm, Count, LocalA, & + CountOut, DisplacementsB ) + CALL ParExchangeVectorInt( InComm, Count, BlockSizesA, & + CountOut, BlockSizesB ) + +! +! Sender A: BlockSizes and Displacements can now be stored +! + + if (iam .lt. NpesA) then + + Off = 0 + DO ipe=1, NpesB + Num = CountOut(ipe) + if(Num>0) then +#if defined(DEBUG_PARPATTERNDECOMPTODECOMP) + write(iulog,*) "Sender Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsB(Off+1:Off+Num), & + "BlockSizes", BlockSizesB(Off+1:Off+Num) +#endif + endif + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesB(Off+1), & + DisplacementsB(Off+1), & + DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%SendDesc(ipe)%type = Ptr + ELSE + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%SendDesc(ipe)%Displacements(i) = DisplacementsB(i+Off) + Pattern%SendDesc(ipe)%BlockSizes(i) = BlockSizesB(i+Off) + ENDDO + Pattern%SendDesc(ipe)%Nparcels = & + size (Pattern%SendDesc(ipe)%Displacements) + Pattern%SendDesc(ipe)%Tot_Size = & + sum (Pattern%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%SendDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesA) + + CALL get_partneroffset( InComm, Pattern%SendDesc, Pattern%RecvDesc ) + + DEALLOCATE( CountOut ) + DEALLOCATE( Count ) + + DEALLOCATE( PeB ) + DEALLOCATE( LocalB ) + DEALLOCATE( BlockSizesB ) + DEALLOCATE( DisplacementsB ) + + DEALLOCATE( LocalA ) + DEALLOCATE( BlockSizesA ) + DEALLOCATE( DisplacementsA ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNDECOMPTODECOMP" ) + RETURN +!EOC + END SUBROUTINE ParPatternDecompToDecomp +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternDecompToGhost --- Create pattern decomp to ghost +! +! !INTERFACE: + SUBROUTINE ParPatternDecompToGhost( InComm, DA, GB, Pattern, mod_method, T ) +! +! !USES: + USE decompmodule, ONLY : DecompType, DecompGlobalToLocal, & + DecompInfo + USE ghostmodule, ONLY : GhostType, GhostInfo + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(DecompType), INTENT( IN ) :: DA ! Source Ghost Desc + TYPE(GhostType), INTENT( IN ) :: GB ! Target Ghost Desc + INTEGER, INTENT( IN ), OPTIONAL :: mod_method ! contiguous or derived type + INTEGER, INTENT( IN ), OPTIONAL :: T ! + +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine contructs a communication pattern for a transformation +! from decomposition to a ghosted decomposition, i.e., a so-called +! "transpose". The resulting communication pattern can be used in +! ParBegin/EndTransfer with the decomposed arrays as inputs. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_COMM_DUP +! MPI_TYPE_INDEXED, MPI_TYPE_COMMIT (depending on method) +! +! !REVISION HISTORY: +! 01.07.12 Sawyer Creation from ParPatternDecompToDecomp +! 02.03.20 Sawyer Bug fix: added OldLocal, increment Off +! 02.07.16 Sawyer Added data type T +! 03.11.11 Mirin Added optional argument mod_method +! 07.03.11 Mirin Generalized to different sized decompositions +! 07.09.04 Dennis Reduced amount of temporary memory usage +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER I, J, Tag, Local, Pe, LenB, JB, Ipe, Num, Inc, Off + INTEGER Ptr ! Pointer type + INTEGER GroupSize, Iam, Ierror + INTEGER OldPe, OldLocal, TotalPtsA, NpesA + INTEGER GlobalSizeB, LocalSizeB, BorderSizeB, NpesB + INTEGER DataType + INTEGER :: method + INTEGER :: nCount, maxCount, ierr +#ifdef _SMEMORY + TYPE (ParInfoType) :: Info +#endif + + INTEGER, ALLOCATABLE :: Count(:) ! # segments for each recv PE + INTEGER, ALLOCATABLE :: CountOut(:) ! # segments for each send PE + + INTEGER, ALLOCATABLE :: DisplacementsA(:) ! Generic displacements + INTEGER, ALLOCATABLE :: BlockSizesA(:) ! Generic block sizes + INTEGER, ALLOCATABLE :: LocalA(:) ! Generic Local indices + + INTEGER, ALLOCATABLE :: DisplacementsB(:) ! Displacements for B + INTEGER, ALLOCATABLE :: BlockSizesB(:) ! Block sizes for B + INTEGER, ALLOCATABLE :: LocalB(:) ! Local indices for B + INTEGER, ALLOCATABLE :: PeB(:) ! Processor element numbers + + CPP_ENTER_PROCEDURE( "PARPATTERNDECOMPTOGHOST" ) + + IF (present(T)) THEN + DataType = T + ELSE + DataType = CPP_MPI_REAL8 + ENDIF + + IF (present(mod_method)) THEN + method = mod_method + ELSE + method = 0 ! Default method - see mod_comm for description + ENDIF + +! Assume this routine is called by processes [ 0,max(NpesA,NpesB) ) + + CALL DecompInfo( DA, NpesA, TotalPtsA ) + CALL GhostInfo( GB, NpesB, GlobalSizeB, LocalSizeB, BorderSizeB ) + + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror ) + +#ifdef _SMEMORY +! Calculate info about the pattern + call ParCalcInfo(InComm,DA,GB, Info) + TotalPtsA=Info%maxNumSeg + GlobalSizeB=Info%maxNumSeg +#endif + + Pattern%Size = GroupSize + Pattern%Iam = Iam +! +! Allocate the number of entries and list head arrays +! + +! +! Allocate the patterns +! + ALLOCATE( Pattern%SendDesc( NpesB ) ) + Pattern%SendDesc(:)%method = method + if (iam .ge. NpesA) then + do ipe = 1, NpesB + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(1) ) + Pattern%SendDesc(ipe)%Tot_Size = -1 + Pattern%SendDesc(ipe)%Nparcels = -1 + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%SendDesc(ipe)%Displacements(1) = -1 + Pattern%SendDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + + ALLOCATE( Pattern%RecvDesc( NpesA ) ) + Pattern%RecvDesc(:)%method = method + if (iam .ge. NpesB) then + do ipe = 1, NpesA + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(1) ) + Pattern%RecvDesc(ipe)%Tot_Size = -1 + Pattern%RecvDesc(ipe)%Nparcels = -1 + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%RecvDesc(ipe)%Displacements(1) = -1 + Pattern%RecvDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + +! +! Local allocations +! + ALLOCATE( DisplacementsA( TotalPtsA ) ) ! Allocate for worst case + ALLOCATE( BlockSizesA( TotalPtsA ) ) ! Allocate for worst case + ALLOCATE( LocalA( TotalPtsA ) ) ! Allocate for worst case + + ALLOCATE( DisplacementsB( GlobalSizeB ) ) ! Allocate for worst case + ALLOCATE( BlockSizesB( GlobalSizeB ) ) ! Allocate for worst case + ALLOCATE( LocalB( GlobalSizeB ) ) ! Allocate for worst case + ALLOCATE( PeB( GlobalSizeB ) ) ! Allocate for worst case + + ALLOCATE( Count( GroupSize ) ) + ALLOCATE( CountOut( GroupSize ) ) + + JB = 0 + Count = 0 + LenB = 0 + LocalA = 0 ! (needed for parexchangevector later) + BlocksizesA = 0 ! (needed for parexchangevector later) + + Num = 0 + Inc = 0 + + if (iam .lt. NpesB) then + +! +! Parse through all the tags in the local segment + DO J = 1, SIZE( GB%Local%Head(iam+1)%StartTags ) + OldPe = -1 ! Set PE undefined + OldLocal = 0 ! Set local index undefined + DO Tag=GB%Local%Head(iam+1)%StartTags(J), & + GB%Local%Head(iam+1)%EndTags(J) + IF ( Tag > 0 ) THEN ! Active point +! +! Determine the index and PE of this entry on A. This might be inlined later +! + CALL DecompGlobalToLocal( DA, Tag, Local, Pe ) + +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + IF ( Pe /= OldPe .OR. Local /= OldLocal+1 ) THEN + IF ( jb > 0 ) THEN + BlockSizesB(jb) = LenB + LenB = 0 + ENDIF + jb = jb+1 ! increment the segment index + DisplacementsB(jb) = Inc ! Zero-based offset of local segment + LocalB(jb) = Local-1 ! Local indices (zero-based) + PeB(jb) = Pe ! Note the ID of the sender + Count(Pe+1) = Count(Pe+1)+1 ! Increment counter of segments + ENDIF + OldPe = Pe ! Update PE + OldLocal= Local ! Update local index + LenB = LenB+1 ! Good -- segment is getting longer + ENDIF + Inc = Inc+1 ! Increment local index + ENDDO + ENDDO +! +! Clean up +! + IF ( jb>0 ) BlockSizesB(jb) = LenB + + CPP_ASSERT_F90( JB .LE. GlobalSize ) +! +! Now create the pattern from the displacements and block sizes +! + Inc = 0 + DO ipe = 1, NpesA +! +! Find the segments which are relevant for the sender ipe +! Make compact arrays BlockSizes and Displacements +! + DO j = 1, jb + IF ( PeB(j) == ipe-1 ) THEN + Inc = Inc + 1 + BlockSizesA(Inc) = BlockSizesB(j) + DisplacementsA(Inc) = DisplacementsB(j) + LocalA(Inc) = LocalB(j) + ENDIF + ENDDO + ENDDO + + CPP_ASSERT_F90( Inc .LE. TotalPtsA ) + + Off = 0 + DO ipe = 1, NpesA + Num = Count(ipe) +#if defined( DEBUG_PARPATTERNDECOMPTOGHOST ) + write(iulog,*) "Receiver Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsA(Off+1:Off+Num), & + "BlockSizes", BlockSizesA(Off+1:Off+Num) +#endif + +! +! Create the receiver communication pattern +! + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesA(Off+1), & + DisplacementsA(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%RecvDesc(ipe)%type = Ptr + ELSE + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%RecvDesc(ipe)%Displacements(i) = DisplacementsA(i+Off) + Pattern%RecvDesc(ipe)%BlockSizes(i) = BlockSizesA(i+Off) + ENDDO + Pattern%RecvDesc(ipe)%Nparcels = & + size (Pattern%RecvDesc(ipe)%Displacements) + Pattern%RecvDesc(ipe)%Tot_Size = & + sum (Pattern%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%RecvDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesB) + +! +! Now communicate what the receiver is expecting to the sender +! + CALL ParExchangeVectorInt( InComm, Count, LocalA, & + CountOut, DisplacementsB ) + CALL ParExchangeVectorInt( InComm, Count, BlockSizesA, & + CountOut, BlockSizesB ) + +! +! Sender A: BlockSizes and Displacements can now be stored +! + + if (iam .lt. NpesA) then + + Off = 0 + DO ipe=1, NpesB + Num = CountOut(ipe) +#if defined( DEBUG_PARPATTERNDECOMPTOGHOST ) + write(iulog,*) "Sender Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsB(Off+1:Off+Num), & + "BlockSizes", BlockSizesB(Off+1:Off+Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesB(Off+1), & + DisplacementsB(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%SendDesc(ipe)%type = Ptr + ELSE + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%SendDesc(ipe)%Displacements(i) = DisplacementsB(i+Off) + Pattern%SendDesc(ipe)%BlockSizes(i) = BlockSizesB(i+Off) + ENDDO + Pattern%SendDesc(ipe)%Nparcels = & + size (Pattern%SendDesc(ipe)%Displacements) + Pattern%SendDesc(ipe)%Tot_Size = & + sum (Pattern%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%SendDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesA) + + CALL get_partneroffset( InComm, Pattern%SendDesc, Pattern%RecvDesc ) + + DEALLOCATE( CountOut ) + DEALLOCATE( Count ) + + DEALLOCATE( PeB ) + DEALLOCATE( LocalB ) + DEALLOCATE( BlockSizesB ) + DEALLOCATE( DisplacementsB ) + + DEALLOCATE( LocalA ) + DEALLOCATE( BlockSizesA ) + DEALLOCATE( DisplacementsA ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNDECOMPTOGHOST" ) + RETURN +!EOC + END SUBROUTINE ParPatternDecompToGhost +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternGhostToDecomp --- Create pattern between decomps +! +! !INTERFACE: + SUBROUTINE ParPatternGhostToDecomp( InComm, GA, DB, Pattern, mod_method, T ) +! +! !USES: + USE decompmodule, ONLY : DecompType, DecompGlobalToLocal, DecompInfo + USE ghostmodule, ONLY : GhostType, GhostInfo + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(GhostType), INTENT( IN ) :: GA ! Source Decomp Desc + TYPE(DecompType), INTENT( IN ) :: DB ! Target Decomp Desc + INTEGER, INTENT( IN ), OPTIONAL :: mod_method ! contiguous or derived type + INTEGER, INTENT( IN ), OPTIONAL :: T ! +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine contructs a communication pattern for a +! transformation from one ghosted decomposition to partitioned +! one, i.e., a so-called "transpose". The resulting communication +! pattern can be used in ParBegin/EndTransfer with the decomposed +! arrays as inputs. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_COMM_DUP +! MPI_TYPE_INDEXED, MPI_TYPE_COMMIT (depending on method) +! +! !REVISION HISTORY: +! 02.01.10 Sawyer Creation from DecompToDecomp +! 02.07.16 Sawyer Added data type T +! 03.11.11 Mirin Added optional argument mod_method +! 07.03.11 Mirin Generalized to different sized decompositions +! 07.09.04 Dennis Reduced amount of temporary memory usage +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER I, J, Tag, Local, Pe, Len, JA, Ipe, Num, Inc, Off + INTEGER NpesA, GlobalSizeA, LocalSizeA, BorderSizeA + INTEGER OldPe, OldLocal, TotalPtsB, NpesB + INTEGER GroupSize, Iam, Ierror + INTEGER Ptr ! Pointer type + INTEGER DataType + INTEGER :: method + INTEGER :: nCount, maxCount, ierr +#ifdef _SMEMORY + TYPE (ParInfoType) :: Info +#endif + + INTEGER, ALLOCATABLE :: Count(:) ! # segments for each recv PE + INTEGER, ALLOCATABLE :: CountOut(:) ! # segments for each send PE + + INTEGER, ALLOCATABLE :: DisplacementsA(:) ! Generic displacements + INTEGER, ALLOCATABLE :: BlockSizesA(:) ! Generic block sizes + INTEGER, ALLOCATABLE :: GlobalA(:) ! Generic Local indices + INTEGER, ALLOCATABLE :: PeA(:) ! Processor element numbers + + INTEGER, ALLOCATABLE :: DisplacementsB(:) ! Displacements for B + INTEGER, ALLOCATABLE :: BlockSizesB(:) ! Block sizes for B + INTEGER, ALLOCATABLE :: GlobalB(:) ! Global indices for B + + CPP_ENTER_PROCEDURE( "PARPATTERNGHOSTTODECOMP" ) + + IF (present(T)) THEN + DataType = T + ELSE + DataType = CPP_MPI_REAL8 + ENDIF + + IF (present(mod_method)) THEN + method = mod_method + ELSE + method = 0 ! Default method - see mod_comm for description + ENDIF + +! Assume this routine is called by processes [ 0,max(NpesA,NpesB) ) + + CALL GhostInfo( GA, NpesA, GlobalSizeA, LocalSizeA, BorderSizeA ) + CALL DecompInfo( DB, NpesB, TotalPtsB ) + + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror ) + +#ifdef _SMEMORY +! Calculate info about the pattern + call ParCalcInfo(InComm,GA,DB, Info) + GlobalSizeA=Info%maxNumSeg + TotalPtsB=Info%maxNumSeg +#endif + + Pattern%Size = GroupSize + Pattern%Iam = Iam +! +! Allocate the number of entries and list head arrays +! + +! +! Allocate the patterns +! + ALLOCATE( Pattern%SendDesc( NpesB ) ) + Pattern%SendDesc(:)%method = method + if (iam .ge. NpesA) then + do ipe = 1, NpesB + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(1) ) + Pattern%SendDesc(ipe)%Tot_Size = -1 + Pattern%SendDesc(ipe)%Nparcels = -1 + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%SendDesc(ipe)%Displacements(1) = -1 + Pattern%SendDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + + ALLOCATE( Pattern%RecvDesc( NpesA ) ) + Pattern%RecvDesc(:)%method = method + if (iam .ge. NpesB) then + do ipe = 1, NpesA + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(1) ) + Pattern%RecvDesc(ipe)%Tot_Size = -1 + Pattern%RecvDesc(ipe)%Nparcels = -1 + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%RecvDesc(ipe)%Displacements(1) = -1 + Pattern%RecvDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + +! +! Local allocations +! + ALLOCATE( DisplacementsA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( BlockSizesA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( GlobalA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( PeA( GlobalSizeA ) ) ! Allocate for worst case + + ALLOCATE( DisplacementsB( TotalPtsB ) ) ! Allocate for worst case + ALLOCATE( BlockSizesB( TotalPtsB ) ) ! Allocate for worst case + ALLOCATE( GlobalB( TotalPtsB ) ) ! Allocate for worst case + + ALLOCATE( Count( GroupSize ) ) + ALLOCATE( CountOut( GroupSize ) ) + + JA = 0 + Count = 0 + Len = 0 + GlobalB = 0 ! (needed for parexchangevector later) + BlockSizesB = 0 ! (needed for parexchangevector later) + + Num = 0 + Inc = 0 + + if (iam .lt. NpesB) then + +! +! Parse through all the tags in the local segment + DO J = 1, SIZE( DB%Head(iam+1)%StartTags ) + OldPe = -1 ! Set PE undefined + OldLocal = 0 ! Set index value undefined + DO Tag=DB%Head(iam+1)%StartTags(J), DB%Head(iam+1)%EndTags(J) +! +! Determine the index and PE of this entry on A. This might be inlined later +! + CALL DecompGlobalToLocal( GA%Decomp, Tag, Local, Pe ) + +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + IF ( Pe /= OldPe .OR. Local /= OldLocal+1 ) THEN + IF ( ja > 0 ) THEN + BlockSizesA(ja) = Len + Len = 0 + ENDIF + ja = ja+1 ! increment the segment index + DisplacementsA(ja) = Inc ! Zero-based offset of local segment + GlobalA(ja) = Tag ! The global tag of the desired datum + PeA(ja) = Pe ! Note the ID of the sender + Count(Pe+1) = Count(Pe+1)+1 ! Increment counter of segments + ENDIF + OldPe = Pe ! Update old PE + OldLocal = Local ! Update old local index + Len = Len+1 ! Good -- segment is getting longer + Inc = Inc+1 ! Increment local index + ENDDO + ENDDO +! +! Clean up +! + BlockSizesA(ja) = Len + CPP_ASSERT_F90( JA .LE. GlobalSizeA ) +! +! Now create the pattern from the displacements and block sizes +! + Inc = 0 + DO ipe = 1, NpesA +! +! Find the segments which are relevant for the sender ipe +! Make compact arrays BlockSizes and Displacements +! + DO j = 1, ja + IF ( PeA(j) == ipe-1 ) THEN + Inc = Inc + 1 + BlockSizesB(Inc) = BlockSizesA(j) + DisplacementsB(Inc) = DisplacementsA(j) + GlobalB(Inc) = GlobalA(j) + ENDIF + ENDDO + ENDDO + + CPP_ASSERT_F90(Inc .LE. TotalPtsB) + +! +! Create the receiver communication pattern +! + Off = 0 + DO ipe = 1, NpesA + Num = Count(ipe) +#if defined( DEBUG_PARPATTERNGHOSTTODECOMP ) + write(iulog,*) "Receiver Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsB(Off+1:Off+Num), & + "BlockSizes", BlockSizesB(Off+1:Off+Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesB(Off+1), & + DisplacementsB(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%RecvDesc(ipe)%type = Ptr + ELSE + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%RecvDesc(ipe)%Displacements(i) = DisplacementsB(i+Off) + Pattern%RecvDesc(ipe)%BlockSizes(i) = BlockSizesB(i+Off) + ENDDO + Pattern%RecvDesc(ipe)%Nparcels = & + size (Pattern%RecvDesc(ipe)%Displacements) + Pattern%RecvDesc(ipe)%Tot_Size = & + sum (Pattern%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%RecvDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesB) + +! +! Now communicate what the receiver is expecting to the sender +! + CALL ParExchangeVectorInt( InComm, Count, GlobalB, & + CountOut, GlobalA ) + CALL ParExchangeVectorInt( InComm, Count, BlockSizesB, & + CountOut, BlockSizesA ) + + if (iam .lt. NpesA) then + +! +! Sender A: BlockSizes and Displacements can now be stored +! + Off = 0 + DO ipe=1, NpesB + Num = CountOut(ipe) + DO i=1, Num + CALL DecompGlobalToLocal( GA%Local, GlobalA(i+Off), Local, Pe ) + DisplacementsA(i+Off) = Local-1 ! zero-based displacement + ENDDO +#if defined( DEBUG_PARPATTERNGHOSTTODECOMP ) + write(iulog,*) "Sender Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsA(Off+1:Off+Num), & + "BlockSizes", BlockSizesA(Off+1:Off+Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesA(Off+1), & + DisplacementsA(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%SendDesc(ipe)%type = Ptr + ELSE + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%SendDesc(ipe)%Displacements(i) = DisplacementsA(i+Off) + Pattern%SendDesc(ipe)%BlockSizes(i) = BlockSizesA(i+Off) + ENDDO + Pattern%SendDesc(ipe)%Nparcels = & + size (Pattern%SendDesc(ipe)%Displacements) + Pattern%SendDesc(ipe)%Tot_Size = & + sum (Pattern%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%SendDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesA) + + CALL get_partneroffset( InComm, Pattern%SendDesc, Pattern%RecvDesc ) + + DEALLOCATE( CountOut ) + DEALLOCATE( Count ) + + DEALLOCATE( PeA ) + DEALLOCATE( GlobalA ) + DEALLOCATE( BlockSizesA ) + DEALLOCATE( DisplacementsA ) + + DEALLOCATE( GlobalB ) + DEALLOCATE( BlockSizesB ) + DEALLOCATE( DisplacementsB ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNGHOSTTODECOMP" ) + RETURN +!EOC + END SUBROUTINE ParPatternGhostToDecomp +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternGhostToGhost --- Create pattern between decomps +! +! !INTERFACE: + SUBROUTINE ParPatternGhostToGhost( InComm, GA, GB, Pattern, mod_method, T ) +! +! !USES: + USE decompmodule, ONLY : DecompGlobalToLocal + USE ghostmodule, ONLY : GhostType, GhostInfo + USE mod_comm, ONLY : get_partneroffset + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs + TYPE(GhostType), INTENT( IN ) :: GA ! Source Ghost Decomp + TYPE(GhostType), INTENT( IN ) :: GB ! Target Ghost Decomp + INTEGER, INTENT( IN ), OPTIONAL :: mod_method ! contiguous or derived type + INTEGER, INTENT( IN ), OPTIONAL :: T ! +! !OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( OUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine contructs a communication pattern for a +! transformation from one ghosted decomposition to partitioned +! one, i.e., a so-called "transpose". The resulting communication +! pattern can be used in ParBegin/EndTransfer with the decomposed +! arrays as inputs. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_COMM_DUP +! MPI_TYPE_INDEXED, MPI_TYPE_COMMIT (depending on method) +! +! !REVISION HISTORY: +! 02.01.10 Sawyer Creation from DecompToDecomp +! 02.07.16 Sawyer Added data type T +! 03.11.11 Mirin Added optional argument mod_method +! 07.03.11 Mirin Generalized to different sized decompositions +! 07.09.04 Dennis Reduced amount of temporary memory usage +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER I, J, Tag, Local, Pe, Len, JA, Ipe, Num, Inc, Off + INTEGER NpesA, GlobalSizeA, LocalSizeA, BorderSizeA + INTEGER NpesB, GlobalSizeB, LocalSizeB, BorderSizeB + INTEGER GroupSize, Iam, Ierror, OldPe, OldLocal + INTEGER Ptr ! Pointer type + INTEGER DataType + INTEGER :: method + INTEGER :: nCount, maxCount, ierr +#ifdef _SMEMORY + TYPE (ParInfoType) :: Info +#endif + + INTEGER, ALLOCATABLE :: Count(:) ! # segments for each recv PE + INTEGER, ALLOCATABLE :: CountOut(:) ! # segments for each send PE + + INTEGER, ALLOCATABLE :: DisplacementsA(:) ! Generic displacements + INTEGER, ALLOCATABLE :: BlockSizesA(:) ! Generic block sizes + INTEGER, ALLOCATABLE :: GlobalA(:) ! Generic Local indices + INTEGER, ALLOCATABLE :: PeA(:) ! Processor element numbers + + INTEGER, ALLOCATABLE :: DisplacementsB(:) ! Displacements for B + INTEGER, ALLOCATABLE :: BlockSizesB(:) ! Block sizes for B + INTEGER, ALLOCATABLE :: GlobalB(:) ! Global indices for B + + CPP_ENTER_PROCEDURE( "PARPATTERNGHOSTTOGHOST" ) + + IF (present(T)) THEN + DataType = T + ELSE + DataType = CPP_MPI_REAL8 + ENDIF + + IF (present(mod_method)) THEN + method = mod_method + ELSE + method = 0 ! Default method - see mod_comm for description + ENDIF + +! Assume this routine is called by processes [ 0,max(NpesA,NpesB) ) + + CALL GhostInfo( GA, NpesA, GlobalSizeA, LocalSizeA, BorderSizeA ) + CALL GhostInfo( GB, NpesB, GlobalSizeB, LocalSizeB, BorderSizeB ) + + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror ) + +#ifdef _SMEMORY +! Calculate info about the pattern + call ParCalcInfo(InComm,GA,GB, Info) + GlobalSizeA=Info%maxNumSeg + GlobalSizeB=Info%maxNumSeg +#endif + + Pattern%Size = GroupSize + Pattern%Iam = Iam +! +! Allocate the number of entries and list head arrays +! + +! +! Allocate the patterns +! + ALLOCATE( Pattern%SendDesc( NpesB ) ) + Pattern%SendDesc(:)%method = method + if (iam .ge. NpesA) then + do ipe = 1, NpesB + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(1) ) + Pattern%SendDesc(ipe)%Tot_Size = -1 + Pattern%SendDesc(ipe)%Nparcels = -1 + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%SendDesc(ipe)%Displacements(1) = -1 + Pattern%SendDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + + ALLOCATE( Pattern%RecvDesc( NpesA ) ) + Pattern%RecvDesc(:)%method = method + if (iam .ge. NpesB) then + do ipe = 1, NpesA + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(1) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(1) ) + Pattern%RecvDesc(ipe)%Tot_Size = -1 + Pattern%RecvDesc(ipe)%Nparcels = -1 + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + Pattern%RecvDesc(ipe)%Displacements(1) = -1 + Pattern%RecvDesc(ipe)%Blocksizes(1) = -1 + enddo + endif + +! +! Local allocations +! + ALLOCATE( DisplacementsA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( BlockSizesA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( GlobalA( GlobalSizeA ) ) ! Allocate for worst case + ALLOCATE( PeA( GlobalSizeA ) ) ! Allocate for worst case + + ALLOCATE( DisplacementsB( GlobalSizeB ) ) ! Allocate for worst case + ALLOCATE( BlockSizesB( GlobalSizeB ) ) ! Allocate for worst case + ALLOCATE( GlobalB( GlobalSizeB ) ) ! Allocate for worst case + + ALLOCATE( Count( GroupSize ) ) + ALLOCATE( CountOut( GroupSize ) ) + + JA = 0 + Count = 0 + Len = 0 + GlobalB = 0 ! (needed for parexchangevector later) + BlocksizesB = 0 ! (needed for parexchangevector later) + + Num = 0 + Inc = 0 + + if (iam .lt. NpesB) then + +! +! Parse through all the tags in the local segment + DO J = 1, SIZE( GB%Local%Head(iam+1)%StartTags ) + OldPe = -1 ! Set PE undefined + OldLocal = 0 ! Set index value undefined + DO Tag=GB%Local%Head(iam+1)%StartTags(J), GB%Local%Head(iam+1)%EndTags(J) + IF ( Tag > 0 ) THEN ! Active point +! +! Determine the index and PE of this entry on A. This might be inlined later +! + CALL DecompGlobalToLocal( GA%Decomp, Tag, Local, Pe ) +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + IF ( Pe /= OldPe .OR. Local /= OldLocal+1 ) THEN + IF ( ja > 0 ) THEN + BlockSizesA(ja) = Len + Len = 0 + ENDIF + ja = ja+1 ! increment the segment index + DisplacementsA(ja) = Inc ! Zero-based offset of local segment + GlobalA(ja) = Tag ! The global tag of the desired datum + PeA(ja) = Pe ! Note the ID of the sender + Count(Pe+1) = Count(Pe+1)+1 ! Increment counter of segments + ENDIF + OldPe = Pe ! Update old PE + OldLocal = Local ! Update old local index + Len = Len+1 ! Good -- segment is getting longer + ENDIF + Inc = Inc+1 ! Increment local index + ENDDO + ENDDO +! +! Clean up +! + BlockSizesA(ja) = Len + + CPP_ASSERT_F90( JA .LE. GlobalSizeA ) + +! +! Now create the pattern from the displacements and block sizes +! + Inc = 0 + DO ipe = 1, NpesA +! +! Find the segments which are relevant for the sender ipe +! Make compact arrays BlockSizes and Displacements +! + DO j = 1, ja + IF ( PeA(j) == ipe-1 ) THEN + Inc = Inc + 1 + BlockSizesB(Inc) = BlockSizesA(j) + DisplacementsB(Inc) = DisplacementsA(j) + GlobalB(Inc) = GlobalA(j) + ENDIF + ENDDO + ENDDO + CPP_ASSERT_F90( Inc .LE. GlobalSizeB ) + +! +! Create the receiver communication pattern +! + Off = 0 + DO ipe = 1, NpesA + Num = Count(ipe) +#if defined(DEBUG_PARPATTERNGHOSTTOGHOST) + write(iulog,*) "Receiver Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsB(Off+1:Off+Num), & + "BlockSizes", BlockSizesB(Off+1:Off+Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesB(Off+1), & + DisplacementsB(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%RecvDesc(ipe)%type = Ptr + ELSE + Pattern%RecvDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%RecvDesc(ipe)%Displacements(i) = DisplacementsB(i+Off) + Pattern%RecvDesc(ipe)%BlockSizes(i) = BlockSizesB(i+Off) + ENDDO + Pattern%RecvDesc(ipe)%Nparcels = & + size (Pattern%RecvDesc(ipe)%Displacements) + Pattern%RecvDesc(ipe)%Tot_Size = & + sum (Pattern%RecvDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%RecvDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesB) + +! +! Now communicate what the receiver is expecting to the sender +! + CALL ParExchangeVectorInt( InComm, Count, GlobalB, & + CountOut, GlobalA ) + CALL ParExchangeVectorInt( InComm, Count, BlockSizesB, & + CountOut, BlockSizesA ) + + if (iam .lt. NpesA) then + +! +! Sender A: BlockSizes and Displacements can now be stored +! + Off = 0 + DO ipe=1, NpesB + Num = CountOut(ipe) + DO i=1, Num + CALL DecompGlobalToLocal( GA%Local, GlobalA(i+Off), Local, Pe ) + DisplacementsA(i+Off) = Local-1 ! zero-based displacement + ENDDO +#if defined(DEBUG_PARPATTERNGHOSTTOGHOST) + write(iulog,*) "Sender Iam", Iam, "Ipe", Ipe-1, "Num", Num, & + "Displacements", DisplacementsA(Off+1:Off+Num), & + "BlockSizes", BlockSizesA(Off+1:Off+Num) +#endif + + IF ( Num > 0 .and. method > 0 ) THEN + CALL MPI_TYPE_INDEXED( Num, BlockSizesA(Off+1), & + DisplacementsA(Off+1), DataType, Ptr, Ierror ) + CALL MPI_TYPE_COMMIT( Ptr, Ierror ) + Pattern%SendDesc(ipe)%type = Ptr + ELSE + Pattern%SendDesc(ipe)%type = MPI_DATATYPE_NULL + ENDIF + + ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) ) + ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) ) + DO i=1, Num + Pattern%SendDesc(ipe)%Displacements(i) = DisplacementsA(i+Off) + Pattern%SendDesc(ipe)%BlockSizes(i) = BlockSizesA(i+Off) + ENDDO + Pattern%SendDesc(ipe)%Nparcels = & + size (Pattern%SendDesc(ipe)%Displacements) + Pattern%SendDesc(ipe)%Tot_Size = & + sum (Pattern%SendDesc(ipe)%Blocksizes) + Max_Nparcels = max (Max_Nparcels, Pattern%SendDesc(ipe)%Nparcels) + + Off = Off + Num + ENDDO + + endif ! (iam .lt. NpesA) + + CALL get_partneroffset( InComm, Pattern%SendDesc, Pattern%RecvDesc ) + + + DEALLOCATE( CountOut ) + DEALLOCATE( Count ) + + DEALLOCATE( PeA ) + DEALLOCATE( GlobalA ) + DEALLOCATE( BlockSizesA ) + DEALLOCATE( DisplacementsA ) + + DEALLOCATE( GlobalB ) + DEALLOCATE( BlockSizesB ) + DEALLOCATE( DisplacementsB ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNGHOSTTOGHOST" ) + RETURN +!EOC + END SUBROUTINE ParPatternGhostToGhost +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParPatternFree --- Free the communication pattern +! +! !INTERFACE: + SUBROUTINE ParPatternFree( InComm, Pattern ) +! +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! # of PEs +! !INPUT/OUTPUT PARAMETERS: + TYPE(ParPatternType), INTENT( INOUT ) :: Pattern ! Comm Pattern +! +! !DESCRIPTION: +! This routine frees a communication pattern. +! +! !SYSTEM ROUTINES: +! MPI_TYPE_FREE +! +! !BUGS: +! The MPI_TYPE_FREE statement does not seem to work with FFC +! +! !REVISION HISTORY: +! 01.02.10 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER ipe, GroupSize, Pointer, Ierror, method + + CPP_ENTER_PROCEDURE( "PARPATTERNFREE" ) + + method = Pattern%RecvDesc(1)%method + +! +! First request the needed ghost values from other processors. +! +! Free all the MPI derived types +! + DO ipe=1, Pattern%Size + Pointer = Pattern%SendDesc(ipe)%type + IF ( Pointer /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_FREE( Pointer, Ierror ) + ENDIF + Pointer = Pattern%RecvDesc(ipe)%type + IF ( Pointer /= MPI_DATATYPE_NULL ) THEN + CALL MPI_TYPE_FREE( Pointer, Ierror ) + ENDIF + ENDDO + + DO ipe=1, size(Pattern%RecvDesc) + DEALLOCATE( Pattern%RecvDesc(ipe)%Displacements ) + DEALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes ) + ENDDO + DO ipe=1, size(Pattern%SendDesc) + DEALLOCATE( Pattern%SendDesc(ipe)%Displacements ) + DEALLOCATE( Pattern%SendDesc(ipe)%BlockSizes ) + ENDDO + + DEALLOCATE( Pattern%SendDesc ) + DEALLOCATE( Pattern%RecvDesc ) + + CPP_LEAVE_PROCEDURE( "PARPATTERNFREE" ) + RETURN +!EOC + END SUBROUTINE ParPatternFree +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParScatterReal --- Scatter slice to all PEs +! +! !INTERFACE: + SUBROUTINE ParScatterReal ( InComm, Root, Slice, Decomp, Local ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + REAL(CPP_REAL8), INTENT( IN ) :: Slice(*) ! Global Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: Local(*) ! Local Slice + +! !DESCRIPTION: +! Given a decomposition of the domain, dole out a slice +! (one-dimensional array) to all the constituent PEs as described +! by the decomposition Decomp. +! +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.30 Sawyer Stats dimension corrected: Gsize*MPI_STATUS_SIZE +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + + INTEGER Ierror, I, J, K, L, Iam, GroupSize + INTEGER Status( MPI_STATUS_SIZE ) + Integer, allocatable :: Reqs(:), Stats(:) + REAL(CPP_REAL8), ALLOCATABLE :: SendBuf(:) +! + CPP_ENTER_PROCEDURE( "PARSCATTERREAL" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + + allocate (Reqs(GroupSize)) + allocate (Stats(GroupSize*MPI_STATUS_SIZE)) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( SendBuf( SUM( Decomp%NumEntries ) ) ) + L = 0 + DO I = 1, GroupSize +! +! Pick out the array sections to be sent. +! This is the inverse of the operation in ParGather +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L+1 + SendBuf(L) = Slice(K) + ENDDO + ENDDO +! +! This is a non-blocking send. SendBuf cannot be immediately deallocated +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CALL MPI_ISEND( SendBuf(L-Decomp%NumEntries(I)+1), & + Decomp%NumEntries(I), CPP_MPI_REAL8, & + I-1, 0, InComm, Reqs(I), Ierror ) + + ENDDO + ENDIF + +! +! All receive from the root. +! +! The local array may be larger than that specified in the decomposition +! + CALL MPI_RECV( Local, Decomp%NumEntries(Iam+1), & + CPP_MPI_REAL8, & + Root, 0, InComm, Status, Ierror ) +! +! Experience shows that we should wait for all the non-blocking +! PEs to check in, EVEN THOUGH THE MPI_RECV HAS COMPLETED !! +! + IF ( Iam .EQ. Root ) THEN + CALL MPI_WAITALL( GroupSize, Reqs, Stats, Ierror ) + DEALLOCATE( SendBuf ) + ENDIF + +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PARSCATTERREAL" ) + RETURN +!EOC + END SUBROUTINE ParScatterReal +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParScatterReal4 --- Scatter slice to all PEs +! +! !INTERFACE: + SUBROUTINE ParScatterReal4 ( InComm, Root, Slice, Decomp, Local ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + REAL(CPP_REAL4), INTENT( IN ) :: Slice(*) ! Global Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL4), INTENT( OUT ) :: Local(*) ! Local Slice + +! !DESCRIPTION: +! Given a decomposition of the domain, dole out a slice +! (one-dimensional array) to all the constituent PEs as described +! by the decomposition Decomp. +! +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.30 Sawyer Stats dimension corrected: Gsize*MPI_STATUS_SIZE +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + + INTEGER Ierror, I, J, K, L, Iam, GroupSize + INTEGER Status( MPI_STATUS_SIZE ) + Integer, allocatable :: Reqs(:), Stats(:) + REAL(CPP_REAL4), ALLOCATABLE :: SendBuf(:) +! + CPP_ENTER_PROCEDURE( "PARSCATTERREAL4" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + + allocate (Reqs(GroupSize)) + allocate (Stats(GroupSize*MPI_STATUS_SIZE)) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( SendBuf( SUM( Decomp%NumEntries ) ) ) + L = 0 + DO I = 1, GroupSize +! +! Pick out the array sections to be sent. +! This is the inverse of the operation in ParGather +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L+1 + SendBuf(L) = Slice(K) + ENDDO + ENDDO +! +! This is a non-blocking send. SendBuf cannot be immediately deallocated +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CALL MPI_ISEND( SendBuf(L-Decomp%NumEntries(I)+1), & + Decomp%NumEntries(I), CPP_MPI_REAL4, & + I-1, 0, InComm, Reqs(I), Ierror ) + + ENDDO + ENDIF + +! +! All receive from the root. +! +! The local array may be larger than that specified in the decomposition +! + CALL MPI_RECV( Local, Decomp%NumEntries(Iam+1), & + CPP_MPI_REAL4, & + Root, 0, InComm, Status, Ierror ) +! +! Experience shows that we should wait for all the non-blocking +! PEs to check in, EVEN THOUGH THE MPI_RECV HAS COMPLETED !! +! + IF ( Iam .EQ. Root ) THEN + CALL MPI_WAITALL( GroupSize, Reqs, Stats, Ierror ) + DEALLOCATE( SendBuf ) + ENDIF + +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PARSCATTERREAL4" ) + RETURN +!EOC + END SUBROUTINE ParScatterReal4 +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParScatterInt --- Scatter slice to all PEs +! +! !INTERFACE: + SUBROUTINE ParScatterInt ( InComm, Root, Slice, Decomp, Local ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + INTEGER, INTENT( IN ) :: Slice(*) ! Global Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Local(*) ! Local Slice + +! !DESCRIPTION: +! Given a decomposition of the domain, dole out a slice +! (one-dimensional array) to all the constituent PEs as described +! by the decomposition Decomp. +! +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.30 Sawyer Stats dimension corrected: Gsize*MPI_STATUS_SIZE +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + + INTEGER Ierror, I, J, K, L, Iam, GroupSize + INTEGER Status( MPI_STATUS_SIZE ) + Integer, allocatable :: Reqs(:), Stats(:) + INTEGER, ALLOCATABLE :: SendBuf(:) +! + CPP_ENTER_PROCEDURE( "PARSCATTERINT" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) + + allocate (Reqs(GroupSize)) + allocate (Stats(GroupSize*MPI_STATUS_SIZE)) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( SendBuf( SUM( Decomp%NumEntries ) ) ) + L = 0 + DO I = 1, GroupSize +! +! Pick out the array sections to be sent. +! This is the inverse of the operation in ParGather +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L+1 + SendBuf(L) = Slice(K) + ENDDO + ENDDO +! +! This is a non-blocking send. SendBuf cannot be immediately deallocated +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CALL MPI_ISEND( SendBuf(L-Decomp%NumEntries(I)+1), & + Decomp%NumEntries(I), CPP_MPI_INTEGER, & + I-1, 0, InComm, Reqs(I), Ierror ) + + ENDDO + ENDIF + +! +! All receive from the root. +! +! The local array may be larger than that specified in the decomposition +! + CALL MPI_RECV( Local, Decomp%NumEntries(Iam+1), & + CPP_MPI_INTEGER, & + Root, 0, InComm, Status, Ierror ) +! +! Experience shows that we should wait for all the non-blocking +! PEs to check in, EVEN THOUGH THE MPI_RECV HAS COMPLETED !! +! + IF ( Iam .EQ. Root ) THEN + CALL MPI_WAITALL( GroupSize, Reqs, Stats, Ierror ) + DEALLOCATE( SendBuf ) + ENDIF + +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PARSCATTERINT" ) + RETURN +!EOC + END SUBROUTINE ParScatterInt +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParGatherReal --- Gather Slice from all PEs +! +! !INTERFACE: + SUBROUTINE ParGatherReal ( InComm, Root, Local, Decomp, Slice ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + REAL(CPP_REAL8), INTENT( IN ) :: Local(*) ! Local Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: Slice(*) ! Global Slice + +! !DESCRIPTION: +! Given a decomposition of the domain and a local portion of the +! total slice on each PE, gather together the portions into a +! global slice on the root PE +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.01.29 Sawyer Corrected assertions +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.31 Sawyer Stat dimension corrected: MPI_STATUS_SIZE +! 98.04.22 Sawyer Local no longer assumed shape: Local(*) +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Ierror, I, J, K, L, Iam, GroupSize, Req + INTEGER Status( MPI_STATUS_SIZE ), Stat( MPI_STATUS_SIZE ) + REAL(CPP_REAL8), ALLOCATABLE :: RecvBuf(:) +! + CPP_ENTER_PROCEDURE( "PARGATHERREAL" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) +! +! All PEs send their contribution to the root +! + CALL MPI_ISEND( Local, Decomp%NumEntries(Iam+1), & + CPP_MPI_REAL8, & + Root, Iam+3001, InComm, Req, Ierror ) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( RecvBuf( SUM( Decomp%NumEntries ) ) ) +! +! On the Root PE receive from every other PE +! + L = 0 + DO I = 1, GroupSize +! +! This is a blocking, synchronous recv. All the +! sends should have been posted so it should not deadlock +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CPP_ASSERT_F90( L .LT. SIZE( RecvBuf ) ) + CALL MPI_RECV( RecvBuf(L+1), Decomp%NumEntries(I), & + CPP_MPI_REAL8, I-1, I+3000, InComm, & + Status, Ierror ) +! +! This is the simple reverse mapping of that in ParScatter +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L + 1 + Slice(K) = RecvBuf(L) +#if defined(DEBUG_PARGATHERREAL) + PRINT *, " Entry ", L, RecvBuf(L), K, SIZE(Slice) +#endif + ENDDO + ENDDO + ENDDO + DEALLOCATE( RecvBuf ) + ENDIF + CALL MPI_WAIT( Req, Stat, Ierror ) +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + + CPP_LEAVE_PROCEDURE( "PARGATHERREAL" ) + RETURN +!EOC + END SUBROUTINE ParGatherReal +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParGatherReal4 --- Gather Slice from all PEs +! +! !INTERFACE: + SUBROUTINE ParGatherReal4 ( InComm, Root, Local, Decomp, Slice ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + REAL(CPP_REAL4), INTENT( IN ) :: Local(*) ! Local Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL4), INTENT( OUT ) :: Slice(*) ! Global Slice + +! !DESCRIPTION: +! Given a decomposition of the domain and a local portion of the +! total slice on each PE, gather together the portions into a +! global slice on the root PE +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.01.29 Sawyer Corrected assertions +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.31 Sawyer Stat dimension corrected: MPI_STATUS_SIZE +! 98.04.22 Sawyer Local no longer assumed shape: Local(*) +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Ierror, I, J, K, L, Iam, GroupSize, Req + INTEGER Status( MPI_STATUS_SIZE ), Stat( MPI_STATUS_SIZE ) + REAL(CPP_REAL4), ALLOCATABLE :: RecvBuf(:) +! + CPP_ENTER_PROCEDURE( "PARGATHERREAL4" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) +! +! All PEs send their contribution to the root +! + CALL MPI_ISEND( Local, Decomp%NumEntries(Iam+1), & + CPP_MPI_REAL4, & + Root, Iam+3001, InComm, Req, Ierror ) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( RecvBuf( SUM( Decomp%NumEntries ) ) ) +! +! On the Root PE receive from every other PE +! + L = 0 + DO I = 1, GroupSize +! +! This is a blocking, synchronous recv. All the +! sends should have been posted so it should not deadlock +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CPP_ASSERT_F90( L .LT. SIZE( RecvBuf ) ) + CALL MPI_RECV( RecvBuf(L+1), Decomp%NumEntries(I), & + CPP_MPI_REAL4, I-1, I+3000, InComm, & + Status, Ierror ) +! +! This is the simple reverse mapping of that in ParScatter +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L + 1 + Slice(K) = RecvBuf(L) +#if defined(DEBUG_PARGATHERREAL4) + PRINT *, " Entry ", L, RecvBuf(L), K, SIZE(Slice) +#endif + ENDDO + ENDDO + ENDDO + DEALLOCATE( RecvBuf ) + ENDIF + CALL MPI_WAIT( Req, Stat, Ierror ) +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + CPP_LEAVE_PROCEDURE( "PARGATHERREAL4" ) + RETURN +!EOC + END SUBROUTINE ParGatherReal4 +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParGatherInt --- Gather Slice from all PEs +! +! !INTERFACE: + SUBROUTINE ParGatherInt ( InComm, Root, Local, Decomp, Slice ) + +! !USES: + USE decompmodule, ONLY: DecompType, Lists + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Root ! Root PE + INTEGER, INTENT( IN ) :: Local(*) ! Local Slice + TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: Slice(*) ! Global Slice + +! !DESCRIPTION: +! Given a decomposition of the domain and a local portion of the +! total slice on each PE, gather together the portions into a +! global slice on the root PE +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_COMM_RANK +! +! !REVISION HISTORY: +! 97.04.14 Sawyer Creation +! 97.04.16 Sawyer Cleaned up for walk-through +! 97.05.01 Sawyer Use Decomp%Comm for all local info +! 97.05.18 Sawyer DecompType has moved to ParUtilitiesTypes +! 97.05.29 Sawyer Changed 2-D arrays to 1-D +! 97.07.03 Sawyer Reformulated documentation +! 97.07.22 Sawyer DecompType has moved to DecompModule +! 97.12.01 Sawyer Changed MPI_SSEND to MPI_ISEND +! 97.12.05 Sawyer Added InComm and Root as arguments +! 97.12.05 Sawyer Added logic to support intercommunicators +! 98.01.24 Sawyer Removed dependence on MPI derived types TESTED +! 98.01.29 Sawyer Corrected assertions +! 98.02.05 Sawyer Removed the use of intercommunicators +! 98.03.31 Sawyer Stat dimension corrected: MPI_STATUS_SIZE +! 98.04.22 Sawyer Local no longer assumed shape: Local(*) +! 99.01.19 Sawyer Dropped assumed-size arrays +! 00.07.07 Sawyer Removed "1D" references +! 00.07.23 Sawyer Implementation with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Ierror, I, J, K, L, Iam, GroupSize, Req + INTEGER Status( MPI_STATUS_SIZE ), Stat( MPI_STATUS_SIZE ) + INTEGER, ALLOCATABLE :: RecvBuf(:) +! + CPP_ENTER_PROCEDURE( "PARGATHERINT" ) +! + CALL MPI_COMM_RANK( InComm, Iam, Ierror ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror ) +! +! All PEs send their contribution to the root +! + CALL MPI_ISEND( Local, Decomp%NumEntries(Iam+1), CPP_MPI_INTEGER, & + Root, Iam+3001, InComm, Req, Ierror ) + + IF ( Iam .EQ. Root ) THEN + ALLOCATE( RecvBuf( SUM( Decomp%NumEntries ) ) ) +! +! On the Root PE receive from every other PE +! + L = 0 + DO I = 1, GroupSize +! +! This is a blocking, synchronous recv. All the +! sends should have been posted so it should not deadlock +! +! WARNING: F90-MPI inconsistency: make sure the indexing below always works +! + CPP_ASSERT_F90( L .LT. SIZE( RecvBuf ) ) + CALL MPI_RECV( RecvBuf(L+1), Decomp%NumEntries(I), & + CPP_MPI_INTEGER, I-1, I+3000, InComm, & + Status, Ierror ) +! +! This is the simple reverse mapping of that in ParScatter +! + DO J = 1, SIZE( Decomp%HEAD(I)%StartTags ) + DO K = Decomp%HEAD(I)%StartTags(J),Decomp%HEAD(I)%EndTags(J) + L = L + 1 + Slice(K) = RecvBuf(L) +#if defined(DEBUG_PARGATHERINT) + PRINT *, " Entry ", L, RecvBuf(L), K, SIZE(Slice) +#endif + ENDDO + ENDDO + ENDDO + DEALLOCATE( RecvBuf ) + ENDIF + CALL MPI_WAIT( Req, Stat, Ierror ) +! +! The following may be needed on some platforms to avoid an MPI bug. +! + CALL MPI_BARRIER( InComm, Ierror ) + + CPP_LEAVE_PROCEDURE( "PARGATHERINT" ) + RETURN +!EOC + END SUBROUTINE ParGatherInt +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferReal --- Start an ASYNC Real Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferReal(InComm, NrInPackets, NrOutPackets, & + Dest, Src, InBuf, InIA, & + OutBuf, OutIA ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: NrInPackets ! Number of in packets + INTEGER, INTENT( IN ) :: NrOutPackets ! Number of out packets + INTEGER, INTENT( IN ) :: Dest(:) ! PE destinations + INTEGER, INTENT( IN ) :: Src(:) ! PE sources + REAL(CPP_REAL8), INTENT(IN) :: InBuf(:) ! Input buffer + INTEGER, INTENT( IN ) :: InIA(:) ! In packet counter + INTEGER, INTENT( IN ) :: OutIA(:) ! Out packet counter + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: OutBuf(:) ! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf +! partitioned into parcels defined by the arrays InIA and Dest +! to an output array OutBuf on another PE. InIA(1) contains +! the number of reals to be sent to Dest(1), InIA(2) the number +! of reals to be sent to Dest(2), etc. Similarly, the array +! OutBuf on the calling PE is partitioned into parcels by OutIA +! and Src, with OutIA(1) the number of reals anticipated from +! Src(1), etc. +! +! The default implementation reads through the contiguous array +! InBuf and sends the parcels to the PEs designated with an +! asyncronous MPI\_ISEND. Correspondingly it posts the receives +! with an asynchronous MPI\_IRECV. +! +! Wait handles InHandle(:) and OutHandle(:) are in common block. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference!!!!!!!!!! +! +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! +! !SYSTEM ROUTINES: +! MPI_COMM_RANK, MPI_ISEND, MPI_IRECV +! +! !REVISION HISTORY: +! 97.09.26 Sawyer Creation +! 97.12.05 Sawyer Renamed Comm to InComm to avoid collisions +! 98.02.26 Sawyer Added Dest, Src and Remote to clean up code +! 98.04.16 Sawyer Number of packets become input arguments +! 98.09.04 Sawyer Cleaned interface: handles in common, no Remote +! 99.03.04 Sawyer Inlined ParCalculateRemote +! 99.06.01 Sawyer Changed pointer arrays to INTEGER*8 for SGI +! 00.08.07 Sawyer Implementation with shared memory arenas +! 01.09.27 Sawyer Added multiple shared buffers for USE_MLP +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + INTEGER Iam, GroupSize, Nr, Icnt, Packet, I, Ierr + + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERREAL" ) + CPP_ASSERT_F90( NrInPackets .LE. SIZE( Dest ) ) + CPP_ASSERT_F90( NrInPackets .LE. SIZE( InIA ) ) + CPP_ASSERT_F90( NrOutPackets .LE. SIZE( Src ) ) + CPP_ASSERT_F90( NrOutPackets .LE. SIZE( OutIA ) ) + +! +! Increment the ongoing transfer number + BegTrf = MOD(BegTrf,MAX_TRF) + 1 + + CALL MPI_COMM_RANK( InComm, Iam, Ierr ) + CALL MPI_COMM_SIZE( InComm, GroupSize, Ierr ) + +! +! MPI: Irecv over all processes +! + Icnt = 1 + DO Packet = 1, NrOutPackets + Nr = OutIA( Packet ) + IF ( Nr .GT. 0 ) THEN +#if defined( DEBUG_PARBEGINTRANSFERREAL ) + PRINT *, "Iam ",Iam," posts recv ",Nr," from ", Src( Packet ) +#endif +! +! Receive the buffers with MPI_Irecv. Non-blocking +! + CPP_ASSERT_F90( Icnt+Nr-1 .LE. SIZE( OutBuf ) ) + CALL MPI_IRECV( OutBuf( Icnt ), Nr, & + CPP_MPI_REAL8, Src( Packet ), Src( Packet ), & + InComm, OutHandle(Packet,1,BegTrf), Ierr ) + ELSE + OutHandle(Packet,1,BegTrf) = MPI_REQUEST_NULL + END IF + Icnt = Icnt + Nr + END DO +! +! MPI: Isend over all processes +! + Icnt = 1 + CPP_ASSERT_F90( NrInPackets .LE. SIZE( Dest ) ) + CPP_ASSERT_F90( NrInPackets .LE. SIZE( InIA ) ) + DO Packet = 1, NrInPackets + Nr = InIA( Packet ) + IF ( Nr .GT. 0 ) THEN +#if defined( DEBUG_PARBEGINTRANSFERREAL ) + PRINT *,"Iam ",Iam," posts send ",Nr," to ",Dest( Packet ) +#endif +! +! Send the individual buffers with non-blocking sends +! + CPP_ASSERT_F90( Icnt+Nr-1 .LE. SIZE( InBuf ) ) + CALL MPI_ISEND ( InBuf( Icnt ), Nr, & + CPP_MPI_REAL8, Dest( Packet ), Iam, & + InComm, InHandle(Packet,1,BegTrf), Ierr ) + ELSE + InHandle(Packet,1,BegTrf) = MPI_REQUEST_NULL + END IF + Icnt = Icnt + Nr + END DO +! +! + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERREAL" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferReal +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferPattern1D --- Start ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferPattern1D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_sendirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT( IN ) :: InBuf(*) ! Input buffer + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: OutBuf(*) ! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf. +! The communication pattern indicates the indices outgoing +! values of InBuf and incoming values for OutBuf. This routine +! is fundamentally equivalent to ParBeginTransferReal; the use +! of a communication pattern is largely a performance enhancement, +! since it eliminates the need for intermediate buffering. +! +! Wait handles InHandle and OutHandle are module variables +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.02.14 Sawyer Creation from ParBeginTransferReal +! 01.09.27 Sawyer Added multiple shared buffers for USE_MLP +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_sendirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERPATTERN1D" ) + + CALL mp_sendirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) +! + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERPATTERN1D" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferPattern1D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferPattern1Dint --- Start ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferPattern1Dint( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_sendirr_i4 + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + INTEGER, INTENT( IN ) :: InBuf(*) ! Input buffer + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: OutBuf(*) ! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf. +! The communication pattern indicates the indices outgoing +! values of InBuf and incoming values for OutBuf. This routine +! is fundamentally equivalent to ParBeginTransferReal; the use +! of a communication pattern is largely a performance enhancement, +! since it eliminates the need for intermediate buffering. +! +! Wait handles InHandle and OutHandle are module variables +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.02.14 Sawyer Creation from ParBeginTransferReal +! 01.09.27 Sawyer Added multiple shared buffers for USE_MLP +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_sendirr_i4 +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERPATTERN1DINT" ) + + CALL mp_sendirr_i4( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERPATTERN1DINT" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferPattern1Dint +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferPattern2D --- Start an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferPattern2D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_sendirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT(IN) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT(IN) :: InBuf(:,:) ! Input buffer + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT(OUT) :: OutBuf(:,:) ! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf. +! The communication pattern indicates the indices outgoing +! values of InBuf and incoming values for OutBuf. This routine +! is fundamentally equivalent to ParBeginTransferReal; the use +! of a communication pattern is largely a performance enhancement, +! since it eliminates the need for intermediate buffering. +! +! Wait handles InHandle and OutHandle are module variables +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! !REVISION HISTORY: +! 01.10.01 Sawyer Creation from ParBeginTransferPattern +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_sendirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERPATTERN2D" ) + + CALL mp_sendirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERPATTERN2D" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferPattern2D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferPattern3D --- Start an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferPattern3D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_sendirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT(IN) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT(IN) :: InBuf(:,:,:) ! Input buffer + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT(OUT) :: OutBuf(:,:,:)! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf. +! The communication pattern indicates the indices outgoing +! values of InBuf and incoming values for OutBuf. This routine +! is fundamentally equivalent to ParBeginTransferReal; the use +! of a communication pattern is largely a performance enhancement, +! since it eliminates the need for intermediate buffering. +! +! Wait handles InHandle and OutHandle are module variables +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! !REVISION HISTORY: +! 01.10.01 Sawyer Creation from ParBeginTransferPattern +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_sendirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERPATTERN3D" ) + + CALL mp_sendirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERPATTERN3D" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferPattern3D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParBeginTransferPattern4D --- Start an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParBeginTransferPattern4D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_sendirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT(IN) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT(IN) :: InBuf(:,:,:,:) ! Input buffer + +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT(OUT) :: OutBuf(:,:,:,:)! Output buffer + +! !DESCRIPTION: +! +! This routine initiates an async. transfer of an array InBuf. +! The communication pattern indicates the indices outgoing +! values of InBuf and incoming values for OutBuf. This routine +! is fundamentally equivalent to ParBeginTransferReal; the use +! of a communication pattern is largely a performance enhancement, +! since it eliminates the need for intermediate buffering. +! +! Wait handles InHandle and OutHandle are module variables +! The buffers may not be accessed until after the call to +! ParEndTransferReal. +! +! !REVISION HISTORY: +! 02.12.19 Sawyer Creation from ParBeginTransferPattern +! 03.06.24 Sawyer All complexity now in mp_sendirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARBEGINTRANSFERPATTERN4D" ) + + CALL mp_sendirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARBEGINTRANSFERPATTERN4D" ) + RETURN +!EOC + END SUBROUTINE ParBeginTransferPattern4D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferReal --- Complete an ASYNC Real Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferReal( InComm, NrInPackets, NrOutPackets, & + Dest, Src, InBuf, InIA, & + OutBuf, OutIA ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: NrInPackets ! Number of in packets + INTEGER, INTENT( IN ) :: NrOutPackets ! Number of out packets + INTEGER, INTENT( IN ) :: Dest(:) ! PE destinations + INTEGER, INTENT( IN ) :: Src(:) ! PE sources + REAL(CPP_REAL8), INTENT(IN) :: InBuf(:) ! Input buffer + INTEGER, INTENT( IN ) :: InIA(:) ! Pointer array + INTEGER, INTENT( IN ) :: OutIA(:) ! Pointer array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: OutBuf(:)! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array +! partitioned into parcels defined by the array InIA. In the +! MPI version, neither InBuf nor OutBuf is not used since +! that information was utilized in ParBeginTransferReal. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference! The buffers may not be accessed until after the +! completion of ParEndTransferReal. +! +! +! !SYSTEM ROUTINES: +! MPI_COMM_RANK, MPI_ISEND, MPI_IRECV +! +! !REVISION HISTORY: +! 97.09.26 Sawyer Creation +! 97.12.05 Sawyer Renamed Comm to InComm to avoid collisions +! 98.02.26 Sawyer Count through packets, not PEs +! 98.04.16 Sawyer Number of packets become input arguments +! 98.09.04 Sawyer Cleaned interface: handles in common +! 99.03.05 Sawyer Support for contiguous communicators in SHMEM +! 99.04.22 Sawyer Bug fix: replaced MPI_WAIT with MPI_WAITALL +! 99.06.03 Sawyer Bug fix: GroupSize in SHMEM_BARRIER +! 00.07.28 Sawyer Implemented with shared memory arenas +! 01.09.27 Sawyer Added multiple shared buffers for USE_MLP +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER Iam, GroupSize, J, Offset, Packet, Ierr + INTEGER InStats(NrInPackets*MPI_STATUS_SIZE) + INTEGER OutStats(NrOutPackets*MPI_STATUS_SIZE) + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERREAL" ) + +! +! Increment the receiver + EndTrf = MOD(EndTrf,MAX_TRF)+1 + + CPP_ASSERT_F90( NrInPackets .LE. MAX_PAX ) + CALL MPI_WAITALL( NrInPackets, InHandle(:,1,EndTrf), InStats, Ierr ) + + CPP_ASSERT_F90( NrOutPackets .LE. MAX_PAX ) + CALL MPI_WAITALL( NrOutPackets, OutHandle(:,1,EndTrf), OutStats, Ierr ) +! +! WS 98.09.22 : This barrier needed to synchronize. +! + CALL MPI_BARRIER( InComm, Ierr ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERREAL" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferReal +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferPattern1D --- Complete ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferPattern1D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_recvirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT( IN ) :: InBuf(*) ! Input buffer + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: OutBuf(*) ! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array communicated +! with a communication pattern. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! The buffers may not be accessed until after the +! completion of ParEndTransfer. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.02.14 Sawyer Creation from ParEndTransferReal +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_recvirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERPATTERN1D" ) + + CALL mp_recvirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERPATTERN1D" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferPattern1D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferPattern1Dint --- Complete ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferPattern1Dint( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_recvirr_i4 + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + INTEGER, INTENT( IN ) :: InBuf(*) ! Input buffer + +! !INPUT/OUTPUT PARAMETERS: + INTEGER, INTENT( INOUT ) :: OutBuf(*) ! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array communicated +! with a communication pattern. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! The buffers may not be accessed until after the +! completion of ParEndTransfer. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.02.14 Sawyer Creation from ParEndTransferReal +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_recvirr_i4 +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERPATTERN1DINT" ) + + CALL mp_recvirr_i4( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERPATTERN1DINT" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferPattern1Dint +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferPattern2D --- Complete an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferPattern2D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_recvirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT( IN ) :: InBuf(:,:) ! Input buffer + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: OutBuf(:,:) ! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array communicated +! with a communication pattern. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! The buffers may not be accessed until after the +! completion of ParEndTransfer. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.10.01 Sawyer Creation from ParEndTransferPattern +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_recvirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERPATTERN2D" ) + + CALL mp_recvirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf(:,:),OutBuf(:,:) ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERPATTERN2D" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferPattern2D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferPattern3D --- Complete an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferPattern3D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_recvirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT( IN ) :: InBuf(:,:,:) ! Input buffer + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: OutBuf(:,:,:) ! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array communicated +! with a communication pattern. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! The buffers may not be accessed until after the +! completion of ParEndTransfer. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 01.10.01 Sawyer Creation from ParEndTransferPattern +! 02.08.13 Sawyer Now uses mod_comm unless Use_Mpi_Types +! 03.06.24 Sawyer All complexity now in mp_recvirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERPATTERN3D" ) + + CALL mp_recvirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf(:,:,:),OutBuf(:,:,:) ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERPATTERN3D" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferPattern3D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParEndTransferPattern4D --- Complete an ASYNC Pattern Transfer +! +! !INTERFACE: + SUBROUTINE ParEndTransferPattern4D( InComm, Pattern, InBuf, OutBuf ) + +! !USES: + USE mod_comm, ONLY : mp_recvirr + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + TYPE (ParPatternType), INTENT( IN ) :: Pattern ! Comm Pattern + REAL(CPP_REAL8), INTENT( IN ) :: InBuf(:,:,:,:) ! Input buffer + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: OutBuf(:,:,:,:)! Output buffer + +! !DESCRIPTION: +! +! This routine completes an async. transfer of an array communicated +! with a communication pattern. +! +! The link between StartTransfer and EndTransfer is made possible +! by the InHandle and OutHandle: they reflect the status of +! the ongoing transfer. When this routine completes, a valid +! and accessible copy of the OutBuf is ready for use. +! The buffers may not be accessed until after the +! completion of ParEndTransfer. +! +! !BUGS: +! +! It is assumed that the buffers are passed to this routine by +! reference. +! +! !REVISION HISTORY: +! 02.12.19 Sawyer Creation from ParEndTransferPattern +! 03.06.24 Sawyer All complexity now in mp_recvirr +! +!EOP +!----------------------------------------------------------------------- +!BOC + + CPP_ENTER_PROCEDURE( "PARENDTRANSFERPATTERN4D" ) + + CALL mp_recvirr( InComm,Pattern%SendDesc,Pattern%RecvDesc,InBuf,OutBuf ) + + CPP_LEAVE_PROCEDURE( "PARENDTRANSFERPATTERN4D" ) + RETURN +!EOC + END SUBROUTINE ParEndTransferPattern4D +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParExchangeVectorReal --- Exchange a sparse packed vector +! +! !INTERFACE: + SUBROUTINE ParExchangeVectorReal ( InComm, LenInVector, InVector, & + LenOutVector, OutVector ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: LenInVector( * ) ! Length on each PE + REAL(CPP_REAL8), INTENT( IN ):: InVector( * ) ! The input buffer + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: LenOutVector( * ) ! Length on each PE + REAL(CPP_REAL8), INTENT( OUT ) :: OutVector( * ) ! The output buffer + +! !DESCRIPTION: +! +! This routine exchanges vectors stored in compressed format, i.e., +! in so-called compressed sparse row (CSR) format, with other +! PEs. In essence it first exchanges the lengths with +! MPI\_Alltoall, then the exchange of the actual vectors (can be +! different in size) using MPI\_AlltoallV. Since the latter is +! inefficient, it is simulated using MPI\_Isend and MPI\_Recv. +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_WAITALL, MPI_ALLTOALL +! +! !REVISION HISTORY: +! 98.03.17 Sawyer Creation from F77 version +! 98.03.30 Sawyer Removed assumed shape arrays due to problems +! 99.01.18 Sawyer Added barrier for safety +! 99.03.08 Sawyer USE_SHMEM version for CRAY only; untested +! 99.06.01 Sawyer USE_SHMEM version revised per comments from Tom +! 00.07.28 Sawyer Implemented with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: i, iscnt, ircnt, nr, pe, icnt, Nsize, Iam, Ierr + INTEGER :: Status(MPI_STATUS_SIZE) + Integer, allocatable :: Reqs(:), Stats(:) + + CPP_ENTER_PROCEDURE( "PAREXCHANGEVECTORREAL" ) + + CALL MPI_COMM_SIZE( InComm, Nsize, Ierr ) + CALL MPI_COMM_RANK( InComm, Iam, Ierr ) + + allocate (Reqs(Nsize)) + allocate (Stats(Nsize*MPI_STATUS_SIZE)) + +#if defined( MY_ALLTOALL ) + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + CALL MPI_ISEND( nr, 1, CPP_MPI_INTEGER, pe, Iam+3000, & + InComm, Reqs( pe+1 ), Ierr ) + ENDDO + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + CALL MPI_RECV( nr, 1, CPP_MPI_INTEGER, pe, pe+3000, & + InComm, Status, Ierr ) + LenOutVector(pe + 1) = nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) +#else + CALL MPI_ALLTOALL( LenInVector, 1, CPP_MPI_INTEGER, & + LenOutVector, 1, CPP_MPI_INTEGER, & + InComm, Ierr ) +#endif +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + IF ( nr .gt. 0 ) THEN + CALL MPI_ISEND( InVector( icnt ), nr, & + CPP_MPI_REAL8, pe, Iam+2000, & + InComm, Reqs( pe+1 ), Ierr ) + ELSE + Reqs( pe+1 ) = MPI_REQUEST_NULL + ENDIF + icnt = icnt + nr + ENDDO + +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + nr = LenOutVector(pe + 1) + IF ( nr .gt. 0 ) THEN + CALL MPI_RECV( OutVector( icnt ), nr, & + CPP_MPI_REAL8, pe, pe+2000, & + InComm, Status, Ierr ) + ENDIF + icnt = icnt + nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PAREXCHANGEVECTORREAL" ) + + RETURN +!EOC + END SUBROUTINE ParExchangeVectorReal +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParExchangeVectorReal4 --- Exchange a sparse packed vector +! +! !INTERFACE: + SUBROUTINE ParExchangeVectorReal4 ( InComm, LenInVector, InVector,& + LenOutVector, OutVector ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: LenInVector( * ) ! Length on each PE + REAL(CPP_REAL4), INTENT( IN ):: InVector( * ) ! The input buffer + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: LenOutVector( * ) ! Length on each PE + REAL(CPP_REAL4), INTENT( OUT ) :: OutVector( * ) ! The output buffer + +! !DESCRIPTION: +! +! This routine exchanges vectors stored in compressed format, i.e., +! in so-called compressed sparse row (CSR) format, with other +! PEs. In essence it first exchanges the lengths with +! MPI\_Alltoall, then the exchange of the actual vectors (can be +! different in size) using MPI\_AlltoallV. Since the latter is +! inefficient, it is simulated using MPI\_Isend and MPI\_Recv. +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_WAITALL, MPI_ALLTOALL +! +! !REVISION HISTORY: +! 98.03.17 Sawyer Creation from F77 version +! 98.03.30 Sawyer Removed assumed shape arrays due to problems +! 99.01.18 Sawyer Added barrier for safety +! 99.03.08 Sawyer USE_SHMEM version for CRAY only; untested +! 99.06.01 Sawyer USE_SHMEM version revised per comments from Tom +! 00.07.28 Sawyer Implemented with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: i, iscnt, ircnt, nr, pe, icnt, Nsize, Iam, Ierr + INTEGER :: Status(MPI_STATUS_SIZE) + Integer, allocatable :: Reqs(:), Stats(:) + + CPP_ENTER_PROCEDURE( "PAREXCHANGEVECTORREAL4" ) + + CALL MPI_COMM_SIZE( InComm, Nsize, Ierr ) + CALL MPI_COMM_RANK( InComm, Iam, Ierr ) + + allocate (Reqs(Nsize)) + allocate (Stats(Nsize*MPI_STATUS_SIZE)) + +#if defined( MY_ALLTOALL ) + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + CALL MPI_ISEND( nr, 1, CPP_MPI_INTEGER, pe, Iam+3000, & + InComm, Reqs( pe+1 ), Ierr ) + ENDDO + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + CALL MPI_RECV( nr, 1, CPP_MPI_INTEGER, pe, pe+3000, & + InComm, Status, Ierr ) + LenOutVector(pe + 1) = nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) +#else + CALL MPI_ALLTOALL( LenInVector, 1, CPP_MPI_INTEGER, & + LenOutVector, 1, CPP_MPI_INTEGER, & + InComm, Ierr ) +#endif +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + IF ( nr .gt. 0 ) THEN + CALL MPI_ISEND( InVector( icnt ), nr, & + CPP_MPI_REAL4, pe, Iam+2000, & + InComm, Reqs( pe+1 ), Ierr ) + ELSE + Reqs( pe+1 ) = MPI_REQUEST_NULL + ENDIF + icnt = icnt + nr + ENDDO + +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + nr = LenOutVector(pe + 1) + IF ( nr .gt. 0 ) THEN + CALL MPI_RECV( OutVector( icnt ), nr, & + CPP_MPI_REAL4, pe, pe+2000, & + InComm, Status, Ierr ) + ENDIF + icnt = icnt + nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PAREXCHANGEVECTORREAL4" ) + + RETURN +!EOC + END SUBROUTINE ParExchangeVectorReal4 +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParExchangeVectorInt --- Exchange a sparse packed vector +! +! !INTERFACE: + SUBROUTINE ParExchangeVectorInt ( InComm, LenInVector, InVector, & + LenOutVector, OutVector ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: LenInVector( * ) ! Length on each PE + INTEGER, INTENT( IN ) :: InVector( * ) ! The input buffer + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: LenOutVector( * ) ! Length on each PE + INTEGER, INTENT( OUT ) :: OutVector( * ) ! The output buffer + +! !DESCRIPTION: +! +! This routine exchanges vectors stored in compressed format, i.e., +! in so-called compressed sparse row (CSR) format, with other +! PEs. In essence it first exchanges the lengths with +! MPI\_Alltoall, then the exchange of the actual vectors (can be +! different in size) using MPI\_AlltoallV. Since the latter is +! inefficient, it is simulated using MPI\_Isend and MPI\_Recv. +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_WAITALL, MPI_ALLTOALL +! +! !REVISION HISTORY: +! 98.03.17 Sawyer Creation from F77 version +! 98.03.30 Sawyer Removed assumed shape arrays due to problems +! 99.01.18 Sawyer Added barrier for safety +! 99.03.08 Sawyer USE_SHMEM version for CRAY only; untested +! 99.06.01 Sawyer USE_SHMEM version revised per comments from Tom +! 00.07.28 Sawyer Implemented with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: i, iscnt, ircnt, nr, pe, icnt, Nsize, Iam, Ierr + INTEGER :: Status(MPI_STATUS_SIZE) + Integer, allocatable :: Reqs(:), Stats(:) + + CPP_ENTER_PROCEDURE( "PAREXCHANGEVECTORINT" ) + + CALL MPI_COMM_SIZE( InComm, Nsize, Ierr ) + CALL MPI_COMM_RANK( InComm, Iam, Ierr ) + + allocate (Reqs(Nsize)) + allocate (Stats(Nsize*MPI_STATUS_SIZE)) + +#if defined( MY_ALLTOALL ) + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + CALL MPI_ISEND( nr, 1, & + MPI_INTEGER, pe, Iam+3000, & + InComm, Reqs( pe+1 ), Ierr ) + ENDDO + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + CALL MPI_RECV( nr, 1, & + MPI_INTEGER, pe, pe+3000, & + InComm, Status, Ierr ) + LenOutVector(pe + 1) = nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) +#else + CALL MPI_ALLTOALL( LenInVector, 1, CPP_MPI_INTEGER, & + LenOutVector, 1, CPP_MPI_INTEGER, & + InComm, Ierr ) +#endif +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + IF ( nr .gt. 0 ) THEN + CALL MPI_ISEND( InVector( icnt ), nr, & + CPP_MPI_INTEGER, pe, Iam+2000, & + InComm, Reqs( pe+1 ), Ierr ) + ELSE + Reqs( pe+1 ) = MPI_REQUEST_NULL + ENDIF + icnt = icnt + nr + ENDDO + +! +! Over all processes +! + icnt = 1 + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + nr = LenOutVector(pe + 1) + IF ( nr .gt. 0 ) THEN + CALL MPI_RECV( OutVector( icnt ), nr, & + CPP_MPI_INTEGER, pe, pe+2000, & + InComm, Status, Ierr ) + ENDIF + icnt = icnt + nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) +! +! WS 98.09.22 : This barrier needed to synchronize. Why? +! + CALL MPI_BARRIER( InComm, Ierr ) + + deallocate (Reqs) + deallocate (Stats) + + CPP_LEAVE_PROCEDURE( "PAREXCHANGEVECTORINT" ) + + RETURN +!EOC + END SUBROUTINE ParExchangeVectorInt +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollectiveBarrier --- Barrier: Simplest collective op. +! +! !INTERFACE: + SUBROUTINE ParCollectiveBarrier( InComm ) + +! !USES: + IMPLICIT NONE +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + +! !DESCRIPTION: +! +! This routine performs a barrier only within the communicator InComm +! +! !REVISION HISTORY: +! 00.09.10 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + + CALL MPI_Barrier(InComm, Ierror ) + + RETURN +!EOC + END SUBROUTINE ParCollectiveBarrier +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective0D --- Perform global Collective of a scalar +! +! !INTERFACE: + SUBROUTINE ParCollective0D( InComm, Op, Var ) + +! !USES: + IMPLICIT NONE +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: Var ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL8) Tmp + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, 1, CPP_MPI_REAL8, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, 1, CPP_MPI_REAL8, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective0D +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective1D --- Perform component-wise global Collective of a vector +! +! !INTERFACE: + SUBROUTINE ParCollective1D( InComm, Op, Im, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! Size of 1-D array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: Var(Im) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL8) Tmp(Im) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im, CPP_MPI_REAL8, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im, CPP_MPI_REAL8, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective1D +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective1DReal4 --- Perform component-wise global Collective of a vector +! +! !INTERFACE: + SUBROUTINE ParCollective1DReal4( InComm, Op, Im, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! Size of 1-D array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL4), INTENT( INOUT ) :: Var(Im) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL4) Tmp(Im) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im, CPP_MPI_REAL4, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im, CPP_MPI_REAL4, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective1DReal4 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective2D --- Perform component-wise collective operation +! +! !INTERFACE: + SUBROUTINE ParCollective2D( InComm, Op, Im, Jm, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! First dimension of 2-D array + INTEGER, INTENT( IN ) :: Jm ! Second dimension of 2-D array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ) :: Var(Im,Jm) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL8) Tmp(Im,Jm) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im*Jm, CPP_MPI_REAL8, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im*Jm, CPP_MPI_REAL8, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective2D +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective2DReal4 --- Perform component-wise collective operation +! +! !INTERFACE: + SUBROUTINE ParCollective2DReal4( InComm, Op, Im, Jm, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! First dimension of 2-D array + INTEGER, INTENT( IN ) :: Jm ! Second dimension of 2-D array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL4), INTENT( INOUT ) :: Var(Im,Jm) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL4) Tmp(Im,Jm) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im*Jm, CPP_MPI_REAL4, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im*Jm, CPP_MPI_REAL4, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective2DReal4 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective3D --- Perform component-wise global Collective of a vector +! +! !INTERFACE: + SUBROUTINE ParCollective3D( InComm, Op, Im, Jm, Lm, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! First dimension of 3-D array + INTEGER, INTENT( IN ) :: Jm ! Second dimension of 3-D array + INTEGER, INTENT( IN ) :: Lm ! Third dimension of 3-D array + +! !INPUT/OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( INOUT ):: Var(Im,Jm,LM) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + REAL(CPP_REAL8) Tmp(Im,Jm,Lm) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im*Jm*Lm, CPP_MPI_REAL8, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im*Jm*Lm, CPP_MPI_REAL8, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective3D +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective0DInt --- Perform global Collective of a scalar +! +! !INTERFACE: + SUBROUTINE ParCollective0DInt( InComm, Op, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + +! !INPUT/OUTPUT PARAMETERS: + INTEGER, INTENT( INOUT ) :: Var ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + INTEGER Tmp + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, 1, CPP_MPI_INTEGER, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var,Tmp,1,CPP_MPI_INTEGER,Op,InComm,Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective0DInt +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective0DStr --- Perform global Collective of a string +! +! !INTERFACE: + SUBROUTINE ParCollective0DStr( InComm, Op, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + +! !INPUT/OUTPUT PARAMETERS: + CHARACTER (LEN=*), INTENT( INOUT ) :: Var ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror, StrLen + + StrLen = LEN(Var) + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, StrLen, MPI_CHARACTER, 0, InComm, Ierror ) + ELSE + write(iulog,*) "global reduction of string not supported" + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective0DStr +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective1DStr --- Perform global Collective of a string +! +! !INTERFACE: + SUBROUTINE ParCollective1DStr( InComm, Op, Im, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! Size of 1-D array + +! !INPUT/OUTPUT PARAMETERS: + CHARACTER (LEN=*), INTENT( INOUT ) :: Var(:) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror, StrLen + + StrLen = LEN(Var(1)) + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im*StrLen, MPI_CHARACTER, 0, InComm, Ierror ) + ELSE + write(iulog,*) "global reduction of string not supported" + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective1DStr +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective1DInt --- Perform component-wise global +! collective operations of int vector +! +! !INTERFACE: + SUBROUTINE ParCollective1DInt( InComm, Op, Im, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! Size of 1-D array + +! !INPUT/OUTPUT PARAMETERS: + INTEGER, INTENT( INOUT ) :: Var(Im) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + INTEGER Tmp(Im) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im, CPP_MPI_INTEGER, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var,Tmp,Im,CPP_MPI_INTEGER,Op,InComm,Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective1DInt +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: ParCollective2DInt --- Perform component-wise collective op. +! +! !INTERFACE: + SUBROUTINE ParCollective2DInt( InComm, Op, Im, Jm, Var ) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: Op ! Operation (see header) + INTEGER, INTENT( IN ) :: Im ! First dimension of 2-D array + INTEGER, INTENT( IN ) :: Jm ! Second dimension of 2-D array + +! !INPUT/OUTPUT PARAMETERS: + INTEGER, INTENT( INOUT ):: Var(Im,Jm) ! partial Var in, Var out + +! !DESCRIPTION: +! +! This utility makes a collective operation over all processes in +! communicator InComm. +! +! !REVISION HISTORY: +! 00.08.07 Sawyer Creation +! +!EOP +!--------------------------------------------------------------------- +!BOC + INTEGER Ierror + INTEGER Tmp(Im,Jm) + + IF ( Op .EQ. BCSTOP ) THEN + CALL MPI_BCAST( Var, Im*Jm, CPP_MPI_INTEGER, 0, InComm, Ierror ) + ELSE + CALL MPI_ALLREDUCE( Var, Tmp, Im*Jm, CPP_MPI_INTEGER, & + Op, InComm, Ierror ) + Var = Tmp + ENDIF + + RETURN +!EOC + END SUBROUTINE ParCollective2DInt +!----------------------------------------------------------------------- +# ifdef _SMEMORY +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParExchangeLength --- Exchange a sparse packed vector +! +! !INTERFACE: + SUBROUTINE ParExchangeLength ( InComm, LenInVector, LenOutVector) + +! !USES: + IMPLICIT NONE + +! !INPUT PARAMETERS: + INTEGER, INTENT( IN ) :: InComm ! Communicator + INTEGER, INTENT( IN ) :: LenInVector( * ) ! Length on each PE + +! !OUTPUT PARAMETERS: + INTEGER, INTENT( OUT ) :: LenOutVector( * ) ! Length on each PE + +! !DESCRIPTION: +! +! This routine exchanges vectors stored in compressed format, i.e., +! in so-called compressed sparse row (CSR) format, with other +! PEs. In essence it first exchanges the lengths with +! MPI\_Alltoall, then the exchange of the actual vectors (can be +! different in size) using MPI\_AlltoallV. Since the latter is +! inefficient, it is simulated using MPI\_Isend and MPI\_Recv. +! +! !SYSTEM ROUTINES: +! MPI_ISEND, MPI_RECV, MPI_WAITALL, MPI_ALLTOALL +! +! !REVISION HISTORY: +! 98.03.17 Sawyer Creation from F77 version +! 98.03.30 Sawyer Removed assumed shape arrays due to problems +! 99.01.18 Sawyer Added barrier for safety +! 99.03.08 Sawyer USE_SHMEM version for CRAY only; untested +! 99.06.01 Sawyer USE_SHMEM version revised per comments from Tom +! 00.07.28 Sawyer Implemented with shared memory arenas +! +!EOP +!----------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER :: i, iscnt, ircnt, nr, pe, icnt, Nsize, Iam, Ierr + INTEGER :: Status(MPI_STATUS_SIZE) + Integer, allocatable :: Reqs(:), Stats(:) + + CPP_ENTER_PROCEDURE( "PAREXCHANGELENGTH" ) + + CALL MPI_COMM_SIZE( InComm, Nsize, Ierr ) + CALL MPI_COMM_RANK( InComm, Iam, Ierr ) + + allocate (Reqs(Nsize)) + allocate (Stats(Nsize*MPI_STATUS_SIZE)) + +#if defined( MY_ALLTOALL ) + DO pe = 0, Nsize-1 +! +! Send the individual buffers with non-blocking sends +! + nr = LenInVector( pe + 1 ) + CALL MPI_ISEND( nr, 1, & + MPI_INTEGER, pe, Iam+3000, & + InComm, Reqs( pe+1 ), Ierr ) + ENDDO + DO pe = 0, Nsize - 1 +! +! Receive the buffers with MPI_Recv. Now we are blocking. +! + CALL MPI_RECV( nr, 1, & + MPI_INTEGER, pe, pe+3000, & + InComm, Status, Ierr ) + LenOutVector(pe + 1) = nr + ENDDO + CALL MPI_WAITALL( Nsize, Reqs, Stats, Ierr ) + + deallocate (Reqs) + deallocate (Stats) + +#else + CALL MPI_ALLTOALL( LenInVector, 1, CPP_MPI_INTEGER, & + LenOutVector, 1, CPP_MPI_INTEGER, & + InComm, Ierr ) +#endif + CALL MPI_BARRIER( InComm, Ierr ) + + + CPP_LEAVE_PROCEDURE( "PAREXCHANGELENGTH" ) + + RETURN +!EOC + END SUBROUTINE ParExchangeLength +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParCalcInfoDecompToGhost --- calculates info about the pattern +! +! !INTERFACE: + subroutine ParCalcInfoDecompToGhost(InComm, DA,GB,Info) +! +! !USES: + USE decompmodule, ONLY : DecompType,DecompInfo,DecompGlobalToLocal + USE ghostmodule, ONLY : GhostType,GhostInfo + IMPLICIT NONE + +! !INPUT PARAMETERS: + integer, intent(in) :: InComm ! communicator + type(DecompType), intent(in) :: DA ! Source Decomp Desc + type(GhostType) , intent(in) :: GB ! Destination Ghost Desc + +! !OUTPUT PARAMETERS: + type (ParInfoType), intent(out) :: Info ! Info structure +! +! !DESCRIPTION: +! This routine calulcates the information about a communication +! pattern that transforms from one decomposition to another, +! i.e., a so-called "transpose". This is a copy of an algorithm +! from the ParPatternDecompToGhost subroutine. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_ALLREDUCE +! +! !REVISION HISTORY: +! 07.09.04 Dennis Creation based on algorithm in ParPatternDecompToGhost +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + integer :: nTags,oldpe,oldlocal,sTag,eTag,nCount + integer :: j,pe,local,tag,ierr,iam,npes + integer :: npesA,npesB,tmpA,tmp1B,tmp2B,tmp3B + integer, allocatable :: sCount(:),rCount(:) + + call DecompInfo(DA,npesA,tmpA) + call GhostInfo(GB,npesB,tmp1B,tmp2B,tmp3B) + + call MPI_COMM_SIZE(InComm,npes,ierr) + call MPI_COMM_RANK(InComm,iam,ierr) + + allocate(sCount(npes),rCount(npes)) + sCount=0 + rCount=0 + if(iam .lt. npesB) then +! Parse through all the tags in the local segment + nTags = SIZE(GB%Local%Head(iam+1)%StartTags) + do j=1,nTags + oldpe = -1 + oldlocal = 0 + sTag = GB%Local%Head(iam+1)%StartTags(j) + eTag = GB%Local%Head(iam+1)%EndTags(j) + do tag = sTag,eTag + if(tag > 0) then +! +! Determine the index and PE of this entry on A. This might be inlined later +! + call DecompGlobalToLocal(DA,tag,Local,Pe) +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + if( pe /= oldpe .or. local /= oldlocal+1) then + sCount(pe+1) = sCount(pe+1) + 1 + endif + oldpe = pe ! Update PE + oldlocal = local ! Update local index + endif + enddo + enddo + endif + +! Calculate the length of receive segments + call ParExchangeLength(InComm,sCount,rCount) +! Record some information + Info%numSendSeg = SUM(sCount) + InFo%numSendNeigh = COUNT(sCount > 0) + + Info%numRecvSeg = SUM(rCount) + InFo%numRecvNeigh = COUNT(rCount > 0) + nCount=MAX(Info%numSendSeg,Info%numRecvSeg) + call MPI_ALLREDUCE(nCount,Info%maxNumSeg,1,INT4,MPI_MAX,InComm,ierr) + + deallocate(sCount,rCount) + + CPP_LEAVE_PROCEDURE( "PARCALCLENGTHDECOMPTOGHOST" ) + RETURN +!EOC + end subroutine ParCalcInfoDecompToGhost +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParCalcInfoDecompToDecomp --- calculates info about the pattern +! +! !INTERFACE: + subroutine ParCalcInfoDecompToDecomp(InComm, DA,DB,Info) +! +! !USES: + USE decompmodule, ONLY : DecompType,DecompInfo,DecompGlobalToLocal + IMPLICIT NONE + +! !INPUT PARAMETERS: + integer, intent(in) :: InComm ! communicator + type(DecompType), intent(in) :: DA ! Source Decomp Desc + type(DecompType), intent(in) :: DB ! Destination Decomp Desc + +! !OUTPUT PARAMETERS: + type (ParInfoType), intent(out) :: Info ! Info structure +! +! !DESCRIPTION: +! This routine calulcates the information about a communication +! pattern that transforms from one decomposition to another, +! i.e., a so-called "transpose". This is a copy of an algorithm +! from the ParPatternDecompToDecomp subroutine. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_ALLREDUCE +! +! !REVISION HISTORY: +! 07.09.04 Dennis Creation based on algorithm in ParPatternDecompToDecomp +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + integer :: nCount,npes,iam,ierr + integer :: nTags,oldpe,oldlocal,sTag,eTag + integer :: j,pe,local,tag,tmpA,tmpB,npesA,npesB + integer, allocatable :: sCount(:),rCount(:) + + call DecompInfo(DA,npesA,tmpA) + call DecompInfo(DB,npesB,tmpB) + + call MPI_COMM_SIZE(InComm,npes,ierr) + call MPI_COMM_RANK(InComm,iam,ierr) + + allocate(sCount(npes),rCount(npes)) + sCount=0 + rCount=0 + if(iam .lt. npesB) then +! Parse through all the tags in the local segment + nTags = SIZE(DB%Head(iam+1)%StartTags) + do j=1,nTags + oldpe = -1 + sTag = DB%Head(iam+1)%StartTags(j) + eTag = DB%Head(iam+1)%EndTags(j) + do tag = sTag,eTag +! +! Determine the index and PE of this entry on A. This might be inlined later +! + call DecompGlobalToLocal(DA,tag,Local,Pe) +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + if( pe /= oldpe ) then + oldpe = pe + sCount(pe+1) = sCount(pe+1) + 1 + endif + enddo + enddo + endif +! Calculate the length of recieve segments + call ParExchangeLength(InComm,sCount,rCount) +! Record some information + Info%numSendSeg = SUM(sCount) + InFo%numSendNeigh = COUNT(sCount > 0) + + Info%numRecvSeg = SUM(rCount) + InFo%numRecvNeigh = COUNT(rCount > 0) + nCount=MAX(Info%numSendSeg,Info%numRecvSeg) + call MPI_ALLREDUCE(nCount,Info%maxNumSeg,1,INT4,MPI_MAX,InComm,ierr) + + deallocate(sCount,rCount) + + CPP_LEAVE_PROCEDURE( "PARCALCINFODECOMPTODECOMP" ) + RETURN +!EOC + end subroutine ParCalcInfoDecompToDecomp +!-------------------------------------------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParCalcInfoGhostToDecomp --- calculates info about the pattern +! +! !INTERFACE: + subroutine ParCalcInfoGhostToDecomp(InComm, GA,DB,Info) +! +! !USES: + USE decompmodule, ONLY : DecompType,DecompInfo,DecompGlobalToLocal + USE ghostmodule, ONLY : GhostType,GhostInfo + IMPLICIT NONE + +! !INPUT PARAMETERS: + integer, intent(in) :: InComm ! communicator + type(GhostType), intent(in) :: GA ! Source Ghost Desc + type(DecompType), intent(in) :: DB ! Destination Decomp Desc + +! !OUTPUT PARAMETERS: + type (ParInfoType), intent(out) :: Info ! Info structure +! +! !DESCRIPTION: +! This routine calulcates the information about a communication +! pattern that transforms from one decomposition to another, +! i.e., a so-called "transpose". This is a copy of an algorithm +! from the ParPatternGhostToDecomp subroutine. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_ALLREDUCE +! +! !REVISION HISTORY: +! 07.09.04 Dennis Creation based on algorithm in ParPatternGhostToDecomp +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + integer :: nTags,oldpe,oldlocal,sTag,eTag + integer :: npes, nCount,iam,ierr + integer :: j,pe,local,tag,npesA,npesB,tmpB,tmp1A,tmp2A,tmp3A + integer, allocatable :: sCount(:),rCount(:) + + call GhostInfo(GA,npesA,tmp1A,tmp2A,tmp3A) + call DecompInfo(DB,npesB,tmpB) + + call MPI_COMM_SIZE(InComm,npes,ierr) + call MPI_COMM_RANK(InComm,iam,ierr) + + allocate(sCount(npes),rCount(npes)) + sCount=0 + rCount=0 + if(iam .lt. npesB) then +! Parse through all the tags in the local segment + nTags = SIZE(DB%Head(iam+1)%StartTags) + do j=1,nTags + oldpe = -1 + oldlocal = 0 + sTag = DB%Head(iam+1)%StartTags(j) + eTag = DB%Head(iam+1)%EndTags(j) + do tag = sTag,eTag +! +! Determine the index and PE of this entry on A. This might be inlined later +! + call DecompGlobalToLocal(GA%Decomp,tag,Local,Pe) +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + if ((pe /= -1) .and. ( pe /= oldpe .or. local /= OldLocal+1 )) then + sCount(pe+1) = sCount(pe+1) + 1 + endif + oldpe = pe + oldlocal = local + enddo + enddo + endif +! Calculate the lenght of recieve segments + call ParExchangeLength(InComm,sCount,rCount) +! Record some information + Info%numSendSeg = SUM(sCount) + InFo%numSendNeigh = COUNT(sCount > 0) + + Info%numRecvSeg = SUM(rCount) + InFo%numRecvNeigh = COUNT(rCount > 0) + nCount=MAX(Info%numSendSeg,Info%numRecvSeg) + call MPI_ALLREDUCE(nCount,Info%maxNumSeg,1,INT4,MPI_MAX,InComm,ierr) + + deallocate(sCount,rCount) + + CPP_LEAVE_PROCEDURE( "PARCALCLENGTHGHOSTTODECOMP" ) + RETURN +!EOC + end subroutine ParCalcInfoGhostToDecomp +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: ParCalcInfoGhostToGhost --- calculates info about the pattern +! +! !INTERFACE: + subroutine ParCalcInfoGhostToGhost(InComm, GA,GB,Info) +! +! !USES: + USE decompmodule, ONLY : DecompGlobalToLocal + USE ghostmodule, ONLY : GhostType,GhostInfo + IMPLICIT NONE + +! !INPUT PARAMETERS: + integer, intent(in) :: InComm ! communicator + type(GhostType), intent(in) :: GA ! Source Ghost Desc + type(GhostType), intent(in) :: GB ! Destination Ghost Desc + +! !OUTPUT PARAMETERS: + type (ParInfoType), intent(out) :: Info ! Info structure +! +! !DESCRIPTION: +! This routine calulcates the information about a communication +! pattern that transforms from one decomposition to another, +! i.e., a so-called "transpose". This is a copy of an algorithm +! from the ParPatternGhostToGhost subroutine. +! +! !SYSTEM ROUTINES: +! MPI_COMM_SIZE, MPI_COMM_RANK, MPI_ALLREDUCE +! +! !REVISION HISTORY: +! 07.09.04 Dennis Creation based on algorithm in ParPatternGhostToGhost +! +!EOP +!----------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + integer :: nTags,oldpe,oldlocal,sTag,eTag,ierr,nCount + integer :: j,pe,local,tag,npes,iam,npesA,npesB + integer :: tmp1A,tmp2A,tmp3A,tmp1B,tmp2B,tmp3B + integer, allocatable :: sCount(:),rCount(:) + + call GhostInfo(GA,npesA,tmp1A,tmp2A,tmp3A) + call GhostInfo(GB,npesB,tmp1B,tmp2B,tmp3B) + + call MPI_COMM_SIZE(InComm,npes,ierr) + call MPI_COMM_RANK(InComm,iam,ierr) + + allocate(sCount(npes),rCount(npes)) + sCount=0 + rCount=0 + if(iam .lt. npesB) then +! Parse through all the tags in the local segment + nTags = SIZE(GB%Local%Head(iam+1)%StartTags) + do j=1,nTags + oldpe = -1 + oldlocal = 0 + sTag = GB%Local%Head(iam+1)%StartTags(j) + eTag = GB%Local%Head(iam+1)%EndTags(j) + do tag = sTag,eTag + if (Tag > 0 ) THEN +! +! Determine the index and PE of this entry on A. This might be inlined later +! + call DecompGlobalToLocal(GA%Decomp,tag,Local,Pe) +! +! If ipe-1 is my id, then this is an entry ipe will receive from Pe +! + if( pe /= oldpe .or. local /= OldLocal+1 ) then + sCount(pe+1)=sCount(pe+1)+1 + endif + oldpe = pe + oldlocal = local + endif + enddo + enddo + endif + +! Calculate the length of receive segments + call ParExchangeLength(InComm,sCount,rCount) +! Record some information + Info%numSendSeg = SUM(sCount) + InFo%numSendNeigh = COUNT(sCount > 0) + + Info%numRecvSeg = SUM(rCount) + InFo%numRecvNeigh = COUNT(rCount > 0) + nCount=MAX(Info%numSendSeg,Info%numRecvSeg) + call MPI_ALLREDUCE(nCount,Info%maxNumSeg,1,INT4,MPI_MAX,InComm,ierr) + + deallocate(sCount,rCount) + + CPP_LEAVE_PROCEDURE( "PARCALCINFOGHOSTTOGHOST" ) + RETURN +!EOC + end subroutine ParCalcInfoGhostToGhost +# endif +#endif + END MODULE parutilitiesmodule diff --git a/src/utils/pilgrim/pilgrim.h b/src/utils/pilgrim/pilgrim.h new file mode 100644 index 0000000000..c976b110a7 --- /dev/null +++ b/src/utils/pilgrim/pilgrim.h @@ -0,0 +1,27 @@ +!----------------------------------------------------------------------- +! MPI Context: +!----------------------------------------------------------------------- +! +! Now only contains cpp defines. This file should really be called +! mpi_defines.h +! + +#define MAX_TRF 4 +#define MAX_SMP 4 +#define MAX_PAX 4 + +#define CPP_MPI_INTEGER MPI_INTEGER +#define CPP_MPI_REAL8 MPI_DOUBLE_PRECISION +#define CPP_MPI_REAL4 MPI_REAL + +#if defined(STAND_ALONE) +# define CPP_REAL4 selected_real_kind(5) +# define CPP_REAL8 selected_real_kind(12) +# define CPP_INTEGER4 selected_int_kind(6) +# define CPP_INTEGER8 selected_int_kind(13) +#else +# define CPP_REAL4 r4 +# define CPP_REAL8 r8 +# define CPP_INTEGER4 i4 +# define CPP_INTEGER8 i8 +#endif diff --git a/src/utils/pilgrim/puminterfaces.F90 b/src/utils/pilgrim/puminterfaces.F90 new file mode 100644 index 0000000000..accab4209f --- /dev/null +++ b/src/utils/pilgrim/puminterfaces.F90 @@ -0,0 +1,225 @@ +#include "pilgrim.h" +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: scatter --- wrapper for PILGRIM utility +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine scatter( input, decomp, output, incomm ) +!****6***0*********0*********0*********0*********0*********0**********72 +! !USES: +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif + use decompmodule, only : decomptype +#if defined( SPMD ) + use parutilitiesmodule, only : parscatter +#endif + implicit none + +! !INPUT PARAMETERS: + real(CPP_REAL8) input(*) ! Input array (global) + type (decomptype) :: decomp ! Decomposition + integer incomm ! Communicator + +! !OUTPUT PARAMETERS: + real(CPP_REAL8) output(*) ! Output array (local) + +! !DESCRIPTION: +! Scatter the global input array (on PE 0) according to +! decomposition to the local output array. This intermediate +! routine is a way to trick the compiler into passing 1-D +! arrays to the parutilitiesmodule method parscatter. +! +! !REVISION HISTORY: +! WS 00.11.28: Creation +! AAM 01.05.08: Added communicator as input argument +!EOP +!----------------------------------------------------------------------- +!BOC +#if defined( SPMD ) + call parscatter( incomm, 0, input, decomp, output ) +#endif + return +!EOC + end subroutine scatter +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: gather --- wrapper for PILGRIM utility +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine gather( input, decomp, output ) +!****6***0*********0*********0*********0*********0*********0**********72 +! !USES: +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif + use decompmodule, only : decomptype +#if defined( SPMD ) + use parutilitiesmodule, only : commglobal, pargather +#endif + implicit none + +! !INPUT PARAMETERS: + real(CPP_REAL8) input(*) ! Input array (global) + type (decomptype) :: decomp ! Decomposition + +! !OUTPUT PARAMETERS: + real(CPP_REAL8) output(*) ! Output array (local) + +! !DESCRIPTION: +! Gather the local input array according to decomposition +! to the global output array (on PE 0). This intermediate +! routine is a way to trick the compiler into passing 1-D +! arrays to the parutilitiesmodule method pargather. +! +! !REVISION HISTORY: +! WS 00.11.28: Creation +!EOP +!----------------------------------------------------------------------- +!BOC +#if defined( SPMD ) + call pargather( commglobal, 0, input, decomp, output ) +#endif + return +!EOC + end subroutine gather +!----------------------------------------------------------------------- + +#if defined( SPMD ) +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: begintransfer --- wrapper for PILGRIM utility +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine begintransfer( pattern, input, output ) +!****6***0*********0*********0*********0*********0*********0**********72 +! !USES: +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif +#if defined( SPMD ) + use parutilitiesmodule, only : parpatterntype, parbegintransfer, commglobal +#endif + implicit none + +! !INPUT PARAMETERS: + type (parpatterntype) :: pattern ! Decomposition + real(CPP_REAL8) input(*) ! Input array +! !OUTPUT PARAMETERS: + real(CPP_REAL8) output(*) ! Output array + +! !DESCRIPTION: +! Initiate an asynchronous collective transfer of the input +! array to the output array as defined by the communication +! pattern. +! +! !REVISION HISTORY: +! WS 01.03.11: Creation +!EOP +!----------------------------------------------------------------------- +!BOC + +#if defined( SPMD ) + call parbegintransfer( commglobal, pattern, input, output ) +#endif + return +!EOC + end subroutine begintransfer +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: endtransfer --- wrapper for PILGRIM utility +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine endtransfer( pattern, input, output ) +!****6***0*********0*********0*********0*********0*********0**********72 +! !USES: +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif +#if defined( SPMD ) + use parutilitiesmodule, only : parpatterntype, parendtransfer, commglobal +#endif + implicit none + +! !INPUT PARAMETERS: + type (parpatterntype) :: pattern ! Decomposition + real(CPP_REAL8) input(*) ! Input array + +! !OUTPUT PARAMETERS: + real(CPP_REAL8) output(*) ! Output array + +! !DESCRIPTION: +! Complete an asynchronous collective transfer of the input +! array to the output array as defined by the communication +! pattern. +! +! !REVISION HISTORY: +! WS 01.03.11: Creation +!EOP +!--------------------------------------------------------------------- +!BOC + +#if defined( SPMD ) + call parendtransfer( commglobal, pattern, input, output ) +#endif + return +!EOC + end subroutine endtransfer +!--------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !ROUTINE: exchangevector --- wrapper for PILGRIM utility +! +! !INTERFACE: +!****6***0*********0*********0*********0*********0*********0**********72 + subroutine exchangevector( incomm, inlen, input, outlen, output ) +!****6***0*********0*********0*********0*********0*********0**********72 +! !USES: +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif +#if defined( SPMD ) + use parutilitiesmodule, only : parexchangevector +#endif + implicit none + +! !INPUT PARAMETERS: + integer incomm ! Communicator + integer inlen(*) ! Input lengths per PE + real(CPP_REAL8) input(*) ! Input array (global) + +! !OUTPUT PARAMETERS: + integer outlen(*) ! Output lengths per PE + real(CPP_REAL8) output(*) ! Output array (local) + +! !DESCRIPTION: +! Perform a synchronous collective transfer of the input vector, +! blocked in segments to be sent to each PE in ascending order, and +! the lengths of the blocks given by inlen. The routine returns the +! output block lengths (those received on the local PE) and +! the vector output which is blocked by ascending PE order. +! +! !REVISION HISTORY: +! WS 01.03.11: Creation +!EOP +!--------------------------------------------------------------------- +!BOC + +#if defined( SPMD ) + call parexchangevector( incomm, inlen, input, outlen, output ) +#endif + return +!EOC + end subroutine exchangevector +!--------------------------------------------------------------------- +#endif diff --git a/src/utils/pilgrim/redistributemodule.F90 b/src/utils/pilgrim/redistributemodule.F90 new file mode 100644 index 0000000000..1650f0ec8b --- /dev/null +++ b/src/utils/pilgrim/redistributemodule.F90 @@ -0,0 +1,506 @@ +#include "pilgrim.h" +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- + MODULE redistributemodule +#if defined( SPMD ) +!BOP +! +! !MODULE: redistributemodule +! +! !USES: +#include "debug.h" +#if !defined(STAND_ALONE) + use shr_kind_mod, only: r8 => shr_kind_r8 +#endif + IMPLICIT NONE + +! +! !DESCRIPTION: +! +! +! !REVISION HISTORY: +! 99.01.18 Sawyer Creation +! 99.11.17 Sawyer Added RedistributeStart, RedistributeFinish +! 00.07.20 Sawyer Minor cosmetic changes +! 00.08.28 Sawyer Accommodated change to ParEndTranfer interface +! 01.02.12 Sawyer Converted to free format +! +! !PUBLIC TYPES: + PUBLIC RedistributeType + PUBLIC RedistributeCreate, RedistributeFree, RedistributePerform + PUBLIC RedistributeStart, RedistributeFinish + +! Redistribution info + + TYPE RedistributeType + INTEGER, POINTER :: CountA(:) ! Per PE counts in Decomp A + INTEGER, POINTER :: CountB(:) ! Per PE counts in Decomp B + INTEGER, POINTER :: PermA(:) ! Permutation in Decomp A + INTEGER, POINTER :: PermB(:) ! Permutation in Decomp B + END TYPE RedistributeType +!EOP + REAL(CPP_REAL8), ALLOCATABLE, SAVE :: InStatic(:), OutStatic(:) + + CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: RedistributeCreate --- Create an inter-decomp. structure +! +! !INTERFACE: + SUBROUTINE RedistributeCreate( DecompA, DecompB, Inter ) +! !USES: + USE decompmodule, ONLY: DecompType, DecompGlobalToLocal + USE parutilitiesmodule, ONLY: GID, Gsize + IMPLICIT NONE +#include "mpif.h" + +! +! !INPUT PARAMETERS: + TYPE(DecompType), INTENT( IN ) :: DecompA ! Decomposition A + TYPE(DecompType), INTENT( IN ) :: DecompB ! Decomposition B + +! !OUTPUT PARAMETERS: + TYPE(RedistributeType), INTENT( OUT ) :: Inter ! Inter info. + +! +! !DESCRIPTION: +! +! This routine constructs a RedistributeType structure which +! can be efficiently used in the RedistributePerform routine. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 99.01.15 Sawyer Creation +! +! !BUGS: +! Currently untested. +! +!EOP +!--------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + INTEGER IndexA, IndexB, I, J, K, Tag, Local, Pe, Offsets( Gsize ) + LOGICAL Found, First, Search + + CPP_ENTER_PROCEDURE( "REDISTRIBUTECREATE" ) +! +! Allocate the number of entries and list head arrays +! + CPP_ASSERT_F90( SIZE( DecompA%NumEntries ).EQ. Gsize ) + + CPP_ASSERT_F90( SIZE( DecompB%NumEntries ).EQ. Gsize ) + + ALLOCATE( Inter%CountA( Gsize ) ) + ALLOCATE( Inter%CountB( Gsize ) ) + + ALLOCATE( Inter%PermA( DecompA%NumEntries( GID+1 ) ) ) + ALLOCATE( Inter%PermB( DecompB%NumEntries( GID+1 ) ) ) + + Inter%CountA = 0 + Inter%CountB = 0 + IndexA = 0 + IndexB = 0 + + DO I = 1, Gsize + DO J = 1, SIZE( DecompB%Head(I)%StartTags ) + First = .TRUE. + DO Tag=DecompB%Head(I)%StartTags(J),DecompB%Head(I)%EndTags(J) + +! +! CODE INLINED FOR PERFORMANCE +! +!!! CALL DecompGlobalToLocal( DecompA, Tag, Local, Pe ) + + Search = .TRUE. + IF ( .NOT. First ) & + Search = First .OR. Tag .GT. DecompA%Head(Pe+1)%EndTags(K) + + IF ( Search ) THEN + First = .FALSE. + +! +! Search over all the PEs +! + Pe = -1 + Found = .FALSE. + DO WHILE ( .NOT. Found ) +! +! Copy the number of entries on each PE +! + Pe = Pe + 1 +! +! Search through the local data segment +! + Local = 1 + K = 1 + DO WHILE ( .NOT. Found .AND. & + K .LE. SIZE( DecompA%Head(Pe+1)%StartTags ) ) + IF ( Tag .GE. DecompA%Head(Pe+1)%StartTags(K) .AND. & + Tag .LE. DecompA%Head(Pe+1)%EndTags(K) ) THEN + Local = Local+Tag - DecompA%Head(Pe+1)%StartTags(K) + Found = .TRUE. + ELSE + Local = Local + DecompA%Head(Pe+1)%EndTags(K) - & + DecompA%Head(Pe+1)%StartTags(K) + 1 + K = K+1 + ENDIF + ENDDO +! +! Emergency brake +! + IF ( Pe.EQ.(SIZE(DecompA%Head)-1).AND. .NOT.Found ) THEN + Found = .TRUE. + Local = 0 + Pe = -1 + ENDIF + ENDDO + +! +! END OF INLINING +! + ELSE + Local = Local + 1 + ENDIF +! +! Calculate the sorting permutation for A +! + IF ( Pe .EQ. GID ) THEN + Inter%CountA( I ) = Inter%CountA( I ) + 1 + IndexA = IndexA + 1 + Inter%PermA( IndexA ) = local + ENDIF +! +! Calculate the sorting permutation for B +! + IF ( I-1 .EQ. GID ) THEN + Inter%CountB( Pe+1 ) = Inter%CountB( Pe+1 ) + 1 + IndexB = IndexB + 1 + Inter%PermB( IndexB ) = Inter%CountB( Pe+1 )*Gsize + Pe + ENDIF + ENDDO + ENDDO + ENDDO + +! +! Finally decode PermB and add in the proper offsets +! + Offsets = 0 + DO I=1, Gsize-1 + Offsets( I+1 ) = Offsets( I ) + Inter%CountB( I ) + ENDDO + DO I=1, IndexB + Pe = MOD( Inter%PermB( I ), Gsize ) + Inter%PermB( I ) = Inter%PermB(I)/Gsize + Offsets( Pe+1 ) + ENDDO + + CPP_LEAVE_PROCEDURE( "REDISTRIBUTECREATE" ) + RETURN +!EOC + END SUBROUTINE RedistributeCreate +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: RedistributePerform --- Perform the Redistribution +! +! !INTERFACE: + SUBROUTINE RedistributePerform( Inter, Forward, Input, Output ) +! !USES: + USE parutilitiesmodule, ONLY : CommGlobal, Gsize, & + ParExchangeVector,GID + IMPLICIT NONE + +! +! !INPUT PARAMETERS: + TYPE(RedistributeType), INTENT( INOUT ) :: Inter ! Inter info. + LOGICAL :: Forward ! True: A -> B False: B -> A + REAL(CPP_REAL8), INTENT( IN ) :: Input( * ) ! Input Array +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: Output( * ) ! Output Array +! +! !DESCRIPTION: +! +! This routine performs the redistribution of Input to Output +! according to the RedistributionType data structure Inter. +! The redistribution can be from A -> B ("forward") or B -> A +! ("backward"). This feature has been added to avoid the +! need of a separate Inter (which requires considerable +! memory) to perform the backward redistribution. +! +! !SYSTEM ROUTINES: +! ALLOCATE, DEALLOCATE +! +! !BUGS: +! Currently limited to the global communicator. +! +! !REVISION HISTORY: +! 99.01.15 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + INTEGER I, Ierr, LenOutBuf( Gsize ) + REAL(CPP_REAL8), ALLOCATABLE :: InBuf(:), OutBuf(:) + + CPP_ENTER_PROCEDURE( "REDISTRIBUTEPERFORM" ) + + IF ( Forward ) THEN +! +! Forward redistribution +! + ALLOCATE( InBuf( SUM( Inter%CountA ) ) ) + ALLOCATE( OutBuf( SUM( Inter%CountB ) ) ) + DO I = 1, SUM( Inter%CountA ) + InBuf( I ) = Input( Inter%PermA( I ) ) + ENDDO + + CALL ParExchangeVector( CommGlobal, Inter%CountA, InBuf, & + LenOutBuf, OutBuf ) + DO I = 1, SUM( Inter%CountB ) + Output( I ) = OutBuf( Inter%PermB( I ) ) + ENDDO + DEALLOCATE( OutBuf ) + DEALLOCATE( InBuf ) + + ELSE +! +! Backward redistribution +! + ALLOCATE( InBuf( SUM( Inter%CountB ) ) ) + ALLOCATE( OutBuf( SUM( Inter%CountA ) ) ) + DO I = 1, SUM( Inter%CountB ) + InBuf( Inter%PermB( I ) ) = Input( I ) + ENDDO + + CALL ParExchangeVector( CommGlobal, Inter%CountB, InBuf, & + LenOutBuf, OutBuf ) + DO I = 1, SUM( Inter%CountA ) + Output( Inter%PermA( I ) ) = OutBuf( I ) + ENDDO + DEALLOCATE( OutBuf ) + DEALLOCATE( InBuf ) + + ENDIF + CPP_LEAVE_PROCEDURE( "REDISTRIBUTEPERFORM" ) + RETURN +!EOC + END SUBROUTINE RedistributePerform +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: RedistributeFree --- Free an inter-decomp. structure +! +! !INTERFACE: + SUBROUTINE RedistributeFree( Inter ) +! !USES: + IMPLICIT NONE +! +! !INPUT/OUTPUT PARAMETERS: + TYPE(RedistributeType), INTENT( INOUT ) :: Inter ! Inter info. +! +! !DESCRIPTION: +! +! This routine frees a RedistributeType structure. +! +! !SYSTEM ROUTINES: +! DEALLOCATE +! +! !REVISION HISTORY: +! 99.01.15 Sawyer Creation +! +! !BUGS: +! Currently untested. +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + INTEGER Ierr + + CPP_ENTER_PROCEDURE( "REDISTRIBUTEFREE" ) + + DEALLOCATE( Inter%PermB ) + DEALLOCATE( Inter%PermA ) + DEALLOCATE( Inter%CountB ) + DEALLOCATE( Inter%CountA ) + + CPP_LEAVE_PROCEDURE( "REDISTRIBUTEFREE" ) + RETURN +!EOC + END SUBROUTINE RedistributeFree +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: RedistributeStart --- Perform Asynchronous Redistribution +! +! !INTERFACE: + SUBROUTINE RedistributeStart( Inter, Forward, Input ) +! !USES: + USE parutilitiesmodule, ONLY : CommGlobal, Gsize, & + ParBeginTransfer,GID + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(RedistributeType), INTENT( INOUT ) :: Inter ! Inter info. + LOGICAL :: Forward ! True: A -> B False: B -> A + REAL(CPP_REAL8), INTENT( IN ) :: Input( * ) ! Input Array +! +! !DESCRIPTION: +! +! This routine starts an asynchronous redistribution of Input +! to Output according to the RedistributionType data structure Inter. +! The redistribution can be from A -> B ("forward") or B -> A +! ("backward"). This feature has been added to avoid the +! need of a separate Inter (which requires considerable +! memory) to perform the backward redistribution. +! +! Beware: both RedistributeStart and RedistributeFinish *must* +! be called with the same values of Inter and Forward. Nesting +! of asynchronous distributions is forbidden. In addition, any +! other communication in the between RedistributeStart and +! RedistributeFinish cannot used the communicator "CommGlobal" +! provided by parutilitiesmodule. +! +! !SYSTEM ROUTINES: +! ALLOCATE +! +! !REVISION HISTORY: +! 99.11.17 Sawyer Creation from RedistributePerform +! +! !BUGS: +! Currently limited to the global communicator. +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + INTEGER I, Ierr, Dest( Gsize ), Src( Gsize ) + + CPP_ENTER_PROCEDURE( "REDISTRIBUTESTART" ) + + DO I = 1, Gsize + Dest( I ) = I-1 + Src( I ) = I-1 + ENDDO + + IF ( Forward ) THEN +! +! Forward redistribution +! + ALLOCATE( InStatic( SUM( Inter%CountA ) ) ) + ALLOCATE( OutStatic( SUM( Inter%CountB ) ) ) + DO I = 1, SUM( Inter%CountA ) + InStatic( I ) = Input( Inter%PermA( I ) ) + ENDDO + CALL ParBeginTransfer( CommGlobal, Gsize, Gsize, Dest, Src, & + InStatic, Inter%CountA, & + OutStatic, Inter%CountB ) + + ELSE +! +! Backward redistribution +! + ALLOCATE( InStatic( SUM( Inter%CountB ) ) ) + ALLOCATE( OutStatic( SUM( Inter%CountA ) ) ) + DO I = 1, SUM( Inter%CountB ) + InStatic( Inter%PermB( I ) ) = Input( I ) + ENDDO + CALL ParBeginTransfer( CommGlobal, Gsize, Gsize, Dest, Src, & + InStatic, Inter%CountB, & + OutStatic, Inter%CountA ) + + ENDIF + CPP_LEAVE_PROCEDURE( "REDISTRIBUTESTART" ) + RETURN +!EOC + END SUBROUTINE RedistributeStart +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: RedistributeFinish --- Complete Asynchronous Redistribution +! +! !INTERFACE: + SUBROUTINE RedistributeFinish( Inter, Forward, Output ) +! !USES: + USE parutilitiesmodule, ONLY: CommGlobal,Gsize,ParEndTransfer,GID + IMPLICIT NONE +! +! !INPUT PARAMETERS: + TYPE(RedistributeType), INTENT( INOUT ) :: Inter ! Inter info. + LOGICAL :: Forward ! True: A -> B False: B -> A +! !OUTPUT PARAMETERS: + REAL(CPP_REAL8), INTENT( OUT ) :: Output( * ) ! Output Array +! +! !DESCRIPTION: +! +! This routine completes an asynchronous redistribution of Input +! to Output according to the RedistributionType data structure Inter. +! The redistribution can be from A -> B ("forward") or B -> A +! ("backward"). This feature has been added to avoid the +! need of a separate Inter (which requires considerable +! memory) to perform the backward redistribution. +! +! See additional documentation in RedistributeStart. +! +! !SYSTEM ROUTINES: +! DEALLOCATE +! +! !REVISION HISTORY: +! 99.11.17 Sawyer Creation from RedistributePerform +! +! !BUGS: +! Currently limited to the global communicator. +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + INTEGER I, Dest( Gsize ), Src( Gsize ) + + CPP_ENTER_PROCEDURE( "REDISTRIBUTEFINISH" ) + + DO I = 1, Gsize + Dest( I ) = I-1 + Src( I ) = I-1 + ENDDO + + IF ( Forward ) THEN + CALL ParEndTransfer( CommGlobal, Gsize, Gsize, Dest, Src, & + InStatic, Inter%CountA, & + OutStatic, Inter%CountB ) + DO I = 1, SUM( Inter%CountB ) + Output( I ) = OutStatic( Inter%PermB( I ) ) + ENDDO + ELSE + CALL ParEndTransfer( CommGlobal, Gsize, Gsize, Dest, Src, & + InStatic, Inter%CountB, & + OutStatic, Inter%CountA ) + DO I = 1, SUM( Inter%CountA ) + Output( Inter%PermA( I ) ) = OutStatic( I ) + ENDDO + ENDIF + DEALLOCATE( OutStatic ) + DEALLOCATE( InStatic ) + + CPP_LEAVE_PROCEDURE( "REDISTRIBUTEFINISH" ) + RETURN +!EOC + END SUBROUTINE RedistributeFinish +!----------------------------------------------------------------------- +#endif + END MODULE redistributemodule diff --git a/src/utils/pilgrim/unit_testers/Makefile b/src/utils/pilgrim/unit_testers/Makefile new file mode 100644 index 0000000000..c57768c8f7 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/Makefile @@ -0,0 +1,50 @@ + +include ../Makefile.conf + +PILGRIMLIB = ../libpilgrim.a +TESTSRCS = decomptest.F90 parutilitiestest.F90 ghosttest.F90 \ + redistributetest.F90 parpatterntest.F90 unstructured.F90 +TESTS = decomptest parutilitiestest ghosttest \ + redistributetest parpatterntest +TESTOBJS = ${TESTSRCS:.F90=.o} + +#OPTIONS = -DSTAND_ALONE -DTIMING -I. -I.. +OPTIONS = -I.. + +.SUFFIXES: .F90 .c .o + +# ------------------------------------------------------------------- + +All: tests + +all: tests + +tests: clean $(TESTS) + +metis: + (cd metis-4.0; make; cp libmetis.a ..) + +decomptest: $(PILGRIMLIB) decomptest.o + $(LD) $(LDFLAGS) -o decomptest decomptest.o -L.. -lpilgrim + +parutilitiestest: $(PILGRIMLIB) parutilitiestest.o + $(LD) $(LDFLAGS) -o parutilitiestest parutilitiestest.o -L.. -lpilgrim $(_LMPI) $(_lMPI) + +ghosttest: $(PILGRIMLIB) ghosttest.o + $(LD) $(LDFLAGS) -o ghosttest ghosttest.o -L.. -lpilgrim $(_LMPI) $(_lMPI) + +redistributetest: $(PILGRIMLIB) redistributetest.o + $(LD) $(LDFLAGS) -o redistributetest redistributetest.o -L.. -lpilgrim $(_LMPI) $(_lMPI) + +parpatterntest: $(PILGRIMLIB) unstructured.o parpatterntest.o + $(LD) $(LDFLAGS) -o parpatterntest parpatterntest.o unstructured.o -L.. -lpilgrim $(_LMPI) $(_lMPI) + +.F90.o: + $(FC) $(FFLAGS) $(DFLAGS) $(OPTIONS) -c $< + +clean: + -@${RM} -f $(TESTOBJS) $(TESTS) *~ *.mod *.MOD + +libclean: + -@${RM} -f $(PILGRIMLIB) + diff --git a/src/utils/pilgrim/unit_testers/README b/src/utils/pilgrim/unit_testers/README new file mode 100644 index 0000000000..d497522bb8 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/README @@ -0,0 +1,54 @@ + PILGRIM Tests and Examples + -------------------------- + +This directory contains test programs and examples for the CCM version +of the Parallel Library for Grid Manipulations. The actually library +code resides in another location of the CCM baseline. + +These unit and minor integration tests serve to validate PILGRIM, +but they can also be used as benchmarks: CCM timers have been +built in. + + +Tests: +------ + + DecompTest: Tests decomposition creation, + deletion, permutation in decompmodule. + Contains no communication and runs sequentially. + + ParUtilitiesTest: Tests the basic communication primitives + from parutilitiesmodule; uses features + from decompmodule + + GhostTest: Tests the ghosting primitives in + ghostmodule, along with decomposition + and communications primitives to perform + a realistic example of ghosting: defining + a ghosted region, performing a transfer of + the ghost region, and testing the result + + RedistributeTest: Redistributes arrays between various + decompositions. Tests the redistribution + primitives in redistributemodule and + indirectly those in parutilities module. + + + +Installation: +------------- + +The build procedure is closely integrated with the general CCM +build procedure and uses the corresponding CCM makefiles for the +LR variant of the model. + + + make all -- Create all test programs. + + make GhostTest -- Create only GhostTest (DecompTest, + ParUtilitiesTest, RedistributeTest) + + make clean -- clean up + + +WS, 2001.05.13 diff --git a/src/utils/pilgrim/unit_testers/decomptest.F90 b/src/utils/pilgrim/unit_testers/decomptest.F90 new file mode 100644 index 0000000000..37062fc3af --- /dev/null +++ b/src/utils/pilgrim/unit_testers/decomptest.F90 @@ -0,0 +1,281 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- +!BOP +! !ROUTINE: DecompTest --- Unit tester for the decomposition utilities +! +! !INTERFACE: + PROGRAM decomptest + +! !USES: + USE decompmodule + +#include "pilgrim.h" +#include "debug.h" + + IMPLICIT NONE + +! !DESCRIPTION: +! +! This main program tests the functionality of the DecompModule +! It performs the following tests: +! +! \begin{enumerate} +! \item DecompRegular1D +! \item DecompRegular2D +! \item DecompGlobalToLocal +! \item DecompLocalToGlobal +! \end{enumerate} +! +! Validation check: ./DecompTest +! +! Should yield a single message (if -DDEBUG_ON is *not* defined): +! +! Passed all tests +! +! Be patient, it may take 2 minutes. +! +! !LOCAL VARIABLES: + TYPE (DecompType) :: Decomp1d, Decomp2d, Decomp1dPerm + +! For the Observation decomposition + INTEGER :: NPEsComp, BlockLen, I, J, Local, Global, Pe, Local2, Pe2 + INTEGER :: Nactual, NPEsMax, Nx, Ny, Iglobal, Jglobal, Kglobal, K + PARAMETER (Nactual = 131, NPEsMax = 4, Nx = 72, Ny = 46 ) + + LOGICAL :: Passed + REAL (CPP_REAL8), ALLOCATABLE :: Rtmp(:) + INTEGER , ALLOCATABLE :: itmp(:), ilocal(:), Dist(:), Tags(:) + INTEGER , ALLOCATABLE :: Xdist(:), Ydist(:), Perm(:) + +! !REVISION HISTORY: +! 98.03.20 Sawyer Creation +! 98.05.11 Sawyer Added test of DecompCopy, DecompPermute +! 99.03.05 Sawyer Renovated for complete unit test concept +! 01.02.07 Sawyer Removed DG2L 2D test, added DecompCreate tests +! 01.05.01 Sawyer free-format +! +!EOP +!------------------------------------------------------------------------- +!BOC +! + Passed = .TRUE. + NPEsComp = 1 + DO WHILE( Passed .AND. NPEsComp .LE. NPEsMax ) +! +! Test 1 : Test DecompRegular1D +! using a block-wise distribution. +! + ALLOCATE( Dist( NPEsComp ) ) +! +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! + BlockLen = Nactual + DO I = 1, NPEsComp-1 + Dist( I ) = BlockLen / 2 + BlockLen = BlockLen - Dist(I) + ENDDO + Dist( NPEsComp ) = BlockLen + IF ( SUM( Dist ) .ne. Nactual ) THEN + print *, "Error: Dist contains ", SUM(Dist), " != ",Nactual + ENDIF + CALL DecompCreate( NPEsComp, Dist, Decomp1D ) + + DEALLOCATE( Dist ) + + DO J = 1, Nactual + CALL DecompGlobalToLocal( Decomp1D, J, Local, Pe ) + CALL DecompLocalToGlobal( Decomp1D, Local, Pe, Global ) + IF ( J .NE. Global ) THEN + PRINT *, "DecompTest failed: 1D Global<->Local mapping: " + PRINT *, "GlobalIn ", J, " = ( ", Local, ",", Pe, ")" + PRINT *, "But: (", Local, ",", Pe, ") = ", Global + Passed = .FALSE. + ENDIF + ENDDO + CALL DecompFree( Decomp1D ) + +! +! Test 2 : Test DecompRegular2D +! + ALLOCATE( Xdist( NPEsComp ) ) + ALLOCATE( Ydist( NPEsComp ) ) +! + BlockLen = Nactual + DO I = 1, NPEsComp-1 + Xdist( I ) = BlockLen / 2 + Ydist( I ) = Nactual / NPEsComp + BlockLen = BlockLen - Xdist(I) + ENDDO + Xdist( NPEsComp ) = BlockLen + Ydist( NPEsComp ) = Nactual - (NPEsComp-1)*(Nactual/NPEsComp) + CALL DecompCreate( NPEsComp, NPEsComp, Xdist, Ydist, Decomp2D ) + DO J = 1, Nactual + DO I = 1, Nactual + K = (J-1)*Nactual + I + CALL DecompGlobalToLocal( Decomp2D, K, Local, Pe ) + CALL DecompLocalToGlobal( Decomp2D, Local, Pe, Kglobal ) + Iglobal = MOD( Kglobal - 1, Nactual ) + 1 + Jglobal = ( Kglobal - 1 ) / Nactual + 1 + IF ( I .NE. Iglobal .OR. J .NE. Jglobal ) THEN + PRINT *, "DecompTest failed: 2D Global<->Local mapping: " + PRINT *, "( ",I,J," ) != ( ", Iglobal, Jglobal, ")" + Passed = .FALSE. + ENDIF + ENDDO + ENDDO + + DEALLOCATE( Ydist ) + DEALLOCATE( Xdist ) + CALL DecompFree( Decomp2D ) + +! +! Test 3 : Test DecompPermute +! + ALLOCATE( Dist( NPEsComp ) ) +! +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs Same as Test 1 +! + BlockLen = Nactual + DO I = 1, NPEsComp-1 + Dist( I ) = BlockLen / 2 + BlockLen = BlockLen - Dist(I) + ENDDO + Dist( NPEsComp ) = BlockLen + IF ( SUM( Dist ) .ne. Nactual ) THEN + print *, " Error: Dist contains ", SUM(Dist), " != ",Nactual + ENDIF + CALL DecompCreate( NPEsComp, Dist, Decomp1D ) + + DEALLOCATE( Dist ) +! +! Copy and permute decomposition +! + CALL DecompCopy( Decomp1d, Decomp1dPerm ) + ALLOCATE( Perm( NPEsComp ) ) + DO I = 1, NPEsComp + Perm( NPEsComp - I + 1 ) = I + ENDDO + CALL DecompPermute( Perm, Decomp1dPerm ) + +! +! Run a simple test of the permutation +! + DO J = 1, Nactual + CALL DecompGlobalToLocal( Decomp1D, J, Local, Pe ) + CALL DecompGlobalToLocal( Decomp1DPerm, J, Local2, Pe2 ) + IF ( (Pe+1) .NE. Perm( Pe2+1 ) .OR. Local .NE. Local2 ) THEN + PRINT *, "DecompTest failed, 1D permuted decomposition" + PRINT *, "GlobalIn ", J, " = ( ", Local, ",", Pe, ")" + PRINT *, "But permuted: (", Local2, ",", Perm(Pe2+1)-1, ")" + Passed = .FALSE. + ENDIF + ENDDO + CALL DecompFree( Decomp1D ) + DEALLOCATE( Perm ) + +! +! +! Test 4 : Test DecompCreate +! + ALLOCATE( Tags( Nactual ) ) + ALLOCATE( Dist( Nactual ) ) + ALLOCATE( Rtmp( Nactual ) ) + ALLOCATE( Perm( NPEsComp ) ) + +! +! A random PE assignment is by far the hardest test for the library +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + Dist = INT( NPesComp*Rtmp - 0.5_r8 ) +! +! This is the simple version of an irregular decomposition +! + CALL DecompCreate( NPEsComp, Dist, Nactual, Decomp1D ) +! +! Now some tests: basically go through all the local index to see +! if every global tag is accounted for +! + Perm = 0 + Tags = 0 + DO I = 1, Nactual + Perm( Dist(I) + 1 ) = Perm( Dist(I) + 1 ) + 1 + ENDDO + DO pe=1,NPEsComp + DO Local=1,Perm(pe) + CALL DecompLocalToGlobal( Decomp1D, Local, Pe-1, Global ) + IF ( Tags( Global ) .NE. 0 ) THEN + print *, "Error: DecompCreate" + print *, "Local index",Local, Pe-1, "maps to", Global + print *, "but", Global, "is taken by another index" + Passed = .FALSE. + ENDIF + ENDDO + ENDDO + +! +! Now get trickier: define a unique, but not contiguous set of tags, +! for example a subset of 1..Nactual. +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + global = 0 + DO I=1, Nactual + IF ( Rtmp(I) .GE. 0.3333_r8 .AND. Rtmp(I) .LT. 0.6667_r8 ) THEN + global = global + 1 + Tags( global ) = I + ENDIF + ENDDO +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + Dist = INT( NPesComp*Rtmp - 0.5_r8 ) + +! +! This is the esoteric version of an irregular decomposition +! + CALL DecompCreate( NPEsComp, Dist, Global, Tags, Decomp1Dperm ) +! +! Now check that each of the active tags is properly defined +! + K = 0 + DO i=1, Nactual + CALL DecompGlobalToLocal( Decomp1Dperm, i, Local, Pe ) + IF ( Pe .NE. -1 ) THEN + K = K + 1 + IF ( Dist( K ) .NE. Pe ) THEN + print *, "Error DecompCreate test" + print *, "Element", I,"on", Pe, "instead of", Dist(K) + Passed = .FALSE. + ENDIF + ENDIF + ENDDO + IF ( K .NE. Global ) THEN + print *, "Error: DecompCreate test" + print *, "Found", K, "unique tags", "not correct", Global + Passed = .FALSE. + ENDIF + + DEALLOCATE( Perm ) + DEALLOCATE( Rtmp ) + DEALLOCATE( Dist ) + DEALLOCATE( Tags ) + +! +! Next PE configuration +! + NPEsComp = NPEsComp * 2 + ENDDO + +! +! That's all folks +! + IF ( Passed ) THEN + PRINT *, "Passed DecompTest" + ELSE + PRINT *, "Failed DecompTest" + ENDIF + +!EOC +!------------------------------------------------------------------------- + END PROGRAM decomptest diff --git a/src/utils/pilgrim/unit_testers/ghosttest.F90 b/src/utils/pilgrim/unit_testers/ghosttest.F90 new file mode 100644 index 0000000000..2fad27d6e1 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/ghosttest.F90 @@ -0,0 +1,539 @@ +!------------------------------------------------------------------------ +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------ +!BOP +! !ROUTINE: GhostTest --- Unit tester for the decomposition utilities +! +! !INTERFACE: + PROGRAM GhostTest + +! !USES: + USE decompmodule, ONLY: DecompType, DecompFree, DecompRegular1D, & + & DecompRegular2D, DecompRegular3D, DecompCreate, & + & DecompLocalToGlobal + USE ghostmodule, ONLY: GhostType, GhostFree, GhostCreate, & + & GhostCopy, GhostInfo + USE parutilitiesmodule, ONLY: CommGlobal, GID, GSize, & + & ParPatternType, ParPatternCreate, ParPatternFree, & + & ParInit, ParExit, ParBeginTransfer, ParEndTransfer +#if defined(TIMING) + USE perf_mod +#endif + +#include "debug.h" +#include "pilgrim.h" + + IMPLICIT NONE +#if defined(TIMING) +#include "gptl.inc" +#endif + +! !DESCRIPTION: +! +! This main program tests the functionality of the GhostModule +! It performs the following tests: +! +! \begin{enumerate} +! \item 1D ghost region of a 1D decomposition +! \item 2D ghost region of a 2D decomposition +! \item 3D ghost region of a 3D decomposition +! \item irregular ghost region of an irregular decomposition +! \end{enumerate} +! +! Validation check: +! +! mpirun -np 7 GhostTest +! +! Should yield a single message (if -DDEBUG_ON is *not* defined): +! +! Passed all tests +! +! Be patient, it tests many complex cases, so it could take a while +! +! !REVISION HISTORY: +! 01.02.07 Sawyer Creation +! 01.05.01 Sawyer Minor changes for CCM framework +! 02.08.14 Sawyer No uses explicit precisions +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + TYPE (DecompType) :: Decomp + TYPE (GhostType) :: Ghost + TYPE (ParPatternType) :: Pattern, Pattern2d, Pattern3d + + INTEGER :: Nactual, GhostWidth, Nx, Ny + PARAMETER (Nactual = 100, GhostWidth = 4, Nx = 72, Ny = 46 ) + +! For the Observation decomposition + INTEGER :: BlockLen, I, J, K, Local, Global, Pe + INTEGER :: PEsInX, PEsInY, PEsInZ, IamInX, IamInY, IamInZ + INTEGER :: Xstart, Xend, Ystart, Yend, Zstart, Zend, Ytrue, Ztrue + + LOGICAL :: Passed + REAL (CPP_REAL8), ALLOCATABLE :: Rtmp(:), Rtmp2d(:,:), Rtmp3d(:,:,:) + INTEGER , ALLOCATABLE :: itmp(:), ilocal(:), Dist(:), & + Tags(:), Xdist(:), Ydist(:), Zdist(:), Perm(:) + +! +! GhostModule is communication-free, but in this test a communication +! pattern is constructed for different ghost regions. This makes it +! an SPMD code. +! + CALL ParInit() + Passed = .TRUE. + +! +! Initialize timing library. 2nd arg 0 means disable, 1 means enable +! +#if defined(TIMING) + call t_setoptionf (gptlcpu, 1) + call t_initializef () +#endif + +! +! Test 1 : Test GhostRegular1D +! using a block-wise distribution. +! +#if defined(TIMING) + call t_startf('1D Ghosting Total') +#endif + + ALLOCATE( Xdist( GSize ) ) +! +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! + Global = Nactual*Gsize + BlockLen = Global + DO I = 1, GSize-1 + Xdist( I ) = BlockLen / 2 + BlockLen = BlockLen - Xdist(I) + ENDDO + Xdist( GSize ) = BlockLen + CALL DecompRegular1D ( GSize, Xdist, Decomp ) + +! +! Now define a ghost region (i.e., a subset of the entire domain) +! + Xstart = 1 + IF (GID .GT. 0) Xstart = SUM( Xdist(1:GID) ) + 1 + Xend = Global + IF (GID .LT. Gsize-1) Xend = Xstart + Xdist(GID+1) - 1 + DEALLOCATE( Xdist ) + +! +! Define ghost region with GhostWidth overlap (and wrap-around) +! + CALL GhostCreate( Decomp, Gid, Global, & + & Xstart-GhostWidth, Xend+GhostWidth, .TRUE., Ghost ) + +! Allocate the ghosted region itself + ALLOCATE( Rtmp( Xstart-GhostWidth:Xend+GhostWidth ) ) + +! +! Put the correct global tag into entry of the array, but zero out ghost region +! + Rtmp = 0.0_r8 + DO I=Xstart, Xend + Rtmp(I) = I + ENDDO + +! +! Now create a communication pattern which interrelates all the +! ghosted vectors +! +#if defined(TIMING) + call t_startf('1D PatternCreate') +#endif + CALL ParPatternCreate( CommGlobal, Ghost, Pattern ) +#if defined(TIMING) + call t_stopf('1D PatternCreate') +#endif + + +! +! Do a test with the communication pattern +! +#if defined(TIMING) + call t_startf('1D Ghost Transfer') +#endif + CALL ParBeginTransfer( Pattern, Rtmp, Rtmp ) + CALL ParEndTransfer( Pattern, Rtmp, Rtmp ) +#if defined(TIMING) + call t_stopf('1D Ghost Transfer') +#endif + DO I=Xstart-GhostWidth, Xend+GhostWidth + IF ( Rtmp(I) .NE. MODULO(I-1,Global)+1 ) THEN + print *, "Error on PE", GID, "Rtmp(",I,")=",Rtmp(I) + Passed = .FALSE. + ENDIF + ENDDO + +! +! Free the communication pattern +! + DEALLOCATE( Rtmp ) + CALL ParPatternFree( CommGlobal, Pattern ) + CALL GhostFree( Ghost ) + CALL DecompFree( Decomp ) + +#if defined(TIMING) + call t_stopf('1D Ghosting Total') +#endif + +! +! Test 2 : Test DecompRegular2D +! + +#if defined(TIMING) + call t_startf('2D Ghosting Total') +#endif + IF ( Gsize .GT. 1 ) THEN + PEsInX = 2 + DO WHILE ( MOD(Gsize,PEsInX) .NE. 0 ) + PEsInX = PEsInX + 1 + ENDDO + ELSE + PEsInX = 1 + ENDIF +! +! In the worst case PEsInX = Gsize, PEsInY=1 +! + PEsInY = Gsize / PEsInX + + IamInY = GID / PEsInX + IamInX = MOD( GID, PEsInX ) + + ALLOCATE( Xdist( PEsInX ) ) + ALLOCATE( Ydist( PEsInY ) ) +! + BlockLen = Nactual + DO I = 1, PEsInX-1 + Xdist( I ) = BlockLen / 2 + BlockLen = BlockLen - Xdist(I) + ENDDO + Xdist( PEsInX ) = BlockLen + + DO J = 1, PEsInY-1 + Ydist( J ) = Nactual / PEsInY + ENDDO + Ydist( PEsInY ) = Nactual - (PEsInY-1)*(Nactual/PEsInY) + + CALL DecompRegular2D( PEsInX, PEsInY, Xdist, Ydist, Decomp ) + + Xstart = 1 + IF (IamInX .GT. 0) Xstart = SUM( Xdist(1:IamInX) ) + 1 + Xend = Nactual + IF (IamInX .LT. PEsInX-1) Xend = Xstart + Xdist(IamInX+1) - 1 + Ystart = 1 + IF (IamInY .GT. 0) Ystart = SUM( Ydist(1:IamInY) ) + 1 + Yend = Nactual + IF (IamInY .LT. PEsInY-1) Yend = Ystart + Ydist(IamInY+1) - 1 + + DEALLOCATE( Ydist ) + DEALLOCATE( Xdist ) + +! +! Now define a ghost region (i.e., a subset of the entire domain) +! + CALL GhostCreate( Decomp, Gid, & + & Nactual, Xstart-GhostWidth, Xend+GhostWidth,.TRUE., & + & Nactual, Ystart-GhostWidth, Yend+GhostWidth,.FALSE., & + & Ghost) + +! +! Allocated the corresponding ghosted array: Note that some ghost regions +! will not be used (there is no wrap around) +! + ALLOCATE( Rtmp2d(Xstart-GhostWidth:Xend+GhostWidth, & + & Ystart-GhostWidth:Yend+GhostWidth) ) + + +! +! Put the correct global tag into entry of the array, but zero out ghost region +! + Rtmp2d = 0.0_r8 + DO J=Ystart, Yend + DO I=Xstart, Xend + Rtmp2d(I,J) = (J-1)*Nactual + I + ENDDO + ENDDO + +#if defined(TIMING) + call t_startf('2D PatternCreate') +#endif + CALL ParPatternCreate( CommGlobal, Ghost, Pattern2d ) +#if defined(TIMING) + call t_stopf('2D PatternCreate') +#endif + +! +! Do a test with the communication pattern +! +#if defined(TIMING) + call t_startf('2D Ghost Transfer') +#endif + CALL ParBeginTransfer( Pattern2d, Rtmp2d, Rtmp2d ) + CALL ParEndTransfer( Pattern2d, Rtmp2d, Rtmp2d ) +#if defined(TIMING) + call t_stopf('2D Ghost Transfer') +#endif + + DO J=Ystart, Yend + Ytrue = MODULO(J-1,Nactual) + DO I=Xstart-GhostWidth, Xend+GhostWidth + Global = Ytrue*Nactual + MODULO(I-1,Nactual) + 1 + IF ( Rtmp2D(I,J) .NE. Global ) THEN + print *, "Error on PE", GID, "Rtmp2d(",I,J,")=",Rtmp2d(I,J) + Passed = .FALSE. + ENDIF + ENDDO + ENDDO + +! +! Free the communication pattern +! + CALL ParPatternFree( CommGlobal, Pattern2d ) + DEALLOCATE( Rtmp2D ) + CALL GhostFree( Ghost ) + CALL DecompFree( Decomp ) + +#if defined(TIMING) + call t_stopf('2D Ghosting Total') +#endif + +#if 0 +! +! Test 3 : Test DecompRegular3D +! +#if defined(TIMING) + call t_startf('3D Ghosting Total') +#endif +! +! In the case of a prime: PEsInZ = Gsize, PEsInY=1, PEsInX=1 +! + IF ( Gsize .GT. 1 ) THEN + PEsInZ = 2 + DO WHILE ( MOD(Gsize,PEsInZ) .NE. 0 ) + PEsInZ = PEsInZ + 1 + ENDDO + ELSE + PEsInZ = 1 + ENDIF + Pe = Gsize / PEsInZ + + IF ( Pe .GT. 1 ) THEN + PEsInY = 2 + DO WHILE ( MOD(Pe,PEsInY) .NE. 0 ) + PEsInY = PEsInY + 1 + ENDDO + ELSE + PEsInY = 1 + ENDIF +! + PEsInX = Pe / PEsInY +! + IamInX = MOD( GID, PEsInX ) + IamInY = MOD( GID/PEsInX, PEsInY ) + IamInZ = GID / Pe + + ALLOCATE( Xdist( PEsInX ) ) + ALLOCATE( Ydist( PEsInY ) ) + ALLOCATE( Zdist( PEsInZ ) ) +! + BlockLen = Nactual + DO I = 1, PEsInX-1 + Xdist( I ) = BlockLen / 2 + BlockLen = BlockLen - Xdist(I) + ENDDO + Xdist( PEsInX ) = BlockLen + + DO J = 1, PEsInY-1 + Ydist( J ) = Nactual / PEsInY + ENDDO + Ydist( PEsInY ) = Nactual - (PEsInY-1)*(Nactual/PEsInY) + + BlockLen = Nactual + DO K = PEsInZ,2,-1 + Zdist( K ) = BlockLen / 2 + BlockLen = BlockLen - Zdist(K) + ENDDO + Zdist( 1 ) = BlockLen + + CALL DecompRegular3D( PEsInX, PEsInY, PEsInZ, & + & Xdist, Ydist, Zdist, Decomp ) + + Xstart = 1 + IF (IamInX .GT. 0) Xstart = SUM( Xdist(1:IamInX) ) + 1 + Xend = Nactual + IF (IamInX .LT. PEsInX-1) Xend = Xstart + Xdist(IamInX+1) - 1 + Ystart = 1 + IF (IamInY .GT. 0) Ystart = SUM( Ydist(1:IamInY) ) + 1 + Yend = Nactual + IF (IamInY .LT. PEsInY-1) Yend = Ystart + Ydist(IamInY+1) - 1 + Zstart = 1 + IF (IamInZ .GT. 0) Zstart = SUM( Zdist(1:IamInZ) ) + 1 + Zend = Nactual + IF (IamInZ .LT. PEsInZ-1) Zend = Zstart + Zdist(IamInZ+1) - 1 + + DEALLOCATE( Zdist ) + DEALLOCATE( Ydist ) + DEALLOCATE( Xdist ) + +#if defined(DEBUG_GHOSTTEST) + print *, GID, "Xstart", Xstart, "Xend", Xend, "Ystart", Ystart, & + & "Yend", Yend, "Zstart", Zstart, "Zend", Zend, & + & "IamInX", IamInX, "IamInY", IamInY, "IamInZ", IamInZ +#endif + +! +! Now define a ghost region (i.e., a subset of the entire domain) +! + CALL GhostCreate( Decomp, Gid, & + & Nactual, Xstart-GhostWidth, Xend+GhostWidth,.FALSE., & + & Nactual, Ystart-GhostWidth, Yend+GhostWidth,.FALSE., & + & Nactual, Zstart-GhostWidth, Zend+GhostWidth,.TRUE., & + & Ghost) + +! +! Allocated the corresponding ghosted array: Note that some ghost regions +! will not be used (there is no wrap around) +! + ALLOCATE( Rtmp3d(Xstart-GhostWidth:Xend+GhostWidth, & + & Ystart-GhostWidth:Yend+GhostWidth, & + & Zstart-GhostWidth:Zend+GhostWidth) ) + +! +! Put the correct global tag into entry of the array, but zero out ghost region +! + Rtmp3d = 0.0_r8 + DO K=Zstart, Zend + DO J=Ystart, Yend + DO I=Xstart, Xend + Rtmp3d(I,J,K) = (K-1)*Nactual*Nactual + (J-1)*Nactual + I + ENDDO + ENDDO + ENDDO +#if defined(TIMING) + call t_startf('3D PatternCreate') +#endif + CALL ParPatternCreate( CommGlobal, Ghost, Pattern3d ) +#if defined(TIMING) + call t_stopf('3D PatternCreate') +#endif + +! +! Do a test with the communication pattern +! +#if defined(TIMING) + call t_startf('3D Ghost Transfer') +#endif + CALL BeginTransfer( Pattern3d, Rtmp3d, Rtmp3d ) + CALL EndTransfer( Pattern3d, Rtmp3d, Rtmp3d ) +#if defined(TIMING) + call t_stopf('3D Ghost Transfer') +#endif + + DO K=Zstart-GhostWidth, Zend+GhostWidth + Ztrue = MODULO(K-1,Nactual) + DO J=Ystart, Yend + Ytrue = MODULO(J-1,Nactual) + DO I=Xstart, Xend + Global = (Ztrue*Nactual+Ytrue)*Nactual+MODULO(I-1,Nactual)+1 + IF ( Rtmp3D(I,J,K) .NE. Global ) THEN + print *, "Error on",GID,"Rtmp3d(",I,J,K,")=",Rtmp3d(I,J,K) + Passed = .FALSE. + ENDIF + ENDDO + ENDDO + ENDDO + +! +! Free the communication pattern +! + CALL ParPatternFree( CommGlobal, Pattern3d ) + CALL GhostFree( Ghost ) + CALL DecompFree( Decomp ) +#if defined(TIMING) + call t_stopf('3D Ghosting Total') +#endif + +! +! Test 4 : Test Irregular Decomposition +! + ALLOCATE( Tags( Nactual ) ) + ALLOCATE( Dist( Nactual ) ) + ALLOCATE( Rtmp( Nactual ) ) + ALLOCATE( Perm( GSize ) ) + +! +! A random PE assignment is by far the hardest test for the library +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + Dist = INT( GSize*Rtmp - 0.5_r8 ) +! +! This is the simple version of an irregular decomposition +! + CALL DecompCreate( GSize, Dist, Nactual, Decomp ) + +! +! Define the Ghost region through an arbitrary set of unique tags +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + global = 0 + DO I=1, Nactual + IF ( Rtmp(I) .GE. 0.3333_r8 .AND. Rtmp(I) .LT. 0.6667_r8 ) THEN + global = global + 1 + Tags( global ) = I + ENDIF + ENDDO +! + CALL RANDOM_NUMBER( HARVEST = Rtmp ) + Dist = INT( GSize*Rtmp - 0.5_r8 ) + +! +! This is the esoteric version of an irregular decomposition +! + CALL GhostCreate( Decomp, Gid, Global, Tags, Ghost ) + DEALLOCATE( Perm ) + DEALLOCATE( Rtmp ) + DEALLOCATE( Dist ) + DEALLOCATE( Tags ) + + CALL DecompFree( Decomp ) + + CALL ParPatternCreate( CommGlobal, Ghost, Pattern ) + CALL GhostFree( Ghost ) + +! +! Do a test with the communication pattern +! + +! +! Free the communication pattern +! + CALL ParPatternFree( CommGlobal, Pattern ) +#endif + +! +! That's all folks +! +#if defined(TIMING) + call t_prf(GID) +#endif + + IF ( Passed ) THEN + PRINT *, "Passed GhostTest" + ELSE + PRINT *, "Failed GhostTest" + ENDIF + + CALL ParExit() + +!EOC +!------------------------------------------------------------------------- + END PROGRAM GhostTest + diff --git a/src/utils/pilgrim/unit_testers/parpatterntest.F90 b/src/utils/pilgrim/unit_testers/parpatterntest.F90 new file mode 100644 index 0000000000..7596fee033 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/parpatterntest.F90 @@ -0,0 +1,474 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- +!BOP +! !ROUTINE: ParPatternTest --- Unit tester for the parutilities patterns +! +! !INTERFACE: + PROGRAM parpatterntest + +! !USES: + USE decompmodule, ONLY: DecompType, DecompFree, DecompPermute, & + & DecompCreate + USE parutilitiesmodule, ONLY: Gsize, GID, CommGlobal, & + & ParPatternType, ParInit, ParExit, ParScatter, ParGather, & + & ParPatternCreate, ParPatternFree, & + & ParBeginTransfer, ParEndTransfer +#if defined(TIMING) + USE perf_mod +#endif + +#include "debug.h" +#include "pilgrim.h" + + IMPLICIT NONE +#if defined(TIMING) +#include "gptl.inc" +#endif + +! !DESCRIPTION: +! +! This main program tests the functionality of the decompmodule +! and parutilitiesmodule which relates to communication patterns. +! +! Test 1: DecompRegular1D, ParPatternCreate, ParBegin/EndTransfer +! +! Validation check: +! +! mpirun -np 7 parpatterntest +! +! Should yield a single message (if -DDEBUG_ON is *not* defined): +! +! Passed all tests +! +! !REVISION HISTORY: +! 01.06.03 Sawyer Creation from RedistributeTest +! 02.08.14 Sawyer Now using explicit precision from pilgrim.h +! +!EOP +!------------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: GlobalPEs, GlobalRank, I, J, Ierror + TYPE (DecompType) :: DecompA, DecompB, ObsDecomp + TYPE (ParPatternType) :: InterAB, InterBA + INTEGER :: BlockLen, Remainder, Ipe + REAL (CPP_REAL8) :: time1, time2, time3 + LOGICAL Passed + + +! For the Observation decomposition + INTEGER :: Nactual, Xdim, Ydim, Zdim + PARAMETER ( Nactual = 7 ) + PARAMETER ( Xdim = 144 ) + PARAMETER ( Ydim = 91 ) + PARAMETER ( Zdim = 30 ) + + REAL (CPP_REAL8), ALLOCATABLE :: Rglobal(:), Rtmp(:), RlocalA(:), RlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R2dlocalA(:), R2dlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R2dGlobal(:), R2dtmp(:) +! +! 3D Arrays are smashed down to 1D +! + REAL (CPP_REAL8), ALLOCATABLE :: R3dlocalA(:), R3dlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R3dGlobal(:), R3dTmp(:) + + INTEGER , ALLOCATABLE :: itmp(:), DistA(:), DistB(:) + INTEGER , ALLOCATABLE :: Xdist(:), Ydist(:), Zdist(:), Perm(:) + + CALL ParInit( ) + Passed = .TRUE. + +! +! Initialize timing library. 2nd arg 0 means disable, 1 means enable +! +#if defined(TIMING) + call t_setoptionf (gptlcpu, 1) + call t_initializef () +#endif + +! +! Test 1 : Test DecompRegular1D, DecompPermute, ParScatter1D, ParGather1D +! and Redistribution using a block-wise distribution. +! + +#if defined(TIMING) + call t_startf('1D Redist Total') +#endif + +! +! Set the global vector to random values +! + ALLOCATE( Rtmp(Nactual) ) + rtmp = 1.0_r8 +! +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! +! + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + ALLOCATE( Perm( Gsize ) ) + BlockLen = Nactual + DO I = 1, Gsize-1 + DistA( I ) = BlockLen / 2 + BlockLen = BlockLen - DistA(I) + ENDDO + DistA( Gsize ) = BlockLen + IF ( SUM( DistA ) .ne. Nactual ) THEN + print *, " Error: DistA contains ", SUM(DistA), " != ",Nactual + ENDIF + DO I = 1, Gsize + DistB( I ) = DistA( Gsize-I+1 ) + ENDDO + + CALL DecompCreate ( Gsize, DistA, DecompA ) + CALL DecompCreate ( Gsize, DistB, DecompB ) + + DO I=1, Gsize-1 + Perm( I+1 ) = I + ENDDO + Perm( 1 ) = Gsize + CALL DecompPermute( Perm, DecompB ) + + ALLOCATE( RlocalA( DecompA%NumEntries(GID+1) ) ) + ALLOCATE( RlocalB( DecompB%NumEntries(GID+1) ) ) + ALLOCATE( Rglobal( Nactual ) ) + +!!! IF ( GID .EQ. 0 ) THEN +!!! CALL RANDOM_NUMBER( HARVEST = Rglobal ) +!!! ENDIF + DO i=1, Nactual + Rglobal(i) = REAL(i,r8) + ENDDO + +! +! Now scatter the arrays over all PEs +! + CALL ParScatter( CommGlobal, 0, Rglobal, DecompA, RlocalA ) + +! +! Now redistribute the local arrays from one decomposition to another +! +#if defined(TIMING) + call t_startf('1D Redist Create') +#endif + CALL ParPatternCreate( CommGlobal, DecompA, DecompB, InterAB ) + CALL ParPatternCreate( CommGlobal, DecompB, DecompA, InterBA ) +#if defined(TIMING) + call t_stopf('1D Redist Create') +#endif + +#if defined(TIMING) + call t_startf('1D Redist Forward') +#endif + CALL ParBeginTransfer( InterAB, RlocalA, RlocalB ) + CALL ParEndTransfer( InterAB, RlocalA, RlocalB ) +#if defined(TIMING) + call t_stopf('1D Redist Forward') +#endif + RlocalA = 0.0_r8 + +#if defined(TIMING) + call t_startf('1D Redist Back') +#endif + CALL ParBeginTransfer( InterBA, RlocalB, RlocalA ) + CALL ParEndTransfer( InterBA, RlocalB, RlocalA ) +#if defined(TIMING) + call t_stopf('1D Redist Back') +#endif + CALL ParPatternFree( CommGlobal, InterBA ) + CALL ParPatternFree( CommGlobal, InterAB ) + + CALL ParGather( CommGlobal, 0, RlocalA, DecompA, Rtmp ) + + IF ( GID .eq. 0 ) THEN + Rtmp = Rtmp - Rglobal + IF ( SUM(Rtmp) .ne. 0.0_r8 ) THEN + PRINT *, "Redistribution failed: 1D Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( RlocalB ) + DEALLOCATE( RlocalA ) + DEALLOCATE( Rtmp ) + DEALLOCATE( Rglobal ) + +#if defined(TIMING) + call t_stopf('1D Redist Total') +#endif + +! +! Test 2 : Test DecompRegular2D, ParScatter2D and ParGather2D +! and Redistribute using a 2-D block-wise distribution. +! +#if defined(TIMING) + call t_startf('2D Redist Total') +#endif + +! +! Set the target vector to non-random values +! +! +! Make sure that the array is not square +! + ALLOCATE( R2dtmp( XDim*YDim ) ) + +! Set the global vector to random values +! Make sure that the array is not square +! + ALLOCATE( R2dGlobal( XDim*YDim ) ) + IF ( GID .EQ. 0 ) THEN + CALL RANDOM_NUMBER( HARVEST = R2dglobal ) + ENDIF + +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! + + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + ALLOCATE( XDist( 1 ) ) + ALLOCATE( YDist( 1 ) ) + + BlockLen = Xdim + DO I = 1, Gsize-1 + DistA( I ) = BlockLen / 2 + BlockLen = BlockLen - DistA( I ) + ENDDO + DistA( Gsize ) = BlockLen + YDist( 1 ) = Ydim + + XDist( 1 ) = Xdim + BlockLen = Ydim + DO J = 1, Gsize-1 + DistB( J ) = BlockLen / 2 + BlockLen = BlockLen - DistB( J ) + ENDDO + DistB( Gsize ) = BlockLen + +! +! Row-major ordering +! + ALLOCATE( R2dlocalA( DistA(GID+1)*YDist(1) ) ) + ALLOCATE( R2dlocalB( XDist(1)*DistB(GID+1) ) ) + + CALL DecompCreate( Gsize, 1, DistA, YDist, DecompA ) + CALL DecompCreate( 1, Gsize, Xdist, DistB, DecompB ) + +! +! Now scatter the arrays over all PEs +! + CALL ParScatter( CommGlobal, 0, R2dglobal, DecompA, R2dlocalA ) + +#if defined(TIMING) + call t_startf('2D Redist Create') +#endif + CALL ParPatternCreate( CommGlobal, DecompA, DecompB, InterAB ) + CALL ParPatternCreate( CommGlobal, DecompB, DecompA, InterBA ) + +#if defined(TIMING) + call t_stopf('2D Redist Create') +#endif +#if defined(TIMING) + call t_startf('2D Redist Forward') +#endif + CALL ParBeginTransfer( InterAB, R2dlocalA, R2dlocalB ) + CALL ParEndTransfer( InterAB, R2dlocalA, R2dlocalB ) +#if defined(TIMING) + call t_stopf('2D Redist Forward') +#endif + R2dlocalA = 0.0_r8 +#if defined(TIMING) + call t_startf('2D Redist Back') +#endif + CALL ParBeginTransfer( InterBA, R2dlocalB, R2dlocalA ) + CALL ParEndTransfer( InterBA, R2dlocalB, R2dlocalA ) +#if defined(TIMING) + call t_stopf('2D Redist Back') +#endif + + CALL ParPatternFree( CommGlobal, InterAB ) + CALL ParPatternFree( CommGlobal, InterBA ) + + CALL ParGather( CommGlobal, 0, R2dlocalA, DecompA, R2dtmp ) + IF ( GID .eq. 0 ) THEN + R2dtmp = R2dtmp - R2dglobal + IF ( SUM(R2dtmp) .ne. 0.0_r8 ) THEN + PRINT *,"RedistributeTest Failed: 2D Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( R2dlocalB ) + DEALLOCATE( R2dlocalA ) + + DEALLOCATE( YDist ) + DEALLOCATE( XDist ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( R2dtmp ) + DEALLOCATE( R2dglobal ) + +#if defined(TIMING) + call t_stopf('2D Redist Total') +#endif + + +! +! Test 3 : Test 3-D redistribution +! +#if defined(TIMING) + call t_startf('3D Redist Total') +#endif + +! +! Set the target vector to non-random values +! +! +! Make sure that the array is not square +! + ALLOCATE( R3dTmp( Xdim*Ydim*ZDim ) ) + +! Set the global vector to random values +! Make sure that the array is not square +! + ALLOCATE( R3dGlobal( XDim*YDim*ZDim ) ) + IF ( GID .eq. 0 ) THEN + CALL RANDOM_NUMBER( HARVEST = R3dglobal ) + ENDIF + r3dtmp = 1.0_r8 + + +! +! Now define the distribution +! + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + + ALLOCATE( XDist( 1 ) ) + ALLOCATE( YDist( 1 ) ) + ALLOCATE( ZDist( 1 ) ) + + XDist( 1 ) = Xdim + YDist( 1 ) = Ydim + ZDist( 1 ) = Zdim + +! +! Optimal distribution in Z +! + BlockLen = Zdim / Gsize + Remainder = MOD( Zdim, Gsize ) + + IF ( Remainder .gt. 0 ) DistA( 1:Remainder ) = BlockLen+1 + DistA( Remainder+1 : Gsize ) = BlockLen + CALL DecompCreate( 1,1,Gsize,XDist,YDist,DistA,DecompA ) + +! +! Optimal distribution in Y +! + BlockLen = Ydim / Gsize + Remainder = MOD( Ydim, Gsize ) + IF ( Remainder .gt. 0 ) DistB( 1:Remainder ) = BlockLen+1 + DistB( Remainder+1 : Gsize ) = BlockLen + CALL DecompCreate( 1,Gsize,1,XDist,DistB,ZDist,DecompB ) + + ALLOCATE( R3dlocalA( XDist(1)*YDist(1)*DistA(GID+1) ) ) + ALLOCATE( R3dlocalB( XDist(1)*DistB(GID+1)*ZDist(1) ) ) + +! +! Do all the stuff here +! + CALL ParScatter( CommGlobal, 0, R3dglobal, DecompA, R3dlocalA ) + +#if defined( TIMING ) + call t_startf('3D Redist Create') +#endif + + CALL ParPatternCreate( CommGlobal, DecompA, DecompB, InterAB ) + CALL ParPatternCreate( CommGlobal, DecompB, DecompA, InterBA ) + +#if defined(TIMING) + call t_stopf('3D Redist Create') +#endif +#if defined(TIMING) + call t_startf('3D Redist Forward') +#endif + CALL ParBeginTransfer( InterAB, R3dlocalA, R3dlocalB ) + CALL ParEndTransfer( InterAB, R3dlocalA, R3dlocalB ) +#if defined(TIMING) + call t_stopf('3D Redist Forward') +#endif + R3dlocalA = 0.0_r8 +#if defined(TIMING) + call t_startf('3D Redist Back') +#endif + CALL ParBeginTransfer( InterBA, R3dlocalB, R3dlocalA ) + CALL ParEndTransfer( InterBA, R3dlocalB, R3dlocalA ) +#if defined(TIMING) + call t_stopf('3D Redist Back') +#endif + CALL ParPatternFree( CommGlobal, InterAB ) + CALL ParPatternFree( CommGlobal, InterBA ) + + CALL ParGather( CommGlobal, 0, R3dlocalA, DecompA, R3dtmp ) + + IF ( GID .eq. 0 ) THEN + R3dtmp = R3dtmp - R3dglobal + IF ( SUM(R3dtmp) .ne. 0.0_r8 ) THEN + PRINT *, "RedistributeTest failed: 3d Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( R3dlocalB ) + DEALLOCATE( R3dlocalA ) + + DEALLOCATE( ZDist ) + DEALLOCATE( YDist ) + DEALLOCATE( XDist ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( R3dtmp ) + DEALLOCATE( R3dglobal ) + +#if defined(TIMING) + call t_stopf('3D Redist Total') +#endif + +! +! That's all folks +! +#if defined(TIMING) + call t_prf(GID) +#endif + IF ( gid == 0 ) THEN + IF ( Passed ) THEN + PRINT *, "Passed ParPatternTest" + ELSE + PRINT *, "Failed ParPatternTest" + ENDIF + ENDIF + + CALL ParExit( ) + +!EOC +!------------------------------------------------------------------------- + END PROGRAM parpatterntest diff --git a/src/utils/pilgrim/unit_testers/parutilitiestest.F90 b/src/utils/pilgrim/unit_testers/parutilitiestest.F90 new file mode 100644 index 0000000000..22a854d4d9 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/parutilitiestest.F90 @@ -0,0 +1,477 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- +!BOP +! !ROUTINE: ParUtilitiesTest --- Unit tester for the parallel utilities +! +! !INTERFACE: + PROGRAM parutilitiestest + +! !USES: +#include "pilgrim.h" + USE decompmodule, ONLY: DecompType, DecompFree, DecompCreate + USE parutilitiesmodule + + IMPLICIT NONE + +! !DESCRIPTION: +! +! This main program tests the functionality of the ParUtilitites +! module. It performs the following tests: +! +! Test 1: ParSplit, DecompRegular3D +! +! Test 2: DecompRegular2D, ParScatter and ParGather +! +! Test 3: ParExchangeVector +! +! Validation check: +! +! mpirun -np 7 ParUtilitiesTest +! +! Should yield a single message (if -DDEBUG_ON is *not* defined): +! +! Passed all tests +! +! !REVISION HISTORY: +! 00.07.20 Sawyer Creation, from GEOS3_DAS_CORE version +! 00.08.21 Sawyer Tests for ParCollective, ParGather/Scatter +! 01.05.01 Sawyer free format, new decompmodule interfaces +! 02.08.14 Sawyer Added explicit precisions from pilgrim.h +! +!EOP +!------------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: GlobalPEs, GlobalRank, I, J, K, Ierror + TYPE (DecompType) :: Y3D, Z3D, YZ3D, XY2D, XY3D, ObsDecomp + INTEGER :: BlockLen, Ipe, Comm_1, Comm_2,npr_1,npr_2 + INTEGER :: myid_1, myid_2, size_1, size_2, rank_1, rank_2 + LOGICAL Passed + +! For the 2D and 3D decompositions + INTEGER :: Im, Jm, Km + PARAMETER ( Im = 72, Jm = 46, Km = 18 ) + REAL (CPP_REAL8) :: Tolerance + + REAL (CPP_REAL8), ALLOCATABLE :: Aglobal2d(:), Bglobal2d(:) + REAL (CPP_REAL8), ALLOCATABLE :: Aglobal3d(:), Bglobal3d(:) + REAL (CPP_REAL8), ALLOCATABLE :: Rsemiglobal3d(:) + REAL (CPP_REAL8), ALLOCATABLE :: Rlocal2d(:), Rlocal3d(:) + REAL (CPP_REAL8), ALLOCATABLE :: Rtmp(:), Rlocal(:), Rglobal(:) + REAL (CPP_REAL8) :: Scalar, Q, Array1D(Im), Array2D(Im,Jm), Array3D(Im,Jm,Km) + INTEGER :: Inc, pe, IScalar, IArray1D(Im) + INTEGER , ALLOCATABLE :: itmp(:),Dist(:),Xdist(:),Ydist(:),Zdist(:) + + +! +! Test 0 : Try to initialize the PEs +! + CALL ParInit( ) + Passed = .TRUE. + Tolerance = Gsize*1.0E-15_r8 + +! +! Create a virtual 2-D PE mesh. Remember that this is not +! inherently supported by PILGRIM which considers the PEs +! as an agglommeration of Gsize processes +! + npr_1 = 1 + npr_2 = 1 +! +! The following loop is guaranteed to terminate when npr_1 = Gsize +! and sooner if it finds a factorizaton of Gsize. For best results, +! use Gsize = product of two primes +! + DO WHILE ( npr_1 * npr_2 .LT. Gsize ) + npr_1 = npr_1 + 1 + npr_2 = Gsize / npr_1 + ENDDO + + myid_2 = gid / npr_1 + myid_1 = gid - myid_2 * npr_1 + +#if !defined(USE_MLP) +! +! Test 1 : Test ParSplit, DecompRegular2D, DecompRegular3D, ParScatter, +! and ParGather, as they will be used in the LLNL +! 2D decomposition FVCCM. This test is supported in +! MPI PILGRIM but not in MLP (Jim Taft) since it requires +! communicators and a group-wise barrier to be supported +! via shared memory. This will come in due time. +! + + +! +! Split the communicators as LLNL needs +! + call parsplit(commglobal, myid_2, gid, Comm_1, rank_1, size_1 ) + call parsplit(commglobal, myid_1, gid, Comm_2, rank_2, size_2 ) + + IF ( myid_1 /= rank_1 .OR. myid_2 /= rank_2 .OR. & + & npr_1 /= size_1 .OR. npr_2 /= size_2 ) THEN + print *, "ERROR in ParSplit: ranks or sizes are incorrect" + ENDIF + + ALLOCATE( Dist( 1 ) ) + +! +! Create a latitude/level distribution which is intentionally unbalanced +! -- this is a tougher test of the software than a trivial case +! + ALLOCATE( XDist( 1 ) ) + ALLOCATE( YDist( npr_1 ) ) + ALLOCATE( ZDist( npr_2 ) ) + + Xdist(1) = Im + BlockLen = Jm + DO I = 1, npr_1-1 + YDist( I ) = BlockLen / 2 + BlockLen = BlockLen - YDist( I ) + ENDDO + YDist( npr_1 ) = BlockLen + + BlockLen = Km + DO J = 1, npr_2-1 + ZDist( J ) = BlockLen / 2 + BlockLen = BlockLen - ZDist( J ) + ENDDO + ZDist( npr_2 ) = BlockLen + +! +! Latitude/vertical decompositions 3D array +! + ALLOCATE( Rlocal3D( im * ydist(myid_1+1) * zdist(myid_2+1) ) ) + call decompcreate( 1, npr_1, npr_2, xdist, ydist, zdist, YZ3D ) + +! +! Latitude strip decompositions 3D array +! + dist(1) = km + call decompcreate( 1, npr_1, 1, xdist, ydist, dist, Y3D ) + +! +! Now define a 3D decomposition local to the vertical column as +! defined by LLNL. This is slightly tricky, +! since the decomposition is consistent only over +! all processors with the same myid_1 +! + + ALLOCATE( Rsemiglobal3D( Im*ydist(myid_1+1)*Km ) ) + Dist(1) = ydist(myid_1+1) ! DecompRegular3D requires arrays + call decompcreate( 1,1,npr_2,xdist,dist,zdist, Z3D ) + + DEALLOCATE( zdist ) + DEALLOCATE( ydist ) + DEALLOCATE( xdist ) + DEALLOCATE( dist ) + +! +! Initialize the global arrays +! + ALLOCATE( Bglobal3D( im*jm*km ) ) + ALLOCATE( Aglobal3D( im*jm*km ) ) + CALL RANDOM_NUMBER( HARVEST = Aglobal3D ) ! Only PE 0 is of interest + + CALL ParScatter( CommGlobal, 0, Aglobal3D, YZ3D, Rlocal3D ) + CALL ParGather( Comm_2, 0, Rlocal3D, Z3D, Rsemiglobal3D ) +! +! LLNL will want to do the following on only the myid_z == 0 PES +! This will cause trouble in the current version of MLP (Jim Taft) +! PILGRIM since all PEs meet at a barrier in all communication primitives +! (since a group-wise barrier will take some time to implement) +! + IF ( myid_2 == 0 ) THEN + CALL ParGather( Comm_1, 0, Rsemiglobal3D, Y3D, Bglobal3D ) + ENDIF + + IF ( GID == 0 ) THEN + IF ( SUM(Aglobal3D-Bglobal3D) /= 0.0_r8 ) THEN + PRINT *, "ParUtilitiesTest failed: Scatter/Gather ver. != Orig." + Passed = .FALSE. + END IF + ENDIF + + DEALLOCATE( Bglobal3D ) + DEALLOCATE( Aglobal3D ) + DEALLOCATE( Rsemiglobal3D ) + DEALLOCATE( Rlocal3D ) + + CALL DecompFree( Z3D ) + CALL DecompFree( Y3D ) + CALL DecompFree( YZ3D ) + + CALL ParFree( Comm_1 ) + CALL ParFree( Comm_2 ) +#endif + +! +! Test 2: A simple XY column distribution for 2D and 3D arrays +! + ALLOCATE( XDist( npr_1 ) ) + ALLOCATE( YDist( npr_2 ) ) + ALLOCATE( ZDist( 1 ) ) + +! +! Consider a fairly irregular decomposition +! + BlockLen = Im + DO I = 1, npr_1-1 + XDist( I ) = BlockLen / 2 + BlockLen = BlockLen - XDist( I ) + ENDDO + XDist( npr_1 ) = BlockLen + + BlockLen = Jm + DO J = 1, npr_2-1 + YDist( J ) = BlockLen / 2 + BlockLen = BlockLen - YDist( J ) + ENDDO + YDist( npr_2 ) = BlockLen + + Zdist(1) = Km + +! +! Classical column distribution which could be used in the physics +! + ALLOCATE( Rlocal2D( xdist(myid_1+1)*ydist(myid_2+1) ) ) + call decompcreate( npr_1, npr_2, xdist, ydist, XY2D ) + ALLOCATE( Rlocal3D( xdist(myid_1+1)*ydist(myid_2+1)*km ) ) + call decompcreate( npr_1, npr_2, 1, xdist,ydist,zdist, XY3D ) + + + DEALLOCATE( ZDist ) + DEALLOCATE( YDist ) + DEALLOCATE( XDist ) + + ALLOCATE( Aglobal2D( im*jm ) ) + ALLOCATE( Aglobal3D( im*jm*km ) ) + ALLOCATE( Bglobal2D( im*jm ) ) + ALLOCATE( Bglobal3D( im*jm*km ) ) + + CALL RANDOM_NUMBER( HARVEST = Aglobal2D ) + CALL RANDOM_NUMBER( HARVEST = Aglobal3D ) + +! +! Now scatter the arrays over all PEs +! + CALL ParScatter( CommGlobal, 0, Aglobal2D, XY2D, Rlocal2D ) + CALL ParGather( CommGlobal, 0, Rlocal2D, XY2D, Bglobal2D ) + CALL ParScatter( CommGlobal, 0, Aglobal3D, XY3D, Rlocal3D ) + CALL ParGather( CommGlobal, 0, Rlocal3D, XY3D, Bglobal3D ) + IF ( GID == 0 ) THEN + IF ( SUM( Aglobal2d - Bglobal2d ) /= 0.0_r8 .OR. & + & SUM( Aglobal3d - Bglobal3d ) /= 0.0_r8 ) THEN + PRINT *, "ParUtilitiesTest failed: Gather/scatter != Orig." + Passed = .FALSE. + END IF + END IF + + DEALLOCATE( Rlocal3D ) + DEALLOCATE( Rlocal2D ) + DEALLOCATE( Bglobal3D ) + DEALLOCATE( Aglobal3D ) + DEALLOCATE( Bglobal2D ) + DEALLOCATE( Aglobal2D ) + + CALL DecompFree( XY3D ) + CALL DecompFree( XY2D ) + +! +! Test 3 : Test ParExchangeVector by exchanging a vector twice +! + ALLOCATE( Xdist( Gsize ) ) + ALLOCATE( Ydist( Gsize ) ) + +! +! Initialize seed to a different value on every PE, thus ensuring +! different values in the subsequent vectors +! + CALL RANDOM_SEED( SIZE = BlockLen ) + ALLOCATE( Itmp( BlockLen ) ) + DO I=1, BlockLen + Itmp(BlockLen) = Gid*(BlockLen-I+1)*Gid + ENDDO + CALL RANDOM_SEED( PUT = Itmp ) + DEALLOCATE( Itmp ) + + +! +! Loop several times for better testing +! + DO J = 1, 10 + ALLOCATE( Rtmp(Gsize) ) + CALL RANDOM_NUMBER( HARVEST = Rtmp ) +! +! Determine a random destination pattern +! + Xdist = INT( 10.0_r8 * Rtmp ) + DEALLOCATE( Rtmp ) + + ALLOCATE( Rglobal( SUM(Xdist) ) ) + ALLOCATE( Rlocal( SUM(Xdist) ) ) + ALLOCATE( Rtmp( Gsize*SUM(Xdist) ) ) ! A maximum buffer size + + CALL RANDOM_NUMBER( HARVEST = Rglobal ) + CALL ParExchangeVector( CommGlobal,Xdist,Rglobal,Ydist,Rtmp ) + CALL ParExchangeVector( CommGlobal,Ydist,Rtmp,Xdist,Rlocal ) + IF ( SUM( Rglobal - Rlocal ) /= 0.0_r8 ) THEN + PRINT *, "ParUtilitiesTest failed: ParExchangeVector" + PRINT *, "Loop index ", J + Passed = .FALSE. + stop + ENDIF + + DEALLOCATE( Rtmp ) + DEALLOCATE( Rlocal ) + DEALLOCATE( Rglobal ) + + ENDDO + + DEALLOCATE( Ydist ) + DEALLOCATE( Xdist ) + +! +! Test 4: Parallel sums, ParBeginTransfer/ParEndTransfer +! + ALLOCATE( Xdist( Gsize ) ) + ALLOCATE( Ydist( Gsize ) ) + +! Scalar sum test + ALLOCATE( Rlocal(1) ) ! ParExchangeVector expects arrays + ALLOCATE( Rglobal( Gsize ) ) + CALL RANDOM_NUMBER( HARVEST = Q ) + Rlocal(1) = Q + Xdist = 0 + Xdist(1) = 1 + CALL ParExchangeVector( CommGlobal,Xdist,Rlocal,Ydist,Rglobal ) + CALL ParCollective( CommGlobal, SUMOP, Q ) + IF ( GID == 0 ) THEN + Scalar = 0.0_r8 + DO pe=0,Gsize-1 + Scalar = Scalar + Rglobal( pe+1 ) + ENDDO + IF ( ABS( Scalar - Q ) > Tolerance ) THEN + print *, "Error in Scalar sum: ", Scalar-Q + ENDIF + ENDIF + DEALLOCATE( Rlocal ) + DEALLOCATE( Rglobal ) + +! 1D Array sum test + CALL RANDOM_NUMBER( HARVEST = Array1D ) + ALLOCATE( Rglobal( Im*Gsize ) ) + Xdist = 0 + Xdist(1) = Im + CALL ParExchangeVector( CommGlobal,Xdist,Array1D,Ydist,Rglobal ) + CALL ParCollective( CommGlobal, SUMOP, Im, Array1D ) + IF ( GID == 0 ) THEN + DO i=1, Im + Scalar = 0.0_r8 + DO pe=0,Gsize-1 + Scalar = Scalar + Rglobal( Im*pe+I ) + ENDDO + IF ( ABS( Scalar - Array1D(I) ) > Tolerance ) THEN + print *, "Error in 1D Sum: ", Scalar-Array1D(I), " pos ",I + ENDIF + ENDDO + ENDIF + DEALLOCATE( Rglobal ) + +! 2D Array sum test + CALL RANDOM_NUMBER( HARVEST = Array2D ) + + ALLOCATE( Rglobal( Im*Jm*Gsize ) ) + ALLOCATE( Rlocal( Im*Jm ) ) + Xdist = 0 + Xdist(1) = Im*Jm + + inc = 0 + DO J=1,Jm + DO I=1,Im + inc = inc+1 + Rlocal(inc) = Array2D(i,j) + ENDDO + ENDDO + CALL ParExchangeVector( CommGlobal,Xdist,Rlocal,Ydist,Rglobal ) + CALL ParCollective( CommGlobal, SUMOP, Im, Jm, Array2D ) + IF ( GID == 0 ) THEN + inc = 0 + DO j=1, Jm + DO i=1, Im + inc = inc + 1 + Scalar = 0.0_r8 + DO pe=0,Gsize-1 + Scalar = Scalar + Rglobal( Jm*Im*pe+Inc ) + ENDDO + IF ( ABS( Scalar - Array2D(I,J) ) > Tolerance ) THEN + print *, "Error 2D Sum: ",Scalar-Array2D(I,J), "pos ",I,J + ENDIF + ENDDO + ENDDO + ENDIF + DEALLOCATE( Rglobal ) + DEALLOCATE( Rlocal ) + +! 3D Array sum test + CALL RANDOM_NUMBER( HARVEST = Array3D ) + + ALLOCATE( Rglobal( Im*Jm*Km*Gsize ) ) + ALLOCATE( Rlocal( Im*Jm*Km ) ) + Xdist = 0 + Xdist(1) = Im*Jm*Km + + inc = 0 + DO K=1,Km + DO J=1,Jm + DO I=1,Im + inc = inc+1 + Rlocal(inc) = Array3D(i,j,k) + ENDDO + ENDDO + ENDDO + CALL ParExchangeVector( CommGlobal,Xdist,Rlocal,Ydist,Rglobal ) + CALL ParCollective( CommGlobal, SUMOP, Im, Jm, Km, Array3D ) + IF ( GID == 0 ) THEN + inc = 0 + DO k=1, Km + DO j=1, Jm + DO i=1, Im + inc = inc + 1 + Scalar = 0.0_r8 + DO pe=0,Gsize-1 + Scalar = Scalar + Rglobal( Km*Jm*Im*pe+inc ) + ENDDO + IF ( ABS( Scalar - Array3D(I,J,K) ) > Tolerance ) THEN + print *, "Error 3D Sum: ",Scalar-Array3D(I,J,K), I, J, K + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + + + DEALLOCATE( Rglobal ) + DEALLOCATE( Rlocal ) + + DEALLOCATE( Ydist ) + DEALLOCATE( Xdist ) + +! +! That's all folks +! + + IF ( Gid == 0 ) THEN + IF ( Passed ) THEN + PRINT *, "Passed ParUtilitiesTest" + ELSE + PRINT *, "Failed ParUtilitiesTest" + ENDIF + END IF + + + CALL ParExit( ) + +!EOC +!------------------------------------------------------------------------- + END PROGRAM parutilitiestest diff --git a/src/utils/pilgrim/unit_testers/redistributetest.F90 b/src/utils/pilgrim/unit_testers/redistributetest.F90 new file mode 100644 index 0000000000..80534c67b9 --- /dev/null +++ b/src/utils/pilgrim/unit_testers/redistributetest.F90 @@ -0,0 +1,451 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------- +!BOP +! !ROUTINE: RedistributeTest --- Unit tester for the redistribute facility +! +! !INTERFACE: + PROGRAM redistributetest + +! !USES: + USE DecompModule, ONLY: DecompType, DecompFree, DecompPermute, & + & DecompCreate + USE ParUtilitiesModule, ONLY: Gsize, GID, CommGlobal, & + & ParInit, ParExit, ParScatter, ParGather + USE RedistributeModule +#if defined(TIMING) + USE perf_mod +#endif + +#include "debug.h" +#include "pilgrim.h" + + IMPLICIT NONE +#if defined(TIMING) +#include "gptl.inc" +#endif + +! !DESCRIPTION: +! +! This main program tests the functionality of the Redistribute +! module. It performs the following tests: +! +! Test 1: DecompRegular1D, RedistributeCreate/Perform/Free +! +! Test 2: DecompRegular2D, RedistributeCreate/Perform/Free +! +! Test 3: DecompRegular3D, RedistributeCreate/Perform/Free +! +! Validation check: +! +! mpirun -np 7 RedistributeTest +! +! Should yield a single message (if -DDEBUG_ON is *not* defined): +! +! Passed all tests +! +! !REVISION HISTORY: +! 99.01.18 Sawyer Creation from ParUtilitiesTest +! 99.11.17 Sawyer Added test of RedistributeStart/Finish +! 00.07.20 Sawyer Changed for new PILGRIM API +! 01.05.01 Sawyer Free format, new decompmodule interface +! 02.08.14 Sawyer Added explicit precisions from pilgrim.h +! +!EOP +!------------------------------------------------------------------------- +!BOC +! !LOCAL VARIABLES: + INTEGER :: GlobalPEs, GlobalRank, I, J, Ierror + TYPE (DecompType) :: DecompA, DecompB, ObsDecomp + TYPE (RedistributeType) :: InterAB, InterBA + INTEGER :: BlockLen, Remainder, Ipe + REAL (CPP_REAL8) :: time1, time2, time3 + LOGICAL Passed + + +! For the Observation decomposition + INTEGER Nactual, Xdim, Ydim, Zdim + PARAMETER ( Nactual = 331 ) + PARAMETER ( Xdim = 288 ) + PARAMETER ( Ydim = 181 ) + PARAMETER ( Zdim = 30 ) + + REAL (CPP_REAL8), ALLOCATABLE :: Rglobal(:), Rtmp(:), RlocalA(:), RlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R2dlocalA(:), R2dlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R2dGlobal(:), R2dtmp(:) +! +! 3D Arrays are smashed down to 1D +! + REAL (CPP_REAL8), ALLOCATABLE :: R3dlocalA(:), R3dlocalB(:) + REAL (CPP_REAL8), ALLOCATABLE :: R3dGlobal(:), R3dTmp(:) + + INTEGER , ALLOCATABLE :: itmp(:), DistA(:), DistB(:) + INTEGER , ALLOCATABLE :: Xdist(:), Ydist(:), Zdist(:), Perm(:) + + CALL ParInit( ) + Passed = .TRUE. + +! +! Initialize timing library. 2nd arg 0 means disable, 1 means enable +! +#if defined(TIMING) + call t_setoptionf (gptlcpu, 1) + call t_initializef () +#endif + +! +! Test 1 : Test DecompRegular1D, DecompPermute, ParScatter1D, ParGather1D +! and Redistribution using a block-wise distribution. +! + +#if defined(TIMING) + call t_startf('1D Redist Total') +#endif + +! +! Set the global vector to random values +! + ALLOCATE( Rtmp(Nactual) ) + rtmp = 1.0_r8 +! +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! +! + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + ALLOCATE( Perm( Gsize ) ) + BlockLen = Nactual + DO I = 1, Gsize-1 + DistA( I ) = BlockLen / 2 + BlockLen = BlockLen - DistA(I) + ENDDO + DistA( Gsize ) = BlockLen + IF ( SUM( DistA ) .ne. Nactual ) THEN + print *, " Error: DistA contains ", SUM(DistA), " != ",Nactual + ENDIF + DO I = 1, Gsize + DistB( I ) = DistA( Gsize-I+1 ) + ENDDO + + CALL DecompCreate ( Gsize, DistA, DecompA ) + CALL DecompCreate ( Gsize, DistB, DecompB ) + DO I=1, Gsize-1 + Perm( I+1 ) = I + ENDDO + Perm( 1 ) = Gsize + CALL DecompPermute( Perm, DecompB ) + + ALLOCATE( RlocalA( DecompA%NumEntries(GID+1) ) ) + ALLOCATE( RlocalB( DecompB%NumEntries(GID+1) ) ) + ALLOCATE( Rglobal( Nactual ) ) + + IF ( GID .EQ. 0 ) THEN + CALL RANDOM_NUMBER( HARVEST = Rglobal ) + ENDIF + +! +! Now scatter the arrays over all PEs +! + CALL ParScatter( CommGlobal, 0, Rglobal, DecompA, RlocalA ) +! +! Now redistribute the local arrays from one decomposition to another +! +#if defined(TIMING) + call t_startf('1D Redist Create') +#endif + CALL RedistributeCreate( DecompA, DecompB, InterAB ) +#if defined(TIMING) + call t_stopf('1D Redist Create') +#endif +#if defined(TIMING) + call t_startf('1D Redist Forward') +#endif + CALL RedistributePerform( InterAB, .TRUE., RlocalA, RlocalB ) +#if defined(TIMING) + call t_stopf('1D Redist Forward') +#endif + RlocalA = 0.0_r8 +#if defined(TIMING) + call t_startf('1D Redist Back') +#endif + CALL RedistributePerform( InterAB, .FALSE., RlocalB, RlocalA ) +#if defined(TIMING) + call t_stopf('1D Redist Back') +#endif + CALL RedistributeFree( InterAB ) + CALL ParGather( CommGlobal, 0, RlocalA, DecompA, Rtmp ) + + IF ( GID .eq. 0 ) THEN + Rtmp = Rtmp - Rglobal + IF ( SUM(Rtmp) .ne. 0.0_r8 ) THEN + PRINT *, "Redistribute failed: 1D Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( RlocalB ) + DEALLOCATE( RlocalA ) + DEALLOCATE( Rtmp ) + DEALLOCATE( Rglobal ) + +#if defined(TIMING) + call t_stopf('1D Redist Total') +#endif + +! +! Test 2 : Test DecompRegular2D, ParScatter2D and ParGather2D +! and Redistribute using a 2-D block-wise distribution. +! +#if defined(TIMING) + call t_startf('2D Redist Total') +#endif + +! +! Set the target vector to non-random values +! +! +! Make sure that the array is not square +! + ALLOCATE( R2dtmp( XDim*YDim ) ) + +! Set the global vector to random values +! Make sure that the array is not square +! + ALLOCATE( R2dGlobal( XDim*YDim ) ) + IF ( GID .EQ. 0 ) THEN + CALL RANDOM_NUMBER( HARVEST = R2dglobal ) + ENDIF + r2dtmp = 1.0_r8 + +! Decomposition for Observations: Block distribution with remainder +! on last PE. Should be OK if #obs >> #PEs +! +! + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + ALLOCATE( XDist( 1 ) ) + ALLOCATE( YDist( 1 ) ) + + BlockLen = Xdim + DO I = 1, Gsize-1 + DistA( I ) = BlockLen / 2 + BlockLen = BlockLen - DistA( I ) + ENDDO + DistA( Gsize ) = BlockLen + YDist( 1 ) = Ydim + + XDist( 1 ) = Xdim + BlockLen = Ydim + DO J = 1, Gsize-1 + DistB( J ) = BlockLen / 2 + BlockLen = BlockLen - DistB( J ) + ENDDO + DistB( Gsize ) = BlockLen + +! +! Row-major ordering +! + ALLOCATE( R2dlocalA( DistA(GID+1)*YDist(1) ) ) + ALLOCATE( R2dlocalB( XDist(1)*DistB(GID+1) ) ) + + CALL DecompCreate( Gsize, 1, DistA, YDist, DecompA ) + CALL DecompCreate( 1, Gsize, Xdist, DistB, DecompB ) + +! +! Now scatter the arrays over all PEs +! + CALL ParScatter( CommGlobal, 0, R2dglobal, DecompA, R2dlocalA ) + +#if defined(TIMING) + call t_startf('2D Redist Create') +#endif + CALL RedistributeCreate( DecompA, DecompB, InterAB ) +#if defined(TIMING) + call t_stopf('2D Redist Create') +#endif +#if defined(TIMING) + call t_startf('2D Redist Forward') +#endif + CALL RedistributePerform( InterAB,.TRUE.,R2dlocalA,R2dlocalB ) +#if defined(TIMING) + call t_stopf('2D Redist Forward') +#endif + R2dlocalA = 0.0_r8 +#if defined(TIMING) + call t_startf('2D Redist Back') +#endif + CALL RedistributePerform( InterAB,.FALSE.,R2dlocalB,R2dlocalA ) +#if defined(TIMING) + call t_stopf('2D Redist Back') +#endif + CALL RedistributeFree( InterAB ) + + CALL ParGather( CommGlobal, 0, R2dlocalA, DecompA, R2dtmp ) + IF ( GID .eq. 0 ) THEN + R2dtmp = R2dtmp - R2dglobal + IF ( SUM(R2dtmp) .ne. 0.0_r8 ) THEN + PRINT *,"RedistributeTest Failed: 2D Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( R2dlocalB ) + DEALLOCATE( R2dlocalA ) + + DEALLOCATE( YDist ) + DEALLOCATE( XDist ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( R2dtmp ) + DEALLOCATE( R2dglobal ) + +#if defined(TIMING) + call t_stopf('2D Redist Total') +#endif + +! +! Test 3 : Test 3-D redistribution +! +#if defined(TIMING) + call t_startf('3D Redist Total') +#endif + +! +! Set the target vector to non-random values +! +! +! Make sure that the array is not square +! + ALLOCATE( R3dTmp( Xdim*Ydim*ZDim ) ) + +! Set the global vector to random values +! Make sure that the array is not square +! + ALLOCATE( R3dGlobal( XDim*YDim*ZDim ) ) + IF ( GID .eq. 0 ) THEN + CALL RANDOM_NUMBER( HARVEST = R3dglobal ) + ENDIF + r3dtmp = 1.0_r8 + + +! +! Now define the distribution +! + ALLOCATE( DistA( Gsize ) ) + ALLOCATE( DistB( Gsize ) ) + + ALLOCATE( XDist( 1 ) ) + ALLOCATE( YDist( 1 ) ) + ALLOCATE( ZDist( 1 ) ) + + XDist( 1 ) = Xdim + YDist( 1 ) = Ydim + ZDist( 1 ) = Zdim + +! +! Optimal distribution in Z +! + BlockLen = Zdim / Gsize + Remainder = MOD( Zdim, Gsize ) + + IF ( Remainder .gt. 0 ) DistA( 1:Remainder ) = BlockLen+1 + DistA( Remainder+1 : Gsize ) = BlockLen + CALL DecompCreate( 1,1,Gsize,XDist,YDist,DistA,DecompA ) + +! +! Optimal distribution in Y +! + BlockLen = Ydim / Gsize + Remainder = MOD( Ydim, Gsize ) + IF ( Remainder .gt. 0 ) DistB( 1:Remainder ) = BlockLen+1 + DistB( Remainder+1 : Gsize ) = BlockLen + CALL DecompCreate( 1,Gsize,1,XDist,DistB,ZDist,DecompB ) + + ALLOCATE( R3dlocalA( XDist(1)*YDist(1)*DistA(GID+1) ) ) + ALLOCATE( R3dlocalB( XDist(1)*DistB(GID+1)*ZDist(1) ) ) + +! +! Do all the stuff here +! + CALL ParScatter( CommGlobal, 0, R3dglobal, DecompA, R3dlocalA ) + +#if defined( TIMING ) + call t_startf('3D Redist Create') +#endif + CALL RedistributeCreate( DecompA, DecompB, InterAB ) +#if defined( TIMING ) + call t_stopf('3D Redist Create') + call t_startf('3D Redist Forward') +#endif + CALL RedistributeStart( InterAB,.TRUE.,R3dlocalA ) + CALL RedistributeFinish( InterAB,.TRUE.,R3dlocalB ) + R3dlocalA = 0.0_r8 +#if defined( TIMING ) + call t_stopf('3D Redist Forward') + call t_startf('3D Redist Back') +#endif + CALL RedistributeStart( InterAB,.FALSE.,R3dlocalB ) + CALL RedistributeFinish( InterAB,.FALSE.,R3dlocalA ) +#if defined( TIMING ) + call t_stopf('3D Redist Back') +#endif + CALL RedistributeFree( InterAB ) + + CALL ParGather( CommGlobal, 0, R3dlocalA, DecompA, R3dtmp ) + + IF ( GID .eq. 0 ) THEN + R3dtmp = R3dtmp - R3dglobal + IF ( SUM(R3dtmp) .ne. 0.0_r8 ) THEN + PRINT *, "RedistributeTest failed: 3d Gathered ver. != Orig." + Passed = .FALSE. + ENDIF + ENDIF + + CALL DecompFree( DecompB ) + CALL DecompFree( DecompA ) + + DEALLOCATE( R3dlocalB ) + DEALLOCATE( R3dlocalA ) + + DEALLOCATE( ZDist ) + DEALLOCATE( YDist ) + DEALLOCATE( XDist ) + + DEALLOCATE( DistB ) + DEALLOCATE( DistA ) + + DEALLOCATE( R3dtmp ) + DEALLOCATE( R3dglobal ) + +#if defined(TIMING) + call t_stopf('3D Redist Total') +#endif + +! +! That's all folks +! +#if defined(TIMING) + call t_prf(GID) +#endif + IF ( Passed ) THEN + PRINT *, "Passed RedistributeTest" + ELSE + PRINT *, "Failed RedistributeTest" + ENDIF + + CALL ParExit( ) + +!EOC +!------------------------------------------------------------------------- + END PROGRAM RedistributeTest diff --git a/src/utils/pilgrim/unit_testers/unstructured.F90 b/src/utils/pilgrim/unit_testers/unstructured.F90 new file mode 100644 index 0000000000..2a3b3b14fc --- /dev/null +++ b/src/utils/pilgrim/unit_testers/unstructured.F90 @@ -0,0 +1,220 @@ +!------------------------------------------------------------------------ +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS +!------------------------------------------------------------------------ + MODULE unstructured +!BOP +! +! !MODULE: unstructured +! +! !USES: +#include "pilgrim.h" + IMPLICIT NONE + +! +! !DESCRIPTION: + + + +! !REVISION HISTORY: +! 01.10.30 Sawyer Creation +! 02.08.14 Sawyer Added explicit precisions from pilgrim.h +! +! !PUBLIC TYPES: + PUBLIC Pump, GetPoint, AddTriangle + +!EOP + CONTAINS + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: Pump --- Increase numbers of points and triangles +! +! !INTERFACE: + subroutine Pump( X, Y, Z, Tri ) +! !USES: + implicit none + +! !INPUT/OUTPUT PARAMETERS: + real(CPP_REAL8), pointer :: X(:) ! X + real(CPP_REAL8), pointer :: Y(:) ! Y + real(CPP_REAL8), pointer :: Z(:) ! Z + integer, pointer :: Tri(:,:) ! Corner vertices + +! !DESCRIPTION: +! +! This routine puts a 2-D ghost region at the end of a buffer, first in +! X then in Y. +! +! !LOCAL VARIABLES: + integer :: NVert, NTri, NVertNew, NTriNew + real(CPP_REAL8), pointer :: Xnew(:), Ynew(:), Znew(:) + integer, pointer :: TriNew(:,:) + integer, allocatable :: DB(:,:) + +! +! !REVISION HISTORY: +! 01.10.30 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC + +! !LOCAL VARIABLES: + integer avert, bvert, cvert, abvert, bcvert, acvert + integer i, j, k, count + + + NVert = SIZE(X) + NTri = SIZE(Tri, 2) + + NVertNew = 3*NTri/2 + NVert + NTriNew = 4*NTri + + ALLOCATE( DB(NVert,12) ) ! The vertex database + DB(:,:) = 0 + + ALLOCATE( Xnew(NVertNew) ) + ALLOCATE( Ynew(NVertNew) ) + ALLOCATE( Znew(NVertNew) ) + ALLOCATE( TriNew(3,NTriNew) ) + +! +! Copy over old coordinates (adopt the vertex numbering) +! + Xnew(1:NVert) = X(1:NVert) + Ynew(1:NVert) = Y(1:NVert) + Znew(1:NVert) = Z(1:NVert) + + Count = 0 +! +! For each triangle + DO i=1,NTri + avert=min(min(Tri(1,i),Tri(2,i)),Tri(3,i)) + cvert=max(max(Tri(1,i),Tri(2,i)),Tri(3,i)) + DO k=1,3 + IF (Tri(k,i) /= avert .AND. Tri(k,i) /= cvert) bvert=Tri(k,i) + ENDDO + CALL GetPoint(avert,bvert,X,Y,Z,DB,NVert,Xnew,Ynew,Znew,abvert) + CALL GetPoint(bvert,cvert,X,Y,Z,DB,NVert,Xnew,Ynew,Znew,bcvert) + CALL GetPoint(avert,cvert,X,Y,Z,DB,NVert,Xnew,Ynew,Znew,acvert) + + +! Add new triangles + + CALL AddTriangle(avert,abvert,acvert,Count,TriNew) + CALL AddTriangle(bvert,abvert,bcvert,Count,TriNew) + CALL AddTriangle(cvert,bcvert,acvert,Count,TriNew) + CALL AddTriangle(abvert,bcvert,acvert,Count,TriNew) + ENDDO + + IF (NVert /= NVertNew) print *, "Error in Pump", NVert,"!=",NVertNew + IF (Count /= NTriNew) print *, "Error in Pump", Count,"!=",NTriNew + +! +! Swap the old and new data sets +! + DEALLOCATE(X) + DEALLOCATE(Y) + DEALLOCATE(Z) + DEALLOCATE(Tri) + X => Xnew + Y => Ynew + Z => Znew + Tri => TriNew + + DEALLOCATE(DB) +!EOC + END SUBROUTINE Pump +!------------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: GetPoint --- Get the index of the new point +! +! !INTERFACE: + SUBROUTINE GetPoint(avert,bvert,X,Y,Z,DB,NVert,Xnew,Ynew,Znew,abvert) + +! !USES: + implicit none + +! !INPUT PARAMETERS: + integer, intent(in) :: avert + integer, intent(in) :: bvert + real(CPP_REAL8), pointer :: X(:) + real(CPP_REAL8), pointer :: Y(:) + real(CPP_REAL8), pointer :: Z(:) + +! !INPUT/OUTPUT PARAMETERS: + integer :: DB(:,:) + real(CPP_REAL8), pointer :: Xnew(:) + real(CPP_REAL8), pointer :: Ynew(:) + real(CPP_REAL8), pointer :: Znew(:) + integer, intent(inout) :: NVert + +! !OUTPUT PARAMETERS: + integer, intent(out) :: abvert + +! !DESCRIPTION: +! +! Determine the midpoint if it has not already been done +! +! !REVISION HISTORY: +! 01.10.30 Sawyer Creation +! +!EOP +!----------------------------------------------------------------------- +!BOC + + INTEGER k + LOGICAL Found + REAL (CPP_REAL8) :: xab, yab, zab, norm + + k = 0 + Found = .FALSE. + DO WHILE ( .NOT. Found .AND. k < 6 ) + k = k+1 + IF ( DB(avert,k) == bvert ) THEN + abvert = DB(avert,k+6) + Found = .TRUE. + ELSEIF ( DB(avert,k) == 0 ) THEN + NVert = NVert+1 + abvert = NVert + DB(avert,k) = bvert + DB(avert,k+6) = NVert + xab = x(avert)+x(bvert) + yab = y(avert)+y(bvert) + zab = z(avert)+z(bvert) + norm = sqrt(xab*xab + yab*yab + zab*zab) + xnew(abvert) = xab / norm + ynew(abvert) = yab / norm + Znew(abvert) = zab / norm + Found = .TRUE. + ENDIF + ENDDO + +!EOC + END SUBROUTINE GetPoint +!------------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: AddTriangle --- Add a triangle to the list + SUBROUTINE AddTriangle(vert1,vert2,vert3,NTri,TriNew) + +! !USES: + implicit none + integer, intent(in) :: vert1, vert2, vert3 + integer, intent(inout) :: NTri + integer, pointer :: TriNew(:,:) + + NTri = NTri+1 + TriNew(1,NTri) = vert1 + TriNew(2,NTri) = vert2 + TriNew(3,NTri) = vert3 + +!EOC + END SUBROUTINE AddTriangle +!------------------------------------------------------------------------- + + END MODULE unstructured + diff --git a/src/utils/quicksort.F90 b/src/utils/quicksort.F90 new file mode 100644 index 0000000000..7636fbbd7b --- /dev/null +++ b/src/utils/quicksort.F90 @@ -0,0 +1,110 @@ +module quicksort + +! sort routine to arrange array elements from smallest to largest +! +! grabbed from A millers web site http://users.bigpond.net.au/amiller/ +! Quick sort routine from: +! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to +! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150. +! Modified by Alan Miller to include an associated integer array which gives +! the positions of the elements in the original order. +! pjr added module declaration +! mvr modified integer array to intent inout - may now be any integer +! array that gets sorted along with associated real array + +use shr_kind_mod, only: r8 => shr_kind_r8 + +implicit none +save +private +public quick_sort +contains + +RECURSIVE SUBROUTINE quick_sort(list, order) + +implicit none + +REAL(r8), DIMENSION (:), INTENT(INOUT) :: list +INTEGER, DIMENSION (:), INTENT(INOUT) :: order + +! Local variable +INTEGER :: i + +CALL quick_sort_1(1, SIZE(list)) + +CONTAINS + +RECURSIVE SUBROUTINE quick_sort_1(left_end, right_end) + +implicit none +INTEGER, INTENT(IN) :: left_end, right_end + +! Local variables +INTEGER :: i, j, itemp +REAL(r8) :: reference, temp +INTEGER, PARAMETER :: max_simple_sort_size = 6 + +IF (right_end < left_end + max_simple_sort_size) THEN + ! Use interchange sort for small lists + CALL interchange_sort(left_end, right_end) + +ELSE + ! Use partition ("quick") sort + reference = list((left_end + right_end)/2) + i = left_end - 1; j = right_end + 1 + + DO + ! Scan list from left end until element >= reference is found + DO + i = i + 1 + IF (list(i) >= reference) EXIT + END DO + ! Scan list from right end until element <= reference is found + DO + j = j - 1 + IF (list(j) <= reference) EXIT + END DO + + + IF (i < j) THEN + ! Swap two out-of-order elements + temp = list(i); list(i) = list(j); list(j) = temp + itemp = order(i); order(i) = order(j); order(j) = itemp + ELSE IF (i == j) THEN + i = i + 1 + EXIT + ELSE + EXIT + END IF + END DO + + IF (left_end < j) CALL quick_sort_1(left_end, j) + IF (i < right_end) CALL quick_sort_1(i, right_end) +END IF + +END SUBROUTINE quick_sort_1 + + +SUBROUTINE interchange_sort(left_end, right_end) + +implicit none +INTEGER, INTENT(IN) :: left_end, right_end + +! Local variables +INTEGER :: i, j, itemp +REAL(r8) :: temp + +DO i = left_end, right_end - 1 + DO j = i+1, right_end + IF (list(i) > list(j)) THEN + temp = list(i); list(i) = list(j); list(j) = temp + itemp = order(i); order(i) = order(j); order(j) = itemp + END IF + END DO +END DO + +END SUBROUTINE interchange_sort + +END SUBROUTINE quick_sort + +end module quicksort diff --git a/src/utils/sgexx.F90 b/src/utils/sgexx.F90 new file mode 100644 index 0000000000..51684c8b84 --- /dev/null +++ b/src/utils/sgexx.F90 @@ -0,0 +1,11089 @@ +module sgexx + +! A few LINPACK/LAPACK and supporting BLAS routines + +! The routines have all been converted to use the shr_kind_r8 type which +! is set to double precision. The LINPACK naming convention isn't +! followed by the 's' routines (which should contain 'd's). + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none + +public :: & + dgeco, & + dgedi, & + sgefa, & + sdot, & + isamax, & + sasum, & + saxpy, & + sscal, & + sswap, & + sgeev, & + sgebak, & + sgebal, & + sgehd2, & + sgehrd, & + shseqr, & + slabad, & + slacpy, & + sladiv, & + slahqr, & + slahrd, & + slaln2, & + slange, & + slanhs, & + slanv2, & + slapy2, & + slarf, & + slarfb, & + slarfg, & + slarft, & + slarfx, & + slartg, & + slascl, & + slaset, & + slassq, & + sorg2r, & + sorghr, & + sorgqr, & + strevc, & + ilaenv, & + lsame, & + slamch, & + slamc1, & + slamc2, & + slamc3, & + slamc4, & + slamc5, & + xerbla, & + scopy, & + sger, & + snrm2, & + srot, & + sgemm, & + sgemv, & + strmm, & + strmv + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + + SUBROUTINE DGECO (A,LDA,N,IPVT,RCOND,Z) +! + + INTEGER LDA,N,IPVT(N) + REAL(r8) A(LDA,*),Z(*) + REAL(r8) RCOND +! +! SGECO FACTORS A REAL MATRIX BY GAUSSIAN ELIMINATION +! AND ESTIMATES THE CONDITION OF THE MATRIX. +! +! IF RCOND IS NOT NEEDED, SGEFA IS SLIGHTLY FASTER. +! TO SOLVE A*X = B , FOLLOW SGECO BY SGESL. +! TO COMPUTE INVERSE(A)*C , FOLLOW SGECO BY SGESL. +! TO COMPUTE DETERMINANT(A) , FOLLOW SGECO BY SGEDI. +! TO COMPUTE INVERSE(A) , FOLLOW SGECO BY SGEDI. +! +! ON ENTRY +! +! A REAL(LDA, N) +! THE MATRIX TO BE FACTORED. +! +! LDA INTEGER +! THE LEADING DIMENSION OF THE ARRAY A . +! +! N INTEGER +! THE ORDER OF THE MATRIX A . +! +! ON RETURN +! +! A AN UPPER TRIANGULAR MATRIX AND THE MULTIPLIERS +! WHICH WERE USED TO OBTAIN IT. +! THE FACTORIZATION CAN BE WRITTEN A = L*U WHERE +! L IS A PRODUCT OF PERMUTATION AND UNIT LOWER +! TRIANGULAR MATRICES AND U IS UPPER TRIANGULAR. +! +! IPVT INTEGER(N) +! AN INTEGER VECTOR OF PIVOT INDICES. +! +! RCOND REAL +! AN ESTIMATE OF THE RECIPROCAL CONDITION OF A . +! FOR THE SYSTEM A*X = B , RELATIVE PERTURBATIONS +! IN A AND B OF SIZE EPSILON MAY CAUSE +! RELATIVE PERTURBATIONS IN X OF SIZE EPSILON/RCOND . +! IF RCOND IS SO SMALL THAT THE LOGICAL EXPRESSION +! 1.0 + RCOND .EQ. 1.0 +! IS TRUE, THEN A MAY BE SINGULAR TO WORKING +! PRECISION. IN PARTICULAR, RCOND IS ZERO IF +! EXACT SINGULARITY IS DETECTED OR THE ESTIMATE +! UNDERFLOWS. +! +! Z REAL(N) +! A WORK VECTOR WHOSE CONTENTS ARE USUALLY UNIMPORTANT. +! IF A IS CLOSE TO A SINGULAR MATRIX, THEN Z IS +! AN APPROXIMATE NULL VECTOR IN THE SENSE THAT +! NORM(A*Z) = RCOND*NORM(A)*NORM(Z) . +! +! LINPACK. THIS VERSION DATED 08/14/78 . +! CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. +! +! SUBROUTINES AND FUNCTIONS +! +! LINPACK SGEFA +! BLAS SAXPY,SDOT,SSCAL,SASUM +! FORTRAN ABS,MAX,SIGN +! +! INTERNAL VARIABLES +! + REAL(r8) EK,T,WK,WKM + REAL(r8) ANORM,S,SM,YNORM + INTEGER INFO,J,K,KB,KP1,L +! +! +! +! COMPUTE 1-NORM OF A +! + ANORM = 0.0E0_r8 + DO 10 J = 1, N + ANORM = MAX(ANORM,SASUM(N,A(1,J),1)) + 10 CONTINUE +! +! FACTOR +! + CALL SGEFA(A,LDA,N,IPVT,INFO) +! +! RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) . +! ESTIMATE = NORM(Z)/NORM(Y) WHERE A*Z = Y AND TRANS(A)*Y = E . +! TRANS(A) IS THE TRANSPOSE OF A . THE COMPONENTS OF E ARE +! CHOSEN TO CAUSE MAXIMUM LOCAL GROWTH IN THE ELEMENTS OF W WHERE +! TRANS(U)*W = E . THE VECTORS ARE FREQUENTLY RESCALED TO AVOID +! OVERFLOW. +! +! SOLVE TRANS(U)*W = E +! + EK = 1.0E0_r8 + DO 20 J = 1, N + Z(J) = 0.0E0_r8 + 20 CONTINUE + DO 100 K = 1, N + IF (Z(K) .NE. 0.0E0_r8) EK = SIGN(EK,-Z(K)) + IF (ABS(EK-Z(K)) .LE. ABS(A(K,K))) GO TO 30 + S = ABS(A(K,K))/ABS(EK-Z(K)) + CALL SSCAL(N,S,Z,1) + EK = S*EK + 30 CONTINUE + WK = EK - Z(K) + WKM = -EK - Z(K) + S = ABS(WK) + SM = ABS(WKM) + IF (A(K,K) .EQ. 0.0E0_r8) GO TO 40 + WK = WK/A(K,K) + WKM = WKM/A(K,K) + GO TO 50 + 40 CONTINUE + WK = 1.0E0_r8 + WKM = 1.0E0_r8 + 50 CONTINUE + KP1 = K + 1 + IF (KP1 .GT. N) GO TO 90 + DO 60 J = KP1, N + SM = SM + ABS(Z(J)+WKM*A(K,J)) + Z(J) = Z(J) + WK*A(K,J) + S = S + ABS(Z(J)) + 60 CONTINUE + IF (S .GE. SM) GO TO 80 + T = WKM - WK + WK = WKM + DO 70 J = KP1, N + Z(J) = Z(J) + T*A(K,J) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + Z(K) = WK + 100 CONTINUE + S = 1.0E0_r8/SASUM(N,Z,1) + CALL SSCAL(N,S,Z,1) +! +! SOLVE TRANS(L)*Y = W +! + DO 120 KB = 1, N + K = N + 1 - KB + IF (K .LT. N) Z(K) = Z(K) + SDOT(N-K,A(K+1,K),1,Z(K+1),1) + IF (ABS(Z(K)) .LE. 1.0E0_r8) GO TO 110 + S = 1.0E0_r8/ABS(Z(K)) + CALL SSCAL(N,S,Z,1) + 110 CONTINUE + L = IPVT(K) + T = Z(L) + Z(L) = Z(K) + Z(K) = T + 120 CONTINUE + S = 1.0E0_r8/SASUM(N,Z,1) + CALL SSCAL(N,S,Z,1) +! + YNORM = 1.0E0_r8 +! +! SOLVE L*V = Y +! + DO 140 K = 1, N + L = IPVT(K) + T = Z(L) + Z(L) = Z(K) + Z(K) = T + IF (K .LT. N) CALL SAXPY(N-K,T,A(K+1,K),1,Z(K+1),1) + IF (ABS(Z(K)) .LE. 1.0E0_r8) GO TO 130 + S = 1.0E0_r8/ABS(Z(K)) + CALL SSCAL(N,S,Z,1) + YNORM = S*YNORM + 130 CONTINUE + 140 CONTINUE + S = 1.0E0_r8/SASUM(N,Z,1) + CALL SSCAL(N,S,Z,1) + YNORM = S*YNORM +! +! SOLVE U*Z = V +! + DO 160 KB = 1, N + K = N + 1 - KB + IF (ABS(Z(K)) .LE. ABS(A(K,K))) GO TO 150 + S = ABS(A(K,K))/ABS(Z(K)) + CALL SSCAL(N,S,Z,1) + YNORM = S*YNORM + 150 CONTINUE + IF (A(K,K) .NE. 0.0E0_r8) Z(K) = Z(K)/A(K,K) + IF (A(K,K) .EQ. 0.0E0_r8) Z(K) = 1.0E0_r8 + T = -Z(K) + CALL SAXPY(K-1,T,A(1,K),1,Z(1),1) + 160 CONTINUE +! MAKE ZNORM = 1.0 + S = 1.0E0_r8/SASUM(N,Z,1) + CALL SSCAL(N,S,Z,1) + YNORM = S*YNORM +! + IF (ANORM .NE. 0.0E0_r8) RCOND = YNORM/ANORM + IF (ANORM .EQ. 0.0E0_r8) RCOND = 0.0E0_r8 + RETURN + END SUBROUTINE DGECO + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE DGEDI (A,LDA,N,IPVT,DET,WORK,JOB) + + INTEGER LDA,N,IPVT(N),JOB + REAL(r8) A(LDA,*),DET(2),WORK(*) +! +! SGEDI COMPUTES THE DETERMINANT AND INVERSE OF A MATRIX +! USING THE FACTORS COMPUTED BY SGECO OR SGEFA. +! +! ON ENTRY +! +! A REAL(LDA, N) +! THE OUTPUT FROM SGECO OR SGEFA. +! +! LDA INTEGER +! THE LEADING DIMENSION OF THE ARRAY A . +! +! N INTEGER +! THE ORDER OF THE MATRIX A . +! +! IPVT INTEGER(N) +! THE PIVOT VECTOR FROM SGECO OR SGEFA. +! +! WORK REAL(N) +! WORK VECTOR. CONTENTS DESTROYED. +! +! JOB INTEGER +! = 11 BOTH DETERMINANT AND INVERSE. +! = 01 INVERSE ONLY. +! = 10 DETERMINANT ONLY. +! +! ON RETURN +! +! A INVERSE OF ORIGINAL MATRIX IF REQUESTED. +! OTHERWISE UNCHANGED. +! +! DET REAL(2) +! DETERMINANT OF ORIGINAL MATRIX IF REQUESTED. +! OTHERWISE NOT REFERENCED. +! DETERMINANT = DET(1) * 10.0**DET(2) +! WITH 1.0 .LE. ABS(DET(1)) .LT. 10.0 +! OR DET(1) .EQ. 0.0 . +! +! ERROR CONDITION +! +! A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS +! A ZERO ON THE DIAGONAL AND THE INVERSE IS REQUESTED. +! IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED CORRECTLY +! AND IF SGECO HAS SET RCOND .GT. 0.0 OR SGEFA HAS SET +! INFO .EQ. 0 . +! +! LINPACK. THIS VERSION DATED 08/14/78 . +! CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. +! +! SUBROUTINES AND FUNCTIONS +! +! BLAS SAXPY,SSCAL,SSWAP +! FORTRAN ABS,MOD +! +! INTERNAL VARIABLES +! + REAL(r8) T + REAL(r8) TEN + INTEGER I,J,K,KB,KP1,L,NM1 +! +! +! +! COMPUTE DETERMINANT +! + IF (JOB/10 .EQ. 0) GO TO 70 + DET(1) = 1.0E0_r8 + DET(2) = 0.0E0_r8 + TEN = 10.0E0_r8 + DO 50 I = 1, N + IF (IPVT(I) .NE. I) DET(1) = -DET(1) + DET(1) = A(I,I)*DET(1) +! ...EXIT + IF (DET(1) .EQ. 0.0E0_r8) GO TO 60 + 10 IF (ABS(DET(1)) .GE. 1.0E0_r8) GO TO 20 + DET(1) = TEN*DET(1) + DET(2) = DET(2) - 1.0E0_r8 + GO TO 10 + 20 CONTINUE + 30 IF (ABS(DET(1)) .LT. TEN) GO TO 40 + DET(1) = DET(1)/TEN + DET(2) = DET(2) + 1.0E0_r8 + GO TO 30 + 40 CONTINUE + 50 CONTINUE + 60 CONTINUE + 70 CONTINUE +! +! COMPUTE INVERSE(U) +! + IF (MOD(JOB,10) .EQ. 0) GO TO 150 + DO 100 K = 1, N + A(K,K) = 1.0E0_r8/A(K,K) + T = -A(K,K) + CALL SSCAL(K-1,T,A(1,K),1) + KP1 = K + 1 + IF (N .LT. KP1) GO TO 90 + DO 80 J = KP1, N + T = A(K,J) + A(K,J) = 0.0E0_r8 + CALL SAXPY(K,T,A(1,K),1,A(1,J),1) + 80 CONTINUE + 90 CONTINUE + 100 CONTINUE +! +! FORM INVERSE(U)*INVERSE(L) +! + NM1 = N - 1 + IF (NM1 .LT. 1) GO TO 140 + DO 130 KB = 1, NM1 + K = N - KB + KP1 = K + 1 + DO 110 I = KP1, N + WORK(I) = A(I,K) + A(I,K) = 0.0E0_r8 + 110 CONTINUE + DO 120 J = KP1, N + T = WORK(J) + CALL SAXPY(N,T,A(1,J),1,A(1,K),1) + 120 CONTINUE + L = IPVT(K) + IF (L .NE. K) CALL SSWAP(N,A(1,K),1,A(1,L),1) + 130 CONTINUE + 140 CONTINUE + 150 CONTINUE + RETURN + END SUBROUTINE DGEDI + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEFA (A,LDA,N,IPVT,INFO) + + INTEGER LDA,N,IPVT(N),INFO + REAL(r8) A(LDA,*) +! +! SGEFA FACTORS A REAL MATRIX BY GAUSSIAN ELIMINATION. +! +! SGEFA IS USUALLY CALLED BY SGECO, BUT IT CAN BE CALLED +! DIRECTLY WITH A SAVING IN TIME IF RCOND IS NOT NEEDED. +! (TIME FOR SGECO) = (1 + 9/N)*(TIME FOR SGEFA) . +! +! ON ENTRY +! +! A REAL(LDA, N) +! THE MATRIX TO BE FACTORED. +! +! LDA INTEGER +! THE LEADING DIMENSION OF THE ARRAY A . +! +! N INTEGER +! THE ORDER OF THE MATRIX A . +! +! ON RETURN +! +! A AN UPPER TRIANGULAR MATRIX AND THE MULTIPLIERS +! WHICH WERE USED TO OBTAIN IT. +! THE FACTORIZATION CAN BE WRITTEN A = L*U WHERE +! L IS A PRODUCT OF PERMUTATION AND UNIT LOWER +! TRIANGULAR MATRICES AND U IS UPPER TRIANGULAR. +! +! IPVT INTEGER(N) +! AN INTEGER VECTOR OF PIVOT INDICES. +! +! INFO INTEGER +! = 0 NORMAL VALUE. +! = K IF U(K,K) .EQ. 0.0 . THIS IS NOT AN ERROR +! CONDITION FOR THIS SUBROUTINE, BUT IT DOES +! INDICATE THAT SGESL OR SGEDI WILL DIVIDE BY ZERO +! IF CALLED. USE RCOND IN SGECO FOR A RELIABLE +! INDICATION OF SINGULARITY. +! +! LINPACK. THIS VERSION DATED 08/14/78 . +! CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. +! +! SUBROUTINES AND FUNCTIONS +! +! BLAS SAXPY,SSCAL,ISAMAX +! +! INTERNAL VARIABLES +! + REAL(r8) T + INTEGER J,K,KP1,L,NM1 +! +! +! +! GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING +! + INFO = 0 + NM1 = N - 1 + IF (NM1 .LT. 1) GO TO 70 + DO 60 K = 1, NM1 + KP1 = K + 1 +! +! FIND L = PIVOT INDEX +! + L = ISAMAX(N-K+1,A(K,K),1) + K - 1 + IPVT(K) = L +! +! ZERO PIVOT IMPLIES THIS COLUMN ALREADY TRIANGULARIZED +! + IF (A(L,K) .EQ. 0.0E0_r8) GO TO 40 +! +! INTERCHANGE IF NECESSARY +! + IF (L .EQ. K) GO TO 10 + T = A(L,K) + A(L,K) = A(K,K) + A(K,K) = T + 10 CONTINUE +! +! COMPUTE MULTIPLIERS +! + T = -1.0E0_r8/A(K,K) + CALL SSCAL(N-K,T,A(K+1,K),1) +! +! ROW ELIMINATION WITH COLUMN INDEXING +! + DO 30 J = KP1, N + T = A(L,J) + IF (L .EQ. K) GO TO 20 + A(L,J) = A(K,J) + A(K,J) = T + 20 CONTINUE + CALL SAXPY(N-K,T,A(K+1,K),1,A(K+1,J),1) + 30 CONTINUE + GO TO 50 + 40 CONTINUE + INFO = K + 50 CONTINUE + 60 CONTINUE + 70 CONTINUE + IPVT(N) = N + IF (A(N,N) .EQ. 0.0E0_r8) INFO = N + RETURN + END SUBROUTINE SGEFA + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SDOT(N,SX,INCX,SY,INCY) +! +! FORMS THE DOT PRODUCT OF TWO VECTORS. +! USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. +! JACK DONGARRA, LINPACK, 3/11/78. +! +! + real(r8) sdot + + REAL(r8) SX(*),SY(*),STEMP + INTEGER I,INCX,INCY,IX,IY,M,MP1,N +! + STEMP = 0.0E0_r8 + SDOT = 0.0E0_r8 + IF(N.LE.0)RETURN + IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 +! +! CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS +! NOT EQUAL TO 1 +! + IX = 1 + IY = 1 + IF(INCX.LT.0)IX = (-N+1)*INCX + 1 + IF(INCY.LT.0)IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + STEMP = STEMP + SX(IX)*SY(IY) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + SDOT = STEMP + RETURN +! +! CODE FOR BOTH INCREMENTS EQUAL TO 1 +! +! +! CLEAN-UP LOOP +! + 20 M = MOD(N,5) + IF( M .EQ. 0 ) GO TO 40 + DO 30 I = 1,M + STEMP = STEMP + SX(I)*SY(I) + 30 CONTINUE + IF( N .LT. 5 ) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,5 + STEMP = STEMP + SX(I)*SY(I) + SX(I + 1)*SY(I + 1) + & + SX(I + 2)*SY(I + 2) + SX(I + 3)*SY(I + 3) + SX(I + 4)*SY(I + 4) + 50 CONTINUE + 60 SDOT = STEMP + RETURN + END FUNCTION SDOT + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + INTEGER FUNCTION ISAMAX(N,SX,INCX) +! +! FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. +! JACK DONGARRA, LINPACK, 3/11/78. +! + REAL(r8) SX(*),SMAX + INTEGER I,INCX,IX,N +! + ISAMAX = 0 + IF( N .LT. 1 ) RETURN + ISAMAX = 1 + IF(N.EQ.1)RETURN + IF(INCX.EQ.1)GO TO 20 +! +! CODE FOR INCREMENT NOT EQUAL TO 1 +! + IX = 1 + SMAX = ABS(SX(1)) + IX = IX + INCX + DO 10 I = 2,N + IF(ABS(SX(IX)).LE.SMAX) GO TO 5 + ISAMAX = I + SMAX = ABS(SX(IX)) + 5 IX = IX + INCX + 10 CONTINUE + RETURN +! +! CODE FOR INCREMENT EQUAL TO 1 +! + 20 SMAX = ABS(SX(1)) + DO 30 I = 2,N + IF(ABS(SX(I)).LE.SMAX) GO TO 30 + ISAMAX = I + SMAX = ABS(SX(I)) + 30 CONTINUE + RETURN + END FUNCTION ISAMAX + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SASUM(N,SX,INCX) +! +! TAKES THE SUM OF THE ABSOLUTE VALUES. +! USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE. +! JACK DONGARRA, LINPACK, 3/11/78. +! + real(r8) sasum + + REAL(r8) SX(*),STEMP + INTEGER I,INCX,M,MP1,N,NINCX +! + SASUM = 0.0E0_r8 + STEMP = 0.0E0_r8 + IF(N.LE.0)RETURN + IF(INCX.EQ.1)GO TO 20 +! +! CODE FOR INCREMENT NOT EQUAL TO 1 +! + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + STEMP = STEMP + ABS(SX(I)) + 10 CONTINUE + SASUM = STEMP + RETURN +! +! CODE FOR INCREMENT EQUAL TO 1 +! +! +! CLEAN-UP LOOP +! + 20 M = MOD(N,6) + IF( M .EQ. 0 ) GO TO 40 + DO 30 I = 1,M + STEMP = STEMP + ABS(SX(I)) + 30 CONTINUE + IF( N .LT. 6 ) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,6 + STEMP = STEMP + ABS(SX(I)) + ABS(SX(I + 1)) + ABS(SX(I + 2)) & + + ABS(SX(I + 3)) + ABS(SX(I + 4)) + ABS(SX(I + 5)) + 50 CONTINUE + 60 SASUM = STEMP + RETURN + END FUNCTION SASUM + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY) +! +! CONSTANT TIMES A VECTOR PLUS A VECTOR. +! USES UNROLLED LOOP FOR INCREMENTS EQUAL TO ONE. +! JACK DONGARRA, LINPACK, 3/11/78. +! + REAL(r8) SX(*),SY(*),SA + INTEGER I,INCX,INCY,IX,IY,M,MP1,N +! + IF(N.LE.0)RETURN + IF (SA .EQ. 0.0_r8) RETURN + IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 +! +! CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS +! NOT EQUAL TO 1 +! + IX = 1 + IY = 1 + IF(INCX.LT.0)IX = (-N+1)*INCX + 1 + IF(INCY.LT.0)IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + SY(IY) = SY(IY) + SA*SX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +! +! CODE FOR BOTH INCREMENTS EQUAL TO 1 +! +! +! CLEAN-UP LOOP +! + 20 M = MOD(N,4) + IF( M .EQ. 0 ) GO TO 40 + DO 30 I = 1,M + SY(I) = SY(I) + SA*SX(I) + 30 CONTINUE + IF( N .LT. 4 ) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,4 + SY(I) = SY(I) + SA*SX(I) + SY(I + 1) = SY(I + 1) + SA*SX(I + 1) + SY(I + 2) = SY(I + 2) + SA*SX(I + 2) + SY(I + 3) = SY(I + 3) + SA*SX(I + 3) + 50 CONTINUE + RETURN + END SUBROUTINE SAXPY + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + subroutine sscal(n,sa,sx,incx) +! +! scales a vector by a constant. +! uses unrolled loops for increment equal to 1. +! jack dongarra, linpack, 3/11/78. +! modified 3/93 to return if incx .le. 0. +! modified 12/3/93, array(1) declarations changed to array(*) +! + integer i,incx,m,mp1,n,nincx + real(r8) sa,sx(*) +! + if( n.le.0 .or. incx.le.0 )return + if(incx.eq.1)go to 20 +! +! code for increment not equal to 1 +! + nincx = n*incx + do 10 i = 1,nincx,incx + sx(i) = sa*sx(i) + 10 continue + return +! +! code for increment equal to 1 +! +! +! clean-up loop +! + 20 m = mod(n,5) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sx(i) = sa*sx(i) + 30 continue + if( n .lt. 5 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,5 + sx(i) = sa*sx(i) + sx(i + 1) = sa*sx(i + 1) + sx(i + 2) = sa*sx(i + 2) + sx(i + 3) = sa*sx(i + 3) + sx(i + 4) = sa*sx(i + 4) + 50 continue + return + end subroutine sscal + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + subroutine sswap (n,sx,incx,sy,incy) +! +! interchanges two vectors. +! uses unrolled loops for increments equal to 1. +! jack dongarra, linpack, 3/11/78. +! modified 12/3/93, array(1) declarations changed to array(*) +! + real(r8) sx(*),sy(*),stemp + integer i,incx,incy,ix,iy,m,mp1,n +! + if(n.le.0)return + if(incx.eq.1.and.incy.eq.1)go to 20 +! +! code for unequal increments or equal increments not equal +! to 1 +! + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + stemp = sx(ix) + sx(ix) = sy(iy) + sy(iy) = stemp + ix = ix + incx + iy = iy + incy + 10 continue + return +! +! code for both increments equal to 1 +! +! +! clean-up loop +! + 20 m = mod(n,3) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + stemp = sx(i) + sx(i) = sy(i) + sy(i) = stemp + 30 continue + if( n .lt. 3 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,3 + stemp = sx(i) + sx(i) = sy(i) + sy(i) = stemp + stemp = sx(i + 1) + sx(i + 1) = sy(i + 1) + sy(i + 1) = stemp + stemp = sx(i + 2) + sx(i + 2) = sy(i + 2) + sy(i + 2) = stemp + 50 continue + return + end subroutine sswap + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, & + LDVR, WORK, LWORK, INFO ) + +! +! -- LAPACK driver routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER JOBVL, JOBVR + INTEGER INFO, LDA, LDVL, LDVR, LWORK, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), & + WI( * ), WORK( * ), WR( * ) +! .. +! +! Purpose +! ======= +! +! SGEEV computes for an N-by-N real nonsymmetric matrix A, the +! eigenvalues and, optionally, the left and/or right eigenvectors. +! +! The right eigenvector v(j) of A satisfies +! A * v(j) = lambda(j) * v(j) +! where lambda(j) is its eigenvalue. +! The left eigenvector u(j) of A satisfies +! u(j)**H * A = lambda(j) * u(j)**H +! where u(j)**H denotes the conjugate transpose of u(j). +! +! The computed eigenvectors are normalized to have Euclidean norm +! equal to 1 and largest component real. +! +! Arguments +! ========= +! +! JOBVL (input) CHARACTER*1 +! = 'N': left eigenvectors of A are not computed; +! = 'V': left eigenvectors of A are computed. +! +! JOBVR (input) CHARACTER*1 +! = 'N': right eigenvectors of A are not computed; +! = 'V': right eigenvectors of A are computed. +! +! N (input) INTEGER +! The order of the matrix A. N >= 0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the N-by-N matrix A. +! On exit, A has been overwritten. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! WR (output) REAL array, dimension (N) +! WI (output) REAL array, dimension (N) +! WR and WI contain the real and imaginary parts, +! respectively, of the computed eigenvalues. Complex +! conjugate pairs of eigenvalues appear consecutively +! with the eigenvalue having the positive imaginary part +! first. +! +! VL (output) REAL array, dimension (LDVL,N) +! If JOBVL = 'V', the left eigenvectors u(j) are stored one +! after another in the columns of VL, in the same order +! as their eigenvalues. +! If JOBVL = 'N', VL is not referenced. +! If the j-th eigenvalue is real, then u(j) = VL(:,j), +! the j-th column of VL. +! If the j-th and (j+1)-st eigenvalues form a complex +! conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and +! u(j+1) = VL(:,j) - i*VL(:,j+1). +! +! LDVL (input) INTEGER +! The leading dimension of the array VL. LDVL >= 1; if +! JOBVL = 'V', LDVL >= N. +! +! VR (output) REAL array, dimension (LDVR,N) +! If JOBVR = 'V', the right eigenvectors v(j) are stored one +! after another in the columns of VR, in the same order +! as their eigenvalues. +! If JOBVR = 'N', VR is not referenced. +! If the j-th eigenvalue is real, then v(j) = VR(:,j), +! the j-th column of VR. +! If the j-th and (j+1)-st eigenvalues form a complex +! conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and +! v(j+1) = VR(:,j) - i*VR(:,j+1). +! +! LDVR (input) INTEGER +! The leading dimension of the array VR. LDVR >= 1; if +! JOBVR = 'V', LDVR >= N. +! +! WORK (workspace/output) REAL array, dimension (LWORK) +! On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +! +! LWORK (input) INTEGER +! The dimension of the array WORK. LWORK >= max(1,3*N), and +! if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good +! performance, LWORK must generally be larger. +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value. +! > 0: if INFO = i, the QR algorithm failed to compute all the +! eigenvalues, and no eigenvectors have been computed; +! elements i+1:N of WR and WI contain eigenvalues which +! have converged. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E0_r8, ONE = 1.0E0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL SCALEA, WANTVL, WANTVR + CHARACTER SIDE + INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, & + MAXB, MAXWRK, MINWRK, NOUT + REAL(r8) ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, & + SN +! .. +! .. Local Arrays .. + LOGICAL SELECT( 1 ) + REAL(r8) DUM( 1 ) +! .. +! .. Executable Statements .. +! +! Test the input arguments +! + INFO = 0 + WANTVL = LSAME( JOBVL, 'V' ) + WANTVR = LSAME( JOBVR, 'V' ) + IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN + INFO = -1 + ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN + INFO = -9 + ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN + INFO = -11 + END IF +! +! Compute workspace +! (Note: Comments in the code beginning "Workspace:" describe the +! minimal amount of workspace needed at that point in the code, +! as well as the preferred amount for good performance. +! NB refers to the optimal block size for the immediately +! following subroutine, as returned by ILAENV. +! HSWORK refers to the workspace preferred by SHSEQR, as +! calculated below. HSWORK is computed assuming ILO=1 and IHI=N, +! the worst case.) +! + MINWRK = 1 + IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN + MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 ) + IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN + MINWRK = MAX( 1, 3*N ) + MAXB = MAX( ILAENV( 8, 'SHSEQR', 'EN', N, 1, N, -1 ), 2 ) + K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'SHSEQR', 'EN', N, 1, & + N, -1 ) ) ) + HSWORK = MAX( K*( K+2 ), 2*N ) + MAXWRK = MAX( MAXWRK, N+1, N+HSWORK ) + ELSE + MINWRK = MAX( 1, 4*N ) + MAXWRK = MAX( MAXWRK, 2*N+( N-1 )* & + ILAENV( 1, 'SORGHR', ' ', N, 1, N, -1 ) ) + MAXB = MAX( ILAENV( 8, 'SHSEQR', 'SV', N, 1, N, -1 ), 2 ) + K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'SHSEQR', 'SV', N, 1, & + N, -1 ) ) ) + HSWORK = MAX( K*( K+2 ), 2*N ) + MAXWRK = MAX( MAXWRK, N+1, N+HSWORK ) + MAXWRK = MAX( MAXWRK, 4*N ) + END IF + WORK( 1 ) = MAXWRK + END IF + IF( LWORK.LT.MINWRK ) THEN + INFO = -13 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGEEV ', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.EQ.0 ) & + RETURN +! +! Get machine constants +! + EPS = SLAMCH( 'P' ) + SMLNUM = SLAMCH( 'S' ) + BIGNUM = ONE / SMLNUM + CALL SLABAD( SMLNUM, BIGNUM ) + SMLNUM = SQRT( SMLNUM ) / EPS + BIGNUM = ONE / SMLNUM +! +! Scale A if max element outside range [SMLNUM,BIGNUM] +! + ANRM = SLANGE( 'M', N, N, A, LDA, DUM ) + SCALEA = .FALSE. + IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN + SCALEA = .TRUE. + CSCALE = SMLNUM + ELSE IF( ANRM.GT.BIGNUM ) THEN + SCALEA = .TRUE. + CSCALE = BIGNUM + END IF + IF( SCALEA ) & + CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR ) +! +! Balance the matrix +! (Workspace: need N) +! + IBAL = 1 + CALL SGEBAL( 'B', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR ) +! +! Reduce to upper Hessenberg form +! (Workspace: need 3*N, prefer 2*N+N*NB) +! + ITAU = IBAL + N + IWRK = ITAU + N + CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ), & + LWORK-IWRK+1, IERR ) +! + IF( WANTVL ) THEN +! +! Want left eigenvectors +! Copy Householder vectors to VL +! + SIDE = 'L' + CALL SLACPY( 'L', N, N, A, LDA, VL, LDVL ) +! +! Generate orthogonal matrix in VL +! (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) +! + CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), & + LWORK-IWRK+1, IERR ) +! +! Perform QR iteration, accumulating Schur vectors in VL +! (Workspace: need N+1, prefer N+HSWORK (see comments) ) +! + IWRK = ITAU + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL, & + WORK( IWRK ), LWORK-IWRK+1, INFO ) +! + IF( WANTVR ) THEN +! +! Want left and right eigenvectors +! Copy Schur vectors to VR +! + SIDE = 'B' + CALL SLACPY( 'F', N, N, VL, LDVL, VR, LDVR ) + END IF +! + ELSE IF( WANTVR ) THEN +! +! Want right eigenvectors +! Copy Householder vectors to VR +! + SIDE = 'R' + CALL SLACPY( 'L', N, N, A, LDA, VR, LDVR ) +! +! Generate orthogonal matrix in VR +! (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) +! + CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), & + LWORK-IWRK+1, IERR ) +! +! Perform QR iteration, accumulating Schur vectors in VR +! (Workspace: need N+1, prefer N+HSWORK (see comments) ) +! + IWRK = ITAU + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, & + WORK( IWRK ), LWORK-IWRK+1, INFO ) +! + ELSE +! +! Compute eigenvalues only +! (Workspace: need N+1, prefer N+HSWORK (see comments) ) +! + IWRK = ITAU + CALL SHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, & + WORK( IWRK ), LWORK-IWRK+1, INFO ) + END IF +! +! If INFO > 0 from SHSEQR, then quit +! + IF( INFO.GT.0 ) & + GO TO 50 +! + IF( WANTVL .OR. WANTVR ) THEN +! +! Compute left and/or right eigenvectors +! (Workspace: need 4*N) +! + CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, & + N, NOUT, WORK( IWRK ), IERR ) + END IF +! + IF( WANTVL ) THEN +! +! Undo balancing of left eigenvectors +! (Workspace: need N) +! + CALL SGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL, & + IERR ) +! +! Normalize left eigenvectors and make largest component real +! + DO 20 I = 1, N + IF( WI( I ).EQ.ZERO ) THEN + SCL = ONE / SNRM2( N, VL( 1, I ), 1 ) + CALL SSCAL( N, SCL, VL( 1, I ), 1 ) + ELSE IF( WI( I ).GT.ZERO ) THEN + SCL = ONE / SLAPY2( SNRM2( N, VL( 1, I ), 1 ), & + SNRM2( N, VL( 1, I+1 ), 1 ) ) + CALL SSCAL( N, SCL, VL( 1, I ), 1 ) + CALL SSCAL( N, SCL, VL( 1, I+1 ), 1 ) + DO 10 K = 1, N + WORK( IWRK+K-1 ) = VL( K, I )**2 + VL( K, I+1 )**2 + 10 CONTINUE + K = ISAMAX( N, WORK( IWRK ), 1 ) + CALL SLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R ) + CALL SROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN ) + VL( K, I+1 ) = ZERO + END IF + 20 CONTINUE + END IF +! + IF( WANTVR ) THEN +! +! Undo balancing of right eigenvectors +! (Workspace: need N) +! + CALL SGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR, & + IERR ) +! +! Normalize right eigenvectors and make largest component real +! + DO 40 I = 1, N + IF( WI( I ).EQ.ZERO ) THEN + SCL = ONE / SNRM2( N, VR( 1, I ), 1 ) + CALL SSCAL( N, SCL, VR( 1, I ), 1 ) + ELSE IF( WI( I ).GT.ZERO ) THEN + SCL = ONE / SLAPY2( SNRM2( N, VR( 1, I ), 1 ), & + SNRM2( N, VR( 1, I+1 ), 1 ) ) + CALL SSCAL( N, SCL, VR( 1, I ), 1 ) + CALL SSCAL( N, SCL, VR( 1, I+1 ), 1 ) + DO 30 K = 1, N + WORK( IWRK+K-1 ) = VR( K, I )**2 + VR( K, I+1 )**2 + 30 CONTINUE + K = ISAMAX( N, WORK( IWRK ), 1 ) + CALL SLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R ) + CALL SROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN ) + VR( K, I+1 ) = ZERO + END IF + 40 CONTINUE + END IF +! +! Undo scaling if necessary +! + 50 CONTINUE + IF( SCALEA ) THEN + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ), & + MAX( N-INFO, 1 ), IERR ) + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ), & + MAX( N-INFO, 1 ), IERR ) + IF( INFO.GT.0 ) THEN + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N, & + IERR ) + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N, & + IERR ) + END IF + END IF +! + WORK( 1 ) = MAXWRK + RETURN +! +! End of SGEEV +! + END SUBROUTINE SGEEV + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, & + INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER JOB, SIDE + INTEGER IHI, ILO, INFO, LDV, M, N +! .. +! .. Array Arguments .. + REAL(r8) V( LDV, * ), SCALE( * ) +! .. +! +! Purpose +! ======= +! +! SGEBAK forms the right or left eigenvectors of a real general matrix +! by backward transformation on the computed eigenvectors of the +! balanced matrix output by SGEBAL. +! +! Arguments +! ========= +! +! JOB (input) CHARACTER*1 +! Specifies the type of backward transformation required: +! = 'N', do nothing, return immediately; +! = 'P', do backward transformation for permutation only; +! = 'S', do backward transformation for scaling only; +! = 'B', do backward transformations for both permutation and +! scaling. +! JOB must be the same as the argument JOB supplied to SGEBAL. +! +! SIDE (input) CHARACTER*1 +! = 'R': V contains right eigenvectors; +! = 'L': V contains left eigenvectors. +! +! N (input) INTEGER +! The number of rows of the matrix V. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! The integers ILO and IHI determined by SGEBAL. +! 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. +! +! SCALE (input) REAL array, dimension (N) +! Details of the permutation and scaling factors, as returned +! by SGEBAL. +! +! M (input) INTEGER +! The number of columns of the matrix V. M >= 0. +! +! V (input/output) REAL array, dimension (LDV,M) +! On entry, the matrix of right or left eigenvectors to be +! transformed, as returned by SHSEIN or STREVC. +! On exit, V is overwritten by the transformed eigenvectors. +! +! LDV (input) INTEGER +! The leading dimension of the array V. LDV >= max(1,N). +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE + PARAMETER ( ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL LEFTV, RIGHTV + INTEGER I, II, K + REAL(r8) S +! .. +! .. Executable Statements .. +! +! Decode and Test the input parameters +! + RIGHTV = LSAME( SIDE, 'R' ) + LEFTV = LSAME( SIDE, 'L' ) +! + INFO = 0 + IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. & + .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + INFO = -1 + ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN + INFO = -4 + ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN + INFO = -5 + ELSE IF( M.LT.0 ) THEN + INFO = -7 + ELSE IF( LDV.LT.MAX( 1, N ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGEBAK', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.EQ.0 ) & + RETURN + IF( M.EQ.0 ) & + RETURN + IF( LSAME( JOB, 'N' ) ) & + RETURN +! + IF( ILO.EQ.IHI ) & + GO TO 30 +! +! Backward balance +! + IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN +! + IF( RIGHTV ) THEN + DO 10 I = ILO, IHI + S = SCALE( I ) + CALL SSCAL( M, S, V( I, 1 ), LDV ) + 10 CONTINUE + END IF +! + IF( LEFTV ) THEN + DO 20 I = ILO, IHI + S = ONE / SCALE( I ) + CALL SSCAL( M, S, V( I, 1 ), LDV ) + 20 CONTINUE + END IF +! + END IF +! +! Backward permutation +! +! For I = ILO-1 step -1 until 1, +! IHI+1 step 1 until N do -- +! + 30 CONTINUE + IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN + IF( RIGHTV ) THEN + DO 40 II = 1, N + I = II + IF( I.GE.ILO .AND. I.LE.IHI ) & + GO TO 40 + IF( I.LT.ILO ) & + I = ILO - II + K = SCALE( I ) + IF( K.EQ.I ) & + GO TO 40 + CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) + 40 CONTINUE + END IF +! + IF( LEFTV ) THEN + DO 50 II = 1, N + I = II + IF( I.GE.ILO .AND. I.LE.IHI ) & + GO TO 50 + IF( I.LT.ILO ) & + I = ILO - II + K = SCALE( I ) + IF( K.EQ.I ) & + GO TO 50 + CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) + 50 CONTINUE + END IF + END IF +! + RETURN +! +! End of SGEBAK +! + END SUBROUTINE SGEBAK + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER JOB + INTEGER IHI, ILO, INFO, LDA, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), SCALE( * ) +! .. +! +! Purpose +! ======= +! +! SGEBAL balances a general real matrix A. This involves, first, +! permuting A by a similarity transformation to isolate eigenvalues +! in the first 1 to ILO-1 and last IHI+1 to N elements on the +! diagonal; and second, applying a diagonal similarity transformation +! to rows and columns ILO to IHI to make the rows and columns as +! close in norm as possible. Both steps are optional. +! +! Balancing may reduce the 1-norm of the matrix, and improve the +! accuracy of the computed eigenvalues and/or eigenvectors. +! +! Arguments +! ========= +! +! JOB (input) CHARACTER*1 +! Specifies the operations to be performed on A: +! = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0 +! for i = 1,...,N; +! = 'P': permute only; +! = 'S': scale only; +! = 'B': both permute and scale. +! +! N (input) INTEGER +! The order of the matrix A. N >= 0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the input matrix A. +! On exit, A is overwritten by the balanced matrix. +! If JOB = 'N', A is not referenced. +! See Further Details. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! ILO (output) INTEGER +! IHI (output) INTEGER +! ILO and IHI are set to integers such that on exit +! A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N. +! If JOB = 'N' or 'S', ILO = 1 and IHI = N. +! +! SCALE (output) REAL array, dimension (N) +! Details of the permutations and scaling factors applied to +! A. If P(j) is the index of the row and column interchanged +! with row and column j and D(j) is the scaling factor +! applied to row and column j, then +! SCALE(j) = P(j) for j = 1,...,ILO-1 +! = D(j) for j = ILO,...,IHI +! = P(j) for j = IHI+1,...,N. +! The order in which the interchanges are made is N to IHI+1, +! then 1 to ILO-1. +! +! INFO (output) INTEGER +! = 0: successful exit. +! < 0: if INFO = -i, the i-th argument had an illegal value. +! +! Further Details +! =============== +! +! The permutations consist of row and column interchanges which put +! the matrix in the form +! +! ( T1 X Y ) +! P A P = ( 0 B Z ) +! ( 0 0 T2 ) +! +! where T1 and T2 are upper triangular matrices whose eigenvalues lie +! along the diagonal. The column indices ILO and IHI mark the starting +! and ending columns of the submatrix B. Balancing consists of applying +! a diagonal similarity transformation inv(D) * B * D to make the +! 1-norms of each row of B and its corresponding column nearly equal. +! The output matrix is +! +! ( T1 X*D Y ) +! ( 0 inv(D)*B*D inv(D)*Z ). +! ( 0 0 T2 ) +! +! Information about the permutations P and the diagonal matrix D is +! returned in the vector SCALE. +! +! This subroutine is based on the EISPACK routine BALANC. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) + REAL(r8) SCLFAC + PARAMETER ( SCLFAC = 1.0E+1_r8 ) + REAL(r8) FACTOR + PARAMETER ( FACTOR = 0.95E+0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL NOCONV + INTEGER I, ICA, IEXC, IRA, J, K, L, M + REAL(r8) C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1, & + SFMIN2 +! .. +! .. Executable Statements .. +! +! Test the input parameters +! + INFO = 0 + IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. & + .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGEBAL', -INFO ) + RETURN + END IF +! + K = 1 + L = N +! + IF( N.EQ.0 ) & + GO TO 210 +! + IF( LSAME( JOB, 'N' ) ) THEN + DO 10 I = 1, N + SCALE( I ) = ONE + 10 CONTINUE + GO TO 210 + END IF +! + IF( LSAME( JOB, 'S' ) ) & + GO TO 120 +! +! Permutation to isolate eigenvalues if possible +! + GO TO 50 +! +! Row and column exchange. +! + 20 CONTINUE + SCALE( M ) = J + IF( J.EQ.M ) & + GO TO 30 +! + CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 ) + CALL SSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA ) +! + 30 CONTINUE + GO TO ( 40, 80 )IEXC +! +! Search for rows isolating an eigenvalue and push them down. +! + 40 CONTINUE + IF( L.EQ.1 ) & + GO TO 210 + L = L - 1 +! + 50 CONTINUE + DO 70 J = L, 1, -1 +! + DO 60 I = 1, L + IF( I.EQ.J ) & + GO TO 60 + IF( A( J, I ).NE.ZERO ) & + GO TO 70 + 60 CONTINUE +! + M = L + IEXC = 1 + GO TO 20 + 70 CONTINUE +! + GO TO 90 +! +! Search for columns isolating an eigenvalue and push them left. +! + 80 CONTINUE + K = K + 1 +! + 90 CONTINUE + DO 110 J = K, L +! + DO 100 I = K, L + IF( I.EQ.J ) & + GO TO 100 + IF( A( I, J ).NE.ZERO ) & + GO TO 110 + 100 CONTINUE +! + M = K + IEXC = 2 + GO TO 20 + 110 CONTINUE +! + 120 CONTINUE + DO 130 I = K, L + SCALE( I ) = ONE + 130 CONTINUE +! + IF( LSAME( JOB, 'P' ) ) & + GO TO 210 +! +! Balance the submatrix in rows K to L. +! +! Iterative loop for norm reduction +! + SFMIN1 = SLAMCH( 'S' ) / SLAMCH( 'P' ) + SFMAX1 = ONE / SFMIN1 + SFMIN2 = SFMIN1*SCLFAC + SFMAX2 = ONE / SFMIN2 + 140 CONTINUE + NOCONV = .FALSE. +! + DO 200 I = K, L + C = ZERO + R = ZERO +! + DO 150 J = K, L + IF( J.EQ.I ) & + GO TO 150 + C = C + ABS( A( J, I ) ) + R = R + ABS( A( I, J ) ) + 150 CONTINUE + ICA = ISAMAX( L, A( 1, I ), 1 ) + CA = ABS( A( ICA, I ) ) + IRA = ISAMAX( N-K+1, A( I, K ), LDA ) + RA = ABS( A( I, IRA+K-1 ) ) +! +! Guard against zero C or R due to underflow. +! + IF( C.EQ.ZERO .OR. R.EQ.ZERO ) & + GO TO 200 + G = R / SCLFAC + F = ONE + S = C + R + 160 CONTINUE + IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR. & + MIN( R, G, RA ).LE.SFMIN2 )GO TO 170 + F = F*SCLFAC + C = C*SCLFAC + CA = CA*SCLFAC + R = R / SCLFAC + G = G / SCLFAC + RA = RA / SCLFAC + GO TO 160 +! + 170 CONTINUE + G = C / SCLFAC + 180 CONTINUE + IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR. & + MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190 + F = F / SCLFAC + C = C / SCLFAC + G = G / SCLFAC + CA = CA / SCLFAC + R = R*SCLFAC + RA = RA*SCLFAC + GO TO 180 +! +! Now balance. +! + 190 CONTINUE + IF( ( C+R ).GE.FACTOR*S ) & + GO TO 200 + IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN + IF( F*SCALE( I ).LE.SFMIN1 ) & + GO TO 200 + END IF + IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN + IF( SCALE( I ).GE.SFMAX1 / F ) & + GO TO 200 + END IF + G = ONE / F + SCALE( I ) = SCALE( I )*F + NOCONV = .TRUE. +! + CALL SSCAL( N-K+1, G, A( I, K ), LDA ) + CALL SSCAL( L, F, A( 1, I ), 1 ) +! + 200 CONTINUE +! + IF( NOCONV ) & + GO TO 140 +! + 210 CONTINUE + ILO = K + IHI = L +! + RETURN +! +! End of SGEBAL +! + END SUBROUTINE SGEBAL + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + INTEGER IHI, ILO, INFO, LDA, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), TAU( * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SGEHD2 reduces a real general matrix A to upper Hessenberg form H by +! an orthogonal similarity transformation: Q' * A * Q = H . +! +! Arguments +! ========= +! +! N (input) INTEGER +! The order of the matrix A. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! It is assumed that A is already upper triangular in rows +! and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally +! set by a previous call to SGEBAL; otherwise they should be +! set to 1 and N respectively. See Further Details. +! 1 <= ILO <= IHI <= max(1,N). +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the n by n general matrix to be reduced. +! On exit, the upper triangle and the first subdiagonal of A +! are overwritten with the upper Hessenberg matrix H, and the +! elements below the first subdiagonal, with the array TAU, +! represent the orthogonal matrix Q as a product of elementary +! reflectors. See Further Details. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! TAU (output) REAL array, dimension (N-1) +! The scalar factors of the elementary reflectors (see Further +! Details). +! +! WORK (workspace) REAL array, dimension (N) +! +! INFO (output) INTEGER +! = 0: successful exit. +! < 0: if INFO = -i, the i-th argument had an illegal value. +! +! Further Details +! =============== +! +! The matrix Q is represented as a product of (ihi-ilo) elementary +! reflectors +! +! Q = H(ilo) H(ilo+1) . . . H(ihi-1). +! +! Each H(i) has the form +! +! H(i) = I - tau * v * v' +! +! where tau is a real scalar, and v is a real vector with +! v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on +! exit in A(i+2:ihi,i), and tau in TAU(i). +! +! The contents of A are illustrated by the following example, with +! n = 7, ilo = 2 and ihi = 6: +! +! on entry, on exit, +! +! ( a a a a a a a ) ( a a h h h h a ) +! ( a a a a a a ) ( a h h h h a ) +! ( a a a a a a ) ( h h h h h h ) +! ( a a a a a a ) ( v2 h h h h h ) +! ( a a a a a a ) ( v2 v3 h h h h ) +! ( a a a a a a ) ( v2 v3 v4 h h h ) +! ( a ) ( a ) +! +! where a denotes an element of the original matrix A, h denotes a +! modified element of the upper Hessenberg matrix H, and vi denotes an +! element of the vector defining H(i). +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE + PARAMETER ( ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I + REAL(r8) AII +! .. +! .. Executable Statements .. +! +! Test the input parameters +! + INFO = 0 + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN + INFO = -2 + ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGEHD2', -INFO ) + RETURN + END IF +! + DO 10 I = ILO, IHI - 1 +! +! Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) +! + CALL SLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, & + TAU( I ) ) + AII = A( I+1, I ) + A( I+1, I ) = ONE +! +! Apply H(i) to A(1:ihi,i+1:ihi) from the right +! + CALL SLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), & + A( 1, I+1 ), LDA, WORK ) +! +! Apply H(i) to A(i+1:ihi,i+1:n) from the left +! + CALL SLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ), & + A( I+1, I+1 ), LDA, WORK ) +! + A( I+1, I ) = AII + 10 CONTINUE +! + RETURN +! +! End of SGEHD2 +! + END SUBROUTINE SGEHD2 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + INTEGER IHI, ILO, INFO, LDA, LWORK, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), TAU( * ), WORK( LWORK ) +! .. +! +! Purpose +! ======= +! +! SGEHRD reduces a real general matrix A to upper Hessenberg form H by +! an orthogonal similarity transformation: Q' * A * Q = H . +! +! Arguments +! ========= +! +! N (input) INTEGER +! The order of the matrix A. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! It is assumed that A is already upper triangular in rows +! and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally +! set by a previous call to SGEBAL; otherwise they should be +! set to 1 and N respectively. See Further Details. +! 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the N-by-N general matrix to be reduced. +! On exit, the upper triangle and the first subdiagonal of A +! are overwritten with the upper Hessenberg matrix H, and the +! elements below the first subdiagonal, with the array TAU, +! represent the orthogonal matrix Q as a product of elementary +! reflectors. See Further Details. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! TAU (output) REAL array, dimension (N-1) +! The scalar factors of the elementary reflectors (see Further +! Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to +! zero. +! +! WORK (workspace/output) REAL array, dimension (LWORK) +! On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +! +! LWORK (input) INTEGER +! The length of the array WORK. LWORK >= max(1,N). +! For optimum performance LWORK >= N*NB, where NB is the +! optimal blocksize. +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value. +! +! Further Details +! =============== +! +! The matrix Q is represented as a product of (ihi-ilo) elementary +! reflectors +! +! Q = H(ilo) H(ilo+1) . . . H(ihi-1). +! +! Each H(i) has the form +! +! H(i) = I - tau * v * v' +! +! where tau is a real scalar, and v is a real vector with +! v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on +! exit in A(i+2:ihi,i), and tau in TAU(i). +! +! The contents of A are illustrated by the following example, with +! n = 7, ilo = 2 and ihi = 6: +! +! on entry, on exit, +! +! ( a a a a a a a ) ( a a h h h h a ) +! ( a a a a a a ) ( a h h h h a ) +! ( a a a a a a ) ( h h h h h h ) +! ( a a a a a a ) ( v2 h h h h h ) +! ( a a a a a a ) ( v2 v3 h h h h ) +! ( a a a a a a ) ( v2 v3 v4 h h h ) +! ( a ) ( a ) +! +! where a denotes an element of the original matrix A, h denotes a +! modified element of the upper Hessenberg matrix H, and vi denotes an +! element of the vector defining H(i). +! +! ===================================================================== +! +! .. Parameters .. + INTEGER NBMAX, LDT + PARAMETER ( NBMAX = 64, LDT = NBMAX+1 ) + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, IB, IINFO, IWS, LDWORK, NB, NBMIN, NH, NX + REAL(r8) EI +! .. +! .. Local Arrays .. + REAL(r8) T( LDT, NBMAX ) +! .. +! .. Executable Statements .. +! +! Test the input parameters +! + INFO = 0 + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN + INFO = -2 + ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN + INFO = -8 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGEHRD', -INFO ) + RETURN + END IF +! +! Set elements 1:ILO-1 and IHI:N-1 of TAU to zero +! + DO 10 I = 1, ILO - 1 + TAU( I ) = ZERO + 10 CONTINUE + DO 20 I = MAX( 1, IHI ), N - 1 + TAU( I ) = ZERO + 20 CONTINUE +! +! Quick return if possible +! + NH = IHI - ILO + 1 + IF( NH.LE.1 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +! +! Determine the block size. +! + NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, -1 ) ) + NBMIN = 2 + IWS = 1 + IF( NB.GT.1 .AND. NB.LT.NH ) THEN +! +! Determine when to cross over from blocked to unblocked code +! (last block is always handled by unblocked code). +! + NX = MAX( NB, ILAENV( 3, 'SGEHRD', ' ', N, ILO, IHI, -1 ) ) + IF( NX.LT.NH ) THEN +! +! Determine if workspace is large enough for blocked code. +! + IWS = N*NB + IF( LWORK.LT.IWS ) THEN +! +! Not enough workspace to use optimal NB: determine the +! minimum value of NB, and reduce NB or force use of +! unblocked code. +! + NBMIN = MAX( 2, ILAENV( 2, 'SGEHRD', ' ', N, ILO, IHI, & + -1 ) ) + IF( LWORK.GE.N*NBMIN ) THEN + NB = LWORK / N + ELSE + NB = 1 + END IF + END IF + END IF + END IF + LDWORK = N +! + IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN +! +! Use unblocked code below +! + I = ILO +! + ELSE +! +! Use blocked code +! + DO 30 I = ILO, IHI - 1 - NX, NB + IB = MIN( NB, IHI-I ) +! +! Reduce columns i:i+ib-1 to Hessenberg form, returning the +! matrices V and T of the block reflector H = I - V*T*V' +! which performs the reduction, and also the matrix Y = A*V*T +! + CALL SLAHRD( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT, & + WORK, LDWORK ) +! +! Apply the block reflector H to A(1:ihi,i+ib:ihi) from the +! right, computing A := A - Y * V'. V(i+ib,ib-1) must be set +! to 1. +! + EI = A( I+IB, I+IB-1 ) + A( I+IB, I+IB-1 ) = ONE + CALL SGEMM( 'No transpose', 'Transpose', IHI, IHI-I-IB+1, & + IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE, & + A( 1, I+IB ), LDA ) + A( I+IB, I+IB-1 ) = EI +! +! Apply the block reflector H to A(i+1:ihi,i+ib:n) from the +! left +! + CALL SLARFB( 'Left', 'Transpose', 'Forward', 'Columnwise', & + IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT, & + A( I+1, I+IB ), LDA, WORK, LDWORK ) + 30 CONTINUE + END IF +! +! Use unblocked code to reduce the rest of the matrix +! + CALL SGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) + WORK( 1 ) = IWS +! + RETURN +! +! End of SGEHRD +! + END SUBROUTINE SGEHRD + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, & + LDZ, WORK, LWORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER COMPZ, JOB + INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N +! .. +! .. Array Arguments .. + REAL(r8) H( LDH, * ), WI( * ), WORK( * ), WR( * ), & + Z( LDZ, * ) +! .. +! +! Purpose +! ======= +! +! SHSEQR computes the eigenvalues of a real upper Hessenberg matrix H +! and, optionally, the matrices T and Z from the Schur decomposition +! H = Z T Z**T, where T is an upper quasi-triangular matrix (the Schur +! form), and Z is the orthogonal matrix of Schur vectors. +! +! Optionally Z may be postmultiplied into an input orthogonal matrix Q, +! so that this routine can give the Schur factorization of a matrix A +! which has been reduced to the Hessenberg form H by the orthogonal +! matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. +! +! Arguments +! ========= +! +! JOB (input) CHARACTER*1 +! = 'E': compute eigenvalues only; +! = 'S': compute eigenvalues and the Schur form T. +! +! COMPZ (input) CHARACTER*1 +! = 'N': no Schur vectors are computed; +! = 'I': Z is initialized to the unit matrix and the matrix Z +! of Schur vectors of H is returned; +! = 'V': Z must contain an orthogonal matrix Q on entry, and +! the product Q*Z is returned. +! +! N (input) INTEGER +! The order of the matrix H. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! It is assumed that H is already upper triangular in rows +! and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally +! set by a previous call to SGEBAL, and then passed to SGEHRD +! when the matrix output by SGEBAL is reduced to Hessenberg +! form. Otherwise ILO and IHI should be set to 1 and N +! respectively. +! 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. +! +! H (input/output) REAL array, dimension (LDH,N) +! On entry, the upper Hessenberg matrix H. +! On exit, if JOB = 'S', H contains the upper quasi-triangular +! matrix T from the Schur decomposition (the Schur form); +! 2-by-2 diagonal blocks (corresponding to complex conjugate +! pairs of eigenvalues) are returned in standard form, with +! H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0. If JOB = 'E', +! the contents of H are unspecified on exit. +! +! LDH (input) INTEGER +! The leading dimension of the array H. LDH >= max(1,N). +! +! WR (output) REAL array, dimension (N) +! WI (output) REAL array, dimension (N) +! The real and imaginary parts, respectively, of the computed +! eigenvalues. If two eigenvalues are computed as a complex +! conjugate pair, they are stored in consecutive elements of +! WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and +! WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in the +! same order as on the diagonal of the Schur form returned in +! H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 +! diagonal block, WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and +! WI(i+1) = -WI(i). +! +! Z (input/output) REAL array, dimension (LDZ,N) +! If COMPZ = 'N': Z is not referenced. +! If COMPZ = 'I': on entry, Z need not be set, and on exit, Z +! contains the orthogonal matrix Z of the Schur vectors of H. +! If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q, +! which is assumed to be equal to the unit matrix except for +! the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z. +! Normally Q is the orthogonal matrix generated by SORGHR after +! the call to SGEHRD which formed the Hessenberg matrix H. +! +! LDZ (input) INTEGER +! The leading dimension of the array Z. +! LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise. +! +! WORK (workspace) REAL array, dimension (N) +! +! LWORK (input) INTEGER +! This argument is currently redundant. +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value +! > 0: if INFO = i, SHSEQR failed to compute all of the +! eigenvalues in a total of 30*(IHI-ILO+1) iterations; +! elements 1:ilo-1 and i+1:n of WR and WI contain those +! eigenvalues which have been successfully computed. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8, TWO = 2.0E+0_r8 ) + REAL(r8) CONST + PARAMETER ( CONST = 1.5E+0_r8 ) + INTEGER NSMAX, LDS + PARAMETER ( NSMAX = 15, LDS = NSMAX ) +! .. +! .. Local Scalars .. + LOGICAL INITZ, WANTT, WANTZ + INTEGER I, I1, I2, IERR, II, ITEMP, ITN, ITS, J, K, L, & + MAXB, NH, NR, NS, NV + REAL(r8) ABSW, OVFL, SMLNUM, TAU, TEMP, TST1, ULP, UNFL +! .. +! .. Local Arrays .. + REAL(r8) S( LDS, NSMAX ), V( NSMAX+1 ), VV( NSMAX+1 ) +! .. +! .. Executable Statements .. +! +! Decode and test the input parameters +! + WANTT = LSAME( JOB, 'S' ) + INITZ = LSAME( COMPZ, 'I' ) + WANTZ = INITZ .OR. LSAME( COMPZ, 'V' ) +! + INFO = 0 + IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN + INFO = -1 + ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN + INFO = -4 + ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN + INFO = -5 + ELSE IF( LDH.LT.MAX( 1, N ) ) THEN + INFO = -7 + ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. LDZ.LT.MAX( 1, N ) ) THEN + INFO = -11 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SHSEQR', -INFO ) + RETURN + END IF +! +! Initialize Z, if necessary +! + IF( INITZ ) & + CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ ) +! +! Store the eigenvalues isolated by SGEBAL. +! + DO 10 I = 1, ILO - 1 + WR( I ) = H( I, I ) + WI( I ) = ZERO + 10 CONTINUE + DO 20 I = IHI + 1, N + WR( I ) = H( I, I ) + WI( I ) = ZERO + 20 CONTINUE +! +! Quick return if possible. +! + IF( N.EQ.0 ) & + RETURN + IF( ILO.EQ.IHI ) THEN + WR( ILO ) = H( ILO, ILO ) + WI( ILO ) = ZERO + RETURN + END IF +! +! Set rows and columns ILO to IHI to zero below the first +! subdiagonal. +! + DO 40 J = ILO, IHI - 2 + DO 30 I = J + 2, N + H( I, J ) = ZERO + 30 CONTINUE + 40 CONTINUE + NH = IHI - ILO + 1 +! +! Determine the order of the multi-shift QR algorithm to be used. +! + NS = ILAENV( 4, 'SHSEQR', JOB // COMPZ, N, ILO, IHI, -1 ) + MAXB = ILAENV( 8, 'SHSEQR', JOB // COMPZ, N, ILO, IHI, -1 ) + IF( NS.LE.2 .OR. NS.GT.NH .OR. MAXB.GE.NH ) THEN +! +! Use the standard double-shift algorithm +! + CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO, & + IHI, Z, LDZ, INFO ) + RETURN + END IF + MAXB = MAX( 3, MAXB ) + NS = MIN( NS, MAXB, NSMAX ) +! +! Now 2 < NS <= MAXB < NH. +! +! Set machine-dependent constants for the stopping criterion. +! If norm(H) <= sqrt(OVFL), overflow should not occur. +! + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( NH / ULP ) +! +! I1 and I2 are the indices of the first row and last column of H +! to which transformations must be applied. If eigenvalues only are +! being computed, I1 and I2 are set inside the main loop. +! + IF( WANTT ) THEN + I1 = 1 + I2 = N + END IF +! +! ITN is the total number of multiple-shift QR iterations allowed. +! + ITN = 30*NH +! +! The main loop begins here. I is the loop index and decreases from +! IHI to ILO in steps of at most MAXB. Each iteration of the loop +! works with the active submatrix in rows and columns L to I. +! Eigenvalues I+1 to IHI have already converged. Either L = ILO or +! H(L,L-1) is negligible so that the matrix splits. +! + I = IHI + 50 CONTINUE + L = ILO + IF( I.LT.ILO ) & + GO TO 170 +! +! Perform multiple-shift QR iterations on rows and columns ILO to I +! until a submatrix of order at most MAXB splits off at the bottom +! because a subdiagonal element has become negligible. +! + DO 150 ITS = 0, ITN +! +! Look for a single small subdiagonal element. +! + DO 60 K = I, L + 1, -1 + TST1 = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) ) + IF( TST1.EQ.ZERO ) & + TST1 = SLANHS( '1', I-L+1, H( L, L ), LDH, WORK ) + IF( ABS( H( K, K-1 ) ).LE.MAX( ULP*TST1, SMLNUM ) ) & + GO TO 70 + 60 CONTINUE + 70 CONTINUE + L = K + IF( L.GT.ILO ) THEN +! +! H(L,L-1) is negligible. +! + H( L, L-1 ) = ZERO + END IF +! +! Exit from loop if a submatrix of order <= MAXB has split off. +! + IF( L.GE.I-MAXB+1 ) & + GO TO 160 +! +! Now the active submatrix is in rows and columns L to I. If +! eigenvalues only are being computed, only the active submatrix +! need be transformed. +! + IF( .NOT.WANTT ) THEN + I1 = L + I2 = I + END IF +! + IF( ITS.EQ.20 .OR. ITS.EQ.30 ) THEN +! +! Exceptional shifts. +! + DO 80 II = I - NS + 1, I + WR( II ) = CONST*( ABS( H( II, II-1 ) )+ & + ABS( H( II, II ) ) ) + WI( II ) = ZERO + 80 CONTINUE + ELSE +! +! Use eigenvalues of trailing submatrix of order NS as shifts. +! + CALL SLACPY( 'Full', NS, NS, H( I-NS+1, I-NS+1 ), LDH, S, & + LDS ) + CALL SLAHQR( .FALSE., .FALSE., NS, 1, NS, S, LDS, & + WR( I-NS+1 ), WI( I-NS+1 ), 1, NS, Z, LDZ, & + IERR ) + IF( IERR.GT.0 ) THEN +! +! If SLAHQR failed to compute all NS eigenvalues, use the +! unconverged diagonal elements as the remaining shifts. +! + DO 90 II = 1, IERR + WR( I-NS+II ) = S( II, II ) + WI( I-NS+II ) = ZERO + 90 CONTINUE + END IF + END IF +! +! Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) +! where G is the Hessenberg submatrix H(L:I,L:I) and w is +! the vector of shifts (stored in WR and WI). The result is +! stored in the local array V. +! + V( 1 ) = ONE + DO 100 II = 2, NS + 1 + V( II ) = ZERO + 100 CONTINUE + NV = 1 + DO 120 J = I - NS + 1, I + IF( WI( J ).GE.ZERO ) THEN + IF( WI( J ).EQ.ZERO ) THEN +! +! real shift +! + CALL SCOPY( NV+1, V, 1, VV, 1 ) + CALL SGEMV( 'No transpose', NV+1, NV, ONE, H( L, L ), & + LDH, VV, 1, -WR( J ), V, 1 ) + NV = NV + 1 + ELSE IF( WI( J ).GT.ZERO ) THEN +! +! complex conjugate pair of shifts +! + CALL SCOPY( NV+1, V, 1, VV, 1 ) + CALL SGEMV( 'No transpose', NV+1, NV, ONE, H( L, L ), & + LDH, V, 1, -TWO*WR( J ), VV, 1 ) + ITEMP = ISAMAX( NV+1, VV, 1 ) + TEMP = ONE / MAX( ABS( VV( ITEMP ) ), SMLNUM ) + CALL SSCAL( NV+1, TEMP, VV, 1 ) + ABSW = SLAPY2( WR( J ), WI( J ) ) + TEMP = ( TEMP*ABSW )*ABSW + CALL SGEMV( 'No transpose', NV+2, NV+1, ONE, & + H( L, L ), LDH, VV, 1, TEMP, V, 1 ) + NV = NV + 2 + END IF +! +! Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero, +! reset it to the unit vector. +! + ITEMP = ISAMAX( NV, V, 1 ) + TEMP = ABS( V( ITEMP ) ) + IF( TEMP.EQ.ZERO ) THEN + V( 1 ) = ONE + DO 110 II = 2, NV + V( II ) = ZERO + 110 CONTINUE + ELSE + TEMP = MAX( TEMP, SMLNUM ) + CALL SSCAL( NV, ONE / TEMP, V, 1 ) + END IF + END IF + 120 CONTINUE +! +! Multiple-shift QR step +! + DO 140 K = L, I - 1 +! +! The first iteration of this loop determines a reflection G +! from the vector V and applies it from left and right to H, +! thus creating a nonzero bulge below the subdiagonal. +! +! Each subsequent iteration determines a reflection G to +! restore the Hessenberg form in the (K-1)th column, and thus +! chases the bulge one step toward the bottom of the active +! submatrix. NR is the order of G. +! + NR = MIN( NS+1, I-K+1 ) + IF( K.GT.L ) & + CALL SCOPY( NR, H( K, K-1 ), 1, V, 1 ) + CALL SLARFG( NR, V( 1 ), V( 2 ), 1, TAU ) + IF( K.GT.L ) THEN + H( K, K-1 ) = V( 1 ) + DO 130 II = K + 1, I + H( II, K-1 ) = ZERO + 130 CONTINUE + END IF + V( 1 ) = ONE +! +! Apply G from the left to transform the rows of the matrix in +! columns K to I2. +! + CALL SLARFX( 'Left', NR, I2-K+1, V, TAU, H( K, K ), LDH, & + WORK ) +! +! Apply G from the right to transform the columns of the +! matrix in rows I1 to min(K+NR,I). +! + CALL SLARFX( 'Right', MIN( K+NR, I )-I1+1, NR, V, TAU, & + H( I1, K ), LDH, WORK ) +! + IF( WANTZ ) THEN +! +! Accumulate transformations in the matrix Z +! + CALL SLARFX( 'Right', NH, NR, V, TAU, Z( ILO, K ), LDZ, & + WORK ) + END IF + 140 CONTINUE +! + 150 CONTINUE +! +! Failure to converge in remaining number of iterations +! + INFO = I + RETURN +! + 160 CONTINUE +! +! A submatrix of order <= MAXB in rows and columns L to I has split +! off. Use the double-shift QR algorithm to handle it. +! + CALL SLAHQR( WANTT, WANTZ, N, L, I, H, LDH, WR, WI, ILO, IHI, Z, & + LDZ, INFO ) + IF( INFO.GT.0 ) & + RETURN +! +! Decrement number of remaining iterations, and return to start of +! the main loop with a new value of I. +! + ITN = ITN - ITS + I = L - 1 + GO TO 50 +! + 170 CONTINUE + RETURN +! +! End of SHSEQR +! + END SUBROUTINE SHSEQR + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLABAD( SMALL, LARGE ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + REAL(r8) LARGE, SMALL +! .. +! +! Purpose +! ======= +! +! SLABAD takes as input the values computed by SLAMCH for underflow and +! overflow, and returns the square root of each of these values if the +! log of LARGE is sufficiently large. This subroutine is intended to +! identify machines with a large exponent range, such as the Crays, and +! redefine the underflow and overflow limits to be the square roots of +! the values computed by SLAMCH. This subroutine is needed because +! SLAMCH does not compensate for poor arithmetic in the upper half of +! the exponent range, as is found on a Cray. +! +! Arguments +! ========= +! +! SMALL (input/output) REAL +! On entry, the underflow threshold as computed by SLAMCH. +! On exit, if LOG10(LARGE) is sufficiently large, the square +! root of SMALL, otherwise unchanged. +! +! LARGE (input/output) REAL +! On entry, the overflow threshold as computed by SLAMCH. +! On exit, if LOG10(LARGE) is sufficiently large, the square +! root of LARGE, otherwise unchanged. +! +! ===================================================================== +! +! .. +! .. Executable Statements .. +! +! If it looks like we're on a Cray, take the square root of +! SMALL and LARGE to avoid overflow and underflow problems. +! + IF( LOG10( LARGE ).GT.2000._r8 ) THEN + SMALL = SQRT( SMALL ) + LARGE = SQRT( LARGE ) + END IF +! + RETURN +! +! End of SLABAD +! + END SUBROUTINE SLABAD + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER UPLO + INTEGER LDA, LDB, M, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), B( LDB, * ) +! .. +! +! Purpose +! ======= +! +! SLACPY copies all or part of a two-dimensional matrix A to another +! matrix B. +! +! Arguments +! ========= +! +! UPLO (input) CHARACTER*1 +! Specifies the part of the matrix A to be copied to B. +! = 'U': Upper triangular part +! = 'L': Lower triangular part +! Otherwise: All of the matrix A +! +! M (input) INTEGER +! The number of rows of the matrix A. M >= 0. +! +! N (input) INTEGER +! The number of columns of the matrix A. N >= 0. +! +! A (input) REAL array, dimension (LDA,N) +! The m by n matrix A. If UPLO = 'U', only the upper triangle +! or trapezoid is accessed; if UPLO = 'L', only the lower +! triangle or trapezoid is accessed. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,M). +! +! B (output) REAL array, dimension (LDB,N) +! On exit, B = A in the locations specified by UPLO. +! +! LDB (input) INTEGER +! The leading dimension of the array B. LDB >= max(1,M). +! +! ===================================================================== +! +! .. Local Scalars .. + INTEGER I, J +! .. +! .. Executable Statements .. +! + IF( LSAME( UPLO, 'U' ) ) THEN + DO 20 J = 1, N + DO 10 I = 1, MIN( J, M ) + B( I, J ) = A( I, J ) + 10 CONTINUE + 20 CONTINUE + ELSE IF( LSAME( UPLO, 'L' ) ) THEN + DO 40 J = 1, N + DO 30 I = J, M + B( I, J ) = A( I, J ) + 30 CONTINUE + 40 CONTINUE + ELSE + DO 60 J = 1, N + DO 50 I = 1, M + B( I, J ) = A( I, J ) + 50 CONTINUE + 60 CONTINUE + END IF + RETURN +! +! End of SLACPY +! + END SUBROUTINE SLACPY + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLADIV( A, B, C, D, P, Q ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + REAL(r8) A, B, C, D, P, Q +! .. +! +! Purpose +! ======= +! +! SLADIV performs complex division in real arithmetic +! +! a + i*b +! p + i*q = --------- +! c + i*d +! +! The algorithm is due to Robert L. Smith and can be found +! in D. Knuth, The art of Computer Programming, Vol.2, p.195 +! +! Arguments +! ========= +! +! A (input) REAL +! B (input) REAL +! C (input) REAL +! D (input) REAL +! The scalars a, b, c, and d in the above expression. +! +! P (output) REAL +! Q (output) REAL +! The scalars p and q in the above expression. +! +! ===================================================================== +! +! .. Local Scalars .. + REAL(r8) E, F +! .. +! .. Executable Statements .. +! + IF( ABS( D ).LT.ABS( C ) ) THEN + E = D / C + F = C + D*E + P = ( A+B*E ) / F + Q = ( B-A*E ) / F + ELSE + E = C / D + F = D + C*E + P = ( B+A*E ) / F + Q = ( -A+B*E ) / F + END IF +! + RETURN +! +! End of SLADIV +! + END SUBROUTINE SLADIV + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, & + ILOZ, IHIZ, Z, LDZ, INFO ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + LOGICAL WANTT, WANTZ + INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N +! .. +! .. Array Arguments .. + REAL(r8) H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * ) +! .. +! +! Purpose +! ======= +! +! SLAHQR is an auxiliary routine called by SHSEQR to update the +! eigenvalues and Schur decomposition already computed by SHSEQR, by +! dealing with the Hessenberg submatrix in rows and columns ILO to IHI. +! +! Arguments +! ========= +! +! WANTT (input) LOGICAL +! = .TRUE. : the full Schur form T is required; +! = .FALSE.: only eigenvalues are required. +! +! WANTZ (input) LOGICAL +! = .TRUE. : the matrix of Schur vectors Z is required; +! = .FALSE.: Schur vectors are not required. +! +! N (input) INTEGER +! The order of the matrix H. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! It is assumed that H is already upper quasi-triangular in +! rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless +! ILO = 1). SLAHQR works primarily with the Hessenberg +! submatrix in rows and columns ILO to IHI, but applies +! transformations to all of H if WANTT is .TRUE.. +! 1 <= ILO <= max(1,IHI); IHI <= N. +! +! H (input/output) REAL array, dimension (LDH,N) +! On entry, the upper Hessenberg matrix H. +! On exit, if WANTT is .TRUE., H is upper quasi-triangular in +! rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in +! standard form. If WANTT is .FALSE., the contents of H are +! unspecified on exit. +! +! LDH (input) INTEGER +! The leading dimension of the array H. LDH >= max(1,N). +! +! WR (output) REAL array, dimension (N) +! WI (output) REAL array, dimension (N) +! The real and imaginary parts, respectively, of the computed +! eigenvalues ILO to IHI are stored in the corresponding +! elements of WR and WI. If two eigenvalues are computed as a +! complex conjugate pair, they are stored in consecutive +! elements of WR and WI, say the i-th and (i+1)th, with +! WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the +! eigenvalues are stored in the same order as on the diagonal +! of the Schur form returned in H, with WR(i) = H(i,i), and, if +! H(i:i+1,i:i+1) is a 2-by-2 diagonal block, +! WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). +! +! ILOZ (input) INTEGER +! IHIZ (input) INTEGER +! Specify the rows of Z to which transformations must be +! applied if WANTZ is .TRUE.. +! 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. +! +! Z (input/output) REAL array, dimension (LDZ,N) +! If WANTZ is .TRUE., on entry Z must contain the current +! matrix Z of transformations accumulated by SHSEQR, and on +! exit Z has been updated; transformations are applied only to +! the submatrix Z(ILOZ:IHIZ,ILO:IHI). +! If WANTZ is .FALSE., Z is not referenced. +! +! LDZ (input) INTEGER +! The leading dimension of the array Z. LDZ >= max(1,N). +! +! INFO (output) INTEGER +! = 0: successful exit +! > 0: SLAHQR failed to compute all the eigenvalues ILO to IHI +! in a total of 30*(IHI-ILO+1) iterations; if INFO = i, +! elements i+1:ihi of WR and WI contain those eigenvalues +! which have been successfully computed. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) + REAL(r8) DAT1, DAT2 + PARAMETER ( DAT1 = 0.75E+0_r8, DAT2 = -0.4375E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, I1, I2, ITN, ITS, J, K, L, M, NH, NR, NZ + REAL(r8) CS, H00, H10, H11, H12, H21, H22, H33, H33S, & + H43H34, H44, H44S, OVFL, S, SMLNUM, SN, SUM, & + T1, T2, T3, TST1, ULP, UNFL, V1, V2, V3 +! .. +! .. Local Arrays .. + REAL(r8) V( 3 ), WORK( 1 ) +! .. +! .. Executable Statements .. +! + INFO = 0 +! +! Quick return if possible +! + IF( N.EQ.0 ) & + RETURN + IF( ILO.EQ.IHI ) THEN + WR( ILO ) = H( ILO, ILO ) + WI( ILO ) = ZERO + RETURN + END IF +! + NH = IHI - ILO + 1 + NZ = IHIZ - ILOZ + 1 +! +! Set machine-dependent constants for the stopping criterion. +! If norm(H) <= sqrt(OVFL), overflow should not occur. +! + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( NH / ULP ) +! +! I1 and I2 are the indices of the first row and last column of H +! to which transformations must be applied. If eigenvalues only are +! being computed, I1 and I2 are set inside the main loop. +! + IF( WANTT ) THEN + I1 = 1 + I2 = N + END IF +! +! ITN is the total number of QR iterations allowed. +! + ITN = 30*NH +! +! The main loop begins here. I is the loop index and decreases from +! IHI to ILO in steps of 1 or 2. Each iteration of the loop works +! with the active submatrix in rows and columns L to I. +! Eigenvalues I+1 to IHI have already converged. Either L = ILO or +! H(L,L-1) is negligible so that the matrix splits. +! + I = IHI + 10 CONTINUE + L = ILO + IF( I.LT.ILO ) & + GO TO 150 +! +! Perform QR iterations on rows and columns ILO to I until a +! submatrix of order 1 or 2 splits off at the bottom because a +! subdiagonal element has become negligible. +! + DO 130 ITS = 0, ITN +! +! Look for a single small subdiagonal element. +! + DO 20 K = I, L + 1, -1 + TST1 = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) ) + IF( TST1.EQ.ZERO ) & + TST1 = SLANHS( '1', I-L+1, H( L, L ), LDH, WORK ) + IF( ABS( H( K, K-1 ) ).LE.MAX( ULP*TST1, SMLNUM ) ) & + GO TO 30 + 20 CONTINUE + 30 CONTINUE + L = K + IF( L.GT.ILO ) THEN +! +! H(L,L-1) is negligible +! + H( L, L-1 ) = ZERO + END IF +! +! Exit from loop if a submatrix of order 1 or 2 has split off. +! + IF( L.GE.I-1 ) & + GO TO 140 +! +! Now the active submatrix is in rows and columns L to I. If +! eigenvalues only are being computed, only the active submatrix +! need be transformed. +! + IF( .NOT.WANTT ) THEN + I1 = L + I2 = I + END IF +! + IF( ITS.EQ.10 .OR. ITS.EQ.20 ) THEN +! +! Exceptional shift. +! + S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) ) + H44 = DAT1*S + H33 = H44 + H43H34 = DAT2*S*S + ELSE +! +! Prepare to use Wilkinson's double shift +! + H44 = H( I, I ) + H33 = H( I-1, I-1 ) + H43H34 = H( I, I-1 )*H( I-1, I ) + END IF +! +! Look for two consecutive small subdiagonal elements. +! + DO 40 M = I - 2, L, -1 +! +! Determine the effect of starting the double-shift QR +! iteration at row M, and see if this would make H(M,M-1) +! negligible. +! + H11 = H( M, M ) + H22 = H( M+1, M+1 ) + H21 = H( M+1, M ) + H12 = H( M, M+1 ) + H44S = H44 - H11 + H33S = H33 - H11 + V1 = ( H33S*H44S-H43H34 ) / H21 + H12 + V2 = H22 - H11 - H33S - H44S + V3 = H( M+2, M+1 ) + S = ABS( V1 ) + ABS( V2 ) + ABS( V3 ) + V1 = V1 / S + V2 = V2 / S + V3 = V3 / S + V( 1 ) = V1 + V( 2 ) = V2 + V( 3 ) = V3 + IF( M.EQ.L ) & + GO TO 50 + H00 = H( M-1, M-1 ) + H10 = H( M, M-1 ) + TST1 = ABS( V1 )*( ABS( H00 )+ABS( H11 )+ABS( H22 ) ) + IF( ABS( H10 )*( ABS( V2 )+ABS( V3 ) ).LE.ULP*TST1 ) & + GO TO 50 + 40 CONTINUE + 50 CONTINUE +! +! Double-shift QR step +! + DO 120 K = M, I - 1 +! +! The first iteration of this loop determines a reflection G +! from the vector V and applies it from left and right to H, +! thus creating a nonzero bulge below the subdiagonal. +! +! Each subsequent iteration determines a reflection G to +! restore the Hessenberg form in the (K-1)th column, and thus +! chases the bulge one step toward the bottom of the active +! submatrix. NR is the order of G. +! + NR = MIN( 3, I-K+1 ) + IF( K.GT.M ) & + CALL SCOPY( NR, H( K, K-1 ), 1, V, 1 ) + CALL SLARFG( NR, V( 1 ), V( 2 ), 1, T1 ) + IF( K.GT.M ) THEN + H( K, K-1 ) = V( 1 ) + H( K+1, K-1 ) = ZERO + IF( K.LT.I-1 ) & + H( K+2, K-1 ) = ZERO + ELSE IF( M.GT.L ) THEN + H( K, K-1 ) = -H( K, K-1 ) + END IF + V2 = V( 2 ) + T2 = T1*V2 + IF( NR.EQ.3 ) THEN + V3 = V( 3 ) + T3 = T1*V3 +! +! Apply G from the left to transform the rows of the matrix +! in columns K to I2. +! + DO 60 J = K, I2 + SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J ) + H( K, J ) = H( K, J ) - SUM*T1 + H( K+1, J ) = H( K+1, J ) - SUM*T2 + H( K+2, J ) = H( K+2, J ) - SUM*T3 + 60 CONTINUE +! +! Apply G from the right to transform the columns of the +! matrix in rows I1 to min(K+3,I). +! + DO 70 J = I1, MIN( K+3, I ) + SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 ) + H( J, K ) = H( J, K ) - SUM*T1 + H( J, K+1 ) = H( J, K+1 ) - SUM*T2 + H( J, K+2 ) = H( J, K+2 ) - SUM*T3 + 70 CONTINUE +! + IF( WANTZ ) THEN +! +! Accumulate transformations in the matrix Z +! + DO 80 J = ILOZ, IHIZ + SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 ) + Z( J, K ) = Z( J, K ) - SUM*T1 + Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2 + Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3 + 80 CONTINUE + END IF + ELSE IF( NR.EQ.2 ) THEN +! +! Apply G from the left to transform the rows of the matrix +! in columns K to I2. +! + DO 90 J = K, I2 + SUM = H( K, J ) + V2*H( K+1, J ) + H( K, J ) = H( K, J ) - SUM*T1 + H( K+1, J ) = H( K+1, J ) - SUM*T2 + 90 CONTINUE +! +! Apply G from the right to transform the columns of the +! matrix in rows I1 to min(K+3,I). +! + DO 100 J = I1, I + SUM = H( J, K ) + V2*H( J, K+1 ) + H( J, K ) = H( J, K ) - SUM*T1 + H( J, K+1 ) = H( J, K+1 ) - SUM*T2 + 100 CONTINUE +! + IF( WANTZ ) THEN +! +! Accumulate transformations in the matrix Z +! + DO 110 J = ILOZ, IHIZ + SUM = Z( J, K ) + V2*Z( J, K+1 ) + Z( J, K ) = Z( J, K ) - SUM*T1 + Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2 + 110 CONTINUE + END IF + END IF + 120 CONTINUE +! + 130 CONTINUE +! +! Failure to converge in remaining number of iterations +! + INFO = I + RETURN +! + 140 CONTINUE +! + IF( L.EQ.I ) THEN +! +! H(I,I-1) is negligible: one eigenvalue has converged. +! + WR( I ) = H( I, I ) + WI( I ) = ZERO + ELSE IF( L.EQ.I-1 ) THEN +! +! H(I-1,I-2) is negligible: a pair of eigenvalues have converged. +! +! Transform the 2-by-2 submatrix to standard Schur form, +! and compute and store the eigenvalues. +! + CALL SLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ), & + H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ), & + CS, SN ) +! + IF( WANTT ) THEN +! +! Apply the transformation to the rest of H. +! + IF( I2.GT.I ) & + CALL SROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH, & + CS, SN ) + CALL SROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN ) + END IF + IF( WANTZ ) THEN +! +! Apply the transformation to Z. +! + CALL SROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN ) + END IF + END IF +! +! Decrement number of remaining iterations, and return to start of +! the main loop with new value of I. +! + ITN = ITN - ITS + I = L - 1 + GO TO 10 +! + 150 CONTINUE + RETURN +! +! End of SLAHQR +! + END SUBROUTINE SLAHQR + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + INTEGER K, LDA, LDT, LDY, N, NB +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), T( LDT, NB ), TAU( NB ), & + Y( LDY, NB ) +! .. +! +! Purpose +! ======= +! +! SLAHRD reduces the first NB columns of a real general n-by-(n-k+1) +! matrix A so that elements below the k-th subdiagonal are zero. The +! reduction is performed by an orthogonal similarity transformation +! Q' * A * Q. The routine returns the matrices V and T which determine +! Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T. +! +! This is an auxiliary routine called by SGEHRD. +! +! Arguments +! ========= +! +! N (input) INTEGER +! The order of the matrix A. +! +! K (input) INTEGER +! The offset for the reduction. Elements below the k-th +! subdiagonal in the first NB columns are reduced to zero. +! +! NB (input) INTEGER +! The number of columns to be reduced. +! +! A (input/output) REAL array, dimension (LDA,N-K+1) +! On entry, the n-by-(n-k+1) general matrix A. +! On exit, the elements on and above the k-th subdiagonal in +! the first NB columns are overwritten with the corresponding +! elements of the reduced matrix; the elements below the k-th +! subdiagonal, with the array TAU, represent the matrix Q as a +! product of elementary reflectors. The other columns of A are +! unchanged. See Further Details. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! TAU (output) REAL array, dimension (NB) +! The scalar factors of the elementary reflectors. See Further +! Details. +! +! T (output) REAL array, dimension (NB,NB) +! The upper triangular matrix T. +! +! LDT (input) INTEGER +! The leading dimension of the array T. LDT >= NB. +! +! Y (output) REAL array, dimension (LDY,NB) +! The n-by-nb matrix Y. +! +! LDY (input) INTEGER +! The leading dimension of the array Y. LDY >= N. +! +! Further Details +! =============== +! +! The matrix Q is represented as a product of nb elementary reflectors +! +! Q = H(1) H(2) . . . H(nb). +! +! Each H(i) has the form +! +! H(i) = I - tau * v * v' +! +! where tau is a real scalar, and v is a real vector with +! v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in +! A(i+k+1:n,i), and tau in TAU(i). +! +! The elements of the vectors v together form the (n-k+1)-by-nb matrix +! V which is needed, with T and Y, to apply the transformation to the +! unreduced part of the matrix, using an update of the form: +! A := (I - V*T*V') * (A - Y*V'). +! +! The contents of A on exit are illustrated by the following example +! with n = 7, k = 3 and nb = 2: +! +! ( a h a a a ) +! ( a h a a a ) +! ( a h a a a ) +! ( h h a a a ) +! ( v1 h a a a ) +! ( v1 v2 a a a ) +! ( v1 v2 a a a ) +! +! where a denotes an element of the original matrix A, h denotes a +! modified element of the upper Hessenberg matrix H, and vi denotes an +! element of the vector defining H(i). +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I + REAL(r8) EI +! .. +! .. Executable Statements .. +! +! Quick return if possible +! + IF( N.LE.1 ) & + RETURN +! + DO 10 I = 1, NB + IF( I.GT.1 ) THEN +! +! Update A(1:n,i) +! +! Compute i-th column of A - Y * V' +! + CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, & + A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 ) +! +! Apply I - V * T' * V' to this column (call it b) from the +! left, using the last column of T as workspace +! +! Let V = ( V1 ) and b = ( b1 ) (first I-1 rows) +! ( V2 ) ( b2 ) +! +! where V1 is unit lower triangular +! +! w := V1' * b1 +! + CALL SCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) + CALL STRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ), & + LDA, T( 1, NB ), 1 ) +! +! w := w + V2'*b2 +! + CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), & + LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 ) +! +! w := T'*w +! + CALL STRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT, & + T( 1, NB ), 1 ) +! +! b2 := b2 - V2*w +! + CALL SGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), & + LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) +! +! b1 := b1 - V1*w +! + CALL STRMV( 'Lower', 'No transpose', 'Unit', I-1, & + A( K+1, 1 ), LDA, T( 1, NB ), 1 ) + CALL SAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 ) +! + A( K+I-1, I-1 ) = EI + END IF +! +! Generate the elementary reflector H(i) to annihilate +! A(k+i+1:n,i) +! + CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, & + TAU( I ) ) + EI = A( K+I, I ) + A( K+I, I ) = ONE +! +! Compute Y(1:n,i) +! + CALL SGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, & + A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA, & + A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) + CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, & + ONE, Y( 1, I ), 1 ) + CALL SSCAL( N, TAU( I ), Y( 1, I ), 1 ) +! +! Compute T(1:i,i) +! + CALL SSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, & + T( 1, I ), 1 ) + T( I, I ) = TAU( I ) +! + 10 CONTINUE + A( K+NB, NB ) = EI +! + RETURN +! +! End of SLAHRD +! + END SUBROUTINE SLAHRD + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B, & + LDB, WR, WI, X, LDX, SCALE, XNORM, INFO ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + LOGICAL LTRANS + INTEGER INFO, LDA, LDB, LDX, NA, NW + REAL(r8) CA, D1, D2, SCALE, SMIN, WI, WR, XNORM +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), B( LDB, * ), X( LDX, * ) +! .. +! +! Purpose +! ======= +! +! SLALN2 solves a system of the form (ca A - w D ) X = s B +! or (ca A' - w D) X = s B with possible scaling ("s") and +! perturbation of A. (A' means A-transpose.) +! +! A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA +! real diagonal matrix, w is a real or complex value, and X and B are +! NA x 1 matrices -- real if w is real, complex if w is complex. NA +! may be 1 or 2. +! +! If w is complex, X and B are represented as NA x 2 matrices, +! the first column of each being the real part and the second +! being the imaginary part. +! +! "s" is a scaling factor (.LE. 1), computed by SLALN2, which is +! so chosen that X can be computed without overflow. X is further +! scaled if necessary to assure that norm(ca A - w D)*norm(X) is less +! than overflow. +! +! If both singular values of (ca A - w D) are less than SMIN, +! SMIN*identity will be used instead of (ca A - w D). If only one +! singular value is less than SMIN, one element of (ca A - w D) will be +! perturbed enough to make the smallest singular value roughly SMIN. +! If both singular values are at least SMIN, (ca A - w D) will not be +! perturbed. In any case, the perturbation will be at most some small +! multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values +! are computed by infinity-norm approximations, and thus will only be +! correct to a factor of 2 or so. +! +! Note: all input quantities are assumed to be smaller than overflow +! by a reasonable factor. (See BIGNUM.) +! +! Arguments +! ========== +! +! LTRANS (input) LOGICAL +! =.TRUE.: A-transpose will be used. +! =.FALSE.: A will be used (not transposed.) +! +! NA (input) INTEGER +! The size of the matrix A. It may (only) be 1 or 2. +! +! NW (input) INTEGER +! 1 if "w" is real, 2 if "w" is complex. It may only be 1 +! or 2. +! +! SMIN (input) REAL +! The desired lower bound on the singular values of A. This +! should be a safe distance away from underflow or overflow, +! say, between (underflow/machine precision) and (machine +! precision * overflow ). (See BIGNUM and ULP.) +! +! CA (input) REAL +! The coefficient c, which A is multiplied by. +! +! A (input) REAL array, dimension (LDA,NA) +! The NA x NA matrix A. +! +! LDA (input) INTEGER +! The leading dimension of A. It must be at least NA. +! +! D1 (input) REAL +! The 1,1 element in the diagonal matrix D. +! +! D2 (input) REAL +! The 2,2 element in the diagonal matrix D. Not used if NW=1. +! +! B (input) REAL array, dimension (LDB,NW) +! The NA x NW matrix B (right-hand side). If NW=2 ("w" is +! complex), column 1 contains the real part of B and column 2 +! contains the imaginary part. +! +! LDB (input) INTEGER +! The leading dimension of B. It must be at least NA. +! +! WR (input) REAL +! The real part of the scalar "w". +! +! WI (input) REAL +! The imaginary part of the scalar "w". Not used if NW=1. +! +! X (output) REAL array, dimension (LDX,NW) +! The NA x NW matrix X (unknowns), as computed by SLALN2. +! If NW=2 ("w" is complex), on exit, column 1 will contain +! the real part of X and column 2 will contain the imaginary +! part. +! +! LDX (input) INTEGER +! The leading dimension of X. It must be at least NA. +! +! SCALE (output) REAL +! The scale factor that B must be multiplied by to insure +! that overflow does not occur when computing X. Thus, +! (ca A - w D) X will be SCALE*B, not B (ignoring +! perturbations of A.) It will be at most 1. +! +! XNORM (output) REAL +! The infinity-norm of X, when X is regarded as an NA x NW +! real matrix. +! +! INFO (output) INTEGER +! An error flag. It will be set to zero if no error occurs, +! a negative number if an argument is in error, or a positive +! number if ca A - w D had to be perturbed. +! The possible values are: +! = 0: No error occurred, and (ca A - w D) did not have to be +! perturbed. +! = 1: (ca A - w D) had to be perturbed to make its smallest +! (or only) singular value greater than SMIN. +! NOTE: In the interests of speed, this routine does not +! check the inputs for errors. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E0_r8, ONE = 1.0E0_r8 ) + REAL(r8) TWO + PARAMETER ( TWO = 2.0E0_r8 ) +! .. +! .. Local Scalars .. + INTEGER ICMAX, J + REAL(r8) BBND, BI1, BI2, BIGNUM, BNORM, BR1, BR2, CI21, & + CI22, CMAX, CNORM, CR21, CR22, CSI, CSR, LI21, & + LR21, SMINI, SMLNUM, TEMP, U22ABS, UI11, UI11R, & + UI12, UI12S, UI22, UR11, UR11R, UR12, UR12S, & + UR22, XI1, XI2, XR1, XR2 +! .. +! .. Local Arrays .. + LOGICAL CSWAP( 4 ), RSWAP( 4 ) + INTEGER IPIVOT( 4, 4 ) + REAL(r8) CI( 2, 2 ), CIV( 4 ), CR( 2, 2 ), CRV( 4 ) +! .. +! .. Equivalences .. + EQUIVALENCE ( CI( 1, 1 ), CIV( 1 ) ), & + ( CR( 1, 1 ), CRV( 1 ) ) +! .. +! .. Data statements .. + DATA CSWAP / .FALSE., .FALSE., .TRUE., .TRUE. / + DATA RSWAP / .FALSE., .TRUE., .FALSE., .TRUE. / + DATA IPIVOT / 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4, & + 3, 2, 1 / +! .. +! .. Executable Statements .. +! +! Compute BIGNUM +! + SMLNUM = TWO*SLAMCH( 'Safe minimum' ) + BIGNUM = ONE / SMLNUM + SMINI = MAX( SMIN, SMLNUM ) +! +! Don't check for input errors +! + INFO = 0 +! +! Standard Initializations +! + SCALE = ONE +! + IF( NA.EQ.1 ) THEN +! +! 1 x 1 (i.e., scalar) system C X = B +! + IF( NW.EQ.1 ) THEN +! +! Real 1x1 system. +! +! C = ca A - w D +! + CSR = CA*A( 1, 1 ) - WR*D1 + CNORM = ABS( CSR ) +! +! If | C | < SMINI, use C = SMINI +! + IF( CNORM.LT.SMINI ) THEN + CSR = SMINI + CNORM = SMINI + INFO = 1 + END IF +! +! Check scaling for X = B / C +! + BNORM = ABS( B( 1, 1 ) ) + IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN + IF( BNORM.GT.BIGNUM*CNORM ) & + SCALE = ONE / BNORM + END IF +! +! Compute X +! + X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / CSR + XNORM = ABS( X( 1, 1 ) ) + ELSE +! +! Complex 1x1 system (w is complex) +! +! C = ca A - w D +! + CSR = CA*A( 1, 1 ) - WR*D1 + CSI = -WI*D1 + CNORM = ABS( CSR ) + ABS( CSI ) +! +! If | C | < SMINI, use C = SMINI +! + IF( CNORM.LT.SMINI ) THEN + CSR = SMINI + CSI = ZERO + CNORM = SMINI + INFO = 1 + END IF +! +! Check scaling for X = B / C +! + BNORM = ABS( B( 1, 1 ) ) + ABS( B( 1, 2 ) ) + IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN + IF( BNORM.GT.BIGNUM*CNORM ) & + SCALE = ONE / BNORM + END IF +! +! Compute X +! + CALL SLADIV( SCALE*B( 1, 1 ), SCALE*B( 1, 2 ), CSR, CSI, & + X( 1, 1 ), X( 1, 2 ) ) + XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) ) + END IF +! + ELSE +! +! 2x2 System +! +! Compute the real part of C = ca A - w D (or ca A' - w D ) +! + CR( 1, 1 ) = CA*A( 1, 1 ) - WR*D1 + CR( 2, 2 ) = CA*A( 2, 2 ) - WR*D2 + IF( LTRANS ) THEN + CR( 1, 2 ) = CA*A( 2, 1 ) + CR( 2, 1 ) = CA*A( 1, 2 ) + ELSE + CR( 2, 1 ) = CA*A( 2, 1 ) + CR( 1, 2 ) = CA*A( 1, 2 ) + END IF +! + IF( NW.EQ.1 ) THEN +! +! Real 2x2 system (w is real) +! +! Find the largest element in C +! + CMAX = ZERO + ICMAX = 0 +! + DO 10 J = 1, 4 + IF( ABS( CRV( J ) ).GT.CMAX ) THEN + CMAX = ABS( CRV( J ) ) + ICMAX = J + END IF + 10 CONTINUE +! +! If norm(C) < SMINI, use SMINI*identity. +! + IF( CMAX.LT.SMINI ) THEN + BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 2, 1 ) ) ) + IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN + IF( BNORM.GT.BIGNUM*SMINI ) & + SCALE = ONE / BNORM + END IF + TEMP = SCALE / SMINI + X( 1, 1 ) = TEMP*B( 1, 1 ) + X( 2, 1 ) = TEMP*B( 2, 1 ) + XNORM = TEMP*BNORM + INFO = 1 + RETURN + END IF +! +! Gaussian elimination with complete pivoting. +! + UR11 = CRV( ICMAX ) + CR21 = CRV( IPIVOT( 2, ICMAX ) ) + UR12 = CRV( IPIVOT( 3, ICMAX ) ) + CR22 = CRV( IPIVOT( 4, ICMAX ) ) + UR11R = ONE / UR11 + LR21 = UR11R*CR21 + UR22 = CR22 - UR12*LR21 +! +! If smaller pivot < SMINI, use SMINI +! + IF( ABS( UR22 ).LT.SMINI ) THEN + UR22 = SMINI + INFO = 1 + END IF + IF( RSWAP( ICMAX ) ) THEN + BR1 = B( 2, 1 ) + BR2 = B( 1, 1 ) + ELSE + BR1 = B( 1, 1 ) + BR2 = B( 2, 1 ) + END IF + BR2 = BR2 - LR21*BR1 + BBND = MAX( ABS( BR1*( UR22*UR11R ) ), ABS( BR2 ) ) + IF( BBND.GT.ONE .AND. ABS( UR22 ).LT.ONE ) THEN + IF( BBND.GE.BIGNUM*ABS( UR22 ) ) & + SCALE = ONE / BBND + END IF +! + XR2 = ( BR2*SCALE ) / UR22 + XR1 = ( SCALE*BR1 )*UR11R - XR2*( UR11R*UR12 ) + IF( CSWAP( ICMAX ) ) THEN + X( 1, 1 ) = XR2 + X( 2, 1 ) = XR1 + ELSE + X( 1, 1 ) = XR1 + X( 2, 1 ) = XR2 + END IF + XNORM = MAX( ABS( XR1 ), ABS( XR2 ) ) +! +! Further scaling if norm(A) norm(X) > overflow +! + IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN + IF( XNORM.GT.BIGNUM / CMAX ) THEN + TEMP = CMAX / BIGNUM + X( 1, 1 ) = TEMP*X( 1, 1 ) + X( 2, 1 ) = TEMP*X( 2, 1 ) + XNORM = TEMP*XNORM + SCALE = TEMP*SCALE + END IF + END IF + ELSE +! +! Complex 2x2 system (w is complex) +! +! Find the largest element in C +! + CI( 1, 1 ) = -WI*D1 + CI( 2, 1 ) = ZERO + CI( 1, 2 ) = ZERO + CI( 2, 2 ) = -WI*D2 + CMAX = ZERO + ICMAX = 0 +! + DO 20 J = 1, 4 + IF( ABS( CRV( J ) )+ABS( CIV( J ) ).GT.CMAX ) THEN + CMAX = ABS( CRV( J ) ) + ABS( CIV( J ) ) + ICMAX = J + END IF + 20 CONTINUE +! +! If norm(C) < SMINI, use SMINI*identity. +! + IF( CMAX.LT.SMINI ) THEN + BNORM = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ), & + ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) ) + IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN + IF( BNORM.GT.BIGNUM*SMINI ) & + SCALE = ONE / BNORM + END IF + TEMP = SCALE / SMINI + X( 1, 1 ) = TEMP*B( 1, 1 ) + X( 2, 1 ) = TEMP*B( 2, 1 ) + X( 1, 2 ) = TEMP*B( 1, 2 ) + X( 2, 2 ) = TEMP*B( 2, 2 ) + XNORM = TEMP*BNORM + INFO = 1 + RETURN + END IF +! +! Gaussian elimination with complete pivoting. +! + UR11 = CRV( ICMAX ) + UI11 = CIV( ICMAX ) + CR21 = CRV( IPIVOT( 2, ICMAX ) ) + CI21 = CIV( IPIVOT( 2, ICMAX ) ) + UR12 = CRV( IPIVOT( 3, ICMAX ) ) + UI12 = CIV( IPIVOT( 3, ICMAX ) ) + CR22 = CRV( IPIVOT( 4, ICMAX ) ) + CI22 = CIV( IPIVOT( 4, ICMAX ) ) + IF( ICMAX.EQ.1 .OR. ICMAX.EQ.4 ) THEN +! +! Code when off-diagonals of pivoted C are real +! + IF( ABS( UR11 ).GT.ABS( UI11 ) ) THEN + TEMP = UI11 / UR11 + UR11R = ONE / ( UR11*( ONE+TEMP**2 ) ) + UI11R = -TEMP*UR11R + ELSE + TEMP = UR11 / UI11 + UI11R = -ONE / ( UI11*( ONE+TEMP**2 ) ) + UR11R = -TEMP*UI11R + END IF + LR21 = CR21*UR11R + LI21 = CR21*UI11R + UR12S = UR12*UR11R + UI12S = UR12*UI11R + UR22 = CR22 - UR12*LR21 + UI22 = CI22 - UR12*LI21 + ELSE +! +! Code when diagonals of pivoted C are real +! + UR11R = ONE / UR11 + UI11R = ZERO + LR21 = CR21*UR11R + LI21 = CI21*UR11R + UR12S = UR12*UR11R + UI12S = UI12*UR11R + UR22 = CR22 - UR12*LR21 + UI12*LI21 + UI22 = -UR12*LI21 - UI12*LR21 + END IF + U22ABS = ABS( UR22 ) + ABS( UI22 ) +! +! If smaller pivot < SMINI, use SMINI +! + IF( U22ABS.LT.SMINI ) THEN + UR22 = SMINI + UI22 = ZERO + INFO = 1 + END IF + IF( RSWAP( ICMAX ) ) THEN + BR2 = B( 1, 1 ) + BR1 = B( 2, 1 ) + BI2 = B( 1, 2 ) + BI1 = B( 2, 2 ) + ELSE + BR1 = B( 1, 1 ) + BR2 = B( 2, 1 ) + BI1 = B( 1, 2 ) + BI2 = B( 2, 2 ) + END IF + BR2 = BR2 - LR21*BR1 + LI21*BI1 + BI2 = BI2 - LI21*BR1 - LR21*BI1 + BBND = MAX( ( ABS( BR1 )+ABS( BI1 ) )* & + ( U22ABS*( ABS( UR11R )+ABS( UI11R ) ) ), & + ABS( BR2 )+ABS( BI2 ) ) + IF( BBND.GT.ONE .AND. U22ABS.LT.ONE ) THEN + IF( BBND.GE.BIGNUM*U22ABS ) THEN + SCALE = ONE / BBND + BR1 = SCALE*BR1 + BI1 = SCALE*BI1 + BR2 = SCALE*BR2 + BI2 = SCALE*BI2 + END IF + END IF +! + CALL SLADIV( BR2, BI2, UR22, UI22, XR2, XI2 ) + XR1 = UR11R*BR1 - UI11R*BI1 - UR12S*XR2 + UI12S*XI2 + XI1 = UI11R*BR1 + UR11R*BI1 - UI12S*XR2 - UR12S*XI2 + IF( CSWAP( ICMAX ) ) THEN + X( 1, 1 ) = XR2 + X( 2, 1 ) = XR1 + X( 1, 2 ) = XI2 + X( 2, 2 ) = XI1 + ELSE + X( 1, 1 ) = XR1 + X( 2, 1 ) = XR2 + X( 1, 2 ) = XI1 + X( 2, 2 ) = XI2 + END IF + XNORM = MAX( ABS( XR1 )+ABS( XI1 ), ABS( XR2 )+ABS( XI2 ) ) +! +! Further scaling if norm(A) norm(X) > overflow +! + IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN + IF( XNORM.GT.BIGNUM / CMAX ) THEN + TEMP = CMAX / BIGNUM + X( 1, 1 ) = TEMP*X( 1, 1 ) + X( 2, 1 ) = TEMP*X( 2, 1 ) + X( 1, 2 ) = TEMP*X( 1, 2 ) + X( 2, 2 ) = TEMP*X( 2, 2 ) + XNORM = TEMP*XNORM + SCALE = TEMP*SCALE + END IF + END IF + END IF + END IF +! + RETURN +! +! End of SLALN2 +! + END SUBROUTINE SLALN2 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SLANGE( NORM, M, N, A, LDA, WORK ) + + real(r8) slange +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + CHARACTER NORM + INTEGER LDA, M, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SLANGE returns the value of the one norm, or the Frobenius norm, or +! the infinity norm, or the element of largest absolute value of a +! real matrix A. +! +! Description +! =========== +! +! SLANGE returns the value +! +! SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' +! ( +! ( norm1(A), NORM = '1', 'O' or 'o' +! ( +! ( normI(A), NORM = 'I' or 'i' +! ( +! ( normF(A), NORM = 'F', 'f', 'E' or 'e' +! +! where norm1 denotes the one norm of a matrix (maximum column sum), +! normI denotes the infinity norm of a matrix (maximum row sum) and +! normF denotes the Frobenius norm of a matrix (square root of sum of +! squares). Note that max(abs(A(i,j))) is not a matrix norm. +! +! Arguments +! ========= +! +! NORM (input) CHARACTER*1 +! Specifies the value to be returned in SLANGE as described +! above. +! +! M (input) INTEGER +! The number of rows of the matrix A. M >= 0. When M = 0, +! SLANGE is set to zero. +! +! N (input) INTEGER +! The number of columns of the matrix A. N >= 0. When N = 0, +! SLANGE is set to zero. +! +! A (input) REAL array, dimension (LDA,N) +! The m by n matrix A. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(M,1). +! +! WORK (workspace) REAL array, dimension (LWORK), +! where LWORK >= M when NORM = 'I'; otherwise, WORK is not +! referenced. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, J + REAL(r8) SCALE, SUM, VALUE +! .. +! .. Executable Statements .. +! + IF( MIN( M, N ).EQ.0 ) THEN + VALUE = ZERO + ELSE IF( LSAME( NORM, 'M' ) ) THEN +! +! Find max(abs(A(i,j))). +! + VALUE = ZERO + DO 20 J = 1, N + DO 10 I = 1, M + VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + 10 CONTINUE + 20 CONTINUE + ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN +! +! Find norm1(A). +! + VALUE = ZERO + DO 40 J = 1, N + SUM = ZERO + DO 30 I = 1, M + SUM = SUM + ABS( A( I, J ) ) + 30 CONTINUE + VALUE = MAX( VALUE, SUM ) + 40 CONTINUE + ELSE IF( LSAME( NORM, 'I' ) ) THEN +! +! Find normI(A). +! + DO 50 I = 1, M + WORK( I ) = ZERO + 50 CONTINUE + DO 70 J = 1, N + DO 60 I = 1, M + WORK( I ) = WORK( I ) + ABS( A( I, J ) ) + 60 CONTINUE + 70 CONTINUE + VALUE = ZERO + DO 80 I = 1, M + VALUE = MAX( VALUE, WORK( I ) ) + 80 CONTINUE + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN +! +! Find normF(A). +! + SCALE = ZERO + SUM = ONE + DO 90 J = 1, N + CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM ) + 90 CONTINUE + VALUE = SCALE*SQRT( SUM ) + END IF +! + SLANGE = VALUE + RETURN +! +! End of SLANGE +! + END FUNCTION SLANGE + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SLANHS( NORM, N, A, LDA, WORK ) + + real(r8) slanhs + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + CHARACTER NORM + INTEGER LDA, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SLANHS returns the value of the one norm, or the Frobenius norm, or +! the infinity norm, or the element of largest absolute value of a +! Hessenberg matrix A. +! +! Description +! =========== +! +! SLANHS returns the value +! +! SLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' +! ( +! ( norm1(A), NORM = '1', 'O' or 'o' +! ( +! ( normI(A), NORM = 'I' or 'i' +! ( +! ( normF(A), NORM = 'F', 'f', 'E' or 'e' +! +! where norm1 denotes the one norm of a matrix (maximum column sum), +! normI denotes the infinity norm of a matrix (maximum row sum) and +! normF denotes the Frobenius norm of a matrix (square root of sum of +! squares). Note that max(abs(A(i,j))) is not a matrix norm. +! +! Arguments +! ========= +! +! NORM (input) CHARACTER*1 +! Specifies the value to be returned in SLANHS as described +! above. +! +! N (input) INTEGER +! The order of the matrix A. N >= 0. When N = 0, SLANHS is +! set to zero. +! +! A (input) REAL array, dimension (LDA,N) +! The n by n upper Hessenberg matrix A; the part of A below the +! first sub-diagonal is not referenced. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(N,1). +! +! WORK (workspace) REAL array, dimension (LWORK), +! where LWORK >= N when NORM = 'I'; otherwise, WORK is not +! referenced. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, J + REAL(r8) SCALE, SUM, VALUE +! .. +! .. Executable Statements .. +! + IF( N.EQ.0 ) THEN + VALUE = ZERO + ELSE IF( LSAME( NORM, 'M' ) ) THEN +! +! Find max(abs(A(i,j))). +! + VALUE = ZERO + DO 20 J = 1, N + DO 10 I = 1, MIN( N, J+1 ) + VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + 10 CONTINUE + 20 CONTINUE + ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN +! +! Find norm1(A). +! + VALUE = ZERO + DO 40 J = 1, N + SUM = ZERO + DO 30 I = 1, MIN( N, J+1 ) + SUM = SUM + ABS( A( I, J ) ) + 30 CONTINUE + VALUE = MAX( VALUE, SUM ) + 40 CONTINUE + ELSE IF( LSAME( NORM, 'I' ) ) THEN +! +! Find normI(A). +! + DO 50 I = 1, N + WORK( I ) = ZERO + 50 CONTINUE + DO 70 J = 1, N + DO 60 I = 1, MIN( N, J+1 ) + WORK( I ) = WORK( I ) + ABS( A( I, J ) ) + 60 CONTINUE + 70 CONTINUE + VALUE = ZERO + DO 80 I = 1, N + VALUE = MAX( VALUE, WORK( I ) ) + 80 CONTINUE + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN +! +! Find normF(A). +! + SCALE = ZERO + SUM = ONE + DO 90 J = 1, N + CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) + 90 CONTINUE + VALUE = SCALE*SQRT( SUM ) + END IF +! + SLANHS = VALUE + RETURN +! +! End of SLANHS +! + END FUNCTION SLANHS + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + REAL(r8) A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN +! .. +! +! Purpose +! ======= +! +! SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric +! matrix in standard form: +! +! [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] +! [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] +! +! where either +! 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or +! 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex +! conjugate eigenvalues. +! +! Arguments +! ========= +! +! A (input/output) REAL +! B (input/output) REAL +! C (input/output) REAL +! D (input/output) REAL +! On entry, the elements of the input matrix. +! On exit, they are overwritten by the elements of the +! standardised Schur form. +! +! RT1R (output) REAL +! RT1I (output) REAL +! RT2R (output) REAL +! RT2I (output) REAL +! The real and imaginary parts of the eigenvalues. If the +! eigenvalues are both real, abs(RT1R) >= abs(RT2R); if the +! eigenvalues are a complex conjugate pair, RT1I > 0. +! +! CS (output) REAL +! SN (output) REAL +! Parameters of the rotation matrix. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, HALF, ONE + PARAMETER ( ZERO = 0.0E+0_r8, HALF = 0.5E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + REAL(r8) AA, BB, CC, CS1, DD, P, SAB, SAC, SIGMA, SN1, & + TAU, TEMP +! .. +! .. Executable Statements .. +! +! Initialize CS and SN +! + CS = ONE + SN = ZERO +! + IF( C.EQ.ZERO ) THEN + GO TO 10 +! + ELSE IF( B.EQ.ZERO ) THEN +! +! Swap rows and columns +! + CS = ZERO + SN = ONE + TEMP = D + D = A + A = TEMP + B = -C + C = ZERO + GO TO 10 + ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE. & + SIGN( ONE, C ) ) THEN + GO TO 10 + ELSE +! +! Make diagonal elements equal +! + TEMP = A - D + P = HALF*TEMP + SIGMA = B + C + TAU = SLAPY2( SIGMA, TEMP ) + CS1 = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) ) + SN1 = -( P / ( TAU*CS1 ) )*SIGN( ONE, SIGMA ) +! +! Compute [ AA BB ] = [ A B ] [ CS1 -SN1 ] +! [ CC DD ] [ C D ] [ SN1 CS1 ] +! + AA = A*CS1 + B*SN1 + BB = -A*SN1 + B*CS1 + CC = C*CS1 + D*SN1 + DD = -C*SN1 + D*CS1 +! +! Compute [ A B ] = [ CS1 SN1 ] [ AA BB ] +! [ C D ] [-SN1 CS1 ] [ CC DD ] +! + A = AA*CS1 + CC*SN1 + B = BB*CS1 + DD*SN1 + C = -AA*SN1 + CC*CS1 + D = -BB*SN1 + DD*CS1 +! +! Accumulate transformation +! + TEMP = CS*CS1 - SN*SN1 + SN = CS*SN1 + SN*CS1 + CS = TEMP +! + TEMP = HALF*( A+D ) + A = TEMP + D = TEMP +! + IF( C.NE.ZERO ) THEN + IF ( B.NE.ZERO ) THEN + IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN +! +! Real eigenvalues: reduce to upper triangular form +! + SAB = SQRT( ABS( B ) ) + SAC = SQRT( ABS( C ) ) + P = SIGN( SAB*SAC, C ) + TAU = ONE / SQRT( ABS( B+C ) ) + A = TEMP + P + D = TEMP - P + B = B - C + C = ZERO + CS1 = SAB*TAU + SN1 = SAC*TAU + TEMP = CS*CS1 - SN*SN1 + SN = CS*SN1 + SN*CS1 + CS = TEMP + END IF + ELSE + B = -C + C = ZERO + TEMP = CS + CS = -SN + SN = TEMP + ENDIF + ENDIF + END IF +! + 10 CONTINUE +! +! Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). +! + RT1R = A + RT2R = D + IF( C.EQ.ZERO ) THEN + RT1I = ZERO + RT2I = ZERO + ELSE + RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) ) + RT2I = -RT1I + END IF + RETURN +! +! End of SLANV2 +! + END SUBROUTINE SLANV2 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SLAPY2( X, Y ) + + real(r8) slapy2 + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + REAL(r8) X, Y +! .. +! +! Purpose +! ======= +! +! SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary +! overflow. +! +! Arguments +! ========= +! +! X (input) REAL +! Y (input) REAL +! X and Y specify the values x and y. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E0_r8 ) + REAL(r8) ONE + PARAMETER ( ONE = 1.0E0_r8 ) +! .. +! .. Local Scalars .. + REAL(r8) W, XABS, YABS, Z +! .. +! .. Executable Statements .. +! + XABS = ABS( X ) + YABS = ABS( Y ) + W = MAX( XABS, YABS ) + Z = MIN( XABS, YABS ) + IF( Z.EQ.ZERO ) THEN + SLAPY2 = W + ELSE + SLAPY2 = W*SQRT( ONE+( Z / W )**2 ) + END IF + RETURN +! +! End of SLAPY2 +! + END FUNCTION SLAPY2 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + REAL(r8) TAU +! .. +! .. Array Arguments .. + REAL(r8) C( LDC, * ), V( * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SLARF applies a real elementary reflector H to a real m by n matrix +! C, from either the left or the right. H is represented in the form +! +! H = I - tau * v * v' +! +! where tau is a real scalar and v is a real vector. +! +! If tau = 0, then H is taken to be the unit matrix. +! +! Arguments +! ========= +! +! SIDE (input) CHARACTER*1 +! = 'L': form H * C +! = 'R': form C * H +! +! M (input) INTEGER +! The number of rows of the matrix C. +! +! N (input) INTEGER +! The number of columns of the matrix C. +! +! V (input) REAL array, dimension +! (1 + (M-1)*abs(INCV)) if SIDE = 'L' +! or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +! The vector v in the representation of H. V is not used if +! TAU = 0. +! +! INCV (input) INTEGER +! The increment between elements of v. INCV <> 0. +! +! TAU (input) REAL +! The value tau in the representation of H. +! +! C (input/output) REAL array, dimension (LDC,N) +! On entry, the m by n matrix C. +! On exit, C is overwritten by the matrix H * C if SIDE = 'L', +! or C * H if SIDE = 'R'. +! +! LDC (input) INTEGER +! The leading dimension of the array C. LDC >= max(1,M). +! +! WORK (workspace) REAL array, dimension +! (N) if SIDE = 'L' +! or (M) if SIDE = 'R' +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Executable Statements .. +! + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C +! + IF( TAU.NE.ZERO ) THEN +! +! w := C' * v +! + CALL SGEMV( 'Transpose', M, N, ONE, C, LDC, V, INCV, ZERO, & + WORK, 1 ) +! +! C := C - v * w' +! + CALL SGER( M, N, -TAU, V, INCV, WORK, 1, C, LDC ) + END IF + ELSE +! +! Form C * H +! + IF( TAU.NE.ZERO ) THEN +! +! w := C * v +! + CALL SGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV, & + ZERO, WORK, 1 ) +! +! C := C - w * v' +! + CALL SGER( M, N, -TAU, WORK, 1, V, INCV, C, LDC ) + END IF + END IF + RETURN +! +! End of SLARF +! + END SUBROUTINE SLARF + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, & + T, LDT, C, LDC, WORK, LDWORK ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER DIRECT, SIDE, STOREV, TRANS + INTEGER K, LDC, LDT, LDV, LDWORK, M, N +! .. +! .. Array Arguments .. + REAL(r8) C( LDC, * ), T( LDT, * ), V( LDV, * ), & + WORK( LDWORK, * ) +! .. +! +! Purpose +! ======= +! +! SLARFB applies a real block reflector H or its transpose H' to a +! real m by n matrix C, from either the left or the right. +! +! Arguments +! ========= +! +! SIDE (input) CHARACTER*1 +! = 'L': apply H or H' from the Left +! = 'R': apply H or H' from the Right +! +! TRANS (input) CHARACTER*1 +! = 'N': apply H (No transpose) +! = 'T': apply H' (Transpose) +! +! DIRECT (input) CHARACTER*1 +! Indicates how H is formed from a product of elementary +! reflectors +! = 'F': H = H(1) H(2) . . . H(k) (Forward) +! = 'B': H = H(k) . . . H(2) H(1) (Backward) +! +! STOREV (input) CHARACTER*1 +! Indicates how the vectors which define the elementary +! reflectors are stored: +! = 'C': Columnwise +! = 'R': Rowwise +! +! M (input) INTEGER +! The number of rows of the matrix C. +! +! N (input) INTEGER +! The number of columns of the matrix C. +! +! K (input) INTEGER +! The order of the matrix T (= the number of elementary +! reflectors whose product defines the block reflector). +! +! V (input) REAL array, dimension +! (LDV,K) if STOREV = 'C' +! (LDV,M) if STOREV = 'R' and SIDE = 'L' +! (LDV,N) if STOREV = 'R' and SIDE = 'R' +! The matrix V. See further details. +! +! LDV (input) INTEGER +! The leading dimension of the array V. +! If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); +! if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); +! if STOREV = 'R', LDV >= K. +! +! T (input) REAL array, dimension (LDT,K) +! The triangular k by k matrix T in the representation of the +! block reflector. +! +! LDT (input) INTEGER +! The leading dimension of the array T. LDT >= K. +! +! C (input/output) REAL array, dimension (LDC,N) +! On entry, the m by n matrix C. +! On exit, C is overwritten by H*C or H'*C or C*H or C*H'. +! +! LDC (input) INTEGER +! The leading dimension of the array C. LDA >= max(1,M). +! +! WORK (workspace) REAL array, dimension (LDWORK,K) +! +! LDWORK (input) INTEGER +! The leading dimension of the array WORK. +! If SIDE = 'L', LDWORK >= max(1,N); +! if SIDE = 'R', LDWORK >= max(1,M). +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE + PARAMETER ( ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + CHARACTER TRANST + INTEGER I, J +! .. +! .. Executable Statements .. +! +! Quick return if possible +! + IF( M.LE.0 .OR. N.LE.0 ) & + RETURN +! + IF( LSAME( TRANS, 'N' ) ) THEN + TRANST = 'T' + ELSE + TRANST = 'N' + END IF +! + IF( LSAME( STOREV, 'C' ) ) THEN +! + IF( LSAME( DIRECT, 'F' ) ) THEN +! +! Let V = ( V1 ) (first K rows) +! ( V2 ) +! where V1 is unit lower triangular. +! + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C or H' * C where C = ( C1 ) +! ( C2 ) +! +! W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) +! +! W := C1' +! + DO 10 J = 1, K + CALL SCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 ) + 10 CONTINUE +! +! W := W * V1 +! + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, & + K, ONE, V, LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +! +! W := W + C2'*V2 +! + CALL SGEMM( 'Transpose', 'No transpose', N, K, M-K, & + ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV, & + ONE, WORK, LDWORK ) + END IF +! +! W := W * T' or W * T +! + CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - V * W' +! + IF( M.GT.K ) THEN +! +! C2 := C2 - V2 * W' +! + CALL SGEMM( 'No transpose', 'Transpose', M-K, N, K, & + -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE, & + C( K+1, 1 ), LDC ) + END IF +! +! W := W * V1' +! + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, & + ONE, V, LDV, WORK, LDWORK ) +! +! C1 := C1 - W' +! + DO 30 J = 1, K + DO 20 I = 1, N + C( J, I ) = C( J, I ) - WORK( I, J ) + 20 CONTINUE + 30 CONTINUE +! + ELSE IF( LSAME( SIDE, 'R' ) ) THEN +! +! Form C * H or C * H' where C = ( C1 C2 ) +! +! W := C * V = (C1*V1 + C2*V2) (stored in WORK) +! +! W := C1 +! + DO 40 J = 1, K + CALL SCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 ) + 40 CONTINUE +! +! W := W * V1 +! + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, & + K, ONE, V, LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN +! +! W := W + C2 * V2 +! + CALL SGEMM( 'No transpose', 'No transpose', M, K, N-K, & + ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, & + ONE, WORK, LDWORK ) + END IF +! +! W := W * T or W * T' +! + CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - W * V' +! + IF( N.GT.K ) THEN +! +! C2 := C2 - W * V2' +! + CALL SGEMM( 'No transpose', 'Transpose', M, N-K, K, & + -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE, & + C( 1, K+1 ), LDC ) + END IF +! +! W := W * V1' +! + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, & + ONE, V, LDV, WORK, LDWORK ) +! +! C1 := C1 - W +! + DO 60 J = 1, K + DO 50 I = 1, M + C( I, J ) = C( I, J ) - WORK( I, J ) + 50 CONTINUE + 60 CONTINUE + END IF +! + ELSE +! +! Let V = ( V1 ) +! ( V2 ) (last K rows) +! where V2 is unit upper triangular. +! + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C or H' * C where C = ( C1 ) +! ( C2 ) +! +! W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) +! +! W := C2' +! + DO 70 J = 1, K + CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + 70 CONTINUE +! +! W := W * V2 +! + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, & + K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +! +! W := W + C1'*V1 +! + CALL SGEMM( 'Transpose', 'No transpose', N, K, M-K, & + ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) + END IF +! +! W := W * T' or W * T +! + CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - V * W' +! + IF( M.GT.K ) THEN +! +! C1 := C1 - V1 * W' +! + CALL SGEMM( 'No transpose', 'Transpose', M-K, N, K, & + -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC ) + END IF +! +! W := W * V2' +! + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, & + ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) +! +! C2 := C2 - W' +! + DO 90 J = 1, K + DO 80 I = 1, N + C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J ) + 80 CONTINUE + 90 CONTINUE +! + ELSE IF( LSAME( SIDE, 'R' ) ) THEN +! +! Form C * H or C * H' where C = ( C1 C2 ) +! +! W := C * V = (C1*V1 + C2*V2) (stored in WORK) +! +! W := C2 +! + DO 100 J = 1, K + CALL SCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) + 100 CONTINUE +! +! W := W * V2 +! + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, & + K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN +! +! W := W + C1 * V1 +! + CALL SGEMM( 'No transpose', 'No transpose', M, K, N-K, & + ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) + END IF +! +! W := W * T or W * T' +! + CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - W * V' +! + IF( N.GT.K ) THEN +! +! C1 := C1 - W * V1' +! + CALL SGEMM( 'No transpose', 'Transpose', M, N-K, K, & + -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) + END IF +! +! W := W * V2' +! + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, & + ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) +! +! C2 := C2 - W +! + DO 120 J = 1, K + DO 110 I = 1, M + C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J ) + 110 CONTINUE + 120 CONTINUE + END IF + END IF +! + ELSE IF( LSAME( STOREV, 'R' ) ) THEN +! + IF( LSAME( DIRECT, 'F' ) ) THEN +! +! Let V = ( V1 V2 ) (V1: first K columns) +! where V1 is unit upper triangular. +! + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C or H' * C where C = ( C1 ) +! ( C2 ) +! +! W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) +! +! W := C1' +! + DO 130 J = 1, K + CALL SCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 ) + 130 CONTINUE +! +! W := W * V1' +! + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, & + ONE, V, LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +! +! W := W + C2'*V2' +! + CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, & + C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE, & + WORK, LDWORK ) + END IF +! +! W := W * T' or W * T +! + CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - V' * W' +! + IF( M.GT.K ) THEN +! +! C2 := C2 - V2' * W' +! + CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, & + V( 1, K+1 ), LDV, WORK, LDWORK, ONE, & + C( K+1, 1 ), LDC ) + END IF +! +! W := W * V1 +! + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, & + K, ONE, V, LDV, WORK, LDWORK ) +! +! C1 := C1 - W' +! + DO 150 J = 1, K + DO 140 I = 1, N + C( J, I ) = C( J, I ) - WORK( I, J ) + 140 CONTINUE + 150 CONTINUE +! + ELSE IF( LSAME( SIDE, 'R' ) ) THEN +! +! Form C * H or C * H' where C = ( C1 C2 ) +! +! W := C * V' = (C1*V1' + C2*V2') (stored in WORK) +! +! W := C1 +! + DO 160 J = 1, K + CALL SCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 ) + 160 CONTINUE +! +! W := W * V1' +! + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, & + ONE, V, LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN +! +! W := W + C2 * V2' +! + CALL SGEMM( 'No transpose', 'Transpose', M, K, N-K, & + ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV, & + ONE, WORK, LDWORK ) + END IF +! +! W := W * T or W * T' +! + CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - W * V +! + IF( N.GT.K ) THEN +! +! C2 := C2 - W * V2 +! + CALL SGEMM( 'No transpose', 'No transpose', M, N-K, K, & + -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, & + C( 1, K+1 ), LDC ) + END IF +! +! W := W * V1 +! + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, & + K, ONE, V, LDV, WORK, LDWORK ) +! +! C1 := C1 - W +! + DO 180 J = 1, K + DO 170 I = 1, M + C( I, J ) = C( I, J ) - WORK( I, J ) + 170 CONTINUE + 180 CONTINUE +! + END IF +! + ELSE +! +! Let V = ( V1 V2 ) (V2: last K columns) +! where V2 is unit lower triangular. +! + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C or H' * C where C = ( C1 ) +! ( C2 ) +! +! W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) +! +! W := C2' +! + DO 190 J = 1, K + CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + 190 CONTINUE +! +! W := W * V2' +! + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, & + ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +! +! W := W + C1'*V1' +! + CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, & + C, LDC, V, LDV, ONE, WORK, LDWORK ) + END IF +! +! W := W * T' or W * T +! + CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - V' * W' +! + IF( M.GT.K ) THEN +! +! C1 := C1 - V1' * W' +! + CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, & + V, LDV, WORK, LDWORK, ONE, C, LDC ) + END IF +! +! W := W * V2 +! + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, & + K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) +! +! C2 := C2 - W' +! + DO 210 J = 1, K + DO 200 I = 1, N + C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J ) + 200 CONTINUE + 210 CONTINUE +! + ELSE IF( LSAME( SIDE, 'R' ) ) THEN +! +! Form C * H or C * H' where C = ( C1 C2 ) +! +! W := C * V' = (C1*V1' + C2*V2') (stored in WORK) +! +! W := C2 +! + DO 220 J = 1, K + CALL SCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) + 220 CONTINUE +! +! W := W * V2' +! + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, & + ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN +! +! W := W + C1 * V1' +! + CALL SGEMM( 'No transpose', 'Transpose', M, K, N-K, & + ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) + END IF +! +! W := W * T or W * T' +! + CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, & + ONE, T, LDT, WORK, LDWORK ) +! +! C := C - W * V +! + IF( N.GT.K ) THEN +! +! C1 := C1 - W * V1 +! + CALL SGEMM( 'No transpose', 'No transpose', M, N-K, K, & + -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) + END IF +! +! W := W * V2 +! + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, & + K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) +! +! C1 := C1 - W +! + DO 240 J = 1, K + DO 230 I = 1, M + C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J ) + 230 CONTINUE + 240 CONTINUE +! + END IF +! + END IF + END IF +! + RETURN +! +! End of SLARFB +! + END SUBROUTINE SLARFB + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + INTEGER INCX, N + REAL(r8) ALPHA, TAU +! .. +! .. Array Arguments .. + REAL(r8) X( * ) +! .. +! +! Purpose +! ======= +! +! SLARFG generates a real elementary reflector H of order n, such +! that +! +! H * ( alpha ) = ( beta ), H' * H = I. +! ( x ) ( 0 ) +! +! where alpha and beta are scalars, and x is an (n-1)-element real +! vector. H is represented in the form +! +! H = I - tau * ( 1 ) * ( 1 v' ) , +! ( v ) +! +! where tau is a real scalar and v is a real (n-1)-element +! vector. +! +! If the elements of x are all zero, then tau = 0 and H is taken to be +! the unit matrix. +! +! Otherwise 1 <= tau <= 2. +! +! Arguments +! ========= +! +! N (input) INTEGER +! The order of the elementary reflector. +! +! ALPHA (input/output) REAL +! On entry, the value alpha. +! On exit, it is overwritten with the value beta. +! +! X (input/output) REAL array, dimension +! (1+(N-2)*abs(INCX)) +! On entry, the vector x. +! On exit, it is overwritten with the vector v. +! +! INCX (input) INTEGER +! The increment between elements of X. INCX > 0. +! +! TAU (output) REAL +! The value tau. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER J, KNT + REAL(r8) BETA, RSAFMN, SAFMIN, XNORM +! .. +! .. Executable Statements .. +! + IF( N.LE.1 ) THEN + TAU = ZERO + RETURN + END IF +! + XNORM = SNRM2( N-1, X, INCX ) +! + IF( XNORM.EQ.ZERO ) THEN +! +! H = I +! + TAU = ZERO + ELSE +! +! general case +! + BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA ) + SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' ) + IF( ABS( BETA ).LT.SAFMIN ) THEN +! +! XNORM, BETA may be inaccurate; scale X and recompute them +! + RSAFMN = ONE / SAFMIN + KNT = 0 + 10 CONTINUE + KNT = KNT + 1 + CALL SSCAL( N-1, RSAFMN, X, INCX ) + BETA = BETA*RSAFMN + ALPHA = ALPHA*RSAFMN + IF( ABS( BETA ).LT.SAFMIN ) & + GO TO 10 +! +! New BETA is at most 1, at least SAFMIN +! + XNORM = SNRM2( N-1, X, INCX ) + BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA ) + TAU = ( BETA-ALPHA ) / BETA + CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX ) +! +! If ALPHA is subnormal, it may lose relative accuracy +! + ALPHA = BETA + DO 20 J = 1, KNT + ALPHA = ALPHA*SAFMIN + 20 CONTINUE + ELSE + TAU = ( BETA-ALPHA ) / BETA + CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX ) + ALPHA = BETA + END IF + END IF +! + RETURN +! +! End of SLARFG +! + END SUBROUTINE SLARFG + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N +! .. +! .. Array Arguments .. + REAL(r8) T( LDT, * ), TAU( * ), V( LDV, * ) +! .. +! +! Purpose +! ======= +! +! SLARFT forms the triangular factor T of a real block reflector H +! of order n, which is defined as a product of k elementary reflectors. +! +! If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; +! +! If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. +! +! If STOREV = 'C', the vector which defines the elementary reflector +! H(i) is stored in the i-th column of the array V, and +! +! H = I - V * T * V' +! +! If STOREV = 'R', the vector which defines the elementary reflector +! H(i) is stored in the i-th row of the array V, and +! +! H = I - V' * T * V +! +! Arguments +! ========= +! +! DIRECT (input) CHARACTER*1 +! Specifies the order in which the elementary reflectors are +! multiplied to form the block reflector: +! = 'F': H = H(1) H(2) . . . H(k) (Forward) +! = 'B': H = H(k) . . . H(2) H(1) (Backward) +! +! STOREV (input) CHARACTER*1 +! Specifies how the vectors which define the elementary +! reflectors are stored (see also Further Details): +! = 'C': columnwise +! = 'R': rowwise +! +! N (input) INTEGER +! The order of the block reflector H. N >= 0. +! +! K (input) INTEGER +! The order of the triangular factor T (= the number of +! elementary reflectors). K >= 1. +! +! V (input/output) REAL array, dimension +! (LDV,K) if STOREV = 'C' +! (LDV,N) if STOREV = 'R' +! The matrix V. See further details. +! +! LDV (input) INTEGER +! The leading dimension of the array V. +! If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. +! +! TAU (input) REAL array, dimension (K) +! TAU(i) must contain the scalar factor of the elementary +! reflector H(i). +! +! T (output) REAL array, dimension (LDT,K) +! The k by k triangular factor T of the block reflector. +! If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is +! lower triangular. The rest of the array is not used. +! +! LDT (input) INTEGER +! The leading dimension of the array T. LDT >= K. +! +! Further Details +! =============== +! +! The shape of the matrix V and the storage of the vectors which define +! the H(i) is best illustrated by the following example with n = 5 and +! k = 3. The elements equal to 1 are not stored; the corresponding +! array elements are modified but restored on exit. The rest of the +! array is not used. +! +! DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': +! +! V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) +! ( v1 1 ) ( 1 v2 v2 v2 ) +! ( v1 v2 1 ) ( 1 v3 v3 ) +! ( v1 v2 v3 ) +! ( v1 v2 v3 ) +! +! DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': +! +! V = ( v1 v2 v3 ) V = ( v1 v1 1 ) +! ( v1 v2 v3 ) ( v2 v2 v2 1 ) +! ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) +! ( 1 v3 ) +! ( 1 ) +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, J + REAL(r8) VII +! .. +! .. Executable Statements .. +! +! Quick return if possible +! + IF( N.EQ.0 ) & + RETURN +! + IF( LSAME( DIRECT, 'F' ) ) THEN + DO 20 I = 1, K + IF( TAU( I ).EQ.ZERO ) THEN +! +! H(i) = I +! + DO 10 J = 1, I + T( J, I ) = ZERO + 10 CONTINUE + ELSE +! +! general case +! + VII = V( I, I ) + V( I, I ) = ONE + IF( LSAME( STOREV, 'C' ) ) THEN +! +! T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) +! + CALL SGEMV( 'Transpose', N-I+1, I-1, -TAU( I ), & + V( I, 1 ), LDV, V( I, I ), 1, ZERO, & + T( 1, I ), 1 ) + ELSE +! +! T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' +! + CALL SGEMV( 'No transpose', I-1, N-I+1, -TAU( I ), & + V( 1, I ), LDV, V( I, I ), LDV, ZERO, & + T( 1, I ), 1 ) + END IF + V( I, I ) = VII +! +! T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) +! + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, & + LDT, T( 1, I ), 1 ) + T( I, I ) = TAU( I ) + END IF + 20 CONTINUE + ELSE + DO 40 I = K, 1, -1 + IF( TAU( I ).EQ.ZERO ) THEN +! +! H(i) = I +! + DO 30 J = I, K + T( J, I ) = ZERO + 30 CONTINUE + ELSE +! +! general case +! + IF( I.LT.K ) THEN + IF( LSAME( STOREV, 'C' ) ) THEN + VII = V( N-K+I, I ) + V( N-K+I, I ) = ONE +! +! T(i+1:k,i) := +! - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i) +! + CALL SGEMV( 'Transpose', N-K+I, K-I, -TAU( I ), & + V( 1, I+1 ), LDV, V( 1, I ), 1, ZERO, & + T( I+1, I ), 1 ) + V( N-K+I, I ) = VII + ELSE + VII = V( I, N-K+I ) + V( I, N-K+I ) = ONE +! +! T(i+1:k,i) := +! - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)' +! + CALL SGEMV( 'No transpose', K-I, N-K+I, -TAU( I ), & + V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO, & + T( I+1, I ), 1 ) + V( I, N-K+I ) = VII + END IF +! +! T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) +! + CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I, & + T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) + END IF + T( I, I ) = TAU( I ) + END IF + 40 CONTINUE + END IF + RETURN +! +! End of SLARFT +! + END SUBROUTINE SLARFT + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARFX( SIDE, M, N, V, TAU, C, LDC, WORK ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER SIDE + INTEGER LDC, M, N + REAL(r8) TAU +! .. +! .. Array Arguments .. + REAL(r8) C( LDC, * ), V( * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SLARFX applies a real elementary reflector H to a real m by n +! matrix C, from either the left or the right. H is represented in the +! form +! +! H = I - tau * v * v' +! +! where tau is a real scalar and v is a real vector. +! +! If tau = 0, then H is taken to be the unit matrix +! +! This version uses inline code if H has order < 11. +! +! Arguments +! ========= +! +! SIDE (input) CHARACTER*1 +! = 'L': form H * C +! = 'R': form C * H +! +! M (input) INTEGER +! The number of rows of the matrix C. +! +! N (input) INTEGER +! The number of columns of the matrix C. +! +! V (input) REAL array, dimension (M) if SIDE = 'L' +! or (N) if SIDE = 'R' +! The vector v in the representation of H. +! +! TAU (input) REAL +! The value tau in the representation of H. +! +! C (input/output) REAL array, dimension (LDC,N) +! On entry, the m by n matrix C. +! On exit, C is overwritten by the matrix H * C if SIDE = 'L', +! or C * H if SIDE = 'R'. +! +! LDC (input) INTEGER +! The leading dimension of the array C. LDA >= (1,M). +! +! WORK (workspace) REAL array, dimension +! (N) if SIDE = 'L' +! or (M) if SIDE = 'R' +! WORK is not referenced if H has order < 11. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER J + REAL(r8) SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9, & + V1, V10, V2, V3, V4, V5, V6, V7, V8, V9 +! .. +! .. Executable Statements .. +! + IF( TAU.EQ.ZERO ) & + RETURN + IF( LSAME( SIDE, 'L' ) ) THEN +! +! Form H * C, where H has order m. +! + GO TO ( 10, 30, 50, 70, 90, 110, 130, 150, & + 170, 190 )M +! +! Code for general M +! +! w := C'*v +! + CALL SGEMV( 'Transpose', M, N, ONE, C, LDC, V, 1, ZERO, WORK, & + 1 ) +! +! C := C - tau * v * w' +! + CALL SGER( M, N, -TAU, V, 1, WORK, 1, C, LDC ) + GO TO 410 + 10 CONTINUE +! +! Special code for 1 x 1 Householder +! + T1 = ONE - TAU*V( 1 )*V( 1 ) + DO 20 J = 1, N + C( 1, J ) = T1*C( 1, J ) + 20 CONTINUE + GO TO 410 + 30 CONTINUE +! +! Special code for 2 x 2 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + DO 40 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + 40 CONTINUE + GO TO 410 + 50 CONTINUE +! +! Special code for 3 x 3 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + DO 60 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + 60 CONTINUE + GO TO 410 + 70 CONTINUE +! +! Special code for 4 x 4 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + DO 80 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + 80 CONTINUE + GO TO 410 + 90 CONTINUE +! +! Special code for 5 x 5 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + DO 100 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + 100 CONTINUE + GO TO 410 + 110 CONTINUE +! +! Special code for 6 x 6 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + DO 120 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + C( 6, J ) = C( 6, J ) - SUM*T6 + 120 CONTINUE + GO TO 410 + 130 CONTINUE +! +! Special code for 7 x 7 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + DO 140 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) + & + V7*C( 7, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + C( 6, J ) = C( 6, J ) - SUM*T6 + C( 7, J ) = C( 7, J ) - SUM*T7 + 140 CONTINUE + GO TO 410 + 150 CONTINUE +! +! Special code for 8 x 8 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + DO 160 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) + & + V7*C( 7, J ) + V8*C( 8, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + C( 6, J ) = C( 6, J ) - SUM*T6 + C( 7, J ) = C( 7, J ) - SUM*T7 + C( 8, J ) = C( 8, J ) - SUM*T8 + 160 CONTINUE + GO TO 410 + 170 CONTINUE +! +! Special code for 9 x 9 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + V9 = V( 9 ) + T9 = TAU*V9 + DO 180 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) + & + V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + C( 6, J ) = C( 6, J ) - SUM*T6 + C( 7, J ) = C( 7, J ) - SUM*T7 + C( 8, J ) = C( 8, J ) - SUM*T8 + C( 9, J ) = C( 9, J ) - SUM*T9 + 180 CONTINUE + GO TO 410 + 190 CONTINUE +! +! Special code for 10 x 10 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + V9 = V( 9 ) + T9 = TAU*V9 + V10 = V( 10 ) + T10 = TAU*V10 + DO 200 J = 1, N + SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) + & + V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) + & + V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) + & + V10*C( 10, J ) + C( 1, J ) = C( 1, J ) - SUM*T1 + C( 2, J ) = C( 2, J ) - SUM*T2 + C( 3, J ) = C( 3, J ) - SUM*T3 + C( 4, J ) = C( 4, J ) - SUM*T4 + C( 5, J ) = C( 5, J ) - SUM*T5 + C( 6, J ) = C( 6, J ) - SUM*T6 + C( 7, J ) = C( 7, J ) - SUM*T7 + C( 8, J ) = C( 8, J ) - SUM*T8 + C( 9, J ) = C( 9, J ) - SUM*T9 + C( 10, J ) = C( 10, J ) - SUM*T10 + 200 CONTINUE + GO TO 410 + ELSE +! +! Form C * H, where H has order n. +! + GO TO ( 210, 230, 250, 270, 290, 310, 330, 350, & + 370, 390 )N +! +! Code for general N +! +! w := C * v +! + CALL SGEMV( 'No transpose', M, N, ONE, C, LDC, V, 1, ZERO, & + WORK, 1 ) +! +! C := C - tau * w * v' +! + CALL SGER( M, N, -TAU, WORK, 1, V, 1, C, LDC ) + GO TO 410 + 210 CONTINUE +! +! Special code for 1 x 1 Householder +! + T1 = ONE - TAU*V( 1 )*V( 1 ) + DO 220 J = 1, M + C( J, 1 ) = T1*C( J, 1 ) + 220 CONTINUE + GO TO 410 + 230 CONTINUE +! +! Special code for 2 x 2 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + DO 240 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + 240 CONTINUE + GO TO 410 + 250 CONTINUE +! +! Special code for 3 x 3 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + DO 260 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + 260 CONTINUE + GO TO 410 + 270 CONTINUE +! +! Special code for 4 x 4 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + DO 280 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + 280 CONTINUE + GO TO 410 + 290 CONTINUE +! +! Special code for 5 x 5 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + DO 300 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + 300 CONTINUE + GO TO 410 + 310 CONTINUE +! +! Special code for 6 x 6 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + DO 320 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + C( J, 6 ) = C( J, 6 ) - SUM*T6 + 320 CONTINUE + GO TO 410 + 330 CONTINUE +! +! Special code for 7 x 7 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + DO 340 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) + & + V7*C( J, 7 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + C( J, 6 ) = C( J, 6 ) - SUM*T6 + C( J, 7 ) = C( J, 7 ) - SUM*T7 + 340 CONTINUE + GO TO 410 + 350 CONTINUE +! +! Special code for 8 x 8 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + DO 360 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) + & + V7*C( J, 7 ) + V8*C( J, 8 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + C( J, 6 ) = C( J, 6 ) - SUM*T6 + C( J, 7 ) = C( J, 7 ) - SUM*T7 + C( J, 8 ) = C( J, 8 ) - SUM*T8 + 360 CONTINUE + GO TO 410 + 370 CONTINUE +! +! Special code for 9 x 9 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + V9 = V( 9 ) + T9 = TAU*V9 + DO 380 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) + & + V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + C( J, 6 ) = C( J, 6 ) - SUM*T6 + C( J, 7 ) = C( J, 7 ) - SUM*T7 + C( J, 8 ) = C( J, 8 ) - SUM*T8 + C( J, 9 ) = C( J, 9 ) - SUM*T9 + 380 CONTINUE + GO TO 410 + 390 CONTINUE +! +! Special code for 10 x 10 Householder +! + V1 = V( 1 ) + T1 = TAU*V1 + V2 = V( 2 ) + T2 = TAU*V2 + V3 = V( 3 ) + T3 = TAU*V3 + V4 = V( 4 ) + T4 = TAU*V4 + V5 = V( 5 ) + T5 = TAU*V5 + V6 = V( 6 ) + T6 = TAU*V6 + V7 = V( 7 ) + T7 = TAU*V7 + V8 = V( 8 ) + T8 = TAU*V8 + V9 = V( 9 ) + T9 = TAU*V9 + V10 = V( 10 ) + T10 = TAU*V10 + DO 400 J = 1, M + SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) + & + V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) + & + V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) + & + V10*C( J, 10 ) + C( J, 1 ) = C( J, 1 ) - SUM*T1 + C( J, 2 ) = C( J, 2 ) - SUM*T2 + C( J, 3 ) = C( J, 3 ) - SUM*T3 + C( J, 4 ) = C( J, 4 ) - SUM*T4 + C( J, 5 ) = C( J, 5 ) - SUM*T5 + C( J, 6 ) = C( J, 6 ) - SUM*T6 + C( J, 7 ) = C( J, 7 ) - SUM*T7 + C( J, 8 ) = C( J, 8 ) - SUM*T8 + C( J, 9 ) = C( J, 9 ) - SUM*T9 + C( J, 10 ) = C( J, 10 ) - SUM*T10 + 400 CONTINUE + GO TO 410 + END IF + 410 RETURN +! +! End of SLARFX +! + END SUBROUTINE SLARFX + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLARTG( F, G, CS, SN, R ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + REAL(r8) CS, F, G, R, SN +! .. +! +! Purpose +! ======= +! +! SLARTG generate a plane rotation so that +! +! [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. +! [ -SN CS ] [ G ] [ 0 ] +! +! This is a slower, more accurate version of the BLAS1 routine SROTG, +! with the following other differences: +! F and G are unchanged on return. +! If G=0, then CS=1 and SN=0. +! If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any +! floating point operations (saves work in SBDSQR when +! there are zeros on the diagonal). +! +! If F exceeds G in magnitude, CS will be positive. +! +! Arguments +! ========= +! +! F (input) REAL +! The first component of vector to be rotated. +! +! G (input) REAL +! The second component of vector to be rotated. +! +! CS (output) REAL +! The cosine of the rotation. +! +! SN (output) REAL +! The sine of the rotation. +! +! R (output) REAL +! The nonzero component of the rotated vector. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E0_r8 ) + REAL(r8) ONE + PARAMETER ( ONE = 1.0E0_r8 ) + REAL(r8) TWO + PARAMETER ( TWO = 2.0E0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL FIRST + INTEGER COUNT, I + REAL(r8) EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE +! .. +! .. Save statement .. + SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 +! .. +! .. Data statements .. + DATA FIRST / .TRUE. / +! .. +! .. Executable Statements .. +! + IF( FIRST ) THEN + FIRST = .FALSE. + SAFMIN = SLAMCH( 'S' ) + EPS = SLAMCH( 'E' ) + SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / & + LOG( SLAMCH( 'B' ) ) / TWO ) + SAFMX2 = ONE / SAFMN2 + END IF + IF( G.EQ.ZERO ) THEN + CS = ONE + SN = ZERO + R = F + ELSE IF( F.EQ.ZERO ) THEN + CS = ZERO + SN = ONE + R = G + ELSE + F1 = F + G1 = G + SCALE = MAX( ABS( F1 ), ABS( G1 ) ) + IF( SCALE.GE.SAFMX2 ) THEN + COUNT = 0 + 10 CONTINUE + COUNT = COUNT + 1 + F1 = F1*SAFMN2 + G1 = G1*SAFMN2 + SCALE = MAX( ABS( F1 ), ABS( G1 ) ) + IF( SCALE.GE.SAFMX2 ) & + GO TO 10 + R = SQRT( F1**2+G1**2 ) + CS = F1 / R + SN = G1 / R + DO 20 I = 1, COUNT + R = R*SAFMX2 + 20 CONTINUE + ELSE IF( SCALE.LE.SAFMN2 ) THEN + COUNT = 0 + 30 CONTINUE + COUNT = COUNT + 1 + F1 = F1*SAFMX2 + G1 = G1*SAFMX2 + SCALE = MAX( ABS( F1 ), ABS( G1 ) ) + IF( SCALE.LE.SAFMN2 ) & + GO TO 30 + R = SQRT( F1**2+G1**2 ) + CS = F1 / R + SN = G1 / R + DO 40 I = 1, COUNT + R = R*SAFMN2 + 40 CONTINUE + ELSE + R = SQRT( F1**2+G1**2 ) + CS = F1 / R + SN = G1 / R + END IF + IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN + CS = -CS + SN = -SN + R = -R + END IF + END IF + RETURN +! +! End of SLARTG +! + END SUBROUTINE SLARTG + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + CHARACTER TYPE + INTEGER INFO, KL, KU, LDA, M, N + REAL(r8) CFROM, CTO +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ) +! .. +! +! Purpose +! ======= +! +! SLASCL multiplies the M by N real matrix A by the real scalar +! CTO/CFROM. This is done without over/underflow as long as the final +! result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that +! A may be full, upper triangular, lower triangular, upper Hessenberg, +! or banded. +! +! Arguments +! ========= +! +! TYPE (input) CHARACTER*1 +! TYPE indices the storage type of the input matrix. +! = 'G': A is a full matrix. +! = 'L': A is a lower triangular matrix. +! = 'U': A is an upper triangular matrix. +! = 'H': A is an upper Hessenberg matrix. +! = 'B': A is a symmetric band matrix with lower bandwidth KL +! and upper bandwidth KU and with the only the lower +! half stored. +! = 'Q': A is a symmetric band matrix with lower bandwidth KL +! and upper bandwidth KU and with the only the upper +! half stored. +! = 'Z': A is a band matrix with lower bandwidth KL and upper +! bandwidth KU. +! +! KL (input) INTEGER +! The lower bandwidth of A. Referenced only if TYPE = 'B', +! 'Q' or 'Z'. +! +! KU (input) INTEGER +! The upper bandwidth of A. Referenced only if TYPE = 'B', +! 'Q' or 'Z'. +! +! CFROM (input) REAL +! CTO (input) REAL +! The matrix A is multiplied by CTO/CFROM. A(I,J) is computed +! without over/underflow if the final result CTO*A(I,J)/CFROM +! can be represented without over/underflow. CFROM must be +! nonzero. +! +! M (input) INTEGER +! The number of rows of the matrix A. M >= 0. +! +! N (input) INTEGER +! The number of columns of the matrix A. N >= 0. +! +! A (input/output) REAL array, dimension (LDA,M) +! The matrix to be multiplied by CTO/CFROM. See TYPE for the +! storage type. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,M). +! +! INFO (output) INTEGER +! 0 - successful exit +! <0 - if INFO = -i, the i-th argument had an illegal value. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E0_r8, ONE = 1.0E0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL DONE + INTEGER I, ITYPE, J, K1, K2, K3, K4 + REAL(r8) BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM +! .. +! .. Executable Statements .. +! +! Test the input arguments +! + INFO = 0 +! + IF( LSAME( TYPE, 'G' ) ) THEN + ITYPE = 0 + ELSE IF( LSAME( TYPE, 'L' ) ) THEN + ITYPE = 1 + ELSE IF( LSAME( TYPE, 'U' ) ) THEN + ITYPE = 2 + ELSE IF( LSAME( TYPE, 'H' ) ) THEN + ITYPE = 3 + ELSE IF( LSAME( TYPE, 'B' ) ) THEN + ITYPE = 4 + ELSE IF( LSAME( TYPE, 'Q' ) ) THEN + ITYPE = 5 + ELSE IF( LSAME( TYPE, 'Z' ) ) THEN + ITYPE = 6 + ELSE + ITYPE = -1 + END IF +! + IF( ITYPE.EQ.-1 ) THEN + INFO = -1 + ELSE IF( CFROM.EQ.ZERO ) THEN + INFO = -4 + ELSE IF( M.LT.0 ) THEN + INFO = -6 + ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR. & + ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN + INFO = -7 + ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN + INFO = -9 + ELSE IF( ITYPE.GE.4 ) THEN + IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN + INFO = -2 + ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR. & + ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) ) & + THEN + INFO = -3 + ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR. & + ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR. & + ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN + INFO = -9 + END IF + END IF +! + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SLASCL', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.EQ.0 .OR. M.EQ.0 ) & + RETURN +! +! Get machine parameters +! + SMLNUM = SLAMCH( 'S' ) + BIGNUM = ONE / SMLNUM +! + CFROMC = CFROM + CTOC = CTO +! + 10 CONTINUE + CFROM1 = CFROMC*SMLNUM + CTO1 = CTOC / BIGNUM + IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN + MUL = SMLNUM + DONE = .FALSE. + CFROMC = CFROM1 + ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN + MUL = BIGNUM + DONE = .FALSE. + CTOC = CTO1 + ELSE + MUL = CTOC / CFROMC + DONE = .TRUE. + END IF +! + IF( ITYPE.EQ.0 ) THEN +! +! Full matrix +! + DO 30 J = 1, N + DO 20 I = 1, M + A( I, J ) = A( I, J )*MUL + 20 CONTINUE + 30 CONTINUE +! + ELSE IF( ITYPE.EQ.1 ) THEN +! +! Lower triangular matrix +! + DO 50 J = 1, N + DO 40 I = J, M + A( I, J ) = A( I, J )*MUL + 40 CONTINUE + 50 CONTINUE +! + ELSE IF( ITYPE.EQ.2 ) THEN +! +! Upper triangular matrix +! + DO 70 J = 1, N + DO 60 I = 1, MIN( J, M ) + A( I, J ) = A( I, J )*MUL + 60 CONTINUE + 70 CONTINUE +! + ELSE IF( ITYPE.EQ.3 ) THEN +! +! Upper Hessenberg matrix +! + DO 90 J = 1, N + DO 80 I = 1, MIN( J+1, M ) + A( I, J ) = A( I, J )*MUL + 80 CONTINUE + 90 CONTINUE +! + ELSE IF( ITYPE.EQ.4 ) THEN +! +! Lower half of a symmetric band matrix +! + K3 = KL + 1 + K4 = N + 1 + DO 110 J = 1, N + DO 100 I = 1, MIN( K3, K4-J ) + A( I, J ) = A( I, J )*MUL + 100 CONTINUE + 110 CONTINUE +! + ELSE IF( ITYPE.EQ.5 ) THEN +! +! Upper half of a symmetric band matrix +! + K1 = KU + 2 + K3 = KU + 1 + DO 130 J = 1, N + DO 120 I = MAX( K1-J, 1 ), K3 + A( I, J ) = A( I, J )*MUL + 120 CONTINUE + 130 CONTINUE +! + ELSE IF( ITYPE.EQ.6 ) THEN +! +! Band matrix +! + K1 = KL + KU + 2 + K2 = KL + 1 + K3 = 2*KL + KU + 1 + K4 = KL + KU + 1 + M + DO 150 J = 1, N + DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) + A( I, J ) = A( I, J )*MUL + 140 CONTINUE + 150 CONTINUE +! + END IF +! + IF( .NOT.DONE ) & + GO TO 10 +! + RETURN +! +! End of SLASCL +! + END SUBROUTINE SLASCL + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + CHARACTER UPLO + INTEGER LDA, M, N + REAL(r8) ALPHA, BETA +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ) +! .. +! +! Purpose +! ======= +! +! SLASET initializes an m-by-n matrix A to BETA on the diagonal and +! ALPHA on the offdiagonals. +! +! Arguments +! ========= +! +! UPLO (input) CHARACTER*1 +! Specifies the part of the matrix A to be set. +! = 'U': Upper triangular part is set; the strictly lower +! triangular part of A is not changed. +! = 'L': Lower triangular part is set; the strictly upper +! triangular part of A is not changed. +! Otherwise: All of the matrix A is set. +! +! M (input) INTEGER +! The number of rows of the matrix A. M >= 0. +! +! N (input) INTEGER +! The number of columns of the matrix A. N >= 0. +! +! ALPHA (input) REAL +! The constant to which the offdiagonal elements are to be set. +! +! BETA (input) REAL +! The constant to which the diagonal elements are to be set. +! +! A (input/output) REAL array, dimension (LDA,N) +! On exit, the leading m-by-n submatrix of A is set as follows: +! +! if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, +! if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, +! otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, +! +! and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,M). +! +! ===================================================================== +! +! .. Local Scalars .. + INTEGER I, J +! .. +! .. Executable Statements .. +! + IF( LSAME( UPLO, 'U' ) ) THEN +! +! Set the strictly upper triangular or trapezoidal part of the +! array to ALPHA. +! + DO 20 J = 2, N + DO 10 I = 1, MIN( J-1, M ) + A( I, J ) = ALPHA + 10 CONTINUE + 20 CONTINUE +! + ELSE IF( LSAME( UPLO, 'L' ) ) THEN +! +! Set the strictly lower triangular or trapezoidal part of the +! array to ALPHA. +! + DO 40 J = 1, MIN( M, N ) + DO 30 I = J + 1, M + A( I, J ) = ALPHA + 30 CONTINUE + 40 CONTINUE +! + ELSE +! +! Set the leading m-by-n submatrix to ALPHA. +! + DO 60 J = 1, N + DO 50 I = 1, M + A( I, J ) = ALPHA + 50 CONTINUE + 60 CONTINUE + END IF +! +! Set the first min(M,N) diagonal elements to BETA. +! + DO 70 I = 1, MIN( M, N ) + A( I, I ) = BETA + 70 CONTINUE +! + RETURN +! +! End of SLASET +! + END SUBROUTINE SLASET + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + INTEGER INCX, N + REAL(r8) SCALE, SUMSQ +! .. +! .. Array Arguments .. + REAL(r8) X( * ) +! .. +! +! Purpose +! ======= +! +! SLASSQ returns the values scl and smsq such that +! +! ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, +! +! where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is +! assumed to be non-negative and scl returns the value +! +! scl = max( scale, abs( x( i ) ) ). +! +! scale and sumsq must be supplied in SCALE and SUMSQ and +! scl and smsq are overwritten on SCALE and SUMSQ respectively. +! +! The routine makes only one pass through the vector x. +! +! Arguments +! ========= +! +! N (input) INTEGER +! The number of elements to be used from the vector X. +! +! X (input) REAL +! The vector for which a scaled sum of squares is computed. +! x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. +! +! INCX (input) INTEGER +! The increment between successive values of the vector X. +! INCX > 0. +! +! SCALE (input/output) REAL +! On entry, the value scale in the equation above. +! On exit, SCALE is overwritten with scl , the scaling factor +! for the sum of squares. +! +! SUMSQ (input/output) REAL +! On entry, the value sumsq in the equation above. +! On exit, SUMSQ is overwritten with smsq , the basic sum of +! squares from which scl has been factored out. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER IX + REAL(r8) ABSXI +! .. +! .. Executable Statements .. +! + IF( N.GT.0 ) THEN + DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX + IF( X( IX ).NE.ZERO ) THEN + ABSXI = ABS( X( IX ) ) + IF( SCALE.LT.ABSXI ) THEN + SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2 + SCALE = ABSXI + ELSE + SUMSQ = SUMSQ + ( ABSXI / SCALE )**2 + END IF + END IF + 10 CONTINUE + END IF + RETURN +! +! End of SLASSQ +! + END SUBROUTINE SLASSQ + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! February 29, 1992 +! +! .. Scalar Arguments .. + INTEGER INFO, K, LDA, M, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), TAU( * ), WORK( * ) +! .. +! +! Purpose +! ======= +! +! SORG2R generates an m by n real matrix Q with orthonormal columns, +! which is defined as the first n columns of a product of k elementary +! reflectors of order m +! +! Q = H(1) H(2) . . . H(k) +! +! as returned by SGEQRF. +! +! Arguments +! ========= +! +! M (input) INTEGER +! The number of rows of the matrix Q. M >= 0. +! +! N (input) INTEGER +! The number of columns of the matrix Q. M >= N >= 0. +! +! K (input) INTEGER +! The number of elementary reflectors whose product defines the +! matrix Q. N >= K >= 0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the i-th column must contain the vector which +! defines the elementary reflector H(i), for i = 1,2,...,k, as +! returned by SGEQRF in the first k columns of its array +! argument A. +! On exit, the m-by-n matrix Q. +! +! LDA (input) INTEGER +! The first dimension of the array A. LDA >= max(1,M). +! +! TAU (input) REAL array, dimension (K) +! TAU(i) must contain the scalar factor of the elementary +! reflector H(i), as returned by SGEQRF. +! +! WORK (workspace) REAL array, dimension (N) +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument has an illegal value +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, J, L +! .. +! .. Executable Statements .. +! +! Test the input arguments +! + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( K.LT.0 .OR. K.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SORG2R', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.LE.0 ) & + RETURN +! +! Initialise columns k+1:n to columns of the unit matrix +! + DO 20 J = K + 1, N + DO 10 L = 1, M + A( L, J ) = ZERO + 10 CONTINUE + A( J, J ) = ONE + 20 CONTINUE +! + DO 40 I = K, 1, -1 +! +! Apply H(i) to A(i:m,i:n) from the left +! + IF( I.LT.N ) THEN + A( I, I ) = ONE + CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), & + A( I, I+1 ), LDA, WORK ) + END IF + IF( I.LT.M ) & + CALL SSCAL( M-I, -TAU( I ), A( I+1, I ), 1 ) + A( I, I ) = ONE - TAU( I ) +! +! Set A(1:i-1,i) to zero +! + DO 30 L = 1, I - 1 + A( L, I ) = ZERO + 30 CONTINUE + 40 CONTINUE + RETURN +! +! End of SORG2R +! + END SUBROUTINE SORG2R + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + INTEGER IHI, ILO, INFO, LDA, LWORK, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), TAU( * ), WORK( LWORK ) +! .. +! +! Purpose +! ======= +! +! SORGHR generates a real orthogonal matrix Q which is defined as the +! product of IHI-ILO elementary reflectors of order N, as returned by +! SGEHRD: +! +! Q = H(ilo) H(ilo+1) . . . H(ihi-1). +! +! Arguments +! ========= +! +! N (input) INTEGER +! The order of the matrix Q. N >= 0. +! +! ILO (input) INTEGER +! IHI (input) INTEGER +! ILO and IHI must have the same values as in the previous call +! of SGEHRD. Q is equal to the unit matrix except in the +! submatrix Q(ilo+1:ihi,ilo+1:ihi). +! 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the vectors which define the elementary reflectors, +! as returned by SGEHRD. +! On exit, the N-by-N orthogonal matrix Q. +! +! LDA (input) INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! TAU (input) REAL array, dimension (N-1) +! TAU(i) must contain the scalar factor of the elementary +! reflector H(i), as returned by SGEHRD. +! +! WORK (workspace/output) REAL array, dimension (LWORK) +! On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +! +! LWORK (input) INTEGER +! The dimension of the array WORK. LWORK >= IHI-ILO. +! For optimum performance LWORK >= (IHI-ILO)*NB, where NB is +! the optimal blocksize. +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, IINFO, J, NH +! .. +! .. Executable Statements .. +! +! Test the input arguments +! + INFO = 0 + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN + INFO = -2 + ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( LWORK.LT.MAX( 1, IHI-ILO ) ) THEN + INFO = -8 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SORGHR', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +! +! Shift the vectors which define the elementary reflectors one +! column to the right, and set the first ilo and the last n-ihi +! rows and columns to those of the unit matrix +! + DO 40 J = IHI, ILO + 1, -1 + DO 10 I = 1, J - 1 + A( I, J ) = ZERO + 10 CONTINUE + DO 20 I = J + 1, IHI + A( I, J ) = A( I, J-1 ) + 20 CONTINUE + DO 30 I = IHI + 1, N + A( I, J ) = ZERO + 30 CONTINUE + 40 CONTINUE + DO 60 J = 1, ILO + DO 50 I = 1, N + A( I, J ) = ZERO + 50 CONTINUE + A( J, J ) = ONE + 60 CONTINUE + DO 80 J = IHI + 1, N + DO 70 I = 1, N + A( I, J ) = ZERO + 70 CONTINUE + A( J, J ) = ONE + 80 CONTINUE +! + NH = IHI - ILO + IF( NH.GT.0 ) THEN +! +! Generate Q(ilo+1:ihi,ilo+1:ihi) +! + CALL SORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ), & + WORK, LWORK, IINFO ) + END IF + RETURN +! +! End of SORGHR +! + END SUBROUTINE SORGHR + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + INTEGER INFO, K, LDA, LWORK, M, N +! .. +! .. Array Arguments .. + REAL(r8) A( LDA, * ), TAU( * ), WORK( LWORK ) +! .. +! +! Purpose +! ======= +! +! SORGQR generates an M-by-N real matrix Q with orthonormal columns, +! which is defined as the first N columns of a product of K elementary +! reflectors of order M +! +! Q = H(1) H(2) . . . H(k) +! +! as returned by SGEQRF. +! +! Arguments +! ========= +! +! M (input) INTEGER +! The number of rows of the matrix Q. M >= 0. +! +! N (input) INTEGER +! The number of columns of the matrix Q. M >= N >= 0. +! +! K (input) INTEGER +! The number of elementary reflectors whose product defines the +! matrix Q. N >= K >= 0. +! +! A (input/output) REAL array, dimension (LDA,N) +! On entry, the i-th column must contain the vector which +! defines the elementary reflector H(i), for i = 1,2,...,k, as +! returned by SGEQRF in the first k columns of its array +! argument A. +! On exit, the M-by-N matrix Q. +! +! LDA (input) INTEGER +! The first dimension of the array A. LDA >= max(1,M). +! +! TAU (input) REAL array, dimension (K) +! TAU(i) must contain the scalar factor of the elementary +! reflector H(i), as returned by SGEQRF. +! +! WORK (workspace/output) REAL array, dimension (LWORK) +! On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +! +! LWORK (input) INTEGER +! The dimension of the array WORK. LWORK >= max(1,N). +! For optimum performance LWORK >= N*NB, where NB is the +! optimal blocksize. +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument has an illegal value +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB, & + NBMIN, NX +! .. +! .. Executable Statements .. +! +! Test the input arguments +! + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( K.LT.0 .OR. K.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN + INFO = -8 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SORGQR', -INFO ) + RETURN + END IF +! +! Quick return if possible +! + IF( N.LE.0 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +! +! Determine the block size. +! + NB = ILAENV( 1, 'SORGQR', ' ', M, N, K, -1 ) + NBMIN = 2 + NX = 0 + IWS = N + IF( NB.GT.1 .AND. NB.LT.K ) THEN +! +! Determine when to cross over from blocked to unblocked code. +! + NX = MAX( 0, ILAENV( 3, 'SORGQR', ' ', M, N, K, -1 ) ) + IF( NX.LT.K ) THEN +! +! Determine if workspace is large enough for blocked code. +! + LDWORK = N + IWS = LDWORK*NB + IF( LWORK.LT.IWS ) THEN +! +! Not enough workspace to use optimal NB: reduce NB and +! determine the minimum value of NB. +! + NB = LWORK / LDWORK + NBMIN = MAX( 2, ILAENV( 2, 'SORGQR', ' ', M, N, K, -1 ) ) + END IF + END IF + END IF +! + IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN +! +! Use blocked code after the last block. +! The first kk columns are handled by the block method. +! + KI = ( ( K-NX-1 ) / NB )*NB + KK = MIN( K, KI+NB ) +! +! Set A(1:kk,kk+1:n) to zero. +! + DO 20 J = KK + 1, N + DO 10 I = 1, KK + A( I, J ) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + KK = 0 + END IF +! +! Use unblocked code for the last or only block. +! + IF( KK.LT.N ) & + CALL SORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA, & + TAU( KK+1 ), WORK, IINFO ) +! + IF( KK.GT.0 ) THEN +! +! Use blocked code +! + DO 50 I = KI + 1, 1, -NB + IB = MIN( NB, K-I+1 ) + IF( I+IB.LE.N ) THEN +! +! Form the triangular factor of the block reflector +! H = H(i) H(i+1) . . . H(i+ib-1) +! + CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB, & + A( I, I ), LDA, TAU( I ), WORK, LDWORK ) +! +! Apply H to A(i:m,i+ib:n) from the left +! + CALL SLARFB( 'Left', 'No transpose', 'Forward', & + 'Columnwise', M-I+1, N-I-IB+1, IB, & + A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ), & + LDA, WORK( IB+1 ), LDWORK ) + END IF +! +! Apply H to rows i:m of current block +! + CALL SORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK, & + IINFO ) +! +! Set rows 1:i-1 of current block to zero +! + DO 40 J = I, I + IB - 1 + DO 30 L = 1, I - 1 + A( L, J ) = ZERO + 30 CONTINUE + 40 CONTINUE + 50 CONTINUE + END IF +! + WORK( 1 ) = IWS + RETURN +! +! End of SORGQR +! + END SUBROUTINE SORGQR + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, & + LDVR, MM, M, WORK, INFO ) + +! +! -- LAPACK routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, M, MM, N +! .. +! .. Array Arguments .. + LOGICAL SELECT( * ) + REAL(r8) T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), & + WORK( * ) +! .. +! +! Purpose +! ======= +! +! STREVC computes some or all of the right and/or left eigenvectors of +! a real upper quasi-triangular matrix T. +! +! The right eigenvector x and the left eigenvector y of T corresponding +! to an eigenvalue w are defined by: +! +! T*x = w*x, y'*T = w*y' +! +! where y' denotes the conjugate transpose of the vector y. +! +! If all eigenvectors are requested, the routine may either return the +! matrices X and/or Y of right or left eigenvectors of T, or the +! products Q*X and/or Q*Y, where Q is an input orthogonal +! matrix. If T was obtained from the real-Schur factorization of an +! original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of +! right or left eigenvectors of A. +! +! T must be in Schur canonical form (as returned by SHSEQR), that is, +! block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each +! 2-by-2 diagonal block has its diagonal elements equal and its +! off-diagonal elements of opposite sign. Corresponding to each 2-by-2 +! diagonal block is a complex conjugate pair of eigenvalues and +! eigenvectors; only one eigenvector of the pair is computed, namely +! the one corresponding to the eigenvalue with positive imaginary part. + +! +! Arguments +! ========= +! +! SIDE (input) CHARACTER*1 +! = 'R': compute right eigenvectors only; +! = 'L': compute left eigenvectors only; +! = 'B': compute both right and left eigenvectors. +! +! HOWMNY (input) CHARACTER*1 +! = 'A': compute all right and/or left eigenvectors; +! = 'B': compute all right and/or left eigenvectors, +! and backtransform them using the input matrices +! supplied in VR and/or VL; +! = 'S': compute selected right and/or left eigenvectors, +! specified by the logical array SELECT. +! +! SELECT (input/output) LOGICAL array, dimension (N) +! If HOWMNY = 'S', SELECT specifies the eigenvectors to be +! computed. +! If HOWMNY = 'A' or 'B', SELECT is not referenced. +! To select the real eigenvector corresponding to a real +! eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select +! the complex eigenvector corresponding to a complex conjugate +! pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be +! set to .TRUE.; then on exit SELECT(j) is .TRUE. and +! SELECT(j+1) is .FALSE.. +! +! N (input) INTEGER +! The order of the matrix T. N >= 0. +! +! T (input) REAL array, dimension (LDT,N) +! The upper quasi-triangular matrix T in Schur canonical form. +! +! LDT (input) INTEGER +! The leading dimension of the array T. LDT >= max(1,N). +! +! VL (input/output) REAL array, dimension (LDVL,MM) +! On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +! contain an N-by-N matrix Q (usually the orthogonal matrix Q +! of Schur vectors returned by SHSEQR). +! On exit, if SIDE = 'L' or 'B', VL contains: +! if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +! if HOWMNY = 'B', the matrix Q*Y; +! if HOWMNY = 'S', the left eigenvectors of T specified by +! SELECT, stored consecutively in the columns +! of VL, in the same order as their +! eigenvalues. +! A complex eigenvector corresponding to a complex eigenvalue +! is stored in two consecutive columns, the first holding the +! real part, and the second the imaginary part. +! If SIDE = 'R', VL is not referenced. +! +! LDVL (input) INTEGER +! The leading dimension of the array VL. LDVL >= max(1,N) if +! SIDE = 'L' or 'B'; LDVL >= 1 otherwise. +! +! VR (input/output) REAL array, dimension (LDVR,MM) +! On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +! contain an N-by-N matrix Q (usually the orthogonal matrix Q +! of Schur vectors returned by SHSEQR). +! On exit, if SIDE = 'R' or 'B', VR contains: +! if HOWMNY = 'A', the matrix X of right eigenvectors of T; +! if HOWMNY = 'B', the matrix Q*X; +! if HOWMNY = 'S', the right eigenvectors of T specified by +! SELECT, stored consecutively in the columns +! of VR, in the same order as their +! eigenvalues. +! A complex eigenvector corresponding to a complex eigenvalue +! is stored in two consecutive columns, the first holding the +! real part and the second the imaginary part. +! If SIDE = 'L', VR is not referenced. +! +! LDVR (input) INTEGER +! The leading dimension of the array VR. LDVR >= max(1,N) if +! SIDE = 'R' or 'B'; LDVR >= 1 otherwise. +! +! MM (input) INTEGER +! The number of columns in the arrays VL and/or VR. MM >= M. +! +! M (output) INTEGER +! The number of columns in the arrays VL and/or VR actually +! used to store the eigenvectors. +! If HOWMNY = 'A' or 'B', M is set to N. +! Each selected real eigenvector occupies one column and each +! selected complex eigenvector occupies two columns. +! +! WORK (workspace) REAL array, dimension (3*N) +! +! INFO (output) INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value +! +! Further Details +! =============== +! +! The algorithm used in this program is basically backward (forward) +! substitution, with scaling to make the the code robust against +! possible overflow. +! +! Each eigenvector is normalized so that the element of largest +! magnitude has magnitude 1; here the magnitude of a complex number +! (x,y) is taken to be |x| + |y|. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E+0_r8, ONE = 1.0E+0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, OVER, PAIR, RIGHTV, SOMEV + INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, N2 + REAL(r8) BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE, & + SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR, & + XNORM +! .. +! .. Local Arrays .. + REAL(r8) X( 2, 2 ) +! .. +! .. Executable Statements .. +! +! Decode and test the input parameters +! + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +! + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' ) + SOMEV = LSAME( HOWMNY, 'S' ) +! + INFO = 0 + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE +! +! Set M to the number of columns required to store the selected +! eigenvectors, standardize the array SELECT if necessary, and +! test MM. +! + IF( SOMEV ) THEN + M = 0 + PAIR = .FALSE. + DO 10 J = 1, N + IF( PAIR ) THEN + PAIR = .FALSE. + SELECT( J ) = .FALSE. + ELSE + IF( J.LT.N ) THEN + IF( T( J+1, J ).EQ.ZERO ) THEN + IF( SELECT( J ) ) & + M = M + 1 + ELSE + PAIR = .TRUE. + IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN + SELECT( J ) = .TRUE. + M = M + 2 + END IF + END IF + ELSE + IF( SELECT( N ) ) & + M = M + 1 + END IF + END IF + 10 CONTINUE + ELSE + M = N + END IF +! + IF( MM.LT.M ) THEN + INFO = -11 + END IF + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'STREVC', -INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( N.EQ.0 ) & + RETURN +! +! Set the constants to control overflow. +! + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) + BIGNUM = ( ONE-ULP ) / SMLNUM +! +! Compute 1-norm of each column of strictly upper triangular +! part of T to control overflow in triangular solver. +! + WORK( 1 ) = ZERO + DO 30 J = 2, N + WORK( J ) = ZERO + DO 20 I = 1, J - 1 + WORK( J ) = WORK( J ) + ABS( T( I, J ) ) + 20 CONTINUE + 30 CONTINUE +! +! Index IP is used to specify the real or complex eigenvalue: +! IP = 0, real eigenvalue, +! 1, first of conjugate complex pair: (wr,wi) +! -1, second of conjugate complex pair: (wr,wi) +! + N2 = 2*N +! + IF( RIGHTV ) THEN +! +! Compute right eigenvectors. +! + IP = 0 + IS = M + DO 140 KI = N, 1, -1 +! + IF( IP.EQ.1 ) & + GO TO 130 + IF( KI.EQ.1 ) & + GO TO 40 + IF( T( KI, KI-1 ).EQ.ZERO ) & + GO TO 40 + IP = -1 +! + 40 CONTINUE + IF( SOMEV ) THEN + IF( IP.EQ.0 ) THEN + IF( .NOT.SELECT( KI ) ) & + GO TO 130 + ELSE + IF( .NOT.SELECT( KI-1 ) ) & + GO TO 130 + END IF + END IF +! +! Compute the KI-th eigenvalue (WR,WI). +! + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) & + WI = SQRT( ABS( T( KI, KI-1 ) ) )* & + SQRT( ABS( T( KI-1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +! + IF( IP.EQ.0 ) THEN +! +! Real right eigenvector +! + WORK( KI+N ) = ONE +! +! Form right-hand side +! + DO 50 K = 1, KI - 1 + WORK( K+N ) = -T( K, KI ) + 50 CONTINUE +! +! Solve the upper quasi-triangular system: +! (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK. +! + JNXT = KI - 1 + DO 60 J = KI - 1, 1, -1 + IF( J.GT.JNXT ) & + GO TO 60 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +! + IF( J1.EQ.J2 ) THEN +! +! 1-by-1 diagonal block +! + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, & + ZERO, X, 2, SCALE, XNORM, IERR ) +! +! Scale X(1,1) to avoid overflow when updating +! the right-hand side. +! + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) & + CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 ) + WORK( J+N ) = X( 1, 1 ) +! +! Update right-hand side +! + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, & + WORK( 1+N ), 1 ) +! + ELSE +! +! 2-by-2 diagonal block +! + CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, & + T( J-1, J-1 ), LDT, ONE, ONE, & + WORK( J-1+N ), N, WR, ZERO, X, 2, & + SCALE, XNORM, IERR ) +! +! Scale X(1,1) and X(2,1) to avoid overflow when +! updating the right-hand side. +! + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 2, 1 ) = X( 2, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) & + CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 ) + WORK( J-1+N ) = X( 1, 1 ) + WORK( J+N ) = X( 2, 1 ) +! +! Update right-hand side +! + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, & + WORK( 1+N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, & + WORK( 1+N ), 1 ) + END IF + 60 CONTINUE +! +! Copy the vector x or Q*x to VR and normalize. +! + IF( .NOT.OVER ) THEN + CALL SCOPY( KI, WORK( 1+N ), 1, VR( 1, IS ), 1 ) +! + II = ISAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / ABS( VR( II, IS ) ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +! + DO 70 K = KI + 1, N + VR( K, IS ) = ZERO + 70 CONTINUE + ELSE + IF( KI.GT.1 ) & + CALL SGEMV( 'N', N, KI-1, ONE, VR, LDVR, & + WORK( 1+N ), 1, WORK( KI+N ), & + VR( 1, KI ), 1 ) +! + II = ISAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / ABS( VR( II, KI ) ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) + END IF +! + ELSE +! +! Complex right eigenvector. +! +! Initial solve +! [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0. +! [ (T(KI,KI-1) T(KI,KI) ) ] +! + IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN + WORK( KI-1+N ) = ONE + WORK( KI+N2 ) = WI / T( KI-1, KI ) + ELSE + WORK( KI-1+N ) = -WI / T( KI, KI-1 ) + WORK( KI+N2 ) = ONE + END IF + WORK( KI+N ) = ZERO + WORK( KI-1+N2 ) = ZERO +! +! Form right-hand side +! + DO 80 K = 1, KI - 2 + WORK( K+N ) = -WORK( KI-1+N )*T( K, KI-1 ) + WORK( K+N2 ) = -WORK( KI+N2 )*T( K, KI ) + 80 CONTINUE +! +! Solve upper quasi-triangular system: +! (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2) +! + JNXT = KI - 2 + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) & + GO TO 90 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +! + IF( J1.EQ.J2 ) THEN +! +! 1-by-1 diagonal block +! + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, WI, & + X, 2, SCALE, XNORM, IERR ) +! +! Scale X(1,1) and X(1,2) to avoid overflow when +! updating the right-hand side. +! + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 1, 2 ) = X( 1, 2 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+N2 ), 1 ) + END IF + WORK( J+N ) = X( 1, 1 ) + WORK( J+N2 ) = X( 1, 2 ) +! +! Update the right-hand side +! + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, & + WORK( 1+N ), 1 ) + CALL SAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1, & + WORK( 1+N2 ), 1 ) +! + ELSE +! +! 2-by-2 diagonal block +! + CALL SLALN2( .FALSE., 2, 2, SMIN, ONE, & + T( J-1, J-1 ), LDT, ONE, ONE, & + WORK( J-1+N ), N, WR, WI, X, 2, SCALE, & + XNORM, IERR ) +! +! Scale X to avoid overflow when updating +! the right-hand side. +! + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + REC = ONE / XNORM + X( 1, 1 ) = X( 1, 1 )*REC + X( 1, 2 ) = X( 1, 2 )*REC + X( 2, 1 ) = X( 2, 1 )*REC + X( 2, 2 ) = X( 2, 2 )*REC + SCALE = SCALE*REC + END IF + END IF +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+N2 ), 1 ) + END IF + WORK( J-1+N ) = X( 1, 1 ) + WORK( J+N ) = X( 2, 1 ) + WORK( J-1+N2 ) = X( 1, 2 ) + WORK( J+N2 ) = X( 2, 2 ) +! +! Update the right-hand side +! + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, & + WORK( 1+N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, & + WORK( 1+N ), 1 ) + CALL SAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1, & + WORK( 1+N2 ), 1 ) + CALL SAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, & + WORK( 1+N2 ), 1 ) + END IF + 90 CONTINUE +! +! Copy the vector x or Q*x to VR and normalize. +! + IF( .NOT.OVER ) THEN + CALL SCOPY( KI, WORK( 1+N ), 1, VR( 1, IS-1 ), 1 ) + CALL SCOPY( KI, WORK( 1+N2 ), 1, VR( 1, IS ), 1 ) +! + EMAX = ZERO + DO 100 K = 1, KI + EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+ & + ABS( VR( K, IS ) ) ) + 100 CONTINUE +! + REMAX = ONE / EMAX + CALL SSCAL( KI, REMAX, VR( 1, IS-1 ), 1 ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +! + DO 110 K = KI + 1, N + VR( K, IS-1 ) = ZERO + VR( K, IS ) = ZERO + 110 CONTINUE +! + ELSE +! + IF( KI.GT.2 ) THEN + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, & + WORK( 1+N ), 1, WORK( KI-1+N ), & + VR( 1, KI-1 ), 1 ) + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, & + WORK( 1+N2 ), 1, WORK( KI+N2 ), & + VR( 1, KI ), 1 ) + ELSE + CALL SSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 ) + CALL SSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 ) + END IF +! + EMAX = ZERO + DO 120 K = 1, N + EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+ & + ABS( VR( K, KI ) ) ) + 120 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VR( 1, KI-1 ), 1 ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) + END IF + END IF +! + IS = IS - 1 + IF( IP.NE.0 ) & + IS = IS - 1 + 130 CONTINUE + IF( IP.EQ.1 ) & + IP = 0 + IF( IP.EQ.-1 ) & + IP = 1 + 140 CONTINUE + END IF +! + IF( LEFTV ) THEN +! +! Compute left eigenvectors. +! + IP = 0 + IS = 1 + DO 260 KI = 1, N +! + IF( IP.EQ.-1 ) & + GO TO 250 + IF( KI.EQ.N ) & + GO TO 150 + IF( T( KI+1, KI ).EQ.ZERO ) & + GO TO 150 + IP = 1 +! + 150 CONTINUE + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) & + GO TO 250 + END IF +! +! Compute the KI-th eigenvalue (WR,WI). +! + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) & + WI = SQRT( ABS( T( KI, KI+1 ) ) )* & + SQRT( ABS( T( KI+1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +! + IF( IP.EQ.0 ) THEN +! +! Real left eigenvector. +! + WORK( KI+N ) = ONE +! +! Form right-hand side +! + DO 160 K = KI + 1, N + WORK( K+N ) = -T( KI, K ) + 160 CONTINUE +! +! Solve the quasi-triangular system: +! (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK +! + VMAX = ONE + VCRIT = BIGNUM +! + JNXT = KI + 1 + DO 170 J = KI + 1, N + IF( J.LT.JNXT ) & + GO TO 170 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +! + IF( J1.EQ.J2 ) THEN +! +! 1-by-1 diagonal block +! +! Scale if necessary to avoid overflow when forming +! the right-hand side. +! + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +! + WORK( J+N ) = WORK( J+N ) - & + SDOT( J-KI-1, T( KI+1, J ), 1, & + WORK( KI+1+N ), 1 ) +! +! Solve (T(J,J)-WR)'*X = WORK +! + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, & + ZERO, X, 2, SCALE, XNORM, IERR ) +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) & + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 ) + WORK( J+N ) = X( 1, 1 ) + VMAX = MAX( ABS( WORK( J+N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +! + ELSE +! +! 2-by-2 diagonal block +! +! Scale if necessary to avoid overflow when forming +! the right-hand side. +! + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +! + WORK( J+N ) = WORK( J+N ) - & + SDOT( J-KI-1, T( KI+1, J ), 1, & + WORK( KI+1+N ), 1 ) +! + WORK( J+1+N ) = WORK( J+1+N ) - & + SDOT( J-KI-1, T( KI+1, J+1 ), 1, & + WORK( KI+1+N ), 1 ) +! +! Solve +! [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 ) +! [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 ) +! + CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, & + ZERO, X, 2, SCALE, XNORM, IERR ) +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) & + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 ) + WORK( J+N ) = X( 1, 1 ) + WORK( J+1+N ) = X( 2, 1 ) +! + VMAX = MAX( ABS( WORK( J+N ) ), & + ABS( WORK( J+1+N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +! + END IF + 170 CONTINUE +! +! Copy the vector x or Q*x to VL and normalize. +! + IF( .NOT.OVER ) THEN + CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) +! + II = ISAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / ABS( VL( II, IS ) ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +! + DO 180 K = 1, KI - 1 + VL( K, IS ) = ZERO + 180 CONTINUE +! + ELSE +! + IF( KI.LT.N ) & + CALL SGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL, & + WORK( KI+1+N ), 1, WORK( KI+N ), & + VL( 1, KI ), 1 ) +! + II = ISAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / ABS( VL( II, KI ) ) + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) +! + END IF +! + ELSE +! +! Complex left eigenvector. +! +! Initial solve: +! ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X = 0. +! ((T(KI+1,KI) T(KI+1,KI+1)) ) +! + IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN + WORK( KI+N ) = WI / T( KI, KI+1 ) + WORK( KI+1+N2 ) = ONE + ELSE + WORK( KI+N ) = ONE + WORK( KI+1+N2 ) = -WI / T( KI+1, KI ) + END IF + WORK( KI+1+N ) = ZERO + WORK( KI+N2 ) = ZERO +! +! Form right-hand side +! + DO 190 K = KI + 2, N + WORK( K+N ) = -WORK( KI+N )*T( KI, K ) + WORK( K+N2 ) = -WORK( KI+1+N2 )*T( KI+1, K ) + 190 CONTINUE +! +! Solve complex quasi-triangular system: +! ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2 +! + VMAX = ONE + VCRIT = BIGNUM +! + JNXT = KI + 2 + DO 200 J = KI + 2, N + IF( J.LT.JNXT ) & + GO TO 200 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +! + IF( J1.EQ.J2 ) THEN +! +! 1-by-1 diagonal block +! +! Scale if necessary to avoid overflow when +! forming the right-hand side elements. +! + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 ) + CALL SSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +! + WORK( J+N ) = WORK( J+N ) - & + SDOT( J-KI-2, T( KI+2, J ), 1, & + WORK( KI+2+N ), 1 ) + WORK( J+N2 ) = WORK( J+N2 ) - & + SDOT( J-KI-2, T( KI+2, J ), 1, & + WORK( KI+2+N2 ), 1 ) +! +! Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 +! + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, & + -WI, X, 2, SCALE, XNORM, IERR ) +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 ) + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 ) + END IF + WORK( J+N ) = X( 1, 1 ) + WORK( J+N2 ) = X( 1, 2 ) + VMAX = MAX( ABS( WORK( J+N ) ), & + ABS( WORK( J+N2 ) ), VMAX ) + VCRIT = BIGNUM / VMAX +! + ELSE +! +! 2-by-2 diagonal block +! +! Scale if necessary to avoid overflow when forming +! the right-hand side elements. +! + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 ) + CALL SSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +! + WORK( J+N ) = WORK( J+N ) - & + SDOT( J-KI-2, T( KI+2, J ), 1, & + WORK( KI+2+N ), 1 ) +! + WORK( J+N2 ) = WORK( J+N2 ) - & + SDOT( J-KI-2, T( KI+2, J ), 1, & + WORK( KI+2+N2 ), 1 ) +! + WORK( J+1+N ) = WORK( J+1+N ) - & + SDOT( J-KI-2, T( KI+2, J+1 ), 1, & + WORK( KI+2+N ), 1 ) +! + WORK( J+1+N2 ) = WORK( J+1+N2 ) - & + SDOT( J-KI-2, T( KI+2, J+1 ), 1, & + WORK( KI+2+N2 ), 1 ) +! +! Solve 2-by-2 complex linear equation +! ([T(j,j) T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B +! ([T(j+1,j) T(j+1,j+1)] ) +! + CALL SLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ), & + LDT, ONE, ONE, WORK( J+N ), N, WR, & + -WI, X, 2, SCALE, XNORM, IERR ) +! +! Scale if necessary +! + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 ) + CALL SSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 ) + END IF + WORK( J+N ) = X( 1, 1 ) + WORK( J+N2 ) = X( 1, 2 ) + WORK( J+1+N ) = X( 2, 1 ) + WORK( J+1+N2 ) = X( 2, 2 ) + VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ), & + ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), VMAX ) + VCRIT = BIGNUM / VMAX +! + END IF + 200 CONTINUE +! +! Copy the vector x or Q*x to VL and normalize. +! + 210 CONTINUE + IF( .NOT.OVER ) THEN + CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) + CALL SCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ), & + 1 ) +! + EMAX = ZERO + DO 220 K = KI, N + EMAX = MAX( EMAX, ABS( VL( K, IS ) )+ & + ABS( VL( K, IS+1 ) ) ) + 220 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 ) +! + DO 230 K = 1, KI - 1 + VL( K, IS ) = ZERO + VL( K, IS+1 ) = ZERO + 230 CONTINUE + ELSE + IF( KI.LT.N-1 ) THEN + CALL SGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ), & + LDVL, WORK( KI+2+N ), 1, WORK( KI+N ), & + VL( 1, KI ), 1 ) + CALL SGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ), & + LDVL, WORK( KI+2+N2 ), 1, & + WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) + ELSE + CALL SSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 ) + CALL SSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) + END IF +! + EMAX = ZERO + DO 240 K = 1, N + EMAX = MAX( EMAX, ABS( VL( K, KI ) )+ & + ABS( VL( K, KI+1 ) ) ) + 240 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) + CALL SSCAL( N, REMAX, VL( 1, KI+1 ), 1 ) +! + END IF +! + END IF +! + IS = IS + 1 + IF( IP.NE.0 ) & + IS = IS + 1 + 250 CONTINUE + IF( IP.EQ.-1 ) & + IP = 0 + IF( IP.EQ.1 ) & + IP = -1 +! + 260 CONTINUE +! + END IF +! + RETURN +! +! End of STREVC +! + END SUBROUTINE STREVC + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, & + N4 ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER*( * ) NAME, OPTS + INTEGER ISPEC, N1, N2, N3, N4 +! .. +! +! Purpose +! ======= +! +! ILAENV is called from the LAPACK routines to choose problem-dependent +! parameters for the local environment. See ISPEC for a description of +! the parameters. +! +! This version provides a set of parameters which should give good, +! but not optimal, performance on many of the currently available +! computers. Users are encouraged to modify this subroutine to set +! the tuning parameters for their particular machine using the option +! and problem size information in the arguments. +! +! This routine will not function correctly if it is converted to all +! lower case. Converting it to all upper case is allowed. +! +! Arguments +! ========= +! +! ISPEC (input) INTEGER +! Specifies the parameter to be returned as the value of +! ILAENV. +! = 1: the optimal blocksize; if this value is 1, an unblocked +! algorithm will give the best performance. +! = 2: the minimum block size for which the block routine +! should be used; if the usable block size is less than +! this value, an unblocked routine should be used. +! = 3: the crossover point (in a block routine, for N less +! than this value, an unblocked routine should be used) +! = 4: the number of shifts, used in the nonsymmetric +! eigenvalue routines +! = 5: the minimum column dimension for blocking to be used; +! rectangular blocks must have dimension at least k by m, +! where k is given by ILAENV(2,...) and m by ILAENV(5,...) +! = 6: the crossover point for the SVD (when reducing an m by n +! matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds +! this value, a QR factorization is used first to reduce +! the matrix to a triangular form.) +! = 7: the number of processors +! = 8: the crossover point for the multishift QR and QZ methods +! for nonsymmetric eigenvalue problems. +! +! NAME (input) CHARACTER*(*) +! The name of the calling subroutine, in either upper case or +! lower case. +! +! OPTS (input) CHARACTER*(*) +! The character options to the subroutine NAME, concatenated +! into a single character string. For example, UPLO = 'U', +! TRANS = 'T', and DIAG = 'N' for a triangular routine would +! be specified as OPTS = 'UTN'. +! +! N1 (input) INTEGER +! N2 (input) INTEGER +! N3 (input) INTEGER +! N4 (input) INTEGER +! Problem dimensions for the subroutine NAME; these may not all +! be required. +! +! (ILAENV) (output) INTEGER +! >= 0: the value of the parameter specified by ISPEC +! < 0: if ILAENV = -k, the k-th argument had an illegal value. +! +! Further Details +! =============== +! +! The following conventions have been used when calling ILAENV from the +! LAPACK routines: +! 1) OPTS is a concatenation of all of the character options to +! subroutine NAME, in the same order that they appear in the +! argument list for NAME, even if they are not used in determining +! the value of the parameter specified by ISPEC. +! 2) The problem dimensions N1, N2, N3, N4 are specified in the order +! that they appear in the argument list for NAME. N1 is used +! first, N2 second, and so on, and unused problem dimensions are +! passed a value of -1. +! 3) The parameter value returned by ILAENV is checked for validity in +! the calling subroutine. For example, ILAENV is used to retrieve +! the optimal blocksize for STRTRI as follows: +! +! NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) +! IF( NB.LE.1 ) NB = MAX( 1, N ) +! +! ===================================================================== +! +! .. Local Scalars .. + LOGICAL CNAME, SNAME + CHARACTER*1 C1 + CHARACTER*2 C2, C4 + CHARACTER*3 C3 + CHARACTER*6 SUBNAM + INTEGER I, IC, IZ, NB, NBMIN, NX +! .. +! .. Executable Statements .. +! + GO TO ( 100, 100, 100, 400, 500, 600, 700, 800 ) ISPEC +! +! Invalid value for ISPEC +! + ILAENV = -1 + RETURN +! + 100 CONTINUE +! +! Convert NAME to upper case if the first character is lower case. +! + ILAENV = 1 + SUBNAM = NAME + IC = ICHAR( SUBNAM( 1:1 ) ) + IZ = ICHAR( 'Z' ) + IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN +! +! ASCII character set +! + IF( IC.GE.97 .AND. IC.LE.122 ) THEN + SUBNAM( 1:1 ) = CHAR( IC-32 ) + DO 10 I = 2, 6 + IC = ICHAR( SUBNAM( I:I ) ) + IF( IC.GE.97 .AND. IC.LE.122 ) & + SUBNAM( I:I ) = CHAR( IC-32 ) + 10 CONTINUE + END IF +! + ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN +! +! EBCDIC character set +! + IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. & + ( IC.GE.145 .AND. IC.LE.153 ) .OR. & + ( IC.GE.162 .AND. IC.LE.169 ) ) THEN + SUBNAM( 1:1 ) = CHAR( IC+64 ) + DO 20 I = 2, 6 + IC = ICHAR( SUBNAM( I:I ) ) + IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. & + ( IC.GE.145 .AND. IC.LE.153 ) .OR. & + ( IC.GE.162 .AND. IC.LE.169 ) ) & + SUBNAM( I:I ) = CHAR( IC+64 ) + 20 CONTINUE + END IF +! + ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN +! +! Prime machines: ASCII+128 +! + IF( IC.GE.225 .AND. IC.LE.250 ) THEN + SUBNAM( 1:1 ) = CHAR( IC-32 ) + DO 30 I = 2, 6 + IC = ICHAR( SUBNAM( I:I ) ) + IF( IC.GE.225 .AND. IC.LE.250 ) & + SUBNAM( I:I ) = CHAR( IC-32 ) + 30 CONTINUE + END IF + END IF +! + C1 = SUBNAM( 1:1 ) + SNAME = C1.EQ.'S' .OR. C1.EQ.'D' + CNAME = C1.EQ.'C' .OR. C1.EQ.'Z' + IF( .NOT.( CNAME .OR. SNAME ) ) & + RETURN + C2 = SUBNAM( 2:3 ) + C3 = SUBNAM( 4:6 ) + C4 = C3( 2:3 ) +! + GO TO ( 110, 200, 300 ) ISPEC +! + 110 CONTINUE +! +! ISPEC = 1: block size +! +! In these examples, separate code is provided for setting NB for +! real and complex. We assume that NB will take the same value in +! single or double precision. +! + NB = 1 +! + IF( C2.EQ.'GE' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. & + C3.EQ.'QLF' ) THEN + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C3.EQ.'HRD' ) THEN + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C3.EQ.'BRD' ) THEN + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C3.EQ.'TRI' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + END IF + ELSE IF( C2.EQ.'PO' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + END IF + ELSE IF( C2.EQ.'SY' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN + NB = 1 + ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN + NB = 64 + END IF + ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN + IF( C3.EQ.'TRF' ) THEN + NB = 64 + ELSE IF( C3.EQ.'TRD' ) THEN + NB = 1 + ELSE IF( C3.EQ.'GST' ) THEN + NB = 64 + END IF + ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NB = 32 + END IF + ELSE IF( C3( 1:1 ).EQ.'M' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NB = 32 + END IF + END IF + ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NB = 32 + END IF + ELSE IF( C3( 1:1 ).EQ.'M' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NB = 32 + END IF + END IF + ELSE IF( C2.EQ.'GB' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + IF( N4.LE.64 ) THEN + NB = 1 + ELSE + NB = 32 + END IF + ELSE + IF( N4.LE.64 ) THEN + NB = 1 + ELSE + NB = 32 + END IF + END IF + END IF + ELSE IF( C2.EQ.'PB' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + IF( N2.LE.64 ) THEN + NB = 1 + ELSE + NB = 32 + END IF + ELSE + IF( N2.LE.64 ) THEN + NB = 1 + ELSE + NB = 32 + END IF + END IF + END IF + ELSE IF( C2.EQ.'TR' ) THEN + IF( C3.EQ.'TRI' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + END IF + ELSE IF( C2.EQ.'LA' ) THEN + IF( C3.EQ.'UUM' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF + END IF + ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN + IF( C3.EQ.'EBZ' ) THEN + NB = 1 + END IF + END IF + ILAENV = NB + RETURN +! + 200 CONTINUE +! +! ISPEC = 2: minimum block size +! + NBMIN = 2 + IF( C2.EQ.'GE' ) THEN + IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. & + C3.EQ.'QLF' ) THEN + IF( SNAME ) THEN + NBMIN = 2 + ELSE + NBMIN = 2 + END IF + ELSE IF( C3.EQ.'HRD' ) THEN + IF( SNAME ) THEN + NBMIN = 2 + ELSE + NBMIN = 2 + END IF + ELSE IF( C3.EQ.'BRD' ) THEN + IF( SNAME ) THEN + NBMIN = 2 + ELSE + NBMIN = 2 + END IF + ELSE IF( C3.EQ.'TRI' ) THEN + IF( SNAME ) THEN + NBMIN = 2 + ELSE + NBMIN = 2 + END IF + END IF + ELSE IF( C2.EQ.'SY' ) THEN + IF( C3.EQ.'TRF' ) THEN + IF( SNAME ) THEN + NBMIN = 8 + ELSE + NBMIN = 8 + END IF + ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN + NBMIN = 2 + END IF + ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN + IF( C3.EQ.'TRD' ) THEN + NBMIN = 2 + END IF + ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NBMIN = 2 + END IF + ELSE IF( C3( 1:1 ).EQ.'M' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NBMIN = 2 + END IF + END IF + ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NBMIN = 2 + END IF + ELSE IF( C3( 1:1 ).EQ.'M' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NBMIN = 2 + END IF + END IF + END IF + ILAENV = NBMIN + RETURN +! + 300 CONTINUE +! +! ISPEC = 3: crossover point +! + NX = 0 + IF( C2.EQ.'GE' ) THEN + IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. & + C3.EQ.'QLF' ) THEN + IF( SNAME ) THEN + NX = 128 + ELSE + NX = 128 + END IF + ELSE IF( C3.EQ.'HRD' ) THEN + IF( SNAME ) THEN + NX = 128 + ELSE + NX = 128 + END IF + ELSE IF( C3.EQ.'BRD' ) THEN + IF( SNAME ) THEN + NX = 128 + ELSE + NX = 128 + END IF + END IF + ELSE IF( C2.EQ.'SY' ) THEN + IF( SNAME .AND. C3.EQ.'TRD' ) THEN + NX = 1 + END IF + ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN + IF( C3.EQ.'TRD' ) THEN + NX = 1 + END IF + ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NX = 128 + END IF + END IF + ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN + IF( C3( 1:1 ).EQ.'G' ) THEN + IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. & + C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. & + C4.EQ.'BR' ) THEN + NX = 128 + END IF + END IF + END IF + ILAENV = NX + RETURN +! + 400 CONTINUE +! +! ISPEC = 4: number of shifts (used by xHSEQR) +! + ILAENV = 6 + RETURN +! + 500 CONTINUE +! +! ISPEC = 5: minimum column dimension (not used) +! + ILAENV = 2 + RETURN +! + 600 CONTINUE +! +! ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) +! + ILAENV = INT( REAL( MIN( N1, N2 ) ,r8)*1.6E0_r8 ) + RETURN +! + 700 CONTINUE +! +! ISPEC = 7: number of processors (not used) +! + ILAENV = 1 + RETURN +! + 800 CONTINUE +! +! ISPEC = 8: crossover point for multishift (used by xHSEQR) +! + ILAENV = 50 + RETURN +! +! End of ILAENV +! + END FUNCTION ILAENV + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + LOGICAL FUNCTION LSAME( CA, CB ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER CA, CB +! .. +! +! Purpose +! ======= +! +! LSAME returns .TRUE. if CA is the same letter as CB regardless of +! case. +! +! Arguments +! ========= +! +! CA (input) CHARACTER*1 +! CB (input) CHARACTER*1 +! CA and CB specify the single characters to be compared. +! +! ===================================================================== +! +! .. +! .. Local Scalars .. + INTEGER INTA, INTB, ZCODE +! .. +! .. Executable Statements .. +! +! Test if the characters are equal +! + LSAME = CA.EQ.CB + IF( LSAME ) & + RETURN +! +! Now test for equivalence if both characters are alphabetic. +! + ZCODE = ICHAR( 'Z' ) +! +! Use 'Z' rather than 'A' so that ASCII can be detected on Prime +! machines, on which ICHAR returns a value with bit 8 set. +! ICHAR('A') on Prime machines returns 193 which is the same as +! ICHAR('A') on an EBCDIC machine. +! + INTA = ICHAR( CA ) + INTB = ICHAR( CB ) +! + IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN +! +! ASCII is assumed - ZCODE is the ASCII code of either lower or +! upper case 'Z'. +! + IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32 + IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32 +! + ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN +! +! EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or +! upper case 'Z'. +! + IF( INTA.GE.129 .AND. INTA.LE.137 .OR. & + INTA.GE.145 .AND. INTA.LE.153 .OR. & + INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64 + IF( INTB.GE.129 .AND. INTB.LE.137 .OR. & + INTB.GE.145 .AND. INTB.LE.153 .OR. & + INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64 +! + ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN +! +! ASCII is assumed, on Prime machines - ZCODE is the ASCII code +! plus 128 of either lower or upper case 'Z'. +! + IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32 + IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32 + END IF + LSAME = INTA.EQ.INTB +! +! RETURN +! +! End of LSAME +! + END FUNCTION LSAME + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SLAMCH( CMACH ) + + real(r8) slamch + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + CHARACTER CMACH +! .. +! +! Purpose +! ======= +! +! SLAMCH determines single precision machine parameters. +! +! Arguments +! ========= +! +! CMACH (input) CHARACTER*1 +! Specifies the value to be returned by SLAMCH: +! = 'E' or 'e', SLAMCH := eps +! = 'S' or 's , SLAMCH := sfmin +! = 'B' or 'b', SLAMCH := base +! = 'P' or 'p', SLAMCH := eps*base +! = 'N' or 'n', SLAMCH := t +! = 'R' or 'r', SLAMCH := rnd +! = 'M' or 'm', SLAMCH := emin +! = 'U' or 'u', SLAMCH := rmin +! = 'L' or 'l', SLAMCH := emax +! = 'O' or 'o', SLAMCH := rmax +! +! where +! +! eps = relative machine precision +! sfmin = safe minimum, such that 1/sfmin does not overflow +! base = base of the machine +! prec = eps*base +! t = number of (base) digits in the mantissa +! rnd = 1.0 when rounding occurs in addition, 0.0 otherwise +! emin = minimum exponent before (gradual) underflow +! rmin = underflow threshold - base**(emin-1) +! emax = largest exponent before overflow +! rmax = overflow threshold - (base**emax)*(1-eps) +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ONE, ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Local Scalars .. + LOGICAL FIRST, LRND + INTEGER BETA, IMAX, IMIN, IT + REAL(r8) BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN, & + RND, SFMIN, SMALL, T +! .. +! .. Save statement .. + SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN, & + EMAX, RMAX, PREC +! .. +! .. Data statements .. + DATA FIRST / .TRUE. / +! .. +! .. Executable Statements .. +! + IF( FIRST ) THEN + FIRST = .FALSE. + CALL SLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX ) + BASE = BETA + T = IT + IF( LRND ) THEN + RND = ONE + EPS = ( BASE**( 1-IT ) ) / 2 + ELSE + RND = ZERO + EPS = BASE**( 1-IT ) + END IF + PREC = EPS*BASE + EMIN = IMIN + EMAX = IMAX + SFMIN = RMIN + SMALL = ONE / RMAX + IF( SMALL.GE.SFMIN ) THEN +! +! Use SMALL plus a bit, to avoid the possibility of rounding +! causing overflow when computing 1/sfmin. +! + SFMIN = SMALL*( ONE+EPS ) + END IF + END IF +! + IF( LSAME( CMACH, 'E' ) ) THEN + RMACH = EPS + ELSE IF( LSAME( CMACH, 'S' ) ) THEN + RMACH = SFMIN + ELSE IF( LSAME( CMACH, 'B' ) ) THEN + RMACH = BASE + ELSE IF( LSAME( CMACH, 'P' ) ) THEN + RMACH = PREC + ELSE IF( LSAME( CMACH, 'N' ) ) THEN + RMACH = T + ELSE IF( LSAME( CMACH, 'R' ) ) THEN + RMACH = RND + ELSE IF( LSAME( CMACH, 'M' ) ) THEN + RMACH = EMIN + ELSE IF( LSAME( CMACH, 'U' ) ) THEN + RMACH = RMIN + ELSE IF( LSAME( CMACH, 'L' ) ) THEN + RMACH = EMAX + ELSE IF( LSAME( CMACH, 'O' ) ) THEN + RMACH = RMAX + END IF +! + SLAMCH = RMACH + RETURN +! +! End of SLAMCH +! + END FUNCTION SLAMCH +! +!*********************************************************************** +! + SUBROUTINE SLAMC1( BETA, T, RND, IEEE1 ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + LOGICAL IEEE1, RND + INTEGER BETA, T +! .. +! +! Purpose +! ======= +! +! SLAMC1 determines the machine parameters given by BETA, T, RND, and +! IEEE1. +! +! Arguments +! ========= +! +! BETA (output) INTEGER +! The base of the machine. +! +! T (output) INTEGER +! The number of ( BETA ) digits in the mantissa. +! +! RND (output) LOGICAL +! Specifies whether proper rounding ( RND = .TRUE. ) or +! chopping ( RND = .FALSE. ) occurs in addition. This may not +! be a reliable guide to the way in which the machine performs +! its arithmetic. +! +! IEEE1 (output) LOGICAL +! Specifies whether rounding appears to be done in the IEEE +! 'round to nearest' style. +! +! Further Details +! =============== +! +! The routine is based on the routine ENVRON by Malcolm and +! incorporates suggestions by Gentleman and Marovich. See +! +! Malcolm M. A. (1972) Algorithms to reveal properties of +! floating-point arithmetic. Comms. of the ACM, 15, 949-951. +! +! Gentleman W. M. and Marovich S. B. (1974) More on algorithms +! that reveal properties of floating point arithmetic units. +! Comms. of the ACM, 17, 276-277. +! +! ===================================================================== +! +! .. Local Scalars .. + LOGICAL FIRST, LIEEE1, LRND + INTEGER LBETA, LT + REAL(r8) A, B, C, F, ONE, QTR, SAVEC, T1, T2 +! .. +! .. Save statement .. + SAVE FIRST, LIEEE1, LBETA, LRND, LT +! .. +! .. Data statements .. + DATA FIRST / .TRUE. / +! .. +! .. Executable Statements .. +! + IF( FIRST ) THEN + FIRST = .FALSE. + ONE = 1 +! +! LBETA, LIEEE1, LT and LRND are the local values of BETA, +! IEEE1, T and RND. +! +! Throughout this routine we use the function SLAMC3 to ensure +! that relevant values are stored and not held in registers, or +! are not affected by optimizers. +! +! Compute a = 2.0**m with the smallest positive integer m such +! that +! +! fl( a + 1.0 ) = a. +! + A = 1 + C = 1 +! +!+ WHILE( C.EQ.ONE )LOOP + 10 CONTINUE + IF( C.EQ.ONE ) THEN + A = 2*A + C = SLAMC3( A, ONE ) + C = SLAMC3( C, -A ) + GO TO 10 + END IF +!+ END WHILE +! +! Now compute b = 2.0**m with the smallest positive integer m +! such that +! +! fl( a + b ) .gt. a. +! + B = 1 + C = SLAMC3( A, B ) +! +!+ WHILE( C.EQ.A )LOOP + 20 CONTINUE + IF( C.EQ.A ) THEN + B = 2*B + C = SLAMC3( A, B ) + GO TO 20 + END IF +!+ END WHILE +! +! Now compute the base. a and c are neighbouring floating point +! numbers in the interval ( beta**t, beta**( t + 1 ) ) and so +! their difference is beta. Adding 0.25 to c is to ensure that it +! is truncated to beta and not ( beta - 1 ). +! + QTR = ONE / 4 + SAVEC = C + C = SLAMC3( C, -A ) + LBETA = C + QTR +! +! Now determine whether rounding or chopping occurs, by adding a +! bit less than beta/2 and a bit more than beta/2 to a. +! + B = LBETA + F = SLAMC3( B / 2, -B / 100 ) + C = SLAMC3( F, A ) + IF( C.EQ.A ) THEN + LRND = .TRUE. + ELSE + LRND = .FALSE. + END IF + F = SLAMC3( B / 2, B / 100 ) + C = SLAMC3( F, A ) + IF( ( LRND ) .AND. ( C.EQ.A ) ) & + LRND = .FALSE. +! +! Try and decide whether rounding is done in the IEEE 'round to +! nearest' style. B/2 is half a unit in the last place of the two +! numbers A and SAVEC. Furthermore, A is even, i.e. has last bit +! zero, and SAVEC is odd. Thus adding B/2 to A should not change +! A, but adding B/2 to SAVEC should change SAVEC. +! + T1 = SLAMC3( B / 2, A ) + T2 = SLAMC3( B / 2, SAVEC ) + LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND +! +! Now find the mantissa, t. It should be the integer part of +! log to the base beta of a, however it is safer to determine t +! by powering. So we find t as the smallest positive integer for +! which +! +! fl( beta**t + 1.0 ) = 1.0. +! + LT = 0 + A = 1 + C = 1 +! +!+ WHILE( C.EQ.ONE )LOOP + 30 CONTINUE + IF( C.EQ.ONE ) THEN + LT = LT + 1 + A = A*LBETA + C = SLAMC3( A, ONE ) + C = SLAMC3( C, -A ) + GO TO 30 + END IF +!+ END WHILE +! + END IF +! + BETA = LBETA + T = LT + RND = LRND + IEEE1 = LIEEE1 + RETURN +! +! End of SLAMC1 +! + END SUBROUTINE SLAMC1 +! +!*********************************************************************** +! + SUBROUTINE SLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + LOGICAL RND + INTEGER BETA, EMAX, EMIN, T + REAL(r8) EPS, RMAX, RMIN +! .. +! +! Purpose +! ======= +! +! SLAMC2 determines the machine parameters specified in its argument +! list. +! +! Arguments +! ========= +! +! BETA (output) INTEGER +! The base of the machine. +! +! T (output) INTEGER +! The number of ( BETA ) digits in the mantissa. +! +! RND (output) LOGICAL +! Specifies whether proper rounding ( RND = .TRUE. ) or +! chopping ( RND = .FALSE. ) occurs in addition. This may not +! be a reliable guide to the way in which the machine performs +! its arithmetic. +! +! EPS (output) REAL +! The smallest positive number such that +! +! fl( 1.0 - EPS ) .LT. 1.0, +! +! where fl denotes the computed value. +! +! EMIN (output) INTEGER +! The minimum exponent before (gradual) underflow occurs. +! +! RMIN (output) REAL +! The smallest normalized number for the machine, given by +! BASE**( EMIN - 1 ), where BASE is the floating point value +! of BETA. +! +! EMAX (output) INTEGER +! The maximum exponent before overflow occurs. +! +! RMAX (output) REAL +! The largest positive number for the machine, given by +! BASE**EMAX * ( 1 - EPS ), where BASE is the floating point +! value of BETA. +! +! Further Details +! =============== +! +! The computation of EPS is based on a routine PARANOIA by +! W. Kahan of the University of California at Berkeley. +! +! ===================================================================== +! +! .. Local Scalars .. + LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND + INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT, & + NGNMIN, NGPMIN + REAL(r8) A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE, & + SIXTH, SMALL, THIRD, TWO, ZERO +! .. +! .. Save statement .. + SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX, & + LRMIN, LT +! .. +! .. Data statements .. + DATA FIRST / .TRUE. / , IWARN / .FALSE. / +! .. +! .. Executable Statements .. +! + IF( FIRST ) THEN + FIRST = .FALSE. + ZERO = 0 + ONE = 1 + TWO = 2 +! +! LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of +! BETA, T, RND, EPS, EMIN and RMIN. +! +! Throughout this routine we use the function SLAMC3 to ensure +! that relevant values are stored and not held in registers, or +! are not affected by optimizers. +! +! SLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1. +! + CALL SLAMC1( LBETA, LT, LRND, LIEEE1 ) +! +! Start to find EPS. +! + B = LBETA + A = B**( -LT ) + LEPS = A +! +! Try some tricks to see whether or not this is the correct EPS. +! + B = TWO / 3 + HALF = ONE / 2 + SIXTH = SLAMC3( B, -HALF ) + THIRD = SLAMC3( SIXTH, SIXTH ) + B = SLAMC3( THIRD, -HALF ) + B = SLAMC3( B, SIXTH ) + B = ABS( B ) + IF( B.LT.LEPS ) & + B = LEPS +! + LEPS = 1 +! +!+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP + 10 CONTINUE + IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN + LEPS = B + C = SLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) ) + C = SLAMC3( HALF, -C ) + B = SLAMC3( HALF, C ) + C = SLAMC3( HALF, -B ) + B = SLAMC3( HALF, C ) + GO TO 10 + END IF +!+ END WHILE +! + IF( A.LT.LEPS ) & + LEPS = A +! +! Computation of EPS complete. +! +! Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)). +! Keep dividing A by BETA until (gradual) underflow occurs. This +! is detected when we cannot recover the previous A. +! + RBASE = ONE / LBETA + SMALL = ONE + DO 20 I = 1, 3 + SMALL = SLAMC3( SMALL*RBASE, ZERO ) + 20 CONTINUE + A = SLAMC3( ONE, SMALL ) + CALL SLAMC4( NGPMIN, ONE, LBETA ) + CALL SLAMC4( NGNMIN, -ONE, LBETA ) + CALL SLAMC4( GPMIN, A, LBETA ) + CALL SLAMC4( GNMIN, -A, LBETA ) + IEEE = .FALSE. +! + IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN + IF( NGPMIN.EQ.GPMIN ) THEN + LEMIN = NGPMIN +! ( Non twos-complement machines, no gradual underflow; +! e.g., VAX ) + ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN + LEMIN = NGPMIN - 1 + LT + IEEE = .TRUE. +! ( Non twos-complement machines, with gradual underflow; +! e.g., IEEE standard followers ) + ELSE + LEMIN = MIN( NGPMIN, GPMIN ) +! ( A guess; no known machine ) + IWARN = .TRUE. + END IF +! + ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN + IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN + LEMIN = MAX( NGPMIN, NGNMIN ) +! ( Twos-complement machines, no gradual underflow; +! e.g., CYBER 205 ) + ELSE + LEMIN = MIN( NGPMIN, NGNMIN ) +! ( A guess; no known machine ) + IWARN = .TRUE. + END IF +! + ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND. & + ( GPMIN.EQ.GNMIN ) ) THEN + IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN + LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT +! ( Twos-complement machines with gradual underflow; +! no known machine ) + ELSE + LEMIN = MIN( NGPMIN, NGNMIN ) +! ( A guess; no known machine ) + IWARN = .TRUE. + END IF +! + ELSE + LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN ) +! ( A guess; no known machine ) + IWARN = .TRUE. + END IF +!** +! Comment out this if block if EMIN is ok + IF( IWARN ) THEN + FIRST = .TRUE. + write(iulog, FMT = 9999 )LEMIN + END IF +!** +! +! Assume IEEE arithmetic if we found denormalised numbers above, +! or if arithmetic seems to round in the IEEE style, determined +! in routine SLAMC1. A true IEEE machine should have both things +! true; however, faulty machines may have one or the other. +! + IEEE = IEEE .OR. LIEEE1 +! +! Compute RMIN by successive division by BETA. We could compute +! RMIN as BASE**( EMIN - 1 ), but some machines underflow during +! this computation. +! + LRMIN = 1 + DO 30 I = 1, 1 - LEMIN + LRMIN = SLAMC3( LRMIN*RBASE, ZERO ) + 30 CONTINUE +! +! Finally, call SLAMC5 to compute EMAX and RMAX. +! + CALL SLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX ) + END IF +! + BETA = LBETA + T = LT + RND = LRND + EPS = LEPS + EMIN = LEMIN + RMIN = LRMIN + EMAX = LEMAX + RMAX = LRMAX +! + RETURN +! + 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-', & + ' EMIN = ', I8, / & + ' If, after inspection, the value EMIN looks', & + ' acceptable please comment out ', & + / ' the IF block as marked within the code of routine', & + ' SLAMC2,', / ' otherwise supply EMIN explicitly.', / ) +! +! End of SLAMC2 +! + END SUBROUTINE SLAMC2 +! +!*********************************************************************** +! + FUNCTION SLAMC3( A, B ) + + real(r8) slamc3 + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + REAL(r8) A, B +! .. +! +! Purpose +! ======= +! +! SLAMC3 is intended to force A and B to be stored prior to doing +! the addition of A and B , for use in situations where optimizers +! might hold one of these in a register. +! +! Arguments +! ========= +! +! A, B (input) REAL +! The values A and B. +! +! ===================================================================== +! +! .. Executable Statements .. +! + SLAMC3 = A + B +! + RETURN +! +! End of SLAMC3 +! + END FUNCTION SLAMC3 +! +!*********************************************************************** +! + SUBROUTINE SLAMC4( EMIN, START, BASE ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + INTEGER BASE, EMIN + REAL(r8) START +! .. +! +! Purpose +! ======= +! +! SLAMC4 is a service routine for SLAMC2. +! +! Arguments +! ========= +! +! EMIN (output) EMIN +! The minimum exponent before (gradual) underflow, computed by +! setting A = START and dividing by BASE until the previous A +! can not be recovered. +! +! START (input) REAL +! The starting point for determining EMIN. +! +! BASE (input) INTEGER +! The base of the machine. +! +! ===================================================================== +! +! .. Local Scalars .. + INTEGER I + REAL(r8) A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO +! .. +! .. Executable Statements .. +! + A = START + ONE = 1 + RBASE = ONE / BASE + ZERO = 0 + EMIN = 1 + B1 = SLAMC3( A*RBASE, ZERO ) + C1 = A + C2 = A + D1 = A + D2 = A +!+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND. +! $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP + 10 CONTINUE + IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND. & + ( D2.EQ.A ) ) THEN + EMIN = EMIN - 1 + A = B1 + B1 = SLAMC3( A / BASE, ZERO ) + C1 = SLAMC3( B1*BASE, ZERO ) + D1 = ZERO + DO 20 I = 1, BASE + D1 = D1 + B1 + 20 CONTINUE + B2 = SLAMC3( A*RBASE, ZERO ) + C2 = SLAMC3( B2 / RBASE, ZERO ) + D2 = ZERO + DO 30 I = 1, BASE + D2 = D2 + B2 + 30 CONTINUE + GO TO 10 + END IF +!+ END WHILE +! + RETURN +! +! End of SLAMC4 +! + END SUBROUTINE SLAMC4 +! +!*********************************************************************** +! + SUBROUTINE SLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! October 31, 1992 +! +! .. Scalar Arguments .. + LOGICAL IEEE + INTEGER BETA, EMAX, EMIN, P + REAL(r8) RMAX +! .. +! +! Purpose +! ======= +! +! SLAMC5 attempts to compute RMAX, the largest machine floating-point +! number, without overflow. It assumes that EMAX + abs(EMIN) sum +! approximately to a power of 2. It will fail on machines where this +! assumption does not hold, for example, the Cyber 205 (EMIN = -28625, +! EMAX = 28718). It will also fail if the value supplied for EMIN is +! too large (i.e. too close to zero), probably with overflow. +! +! Arguments +! ========= +! +! BETA (input) INTEGER +! The base of floating-point arithmetic. +! +! P (input) INTEGER +! The number of base BETA digits in the mantissa of a +! floating-point value. +! +! EMIN (input) INTEGER +! The minimum exponent before (gradual) underflow. +! +! IEEE (input) LOGICAL +! A logical flag specifying whether or not the arithmetic +! system is thought to comply with the IEEE standard. +! +! EMAX (output) INTEGER +! The largest exponent before overflow +! +! RMAX (output) REAL +! The largest machine floating-point number. +! +! ===================================================================== +! +! .. Parameters .. + REAL(r8) ZERO, ONE + PARAMETER ( ZERO = 0.0E0_r8, ONE = 1.0E0_r8 ) +! .. +! .. Local Scalars .. + INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP + REAL(r8) OLDY, RECBAS, Y, Z +! .. +! .. Executable Statements .. +! +! First compute LEXP and UEXP, two powers of 2 that bound +! abs(EMIN). We then assume that EMAX + abs(EMIN) will sum +! approximately to the bound that is closest to abs(EMIN). +! (EMAX is the exponent of the required number RMAX). +! + LEXP = 1 + EXBITS = 1 + 10 CONTINUE + TRY = LEXP*2 + IF( TRY.LE.( -EMIN ) ) THEN + LEXP = TRY + EXBITS = EXBITS + 1 + GO TO 10 + END IF + IF( LEXP.EQ.-EMIN ) THEN + UEXP = LEXP + ELSE + UEXP = TRY + EXBITS = EXBITS + 1 + END IF +! +! Now -LEXP is less than or equal to EMIN, and -UEXP is greater +! than or equal to EMIN. EXBITS is the number of bits needed to +! store the exponent. +! + IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN + EXPSUM = 2*LEXP + ELSE + EXPSUM = 2*UEXP + END IF +! +! EXPSUM is the exponent range, approximately equal to +! EMAX - EMIN + 1 . +! + EMAX = EXPSUM + EMIN - 1 + NBITS = 1 + EXBITS + P +! +! NBITS is the total number of bits needed to store a +! floating-point number. +! + IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN +! +! Either there are an odd number of bits used to store a +! floating-point number, which is unlikely, or some bits are +! not used in the representation of numbers, which is possible, +! (e.g. Cray machines) or the mantissa has an implicit bit, +! (e.g. IEEE machines, Dec Vax machines), which is perhaps the +! most likely. We have to assume the last alternative. +! If this is true, then we need to reduce EMAX by one because +! there must be some way of representing zero in an implicit-bit +! system. On machines like Cray, we are reducing EMAX by one +! unnecessarily. +! + EMAX = EMAX - 1 + END IF +! + IF( IEEE ) THEN +! +! Assume we are on an IEEE machine which reserves one exponent +! for infinity and NaN. +! + EMAX = EMAX - 1 + END IF +! +! Now create RMAX, the largest machine number, which should +! be equal to (1.0 - BETA**(-P)) * BETA**EMAX . +! +! First compute 1.0 - BETA**(-P), being careful that the +! result is less than 1.0 . +! + RECBAS = ONE / BETA + Z = BETA - ONE + Y = ZERO + DO 20 I = 1, P + Z = Z*RECBAS + IF( Y.LT.ONE ) & + OLDY = Y + Y = SLAMC3( Y, Z ) + 20 CONTINUE + IF( Y.GE.ONE ) & + Y = OLDY +! +! Now multiply by BETA**EMAX to get RMAX. +! + DO 30 I = 1, EMAX + Y = SLAMC3( Y*BETA, ZERO ) + 30 CONTINUE +! + RMAX = Y + RETURN +! +! End of SLAMC5 +! + END SUBROUTINE SLAMC5 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE XERBLA( SRNAME, INFO ) + +! +! -- LAPACK auxiliary routine (version 2.0) -- +! Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., +! Courant Institute, Argonne National Lab, and Rice University +! September 30, 1994 +! +! .. Scalar Arguments .. + CHARACTER*6 SRNAME + INTEGER INFO +! .. +! +! Purpose +! ======= +! +! XERBLA is an error handler for the LAPACK routines. +! It is called by an LAPACK routine if an input parameter has an +! invalid value. A message is printed and execution stops. +! +! Installers may consider modifying the STOP statement in order to +! call system-specific exception-handling facilities. +! +! Arguments +! ========= +! +! SRNAME (input) CHARACTER*6 +! The name of the routine which called XERBLA. +! +! INFO (input) INTEGER +! The position of the invalid parameter in the parameter list +! of the calling routine. +! +! ===================================================================== +! +! .. Executable Statements .. +! + write(iulog, FMT = 9999 )SRNAME, INFO +! + call endrun('XERBLA') +! + 9999 FORMAT( ' ** On entry to ', A6, ' parameter number ', I2, ' had ', & + 'an illegal value' ) +! +! End of XERBLA +! + END SUBROUTINE XERBLA + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + subroutine scopy(n,sx,incx,sy,incy) + +! +! copies a vector, x, to a vector, y. +! uses unrolled loops for increments equal to 1. +! jack dongarra, linpack, 3/11/78. +! modified 12/3/93, array(1) declarations changed to array(*) +! + real(r8) sx(*),sy(*) + integer i,incx,incy,ix,iy,m,mp1,n +! + if(n.le.0)return + if(incx.eq.1.and.incy.eq.1)go to 20 +! +! code for unequal increments or equal increments +! not equal to 1 +! + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + sy(iy) = sx(ix) + ix = ix + incx + iy = iy + incy + 10 continue + return +! +! code for both increments equal to 1 +! +! +! clean-up loop +! + 20 m = mod(n,7) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sy(i) = sx(i) + 30 continue + if( n .lt. 7 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,7 + sy(i) = sx(i) + sy(i + 1) = sx(i + 1) + sy(i + 2) = sx(i + 2) + sy(i + 3) = sx(i + 3) + sy(i + 4) = sx(i + 4) + sy(i + 5) = sx(i + 5) + sy(i + 6) = sx(i + 6) + 50 continue + return + end subroutine scopy + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) + +! .. Scalar Arguments .. + REAL(r8) ALPHA + INTEGER INCX, INCY, LDA, M, N +! .. Array Arguments .. + REAL(r8) A( LDA, * ), X( * ), Y( * ) +! .. +! +! Purpose +! ======= +! +! SGER performs the rank 1 operation +! +! A := alpha*x*y' + A, +! +! where alpha is a scalar, x is an m element vector, y is an n element +! vector and A is an m by n matrix. +! +! Parameters +! ========== +! +! M - INTEGER. +! On entry, M specifies the number of rows of the matrix A. +! M must be at least zero. +! Unchanged on exit. +! +! N - INTEGER. +! On entry, N specifies the number of columns of the matrix A. +! N must be at least zero. +! Unchanged on exit. +! +! ALPHA - REAL . +! On entry, ALPHA specifies the scalar alpha. +! Unchanged on exit. +! +! X - REAL array of dimension at least +! ( 1 + ( m - 1 )*abs( INCX ) ). +! Before entry, the incremented array X must contain the m +! element vector x. +! Unchanged on exit. +! +! INCX - INTEGER. +! On entry, INCX specifies the increment for the elements of +! X. INCX must not be zero. +! Unchanged on exit. +! +! Y - REAL array of dimension at least +! ( 1 + ( n - 1 )*abs( INCY ) ). +! Before entry, the incremented array Y must contain the n +! element vector y. +! Unchanged on exit. +! +! INCY - INTEGER. +! On entry, INCY specifies the increment for the elements of +! Y. INCY must not be zero. +! Unchanged on exit. +! +! A - REAL array of DIMENSION ( LDA, n ). +! Before entry, the leading m by n part of the array A must +! contain the matrix of coefficients. On exit, A is +! overwritten by the updated matrix. +! +! LDA - INTEGER. +! On entry, LDA specifies the first dimension of A as declared +! in the calling (sub) program. LDA must be at least +! max( 1, m ). +! Unchanged on exit. +! +! +! Level 2 Blas routine. +! +! -- Written on 22-October-1986. +! Jack Dongarra, Argonne National Lab. +! Jeremy Du Croz, Nag Central Office. +! Sven Hammarling, Nag Central Office. +! Richard Hanson, Sandia National Labs. +! +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E+0_r8 ) +! .. Local Scalars .. + REAL(r8) TEMP + INTEGER I, INFO, IX, J, JY, KX +! .. +! .. Executable Statements .. +! +! Test the input parameters. +! + INFO = 0 + IF ( M.LT.0 )THEN + INFO = 1 + ELSE IF( N.LT.0 )THEN + INFO = 2 + ELSE IF( INCX.EQ.0 )THEN + INFO = 5 + ELSE IF( INCY.EQ.0 )THEN + INFO = 7 + ELSE IF( LDA.LT.MAX( 1, M ) )THEN + INFO = 9 + END IF + IF( INFO.NE.0 )THEN + CALL XERBLA( 'SGER ', INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) ) & + RETURN +! +! Start the operations. In this version the elements of A are +! accessed sequentially with one pass through A. +! + IF( INCY.GT.0 )THEN + JY = 1 + ELSE + JY = 1 - ( N - 1 )*INCY + END IF + IF( INCX.EQ.1 )THEN + DO 20, J = 1, N + IF( Y( JY ).NE.ZERO )THEN + TEMP = ALPHA*Y( JY ) + DO 10, I = 1, M + A( I, J ) = A( I, J ) + X( I )*TEMP + 10 CONTINUE + END IF + JY = JY + INCY + 20 CONTINUE + ELSE + IF( INCX.GT.0 )THEN + KX = 1 + ELSE + KX = 1 - ( M - 1 )*INCX + END IF + DO 40, J = 1, N + IF( Y( JY ).NE.ZERO )THEN + TEMP = ALPHA*Y( JY ) + IX = KX + DO 30, I = 1, M + A( I, J ) = A( I, J ) + X( IX )*TEMP + IX = IX + INCX + 30 CONTINUE + END IF + JY = JY + INCY + 40 CONTINUE + END IF +! + RETURN +! +! End of SGER . +! + END SUBROUTINE SGER + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + FUNCTION SNRM2 ( N, X, INCX ) + + real(r8) snrm2 + +! .. Scalar Arguments .. + INTEGER INCX, N +! .. Array Arguments .. + REAL(r8) X( * ) +! .. +! +! SNRM2 returns the euclidean norm of a vector via the function +! name, so that +! +! SNRM2 := sqrt( x'*x ) +! +! +! +! -- This version written on 25-October-1982. +! Modified on 14-October-1993 to inline the call to SLASSQ. +! Sven Hammarling, Nag Ltd. +! +! +! .. Parameters .. + REAL(r8) ONE , ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. Local Scalars .. + INTEGER IX + REAL(r8) ABSXI, NORM, SCALE, SSQ +! .. +! .. Executable Statements .. + IF( N.LT.1 .OR. INCX.LT.1 )THEN + NORM = ZERO + ELSE IF( N.EQ.1 )THEN + NORM = ABS( X( 1 ) ) + ELSE + SCALE = ZERO + SSQ = ONE +! The following loop is equivalent to this call to the LAPACK +! auxiliary routine: +! CALL SLASSQ( N, X, INCX, SCALE, SSQ ) +! + DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX + IF( X( IX ).NE.ZERO )THEN + ABSXI = ABS( X( IX ) ) + IF( SCALE.LT.ABSXI )THEN + SSQ = ONE + SSQ*( SCALE/ABSXI )**2 + SCALE = ABSXI + ELSE + SSQ = SSQ + ( ABSXI/SCALE )**2 + END IF + END IF + 10 CONTINUE + NORM = SCALE * SQRT( SSQ ) + END IF +! + SNRM2 = NORM + RETURN +! +! End of SNRM2. +! + END FUNCTION SNRM2 + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + subroutine srot (n,sx,incx,sy,incy,c,s) +! +! applies a plane rotation. +! jack dongarra, linpack, 3/11/78. +! modified 12/3/93, array(1) declarations changed to array(*) +! + + real(r8) sx(*),sy(*),stemp,c,s + integer i,incx,incy,ix,iy,n +! + if(n.le.0)return + if(incx.eq.1.and.incy.eq.1)go to 20 +! +! code for unequal increments or equal increments not equal +! to 1 +! + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + stemp = c*sx(ix) + s*sy(iy) + sy(iy) = c*sy(iy) - s*sx(ix) + sx(ix) = stemp + ix = ix + incx + iy = iy + incy + 10 continue + return +! +! code for both increments equal to 1 +! + 20 do 30 i = 1,n + stemp = c*sx(i) + s*sy(i) + sy(i) = c*sy(i) - s*sx(i) + sx(i) = stemp + 30 continue + return + end subroutine srot + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, & + BETA, C, LDC ) + +! .. Scalar Arguments .. + CHARACTER*1 TRANSA, TRANSB + INTEGER M, N, K, LDA, LDB, LDC + REAL(r8) ALPHA, BETA +! .. Array Arguments .. + REAL(r8) A( LDA, * ), B( LDB, * ), C( LDC, * ) +! .. +! +! Purpose +! ======= +! +! SGEMM performs one of the matrix-matrix operations +! +! C := alpha*op( A )*op( B ) + beta*C, +! +! where op( X ) is one of +! +! op( X ) = X or op( X ) = X', +! +! alpha and beta are scalars, and A, B and C are matrices, with op( A ) +! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. +! +! Parameters +! ========== +! +! TRANSA - CHARACTER*1. +! On entry, TRANSA specifies the form of op( A ) to be used in +! the matrix multiplication as follows: +! +! TRANSA = 'N' or 'n', op( A ) = A. +! +! TRANSA = 'T' or 't', op( A ) = A'. +! +! TRANSA = 'C' or 'c', op( A ) = A'. +! +! Unchanged on exit. +! +! TRANSB - CHARACTER*1. +! On entry, TRANSB specifies the form of op( B ) to be used in +! the matrix multiplication as follows: +! +! TRANSB = 'N' or 'n', op( B ) = B. +! +! TRANSB = 'T' or 't', op( B ) = B'. +! +! TRANSB = 'C' or 'c', op( B ) = B'. +! +! Unchanged on exit. +! +! M - INTEGER. +! On entry, M specifies the number of rows of the matrix +! op( A ) and of the matrix C. M must be at least zero. +! Unchanged on exit. +! +! N - INTEGER. +! On entry, N specifies the number of columns of the matrix +! op( B ) and the number of columns of the matrix C. N must be +! at least zero. +! Unchanged on exit. +! +! K - INTEGER. +! On entry, K specifies the number of columns of the matrix +! op( A ) and the number of rows of the matrix op( B ). K must +! be at least zero. +! Unchanged on exit. +! +! ALPHA - REAL . +! On entry, ALPHA specifies the scalar alpha. +! Unchanged on exit. +! +! A - REAL array of DIMENSION ( LDA, ka ), where ka is +! k when TRANSA = 'N' or 'n', and is m otherwise. +! Before entry with TRANSA = 'N' or 'n', the leading m by k +! part of the array A must contain the matrix A, otherwise +! the leading k by m part of the array A must contain the +! matrix A. +! Unchanged on exit. +! +! LDA - INTEGER. +! On entry, LDA specifies the first dimension of A as declared +! in the calling (sub) program. When TRANSA = 'N' or 'n' then +! LDA must be at least max( 1, m ), otherwise LDA must be at +! least max( 1, k ). +! Unchanged on exit. +! +! B - REAL array of DIMENSION ( LDB, kb ), where kb is +! n when TRANSB = 'N' or 'n', and is k otherwise. +! Before entry with TRANSB = 'N' or 'n', the leading k by n +! part of the array B must contain the matrix B, otherwise +! the leading n by k part of the array B must contain the +! matrix B. +! Unchanged on exit. +! +! LDB - INTEGER. +! On entry, LDB specifies the first dimension of B as declared +! in the calling (sub) program. When TRANSB = 'N' or 'n' then +! LDB must be at least max( 1, k ), otherwise LDB must be at +! least max( 1, n ). +! Unchanged on exit. +! +! BETA - REAL . +! On entry, BETA specifies the scalar beta. When BETA is +! supplied as zero then C need not be set on input. +! Unchanged on exit. +! +! C - REAL array of DIMENSION ( LDC, n ). +! Before entry, the leading m by n part of the array C must +! contain the matrix C, except when beta is zero, in which +! case C need not be set on entry. +! On exit, the array C is overwritten by the m by n matrix +! ( alpha*op( A )*op( B ) + beta*C ). +! +! LDC - INTEGER. +! On entry, LDC specifies the first dimension of C as declared +! in the calling (sub) program. LDC must be at least +! max( 1, m ). +! Unchanged on exit. +! +! +! Level 3 Blas routine. +! +! -- Written on 8-February-1989. +! Jack Dongarra, Argonne National Laboratory. +! Iain Duff, AERE Harwell. +! Jeremy Du Croz, Numerical Algorithms Group Ltd. +! Sven Hammarling, Numerical Algorithms Group Ltd. +! +! +! .. Local Scalars .. + LOGICAL NOTA, NOTB + INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB + REAL(r8) TEMP +! .. Parameters .. + REAL(r8) ONE , ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Executable Statements .. +! +! Set NOTA and NOTB as true if A and B respectively are not +! transposed and set NROWA, NCOLA and NROWB as the number of rows +! and columns of A and the number of rows of B respectively. +! + NOTA = LSAME( TRANSA, 'N' ) + NOTB = LSAME( TRANSB, 'N' ) + IF( NOTA )THEN + NROWA = M + NCOLA = K + ELSE + NROWA = K + NCOLA = M + END IF + IF( NOTB )THEN + NROWB = K + ELSE + NROWB = N + END IF +! +! Test the input parameters. +! + INFO = 0 + IF( ( .NOT.NOTA ).AND. & + ( .NOT.LSAME( TRANSA, 'C' ) ).AND. & + ( .NOT.LSAME( TRANSA, 'T' ) ) )THEN + INFO = 1 + ELSE IF( ( .NOT.NOTB ).AND. & + ( .NOT.LSAME( TRANSB, 'C' ) ).AND. & + ( .NOT.LSAME( TRANSB, 'T' ) ) )THEN + INFO = 2 + ELSE IF( M .LT.0 )THEN + INFO = 3 + ELSE IF( N .LT.0 )THEN + INFO = 4 + ELSE IF( K .LT.0 )THEN + INFO = 5 + ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN + INFO = 8 + ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN + INFO = 10 + ELSE IF( LDC.LT.MAX( 1, M ) )THEN + INFO = 13 + END IF + IF( INFO.NE.0 )THEN + CALL XERBLA( 'SGEMM ', INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. & + ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) ) & + RETURN +! +! And if alpha.eq.zero. +! + IF( ALPHA.EQ.ZERO )THEN + IF( BETA.EQ.ZERO )THEN + DO 20, J = 1, N + DO 10, I = 1, M + C( I, J ) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40, J = 1, N + DO 30, I = 1, M + C( I, J ) = BETA*C( I, J ) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +! +! Start the operations. +! + IF( NOTB )THEN + IF( NOTA )THEN +! +! Form C := alpha*A*B + beta*C. +! + DO 90, J = 1, N + IF( BETA.EQ.ZERO )THEN + DO 50, I = 1, M + C( I, J ) = ZERO + 50 CONTINUE + ELSE IF( BETA.NE.ONE )THEN + DO 60, I = 1, M + C( I, J ) = BETA*C( I, J ) + 60 CONTINUE + END IF + DO 80, L = 1, K + IF( B( L, J ).NE.ZERO )THEN + TEMP = ALPHA*B( L, J ) + DO 70, I = 1, M + C( I, J ) = C( I, J ) + TEMP*A( I, L ) + 70 CONTINUE + END IF + 80 CONTINUE + 90 CONTINUE + ELSE +! +! Form C := alpha*A'*B + beta*C +! + DO 120, J = 1, N + DO 110, I = 1, M + TEMP = ZERO + DO 100, L = 1, K + TEMP = TEMP + A( L, I )*B( L, J ) + 100 CONTINUE + IF( BETA.EQ.ZERO )THEN + C( I, J ) = ALPHA*TEMP + ELSE + C( I, J ) = ALPHA*TEMP + BETA*C( I, J ) + END IF + 110 CONTINUE + 120 CONTINUE + END IF + ELSE + IF( NOTA )THEN +! +! Form C := alpha*A*B' + beta*C +! + DO 170, J = 1, N + IF( BETA.EQ.ZERO )THEN + DO 130, I = 1, M + C( I, J ) = ZERO + 130 CONTINUE + ELSE IF( BETA.NE.ONE )THEN + DO 140, I = 1, M + C( I, J ) = BETA*C( I, J ) + 140 CONTINUE + END IF + DO 160, L = 1, K + IF( B( J, L ).NE.ZERO )THEN + TEMP = ALPHA*B( J, L ) + DO 150, I = 1, M + C( I, J ) = C( I, J ) + TEMP*A( I, L ) + 150 CONTINUE + END IF + 160 CONTINUE + 170 CONTINUE + ELSE +! +! Form C := alpha*A'*B' + beta*C +! + DO 200, J = 1, N + DO 190, I = 1, M + TEMP = ZERO + DO 180, L = 1, K + TEMP = TEMP + A( L, I )*B( J, L ) + 180 CONTINUE + IF( BETA.EQ.ZERO )THEN + C( I, J ) = ALPHA*TEMP + ELSE + C( I, J ) = ALPHA*TEMP + BETA*C( I, J ) + END IF + 190 CONTINUE + 200 CONTINUE + END IF + END IF +! + RETURN +! +! End of SGEMM . +! + END SUBROUTINE SGEMM + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE SGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, & + BETA, Y, INCY ) + +! .. Scalar Arguments .. + REAL(r8) ALPHA, BETA + INTEGER INCX, INCY, LDA, M, N + CHARACTER*1 TRANS +! .. Array Arguments .. + REAL(r8) A( LDA, * ), X( * ), Y( * ) +! .. +! +! Purpose +! ======= +! +! SGEMV performs one of the matrix-vector operations +! +! y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, +! +! where alpha and beta are scalars, x and y are vectors and A is an +! m by n matrix. +! +! Parameters +! ========== +! +! TRANS - CHARACTER*1. +! On entry, TRANS specifies the operation to be performed as +! follows: +! +! TRANS = 'N' or 'n' y := alpha*A*x + beta*y. +! +! TRANS = 'T' or 't' y := alpha*A'*x + beta*y. +! +! TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. +! +! Unchanged on exit. +! +! M - INTEGER. +! On entry, M specifies the number of rows of the matrix A. +! M must be at least zero. +! Unchanged on exit. +! +! N - INTEGER. +! On entry, N specifies the number of columns of the matrix A. +! N must be at least zero. +! Unchanged on exit. +! +! ALPHA - REAL . +! On entry, ALPHA specifies the scalar alpha. +! Unchanged on exit. +! +! A - REAL array of DIMENSION ( LDA, n ). +! Before entry, the leading m by n part of the array A must +! contain the matrix of coefficients. +! Unchanged on exit. +! +! LDA - INTEGER. +! On entry, LDA specifies the first dimension of A as declared +! in the calling (sub) program. LDA must be at least +! max( 1, m ). +! Unchanged on exit. +! +! X - REAL array of DIMENSION at least +! ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' +! and at least +! ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. +! Before entry, the incremented array X must contain the +! vector x. +! Unchanged on exit. +! +! INCX - INTEGER. +! On entry, INCX specifies the increment for the elements of +! X. INCX must not be zero. +! Unchanged on exit. +! +! BETA - REAL . +! On entry, BETA specifies the scalar beta. When BETA is +! supplied as zero then Y need not be set on input. +! Unchanged on exit. +! +! Y - REAL array of DIMENSION at least +! ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' +! and at least +! ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. +! Before entry with BETA non-zero, the incremented array Y +! must contain the vector y. On exit, Y is overwritten by the +! updated vector y. +! +! INCY - INTEGER. +! On entry, INCY specifies the increment for the elements of +! Y. INCY must not be zero. +! Unchanged on exit. +! +! +! Level 2 Blas routine. +! +! -- Written on 22-October-1986. +! Jack Dongarra, Argonne National Lab. +! Jeremy Du Croz, Nag Central Office. +! Sven Hammarling, Nag Central Office. +! Richard Hanson, Sandia National Labs. +! +! +! .. Parameters .. + REAL(r8) ONE , ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. Local Scalars .. + REAL(r8) TEMP + INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY +! .. +! .. Executable Statements .. +! +! Test the input parameters. +! + INFO = 0 + IF ( .NOT.LSAME( TRANS, 'N' ).AND. & + .NOT.LSAME( TRANS, 'T' ).AND. & + .NOT.LSAME( TRANS, 'C' ) )THEN + INFO = 1 + ELSE IF( M.LT.0 )THEN + INFO = 2 + ELSE IF( N.LT.0 )THEN + INFO = 3 + ELSE IF( LDA.LT.MAX( 1, M ) )THEN + INFO = 6 + ELSE IF( INCX.EQ.0 )THEN + INFO = 8 + ELSE IF( INCY.EQ.0 )THEN + INFO = 11 + END IF + IF( INFO.NE.0 )THEN + CALL XERBLA( 'SGEMV ', INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. & + ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) & + RETURN +! +! Set LENX and LENY, the lengths of the vectors x and y, and set +! up the start points in X and Y. +! + IF( LSAME( TRANS, 'N' ) )THEN + LENX = N + LENY = M + ELSE + LENX = M + LENY = N + END IF + IF( INCX.GT.0 )THEN + KX = 1 + ELSE + KX = 1 - ( LENX - 1 )*INCX + END IF + IF( INCY.GT.0 )THEN + KY = 1 + ELSE + KY = 1 - ( LENY - 1 )*INCY + END IF +! +! Start the operations. In this version the elements of A are +! accessed sequentially with one pass through A. +! +! First form y := beta*y. +! + IF( BETA.NE.ONE )THEN + IF( INCY.EQ.1 )THEN + IF( BETA.EQ.ZERO )THEN + DO 10, I = 1, LENY + Y( I ) = ZERO + 10 CONTINUE + ELSE + DO 20, I = 1, LENY + Y( I ) = BETA*Y( I ) + 20 CONTINUE + END IF + ELSE + IY = KY + IF( BETA.EQ.ZERO )THEN + DO 30, I = 1, LENY + Y( IY ) = ZERO + IY = IY + INCY + 30 CONTINUE + ELSE + DO 40, I = 1, LENY + Y( IY ) = BETA*Y( IY ) + IY = IY + INCY + 40 CONTINUE + END IF + END IF + END IF + IF( ALPHA.EQ.ZERO ) & + RETURN + IF( LSAME( TRANS, 'N' ) )THEN +! +! Form y := alpha*A*x + y. +! + JX = KX + IF( INCY.EQ.1 )THEN + DO 60, J = 1, N + IF( X( JX ).NE.ZERO )THEN + TEMP = ALPHA*X( JX ) + DO 50, I = 1, M + Y( I ) = Y( I ) + TEMP*A( I, J ) + 50 CONTINUE + END IF + JX = JX + INCX + 60 CONTINUE + ELSE + DO 80, J = 1, N + IF( X( JX ).NE.ZERO )THEN + TEMP = ALPHA*X( JX ) + IY = KY + DO 70, I = 1, M + Y( IY ) = Y( IY ) + TEMP*A( I, J ) + IY = IY + INCY + 70 CONTINUE + END IF + JX = JX + INCX + 80 CONTINUE + END IF + ELSE +! +! Form y := alpha*A'*x + y. +! + JY = KY + IF( INCX.EQ.1 )THEN + DO 100, J = 1, N + TEMP = ZERO + DO 90, I = 1, M + TEMP = TEMP + A( I, J )*X( I ) + 90 CONTINUE + Y( JY ) = Y( JY ) + ALPHA*TEMP + JY = JY + INCY + 100 CONTINUE + ELSE + DO 120, J = 1, N + TEMP = ZERO + IX = KX + DO 110, I = 1, M + TEMP = TEMP + A( I, J )*X( IX ) + IX = IX + INCX + 110 CONTINUE + Y( JY ) = Y( JY ) + ALPHA*TEMP + JY = JY + INCY + 120 CONTINUE + END IF + END IF +! + RETURN +! +! End of SGEMV . +! + END SUBROUTINE SGEMV + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE STRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, & + B, LDB ) + +! .. Scalar Arguments .. + CHARACTER*1 SIDE, UPLO, TRANSA, DIAG + INTEGER M, N, LDA, LDB + REAL(r8) ALPHA +! .. Array Arguments .. + REAL(r8) A( LDA, * ), B( LDB, * ) +! .. +! +! Purpose +! ======= +! +! STRMM performs one of the matrix-matrix operations +! +! B := alpha*op( A )*B, or B := alpha*B*op( A ), +! +! where alpha is a scalar, B is an m by n matrix, A is a unit, or +! non-unit, upper or lower triangular matrix and op( A ) is one of +! +! op( A ) = A or op( A ) = A'. +! +! Parameters +! ========== +! +! SIDE - CHARACTER*1. +! On entry, SIDE specifies whether op( A ) multiplies B from +! the left or right as follows: +! +! SIDE = 'L' or 'l' B := alpha*op( A )*B. +! +! SIDE = 'R' or 'r' B := alpha*B*op( A ). +! +! Unchanged on exit. +! +! UPLO - CHARACTER*1. +! On entry, UPLO specifies whether the matrix A is an upper or +! lower triangular matrix as follows: +! +! UPLO = 'U' or 'u' A is an upper triangular matrix. +! +! UPLO = 'L' or 'l' A is a lower triangular matrix. +! +! Unchanged on exit. +! +! TRANSA - CHARACTER*1. +! On entry, TRANSA specifies the form of op( A ) to be used in +! the matrix multiplication as follows: +! +! TRANSA = 'N' or 'n' op( A ) = A. +! +! TRANSA = 'T' or 't' op( A ) = A'. +! +! TRANSA = 'C' or 'c' op( A ) = A'. +! +! Unchanged on exit. +! +! DIAG - CHARACTER*1. +! On entry, DIAG specifies whether or not A is unit triangular +! as follows: +! +! DIAG = 'U' or 'u' A is assumed to be unit triangular. +! +! DIAG = 'N' or 'n' A is not assumed to be unit +! triangular. +! +! Unchanged on exit. +! +! M - INTEGER. +! On entry, M specifies the number of rows of B. M must be at +! least zero. +! Unchanged on exit. +! +! N - INTEGER. +! On entry, N specifies the number of columns of B. N must be +! at least zero. +! Unchanged on exit. +! +! ALPHA - REAL . +! On entry, ALPHA specifies the scalar alpha. When alpha is +! zero then A is not referenced and B need not be set before +! entry. +! Unchanged on exit. +! +! A - REAL array of DIMENSION ( LDA, k ), where k is m +! when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. +! Before entry with UPLO = 'U' or 'u', the leading k by k +! upper triangular part of the array A must contain the upper +! triangular matrix and the strictly lower triangular part of +! A is not referenced. +! Before entry with UPLO = 'L' or 'l', the leading k by k +! lower triangular part of the array A must contain the lower +! triangular matrix and the strictly upper triangular part of +! A is not referenced. +! Note that when DIAG = 'U' or 'u', the diagonal elements of +! A are not referenced either, but are assumed to be unity. +! Unchanged on exit. +! +! LDA - INTEGER. +! On entry, LDA specifies the first dimension of A as declared +! in the calling (sub) program. When SIDE = 'L' or 'l' then +! LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' +! then LDA must be at least max( 1, n ). +! Unchanged on exit. +! +! B - REAL array of DIMENSION ( LDB, n ). +! Before entry, the leading m by n part of the array B must +! contain the matrix B, and on exit is overwritten by the +! transformed matrix. +! +! LDB - INTEGER. +! On entry, LDB specifies the first dimension of B as declared +! in the calling (sub) program. LDB must be at least +! max( 1, m ). +! Unchanged on exit. +! +! +! Level 3 Blas routine. +! +! -- Written on 8-February-1989. +! Jack Dongarra, Argonne National Laboratory. +! Iain Duff, AERE Harwell. +! Jeremy Du Croz, Numerical Algorithms Group Ltd. +! Sven Hammarling, Numerical Algorithms Group Ltd. +! +! +! .. Local Scalars .. + LOGICAL LSIDE, NOUNIT, UPPER + INTEGER I, INFO, J, K, NROWA + REAL(r8) TEMP +! .. Parameters .. + REAL(r8) ONE , ZERO + PARAMETER ( ONE = 1.0E+0_r8, ZERO = 0.0E+0_r8 ) +! .. +! .. Executable Statements .. +! +! Test the input parameters. +! + LSIDE = LSAME( SIDE , 'L' ) + IF( LSIDE )THEN + NROWA = M + ELSE + NROWA = N + END IF + NOUNIT = LSAME( DIAG , 'N' ) + UPPER = LSAME( UPLO , 'U' ) +! + INFO = 0 + IF( ( .NOT.LSIDE ).AND. & + ( .NOT.LSAME( SIDE , 'R' ) ) )THEN + INFO = 1 + ELSE IF( ( .NOT.UPPER ).AND. & + ( .NOT.LSAME( UPLO , 'L' ) ) )THEN + INFO = 2 + ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND. & + ( .NOT.LSAME( TRANSA, 'T' ) ).AND. & + ( .NOT.LSAME( TRANSA, 'C' ) ) )THEN + INFO = 3 + ELSE IF( ( .NOT.LSAME( DIAG , 'U' ) ).AND. & + ( .NOT.LSAME( DIAG , 'N' ) ) )THEN + INFO = 4 + ELSE IF( M .LT.0 )THEN + INFO = 5 + ELSE IF( N .LT.0 )THEN + INFO = 6 + ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN + INFO = 9 + ELSE IF( LDB.LT.MAX( 1, M ) )THEN + INFO = 11 + END IF + IF( INFO.NE.0 )THEN + CALL XERBLA( 'STRMM ', INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( N.EQ.0 ) & + RETURN +! +! And when alpha.eq.zero. +! + IF( ALPHA.EQ.ZERO )THEN + DO 20, J = 1, N + DO 10, I = 1, M + B( I, J ) = ZERO + 10 CONTINUE + 20 CONTINUE + RETURN + END IF +! +! Start the operations. +! + IF( LSIDE )THEN + IF( LSAME( TRANSA, 'N' ) )THEN +! +! Form B := alpha*A*B. +! + IF( UPPER )THEN + DO 50, J = 1, N + DO 40, K = 1, M + IF( B( K, J ).NE.ZERO )THEN + TEMP = ALPHA*B( K, J ) + DO 30, I = 1, K - 1 + B( I, J ) = B( I, J ) + TEMP*A( I, K ) + 30 CONTINUE + IF( NOUNIT ) & + TEMP = TEMP*A( K, K ) + B( K, J ) = TEMP + END IF + 40 CONTINUE + 50 CONTINUE + ELSE + DO 80, J = 1, N + DO 70 K = M, 1, -1 + IF( B( K, J ).NE.ZERO )THEN + TEMP = ALPHA*B( K, J ) + B( K, J ) = TEMP + IF( NOUNIT ) & + B( K, J ) = B( K, J )*A( K, K ) + DO 60, I = K + 1, M + B( I, J ) = B( I, J ) + TEMP*A( I, K ) + 60 CONTINUE + END IF + 70 CONTINUE + 80 CONTINUE + END IF + ELSE +! +! Form B := alpha*A'*B. +! + IF( UPPER )THEN + DO 110, J = 1, N + DO 100, I = M, 1, -1 + TEMP = B( I, J ) + IF( NOUNIT ) & + TEMP = TEMP*A( I, I ) + DO 90, K = 1, I - 1 + TEMP = TEMP + A( K, I )*B( K, J ) + 90 CONTINUE + B( I, J ) = ALPHA*TEMP + 100 CONTINUE + 110 CONTINUE + ELSE + DO 140, J = 1, N + DO 130, I = 1, M + TEMP = B( I, J ) + IF( NOUNIT ) & + TEMP = TEMP*A( I, I ) + DO 120, K = I + 1, M + TEMP = TEMP + A( K, I )*B( K, J ) + 120 CONTINUE + B( I, J ) = ALPHA*TEMP + 130 CONTINUE + 140 CONTINUE + END IF + END IF + ELSE + IF( LSAME( TRANSA, 'N' ) )THEN +! +! Form B := alpha*B*A. +! + IF( UPPER )THEN + DO 180, J = N, 1, -1 + TEMP = ALPHA + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 150, I = 1, M + B( I, J ) = TEMP*B( I, J ) + 150 CONTINUE + DO 170, K = 1, J - 1 + IF( A( K, J ).NE.ZERO )THEN + TEMP = ALPHA*A( K, J ) + DO 160, I = 1, M + B( I, J ) = B( I, J ) + TEMP*B( I, K ) + 160 CONTINUE + END IF + 170 CONTINUE + 180 CONTINUE + ELSE + DO 220, J = 1, N + TEMP = ALPHA + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 190, I = 1, M + B( I, J ) = TEMP*B( I, J ) + 190 CONTINUE + DO 210, K = J + 1, N + IF( A( K, J ).NE.ZERO )THEN + TEMP = ALPHA*A( K, J ) + DO 200, I = 1, M + B( I, J ) = B( I, J ) + TEMP*B( I, K ) + 200 CONTINUE + END IF + 210 CONTINUE + 220 CONTINUE + END IF + ELSE +! +! Form B := alpha*B*A'. +! + IF( UPPER )THEN + DO 260, K = 1, N + DO 240, J = 1, K - 1 + IF( A( J, K ).NE.ZERO )THEN + TEMP = ALPHA*A( J, K ) + DO 230, I = 1, M + B( I, J ) = B( I, J ) + TEMP*B( I, K ) + 230 CONTINUE + END IF + 240 CONTINUE + TEMP = ALPHA + IF( NOUNIT ) & + TEMP = TEMP*A( K, K ) + IF( TEMP.NE.ONE )THEN + DO 250, I = 1, M + B( I, K ) = TEMP*B( I, K ) + 250 CONTINUE + END IF + 260 CONTINUE + ELSE + DO 300, K = N, 1, -1 + DO 280, J = K + 1, N + IF( A( J, K ).NE.ZERO )THEN + TEMP = ALPHA*A( J, K ) + DO 270, I = 1, M + B( I, J ) = B( I, J ) + TEMP*B( I, K ) + 270 CONTINUE + END IF + 280 CONTINUE + TEMP = ALPHA + IF( NOUNIT ) & + TEMP = TEMP*A( K, K ) + IF( TEMP.NE.ONE )THEN + DO 290, I = 1, M + B( I, K ) = TEMP*B( I, K ) + 290 CONTINUE + END IF + 300 CONTINUE + END IF + END IF + END IF +! + RETURN +! +! End of STRMM . +! + END SUBROUTINE STRMM + +!--------1---------2---------3---------4---------5---------6---------7---------8 + + SUBROUTINE STRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) + +! .. Scalar Arguments .. + INTEGER INCX, LDA, N + CHARACTER*1 DIAG, TRANS, UPLO +! .. Array Arguments .. + REAL(r8) A( LDA, * ), X( * ) +! .. +! +! Purpose +! ======= +! +! STRMV performs one of the matrix-vector operations +! +! x := A*x, or x := A'*x, +! +! where x is an n element vector and A is an n by n unit, or non-unit, +! upper or lower triangular matrix. +! +! Parameters +! ========== +! +! UPLO - CHARACTER*1. +! On entry, UPLO specifies whether the matrix is an upper or +! lower triangular matrix as follows: +! +! UPLO = 'U' or 'u' A is an upper triangular matrix. +! +! UPLO = 'L' or 'l' A is a lower triangular matrix. +! +! Unchanged on exit. +! +! TRANS - CHARACTER*1. +! On entry, TRANS specifies the operation to be performed as +! follows: +! +! TRANS = 'N' or 'n' x := A*x. +! +! TRANS = 'T' or 't' x := A'*x. +! +! TRANS = 'C' or 'c' x := A'*x. +! +! Unchanged on exit. +! +! DIAG - CHARACTER*1. +! On entry, DIAG specifies whether or not A is unit +! triangular as follows: +! +! DIAG = 'U' or 'u' A is assumed to be unit triangular. +! +! DIAG = 'N' or 'n' A is not assumed to be unit +! triangular. +! +! Unchanged on exit. +! +! N - INTEGER. +! On entry, N specifies the order of the matrix A. +! N must be at least zero. +! Unchanged on exit. +! +! A - REAL array of DIMENSION ( LDA, n ). +! Before entry with UPLO = 'U' or 'u', the leading n by n +! upper triangular part of the array A must contain the upper +! triangular matrix and the strictly lower triangular part of +! A is not referenced. +! Before entry with UPLO = 'L' or 'l', the leading n by n +! lower triangular part of the array A must contain the lower +! triangular matrix and the strictly upper triangular part of +! A is not referenced. +! Note that when DIAG = 'U' or 'u', the diagonal elements of +! A are not referenced either, but are assumed to be unity. +! Unchanged on exit. +! +! LDA - INTEGER. +! On entry, LDA specifies the first dimension of A as declared +! in the calling (sub) program. LDA must be at least +! max( 1, n ). +! Unchanged on exit. +! +! X - REAL array of dimension at least +! ( 1 + ( n - 1 )*abs( INCX ) ). +! Before entry, the incremented array X must contain the n +! element vector x. On exit, X is overwritten with the +! tranformed vector x. +! +! INCX - INTEGER. +! On entry, INCX specifies the increment for the elements of +! X. INCX must not be zero. +! Unchanged on exit. +! +! +! Level 2 Blas routine. +! +! -- Written on 22-October-1986. +! Jack Dongarra, Argonne National Lab. +! Jeremy Du Croz, Nag Central Office. +! Sven Hammarling, Nag Central Office. +! Richard Hanson, Sandia National Labs. +! +! +! .. Parameters .. + REAL(r8) ZERO + PARAMETER ( ZERO = 0.0E+0_r8 ) +! .. Local Scalars .. + REAL(r8) TEMP + INTEGER I, INFO, IX, J, JX, KX + LOGICAL NOUNIT +! .. +! .. Executable Statements .. +! +! Test the input parameters. +! + INFO = 0 + IF ( .NOT.LSAME( UPLO , 'U' ).AND. & + .NOT.LSAME( UPLO , 'L' ) )THEN + INFO = 1 + ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND. & + .NOT.LSAME( TRANS, 'T' ).AND. & + .NOT.LSAME( TRANS, 'C' ) )THEN + INFO = 2 + ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND. & + .NOT.LSAME( DIAG , 'N' ) )THEN + INFO = 3 + ELSE IF( N.LT.0 )THEN + INFO = 4 + ELSE IF( LDA.LT.MAX( 1, N ) )THEN + INFO = 6 + ELSE IF( INCX.EQ.0 )THEN + INFO = 8 + END IF + IF( INFO.NE.0 )THEN + CALL XERBLA( 'STRMV ', INFO ) + RETURN + END IF +! +! Quick return if possible. +! + IF( N.EQ.0 ) & + RETURN +! + NOUNIT = LSAME( DIAG, 'N' ) +! +! Set up the start point in X if the increment is not unity. This +! will be ( N - 1 )*INCX too small for descending loops. +! + IF( INCX.LE.0 )THEN + KX = 1 - ( N - 1 )*INCX + ELSE IF( INCX.NE.1 )THEN + KX = 1 + END IF +! +! Start the operations. In this version the elements of A are +! accessed sequentially with one pass through A. +! + IF( LSAME( TRANS, 'N' ) )THEN +! +! Form x := A*x. +! + IF( LSAME( UPLO, 'U' ) )THEN + IF( INCX.EQ.1 )THEN + DO 20, J = 1, N + IF( X( J ).NE.ZERO )THEN + TEMP = X( J ) + DO 10, I = 1, J - 1 + X( I ) = X( I ) + TEMP*A( I, J ) + 10 CONTINUE + IF( NOUNIT ) & + X( J ) = X( J )*A( J, J ) + END IF + 20 CONTINUE + ELSE + JX = KX + DO 40, J = 1, N + IF( X( JX ).NE.ZERO )THEN + TEMP = X( JX ) + IX = KX + DO 30, I = 1, J - 1 + X( IX ) = X( IX ) + TEMP*A( I, J ) + IX = IX + INCX + 30 CONTINUE + IF( NOUNIT ) & + X( JX ) = X( JX )*A( J, J ) + END IF + JX = JX + INCX + 40 CONTINUE + END IF + ELSE + IF( INCX.EQ.1 )THEN + DO 60, J = N, 1, -1 + IF( X( J ).NE.ZERO )THEN + TEMP = X( J ) + DO 50, I = N, J + 1, -1 + X( I ) = X( I ) + TEMP*A( I, J ) + 50 CONTINUE + IF( NOUNIT ) & + X( J ) = X( J )*A( J, J ) + END IF + 60 CONTINUE + ELSE + KX = KX + ( N - 1 )*INCX + JX = KX + DO 80, J = N, 1, -1 + IF( X( JX ).NE.ZERO )THEN + TEMP = X( JX ) + IX = KX + DO 70, I = N, J + 1, -1 + X( IX ) = X( IX ) + TEMP*A( I, J ) + IX = IX - INCX + 70 CONTINUE + IF( NOUNIT ) & + X( JX ) = X( JX )*A( J, J ) + END IF + JX = JX - INCX + 80 CONTINUE + END IF + END IF + ELSE +! +! Form x := A'*x. +! + IF( LSAME( UPLO, 'U' ) )THEN + IF( INCX.EQ.1 )THEN + DO 100, J = N, 1, -1 + TEMP = X( J ) + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 90, I = J - 1, 1, -1 + TEMP = TEMP + A( I, J )*X( I ) + 90 CONTINUE + X( J ) = TEMP + 100 CONTINUE + ELSE + JX = KX + ( N - 1 )*INCX + DO 120, J = N, 1, -1 + TEMP = X( JX ) + IX = JX + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 110, I = J - 1, 1, -1 + IX = IX - INCX + TEMP = TEMP + A( I, J )*X( IX ) + 110 CONTINUE + X( JX ) = TEMP + JX = JX - INCX + 120 CONTINUE + END IF + ELSE + IF( INCX.EQ.1 )THEN + DO 140, J = 1, N + TEMP = X( J ) + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 130, I = J + 1, N + TEMP = TEMP + A( I, J )*X( I ) + 130 CONTINUE + X( J ) = TEMP + 140 CONTINUE + ELSE + JX = KX + DO 160, J = 1, N + TEMP = X( JX ) + IX = JX + IF( NOUNIT ) & + TEMP = TEMP*A( J, J ) + DO 150, I = J + 1, N + IX = IX + INCX + TEMP = TEMP + A( I, J )*X( IX ) + 150 CONTINUE + X( JX ) = TEMP + JX = JX + INCX + 160 CONTINUE + END IF + END IF + END IF +! + RETURN +! +! End of STRMV . +! + END SUBROUTINE STRMV + +!--------1---------2---------3---------4---------5---------6---------7---------8 + +end module sgexx diff --git a/src/utils/spmd_utils.F90 b/src/utils/spmd_utils.F90 new file mode 100644 index 0000000000..d768c47ab3 --- /dev/null +++ b/src/utils/spmd_utils.F90 @@ -0,0 +1,1665 @@ +module spmd_utils + +!----------------------------------------------------------------------- +! +! Purpose: This module is responsible for miscellaneous SPMD utilities +! and information that are shared between dynamics and +! physics packages. +! +! Author: +! Original routines: CMS +! Module: T. Henderson, December 2003 +! swap routines: P. Worley +! fc routines: P. Worley +! SMP node id logic: P. Worley +! +! $Id$ +! +!----------------------------------------------------------------------- + +! +! Performance bug work around for Gemini interconnect +! +#ifdef _NO_MPI_RSEND +#define mpi_rsend mpi_send +#define mpi_irsend mpi_isend +#endif + +!----------------------------------------------------------------------- +!- use statements ------------------------------------------------------ +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + +#if ( defined SPMD ) + use mpishorthand, only: mpiint, mpii8, mpichar, mpilog, mpipk, & + mpic16, mpir8, mpir4, mpicom, mpimax +#endif + use cam_logfile, only: iulog + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + include 'mpif.h' + private ! Make the default access private + save +! +! Forward from mpishorthand.F with the idea of phasing out use of and removing that file +! +#ifndef SPMD + + integer :: mpir8 +#endif +! +! Forward these from mpif.h (or mpi.mod), the idea being that this should +! be the only module that uses mpi directly, the rest of cam should use spmd_utils +! + public :: mpi_max_processor_name, mpi_max_error_string, mpi_error, & + mpi_integer, mpi_integer8, mpi_character, mpi_double_precision, & + mpi_logical, mpi_real8, mpi_real4, mpi_complex16, & + mpi_packed, mpi_tag_ub, mpi_info_null, & + mpi_comm_null, mpi_group_null, mpi_undefined, & + mpi_status_size, mpi_success, mpi_status_ignore, & + mpi_max, mpi_min, mpi_sum, mpi_band, & + mpir8 + + + + + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- + public pair ! $$$here... originally from eul|sld/spmd_dyn + public ceil2 ! $$$here... originally from eul|sld/spmd_dyn + public spmdinit + public spmd_utils_readnl +#if ( defined SPMD ) + public swapm + public fc_gatherv + public fc_gathervr4 + public fc_gathervint + public fc_gathervc + public altalltoallv +#endif + +!----------------------------------------------------------------------- +! Public data ---------------------------------------------------------- +!----------------------------------------------------------------------- +! physics-motivated dynamics decomposition request + logical, parameter :: def_mirror = .false. ! default + logical, public :: phys_mirror_decomp_req = def_mirror + ! flag indicating whether latitudes and their + ! reflections across the equator should be + ! assigned to consecutive processes + +#if (defined SPMD) + public :: mpicom + public :: mpichar +#else + integer, public :: mpicom + integer, public :: mpichar +#endif + logical, public :: masterproc + integer, public :: masterprocid + integer, public :: iam + integer, public :: npes + integer, public :: nsmps + integer, allocatable, public :: proc_smp_map(:) + integer, parameter :: DEFAULT_MASTERPROC=0 + ! the value of iam which is assigned + ! the masterproc duties + +!----------------------------------------------------------------------- +! Private data --------------------------------------------------------- +!----------------------------------------------------------------------- +! Swap communication protocol options (reduced set): +! 3, 5: nonblocking send +! 2, 3, 4, 5: nonblocking receive +! 4, 5: ready send + integer, private, parameter :: min_comm_protocol = 2 + integer, private, parameter :: max_comm_protocol = 5 + integer, private, parameter :: def_comm_protocol = 4 ! default + integer, public :: swap_comm_protocol = def_comm_protocol + +! Swap communication maximum request count: +! = -1,0: do not limit number of outstanding send/receive requests +! > 0: do not allow more than swap_comm_maxreq outstanding +! nonblocking send requests or nonblocking receive requests + integer, private, parameter :: def_comm_maxreq = 128 ! default + integer, public :: swap_comm_maxreq = def_comm_maxreq + +! Flow-controlled gather option: +! < 0: use MPI_Gather +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! min(max(1,fc_gather_flow_cntl),max_gather_block_size) +! ahead + integer, private, parameter :: max_gather_block_size = 64 ! max and default + integer, public :: fc_gather_flow_cntl = max_gather_block_size + +!----------------------------------------------------------------------- +! Subroutines and functions -------------------------------------------- +!----------------------------------------------------------------------- +contains + +!======================================================================== + + integer function pair(np,p,k) + + integer np,p,k,q + q = ieor(p,k) + if(q.gt.np-1) then + pair = -1 + else + pair = q + endif + return + + end function pair + +!======================================================================== + + integer function ceil2(n) + integer n,p + p=1 + do while(p.lt.n) + p=p*2 + enddo + ceil2=p + return + end function ceil2 + +!======================================================================== + + subroutine spmdinit( mpicom_atm ) + !----------------------------------------------------------------------- + ! + ! Purpose: MPI initialization routine: + ! + ! Method: get number of cpus, processes, tids, etc + ! dynamics and physics decompositions are set up later + ! + ! Author: CCM Core Group + ! + !----------------------------------------------------------------------- + + implicit none + integer, intent(in) :: mpicom_atm + +#if ( defined SPMD ) + ! + ! Local workspace + ! + integer i,j,c ! indices + integer npthreads ! thread status + integer ier ! return error status + integer length ! length of name + integer max_len ! maximum name length + integer, allocatable :: lengths(:)! max lengths of names for use in gatherv + integer, allocatable :: displs(:) ! offsets for use in gatherv + logical done + character, allocatable :: proc_name(:) ! processor name, this task + character, allocatable :: proc_names(:) ! processor names, all tasks + character(len=mpi_max_processor_name) :: tmp_name ! temporary storage + character(len=mpi_max_processor_name), allocatable :: smp_names(:) ! SMP name + logical mpi_running ! returned value indicates if MPI_INIT has been called + + !--------------------------------------------------------------------------- + ! + ! Determine CAM MPI communicator group + ! + mpicom = mpicom_atm + ! + ! Set mpishorthand variables. Need to set as variables rather than parameters since + ! some MPI implementations set values for MPI tags at run time + ! + mpiint = mpi_integer + mpii8 = mpi_integer8 + mpichar = mpi_character + mpilog = mpi_logical + mpir4 = mpi_real4 + mpir8 = mpi_real8 + mpic16 = mpi_complex16 + mpipk = mpi_packed + mpimax = mpi_max + ! + ! Get my id + ! + call mpi_comm_rank (mpicom, iam, ier) + masterprocid = DEFAULT_MASTERPROC + if (iam == DEFAULT_MASTERPROC) then + masterproc = .true. + else + masterproc = .false. + end if + ! + ! Get number of processors + ! + max_len = mpi_max_processor_name + call mpi_comm_size (mpicom, npes, ier) + allocate ( displs(npes) ) + allocate ( lengths(npes) ) + allocate ( proc_name(max_len) ) + allocate ( proc_names(max_len*npes) ) + + ! + ! Get processor names and send to root. + ! + call mpi_get_processor_name (tmp_name, length, ier) + proc_name(:) = ' ' + do i = 1, length + proc_name(i) = tmp_name(i:i) + end do + + proc_names(:) = ' ' + lengths(:) = max_len + do i=1,npes + displs(i) = (i-1)*max_len + enddo + call fc_gathervc (proc_name, max_len, mpichar, & + proc_names, lengths, displs, mpichar, & + 0, mpicom, flow_cntl=-1) + if (masterproc) then + write(iulog,*) npes, 'pes participating in computation' + write(iulog,*) '-----------------------------------' + write(iulog,*) 'TASK# NAME' + do i=0,min(npes-1,256) ! dont print too many of these + do c=1,max_len + tmp_name(c:c) = proc_names(i*max_len+c) + enddo + write(iulog,'(i3,2x,a)') i,trim(tmp_name) + end do + if(npes-1>256) then + write(iulog,*) '... list truncated at 256' + end if + end if + ! + ! Identify SMP nodes and process/SMP mapping. + ! (Assume that processor names are SMP node names on SMP clusters.) + ! + allocate ( proc_smp_map(0:npes-1) ) + if (masterproc) then + allocate ( smp_names(0:npes-1) ) + smp_names(:) = ' ' + proc_smp_map(:) = -1 + ! + nsmps = 1 + do c=1,max_len + tmp_name(c:c) = proc_names(c) + enddo + smp_names(0) = trim(tmp_name) + proc_smp_map(0) = 0 + ! + do i=1,npes-1 + do c=1,max_len + tmp_name(c:c) = proc_names(i*max_len+c) + enddo + + j = 0 + done = .false. + do while ((.not. done) .and. (j < nsmps)) + if (smp_names(j) .eq. trim(tmp_name)) then + proc_smp_map(i) = j + done = .true. + endif + j = j + 1 + enddo + + if (.not. done) then + smp_names(nsmps) = trim(tmp_name) + proc_smp_map(i) = nsmps + nsmps = nsmps + 1 + endif + + enddo + deallocate(smp_names) + endif + call mpibcast(nsmps, 1, mpiint, 0, mpicom) + call mpibcast(proc_smp_map, npes, mpiint, 0, mpicom) + ! + deallocate(displs) + deallocate(lengths) + deallocate(proc_name) + deallocate(proc_names) + +#else + ! + ! spmd is not defined + ! + mpicom = mpicom_atm + iam = 0 + masterprocid = 0 + masterproc = .true. + npes = 1 + nsmps = 1 + allocate ( proc_smp_map(0:0) ) + proc_smp_map(:) = -1 + +#endif + + end subroutine spmdinit + +#if (defined SPMD) +! +!======================================================================== +! + subroutine swapm (steps, nprocs, swapids, & + sndbuf, sbuf_siz, sndlths, sdispls, & + rcvbuf, rbuf_siz, rcvlths, rdispls, & + comm, comm_protocol, comm_maxreq ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Reduced version of original swapm (for swap of multiple messages +! using MPI point-to-point routines), more efficiently implementing a +! subset of the swap protocols. +! +! Method: +! comm_protocol: +! = 3 or 5: use nonblocking send +! = 2 or 4: use blocking send +! = 4 or 5: use handshaking protocol +! comm_maxreq: +! =-1,0: do not limit number of outstanding send/receive requests +! >0: do not allow more than min(comm_maxreq, steps) outstanding +! nonblocking send requests or nonblocking receive requests +! +! Author of original version: P. Worley +! Ported to CAM: P. Worley, December 2003 +! Simplified version: P. Worley, October, 2008 +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + implicit none +!---------------------------Input arguments-------------------------- +! + integer, intent(in) :: steps ! number of swaps to initiate + integer, intent(in) :: nprocs ! size of communicator + integer, intent(in) :: sbuf_siz ! size of send buffer + integer, intent(in) :: rbuf_siz ! size of receive buffer + integer, intent(in) :: swapids(steps) ! MPI process id of swap partners + + integer, intent(in) :: sndlths(0:nprocs-1)! length of outgoing message + integer, intent(in) :: sdispls(0:nprocs-1)! offset from beginning of send + ! buffer where outgoing messages + ! should be sent from + integer, intent(in) :: rcvlths(0:nprocs-1)! length of incoming messages + integer, intent(in) :: rdispls(0:nprocs-1)! offset from beginning of receive + ! buffer where incoming messages + ! should be placed + real(r8), intent(in) :: sndbuf(sbuf_siz) ! outgoing message buffer + real(r8), intent(out) :: rcvbuf(rbuf_siz) ! incoming message buffer + + integer, intent(in) :: comm ! MPI communicator + integer, intent(in) :: comm_protocol ! swap_comm protocol + integer, intent(in) :: comm_maxreq ! maximum number of outstanding + ! nonblocking requests + +! +!---------------------------Local workspace----------------------------- +! + integer :: p ! process index + integer :: istep ! loop index + integer :: offset_s ! index of message beginning in + ! send buffer + integer :: offset_r ! index of message beginning in + ! receive buffer + integer :: sndids(steps) ! send request ids + integer :: rcvids(steps) ! receive request ids + integer :: hs_rcvids(steps) ! handshake receive request ids + + integer :: maxreq, maxreqh ! maximum number of outstanding + ! nonblocking requests (and half) + integer :: hs_s, hs_r(steps) ! handshake variables (send/receive) + integer :: rstep ! "receive" step index + + logical :: handshake, sendd ! protocol option flags + + integer :: ier ! return error status + integer :: status(MPI_STATUS_SIZE) ! MPI status +! +!------------------------------------------------------------------------------------- +! + if (steps .eq. 0) return + + ! identify communication protocol + if ((comm_protocol < 2) .or. (comm_protocol > 5)) then + sendd = .true. + handshake = .true. + else + if ((comm_protocol .eq. 4) .or. (comm_protocol .eq. 5)) then + handshake = .true. + else + handshake = .false. + endif + + if ((comm_protocol .eq. 2) .or. (comm_protocol .eq. 4)) then + sendd = .true. + else + sendd = .false. + endif + endif + + ! identify maximum number of outstanding nonblocking requests to permit + if (steps .eq. 1) then + maxreq = 1 + maxreqh = 1 + else + if (comm_maxreq >= -1) then + maxreq = comm_maxreq + else + maxreq = steps + endif + + if ((maxreq .le. steps) .and. (maxreq > 0)) then + if (maxreq > 1) then + maxreqh = maxreq/2 + else + maxreq = 2 + maxreqh = 1 + endif + else + maxreq = steps + maxreqh = steps + endif + endif + +! Four protocol options: +! (1) handshaking + blocking sends + if ((handshake) .and. (sendd)) then + + ! Initialize handshake variable + hs_s = 1 + + ! Post initial handshake receive requests + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv( hs_r(istep), 1, mpiint, p, iam, comm, & + hs_rcvids(istep), ier ) + endif + enddo + + ! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(istep), ier ) + call mpi_send ( hs_s, 1, mpiint, p, p, comm, ier ) + endif + enddo + rstep = maxreq + + ! Send (and start receiving) data + do istep=1,steps + p = swapids(istep) + + ! Submit new rsend request + if (sndlths(p) > 0) then + offset_s = sdispls(p)+1 + call mpi_wait ( hs_rcvids(istep), MPI_STATUS_IGNORE, ier ) + call mpi_rsend ( sndbuf(offset_s), sndlths(p), mpir8, p, iam, & + comm, ier ) + endif + + if (istep > maxreqh) then + + ! Wait for oldest irecv request to complete + p = swapids(istep-maxreqh) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep-maxreqh), status, ier ) + endif + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + + ! Submit a new handshake irecv request + if (sndlths(p) > 0) then + call mpi_irecv( hs_r(rstep), 1, mpiint, p, iam, comm, & + hs_rcvids(rstep), ier ) + endif + + ! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(rstep), ier ) + call mpi_send ( hs_s, 1, mpiint, p, p, comm, ier ) + endif + endif + + endif +! + enddo + + ! wait for rest of receive requests to complete + do istep=steps-maxreqh+1,steps + p = swapids(istep) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep), status, ier ) + endif + enddo + +! (2) handshaking + nonblocking sends + elseif ((handshake) .and. (.not. sendd)) then + + ! Initialize handshake variable + hs_s = 1 + + ! Post initial handshake receive requests + do istep=1,maxreq + p = swapids(istep) + if (sndlths(p) > 0) then + call mpi_irecv( hs_r(istep), 1, mpiint, p, iam, comm, & + hs_rcvids(istep), ier ) + endif + enddo + + ! Post initial receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(istep), ier ) + call mpi_send ( hs_s, 1, mpiint, p, p, comm, ier ) + endif + enddo + rstep = maxreq + + ! Send (and start receiving) data + do istep=1,steps + p = swapids(istep) + + ! Submit new irsend request + if (sndlths(p) > 0) then + offset_s = sdispls(p)+1 + call mpi_wait ( hs_rcvids(istep), MPI_STATUS_IGNORE, ier ) + call mpi_irsend( sndbuf(offset_s), sndlths(p), mpir8, p, iam, & + comm, sndids(istep), ier ) + endif + + if (istep > maxreqh) then + + ! Wait for oldest irecv request to complete + p = swapids(istep-maxreqh) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep-maxreqh), status, ier ) + endif + + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + + ! Submit a new handshake irecv request + if (sndlths(p) > 0) then + call mpi_irecv( hs_r(rstep), 1, mpiint, p, iam, comm, & + hs_rcvids(rstep), ier ) + endif + + ! Submit a new irecv request + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(rstep), ier ) + call mpi_send ( hs_s, 1, mpiint, p, p, comm, ier ) + endif + endif + + ! Wait for outstanding i(r)send request to complete + p = swapids(istep-maxreqh) + if (sndlths(p) > 0) then + call mpi_wait( sndids(istep-maxreqh), status, ier ) + endif + + endif + + enddo + + ! wait for rest of send and receive requests to complete + do istep=steps-maxreqh+1,steps + p = swapids(istep) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep), status, ier ) + endif + if (sndlths(p) > 0) then + call mpi_wait( sndids(istep), status, ier ) + endif + enddo + +! (3) no handshaking + blocking sends + elseif ((.not. handshake) .and. (sendd)) then + + ! Post receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(istep), ier ) + endif + enddo + rstep = maxreq + + ! Send (and start receiving) data + do istep=1,steps + p = swapids(istep) + + ! Submit new send request + if (sndlths(p) > 0) then + offset_s = sdispls(p)+1 + call mpi_send( sndbuf(offset_s), sndlths(p), mpir8, p, iam, & + comm, ier ) + endif + + if (istep > maxreqh) then + + ! Wait for oldest irecv request to complete + p = swapids(istep-maxreqh) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep-maxreqh), status, ier ) + endif + + ! Submit a new irecv request + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(rstep), ier ) + endif + endif + + endif + + enddo + + ! wait for rest of send and receive requests to complete + do istep=steps-maxreqh+1,steps + p = swapids(istep) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep), status, ier ) + endif + enddo + +! (4) no handshaking + nonblocking sends + elseif ((.not. handshake) .and. (.not. sendd)) then + + ! Post receive requests + do istep=1,maxreq + p = swapids(istep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(istep), ier ) + endif + enddo + rstep = maxreq + + ! Send (and start receiving) data + do istep=1,steps + p = swapids(istep) + + ! Submit new isend request + if (sndlths(p) > 0) then + offset_s = sdispls(p)+1 + call mpi_isend( sndbuf(offset_s), sndlths(p), mpir8, p, iam, & + comm, sndids(istep), ier ) + endif + + if (istep > maxreqh) then + + ! Wait for oldest irecv request to complete + p = swapids(istep-maxreqh) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep-maxreqh), status, ier ) + endif + + ! Submit a new irecv request + if (rstep < steps) then + rstep = rstep + 1 + p = swapids(rstep) + if (rcvlths(p) > 0) then + offset_r = rdispls(p)+1 + call mpi_irecv( rcvbuf(offset_r), rcvlths(p), mpir8, p, p, & + comm, rcvids(rstep), ier ) + endif + endif + + ! Wait for outstanding i(r)send request to complete + p = swapids(istep-maxreqh) + if (sndlths(p) > 0) then + call mpi_wait( sndids(istep-maxreqh), status, ier ) + endif + + endif + + enddo + + ! wait for rest of send and receive requests to complete + do istep=steps-maxreqh+1,steps + p = swapids(istep) + if (rcvlths(p) > 0) then + call mpi_wait( rcvids(istep), status, ier ) + endif + if (sndlths(p) > 0) then + call mpi_wait( sndids(istep), status, ier ) + endif + enddo + + endif + + return + + end subroutine swapm +! +!======================================================================== + +!----------------------------------------------------------------------- +! +! Purpose: gather collective with additional flow control, so as to +! be more robust when used with high process counts. +! If flow_cntl optional parameter +! < 0: use MPI_Gather +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! min(max(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is 64. +! +! Entry points: +! fc_gatherv functionally equivalent to mpi_gatherv +! fc_gathervr4 functionally equivalent to mpi_gatherv for real*4 data +! fc_gathervint functionally equivalent to mpi_gatherv for integer data +! fc_gathervc functionally equivalent to mpi_gatherv for character data +! +! Author: P. Worley +!----------------------------------------------------------------------- + +! +!======================================================================== +! + subroutine fc_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! Collects different messages from each process on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in) :: sendbuf(*) + real (r8), intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + + real (r8) :: signal + logical fc_gather ! use explicit flow control? + integer gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer ier ! MPI error code + + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + if (fc_gather_flow_cntl >= 0) then + gather_block_size = min(max(1,fc_gather_flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + endif + + if (fc_gather) then + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('fc_gatherv_r8') +#endif + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + +! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, mpir8, p, mtag, comm, ier ) + end if + end if + end do + +! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + +! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, mpir8, root, mtag, comm, & + status, ier ) + call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + if (ier /= mpi_success) then + write(iulog,*)'fc_gatherv_r8 failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('fc_gatherv_r8') +#endif + + else + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + endif + + return + end subroutine fc_gatherv +! +!======================================================================== +! + subroutine fc_gathervr4 (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! Collects different messages from each process on masterproc +! + use shr_kind_mod, only: r4 => shr_kind_r4, r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r4), intent(in) :: sendbuf(*) + real (r4), intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + + real (r8) :: signal + logical fc_gather ! use explicit flow control? + integer gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer ier ! MPI error code + + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + if (fc_gather_flow_cntl >= 0) then + gather_block_size = min(max(1,fc_gather_flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + endif + + if (fc_gather) then + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('fc_gatherv_r4') +#endif + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + +! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, mpir8, p, mtag, comm, ier ) + end if + end if + end do + +! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + +! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, mpir8, root, mtag, comm, & + status, ier ) + call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + if (ier /= mpi_success) then + write(iulog,*)'fc_gatherv_r4 failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('fc_gatherv_r4') +#endif + + else + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + endif + + return + end subroutine fc_gathervr4 +! +!======================================================================== +! + subroutine fc_gathervint (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! Collects different messages from each process on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: sendbuf(*) + integer, intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + + real (r8) :: signal + logical fc_gather ! use explicit flow control? + integer gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer ier ! MPI error code + + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + if (fc_gather_flow_cntl >= 0) then + gather_block_size = min(max(1,fc_gather_flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + endif + + if (fc_gather) then + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('fc_gatherv_int') +#endif + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + +! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, mpir8, p, mtag, comm, ier ) + end if + end if + end do + +! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + +! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, mpir8, root, mtag, comm, & + status, ier ) + call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + if (ier /= mpi_success) then + write(iulog,*)'fc_gatherv_int failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('fc_gatherv_int') +#endif + + else + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + endif + + return + end subroutine fc_gathervint +! +!======================================================================== +! + subroutine fc_gathervc (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! Collects different messages from each process on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + character, intent(in) :: sendbuf(*) + character, intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + + real (r8) :: signal + logical fc_gather ! use explicit flow control? + integer gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer ier ! MPI error code + + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + if (fc_gather_flow_cntl >= 0) then + gather_block_size = min(max(1,fc_gather_flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + endif + + if (fc_gather) then + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('fc_gatherv_char') +#endif + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + +! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, mpir8, p, mtag, comm, ier ) + end if + end if + end do + +! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + +! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, mpir8, root, mtag, comm, & + status, ier ) + call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + if (ier /= mpi_success) then + write(iulog,*)'fc_gatherv_char failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('fc_gatherv_char') +#endif + + else + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + endif + + return + end subroutine fc_gathervc +! +!======================================================================== +#endif + +!----------------------------------------------------------------------- +! +! Purpose: implementations of MPI_Alltoall using different messaging +! layers and different communication protocols, controlled +! by option argument: +! 0: use mpi_alltoallv +! 1: use point-to-point MPI-1 two-sided implementation +! 2: use point-to-point MPI-2 one-sided implementation if supported, +! otherwise use MPI-1 implementation +! 3: use Co-Array Fortran implementation if supported, +! otherwise use MPI-1 implementation +! otherwise use mpi_sendrecv implementation +! +! Entry points: +! altalltoallv +! +! Author: P. Worley +!----------------------------------------------------------------------- + +#if (defined SPMD) +!**************************************************************** + subroutine altalltoallv (option, mytid, nprocs, steps, dests, & + sendbuf, sbuf_siz, sendcnts, sdispls, sendtype, & + recvbuf, rbuf_siz, recvcnts, rdispls, recvtype, & + msgtag, pdispls, desttype, recvwin, comm) +! +! All-to-all scatter/gather implemented using Co-Array +! Fortran one-sided commands, MPI-2 one sided commands, +! SWAP module MPI-1 commands, MPI_ALLTOALLV or MPI_SENDRECV. +! +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: option ! 0: mpi_alltoallv + ! 1: swap package + ! 2: mpi2 + ! 3: co-array fortran + ! otherwise: sendrecv + integer, intent(in) :: mytid + integer, intent(in) :: nprocs + integer, intent(in) :: steps + integer, intent(in) :: dests(steps) + integer, intent(in) :: sbuf_siz + integer, intent(in) :: sendcnts(0:nprocs-1) + integer, intent(in) :: sdispls(0:nprocs-1) + integer, intent(in) :: sendtype + integer, intent(in) :: rbuf_siz + integer, intent(in) :: recvcnts(0:nprocs-1) + integer, intent(in) :: rdispls(0:nprocs-1) + integer, intent(in) :: recvtype + integer, intent(in) :: msgtag + integer, intent(in) :: pdispls(0:nprocs-1) ! displacement at + ! destination + integer, intent(in) :: desttype + integer, intent(in) :: recvwin + integer, intent(in) :: comm + +#if (defined CAF) + real (r8), intent(in) :: sendbuf(sbuf_siz)[*] + real (r8), intent(out) :: recvbuf(rbuf_siz)[*] + + integer :: istart, iend, jstart, jend +#else + real (r8), intent(in) :: sendbuf(sbuf_siz) + real (r8), intent(out) :: recvbuf(rbuf_siz) +#endif + + integer :: loption ! local copy of option + integer :: dest ! MPI remote process id + integer :: ier ! MPI error code + integer :: i ! loop index + integer :: sndids(steps) ! nonblocking MPI send request ids + integer :: rcvids(steps) ! nonblocking MPI recv request ids + integer :: status(MPI_STATUS_SIZE) +#if ( defined MPI2) + integer(kind=MPI_ADDRESS_KIND) :: ddispls +#endif + +!----------------------------------------------------------------------- + loption = option + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! using MPI library collective MPI_ALLTOALLV +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (loption .eq. 0) then + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_alltoallv') +#endif + call mpi_alltoallv (sendbuf, sendcnts, sdispls, sendtype, & + recvbuf, recvcnts, rdispls, recvtype, & + comm, ier) +! +! test for error + if (ier/=mpi_success) then + write(iulog,*)'altalltoallv (mpi_alltoallv) failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_alltoallv') +#endif + + else + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Co-Array Fortran implementation of alltoallv +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (loption .eq. 3) then + +#if ( defined CAF ) +#if defined( WRAP_MPI_TIMING ) + call t_startf ('caf_alltoallv') +#endif + if (this_image() .ne. (mytid+1)) then + call endrun('altalltoallv (caf_alltoallv) failed: MPI id .ne. CAF id') + endif + + call sync_images() + + do i = 1, steps + dest = dests(i) + if (sendcnts(dest) > 0) then + istart = sdispls(dest)+1 + iend = istart+sendcnts(dest)-1 + jstart = pdispls(dest)+1 + jend = jstart+sendcnts(dest)-1 + recvbuf(jstart:jend)[dest+1] = sendbuf(istart:iend) + end if + end do + + call sync_images() +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('caf_alltoallv') +#endif +#else + loption = -1 +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! MPI-2 one-sided implementation of alltoallv +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + elseif (loption .eq. 2) then +#ifdef MPI2 +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi2_alltoallv') +#endif + call mpi_win_fence(0,recvwin,ier) + do i=1, steps + dest = dests(i) + if (sendcnts(dest) > 0) then + ddispls = pdispls(dest) + call mpi_put(sendbuf(sdispls(dest)+1), sendcnts(dest), sendtype, & + dest, ddispls, sendcnts(dest), desttype, & + recvwin, ier) + endif + end do +! +! wait for completion + call mpi_win_fence(0,recvwin,ier) + if (ier/=mpi_success) then + write(iulog,*)'altalltoallv (mpi2_alltoallv) failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi2_alltoallv') +#endif +#else + loption = -1 +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! MPI-1 two-sided implementation of alltoallv +! using SWAP routines +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + elseif (loption .eq. 1) then +#if defined( WRAP_MPI_TIMING ) + call t_startf ('swap_alltoallv') +#endif + + call swapm(steps, nprocs, dests, & + sendbuf, sbuf_siz, sendcnts, sdispls, & + recvbuf, rbuf_siz, recvcnts, rdispls, & + comm, swap_comm_protocol, swap_comm_maxreq ) +! +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('swap_alltoallv') +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Anything else defined to be MPI_SENDRECV implementation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + else +! + loption = -1 +! + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! MPI_SENDRECV implementation of alltoallv +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (loption .eq. -1) then +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi1_alltoallv') +#endif + do i=1, steps + dest = dests(i) + call mpi_sendrecv (sendbuf(sdispls(dest)+1), sendcnts(dest), & + sendtype, dest, msgtag, & + recvbuf(rdispls(dest)+1), recvcnts(dest), & + recvtype, dest, msgtag, & + comm, status, ier) + end do +! +! test for error + if (ier/=mpi_success) then + write(iulog,*)'altalltoallv (mpi1_alltoallv) failed ier=',ier + call endrun + end if + +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi1_alltoallv') +#endif + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Local copy (if necessary) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (sendcnts(mytid) > 0) then + do i=1,sendcnts(iam) + recvbuf(rdispls(mytid)+i) = sendbuf(sdispls(mytid)+i) + enddo + endif +! + endif +! + return + end subroutine altalltoallv + +#endif + + subroutine spmd_utils_readnl(nlfile) +!----------------------------------------------------------------------- +! +! Purpose: +! Read spmd utils namelist to set swap communication protocol options as +! well as the flow control gather options +! +! Method: +! spmd_utils_readnl: +! +! Author of original version: J. Truesdale +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + implicit none +!---------------------------Input arguments-------------------------- +! + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + +#if ( defined SPMD ) +!---------------------------Local variables-------------------------- +! + integer :: unitn, ierr + character(len=*), parameter :: subname = 'spmd_utils_readnl' + + namelist /spmd_utils_nl/ swap_comm_protocol,swap_comm_maxreq,fc_gather_flow_cntl + +!----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'spmd_utils_nl', status=ierr) + if (ierr == 0) then + read(unitn, spmd_utils_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + write(iulog,*) 'Read in spmd_utils_nl namelist from: ', trim(nlfile) + end if + close(unitn) + call freeunit(unitn) + + + if ((swap_comm_protocol < min_comm_protocol) .or. & + (swap_comm_protocol > max_comm_protocol)) then + write(iulog,*) & + 'SPMD_UTILS_READNL: ERROR: swap_comm_protocol=', & + swap_comm_protocol, ' is out of range.' + write(iulog,*) & + ' It must be between ', min_comm_protocol,' and ',& + max_comm_protocol + write(iulog,*) & + ' Using default value.' + swap_comm_protocol = def_comm_protocol + endif + + write(iulog,*) 'SPMD SWAP_COMM OPTIONS: ' + write(iulog,*) ' swap_comm_protocol = ', swap_comm_protocol + write(iulog,*) ' swap_comm_maxreq = ', swap_comm_maxreq + write(iulog,*) 'SPMD FLOW CONTROL GATHER OPTION: ' + write(iulog,*) ' fc_gather_flow_cntl = ', fc_gather_flow_cntl + endif + + ! Broadcast namelist variables + call mpibcast (swap_comm_protocol , 1, mpiint , 0, mpicom) + call mpibcast (swap_comm_maxreq , 1, mpiint , 0, mpicom) + call mpibcast (fc_gather_flow_cntl, 1, mpiint , 0, mpicom) +#endif + + end subroutine spmd_utils_readnl + + end module spmd_utils + diff --git a/src/utils/srchutil.F90 b/src/utils/srchutil.F90 new file mode 100644 index 0000000000..dff6b714c5 --- /dev/null +++ b/src/utils/srchutil.F90 @@ -0,0 +1,57 @@ +module srchutil + +implicit none + +!----------------------------------------------------------------------- +! +! Purpose: Module containing Fortran equivalents to Cray library functions +! NOTE: some aspects of this code may not meet the CCM coding standard +! +! Author: Lifted from Cray manuals +! +!----------------------------------------------------------------------- +#if (! defined UNICOSMP ) + +CONTAINS + +!=============================================================================== + + subroutine whenieq (n, array, inc, target, index, nval) +!----------------------------------------------------------------------- +! +! Purpose: Determine indices of "array" which equal "target" +! +!----------------------------------------------------------------------- + +! +! Arguments +! + integer, intent(in) :: array(*) ! array to be searched + integer, intent(in) :: target ! value to compare against + integer, intent(in) :: inc ! increment to move through array + + integer, intent(out) :: nval ! number of values meeting criteria + integer, intent(out) :: index(*) ! output array of indices +! +! Local workspace +! + integer :: i + integer :: n + integer :: ina + + ina=1 + nval=0 + if (inc .lt. 0) ina=(-inc)*(n-1)+1 + do i=1,n + if(array(ina) .eq. target) then + nval=nval+1 + index(nval)=i + end if + ina=ina+inc + enddo + return + end subroutine whenieq + +#endif + +end module srchutil diff --git a/src/utils/string_utils.F90 b/src/utils/string_utils.F90 new file mode 100644 index 0000000000..3a1bafe5a6 --- /dev/null +++ b/src/utils/string_utils.F90 @@ -0,0 +1,243 @@ +module string_utils + + + implicit none + private + +! Public interface methods + + public ::& + to_upper, & ! Convert character string to upper case + to_lower, & ! Convert character string to lower case + INCSTR, & ! increments a string + GLC ! Position of last significant character in string + +contains + +function to_upper(str) + +!----------------------------------------------------------------------- +! Purpose: +! Convert character string to upper case. +! +! Method: +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! Author: B. Eaton, July 2001 +! +! $Id$ +!----------------------------------------------------------------------- + implicit none + + character(len=*), intent(in) :: str ! String to convert to upper case + character(len=len(str)) :: to_upper + +! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: lower_to_upper ! integer to convert case + character(len=1) :: ctmp ! Character temporary +!----------------------------------------------------------------------- + lower_to_upper = iachar("A") - iachar("a") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + lower_to_upper) + to_upper(i:i) = ctmp + end do + +end function to_upper + +function to_lower(str) + +!----------------------------------------------------------------------- +! Purpose: +! Convert character string to lower case. +! +! Method: +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! Author: B. Eaton, July 2001 +! +! $Id$ +!----------------------------------------------------------------------- + implicit none + + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: to_lower + +! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: upper_to_lower ! integer to convert case + character(len=1) :: ctmp ! Character temporary +!----------------------------------------------------------------------- + upper_to_lower = iachar("a") - iachar("A") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + upper_to_lower) + to_lower(i:i) = ctmp + end do + +end function to_lower + +integer function INCSTR( s, inc ) + !----------------------------------------------------------------------- + ! ... Increment a string whose ending characters are digits. + ! The incremented integer must be in the range [0 - (10**n)-1] + ! where n is the number of trailing digits. + ! Return values: + ! + ! 0 success + ! -1 error: no trailing digits in string + ! -2 error: incremented integer is out of range + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy variables + !----------------------------------------------------------------------- + integer, intent(in) :: & + inc ! value to increment string (may be negative) + character(len=*), intent(inout) :: & + s ! string with trailing digits + + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: & + i, & ! index + lstr, & ! number of significant characters in string + lnd, & ! position of last non-digit + ndigit, & ! number of trailing digits + ival, & ! integer value of trailing digits + pow, & ! power of ten + digit ! integer value of a single digit + + lstr = GLC( s ) + lnd = LASTND( s ) + ndigit = lstr - lnd + + if( ndigit == 0 ) then + INCSTR = -1 + return + end if + + !----------------------------------------------------------------------- + ! ... Calculate integer corresponding to trailing digits. + !----------------------------------------------------------------------- + ival = 0 + pow = 0 + do i = lstr,lnd+1,-1 + digit = ICHAR(s(i:i)) - ICHAR('0') + ival = ival + digit * 10**pow + pow = pow + 1 + end do + + !----------------------------------------------------------------------- + ! ... Increment the integer + !----------------------------------------------------------------------- + ival = ival + inc + if( ival < 0 .or. ival > 10**ndigit-1 ) then + INCSTR = -2 + return + end if + + !----------------------------------------------------------------------- + ! ... Overwrite trailing digits + !----------------------------------------------------------------------- + pow = ndigit + do i = lnd+1,lstr + digit = MOD( ival,10**pow ) / 10**(pow-1) + s(i:i) = CHAR( ICHAR('0') + digit ) + pow = pow - 1 + end do + + INCSTR = 0 + +end function INCSTR + +integer function LASTND( cs ) + !----------------------------------------------------------------------- + ! ... Position of last non-digit in the first input token. + ! Return values: + ! > 0 => position of last non-digit + ! = 0 => token is all digits (or empty) + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: cs ! Input character string + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: n, nn, digit + + n = GLC( cs ) + if( n == 0 ) then ! empty string + LASTND = 0 + return + end if + + do nn = n,1,-1 + digit = ICHAR( cs(nn:nn) ) - ICHAR('0') + if( digit < 0 .or. digit > 9 ) then + LASTND = nn + return + end if + end do + + LASTND = 0 ! all characters are digits + +end function LASTND + +integer function GLC( cs ) + !----------------------------------------------------------------------- + ! ... Position of last significant character in string. + ! Here significant means non-blank or non-null. + ! Return values: + ! > 0 => position of last significant character + ! = 0 => no significant characters in string + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: cs ! Input character string + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: l, n + + l = LEN( cs ) + if( l == 0 ) then + GLC = 0 + return + end if + + do n = l,1,-1 + if( cs(n:n) /= ' ' .and. cs(n:n) /= CHAR(0) ) then + exit + end if + end do + GLC = n + +end function GLC + +end module string_utils diff --git a/src/utils/time_manager.F90 b/src/utils/time_manager.F90 new file mode 100644 index 0000000000..030451559e --- /dev/null +++ b/src/utils/time_manager.F90 @@ -0,0 +1,1154 @@ +module time_manager + +! Provide CAM specific time management. This is a wrapper layer for the ESMF +! time manager utility. + +use ESMF + +use shr_kind_mod, only: r8 => shr_kind_r8, SHR_KIND_CS +use shr_cal_mod, only: shr_cal_noleap, shr_cal_gregorian +use spmd_utils, only: masterproc +use string_utils, only: to_upper +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +! Public methods + +public ::& + timemgr_init, &! time manager initialization + advance_timestep, &! increment the clocks current time + get_step_size, &! return step size in seconds + get_nstep, &! return timestep number + get_curr_date, &! return date components at end of current timestep + get_prev_date, &! return date components at beginning of current timestep + get_start_date, &! return components of the start date + get_ref_date, &! return components of the reference date + get_perp_date, &! return components of the perpetual date, and current time of day + get_curr_time, &! return components of elapsed time since reference date at end of current timestep + get_prev_time, &! return components of elapsed time since reference date at beg of current timestep + get_curr_calday, &! return calendar day at end of current timestep + get_calday, &! return calendar day from input date + is_first_step, &! return true on first step of initial run + is_first_restart_step, &! return true on first step of restart or branch run + timemgr_is_caltype, &! return true if incoming calendar type string matches actual calendar type in use + timemgr_get_calendar_cf, &! return cf standard for calendar type + is_end_curr_day, &! return true on last timestep in current day + is_end_curr_month, &! return true on last timestep in current month + is_last_step, &! return true on last timestep + is_perpetual, &! return true if perpetual calendar is in use + timemgr_datediff, &! calculate difference between two time instants + timemgr_time_ge, &! check if time2 is later than or equal to time1 + timemgr_time_inc, &! increment time instant by a given interval + timemgr_set_date_time, &! set the current date and time + set_time_float_from_date, &! returns a float representation of time given yr, mon, day, sec + set_date_from_time_float ! returns yr, mon, day, sec given time float + + +! Private module data + +integer, parameter :: uninit_int = -999999999 + +integer :: dtime = uninit_int ! timestep in seconds + +character(len=32) :: calendar ! Calendar type +logical :: tm_first_restart_step = .false. ! true for first step of a restart or branch run +logical :: tm_perp_calendar = .false. ! true when using perpetual calendar +integer :: cal_type = uninit_int ! calendar type + +! The target attribute for tm_cal is needed (at least by NAG) because there are +! pointers to this object inside ESMF_Time objects. +type(ESMF_Calendar), target :: tm_cal ! calendar +type(ESMF_Clock) :: tm_clock ! Model clock +type(ESMF_Time) :: tm_perp_date ! perpetual date + +!========================================================================================= +contains +!========================================================================================= + +subroutine timemgr_init( & + dtime_in, calendar_in, start_ymd, start_tod, ref_ymd, & + ref_tod, stop_ymd, stop_tod, curr_ymd, curr_tod, & + perpetual_run, perpetual_ymd, initial_run) + + ! Initialize the time manager. + + ! Arguments + integer, intent(in) :: dtime_in ! Coupling period (sec) + character(len=*), intent(IN) :: calendar_in ! Calendar type + integer, intent(IN) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(IN) :: start_tod ! Start time of day (sec) + integer, intent(IN) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(IN) :: ref_tod ! Reference time of day (sec) + integer, intent(IN) :: stop_ymd ! Stop date (YYYYMMDD) + integer, intent(IN) :: stop_tod ! Stop time of day (sec) + integer, intent(IN) :: curr_ymd ! current date (YYYYMMDD) + integer, intent(IN) :: curr_tod ! current time of day (sec) + logical, intent(IN) :: perpetual_run ! If in perpetual mode or not + integer, intent(IN) :: perpetual_ymd ! Perpetual date (YYYYMMDD) + logical, intent(in) :: initial_run ! true => initial (or startup) run + + ! Local variables + character(len=*), parameter :: sub = 'timemgr_init' + integer :: rc ! return code + type(ESMF_Time) :: start_date ! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: curr_date ! temporary date used in logic + type(ESMF_Time) :: ref_date ! reference date for time coordinate + !---------------------------------------------------------------------------------------- + + dtime = dtime_in + + calendar = trim(calendar_in) + call init_calendar() + + ! create ESMF time instant objects + start_date = TimeSetymd(start_ymd, start_tod, "start_date") + stop_date = TimeSetymd(stop_ymd, stop_tod, "stop_date") + ref_date = TimeSetymd(ref_ymd, ref_tod, "ref_date") + curr_date = TimeSetymd(curr_ymd, curr_tod, "curr_date") + + ! In order that an initial run start with nstep=0 (which is the criteria + ! for the is_first_step() function to return true), the current time + ! must be the same as the start time. To allow the driver to be doing a + ! continue run and at the same time force CAM into an initial run mode + ! this code forces the start time to equal the current time, even though + ! that may not be true for the data received from the driver. + if (initial_run) then + start_date = curr_date + end if + + ! Initialize ESMF clock + call initialize_clock(start_date, ref_date, curr_date, stop_date) + + if (.not. initial_run) then + + ! Advance the timestep. Data from the restart file corresponds to the + ! last timestep of the previous run. + call advance_timestep() + tm_first_restart_step = .true. + end if + + ! Initialize date used for perpetual calendar day calculation. + if (perpetual_run) then + tm_perp_calendar = .true. + tm_perp_date = TimeSetymd(perpetual_ymd, 0, "tm_perp_date") + end if + + ! Print configuration summary to log file (stdout). + if (masterproc) then + call timemgr_print() + end if + +end subroutine timemgr_init + +!========================================================================================= + +subroutine initialize_clock( start_date, ref_date, curr_date, stop_date ) + +! Create an ESMF clock based on the stepsize, start_date, stop_date, and ref_date +! Then advance the clock to the curr_date. + + ! Input variables + type(ESMF_Time), intent(inout) :: start_date ! start date for run + type(ESMF_Time), intent(inout) :: ref_date ! reference date for time coordinate + type(ESMF_Time), intent(inout) :: curr_date ! current date (equal to start_date) + type(ESMF_Time), intent(inout) :: stop_date ! stop date for run + + ! Local variables + character(len=*), parameter :: sub = 'initialize_clock' + type(ESMF_TimeInterval) :: step_size ! timestep size + type(ESMF_Time) :: current ! current date (from clock) + integer :: yr, mon, day, tod ! Year, month, day, and second as integers + integer :: rc ! return code + + if ( mod(86400,dtime) /= 0 ) then + call endrun (sub//': timestep must divide evenly into 1 day') + end if + + call ESMF_TimeIntervalSet(step_size, s=dtime, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') + + ! check for valid input + if ( stop_date <= start_date ) then + write(iulog,*)sub, ': stop date must be specified later than start date: ' + call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call endrun + end if + if ( curr_date >= stop_date ) then + write(iulog,*)sub, ': stop date must be specified later than current date: ' + call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call endrun + end if + + ! Initialize the clock + tm_clock = ESMF_ClockCreate(name="CAM Time-manager clock", timeStep=step_size, startTime=start_date, & + stopTime=stop_date, refTime=ref_date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockSetup') + + ! Advance clock to the current time (in case of a branch or restart) + call ESMF_ClockGet(tm_clock, currTime=current, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + do while( curr_date > current ) + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + call ESMF_ClockGet(tm_clock, currTime=current ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + end do + +end subroutine initialize_clock + +!========================================================================================= + +function TimeSetymd( ymd, tod, desc ) +! +! Set the time by an integer as YYYYMMDD and integer seconds in the day +! + integer, intent(in) :: ymd ! Year, month, day YYYYMMDD + integer, intent(in) :: tod ! Time of day in seconds + character(len=*), intent(in) :: desc ! Description of time to set + + type(ESMF_Time) :: TimeSetymd ! Return value + + character(len=*), parameter :: sub = 'TimeSetymd' + integer :: yr, mon, day ! Year, month, day as integers + integer :: rc ! return code + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > 24*3600) )then + write(iulog,*) sub//': error yymmdd is a negative number or time-of-day out of bounds', & + ymd, tod + call endrun + end if + yr = ymd / 10000 + mon = (ymd - yr*10000) / 100 + day = ymd - yr*10000 - mon*100 + call ESMF_TimeSet( TimeSetymd, yy=yr, mm=mon, dd=day, s=tod, & + calendar=tm_cal, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet: setting '//trim(desc)) +end function TimeSetymd + +!========================================================================================= + +subroutine set_time_float_from_date( time, year, month, day, sec ) +! +! Set the time as a float given year, month, day, sec +! + implicit none + + real(r8),intent(out):: time + integer, intent(in) :: year + integer, intent(in) :: month + integer, intent(in) :: day + integer, intent(in) :: sec + + integer :: rc ! return code + character(len=*), parameter :: sub = 'set_time_float_from_date' + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff + integer :: useday + + call ESMF_TimeSet( date, yy=year, mm=month, dd=day, s=sec, calendar=tm_cal, rc=rc) + ! + ! If the subroutine returned error, check if it is Feb 29 of a non-leap year + ! (legitimately used by the time-interpolation routines in tracer_data.F90) + ! in which case, substitute Feb 28 for the day + ! + if ( rc .ne. ESMF_SUCCESS ) then + if ( ( month .eq. 2 ) .and. ( day .eq. 29 ) ) then ! assume the failure is because it is leap day + useday = 28 + call ESMF_TimeSet( date, yy=year, mm=month, dd=useday, s=sec, calendar=tm_cal, rc=rc) + else ! legitimate error, let the model quit + call chkrc(rc, sub//': error return from ESMF_TimeSet for set_time_float_from_date') + endif + endif + + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for set_time_float_from_date') + + diff = date - ref_date + + call ESMF_TimeIntervalGet( diff, d_r8=time, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet for set_time_float_from_date') + +endsubroutine set_time_float_from_date + +!========================================================================================= + +subroutine set_date_from_time_float( time, year, month, day, sec ) +! +! Set year, month, day, sec given the time as a float +! + implicit none + + real(r8),intent(in) :: time + integer, intent(out) :: year + integer, intent(out) :: month + integer, intent(out) :: day + integer, intent(out) :: sec + + integer :: rc ! return code + character(len=*), parameter :: sub = 'set_date_from_time_float' + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff + + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for rset_date_from_time_float') + + call ESMF_TimeIntervalSet( diff, d_r8=time, rc=rc) + + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet for set_date_from_time_float') + + date = ref_date + diff + + call ESMF_TimeGet( date, yy=year, mm=month, dd=day, s=sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet for set_date_from_time_float') + +endsubroutine set_date_from_time_float + +!========================================================================================= + +integer function TimeGetymd( date, tod ) +! +! Get the date and time of day in ymd from ESMF Time. +! + type(ESMF_Time), intent(inout) :: date ! Input date to convert to ymd + integer, intent(out), optional :: tod ! Time of day in seconds + + character(len=*), parameter :: sub = 'TimeGetymd' + integer :: yr, mon, day + integer :: rc ! return code + + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + TimeGetymd = yr*10000 + mon*100 + day + if ( present( tod ) )then + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + end if + if ( yr < 0 )then + write(iulog,*) sub//': error year is less than zero', yr + call endrun + end if +end function TimeGetymd + +!========================================================================================= + +subroutine timemgr_set_date_time( new_ymd, new_tod ) + + implicit none + + integer, intent(IN) :: new_ymd ! date (YYYYMMDD) + integer, intent(IN) :: new_tod ! time of day (sec) + + type(ESMF_Time) :: new_time ! new time obj + type(ESMF_Time) :: clk_time ! clock's time obj + integer :: rc ! return code + + character(len=*), parameter :: sub = 'timemgr_set_date_time' + + new_time = TimeSetymd( new_ymd, new_tod, "curr_date" ) + +! Advance clock to the new time + + call ESMF_ClockGet(tm_clock, currTime=clk_time, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + do while( new_time > clk_time ) + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + call ESMF_ClockGet(tm_clock, currTime=clk_time ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + end do +! Print configuration summary to log file (stdout). + + if (masterproc) then + call timemgr_print() + end if + +end subroutine timemgr_set_date_time + +!========================================================================================= + +subroutine init_calendar( ) +! +! Initialize calendar +! +! Local variables + character(len=*), parameter :: sub = 'init_calendar' + type(ESMF_CalKind_Flag) :: cal_type ! calendar type + character(len=len(calendar)) :: caltmp + integer :: rc ! return code + + caltmp = to_upper(trim(calendar) ) + if ( trim(caltmp) == trim(shr_cal_noleap) ) then + cal_type = ESMF_CALKIND_NOLEAP + else if ( trim(caltmp) == trim(shr_cal_gregorian) ) then + cal_type = ESMF_CALKIND_GREGORIAN + else + write(iulog,*)sub,': unrecognized calendar specified: ',calendar + call endrun + end if + tm_cal = ESMF_CalendarCreate( name=caltmp, calkindflag=cal_type, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_CalendarSet') +end subroutine init_calendar + +!========================================================================================= + +subroutine timemgr_print() + +! Local variables + character(len=*), parameter :: sub = 'timemgr_print' + integer :: rc + integer :: yr, mon, day + integer ::& + nstep = uninit_int, &! current step number + step_sec = uninit_int, &! timestep size seconds + start_yr = uninit_int, &! start year + start_mon = uninit_int, &! start month + start_day = uninit_int, &! start day of month + start_tod = uninit_int, &! start time of day + stop_yr = uninit_int, &! stop year + stop_mon = uninit_int, &! stop month + stop_day = uninit_int, &! stop day of month + stop_tod = uninit_int, &! stop time of day + ref_yr = uninit_int, &! reference year + ref_mon = uninit_int, &! reference month + ref_day = uninit_int, &! reference day of month + ref_tod = uninit_int, &! reference time of day + curr_yr = uninit_int, &! current year + curr_mon = uninit_int, &! current month + curr_day = uninit_int, &! current day of month + curr_tod = uninit_int ! current time of day + integer(ESMF_KIND_I8) :: step_no + type(ESMF_Time) :: start_date! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: curr_date ! current date for run + type(ESMF_Time) :: ref_date ! reference date + type(ESMF_TimeInterval) :: step ! Time-step +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & + refTime=ref_date, stopTime=stop_date, timeStep=step, & + advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + + write(iulog,*)' ********** Time Manager Configuration **********' + + call ESMF_TimeIntervalGet( step, s=step_sec, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + call ESMF_TimeGet( start_date, yy=start_yr, mm=start_mon, dd=start_day, & + s=start_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( stop_date, yy=stop_yr, mm=stop_mon, dd=stop_day, & + s=stop_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( ref_date, yy=ref_yr, mm=ref_mon, dd=ref_day, s=ref_tod, & + rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeGet( curr_date, yy=curr_yr, mm=curr_mon, dd=curr_day, & + s=curr_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + write(iulog,*)' Calendar type: ',trim(calendar) + write(iulog,*)' Timestep size (seconds): ', step_sec + write(iulog,*)' Start date (yr mon day tod): ', start_yr, start_mon, & + start_day, start_tod + write(iulog,*)' Stop date (yr mon day tod): ', stop_yr, stop_mon, & + stop_day, stop_tod + write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & + ref_day, ref_tod + write(iulog,*)' Current step number: ', nstep + write(iulog,*)' Current date (yr mon day tod): ', curr_yr, curr_mon, & + curr_day, curr_tod + + if ( tm_perp_calendar ) then + call ESMF_TimeGet( tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + write(iulog,*)' Use perpetual diurnal cycle date (yr mon day): ', & + yr, mon, day + end if + + write(iulog,*)' ************************************************' + +end subroutine timemgr_print +!========================================================================================= + +subroutine advance_timestep() + +! Increment the timestep number. + +! Local variables + character(len=*), parameter :: sub = 'advance_timestep' + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + +! Set first step flag off. + + tm_first_restart_step = .false. + +end subroutine advance_timestep +!========================================================================================= + +integer function get_step_size() + +! Return the step size in seconds. + +! Local variables + character(len=*), parameter :: sub = 'get_step_size' + type(ESMF_TimeInterval) :: step_size ! timestep size + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, timeStep=step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + call ESMF_TimeIntervalGet(step_size, s=get_step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockTimeIntervalGet') + +end function get_step_size +!========================================================================================= + +integer function get_nstep() + +! Return the timestep number. + +! Local variables + character(len=*), parameter :: sub = 'get_nstep' + integer :: rc + integer(ESMF_KIND_I8) :: step_no +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + get_nstep = step_no + +end function get_nstep +!========================================================================================= + +subroutine get_curr_date(yr, mon, day, tod, offset) + +! Return date components valid at end of current timestep with an optional +! offset (positive or negative) in seconds. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + +! Local variables + character(len=*), parameter :: sub = 'get_curr_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_curr_date +!========================================================================================= + +subroutine get_perp_date(yr, mon, day, tod, offset) + +! Return time of day valid at end of current timestep and the components +! of the perpetual date (with an optional offset (positive or negative) in seconds. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + +! Local variables + character(len=*), parameter :: sub = 'get_perp_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: DelTime +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + ! Get time of day add it to perpetual date + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet(DelTime, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + DelTime + if ( present(offset) )then + call ESMF_TimeIntervalSet(DelTime, s=offset, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + DelTime + end if + ! Get time of day from the result + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + + ! Get the date from the fixed perpetual date (in case it overflows to next day) + call ESMF_TimeGet(tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + +end subroutine get_perp_date +!========================================================================================= + +subroutine get_prev_date(yr, mon, day, tod) + +! Return date components valid at beginning of current timestep. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_prev_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_prev_date +!========================================================================================= + +subroutine get_start_date(yr, mon, day, tod) + +! Return date components valid at beginning of initial run. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_start_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, startTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_start_date +!========================================================================================= + +subroutine get_ref_date(yr, mon, day, tod) + +! Return date components of the reference date. + +! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + +! Local variables + character(len=*), parameter :: sub = 'get_ref_date' + integer :: rc + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, refTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +end subroutine get_ref_date +!========================================================================================= + +subroutine get_curr_time(days, seconds) + +! Return time components valid at end of current timestep. +! Current time is the time interval between the current date and the reference date. + +! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + +! Local variables + character(len=*), parameter :: sub = 'get_curr_time' + integer :: rc + type(ESMF_Time) :: cdate, rdate + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=cdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_ClockGet( tm_clock, refTime=rdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + diff = cdate - rdate + + call ESMF_TimeIntervalGet(diff, d=days, s=seconds, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + +end subroutine get_curr_time +!========================================================================================= + +subroutine get_prev_time(days, seconds) + +! Return time components valid at beg of current timestep. +! prev time is the time interval between the prev date and the reference date. + +! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + +! Local variables + character(len=*), parameter :: sub = 'get_prev_time' + integer :: rc + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for prevTime') + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for refTime') + diff = date - ref_date + call ESMF_TimeIntervalGet( diff, d=days, s=seconds, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeintervalGet') + +end subroutine get_prev_time +!========================================================================================= + +function get_curr_calday(offset) + +! Return calendar day at end of current timestep with optional offset. +! Calendar day 1.0 = 0Z on Jan 1. + +! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. +! Return value + real(r8) :: get_curr_calday + +! Local variables + character(len=*), parameter :: sub = 'get_curr_calday' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off, diurnal + integer :: year, month, day, tod +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + if ( tm_perp_calendar ) then +! Get current time-of-day from clock + call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') +! Get date from perpetual date add time-of-day to it + call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + diurnal +!!!! write(iulog,*) ' tod = ', tod +!!!! call ESMF_TimePrint( date, "string" ) + end if + + call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +! +! WARNING: Gregorian calendar fakes day 366 +! +! The zenith angle calculation is only capable of using a 365-day calendar. +! If a Gregorian calendar is being used, the last day of a leap year (day 366) +! is sent to the model as a repetition of the previous day (day 365). +! This is done by decrementing calday by 1 immediately below. +! bundy, July 2008 +! + if (( get_curr_calday > 366.0_r8 ) .and. ( get_curr_calday <= 367.0_r8 ) & + .and. (timemgr_is_caltype(trim(shr_cal_gregorian)))) then + get_curr_calday = get_curr_calday - 1.0_r8 + endif + + if ( (get_curr_calday < 1.0_r8) .or. (get_curr_calday > 366.0_r8) )then + write(iulog,*) 'atm '//sub//' calday = ', get_curr_calday + if ( present(offset) ) write(iulog,*) 'offset = ', offset + call endrun( sub//': error get_curr_calday out of bounds' ) + end if + +end function get_curr_calday +!========================================================================================= + +function get_calday(ymd, tod) + +! Return calendar day corresponding to specified time instant. +! Calendar day 1.0 = 0Z on Jan 1. + +! Arguments + integer, intent(in) :: & + ymd, &! date in yearmmdd format + tod ! time of day (seconds past 0Z) + +! Return value + real(r8) :: get_calday + +! Local variables + character(len=*), parameter :: sub = 'get_calday' + integer :: rc ! return code + type(ESMF_Time) :: date +!----------------------------------------------------------------------------------------- + + date = TimeSetymd( ymd, tod, "get_calday" ) + call ESMF_TimeGet( date, dayOfYear_r8=get_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + +! +! WARNING: Gregorian calendar fakes day 366 +! +! The zenith angle calculation is only capable of using a 365-day calendar. +! If a Gregorian calendar is being used, the last day of a leap year (day 366) +! is sent to the model as a repetition of the previous day (day 365). +! This is done by decrementing calday by 1 immediately below. +! bundy, July 2008 +! + if (( get_calday > 366.0_r8 ) .and. ( get_calday <= 367.0_r8 ) & + .and. (timemgr_is_caltype(trim(shr_cal_gregorian)))) then + get_calday = get_calday - 1.0_r8 + endif + + if ( (get_calday < 1.0_r8) .or. (get_calday > 366.0_r8) )then + write(iulog,*) 'atm '//sub//' calday = ', get_calday + call endrun( sub//': error calday out of range' ) + end if + +end function get_calday +!========================================================================================= + +character(len=SHR_KIND_CS) function timemgr_get_calendar_cf() + +! Return cf standard for calendar type + +! Local variables + character(len=*), parameter :: sub = 'timemgr_get_calendar_cf' + character(len=len(calendar)) :: caltmp +!----------------------------------------------------------------------------------------- + + caltmp = to_upper(trim(calendar) ) + if ( trim(caltmp) == trim(shr_cal_noleap) ) then + timemgr_get_calendar_cf = 'noleap' + else if ( trim(caltmp) == trim(shr_cal_gregorian) ) then + timemgr_get_calendar_cf = 'gregorian' + else + write(iulog,*)sub,': unrecognized calendar specified: ',calendar + call endrun + end if + +end function timemgr_get_calendar_cf +!========================================================================================= + +function timemgr_is_caltype( cal_in ) + +! Return true if incoming calendar type string matches actual calendar type in use + + character(len=*), intent(in) :: cal_in + +! Return value + logical :: timemgr_is_caltype + +!----------------------------------------------------------------------------------------- + + timemgr_is_caltype = ( to_upper(trim(calendar)) == to_upper(trim(cal_in)) ) + +end function timemgr_is_caltype +!========================================================================================= + +function is_end_curr_day() + +! Return true if current timestep is last timestep in current day. + +! Return value + logical :: is_end_curr_day + +! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) +!----------------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_day = (tod == 0) + +end function is_end_curr_day +!========================================================================================= + +logical function is_end_curr_month() + +! Return true if current timestep is last timestep in current month. + +! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) +!----------------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_month = (day == 1 .and. tod == 0) + +end function is_end_curr_month +!========================================================================================= + +logical function is_first_step() + +! Return true on first step of initial run only. + +! Local variables + character(len=*), parameter :: sub = 'is_first_step' + integer :: rc + integer :: nstep + integer(ESMF_KIND_I8) :: step_no +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + is_first_step = (nstep == 0) + +end function is_first_step +!========================================================================================= + +logical function is_first_restart_step() + +! Return true on first step of restart run only. + +!----------------------------------------------------------------------------------------- + + is_first_restart_step = tm_first_restart_step + +end function is_first_restart_step +!========================================================================================= + +logical function is_last_step() + +! Return true on last timestep. + +! Local variables + character(len=*), parameter :: sub = 'is_last_step' + type(ESMF_Time) :: stop_date + type(ESMF_Time) :: curr_date + type(ESMF_TimeInterval) :: time_step + integer :: rc +!----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, stopTime=stop_date, & + currTime=curr_date, TimeStep=time_step, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + if ( curr_date+time_step > stop_date ) then + is_last_step = .true. + else + is_last_step = .false. + end if + +end function is_last_step +!========================================================================================= + +logical function is_perpetual() + +! Return true on last timestep. + +!----------------------------------------------------------------------------------------- + + is_perpetual = tm_perp_calendar + +end function is_perpetual + +!========================================================================================= + +subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) + +! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. + +! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + real(r8) :: days ! (ymd2,tod2)-(ymd1,tod1) in days + +! Local variables + character(len=*), parameter :: sub = 'timemgr_datediff' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: diff +!----------------------------------------------------------------------------------------- + + date1 = TimeSetymd( ymd1, tod1, "date1" ) + date2 = TimeSetymd( ymd2, tod2, "date2" ) + diff = date2 - date1 + call ESMF_TimeIntervalGet( diff, d_r8=days, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + +end subroutine timemgr_datediff + +!========================================================================================= + +subroutine timemgr_time_ge(ymd1, tod1, ymd2, tod2, time2_ge_time1) + +! time2_ge_time1 is set to true if (ymd2,tod2) is later than or equal to (ymd1,tod1) + +! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + logical :: time2_ge_time1 + +! Local variables + character(len=*), parameter :: sub = 'timemgr_time_ge' + integer :: rc ! return code + + type(ESMF_Time) :: time1, time2 +!----------------------------------------------------------------------------------------- + + time1 = TimeSetymd( ymd1, tod1, "date1" ) + time2 = TimeSetymd( ymd2, tod2, "date2" ) + time2_ge_time1 = (time2 >= time1) + +end subroutine timemgr_time_ge + +!========================================================================================= + +subroutine timemgr_time_inc(ymd1, tod1, ymd2, tod2, inc_s, inc_h, inc_d) + +! Increment the time instant (ymd1,tod1) by an interval and return the resulting +! time instant (ymd2,tod2). + + ! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1 ! time of day relative to date1 (seconds past 0Z) + + integer, intent(out) ::& + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + integer, intent(in), optional ::& + inc_s, &! number of seconds in interval + inc_h, &! number of hours in interval + inc_d ! number of days in interval + + ! Local variables + character(len=*), parameter :: sub = 'timemgr_time_inc' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: t_interval + integer :: year, month, day +!----------------------------------------------------------------------------------------- + + ! set esmf time object + date1 = TimeSetymd( ymd1, tod1, "date1" ) + + ! set esmf time interval object + if (present(inc_s)) then + call ESMF_TimeIntervalSet(t_interval, s=inc_s, rc=rc) + else if (present(inc_h)) then + call ESMF_TimeIntervalSet(t_interval, h=inc_h, rc=rc) + else if (present(inc_d)) then + call ESMF_TimeIntervalSet(t_interval, d=inc_d, rc=rc) + else + call endrun(sub//': one of the args inc_s, inc_h, or inc_d must be set') + end if + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + + ! increment the time instant + date2 = date1 + t_interval + + ! extract the time components + call ESMF_TimeGet(date2, yy=year, mm=month, dd=day, s=tod2, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + ymd2 = year*10000 + month*100 + day + +end subroutine timemgr_time_inc + +!========================================================================================= + +subroutine chkrc(rc, mes) + integer, intent(in) :: rc ! return code from time management library + character(len=*), intent(in) :: mes ! error message + if ( rc == ESMF_SUCCESS ) return + write(iulog,*) mes + call endrun ('CHKRC') +end subroutine chkrc + +end module time_manager diff --git a/src/utils/units.F90 b/src/utils/units.F90 new file mode 100644 index 0000000000..8497cbf687 --- /dev/null +++ b/src/utils/units.F90 @@ -0,0 +1,36 @@ +module units + +use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit + +implicit none +private + +public :: getunit, freeunit + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + +integer function getunit(iu) + + ! return an available unit number for i/o + + integer, intent(in), optional :: iu ! desired unit number + + getunit = shr_file_getUnit(iu) + +end function getunit + +!------------------------------------------------------------------------------- + +subroutine freeunit(iu) + + ! release the unit + + integer, intent(in) :: iu ! unit number to be freed + + call shr_file_freeUnit(iu) + +end subroutine freeunit + +end module units diff --git a/src/utils/vrtmap.F90 b/src/utils/vrtmap.F90 new file mode 100644 index 0000000000..5097287e9c --- /dev/null +++ b/src/utils/vrtmap.F90 @@ -0,0 +1,77 @@ +module vrtmap_mod + +implicit none + +private + +public :: vrtmap + +contains + +subroutine vrtmap (pkdim ,pmap ,sigln ,dsigln ,kdpmap ) +!----------------------------------------------------------------------- +! +! Purpose: Map indices of an artificial evenly spaced (in log) vertical grid to +! the indices of the log of the model vertical grid. The resultant +! array of mapped indices will be used by "kdpfnd" to find the vertical +! location of any departure point relative to the model grid. +! +! Method: +! +! Author: Jerry Olson +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +!----------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: pkdim ! dimension of "sigln" and "dsigln" + integer, intent(in) :: pmap ! dimension of "kdpmap" + + real(r8), intent(in) :: sigln (pkdim) ! model levels (log(eta)) + real(r8), intent(in) :: dsigln(pkdim) ! intervals between model levels (log) + + integer, intent(out) :: kdpmap(pmap) ! array of mapped indices +! +!---------------------------Local variables----------------------------- +! + integer imin ! | + integer k ! |-- indices + integer kk ! | + integer newmap ! estimated value of "pmap" + + real(r8) del ! artificial grid interval + real(r8) dp ! artificial departure point + real(r8) eps ! epsilon factor +! +!----------------------------------------------------------------------- +! + eps = 1.e-05_r8 + del = ( sigln(pkdim) - sigln(1) )/real(pmap,r8) + imin = minloc( dsigln(:pkdim-1), dim=1 ) + if (del + eps >= dsigln(imin)) then + newmap = ( sigln(pkdim) - sigln(1) )/dsigln(imin) + 1 + write(iulog,9000) pmap,newmap + call endrun() + end if + + kdpmap(1) = 1 + do kk = 2,pmap + dp = sigln(1) + real(kk-1,r8)*del + do k = 1,pkdim-1 + if(dp > sigln(k) + eps) then + kdpmap(kk) = k + end if + end do + end do + + return +9000 format(' VRTMAP: Not enough artificial grid intervals.'/ & + ' Currently, "pmap" is set to ',i20/ & + ' Reset parameter "pmap" to at least ',i20) +end subroutine vrtmap + +end module vrtmap_mod diff --git a/src/utils/wrap_mpi.F90 b/src/utils/wrap_mpi.F90 new file mode 100644 index 0000000000..68f7394898 --- /dev/null +++ b/src/utils/wrap_mpi.F90 @@ -0,0 +1,1302 @@ +!----------------------------------------------------------------------- +! +! Purpose: +! +! Wrapper routines for the MPI (Message Passing) library for the +! distributed memory (SPMD) version of the code. Also data with +! "shorthand" names for the MPI data types. +! +! Entry points: +! mpibarrier Calls mpi_barrier +! mpifinalize Calls mpi_finalize +! mpipack_size Calls mpi_pack +! mpipack Calls mpi_pack +! mpiunpack Calls mpi_unpack +! mpisendrecv Calls mpi_sendrecv +! mpiisend Calls mpi_isend +! mpiirsend Calls mpi_irsend +! mpiissend Calls mpi_issend +! mpiirecv Calls mpi_irecv +! mpiwait Calls mpi_wait +! mpiwaitall Calls mpi_waitall +! mpisend Calls mpi_send +! mpirsend Calls mpi_rsend +! mpissend Calls mpi_ssend +! mpirecv Calls mpi_recv +! mpigather Calls mpi_gather +! mpigatherv Calls mpi_gatherv +! mpigathervr4 Calls mpi_gatherv for real*4 data +! mpigathervint Calls mpi_gatherv for integer data +! mpisum Calls mpi_sum +! mpiscatter Calls mpi_scatter +! mpiscatterv Calls mpi_scatterv +! mpibcast Calls mpi_bcast +! mpiallmaxint Calls mpi_allreduce on integer vector with mpi_max operator +! mpialltoallv Calls mpi_alltoallv +! mpialltoallint Calls mpi_alltoall for integer data +! mpiallgatherv Calls mpi_allgatherv +! mpiallgatherint Calls mpi_allgatherv for integer data +! mpiwincreate Calls mpi_win_create and mpi_win_fence +! +! Author: Many +! +!----------------------------------------------------------------------- +! + +! +! Performance bug work around for Gemini interconnect +! +#ifdef _NO_MPI_RSEND +#define mpi_rsend mpi_send +#define mpi_irsend mpi_isend +#endif + +! +! Compile these routines only when SPMD is defined +! +#if (defined SPMD) + +!**************************************************************** + + subroutine mpibarrier (comm) +! +! MPI barrier, have threads wait until all threads have reached this point +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + integer, intent(in):: comm + + integer ier !MP error code + + call mpi_barrier (comm, ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_barrier failed ier=',ier + call endrun + end if + + return + end subroutine mpibarrier + +!**************************************************************** + + subroutine mpifinalize +! +! End of all MPI communication +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + integer ier !MP error code + + call mpi_finalize (ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_finalize failed ier=',ier + call endrun + end if + + return + end subroutine mpifinalize + +!**************************************************************** + + subroutine mpipack_size (incount, datatype, comm, size) +! +! Returns the size of the packed data +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + integer, intent(in):: incount + integer, intent(in):: datatype + integer, intent(in):: comm + integer, intent(out):: size + + integer ier !MP error code + + call mpi_pack_size (incount, datatype, comm, size, ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_pack_size failed ier=',ier + call endrun + end if + + return + end subroutine mpipack_size + +!**************************************************************** + + subroutine mpipack (inbuf, incount, datatype, outbuf, outsize, & + position, comm) +! +! Pack the data and send it. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + real(r8), intent(in):: inbuf(*) + real(r8), intent(out):: outbuf(*) + integer, intent(in):: incount + integer, intent(in):: datatype + integer, intent(out):: outsize + integer, intent(inout):: position + integer, intent(in):: comm + + integer ier !MP error code + + call mpi_pack (inbuf, incount, datatype, outbuf, outsize, & + position, comm, ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_pack failed ier=',ier + call endrun + end if + + return + end subroutine mpipack + +!**************************************************************** + + subroutine mpiunpack (inbuf, insize, position, outbuf, outcount, & + datatype, comm) +! +! Un-packs the data from the packed receive buffer +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + implicit none + + real(r8), intent(in):: inbuf(*) + real(r8), intent(out):: outbuf(*) + integer, intent(in):: insize + integer, intent(inout):: position + integer, intent(in):: outcount + integer, intent(in):: datatype + integer, intent(in):: comm + + integer ier !MP error code + + call mpi_unpack (inbuf, insize, position, outbuf, outcount, & + datatype, comm, ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_unpack failed ier=',ier + call endrun + end if + + return + end subroutine mpiunpack + +!**************************************************************** + + subroutine mpisendrecv (sendbuf, sendcount, sendtype, dest, sendtag, & + recvbuf, recvcount, recvtype, source,recvtag, & + comm) +! +! Blocking send and receive. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real(r8), intent(in):: sendbuf(*) + real(r8), intent(out):: recvbuf(*) + integer, intent(in):: sendcount + integer, intent(in):: sendtype + integer, intent(in):: dest + integer, intent(in):: sendtag + integer, intent(in):: recvcount + integer, intent(in):: recvtype + integer, intent(in):: source + integer, intent(in):: recvtag + integer, intent(in):: comm + + integer :: status(MPI_STATUS_SIZE) + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_sendrecv') +#endif + call mpi_sendrecv (sendbuf, sendcount, sendtype, dest, sendtag, & + recvbuf, recvcount, recvtype, source, recvtag, & + comm, status, ier) + if (ier.ne.mpi_success) then + write(iulog,*)'mpi_sendrecv failed ier=',ier + call endrun + end if +! +! ASSUME nrecv = nsend for stats gathering purposes. This is not actually +! correct, but its the best we can do since recvcount is a Max number +! + nsend = nsend + 1 + nrecv = nrecv + 1 + nwsend = nwsend + sendcount + nwrecv = nwrecv + sendcount + +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_sendrecv') +#endif + + return + end subroutine mpisendrecv + +!**************************************************************** + + subroutine mpiisend (buf, count, datatype, dest, tag, comm, request) +! +! Does a non-blocking send. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + integer, intent(out):: request + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_isend') +#endif + call mpi_isend (buf, count, datatype, dest, tag, comm, request, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_isend failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_isend') +#endif + + return + end subroutine mpiisend + +!**************************************************************** + + subroutine mpiirsend (buf, count, datatype, dest, tag, comm, request) +! +! Does a non-blocking ready send. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + integer, intent(out):: request + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_irsend') +#endif + call mpi_irsend (buf, count, datatype, dest, tag, comm, request, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_irsend failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_irsend') +#endif + + return + end subroutine mpiirsend + +!**************************************************************** + + subroutine mpiissend (buf, count, datatype, dest, tag, comm, request) +! +! Does a non-blocking synchronous send. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + integer, intent(out):: request + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_issend') +#endif + call mpi_issend (buf, count, datatype, dest, tag, comm, request, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_issend failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_issend') +#endif + + return + end subroutine mpiissend + +!**************************************************************** + + subroutine mpiirecv (buf, count, datatype, source, tag, comm, request) +! +! Does a non-blocking receive. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(out):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: source + integer, intent(in):: tag + integer, intent(in):: comm + integer, intent(out):: request + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_irecv') +#endif + call mpi_irecv (buf, count, datatype, source, tag, comm, request, ier ) + if (ier/=mpi_success) then + write(iulog,*)'mpi_irecv failed ier=',ier + call endrun + end if + nrecv = nrecv + 1 + nwrecv = nwrecv + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_irecv') +#endif + + return + end subroutine mpiirecv + +!**************************************************************** + + subroutine mpiwait (request, status) +! +! Waits for a nonblocking operation to complete. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(inout):: request + integer, intent(out):: status + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_wait') +#endif + call mpi_wait (request, status, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_wait failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_wait') +#endif + + return + end subroutine mpiwait + +!**************************************************************** + + subroutine mpiwaitall (count, array_of_requests, array_of_statuses) +! +! Waits for a collection of nonblocking operations to complete. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in):: count + integer, intent(inout):: array_of_requests(*) + integer, intent(out):: array_of_statuses(*) + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_waitall') +#endif + call mpi_waitall (count, array_of_requests, array_of_statuses, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_waitall failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_waitall') +#endif + + return + end subroutine mpiwaitall + +!**************************************************************** + + subroutine mpisend (buf, count, datatype, dest, tag, comm) +! +! Does a blocking send +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_send') +#endif + call mpi_send (buf, count, datatype, dest, tag, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_send failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_send') +#endif + + return + end subroutine mpisend + +!**************************************************************** + + subroutine mpirsend (buf, count, datatype, dest, tag, comm) +! +! Does a blocking ready send +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_rsend') +#endif + call mpi_rsend (buf, count, datatype, dest, tag, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_rsend failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_rsend') +#endif + + return + end subroutine mpirsend + +!**************************************************************** + + subroutine mpissend (buf, count, datatype, dest, tag, comm) +! +! Does a blocking synchronous send +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: dest + integer, intent(in):: tag + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_ssend') +#endif + call mpi_ssend (buf, count, datatype, dest, tag, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_ssend failed ier=',ier + call endrun + end if + nsend = nsend + 1 + nwsend = nwsend + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_ssend') +#endif + + return + end subroutine mpissend + +!**************************************************************** + + subroutine mpirecv (buf, count, datatype, source, tag, comm) +! +! Does a blocking receive +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(out):: buf(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: source + integer, intent(in):: tag + integer, intent(in):: comm + + integer status (MPI_STATUS_SIZE) ! Status of message + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_recv') +#endif + call mpi_recv (buf, count, datatype, source, tag, comm, status, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_recv failed ier=',ier + call endrun + end if + nrecv = nrecv + 1 + nwrecv = nwrecv + count +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_recv') +#endif + + return + end subroutine mpirecv + +!**************************************************************** + + subroutine mpigather (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, & + recvtype, root, comm) +! +! Collects different messages from each thread on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: sendbuf(*) + real (r8), intent(out):: recvbuf(*) + integer, intent(in):: sendcnt + integer, intent(in):: sendtype + integer, intent(in):: recvcnt + integer, intent(in):: recvtype + integer, intent(in):: root + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gather') +#endif + call mpi_gather (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnt, recvtype, root, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_gather failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gather') +#endif + + return + end subroutine mpigather + +!**************************************************************** + + subroutine mpigatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, & + displs, recvtype, root, comm) +! +! Collects different messages from each thread on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in) :: sendbuf(*) + real (r8), intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + + integer ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + return + end subroutine mpigatherv + +!**************************************************************** + + subroutine mpigathervr4 (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, & + displs, recvtype, root, comm) +! +! Collects different messages from each thread on masterproc +! + use shr_kind_mod, only: r4 => shr_kind_r4, r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r4), intent(in) :: sendbuf(*) + real (r4), intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + + integer ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + return + end subroutine mpigathervr4 + +!**************************************************************** + + subroutine mpigathervint (sendbuf, sendcnt, sendtype, recvbuf, & + recvcnts, displs, recvtype, root, comm) +! +! Collects different messages from each thread on masterproc +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: sendbuf(*) + integer, intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + + integer ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_gatherv') +#endif + call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + if (ier /= mpi_success) then + write(iulog,*)'mpi_gatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_gatherv') +#endif + + return + end subroutine mpigathervint + +!**************************************************************** + + subroutine mpisum (sendbuf, recvbuf, cnt, datatype, root, comm) +! +! Sums sendbuf across all processors on communicator, returning +! result to root. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in):: sendbuf(*) + real (r8), intent(out):: recvbuf(*) + integer, intent(in):: cnt + integer, intent(in):: datatype + integer, intent(in):: root + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_reduce') +#endif + call mpi_reduce (sendbuf, recvbuf, cnt, datatype, mpi_sum, & + root, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_reduce failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_reduce') +#endif + + return + end subroutine mpisum + +!**************************************************************** + + subroutine mpiscatter (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, & + recvtype, root, comm) +! +! Sends different messages from masterproc to each thread +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8),intent(in):: sendbuf(*) + real (r8), intent(out):: recvbuf(*) + integer,intent(in):: sendcnt + integer,intent(in):: sendtype + integer,intent(in):: recvcnt + integer,intent(in):: recvtype + integer,intent(in):: root + integer,intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_scatter') +#endif + call mpi_scatter (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, & + recvtype, root, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_scatter failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_scatter') +#endif + + return + end subroutine mpiscatter + +!**************************************************************** + + subroutine mpiscatterv (sendbuf, sendcnts, displs, sendtype, recvbuf, & + recvcnt, recvtype, root, comm) +! +! Sends different messages from masterproc to each thread +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in) :: sendbuf(*) + real (r8), intent(out) :: recvbuf(*) + integer, intent(in) :: displs(*) + integer, intent(in) :: sendcnts(*) + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnt + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_scatter') +#endif + call mpi_scatterv (sendbuf, sendcnts, displs, sendtype, recvbuf, recvcnt, & + recvtype, root, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_scatter failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_scatter') +#endif + + return + end subroutine mpiscatterv + +!**************************************************************** + + subroutine mpibcast (buffer, count, datatype, root, comm ) +! +! Broadcasts a message from masterproc to all threads +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(inout):: buffer(*) + integer, intent(in):: count + integer, intent(in):: datatype + integer, intent(in):: root + integer, intent(in):: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_bcast') +#endif + call mpi_bcast (buffer, count, datatype, root, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_bcast failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_bcast') +#endif + + return + end subroutine mpibcast +!**************************************************************** + + subroutine mpiallmaxint (sendbuf, recvbuf, count, comm) +! +! Allreduce integer vector maximum +! + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: sendbuf(*) + integer, intent(out) :: recvbuf(*) + integer, intent(in) :: count + integer, intent(in) :: comm + + integer :: ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_allreduce') +#endif + call mpi_allreduce (sendbuf, recvbuf, count, mpiint, & + mpimax, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_allreduce failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_allreduce') +#endif + + return + end subroutine mpiallmaxint + +!**************************************************************** + + subroutine mpialltoallv (sendbuf, sendcnts, sdispls, sendtype, & + recvbuf, recvcnts, rdispls, recvtype, & + comm) +! +! All-to-all scatter/gather +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in) :: sendbuf(*) + real (r8), intent(out) :: recvbuf(*) + integer, intent(in) :: sdispls(*) + integer, intent(in) :: sendcnts(*) + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: rdispls(*) + integer, intent(in) :: recvtype + integer, intent(in) :: comm + + integer :: ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_alltoallv') +#endif + call mpi_alltoallv (sendbuf, sendcnts, sdispls, sendtype, & + recvbuf, recvcnts, rdispls, recvtype, & + comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_alltoallv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_alltoallv') +#endif + + return + end subroutine mpialltoallv +!**************************************************************** + + subroutine mpialltoallint (sendbuf, sendcnt, recvbuf, recvcnt, & + comm) +! +! All-to-all scatter/gather +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(out) :: recvbuf(*) + integer, intent(in) :: recvcnt + integer, intent(in) :: comm + + integer :: ier ! MPI error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_alltoallint') +#endif + call mpi_alltoall (sendbuf, sendcnt, mpiint, & + recvbuf, recvcnt, mpiint, & + comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_alltoallint failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_alltoallint') +#endif + + return + end subroutine mpialltoallint + +!**************************************************************** + + subroutine mpiallgatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, rdispls, recvtype, & + comm) +! +! Collect data from each task and broadcast resulting +! vector to all tasks +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real (r8), intent(in) :: sendbuf(*) + real (r8), intent(out) :: recvbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnts(*) + integer, intent(in) :: rdispls(*) + integer, intent(in) :: recvtype + integer, intent(in) :: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_allgatherv') +#endif + call mpi_allgatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, rdispls, recvtype, & + comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_allgatherv failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_allgatherv') +#endif + + return + end subroutine mpiallgatherv +!**************************************************************** + + subroutine mpiallgatherint (sendbuf, scount, recvbuf, rcount, comm) +! +! Collects integer data from each task and broadcasts resulting +! vector to all tasks +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + integer, intent(in) :: sendbuf(*) + integer, intent(out) :: recvbuf(*) + integer, intent(in) :: scount + integer, intent(in) :: rcount + integer, intent(in) :: comm + + integer ier !MP error code + +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_allgather') +#endif + call mpi_allgather (sendbuf, scount, mpiint, recvbuf, rcount, & + mpiint, comm, ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_allgather failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_allgather') +#endif + + return + end subroutine mpiallgatherint + +!**************************************************************** + + subroutine mpiwincreate(base,size,comm,win) +! +! Creates window for MPI2 one-sided commands +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mpishorthand + use cam_abortutils, only: endrun + use cam_logfile, only: iulog +#if defined( WRAP_MPI_TIMING ) + use perf_mod +#endif + + implicit none + + real(r8), intent(in) :: base(*) + integer, intent(in) :: size + integer, intent(in) :: comm + integer, intent(out) :: win +! +#ifdef MPI2 + integer(kind=MPI_ADDRESS_KIND) :: size8 + integer :: ier, info +! +#if defined( WRAP_MPI_TIMING ) + call t_startf ('mpi_win_create') +#endif + info = MPI_INFO_NULL + size8 = size + call mpi_win_create(base,size8,8,info,comm,win,ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_win_create failed ier=',ier + call endrun + end if + call mpi_win_fence(0,win,ier) + if (ier/=mpi_success) then + write(iulog,*)'mpi_win_fence failed ier=',ier + call endrun + end if +#if defined( WRAP_MPI_TIMING ) + call t_stopf ('mpi_win_create') +#endif +#endif + + return + end subroutine mpiwincreate +!**************************************************************** +! +! If SPMD is not turned on +! +#else + subroutine wrap_mpi + use cam_abortutils, only: endrun + implicit none +! +! A unused stub routine to make the compiler happy when SPMD is +! turned off (which means you don't need anything in this file). +! + call endrun ('(WRAP_MPI): This should not be called at all') + end subroutine wrap_mpi +#endif + diff --git a/src/utils/wrap_nf.F90 b/src/utils/wrap_nf.F90 new file mode 100644 index 0000000000..d89fddadfc --- /dev/null +++ b/src/utils/wrap_nf.F90 @@ -0,0 +1,921 @@ +!------------------------------------------------------------------------------- +! +! WARNING: USE OF THIS MODULE WITHIN CAM IS DEPRECATED. ALL +! HANDLING OF NETCDF FILES SHOULD ULTIMATELY BE DONE +! BY PIO, OR FOR PORTABLE CODE, SHOULD CONTACT THE +! NETCDF F90 INTERFACE DIRECTLY. +! +! DO NOT USE THIS MODULE. +! +!------------------------------------------------------------------------------- + +module wrap_nf + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use netcdf + +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Wrapper routines for the netCDF library for input and output data. +! +! Author: Jim Rosinski +! +! $Id$ +! +!------------------------------------------------------------------------------- + + +contains +!=============================================================================== + +!=============================================================================== + + subroutine wrap_redef (nfid) + implicit none + + integer, intent(in):: nfid + + integer ret ! NetCDF return code + + ret = nf90_redef (nfid) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_redef +!=============================================================================== + + subroutine wrap_enddef (nfid) + implicit none + + + integer, intent(in):: nfid + + integer ret ! NetCDF return code + + ret = nf90_enddef (nfid) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_enddef + + subroutine wrap_create (path, cmode, ncid) + implicit none +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Create a netCDF file for reading and/or writing +! +!------------------------------------------------------------------------------- + + character*(*), intent(in):: path + integer, intent(in):: cmode + integer, intent(out):: ncid + + integer ret ! NetCDF return code + + ret = nf90_create (path, cmode, ncid) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_create + +!=============================================================================== + + subroutine wrap_inq_unlimdim (nfid, dimid) + implicit none + !------------------------------------------------------------------------------- + ! + ! Purpose: + ! + ! Get dimid for the unlimited dimension. + ! + !------------------------------------------------------------------------------- + integer, intent(in):: nfid + integer, intent(out):: dimid + + integer ret ! NetCDF return code + + ret = nf90_inquire(nfid, unlimitedDimId=dimid) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_unlimdim + + subroutine wrap_inq_dim (nfid, dimid, dimname, dimlen) + implicit none +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets dimension name for a given dimension id +! +!------------------------------------------------------------------------------- + integer, intent(in):: nfid + integer, intent(in):: dimid + integer, intent(out):: dimlen + character*(*), intent(out):: dimname + + integer ret ! NetCDF return code + + ret = nf90_inquire_dimension (nfid, dimid, dimname, dimlen) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_inq_dim + + subroutine wrap_inq_nvars (nfid, nvars) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets number of variables in file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(out):: nvars + + integer ret ! NetCDF return code + + ret = nf90_inquire (nfid, nvars) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_inq_nvars + + subroutine wrap_inq_ndims (nfid, ndims) + implicit none +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets number of dimensions in file +! +!------------------------------------------------------------------------------- + integer, intent(in):: nfid + integer, intent(out):: ndims + + integer ret ! NetCDF return code + + ret = nf90_inquire(nfid, ndims) + if (ret/=NF90_NOERR) call handle_error (ret) + + end subroutine wrap_inq_ndims + +!=============================================================================== + + subroutine wrap_inq_dimid (nfid, dimname, dimid) + implicit none +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the dimension id +! +!------------------------------------------------------------------------------- + + integer, intent(in):: nfid + integer, intent(out):: dimid + character*(*), intent(in):: dimname + + integer ret ! NetCDF return code + + ret = nf90_inq_dimid (nfid, dimname, dimid) + if(ret==NF90_NOERR) return + if (ret/=NF90_EBADDIM) call handle_error (ret) + dimid=-1 ! do not exist on bad dim. This allows the user to check for dims that may not + ! be in the file + end subroutine wrap_inq_dimid + +!=============================================================================== + + subroutine wrap_inq_dimlen (nfid, dimid, dimlen) + implicit none +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the dimension length for a given dimension +! +!------------------------------------------------------------------------------- + + integer, intent(in):: nfid + integer, intent(in):: dimid + integer, intent(out):: dimlen + + integer ret ! NetCDF return code + + ret = nf90_inquire_dimension (nfid, dimid, len=dimlen) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_dimlen + +!=============================================================================== + + subroutine wrap_inq_vardimid (nfid, varid, dimids) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the dimension Id's from a variable +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: dimids(:) + + integer ret ! NetCDF return code + + ret = nf90_inquire_variable (nfid, varid, dimids=dimids) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_vardimid + +!=============================================================================== + + subroutine wrap_inq_varndims (nfid, varid, ndims) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the dimension Id's from a variable +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: ndims + + integer ret ! NetCDF return code + + ret = nf90_inquire_variable (nfid, varid, ndims=ndims) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_varndims + +!=============================================================================== + + subroutine wrap_inq_varid (nfid, varname, varid, abort) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the variable ID +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(out):: varid + character*(*), intent(in):: varname + logical, optional :: abort + + integer ret ! NetCDF return code + logical :: call_endrun + + ret = nf90_inq_varid (nfid, varname, varid) + if (ret/=NF90_NOERR ) then + call_endrun = .true. + if ( present(abort) ) then + call_endrun = abort + endif + + if ( call_endrun ) then + write(iulog,*)'wrap_inq_varid: id for ',trim(varname),' not found' + call handle_error (ret) + else + varid = -1 + endif + end if + end subroutine wrap_inq_varid + +!=============================================================================== + + subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, & + dimids, natts) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the variable name, type, number of dimensions, dimension ID's, and number of attributes +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: xtype + integer, intent(out):: ndims + integer, intent(out):: dimids(:) + integer, intent(out):: natts + character*(*), intent(out):: varname + + integer ret ! NetCDF return code + + ret = nf90_inquire_variable (nfid, varid, varname, xtype, ndims, dimids, & + natts) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_var + +!=============================================================================== + + subroutine wrap_inq_varname (nfid, varid, varname) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the variable name from the dimension ID +! +!------------------------------------------------------------------------------- + implicit none + + integer ret ! NetCDF return code + + integer, intent(in):: nfid + integer, intent(in):: varid + character*(*), intent(out):: varname + + ret = nf90_inquire_variable(nfid, varid, varname) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_inq_varname + +!=============================================================================== + + subroutine wrap_get_att_text (nfid, varid, attname, atttext) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Returns the attribute text from the given variable ID and attribute name +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + character*(*), intent(in):: attname + character*(*), intent(out):: atttext + + integer ret ! NetCDF return code + + ret = nf90_get_att(nfid, varid, attname, atttext) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_ATT_TEXT: error reading attribute '//trim(attname) + call handle_error (ret) + endif + end subroutine wrap_get_att_text + +!=============================================================================== + + subroutine wrap_put_att_text (nfid, varid, attname, atttext) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Puts the given attribute text to variable ID. +! +! This routine violates the convetion that the wrapper codes take an identical +! set of arguments as the netcdf library code. The length of the character +! argument is computed inside the wrapper. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + character*(*), intent(in):: attname + character*(*), intent(in):: atttext + + integer ret ! NetCDF return code + integer siz + + ret = nf90_put_att(nfid, varid, attname, atttext) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_att_text + +!=============================================================================== + + subroutine wrap_put_att_realx (nfid, varid, attname, xtype, len, & + attval) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Puts the given real attribute to the variable id +! +!------------------------------------------------------------------------------- + implicit none + + integer , intent(in):: nfid + integer , intent(in):: varid + integer , intent(in):: xtype + integer , intent(in):: len + character*(*) , intent(in):: attname + real(r8) , intent(in):: attval(len) + + integer ret ! NetCDF return code + + ret = nf90_put_att(nfid, varid, attname, attval) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_att_realx +!=============================================================================== + + subroutine wrap_def_dim (nfid, dimname, len, dimid) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Defines the input dimension +! +!------------------------------------------------------------------------------- + implicit none + integer, intent(in):: nfid + integer, intent(in):: len + integer, intent(out):: dimid + character*(*), intent(in):: dimname + + integer ret ! NetCDF return code + + ret = nf90_def_dim (nfid, dimname, len, dimid) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_def_dim + +!=============================================================================== + + subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Defines the given variable +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in)::xtype + integer, intent(in)::nvdims + integer, intent(out)::varid + integer, intent(in):: vdims(nvdims) + character*(*), intent(in):: name + + integer ret ! NetCDF return code + + ret = nf90_def_var(nfid, name, xtype, vdims, varid) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_def_var + +!=============================================================================== + + subroutine wrap_get_var_realx (nfid, varid, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the given real variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + real(r8), intent(out):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, arr) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_VAR_REALX: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_var_realx + +!=============================================================================== + + subroutine wrap_get_var_real4 (nfid, varid, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the given real variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + real(r4), intent(out):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, arr) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_VAR_REAL4: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_var_real4 + +!=============================================================================== + + subroutine wrap_get_scalar_realx (nfid, varid, x) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the given real variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + real(r8), intent(out):: x + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, x) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_SCALAR_REALX: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_scalar_realx + +!=============================================================================== + + subroutine wrap_get_var_int (nfid, varid, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the given integer variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, arr) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_VAR_INT: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_var_int + +!=============================================================================== + + subroutine wrap_get_scalar_int (nfid, varid, x) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets the given integer variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: x + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, x) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_SCALAR_INT: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_scalar_int + +!=============================================================================== + + subroutine wrap_get_vara_realx (nfid, varid, start, count, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets a range of the given real variable from a input file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in)::varid + integer, intent(in)::start(:) + integer, intent(in)::count(:) + real(r8), intent(out):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, arr, start, count) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_VARA_REALX: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_vara_realx + +!=============================================================================== + + subroutine wrap_get_vara_int (nfid, varid, start, count, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets a range of the given integer variable from a input file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + integer, intent(out):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, arr, start, count) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_GET_VARA_INT: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_get_vara_int + +!=============================================================================== + + subroutine wrap_get_vara_text (nfid, varid, start, count, text) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Gets a range of the given text variable to input file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + character(len=*), intent(out):: text(:) + + integer ret ! NetCDF return code + + ret = nf90_get_var (nfid, varid, text, start, count) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_get_vara_text + +!=============================================================================== + + subroutine wrap_open (path, omode, ncid) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Open a netCDF file +! +!------------------------------------------------------------------------------- + implicit none + + character*(*), intent(in):: path + integer, intent(in):: omode + integer, intent(out):: ncid + + integer ret ! NetCDF return code + + ret = nf90_open (path, omode, ncid) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_OPEN: nf90_open failed for file ',path + call handle_error (ret) + end if + end subroutine wrap_open + +!=============================================================================== + + subroutine wrap_close (ncid) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Close netCDF file +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: ncid + + integer ret ! NetCDF return code + + ret = nf90_close (ncid) + if (ret/=NF90_NOERR) then + write(iulog,*)'WRAP_CLOSE: nf90_close failed for id ',ncid + call handle_error (ret) + end if + end subroutine wrap_close + +!=============================================================================== + + subroutine wrap_put_var_int (nfid, varid, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put a integer variable on output file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, arr) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_var_int + +!=============================================================================== + + subroutine wrap_put_var1_int (nfid, varid, index, ival) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put a variable on output file at a given index. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: index(:) + integer, intent(in):: ival + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, ival, index) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_var1_int + +!=============================================================================== + + subroutine wrap_put_vara_int (nfid, varid, start, count, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put a range of a integer variable on a output file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + integer, intent(in):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, arr, start, count) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_vara_int + +!=============================================================================== + + subroutine wrap_put_vara_text (nfid, varid, start, count, text) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put a range of the given text variable to output file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + character(len=*), intent(in):: text(:) + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, text, start, count) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_vara_text + +!=============================================================================== + + subroutine wrap_put_var1_realx (nfid, varid, index, val) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put the given real variable to output file at given index. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: index(:) + real(r8), intent(in):: val + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, val, index) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_var1_realx + +!=============================================================================== + + subroutine wrap_put_vara_realx (nfid, varid, start, count, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Output the given portion of the real array. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + real(r8), intent(in):: arr(:) + + integer ret ! NetCDF return code + ret = nf90_put_var (nfid, varid, arr, start, count) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_vara_realx + +!=============================================================================== + + subroutine wrap_put_vara_real (nfid, varid, start, count, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Output the given portion of the real array. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(:) + integer, intent(in):: count(:) + real(r4), intent(in):: arr(:) + + integer ret ! NetCDF return code + ret = nf90_put_var (nfid, varid, arr, start, count) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_vara_real + +!=============================================================================== + + subroutine wrap_put_var_realx (nfid, varid, arr) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Put the given real variable to output file. +! +!------------------------------------------------------------------------------- + implicit none + + integer, intent(in):: nfid + integer, intent(in):: varid + real(r8), intent(in):: arr(:) + + integer ret ! NetCDF return code + + ret = nf90_put_var (nfid, varid, arr) + if (ret/=NF90_NOERR) call handle_error (ret) + end subroutine wrap_put_var_realx + +!=============================================================================== + + subroutine handle_error(ret) +!------------------------------------------------------------------------------- +! +! Purpose: +! +! Handle netCDF errors. +! +!------------------------------------------------------------------------------- + + implicit none + + integer, intent(in):: ret + + write(iulog,*)nf90_strerror(ret) + call endrun ('HANDLE_ERROR') + end subroutine handle_error + +!=============================================================================== + end module wrap_nf diff --git a/src/utils/xpavg_mod.F90 b/src/utils/xpavg_mod.F90 new file mode 100644 index 0000000000..1adcfebe2f --- /dev/null +++ b/src/utils/xpavg_mod.F90 @@ -0,0 +1,57 @@ +module xpavg_mod + !----------------------------------------------------------------------- + !BOP + ! !ROUTINE: xpaxg --- Average a scalar latitude field + ! + ! !INTERFACE: + implicit none + private + public :: xpavg +contains + subroutine xpavg(p, im) + + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + + ! !INPUT PARAMETERS: + integer, intent(in) :: im + + ! !INPUT/OUTPUT PARAMETERS: + real(r8), intent(inout):: p(:) + + ! + ! !DESCRIPTION: + ! This routine determines the average of the scalar latitude field p + ! and then sets all the values in p to the average. + ! + ! !REVISION HISTORY: + ! ??.??.?? Lin? Creation + ! 01.03.26 Sawyer Added ProTeX documentation + ! 07.04.06 Edwards moved to utils, placed in module form + ! + !EOP + !----------------------------------------------------------------------- + !BOC + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: D0_0 = 0.0_r8 + + integer :: i + real(r8) :: sum1 + + sum1 = D0_0 + do i=1,im + sum1 = sum1 + p(i) + enddo + sum1 = sum1 / im + + do i=1,im + p(i) = sum1 + enddo + + return + !EOC + end subroutine xpavg + !----------------------------------------------------------------------- +end module xpavg_mod diff --git a/test/system/CAM_compare.sh b/test/system/CAM_compare.sh new file mode 100755 index 0000000000..12aa790d76 --- /dev/null +++ b/test/system/CAM_compare.sh @@ -0,0 +1,39 @@ +#!/bin/sh +# + +if [ $# -ne 2 ]; then + echo "CAM_compare.sh: incorrect number of input arguments" + exit 1 +fi + +echo "CAM_compare.sh: comparing $1 " +echo " with $2" + +##note syntax here as stderr and stdout from cprnc command go +##to separate places! +# +# The -d option to cprnc is required for the comparison of sat_hist +# files, it should not affect other files. +# +${CPRNC_EXE} -d ncol:1:-1 $1 $2 2>&1 > cprnc.out +rc=$? +if [ $rc -ne 0 ]; then + echo "CAM_compare.sh: error doing comparison, cprnc error= $rc" + exit 2 +fi + +if grep -c "the two files seem to be IDENTICAL" cprnc.out > /dev/null; then + echo "CAM_compare.sh: files are b4b" +elif grep -c "the two files seem to be DIFFERENT" cprnc.out > /dev/null; then + echo "CAM_compare.sh: files are NOT b4b...the following fields had diffs" + result=`perl -e 'while (my $ll = <>) \ + { if ($ll =~ /RMS\s+(\S+)\s+(\S+)/) \ + { print "$1 " }}' cprnc.out` + echo $result + exit 3 +else + echo "CAM_compare.sh: unable to determine whether files are identical" + exit 4 +fi + +exit 0 diff --git a/test/system/CAM_runcmnd.sh b/test/system/CAM_runcmnd.sh new file mode 100755 index 0000000000..948640864e --- /dev/null +++ b/test/system/CAM_runcmnd.sh @@ -0,0 +1,60 @@ +#!/bin/sh + +# Set up run command for serial, openmp, mpi, or hybrid configurations. +# Input args: +# $1 - name of config file +# $2 - number of tasks +# $3 - number of threads + +# utility functions +. $CAM_SCRIPTDIR/CAM_utils.sh + +if [ $# -ne 3 ]; then + echo "CAM_runcmnd.sh: incorrect number of input arguments" + exit 1 +fi + +run_mode=`get_run_mode $1` + +# set up threading via use of OMP_NUM_THREADS environment variable +if [ $run_mode = serial ]; then + cmnd="" + +elif [ $run_mode = omp ] || [ $run_mode = hybrid ]; then + cmnd="env OMP_NUM_THREADS=$3 " + +elif [ $run_mode = mpi ]; then + cmnd="env OMP_NUM_THREADS=1 " +fi + +# add MPI job launcher to command + +if [ $run_mode = mpi ] || [ $run_mode = hybrid ]; then + + hostname=`hostname` + case $hostname in + + # cheyenne + ch* | r* ) + + cmnd="${cmnd} mpiexec_mpt -np $2 omplace -vv " + # cmnd="${cmnd} ddt --connect mpiexec_mpt -np $ntasks omplace -vv " + ;; + + # hobart and leehill + hob* | h[[:digit:]]* | le* ) + + cmnd="${cmnd} mpiexec -n $2 " + ;; + + * ) + echo "CAM_runcmnd.sh: unable to construct run command for unsupported machine $hostname " + exit 3 + ;; + esac + +fi + +#store command in temporary file for calling script to access +echo ${cmnd} > cam_run_command.txt +exit 0 diff --git a/test/system/CAM_utils.sh b/test/system/CAM_utils.sh new file mode 100755 index 0000000000..dfe6c36194 --- /dev/null +++ b/test/system/CAM_utils.sh @@ -0,0 +1,46 @@ +#!/bin/sh +# +# define functions used by the test scripts + +get_run_mode() +{ + # determine the CAM run mode based on arguments in the configure options file + # arg $1 is name of config options file + + if [ $# -ne 1 ]; then + echo "get_run_mode(): incorrect number of input arguments" + exit 1 + fi + + if [ ! -f ${CAM_SCRIPTDIR}/config_files/$1 ]; then + echo "get_run_mode(): configure options file ${CAM_SCRIPTDIR}/config_files/$1 not found" + exit 2 + fi + + # search config options file for parallelization info + spmd=1 + if grep -ic NOSPMD ${CAM_SCRIPTDIR}/config_files/$1 > /dev/null; then + spmd=0 + fi + + smp=1 + if grep -ic NOSMP ${CAM_SCRIPTDIR}/config_files/$1 > /dev/null; then + smp=0 + fi + + if [[ "$spmd" -eq "0" && "$smp" -eq "0" ]]; then + # serial + run_mode="serial" + elif [[ "$spmd" -eq "0" && "$smp" -eq "1" ]]; then + # openmp only + run_mode="omp" + elif [[ "$spmd" -eq "1" && "$smp" -eq "0" ]]; then + # mpi only + run_mode="mpi" + else + # hybrid + run_mode="hybrid" + fi + + echo -n $run_mode +} diff --git a/test/system/TBL.sh b/test/system/TBL.sh new file mode 100755 index 0000000000..18df93012b --- /dev/null +++ b/test/system/TBL.sh @@ -0,0 +1,144 @@ +#!/bin/sh +# + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TBL.sh: no environment variables set for baseline test - will skip" + exit 255 +fi + +if [ $# -ne 4 ]; then + echo "TBL.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TBL.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBL.sh: baseline test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBL.sh: baseline test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBL.sh: this baseline test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBL.sh: error, unable to create work subdirectory" + exit 3 +fi + +cd ${rundir} + +echo "TBL.sh: calling TSM.sh for smoke test" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBL.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CAM_TESTDIR}.bl + fi + echo "TBL.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TBL.sh: calling ****baseline**** TSM.sh for smoke test" + if [ "${CAM_BASEBACK}" = "YES" ]; then + if [ -d "${BL_ROOT}/components/cam" ]; then + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/components/cam/test/system \ + ${BL_ROOT}/components/cam/test/system/TSM.sh $1 $2 $3 + + else + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/test/system \ + ${BL_ROOT}/test/system/TSM.sh $1 $2 $3 + + fi + else + if [ -d "${BL_ROOT}/components/cam" ]; then + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/components/cam/test/system \ + ${BL_ROOT}/components/cam/test/system/TSM.sh $1 $2 $3 $4 + + else + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/test/system \ + ${BL_ROOT}/test/system/TSM.sh $1 $2 $3 $4 + + fi + fi + rc=$? + if [ $rc -ne 0 ]; then + echo "TBL.sh: error from *baseline* TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +echo "TBL.sh: starting b4b comparisons " +files_to_compare=`cd ${CAM_TESTDIR}/TSM.$1.$2.$3; ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TBL.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${BL_TESTDIR}/TSM.$1.$2.$3/${compare_file} \ + ${CAM_TESTDIR}/TSM.$1.$2.$3/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBL.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBL.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBL.sh: baseline test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TBL.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TBL.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/test/system/TBL_ccsm.sh b/test/system/TBL_ccsm.sh new file mode 100755 index 0000000000..fa6ae824dc --- /dev/null +++ b/test/system/TBL_ccsm.sh @@ -0,0 +1,147 @@ +#!/bin/sh +# + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TBL_ccsm.sh: no environment variables set for baseline test - will skip" + exit 255 +fi + +if [ $# -ne 4 ]; then + echo "TBL_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TBL_ccsm.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBL_ccsm.sh: CESM baseline test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBL_ccsm.sh: CESM baseline test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBL_ccsm.sh: this CESM baseline test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBL_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi + +cd ${rundir} + +echo "TBL_ccsm.sh: calling TSM_ccsm.sh for smoke test" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBL_ccsm.sh: error from TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CAM_TESTDIR}.bl + fi + echo "TBL_ccsm.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TBL_ccsm.sh: calling ****baseline**** TSM_ccsm.sh for smoke test" + if [ "${CAM_BASEBACK}" = "YES" ]; then + if [ -d "${BL_ROOT}/components/cam" ]; then + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/components/cam/test/system \ + CAM_ROOT=${BL_ROOT} \ + ${BL_ROOT}/components/cam/test/system/TSM_ccsm.sh $1 $2 $3 + + else + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/test/system \ + CAM_ROOT=${BL_ROOT} \ + ${BL_ROOT}/test/system/TSM_ccsm.sh $1 $2 $3 + + fi + else + if [ -d "${BL_ROOT}/components/cam" ]; then + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/components/cam/test/system \ + CAM_ROOT=${BL_ROOT} \ + ${BL_ROOT}/components/cam/test/system/TSM_ccsm.sh $1 $2 $3 $4 + + else + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/test/system \ + CAM_ROOT=${BL_ROOT} \ + ${BL_ROOT}/test/system/TSM_ccsm.sh $1 $2 $3 $4 + + fi + fi + rc=$? + if [ $rc -ne 0 ]; then + echo "TBL_ccsm.sh: error from *baseline* TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +echo "TBL_ccsm.sh: starting b4b comparisons " +files_to_compare=`cd ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$3; ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TBL_ccsm.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${BL_TESTDIR}/TSM_ccsm.$1.$2.$3/${compare_file} \ + ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$3/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBL_ccsm.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBL_ccsm.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBL_ccsm.sh: baseline test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TBL_ccsm.sh: removing some unneeded files to save disc space" + #think of any? + fi +else + echo "TBL_ccsm.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/test/system/TBR.sh b/test/system/TBR.sh new file mode 100755 index 0000000000..cb22c8bdc2 --- /dev/null +++ b/test/system/TBR.sh @@ -0,0 +1,253 @@ +#!/bin/sh +# + +# utility functions +. $CAM_SCRIPTDIR/CAM_utils.sh + +if [ $# -ne 4 ]; then + echo "TBR.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TBR.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBR.sh: branch test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBR.sh: branch test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBR.sh: this branch test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=${CAM_SCRIPTDIR}/../../bld +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBR.sh: error, unable to create work subdirectory" + exit 3 +fi + +cd ${rundir} + +initial_length=${3%+*} +branch_string=${3#*+} +if [ ${initial_length} = $3 ] || [ ${branch_string} = $3 ]; then + echo "TBR.sh: error processing input argument for run lengths" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +stop_flag=${branch_string##*[0-9]} +branch_length=${branch_string%%[sdm]} +if [ ${stop_flag} = ${branch_string} ] || [ ${branch_length} = ${branch_string} ]; then + echo "TBR.sh: error processing input argument for run length= $3" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +case $stop_flag in + s ) stop_option="nsteps";; + + d ) stop_option="ndays";; + + m ) stop_option="nmonths";; +esac + +#full_length=`expr $initial_length + $branch_length` +full_length=`expr $initial_length` + +echo "TBR.sh: calling TSM.sh for smoke test of full length ${full_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 "${full_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBR.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +echo "TBR.sh: calling TSM.sh for smoke test of initial length ${initial_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 "${initial_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBR.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +cp ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*cam* ${rundir}/. + +nl_file=${2%+*} +use_case=${2#*+} + +if [ ${use_case} != $2 ]; then + use_case_string="-use_case ${use_case}" +else + use_case_string="" +fi + +## branch from an older restart file if more than one available +## the following commands now do their ls in the directory the files were +## copied from because the above cp's sometimes wouldn't finish in time on bluesky +master_cam_restart=`ls -1rt ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*.cam*.r.*[0-9].nc \ + | tail -2 | head -1` +master_cpl_restart=`ls -1rt ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*.cpl*.r.* \ + | tail -2 | head -1` +if [ -f ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/docn_in ]; then + ocn_inparm=docn_in + ocn_branch_nlparm=restfilm + master_ocn_restart=`ls -1rt ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*.docn*.rs1.* \ + | tail -2 | head -1` +fi + +## set # of tasks/threads for branch +ntasks=$CAM_RESTART_TASKS +nthreads=$CAM_RESTART_THREADS + +run_mode=`get_run_mode $1` +if [ $run_mode = mpi ]; then + ntasks=$(( ntasks * nthreads / 2 )) +fi +echo "TBR.sh: run mode is ${run_mode}." +if [ $run_mode = mpi ] || [ $run_mode = hybrid ]; then + echo "TBR.sh: branch run will use $ntasks tasks." +fi +if [ $run_mode = omp ] || [ $run_mode = hybrid ]; then + echo "TBR.sh: branch run will use $nthreads threads." +fi + +cp ${CAM_SCRIPTDIR}/nl_files/$nl_file ${CAM_TESTDIR}/${test_name}/. +perl -pi -e 's/\$CSMDATA/$ENV{CSMDATA}/' ${CAM_TESTDIR}/${test_name}/$nl_file + +# +# Turn on all outputs, when physics is cam3, cam4, or cam5 +# + +if [[ "$1" == c3 || "$1" == c4 || "$1" == c5 ]]; then + history_output="history_aerosol=.true. history_aero_optics=.true. history_eddy=.true. history_budget=.true." +fi + +echo "TBR.sh: branching cam; output in ${CAM_TESTDIR}/${test_name}/test.log" +echo "TBR.sh: call to build-namelist:" +echo " env OMP_NUM_THREADS=$nthreads ${cfgdir}/build-namelist -test -runtype branch \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ignore_ic_date $use_case_string \ + -ntasks $ntasks \ + -namelist \"&seq_timemgr_inparm stop_n=${branch_length} stop_option=\'$stop_option\' $history_output / \ + &seq_infodata_inparm brnch_retain_casename=.true. restart_file=\'${master_cpl_restart}\' / \ + &cam_inparm cam_branch_file=\'${master_cam_restart}\' / \ + &${ocn_inparm} ${ocn_branch_nlparm}='${master_ocn_restart} ' /\"" + +env OMP_NUM_THREADS=$nthreads ${cfgdir}/build-namelist -test -runtype branch \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -ignore_ic_date $use_case_string \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ntasks $ntasks \ + -namelist "&seq_timemgr_inparm stop_n=${branch_length} stop_option='$stop_option' $history_output / \ + &seq_infodata_inparm brnch_retain_casename=.true. \ + restart_file='${master_cpl_restart}' / \ + &cam_inparm cam_branch_file='${master_cam_restart}' / \ + &${ocn_inparm} ${ocn_branch_nlparm}='${master_ocn_restart} ' /" \ + > test.log 2>&1 +rc=$? + +if [ $rc -eq 0 ]; then + echo "TBR.sh: cam build-namelist was successful" + cat drv_in + cat atm_in + cat docn_in + cat docn_in + cat docn_ocn_in + cat drv_flds_in + cat docn.stream.txt +else + echo "TBR.sh: error building namelist, error from build-namelist= $rc" + echo "TBR.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +echo "TBR.sh calling CAM_runcmnd.sh to build run command" +${CAM_SCRIPTDIR}/CAM_runcmnd.sh $1 $ntasks $nthreads +rc=$? +if [ $rc -eq 0 ] && [ -f cam_run_command.txt ]; then + read cmnd < cam_run_command.txt + echo "TBR.sh: cam run command:" + echo " $cmnd ${CAM_TESTDIR}/TCB.$1/cam" + rm cam_run_command.txt +else + echo "TBR.sh: error building run command; error from CAM_runcmnd.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 9 +fi + +${cmnd} ${CAM_TESTDIR}/TCB.$1/cam >> test.log 2>&1 +rc=$? +if [ $rc -eq 0 ] && grep -c "END OF MODEL RUN" test.log > /dev/null; then + echo "TBR.sh: branch of cam completed successfully" +else + echo "TBR.sh: error on branch run of cam, error= $rc" + echo "TBR.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 10 +fi + +echo "TBR.sh: starting b4b comparisons " +files_to_compare=`ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TBR.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 11 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${compare_file} \ + ${CAM_TESTDIR}/TSM.$1.$2.${full_length}${stop_flag}/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBR.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBR.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBR.sh: branch test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TBR.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TBR.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 12 +fi + +exit 0 diff --git a/test/system/TCB.sh b/test/system/TCB.sh new file mode 100755 index 0000000000..ba14d3aee8 --- /dev/null +++ b/test/system/TCB.sh @@ -0,0 +1,120 @@ +#!/bin/sh +# + +if [ $# -ne 2 ]; then + echo "TCB.sh: incorrect number of input arguments" + exit 1 +fi + +confile=${1%+*} +usrmech=${1#*+} + +test_name=TCB.${1} + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCB.sh: configure and build test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TCB.sh: configure and build test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TCB.sh: this configure and build test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + if [ $2 = "run_only" ]; then + echo "TCB.sh: CAM_RBOPTIONS set to run_only, this test needs to be built. Try build_only or run_and_build" + exit 2 + fi + + fi +else + if [ $2 = "run_only" ]; then + echo "TCB.sh: CAM_RBOPTIONS set to run_only, this test needs to be built. Try build_only or run_and_build" + exit 2 + fi +fi + +cfgdir=${CAM_SCRIPTDIR}/../../bld +blddir=${CAM_TESTDIR}/${test_name} +if [ -d ${blddir} ]; then + rm -rf ${blddir} +fi +mkdir -p ${blddir} +if [ $? -ne 0 ]; then + echo "TCB.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${blddir} + +if [ ! -f ${CAM_SCRIPTDIR}/config_files/${confile} ]; then + echo "TCB.sh: configure options file ${CAM_SCRIPTDIR}/config_files/${confile} not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +##construct string of args to configure +config_string="$CFG_STRING -mct_libdir $CAM_TESTDIR/lib/mct " +while read config_arg; do + config_string="${config_string}${config_arg} " +done < ${CAM_SCRIPTDIR}/config_files/${confile} + +# chemistry preprocessor +if [ $usrmech != $1 ];then + config_string="${config_string} -usr_mech_infile ${CAM_SCRIPTDIR}/config_files/$usrmech -build_chem_proc" +fi + +echo "TCB.sh: building cam executable; output in ${CAM_TESTDIR}/${test_name}/test.log" + +attempt=1 +still_compiling="TRUE" +while [ $still_compiling = "TRUE" ]; do + + echo "TCB.sh: call to configure:" + echo " ${cfgdir}/configure ${config_string}" + + ${cfgdir}/configure ${config_string} > test.log 2>&1 + rc=$? + if [ $rc -eq 0 ]; then + echo "TCB.sh: configure was successful" + else + echo "TCB.sh: cam configure failed, error from configure= $rc" + echo "TCB.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi + + echo "TCB.sh: call to make:" + echo " ${MAKE_CMD}" + ${MAKE_CMD} >> test.log 2>&1 + rc=$? + if [ $rc -eq 0 ]; then + echo "TCB.sh: make was successful" + echo "TCB.sh: configure and build test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TCB.sh: removing some unneeded files to save disc space" + rm *.o + rm *.mod + fi + still_compiling="FALSE" + elif [ $attempt -lt 10 ] && \ + grep -c "LICENSE MANAGER PROBLEM" test.log > /dev/null; then + attempt=`expr $attempt + 1` + echo "TCB.sh: encountered License Manager Problem; launching attempt #$attempt" + else + echo "TCB.sh: cam build failed, error from make= $rc" + echo "TCB.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 + fi +done + +exit 0 diff --git a/test/system/TCB_ccsm.sh b/test/system/TCB_ccsm.sh new file mode 100755 index 0000000000..7ce884c126 --- /dev/null +++ b/test/system/TCB_ccsm.sh @@ -0,0 +1,145 @@ +#!/bin/sh +# + +if [ $# -ne 3 ]; then + echo "TCB_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TCB_ccsm.$1.$2 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCB_ccsm.sh: CESM configure and build test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TCB_ccsm.sh: CESM configure and build test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TCB_ccsm.sh: this CESM configure and build test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + if [ $3 = "run_only" ]; then + echo "TCB_ccsm.sh: CAM_RBOPTIONS set to run_only, this test needs to be built. Try build_only or run_and_build" + exit 2 + fi + fi +fi + +blddir=${CAM_TESTDIR}/${test_name} +if [ -d ${blddir} ]; then + rm -rf ${blddir} +fi +mkdir -p ${blddir} +if [ $? -ne 0 ]; then + echo "TCB_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${blddir} + +echo "TCB_ccsm.sh: building ccsm executable; output in ${CAM_TESTDIR}/${test_name}/test.log" +if [ -d ${CAM_TESTDIR}/case.$1.$2 ]; then + rm -rf ${CAM_TESTDIR}/case.$1.$2 +fi + +# determine if chemistry preprocessor needs to be invoked +compset=${2%+*} +usrmech=${2#*+} + +echo ${CCSM_MACH} +if [[ -n "$CCSM_MPILIB" ]]; then + echo ${CCSM_MPILIB} + mpiopt="-mpilib $CCSM_MPILIB" +else + mpiopt="" +fi +echo "${CAM_ROOT}/cime/scripts/create_newcase --case ${CAM_TESTDIR}/case.$1.$2 \ + --res $1 --compset $compset ${mpiopt} --run-unsupported " + +${CAM_ROOT}/cime/scripts/create_newcase --case ${CAM_TESTDIR}/case.$1.$2 \ + --res $1 --compset $compset ${mpiopt} --run-unsupported >test.log 2>&1 +rc=$? +if [ $rc -eq 0 ]; then + echo "TCB_ccsm.sh: create_newcase was successful" +else + echo "TCB_ccsm.sh: create_newcase failed, error from create_newcase= $rc" + echo "TCB_ccsm.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +cd ${CAM_TESTDIR}/case.$1.$2 +echo "./xmlchange EXEROOT=${CAM_TESTDIR}/case.$1.$2/bld" +./xmlchange EXEROOT=${CAM_TESTDIR}/case.$1.$2/bld + +echo "./xmlchange RUNDIR=${CAM_TESTDIR}/case.$1.$2/run" +./xmlchange RUNDIR=${CAM_TESTDIR}/case.$1.$2/run + +# chemistry preprocessor +if [ $usrmech != $2 ]; then + string1=`grep CAM_CONFIG_OPTS env_build.xml` + string2=`echo $string1 | cut -d "=" -f 3` + cfgstring=`echo $string2 | cut -d "\"" -f 2` + echo "./xmlchange CAM_CONFIG_OPTS=""$cfgstring -usr_mech_infile ${CAM_SCRIPTDIR}/config_files/$usrmech -build_chem_proc"" " + ./xmlchange CAM_CONFIG_OPTS="$cfgstring -usr_mech_infile ${CAM_SCRIPTDIR}/config_files/$usrmech -build_chem_proc" +fi + +# +# Override CESM pe layout. +# + +for comp in ATM LND ICE OCN CPL GLC ROF WAV ESP; do + echo "./xmlchange NTASKS_${comp}=$CAM_TASKS" + ./xmlchange NTASKS_${comp}=$CAM_TASKS +# echo "./xmlchange DEBUG=TRUE" +# ./xmlchange DEBUG=TRUE + echo "./xmlchange NTHRDS_${comp}=$CAM_THREADS" + ./xmlchange NTHRDS_${comp}=$CAM_THREADS +done + + +echo "./case.setup" +./case.setup >> ${CAM_TESTDIR}/${test_name}/test.log 2>&1 +rc=$? +if [ $rc -eq 0 ]; then + echo "TCB_ccsm.sh: CESM configure was successful" +else + echo "TCB_ccsm.sh: CESM configure failed, error from configure= $rc" + echo "TCB_ccsm.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + + +buildscript=`ls *.build` +echo "./$buildscript" +./$buildscript >> ${CAM_TESTDIR}/${test_name}/test.log 2>&1 +rc=$? +if [ $rc -eq 0 ]; then + echo "TCB_ccsm.sh: CESM build was successful" +else + echo "TCB_ccsm.sh: CESM build failed, error from build= $rc" + echo "TCB_ccsm.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +cd ${blddir} +echo "TCB_ccsm.sh: CESM configure and build test passed" +echo "PASS" > TestStatus +if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TCB_ccsm.sh: removing some unneeded files to save disc space" + for dir in atm glc ice lnd ocn rof wav cpl mct pio cesm csm_share lib + do + rm -rf ${CAM_TESTDIR}/case.$1.$2/$dir + done +fi + +exit 0 diff --git a/test/system/TDD.sh b/test/system/TDD.sh new file mode 100755 index 0000000000..924086d785 --- /dev/null +++ b/test/system/TDD.sh @@ -0,0 +1,65 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TDD.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TDD.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TDD.sh: Divergence damper test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TDD.sh: Divergence damper test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TDD.sh: this Divergence damper test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TDD.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TDD.sh: calling TSM.sh for smoke test" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TDD.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +if grep -c "Divergence damper for spectral dycore invoked" ${CAM_TESTDIR}/TSM.$1.$2.$3/test.log > /dev/null; then + echo "TDD.sh: Divergence Damper test passed" + echo "PASS" > TestStatus +else + echo "TDD.sh: Divergence Damper test failed" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/test/system/TEQ.sh b/test/system/TEQ.sh new file mode 100755 index 0000000000..076d8944ca --- /dev/null +++ b/test/system/TEQ.sh @@ -0,0 +1,98 @@ +#!/bin/sh +# + +if [ $# -ne 6 ]; then + echo "TEQ.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TEQ.$1.$2.$3.$4.$5 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TEQ.sh: equivalent run test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TEQ.sh: equivalent run test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TEQ.sh: this equivalent run test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TEQ.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TEQ.sh: calling TSM.sh for first smoke test" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TEQ.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TEQ.sh: calling TSM.sh for second smoke test" +${CAM_SCRIPTDIR}/TSM.sh $3 $4 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TEQ.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ $6 = "build_only" ]; then + exit 0 +fi + +echo "TEQ.sh: starting b4b comparisons " +files_to_compare=`cd ${CAM_TESTDIR}/TSM.$1.$2.$5; ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TEQ.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${CAM_TESTDIR}/TSM.$1.$2.$5/${compare_file} \ + ${CAM_TESTDIR}/TSM.$3.$4.$5/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TEQ.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TEQ.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TEQ.sh: equivalent run test passed" + echo "PASS" > TestStatus +else + echo "TEQ.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/test/system/TEQ_ccsm.sh b/test/system/TEQ_ccsm.sh new file mode 100755 index 0000000000..d5cbcbd8a1 --- /dev/null +++ b/test/system/TEQ_ccsm.sh @@ -0,0 +1,127 @@ +#!/bin/sh +# + +if [ $# -ne 6 ]; then + echo "TEQ_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TEQ_ccsm.$1.$2.$3.$4.$5 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TEQ_ccsm.sh: CESM equivalent run test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TEQ_ccsm.sh: CESM equivalent run test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TEQ_ccsm.sh: this CESM equivalent run test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TEQ_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TEQ_ccsm.sh: calling TSM_ccsm.sh for first smoke test" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $2 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TEQ_ccsm.sh: error from TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TEQ_ccsm.sh: calling TSM.sh for second smoke test" +${CAM_SCRIPTDIR}/TSM.sh $3 $4 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TEQ_ccsm.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ $6 = "build_only" ]; then + exit 0 +fi + +echo "TEQ_ccsm.sh: starting b4b comparisons " +files_to_compare=`cd ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$5; ls *.cam.h*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TEQ_ccsm.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" + +# Compare history files +for compare_file in ${files_to_compare}; do + + mystring=${compare_file##*cam.h} + corresponding_file=`ls ${CAM_TESTDIR}/TSM.$3.$4.$5/*cam.h${mystring}` + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$5/${compare_file} \ + ${corresponding_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TEQ_ccsm.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TEQ_ccsm.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +# Compare initial files +files_to_compare=`cd ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$5; ls *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +for compare_file in ${files_to_compare}; do + + mystring=${compare_file##*i.[0-9][0-9][0-9][0-9]} + corresponding_file=`ls ${CAM_TESTDIR}/TSM.$3.$4.$5/*cam.i*${mystring}*` + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$5/${compare_file} \ + ${corresponding_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TEQ_ccsm.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TEQ_ccsm.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TEQ_ccsm.sh: equivalent run test passed" + echo "PASS" > TestStatus +else + echo "TEQ_ccsm.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/test/system/TER.sh b/test/system/TER.sh new file mode 100755 index 0000000000..bab8bf6ac4 --- /dev/null +++ b/test/system/TER.sh @@ -0,0 +1,240 @@ +#!/bin/sh +# + +# utility functions +. $CAM_SCRIPTDIR/CAM_utils.sh + +if [ $# -ne 4 ]; then + echo "TER.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TER.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TER.sh: exact restart test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TER.sh: exact restart test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TER.sh: this exact restart test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=${CAM_SCRIPTDIR}/../../bld +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TER.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +initial_length=${3%+*} +restart_string=${3#*+} +if [ ${initial_length} = $3 ] || [ ${restart_string} = $3 ]; then + echo "TER.sh: error processing input argument for run lengths" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +stop_flag=${restart_string##*[0-9]} +restart_length=${restart_string%%[sdm]} +if [ ${stop_flag} = ${restart_string} ] || [ ${restart_length} = ${restart_string} ]; then + echo "TER.sh: error processing input argument for run length= $3" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +case $stop_flag in + s ) stop_option="nsteps";; + + d ) stop_option="ndays";; + + m ) stop_option="nmonths";; +esac + +full_length=`expr $initial_length + $restart_length` + +echo "TER.sh: calling TSM.sh for smoke test of full length ${full_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 "${full_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TER.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +echo "TER.sh: calling TSM.sh for smoke test of initial length ${initial_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 "${initial_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TER.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + + +cp ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*cam* ${rundir}/. +cp ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*drv* ${rundir}/. +cp ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/rpointer* ${rundir}/. +# CARMA RRTMG files are not re-written on restart. +cp ${CAM_TESTDIR}/TSM.$1.$2.${initial_length}${stop_flag}/*CR*_rrtmg.nc ${rundir}/. + +use_case=${2#*+} +nl_file=${2%+*} + +if grep -ic endofrun ${CAM_SCRIPTDIR}/nl_files/$nl_file > /dev/null; then + # REMOVE the inithist file created at the end of the initial_length run as it + # will not be produced by the full_length run and will cause the test to fail. + echo "TER.sh: Removing inithist written by initial_length run" + rm ${rundir}/*cam*.i.*nc +fi + + +if [ ${use_case} != $2 ]; then + use_case_string="-use_case ${use_case}" +else + use_case_string="" +fi + +## set # of tasks/threads for restart +ntasks=$CAM_RESTART_TASKS +nthreads=$CAM_RESTART_THREADS + +run_mode=`get_run_mode $1` +if [ $run_mode = mpi ]; then + ntasks=$(( ntasks * nthreads / 2 )) +fi +echo "TER.sh: run mode is ${run_mode}." +if [ $run_mode = mpi ] || [ $run_mode = hybrid ]; then + echo "TER.sh: restart run will use $ntasks tasks." +fi +if [ $run_mode = omp ] || [ $run_mode = hybrid ]; then + echo "TER.sh: restart run will use $nthreads threads." +fi + +cp ${CAM_SCRIPTDIR}/nl_files/$nl_file ${CAM_TESTDIR}/${test_name}/. +perl -pi -e 's/\$CSMDATA/$ENV{CSMDATA}/' ${CAM_TESTDIR}/${test_name}/$nl_file + +# +# Turn on all outputs, when physics is cam3, cam4, or cam5 +# + +if [[ "$1" == c3 || "$1" == c4 || "$1" == c5 ]]; then + history_output="history_aerosol=.true. history_aero_optics=.true. history_eddy=.true. history_budget=.true." +fi + +echo "TER.sh: restarting sequential ccsm; output in ${CAM_TESTDIR}/${test_name}/test.log" +echo "TER.sh: call to build-namelist:" +echo " env OMP_NUM_THREADS=$nthreads ${cfgdir}/build-namelist -test -runtype continue \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ntasks $ntasks \ + -namelist \"&seq_timemgr_inparm stop_n=${restart_length} stop_option=\'$stop_option\' $history_output /\"" + +env OMP_NUM_THREADS=$nthreads ${cfgdir}/build-namelist -test -runtype continue \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -ignore_ic_date $use_case_string \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ntasks $ntasks \ + -namelist "&seq_timemgr_inparm stop_n=${restart_length} stop_option='$stop_option' $history_output / &cam_inparm /" > test.log 2>&1 +rc=$? + +if [ $rc -eq 0 ]; then + echo "TER.sh: cam build-namelist was successful" + cat drv_in + cat atm_in + cat docn_in + cat docn_ocn_in + cat drv_flds_in + cat docn.stream.txt +else + echo "TER.sh: error building namelist, error from build-namelist= $rc" + echo "TER.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +echo "TER.sh calling CAM_runcmnd.sh to build run command" +${CAM_SCRIPTDIR}/CAM_runcmnd.sh $1 $ntasks $nthreads +rc=$? +if [ $rc -eq 0 ] && [ -f cam_run_command.txt ]; then + read cmnd < cam_run_command.txt + echo "TER.sh: cam run command:" + echo " $cmnd ${CAM_TESTDIR}/TCB.$1/cam" + rm cam_run_command.txt +else + echo "TER.sh: error building run command; error from CAM_runcmnd.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 9 +fi + +${cmnd} ${CAM_TESTDIR}/TCB.$1/cam >> test.log 2>&1 +rc=$? +if [ $rc -eq 0 ] && grep -c "END OF MODEL RUN" test.log > /dev/null; then + echo "TER.sh: restart of sequential ccsm completed successfully" +else + echo "TER.sh: error on restart run of sequential ccsm, error= $rc" + echo "TER.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 10 +fi + +echo "TER.sh: starting b4b comparisons " +files_to_compare=`ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TER.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 11 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${compare_file} \ + ${CAM_TESTDIR}/TSM.$1.$2.${full_length}${stop_flag}/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TER.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TER.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TER.sh: exact restart test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TER.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TER.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 12 +fi + +exit 0 diff --git a/test/system/TER_ccsm.sh b/test/system/TER_ccsm.sh new file mode 100755 index 0000000000..c5bfc6bbfa --- /dev/null +++ b/test/system/TER_ccsm.sh @@ -0,0 +1,147 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TER_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TER_ccsm.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TER_ccsm.sh: CESM exact restart test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TER_ccsm.sh: CESM exact restart test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TER_ccsm.sh: this CESM exact restart test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TER_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +initial_length=${3%+*} +restart_string=${3#*+} +if [ ${initial_length} = $3 ] || [ ${restart_string} = $3 ]; then + echo "TER_ccsm.sh: error processing input argument for run lengths" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +stop_flag=${restart_string##*[0-9]} +restart_length=${restart_string%%[sdm]} +if [ ${stop_flag} = ${restart_string} ] || [ ${restart_length} = ${restart_string} ]; then + echo "TER_ccsm.sh: error processing input argument for run length= $3" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +case $stop_flag in + s ) stop_option="nsteps";; + + d ) stop_option="ndays";; + + m ) stop_option="nmonths";; +esac + +full_length=`expr $initial_length + $restart_length` + +echo "TER_ccsm.sh: calling TSM_ccsm.sh for smoke test of full length ${full_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $2 "${full_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TER_ccsm.sh: error from TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +echo "TER_ccsm.sh: calling TSM_ccsm.sh for smoke test of initial length ${initial_length}${stop_flag}" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $2 "${initial_length}${stop_flag}" $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TER_ccsm.sh: error from TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +echo "TER_ccsm.sh: restarting CESM; output in ${CAM_TESTDIR}/${test_name}/test.log" + +cd ${CAM_TESTDIR}/case.$1.$2 +./xmlchange STOP_N=$restart_length +./xmlchange CONTINUE_RUN=TRUE +./case.submit --no-batch > ${CAM_TESTDIR}/${test_name}/test.log 2>&1 +rc=$? +cd ${rundir} +if [ $rc -eq 0 ] && grep -c "SUCCESSFUL TERMINATION" test.log > /dev/null; then + echo "TER_ccsm.sh: restart of CESM completed successfully" +else + echo "TER_ccsm.sh: error on restart run of CESM, error= $rc" + echo "TER_ccsm.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 8 +fi + +cp ${CAM_TESTDIR}/case.$1.$2/run/*cam.h0* . + +echo "TER_ccsm.sh: starting b4b comparisons " +files_to_compare=`ls *.cam*.h*.nc *.cam*.i*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TER_ccsm.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 9 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${compare_file} \ + ${CAM_TESTDIR}/TSM_ccsm.$1.$2.${full_length}${stop_flag}/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TER_ccsm.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TER_ccsm.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TER_ccsm.sh: exact restart test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TER_ccsm.sh: removing some unneeded files to save disc space" + rm *.nc + fi +else + echo "TER_ccsm.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 10 +fi + +exit 0 diff --git a/test/system/TFM.sh b/test/system/TFM.sh new file mode 100755 index 0000000000..ffd62c46da --- /dev/null +++ b/test/system/TFM.sh @@ -0,0 +1,97 @@ +#!/bin/sh +# Test for bad svn:mergeinfo +# Ensures that the top directory has mergeinfo, and nothing else. +# This also verifies that CAM externals do not have mergeinfo below the +# root directory (except HOMME). + +# Return codes in use: +# 1: Extra mergeinfo +# 2: Error from running an external command +# 4: No mergeinfo on top level + +# Utility to check return code. +# Give it the code and an error message, and it will print stuff and exit. +check_code () { + if [ "$1" -ne 0 ]; then + echo "Error: return code from command was $1" + echo "$2" + exit 2 + fi +} + +# Little utility for finding absolute path to a directory. +get_dir_abspath () { + echo $(cd $1 && pwd) +} + +cam_top_dir=$(get_dir_abspath ${CAM_SCRIPTDIR}/..) +cesm_top_dir=$(get_dir_abspath $cam_top_dir/../../..) + +rc=0 + +# Check to make sure that the top level directory *does* have mergeinfo. +top_dir_mergeinfo=$(svn pg svn:mergeinfo "$cesm_top_dir") + +check_code "$?" "Problem running svn pg on the CAM root directory." + +if [ "${#top_dir_mergeinfo}" -lt 1 ]; then + cat < svn pd -R svn:mergeinfo +> svn revert . + +If you have changed the externals, they will be reverted, so you will have +to set the svn:externals property again after using these commands. + +EOF +fi + +if [ "$rc" -eq 0 ]; then + echo "No problems found in svn:mergeinfo in this working copy ($cesm_top_dir)." +fi + +exit $rc diff --git a/test/system/TGIT.sh b/test/system/TGIT.sh new file mode 100755 index 0000000000..b2a8cfadd7 --- /dev/null +++ b/test/system/TGIT.sh @@ -0,0 +1,90 @@ +#!/bin/sh +# Test for bad git repo +# Ensures that the top-level CAM directory +# has ".git" directory and ".gitignore" file, +# and no other git files or directories. + +# Return codes in use: +# 1: Not a git repository. +# 2: Missing ".git" directory. +# 3: Missing ".gitignore" file. +# 4: More than two ".git*" files. +# 5: Error from running an external command + +# Utility to check return code. +# Give it the code and an error message, and it will print stuff and exit. +check_code () { + if [ "$1" -ne 0 ]; then + echo "Error: return code from command was $1" + echo "$2" + exit 5 + fi +} + +# Little utility for finding absolute path to a directory. +get_dir_abspath () { + echo $(cd $1 && pwd) +} + +# Set CAM top-level directory: +cam_top_dir=$(get_dir_abspath ${CAM_SCRIPTDIR}/../..) + +# Initialize error variable: +rc=0 + +# Check to make sure that the top level directory is a git repo: +top_dir_gitinfo=$(git -C "${cam_top_dir}" rev-parse) + +# Save error code: +gitinfo_error=$? + +# Print error if directory is not a git repository: +if [ "${gitinfo_error}" -ne 0 ]; then + cat < /dev/null; then + echo "TMC.sh: mass conservation test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TMC.sh: mass conservation test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TMC.sh: this mass conservation test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TMC.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TMC.sh: calling TSM.sh for smoke test" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TMC.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +result=`perl -e 'while (my $ll = <>) \ + { if ($ll =~ /before tphysbc DRY m=\s*[\d]+ name=TT_UN [^0-9]+([\S]+)/) \ + { print "$1 " }}' ${CAM_TESTDIR}/TSM.$1.$2.$3/test.log` + +tstep=0 +for next_val in $result; do + if [ $tstep -eq 0 ]; then + first_val=$next_val + else + if [ $next_val != $first_val ]; then + echo "TMC.sh: global dry TT_UN at step $tstep ( $next_val ) not equal to value at " + echo " step 0 ( $first_val )" + echo "TMC.sh: see ${rundir}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi + fi + tstep=`expr $tstep + 1` +done + +if [ $tstep -eq 0 ]; then + echo "TMC.sh: no mass conservation data available in output log" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +else + echo "TMC.sh: mass conservation test passed" + echo "PASS" > TestStatus +fi + +exit 0 diff --git a/test/system/TNE_ccsm.sh b/test/system/TNE_ccsm.sh new file mode 100755 index 0000000000..a5fe6952c0 --- /dev/null +++ b/test/system/TNE_ccsm.sh @@ -0,0 +1,101 @@ +#!/bin/sh +# + +if [ $# -ne 5 ]; then + echo "TNE_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TNE_ccsm.$1.$2.$3.$4 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TNE_ccsm.sh: CESM equivalent run test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TNE_ccsm.sh: CESM equivalent run test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TNE_ccsm.sh: this CESM equivalent run test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TNE_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TNE_ccsm.sh: calling TSM_ccsm.sh for first smoke test" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $2 $4 $5 +rc=$? +if [ $rc -ne 0 ]; then + echo "TNE_ccsm.sh: error from TSM_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TNE_ccsm.sh: calling TSM_ccsm.sh for second smoke test" +${CAM_SCRIPTDIR}/TSM_ccsm.sh $1 $3 $4 $5 +rc=$? +if [ $rc -ne 0 ]; then + echo "TNE_ccsm.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ $5 = "build_only" ]; then + exit 0 +fi + +echo "TNE_ccsm.sh: starting b4b comparisons " +files_to_compare=`cd ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$4; ls *.cam*.h*.nc *.cam*.i.*.nc *.cam*.r.*.nc` +if [ -z "${files_to_compare}" ]; then + echo "TNE_ccsm.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + mystring=${compare_file##*.cam} + corresponding_file=`ls ${CAM_TESTDIR}/TSM_ccsm.$1.$3.$4/*${mystring}*` + + ${CAM_SCRIPTDIR}/CAM_compare.sh \ + ${CAM_TESTDIR}/TSM_ccsm.$1.$2.$4/${compare_file} \ + ${corresponding_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -ne 0 ]; then + echo "TNE_ccsm.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TNE_ccsm.sh: error from CAM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TNE_ccsm.sh: non-equivalent run test passed" + echo "PASS" > TestStatus +else + echo "TNE_ccsm.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/test/system/TPF.sh b/test/system/TPF.sh new file mode 100755 index 0000000000..982dc9432f --- /dev/null +++ b/test/system/TPF.sh @@ -0,0 +1,125 @@ +#!/bin/sh +# + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TPF.sh: no environment variables set for baseline performance test - will skip" + exit 255 +fi + +if [ $# -ne 4 ]; then + echo "TPF.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TPF.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TPF.sh: baseline performance test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TPF.sh: baseline performance test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TPF.sh: this baseline performance test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TPF.sh: error, unable to create work subdirectory" + exit 3 +fi + +cd ${rundir} + +echo "TPF.sh: calling TSM.sh for smoke test" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TPF.sh: error from TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CAM_TESTDIR}.bl + fi + echo "TPF.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TPF.sh: calling ****baseline**** TSM.sh for smoke test" + if [ -d "${BL_ROOT}/components/cam" ]; then + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/components/cam/test/system \ + ${BL_ROOT}/components/cam/test/system/TSM.sh $1 $2 $3 $4 + + else + + env CAM_TESTDIR=${BL_TESTDIR} \ + CAM_SCRIPTDIR=${BL_ROOT}/test/system \ + ${BL_ROOT}/test/system/TSM.sh $1 $2 $3 $4 + + fi + rc=$? + if [ $rc -ne 0 ]; then + echo "TPF.sh: error from *baseline* TSM.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +#made the following extraction of timing info compatible with single or multiple timing files +model_time=`grep -i "CPL:RUN_LOOP " ${CAM_TESTDIR}/TSM.$1.$2.$3/cesm_timing* | perl -e 'while (my $ll = <>) \ + { if ($ll =~ /CPL:RUN_LOOP[\s-]+[0-9]+[\s-]+([0-9\.]+)/) \ + { print "$1"; last }}' ` +if [ "$model_time" = "" ]; then + echo "TPF.sh: unable to determine model time from timing file(s) in ${CAM_TESTDIR}/TSM.$1.$2.$3/" + exit 6 +fi + +echo "TPF.sh: model_time= $model_time" + +#made the following extraction of timing info compatible with single or multiple timing files +bl_time=`grep -i "CPL:RUN_LOOP " ${BL_TESTDIR}/TSM.$1.$2.$3/cesm_timing* | perl -e 'while (my $ll = <>) \ + { if ($ll =~ /CPL:RUN_LOOP[\s-]+[0-9]+[\s-]+([0-9\.]+)/) \ + { print "$1"; last }}' ` +if [ "$bl_time" = "" ]; then + echo "TPF.sh: unable to determine model time from timing file(s) in ${BL_TESTDIR}/TSM.$1.$2.$3/" + exit 7 +fi + +echo "TPF.sh: bl_time= $bl_time" + +perf_hit=`echo 5 k $model_time $bl_time / 100.00 * p | dc` +perf_hit=${perf_hit%.*} +perf_hit=`echo $perf_hit 100 - p | dc` +echo "TPF.sh: baseline performance hit= ${perf_hit}% (cutoff is 5%)" +if [ $perf_hit -gt 5 ]; then + echo "TPF.sh: baseline performance test failed" + echo "FAIL.job${JOBID}" > TestStatus + exit 8 +else + echo "TPF.sh: baseline performance test passed" + echo "PASS" > TestStatus +fi + +exit 0 diff --git a/test/system/TR8.sh b/test/system/TR8.sh new file mode 100755 index 0000000000..8c7079ba44 --- /dev/null +++ b/test/system/TR8.sh @@ -0,0 +1,125 @@ +#!/bin/sh +# Test for missing r8 +# + + +# Check physics +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/cam +rc=$? +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/waccm +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/waccmx +rc=`expr $? + $rc` + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/cam +rc=$? +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/camrt +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/rrtmg -s aer_src +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/simple +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/waccm +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/waccmx +rc=`expr $? + $rc` + +fi + +#Check Ionosphere +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/ionosphere +rc=`expr $? + $rc` + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/ionosphere +rc=`expr $? + $rc` + +fi + +#Check Chemistry +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/chemistry +rc=`expr $? + $rc` + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/chemistry +rc=`expr $? + $rc` + +fi + +#Check Dynamics +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/dynamics/se -s share +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/dynamics/fv +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/dynamics/eul +rc=`expr $? + $rc` + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/dynamics/se +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/dynamics/fv +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/dynamics/eul +rc=`expr $? + $rc` + +fi + +#Check other +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/advection +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/control +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/utils +rc=`expr $? + $rc` + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/advection +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/control +rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/utils +rc=`expr $? + $rc` + +fi + +#Check coupler +if [ -d "${CAM_ROOT}/components/cam" ]; then + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/cpl +rc=`expr $? + $rc` + + + +else + +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/cpl +rc=`expr $? + $rc` + +fi + +echo $rc + +if [ $rc = 255 ]; then + rc=1 +fi + + + +echo $rc +exit $rc diff --git a/test/system/TSC.sh b/test/system/TSC.sh new file mode 100755 index 0000000000..e00b156e53 --- /dev/null +++ b/test/system/TSC.sh @@ -0,0 +1,94 @@ +#!/bin/sh +# + +if [ $# -ne 6 ]; then + echo "TSC.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSC.$1.$2.$3.$4.$5 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSC.sh: scam b4b test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSC.sh: scam b4b test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSC.sh: this scam b4b test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSC.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TSC.sh: calling TSM.sh for cam to generate iop datafiles" +${CAM_SCRIPTDIR}/TSM.sh $1 $2 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSC.sh: error from TSM.sh for cam run= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +#temporarily stage these files one level up in work directory tree +cp ${CAM_TESTDIR}/TSM.$1.$2.$5/camrun.*.i.*.nc ../. +cp ${CAM_TESTDIR}/TSM.$1.$2.$5/camrun.*.h1.*.nc ../. + +echo "TSC.sh: calling TSM.sh using iop files as input to single-column model" +${CAM_SCRIPTDIR}/TSM.sh $3 $4 $5 $6 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSC.sh: error from TSM.sh for scam run= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + + +if [ $6 = "build_only" ]; then + exit 0 +fi + +#remove temporarily staged files +if [ $CAM_RETAIN_FILES != "TRUE" ]; then + rm ../camrun.* +fi + +# Now test the output +echo "TSC.sh: Comparing answers to ensure SCAM gives bit-for-bit answers as CAM ... " +myvar=`ncdump -ff -p 9,17 -v QDIFF,TDIFF ${CAM_TESTDIR}/TSM.$3.$4.$5/camrun.*.h1.*00000.nc | egrep //\.\*DIFF | sed s/^\ \*// | sed s/\[,\;\].\*\$// | uniq` +if [ "$myvar" == "0" ]; then + myvar=`ncdump -ff -p 9,17 -v QDIFF,TDIFF ${CAM_TESTDIR}/TSM.$3.$4.$5/camrun.*.h1.*08400.nc | egrep //\.\*DIFF | sed s/^\ \*// | sed s/\[,\;\].\*\$// | uniq` + if [ "$myvar" == "0" ]; then + echo "TSC.sh: scam b4b test passed" + echo "PASS" > TestStatus + else + echo "TSC.sh: scam b4b test did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 + fi +else + echo "TSC.sh: scam b4b test did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/test/system/TSM.sh b/test/system/TSM.sh new file mode 100755 index 0000000000..db52a59b6a --- /dev/null +++ b/test/system/TSM.sh @@ -0,0 +1,182 @@ +#!/bin/sh +# + +# utility functions +. $CAM_SCRIPTDIR/CAM_utils.sh + +echo "TSM.sh: called with args: $1 $2 $3 $4" + +if [ $# -ne 4 ]; then + echo "TSM.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSM.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSM.sh: smoke test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSM.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSM.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=${CAM_SCRIPTDIR}/../../bld +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSM.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TSM.sh: calling TCB.sh to prepare cam executable" +echo "${CAM_SCRIPTDIR}/TCB.sh $1 $4" +${CAM_SCRIPTDIR}/TCB.sh $1 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSM.sh: error from TCB.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +nl_file=${2%+*} +use_case=${2#*+} + +if [ ! -f ${CAM_SCRIPTDIR}/nl_files/$nl_file ]; then + echo "TSM.sh: namelist options file ${CAM_SCRIPTDIR}/nl_files/$nl_file not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ ${use_case} != $2 ]; then + use_case_string="-use_case ${use_case}" +else + use_case_string="" +fi + +stop_flag=${3##*[0-9]} +run_length=${3%%[sdm]} +if [ ${stop_flag} = $3 ] || [ ${run_length} = $3 ]; then + echo "TSM.sh: error processing input argument for run length= $3" + echo "FAIL.job${JOBID}" > TestStatus + exit 99 +fi + +case $stop_flag in + s ) stop_option="nsteps";; + + d ) stop_option="ndays";; + + m ) stop_option="nmonths";; +esac + +# set # of tasks/threads for smoke test +ntasks=$CAM_TASKS +nthreads=$CAM_THREADS + +run_mode=`get_run_mode $1` +if [ $run_mode = mpi ]; then + ntasks=$(( CAM_TASKS * CAM_THREADS )) +fi +echo "TSM.sh: run mode is ${run_mode}." +if [ $run_mode = mpi ] || [ $run_mode = hybrid ]; then + echo "TSM.sh: run will use $ntasks tasks." +fi + +cp ${CAM_SCRIPTDIR}/nl_files/$nl_file ${CAM_TESTDIR}/${test_name}/. +perl -pi -e 's/\$CSMDATA/$ENV{CSMDATA}/' ${CAM_TESTDIR}/${test_name}/$nl_file + +# +# Turn on all outputs, when physics is cam3, cam4, or cam5 +# + +if [[ "$1" == c3 || "$1" == c4 || "$1" == c5 ]]; then + history_output="history_aerosol=.true. history_aero_optics=.true. history_eddy=.true. history_budget=.true." +fi + +echo "TSM.sh: running cam; output in ${CAM_TESTDIR}/${test_name}/test.log" +echo "TSM.sh: call to build-namelist:" +echo " env OMP_NUM_THREADS=$nthreads ${cfgdir}/build-namelist -test -runtype startup \ + -ignore_ic_date $use_case_string \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ntasks $ntasks \ + -namelist \"&seq_timemgr_inparm stop_n=$run_length stop_option=\'$stop_option\' /\"" + +env OMP_NUM_THREADS=$nthreads perl ${cfgdir}/build-namelist -test -runtype startup \ + -ignore_ic_date $use_case_string \ + -config ${CAM_TESTDIR}/TCB.$1/config_cache.xml \ + -infile ${CAM_TESTDIR}/${test_name}/$nl_file \ + -ntasks $ntasks \ + -namelist "&seq_timemgr_inparm stop_n=$run_length stop_option='$stop_option' $history_output/" > test.log 2>&1 +rc=$? + +if [ $rc -eq 0 ]; then + echo "TSM.sh: cam build-namelist was successful" + cat drv_in + cat atm_in + cat docn_in + cat docn_ocn_in + cat drv_flds_in + cat docn.stream.txt +else + echo "TSM.sh: error building namelist, error from build-namelist= $rc" + echo "TSM.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +echo "TSM.sh calling CAM_runcmnd.sh to build run command" +${CAM_SCRIPTDIR}/CAM_runcmnd.sh $1 $ntasks $nthreads +rc=$? +if [ $rc -eq 0 ] && [ -f cam_run_command.txt ]; then + read cmnd < cam_run_command.txt + echo "TSM.sh: cam run command:" + echo " $cmnd ${CAM_TESTDIR}/TCB.$1/cam" + rm cam_run_command.txt +else + echo "TSM.sh: error building run command; error from CAM_runcmnd.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 8 +fi + +${cmnd} ${CAM_TESTDIR}/TCB.$1/cam >> test.log 2>&1 +rc=$? +if [ $rc -eq 0 ] && grep -c "END OF MODEL RUN" test.log > /dev/null; then + echo "TSM.sh: smoke test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TSM.sh: removing some unneeded files to save disc space" + if [ -f *.clm*.i.* ]; then + rm *.clm*.i.* + fi + fi +else + echo "TSM.sh: error running cam, error= $rc" + echo "TSM.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 8 +fi + +exit 0 diff --git a/test/system/TSM_ccsm.sh b/test/system/TSM_ccsm.sh new file mode 100755 index 0000000000..d9b4d206a2 --- /dev/null +++ b/test/system/TSM_ccsm.sh @@ -0,0 +1,121 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TSM_ccsm.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSM_ccsm.$1.$2.$3 + +if [ -f ${CAM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CAM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSM_ccsm.sh: CESM smoke test has already passed; results are in " + echo " ${CAM_TESTDIR}/${test_name}" + exit 0 + else + read fail_msg < ${CAM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSM_ccsm.sh: CESM smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CAM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSM_ccsm.sh: this CESM smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CAM_TESTDIR}/${test_name} ${CAM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CAM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -rf ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSM_ccsm.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TSM_ccsm.sh: calling TCB_ccsm.sh to prepare cam executable" +${CAM_SCRIPTDIR}/TCB_ccsm.sh $1 $2 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSM_ccsm.sh: error from TCB_ccsm.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ $4 = "build_only" ]; then + exit 0 +fi + +rm -f ${CAM_TESTDIR}/case.$1.$2/run/*cam.h* + +stop_flag=${3##*[0-9]} +run_length=${3%%[sdm]} +if [ ${stop_flag} = $3 ] || [ ${run_length} = $3 ]; then + echo "TSM_ccsm.sh: error processing input argument for run length= $3" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +case $stop_flag in + s ) stop_option="nsteps";; + + d ) stop_option="ndays";; + + m ) stop_option="nmonths";; +esac + +echo "TSM_ccsm.sh: running CESM; output in ${CAM_TESTDIR}/${test_name}/test.log" + +cd ${CAM_TESTDIR}/case.$1.$2 + +if [ ${stop_flag} = 's' ]; then + if [ ${run_length} = '1' ]; then + echo "cp ${CAM_SCRIPTDIR}/nl_files/outfrq1s ./user_nl_cam" + cp ${CAM_SCRIPTDIR}/nl_files/outfrq1s ./user_nl_cam + else + echo "cp ${CAM_SCRIPTDIR}/nl_files/outfrq9s ./user_nl_cam" + cp ${CAM_SCRIPTDIR}/nl_files/outfrq9s ./user_nl_cam + fi +else + echo "cp ${CAM_SCRIPTDIR}/nl_files/outfrq24h ./user_nl_cam" + cp ${CAM_SCRIPTDIR}/nl_files/outfrq24h ./user_nl_cam +fi + +./xmlchange STOP_N=$run_length +./xmlchange STOP_OPTION=$stop_option +./xmlchange DOUT_S=FALSE +CIMEROOT=${CAM_ROOT}/cime ./case.submit --no-batch > ${CAM_TESTDIR}/${test_name}/test.log 2>&1 +rc=$? +cd ${rundir} +if [ -e ${CAM_TESTDIR}/case.$1.$2/logs/atm.log* ]; then + log_file=`ls -t ${CAM_TESTDIR}/case.$1.$2/logs/atm.log* | head -n1` +else + log_file=`ls -t ${CAM_TESTDIR}/case.$1.$2/run/atm.log* | head -n1` +fi +echo 'log_file:' $log_file +if [ $rc -eq 0 ] && zgrep -c "END OF MODEL RUN" $log_file > /dev/null; then + echo "TSM_ccsm.sh: CESM smoke test passed" + echo "PASS" > TestStatus + if [ $CAM_RETAIN_FILES != "TRUE" ]; then + echo "TSM_ccsm.sh: removing some unneeded files to save disc space" + #think of any? + fi +else + echo "TSM_ccsm.sh: error running CESM, error= $rc" + echo "TSM_ccsm.sh: see ${CAM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +cp ${CAM_TESTDIR}/case.$1.$2/run/*cam.h* . +cp ${CAM_TESTDIR}/case.$1.$2/run/*cam.i.* . +cp ${CAM_TESTDIR}/case.$1.$2/run/*cam.r.* . + +exit 0 diff --git a/test/system/archive_baseline.sh b/test/system/archive_baseline.sh new file mode 100755 index 0000000000..3ce583268f --- /dev/null +++ b/test/system/archive_baseline.sh @@ -0,0 +1,183 @@ +#!/bin/sh -f + +echo + +if [ $# -ne 1 ]; then + echo "Invoke archive_baseline.sh -help for usage." + exit 1 +fi + +if [ $1 == "-help" ]; then +cat << EOF1 +NAME + + archive_baseline.sh - archive pretag baselines to set locations on + hobart and cheyenne. + + +SYNOPSIS + + archive_baseline.sh TAGNAME + [-help] + + +ENVIROMENT VARIABLES + + CESM_TESTDIR - Directory that contains the CESM finished results you wish to archive. + CAM_TESTDIR - Directory that contains the CAM finished results you wish to archive. + CAM_FC - Compiler used, only used on hobart (PGI,NAG), where the compiler + name is appended to the archive directory. + + +BASELINE ARCHIVED LOCATION + + hobart: /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_pgi + /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_nag + cheyenne: /glade/p/cesm/cseg/models/atm/cam/pretag_bl/TAGNAME + + + +HOW TO USE ARCHIVE BASELINES + + Set BL_TESTDIR to the archived baseline you wish to load. + + +WORK FLOW + + This is an example for hobart. + + Modify your sandbox with the changes you want. + setenv CAM_FC PGI + setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_06 + Run the cam test suite. + Make your trunk tag + archive_baseline.sh cam5_2_06 + + Create a new sandbox. + setenv CAM_FC PGI + setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_07 + setenv BL_TESTDIR /fs/cgd/csm/models/atm/cam/pretag_bl/cam5_2_06_pgi + Run the cam test suite. + Make your trunk tag + archive_baseline.sh cam5_2_07 + + +WARNING + + System changes can cause answer changes. So you may need to create new baselines + if you are getting unexpected baseline failures. + +EOF1 +exit +fi + +if [ -z "$CAM_TESTDIR" ]; then + echo "ERROR: please set CAM_TESTDIR" + echo + exit 1 +fi + + +hostname=`hostname` +case $hostname in + + ho*) + echo "server: hobart" + if [ -z "$CAM_FC" ]; then + CAM_FC="PGI" + fi + test_file_list="tests_pretag_hobart_${CAM_FC,,}" + baselinedir="/fs/cgd/csm/models/atm/cam/pretag_bl/$1_${CAM_FC,,}" + ;; + + ch*) + echo "server: cheyenne" + if [ -z "$CAM_FC" ]; then + CAM_FC="INTEL" + fi + test_file_list="tests_pretag_cheyenne" + baselinedir="/glade/p/cesm/cseg/models/atm/cam/pretag_bl/$1" + ;; + + * ) echo "ERROR: machine $hostname not currently supported"; exit 1 ;; +esac + +if [ -n "$CESM_TESTDIR" ]; then + + echo " " + case $hostname in + ch*) + echo "CESM Archiving to /glade/p/cesmdata/cseg/cesm_baselines/$1" + ;; + + hobart) + echo "CESM Archiving to /fs/cgd/csm/models/atm/cam/cesm_baselines/$1" + ;; + esac + echo " " + + ../../../../cime/scripts/Tools/bless_test_results -p -t '' -c '' -r $CESM_TESTDIR -b $1 -f -s +fi + +echo +echo "Archiving to ${baselinedir}" +echo +if [ -d ${baselinedir} ]; then + echo "ERROR: Baseline $baselinedir already exists." + exit 1 +fi + +mkdir $baselinedir + +if [ ! -d ${baselinedir} ]; then + echo "ERROR: Failed to make ${baselinedir}" + exit 1 +fi + +echo "Archiving the following directories." +test_list="" +while read input_line; do + test_list="${input_line} " + for test_id in ${test_list}; do + master_line=`grep $test_id input_tests_master` + str1=${master_line%% *} + temp=${master_line#$str1 } + str2=${temp%% *} + + temp=${temp#$str2 } + str3=${temp%% *} + temp=${temp#$str3 } + str4=${temp%% *} + temp=${temp#$str4 } + str5=${temp%% *} + + temp=${str2%%.*} + scr1=${temp#"TBL"} + scr1=${temp#"TBL"} + + + + if grep -c TBL ${str2} > /dev/null; then + case="TSM${scr1}.$str3.$str4.$str5" + ls -ld ${CAM_TESTDIR}/${case} + cp -rp ${CAM_TESTDIR}/${case} ${baselinedir}/${case} + chmod -R a+r ${baselinedir} + chmod -R g+w ${baselinedir} + fi + + done + +done < ${test_file_list} + +case $hostname in + + ch* | hobart) + if [ -z "$CESM_TESTDIR" ]; then + echo '***********************************************************************************' + echo 'INFO: The aux_cam and test_cam tests were NOT archived' + echo "INFO: Must set CESM_TESTDIR (test-root in the create_test) to archive aux_cam tests" + echo '***********************************************************************************' + fi + ;; + +esac diff --git a/test/system/config_files/e48adh b/test/system/config_files/e48adh new file mode 100644 index 0000000000..4686d3a346 --- /dev/null +++ b/test/system/config_files/e48adh @@ -0,0 +1,6 @@ +-smp -spmd +-dyn eul +-hgrid 48x96 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/e48c4paqdm b/test/system/config_files/e48c4paqdm new file mode 100644 index 0000000000..07b053c822 --- /dev/null +++ b/test/system/config_files/e48c4paqdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn eul +-hgrid 48x96 +-phys cam4 +-debug +-pergro +-ocn aquaplanet +-s diff --git a/test/system/config_files/e48idh b/test/system/config_files/e48idh new file mode 100644 index 0000000000..060643bc12 --- /dev/null +++ b/test/system/config_files/e48idh @@ -0,0 +1,6 @@ +-spmd -smp +-dyn eul +-hgrid 48x96 +-phys held_suarez +-debug +-s diff --git a/test/system/config_files/e64addh b/test/system/config_files/e64addh new file mode 100644 index 0000000000..022a59a2eb --- /dev/null +++ b/test/system/config_files/e64addh @@ -0,0 +1,6 @@ +-spmd -smp +-dyn eul +-hgrid 64x128 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/e64adh b/test/system/config_files/e64adh new file mode 100644 index 0000000000..c539976a38 --- /dev/null +++ b/test/system/config_files/e64adh @@ -0,0 +1,5 @@ +-spmd -smp +-dyn eul +-hgrid 64x128 +-phys adiabatic +-s diff --git a/test/system/config_files/e64c4aqiopdm b/test/system/config_files/e64c4aqiopdm new file mode 100644 index 0000000000..dd98b075ed --- /dev/null +++ b/test/system/config_files/e64c4aqiopdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn eul +-hgrid 64x128 +-phys cam4 +-aquaplanet +-camiop +-debug +-s diff --git a/test/system/config_files/e64c5aqiopdm b/test/system/config_files/e64c5aqiopdm new file mode 100644 index 0000000000..534b361c10 --- /dev/null +++ b/test/system/config_files/e64c5aqiopdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn eul +-hgrid 64x128 +-phys cam5 +-aquaplanet +-camiop +-debug +-s diff --git a/test/system/config_files/e64c6aqiopdm b/test/system/config_files/e64c6aqiopdm new file mode 100644 index 0000000000..806aa2b415 --- /dev/null +++ b/test/system/config_files/e64c6aqiopdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn eul +-hgrid 64x128 +-phys cam6 +-aquaplanet +-camiop +-noclubb_sgs +-debug +-s diff --git a/test/system/config_files/e64hsdh b/test/system/config_files/e64hsdh new file mode 100644 index 0000000000..00190a05a0 --- /dev/null +++ b/test/system/config_files/e64hsdh @@ -0,0 +1,6 @@ +-spmd -smp +-dyn eul +-hgrid 64x128 +-phys held_suarez +-debug +-s diff --git a/test/system/config_files/e8c3aqdm b/test/system/config_files/e8c3aqdm new file mode 100644 index 0000000000..d6c9290f10 --- /dev/null +++ b/test/system/config_files/e8c3aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn eul +-hgrid 8x16 +-phys cam3 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/e8c4aqdm b/test/system/config_files/e8c4aqdm new file mode 100644 index 0000000000..9bc58fc25b --- /dev/null +++ b/test/system/config_files/e8c4aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn eul +-hgrid 8x16 +-phys cam4 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/e8c5aqt5mdm b/test/system/config_files/e8c5aqt5mdm new file mode 100644 index 0000000000..6b4cbf5335 --- /dev/null +++ b/test/system/config_files/e8c5aqt5mdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn eul +-hgrid 8x16 +-debug +-nadv_tt 5 +-cppdefs -DTRACER_CHECK +-phys cam5 +-aquaplanet +-s diff --git a/test/system/config_files/e8idm b/test/system/config_files/e8idm new file mode 100644 index 0000000000..550f60b0e5 --- /dev/null +++ b/test/system/config_files/e8idm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn eul +-hgrid 8x16 +-phys held_suarez +-debug +-s diff --git a/test/system/config_files/f1.9c4aqbamm b/test/system/config_files/f1.9c4aqbamm new file mode 100644 index 0000000000..6af615963d --- /dev/null +++ b/test/system/config_files/f1.9c4aqbamm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn fv +-hgrid 1.9x2.5 +-chem trop_bam +-phys cam4 +-aquaplanet +-s diff --git a/test/system/config_files/f1.9c4aqh b/test/system/config_files/f1.9c4aqh new file mode 100644 index 0000000000..8a6eef6387 --- /dev/null +++ b/test/system/config_files/f1.9c4aqh @@ -0,0 +1,7 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-aquaplanet +-ocn docn +-s diff --git a/test/system/config_files/f1.9c4aqmozdh b/test/system/config_files/f1.9c4aqmozdh new file mode 100644 index 0000000000..38b6abbed3 --- /dev/null +++ b/test/system/config_files/f1.9c4aqmozdh @@ -0,0 +1,8 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-aquaplanet +-chem trop_mozart +-debug +-s diff --git a/test/system/config_files/f1.9c4aqwmxdh b/test/system/config_files/f1.9c4aqwmxdh new file mode 100644 index 0000000000..8a2828e86f --- /dev/null +++ b/test/system/config_files/f1.9c4aqwmxdh @@ -0,0 +1,9 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-aquaplanet +-chem waccm_ma +-waccmx +-debug +-s diff --git a/test/system/config_files/f1.9c4aqwmxidh b/test/system/config_files/f1.9c4aqwmxidh new file mode 100644 index 0000000000..a125177177 --- /dev/null +++ b/test/system/config_files/f1.9c4aqwmxidh @@ -0,0 +1,10 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-aquaplanet +-chem waccm_ma +-waccmx +-ionosphere wxi +-debug +-s diff --git a/test/system/config_files/f1.9c4cdm b/test/system/config_files/f1.9c4cdm new file mode 100644 index 0000000000..8acbc092d9 --- /dev/null +++ b/test/system/config_files/f1.9c4cdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-cosp +-debug +-s diff --git a/test/system/config_files/f1.9c4h b/test/system/config_files/f1.9c4h new file mode 100644 index 0000000000..b26336481f --- /dev/null +++ b/test/system/config_files/f1.9c4h @@ -0,0 +1,5 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4portdh b/test/system/config_files/f1.9c4portdh new file mode 100755 index 0000000000..8f32c8e58e --- /dev/null +++ b/test/system/config_files/f1.9c4portdh @@ -0,0 +1,7 @@ +-spmd -smp +-offline_drv rad +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-debug +-s diff --git a/test/system/config_files/f1.9c4portdm b/test/system/config_files/f1.9c4portdm new file mode 100755 index 0000000000..21a046eba3 --- /dev/null +++ b/test/system/config_files/f1.9c4portdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-offline_drv rad +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-debug +-s diff --git a/test/system/config_files/f1.9c4wmdh b/test/system/config_files/f1.9c4wmdh new file mode 100755 index 0000000000..3de1ca5c9a --- /dev/null +++ b/test/system/config_files/f1.9c4wmdh @@ -0,0 +1,7 @@ +-debug -spmd -smp +-chem waccm_ma +-age_of_air_trcs +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4wmh b/test/system/config_files/f1.9c4wmh new file mode 100644 index 0000000000..44c375bd96 --- /dev/null +++ b/test/system/config_files/f1.9c4wmh @@ -0,0 +1,6 @@ +-spmd -smp +-chem waccm_ma +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4wmm b/test/system/config_files/f1.9c4wmm new file mode 100644 index 0000000000..ad3f29e517 --- /dev/null +++ b/test/system/config_files/f1.9c4wmm @@ -0,0 +1,6 @@ +-spmd -nosmp +-chem waccm_ma +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4wscdm b/test/system/config_files/f1.9c4wscdm new file mode 100644 index 0000000000..54a69ccf31 --- /dev/null +++ b/test/system/config_files/f1.9c4wscdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-chem waccm_sc +-dyn fv +-hgrid 1.9x2.5 +-debug +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4wtsmltdh b/test/system/config_files/f1.9c4wtsmltdh new file mode 100755 index 0000000000..ca561dcd2d --- /dev/null +++ b/test/system/config_files/f1.9c4wtsmltdh @@ -0,0 +1,8 @@ +-spmd -smp +-chem waccm_tsmlt +-age_of_air_trcs +-dyn fv +-hgrid 1.9x2.5 +-debug +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c4wtsmlth b/test/system/config_files/f1.9c4wtsmlth new file mode 100755 index 0000000000..c8bc0689ec --- /dev/null +++ b/test/system/config_files/f1.9c4wtsmlth @@ -0,0 +1,6 @@ +-spmd -smp +-chem waccm_tsmlt +-dyn fv +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/f1.9c5aqm b/test/system/config_files/f1.9c5aqm new file mode 100644 index 0000000000..eea31615e5 --- /dev/null +++ b/test/system/config_files/f1.9c5aqm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn fv +-hgrid 1.9x2.5 +-phys cam5 +-aquaplanet +-s diff --git a/test/system/config_files/f1.9c5carmdusdm b/test/system/config_files/f1.9c5carmdusdm new file mode 100644 index 0000000000..0efe537356 --- /dev/null +++ b/test/system/config_files/f1.9c5carmdusdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-debug +-dyn fv +-hgrid 1.9x2.5 +-phys cam5 +-carma dust +-s diff --git a/test/system/config_files/f1.9c5carmdusm b/test/system/config_files/f1.9c5carmdusm new file mode 100644 index 0000000000..bb3c7f96e2 --- /dev/null +++ b/test/system/config_files/f1.9c5carmdusm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn fv +-hgrid 1.9x2.5 +-phys cam5 +-carma dust +-s diff --git a/test/system/config_files/f1.9c6aqcdh b/test/system/config_files/f1.9c6aqcdh new file mode 100644 index 0000000000..6f9e52afb5 --- /dev/null +++ b/test/system/config_files/f1.9c6aqcdh @@ -0,0 +1,8 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam6 +-aquaplanet +-cosp +-debug +-s diff --git a/test/system/config_files/f1.9c6aqcdm b/test/system/config_files/f1.9c6aqcdm new file mode 100644 index 0000000000..c87a0a3185 --- /dev/null +++ b/test/system/config_files/f1.9c6aqcdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 1.9x2.5 +-phys cam6 +-aquaplanet +-cosp +-debug +-s diff --git a/test/system/config_files/f1.9c6aqtsvbsdh b/test/system/config_files/f1.9c6aqtsvbsdh new file mode 100644 index 0000000000..f21ab62b48 --- /dev/null +++ b/test/system/config_files/f1.9c6aqtsvbsdh @@ -0,0 +1,8 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam6 +-aquaplanet +-chem trop_strat_mam4_vbs +-debug +-s diff --git a/test/system/config_files/f1.9c6aqwmth b/test/system/config_files/f1.9c6aqwmth new file mode 100644 index 0000000000..c17397ba86 --- /dev/null +++ b/test/system/config_files/f1.9c6aqwmth @@ -0,0 +1,7 @@ +-spmd -smp +-chem waccm_tsmlt_mam4 +-dyn fv +-hgrid 1.9x2.5 +-phys cam6 +-aquaplanet +-s diff --git a/test/system/config_files/f1.9c6aqwscdh b/test/system/config_files/f1.9c6aqwscdh new file mode 100644 index 0000000000..6fb8716f24 --- /dev/null +++ b/test/system/config_files/f1.9c6aqwscdh @@ -0,0 +1,9 @@ +-spmd -smp +-dyn fv +-hgrid 1.9x2.5 +-phys cam6 +-aquaplanet +-chem waccm_sc_mam4 +-age_of_air_trcs +-debug +-s diff --git a/test/system/config_files/f10adhterm b/test/system/config_files/f10adhterm new file mode 100644 index 0000000000..869cc27d8b --- /dev/null +++ b/test/system/config_files/f10adhterm @@ -0,0 +1,7 @@ +-nosmp -spmd +-dyn fv +-hgrid 10x15 +-phys adiabatic +-chem terminator +-debug +-s diff --git a/test/system/config_files/f10c3aqdm b/test/system/config_files/f10c3aqdm new file mode 100644 index 0000000000..beb0989e22 --- /dev/null +++ b/test/system/config_files/f10c3aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-debug +-ocn aquaplanet +-phys cam3 +-s diff --git a/test/system/config_files/f10c4aqwmxdm b/test/system/config_files/f10c4aqwmxdm new file mode 100644 index 0000000000..dd09d6ff69 --- /dev/null +++ b/test/system/config_files/f10c4aqwmxdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam4 +-aquaplanet +-chem waccm_ma +-waccmx +-debug +-s diff --git a/test/system/config_files/f10c4aqwscdm b/test/system/config_files/f10c4aqwscdm new file mode 100644 index 0000000000..4200287ea3 --- /dev/null +++ b/test/system/config_files/f10c4aqwscdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam4 +-aquaplanet +-chem waccm_sc +-debug +-s diff --git a/test/system/config_files/f10c5aqcdm b/test/system/config_files/f10c5aqcdm new file mode 100644 index 0000000000..ff3259d603 --- /dev/null +++ b/test/system/config_files/f10c5aqcdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-cosp +-debug +-s diff --git a/test/system/config_files/f10c5aqcmtt1dm b/test/system/config_files/f10c5aqcmtt1dm new file mode 100644 index 0000000000..b20c700779 --- /dev/null +++ b/test/system/config_files/f10c5aqcmtt1dm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-carma test_tracers +-debug +-s diff --git a/test/system/config_files/f10c5aqdm b/test/system/config_files/f10c5aqdm new file mode 100644 index 0000000000..c8a588a795 --- /dev/null +++ b/test/system/config_files/f10c5aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/f10c5aqpbadm b/test/system/config_files/f10c5aqpbadm new file mode 100644 index 0000000000..ff48ebdb82 --- /dev/null +++ b/test/system/config_files/f10c5aqpbadm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-chem none +-debug +-s diff --git a/test/system/config_files/f10c5aqscdm b/test/system/config_files/f10c5aqscdm new file mode 100644 index 0000000000..6dd86fd7dd --- /dev/null +++ b/test/system/config_files/f10c5aqscdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-psubcols 3 +-debug +-s diff --git a/test/system/config_files/f10c5aqt5mdm b/test/system/config_files/f10c5aqt5mdm new file mode 100644 index 0000000000..28a70d6965 --- /dev/null +++ b/test/system/config_files/f10c5aqt5mdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-nadv_tt 5 +-cppdefs -DTRACER_CHECK +-debug +-s diff --git a/test/system/config_files/f10c5aqudm b/test/system/config_files/f10c5aqudm new file mode 100644 index 0000000000..c9b3c374d9 --- /dev/null +++ b/test/system/config_files/f10c5aqudm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam5 +-aquaplanet +-unicon +-debug +-s diff --git a/test/system/config_files/f10c6aqcdm b/test/system/config_files/f10c6aqcdm new file mode 100644 index 0000000000..ddbfb36bd6 --- /dev/null +++ b/test/system/config_files/f10c6aqcdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam6 +-aquaplanet +-cosp +-debug +-s diff --git a/test/system/config_files/f10c6aqdm b/test/system/config_files/f10c6aqdm new file mode 100644 index 0000000000..afd1cc5821 --- /dev/null +++ b/test/system/config_files/f10c6aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam6 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/f10c6aqt5mdm b/test/system/config_files/f10c6aqt5mdm new file mode 100644 index 0000000000..a86e880f3c --- /dev/null +++ b/test/system/config_files/f10c6aqt5mdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam6 +-aquaplanet +-nadv_tt 5 +-cppdefs -DTRACER_CHECK +-debug +-s diff --git a/test/system/config_files/f10c6aqtsvbsdm b/test/system/config_files/f10c6aqtsvbsdm new file mode 100644 index 0000000000..0bcce91d1e --- /dev/null +++ b/test/system/config_files/f10c6aqtsvbsdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam6 +-aquaplanet +-chem trop_strat_mam4_vbs +-debug +-s diff --git a/test/system/config_files/f10c6aqwmadm b/test/system/config_files/f10c6aqwmadm new file mode 100644 index 0000000000..af3cc596c3 --- /dev/null +++ b/test/system/config_files/f10c6aqwmadm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys cam6 +-aquaplanet +-chem waccm_ma_mam4 +-debug +-s diff --git a/test/system/config_files/f10idm b/test/system/config_files/f10idm new file mode 100644 index 0000000000..45fd2ca73f --- /dev/null +++ b/test/system/config_files/f10idm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys held_suarez +-debug +-s diff --git a/test/system/config_files/f10spmaqdm b/test/system/config_files/f10spmaqdm new file mode 100644 index 0000000000..29f3430731 --- /dev/null +++ b/test/system/config_files/f10spmaqdm @@ -0,0 +1,11 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys spcam_m2005 +-spcam_nx 32 +-spcam_ny 1 +-spcam_dx 4000 +-spcam_dt 20 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/f10spsaqdm b/test/system/config_files/f10spsaqdm new file mode 100644 index 0000000000..83aa3c62d1 --- /dev/null +++ b/test/system/config_files/f10spsaqdm @@ -0,0 +1,13 @@ +-spmd -nosmp +-dyn fv +-hgrid 10x15 +-phys spcam_sam1mom +-rad camrt +-chem none +-spcam_nx 32 +-spcam_ny 1 +-spcam_dx 4000 +-spcam_dt 20 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/f4adh b/test/system/config_files/f4adh new file mode 100644 index 0000000000..2a0a9d8b74 --- /dev/null +++ b/test/system/config_files/f4adh @@ -0,0 +1,6 @@ +-spmd -smp +-dyn fv +-hgrid 4x5 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/f4c4aqdh b/test/system/config_files/f4c4aqdh new file mode 100644 index 0000000000..8410222ec2 --- /dev/null +++ b/test/system/config_files/f4c4aqdh @@ -0,0 +1,7 @@ +-spmd -smp +-dyn fv +-hgrid 4x5 +-phys cam4 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/f4c4aqprgspcdm b/test/system/config_files/f4c4aqprgspcdm new file mode 100755 index 0000000000..b3b7f069db --- /dev/null +++ b/test/system/config_files/f4c4aqprgspcdm @@ -0,0 +1,8 @@ +-debug +-spmd -nosmp +-dyn fv +-hgrid 4x5 +-prog_species SO4,BC,OC,SSLT,DST,GHG +-phys cam4 +-aquaplanet +-s diff --git a/test/system/config_files/f4c4aqwmxdm b/test/system/config_files/f4c4aqwmxdm new file mode 100644 index 0000000000..0a98bfaf92 --- /dev/null +++ b/test/system/config_files/f4c4aqwmxdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-phys cam4 +-aquaplanet +-chem waccm_ma +-waccmx +-dyn fv +-hgrid 4x5 +-debug +-s diff --git a/test/system/config_files/f4c4aqwmxidm b/test/system/config_files/f4c4aqwmxidm new file mode 100644 index 0000000000..d7b812bc2a --- /dev/null +++ b/test/system/config_files/f4c4aqwmxidm @@ -0,0 +1,10 @@ +-spmd -nosmp +-phys cam4 +-chem waccm_ma +-aquaplanet +-waccmx +-ionosphere wxi +-dyn fv +-hgrid 4x5 +-debug +-s diff --git a/test/system/config_files/f4c4aqwmxiedm b/test/system/config_files/f4c4aqwmxiedm new file mode 100644 index 0000000000..5e4d341a04 --- /dev/null +++ b/test/system/config_files/f4c4aqwmxiedm @@ -0,0 +1,11 @@ +-spmd -nosmp +-phys cam4 +-chem waccm_ma +-aquaplanet +-waccmx +-ionosphere wxie +-esmf_libdir /home/fvitt/esmf/lib/libg/Linux.nag.64.mvapich2.default +-dyn fv +-hgrid 4x5 +-debug +-s diff --git a/test/system/config_files/f4c4paqdh b/test/system/config_files/f4c4paqdh new file mode 100644 index 0000000000..27bc363a15 --- /dev/null +++ b/test/system/config_files/f4c4paqdh @@ -0,0 +1,8 @@ +-spmd -smp +-dyn fv +-hgrid 4x5 +-phys cam4 +-debug +-pergro +-ocn aquaplanet +-s diff --git a/test/system/config_files/f4c4wtsmltdh b/test/system/config_files/f4c4wtsmltdh new file mode 100755 index 0000000000..2f204df0bb --- /dev/null +++ b/test/system/config_files/f4c4wtsmltdh @@ -0,0 +1,8 @@ +-spmd -smp +-chem waccm_tsmlt +-age_of_air_trcs +-dyn fv +-hgrid 4x5 +-debug +-phys cam4 +-s diff --git a/test/system/config_files/f4c5dh b/test/system/config_files/f4c5dh new file mode 100644 index 0000000000..4dd778f66e --- /dev/null +++ b/test/system/config_files/f4c5dh @@ -0,0 +1,6 @@ +-spmd -smp +-dyn fv +-hgrid 4x5 +-phys cam5 +-debug +-s diff --git a/test/system/config_files/f4c5portdh b/test/system/config_files/f4c5portdh new file mode 100755 index 0000000000..91a80cead7 --- /dev/null +++ b/test/system/config_files/f4c5portdh @@ -0,0 +1,8 @@ +-spmd -smp +-chem trop_mam3 +-offline_drv rad +-dyn fv +-hgrid 4x5 +-phys cam5 +-debug +-s diff --git a/test/system/config_files/f4c5portdm b/test/system/config_files/f4c5portdm new file mode 100755 index 0000000000..2ac03d802d --- /dev/null +++ b/test/system/config_files/f4c5portdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-chem trop_mam3 +-offline_drv rad +-dyn fv +-hgrid 4x5 +-phys cam5 +-debug +-s diff --git a/test/system/config_files/f4c6aqwmadm b/test/system/config_files/f4c6aqwmadm new file mode 100644 index 0000000000..4bdbff20b9 --- /dev/null +++ b/test/system/config_files/f4c6aqwmadm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn fv +-hgrid 4x5 +-phys cam6 +-aquaplanet +-chem waccm_ma_mam4 +-debug +-s diff --git a/test/system/config_files/f4c6aqwmtdm b/test/system/config_files/f4c6aqwmtdm new file mode 100644 index 0000000000..4624536ab1 --- /dev/null +++ b/test/system/config_files/f4c6aqwmtdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-chem waccm_tsmlt_mam4 +-dyn fv +-hgrid 4x5 +-phys cam6 +-debug +-aquaplanet +-s diff --git a/test/system/config_files/f4idm b/test/system/config_files/f4idm new file mode 100644 index 0000000000..28c06c7674 --- /dev/null +++ b/test/system/config_files/f4idm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn fv +-hgrid 4x5 +-phys held_suarez +-debug +-s diff --git a/test/system/config_files/fsd1.9c4mozdh b/test/system/config_files/fsd1.9c4mozdh new file mode 100644 index 0000000000..a97b9c5d5b --- /dev/null +++ b/test/system/config_files/fsd1.9c4mozdh @@ -0,0 +1,9 @@ +-spmd -smp +-chem trop_mozart +-nlev 56 +-dyn fv +-hgrid 1.9x2.5 +-debug +-offline_dyn +-phys cam4 +-s diff --git a/test/system/config_files/fsd1.9c4wmdh b/test/system/config_files/fsd1.9c4wmdh new file mode 100755 index 0000000000..96c63e275e --- /dev/null +++ b/test/system/config_files/fsd1.9c4wmdh @@ -0,0 +1,9 @@ +-debug -spmd -smp +-chem waccm_ma +-age_of_air_trcs +-dyn fv +-nlev 88 +-offline_dyn +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/fsd1.9c4wmh b/test/system/config_files/fsd1.9c4wmh new file mode 100755 index 0000000000..fbfd84e555 --- /dev/null +++ b/test/system/config_files/fsd1.9c4wmh @@ -0,0 +1,9 @@ +-spmd -smp +-chem waccm_ma +-age_of_air_trcs +-dyn fv +-nlev 88 +-offline_dyn +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/fsd1.9c4wtsmltdh b/test/system/config_files/fsd1.9c4wtsmltdh new file mode 100755 index 0000000000..62e6ee612f --- /dev/null +++ b/test/system/config_files/fsd1.9c4wtsmltdh @@ -0,0 +1,10 @@ +-spmd -smp +-chem waccm_tsmlt +-dyn fv +-nlev 88 +-offline_dyn +-age_of_air_trcs +-hgrid 1.9x2.5 +-debug +-phys cam4 +-s diff --git a/test/system/config_files/fsd1.9c4wtsmlth b/test/system/config_files/fsd1.9c4wtsmlth new file mode 100755 index 0000000000..ab81518e0d --- /dev/null +++ b/test/system/config_files/fsd1.9c4wtsmlth @@ -0,0 +1,9 @@ +-spmd -smp +-chem waccm_tsmlt +-dyn fv +-nlev 88 +-offline_dyn +-age_of_air_trcs +-hgrid 1.9x2.5 +-phys cam4 +-s diff --git a/test/system/config_files/h16.3c4aqdm b/test/system/config_files/h16.3c4aqdm new file mode 100644 index 0000000000..e50af5301f --- /dev/null +++ b/test/system/config_files/h16.3c4aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne16np4.pg3 +-phys cam4 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h16.3c5aqt5dh b/test/system/config_files/h16.3c5aqt5dh new file mode 100644 index 0000000000..eabc67bc90 --- /dev/null +++ b/test/system/config_files/h16.3c5aqt5dh @@ -0,0 +1,8 @@ +-spmd -smp +-dyn se +-hgrid ne16np4.pg3 +-phys cam5 +-aquaplanet +-nadv_tt 5 +-debug +-s diff --git a/test/system/config_files/h16adh b/test/system/config_files/h16adh new file mode 100644 index 0000000000..a0190e981b --- /dev/null +++ b/test/system/config_files/h16adh @@ -0,0 +1,6 @@ +-smp -spmd +-dyn se +-hgrid ne16np4 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h16adtermdh b/test/system/config_files/h16adtermdh new file mode 100644 index 0000000000..10f97c023d --- /dev/null +++ b/test/system/config_files/h16adtermdh @@ -0,0 +1,7 @@ +-smp -spmd +-dyn se +-hgrid ne16np4 +-phys adiabatic +-chem terminator +-debug +-s diff --git a/test/system/config_files/h16c3aqdh b/test/system/config_files/h16c3aqdh new file mode 100644 index 0000000000..9b8a38fc3d --- /dev/null +++ b/test/system/config_files/h16c3aqdh @@ -0,0 +1,9 @@ +-spmd -smp +-dyn se +-hgrid ne16np4 +-phys cam3 +-ice sice +-lnd slnd +-debug +-ocn aquaplanet +-s diff --git a/test/system/config_files/h16c4aqdm b/test/system/config_files/h16c4aqdm new file mode 100644 index 0000000000..2877a821e4 --- /dev/null +++ b/test/system/config_files/h16c4aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne16np4 +-phys cam4 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h16c5aqdm b/test/system/config_files/h16c5aqdm new file mode 100644 index 0000000000..648964809a --- /dev/null +++ b/test/system/config_files/h16c5aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne16np4 +-phys cam5 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h16c5naqdm b/test/system/config_files/h16c5naqdm new file mode 100644 index 0000000000..ef8f827684 --- /dev/null +++ b/test/system/config_files/h16c5naqdm @@ -0,0 +1,10 @@ +-spmd -nosmp +-dyn se +-hgrid ne16np4 +-phys cam5 +-chem none +-ice sice +-lnd slnd +-debug +-ocn aquaplanet +-s diff --git a/test/system/config_files/h16c6aqdm b/test/system/config_files/h16c6aqdm new file mode 100644 index 0000000000..c77f6ac1fb --- /dev/null +++ b/test/system/config_files/h16c6aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne16np4 +-phys cam6 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h16c6aqh b/test/system/config_files/h16c6aqh new file mode 100644 index 0000000000..11b61e0456 --- /dev/null +++ b/test/system/config_files/h16c6aqh @@ -0,0 +1,7 @@ +-spmd -smp +-dyn se +-hgrid ne16np4 +-phys cam6 +-aquaplanet +-ocn docn +-s diff --git a/test/system/config_files/h16idm b/test/system/config_files/h16idm new file mode 100644 index 0000000000..651d4b8a76 --- /dev/null +++ b/test/system/config_files/h16idm @@ -0,0 +1,7 @@ +-nosmp -spmd +-dyn se +-dyn_test +-hgrid ne16np4 +-phys ideal +-debug +-s diff --git a/test/system/config_files/h16kstich b/test/system/config_files/h16kstich new file mode 100644 index 0000000000..87a4db83c2 --- /dev/null +++ b/test/system/config_files/h16kstich @@ -0,0 +1,7 @@ +-spmd -smp +-dyn se +-hgrid ne16np4 +-phys kessler +-chem terminator +-analytic_ic +-s diff --git a/test/system/config_files/h30c4aqdm b/test/system/config_files/h30c4aqdm new file mode 100644 index 0000000000..0debcd6d61 --- /dev/null +++ b/test/system/config_files/h30c4aqdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn se +-hgrid ne30np4 +-phys cam4 +-ice sice +-lnd slnd +-debug +-ocn aquaplanet +-s diff --git a/test/system/config_files/h5.2addm b/test/system/config_files/h5.2addm new file mode 100644 index 0000000000..df7ea12c6d --- /dev/null +++ b/test/system/config_files/h5.2addm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg2 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5.3addm b/test/system/config_files/h5.3addm new file mode 100644 index 0000000000..d84218bd29 --- /dev/null +++ b/test/system/config_files/h5.3addm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg3 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5.3adds b/test/system/config_files/h5.3adds new file mode 100644 index 0000000000..cbf188ad4d --- /dev/null +++ b/test/system/config_files/h5.3adds @@ -0,0 +1,6 @@ +-nospmd -nosmp +-dyn se +-hgrid ne5np4.pg3 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5.3adicdm b/test/system/config_files/h5.3adicdm new file mode 100644 index 0000000000..e438589bc8 --- /dev/null +++ b/test/system/config_files/h5.3adicdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg3 +-phys adiabatic +-analytic_ic +-debug +-s diff --git a/test/system/config_files/h5.3c5aqdm b/test/system/config_files/h5.3c5aqdm new file mode 100644 index 0000000000..cf988ae252 --- /dev/null +++ b/test/system/config_files/h5.3c5aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg3 +-phys cam5 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h5.3c5aqt5mdm b/test/system/config_files/h5.3c5aqt5mdm new file mode 100644 index 0000000000..7c7204eed8 --- /dev/null +++ b/test/system/config_files/h5.3c5aqt5mdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg3 +-phys cam5 +-aquaplanet +-nadv_tt 5 +-cppdefs -DTRACER_CHECK +-debug +-s diff --git a/test/system/config_files/h5.4addm b/test/system/config_files/h5.4addm new file mode 100644 index 0000000000..f8943e1535 --- /dev/null +++ b/test/system/config_files/h5.4addm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4.pg4 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5addm b/test/system/config_files/h5addm new file mode 100644 index 0000000000..36802ada3b --- /dev/null +++ b/test/system/config_files/h5addm @@ -0,0 +1,6 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5adds b/test/system/config_files/h5adds new file mode 100644 index 0000000000..e559971ba5 --- /dev/null +++ b/test/system/config_files/h5adds @@ -0,0 +1,6 @@ +-nospmd -nosmp +-dyn se +-hgrid ne5np4 +-phys adiabatic +-debug +-s diff --git a/test/system/config_files/h5adicdm b/test/system/config_files/h5adicdm new file mode 100644 index 0000000000..3f5a36cc51 --- /dev/null +++ b/test/system/config_files/h5adicdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4 +-phys adiabatic +-analytic_ic +-debug +-s diff --git a/test/system/config_files/h5c5aqbamdm b/test/system/config_files/h5c5aqbamdm new file mode 100644 index 0000000000..843b7e23c8 --- /dev/null +++ b/test/system/config_files/h5c5aqbamdm @@ -0,0 +1,8 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4 +-phys cam5 +-aquaplanet +-chem none +-debug +-s diff --git a/test/system/config_files/h5c5aqdm b/test/system/config_files/h5c5aqdm new file mode 100644 index 0000000000..81e0f2b8da --- /dev/null +++ b/test/system/config_files/h5c5aqdm @@ -0,0 +1,7 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4 +-phys cam5 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/h5c5aqt5mdm b/test/system/config_files/h5c5aqt5mdm new file mode 100644 index 0000000000..b40317af3d --- /dev/null +++ b/test/system/config_files/h5c5aqt5mdm @@ -0,0 +1,9 @@ +-spmd -nosmp +-dyn se +-hgrid ne5np4 +-phys cam5 +-aquaplanet +-nadv_tt 5 +-cppdefs -DTRACER_CHECK +-debug +-s diff --git a/test/system/config_files/scmc4aqds b/test/system/config_files/scmc4aqds new file mode 100644 index 0000000000..679b9a049f --- /dev/null +++ b/test/system/config_files/scmc4aqds @@ -0,0 +1,8 @@ +-nospmd -nosmp +-scam +-dyn eul +-hgrid 64x128 +-phys cam4 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/scmc5aqds b/test/system/config_files/scmc5aqds new file mode 100644 index 0000000000..1b7ef8f46e --- /dev/null +++ b/test/system/config_files/scmc5aqds @@ -0,0 +1,8 @@ +-nospmd -nosmp +-scam +-dyn eul +-hgrid 64x128 +-phys cam5 +-aquaplanet +-debug +-s diff --git a/test/system/config_files/scmc6aqds b/test/system/config_files/scmc6aqds new file mode 100644 index 0000000000..43a9356688 --- /dev/null +++ b/test/system/config_files/scmc6aqds @@ -0,0 +1,9 @@ +-nospmd -nosmp +-scam +-dyn eul +-hgrid 64x128 +-phys cam6 +-noclubb_sgs +-aquaplanet +-debug +-s diff --git a/test/system/config_files/testmech b/test/system/config_files/testmech new file mode 100644 index 0000000000..b00ff18091 --- /dev/null +++ b/test/system/config_files/testmech @@ -0,0 +1,349 @@ +* Incorrect trop_mozart mechanism to be used only for pre-processor testing + +SPECIES + + Solution + O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2 + CH4, CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH + CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH + BIGENE -> C4H8, ENEO2 -> C4H9O3 + MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3 + BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2 + ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2 + MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO + MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH + MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH + CH3COCHO, XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO + C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3 + TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5 + XOH -> C7H10O6, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2 + PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2 + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH + CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12 + SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3 + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + Rn, Pb + HCN, CH3CN, C2H2, HCOOH, HOCH2OO + End Solution + + Fixed + M, N2, O2, H2O + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + CH4, N2O, CO, Rn, Pb, H2, HCN, CH3CN + End Explicit + Implicit + O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2 + CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO, EO2, CH3COOH, GLYALD + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH + BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH + ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3 + HYDRALD, HYAC, CH3COCHO, XO2, XOOH + C10H16, TERPO2, TERPOOH + TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL + PAN, ONIT, MPAN, ISOPNO3, ONITR + SO2, DMS, SO4, NH3, NH4, NH4NO3, SOA + CB1, CB2, OC1, OC2 + C2H2, HCOOH, HOCH2OO + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis + [jo2->,jo2_b] O2 + hv -> 2*O + [jo1d->,jo3_a] O3 + hv -> O1D + O2 + [jo3p->,jo3_b] O3 + hv -> O + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno2] NO2 + hv -> NO + O + [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH + [jch2o_a] CH2O + hv -> CO + 2 * HO2 + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o2] H2O2 + hv -> 2*OH + [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 + [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH + [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 + [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 + [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 + [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmvk] MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 + [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH + [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> .82 * CH3COCH3 + OH + HO2 + [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH + [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 + [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 + [jxooh->,jch3ooh] XOOH + hv -> OH + [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O + [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2 + [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O + [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O + [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 + [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO + [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 + [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH + [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO + [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR + End Photolysis + + Reactions +* [usr_O_O2] O + O2 + M -> O3 + M +* O + O3 -> 2*O2 ; 8e-12, -2060 + [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115 + [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70 + [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10 + H2 + O1D -> HO2 + OH ; 1.1e-10 + H2 + OH -> H2O + HO2 ; 2.8e-12, -1800 + O + OH -> HO2 + O2 ; 2.2e-11, 120 + HO2 + O -> OH + O2 ; 3e-11, 200 + [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 + [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490 + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + OH + HO2 -> H2O + O2 ; 4.8e-11, 250 + OH + OH -> H2O + O ; 1.8e-12 + OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6 + N2O + O1D -> N2 + O2 ; 4.9e-11 + N2O + O1D -> 2*NO ; 6.7e-11 + [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250 + NO + O3 -> NO2 + O2 ; 3e-12, -1500 + NO2 + O -> NO + O2 ; 5.1e-12, 210 + NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 + NO3 + HO2 -> OH + NO2 ; 3.5e-12 + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + NO3 + NO -> 2*NO2 ; 1.5e-11, 170 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.0e-31,3.4, 2.9e-12,1.1, .6 + HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 + CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10 + [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 + CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424 + CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706 + CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 + CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200 + CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058 + CH2O + OH -> CO + H2O +HO2 ; 9.e-12 + CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [usr_CO_OH_b] CO + OH -> CO2 + HO2 + CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620 + HCOOH + OH -> HO2 + CO2 + H2O ; 4.5e-13 + CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 + HOCH2OO -> CH2O + HO2 ; 2.4e12, -7000 + HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 + HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +*C2 + C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.5e-30,0,8.3e-13,-2,.6 + + .35*CO + M + [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6 + [ox_l6] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630 + [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180 + EO + O2 -> GLYALD + HO2 ; 1.e-14 + EO -> 2 * CH2O + HO2 ; 1.6e11,-4150 + C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070 + [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 + C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 + C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13 + + .3 * CH3OH + .2 * C2H5OH + C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14 + C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200 + CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270 + CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 + [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 + [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6 + CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040 + CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500 + CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12 + PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14 + [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M + CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500 + GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11 + GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11 + CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13 + C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230 + +*C3 + [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5 + [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900 + + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + C3H6 + NO3 -> ONIT ; 4.6e-13,-1156 + [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 + PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 + POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200 + C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -665 + [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180 + C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 + C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40 + C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 + [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O + [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 + RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700 + RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 7.1e-13, 500 + + .5*CH3COCHO + .5*CH3OH + ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 + ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13 + CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830 + CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 + HYAC + OH -> CH3COCHO + HO2 ; 3.e-12 + +*C4 + BIGENE + OH -> ENEO2 ; 5.4e-11 + [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180 + MEK + OH -> MEKO2 ; 2.3e-12, -170 + [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 + MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700 + MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 + MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 ; 8.e-27,3.5,3.e-11,0.,.5 + + .5*CO2 + M + +*C5 + [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12 + [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180 + + .75*MEK + .9*NO2 + .1*ONIT + ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 + ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 + ISOP + OH -> ISOPO2 ; 2.54e-11, 410 + [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000 + + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3 + + .2 * MCO3 + .2 * CH3COOH + [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 4.4e-12, 180 + + .23 * MACR + .32 * MVK + .37 * HYDRALD + ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12 + + .35 * MVK + .4 * HYDRALD + ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700 + ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200 + ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400 + + .19 * MACR + .26 * MVK + .3 * HYDRALD + ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11 + + .25 * MACR + .35 * MVK + .4 * HYDRALD + ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446 + ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360 + + .039 * MVK + .794 * ONITR + ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12 + + .794 * ONITR + .794 * HO2 + ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700 + + .167 * MACR + .039 * MVK + .794 * ONITR + MVK + OH -> MACRO2 ; 4.13e-12, 452 + [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521 + + .06 * HO2 + .05 * CO + .04 * CH3CHO + MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175 + [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500 + + .7 * CH2O + .215 * OH + [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360 + + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD + + .22 * HYAC + .22 * CO + MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360 + MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12 + + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3 + MACRO2 + HO2 -> MACROOH ; 8.e-13, 700 + MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400 + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11 + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200 + [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360 + MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12 + MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040 + MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500 + MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 + MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530 + [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M + [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M + ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11 + ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860 + HYDRALD + OH -> XO2 ; 1.86e-11,175 + [ox_p11] XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL ; 2.7e-12, 360. + + .25*HYAC + .25*CH3COCHO + .25*GLYALD + XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12 + + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD + XO2 + HO2 -> XOOH ; 8.e-13, 700 + XO2 + CH3O2 -> .3 * CH3OH + 0.8*HO2 + .7 * CH2O ; 5.00e-13, 400. + + .2 * CO + .1 * HYAC + + .1*GLYOXAL + .1 * CH3COCHO + .1 * GLYALD + XO2 + CH3CO3 -> 0.5*CO + CH3O2 + HO2 + CO2 + .25 GLYOXAL ; 1.30e-12, 640. + + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD + XOOH + OH -> H2O + XO2 ; 1.90e-12, 190 + [usr_XOOH_OH] XOOH + OH -> H2O + OH + +*C7 + [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352 + CRESOL + OH -> XOH ; 3.e-12 + XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11 + [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180 + + .9*NO2 + .9*HO2 + TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 + TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 + +*C10 + [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444 + [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732 + [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490 + [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180 + TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 + TERPOOH + OH -> TERPO2 ; 3.8e-12, 200 + + Rn -> Pb ; 2.1e-6 +*het/aerosol rxns + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + CB1 -> CB2 ; 7.1e-6 + [usr_SO2_OH] SO2 + OH -> SO4 + DMS + OH -> SO2 ; 9.6e-12,-234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + NH3 + OH -> H2O ; 1.7e-12, -710. + OC1 -> OC2 ; 7.1e-6 + [usr_HO2_aer] HO2 -> 0.5*H2O2 +*cyanides + HCN + OH + M -> HO2 + M ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8 + CH3CN + OH -> HO2 ;7.8e-13, -1050 + End Reactions + + Ext Forcing + NO <- dataset + CO <- dataset + SO2 <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/test/system/find_mergeinfo.sh b/test/system/find_mergeinfo.sh new file mode 100755 index 0000000000..0e83d106b2 --- /dev/null +++ b/test/system/find_mergeinfo.sh @@ -0,0 +1,113 @@ +#!/usr/bin/env bash + +usage () { + cat <&2 + exit 1 +fi +eval set -- "$new_args" + +while (( $# > 0 )); do + case "$1" in + -d) + check_dir=1 + ;; + -h) + usage + exit + ;; + -r) + recursive=1 + ;; + -s) + sub_only=1 + ;; + --) + shift + break + ;; + esac + shift +done + +if (( $# != 1 )); then + echo "You must provide exactly one argument." >&2 + usage >&2 + exit 1 +fi + +find_external_dirs () { + local more_dirs + local more_more_dirs + # Regex below only valid with GNU sed. Use "!" as delimiter because it + # is unlikely to appear in the path. + get_external_regex='s!\(\S\+\)\b\s\+.*!'"$1"'/\1!' + more_dirs=$(svn pg svn:externals "$1" 2>/dev/null | \ + sed "$get_external_regex") + for dir in $more_dirs; do + more_more_dirs=$(find_external_dirs "$dir") + done + echo "$more_dirs $more_more_dirs" +} + +# Get absolute path (to make -s option work robustly). +svn_dirs=`cd $1 && pwd` + +if [[ "$recursive" ]]; then + svn_dirs+=" $(find_external_dirs $svn_dirs)" +fi + +find_dir_mergeinfo () { +# Parse recursive listing of svn:mergeinfo, returning all directories +# that have this property. +# Should use pl instead of pg? +# Subversion 1.6 always returns absolute paths from pg, but Subversion 1.7 +# can return relative paths. Hack around this by removing "${PWD}/" if it +# is present from both $top_dir and $tmp_path, so that hopefully they match +# up. + top_dir="${1#${PWD}/}" + while read line; do + if [[ "${line}" =~ (.*)\ -\ .* ]]; then + tmp_path="${BASH_REMATCH[1]#${PWD}/}" + if [[ ! "$check_dir" || -d $tmp_path ]]; then + if [[ ! "$sub_only" || "$tmp_path" != "$top_dir" ]]; then + echo "$tmp_path" + fi + fi + fi + done < <(svn pg -R svn:mergeinfo "$top_dir") +} + +for dir in $svn_dirs; do + find_dir_mergeinfo "$dir" +done diff --git a/test/system/gen-test-coverage b/test/system/gen-test-coverage new file mode 100755 index 0000000000..6c5094084f --- /dev/null +++ b/test/system/gen-test-coverage @@ -0,0 +1,257 @@ +#!/usr/bin/env perl + +# Execute this script in the directory containing the test-driver scripts +# (~components/cam/test/system) to generate an HTML table +# (test_coverage.html) containing all the tests in the master list, and +# indicate in which of the pretag lists the test is done. + +use strict; +use warnings; +use diagnostics; + +my $fout = 'test_coverage.html'; +my $fmaster = 'input_tests_master'; + +# Parse the master test list and format the test components for HTML output. +my $masterlist_html = gen_masterlist_html($fmaster); + +# Get list of the files containing tests, and do some sorting so the pretag test +# tables are first, then the posttag tables, and finally the miscellaneous tables. +my @pretag_test_lists = ; + +### Produce the web page here ### + +# open file for output +open my $fh_out, '+>', $fout or die "*** can't open $fout\n"; + +# output header info +print_header($fh_out); + +# Generate a table test coverage. +print_test_coverage($masterlist_html, \@pretag_test_lists); + +# Finish the page +print {$fh_out} "\n"; + +close $fh_out; + +#==================================================================================== + +sub gen_masterlist_html{ + + my $fmaster = shift(@_); + + # Parse master test list and store each line as an array of elements () + # in an HTML formatted row of a table. Then store these arrays in the hash + # %masterlist_html indexed by the test IDs. Return a pointer to this hash. + + open my $fh_master, '<', $fmaster or die "*** can't open $fmaster\n"; + + my %masterlist_html; + + LINE: while (my $line = <$fh_master>) { + + my @test_desc = split " ", $line; + # check for empty lines or for file header line + if (! defined($test_desc[0]) or $test_desc[0] =~ //) {next LINE;} + + # Apply HTML table formatting to each component of the test description. + my @test_desc_html = (); + + foreach my $comp (@test_desc) { + + # Add HTML links for all the components of the test description + # which are files. This includes the names of the test scripts + # and input files for the configure and build-namelist utilities. + my $html_str; + + if ($comp =~ /([-\.\w]+)\+([-\.\w]+)/) { + + my $str1 = add_html_link($1); + my $str2 = add_html_link($2); + $html_str = "$str1+$str2"; + } + else { + my $str1 = add_html_link($comp); + $html_str = "$str1 "; + } + + push @test_desc_html, $html_str ; + } + + # Add empty cells as necessary so that all descriptions contain + # 7 cells. The cells are added in a way that pushes the run length + # component to the last column so they all line up. + my $num_test_comp = scalar(@test_desc_html); + my $num_empty_cells = 7 - $num_test_comp; + if ($num_test_comp <= 4) { + # When a test description has <= 4 components then there is no + # run length component. So just add the empty cells to the end. + push @test_desc_html, (" ") x $num_empty_cells; + } + else { + # When a test description has 5 or more components then the last component + # is the run length. In this case add empty cells in front of the last one + # until the total array length is 7. + splice @test_desc_html, -1, 0, (" ") x $num_empty_cells; + } + + $masterlist_html{$test_desc[0]} = \@test_desc_html; + } + close $fh_master; + return \%masterlist_html; +} + +#==================================================================================== + +sub print_test_coverage{ + + my $masterlist_html = shift(@_); + my $pretag_test_lists = shift(@_); + + my $header = ''; + + # Add a column header for each of the pretag test lists. + foreach my $test_list (@$pretag_test_lists) { + $test_list =~ /tests_pretag_(\w+)/; + $header .= ""; + } + + # Finish header with columns for the components of the test description + $header .= ''. + ''. + ''; + + print {$fh_out} $header; + + # Store the test IDs from each test list in the keys of a hash. + my %test_list_ids; + foreach my $test_list (@$pretag_test_lists) { + $test_list =~ /tests_pretag_(\w+)/; + + my %test_ids = (); + + # open file read only + open my $fh, '<', $test_list or die "*** can't open $test_list\n"; + + # read test IDs in input file + my @test_ids = (); + while (my $line = <$fh>) { + push @test_ids, split " ", $line; + } + close $fh; + + # Put the test IDs into the keys of %test_ids + foreach my $test_id (@test_ids) { + $test_ids{$test_id} = " "; + } + + # Store a reference to the %test_ids for this $test_list in %test_list_ids + $test_list_ids{$test_list} = \%test_ids; + } + + # Construct array of the test IDs to display. This is where we select tests from the + # master list and customize the test order. + # Start with sorted list of all tests: + my @test_ids_all = sort keys %$masterlist_html; + + # Remove the TCB tests because these are always done as part of the smoke tests, so + # no reason to call them out separately. They're only listed separately to allow + # the builds to occur separately from running a test. + my @test_ids_no_tcb = grep { !/cb/ } @test_ids_all; + + # Next pull out the smoke tests. This is the most basic test so list them first. + my @tsm = grep { /sm/ } @test_ids_no_tcb; + my @remaining = grep { !/sm/ } @test_ids_no_tcb; + + # Exact restart tests. + my @ter = grep { /er/ } @remaining; + my @remaining2 = grep { !/er/ } @remaining; + + # Baseline comparisons. + my @tbl = grep { /bl/ } @remaining2; + @remaining = grep { !/bl/ } @remaining2; + + # Branch tests. + my @tbr = grep { /br/ } @remaining; + @remaining2 = grep { !/br/ } @remaining; + + # Add cells to indicate test coverage. + foreach my $test_id (@tsm, @ter, @tbl, @tbr, @remaining2) { + + # Construct a table row for each test id. Start the row with + # the test ID cell. + my @test_desc_html = @{$$masterlist_html{$test_id}}; + my $test_id_cell = splice @test_desc_html, 0, 1; + my $row = "$test_id_cell"; + + # Check for the test id in each test list and add a cell to indicate whether + # the test list contains the test id (colored cell) or not (empty cell). + foreach my $test_list (@$pretag_test_lists) { + $test_list =~ /tests_pretag_(\w+)/; + if (defined $test_list_ids{$test_list}->{$test_id}) { + $row .= ''; + } + else { + $row .= ""; + } + } + + + # Finish the row with the remainder of the test description. + $row .= "@test_desc_html\n"; + + # print a table row for each test + print {$fh_out} $row; + } + + # Terminate
testid $1test script build 1namelist 1build 2namelist 2run length
+ print {$fh_out} "


\n"; +} + +#==================================================================================== + +sub add_html_link{ + + # Add HTML links to the parts of the test description that correspond to a file. + + my $fname = shift(@_); + + my $result = $fname; + + if (-f "./$fname") { + $result = "$fname "; + } + elsif (-f "./config_files/$fname") { + $result = "$fname "; + } + elsif (-f "./nl_files/$fname") { + $result = "$fname "; + } + elsif (-f "../use_cases/$fname.xml") { + $result = "$fname "; + } + + return $result; +} + +#==================================================================================== + +sub print_header{ + + my $fh = shift(@_); + + print {$fh} <<'END_HERE' + + + +CAM Pretag Test Coverage + + + + + + +

Pretag Regression Test Coverage

+END_HERE +} diff --git a/test/system/gen-test-style.css b/test/system/gen-test-style.css new file mode 100644 index 0000000000..c609390cef --- /dev/null +++ b/test/system/gen-test-style.css @@ -0,0 +1,18 @@ +body { + font-family: Helvetica, Arial, sans-serif; + background: #EEEEEE; + color: black; +} + +a:link { text-decoration:none; color:navy; } +a:visited { text-decoration:none; color:#996699; } +a:active { text-decoration:none } +a:hover { text-decoration:none; color:#0066FF; } + +h1{font-size: 1.5em } + +table {border: thin solid; border-collapse: separate; border-spacing: 0; empty-cells: show;} +td {border: thin solid; padding: .2em;} +th {border: thin solid; padding: .2em;} + +td.on {background: green;} diff --git a/test/system/gen-test-table b/test/system/gen-test-table new file mode 100755 index 0000000000..f6b8be831b --- /dev/null +++ b/test/system/gen-test-table @@ -0,0 +1,192 @@ +#!/usr/bin/env perl + +# Execute this script in the directory containing the test-driver +# scripts (~components/cam/test/system) to loop through the CAM test +# lists (filenames matching test_*) and create an html file +# (test_table.html) with the specifics of each test detailed. + +use strict; +use warnings; +use diagnostics; + +my $fout = 'test_table.html'; +my $fmaster = 'input_tests_master'; + +# Parse the master test list and format the test components for HTML output. +my $masterlist_html = gen_masterlist_html($fmaster); + +# Get list of the files containing tests, and do some sorting so the pretag test +# tables are first, then the posttag tables, and finally the miscellaneous tables. +my @test_lists = ; + +my @pretag_tests = grep /pretag/, @test_lists; +my @posttag_tests = grep /posttag/, @test_lists; +my @misc_tests = grep { !/pretag/ and !/posttag/ } @test_lists; + +my @test_lists_sorted = (@pretag_tests, @posttag_tests, @misc_tests); + + +### Produce the web page here ### + +# open file for output +open my $fh_out, '+>', $fout or die "*** can't open $fout\n"; + +# output header info +print_header($fh_out); + +# Generate a table for each test list. +foreach my $test_list (@test_lists_sorted) { + print_test_table($masterlist_html, $test_list); +} + +# Finish the page +print {$fh_out} "\n"; + +close $fh_out; + +#==================================================================================== + +sub gen_masterlist_html{ + + my $fmaster = shift(@_); + + # Parse master test list and store each line as an array of elements () + # in an HTML formatted row of a table. Then store these arrays in the hash + # %masterlist_html indexed by the test IDs. Return a pointer to this hash. + + open my $fh_master, '<', $fmaster or die "*** can't open $fmaster\n"; + + my %masterlist_html; + + LINE: while (my $line = <$fh_master>) { + + my @test_desc = split " ", $line; + # check for empty lines or for file header line + if (! defined($test_desc[0]) or $test_desc[0] =~ //) {next LINE;} + + # Apply HTML table formatting to each component of the test description. + my @test_desc_html = (); + + foreach my $comp (@test_desc) { + + # Add HTML links for all the components of the test description + # which are files. This includes the names of the test scripts + # and input files for the configure and build-namelist utilities. + my $html_str; + + if ($comp =~ /([-\.\w]+)\+([-\.\w]+)/) { + + my $str1 = add_html_link($1); + my $str2 = add_html_link($2); + $html_str = "$str1+$str2"; + } + else { + my $str1 = add_html_link($comp); + $html_str = "$str1 "; + } + + push @test_desc_html, $html_str ; + } + + # Add empty cells as necessary so that all descriptions contain + # 7 cells. The cells are added in a way that pushes the run length + # component to the last column so they all line up. + my $num_test_comp = scalar(@test_desc_html); + my $num_empty_cells = 7 - $num_test_comp; + if ($num_test_comp <= 4) { + # When a test description has <= 4 components then there is no + # run length component. So just add the empty cells to the end. + push @test_desc_html, (" ") x $num_empty_cells; + } + else { + # When a test description has 5 or more components then the last component + # is the run length. In this case add empty cells in front of the last one + # until the total array length is 7. + splice @test_desc_html, -1, 0, (" ") x $num_empty_cells; + } + + $masterlist_html{$test_desc[0]} = \@test_desc_html; + } + close $fh_master; + return \%masterlist_html; +} + +#==================================================================================== + +sub print_test_table{ + + my $masterlist_html = shift(@_); + my $test_list = shift(@_); + + # open file read only + open my $fh, '<', $test_list or die "*** can't open $test_list\n"; + + print {$fh_out} "

$test_list

". + ''. + ''. + ''; + + # read test IDs in input file + my @test_ids; + while (my $line = <$fh>) { + push @test_ids, split " ", $line; + } + + my $test_num = 0; + foreach my $test_id (@test_ids) { + + ++$test_num; + my $test_num_str = sprintf "%03d", $test_num; + + # print a table row for each test + print {$fh_out} " ". + "@{$$masterlist_html{$test_id}}\n"; + } + + print {$fh_out} "
test# testid test script build 1namelist 1build 2namelist 2run length
$test_num_str


\n"; +} + +#==================================================================================== + +sub add_html_link{ + + # Add HTML links to the parts of the test description that correspond to a file. + + my $fname = shift(@_); + + my $result = $fname; + + if (-f "./$fname") { + $result = "$fname "; + } + elsif (-f "./config_files/$fname") { + $result = "$fname "; + } + elsif (-f "./nl_files/$fname") { + $result = "$fname "; + } + elsif (-f "../use_cases/$fname.xml") { + $result = "$fname "; + } + + return $result; +} + +#==================================================================================== + +sub print_header{ + + my $fh = shift(@_); + + print {$fh} <<'END_HERE' + + + +CAM Regression Test Tables + + + + + +END_HERE +} diff --git a/test/system/input_tests_master b/test/system/input_tests_master new file mode 100644 index 0000000000..f86194fd5f --- /dev/null +++ b/test/system/input_tests_master @@ -0,0 +1,357 @@ + +r8001 TR8.sh + +gt001 TGIT.sh +fm001 TFM.sh + +sm010 TSM.sh f4c5portdh outfrq24h_port 2d +sm011 TSM.sh f4c5portdm outfrq24h_port 2d +sm012 TSM.sh f1.9c4portdh port_cam4 5d +sm013 TSM.sh f1.9c4portdm port_cam4 5d + +sm111 TSM.sh e8c5aqt5mdm ghgrmp_e8 9s +sm112 TSM.sh e8c3aqdm outfrq3s+aquaplanet_cam3 9s +sm113 TSM.sh e8c4aqdm outfrq3s+aquaplanet_cam4 9s +sm114 TSM.sh e8c4aqdm co2rmp 9s +sm115 TSM.sh e8idm idphys 9s + +sm133 TSM.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s +sm134 TSM.sh e48adh adia 9s +sm135 TSM.sh e48idh idphys 9s + +sm150 TSM.sh e64addh outfrq3s+dabi_p2004 9s +sm151 TSM.sh e64hsdh outfrq3s+held_suarez_1994 9s + +sm221 TSM.sh f10spsaqdm outfrq3s 9s +sm222 TSM.sh f10spmaqdm outfrq3s 9s + +sm311 TSM.sh f10c5aqt5mdm ttrac 9s +sm313 TSM.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s +sm314 TSM.sh f10c4aqwscdm outfrq3s_diags 9s +sm317 TSM.sh f10c5aqcdm outfrq3s_cosp 9s +sm318 TSM.sh f10c6aqcdm sat_hist 9s +sm320 TSM.sh f10c5aqpbadm rad_diag 9s + +sm325 TSM.sh f10c5aqscdm outfrq3s_subcol 9s + +sm331 TSM.sh f4c4aqdh co2rmp+1850_cam4 9s +sm333 TSM.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s +sm334 TSM.sh f10c5aqudm outfrq3s 9s + +sm335 TSM.sh f10idm idphys 9s + +sm338 TSM.sh f10c5aqdm rad_diag_mam 9s +sm339 TSM.sh f10adhterm terminator 9s + +sm353 TSM.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s + +sm360 TSM.sh f1.9c5aqm volc+1850-2005_cam5 2d + +sm367 TSM.sh f10c6aqdm outfrq3s_convmic 9s +sm368 TSM.sh f10c6aqdm outfrq3s 9s +sm369 TSM.sh f10c6aqdm outfrq3s_am 9s + +sm370 TSM.sh f1.9c6aqtsvbsdh outfrq3s 9s + +sm375 TSM.sh f10c6aqtsvbsdm outfrq3s_sums 9s + +sm380 TSM.sh f1.9c6aqcdh outfrq3s_cosp 9s + +sm390 TSM.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s +sm391 TSM.sh f1.9c4aqwmxidh outfrq3s 9s +sm392 TSM.sh f4c4aqwmxdm outfrq3s_newyear 9s +sm393 TSM.sh f4c4aqwmxidm outfrq3s 9s +sm394 TSM.sh f4c4aqwmxiedm outfrq3s_ionos 9s + +sm426 TSM.sh f10c4aqwmxdm outfrq3s_newyear 9s + +sm430 TSM.sh f10c5aqcmtt1dm outfrq3s_carma 9s + +sm460 TSM.sh f1.9c4aqbamm outfrq3s 9s + +sm469 TSM.sh f4c4aqprgspcdm outfrq3s 9s + +sm471 TSM.sh f10c6aqwmadm outfrq3s 9s +sm472 TSM.sh f4c6aqwmadm outfrq3s 9s +sm473 TSM.sh f4c6aqwmtdm outfrq3s 9s +sm474 TSM.sh f1.9c6aqwmth outfrq3s 9s + +sm700 TSM.sh h5adicdm outfrq3s_bwic 9s +sm701 TSM.sh h5addm outfrq3s 9s +sm702 TSM.sh h5.3adicdm outfrq3s_bwic 9s +sm703 TSM.sh h5.3addm outfrq3s 9s +sm704 TSM.sh h5.4addm outfrq3s 9s +sm705 TSM.sh h5adds outfrq3s 9s +sm706 TSM.sh h5.3adds outfrq3s 9s +sm707 TSM.sh h5.2addm outfrq3s 9s +sm708 TSM.sh h5addm outfrq3s_unstruct 9s + +sm711 TSM.sh h5c5aqt5mdm ttrac 9s +sm712 TSM.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s + +sm714 TSM.sh h5.3c5aqt5mdm ttrac 9s + +sm720 TSM.sh h16c4aqdm outfrq3s+aquaplanet_cam4 9s +sm721 TSM.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 9s + +sm731 TSM.sh h16c3aqdh aqua+aquaplanet_cam3 9s +sm734 TSM.sh h16c5naqdm outfrq3s+aquaplanet_cam5 9s +sm735 TSM.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s +sm736 TSM.sh h16adtermdh terminator 9s +sm737 TSM.sh h16c5aqdm ghgrmp_unstruct 9s +sm738 TSM.sh h16idm idphys 9s + +sm741 TSM.sh h16c6aqdm ghgrmp_unstruct 9s + +sm751 TSM.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s + +sm991 TSM_ccsm.sh f19_f19_mg17 QPC4 9s +sm993 TSM_ccsm.sh ne16_ne16_mg17 FKESSLER 9s +sm994 TSM_ccsm.sh ne16_ne16_mg17 QPC6 9s +sm995 TSM_ccsm.sh T42_T42 FDABIP04 9s + +er111 TER.sh e8c5aqt5mdm ghgrmp_e8 4+5s +er112 TER.sh e8c3aqdm outfrq3s+aquaplanet_cam3 4+5s +er113 TER.sh e8c4aqdm outfrq3s+aquaplanet_cam4 4+5s +er114 TER.sh e8c4aqdm co2rmp 4+5s +er115 TER.sh e8idm idphys 4+5s + +er134 TER.sh e48adh adia 4+5s +er135 TER.sh e48idh idphys 4+5s + +er150 TER.sh e64addh outfrq3s+dabi_p2004 4+5s +er151 TER.sh e64hsdh outfrq3s+held_suarez_1994 4+5s + +er221 TER.sh f10spsaqdm outfrq3s 4+5s +er222 TER.sh f10spmaqdm outfrq3s 4+5s + +er311 TER.sh f10c5aqt5mdm ttrac 4+5s +er314 TER.sh f10c4aqwscdm outfrq3s_diags 4+5s +er317 TER.sh f10c5aqcdm outfrq3s_cosp 4+5s +er318 TER.sh f10c6aqcdm sat_hist 4+5s +er320 TER.sh f10c5aqpbadm rad_diag 4+5s + +er325 TER.sh f10c5aqscdm outfrq3s_subcol 4+5s + +er331 TER.sh f4c4aqdh co2rmp+1850_cam4 4+5s + +er334 TER.sh f10c5aqudm outfrq3s 4+5s +er335 TER.sh f10idm idphys 4+5s + +er339 TER.sh f10adhterm terminator 4+5s + +er353 TER.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 4+5s + +er360 TER.sh f1.9c5aqm volc+1850-2005_cam5 1+1d + +er367 TER.sh f10c6aqdm outfrq3s_convmic 4+5s +er368 TER.sh f10c6aqdm outfrq3s 4+5s +er369 TER.sh f10c6aqdm outfrq3s_am 4+5s + +er370 TER.sh f1.9c6aqtsvbsdh outfrq3s 4+5s + +er375 TER.sh f10c6aqtsvbsdm outfrq3s_sums 4+5s + +er380 TER.sh f1.9c6aqcdh outfrq3s_cosp 4+5s + +er390 TER.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 4+5s +er391 TER.sh f1.9c4aqwmxidh outfrq3s 4+5s +er392 TER.sh f4c4aqwmxdm outfrq3s_newyear 4+5s +er393 TER.sh f4c4aqwmxidm outfrq3s 4+5s +er394 TER.sh f4c4aqwmxiedm outfrq3s_ionos 4+5s + +er426 TER.sh f10c4aqwmxdm outfrq3s_newyear 4+5s + +er430 TER.sh f10c5aqcmtt1dm outfrq3s_carma 4+5s + +er460 TER.sh f1.9c4aqbamm outfrq3s 4+5s + +er469 TER.sh f4c4aqprgspcdm outfrq3s 4+5s + +er471 TER.sh f10c6aqwmadm outfrq3s 4+5s +er472 TER.sh f4c6aqwmadm outfrq3s 4+5s +er473 TER.sh f4c6aqwmtdm outfrq3s 4+5s +er474 TER.sh f1.9c6aqwmth outfrq3s 4+5s + +er700 TER.sh h5adicdm outfrq3s_bwic 4+5s +er701 TER.sh h5addm outfrq3s 4+5s +er702 TER.sh h5.3adicdm outfrq3s_bwic 4+5s +er703 TER.sh h5.3addm outfrq3s 4+5s +er704 TER.sh h5.4addm outfrq3s 4+5s +er707 TER.sh h5.2addm outfrq3s 4+5s +er708 TER.sh h5addm outfrq3s_unstruct 4+5s + +er711 TER.sh h5c5aqt5mdm ttrac 4+5s +er712 TER.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 4+5s + +er720 TER.sh h16c4aqdm outfrq3s+aquaplanet_cam4 4+5s +er721 TER.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 4+5s + +er731 TER.sh h16c3aqdh aqua+aquaplanet_cam3 4+5s +er734 TER.sh h16c5naqdm outfrq3s+aquaplanet_cam5 4+5s +er735 TER.sh h16c5aqdm outfrq3s+1850-2005_cam5 4+5s +er736 TER.sh h16adtermdh terminator 4+5s +er737 TER.sh h16c5aqdm ghgrmp_unstruct 4+5s +er738 TER.sh h16idm idphys 4+5s + +er741 TER.sh h16c6aqdm ghgrmp_unstruct 4+5s + +er751 TER.sh h30c4aqdm outfrq3s+aquaplanet_cam4 4+5s + +br111 TBR.sh e8c5aqt5mdm ghgrmp_e8 6+3s +br114 TBR.sh e8c4aqdm co2rmp 6+3s + +br222 TBR.sh f10spmaqdm outfrq3s 6+3s + +br311 TBR.sh f10c5aqt5mdm ttrac 6+3s + +br331 TBR.sh f4c4aqdh co2rmp+1850_cam4 6+3s + +br353 TBR.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 6+3s + +br380 TBR.sh f1.9c6aqcdh outfrq3s_cosp 6+3s + +br390 TBR.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 6+3s +br391 TBR.sh f1.9c4aqwmxidh outfrq3s 6+3s + +br469 TBR.sh f4c4aqprgspcdm outfrq3s 6+3s + +br471 TBR.sh f10c6aqwmadm outfrq3s 6+3s + +br700 TBR.sh h5adicdm outfrq3s_bwic 6+3s +br701 TBR.sh h5addm outfrq3s 6+3s +br702 TBR.sh h5.3adicdm outfrq3s_bwic 6+3s +br703 TBR.sh h5.3addm outfrq3s 6+3s + +br711 TBR.sh h5c5aqt5mdm ttrac 6+3s + +br720 TBR.sh h16c4aqdm outfrq3s+aquaplanet_cam4 6+3s +br721 TBR.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 6+3s + +bl010 TBL.sh f4c5portdh outfrq24h_port 2d +bl011 TBL.sh f4c5portdm outfrq24h_port 2d +bl012 TBL.sh f1.9c4portdh port_cam4 5d +bl013 TBL.sh f1.9c4portdm port_cam4 5d + +bl111 TBL.sh e8c5aqt5mdm ghgrmp_e8 9s +bl112 TBL.sh e8c3aqdm outfrq3s+aquaplanet_cam3 9s +bl113 TBL.sh e8c4aqdm outfrq3s+aquaplanet_cam4 9s +bl114 TBL.sh e8c4aqdm co2rmp 9s +bl115 TBL.sh e8idm idphys 9s + +bl133 TBL.sh e48c4paqdm aqpgro+aquaplanet_cam4 3s +bl134 TBL.sh e48adh adia 9s +bl135 TBL.sh e48idh idphys 9s + +bl150 TBL.sh e64addh outfrq3s+dabi_p2004 9s +bl151 TBL.sh e64hsdh outfrq3s+held_suarez_1994 9s + +bl221 TBL.sh f10spsaqdm outfrq3s 9s +bl222 TBL.sh f10spmaqdm outfrq3s 9s + +bl311 TBL.sh f10c5aqt5mdm ttrac 9s +bl313 TBL.sh f10c3aqdm outfrq3s+aquaplanet_cam3 3s +bl314 TBL.sh f10c4aqwscdm outfrq3s_diags 9s +bl317 TBL.sh f10c5aqcdm outfrq3s_cosp 9s +bl318 TBL.sh f10c6aqcdm sat_hist 9s +bl320 TBL.sh f10c5aqpbadm rad_diag 9s + +bl325 TBL.sh f10c5aqscdm outfrq3s_subcol 9s + +bl331 TBL.sh f4c4aqdh co2rmp+1850_cam4 9s +bl333 TBL.sh f4c4paqdh aqpgro+aquaplanet_cam4 3s +bl334 TBL.sh f10c5aqudm outfrq3s 9s +bl335 TBL.sh f10idm idphys 9s + +bl338 TBL.sh f10c5aqdm rad_diag_mam 9s +bl339 TBL.sh f10adhterm terminator 9s + +bl353 TBL.sh f1.9c4aqmozdh outfrq3s+2000_cam4_trop_chem 9s + +bl360 TBL.sh f1.9c5aqm volc+1850-2005_cam5 2d + +bl367 TBL.sh f10c6aqdm outfrq3s_convmic 9s +bl368 TBL.sh f10c6aqdm outfrq3s 9s +bl369 TBL.sh f10c6aqdm outfrq3s_am 9s + +bl370 TBL.sh f1.9c6aqtsvbsdh outfrq3s 9s + +bl375 TBL.sh f10c6aqtsvbsdm outfrq3s_sums 9s + +bl380 TBL.sh f1.9c6aqcdh outfrq3s_cosp 9s + +bl390 TBL.sh f1.9c4aqwmxdh outfrq3s+waccmx_ma_2000_cam4 9s +bl391 TBL.sh f1.9c4aqwmxidh outfrq3s 9s +bl392 TBL.sh f4c4aqwmxdm outfrq3s_newyear 9s +bl393 TBL.sh f4c4aqwmxidm outfrq3s 9s +bl394 TBL.sh f4c4aqwmxiedm outfrq3s_ionos 9s + +bl426 TBL.sh f10c4aqwmxdm outfrq3s_newyear 9s + +bl430 TBL.sh f10c5aqcmtt1dm outfrq3s_carma 9s + +bl460 TBL.sh f1.9c4aqbamm outfrq3s 9s + +bl469 TBL.sh f4c4aqprgspcdm outfrq3s 9s + +bl471 TBL.sh f10c6aqwmadm outfrq3s 9s +bl472 TBL.sh f4c6aqwmadm outfrq3s 9s +bl473 TBL.sh f4c6aqwmtdm outfrq3s 9s +bl474 TBL.sh f1.9c6aqwmth outfrq3s 9s + +bl700 TBL.sh h5adicdm outfrq3s_bwic 9s +bl701 TBL.sh h5addm outfrq3s 9s +bl702 TBL.sh h5.3adicdm outfrq3s_bwic 9s +bl703 TBL.sh h5.3addm outfrq3s 9s +bl704 TBL.sh h5.4addm outfrq3s 9s +bl707 TBL.sh h5.2addm outfrq3s 9s + +bl711 TBL.sh h5c5aqt5mdm ttrac 9s +bl712 TBL.sh h5c5aqbamdm outfrq3s+aquaplanet_cam5 9s + +bl720 TBL.sh h16c4aqdm outfrq3s+aquaplanet_cam4 9s +bl721 TBL.sh h16.3c4aqdm outfrq3s+aquaplanet_cam4 9s + +bl731 TBL.sh h16c3aqdh aqua+aquaplanet_cam3 9s +bl734 TBL.sh h16c5naqdm outfrq3s+aquaplanet_cam5 9s +bl735 TBL.sh h16c5aqdm outfrq3s+1850-2005_cam5 9s +bl736 TBL.sh h16adtermdh terminator 9s +bl737 TBL.sh h16c5aqdm ghgrmp_unstruct 9s + +bl741 TBL.sh h16c6aqdm ghgrmp_unstruct 9s + +bl751 TBL.sh h30c4aqdm outfrq3s+aquaplanet_cam4 9s + +eq301 TEQ.sh f10c5aqt5mdm ttrac f10c5aqdm ttrac_lb1 9s +eq302 TEQ.sh f10c5aqt5mdm ttrac f10c5aqdm ttrac_lb2 9s +eq303 TEQ.sh f10c5aqt5mdm ttrac f10c5aqdm ttrac_lb3 9s +eq304 TEQ.sh f10c5aqt5mdm ttrac f10c5aqdm ttrac_lb0 9s + +eq325 TEQ.sh f10c5aqscdm outfrq3s_subcol f10c5aqdm outfrq3s 9s + +eq701 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb0 9s +eq702 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb1 9s +eq703 TEQ.sh h5c5aqt5mdm ttrac h5c5aqdm ttrac_lb3 9s + +eq705 TEQ.sh h5adds outfrq3s h5addm outfrq3s 9s +eq706 TEQ.sh h5.3adds outfrq3s h5.3addm outfrq3s 9s + +eq711 TEQ.sh h5.3c5aqt5mdm ttrac h5.3c5aqdm ttrac_lb0 9s +eq712 TEQ.sh h5.3c5aqt5mdm ttrac h5.3c5aqdm ttrac_lb1 9s +eq713 TEQ.sh h5.3c5aqt5mdm ttrac h5.3c5aqdm ttrac_lb3 9s + +eq991 TEQ_ccsm.sh f19_f19_mg17 QPC4 f1.9c4aqh fcase+aquaplanet_cam4 9s +eq993 TEQ_ccsm.sh ne16_ne16_mg17 FKESSLER h16kstich fcase+dctest_baro_kessler 9s +eq994 TEQ_ccsm.sh ne16_ne16_mg17 QPC6 h16c6aqh fcase+aquaplanet_cam6 9s +eq995 TEQ_ccsm.sh T42_T42 FDABIP04 e64adh fcase+dabi_p2004 9s + +sc001 TSC.sh e64c5aqiopdm scm_prep scmc5aqds scm_b4b_o1 7s +sc002 TSC.sh e64c4aqiopdm scm_prep scmc4aqds scm_b4b_o1 7s +sc003 TSM.sh scmc5aqds scmarm 7s +sc004 TSC.sh e64c6aqiopdm scm_prep scmc6aqds scm_b4b_o1 7s + +mc111 TMC.sh e8c5aqt5mdm ghgrmp_e8 9s +mc311 TMC.sh f10c5aqt5mdm ttrac 9s +mc711 TMC.sh h5c5aqt5mdm ttrac 9s + +dd111 TDD.sh e8c5aqt5mdm ghgrmp_e8 9s diff --git a/test/system/nl_files/adia b/test/system/nl_files/adia new file mode 100644 index 0000000000..1c3815d838 --- /dev/null +++ b/test/system/nl_files/adia @@ -0,0 +1,6 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + / + diff --git a/test/system/nl_files/aqpgro b/test/system/nl_files/aqpgro new file mode 100644 index 0000000000..a0863bcfa8 --- /dev/null +++ b/test/system/nl_files/aqpgro @@ -0,0 +1,10 @@ +&camexp + restart_option='none' + empty_htapes=.true. + fincl1='T','PS' + inithist='ENDOFRUN' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=1,1,1,1,1,1 + / + diff --git a/test/system/nl_files/aqua b/test/system/nl_files/aqua new file mode 100644 index 0000000000..4c82abc765 --- /dev/null +++ b/test/system/nl_files/aqua @@ -0,0 +1,9 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt= 1,1,1,1,1,1 + ndens= 1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + fincl1='FU','FV' + / + diff --git a/test/system/nl_files/co2rmp b/test/system/nl_files/co2rmp new file mode 100644 index 0000000000..a29c884c0d --- /dev/null +++ b/test/system/nl_files/co2rmp @@ -0,0 +1,19 @@ +&camexp + restart_option='nsteps' + restart_n=3 + fexcl1='UU' + fincl1='T:I','PS:I' + fincl2='T:A','PS:A' + fincl3='T:X','PS:X' + fincl4='T:M','PS:M' + fincl5='PS','U200' + fincl6='PS','TREFHTMX','TREFHTMN' + inithist='DAILY' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,1,1 + ramp_co2_start_ymd=20000915 + scenario_ghg='RAMP_CO2_ONLY' + start_tod=82800 + start_ymd=20000914 + / diff --git a/test/system/nl_files/fcase b/test/system/nl_files/fcase new file mode 100644 index 0000000000..c2da580862 --- /dev/null +++ b/test/system/nl_files/fcase @@ -0,0 +1,8 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=9,9,9,9,9,9 + start_ymd = 10101 + inithist='ENDOFRUN' + aqua_planet_sst=3 + / diff --git a/test/system/nl_files/ghgrmp b/test/system/nl_files/ghgrmp new file mode 100644 index 0000000000..1f374eb83f --- /dev/null +++ b/test/system/nl_files/ghgrmp @@ -0,0 +1,35 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + scenario_ghg='RAMPED' + start_tod=82800 + start_ymd=19671231 + FINCL2LONLAT = '258e:265e_34n:41n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '165e:169e_1.5s:1.5n','298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' ,'120.0e:130.0e_15n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL2 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL3LONLAT = '258e:265e_34n:41n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '165e:169e_1.5s:1.5n','298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' ,'120.0e:130.0e_15n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL3 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL4LONLAT = '67.0e_50.0n' , '67.0w_50.0s' + FINCL4 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + + collect_column_output = .false.,.false.,.true.,.true. + + inithist='ENDOFRUN' + / diff --git a/test/system/nl_files/ghgrmp_e8 b/test/system/nl_files/ghgrmp_e8 new file mode 100644 index 0000000000..b2993ab07f --- /dev/null +++ b/test/system/nl_files/ghgrmp_e8 @@ -0,0 +1,36 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + scenario_ghg='RAMPED' + start_tod=82800 + start_ymd=19671231 + FINCL2LONLAT = '225e:247e_31n:53n' , '112e:135e_16s:9s' , '157e:179e_11.5s:11.5n', + '290e:304e_21s:9s' , '240e:256e_51n:58n' , '160e:211e_30s:30n' , + '0e_89s' , '180e_0s' , '0w_0n' , + '110.0e:140.0e_15n' , '140.0w_67.0s' , '20.0e:40.0e_33s:15s' , + '260.0e_30.0n' , '260.0w_30.0s' , '50w_90.0n' , + '60.0e_70.0n' , '90.0w_80.0s' , '8e:32e_50n:54n' , + '165e:221e_20s:20n' + FINCL2 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL3LONLAT = '225e:247e_31n:53n' , '112e:135e_16s:9s' , '157e:179e_11.5s:11.5n', + '290e:304e_21s:9s' , '240e:256e_51n:58n' , '160e:211e_30s:30n' , + '0e_89s' , '180e_0s' , '0w_0n' , + '110.0e:140.0e_15n' , '140.0w_67.0s' , '20.0e:40.0e_33s:15s' , + '260.0e_30.0n' , '260.0w_30.0s' , '50w_90.0n' , + '60.0e_70.0n' , '90.0w_80.0s' , '8e:32e_50n:54n' , + '165e:221e_20s:20n' + FINCL3 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL4LONLAT = '67.0e_50.0n' , '67.0w_50.0s' + FINCL4 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + + collect_column_output = .false.,.false.,.true.,.true. + + inithist='ENDOFRUN' + eul_divdampn=1. + / diff --git a/test/system/nl_files/ghgrmp_f4 b/test/system/nl_files/ghgrmp_f4 new file mode 100644 index 0000000000..83cac5bbb3 --- /dev/null +++ b/test/system/nl_files/ghgrmp_f4 @@ -0,0 +1,35 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + scenario_ghg='RAMPED' + start_tod=82800 + start_ymd=19671231 + FINCL2LONLAT = '258e:265e_34n:41n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' ,'120.0e:130.0e_15n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL2 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL3LONLAT = '258e:265e_34n:41n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' ,'120.0e:130.0e_15n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL3 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL4LONLAT = '67.0e_50.0n' , '67.0w_50.0s' + FINCL4 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + + collect_column_output = .false.,.false.,.true.,.true. + + inithist='ENDOFRUN' + / diff --git a/test/system/nl_files/ghgrmp_unstruct b/test/system/nl_files/ghgrmp_unstruct new file mode 100644 index 0000000000..da6422e99d --- /dev/null +++ b/test/system/nl_files/ghgrmp_unstruct @@ -0,0 +1,44 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + scenario_ghg='RAMPED' + start_tod=82800 + start_ymd=19671231 + FINCL2LONLAT = '258e:265e_34n:41n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '165e:169e_1.5s:1.5n','298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL2 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL3LONLAT = '190e:195e_70n:73n','202e:206e_70n:73n' ,'129e:133e_16s:9s' ,'146e:150e_2s:2n' , + '165e:169e_1.5s:1.5n','298e:304e_21s:9s' ,'250e:256e_51n:58n' , + '5e:15e_48n:55n' ,'160e:211e_30s:30n' ,'0e_89s' , + '180e_0s' ,'0w_0n' , + '140.0w_67.0s' ,'20.0e:40.0e_23s:15s','260.0e_30.0n' , + '260.0w_30.0s' ,'50w_90.0n' ,'60.0e_70.0n' , + '90.0w_80.0s' ,'8e:12e_50n:54n' ,'165e:221e_20s:20n' + FINCL3 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL4LONLAT = '67.0e_50.0n' , '67.0w_50.0s' + FINCL4 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', + FINCL5 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU:I ','FV:I ','RELHUM:I ', + FINCL6 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', + 'PS:I ','PHIS:I ','FU:I ','FV:I ','RELHUM:I ', + + collect_column_output = .false.,.false.,.true., .true., .false.,.false. + interpolate_output = .false.,.false.,.false.,.false.,.true., .true.,.false. + interpolate_nlat = 0, 0, 0, 0, 0, 64 + interpolate_nlon = 0, 0, 0, 0, 0, 128 + interpolate_type = 0, 0, 0, 0, 0, 1 + interpolate_gridtype = 0, 0, 0, 0, 1, 2 + + inithist='ENDOFRUN' + / diff --git a/test/system/nl_files/idphys b/test/system/nl_files/idphys new file mode 100644 index 0000000000..9fad180965 --- /dev/null +++ b/test/system/nl_files/idphys @@ -0,0 +1,7 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + fincl2='U:I','V:I','T:I','TTEND_TOT:I','DTCORE:I' + / + diff --git a/test/system/nl_files/outfrq1m b/test/system/nl_files/outfrq1m new file mode 100644 index 0000000000..6ba098adf8 --- /dev/null +++ b/test/system/nl_files/outfrq1m @@ -0,0 +1,5 @@ +&camexp + nhtfrq=0,0,0,0,0,0 + mfilt=1,1,1,1,1,1 + ndens=2,2,2,2,2,2 + / diff --git a/test/system/nl_files/outfrq1s b/test/system/nl_files/outfrq1s new file mode 100644 index 0000000000..fa7dd68edc --- /dev/null +++ b/test/system/nl_files/outfrq1s @@ -0,0 +1,6 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=1,1,1,1,1,1 + inithist='ENDOFRUN' + / diff --git a/test/system/nl_files/outfrq1s_carma b/test/system/nl_files/outfrq1s_carma new file mode 100644 index 0000000000..13eb42f890 --- /dev/null +++ b/test/system/nl_files/outfrq1s_carma @@ -0,0 +1,15 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=2,2,2,2,2,2 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + history_carma=.true. + / +&carma_nl + carma_do_fixedinit=.false. + carma_reftfile="camrun.cam.r.carma_reft.nc" +/ + diff --git a/test/system/nl_files/outfrq1s_clubb b/test/system/nl_files/outfrq1s_clubb new file mode 100644 index 0000000000..05617b4e92 --- /dev/null +++ b/test/system/nl_files/outfrq1s_clubb @@ -0,0 +1,12 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=2,2,2,2,2,2 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + clubb_rad_history=.true., + history_clubb=.true., +/ diff --git a/test/system/nl_files/outfrq1s_hist b/test/system/nl_files/outfrq1s_hist new file mode 100644 index 0000000000..b61d14e0e8 --- /dev/null +++ b/test/system/nl_files/outfrq1s_hist @@ -0,0 +1,19 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=1 + mfilt=1,1,1,1,1,1 + ndens=2,2,2,2,2,2 + nhtfrq=1,1,1,1,1,1 + inithist='ENDOFRUN' + history_amwg=.true. + history_aerosol=.true. + history_aero_optics=.true. + history_eddy=.true. + history_budget=.true. + history_waccm=.true. + history_waccmx=.true. + history_chemistry=.true. + history_carma=.true. + history_clubb=.true. + / diff --git a/test/system/nl_files/outfrq24h b/test/system/nl_files/outfrq24h new file mode 100644 index 0000000000..7bef5dbefc --- /dev/null +++ b/test/system/nl_files/outfrq24h @@ -0,0 +1,5 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 + / diff --git a/test/system/nl_files/outfrq24h_carma b/test/system/nl_files/outfrq24h_carma new file mode 100644 index 0000000000..86a673c1dc --- /dev/null +++ b/test/system/nl_files/outfrq24h_carma @@ -0,0 +1,11 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 +/ + + +&carma_nl + carma_do_fixedinit=.false. + carma_reftfile="camrun.cam.r.carma_reft.nc" +/ diff --git a/test/system/nl_files/outfrq24h_epp b/test/system/nl_files/outfrq24h_epp new file mode 100644 index 0000000000..68436444a2 --- /dev/null +++ b/test/system/nl_files/outfrq24h_epp @@ -0,0 +1,9 @@ +&camexp + start_ymd = 20031231 + start_tod = 0 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 + fincl2 = 'EPP_ionpairs','N2D_EPP','N4S_EPP','OH_EPP','QSUM','ALONM','ALATM' + epp_all_filepath = '$CSMDATA/atm/cam/solar/solarforcing_ref_day_3.1_EPP_c160505.nc' + / diff --git a/test/system/nl_files/outfrq24h_port b/test/system/nl_files/outfrq24h_port new file mode 100644 index 0000000000..dbc82c3f5d --- /dev/null +++ b/test/system/nl_files/outfrq24h_port @@ -0,0 +1,18 @@ +&camexp + offline_driver_infile = '$CSMDATA/atm/cam/port/trop_strat_mam3.4x5.doubleCO2.cam.h1.0000-01-01-00000_c140430.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 + / diff --git a/test/system/nl_files/outfrq3s b/test/system/nl_files/outfrq3s new file mode 100644 index 0000000000..afde886fdd --- /dev/null +++ b/test/system/nl_files/outfrq3s @@ -0,0 +1,10 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / diff --git a/test/system/nl_files/outfrq3s_2005 b/test/system/nl_files/outfrq3s_2005 new file mode 100644 index 0000000000..12f5a9d80e --- /dev/null +++ b/test/system/nl_files/outfrq3s_2005 @@ -0,0 +1,13 @@ +! Sets things up for a short year 2005 test run (for RCPs), mostly to avoid +! having to put it in the use case. +&camexp + start_ymd=20050101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + stream_year_first = 2005 + stream_year_last = 2006 + / diff --git a/test/system/nl_files/outfrq3s_NEUwetdep b/test/system/nl_files/outfrq3s_NEUwetdep new file mode 100644 index 0000000000..a5e42cf85b --- /dev/null +++ b/test/system/nl_files/outfrq3s_NEUwetdep @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + gas_wetdep_method = 'NEU' +/ diff --git a/test/system/nl_files/outfrq3s_am b/test/system/nl_files/outfrq3s_am new file mode 100644 index 0000000000..6ee3030c51 --- /dev/null +++ b/test/system/nl_files/outfrq3s_am @@ -0,0 +1,18 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + + fv_am_fixer = .true. + fv_am_fix_lbl = .true. + fv_am_correction = .true. + fv_am_diag = .true. + do_circulation_diags = .true. + fincl1='MSKtem','VTHzm','UVzm','UWzm','Uzm','Vzm','Wzm','THzm' + + / diff --git a/test/system/nl_files/outfrq3s_bwic b/test/system/nl_files/outfrq3s_bwic new file mode 100644 index 0000000000..a31171b19e --- /dev/null +++ b/test/system/nl_files/outfrq3s_bwic @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + analytic_ic_type='baroclinic_wave' + pbuf_global_allocate=.false. + / diff --git a/test/system/nl_files/outfrq3s_carma b/test/system/nl_files/outfrq3s_carma new file mode 100644 index 0000000000..bccaf7dedb --- /dev/null +++ b/test/system/nl_files/outfrq3s_carma @@ -0,0 +1,15 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + history_carma=.true. +/ +&carma_nl + carma_do_fixedinit=.false. + carma_reftfile="camrun.cam.r.carma_reft.nc" +/ + diff --git a/test/system/nl_files/outfrq3s_carma2000 b/test/system/nl_files/outfrq3s_carma2000 new file mode 100644 index 0000000000..1bb3597b30 --- /dev/null +++ b/test/system/nl_files/outfrq3s_carma2000 @@ -0,0 +1,15 @@ +&camexp + start_ymd=20000101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / +&carma_nl + carma_do_fixedinit=.false. + carma_reftfile="camrun.cam.r.carma_reft.nc" +/ + diff --git a/test/system/nl_files/outfrq3s_carma_fractal b/test/system/nl_files/outfrq3s_carma_fractal new file mode 100644 index 0000000000..8f87e339bc --- /dev/null +++ b/test/system/nl_files/outfrq3s_carma_fractal @@ -0,0 +1,16 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / +&carma_nl + carma_do_fixedinit=.false. + carma_fractal_soot = .true. + carma_reftfile="camrun.cam.r.carma_reft.nc" +/ + diff --git a/test/system/nl_files/outfrq3s_convmic b/test/system/nl_files/outfrq3s_convmic new file mode 100644 index 0000000000..73f854c822 --- /dev/null +++ b/test/system/nl_files/outfrq3s_convmic @@ -0,0 +1,11 @@ +&camexp + zmconv_microp=.true. + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / diff --git a/test/system/nl_files/outfrq3s_cosp b/test/system/nl_files/outfrq3s_cosp new file mode 100644 index 0000000000..fc23acdd1c --- /dev/null +++ b/test/system/nl_files/outfrq3s_cosp @@ -0,0 +1,9 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + fexcl1='CFAD_DBZE94_CS','CLDTOT_CALCS','CLD_CAL_NOTCS' + / diff --git a/test/system/nl_files/outfrq3s_diags b/test/system/nl_files/outfrq3s_diags new file mode 100644 index 0000000000..eb05fcafd5 --- /dev/null +++ b/test/system/nl_files/outfrq3s_diags @@ -0,0 +1,18 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=2,2,2,2,2,2 + nhtfrq=3,3,3,3,3,3 + history_amwg=.true. + history_aerosol=.true. + history_aero_optics=.true. + history_eddy=.true. + history_budget=.true. + history_waccm=.true. + history_waccmx=.true. + history_chemistry=.true. + history_carma=.true. + history_clubb=.true. + / diff --git a/test/system/nl_files/outfrq3s_epp b/test/system/nl_files/outfrq3s_epp new file mode 100644 index 0000000000..7de75a5ab3 --- /dev/null +++ b/test/system/nl_files/outfrq3s_epp @@ -0,0 +1,19 @@ +&camexp + start_ymd = 20031231 + start_tod = 82800 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + fincl3 = 'EPP_ionpairs','N2D_EPP','N4S_EPP','OH_EPP','QSUM', + 'ELECDEN','QIONSUM','QSUM','ALONM','ALATM','BNORTH','BEAST','BDOWN','BMAG','SIGMAPED','SIGMAHAL', + 'EPOTEN','EF_EAST','EF_WEST','EF_UP','EF1_MAP','EF2_MAP','UI','VI','WI', + fincl4 = 'MSIS_T','MSIS_H','MSIS_O','MSIS_O2' + epp_mee_filepath = '$CSMDATA/atm/cam/solar/solarforcing_ref_day_3.1_c160608.nc' + epp_gcr_filepath = '$CSMDATA/atm/cam/solar/solarforcing_ref_day_3.1_c160608.nc' + epp_spe_filepath = '$CSMDATA/atm/waccm/solar/spes_1963-2013_c140916.nc' + epp_spe_varname = 'Prod' + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / diff --git a/test/system/nl_files/outfrq3s_euv b/test/system/nl_files/outfrq3s_euv new file mode 100644 index 0000000000..f59e313e72 --- /dev/null +++ b/test/system/nl_files/outfrq3s_euv @@ -0,0 +1,11 @@ +&camexp + start_ymd=20031028 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + solar_euv_data_file = '$CSMDATA/atm/waccm/phot/2003_fism_daily_and_2003301flare_23_5minutes_c150626.nc' + / diff --git a/test/system/nl_files/outfrq3s_f19c6aqwsc b/test/system/nl_files/outfrq3s_f19c6aqwsc new file mode 100644 index 0000000000..54bab5e21c --- /dev/null +++ b/test/system/nl_files/outfrq3s_f19c6aqwsc @@ -0,0 +1,12 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + ncdata='$CSMDATA/atm/waccm/ic/aqua.cam6.waccmsc_1.9x2.5_L70.2000-01-01.c170123.nc' + use_gw_rdg_beta=.false. + / diff --git a/test/system/nl_files/outfrq3s_gw_igw b/test/system/nl_files/outfrq3s_gw_igw new file mode 100644 index 0000000000..8c52e0bdd0 --- /dev/null +++ b/test/system/nl_files/outfrq3s_gw_igw @@ -0,0 +1,12 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + use_gw_front_igw = .true. + print_energy_errors = .true. + / diff --git a/test/system/nl_files/outfrq3s_gw_sh b/test/system/nl_files/outfrq3s_gw_sh new file mode 100644 index 0000000000..9ca857b427 --- /dev/null +++ b/test/system/nl_files/outfrq3s_gw_sh @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + use_gw_convect_sh = .true. + / diff --git a/test/system/nl_files/outfrq3s_ionos b/test/system/nl_files/outfrq3s_ionos new file mode 100644 index 0000000000..4b1035c94f --- /dev/null +++ b/test/system/nl_files/outfrq3s_ionos @@ -0,0 +1,13 @@ +&camexp + start_ymd=20000101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + solar_parms_data_file = '$CSMDATA/atm/waccm/solar/wa_smed_quiet.nc' + ionos_xport_nsplit = 10 + ionos_epotential_model='weimer' +/ diff --git a/test/system/nl_files/outfrq3s_lb0 b/test/system/nl_files/outfrq3s_lb0 new file mode 100644 index 0000000000..4d8f16d2ae --- /dev/null +++ b/test/system/nl_files/outfrq3s_lb0 @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + phys_loadbalance=0 + / diff --git a/test/system/nl_files/outfrq3s_lb2 b/test/system/nl_files/outfrq3s_lb2 new file mode 100644 index 0000000000..2585e2ace0 --- /dev/null +++ b/test/system/nl_files/outfrq3s_lb2 @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + phys_loadbalance=2 + / diff --git a/test/system/nl_files/outfrq3s_megan b/test/system/nl_files/outfrq3s_megan new file mode 100644 index 0000000000..11edcfb4dc --- /dev/null +++ b/test/system/nl_files/outfrq3s_megan @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + megan_factors_file = '$CSMDATA/atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20130304.nc' + / diff --git a/test/system/nl_files/outfrq3s_modalstrat b/test/system/nl_files/outfrq3s_modalstrat new file mode 100644 index 0000000000..c3dbfdaaa3 --- /dev/null +++ b/test/system/nl_files/outfrq3s_modalstrat @@ -0,0 +1,12 @@ +&camexp + start_ymd=20000101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + modal_strat_sulfate=.true. + modal_accum_coarse_exch=.true. +/ diff --git a/test/system/nl_files/outfrq3s_mozEOOH b/test/system/nl_files/outfrq3s_mozEOOH new file mode 100644 index 0000000000..e0f96fe130 --- /dev/null +++ b/test/system/nl_files/outfrq3s_mozEOOH @@ -0,0 +1,15 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + drydep_list = 'ALKOOH', 'C2H5OH', 'C2H5OOH', 'C3H7OOH', 'CH2O', 'CH3CHO', 'CH3CN', 'CH3COCH3', + 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', 'CO', 'GLYALD', 'H2O2', 'HCN', 'HCOOH', + 'HNO3', 'HO2NO2', 'HYAC', 'HYDRALD', 'ISOPOOH', 'MACROOH', 'MEKOOH', 'MPAN', 'NH3', 'NH4', + 'NO', 'NO2', 'O3', 'ONIT', 'ONITR', 'PAN', 'POOH', 'Pb', 'ROOH', 'SO2', 'TERPOOH', 'TOLOOH', 'XOOH' + gas_wetdep_method = 'NEU' +/ diff --git a/test/system/nl_files/outfrq3s_neu b/test/system/nl_files/outfrq3s_neu new file mode 100644 index 0000000000..addcc4fbb7 --- /dev/null +++ b/test/system/nl_files/outfrq3s_neu @@ -0,0 +1,11 @@ +&camexp + start_ymd=20000701 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + gas_wetdep_method = 'NEU' +/ diff --git a/test/system/nl_files/outfrq3s_newyear b/test/system/nl_files/outfrq3s_newyear new file mode 100644 index 0000000000..39c2cc3ee4 --- /dev/null +++ b/test/system/nl_files/outfrq3s_newyear @@ -0,0 +1,11 @@ +&camexp + start_ymd=19991231 + start_tod = 85800 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + / diff --git a/test/system/nl_files/outfrq3s_sd b/test/system/nl_files/outfrq3s_sd new file mode 100644 index 0000000000..42b8d54e76 --- /dev/null +++ b/test/system/nl_files/outfrq3s_sd @@ -0,0 +1,10 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + megan_factors_file = '$CSMDATA/atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20130304.nc' + / diff --git a/test/system/nl_files/outfrq3s_subcol b/test/system/nl_files/outfrq3s_subcol new file mode 100644 index 0000000000..0ecdbae701 --- /dev/null +++ b/test/system/nl_files/outfrq3s_subcol @@ -0,0 +1,14 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + microp_uniform=.false. + use_subcol_microp=.true. + subcol_scheme='tstcp' + subcol_tstcp_noAvg=.true. +/ diff --git a/test/system/nl_files/outfrq3s_sums b/test/system/nl_files/outfrq3s_sums new file mode 100644 index 0000000000..6d468a1bf6 --- /dev/null +++ b/test/system/nl_files/outfrq3s_sums @@ -0,0 +1,28 @@ +&camexp + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + vmr_sums = + 'SOAG = SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 ', + 'NOy= N + NO + NO2 + NO3 + 2*N2O5 + HNO3 + HO2NO2 + CLONO2 + BRONO2 + PAN + MPAN + ISOPNO3 +', + 'ONITR+ HONITR + ALKNIT + ISOPNITA + ISOPNITB + ISOPNOOH + NC4CH2OH + NC4CHO + NOA + NTERPOOH + PBZNIT + TERPNIT' + mmr_sums = + 'soa_a1 = soa1_a1 + soa2_a1 + soa3_a1 + soa4_a1 + soa5_a1', + 'soa_a2 = soa1_a2 + soa2_a2 + soa3_a2 + soa4_a2 + soa5_a2' + rxn_rate_sums= + 'O3_Prod = NO_HO2 + CH3O2_NO + PO2_NO + CH3CO3_NO + C2H5O2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + MACRO2_NOa +', + ' MCO3_NO + C3H7O2_NO + RO2_NO + XO2_NO + .9*TOLO2_NO +', + ' .9*PHENO2_NO + .9*C6H5O2_NO + .9*BENZO2_NO + .9*MALO2_NO + .9*BZOO_NO + .9*ACBZO2_NO + .9*DICARBO2_NO +', + '.9*MDIALO2_NO + .9*XYLOLO2_NO + .9*XYLENO2_NO + TERPO2_NO+ ', + 'TERP2O2_NO + NTERPO2_NO + ALKO2_NO + ENEO2_NO + EO2_NO + MEKO2_NO + HOCH2OO_NO + jonitr', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + H_O3 + C3H6_O3 + .9*ISOP_O3 + C2H4_O3 + .8*MVK_O3 + 0.8*MACR_O3 + MTERP_O3 + BCARY_O3' + fincl2 = 'SOAG','NOy','NOY','soa_a1','soa_a2', + 'SOAG0','SOAG1','SOAG2','SOAG3','SOAG4', + 'soa1_a1','soa2_a1','soa3_a1','soa4_a1','soa5_a1', + 'soa1_a2','soa2_a2','soa3_a2','soa4_a2','soa5_a2', + 'O3_Prod','O3_Loss' +/ diff --git a/test/system/nl_files/outfrq3s_unstruct b/test/system/nl_files/outfrq3s_unstruct new file mode 100644 index 0000000000..623cfca49e --- /dev/null +++ b/test/system/nl_files/outfrq3s_unstruct @@ -0,0 +1,11 @@ +&camexp + start_ymd=19950101 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + inithist='ENDOFRUN' + pbuf_global_allocate=.false. + se_write_restart_unstruct=.true. + / diff --git a/test/system/nl_files/outfrq9s b/test/system/nl_files/outfrq9s new file mode 100644 index 0000000000..8029f935fc --- /dev/null +++ b/test/system/nl_files/outfrq9s @@ -0,0 +1,6 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=9,9,9,9,9,9 + inithist='ENDOFRUN' + / diff --git a/test/system/nl_files/port_cam4 b/test/system/nl_files/port_cam4 new file mode 100644 index 0000000000..05499eccd1 --- /dev/null +++ b/test/system/nl_files/port_cam4 @@ -0,0 +1,17 @@ +&camexp + offline_driver_infile = '$CSMDATA/atm/cam/port/base_cam4_2deg.doubleCO2.cam.h1.0001-01-01-00000_c140808.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 +/ \ No newline at end of file diff --git a/test/system/nl_files/rad_diag b/test/system/nl_files/rad_diag new file mode 100644 index 0000000000..562d6dfa42 --- /dev/null +++ b/test/system/nl_files/rad_diag @@ -0,0 +1,49 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + start_ymd = 10101 + + rad_diag_1='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:sulf:$CSMDATA/atm/cam/physprops/sulfate_rrtmg_c080918.nc' + + rad_diag_2='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:dust1:$CSMDATA/atm/cam/physprops/dust1_rrtmg_c080918.nc' + + rad_diag_3='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:dust2:$CSMDATA/atm/cam/physprops/dust2_rrtmg_c080918.nc' + + rad_diag_4='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:dust3:$CSMDATA/atm/cam/physprops/dust3_rrtmg_c080918.nc' + + rad_diag_5='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:dust4:$CSMDATA/atm/cam/physprops/dust4_rrtmg_c080918.nc' + + rad_diag_6='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:bcar1:$CSMDATA/atm/cam/physprops/bcpho_rrtmg_c080918.nc' + + rad_diag_7='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:bcar2:$CSMDATA/atm/cam/physprops/bcphi_rrtmg_c080918.nc' + + rad_diag_8='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:ocar1:$CSMDATA/atm/cam/physprops/ocpho_rrtmg_c080918.nc' + + rad_diag_9='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:ocar2:$CSMDATA/atm/cam/physprops/ocphi_rrtmg_c080918.nc' + + rad_diag_10='A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4', + 'N:CFC11:CFC11','N:CFC12:CFC12', + 'N:sslt1:$CSMDATA/atm/cam/physprops/seasalt1_rrtmg_c080918.nc', + 'N:sslt2:$CSMDATA/atm/cam/physprops/seasalt2_rrtmg_c080918.nc', + 'N:sslt3:$CSMDATA/atm/cam/physprops/seasalt3_rrtmg_c080918.nc', + 'N:sslt4:$CSMDATA/atm/cam/physprops/seasalt4_rrtmg_c080918.nc' + / diff --git a/test/system/nl_files/rad_diag_mam b/test/system/nl_files/rad_diag_mam new file mode 100644 index 0000000000..89325bb1d0 --- /dev/null +++ b/test/system/nl_files/rad_diag_mam @@ -0,0 +1,46 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + start_ymd = 10101 + +mode_defs= +'mam3_mode1:accum:=', 'A:num_a1:N:num_c1:num_mr:+', + 'A:so4_a1:N:so4_c1:sulfate:/fs/cgd/csm/inputdata/atm/cam/physprops/sulfate_rrtmg_c080918.nc:+', + 'A:pom_a1:N:pom_c1:p-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocpho_rrtmg_c101112.nc:+', + 'A:soa_a1:N:soa_c1:s-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocphi_rrtmg_c100508.nc:+', + 'A:bc_a1:N:bc_c1:black-c:/fs/cgd/csm/inputdata/atm/cam/physprops/bcpho_rrtmg_c100508.nc:+', + 'A:dst_a1:N:dst_c1:dust:/fs/cgd/csm/inputdata/atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc:+', + 'A:ncl_a1:N:ncl_c1:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc', +'mam3_mode2:aitken:=', 'A:num_a2:N:num_c2:num_mr:+', + 'A:so4_a2:N:so4_c2:sulfate:/fs/cgd/csm/inputdata/atm/cam/physprops/sulfate_rrtmg_c080918.nc:+', + 'A:soa_a2:N:soa_c2:s-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocphi_rrtmg_c100508.nc:+', + 'A:ncl_a2:N:ncl_c2:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc', +'mam3_mode3:coarse:=', 'A:num_a3:N:num_c3:num_mr:+', + 'A:dst_a3:N:dst_c3:dust:/fs/cgd/csm/inputdata/atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc:+', + 'A:ncl_a3:N:ncl_c3:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc:+', + 'A:so4_a3:N:so4_c3:sulfate:/fs/cgd/csm/inputdata/atm/cam/physprops/sulfate_rrtmg_c080918.nc', +'mam3_m1_noso4:accum:=', 'A:num_a1:N:num_c1:num_mr:+', + 'A:pom_a1:N:pom_c1:p-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocpho_rrtmg_c101112.nc:+', + 'A:soa_a1:N:soa_c1:s-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocphi_rrtmg_c100508.nc:+', + 'A:bc_a1:N:bc_c1:black-c:/fs/cgd/csm/inputdata/atm/cam/physprops/bcpho_rrtmg_c100508.nc:+', + 'A:dst_a1:N:dst_c1:dust:/fs/cgd/csm/inputdata/atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc:+', + 'A:ncl_a1:N:ncl_c1:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc', +'mam3_m2_noso4:aitken:=', 'A:num_a2:N:num_c2:num_mr:+', + 'A:soa_a2:N:soa_c2:s-organic:/fs/cgd/csm/inputdata/atm/cam/physprops/ocphi_rrtmg_c100508.nc:+', + 'A:ncl_a2:N:ncl_c2:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc', +'mam3_m3_noso4:coarse:=', 'A:num_a3:N:num_c3:num_mr:+', + 'A:dst_a3:N:dst_c3:dust:/fs/cgd/csm/inputdata/atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc:+', + 'A:ncl_a3:N:ncl_c3:seasalt:/fs/cgd/csm/inputdata/atm/cam/physprops/ssam_rrtmg_c100508.nc' +rad_climate= + 'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11', 'N:CFC12:CFC12', + 'M:mam3_mode1:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc', + 'M:mam3_mode2:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc', + 'M:mam3_mode3:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc' +rad_diag_1= + 'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11', 'N:CFC12:CFC12', + 'M:mam3_m1_noso4:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc', + 'M:mam3_m2_noso4:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc', + 'M:mam3_m3_noso4:/fs/cgd/csm/inputdata/atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc' + + / diff --git a/test/system/nl_files/sat_hist b/test/system/nl_files/sat_hist new file mode 100644 index 0000000000..1ffdd18715 --- /dev/null +++ b/test/system/nl_files/sat_hist @@ -0,0 +1,18 @@ +&camexp + restart_option='nsteps' + restart_n=3 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,-2,3 + mfilt=1,1,1,1,1,1 + start_ymd=20050101 + sathist_track_infile='$CSMDATA/atm/cam/sat/satellite_profilelist_20020125_20101030_c110204_noleap.nc' + sathist_fincl = 'Q','T','PS','U','V','FV' + fincl3 = 'Q','T','PS','FV','UWzm:I' + fincl4 = 'Q','T','PS','FV','UWzm:I' + fincl5 = 'Q','T','U','V','PS','FV','UWzm','AEROD_v','TOT_CLD_VISTAU' + lcltod_start = 0,0, 7200,82800,0 + lcltod_stop = 0,0,10800,7200,0 + avgflag_pertape = 'I',' ','L','L','S' + do_circulation_diags=.true. + fexcl1='CFAD_DBZE94_CS','CLDTOT_CALCS','CLD_CAL_NOTCS' +/ diff --git a/test/system/nl_files/scm_b4b_o1 b/test/system/nl_files/scm_b4b_o1 new file mode 100644 index 0000000000..51d79384ea --- /dev/null +++ b/test/system/nl_files/scm_b4b_o1 @@ -0,0 +1,14 @@ +&camexp + ncdata = '../camrun.cam.i.0000-09-01-00000.nc' + start_ymd = 901 + NDENS = 1,1,1,1,1,1 + MFILT = 1,7,1,1,1,1 + nhtfrq = 1,1,1,1,1,1 + fincl2='TDIFF','QDIFF','LANDFRAC' + scmlon= 140. + scmlat= -20. + iopfile = '../camrun.cam.h1.0000-09-01-00000.nc' + inithist_all = .true. + scm_cambfb_mode = .true. + scm_use_obs_uv = .true. +/ diff --git a/test/system/nl_files/scm_prep b/test/system/nl_files/scm_prep new file mode 100644 index 0000000000..6796e815ba --- /dev/null +++ b/test/system/nl_files/scm_prep @@ -0,0 +1,8 @@ +&camexp + start_ymd=901 + NDENS = 1,1 + MFILT = 1,10 + nhtfrq = 0,1 + inithist = 'CAMIOP' + inithist_all = .true. + / diff --git a/test/system/nl_files/scmarm b/test/system/nl_files/scmarm new file mode 100644 index 0000000000..f3575ed62f --- /dev/null +++ b/test/system/nl_files/scmarm @@ -0,0 +1,12 @@ +&camexp + start_ymd = 901 + start_ymd = 19970618 + start_tod = 84585 + scmlat=36.6 + scmlon=262.5 + stop_n=7 + stop_option='nsteps' + mfilt=1500 + nhtfrq = 1 + history_budget=.true. +/ diff --git a/test/system/nl_files/terminator b/test/system/nl_files/terminator new file mode 100644 index 0000000000..7c93028917 --- /dev/null +++ b/test/system/nl_files/terminator @@ -0,0 +1,7 @@ +&camexp + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + fincl2='U:I','V:I','T:I','TTEND_TOT:I','CL:I','CL2:I' + / + diff --git a/test/system/nl_files/ttrac b/test/system/nl_files/ttrac new file mode 100644 index 0000000000..513755c80b --- /dev/null +++ b/test/system/nl_files/ttrac @@ -0,0 +1,9 @@ +&camexp + start_ymd=1231 + start_tod=82800 + restart_option='nsteps' + restart_n=3 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + / diff --git a/test/system/nl_files/ttrac_lb0 b/test/system/nl_files/ttrac_lb0 new file mode 100644 index 0000000000..6d6ea2f5eb --- /dev/null +++ b/test/system/nl_files/ttrac_lb0 @@ -0,0 +1,9 @@ +&camexp + start_ymd=1231 + start_tod=82800 + restart_option='none' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + phys_loadbalance=0 + / diff --git a/test/system/nl_files/ttrac_lb1 b/test/system/nl_files/ttrac_lb1 new file mode 100644 index 0000000000..4b537de2cd --- /dev/null +++ b/test/system/nl_files/ttrac_lb1 @@ -0,0 +1,9 @@ +&camexp + start_ymd=1231 + start_tod=82800 + restart_option='none' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + phys_loadbalance=1 + / diff --git a/test/system/nl_files/ttrac_lb2 b/test/system/nl_files/ttrac_lb2 new file mode 100644 index 0000000000..ec39043821 --- /dev/null +++ b/test/system/nl_files/ttrac_lb2 @@ -0,0 +1,9 @@ +&camexp + start_ymd=1231 + start_tod=82800 + restart_option='none' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + phys_loadbalance=2 + / diff --git a/test/system/nl_files/ttrac_lb3 b/test/system/nl_files/ttrac_lb3 new file mode 100644 index 0000000000..f3e82800bb --- /dev/null +++ b/test/system/nl_files/ttrac_lb3 @@ -0,0 +1,9 @@ +&camexp + start_ymd=1231 + start_tod=82800 + restart_option='none' + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=3,3,3,3,3,3 + phys_loadbalance=3 + / diff --git a/test/system/nl_files/volc b/test/system/nl_files/volc new file mode 100644 index 0000000000..35d7123445 --- /dev/null +++ b/test/system/nl_files/volc @@ -0,0 +1,6 @@ +&camexp + start_ymd=18840101 + mfilt=1,1,1,1,1,1 + ndens=1,1,1,1,1,1 + nhtfrq=-24,-24,-24,-24,-24,-24 + / diff --git a/test/system/tag_email.sh b/test/system/tag_email.sh new file mode 100755 index 0000000000..927b681bb4 --- /dev/null +++ b/test/system/tag_email.sh @@ -0,0 +1,52 @@ +#!/bin/sh +# script currently set to run every 10min as cron job on poorman + +admin=mvr@cgd.ucar.edu + +cd /fs/cgd/csm/models/atm/cam/doc + +svn diff -r HEAD --diff-cmd /usr/bin/diff -x "-b" ChangeLog > ./body +rc=$? +if [ $rc -eq 0 ]; then + bytes=`wc -c < ./body` + if [ "$bytes" -ne 0 ]; then + subject=`grep 'Tag name:' ./body | head -1` + subject=${subject##*:} + subject=`echo ${subject}` + svn list https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/${subject} > /dev/null + rc=$? + if [ $rc -eq 0 ]; then + echo "" > ./message + echo "*** RESPONSES TO THIS EMAIL WILL NOT BE READ ***" >> ./message + echo "" >> ./message + cat ./body >> ./message + env NAME='CAM Gatekeeper' mail -s ${subject} cam-dev@cgd.ucar.edu < ./message + + rc=$? + if [ $rc -eq 0 ]; then + svn update + rm /home/cam/.vacation.db + cp ChangeLog /web/public_html/cam/versions/. + cp ./body /web/public_html/cam/cam_checkins/Documentation/${subject}.diffs + else + echo "Error from mail= $rc" + echo "Error from mail= $rc" \ + | env NAME='CAM Gatekeeper' mail -s "cron script error" $admin + fi + rm ./message + else + echo "Error from svn list= $rc ...ChangeLog committed but $subject not tagged?" + echo "Error from svn list= $rc ...ChangeLog committed but $subject not tagged?" \ + | env NAME='CAM Gatekeeper' mail -s "cron script error" $admin + fi + else + echo "ChangeLog unmodified" + fi +else + echo "Error from svn diff= $rc ...repository offline?" + echo "Error from svn diff= $rc ...repository offline?" \ + | env NAME='CAM Gatekeeper' mail -s "cron script error" $admin +fi +rm ./body + +exit 0 diff --git a/test/system/test_driver.sh b/test/system/test_driver.sh new file mode 100755 index 0000000000..dc36cd0033 --- /dev/null +++ b/test/system/test_driver.sh @@ -0,0 +1,974 @@ +#!/bin/sh -f +# +# test_driver.sh: driver for the testing of CAM with standalone scripts +# +# usage on hobart, leehill, cheyenne +# ./test_driver.sh +# +# **more details in the CAM testing user's guide, accessible +# from the CAM developers web page + +## +## General syntax help function +## Usage: help +## + +help () { + local hname="Usage: `basename ${0}` [ OPTION [ OPTION ... ] ]" + local hprefix="`echo ${hname} | tr '[!-~]' ' '`" + hprefix=" " + echo "${hname} " + echo "${hprefix} [ -b ] (support baseline scripts for cam5_2_12 and earlier)" + echo "${hprefix} [ -e ] (email summary to $USER)" + echo "${hprefix} [ -f ] (force batch submission -- avoids user prompt)" + echo "${hprefix} [ -h ] (displays this help message)" + echo "${hprefix} [ -i ] (interactive usage)" + echo "${hprefix} [ -j ] (number of jobs for gmake)" + echo "${hprefix} [ --archive-cime ] (directory for archiving baselines of cime tests)" + echo "${hprefix} [ --cesm ] (default aux_cam)" + echo "${hprefix} [ --no-cesm ] (do not run any CESM test or test suite)" + echo "${hprefix} [ --no-cam ] (do not run CAM regression tests" + echo "${hprefix} [ --rerun-cesm ] (rerun the cesm tests with the --use-existing-flag)" + echo "" + echo "${hprefix} **pass environment variables by preceding above commands with:" + echo "${hprefix} 'env var1=setting var2=setting '" + echo "" + echo "Supported ENVIRONMENT variables" + echo "BL_TESTDIR: Default = none (used to set CESM baseline compare dir)" + echo "CAM_ACCOUNT: Default = none" + echo "CAM_BATCHQ: Default = machine dependent" + echo "CAM_FC: Default = machine dependent" + echo "CAM_INPUT_TESTS: Default = tests_pretag_[_]" + echo "CAM_RESTART_TASKS: Default = 64" + echo "CAM_RETAIN_FILES: Default = FALSE" + echo "CAM_ROOT: Default = set relative to CAM_SCRIPTDIR" + echo "NB: If script is not called as ./`basename ${0}`, CAM_ROOT must be specified" + echo "CAM_SCRIPTDIR: Default = " + echo "CAM_TAG: Default = none (used to set CESM baseline dir)" + echo "CAM_TASKS: Default = 32" + echo "CAM_TESTDIR: Default = /test-driver." + echo "" + echo "Less common ENVIRONMENT variables" + echo "CALDERA_BATCHQ: Default = caldera" + echo "CAM_RBOPTIONS: Default = build_only" + echo "CAM_SOFF: Default = none (stop of first test fail if TRUE)" + echo "CIME_MODEL: Default = none (should be set to cesm)" + echo "EMAIL: Default = $USER@ucar.edu" + echo "SUMMARY_FILE: Default = `pwd -P`/cam_test_summaries}" + exit $1 +} + +## +## Error output function (should be handed a string) +## +perr() { + echo -e "\nERROR: ${@}\n" + help 1 +} + +## These variables may be overridden from the user's environment +EMAIL=${EMAIL:-"${USER}@ucar.edu"} +SUMMARY_FILE="${SUMMARY_FILE:-`pwd -P`/cam_test_summaries}" + +# These variables may be modified by script switches (./test_driver.sh -h) +cam_email_summary=false +cesm_test_suite="aux_cam" +force=false +gmake_j=0 +interactive=false +run_cam_regression=true +use_existing='' + +# Initialize variables which may not be set +submit_script='' +submit_script_cb='' +submit_script_cime='' + +while [ "${1:0:1}" == "-" ]; do + case $1 in + + --archive-cime ) + if [ $# -lt 2 ]; then + perr "${1} requires a directory name)" + fi + archive_dir="${2}" + shift + ;; + + -b ) export CAM_BASEBACK="YES" + ;; + + --cesm ) + if [ $# -lt 2 ]; then + perr "${1} requires a CESM test name or test suite name (e.g., aux_cam)" + fi + if [ "${2:0:1}" == "-" ]; then + perr "Invalid CESM test name, '${2}'" + fi + cesm_test_suite="${2}" + shift + ;; + + -e ) cam_email_summary=true + ;; + + -f ) force=true + if $interactive ; then + echo "test_driver.sh: FATAL ERROR: -i and -f were set" + exit 1 + fi + ;; + + -h | --help ) + help 0 + ;; + + -i ) interactive=true + if $force ; then + echo "test_driver.sh: FATAL ERROR: -i and -f were set" + exit 1 + fi + ;; + + -j ) shift; gmake_j=$1 + ;; + + --no-cam ) + run_cam_regression=false + ;; + + --no-cesm ) + cesm_test_suite="none" + ;; + + --rerun-cesm ) + if [ $# -lt 2 ]; then + perr "${1} requires a test_id from a previous run)" + fi + use_existing="${2}" + shift + ;; + + esac + shift +done + +# Currently, we don't support non-options, should we? +if [ $# -gt 0 ]; then + perr "Unrecognized arguments: '$*'" +fi + +#will attach timestamp onto end of script name to prevent overwriting +start_date="`date --iso-8601=seconds`" +cur_time=`date '+%H%M%S'` + +hostname=`hostname` + +case $hostname in + + ##cheyenne + ch* | r* ) + submit_script="`pwd -P`/test_driver_cheyenne_${cur_time}.sh" + submit_script_cb="`pwd -P`/test_driver_cheyenne_cb_${cur_time}.sh" + submit_script_cime="`pwd -P`/test_driver_cheyenne_cime_${cur_time}.sh" + + if [ -z "$CAM_ACCOUNT" ]; then + echo "ERROR: Must set the environment variable CAM_ACCOUNT" + exit 2 + fi + + if [ -z "$CAM_BATCHQ" ]; then + export CAM_BATCHQ="regular" + fi + + # wallclock for run job + wallclock_limit="5:00:00" + + if [ $gmake_j = 0 ]; then + gmake_j=36 + fi + + # run tests on 2 nodes using 12 tasks/node, 3 threads/task + CAM_TASKS=24 + CAM_THREADS=3 + + # change parallel configuration on 2 nodes using 18 tasks/node, 2 threads/task + CAM_RESTART_TASKS=36 + CAM_RESTART_THREADS=2 + + mach_workspace="/glade/scratch" + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv + +cat > ${submit_script_cb} << EOF +#!/bin/sh +# +#PBS -N test_dr +#PBS -q $CAM_BATCHQ +#PBS -A $CAM_ACCOUNT +#PBS -l walltime=2:00:00 +#PBS -l select=1:ncpus=36:mpiprocs=36 +#PBS -j oe +#PBS -l inception=login + +export TMPDIR=/glade/scratch/$USER + +if [ -n "\$PBS_JOBID" ]; then #batch job + export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\` + initdir=`pwd -P` + interactive=false +else + interactive=true +fi + +export CAM_RBOPTIONS="build_only" + +## create_newcase looks for account number in ACCOUNT environment variable +export ACCOUNT=$CAM_ACCOUNT + +# tasks and threads need to be set in the cb script because TCB_ccsm.sh uses +# them to set the pe_layout +export CAM_THREADS=$CAM_THREADS +export CAM_TASKS=$CAM_TASKS + +module load intel/17.0.1 +module load mkl +module list + +export CFG_STRING="-cc mpicc -fc mpif90 -fc_type intel " +export MAKE_CMD="gmake -j $gmake_j" +export CCSM_MACH="cheyenne" +export MACH_WORKSPACE="$mach_workspace" +dataroot=${CESMDATAROOT} +echo_arg="-e" +input_file="tests_pretag_cheyenne" + +EOF + +#------------------------------------------- + +cat > ${submit_script} << EOF +#!/bin/sh +# +#PBS -N test_dr +#PBS -q $CAM_BATCHQ +#PBS -A $CAM_ACCOUNT +#PBS -l walltime=$wallclock_limit +#PBS -l select=2:ncpus=36:mpiprocs=36 +#PBS -j oe + +export TMPDIR=/glade/scratch/$USER + +if [ -n "\$PBS_JOBID" ]; then #batch job + export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\` + initdir=`pwd -P` + interactive=false +else + interactive=true +fi + +export CAM_RBOPTIONS="run_only" +ulimit -c unlimited + +##omp threads +export OMP_STACKSIZE=256M +export CAM_THREADS=$CAM_THREADS +export CAM_RESTART_THREADS=$CAM_RESTART_THREADS + +##mpi tasks +export CAM_TASKS=$CAM_TASKS +export CAM_RESTART_TASKS=$CAM_RESTART_TASKS + +module load intel/17.0.1 +module load mkl +module list + +export CCSM_MACH="cheyenne" +export MACH_WORKSPACE="$mach_workspace" +export CPRNC_EXE=${CESMDATAROOT}/tools/cime/tools/cprnc/cprnc.cheyenne +export ADDREALKIND_EXE=/fs/cgd/csm/tools/addrealkind/addrealkind + +dataroot=${CESMDATAROOT} + +echo_arg="-e" + +input_file="tests_pretag_cheyenne" + +EOF + +#------------------------------------------- + +cat > ${submit_script_cime} << EOF +#!/bin/bash +# +#PBS -N cime-tests +#PBS -q $CAM_BATCHQ +#PBS -A $CAM_ACCOUNT +#PBS -l walltime=4:00:00 +#PBS -l select=1:ncpus=36:mpiprocs=36 +#PBS -j oe +#PBS -l inception=login + +EOF + +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + + ##hobart + hob* | h[[:digit:]]* ) + submit_script="`pwd -P`/test_driver_hobart_${cur_time}.sh" + submit_script_cime="`pwd -P`/test_driver_hobart_cime_${cur_time}.sh" + export PATH=/cluster/torque/bin:${PATH} + + # Default setting is 12 hr in the long queue; the short queue only + # allows 1 hr runs. + wallclock_limit="12:00:00" + gmake_j=24 + if [ -z "$CAM_BATCHQ" ]; then + export CAM_BATCHQ="long" + elif [[ "$CAM_BATCHQ" == short ]]; then + wallclock_limit="1:00:00" + fi + + if [ $gmake_j = 0 ]; then + gmake_j=24 + fi + + if [ -z "$CAM_TASKS" ]; then + CAM_TASKS=24 + fi + if [ -z "$CAM_RESTART_TASKS" ]; then + CAM_RESTART_TASKS=$(( $CAM_TASKS / 2)) + fi + + mach_workspace="/scratch/cluster" + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv +cat > ${submit_script} << EOF +#!/bin/sh +# + +# Name of the queue (CHANGE THIS if needed) +#PBS -q $CAM_BATCHQ +# Number of nodes (CHANGE THIS if needed) +#PBS -l walltime=$wallclock_limit,nodes=1:ppn=24 +# output file base name +#PBS -N test_dr +# Put standard error and standard out in same file +#PBS -j oe +# Export all Environment variables +#PBS -V +# End of options + +# Make sure core dumps are created +ulimit -c unlimited + +if [ -n "\$PBS_JOBID" ]; then #batch job + export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\` + initdir=\${PBS_O_WORKDIR} +fi + +if [ "\$PBS_ENVIRONMENT" = "PBS_BATCH" ]; then + interactive=false +else + interactive=true +fi + +if [ -z "$CAM_RBOPTIONS" ]; then + export CAM_RBOPTIONS="run_and_build" +fi + +##omp threads +export CAM_THREADS=1 +export CAM_RESTART_THREADS=2 + +##mpi tasks +export CAM_TASKS=$CAM_TASKS +export CAM_RESTART_TASKS=$CAM_RESTART_TASKS + +export P4_GLOBMEMSIZE=500000000 +source /usr/share/Modules/init/sh +module purge + +export LAPACK_LIBDIR=/usr/lib64 + +# Not currently used on hobart +#/usr/local/bin/make_ib_hosts.sh + +if [ "\$CAM_FC" = "INTEL" ]; then + module load compiler/intel/14.0.2 + export CFG_STRING=" -cc mpicc -fc_type intel -fc mpif90 -cppdefs -DNO_MPI2 -cppdefs -DNO_MPIMOD " + export INC_NETCDF=\${NETCDF_PATH}/include + export LIB_NETCDF=\${NETCDF_PATH}/lib + input_file="tests_pretag_hobart_nag" + export CCSM_MACH="hobart_intel" +elif [ "\$CAM_FC" = "NAG" ]; then + module load compiler/nag/6.1 + export CFG_STRING="-cc mpicc -fc mpif90 -fc_type nag " + export INC_NETCDF=\${NETCDF_PATH}/include + export LIB_NETCDF=\${NETCDF_PATH}/lib + input_file="tests_pretag_hobart_nag" + export CCSM_MACH="hobart_nag" +else + module load compiler/pgi/17.05 + export CFG_STRING=" -cc mpicc -fc_type pgi -fc mpif90 -cppdefs -DNO_MPI2 -cppdefs -DNO_MPIMOD " + export INC_NETCDF=\${NETCDF_PATH}/include + export LIB_NETCDF=\${NETCDF_PATH}/lib + input_file="tests_pretag_hobart_pgi" + export CCSM_MACH="hobart_pgi" +fi +export MAKE_CMD="gmake --output-sync -j $gmake_j" +export MACH_WORKSPACE="$mach_workspace" +export CPRNC_EXE=/fs/cgd/csm/tools/cprnc_hobart/cprnc +export ADDREALKIND_EXE=/fs/cgd/csm/tools/addrealkind/addrealkind +dataroot="/fs/cgd/csm" +echo_arg="-e" + +EOF + +#------------------------------------------- + +cat > ${submit_script_cime} << EOF +#!/bin/bash +# +# Name of the queue (CHANGE THIS if needed) +#PBS -q $CAM_BATCHQ +# Number of nodes (CHANGE THIS if needed) +#PBS -l walltime=$wallclock_limit,nodes=1:ppn=24 +# output file base name +#PBS -N cime-tests +# Put standard error and standard out in same file +#PBS -j oe +# Export all Environment variables +#PBS -V +# End of options + +EOF + +# To lower number of nodes required for regression testing on Hobart, +# run CIME test suites sequentially after standalone regression tests +submit_script_cime="${submit_script}" +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + + ##leehill - always run with CAM_FC=PGI and -i + le* ) + submit_script="`pwd -P`/test_driver_leehill_${cur_time}.sh" + export PATH=/cluster/torque/bin:${PATH} + + # Default setting is 12 hr in the long queue; the short queue only + # allows 1 hr runs. + wallclock_limit="12:00:00" + if [ -z "$CAM_BATCHQ" ]; then + export CAM_BATCHQ="long" + elif [[ "$CAM_BATCHQ" == short ]]; then + wallclock_limit="1:00:00" + fi + + if [ $gmake_j = 0 ]; then + gmake_j=8 + fi + + mach_workspace="/scratch/cluster" + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv + +cat > ${submit_script} << EOF +#!/bin/sh +# + +# Make sure core dumps are created +ulimit -c unlimited + +if [ -n "\$PBS_JOBID" ]; then #batch job + export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\` + initdir=\${PBS_O_WORKDIR} +fi + +if [ "\$PBS_ENVIRONMENT" = "PBS_BATCH" ]; then + interactive=false +else + interactive=true +fi + +echo "interactive = ${interactive}" + +if [ -z "$CAM_RBOPTIONS" ]; then + export CAM_RBOPTIONS="run_and_build" +fi + +export INTEL=/usr/local/intel-cluster +export NAG=/usr/local/nag +export PGI=/usr/local/pgi +export LD_LIBRARY_PATH=\${PGI}/linux86-64/lib:/cluster/torque/lib:\${INTEL}/lib/intel64 +echo \${LD_LIBRARY_PATH} +export P4_GLOBMEMSIZE=500000000 + +# Only PGI is supported on leehill at this time +#if [ "\$CAM_FC" = "PGI" ]; then + export LAPACK_LIBDIR=\${PGI}/linux86-64/lib + export INC_NETCDF=/usr/local/netcdf-pgi/include + export LIB_NETCDF=/usr/local/netcdf-pgi/lib + export PATH=\${PGI}/linux86-64/bin:\${PATH}:\${LIB_NETCDF} + export LD_LIBRARY_PATH=\${PGI}/linux86-64/libso:\${LIB_NETCDF}:\${LD_LIBRARY_PATH} + export CFG_STRING=" -cc pgcc -fc_type pgi -fc pgf90 " + export input_file="tests_pretag_leehill" + export CCSM_MACH="leehill_pgi" +#fi +export MAKE_CMD="gmake -j $gmake_j" +export MACH_WORKSPACE="$mach_workspace" +export CPRNC_EXE=/fs/cgd/csm/tools/cprnc_64/cprnc +export ADDREALKIND_EXE=/fs/cgd/csm/tools/addrealkind/addrealkind +dataroot="/fs/cgd/csm" +echo_arg="-e" + +EOF + +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + + + * ) echo "ERROR: machine $hostname not currently supported"; exit 1 ;; +esac + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv + +for file in ${submit_script} ${submit_script_cb} +do +cat >> ${file} << EOF + +##check if interactive job +if \$interactive ; then + + echo "test_driver.sh: interactive run - setting JOBID to \$\$" + export JOBID=\$\$ + if [ \$0 = "test_driver.sh" ]; then + initdir="." + else + initdir=\${0%/*} + fi +fi + +##establish script dir and cam_root +if [ -f \${initdir}/test_driver.sh ]; then + export CAM_SCRIPTDIR=\`cd \${initdir}; pwd \` + if [ -d "\${CAM_SCRIPTDIR}/../../components" ]; then + export CAM_ROOT=\`cd \${CAM_SCRIPTDIR}/../.. ; pwd \` + else + export CAM_ROOT=\`cd \${CAM_SCRIPTDIR}/../../../.. ; pwd \` + fi +else + if [ -n "\${CAM_ROOT}" ] && [ -f \${CAM_ROOT}/components/cam/test/system/test_driver.sh ]; then + export CAM_SCRIPTDIR=\`cd \${CAM_ROOT}/components/cam/test/system; pwd \` + else + if [ -n "\${CAM_ROOT}" -a -f "\${CAM_ROOT}/test/system/test_driver.sh" ]; then + export CAM_SCRIPTDIR=\`cd \${CAM_ROOT}/test/system; pwd \` + else + echo "ERROR: unable to determine script directory " + echo " if initiating batch job from directory other than the one containing test_driver.sh, " + echo " you must set the environment variable CAM_ROOT to the full path of directory containing " + echo " . " + exit 3 + fi + fi +fi + +##output files +cam_log=\${initdir}/td.\${JOBID}.log +if [ -f \$cam_log ]; then + rm \$cam_log +fi +cam_status=\${initdir}/td.\${JOBID}.status +if [ -f \$cam_status ]; then + rm \$cam_status +fi + +##setup test work directory +if [ -z "\$CAM_TESTDIR" ]; then + export CAM_TESTDIR=$mach_workspace/\$LOGNAME/test-driver.\${JOBID} + if [ -d \$CAM_TESTDIR ]; then + rm -rf \$CAM_TESTDIR + fi +fi +if [ ! -d \$CAM_TESTDIR ]; then + mkdir -p \$CAM_TESTDIR + if [ \$? -ne 0 ]; then + echo "ERROR: unable to create work directory \$CAM_TESTDIR" + exit 4 + fi +fi + +##set our own environment vars +export CSMDATA=\${dataroot}/inputdata +export MPI_TYPE_MAX=100000 + +##process other env vars possibly coming in +if [ -z "\$CAM_RETAIN_FILES" ]; then + export CAM_RETAIN_FILES=FALSE +fi +if [ -n "\${CAM_INPUT_TESTS}" ]; then + input_file=\$CAM_INPUT_TESTS +else + input_file=\${CAM_SCRIPTDIR}/\${input_file} +fi + +if [ ! -f \${input_file} ]; then + echo "ERROR: unable to locate input file \${input_file}" + exit 5 +fi + +if \$interactive ; then + echo "reading tests from \${input_file}" +else + echo "reading tests from \${input_file}" >> \${cam_log} +fi + +num_tests=\`wc -w < \${input_file}\` +echo "STATUS OF CAM TESTING UNDER JOB \${JOBID}; scheduled to run \$num_tests tests from:" >> \${cam_status} +echo "\$input_file" >> \${cam_status} +echo "" >> \${cam_status} +echo "Start testing at \$(date)" >> \${cam_status} +echo "On node \$(hostname)" >> \${cam_status} +uptime >> \${cam_status} +echo "" >> \${cam_status} +if \$interactive ; then + echo "see \${cam_log} for more detailed output" >> \${cam_status} +fi +echo "" >> \${cam_status} + +test_list="" +while read input_line; do + test_list="\${test_list}\${input_line} " +done < \${input_file} + +##initialize flags, counter +skipped_tests="NO" +pending_tests="NO" +count=0 + +##loop through the tests of input file +for test_id in \${test_list}; do + count=\`expr \$count + 1\` + while [ \${#count} -lt 3 ]; do + count="0\${count}" + done + + master_line=\`grep \$test_id \${CAM_SCRIPTDIR}/input_tests_master\` + status_out="" + for arg in \${master_line}; do + status_out="\${status_out}\${arg} " + done + + + test_cmd=\${status_out#* } + + status_out="\${count} \${status_out}" + + if \$interactive ; then + echo "" + echo "************************************************************" + echo "\${status_out}" + echo "************************************************************" + else + echo "" >> \${cam_log} + echo "************************************************************"\ + >> \${cam_log} + echo "\$status_out" >> \${cam_log} + echo "************************************************************"\ + >> \${cam_log} + fi + + while [ \${#status_out} -lt 95 ]; do + status_out="\${status_out}." + done + + echo \$echo_arg "\$status_out\c" >> \${cam_status} + + + + if \$interactive ; then + \${CAM_SCRIPTDIR}/\${test_cmd} \$CAM_RBOPTIONS + rc=\$? + else + \${CAM_SCRIPTDIR}/\${test_cmd} \$CAM_RBOPTIONS >> \${cam_log} 2>&1 + rc=\$? + fi + if [ \$rc -eq 0 ]; then + if [ \${CAM_RBOPTIONS} = "build_only" ]; then + echo "BUILT at \$(date)" >> \${cam_status} + else + echo "PASS at \$(date)" >> \${cam_status} + fi + elif [ \$rc -eq 255 ]; then + echo "SKIPPED* at \$(date)" >> \${cam_status} + skipped_tests="YES" + elif [ \$rc -eq 254 ]; then + echo "PENDING** at \$(date)" >> \${cam_status} + pending_tests="YES" + else + echo "FAIL! rc= \$rc at \$(date)" >> \${cam_status} + if \$interactive ; then + if [ "\$CAM_SOFF" != "FALSE" ]; then + echo "stopping on first failure" + echo "stopping on first failure" >> \${cam_status} + exit 6 + fi + else + if [ "\$CAM_SOFF" == "TRUE" ]; then + echo "stopping on first failure" >> \${cam_status} + echo "stopping on first failure" >> \${cam_log} + exit 6 + fi + fi + fi +done + + +echo "end of input" >> \${cam_status} +if \$interactive ; then + echo "end of input" +else + echo "end of input" >> \${cam_log} +fi + +if [ "\$skipped_tests" = "YES" ]; then + echo "* please verify that any skipped tests are not required of your cam commit" >> \${cam_status} +fi +if [ "\$pending_tests" = "YES" ]; then + echo "** tests that are pending must be checked manually for a successful completion" >> \${cam_status} + if \$interactive ; then + echo " see the test's output in \${cam_log} " >> \${cam_status} + echo " for the location of test results" >> \${cam_status} + fi +fi +EOF + +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + +done + +## Make sure we have a place to store test summaries +if [ ! -f "${SUMMARY_FILE}" ]; then + touch "${SUMMARY_FILE}" +fi + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvv add summary to output or email vvvvvvvvvvvvvvv + +cat >> ${submit_script} << EOF +banner="========================================" +subj="CAM regression test summary from \$CCSM_MACH" +np="Num PASS = \$( grep PASS \${cam_status} | wc -l )" +nf="Num FAIL = \$( grep FAIL \${cam_status} | wc -l )" +js="$CAM_FC job started at ${start_date}" +je="$CAM_FC job finished at \$( date --iso-8601=seconds )" +echo "${banner}" | tee -a ${SUMMARY_FILE} +echo "\${js}" | tee -a ${SUMMARY_FILE} +echo "" | tee -a ${SUMMARY_FILE} +echo "\${np}" | tee -a ${SUMMARY_FILE} +echo "\${nf}" | tee -a ${SUMMARY_FILE} +if [ "${nf}" != "Num FAIL = 0" ]; then + grep FAIL \${cam_status} | tee -a ${SUMMARY_FILE} +fi +echo "" | tee -a ${SUMMARY_FILE} +echo "\${je}" | tee -a ${SUMMARY_FILE} +echo "" | tee -a ${SUMMARY_FILE} +EOF + +if $cam_email_summary; then + cat >> ${submit_script} << EOF +echo -e "\${js}\n\n\${np}\n\${nf}\n\n${je}" | mail -s "\${subj}" ${EMAIL} +EOF +fi +if [ "${submit_script}" != "${submit_script_cime}" ]; then + echo "exit 0" >> ${submit_script} +fi + +# If setting up a separate "configure and build" script then add command to +# submit the run script after builds are done. +if [ -n "${submit_script_cb}" ]; then + + case $hostname in + # cheyenne + chey* | r* ) + batch_queue_submit='qsub ' + ;; + *) + echo "ERROR: machine $hostname not currently supported for batch builds" + exit 1 + ;; + esac + +cat >> ${submit_script_cb} << EOF +echo "$batch_queue_submit ${submit_script}" >> \${cam_log} +$batch_queue_submit ${submit_script} >> \${cam_log} 2>&1 +exit 0 +EOF + +fi + +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ add summary to output or email ^^^^^^^^^^^^^^^ + +for file in ${submit_script} ${submit_script_cb} +do + chmod a+x $file +done + +if $interactive ; then + if [ ${submit_script_cb} ]; then + ${submit_script_cb} + else + ${submit_script} + fi + exit 0 +fi + +if ! $force ; then + echo "" + echo "**********************" + echo "$submit_script has been created and will be submitted to the batch queue..." + echo "(ret) to continue, (a) to abort" + read ans + case $ans in + [aA]* ) + echo "aborting...type ./test_driver.sh -h for help message" + exit 0 + ;; + esac +fi + +##vvvvvvvvvvvvvvvvvvvvvv start CAM aux test suite vvvvvvvvvvvvvvvvvvvvvvvvvvvv + +cesm_test_mach="" +comp="" +if [ "${hostname:0:4}" == "chey" ]; then + cesm_test_mach="cheyenne" +fi +if [ "${hostname:0:6}" == "hobart" ]; then + cesm_test_mach="hobart" +fi +if [ -n "${CAM_FC}" ]; then + comp="_${CAM_FC,,}" +fi + +if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then + if [ "${hostname:0:6}" != "hobart" ]; then + module load python + fi + + for cesm_test in ${cesm_test_suite}; do + testargs="--xml-category ${cesm_test} --xml-machine ${cesm_test_mach}" + + if [ -n "${use_existing}" ]; then + test_id="${use_existing}" + else + idstr="`date '+%Y%m%d%H%M%S'`" + test_id=${cesm_test}${comp}"_"${idstr} + fi + currdir="`pwd -P`" + logfile="${currdir}/${test_id}.log" + tdir="$( cd $( dirname $0 ); pwd -P )" + trial_dir="$( dirname $( dirname $( dirname $( dirname ${tdir} ) ) ) )" + if [ -d "${trial_dir}/cime/scripts" ]; then + root_dir=$trial_dir + else + root_dir="$( dirname $( dirname ${tdir} ) )" + fi + + script_dir="${root_dir}/cime/scripts" + if [ ! -d "${script_dir}" ]; then + echo "ERROR: CIME scripts dir not found at ${script_dir}" + exit 1 + fi + if [ ! -x "${script_dir}/create_test" ]; then + echo "ERROR: create_test script dir not found in ${script_dir}" + exit 1 + fi + + ##setup CESM work directory + cesm_testdir=$mach_workspace/$LOGNAME/$test_id + + if [ -e ${cesm_testdir} ]; then + if [ -n "${use_existing}" ]; then + echo " Using existing tests in ${cesm_testdir}" + else + echo "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " + echo "!! ERROR: ${cesm_testdir} already exists and << --rerun-cesm >> was not specified " + echo "!! Either remove ${cesm_testdir} or specify << --rerun-cesm >> " + echo "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " + exit 1 + fi + else + mkdir $cesm_testdir + fi + + if [ -n "${CAM_FC}" ]; then + testargs="${testargs} --xml-compiler ${CAM_FC,,}" + else + testargs="${testargs} --xml-compiler intel" + fi + testargs="${testargs} --queue ${CAM_BATCHQ} --test-root ${cesm_testdir} --output-root ${cesm_testdir}" + if [ -n "${CAM_ACCOUNT}" ]; then + testargs="${testargs} --project ${CAM_ACCOUNT}" + fi + testargs="${testargs} --test-id ${test_id}" + if [ -n "${BL_TESTDIR}" ]; then + testargs="${testargs} --compare $( basename ${BL_TESTDIR} )" + fi + if [ -n "${use_existing}" ]; then + testargs="${testargs} --use-existing" + fi + if [ -n "${archive_dir}" ]; then + testargs="${testargs} --generate ${archive_dir}" + fi + + echo "" + echo "CESM test results will be in: ${cesm_testdir}" | tee ${logfile} + echo "Running ./create_test ${testargs}" | tee -a ${logfile} + + if [ "${hostname:0:2}" == "ch" ]; then + echo "cd ${script_dir}" >> ${submit_script_cime} + echo './create_test' ${testargs} >> ${submit_script_cime} + chmod u+x ${submit_script_cime} + qsub ${submit_script_cime} + fi + + if [ "${hostname:0:6}" == "hobart" ]; then + echo "cd ${script_dir}" >> ${submit_script_cime} + echo './create_test' ${testargs} >> ${submit_script_cime} + if [ "${submit_script}" != "${submit_script_cime}" ]; then + chmod u+x ${submit_script_cime} + qsub ${submit_script_cime} + fi + fi + + done +fi + +##^^^^^^^^^^^^^^^^^^^^^^ start CAM aux test suite ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +if $run_cam_regression; then + + echo "" + echo "submitting cam regression tests..." + + case $hostname in + ##cheyenne + ch* | r* ) + qsub ${submit_script_cb} + ;; + + ##hobart + hob* | h[[:digit:]]* ) + qsub ${submit_script} + ;; + + ##leehill + le* ) + ${submit_script} + ;; + + esac + +fi + +exit 0 diff --git a/test/system/tests_carma b/test/system/tests_carma new file mode 100644 index 0000000000..5ae95fcc2a --- /dev/null +++ b/test/system/tests_carma @@ -0,0 +1,3 @@ +sm360 er360 bl360 +sm391 er391 bl391 +sm430 er430 bl430 diff --git a/test/system/tests_chem_hybrid b/test/system/tests_chem_hybrid new file mode 100644 index 0000000000..dc597ac8cb --- /dev/null +++ b/test/system/tests_chem_hybrid @@ -0,0 +1,2 @@ +sm353 br353 bl353 +sm390 br390 bl390 diff --git a/test/system/tests_chem_mpi b/test/system/tests_chem_mpi new file mode 100644 index 0000000000..e7cd5177c9 --- /dev/null +++ b/test/system/tests_chem_mpi @@ -0,0 +1,4 @@ +sm375 er375 bl375 +sm471 br471 bl471 +sm469 bl469 +sm460 er460 bl460 diff --git a/test/system/tests_pretag_cheyenne b/test/system/tests_pretag_cheyenne new file mode 100644 index 0000000000..4072746052 --- /dev/null +++ b/test/system/tests_pretag_cheyenne @@ -0,0 +1,16 @@ +sm150 er150 bl150 +sm151 er151 bl151 +sm331 er331 br331 bl331 +sm353 er353 bl353 +sm360 bl360 +sm370 bl370 +sm380 er380 bl380 +sm390 er390 bl390 +sm391 br391 bl391 +sm735 er735 bl735 +sm736 er736 bl736 +sm991 eq991 +sm994 eq994 +sm995 eq995 +sm012 bl012 +sc001 diff --git a/test/system/tests_pretag_hobart_nag b/test/system/tests_pretag_hobart_nag new file mode 100644 index 0000000000..7f4343852b --- /dev/null +++ b/test/system/tests_pretag_hobart_nag @@ -0,0 +1,24 @@ +gt001 +sm111 er111 br111 bl111 mc111 dd111 +sm113 er113 bl113 +sm221 er221 bl221 +sm311 er311 br311 bl311 mc311 eq301 eq303 eq304 +sm317 er317 bl317 +sm318 er318 bl318 +sm325 er325 bl325 eq325 +sm335 er335 bl335 +sm338 bl338 +sm367 er367 bl367 +sm368 er368 bl368 +sm369 er369 bl369 +sm426 er426 bl426 +sm430 er430 bl430 +sm471 er471 bl471 +sm700 er700 br700 bl700 +sm702 er702 br702 bl702 +sm705 eq705 +sm711 er711 bl711 eq701 eq702 eq703 +sm720 er720 bl720 +sm721 er721 bl721 +sm011 bl011 +sc003 diff --git a/test/system/tests_pretag_hobart_pgi b/test/system/tests_pretag_hobart_pgi new file mode 100644 index 0000000000..b0a3e1e4a7 --- /dev/null +++ b/test/system/tests_pretag_hobart_pgi @@ -0,0 +1,15 @@ +r8001 +sm112 er112 bl112 +sm114 er114 br114 bl114 +sm222 er222 bl222 +sm314 er314 bl314 +sm320 er320 bl320 +sm334 er334 bl334 +sm339 er339 bl339 +sm704 er704 bl704 +sm706 eq706 +sm707 er707 bl707 +sm712 er712 bl712 +sm714 eq711 eq712 eq713 +sc002 +sc004 diff --git a/test/system/tests_pretag_leehill b/test/system/tests_pretag_leehill new file mode 100644 index 0000000000..b0dedf1d75 --- /dev/null +++ b/test/system/tests_pretag_leehill @@ -0,0 +1 @@ +sc003 diff --git a/test/system/tests_waccm_hybrid b/test/system/tests_waccm_hybrid new file mode 100644 index 0000000000..ee6f463cdb --- /dev/null +++ b/test/system/tests_waccm_hybrid @@ -0,0 +1,3 @@ +sm390 br390 bl390 +sm391 er391 bl391 +sm474 er474 bl474 diff --git a/test/system/tests_waccm_mpi b/test/system/tests_waccm_mpi new file mode 100644 index 0000000000..b16f726f7c --- /dev/null +++ b/test/system/tests_waccm_mpi @@ -0,0 +1,8 @@ +sm314 er314 bl314 +sm426 er426 bl426 +sm471 er471 bl471 +sm472 er472 bl472 +sm473 er473 bl473 +sm392 er392 bl392 +sm393 er393 bl393 +sm394 er394 bl394 diff --git a/test/unit/CMakeLists.txt b/test/unit/CMakeLists.txt new file mode 100644 index 0000000000..502110f7e5 --- /dev/null +++ b/test/unit/CMakeLists.txt @@ -0,0 +1,45 @@ +cmake_minimum_required(VERSION 2.8) + +# Unit test boilerplate. +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +include(CIME_initial_setup) + +project(CAM_tests Fortran C) + +# More unit test boilerplate. +include(CIME_utils) + +# Useful paths. +set(CAMROOT ../../) +set(CESMROOT ${CAMROOT}../../) +set(SHAREROOT ${CESMROOT}/cime/src/share) + +# Add share code to source list. +include_directories(${SHAREROOT}/include ${SHAREROOT}/util) +add_subdirectory(${SHAREROOT}/util csm_share) +add_subdirectory(${SHAREROOT}/unit_test_stubs/util csm_share_stubs) + +# CAM physics. +add_subdirectory(${CAMROOT}src/physics/cam physics_cam) +add_subdirectory(${CAMROOT}src/utils utils_cam) + +# Build part of csm_share as a library. +add_library(csm_share ${share_sources}) +declare_generated_dependencies(csm_share "${share_genf90_sources}") +get_target_property(includes csm_share INCLUDE_DIRECTORIES) +if(NOT includes) + unset(includes) +endif() +list(APPEND includes "${PFUNIT_INCLUDE_DIRS}") +set_target_properties(csm_share PROPERTIES + INCLUDE_DIRECTORIES "${includes}") + +# Pick up csm_share module files. +include_directories(${CMAKE_CURRENT_BINARY_DIR}) + +# Test subdirectories. +add_subdirectory(coords_1d) +add_subdirectory(linear_1d_operators) +add_subdirectory(micro_mg_data) +add_subdirectory(micro_mg_utils) +add_subdirectory(vdiff_lu_solver) diff --git a/test/unit/README.txt b/test/unit/README.txt new file mode 100644 index 0000000000..b3417e3717 --- /dev/null +++ b/test/unit/README.txt @@ -0,0 +1,15 @@ +# To run all CAM unit tests on caldera, run the following command: +# +# Also note that, on caldera, this requires 'module load all-python-libs' +# +# The creation of a temporary directory ensures that you are doing a completely +# clean build of the unit tests. (The use of the --clean flag to run_tests.py +# cleans most, but not all of the files created by the unit test build.) For +# rerunning the tests after an incremental change, you can instead use an +# existing build directory. +# +# The specification of -DUSE_CONTIGUOUS is a workaround for https://github.com/ESMCI/cime/issues/1250 +# It can be removed once that issue is resolved + +../../../../cime/scripts/fortran_unit_testing/run_tests.py --build-dir `mktemp -d --tmpdir=. unit_tests.XXXXXXXX` --cmake-args ' -DCPPDEFS=-DUSE_CONTIGUOUS=contiguous,' + diff --git a/test/unit/coords_1d/CMakeLists.txt b/test/unit/coords_1d/CMakeLists.txt new file mode 100644 index 0000000000..b762d28b64 --- /dev/null +++ b/test/unit/coords_1d/CMakeLists.txt @@ -0,0 +1,14 @@ +# Local pFUnit files. +set(pf_sources + test_coords_1d.pf) + +# Sources to test. +set(sources_needed + coords_1d.F90) +extract_sources("${sources_needed}" "${cam_sources}" test_sources) + +# Do source preprocessing and add the executable. +create_pFUnit_test(coords_1d coords_1d_exe "${pf_sources}" + "${test_sources}") + +target_link_libraries(coords_1d_exe csm_share) diff --git a/test/unit/coords_1d/test_coords_1d.pf b/test/unit/coords_1d/test_coords_1d.pf new file mode 100644 index 0000000000..1536470197 --- /dev/null +++ b/test/unit/coords_1d/test_coords_1d.pf @@ -0,0 +1,117 @@ +module test_coords_1d + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use coords_1d, only: Coords1D + +implicit none + +integer, parameter :: n = 3 +integer, parameter :: d = 4 + +real(r8) :: ifc(n,d+1) +real(r8) :: mid(n,d) +real(r8) :: del(n,d) +real(r8) :: dst(n,d-1) + +type(Coords1D) :: coords + +contains + +@Before +subroutine setUp() + integer :: i + + do i = 1, n + ifc(i,:) = i*[0._r8, 1._r8, 3._r8, 3.5_r8, 4._r8] + mid(i,:) = i*[0.5_r8, 2._r8, 3.25_r8, 3.75_r8] + del(i,:) = i*[1._r8, 2._r8, 0.5_r8, 0.5_r8] + dst(i,:) = i*[1.5_r8, 1.25_r8, 0.5_r8] + end do + +end subroutine setUp + +@After +subroutine tearDown() + call coords%finalize() +end subroutine tearDown + +! This test just sets all the fields and checks that they were allocated +! and set correctly. +@Test +subroutine coords_1d_set_all() + + ! XLF workaround requires these temporaries. + real(r8) :: rdel(n,d), rdst(n,d-1) + + rdel = 1._r8/del + rdst = 1._r8/dst + + coords = Coords1D(ifc, mid, del, dst, rdel, rdst) + + @assertEqual(n, coords%n) + @assertEqual(d, coords%d) + @assertEqual(ifc, coords%ifc) + @assertEqual(mid, coords%mid) + @assertEqual(del, coords%del) + @assertEqual(dst, coords%dst) + @assertEqual(1._r8/del, coords%rdel) + @assertEqual(1._r8/dst, coords%rdst) + +end subroutine coords_1d_set_all + +! This test is for the constructor from an input of "int" alone. +@Test +subroutine coords_1d_set_from_int() + + coords = Coords1D(ifc) + + @assertEqual(n, coords%n) + @assertEqual(d, coords%d) + @assertEqual(ifc, coords%ifc) + @assertEqual(mid, coords%mid) + @assertEqual(del, coords%del) + @assertEqual(dst, coords%dst) + @assertEqual(1._r8/del, coords%rdel) + @assertEqual(1._r8/dst, coords%rdst) + +end subroutine coords_1d_set_from_int + +! Test creating a coords object as a section of another coords object. +@Test +subroutine coords_section() + + ! Lower and upper bounds for section. + integer :: li, ui, lj, uj + + type(Coords1D) :: sub_coords, section + + ! Bounds to use for section. + li = 2 + ui = n-1 + lj = 2 + uj = d-1 + + ! Create coords and coords subset. + coords = Coords1D(ifc) + sub_coords = Coords1D(ifc(li:ui,lj:uj+1)) + + ! Coords section. + section = coords%section([li, ui],[lj, uj]) + + ! Subset and section should be the same. + @assertEqual(sub_coords%n, section%n) + @assertEqual(sub_coords%d, section%d) + @assertEqual(sub_coords%ifc, section%ifc) + @assertEqual(sub_coords%mid, section%mid) + @assertEqual(sub_coords%del, section%del) + @assertEqual(sub_coords%dst, section%dst) + @assertEqual(sub_coords%rdel, section%rdel) + @assertEqual(sub_coords%rdst, section%rdst) + + call sub_coords%finalize() + +end subroutine coords_section + +end module test_coords_1d diff --git a/test/unit/linear_1d_operators/CMakeLists.txt b/test/unit/linear_1d_operators/CMakeLists.txt new file mode 100644 index 0000000000..3a4eb569fd --- /dev/null +++ b/test/unit/linear_1d_operators/CMakeLists.txt @@ -0,0 +1,21 @@ +# Local pFUnit files. +set(pf_sources + test_diagonal.pf test_derivatives.pf test_arithmetic.pf) + +# Sources to test. +set(sources_needed + coords_1d.F90 linear_1d_operators.F90) +extract_sources("${sources_needed}" "${cam_sources}" test_sources) + +# NOTE(wjs, 2016-04-29) The linear_1d_operators test gives segfaults with gnu +# (gfortran 5.3.0 on my Mac); for now, commenting it out. We'd like the users to +# be able to see that the test was skipped but didn't fail, but CTest has no +# mechanism for this. Instead, hack around it by adding a test that will always +# pass but is likely to stand out as a skipped test. +add_test(SKIPPED_linear_1d_operators true) + +# # Do source preprocessing and add the executable. +# create_pFUnit_test(linear_1d_operators linear_1d_operators_exe +# "${pf_sources}" "${test_sources}") + +# target_link_libraries(linear_1d_operators_exe csm_share) diff --git a/test/unit/linear_1d_operators/test_arithmetic.pf b/test/unit/linear_1d_operators/test_arithmetic.pf new file mode 100644 index 0000000000..e9bc800fe9 --- /dev/null +++ b/test/unit/linear_1d_operators/test_arithmetic.pf @@ -0,0 +1,227 @@ +module test_arithmetic + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use linear_1d_operators + +implicit none + +! Roundoff level tolerance. +real(r8), parameter :: tol = 1.e-12_r8 + +! Grid size. +integer, parameter :: nsys = 2, ncel = 4 + +! Grids: +! Uniform. +real(r8), parameter :: uniform_grid(ncel) = & + [0._r8, 1._r8, 2._r8, 3._r8] +real(r8), parameter :: uniform_spacing(ncel-1) = & + [1._r8, 1._r8, 1._r8] +! Non-uniform. +real(r8), parameter :: non_uni_grid(ncel) = & + [0._r8, 0.25_r8, 0.75_r8, 2.0_r8] +real(r8), parameter :: non_uni_spacing(ncel-1) = & + [0.25_r8, 0.5_r8, 1.25_r8] + +real(r8) :: data(nsys, ncel) + +type(TriDiagOp) :: first_deriv +type(TriDiagOp) :: second_deriv +type(TriDiagOp) :: test_op + +contains + +@Before +subroutine setUp() + real(r8) :: spacings(nsys, ncel-1) + ! Quadratic test data. + data(1,:) = non_uni_grid * non_uni_grid + data(2,:) = uniform_grid * uniform_grid + + spacings(1,:) = non_uni_spacing + spacings(2,:) = uniform_spacing + + first_deriv = first_derivative(spacings, & + l_bndry=BoundaryExtrapolate(), r_bndry=BoundaryExtrapolate()) + second_deriv = second_derivative(spacings, & + l_bndry=BoundaryExtrapolate(), r_bndry=BoundaryExtrapolate()) +end subroutine setUp + +@After +subroutine tearDown() + call first_deriv%finalize() + call second_deriv%finalize() + call test_op%finalize() +end subroutine tearDown + +! Check that two linear operators can be summed. This uses the distributive +! property. +@Test +subroutine adding_ops_gives_sum() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The expected result on data. + expected = first_deriv%apply(data) + expected = expected + second_deriv%apply(data) + + ! Combined operator. + test_op = first_deriv + second_deriv + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine adding_ops_gives_sum + +! Check that two linear operators can be subtracted. +@Test +subroutine subtracting_ops_gives_difference() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The expected result on data. + expected = first_deriv%apply(data) + expected = second_deriv%apply(data) - expected + + ! Combined operator. + test_op = second_deriv - first_deriv + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine subtracting_ops_gives_difference + +! Check that two linear operators can be summed. This uses the distributive +! property. +@Test +subroutine adding_ops_in_place_gives_sum() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + expected = first_deriv%apply(data) + expected = expected + second_deriv%apply(data) + + ! Combined operator. + test_op = second_deriv + call test_op%add(first_deriv) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine adding_ops_in_place_gives_sum + +! Check that two linear operators can be subtracted. +@Test +subroutine subtracting_ops_in_place() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + expected = first_deriv%apply(data) + expected = second_deriv%apply(data) - expected + + ! Combined operator. + test_op = second_deriv + call test_op%subtract(first_deriv) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine subtracting_ops_in_place + +! Can add a scalar to diagonal, equivalent to adding a multiple of the +! identity. +@Test +subroutine add_scalar_to_diag() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + test_op = first_deriv + expected = data + test_op%apply(data) + + ! Add in data to operator. + call test_op%add_to_diag(1._r8) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine add_scalar_to_diag + +! Adding data to an operator's diagonal is the same as adding a diagonal +! operator. +@Test +subroutine add_to_diag_gives_sum() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + test_op = first_deriv + expected = data*data + test_op%apply(data) + + ! Add in data to operator. + call test_op%add_to_diag(data) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine add_to_diag_gives_sum + +! Can multiply an operator by a scalar. +@Test +subroutine scalar_multiplies_diag() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + test_op = first_deriv + expected = 2._r8 * test_op%apply(data) + + ! Add in data to operator. + call test_op%lmult_as_diag(2._r8) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine scalar_multiplies_diag + +! Test that we can construct the operator (f * derivative), where f is a +! scalar function. The test checks using associativity: +! (f * derivative) x = f * (derivative x) +@Test +subroutine diagonal_multiplies_operator() + + real(r8) :: output(nsys,ncel) + real(r8) :: expected(nsys,ncel) + + ! The derivative and expected result on data. + test_op = first_deriv + expected = data * test_op%apply(data) + + ! Now do the scaling and see if we get the same output. + call test_op%lmult_as_diag(data) + output = test_op%apply(data) + + ! The two should match up to roundoff. + @assertEqual(expected, output, tolerance=tol) + +end subroutine diagonal_multiplies_operator + +end module test_arithmetic diff --git a/test/unit/linear_1d_operators/test_derivatives.pf b/test/unit/linear_1d_operators/test_derivatives.pf new file mode 100644 index 0000000000..53adae4441 --- /dev/null +++ b/test/unit/linear_1d_operators/test_derivatives.pf @@ -0,0 +1,579 @@ +! +! Tests for derivative operators. +! +! This gets complex because of these combinatorics: +! +! Three grids: Uniform spacing, non-uniform spacing, and different spacings +! in different columns. +! Three functions: Linear, quadratic, and different for different columns. +! Two operators: First and second derivative +! Several cases: One for interior points, one for each type of boundary +! condition. +! +! The "cases" are each a different test. The grids, functions, and +! operators are fed in as parameters to those tests. Thus each test is run +! 18 times. +! +! The upshot is high test specificity. +! +module test_derivatives + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use linear_1d_operators + +implicit none + +! Roundoff level tolerance. +real(r8), parameter :: tol = 1.e-15_r8 + +type :: LabeledGrid + character(len=32) :: name = "" + real(r8), allocatable :: coords(:,:) +end type LabeledGrid + +! This type contained a procedure pointer to the constructor. However, due +! to an Intel compiler bug, this had to be replaced with a simpler, "enum" +! method of picking a constructor. +type :: LabeledDerivConstructor + character(len=32) :: name = "" + integer :: constructor_enum = 0 +! procedure(first_derivative), pointer, nopass :: constructor => null() +end type LabeledDerivConstructor + +type :: FunctionSet + character(len=32) :: name = "" + procedure(r8_to_r8), pointer, nopass :: f => null() + procedure(r8_to_r8), pointer, nopass :: d_f => null() + procedure(r8_to_r8), pointer, nopass :: d2_f => null() +end type FunctionSet + +abstract interface + function r8_to_r8(x) result(y) + import :: r8 + real(r8), intent(in) :: x + real(r8) :: y + end function r8_to_r8 +end interface + +@TestParameter +type, extends(AbstractTestParameter) :: DerivTestParams + character(len=32) :: function_string = "" + type(LabeledDerivConstructor) :: deriv + type(LabeledGrid) :: grid + real(r8), allocatable :: data(:,:) + real(r8), allocatable :: expected(:,:) + real(r8), allocatable :: expected_1st_order_bndry(:,:) + real(r8), allocatable :: expected_barrier_bndry(:,:) + contains + procedure, pass(this) :: toString +end type DerivTestParams + +@TestCase(testParameters={getParameters()}, constructor=new_DerivTestCase) +type, extends(ParameterizedTestCase) :: DerivTestCase + procedure(first_derivative), pointer, nopass :: deriv_constructor => null() + real(r8), allocatable :: grid_spacing(:,:) + real(r8), allocatable :: data(:,:) + real(r8), allocatable :: expected(:,:) + real(r8), allocatable :: expected_1st_order_bndry(:,:) + real(r8), allocatable :: expected_barrier_bndry(:,:) +end type DerivTestCase + +interface DerivTestParams + module procedure new_DerivTestParams +end interface + +! Enumeration of derivatives. +integer, parameter :: first_d = 1 +integer, parameter :: second_d = 2 + +contains + +function new_DerivTestCase(test_params) result(test) + type(DerivTestParams), intent(in) :: test_params + type(DerivTestCase) :: test + + select case(test_params%deriv%constructor_enum) + case(first_d) + test%deriv_constructor => first_derivative + case(second_d) + test%deriv_constructor => second_derivative + case default + call throw("Unrecognized derivative operator index.") + end select + test%grid_spacing = test_params%grid%coords(:,2:) - & + test_params%grid%coords(:,:size(test_params%grid%coords, 2)-1) + test%data = test_params%data + test%expected = test_params%expected + test%expected_1st_order_bndry = test_params%expected_1st_order_bndry + test%expected_barrier_bndry = test_params%expected_barrier_bndry + +end function new_DerivTestCase + +function toString(this) result(string) + class(DerivTestParams), intent(in) :: this + character(:), allocatable :: string + + character(len=256) :: buffer + + write(buffer,*) "(Operator: ", trim(this%deriv%name), & + ", Grid: ", trim(this%grid%name), & + ", Data: ", trim(this%function_string), ")" + + string = trim(buffer) + +end function toString + +function identity(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = x +end function identity + +function one(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = 1._r8 +end function one + +function zero(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = 0._r8 +end function zero + +function square(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = x*x +end function square + +function two_x(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = 2._r8*x +end function two_x + +function two(x) result(y) + real(r8), intent(in) :: x + real(r8) :: y + y = 2._r8 +end function two + +function new_DerivTestParams(func_set, grid, deriv) result(params) + type(FunctionSet), intent(in) :: func_set(:) + type(LabeledGrid), intent(in) :: grid + integer, intent(in) :: deriv + type(DerivTestParams) :: params + + character(len=32) :: function_string + + integer :: i, k + integer :: ncol, nlev + + ncol = size(grid%coords, 1) + nlev = size(grid%coords, 2) + + if (all(func_set(2:)%name == func_set(1)%name)) then + function_string = func_set(1)%name + else + function_string = "mixed data" + end if + + params%function_string = function_string + params%grid = grid + + ! Set procedure component separately to deal with Intel bug. + select case (deriv) + case(first_d) + params%deriv = & + LabeledDerivConstructor("First derivative")!, first_derivative) + case(second_d) + params%deriv = & + LabeledDerivConstructor("Second derivative")!, second_derivative) + case default + ! We throw to get pFUnit to recognize this, but in fact it doesn't + ! work, because pFUnit doesn't check the exception stack at the right + ! time. + call throw("Unrecognized derivative operator index.") + return + end select + + params%deriv%constructor_enum = deriv + + allocate(params%data(ncol,nlev), params%expected(ncol,nlev), & + params%expected_1st_order_bndry(ncol,2), & + params%expected_barrier_bndry(ncol,2)) + + do k = 1, nlev + do i = 1, ncol + params%data(i,k) = func_set(i)%f(grid%coords(i,k)) + end do + end do + + select case (deriv) + case(first_d) + do k = 1, nlev + do i = 1, ncol + params%expected(i,k) = func_set(i)%d_f(grid%coords(i,k)) + end do + end do + ! First order approximation to boundary condition. + params%expected_1st_order_bndry(:,1) = & + (params%data(:,2)-params%data(:,1)) / & + (grid%coords(:,2)-grid%coords(:,1)) + params%expected_1st_order_bndry(:,2) = & + (params%data(:,nlev)-params%data(:,nlev-1)) / & + (grid%coords(:,nlev)-grid%coords(:,nlev-1)) + ! With a barrier present, the first order approximation is "averaged" + ! with derivative 0 on the other side of the boundary. + params%expected_barrier_bndry = & + params%expected_1st_order_bndry/2._r8 + case(second_d) + do k = 1, nlev + do i = 1, ncol + params%expected(i,k) = func_set(i)%d2_f(grid%coords(i,k)) + end do + end do + params%expected_1st_order_bndry = 0._r8 + ! Approximation combining 1st order first derivative with an effective + ! derivative of 0 inside the barrier. + params%expected_barrier_bndry(:,1) = & + (params%data(:,2)-params%data(:,1)) / & + (grid%coords(:,2)-grid%coords(:,1))**2 + params%expected_barrier_bndry(:,2) = & + (params%data(:,nlev-1)-params%data(:,nlev)) / & + (grid%coords(:,nlev)-grid%coords(:,nlev-1))**2 + case default + call throw("Unrecognized derivative operator index.") + return + end select + +end function new_DerivTestParams + +function getParameters() result(params) + type(DerivTestParams), allocatable :: params(:) + + ! Grid size. + integer, parameter :: nlev = 5 + + ! Grids: + ! Uniform. + real(r8), parameter :: uniform(nlev) = & + [0._r8, 1._r8, 2._r8, 3._r8, 4._r8] + ! Non-uniform. + real(r8), parameter :: non_uni(nlev) = & + [0._r8, 0.25_r8, 0.75_r8, 2.0_r8, 3._r8] + + real(r8) :: uniform_coords(2,nlev) + real(r8) :: non_uni_coords(2,nlev) + real(r8) :: mixed_coords(2,nlev) + type(LabeledGrid) :: uniform_grid + type(LabeledGrid) :: non_uni_grid + type(LabeledGrid) :: mixed_grid + + type(FunctionSet) :: y_equals_x + type(FunctionSet) :: y_equals_x_squared + + uniform_coords = spread(uniform, 1, 2) + non_uni_coords = spread(non_uni, 1, 2) + mixed_coords(1,:) = uniform + mixed_coords(2,:) = non_uni + + uniform_grid = LabeledGrid("Uniform", uniform_coords) + non_uni_grid = LabeledGrid("Non-Uniform", non_uni_coords) + mixed_grid = LabeledGrid("Mixed", mixed_coords) + + ! Set procedure components separately to deal with Intel bug. + y_equals_x = & + FunctionSet("f = x")!, identity, one, zero) + y_equals_x%f => identity + y_equals_x%d_f => one + y_equals_x%d2_f => zero + + y_equals_x_squared = & + FunctionSet("f = x^2")!, square, two_x, two) + y_equals_x_squared%f => square + y_equals_x_squared%d_f => two_x + y_equals_x_squared%d2_f => two + + params = [ & + DerivTestParams(spread(y_equals_x, 1, 2), & + uniform_grid, first_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + uniform_grid, first_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + uniform_grid, first_d), & + DerivTestParams(spread(y_equals_x, 1, 2), & + non_uni_grid, first_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + non_uni_grid, first_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + non_uni_grid, first_d), & + DerivTestParams(spread(y_equals_x, 1, 2), & + mixed_grid, first_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + mixed_grid, first_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + mixed_grid, first_d), & + DerivTestParams(spread(y_equals_x, 1, 2), & + uniform_grid, second_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + uniform_grid, second_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + uniform_grid, second_d), & + DerivTestParams(spread(y_equals_x, 1, 2), & + non_uni_grid, second_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + non_uni_grid, second_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + non_uni_grid, second_d), & + DerivTestParams(spread(y_equals_x, 1, 2), & + mixed_grid, second_d), & + DerivTestParams(spread(y_equals_x_squared, 1, 2), & + mixed_grid, second_d), & + DerivTestParams([y_equals_x, y_equals_x_squared], & + mixed_grid, second_d) & + ] + +end function getParameters + +! This routine checks the interior points only; edges are checked in the +! "bndry" tests below. +@test +subroutine test_interior(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(this%expected(:,2:nlev-1), output(:,2:nlev-1), tolerance=tol) + end associate + +end subroutine test_interior + +@test +subroutine test_bndry_zero(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, BoundaryZero(), & + BoundaryZero()) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(0._r8, output(:,1)) + @assertEqual(0._r8, output(:,nlev)) + end associate + +end subroutine test_bndry_zero + +@test +subroutine test_bndry_1st_order(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryFirstOrder(), BoundaryFirstOrder()) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(this%expected_1st_order_bndry(:,1), output(:,1), tolerance=tol) + @assertEqual(this%expected_1st_order_bndry(:,2), output(:,nlev), tolerance=tol) + end associate + +end subroutine test_bndry_1st_order + +@test +subroutine test_bndry_extrap(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryExtrapolate(), BoundaryExtrapolate()) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(this%expected(:,1), output(:,1), tolerance=tol) + @assertEqual(this%expected(:,nlev), output(:,nlev), tolerance=tol) + end associate + +end subroutine test_bndry_extrap + +! Unlike the above boundary conditions, this test needs an extra buffer +! layer on each side. Therefore, we only run on the interior points, and +! the tested "boundary" points in this case are at 2 and nlev-2. +@test +subroutine test_bndry_fixed_layer(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),2:size(this%data, 2)-1) + + type(TriDiagOp) :: deriv_op + type(BoundaryType) :: left_boundary, right_boundary + type(BoundaryCond) :: left_data, right_data + + integer :: nlev + + nlev = size(this%data, 2) + + ! Specify fixed layer boundary conditions. + left_boundary = BoundaryFixedLayer(this%grid_spacing(:,1)) + right_boundary = BoundaryFixedLayer(this%grid_spacing(:,nlev-1)) + + ! The derivative from the SUT. + ! We only actually run this on the interior points. This means that. + deriv_op = this%deriv_constructor(this%grid_spacing(:,2:nlev-2), & + left_boundary, right_boundary) + + ! Apply boundary condition. + left_data = BoundaryData(this%data(:,1)) + right_data = BoundaryData(this%data(:,nlev)) + output = deriv_op%apply(this%data(:,2:nlev-1), & + left_data, right_data) + + @assertEqual(this%expected(:,2), output(:,2), tolerance=tol) + @assertEqual(this%expected(:,nlev-1), output(:,nlev-1), tolerance=tol) + +end subroutine test_bndry_fixed_layer + +! Consider a "barrier" condition to simply be equivalent to a fixed flux +! of 0 (which is the default if none specified). +@test +subroutine test_bndry_barrier(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryFixedFlux(), BoundaryFixedFlux()) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(this%expected_barrier_bndry(:,1), output(:,1), tolerance=tol) + @assertEqual(this%expected_barrier_bndry(:,2), output(:,nlev), tolerance=tol) + end associate + +end subroutine test_bndry_barrier + +! Using BoundaryFixedFlux with BoundaryFlux is the same as using +! BoundaryFixedFlux with no data, then adding in the change. This is one +! of those unfortunate situations where you can't easily make a test for +! the code that's much simpler than the SUT. +@test +subroutine test_bndry_fixed_flux(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + real(r8) :: no_flux(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + type(BoundaryCond) :: left_flux, right_flux + + integer :: nlev + + nlev = size(this%data, 2) + + ! Just use fluxes that add in half the original values. + left_flux = BoundaryFlux(this%data(:,1), 0.5_r8, & + this%grid_spacing(:,1)) + right_flux = BoundaryFlux(this%data(:,nlev), 0.5_r8, & + this%grid_spacing(:,nlev-1)) + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryFixedFlux(), BoundaryFixedFlux()) + no_flux = deriv_op%apply(this%data) + output = deriv_op%apply(this%data, left_flux, right_flux) + + @assertEqual(0.5*this%data(:,1)+no_flux(:,1), output(:,1), tolerance=tol) + @assertEqual(0.5*this%data(:,nlev)+no_flux(:,nlev), output(:,nlev), tolerance=tol) + +end subroutine test_bndry_fixed_flux + +! Identical to the fixed flux test, only now we don't explicitly specify +! the boundary condition, while expecting to get the same answer anyway. +@test +subroutine test_bndry_fixed_flux_is_default(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + real(r8) :: no_flux(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + type(BoundaryCond) :: left_flux, right_flux + + integer :: nlev + + nlev = size(this%data, 2) + + ! Just use fluxes that add in half the original values. + left_flux = BoundaryFlux(this%data(:,1), 0.5_r8, & + this%grid_spacing(:,1)) + right_flux = BoundaryFlux(this%data(:,nlev), 0.5_r8, & + this%grid_spacing(:,nlev-1)) + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryFixedFlux(), BoundaryFixedFlux()) + no_flux = deriv_op%apply(this%data) + output = deriv_op%apply(this%data, left_flux, right_flux) + + @assertEqual(0.5*this%data(:,1)+no_flux(:,1), output(:,1), tolerance=tol) + @assertEqual(0.5*this%data(:,nlev)+no_flux(:,nlev), output(:,nlev), tolerance=tol) + +end subroutine test_bndry_fixed_flux_is_default + +! Test the case where one boundary condition differs from the other. +@test +subroutine test_bndry_left_differs_from_right(this) + + class(DerivTestCase), intent(inout) :: this + + real(r8) :: output(size(this%data, 1),size(this%data, 2)) + + type(TriDiagOp) :: deriv_op + + ! The derivative from the SUT. + deriv_op = this%deriv_constructor(this%grid_spacing, & + BoundaryZero(), BoundaryExtrapolate()) + output = deriv_op%apply(this%data) + + associate( nlev => size(output, 2) ) + @assertEqual(0._r8, output(:,1), tolerance=tol) + @assertEqual(this%expected(:,nlev), output(:,nlev), tolerance=tol) + end associate + +end subroutine test_bndry_left_differs_from_right + +end module test_derivatives diff --git a/test/unit/linear_1d_operators/test_diagonal.pf b/test/unit/linear_1d_operators/test_diagonal.pf new file mode 100644 index 0000000000..f75ba1d70b --- /dev/null +++ b/test/unit/linear_1d_operators/test_diagonal.pf @@ -0,0 +1,76 @@ +module test_diagonal + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use linear_1d_operators + +implicit none + +integer, parameter :: nlev = 4 + +real(r8), parameter :: vec1(nlev) = [1._r8, 2._r8, 3._r8, 4._r8] +real(r8), parameter :: vec2(nlev) = [2._r8, 3._r8, 4._r8, 5._r8] +real(r8), parameter :: vec3(nlev) = [3._r8, 4._r8, 5._r8, 6._r8] + +contains + +! Data is cleared by the zero operator. +@Test +subroutine zero_operator_gives_zero() + + real(r8) :: data(1,nlev), output(1,nlev) + + type(TriDiagOp) :: zero + + data(1,:) = vec1 + + zero = zero_operator(1, nlev) + output = zero%apply(data) + + data = 0._r8 + + @assertEqual(data, output) + +end subroutine zero_operator_gives_zero + +! Data is still the same after being operated on by the identity operator. +@Test +subroutine identity_does_nothing() + + real(r8) :: data(1,nlev), output(1,nlev) + + type(TriDiagOp) :: identity + + data(1,:) = vec1 + + identity = identity_operator(1, nlev) + output = identity%apply(data) + + @assertEqual(data, output) + +end subroutine identity_does_nothing + +! Making an array into an operator and then applying it is the same as +! multiplying the two arrays. +@Test +subroutine diagonal_op_is_product() + + real(r8) :: operator_entries(2,nlev), data(2,nlev), output(2,nlev) + + type(TriDiagOp) :: diag_op + + operator_entries(1,:) = vec1 + operator_entries(2,:) = vec2 + + data(1,:) = vec3 + data(2,:) = vec1 + + diag_op = diagonal_operator(operator_entries) + output = diag_op%apply(data) + + @assertEqual(operator_entries*data, output) + +end subroutine diagonal_op_is_product + +end module test_diagonal diff --git a/test/unit/micro_mg_data/CMakeLists.txt b/test/unit/micro_mg_data/CMakeLists.txt new file mode 100644 index 0000000000..e5c5615b1b --- /dev/null +++ b/test/unit/micro_mg_data/CMakeLists.txt @@ -0,0 +1,14 @@ +# Local pFUnit files. +set(pf_sources + test_MGPacker.pf test_MGFieldPostProc.pf test_MGPostProc.pf) + +# Sources to test. +set(sources_needed + micro_mg_data.F90) +extract_sources("${sources_needed}" "${cam_sources}" test_sources) + +# Do source preprocessing and add the executable. +create_pFUnit_test(micro_mg_data micro_mg_data_exe "${pf_sources}" + "${test_sources}") + +target_link_libraries(micro_mg_data_exe csm_share) diff --git a/test/unit/micro_mg_data/test_MGFieldPostProc.pf b/test/unit/micro_mg_data/test_MGFieldPostProc.pf new file mode 100644 index 0000000000..103bde80c6 --- /dev/null +++ b/test/unit/micro_mg_data/test_MGFieldPostProc.pf @@ -0,0 +1,308 @@ +module test_MGFieldPostProc + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use micro_mg_data, only: MGFieldPostProc, accum_null, accum_mean, & + MGPacker + +implicit none + +integer, parameter :: pcols = 4, pver = 3, dim_t = 2 + +! Just for convenience, tests will all pack with these settings. +integer, parameter :: mgncol = 2 +integer, parameter :: nlev = 2 +integer, parameter :: mgcols(mgncol) = [1, 3] +integer, parameter :: top_lev = 2 +real(r8), parameter :: fillvalue = -1._r8 + +type(MGPacker) :: packer + +! Packed test data for the two time steps. +real(r8) :: test_ref(mgncol, nlev, dim_t) +real(r8) :: test_ref_mean(mgncol, nlev) + +type(MGFieldPostProc), allocatable :: field_proc + +contains + +@Before +subroutine setUp() + integer :: i, k, m + + do m = 1, dim_t + do k = 1, nlev + do i = 1, mgncol + test_ref(i,k,m) = i + 10._r8*k + 100._r8*m + end do + end do + end do + + test_ref_mean = sum(test_ref, dim=3)/dim_t + + packer = MGPacker(pcols, pver, mgcols, top_lev) + +end subroutine setUp + +@After +subroutine tearDown() + + if (allocated(field_proc)) then + call field_proc%finalize() + deallocate(field_proc) + end if + + call packer%finalize() + +end subroutine tearDown + +@Test +subroutine MGFieldPostProc_accum_null_1D() + real(r8), target :: unpacked_data(pcols) + real(r8), target :: packed_data(mgncol) + real(r8), pointer :: unpacked_ptr(:) + real(r8), pointer :: packed_ptr(:) + + real(r8) :: expected_data(pcols) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_null) + + packed_data = test_ref(:,1,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,1,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref(:,1,2), fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_null_1D + +@Test +subroutine MGFieldPostProc_accum_null_2D() + real(r8), target :: unpacked_data(pcols,pver) + real(r8), target :: packed_data(mgncol,nlev) + real(r8), pointer :: unpacked_ptr(:,:) + real(r8), pointer :: packed_ptr(:,:) + + real(r8) :: expected_data(pcols,pver) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_null) + + packed_data = test_ref(:,:,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,:,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref(:,:,2), fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_null_2D + +@Test +subroutine MGFieldPostProc_accum_mean_1D() + real(r8), target :: unpacked_data(pcols) + real(r8), target :: packed_data(mgncol) + real(r8), pointer :: unpacked_ptr(:) + real(r8), pointer :: packed_ptr(:) + + real(r8) :: expected_data(pcols) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_mean) + + packed_data = test_ref(:,1,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,1,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref_mean(:,1), fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_mean_1D + +@Test +subroutine MGFieldPostProc_accum_mean_2D() + real(r8), target :: unpacked_data(pcols,pver) + real(r8), target :: packed_data(mgncol,nlev) + real(r8), pointer :: unpacked_ptr(:,:) + real(r8), pointer :: packed_ptr(:,:) + + real(r8) :: expected_data(pcols,pver) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_mean) + + packed_data = test_ref(:,:,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,:,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref_mean, fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_mean_2D + +! Checks that the defaults are equivalent to a fillvalue of 0 and +! a method of accum_mean. +@Test +subroutine MGFieldPostProc_accum_defaults_1D() + real(r8), target :: unpacked_data(pcols) + real(r8), target :: packed_data(mgncol) + real(r8), pointer :: unpacked_ptr(:) + real(r8), pointer :: packed_ptr(:) + + real(r8) :: expected_data(pcols) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = MGFieldPostProc(unpacked_ptr, packed_ptr) + + packed_data = test_ref(:,1,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,1,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref_mean(:,1), 0._r8) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_defaults_1D + +@Test +subroutine MGFieldPostProc_accum_defaults_2D() + real(r8), target :: unpacked_data(pcols,pver) + real(r8), target :: packed_data(mgncol,nlev) + real(r8), pointer :: unpacked_ptr(:,:) + real(r8), pointer :: packed_ptr(:,:) + + real(r8) :: expected_data(pcols,pver) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = MGFieldPostProc(unpacked_ptr, packed_ptr) + + packed_data = test_ref(:,:,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,:,2) + + call field_proc%accumulate() + + call field_proc%process_and_unpack(packer) + + expected_data = packer%unpack(test_ref_mean, 0._r8) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_accum_defaults_2D + +@Test +subroutine MGFieldPostProc_unpack_only_1D() + real(r8), target :: unpacked_data(pcols) + real(r8), target :: packed_data(mgncol) + real(r8), pointer :: unpacked_ptr(:) + real(r8), pointer :: packed_ptr(:) + + real(r8) :: expected_data(pcols) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_mean) + + packed_data = test_ref(:,1,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,1,2) + + call field_proc%accumulate() + + call field_proc%unpack_only(packer) + + expected_data = packer%unpack(test_ref(:,1,2), fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_unpack_only_1D + +@Test +subroutine MGFieldPostProc_unpack_only_2D() + real(r8), target :: unpacked_data(pcols,pver) + real(r8), target :: packed_data(mgncol,nlev) + real(r8), pointer :: unpacked_ptr(:,:) + real(r8), pointer :: packed_ptr(:,:) + + real(r8) :: expected_data(pcols,pver) + + unpacked_ptr => unpacked_data + packed_ptr => packed_data + + field_proc = & + MGFieldPostProc(unpacked_ptr, packed_ptr, fillvalue, accum_mean) + + packed_data = test_ref(:,:,1) + + call field_proc%accumulate() + + packed_data = test_ref(:,:,2) + + call field_proc%accumulate() + + call field_proc%unpack_only(packer) + + expected_data = packer%unpack(test_ref(:,:,2), fillvalue) + + @assertEqual(expected_data, unpacked_data) + +end subroutine MGFieldPostProc_unpack_only_2D + +end module test_MGFieldPostProc diff --git a/test/unit/micro_mg_data/test_MGPacker.pf b/test/unit/micro_mg_data/test_MGPacker.pf new file mode 100644 index 0000000000..a82d060b75 --- /dev/null +++ b/test/unit/micro_mg_data/test_MGPacker.pf @@ -0,0 +1,387 @@ +module test_MGPacker + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use micro_mg_data, only: MGPacker + +implicit none + +integer, parameter :: pcols = 4, pver = 3 + +real(r8) :: test_data(pcols, pver) +real(r8) :: test_data_interface(pcols, pver+1) + +! Just for convenience, tests will all pack with these settings. +integer, parameter :: mgncol = 2 +integer, parameter :: nlev = 2 +integer, parameter :: mgcols(mgncol) = [1, 3] +integer, parameter :: top_lev = 2 + +type(MGPacker) :: packer + +contains + +@Before +subroutine setUp() + + integer :: i, k + + do k = 1, pver+1 + do i = 1, pcols + test_data_interface(i,k) = 10._r8*k + i + end do + end do + + test_data = test_data_interface(:,:pver) + + packer = MGPacker(pcols, pver, mgcols, top_lev) + +end subroutine setUp + +@After +subroutine tearDown() + call packer%finalize() +end subroutine tearDown + +@Test +subroutine MGPacker_packs_1D() + + real(r8) :: packed(mgncol) + + integer :: i + + packed = packer%pack(test_data(:,1)) + + ! Result should be test_data for level 1 and each of the MG columns. + @assertEqual([(test_data(mgcols(i), 1), i = 1, mgncol)], packed) + +end subroutine MGPacker_packs_1D + +@Test +subroutine MGPacker_unpacks_1D() + + real(r8) :: packed(mgncol) + real(r8) :: unpacked(pcols) + real(r8) :: expected(pcols) + + integer :: i + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_data(:,1)) + + ! This should yield 2*test_data at the packed points and 0 elsewhere. + unpacked = packer%unpack(packed, 0._r8) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do i = 1, pcols + if (any(i == mgcols)) then + expected(i) = 2._r8 * test_data(i,1) + else + expected(i) = 0._r8 + end if + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_1D + +@Test +subroutine MGPacker_unpacks_1D_array_fill() + + real(r8) :: packed(mgncol) + real(r8) :: unpacked(pcols) + real(r8) :: expected(pcols) + + integer :: i + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_data(:,1)) + + ! This should yield 2*test_data at the packed points and test_data + ! elsewhere. + unpacked = packer%unpack(packed, test_data(:,1)) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do i = 1, pcols + if (any(i == mgcols)) then + expected(i) = 2._r8 * test_data(i,1) + else + expected(i) = test_data(i,1) + end if + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_1D_array_fill + +@Test +subroutine MGPacker_packs_2D() + + real(r8) :: packed(mgncol,nlev) + real(r8) :: expected(mgncol,nlev) + + integer :: i, k + + packed = packer%pack(test_data) + + do k = 1, nlev + expected(:,k) = & + [(test_data(mgcols(i), k+top_lev-1), i = 1, mgncol)] + end do + + @assertEqual(expected, packed) + +end subroutine MGPacker_packs_2D + +@Test +subroutine MGPacker_unpacks_2D() + + real(r8) :: packed(mgncol,nlev) + real(r8) :: unpacked(pcols,pver) + real(r8) :: expected(pcols,pver) + + integer :: i, k + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_data) + + ! This should yield 2*test_data at the packed points and 0 elsewhere. + unpacked = packer%unpack(packed, 0._r8) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k) = 2._r8 * test_data(i,k) + else + expected(i,k) = 0._r8 + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_2D + +@Test +subroutine MGPacker_unpacks_2D_array_fill() + + real(r8) :: packed(mgncol,nlev) + real(r8) :: unpacked(pcols,pver) + real(r8) :: expected(pcols,pver) + + integer :: i, k + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_data) + + ! This should yield 2*test_data at the packed points and test_data + ! elsewhere. + unpacked = packer%unpack(packed, test_data) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k) = 2._r8 * test_data(i,k) + else + expected(i,k) = test_data(i,k) + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_2D_array_fill + +@Test +subroutine MGPacker_packs_2D_interface() + + real(r8) :: packed(mgncol,nlev+1) + real(r8) :: expected(mgncol,nlev+1) + + integer :: i, k + + packed = packer%pack_interface(test_data_interface) + + do k = 1, nlev+1 + expected(:,k) = & + [(test_data_interface(mgcols(i), k+top_lev-1), i = 1, mgncol)] + end do + + @assertEqual(expected, packed) + +end subroutine MGPacker_packs_2D_interface + +@Test +subroutine MGPacker_unpacks_2D_interface() + + real(r8) :: packed(mgncol,nlev+1) + real(r8) :: unpacked(pcols,pver+1) + real(r8) :: expected(pcols,pver+1) + + integer :: i, k + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack_interface(test_data_interface) + + ! This should yield 2*test_data at the packed points and 0 elsewhere. + unpacked = packer%unpack(packed, 0._r8) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver+1 + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k) = 2._r8 * test_data_interface(i,k) + else + expected(i,k) = 0._r8 + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_2D_interface + +@Test +subroutine MGPacker_unpacks_2D_ifc_array_fill() + + real(r8) :: packed(mgncol,nlev+1) + real(r8) :: unpacked(pcols,pver+1) + real(r8) :: expected(pcols,pver+1) + + integer :: i, k + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack_interface(test_data_interface) + + ! This should yield 2*test_data at the packed points and test_data + ! elsewhere. + unpacked = packer%unpack(packed, test_data_interface) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver+1 + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k) = 2._r8 * test_data_interface(i,k) + else + expected(i,k) = test_data_interface(i,k) + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_2D_ifc_array_fill + +@Test +subroutine MGPacker_packs_3D() + + real(r8) :: test_3D(pcols,pver,2) + real(r8) :: packed(mgncol,nlev,2) + real(r8) :: expected(mgncol,nlev,2) + + integer :: i, k + + test_3D(:,:,1) = test_data + test_3D(:,:,2) = -test_data + + packed = packer%pack(test_3D) + + do k = 1, nlev + expected(:,k,1) = & + [(test_3D(mgcols(i), k+top_lev-1,1), i = 1, mgncol)] + expected(:,k,2) = & + [(test_3D(mgcols(i), k+top_lev-1,2), i = 1, mgncol)] + end do + + @assertEqual(expected, packed) + +end subroutine MGPacker_packs_3D + +@Test +subroutine MGPacker_unpacks_3D() + + real(r8) :: test_3D(pcols,pver,2) + real(r8) :: packed(mgncol,nlev,2) + real(r8) :: unpacked(pcols,pver,2) + real(r8) :: expected(pcols,pver,2) + + integer :: i, k + + test_3D(:,:,1) = test_data + test_3D(:,:,2) = -test_data + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_3D) + + ! This should yield 2*test_data at the packed points and 0 elsewhere. + unpacked = packer%unpack(packed, 0._r8) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k,:) = 2._r8 * test_3D(i,k,:) + else + expected(i,k,:) = 0._r8 + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_3D + +@Test +subroutine MGPacker_unpacks_3D_array_fill() + + real(r8) :: test_3D(pcols,pver,2) + real(r8) :: packed(mgncol,nlev,2) + real(r8) :: unpacked(pcols,pver,2) + real(r8) :: expected(pcols,pver,2) + + integer :: i, k + + test_3D(:,:,1) = test_data + test_3D(:,:,2) = -test_data + + ! Double the packed data so that we can tell that the unpacking did + ! something. + packed = 2._r8*packer%pack(test_3D) + + ! This should yield 2*test_data at the packed points and 0 elsewhere. + unpacked = packer%unpack(packed, test_3D) + + ! Explicitly create an array matching the previous comment for + ! comparison. + do k = 1, pver + do i = 1, pcols + if (k >= top_lev .and. any(i == mgcols)) then + expected(i,k,:) = 2._r8 * test_3D(i,k,:) + else + expected(i,k,:) = test_3D(i,k,:) + end if + end do + end do + + @assertEqual(expected, unpacked) + +end subroutine MGPacker_unpacks_3D_array_fill + +end module test_MGPacker diff --git a/test/unit/micro_mg_data/test_MGPostProc.pf b/test/unit/micro_mg_data/test_MGPostProc.pf new file mode 100644 index 0000000000..67800d3ca7 --- /dev/null +++ b/test/unit/micro_mg_data/test_MGPostProc.pf @@ -0,0 +1,147 @@ +module test_MGPostProc + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use micro_mg_data, only: MGPacker, accum_null, accum_mean, MGPostProc + +implicit none + +integer, parameter :: pcols = 4, pver = 3, dim_t = 2 + +! Just for convenience, tests will all pack with these settings. +integer, parameter :: mgncol = 2 +integer, parameter :: nlev = 2 +integer, parameter :: mgcols(mgncol) = [1, 3] +integer, parameter :: top_lev = 2 +real(r8), parameter :: fillvalue = -1._r8 + +type(MGPacker) :: packer +type(MGPostProc) :: post_proc + +! Packed test data for the two time steps. +real(r8) :: test_ref(mgncol, nlev, dim_t) +real(r8) :: test_ref_mean(mgncol, nlev) + +contains + +@Before +subroutine setUp() + integer :: i, k, m + + do m = 1, dim_t + do k = 1, nlev + do i = 1, mgncol + test_ref(i,k,m) = i + 10._r8*k + 100._r8*m + end do + end do + end do + + test_ref_mean = sum(test_ref, dim=3)/dim_t + + packer = MGPacker(pcols, pver, mgcols, top_lev) + post_proc = MGPostProc(packer) + +end subroutine setUp + +@After +subroutine tearDown() + + call post_proc%finalize() + call packer%finalize() + +end subroutine tearDown + +@Test +subroutine MGPostProc_accum() + + real(r8), target :: unpacked_data_1D(pcols) + real(r8), target :: packed_data_1D(mgncol) + real(r8), pointer :: unpacked_ptr_1D(:) + real(r8), pointer :: packed_ptr_1D(:) + + real(r8), target :: unpacked_data_2D(pcols,pver) + real(r8), target :: packed_data_2D(mgncol,nlev) + real(r8), pointer :: unpacked_ptr_2D(:,:) + real(r8), pointer :: packed_ptr_2D(:,:) + + real(r8) :: expected_data_1D(pcols) + real(r8) :: expected_data_2D(pcols,pver) + + unpacked_ptr_1D => unpacked_data_1D + packed_ptr_1D => packed_data_1D + + unpacked_ptr_2D => unpacked_data_2D + packed_ptr_2D => packed_data_2D + + call post_proc%add_field(unpacked_ptr_1D, packed_ptr_1D, fillvalue, & + accum_null) + call post_proc%add_field(unpacked_ptr_2D, packed_ptr_2D) + + packed_data_1D = test_ref(:,1,1) + packed_data_2D = test_ref(:,:,1) + + call post_proc%accumulate() + + packed_data_1D = test_ref(:,1,2) + packed_data_2D = test_ref(:,:,2) + + call post_proc%accumulate() + + call post_proc%process_and_unpack() + + expected_data_1D = packer%unpack(test_ref(:,1,2), fillvalue) + expected_data_2D = packer%unpack(test_ref_mean, 0._r8) + + @assertEqual(expected_data_1D, unpacked_data_1D) + @assertEqual(expected_data_2D, unpacked_data_2D) + +end subroutine MGPostProc_accum + +@Test +subroutine MGPostProc_unpack_only() + + real(r8), target :: unpacked_data_1D(pcols) + real(r8), target :: packed_data_1D(mgncol) + real(r8), pointer :: unpacked_ptr_1D(:) + real(r8), pointer :: packed_ptr_1D(:) + + real(r8), target :: unpacked_data_2D(pcols,pver) + real(r8), target :: packed_data_2D(mgncol,nlev) + real(r8), pointer :: unpacked_ptr_2D(:,:) + real(r8), pointer :: packed_ptr_2D(:,:) + + real(r8) :: expected_data_1D(pcols) + real(r8) :: expected_data_2D(pcols,pver) + + unpacked_ptr_1D => unpacked_data_1D + packed_ptr_1D => packed_data_1D + + unpacked_ptr_2D => unpacked_data_2D + packed_ptr_2D => packed_data_2D + + call post_proc%add_field(unpacked_ptr_1D, packed_ptr_1D, fillvalue, & + accum_null) + call post_proc%add_field(unpacked_ptr_2D, packed_ptr_2D) + + packed_data_1D = test_ref(:,1,1) + packed_data_2D = test_ref(:,:,1) + + call post_proc%accumulate() + + packed_data_1D = test_ref(:,1,2) + packed_data_2D = test_ref(:,:,2) + + call post_proc%accumulate() + + call post_proc%unpack_only() + + expected_data_1D = packer%unpack(test_ref(:,1,2), fillvalue) + expected_data_2D = packer%unpack(test_ref(:,:,2), 0._r8) + + @assertEqual(expected_data_1D, unpacked_data_1D) + @assertEqual(expected_data_2D, unpacked_data_2D) + +end subroutine MGPostProc_unpack_only + +end module test_MGPostProc diff --git a/test/unit/micro_mg_utils/CMakeLists.txt b/test/unit/micro_mg_utils/CMakeLists.txt new file mode 100644 index 0000000000..cb40c09eb8 --- /dev/null +++ b/test/unit/micro_mg_utils/CMakeLists.txt @@ -0,0 +1,21 @@ +# Local pFUnit files. +set(pf_sources + test_mg_processes.pf test_mg_size_utils.pf) + +# Sources to test. +set(sources_needed + micro_mg_utils.F90) +extract_sources("${sources_needed}" "${cam_sources}" test_sources) + +# BUG(wjs, 2016-03-21, bugz 2301) micro_mg_utils unit tests currently give a lot +# of build errors; for now, commenting them out. We'd like the users to be able +# to see that the test was skipped but didn't fail, but CTest has no mechanism +# for this. Instead, hack around it by adding a test that will always pass but +# is likely to stand out as a skipped test. +add_test(SKIPPED_micro_mg_utils true) + +# # Do source preprocessing and add the executable. +# create_pFUnit_test(micro_mg_utils micro_mg_utils_exe "${pf_sources}" +# "${test_sources}") + +# target_link_libraries(micro_mg_utils_exe csm_share) diff --git a/test/unit/micro_mg_utils/test_mg_processes.pf b/test/unit/micro_mg_utils/test_mg_processes.pf new file mode 100644 index 0000000000..45a06d6dd4 --- /dev/null +++ b/test/unit/micro_mg_utils/test_mg_processes.pf @@ -0,0 +1,1654 @@ +module test_mg_processes + +use pfunit_mod + +use micro_mg_utils + +! Constants we can get from the same place as the model: +use shr_const_mod, only: & + rh2o => shr_const_rwv, & + cpair => shr_const_cpdair, & + tmelt => shr_const_tkfrz, & + latvap => shr_const_latvap, & + latice => shr_const_latice + +use shr_spfn_mod, only: gamma => shr_spfn_gamma + +implicit none + +! At the time of this writing, this is the hard-coded MG2 value. +real(r8), parameter :: dcs = 150.e-6_r8 + +real(r8), parameter :: mach_eps = epsilon(1._r8) + +contains + +@Before +subroutine setUp() + character(len=128) :: errstring + call micro_mg_utils_init(r8, rh2o, cpair, tmelt, latvap, latice, dcs, & + errstring) + if (trim(errstring) /= "") & + call throw("micro_mg_utils_init error: "//errstring) +end subroutine setUp + +@After +subroutine tearDown() +end subroutine tearDown + +@Test +subroutine ice_dep_sub_has_qi_threshold() + + real(r8) :: t(2), qv(2), qi(2), ni(2) + real(r8) :: icldm(2), rho(2), dv(2), qvl(2), qvi(2) + + real(r8) :: berg(2), vap_dep(2), ice_sublim(2) + + ! As long as qi is 0, this should produce 0 at the end. + t = 1._r8 + qv = 2._r8 + qi = 0._r8 + ni = 1._r8 + icldm = 1._r8 + rho = 1._r8 + dv = 1._r8 + qvl = 2._r8 + qvi = 1._r8 + + berg = 1._r8 + vap_dep = 1._r8 + ice_sublim = 1._r8 + + call ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, & + berg, vap_dep, ice_sublim) + + @assertEqual(0._r8, berg) + @assertEqual(0._r8, vap_dep) + @assertEqual(0._r8, ice_sublim) + +end subroutine ice_dep_sub_has_qi_threshold + +@Test +subroutine ice_dep_has_correct_value() + + real(r8) :: t(2), qv(2), qi(2), ni(2) + real(r8) :: icldm(2), rho(2), dv(2), qvl(2), qvi(2) + + real(r8) :: berg(2), vap_dep(2), ice_sublim(2) + + ! Check the typical case with deposition and the bergeron process. + ! + ! Make up unrealistic data because it's easier to see that it should + ! exercise the appropriate code paths. + t = 253._r8 + qv = 1._r8 + qi = 1.e-3_r8 + ni = qi / (pi/6._r8 * (50.e-6_r8)**3 * rhoi) + icldm = 0.1_r8 + rho = 3._r8 + dv = 5._r8 + qvl = 0.5_r8 + qvi = 0.25_r8 + + berg = 1._r8 + vap_dep = 1._r8 + ice_sublim = 1._r8 + + call ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, & + berg, vap_dep, ice_sublim) + + @assertEqual(2884.1851927526181_r8, berg, tolerance=(1.e5*mach_eps)) + @assertEqual(865.25555782578544_r8, vap_dep, tolerance=(1.e5*mach_eps)) + @assertEqual(0._r8, ice_sublim) + +end subroutine ice_dep_has_correct_value + +@Test +subroutine ice_dep_is_off_above_freezing() + + real(r8) :: t(2), qv(2), qi(2), ni(2) + real(r8) :: icldm(2), rho(2), dv(2), qvl(2), qvi(2) + + real(r8) :: berg(2), vap_dep(2), ice_sublim(2) + + ! Copy above, but with a temperature too high to freeze + t = 280._r8 + qv = 1._r8 + qi = 1.e-3_r8 + ni = qi / (pi/6._r8 * (50.e-6_r8)**3 * rhoi) + icldm = 0.1_r8 + rho = 3._r8 + dv = 5._r8 + qvl = 0.5_r8 + qvi = 0.25_r8 + + berg = 1._r8 + vap_dep = 1._r8 + ice_sublim = 1._r8 + + call ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, & + berg, vap_dep, ice_sublim) + + @assertEqual(0._r8, berg) + @assertEqual(0._r8, vap_dep) + @assertEqual(0._r8, ice_sublim) + +end subroutine ice_dep_is_off_above_freezing + +@Test +subroutine ice_sub_has_correct_value() + + real(r8) :: t(2), qv(2), qi(2), ni(2) + real(r8) :: icldm(2), rho(2), dv(2), qvl(2), qvi(2) + + real(r8) :: berg(2), vap_dep(2), ice_sublim(2) + + ! In this case, qv < qvl < qvi, so we should have sublimation and the + ! bergeron process should be inactive. + t = 280._r8 + qv = 0.25_r8 + qi = 1.e-3_r8 + ni = qi / (pi/6._r8 * (50.e-6_r8)**3 * rhoi) + icldm = 0.1_r8 + rho = 3._r8 + dv = 5._r8 + qvl = 0.5_r8 + qvi = 1._r8 + + berg = 1._r8 + vap_dep = 1._r8 + ice_sublim = 1._r8 + + call ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, & + berg, vap_dep, ice_sublim) + + @assertEqual(0._r8, berg) + @assertEqual(0._r8, vap_dep) + @assertEqual(-267.65060825243921_r8, ice_sublim, tolerance=(1.e5_r8*mach_eps)) + +end subroutine ice_sub_has_correct_value + +@Test +subroutine ice_sub_is_on_above_freezing() + + real(r8) :: t(2), qv(2), qi(2), ni(2) + real(r8) :: icldm(2), rho(2), dv(2), qvl(2), qvi(2) + + real(r8) :: berg(2), vap_dep(2), ice_sublim(2) + + ! Similar to above, but it's cold. + t = 253._r8 + qv = 0.25_r8 + qi = 1.e-3_r8 + ni = qi / (pi/6._r8 * (50.e-6_r8)**3 * rhoi) + icldm = 0.1_r8 + rho = 3._r8 + dv = 5._r8 + qvl = 0.5_r8 + qvi = 1._r8 + + berg = 1._r8 + vap_dep = 1._r8 + ice_sublim = 1._r8 + + call ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, & + berg, vap_dep, ice_sublim) + + @assertEqual(0._r8, berg) + @assertEqual(0._r8, vap_dep) + @assertEqual(-218.70179977744760_r8, ice_sublim, tolerance=(1.e5_r8*mach_eps)) + +end subroutine ice_sub_is_on_above_freezing + +@Test +subroutine liq_autoconversion_has_qc_threshold() + + real(r8), parameter :: zeros(2) = 0._r8 + + real(r8) :: prc(2), nprc(2), nprc1(2) + + prc = 1._r8 + nprc = 1._r8 + nprc1 = 1._r8 + + ! For zeroed inputs, should get zeroed outputs. + call kk2000_liq_autoconversion(.true., zeros, zeros, zeros, zeros, & + prc, nprc, nprc1) + + @assertEqual(0._r8, prc) + @assertEqual(0._r8, nprc) + @assertEqual(0._r8, nprc1) + +end subroutine liq_autoconversion_has_qc_threshold + +@Test +subroutine uniform_liq_autoconversion_mass() + + real(r8), parameter :: zeros(2) = 0._r8 + + real(r8) :: qcic(2), ncic(2), rho(2), prc(2), nprc(2), nprc1(2) + real(r8) :: expected(2) + + ! Arbitrary contrived inputs. + qcic = [2.e-3_r8, 3.e-3_r8] + ncic = [2.e6_r8, 1.5e6_r8] + rho = [2._r8, 1.5_r8] + + ! Use formula 1350 * qc**2.47 * (nc/1.e6_r8*rho)**-1.79 to get this. + ! (Note that the above form is because the original paper used #/cm3 + ! instead of #/kg as CAM does.) + expected = [2.4332709614947312e-05_r8, 1.8553103196805609e-4_r8] + + prc = 1._r8 + nprc = 1._r8 + nprc1 = 1._r8 + + call kk2000_liq_autoconversion(.true., qcic, ncic, rho, zeros, & + prc, nprc, nprc1) + + @assertEqual(expected, prc, tolerance=(1.e-4_r8*mach_eps)) + +end subroutine uniform_liq_autoconversion_mass + +@Test +subroutine liq_autoconversion_rain_num() + + real(r8), parameter :: zeros(2) = 0._r8 + + real(r8) :: qcic(2), ncic(2), rho(2), prc(2), nprc(2), nprc1(2) + real(r8) :: expected_mass + + ! Arbitrary contrived inputs. + qcic = [2.e-3_r8, 3.e-3_r8] + ncic = [2.e6_r8, 1.5e6_r8] + rho = [2._r8, 1.5_r8] + + ! Average particle mass is the mass of a droplet with a 50 micron + ! diameter. + expected_mass = pi/6._r8 * (50.e-6_r8)**3 * rhow + + prc = 1._r8 + nprc = 1._r8 + nprc1 = 1._r8 + + call kk2000_liq_autoconversion(.true., qcic, ncic, rho, zeros, & + prc, nprc, nprc1) + + @assertEqual(expected_mass, prc/nprc, tolerance=(expected_mass*10._r8*mach_eps)) + +end subroutine liq_autoconversion_rain_num + +@Test +subroutine liq_autoconversion_cld_num() + + real(r8), parameter :: zeros(2) = 0._r8 + + real(r8) :: qcic(2), ncic(2), rho(2), prc(2), nprc(2), nprc1(2) + + ! Arbitrary contrived inputs. + qcic = [2.e-3_r8, 3.e-3_r8] + ncic = [2.e6_r8, 1.5e6_r8] + rho = [2._r8, 1.5_r8] + + prc = 1._r8 + nprc = 1._r8 + nprc1 = 1._r8 + + call kk2000_liq_autoconversion(.true., qcic, ncic, rho, zeros, & + prc, nprc, nprc1) + + @assertEqual(qcic/ncic, prc/nprc1, tolerance=(1.e-8_r8*mach_eps)) + +end subroutine liq_autoconversion_cld_num + +@Test +subroutine nonuniform_liq_autoconversion_mass() + + real(r8) :: qcic(2), ncic(2), rho(2), relvar(2), prc(2), nprc(2), nprc1(2) + real(r8) :: expected(2) + + ! Arbitrary contrived inputs. + qcic = [2.e-3_r8, 3.e-3_r8] + ncic = [2.e6_r8, 1.5e6_r8] + rho = [2._r8, 1.5_r8] + relvar = [2._r8, 3._r8] + + ! Same as uniform test, only we multiply in a variance-related factor: + ! gamma(relvar+2.47) / (gamma(relvar) * relvar**2.47) + expected = [4.9005406623946315e-05_r8, 3.0676245281189245e-4_r8] + + prc = 1._r8 + nprc = 1._r8 + nprc1 = 1._r8 + + call kk2000_liq_autoconversion(.false., qcic, ncic, rho, relvar, & + prc, nprc, nprc1) + + @assertEqual(expected, prc, tolerance=(1.e-4_r8*mach_eps)) + +end subroutine nonuniform_liq_autoconversion_mass + +@Test +subroutine ice_auto_has_t_threshold() + + real(r8) :: t(2), qiic(2), lami(2), n0i(2), prci(2), nprci(2) + + ! Above freezing, nothing should happen. + t = 280._r8 + qiic = 1._r8 + lami = 1._r8 + n0i = 1._r8 + prci = 1._r8 + nprci = 1._r8 + + call ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci) + + @assertEqual(0._r8, prci) + @assertEqual(0._r8, nprci) + +end subroutine ice_auto_has_t_threshold + +@Test +subroutine ice_auto_has_qi_threshold() + + real(r8) :: t(2), qiic(2), lami(2), n0i(2), prci(2), nprci(2) + + ! Without cloud ice, nothing should happen. + t = 253._r8 + qiic = 0._r8 + lami = 1._r8 + n0i = 1._r8 + prci = 1._r8 + nprci = 1._r8 + + call ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci) + + @assertEqual(0._r8, prci) + @assertEqual(0._r8, nprci) + +end subroutine ice_auto_has_qi_threshold + +@Test +subroutine ice_auto_has_correct_outputs() + + real(r8) :: t(2), qiic(2), lami(2), n0i(2), prci(2), nprci(2) + + ! Arbitrary inputs that cause a small amount of autoconversion. + t = 253._r8 + qiic = 1.e-3_r8 + lami = 20000._r8 + n0i = 1._r8 + prci = 1._r8 + nprci = 1._r8 + + call ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci) + + @assertEqual(3.5301023384849040e-17_r8, prci, tolerance=(1.e-16*mach_eps)) + @assertEqual(1.3829741213295544e-08_r8, nprci, tolerance=(1.e-7*mach_eps)) + +end subroutine ice_auto_has_correct_outputs + +@Test +subroutine imm_freezing_has_t_threshold() + + real(r8) :: t(2), pgam(2), lamc(2), qcic(2), ncic(2), relvar(2) + real(r8) :: mnuccc(2), nnuccc(2) + + t = 280._r8 + pgam = 1._r8 + lamc = 1._r8 + qcic = 1._r8 + ncic = 1._r8 + relvar = 1._r8 + + mnuccc = 1._r8 + nnuccc = 1._r8 + + call immersion_freezing(.true., t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc) + + @assertEqual(0._r8, mnuccc) + @assertEqual(0._r8, nnuccc) + +end subroutine imm_freezing_has_t_threshold + +@Test +subroutine imm_freezing_has_qc_threshold() + + real(r8) :: t(2), pgam(2), lamc(2), qcic(2), ncic(2), relvar(2) + real(r8) :: mnuccc(2), nnuccc(2) + + t = 253._r8 + pgam = 1._r8 + lamc = 1._r8 + qcic = 0._r8 + ncic = 1._r8 + relvar = 1._r8 + + mnuccc = 1._r8 + nnuccc = 1._r8 + + call immersion_freezing(.true., t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc) + + @assertEqual(0._r8, mnuccc) + @assertEqual(0._r8, nnuccc) + +end subroutine imm_freezing_has_qc_threshold + +@Test +subroutine imm_freezing_has_correct_outputs() + + real(r8) :: t(2), pgam(2), lamc(2), qcic(2), ncic(2), relvar(2) + real(r8) :: mnuccc(2), nnuccc(2) + + t = 253._r8 + pgam = 3._r8 + lamc = 20000._r8 + qcic = 1._r8 + ncic = 1.e6_r8 + relvar = 1._r8 + + mnuccc = 1._r8 + nnuccc = 1._r8 + + call immersion_freezing(.true., t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc) + + @assertEqual(1.5456481556770479e-5_r8, mnuccc, tolerance=(1.e-4*mach_eps)) + @assertEqual(468.56675096547337_r8, nnuccc, tolerance=(1.e4*mach_eps)) + +end subroutine imm_freezing_has_correct_outputs + +@Test +subroutine nonuniform_imm_freezing_is_correct() + + real(r8) :: t(2), pgam(2), lamc(2), qcic(2), ncic(2), relvar(2) + real(r8) :: mnuccc(2), nnuccc(2) + + t = 253._r8 + pgam = 3._r8 + lamc = 20000._r8 + qcic = 1._r8 + ncic = 1.e6_r8 + relvar = 2.5_r8 + + mnuccc = 1._r8 + nnuccc = 1._r8 + + call immersion_freezing(.false., t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc) + + @assertEqual(2.1639074179478672e-5_r8, mnuccc, tolerance=(1.e-4*mach_eps)) + @assertEqual(468.56675096547337_r8, nnuccc, tolerance=(1.e4*mach_eps)) + +end subroutine nonuniform_imm_freezing_is_correct + +@Test +subroutine cont_freezing_has_t_threshold() + real(r8) :: t(2), p(2), rndst(2,2), nacon(2,2), pgam(2), lamc(2) + real(r8) :: qcic(2), ncic(2), relvar(2), mnucct(2), nnucct(2) + + ! No contact freezing if temperature is around tmelt or above. + t = [tmelt, 280._r8] + p = 1._r8 + rndst = 1._r8 + nacon = 1._r8 + pgam = 1._r8 + lamc = 1._r8 + qcic = 1._r8 + ncic = 1._r8 + relvar = 1._r8 + + mnucct = 1._r8 + nnucct = 1._r8 + + call contact_freezing (.true., t, p, rndst, nacon, & + pgam, lamc, qcic, ncic, relvar, mnucct, nnucct) + + @assertEqual(0._r8, mnucct) + @assertEqual(0._r8, nnucct) + +end subroutine cont_freezing_has_t_threshold + +@Test +subroutine cont_freezing_has_qc_threshold() + real(r8) :: t(2), p(2), rndst(2,2), nacon(2,2), pgam(2), lamc(2) + real(r8) :: qcic(2), ncic(2), relvar(2), mnucct(2), nnucct(2) + + ! No contact freezing if there's no cloud to freeze. + t = 253._r8 + p = 1._r8 + rndst = 1._r8 + nacon = 1._r8 + pgam = 1._r8 + lamc = 1._r8 + qcic = 0._r8 + ncic = 1._r8 + relvar = 1._r8 + + mnucct = 1._r8 + nnucct = 1._r8 + + call contact_freezing (.true., t, p, rndst, nacon, & + pgam, lamc, qcic, ncic, relvar, mnucct, nnucct) + + @assertEqual(0._r8, mnucct) + @assertEqual(0._r8, nnucct) + +end subroutine cont_freezing_has_qc_threshold + +@Test +subroutine cont_freezing_is_correct() + real(r8) :: t(2), p(2), rndst(2,2), nacon(2,2), pgam(2), lamc(2) + real(r8) :: qcic(2), ncic(2), relvar(2), mnucct(2), nnucct(2) + + ! Completely made up data again. + t = 253._r8 + p = 1.e5_r8 + rndst = spread([30.e-6_r8, 50.e-6_r8], 1, 2) + nacon = spread([3.e6_r8, 2.e6_r8], 1, 2) + pgam = 3._r8 + lamc = 20000._r8 + qcic = 1._r8 + ncic = 1.e6_r8 + relvar = 1._r8 + + mnucct = 1._r8 + nnucct = 1._r8 + + call contact_freezing (.true., t, p, rndst, nacon, & + pgam, lamc, qcic, ncic, relvar, mnucct, nnucct) + + @assertEqual(1.1544152715841601e-9_r8, mnucct, tolerance=(1.e-8*mach_eps)) + @assertEqual(8.3991267132979150e-2_r8, nnucct, tolerance=(1.e-1*mach_eps)) + +end subroutine cont_freezing_is_correct + +@Test +subroutine cont_freezing_nonuniform_is_correct() + real(r8) :: t(2), p(2), rndst(2,2), nacon(2,2), pgam(2), lamc(2) + real(r8) :: qcic(2), ncic(2), relvar(2), mnucct(2), nnucct(2) + + ! Completely made up data yet again. + t = 253._r8 + p = 1.e5_r8 + rndst = spread([30.e-6_r8, 50.e-6_r8], 1, 2) + nacon = spread([3.e6_r8, 2.e6_r8], 1, 2) + pgam = 3._r8 + lamc = 20000._r8 + qcic = 1._r8 + ncic = 1.e6_r8 + relvar = 2.5_r8 + + mnucct = 1._r8 + nnucct = 1._r8 + + call contact_freezing (.false., t, p, rndst, nacon, & + pgam, lamc, qcic, ncic, relvar, mnucct, nnucct) + + @assertEqual(1.2505730222133072e-9_r8, mnucct, tolerance=(1.e-8*mach_eps)) + @assertEqual(8.0282976073661236e-2_r8, nnucct, tolerance=mach_eps) + +end subroutine cont_freezing_nonuniform_is_correct + +@Test +subroutine snow_aggregation_has_t_threshold() + real(r8) :: t(2), rho(2), asn(2), qsic(2), nsic(2) + real(r8) :: nsagg(2) + + ! Above freezing, nothing should happen. + t = 280._r8 + rho = 1._r8 + asn = as + qsic = 1.e-3_r8 + nsic = 1.e6_r8 + + call snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg) + + @assertEqual(0._r8, nsagg) + +end subroutine snow_aggregation_has_t_threshold + +@Test +subroutine snow_aggregation_has_qs_threshold() + real(r8) :: t(2), rho(2), asn(2), qsic(2), nsic(2) + real(r8) :: nsagg(2) + + ! Without snow, nothing should happen. + t = 253._r8 + rho = 1._r8 + asn = as + qsic = 0._r8 + nsic = 1.e6_r8 + + call snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg) + + @assertEqual(0._r8, nsagg) + +end subroutine snow_aggregation_has_qs_threshold + +@Test +subroutine snow_aggregation_is_correct() + real(r8) :: t(2), rho(2), asn(2), qsic(2), nsic(2) + real(r8) :: nsagg(2) + + ! Without snow, nothing should happen. + t = 253._r8 + rho = 1._r8 + asn = as + qsic = 1.e-3_r8 + nsic = 1.e6_r8 + + call snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg) + + @assertEqual(-1.9700287158816477e3_r8, nsagg, tolerance=(1.e5_r8*mach_eps)) + +end subroutine snow_aggregation_is_correct + +@Test +subroutine acc_cloud_snow_has_t_threshold() + real(r8) :: t(2), rho(2), asn(2), uns(2), mu(2), qcic(2), ncic(2) + real(r8) :: qsic(2), pgam(2), lamc(2), lams(2), n0s(2) + real(r8) :: psacws(2), npsacws(2) + + t = 280._r8 + rho = 1._r8 + asn = as + uns = 1._r8 + mu = 1._r8 + qcic = 1._r8 + ncic = 1._r8 + qsic = 1._r8 + pgam = 1._r8 + lamc = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + psacws = 1._r8 + npsacws = 1._r8 + + call accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws) + + @assertEqual(0._r8, psacws) + @assertEqual(0._r8, npsacws) + +end subroutine acc_cloud_snow_has_t_threshold + +@Test +subroutine acc_cloud_snow_has_qs_threshold() + real(r8) :: t(2), rho(2), asn(2), uns(2), mu(2), qcic(2), ncic(2) + real(r8) :: qsic(2), pgam(2), lamc(2), lams(2), n0s(2) + real(r8) :: psacws(2), npsacws(2) + + t = 253._r8 + rho = 1._r8 + asn = as + uns = 1._r8 + mu = 1._r8 + qcic = 1._r8 + ncic = 1._r8 + qsic = 0._r8 + pgam = 1._r8 + lamc = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + psacws = 1._r8 + npsacws = 1._r8 + + call accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws) + + @assertEqual(0._r8, psacws) + @assertEqual(0._r8, npsacws) + +end subroutine acc_cloud_snow_has_qs_threshold + +@Test +subroutine acc_cloud_snow_has_qc_threshold() + real(r8) :: t(2), rho(2), asn(2), uns(2), mu(2), qcic(2), ncic(2) + real(r8) :: qsic(2), pgam(2), lamc(2), lams(2), n0s(2) + real(r8) :: psacws(2), npsacws(2) + + t = 253._r8 + rho = 1._r8 + asn = as + uns = 1._r8 + mu = 1._r8 + qcic = 0._r8 + ncic = 1._r8 + qsic = 1._r8 + pgam = 1._r8 + lamc = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + psacws = 1._r8 + npsacws = 1._r8 + + call accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws) + + @assertEqual(0._r8, psacws) + @assertEqual(0._r8, npsacws) + +end subroutine acc_cloud_snow_has_qc_threshold + +@Test +subroutine acc_cloud_snow_is_correct() + real(r8) :: t(2), rho(2), asn(2), uns(2), mu(2), qcic(2), ncic(2) + real(r8) :: qsic(2), pgam(2), lamc(2), lams(2), n0s(2) + real(r8) :: psacws(2), npsacws(2) + + t = 253._r8 + rho = 1.2_r8 + asn = as + uns = 0.2_r8 + mu = 1.e-5_r8 + qcic = 1.e-3_r8 + ncic = 1.e6_r8 + qsic = 1._r8 + pgam = 3._r8 + lamc = 20000._r8 + lams = 5000._r8 + n0s = 7.e4_r8 + + psacws = 1._r8 + npsacws = 1._r8 + + call accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws) + + @assertEqual(5.6633345420868814e-10_r8, psacws, tolerance=(1.e-9_r8*mach_eps)) + @assertEqual(0.5663334542086882_r8, npsacws, tolerance=mach_eps) + +end subroutine acc_cloud_snow_is_correct + +@Test +subroutine snd_ice_production_has_t_thresholds() + real(r8) :: t(2), psacws(2) + real(r8) :: msacwi(2), nsacwi(2) + + ! Both of these are outside the relevant temperature range. + t = [253._r8, tmelt] + psacws = 1.e-8_r8 + + msacwi = 1._r8 + nsacwi = 1._r8 + + call secondary_ice_production(t, psacws, msacwi, nsacwi) + + @assertEqual(1.e-8_r8, psacws) + @assertEqual(0._r8, msacwi) + @assertEqual(0._r8, nsacwi) + +end subroutine snd_ice_production_has_t_thresholds + +@Test +subroutine snd_ice_production_is_correct() + real(r8) :: t(2), psacws(2) + real(r8) :: msacwi(2), nsacwi(2) + + real(r8) :: psacws_expected(2), msacwi_expected(2), nsacwi_expected(2) + + ! Both of these are outside the relevant temperature range. + t = [267._r8, 269._r8] + psacws = 1.e-8_r8 + + msacwi = 1._r8 + nsacwi = 1._r8 + + call secondary_ice_production(t, psacws, msacwi, nsacwi) + + psacws_expected = [9.9955040318468636e-9_r8, 9.9957483779421419e-9_r8] + msacwi_expected = [4.4959681531373333e-12_r8, 4.2516220578582796e-12_r8] + nsacwi_expected = [2.1466666666666376_r8, 2.0300000000000438_r8] + @assertEqual(psacws_expected, psacws, tolerance=(1.e-8_r8*mach_eps)) + @assertEqual(msacwi_expected, msacwi, tolerance=(1.e-11_r8*mach_eps)) + @assertEqual(nsacwi_expected, nsacwi, tolerance=(1.e1_r8*mach_eps)) + +end subroutine snd_ice_production_is_correct + +@Test +subroutine acc_rain_snow_has_t_threshold() + real(r8) :: t(2), rho(2), umr(2), ums(2), unr(2), uns(2), qric(2), qsic(2) + real(r8) :: lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pracs(2), npracs(2) + + t = 280._r8 + rho = 1._r8 + umr = 1._r8 + ums = 1._r8 + unr = 1._r8 + uns = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 1._r8 + n0r = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + pracs = 1._r8 + npracs = 1._r8 + + call accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs) + + @assertEqual(0._r8, pracs) + @assertEqual(0._r8, npracs) + +end subroutine acc_rain_snow_has_t_threshold + +@Test +subroutine acc_rain_snow_has_qr_threshold() + real(r8) :: t(2), rho(2), umr(2), ums(2), unr(2), uns(2), qric(2), qsic(2) + real(r8) :: lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pracs(2), npracs(2) + + t = 253._r8 + rho = 1._r8 + umr = 1._r8 + ums = 1._r8 + unr = 1._r8 + uns = 1._r8 + qric = 0._r8 + qsic = 1._r8 + lamr = 1._r8 + n0r = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + pracs = 1._r8 + npracs = 1._r8 + + call accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs) + + @assertEqual(0._r8, pracs) + @assertEqual(0._r8, npracs) + +end subroutine acc_rain_snow_has_qr_threshold + +@Test +subroutine acc_rain_snow_has_qs_threshold() + real(r8) :: t(2), rho(2), umr(2), ums(2), unr(2), uns(2), qric(2), qsic(2) + real(r8) :: lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pracs(2), npracs(2) + + t = 253._r8 + rho = 1._r8 + umr = 1._r8 + ums = 1._r8 + unr = 1._r8 + uns = 1._r8 + qric = 1._r8 + qsic = 0._r8 + lamr = 1._r8 + n0r = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + pracs = 1._r8 + npracs = 1._r8 + + call accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs) + + @assertEqual(0._r8, pracs) + @assertEqual(0._r8, npracs) + +end subroutine acc_rain_snow_has_qs_threshold + +@Test +subroutine acc_rain_snow_is_correct() + real(r8) :: t(2), rho(2), umr(2), ums(2), unr(2), uns(2), qric(2), qsic(2) + real(r8) :: lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pracs(2), npracs(2) + + t = 253._r8 + rho = 1.2_r8 + umr = 4._r8 + ums = 0.8_r8 + unr = 1._r8 + uns = 0.2_r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 5000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + + pracs = 1._r8 + npracs = 1._r8 + + call accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs) + + @assertEqual(9.7214791125218962_r8, pracs, tolerance=(1.e1_r8*mach_eps)) + @assertEqual(2.0357882303518619e7_r8, npracs, tolerance=(1.e8_r8*mach_eps)) + +end subroutine acc_rain_snow_is_correct + +@Test +subroutine het_rain_frz_has_t_threshold() + real(r8) :: t(2), qric(2), nric(2), lamr(2) + real(r8) :: mnuccr(2), nnuccr(2) + + ! Does not operate unless somewhat below freezing. + t = tmelt + qric = 1._r8 + nric = 1._r8 + lamr = 1._r8 + + mnuccr = 1._r8 + nnuccr = 1._r8 + + call heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr) + + @assertEqual(0._r8, mnuccr) + @assertEqual(0._r8, nnuccr) + +end subroutine het_rain_frz_has_t_threshold + +@Test +subroutine het_rain_frz_has_qr_threshold() + real(r8) :: t(2), qric(2), nric(2), lamr(2) + real(r8) :: mnuccr(2), nnuccr(2) + + ! Does not operate unless somewhat below freezing. + t = 253._r8 + qric = 0._r8 + nric = 1._r8 + lamr = 1._r8 + + mnuccr = 1._r8 + nnuccr = 1._r8 + + call heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr) + + @assertEqual(0._r8, mnuccr) + @assertEqual(0._r8, nnuccr) + +end subroutine het_rain_frz_has_qr_threshold + +@Test +subroutine het_rain_frz_is_correct() + real(r8) :: t(2), qric(2), nric(2), lamr(2) + real(r8) :: mnuccr(2), nnuccr(2) + + ! Does not operate unless somewhat below freezing. + t = 253._r8 + qric = 1._r8 + nric = 1.e6_r8 + lamr = 5000._r8 + + mnuccr = 1._r8 + nnuccr = 1._r8 + + call heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr) + + @assertEqual(7.5368748162537962e-4_r8, mnuccr, tolerance=(1.e-3*mach_eps)) + @assertEqual(1.4994136030895149e3_r8, nnuccr, tolerance=(1.e4*mach_eps)) + +end subroutine het_rain_frz_is_correct + +@Test +subroutine acc_cloud_rain_has_qr_threshold() + real(r8) :: qric(2), qcic(2), ncic(2), relvar(2), accre_enhan(2) + real(r8) :: pra(2), npra(2) + + qric = 0._r8 + qcic = 1._r8 + ncic = 1._r8 + relvar = 1._r8 + accre_enhan = 1._r8 + + pra = 1._r8 + npra = 1._r8 + + call accrete_cloud_water_rain(.true., qric, qcic, & + ncic, relvar, accre_enhan, pra, npra) + + @assertEqual(0._r8, pra) + @assertEqual(0._r8, npra) + +end subroutine acc_cloud_rain_has_qr_threshold + +@Test +subroutine acc_cloud_rain_has_qc_threshold() + real(r8) :: qric(2), qcic(2), ncic(2), relvar(2), accre_enhan(2) + real(r8) :: pra(2), npra(2) + + qric = 1._r8 + qcic = 0._r8 + ncic = 1._r8 + relvar = 1._r8 + accre_enhan = 1._r8 + + pra = 1._r8 + npra = 1._r8 + + call accrete_cloud_water_rain(.true., qric, qcic, & + ncic, relvar, accre_enhan, pra, npra) + + @assertEqual(0._r8, pra) + @assertEqual(0._r8, npra) + +end subroutine acc_cloud_rain_has_qc_threshold + +@Test +subroutine acc_cloud_rain_is_correct() + real(r8) :: qric(2), qcic(2), ncic(2), relvar(2), accre_enhan(2) + real(r8) :: pra(2), npra(2) + + qric = 1.e-3_r8 + qcic = 1.e-4_r8 + ncic = 1.e6_r8 + relvar = 1._r8 + accre_enhan = 1._r8 + + pra = 1._r8 + npra = 1._r8 + + call accrete_cloud_water_rain(.true., qric, qcic, & + ncic, relvar, accre_enhan, pra, npra) + + @assertEqual(5.9713812854961045e-7_r8, pra, tolerance=(1.e-6*mach_eps)) + @assertEqual(5.9713812854961043e3_r8, npra, tolerance=(1.e4*mach_eps)) + +end subroutine acc_cloud_rain_is_correct + +@Test +subroutine acc_cloud_rain_nonuniform_is_correct() + real(r8) :: qric(2), qcic(2), ncic(2), relvar(2), accre_enhan(2) + real(r8) :: pra(2), npra(2) + + qric = 1.e-3_r8 + qcic = 1.e-4_r8 + ncic = 1.e6_r8 + relvar = 3._r8 + accre_enhan = 7._r8 + + pra = 1._r8 + npra = 1._r8 + + call accrete_cloud_water_rain(.false., qric, qcic, & + ncic, relvar, accre_enhan, pra, npra) + + @assertEqual(4.2933960677780231e-6_r8, pra, tolerance=(1.e-7*mach_eps)) + @assertEqual(4.2933960677780233e4_r8, npra, tolerance=(1.e5*mach_eps)) + +end subroutine acc_cloud_rain_nonuniform_is_correct + +@Test +subroutine rain_collection_has_qr_threshold() + real(r8) :: rho(2), qric(2), nric(2), nragg(2) + + rho = 1._r8 + qric = 0._r8 + nric = 1._r8 + + nragg = 1._r8 + + call self_collection_rain(rho, qric, nric, nragg) + + @assertEqual(0._r8, nragg) + +end subroutine rain_collection_has_qr_threshold + +@Test +subroutine rain_collection_is_correct() + real(r8) :: rho(2), qric(2), nric(2), nragg(2) + + rho = 1._r8 + qric = 1._r8 + nric = 1._r8 + + nragg = 1._r8 + + call self_collection_rain(rho, qric, nric, nragg) + + @assertEqual(-8._r8, nragg, tolerance=(1.e1_r8*mach_eps)) + +end subroutine rain_collection_is_correct + +@Test +subroutine acc_ice_snow_has_t_threshold() + real(r8) :: t(2), rho(2), asn(2), qiic(2), niic(2), qsic(2), lams(2), n0s(2) + real(r8) :: prai(2), nprai(2) + + t = 280._r8 + rho = 1._r8 + asn = as + qiic = 1._r8 + niic = 1._r8 + qsic = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + prai = 1._r8 + nprai = 1._r8 + + call accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai) + + @assertEqual(0._r8, prai) + @assertEqual(0._r8, nprai) + +end subroutine acc_ice_snow_has_t_threshold + +@Test +subroutine acc_ice_snow_has_qs_threshold() + real(r8) :: t(2), rho(2), asn(2), qiic(2), niic(2), qsic(2), lams(2), n0s(2) + real(r8) :: prai(2), nprai(2) + + t = 253._r8 + rho = 1._r8 + asn = as + qiic = 1._r8 + niic = 1._r8 + qsic = 0._r8 + lams = 1._r8 + n0s = 1._r8 + + prai = 1._r8 + nprai = 1._r8 + + call accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai) + + @assertEqual(0._r8, prai) + @assertEqual(0._r8, nprai) + +end subroutine acc_ice_snow_has_qs_threshold + +@Test +subroutine acc_ice_snow_has_qi_threshold() + real(r8) :: t(2), rho(2), asn(2), qiic(2), niic(2), qsic(2), lams(2), n0s(2) + real(r8) :: prai(2), nprai(2) + + t = 253._r8 + rho = 1._r8 + asn = as + qiic = 0._r8 + niic = 1._r8 + qsic = 1._r8 + lams = 1._r8 + n0s = 1._r8 + + prai = 1._r8 + nprai = 1._r8 + + call accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai) + + @assertEqual(0._r8, prai) + @assertEqual(0._r8, nprai) + +end subroutine acc_ice_snow_has_qi_threshold + +@Test +subroutine acc_ice_snow_is_correct() + real(r8) :: t(2), rho(2), asn(2), qiic(2), niic(2), qsic(2), lams(2), n0s(2) + real(r8) :: prai(2), nprai(2) + + t = 253._r8 + rho = 1._r8 + asn = as + qiic = 1.e-3_r8 + niic = 1.e6_r8 + qsic = 1._r8 + lams = 5000._r8 + n0s = 5.e9_r8 + + prai = 1._r8 + nprai = 1._r8 + + call accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai) + + @assertEqual(1.6885515272510761e-5_r8, prai, tolerance=(1.e-4*mach_eps)) + @assertEqual(1.6885515272510762e4_r8, nprai, tolerance=(1.e5*mach_eps)) + +end subroutine acc_ice_snow_is_correct + +@Test +subroutine precip_evap_sub_has_precip_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + + ! With a precipitation fraction below the cloud fraction, nothing should + ! happen. + t = 1._r8 + rho = 1._r8 + dv = 1._r8 + mu = 1._r8 + sc = 1._r8 + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 1._r8 + precip_frac = 0.5_r8 + arn = 1._r8 + asn = 1._r8 + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 1._r8 + n0r = 1._r8 + lams = 1._r8 + n0s = 1._r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(0._r8, pre) + @assertEqual(0._r8, prds) + +end subroutine precip_evap_sub_has_precip_threshold + +@Test +subroutine precip_evap_sub_is_correct() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + + ! Made-up data! + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 0.25_r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(-3.1908134966921465e-6_r8, pre, tolerance=(1.e-5*mach_eps)) + @assertEqual(-2.7062816224452731e-5_r8, prds, tolerance=(1.e-4*mach_eps)) + +end subroutine precip_evap_sub_is_correct + +@Test +subroutine precip_evap_sub_has_cloud_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + real(r8) :: pre_no_lcldm(2), prds_no_lcldm(2) + + ! If qcic and qiic are negligible, the routine should behave as if cloud + ! fraction were zero. + ! + ! First run with cloud fraction of 0. + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 0._r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre_no_lcldm, prds_no_lcldm) + + ! Now positive cloud fraction, but no actual cloud mass. + lcldm = 0.25_r8 + qcic = 0._r8 + qiic = 0._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(pre_no_lcldm, pre) + @assertEqual(prds_no_lcldm, prds) + +end subroutine precip_evap_sub_has_cloud_threshold + +@Test +subroutine precip_evap_sub_has_rain_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + real(r8) :: prds_no_rain(2) + + ! If we zero out rain mass, there should be no evaporation, but + ! sublimation should not be affected. + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 0.25_r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds_no_rain) + + qric = 0._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(0._r8, pre) + @assertEqual(prds_no_rain, prds) + +end subroutine precip_evap_sub_has_rain_threshold + +@Test +subroutine precip_evap_sub_has_snow_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + real(r8) :: pre_no_snow(2) + + ! Zeroing out snow mass affects sublimation, but not evaporation. + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 0.25_r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre_no_snow, prds) + + qsic = 0._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(pre_no_snow, pre) + @assertEqual(0._r8, prds) + +end subroutine precip_evap_sub_has_snow_threshold + +@Test +subroutine precip_evap_sub_has_qvl_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + + ! Low qvl prevents rain evaporation and increases out-of-cloud humidity, + ! reducing snow sublimation. + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-5_r8 + qvi = 1.e-3_r8 + lcldm = 0.25_r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(0._r8, pre) + @assertEqual(-1.3666722193348627e-5_r8, prds, tolerance=(1.e-4_r8*mach_eps)) + +end subroutine precip_evap_sub_has_qvl_threshold + +@Test +subroutine precip_evap_sub_has_qvi_threshold() + + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), q(2), qvl(2), qvi(2) + real(r8) :: lcldm(2), precip_frac(2), arn(2), asn(2), qcic(2), qiic(2) + real(r8) :: qric(2), qsic(2), lamr(2), n0r(2), lams(2), n0s(2) + real(r8) :: pre(2), prds(2) + real(r8) :: pre_no_qvi(2) + + ! Similar to snow mass check, but this time we use supersaturation to + ! prevent snow sublimation. + t = tmelt + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + q = 5.e-4_r8 + qvl = 1.e-3_r8 + qvi = 1.e-3_r8 + lcldm = 0.25_r8 + precip_frac = 0.5_r8 + arn = ar + asn = as + qcic = 1._r8 + qiic = 1._r8 + qric = 1._r8 + qsic = 1._r8 + lamr = 10000._r8 + n0r = 3.e10_r8 + lams = 5000._r8 + n0s = 7.e10_r8 + pre = 1._r8 + prds = 1._r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre_no_qvi, prds) + + qvi = 1.e-5_r8 + + call evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, & + precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds) + + @assertEqual(pre_no_qvi, pre) + @assertEqual(0._r8, prds) + +end subroutine precip_evap_sub_has_qvi_threshold + +@Test +subroutine bergeron_snow_has_t_threshold() + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), qvl(2), qvi(2), asn(2) + real(r8) :: qcic(2), qsic(2), lams(2), n0s(2) + real(r8) :: bergs(2) + + ! Process not active above freezing. + t = 280._r8 + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + qvl = 1.e-3_r8 + qvi = 5.e-4_r8 + asn = as + qcic = 1._r8 + qsic = 1._r8 + lams = 5000._r8 + n0s = 7.e10_r8 + bergs = 1._r8 + + call bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs) + + @assertEqual(0._r8, bergs) + +end subroutine bergeron_snow_has_t_threshold + +@Test +subroutine bergeron_snow_has_qc_threshold() + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), qvl(2), qvi(2), asn(2) + real(r8) :: qcic(2), qsic(2), lams(2), n0s(2) + real(r8) :: bergs(2) + + ! Process not active above freezing. + t = 253._r8 + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + qvl = 1.e-3_r8 + qvi = 5.e-4_r8 + asn = as + qcic = 0._r8 + qsic = 1._r8 + lams = 5000._r8 + n0s = 7.e10_r8 + bergs = 1._r8 + + call bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs) + + @assertEqual(0._r8, bergs) + +end subroutine bergeron_snow_has_qc_threshold + +@Test +subroutine bergeron_snow_has_qs_threshold() + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), qvl(2), qvi(2), asn(2) + real(r8) :: qcic(2), qsic(2), lams(2), n0s(2) + real(r8) :: bergs(2) + + ! Process not active above freezing. + t = 253._r8 + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + qvl = 1.e-3_r8 + qvi = 5.e-4_r8 + asn = as + qcic = 1._r8 + qsic = 0._r8 + lams = 5000._r8 + n0s = 7.e10_r8 + bergs = 1._r8 + + call bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs) + + @assertEqual(0._r8, bergs) + +end subroutine bergeron_snow_has_qs_threshold + +@Test +subroutine bergeron_snow_is_correct() + real(r8) :: t(2), rho(2), dv(2), mu(2), sc(2), qvl(2), qvi(2), asn(2) + real(r8) :: qcic(2), qsic(2), lams(2), n0s(2) + real(r8) :: bergs(2) + + ! Process not active above freezing. + t = 253._r8 + rho = 1._r8 + dv = 2.e-6_r8 + mu = 1.e-5_r8 + sc = mu/(rho*dv) + qvl = 1.e-3_r8 + qvi = 5.e-4_r8 + asn = as + qcic = 1._r8 + qsic = 1._r8 + lams = 5000._r8 + n0s = 7.e10_r8 + bergs = 1._r8 + + call bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs) + + @assertEqual(4.4059005347141078e-5_r8, bergs, tolerance=(1.e-4*mach_eps)) + +end subroutine bergeron_snow_is_correct + +end module test_mg_processes diff --git a/test/unit/micro_mg_utils/test_mg_size_utils.pf b/test/unit/micro_mg_utils/test_mg_size_utils.pf new file mode 100644 index 0000000000..66f1033f5d --- /dev/null +++ b/test/unit/micro_mg_utils/test_mg_size_utils.pf @@ -0,0 +1,282 @@ +module test_mg_size_utils + +use pfunit_mod + +use micro_mg_utils + +! Constants we can get from the same place as the model: +use shr_const_mod, only: & + rh2o => shr_const_rwv, & + cpair => shr_const_cpdair, & + tmelt => shr_const_tkfrz, & + latvap => shr_const_latvap, & + latice => shr_const_latice + +implicit none + +! At the time of this writing, this is the hard-coded MG2 value. +real(r8), parameter :: dcs = 150.e-6_r8 + +real(r8), parameter :: mach_eps = epsilon(1._r8) + +contains + +@Before +subroutine setUp() + character(len=128) :: errstring + call micro_mg_utils_init(r8, rh2o, cpair, tmelt, latvap, latice, dcs, & + errstring) + if (trim(errstring) /= "") & + call throw("micro_mg_utils_init error: "//errstring) +end subroutine setUp + +@After +subroutine tearDown() +end subroutine tearDown + +@Test +subroutine mmr_converts_to_avg_diameter() + ! Don't really need to use units related to the model here. + ! + ! Note that for an exponential distribution with mean diameter 1/lambda, + ! the average particle volume is pi * lambda**-3. (Not to be confused + ! with the volume of a particle with the average diameter, which is six + ! times smaller.) + ! + ! Scenario: + ! In a substance of mass and volume 1, there are 2000 particles, each 3 + ! micro-units wide, of a substance 5 times as heavy as the background + ! material. + ! + ! Then the mmr is 2000 * (pi*(3e-6)**3) * 5 = 8.48e-13 + + real(r8) :: calculated_diameter + + calculated_diameter = & + avg_diameter(8.4823001646924416e-13_r8, 2000._r8, 1._r8, 5._r8) + + ! Should get the expected diameter to within an order of magnitude of + ! machine epsilon. + @assertEqual(3.e-6_r8, calculated_diameter, tolerance=(1.e-5_r8*mach_eps)) + +end subroutine mmr_converts_to_avg_diameter + +@Test +subroutine param_basic_has_q_threshold + + type(MGHydrometeorProps) :: props + + real(r8) :: qic(1), nic(1), lam(1) + + ! Simple properties object with the density of water and 3 dimensions. + props = MGHydrometeorProps(1000._r8, 3._r8) + + qic = 0._r8 + nic = 0._r8 + lam = -1._r8 + + ! For zeroed inputs, we expect a zeroed output. + call size_dist_param_basic(props, qic, nic, lam) + + @assertEqual(0._r8, lam) + +end subroutine param_basic_has_q_threshold + +@Test +subroutine param_basic_lam + + type(MGHydrometeorProps) :: props + + real(r8) :: qic(3), nic(3), lam(3), mean_masses_limited(3) + + ! Particle type with the density of water and an effective dimension of + ! 2.5, between 1 and 100 microns average size. + props = MGHydrometeorProps(1000._r8, 2.5_r8, & + lambda_bounds=[1.e4_r8, 1.e6_r8]) + + ! What we expect is that the mean particle mass (qic/nic) for a particle + ! with an exponential distribution in diameter should be: + ! + ! rho * gamma(d+1) * pi/6 * (1/lam)**d + ! + ! For a lambda of 1.e3, 1.e5, and 1.e7, the mean mass would be 5.50e-5, + ! 5.50e-10, and 5.50e-15 respectively. However the first and third cases + ! should be limited, producing mean masses of 1.740e-5 and 1.740e-12. + + qic = 55.02687259022202_r8 + nic = [1.e6_r8, 1.e11_r8, 1.e16_r8] + lam = -1._r8 + + call size_dist_param_basic(props, qic, nic, lam) + + ! Check limited lambda. + @assertEqual([1.e4_r8, 1.e5_r8, 1.e6_r8], lam, tolerance=(1.e7_r8*mach_eps)) + + ! Check that nic was limited as well. + mean_masses_limited = & + [1.7401024990099086e-7_r8, 5.502687259022204e-10_r8, & + 1.7401024990099086e-12_r8] + @assertEqual(mean_masses_limited, qic/nic, tolerance=(1.e-6_r8*mach_eps)) + +end subroutine param_basic_lam + +@Test +subroutine param_basic_lam_mass_lim + + type(MGHydrometeorProps) :: props + + real(r8) :: qic(1), nic(1), lam(1) + + ! Particle type with the density of water and an effective dimension of + ! 2.5, limiting mean mass to above 1.e-20. The lambda bounds are made + ! ineffective to avoid interference from them. + props = MGHydrometeorProps(1000._r8, 2.5_r8, & + lambda_bounds=[0._r8, huge(1._r8)], min_mean_mass=1.e-20_r8) + + qic = 1._r8 + nic = 1.e21_r8 + + call size_dist_param_basic(props, qic, nic, lam) + + ! Check that nic was limited correctly. + @assertEqual(1.e20_r8, nic, tolerance=(1.e21_r8*mach_eps)) + +end subroutine param_basic_lam_mass_lim + +@Test +subroutine param_basic_n0 + + type(MGHydrometeorProps) :: props + + real(r8) :: qic(1), nic(1), lam_alone(1), lam(1), n0(1) + + ! Particle type with the density of water and an effective dimension of + ! 2.5, between 1 and 100 microns average size. + props = MGHydrometeorProps(1000._r8, 2.5_r8, & + lambda_bounds=[1.e4_r8, 1.e6_r8]) + + qic = 55.02687259022202_r8 + nic = 1.e11_r8 + lam_alone = -1._r8 + lam = -1._r8 + n0 = -1._r8 + + ! First, call without optional argument. + call size_dist_param_basic(props, qic, nic, lam_alone) + + ! Now, again with n0. + call size_dist_param_basic(props, qic, nic, lam, n0) + + ! First, lambda should be the same from both calls. + @assertEqual(lam_alone, lam, tolerance=(1.e7_r8*mach_eps)) + + ! Second, n0 should match nic*lam + @assertEqual(nic*lam, n0, tolerance=(1.e18_r8*mach_eps)) + +end subroutine param_basic_n0 + +@Test +subroutine param_liq_has_q_threshold + + type(MGHydrometeorProps) :: props + + real(r8) :: qcic(1), ncic(1), rho(1), pgam(1), lamc(1) + + ! Simple properties object with the density of water and 3 dimensions. + props = MGHydrometeorProps(1000._r8, 3._r8) + + qcic = 0._r8 + ncic = 0._r8 + rho = 0._r8 + pgam = -1._r8 + lamc = -1._r8 + + ! For zeroed inputs, we expect a zeroed output (and the sentinel value + ! pgam = -100). + call size_dist_param_liq(props, qcic, ncic, rho, pgam, lamc) + + @assertEqual(-100._r8, pgam) + @assertEqual(0._r8, lamc) + +end subroutine param_liq_has_q_threshold + +! Note a slightly unusual formulation of the gamma distribution: +! +! Gamma(x; pgam, lamc) = +! lamc**(pgam+1) * x**pgam * exp(-x*lamc) / gamma(pgam+1) +! +! For a given pgam, mean particle mass then becomes: +! +! rho * (gamma(d+pgam+1)/gamma(pgam+1)) * pi/6 * (1/lam)**d + +@Test +subroutine param_liq_pgam + + type(MGHydrometeorProps) :: props + + real(r8) :: qcic(2), ncic(2), rho(2), pgam(2), lamc(2) + + ! Particle with the density of water and an effective dimension of 2.5. + props = MGHydrometeorProps(1000._r8, 2.5_r8) + + ! We are only testing pgam here, and only ncic and rho matter for that + ! (except qcic must be positive to run at all). To calculate pgam, this + ! empirical fit is used: + ! + ! 1/sqrt(pgam + 1) = 0.0005714*(ncic*rho*1.e-6) + 0.2714 + ! + ! pgam is also limited to be greater than 2. It can never grow above + ! ~12.58 for any positive value of ncic*rho, so an upper bound is + ! unnecessary. + ! + ! We want to pick ncic*rho that would generate the values 1 and 3, to + ! test the standard case and limiter. Arbitrarily picking rho=4, the + ! following should work: + qcic = 1.e-3_r8 + ncic = [1.906312483315311e8_r8, 1.0001750087504376e8_r8] + rho = 4._r8 + pgam = -1._r8 + lamc = -1._r8 + + call size_dist_param_liq(props, qcic, ncic, rho, pgam, lamc) + + @assertEqual([2._r8, 3._r8], pgam, tolerance=10._r8*mach_eps) + +end subroutine param_liq_pgam + +@Test +subroutine param_liq_lamc + + type(MGHydrometeorProps) :: props + + real(r8) :: qcic(3), ncic(3), rho(3), pgam(3), lamc(3) + + ! Particle with the density of water and an effective dimension of 2.5. + props = MGHydrometeorProps(1000._r8, 2.5_r8) + + ! For liquid, the limiter on lamc is (pgam+1)/[50.e-6, 2.e-6]. + ! We can rig this using ncic/rho so that pgam = 3. The limits on lambda + ! are then [8.e4, 2.e6], so we want inputs that would generate 1.e3, + ! 1.e5, and 1.e7 again. + ! + ! As mentioned in comments above: + ! qcic/ncic = rho * (gamma(d+pgam+1)/gamma(pgam+1)) * pi/6 * (1/lam)**d + ! + ! We then need qcic/ncic = 7.944504730213308 * [1.e-4, 1.e-9, 1.e-14] + ! + ! The simplest solution is to set ncic = 1: + qcic = 7.944504730213308 * [1.e-4, 1.e-9, 1.e-14] + ncic = 1._r8 + rho = 4.0007000350017506e8_r8 + pgam = -1._r8 + lamc = -1._r8 + + call size_dist_param_liq(props, qcic, ncic, rho, pgam, lamc) + + ! Gamma is only correct up to ~1.e-8 in some cases, so don't use machine + ! epsilon. + @assertEqual([8.e4_r8, 1.e5_r8, 2.e6_r8], lamc, tolerance=1.e7_r8*1.e-8_r8) + +end subroutine param_liq_lamc + +end module test_mg_size_utils diff --git a/test/unit/vdiff_lu_solver/CMakeLists.txt b/test/unit/vdiff_lu_solver/CMakeLists.txt new file mode 100644 index 0000000000..d3a58f3ae7 --- /dev/null +++ b/test/unit/vdiff_lu_solver/CMakeLists.txt @@ -0,0 +1,14 @@ +# Local pFUnit files. +set(pf_sources + test_fd_solver.pf test_fv_solver.pf) + +# Sources to test. +set(sources_needed + coords_1d.F90 linear_1d_operators.F90 vdiff_lu_solver.F90) +extract_sources("${sources_needed}" "${cam_sources}" test_sources) + +# Do source preprocessing and add the executable. +create_pFUnit_test(vdiff_lu_solver vdiff_lu_solver_exe "${pf_sources}" + "${test_sources}") + +target_link_libraries(vdiff_lu_solver_exe csm_share) diff --git a/test/unit/vdiff_lu_solver/test_fd_solver.pf b/test/unit/vdiff_lu_solver/test_fd_solver.pf new file mode 100644 index 0000000000..8b0d7e0dc9 --- /dev/null +++ b/test/unit/vdiff_lu_solver/test_fd_solver.pf @@ -0,0 +1,272 @@ +module test_fd_solver + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_const_mod, only: pi => shr_const_pi + +use linear_1d_operators, only: TriDiagDecomp +use vdiff_lu_solver, only: vd_lu_decomp + +implicit none + +! This tests the differential equation solver by actually setting up small +! systems to solve via implicit Euler (for a single time step). The error +! bounds are based on very rough heuristics, and may not be as tight as +! they could be. + +! Grid size used by these tests. +integer, parameter :: n = 101 + +! The grid itself (mid-points and distances between points). +real(r8) :: x(1,n), deltas(1,n-1) + +contains + +@Before +subroutine setUp() + + integer :: i + + ! Grid is n points between 0 and 1. + x(1,:) = [( real(i, r8) / real(n-1, r8), i = 0, n-1 )] + ! Introduce nonuniformity. + x = x*x + deltas = x(:,2:) - x(:,:n-1) + +end subroutine setUp + +@After +subroutine tearDown() + + ! Fight pollution! + x = 0._r8 + deltas = 0._r8 + +end subroutine tearDown + +! This test sets up a scenario where the concentration of a tracer decays +! exponentially at each grid point, without transport. +@Test +subroutine solves_decay() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q(1,n) + ! Array to evolve. + real(r8) :: q(1,n), q_expected(1,n) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is dq/dt = -q + coef_q = -1._r8 + + dt = 1._r8 + + ! Decomposition + diff_decomp = vd_lu_decomp(dt, deltas, coef_q=coef_q) + + ! We are seeking the solution q(x,t) = e^(-t) * cos(pi*x) + ! Set q for t = 0. + q = cos(pi*x) + ! Expected result after one step. + q_expected = cos(pi*x)*exp(-dt) + + call diff_decomp%left_div(q) + + ! Max error in this case is (1/2 - 1/e)*dt*maxval(x) which is + ! ~dt*maxval(x)/6. + @assertEqual(q_expected, q, tolerance=dt*maxval(x)/6._r8) + +end subroutine solves_decay + +! This test sets up a scenario where we only solve the 1-D advection +! equation. It deliberately uses boundary conditions where the tendency is +! zero; a separate test will test the boundaries. +! +! Note that this method (using central differencing) does not actually +! converge on the right answer. We don't really care, since the point is +! just to ensure that it's roughly OK for a single time-step. Real uses of +! this solver should always be dominated by a diffusive term. +@Test +subroutine solves_advection() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_d(1,n) + ! Array to evolve. + real(r8) :: q(1,n), q_expected(1,n) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is dq/dt = -dq/dx + coef_q_d = -1._r8 + + ! Set time based (roughly) on CFL. + dt = minval(deltas) / maxval(abs(coef_q_d)) + + ! Decomposition + diff_decomp = vd_lu_decomp(dt, deltas, coef_q_d=coef_q_d) + + ! We are seeking the solution q(x,t) = cos(pi*(x-t)) + ! Set q for t = 0. + q = cos(pi*x) + ! Expected result after one step. + q_expected = cos(pi*(x-dt)) + + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=dt) + +end subroutine solves_advection + +! This test sets up a scenario where we only solve the 1-D heat equation. +! It deliberately uses boundary conditions where the tendency is zero; a +! separate test will test the boundaries. +@Test +subroutine solves_heat() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_d2(1,n) + ! Array to evolve. + real(r8) :: q(1,n), q_expected(1,n) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is dq/dt = (d^2 q)/dx^2 + coef_q_d2 = 1._r8 + + ! Set time based (roughly) on CFL. + dt = minval(deltas)**2 / maxval(abs(coef_q_d2)) + + ! Decomposition + diff_decomp = vd_lu_decomp(dt, deltas, coef_q_d2=coef_q_d2) + + ! We are seeking the solution: + ! q(x,t) = sin(pi*x) * exp(-pi^2*t) - (1/3) * sin(3*pi*x) * exp(-9*pi^2*t) + ! This solution is constant at the boundaries, and it has no heat flux + ! through the boundary at t=0, so it's a good choice for testing the + ! default (zero-flux) boundary condition. + + ! Set q for t = 0. + q = sin(pi*x) - (1._r8/3._r8)*sin(3._r8*pi*x) + ! Expected result after one step. + q_expected = sin(pi*x)*exp(-pi*pi*dt) - & + (1._r8/3._r8)*sin(3._r8*pi*x)*exp(-9._r8*pi*pi*dt) + + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=2._r8*dt) + +end subroutine solves_heat + +! This test sets up a scenario where we only solve the 1-D heat equation. +! A flux is prescribed at the boundary. +@Test +subroutine solves_heat_with_flux() + + use linear_1d_operators, only: BoundaryCond, BoundaryFlux + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_d2(1,n) + ! Array to evolve. + real(r8) :: q(1,n), q_expected(1,n) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + type(BoundaryCond) :: upper_cond, lower_cond + + ! Equation to solve is dq/dt = (d^2 q)/dx^2 + coef_q_d2 = 1._r8 + + ! Set time based (roughly) on CFL. + dt = minval(deltas)**2 / maxval(abs(coef_q_d2)) + + ! Decomposition + diff_decomp = vd_lu_decomp(dt, deltas, coef_q_d2=coef_q_d2) + + ! We are seeking the solution: q(x,t) = sin(pi*x) * exp(-pi^2*t) + ! To adhere to this solution, we need to specify information about the + ! boundary fluxes. + ! Set q for t = 0. + q = sin(pi*x) + ! Expected result after one step. + q_expected = q*exp(-pi*pi*dt) + + ! Boundary flux for t=0 is -pi on the top and the bottom. + upper_cond = BoundaryFlux(spread(-pi, 1, 1), dt, deltas(:,1)) + lower_cond = BoundaryFlux(spread(-pi, 1, 1), dt, deltas(:,n-1)) + call diff_decomp%left_div(q, upper_cond, lower_cond) + + @assertEqual(q_expected, q, tolerance=dt) + +end subroutine solves_heat_with_flux + +! This test sets up a scenario where we only solve the 1-D heat equation. +! An extra layer with a specified value is provided for the boundary +! condition. +@Test +subroutine solves_heat_with_data() + + use linear_1d_operators, only: BoundaryType, BoundaryFixedLayer, & + BoundaryCond, BoundaryData + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_d2(1,n) + ! Array to evolve. + real(r8) :: q(1,n), q_expected(1,n) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + type(BoundaryType) :: upper_bndry, lower_bndry + type(BoundaryCond) :: upper_cond, lower_cond + + real(r8) :: tmp_bndry_data(1) + + ! Equation to solve is dq/dt = (d^2 q)/dx^2 + coef_q_d2 = 1._r8 + + ! Set time based (roughly) on CFL. + dt = minval(deltas)**2 / maxval(abs(coef_q_d2)) + + ! Fixed boundary layers. + tmp_bndry_data = deltas(:,1) + upper_bndry = BoundaryFixedLayer(tmp_bndry_data) + tmp_bndry_data = deltas(:,n-1) + lower_bndry = BoundaryFixedLayer(tmp_bndry_data) + + ! Decomposition + diff_decomp = vd_lu_decomp(dt, deltas, coef_q_d2=coef_q_d2, & + upper_bndry=upper_bndry, lower_bndry=lower_bndry) + + ! We are seeking the solution: q(x,t) = sin(pi*x) * exp(-pi^2*t) + ! To adhere to this solution, we need to specify information about the + ! boundary fluxes. + ! Set q for t = 0. + q = sin(pi*x) + ! Expected result after one step. + q_expected = q*exp(-pi*pi*dt) + + ! Boundary condition such that the end points should stay at 0. + upper_cond = BoundaryData(-q(:,2)) + lower_cond = BoundaryData(-q(:,n-1)) + call diff_decomp%left_div(q, upper_cond, lower_cond) + + @assertEqual(q_expected, q, tolerance=dt) + +end subroutine solves_heat_with_data + +end module test_fd_solver diff --git a/test/unit/vdiff_lu_solver/test_fv_solver.pf b/test/unit/vdiff_lu_solver/test_fv_solver.pf new file mode 100644 index 0000000000..c92141bf15 --- /dev/null +++ b/test/unit/vdiff_lu_solver/test_fv_solver.pf @@ -0,0 +1,306 @@ +module test_fv_solver + +use pfunit_mod + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_const_mod, only: pi => shr_const_pi +use coords_1d, only: Coords1D + +use linear_1d_operators, only: TriDiagDecomp +use vdiff_lu_solver, only: fin_vol_lu_decomp + +implicit none + +! This tests the differential equation solver by actually setting up small +! systems to solve via implicit Euler (for a single time step). The error +! bounds are based on very rough heuristics, and may not be as tight as +! they could be. + +! Grid parameters. +type(Coords1D) :: coords + +contains + +@Before +subroutine setUp() + + ! Grid size used by these tests. + integer, parameter :: n = 101 + + real(r8) :: ifc(1,n) + + integer :: i + + ! Grid is n points between -1 and 1. + ifc(1,:) = [( -1._r8 + 2._r8 * real(i, r8) / real(n-1, r8), i = 0, n-1 )] + ! Introduce nonuniformity. + ifc = sign(ifc*ifc, ifc) + + coords = Coords1D(ifc) + +end subroutine setUp + +@After +subroutine tearDown() + + call coords%finalize() + +end subroutine tearDown + +! This test compares a finite volume solution to a simple diffusion +! equation with a known solution. The boundary flux is zero in this case. +@Test +subroutine solves_diffusion() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_diff(1,coords%d+1) + ! Array to evolve. + real(r8) :: q(1,coords%d), q_expected(1,coords%d) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is dq/dt = d/dx ((1-x^2) * dq/dx) + ! We can leverage the fact that the Legendre polynomials experience a + ! simple exponential decay for this equation. + coef_q_diff = 1._r8 - coords%ifc*coords%ifc + + ! Set time based (roughly) on CFL. + dt = minval(coords%del)**2 / maxval(abs(coef_q_diff)) + + ! Set q for t = 0. + ! One analytic solution is: + ! q(x,t) = e^(-6t) * (3x^2-1)/2 + ! However we want grid-cell average, which is: + ! q_bar(x_m,d,t) = q(x_m,t) + e^(-6t)*(d^2)/8 + ! where x_m is the midpoint of the cell, and d is the cell width. + q = (3._r8*coords%mid*coords%mid - 1._r8)/2._r8 + q = q + coords%del*coords%del/8._r8 + + ! Expected result. + q_expected = q * exp(-6._r8*dt) + + ! Decompose and solve diffusion case. + diff_decomp = fin_vol_lu_decomp(dt, coords, coef_q_diff=coef_q_diff) + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=1.5_r8*dt) + +end subroutine solves_diffusion + +! This test compares a finite volume solution to a known solution for the +! diffusion-advection equation. The boundary flux is zero in this case. +@Test +subroutine solves_diffusion_advection() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_diff(1,coords%d+1), coef_q_adv(1,coords%d+1) + ! Array to evolve. + real(r8) :: q(1,coords%d), q_expected(1,coords%d) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is dq/dt = d/dx (dq/dx - x*q) + ! The Hermite polynomials experience an exponential decay over time under + ! this PDE. + coef_q_diff = 1._r8 + coef_q_adv = coords%ifc + + ! Set time based (roughly) on CFL. + dt = minval(coords%del)**2 / maxval(abs(coef_q_diff)) + + ! Set q for t = 0. + ! A solution is based on the first Hermite polynomial: + ! q(x,t) = e^(-2t) * x + ! Since this is linear, the grid cell average is just the midpoint value. + q = coords%mid + + ! Expected result. + q_expected = q * exp(-2._r8*dt) + + ! Decompose and solve diffusion case. + diff_decomp = fin_vol_lu_decomp(dt, coords, coef_q_diff=coef_q_diff, & + coef_q_adv=coef_q_adv) + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=dt) + +end subroutine solves_diffusion_advection + +! This test solves a diffusion/advection equation with data for a fixed- +! concentration boundary layer. +@Test +subroutine solves_diffusion_advection_boundary() + + use linear_1d_operators, only: BoundaryType, BoundaryFixedLayer, & + BoundaryCond, BoundaryData + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_diff(1,coords%d+1), coef_q_adv(1,coords%d+1) + ! Array to evolve. + real(r8) :: q(1,coords%d), q_expected(1,coords%d) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + type(BoundaryType) :: upper_bndry, lower_bndry + type(BoundaryCond) :: upper_cond, lower_cond + + ! Use the edge points as the boundary layers. + upper_bndry = BoundaryFixedLayer([0._r8]) + lower_bndry = BoundaryFixedLayer([0._r8]) + + ! Equation to solve is dq/dt = d/dx (dq/dx - x*q) + ! The Hermite polynomials experience an exponential decay over time under + ! this PDE. + coef_q_diff = 1._r8 + coef_q_adv = coords%ifc + + ! Set time based (roughly) on CFL. + dt = minval(coords%del)**2 / maxval(abs(coef_q_diff)) + + ! Set q for t = 0. + ! A solution is based on the second Hermite polynomial: + ! q(x,t) = e^(-3t) * (x^2 - 1) + ! The grid cell average is: + ! q_bar(x_m, d, t) = q(x_m, t) + e^(-3t)*(d^2)/12 + ! where x_m is the midpoint of the cell, and d is the cell width. + q = coords%mid*coords%mid - 1._r8 + q = q + coords%del*coords%del/12._r8 + + ! Set edge layers from q. These points are fixed at 0. + upper_cond = BoundaryData([0._r8]) + lower_cond = BoundaryData([0._r8]) + + ! Expected result. + q_expected = q * exp(-3._r8*dt) + + ! Decompose and solve diffusion case (interior points only). + diff_decomp = fin_vol_lu_decomp(dt, coords, & + coef_q_diff=coef_q_diff, coef_q_adv=coef_q_adv, & + upper_bndry=upper_bndry, lower_bndry=lower_bndry) + call diff_decomp%left_div(q, l_cond=upper_cond, & + r_cond=lower_cond) + + @assertEqual(q_expected, q, tolerance=1.5_r8*dt) + +end subroutine solves_diffusion_advection_boundary + +! This test solves the case where there is a space-dependent weighting +! function on the process rate. +@Test +subroutine solves_diffusion_with_weighting() + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_diff(1,coords%d+1) + real(r8) :: coef_q_weight(1,coords%d) + ! Array to evolve. + real(r8) :: q(1,coords%d), q_expected(1,coords%d) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: diff_decomp + + ! Equation to solve is exp(-x^2/2)dq/dt = d/dx (exp(-x^2/2) * dq/dx) + ! We can leverage the fact that the Hermite polynomials experience a + ! simple exponential decay for this equation. + coef_q_diff = exp(-coords%ifc*coords%ifc/2._r8) + + ! Cheat a bit, assuming that the average of q*e^(-x^2/2) is approximately + ! the product of q times the midpoint value of the gaussian part. + coef_q_weight = exp(-coords%mid*coords%mid/2._r8) + + ! Set time based (roughly) on CFL. + dt = minval(coords%del)**2 / maxval(abs(coef_q_diff)) + + ! Set q for t = 0. + ! One analytic solution is: + ! q(x,t) = e^(-3t) * (x^3 - 3*x) + ! However we want grid-cell average, which is: + ! q_bar(x_m,d,t) = q(x_m,t) + e^(-3t)*(d^2*x)/4 + ! where x_m is the midpoint of the cell, and d is the cell width. + q = ((coords%mid*coords%mid) - 3._r8)*coords%mid + q = q + coords%del*coords%del*coords%mid/4._r8 + + ! Expected result. + q_expected = q * exp(-3._r8*dt) + + ! Decompose and solve diffusion case. + diff_decomp = fin_vol_lu_decomp(dt, coords, coef_q_diff=coef_q_diff, & + coef_q_weight=coef_q_weight) + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=dt) + +end subroutine solves_diffusion_with_weighting + +! Grafting two different decompositions together should work as if a single +! combined operator had been decomposed. +! +! This test is mostly the same as "solves_diffusion". +@Test +subroutine solves_diffusion_with_grafting() + + use linear_1d_operators, only: BoundaryType, BoundaryFixedLayer + + ! Graft point. + integer, parameter :: gp = 30 + + ! Time step. + real(r8) :: dt + ! PDE coefficients. + real(r8) :: coef_q_diff(1,coords%d+1), coef_upper(1,gp+1) + ! Array to evolve. + real(r8) :: q(1,coords%d), q_expected(1,coords%d) + + ! Decomposed diffusion matrix. + type(TriDiagDecomp) :: lower_decomp, diff_decomp + type(BoundaryType) :: graft_bndry + + ! Equation to solve is dq/dt = d/dx ((1-x^2) * dq/dx) + ! We can leverage the fact that the Legendre polynomials experience a + ! simple exponential decay for this equation. + ! + ! We split the coefficient between the operator that is "grafted" onto, + ! and a part that overwrites the upper region. + coef_upper = 1._r8 - coords%ifc(:,:gp+1)*coords%ifc(:,:gp+1) + coef_q_diff(:,:gp) = 0._r8 + coef_q_diff(:,gp+1:) = 1._r8 - coords%ifc(:,gp+1:)*coords%ifc(:,gp+1:) + + ! Edge layer for the boundary. + graft_bndry = BoundaryFixedLayer(coords%dst(:,gp)) + + ! Set time based (roughly) on CFL. + dt = minval(coords%del)**2 / maxval(abs(coef_q_diff)) + + ! Set q for t = 0. + ! One analytic solution is: + ! q(x,t) = e^(-6t) * (3x^2-1)/2 + ! However we want grid-cell average, which is: + ! q_bar(x_m,d,t) = q(x_m,t) + e^(-6t)*(d^2)/8 + ! where x_m is the midpoint of the cell, and d is the cell width. + q = (3._r8*coords%mid*coords%mid - 1._r8)/2._r8 + q = q + coords%del*coords%del/8._r8 + + ! Expected result. + q_expected = q * exp(-6._r8*dt) + + ! Decompose and solve diffusion case. + lower_decomp = fin_vol_lu_decomp(dt, coords, coef_q_diff=coef_q_diff) + diff_decomp = fin_vol_lu_decomp(dt, coords%section([1, 1], [1, gp]), & + coef_q_diff=coef_upper, lower_bndry=graft_bndry, & + graft_decomp=lower_decomp) + call diff_decomp%left_div(q) + + @assertEqual(q_expected, q, tolerance=1.5_r8*dt) + +end subroutine solves_diffusion_with_grafting + +end module test_fv_solver diff --git a/tools/README b/tools/README new file mode 100644 index 0000000000..50c744cb85 --- /dev/null +++ b/tools/README @@ -0,0 +1,45 @@ +Filename: cam/tools/README +Original Author: Erik Kluzek +Date: Apr/30/1998 +Description: Description of the cam/tools module. + (Various off-line tools that operate on) + (CAM input and output datasets) +Version-Control: + +CVS: $Id$ +CVS: $Source$ +CVS: $Name$ + +############################################################################ + +I. Description of cam/tools. + +cam/tools contains various off-line programs that operate on CAM input +and output datasets. Each of these tools requires netCDF3.x.x +(http://www.unidata.ucar.edu/) or beyond. It is assumed that netCDF +has been installed under/usr/local. If installed elsewhere, the +environment variables $INC_NETCDF and $LIB_NETCDF must be set to point +to the location of the netCDF include files and library, respectively. + +############################################################################ + +II. Description of tools contained in this module. + +1.) interpic: Horizontally and/or vertically interpolates an + initial condition dataset to a user-specified + resolution. + +2.) definesurf: Defines CAM surface fields SGH, PHIS, and ORO on + an initial condition dataset. Input comes from a + high resolution topography dataset. + +3.) mkrgrid: Tool to translate datafiles from full to + reduced grid or vica versa. Reduced grid files + can be converted to full-grid for plotting + and full grid files can be converted to + reduced for a reduced grid simulation. + +4.) mkrgridsst: Tool to translate SST datafiles from full to + reduced grid. + +############################################################################ diff --git a/tools/definehires/Makefile b/tools/definehires/Makefile new file mode 100644 index 0000000000..ef34446982 --- /dev/null +++ b/tools/definehires/Makefile @@ -0,0 +1,127 @@ +# Makefile to build definesurf on various platforms +# Note: If netcdf library is not built in the standard location, you must set the environment +# variables INC_NETCDF and LIB_NETCDF + +EXEDIR = . +EXENAME = definehires +RM = rm + +.SUFFIXES: +.SUFFIXES: .F90 .o + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +# Architecture-specific flags and rules +# +#------------------------------------------------------------------------ +# Cray +#------------------------------------------------------------------------ + +ifeq ($(UNAMEM),CRAY) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) -64 -mips4 -bytereclen -s -r8 +LDFLAGS = -64 -L/usr/local/lib64/r4i4 -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# SUN +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),SunOS) +FC = f90 +FFLAGS = -c -stackvar -f -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) -qsuffix=f=F90 $< +endif + +#------------------------------------------------------------------------ +# OSF1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),OSF1) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) +ifeq ($(USER_FC),$(null)) +FC := pgf90 +FFLAGS = -c -I$(INC_NETCDF) -fast -r8 -byteswapio +else +FC := $(USER_FC) +endif +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + +ifeq ($(FC),lf95) + FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) + ifeq ($(DEBUG),TRUE) + #TBH: this works FFLAGS += -g --chk --pca + #TBH: this FAILS FFLAGS += -g --chk a,e,s,u,x --pca + FFLAGS += -g --chk a,e,s,u --pca + else + FFLAGS += -O + endif +endif + +.F90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := gtopo30_to_10min.o shr_kind_mod.o + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +gtopo30_to_10min.o: shr_kind_mod.o diff --git a/tools/definehires/README b/tools/definehires/README new file mode 100644 index 0000000000..5834c3961a --- /dev/null +++ b/tools/definehires/README @@ -0,0 +1,114 @@ +*** Lahey compiler note If you build definehires with lf95, you must +*** execute with the -T runtime option, to get the proper byte +*** ordering on input. Otherwise, you get nonsense. The GTOPO30 input +*** files are binary, with "bigendian" ordering. +*** definesurf -Wl,-T + +Running gnumake in this directory will create an executable named +"definehires". Its function is to produce a 10-minute topography +dataset from a USGS 30-second topographic dataset. The 30-second +dataset contains only a height field. The 10-minute dataset contains + height field, a binary land mask, and a fractional land mask. + +Ocean points are indicated in the 30-second dataset by a missing data +flag and are assumed to have elevation 0m. However, the Caspian Sea +is not flagged as ocean. The definehires program generates a Caspian +Sea based on elevation, and reports these points as ocean while +generating the 10-minute dataset. This is done through three calls to +the new routine expand_sea. + +The 30-second dataset needed by definehires can be obtained from the +following USGS web site: + +http://edcdaac.usgs.gov/gtopo30/gtopo30.asp + +For each tile in the dataset, both the *.DEM and *.HDR files must be +present in the directory from which definehires is run. On NCAR +machines, this may be accomplished by repeating the following snippet +from a user csh or tcsh shell. + +>> foreach temp ( /fs/cgd/csm/inputdata/atm/cam2/gtopo30data/* ) +foreach? ln -s $temp +foreach? end + +Once the appropriate data files are in place, simply type: +./definehires + +This will produce a new 10-minute high-resolution dataset named +topo_gtopo30_10min.nc + + + +------------------------------------- +Feb 01, 2005 +------------------------------------- + +------------------------------------- +*********** definehires ************* +------------------------------------- + +The GTOPO30 30" is converted to a 10' dataset using definehires + Originally by Jiundar Chern (jchern@dao.gsfc.nasa.gov), + updated by Jim McCaa (jmccaa@ucar.edu) + updated by B.A. Boville + +./definehires generates file "topo_gtopo30_10min.nc" containing 5 variables + lon dimension variable of longitudes + lat dimension variable of latitudes + variance variance of 30" height w.r.t. 10' grid + htopo average terrain height on 10' grid + landfract land fraction on 10' grid, + cells are either land or ocean on 30" grid + Caspian sea is identified as ocean, but has nonzero height + +The original GTOPO30 files contain only elevation, with a flag for +ocean points (NODATA=-9999). The Caspian Sea is not connected to the +oceans and is not at sea level. Definehires identifies the Caspian Sea +in the 30" data using an algorithm based on elevation. Therefore, +the land fraction reflects the presence of the Caspian and the +elevation is nonzero. + +method: + + Subroutine expand_sea is called 3 times, once for each GTOPO30 tile + which contains part of the Caspian. The arguments include the x,y + indices of a start point which is known to be in the Caspian. These + 3 points had to identified by hand. + + 1. the start point is flagged by + adding NODATA + NODATA to the original height + setting a flag true for the block of surrounding points: + (startx-1:startx+1,starty-1:starty+1) + + 2. find points with the same elevation as the start point and whose + flag is true. Flag them the same way as the start point. + + This provides an expanding mask of potential Caspian points, which + are flagged true, and an expanding region of actual Caspian points + which are flagged with the original elavation + NODATA + NODATA. + + Subroutine avg is called to compute the area weighted average and + land fraction of the 30" data with respect to the 10' grid. The + weighting accounts for the area change with latitude. Points with + elavation = NODATA are given elevation = 0 and land fraction = + 0. Caspian points (elevation < NODATA) are given their original + elevation (elevation - NODATA - NODATA) and land fraction = 0. + + The variance of the 30" height data with respect to the 10' average + is computed without area weighting. + +Note on method. The Caspian terrain height flag is exact because the +height is an integer. However, I would have preferred to + + Convert the height of ocean points from NODATA to ZERO and make a + land fraction array with 0. or 1.. This could be done with a + subroutine find_ocn. + + Then the Caspian points would retain their original elevations and + also get land fraction 0 in find_caspian (instead of + expand_sea). Still called for only the 3 tiles. + + Subroutine avg would not have to recognize anything special about + Caspian points. + + diff --git a/tools/definehires/gtopo30_to_10min.F90 b/tools/definehires/gtopo30_to_10min.F90 new file mode 100644 index 0000000000..50ccae5c2e --- /dev/null +++ b/tools/definehires/gtopo30_to_10min.F90 @@ -0,0 +1,721 @@ +! +! DATE CODED: Oct 17, 2000 +! DESCRIPTION: This program reads USGS 30-sec terrain dataset in 33 tiles and converts +! them to 10-min resolution global dataset in one single NetCDF file. +! +! Author: Jiundar Chern (jchern@dao.gsfc.nasa.gov) +! +! ** Modified November, 2003 *** +! This code has been modified by Jim McCaa (jmccaa@ucar.edu) for use at NCAR. +! In particular: +! 1) Paths and compiler options have been changed. +! 2) The code now generates a Caspian Sea based on elevation, and reports these points +! as ocean. This is done through three calls to the new routine expand_sea. +! +! ** Modified February 4, 2005 B.A. Boville *** +! +! ROUTINES CALLED: +! netcdf routines +! +! COMPILING: +! +! NCAR SGI (chinookfe) f90 -I/usr/local/include -O -64 -mips4 -bytereclen -s +! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/usr/local/lib64/r4i4 -lnetcdf -r8 + +! NASA DAO SGI: f90 -I/ford1/local/IRIX64/netcdf/include -O -64 -mips4 -bytereclen -s +! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/ford1/local/IRIX64/netcdf/lib -lnetcdf -r8 + + program convterr + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This program converts USGS 30-sec terrain data set to 10-min resolution +! terrain data set. +! + implicit none +! + integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset + integer, parameter :: im10 = 2160 ! total grids in x direction of 10-min global dataset + integer, parameter :: jm10 = 1080 ! total grids in y direction of 10-min global dataset + real(r8), parameter :: dx30s = 1.0/120.0 ! space interval for 30-sec data (in degree) + real(r8), parameter :: dx10m = 1.0/6.0 ! space interval for 10-min data (in degree) + + character (len=7) :: nmtile(ntile) ! name of each tile + integer :: ncols,nrows ! number of columns and rows for 30-sec tile + integer :: nodata ! integer for ocean point + integer :: ncol10,nrow10 ! number of columns and rows for 10-min tile + real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile + real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile + real(r8):: lon1_10m ! longitude at the center of grid (1,1) in the 10-min global data + real(r8):: lat1_10m ! latitude at the center of grid (1,1) in the 10-min global data + real(r8):: lonsw10 ! longitude at the center of southwest corner cell in the 10-min tile + real(r8):: latsw10 ! latitude at the center of southwest corner cell in the 10-min tile + integer :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile in the global grid + real(r8), dimension(im10,jm10) :: terr ! global 10-min terrain data + real(r8), dimension(im10,jm10) :: variance ! global 10-min variance of elevation + real(r8), dimension(im10,jm10) :: land_fraction !global 10-min land fraction + + integer :: alloc_error,dealloc_error + integer :: i,j,n ! index + integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile + real(r8), allocatable, dimension(:,:) :: terr10m ! terrain data for 10-min tile + real(r8), allocatable, dimension(:,:) :: psea10m ! percentage of ocaen for 10-min tile + real(r8), allocatable, dimension(:,:) :: var10m ! variance of 30-sec elevations for 10-min tile +! + lat1_10m=-90.0 + 0.5 * dx10m + lon1_10m=0.5*dx10m +! +! Initialize each tile name +! + nmtile(1) = 'W180N90' + nmtile(2) = 'W140N90' + nmtile(3) = 'W100N90' + nmtile(4) = 'W060N90' + nmtile(5) = 'W020N90' + nmtile(6) = 'E020N90' + nmtile(7) = 'E060N90' + nmtile(8) = 'E100N90' + nmtile(9) = 'E140N90' + + nmtile(10) = 'W180N40' + nmtile(11) = 'W140N40' + nmtile(12) = 'W100N40' + nmtile(13) = 'W060N40' + nmtile(14) = 'W020N40' + nmtile(15) = 'E020N40' + nmtile(16) = 'E060N40' + nmtile(17) = 'E100N40' + nmtile(18) = 'E140N40' + + nmtile(19) = 'W180S10' + nmtile(20) = 'W140S10' + nmtile(21) = 'W100S10' + nmtile(22) = 'W060S10' + nmtile(23) = 'W020S10' + nmtile(24) = 'E020S10' + nmtile(25) = 'E060S10' + nmtile(26) = 'E100S10' + nmtile(27) = 'E140S10' + + nmtile(28) = 'W180S60' + nmtile(29) = 'W120S60' + nmtile(30) = 'W060S60' + nmtile(31) = 'W000S60' + nmtile(32) = 'E060S60' + nmtile(33) = 'E120S60' + + do j = 1, jm10 + do i = 1, im10 + terr(i,j) = -9999.0 + variance(i,j) = -9999.0 + land_fraction(i,j) = -9999.0 + end do + end do + + do n = 1,ntile +! +! Read header for each tile +! + call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) + +! +! Allocate space for array iterr +! + allocate ( iterr(ncols,nrows),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for iterr' + stop + end if +! +! Read terr data for each tile +! + call rdterr(nmtile(n),nrows,ncols,iterr) +! +! Allocate space for arrays terr10m and psea10m +! + nrow10 =nrows*dx30s/dx10m + ncol10 =ncols*dx30s/dx10m + allocate ( terr10m(ncol10,nrow10),psea10m(ncol10,nrow10),var10m(ncol10,nrow10),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr10m, psea10m, and var10m' + stop + end if +! +! Expand Caspian Sea for tiles 6 and 15 +! + if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) + if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) + if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) +! +! area average of 30-sec tile to 10-min tile +! + call avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) + +! +! Print some info on the fields + print *, "min and max elevations: ", minval(terr10m), maxval(terr10m) + print *, "min and max variacnes: ", minval(var10m) , maxval(var10m) + print *, "min and max land frac: ", minval(psea10m), maxval(psea10m) +! +! fit the 10-min tile into global 10-min dataset +! Note: the 30-sec and 10-min tiles are scaned from north to south, the global 10-min dataset are +! scaned from south to north (90S to 90N) and east to west (0E to -0.1666667W) +! + latsw10 = nint(ulymap + 0.5 * dx30s) - nrow10 * dx10m + 0.5 * dx10m + lonsw10 = nint(ulxmap - 0.5 * dx30s) + 0.5 * dx10m + if( lonsw10 < 0.0 ) lonsw10=360.0+lonsw10 + i1 = nint( (lonsw10 - lon1_10m) / dx10m )+1 + if( i1 <= 0 ) i1 = i1 + im10 + if( i1 > im10 ) i1 = i1 - im10 + j1 = nint( (latsw10 - lat1_10m) / dx10m )+1 + +! print*,'ulymap,ulxmap,latsw10,lonsw10 = ',ulymap,ulxmap,latsw10,lonsw10 +! print*,'i1,j1 = ', i1,j1 + + call fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) +! +! Deallocate working space for arrays iterr, terr10m and psea10m +! + deallocate ( iterr,terr10m,psea10m,var10m,stat=dealloc_error ) + if( dealloc_error /= 0 ) then + print*,'Unexpected deallocation error for arrays iterr,terr10m,psea10m,var10m' + stop + end if + + end do + +! +! Print some info on the fields + print *, "min and max elevations: ", minval(terr), maxval(terr) + print *, "min and max variances: ", minval(variance), maxval(variance) + print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) +! +! Write 10-min terrain dataset, variance and land_fraction to NetCDF file +! + call wrtncdf(im10,jm10,terr,variance, land_fraction,dx10m) + + end program convterr + + subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine read the header of USGA Global30 sec TOPO data set. +! + implicit none +! +! Dummy arguments +! + character (len=7), intent(in) :: nmtile ! name of the tile + integer, intent(out) :: nrows ! number of rows + integer, intent(out) :: ncols ! number of column + integer, intent(out) :: nodata ! integer for ocean data point + real(r8), intent(out) :: ulxmap + real(r8), intent(out) :: ulymap +! +! Local variables +! + character (len=11) :: flheader ! file name of the header + character (len=13) :: chars ! dummy character + + flheader=nmtile//'.HDR' + + print*,'flheader = ', flheader +! +! Open GTOPO30 Header File +! + open(unit=10,file=flheader,status='old',form='formatted') +! +! Read GTOPO30 Header file +! + read (10, *) + read (10, *) + read (10, *) chars,nrows + print*,chars,' = ',nrows + read (10, *) chars,ncols + print*,chars,' = ',ncols + read (10, *) + read (10, *) + read (10, *) + read (10, *) + read (10, *) + read (10, *) chars,nodata + print*,chars,' = ',nodata + read (10, *) chars,ulxmap + print*,chars,' = ',ulxmap + read (10, *) chars,ulymap + print*,chars,' = ',ulymap + close(10) + + end subroutine rdheader + + subroutine rdterr(nmtile,nrows,ncols,iterr) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine read the USGS Global 30-sec terrain data for each tile. +! + implicit none +! +! Dummy arguments +! + character (len=7), intent(in) :: nmtile ! name of the tile + integer, intent(in) :: nrows ! number of rows + integer, intent(in) :: ncols ! number of column + integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data +! +! Local variables +! + character (len=11) :: flterr ! file name for each terr dataset + integer :: io_error ! I/O status + integer :: i,j ! Index + integer :: length ! record length + + flterr=nmtile//'.DEM' + +! print*,'flterr = ', flterr +! print*,'nrows,ncols = ',nrows,ncols +! +! Open GTOPO30 Terrain dataset File +! + + length = 2 * ncols * nrows + io_error=0 + open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) + if( io_error /= 0 ) then + print*,'Open file error in subroutine rdterr' + print*,'iostat = ', io_error + stop + end if +! +! Read GTOPO30 Terrain data file +! + read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) +! + if( io_error /= 0 ) then + print*,'Data file error in subroutine rdterr' + print*,'iostat = ', io_error + stop + end if +! +! Print some info on the fields + print *, "min and max elevations: ", minval(iterr), maxval(iterr) +! +! Correct missing data in source files +! +! Missing data near dateline + + if( nmtile == 'W180S60' ) then + do j = 1, nrows + iterr(1,j) = iterr(2,j) + end do + else if (nmtile == 'E120S60') then + do j = 1, nrows + iterr(ncols-1,j) = iterr(ncols-2,j) + iterr(ncols,j) = iterr(ncols-2,j) + end do + end if +! +! Missing data at the southermost row near South pole +! + if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & + nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then + do i=1,ncols + iterr(i,nrows) = iterr(i,nrows-1) + end do + end if +! +! print*,'iterr(1,1),iterr(ncols,nrows) = ', & +! iterr(1,1),iterr(ncols,nrows) + + close (11) + end subroutine rdterr + + subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and +! compute the percentage of ocean cover (psea10m) +! + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncols ! number of column for 30-sec tile + integer, intent(in) :: nrows ! number of rows for 30-sec tile + integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile + integer, intent(in) :: nodata ! integer for ocean data point + real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile + real(r8),intent(in) :: dx30s ! spacing interval for 30-sec data (in degree) + integer, intent(in) :: nrow10 ! number of rows for 10-min tile + integer, intent(in) :: ncol10 ! number of columns for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(out) :: terr10m ! terrain data for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(out) :: psea10m ! percentage ocean coverage for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(out) :: var10m ! variance of 30-sec elevations +! +! Local variables +! + real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell + real(r8) :: wt ! area weighting of each 30-sec cell + real(r8) :: wt_tot ! total weighting of each 10-min cell + real(r8) :: sumterr ! summation of terrain height of each 10-min cell + real(r8) :: sumsea ! summation of sea coverage of each 10-min cell + real(r8) :: pi ! pi=3.1415 + real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile + integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces + integer :: i,j,ii,jj ! index + logical, dimension(ncols,nrows) :: oflag + + pi = 4.0 * atan(1.0) +! + n1 = ncols / ncol10 + print*,'ncols,ncol10,n1 = ',ncols,ncol10,n1 + + itmp = nint( ulymap + 0.5 * dx30s ) + latul = itmp + print*,'ulymap,latul = ', ulymap,latul + oflag = .false. + + do j = 1, nrow10 + j1 = (j-1) * n1 + 1 + j2 = j * n1 + do i = 1, ncol10 + i1 = (i-1) * n1 + 1 + i2 = i * n1 + wt_tot = 0.0 + sumterr = 0.0 + sumsea = 0.0 + + do jj = j1, j2 + latn = ( latul - (jj -1) * dx30s ) * pi / 180.0 + lats = ( latul - jj * dx30s ) * pi / 180.0 + wt = sin( latn ) - sin( lats ) + + do ii = i1, i2 + wt_tot=wt_tot+wt + if ( iterr(ii,jj) == nodata ) then + sumsea = sumsea + wt + oflag(ii,jj) = .true. + else + if ( iterr(ii,jj) .lt.nodata ) then + ! this can only happen in the expand_sea routine + sumsea = sumsea + wt + oflag(ii,jj) = .true. + iterr(ii,jj) = iterr(ii,jj) - nodata - nodata + endif + sumterr = sumterr + iterr(ii,jj) * wt + end if + end do + end do + + terr10m(i,j) = sumterr / wt_tot + psea10m(i,j) = sumsea / wt_tot + + end do + end do + + ! Now compute variance of 30-second points + + do j = 1, nrow10 + j1 = (j-1) * n1 + 1 + j2 = j * n1 + + do i = 1, ncol10 + i1 = (i-1) * n1 + 1 + i2 = i * n1 + + wt_tot = 0.0 + var10m(i,j) = 0.0 + wt = 1.0 + do jj = j1, j2 + do ii = i1, i2 + wt_tot = wt_tot + wt + if ( .not. oflag(ii,jj) ) then + var10m(i,j) = var10m(i,j) + wt * (iterr(ii,jj)-terr10m(i,j))**2 + end if + end do + end do + var10m(i,j) = var10m(i,j) / wt_tot + + end do + end do + + end subroutine avg + + subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and +! compute the percentage of ocean cover (psea10m) +! + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncols ! number of column for 30-sec tile + integer, intent(in) :: nrows ! number of rows for 30-sec tile + integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile + integer, intent(in) :: nodata ! integer for ocean data point + integer, intent(in) :: startx, starty ! where to begin the sea +! +! Local variables +! + real(r8):: maxh + integer :: i,j,per,ii,jj ! index + logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile + logical :: found + + flag = .false. + + maxh = iterr(startx,starty) + + iterr(startx,starty) = iterr(startx,starty) + nodata + nodata + flag(startx-1:startx+1,starty-1:starty+1) = .true. + + per = 0 + print *, 'expanding sea at ',maxh,' m ' + +2112 per = per + 1 + found = .false. + do j = starty - per, starty + per, per*2 + do i = startx - per, startx + per + if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then + if( iterr(i,j).eq.maxh .and. flag(i,j) ) then + iterr(i,j) = iterr(i,j) + nodata + nodata + flag(i-1:i+1,j-1:j+1) = .true. + found = .true. + endif + endif + end do + end do + + do i = startx - per, startx + per, per*2 + do j = starty - per + 1, starty + per - 1 + if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then + if( iterr(i,j).eq.maxh .and. flag(i,j) ) then + iterr(i,j) = iterr(i,j) + nodata + nodata + flag(i-1:i+1,j-1:j+1) = .true. + found = .true. + endif + endif + end do + end do + if (found)goto 2112 + print *, 'done with expand_sea' + return + + end subroutine expand_sea + + subroutine fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine put 10-min tile into the global dataset +! + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncol10 ! number of columns for 10-min tile + integer, intent(in) :: nrow10 ! number of rows for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(in) :: terr10m ! terrain data for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(in) :: psea10m ! percentage ocean coverage for 10-min tile + real(r8), dimension(ncol10,nrow10), intent(in) :: var10m ! variance of 30-sec elev for 10-min tile + integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile + ! in the global grid + integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset + real(r8),dimension(im10,jm10), intent(out) :: terr ! global 10-min terrain data + real(r8),dimension(im10,jm10), intent(out) :: variance ! global 10-min variance of elev + real(r8),dimension(im10,jm10), intent(out) :: land_fraction ! global 10-min land fraction +! +! Local variables +! + integer :: i,j,ii,jj ! index + + do j = 1, nrow10 + jj = j1 + (nrow10 - j) + do i = 1, ncol10 + ii = i1 + (i-1) + if( ii > im10 ) ii = ii - im10 + terr(ii,jj) = terr10m(i,j) + land_fraction(ii,jj) = 1.0 - psea10m(i,j) + variance(ii,jj) = var10m(i,j) + if( i == 1 .and. j == 1 ) & + print*,'i,j,ii,jj = ',i,j,ii,jj + if( i == ncol10 .and. j == nrow10 ) & + print*,'i,j,ii,jj = ',i,j,ii,jj + end do + end do + end subroutine fitin + + subroutine wrtncdf(im10,jm10,terr,variance,land_fraction,dx10m) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine save 10-min terrain data, variance, land fraction to NetCDF file +! + implicit none + +# include + +! +! Dummy arguments +! + integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset + real(r8),dimension(im10,jm10), intent(in) :: terr ! global 10-min terrain data + real(r8),dimension(im10,jm10), intent(in) :: variance ! global 10-min variance data + real(r8),dimension(im10,jm10), intent(in) :: land_fraction !global 10-min land fraction + real(r8), intent(in) :: dx10m +! +! Local variables +! + real(r8),dimension(im10) :: lonar ! longitude array + real(r8),dimension(im10) :: latar ! latitude array + character (len=32) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: varianceid + integer :: htopoid + integer :: landfid + integer, dimension(2) :: variancedim,htopodim,landfdim + integer :: status ! return value for error control of netcdf routin + integer :: i,j + character (len=8) :: datestring + +! +! Fill lat and lon arrays +! + do i = 1,im10 + lonar(i)= dx10m * (i-0.5) + enddo + do j = 1,jm10 + latar(j)= -90.0 + dx10m * (j-0.5) + enddo + + fout='topo_gtopo30_10min.nc' +! +! Create NetCDF file for output +! + status = nf_create (fout, NF_WRITE, foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create dimensions for output +! + status = nf_def_dim (foutid, 'lon', im10, lonid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'lat', jm10, latid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create variable for output +! + variancedim(1)=lonid + variancedim(2)=latid + status = nf_def_var (foutid,'variance', NF_FLOAT, 2, variancedim, varianceid) + if (status .ne. NF_NOERR) call handle_err(status) + + htopodim(1)=lonid + htopodim(2)=latid + status = nf_def_var (foutid,'htopo', NF_FLOAT, 2, htopodim, htopoid) + if (status .ne. NF_NOERR) call handle_err(status) + + landfdim(1)=lonid + landfdim(2)=latid + status = nf_def_var (foutid,'landfract', NF_FLOAT, 2, landfdim, landfid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! Create attributes for output variables +! + status = nf_put_att_text (foutid,varianceid,'long_name', 29, 'variance of 30-sec elevations') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,varianceid,'units', 8, 'meter**2') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,htopoid,'long_name', 41, '10-min elevation from USGS 30-sec dataset') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,landfid,'long_name', 23, '10-minute land fraction') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '10-minute USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! End define mode for output file +! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Write variable for output +! + status = nf_put_var_double (foutid, varianceid, variance) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_var_double (foutid, htopoid, terr) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_var_double (foutid, landfid, land_fraction) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_var_double (foutid, latvid, latar) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_var_double (foutid, lonvid, lonar) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! Close output file +! + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + + end subroutine wrtncdf +!************************************************************************ +!!handle_err +!************************************************************************ +! +!!ROUTINE: handle_err +!!DESCRIPTION: error handler +!-------------------------------------------------------------------------- + + subroutine handle_err(status) + + implicit none + +# include + + integer status + + if (status .ne. nf_noerr) then + print *, nf_strerror(status) + stop 'Stopped' + endif + + end subroutine handle_err + + diff --git a/tools/definehires/shr_kind_mod.F90 b/tools/definehires/shr_kind_mod.F90 new file mode 100644 index 0000000000..fc1ed8e94a --- /dev/null +++ b/tools/definehires/shr_kind_mod.F90 @@ -0,0 +1,20 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + +END MODULE shr_kind_mod diff --git a/tools/definesurf/Makefile b/tools/definesurf/Makefile new file mode 100644 index 0000000000..dd13a5bdd4 --- /dev/null +++ b/tools/definesurf/Makefile @@ -0,0 +1,144 @@ +# Makefile to build definesurf on various platforms +# Note: If netcdf library is not built in the standard location, you must set the environment +# variables INC_NETCDF and LIB_NETCDF + +EXEDIR = . +EXENAME = definesurf +RM = rm + +.SUFFIXES: +.SUFFIXES: .f90 .o + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +# Architecture-specific flags and rules +# +#------------------------------------------------------------------------ +# Cray +#------------------------------------------------------------------------ + +ifeq ($(UNAMEM),CRAY) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.f90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) +FC = f90 +FFLAGS = -64 -c -I$(INC_NETCDF) +LDFLAGS = -64 -L/usr/local/lib64/r4i4 -lnetcdf +.f90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# SUN +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),SunOS) +FC = f90 +FFLAGS = -c -stackvar -f -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.f90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.f90.o: + $(FC) $(FFLAGS) -qsuffix=f=f90 $< +endif + +#------------------------------------------------------------------------ +# OSF1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),OSF1) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.f90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) +ifeq ($(USER_FC),$(null)) +FC := pgf90 +FFLAGS = -c -I$(INC_NETCDF) -fast +else +FC := $(USER_FC) +endif +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + +ifeq ($(FC),lf95) +FFLAGS = -c --trace --trap -I$(INC_NETCDF) -g +LDFLAGS += -g +endif + +.f90.o: + $(FC) $(FFLAGS) $< +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := ao.o ao_i.o area_ave.o binf2c.o cell_area.o \ + chkdims.o endrun.o fmain.o handle_error.o inimland.o \ + lininterp.o map_i.o max_ovr.o shr_kind_mod.o sghphis.o sm121.o \ + terrain_filter.o varf2c.o wrap_nf.o interplandm.o map2f.o + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +ao.o: shr_kind_mod.o +ao_i.o: shr_kind_mod.o +area_ave.o: shr_kind_mod.o +binf2c.o: shr_kind_mod.o +cell_area.o: shr_kind_mod.o +chkdims.o: +endrun.o: +fmain.o: shr_kind_mod.o +handle_error.o: +inimland.o: shr_kind_mod.o +lininterp.o: shr_kind_mod.o +map_i.o: shr_kind_mod.o +max_ovr.o: shr_kind_mod.o +shr_kind_mod.o: +sghphis.o: shr_kind_mod.o +sm121.o: shr_kind_mod.o +terrain_filter.o: +map2f.o: +varf2c.o: shr_kind_mod.o +wrap_nf.o: +interplandm.o: diff --git a/tools/definesurf/README b/tools/definesurf/README new file mode 100644 index 0000000000..f0d9427e8e --- /dev/null +++ b/tools/definesurf/README @@ -0,0 +1,156 @@ +Running gnumake in this directory will create an executable named +"definesurf". Its function is to compute required CAM initial dataset +variables SGH, PHIS, and LANDFRAC from a high-resolution topography dataset, +and LANDM_COSLAT from a T42 "master", then add or replace the values on an +existing initial dataset. SGH is the standard deviation of PHIS used in the +gravity wave drag scheme. PHIS is the geopotential height. LANDFRAC is land +fraction. LANDM_COSLAT is a field derived from LANDFRAC which is required by +the prognostic cloud water parameterization. There is a cosine(latitude) +dependence built in to the function. + +The cam standard high resolution dataset is now based on the USGS +GTOPO30 digital elevation model at 30" resolution. It is converted to +10' resolution by definehires. + +The older high resolution topography dataset (10') used by definesurf +is named topo.nc and is included as part of the CAM distribution in +the datasets tar file. topo.nc was derived from the U.S. Navy Global +Elevation 10-MIN dataset DS754.0 Please refer to the following NCAR +website for more information: + +http://www.scd.ucar.edu/dss/catalogs/geo.html + +The algorithms within this code should be considered experimental. +For example, a 1-2-1 smoothing operator (sm121, called from subroutine +sghphis) is applied twice in succession to the topography variance +field regardless of horizontal resolution. Also, a spectral filter +will be applied to the PHIS field within the CAM at model startup +(except for the fv dycore) if PHIS was defined from the high +resolution topography dataset. The model determines this by checking +for the presence of netcdf attribute "from_hires" on variable PHIS. + +------------------------------------- +Feb 01, 2005 +------------------------------------- +------------------------------------- +*********** definesurf ************** +------------------------------------- + +A 10' data file is read in and averaged to the model grid by +definesurf. The present form of definesurf also takes a model initial +condition file as input and gets model grid description from it. The +terrain data mapped to the model grid is output on a new file. + +Command line flags are used for + -t name - (required) name of 10' data file + -g name - (required) name of cam initial condition file containing grid description + -l name - (required) name of land mask file on ?? grid + -r - (optional) do not extend Ross sea (default is extend) + -v - (optional) verbose (default is false) + -del2 - (optional) filter the elevations with a del2 filter (use for fv only) + -remap - (optional) filter the elevations with a remapping filter (use for fv only) + -sgh - (optional) filter the standard deviations with same filter as height + name - (required) name of i.c. file with existing terrain data, + must be final argument + +definesurf -t topo_gtopo30_10min.nc -g cami_*.nc -l landm_coslat.nc -remap oro_GTOPO30.nc +generates the file oro_GTOPO30.nc using the remapping filter. + +definesurf calls shgphis, which recognizes 2 input 10' data file formats + Old style, no 30" variance data on 10' grid, variance = -1 + land fraction called "ftopo" + New style, 30" variance data is present + land fraction called "landfract" + + Land fraction and 30" variance (if present) are averaged to the + model grid. + + if plon >= 128 then + Height is averaged to the model grid and the variance w.r.t to the + 10' data is computed. + if plon < 128 then + Height is averaged to a 3 degree grid and the variance w.r.t to the + 10' data is computed. The avg height and the variance of + the 3 degree data are then averaged to the model grid. + + 1-2-1 smoothers are applied twice to the model grid averaged values + of the two variance fields: 10' w.r.t. model grid; 30" w.r.t. 10' + (if 30" variance is present). + + The averaged and smoothed variances are converted to standard + deviations. + + The averaged height is converted to a geopotential (z*9.80616) + +Attributes are added to input file to describe what definesurf is doing. + +Land mask for clouds is interpolated to model grid. + +Extend land to -79 degrees for Ross ice shelf, unless -r flag was +set. + +Run terrain filter, if requested (-remap or -del2). Should only be +done for fv grids. For spectral grid, filtering is done in the model +based on the value of the attribute "from_hires". + Diffusive filter or remapping is appled to + surface geopotential + standard deviation of 10' data w.r.t. model grid + standard deviation of 30" data w.r.t. 10' grid (if present) + +**** It is not clear that the filter should be applied to the +**** standard deviations. + + The remapping filter removes structure near grid scale by using the + ppm mapping code to go to a half resolution grid and back to the + full resolution grid. Order (accuracy) parameters iord=7 and jord=3 + are used. A polar filter is also applied. + +------------------------------------------------------- +******* diffusive (-del2) terrain filter notes ******** +------------------------------------------------------- + +The del2 filter is a bit of a pain to figure out from the code (as is the +spectral one applied in the model for eul and sld dycores). It looks like + +(1) h(n+1) = h(n) + c*del2(h(n)), c=0.25 + +del2(h) = div(grad(h)) + +however, buried inside the del2 routine is a scaling by +CD = 0.25*DL*DP*coszc**2, + +coszc = cos(60*pi/180) [= 0.5] +DL = 2*pi/NLON is delta lambda +DP = pi / (NLAT-1) is delta phi +so +CD = 0.0625 * 2*pi/NLON * pi/(NLAT-1) = 0.4 / NLON / (NLAT-1) + +So the scaling factor reduces as the square of the resolution, just like +a del2 coefficient should, in order to maintain a constant damping rate +at the truncation limit. +CD = 3E-5, for 2x2.5 + +However, the number of iterations is NLON/12, so there is an additional +scaling upward of diffusion with resolution. + +going back to (1) +h(n+1) = h(n) + c*CD*del2(h(n)) +c*CD = 7.57E-6 for 2x2.5 +c*CD is just dt*k for a normal diffusion equation, where dt is the time +step and k is the diffusivity on the unit sphere. For a sphere with +radius a (=6.37E6), the diffusivity is K=k*a**2 . +Then dt*K = c*CD*a**2 = 3E8 and assuming dt=3600, K = 8.5E4 + +The del4 diffusivity in the spectral case is 5E15 at T63. The equivalent +del2 coefficient is K = 5E15 * 63*64/a**2 = 5E5 to damp wave 63 at the +same rate. + +So, we have K_fv ~ 8.5E4 and K_eul ~ 5E5. So the fv damping should +actually be less than the spectral/eulerian damping. + +Also, the damping is applied 25 times in the spectral case and NLON/12 +times for fv. NLON/12 =12 for 2x2.5, =24 for 1x1.25 and =48 for +0.5x0.625. + +The big difference is that the spectral/eulerian actually uses del4, +which confines the damping much closer to grid scale. diff --git a/tools/definesurf/ao.f90 b/tools/definesurf/ao.f90 new file mode 100644 index 0000000000..33d7494215 --- /dev/null +++ b/tools/definesurf/ao.f90 @@ -0,0 +1,141 @@ +subroutine ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: ao.F +! purpose: weights and indices for area of overlap between +! input and output grids +! date last revised: March 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlon_i !maximum number of input longitude points + integer nlat_i !number of input latitude points + integer numlon_i(nlat_i) !number of input lon pts for each latitude + integer nlon_o !maximum number of output longitude points + integer nlat_o !number of output latitude points + integer numlon_o(nlat_o) !number of output lon pts for each latitude + integer mx_ovr !maximum number of overlapping input cells + + real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell longitude, w. edge (deg) + real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell longitude, w. edge (deg) + real(r8) lat_i(nlat_i+1) !input grid cell latitude, s. edge (deg) + real(r8) lat_o(nlat_o+1) !output grid cell latitude, s. edge (deg) + real(r8) area_o(nlon_o,nlat_o) !area of output grid cell + real(r8) re !radius of earth +! ----------------------------------------------------------------- + +! ------------------- input/output variables ---------------------- + integer n_ovr(nlon_o,nlat_o ) !number of overlapping input cells + integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell + + real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer io,ii !output and input grids longitude loop index + integer jo,ji !output and input grids latitude loop index + + real(r8) lonw,lone,dx !west, east longitudes of overlap and difference + real(r8) lats,latn,dy !south, north latitudes of overlap and difference + real(r8) deg2rad !pi/180 + real(r8) a_ovr !area of overlap + real(r8) zero,one + parameter (zero=0.0) ! Needed as arg to "max" + parameter (one=1.) ! Needed as arg to "atan" +! ----------------------------------------------------------------- + + deg2rad = (4.*atan(one)) / 180. + +! ----------------------------------------------------------------- +! for each output grid cell: find overlapping input grid cell and area of +! input grid cell that overlaps with output grid cell. cells overlap if: +! +! southern edge of input grid < northern edge of output grid AND +! northern edge of input grid > southern edge of output grid +! +! western edge of input grid < eastern edge of output grid AND +! eastern edge of input grid > western edge of output grid +! +! lon_o(io,jo) lon_o(io+1,jo) +! +! | | +! --------------------- lat_o(jo+1) +! | | +! | | +! xxxxxxxxxxxxxxx lat_i(ji+1) | +! x | x | +! x input | x output | +! x cell | x cell | +! x ii,ji | x io,jo | +! x | x | +! x ----x---------------- lat_o(jo ) +! x x +! xxxxxxxxxxxxxxx lat_i(ji ) +! x x +! lon_i(ii,ji) lon_i(ii+1,ji) +! ----------------------------------------------------------------- + +! note that code does not vectorize but is only called during +! initialization. + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + +! loop through all input grid cells to find overlap with output grid. + + do ji = 1, nlat_i + if ( lat_i(ji ).lt.lat_o(jo+1) .and. & + lat_i(ji+1).gt.lat_o(jo ) ) then !lat ok + + do ii = 1, numlon_i(ji) + if ( lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & + lon_i(ii+1,ji).gt.lon_o(io ,jo) ) then !lon okay + +! increment number of overlapping cells. make sure 0 < n_ovr < mx_ovr + + n_ovr(io,jo) = n_ovr(io,jo) + 1 +! if (n_ovr(io,jo) .gt. mx_ovr) then +! write (6,*) 'AO error: n_ovr= ',n_ovr(io,jo), & +! ' exceeded mx_ovr = ',mx_ovr, & +! ' for output lon,lat = ',io,jo +! call endrun +! end if + +! determine area of overlap + + lone = min(lon_o(io+1,jo),lon_i(ii+1,ji))*deg2rad !e edge + lonw = max(lon_o(io ,jo),lon_i(ii ,ji))*deg2rad !w edge + dx = max(zero,(lone-lonw)) + latn = min(lat_o(jo+1),lat_i(ji+1))*deg2rad !n edge + lats = max(lat_o(jo ),lat_i(ji ))*deg2rad !s edge + dy = max(zero,(sin(latn)-sin(lats))) + a_ovr = dx*dy*re*re + +! determine indices and weights. re cancels in the division by area + + i_ovr(io,jo,n_ovr(io,jo)) = ii + j_ovr(io,jo,n_ovr(io,jo)) = ji + w_ovr(io,jo,n_ovr(io,jo)) = a_ovr/area_o(io,jo) + + end if + end do + + end if + end do + + end do + end do + + return +end subroutine ao diff --git a/tools/definesurf/ao_i.f90 b/tools/definesurf/ao_i.f90 new file mode 100644 index 0000000000..87b96eb815 --- /dev/null +++ b/tools/definesurf/ao_i.f90 @@ -0,0 +1,178 @@ +subroutine ao_i(nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + mx_ovr , i_ovr , j_ovr , w_ovr , re , & + area_o , relerr ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: ao_i.F +! purpose: area averaging initialization: indices and weights +! date last revised: November 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------------ notes ---------------------------------- +! get indices and weights for area-averaging between input and output grids + +! o input grid does not have to be finer resolution than output grid + +! o both grids must be oriented south to north, i.e., cell(lat+1) +! must be north of cell(lat). the southern edge of the first row +! must be -90 (south pole) and the northern edge of the last row +! must be +90 (north pole) + +! o both grids must be oriented eastwards, i.e., cell(lon+1) must be +! east of cell(lon). but the two grids do not have to start at the +! same longitude, i.e., one grid can start at dateline and go east; +! the other grid can start at greenwich and go east. longitudes for +! the western edge of the cells must increase continuously and span +! 360 degrees. examples +! dateline : -180 to 180 (- longitudes west of greenwich) +! greenwich : 0 to 360 +! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) + +! for each output grid cell +! o number of input grid cells that overlap with output grid cell (n_ovr) +! o longitude index (1 <= i_ovr <= nlon_i) of the overlapping input grid cell +! o latitude index (1 <= j_ovr <= nlat_i) of the overlapping input grid cell + +! for field values fld_i on an input grid with dimensions nlon_i and nlat_i +! field values fld_o on an output grid with dimensions nlon_o and nlat_o are +! fld_o(io,jo) = +! fld_i(i_ovr(io,jo, 1),j_ovr(io,jo, 1)) * w_ovr(io,jo, 1) + +! ... + ... + +! fld_i(i_ovr(io,jo,mx_ovr),j_ovr(io,jo,mx_ovr)) * w_ovr(io,jo,mx_ovr) + +! error check: overlap weights of input cells sum to 1 for each output cell +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlon_i !input grid max number of input longitude points + integer nlat_i !input grid number of input latitude points + integer numlon_i(nlat_i) !input grid number of lon points for each lat + integer nlon_o !output grid max number of output lon points + integer nlat_o !output grid number of output latitude points + integer numlon_o(nlat_o) !output grid number of lon points for each lat + integer mx_ovr !max num of input cells that overlap output cell + + real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell lon, western edge (degrees) + real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell lon, western edge (degrees) + real(r8) lat_i(nlat_i+1) !input grid cell lat, southern edge (degrees) + real(r8) lat_o(nlat_o+1) !output grid cell lat, southern edge (degrees) + real(r8) area_o(nlon_o,nlat_o) !cell area on output grid + real(r8) re !radius of earth + real(r8) relerr !max error: sum overlap weights ne 1 +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell + real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer io,ii !input and output grids longitude loop index + integer jo,ji !input and output grids latitude loop index + integer n !overlapping cell index + + real(r8) offset !used to shift x-grid 360 degrees + real(r8) f_ovr !sum of overlap weights for cells on output grid +! +! Dynamic +! + integer n_ovr(nlon_o,nlat_o) !number of overlapping input cells + +! ----------------------------------------------------------------- +! initialize overlap weights on output grid to zero for maximum +! number of overlapping points. set lat and lon indices of overlapping +! input cells to dummy values. set number of overlapping cells to zero +! ----------------------------------------------------------------- + + do n = 1, mx_ovr + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + i_ovr(io,jo,n) = 1 + j_ovr(io,jo,n) = 1 + w_ovr(io,jo,n) = 0. + end do + end do + end do + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + n_ovr(io,jo) = 0 + end do + end do + +! ----------------------------------------------------------------- +! first pass to find cells that overlap, area of overlap, and weights +! ----------------------------------------------------------------- + + call ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + +! ----------------------------------------------------------------- +! second pass to find cells that overlap, area of overlap, and weights +! ----------------------------------------------------------------- + +! shift x-grid to locate periodic grid intersections +! the following assumes that all lon_i(1,:) have the same value +! independent of latitude and that the same holds for lon_o(1,:) + + if (lon_i(1,1) .lt. lon_o(1,1)) then + offset = 360.0 + else + offset = -360.0 + end if + + do ji = 1,nlat_i + do ii = 1, numlon_i(ji) + 1 + lon_i(ii,ji) = lon_i(ii,ji) + offset + end do + end do + +! find overlap + + call ao (nlon_i , nlat_i , numlon_i , lon_i , lat_i , & + nlon_o , nlat_o , numlon_o , lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + +! restore x-grid (un-shift x-grid) + + do ji = 1,nlat_i + do ii = 1, numlon_i(ji) + 1 + lon_i(ii,ji) = lon_i(ii,ji) - offset + end do + end do + +! ----------------------------------------------------------------- +! error check: overlap weights for input grid cells must sum to 1 +! ----------------------------------------------------------------- + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + f_ovr = 0. + + do n = 1, mx_ovr + f_ovr = f_ovr + w_ovr(io,jo,n) + end do + + if (abs(f_ovr-1.) .gt. relerr) then + write (6,*) 'AO_I error: area not conserved for',' lon,lat = ', io,jo + write (6,'(a30,e20.10)') ' sum of overlap weights = ', f_ovr + call endrun + end if + + end do + end do + + return +end subroutine ao_i diff --git a/tools/definesurf/area_ave.f90 b/tools/definesurf/area_ave.f90 new file mode 100644 index 0000000000..cbcdbcd3af --- /dev/null +++ b/tools/definesurf/area_ave.f90 @@ -0,0 +1,59 @@ +subroutine area_ave (nlat_i , nlon_i , numlon_i, fld_i , & + nlat_o , nlon_o , numlon_o, fld_o , & + i_ovr , j_ovr , w_ovr , nmax ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none +! ------------------------ code history --------------------------- +! source file: area_ave.F +! purpose: area averaging of field from input to output grids +! date last revised: November 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlat_i ! number of latitude points for input grid + integer nlat_o ! number of latitude points for output grid + integer nlon_i ! maximum number of longitude points for input grid + integer nlon_o ! maximum number of longitude points for output grid + integer nmax ! maximum number of overlapping cells + integer numlon_i(nlat_i) ! input grid number of lon points at each lat + integer numlon_o(nlat_o) ! input grid number of lon points at each lat + integer i_ovr(nlon_o,nlat_o,nmax) ! lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,nmax) ! lat index, overlapping input cell + + real(r8) fld_i(nlon_i,nlat_i) !field for input grid + real(r8) w_ovr(nlon_o,nlat_o,nmax) ! overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + real(r8) fld_o(nlon_o,nlat_o) !field for output grid +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer jo,ji !latitude index for output,input grids + integer io,ii !longitude index for output,input grids + integer n !overlapping cell index +! ----------------------------------------------------------------- + + do jo = 1, nlat_o + do io =1, numlon_o(jo) + fld_o(io,jo) = 0. + end do + end do + + do n = 1, nmax + do jo = 1, nlat_o + do io =1, numlon_o(jo) + ii = i_ovr(io,jo,n) + ji = j_ovr(io,jo,n) + fld_o(io,jo) = fld_o(io,jo) + w_ovr(io,jo,n)*fld_i(ii,ji) + end do + end do + end do + + return +end subroutine area_ave diff --git a/tools/definesurf/binf2c.f90 b/tools/definesurf/binf2c.f90 new file mode 100644 index 0000000000..f43ca19ee4 --- /dev/null +++ b/tools/definesurf/binf2c.f90 @@ -0,0 +1,218 @@ +subroutine binf2c(flon , flat ,nflon ,nflat ,fine , & + clon , clat ,nclon ,nclat ,cmean ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +!----------------------------------------------------------------------------- +! Bin going from a fine grid to a coarse grid. +! A schematic for the coarse and fine grid systems is shown in +! Figure 1. This code assumes that each data point is represent +! it's surrounding area, called a cell. The first grid data point +! for both grids is assumed to be located at 0E (GM). This +! implies that the 1st cell for both the fine and the coarse grids +! strattles the Greenwich Meridian (GM). This code also assumes +! that there is no data wraparound (last data value is located at +! 360-dx). +! +! FIGURE 1: Overview of the coarse (X) and fine (@) grids +! longitudinal structure where: +! X = location of each coarse grid data point +! @ = location of each fine grid data point +! +! Greenwich Greenwich +! 0 Coarse cells 360 +! : v : +! clon(1): clon(2) v clon(3) clon(nclon): +! v : v v v v : +! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : +! x x x x x : +! x x x x x : +! x c(1) x c(2) x x c(nclon)x : +! x X x X x x X x : +! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : +! x | | | | | | | | | | | | | : +! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : +! xxx|___|___|___|___|___|___| |___|___|___|___|___| : +! v v v v v : +! flon(1) flon(3) v flon(nflon-1) flon(nflon) +! : v : +! : Fine cells : +! 0 360 +! +! The Longitude/Latitude search: +! ------------------------------ +! +! Given a coarse grid cell with west and east boundaries of cWest +! and cEast and south and north boundaries of cSouth and cNorth +! (outlined by "x" in figure 2), find the indices of the fine grid +! points which are contained within the coarse grid cell. imin and +! imax are the indices fine grid points which overlap the western +! and eastern boundary of the coarse cell. jmin and jmax are the +! corresponding indices in the S-N direction. Bin these overlapping +! values to generate coarse(n), the coarse grid data values. +! +! FIGURE 2: Detail of Coarse and Fine cell overlap. +! @ = fine grid data point +! X = coarse grid data point +! +! cWest cEast +! | | x | | x | +! -@-------@---x---@-------@-----x-@- +! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth +! | | x | | x | +! | | x | | x | +! @-------@---x---@-------@-----x-@- jmax +! | | x | c(n) | x | +! | @ | x | | x | +! | | x | | x | +! @-------@---x---@-------@-----x-@- jmin +! | | x | | x | +! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth +! | | x | | x | +! -@-------@---x---@-------@-----x-@- +! | imin imax | +! +! +! When a cell coarse cell strattles the Greenwich Meridian +! --------------------------------------------------------- +! +! The first coarse grid cell strattles the GM, so when the western +! boundary of the coarse cell is < 0, an additional search is carried out. +! It ASSUMES that the easternmost fine grid point overlaps and searches +! westward from nflon, looking for a grid point west of clon(1) +! This generates a second set of longitudinal indices, imin1 and imax1. +! See Figure 3. +! +! Figure 3: Detail of Coarse cell strattling GM: +! ----------------------------------------------- +! +! Greenwich Greenwich +! 0 360 +! cWest : cEast cWest : +! clon(1): clon(2) clon(nclon+1)=clon(1) +! v : v v : +! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : +! x x x x x : +! x x x x x : +! x c(1) x x x c(nclon)x : +! x X x x x X x : +! x ___ ___ ___ _ ___ ___ ___ : +! x | | | | | | | : +! x | @ | @ | @ | @ | @ | @ | : +! xxx|___|___|___|_ ___|___|___| : +! ^ : ^ ^ ^ ^ : +! flon(1): ^ flon(3) flon(nflon-1) ^ : +! ^ : ^ ^ ^ : +! ^ :flon(2) ^ flon(nflon) +! ^ : ^ ^ ^ : +! imin : imax imin1 imax1 : +! : : +! +! +! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. +! because the last two cells of the fine grid will have some +! contribution the the 1st cell of the coarse grid. +! +!----------------------------------------------------------------------- + implicit none +!-----------------------------Arguments--------------------------------- + + integer nflon ! Input: number of fine longitude points + integer nflat ! Input: number of fine latitude points + integer nclon ! Input: number of coarse longitude points + integer nclat ! Input: number of coarse latitude points + + real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) + real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) + real(r8) fine(nflon,nflat) ! Input: Fine grid data array + real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) + real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) + real(r8) cmean(nclon,nclat) ! Output: mean of fine grid points over coarse cell + +!--------------------------Local variables------------------------------ + + real(r8) cWest ! Coarse cell longitude, west edge (deg) + real(r8) cEast ! Coarse cell longitude, east edge (deg) + real(r8) cSouth ! Coarse cell latitude, south edge (deg) + real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) + real(r8) sum ! coarse tmp value + + integer i,j ! Indices + integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. + integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM + integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. + integer iclon,jclat ! coarse grid indices + integer num ! increment + +!----------------------------------------------------------------------------- + + do jclat= 1,nclat ! loop over coarse latitudes + cSouth = clat(jclat) + cNorth = clat(jclat+1) + + do iclon=1,nclon ! loop over coarse longitudes + cWest = clon(iclon,jclat) + cEAST = clon(iclon+1,jclat) + +! 1. Normal longitude search: Find imin and imax + + imin = 0 + imax = 0 + do i=1,nflon-1 ! loop over fine lons, W -> E + if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box + if (flon(i) .ge. cWest .and. imin.eq.0) imin=i + imax=i + enddo + +! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward +! from the end to find indices of any overlapping fine grid cells: +! imin1 and imax1. + +10 imin1 = 0 ! borders for cWest, cEast + imax1 = -1 ! borders for cWest, cEast + if (cWest .lt. 0) then + cWest = cWest + 360. + imax1 = nflon + do i=nflon,1,-1 ! loop over fine lons, E -> W + imin1=i + if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box + enddo + endif + +! 3. Do the latitude search S -> N for jmin and jmax + +20 jmin = 0 + jmax = 0 + do j=1,nflat ! loop over fine lats, S -> N + if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box + if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j + jmax=j + enddo +30 continue + +! 4. Sum + + sum = 0. ! Initialize coarse data value + num = 0 + + do j=jmin,jmax ! loop over fine lats, S -> N + do i=imin,imax ! loop over fine lons, W -> E + sum = sum + fine(i,j) + num = num + 1 + enddo + do i=imin1,imax1 ! If coarse cell strattles GM + sum = sum + fine(i,j) + num = num + 1 + enddo + enddo + + if (num .gt. 0) then + cmean(iclon,jclat) = sum/num + else + cmean(iclon,jclat) = 1.e30 + endif + + end do + end do + return +end subroutine binf2c diff --git a/tools/definesurf/cell_area.f90 b/tools/definesurf/cell_area.f90 new file mode 100644 index 0000000000..2e8272aaeb --- /dev/null +++ b/tools/definesurf/cell_area.f90 @@ -0,0 +1,51 @@ +subroutine cell_area (nlat, nlon, numlon, lon_w, lat_s, re, area) + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none +! ------------------------ code history --------------------------- +! source file: cell_area.F +! purpose: area of grid cells +! date last revised: March 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlat !number of latitude points + integer nlon !maximum number of longitude points + integer numlon(nlat) !number of longitude points for each latitude + real(r8) lon_w(nlon+1,nlat) !grid cell longitude, western edge (degrees) + real(r8) lat_s(nlat+1) !grid cell latitude, southern edge (degrees) +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + real(r8) re !radius of earth (km) + real(r8) area(nlon,nlat) !cell area (km**2) +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer i !longitude index + integer j !latitude index + + real(r8) dx !cell width + real(r8) dy !cell length + real(r8) deg2rad !pi/180 + real(r8) one + parameter (one=1.) ! Argument to atan +! ----------------------------------------------------------------- + + deg2rad = (4.*atan(one)) / 180. + re = 6371.227709 + + do j = 1, nlat + do i = 1, numlon(j) + dx = (lon_w(i+1,j)-lon_w(i,j)) * deg2rad + dy = sin(lat_s(j+1)*deg2rad) - sin(lat_s(j)*deg2rad) + area(i,j) = dx*dy*re*re + end do + end do + + return +end subroutine cell_area diff --git a/tools/definesurf/chkdims.f90 b/tools/definesurf/chkdims.f90 new file mode 100644 index 0000000000..cb9be4ce32 --- /dev/null +++ b/tools/definesurf/chkdims.f90 @@ -0,0 +1,52 @@ +subroutine chkdims (fileid, name, varid, londimid, latdimid, timdimid, verbose) + + implicit none + + include 'netcdf.inc' + + integer fileid, varid, londimid, latdimid + integer timdimid + logical verbose + character*(*) name + + integer ret + integer ndims, dimids(nf_max_dims) + + ret = nf_inq_varid (fileid, name, varid) + + if (ret.eq.NF_NOERR) then + + dimids(:) = -999 + ret = nf_inq_varndims (fileid, varid, ndims) + ret = nf_inq_vardimid (fileid, varid, dimids) + + if (ret.ne.NF_NOERR) then + write(6,*)'NF_INQ_VAR failed for ',name + call handle_error (ret) + end if + + if (ndims.eq.3 .and. dimids(3).ne.timdimid) then + write(6,*)'3rd dim of ', name, ' must be time' + call endrun + end if + + if (dimids(1).ne.londimid .or. dimids(2).ne.latdimid) then + write(6,*)'Dims of ', name,' must be lon by lat' + call endrun + end if + + if (verbose) write(6,*)'Overwriting existing ',name,' with hi-res topo' + + else + + dimids(1) = londimid + dimids(2) = latdimid + dimids(3) = timdimid + if (verbose) write(6,*)name,' does not exist on netcdf file: Creating.' + ret = nf_redef (fileid) + ret = nf_def_var (fileid, name, NF_DOUBLE, 3, dimids, varid) + if (ret.ne.NF_NOERR) call handle_error (ret) + ret = nf_enddef (fileid) + + end if +end subroutine chkdims diff --git a/tools/definesurf/endrun.f90 b/tools/definesurf/endrun.f90 new file mode 100644 index 0000000000..71b2194a6f --- /dev/null +++ b/tools/definesurf/endrun.f90 @@ -0,0 +1,7 @@ +subroutine endrun + implicit none + include 'netcdf.inc' + + call abort + stop 999 +end subroutine endrun diff --git a/tools/definesurf/fmain.f90 b/tools/definesurf/fmain.f90 new file mode 100644 index 0000000000..c14b337c64 --- /dev/null +++ b/tools/definesurf/fmain.f90 @@ -0,0 +1,458 @@ +program fmain + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Local workspace +! + real(r8), parameter :: fillvalue = 1.d36 + real(r8), parameter :: filter_coefficient = 0.25D0 + + character(len=128) :: topofile = ' ' ! input high resolution (10 min) file name + character(len=128) :: landmfile = ' ' ! input land mask file name + character(len=128) :: gridfile = ' ' ! input initial condition file with grid definition + character(len=128) :: outbcfile = ' ' ! output boundary condition file with PHIS, SGH, etc. + character(len= 80) :: arg ! used for parsing command line arguments + character(len=256) :: cmdline ! input command line + character(len=256) :: history ! history attribute text + character(len= 8) :: datestring + character(len= 32) :: z_filter_type ! type of filter applied to height + character(len= 32) :: s_filter_type ! type of filter applied to standard deviations + + logical verbose ! Add print statements + logical make_ross ! Make Ross ice shelf south of -79 + logical filter_del2 ! Execute SJ Lin's del2 terrain filter + logical filter_remap ! Execute SJ Lin's newer remapping terrain filter + logical filter_sgh ! Filter SGH and SGH30 in addition to height + logical reduced_grid ! reduced grid defined + logical have_sgh30 ! input topofile has sgh30, output will also + + integer cmdlen ! character array lengths + integer gridid + integer foutid ! output file id + integer lonid, londimid, rlonid ! longitude dimension variable ids + integer latid, latdimid ! latitude dimension variable ids + integer sghid, phisid, landfid, nlonid, landmid, sgh30id ! output variable netcdf ids + integer start(4), count(4) + integer plon, nlat + integer i, j + integer ret + integer nargs ! input arg + integer n ! index loops thru input args + + integer dim(2) ! dimension list for output variables + + integer , allocatable :: nlon(:) + real(r8), allocatable :: mlatcnts(:) ! model cell center latitudes + real(r8), allocatable :: mloncnts(:,:) ! model cell center longitudes + real(r8), allocatable :: sgh(:,:) + real(r8), allocatable :: sgh30(:,:) + real(r8), allocatable :: phis(:,:) + real(r8), allocatable :: fland(:,:) + real(r8), allocatable :: landm(:,:) + + integer iargc + external iargc +! +! Default settings before parsing argument list +! + verbose = .false. + make_ross = .true. + filter_del2 = .false. + filter_remap = .false. + filter_sgh = .false. + reduced_grid = .false. + +! parse input arguments + + nargs = iargc() + n = 1 + cmdline = char(10) // 'definesurf ' + do while (n .le. nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + + select case (arg) +! topography file name (10') + case ('-t') + call getarg (n, arg) + n = n + 1 + topofile = arg + cmdline = trim(cmdline) // ' -t ' // trim(topofile) +! grid file name + case ('-g') + call getarg (n, arg) + n = n + 1 + gridfile = arg + cmdline = trim(cmdline) // ' -g ' // trim(gridfile) +! verbose mode + case ('-v') + verbose = .true. + cmdline = trim(cmdline) // ' -v' +! landmask file name + case ('-l') + call getarg (n, arg) + n = n + 1 + landmfile = arg + cmdline = trim(cmdline) // ' -l ' // trim(landmfile) +! extend Ross Sea + case ('-r') + make_ross = .false. + cmdline = trim(cmdline) // ' -r' +! use del2 filter on heights + case ('-del2') + filter_del2 = .true. + cmdline = trim(cmdline) // ' -del2' +! use remap filter on heights + case ('-remap') + filter_remap = .true. + cmdline = trim(cmdline) // ' -remap' +! apply filter to sgh (and sgh30) in addition to height + case ('-sgh') + filter_sgh = .true. + cmdline = trim(cmdline) // ' -sgh' +! not one of the above, must be output file name + case default + if (outbcfile .eq. ' ') then + outbcfile = arg + else + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end if + cmdline = trim(cmdline) // ' ' // trim(arg) + end select + end do + + if (outbcfile == ' ') then + call usage_exit ('Must enter an output file name') + end if + + if (gridfile == ' ') then + call usage_exit ('Must enter gridfile name via -g arg (can use a model history file)') + end if + + if (topofile == ' ') then + call usage_exit ('Must enter topofile name via -t arg') + end if + + if (filter_remap .and. filter_del2) then + write(6,*)'Both filter_remap and filter_del2 set: using filter_remap' + end if + + if (.not. filter_remap .and. .not. filter_del2) then + write(6,*)'No filter being applied to height field' + if (filter_sgh) call usage_exit ('Must filter height to filter sgh') + end if + + if (landmfile == ' ') then + call usage_exit ('Must enter landmfile name via -l arg') + end if + +! Open the grid file + ret = nf_open (trim(gridfile), nf_nowrite, gridid) + if (ret /= nf_noerr) then + write(6,*)nf_strerror(ret) + write(6,*)'Unable to open input file ', trim(gridfile), ' for writing' + stop 999 + end if + +! Get the grid dimensions from the grid file + call wrap_inq_dimid (gridid, 'lon', londimid) + call wrap_inq_dimlen (gridid, londimid, plon ) + call wrap_inq_dimid (gridid, 'lat', latdimid) + call wrap_inq_dimlen (gridid, latdimid, nlat ) +! +! Get longitude and latitude arrays for model grid. +! If reduced grid, 2-d variable containing lon values for each lat is called "rlon". +! First allocate space for dynamic arrays now that sizes are known +! + allocate (nlon(nlat)) + allocate (mlatcnts(nlat)) + allocate (mloncnts(plon,nlat)) + + if (nf_inq_varid (gridid, 'nlon', nlonid) == nf_noerr) then + if (nf_get_var_int (gridid, nlonid, nlon) /= nf_noerr) then + write(6,*)'nf_get_var_int() failed for nlon' + call endrun + end if + reduced_grid = .true. + else + nlon(:) = plon + end if + + do j=1,nlat + if (nlon(j)<1 .or. nlon(j)>plon) then + write(6,*)'nlon(',j,')=',nlon(j),' is invalid.' + write(6,*)'Must be between 1 and ',plon + call endrun + end if + end do + + call wrap_inq_varid (gridid, 'lat', latid) + call wrap_get_var8 (gridid, latid, mlatcnts) + + if (nf_inq_varid (gridid, 'lon', lonid) == nf_noerr) then + call wrap_get_var8 (gridid, lonid, mloncnts(1,1)) + do j=2,nlat + mloncnts(:,j) = mloncnts(:,1) + end do + else + call wrap_inq_varid (gridid, 'rlon', rlonid) + call wrap_get_var8 (gridid, rlonid, mloncnts) + end if + +! Close the grid file + if (nf_close (gridid) == nf_noerr) then + write(6,*) 'close grid file ', trim(gridfile) + else + write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(gridfile) + end if +! +! Allocate space for variables +! + allocate (sgh(plon,nlat)) + allocate (sgh30(plon,nlat)) + allocate (phis(plon,nlat)) + allocate (fland(plon,nlat)) + allocate (landm(plon,nlat)) +! +! Determine model topographic height and 2 standard deviations +! + call sghphis (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & + verbose, sgh, sgh30, have_sgh30, phis, fland) + +! Do the terrain filter. +! Note: not valid if a reduced grid is used. + if (filter_remap) then + z_filter_type = 'remap' + write(6,*)'Remapping terrain filtering' +! 7 and 3 are the recommended mapping accuracy settings + call map2f (plon, nlat, phis, 7, 3, .true.) + if (filter_sgh) then + s_filter_type = 'remap' + write(6,*)'Filtering standard deviation' + call map2f (plon, nlat, sgh, 7, 3, .true.) + if(have_sgh30) call map2f(plon, nlat, sgh30, 7, 3, .true.) + else + s_filter_type = 'none (2x[1-2-1])' + write(6,*)'Not filtering standard deviation' + end if + else if (filter_del2) then + z_filter_type = 'del2' + write(6,*) 'Del2 Terrain filtering' + call sm2(plon, nlat, phis, plon/12, filter_coefficient) + if (filter_sgh) then + s_filter_type = 'del2' + write(6,*)'Filtering standard deviation' + call sm2(plon, nlat, sgh, plon/12, filter_coefficient) + if(have_sgh30) call sm2(plon, nlat, sgh30, plon/12, filter_coefficient) + else + s_filter_type = 'none (2x[1-2-1])' + write(6,*)'Not filtering standard deviation' + end if + else + z_filter_type = 'none' + s_filter_type = 'none (2x[1-2-1])' + endif +! +! Adjustments to land fraction: +! 1. Extend land fraction for Ross Ice shelf +! 2. Set land fractions < .001 to 0.0 +! 3. flag regions outside reduced grid +! + do j=1,nlat + do i=1,nlon(j) +! +! Overwrite FLAND flag as land for Ross ice shelf + if (make_ross .and. mlatcnts(j) < -79.) then + fland(i,j) = 1. + end if + + if (fland(i,j) < .001_r8) fland(i,j) = 0.0 + + end do +! +! Fill region outside reduced grid with flag values + do i=nlon(j)+1,plon + sgh(i,j) = fillvalue + if(have_sgh30) sgh30(i,j) = fillvalue + phis(i,j) = fillvalue + fland(i,j) = fillvalue + landm(i,j) = fillvalue + end do + end do +! +! Calculate LANDM field required by cloud water. +! +!JR Replace original resolution-dependent calculation with interpolation. +!JR +!JR call inimland (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & +!JR verbose, make_ross, landm) +! + call interplandm (plon, nlat, nlon, mlatcnts, mloncnts, & + landmfile, landm) + +! Create NetCDF file for output + ret = nf_create (outbcfile, NF_CLOBBER, foutid) + if (ret .ne. NF_NOERR) call handle_error(ret) + +! Create dimensions for output + call wrap_def_dim (foutid, 'lon', plon, lonid) + call wrap_def_dim (foutid, 'lat', nlat, latid) + dim(1)=lonid + dim(2)=latid + +! Create latitude dimension variable for output + ret = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latdimid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_text (foutid,latdimid,'long_name', 'latitude') + call wrap_put_att_text (foutid,latdimid,'units' , 'degrees_north') + +! Create longitude dimension variable for output + if (.not.reduced_grid) then + ret = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, londimid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_text (foutid,londimid,'long_name', 'longitude') + call wrap_put_att_text (foutid,londimid,'units' , 'degrees_east') + +! For reduced grid, add longitude limits (nlon) and lons (rlon) + else + ret = nf_def_var (foutid,'nlon', NF_INT, 1, lonid, londimid) + if (ret .ne. NF_NOERR) call handle_error(ret) + ret = nf_def_var (foutid,'rlon', NF_DOUBLE, 2, dim, rlonid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_text (foutid,rlonid,'long_name', 'longitude') + call wrap_put_att_text (foutid,rlonid,'units' , 'degrees_east') + end if + +! Create variables for output + ret = nf_def_var (foutid,'PHIS' , NF_DOUBLE, 2, dim, phisid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_double (foutid, phisid, '_FillValue', nf_double, 1, fillvalue) + call wrap_put_att_double (foutid, phisid, 'missing_value', nf_double, 1, fillvalue) + call wrap_put_att_text (foutid, phisid, 'long_name' , 'surface geopotential') + call wrap_put_att_text (foutid, phisid, 'units' , 'm2/s2') + call wrap_put_att_text (foutid, phisid, 'from_hires', 'true') + call wrap_put_att_text (foutid, phisid, 'filter' , z_filter_type) + + ret = nf_def_var (foutid,'SGH' , NF_DOUBLE, 2, dim, sghid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_double (foutid, sghid, '_FillValue', nf_double, 1, fillvalue) + call wrap_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) + call wrap_put_att_text (foutid, sghid, 'long_name' , 'standard deviation of 10-min elevations') + call wrap_put_att_text (foutid, sghid, 'units' , 'm') + call wrap_put_att_text (foutid, sghid, 'from_hires', 'true') + call wrap_put_att_text (foutid, sghid, 'filter' , s_filter_type) + + if (have_sgh30) then + ret = nf_def_var (foutid,'SGH30' , NF_DOUBLE, 2, dim, sgh30id) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_double (foutid, sgh30id, '_FillValue', nf_double, 1, fillvalue) + call wrap_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) + call wrap_put_att_text (foutid, sgh30id, 'long_name' , 'standard deviation of elevation from 30s to 10m') + call wrap_put_att_text (foutid, sgh30id, 'units' , 'm') + call wrap_put_att_text (foutid, sgh30id, 'from_hires', 'true') + call wrap_put_att_text (foutid, sgh30id, 'filter' , s_filter_type) + endif + + ret = nf_def_var (foutid,'LANDFRAC' , NF_DOUBLE, 2, dim, landfid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_double (foutid, landfid, '_FillValue', nf_double, 1, fillvalue) + call wrap_put_att_double (foutid, landfid, 'missing_value', nf_double, 1, fillvalue) + call wrap_put_att_text (foutid, landfid, 'long_name' , 'gridbox land fraction') + call wrap_put_att_text (foutid, landfid, 'from_hires', 'true') + + ret = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, dim, landmid) + if (ret .ne. NF_NOERR) call handle_error(ret) + call wrap_put_att_double (foutid, landmid, '_FillValue', nf_double, 1, fillvalue) + call wrap_put_att_double (foutid, landmid, 'missing_value', nf_double, 1, fillvalue) + call wrap_put_att_text (foutid, landmid, 'long_name' , & + 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') + call wrap_put_att_text (foutid, landmid, 'from_hires', 'true') + +! Define history attribute. + call DATE_AND_TIME(DATE=datestring) + history = 'Written on date: ' // datestring // cmdline + call wrap_put_att_text (foutid, nf_global, 'history', history) + +! Define Ross Sea attribute + if (make_ross) then + write (6,*) 'Extending Ross ice shelf south of -79 degrees' + call wrap_put_att_text (foutid, nf_global, 'make_ross', 'true') + else + write (6,*) 'Not doing anything special for Ross ice shelf' + call wrap_put_att_text (foutid, nf_global, 'make_ross', 'false') + end if + +! Define source file attributes + call wrap_put_att_text (foutid, nf_global, 'topofile', topofile) + cmdlen = len_trim (gridfile) + call wrap_put_att_text (foutid, nf_global, 'gridfile', gridfile) + cmdlen = len_trim (landmfile) + call wrap_put_att_text (foutid, nf_global, 'landmask', landmfile) + + +! End definition of netCDF file + ret = nf_enddef (foutid) + if (ret/=NF_NOERR) call handle_error (ret) + + +! Write data to file + write(6,*) 'Writing surface quantities' + +! Write dimension variables + call wrap_put_var8 (foutid, latdimid, mlatcnts) + if (.not.reduced_grid) then + call wrap_put_var8 (foutid, londimid, mloncnts(:,1)) + else + ret = nf_put_var_int (foutid, nlonid, nlon) + if (ret/=NF_NOERR) call handle_error (ret) + call wrap_put_vara8 (foutid, rlonid, start, count, mloncnts) + end if + + start(:) = 1 + count(1) = plon + count(2) = nlat + count(3:) = 1 + + call wrap_put_vara8 (foutid, sghid, start, count, sgh) + if(have_sgh30) call wrap_put_vara8 (foutid, sgh30id, start, count, sgh30) + call wrap_put_vara8 (foutid, phisid , start, count, phis) + call wrap_put_vara8 (foutid, landfid, start, count, fland) + call wrap_put_vara8 (foutid, landmid, start, count, landm) + + if (nf_close (foutid) == nf_noerr) then + write(6,*) 'Successfully defined surface quantities on ', trim(outbcfile) + else + write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(outbcfile) + end if + + deallocate (nlon) + deallocate (mlatcnts) + deallocate (mloncnts) + deallocate (sgh) + deallocate (sgh30) + deallocate (phis) + deallocate (fland) + deallocate (landm) + + stop 0 +end program fmain + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg /= ' ') write (6,*) arg + write (6,*) 'Usage: definesurf -t topofile -g gridfile -l landmfile [-v] [-r] [-del2] [-remap] outfile' + write (6,*) ' -v verbose mode' + write (6,*) ' -r Do *not* extend Ross Ice Shelf as land ice' + write (6,*) ' -del2 use del2 terrain filter (not a valid option for reduced grid)' + write (6,*) ' -remap use remapping filter (not a valid option for reduced grid)' + write (6,*) ' -sgh filter sgh and sgh30 using same terrain filter' + stop 999 +end subroutine usage_exit diff --git a/tools/definesurf/handle_error.f90 b/tools/definesurf/handle_error.f90 new file mode 100644 index 0000000000..519f829097 --- /dev/null +++ b/tools/definesurf/handle_error.f90 @@ -0,0 +1,11 @@ +subroutine handle_error (ret) + implicit none + + integer ret + + include 'netcdf.inc' + + write(6,*) nf_strerror (ret) + call abort + stop 999 +end subroutine handle_error diff --git a/tools/definesurf/inimland.f90 b/tools/definesurf/inimland.f90 new file mode 100644 index 0000000000..af929f1b98 --- /dev/null +++ b/tools/definesurf/inimland.f90 @@ -0,0 +1,205 @@ +subroutine inimland (plon, nlat, nlon_reduced, mlatcnts, mloncnts, topofile, & + verbose, make_ross, landm_reduced) + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none +! +! Input arguments +! + integer , intent(in) :: plon ! number of longitudes + integer , intent(in) :: nlat ! number of latitudes + integer , intent(in) :: nlon_reduced(nlat) ! number of reduced latitudes + real(r8), intent(in) :: mlatcnts(nlat) ! latitude at center of grid cell + real(r8), intent(in) :: mloncnts(plon,nlat) ! model cell ceneter longitudes + character(len=*), intent(in) :: topofile ! high res topo file + logical, intent(in) :: verbose ! verbose output + logical, intent(in) :: make_ross ! flag to make Ross ice shelf +! +! Output arguments +! + real(r8), intent(out) :: landm_reduced(plon,nlat) ! landm on reduced grid + +! Local variables + + real(r8) landm(plon,nlat) ! landm on full grid + real(r8) clon(plon) + real(r8) clon_reduced(plon,nlat) + real(r8) cont(plon,nlat) + real(r8) temp(plon,nlat) + real(r8) dmax + real(r8) arad + real(r8) dist + real(r8) sum + real(r8) cs(nlat) + real(r8) ss(nlat) + real(r8) c1 + real(r8) s1 + real(r8) c2 + real(r8) s2 + real(r8) dx + real(r8) dy + real(r8) term + real(r8) pi + real(r8) sgh(plon,nlat) ! required by SGHPHIS (unused locally) + real(r8) phis(plon,nlat) ! required by SGHPHIS (unused locally) + real(r8) oro(plon,nlat) ! land/ocean flag + real(r8) fland(plon,nlat) ! land fraction output from SGHPHIS + real(r8) mloncnts_full(plon,nlat) ! longitudes for rectangular grid + + integer i + integer j + integer ii + integer jj + integer iplm1 + integer jof + integer iof + integer itmp + integer jmin, jmax + integer nlon(nlat) + integer latid + + pi = acos(-1.d0) +! +! Define longitudes for a rectangular grid: index nlat/2+1 will be a latitude +! closest to the equator, i.e. with the most points in a reduced grid. +! + nlon(:) = plon + do j=1,nlat + mloncnts_full(:,j) = mloncnts(:,nlat/2+1) + end do + + call sghphis (plon, nlat, nlon, mlatcnts, mloncnts_full, topofile, & + verbose, sgh, phis, fland) +! +! Define land mask. Set all non-land points to ocean (i.e. not sea ice). +! + where (fland(:,:) >= 0.5) + oro(:,:) = 1. + elsewhere + oro(:,:) = 0. + endwhere +! +! Overwrite ORO flag as land for Ross ice shelf: note that the ORO field +! defined in this routine is only used locally. +! + do j=1,nlat + if (make_ross .and. mlatcnts(j) < -79.) then + do i=1,plon + oro(i,j) = 1. + end do + end if + end do +! +! Code lifted directly from cldwat.F +! + dmax = 2.e6 ! distance to carry the mask + arad = 6.37e6 + do i = 1,plon + clon(i) = 2.*(i-1)*pi/plon + end do +! +! first isolate the contenents +! as land points not surrounded by ocean or ice +! + do j = 1,nlat + cs(j) = cos(mlatcnts(j)*pi/180.) + ss(J) = sin(mlatcnts(j)*pi/180.) + do i = 1,plon + cont(i,j) = 0. + if (nint(oro(i,j)) .eq. 1) then + cont(i,j) = 1. + endif + end do + temp(1,j) = cont(1,j) + temp(plon,j) = cont(plon,j) + end do + + do i = 1,plon + temp(i,1) = cont(i,1) + temp(i,nlat) = cont(i,nlat) + end do +! +! get rid of one and two point islands +! + do j = 2,nlat-1 + do i = 2,plon-1 + sum = cont(i ,j+1) + cont(i ,j-1) & + + cont(i+1,j+1) + cont(i+1,j-1) & + + cont(i-1,j+1) + cont(i-1,j-1) & + + cont(i+1,j ) + cont(i-1,j) & + + cont(i ,j ) + if (sum.le.2.) then + temp(i,j) = 0. + else + temp(i,j) = 1. + endif + enddo + end do + + do j = 1,nlat + do i = 1,plon + cont(i,j) = temp(i,j) + end do + end do +! +! construct a function which is one over land, +! zero over ocean points beyond dmax from land +! + iplm1 = 2*plon - 1 + dy = pi*arad/nlat + jof = dmax/dy + 1 +! write (6,*) ' lat bands to check ', 2*jof+1 + do j = 1,nlat + c1 = cs(j) + s1 = ss(j) + dx = 2*pi*arad*cs(j)/plon +! +! if dx is too small, int(dmax/dx) may exceed the maximum size +! of an integer, especially on Suns, causing a core dump. Test +! to avoid that. +! + if (dx .lt. 1. .and. dmax .gt. 10000.) then + iof = plon + else + iof = min(int(dmax/dx) + 1, plon) + end if + do i = 1,plon + temp(i,j) = 0. + landm(i,j) = 0. + jmin = max(1,j-jof) + jmax = min(nlat,j+jof) + do jj = jmin, jmax + s2 = ss(jj) + c2 = cs(jj) + do itmp = -iof,iof + ii = mod(i+itmp+iplm1,plon)+1 + term = s1*s2 + c1*c2*cos(clon(ii)-clon(i)) + if (term.gt.0.9999999) term = 1. + dist = arad*acos(term) + landm(i,j) = max(landm(i,j), (1.-dist/dmax)*cont(ii,jj)) +! if (dist.lt.dmax .and. cont(ii,jj).eq.1) then +! landm(i,j) = max(landm(i,j), 1.-dist/dmax) +! endif + end do + end do + end do + end do +! +! Interpolate to reduced grid. Redefine clon in terms of degrees for interpolation +! + do i = 1,plon + clon(i) = (i-1)*360./plon + end do + do j=1,nlat + do i=1,nlon_reduced(j) + clon_reduced(i,j) = (i-1)*360./nlon_reduced(j) + end do + end do + + do j=1,nlat + call lininterp (landm(1,j), plon, 1, clon, & + landm_reduced(1,j), nlon_reduced(j), 1, clon_reduced(1,j), .true.) + end do + + return + end diff --git a/tools/definesurf/interplandm.f90 b/tools/definesurf/interplandm.f90 new file mode 100644 index 0000000000..88e5fd3d17 --- /dev/null +++ b/tools/definesurf/interplandm.f90 @@ -0,0 +1,92 @@ +subroutine interplandm (plono, nlato, nlono, lato, rlono, & + landmfile, landmo) +! +! Read LANDM_COSLAT from input file and interpolate to output grid. +! The input grid is assumed rectangular, but the output grid may +! be reduced. +! + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer , intent(in) :: plono ! output longitude dimension + integer , intent(in) :: nlato ! number of latitudes + integer , intent(in) :: nlono(nlato) ! number of reduced latitudes + real(r8), intent(in) :: lato(nlato) ! latitude at center of grid cell + real(r8), intent(in) :: rlono(plono,nlato) ! longitude on (potentially reduced) output grid + character(len=*), intent(in) :: landmfile ! file containing input LANDM_COSLAT +! +! Output arguments +! + real(r8), intent(out) :: landmo(plono,nlato) ! landm on reduced grid + +! Local variables + + integer :: nloni + integer :: nlati + integer :: i,j ! spatial indices + integer :: ret ! return code + + integer :: landmfileid ! netcdf file id for landm file + integer :: londimid, latdimid ! lon, lat dimension ids + integer :: lonid, latid ! lon, lat var ids + integer :: landmid ! landm variable id + + real(r8), allocatable :: landmi(:,:) ! landm on full grid + real(r8), allocatable :: lati(:) + real(r8), allocatable :: loni(:) + real(r8), allocatable :: xtemp(:,:) ! temporary for interpolation + + ret = nf_open (landmfile, nf_nowrite, landmfileid) + if (ret /= nf_noerr) then + write(6,*)nf_strerror(ret) + write(6,*)'Unable to open input file ', trim (landmfile) + stop 999 + end if +! +! Retrieve grid info and LANDM_COSLAT field from from offline file. +! + call wrap_inq_dimid (landmfileid, 'lat', latdimid) + call wrap_inq_dimlen (landmfileid, latdimid, nlati) + + call wrap_inq_dimid (landmfileid, 'lon', londimid) + call wrap_inq_dimlen (landmfileid, londimid, nloni) + + allocate (lati(nlati)) + allocate (loni(nloni)) + allocate (landmi(nloni,nlati)) + + call wrap_inq_varid (landmfileid, 'lat', latid) + call wrap_get_var8 (landmfileid, latid, lati) + + call wrap_inq_varid (landmfileid, 'lon', lonid) + call wrap_get_var8 (landmfileid, lonid, loni) + + call wrap_inq_varid (landmfileid, 'LANDM_COSLAT', landmid) + call wrap_get_var8 (landmfileid, landmid, landmi) + + allocate (xtemp(nloni,nlato)) +! +! For rectangular -> reduced, interpolate first in latitude, then longitude +! + do i=1,nloni + call lininterp (landmi(i,1), nlati, nloni, lati, & + xtemp(i,1), nlato, nloni, lato, .false.) + end do + + do j=1,nlato + call lininterp (xtemp(1,j), nloni, 1, loni, & + landmo(1,j), nlono(j), 1, rlono(1,j), .true.) + end do + + deallocate (xtemp) + deallocate (lati) + deallocate (loni) + deallocate (landmi) + + return +end subroutine interplandm diff --git a/tools/definesurf/lininterp.f90 b/tools/definesurf/lininterp.f90 new file mode 100644 index 0000000000..9d5d9d9e76 --- /dev/null +++ b/tools/definesurf/lininterp.f90 @@ -0,0 +1,174 @@ +subroutine lininterp (arrin, nxin, incin, xin, & + arrout, nxout, incout, xout, periodic) + use shr_kind_mod, only: r8 => shr_kind_r8 + +!----------------------------------------------------------------------- +! +! Do a linear interpolation from input mesh defined by xin to output +! mesh defined by xout. Where extrapolation is necessary, values will +! be copied from the extreme edge of the input grid. +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! +!----------------------------------------------------------------------- + implicit none +!----------------------------------------------------------------------- +! +! Arguments +! + integer nxin, incin + integer nxout, incout + + real(r8) xin(nxin), xout(nxout) + real(r8) arrin(incin,nxin) + real(r8) arrout(incout,nxout) + + logical periodic +! +! Local workspace +! + integer i, ii ! input grid indices + integer im, ip, iiprev ! input grid indices + integer icount ! number of values + + real(r8) extrap ! percent grid non-overlap + real(r8) dxinwrap ! delta-x on input grid for 2-pi + real(r8) avgdxin ! avg input delta-x + real(r8) ratio ! compare dxinwrap to avgdxin +! +! Dynamic +! + integer iim(nxout) ! interp. indices minus + integer iip(nxout) ! interp. indices plus + + real(r8) wgtm(nxout) ! interp. weight minus + real(r8) wgtp(nxout) ! interp. weight plus +! +! Just copy the data and return if input dimensions are 1 +! + if (nxin.eq.1 .and. nxout.eq.1) then + arrout(1,1) = arrin(1,1) + else if (nxin.eq.1) then + write(6,*)'LININTERP: Must have at least 2 input points' + call abort + end if + icount = 0 + do i=1,nxin-1 + if (xin(i).gt.xin(i+1)) icount = icount + 1 + end do + do i=1,nxout-1 + if (xout(i).gt.xout(i+1)) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Non-monotonic coordinate array(s) found' + call abort + end if +! +! Initialize index arrays for later checking +! + do i=1,nxout + iim(i) = 0 + iip(i) = 0 + end do + if (periodic) then +! +! Periodic case: for values which extend beyond boundaries, assume +! periodicity and interpolate between endpoints. First check for sane +! periodicity assumption. +! + if (xin(1).lt.0. .or. xin(nxin).gt.360.) then + write(6,*)'LININTERP: For periodic Input x-grid must be between 0 and 360' + call abort + end if + if (xout(1).lt.0. .or. xout(nxout).gt.360.) then + write(6,*)'Output x-grid must be between 0 and 360' + call abort + end if + dxinwrap = xin(1) + 360. - xin(nxin) + avgdxin = (xin(nxin)-xin(1))/(nxin-1.) + ratio = dxinwrap/avgdxin + if (ratio.lt.0.9 .or. ratio.gt.1.1) then + write(6,*)'LININTERP: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin + call abort + end if + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = nxin + iip(im) = 1 + wgtm(im) = (xin(1) - xout(im)) /dxinwrap + wgtp(im) = (xout(im)+360. - xin(nxin))/dxinwrap + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = 1 + wgtm(ip) = (xin(1)+360. - xout(ip)) /dxinwrap + wgtp(ip) = (xout(ip) - xin(nxin))/dxinwrap + end do + else +! +! Non-periodic case: for values which extend beyond boundaries, set weights +! such that values will just be copied. +! + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = 1 + iip(im) = 1 + wgtm(im) = 1. + wgtp(im) = 0. + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = nxin + wgtm(ip) = 1. + wgtp(ip) = 0. + end do + end if +! +! Loop though output indices finding input indices and weights +! + iiprev = 1 + do i=im,ip + do ii=iiprev,nxin-1 + if (xout(i).gt.xin(ii) .and. xout(i).le.xin(ii+1)) then + iim(i) = ii + iip(i) = ii + 1 + wgtm(i) = (xin(ii+1)-xout(i))/(xin(ii+1)-xin(ii)) + wgtp(i) = (xout(i)-xin(ii))/(xin(ii+1)-xin(ii)) + goto 30 + end if + end do + write(6,*)'LININTERP: Failed to find interp values' +30 iiprev = ii + end do +! +! Check grid overlap +! + extrap = 100.*((im - 1.) + (nxout - ip))/nxout + if (extrap.gt.30.) then + write(6,*)'********LININTERP WARNING:',extrap,' % of output', & + ' grid will have to be extrapolated********' + end if +! +! Check that interp/extrap points have been found for all outputs +! + icount = 0 + do i=1,nxout + if (iim(i).eq.0 .or. iip(i).eq.0) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Point found without interp indices' + call abort + end if +! +! Do the interpolation +! + do i=1,nxout + arrout(1,i) = arrin(1,iim(i))*wgtm(i) + arrin(1,iip(i))*wgtp(i) + end do + return +end subroutine lininterp + diff --git a/tools/definesurf/map2f.f90 b/tools/definesurf/map2f.f90 new file mode 100644 index 0000000000..1fb58b3f8a --- /dev/null +++ b/tools/definesurf/map2f.f90 @@ -0,0 +1,1039 @@ + subroutine map2f(im, jm, qm, iord, jord, pfilter) +! +! This is a stand alone 2-Grid-Wave filter for filtering the terrain for +! the finite-volume dynamical core +! Developed and coded by S.-J. Lin +! Data Assimilation Office, NASA/GSFC +! + implicit none +! Input + integer, intent(in):: im ! E-W diimension (e.g., 144 for 2.5 deg) + integer, intent(in):: jm ! N-S dimension (S pole to N pole; 91 for 2 deg) + integer, intent(in):: iord ! Mapping accuracy for E-W; recommended value=7 + integer, intent(in):: jord ! Mapping accuracy for N-S; recommended value=3 + logical, intent(in):: pfilter ! Polar filter (set to .T. for normal application) + +! Input/Output + real*8, intent(inout):: qm(im,jm) ! array to be filtered + +! Local + integer im2, jm2 + integer ndeg + real*8, allocatable:: q2(:,:) + real*8, allocatable:: lon1(:) + real*8, allocatable:: lon2(:) + real*8, allocatable:: sin1(:) + real*8, allocatable:: sin2(:) + real*8, allocatable:: qt1(:,:), qt2(:,:) + + real*8 dx1, dx2 + real*8 dy1, dy2 + + integer i, j + real*8 pi + + ndeg = 45 ! starting latitude for polar filter + pi = 4.d0 * datan(1.d0) + + im2 = im / 2 + if (im2*2 /= im) then + write(*,*) 'Stop in map2f; im=', im + stop + endif + + jm2 = (jm-1) / 2 + 1 + + allocate ( qt1(im2,jm) ) + allocate ( qt2(im2,jm2) ) + + allocate ( q2(im2,jm2) ) + allocate ( lon1(im+1) ) + allocate ( lon2(im2+1) ) + allocate ( sin1(jm+1) ) + allocate ( sin2(jm2+1) ) + + dx1 = 360./im + dx2 = 360./im2 + + dy1 = pi/(jm-1) + dy2 = pi/(jm2-1) + + do i=1,im+1 + lon1(i) = dx1 * (-0.5 + (i-1) ) + enddo + + do i=1,im2+1 + lon2(i) = dx2 * (-0.5 + (i-1) ) + enddo + + sin1(1) = -1. + sin2(1) = -1. + + sin1(jm +1) = 1. + sin2(jm2+1) = 1. + + do j=2,jm + sin1(j) = dsin( -0.5*pi + dy1*(-0.5+(j-1)) ) + enddo + + do j=2,jm2 + sin2(j) = dsin( -0.5*pi + dy2*(-0.5+(j-1)) ) + enddo + + call polavg(qm, im, jm, 1, jm) + if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) + +!============================== +! From full --> half resolution +!============================== + + call xmap(iord, im, jm, sin1, lon1, qm, im2, lon2, qt1 ) + call ymap(im2, jm, sin1, qt1, jm2, sin2, qt2, 0, jord) + +!============================== +! From half --> full resolution +!============================== + + call ymap(im2, jm2, sin2, qt2, jm, sin1, qt1, 0, jord) + call xmap(iord, im2, jm, sin1, lon2, qt1, im, lon1, qm ) + +! Apply Monotonicity preserving polar filter + if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) + call polavg(qm, im, jm, 1, jm) + + deallocate ( q2 ) + deallocate ( lon1 ) + deallocate ( lon2 ) + deallocate ( sin1 ) + deallocate ( sin2 ) + + deallocate ( qt1 ) + deallocate ( qt2 ) + + return + end + + subroutine polavg(p, im, jm, jfirst, jlast) + + implicit none + + integer im, jm, jfirst, jlast + real*8 p(im,jfirst:jlast) + real*8 sum1 + integer i + + if ( jfirst == 1 ) then + sum1 = 0. + do i=1,im + sum1 = sum1 + p(i,1) + enddo + sum1 = sum1/im + + do i=1,im + p(i,1) = sum1 + enddo + endif + + if ( jlast == jm ) then + sum1 = 0. + do i=1,im + sum1 = sum1 + p(i,jm) + enddo + sum1 = sum1/im + + do i=1,im + p(i,jm) = sum1 + enddo + endif + + return + end + + subroutine setrig(im, jm, dp, dl, cosp, cose, sinp, sine) + + implicit none + + integer im, jm + integer j, jm1 + real*8 sine(jm),cosp(jm),sinp(jm),cose(jm) + real*8 dp, dl + real*8 pi, ph5 + + jm1 = jm - 1 + pi = 4.d0 * datan(1.d0) + dl = (pi+pi)/dble(im) + dp = pi/dble(jm1) + + do 10 j=2,jm + ph5 = -0.5d0*pi + (dble(j-1)-0.5d0)*(pi/dble(jm1)) +10 sine(j) = dsin(ph5) + + cosp( 1) = 0. + cosp(jm) = 0. + + do 80 j=2,jm1 +80 cosp(j) = (sine(j+1)-sine(j)) / dp + +! Define cosine at edges.. + + do 90 j=2,jm +90 cose(j) = 0.5 * (cosp(j-1) + cosp(j)) + cose(1) = cose(2) + + sinp( 1) = -1. + sinp(jm) = 1. + + do 100 j=2,jm1 +100 sinp(j) = 0.5 * (sine(j) + sine(j+1)) + + return + end + + subroutine ymap(im, jm, sin1, q1, jn, sin2, q2, iv, jord) + +! Routine to perform area preserving mapping in N-S from an arbitrary +! resolution to another. +! +! sin1 (1) = -1 must be south pole; sin1(jm+1)=1 must be N pole. +! +! sin1(1) < sin1(2) < sin1(3) < ... < sin1(jm) < sin1(jm+1) +! sin2(1) < sin2(2) < sin2(3) < ... < sin2(jn) < sin2(jn+1) +! +! Developer: S.-J. Lin +! First version: piece-wise constant mapping +! Apr 1, 2000 +! Last modified: + + implicit none + +! Input + integer im ! original E-W dimension + integer jm ! original N-S dimension + integer jn ! Target N-S dimension + integer jord + integer iv ! iv=0 scalar; iv=1: vector + real*8 sin1(jm+1) ! original southern edge of the cell + ! sin(lat1) + real*8 sin2(jn+1) ! Target cell's southern edge + real*8 q1(im,jm) ! original data at center of the cell + ! sin(lat2) +! Output + real*8 q2(im,jn) ! Mapped data at the target resolution + +! Local + integer i, j0, m, mm + integer j + +! PPM related arrays + real*8 al(im,jm) + real*8 ar(im,jm) + real*8 a6(im,jm) + real*8 dy1(jm) + + real*8 r3, r23 + parameter ( r3 = 1./3., r23 = 2./3. ) + real*8 pl, pr, qsum, esl + real*8 dy, sum + + do j=1,jm + dy1(j) = sin1(j+1) - sin1(j) + enddo + +! *********************** +! Area preserving mapping +! *********************** + +! Construct subgrid PP distribution + if ( jord == 1 ) then + + do j=1,jm + do i=1,im + a6(i,j) = 0. + ar(i,j) = q1(i,j) + al(i,j) = q1(i,j) + enddo + enddo + + else + + call ppm_lat(im, jm, q1, al, ar, a6, jord, iv) + do i=1,im +! SP + a6(i, 1) = 0. + ar(i, 1) = q1(i,1) + al(i, 1) = q1(i,1) +! NP + a6(i,jm) = 0. + ar(i,jm) = q1(i,jm) + al(i,jm) = q1(i,jm) + enddo + endif + + do 1000 i=1,im + j0 = 1 + do 555 j=1,jn + do 100 m=j0,jm +! +! locate the southern edge: sin2(i) +! + if(sin2(j) .ge. sin1(m) .and. sin2(j) .le. sin1(m+1)) then + pl = (sin2(j)-sin1(m)) / dy1(m) + if(sin2(j+1) .le. sin1(m+1)) then +! entire new cell is within the original cell + pr = (sin2(j+1)-sin1(m)) / dy1(m) + q2(i,j) = al(i,m) + 0.5*(a6(i,m)+ar(i,m)-al(i,m)) & + *(pr+pl)-a6(i,m)*r3*(pr*(pr+pl)+pl**2) + j0 = m + goto 555 + else +! South most fractional area + qsum = (sin1(m+1)-sin2(j))*(al(i,m)+0.5*(a6(i,m)+ & + ar(i,m)-al(i,m))*(1.+pl)-a6(i,m)* & + (r3*(1.+pl*(1.+pl)))) + do mm=m+1,jm +! locate the eastern edge: sin2(j+1) + if(sin2(j+1) .gt. sin1(mm+1) ) then +! Whole layer + qsum = qsum + dy1(mm)*q1(i,mm) + else +! North most fractional area + dy = sin2(j+1)-sin1(mm) + esl = dy / dy1(mm) + qsum = qsum + dy*(al(i,mm)+0.5*esl* & + (ar(i,mm)-al(i,mm)+a6(i,mm)*(1.-r23*esl))) + j0 = mm + goto 123 + endif + enddo + goto 123 + endif + endif +100 continue +123 q2(i,j) = qsum / ( sin2(j+1) - sin2(j) ) +555 continue +1000 continue + +! Final processing for poles + + if ( iv == 0 ) then + +! South pole + sum = 0. + do i=1,im + sum = sum + q2(i,1) + enddo + + sum = sum / im + do i=1,im + q2(i,1) = sum + enddo + +! North pole: + sum = 0. + do i=1,im + sum = sum + q2(i,jn) + enddo + + sum = sum / im + do i=1,im + q2(i,jn) = sum + enddo + + endif + + return + end + + subroutine ppm_lat(im, jm, q, al, ar, a6, jord, iv) + implicit none + +!INPUT + integer im, jm ! Dimensions + real*8 q(im,jm) + real*8 al(im,jm) + real*8 ar(im,jm) + real*8 a6(im,jm) + integer jord + integer iv ! iv=0 scalar + ! iv=1 vector +! Local + real*8 dm(im,jm) + real*8 r3 + parameter ( r3 = 1./3. ) + integer i, j, im2, iop, jm1 + real*8 tmp, qmax, qmin + real*8 qop + +! Compute dm: linear slope + + do j=2,jm-1 + do i=1,im + dm(i,j) = 0.25*(q(i,j+1) - q(i,j-1)) + qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) + qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) + dm(i,j) = sign(min(abs(dm(i,j)),qmin,qmax),dm(i,j)) + enddo + enddo + + im2 = im/2 + jm1 = jm - 1 + +!Poles: + if (iv == 1 ) then +! SP + do i=1,im + if( i .le. im2) then + qop = -q(i+im2,2) + else + qop = -q(i-im2,2) + endif + tmp = 0.25*(q(i,2) - qop) + qmax = max(q(i,2),q(i,1), qop) - q(i,1) + qmin = q(i,1) - min(q(i,2),q(i,1), qop) + dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo +! NP + do i=1,im + if( i .le. im2) then + qop = -q(i+im2,jm1) + else + qop = -q(i-im2,jm1) + endif + tmp = 0.25*(qop - q(i,jm1)) + qmax = max(qop,q(i,jm), q(i,jm1)) - q(i,jm) + qmin = q(i,jm) - min(qop,q(i,jm), q(i,jm1)) + dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + else +! +!********* +! Scalar: +!********* +! SP + do i=1,im2 + tmp = 0.25*(q(i,2)-q(i+im2,2)) + qmax = max(q(i,2),q(i,1), q(i+im2,2)) - q(i,1) + qmin = q(i,1) - min(q(i,2),q(i,1), q(i+im2,2)) + dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i, 1) = - dm(i-im2, 1) + enddo +! NP + do i=1,im2 + tmp = 0.25*(q(i+im2,jm1)-q(i,jm1)) + qmax = max(q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) + qmin = q(i,jm) - min(q(i+im2,jm1),q(i,jm), q(i,jm1)) + dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) + enddo + + do i=im2+1,im + dm(i,jm) = - dm(i-im2,jm) + enddo + endif + + do j=2,jm + do i=1,im + al(i,j) = 0.5*(q(i,j-1)+q(i,j)) + r3*(dm(i,j-1) - dm(i,j)) + enddo + enddo + + do j=1,jm-1 + do i=1,im + ar(i,j) = al(i,j+1) + enddo + enddo + + do j=2,jm-1 + do i=1,im + a6(i,j) = 3.*(q(i,j)+q(i,j) - (al(i,j)+ar(i,j))) + enddo + + call lmppm(dm(1,j), a6(1,j), ar(1,j), & + al(1,j), q(1,j), im, jord-3) + enddo + + return + end + + subroutine xmap(iord, im, jm, sin1, lon1, q1, in, lon2, q2) + +! Routine to perform area preserving mapping in E-W from an arbitrary +! resolution to another. +! Periodic domain will be assumed, i.e., the eastern wall bounding cell +! im is lon1(im+1) = lon1(1); Note the equal sign is true geographysically. +! +! lon1(1) < lon1(2) < lon1(3) < ... < lon1(im) < lon1(im+1) +! lon2(1) < lon2(2) < lon2(3) < ... < lon2(in) < lon2(in+1) +! +! Developer: S.-J. Lin +! First version: piece-wise constant mapping +! Apr 1, 2000 +! Last modified: + + implicit none + +! Input + integer iord + integer im ! original E-W dimension + integer in ! Target E-W dimension + integer jm ! original N-S dimension + real*8 lon1(im+1) ! original western edge of the cell + real*8 sin1(jm+1) + real*8 q1(im,jm) ! original data at center of the cell + real*8 lon2(in+1) ! Target cell's western edge + +! Output + real*8 q2(in,jm) ! Mapped data at the target resolution + +! Local + integer i1, i2 + integer i, i0, m, mm + integer j + integer ird + +! PPM related arrays + real*8 qtmp(-im:im+im) + real*8 al(-im:im+im) + real*8 ar(-im:im+im) + real*8 a6(-im:im+im) + real*8 x1(-im:im+im+1) + real*8 dx1(-im:im+im) + real*8 r3, r23 + parameter ( r3 = 1./3., r23 = 2./3. ) + real*8 pl, pr, qsum, esl + real*8 dx + logical found + + do i=1,im+1 + x1(i) = lon1(i) + enddo + + do i=1,im + dx1(i) = x1(i+1) - x1(i) + enddo + +! check to see if ghosting is necessary + +!************** +! Western edge: +!************** + found = .false. + i1 = 1 + do while ( .not. found ) + if( lon2(1) .ge. x1(i1) ) then + found = .true. + else + i1 = i1 - 1 + if (i1 .lt. -im) then + write(6,*) 'failed in xmap' + stop + else + x1(i1) = x1(i1+1) - dx1(im+i1) + dx1(i1) = dx1(im+i1) + endif + endif + enddo + +!************** +! Eastern edge: +!************** + found = .false. + i2 = im+1 + do while ( .not. found ) + if( lon2(in+1) .le. x1(i2) ) then + found = .true. + else + i2 = i2 + 1 + if (i2 .gt. 2*im) then + write(6,*) 'failed in xmap' + stop + else + dx1(i2-1) = dx1(i2-1-im) + x1(i2) = x1(i2-1) + dx1(i2-1) + endif + endif + enddo + + do 1000 j=1,jm + +! *********************** +! Area preserving mapping +! *********************** + +! Construct subgrid PP distribution + if ( abs(sin1(j)+sin1(j+1)) > 1.5 ) then + ird = 3 + elseif ( abs(sin1(j)+sin1(j+1)) < 1.0 ) then + ird = 8 + else + ird = iord + endif + + if ( iord == 1 ) then + do i=1,im + qtmp(i) = q1(i,j) + al(i) = q1(i,j) + ar(i) = q1(i,j) + a6(i) = 0. + enddo + qtmp(0 ) = q1(im,j) + qtmp(im+1) = q1(1, j) + else + call ppm_cycle(im, q1(1,j), al(1), ar(1), a6(1), qtmp, ird) + endif + +! check to see if ghosting is necessary + +! Western edge + if ( i1 .le. 0 ) then + do i=i1,0 + qtmp(i) = qtmp(im+i) + al(i) = al(im+i) + ar(i) = ar(im+i) + a6(i) = a6(im+i) + enddo + endif + +! Eastern edge: + if ( i2 .gt. im+1 ) then + do i=im+1,i2-1 + qtmp(i) = qtmp(i-im) + al(i) = al(i-im) + ar(i) = ar(i-im) + a6(i) = a6(i-im) + enddo + endif + + i0 = i1 + + do 555 i=1,in + do 100 m=i0,i2-1 +! +! locate the western edge: lon2(i) +! + if(lon2(i) .ge. x1(m) .and. lon2(i) .le. x1(m+1)) then + pl = (lon2(i)-x1(m)) / dx1(m) + if(lon2(i+1) .le. x1(m+1)) then +! entire new grid is within the original grid + pr = (lon2(i+1)-x1(m)) / dx1(m) + q2(i,j) = al(m) + 0.5*(a6(m)+ar(m)-al(m)) & + *(pr+pl)-a6(m)*r3*(pr*(pr+pl)+pl**2) + i0 = m + goto 555 + else +! Left most fractional area + qsum = (x1(m+1)-lon2(i))*(al(m)+0.5*(a6(m)+ & + ar(m)-al(m))*(1.+pl)-a6(m)* & + (r3*(1.+pl*(1.+pl)))) + do mm=m+1,i2-1 +! locate the eastern edge: lon2(i+1) + if(lon2(i+1) .gt. x1(mm+1) ) then +! Whole layer + qsum = qsum + dx1(mm)*qtmp(mm) + else +! Right most fractional area + dx = lon2(i+1)-x1(mm) + esl = dx / dx1(mm) + qsum = qsum + dx*(al(mm)+0.5*esl* & + (ar(mm)-al(mm)+a6(mm)*(1.-r23*esl))) + i0 = mm + goto 123 + endif + enddo + goto 123 + endif + endif +100 continue +123 q2(i,j) = qsum / ( lon2(i+1) - lon2(i) ) +555 continue +1000 continue + + return + end + + subroutine ppm_cycle(im, q, al, ar, a6, p, iord) + implicit none + + real*8 r3 + parameter ( r3 = 1./3. ) + +! Input + integer im, iord + real*8 q(1) +! Output + real*8 al(1) + real*8 ar(1) + real*8 a6(1) + real*8 p(-im:im+im) + +! local + real*8 dm(0:im) + integer i, lmt + real*8 tmp, qmax, qmin + + p(0) = q(im) + do i=1,im + p(i) = q(i) + enddo + p(im+1) = q(1) + +! 2nd order slope + do i=1,im + tmp = 0.25*(p(i+1) - p(i-1)) + qmax = max(p(i-1), p(i), p(i+1)) - p(i) + qmin = p(i) - min(p(i-1), p(i), p(i+1)) + dm(i) = sign(min(abs(tmp),qmax,qmin), tmp) + enddo + dm(0) = dm(im) + + do i=1,im + al(i) = 0.5*(p(i-1)+p(i)) + (dm(i-1) - dm(i))*r3 + enddo + + do i=1,im-1 + ar(i) = al(i+1) + enddo + ar(im) = al(1) + + do i=1,im + a6(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) + enddo + + if(iord <= 6) then + lmt = iord - 3 + if(lmt <= 2) call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,lmt) + else + call huynh(im, ar(1), al(1), p(1), a6(1), dm(1)) + call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,2) + endif + + return + end + + subroutine lmppm(dm, a6, ar, al, p, im, lmt) + implicit none + real*8 r12 + parameter ( r12 = 1./12. ) + + integer im, lmt + integer i + real*8 a6(im),ar(im),al(im),p(im),dm(im) + real*8 da1, da2, fmin, a6da + +! LMT = 0: full monotonicity +! LMT = 1: semi-monotonic constraint (no undershoot) +! LMT = 2: positive-definite constraint + + if(lmt.eq.0) then + +! Full constraint + do 100 i=1,im + if(dm(i) .eq. 0.) then + ar(i) = p(i) + al(i) = p(i) + a6(i) = 0. + else + da1 = ar(i) - al(i) + da2 = da1**2 + a6da = a6(i)*da1 + if(a6da .lt. -da2) then + a6(i) = 3.*(al(i)-p(i)) + ar(i) = al(i) - a6(i) + elseif(a6da .gt. da2) then + a6(i) = 3.*(ar(i)-p(i)) + al(i) = ar(i) - a6(i) + endif + endif +100 continue + + elseif(lmt == 1) then +! Semi-monotonic constraint + do 150 i=1,im + if(abs(ar(i)-al(i)) .ge. -a6(i)) go to 150 + if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then + ar(i) = p(i) + al(i) = p(i) + a6(i) = 0. + elseif(ar(i) .gt. al(i)) then + a6(i) = 3.*(al(i)-p(i)) + ar(i) = al(i) - a6(i) + else + a6(i) = 3.*(ar(i)-p(i)) + al(i) = ar(i) - a6(i) + endif +150 continue + elseif(lmt == 2) then +! Positive definite constraint + do 250 i=1,im + if(abs(ar(i)-al(i)) >= -a6(i)) go to 250 + fmin = p(i) + 0.25*(ar(i)-al(i))**2/a6(i) + a6(i)*r12 + if(fmin >= 0.) go to 250 + if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then + ar(i) = p(i) + al(i) = p(i) + a6(i) = 0. + elseif(ar(i) .gt. al(i)) then + a6(i) = 3.*(al(i)-p(i)) + ar(i) = al(i) - a6(i) + else + a6(i) = 3.*(ar(i)-p(i)) + al(i) = ar(i) - a6(i) + endif +250 continue + endif + return + end + + subroutine huynh(im, ar, al, p, d2, d1) + +! Enforce Huynh's 2nd constraint in 1D periodic domain + + implicit none + integer im, i + real*8 ar(im) + real*8 al(im) + real*8 p(im) + real*8 d2(im) + real*8 d1(im) + +! Local scalars: + real*8 pmp + real*8 lac + real*8 pmin + real*8 pmax + +! Compute d1 and d2 + d1(1) = p(1) - p(im) + do i=2,im + d1(i) = p(i) - p(i-1) + enddo + + do i=1,im-1 + d2(i) = d1(i+1) - d1(i) + enddo + d2(im) = d1(1) - d1(im) + +! Constraint for AR +! i = 1 + pmp = p(1) + 2.0 * d1(1) + lac = p(1) + 0.5 * (d1(1)+d2(im)) + d2(im) + pmin = min(p(1), pmp, lac) + pmax = max(p(1), pmp, lac) + ar(1) = min(pmax, max(ar(1), pmin)) + + do i=2, im + pmp = p(i) + 2.0*d1(i) + lac = p(i) + 0.5*(d1(i)+d2(i-1)) + d2(i-1) + pmin = min(p(i), pmp, lac) + pmax = max(p(i), pmp, lac) + ar(i) = min(pmax, max(ar(i), pmin)) + enddo + +! Constraint for AL + do i=1, im-1 + pmp = p(i) - 2.0*d1(i+1) + lac = p(i) + 0.5*(d2(i+1)-d1(i+1)) + d2(i+1) + pmin = min(p(i), pmp, lac) + pmax = max(p(i), pmp, lac) + al(i) = min(pmax, max(al(i), pmin)) + enddo + +! i=im + i = im + pmp = p(im) - 2.0*d1(1) + lac = p(im) + 0.5*(d2(1)-d1(1)) + d2(1) + pmin = min(p(im), pmp, lac) + pmax = max(p(im), pmp, lac) + al(im) = min(pmax, max(al(im), pmin)) + +! compute A6 (d2) + do i=1, im + d2(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) + enddo + return + end + + subroutine plft2d(im, jm, p, JS, JN, ndeg) +! +! This is a weak LOCAL polar filter. +! Developer: Shian-Jiann Lin + + implicit none + + integer im + integer jm + integer js, jn, ndeg + real*8 p(im,jm) + + integer i, j, n, ideg, jj, jc + real*8 cosp(jm),cose(jm) + real*8 a(0:im/2+1) + + real*8 sine(jm),sinp(jm) + real*8, allocatable, save :: se(:), sc(:) + + real*8 pi, dp, dl, e0, ycrit, coszc, smax, rn, rn2, esl, tmp + + data IDEG /0/ + + if(IDEG .ne. ndeg) then + IDEG = ndeg +! (e0 = 2.6) + e0 = 0.5 * sqrt(27.) + PI = 4. * ATAN(1.) + + allocate( sc(jm), se(jm)) + + call setrig(im, jm, dp, dl, cosp, cose, sinp, sine) + + ycrit = IDEG*PI/180. + coszc = cos(ycrit) + + smax = (jm-1)/2 + write(6,*) 'Critical latitude in local pft = ',ndeg + + a(0) = 1. + do n=1,im/2+1 + rn = n + rn2 = 2*n + a(n) = sqrt(rn2+1.) * ((rn2+1.)/rn2)**rn + enddo + + do j=2,jm-1 + sc(j) = coszc / cosp(j) + + IF(sc(j) > 1. .and. sc(j) <= 1.5 ) THEN + esl = 1./ sc(j) + sc(j) = 1. + (1.-esl) / (1.+esl) + ELSEIF(sc(j) > 1.5 .and. sc(j) <= e0 ) THEN + esl = 1./ sc(j) + sc(j) = 1. + 2./ (27.*esl**2 - 2.) + ELSEIF(sc(j) > e0) THEN +! Search + do jj=1,im/2 + if(sc(j) <= a(jj)) then + jc = jj +! write(*,*) 'jc=', jc + goto 111 + endif + enddo + jc = im/2 + 1 +111 continue + + tmp = ((sc(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 + sc(j) = jc + min(1.d0, tmp) +! sc(j) = min(smax,sc(j)) + ENDIF + enddo +! ==================================================== + do j=2,jm + se(j) = coszc / cose(j) + IF(se(j) > 1. .and. se(j) <= 1.5 ) THEN + esl = 1./ se(j) + se(j) = 1. + (1.-esl) / (1.+esl) + ELSEIF(se(j) > 1.5 .and. se(j) <= e0 ) THEN + esl = 1./ se(j) + se(j) = 1. + 2./ (27.*esl**2 - 2.) + ELSEIF(se(j) > e0) THEN +! Search + do jj=1,im/2 + if(se(j) <= a(jj)) then + jc = jj + goto 222 + endif + enddo + + jc = im/2 + 1 +222 continue + tmp = ((se(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 + se(j) = jc + min(1.d0, tmp) +! se(j) = min(smax,se(j)) + ENDIF + enddo + + do i=1,im + se( 2) = sc(2) + se(jm) = sc(jm-1) + enddo + + do j=2,jm-1 +! write(*,*) j,sc(j) + enddo + ENDIF + + if( JN == (jm-1) ) then +! Cell-centered variables + call lpft(im, jm, p, 2, jm-1, Sc) + else +! Cell-edge variables + call lpft(im, jm, p, 2, jm, Se) + endif + return + end + + + subroutine lpft(im, jm, p, j1, j2, s) + implicit none + + integer im, jm, j1, j2 + real*8 p(im,jm) + real*8 s(jm) + +! Local + integer i, j, n, nt + + real*8 ptmp(0:im+1) + real*8 q(0:im+1) + real*8 frac, rsc, bt + + do 2500 j=j1,j2 + if(s(j) > 1.02) then + + NT = INT(S(j)) + frac = S(j) - NT + NT = NT-1 + + rsc = 1. / (1.+frac) + bt = 0.5 * frac + + do i=1,im + ptmp(i) = p(i,j) + enddo + + ptmp(0) = p(im,j) + ptmp(im+1) = p(1 ,j) + + if( NT < 1 ) then + do i=1,im + p(i,j) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) + enddo + else + do i=1,im + q(i) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) + enddo + + do 500 N=1,NT + q(0) = q(im) + do i=1,im + ptmp(i) = q(i) + q(i-1) + enddo + ptmp(im+1) = ptmp(1) + + if ( n == nt ) then + do i=1,im + p(i,j) = 0.25*(ptmp(i) + ptmp(i+1)) + enddo + else + do i=1,im + q(i) = 0.25*(ptmp(i) + ptmp(i+1)) + enddo + endif +500 continue + endif + endif +2500 continue + + return + end diff --git a/tools/definesurf/map_i.f90 b/tools/definesurf/map_i.f90 new file mode 100644 index 0000000000..d73e02e7db --- /dev/null +++ b/tools/definesurf/map_i.f90 @@ -0,0 +1,136 @@ +subroutine map_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i, & + nlon_o , nlat_o , numlon_o, lon_o , lat_o, & + mxovr_i2o, iovr_i2o, jovr_i2o, wovr_i2o) + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +! ------------------------ code history --------------------------- +! source file: map_i.F +! purpose: driver for area averaging initialization +! date last revised: July 2000 +! author: Mariana Vertenstein +! ----------------------------------------------------------------- + +! ------------------------ notes ---------------------------------- +! o get indices and weights for area-averaging: +! +! from input surface grid to output model grid +! +! o input surface and output model grids can be any resolution BUT: +! +! both grids must be oriented south to north, i.e., cell(lat+1) +! must be north of cell(lat). the southern edge of the first row +! must be -90 (south pole) and the northern edge of the last row +! must be +90 (north pole) +! +! both grids must be oriented eastwards, i.e., cell(lon+1) must be +! east of cell(lon). but the two grids do not have to start at the +! same longitude, i.e., one grid can start at dateline and go east; +! the other grid can start at greenwich and go east. longitudes for +! the western edge of the cells must increase continuously and span +! 360 degrees. examples +! dateline : -180 to 180 (- longitudes west of greenwich) +! greenwich : 0 to 360 +! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) +! +! o field values fld_i on an input grid with dimensions nlon_i and nlat_i => +! field values fld_o on an output grid with dimensions nlon_o and nlat_o as +! +! fld_o(io,jo) = +! fld_i(i_ovr(io,jo, 1 ),j_ovr(io,jo, 1 )) * w_ovr(io,jo, 1 ) + +! fld_i(i_ovr(io,jo,mxovr_i),j_ovr(io,jo,mxovr_i)) * w_ovr(io,jo,mxovr_i) +! +! o error checks: +! overlap weights of input cells sum to 1 for each output cell +! global sums of dummy fields are conserved for input => model area-averaging +! ----------------------------------------------------------------- + +! ------------------- arguments ----------------------------------- + integer , intent(in) :: nlon_i !input grid max number of longitude points + integer , intent(in) :: nlat_i !input grid number of latitude points + integer , intent(in) :: numlon_i(nlat_i) !input grid number of longitude points at each lat + real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, west edge (degrees) + real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, south edge (degrees) + integer , intent(in) :: nlon_o !model grid max number of longitude points + integer , intent(in) :: nlat_o !model grid number of latitude points + integer , intent(in) :: numlon_o(nlat_o) !model grid number of longitude points at each lat + real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !model grid cell longitude, west edge (degrees) + real(r8), intent(in) :: lat_o(nlat_o+1) !model grid cell latitude, south edge (degrees) + integer , intent(in) :: mxovr_i2o !max number of input cells that overlap model cell + integer , intent(out):: iovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lon index of overlap input cell + integer , intent(out):: jovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lat index of overlap input cell + real(r8), intent(out):: wovr_i2o(nlon_o,nlat_o,mxovr_i2o) !weight of overlap input cell +! ----------------------------------------------------------------- +! +! ------------------- local variables ----------------------------- +! + real(r8) fld_i(nlon_i,nlat_i) !dummy input grid field + real(r8) fld_o(nlon_o,nlat_o) !dummy model grid field + real(r8) area_i(nlon_i,nlat_i) !input grid cell area + real(r8) area_o(nlon_o,nlat_o) !model grid cell area + real(r8) re !radius of earth + real(r8) sum_fldo !global sum of dummy model field + real(r8) sum_fldi !global sum of dummy input field + integer io,ii !model and input longitude loop indices + integer jo,ji !model and input latitude loop indices + real(r8), parameter :: relerr = 0.000001 !relative error for error checks +! ----------------------------------------------------------------- + +! ----------------------------------------------------------------- +! get cell areas +! ----------------------------------------------------------------- + + call cell_area (nlat_i, nlon_i, numlon_i, lon_i, lat_i, re, area_i) + + call cell_area (nlat_o, nlon_o, numlon_o, lon_o, lat_o, re, area_o) + +! ----------------------------------------------------------------- +! get indices and weights for mapping from input grid to model grid +! ----------------------------------------------------------------- + + call ao_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + mxovr_i2o, iovr_i2o , jovr_i2o, wovr_i2o , re , & + area_o , relerr ) + +! ----------------------------------------------------------------- +! error check: global sum fld_o = global sum fld_i +! ----------------------------------------------------------------- +! +! make dummy input field and sum globally +! + sum_fldi = 0. + do ji = 1, nlat_i + do ii = 1, numlon_i(ji) + fld_i(ii,ji) = (ji-1)*nlon_i + ii + sum_fldi = sum_fldi + area_i(ii,ji)*fld_i(ii,ji) + end do + end do +! +! area-average model field from input field +! + call area_ave (nlat_i , nlon_i , numlon_i ,fld_i , & + nlat_o , nlon_o , numlon_o ,fld_o , & + iovr_i2o , jovr_i2o , wovr_i2o , mxovr_i2o) +! +! global sum of model field +! + sum_fldo = 0. + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + sum_fldo = sum_fldo + area_o(io,jo)*fld_o(io,jo) + end do + end do +! +! check for conservation +! + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'map_i error srf => model: srf field not conserved' + write (6,'(a23,e20.10)') 'global sum model field = ',sum_fldo + write (6,'(a23,e20.10)') 'global sum srf field = ',sum_fldi + call endrun + end if + + return +end subroutine map_i diff --git a/tools/definesurf/max_ovr.f90 b/tools/definesurf/max_ovr.f90 new file mode 100644 index 0000000000..46b01fdc38 --- /dev/null +++ b/tools/definesurf/max_ovr.f90 @@ -0,0 +1,93 @@ +subroutine max_ovr (nlon_i, nlat_i, numlon_i, nlon_o, nlat_o, numlon_o, & + lon_i , lat_i , lon_o , lat_o , novr_max) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: max_ovr +! purpose: determine maximum number of overlapping cells +! input and output grids +! date last revised: March 1997 +! author: Mariana Vertenstein +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer, intent(in) :: nlon_i !number of input longitude points + integer, intent(in) :: nlat_i !number of input latitude points + integer, intent(in) :: numlon_i(nlat_i) !number of longitude points for each input grid cell latitude + integer, intent(in) :: nlon_o !number of output longitude points + integer, intent(in) :: nlat_o !number of output latitude points + integer, intent(in) :: numlon_o(nlat_o) !number of longitude points for each output grid cell latitude + real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, western edge + real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, southern edge + real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !output grid cell longitude, western edge + real(r8), intent(in) :: lat_o(nlat_o+1) !output grid cell latitude , southern edge + integer , intent(out):: novr_max !maximum number of overlapping input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer novr !number of overlapping input cells + integer io,ii !output and input grids longitude loop index + integer jo,ji !output and input grids latitude loop index +! ----------------------------------------------------------------- + + +! ----------------------------------------------------------------- +! for each output grid cell: find overlapping input grid cell and area of +! input grid cell that overlaps with output grid cell. cells overlap if: +! +! southern edge of input grid < northern edge of output grid AND +! northern edge of input grid > southern edge of output grid +! +! western edge of input grid < eastern edge of output grid AND +! eastern edge of input grid > western edge of output grid +! +! lon_o(io,jo) lon_o(io+1,jo) +! +! | | +! --------------------- lat_o(jo+1) +! | | +! | | +! xxxxxxxxxxxxxxx lat_i(ji+1) | +! x | x | +! x input | x output | +! x cell | x cell | +! x ii,ji | x io,jo | +! x | x | +! x ----x---------------- lat_o(jo ) +! x x +! xxxxxxxxxxxxxxx lat_i(ji ) +! x x +! lon_i(ii,ji) lon_i(ii+1,ji) +! ----------------------------------------------------------------- + +! +! determine maximum number of overlapping cells +! loop through all input grid cells to find overlap with output grid. +! code does not vectorize but is only called during initialization. +! + novr_max = 0 + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + novr = 0 + do ji = 1, nlat_i + if (lat_i(ji ).lt.lat_o(jo+1) .and. & + lat_i(ji+1).gt.lat_o(jo )) then !lat ok + do ii = 1, numlon_i(ji) + if (lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & + lon_i(ii+1,ji).gt.lon_o(io ,jo)) then !lon okay + novr = novr + 1 ! increment number of ovrlap cells for io,jo + end if + end do + end if + end do + if (novr .gt. novr_max) novr_max = novr + end do + end do + + return +end subroutine max_ovr diff --git a/tools/definesurf/sghphis.f90 b/tools/definesurf/sghphis.f90 new file mode 100644 index 0000000000..39a694aa84 --- /dev/null +++ b/tools/definesurf/sghphis.f90 @@ -0,0 +1,340 @@ +subroutine sghphis (plon, plat, numlons, mlatcnts, mloncnts, & + topofile, verbose, sgh, sgh30, have_sgh30, phis, fland ) + +!----------------------------------------------------------------------- +! +! Read high resolution topo dataset and calculate values of phis and sgh +! for the model resolution this model +! +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + include 'netcdf.inc' +! +!----------------------------------------------------------------------- +! +! parameters +! + integer , parameter :: ntopolon = 2160 + integer , parameter :: ntopolat = 1080 + integer , parameter :: n2x2lon = 180 + integer , parameter :: n2x2lat = 90 + integer , parameter :: n3x3lon = 120 + integer , parameter :: n3x3lat = 60 + real(r8), parameter :: r8_360 = 360. ! For argument compatibility to mod +! +! arguments +! + integer , intent(in) :: plon ! maximum number of model longitudes + integer , intent(in) :: plat ! number of model latitudes + integer , intent(in) :: numlons(plat) ! number of model longitudes per latitude + real(r8), intent(in) :: mlatcnts(plat) ! model cell center latitudes + real(r8), intent(in) :: mloncnts(plon,plat) ! model cell ceneter longitudes + logical , intent(in) :: verbose ! true => verbose output + character(len=*), intent(in) :: topofile ! high resolution topo file + real(r8), intent(out):: phis(plon,plat) ! model geopotention height + real(r8), intent(out):: sgh(plon,plat) ! model standard dev of geopotential height above 10min + real(r8), intent(out):: sgh30(plon,plat) ! model standard dev of geopotential height from 30s to 10m + logical , intent(out):: have_sgh30 ! true => variance is on topofile, sgh30 will be output + real(r8), intent(out):: fland(plon,plat) ! model fractional land +! +! Local workspace : note that anything with plon or plat in its dimension is dynamic +! + real(r8) wt ! weight for area averaging + real(r8) dx,dy ! increments for definition of intermed grid + +! high resolution topo grid + + integer lonid_topo, latid_topo ! input topo file vars + integer htopoid,ftopoid,ret,varianceid ! input topo file vars + real(r8) tloncnts(ntopolon) ! topo cell center lon boundaries + real(r8) tlatcnts(ntopolat) ! topo cell center lat boundaries + real(r8) tlons(ntopolon+1,ntopolat) ! topo cell W lon boundaries + real(r8) tlats(ntopolat+1) ! topo cell N lat boundaries + real(r8) ftopo(ntopolon,ntopolat) ! Land fraction array + real(r8) htopo(ntopolon,ntopolat) ! Topographic heights + real(r8) variance(ntopolon,ntopolat) ! Variance of elev at 30sec + +! intermediate grid + + real(r8) lons3x3(n3x3lon+1,n3x3lat) ! list of topo cell W lon boundaries + real(r8) lats3x3(n3x3lat+1) ! list of topo cell N lat boundaries + integer num3x3lons(n3x3lat) ! number if longitudes per latitude + real(r8) mnhgt3x3(n3x3lon,n3x3lat) ! intermediate topo height + real(r8) varhgt3x3(n3x3lon,n3x3lat) ! intermediate topovariance + +! model grid + + real(r8) mlons(plon+1,plat) ! model cell W lon boundaries + real(r8) mlats(plat+1) ! model cell N lat boundaries + real(r8) mnhgt(plon,plat) ! model topographic height + real(r8) varhgt(plon,plat) ! model topographic variance + real(r8) summn, sumvar ! use only for pole point calculations + +! other vars + + real(r8) xmax ! temporary variable + real(r8), parameter :: eps = 1.e-6 ! eps criterion for pole point + integer imax, jmax ! indices + integer i,j,ii,ji,io,jo,n ! indices + integer ncid_topo ! topographic netcdf id + integer ioe + integer mxovr ! max number of fine grid points used in area calculation of model grid point +! +! Space needed in 3 dimensions to store the initial data. This space is +! required because the input data file does not have a predetermined +! ordering of the latitude records. A specific order is imposed in the +! transforms so that the results will be reproducible. +! +! Dynamic +! + integer , allocatable :: iovr(:,:,:) ! lon index of overlap input cell + integer , allocatable :: jovr(:,:,:) ! lat index of overlap input cell + real(r8), allocatable :: wovr(:,:,:) ! weight of overlap input cell +! +!----------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- +! Read in navy topo cell locations and determine cell edges (Uniform grid) +!---------------------------------------------------------------------------- +! + ret = nf_open (topofile, nf_nowrite, ncid_topo) + if (ret == nf_noerr) then + if (verbose) write(6,*)'Successfully opened netcdf topofile ',trim(topofile) + ret = nf_inq_varid (ncid_topo, 'variance', varianceid) + if (ret == NF_NOERR) then + if (verbose) write(6,*)'Found a new style topofile.' + call wrap_get_var8 (ncid_topo, varianceid, variance ) + call wrap_inq_varid (ncid_topo, 'landfract', ftopoid ) + have_sgh30 = .true. + else + if (verbose) write(6,*)'Found an old style topofile.' + call wrap_inq_varid (ncid_topo, 'ftopo', ftopoid ) + have_sgh30 = .false. + end if + call wrap_get_var8 (ncid_topo, ftopoid, ftopo) + call wrap_inq_varid (ncid_topo, 'htopo', htopoid ) + call wrap_get_var8 (ncid_topo, htopoid, htopo) + else + write(6,*)'cannot open topo file successfully' + call endrun + endif + + call wrap_inq_varid (ncid_topo, 'lon', lonid_topo) + call wrap_inq_varid (ncid_topo, 'lat', latid_topo) + + call wrap_get_var8 (ncid_topo, latid_topo, tlatcnts) + call wrap_get_var8 (ncid_topo, lonid_topo, tloncnts) + ret = nf_close (ncid_topo) + + tloncnts(:) = mod(tloncnts(:)+r8_360,r8_360) + + tlats(:) = 1.e36 + tlats(1) = -90. ! south pole + do j = 2, ntopolat + tlats(j) = (tlatcnts(j-1) + tlatcnts(j)) / 2. ! southern edges + end do + tlats(ntopolat+1) = 90. ! north pole + + tlons(:,:) = 1.e36 + do j = 1,ntopolat + dx = 360./ntopolon + tlons(1,j) = tloncnts(1) - dx/2. + do i = 2, ntopolon + tlons(i,j) = tloncnts(i) - dx/2. + end do + tlons(ntopolon+1,j) = tloncnts(ntopolon) + dx/2. + end do +! +!---------------------------------------------------------------------------- +! Determine model cell edges +!---------------------------------------------------------------------------- +! + mlats(:) = 1.e36 + mlats(1) = -90. ! south pole + do j = 2,plat + mlats(j) = (mlatcnts(j-1) + mlatcnts(j)) / 2. ! southern edges + end do + mlats(plat+1) = 90. ! north pole + + do j = 1,plat + dx = 360./(numlons(j)) + do i = 1,plon+1 + mlons(i,j) = -dx/2. + (i-1)*dx + end do + end do + +! +!---------------------------------------------------------------------------- +! Calculate fractional land +!---------------------------------------------------------------------------- +! + call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,ftopo, & + mlons ,mlats ,plon ,plat ,fland) +! +!---------------------------------------------------------------------------- +! Calculate standard deviation of elevation from 30sec to 10min +!---------------------------------------------------------------------------- + + if (have_sgh30) then + call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,variance, & + mlons ,mlats ,plon ,plat ,sgh30) + else + sgh30 = -1 + endif +!------------------------------------------------------------------------- +! Calculate determine mean and variance of topographic height, plon >=128 +!------------------------------------------------------------------------- +! + if (plon >= 128) then + call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo, & + mlons ,mlats ,plon ,plat ,mnhgt) + + call varf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo , & + mlons ,mlats ,plon ,plat ,mnhgt , & + varhgt ) + end if + +!------------------------------------------------------------------------- +! Calculate determine mean and variance of topographic height, plon < 128 +!------------------------------------------------------------------------- + + if (plon < 128) then +! +! bin to uniform 3x3 deg grid then area avg to output grid +! get 3x3 cell boundaries for binning routine +! + dy = 180./n3x3lat + do j = 1, n3x3lat+1 + lats3x3(j) = -90.0 + (j-1)*dy + end do + + num3x3lons(:) = n3x3lon + do j = 1,n3x3lat + dx = 360./(num3x3lons(j)) + do i = 1, num3x3lons(j)+1 + lons3x3(i,j) = 0. + (i-1)*dx + end do + end do +! +! bin mean height to intermed grid +! + call binf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo, & + lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3) +! +! get variation of topography mean height over the intermed grid +! + call varf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo , & + lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3, & + varhgt3x3 ) +! +! get maximum number of 3x3 cells which will to be used in area average +! for each model cell +! + call max_ovr (n3x3lon, n3x3lat, num3x3lons, plon , plat, numlons, & + lons3x3, lats3x3, mlons , mlats , mxovr ) +! +! do area average from intermediate regular grid to gauss grid +! get memory for pointer based arrays +! + allocate(iovr(plon,plat,mxovr)) + allocate(jovr(plon,plat,mxovr)) + allocate(wovr(plon,plat,mxovr)) + + call map_i (n3x3lon, n3x3lat, num3x3lons, lons3x3, lats3x3, & + plon , plat , numlons , mlons , mlats , & + mxovr , iovr , jovr , wovr ) + + do jo = 1, plat + do io = 1, numlons(jo) + mnhgt(io,jo) = 0. + varhgt(io,jo) = 0. + do n = 1, mxovr ! overlap cell index + ii = iovr(io,jo,n) ! lon index (input grid) of overlap cell + ji = jovr(io,jo,n) ! lat index (input grid) of overlap cell + wt = wovr(io,jo,n) ! overlap weight + mnhgt(io,jo) = mnhgt(io,jo) + mnhgt3x3(ii,ji) * wt + varhgt(io,jo) = varhgt(io,jo) + varhgt3x3(ii,ji) * wt + end do + end do + end do + +! If model grid contains pole points, then overwrite above values of phis and sgh at the +! poles with average of values of nearest 2x2 band - this is a fair approximation and +! is done so that above mapping routines do not have to be rewritten to correctly evaulte +! the area average of the pole points + + if (mlatcnts(1)-eps < -90.0 .and. mlatcnts(plat)+eps > 90.0) then + write(6,*)' determining sgh and phis at poles' + summn = 0 + sumvar = 0 + do io = 1,numlons(2) + summn = summn + mnhgt(io,2) + sumvar = sumvar + varhgt(io,2) + end do + do io = 1,numlons(1) + mnhgt(io,1) = summn/numlons(2) + varhgt(io,1) = sumvar/numlons(2) + end do + summn = 0 + sumvar = 0 + do io = 1,numlons(plat-1) + summn = summn + mnhgt(io,plat-1) + sumvar = sumvar + varhgt(io,plat-1) + end do + do io = 1,numlons(plat) + mnhgt(io,plat) = summn/numlons(plat-1) + varhgt(io,plat) = sumvar/numlons(plat-1) + end do + endif + + deallocate(iovr) + deallocate(jovr) + deallocate(wovr) + + end if + +! 1-2-1 smoothing for variation height + + call sm121(varhgt,plon,plat,numlons) + call sm121(varhgt,plon,plat,numlons) + if (have_sgh30) then + call sm121(sgh30,plon,plat,numlons) + call sm121(sgh30,plon,plat,numlons) + end if +! +! get standard deviation for smoothed height field +! +! determine geopotential height field. The multiplication by 9.80616 +! causes phis to be only accurate to 32-bit roundoff on some machines +! + xmax = -1.d99 + do jo=1,plat + do io=1,numlons(jo) + if (varhgt(io,jo) < 0.5) then + sgh(io,jo) = 0. + else + sgh(io,jo) = sqrt(varhgt(io,jo)) + end if + if (have_sgh30) then + if (sgh30(io,jo) < 0.5) then + sgh30(io,jo) = 0. + else + sgh30(io,jo) = sqrt(sgh30(io,jo)) + end if + end if + if (sgh(io,jo) > xmax) then + xmax = sgh(io,jo) + imax = io + jmax = jo + end if + phis(io,jo) = mnhgt(io,jo) * 9.80616 + end do + end do + + if (verbose) write(6,*)'Max SGH =',xmax,' at i,j=', imax, jmax + + return +end subroutine sghphis diff --git a/tools/definesurf/shr_kind_mod.f90 b/tools/definesurf/shr_kind_mod.f90 new file mode 100644 index 0000000000..fc1ed8e94a --- /dev/null +++ b/tools/definesurf/shr_kind_mod.f90 @@ -0,0 +1,20 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + +END MODULE shr_kind_mod diff --git a/tools/definesurf/sm121.f90 b/tools/definesurf/sm121.f90 new file mode 100644 index 0000000000..c4b491616a --- /dev/null +++ b/tools/definesurf/sm121.f90 @@ -0,0 +1,86 @@ +subroutine sm121 (a, plon, nlat, nlon) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! +! perform 1-2-1 smoothing using data array a. On reduced grid, linearly +! interpolate to a rectangular grid (nlon(j),3) before interpolating +! +!----------------------------------------------------------------------- + implicit none +!-----------------------------Arguments--------------------------------- + + integer plon ! Input: Lon dim + integer nlat ! Input: Lat dim + integer nlon(nlat) ! Number of longitudes per latitude + real(r8) a(plon,nlat) ! I/O: Array to be smoothed + +!--------------------------Local variables------------------------------ + + integer i,j ! Indices + integer imin,imax ! Indices + integer jmax,jmin ! Indices +! +! Dynamic +! + real(r8) xin(plon,nlat) + real(r8) xout(plon) + real(r8) temp(plon,nlat) ! Temp array + real(r8) tempjmin(plon) ! Temp array + real(r8) tempjmax(plon) ! Temp array +! +!----------------------------------------------------------------------- +! + temp(:,:) = a(:,:) +! +! first do the S and N boundaries. +! + do i=1,nlon(1) + imin = i - 1 + imax = i + 1 + if( imin .lt. 1 ) imin = imin + nlon(1) + if( imax .gt. nlon(1)) imax = imax - nlon(1) + a(i,1) = (temp(imin,1) + 3.*temp(i,1) +temp(imax,1))/5. + end do + + do i=1,nlon(nlat) + imin = i - 1 + imax = i + 1 + if( imin .lt. 1 ) imin = imin + nlon(nlat) + if( imax .gt. nlon(nlat)) imax = imax - nlon(nlat) + a(i,nlat) = (temp(imin,nlat)+3.*temp(i,nlat)+temp(imax,nlat))/5. + end do +! +! Define xin array for each latitude +! + do j=1,nlat + do i=1,nlon(j) + xin(i,j) = (i-1)*360./nlon(j) + end do + end do +! +! Linearly interpolate data N and S of each target latitude to the longitudes +! of each target latitude before applying 1-2-1 filter +! + do j=2,nlat-1 + jmin = j - 1 + jmax = j + 1 + xout(:) = xin(:,j) + call lininterp (temp(1,jmin), nlon(jmin), 1, xin(1,jmin), & + tempjmin, nlon(j), 1, xout, .true.) + call lininterp (temp(1,jmax), nlon(jmax), 1, xin(1,jmax), & + tempjmax, nlon(j), 1, xout, .true.) + + do i=1,nlon(j) + imin = i - 1 + imax = i + 1 + if( imin .lt. 1 ) imin = imin + nlon(j) + if( imax .gt. nlon(j)) imax = imax - nlon(j) + a(i,j) = (tempjmin(i) + & + temp(imin,j) + 4.*temp(i,j) + temp(imax,j) + & + tempjmax(i) ) / 8. + enddo + enddo +! + return +end subroutine sm121 diff --git a/tools/definesurf/terrain_filter.f90 b/tools/definesurf/terrain_filter.f90 new file mode 100644 index 0000000000..fb80d9c492 --- /dev/null +++ b/tools/definesurf/terrain_filter.f90 @@ -0,0 +1,320 @@ +! Terrain Filter +! +! Contributed by S.J. Lin. +! +! Added to the definesurf program by G. Grant, 30 June 2000. +! Updated with latest version from S.J. by B. Eaton, 23 August 2001 +! +! Notes from S.J.: +! +! "I compute the unsmoothed mean height and the variance +! exactly the same as the standard CCM utility. The only difference +! is the grid being uniformly spaced from North pole to South pole. +! The filter is applied to the mean height and the sqaure root of +! the variance (the standard deviation). +! +! For the 2x2.5 deg resolution +! +! mlon = 144 +! mlat = 91 +! +! Assuming the mean height is Z(mlon,mlat), and the standard deviation +! (the sqaure root of the variance) is SD(moln,mlat), the filter +! algorithm goes like this: +! +! call sm2(mlon, mlat, Z, itmax_Z, 0.25D0) +! call sm2(mlon, mlat, SD, itmax_SD, 0.25D0) +! +! where 0.25D0 is the dimensionless filter coefficient, and +! +! itmax_Z = 2*mlat +! itmax_SD = mlon +! +! [As discussed elsewhere] the above filtering is a bit too strong. +! But it is the filter I used up to now. +! I am currently testing the following setting +! +! itmax_Z = mlat/2 +! itmax_SD = mlon/4 +! " + + + subroutine sm2(im, jm, ht, itmax, c) +! +! Del-2 diffusion on the sphere +! + implicit none + +! Input: + integer im ! e-w dimension (eg, 144 for 2.5 deg resolution) + integer jm ! n-s doemsnion (eg, 91 for 2 deg resolution) + integer itmax ! iteration count + real*8 c ! filter coefficient + +! Input/Output + real*8 ht(im,jm) ! array to be filtered + +! Local + real*8 dg(im,jm) ! del2 of h + real*8 cose(jm), cosp(jm), sinp(jm), sine(jm) + real*8 dl + real*8 dp + real*8 fmin, fmax + integer jm1 + integer mnk, mxk + integer ndeg + integer it, i, j + real*8 s1, s2 + + jm1 = jm-1 + + call setrig(im, jm, dp, DL, cosp, cose, sinp, sine) + + call pmnx(ht, im, jm, fmin, fmax, mnk, mxk) + write(6,*) 'hmax=', fmax,' at j= ',mxk + write(6,*) 'hmin=', fmin,' at j= ',mnk + + ndeg = 60 ! starting latitude for the monotonicity + ! preserving polar filter + + call pmnx(ht,im,jm,fmin,fmax,mnk,mxk) + write(6,*) 'hmax=', fmax,' at j= ',mxk + write(6,*) 'hmin=', fmin,' at j= ',mnk + +! Apply Monotonicity preserving polar filter + call plft2d(im, jm, ht, 2, jm1, ndeg) + call avgp2(ht, sine, im, jm) + + do it=1,itmax + call del2(ht, im, jm, dg, cosp, cose, sine, DL, dp, ndeg) + call plft2d(im, jm, dg, 2, jm1, ndeg) + + do j=1,jm + do i=1,im + ht(i,j) = ht(i,j) + c*dg(i,j) + enddo + enddo + enddo + +! Final polar filter + call plft2d(im, jm, ht, 2, jm1, ndeg) + + return + end + + subroutine del2(h, im, jm, dg, cosp, cose, sine, dL, dp, ndeg) + implicit none + +! AE = 1 (unit radius) +! Input: + integer im + integer jm + integer ndeg +! Input-output + + real*8 h(im,jm) + real*8 dg(im,jm) ! del2 of h + real*8 cose(jm),cosp(jm) + real*8 sine(jm) + real*8 PI, ycrit, coszc, CD + real*8 DL, dp + +! Local + real*8 fx(im,jm) ! e-w fluxes + real*8 fy(im,jm) ! n-s fluxes + integer i, j + + call grad(h, im, jm, fx, fy, cosp, dl, dp) + + PI = 4. * ATAN(1.) + ycrit = float(ndeg)*PI/180. + coszc = cos(ycrit) + + CD = 0.25*DL*DP*coszc**2 +! CD = 0.25*DL*DP*cosp(2)**2 + + do j=2,jm-1 + do i=1,im + fx(i,j) = fx(i,j) * CD + enddo + enddo + + do j=2,jm + do i=1,im + fy(i,j) = fy(i,j) * CD + enddo + enddo + + call divg(im,jm,fx,fy,DG,cosp,cose,sine, dl, dp) + + return + end + + subroutine divg(im, jm, fx, fy, dg, cosp, cose, sine, dl, dp) + implicit none + + integer im + integer jm + real*8 fx(im,jm) ! e-w fluxes + real*8 fy(im,jm) ! n-s fluxes + real*8 DG(im,jm) ! del2 of h + real*8 wk(im,jm) + real*8 cosp(jm), cose(jm), sine(jm) + real*8 rdx + real*8 dl, dp, CDP, sum1, sum2 + integer i,j + + do j=2,jm-1 + + rdx = 1./ (cosp(j)*DL) + + do i=1,im-1 + DG(i,j) = (fx(i+1,j) - fx(i,j)) * rdx + enddo + DG(im,j) = (fx(1,j) - fx(im,j)) * rdx + enddo + + do j=2,jm + do i=1,im + wk(i,j) = fy(i,j) * cose(j) + enddo + enddo + + do j=2,jm-1 + CDP = 1./ (DP*cosp(j)) + do i=1,im + DG(i,j) = DG(i,j) + (wk(i,j+1) - wk(i,j)) * CDP + enddo + enddo + +! Poles; + + sum1 = wk(im, 2) + sum2 = wk(im,jm) + + do i=1,im-1 + sum1 = sum1 + wk(i, 2) + sum2 = sum2 + wk(i,jm) + enddo + + sum1 = sum1 / ( float(im)*(1.+sine(2)) ) + sum2 = -sum2 / ( float(im)*(1.+sine(2)) ) + + do i=1,im + DG(i, 1) = sum1 + DG(i,jm) = sum2 + enddo + + return + end + + subroutine grad(h, im, jm, fx, fy, cosp, DL, DP) + implicit none + integer im + integer jm + real*8 h(im,jm) + real*8 fx(im,jm) ! e-w fluxes + real*8 fy(im,jm) ! n-s fluxes + real*8 cosp(jm) + real*8 RDP, DL, DP, rdx + integer i, j + + RDP = 1./ DP + + do j=2,jm + do i=1,im + fy(i,j) = (h(i,j) - h(i,j-1)) * RDP + enddo + enddo + + do j=2,jm-1 + + rdx = 1./ (cosp(j)*DL) + fx(1,j) = (h(1,j) - h(im,j)) * rdx + do i=2,im + fx(i,j) = (h(i,j) - h(i-1,j)) * rdx + enddo + enddo + + return + end + + subroutine avgp2(p, sine, im, jm) + implicit none + integer im, jm + real*8 p(im,jm) + real*8 sine(jm) + real*8 sum1, sum2 + real*8 sum3, sum4 + real*8 rim + integer i + integer j + integer jm1 + + jm1 = jm-1 + rim = 1./ float(im) + + call sump2(p(1,1),p(1,jm),IM,sum1,sum2) + sum1 = sum1*(1.+sine(2)) + sum2 = sum2*(1.+sine(2)) + + call sump2(p(1,2),p(1,jm1),IM,sum3,sum4) + sum1 = rim * ( sum1 + sum3*(sine(3)-sine(2)) ) / (1.+sine(3)) + sum2 = rim * ( sum2 + sum4*(sine(3)-sine(2)) ) / (1.+sine(3)) + + do i=1,im + P(i, 1) = sum1 + P(i, 2) = sum1 + P(i,jm1) = sum2 + P(i, jm) = sum2 + enddo + return + end + + subroutine sump2(p1,p2,im,s1,s2) + implicit none + integer im,i + real*8 s1,s2 + real*8 p1(*),p2(*) + + s1 = p1(im) + s2 = p2(im) + + do i=1,im-1 + s1 = s1 + p1(i) + s2 = s2 + p2(i) + enddo + return + end + + subroutine pmnx(a,nx,ny,fmin,fmax,mnk,mxk) + implicit none + integer nx + integer ny + integer mnk + integer mxk + real*8 a(nx,*) + real*8 fmax, fmin, temp + integer i,j + + fmax = a(1,1) + fmin = a(1,1) + mnk = 1 + mxk = 1 + + do j=1,ny + do i=1,nx + temp = a(i,j) + if(temp.gt.fmax) then + fmax = temp + mxk = j + elseif(temp .lt. fmin) then + fmin = temp + mnk = j + endif + enddo + enddo + + return + end + diff --git a/tools/definesurf/varf2c.f90 b/tools/definesurf/varf2c.f90 new file mode 100644 index 0000000000..c7f638ff41 --- /dev/null +++ b/tools/definesurf/varf2c.f90 @@ -0,0 +1,219 @@ +subroutine varf2c(flon ,flat ,nflon ,nflat ,fine , & + clon ,clat ,nclon ,nclat ,cmean , & + cvar ) + + use shr_kind_mod, only: r8 => shr_kind_r8 + +!----------------------------------------------------------------------------- +! Bin going from a fine grid to a coarse grid. +! A schematic for the coarse and fine grid systems is shown in +! Figure 1. This code assumes that each data point is represent +! it's surrounding area, called a cell. The first grid data point +! for both grids is assumed to be located at 0E (GM). This +! implies that the 1st cell for both the fine and the coarse grids +! strattles the Greenwich Meridian (GM). This code also assumes +! that there is no data wraparound (last data value is located at +! 360-dx). +! +! FIGURE 1: Overview of the coarse (X) and fine (@) grids +! longitudinal structure where: +! X = location of each coarse grid data point +! @ = location of each fine grid data point +! +! Greenwich Greenwich +! 0 Coarse cells 360 +! : v : +! clon(1): clon(2) v clon(3) clon(nclon): +! v : v v v v : +! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : +! x x x x x : +! x x x x x : +! x c(1) x c(2) x x c(nclon)x : +! x X x X x x X x : +! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : +! x | | | | | | | | | | | | | : +! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : +! xxx|___|___|___|___|___|___| |___|___|___|___|___| : +! v v v v v : +! flon(1) flon(3) v flon(nflon-1) flon(nflon) +! : v : +! : Fine cells : +! 0 360 +! +! The Longitude/Latitude search: +! ------------------------------ +! +! Given a coarse grid cell with west and east boundaries of cWest +! and cEast and south and north boundaries of cSouth and cNorth +! (outlined by "x" in figure 2), find the indices of the fine grid +! points which are contained within the coarse grid cell. imin and +! imax are the indices fine grid points which overlap the western +! and eastern boundary of the coarse cell. jmin and jmax are the +! corresponding indices in the S-N direction. Bin these overlapping +! values to generate coarse(n), the coarse grid data values. +! +! FIGURE 2: Detail of Coarse and Fine cell overlap. +! @ = fine grid data point +! X = coarse grid data point +! +! cWest cEast +! | | x | | x | +! -@-------@---x---@-------@-----x-@- +! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth +! | | x | | x | +! | | x | | x | +! @-------@---x---@-------@-----x-@- jmax +! | | x | c(n) | x | +! | @ | x | | x | +! | | x | | x | +! @-------@---x---@-------@-----x-@- jmin +! | | x | | x | +! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth +! | | x | | x | +! -@-------@---x---@-------@-----x-@- +! | imin imax | +! +! +! When a cell coarse cell strattles the Greenwich Meridian +! --------------------------------------------------------- +! +! The first coarse grid cell strattles the GM, so when the western +! boundary of the coarse cell is < 0, an additional search is carried out. +! It ASSUMES that the easternmost fine grid point overlaps and searches +! westward from nflon, looking for a grid point west of clon(1) +! This generates a second set of longitudinal indices, imin1 and imax1. +! See Figure 3. +! +! Figure 3: Detail of Coarse cell strattling GM: +! ----------------------------------------------- +! +! Greenwich Greenwich +! 0 360 +! cWest : cEast cWest : +! clon(1): clon(2) clon(nclon+1)=clon(1) +! v : v v : +! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : +! x x x x x : +! x x x x x : +! x c(1) x x x c(nclon)x : +! x X x x x X x : +! x ___ ___ ___ _ ___ ___ ___ : +! x | | | | | | | : +! x | @ | @ | @ | @ | @ | @ | : +! xxx|___|___|___|_ ___|___|___| : +! ^ : ^ ^ ^ ^ : +! flon(1): ^ flon(3) flon(nflon-1) ^ : +! ^ : ^ ^ ^ : +! ^ :flon(2) ^ flon(nflon) +! ^ : ^ ^ ^ : +! imin : imax imin1 imax1 : +! : : +! +! +! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. +! because the last two cells of the fine grid will have some +! contribution the the 1st cell of the coarse grid. +! +!----------------------------------------------------------------------- + implicit none +!-----------------------------Arguments--------------------------------- + + integer nflon ! Input: number of fine longitude points + integer nflat ! Input: number of fine latitude points + integer nclon ! Input: number of coarse longitude points + integer nclat ! Input: number of coarse latitude points + + real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) + real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) + real(r8) fine(nflon,nflat) ! Input: Fine grid data array + real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) + real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) + real(r8) cmean(nclon,nclat) ! Input: mean of fine points over coarse grid cell + real(r8) cvar (nclon,nclat) ! Output:variance of fine points over coarse cell + +!--------------------------Local variables------------------------------ + + real(r8) cWest ! Coarse cell longitude, west edge (deg) + real(r8) cEast ! Coarse cell longitude, east edge (deg) + real(r8) cSouth ! Coarse cell latitude, south edge (deg) + real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) + real(r8) sum ! coarse tmp value + + integer i,j ! Indices + integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. + integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM + integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. + integer iclon,jclat ! coarse grid indices + integer num ! increment + +!----------------------------------------------------------------------------- + + do jclat= 1,nclat ! loop over coarse latitudes + cSouth = clat(jclat) + cNorth = clat(jclat+1) + + do iclon=1,nclon ! loop over coarse longitudes + cWest = clon(iclon,jclat) + cEAST = clon(iclon+1,jclat) + +! 1. Normal longitude search: Find imin and imax + + imin = 0 + imax = 0 + do i=1,nflon-1 ! loop over fine lons, W -> E + if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box + if (flon(i) .ge. cWest .and. imin.eq.0) imin=i + imax=i + enddo + +! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward +! from the end to find indices of any overlapping fine grid cells: +! imin1 and imax1. + +10 imin1 = 0 ! borders for cWest, cEast + imax1 = -1 ! borders for cWest, cEast + if (cWest .lt. 0) then + cWest = cWest + 360. + imax1 = nflon + do i=nflon,1,-1 ! loop over fine lons, E -> W + imin1=i + if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box + enddo + endif + +! 3. Do the latitude search S -> N for jmin and jmax + +20 jmin = 0 + jmax = 0 + do j=1,nflat ! loop over fine lats, S -> N + if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box + if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j + jmax=j + enddo +30 continue + +! 4. Sdv + + sum = 0. ! Initialize coarse data value + num = 0 + + do j=jmin,jmax ! loop over fine lats, S -> N + do i=imin,imax ! loop over fine lons, W -> E + sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 + num = num + 1 + enddo + do i=imin1,imax1 ! If coarse cell strattles GM + sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 + num = num + 1 + enddo + enddo + + if (num .gt. 0) then + cvar(iclon,jclat) = sum/num + else + cvar(iclon,jclat) = 1.e30 + endif + end do + end do + return +end subroutine varf2c diff --git a/tools/definesurf/wrap_nf.f90 b/tools/definesurf/wrap_nf.f90 new file mode 100644 index 0000000000..c340b3817b --- /dev/null +++ b/tools/definesurf/wrap_nf.f90 @@ -0,0 +1,146 @@ +subroutine wrap_inq_varid (nfid, varname, varid) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) varname + + integer ret + + ret = nf_inq_varid (nfid, varname, varid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_varid + +subroutine wrap_inq_dimlen (nfid, dimid, dimlen) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, dimlen + + integer ret + + ret = nf_inq_dimlen (nfid, dimid, dimlen) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimlen + +subroutine wrap_inq_dimid (nfid, dimname, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimid (nfid, dimname, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimid + +subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts + character*(*) varname + + integer ret + + ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_var + +subroutine wrap_def_dim (nfid, dimname, len, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, len, dimid + character*(*) dimname + + integer ret + + ret = nf_def_dim (nfid, dimname, len, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_def_dim + +subroutine wrap_get_var8 (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + + ret = nf_get_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_var8 + +subroutine wrap_put_var8 (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + ret = nf_put_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_put_var8 + +subroutine wrap_get_vara8 (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + real*8 arr(*) + + integer ret + + ret = nf_get_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_vara8 + +subroutine wrap_put_vara8 (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + real*8 arr(*) + + integer ret + ret = nf_put_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_put_vara8 + +subroutine wrap_put_att_text (nfid, varid, attname, atttext) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + character*(*), intent(in):: attname + character*(*), intent(in):: atttext + + integer ret ! NetCDF return code + integer siz + + siz = len_trim(atttext) + ret = nf_put_att_text (nfid, varid, attname, siz, atttext) + if (ret/=NF_NOERR) call handle_error (ret) +end subroutine wrap_put_att_text + +subroutine wrap_put_att_double (nfid, varid, name, xtype, len, dvals) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, len + character*(*) name + real*8 dvals + + integer ret + + ret = nf_put_att_double (nfid, varid, name, xtype, len, dvals) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_put_att_double + diff --git a/tools/icesst/Makefile b/tools/icesst/Makefile new file mode 100644 index 0000000000..e834d42cb8 --- /dev/null +++ b/tools/icesst/Makefile @@ -0,0 +1,7 @@ +all: + (cd regrid; gmake) + (cd bcgen; gmake) + +clean: + (cd regrid; gmake clean) + (cd bcgen; gmake clean) diff --git a/tools/icesst/README b/tools/icesst/README new file mode 100644 index 0000000000..82fdb690f4 --- /dev/null +++ b/tools/icesst/README @@ -0,0 +1,177 @@ +This document describes how to build CAM-readable SST and sea ice +concentration boundary datasets at an arbitrary resolution. Two +Fortran-based executables are required to complete the process. The first +(regrid) area averages or linearly interpolates input data to a target grid. +The second (bcgen) computes a climatology and modifies monthly mean values to +produce mid-month values such that linear time interpolation (e.g. as done in +a model) will reproduce the monthly means. Algorithms devised by Karl Taylor +of PCMDI are used to accomplish these tasks. His descriptions of these +algorithms are included as Fortran comments in the file bcgen/bcgen.f90. The +final product is two boundary condition netcdf files suitable for input to +CAM. One contains climatological mid-month SST values and ice +concentrations, and the other a multi-year time series of mid-month values of +these quantities. + +Two netcdf files containing SST and sea ice concentration data, respectively, +are required input to start the process. The data are on a one-degree grid, +and were created by Jim Hurrell and Dennis Shea of NCAR's Climate Analysis +Section. These input data contain monthly averaged values for some number of +years. Values over land are interpolated, so no land mask is required. + +The codes have been tested on Linux, AIX, and IRIX systems. In addition to +an f90 compiler (pgf90 or lf95 on a PC) and gnumake, it is assumed that the +netcdf library is available. If netcdf does not live in the default +location of /usr/local, gnumake macros LIB_NETCDF (for libnetcdf.a) and +INC_NETCDF (for netcdf.inc) need to be set either in the Makefile directly +or as environment variables. + +An example session containing the commands needed to build a T5 dataset on a +Linux PC are given next, followed by a description of what each of the +commands does. On Linux systems, lf95 is the default compiler. pgf90 can +also be used. To do so, set USER_FC=pgf90, and change the definition of r16 +in regrid/precision.f90 to selected_real_kind(12). The latter change is +needed because pgf90 does not allow a real*16 data type. + +gmake +cd regrid +./regrid -i MODEL.had+oiv2.ice.mnly.49-01.unf.nc \ + -s MODEL.had+oiv2.sst.mnly.49-01.unf.nc \ + -g /fs/cgd/csm/inputdata/atm/cam/coords/gauss_8x16.nc \ + -o sstice.nc +cd ../bcgen +ln -s ../regrid/sstice.nc . +./bcgen -i sstice.nc -c sstice_clim.nc -t sstice_ts.nc < namelist + +An elaboration on the above steps follows. + +The first command (gmake) builds required executables in subdirectories +regrid/ and bcgen/. + +The command "./regrid -i ..." converts the 1-degree data to the output +grid. For resolutions coarser than the 1-degree input, by default the data +are converted using area averaging, and finer resolutions default to linear +interpolation. These defaults can be overridden via a command-line +argument (-l for linear, -a for area averaging). If running in verbose +mode (-v included on command line), points with both ice fraction greater +than 50% and SST greater than 6 deg. C are printed. This is only a +diagnostic and not necessarily an indication of a problem. After running +regrid, the file sstice.nc (specified by the -o option) will contain SST +and ice concentration data on the grid in the file specified by the -g +command-line option. The grid file is assumed to contain latitude and +longitude coordinate variables with the names "lat" and "lon" respectively. +If the output is a reduced grid then this file must also contain the +variables "nlon" which contains the number of longitudes at each latitude, +and "rlon" which is a 2D array of the reduced grid longitudes. It is also +assumed that the centers of the cells at the west edge of the grid are +located on the Greenwich meridian. In fact only the number of longitudes +will be read from the grid file, and the cell center and edge longitude +values will be computed. + +The last step (./bcgen -i ...) creates the climatological mid-month values +and multi-year time series boundary data. To run this code, first copy or +link sstice.nc into the directory ../bcgen. The file driver.f90 contains +descriptions of the namelist variables. An example namelist is provided. +The filepaths of input and output files are given on the command-line since +they are resolution specific, while the variables in the namelist are +relevent to the time samples contained in the raw 1x1 data and are spatial +resolution independent. + +In this example, output files sstice_clim.nc and sstice_ts.nc will +contain the CAM-readable boundary condition SSTs (variable SST_cpl) and ice +concentrations (variable ice_cov). Versions of these variables prior to +modification for retaining the monthly mean via linear interpolation are +included in these files. The variable names have "_prediddle" appended. + +The following explanation of the namelist variables is taken from the +bcgen.f90 file: + +! Namelist details: +! +! SPECIFY the first and last month and year for period in which +! observed monthly mean data will be read. (The first month +! read must not preceed mon1, iyr1, and the last month must +! not follow monn, iyrn). For example: + +! mon1rd = 1 !AMIP +! iyr1rd = 1956 !AMIP + +! monnrd = 8 !AMIP +! iyrnrd = 2002 !AMIP + +! SPECIFY first and last month and year for entire period that will +! be treated (i.e., the period of interest plus buffers at ends). +! Note that the entire period treated should be an integral +! number of years. For example: + +! mon1 = 1 !AMIP +! iyr1 = 1955 !AMIP + +! monn = 12 !AMIP +! iyrn = 2003 !AMIP + +! SPECIFY the first and last month and year that will be included in +! climatological mean. (This must be an interval within the +! observed period). For example: + +! mon1clm = 1 !AMIP +! iyr1clm = 1982 !AMIP + +! monnclm = 12 !AMIP +! iyrnclm = 2001 !AMIP + +! SPECIFY the first and last month and year written to the output +! file. (Try to begin at east a few months after the mon1rd, +! iyr1rd, and end a few months before monnrd, iyrnrd, to avoid +! sensitivity to the artificial data outside the observed +! period.) For example: + +! mon1out = 1 !AMIP +! iyr1out = 1956 !AMIP +! +! monnout = 6 !AMIP +! iyrnout = 2002 !AMIP +! + +One important note on the climatological averaging period. In general the +namelist variables defining it should NOT change from 1982-2001. The code +checks for this and errors out if the values are set inappropriately. It +also prints a message explaining how to change the climatological averaging +period if the user really wishes to do so. + + +History: + +2003-04-16 Jim Rosinski +Original version + +2005-05-25 Brian Eaton +1. The regrid program was modified to read the grid from a file that is + separate from the file that the output data is written to. Previously + the regrid procedure required an extra step to create a template file + that contained the grid which was then modified by adding the regridded + sst/ice data. + +2. A timestamp was added to the history attribute written to output files + produced by the regrid program. + +3. The bcgen program was modified so that the input and output filename are + specified on the command-line rather than in a namelist file. + +4. A history attribute was added to files produced by the bcgen program. + This contains the history from the regrid program since the output file + from that program is the input to this one. The final output files now + contain a complete history of the files used to produce them, along with + timestamps for when the programs were run. + +2006-04-18 B. Eaton + +1. regrid/regrid.f90 was modified to check the units attribute of the time + variable to determine if the 1x1 data uses a new or old style time + coordinate (added wrap_nf_get_att_text method to wrap_nf.f90). If old + style (units = 'YYYYMMDD') then the date info is contained in the time + variable, and if new style (units = 'days since ...') then the date info + is contained in the date variable. + +2. bcgen/solver.f90 was modified by replacing nmont by nmax, and setting + nmax to 12*250. This was done to accomodate the new boundary datasets + which begin in 1870 rather than 1949. diff --git a/tools/icesst/bcgen/Makefile b/tools/icesst/bcgen/Makefile new file mode 100644 index 0000000000..9f9defcd62 --- /dev/null +++ b/tools/icesst/bcgen/Makefile @@ -0,0 +1,97 @@ +# Set up special characters +null := + +# Check for netcdf locations +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# FFLAGS and LDFLAGS will have at least these values in all situations +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + +# Determine platform +UNAMES := $(shell uname -s) + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),pgf90) + FC = pgf90 + ifeq ($(DEBUG),TRUE) + FFLAGS += -g -Mbounds + else + FFLAGS += -fast + endif + else + FC = lf95 + ifeq ($(DEBUG),TRUE) + FFLAGS += -g --chk esu + else + FFLAGS += -O + endif + endif +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) + FC = f90 + FFLAGS += -64 + LDFLAGS += -64 + ifeq ($(DEBUG),TRUE) + FFLAGS += -C -g + LDFLAGS += -g + else + FFLAGS += -O2 + endif +endif + +#------------------------------------------------------------------------ +# IBM +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) + FC = xlf90 + FFLAGS += -qsuffix=f=f90 + ifeq ($(DEBUG),TRUE) + FFLAGS += -C -g + LDFLAGS += -g + else + FFLAGS += -O2 + endif +endif + +OBJS = calcclim.o calcfull.o driver.o bcgen.o output_dateinfo.o prec.o \ + setup_outfile.o solver.o wrap_nf.o types.o + +bcgen: $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) bcgen *.o *.mod *.stb *.MOD + +.SUFFIXES: +.SUFFIXES: .f90 .o + +.f90.o: + $(FC) $(FFLAGS) $*.f90 + +calcclim.o: prec.o solver.o +calcfull.o: prec.o solver.o +driver.o: prec.o +bcgen.o: prec.o types.o +output_dateinfo.o: prec.o +prec.o: +setup_outfile.o: prec.o types.o +solver.o: prec.o +wrap_nf.o: prec.o +types.o: prec.o diff --git a/tools/icesst/bcgen/bcgen.f90 b/tools/icesst/bcgen/bcgen.f90 new file mode 100644 index 0000000000..39093c62b8 --- /dev/null +++ b/tools/icesst/bcgen/bcgen.f90 @@ -0,0 +1,763 @@ +subroutine bcgen (mon1, iyr1, monn, iyrn, mon1rd, & + iyr1rd, monnrd, iyrnrd, mon1clm, iyr1clm, & + monnclm, iyrnclm, nlat, nlon, mon1out, & + iyr1out, monnout, iyrnout, ncidin, outfilclim, & + outfilamip, nmon, oldttcalc, history) + use prec + use types + +!------------------------------------------------------------------------ +! 21 August 1997 +! Karl E. Taylor +! PCMDI +! taylor13@llnl.gov +! +! 14 February 2003 +! Jim Rosinski +! NCAR +! Modified to be CAM-specific, and use namelist input +! +! Documentation provided by Karl Taylor +! +! Purpose: + +! to create on some specified "target" grid an artificial mid-month +! sea ice fraction and SST data set (referred to here as the +! "boundary condition data" set) that, when linearly interpolated +! (in time), produces the observed monthly means (referred to here +! as the "observed data"). + +! REFERENCE: +! +! Taylor, K.E., D. Williamson, and F. Zwiers (2000): The sea surface +! temperature and sea-ice concentration boundary conditions for +! AMIP II simulations. PCMDI Report No. 60 and UCRL-MI-125597, +! Lawrence Livermore National Laboratory, Livermore, CA, 25 pp. +! +! pdf file available at +! http://www-pcmdi.llnl.gov/pcmdi/pubs/ab60.html + +! Input files: + +! monthly mean (observed) SSTs and sea ice fraction on the target grid + +! fortran namelist defining input and output filenames, and time periods +! of input and output data. + +! Output files: + +! (1) The boundary condition data set for the years requested. +! (The filenames contain the string "bc" and don't +! include the string "clim" (e.g. amipbc_sst_1978.nc).) +! (2) A climatological boundary condition data set based on the +! years specified for computing this climatology. +! (The filenames contain the strings "bc" and "clim" +! (e.g., amipbc_sic_360x180_1979_2001_clim.nc).) + +! Libraries used: +! netcdf library: interface to netCDF files + +! Overview of algorithm: + +! The following assumes familiarity with the information contained +! in the reference listed above. + +! Away from regions of near-freezing temperature, the SSTs are +! generated by solving a set of N linear equations where N +! is the number of months considered. The mid-month (boundary +! condition) temperatures for a given month depend on the observed +! monthly-mean temperature of that month, and also the temperatures +! of the preceeding month and following month. Thus, +! the mid-month temperature for the first and last months +! formally require observed temperatures before and after +! the time period considered. In practice the dependence +! on the temperatures outside the period considered is fairly weak. +! To close the problem mathematically, however, we must impose some +! sort of condition on the temperatures before and following the +! period of interest. + +! If observations are available for several months before and +! after the period of interest, then these can be used along with +! imposition of a periodic boundary condition to fully constrain the +! problem. (By "periodic boundary condition," we mean that the +! first month of the available observations is assumed to follow +! the last month). The periodic boundary condition should only be +! imposed on an observational period that comprises an integral +! number of years, so, for example, if the first month is March, the +! last month must be February. + +! The periodic condition is a convenient way of closing the +! problem mathematically, but is of course unrealistic. In +! practice, however, it really affects only the mid-month +! temperatures of a few months: the temperatures for the 2 or 3 +! months at the beginning and end of the observational period +! considered. If the observational record extends well outside +! (both before and after) the period for which boundary condition +! data are needed, then this is not a problem. If, however, we need +! boundary condition data for every month for which observations are +! available, then the months at the beginning and end will be +! sensitive to this assumption. + +! If you really want to simulate the full time period for which +! observed monthly means are available, the "end" effects +! can be reduced by generating artifical "observed" temperatures +! for a brief period preceeding and following the actual +! observational period. In this code we do this as follows: The +! artificial "observed" temperature anomalies are assumed to decay +! to zero in the first few months prior to and following the +! observational period, so that the temperature approaches +! climatology. The rate of decay is based on the the +! autocorrelation function for the monthly mean SST time-series +! (analyzed for the years 1979-1998). The spatial mean +! (area-weighted over all ocean grid cells) of the autocorrelation +! function, at lags of 1, 2, 3, ..., and 8 months have been +! computed and are specified within this code. The correlations +! for lags greater than 8 months are small, and are assigned so +! that the correlation reaches zero (in a smooth way) at month 12. +! [Note: for sea ice fraction the correlations are based on +! observations for lags less than 6 months, and the correlation is +! assumed to be zero for lags greater than 7 months.] + +! In summary, to minimize dependence on the boundary end +! conditions (i.e., the values of "observations" specfied for the +! period before and after the interval where observations are +! actually available), it is best to use only the mid-month values +! that are generated for a subinterval away from the boundary. In +! practice this means the mid-month values for the 2 or 3 months at +! the beginning and the end of the observational period should be +! excluded from use in forcing a GCM simulation. + +! Consider the following example. Suppose observations +! are available for the months January, 1956 through August, 2002. +! Suppose, further, we would like to prescribe the SST boundary +! condition in an atmospheric GCM simulation of these same months +! (1/1956 - 8/2002). The recommended approach would be to generate +! artificial observational data for the year preceeding 1/56 and the +! year following 8/02. We also require that we treat an integral +! number of years. We could conservatively choose to extend the +! "observations" to 12/03 at the end, and to also tack on a year +! at the beginning (i.e., 12 months starting at 1/55). +! Since the artifical "observational" data approaches climatology +! outside the time period of interest, the user must also +! specify which years will contribute to the climatology. If there +! is no significant temperature trend over the period considered, +! the climatology could be justifiably based on any interval of +! several (say, 10 or more) years. + +! If, however, the data exhibit a noticable trend, then the +! user should probably avoid trying to simulate the entire +! period because the current code is unable to handle this case +! accurately; it assumes that the artificial data outside both ends +! of the observational period "decay" toward (i.e., approach) the +! same climatology. It would be better to assume that at the +! beginning of the period and at the end of the period, the values +! approached the different characteristic climatologies. + +! In any case, it is wise to avoid the last few months for which +! observations are currently available. This is because as +! observations become available for succeeding months, these +! will replace the artificially generated "observations" and will +! have some effect on boundary condition data for the few months +! near the end of the observational period. + +! The user can specify the beginning and ending months of the +! following: +! +! 1) the interval for which observational monthly mean data +! are available. +! 2) the entire interval over which the analysis will be +! performed, including buffer periods prior to and +! following the observed data, which are recommended to +! total a year or two. +! 3) the interval over which the climatology is computed. +! 4) the interval defining which months will be included +! as output (in the form of SST mid-month boundary +! conditions). + +! Away from regions of near-freezing temperature, the mid-month +! SSTs [represented here by S] satisfy: + +! A S = B + +! where S is a column vector of dimension N representing the +! mid-month values that constitute the SST boundary condition, +! B is a column vector of dimension N, representing the +! observed monthly mean time-series, and A (except for 2 +! elements) is a tri-diagnal matrix of dimension NxN. The +! two unconforming elements account for the assumption of +! periodicity. (The following shows the matrix structure.) +! + +! |b(1) c(1) ... a(1) | +! |a(2) b(2) c(2) | +! | . a(3) b(3) c(3) ... | +! A = | . | +! | . | +! | . | +! | ... a(N-1) b(N-1) c(N-1)| +! |c(N) ... . a(N) b(N) | + +! where +! a(i) = aa(i)/8 +! b(i) = 1 - aa(i)/8 - cc(i)/8 +! c(i) = cc(i)/8 + +! aa(i) = 2*n(i)/(n(i)*n(i-1)) +! cc(i) = 2*n(i)/(n(i)*n(i+1)) + +! where n(i) = number of days in month i. + +! Note that if all the months were of equal length, then aa=cc=1 +! and a=1/8, b=3/4, and c=1/8. + +! For sea ice, the above procedure has to be modified because +! the sea ice fraction is constrained to be between 0 and 1. +! Similarly, the water temperature cannot fall below its freezing +! point, so this also places a physical constraint that is not +! always consistent with the above procedure. In these cases +! the equations that must be solved have a similar structure as +! shown above, but the coefficients (a's, b's, and c's) depend on +! temperature or the sea ice fraction. Thus, the equations in this +! case are no longer linear, but they can be solved using an +! iterative Newton-Raphson approach. + +! The Jacobian that is required under this approach is +! not generated analytically, but is approximated numerically. + +! There is another constraint necessary to ensure a unique +! solution in the nonlinear case. To see why the constraint +! is needed, consider a grid cell where the ocean is ice-free +! year around, except for 1 month, when the ice fraction is +! 10%. The mid-month value for this month is not uniquely +! determined because the cell could be covered by little +! ice over the entire month, or by lots of ice for only a short +! time in the middle of the month. The algorithm relied on +! in this code tries to minimize the absolute difference between +! mid-month values that exceed the maximum physically allowed +! value (S_max=100% for sea ice) and S_max, while still yielding +! the correct monthly means: i.e., + +! where S > S_max, minimize (S - S_max) + +! Similarly, for values that are less than the minimum physically +! allowed value (S_min = 0% for sea ice): + +! where S < S_min, minimize (S_min - S) + +! In the example above this results in the following mid-month +! values for sea ice (assuming for simplicity that all months +! are of the same length): S(i-1) = S(i+1) = -20% and +! S(i) = 20% where i is the month with mean sea ice fraction of +! 10%. These mid-month values when linearly interpolated give a +! sea ice fraction for month i that starts at 0%, linearly grows to +! 20% at the middle of the month, and then linearly decreases to 0% +! at the end of the month. For the month preceeding and the month +! following month i, the linear interpolation leads to negative +! values, but recall that the model's alogrithm will "clip" these +! values, setting them to 0%. + +! Namelist details: +! +! SPECIFY the first and last month and year for period in which +! observed monthly mean data will be read. (The first month +! read must not preceed mon1, iyr1, and the last month must +! not follow monn, iyrn). For example: + +! mon1rd = 1 !AMIP +! iyr1rd = 1956 !AMIP + +! monnrd = 8 !AMIP +! iyrnrd = 2002 !AMIP + +! SPECIFY first and last month and year for entire period that will +! be treated (i.e., the period of interest plus buffers at ends). +! Note that the entire period treated should be an integral +! number of years. For example: + +! mon1 = 1 !AMIP +! iyr1 = 1955 !AMIP + +! monn = 12 !AMIP +! iyrn = 2003 !AMIP + +! SPECIFY the first and last month and year that will be included in +! climatological mean. (This must be an interval within the +! observed period). For example: + +! mon1clm = 1 !AMIP +! iyr1clm = 1979 !AMIP + +! monnclm = 12 !AMIP +! iyrnclm = 2000 !AMIP + +! SPECIFY the first and last month and year written to the output +! file. (Try to begin at east a few months after the mon1rd, +! iyr1rd, and end a few months before monnrd, iyrnrd, to avoid +! sensitivity to the artificial data outside the observed +! period.) For example: + +! mon1out = 1 !AMIP +! iyr1out = 1956 !AMIP +! +! monnout = 6 !AMIP +! iyrnout = 2002 !AMIP +! +! SPECIFY input dataset (as output by the program regrid) on the +! target grid. For example: +! +! infil = 'regrid.T42.nc' +! +! SPECIFY output climatological boundary condition dataset name. +! For example: +! +! outfilclim = 'outfilclim.T42.nc' +! +! SPECIFY output AMIP-style boundary condition dataset name +! +! outfilclim = 'outfilclim.T42.nc' +!------------------------------------------------------------------------ + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer, intent(in) :: mon1 ! start month of period of interest plus buffer + integer, intent(in) :: iyr1 ! start year of period of interest plus buffer + integer, intent(in) :: monn ! end month of period of interest plus buffer + integer, intent(in) :: iyrn ! end year of period of interest plus buffer + integer, intent(in) :: mon1rd ! start month to read from input data + integer, intent(in) :: iyr1rd ! start year to read from input data + integer, intent(in) :: monnrd ! end month to read from input data + integer, intent(in) :: iyrnrd ! end year to read from input data + integer, intent(in) :: mon1clm ! start month to use for climatology + integer, intent(in) :: iyr1clm ! start year to use for climatology + integer, intent(in) :: monnclm ! end month to use for climatology + integer, intent(in) :: iyrnclm ! end year to use for climatology + integer, intent(in) :: nlat ! number of latitudes (e.g. 64 for typical T42) + integer, intent(in) :: nlon ! number of longitudes (e.g. 128 for typical T42) + integer, intent(in) :: mon1out ! start month written to output file (default mon1rd) + integer, intent(in) :: iyr1out ! start year written to output file (default iyr1rd) + integer, intent(in) :: monnout ! end month written to output file (default monnrd) + integer, intent(in) :: iyrnout ! end year written to output file (default iyrnrd) + integer, intent(in) :: ncidin ! input file netcdf id + integer, intent(in) :: nmon ! total number of months of period of interest plus buffer + + logical, intent(in) :: oldttcalc ! for bfb agreement with original code + + character*120, intent(in) :: outfilclim ! output filename for climatology + character*120, intent(in) :: outfilamip ! output filename for year-by-year output + character(len=*), intent(in) :: history ! history attribute +! +! Local workspace +! + integer :: i, j ! lon, lat indices + integer :: k ! index value 1=ice, 2=sst + integer :: m, mp, n, mm, l ! month indices + integer :: m1, m2 ! month indices + integer :: ismc ! number of monthly means smoothed (climatology) + integer :: jsmc ! number of grid cells affected by smoothing (climatology) + integer :: ismf ! number of year-by-year monthly means smoothed (year-by-year) + integer :: jsmf ! number of grid cells affected by smoothing (year-by-year) + integer :: isea ! number of ocean grid cells + integer :: nmonout ! number of output months + integer :: prvyr, prvmo ! previous year, month index from input file + integer :: yr, mo ! year, month index from input file + + logical :: dateok ! flag indicates acceptable input date format +! +! netcdf info +! + integer :: ncidclim = -1 ! output filehandle (climatology) + integer :: ncidamip = -1 ! output filehandle (year-by-year) + integer :: varid = -1 ! variable id + integer :: lonid = -1 ! longitude id (input) + integer :: latid = -1 ! latitude id (input) + integer :: dateidclim = -1 ! date id (climatology) + integer :: dateidamip = -1 ! date id (year-by-year) + integer :: datesecidclim = -1 ! seconds of date id (climatology) + integer :: datesecidamip = -1 ! seconds of date id (year-by-year) + integer :: timeidclim = -1 ! time id (clim) + integer :: timeidamip = -1 ! time id (year-by-year) + integer :: dateidin = -1 ! date info on input file + integer :: date(1) = -1 ! input date (yyyymmdd) + integer :: start(3) = (/-1,-1,-1/) ! for reading/writing non-contiguous data in netcdf file + integer :: start1d(1) = -1 ! date start index on input file + integer :: start1dtst(1) = -1 ! test date index on input file + integer :: kount(3) = (/-1,-1,-1/) ! for reading/writing non-contiguous data in netcdf file + + integer, parameter :: maxiter = 100 ! max iterations in solving time-diddling + + real(r8), parameter :: fac = 1.0 ! factor to multiply input data by (before any cropping). + real(r8), parameter :: bbmin = 0.001 ! smallest diagonal element allowed in Jacobian + ! i.e. will change 0.0005 to 0.001 + real(r8) :: obsclim(nlon,nlat,12) ! climatological values + real(r8) :: obsamip(nlon,nmon) ! year-by-year values + real(r8) :: arr(nlon,nmon) ! sst or ice conc. (1 latitude) + real(r8) :: centmon(nlon,nlat,12) ! sst or ice conc. climatology (all latitudes) + real(r8) :: a(nmon) ! lower diagonal matrix coeffs (year-by-year) + real(r8) :: c(nmon) ! upper diagonal matrix coeffs (year-by-year) + real(r8) :: ac(12) ! lower diagonal matrix coeffs (climatology) + real(r8) :: cc(12) ! upper diagonal matrix coeffs (climatology) + real(r8) :: xlon(nlon) ! longitudes on input file (between 0 and 360) + real(r8) :: xlat(nlat) ! latitudes on input file (between -90 and 90) + + integer :: monlen(12,2) ! length of months + + data monlen/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, & + 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ + + character(len=80) :: center = 'NCAR' ! research center creating data + + type(icesstparms) :: icesst(2) ! struct containing variable-specific info +! +! Set ice parms. dt value: Not much smoothing => 0->100 becomes 2->98 between months +! + icesst(1) = icesstparms ('ICEFRAC', -1, & ! inname, invarid + + 'ice_cov', & ! climname + 'ice_cov_prediddle', & ! climname_pre + 'BCS Pseudo Sea-ice concentration', & ! climlongname + 'Sea-ice concentration before time diddling', & ! climlongname_pre + + 'ice_cov', & ! amipname + 'ice_cov_prediddle', & ! amipname_pre + 'BCS Pseudo Sea-ice concentration', & ! amiplongname + 'Sea-ice concentration before time diddling', & ! amiplongname_pre + + 'fraction', & ! units + + -1, -1, -1, -1, & ! varids + + 1.e-4, 0., 1., 1.e-4, 0.02, & ! conv, tmin, tmax, varmin, dt + (/0.53, 0.23, 0.13, 0.08, 0.05, 0.02, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/)) ! correl +! +! With Karl's bugfix to tt calc, convergence criterion for ice can be tightened. +! Leave as is for now since halving this number can lead to big excursions in ice +! concentration. +! + if (oldttcalc) then + icesst(1)%dt = (icesst(1)%tmax - icesst(1)%tmin) / 50. + else + icesst(1)%dt = (icesst(1)%tmax - icesst(1)%tmin) / 100. + icesst(1)%dt = (icesst(1)%tmax - icesst(1)%tmin) / 50. + end if +! +! Set sst parms. Cropping SST at 1000. effectively means do not crop +! + icesst(2) = icesstparms ('SST', -1, & ! inname, invarid + + 'SST_cpl', & ! climname + 'SST_cpl_prediddle', & ! climname_pre + 'BCS Pseudo SST', & ! climlongname + 'SST before time diddling', & ! climlongname_pre + + 'SST_cpl', & ! amipname + 'SST_cpl_prediddle', & ! amipname_pre + 'BCS Pseudo SST', & ! amiplongname + 'SST before time diddling', & ! amiplongname_pre + + 'deg_C', & ! units + + -1, -1, -1, -1, & ! varids + + 1.e-3, -1.8, 1000., 0., 0.001, & ! conv,tmin, tmax, varmin, dt + (/0.68, 0.46, 0.33, 0.26, 0.20, 0.17, 0.14, 0.11, 0.08, 0.05, 0.02, 0.00/)) ! correl + +! ***************************************************************** + + monlen(2,2) = 28 ! JR for no leap year + +! +! Copy dimension vars from input to output +! + call wrap_nf_inq_varid (ncidin, 'lon', lonid) + call wrap_nf_inq_varid (ncidin, 'lat', latid) + call wrap_nf_get_var_double (ncidin, lonid, xlon) + call wrap_nf_get_var_double (ncidin, latid, xlat) +! +! Open output files and define metadata +! + call setup_outfile (ncidclim, outfilclim, 'CLIM', dateidclim, datesecidclim, & + timeidclim, icesst, nlon, nlat, xlon, & + xlat, 0, 1, history) + call setup_outfile (ncidamip, outfilamip, 'AMIP', dateidamip, datesecidamip, & + timeidamip, icesst, nlon, nlat, xlon, & + xlat, iyr1out, mon1out, history) +! +! Determine starting index of data to be read. Assume this and subsequent data are monthly +! values, centered in the middle of the month. +! + start1d(1) = 1 + call wrap_nf_inq_varid (ncidin, 'date', dateidin) + do while (.true.) + call wrap_nf_get_vara_int (ncidin, dateidin, start1d, 1, date) + if (date(1)/10000 == iyr1rd .and. mod(date(1)/100,100) == mon1rd) then + write(6,*)'Input data at iyr1rd, mon1rd=', iyr1rd, mon1rd, ' are record # ', start1d(1) + exit + end if + start1d(1) = start1d(1) + 1 + end do +! +! Ensure that enough data are present, and that they increment properly in time +! + start1dtst(1) = start1d(1) + call wrap_nf_get_vara_int (ncidin, dateidin, start1dtst, 1, date) + prvyr = date(1)/10000 + prvmo = mod(date(1)/100,100) + + do while (.true.) + start1dtst(1) = start1dtst(1) + 1 + call wrap_nf_get_vara_int (ncidin, dateidin, start1dtst, 1, date) + yr = date(1)/10000 + mo = mod(date(1)/100,100) +! +! Exit loop when date read in extend beyond requested data +! + if (yr > iyrnrd) exit + if (yr == iyrnrd .and. mo >= monnrd) then + write(6,*)'Input yr,mo=', yr, mo,' will be the last date read from input file' + exit + end if + dateok = (yr == prvyr .and. (mo == prvmo+1 .and. mo >= 1 .and. mo <= 12)) .or. & + yr == prvyr+1 .and. mo == 1 + if (.not. dateok) then + write(6,*)'Bad date info read: yr,mo=',yr,mo + stop 999 + end if + write(6,*)'Input yr,mo=', yr, mo, ' OK' + prvyr = yr + prvmo = mo + end do +! +! Set kount array for netcdf calls +! + kount(1) = nlon + kount(2) = 1 + kount(3) = 1 +! +! Loop 1 to 2 to do ice first then sst +! + do 22 k=1,2 + write(6,*) 'Output from monthly boundary condition generator ' + write(6,*) 'clim var name = ', icesst(k)%climname + write(6,*) 'climlong name = ', icesst(k)%climlongname + write(6,*) 'amip var name = ', icesst(k)%amipname + write(6,*) 'amiplong name = ', icesst(k)%amiplongname + write(6,*) 'units = ', icesst(k)%units + write(6,*) 'center = ', center + write(6,*) 'nlon = ', nlon + write(6,*) 'nlat = ', nlat + write(6,*) 'nmon = ', nmon + write(6,*) 'mon1rd = ', mon1rd + write(6,*) 'iyr1rd = ', iyr1rd + write(6,*) 'monnrd = ', monnrd + write(6,*) 'iyrnrd = ', iyrnrd + write(6,*) 'mon1clm = ', mon1clm + write(6,*) 'iyr1clm = ', iyr1clm + write(6,*) 'monnclm = ', monnclm + write(6,*) 'iyrnclm = ', iyrnclm + write(6,*) 'mon1 = ', mon1 + write(6,*) 'iyr1 = ', iyr1 + write(6,*) 'monn = ', monn + write(6,*) 'iyrn = ', iyrn + write(6,*) 'mon1out = ', mon1out + write(6,*) 'iyr1out = ', iyr1out + write(6,*) 'monnout = ', monnout + write(6,*) 'iyrnout = ', iyrnout + write(6,'(a,1pe14.7)') 'conv = ', icesst(k)%conv + write(6,*) 'maxiter = ', maxiter + write(6,'(a,1pe14.7)') 'bbmin = ', bbmin + write(6,'(a,1pe14.7)') 'varmin = ', icesst(k)%varmin + write(6,'(a,1p,12(e10.3))') 'correl = ', icesst(k)%correl + write(6,*) 'monlen = ', monlen + write(6,'(a,1pe14.7)') 'tmin = ', icesst(k)%tmin + write(6,'(a,1pe14.7)') 'tmax = ', icesst(k)%tmax + write(6,'(a,1pe14.7)') 'dt = ', icesst(k)%dt + write(6,'(a,1pe14.7)') 'fac = ', fac + write(6,*) 'oldttcalc=', oldttcalc + +! Calculate jacobian elements for climatological years + + m = 12 + mp = 1 + do n=1,12 + mm = m + m = mp + mp = mp + 1 + if (mp == (12+1)) mp = 1 + ac(n) = 2.0_r8*monlen(m,1)/(monlen(m,1) + monlen(mm,1)) + cc(n) = 2.0_r8*monlen(m,1)/(monlen(m,1) + monlen(mp,1)) + end do + +! Calculate jacobian elements for all years + + i = iyr1 + j = 1 + if (((mod(i,4) == 0) .and. (mod(i,100) /= 0)) .or. (mod(i,400) == 0)) j = 2 + + m = mod((mon1+12-2), 12) + 1 + mp = mod((mon1-1), 12) + 1 + + do n=1,nmon + mm = m + m = mp + mp = mp + 1 + if (mp == (12+1)) then + mp = 1 + i = i + 1 + j = 1 + if (((mod(i,4) == 0) .and. (mod(i,100) /= 0)) .or. (mod(i,400) == 0)) j = 2 + end if + a(n) = 2.0_r8*monlen(m,j)/(monlen(m,j) + monlen(mm,j)) + c(n) = 2.0_r8*monlen(m,j)/(monlen(m,j) + monlen(mp,j)) + end do +! +! Get input variable id +! + call wrap_nf_inq_varid (ncidin, icesst(k)%inname, icesst(k)%invarid) +! +! Monthly mean computation section: save memory by computing and writing one +! latitude slice at a time +! + ismc = 0 + jsmc = 0 + ismf = 0 + jsmf = 0 + isea = 0 + + do j=1,nlat + m1 = (iyr1rd-iyr1)*12 + mon1rd - mon1 + 1 + m2 = (iyrnrd-iyr1)*12 + monnrd - mon1 + 1 +! +! Read in all time values of the j'th latitude slice +! + start(1) = 1 + start(2) = j + start(3) = start1d(1) +! +! Note data read in to array index starting at m1 not 1 to allow for padding at start of +! period. +! + do l=m1,m2 + call wrap_nf_get_vara_double (ncidin, icesst(k)%invarid, start, kount, arr(1,l)) + start(3) = start(3) + 1 + end do +! +! Save off obs for writing to output file +! + obsamip(:nlon,1:m1-1) = 0. + obsamip(:nlon,m1:m2) = arr(:nlon,m1:m2) + obsamip(:nlon,m2+1:) = 0. + + write(6,*) 'latitude ', j, ' read successfully.' + +! Compute climatological means + + call calcclim (j, nlon, nlat, nmon, ismc, & + jsmc, mon1clm, iyr1clm, iyr1, mon1, & + iyr1rd, mon1rd, iyrnrd, monnrd, monnclm, & + iyrnclm, maxiter, icesst(k)%tmin, & + icesst(k)%tmax, icesst(k)%dt, & + icesst(k)%conv, bbmin, isea, obsclim, arr, & + centmon, ac, cc) + +! Solve for full mid-month values + + call calcfull (j, nlon, nlat, nmon, ismf, & + jsmf, iyr1rd, mon1rd, iyr1, mon1, & + iyrn, monn, iyrnrd, monnrd, maxiter, & + icesst(k)%tmin, icesst(k)%tmax, icesst(k)%dt, & + icesst(k)%conv, bbmin, & + obsclim, arr, centmon, a, c, & + icesst(k)%correl, oldttcalc) +! +! Add climatology back on to output data +! + call finish (nlon, nlat, mon1, nmon, centmon, & + arr, j) +! +! Write 1 latitude of pre- and post-time-diddled variable to output file. +! + start(1) = 1 + start(2) = j + nmonout = (iyrnout - iyr1out)*12 + (monnout - mon1out + 1) +! +! l is the output time index for the netcdf file +! m indexes into output arrays with a buffer offset +! + m = (iyr1out - iyr1)*12 + (mon1out - mon1) + do l=1,nmonout + m = m + 1 + start(3) = l + varid = icesst(k)%varidamip + call wrap_nf_put_vara_double (ncidamip, varid, start, kount, arr(1,m)) + varid = icesst(k)%varidamip_pre + call wrap_nf_put_vara_double (ncidamip, varid, start, kount, obsamip(1,m)) + end do + + do l=1,12 + start(3) = l + varid = icesst(k)%varidclim + call wrap_nf_put_vara_double (ncidclim, varid, start, kount, centmon(1,j,l)) + varid = icesst(k)%varidclim_pre + call wrap_nf_put_vara_double (ncidclim, varid, start, kount, obsclim(1,j,l)) + end do + end do ! j=1,nlat + + write(6,*) ' ' + write(6,*) ismc, ' climatological monthly means were smoothed' + write(6,*) jsmc, ' grid cells were affected' + write(6,*) ' ' + write(6,*) ismf, ' monthly means were smoothed' + write(6,*) jsmf, ' grid cells were affected' + write(6,*) ' ' + +22 continue ! 1=ice 2=sst +! +! Write model-readable date and datesec info to output files +! + call output_dateinfo (ncidclim, dateidclim, datesecidclim, timeidclim, 0, & + 1, 0, 12, monlen(1,1)) + call output_dateinfo (ncidamip, dateidamip, datesecidamip, timeidamip, iyr1out, & + mon1out, iyrnout, monnout, monlen(1,1)) + + call wrap_nf_close (ncidclim) + call wrap_nf_close (ncidamip) + call wrap_nf_close (ncidin) + + return +end subroutine bcgen + +subroutine finish (nlon, nlat, mon1, nmon, centmon, & + arr, j) +! +! Add climatology back on to year-by-year data +! + use prec + implicit none + + integer, intent(in) :: nlon, nlat ! number of lons, lats + integer, intent(in) :: mon1 ! starting month index of arr + integer, intent(in) :: nmon ! total number of months + integer, intent(in) :: j ! latitude index + + real(r8), intent(in) :: centmon(nlon,nlat,12) ! climatology + real(r8), intent(inout) :: arr(nlon,nmon) ! year-by-year data + + integer :: i ! longitude index + integer :: m ! month index cycling 1-12 + integer :: n ! month index for entire period + +! Calculate full mid-month time-series + + do n=1,nmon + m = mod((n+mon1-2), 12) + 1 + do i=1,nlon + arr(i,n) = arr(i,n) + centmon(i,j,m) + end do + end do + + return +end subroutine finish diff --git a/tools/icesst/bcgen/calcclim.f90 b/tools/icesst/bcgen/calcclim.f90 new file mode 100644 index 0000000000..ddcb2fd5eb --- /dev/null +++ b/tools/icesst/bcgen/calcclim.f90 @@ -0,0 +1,185 @@ +subroutine calcclim (j, nlon, nlat, nmon, ismc, & + jsmc, mon1clm, iyr1clm, iyr1, mon1, & + iyr1rd, mon1rd, iyrnrd, monnrd, monnclm, & + iyrnclm, maxiter, tmin, tmax, dt, & + conv, bbmin, isea, obsclim, arr, & + centmon, ac, cc) + + use prec + use solver, only: solvmid + + implicit none + + integer, intent(in) :: j + integer, intent(in) :: nlon + integer, intent(in) :: nlat + integer, intent(in) :: nmon + integer, intent(in) :: mon1clm + integer, intent(in) :: iyr1clm + integer, intent(in) :: monnclm + integer, intent(in) :: iyrnclm + integer, intent(in) :: maxiter + integer, intent(inout) :: isea + integer, intent(in) :: iyr1 + integer, intent(in) :: mon1 + integer, intent(in) :: iyr1rd + integer, intent(in) :: mon1rd + integer, intent(in) :: iyrnrd + integer, intent(in) :: monnrd + + real(r8), intent(in) :: tmin + real(r8), intent(in) :: tmax + real(r8), intent(in) :: dt + real(r8), intent(in) :: conv + real(r8), intent(in) :: bbmin + + real(r8), intent(inout) :: obsclim(nlon,nlat,12) + real(r8), intent(inout) :: arr(nlon,nmon) + real(r8), intent(out) :: centmon(nlon,nlat,12) + real(r8), intent(in) :: ac(12) + real(r8), intent(in) :: cc(12) + + integer :: ismc, jsmc + integer :: i, k + integer :: n, m, nn, mn, mm + integer :: momax, momin, mmax, mmin, mmnn + integer :: m1, m2, m3, m4 + + real(r8) :: vecin(12) + real(r8) :: vecout(12) + real(r8) :: ocentmax + real(r8) :: ocentmin + real(r8) :: centmax + real(r8) :: centmin + real(r8) :: rmin, rmax + real(r8) :: rrmin, rrmax + + mmnn = 0 + rrmin = 0.0 + rrmax = 0.0 + + m1 = 12*(iyr1rd-iyr1) + mon1rd-mon1 + 1 + m2 = 12*(iyrnrd-iyr1) + monnrd-mon1 + 1 + + m3 = 12*(iyr1clm-iyr1) + mon1clm-mon1 + 1 + m4 = 12*(iyrnclm-iyr1) + monnclm-mon1 + 1 + + write(6,*) 'computing climatology for latitude ', j + + do i=1,nlon + do n=1,12 + obsclim(i,j,n) = 0.0 + end do + mn = 0 + rmin = 0.0 + rmax = 0.0 + do n=m1,m2 + if (arr(i,n) > tmax) then + if (arr(i,n) > tmax+1.0e-2) then + write(6,*) 'tmax exceeded ', i, j, n, arr(i,n) + rmax = max (rmax,arr(i,n)-tmax) + mn = mn + 1 + end if + arr(i,n) = tmax + else if (arr(i,n) < tmin) then + if (arr(i,n) < tmin-dt) then + if ((tmin-arr(i,n)) < 900.) then + rmin = min (rmin,arr(i,n)-tmin) + mn = mn + 1 + end if + end if + arr(i,n) = tmin + end if + end do + + if (mn > 0) then + mmnn = mmnn + 1 + rrmin = min (rrmin, rmin) + rrmax = max (rrmax, rmax) + write(6,*) ' ' + write(6,*) ' WARNING -- observed value exceeds limits at ', mn, & + ' time points at latitude ', j + write(6,*) 'and longitude ', i + write(6,*) 'max error = ', rmax, ' min error = ', rmin + end if + +! Compute climatology + + do n=1,12 + m = mod((mon1clm+n-2), 12) + 1 + obsclim(i,j,m)=0.0 + nn = 0 + do k = m3+n-1, m4, 12 + nn = nn + 1 + obsclim(i,j,m) = obsclim(i,j,m) + arr(i,k) + end do + obsclim(i,j,m) = obsclim(i,j,m)/nn + end do + +! Remove climatology to generate anomalies + + do n=m1,m2 + mm = mod((mon1rd+n-m1-1), 12) + 1 + arr(i,n) = arr(i,n) - obsclim(i,j,mm) + end do + end do + + if (mmnn > 0) then + write(6,*) ' ' + write(6,*) ' WARNING -- observed value exceeds limits at' + write(6,*) mmnn, ' grid cells' + write(6,*) 'max error = ', rrmax, ' min error = ', rrmin + end if + +! Solve for climatological mid-month values + + write(6,*) 'Computing climatological mid-month values for latitude ', j + + do i=1,nlon + do m=1,12 + vecin(m) = obsclim(i,j,m) + vecout(m) = obsclim(i,j,m) + end do + + call solvmid (i, j, 12, conv, dt, & + tmin, tmax, bbmin, maxiter, ac, & + cc, vecin, vecout, ismc, jsmc) + + do m=1,12 + centmon(i,j,m) = vecout(m) + end do + + ocentmax = -1.e20 + ocentmin = 1.e20 + centmax = -1.e20 + centmin = 1.e20 + + do m=1,12 + +! Find max and min values and months of max and min values + + if (obsclim(i,j,m) > ocentmax) then + ocentmax = obsclim(i,j,m) + momax = m + end if + + if (obsclim(i,j,m) < ocentmin) then + ocentmin = obsclim(i,j,m) + momin = m + end if + + if (centmon(i,j,m) > centmax) then + centmax = centmon(i,j,m) + mmax = m + end if + + if (centmon(i,j,m) < centmin) then + centmin = centmon(i,j,m) + mmin = m + end if + end do + isea = isea + 1 ! count ocean grid cells + end do + + return +end subroutine calcclim diff --git a/tools/icesst/bcgen/calcfull.f90 b/tools/icesst/bcgen/calcfull.f90 new file mode 100644 index 0000000000..566fbd93a5 --- /dev/null +++ b/tools/icesst/bcgen/calcfull.f90 @@ -0,0 +1,128 @@ +subroutine calcfull (j, nlon, nlat, nmon, ismf, & + jsmf, iyr1rd, mon1rd, iyr1, mon1, & + iyrn, monn, iyrnrd, monnrd, maxiter, & + tmin, tmax, dt, conv, bbmin, & + obsclim, arr, centmon, a, c, & + correl, oldttcalc) + use prec + use solver, only: solvmid + + implicit none + + integer, intent(in) :: j + integer, intent(in) :: nlon + integer, intent(in) :: nlat + integer, intent(in) :: nmon + integer, intent(in) :: monn + integer, intent(in) :: iyrn + integer, intent(in) :: maxiter + integer, intent(in) :: iyr1 + integer, intent(in) :: mon1 + integer, intent(in) :: iyr1rd + integer, intent(in) :: mon1rd + integer, intent(in) :: iyrnrd + integer, intent(in) :: monnrd + + real(r8), intent(in) :: tmin + real(r8), intent(in) :: tmax + real(r8), intent(in) :: dt + real(r8), intent(in) :: conv + real(r8), intent(in) :: bbmin + + real(r8), intent(inout) :: obsclim(nlon,nlat,12) + real(r8), intent(inout) :: arr(nlon,nmon) + real(r8), intent(in) :: centmon(nlon,nlat,12) + real(r8), intent(in) :: a(nmon) + real(r8), intent(in) :: c(nmon) + real(r8), intent(in) :: correl(12) + + logical, intent(in) :: oldttcalc ! for bfb agreement with original code + + integer :: ismf, jsmf + integer :: i + integer :: n, m, mm + integer :: nprior, nafter + + real(r8) :: vecin(nmon) + real(r8) :: vecout(nmon) + real(r8) :: cc + real(r8) :: tt + + write(6,*) 'Calculating mid-month values for latitude ', j + + do i=1,nlon + +! Fill in some months prior to the 1st observed month and +! after the last observed month + + nprior = 12*(iyr1rd-iyr1) + mon1rd - mon1 + if (nprior > 0) then + do m=1,nprior + if ((nprior+1-m) > 12) then + cc = 0.0 + else + cc = correl(nprior+1-m) + end if + mm = mod((mon1-2+m), 12) + 1 + tt = arr(i,nprior+1)*cc + if (obsclim(i,j,mm)+tt > tmax) tt = tmax-obsclim(i,j,mm) +! +!JR Bugfix from K. Taylor: do not zero tt. Keep to allow bfb vs. original code +! + if (oldttcalc) then + if (obsclim(i,j,mm) >= tmax) tt = 0.0 + end if + if (obsclim(i,j,mm)+tt < tmin) tt = tmin-obsclim(i,j,mm) + if (oldttcalc) then + if (obsclim(i,j,mm) <= tmin) tt = 0.0 + end if + arr(i,m) = tt + end do + end if + + nafter = 12*(iyrn-iyrnrd) + monn - monnrd + + if (nafter > 0) then + do m=1,nafter + if (m > 12) then + cc = 0.0 + else + cc = correl(m) + end if + mm = mod((monnrd-1+m), 12) + 1 + tt = arr(i,nmon-nafter)*cc + if ((obsclim(i,j,mm)+tt) > tmax) tt = tmax-obsclim(i,j,mm) +! +!JR Bugfix from K. Taylor: do not zero tt. Keep to allow bfb vs. original code +! + if (oldttcalc) then + if (obsclim(i,j,mm) >= tmax) tt = 0.0 + end if + if ((obsclim(i,j,mm)+tt) < tmin) tt = tmin-obsclim(i,j,mm) + if (oldttcalc) then + if (obsclim(i,j,mm) <= tmin) tt = 0.0 + end if + arr(i,nmon-nafter+m) = tt + end do + end if + +! Copy data into vecin, vecout + + do n=1,nmon + mm = mod((mon1+n-2), 12) + 1 + vecin(n) = arr(i,n) + obsclim(i,j,mm) + vecout(n) = vecin(n) + end do + + call solvmid (i, j, nmon, conv, dt, & + tmin, tmax, bbmin, maxiter, a, & + c, vecin, vecout, ismf, jsmf) + + do n=1,nmon + mm = mod((mon1+n-2), 12) + 1 + arr(i,n) = vecout(n) - centmon(i,j,mm) + end do + end do + + return +end subroutine calcfull diff --git a/tools/icesst/bcgen/driver.f90 b/tools/icesst/bcgen/driver.f90 new file mode 100644 index 0000000000..e174a6b8d9 --- /dev/null +++ b/tools/icesst/bcgen/driver.f90 @@ -0,0 +1,352 @@ +program pcmdisst +!------------------------------------------------------------------------------------ +! +! Purpose: Wrapper program for routines (provided by Karl Taylor of PCMDI) which modify +! mid-month values of SST and ice concentration to preserve monthly means upon +! linear time interpolation. +! +! Method: Read in a namelist containing the relevant variables. Check for validity, +! then call driving subroutine. +! +!------------------------------------------------------------------------------------ + implicit none + + include 'netcdf.inc' + + integer :: mon1 = -1 ! start month of period of interest plus buffer + integer :: iyr1 = -1 ! start year of period of interest plus buffer + integer :: monn = -1 ! end month of period of interest plus buffer + integer :: iyrn = -1 ! end year of period of interest plus buffer + integer :: mon1rd = -1 ! start month to read from input data + integer :: iyr1rd = -1 ! start year to read from input data + integer :: monnrd = -1 ! end month to read from input data + integer :: iyrnrd = -1 ! end year to read from input data + integer :: mon1clm = -1 ! start month to use for climatology + integer :: iyr1clm = -1 ! start year to use for climatology + integer :: monnclm = -1 ! end month to use for climatology + integer :: iyrnclm = -1 ! end year to use for climatology + integer :: nlat = -1 ! number of latitudes (e.g. 64 for typical T42) + integer :: nlon = -1 ! number of longitudes (e.g. 128 for typical T42) + integer :: mon1out = -1 ! start month written to output file (default mon1rd) + integer :: iyr1out = -1 ! start year written to output file (default iyr1rd) + integer :: monnout = -1 ! end month written to output file (default monnrd) + integer :: iyrnout = -1 ! end year written to output file (default iyrnrd) + integer :: nmon ! total number of months of period of interest plus buffer + + logical :: oldttcalc = .false. ! true => bfb agreement with original code + + character(len=120) :: infil = ' ' ! input filename. + character(len=120) :: outfilclim = ' ' ! output climatology file + character(len=120) :: outfilamip = ' ' ! output AMIP-style file + character(len=256) :: string ! temporary character variable + + character(len=256) :: arg ! cmd line argument + character(len=512) :: cmdline ! input command line + character(len=19) :: cur_timestamp + character(len=1024) :: prev_history = ' ' ! history attribute from input file + character(len=1024) :: history = ' ' ! history attribute for output files +! +! netcdf info +! + integer :: ncidin = -1 ! input file handle + integer :: londimid = -1 ! longitude dimension id + integer :: latdimid = -1 ! latitude dimension id +! +! Cmd line +! + integer, external :: iargc + integer :: n, nargs +! +! Namelist +! + namelist /cntlvars/ mon1, iyr1, monn, iyrn, mon1rd, iyr1rd, monnrd, iyrnrd, & + mon1clm, iyr1clm, monnclm, iyrnclm, mon1out, & + iyr1out, monnout, iyrnout, oldttcalc +! +! Read namelist +! + read (5,cntlvars) +! +! Check that all required input items were specified in the namelist +! + call verify_input (mon1, 'mon1', 'start month of period of interest plus buffer') + call verify_input (iyr1, 'iyr1', 'start year of period of interest plus buffer') + call verify_input (monn, 'monn', 'end month of period of interest plus buffer') + call verify_input (iyrn, 'iyrn', 'end year of period of interest plus buffer') + call verify_input (mon1rd, 'mon1rd', 'start month of input data') + call verify_input (iyr1rd, 'iyr1rd', 'start year of input data') + call verify_input (monnrd, 'monnrd', 'end month of input data') + call verify_input (iyrnrd, 'iyrnrd', 'end year of input data') + call verify_input (mon1clm, 'mon1clm', 'start month of output climatology') + call verify_input (iyr1clm, 'iyr1clm', 'start year of output climatology') + call verify_input (monnclm, 'monnclm', 'end month of output climatology') + call verify_input (iyrnclm, 'iyrnclm', 'end year of output climatology') +! +! Check that all specified input values are valid +! + call verify_monthindx (mon1, 'mon1') + call verify_monthindx (monn, 'monn') + call verify_monthindx (mon1rd, 'mon1rd') + call verify_monthindx (monnrd, 'monnrd') + call verify_monthindx (mon1clm, 'mon1clm') + call verify_monthindx (monnclm, 'monnclm') +! +! Check that input dates are valid with respect to each other +! + if ((mon1clm + 12*iyr1clm) < (mon1rd + 12*iyr1rd)) then + write(6,*)'mon1clm, iyr1clm=', mon1clm, iyr1clm + write(6,*)'mon1rd, iyr1rd= ', mon1rd, iyr1rd + call err_exit ('Dates for data to be read must bracket climatology') + end if + + if (mon1rd + 12*iyr1rd > monnrd + 12*(iyrnrd-1)) then + write(6,*)'mon1rd, iyr1rd=', mon1rd, iyr1rd + write(6,*)'monnrd, iyrnrd=', monnrd, iyrnrd + call err_exit ('must read at least 1 year of data total') + end if + + if ((monnclm + 12*iyrnclm) > (monnrd + 12*iyrnrd)) then + write(6,*)'monnclm, iyrnclm=', monnclm, iyrnclm + write(6,*)'monnrd, iyrnrd= ', monnrd, iyrnrd + call err_exit ('End date for climatology exceeds end date of data to be read') + end if + + if (iyr1rd > iyrnrd .or. iyr1rd == iyrnrd .and. mon1rd > mon1rd) then + write(6,*)'mon1rd, iyr1rd=', mon1rd, iyr1rd + write(6,*)'monnrd, iyrnrd=', monnrd, iyrnrd + call err_exit ('Start date for input data exceeds end date') + end if + + if (iyr1 > iyrn .or. iyr1 == iyrn .and. mon1 > monn) then + write(6,*)'mon1, iyr1=', mon1, iyr1 + write(6,*)'monn, iyrn=', monn, iyrn + call err_exit ('Start date for output data exceeds end date') + end if + + if (.not. (monn == mon1-1 .or. mon1 == 1 .and. monn == 12)) then + write(6,*)'mon1, monn=', mon1, monn + call err_exit ('Period to be treated must be an integral number of years') + end if + + if ((mon1 + 12*iyr1) > (mon1rd + 12*iyr1rd)) then + write(6,*)'mon1, iyr1= ', mon1, iyr1 + write(6,*)'mon1rd, iyr1rd=', mon1rd, iyr1rd + call err_exit ('Start date of data to be read must not preceed period of interest') + end if + + if ((monn + 12*iyrn) < (monnrd + 12*iyrnrd)) then + write(6,*)'monn, iyrn= ', monn, iyrn + write(6,*)'monnrd, iyrnrd=', monnrd, iyrnrd + call err_exit ('End date of data to be read must not follow period of interest') + end if + + if (mod((monn+12-mon1+1),12) /= 0) then + write(6,*)'mon1, monn=',mon1, monn + string = 'error in time specifications: only integral number of yrs allowed' + call err_exit (string) + end if +! +! Ensure that climatology period is as expected (1982-2001). To enable other +! averaging periods, just comment out the following bit of code +! + if (mon1clm /= 1 .or. iyr1clm /= 1982 .or. & + monnclm /= 12 .or. iyrnclm /= 2001) then + write(6,*)'Climatological averaging period is not as expected (1982-2001)' + write(6,*)'If you REALLY want to change the averaging period, delete the' + write(6,*)'appropriate err_exit call from driver.f90' + call err_exit ('pcmdisst') + end if +! +! Calculate derived variables +! + nmon = (iyrn - iyr1)*12 + (monn - mon1 + 1) + + if (monn - mon1 + 12*(iyrn - iyr1)+1 /= nmon) then + string = 'error in time specifications: parameter nmon must be consistent with '// & + 'first and last months specified. Check nmon, mon1, iyr1, monn, iyrn' + call err_exit (string) + end if + + ! parse command line arguments, saving them to be written to history attribute + nargs = iargc () + n = 1 + cmdline = 'bcgen ' + do while (n <= nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + select case (arg) + case ('-i') + call getarg (n, arg) + n = n + 1 + infil = arg + cmdline = trim(cmdline) // ' -i ' // trim(infil) + case ('-c') + call getarg (n, arg) + n = n + 1 + outfilclim = arg + cmdline = trim(cmdline) // ' -c ' // trim(outfilclim) + case ('-t') + call getarg (n, arg) + n = n + 1 + outfilamip = arg + cmdline = trim(cmdline) // ' -t ' // trim(outfilamip) + case default + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end select + end do + +! +! Check required input character variables +! + if (infil == ' ') then + call usage_exit ('input file must be specified using -i command-line option') + end if + + if (outfilclim == ' ') then + call usage_exit ('output climatology file must be specified using -c command-line option') + end if + + if (outfilamip == ' ') then + call usage_exit ('output time series file must be specified using -t command-line option') + end if +! +! Set defaults for unspecified variables +! + if (mon1out == -1) mon1out = mon1rd + if (iyr1out == -1) iyr1out = iyr1rd + if (monnout == -1) monnout = monnrd + if (iyrnout == -1) iyrnout = iyrnrd +! +! Check validity of output dates +! + call verify_monthindx (mon1out, 'mon1out') + call verify_monthindx (monnout, 'monnout') + + if (iyr1out > iyrnout .or. iyr1out == iyrnout .and. mon1out > mon1out) then + call err_exit ('Start date for output exceeds end date') + end if +! +! Calculate derived variables +! + nmon = (iyrn - iyr1)*12 + (monn - mon1 + 1) +! +! Open input file and obtain grid size (nlon and nlat) +! + call wrap_nf_open (infil, NF_NOWRITE, ncidin) + call wrap_nf_inq_dimid (ncidin, 'lon', londimid) + call wrap_nf_inq_dimid (ncidin, 'lat', latdimid) + call wrap_nf_inq_dimlen (ncidin, londimid, nlon) + call wrap_nf_inq_dimlen (ncidin, latdimid, nlat) +! +! Add to or define history attribute. +! + if (nf_get_att_text (ncidin, NF_GLOBAL, 'history', prev_history) /= NF_NOERR) then + write(6,*)'nf_get_att_text() failed for history attribute' + end if + + call get_curr_timestamp(cur_timestamp) + if (len_trim(prev_history) == 0) then + history = cur_timestamp // ' ' // trim(cmdline) + else + history = trim(prev_history) // char(10) // cur_timestamp // ' ' // trim(cmdline) + end if + + write(6,*)'Grid size is nlon,nlat=', nlon, nlat +! +! Call Karl's main program or the derivative code. Either should give the same answers +! + call bcgen (mon1, iyr1, monn, iyrn, mon1rd, & + iyr1rd, monnrd, iyrnrd, mon1clm, iyr1clm, & + monnclm, iyrnclm, nlat, nlon, mon1out, & + iyr1out, monnout, iyrnout, ncidin, outfilclim, & + outfilamip, nmon, oldttcalc, history) + write(6,*)'Done writing output files ', trim(outfilclim), ' and ', trim(outfilamip) + stop 0 +end program pcmdisst + +subroutine verify_monthindx (indx, varname) +!------------------------------------------------------------------------------------ +! +! Purpose: Check validity of input month index. +! +!------------------------------------------------------------------------------------ + implicit none +! +! Input arguments +! + integer, intent(in) :: indx + character(len=*), intent(in) :: varname + + if (indx < 1 .or. indx > 12) then + write(6,*) varname, '=', indx, ' is an invalid month index' + stop 999 + end if + + return +end subroutine verify_monthindx + +subroutine err_exit (string) +!------------------------------------------------------------------------------------ +! +! Purpose: Print an error message and exit +! +!------------------------------------------------------------------------------------ + implicit none +! +! Input arguments +! + character(len=*), intent(in) :: string + + write(6,*) string + stop 999 +end subroutine err_exit + +subroutine verify_input (ivar, ivarname, string) +!------------------------------------------------------------------------------------ +! +! Purpose: Check that a required input variable was actually set. If not, print an +! error msg and exit. +! +! Method: All namelist input integer variables must have a non-negative value. Since +! they are initialized to -1, a check on < 0 effectively checks whether they +! were correctly set in the namelist. +!------------------------------------------------------------------------------------ + implicit none +! +! Input arguments +! + integer, intent(in) :: ivar + character(len=*), intent(in) :: ivarname + character(len=*), intent(in) :: string + + if (ivar < 0) then + write(6,*) ivarname, ' must be set in the namelist to a non-negative value' + write(6,*) 'verbose description of this variable: ', trim(string) + stop 999 + end if + + return +end subroutine verify_input + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg /= ' ') write (6,*) arg + write (6,*) 'Usage: bcgen -i infile -c climfile -t tsfile < namelist_file' + write (6,*) ' -i file: input file' + write (6,*) ' -c file: output climatology file' + write (6,*) ' -t file: output time series file' + stop 999 +end subroutine usage_exit + +subroutine get_curr_timestamp(time) +! return timestamp formatted as "YYYY-MM-DD HH:MM:SS" + character(len=19), intent(out) :: time + integer :: t(8) + call date_and_time(values=t) + write(time,'(i4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') t(1),'-',t(2),'-',t(3),' ',& + t(5),':',t(6),':',t(7) +end subroutine get_curr_timestamp diff --git a/tools/icesst/bcgen/namelist b/tools/icesst/bcgen/namelist new file mode 100644 index 0000000000..37058d4c70 --- /dev/null +++ b/tools/icesst/bcgen/namelist @@ -0,0 +1,18 @@ + &cntlvars + mon1 = 1 + iyr1 = 1948 + monn = 12 + iyrn = 2005 + mon1rd = 1 + iyr1rd = 1949 + monnrd = 12 + iyrnrd = 2004 + mon1clm = 1 + iyr1clm = 1982 + monnclm = 12 + iyrnclm = 2001 + mon1out = 1 + iyr1out = 1949 + monnout = 10 + iyrnout = 2004 + / diff --git a/tools/icesst/bcgen/output_dateinfo.f90 b/tools/icesst/bcgen/output_dateinfo.f90 new file mode 100644 index 0000000000..502e4fe1d6 --- /dev/null +++ b/tools/icesst/bcgen/output_dateinfo.f90 @@ -0,0 +1,62 @@ +subroutine output_dateinfo (ncid, dateid, datesecid, timeid, iyr1out, & + mon1out, iyrnout, monnout, monlen) + use prec + + implicit none + + integer, intent(in) :: ncid ! netcdf file id + integer, intent(in) :: dateid ! date id + integer, intent(in) :: datesecid ! id for seconds of current date + integer, intent(in) :: timeid ! time variable id + integer, intent(in) :: iyr1out ! start year written to output file (default iyr1rd) + integer, intent(in) :: mon1out ! start month written to output file (default mon1rd) + integer, intent(in) :: iyrnout ! end year written to output file (default iyrnrd) + integer, intent(in) :: monnout ! end month written to output file + integer, intent(in) :: monlen(12) ! length of months + + integer :: date(1) ! array to please lf95 + integer :: datesec(1) ! array to please lf95 + integer :: yr ! year + integer :: mo ! month + integer :: start(1) ! initial value + integer, parameter :: count(1) = 1 ! number of values to write to netcdf file + + real(r8) :: time(1) ! array to please lf95 + real(r8) :: prvrem ! remaining length of prv month + real(r8) :: halfmo ! half the length of current month + + if (mon1out < 1 .or. mon1out > 12) then + call err_exit ('output_dateinfo: mon1out must be between 1 and 12') + end if + + if (monnout < 1 .or. monnout > 12) then + call err_exit ('output_dateinfo: monnout must be between 1 and 12') + end if + + yr = iyr1out + mo = mon1out + start(1) = 0 + time(1) = 0. + prvrem = 0. + do while (yr < iyrnout .or. yr == iyrnout .and. mo <= monnout) + start(1) = start(1) + 1 + date(1) = yr*10000 + mo*100 + monlen(mo)/2 + 1 + + datesec(1) = 0 + if (mod(monlen(mo), 2) /= 0) datesec(1) = 43200 + + halfmo = monlen(mo)/2 + datesec(1)/86400._r8 ! half of the current month length + time(1) = time(1) + prvrem + halfmo ! plus remaining half of prv month + prvrem = monlen(mo) - halfmo ! set remainder for next iteration + call wrap_nf_put_vara_int (ncid, dateid, start, count, date) + call wrap_nf_put_vara_int (ncid, datesecid, start, count, datesec) + call wrap_nf_put_vara_double (ncid, timeid, start, count, time) + mo = mo + 1 + if (mo == 13) then + mo = 1 + yr = yr + 1 + end if + end do + + return +end subroutine output_dateinfo diff --git a/tools/icesst/bcgen/prec.f90 b/tools/icesst/bcgen/prec.f90 new file mode 100644 index 0000000000..de762b4efe --- /dev/null +++ b/tools/icesst/bcgen/prec.f90 @@ -0,0 +1,9 @@ +module prec +! +! Define 8-byte size +! Use 6 for real*4 arithmetic. Reason is to get bfb agreement with +! Karl Taylor's original code. +! +! integer, parameter :: r8 = selected_real_kind(6) + integer, parameter :: r8 = selected_real_kind(12) +end module prec diff --git a/tools/icesst/bcgen/setup_outfile.f90 b/tools/icesst/bcgen/setup_outfile.f90 new file mode 100644 index 0000000000..2829f29d62 --- /dev/null +++ b/tools/icesst/bcgen/setup_outfile.f90 @@ -0,0 +1,136 @@ +subroutine setup_outfile (ncid, outfil, tag, dateid, datesecid, & + timeid, icesst, nlon, nlat, xlon, & + xlat, iyr1out, mon1out, history) + use prec + use types + + implicit none + + include 'netcdf.inc' + + integer, intent(out) :: ncid ! output file netcdf id + character(len=*), intent(in) :: outfil ! output file name + character(len=*), intent(in) :: tag ! 'CLIM' or 'AMIP' + integer, intent(out) :: dateid, datesecid ! date variable ids + integer, intent(out) :: timeid ! time variable id + type(icesstparms), intent(inout) :: icesst(2) ! struct containing ice or sst-specific info + integer, intent(in) :: nlon ! number of longitudes + integer, intent(in) :: nlat ! number of latitudes + real(r8), intent(in) :: xlon(nlon) ! longitude coordinate values + real(r8), intent(in) :: xlat(nlat) ! latitude coordinate values + integer, intent(in) :: iyr1out ! start year written to output file + integer, intent(in) :: mon1out ! start month written to output file + character(len=*), intent(in) :: history ! history attribute + + integer :: ret ! return code + integer :: dimids(3) ! dimension ids for multi-dimensioned arrays + integer :: lonid, latid ! lon, lat variable ids + + character(len=32) :: name ! variable name + character(len=32) :: str ! attribute string +! +! Open file and define dimensions +! + call wrap_nf_create (outfil, NF_CLOBBER, ncid) + call wrap_nf_def_dim (ncid, 'lon', nlon, dimids(1)) + call wrap_nf_def_dim (ncid, 'lat', nlat, dimids(2)) + call wrap_nf_def_dim (ncid, 'time', NF_UNLIMITED, dimids(3)) +! +! Model-readable date info +! + call wrap_nf_def_var (ncid, 'date', NF_INT, 1, dimids(3), dateid) + call wrap_nf_put_att_text (ncid, dateid, 'long_name', 'current date (YYYYMMDD)') + + call wrap_nf_def_var (ncid, 'datesec', NF_INT, 1, dimids(3), datesecid) + call wrap_nf_put_att_text (ncid, datesecid, 'long_name', 'current seconds of current date') +! +! Dimension variables +! + call wrap_nf_def_var (ncid, 'lon', NF_DOUBLE, 1, dimids(1), lonid) + call wrap_nf_put_att_text (ncid, lonid, 'long_name', 'longitude') + call wrap_nf_put_att_text (ncid, lonid, 'units', 'degrees_east') + + call wrap_nf_def_var (ncid, 'lat', NF_DOUBLE, 1, dimids(2), latid) + call wrap_nf_put_att_text (ncid, latid, 'long_name', 'latitude') + call wrap_nf_put_att_text (ncid, latid, 'units', 'degrees_north') + + call wrap_nf_def_var (ncid, 'time', NF_DOUBLE, 1, dimids(3), timeid) + write(str,100) iyr1out, mon1out +100 format('days since ',i4.4,'-',i2.2,'-01 00:00:00') + call wrap_nf_put_att_text (ncid, timeid, 'units', trim(str)) + call wrap_nf_put_att_text (ncid, timeid, 'calendar', '365_day') + + ! history attribute + call wrap_nf_put_att_text (ncid, NF_GLOBAL, 'history', trim(history)) + +! +! Define variables +! + select case (tag) + case ('CLIM') +! +! ice +! + name = icesst(1)%climname + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(1)%varidclim) + call wrap_nf_put_att_text (ncid, icesst(1)%varidclim, 'long_name', icesst(1)%climlongname) + call wrap_nf_put_att_text (ncid, icesst(1)%varidclim, 'units', icesst(1)%units) + + name = icesst(1)%climname_pre + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(1)%varidclim_pre) + call wrap_nf_put_att_text (ncid, icesst(1)%varidclim_pre, 'long_name', icesst(1)%climlongname_pre) + call wrap_nf_put_att_text (ncid, icesst(1)%varidclim_pre, 'units', icesst(1)%units) +! +! sst +! + name = icesst(2)%climname + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(2)%varidclim) + call wrap_nf_put_att_text (ncid, icesst(2)%varidclim, 'long_name', icesst(2)%climlongname) + call wrap_nf_put_att_text (ncid, icesst(2)%varidclim, 'units', icesst(2)%units) + + name = icesst(2)%climname_pre + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(2)%varidclim_pre) + call wrap_nf_put_att_text (ncid, icesst(2)%varidclim_pre, 'long_name', icesst(2)%climlongname_pre) + call wrap_nf_put_att_text (ncid, icesst(2)%varidclim_pre, 'units', icesst(2)%units) + case ('AMIP') +! +! ice +! + name = icesst(1)%amipname + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(1)%varidamip) + call wrap_nf_put_att_text (ncid, icesst(1)%varidamip, 'long_name', icesst(1)%amiplongname) + call wrap_nf_put_att_text (ncid, icesst(1)%varidamip, 'units', icesst(1)%units) + + name = icesst(1)%amipname_pre + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(1)%varidamip_pre) + call wrap_nf_put_att_text (ncid, icesst(1)%varidamip_pre, 'long_name', icesst(1)%amiplongname_pre) + call wrap_nf_put_att_text (ncid, icesst(1)%varidamip_pre, 'units', icesst(1)%units) +! +! sst +! + name = icesst(2)%amipname + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(2)%varidamip) + call wrap_nf_put_att_text (ncid, icesst(2)%varidamip, 'long_name', icesst(2)%amiplongname) + call wrap_nf_put_att_text (ncid, icesst(2)%varidamip, 'units', icesst(2)%units) + + name = icesst(2)%amipname_pre + call wrap_nf_def_var (ncid, name, NF_FLOAT, 3, dimids, icesst(2)%varidamip_pre) + call wrap_nf_put_att_text (ncid, icesst(2)%varidamip_pre, 'long_name', icesst(2)%amiplongname_pre) + call wrap_nf_put_att_text (ncid, icesst(2)%varidamip_pre, 'units', icesst(2)%units) + case default + write(6,*) 'tag ', tag, ' is an invalid tag: valid values are CLIM and AMIP' + stop 999 + end select + + ret = nf_enddef (ncid) + if (ret < 0) then + call handle_error (ret) + end if + + call wrap_nf_put_var_double (ncid, lonid, xlon) + call wrap_nf_put_var_double (ncid, latid, xlat) + + return +end subroutine setup_outfile + + diff --git a/tools/icesst/bcgen/solver.f90 b/tools/icesst/bcgen/solver.f90 new file mode 100644 index 0000000000..67ecbb0d9f --- /dev/null +++ b/tools/icesst/bcgen/solver.f90 @@ -0,0 +1,950 @@ +module solver + + use prec + + implicit none + + ! maximum number of months in input dataset + integer, parameter :: nmax=12*250 + +CONTAINS + + subroutine solvmid (lonindx, latindx, nmon, conv, dt, tmin, tmax, & + bbmin, maxiter, a, c, obsmean, ss, icnt, jcnt) + + integer, intent(in) :: lonindx + integer, intent(in) :: latindx + integer, intent(in) :: nmon + integer, intent(in) :: maxiter ! max number of iterations + integer, intent(inout) :: icnt, jcnt ! number of points smoothed + real(r8), intent(in) :: conv, tmin, tmax, dt, bbmin + real(r8), intent(inout) :: obsmean(nmon) + real(r8), intent(in) :: a(nmon), c(nmon) + real(r8), intent(inout) :: ss(nmon) + + integer i, n, imethod, n1, n2, nn, jj, i1, i2, i3, nnn, jend, & + kk, j, k, kkk, nm, np + integer jbeg(nmax) + + real(r8) :: relax, residmax, resid, dxm, dxp, s1, s2, addmax, addmin + real(r8) :: r(nmax), avg(nmax), aa(nmax), bb(nmax), cc(nmax), add(nmax) + + double precision s(nmax), sum + + imethod = 1 +! ??? check following value + relax = 1.0 + + if (nmon > nmax) then + write(6,*) 'error-- nmax not declared large enough in ' + write(6,*) 'subroutine solvmid' + stop 999 + end if + +! Check for occurance where obs monthly means are consecutively +! at upper and lower limits. If so, smooth data, being careful +! to preserve annual mean. + + do n=1,nmon + add(n) = 0.0 + end do + + n2 = nmon + do n=1,nmon + n1 = n2 + n2 = n + if ((obsmean(n2)-obsmean(n1)) > (tmax-tmin-2.*dt)) then + add(n1) = add(n1) + (0.5*(obsmean(n2)-obsmean(n1)-tmax+tmin) + dt)/c(n1) + add(n2) = add(n2) - (0.5*(obsmean(n2)-obsmean(n1)-tmax+tmin) + dt)/a(n2) + else if ((obsmean(n1)-obsmean(n2)) > (tmax-tmin-2.*dt)) then + add(n1) = add(n1) - (0.5*(obsmean(n1)-obsmean(n2)-tmax+tmin) + dt)/c(n1) + add(n2) = add(n2) + (0.5*(obsmean(n1)-obsmean(n2)-tmax+tmin) + dt)/a(n2) + end if + end do + + nn = 0 + addmax = 0.0 + addmin = 0.0 + do n=1,nmon + + if (add(n) .ne. 0.0) then +! write(6,*) 'monthly means go from one limit to the other in 1 month' +! write(6,*) 'alat = ', latindx, ' i = ', lonindx, ' n = ', n, ' add = ', add(n) + addmax = max(addmax, add(n)) + addmin = min(addmin, add(n)) + obsmean(n) = obsmean(n) + add(n) + nn = nn + 1 + end if + end do + + icnt = icnt + nn + if (nn > 0) then + jcnt = jcnt + 1 +! if (nmon == 12) then +! write(6,*) 'Climatology: ' +! endif + if (jcnt <= 200) then + write(6,*) nn, ' monthly values smoothed at lat= ', latindx, ' lon= ', lonindx + write(6,'(a,1p,e14.7,a,e14.7)') 'max added = ', addmax, ' max subtracted = ', addmin + end if + + if (jcnt == 200) then + write(6,*) ' ' + if (nmon == 12) then + write(6,*) 'No more warnings will be printed concerning smoothing of climatological data' + else + write(6,*) 'No more warnings will be printed concerning smoothing of monthly data' + end if + write(6,*) ' ' + if (nmon == 12) then + write(6,*) 'No more warnings will be printed concerning smoothing of climatological data' + else + write(6,*) 'No more warnings will be printed concerning smoothing of monthly data' + endif + write(6,*) ' ' + endif + endif + +! check if all are le tmin or all are ge tmax + + if (obsmean(1) <= (tmin+0.01*dt)) then + do i=2,nmon + if (obsmean(i) > (tmin+0.01*dt)) go to 99 + end do + do i=1,nmon + ss(i) = tmin + end do +! if (nmon == 12) write(6,*) 'Climatology: ' +! write(6,*) 'all values were at minimum at this grid cell:' +! write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + return + + else if (obsmean(1) >= (tmax-0.01*dt)) then + + do i=2,nmon + if (obsmean(i) < (tmax-0.01*dt)) go to 99 + end do + do i=1,nmon + ss(i) = tmax + end do +! if (nmon == 12) write(6,*) 'Climatology: ' +! write(6,*) 'all values were at maximum at this grid cell:' +! write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + return + + end if + + 99 jj = 0 + do i=1,nmon + i1 = i + i2 = mod(i,nmon) + 1 + i3 = mod((i+1), nmon) + 1 + + if ((obsmean(i1) <= tmin+0.01*dt .and. obsmean(i2) <= tmin+0.01*dt .and. & + obsmean(i3) > tmin+0.01*dt) .or. & + (obsmean(i1) >= tmax-0.01*dt .and. obsmean(i2) >= tmax-0.01*dt .and. & + obsmean(i3) < tmax-0.01*dt)) then + jj = jj + 1 + jbeg(jj) = i2 + end if + end do + + if (jj == 0) then ! simple cyclic treatment + +! Latest approximation of means (given mid-month values) + + nnn = 0 + 105 nnn = nnn + 1 + sum = 0.0 + residmax = 0.0 + + do n = 1, nmon + nm = mod((n+nmon-2), nmon) + 1 + np = mod(n, nmon) + 1 + bb(n) = 0.0 + avg(n) = 0.0 + if (nnn < imethod) then + call approx (tmin, tmax, a(n), c(n), ss(nm), ss(n), & + ss(np), aa(n), bb(n), cc(n), avg(n)) + + else + call numer (conv, tmin, tmax, bbmin, a(n), c(n), ss(nm), & + ss(n), ss(np), aa(n), bb(n), cc(n), avg(n)) + end if + + r(n) = obsmean(n) - avg(n) + sum = sum + r(n)**2 + residmax = max(residmax, abs(r(n))) + end do + + resid = dsqrt(sum)/nmon + if (residmax > conv) then + if (nnn > maxiter*0.5) then + write(6,'(a,i8,a,1p,e14.7,a,e14.7)') 'iteration = ', nnn, ' residual = ', & + resid, ' maximum residual = ', residmax + end if + + if (nnn > maxiter*0.9) then + write(6,*) ' ' + write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + do n=1,nmon + write(6,'(8(1pe10.2))') obsmean(n), avg(n), r(n), s(n), ss(n), aa(n), bb(n), cc(n) + end do + end if + + if (nnn > maxiter) then + write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + write(6,*) 'does not converge' +!JR uncomment so it barfs if no convergence + call exit(1) + end if + +! Solve for new estimate of mid-month values + + call cyclic (lonindx, latindx, aa, bb, cc, cc(nmon), aa(1), r, s, nmon) + + do n=1,nmon + ss(n) = ss(n) + relax*s(n) + end do + +! If ss exceeds tmax or tmin, then it should exceed it no +! more than absolutely necessary: + + do n=1,nmon + nm = mod((n+nmon-2), nmon) + 1 + np = mod(n, nmon) + 1 + + if (ss(n) > tmax) then + if (ss(nm) <= tmax) then + dxm = (ss(n)-tmax)/((ss(n)-ss(nm))*a(n)) + else + dxm = 0.0 + end if + + if (ss(np) <= tmax) then + dxp = (ss(n)-tmax)/((ss(n)-ss(np))*c(n)) + else + dxp = 0.0 + end if + + if ((dxm > 0.5) .and. (dxp > 0.5)) then + s1 = tmax + (tmax-ss(nm))*a(n)/(2.-a(n)) + s2 = tmax + (tmax-ss(np))*c(n)/(2.-c(n)) + ss(n) = min(s1, s2) + else if ((dxm == 0.0) .and. (dxp == 0.0)) then + ss(n) = tmax + else if ((dxp == 0.0) .and. (dxm > 0.5)) then + ss(n) = tmax + (tmax-ss(nm))*a(n)/(2.-a(n)) + else if ((dxm == 0.0) .and. (dxp > 0.5)) then + ss(n) = tmax + (tmax-ss(np))*c(n)/(2.-c(n)) + end if + + else if (ss(n) < tmin) then + + if (ss(nm) >= tmin) then + dxm = (ss(n)-tmin)/((ss(n)-ss(nm))*a(n)) + else + dxm = 0.0 + end if + + if (ss(np) >= tmin) then + dxp = (ss(n)-tmin)/((ss(n)-ss(np))*c(n)) + else + dxp = 0.0 + endif + + if ((dxm > 0.5) .and. (dxp > 0.5)) then + s1 = tmin + (tmin-ss(nm))*a(n)/(2.-a(n)) + s2 = tmin + (tmin-ss(np))*c(n)/(2.-c(n)) + ss(n) = min(s1, s2) + else if ((dxm == 0.0) .and. (dxp == 0.0)) then + ss(n) = tmin + else if ((dxp == 0.0) .and. (dxm > 0.5)) then + ss(n) = tmin + (tmin-ss(nm))*a(n)/(2.-a(n)) + elseif ((dxm == 0.0) .and. (dxp > 0.5)) then + ss(n) = tmin + (tmin-ss(np))*c(n)/(2.-c(n)) + end if + end if + end do + go to 105 + end if + else + +! Treat independent segments + + do j=1,jj + jend = jbeg(j) +150 jend = jend + 1 + i1 = mod((jend-1), nmon) + 1 + i2 = mod(jend, nmon) + 1 + if ((obsmean(i1) <= tmin+0.01*dt .and. obsmean(i2) <= tmin+0.01*dt) .or. & + (obsmean(i1) >= tmax-0.01*dt .and. obsmean(i2) >= tmax-0.01*dt)) then + +! Calculate values for interval jbeg(j) to jend +! latest approximation of means (given mid-month values) + + nnn = 0 +205 nnn = nnn + 1 + kk = jend - jbeg(j) + 1 + n = jbeg(j) + avg(1) = obsmean(n) + r(1) = 0.0 + n = mod((jend-1), nmon) + 1 + avg(kk) = obsmean(n) + r(kk) = 0.0 + sum = 0.0 + residmax = 0.0 + + do k = 2, kk-1 + nm = mod((k+jbeg(j)-3), nmon) + 1 + n = mod((k+jbeg(j)-2), nmon) + 1 + np = mod((k+jbeg(j)-1), nmon) + 1 + bb(k) = 0.0 + avg(k) = 0.0 + + if (nnn < imethod) then + call approx (tmin, tmax, a(n), c(n), ss(nm), ss(n), & + ss(np), aa(k), bb(k), cc(k), avg(k)) + else + call numer (conv, tmin, tmax, bbmin, a(n), c(n), ss(nm), & + ss(n), ss(np), aa(k), bb(k), cc(k), avg(k)) + end if + + r(k) = obsmean(n) - avg(k) + sum = sum + r(k)**2 + residmax = max(residmax, abs(r(k))) + end do + + resid = dsqrt(sum)/(kk-2) + + if (residmax > conv) then + if (nnn > maxiter*0.5) then + write(6,'(a,i8,a,i8,a,1p,e14.7,a,e14.7)') 'iter = ', nnn, ' kk = ', kk, & + ' residual = ', resid, ' maximum residual = ', residmax + end if + + if (nnn > maxiter*0.9) then + write(6,*) ' ' + write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + do k=1,kk + n = mod((k+jbeg(j)-2), nmon) + 1 + write(6,'(8(1pe10.2))') obsmean(n), avg(k), r(k), s(k), ss(n), & + aa(k), bb(k), cc(k) + end do + end if + + if (nnn > maxiter) then + write(6,*) 'latitude = ', latindx, ' longitude = ', lonindx + write(6,*) 'does not converge' +!JR uncomment so it barfs if no convergence + call exit(1) + end if + +! Solve for new estimate of mid-month values + + kkk = kk - 2 + call tridag(lonindx, latindx, aa(2), bb(2), cc(2), r(2), s(2), kkk) + + do k=2,kk-1 + n = mod((k+jbeg(j)-2), nmon) + 1 + ss(n) = ss(n) + relax*s(k) + end do + +! If ss exceeds tmax or tmin, then it should exceed it no +! more than absolutely necessary: + + n = mod((jbeg(j)-1), nmon) + 1 + np = mod(jbeg(j), nmon) + 1 + + if (obsmean(n) >= (tmax-0.01*dt)) then + ss(n) = max(tmax, (tmax + (tmax-ss(np))*c(n)/(2.-c(n)))) + else + ss(n) = min(tmin, (tmin + (tmin-ss(np))*c(n)/(2.-c(n)))) + end if + + nm = mod((jend+nmon-2), nmon) + 1 + n = mod((jend-1), nmon) + 1 + + if (obsmean(n) >= (tmax-0.01*dt)) then + ss(n) = max(tmax, (tmax + (tmax-ss(nm))*a(n)/(2.-a(n)))) + else + ss(n) = min(tmin, (tmin + (tmin-ss(nm))*a(n)/(2.-a(n)))) + end if + + do k=2,kk-1 + nm = mod((k+jbeg(j)+nmon-3), nmon) + 1 + n = mod((k+jbeg(j)-2), nmon) + 1 + np = mod((k+jbeg(j)-1), nmon) + 1 + + if (ss(n) > tmax) then + if (ss(nm) <= tmax) then + dxm = (ss(n)-tmax)/((ss(n)-ss(nm))*a(n)) + else + dxm = 0.0 + end if + + if (ss(np) <= tmax) then + dxp = (ss(n)-tmax)/((ss(n)-ss(np))*c(n)) + else + dxp = 0.0 + end if + + if ((dxm > 0.5) .and. (dxp > 0.5)) then + s1 = tmax + (tmax-ss(nm))*a(n)/(2.-a(n)) + s2 = tmax + (tmax-ss(np))*c(n)/(2.-c(n)) + ss(n) = min(s1, s2) + else if ((dxm == 0.0) .and. (dxp == 0.0)) then + ss(n) = tmax + else if ((dxp == 0.0) .and. (dxm > 0.5)) then + ss(n) = tmax + (tmax-ss(nm))*a(n)/(2.-a(n)) + else if ((dxm == 0.0) .and. (dxp > 0.5)) then + ss(n) = tmax + (tmax-ss(np))*c(n)/(2.-c(n)) + end if + + else if (ss(n) < tmin) then + + if (ss(nm) >= tmin) then + dxm = (ss(n)-tmin)/((ss(n)-ss(nm))*a(n)) + else + dxm = 0.0 + end if + + if (ss(np) >= tmin) then + dxp = (ss(n)-tmin)/((ss(n)-ss(np))*c(n)) + else + dxp = 0.0 + end if + + if ((dxm > 0.5) .and. (dxp > 0.5)) then + s1 = tmin + (tmin-ss(nm))*a(n)/(2.-a(n)) + s2 = tmin + (tmin-ss(np))*c(n)/(2.-c(n)) + ss(n) = max(s1, s2) + else if ((dxm == 0.0) .and. (dxp == 0.0)) then + ss(n) = tmin + else if ((dxp == 0.0) .and. (dxm > 0.5)) then + ss(n) = tmin + (tmin-ss(nm))*a(n)/(2.-a(n)) + else if ((dxm == 0.0) .and. (dxp > 0.5)) then + ss(n) = tmin + (tmin-ss(np))*c(n)/(2.-c(n)) + end if + end if + end do + go to 205 + end if + go to 300 + else + go to 150 + end if + + if ((ss(kk) > 700.0) .or. (ss(kk) < -700.0)) then + write(6,*) 'exceeds 700 at lat = ', latindx, ' lonindx = ', lonindx + write(6,*) 'kk = ', kk, ' obs = ', obsmean(kk-1), obsmean(kk), obsmean(kk+1) + write(6,*) 'kk = ', kk, ' ss = ', ss(kk-1), ss(kk), ss(kk+1) + end if +300 continue + end do + +! Fill in values where consecutive means are outside limits + + do i=1,nmon + i1 = mod((i-2+nmon), nmon) + 1 + i2 = mod((i-1), nmon) + 1 + i3 = mod(i, nmon) + 1 + if (obsmean(i1) <= tmin+0.01*dt .and. obsmean(i2) <= tmin+0.01*dt .and. & + obsmean(i3) <= tmin+0.01*dt) then + ss(i2) = tmin + else if (obsmean(i1) >= tmax-0.01*dt .and. obsmean(i2) >= tmax-0.01*dt .and. & + obsmean(i3) >= tmax-0.01*dt) then + ss(i2) = tmax + end if + end do + end if + + return + end subroutine solvmid + + subroutine numer (conv, tmin, tmax, bbmin, a, & + c, ssm, ss, ssp, aa, & + bb, cc, avg) +! ********************************************************************* + + real(r8), intent(in) :: conv + real(r8), intent(in) :: tmin + real(r8), intent(in) :: tmax + real(r8), intent(in) :: bbmin + real(r8), intent(in) :: a + real(r8), intent(in) :: c + real(r8), intent(in) :: ssm + real(r8), intent(in) :: ss + real(r8), intent(in) :: ssp + real(r8), intent(out) :: aa + real(r8), intent(out) :: bb + real(r8), intent(out) :: cc + real(r8), intent(out) :: avg + + real(r8) :: ssmm + real(r8) :: ssmp + real(r8) :: sssm + real(r8) :: sssp + real(r8) :: sspm + real(r8) :: sspp + real(r8) :: r + + avg = amean (tmin,tmax,a,c,ssm,ss,ssp) + + ssmm = ssm - conv + ssmp = ssm + conv + sssm = ss - conv + sssp = ss + conv + sspm = ssp - conv + sspp = ssp + conv + + aa = (amean(tmin,tmax,a,c,ssmp,ss,ssp) - & + amean(tmin,tmax,a,c,ssmm,ss,ssp)) / (2.*conv) + + bb = (amean(tmin,tmax,a,c,ssm,sssp,ssp) - & + amean(tmin,tmax,a,c,ssm,sssm,ssp)) / (2.*conv) + + cc = (amean(tmin,tmax,a,c,ssm,ss,sspp) - & + amean(tmin,tmax,a,c,ssm,ss,sspm)) / (2.*conv) + + aa = min(aa, bb) + cc = min(cc, bb) + + if (bb < bbmin) then + bb = bbmin + r = 0.2*bbmin + aa = max(r, aa) + cc = max(r, cc) + endif + + return + end subroutine numer + + real(r8) function amean (tmin, tmax, a, c, ssm, ss, ssp) + + real(r8), intent(in) :: tmin, tmax, a, c, ssm, ss, ssp + + real(r8) :: dx, dy, avg + + avg = 0.0 + + if (ss <= tmin) then + if (ssm <= tmin) then + avg = avg + tmin*0.5 + else if (ssm >= tmax) then + dx = (ss-tmin)/((ss-ssm)*a) + dy = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + else if (dy <= 0.5) then + avg = avg + tmin*dx + tmax*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*a*(ss-ssm)) + end if + else + dx = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*a*(ss-ssm)) + end if + end if + + if (ssp <= tmin) then + avg = avg + tmin*0.5 + else if (ssp >= tmax) then + dx = (ss-tmin)/((ss-ssp)*c) + dy = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + else if (dy <= 0.5) then + avg = avg + tmin*dx + tmax*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*c*(ss-ssp)) + end if + else + dx = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*c*(ss-ssp)) + end if + end if + else if (ss >= tmax) then + if (ssm >= tmax) then + avg = avg + tmax*0.5 + else if (ssm <= tmin) then + dx = (ss-tmax)/((ss-ssm)*a) + dy = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + else if (dy <= 0.5) then + avg = avg + tmax*dx + tmin*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*a*(ss-ssm)) + end if + else + dx = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*a*(ss-ssm)) + end if + end if + + if (ssp >= tmax) then + avg = avg + tmax*0.5 + else if (ssp <= tmin) then + dx = (ss-tmax)/((ss-ssp)*c) + dy = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + else if (dy <= 0.5) then + avg = avg + tmax*dx + tmin*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*c*(ss-ssp)) + end if + else + dx = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*c*(ss-ssp)) + end if + end if + + else + + if (ssm <= tmin) then + dx = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + else + avg = avg + tmin*(.5-dx) + dx*0.5*(tmin + ss) + endif + else if (ssm >= tmax) then + dx = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + else + avg = avg + tmax*(.5-dx) + dx*0.5*(tmax + ss) + end if + else + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + end if + + if (ssp <= tmin) then + dx = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + else + avg = avg + tmin*(.5-dx) + dx*0.5*(tmin + ss) + end if + else if (ssp >= tmax) then + dx = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + else + avg = avg + tmax*(.5-dx) + dx*0.5*(tmax + ss) + endif + else + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + end if + end if + amean = avg + + return + end function amean + + subroutine approx (tmin, tmax, a, c, ssm, ss, ssp, aa, bb, cc, avg) + + real(r8), intent(in) :: tmin, tmax, a, c, ssm, ss, ssp + real(r8), intent(inout) :: avg + real(r8), intent(out) :: aa, bb, cc + + real(r8) :: dx, dy + + if (ss <= tmin) then + if (ssm <= tmin) then + avg = avg + tmin*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else if (ssm >= tmax) then + dx = (ss-tmin)/((ss-ssm)*a) + dy = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else if (dy <= 0.5) then + avg = avg + tmin*dx + tmax*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + aa = a/16. + bb = bb + 0.25 - a/16. + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*a*(ss-ssm)) + aa = a/16. + bb = bb + 0.25 - a/16. + end if + else + dx = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*a*(ss-ssm)) + aa = a/16. + bb = bb + 0.25 - a/16. + end if + end if + + if (ssp <= tmin) then + avg = avg + tmin*0.5 + cc = c/32. + bb = bb + 0.125 - c/32. + else if (ssp >= tmax) then + dx = (ss-tmin)/((ss-ssp)*c) + dy = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + cc = c/32. + bb = bb + 0.125 - c/32. + elseif (dy <= 0.5) then + avg = avg + tmin*dx + tmax*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + cc = c/16. + bb = bb + 0.25 - c/16. + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*c*(ss-ssp)) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + else + dx = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmin*0.5 + cc = c/32. + bb = bb + 0.125 - c/32. + else + avg = avg + tmin*dx + (0.5-dx)*0.5*(tmin + ss - 0.5*c*(ss-ssp)) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + end if + else if (ss >= tmax) then + if (ssm >= tmax) then + avg = avg + tmax*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else if (ssm <= tmin) then + dx = (ss-tmax)/((ss-ssm)*a) + dy = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else if (dy <= 0.5) then + avg = avg + tmax*dx + tmin*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + aa = a/16. + bb = bb + 0.25 - a/16. + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*a*(ss-ssm)) + aa = a/16. + bb = bb + 0.25 - a/16. + end if + else + dx = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + aa = a/32. + bb = bb + 0.125 - a/32. + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*a*(ss-ssm)) + aa = a/16. + bb = bb + 0.25 - a/16. + end if + end if + + if (ssp >= tmax) then + avg = avg + tmax*0.5 + cc = c/32. + bb = bb + 0.125 - c/32. + else if (ssp <= tmin) then + dx = (ss-tmax)/((ss-ssp)*c) + dy = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + cc = c/32. + bb = bb + 0.125 - c/32. + avg = avg + tmax*0.5 + else if (dy <= 0.5) then + avg = avg + tmax*dx + tmin*(.5-dy) + (dy-dx)*.5*(tmin+tmax) + cc = c/16. + bb = bb + 0.25 - c/16. + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*c*(ss-ssp)) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + else + dx = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + tmax*0.5 + cc = c/32. + bb = bb + 0.125 - c/32. + else + avg = avg + tmax*dx + (0.5-dx)*0.5*(tmax + ss - 0.5*c*(ss-ssp)) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + end if + else + if (ssm <= tmin) then + dx = (ss-tmin)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + aa = a/16. + bb = bb + 0.25 - a/16. + else + avg = avg + tmin*(.5-dx) + dx*0.5*(tmin + ss) + aa = a/16. + bb = bb + 0.25 - a/16. + endif + else if (ssm >= tmax) then + dx = (ss-tmax)/((ss-ssm)*a) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + aa = a/16. + bb = bb + 0.25 - a/16. + else + avg = avg + tmax*(.5-dx) + dx*0.5*(tmax + ss) + aa = a/16. + bb = bb + 0.25 - a/16. + end if + else + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssm)*a) + aa = a/8. + bb = bb + 0.5 - a/8. + end if + + if (ssp <= tmin) then + dx = (ss-tmin)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + cc = c/16. + bb = bb + 0.25 - c/16. + else + avg = avg + tmin*(.5-dx) + dx*0.5*(tmin + ss) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + else if (ssp >= tmax) then + dx = (ss-tmax)/((ss-ssp)*c) + if (dx >= 0.5) then + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + cc = c/16. + bb = bb + 0.25 - c/16. + else + avg = avg + tmax*(.5-dx) + dx*0.5*(tmax + ss) + cc = c/16. + bb = bb + 0.25 - c/16. + end if + else + avg = avg + 0.5*0.5*(2.*ss - 0.5*(ss-ssp)*c) + cc = c/8. + bb = bb + 0.5 - c/8. + end if + end if + + return + end subroutine approx + + subroutine tridag(lonindx,latindx,a,b,c,r,u,n) + integer, intent(in) :: n + integer, intent(in) :: lonindx, latindx + real(r8), intent(in) :: a(n),b(n),c(n),r(n) + double precision, intent(out) :: u(n) + + integer :: j + real(r8) :: bet, gam(nmax) + + if (nmax < n) then + write(6,*) 'Error nmax not declared large enough' + write(6,*) 'in tridag' + stop 999 + endif + + if (b(1) == 0.) then + write(6,*) 'longitude = ', lonindx, ' latitude = ', latindx +!JR make stop if something bad happened +!JR pause 'tridag: rewrite equations' + write (6,*) 'tridag: rewrite equations' + call exit(1) + end if + + bet = b(1) + u(1) = r(1)/bet + + if (n > 1) then + do j=2,n + gam(j) = c(j-1)/bet + bet = b(j)-a(j)*gam(j) + if (bet == 0.) then + write(6,*) 'longitude = ', lonindx, ' latitude = ', latindx +!JR make stop if something bad happened +!JR pause 'tridag failed' + write (6,*)'tridag failed' + call exit(1) + end if + u(j)=(r(j)-a(j)*u(j-1))/bet + end do + do j=n-1,1,-1 + u(j)=u(j)-gam(j+1)*u(j+1) + end do + endif + return + end subroutine tridag + + subroutine cyclic (lonindx, latindx, a, b, c, alpha, beta, r, x, n) + integer, intent(in) :: lonindx, latindx + integer, intent(in) :: n + real(r8), intent(in) :: alpha,beta,a(n),b(n),c(n),r(n) + double precision, intent(out) :: x(n) +!u uses tridag + + integer :: i + real(r8) :: fact,gamma,bb(nmax),u(nmax) + double precision z(nmax) + + if (n <= 2) then + write(6,*) 'n too small in cyclic' + stop 999 + end if + if (n > nmax) then + write(6,*) 'nmax too small in cyclic' + stop 999 + end if + + gamma = -b(1) + bb(1) = b(1) - gamma + bb(n) = b(n) - alpha*beta/gamma + do i=2,n-1 + bb(i)=b(i) + end do + + call tridag (lonindx, latindx, a, bb, c, r, x, n) + + u(1) = gamma + u(n) = alpha + do i=2,n-1 + u(i) = 0. + end do + + call tridag (lonindx, latindx, a, bb, c, u, z, n) + + fact = (x(1) + beta*x(n)/gamma)/(1. + z(1) + beta*z(n)/gamma) + do i=1,n + x(i)=x(i)-fact*z(i) + end do + + return + end subroutine cyclic +end module solver diff --git a/tools/icesst/bcgen/types.f90 b/tools/icesst/bcgen/types.f90 new file mode 100644 index 0000000000..5fed272809 --- /dev/null +++ b/tools/icesst/bcgen/types.f90 @@ -0,0 +1,46 @@ +module types + use prec +! +! 1 for sst, 1 for ice +! +type icesstparms + character(len=8) :: inname ! variable name on input file + integer :: invarid ! netcdf varid on input file +! +! Climatological +! + character(len=32) :: climname ! output variable name + character(len=32) :: climname_pre ! output variable name prior to time diddling + character(len=128) :: climlongname ! output variable long name + character(len=128) :: climlongname_pre ! output variable long name prior to time diddling +! +! AMIP +! + character(len=32) :: amipname ! output variable name + character(len=32) :: amipname_pre ! output variable name prior to time diddling + character(len=128) :: amiplongname ! output variable long name + character(len=128) :: amiplongname_pre ! output variable long name prior to time diddling + + character(len=8) :: units ! "fraction" for sea ice, "deg_C" for sst + + integer :: varidclim ! variable id goes with climname + integer :: varidclim_pre ! variable id goes with climname_pre + integer :: varidamip ! variable id goes with amipname + integer :: varidamip_pre ! variable id goes with amipname_pre + + real(r8) :: conv ! convergence criteria + real(r8) :: tmin ! min limit to which clipping will be applied + real(r8) :: tmax ! max limit to which clipping will be applied + real(r8) :: varmin ! min variance for grid cell to be included in area means + real(r8) :: dt ! smoothing when values go from mininum to maximum + ! maximum jump in monthly means allowed is tmax-tmin-dt (in output units) + +!JR correl: How to decay toward climatology in buffer zones +!JR what if buffer zone is longer than 1 year? Karl will check that the +! following are from AMIP II data on original 1x1 degree grid. +!JR ice items 6-12 are NOT taken from observations +!JR sst items 9-12 are NOT taken from observations + + real(r8) :: correl(12) +end type icesstparms +end module types diff --git a/tools/icesst/bcgen/types.inc b/tools/icesst/bcgen/types.inc new file mode 100644 index 0000000000..6f5ee1aa60 --- /dev/null +++ b/tools/icesst/bcgen/types.inc @@ -0,0 +1,44 @@ +! +! 1 for sst, 1 for ice +! +type icesstparms + character(len=8) :: inname ! variable name on input file + integer :: invarid ! netcdf varid on input file +! +! Climatological +! + character(len=32) :: climname ! output variable name + character(len=32) :: climname_pre ! output variable name prior to time diddling + character(len=128) :: climlongname ! output variable long name + character(len=128) :: climlongname_pre ! output variable long name prior to time diddling +! +! AMIP +! + character(len=32) :: amipname ! output variable name + character(len=32) :: amipname_pre ! output variable name prior to time diddling + character(len=128) :: amiplongname ! output variable long name + character(len=128) :: amiplongname_pre ! output variable long name prior to time diddling + + character(len=8) :: units ! "fraction" for sea ice, "deg_C" for sst + + integer :: varidclim ! variable id goes with climname + integer :: varidclim_pre ! variable id goes with climname_pre + integer :: varidamip ! variable id goes with amipname + integer :: varidamip_pre ! variable id goes with amipname_pre + + real(r8) :: conv ! convergence criteria + real(r8) :: tmin ! min limit to which clipping will be applied + real(r8) :: tmax ! max limit to which clipping will be applied + real(r8) :: varmin ! min variance for grid cell to be included in area means + real(r8) :: dt ! smoothing when values go from mininum to maximum + ! maximum jump in monthly means allowed is tmax-tmin-dt (in output units) + +!JR correl: How to decay toward climatology in buffer zones +!JR what if buffer zone is longer than 1 year? Karl will check that the +! following are from AMIP II data on original 1x1 degree grid. +!JR ice items 6-12 are NOT taken from observations +!JR sst items 9-12 are NOT taken from observations + + real(r8) :: correl(12) +end type icesstparms + diff --git a/tools/icesst/bcgen/wrap_nf.f90 b/tools/icesst/bcgen/wrap_nf.f90 new file mode 100644 index 0000000000..b4dee465e9 --- /dev/null +++ b/tools/icesst/bcgen/wrap_nf.f90 @@ -0,0 +1,386 @@ +!=============================================================================== +! +! Wrapper functions for netcdf. Print message and abort upon failure return. +! WARNING: If enabling 32-bit internal reals, this code makes the assumption that +! selected_real_kind(6) (see prec.f90) will return "4", i.e. the number of bytes +! in a 32-bit real number +! +!=============================================================================== + + subroutine wrap_nf_create (path, omode, ncid) + implicit none + include 'netcdf.inc' + + character*(*), intent(in):: path + integer, intent(in):: omode + integer, intent(out):: ncid + + integer ret ! NetCDF return code + + ret = nf_create (path, omode, ncid) + if (ret /= NF_NOERR) then + write(6,*)'WRAP_NF_CREATE: nf_create failed for file ',path + call handle_error (ret) + end if + end subroutine wrap_nf_create + +!=============================================================================== + + subroutine wrap_nf_open (path, omode, ncid) + implicit none + include 'netcdf.inc' + + character*(*), intent(in):: path + integer, intent(in):: omode + integer, intent(out):: ncid + + integer ret ! NetCDF return code + + ret = nf_open (path, omode, ncid) + if (ret /= NF_NOERR) then + write(6,*)'WRAP_NF_OPEN: nf_open failed for file ',path + call handle_error (ret) + end if + end subroutine wrap_nf_open + + subroutine wrap_nf_put_att_text (nfid, varid, attname, atttext) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + character*(*), intent(in):: attname + character*(*), intent(in):: atttext + + integer ret ! NetCDF return code + integer siz + + siz = len_trim(atttext) + ret = nf_put_att_text (nfid, varid, attname, siz, atttext) + if (ret/=NF_NOERR) then + write(6,*)'wrap_nf_put_att_text varid, attname, text=', varid, attname, ' ', atttext + call handle_error (ret) + end if + end subroutine wrap_nf_put_att_text + +!=============================================================================== + + subroutine wrap_nf_def_dim (nfid, dimname, len, dimid) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: len + integer, intent(out):: dimid + character*(*), intent(in):: dimname + + integer ret ! NetCDF return code + + ret = nf_def_dim (nfid, dimname, len, dimid) + if (ret/=NF_NOERR) then + write(6,*)'wrap_nf_def_dim: nfid, dimname, len=', nfid, dimname, len + call handle_error (ret) + end if + end subroutine wrap_nf_def_dim + +!=============================================================================== + + subroutine wrap_nf_inq_dimid (nfid, name, dimid) + implicit none + include 'netcdf.inc' + + integer, intent(in) :: nfid + integer, intent(out) :: dimid + character(len=*), intent(in) :: name + + integer ret ! NetCDF return code + + ret = nf_inq_dimid (nfid, name, dimid) + if (ret /= NF_NOERR) then + write(6,*)'wrap_nf_inq_dimid: nfid,name=', nfid, name + call handle_error (ret) + end if + end subroutine wrap_nf_inq_dimid + +!=============================================================================== + + subroutine wrap_nf_inq_dimlen (nfid, dimid, dimlen) + implicit none + include 'netcdf.inc' + + integer, intent(in) :: nfid + integer, intent(in) :: dimid + integer, intent(out) :: dimlen + + integer ret ! NetCDF return code + + ret = nf_inq_dimlen (nfid, dimid, dimlen) + if (ret /= NF_NOERR) then + write(6,*)'wrap_nf_inq_dimlen: nfid,dimid=', nfid, dimid + call handle_error (ret) + end if + end subroutine wrap_nf_inq_dimlen + +!=============================================================================== + + subroutine wrap_nf_inq_varid (nfid, name, varid) + implicit none + include 'netcdf.inc' + + integer, intent(in) :: nfid + integer, intent(out) :: varid + character(len=*), intent(in) :: name + + integer ret ! NetCDF return code + + ret = nf_inq_varid (nfid, name, varid) + if (ret /= NF_NOERR) then + write(6,*)'wrap_nf_inq_varid: nfid,name=', nfid, name + call handle_error (ret) + end if + end subroutine wrap_nf_inq_varid + +!=============================================================================== + + subroutine wrap_nf_def_var (nfid, name, xtype, nvdims, vdims, varid) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in)::xtype + integer, intent(in)::nvdims + integer, intent(out)::varid + integer, intent(in):: vdims(nvdims) + character*(*), intent(in):: name + + integer ret ! NetCDF return code + + ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid) + if (ret/=NF_NOERR) then + write(6,*) 'wrap_nf_def_var: nfid, varname, nvdims, vdims=', name, nvdims, vdims + call handle_error (ret) + end if + end subroutine wrap_nf_def_var + +!=============================================================================== + + subroutine wrap_nf_get_vara_int (nfid, varid, start, count, arr) + use prec + implicit none + + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in)::varid + integer, intent(in)::start(*) + integer, intent(in)::count(*) + integer, intent(out):: arr(*) + + integer ret ! NetCDF return code + + ret = nf_get_vara_int (nfid, varid, start, count, arr) + if (ret/=NF_NOERR) then + write(6,*)'WRAP_NF_GET_VARA_INT: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_nf_get_vara_int + +!=============================================================================== + + subroutine wrap_nf_get_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(out):: arr(*) + + integer ret ! NetCDF return code + + ret = nf_get_var_int (nfid, varid, arr) + if (ret/=NF_NOERR) then + write(6,*)'WRAP_NF_GET_VAR_INT: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_nf_get_var_int + +!=============================================================================== + + subroutine wrap_nf_get_vara_double (nfid, varid, start, count, arr) + use prec + implicit none + + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in)::varid + integer, intent(in)::start(*) + integer, intent(in)::count(*) + real(r8), intent(out):: arr(*) + + integer ret ! NetCDF return code + + if (selected_real_kind(6) /= 4) then + write(6,*)'WRAP_NF_GET_VARA_DOUBLE: cannot determine r4 vs. r8' + call abort () + end if + + if (r8 == 4) then + ret = nf_get_vara_real (nfid, varid, start, count, arr) + else + ret = nf_get_vara_double (nfid, varid, start, count, arr) + end if + if (ret/=NF_NOERR) then + write(6,*)'WRAP_NF_GET_VARA_DOUBLE: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_nf_get_vara_double + +!=============================================================================== + + subroutine wrap_nf_get_var_double (nfid, varid, arr) + use prec + implicit none + + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in)::varid + real(r8), intent(out):: arr(*) + + integer ret ! NetCDF return code + + if (selected_real_kind(6) /= 4) then + write(6,*)'WRAP_NF_GET_VAR_DOUBLE: cannot determine r4 vs. r8' + call abort () + end if + + if (r8 == 4) then + ret = nf_get_var_real (nfid, varid, arr) + else + ret = nf_get_var_double (nfid, varid, arr) + end if + if (ret/=NF_NOERR) then + write(6,*)'WRAP_NF_GET_VAR_DOUBLE: error reading varid =', varid + call handle_error (ret) + end if + end subroutine wrap_nf_get_var_double + +!=============================================================================== + + subroutine wrap_nf_close (ncid) + implicit none + include 'netcdf.inc' + + integer, intent(in):: ncid + + integer ret ! NetCDF return code + + ret = nf_close (ncid) + if (ret/=NF_NOERR) then + write(6,*)'WRAP_NF_CLOSE: nf_close failed for id ',ncid + call handle_error (ret) + end if + end subroutine wrap_nf_close + +!=============================================================================== + + subroutine wrap_nf_put_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: arr(*) + + integer ret ! NetCDF return code + + ret = nf_put_var_int (nfid, varid, arr) + if (ret /= NF_NOERR) call handle_error (ret) + end subroutine wrap_nf_put_var_int + +!=============================================================================== + + subroutine wrap_nf_put_vara_int (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(*) + integer, intent(in):: count(*) + integer, intent(in):: arr(*) + + integer ret ! NetCDF return code + + ret = nf_put_vara_int (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) call handle_error (ret) + end subroutine wrap_nf_put_vara_int + +!=============================================================================== + + subroutine wrap_nf_put_var_double (nfid, varid, arr) + use prec + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + real(r8), intent(in):: arr(*) + + integer ret ! NetCDF return code + + if (selected_real_kind(6) /= 4) then + write(6,*)'WRAP_NF_PUT_VARA_DOUBLE: cannot determine r4 vs. r8' + call abort () + end if + + if (r8 == 4) then + ret = nf_put_var_real (nfid, varid, arr) + else + ret = nf_put_var_double (nfid, varid, arr) + end if + if (ret /= NF_NOERR) call handle_error (ret) + end subroutine wrap_nf_put_var_double + +!=============================================================================== + + subroutine wrap_nf_put_vara_double (nfid, varid, start, count, arr) + use prec + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in):: varid + integer, intent(in):: start(*) + integer, intent(in):: count(*) + real(r8), intent(in):: arr(*) + + integer ret ! NetCDF return code + + if (selected_real_kind(6) /= 4) then + write(6,*)'WRAP_NF_PUT_VARA_DOUBLE: cannot determine r4 vs. r8' + call abort () + end if + + if (r8 == 4) then + ret = nf_put_vara_real (nfid, varid, start, count, arr) + else + ret = nf_put_vara_double (nfid, varid, start, count, arr) + end if + if (ret /= NF_NOERR) call handle_error (ret) + end subroutine wrap_nf_put_vara_double + +!=============================================================================== + + subroutine handle_error(ret) + implicit none + include 'netcdf.inc' + + integer, intent(in):: ret + + write(6,*)nf_strerror(ret) + call abort () + end subroutine handle_error + +!=============================================================================== diff --git a/tools/icesst/regrid/CREATE_DIMS_GAU.ncl b/tools/icesst/regrid/CREATE_DIMS_GAU.ncl new file mode 100644 index 0000000000..b101b30264 --- /dev/null +++ b/tools/icesst/regrid/CREATE_DIMS_GAU.ncl @@ -0,0 +1,45 @@ + + +begin + + RESLN = "T85" + + NLAT = 128 + NLON = 256 + + gau_info = doubletofloat(gaus(NLAT/2)) + lat = gau_info(:,0) + gwgt = gau_info(:,1) + del_lon = (360./NLON) + lon = ispan(0,NLON-1,1)*del_lon + + lat@long_name = "latitude" + lat@short_name = "lat" + + lon@long_name = "longitude" + lon@short_name = "lon" + +;------------------------ +; Write to file +;------------------------ + + nfn = "regrid."+RESLN+".nc" + system("rm "+nfn) + cdf = addfile(nfn, "c") + + filedimdef(cdf, (/ "lat","lon" /), \ + (/ NLAT, NLON /), \ + (/ False, False /) ) + + + filevardef(cdf, "lat", "float", (/"lat"/)) + filevarattdef(cdf, "lat", lat) + + filevardef(cdf, "lon", "float", (/"lon"/)) + filevarattdef(cdf, "lon", lon) + + cdf->lat = lat + cdf->lon = lon + + +end diff --git a/tools/icesst/regrid/CREATE_DIMS_REG.ncl b/tools/icesst/regrid/CREATE_DIMS_REG.ncl new file mode 100644 index 0000000000..487acc3cf4 --- /dev/null +++ b/tools/icesst/regrid/CREATE_DIMS_REG.ncl @@ -0,0 +1,49 @@ + + +begin + + RESLN = + + NLAT = + NLON = + + BEGLAT = + BEGLON = + + ENDLAT = + ENDLON = + + + lat = fspan(BEGLAT,ENDLAT,NLAT) + lon = fspan(BEGLON,ENDLON,NLON) + + lat@long_name = "latitude" + lat@short_name = "lat" + + lon@long_name = "longitude" + lon@short_name = "lon" + +;------------------------ +; Write to file +;------------------------ + + nfn = "regrid."+RESLN+".nc" + system("rm "+nfn) + cdf = addfile(nfn, "c") + + filedimdef(cdf, (/ "lat","lon" /), \ + (/ NLAT, NLON /), \ + (/ False, False /) ) + + + filevardef(cdf, "lat", "float", (/"lat"/)) + filevarattdef(cdf, "lat", lat) + + filevardef(cdf, "lon", "float", (/"lon"/)) + filevarattdef(cdf, "lon", lon) + + cdf->lat = lat + cdf->lon = lon + + +end diff --git a/tools/icesst/regrid/Makefile b/tools/icesst/regrid/Makefile new file mode 100644 index 0000000000..66e2752ea7 --- /dev/null +++ b/tools/icesst/regrid/Makefile @@ -0,0 +1,101 @@ +# Set up special characters +null := + +# Check for netcdf locations +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# FFLAGS and LDFLAGS will have at least these values in all situations +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + +# Determine platform +UNAMES := $(shell uname -s) + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),pgf90) + FC = pgf90 + ifeq ($(DEBUG),TRUE) + FFLAGS += -g -Mbounds + else + FFLAGS += -O + endif + else + FC = lf95 + ifeq ($(DEBUG),TRUE) + FFLAGS += -g --chk esu + else + FFLAGS += -O + endif + endif +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) + FC = f90 + FFLAGS += -64 + LDFLAGS += -64 + ifeq ($(DEBUG),TRUE) + FFLAGS += -C -g + LDFLAGS += -g + else + FFLAGS += -O2 + endif +endif + +#------------------------------------------------------------------------ +# IBM +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) + FC = xlf90 + FFLAGS += -qsuffix=f=f90 + ifeq ($(DEBUG),TRUE) + FFLAGS += -C -g + LDFLAGS += -g + else + FFLAGS += -O2 + endif +endif + +OBJS = regrid.o binf2c.o wrap_nf.o precision.o map_i.o cell_area.o ao_i.o area_ave.o \ + max_ovr.o ao.o interp_driver.o lininterp.o err_exit.o + +regrid: $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) regrid *.o *.mod *.stb *.MOD + +.SUFFIXES: +.SUFFIXES: .f90 .o + +.f90.o: + $(FC) $(FFLAGS) $*.f90 + +regrid.o: precision.o +hurrellsst.o: precision.o +binf2c.o: precision.o +wrap_nf.o: +precision.o: +map_i.o: precision.o +cell_area.o: precision.o +ao_i.o: precision.o +area_ave.o: precision.o +max_ovr.o: precision.o +ao.o: precision.o +interp_driver.o: precision.o +lininterp.o: precision.o +err_exit.o: diff --git a/tools/icesst/regrid/REGRID.pl b/tools/icesst/regrid/REGRID.pl new file mode 100755 index 0000000000..c5181f2afb --- /dev/null +++ b/tools/icesst/regrid/REGRID.pl @@ -0,0 +1,171 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------- +# Usage: perl REGRID.pl RESLN +# where RESLN denotes the resolution desired. +# Supported resolutions are: +# T5, T21, T31, T42, T63, T85, T170, +# 10by15, 4by5, 2by2.5, 1by1.25 +#----------------------------------------------------------------------- + +@ARGV; + +$resln = $ARGV[0]; + +#----------------------------------------------------- +# Assign necessary dimensions given the resolution +#----------------------------------------------------- + +if( $resln eq "T42" ) { + $nlat = 64; + $nlon = 128; + +} elsif ( $resln eq "T63" ) { + $nlat = 96; + $nlon = 192; + +} elsif ( $resln eq "T85" ) { + $nlat = 128; + $nlon = 256; + +} elsif ( $resln eq "T170" ) { + $nlat = 256; + $nlon = 512; + +} elsif ( $resln eq "T31" ) { + $nlat = 48; + $nlon = 96; + +} elsif ( $resln eq "T21" ) { + $nlat = 32; + $nlon = 64; + +} elsif ( $resln eq "T5" ) { + $nlat = 8; + $nlon = 16; + +} elsif ( $resln eq "10by15" ) { + $nlat = 19; + $nlon = 24; + + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "345.0"; + +} elsif ( $resln eq "4by5" ) { + $nlat = 46; + $nlon = 72; + + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "355.0"; + +} elsif ( $resln eq "2by2.5" ) { + $nlat = 91; + $nlon = 144; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "357.5"; + +} elsif ( $resln eq "1.9by2.5" ) { + $nlat = 96; + $nlon = 144; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "357.5"; + +} elsif ( $resln eq "1by1.25" ) { + $nlat = 181; + $nlon = 288; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "358.75"; + +} else { + + die "FATAL: Invalid or unsupported resolution specified. Aborting." + +} + + +#--------------------------------------------- +# determine grid type (gaussian or regular) +#--------------------------------------------- + +$leadchar = substr($resln,0,1); + + if( $leadchar eq "T" ) { + + $indic = "GAUS"; + $infile = "CREATE_DIMS_GAU.ncl"; + + }else{ + + $indic = "REG"; + $infile = "CREATE_DIMS_REG.ncl"; + + } + +#------------------------------------------------------------------ +# Set up NCL script to create netCDF file for requested resolution +#------------------------------------------------------------------ + +$keyword1 = "RESLN ="; +$keyword2 = "NLAT ="; +$keyword3 = "NLON ="; +$keyword4 = "BEGLAT ="; +$keyword5 = "BEGLON ="; +$keyword6 = "ENDLAT ="; +$keyword7 = "ENDLON ="; + +$resexpr = qq!"$resln"!; + +$outfile = "CREATE_DIMS_$resln.ncl"; + + open(INF, "$infile"); + open(OUTF,">$outfile"); + + while(){ + + if(/$keyword1/){ + print OUTF "RESLN = $resexpr\n"; + } elsif (/$keyword2/) { + print OUTF "NLAT = $nlat\n"; + } elsif (/$keyword3/) { + print OUTF "NLON = $nlon\n"; + } elsif (/$keyword4/) { + print OUTF "BEGLAT = $blat\n"; + } elsif (/$keyword5/) { + print OUTF "BEGLON = $blon\n"; + } elsif (/$keyword6/) { + print OUTF "ENDLAT = $elat\n"; + } elsif (/$keyword7/) { + print OUTF "ENDLON = $elon\n"; + } else { + print OUTF "$_"; + } + + + } + + close(INF); + close(OUTF); + + +#------------------------------------------ +# Run NCL script +#------------------------------------------ + + print("CREATING DIMENSION FILE FOR $resln GRID\n"); + system( "ncl < CREATE_DIMS_$resln.ncl" ); + + +exit; + + + + diff --git a/tools/icesst/regrid/ao.f90 b/tools/icesst/regrid/ao.f90 new file mode 100644 index 0000000000..d9ded3a0fe --- /dev/null +++ b/tools/icesst/regrid/ao.f90 @@ -0,0 +1,141 @@ +subroutine ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + + use precision + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: ao.F +! purpose: weights and indices for area of overlap between +! input and output grids +! date last revised: March 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlon_i !maximum number of input longitude points + integer nlat_i !number of input latitude points + integer numlon_i(nlat_i) !number of input lon pts for each latitude + integer nlon_o !maximum number of output longitude points + integer nlat_o !number of output latitude points + integer numlon_o(nlat_o) !number of output lon pts for each latitude + integer mx_ovr !maximum number of overlapping input cells + + real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell longitude, w. edge (deg) + real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell longitude, w. edge (deg) + real(r8) lat_i(nlat_i+1) !input grid cell latitude, s. edge (deg) + real(r8) lat_o(nlat_o+1) !output grid cell latitude, s. edge (deg) + real(r8) area_o(nlon_o,nlat_o) !area of output grid cell + real(r8) re !radius of earth +! ----------------------------------------------------------------- + +! ------------------- input/output variables ---------------------- + integer n_ovr(nlon_o,nlat_o ) !number of overlapping input cells + integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell + + real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer io,ii !output and input grids longitude loop index + integer jo,ji !output and input grids latitude loop index + + real(r8) lonw,lone,dx !west, east longitudes of overlap and difference + real(r8) lats,latn,dy !south, north latitudes of overlap and difference + real(r8) deg2rad !pi/180 + real(r8) a_ovr !area of overlap + real(r8) zero,one + parameter (zero=0.0) ! Needed as arg to "max" + parameter (one=1.) ! Needed as arg to "atan" +! ----------------------------------------------------------------- + + deg2rad = (4.*atan(one)) / 180. + +! ----------------------------------------------------------------- +! for each output grid cell: find overlapping input grid cell and area of +! input grid cell that overlaps with output grid cell. cells overlap if: +! +! southern edge of input grid < northern edge of output grid AND +! northern edge of input grid > southern edge of output grid +! +! western edge of input grid < eastern edge of output grid AND +! eastern edge of input grid > western edge of output grid +! +! lon_o(io,jo) lon_o(io+1,jo) +! +! | | +! --------------------- lat_o(jo+1) +! | | +! | | +! xxxxxxxxxxxxxxx lat_i(ji+1) | +! x | x | +! x input | x output | +! x cell | x cell | +! x ii,ji | x io,jo | +! x | x | +! x ----x---------------- lat_o(jo ) +! x x +! xxxxxxxxxxxxxxx lat_i(ji ) +! x x +! lon_i(ii,ji) lon_i(ii+1,ji) +! ----------------------------------------------------------------- + +! note that code does not vectorize but is only called during +! initialization. + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + +! loop through all input grid cells to find overlap with output grid. + + do ji = 1, nlat_i + if ( lat_i(ji ).lt.lat_o(jo+1) .and. & + lat_i(ji+1).gt.lat_o(jo ) ) then !lat ok + + do ii = 1, numlon_i(ji) + if ( lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & + lon_i(ii+1,ji).gt.lon_o(io ,jo) ) then !lon okay + +! increment number of overlapping cells. make sure 0 < n_ovr < mx_ovr + + n_ovr(io,jo) = n_ovr(io,jo) + 1 +! if (n_ovr(io,jo) .gt. mx_ovr) then +! write (6,*) 'AO error: n_ovr= ',n_ovr(io,jo), & +! ' exceeded mx_ovr = ',mx_ovr, & +! ' for output lon,lat = ',io,jo +! call endrun +! end if + +! determine area of overlap + + lone = min(lon_o(io+1,jo),lon_i(ii+1,ji))*deg2rad !e edge + lonw = max(lon_o(io ,jo),lon_i(ii ,ji))*deg2rad !w edge + dx = max(zero,(lone-lonw)) + latn = min(lat_o(jo+1),lat_i(ji+1))*deg2rad !n edge + lats = max(lat_o(jo ),lat_i(ji ))*deg2rad !s edge + dy = max(zero,(sin(latn)-sin(lats))) + a_ovr = dx*dy*re*re + +! determine indices and weights. re cancels in the division by area + + i_ovr(io,jo,n_ovr(io,jo)) = ii + j_ovr(io,jo,n_ovr(io,jo)) = ji + w_ovr(io,jo,n_ovr(io,jo)) = a_ovr/area_o(io,jo) + + end if + end do + + end if + end do + + end do + end do + + return +end subroutine ao diff --git a/tools/icesst/regrid/ao_i.f90 b/tools/icesst/regrid/ao_i.f90 new file mode 100644 index 0000000000..edad02d20b --- /dev/null +++ b/tools/icesst/regrid/ao_i.f90 @@ -0,0 +1,178 @@ +subroutine ao_i(nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + mx_ovr , i_ovr , j_ovr , w_ovr , re , & + area_o , relerr ) + + use precision + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: ao_i.F +! purpose: area averaging initialization: indices and weights +! date last revised: November 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------------ notes ---------------------------------- +! get indices and weights for area-averaging between input and output grids + +! o input grid does not have to be finer resolution than output grid + +! o both grids must be oriented south to north, i.e., cell(lat+1) +! must be north of cell(lat). the southern edge of the first row +! must be -90 (south pole) and the northern edge of the last row +! must be +90 (north pole) + +! o both grids must be oriented eastwards, i.e., cell(lon+1) must be +! east of cell(lon). but the two grids do not have to start at the +! same longitude, i.e., one grid can start at dateline and go east; +! the other grid can start at greenwich and go east. longitudes for +! the western edge of the cells must increase continuously and span +! 360 degrees. examples +! dateline : -180 to 180 (- longitudes west of greenwich) +! greenwich : 0 to 360 +! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) + +! for each output grid cell +! o number of input grid cells that overlap with output grid cell (n_ovr) +! o longitude index (1 <= i_ovr <= nlon_i) of the overlapping input grid cell +! o latitude index (1 <= j_ovr <= nlat_i) of the overlapping input grid cell + +! for field values fld_i on an input grid with dimensions nlon_i and nlat_i +! field values fld_o on an output grid with dimensions nlon_o and nlat_o are +! fld_o(io,jo) = +! fld_i(i_ovr(io,jo, 1),j_ovr(io,jo, 1)) * w_ovr(io,jo, 1) + +! ... + ... + +! fld_i(i_ovr(io,jo,mx_ovr),j_ovr(io,jo,mx_ovr)) * w_ovr(io,jo,mx_ovr) + +! error check: overlap weights of input cells sum to 1 for each output cell +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlon_i !input grid max number of input longitude points + integer nlat_i !input grid number of input latitude points + integer numlon_i(nlat_i) !input grid number of lon points for each lat + integer nlon_o !output grid max number of output lon points + integer nlat_o !output grid number of output latitude points + integer numlon_o(nlat_o) !output grid number of lon points for each lat + integer mx_ovr !max num of input cells that overlap output cell + + real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell lon, western edge (degrees) + real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell lon, western edge (degrees) + real(r8) lat_i(nlat_i+1) !input grid cell lat, southern edge (degrees) + real(r8) lat_o(nlat_o+1) !output grid cell lat, southern edge (degrees) + real(r8) area_o(nlon_o,nlat_o) !cell area on output grid + real(r8) re !radius of earth + real(r8) relerr !max error: sum overlap weights ne 1 +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell + real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer io,ii !input and output grids longitude loop index + integer jo,ji !input and output grids latitude loop index + integer n !overlapping cell index + + real(r8) offset !used to shift x-grid 360 degrees + real(r8) f_ovr !sum of overlap weights for cells on output grid +! +! Dynamic +! + integer n_ovr(nlon_o,nlat_o) !number of overlapping input cells + +! ----------------------------------------------------------------- +! initialize overlap weights on output grid to zero for maximum +! number of overlapping points. set lat and lon indices of overlapping +! input cells to dummy values. set number of overlapping cells to zero +! ----------------------------------------------------------------- + + do n = 1, mx_ovr + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + i_ovr(io,jo,n) = 1 + j_ovr(io,jo,n) = 1 + w_ovr(io,jo,n) = 0. + end do + end do + end do + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + n_ovr(io,jo) = 0 + end do + end do + +! ----------------------------------------------------------------- +! first pass to find cells that overlap, area of overlap, and weights +! ----------------------------------------------------------------- + + call ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + +! ----------------------------------------------------------------- +! second pass to find cells that overlap, area of overlap, and weights +! ----------------------------------------------------------------- + +! shift x-grid to locate periodic grid intersections +! the following assumes that all lon_i(1,:) have the same value +! independent of latitude and that the same holds for lon_o(1,:) + + if (lon_i(1,1) .lt. lon_o(1,1)) then + offset = 360.0 + else + offset = -360.0 + end if + + do ji = 1,nlat_i + do ii = 1, numlon_i(ji) + 1 + lon_i(ii,ji) = lon_i(ii,ji) + offset + end do + end do + +! find overlap + + call ao (nlon_i , nlat_i , numlon_i , lon_i , lat_i , & + nlon_o , nlat_o , numlon_o , lon_o , lat_o , & + area_o , re , mx_ovr , n_ovr , i_ovr , & + j_ovr , w_ovr ) + +! restore x-grid (un-shift x-grid) + + do ji = 1,nlat_i + do ii = 1, numlon_i(ji) + 1 + lon_i(ii,ji) = lon_i(ii,ji) - offset + end do + end do + +! ----------------------------------------------------------------- +! error check: overlap weights for input grid cells must sum to 1 +! ----------------------------------------------------------------- + + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + f_ovr = 0. + + do n = 1, mx_ovr + f_ovr = f_ovr + w_ovr(io,jo,n) + end do + + if (abs(f_ovr-1.) .gt. relerr) then + write (6,*) 'AO_I error: area not conserved for',' lon,lat = ', io,jo + write (6,'(a30,e20.10)') ' sum of overlap weights = ', f_ovr + stop 999 + end if + + end do + end do + + return +end subroutine ao_i diff --git a/tools/icesst/regrid/area_ave.f90 b/tools/icesst/regrid/area_ave.f90 new file mode 100644 index 0000000000..e6bcd40388 --- /dev/null +++ b/tools/icesst/regrid/area_ave.f90 @@ -0,0 +1,59 @@ +subroutine area_ave (nlat_i , nlon_i , numlon_i, fld_i , & + nlat_o , nlon_o , numlon_o, fld_o , & + i_ovr , j_ovr , w_ovr , nmax ) + + use precision + + implicit none +! ------------------------ code history --------------------------- +! source file: area_ave.F +! purpose: area averaging of field from input to output grids +! date last revised: November 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlat_i ! number of latitude points for input grid + integer nlat_o ! number of latitude points for output grid + integer nlon_i ! maximum number of longitude points for input grid + integer nlon_o ! maximum number of longitude points for output grid + integer nmax ! maximum number of overlapping cells + integer numlon_i(nlat_i) ! input grid number of lon points at each lat + integer numlon_o(nlat_o) ! input grid number of lon points at each lat + integer i_ovr(nlon_o,nlat_o,nmax) ! lon index, overlapping input cell + integer j_ovr(nlon_o,nlat_o,nmax) ! lat index, overlapping input cell + + real(r8) fld_i(nlon_i,nlat_i) !field for input grid + real(r8) w_ovr(nlon_o,nlat_o,nmax) ! overlap weights for input cells +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + real(r8) fld_o(nlon_o,nlat_o) !field for output grid +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer jo,ji !latitude index for output,input grids + integer io,ii !longitude index for output,input grids + integer n !overlapping cell index +! ----------------------------------------------------------------- + + do jo = 1, nlat_o + do io =1, numlon_o(jo) + fld_o(io,jo) = 0. + end do + end do + + do n = 1, nmax + do jo = 1, nlat_o + do io =1, numlon_o(jo) + ii = i_ovr(io,jo,n) + ji = j_ovr(io,jo,n) + fld_o(io,jo) = fld_o(io,jo) + w_ovr(io,jo,n)*fld_i(ii,ji) + end do + end do + end do + + return +end subroutine area_ave diff --git a/tools/icesst/regrid/binf2c.f90 b/tools/icesst/regrid/binf2c.f90 new file mode 100644 index 0000000000..d1fd67eca4 --- /dev/null +++ b/tools/icesst/regrid/binf2c.f90 @@ -0,0 +1,92 @@ +subroutine binf2c (plonin, nlatin, lonin, latin, arrin, & + plonout, nlatout, nlon, rlon, latout, arrout, & + verbose) +!----------------------------------------------------------------------- +! +! Purpose: bin from a finer grid to a coarser one, taking account of missing or +! filled data points. Configured to work correctly on a reduced grid. Algorithm: +! For each point on the fine grid with valid data, 1st find the nearest latitude +! on the coarse mesh. Then for that latitude find the nearest coarse longitude and +! put the fine grid point into that coarse "bin". +! +!----------------------------------------------------------------------- + use precision + + implicit none +! +! Arguments +! + integer, intent(in) :: plonin ! longitude dimension of input + integer, intent(in) :: nlatin ! latitude dimension of input + real(r8), intent(in) :: lonin(plonin) ! input longitudes + real(r8), intent(in) :: latin(nlatin) ! input latitudes + real(r8), intent(in) :: arrin(plonin,nlatin) ! input array + + integer, intent(in) :: plonout ! longitude dimension of output + integer, intent(in) :: nlatout ! latitude dimension of output + integer, intent(in) :: nlon(nlatout) ! lons (deg.) at each lat (maybe on reduced grid) + real(r8), intent(in) :: rlon(plonout,nlatout) ! longitudes (deg.) at each latitude (maybe on reduced grid) + real(r8), intent(in) :: latout(nlatout) ! output latitudes + real(r8), intent(out) :: arrout(plonout,nlatout) ! output array + + logical, intent(in) :: verbose ! added printout +! +! Local workspace +! + integer :: i,j + integer :: ii,jj + integer :: iiarr(1), jjarr(1) + integer :: num + integer :: bincount(plonout,nlatout) + + real(r16) :: arrloc(plonout,nlatout) ! output array in real*16 + real(r8) :: deltay(nlatout) + real(r8) :: deltax(plonout) + + if (nlatin < nlatout) then + write(6,*)'Warning: input grid coarser than output grid' + end if + + bincount(:,:) = 0 + arrloc(:,:) = 0. + arrout(:,:) = 0. +! +! Find closest output grid lon index (ii) and lat index (jj) to input grid lon (i) and lat (j) +! Then sum arr into appropriate bin +! + do j=1,nlatin + deltay(:) = abs (latin(j) - latout(:)) + jjarr = minloc (deltay(:)) ! lat index of closest output grid point + jj = jjarr(1) + do i=1,plonin + num = nlon(jj) + deltax(:num) = abs (lonin(i) - rlon(:num,jj)) + iiarr = minloc (deltax(:num)) ! lon index of closest output grid point + ii = iiarr(1) + arrloc(ii,jj) = arrloc(ii,jj) + arrin(i,j) + bincount(ii,jj) = bincount(ii,jj) + 1 + end do + end do +! +! Normalize by bin count +! + do jj=1,nlatout + do ii=1,nlon(jj) + if (bincount(ii,jj) > 0) then + arrout(ii,jj) = arrloc(ii,jj)/bincount(ii,jj) + else + write(6,*)'binf2c: Bincount(i=',ii,',j=',jj,') = 0: stopping' + stop 999 + end if + end do + end do + + if (verbose) then + write(6,*)'bincount:' + do jj=1,nlatout + write(6,'(1000i2)') (bincount(ii,jj),ii=1,nlon(jj)) + end do + end if + + return +end subroutine binf2c diff --git a/tools/icesst/regrid/cell_area.f90 b/tools/icesst/regrid/cell_area.f90 new file mode 100644 index 0000000000..28dbe75b1c --- /dev/null +++ b/tools/icesst/regrid/cell_area.f90 @@ -0,0 +1,51 @@ +subroutine cell_area (nlat, nlon, numlon, lon_w, lat_s, re, area) + + use precision + + implicit none +! ------------------------ code history --------------------------- +! source file: cell_area.F +! purpose: area of grid cells +! date last revised: March 1996 +! author: Gordon Bonan +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer nlat !number of latitude points + integer nlon !maximum number of longitude points + integer numlon(nlat) !number of longitude points for each latitude + real(r8) lon_w(nlon+1,nlat) !grid cell longitude, western edge (degrees) + real(r8) lat_s(nlat+1) !grid cell latitude, southern edge (degrees) +! ----------------------------------------------------------------- + +! ------------------- output variables ---------------------------- + real(r8) re !radius of earth (km) + real(r8) area(nlon,nlat) !cell area (km**2) +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer i !longitude index + integer j !latitude index + + real(r8) dx !cell width + real(r8) dy !cell length + real(r8) deg2rad !pi/180 + real(r8) one + parameter (one=1.) ! Argument to atan +! ----------------------------------------------------------------- + + deg2rad = (4.*atan(one)) / 180. + re = 6371.227709 + + do j = 1, nlat + do i = 1, numlon(j) + dx = (lon_w(i+1,j)-lon_w(i,j)) * deg2rad + dy = sin(lat_s(j+1)*deg2rad) - sin(lat_s(j)*deg2rad) + area(i,j) = dx*dy*re*re + end do + end do + + return +end subroutine cell_area diff --git a/tools/icesst/regrid/err_exit.f90 b/tools/icesst/regrid/err_exit.f90 new file mode 100644 index 0000000000..40d157a0ee --- /dev/null +++ b/tools/icesst/regrid/err_exit.f90 @@ -0,0 +1,8 @@ +subroutine err_exit (string) + implicit none + + character*(*) string + + write(6,*) string + stop 999 +end subroutine err_exit diff --git a/tools/icesst/regrid/interp_driver.f90 b/tools/icesst/regrid/interp_driver.f90 new file mode 100644 index 0000000000..0db5d0d61d --- /dev/null +++ b/tools/icesst/regrid/interp_driver.f90 @@ -0,0 +1,131 @@ +subroutine interp_driver (nxi, nyi, nzi, numxi, xposi, yposi, zposi, xiziyi, & + nxo, nyo, nzo, numxo, xposo, yposo, zposo, xozoyo) +!----------------------------------------------------------------------- +! +! Driver code for linear interpolation +! +!----------------------------------------------------------------------- + use precision, only: r8 + + implicit none +! +! Arguments +! + integer, intent(in) :: nxi, nyi, nzi ! dimensions of input grid + integer, intent(in) :: numxi(nyi) ! number of x points per y + real(r8), intent(in) :: xposi(nxi,nyi) ! x-positions of input grid + real(r8), intent(in) :: yposi(nyi) ! y-positions of input grid + real(r8), intent(in) :: zposi(nzi) ! z-positions of input grid + real(r8), intent(in) :: xiziyi(nxi,nzi,nyi) ! field to be interpolated + + integer, intent(in) :: nxo, nyo, nzo ! dimensions of output grid + integer, intent(in) :: numxo(nyo) ! number of x points per y + real(r8), intent(in) :: xposo(nxo,nyo) ! x-positions of output grid + real(r8), intent(in) :: yposo(nyo) ! y-positions of output grid + real(r8), intent(in) :: zposo(nzo) ! z-positions of output grid + real(r8), intent(out) :: xozoyo(nxo,nzo,nyo) ! output field +! +! Local workspace +! + integer :: i,j,k ! spatial indices + integer :: numxis, numxin ! number of xpoints input to the south, north + integer :: numxoj ! numxo(j) + integer :: jj, jjs, jjn ! index in y-direction + integer :: count ! number of values found + + real(r8) :: wgts, wgtn ! interpolation weights +! +! Intermediate interpolation arrays +! + real(r8) :: xizoyi(nxi,nzo,nyi) + real(r8) :: xtemp(nxo,2) +! +! Interpolate in z +! + if (nzi == 1 .and. nzo == 1) then + xizoyi(:,1,:) = xiziyi(:,1,:) + else + do j=1,nyi + do i=1,nxi + call lininterp (xiziyi(i,1,j), nzi, nxi, zposi, & + xizoyi(i,1,j), nzo, nxi, zposo, .false.) + end do + end do + end if +! +! Check monotonicity of y-coordinate variable before interpolating. z and +! x monotonicity is checked inside lininterp. +! + count = 0 + do j=1,nyi-1 + if (yposi(j) > yposi(j+1)) count = count + 1 + end do + do j=1,nyo-1 + if (yposo(j) > yposo(j+1)) count = count + 1 + end do + + if (count > 0) then + call err_exit ('interp_driver: non-monotonic coordinate array(s) found') + end if +! +! Interpolate in x and y +! + do j=1,nyo + numxoj = numxo(j) + + jjs = -1 + jjn = -1 + + if (yposi(1) >= yposo(j)) then ! extrapolate south + jjs = 1 + jjn = 1 + else if (yposi(nyi) < yposo(j)) then ! extrapolate north + jjs = nyi + jjn = nyi + else ! interpolate + do jj=1,nyi-1 + if (yposi(jj ) < yposo(j) .and. & + yposi(jj+1) >= yposo(j)) then + jjs = jj + jjn = jj+1 + exit + end if + end do + end if + + if (jjs < 0 .or. jjn < 0) then + call err_exit ('interp_driver: bad index calculation') + end if + + numxis = numxi(jjs) + numxin = numxi(jjn) + + if (jjs /= jjn) then + wgts = (yposi(jjn) - yposo(j)) / (yposi(jjn) - yposi(jjs)) + wgtn = (yposo(j) - yposi(jjs)) / (yposi(jjn) - yposi(jjs)) + if (abs ((wgts+wgtn)-1.) > 1.e-6) then + call err_exit ('interp_driver: bad weight calculation') + end if + end if + + do k=1,nzo +! +! X interp +! + call lininterp (xizoyi(1,k,jjs), numxis, 1, xposi(1,jjs), & + xtemp(1,1), numxoj, 1, xposo(1,j), .true.) + if (jjs == jjn) then + xozoyo(:numxoj,k,j) = xtemp(:numxoj,1) + else + call lininterp (xizoyi(1,k,jjn), numxin, 1, xposi(1,jjn), & + xtemp(1,2), numxoj, 1, xposo(1,j), .true.) +! +! Y interp +! + xozoyo(:numxoj,k,j) = xtemp(:numxoj,1)*wgts + xtemp(:numxoj,2)*wgtn + end if + end do ! k=1,nzo + end do ! j=1,nyo + + return +end subroutine interp_driver diff --git a/tools/icesst/regrid/lininterp.f90 b/tools/icesst/regrid/lininterp.f90 new file mode 100644 index 0000000000..ec9a66a71b --- /dev/null +++ b/tools/icesst/regrid/lininterp.f90 @@ -0,0 +1,174 @@ +subroutine lininterp (arrin, nxin, incin, xin, & + arrout, nxout, incout, xout, periodic) +!----------------------------------------------------------------------- +! +! Do a linear interpolation from input mesh defined by xin to output +! mesh defined by xout. Where extrapolation is necessary, values will +! be copied from the extreme edge of the input grid. +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! +!----------------------------------------------------------------------- + use precision + + implicit none +!----------------------------------------------------------------------- +! +! Arguments +! + integer nxin, incin ! input dimension, increment + integer nxout, incout ! output dimension, increment + + real(r8) xin(nxin), xout(nxout) ! input and output meshes + real(r8) arrin(incin,nxin) ! input array + real(r8) arrout(incout,nxout) ! output array + + logical periodic ! flag indicates whether boundaries are periodic +! +! Local workspace +! + integer i, ii ! input grid indices + integer im, ip, iiprev ! input grid indices + integer icount ! number of values + + real(r8) extrap ! percent grid non-overlap + real(r8) dxinwrap ! delta-x on input grid for 2-pi + real(r8) avgdxin ! avg input delta-x + real(r8) ratio ! compare dxinwrap to avgdxin +! +! Dynamic +! + integer iim(nxout) ! interp. indices minus + integer iip(nxout) ! interp. indices plus + + real(r8) wgtm(nxout) ! interp. weight minus + real(r8) wgtp(nxout) ! interp. weight plus +! +! Just copy the data and return if input dimensions are 1 +! + if (nxin.eq.1 .and. nxout.eq.1) then + arrout(1,1) = arrin(1,1) + else if (nxin.eq.1) then + write(6,*)'LININTERP: Must have at least 2 input points' + call abort + end if + icount = 0 + do i=1,nxin-1 + if (xin(i).gt.xin(i+1)) icount = icount + 1 + end do + do i=1,nxout-1 + if (xout(i).gt.xout(i+1)) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Non-monotonic coordinate array(s) found' + call abort + end if +! +! Initialize index arrays for later checking +! + do i=1,nxout + iim(i) = 0 + iip(i) = 0 + end do + if (periodic) then +! +! Periodic case: for values which extend beyond boundaries, assume +! periodicity and interpolate between endpoints. First check for sane +! periodicity assumption. +! + if (xin(nxin).gt.360.) then + write(6,*)'LININTERP: Periodic input x-grid must not be greater than 360' + call abort + end if + if (xout(nxout).gt.360.) then + write(6,*)'LININTERP: Output x-grid must not be greater than 360' + call abort + end if + dxinwrap = xin(1) + 360. - xin(nxin) + avgdxin = (xin(nxin)-xin(1))/(nxin-1.) + ratio = dxinwrap/avgdxin + if (ratio.lt.0.9 .or. ratio.gt.1.1) then + write(6,*)'LININTERP: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin + call abort + end if + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = nxin + iip(im) = 1 + wgtm(im) = (xin(1) - xout(im)) /dxinwrap + wgtp(im) = (xout(im)+360. - xin(nxin))/dxinwrap + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = 1 + wgtm(ip) = (xin(1)+360. - xout(ip)) /dxinwrap + wgtp(ip) = (xout(ip) - xin(nxin))/dxinwrap + end do + else +! +! Non-periodic case: for values which extend beyond boundaries, set weights +! such that values will just be copied. +! + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = 1 + iip(im) = 1 + wgtm(im) = 1. + wgtp(im) = 0. + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = nxin + wgtm(ip) = 1. + wgtp(ip) = 0. + end do + end if +! +! Loop though output indices finding input indices and weights +! + iiprev = 1 + do i=im,ip + do ii=iiprev,nxin-1 + if (xout(i).gt.xin(ii) .and. xout(i).le.xin(ii+1)) then + iim(i) = ii + iip(i) = ii + 1 + wgtm(i) = (xin(ii+1)-xout(i))/(xin(ii+1)-xin(ii)) + wgtp(i) = (xout(i)-xin(ii))/(xin(ii+1)-xin(ii)) + goto 30 + end if + end do + write(6,*)'LININTERP: Failed to find interp values' +30 iiprev = ii + end do +! +! Check grid overlap +! + extrap = 100.*((im - 1.) + (nxout - ip))/nxout + if (extrap.gt.30.) then + write(6,*)'********LININTERP WARNING:',extrap,' % of output', & + ' grid will have to be extrapolated********' + end if +! +! Check that interp/extrap points have been found for all outputs +! + icount = 0 + do i=1,nxout + if (iim(i).eq.0 .or. iip(i).eq.0) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Point found without interp indices' + call abort + end if +! +! Do the interpolation +! + do i=1,nxout + arrout(1,i) = arrin(1,iim(i))*wgtm(i) + arrin(1,iip(i))*wgtp(i) + end do + return +end subroutine lininterp + diff --git a/tools/icesst/regrid/map_i.f90 b/tools/icesst/regrid/map_i.f90 new file mode 100644 index 0000000000..9c527af911 --- /dev/null +++ b/tools/icesst/regrid/map_i.f90 @@ -0,0 +1,136 @@ +subroutine map_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i, & + nlon_o , nlat_o , numlon_o, lon_o , lat_o, & + mxovr_i2o, iovr_i2o, jovr_i2o, wovr_i2o) + + use precision + implicit none + +! ------------------------ code history --------------------------- +! source file: map_i.F +! purpose: driver for area averaging initialization +! date last revised: July 2000 +! author: Mariana Vertenstein +! ----------------------------------------------------------------- + +! ------------------------ notes ---------------------------------- +! o get indices and weights for area-averaging: +! +! from input surface grid to output model grid +! +! o input surface and output model grids can be any resolution BUT: +! +! both grids must be oriented south to north, i.e., cell(lat+1) +! must be north of cell(lat). the southern edge of the first row +! must be -90 (south pole) and the northern edge of the last row +! must be +90 (north pole) +! +! both grids must be oriented eastwards, i.e., cell(lon+1) must be +! east of cell(lon). but the two grids do not have to start at the +! same longitude, i.e., one grid can start at dateline and go east; +! the other grid can start at greenwich and go east. longitudes for +! the western edge of the cells must increase continuously and span +! 360 degrees. examples +! dateline : -180 to 180 (- longitudes west of greenwich) +! greenwich : 0 to 360 +! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) +! +! o field values fld_i on an input grid with dimensions nlon_i and nlat_i => +! field values fld_o on an output grid with dimensions nlon_o and nlat_o as +! +! fld_o(io,jo) = +! fld_i(i_ovr(io,jo, 1 ),j_ovr(io,jo, 1 )) * w_ovr(io,jo, 1 ) + +! fld_i(i_ovr(io,jo,mxovr_i),j_ovr(io,jo,mxovr_i)) * w_ovr(io,jo,mxovr_i) +! +! o error checks: +! overlap weights of input cells sum to 1 for each output cell +! global sums of dummy fields are conserved for input => model area-averaging +! ----------------------------------------------------------------- + +! ------------------- arguments ----------------------------------- + integer , intent(in) :: nlon_i !input grid max number of longitude points + integer , intent(in) :: nlat_i !input grid number of latitude points + integer , intent(in) :: numlon_i(nlat_i) !input grid number of longitude points at each lat + real(r8), intent(inout) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, west edge (degrees) + real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, south edge (degrees) + integer , intent(in) :: nlon_o !model grid max number of longitude points + integer , intent(in) :: nlat_o !model grid number of latitude points + integer , intent(in) :: numlon_o(nlat_o) !model grid number of longitude points at each lat + real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !model grid cell longitude, west edge (degrees) + real(r8), intent(in) :: lat_o(nlat_o+1) !model grid cell latitude, south edge (degrees) + integer , intent(in) :: mxovr_i2o !max number of input cells that overlap model cell + integer , intent(out):: iovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lon index of overlap input cell + integer , intent(out):: jovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lat index of overlap input cell + real(r8), intent(out):: wovr_i2o(nlon_o,nlat_o,mxovr_i2o) !weight of overlap input cell +! ----------------------------------------------------------------- +! +! ------------------- local variables ----------------------------- +! + real(r8) fld_i(nlon_i,nlat_i) !dummy input grid field + real(r8) fld_o(nlon_o,nlat_o) !dummy model grid field + real(r8) area_i(nlon_i,nlat_i) !input grid cell area + real(r8) area_o(nlon_o,nlat_o) !model grid cell area + real(r8) re !radius of earth + real(r8) sum_fldo !global sum of dummy model field + real(r8) sum_fldi !global sum of dummy input field + integer io,ii !model and input longitude loop indices + integer jo,ji !model and input latitude loop indices + real(r8), parameter :: relerr = 0.000001 !relative error for error checks +! ----------------------------------------------------------------- + +! ----------------------------------------------------------------- +! get cell areas +! ----------------------------------------------------------------- + + call cell_area (nlat_i, nlon_i, numlon_i, lon_i, lat_i, re, area_i) + + call cell_area (nlat_o, nlon_o, numlon_o, lon_o, lat_o, re, area_o) + +! ----------------------------------------------------------------- +! get indices and weights for mapping from input grid to model grid +! ----------------------------------------------------------------- + + call ao_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & + nlon_o , nlat_o , numlon_o, lon_o , lat_o , & + mxovr_i2o, iovr_i2o , jovr_i2o, wovr_i2o , re , & + area_o , relerr ) + +! ----------------------------------------------------------------- +! error check: global sum fld_o = global sum fld_i +! ----------------------------------------------------------------- +! +! make dummy input field and sum globally +! + sum_fldi = 0. + do ji = 1, nlat_i + do ii = 1, numlon_i(ji) + fld_i(ii,ji) = (ji-1)*nlon_i + ii + sum_fldi = sum_fldi + area_i(ii,ji)*fld_i(ii,ji) + end do + end do +! +! area-average model field from input field +! + call area_ave (nlat_i , nlon_i , numlon_i ,fld_i , & + nlat_o , nlon_o , numlon_o ,fld_o , & + iovr_i2o , jovr_i2o , wovr_i2o , mxovr_i2o) +! +! global sum of model field +! + sum_fldo = 0. + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + sum_fldo = sum_fldo + area_o(io,jo)*fld_o(io,jo) + end do + end do +! +! check for conservation +! + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'map_i error srf => model: srf field not conserved' + write (6,'(a23,e20.10)') 'global sum model field = ',sum_fldo + write (6,'(a23,e20.10)') 'global sum srf field = ',sum_fldi + stop 999 + end if + + return +end subroutine map_i diff --git a/tools/icesst/regrid/max_ovr.f90 b/tools/icesst/regrid/max_ovr.f90 new file mode 100644 index 0000000000..63f41da3ac --- /dev/null +++ b/tools/icesst/regrid/max_ovr.f90 @@ -0,0 +1,93 @@ +subroutine max_ovr (nlon_i, nlat_i, numlon_i, nlon_o, nlat_o, numlon_o, & + lon_i , lat_i , lon_o , lat_o , novr_max) + + use precision + +! ----------------------------------------------------------------- + implicit none +! ------------------------ code history --------------------------- +! source file: max_ovr +! purpose: determine maximum number of overlapping cells +! input and output grids +! date last revised: March 1997 +! author: Mariana Vertenstein +! standardized: +! reviewed: +! ----------------------------------------------------------------- + +! ------------------- input variables ----------------------------- + integer, intent(in) :: nlon_i !number of input longitude points + integer, intent(in) :: nlat_i !number of input latitude points + integer, intent(in) :: numlon_i(nlat_i) !number of longitude points for each input grid cell latitude + integer, intent(in) :: nlon_o !number of output longitude points + integer, intent(in) :: nlat_o !number of output latitude points + integer, intent(in) :: numlon_o(nlat_o) !number of longitude points for each output grid cell latitude + real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, western edge + real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, southern edge + real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !output grid cell longitude, western edge + real(r8), intent(in) :: lat_o(nlat_o+1) !output grid cell latitude , southern edge + integer , intent(out):: novr_max !maximum number of overlapping input cells +! ----------------------------------------------------------------- + +! ------------------- local variables ----------------------------- + integer novr !number of overlapping input cells + integer io,ii !output and input grids longitude loop index + integer jo,ji !output and input grids latitude loop index +! ----------------------------------------------------------------- + + +! ----------------------------------------------------------------- +! for each output grid cell: find overlapping input grid cell and area of +! input grid cell that overlaps with output grid cell. cells overlap if: +! +! southern edge of input grid < northern edge of output grid AND +! northern edge of input grid > southern edge of output grid +! +! western edge of input grid < eastern edge of output grid AND +! eastern edge of input grid > western edge of output grid +! +! lon_o(io,jo) lon_o(io+1,jo) +! +! | | +! --------------------- lat_o(jo+1) +! | | +! | | +! xxxxxxxxxxxxxxx lat_i(ji+1) | +! x | x | +! x input | x output | +! x cell | x cell | +! x ii,ji | x io,jo | +! x | x | +! x ----x---------------- lat_o(jo ) +! x x +! xxxxxxxxxxxxxxx lat_i(ji ) +! x x +! lon_i(ii,ji) lon_i(ii+1,ji) +! ----------------------------------------------------------------- + +! +! determine maximum number of overlapping cells +! loop through all input grid cells to find overlap with output grid. +! code does not vectorize but is only called during initialization. +! + novr_max = 0 + do jo = 1, nlat_o + do io = 1, numlon_o(jo) + novr = 0 + do ji = 1, nlat_i + if (lat_i(ji ).lt.lat_o(jo+1) .and. & + lat_i(ji+1).gt.lat_o(jo )) then !lat ok + do ii = 1, numlon_i(ji) + if (lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & + lon_i(ii+1,ji).gt.lon_o(io ,jo)) then !lon okay + novr = novr + 1 ! increment number of ovrlap cells for io,jo + end if + end do + end if + end do + if (novr .gt. novr_max) novr_max = novr + end do + end do + + return +end subroutine max_ovr diff --git a/tools/icesst/regrid/precision.f90 b/tools/icesst/regrid/precision.f90 new file mode 100644 index 0000000000..9e40ff613c --- /dev/null +++ b/tools/icesst/regrid/precision.f90 @@ -0,0 +1,9 @@ +module precision + +! Define 4-byte, 8-byte, and 16-byte sizes + + integer, parameter :: r4 = selected_real_kind(5) + integer, parameter :: r8 = selected_real_kind(12) + integer, parameter :: r16 = selected_real_kind(20) + integer, parameter :: i8 = selected_int_kind(13) +end module precision diff --git a/tools/icesst/regrid/regrid.f90 b/tools/icesst/regrid/regrid.f90 new file mode 100644 index 0000000000..ada1556774 --- /dev/null +++ b/tools/icesst/regrid/regrid.f90 @@ -0,0 +1,770 @@ +program regrid +!---------------------------------------------------------------------------------- +! +! Purpose: Area average or linearly interpolate 1x1 degree SST and sea ice concentration +! data to grid defined by output file. +! +! Usage: regrid [-a] [-b begin] [-e end] -g gridfile -i icefile [-l] -o outfile -s sstfile [-v] +! +!---------------------------------------------------------------------------------- + use precision + + implicit none + + include 'netcdf.inc' +! +! Local workspace +! + character(len=256) :: sstfilein = ' ' ! filename for 1x1 input SST data + character(len=256) :: icefilein = ' ' ! filename for 1x1 input ICE data + character(len=256) :: gridout = ' ' ! filename for output grid coordinates + character(len=256) :: fileout = ' ' ! filename for regridded output data + character(len=256) :: arg ! cmd line argument + character(len=512) :: cmdline ! input command line + character(len=23) :: scattername ! file name for scatter plot + character(len=19) :: cur_timestamp + character(len=600) :: history ! history attribute + character(len=256) :: units_att ! units attribute + character(len=3) :: time_coord = 'old' ! 'new' or 'old' + + logical :: uselandmask = .false. ! Flag says to use input land mask (no longer used) + logical :: verbose = .false. ! Add print statements + logical :: linear_interp ! Flag to do linear interpolation vs. area averaging + logical :: usr_specified_interp = .false. ! Whether cmd-line interp type specified + logical :: scatterplots = .false. ! Turn on for scatter plots + + integer :: cmdlen, hislen, totlen ! character array lengths + integer :: date(1) ! array to please lf95 + integer :: datesec(1) ! array to please lf95 + integer :: mo ! month index + + real(r8), parameter :: iceflag = -1.8 ! sea ice flag + real(r8) :: pertval ! randomizer for scatter plots + real(r8) :: fillvaluesst ! in case sst has fillvalue over land + real(r8) :: fillvalueice ! in case ice has fillvalue over land + real(r4), parameter :: fillvalueout = 1.e36 ! placeholder in case land mask desired +! +! Netcdf file, dimension, and variable id's for input file +! + integer :: ncidsstin = -1 ! input sst file + integer :: ncidicein = -1 ! input sst file + integer :: ncidout = -1 ! output file + integer :: londimidin = -1 ! longitude dimension + integer :: londimidicein = -1 ! longitude dimension ice file (length compared vs. sst) + integer :: latdimidin = -1 ! latitude dimension + integer :: latdimidicein = -1 ! latitude dimension ice file (length compared vs. sst) + integer :: timedimidin = -1 ! time dimension + integer :: timedimidicein = -1 ! time dimension ice file (compared vs. sst) + integer :: lonidin = -1 ! longitude variable + integer :: latidin = -1 ! latitude variable + integer :: timeidin = -1 ! time variable + integer :: timeidicein = -1 ! time variable from ice, checked vs. sst + integer :: dateidin = -1 ! date variable + integer :: ntimein = -1 ! number of time samples + integer :: ntimeicein = -1 ! number of time samples ice file, checked vs. sst + integer :: sstidin = -1 ! SST variable + integer :: iceidin = -1 ! ICE variable +! +! Netcdf file, dimension, and variable id's for grid file +! + integer :: ncidgrd = -1 ! grid file + integer :: londimidgrd = -1 ! longitude dimension + integer :: latdimidgrd = -1 ! latitude dimension + integer :: lonidgrd = -1 ! longitude variable + integer :: latidgrd = -1 ! latitude variable + logical :: is_reduced_grid = .false. + integer :: nlonidgrd = -1 ! number of longitudes (reduced grid) + integer :: rlonidgrd = -1 ! longitude variable (reduced grid) +! +! Netcdf file, dimension, and variable id's for output file +! + integer :: londimidout = -1 ! longitude dimension + integer :: latdimidout = -1 ! latitude dimension + integer :: timedimidout = -1 ! time dimension + integer :: lonidout = -1 ! longitude variable + integer :: latidout = -1 ! latitude variable + integer :: nlonidout = -1 ! number of longitudes (reduced grid) + integer :: rlonidout = -1 ! longitude variable (reduced grid) + integer :: timeidout = -1 ! time variable + integer :: dateidout = -1 ! date variable for model + integer :: datesecidout = -1 ! seconds of date variable for model + integer :: sstidout = -1 ! SST variable + integer :: iceidout = -1 ! ICE fraction variable + integer :: oroidsst = -1 ! ORO variable based on SST + integer :: oroidconc = -1 ! ORO variable based on sea ice concentration + integer :: landmaskidout = -1 ! LANDMASK variable on output grid + integer :: dimid(3) ! dimension id's for variable to be defined + integer :: startin(3) = (/1, 1, 1/) ! starting position for variable read + integer :: startout(3) = (/1, 1, 1/) ! starting position for variable written + integer :: kountin(3) = (/-1, -1, 1/)! number of values for variable read + integer :: kountout(3) = (/-1, -1, 1/)! number of values for variable written + integer :: plonin = -1 ! longitude dimension (input grid) + integer :: plonicein = -1 ! longitude dimension (input ice grid). Compared to sst + integer :: nlatin = -1 ! latitude dimension (input grid) + integer :: nlaticein = -1 ! latitude dimension (input ice grid). Compared to sst + integer :: plonout = -1 ! longitude dimension (output grid) + integer :: nlatout = -1 ! latitude dimension (output grid) + integer :: i, j ! longitude, latitude indices + integer :: ret ! return code + integer :: nargs ! input arg + integer :: n ! index loops thru input args + integer :: itime ! integer equivalent of time variable + integer :: year ! year from binary file + integer :: bdate = -1 ! integer equivalent of begindate + integer :: edate = huge(1) ! integer equivalent of enddate + + character(len=8) :: begindate = ' ' ! date to start data values + character(len=8) :: enddate = ' ' ! date to start data values +! +! Data on input SST file +! + integer, allocatable :: nlonin(:) ! number of lons per lat on input grid + + real(r8) :: time ! time variable, copied from input to output + real(r8) :: timeice ! time variable from ice file, checked vs. sst + real(r8), allocatable :: lonin(:) ! longitude on input grid (degrees) + real(r8), allocatable :: lonin2d(:,:) ! longitude on input grid (degrees) + real(r8), allocatable :: latin(:) ! latitude on input grid (degrees) + real(r8), allocatable :: sstin(:,:) ! mixed layer depths on input grid + real(r8), allocatable :: icefracin(:,:)! ice fraction on input grid +! +! Data on output grid +! + integer, allocatable :: nlonout(:) ! number of lons per lat (reduced output grid) + + real(r8), allocatable :: latout(:) ! latitude on output grid + real(r8), allocatable :: lonout(:) ! longitude on output grid + real(r8), allocatable :: rlon(:,:) ! longitude on (reduced) output grid + real(r8), allocatable :: sstout(:,:) ! mixed layer depths on output grid + real(r8), allocatable :: orosst(:,:) ! ocean/ice flag (1=ice 0=non-ice) based on sst + real(r8), allocatable :: oroconc(:,:) ! ocean/ice flag (1=ice 0=non-ice) based on ice conc. + real(r8), allocatable :: landmasksst(:,:) ! land flag (1=land 0=non-land) input grid + real(r8), allocatable :: landmaskice(:,:) ! land flag (1=land 0=non-land) input grid + real(r8), allocatable :: landmaskout(:,:) ! land flag (1=land 0=non-land) output grid + real(r8), allocatable :: icefracout(:,:) ! sea ice concentration on output grid +! +! Required by area averaging procedure +! + integer :: mxovr = -1 ! parameter needed by grid overlap routines + integer :: ii,jj ! indices from input grid + integer :: m ! index over number of overlapping points + integer, allocatable :: iovr(:,:,:) ! lon index of overlap input cell + integer, allocatable :: jovr(:,:,:) ! lat index of overlap input cell + + real(r8) :: wt ! weight + real(r8) :: icewt ! weight for sea ice + real(r8) :: waterwt ! weight for open ocean + real(r8) :: totwt ! icewt + waterwt + real(r8) :: dxin ! delta-x on input grid (degrees) + real(r8) :: dxout ! delta-x on output grid (degrees) + real(r8) :: dyin ! delta-y on input grid (degrees) + real(r8) :: dyout ! delta-y on output grid (degrees) + real(r8), allocatable :: wovr(:,:,:) ! weight of overlap input cell + real(r8), allocatable :: latinse(:) ! latitude south edge on input grid (degrees) + real(r8), allocatable :: latoutse(:) ! latitude south edge on output grid (degrees) + real(r8), allocatable :: loninwe(:,:) ! longitude west edge on 2-d input grid (degrees) + real(r8), allocatable :: lonoutwe(:,:) ! longitude west edge on 2-d output grid (degrees) +! +! For computing date info +! + integer :: monlen(12) ! length of months + data monlen/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ +! +! Cmd line +! + integer iargc + external iargc + +! parse command line arguments, saving them to be written to history attribute + + nargs = iargc () + n = 1 + cmdline = 'regrid ' + do while (n <= nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + select case (arg) + case ('-a') + linear_interp = .false. + usr_specified_interp = .true. + cmdline = trim(cmdline) // ' -a' + case ('-b') + call getarg (n, arg) + n = n + 1 + begindate = arg + read (begindate,'(i8)') bdate + cmdline = trim(cmdline) // ' -b ' // trim(begindate) + case ('-e') + call getarg (n, arg) + n = n + 1 + enddate = arg + read (enddate,'(i8)') edate + cmdline = trim(cmdline) // ' -e ' // trim(enddate) + case ('-g') + call getarg (n, arg) + n = n + 1 + gridout = arg + cmdline = trim(cmdline) // ' -g ' // trim(gridout) + case ('-i') + call getarg (n, arg) + n = n + 1 + icefilein = arg + cmdline = trim(cmdline) // ' -i ' // trim(icefilein) + case ('-l') + linear_interp = .true. + usr_specified_interp = .true. + cmdline = trim(cmdline) // ' -l' + case ('-o') + call getarg (n, arg) + n = n + 1 + fileout = arg + cmdline = trim(cmdline) // ' -o ' // trim(fileout) + case ('-s') + call getarg (n, arg) + n = n + 1 + sstfilein = arg + cmdline = trim(cmdline) // ' -s ' // trim(sstfilein) + case ('-v') + verbose = .true. + cmdline = trim(cmdline) // ' -v' + case default + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end select + end do + + if (sstfilein == ' ') then + call usage_exit ('No input SST file specified') + end if + + if (icefilein == ' ') then + call usage_exit ('No input ICE file specified') + end if + + if (gridout == ' ') then + call usage_exit ('No grid file specified') + end if + + if (fileout == ' ') then + call usage_exit ('No output file specified') + end if +! +! Open 1x1 netcdf files for reading and get dimension info +! + call wrap_nf_open (trim(sstfilein), nf_nowrite, ncidsstin) + call wrap_nf_open (trim(icefilein), nf_nowrite, ncidicein) + + call wrap_nf_inq_dimid (ncidsstin, 'lon', londimidin) + call wrap_nf_inq_dimlen (ncidsstin, londimidin, plonin) + + call wrap_nf_inq_dimid (ncidsstin, 'lat', latdimidin) + call wrap_nf_inq_dimlen (ncidsstin, latdimidin, nlatin) + + call wrap_nf_inq_dimid (ncidsstin, 'time', timedimidin) + call wrap_nf_inq_dimlen (ncidsstin, timedimidin, ntimein) +! +! Ensure ice file dims match those of sst +! + call wrap_nf_inq_dimid (ncidicein, 'lon', londimidicein) + call wrap_nf_inq_dimlen (ncidicein, londimidicein, plonicein) + if (plonin /= plonicein) then + write(6,*)'lon dim mismatch sst vs ice:',plonin,plonicein + call err_exit ('regrid') + end if + + call wrap_nf_inq_dimid (ncidicein, 'lat', latdimidicein) + call wrap_nf_inq_dimlen (ncidicein, latdimidicein, nlaticein) + if (nlatin /= nlaticein) then + write(6,*)'lat dim mismatch sst vs ice:',nlatin,nlaticein + call err_exit ('regrid') + end if + + call wrap_nf_inq_dimid (ncidicein, 'time', timedimidicein) + call wrap_nf_inq_dimlen (ncidicein, timedimidicein, ntimeicein) + if (ntimein /= ntimeicein) then + write(6,*)'time dim mismatch sst vs ice:',ntimein,ntimeicein + call err_exit ('regrid') + end if +! +! Allocate space for needed data from 1x1 files +! + allocate (nlonin(nlatin)) + allocate (lonin(plonin)) + allocate (latin(nlatin)) + allocate (sstin(plonin,nlatin)) + allocate (icefracin(plonin,nlatin)) + allocate (landmasksst(plonin,nlatin)) + allocate (landmaskice(plonin,nlatin)) + + nlonin(:) = plonin ! Input grid is rectangular +! +! Read needed grid info and variables from 1x1 files +! + call wrap_nf_inq_varid (ncidsstin, 'lon', lonidin) + call wrap_nf_inq_varid (ncidsstin, 'lat', latidin) + call wrap_nf_inq_varid (ncidsstin, 'time', timeidin) + call wrap_nf_inq_varid (ncidicein, 'time', timeidicein) ! to compare to sst + call wrap_nf_inq_varid (ncidsstin, 'SST', sstidin) + call wrap_nf_inq_varid (ncidicein, 'SEAICE', iceidin) + + ! Determine format of time variable in 1x1 files. + ! Old format was 'YYYYMMDD', new format is "days since ..." + call wrap_nf_get_att_text(ncidsstin, timeidin, 'units', units_att) + if (units_att(1:10) == 'days since') time_coord = 'new' + + ! If 1x1 files use new time units, then get the date info from the date variable + if (time_coord == 'new') then + call wrap_nf_inq_varid (ncidsstin, 'date', dateidin) + end if + + call wrap_nf_get_var_double (ncidsstin, lonidin, lonin) + call wrap_nf_get_var_double (ncidsstin, latidin, latin) +! +! Open grid file and get dimension info +! + call wrap_nf_open (trim(gridout), NF_NOWRITE, ncidgrd) + + call wrap_nf_inq_dimid (ncidgrd, 'lon', londimidgrd) + call wrap_nf_inq_dimlen (ncidgrd, londimidgrd, plonout) + + call wrap_nf_inq_dimid (ncidgrd, 'lat', latdimidgrd) + call wrap_nf_inq_dimlen (ncidgrd, latdimidgrd, nlatout) +! +! Allocate space for needed input and output data on output file +! + allocate (latout(nlatout)) + allocate (lonout(plonout)) + allocate (rlon(plonout,nlatout)) + allocate (nlonout(nlatout)) + allocate (sstout(plonout,nlatout)) + allocate (landmaskout(plonout,nlatout)) + allocate (orosst(plonout,nlatout)) + allocate (oroconc(plonout,nlatout)) + allocate (icefracout(plonout,nlatout)) +! +! Get coordinate variable IDs from grid file +! + call wrap_nf_inq_varid (ncidgrd, 'lon', lonidgrd) + call wrap_nf_inq_varid (ncidgrd, 'lat', latidgrd) +! +! Create output file +! + if (nf_create(trim(fileout), NF_CLOBBER, ncidout) /= NF_NOERR) then + write(6,*)'FAILURE: creating output file: ', fileout + stop 999 + end if +! +! Define dimensions on output file +! + call wrap_nf_def_dim (ncidout, 'lat', nlatout, latdimidout) + call wrap_nf_def_var (ncidout, 'lat', NF_DOUBLE, 1, latdimidout, latidout) + call wrap_nf_def_dim (ncidout, 'lon', plonout, londimidout) + call wrap_nf_def_var (ncidout, 'lon', NF_DOUBLE, 1, londimidout, lonidout) + call wrap_nf_def_dim (ncidout, 'time', NF_UNLIMITED, timedimidout) + call wrap_nf_def_var (ncidout, 'time', NF_DOUBLE, 1, timedimidout, timeidout) + call wrap_nf_def_var (ncidout, 'date', NF_INT, 1, timedimidout, dateidout) + call wrap_nf_def_var (ncidout, 'datesec', NF_INT, 1, timedimidout, datesecidout) +! +! Get fillvalues for ice and sst +! + call wrap_nf_get_att_double (ncidsstin, sstidin, '_FillValue', fillvaluesst) + call wrap_nf_get_att_double (ncidicein, iceidin, '_FillValue', fillvalueice) +! +! Define history attribute. +! + call get_curr_timestamp(cur_timestamp) + history = trim(cur_timestamp) // ' ' // trim(cmdline) + cmdlen = len_trim (history) + call wrap_nf_put_att_text (ncidout, NF_GLOBAL, 'history', cmdlen, trim(history)) +! +! Define SST on the output file +! + dimid(1) = londimidout + dimid(2) = latdimidout + dimid(3) = timedimidout + + call wrap_nf_def_var (ncidout, 'SST', NF_FLOAT, 3, dimid, sstidout) + call wrap_nf_def_var (ncidout, 'ICEFRAC', NF_FLOAT, 3, dimid, iceidout) + call wrap_nf_def_var (ncidout, 'OROSST', NF_FLOAT, 3, dimid, oroidsst) + call wrap_nf_def_var (ncidout, 'OROCONC', NF_FLOAT, 3, dimid, oroidconc) +! +! Copy and define attributes for SST and ICE +! + call wrap_nf_copy_att (ncidgrd, latidgrd, 'long_name', ncidout, latidout) + call wrap_nf_copy_att (ncidgrd, latidgrd, 'units', ncidout, latidout) + + call wrap_nf_copy_att (ncidgrd, lonidgrd, 'long_name', ncidout, lonidout) + call wrap_nf_copy_att (ncidgrd, lonidgrd, 'units', ncidout, lonidout) + + if (time_coord == 'old') then + call wrap_nf_copy_att (ncidsstin, timeidin, 'long_name', ncidout, timeidout) + else + call wrap_nf_copy_att (ncidsstin, timeidin, 'calendar', ncidout, timeidout) + end if + call wrap_nf_copy_att (ncidsstin, timeidin, 'units', ncidout, timeidout) + + call wrap_nf_copy_att (ncidsstin, sstidin, 'long_name', ncidout, sstidout) + call wrap_nf_copy_att (ncidsstin, sstidin, 'units', ncidout, sstidout) +! call wrap_nf_put_att_real (ncidout, sstidout, '_FillValue', NF_FLOAT, 1, fillvalueout) + + call wrap_nf_copy_att (ncidicein, iceidin, 'long_name', ncidout, iceidout) + call wrap_nf_put_att_text (ncidout, iceidout, 'units', len('1'), '1') +! call wrap_nf_put_att_real (ncidout, iceidout, '_FillValue', NF_FLOAT, 1, fillvalueout) + +! +! Set longitude values for output grid (check for reduced grid) +! + ret = nf_inq_varid (ncidgrd, 'nlon', nlonidgrd) + if (ret == nf_noerr) then ! probably reduced grid + ret = nf_inq_varid (ncidgrd, 'rlon', rlonidgrd) + if (ret == nf_noerr) then + + is_reduced_grid = .true. + + call wrap_nf_get_var_int (ncidgrd, nlonidgrd, nlonout) + call wrap_nf_get_var_double (ncidgrd, rlonidgrd, rlon) + + ! Put reduced grid variables in output file + call wrap_nf_def_var (ncidout, 'nlon', NF_INT, 1, dimid, nlonidout) + call wrap_nf_def_var (ncidout, 'rlon', NF_DOUBLE, 2, dimid, rlonidout) + call wrap_nf_copy_att (ncidgrd, lonidgrd, 'long_name', ncidout, rlonidout) + call wrap_nf_copy_att (ncidgrd, lonidgrd, 'units', ncidout, rlonidout) + + else + write(6,*)gridout, ' has nlon but not rlon => is screwed up' + stop 999 + end if + else ! full grid: define nlon and rlon + do j=1,nlatout + nlonout(j) = plonout + do i=1,plonout + rlon(i,j) = (i-1)*360./plonout + end do + end do + end if + + ! Read latitude and longitude values for output grid + call wrap_nf_get_var_double (ncidgrd, latidgrd, latout) + call wrap_nf_get_var_double (ncidgrd, lonidgrd, lonout) + +! +! Determine interpolation type if not specified on cmd line +! Use linear interpolation if output grid is finer than input grid. +! Otherwise use area averaging +! + if (.not. usr_specified_interp) then + if (nlonout(plonout/2) > nlonin(plonin/2)) then + linear_interp = .true. + else + linear_interp = .false. + end if + end if +! + if (linear_interp) then + write(6,*)'Using LINEAR interpolation to output grid' + call wrap_nf_put_att_text (ncidout, NF_GLOBAL, 'interp_type', 6, 'LINEAR') + allocate (lonin2d(plonin,nlatin)) +! +! ASSUME input grid is regular (not reduced) +! + do j=1,nlatin + lonin2d(:,j) = lonin(:) + end do + else +! +! For area averaging, compute overlap quantities. Only output lats need to be computed +! from lat vals. on input .nc file because they might not be uniformly spaced (e.g. Gaussian) +! + write(6,*)'Using AREA AVERAGING to output grid' + call wrap_nf_put_att_text (ncidout, NF_GLOBAL, 'interp_type', 14, 'AREA AVERAGING') + + allocate (loninwe(plonin+1,nlatin)) + allocate (lonoutwe(plonout+1,nlatout)) + allocate (latinse(nlatin+1)) + allocate (latoutse(nlatout+1)) + + dxin = 360._r8 / plonin + dyin = 180._r8 / nlatin +! +! West edge of input grid: starts at Greenwich +! South edge of input grid: starts at south pole +! + do i=1,plonin+1 + loninwe(i,:) = (i-1)*dxin + end do + + do j=1,nlatin+1 + latinse(j) = -90. + (j-1)*dyin + end do +! +! West edge of output grid: starts west of Greenwich +! + do j=1,nlatout + dxout = 360._r8 / nlonout(j) + do i=1,nlonout(j)+1 + lonoutwe(i,j) = -0.5*dxout + (i-1)*dxout + end do + end do + + latoutse(1) = -90. + do j=2,nlatout + dyout = latout(j) - latout(j-1) + latoutse(j) = latout(j) - 0.5*dyout + end do + latoutse(nlatout+1) = +90. + + call max_ovr (plonin, nlatin, nlonin, plonout, nlatout, nlonout, & + loninwe, latinse, lonoutwe, latoutse, mxovr) + + allocate (iovr(plonout,nlatout,mxovr)) + allocate (jovr(plonout,nlatout,mxovr)) + allocate (wovr(plonout,nlatout,mxovr)) + + call map_i (plonin, nlatin, nlonin, loninwe, latinse, & + plonout, nlatout, nlonout, lonoutwe, latoutse, & + mxovr, iovr, jovr, wovr) + end if +! +! Done with data definition +! + if (nf_enddef (ncidout) /= nf_noerr) then + write(6,*)'Ending define mode failed on ', fileout + stop 999 + end if + + ! Add coordinate data to output file + call wrap_nf_put_var_double (ncidout, latidout, latout) + call wrap_nf_put_var_double (ncidout, lonidout, lonout) + if (is_reduced_grid) then + call wrap_nf_put_var_int (ncidout, nlonidout, nlonout) + call wrap_nf_put_var_double (ncidout, rlonidout, rlon) + end if + +! +! Define lon and lat count variables for netcdf calls +! + kountin(1) = plonin + kountin(2) = nlatin + + kountout(1) = plonout + kountout(2) = nlatout +! +! Get LANDMASK variables for output grid if requested +! + if (uselandmask) then + call wrap_nf_inq_varid (ncidgrd, 'LANDMASK', landmaskidout) + call wrap_nf_get_var_double (ncidgrd, landmaskidout, landmaskout) + else + landmaskout(:,:) = 0. + end if +! +! Loop over time, binning 1x1 SST data to output grid +! + do n=1,ntimein + call wrap_nf_get_vara_double (ncidsstin, timeidin, n, 1, time) + call wrap_nf_get_vara_double (ncidicein, timeidicein, n, 1, timeice) +! +! Ensure times must match sst vs ice +! + if (time /= timeice) then + write(6,*)'time mismatch sst vs ice:',time,timeice + call err_exit ('regrid') + end if + if (time_coord == 'old') then + ! date info from time variable + itime = nint (time) + else + ! date info from date variable + call wrap_nf_get_vara_int (ncidsstin, dateidin, n, 1, itime) + end if + if (bdate <= itime .and. edate >= itime) then + if (verbose) then + write(6,*)'Processing date ', itime + end if + startin(3) = n + call wrap_nf_get_vara_double (ncidsstin, sstidin, startin, kountin, sstin) + call wrap_nf_get_vara_double (ncidicein, iceidin, startin, kountin, icefracin) +! +! Turn percentage into fraction +! + where (icefracin(:,:) /= fillvalueice) + icefracin(:,:) = icefracin(:,:) * 0.01 + end where + + if (linear_interp) then + call interp_driver (plonin, nlatin, 1, nlonin, lonin2d, latin, 0._r8, icefracin, & + plonout, nlatout, 1, nlonout, rlon, latout, 0._r8, icefracout) + call interp_driver (plonin, nlatin, 1, nlonin, lonin2d, latin, 0._r8, sstin, & + plonout, nlatout, 1, nlonout, rlon, latout, 0._r8, sstout) + do j=1,nlatout + do i=1,nlonout(j) + if (nint (landmaskout(i,j)) == 1) then + sstout(i,j) = fillvalueout + icefracout(i,j) = fillvalueout + end if + end do + end do + else + do j=1,nlatout + do i=1,nlonout(j) + if (nint (landmaskout(i,j)) == 1) then + sstout(i,j) = fillvalueout + icefracout(i,j) = fillvalueout + else + sstout(i,j) = 0. + icefracout(i,j) = 0. + icewt = 0. + waterwt = 0. + + do m=1,mxovr ! overlap cell index + ii = iovr(i,j,m) ! lon index (input grid) of overlap cell + jj = jovr(i,j,m) ! lat index (input grid) of overlap cell + wt = wovr(i,j,m) ! overlap weight + sstout(i,j) = sstout(i,j) + sstin(ii,jj)*wt + icefracout(i,j) = icefracout(i,j) + icefracin(ii,jj)*wt +! +! The next bit of code is only useful when using SST to define where ice is +! + if (sstin(ii,jj) > iceflag + 0.001) then + waterwt = waterwt + wovr(i,j,m) + else + icewt = icewt + wovr(i,j,m) + end if + end do + + totwt = waterwt + icewt + if (totwt < 0.9999 .or. totwt > 1.0001) then + write(6,*) 'regrid: bad totwt=', totwt + stop 999 + end if +! +! When computing ice flag using SST's, ensure ice point if fraction is > 50% +! +! if (icewt >= 0.5 .and. sstout(i,j) > iceflag) then +! sstout(i,j) = iceflag +! end if + end if + end do ! i=1,nlonout(j) + end do ! j=1,nlatout + end if +! +! Open output file for scatter plot at start of every year +! + if (scatterplots .and. mod(itime/100,100) == 1) then + year = itime/10000 + write (scattername,200) year +200 format ('scatter.data.',i4) + open (unit=1,file=scattername,form='formatted',action='WRITE') + end if +! +! Produce data for scatter plot, randomized by rectangular distributin bounded by +! +-0.5x1.E-02 +! + do j=1,nlatin + do i=1,nlonin(j) + if (icefracin(i,j) /= fillvalueice .and. sstin(i,j) /= fillvaluesst) then + if (verbose .and. icefracin(i,j) > 0.5 .and. sstin(i,j) > 6.) then + write(6,*)'i=',i,' j=',j,' icefrac,sst=',icefracin(i,j),sstin(i,j) + end if + if (scatterplots .and. icefracin(i,j) > 0.) then + call random_number (pertval) + write(1,'(2f8.4)') icefracin(i,j) + (0.5-pertval)*.01, sstin(i,j) + end if + end if + end do + end do + + if (scatterplots .and. mod(itime,100) == 12) then + close (unit=1) + end if +! +! Define sea ice flags from 1) ice concentration, and 2) SST dataset +! + do j=1,nlatout + do i=1,nlonout(j) + orosst(i,j) = 0. + oroconc(i,j) = 0. + if (sstout(i,j) <= iceflag) then + orosst(i,j) = 1. + end if + if (icefracout(i,j) >= 0.5) then ! sea ice + oroconc(i,j) = 1. + end if + end do + end do +! +! Write out SST data +! + if (verbose) then + write(6,*)'regrid: writing SST data for time slice ', n + end if +! +! Build date info: use only year/month from input file because day info is incompatible +! with CAM +! + date(1) = (itime / 100) * 100 + mo = mod ((itime / 100), 100) + if (mo < 1 .or. mo > 12) then + write(6,*)'regrid: Bad mo index=', mo + stop 999 + end if + date(1) = date(1) + monlen(mo)/2 + 1 + datesec(1) = 0 + if (mod(monlen(mo), 2) /= 0) datesec(1) = 43200 + + startout(3) = n + call wrap_nf_put_vara_double (ncidout, timeidout, n, 1, time) + call wrap_nf_put_vara_int (ncidout, dateidout, n, 1, date) + call wrap_nf_put_vara_int (ncidout, datesecidout, n, 1, datesec) + call wrap_nf_put_vara_double (ncidout, sstidout, startout, kountout, sstout) + call wrap_nf_put_vara_double (ncidout, iceidout, startout, kountout, icefracout) + call wrap_nf_put_vara_double (ncidout, oroidsst, startout, kountout, orosst) + call wrap_nf_put_vara_double (ncidout, oroidconc, startout, kountout, oroconc) + else + if (verbose) then + write(6,*)'Skipping date ', itime + end if + end if + end do +! +! Clean up +! + call wrap_nf_close (ncidsstin) + call wrap_nf_close (ncidicein) + call wrap_nf_close (ncidgrd) + call wrap_nf_close (ncidout) + + if (scatterplots) then + close (unit=1) + end if + + stop +end program regrid + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg /= ' ') write (6,*) arg + write (6,*) 'Usage: regrid [-a] [-b begin] [-e end] -g gridfile -i icefile [-l] -o outfile -s sstfile [-v]' + write (6,*) ' -a: Use area averaging (not linear interpolation). default if fine->coarse' + write (6,*) ' -b date: (yyyymmdd) skip input dates earlier than this. default: start at the beginning' + write (6,*) ' -e date: (yyyymmdd) skip input dates later than this. default: end at the end' + write (6,*) ' -g file: input netcdf file containing grid for output fields' + write (6,*) ' -i file: 1x1 input netcdf ICE concentration file' + write (6,*) ' -l: Use linear interpolation (not area averaging). default if coarse->fine' + write (6,*) ' -o file: output netcdf file with regridded SST and ICE' + write (6,*) ' -s file: 1x1 input netcdf SST file' + write (6,*) ' -v: verbose mode' + stop 999 +end subroutine usage_exit + +subroutine get_curr_timestamp(time) +! return timestamp formatted as "YYYY-MM-DD HH:MM:SS" + character(len=19), intent(out) :: time + integer :: t(8) + call date_and_time(values=t) + write(time,'(i4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') t(1),'-',t(2),'-',t(3),' ',& + t(5),':',t(6),':',t(7) +end subroutine get_curr_timestamp diff --git a/tools/icesst/regrid/wrap_nf.f90 b/tools/icesst/regrid/wrap_nf.f90 new file mode 100644 index 0000000000..2bb627bd02 --- /dev/null +++ b/tools/icesst/regrid/wrap_nf.f90 @@ -0,0 +1,380 @@ +!=============================================================================== +! +! Wrapper functions for netcdf. Print message and abort upon failure return. +! +!=============================================================================== + +subroutine wrap_nf_open (file, mode, nfid) + implicit none + include 'netcdf.inc' + + character(len=*) file + integer mode, nfid + + integer ret + + ret = nf_open (file, mode, nfid) + if (ret /= nf_noerr) then + write(6,*)nf_strerror(ret) + write(6,*)'Unable to open file ', file + call abort + end if +end subroutine wrap_nf_open + +subroutine wrap_nf_close (nfid) + implicit none + include 'netcdf.inc' + + integer nfid + + integer ret + + ret = nf_close (nfid) + if (ret /= nf_noerr) then + write(6,*)nf_strerror(ret) + write(6,*)'Unable to close nfid ', nfid + call abort + end if +end subroutine wrap_nf_close + +subroutine wrap_nf_inq_varid (nfid, varname, varid) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) varname + + integer ret + + ret = nf_inq_varid (nfid, varname, varid) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_inq_varid + +subroutine wrap_nf_inq_dimlen (nfid, dimid, dimlen) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, dimlen + + integer ret + + ret = nf_inq_dimlen (nfid, dimid, dimlen) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_inq_dimlen + +subroutine wrap_nf_inq_dimid (nfid, dimname, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimid (nfid, dimname, dimid) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_inq_dimid + +subroutine wrap_nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts + character*(*) varname + + integer ret + + ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_inq_var + +subroutine wrap_nf_def_dim (nfid, dimname, len, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, len, dimid + character*(*) dimname + + integer ret + + ret = nf_def_dim (nfid, dimname, len, dimid) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_def_dim + +subroutine wrap_nf_def_var (nfid, name, xtype, nvdims, vdims, varid) + implicit none + include 'netcdf.inc' + + integer, intent(in):: nfid + integer, intent(in)::xtype + integer, intent(in)::nvdims + integer, intent(out)::varid + integer, intent(in):: vdims(nvdims+1) + character*(*), intent(in):: name + + integer ret ! NetCDF return code + + ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid) + if (ret/=NF_NOERR) then + write(6,*) 'wrap_nf_def_var failed for ',name + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_def_var + +subroutine wrap_nf_get_var_double (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + double precision arr(*) + + integer ret + + ret = nf_get_var_double (nfid, varid, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_get_var_double + +subroutine wrap_nf_get_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer arr(*) + + integer ret + + ret = nf_get_var_int (nfid, varid, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_get_var_int + +subroutine wrap_nf_put_var_double (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + double precision arr(*) + + integer ret + ret = nf_put_var_double (nfid, varid, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_var_double + +subroutine wrap_nf_put_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer arr(*) + + integer ret + ret = nf_put_var_int (nfid, varid, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_var_int + +subroutine wrap_nf_put_vara_int (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + + ret = nf_put_vara_int (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_vara_int + +subroutine wrap_nf_get_vara_int (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + + ret = nf_get_vara_int (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_get_vara_int + +subroutine wrap_nf_get_vara_double (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + double precision arr(*) + + integer ret + + ret = nf_get_vara_double (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_get_vara_double + +subroutine wrap_nf_put_vara_double (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + double precision arr(*) + + integer ret + ret = nf_put_vara_double (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_vara_double + +subroutine wrap_nf_put_vara_real (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + real arr(*) + + integer ret + ret = nf_put_vara_real (nfid, varid, start, count, arr) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_vara_real + +subroutine wrap_nf_get_att_text (nfid, varid, name, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) name, text + + integer ret + + ret = nf_get_att_text (nfid, varid, name, text) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret), ": ", trim(name) + call abort + end if +end subroutine wrap_nf_get_att_text + +subroutine wrap_nf_put_att_text (nfid, varid, name, len, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid, len + character*(*) name, text + + integer ret + + ret = nf_put_att_text (nfid, varid, name, len, text) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_att_text + +subroutine wrap_nf_get_att_double (nfid, varid, name, dvals) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) name + double precision dvals + + integer ret + + ret = nf_get_att_double (nfid, varid, name, dvals) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret), ": ", trim(name) + call abort + end if +end subroutine wrap_nf_get_att_double + +subroutine wrap_nf_put_att_double (nfid, varid, name, xtype, len, dvals) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, len + character*(*) name + double precision dvals + + integer ret + + ret = nf_put_att_double (nfid, varid, name, xtype, len, dvals) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_att_double + +subroutine wrap_nf_put_att_real (nfid, varid, name, xtype, len, dvals) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, len + character*(*) name + real dvals + + integer ret + + ret = nf_put_att_real (nfid, varid, name, xtype, len, dvals) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_put_att_real + +subroutine wrap_nf_copy_att (nfid_in, varid_in, name, nfid_out, varid_out) + implicit none + include 'netcdf.inc' + + integer nfid_in, varid_in, nfid_out, varid_out + character*(*) name + + integer ret + + ret = nf_copy_att (nfid_in, varid_in, name, nfid_out, varid_out) + if (ret /= NF_NOERR) then + write(6,*) nf_strerror (ret) + call abort + end if +end subroutine wrap_nf_copy_att + diff --git a/tools/interpaerosols/CREATE_DIMS_GAU.ncl b/tools/interpaerosols/CREATE_DIMS_GAU.ncl new file mode 100644 index 0000000000..d5f8158f37 --- /dev/null +++ b/tools/interpaerosols/CREATE_DIMS_GAU.ncl @@ -0,0 +1,46 @@ + + +begin + + RESLN = + + NLAT = + NLON = + + del_lon = new( (/1/) , double) + gau_info = gaus(NLAT/2) + lat = gau_info(:,0) + gwgt = gau_info(:,1) + del_lon(0) = (360./NLON) + lon = ispan(0,NLON-1,1)*del_lon(0) + + lat@long_name = "latitude" + lat@short_name = "lat" + + lon@long_name = "longitude" + lon@short_name = "lon" + +;------------------------ +; Write to file +;------------------------ + + nfn = "regrid."+RESLN+".nc" + system("rm "+nfn) + cdf = addfile(nfn, "c") + + filedimdef(cdf, (/ "lat","lon" /), \ + (/ NLAT, NLON /), \ + (/ False, False /) ) + + + filevardef(cdf, "lat", "double", (/"lat"/)) + filevarattdef(cdf, "lat", lat) + + filevardef(cdf, "lon", "double", (/"lon"/)) + filevarattdef(cdf, "lon", lon) + + cdf->lat = lat + cdf->lon = lon + + +end diff --git a/tools/interpaerosols/CREATE_DIMS_REG.ncl b/tools/interpaerosols/CREATE_DIMS_REG.ncl new file mode 100644 index 0000000000..f375b1b9a2 --- /dev/null +++ b/tools/interpaerosols/CREATE_DIMS_REG.ncl @@ -0,0 +1,52 @@ + + +begin + + RESLN = + + NLAT = + NLON = + + BEGLAT = + BEGLON = + + ENDLAT = + ENDLON = + + lat = new ( (/NLAT/), double ) + lon = new ( (/NLON/), double ) + + lat = fspan(BEGLAT,ENDLAT,NLAT) + lon = fspan(BEGLON,ENDLON,NLON) + + + lat@long_name = "latitude" + lat@short_name = "lat" + + lon@long_name = "longitude" + lon@short_name = "lon" + +;------------------------ +; Write to file +;------------------------ + + nfn = "regrid."+RESLN+".nc" + system("rm "+nfn) + cdf = addfile(nfn, "c") + + filedimdef(cdf, (/ "lat","lon" /), \ + (/ NLAT, NLON /), \ + (/ False, False /) ) + + + filevardef(cdf, "lat", "double", (/"lat"/)) + filevarattdef(cdf, "lat", lat) + + filevardef(cdf, "lon", "double", (/"lon"/)) + filevarattdef(cdf, "lon", lon) + + cdf->lat = lat + cdf->lon = lon + + +end diff --git a/tools/interpaerosols/Makefile b/tools/interpaerosols/Makefile new file mode 100644 index 0000000000..d56c270e2f --- /dev/null +++ b/tools/interpaerosols/Makefile @@ -0,0 +1,132 @@ +# Makefile to build interpaerosols on various platforms +# Note: If netcdf library is not built in the standard location, you must set the environment +# variables INC_NETCDF and LIB_NETCDF +# This program now looks for the file netcdf.mod instead of netcdf.inc +# on some NCAR systems this means that INC_NETCDF and LIB_NETCDF will be set to +# the same directory +# Set up special characters +null := + +EXEDIR = . +EXENAME = interpaerosols +RM = rm + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) +FC = f90 +FFLAGS = -64 -c -I$(INC_NETCDF) -O2 -D$(UNAMES) -DHIDE_MPI +LDFLAGS = -64 -L$(LIB_NETCDF) -lnetcdf -lscs +endif + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90:cpp=F90 -O2 -qmaxmem=-1 -g -qfullpath -WF,-DHIDE_MPI,-DAIX +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdf -llapack -lblas -g +endif + +#------------------------------------------------------------------------ +# OSF1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),OSF1) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lcxml +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := pgf90 + else + FC := $(USER_FC) + endif + + FFLAGS = -c -I$(INC_NETCDF) -DHIDE_MPI -D$(UNAMES) + LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + + ifeq ($(FC),pgf90) + ifeq ($(DEBUG),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds + else + FFLAGS += -fast + endif + LDFLAGS += -llapack -lblas + endif + + ifeq ($(FC),lf95) + ifeq ($(DEBUG),TRUE) + FFLAGS += -g --chk e,s,u + else + FFLAGS += -O + endif + LDFLAGS += -llapackmt -lblasmt + endif +endif + +#------------------------------------------------------------------------ +# Cray X1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),UNICOS/mp) +FC = ftn +FFLAGS = -c -I$(INC_NETCDF) -O2 -DUNICOSMP +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := addglobal.o driver.o fmain.o globals.o preserve_mean.o error_messages.o\ + interpolate_data.o shr_kind_mod.o cam_abortutils.o shr_sys_mod.o shr_mpi_mod.o + +.SUFFIXES: +.SUFFIXES: .F90 .f90 .o + +.f90.o: + $(FC) $(FFLAGS) $< + +.F90.o: + $(FC) $(FFLAGS) $< + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +addglobal.o: error_messages.o +interpolate_data.o: cam_abortutils.o shr_kind_mod.o +driver.o: shr_kind_mod.o globals.o preserve_mean.o interpolate_data.o +fmain.o: globals.o +preserve_mean.o: shr_kind_mod.o globals.o +cam_abortutils.o: shr_sys_mod.o +shr_sys_mod.o: shr_mpi_mod.o +error_messages.o: cam_abortutils.o +shr_mpi_mod.o: shr_kind_mod.o + +VPATH = . ../../src/control ../../../../csm_share/shr ../../src/utils diff --git a/tools/interpaerosols/README b/tools/interpaerosols/README new file mode 100644 index 0000000000..36d64903c3 --- /dev/null +++ b/tools/interpaerosols/README @@ -0,0 +1,24 @@ +Typing "gmake" in this directory will build an executable named +interpaerosols that can be used to generate a resolution-specific aerosol +mass dataset suitable for input to CAM. Required command-line arguments to +interpaerosols are 1) input "master" aerosol netcdf dataset on a rectangular +grid; 2) input/output template netcdf dataset on the target CAM grid. On +output this second dataset will contain horizontally interpolated and +vertically summed versions of the input fields. Optionally, the -d argument +can be included which will produce 64-bit output fields. The default is +32-bit fields. At this writing the most current master aerosol mass dataset +is named AerosolMass_192x94_L28_clim_c030418.nc and lives in +/fs/cgd/csm/inputdata/atm/cam2/rad. + +Perl script REGRID.pl is included to enable easy creation of the +template dataset at a specific resolution. Usage of the perl script is: +REGRID.pl , where currently supported resolutions can be found by +running the script without arguments. The output netcdf file will be named +regrid..nc. An example sequence of steps to create +a T42 aerosol dataset for input to CAM would be: + +REGRID.pl T42 +gmake +./interpaerosols /fs/cgd/csm/inputdata/atm/cam2/rad/AerosolMass_192x94_L28_clim_c030418.nc \ + regrid.T42.nc + diff --git a/tools/interpaerosols/REGRID.pl b/tools/interpaerosols/REGRID.pl new file mode 100755 index 0000000000..0cc7017ee2 --- /dev/null +++ b/tools/interpaerosols/REGRID.pl @@ -0,0 +1,186 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------- +# Usage: perl REGRID.pl RESLN +# where RESLN denotes the resolution desired. +# Supported resolutions are: +# T5, T21, T31, T42, T63, T85, T170, +# 10by15, 4by5, 2by2.5, 1by1.25, ncfilename (*new*) +#----------------------------------------------------------------------- + +@ARGV; + +$resln = $ARGV[0]; + + +#----------------------------------------------------- +# Assign necessary dimensions given the resolution +#----------------------------------------------------- + +if( $resln eq "T42" ) { + $nlat = 64; + $nlon = 128; + +} elsif ( $resln eq "T63" ) { + $nlat = 96; + $nlon = 192; + +} elsif ( $resln eq "T85" ) { + $nlat = 128; + $nlon = 256; + +} elsif ( $resln eq "T170" ) { + $nlat = 256; + $nlon = 512; + +} elsif ( $resln eq "T31" ) { + $nlat = 48; + $nlon = 96; + +} elsif ( $resln eq "T21" ) { + $nlat = 32; + $nlon = 64; + +} elsif ( $resln eq "T5" ) { + $nlat = 8; + $nlon = 16; + +} elsif ( $resln eq "10by15" ) { + $nlat = 19; + $nlon = 24; + + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "345.0"; + +} elsif ( $resln eq "4by5" ) { + $nlat = 46; + $nlon = 72; + + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "355.0"; + +} elsif ( $resln eq "2by2.5" ) { + $nlat = 91; + $nlon = 144; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "357.5"; + +} elsif ( $resln eq "1by1.25" ) { + $nlat = 181; + $nlon = 288; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "358.75"; + +} elsif ( $resln eq "0.5by.625" ) { + $nlat = 361; + $nlon = 576; + $blat = "-90.0"; + $blon = "0.0"; + $elat = "90.0"; + $elon = "359.375"; + +} elsif ( -e "$resln" ) { + print "Copying from input file $resln\n"; + $createfromfile=1; + +} else { + + die "Usage: perl REGRID.pl \n Supported resolutions are T5, T21, T31, T42, T63, T85, T170, 10by15, 4by5, 2by2.5, 1by1.25 or {ncfilename} where ncfilename is the name of an existing netcdf file containing variables lat and lon. \nExiting script"; + + +} + +if($createfromfile) { + $outfile = "CREATE_DIMS_FROM_FILE.ncl"; + #------------------------------------------ + # Run NCL script + #------------------------------------------ + + print("CREATING DIMENSION FILE FOR $resln GRID\n"); + system( "ncl < CREATE_DIMS_FROM_FILE.ncl" ); + +}else{ + #--------------------------------------------- + # determine grid type (gaussian or regular) + #--------------------------------------------- + + $leadchar = substr($resln,0,1); + + if( $leadchar eq "T" ) { + + $indic = "GAUS"; + $infile = "CREATE_DIMS_GAU.ncl"; + + }else{ + + $indic = "REG"; + $infile = "CREATE_DIMS_REG.ncl"; + + } + + #------------------------------------------------------------------ + # Set up NCL script to create netCDF file for requested resolution + #------------------------------------------------------------------ + + $keyword1 = "RESLN ="; + $keyword2 = "NLAT ="; + $keyword3 = "NLON ="; + $keyword4 = "BEGLAT ="; + $keyword5 = "BEGLON ="; + $keyword6 = "ENDLAT ="; + $keyword7 = "ENDLON ="; + + $resexpr = qq!"$resln"!; + + $outfile = "CREATE_DIMS_$resln.ncl"; + + open(INF, "$infile"); + open(OUTF,">$outfile"); + + while(){ + + if(/$keyword1/){ + print OUTF "RESLN = $resexpr\n"; + } elsif (/$keyword2/) { + print OUTF "NLAT = $nlat\n"; + } elsif (/$keyword3/) { + print OUTF "NLON = $nlon\n"; + } elsif (/$keyword4/) { + print OUTF "BEGLAT = $blat\n"; + } elsif (/$keyword5/) { + print OUTF "BEGLON = $blon\n"; + } elsif (/$keyword6/) { + print OUTF "ENDLAT = $elat\n"; + } elsif (/$keyword7/) { + print OUTF "ENDLON = $elon\n"; + } else { + print OUTF "$_"; + } + + + } + + close(INF); + close(OUTF); + #------------------------------------------ + # Run NCL script + #------------------------------------------ + + print("CREATING DIMENSION FILE FOR $resln GRID\n"); + system( "ncl < CREATE_DIMS_$resln.ncl" ); +} + + + +exit; + + + + diff --git a/tools/interpaerosols/addglobal.F90 b/tools/interpaerosols/addglobal.F90 new file mode 100644 index 0000000000..27113cfc14 --- /dev/null +++ b/tools/interpaerosols/addglobal.F90 @@ -0,0 +1,82 @@ +subroutine addglobal (ncid, cmdline) + use netcdf + use error_messages, only : handle_ncerr + + implicit none + +! +! Input arguments +! + integer ncid + character*(*) cmdline +! +! Local workspace +! + integer ret + integer numchars + integer values(8) + integer hnum + integer hlen + + character*8 date + character*10 time + character*5 zone + character*18 datetime + character*16 logname + character*16 hostname + character*1500 :: hist + + call date_and_time (date, time, zone, values) + + datetime(1:8) = date(5:6) // '/' // date(7:8) // '/' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + + call getenv ('LOGNAME', logname) + call getenv ('HOST', hostname) + + hlen = 0 + hist = ' ' + if (nf90_inquire_attribute (ncid, nf90_global, 'history', len=hlen, attnum=hnum) == nf90_noerr) then + call handle_ncerr( nf90_get_att (ncid, nf90_global, 'history', hist),& + 'addglobal.F90:40') + end if + + hist = trim (hist) // char(10) // datetime // trim (logname) // ':' // & + trim (hostname) // ':' // trim (cmdline) +! +! Add 3 to account for 1st newline and colons between each of 2 trimmed strings +! + hlen = hlen + len(datetime) + len_trim(logname) + len_trim(hostname) + & + len_trim(cmdline) + 3 + + if (hlen > len (hist)) then + write(6,*)'Warning: history attribute too long: truncating' + hlen = len (hist) + end if + + numchars = len_trim (hist) + ret = nf90_put_att (ncid, nf90_global, 'history', hist) + + return +end subroutine addglobal + +#ifdef UNICOSMP +subroutine getenv (name, val) + implicit none + + character(len=*), intent(in) :: name + character(len=*), intent(out) :: val + + integer :: lenname + integer :: lenval + integer :: ierr + + call pxfgetenv (name, lenname, val, lenval, ierr) + if (ierr /= 0) then + write(6,*)'getenv: ierr not 0:', ierr + stop 999 + end if + + return +end subroutine getenv +#endif diff --git a/tools/interpaerosols/driver.f90 b/tools/interpaerosols/driver.f90 new file mode 100644 index 0000000000..62cd8f0b54 --- /dev/null +++ b/tools/interpaerosols/driver.f90 @@ -0,0 +1,454 @@ +subroutine driver (ncprec, rgridnl,isncol,nxi,nyi,nxo,nyo,nz,ntime,nxof,nyof) +!------------------------------------------------------------------ +! Purpose: +! Horizontally interpolate file containing aerosol masses to CAM grid. +! Sum the values in the vertical such that output arrays contain the +! column sum from the bottom of the atmosphere to that level. +! Convert monthly averages to mid month values. +! Input file assumed to be MATCH ncep runs, averaged by month. +! and backsolved to provide Mid-month values) +! +! Method: +! read data from file +! interpolate data onto CAM horizontal grid +! Modified: by Jim Edwards 3/2006 +! CAM horizontal grid may either be a rectangular lat/lon grid, or a 1d list of columns +! in the case of a 1d list the output arrays are of size f(ncol,nz,1) and lonout(ncol) +! and latout(ncol) contain a lon/lat pair for each point of the output grid. +! to achieve this a few variables in this file are overloaded. +! Specifically in the lat/lon case we have nxof=nxo and nyof=nyo and in the ncols case: +! nxo=nyo=ncols +! nxof=ncols +! nyof=1 +!------------------------------------------------------------------ + use shr_kind_mod, only : r8=>shr_kind_r8 + use globals + use preserve_mean, only: monthly_to_midmonth + use interpolate_data, only: bilin, lininterp_init, lininterp, lininterp_finish, interp_type + use netcdf + use error_messages, only : handle_ncerr + + implicit none + + +! +! Arguments +! + integer, intent(in) :: ncprec ! specify 32-bit or 64-bit precision for output variables + character(len=*), intent(in) :: rgridnl ! reduced grid namelist (if applicable) + logical, intent(in) :: isncol ! full grid list of lat/lon pairs instead of rectangular lat by lon grid + integer, intent(in) :: nxi ! first dimension of input array (longitude) + integer, intent(in) :: nz ! second dimension of input and output array (level) + integer, intent(in) :: nyi ! third dimension of input array (latitude) + integer, intent(in) :: nxo ! size of output longitude or ncol array + integer, intent(in) :: nyo ! size of output latitude or ncol array + integer, intent(in) :: ntime ! number of time levels to interpolate + integer, intent(in) :: nxof ! first dimension of output array (longitude or ncol) + integer, intent(in) :: nyof ! third dimension of output array (latitude or 1) +! +! Local workspace +! + character(len=8), parameter :: aerosol_name(naer) = & + (/"MSUL "& + ,"MSSLT "& + ,"MDUST1 "& + ,"MDUST2 "& + ,"MDUST3 "& + ,"MDUST4 "& + ,"MOCPHO "& + ,"MBCPHO "& + ,"MOCPHI "& + ,"MBCPHI "/) + + integer, parameter :: idxsslt = 2 ! index of SSLT + + integer :: lonidi = -1 ! longitude id input file + integer :: latidi = -1 ! latitude id input file + integer :: dateidi = -1 ! date id input file + integer :: datesecidi = -1 ! datesec id input file + integer :: mhybiid = -1 ! MATCH hybi id input file + integer :: mpsid = -1 ! MATCH PS id input file + integer :: species_id(naer) ! aerosol ids input file + + integer :: lonido = -1 ! longitude id output file + integer :: latido = -1 ! latitude id output file + integer :: dateido = -1 ! date id output file + integer :: datesecido = -1 ! datesec id output file + integer :: hybiido = -1 ! MATCH hybi id output file + integer :: psido = -1 ! MATCH PS id output file + integer :: varido(naer) ! aerosol ids output file + integer :: timeido ! time id output filep + + integer :: nlonid ! nlon id output file (if present) + integer :: rlonid ! rlon id output file (if present) + + real(r8) :: tempin(nxi,nz,nyi) ! temp variable for bilinear interpolation + real(r8) :: lonin(nxi) ! longitude on input grid (rectangular) + real(r8) :: latin(nyi) ! latitude on input grid + real(r8) :: m_hybi(nz+1) ! MATCH hybi + real(r8) :: m_ps(nxi,nyi,ntime) ! surface pressure from MATCH + + real(r8) :: tempout(nxof,nz,nyof) ! temp variable for bilinear interpolation + real(r8) :: rlonout(nxof,nyof) ! longitude on output grid (2-d for reduced grid) + real(r8) :: lonout(nxo) ! longitude on output grid (if rectangular) + real(r8) :: latout(nyo) ! latitude on input grid + real(r8) :: M_ps_cam(nxof,nyof,ntime) ! surface pressure from MATCH on cam grid + + integer :: istat ! status return + integer :: i, j, k ! x,y,z indices + integer :: m ! constituent index + integer :: mo ! month index + integer :: dimids(nf90_max_var_dims) ! variable shape on output netcdf file + integer :: date(ntime) ! date (yyyymmdd) + integer :: datesec(ntime) ! seconds of date + integer :: nlonout(nyo) ! number of longitudes per latitude + integer :: start(4) ! starting position in netcdf file + integer :: kount(4) ! number of values to take from netcdf file + integer :: dimcnt + type(interp_type) :: lon_wgts, lat_wgts + +! +! Reduced grid namelist. Fortran insists namelist arrs not be dimensioned +! dynamically +! + integer, parameter :: maxlat = 10000 + integer :: nlon(maxlat) = -1 + namelist /reduced/ nlon + real(r8), parameter :: fillvalue = 1.d36 +! +! a temporary place to store mmr's from files (generated from MATCH runs) +! + real(r8) :: fspecies(nxi,nyi,nz) ! aerosol mmr's from MATCH file + real(r8) :: aerosol(nxof,nyof,nz,ntime) ! aerosol mmr's from MATCH file on CAM grid +!!! real(r8), allocatable :: aerosol(:,:,:,:) ! aerosol mmr's from MATCH file on CAM grid + ! allocate instead of dimension directly to prevent stack overflow + +!!! allocate (aerosol(nxof,nyof,nz,ntime)) +! +! Get required info from input file. +! + call handle_ncerr( nf90_inq_varid (ncidi, 'lon', lonidi),& + 'driver.f90:127') + call handle_ncerr( nf90_inq_varid (ncidi, 'lat', latidi),& + 'driver.f90:129') + call handle_ncerr( nf90_inq_varid (ncidi, 'hybi', mhybiid),& + 'driver.f90:131') + call handle_ncerr( nf90_inq_varid (ncidi, 'PS', mpsid),& + 'driver.f90:133') + call handle_ncerr( nf90_inq_varid (ncidi, 'date', dateidi),& + 'driver.f90:135') + call handle_ncerr( nf90_inq_varid (ncidi, 'datesec', datesecidi),& + 'driver.f90:137') + + call handle_ncerr( nf90_get_var (ncidi, lonidi, lonin),& + 'driver.f90:140') + call handle_ncerr( nf90_get_var (ncidi, latidi, latin),& + 'driver.f90:142') + call handle_ncerr( nf90_get_var (ncidi, mhybiid, m_hybi),& + 'driver.f90:144') + call handle_ncerr( nf90_get_var (ncidi, mpsid, m_ps),& + 'driver.f90:146') + call handle_ncerr( nf90_get_var (ncidi, dateidi, date),& + 'driver.f90:148') + call handle_ncerr( nf90_get_var (ncidi, datesecidi, datesec),& + 'driver.f90:150') +! +! If time variable is not found on output file, create it. +! Then create date and datesec variables. +! + if (nf90_inq_varid (ncido, 'time', timeido) /= nf90_noerr) then + call handle_ncerr( nf90_def_var (ncido, 'time', nf90_double, timedimido, timeido),& + 'driver.f90:157') + end if + call handle_ncerr( nf90_def_var (ncido, 'date', nf90_int, timedimido, dateido),& + 'driver.f90:160') + call handle_ncerr( nf90_def_var (ncido, 'datesec', nf90_int, timedimido, datesecido),& + 'driver.f90:162') +! +! Define hybi and PS on output grid +! + call handle_ncerr( nf90_def_var (ncido, 'hybi', nf90_double, ilevdimido, hybiido),& + 'driver.f90:167') + if(isncol) then + dimids(1:4) = (/ncoldimido, timedimido, -1, -1/) + dimcnt=2 + else + dimids(1:4) = (/londimido, latdimido, timedimido, -1/) + dimcnt=3 + end if + call handle_ncerr( nf90_def_var (ncido, 'PS', ncprec, dimids(1:dimcnt), psido),& + 'driver.f90:176') + call handle_ncerr( nf90_put_att (ncido, psido, '_FillValue', fillvalue),& + 'driver.f90:178') +! +! Read input variable names and define output names accordingly +! Append '_V' to indicate field has been vertically summed from sfc to each level +! + dimcnt=dimcnt+1 + dimids(dimcnt-1:dimcnt+1) = (/levdimido, timedimido, -1/) + do m = 1, naer + call handle_ncerr( nf90_inq_varid (ncidi, trim (aerosol_name(m)), species_id(m)),& + 'driver.f90:187') + call handle_ncerr( nf90_def_var (ncido, trim (aerosol_name(m))//'_V', ncprec, dimids(1:dimcnt), varido(m)),& + 'driver.f90:189') + call handle_ncerr( nf90_put_att (ncido, varido(m), '_FillValue', fillvalue),& + 'driver.f90:191') + end do +! +! Define global attribute "cam-ready" which will be checked for by CAM to prevent +! the use of datasets not run through the interpaerosols procedure. +! + call handle_ncerr( nf90_put_att (ncido, nf90_global, 'cam-ready', 'yes'),& + 'driver.f90:198') +! +! End define mode on output file. Copy required data from input file to output file +! + call handle_ncerr( nf90_enddef (ncido),& + 'driver.f90:203') +! +! Retrieve output grid definition +! + call handle_ncerr( nf90_inq_varid (ncido, 'lat', latido),& + 'driver.f90:208') + call handle_ncerr( nf90_get_var (ncido, latido, latout),& + 'driver.f90:210') +! +! Define nlon and rlon if output file is on reduced grid +! + if (rgridnl /= ' ') then + call handle_ncerr( nf90_redef (ncido),& + 'driver.f90:216') + call handle_ncerr( nf90_def_var (ncido, 'nlon', NF90_INT, latdimido, nlonid),& + 'driver.f90:218') + dimids(:3) = (/londimido, latdimido, -1/); + dimcnt=2 + call handle_ncerr( nf90_def_var (ncido, 'rlon', NF90_DOUBLE, dimids(1:dimcnt), rlonid),& + 'driver.f90:221') + call handle_ncerr( nf90_put_att (ncido, rlonid, '_FillValue', fillvalue),& + 'driver.f90:223') + call handle_ncerr( nf90_enddef (ncido),& + 'driver.f90:225') + open (unit=7, form='formatted', status='old', file=rgridnl, iostat=istat) + if (istat /= 0) then + write(6,*)'Namelist file ', rgridnl, ' cannot be opened for reading' + stop 999 + end if + if (nyo > maxlat) then + write(6,*)'Parameter maxlat must be at least nyo=', nyo + write(6,*)'Should just need to change parameter setting in regrid.f90' + stop 999 + end if + read(7,reduced) + nlonout(:nyo) = nlon(:nyo) + do j=1,nyo + if (nlonout(j) < 1 .or. nlonout(j) > nxo .or. & + nlonout(j) /= nlonout(nyo-j+1)) then + write(6,*)'Bad nlonout value=', nlonout(j) + stop 999 + end if + end do + do j=1,nyo + rlonout(:,j) = fillvalue + do i=1,nlonout(j) + rlonout(i,j) = (i-1)*360./nlonout(j) + end do + end do + else ! full grid: define nlon and rlon + call handle_ncerr( nf90_inq_varid (ncido, 'lon', lonido),& + 'driver.f90:253') + call handle_ncerr( nf90_get_var (ncido, lonido, lonout),& + 'driver.f90:255') + do j=1,nyof + rlonout(:,j) = lonout(:) + nlonout(j) = nxo + end do + end if +! +! interpolate match's surface pressure and get mid-month values +! + if(isncol) then + ! 2 cyclic boundaries, 1 means set to boundary value. + call lininterp_init(lonin, nxi, lonout, nxo, 2, lon_wgts) + call lininterp_init(latin, nyi, latout, nyo, 1, lat_wgts) + do mo=1,ntime + call lininterp(M_ps(:,:,mo),nxi,nyi,M_ps_cam(:,1,mo),nxo,lon_wgts,lat_wgts) + ! print *, 'mean ps month: ',mo,' input: ',sum(M_ps(:,:,mo))/real(nxi*nyi,kind=r8), & + ! ' output: ', sum(M_ps_cam(:,1,mo))/real(nxo,kind=r8) + ! call simplemean(nxi,nyi,nyi,M_ps(:,:,mo),latin) + ! call simplemean(nxo,1,nxo,M_PS_cam(:,:,mo),latout) + ! print *,minval(M_ps(:,:,mo)), maxval(M_ps(:,:,mo)), & + ! minval(M_ps_cam(:,1,mo)), maxval(M_ps_cam(:,1,mo)) + end do + else + do mo=1,ntime + call bilin (M_ps(1,1,mo), lonin, latin, nxi, nxi, & + 1, 1, nyi, M_ps_cam(1,1,mo), rlonout, & + latout, nxo, nlonout, 1, nyo) + print *, 'mean ps month: ',mo,' input: ',sum(M_ps(:,:,mo))/real(nxi*nyi,kind=r8), & + ' output: ', sum(M_ps_cam(:,:,mo))/real(nxo*nyo,kind=r8) + end do + end if + call monthly_to_midmonth (M_ps_cam, 1, nlonout,nxof,nyof,ntime) +! +! Retrieve Aerosol Masses (kg/m^2 in each layer) +! + do m=1,naer + do mo=1,ntime + start(:) = (/1,1,1,mo/) + kount(:) = (/nxi,nyi,nz,1/) + call handle_ncerr( nf90_get_var (ncidi, species_id(m), fspecies, start,kount),& + 'driver.f90:297') +! +! Accumulate mass below each interface level +! note that lowest level (nz+1) is assumed to be zero +! but there isn't even storage for this value in the array +! + do k=nz-1,1,-1 + fspecies(:,:,k) = fspecies(:,:,k) + fspecies(:,:,k+1) + end do +! +! Transpose coords of retrieved aerosols to enable using CAM's bi-linear +! interpolation code. Interpolate onto CAM horizontal grid +! + if(isncol) then + do k=1,nz + call lininterp(fspecies(:,:,k),nxi,nyi,tempout(:,k,1),nxo,lon_wgts,lat_wgts) + end do + else + do k=1,nz + tempin(:,k,:) = fspecies(:,:,k) + end do + call bilin (tempin, lonin, latin, nxi, nxi, & + nz, nz, nyi, tempout, rlonout, & + latout, nxo, nlonout, nz, nyo) + end if + do k=1,nz + do j=1,nyof + do i=1,nlonout(j) + aerosol(i,j,k,mo) = tempout(i,k,j) + end do + end do + end do +! +! Sea Salt over land is minuscule. After interpolation, differencing +! different levels of the cumulative mass can lead to underflow errors. +! To solve this problem, set sea salt to 0 for any column where +! the total mass is less than a threashold which looks like roundoff +! (and is unmeasurable?) +! + if (m == idxSSLT) then + do j=1,nyof + do i=1,nlonout(j) + if (aerosol(i,j,1,mo) < 1.e-24) then + aerosol(i,j,:,mo) = 0. + end if + end do + end do + end if + end do ! mo +! +! convert from monthly average to mid-month values +! + call monthly_to_midmonth (aerosol, nz, nlonout,nxof,nyof,ntime) + + do mo=1,ntime + do j=1,nyof +! +! make sure total column mass total is not negative +! + do i=1,nlonout(j) + aerosol(i,j,1,mo) = max (aerosol(i,j,1,mo), 0._r8) + end do +! +! make function non-increasing and positive +! + do k=2,nz + do i=1,nlonout(j) + aerosol(i,j,k,mo) = min (aerosol(i,j,k,mo), aerosol(i,j,k-1,mo)) + aerosol(i,j,k,mo) = max (aerosol(i,j,k,mo), 0._r8) + end do + end do + do k=1,nz + do i=nlonout(j)+1,nxo + aerosol(i,j,k,mo) = fillvalue + end do + end do + end do +! +! Write interpolated data to output file +! + if(isncol) then + start(:) = (/1,1,mo,-1/) + kount(:) = (/nxo,nz,1,-1/) + else + start(:) = (/1,1,1,mo/) + kount(:) = (/nxo,nyo,nz,1/) + end if + call handle_ncerr( nf90_put_var (ncido, varido(m), aerosol(:,:,:,mo),start,kount),& + 'driver.f90:385') + end do ! loop over months (mo) + end do ! loop over constituents (m) + + call handle_ncerr( nf90_put_var (ncido, hybiido, m_hybi),& + 'driver.f90:390') + + if (rgridnl /= ' ') then + call handle_ncerr( nf90_put_var (ncido, nlonid, nlon),& + 'driver.f90:394') + call handle_ncerr( nf90_put_var (ncido, rlonid, rlonout),& + 'driver.f90:396') + end if + + do mo=1,ntime + do j=1,nyof + do i=nlonout(j)+1,nxo + M_ps_cam(i,j,mo) = fillvalue + end do + end do + if(isncol) then + start(:) = (/1,mo,-1,-1/) + kount(:) = (/nxo,1,-1,-1/) + else + start(:) = (/1,1,mo,-1/) + kount(:) = (/nxo,nyo,1,-1/) + end if + call handle_ncerr( nf90_put_var (ncido, psido, M_ps_cam(:,:,mo),start,kount),& + 'driver.f90:413') + + start(:) = (/mo,-1,-1,-1/) + kount(:) = (/1,-1,-1,-1/) + call handle_ncerr( nf90_put_var (ncido, dateido, date(mo:mo),start,kount),& + 'driver.f90:418') + call handle_ncerr( nf90_put_var (ncido, datesecido, datesec(mo:mo),start,kount),& + 'driver.f90:420') + end do + +!!! deallocate (aerosol) + return +end subroutine driver + +subroutine simplemean(n1,n2,n3,f,lat) + use shr_kind_mod, only : r8=>shr_kind_r8 + integer, intent(in) :: n1, n2, n3 + real(r8), intent(in) :: f(n1,n2) + real(r8), intent(in) :: lat(n3) + real(r8) :: mean, wgt + integer :: i, j + + + if(n2==1) then + mean = sum(f(:,1)*cos(lat))/sum(cos(lat)) + else + mean = 0. + wgt = 0. + do j=1,n2 + do i=1,n1 + wgt = wgt+cos(lat(j)) + mean = mean+f(i,j)*cos(lat(j)) + end do + end do + mean = mean/wgt + end if + print *, 'weighted mean = ',mean + +end subroutine simplemean diff --git a/tools/interpaerosols/fmain.F90 b/tools/interpaerosols/fmain.F90 new file mode 100644 index 0000000000..c1b8afbf15 --- /dev/null +++ b/tools/interpaerosols/fmain.F90 @@ -0,0 +1,236 @@ +program fmain +!------------------------------------------------------------------ +! Purpose: +! Usage: interpaerosols [-d] [-r rgridnl] [-v] +! +! Horizontally interpolate file containing aerosol masses (infile.nc) +! to CAM grid (as specified by outfile.nc). Perl script REGRID.pl +! contained in this directory can be used to create a template +! outfile.nc. +! +! Sum the values in the vertical such that output arrays contain the +! column sum from the bottom of the atmosphere to that level. +! Convert monthly averages to mid month values. +! Input file assumed to be MATCH ncep runs, averaged by month. +! and backsolved to provide Mid-month values) +! +! Method: +! read data from file +! interpolate data onto CAM horizontal grid +! +!------------------------------------------------------------------ + use globals + use netcdf + use error_messages, only : handle_ncerr + + implicit none + +! +! Local workspace +! + character(len=80) :: arg = ' ' ! cmd line arg + character(len=80) :: rgridnl = ' ' ! reduced grid namelist (if applicable) + character(len=256) :: infile = ' ' ! input file name + character(len=256) :: outfile = ' ' ! output file name + character(len=256) :: cmdline = ' ' ! command line + + integer :: n ! argument counter + integer :: nargs ! number of command line arguments + integer :: ncprec = nf90_float ! default precision to write data + integer :: old_mode ! returned from nf90_set_fill + integer :: ret ! return code + + logical :: verbose = .false. ! verbose output + logical :: isncol = .false. + integer iargc + external iargc + integer :: nxi,nyi,nxo,nyo,nz,ntime,nyof +! +! Default settings before parsing argument list +! + nargs = iargc() + n = 1 + cmdline = 'interpaerosols ' + do while (n <= nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + + select case (arg) + case ('-d') + ncprec = nf90_double + cmdline = trim(cmdline) // ' -d' + case ('-r') + call getarg (n, arg) + n = n + 1 + rgridnl = arg + cmdline = trim(cmdline) // ' -r ' // trim(rgridnl) + case ('-v') + verbose = .true. + cmdline = trim(cmdline) // ' -v' + case default + if (infile == ' ') then + infile = arg + else if (outfile == ' ') then + outfile = arg + else + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end if + cmdline = trim(cmdline) // ' ' // trim(arg) + end select + end do + + if (infile == ' ' .or. outfile == ' ') then + call usage_exit ('Must enter an input file and an output file') + end if +! +! Open input and output netcdf files +! + call handle_ncerr( nf90_open (infile, NF90_NOWRITE, ncidi),& + 'fmain.F90:90') + call handle_ncerr( nf90_open (outfile, NF90_WRITE, ncido),& + 'fmain.F90:92') + ret = nf90_set_fill (ncido, NF90_NOFILL, old_mode) + if (ret /= NF90_NOERR) then + write(6,*)'Error calling nf90_set_fill:' + write(6,*)nf90_strerror (ret) + stop 999 + end if + ! start in define mode on output file + call handle_ncerr( nf90_redef (ncido), & + 'fmain.F90:100') +! +! Get input and output dimensions for x, y, time +! Input file first +! + call handle_ncerr( nf90_inq_dimid (ncidi, 'lon', londimidi),& + 'fmain.F90:106') + call handle_ncerr( nf90_inquire_dimension (ncidi, londimidi, len=nxi),& + 'fmain.F90:108') + + call handle_ncerr( nf90_inq_dimid (ncidi, 'lat', latdimidi),& + 'fmain.F90:111') + call handle_ncerr( nf90_inquire_dimension (ncidi, latdimidi, len=nyi),& + 'fmain.F90:113') + + call handle_ncerr( nf90_inq_dimid (ncidi, 'lev', levdimidi),& + 'fmain.F90:116') + ! nz is the same for input and output + call handle_ncerr( nf90_inquire_dimension (ncidi, levdimidi, len=nz), & + 'fmain.F90:118') + + call handle_ncerr( nf90_inq_dimid (ncidi, 'time', timedimidi),& + 'fmain.F90:121') + call handle_ncerr( nf90_inquire_dimension (ncidi, timedimidi, len=ntime),& + 'fmain.F90:123') +! +! Ensure ntime is 12. Reason is because mean-preserving code for the moment assumes it. +! + if (ntime /= 12) then + write(6,*) 'Size of input time dimension must be 12' + stop 999 + end if +! +! Now output file +! + + ret = nf90_inq_dimid (ncido, 'lon', londimido) + if(ret==nf90_EBADDIM ) then + call handle_ncerr( nf90_inq_dimid(ncido, 'ncol',ncoldimido),& + 'fmain.F90:139') + call handle_ncerr( nf90_inquire_dimension (ncido, ncoldimido, len=nxo),& + 'fmain.F90:141') + nyo=nxo + nyof=1 + isncol=.true. + else if(ret==NF90_NOERR) then + call handle_ncerr( nf90_inquire_dimension (ncido, londimido, len=nxo),& + 'fmain.F90:147') + call handle_ncerr( nf90_inq_dimid (ncido, 'lat', latdimido),& + 'fmain.F90:149') + call handle_ncerr( nf90_inquire_dimension (ncido, latdimido, len=nyo),& + 'fmain.F90:151') + nyof=nyo + else + call handle_ncerr( ret,'fmain.F90:156') + end if + +! +! Assume z dimensions on output file don't exist (code will crash if they do) +! This way it will be guaranteed to match input file. +! + call handle_ncerr( nf90_def_dim (ncido, 'lev', nz, levdimido),& + 'fmain.F90:160') + call handle_ncerr( nf90_def_dim (ncido, 'ilev', nz+1, ilevdimido),& + 'fmain.F90:162') +! +! If a time dimension is not found on the output file, create it +! + if (nf90_inq_dimid (ncido, 'time', timedimido) /= nf90_noerr) then + call handle_ncerr( nf90_def_dim (ncido, 'time', nf90_unlimited, timedimido),& + 'fmain.F90:168') + end if +! +! Add global attributes +! + call addglobal (ncido, cmdline) +! +! Call driver code to read the input data and do the interpolations and/or copies +! + if(isncol) then + nyof = 1 + else + nyof = nyo + end if + call driver (ncprec, rgridnl,isncol,nxi,nyi,nxo,nyo,nz,ntime,nxo,nyof) +! +! Close netcdf files. This is crucial for output file in particular in order +! to ensure that all data get written to the file. +! + call handle_ncerr( nf90_close (ncidi),& + 'fmain.F90:188') + call handle_ncerr( nf90_close (ncido),& + 'fmain.F90:190') + + write(6,*)'Successfully interpolated aerosol data to file ', trim (outfile) + + stop 0 +end program fmain + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg /= ' ') write (6,*) arg + write (6,*) 'Usage: interpaerosols [-d] [-r rgridnl] [-v] infile.nc outfile.nc' + write (6,*) ' -d: write output file in double precision' + write (6,*) ' -r rgridnl: define output on reduced grid defined by nlon in namelist' + write (6,*) ' -v: verbose printout' + stop 999 +end subroutine usage_exit + +#ifdef UNICOSMP +subroutine getarg (n, arg) + implicit none + integer, intent(in) :: n + character(len=*), intent(out) :: arg + + integer :: ilen + integer :: ierr + + call pxfgetarg (n, arg, ilen, ierr) + if (ierr /= 0) then + write(6,*)'getarg: ierr not 0:', ierr + stop 999 + end if + return +end subroutine getarg + +integer function iargc () + integer, external :: ipxfargc + + iargc = ipxfargc () + return +end function iargc +#endif diff --git a/tools/interpaerosols/globals.f90 b/tools/interpaerosols/globals.f90 new file mode 100644 index 0000000000..f6c621f3ff --- /dev/null +++ b/tools/interpaerosols/globals.f90 @@ -0,0 +1,27 @@ +module globals + integer, parameter :: naer=10 ! number of aerosol species + + integer :: ncidi = -1 ! input necdf file id + integer :: londimidi = -1 ! longitude dimension id input file + integer :: latdimidi = -1 ! latitude dimension id input file + integer :: levdimidi = -1 ! level dimension id input file + integer :: timedimidi = -1 ! time dimension id input file + +! integer :: nxi = -1 ! x-dimension size input file +! integer :: nyi = -1 ! y-dimension size input file + + integer :: ncido = -1 ! output necdf file id + integer :: londimido = -1 ! longitude dimension id output file + integer :: latdimido = -1 ! latitude dimension id output file + integer :: ncoldimido = -1 ! ncol dimension id output file only for 1d horizontal files + integer :: levdimido = -1 ! level dimension id output file + integer :: ilevdimido = -1 ! interface dimension id output file + integer :: timedimido = -1 ! time dimension id output file + +! integer :: nxo = -1 ! x-dimension size output file +! integer :: nyo = -1 ! y-dimension size output file + +! integer :: nz = -1 ! z-dimension size input and output files +! integer :: ntime = -1 ! time-dimension size input and output files +end module globals + diff --git a/tools/interpaerosols/preserve_mean.f90 b/tools/interpaerosols/preserve_mean.f90 new file mode 100644 index 0000000000..07960efe09 --- /dev/null +++ b/tools/interpaerosols/preserve_mean.f90 @@ -0,0 +1,154 @@ +module preserve_mean + + use shr_kind_mod, only : r8=>shr_kind_r8 +! use globals, only: nxo, nyo, ntime + + implicit none + private + public :: monthly_to_midmonth +contains + +subroutine monthly_to_midmonth (arr, nlev, nlonout,nxo,nyo,ntime) +!------------------------------------------------------------------- +! +! Input/Output: +! AEROSOL, M_ps_cam from monthly averages to mid-month values +! +!-------------------------------------------------------------------- +! +! Arguments +! + integer, intent(in) :: nlev + integer, intent(in) :: nxo,nyo,ntime + integer, intent(in) :: nlonout(nyo) + real(r8), intent(inout) :: arr(nxo,nyo,nlev,ntime) ! input/output array +! +! Local workspace +! + real(r8) Matrix(1:12,1:12) ! map from mid-month to monthly average + integer pivot(12) ! pivot from LU factor + real(r8) vec(12) ! vector to be used for LU solve + integer i,j,k ! spatial indices + integer :: m ! constituent index +! +! ntime must be 12 +! + if (ntime /= 12) then + write(6,*) 'monthly_to_midmonth: ntime must be 12 got ', ntime + stop 999 + end if +! +! construct and factor linear map from +! mid month values to monthly averages +! + call construct_matrix (Matrix, pivot) +! +! convert monthly averages to mid-month values +! could be sped up by solving many rhs at once +! rather than one at a time. +! + do k=1,nlev + do j=1,nyo + do i=1,nlonout(j) + vec(:) = arr(i,j,k,:) + call LUSolve (vec, Matrix, pivot) + arr(i,j,k,:) = vec(:) + end do + end do + end do + + return +end subroutine monthly_to_midmonth + +subroutine construct_matrix (Matrix, pivot) +!-------------------------------------------------------------------- +! Input: None +! +! Output: +! Matrix (LU Factored form) +! pivot (pivots corresponding to LU Factored form of matrix) +! +! Method: +! construct matrix representing averaging +! from mid-monthly values +! to monthly average values +! factor matrix (matrix => LUFactoredMatrix, pivots) so that the +! backsolves represent map from averages to mid-month values +!-------------------------------------------------------------------- + + real(r8), intent(out) :: Matrix(12,12) !map from mid-month values to monthly average + integer, intent(out) :: pivot(12) ! pivots from LU factorization of Matrix + + integer row, col, colp, colm ! indexes ino matrix + real(r8) :: Len(12) ! number of days in month + data Len /31.0, 28.0, 31.0, 30.0, 31.0, 30.0, 31.0, 31.0, 30.0, 31.0, 30.0, 31.0 / + + Matrix(:,:) = 0.0 +! +! construct tridiagonal cyclic matrix +! + do row = 1,12 + col = row + colm = row - 1 + colp = row + 1 + if (colm == 0) then + colm = 12 + endif + if (colp == 13) then + colp = 1 + endif + Matrix(row,colm) = Len(row) / (4*(Len(row )+Len(colm))) + Matrix(row,colp) = Len(row) / (4*(Len(colp)+Len(row ))) + Matrix(row,col ) = 1.0 - Matrix(row,colm) - Matrix(row,colp) + enddo + + call LUFactor (Matrix, pivot); + + return +end subroutine construct_matrix + + +subroutine LUFactor (Matrix, pivot) +!----------------------------------------------------------------- +! interface to matrix factorization routine +! here, LAPACK +!----------------------------------------------------------------- + + real(r8) Matrix(12,12) ! matrix to be factored + integer pivot(12) ! pivots from factorization + integer :: info = 0 ! did factorization fail? + + call DGETRF (12, 12, Matrix, 12, pivot, info) + if (info < 0) then + write(6,*)"AEROSOL_INITIALIZE:DGETRF (LAPACK) factor argument ",-info," has illegal value" + stop 999 + elseif(info > 0) then + write(6,*)"AEROSOL_INITIALIZE:DGETRF (LAPACK) factor matrix upper element ",info," was zero" + stop 999 + endif + + return +end subroutine LUFactor + + +subroutine LUSolve (vec, Matrix, pivot) +!----------------------------------------------------------------- +! interface to matrix back-solve routine +! here, LAPACK +!----------------------------------------------------------------- + + real(r8) vec(12) ! vector to be solved. vector then solution + real(r8) Matrix(12,12) ! factored matrix + integer pivot(12) ! pivots from factorization + integer :: info = 0 ! did solve fail? + + call DGETRS ('N', 12, 1, Matrix, 12, pivot, vec, 12, info) + if (info < 0) then + write(6,*)"AEROSOL_INITIALIZE:DGETRS (LAPACK) solve argument ",-info," has illegal value" + stop 999 + endif + + return +end subroutine LUSolve + +end module preserve_mean diff --git a/tools/interpic/Makefile b/tools/interpic/Makefile new file mode 100644 index 0000000000..ccbfd1f01a --- /dev/null +++ b/tools/interpic/Makefile @@ -0,0 +1,129 @@ +# Makefile to build interpic on various platforms +# Note: If netcdf library is not built in the standard location, you must set the environment +# variables INC_NETCDF and LIB_NETCDF + +EXEDIR = . +EXENAME = interpic +RM = rm + +.SUFFIXES: +.SUFFIXES: .f90 .o + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +# Architecture-specific flags and rules +# +#------------------------------------------------------------------------ +# Cray +#------------------------------------------------------------------------ + +ifeq ($(UNAMEM),CRAY) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) +FC = f90 +FFLAGS = -64 -c -trapuv -I$(INC_NETCDF) -g -C -DEBUG:trap_uninitialized=ON +LDFLAGS = -64 -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# SUN +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),SunOS) +FC = f90 +FFLAGS = -c -stackvar -f -I$(INC_NETCDF) -g +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) -qsuffix=f=f90 +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# OSF1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),OSF1) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) +FC = pgf90 +FFLAGS = -c -I$(INC_NETCDF) -fast +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) +FC = ifort +FFLAGS = -c -I$(INC_NETCDF) -ftz -g -traceback +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := control.o dimensions.o driver.o err_exit.o fill_positions.o fmain.o \ + handle_special_cases.o interp_driver.o is_special_case.o lininterp.o \ + shr_kind_mod.o varspecs_mod.o wrap_nf.o cpvar.o compare_var.o addglobal.o + +.f90.o: + $(FC) $(FFLAGS) $< + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +control.o: control.f90 +cpvar.o: cpvar.f90 shr_kind_mod.o +dimensions.o: dimensions.f90 shr_kind_mod.o +driver.o: driver.f90 shr_kind_mod.o varspecs_mod.o control.o dimensions.o fill_positions.o +err_exit.o: err_exit.f90 +fill_positions.o: fill_positions.f90 shr_kind_mod.o dimensions.o varspecs_mod.o +fmain.o: fmain.f90 control.o dimensions.o +handle_special_cases.o: handle_special_cases.f90 shr_kind_mod.o +interp_driver.o: interp_driver.f90 shr_kind_mod.o varspecs_mod.o +is_special_case.o: is_special_case.f90 +lininterp.o: lininterp.f90 shr_kind_mod.o +shr_kind_mod.o: shr_kind_mod.f90 +varspecs_mod.o: varspecs_mod.f90 shr_kind_mod.o +wrap_nf.o: wrap_nf.f90 shr_kind_mod.o +compare_var.o: compare_var.f90 varspecs_mod.o +addglobal.o: addglobal.f90 diff --git a/tools/interpic/README b/tools/interpic/README new file mode 100644 index 0000000000..33a29f8087 --- /dev/null +++ b/tools/interpic/README @@ -0,0 +1,95 @@ +Running gnumake in this directory will create an executable named "interpic". +Its function is to take an input CAM history tape in netcdf format +and interpolate the all time sample to an arbitrary +horizontal and/or vertical resolution. The primary reason one would want to +do this is to create an initial dataset at a resolution for which they don't +already have one. The code will also automatically reorder the dimensions on +the created file (if necessary) so that it can be input to the CAM. + +Output horizontal and vertical resolution is specified by a template netcdf +file ("-t template_file"). Output file contents are the intersection of +fields specified on the template file and the input file. + +To create a template file you can use the NCL script create_template.ncl. +Edit the parameters at the top of the script and then run with + +ncl < create_template.ncl + + +Note: When creating Lin/Rood template files from Guassian grids! + +After running create_template.ncl and interpic, you will need to +rename the U and V fields to US and VS. This is easy to do with +the netCDF operator (NCO) ncrename as follows... + +ncrename -v U,US -v V,VS filename.nc + +======================================================================================= + +So here is the complete sequence you need to follow to create a new dataset. + +1.) Edit the "create_template.ncl" script as needed for you case. +2.) Run "create_template.ncl" to produce the template file. +3.) Build and run "interpic" on the template file you produced. +4.) For a Lin-Rood case, you then need to rename U and V to US and VS. + +1.) Edit the "create_template.ncl" script as needed for you case. + +Edit "create_template.ncl", for the case you wish to create. The most important +settings are: + + nlat = 73; ; Number of latitudes + nlon =120; ; Number of longitudes + nlev = 26; ; Number of vertical levels + ntrm = 21; ; Truncation in "M" + ntrk = 21; ; Truncation in "K" + ntrn = 21; ; Truncation in "N" + ; Grid type ("gaussian", "staggered" or "reduced") + grid = "staggered"; + ; Filename to interpolate from + interpfilename = "/fs/cgd/csm/inputdata/atm/cam1/inic/SEP1.T42L26.112000.nc"; + + +Which define the grid-type, and horizontal and vertical resolution you would like to have +on your output grid. "interpfilename" is the file you wish to interpolate from. Standard +levels are defined for 18, 26 and 30 levels, if you need non-standard vertical levels +you will also have to edit the next section of the file, so that the right hybrid +surfaces are used. + +Note: "interpfilename" needs to match the filename you will give to "interpic" +to interpolate from in step 3 below. + +2.) Run "create_template.ncl" to produce the template file. + +This is done by simply... + + ncl < create_template.ncl + +You do need a current version of NCAR Graphics command Language (NCL) to run the script. + +3.) Build and run "interpic" on the template file you produced. + +To build interpic. + + gmake + +Make sure the envrionment variables INC_NETCDF and LIB_NETCDF are set to the location +where the NetCDF library is on your system. + +To run first make sure your system's stacksize is sufficiently large. + +limit stacksize unlimited + +Then run with + + interpic -t template_file interpfilename outputfilename + +Note: "interpfilename" above HAS TO match the value you set when you edited +the "create_template.ncl" script. + +4.) For a Lin-Rood case, you then need to rename U and V to US and VS. + +When interpolating from a Gaussian grid to a Lin-Rood grid you then need to rename +U and V to US and VS. + + ncrename -v U,US -v V,VS filename.nc diff --git a/tools/interpic/addglobal.f90 b/tools/interpic/addglobal.f90 new file mode 100644 index 0000000000..78f04d520b --- /dev/null +++ b/tools/interpic/addglobal.f90 @@ -0,0 +1,61 @@ +subroutine addglobal (ncid, cmdline) + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + character*(*) cmdline +! +! Local workspace +! + integer ret + integer numchars + integer values(8) + integer hnum + integer hlen + + character*8 date + character*10 time + character*5 zone + character*18 datetime + character*16 logname + character*16 hostname + character*1500 :: hist + + call date_and_time (date, time, zone, values) + + datetime(1:8) = date(5:6) // '/' // date(7:8) // '/' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + + call getenv ('LOGNAME', logname) + call getenv ('HOST', hostname) + + hlen = 0 + hist = ' ' + if (nf_inq_attid (ncid, nf_global, 'history', hnum) == nf_noerr) then + ret = nf_inq_attlen (ncid, nf_global, 'history', hlen) + call wrap_get_att_text (ncid, nf_global, 'history', hist) + end if + + hist = trim (hist) // char(10) // datetime // trim (logname) // ':' // & + trim (hostname) // ':' // trim (cmdline) +! +! Add 3 to account for 1st newline and colons between each of 2 trimmed strings +! + hlen = hlen + len(datetime) + len_trim(logname) + len_trim(hostname) + & + len_trim(cmdline) + 3 + + if (hlen > len (hist)) then + write(6,*)'Warning: history attribute too long: truncating' + hlen = len (hist) + end if + + numchars = len_trim (hist) + ret = nf_put_att_text (ncid, nf_global, 'history', numchars, hist) + + return +end subroutine addglobal + + diff --git a/tools/interpic/compare_var.f90 b/tools/interpic/compare_var.f90 new file mode 100644 index 0000000000..10b66c2b40 --- /dev/null +++ b/tools/interpic/compare_var.f90 @@ -0,0 +1,32 @@ +subroutine compare_var (vari, varo) + use varspecs_mod, only: varspecs + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + type(varspecs) :: vari + type(varspecs) :: varo +! +! Local workspace +! + logical isfloatingi + logical isfloatingo + + if (vari%name /= varo%name) then + write(6,*)'compare_var: names do not match: ', trim(vari%name), trim(varo%name) + stop 999 + end if + + isfloatingi = vari%xtype == nf_float .or. vari%xtype == nf_double + isfloatingo = varo%xtype == nf_float .or. varo%xtype == nf_double + + if (vari%xtype /= varo%xtype .and. .not. (isfloatingi .and. isfloatingo)) then + write(6,*)'compare_var: types are incompatible for: ', & + trim(vari%name), ' ', trim(varo%name) + end if + + return +end subroutine compare_var diff --git a/tools/interpic/control.f90 b/tools/interpic/control.f90 new file mode 100644 index 0000000000..51394e58ba --- /dev/null +++ b/tools/interpic/control.f90 @@ -0,0 +1,8 @@ +module control + logical verbose + logical silent + logical compute_gauss + + integer unlimdimid + integer unlimdimidi +end module control diff --git a/tools/interpic/cpvar.f90 b/tools/interpic/cpvar.f90 new file mode 100644 index 0000000000..a9fb3638ed --- /dev/null +++ b/tools/interpic/cpvar.f90 @@ -0,0 +1,56 @@ +subroutine cpvar (ncidi, ncido, vi, vo, name, & + totsiz, xtype, start, count) + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncidi, ncido + integer vi, vo + integer xtype + integer start(nf_max_var_dims) + integer count(nf_max_var_dims) + integer totsiz + + character*(nf_max_name) :: name +! +! Local workspace +! + character, allocatable :: cbuf(:) + real(r8), allocatable :: buf(:) + integer, allocatable :: ibuf(:) + + if (xtype == NF_FLOAT .or. xtype == NF_DOUBLE) then + + allocate (buf(totsiz)) + call wrap_get_vara_double (ncidi, vi, start, count, buf) + call wrap_put_vara_double (ncido, vo, start, count, buf) + deallocate (buf) + + else if (xtype == NF_INT) then + + allocate (ibuf(totsiz)) + call wrap_get_vara_int (ncidi, vi, start, count, ibuf) + call wrap_put_vara_int (ncido, vo, start, count, ibuf) + deallocate (ibuf) + + else if (xtype == NF_CHAR) then + + allocate (cbuf(totsiz)) + call wrap_get_vara_text (ncidi, vi, start, count, cbuf) + call wrap_put_vara_text (ncido, vo, start, count, cbuf) + deallocate (cbuf) + + else + + write(6,*)'Unknown type for variable ',name + stop 999 + + end if + + return +end subroutine cpvar diff --git a/tools/interpic/create_template.ncl b/tools/interpic/create_template.ncl new file mode 100644 index 0000000000..f42b70ad6d --- /dev/null +++ b/tools/interpic/create_template.ncl @@ -0,0 +1,206 @@ +; +; create_template.ncl +; +; Purpose: Provide a easier mechanism to create the +; template file to interpolate a dataset. The +; template file is used by interpic to interpolate a +; given file. Use the same file both here and in +; interpic. +; +; Method: Set grid sizes and variables at top of +; script. Copy variables and needed values from +; file that will be interpolated. Use the template.ncl +; subroutines to do most of the work. +; +; Usage: Edit the settings in the first section. Make sure +; everything is set as it should. Then... +; +; ncl < create_template.ncl +; +; Settings for the standard configurations of 18, 26, and +; 30 levels are given. If you need to change the standard +; configuration, or if you need a different number of levels +; you will have to edit the section that sets the hybrid levels. +; +; Author: Erik Kluzek +; +; $Id$ +; +begin +;----------------------------------------------------------------------------------- +; Here are all the important settings. You must edit these by hand +; The following global variables must be set. +; +; nlat Number of latitudes +; nlon Number of longitudes +; nlev Number of levels +; grid Grid type (staggered, reduced or gaussian) +; ntrm Number of wave truncation for M (Gaussian and reduced grid only) +; ntrk Number of wave truncation for K (Gaussian and reduced grid only) +; ntrn Number of wave truncation for N (Gaussian and reduced grid only) +; interpfilename Filename of file interpolating from +; templatefilename Output filename of template creating +; caseid case id (max 16 characters) +; nlons Array of number of longitudes for each latitude (reduced grid only) +; var_type Output type of fields creating +; nstandard Array of the number of levels for various standard level configurations +; hyai_standard Hybrid "A" interface levels for the standard levels. +; hybi_standard Hybrid "B" interface levels for the standard levels. +; FillValue Value to give the missing value +; nchar Number of characters to use for character data. +; dimnames Names of the dimensions for the file +; dsizes Dimension sizes. +; is_unlim Logical array to indicate if a dimension is unlimited or not. +; rlon reduced grid longitudes (reduced grid only) +; lat Latitudes +; lon Longitudes +; slat Staggered latitudes (staggered only) +; slon Staggered longitudes (staggered only) +; gw Gaussian weights +; w_stag Staggered weights (staggered only) +; +;----------------------------------------------------------------------------------- + nlat = 19; ; Number of latitudes + nlon = 24; ; Number of longitudes + nlev = 26; ; Number of vertical levels + ntrm = 0; ; Truncation in "M" + ntrk = 0; ; Truncation in "K" + ntrn = 0; ; Truncation in "N" + ; Grid type ("gaussian", "staggered" or "reduced") + grid = "staggered"; + ; Filename to interpolate from + interpfilename = "/fs/cgd/csm/inputdata/atm/cam1/inic/gaus/SEP1.T42L26.fland.c020402.nc"; + caseid = "interp_newsstclim03Br"; ; Case id to use on output template file + ; Name of output filename + if ( grid .eq. "staggered" )then + templatefilename = "SEP1."+nlat+"x"+nlon+"L"+nlev+"."+grid+".template.nc"; + else + templatefilename = "SEP1.T"+ntrm+"L"+nlev+"."+grid+".template.nc"; + end if + ; number of longitudes used For reduced grids only + if ( grid .eq. "reduced" )then + nlons = new( nlat, integer ); + nlons(:nlat-1) = (/10, 16, 30, 32, 40, 48, 50, 60, 64, 72, 80, 80, 90, \ + 90, 96, 100, 108, 108, 120, 120, 120, 120, 128, 128, 128, 128, 128, 128, \ + 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 120, \ + 120, 120, 120, 108, 108, 100, 96, 90, 90, 80, 80, 72, 64, 60, 50, 48, 40, \ + 32, 30, 16, 10 /); + end if +;----------------------------------------------------------------------------------- +; "Standard" definitions of hybrid coefficents for given level numbers. +; You only need to edit this if you need to go to a non-standard number of levels. +; Or if you need to change the levels for these cases. +;----------------------------------------------------------------------------------- + var_type = "double"; ; Output type for variables creating + hyai_standard= new( (/3,50/), var_type ); + hybi_standard = new( dimsizes(hyai_standard), var_type ); + nstandard = (/19,27,31/); ; Sizes of hyai for each set + hyai_standard(0,:nstandard(0)-1) = \ + (/0.00251499470323319, 0.00710360519587988, 0.0190425943583249, \ + 0.046075608581305, 0.081818588078022, 0.0786980539560318, \ + 0.0746317282319069, 0.0695530474185939, 0.0633905678987499, \ + 0.0562177114188669, 0.0481529273092749, 0.039492335170507, \ + 0.0305845476686949, 0.0219334047287699, 0.01403667870909, \ + 0.0074586505070329, 0.0026468755677342, 0.0, 0.0/); + hybi_standard(0,:nstandard(0)-1) = \ + (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0375697687268259, 0.0865262672305107, \ + 0.147671163082119, 0.22186444699764, 0.308222115039829, 0.40531820058823, \ + 0.509587526321408, 0.616832911968228, 0.720988512039177, \ + 0.81606125831604, 0.895257532596588, 0.953188955783837, \ + 0.985056042671197, 1./); + ; Hybrid coefficients for standard 26 level case + hyai_standard(1,:nstandard(1)-1) = \ + (/0.00219406700000001, 0.00489520900000001, 0.009882418, 0.01805201, \ + 0.02983724, 0.0446233400000002, 0.0616058700000002, 0.0785124300000004, \ + 0.0773127100000002, 0.0759013100000003, 0.0742408600000002, \ + 0.0722874400000002, 0.0699893299999998, 0.06728574, 0.06410509, \ + 0.0603632200000002, 0.0559611100000001, 0.0507822500000001, \ + 0.0446896000000001, 0.0375219099999999, 0.0290894900000001, 0.02084739, \ + 0.01334443, 0.00708499000000001, 0.00252136, 0.0, 0.0 /) ; + + hybi_standard(1,:nstandard(1)-1) = \ + (/0, 0, 0, 0, 0, 0, 0, 0, 0.01505309, 0.03276228, 0.05359622, \ + 0.0781062700000006, 0.1069411, 0.140863700000001, 0.180772, 0.227722, \ + 0.282956200000001, 0.347936400000002, 0.4243822, 0.514316800000003, \ + 0.620120200000002, 0.723535500000004, 0.817676800000001, \ + 0.896215300000001, 0.953476100000003, 0.9851122, 1.0 /) ; + ; Hybrid coefficients for standard 30 level case + hyai_standard(2,:nstandard(2)-1) = \ + (/0.00225523952394724, 0.00503169186413288, 0.0101579474285245, \ + 0.0185553170740604, 0.0306691229343414, 0.0458674766123295, \ + 0.0633234828710556, 0.0807014182209969, 0.0949410423636436, \ + 0.11169321089983, 0.131401270627975, 0.154586806893349, \ + 0.181863352656364, 0.17459799349308, 0.166050657629967, \ + 0.155995160341263, 0.14416541159153, 0.130248308181763, \ + 0.113875567913055, 0.0946138575673103, 0.0753444507718086, \ + 0.0576589405536652, 0.0427346378564835, 0.0316426791250706, \ + 0.0252212174236774, 0.0191967375576496, 0.0136180268600583, \ + 0.00853108894079924, 0.00397881818935275, 0, 0 /); + hybi_standard(2,:nstandard(2)-1) = \ + (/0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0393548272550106, \ + 0.0856537595391273, 0.140122056007385, 0.204201176762581, \ + 0.279586911201477, 0.368274360895157, 0.47261056303978, \ + 0.576988518238068, 0.672786951065063, 0.753628432750702, \ + 0.813710987567902, 0.848494648933411, 0.881127893924713, \ + 0.911346435546875, 0.938901245594025, 0.963559806346893, \ + 0.985112190246582, 1 /); +;----------------------------------------------------------------------------------- +; These are things that you won't have to worry about except with special grids +; Set the dimensions, latitudes, longitudes, and gaussian weights. +; All of this depends on the grid type. Right now it does the right thing +; for "gaussian" , "reduced" and "staggered" grids. +;----------------------------------------------------------------------------------- + FillValue = new( 1, var_type ); + FillValue = 1.e36; ; Missing fill value to use + ; + ; Output dimension names and sizes (and the one that is unlimited + ; + nchar = 8; + ntimes = 1; + if ( (grid .eq. "gaussian") .or. (grid .eq. "reduced") )then + dimnames = (/"lat", "lon", "lev", "ilev", "time", "chars" /); + dsizes = (/nlat, nlon, nlev, nlev+1, ntimes, nchar/); + is_unlim = (/False, False, False, False, True, False/); + else + if ( grid .eq. "staggered" )then + dimnames = (/"lat", "lon", "lev", "ilev", "slat", "slon", "time", "chars" /); + dsizes = (/nlat, nlon, nlev, nlev+1, nlat-1, nlon, ntimes, nchar /); + is_unlim = (/False, False, False, False, False, False, True, False /); + else + print( "ERROR::Invalid grid type:"+grid ); + print( "Valid grids are: gaussian, reduced or staggered" ); + exit; + end if + end if + ; + ; Reduced grid + ; + if ( grid .eq. "reduced" )then + rlon = new( (/nlat,nlon/), var_type ); + end if + if ( grid .eq. "staggered" )then + ; + ; Staggered grid + ; + slat = new( nlat-1, var_type ); + slon = new( nlon, var_type ); + w_stag = new( nlat-1, var_type ); + end if + gw = new( nlat, var_type ); + lat = new( nlat, var_type ); + lon = new( nlon, var_type ); + + load "template.ncl"; + + get_standard_lat_and_longs( ); + settings( ); + system( "/bin/rm " + templatefilename ); + print( "Create:"+templatefilename ); + nco = addfile( templatefilename, "c" ); + print( "From:"+interpfilename ); + nc = addfile( interpfilename, "r" ); + define_file( nco, nc ); + copy_vars_and_atts( nco, nc ); + set_vertical_levels( nco, nc ); + print( "Done!" ); +end diff --git a/tools/interpic/dimensions.f90 b/tools/interpic/dimensions.f90 new file mode 100644 index 0000000000..1f98a01f39 --- /dev/null +++ b/tools/interpic/dimensions.f90 @@ -0,0 +1,220 @@ +module dimensions + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + + public :: info + public :: maxdims + public :: is_ewdim, is_nsdim, is_zdim, add_dim + public :: get_dimlen, get_shape + public :: ewdim, nsdim, zdim + public :: ewdimi, nsdimi, zdimi + + include 'netcdf.inc' + + integer, parameter :: maxdims = 4 + + type info + character*(nf_max_name) :: dimname + integer :: dimlen + end type info + + type(info) :: ewdim(maxdims), nsdim(maxdims), zdim(maxdims) + type(info) :: ewdimi(maxdims), nsdimi(maxdims), zdimi(maxdims) + + logical init_done + data init_done /.false./ + + character*(nf_max_name) ewnames (maxdims) + character*(nf_max_name) nsnames (maxdims) + character*(nf_max_name) znames (maxdims) + + integer :: newnames, nnsnames, nznames + + contains +!------------------------------------------------------------------------------- + subroutine init_dims + + integer n + + ewnames(:) = ' ' + nsnames(:) = ' ' + znames(:) = ' ' + + ewnames(1) = 'lon' + ewnames(2) = 'slon' + nsnames(1) = 'lat' + nsnames(2) = 'slat' + znames(1) = 'lev' + znames(2) = 'ilev' + + do n=1,size (ewnames) + if (ewnames(n) == ' ') exit + end do + newnames = n - 1 + + do n=1,size (nsnames) + if (nsnames(n) == ' ') exit + end do + nnsnames = n - 1 + + do n=1,size (znames) + if (znames(n) == ' ') exit + end do + nznames = n - 1 + + ewdim(:)%dimname = ' ' + nsdim(:)%dimname = ' ' + zdim(:)%dimname = ' ' + + ewdimi(:)%dimname = ' ' + nsdimi(:)%dimname = ' ' + zdimi(:)%dimname = ' ' + + init_done = .true. + + return + end subroutine init_dims +!------------------------------------------------------------------------------- + logical function is_ewdim (name) + character*(*) name + + integer n + + if (.not. init_done) call init_dims + is_ewdim = .false. + + do n=1,newnames + if (name == ewnames(n)) then + is_ewdim = .true. + end if + end do + + return + end function is_ewdim +!------------------------------------------------------------------------------- + logical function is_nsdim (name) + character*(*) name + + integer n + + if (.not. init_done) call init_dims + is_nsdim = .false. + + do n=1,nnsnames + if (name == nsnames(n)) then + is_nsdim = .true. + end if + end do + + return + end function is_nsdim +!------------------------------------------------------------------------------- + logical function is_zdim (name) + character*(*) name + + integer n + + if (.not. init_done) call init_dims + is_zdim = .false. + + do n=1,nznames + if (name == znames(n)) then + is_zdim = .true. + end if + end do + + return + end function is_zdim +!------------------------------------------------------------------------------- + subroutine add_dim (arr, dimname, dimlen) + implicit none + + type(info) :: arr(:) + character*(nf_max_name) dimname + + integer dimlen + + integer n + + n = size (arr,1) + if (arr(n)%dimname /= ' ') then + call err_exit ('add_dim: not enough space allocated for dimension array') + end if + + do n=1,size (arr,1) + if (arr(n)%dimname == ' ') then + exit + else if (arr(n)%dimname == dimname) then + write(6,*)'add_dim: ', trim(dimname), ' already exists' + stop 999 + end if + end do + + arr(n)%dimname = dimname + arr(n)%dimlen = dimlen + + return + end subroutine add_dim +!------------------------------------------------------------------------------- + integer function get_dimlen (arr, dimname) + type(info) :: arr(:) + character*(nf_max_name) dimname + + integer n + + do n=1,size (arr,1) + if (arr(n)%dimname == dimname) then + get_dimlen = arr(n)%dimlen + return + end if + end do + + write(6,*) 'get_dimlen: dimname ',trim(dimname), ' not found' + stop 999 + + end function get_dimlen +!------------------------------------------------------------------------------- + character*8 function get_shape (ncid, vardids, nvdims, dimnames) + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + integer vardids(nf_max_var_dims) ! variable dimension id's + integer nvdims + character*(nf_max_name) dimnames(3) + + dimnames(:) = ' ' + + if (nvdims > 0) call wrap_inq_dimname (ncid, vardids(1), dimnames(1)) + if (nvdims > 1) call wrap_inq_dimname (ncid, vardids(2), dimnames(2)) + if (nvdims > 2) call wrap_inq_dimname (ncid, vardids(3), dimnames(3)) + + get_shape = 'unknown' + + if ( is_ewdim (dimnames(1)) .and. is_nsdim (dimnames(2)) .and. & + .not. is_zdim (dimnames(3))) then + + get_shape = 'xy' + + else if (is_ewdim (dimnames(1)) .and. is_nsdim (dimnames(2)) .and. & + is_zdim (dimnames(3))) then + + get_shape = 'xyz' + + else if (is_ewdim (dimnames(1)) .and. is_zdim (dimnames(2)) .and. & + is_nsdim (dimnames(3))) then + + get_shape = 'xzy' + + end if + + return + end function get_shape +end module dimensions diff --git a/tools/interpic/driver.f90 b/tools/interpic/driver.f90 new file mode 100644 index 0000000000..7b8bb45252 --- /dev/null +++ b/tools/interpic/driver.f90 @@ -0,0 +1,263 @@ +subroutine driver (ncidi, ncido, ncidt, nvars, ntime) +! +! $Id$ +! + use shr_kind_mod, only: r8 => shr_kind_r8 + use varspecs_mod, only: varspecs + use control + use dimensions + use fill_positions + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncidi, ncido, ncidt ! input, output, template netcdf file ids + integer nvars ! number of variables + integer ntime ! size of unlimited dimension (if present) +! +! Local workspace +! + character*8 :: shapei, shapeo + character*(nf_max_name) :: name, namei + character*(nf_max_name) :: dimnames(3) + character*(nf_max_name) :: dimnamesi(3) + character*(nf_max_name) :: attname + + integer natts, nattsi ! number of attributes for a given variable + integer nvdims, nvdimsi ! number of dimensions for this variable + integer vardids(nf_max_var_dims) ! variable dimension id's + integer vardidsi(nf_max_var_dims) ! variable dimension id's + integer j, k ! spatial indices + integer n ! index + integer t ! index over unlimited dimension + integer v ! loop index over variable id + integer vi, vo ! returned variable id on output file + integer nxi, nyi, nzi + integer nxo, nyo, nzo + integer xtype, xtypei ! variable type (netcdf) + integer tpos ! position of unlimited dimension + integer ncp + integer nintp + integer start(nf_max_var_dims) + integer count(nf_max_var_dims) + integer counti(nf_max_var_dims) + integer totsiz + integer :: indx_cp(nvars) + integer :: indx_intp(nvars) + + logical copy + + real(r8), allocatable :: arrxyzi(:,:,:), arrxzyi(:,:,:) + real(r8), allocatable :: arrxyzo(:,:,:), arrxzyo(:,:,:) + + type (varspecs) :: vari(nvars) + type (varspecs) :: varo(nvars) + + logical is_special_case + external is_special_case +! +! Initialize indices to invalid values +! + indx_cp(:) = -1 + indx_intp(:) = -1 + + ncp = 0 + nintp = 0 + + + do v=1,nvars + copy = .true. + + call wrap_inq_var (ncidt, v, name, xtype, nvdims, vardids, natts) +! +! Skip any special case variables: they have already been dealt with. +! Also skip the variable if it is not on the input tape +! + if (is_special_case (name, ncidt)) then + if (verbose) write(6,*)'skipping special case var ',trim(name) + cycle + end if + + if (nf_inq_varid (ncidi, name, vi) == nf_noerr) then + call wrap_inq_var (ncidi, vi, namei, xtypei, nvdimsi, vardidsi, nattsi) + else + if (verbose) write(6,*)trim(name),' not found on input: skipping' + cycle + end if +! +! Variable is on both input and template file, and is not a special case +! + call wrap_def_var (ncido, name, xtype, nvdims, vardids, vo) +! +! Copy attributes from input to output +! + do n=1,nattsi + call wrap_inq_attname (ncidi, vi, n, attname) + call wrap_copy_att (ncidi, vi, attname, ncido, vo) + end do + + if (xtype == NF_FLOAT .or. xtype == NF_DOUBLE) then + + shapeo = get_shape (ncidt, vardids, nvdims, dimnames) +! +! Interpolated variables must be of a floating point type and have dimensions +! xy, xyz, or xzy. +! + if (shapeo == 'xy' .or. shapeo == 'xyz' .or. shapeo == 'xzy') then + if (xtypei /= NF_FLOAT .and. xtypei /= NF_DOUBLE) then + write(6,*)'driver: type of ', trim(namei), & + ' does not match between input and template files' + stop 999 + end if + + shapei = get_shape (ncidi, vardidsi, nvdimsi, dimnamesi) + + copy = .false. + nintp = nintp + 1 + indx_intp(nintp) = v + end if + end if +! +! Variables to be copied will not be interpolated. Determine which do and +! do not have an unlimited dimension +! + if (copy) then + ncp = ncp + 1 + indx_cp(ncp) = v + end if +! +! Copy useful information for copying or interpolating into the struct +! + call fillvar (ncidi, namei, xtypei, shapei, dimnamesi, & + ewdimi, nsdimi, zdimi, vari(v), vi, & + nvdimsi, vardidsi) + + call fillvar (ncidt, name, xtype, shapeo, dimnames, & + ewdim, nsdim, zdim, varo(v), vo, & + nvdims, vardids) + + call compare_var (vari(v), varo(v)) + end do ! loop over input variables + + if (nf_enddef (ncido) /= NF_NOERR) stop 999 +! +! Now loop over the unlimited dimension. First do copies +! + do t=1,ntime + if (.not.silent) then + write(6,*)'Starting time sample ',t + end if + + do n=1,ncp + v = indx_cp(n) + + name = vari(v)%name + totsiz = vari(v)%totsiz + xtype = vari(v)%xtype + vi = vari(v)%varid + vo = varo(v)%varid + + start(:) = 1 + count(:) = vari(v)%count(:) + + if (vari(v)%tpos > 0) then + tpos = vari(v)%tpos + start(tpos) = t + end if + + call cpvar (ncidi, ncido, vi, vo, name, & + totsiz, xtype, start, count) + end do +! +! Now the data which need to be interpolated +! + do n=1,nintp + v = indx_intp(n) + + name = vari(v)%name + vi = vari(v)%varid + shapei = vari(v)%vshape + nxi = vari(v)%nx + nyi = vari(v)%ny + nzi = vari(v)%nz + counti(:) = vari(v)%count(:) + + vo = varo(v)%varid + shapeo = varo(v)%vshape + nxo = varo(v)%nx + nyo = varo(v)%ny + nzo = varo(v)%nz + count(:) = varo(v)%count(:) + + start(:) = 1 + + if (vari(v)%tpos > 0) then + tpos = vari(v)%tpos + start(tpos) = t + end if + + allocate (arrxzyi(nxi,nzi,nyi)) + allocate (arrxzyo(nxo,nzo,nyo)) + + if (shapei(1:2) == 'xy') then + + allocate (arrxyzi(nxi,nyi,nzi)) + + call wrap_get_vara_double (ncidi, vi, start, counti, arrxyzi) + + do j=1,nyi + do k=1,nzi + arrxzyi(:,k,j) = arrxyzi(:,j,k) + end do + end do + + deallocate (arrxyzi) + + else + + call wrap_get_vara_double (ncidi, vi, start, counti, arrxzyi) + + end if + + if (verbose) then + write(6,*)'Interpolating ',trim(name),' 1st elem=',arrxzyi(1,1,1) + end if + + call interp_driver (arrxzyi, arrxzyo, vari(v), varo(v), nxi, & + nzi, nyi, nxo, nzo, nyo) + + if (shapeo(1:2) == 'xy') then + + allocate (arrxyzo(nxo,nyo,nzo)) + + do j=1,nyo + do k=1,nzo + arrxyzo(:,j,k) = arrxzyo(:,k,j) + end do + end do + + call wrap_put_vara_double (ncido, vo, start, count, arrxyzo) + deallocate (arrxyzo) + + else if (shapeo == 'xzy') then + + call wrap_put_vara_double (ncido, vo, start, count, arrxzyo) + + else + + write(6,*)'Unknown shape=',shapeo,' for variable ',name + stop 999 + + end if + + deallocate (arrxzyi) + deallocate (arrxzyo) + + end do + end do + + return +end subroutine driver diff --git a/tools/interpic/err_exit.f90 b/tools/interpic/err_exit.f90 new file mode 100644 index 0000000000..40d157a0ee --- /dev/null +++ b/tools/interpic/err_exit.f90 @@ -0,0 +1,8 @@ +subroutine err_exit (string) + implicit none + + character*(*) string + + write(6,*) string + stop 999 +end subroutine err_exit diff --git a/tools/interpic/fill_positions.f90 b/tools/interpic/fill_positions.f90 new file mode 100644 index 0000000000..7c1d377457 --- /dev/null +++ b/tools/interpic/fill_positions.f90 @@ -0,0 +1,175 @@ +module fill_positions + + contains + + subroutine fill_xpos (ncid, dimname, nx, ny, xpos, numx) + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + integer nx, ny + integer numx(ny) + character*(nf_max_name) dimname + real(r8) :: xpos(nx,ny) +! +! Local workspace +! + integer varid + integer j + + if (dimname == 'lon' .and. nf_inq_varid (ncid, 'rlon', varid) == nf_noerr) then + call wrap_get_var_double (ncid, varid, xpos) + call wrap_inq_varid (ncid, 'nlon', varid) + call wrap_get_var_int (ncid, varid, numx) + else + call wrap_inq_varid (ncid, dimname, varid) + call wrap_get_var_double (ncid, varid, xpos(1,1)) + do j=2,ny + xpos(:,j) = xpos(:,1) + end do + numx(:) = nx + end if + + return + end subroutine fill_xpos +!------------------------------------------------------------------------------- + subroutine fill_yzpos (ncid, dimname, nyz, yzpos) + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + integer nyz + character*(nf_max_name) dimname + real(r8) :: yzpos(nyz) +! +! Local workspace +! + integer varid + + call wrap_inq_varid (ncid, dimname, varid) + call wrap_get_var_double (ncid, varid, yzpos) + + return + end subroutine fill_yzpos +!------------------------------------------------------------------------------- + subroutine fillvar (ncid, name, xtype, vshape, dimnames, & + ewdim, nsdim, zdim, var, varid, & + nvdims, vardids) + + use dimensions, only: info, get_dimlen, maxdims + use varspecs_mod, only: varspecs + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + integer varid + character*(*) name + integer xtype + character*(nf_max_name) dimnames(3) + character*8 vshape + type(info) :: ewdim(maxdims), nsdim(maxdims), zdim(maxdims) + type(varspecs) :: var + integer nvdims + integer vardids(*) +! +! Local workspace +! + integer nx, ny, nz + integer dimlen + integer n + integer ret + integer unlimdimid + + var%name = name + var%xtype = xtype + var%vshape = vshape + var%varid = varid + + var%totsiz = 1 ! ini to to size which can be multiplied + var%tpos = 1 ! init to 1 in case unlimited dim not present + var%count(:) = 1 ! init to 1 in case unlimited dim not present + + nx = 1 + ny = 1 + nz = 1 + + if (vshape == 'xy') then + + nx = get_dimlen (ewdim, dimnames(1)) + ny = get_dimlen (nsdim, dimnames(2)) + + allocate(var%numx(ny)) + allocate(var%xpos(nx,ny)) + allocate(var%ypos(ny)) + + call fill_xpos (ncid, dimnames(1), nx, ny, var%xpos, var%numx) + call fill_yzpos (ncid, dimnames(2), ny, var%ypos) + + else if (vshape == 'xyz') then + + nx = get_dimlen (ewdim, dimnames(1)) + ny = get_dimlen (nsdim, dimnames(2)) + nz = get_dimlen (zdim, dimnames(3)) + + allocate(var%numx(ny)) + allocate(var%xpos(nx,ny)) + allocate(var%ypos(ny)) + allocate(var%zpos(nz)) + + call fill_xpos (ncid, dimnames(1), nx, ny, var%xpos, var%numx) + call fill_yzpos (ncid, dimnames(2), ny, var%ypos) + call fill_yzpos (ncid, dimnames(3), nz, var%zpos) + + else if (vshape == 'xzy') then + + nx = get_dimlen (ewdim, dimnames(1)) + ny = get_dimlen (nsdim, dimnames(3)) + nz = get_dimlen (zdim, dimnames(2)) + + allocate(var%numx(ny)) + allocate(var%xpos(nx,ny)) + allocate(var%ypos(ny)) + allocate(var%zpos(nz)) + + call fill_xpos (ncid, dimnames(1), nx, ny, var%xpos, var%numx) + call fill_yzpos (ncid, dimnames(3), ny, var%ypos) + call fill_yzpos (ncid, dimnames(2), nz, var%zpos) + + end if + + var%nx = nx + var%ny = ny + var%nz = nz + + ret = nf_inq_unlimdim (ncid, unlimdimid) + + do n=1,nvdims + if (vardids(n) == unlimdimid) then + var%tpos = n + var%count(n) = 1 + else + call wrap_inq_dimlen (ncid, vardids(n), dimlen) + var%count(n) = dimlen + var%totsiz = var%totsiz * dimlen + end if + end do + + return + end subroutine fillvar + +end module fill_positions + diff --git a/tools/interpic/fmain.f90 b/tools/interpic/fmain.f90 new file mode 100644 index 0000000000..3deb66bb88 --- /dev/null +++ b/tools/interpic/fmain.f90 @@ -0,0 +1,211 @@ +program fmain + use control + use dimensions +! +! $Id$ +! + implicit none + + include 'netcdf.inc' +! +! Local workspace +! + character*80 :: arg, file1, file2, template + character*1500 :: text + character*256 :: cmdline + character*(nf_max_name) :: name, namei + character*(nf_max_name) :: attname + + integer, parameter :: maxny = 1000 + + integer attlen + integer ncidi, ncido, ncidt + integer ndims, ndimsi + integer dimlen + integer dimid + integer nvars, nvarsi + integer ngatts, ngattsi + integer ret + integer n + integer ntime + integer nargs + integer nx, ny + data nx, ny /0, 0/ + + integer iargc + external iargc +! +! Default settings before parsing argument list +! + file1 = ' ' + file2 = ' ' + template = ' ' + verbose = .false. + silent = .false. + + nargs = iargc() + n = 1 + cmdline = 'interpic ' + do while (n .le. nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + + select case (arg) + case ('-s') + silent = .true. + cmdline = trim(cmdline) // ' -s' + case ('-t') + call getarg (n, arg) + n = n + 1 + template = arg + cmdline = trim(cmdline) // ' -t ' // trim(template) + case ('-v') + verbose = .true. + cmdline = trim(cmdline) // ' -v' + case ('-x') + call getarg (n, arg) + n = n + 1 + read(nx,'(i4)') arg + cmdline = trim(cmdline) // ' -x ' // trim(arg) + case ('-y') + call getarg (n, arg) + n = n + 1 + read(ny,'(i4)') arg + cmdline = trim(cmdline) // ' -y ' // trim(arg) + case default + if (file1 .eq. ' ') then + file1 = arg + else if (file2 .eq. ' ') then + file2 = arg + else + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end if + cmdline = trim(cmdline) // ' ' // trim(arg) + end select + end do + + if ((nx > 0 .or. ny > 0) .and. template /= ' ') then + call usage_exit ('Cannot specify template file in addition to nx or ny') + else if (file1.eq.' ' .or. file2.eq.' ') then + call usage_exit ('Must enter an input file and an output file') + else if (silent .and. verbose) then + call usage_exit ('-s cannot be specified with -v') + end if +! +! Open input and output netcdf files +! + call wrap_open (file1, NF_NOWRITE, ncidi) + call wrap_open (template, NF_NOWRITE, ncidt) + call wrap_create (file2, NF_CLOBBER, ncido) +! +! Copy dimension and attribute information from template file to output file +! + call wrap_inq (ncidt, ndims, nvars, ngatts, unlimdimid) +! +! Determine space and time dimensions of output file from template file +! + do n=1,ndims + call wrap_inq_dim (ncidt, n, name, dimlen) + + if (n == unlimdimid) then + call wrap_def_dim (ncido, name, NF_UNLIMITED, dimid) + else + call wrap_def_dim (ncido, name, dimlen, dimid) + if (is_ewdim (name)) then + call add_dim (ewdim, name, dimlen) + else if (is_nsdim (name)) then + call add_dim (nsdim, name, dimlen) + else if (is_zdim (name)) then + call add_dim (zdim, name, dimlen) + end if + end if + + if (dimid /= n) then + call err_exit ('Input dimid not equal to output dimid') + end if + end do +! +! Determine space and time dimensions of input file +! + call wrap_inq (ncidi, ndimsi, nvarsi, ngattsi, unlimdimidi) + + ret = nf_inq_dimlen (ncidi, unlimdimidi, ntime) + if (ret /= NF_NOERR) then + ntime = 1 + write(6,*)'INFO: Input file has no unlimited dimension' + end if + + do n=1,ndimsi + call wrap_inq_dim (ncidi, n, namei, dimlen) + + if (n /= unlimdimidi) then + if (is_ewdim (namei)) then + call add_dim (ewdimi, namei, dimlen) + else if (is_nsdim (namei)) then + call add_dim (nsdimi, namei, dimlen) + else if (is_zdim (namei)) then + call add_dim (zdimi, namei, dimlen) + end if + end if + end do +! +! Copy global attributes from template file +! + do n=1,ngatts + call wrap_inq_attname (ncidt, NF_GLOBAL, n, attname) + ret = nf_inq_attlen (ncidt, NF_GLOBAL, attname, attlen) + + if (attlen > len(text)) then + write(6,*) 'attribute ',trim(attname),' too long' + stop 999 + end if + + if (attname == 'case') then + text = ' ' + call wrap_get_att_text (ncidt, NF_GLOBAL, attname, text) + write(6,*)'case =',trim(text) + else if (attname == 'title') then + text = ' ' + call wrap_get_att_text (ncidt, NF_GLOBAL, attname, text) + write(6,*)'title =',trim(text) + end if + call wrap_copy_att (ncidt, NF_GLOBAL, attname, ncido, NF_GLOBAL) + end do + + if (ny > maxny) then + write(6,*)'maxny too small: recompile with this parameter > ',ny + stop 999 + end if +! +! Add global attributes for interpic +! + call addglobal (ncido, cmdline) +! +! Special cases: coordinate variables and offshoots (e.g. nlon, rlon, hyai) will be +! copied from template file to output file. +! + call handle_special_cases (ncidt, ncido, nvars, ntime, unlimdimid) +! +! Call driver code to do the interpolations and/or copies +! + call driver (ncidi, ncido, ncidt, nvars, ntime) + + if (nf_close (ncido) /= nf_noerr) then + call err_exit ('error from nf_close') + end if + + stop +end program + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg.ne.' ') write (6,*) arg + write (6,*) 'Usage: interpic [-s] [-v] ', & + '-t template infile outfile' + stop 999 +end subroutine + diff --git a/tools/interpic/handle_special_cases.f90 b/tools/interpic/handle_special_cases.f90 new file mode 100644 index 0000000000..4b3fb62251 --- /dev/null +++ b/tools/interpic/handle_special_cases.f90 @@ -0,0 +1,75 @@ +subroutine handle_special_cases (ncidt, ncido, nvars, ntime, unlimdimid) + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncidt, ncido + integer nvars, ntime + integer unlimdimid +! +! Local workspace +! + character*(nf_max_name) :: name + + integer i, n ! indices + integer vt, vo + integer natts + integer xtype + integer nvdims + integer dimlen + integer totsiz + integer vardids(nf_max_var_dims) ! variable dimension ids + integer start(nf_max_var_dims) + integer count(nf_max_var_dims) + integer ret + + character*(nf_max_name) :: attname +! +! Externals +! + logical, external :: is_special_case +! +! Copy all the special case variables from template to output +! Probably should have separate "define" and "put" loops to optimize redef/enddef +! + start(:) = 1 + + do vt=1,nvars + call wrap_inq_var (ncidt, vt, name, xtype, nvdims, vardids, natts) + + if (is_special_case (name, ncidt)) then + totsiz = 1 ! Init to size that can be multiplied + do n=1,nvdims + if (vardids(n) == unlimdimid) then + count(n) = ntime + totsiz = totsiz * ntime + else + call wrap_inq_dimlen (ncidt, vardids(n), dimlen) + count(n) = dimlen + totsiz = totsiz * dimlen + end if + end do + + call wrap_def_var (ncido, name, xtype, nvdims, vardids, vo) +! +! Copy attributes from input to output, then the variable itself +! + do n=1,natts + call wrap_inq_attname (ncidt, vt, n, attname) + call wrap_copy_att (ncidt, vt, attname, ncido, vo) + end do + + if (nf_enddef (ncido) /= NF_NOERR) stop 999 + + call cpvar (ncidt, ncido, vt, vo, name, & + totsiz, xtype, start, count ) + + ret = nf_redef (ncido) + + end if + end do +end subroutine handle_special_cases diff --git a/tools/interpic/interp_driver.f90 b/tools/interpic/interp_driver.f90 new file mode 100644 index 0000000000..04cc2550c0 --- /dev/null +++ b/tools/interpic/interp_driver.f90 @@ -0,0 +1,121 @@ +subroutine interp_driver (xiziyi, xozoyo, vari, varo, nxi, & + nzi, nyi, nxo, nzo, nyo) + use shr_kind_mod, only: r8 => shr_kind_r8 + use varspecs_mod, only: varspecs + + implicit none +! +! Input arguments +! + integer nxi, nzi, nyi + integer nxo, nzo, nyo + + type(varspecs) :: vari, varo + + real(r8) :: xiziyi(nxi,nzi,nyi) + real(r8) :: xozoyo(nxo,nzo,nyo) +! +! Local workspace +! + integer :: i,j,k + integer :: numxis, numxin + integer :: numxo + integer :: jj, jjs, jjn + integer :: count + + real(r8) :: wgts, wgtn +! +! Intermediate interpolation arrays +! + real(r8) :: xizoyi(nxi,nzo,nyi) + real(r8) :: xtemp(nxo,2) +! +! Interpolate in z +! + if (nzi == 1 .and. nzo == 1) then + xizoyi(:,1,:) = xiziyi(:,1,:) + else + do j=1,nyi + do i=1,nxi + call lininterp (xiziyi(i,1,j), nzi, nxi, vari%zpos, & + xizoyi(i,1,j), nzo, nxi, varo%zpos, .false.) + end do + end do + end if +! +! Check monotonicity of y-coordinate variable before interpolating. z and +! x monotonicity is checked inside lininterp. +! + count = 0 + do j=1,nyi-1 + if (vari%ypos(j) > vari%ypos(j+1)) count = count + 1 + end do + do j=1,nyo-1 + if (varo%ypos(j) > varo%ypos(j+1)) count = count + 1 + end do + + if (count > 0) then + call err_exit ('interp_driver: non-monotonic coordinate array(s) found') + end if +! +! Interpolate in x and y +! + do j=1,nyo + numxo = varo%numx(j) + + jjs = -1 + jjn = -1 + + if (vari%ypos(1) >= varo%ypos(j)) then + jjs = 1 + jjn = 1 + else if (vari%ypos(nyi) < varo%ypos(j)) then + jjs = nyi + jjn = nyi + else + do jj=1,nyi-1 + if (vari%ypos(jj ) < varo%ypos(j) .and. & + vari%ypos(jj+1) >= varo%ypos(j)) then + jjs = jj + jjn = jj+1 + exit + end if + end do + end if + + if (jjs < 0 .or. jjn < 0) then + call err_exit ('interp_driver: bad index calculation') + end if + + numxis = vari%numx(jjs) + numxin = vari%numx(jjn) + + if (jjs /= jjn) then + wgts = (vari%ypos(jjn) - varo%ypos(j)) / (vari%ypos(jjn) - vari%ypos(jjs)) + wgtn = (varo%ypos(j) - vari%ypos(jjs)) / (vari%ypos(jjn) - vari%ypos(jjs)) + if (abs ((wgts+wgtn)-1.) > 1.e-6) then + call err_exit ('interp_driver: bad weight calculation') + end if + end if + + do k=1,nzo +! +! X interp +! + call lininterp (xizoyi(1,k,jjs), numxis, 1, vari%xpos(1,jjs), & + xtemp(1,1), numxo, 1, varo%xpos(1,j), .true.) + if (jjs == jjn) then + xozoyo(:numxo,k,j) = xtemp(:numxo,1) + else + call lininterp (xizoyi(1,k,jjn), numxin, 1, vari%xpos(1,jjn), & + xtemp(1,2), numxo, 1, varo%xpos(1,j), .true.) +! +! Y interp +! + xozoyo(:numxo,k,j) = xtemp(:numxo,1)*wgts + xtemp(:numxo,2)*wgtn + end if + end do + end do + + return +end subroutine interp_driver diff --git a/tools/interpic/is_special_case.f90 b/tools/interpic/is_special_case.f90 new file mode 100644 index 0000000000..5a88948a61 --- /dev/null +++ b/tools/interpic/is_special_case.f90 @@ -0,0 +1,43 @@ +logical function is_special_case (name, ncid) + + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + character*(*) name +! +! Local workspace +! + character*(nf_max_name) dimname + integer n + integer ndims +! +! Hardwire the names known to be functions of coordinate variables +! + if (name == 'rlon' .or. name == 'nlon' .or. name == 'wnummax' .or. & + name == 'hyai' .or. name == 'hybi' .or. name == 'hyam' .or. & + name == 'hybm' .or. name == 'gw') then + is_special_case = .true. + return + end if +! +! Loop through the dimensions and see if "name" matches a dimension +! + if (nf_inq_ndims (ncid, ndims) /= nf_noerr) then + call err_exit ('is_special_case: nf_inq_ndims failure') + end if + + do n=1,ndims + call wrap_inq_dimname (ncid, n, dimname) + if (dimname == name) then + is_special_case = .true. + return + end if + end do + + is_special_case = .false. + return +end function is_special_case diff --git a/tools/interpic/lininterp.f90 b/tools/interpic/lininterp.f90 new file mode 100644 index 0000000000..d814beaf56 --- /dev/null +++ b/tools/interpic/lininterp.f90 @@ -0,0 +1,174 @@ +subroutine lininterp (arrin, nxin, incin, xin, & + arrout, nxout, incout, xout, periodic) +!----------------------------------------------------------------------- +! +! Do a linear interpolation from input mesh defined by xin to output +! mesh defined by xout. Where extrapolation is necessary, values will +! be copied from the extreme edge of the input grid. +! +!---------------------------Code history-------------------------------- +! +! Original version: J. Rosinski +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none +!----------------------------------------------------------------------- +! +! Arguments +! + integer nxin, incin + integer nxout, incout + + real(r8) xin(nxin), xout(nxout) + real(r8) arrin(incin,nxin) + real(r8) arrout(incout,nxout) + + logical periodic +! +! Local workspace +! + integer i, ii ! input grid indices + integer im, ip, iiprev ! input grid indices + integer icount ! number of values + + real(r8) extrap ! percent grid non-overlap + real(r8) dxinwrap ! delta-x on input grid for 2-pi + real(r8) avgdxin ! avg input delta-x + real(r8) ratio ! compare dxinwrap to avgdxin +! +! Dynamic +! + integer iim(nxout) ! interp. indices minus + integer iip(nxout) ! interp. indices plus + + real(r8) wgtm(nxout) ! interp. weight minus + real(r8) wgtp(nxout) ! interp. weight plus +! +! Just copy the data and return if input dimensions are 1 +! + if (nxin.eq.1 .and. nxout.eq.1) then + arrout(1,1) = arrin(1,1) + else if (nxin.eq.1) then + write(6,*)'LININTERP: Must have at least 2 input points' + call abort + end if + icount = 0 + do i=1,nxin-1 + if (xin(i).gt.xin(i+1)) icount = icount + 1 + end do + do i=1,nxout-1 + if (xout(i).gt.xout(i+1)) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Non-monotonic coordinate array(s) found' + call abort + end if +! +! Initialize index arrays for later checking +! + do i=1,nxout + iim(i) = 0 + iip(i) = 0 + end do + if (periodic) then +! +! Periodic case: for values which extend beyond boundaries, assume +! periodicity and interpolate between endpoints. First check for sane +! periodicity assumption. +! + if (xin(nxin).gt.360.) then + write(6,*)'LININTERP: Periodic input x-grid must not be greater than 360' + call abort + end if + if (xout(nxout).gt.360.) then + write(6,*)'LININTERP: Output x-grid must not be greater than 360' + call abort + end if + dxinwrap = xin(1) + 360. - xin(nxin) + avgdxin = (xin(nxin)-xin(1))/(nxin-1.) + ratio = dxinwrap/avgdxin + if (ratio.lt.0.9 .or. ratio.gt.1.1) then + write(6,*)'LININTERP: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin + call abort + end if + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = nxin + iip(im) = 1 + wgtm(im) = (xin(1) - xout(im)) /dxinwrap + wgtp(im) = (xout(im)+360. - xin(nxin))/dxinwrap + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = 1 + wgtm(ip) = (xin(1)+360. - xout(ip)) /dxinwrap + wgtp(ip) = (xout(ip) - xin(nxin))/dxinwrap + end do + else +! +! Non-periodic case: for values which extend beyond boundaries, set weights +! such that values will just be copied. +! + do im=1,nxout + if (xout(im).gt.xin(1)) exit + iim(im) = 1 + iip(im) = 1 + wgtm(im) = 1. + wgtp(im) = 0. + end do + do ip=nxout,1,-1 + if (xout(ip).le.xin(nxin)) exit + iim(ip) = nxin + iip(ip) = nxin + wgtm(ip) = 1. + wgtp(ip) = 0. + end do + end if +! +! Loop though output indices finding input indices and weights +! + iiprev = 1 + do i=im,ip + do ii=iiprev,nxin-1 + if (xout(i).gt.xin(ii) .and. xout(i).le.xin(ii+1)) then + iim(i) = ii + iip(i) = ii + 1 + wgtm(i) = (xin(ii+1)-xout(i))/(xin(ii+1)-xin(ii)) + wgtp(i) = (xout(i)-xin(ii))/(xin(ii+1)-xin(ii)) + goto 30 + end if + end do + write(6,*)'LININTERP: Failed to find interp values' +30 iiprev = ii + end do +! +! Check grid overlap +! + extrap = 100.*((im - 1.) + (nxout - ip))/nxout + if (extrap.gt.30.) then + write(6,*)'********LININTERP WARNING:',extrap,' % of output', & + ' grid will have to be extrapolated********' + end if +! +! Check that interp/extrap points have been found for all outputs +! + icount = 0 + do i=1,nxout + if (iim(i).eq.0 .or. iip(i).eq.0) icount = icount + 1 + end do + if (icount.gt.0) then + write(6,*)'LININTERP: Point found without interp indices' + call abort + end if +! +! Do the interpolation +! + do i=1,nxout + arrout(1,i) = arrin(1,iim(i))*wgtm(i) + arrin(1,iip(i))*wgtp(i) + end do + return +end subroutine lininterp + diff --git a/tools/interpic/shr_kind_mod.f90 b/tools/interpic/shr_kind_mod.f90 new file mode 100644 index 0000000000..fc1ed8e94a --- /dev/null +++ b/tools/interpic/shr_kind_mod.f90 @@ -0,0 +1,20 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + +END MODULE shr_kind_mod diff --git a/tools/interpic/template.ncl b/tools/interpic/template.ncl new file mode 100644 index 0000000000..1eabe70271 --- /dev/null +++ b/tools/interpic/template.ncl @@ -0,0 +1,413 @@ +; +; template.ncl +; +; Purpose: Subroutines to help create templates for interpolation. +; +; Method: Set grid sizes and variables at top of +; script. Copy variables and needed values from +; file that will be interpolated. +; +; Usage: Main program must set the following global variables: +; +; nlat Number of latitudes +; nlon Number of longitudes +; nlev Number of levels +; grid Grid type (staggered, reduced or gaussian) +; ntrm Number of wave truncation for M (Gaussian and reduced grid only) +; ntrk Number of wave truncation for K (Gaussian and reduced grid only) +; ntrn Number of wave truncation for N (Gaussian and reduced grid only) +; ntimes Number of times on file +; interpfilename Filename of file interpolating from +; templatefilename Output filename of template creating +; caseid case id (max 16 characters) +; nlons Array of number of longitudes for each latitude (reduced grid only) +; var_type Output type of fields creating +; nstandard Array of the number of levels for various standard level configurations +; hyai_standard Hybrid "A" interface levels for the standard levels. +; hybi_standard Hybrid "B" interface levels for the standard levels. +; FillValue Value to give the missing value +; nchar Number of characters to use for character data. +; dimnames Names of the dimensions for the file +; dsizes Dimension sizes. +; is_unlim Logical array to indicate if a dimension is unlimited or not. +; rlon reduced grid longitudes (reduced grid only) +; lat Latitudes +; lon Longitudes +; slat Staggered latitudes (staggered only) +; slon Staggered longitudes (staggered only) +; gw Gaussian weights +; w_stag Staggered weights (staggered only) +; +; Example usage: +; +; get_standard_lat_and_longs( ); +; settings( ); +; nco = addfile( templatefilename, "c" ); +; nc = addfile( interpfilename, "r" ); +; define_file( nco, nc ); +; copy_vars_and_atts( nco, nc ); +; set_vertical_levels( nco, nc ); +; +; Author: Erik Kluzek +; +; $Id$ +; +undef("copy_VarAtts") +procedure copy_VarAtts(var_from,var_to) +; +; Procedure to copy attributes from one variable to another. +; +local att_names, i +begin + att_names =getvaratts(var_from); + if(.not.all(ismissing(att_names))) + do i = 0,dimsizes(att_names)-1 + var_to@$att_names(i)$ = var_from@$att_names(i)$ + end do + end if +end + +undef( "get_standard_lat_and_longs" ); +procedure get_standard_lat_and_longs( ) +; +; Compute the standard latitudes and longitudes for the standard grid types +; gaussian, reduced, and staggered +; +begin + if ( grid .eq. "reduced" )then + rlon(:,0) = 0.0; + rlon(:,1) = 360.0 / nlons; + do j = 2, nlons(j)-1 + rlon(:,j) = rlon(:,j-1) + rlon(:,1); + end do + end if + ; + ; weights and latitudes + ; + if ( grid .eq. "staggered" )then + info = linrood_latwgt( nlat ); + lat = info(:,0) + gw = info(:,1) + slat = lat(:nlat-2) + (lat(1) - lat(0))*0.5 + slat@long_name = "Latitude"; + slat@units = "degrees_north"; + ; Currently don't have an easy way to get the weights on the staggered grid + else + ; + ; Gaussian grid + ; + gau_info = gaus(nlat/2) ; divide by 2 to get "per hemisphere" + lat = gau_info(:,0) ; gaussian latitudes ( 1st dimension of gau_info) + gw = gau_info(:,1) ; gaussian weights ( 2nd dimension of gau_info) + end if + ; + ; Longitudes + ; + lon(0) = 0.0; + lon(1) = 360.0 / nlon; + do i = 2, nlon-1 + lon(i) = lon(i-1) + lon(1); + end do + if ( grid .eq. "staggered" )then + slon(:) = lon(:) - lon(1)*0.5; + slon@long_name = "Longitude"; + slon@units = "degrees_east"; + end if + lon@long_name = "Longitude"; + lon@units = "degrees_east"; + lat@long_name = "Latitude"; + lat@units = "degrees_north"; +end + +undef( "settings" ); +procedure settings( ) +; +; Print what the important settings are: +; +begin + print( "This is creating a template for a "+grid+" grid." ); + print( "Input filename is: "+interpfilename ); + print( "Output filename is: "+templatefilename ); + print( "Case id is: "+caseid ); + if ( grid .ne. "staggered" )then + print( "# lats: "+nlat+" # lons: "+nlon+" # levs: "+nlev+" Trunc M:"+ntrm+\ + " # times: "+ntimes + " Trunc N:"+ntrn+" Trunc K:"+ntrk ); + else + print( "# lats: "+nlat+" # lons: "+nlon+" # levs: "+nlev+" Trunc M:"+ntrm+\ + " # times: "+ntimes ); + end if + if ( grid .eq. "reduced" )then + print( "Number of longitudes at each latitude: "+nlons ); + end if +end + +undef( "grid_dimlist" ); +function grid_dimlist( nco:file, nc:file, varname:string ) +; +; Return the list of names for the desired dimensions for the given variable. +; On a staggered grid, U and V are handled differently +; +begin + if ( grid .eq. "staggered" )then + if ( varname .eq. "U" )then + print( "U will be interpolating to staggered grid -- be sure to rename U to US after interpic" ); + dimlist = (/"slat", "lev", "lon"/); + else + if ( varname .eq. "V" )then + print( "V will be interpolating to staggered grid -- be sure to rename V to VS after interpic" ); + dimlist = (/"lat", "lev", "slon"/); + else + dimlist = getfilevardims( nc, varname ) + end if + end if + else + dimlist = getfilevardims( nc, varname ) + end if + return( dimlist ); +end + +undef( "define_file" ); +procedure define_file( nco:file, nc:file ) +; +; Define the output netCDF file variables and dimensions +; +begin + print( "Define the file according to the settings" ); + print( "Dimension names are: "+dimnames ); + ; + ; Define dimensions + ; + filedimdef ( nco, dimnames, dsizes, is_unlim ); + ; + ; Check that needed dimensions and variables are on file + ; + if ( .not. isdim( nc, "lat" ) )then + print( "ERROR:: lat not a dimension on this file" ); + exit; + end if + if ( .not. isdim( nc, "lon" ) )then + print( "ERROR:: lon not a dimension on this file" ); + exit; + end if + ; + ; Define staggered lat and lon + ; + if ( grid .eq. "staggered" )then + filevardef ( nco, "slat", var_type, "slat" ); + if ( isfilevar( nc, "lat" ) )then + filevarattdef ( nco, "slat", nc->lat ); + else + filevarattdef ( nco, "slat", lat ); + end if + filevardef ( nco, "slon", var_type, "slon" ); + if ( isfilevar( nc, "lat" ) )then + filevarattdef ( nco, "slon", nc->lon ); + else + filevarattdef ( nco, "slon", lon ); + end if + end if + + print( "now define the variables" ); + varnames = getfilevarnames( nc ); + do j = 0, dimsizes(varnames)-1 + i = dimsizes(varnames)-1 - j; + ; NCL can't seem to handle string data + if ( typeof(nc->$varnames(i)$) .ne. "char" )then + if ( (grid .ne. "reduced") .or. (varnames(i) .ne. "lon") )then + ; + ; Get the Dimension names same as from interp grid + ; if staggered grid U and V are handled differently + ; + dimlist = grid_dimlist( nco, nc, varnames(i) ); + ; Copy scalars + if ( dimlist(0) .eq. "ncl_scalar" )then + nco->$varnames(i)$ = nc->$varnames(i)$; + ; Define vectors + else + if ( (varnames(i) .ne. "slat") .and. (varnames(i) .ne. "slon") )then + filevardef ( nco, varnames(i), typeof(nc->$varnames(i)$), dimlist ); + filevarattdef ( nco, varnames(i), nc->$varnames(i)$ ); + if ( typeof(nc->$varnames(i)$) .eq. var_type )then + nco->$varnames(i)$@_FillValue = FillValue; + end if + end if + end if + delete( dimlist ); + end if + else + ; Copy string variables + nco->$varnames(i)$ = nc->$varnames(i)$; + end if + end do + ; + ; Define gw + ; + filevardef ( nco, "gw", var_type, "lat" ); + if ( isfilevar( nc, "gw" ) )then + filevarattdef ( nco, "gw", nc->gw ); + else + nco->gw@long_name = "gauss weights"; + end if + if ( grid .eq. "staggered" )then + filevardef ( nco, "w_stag", var_type, "slat" ); + nco->w_stag@long_name = "staggered latitude weights"; + end if + ; + ; Define reduced grid "rlon" and "nlon" + ; + if ( grid .eq. "reduced" )then + filevardef ( nco, "rlon", var_type, (/"lat","lon"/) ); + filevardef ( nco, "nlon", "integer", "lat" ); + nco->nlon@long_name = "number of longitudes"; + nco->rlon@_FillValue = FillValue; + if ( isfilevar( nc, "lon" ) ) then + nco->rlon@long_name = grid + nc->lon@long_name; + nco->rlon@units = nc->lon@units; + else + nco->rlon@long_name = grid + " Longitude"; + nco->rlon@units = "degrees_east"; + end if + end if +end + +undef( "copy_vars_and_atts" ); +procedure copy_vars_and_atts( nco:file, nc:file ) +; +; Copy variables and attributes from the interpolation file +; +begin + print( "Copy variables and attributes from the interpolation file: " + interpfilename ); + ; + ; Set date and time + ; + ;if ( isfilevar( nco, "date_written" ) )then + ; delete( nco->date_written ); + ;end if + ;if ( isfilevar( nco, "time_written" ) )then + ; delete( nco->time_written ); + ;end if + ;date_written = stringtochar( systemfunc( "date +%m/%d/%y" ) ); + ;time_written = stringtochar( systemfunc( "date +%H:%M:%S" ) ); + ;do i = 0, nchar-1 + ; nco->date_written(0,i) = date_written(i); + ; nco->time_written(0,i) = time_written(i); + ;end do + ; + ; Copy reference pressure and variables having to do with time + ; + vlist = (/"P0", "time", "ndbase", "nsbase", "nbdate", "nbsec", "mdt", "ndcur", \ + "nscur", "date", "datesec", "nsteph" /); + do i = 0, dimsizes(vlist)-1 + print( "Copy:"+vlist(i) ); + if ( isfilevar( nc, vlist(i) ) )then + nco->$vlist(i)$ = (/nc->$vlist(i)$/); + else + print( "WARNING::Variable "+vlist(i)+" does not exist on "+interpfilename ); + end if + end do + ; + ; Set ntrm, ntrk, ntrn + ; + if ( grid .ne. "staggered" )then + nco->ntrm = ntrm; + nco->ntrn = ntrn; + nco->ntrk = ntrk; + end if + ; + ; Copy lats, lon, and gw + ; + print( "copy grid" ); + nco->lat = (/lat/); + if ( grid .eq. "reduced" )then + nco->rlon = (/rlon/); + nco->nlon = (/nlons/); + else + nco->lon = (/lon/); + if ( grid .eq. "staggered" )then + nco->slon = (/slon/); + nco->slat = (/slat/); + filevardef ( nco, "w_stag", var_type, (/"slat"/) ); + nco->w_stag = (/w_stag/); + end if + end if + nco->gw = (/gw/); + ; + ; Copy attributes + ; + print( "copy attributes" ); + ;fileattdef( nco, nc ); + globalAtt = True ; temporary to attach attributes + copy_VarAtts (nc, globalAtt) + copy_VarAtts (globalAtt, nco) + ; Modify source title and caseid + if ( isatt( nco, "source" ) ) then + delete( nco@source ); + end if + if ( isatt( nco, "case" ) ) then + delete( nco@case ); + end if + if ( isatt( nco, "title" ) ) then + delete( nco@title ); + end if + if ( isatt( nc, "source" ) ) then + nco@source = "Interpolated from:" + interpfilename + "::" + nc@source; + else + nco@source = "Interpolated from:" + interpfilename; + end if + nco@case = caseid; + if ( isatt( nc, "title" ) ) then + nco@title = "Interpolated from:" + interpfilename + "::" + nc@title + else + nco@title = "Interpolated from:" + interpfilename; + end if +end + +undef( "set_vertical_levels" ); +procedure set_vertical_levels( nco:file, nc:file ) +; +; Set the vertical levels +; +begin + print( "Set the vertical levels" ); + if ( .not. isfilevar(nc, "lev") )then + print( "lev does not exist on this file do not create vertical levels" ); + return + end if + if ( nlev .eq. dimsizes(nc->lev) )then + if ( .not. isfilevar( nc, "hyai" ) )then + print( "ERROR:: Variable hyai does not exist on the input file" ); + exit; + end if + if ( .not. isfilevar( nc, "hybi" ) )then + print( "ERROR:: Variable hybi does not exist on the input file" ); + exit; + end if + hyai = (/nc->hyai/); + hybi = (/nc->hybi/); + else + set = False; + do i = 0, dimsizes(hybi_standard(:,0))-1 + if ( (.not. set) .and. (nlev .eq. nstandard(i)-1) )then + hyai = hyai_standard(i,:nstandard(i)-1); + hybi = hybi_standard(i,:nstandard(i)-1); + set = True; + end if + end do + if ( .not. set )then + print( "ERROR:: Must add the hybi and hyai interfaces levels for nlev = "+nlev ); + print( "Edit the section of the script that lists values for hybi_standard" ); + exit; + end if + end if + hyam = (hyai(0:nlev-1) + hyai(1:nlev) )*0.5; + hybm = (hybi(0:nlev-1) + hybi(1:nlev) )*0.5; + nco->hyam = hyam; + nco->hybm = hybm; + nco->hyai = hyai; + nco->hybi = hybi; + nco->lev = 1000.*(hyam+hybm); + nco->ilev = 1000.*(hyai+hybi); + print( "lev = "+nco->lev ); + print( "ilev = "+nco->ilev ); +end + diff --git a/tools/interpic/varspecs_mod.f90 b/tools/interpic/varspecs_mod.f90 new file mode 100644 index 0000000000..c2d6a704ec --- /dev/null +++ b/tools/interpic/varspecs_mod.f90 @@ -0,0 +1,23 @@ +module varspecs_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + include 'netcdf.inc' + + type varspecs + character*(nf_max_name) :: name + character*8 :: vshape + + integer :: varid + integer :: totsiz + integer :: xtype + integer :: nx, ny, nz + integer :: tpos + integer :: count(nf_max_var_dims) + + integer, pointer :: numx(:) + real(r8), pointer :: xpos(:,:) + real(r8), pointer :: ypos(:) + real(r8), pointer :: zpos(:) + + end type varspecs +end module varspecs_mod diff --git a/tools/interpic/wrap_nf.f90 b/tools/interpic/wrap_nf.f90 new file mode 100644 index 0000000000..ab29be6615 --- /dev/null +++ b/tools/interpic/wrap_nf.f90 @@ -0,0 +1,333 @@ +subroutine wrap_create (path, cmode, ncid) + implicit none + include 'netcdf.inc' + + character*(*) path + integer cmode, ncid + + integer ret + + ret = nf_create (path, cmode, ncid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_open (path, omode, ncid) + implicit none + include 'netcdf.inc' + + character*(*) path + integer omode + integer ncid + integer ret + + ret = nf_open (path, omode, ncid) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_OPEN: nf_open failed for file ',path + call handle_error (ret) + end if +end subroutine + +subroutine wrap_inq_varid (nfid, varname, varid) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) varname + + integer ret + + ret = nf_inq_varid (nfid, varname, varid) + if (ret.ne.NF_NOERR) then + write(6,*)'nf_inq_varid: ',trim(varname),' not found' + call handle_error (ret) + end if +end subroutine wrap_inq_varid + +subroutine wrap_inq_dimname (nfid, dimid, dimname) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimname (nfid, dimid, dimname) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_dimlen (nfid, dimid, dimlen) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, dimlen + + integer ret + + ret = nf_inq_dimlen (nfid, dimid, dimlen) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimlen + +subroutine wrap_inq_dimid (nfid, dimname, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimid (nfid, dimname, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimid + +subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts + character*(*) varname + + integer ret + + ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_var + +subroutine wrap_def_dim (nfid, dimname, len, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, len, dimid + character*(*) dimname + + integer ret + + ret = nf_def_dim (nfid, dimname, len, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_def_dim + +subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid) + implicit none + include 'netcdf.inc' + + integer nfid, xtype, nvdims, varid + integer vdims(nvdims) + character*(*) name + + integer ret + + ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid) +! write(6,*)'WRAP_DEF_VAR: ',name,' has varid ',varid,nvdims, +! $'dimensions of ids ',(vdims(i),i=1,nvdims) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_get_var_double (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + + ret = nf_get_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_var_double + +subroutine wrap_get_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer arr(*) + + integer ret + + ret = nf_get_var_int (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_var_int + +subroutine wrap_get_vara_double (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(nf_max_dims), count(nf_max_dims) + real*8 arr(*) + + integer ret + + ret = nf_get_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_vara_double + +subroutine wrap_get_vara_int (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + + ret = nf_get_vara_int (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_GET_VARA8: error reading varid =', varid + call handle_error (ret) + end if +end subroutine + +subroutine wrap_put_vara_text (nfid, varid, start, count, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + character*(*) text + + integer ret + + ret = nf_put_vara_text (nfid, varid, start, count, text) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_PUT_VARA_TEXT: error writing varid =', varid + call handle_error (ret) + end if +end subroutine + +!------------------------------------------------------------------------------ + +subroutine wrap_get_vara_text (nfid, varid, start, count, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + character*(*) text + + integer ret + + ret = nf_get_vara_text (nfid, varid, start, count, text) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_GET_VARA_TEXT: error writing varid =', varid + call handle_error (ret) + end if +end subroutine + +subroutine wrap_put_var8 (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + ret = nf_put_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_put_var8 + +subroutine wrap_put_vara_double (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + real(r8) arr(*) + + integer ret + ret = nf_put_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine handle_error (ret) + implicit none + include 'netcdf.inc' + + integer ret + + write(6,*) nf_strerror (ret) + call abort +end subroutine handle_error + +subroutine wrap_put_vara_int (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + ret = nf_put_vara_int (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq (nfid, ndims, nvars, ngatts, unlimdimid) + implicit none + include 'netcdf.inc' + + integer nfid, ndims, nvars, ngatts, unlimdimid + + integer ret + + ret = nf_inq (nfid, ndims, nvars, ngatts, unlimdimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_dim (nfid, dimid, name, length) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, length + character*(*) name + + integer ret + + ret = nf_inq_dim (nfid, dimid, name, length) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_attname (nfid, varid, num, attname) + implicit none + + include 'netcdf.inc' + + integer nfid, varid, num + character*(*) attname + + integer ret + + ret = nf_inq_attname (nfid, varid, num, attname) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_get_att_text (nfid, varid, attname, atttext) + implicit none + + include 'netcdf.inc' + + integer nfid, varid + character*(*) attname, atttext + + integer ret + + ret = nf_get_att_text (nfid, varid, attname, atttext) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_copy_att (nfid, varid, attname, nfido, varido) + implicit none + + include 'netcdf.inc' + + integer nfid, varid, nfido, varido + character*(*) attname + + integer ret + + ret = nf_copy_att (nfid, varid, attname, nfido, varido) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + diff --git a/tools/interpic_new/Makefile b/tools/interpic_new/Makefile new file mode 100644 index 0000000000..cd43e9fdba --- /dev/null +++ b/tools/interpic_new/Makefile @@ -0,0 +1,134 @@ +# Makefile to build interpic on various platforms +# Note: If netcdf library is not built in the standard location, you must set the +# variables INC_NETCDF and LIB_NETCDF + +EXEDIR = . +EXENAME = interpic +RM = rm + +.SUFFIXES: +.SUFFIXES: .o .f90 .F90 + +# Check whether NetCDF library and include directories specified in environment +# or on make commandline. +ifeq ($(strip $(LIB_NETCDF)),) + LIB_NETCDF := /usr/local/lib +endif +ifeq ($(strip $(INC_NETCDF)),) + INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +# Architecture-specific flags and rules +# +#------------------------------------------------------------------------ +# Cray +#------------------------------------------------------------------------ + +ifeq ($(UNAMEM),CRAY) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# SGI +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),IRIX64) +FC = f90 +FFLAGS = -64 -c -trapuv -I$(INC_NETCDF) -g -C -DEBUG:trap_uninitialized=ON +LDFLAGS = -64 -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# SUN +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),SunOS) +FC = f90 +FFLAGS = -c -stackvar -f -I$(INC_NETCDF) -g +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) -qsuffix=cpp=F90 -WF,-DAIX -g -qfullpath +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# OSF1 +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),OSF1) +FC = f90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + +# g95 +#FC = g95 +#FFLAGS = -c -I$(INC_NETCDF) -g -ftrace=full + +# pgf90 +#FC = pgf90 +#FFLAGS = -c -I$(INC_NETCDF) -g -Ktrap=fp -Mrecursive -Mbounds + +# lf95 +#FC = lf95 +#FFLAGS = -c -I$(INC_NETCDF) -g --chk a,e,s,u --pca --trace --trap + +# ifort +FC = ifort +FFLAGS = -c -I$(INC_NETCDF) -g -check all -fpe0 -traceback -ftz -convert big_endian -fp-model precise + +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := addglobal.o compare_var.o control.o cpvar.o dimensions.o driver.o \ + err_exit.o fill_positions.o fmain.o \ + handle_special_cases.o interp.o interpolate_data.o is_special_case.o \ + shr_kind_mod.o wrap_nf.o + +.F90.o: + $(FC) $(FFLAGS) $< + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +addglobal.o: addglobal.F90 +compare_var.o: compare_var.F90 fill_positions.o +control.o: control.F90 +cpvar.o: cpvar.F90 shr_kind_mod.o +dimensions.o: dimensions.F90 shr_kind_mod.o control.o +driver.o: driver.F90 shr_kind_mod.o control.o dimensions.o fill_positions.o interp.o +err_exit.o: err_exit.F90 +fill_positions.o: fill_positions.F90 shr_kind_mod.o control.o +fmain.o: fmain.F90 control.o dimensions.o +handle_special_cases.o: handle_special_cases.F90 shr_kind_mod.o +interp.o: interp.F90 shr_kind_mod.o fill_positions.o interpolate_data.o control.o +interpolate_data.o: interpolate_data.F90 +is_special_case.o: is_special_case.F90 +shr_kind_mod.o: shr_kind_mod.F90 +wrap_nf.o : wrap_nf.F90 diff --git a/tools/interpic_new/README b/tools/interpic_new/README new file mode 100644 index 0000000000..60e341d8a5 --- /dev/null +++ b/tools/interpic_new/README @@ -0,0 +1,91 @@ +25 March 2008, eaton + +Running gnumake in this directory will create an executable named +"interpic". Its function is to take an input CAM history or initial file +and interpolate all time samples to a new horizontal and/or vertical +resolution. + +The output resolution is determined by the coordinates in a template netcdf +file ("-t template_file"). Previously made coordinate files are located in +inputdata/atm/cam/coords. If a coordinate for a field in the input file +exists in the template file (the coordinate must have the same name in both +files), then the field that appears in the output file will be interpolated +from the input file coordinate to the template file coordinate. By default +all fields contained in the input file are interpolated and written to the +output file. + +Certain variable names are hardwired into the interpic code and are +automatically recognized as variables that contain coordinate information. +The variable names are: rlon, nlon, wnummax, hyai, hybi, hyam, hybm, gw, +w_stag, lat, lon, slat, slon, lev, ilev. + +The code assumes that the netCDF conventions for coordinate variables have +been followed, i.e., the dimension of a 1D coordinate variable has the same +name as the associated variable. This means that the following dimension +names which are hardwired into the code are also treated specially: lon, +slon, lat, slat, lev, ilev, time. In addition, the extension of the code +to treat unstructured grids added the dimension name "ncol" to identify the +dimension of the global column indices. + + +This code will eventually replace the original version of interpic. It is, +however, still missing some functionality: + +. If interpolating to a staggered grid, the input dataset must be on a + staggered grid. The original code had hardwired logic to allow + interpolating from a Gauss grid to a staggered grid. The current code + assumes the dimension names of the output grid are the same as the input + grid. It's missing the special logic to allow the lat dimension of V to + become the slat dimension of VS (and similar for U --> US). + +It has been generalized as follows: + +. Can produce non-rectangular grids for output, e.g. cubed sphere grid. + +. No longer requires separate steps to produce a template file containing + the desired fields declared on the desire output grid. The user just + supplies a template file containing the desired output grid. + +. The output precision may optionally be reduced to real*4 when the input + data is real*8 (see commandline option -p). The precision override does + not apply to the coordinate variables which are always output as real*8. + +. Fields from the input file may optionally be excluded from the output + file (see commandline option -e). + +. Fields from the template file may optionally be included on the output + file (see commandline option -i). + + +There are round-off level differences with the original interpic code due +to changes in the interpolation routine. + + +SE Note: + +If a CAM-SE file doesn't already exist for the desired output grid, a +template file can be constructed as follows: + +Start with an output file from a SE test case at the resolution that you +want. + +Create the template file by extracting the lat,lon and ncol variables from +the test case file: + +% ncks -v lat,lon baroclinic1.nc SE_temp.nc + +Convert the lat and lon variables from radians to degrees + +% ncap -O -s "lat=lat*90./asin(1.0);lon=lon*90./asin(1.0)" SE_temp.nc SE_template.nc + +Add the vertical coordinates (from another cam input file) + +% ncks -vhyai,hyam,hybi,hybm cami_0000-09-01_64x128_L30_c031210.nc SE_template.nc + + +Then run interpic: + +% interpic -t SE_template.nc inputfile.nc outputfile.nc + +Finally if you started with an FV based initial file you will need to rename US and VS to +U and V. diff --git a/tools/interpic_new/addglobal.F90 b/tools/interpic_new/addglobal.F90 new file mode 100644 index 0000000000..78f04d520b --- /dev/null +++ b/tools/interpic_new/addglobal.F90 @@ -0,0 +1,61 @@ +subroutine addglobal (ncid, cmdline) + implicit none + + include 'netcdf.inc' +! +! Input arguments +! + integer ncid + character*(*) cmdline +! +! Local workspace +! + integer ret + integer numchars + integer values(8) + integer hnum + integer hlen + + character*8 date + character*10 time + character*5 zone + character*18 datetime + character*16 logname + character*16 hostname + character*1500 :: hist + + call date_and_time (date, time, zone, values) + + datetime(1:8) = date(5:6) // '/' // date(7:8) // '/' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + + call getenv ('LOGNAME', logname) + call getenv ('HOST', hostname) + + hlen = 0 + hist = ' ' + if (nf_inq_attid (ncid, nf_global, 'history', hnum) == nf_noerr) then + ret = nf_inq_attlen (ncid, nf_global, 'history', hlen) + call wrap_get_att_text (ncid, nf_global, 'history', hist) + end if + + hist = trim (hist) // char(10) // datetime // trim (logname) // ':' // & + trim (hostname) // ':' // trim (cmdline) +! +! Add 3 to account for 1st newline and colons between each of 2 trimmed strings +! + hlen = hlen + len(datetime) + len_trim(logname) + len_trim(hostname) + & + len_trim(cmdline) + 3 + + if (hlen > len (hist)) then + write(6,*)'Warning: history attribute too long: truncating' + hlen = len (hist) + end if + + numchars = len_trim (hist) + ret = nf_put_att_text (ncid, nf_global, 'history', numchars, hist) + + return +end subroutine addglobal + + diff --git a/tools/interpic_new/compare_var.F90 b/tools/interpic_new/compare_var.F90 new file mode 100644 index 0000000000..8f80464505 --- /dev/null +++ b/tools/interpic_new/compare_var.F90 @@ -0,0 +1,32 @@ +subroutine compare_var(vari, varo) + + use fill_positions, only: varspec_t + + implicit none + + include 'netcdf.inc' + + ! Input arguments + type(varspec_t), intent(in) :: vari + type(varspec_t), intent(in) :: varo + + ! Local workspace + logical isfloatingi + logical isfloatingo + !------------------------------------------------------------------------------ + + if (vari%name /= varo%name) then + write(6,*)'compare_var: names do not match: ', trim(vari%name), trim(varo%name) + stop 999 + end if + + isfloatingi = vari%xtype == nf_float .or. vari%xtype == nf_double + isfloatingo = varo%xtype == nf_float .or. varo%xtype == nf_double + + if (vari%xtype /= varo%xtype .and. .not. (isfloatingi .and. isfloatingo)) then + write(6,*)'compare_var: types are incompatible for: ', & + trim(vari%name), ' ', trim(varo%name) + stop 999 + end if + +end subroutine compare_var diff --git a/tools/interpic_new/control.F90 b/tools/interpic_new/control.F90 new file mode 100644 index 0000000000..79339760de --- /dev/null +++ b/tools/interpic_new/control.F90 @@ -0,0 +1,156 @@ +module control + + implicit none + private + + include 'netcdf.inc' + + + logical, public :: verbose + logical, public :: silent + logical, public :: compute_gauss + logical, public :: prec_override = .false. + integer, public :: prec_out + + public :: & + set_user_skip, & + set_user_include, & + is_user_skip, & + is_user_include + + integer, parameter :: fexcl_max = 100 + character(len=nf_max_name) :: fexcl(fexcl_max) = ' ' + integer :: num_fexcl = 0 + + integer, parameter :: fincl_max = 100 + character(len=nf_max_name) :: fincl(fincl_max) = ' ' + integer :: num_fincl = 0 + +!======================================================================================= +contains +!======================================================================================= + +subroutine set_user_skip(var_list) + + character(len=*), intent(in) :: var_list + + integer :: i + integer :: start, str_len, next_comma + !------------------------------------------------------------------- + + call delimited_string_to_array(var_list, ',', fexcl, num_fexcl) + + if (verbose) write(6,*)'set_user_skip: fexcl:', trim(var_list) + +end subroutine set_user_skip + +!--------------------------------------------------------------------------------------- + +subroutine set_user_include(var_list) + + character(len=*), intent(in) :: var_list + + integer :: i + integer :: start, str_len, next_comma + !------------------------------------------------------------------- + + call delimited_string_to_array(var_list, ',', fincl, num_fincl) + + if (verbose) write(6,*)'set_user_include: fincl:', trim(var_list) + +end subroutine set_user_include + +!--------------------------------------------------------------------------------------- + +logical function is_user_skip(name) + + character(len=*), intent(in) :: name + + integer :: i + + ! look through list of user specified names to skip (i.e., + ! don't copy/interpolate these variables on input file to + ! the output file + + is_user_skip = .false. + do i = 1, num_fexcl + if (trim(name) == trim(fexcl(i))) then + is_user_skip = .true. + return + end if + end do + +end function is_user_skip + +!--------------------------------------------------------------------------------------- + +logical function is_user_include(name) + + character(len=*), intent(in) :: name + + integer :: i + + ! look through list of user specified names to include, i.e., + ! copy these variables from the template file to the output file. + + is_user_include = .false. + do i = 1, num_fincl + if (trim(name) == trim(fincl(i))) then + is_user_include = .true. + return + end if + end do + +end function is_user_include + +!--------------------------------------------------------------------------------------- + +subroutine delimited_string_to_array(delim_str, delim, array, nelem) + + character(len=*), intent(in) :: delim_str ! string containing delimiter separated tokens + character(len=1), intent(in) :: delim ! value of delimiter + + character(len=nf_max_name), intent(out) :: array(:) ! names + integer, intent(out) :: nelem ! number of tokens + + integer :: i, nelem_max + integer :: start, str_len, next_delim + !------------------------------------------------------------------- + + nelem_max = size(array) + + start = 1 + str_len = len_trim(delim_str) + + ! check that there's at least one variable specified + if (str_len == 0) then + write(6,*) 'delimited_string_to_array: ERROR - input string argument is empty' + stop + end if + + do i = 1, nelem_max + + ! scan for delimiter + next_delim = scan(delim_str(start:str_len), delim) + + ! copy next variable into array + if (next_delim == 0) then + ! if scan returns zero there are no delimiters. So use entire remaining + ! string as a variable name and we're done + array(i) = delim_str(start:str_len) + exit + else + array(i) = delim_str(start:start+next_delim-2) + start = start+next_delim + if (start > str_len) exit + end if + + end do + + nelem = i + +end subroutine delimited_string_to_array + +!--------------------------------------------------------------------------------------- + +end module control diff --git a/tools/interpic_new/cpvar.F90 b/tools/interpic_new/cpvar.F90 new file mode 100644 index 0000000000..4ef8312a92 --- /dev/null +++ b/tools/interpic_new/cpvar.F90 @@ -0,0 +1,53 @@ +subroutine cpvar(ncidi, ncido, vi, vo, name, & + totsiz, xtype, start, count) + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + include 'netcdf.inc' + + ! Input arguments + integer ncidi, ncido + integer vi, vo + integer xtype + integer start(nf_max_var_dims) + integer count(nf_max_var_dims) + integer totsiz + + character*(nf_max_name) :: name + + ! Local workspace + character, allocatable :: cbuf(:) + real(r8), allocatable :: buf(:) + integer, allocatable :: ibuf(:) + + if (xtype == NF_FLOAT .or. xtype == NF_DOUBLE) then + + allocate (buf(totsiz)) + call wrap_get_vara_double (ncidi, vi, start, count, buf) + call wrap_put_vara_double (ncido, vo, start, count, buf) + deallocate (buf) + + else if (xtype == NF_INT) then + + allocate (ibuf(totsiz)) + call wrap_get_vara_int (ncidi, vi, start, count, ibuf) + call wrap_put_vara_int (ncido, vo, start, count, ibuf) + deallocate (ibuf) + + else if (xtype == NF_CHAR) then + + allocate (cbuf(totsiz)) + call wrap_get_vara_text (ncidi, vi, start, count, cbuf) + call wrap_put_vara_text (ncido, vo, start, count, cbuf) + deallocate (cbuf) + + else + + write(6,*)'Unknown type for variable ',name + stop 999 + + end if + +end subroutine cpvar diff --git a/tools/interpic_new/dimensions.F90 b/tools/interpic_new/dimensions.F90 new file mode 100644 index 0000000000..5b75e83ff0 --- /dev/null +++ b/tools/interpic_new/dimensions.F90 @@ -0,0 +1,274 @@ +module dimensions + + use shr_kind_mod, only: r8 => shr_kind_r8 + use control, only: verbose + + implicit none + + private + + public :: info + public :: maxdims + public :: is_ewdim, is_nsdim, is_zdim, add_dim, is_ncoldim + public :: get_dimlen, get_shape + public :: ewdim, nsdim, zdim, ncoldim + public :: ewdimi, nsdimi, zdimi + public :: ncoldimid + + include 'netcdf.inc' + + integer, parameter :: maxdims = 4 + integer :: ncoldimid = -1 + + type info + character*(nf_max_name) :: dimname + integer :: dimlen + end type info + + type(info) :: ewdim(maxdims), nsdim(maxdims), zdim(maxdims), ncoldim(maxdims) + type(info) :: ewdimi(maxdims), nsdimi(maxdims), zdimi(maxdims) + + logical :: init_done = .false. + + character*(nf_max_name) :: ewnames(maxdims) + character*(nf_max_name) :: nsnames(maxdims) + character*(nf_max_name) :: znames(maxdims) + character*(nf_max_name) :: ncolnames(maxdims) + + integer :: newnames, nnsnames, nznames, nncolnames + +contains +!------------------------------------------------------------------------------- + +subroutine init_dims + + integer :: n + + ewnames(:) = ' ' + nsnames(:) = ' ' + znames(:) = ' ' + ncolnames(:) = ' ' + + ewnames(1) = 'lon' + ewnames(2) = 'slon' + nsnames(1) = 'lat' + nsnames(2) = 'slat' + znames(1) = 'lev' + znames(2) = 'ilev' + ncolnames(1) = 'ncol' + + do n=1,size (ewnames) + if (ewnames(n) == ' ') exit + end do + newnames = n - 1 + + do n=1,size (nsnames) + if (nsnames(n) == ' ') exit + end do + nnsnames = n - 1 + + do n=1,size (znames) + if (znames(n) == ' ') exit + end do + nznames = n - 1 + + do n=1,size (ncolnames) + if (ncolnames(n) == ' ') exit + end do + nncolnames = n - 1 + + ewdim(:)%dimname = ' ' + nsdim(:)%dimname = ' ' + zdim(:)%dimname = ' ' + ncoldim(:)%dimname = ' ' + + ewdimi(:)%dimname = ' ' + nsdimi(:)%dimname = ' ' + zdimi(:)%dimname = ' ' + + init_done = .true. + +end subroutine init_dims + +!------------------------------------------------------------------------------- + +logical function is_ewdim (name) + + character*(*) :: name + + integer :: n + + if (.not. init_done) call init_dims + is_ewdim = .false. + + do n=1,newnames + if (name == ewnames(n)) then + is_ewdim = .true. + end if + end do + +end function is_ewdim + +!------------------------------------------------------------------------------- + +logical function is_ncoldim (name) + + character*(*) :: name + + integer :: n + + if (.not. init_done) call init_dims + is_ncoldim = .false. + + do n=1,nncolnames + if (name == ncolnames(n)) then + is_ncoldim = .true. + end if + end do + +end function is_ncoldim + +!------------------------------------------------------------------------------- + +logical function is_nsdim (name) + + character*(*) :: name + + integer :: n + + if (.not. init_done) call init_dims + is_nsdim = .false. + + do n=1,nnsnames + if (name == nsnames(n)) then + is_nsdim = .true. + end if + end do + +end function is_nsdim + +!------------------------------------------------------------------------------- + +logical function is_zdim (name) + + character*(*) :: name + + integer :: n + + if (.not. init_done) call init_dims + is_zdim = .false. + + do n=1,nznames + if (name == znames(n)) then + is_zdim = .true. + end if + end do + +end function is_zdim + +!------------------------------------------------------------------------------- + +subroutine add_dim (arr, dimname, dimlen) + + type(info) :: arr(:) + character*(nf_max_name) :: dimname + integer :: dimlen + + integer :: n + + n = size (arr,1) + if (arr(n)%dimname(1:1) /= ' ') then + call err_exit ('add_dim: not enough space allocated for dimension array') + end if + + ! Postition array arr at first empty slot. + ! If dimension name is already in arr then stop with error. + do n = 1, size(arr, 1) + if (arr(n)%dimname(1:1) == ' ') then + exit + else if (trim(arr(n)%dimname) == trim(dimname)) then + write(6,*)'add_dim: ', trim(dimname), ' already exists' + stop 999 + end if + end do + + ! Add dimension name/size to arr + arr(n)%dimname = trim(dimname) + arr(n)%dimlen = dimlen + + if (verbose) then + write(6,*)'add_dim: ', trim(dimname), dimlen + end if + +end subroutine add_dim + +!------------------------------------------------------------------------------- + +integer function get_dimlen (arr, dimname) + + type(info) :: arr(:) + character*(nf_max_name) :: dimname + + integer :: n + + do n=1,size (arr,1) + if (arr(n)%dimname == dimname) then + get_dimlen = arr(n)%dimlen + return + end if + end do + + write(6,*) 'WARNING: get_dimlen: dimname ',trim(dimname), ' not found' + get_dimlen=-1 + +end function get_dimlen + +!------------------------------------------------------------------------------- + +character*8 function get_shape (ncid, vardids, nvdims, dimnames) + + integer, intent(in) :: ncid + integer, intent(in) :: vardids(nf_max_var_dims) ! variable dimension id's + integer, intent(in) :: nvdims + + character*(nf_max_name), intent(out) :: dimnames(4) + + ! If a time dimension is present we assume that it's the last dimension. + ! In that case the dimension name is returned in dimnames, but the shape + ! is determined by the leading spatial dimensions. + + dimnames(:) = ' ' + + if (nvdims > 0) call wrap_inq_dimname(ncid, vardids(1), dimnames(1)) + if (nvdims > 1) call wrap_inq_dimname(ncid, vardids(2), dimnames(2)) + if (nvdims > 2) call wrap_inq_dimname(ncid, vardids(3), dimnames(3)) + if (nvdims > 3) call wrap_inq_dimname(ncid, vardids(4), dimnames(4)) + + get_shape = 'unknown' + + if ( is_ncoldim (dimnames(1) ) ) then + if(is_zdim (dimnames(2))) then + get_shape='nz' + else + get_shape='n' + end if + else if ( is_ewdim (dimnames(1)) .and. is_nsdim (dimnames(2)) .and. & + .not. is_zdim (dimnames(3))) then + + get_shape = 'xy' + + else if (is_ewdim (dimnames(1)) .and. is_nsdim (dimnames(2)) .and. & + is_zdim (dimnames(3))) then + + get_shape = 'xyz' + + else if (is_ewdim (dimnames(1)) .and. is_zdim (dimnames(2)) .and. & + is_nsdim (dimnames(3))) then + + get_shape = 'xzy' + + end if + +end function get_shape + +end module dimensions diff --git a/tools/interpic_new/driver.F90 b/tools/interpic_new/driver.F90 new file mode 100644 index 0000000000..d6506029da --- /dev/null +++ b/tools/interpic_new/driver.F90 @@ -0,0 +1,418 @@ +subroutine driver(ncidi, ncido, ncidt, ntime) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use control, only: verbose, prec_override, prec_out, is_user_skip + use dimensions, only: ncoldimid, get_shape + use fill_positions, only: varspec_t, fillvar + use interp, only: interp_driver + + implicit none + + include 'netcdf.inc' + + ! Input arguments + + integer ncidi, ncido, ncidt ! input, output, template netcdf file ids + integer ntime ! size of unlimited dimension (if present) in "input" file + + ! Local workspace + + character*8 :: shapei ! dimension order of variable on input file + character*8 :: shapeo ! dimension order of variable on output file + character*(nf_max_name) :: name ! name of variable on input and output file + character*(nf_max_name) :: dimnamesi(4) ! dimension names of a variable on the input file + character*(nf_max_name) :: dimnames(4) ! dimension names for output variable + character*(nf_max_name) :: attname + + integer :: ndims, nvars, ngatts, unlimdimid + + integer :: natts ! number of attributes for a given variable + integer :: nvdims, nvdimsi ! number of dimensions for this variable + integer :: vardids_i(nf_max_var_dims) ! variable dimension id's + integer :: vardids_o(nf_max_var_dims) ! variable dimension id's on output file + integer :: j, k ! spatial indices + integer :: n ! index + integer :: t ! index over unlimited dimension + integer :: v, vi, vo ! loop index over variable id + integer :: vidi ! variable id on input file + integer :: vido ! returned variable id on output file + integer :: nxi, nyi, nzi + integer :: nxo, nyo, nzo + integer :: xtype, xtypeo ! variable type (netcdf) + integer :: tpos ! position of unlimited dimension + integer :: ncp = 0 ! number of variables to copy from input to output + integer :: nintp = 0 ! number of variables that require interpolation + integer :: starti(nf_max_var_dims) + integer :: starto(nf_max_var_dims) + integer :: counto(nf_max_var_dims) + integer :: counti(nf_max_var_dims) + integer :: totsiz + integer, allocatable :: indx_cp(:) ! input file var IDs for variables to be copied + integer, allocatable :: indx_intp(:) ! input file var IDs for variables to be interpolated + integer :: i + logical :: copy + + real(r8), target, allocatable :: arr3d_i(:,:,:) + real(r8), pointer :: arr3d_o(:,:,:) + real(r8), pointer :: arrxyzi(:,:,:) + real(r8), target, allocatable :: arrxyzo(:,:,:) + real, allocatable :: arr3d_o_r4(:,:,:) + + type(varspec_t), allocatable :: varspec_i(:) + type(varspec_t), allocatable :: varspec_o(:) + + logical :: is_special_case + !----------------------------------------------------------------------------- + + ! loop over variables in "input" dataset + call wrap_inq(ncidi, ndims, nvars, ngatts, unlimdimid) + + allocate(indx_cp(nvars)) + allocate(indx_intp(nvars)) + allocate(varspec_i(nvars)) + allocate(varspec_o(nvars)) + indx_cp(:) = -1 + indx_intp(:) = -1 + + do vidi = 1, nvars + + copy = .true. + + call wrap_inq_var(ncidi, vidi, name, xtype, nvdimsi, vardids_i, natts) + + ! Skip any special case variables: they have already been copied to the output file. + if (is_special_case(name)) then + if (verbose) write(6,*)'skipping special case var ',trim(name) + cycle + end if + + ! Skip any variables requested by user + if (is_user_skip(name)) then + if (verbose) write(6,*)'skipping user requested var ',trim(name) + cycle + end if + + ! return name of each dimension (dimnamesi), and the axis ordering (shapei) + shapei = get_shape(ncidi, vardids_i, nvdimsi, dimnamesi) + + vardids_o = 0 + nvdims = nvdimsi + shapeo = ' ' + + ! Set arrays containing information needed to define the variable + ! in the output file. + + if (ncoldimid > 0 .and. (shapei(1:2)=='xz' .or. shapei(1:2)=='xy')) then + + ! If the template file contains an "ncol" dimension then, then the output + ! file uses an unstructured grid. If the input file contains variables on + ! a rectangular grid, then the 'xy' dimensions need to be compressed to a + ! single column dimension 'n'. + + if (shapei .eq. 'xzy') then + + dimnames(1) = 'ncol' + vardids_o(1) = ncoldimid + dimnames(2) = dimnamesi(2) + vardids_o(2) = get_dimid_o(dimnamesi(2)) + + if (nvdimsi > 3) then + dimnames(3) = dimnamesi(4) + vardids_o(3) = get_dimid_o(dimnamesi(4)) + end if + + nvdims = nvdimsi-1 + shapeo = 'nz' + + else if (shapei .eq. 'xyz') then + + dimnames(1) = 'ncol' + vardids_o(1) = ncoldimid + dimnames(2) = dimnamesi(3) + vardids_o(2) = get_dimid_o(dimnamesi(3)) + + if (nvdimsi > 3) then + dimnames(3) = dimnamesi(4) + vardids_o(3) = get_dimid_o(dimnamesi(4)) + end if + + nvdims = nvdimsi-1 + shapeo = 'nz' + + else if(shapei .eq. 'xy') then + + dimnames(1) = 'ncol' + vardids_o(1) = ncoldimid + + if (nvdimsi > 2) then + dimnames(2) = dimnamesi(3) + vardids_o(2) = get_dimid_o(dimnamesi(3)) + end if + + nvdims = nvdimsi - 1 + shapeo = 'n' + + end if + + else + + ! Assume that the dimension names on the output file match the + ! dimension names on the input file. Get the dimension ID from the + ! output file since that may be different from the ID in the input + ! file. + do i = 1, nvdimsi + vardids_o(i) = get_dimid_o(dimnamesi(i)) + end do + + dimnames = dimnamesi + nvdims = nvdimsi + shapeo = shapei + + end if + + ! Allow override of real precision for output fields on 2D or 3D spatial grid + xtypeo = xtype + if (shapei(1:2) == 'xy' .or. shapei(1:2) == 'xz') then + if (prec_override) then + xtypeo = prec_out + end if + end if + + ! Define variable on output file with same type and dimension order as variable + ! on input file + if (nf_def_var(ncido, name, xtypeo, nvdims, vardids_o, vido) /= nf_noerr) then + print*, 'driver: ERROR defining variable ', trim(name), ' type=', xtypeo + print*, 'nvdims=', nvdims, ' dids=',vardids_o(1:nvdims) + stop + ! call wrap_def_var (ncido, name, xtypeo, nvdims, vardids_o, vido) + else + print*, 'create var ', trim(name), ' ndims=', nvdims, ' dids=', vardids_o(1:nvdims), ' vid=', vido + end if + + ! Copy variable's attributes from input to output + do n = 1, natts + call wrap_inq_attname (ncidi, vidi, n, attname) + call wrap_copy_att (ncidi, vidi, attname, ncido, vido) + end do + + if (xtype == NF_FLOAT .or. xtype == NF_DOUBLE) then + + ! Interpolated variables must be of a floating point type and have dimensions + ! xy, xyz, or xzy. + ! Assumption: All variables using a horizontal grid need to be interpolated. + if (shapeo == 'xy' .or. shapeo == 'xyz' .or. shapeo == 'xzy' .or. shapeo == 'n' .or. shapeo =='nz') then + + copy = .false. + nintp = nintp + 1 + indx_intp(nintp) = vidi + end if + end if + + ! Variables to be copied will not be interpolated. + if (copy) then + ncp = ncp + 1 + indx_cp(ncp) = vidi + end if + + ! Set the varspec_i array with coordinate information for each variable + ! from the input file. + call fillvar(ncidi, name, xtype, shapei, dimnamesi, & + vidi, nvdimsi, vardids_i, varspec_i(vidi)) + + + ! Set the varspec_o array with coordinate information for each variable + ! from the output file. + call fillvar(ncido, name, xtypeo, shapeo, dimnames, & + vido, nvdims, vardids_o, varspec_o(vidi)) + + call compare_var(varspec_i(vidi), varspec_o(vidi)) + + shapeo='' + shapei='' + dimnames='' + + end do ! loop over input variables + + ! Take the output file out of define mode + if (nf_enddef(ncido) /= NF_NOERR) then + print *,'ERROR: nf_enddef(ncido) = ',nf_enddef(ncido) + stop + endif + + ! Now loop over the time dimension. First do copies + if (verbose) write(6,*)'Copy and interpolate from input to output. ntime=',ntime + do t = 1, ntime + + if (verbose) write(6,*)'Starting time sample ',t + + do n = 1, ncp + v = indx_cp(n) + name = varspec_i(v)%name + totsiz = varspec_i(v)%totsiz + xtype = varspec_i(v)%xtype + vi = varspec_i(v)%varid + vo = varspec_o(v)%varid + starti(:) = 1 + counto(:) = varspec_i(v)%count(:) + + if (varspec_i(v)%tpos > 0) then + tpos = varspec_i(v)%tpos + starti(tpos) = t + end if + + if (verbose) then + write(6,*)'Copying variable ',trim(name), vi, vo + end if + + call cpvar(ncidi, ncido, vi, vo, name, & + totsiz, xtype, starti, counto) + end do + + ! Now the data which need to be interpolated + + do n = 1, nintp + + v = indx_intp(n) + + name = varspec_i(v)%name + + if (verbose) then + write(6,*) 'Interpolating '//trim(name) + end if + + vi = varspec_i(v)%varid + shapei = varspec_i(v)%vshape + nxi = varspec_i(v)%nx + nyi = varspec_i(v)%ny + nzi = varspec_i(v)%nz + counti(:) = varspec_i(v)%count(:) + + if (verbose) then + write(6,'(a16,a3,3(a5,i6))') ' input: shape=', trim(shapei), ' nx=', nxi, ' ny=', nyi, ' nz=', nzi + end if + + vo = varspec_o(v)%varid + shapeo = varspec_o(v)%vshape + nxo = varspec_o(v)%nx + nyo = varspec_o(v)%ny + nzo = varspec_o(v)%nz + counto(:) = varspec_o(v)%count + + if (verbose) then + write(6,'(a16,a3,3(a5,i6))') ' output: shape=', trim(shapeo), ' nx=', nxo, ' ny=', nyo, ' nz=', nzo + end if + + + starti(:) = 1 + starto(:) = 1 + + if (varspec_i(v)%tpos > 0) then + tpos = varspec_i(v)%tpos + if(shapeo(1:1).eq.'n') then + starto(tpos-1) = t + else + starto(tpos) = t + end if + starti(tpos) = t + end if + + allocate(arrxyzo(nxo,nyo,nzo)) + if (trim(shapei) == 'xzy') then + allocate(arr3d_i(nxi,nzi,nyi)) + allocate(arrxyzi(nxi,nyi,nzi)) + else + allocate(arr3d_i(nxi,nyi,nzi)) + end if + + call wrap_get_vara_double(ncidi, vi, starti, counti, arr3d_i) + + if (trim(shapei) == 'xzy') then + do k = 1, nzi + do j = 1, nyi + do i = 1, nxi + arrxyzi(i,j,k) = arr3d_i(i,k,j) + end do + end do + end do + else + arrxyzi => arr3d_i + end if + + if (verbose) then + write(6,*)' input min, avg, max = ', minval(arrxyzi), & + sum(arrxyzi)/real(size(arrxyzi), r8), maxval(arrxyzi) + end if + + call interp_driver(ncidi, ncido, arrxyzi, arrxyzo, varspec_i(v), varspec_o(v), nxi, & + nzi, nyi, nxo, nzo, nyo) + + if (verbose) then + write(6,*)' output min, avg, max= ', minval(arrxyzo), & + sum(arrxyzo)/real(size(arrxyzo), r8), maxval(arrxyzo) + end if + + ! Output uses same dimension ordering as input + if (trim(shapei) == 'xzy') then + allocate(arr3d_o(nxo,nzo,nyo)) + do k = 1, nzo + do j = 1, nyo + do i = 1, nxo + arr3d_o(i,k,j) = arrxyzo(i,j,k) + end do + end do + end do + else + arr3d_o => arrxyzo + end if + + if (varspec_o(v)%xtype == NF_DOUBLE) then + call wrap_put_vara_double(ncido, vo, starto, counto, arr3d_o) + else + + ! Convert to 4-byte reals before output + if (trim(shapei) == 'xzy') then + allocate(arr3d_o_r4(nxo,nzo,nyo)) + else + allocate(arr3d_o_r4(nxo,nyo,nzo)) + end if + + arr3d_o_r4 = arr3d_o + if (nf_put_vara_real(ncido, vo, starto, counto, arr3d_o_r4) /= NF_NOERR) then + write(6,*) 'driver: ERROR from nf_put_vara_real' + stop + end if + deallocate(arr3d_o_r4) + end if + + deallocate(arr3d_i) + deallocate(arrxyzo) + if (trim(shapei) == 'xzy') then + deallocate(arrxyzi) + deallocate(arr3d_o) + end if + + end do + + end do + + deallocate(indx_cp) + deallocate(indx_intp) + deallocate(varspec_i) + deallocate(varspec_o) + +contains + +integer function get_dimid_o(dimname) + +! Lookup the dimension ID for the requested name in the output file + + character(len=*), intent(in) :: dimname + + if (nf_inq_dimid(ncido, trim(dimname), get_dimid_o) /= nf_noerr) then + print *, 'driver: ERROR: input variable ', trim(name), ' has dimension ', trim(dimname), & + 'which is not found in the output file' + stop + end if +end function get_dimid_o + +end subroutine driver diff --git a/tools/interpic_new/err_exit.F90 b/tools/interpic_new/err_exit.F90 new file mode 100644 index 0000000000..40d157a0ee --- /dev/null +++ b/tools/interpic_new/err_exit.F90 @@ -0,0 +1,8 @@ +subroutine err_exit (string) + implicit none + + character*(*) string + + write(6,*) string + stop 999 +end subroutine err_exit diff --git a/tools/interpic_new/fill_positions.F90 b/tools/interpic_new/fill_positions.F90 new file mode 100644 index 0000000000..c1abeb3fff --- /dev/null +++ b/tools/interpic_new/fill_positions.F90 @@ -0,0 +1,208 @@ +module fill_positions + +use shr_kind_mod, only: r8 => shr_kind_r8 +use control, only: verbose + +implicit none +private + +include 'netcdf.inc' + +public :: varspec_t, fillvar + +type varspec_t + character*(nf_max_name) :: name + character*8 :: vshape + + integer :: varid + integer :: totsiz + integer :: xtype + integer :: nx, ny, nz + integer :: tpos + integer :: count(nf_max_var_dims) + + integer :: x_vid + integer :: y_vid + integer :: z_vid +end type varspec_t + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + +subroutine fillvar(ncid, name, xtype, vshape, dimnames, & + varid, nvdims, vardids, varspec) + + ! arguments + + integer, intent(in) :: ncid + character*(*), intent(in) :: name + integer, intent(in) :: xtype + character*8, intent(in) :: vshape + character*(nf_max_name), intent(in) :: dimnames(nvdims) + integer, intent(in) :: varid + integer, intent(in) :: nvdims + integer, intent(in) :: vardids(nvdims) + + type(varspec_t), intent(out) :: varspec + + ! Local workspace + + integer :: nx, ny, nz + integer :: dimlen + integer :: n + integer :: unlimdimid + character(len=*), parameter :: sub = 'fillvar: ' + !------------------------------------------------------------------------------- + + varspec%name = name + varspec%xtype = xtype + varspec%vshape = vshape + varspec%varid = varid + + varspec%totsiz = 1 + varspec%tpos = 1 + varspec%count(:) = 1 + + nx = 1 + ny = 1 + nz = 1 + + ! Get dimension lengths. + + ! Identify the dimension ID of the unlimited dimension if there is one. + if (nf_inq_unlimdim(ncid, unlimdimid) /= nf_noerr) then + write(6,*) sub//'ERROR return from nf_inq_unlimdim' + end if + + do n = 1, nvdims + + ! If the dimension ID is the unlimited one, assume that it's time + ! and set the count to 1 since will work with 1 record at a time. + if (vardids(n) == unlimdimid) then + varspec%tpos = n + varspec%count(n) = 1 + else + + ! If the dimension ID isn't the unlimited one, get the corresponding size and + ! increment the total size of the variable. + if (nf_inq_dimlen(ncid, vardids(n), dimlen) == nf_noerr) then + varspec%count(n) = dimlen + varspec%totsiz = varspec%totsiz * dimlen + else + write(6,*) sub//'ERROR return from nf_inq_dimlen for dimension '//trim(dimnames(n)) + stop + end if + end if + end do + + ! Now get the IDs of the variables that contain the coordinate information for + ! each spatial dimension + + if (vshape == 'xy') then + + varspec%nx = varspec%count(1) + varspec%ny = varspec%count(2) + varspec%nz = 1 + + call fill_xpos(ncid, dimnames(1), varspec%x_vid) + call fill_yzpos(ncid, dimnames(2), varspec%y_vid) + + else if (vshape == 'xyz') then + + varspec%nx = varspec%count(1) + varspec%ny = varspec%count(2) + varspec%nz = varspec%count(3) + + call fill_xpos(ncid, dimnames(1), varspec%x_vid) + call fill_yzpos(ncid, dimnames(2), varspec%y_vid) + call fill_yzpos(ncid, dimnames(3), varspec%z_vid) + + else if (vshape == 'xzy') then + + varspec%nx = varspec%count(1) + varspec%ny = varspec%count(3) + varspec%nz = varspec%count(2) + + call fill_xpos(ncid, dimnames(1), varspec%x_vid) + call fill_yzpos(ncid, dimnames(3), varspec%y_vid) + call fill_yzpos(ncid, dimnames(2), varspec%z_vid) + + else if (vshape == 'nz') then + + varspec%nx = varspec%count(1) + varspec%ny = 1 + varspec%nz = varspec%count(2) + + call fill_xpos(ncid, dimnames(1), varspec%x_vid) + call fill_yzpos(ncid, dimnames(1), varspec%y_vid) + call fill_yzpos(ncid, dimnames(2), varspec%z_vid) + + else if (vshape == 'n') then + + varspec%nx = varspec%count(1) + varspec%ny = 1 + varspec%nz = 1 + + call fill_xpos(ncid, dimnames(1), varspec%x_vid) + call fill_yzpos(ncid, dimnames(1), varspec%y_vid) + + end if + + if (verbose) then + if (nvdims == 1) then + print*,'fillvar: ',trim(name),'(',trim(dimnames(1)),'=',varspec%count(1),')' + else if (nvdims == 2) then + print*,'fillvar: ',trim(name),'(',trim(dimnames(1)),'=',varspec%count(1),trim(dimnames(2)),'=',varspec%count(2),')' + else if (nvdims == 3) then + print*,'fillvar: ',trim(name),'(',trim(dimnames(1)),'=',varspec%count(1),trim(dimnames(2)),'=',varspec%count(2),& + trim(dimnames(3)),'=',varspec%count(3),')' + else if (nvdims == 4) then + print*,'fillvar: ',trim(name),'(',trim(dimnames(1)),'=',varspec%count(1),trim(dimnames(2)),'=',varspec%count(2),& + trim(dimnames(3)),'=',varspec%count(3),trim(dimnames(4)),'=',varspec%count(4),')' + end if + end if + +end subroutine fillvar + +!------------------------------------------------------------------------------- + +subroutine fill_xpos(ncid, dimname, x_vid) + + ! arguments + integer, intent(in) :: ncid + character(len=nf_max_name), intent(in) :: dimname + + integer, intent(out) :: x_vid + !------------------------------------------------------------- + + if (dimname == 'ncol') then + call wrap_inq_varid(ncid, 'lon', x_vid) + else + call wrap_inq_varid(ncid, dimname, x_vid) + end if + +end subroutine fill_xpos + +!------------------------------------------------------------------------------- + +subroutine fill_yzpos(ncid, dimname, yz_vid) + + ! arguments + integer, intent(in) :: ncid + character(len=nf_max_name), intent(in) :: dimname + + integer, intent(out) :: yz_vid + !------------------------------------------------------------- + + if (dimname == 'ncol') then + call wrap_inq_varid(ncid, 'lat', yz_vid) + else + call wrap_inq_varid(ncid, dimname, yz_vid) + end if + +end subroutine fill_yzpos + +!------------------------------------------------------------------------------- +end module fill_positions + diff --git a/tools/interpic_new/fmain.F90 b/tools/interpic_new/fmain.F90 new file mode 100644 index 0000000000..a293e3d9f7 --- /dev/null +++ b/tools/interpic_new/fmain.F90 @@ -0,0 +1,245 @@ +program fmain + + use control, only: verbose, silent, prec_override, prec_out, & + set_user_skip, set_user_include + use dimensions, only: is_ewdim, is_nsdim, is_zdim, is_ncoldim, ncoldimid + + implicit none + + include 'netcdf.inc' + + ! Local workspace + + character(len=256) :: arg, file1, file2, template + character(len=256) :: exclude = ' ', inc_template = ' ' + character(len=1024) :: cmdline + character(len=nf_max_name) :: name, namei + character(len=nf_max_name) :: attname + + integer :: attlen + integer :: ncidi, ncido, ncidt + integer :: ndims, ndimsi + integer :: unlimdimid, unlimdimidi + integer :: dimlen + integer :: dimid + integer :: nvars, nvarsi + integer :: ngatts, ngattsi + integer :: ret + integer :: n + integer :: ntime = 1 + integer :: nargs + integer :: nprec + + integer iargc + external iargc + + ! Default settings before parsing argument list + + file1 = ' ' + file2 = ' ' + template = ' ' + verbose = .false. + silent = .false. + + nargs = iargc() + n = 1 + cmdline = 'interpic ' + do while (n .le. nargs) + arg = ' ' + call getarg(n, arg) + n = n + 1 + + select case (arg) + case ('-e') + call getarg(n, arg) + n = n + 1 + exclude = arg + cmdline = trim(cmdline) // ' -e ' // trim(arg) + case ('-i') + call getarg(n, arg) + n = n + 1 + inc_template = arg + cmdline = trim(cmdline) // ' -i ' // trim(arg) + case ('-p') + prec_override = .true. + call getarg(n, arg) + n = n + 1 + read(arg,'(i1)') nprec + cmdline = trim(cmdline) // ' -p ' // trim(arg) + case ('-s') + silent = .true. + cmdline = trim(cmdline) // ' -s' + case ('-t') + call getarg(n, arg) + n = n + 1 + template = arg + cmdline = trim(cmdline) // ' -t ' // trim(template) + case ('-v') + verbose = .true. + cmdline = trim(cmdline) // ' -v' + case default + if (file1 .eq. ' ') then + file1 = arg + else if (file2 .eq. ' ') then + file2 = arg + else + write (6,*) 'Argument ', arg,' is not known' + call usage_exit(' ') + end if + cmdline = trim(cmdline) // ' ' // trim(arg) + end select + end do + + if (file1 .eq. ' ' .or. file2 .eq. ' ') then + call usage_exit('Must enter an input file and an output file') + else if (silent .and. verbose) then + call usage_exit('-s cannot be specified with -v') + end if + + if (len_trim(exclude) > 0) then + call set_user_skip(exclude) + end if + + if (len_trim(inc_template) > 0) then + call set_user_include(inc_template) + end if + + if (prec_override) then + if (nprec == 4) then + prec_out = NF_FLOAT + else if (nprec == 8) then + prec_out = NF_DOUBLE + else + call usage_exit('-p can only be set to 4 or 8') + end if + end if + + ! Open input and output netcdf files + call wrap_open(file1, NF_NOWRITE, ncidi) + call wrap_open(template, NF_NOWRITE, ncidt) + call wrap_create (file2, IOR(NF_CLOBBER,NF_64BIT_OFFSET), ncido) + + ! Determine space dimensions of output file from template file. + ! Currently all spatial dimensions of the output file must exist + ! on the template file. + call wrap_inq(ncidt, ndims, nvars, ngatts, unlimdimid) + + do n=1,ndims + + call wrap_inq_dim(ncidt, n, name, dimlen) + + if (is_ncoldim(name) .or. is_ewdim(name) .or. & + is_nsdim(name) .or. is_zdim (name) ) then + + if (nf_def_dim(ncido, name, dimlen, dimid) /= NF_NOERR) then + print *, 'fmain: ERROR return from nf_def_dim: failed to define '//trim(name) + end if + + if (verbose) then + print *, 'define dim from template file: '//trim(name)//' len=',dimlen + end if + + if (is_ncoldim(name)) ncoldimid = dimid + + end if + + end do + + ! Determine all non-spatial dimensions from the input file + call wrap_inq(ncidi, ndimsi, nvarsi, ngattsi, unlimdimidi) + + do n=1,ndimsi + + call wrap_inq_dim(ncidi, n, name, dimlen) + + if (.not. is_ncoldim(name) .and. .not. is_ewdim(name) .and. & + .not. is_nsdim(name) .and. .not. is_zdim (name) ) then + + ! check for time dimension + if (trim(name) == 'time') then + ntime = dimlen + + ! Reset dimlen for unlimited dimension + ! make sure time is marked UNLIMITED. netcdf3, 64bit, only allows + ! 4GB variables. if time is UNLIMITED, each timeslice limited to 4GB + ! otherwise, entire variable must be < 4GB + dimlen = NF_UNLIMITED + if (n /= unlimdimidi) then + print *, 'fmain: INFO: change the time dimension from fixed length to unlimited' + end if + + end if + + if (nf_def_dim(ncido, name, dimlen, dimid) /= NF_NOERR) then + print *, 'fmain: ERROR return from nf_def_dim: failed to define '//trim(name) + end if + + if (verbose) then + print *, 'define dim from input file: '//trim(name)//' len=',dimlen + end if + + end if + + end do + + ! Copy global attributes from input to output file + do n=1,ngattsi + + call wrap_inq_attname(ncidi, NF_GLOBAL, n, attname) + + if (verbose) then + write(6,*) 'copy '//trim(attname) + end if + + call wrap_copy_att(ncidi, NF_GLOBAL, attname, ncido, NF_GLOBAL) + + end do + + ! Add global attributes for interpic + call addglobal(ncido, cmdline) + + ! Special cases: spatial coordinate variables and variables that depend on spatial + ! dimensions will be copied from the template file to output file + if (verbose) then + write(6,*) 'handle_special_cases from template file:' + end if + call handle_special_cases(ncidt, ncido) + + ! Copying spatial coordinate variables and variables that depend on spatial + ! dimensions from the input file to output is currently disabled. + ! + !if (verbose) then + ! write(6,*) 'handle_special_cases from input file:' + !end if + !call handle_special_cases(ncidi, ncido) + + ! Call driver code to do the interpolations and/or copies + call driver(ncidi, ncido, ncidt, ntime) + + if (nf_close(ncido) /= nf_noerr) then + call err_exit('error from nf_close') + end if + if (verbose) then + write(6,*) 'Finished.' + end if + +end program fmain + +subroutine usage_exit (arg) + implicit none + character*(*) arg + + if (arg.ne.' ') write (6,*) arg + write (6,*) 'Usage: interpic [-e "var1,...,varn"] [-i "var1,...,varn"] & + &[-p (4 or 8)] [-s] [-v]' + write (6,*) ' -t template infile outfile' + write (6,*) 'OPTIONS:' + write (6,*) '-e comma separated list of variables to exclude when & + ©ing from input file to output file' + write (6,*) '-i comma separated list of variables to include when & + ©ing from template file to output file' + write (6,*) '-p set precision of data variables in output file' + write (6,*) '-s set silent mode' + write (6,*) '-v set verbose mode' + stop 999 +end subroutine usage_exit diff --git a/tools/interpic_new/handle_special_cases.F90 b/tools/interpic_new/handle_special_cases.F90 new file mode 100644 index 0000000000..73b6b731a5 --- /dev/null +++ b/tools/interpic_new/handle_special_cases.F90 @@ -0,0 +1,109 @@ +subroutine handle_special_cases(ncidt, ncido) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use control, only: verbose, is_user_include + + implicit none + + include 'netcdf.inc' + + ! arguments + integer, intent(in) :: ncidt + integer, intent(in) :: ncido + + ! Local workspace + integer :: ndims + integer :: nvars + integer :: ngatts + integer :: unlimdimid + + character*(nf_max_name) :: name + integer :: xtype + integer :: nvdims + integer :: vardids(nf_max_var_dims) ! variable dimension ids + integer :: natts + + integer :: n + integer :: vt, vo + character*(nf_max_name) :: dim_name + integer :: dimlen + integer :: totsiz + integer :: vardids_o(nf_max_var_dims) + integer :: start(nf_max_var_dims) + integer :: count(nf_max_var_dims) + integer :: ret + + character*(nf_max_name) :: attname + + logical :: is_special_case + + ! Copy all the special case variables from template to output + ! Probably should have separate "define" and "put" loops to optimize redef/enddef + ! + ! ***N.B.*** This routine assumes that the required dimensions have already + ! been defined. + + call wrap_inq(ncidt, ndims, nvars, ngatts, unlimdimid) + + start(:) = 1 + + do vt = 1, nvars + + call wrap_inq_var(ncidt, vt, name, xtype, nvdims, vardids, natts) + + if (is_special_case(name) .or. is_user_include(name)) then + + totsiz = 1 + + ! The dimension IDs from the template file need to be translated + ! to the appropriate ID for the output file. + ! ***N.B.*** Assume that the dimension names are the same on + ! the template and output files + do n = 1, nvdims + + ! Get dimension name and length from the template file + if (nf_inq_dim(ncidt, vardids(n), dim_name, dimlen) /= NF_NOERR) then + write(6,*)'handle_special_cases: ERROR from nf_inq_dim for variable='//& + trim(name)//', dimID=',vardids(n) + end if + + ! Get dimension ID from the output file + if (nf_inq_dimid(ncido, dim_name, vardids_o(n)) /= NF_NOERR) then + write(6,*)'handle_special_cases: ERROR from nf_inq_dimid for dimension='//& + trim(dim_name) + end if + + count(n) = dimlen + totsiz = totsiz * dimlen + + end do + + ! special variables that have previously been defined won't be overwritten + ! because this define request will fail. + if( nf_def_var(ncido, name, xtype, nvdims, vardids_o, vo) == NF_NOERR) then + + ! Copy attributes from input to output, then the variable itself + do n = 1, natts + call wrap_inq_attname(ncidt, vt, n, attname) + call wrap_copy_att(ncidt, vt, attname, ncido, vo) + end do + + ! leave define mode + if (nf_enddef(ncido) /= NF_NOERR) stop 999 + + if(verbose) print *, "Copying special var ", trim(name) + + call cpvar(ncidt, ncido, vt, vo, name, & + totsiz, xtype, start, count ) + + ! return to define mode + ret = nf_redef(ncido) + else + if(verbose) print *, "Cannot define special var ", trim(name) + end if + + end if ! is special case + + end do ! loop over variables on input file + +end subroutine handle_special_cases diff --git a/tools/interpic_new/interp.F90 b/tools/interpic_new/interp.F90 new file mode 100644 index 0000000000..343f9734f9 --- /dev/null +++ b/tools/interpic_new/interp.F90 @@ -0,0 +1,183 @@ +module interp + +use control, only: verbose + +implicit none +save +private + +public :: interp_driver + +contains + +subroutine interp_driver(ncidi, ncido, f_in, f_out, vari, varo, nxi, & + nzi, nyi, nxo, nzo, nyo) + + ! first cut -- horizontal interpolation only + ! Assume COARDS ordering, i.e., xyz + + use shr_kind_mod, only: r8 => shr_kind_r8 + use fill_positions, only: varspec_t + use interpolate_data, only: lininterp, lininterp_init, interp_type, lininterp_finish + + implicit none + + include 'netcdf.inc' + + ! arguments + + integer, intent(in) :: ncidi, ncido + integer, intent(in) :: nxi, nyi, nzi + integer, intent(in) :: nxo, nyo, nzo + + type(varspec_t), intent(in) :: vari, varo + + real(r8), target, intent(in) :: f_in(nxi,nyi,nzi) + real(r8), intent(out) :: f_out(nxo,nyo,nzo) + + ! Local workspace + integer :: i,j,k + integer :: numxis, numxin + integer :: numxo + integer :: jj, jjs, jjn + integer :: count + + real(r8) :: x_in(nxi), x_out(nxo), y_in(nyi), z_in(nzi), z_out(nzo) + real(r8), allocatable :: y_out(:) + integer, parameter :: use_bnd_value_to_extrap = 1 + integer, parameter :: cyclic_bnds = 2 + type(interp_type) :: xwgts, ywgts, zwgts + + logical :: do_vert_interp, do_horiz_interp + real(r8), allocatable :: col_in(:), col_out(:) + real(r8), pointer :: f_z(:,:,:) + !----------------------------------------------------------------------------- + + ! Check whether vertical interpolation is needed. + + do_vert_interp = .false. + + if (nzi > 1) then + + ! If nzi > 1 then assume a vertical coordinate is present. And if the input + ! variable has a vertical coordinate then so does the output, even if its size + ! is 1. + call wrap_get_var_double(ncidi, vari%z_vid, z_in) + call wrap_get_var_double(ncido, varo%z_vid, z_out) + + ! If number of input and output levels is the same, check whether the coordinates + ! are different. Otherwise no need to interpolate. + if (nzi == nzo) then + do k = 1, nzi + if ( abs(z_in(k) - z_out(k)) > 1.e-4 ) do_vert_interp = .true. + end do + else + ! If number of levels changes on output the interpolation is required. + do_vert_interp = .true. + end if + + end if + + if (do_vert_interp) then + + if (verbose) then + write(6,*)' doing vertical interpolation' + end if + + allocate(f_z(nxi,nyi,nzo)) + allocate(col_in(nzi)) + allocate(col_out(nzo)) + + call lininterp_init(z_in, nzi, z_out, nzo, use_bnd_value_to_extrap, zwgts) + + ! interpolate a column at a time + do j = 1, nyi + do i = 1, nxi + do k = 1, nzi + col_in(k) = f_in(i,j,k) + end do + call lininterp(col_in, nzi, col_out, nzo, zwgts) + do k = 1, nzo + f_z(i,j,k) = col_out(k) + end do + end do + end do + + deallocate(col_in) + deallocate(col_out) + else + f_z => f_in + end if + + ! Get x and y coordinates + call wrap_get_var_double(ncidi, vari%x_vid, x_in) + call wrap_get_var_double(ncidi, vari%y_vid, y_in) + call wrap_get_var_double(ncido, varo%x_vid, x_out) + + if (nyo > 1) then + allocate(y_out(nyo)) + else + ! This is the unstructured grid mode. The number of global + ! columns is nxo + allocate(y_out(nxo)) + end if + call wrap_get_var_double(ncido, varo%y_vid, y_out) + + ! Check whether horizontal interpolation is needed + + do_horiz_interp = .false. + + if (nxi == nxo .and. nyi == nyo) then + + ! If grids are the same shape then need to check coordinates + do i = 1, nxi + if ( abs(x_in(i) - x_out(i)) > 1.e-4 ) do_horiz_interp = .true. + end do + do j = 1, nyi + if ( abs(y_in(j) - y_out(j)) > 1.e-4 ) do_horiz_interp = .true. + end do + + else + ! If grids aren't the same shape then interpolation is needed + do_horiz_interp = .true. + end if + + if (do_horiz_interp) then + + if (verbose) then + write(6,*)' doing horizontal interpolation' + end if + + call lininterp_init(x_in, nxi, x_out, nxo, cyclic_bnds, xwgts) + + if (nyo > 1) then + ! Output grid is rectangular. + call lininterp_init(y_in, nyi, y_out, nyo, use_bnd_value_to_extrap, ywgts) + + do k = 1, nzo + call lininterp(f_z(:,:,k), nxi, nyi, f_out(:,:,k), nxo, nyo, xwgts, ywgts) + end do + else + ! Output grid is unstructured. + call lininterp_init(y_in, nyi, y_out, nxo, use_bnd_value_to_extrap, ywgts) + + do k = 1, nzo + call lininterp(f_z(:,:,k), nxi, nyi, f_out(:,1,k), nxo, xwgts, ywgts) + end do + end if + + call lininterp_finish(xwgts) + call lininterp_finish(ywgts) + + else + f_out = f_z + end if + + deallocate(y_out) + if (do_vert_interp) then + deallocate(f_z) + end if + +end subroutine interp_driver + +end module interp diff --git a/tools/interpic_new/interpolate_data.F90 b/tools/interpic_new/interpolate_data.F90 new file mode 100644 index 0000000000..87e8c2aff6 --- /dev/null +++ b/tools/interpic_new/interpolate_data.F90 @@ -0,0 +1,1083 @@ +! copied from cam3_5_26. Get rid of some CAM utilities to avoid +! spiralling into the dependency abyss! +! remove use association of cam_abortutils, scamMod, cam_logfile + +module interpolate_data +! Description: +! Routines for interpolation of data in latitude, longitude and time. +! +! Author: Gathered from a number of places and put into the current format by Jim Edwards +! +! Modules Used: +! + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + private +! +! Public Methods: +! + + public :: interp_type, lininterp, vertinterp, bilin, get_timeinterp_factors + public :: lininterp_init, lininterp_finish + type interp_type + private + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + end type interp_type + interface lininterp + module procedure lininterp_original + module procedure lininterp_full1d + module procedure lininterp1d + module procedure lininterp2d2d + module procedure lininterp2d1d + end interface + + integer, parameter :: iulog = 6 + +contains + subroutine lininterp_full1d (arrin, yin, nin, arrout, yout, nout) + integer, intent(in) :: nin, nout + real(r8), intent(in) :: arrin(nin), yin(nin), yout(nout) + real(r8), intent(out) :: arrout(nout) + type (interp_type) :: interp_wgts + + call lininterp_init(yin, nin, yout, nout, 1, interp_wgts) + call lininterp1d(arrin, nin, arrout, nout, interp_wgts) + call lininterp_finish(interp_wgts) + + end subroutine lininterp_full1d + + subroutine lininterp_init(yin, nin, yout, nout, extrap_method, interp_wgts, & + cyclicmin, cyclicmax) +! +! Description: +! Initialize a variable of type(interp_type) with weights for linear interpolation. +! this variable can then be used in calls to lininterp1d and lininterp2d. +! yin is a 1d array of length nin of locations to interpolate from - this array must +! be monotonic but can be increasing or decreasing +! yout is a 1d array of length nout of locations to interpolate to, this array need +! not be ordered +! extrap_method determines how to handle yout points beyond the bounds of yin +! if 0 set values outside output grid to 0 +! if 1 set to boundary value +! if 2 set to cyclic boundaries +! optional values cyclicmin and cyclicmax can be used to set the bounds of the +! cyclic mapping - these default to 0 and 360. +! + + integer, intent(in) :: nin + integer, intent(in) :: nout + real(r8), intent(in) :: yin(nin) ! input mesh + real(r8), intent(in) :: yout(nout) ! output mesh + integer, intent(in) :: extrap_method ! if 0 set values outside output grid to 0 + ! if 1 set to boundary value + ! if 2 set to cyclic boundaries + real(r8), intent(in), optional :: cyclicmin, cyclicmax + + type (interp_type), intent(out) :: interp_wgts + real(r8) :: cmin, cmax + real(r8) :: extrap + real(r8) :: dyinwrap + real(r8) :: ratio + real(r8) :: avgdyin + integer :: i, j, icount + integer :: jj + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + logical :: increasing + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nin.lt.2) then + call endrun('LININTERP: Must have at least 2 input points for interpolation') + end if + if(present(cyclicmin)) then + cmin=cyclicmin + else + cmin=0_r8 + end if + if(present(cyclicmax)) then + cmax=cyclicmax + else + cmax=360_r8 + end if + if(cmax<=cmin) then + call endrun('LININTERP: cyclic min value must be < max value') + end if + increasing=.true. + icount = 0 + do j=1,nin-1 + if (yin(j).gt.yin(j+1)) icount = icount + 1 + end do + if(icount.eq.nin-1) then + increasing = .false. + icount=0 + endif + if (icount.gt.0) then + call endrun('LININTERP: Non-monotonic input coordinate array found') + end if + allocate(interp_wgts%jjm(nout), & + interp_wgts%jjp(nout), & + interp_wgts%wgts(nout), & + interp_wgts%wgtn(nout)) + + jjm => interp_wgts%jjm + jjp => interp_wgts%jjp + wgts => interp_wgts%wgts + wgtn => interp_wgts%wgtn + + ! + ! Initialize index arrays for later checking + ! + jjm = 0 + jjp = 0 + + extrap = 0. + if(extrap_method.eq.0) then + ! + ! For values which extend beyond boundaries, set weights + ! such that values will be 0. + ! + do j=1,nout + if(increasing) then + if (yout(j).lt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 0. + wgtn(j) = 0. + extrap = extrap + 1. + else if (yout(j).gt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 0. + wgtn(j) = 0. + extrap = extrap + 1. + end if + else + if (yout(j).gt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 0. + wgtn(j) = 0. + extrap = extrap + 1. + else if (yout(j).lt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 0. + wgtn(j) = 0. + extrap = extrap + 1. + end if + end if + end do + else if(extrap_method.eq.1) then + ! + ! For values which extend beyond boundaries, set weights + ! such that values will just be copied. + ! + do j=1,nout + if(increasing) then + if (yout(j).le.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1. + wgtn(j) = 0. + extrap = extrap + 1. + else if (yout(j).gt.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 1. + wgtn(j) = 0. + extrap = extrap + 1. + end if + else + if (yout(j).gt.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1. + wgtn(j) = 0. + extrap = extrap + 1. + else if (yout(j).le.yin(nin)) then + jjm(j) = nin + jjp(j) = nin + wgts(j) = 1. + wgtn(j) = 0. + extrap = extrap + 1. + end if + end if + end do + else if(extrap_method.eq.2) then + ! + ! For values which extend beyond boundaries, set weights + ! for circular boundaries + ! + dyinwrap = yin(1) + (cmax-cmin) - yin(nin) + avgdyin = abs(yin(nin)-yin(1))/(nin-1.) + ratio = dyinwrap/avgdyin + if (ratio < 0.9 .or. ratio > 1.1) then + write(iulog,*) 'Lininterp: Bad dyinwrap value =',dyinwrap,& + ' avg=', avgdyin, yin(1),yin(nin) + call endrun('interpolate_data') + end if + + do j=1,nout + if(increasing) then + if (yout(j) <= yin(1)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin) - yin(nin))/dyinwrap + else if (yout(j) > yin(nin)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)+(cmax-cmin)-yout(j))/dyinwrap + wgtn(j) = (yout(j)-yin(nin))/dyinwrap + end if + else + if (yout(j) > yin(1)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin) - yin(nin))/dyinwrap + else if (yout(j) <= yin(nin)) then + jjm(j) = nin + jjp(j) = 1 + wgts(j) = (yin(1)+(cmax-cmin)-yout(j))/dyinwrap + wgtn(j) = (yout(j)+(cmax-cmin)-yin(nin))/dyinwrap + end if + + endif + end do + end if + + ! + ! Loop though output indices finding input indices and weights + ! + if(increasing) then + do j=1,nout + do jj=1,nin-1 + if (yout(j).gt.yin(jj) .and. yout(j).le.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + else + do j=1,nout + do jj=1,nin-1 + if (yout(j).le.yin(jj) .and. yout(j).gt.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + end if + +#ifndef SPMD + ! + ! Check grid overlap + ! + extrap = 100.*extrap/real(nout,r8) + if (extrap.gt.50.) then + write(iulog,*) 'interpolate_data:','yout=',minval(yout),maxval(yout),increasing,nout + write(iulog,*) 'interpolate_data:','yin=',yin(1),yin(nin) + write(iulog,*) 'interpolate_data:',extrap,' % of output grid will have to be extrapolated' + call endrun('interpolate_data: ') + end if +#endif + + ! + ! Check that interp/extrap points have been found for all outputs + ! + icount = 0 + do j=1,nout + if (jjm(j).eq.0 .or. jjp(j).eq.0) icount = icount + 1 + ratio=wgts(j)+wgtn(j) + if((ratio<0.9.or.ratio>1.1).and.extrap_method.ne.0) then + write(iulog,*) j, wgts(j),wgtn(j),jjm(j),jjp(j), increasing,extrap_method + call endrun('Bad weight computed in LININTERP_init') + end if + end do + if (icount.gt.0) then + call endrun('LININTERP: Point found without interp indices') + end if + + end subroutine lininterp_init + + subroutine lininterp1d (arrin, n1, arrout, m1, interp_wgts) + !----------------------------------------------------------------------- + ! + ! Purpose: Do a linear interpolation from input mesh to output + ! mesh with weights as set in lininterp_init. + ! + ! + ! Author: Jim Edwards + ! + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1 ! number of input latitudes + integer, intent(in) :: m1 ! number of output latitudes + + real(r8), intent(in) :: arrin(n1) ! input array of values to interpolate + type(interp_type), intent(in) :: interp_wgts + real(r8), intent(out) :: arrout(m1) ! interpolated array + + ! + ! Local workspace + ! + integer j ! latitude indices + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + + real(r8), pointer :: wgts(:) + real(r8), pointer :: wgtn(:) + + jjm => interp_wgts%jjm + jjp => interp_wgts%jjp + wgts => interp_wgts%wgts + wgtn => interp_wgts%wgtn + + ! + ! Do the interpolation + ! + do j=1,m1 + arrout(j) = arrin(jjm(j))*wgts(j) + arrin(jjp(j))*wgtn(j) + end do + + return + end subroutine lininterp1d + + subroutine lininterp2d2d(arrin, n1, n2, arrout, m1, m2, wgt1, wgt2) + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1, n2, m1, m2 + real(r8), intent(in) :: arrin(n1,n2) ! input array of values to interpolate + type(interp_type), intent(in) :: wgt1, wgt2 + real(r8), intent(out) :: arrout(m1,m2) ! interpolated array + ! + ! locals + ! + integer i,j ! indices + integer, pointer :: iim(:), jjm(:) + integer, pointer :: iip(:), jjp(:) + + real(r8), pointer :: wgts1(:), wgts2(:) + real(r8), pointer :: wgtn1(:), wgtn2(:) + + real(r8) :: arrtmp(n1,m2) + + jjm => wgt2%jjm + jjp => wgt2%jjp + wgts2 => wgt2%wgts + wgtn2 => wgt2%wgtn + + iim => wgt1%jjm + iip => wgt1%jjp + wgts1 => wgt1%wgts + wgtn1 => wgt1%wgtn + + do j=1,m2 + do i=1,n1 + arrtmp(i,j) = arrin(i,jjm(j))*wgts2(j) + arrin(i,jjp(j))*wgtn2(j) + end do + end do + + do j=1,m2 + do i=1,m1 + arrout(i,j) = arrtmp(iim(i),j)*wgts1(i) + arrtmp(iip(i),j)*wgtn1(i) + end do + end do + + end subroutine lininterp2d2d + subroutine lininterp2d1d(arrin, n1, n2, arrout, m1, wgt1, wgt2) + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: n1, n2, m1 + real(r8), intent(in) :: arrin(n1,n2) ! input array of values to interpolate + type(interp_type), intent(in) :: wgt1, wgt2 + real(r8), intent(out) :: arrout(m1) ! interpolated array + ! + ! locals + ! + integer i,j ! indices + integer, pointer :: iim(:), jjm(:) + integer, pointer :: iip(:), jjp(:) + + real(r8), pointer :: wgts(:), wgte(:) + real(r8), pointer :: wgtn(:), wgtw(:) + + real(r8) :: avg + + + jjm => wgt2%jjm + jjp => wgt2%jjp + wgts => wgt2%wgts + wgtn => wgt2%wgtn + + iim => wgt1%jjm + iip => wgt1%jjp + wgtw => wgt1%wgts + wgte => wgt1%wgtn + + do i=1,m1 + arrout(i) = arrin(iim(i),jjm(i))*wgtw(i)*wgts(i)+arrin(iip(i),jjm(i))*wgte(i)*wgts(i) + & + arrin(iim(i),jjp(i))*wgtw(i)*wgtn(i)+arrin(iip(i),jjp(i))*wgte(i)*wgtn(i) + end do + + end subroutine lininterp2d1d + + + subroutine lininterp_finish(interp_wgts) + type(interp_type) :: interp_wgts + + deallocate(interp_wgts%jjm, & + interp_wgts%jjp, & + interp_wgts%wgts, & + interp_wgts%wgtn) + + nullify(interp_wgts%jjm, & + interp_wgts%jjp, & + interp_wgts%wgts, & + interp_wgts%wgtn) + end subroutine lininterp_finish + + subroutine lininterp_original (arrin, yin, nlev, nlatin, arrout, & + yout, nlatout) + !----------------------------------------------------------------------- + ! + ! Purpose: Do a linear interpolation from input mesh defined by yin to output + ! mesh defined by yout. Where extrapolation is necessary, values will + ! be copied from the extreme edge of the input grid. Vectorization is over + ! the vertical (nlev) dimension. + ! + ! Method: Check validity of input, then determine weights, then do the N-S interpolation. + ! + ! Author: Jim Rosinski + ! Modified: Jim Edwards so that there is no requirement of monotonacity on the yout array + ! + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: nlev ! number of vertical levels + integer, intent(in) :: nlatin ! number of input latitudes + integer, intent(in) :: nlatout ! number of output latitudes + + real(r8), intent(in) :: arrin(nlev,nlatin) ! input array of values to interpolate + real(r8), intent(in) :: yin(nlatin) ! input mesh + real(r8), intent(in) :: yout(nlatout) ! output mesh + + real(r8), intent(out) :: arrout(nlev,nlatout) ! interpolated array + ! + ! Local workspace + ! + integer j, jj ! latitude indices + integer jjprev ! latitude indices + integer k ! level index + integer icount ! number of values + + real(r8) extrap ! percent grid non-overlap + ! + ! Dynamic + ! + integer :: jjm(nlatout) + integer :: jjp(nlatout) + + real(r8) :: wgts(nlatout) + real(r8) :: wgtn(nlatout) + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nlatin.lt.2) then + call endrun('LININTERP: Must have at least 2 input points for interpolation') + end if + + icount = 0 + do j=1,nlatin-1 + if (yin(j).gt.yin(j+1)) icount = icount + 1 + end do + + + if (icount.gt.0) then + call endrun('LININTERP: Non-monotonic coordinate array(s) found') + end if + ! + ! Initialize index arrays for later checking + ! + do j=1,nlatout + jjm(j) = 0 + jjp(j) = 0 + end do + ! + ! For values which extend beyond N and S boundaries, set weights + ! such that values will just be copied. + ! + extrap = 0. + + do j=1,nlatout + if (yout(j).le.yin(1)) then + jjm(j) = 1 + jjp(j) = 1 + wgts(j) = 1. + wgtn(j) = 0. + extrap=extrap+1. + else if (yout(j).gt.yin(nlatin)) then + jjm(j) = nlatin + jjp(j) = nlatin + wgts(j) = 1. + wgtn(j) = 0. + extrap=extrap+1. + endif + end do + + ! + ! Loop though output indices finding input indices and weights + ! + do j=1,nlatout + do jj=1,nlatin-1 + if (yout(j).gt.yin(jj) .and. yout(j).le.yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1)-yout(j))/(yin(jj+1)-yin(jj)) + wgtn(j) = (yout(j)-yin(jj))/(yin(jj+1)-yin(jj)) + exit + end if + end do + end do + ! + ! Check that interp/extrap points have been found for all outputs + ! + icount = 0 + do j=1,nlatout + if (jjm(j).eq.0 .or. jjp(j).eq.0) then + icount = icount + 1 + end if + end do + if (icount.gt.0) then + call endrun('LININTERP: Point found without interp indices') + end if + ! + ! Do the interpolation + ! + do j=1,nlatout + do k=1,nlev + arrout(k,j) = arrin(k,jjm(j))*wgts(j) + arrin(k,jjp(j))*wgtn(j) + end do + end do + + return + end subroutine lininterp_original + + + subroutine bilin (arrin, xin, yin, nlondin, nlonin, & + nlevdin, nlev, nlatin, arrout, xout, & + yout, nlondout, nlonout, nlevdout, nlatout) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! + ! Do a bilinear interpolation from input mesh defined by xin, yin to output + ! mesh defined by xout, yout. Circularity is assumed in the x-direction so + ! input x-grid must be in degrees east and must start from Greenwich. When + ! extrapolation is necessary in the N-S direction, values will be copied + ! from the extreme edge of the input grid. Vectorization is over the + ! longitude dimension. Input grid is assumed rectangular. Output grid + ! is assumed ragged, i.e. xout is a 2-d mesh. + ! + ! Method: Interpolate first in longitude, then in latitude. + ! + ! Author: Jim Rosinski + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + !----------------------------------------------------------------------- + implicit none + !----------------------------------------------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: nlondin ! longitude dimension of input grid + integer, intent(in) :: nlonin ! number of real longitudes (input) + integer, intent(in) :: nlevdin ! vertical dimension of input grid + integer, intent(in) :: nlev ! number of vertical levels + integer, intent(in) :: nlatin ! number of input latitudes + integer, intent(in) :: nlatout ! number of output latitudes + integer, intent(in) :: nlondout ! longitude dimension of output grid + integer, intent(in) :: nlonout(nlatout) ! number of output longitudes per lat + integer, intent(in) :: nlevdout ! vertical dimension of output grid + + real(r8), intent(in) :: arrin(nlondin,nlevdin,nlatin) ! input array of values to interpolate + real(r8), intent(in) :: xin(nlondin) ! input x mesh + real(r8), intent(in) :: yin(nlatin) ! input y mesh + real(r8), intent(in) :: xout(nlondout,nlatout) ! output x mesh + real(r8), intent(in) :: yout(nlatout) ! output y mesh + ! + ! Output arguments + ! + real(r8), intent(out) :: arrout(nlondout,nlevdout,nlatout) ! interpolated array + ! + ! Local workspace + ! + integer :: i, ii, iw, ie, iiprev ! longitude indices + integer :: j, jj, js, jn, jjprev ! latitude indices + integer :: k ! level index + integer :: icount ! number of bad values + + real(r8) :: extrap ! percent grid non-overlap + real(r8) :: dxinwrap ! delta-x on input grid for 2-pi + real(r8) :: avgdxin ! avg input delta-x + real(r8) :: ratio ! compare dxinwrap to avgdxin + real(r8) :: sum ! sum of weights (used for testing) + ! + ! Dynamic + ! + integer :: iim(nlondout) ! interpolation index to the left + integer :: iip(nlondout) ! interpolation index to the right + integer :: jjm(nlatout) ! interpolation index to the south + integer :: jjp(nlatout) ! interpolation index to the north + + real(r8) :: wgts(nlatout) ! interpolation weight to the north + real(r8) :: wgtn(nlatout) ! interpolation weight to the north + real(r8) :: wgte(nlondout) ! interpolation weight to the north + real(r8) :: wgtw(nlondout) ! interpolation weight to the north + real(r8) :: igrid(nlonin) ! interpolation weight to the north + ! + ! Check validity of input coordinate arrays: must be monotonically increasing, + ! and have a total of at least 2 elements + ! + if (nlonin < 2 .or. nlatin < 2) then + call endrun ('BILIN: Must have at least 2 input points for interpolation') + end if + + if (xin(1) < 0._r8 .or. xin(nlonin) > 360._r8) then + call endrun ('BILIN: Input x-grid must be between 0 and 360') + end if + + icount = 0 + do i=1,nlonin-1 + if (xin(i) >= xin(i+1)) icount = icount + 1 + end do + + do j=1,nlatin-1 + if (yin(j) >= yin(j+1)) icount = icount + 1 + end do + + do j=1,nlatout-1 + if (yout(j) >= yout(j+1)) icount = icount + 1 + end do + + do j=1,nlatout + do i=1,nlonout(j)-1 + if (xout(i,j) >= xout(i+1,j)) icount = icount + 1 + end do + end do + + if (icount > 0) then + call endrun ('BILIN: Non-monotonic coordinate array(s) found') + end if + + if (yout(nlatout) <= yin(1) .or. yout(1) >= yin(nlatin)) then + call endrun ('BILIN: No overlap in y-coordinates') + end if + + do j=1,nlatout + if (xout(1,j) < 0._r8 .or. xout(nlonout(j),j) > 360._r8) then + call endrun ('BILIN: Output x-grid must be between 0 and 360') + end if + + if (xout(nlonout(j),j) <= xin(1) .or. & + xout(1,j) >= xin(nlonin)) then + call endrun ('BILIN: No overlap in x-coordinates') + end if + end do + ! + ! Initialize index arrays for later checking + ! + do j=1,nlatout + jjm(j) = 0 + jjp(j) = 0 + end do + ! + ! For values which extend beyond N and S boundaries, set weights + ! such that values will just be copied. + ! + do js=1,nlatout + if (yout(js) > yin(1)) exit + jjm(js) = 1 + jjp(js) = 1 + wgts(js) = 1._r8 + wgtn(js) = 0._r8 + end do + + do jn=nlatout,1,-1 + if (yout(jn) <= yin(nlatin)) exit + jjm(jn) = nlatin + jjp(jn) = nlatin + wgts(jn) = 1._r8 + wgtn(jn) = 0._r8 + end do + ! + ! Loop though output indices finding input indices and weights + ! + jjprev = 1 + do j=js,jn + do jj=jjprev,nlatin-1 + if (yout(j) > yin(jj) .and. yout(j) <= yin(jj+1)) then + jjm(j) = jj + jjp(j) = jj + 1 + wgts(j) = (yin(jj+1) - yout(j)) / (yin(jj+1) - yin(jj)) + wgtn(j) = (yout(j) - yin(jj)) / (yin(jj+1) - yin(jj)) + goto 30 + end if + end do + call endrun ('BILIN: Failed to find interp values') +30 jjprev = jj + end do + + dxinwrap = xin(1) + 360._r8 - xin(nlonin) + ! + ! Check for sane dxinwrap values. Allow to differ no more than 10% from avg + ! + avgdxin = (xin(nlonin)-xin(1))/(nlonin-1._r8) + ratio = dxinwrap/avgdxin + if (ratio < 0.9_r8 .or. ratio > 1.1_r8) then + write(iulog,*)'BILIN: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin + call endrun + end if + ! + ! Check grid overlap + ! Do not do on spmd since distributed output grid may be expected to fail this test +#ifndef SPMD + extrap = 100._r8*((js - 1._r8) + real(nlatout - jn,r8))/nlatout + if (extrap > 20._r8) then + write(iulog,*)'BILIN:',extrap,' % of N/S output grid will have to be extrapolated' + end if +#endif + ! + ! Check that interp/extrap points have been found for all outputs, and that + ! they are reasonable (i.e. within 32-bit roundoff) + ! + icount = 0 + do j=1,nlatout + if (jjm(j) == 0 .or. jjp(j) == 0) icount = icount + 1 + sum = wgts(j) + wgtn(j) + if (sum < 0.99999_r8 .or. sum > 1.00001_r8) icount = icount + 1 + if (wgts(j) < 0._r8 .or. wgts(j) > 1._r8) icount = icount + 1 + if (wgtn(j) < 0._r8 .or. wgtn(j) > 1._r8) icount = icount + 1 + end do + + if (icount > 0) then + call endrun ('BILIN: something bad in latitude indices or weights') + end if + ! + ! Do the bilinear interpolation + ! + do j=1,nlatout + ! + ! Initialize index arrays for later checking + ! + do i=1,nlondout + iim(i) = 0 + iip(i) = 0 + end do + ! + ! For values which extend beyond E and W boundaries, set weights such that + ! values will be interpolated between E and W edges of input grid. + ! + do iw=1,nlonout(j) + if (xout(iw,j) > xin(1)) exit + iim(iw) = nlonin + iip(iw) = 1 + wgtw(iw) = (xin(1) - xout(iw,j)) /dxinwrap + wgte(iw) = (xout(iw,j)+360._r8 - xin(nlonin))/dxinwrap + end do + + do ie=nlonout(j),1,-1 + if (xout(ie,j) <= xin(nlonin)) exit + iim(ie) = nlonin + iip(ie) = 1 + wgtw(ie) = (xin(1)+360._r8 - xout(ie,j)) /dxinwrap + wgte(ie) = (xout(ie,j) - xin(nlonin))/dxinwrap + end do + ! + ! Loop though output indices finding input indices and weights + ! + iiprev = 1 + do i=iw,ie + do ii=iiprev,nlonin-1 + if (xout(i,j) > xin(ii) .and. xout(i,j) <= xin(ii+1)) then + iim(i) = ii + iip(i) = ii + 1 + wgtw(i) = (xin(ii+1) - xout(i,j)) / (xin(ii+1) - xin(ii)) + wgte(i) = (xout(i,j) - xin(ii)) / (xin(ii+1) - xin(ii)) + goto 60 + end if + end do + call endrun ('BILIN: Failed to find interp values') +60 iiprev = ii + end do + + icount = 0 + do i=1,nlonout(j) + if (iim(i) == 0 .or. iip(i) == 0) icount = icount + 1 + sum = wgtw(i) + wgte(i) + if (sum < 0.99999_r8 .or. sum > 1.00001_r8) icount = icount + 1 + if (wgtw(i) < 0._r8 .or. wgtw(i) > 1._r8) icount = icount + 1 + if (wgte(i) < 0._r8 .or. wgte(i) > 1._r8) icount = icount + 1 + end do + + if (icount > 0) then + write(iulog,*)'BILIN: j=',j,' Something bad in longitude indices or weights' + call endrun + end if + ! + ! Do the interpolation, 1st in longitude then latitude + ! + do k=1,nlev + do i=1,nlonin + igrid(i) = arrin(i,k,jjm(j))*wgts(j) + arrin(i,k,jjp(j))*wgtn(j) + end do + + do i=1,nlonout(j) + arrout(i,k,j) = igrid(iim(i))*wgtw(i) + igrid(iip(i))*wgte(i) + end do + end do + end do + + + return + end subroutine bilin + + subroutine vertinterp(ncol, ncold, nlev, pmid, pout, arrin, arrout) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Vertically interpolate input array to output pressure level + ! Copy values at boundaries. + ! + ! Method: + ! + ! Author: + ! + !----------------------------------------------------------------------- + + implicit none + + !------------------------------Arguments-------------------------------- + integer , intent(in) :: ncol ! column dimension + integer , intent(in) :: ncold ! declared column dimension + integer , intent(in) :: nlev ! vertical dimension + real(r8), intent(in) :: pmid(ncold,nlev) ! input level pressure levels + real(r8), intent(in) :: pout ! output pressure level + real(r8), intent(in) :: arrin(ncold,nlev) ! input array + real(r8), intent(out) :: arrout(ncold) ! output array (interpolated) + !-------------------------------------------------------------------------- + + !---------------------------Local variables----------------------------- + integer i,k ! indices + integer kupper(ncold) ! Level indices for interpolation + real(r8) dpu ! upper level pressure difference + real(r8) dpl ! lower level pressure difference + logical found(ncold) ! true if input levels found + logical error ! error flag + !----------------------------------------------------------------- + ! + ! Initialize index array and logical flags + ! + do i=1,ncol + found(i) = .false. + kupper(i) = 1 + end do + error = .false. + ! + ! Store level indices for interpolation. + ! If all indices for this level have been found, + ! do the interpolation + ! + do k=1,nlev-1 + do i=1,ncol + if ((.not. found(i)) .and. pmid(i,k)= pmid(i,nlev)) then + arrout(i) = arrin(i,nlev) + else if (found(i)) then + dpu = pout - pmid(i,kupper(i)) + dpl = pmid(i,kupper(i)+1) - pout + arrout(i) = (arrin(i,kupper(i) )*dpl + arrin(i,kupper(i)+1)*dpu)/(dpl + dpu) + else + error = .true. + end if + end do + ! + ! Error check + ! + if (error) then + call endrun ('VERTINTERP: ERROR FLAG') + end if + + return + end subroutine vertinterp + + subroutine get_timeinterp_factors (cycflag, np1, cdayminus, cdayplus, cday, & + fact1, fact2, str) + !--------------------------------------------------------------------------- + ! + ! Purpose: Determine time interpolation factors (normally for a boundary dataset) + ! for linear interpolation. + ! + ! Method: Assume 365 days per year. Output variable fact1 will be the weight to + ! apply to data at calendar time "cdayminus", and fact2 the weight to apply + ! to data at time "cdayplus". Combining these values will produce a result + ! valid at time "cday". Output arguments fact1 and fact2 will be between + ! 0 and 1, and fact1 + fact2 = 1 to roundoff. + ! + ! Author: Jim Rosinski + ! + !--------------------------------------------------------------------------- + implicit none + ! + ! Arguments + ! + logical, intent(in) :: cycflag ! flag indicates whether dataset is being cycled yearly + + integer, intent(in) :: np1 ! index points to forward time slice matching cdayplus + + real(r8), intent(in) :: cdayminus ! calendar day of rearward time slice + real(r8), intent(in) :: cdayplus ! calendar day of forward time slice + real(r8), intent(in) :: cday ! calenar day to be interpolated to + real(r8), intent(out) :: fact1 ! time interpolation factor to apply to rearward time slice + real(r8), intent(out) :: fact2 ! time interpolation factor to apply to forward time slice + + character(len=*), intent(in) :: str ! string to be added to print in case of error (normally the callers name) + ! + ! Local workspace + ! + real(r8) :: deltat ! time difference (days) between cdayminus and cdayplus + real(r8), parameter :: daysperyear = 365. ! number of days in a year + ! + ! Initial sanity checks + ! + if (np1 == 1 .and. .not. cycflag) then + call endrun ('GETFACTORS:'//str//' cycflag false and forward month index = Jan. not allowed') + end if + + if (np1 < 1) then + call endrun ('GETFACTORS:'//str//' input arg np1 must be > 0') + end if + + if (cycflag) then + if ((cday < 1.) .or. (cday > (daysperyear+1.))) then + write(iulog,*) 'GETFACTORS:', str, ' bad cday=',cday + call endrun () + end if + else + if (cday < 1.) then + write(iulog,*) 'GETFACTORS:', str, ' bad cday=',cday + call endrun () + end if + end if + ! + ! Determine time interpolation factors. Account for December-January + ! interpolation if dataset is being cycled yearly. + ! + if (cycflag .and. np1 == 1) then ! Dec-Jan interpolation + deltat = cdayplus + daysperyear - cdayminus + if (cday > cdayplus) then ! We are in December + fact1 = (cdayplus + daysperyear - cday)/deltat + fact2 = (cday - cdayminus)/deltat + else ! We are in January + fact1 = (cdayplus - cday)/deltat + fact2 = (cday + daysperyear - cdayminus)/deltat + end if + else + deltat = cdayplus - cdayminus + fact1 = (cdayplus - cday)/deltat + fact2 = (cday - cdayminus)/deltat + end if + + if (.not. valid_timeinterp_factors (fact1, fact2)) then + write(iulog,*) 'GETFACTORS: ', str, ' bad fact1 and/or fact2=', fact1, fact2 + call endrun () + end if + + return + end subroutine get_timeinterp_factors + + logical function valid_timeinterp_factors (fact1, fact2) + !--------------------------------------------------------------------------- + ! + ! Purpose: check sanity of time interpolation factors to within 32-bit roundoff + ! + !--------------------------------------------------------------------------- + implicit none + + real(r8), intent(in) :: fact1, fact2 ! time interpolation factors + + valid_timeinterp_factors = .true. + + ! The fact1 .ne. fact1 and fact2 .ne. fact2 comparisons are to detect NaNs. + if (abs(fact1+fact2-1.) > 1.e-6 .or. & + fact1 > 1.000001 .or. fact1 < -1.e-6 .or. & + fact2 > 1.000001 .or. fact2 < -1.e-6 .or. & + fact1 .ne. fact1 .or. fact2 .ne. fact2) then + + valid_timeinterp_factors = .false. + end if + + return + end function valid_timeinterp_factors + +!--------------------------------------------------------------------------- + +subroutine endrun(msg) + + character(len=*), intent(in), optional :: msg ! string to be printed + + if (present (msg)) then + write(iulog,*)'ENDRUN:', msg + else + write(iulog,*)'ENDRUN: called without a message string' + end if + + stop + +end subroutine endrun + +end module interpolate_data diff --git a/tools/interpic_new/is_special_case.F90 b/tools/interpic_new/is_special_case.F90 new file mode 100644 index 0000000000..f06278ce47 --- /dev/null +++ b/tools/interpic_new/is_special_case.F90 @@ -0,0 +1,28 @@ +logical function is_special_case (name) + + implicit none + + include 'netcdf.inc' + + ! Input arguments + + character(len=*), intent(in) :: name + !--------------------------------------------------------------------- + + is_special_case = .false. + + ! Hardwire variable names known to be functions of spatial dimensions + + if (name == 'rlon' .or. name == 'nlon' .or. name == 'wnummax' .or. & + name == 'hyai' .or. name == 'hybi' .or. & + name == 'hyam' .or. name == 'hybm' .or. & + name == 'gw' .or. name == 'w_stag' .or. & + name == 'lat' .or. name == 'lon' .or. & + name == 'slat' .or. name == 'slon' .or. & + name == 'lev' .or. name == 'ilev') then + + is_special_case = .true. + + end if + +end function is_special_case diff --git a/tools/interpic_new/shr_kind_mod.F90 b/tools/interpic_new/shr_kind_mod.F90 new file mode 100644 index 0000000000..d8f5062409 --- /dev/null +++ b/tools/interpic_new/shr_kind_mod.F90 @@ -0,0 +1,22 @@ +!=============================================================================== +! SVN $Id: shr_kind_mod.F90 3729 2007-03-29 19:22:12Z kauff $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/loga_share3_070903_tags/loga15_share3_071012/shr/shr_kind_mod.F90 $ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + integer,parameter :: SHR_KIND_CS = 80 ! short char + integer,parameter :: SHR_KIND_CL = 256 ! long char + integer,parameter :: SHR_KIND_CX = 384 ! extra-long char + +END MODULE shr_kind_mod diff --git a/tools/interpic_new/wrap_nf.F90 b/tools/interpic_new/wrap_nf.F90 new file mode 100644 index 0000000000..0c62707cb3 --- /dev/null +++ b/tools/interpic_new/wrap_nf.F90 @@ -0,0 +1,333 @@ +subroutine wrap_create (path, cmode, ncid) + implicit none + include 'netcdf.inc' + + character*(*) path + integer cmode, ncid + + integer ret + + ret = nf_create (path, cmode, ncid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_open (path, omode, ncid) + implicit none + include 'netcdf.inc' + + character*(*) path + integer omode + integer ncid + integer ret + + ret = nf_open (path, omode, ncid) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_OPEN: nf_open failed for file ',path + call handle_error (ret) + end if +end subroutine + +subroutine wrap_inq_varid (nfid, varname, varid) + implicit none + include 'netcdf.inc' + + integer nfid, varid + character*(*) varname + + integer ret + + ret = nf_inq_varid (nfid, varname, varid) + if (ret.ne.NF_NOERR) then + write(6,*)'nf_inq_varid: ',trim(varname),' not found' + call handle_error (ret) + end if +end subroutine wrap_inq_varid + +subroutine wrap_inq_dimname (nfid, dimid, dimname) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimname (nfid, dimid, dimname) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_dimlen (nfid, dimid, dimlen) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, dimlen + + integer ret + + ret = nf_inq_dimlen (nfid, dimid, dimlen) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimlen + +subroutine wrap_inq_dimid (nfid, dimname, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, dimid + character*(*) dimname + + integer ret + + ret = nf_inq_dimid (nfid, dimname, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_dimid + +subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + implicit none + include 'netcdf.inc' + + integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts + character*(*) varname + + integer ret + + ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_inq_var + +subroutine wrap_def_dim (nfid, dimname, len, dimid) + implicit none + include 'netcdf.inc' + + integer nfid, len, dimid + character*(*) dimname + + integer ret + + ret = nf_def_dim (nfid, dimname, len, dimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_def_dim + +subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid) + implicit none + include 'netcdf.inc' + + integer nfid, xtype, nvdims, varid + integer vdims(nvdims) + character*(*) name + + integer ret + + ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid) +! write(6,*)'WRAP_DEF_VAR: ',name,' has varid ',varid,nvdims, +! $'dimensions of ids ',(vdims(i),i=1,nvdims) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_get_var_double (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + + ret = nf_get_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_var_double + +subroutine wrap_get_var_int (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer arr(*) + + integer ret + + ret = nf_get_var_int (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_var_int + +subroutine wrap_get_vara_double (nfid, varid, start, count, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(nf_max_dims), count(nf_max_dims) + real*8 arr(*) + + integer ret + + ret = nf_get_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_get_vara_double + +subroutine wrap_get_vara_int (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + + ret = nf_get_vara_int (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_GET_VARA8: error reading varid =', varid + call handle_error (ret) + end if +end subroutine + +subroutine wrap_put_vara_text (nfid, varid, start, count, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + character text(*) + + integer ret + + ret = nf_put_vara_text (nfid, varid, start, count, text) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_PUT_VARA_TEXT: error writing varid =', varid + call handle_error (ret) + end if +end subroutine + +!------------------------------------------------------------------------------ + +subroutine wrap_get_vara_text (nfid, varid, start, count, text) + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + character text(*) + + integer ret + + ret = nf_get_vara_text (nfid, varid, start, count, text) + if (ret.ne.NF_NOERR) then + write(6,*)'WRAP_GET_VARA_TEXT: error writing varid =', varid + call handle_error (ret) + end if +end subroutine + +subroutine wrap_put_var8 (nfid, varid, arr) + implicit none + include 'netcdf.inc' + + integer nfid, varid + real*8 arr(*) + + integer ret + ret = nf_put_var_double (nfid, varid, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine wrap_put_var8 + +subroutine wrap_put_vara_double (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid + integer start(*), count(*) + real(r8) arr(*) + + integer ret + ret = nf_put_vara_double (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine handle_error (ret) + implicit none + include 'netcdf.inc' + + integer ret + + write(6,*) nf_strerror (ret) + call abort +end subroutine handle_error + +subroutine wrap_put_vara_int (nfid, varid, start, count, arr) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + include 'netcdf.inc' + + integer nfid, varid, start(*), count(*) + integer arr(*) + + integer ret + ret = nf_put_vara_int (nfid, varid, start, count, arr) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq (nfid, ndims, nvars, ngatts, unlimdimid) + implicit none + include 'netcdf.inc' + + integer nfid, ndims, nvars, ngatts, unlimdimid + + integer ret + + ret = nf_inq (nfid, ndims, nvars, ngatts, unlimdimid) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_dim (nfid, dimid, name, length) + implicit none + include 'netcdf.inc' + + integer nfid, dimid, length + character*(*) name + + integer ret + + ret = nf_inq_dim (nfid, dimid, name, length) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_inq_attname (nfid, varid, num, attname) + implicit none + + include 'netcdf.inc' + + integer nfid, varid, num + character*(*) attname + + integer ret + + ret = nf_inq_attname (nfid, varid, num, attname) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_get_att_text (nfid, varid, attname, atttext) + implicit none + + include 'netcdf.inc' + + integer nfid, varid + character*(*) attname, atttext + + integer ret + + ret = nf_get_att_text (nfid, varid, attname, atttext) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + +subroutine wrap_copy_att (nfid, varid, attname, nfido, varido) + implicit none + + include 'netcdf.inc' + + integer nfid, varid, nfido, varido + character*(*) attname + + integer ret + + ret = nf_copy_att (nfid, varid, attname, nfido, varido) + if (ret.ne.NF_NOERR) call handle_error (ret) +end subroutine + diff --git a/tools/mkatmsrffile/Makefile b/tools/mkatmsrffile/Makefile new file mode 100644 index 0000000000..0d24fcc7d2 --- /dev/null +++ b/tools/mkatmsrffile/Makefile @@ -0,0 +1,11 @@ +include $(CASEROOT)/Macros.bluefire + +LIBDIR=/ptmp/jedwards/SMS_D.f09_g16.B1850CN.bluefire.C.083815/lib +LIBS = -L$(LIBDIR) -lcsm_share -lpio -lmct -lmpeu -L$(LIB_NETCDF) -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf +MODDIR=$(LIBDIR)/include + + +mkatmsrffile: mkatmsrffile.F90 + $(FC) $(FFLAGS) -I$(MODDIR) $< -o $@ $(LIBS) $(LDFLAGS) + + diff --git a/tools/mkatmsrffile/README b/tools/mkatmsrffile/README new file mode 100644 index 0000000000..4d32730b89 --- /dev/null +++ b/tools/mkatmsrffile/README @@ -0,0 +1,25 @@ +Atmospheric drydeposition at the surface depends on certain surface +properties including soil and land use properties. In most cases +these calculations can be handled in the land model and passed to he +atmosphere through the coupler. This is the default namelist setting +drydep_method='xactive_lnd'. However with modal areosols this method +is not adequate and we must recalculate these fields in the atmosphere +(see subroutine interp_map in mo_drydep.F90). For unstructured grids +it was determined to create this offline interpolation tool rather +than generalize the subroutine interp_map. + +1. Locate or create scrip mapping files for the 1x1 degree input grids and + the desired model output grid. + +2. Run the script scrip_makemaps.csh +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/makemaps/trunk/scrip_makemaps.csh + The script will create 4 mapping files, you need only the 1x1 -> model grid + area average file. + +3. Edit mkatmsrffile.rc and put the name of this file in the srf2atmFmapname field, edit + other fields as appropriate + +4. Set the environment variable CASEROOT to a valid cesm case directory. This case + has to have been compiled on the system you will run mkatmsrffile + +5. Compile and run mkatmsrffile. \ No newline at end of file diff --git a/tools/mkatmsrffile/mkatmsrffile.F90 b/tools/mkatmsrffile/mkatmsrffile.F90 new file mode 100644 index 0000000000..b25c395028 --- /dev/null +++ b/tools/mkatmsrffile/mkatmsrffile.F90 @@ -0,0 +1,383 @@ +!=============================================================================== +! SVN $Id: $ +! SVN $URL: $ +! 12/06/2010 Jim Edwards jedwards@ucar.edu +! Interpolate files needed for cam atmosphere dry deposition to model grid +!=============================================================================== + +program mkatmsrffile + use mpi + use pio + use mct_mod + use shr_mct_mod + use shr_kind_mod, only : r8=>shr_kind_r8, shr_kind_cl + implicit none + integer :: ierr, npes, iam, npft + integer, pointer :: sfcgindex(:), atmgindex(:) + + type rptr + real(r8), pointer :: fld(:) + end type rptr + + type(rptr), pointer :: soilw(:), pft(:), apft(:), asoilw(:) + + + type(iosystem_desc_t) :: iosystem + + type(mct_gsmap) :: gsMap_srf, gsMap_atm + type(mct_SMatP) :: sMatP + type(mct_aVect), target :: srf_av, atm_av + + + + integer, pointer :: comps(:) ! array with component ids + integer, pointer :: comms(:) ! array with mpicoms + type(io_desc_t) :: atm_iodesc, srf_iodesc + + character(len=shr_kind_cl) :: srffilename + character(len=shr_kind_cl) :: atmfilename + + character(len=shr_kind_cl) :: soilwfilename + character(len=shr_kind_cl) :: landfilename + + character(len=shr_kind_cl) :: outputfilename + character(len=shr_kind_cx) :: mapname + character(len=shr_kind_cl) :: maptype + + + type(file_desc_t) :: landfile, newfile + integer, pointer :: dof(:), dof2(:), dof3(:) + real(r8), pointer :: landmask(:),lake(:), wetland(:), urban(:) + real(r8), pointer :: alake(:), awetland(:), aurban(:), fraction_landuse(:,:) + integer :: srfnx, atmnx, srfnxg, atmnxg, dimid, nlat, nlon, i, j, clen, index, dim1, dim2 + type(var_desc_t) :: vid, vid1, vid2 + + character(len=*), parameter :: srffields(5) =(/"PCT_LAKE ",& + "PCT_WETLAND",& + "PCT_URBAN ", & + "SOILW ", & + "PCT_PFT "/) + + + character(len=220) :: rList + character(len=6) :: str + real(r8) :: total_land, fraction_soilw + real(r8), pointer :: total_soilw(:,:) + Character(len=*), parameter :: ConfigFileName="mkatmsrffile.rc" + + call mpi_init(ierr) + + call mpi_comm_size(MPI_COMM_WORLD, npes, ierr) + call mpi_comm_rank(MPI_COMM_WORLD, iam, ierr) + call pio_init(iam, MPI_COMM_WORLD, npes, 0, 1, pio_rearr_none, iosystem,base=0) + allocate(comps(2), comms(2)) + comps(1)=1 + comps(2)=2 + call mpi_comm_dup(MPI_COMM_WORLD,comms(1),ierr) + call mpi_comm_dup(MPI_COMM_WORLD,comms(2),ierr) + call mct_world_init(2, MPI_COMM_WORLD, comms, comps) + + + call I90_allLoadF(ConfigFileName,0,MPI_COMM_WORLD,ierr) + + call I90_label('srfFileName:', ierr) + call i90_gtoken(srffilename, ierr) + call I90_label('atmFileName:', ierr) + call i90_gtoken(atmfilename, ierr) + call I90_label('landFileName:', ierr) + call i90_gtoken(landfilename, ierr) + call I90_label('soilwFileName:', ierr) + call i90_gtoken(soilwfilename, ierr) + call I90_label('outputFileName:', ierr) + call i90_gtoken(outputfilename, ierr) + call i90_release(ierr) + + + call openfile_and_initdecomp(iosystem, srffilename, npes, iam, gsmap_srf, srfnx, srfnxg) + call openfile_and_initdecomp(iosystem, atmfilename, npes, iam, gsmap_atm, atmnx, atmnxg) + + + call shr_mct_queryConfigFile(MPI_COMM_WORLD, "mkatmsrffile.rc", + "srf2atmFmapname:",mapname,"srf2atmFmaptype:",maptype) + + call shr_mct_sMatPInitnc(sMatP,gsmap_srf, gsmap_atm, & + mapname, maptype, MPI_COMM_WORLD) + + + ierr = pio_openfile(iosystem, landFile, pio_iotype_netcdf, landfilename, pio_noclobber) + + ierr = pio_inq_dimid(landFile, 'lon', dimid) + ierr = pio_inq_dimlen(landfile, dimid, nlon) + ierr = pio_inq_dimid(landFile, 'lat', dimid) + ierr = pio_inq_dimlen(landfile, dimid, nlat) + ierr = pio_inq_dimid(landFile, 'pft', dimid) + ierr = pio_inq_dimlen(landfile, dimid, npft) + + call mct_gsmap_OrderedPoints(gsMap_srf, iam, Dof) + + call pio_initdecomp(iosystem, pio_double, (/nlon,nlat/), dof, srf_iodesc) + + deallocate(dof) + + rlist = ' ' + clen=1 + do i=1,npft+15 + if(i<=npft) then + write(str,'(A,i2.2,A)') 'pft',i,':' + rlist(clen:clen+5) = str + clen=clen+6 + else if(i<=npft+12) then + write(str,'(A,i2.2,A)') 'slw',i-npft,':' + rlist(clen:clen+5) = str + clen=clen+6 + else + if(i==npft+13) clen=clen-1 + rlist(clen:clen+len_trim(srffields(i-12-npft))) = ':'//trim(srffields(i-12-npft)) + clen = clen+len_trim(srffields(i))+1 + end if + end do + + + call mct_aVect_init(srf_av, rlist=trim(rlist), lsize=srfnx) + call mct_aVect_zero(srf_av) + call mct_aVect_init(atm_av, rlist=rlist, lsize=atmnx) + call mct_aVect_zero(atm_av) + + + index = mct_avect_indexra(srf_av,'PCT_LAKE') + lake => srf_av%rattr(index,:) + ierr = pio_inq_varid( landFile, 'PCT_LAKE', vid) + call pio_read_darray(landFile, vid, srf_iodesc, lake, ierr) + lake = lake * 0.01_r8 + + ierr = pio_inq_varid( landFile, 'PCT_PFT', vid) + allocate(pft(npft),apft(npft)) + do i=1,npft + write(str,'(A,i2.2)') 'pft',i + + pft(i)%fld => srf_av%rattr(mct_avect_indexra(srf_av,str(1:5)),:) + apft(i)%fld => atm_av%rattr(mct_avect_indexra(atm_av,str(1:5)),:) + + call pio_setframe(vid,int(i,kind=PIO_OFFSET)) + call pio_read_darray(landFile, vid, srf_iodesc, pft(i)%fld, ierr) + pft(i)%fld = pft(i)%fld * 0.01_r8 + end do + + + index = mct_avect_indexra(srf_av,'PCT_WETLAND') + wetland => srf_av%rattr(index,:) + ierr = pio_inq_varid( landFile, 'PCT_WETLAND', vid) + call pio_read_darray(landFile, vid, srf_iodesc, wetland, ierr) + wetland = wetland * 0.01_r8 + + index = mct_avect_indexra(srf_av,'PCT_URBAN') + urban => srf_av%rattr(index,:) + ierr = pio_inq_varid( landFile, 'PCT_URBAN', vid) + call pio_read_darray(landFile, vid, srf_iodesc, urban, ierr) + urban = urban * 0.01_r8 + + allocate(landmask(srfnx)) + ierr = pio_inq_varid( landFile, 'LANDMASK', vid) + call pio_read_darray(landFile, vid, srf_iodesc, landmask, ierr) + + call pio_closefile(landfile) + +! call pio_freedecomp(iosystem, srf_iodesc) + + ierr = pio_openfile(iosystem, landFile, pio_iotype_netcdf, soilwfilename, pio_noclobber) + +! call pio_initdecomp(iosystem, pio_double, (/nlon,nlat,12/), vdof, srf_iodesc) + ierr = pio_inq_varid( landFile, 'SOILW', vid) + allocate(soilw(12),asoilw(12)) + do i=1,12 + str = ' ' + write(str,'(A,i2.2)') 'slw',i + soilw(i)%fld => srf_av%rattr(mct_avect_indexra(srf_av,str(1:5)),:) + asoilw(i)%fld => atm_av%rattr(mct_avect_indexra(atm_av,str(1:5)),:) + + call pio_setframe(vid,int(i,kind=PIO_OFFSET)) + call pio_read_darray(landFile, vid, srf_iodesc, soilw(i)%fld, ierr) + end do + call pio_closefile(landfile) + call pio_freedecomp(iosystem, srf_iodesc) + + + do i=1,srfnx + if(nint(landmask(i)) == 0) then + lake(i) = 1.0 + wetland(i) = 0.0 + urban(i) = 0.0 + do j=1,12 + soilw(j)%fld(i) = 0.0 + end do + end if + end do + deallocate(landmask) + + index = mct_avect_indexra(atm_av,'PCT_LAKE') + alake => atm_av%rattr(index,:) + + + call mct_sMat_avMult( srf_av, smatP, atm_av) + + index = mct_avect_indexra(atm_av,'PCT_LAKE') + alake => atm_av%rattr(index,:) + + + index = mct_avect_indexra(atm_av,'PCT_WETLAND') + awetland => atm_av%rattr(index,:) + + index = mct_avect_indexra(atm_av,'PCT_URBAN') + aurban => atm_av%rattr(index,:) + + + + fraction_soilw=0.0 + + allocate(fraction_landuse(atmnx,11)) + allocate(total_soilw(atmnx,12)) + + fraction_landuse = 0.0_r8 + do i=1,atmnx + total_soilw(i,:)=0.0 + total_land = (alake(i)+awetland(i)+aurban(i)) + do j=1,npft + total_land=total_land+apft(j)%fld(i) + end do + fraction_soilw = total_land - (alake(i)+wetland(i)) + if(total_land < 1.0_r8) then + alake(i) = alake(i) + (1.0_r8 - total_land) + end if + +! print *,i,fraction, fraction_soilw +! if(abs(fraction-1.0_r8) > 0.1_r8) then +! print *, i, fraction, alake(i), awetland(i), aurban(i), (apft(j)%fld(i), j=1,npft) +! end if + + do j=1,12 + total_soilw(i,j) = total_soilw(i,j) + asoilw(j)%fld(i) * fraction_soilw + end do + + fraction_landuse(i,1) = aurban(i) + fraction_landuse(i,2) = apft(16)%fld(i) + apft(17)%fld(i) + fraction_landuse(i,3) = apft(13)%fld(i) + apft(14)%fld(i) + apft(15)%fld(i) + fraction_landuse(i,4) = apft(5)%fld(i) + apft(6)%fld(i) + apft(7)%fld(i)+ apft(8)%fld(i) + apft(9)%fld(i) + fraction_landuse(i,5) = apft(2)%fld(i) + apft(3)%fld(i) + apft(4)%fld(i) + fraction_landuse(i,6) = awetland(i) + fraction_landuse(i,7) = alake(i) + fraction_landuse(i,8) = apft(1)%fld(i) + fraction_landuse(i,11) = apft(10)%fld(i) + apft(11)%fld(i) + apft(12)%fld(i) + + if(abs(sum(fraction_landuse(i,:)-1._r8)) > 0.001_r8) then + fraction_landuse(i,:) = fraction_landuse(i,:)/sum(fraction_landuse(i,:)) + end if + + + end do + + ierr = pio_createfile(iosystem, newFile, pio_iotype_netcdf, trim(outputfilename), pio_clobber) + + ierr = pio_def_dim(newFile, 'ncol', atmnxg, dim1) + ierr = pio_def_dim(newFile, 'class',11, dim2) + + ierr = pio_def_var(newFile, 'fraction_landuse', pio_double, (/dim1,dim2/), vid1) + ierr = pio_def_dim(newFile, 'month',12, dim2) + + ierr = pio_def_var(newFile, 'soilw', pio_double, (/dim1,dim2/), vid2) + + ierr = pio_enddef(newFile) + + call mct_gsmap_OrderedPoints(gsMap_atm, iam, Dof) + + + + allocate(dof2(atmnx*12)) + do j=1,12 + do i=1,atmnx + dof2(i+(j-1)*atmnx) = dof(i)+(j-1)*atmnxg + end do + end do + + call pio_initdecomp(iosystem, pio_double, (/atmnxg,11/), dof2(1:11*atmnx-1), atm_iodesc) + + call pio_write_darray(newFile, vid1, atm_iodesc, fraction_landuse ,ierr) + call pio_freedecomp(newfile, atm_iodesc) + + call pio_initdecomp(iosystem, pio_double, (/atmnxg,12/), dof2, atm_iodesc) + + call pio_write_darray(newFile, vid2, atm_iodesc, total_soilw ,ierr) + call pio_freedecomp(newfile, atm_iodesc) + + + call pio_closefile(newFile) + call pio_finalize(iosystem, ierr) + + deallocate(comps, comms) + call mpi_finalize(ierr) + + +contains + + subroutine openfile_and_initdecomp(iosystem, filename, npes, iam, gsmap, nx, nxg) + type(iosystem_desc_t) :: iosystem + character(len=*), intent(in) :: filename + integer, intent(in) :: npes, iam + type(mct_gsmap), intent(out) :: gsmap + integer, intent(out) :: nx, nxg + integer, pointer :: gindex(:) + + + + gindex => get_grid_index(iosystem, filename, npes, iam, nx, nxg) + call mct_gsMap_init( gsMap, gindex, MPI_COMM_WORLD,1 , nx, nxg) + deallocate(gindex) + + + + end subroutine openfile_and_initdecomp + + + function get_grid_index(iosystem, filename, npes, iam, nx, nxg) result(gindex) + use pio + implicit none + character(len=*), intent(in) :: filename + type(iosystem_desc_t) :: iosystem + integer, intent(in) :: npes, iam + integer, intent(out) :: nx, nxg + + type(file_desc_t) :: file + integer, pointer :: gindex(:) + + + integer :: dimid, ierr, add1=0, i, start_offset + + ierr = pio_openfile(iosystem, File, PIO_IOTYPE_NETCDF, filename, PIO_NOCLOBBER) + + ierr = pio_inq_dimid(File, 'grid_size', dimid) + ierr = pio_inq_dimlen(File, dimid, nxg) + + nx = nxg/npes + + if(nx*npes < nxg-(npes-iam-1)) then + start_offset = nxg-(npes-iam-1)-(nx*npes)-1 + add1 = 1 + else + add1 = 0 + start_offset=0 + end if + allocate(gindex(nx+add1)) + do i=1,nx+add1 + gindex(i)=i+iam*nx+start_offset + end do + + + + call pio_closefile(FILE) + + end function get_grid_index + +end program mkatmsrffile + + + + diff --git a/tools/mkatmsrffile/mkatmsrffile.rc b/tools/mkatmsrffile/mkatmsrffile.rc new file mode 100644 index 0000000000..1da3042f36 --- /dev/null +++ b/tools/mkatmsrffile/mkatmsrffile.rc @@ -0,0 +1,24 @@ +################################################################## +# +# seq_maps.rc +# +# This is a resource file which lists the names of mapping +# weight files to use in a sequential CCSM run (mapname). +# You can also set when data is rearranged in the mapping (maptype). +# +# This file is read during the map_model2model_init calls. +# +# For maptype: X = Rearrange the input so that the output +# is on the correct processor. +# Y = Rearrange the output and sum partial outputs +# if necessary +# +# NOTE: For bfb on different processor counts, set all maptypes to "X". +################################################################## +srfFileName: /fs/cgd/csm/mapping/grids/1x1d.nc +atmFileName: ne30np4_091226_pentagons.nc +landFileName: /fs/cgd/csm/inputdata/atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc +soilwFileName: /fs/cgd/csm/inputdata/atm/cam/chem/trop_mozart/dvel/clim_soilw.nc +srf2atmFmapname: map_1x1_to_ne30np4_aave_da_101203.nc +srf2atmFmaptype: X +outputFileName: atmsrf_ne30np4_101206.nc diff --git a/tools/se_grid/make_se_grid.sh b/tools/se_grid/make_se_grid.sh new file mode 100755 index 0000000000..3fa72758c6 --- /dev/null +++ b/tools/se_grid/make_se_grid.sh @@ -0,0 +1,533 @@ +#! /bin/bash + +## +## General syntax help function +## Usage: help +## +help () { + local sname="`basename ${0}`" + local hname="Usage: ${sname}" + local hprefix="`echo ${hname} | tr '[!-~]' ' '`" + echo "${hname} [ --ne ]" + echo "${hprefix} [ --pg <#> ] physgrid FVM size (default no physgrid)" + echo "${hprefix} [ --filename ]" + echo "${hprefix} [ --np <#> ] Set number of GLL points (default 4)" + echo "${hprefix} [ --fine-ne <#> ] Effective NE for refined mesh files" + echo "${hprefix} [ --mesh-file ]" + echo "${hprefix} [ --mesh-name ]" + echo "${hprefix} [ --root ]" + echo "${hprefix} [ --project ]" + if [ $1 -eq 0 ]; then + echo "" + echo "${sname} is used to create SCRIP and domain files for new SE grids." + echo -e "\nTo create a normal (fixed size) GLL 1 degree grid:" + echo "${sname} --ne 30" + echo -e "\nTo create a 1 degree grid with a 3x3 FVM physics grid:" + echo "${sname} --ne 30 --pg 3" + echo -e "\nTo create a refined mesh grid with refinement from 1 to 1/4 deg:" + echo "${sname} --ne 30 --fine-ne 120 --mesh-name --mesh-file .g" + echo " where .g is the mesh file read by the SE dycore and" + echo " is the name of the refined area (e.g., CONUS)" + echo -e "\nNote that before running this script, you must enter the new" + echo "grid in two places:" + echo "In /components/cam/bld/config_files/horiz_grid.xml and" + echo "/cime/config/cesm/config_grids.xml" + fi + exit $1 +} + +## +## Error output function (should be handed a string) +## +perr() { + echo -e "\nERROR: ${@}\n" + help 1 +} + +## +## Calculate the number of points in a CAM-SE grid +## Inputs are +## +npoints() { + local np + local npt + + if [ $2 -gt 0 ]; then + npt=$(( $1 * $1 * $2 * $2 * 6 )) + else + np=$(( $3 - 1 )) + npt=$(( $1 * $1 * $np * $np * 6 + 2 )) + fi + echo "${npt}" +} + +## +## Calculate the approximate resolution of a CAM-SE grid +## Inputs are +## +resolution() { + local np + local nres + local ndeg + + np=$(( $2 - 1 )) + nres=$(( $1 * $np * 4 )) + if [ $nres -gt 360 ]; then + # Fraction of a degree, assume 1/integer + nres=$(( $nres / 360 )) + echo "1/${nres}" + else + # Resolution of less than a degree, round up + ndeg=$(( 360 + ( $nres / 2 ) )) + nres=$(( $ndeg / $nres )) + echo "${nres}" + fi +} + +## +## Calculate the number of points in a CAM-SE refined mesh grid +## Inputs are +## +nptRefined() { + local np + local nelem + local npt=0 + # Check for ncdump + if [ -n "`type ncdump 2> /dev/null`" ]; then + np=$(( $2 - 1 )) + nelem=`ncdump -h ${1} | grep num_elem | head -1 | cut -f3 -d' '` + npt=$(( $nelem * $np * $np + 2 )) + fi + echo "${npt}" +} + +## +## Return 0 status iff $1 is found in $2 +## +find_in_file() { + local fstr="`grep ${1} ${2} 2> /dev/null`" + if [ -n "${fstr}" ]; then + return 0 + else + return 1 + fi +} + +camroot="" +domaingrid="" +filename="" +finene=0 +gridalias="" +gridname="" +meshfile="" +meshname="" +ne=0 +np=4 +pg=0 +project="" +scriptroot="" + +## Process our input arguments +while [ $# -gt 0 ]; do + case $1 in + --h | -h | --help | -help) + help 0 + ;; + --ne | -ne) + if [ $# -lt 2 ]; then + perr "${1} requires NE, the number of elements across a cube edge" + fi + ne=${2} + shift + ;; + --np | -np) + if [ $# -lt 2 ]; then + perr "${1} requires NP, the number of gll points across an element edge" + fi + np=${2} + shift + ;; + --pg | -pg) + if [ $# -lt 2 ]; then + perr "${1} requires PG, the number of FVM cols across an element edge" + fi + pg=${2} + shift + ;; + --fine-ne | -fine-ne) + if [ $# -lt 2 ]; then + perr "${1} requires PG, the number of FVM cols across an element edge" + fi + finene=${2} + shift + ;; + --filename | -filename) + if [ $# -lt 2 ]; then + perr "${1} requires the name of the output SCRIP file" + fi + filename="${2}" + shift + ;; + --mesh-file | -mesh-file) + if [ $# -lt 2 ]; then + perr "${1} requires the name of the refined grid mesh file" + fi + meshfile="${2}" + shift + ;; + --mesh-name | -mesh-name) + if [ $# -lt 2 ]; then + perr "${1} requires a name for this refined grid" + fi + meshname="${2}" + shift + ;; + --project | -project) + if [ $# -lt 2 ]; then + perr "${1} requires a project number" + fi + project="--project ${2}" + shift + ;; + --root | -root) + if [ $# -lt 2 ]; then + perr "${1} requires a cam root directory" + fi +# We need to make sure that the install directory is a full path +# First, we see if it looks like a full path (not sure Windows will like this) + case $1 in + /*) + camroot="$2" + ;; + *) + camroot="`(cd $2; pwd -P)`" + retval=$? + if [ $retval -ne 0 ]; then + perr "CAM root must exist" + fi + esac + if [ ! -d "${camroot}" ]; then + perr "The specified CAM directory, \"${2}\", does not exist." + exit 1 + fi + if [ ! -d "${camroot}/cime/scripts" ]; then + perr "The specified CAM directory, \"${2}\", does not appear to be a CAM root." + exit 1 + fi + shift + ;; + *) + perr "Unrecognized option, \"${1}\"" + ;; + esac + shift +done + +scriptdir="$( cd $( dirname $0 ); pwd -P )" +trialroot="$( dirname $( dirname $( dirname ${scriptdir} ) ) )" +if [ -z "${camroot}" ]; then + # Are we already in a CAM root or CIME scripts directory? + if [ -f "./create_newcase" ]; then + camroot="$( dirname $( dirname $( pwd -P ) ) )" + if [ ! -d "${camroot}/components/cam" -o ! -d "${camroot}/cime" ]; then + perr "We seem to be in a CIME directory but not in a CAM sandbox" + fi + elif [ -d "./components/cam" -a -d "./cime" ]; then + camroot="`pwd -P`" + elif [ -d "${trialroot}/components/cam" -a -d "${trialroot}/cime" ]; then + camroot="${trialroot}" + else + perr "We don't seem to be in a CAM sandbox, use --root option" + fi +fi + +scriptroot="${camroot}/cime/scripts" + +# Some basic checks +if [ $np -le 0 ]; then + perr "NP must be a positive integer" +fi +if [ $ne -le 0 ]; then + perr "Need an --ne <#> entry to construct a new grid filename" +fi + +# Construct a gridname +if [ $pg -gt 0 ]; then + if [ -n "${meshfile}" ]; then + perr "FVM physics grid not supported for refined mesh grids" + fi + if [ -n "${meshname}" ]; then + perr "FVM physics grid not supported for refined mesh grids" + fi + if [ $finene -gt 0 ]; then + perr "FVM physics grid not supported for refined mesh grids" + fi + gridname="ne${ne}np${np}.pg${pg}" + domaingrid="ne${ne}pg${pg}" + ncol=`npoints $ne $pg $np` + resolution="`resolution ${ne} ${np}`" + if [ -n "`echo ${resolution} | grep '/'`" ]; then + mask="tx0.1v2" + malias="mt12" + elif [ $resolution -gt 2 ]; then + mask="gx3v7" + malias="mg37" + else + mask="gx1v7" + malias="mg17" + fi + gridalias="${domaingrid}_${domaingrid}_${malias}" + desc="${gridname} is a Spectral Elem ${resolution}-deg grid with a ${pg}x${pg} FVM physics grid:" +elif [ -n "${meshname}" -o -n "${meshfile}" -o $finene -gt 0 ]; then + # Refined mesh, make sure we have all the info + if [ $finene -le 0 ]; then + perr "Refined mesh grids require a --fine-ne entry" + fi + if [ -z "${meshfile}" ]; then + perr "Refined mesh grids require a --mesh-file entry" + fi + if [ -z "${meshname}" ]; then + perr "Refined mesh grids require a --mesh-name entry" + fi + gridname="ne0np${np}${meshname}.ne${ne}x$(( $finene / $ne ))" + domaingrid="ne0${meshname}ne${ne}x$(( $finene / $ne ))" + resolution="`resolution ${finene} ${np}`" + if [ -n "`echo ${resolution} | grep '/'`" ]; then + mask="tx0.1v2" + malias="mt12" + elif [ $resolution -gt 2 ]; then + mask="gx3v7" + malias="mg37" + else + mask="gx1v7" + malias="mg17" + fi + gridalias="${domaingrid}_${domaingrid}_${malias}" + ncol=`nptRefined ${meshfile} ${np}` + desc="${gridname} is a Spectral Elem refined mesh grid:" +else + # Standard GLL grid + gridname="ne${ne}np${np}" + domaingrid="ne${ne}" + ncol=`npoints $ne $pg $np` + resolution="`resolution ${ne} ${np}`" + if [ -n "`echo ${resolution} | grep '/'`" ]; then + mask="tx0.1v2" + malias="mt12" + elif [ $resolution -gt 2 ]; then + mask="gx3v7" + malias="mg37" + else + mask="gx1v7" + malias="mg17" + fi + gridalias="${domaingrid}_${domaingrid}_${malias}" + ncol=`npoints $ne $pg $np` + desc="${gridname} is a Spectral Elem ${resolution}-deg grid:" +fi + +datestr="`date '+%y%m%d'`" +if [ -z "${filename}" ]; then + # We were not passed a filename so we have to construt one + filename="${gridname}_SCRIP_${datestr}.nc" +fi + +echo "gridname = ${gridname}" +echo "domaingrid = ${domaingrid}" +echo "gridalias = ${gridalias}" +echo "ncol = ${ncol}" +echo "filename = ${filename}" + +## Check for an entry for this grid in horiz_grid.xml +hgridfile="${camroot}/components/cam/bld/config_files/horiz_grid.xml" + +if [ ! -f "${hgridfile}" ]; then + echo $hgridfile + perr "Cannot find horiz_grid.xml -- THIS SHOULD NOT HAPPEN!" +fi + +if ! find_in_file "hgrid=\\\"${gridname}\\\"" "${hgridfile}"; then + echo "Did not find ${gridname} in `basename ${hgridfile}`" + echo -e "Add the following grid entry to ${hgridfile}:\n" + echo "" + echo -e "\nThen repeat command" + exit 1 +fi + +cgridfile="${camroot}/cime/config/cesm/config_grids.xml" +find_in_file "alias=\\\"${gridalias}\\\"" ${cgridfile} +resa=$? +find_in_file "domain name=\\\"${gridname}\\\"" ${cgridfile} +resd=$? + +if [ $resa -ne 0 -o $resd -ne 0 ]; then + if [ $resa -ne 0 ]; then + echo -e "\nDid not find a model_grid entry for ${gridname}" + echo -e "Add the following model_grid entry to ${cgridfile}:\n" + echo "" + echo " ${gridname}" + echo " ${gridname}" + echo " ${gridname}" + echo " ${mask}" + echo "" + fi + if [ $resd -ne 0 ]; then + echo -e "\nDid not find a domain entry for ${gridname}" + echo -e "\nAdd the following domain entry to ${cgridfile}:\n" + echo "" + echo " ${ncol} 1" + echo " \$DIN_LOC_ROOT/share/domains/domain.lnd.${gridname}_${mask}.${datestr}.nc" + echo " \$DIN_LOC_ROOT/share/domains/domain.ocn.${gridname}_${mask}_${datestr}.nc" + echo " ${desc}" + echo "" + fi + echo -e "\nThen repeat command" + exit 1 +fi + +# If we get this far, it is time to create the files +cset="FADIAB" +if [ -d "/glade/scratch" ]; then + scrdir="/glade/scratch/${USER}" +elif [ -d "/scratch/cluster" ]; then + scrdir="/scratch/cluster/${USER}" +else + scrdir="`pwd -P`" +fi +if [ ! -d "${scrdir}" ]; then + mkdir -p ${scrdir} +fi +cdir="${scrdir}/${cset}_${datestr}" +rm -rf ${cdir} +cd ${scriptroot} +res=$? +if [ $res -ne 0 ]; then + perr "Unable to cd to script root, ${scriptroot}" +fi +./create_newcase --case ${cdir} --compset ${cset} --run-unsupported --res ${gridalias} ${project} --walltime 00:20:00 +res=$? +if [ $res -ne 0 ]; then + perr "create_newcase FAILED" +fi +cd ${cdir} +res=$? +if [ $res -ne 0 ]; then + perr "Unable to change to case directory, ${cdir}" +fi +./xmlchange DOUT_S=FALSE,DEBUG=FALSE,ATM_GRID=${gridname} +res=$? +if [ $res -ne 0 ]; then + perr "xmlchange 1 FAILED" +fi +./xmlchange --append CAM_CONFIG_OPTS=-analytic_ic +res=$? +if [ $res -ne 0 ]; then + perr "xmlchange 2 FAILED" +fi +./xmlchange STOP_OPTION=nsteps,STOP_N=1 +res=$? +if [ $res -ne 0 ]; then + perr "xmlchange 3 FAILED" +fi +./case.setup +res=$? +if [ $res -ne 0 ]; then + perr "case.setup FAILED" +fi +echo "se_write_grid_file = 'SCRIP'" >> user_nl_cam +res=$? +if [ $res -ne 0 ]; then + perr "Unable to add se_write_grid_file to user_nl_cam" +fi +echo "se_grid_filename = '${domaingrid}_scrip_${datestr}.nc'" >> user_nl_cam +res=$? +if [ $res -ne 0 ]; then + perr "Unable to add se_grid_filename to user_nl_cam" +fi +echo "ncdata = '\$DIN_LOC_ROOT/atm/cam/inic/homme/cami-mam3_0000-01-01_ne30np4_L30_c130424.nc'" >> user_nl_cam +res=$? +if [ $res -ne 0 ]; then + perr "Unable to add ncdata to user_nl_cam" +fi +if [ $pg -gt 0 ]; then + echo "se_fv_nphys = ${pg}" >> user_nl_cam + res=$? + if [ $res -ne 0 ]; then + perr "Unable to add se_fv_nphys to user_nl_cam" + fi +fi + +if [ -n "${meshname}" -o -n "${meshfile}" -o $finene -gt 0 ]; then + echo "se_refined_mesh = .true. ">> user_nl_cam + res=$? + if [ $res -ne 0 ]; then + perr "Unable to add se_ne to user_nl_cam" + fi + echo "se_fine_ne=${finene} ">> user_nl_cam + res=$? + if [ $res -ne 0 ]; then + perr "Unable to add se_fine_ne to user_nl_cam" + fi + echo "se_mesh_file = '${meshfile}' ">> user_nl_cam + res=$? + if [ $res -ne 0 ]; then + perr "Unable to add se_mesh_file to user_nl_cam" + fi +fi + +if [ -n "`type execca 2> /dev/null`" ]; then + execca ./case.build +else + ./case.build +fi +res=$? +if [ $res -ne 0 ]; then + perr "case.build FAILED" +fi +tname="temp_${datestr}_`date '+%H%M%S'`" +./case.submit 2>&1 | tee ${tname} +res=$? +if [ $res -ne 0 ]; then + perr "case.submit FAILED" +fi + +# Wait until the file is created. +jobno="`grep Submitted ${tname}`" +if [[ "${jobno}" =~ ^[^0-9]*([0-9]*)[^0-9].*$ ]]; then + jobno="${BASH_REMATCH[1]}" +else + jobno="" +fi +rm ${tname} +if [ -x "`which bjobs 2> /dev/null`" ]; then + qs="`which bjobs`" +elif [ -x "`which qstat 2> /dev/null`" ];then + qs="`which qstat`" +else + qs="" +fi +if [ -n "${qs}" -a -n "${jobno}" ]; then + while [ -n "`${qs} | grep ${jobno}`" ]; do + echo "Waiting for job ${jobno} to finish" + sleep 20 + done +fi + +# Print out instructions for finishing up +echo "You probably need to create the domain files in the entry" +echo "you added to ${cgridfile}." +echo "To do this, you need to create an ocean to atmosphere conservative" +echo "mapping file using the script:" +echo "${camroot}/cime/tools/mapping/gen_mapping_files/gen_cesm_maps.sh" + +# Last but not least, create the domain files +gendomdir="${camroot}/cime/tools/mapping/gen_domain_files" +gendomname="gen_domain" +gendom="${gendomdir}/${gendomname}" +echo "You also need to create the domain files so that the correct ocean" +echo "mask can be accessed." +if [ ! -x "${gendom}" ]; then + echo "Before creating domain files, you must generate the ${gendomname} program." + echo "Follow the directions in ${gendomdir}/INSTALL" +fi +echo "To create domain files, follow the directions in ${gendomdir}/README" diff --git a/tools/topo_tool/bin_to_cube/Makefile b/tools/topo_tool/bin_to_cube/Makefile new file mode 100644 index 0000000000..84d1b39138 --- /dev/null +++ b/tools/topo_tool/bin_to_cube/Makefile @@ -0,0 +1,82 @@ +EXEDIR = . +EXENAME = bin_to_cube +RM = rm + +.SUFFIXES: +.SUFFIXES: .F90 .o + + +# +# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib +# + +FC = lf95 +#DEBUG=TRUE + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + + +#------------------------------------------------------------------------ +# LF95 +#------------------------------------------------------------------------ + +ifeq ($(FC),lf95) +# +# Tramhill +# + INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include + LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib + + LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium + FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) + ifeq ($(DEBUG),TRUE) + #TBH: this works FFLAGS += -g --chk --pca + #TBH: this FAILS FFLAGS += -g --chk a,e,s,u,x --pca + FFLAGS += -g --chk a,e,s,u --pca + else + FFLAGS += -O + endif + +endif + + +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +FC = xlf90 +FFLAGS = -c -I$(INC_NETCDF) +LDFLAGS = -L$(LIB_NETCDF) -lnetcdf +.F90.o: + $(FC) $(FFLAGS) -qsuffix=f=F90 $< +endif + + +.F90.o: + $(FC) $(FFLAGS) $< + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := bin_to_cube.o shr_kind_mod.o + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +bin_to_cube.o: shr_kind_mod.o diff --git a/tools/topo_tool/bin_to_cube/README b/tools/topo_tool/bin_to_cube/README new file mode 100644 index 0000000000..aa65664798 --- /dev/null +++ b/tools/topo_tool/bin_to_cube/README @@ -0,0 +1,23 @@ +This program reads USGS 30-sec terrain dataset from NetCDF file and bins it to an approximately +3km cubed-sphere grid and outputs the data in netCDF format. + +The LANDM_COSLAT field is read in from a separate netCDF file and linearly interpolated to the 3km cubed-sphere grid. + +Input files needed: + +1. USGS raw data in netCDF format: usgs-rawdata.nc (must be placed in same dirctory as the executables) + Generated with software in gen_netCDF_from_USGS/ directory + + File may be found at: + + $CESMDATA/inputdata/atm/cam/gtopo30data/usgs-rawdata.nc + +2. landm_coslat dataset (must be placed in same dirctory as the executables). E.g.: + + ln -s /fs/cgd/csm/inputdata/atm/cam2/hrtopo/landm_coslat.nc . + + The landm_coslat field is not used in CAM5! + +Output file: + +USGS-topo-cube.nc diff --git a/tools/topo_tool/bin_to_cube/bin_to_cube.F90 b/tools/topo_tool/bin_to_cube/bin_to_cube.F90 new file mode 100644 index 0000000000..89ea086a37 --- /dev/null +++ b/tools/topo_tool/bin_to_cube/bin_to_cube.F90 @@ -0,0 +1,931 @@ +! +! DATE CODED: Nov 7, 2011 +! +! DESCRIPTION: This program reads USGS 30-sec terrain dataset from NetCDF file and +! bins it to an approximately 3km cubed-sphere grid and outputs the +! data in netCDF format. +! +! The LANDM_COSLAT field is read in from a separate netCDF file and linearly +! interpolated to the 3km cubed-sphere grid. +! +! Author: Peter Hjort Lauritzen (pel@ucar.edu) +! +! ROUTINES CALLED: +! netcdf routines +! +! COMPILING: +! +program convterr + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +# include + ! + integer :: im, jm + + integer, parameter :: ncube = 3000 !dimension of cubed-sphere grid +! integer, parameter :: ncube = 540 !dimension of cubed-sphere grid + ! integer, parameter :: ncube = 361 ! for debugging + + integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data + integer*1, allocatable, dimension(:,:) :: landfrac ! global 30-sec land fraction + + integer :: alloc_error,dealloc_error + integer :: i,j,n,k,index ! index + integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile + integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file + integer :: srcid,dstid ! for netCDF weight file + + real(r8), allocatable, dimension(:) :: lon , lat + real(r8), allocatable, dimension(:) :: lon_landm , lat_landm + real(r8), allocatable, dimension(:,:) :: landm_coslat + integer :: im_landm, jm_landm + integer :: lonid, latid + integer :: lon_vid, lat_vid + + REAL (r8), PARAMETER :: tiny = 1.0E-10 + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rad2deg = 180.0/pi + REAL (r8), PARAMETER :: deg2rad = pi/180.0 + + real(r8) :: alpha, beta,da,wt,dlat + integer :: ipanel,icube,jcube + real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube + real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube + integer , allocatable, dimension(:,:) :: idx,idy,idp + ! + real(r8) :: dx,dy + ! + ! for "bi-linear" interpolation + ! + real(r8) :: lambda,theta,wx,wy + integer :: ilon,ilat,ip1,jp1 + ! + ! variable for regridding + ! + integer :: src_grid_dim ! for netCDF weight file + ! + ! this is only used if target grid is a lat-lon grid + ! + integer , parameter :: im_target = 360 , jm_target = 180 + logical , parameter :: ltarget_rll = .TRUE. + ! + ! this is only used if target grid is not a lat-lon grid + ! + real(r8), allocatable, dimension(:) :: lon_target, lat_target + ! + ! compute volume of surface topography + ! + real(r8) :: vol,dx_rad,vol_cube,area_latlon,darea_latlon ! latitude array + real(r8), allocatable, dimension(:,:) :: darea_cube + + ! + ! read in USGS data from netCDF file + ! + ! status = nf_open('topo-lowres.nc', 0, ncid) !for debugging + status = nf_open('usgs-rawdata.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'lat', dimlatid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimlatid, jm) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_INQ_DIMID(ncid, 'lon', dimlonid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimlonid, im) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "lon-lat dimensions: ",im,jm + + allocate ( landfrac(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + allocate ( terr(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr' + stop + end if + + allocate ( lon(im),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + allocate ( lat(jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + terr = -999999 + landfrac = -99.0 + + status = NF_INQ_VARID(ncid, 'landfract', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_INT1(ncid, landid,landfrac) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of 30sec land fraction",MINVAL(landfrac),MAXVAL(landfrac) + + + status = NF_INQ_VARID(ncid, 'htopo', topoid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "read terrain data" + status = NF_GET_VAR_INT2(ncid, topoid,terr) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_INQ_VARID(ncid, 'lon', lonid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "read lon" + status = NF_GET_VAR_DOUBLE(ncid, lonid,lon) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_INQ_VARID(ncid, 'lat', latid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "read lat" + status = NF_GET_VAR_DOUBLE(ncid, latid,lat) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + print *,"close file topo.nc" + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + + WRITE(*,*) 'done reading in USGS data from netCDF file' + + WRITE(*,*) "Adjustments to land fraction: Extend land fraction for Ross Ice shelf by" + WRITE(*,*) "setting all landfractions south of 79S to 1" + DO j=1,jm + IF (lat(j)<-79.0) THEN + DO i=1,im + landfrac(i,j) = 1 + END DO + END IF + END DO + + WRITE(*,*) "compute volume for USGS raw data" + vol = 0.0 + dx = (lon(2)-lon(1)) + dx_rad = dx*deg2rad + do j=1,jm + do i=1,im + darea_latlon = dx_rad*(SIN(deg2rad*(-90.0+dx*j))-SIN(deg2rad*(-90.0+dx*(j-1)))) + vol = vol+DBLE(terr(i,j))*darea_latlon + area_latlon = area_latlon + darea_latlon + end do + end do + vol = vol/area_latlon + WRITE(*,*) "consistency of lat-lon area",area_latlon-4.0*pi + WRITE(*,*) "volume of topography about sea-level (raw usgs data)",vol + + + ! + !**************************************************** + ! + ! read LANDM_COSLAT + ! + !**************************************************** + ! + WRITE(*,*) "read LANDM_COSLAT from file" + status = nf_open('landm_coslat.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'lat', dimlatid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimlatid, jm_landm) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_INQ_DIMID(ncid, 'lon', dimlonid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimlonid, im_landm) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "lon-lat dimensions: ",im_landm,jm_landm + + allocate ( landm_coslat(im_landm,jm_landm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + allocate ( lon_landm(im_landm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + allocate ( lat_landm(jm_landm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + do j = 1, jm_landm + do i = 1, im_landm + landm_coslat(i,j) = -999999.99 + end do + end do + + status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) + + status = NF_INQ_VARID(ncid, 'lon', lonid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "read lon" + status = NF_GET_VAR_DOUBLE(ncid, lonid,lon_landm) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_INQ_VARID(ncid, 'lat', latid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + WRITE(*,*) "read lat" + status = NF_GET_VAR_DOUBLE(ncid, latid,lat_landm) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + print *,"close file" + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + + WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' + + ! + ! bin data on cubed-sphere grid + ! + da = pi / DBLE(2*ncube)!equal-angle cubed-sphere grid spacing + lon = deg2rad*lon + lat = deg2rad*lat + dlat = pi/DBLE(jm) + allocate ( weight(ncube,ncube,6),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for weight' + stop + end if + weight = 0.0 + allocate ( terr_cube(ncube,ncube,6),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_cube' + stop + end if + terr_cube = 0.0 + allocate ( landfrac_cube(ncube,ncube,6),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_cube' + stop + end if + landfrac_cube = 0.0 + allocate ( landm_coslat_cube(ncube,ncube,6),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_cube' + stop + end if + landm_coslat_cube = 0.0 + + + allocate ( idx(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for idx' + stop + end if + allocate ( idy(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for idy' + stop + end if + allocate ( idp(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for idp' + stop + end if + + WRITE(*,*) "bin lat-lon data on cubed-sphere" + + ! + ! for debugging ONLY + ! +! DO j=1,jm +! DO i=1,im +!! terr(i,j) = 10000.0*(2.0+cos(lat(j))*cos(lat(j))*cos(2.0*lon(i)))!Y22 +!! terr(i,j) = 10000.0*(2.0+(sin(2.0*lat(j))**16)*cos(16.0*lon(i))) !Y16_32 +! terr(i,j) = 10000.0*(2.0+cos(16.0*lon(i))) !Y16_32 +! END DO +! END DO + + DO j=1,jm + DO i=1,im +! WRITE(*,*) "bin to cube ",100.0*FLOAT(i+(j-1)*im)/FLOAT(im*jm),"% done" + call CubedSphereABPFromRLL(lon(i), lat(j), alpha, beta, ipanel) + icube = CEILING((alpha + piq) / da) + jcube = CEILING((beta + piq) / da) + IF (icube<1.OR.icube>ncube.OR.jcube<1.OR.jcube>ncube) THEN + WRITE(*,*) "fatal error in search algorithm" + WRITE(*,*) "icube or jcube out of range: ",icube,jcube + STOP + END IF + wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) + weight(icube,jcube,ipanel) = weight(icube,jcube,ipanel)+wt + ! + terr_cube (icube,jcube,ipanel) = terr_cube (icube,jcube,ipanel)+wt*DBLE(terr(i,j)) + landfrac_cube(icube,jcube,ipanel) = landfrac_cube(icube,jcube,ipanel)+wt*DBLE(landfrac(i,j)) + ! + ! save "index-association" for variance computation + ! + idx(i,j) = icube + idy(i,j) = jcube + idp(i,j) = ipanel + END DO + END DO + + dx = deg2rad*(lon_landm(2)-lon_landm(1)) + ! + ! lat_landm is not exactly equally spaced so a search is needed in the loop below + ! + dy = deg2rad*(lat_landm(2)-lat_landm(1)) + DO k=1,6 + DO j=1,ncube + DO i=1,ncube + IF (ABS(weight(i,j,k))<1.0E-9) THEN + WRITE(*,*) "there is no lat-lon grid point in cubed sphere cell ",i,j,k + WRITE(*,*) "fatal error" + STOP + ELSE + terr_cube (i,j,k) = terr_cube (i,j,k)/weight(i,j,k) + landfrac_cube (i,j,k) = landfrac_cube (i,j,k)/weight(i,j,k) + END IF + ! + ! linearly interpolate landm_coslat + ! + alpha = -piq+(i-0.5)*da + beta = -piq+(j-0.5)*da + CALL CubedSphereRLLFromABP(alpha, beta, k, lambda, theta) + IF (theta>lat_landm(jm_landm)*deg2rad-tiny) THEN + landm_coslat_cube(i,j,k) = 0.0 + ELSE IF (theta1.0.OR.wy<0.0) + jp1 = ilat+1 + wy = (theta -lat_landm(ilat)*deg2rad)/((lat_landm(jp1)-lat_landm(ilat))*deg2rad) + IF (wy>1.0) THEN + ilat=ilat+1 + ELSE IF (wy<0.0) THEN + ilat=ilat-1 + END IF + END DO + + IF (wx>1.0+tiny.OR.wx<0.0-tiny) THEN + WRITE(*,*) "wx out of range",wx + stop + END IF + IF (wy>1.0+tiny.OR.wy<0.0-tiny) THEN + WRITE(*,*) "wy out of range",wy + stop + END IF + ! + ! "crude" bi-linear interpolation + ! + landm_coslat_cube(i,j,k) =& + (1.0-wx)*(1.0-wy)*landm_coslat(ilon,ilat)+ wx *(1-wy)*landm_coslat(ip1,ilat)+& + (1.0-wx)* wy *landm_coslat(ilon,jp1 )+ wx * wy *landm_coslat(ip1,jp1) + END IF + END DO + END DO + END DO + WRITE(*,*) "min/max value of terr_cube:", MINVAL(terr_cube), MAXVAL(terr_cube) + WRITE(*,*) "min/max value of landm_coslat_cube:", MINVAL(landm_coslat_cube), MAXVAL(landm_coslat_cube) + ! + ! compute volume of topography on cubed-sphere + ! + WRITE(*,*) "compute volume for cubed-sphere binned data" + allocate (darea_cube(ncube,ncube),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for idp' + stop + end if + CALL EquiangularAllAreas(ncube, darea_cube) + vol_cube = 0.0 + do ipanel=1,6 + do j=1,ncube + do i=1,ncube + vol_cube = vol_cube+terr_cube(i,j,ipanel)*darea_cube(i,j) + end do + end do + end do + vol_cube=vol_cube/(4.0*pi) + deallocate(darea_cube) + WRITE(*,*) "mean height (globally) of topography about sea-level (3km cube data)",vol_cube,(vol_cube-vol)/vol + !********************************************************* + ! + ! compute variance + ! + !********************************************************* + ! + allocate ( sgh30_cube(ncube,ncube,6),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for sgh30_cube' + stop + end if + sgh30_cube = 0.0 + DO j=1,jm + DO i=1,im + icube = idx(i,j) + jcube = idy(i,j) + ipanel = idp(i,j) + wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) + sgh30_cube(icube,jcube,ipanel) = sgh30_cube(icube,jcube,ipanel) + & + (wt*(terr_cube(icube,jcube,ipanel)-terr(i,j))**2)/weight(icube,jcube,ipanel) + END DO + END DO + ! sgh30_cube=sgh30_cube/weight + WRITE(*,*) "min/max value of sgh30_cube:", MINVAL(sgh30_cube), MAXVAL(sgh30_cube) + ! + ! write data to NetCDF file + ! + CALL wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) + DEALLOCATE(weight,terr,landfrac,idx,idy,idp,lat,lon) + WRITE(*,*) "done writing cubed sphere data" +end program convterr + + +!************************************************************************ +!!handle_err +!************************************************************************ +! +!!ROUTINE: handle_err +!!DESCRIPTION: error handler +!-------------------------------------------------------------------------- + +subroutine handle_err(status) + + implicit none + +# include + + integer status + + if (status .ne. nf_noerr) then + print *, nf_strerror(status) + stop 'Stopped' + endif + +end subroutine handle_err + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromRLL +! +! Description: +! Determine the (alpha,beta,panel) coordinate of a point on the sphere from +! a given regular lat lon coordinate. +! +! Parameters: +! lon - Coordinate longitude +! lat - Coordinate latitude +! alpha (OUT) - Alpha coordinate +! beta (OUT) - Beta coordinate +! ipanel (OUT) - Face panel +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (R8), INTENT(IN) :: lon, lat + REAL (R8), INTENT(OUT) :: alpha, beta + INTEGER, INTENT(OUT) :: ipanel + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rotate_cube = 0.0 + + ! Local variables + REAL (R8) :: xx, yy, zz, pm + REAL (R8) :: sx, sy, sz + INTEGER :: ix, iy, iz + + ! Translate to (x,y,z) space + xx = COS(lon-rotate_cube) * COS(lat) + yy = SIN(lon-rotate_cube) * COS(lat) + zz = SIN(lat) + + pm = MAX(ABS(xx), ABS(yy), ABS(zz)) + + ! Check maximality of the x coordinate + IF (pm == ABS(xx)) THEN + IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF + ELSE + ix = 0 + ENDIF + + ! Check maximality of the y coordinate + IF (pm == ABS(yy)) THEN + IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF + ELSE + iy = 0 + ENDIF + + ! Check maximality of the z coordinate + IF (pm == ABS(zz)) THEN + IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF + ELSE + iz = 0 + ENDIF + + ! Panel assignments + IF (iz == 1) THEN + ipanel = 6; sx = yy; sy = -xx; sz = zz + + ELSEIF (iz == -1) THEN + ipanel = 5; sx = yy; sy = xx; sz = -zz + + ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN + ipanel = 1; sx = yy; sy = zz; sz = xx + + ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN + ipanel = 3; sx = -yy; sy = zz; sz = -xx + + ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN + ipanel = 2; sx = -xx; sy = zz; sz = yy + + ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN + ipanel = 4; sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' + WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' + WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' + STOP + ENDIF + + ! Use panel information to calculate (alpha, beta) coords + alpha = ATAN(sx / sz) + beta = ATAN(sy / sz) + +END SUBROUTINE CubedSphereABPFromRLL + + + +! +! write netCDF file +! +subroutine wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +# include + + ! + ! Dummy arguments + ! + integer, intent(in) :: ncube + real (r8), dimension(6*ncube*ncube), intent(in) :: terr_cube,landfrac_cube,sgh30_cube,landm_coslat_cube + ! + ! Local variables + ! + !----------------------------------------------------------------------- + ! + ! grid coordinates and masks + ! + !----------------------------------------------------------------------- + + real (r8), dimension(6*ncube*ncube) :: grid_center_lat ! lat/lon coordinates for + real (r8), dimension(6*ncube*ncube) :: grid_center_lon ! each grid center in degrees + + integer :: ncstat ! general netCDF status variable + integer :: nc_grid_id ! netCDF grid dataset id + integer :: nc_gridsize_id ! netCDF grid size dim id + integer :: nc_gridrank_id ! netCDF grid rank dim id + integer :: nc_griddims_id ! netCDF grid dimension size id + integer :: nc_grdcntrlat_id ! netCDF grid center lat id + integer :: nc_grdcntrlon_id ! netCDF grid center lon id + integer :: nc_terr_id + integer :: nc_landfrac_id + integer :: nc_landm_coslat_id + integer :: nc_var_id + + + integer, dimension(2) :: nc_dims2_id ! netCDF dim id array for 2-d arrays + integer :: grid_dims + + character(18), parameter :: grid_file_out = 'USGS-topo-cube.nc' + character(90), parameter :: grid_name = 'equi-angular gnomonic cubed sphere grid' + + character (len=32) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: status ! return value for error control of netcdf routin + integer :: i,j,k + character (len=8) :: datestring + + integer :: atm_add,n + real(r8) :: xgno_ce,lon,ygno_ce,lat + + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rad2deg = 180.0/pi + + real(r8) :: da, a1,a2,a3,a4,dbg_area,max_size + real(r8), dimension(2,2) :: ang + real(r8) :: tmp_lon,min_lon,max_lon!,sum,lflag_value + logical :: lflag + + grid_dims = 6*ncube*ncube + + dbg_area = 0.0 + + da = pi / DBLE(2*ncube) + atm_add = 1 + do k=1,6 + do j=1,ncube + ygno_ce = -piq + da * (DBLE(j-1)+0.5) !center of cell + do i=1,ncube + xgno_ce = -piq + da * (DBLE(i-1)+0.5) + call CubedSphereRLLFromABP(xgno_ce, ygno_ce, k, lon, lat) + grid_center_lon(atm_add ) = lon*rad2deg + grid_center_lat(atm_add ) = lat*rad2deg + atm_add = atm_add+1 + end do + end do + end do + + WRITE(*,*) "Create NetCDF file for output" + ncstat = nf_create (grid_file_out, NF_64BIT_OFFSET,nc_grid_id) + call handle_err(ncstat) + + ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',len_trim(grid_name), grid_name) + call handle_err(ncstat) + + WRITE(*,*) "define grid size dimension" + ncstat = nf_def_dim (nc_grid_id, 'grid_size', 6*ncube*ncube, nc_gridsize_id) + call handle_err(ncstat) + + WRITE(*,*) "define grid rank dimension" + ncstat = nf_def_dim (nc_grid_id, 'grid_rank', 1, nc_gridrank_id) + call handle_err(ncstat) + + WRITE(*,*) "define grid dimension size array" + ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,1, nc_gridrank_id, nc_griddims_id) + call handle_err(ncstat) + + WRITE(*,*) "define grid center latitude array" + ncstat = nf_def_var (nc_grid_id, 'lat', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlat_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',13, 'degrees_north') + call handle_err(ncstat) + + WRITE(*,*) "define grid center longitude array" + ncstat = nf_def_var (nc_grid_id, 'lon', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlon_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',12, 'degrees_east') + call handle_err(ncstat) + + WRITE(*,*) "define terr_cube array" + ncstat = nf_def_var (nc_grid_id, 'terr', NF_DOUBLE,1, nc_gridsize_id, nc_terr_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_terr_id, 'units',1, 'm') + call handle_err(ncstat) + + WRITE(*,*) "define landfrac_cube array" + ncstat = nf_def_var (nc_grid_id, 'LANDFRAC', NF_DOUBLE,1, nc_gridsize_id, nc_landfrac_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_landfrac_id, 'long_name',70,& + 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') + call handle_err(ncstat) + + WRITE(*,*) "define landm_coslat_cube array" + ncstat = nf_def_var (nc_grid_id, 'LANDM_COSLAT', NF_DOUBLE,1, nc_gridsize_id, nc_landm_coslat_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_landm_coslat_id, 'long_name',35,'smoothed land ocean transition mask') + call handle_err(ncstat) + + WRITE(*,*) "define sgh30_cube array" + ncstat = nf_def_var (nc_grid_id, 'SGH30', NF_DOUBLE,1, nc_gridsize_id, nc_var_id) + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'units',12, 'm') + call handle_err(ncstat) + ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'long_name',58,& + 'variance of elevation from 30s lat-lon to 3km cubed-sphere') + + WRITE(*,*) "end definition stage" + ncstat = nf_enddef(nc_grid_id) + call handle_err(ncstat) + + !----------------------------------------------------------------------- + ! + ! write grid data + ! + !----------------------------------------------------------------------- + + + WRITE(*,*) "write grid data" + ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, grid_center_lat) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, grid_center_lon) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_terr_id, terr_cube) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_landfrac_id, landfrac_cube) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_landm_coslat_id, landm_coslat_cube) + call handle_err(ncstat) + + ncstat = nf_put_var_double(nc_grid_id, nc_var_id, sgh30_cube) + call handle_err(ncstat) + + WRITE(*,*) "Close output file" + ncstat = nf_close(nc_grid_id) + call handle_err(ncstat) +end subroutine wrt_cube + + +!------------------------------------------------------------------------------ +! SUBROUTINE EquiangularAllAreas +! +! Description: +! Compute the area of all cubed sphere grid cells, storing the results in +! a two dimensional array. +! +! Parameters: +! icube - Resolution of the cubed sphere +! dA (OUT) - Output array containing the area of all cubed sphere grid cells +!------------------------------------------------------------------------------ +SUBROUTINE EquiangularAllAreas(icube, dA) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + INTEGER, INTENT(IN) :: icube + REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA + + ! Local variables + INTEGER :: k, k1, k2 + REAL (r8) :: a1, a2, a3, a4 + REAL (r8), DIMENSION(icube+1,icube+1) :: ang + REAL (r8), DIMENSION(icube+1) :: gp + + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + + !#ifdef DBG + REAL (r8) :: dbg1 !DBG + !#endif + + ! Recall that we are using equi-angular spherical gridding + ! Compute the angle between equiangular cubed sphere projection grid lines. + DO k = 1, icube+1 + gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) + ENDDO + + DO k2=1,icube+1 + DO k1=1,icube+1 + ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) + ENDDO + ENDDO + + DO k2=1,icube + DO k1=1,icube + a1 = ang(k1 , k2 ) + a2 = pi - ang(k1+1, k2 ) + a3 = pi - ang(k1 , k2+1) + a4 = ang(k1+1, k2+1) + + ! area = r*r*(-2*pi+sum(interior angles)) + DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 + ENDDO + ENDDO + + !#ifdef DBG + ! Only for debugging - test consistency + dbg1 = 0.0 !DBG + DO k2=1,icube + DO k1=1,icube + dbg1 = dbg1 + DA(k1,k2) !DBG + ENDDO + ENDDO + write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG + !#endif +END SUBROUTINE EquiangularAllAreas + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereRLLFromABP +! +! Description: +! Determine the lat lon coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! lon (OUT) - Calculated longitude +! lat (OUT) - Calculated latitude +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: lon, lat + ! Local variables + REAL (r8) :: xx, yy, zz, rotate_cube + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + rotate_cube = 0.0 + ! Convert to cartesian coordinates + CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + ! Convert back to lat lon + lat = ASIN(zz) + if (xx==0.0.and.yy==0.0) THEN + lon = 0.0 + else + lon = ATAN2(yy, xx) +rotate_cube + IF (lon<0.0) lon=lon+2.0*pi + IF (lon>2.0*pi) lon=lon-2.0*pi + end if +END SUBROUTINE CubedSphereRLLFromABP + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereXYZFromABP +! +! Description: +! Determine the Cartesian coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! xx (OUT) - Calculated x coordinate +! yy (OUT) - Calculated y coordinate +! zz (OUT) - Calculated z coordinate +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: xx, yy, zz + ! Local variables + REAL (r8) :: a1, b1, pm + REAL (r8) :: sx, sy, sz + + ! Convert to Cartesian coordinates + a1 = TAN(alpha) + b1 = TAN(beta) + + sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + ! Panel assignments + IF (ipanel == 6) THEN + yy = sx; xx = -sy; zz = sz + ELSEIF (ipanel == 5) THEN + yy = sx; xx = sy; zz = -sz + ELSEIF (ipanel == 1) THEN + yy = sx; zz = sy; xx = sz + ELSEIF (ipanel == 3) THEN + yy = -sx; zz = sy; xx = -sz + ELSEIF (ipanel == 2) THEN + xx = -sx; zz = sy; yy = sz + ELSEIF (ipanel == 4) THEN + xx = sx; zz = sy; yy = -sz + ELSE + WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' + WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' + STOP + ENDIF +END SUBROUTINE CubedSphereXYZFromABP + + diff --git a/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 b/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 new file mode 100644 index 0000000000..fc1ed8e94a --- /dev/null +++ b/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 @@ -0,0 +1,20 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + +END MODULE shr_kind_mod diff --git a/tools/topo_tool/cube_to_target/Makefile b/tools/topo_tool/cube_to_target/Makefile new file mode 100644 index 0000000000..23d518cf03 --- /dev/null +++ b/tools/topo_tool/cube_to_target/Makefile @@ -0,0 +1,69 @@ +EXEDIR = . +EXENAME = cube_to_target +RM = rm + +.SUFFIXES: +.SUFFIXES: .F90 .o + +FC = lf95 +DEBUG = FALSE + + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /usr/local/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +#------------------------------------------------------------------------ +# LF95 +#------------------------------------------------------------------------ +# +# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib +# +ifeq ($(FC),lf95) +# +# Tramhill +# + INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include + LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib + + LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium + FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) + ifeq ($(DEBUG),TRUE) +# FFLAGS += --chk aesu -Cpp --trace + FFLAGS += -g --chk a,e,s,u --pca + else + FFLAGS += -O + endif + +endif + + + +.F90.o: + $(FC) $(FFLAGS) $< + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +OBJS := reconstruct.o remap.o cube_to_target.o shr_kind_mod.o + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +cube_to_target.o: shr_kind_mod.o remap.o reconstruct.o +remap.o: +reconstruct.o: remap.o +#reconstruct.o : shr_kind_mod.o diff --git a/tools/topo_tool/cube_to_target/README b/tools/topo_tool/cube_to_target/README new file mode 100644 index 0000000000..134b6de4f9 --- /dev/null +++ b/tools/topo_tool/cube_to_target/README @@ -0,0 +1,20 @@ +cube_to_target performs rigourous remapping of topo variables from cubed-sphere grid to +any target grid. In the process SGH is computed. + +Input files: + +1. USGS-topo-cube.nc (may be found here $CESMDATA/inputdata/atm/cam/hrtopo/USGS-topo-cube3000.nc) + + This is the topo data on a cubed-sphere (default is 3km cubed-sphere grid) + +2. target.nc (e.g., $CESMDATA/inputdata/atm/cam/grid-description/se/ne30np4_091226_pentagons.nc) + + This is a SCRIP/ESMF grid descriptor file for the target grid + +3. phis-smooth.nc + + (optional) The user may provide a smoothed PHIS field. The software then recomputes SGH to + account for the smoothing in the sub-grid-scale. + + + diff --git a/tools/topo_tool/cube_to_target/cube_to_target.F90 b/tools/topo_tool/cube_to_target/cube_to_target.F90 new file mode 100644 index 0000000000..3f73f6a47b --- /dev/null +++ b/tools/topo_tool/cube_to_target/cube_to_target.F90 @@ -0,0 +1,2008 @@ +! +! DATE CODED: Nov 7, 2011 to Oct 15, 2012 +! DESCRIPTION: Remap topo data from cubed-sphere grid to target grid using rigorous remapping +! (Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys.) +! +! Author: Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR +! +program convterr + use shr_kind_mod, only: r8 => shr_kind_r8 + use reconstruct + implicit none +# include + + !************************************** + ! + ! USER SETTINGS BELOW + ! + !************************************** + ! + ! + ! if smoothed PHIS is available SGH needs to be recomputed to account for the sub-grid-scale + ! variability introduced by the smoothing + ! + logical :: lsmooth_terr = .FALSE. + ! + ! PHIS is smoothed by other software/dynamical core + ! + logical :: lexternal_smooth_terr = .FALSE. ! lexternal_smooth_terr = .FALSE. is NOT supported currently + ! + ! set PHIS=0.0 if LANDFRAC<0.01 + ! + logical :: lzero_out_ocean_point_phis = .FALSE. + ! + ! For internal smoothing (experimental at this point) + ! =================================================== + ! + ! if smoothing is internal (lexternal_smooth_terr=.FALSE.) choose coarsening factor + ! + ! recommendation: 2*(target resolution)/(0.03 degree) + ! + ! factor must be an even integer + ! + integer, parameter :: factor = 60 !coarse grid = 2.25 degrees + integer, parameter :: norder = 2 + integer, parameter :: nmono = 0 + integer, parameter :: npd = 1 + ! + !********************************************************************** + ! + ! END OF USER SETTINS BELOW + ! (do not edit beyond this point unless you know what you are doing!) + ! + !********************************************************************** + ! + integer :: im, jm, ncoarse + integer :: ncube !dimension of cubed-sphere grid + + real(r8), allocatable, dimension(:) :: landm_coslat, landfrac, terr, sgh30 + real(r8), allocatable, dimension(:) :: terr_coarse !for internal smoothing + + integer :: alloc_error,dealloc_error + integer :: i,j,n,k,index + integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile + integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file + integer :: srcid,dstid, jm_dbg ! for netCDF weight file + integer, dimension(2) :: src_grid_dims ! for netCDF weight file + + integer :: dimid + + logical :: ldbg + real(r8), allocatable, dimension(:) :: lon , lat + real(r8), allocatable, dimension(:) :: lon_landm , lat_landm + real(r8), allocatable, dimension(:) :: area + integer :: im_landm, jm_landm + integer :: lonid, latid, phisid + ! + ! constants + ! + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: pih = 0.50*pi + REAL (r8), PARAMETER :: deg2rad = pi/180.0 + + real(r8) :: wt,dlat + integer :: ipanel,icube,jcube + real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube + real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube + integer, allocatable, dimension(:,:) :: idx,idy,idp + integer :: npatch, isub,jsub, itmp, iplm1,jmin,jmax + real(r8) :: sum,dx,scale,dmax,arad,jof,term,s1,c1,clon,iof,dy,s2,c2,dist + ! + ! for linear interpolation + ! + real(r8) :: lambda,theta,wx,wy,offset + integer :: ilon,ilat,ip1,jp1 + ! + ! variable for regridding + ! + integer :: src_grid_dim ! for netCDF weight file + integer :: n_a,n_b,n_s,n_aid,n_bid,n_sid + integer :: count + real(r8), allocatable, dimension(:) :: landfrac_target, terr_target, sgh30_target, sgh_target + real(r8), allocatable, dimension(:) :: landm_coslat_target, area_target + ! + ! this is only used if target grid is a lat-lon grid + ! + integer , parameter :: im_target = 360 , jm_target = 180 + ! + ! this is only used if target grid is not a lat-lon grid + ! + real(r8), allocatable, dimension(:) :: lon_target, lat_target + ! + ! new + ! + integer :: ntarget, ntarget_id, ncorner, ncorner_id, nrank, nrank_id + integer :: ntarget_smooth + real(r8), allocatable, dimension(:,:):: target_corner_lon, target_corner_lat + real(r8), allocatable, dimension(:) :: target_center_lon, target_center_lat, target_area + integer :: ii,ip,jx,jy,jp + real(r8), dimension(:), allocatable :: xcell, ycell, xgno, ygno + real(r8), dimension(:), allocatable :: gauss_weights,abscissae + integer, parameter :: ngauss = 3 + integer :: jmax_segments,jall + real(r8) :: tmp + + real(r8), allocatable, dimension(:,:) :: weights_all + integer , allocatable, dimension(:,:) :: weights_eul_index_all + integer , allocatable, dimension(:) :: weights_lgr_index_all + integer :: ix,iy + ! + ! volume of topography + ! + real(r8) :: vol_target, vol_target_un, area_target_total,vol_source,vol_tmp + integer :: nlon,nlon_smooth,nlat,nlat_smooth + logical :: ltarget_latlon,lpole + real(r8), allocatable, dimension(:,:) :: terr_smooth + ! + ! for internal filtering + ! + real(r8), allocatable, dimension(:,:) :: weights_all_coarse + integer , allocatable, dimension(:,:) :: weights_eul_index_all_coarse + integer , allocatable, dimension(:) :: weights_lgr_index_all_coarse + real(r8), allocatable, dimension(:) :: area_target_coarse + real(r8), allocatable, dimension(:,:) :: da_coarse,da + real(r8), allocatable, dimension(:,:) :: recons,centroids + integer :: nreconstruction + + integer :: jmax_segments_coarse,jall_coarse,ncube_coarse + real(r8) :: all_weights + + ! + ! turn extra debugging on/off + ! + ldbg = .FALSE. + + nreconstruction = 1 + ! + !********************************************************* + ! + ! read in target grid + ! + !********************************************************* + ! + status = nf_open('target.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'grid_size', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, ntarget) + WRITE(*,*) "dimension of target grid: ntarget=",ntarget + + status = NF_INQ_DIMID(ncid, 'grid_corners', ncorner_id) + status = NF_INQ_DIMLEN(ncid, ncorner_id, ncorner) + WRITE(*,*) "maximum number of corners: ncorner=",ncorner + + status = NF_INQ_DIMID(ncid, 'grid_rank', nrank_id);status = NF_INQ_DIMLEN(ncid, nrank_id, nrank) + WRITE(*,*) "grid rank: nrank=",nrank + IF (nrank==2) THEN + WRITE(*,*) "target grid is a lat-lon grid" + ltarget_latlon = .TRUE. + status = NF_INQ_DIMID(ncid, 'nlon', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon) + status = NF_INQ_DIMID(ncid, 'nlat', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat) + status = NF_INQ_DIMID(ncid, 'lpole', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, lpole) + WRITE(*,*) "nlon=",nlon,"nlat=",nlat + IF (lpole) THEN + WRITE(*,*) "center of most Northern grid cell is lat=90; similarly for South pole" + ELSE + WRITE(*,*) "center of most Northern grid cell is NOT lat=90; similarly for South pole" + END IF + ELSE IF (nrank==1) THEN + ltarget_latlon = .FALSE. + ELSE + WRITE(*,*) "nrank out of range",nrank + STOP + ENDIF + + allocate ( target_corner_lon(ncorner,ntarget),stat=alloc_error) + allocate ( target_corner_lat(ncorner,ntarget),stat=alloc_error) + + status = NF_INQ_VARID(ncid, 'grid_corner_lon', lonid) + status = NF_GET_VAR_DOUBLE(ncid, lonid,target_corner_lon) + IF (maxval(target_corner_lon)>10.0) target_corner_lon = deg2rad*target_corner_lon + + status = NF_INQ_VARID(ncid, 'grid_corner_lat', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_corner_lat) + IF (maxval(target_corner_lat)>10.0) target_corner_lat = deg2rad*target_corner_lat + ! + ! for writing remapped data on file at the end of the program + ! + allocate ( target_center_lon(ntarget),stat=alloc_error) + allocate ( target_center_lat(ntarget),stat=alloc_error) + allocate ( target_area (ntarget),stat=alloc_error)!dbg + + status = NF_INQ_VARID(ncid, 'grid_center_lon', lonid) + status = NF_GET_VAR_DOUBLE(ncid, lonid,target_center_lon) + + status = NF_INQ_VARID(ncid, 'grid_center_lat', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_center_lat) + + status = NF_INQ_VARID(ncid, 'grid_area', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_area) + + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + !**************************************************** + ! + ! get dimension of cubed-sphere grid + ! + !**************************************************** + ! + WRITE(*,*) "get dimension of cubed-sphere data from file" + status = nf_open('USGS-topo-cube.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'grid_size', dimid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimid, n) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + ncube = INT(SQRT(DBLE(n/6))) + WRITE(*,*) "cubed-sphere dimension: ncube = ",ncube + WRITE(*,*) "average grid-spacing at the Equator (degrees):" ,90.0/ncube + + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + !**************************************************** + ! + ! compute weights for remapping + ! + !**************************************************** + ! + jall = ncube*ncube*12*10 !anticipated number of weights (cab be tweaked) + jmax_segments = 100000 !can be tweaked + + allocate (weights_all(jall,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index_all(jall,3),stat=alloc_error ) + allocate (weights_lgr_index_all(jall),stat=alloc_error ) + + CALL overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& + jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) + ! + !**************************************************** + ! + ! read cubed-sphere 3km data + ! + !**************************************************** + ! + WRITE(*,*) "read cubed-sphere 3km data from file" + status = nf_open('USGS-topo-cube.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'grid_size', dimid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimid, n) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + ncube = INT(SQRT(DBLE(n/6))) + WRITE(*,*) "cubed-sphere dimension, ncube: ",ncube + + allocate ( landm_coslat(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) + ! + ! read LANDFRAC + ! + allocate ( landfrac(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'LANDFRAC', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,landfrac) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of landfrac",MINVAL(landfrac),MAXVAL(landfrac) + ! + ! read terr + ! + allocate ( terr(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'terr', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,terr) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of terr",MINVAL(terr),MAXVAL(terr) + ! + ! + ! + allocate ( sgh30(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'SGH30', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,sgh30) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of sgh30",MINVAL(sgh30),MAXVAL(sgh30) + print *,"close file" + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + + WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' + ! + !********************************************************* + ! + ! do actual remapping + ! + !********************************************************* + ! + allocate (terr_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_target' + stop + end if + allocate (landfrac_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac_target' + stop + end if + allocate (landm_coslat_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac_target' + stop + end if + allocate (sgh30_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for sgh30_target' + stop + end if + allocate (area_target(ntarget),stat=alloc_error ) + terr_target = 0.0 + landfrac_target = 0.0 + sgh30_target = 0.0 + landm_coslat_target = 0.0 + area_target = 0.0 + + tmp = 0.0 + do count=1,jall + i = weights_lgr_index_all(count) + wt = weights_all(count,1) + area_target (i) = area_target(i) + wt + end do + + do count=1,jall + i = weights_lgr_index_all(count) + + ix = weights_eul_index_all(count,1) + iy = weights_eul_index_all(count,2) + ip = weights_eul_index_all(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix + + wt = weights_all(count,1) + + terr_target (i) = terr_target (i) + wt*terr (ii)/area_target(i) + landfrac_target (i) = landfrac_target (i) + wt*landfrac (ii)/area_target(i) + landm_coslat_target(i) = landm_coslat_target(i) + wt*landm_coslat(ii)/area_target(i) + sgh30_target (i) = sgh30_target (i) + wt*sgh30 (ii)/area_target(i) + + tmp = tmp+wt*terr(ii) + end do + + + write(*,*) "tmp", tmp + WRITE(*,*) "max difference between target grid area and remapping software area",& + MAXVAL(target_area-area_target) + + do count=1,ntarget + if (terr_target(count)>8848.0) then + ! + ! max height is higher than Mount Everest + ! + write(*,*) "FATAL error: max height is higher than Mount Everest!" + write(*,*) "terr_target",count,terr_target(count) + write(*,*) "(lon,lat) locations of vertices of cell with excessive max height::" + do i=1,ncorner + write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) + end do + STOP + else if (terr_target(count)<-423.0) then + ! + ! min height is lower than Dead Sea + ! + write(*,*) "FATAL error: min height is lower than Dead Sea!" + write(*,*) "terr_target",count,terr_target(count) + write(*,*) "(lon,lat) locations of vertices of cell with excessive min height::" + do i=1,ncorner + write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) + end do + STOP + else + + end if + end do + WRITE(*,*) "Elevation data passed min/max consistency check!" + WRITE(*,*) + + WRITE(*,*) "min/max of unsmoothed terr_target : ",MINVAL(terr_target ),MAXVAL(terr_target ) + WRITE(*,*) "min/max of landfrac_target : ",MINVAL(landfrac_target),MAXVAL(landfrac_target) + WRITE(*,*) "min/max of landm_coslat_target : ",& + MINVAL(landm_coslat_target),MAXVAL(landm_coslat_target) + WRITE(*,*) "min/max of var30_target : ",MINVAL(sgh30_target ),MAXVAL(sgh30_target ) + ! + ! compute mean height (globally) of topography about sea-level for target grid unfiltered elevation + ! + vol_target_un = 0.0 + area_target_total = 0.0 + DO i=1,ntarget + area_target_total = area_target_total+area_target(i) + vol_target_un = vol_target_un+terr_target(i)*area_target(i) + END DO + WRITE(*,*) "mean height (globally) of topography about sea-level for target grid unfiltered elevation",& + vol_target_un/area_target_total + + ! + ! diagnostics + ! + vol_source = 0.0 + allocate ( dA(ncube,ncube),stat=alloc_error ) + CALL EquiangularAllAreas(ncube, dA) + DO jp=1,6 + DO jy=1,ncube + DO jx=1,ncube + ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx + vol_source = vol_source+terr(ii)*dA(jx,jy) + END DO + END DO + END DO + WRITE(*,*) "volume of input cubed-sphere terrain :",vol_source + WRITE(*,*) "average elevation of input cubed-sphere terrain:",vol_source/(4.0*pi) + + DEALLOCATE(dA) + ! + ! + ! + allocate (sgh_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for sgh_target' + stop + end if + ! + ! compute variance with respect to cubed-sphere data + ! + WRITE(*,*) "compute variance with respect to 3km cubed-sphere data: SGH" + + IF (lsmooth_terr) THEN + WRITE(*,*) "smoothing PHIS" + IF (lexternal_smooth_terr) THEN + WRITE(*,*) "using externally generated smoothed topography" + + status = nf_open('phis-smooth.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + ! + IF (.NOT.ltarget_latlon) THEN + ! + !********************************************************* + ! + ! read in smoothed topography + ! + !********************************************************* + ! + status = NF_INQ_DIMID (ncid, 'ncol', ntarget_id ) + status = NF_INQ_DIMLEN(ncid, ntarget_id , ntarget_smooth) + IF (ntarget.NE.ntarget_smooth) THEN + WRITE(*,*) "mismatch in smoothed data-set and target grid specification" + WRITE(*,*) ntarget, ntarget_smooth + STOP + END IF + status = NF_INQ_VARID(ncid, 'PHIS', phisid) + ! + ! overwrite terr_target with smoothed version + ! + status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_target) + terr_target = terr_target/9.80616 + ELSE + ! + ! read in smoothed lat-lon topography + ! + status = NF_INQ_DIMID(ncid, 'lon', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon_smooth) + status = NF_INQ_DIMID(ncid, 'lat', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat_smooth) + IF (nlon.NE.nlon_smooth.OR.nlat.NE.nlat_smooth) THEN + WRITE(*,*) "smoothed topography dimensions do not match target grid dimensions" + WRITE(*,*) "target grid : nlon ,nlat =",nlon,nlat + WRITE(*,*) "smoothed topo: nlon_smooth,nlat_smooth =",nlon_smooth,nlat_smooth + STOP + END IF + ALLOCATE(terr_smooth(nlon_smooth,nlat_smooth),stat=alloc_error) + status = NF_INQ_VARID(ncid, 'PHIS', phisid) + status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_smooth) + ! + ! overwrite terr_target with smoothed version + ! + ii=1 + DO j=1,nlat + DO i=1,nlon + terr_target(ii) = terr_smooth(i,j)/9.80616 + ii=ii+1 + END DO + END DO + DEALLOCATE(terr_smooth) + END IF + ELSE + WRITE(*,*) "unstested software - uncomment this line of you know what you are doing!" + STOP + ! + !***************************************************** + ! + ! smoothing topography internally + ! + !***************************************************** + ! + WRITE(*,*) "internally smoothing orography" + ! CALL smooth(terr_target,ntarget,target_corner_lon,target_corner_lat) + ! + ! smooth topography internally + ! + ncoarse = n/(factor*factor) + ! + ! + ! + ncube_coarse = ncube/factor + WRITE(*,*) "resolution of coarse grid", 90.0/ncube_coarse + allocate ( terr_coarse(ncoarse),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + WRITE(*,*) "coarsening" + allocate ( dA_coarse(ncube_coarse,ncube_coarse),stat=alloc_error ) + CALL coarsen(terr,terr_coarse,factor,n,dA_coarse) + ! + ! + ! + vol_tmp = 0.0 + DO jp=1,6 + DO jy=1,ncube_coarse + DO jx=1,ncube_coarse + ii = (jp-1)*ncube_coarse*ncube_coarse+(jy-1)*ncube_coarse+jx + vol_tmp = vol_tmp+terr_coarse(ii)*dA_coarse(jx,jy) + END DO + END DO + END DO + WRITE(*,*) "volume of coarsened cubed-sphere terrain :",vol_source + WRITE(*,*) "difference between coarsened cubed-sphere data and input cubed-sphere data",& + vol_tmp-vol_source + + + + WRITE(*,*) "done coarsening" + + nreconstruction = 1 + IF (norder>1) THEN + IF (norder == 2) THEN + nreconstruction = 3 + ELSEIF (norder == 3) THEN + nreconstruction = 6 + END IF + ALLOCATE(recons (nreconstruction, ncoarse), STAT=status) + ALLOCATE(centroids(nreconstruction, ncoarse), STAT=status) + CALL get_reconstruction(terr_coarse,norder, nmono, recons, npd,da_coarse,& + ncube_coarse+1,nreconstruction,centroids) + SELECT CASE (nmono) + CASE (0) + WRITE(*,*) "coarse grid reconstructions are not filtered with shape-preesrving filter" + CASE (1) + WRITE(*,*) "coarse grid reconstructions are filtered with shape-preserving filter" + CASE DEFAULT + WRITE(*,*) "nmono out of range: ",nmono + STOP + END SELECT + SELECT CASE (0) + CASE (0) + WRITE(*,*) "coarse grid reconstructions are not filtered with positive definite filter" + CASE (1) + WRITE(*,*) "coarse grid reconstructions filtered with positive definite filter" + CASE DEFAULT + WRITE(*,*) "npd out of range: ",npd + STOP + END SELECT + END IF + + jall_coarse = (ncube*ncube*12) !anticipated number of weights + jmax_segments_coarse = jmax_segments!/factor ! + WRITE(*,*) "anticipated",jall_coarse + allocate (weights_all_coarse(jall_coarse,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index_all_coarse(jall_coarse,3),stat=alloc_error ) + allocate (weights_lgr_index_all_coarse(jall_coarse),stat=alloc_error ) + ! + ! + ! + CALL overlap_weights(weights_lgr_index_all_coarse,weights_eul_index_all_coarse,weights_all_coarse,& + jall_coarse,ncube_coarse,ngauss,ntarget,ncorner,jmax_segments_coarse,target_corner_lon,& + target_corner_lat,nreconstruction) + WRITE(*,*) "MIN/MAX of area-weight [0:1]: ",& + MINVAL(weights_all_coarse(:,1)),MAXVAL(weights_all_coarse(:,1)) + ! + ! compute new weights + ! + + ! + ! do mapping + ! + terr_target = 0.0 + tmp = 0.0 + allocate ( area_target_coarse(ntarget),stat=alloc_error) + all_weights = 0.0 + area_target_coarse = 0.0 + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + wt = weights_all_coarse(count,1) + area_target_coarse (i) = area_target_coarse(i) + wt + all_weights = all_weights+wt + end do + WRITE(*,*) "sum of all weights (coarse to target) minus area of sphere : ",all_weights-4.0*pi + WRITE(*,*) "MIN/MAX of area_target_coarse [0:1]:",& + MINVAL(area_target_coarse),MAXVAL(area_target_coarse) + IF (norder==1) THEN + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + wt = weights_all_coarse(count,1) + + terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) + tmp = tmp+wt*terr_coarse(ii) + end do + ELSE IF (norder==2) THEN + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + IF (i>jall_coarse.OR.i<1) THEN + WRITE(*,*) i,jall_coarse + STOP + END IF + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& + ! + ! all constant terms + ! + terr_coarse(ii) & + - recons(1,ii)*centroids(1,ii) & + - recons(2,ii)*centroids(2,ii) & + ! + ! + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& + ! + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& + ! + ! + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& + )+& + ! + ! linear terms + ! + weights_all_coarse(count,2)*(& + + recons(1,ii)& + + ! - recons(3,ii)*2.0*centroids(1,ii)& + ! - recons(5,ii)* centroids(2,ii)& + )+& + ! + weights_all_coarse(count,3)*(& + recons(2,ii)& + ! + ! - recons(4,ii)*2.0*centroids(2,ii)& + ! - recons(5,ii)* centroids(1,ii)& + )& + ! + ! quadratic terms + ! + ! weights_all_coarse(count,4)*recons(3,ii)+& + ! weights_all_coarse(count,5)*recons(4,ii)+& + ! weights_all_coarse(count,6)*recons(5,ii) + )/area_target_coarse(i) + end do + DEALLOCATE(centroids) + DEALLOCATE(recons) + DEALLOCATE(weights_all_coarse) + + ELSE IF (norder==3) THEN + ! recons(4,:) = 0.0 + ! recons(5,:) = 0.0 + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + IF (i>jall_coarse.OR.i<1) THEN + WRITE(*,*) i,jall_coarse + STOP + END IF + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + ! terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) + + ! WRITE(*,*) count,area_target_coarse(i) + ! terr_target(i) = terr_target(i) + area_target_coarse(i) + ! + terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& + + + ! centroids(5,ii))/area_target_coarse(i)) + ! centroids(1,ii)/area_target_coarse(i)) + ! /area_target_coarse(i)) + + + + + ! + ! all constant terms + ! + terr_coarse(ii) & + - recons(1,ii)*centroids(1,ii) & + - recons(2,ii)*centroids(2,ii) & + ! + + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& + + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& + ! + + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& + )+& + ! + ! linear terms + ! + weights_all_coarse(count,2)*(& + + recons(1,ii)& + + - recons(3,ii)*2.0*centroids(1,ii)& + - recons(5,ii)* centroids(2,ii)& + )+& + ! + weights_all_coarse(count,3)*(& + recons(2,ii)& + ! + - recons(4,ii)*2.0*centroids(2,ii)& + - recons(5,ii)* centroids(1,ii)& + )+& + ! + ! quadratic terms + ! + weights_all_coarse(count,4)*recons(3,ii)+& + weights_all_coarse(count,5)*recons(4,ii)+& + weights_all_coarse(count,6)*recons(5,ii))/area_target_coarse(i) + end do + DEALLOCATE(centroids) + DEALLOCATE(recons) + DEALLOCATE(weights_all_coarse) + END IF + DEALLOCATE(area_target_coarse) + WRITE(*,*) "done smoothing" + END IF + ! + ! compute mean height (globally) of topography about sea-level for target grid filtered elevation + ! + vol_target = 0.0 + DO i=1,ntarget + vol_target = vol_target+terr_target(i)*area_target(i) + ! if (ABS(area_target(i)-area_target_coarse(i))>0.000001) THEN + ! WRITE(*,*) "xxx",area_target(i),area_target_coarse(i),area_target(i)-area_target_coarse(i) + ! STOP + ! END IF + END DO + WRITE(*,*) "mean height (globally) of topography about sea-level for target grid filtered elevation",& + vol_target/area_target_total + WRITE(*,*) "percentage change in mean height between filtered and unfiltered elevations",& + 100.0*(vol_target-vol_target_un)/vol_target_un + WRITE(*,*) "percentage change in mean height between input cubed-sphere and unfiltered elevations",& + 100.0*(vol_source-vol_target_un)/vol_source + + END IF + ! + ! Done internal smoothing + ! + WRITE(*,*) "min/max of terr_target : ",MINVAL(terr_target),MAXVAL(terr_target) + + if (lzero_out_ocean_point_phis) then + WRITE(*,*) "if ocean mask PHIS=0.0" + end if + + + sgh_target=0.0 + do count=1,jall + i = weights_lgr_index_all(count)!! + ! + ix = weights_eul_index_all(count,1) + iy = weights_eul_index_all(count,2) + ip = weights_eul_index_all(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + + wt = weights_all(count,1) + + if (lzero_out_ocean_point_phis.AND.landfrac_target(i).lt.0.01_r8) then + terr_target(i) = 0.0_r8 !5*terr_target(i) + end if + sgh_target(i) = sgh_target(i)+wt*((terr_target(i)-terr(ii))**2)/area_target(i) + end do + + + + ! + ! zero out small values + ! + DO i=1,ntarget + IF (landfrac_target(i)<.001_r8) landfrac_target(i) = 0.0 + IF (sgh_target(i)<0.5) sgh_target(i) = 0.0 + IF (sgh30_target(i)<0.5) sgh30_target(i) = 0.0 + END DO + sgh_target = SQRT(sgh_target) + sgh30_target = SQRT(sgh30_target) + WRITE(*,*) "min/max of sgh_target : ",MINVAL(sgh_target),MAXVAL(sgh_target) + WRITE(*,*) "min/max of sgh30_target : ",MINVAL(sgh30_target),MAXVAL(sgh30_target) + + DEALLOCATE(terr,weights_all,weights_eul_index_all,landfrac,landm_coslat) + + + IF (ltarget_latlon) THEN + CALL wrtncdf_rll(nlon,nlat,lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& + landm_coslat_target,target_center_lon,target_center_lat,.true.) + ELSE + CALL wrtncdf_unstructured(ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& + landm_coslat_target,target_center_lon,target_center_lat) + END IF + DEALLOCATE(terr_target,landfrac_target,sgh30_target,sgh_target,landm_coslat_target) + +end program convterr + +! +! +! +subroutine wrtncdf_unstructured(n,terr,landfrac,sgh,sgh30,landm_coslat,lon,lat) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +# include + + ! + ! Dummy arguments + ! + integer, intent(in) :: n + real(r8),dimension(n) , intent(in) :: terr, landfrac,sgh,sgh30,lon, lat, landm_coslat + ! + ! Local variables + ! + character (len=64) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: terrid,nid + integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid + integer :: status ! return value for error control of netcdf routin + integer :: i,j + integer, dimension(2) :: nc_lat_vid,nc_lon_vid + character (len=8) :: datestring + integer :: nc_gridcorn_id, lat_vid, lon_vid + + real(r8), parameter :: fillvalue = 1.d36 + + fout='new-topo-file.nc' + ! + ! Create NetCDF file for output + ! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create dimensions for output + ! + status = nf_def_dim (foutid, 'ncol', n, nid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create variable for output + ! + print *,"Create variable for output" + status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 1, nid, terrid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 1, nid, landfracid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'SGH', NF_DOUBLE, 1, nid, sghid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 1, nid, sgh30id) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 1, nid, landm_coslatid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, nid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, nid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + + ! + ! Create attributes for output variables + ! + status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') + status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') + status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) + ! status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from USGS 30-sec data') + + status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & + 'standard deviation of 3km cubed-sphere elevation and target grid elevation') + status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') + ! status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & + 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') + status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') + ! status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') + status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') + ! status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') + + + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 50, 'USGS 30-sec dataset binned to ncube3000 (cube-sphere) grid') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + + ! + ! End define mode for output file + ! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Write variable for output + ! + print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) + status = nf_put_var_double (foutid, terrid, terr*9.80616) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" + + print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) + status = nf_put_var_double (foutid, landfracid, landfrac) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing landfrac data" + + print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) + status = nf_put_var_double (foutid, sghid, sgh) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh data" + + print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) + status = nf_put_var_double (foutid, sgh30id, sgh30) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + + print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) + status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + ! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, lat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lon) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" + ! + ! Close output file + ! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +end subroutine wrtncdf_unstructured +! +!************************************************************** +! +! if target grid is lat-lon output structured +! +!************************************************************** +! +subroutine wrtncdf_rll(nlon,nlat,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +# include + + ! + ! Dummy arguments + ! + integer, intent(in) :: n,nlon,nlat + ! + ! lprepare_fv_smoothing_routine is to make a NetCDF file that can be used with the CAM-FV smoothing software + ! + logical , intent(in) :: lpole,lprepare_fv_smoothing_routine + real(r8),dimension(n) , intent(in) :: terr_in, landfrac_in,sgh_in,sgh30_in,lon, lat, landm_coslat_in + ! + ! Local variables + ! + character (len=32) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: terrid,nid + integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid + integer :: status ! return value for error control of netcdf routin + integer :: i,j + integer, dimension(2) :: nc_lat_vid,nc_lon_vid + character (len=8) :: datestring + integer :: nc_gridcorn_id, lat_vid, lon_vid + real(r8), parameter :: fillvalue = 1.d36 + real(r8) :: ave + + real(r8),dimension(nlon) :: lonar ! longitude array + real(r8),dimension(nlat) :: latar ! latitude array + + integer, dimension(2) :: htopodim,landfdim,sghdim,sgh30dim,landmcoslatdim + real(r8),dimension(n) :: terr, landfrac,sgh,sgh30,landm_coslat + + IF (nlon*nlat.NE.n) THEN + WRITE(*,*) "inconsistent input for wrtncdf_rll" + STOP + END IF + ! + ! we assume that the unstructured layout of the lat-lon grid is ordered in latitude rows, that is, + ! unstructured index n is given by + ! + ! n = (j-1)*nlon+i + ! + ! where j is latitude index and i longitude index + ! + do i = 1,nlon + lonar(i)= lon(i) + enddo + do j = 1,nlat + latar(j)= lat((j-1)*nlon+1) + enddo + + terr = terr_in + sgh=sgh_in + sgh30 =sgh30_in + landfrac = landfrac_in + landm_coslat = landm_coslat_in + + if (lpole) then + write(*,*) "average pole control volume" + ! + ! North pole - terr + ! + ave = 0.0 + do i=1,nlon + ave = ave + terr_in(i) + end do + terr(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + terr_in(i) + end do + terr(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - sgh + ! + ave = 0.0 + do i=1,nlon + ave = ave + sgh_in(i) + end do + sgh(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + sgh_in(i) + end do + sgh(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - sgh30 + ! + ave = 0.0 + do i=1,nlon + ave = ave + sgh30_in(i) + end do + sgh30(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + sgh30_in(i) + end do + sgh30(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - landfrac + ! + ave = 0.0 + do i=1,nlon + ave = ave + landfrac_in(i) + end do + landfrac(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + landfrac_in(i) + end do + landfrac(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - landm_coslat + ! + ave = 0.0 + do i=1,nlon + ave = ave + landm_coslat_in(i) + end do + landm_coslat(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + landm_coslat_in(i) + end do + landm_coslat(n-(nlon+1):n) = ave/DBLE(nlon) + end if + + + fout='final.nc' + ! + ! Create NetCDF file for output + ! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create dimensions for output + ! + print *,"Create dimensions for output" + status = nf_def_dim (foutid, 'lon', nlon, lonid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'lat', nlat, latid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create variable for output + ! + print *,"Create variable for output" + + htopodim(1)=lonid + htopodim(2)=latid + + if (lprepare_fv_smoothing_routine) then + status = nf_def_var (foutid,'htopo', NF_DOUBLE, 2, htopodim, terrid) + else + status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 2, htopodim, terrid) + end if + if (status .ne. NF_NOERR) call handle_err(status) + + landfdim(1)=lonid + landfdim(2)=latid + + if (lprepare_fv_smoothing_routine) then + status = nf_def_var (foutid,'ftopo', NF_DOUBLE, 2, landfdim, landfracid) + else + status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 2, landfdim, landfracid) + end if + + if (status .ne. NF_NOERR) call handle_err(status) + + sghdim(1)=lonid + sghdim(2)=latid + + status = nf_def_var (foutid,'SGH', NF_DOUBLE, 2, sghdim, sghid) + if (status .ne. NF_NOERR) call handle_err(status) + + sgh30dim(1)=lonid + sgh30dim(2)=latid + + status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 2, sgh30dim, sgh30id) + if (status .ne. NF_NOERR) call handle_err(status) + + landmcoslatdim(1)=lonid + landmcoslatdim(2)=latid + + status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, landmcoslatdim, landm_coslatid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + + ! + ! Create attributes for output variables + ! + status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') + status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') + status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from ncube3000 data') + status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) + + + status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & + 'standard deviation of 3km cubed-sphere elevation and target grid elevation') + status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') + status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & + 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') + status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') + status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') + status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') + status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') + + + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + + ! + ! End define mode for output file + ! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Write variable for output + ! + print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) + if (lprepare_fv_smoothing_routine) then + status = nf_put_var_double (foutid, terrid, terr) + else + status = nf_put_var_double (foutid, terrid, terr*9.80616) + end if + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" + + print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) + status = nf_put_var_double (foutid, landfracid, landfrac) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing landfrac data" + + print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) + status = nf_put_var_double (foutid, sghid, sgh) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh data" + + print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) + status = nf_put_var_double (foutid, sgh30id, sgh30) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + + print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) + status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + ! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, latar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lonar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" + ! + ! Close output file + ! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +end subroutine wrtncdf_rll +!************************************************************************ +!!handle_err +!************************************************************************ +! +!!ROUTINE: handle_err +!!DESCRIPTION: error handler +!-------------------------------------------------------------------------- + +subroutine handle_err(status) + + implicit none + +# include + + integer status + + if (status .ne. nf_noerr) then + print *, nf_strerror(status) + stop 'Stopped' + endif + +end subroutine handle_err + + +SUBROUTINE coarsen(f,fcoarse,nf,n,dA_coarse) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (R8), DIMENSION(n) , INTENT(IN) :: f + REAL (R8), DIMENSION(n/nf), INTENT(OUT) :: fcoarse + INTEGER, INTENT(in) :: n,nf + REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf),INTENT(OUT) :: dA_coarse + !must be an even number + ! + ! local workspace + ! + ! ncube = INT(SQRT(DBLE(n/6))) + + REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6))),INT(SQRT(DBLE(n/6)))):: dA + REAL (R8) :: sum, sum_area,tmp + INTEGER :: jx,jy,jp,ii,ii_coarse,coarse_ncube,ncube + INTEGER :: jx_coarse,jy_coarse,jx_s,jy_s + + + ! REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf) :: dAtmp + + ncube = INT(SQRT(DBLE(n/6))) + coarse_ncube = ncube/nf + + IF (ABS(DBLE(ncube)/DBLE(nf)-coarse_ncube)>0.000001) THEN + WRITE(*,*) "ncube/nf must be an integer" + WRITE(*,*) "ncube and nf: ",ncube,nf + STOP + END IF + + da_coarse = 0.0 + + WRITE(*,*) "compute all areas" + CALL EquiangularAllAreas(ncube, dA) + ! CALL EquiangularAllAreas(coarse_ncube, dAtmp)!dbg + tmp = 0.0 + DO jp=1,6 + DO jy_coarse=1,coarse_ncube + DO jx_coarse=1,coarse_ncube + ! + ! inner loop + ! + sum = 0.0 + sum_area = 0.0 + DO jy_s=1,nf + jy = (jy_coarse-1)*nf+jy_s + DO jx_s=1,nf + jx = (jx_coarse-1)*nf+jx_s + ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx + sum = sum +f(ii)*dA(jx,jy) + sum_area = sum_area+dA(jx,jy) + ! WRITE(*,*) "jx,jy",jx,jy + END DO + END DO + tmp = tmp+sum_area + da_coarse(jx_coarse,jy_coarse) = sum_area + ! WRITE(*,*) "jx_coarse,jy_coarse",jx_coarse,jy_coarse,& + ! da_coarse(jx_coarse,jy_coarse)-datmp(jx_coarse,jy_coarse) + ii_coarse = (jp-1)*coarse_ncube*coarse_ncube+(jy_coarse-1)*coarse_ncube+jx_coarse + fcoarse(ii_coarse) = sum/sum_area + END DO + END DO + END DO + WRITE(*,*) "coarsened surface area",tmp-4.0*3.141592654 +END SUBROUTINE COARSEN + +SUBROUTINE overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& + jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) + use shr_kind_mod, only: r8 => shr_kind_r8 + use remap + IMPLICIT NONE + + + INTEGER, INTENT(INOUT) :: jall !anticipated number of weights + INTEGER, INTENT(IN) :: ncube, ngauss, ntarget, jmax_segments, ncorner, nreconstruction + + INTEGER, DIMENSION(jall,3), INTENT(OUT) :: weights_eul_index_all + REAL(R8), DIMENSION(jall,nreconstruction) , INTENT(OUT) :: weights_all + INTEGER, DIMENSION(jall) , INTENT(OUT) :: weights_lgr_index_all + + REAL(R8), DIMENSION(ncorner,ntarget), INTENT(IN) :: target_corner_lon, target_corner_lat + + INTEGER, DIMENSION(ncorner+1) :: ipanel_array, ipanel_tmp + REAL(R8), DIMENSION(ncorner) :: lat, lon + REAL(R8), DIMENSION(0:ncube+2):: xgno, ygno + REAL(R8), DIMENSION(0:ncorner+1) :: xcell, ycell + + REAL(R8), DIMENSION(ngauss) :: gauss_weights, abscissae + + REAL(R8) :: da, tmp, alpha, beta + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: pih = 0.50*pi + INTEGER :: i, j,ncorner_this_cell,k,ip,ipanel,ii,jx,jy,jcollect + integer :: alloc_error + + REAL (r8), PARAMETER :: rad2deg = 180.0/pi + + real(r8), allocatable, dimension(:,:) :: weights + integer , allocatable, dimension(:,:) :: weights_eul_index + + + LOGICAL:: ldbg = .FAlSE. + + INTEGER :: jall_anticipated + + jall_anticipated = jall + + ipanel_array = -99 + ! + da = pih/DBLE(ncube) + xgno(0) = -bignum + DO i=1,ncube+1 + xgno(i) = TAN(-piq+(i-1)*da) + END DO + xgno(ncube+2) = bignum + ygno = xgno + + CALL glwp(ngauss,gauss_weights,abscissae) + + + allocate (weights(jmax_segments,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index(jmax_segments,2),stat=alloc_error ) + + tmp = 0.0 + jall = 1 + DO i=1,ntarget + WRITE(*,*) "cell",i," ",100.0*DBLE(i)/DBLE(ntarget),"% done" + ! + !--------------------------------------------------- + ! + ! determine how many vertices the cell has + ! + !--------------------------------------------------- + ! + CALL remove_duplicates_latlon(ncorner,target_corner_lon(:,i),target_corner_lat(:,i),& + ncorner_this_cell,lon,lat,1.0E-10,ldbg) + + IF (ldbg) THEN + WRITE(*,*) "number of vertices ",ncorner_this_cell + WRITE(*,*) "vertices locations lon,",lon(1:ncorner_this_cell)*rad2deg + WRITE(*,*) "vertices locations lat,",lat(1:ncorner_this_cell)*rad2deg + DO j=1,ncorner_this_cell + WRITE(*,*) lon(j)*rad2deg, lat(j)*rad2deg + END DO + WRITE(*,*) " " + END IF + ! + !--------------------------------------------------- + ! + ! determine how many and which panels the cell spans + ! + !--------------------------------------------------- + ! + DO j=1,ncorner_this_cell + CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ipanel_tmp(j), .TRUE.) + IF (ldbg) WRITE(*,*) "ipanel for corner ",j," is ",ipanel_tmp(j) + END DO + ipanel_tmp(ncorner_this_cell+1) = ipanel_tmp(1) + ! make sure to include possible overlap areas not on the face the vertices are located + IF (MINVAL(lat(1:ncorner_this_cell))<-pi/6.0) THEN + ! include South-pole panel in search + ipanel_tmp(ncorner_this_cell+1) = 5 + IF (ldbg) WRITE(*,*) "add panel 5 to search" + END IF + IF (MAXVAL(lat(1:ncorner_this_cell))>pi/6.0) THEN + ! include North-pole panel in search + ipanel_tmp(ncorner_this_cell+1) = 6 + IF (ldbg) WRITE(*,*) "add panel 6 to search" + END IF + ! + ! remove duplicates in ipanel_tmp + ! + CALL remove_duplicates_integer(ncorner_this_cell+1,ipanel_tmp(1:ncorner_this_cell+1),& + k,ipanel_array(1:ncorner_this_cell+1)) + ! + !--------------------------------------------------- + ! + ! loop over panels with possible overlap areas + ! + !--------------------------------------------------- + ! + DO ip = 1,k + ipanel = ipanel_array(ip) + DO j=1,ncorner_this_cell + ii = ipanel + CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ii,.FALSE.) + IF (j==1) THEN + jx = CEILING((alpha + piq) / da) + jy = CEILING((beta + piq) / da) + END IF + xcell(ncorner_this_cell+1-j) = TAN(alpha) + ycell(ncorner_this_cell+1-j) = TAN(beta) + END DO + xcell(0) = xcell(ncorner_this_cell) + ycell(0) = ycell(ncorner_this_cell) + xcell(ncorner_this_cell+1) = xcell(1) + ycell(ncorner_this_cell+1) = ycell(1) + + jx = MAX(MIN(jx,ncube+1),0) + jy = MAX(MIN(jy,ncube+1),0) + + CALL compute_weights_cell(xcell(0:ncorner_this_cell+1),ycell(0:ncorner_this_cell+1),& + jx,jy,nreconstruction,xgno,ygno,& + 1, ncube+1, 1,ncube+1, tmp,& + ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& + ncube,0,ncorner_this_cell,ldbg) + + weights_all(jall:jall+jcollect-1,1:nreconstruction) = weights(1:jcollect,1:nreconstruction) + + weights_eul_index_all(jall:jall+jcollect-1,1:2) = weights_eul_index(1:jcollect,:) + weights_eul_index_all(jall:jall+jcollect-1, 3) = ipanel + weights_lgr_index_all(jall:jall+jcollect-1 ) = i + + jall = jall+jcollect + IF (jall>jall_anticipated) THEN + WRITE(*,*) "more weights than anticipated" + WRITE(*,*) "increase jall" + STOP + END IF + IF (ldbg) WRITE(*,*) "jcollect",jcollect + END DO + END DO + jall = jall-1 + WRITE(*,*) "sum of all weights divided by surface area of sphere =",tmp/(4.0*pi) + WRITE(*,*) "actual number of weights",jall + WRITE(*,*) "anticipated number of weights",jall_anticipated + IF (jall>jall_anticipated) THEN + WRITE(*,*) "anticipated number of weights < actual number of weights" + WRITE(*,*) "increase jall!" + STOP + END IF + WRITE(*,*) MINVAL(weights_all(1:jall,1)),MAXVAL(weights_all(1:jall,1)) + IF (ABS(tmp/(4.0*pi))-1.0>0.001) THEN + WRITE(*,*) "sum of all weights does not match the surface area of the sphere" + WRITE(*,*) "sum of all weights is : ",tmp + WRITE(*,*) "surface area of sphere: ",4.0*pi + STOP + END IF +END SUBROUTINE overlap_weights + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromRLL +! +! Description: +! Determine the (alpha,beta,panel) coordinate of a point on the sphere from +! a given regular lat lon coordinate. +! +! Parameters: +! lon - Coordinate longitude +! lat - Coordinate latitude +! alpha (OUT) - Alpha coordinate +! beta (OUT) - Beta coordinate +! ipanel (OUT) - Face panel +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (R8), INTENT(IN) :: lon, lat + REAL (R8), INTENT(OUT) :: alpha, beta + INTEGER :: ipanel + LOGICAL, INTENT(IN) :: ldetermine_panel + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rotate_cube = 0.0 + + ! Local variables + REAL (R8) :: xx, yy, zz, pm + REAL (R8) :: sx, sy, sz + INTEGER :: ix, iy, iz + + ! Translate to (x,y,z) space + xx = COS(lon-rotate_cube) * COS(lat) + yy = SIN(lon-rotate_cube) * COS(lat) + zz = SIN(lat) + + pm = MAX(ABS(xx), ABS(yy), ABS(zz)) + + ! Check maximality of the x coordinate + IF (pm == ABS(xx)) THEN + IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF + ELSE + ix = 0 + ENDIF + + ! Check maximality of the y coordinate + IF (pm == ABS(yy)) THEN + IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF + ELSE + iy = 0 + ENDIF + + ! Check maximality of the z coordinate + IF (pm == ABS(zz)) THEN + IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF + ELSE + iz = 0 + ENDIF + + ! Panel assignments + IF (ldetermine_panel) THEN + IF (iz == 1) THEN + ipanel = 6; sx = yy; sy = -xx; sz = zz + + ELSEIF (iz == -1) THEN + ipanel = 5; sx = yy; sy = xx; sz = -zz + + ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN + ipanel = 1; sx = yy; sy = zz; sz = xx + + ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN + ipanel = 3; sx = -yy; sy = zz; sz = -xx + + ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN + ipanel = 2; sx = -xx; sy = zz; sz = yy + + ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN + ipanel = 4; sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' + WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' + WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' + STOP + ENDIF + ELSE + IF (ipanel == 6) THEN + sx = yy; sy = -xx; sz = zz + ELSEIF (ipanel == 5) THEN + sx = yy; sy = xx; sz = -zz + ELSEIF (ipanel == 1) THEN + sx = yy; sy = zz; sz = xx + ELSEIF (ipanel == 3) THEN + sx = -yy; sy = zz; sz = -xx + ELSEIF (ipanel == 2) THEN + sx = -xx; sy = zz; sz = yy + ELSEIF (ipanel == 4) THEN + sx = xx; sy = zz; sz = -yy + ELSE + WRITE(*,*) "ipanel out of range",ipanel + STOP + END IF + END IF + + ! Use panel information to calculate (alpha, beta) coords + alpha = ATAN(sx / sz) + beta = ATAN(sy / sz) + +END SUBROUTINE CubedSphereABPFromRLL + +!------------------------------------------------------------------------------ +! SUBROUTINE EquiangularAllAreas +! +! Description: +! Compute the area of all cubed sphere grid cells, storing the results in +! a two dimensional array. +! +! Parameters: +! icube - Resolution of the cubed sphere +! dA (OUT) - Output array containing the area of all cubed sphere grid cells +!------------------------------------------------------------------------------ +SUBROUTINE EquiangularAllAreas(icube, dA) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + INTEGER, INTENT(IN) :: icube + REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA + + ! Local variables + INTEGER :: k, k1, k2 + REAL (r8) :: a1, a2, a3, a4 + REAL (r8), DIMENSION(icube+1,icube+1) :: ang + REAL (r8), DIMENSION(icube+1) :: gp + + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + + !#ifdef DBG + REAL (r8) :: dbg1 !DBG + !#endif + + ! Recall that we are using equi-angular spherical gridding + ! Compute the angle between equiangular cubed sphere projection grid lines. + DO k = 1, icube+1 + gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) + ENDDO + + DO k2=1,icube+1 + DO k1=1,icube+1 + ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) + ENDDO + ENDDO + + DO k2=1,icube + DO k1=1,icube + a1 = ang(k1 , k2 ) + a2 = pi - ang(k1+1, k2 ) + a3 = pi - ang(k1 , k2+1) + a4 = ang(k1+1, k2+1) + ! area = r*r*(-2*pi+sum(interior angles)) + DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 + ENDDO + ENDDO + + !#ifdef DBG + ! Only for debugging - test consistency + dbg1 = 0.0 !DBG + DO k2=1,icube + DO k1=1,icube + dbg1 = dbg1 + DA(k1,k2) !DBG + ENDDO + ENDDO + write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG + !#endif +END SUBROUTINE EquiangularAllAreas + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereRLLFromABP +! +! Description: +! Determine the lat lon coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! lon (OUT) - Calculated longitude +! lat (OUT) - Calculated latitude +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: lon, lat + ! Local variables + REAL (r8) :: xx, yy, zz, rotate_cube + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + rotate_cube = 0.0 + ! Convert to cartesian coordinates + CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + ! Convert back to lat lon + lat = ASIN(zz) + if (xx==0.0.and.yy==0.0) THEN + lon = 0.0 + else + lon = ATAN2(yy, xx) +rotate_cube + IF (lon<0.0) lon=lon+2.0*pi + IF (lon>2.0*pi) lon=lon-2.0*pi + end if +END SUBROUTINE CubedSphereRLLFromABP + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereXYZFromABP +! +! Description: +! Determine the Cartesian coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! xx (OUT) - Calculated x coordinate +! yy (OUT) - Calculated y coordinate +! zz (OUT) - Calculated z coordinate +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: xx, yy, zz + ! Local variables + REAL (r8) :: a1, b1, pm + REAL (r8) :: sx, sy, sz + + ! Convert to Cartesian coordinates + a1 = TAN(alpha) + b1 = TAN(beta) + + sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + ! Panel assignments + IF (ipanel == 6) THEN + yy = sx; xx = -sy; zz = sz + ELSEIF (ipanel == 5) THEN + yy = sx; xx = sy; zz = -sz + ELSEIF (ipanel == 1) THEN + yy = sx; zz = sy; xx = sz + ELSEIF (ipanel == 3) THEN + yy = -sx; zz = sy; xx = -sz + ELSEIF (ipanel == 2) THEN + xx = -sx; zz = sy; yy = sz + ELSEIF (ipanel == 4) THEN + xx = sx; zz = sy; yy = -sz + ELSE + WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' + WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' + STOP + ENDIF +END SUBROUTINE CubedSphereXYZFromABP + + +SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + integer,dimension(n_in), intent(in) :: f_in + integer, intent(out) :: n_out + integer,dimension(n_in), intent(out) :: f_out + ! + ! local work space + ! + integer :: k,i,j + ! + ! remove duplicates in ipanel_tmp + ! + k = 1 + f_out(1) = f_in(1) + outer: do i=2,n_in + do j=1,k + ! if (f_out(j) == f_in(i)) then + if (ABS(f_out(j)-f_in(i))<1.0E-10) then + ! Found a match so start looking again + cycle outer + end if + end do + ! No match found so add it to the output + k = k + 1 + f_out(k) = f_in(i) + end do outer + n_out = k +END SUBROUTINE remove_duplicates_integer + +SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in + real, intent(in) :: tiny + integer, intent(out) :: n_out + real(r8),dimension(n_in), intent(out) :: lon_out,lat_out + logical :: ldbg + ! + ! local work space + ! + integer :: k,i,j + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: pih = 0.50*pi + ! + ! for pole points: make sure the longitudes are identical so that algorithm below works properly + ! + do i=2,n_in + if (abs(lat_in(i)-pih) 0) .AND. (j < ncube_reconstruct)) THEN + beta = gp(j) + beta_next = gp(j+1) + ELSEIF (j == -1) THEN + beta = -piq - (gp(3) + piq) + beta_next = -piq - (gp(2) + piq) + ELSEIF (j == 0) THEN + beta = -piq - (gp(2) + piq) + beta_next = -piq + ELSEIF (j == ncube_reconstruct) THEN + beta = piq + beta_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (j == ncube_reconstruct+1) THEN + beta = piq + (piq - gp(ncube_reconstruct-1)) + beta_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + + DO i = -1, ncube_reconstruct+1 + IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN + alpha = gp(i) + alpha_next = gp(i+1) + ELSEIF (i == -1) THEN + alpha = -piq - (gp(3) + piq) + alpha_next = -piq - (gp(2) + piq) + ELSEIF (i == 0) THEN + alpha = -piq - (gp(2) + piq) + alpha_next = -piq + ELSEIF (i == ncube_reconstruct) THEN + alpha = piq + alpha_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (i == ncube_reconstruct+1) THEN + alpha = piq + (piq - gp(ncube_reconstruct-1)) + alpha_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + abp_centroid(1,i,j) = & + I_10_ab(alpha_next,beta_next)-I_10_ab(alpha ,beta_next)+& + I_10_ab(alpha ,beta )-I_10_ab(alpha_next,beta ) +! - ASINH(COS(alpha_next) * TAN(beta_next)) & +! + ASINH(COS(alpha_next) * TAN(beta)) & +! + ASINH(COS(alpha) * TAN(beta_next)) & +! - ASINH(COS(alpha) * TAN(beta)) + + abp_centroid(2,i,j) = & + I_01_ab(alpha_next,beta_next)-I_01_ab(alpha ,beta_next)+& + I_01_ab(alpha ,beta )-I_01_ab(alpha_next,beta ) +! - ASINH(TAN(alpha_next) * COS(beta_next)) & +! + ASINH(TAN(alpha_next) * COS(beta)) & +! + ASINH(TAN(alpha) * COS(beta_next)) & +! - ASINH(TAN(alpha) * COS(beta)) + + !ADD PHL START + IF (order>2) THEN + ! TAN(alpha)^2 component + abp_centroid(3,i,j) =& + I_20_ab(alpha_next,beta_next)-I_20_ab(alpha ,beta_next)+& + I_20_ab(alpha ,beta )-I_20_ab(alpha_next,beta ) + + ! TAN(beta)^2 component + abp_centroid(4,i,j) = & + I_02_ab(alpha_next,beta_next)-I_02_ab(alpha ,beta_next)+& + I_02_ab(alpha ,beta )-I_02_ab(alpha_next,beta ) + + ! TAN(alpha) TAN(beta) component + abp_centroid(5,i,j) = & + I_11_ab(alpha_next,beta_next)-I_11_ab(alpha ,beta_next)+& + I_11_ab(alpha ,beta )-I_11_ab(alpha_next,beta ) + ENDIF + !ADD PHL END + ENDDO + ENDDO + +! +! PHL outcommented below +! + ! High order calculations +! IF (order > 2) THEN +! DO k = 1, nlon +! DO i = 1, int_nx(nlat,k)-1 +! IF ((int_itype(i,k) > 4) .AND. (int_np(1,i,k) == 1)) THEN +! abp_centroid(3, int_a(i,k), int_b(i,k)) = & +! abp_centroid(3, int_a(i,k), int_b(i,k)) + int_wt_2a(i,k) +! abp_centroid(4, int_a(i,k), int_b(i,k)) = & +! abp_centroid(4, int_a(i,k), int_b(i,k)) + int_wt_2b(i,k) +! abp_centroid(5, int_a(i,k), int_b(i,k)) = & +! abp_centroid(5, int_a(i,k), int_b(i,k)) + int_wt_2c(i,k) +! ENDIF +! ENDDO +! ENDDO +! ENDIF + + ! Normalize with element areas + DO j = -1, ncube_reconstruct+1 + IF ((j > 0) .AND. (j < ncube_reconstruct)) THEN + beta = gp(j) + beta_next = gp(j+1) + ELSEIF (j == -1) THEN + beta = -piq - (gp(3) + piq) + beta_next = -piq - (gp(2) + piq) + ELSEIF (j == 0) THEN + beta = -piq - (gp(2) + piq) + beta_next = -piq + ELSEIF (j == ncube_reconstruct) THEN + beta = piq + beta_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (j == ncube_reconstruct+1) THEN + beta = piq + (piq - gp(ncube_reconstruct-1)) + beta_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + DO i = -1, ncube_reconstruct+1 + IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN + alpha = gp(i) + alpha_next = gp(i+1) + ELSEIF (i == -1) THEN + alpha = -piq - (gp(3) + piq) + alpha_next = -piq - (gp(2) + piq) + ELSEIF (i == 0) THEN + alpha = -piq - (gp(2) + piq) + alpha_next = -piq + ELSEIF (i == ncube_reconstruct) THEN + alpha = piq + alpha_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (i == ncube_reconstruct+1) THEN + alpha = piq + (piq - gp(ncube_reconstruct-1)) + alpha_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + area = DAcube(i,j) + ELSE + area = EquiangularElementArea(alpha, alpha_next - alpha, & + beta, beta_next - beta) + ENDIF + + abp_centroid(1,i,j) = abp_centroid(1,i,j) / area + abp_centroid(2,i,j) = abp_centroid(2,i,j) / area + + IF (order > 2) THEN + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + abp_centroid(3,i,j) = abp_centroid(3,i,j) / area + abp_centroid(4,i,j) = abp_centroid(4,i,j) / area + abp_centroid(5,i,j) = abp_centroid(5,i,j) / area + ENDIF + ENDIF + ENDDO + ENDDO + + WRITE(*,*) '...Done computing ABP element centroids' + + END SUBROUTINE ComputeABPElementCentroids + +!------------------------------------------------------------------------------ +! FUNCTION EvaluateABPReconstruction +! +! Description: +! Evaluate the sub-grid scale reconstruction at the given point. +! +! Parameters: +! fcubehalo - Array of element values +! recons - Array of reconstruction coefficients +! a - Index of element in alpha direction (1 <= a <= ncube_reconstruct-1) +! b - Index of element in beta direction (1 <= b <= ncube_reconstruct-1) +! p - Panel index of element +! alpha - Alpha coordinate of evaluation point +! beta - Beta coordinate of evaluation point +! order - Order of the reconstruction +! value (OUT) - Result of function evaluation at given point +!------------------------------------------------------------------------------ + SUBROUTINE EvaluateABPReconstruction( & + fcubehalo, recons, a, b, p, alpha, beta, order, value) + IMPLICIT NONE + + ! Dummy variables + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(IN) :: recons + INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p + REAL (KIND=dbl_kind), INTENT(IN) :: alpha, beta + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), INTENT(OUT) :: value + + ! Evaluate constant order terms + value = fcubehalo(a,b,p) + + ! Evaluate linear order terms + IF (order > 1) THEN + value = value + recons(1,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) + value = value + recons(2,a,b,p) * (TAN(beta) - abp_centroid(2,a,b)) + ENDIF + + ! Evaluate second order terms + IF (order > 2) THEN + value = value + recons(3,a,b,p) * & + (abp_centroid(1,a,b)**2 - abp_centroid(3,a,b)) + value = value + recons(4,a,b,p) * & + (abp_centroid(2,a,b)**2 - abp_centroid(4,a,b)) + value = value + recons(5,a,b,p) * & + (abp_centroid(1,a,b) * abp_centroid(2,a,b) - & + abp_centroid(5,a,b)) + + value = value + recons(3,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b))**2 + value = value + recons(4,a,b,p) * (TAN(beta) - abp_centroid(2,a,b))**2 + value = value + recons(5,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) & + * (TAN(beta) - abp_centroid(2,a,b)) + ENDIF + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ABPHaloMinMax +! +! Description: +! Calculate the minimum and maximum values of the cell-averaged function +! around the given element. +! +! Parameters: +! fcubehalo - Cell-averages for the cubed sphere +! a - Local element alpha index +! b - Local element beta index +! p - Local element panel index +! min_val (OUT) - Minimum value in the halo +! max_val (OUT) - Maximum value in the halo +! nomiddle - whether to not include the middle cell (index a,b) in the search. +! +! NOTE: Since this routine is not vectorized, it will likely be called MANY times. +! To speed things up, make sure to pass the first argument as the ENTIRE original +! array, not as a subset of it, since repeatedly cutting up that array and creating +! an array temporary (on some compilers) is VERY slow. +! ex: +! CALL APBHaloMinMax(zarg, a, ...) !YES +! CALL ABPHaloMinMax(zarg(-1:ncube_reconstruct+1,-1:ncube_reconstruct+1,:)) !NO -- slow +!------------------------------------------------------------------------------ + SUBROUTINE ABPHaloMinMax(fcubehalo, a, b, p, min_val, max_val, nomiddle) + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p + REAL (KIND=dbl_kind), INTENT(OUT) :: min_val, max_val + LOGICAL, INTENT(IN) :: nomiddle + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, il, jl, inew, jnew + REAL (KIND=dbl_kind) :: value + + min_val = fcubehalo(a,b,p) + max_val = fcubehalo(a,b,p) + value = fcubehalo(a,b,p) + + DO il = a-1,a+1 + DO jl = b-1,b+1 + + i = il + j = jl + + inew = i + jnew = j + + IF (nomiddle .AND. i==a .AND. j==b) CYCLE + + !Interior + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + value = fcubehalo(i,j,p) + + ELSE + + + !The next 4.0 regions are cases in which a,b themselves lie in the panel's halo, and the cell's "halo" (in this usage the 8.0 cells surrounding it) might wrap around into another part of the halo. This happens for (a,b) = {(1,:0),(ncube_reconstruct-1,:0),(1,ncube_reconstruct:),(ncube_reconstruct-1,ncube_reconstruct:)} and for the transposes thereof ({(:0,1), etc.}). In these cases (i,j) could lie in the "Corners" where nothing should lie. We correct this by moving i,j to its appropriate position on the "facing" halo, and then the remainder of the routine then moves it onto the correct face. + +101 FORMAT("ERROR cannot find (i,j) = (", I4, ", ", I4, ") for (a,b,p) = ", I4, ",", I4, ",", I4, ")") +102 FORMAT("i,j,p = ", 3I4, " moved to " 2I4, " (CASE ", I1, ")") + !NOTE: we need the general case to be able to properly handle (0,0), (ncube_reconstruct,0), etc. Note that we don't need to bother with (0,0), etc. when a, b lie in the interior, since both sides of the (0,0) cell are already accounted for by this routine. + !LOWER LEFT + IF (i < 1 .AND. j < 1) THEN + IF (a < 1) THEN !(a,b) centered on left halo, cross to lower halo + inew = 1-j + jnew = i + ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to left halo + jnew = 1-i + inew = j + END IF +! WRITE(*,102) i, j, p, inew, jnew, 1 + !LOWER RIGHT + ELSE IF (i > ncube_reconstruct-1 .AND. j < 1) THEN + IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to lower halo + inew = ncube_reconstruct-1+j + jnew = ncube_reconstruct-i + ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to right halo + jnew = 1+(i-ncube_reconstruct) + inew = ncube_reconstruct-j + END IF +! WRITE(*,102) i, j, p, inew, jnew, 2 + !UPPER LEFT + ELSE IF (i < 1 .AND. j > ncube_reconstruct-1) THEN + IF (a < 1) THEN! (a,b) centered on left halo, cross to upper halo + inew = 1-(j-ncube_reconstruct) + jnew = ncube_reconstruct-i + ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to left halo + inew = ncube_reconstruct-j + jnew = ncube_reconstruct-1-i + END IF +! WRITE(*,102) i, j, p, inew, jnew, 3 + !UPPER RIGHT + ELSE IF (i > ncube_reconstruct-1 .AND. j > ncube_reconstruct-1) THEN + IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to upper halo + inew = ncube_reconstruct-1-(ncube_reconstruct-j) + jnew = i + ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to right halo + inew = j + jnew = ncube_reconstruct-1-(ncube_reconstruct-i) + END IF +! WRITE(*,102) i, j, p, inew, jnew, 4 + END IF + + i = inew + j = jnew + + + !Lower halo ("halo" meaning the panel's halo, not the nine-cell halo + IF ((i < 1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,4) + ELSEIF (p == 2) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,1) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,2) + ELSEIF (p == 4) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,3) + ELSEIF (p == 5) THEN + value = fcubehalo(j,1-i,4) + ELSEIF (p == 6) THEN + value = fcubehalo(ncube_reconstruct-j,ncube_reconstruct-1+i,4) + ENDIF + + !Upper halo + ELSEIF ((i > ncube_reconstruct-1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,2) + ELSEIF (p == 2) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,3) + ELSEIF (p == 3) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,4) + ELSEIF (p == 4) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,1) + ELSEIF (p == 5) THEN + value = fcubehalo(ncube_reconstruct-j,i-ncube_reconstruct+1,2) + ELSEIF (p == 6) THEN + value = fcubehalo(j,2*ncube_reconstruct-i-1,2) + ENDIF + + !Left halo + ELSEIF ((j < 1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i,ncube_reconstruct-1+j,5) + ELSEIF (p == 2) THEN + value = fcubehalo(ncube_reconstruct-1+j,ncube_reconstruct-i,5) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-i,1-j,5) + ELSEIF (p == 4) THEN + value = fcubehalo(1-j,i,5) + ELSEIF (p == 5) THEN + value = fcubehalo(ncube_reconstruct-i,1-j,3) + ELSEIF (p == 6) THEN + value = fcubehalo(i,ncube_reconstruct-1+j,1) + ENDIF + + !Right halo + ELSEIF ((j > ncube_reconstruct-1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i,j-ncube_reconstruct+1,6) + ELSEIF (p == 2) THEN + value = fcubehalo(2*ncube_reconstruct-j-1,i,6) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,6) + ELSEIF (p == 4) THEN + value = fcubehalo(j-ncube_reconstruct+1,ncube_reconstruct-i,6) + ELSEIF (p == 5) THEN + value = fcubehalo(i,j-ncube_reconstruct+1,1) + ELSEIF (p == 6) THEN + value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,3) + ENDIF + + ENDIF + + END IF + min_val = MIN(min_val, value) + max_val = MAX(max_val, value) + ENDDO + ENDDO + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE MonotonizeABPGradient +! +! Description: +! Apply a monotonic filter to the calculated ABP gradient. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! selective - whether to apply a simple form of selective limiting, + !which assumes that if a point is larger/smaller than ALL of its + !surrounding points, that the extremum is physical, and that + !filtering should not be applied to it. +! +! Remarks: +! This monotonizing scheme is based on the monotone scheme for unstructured +! grids of Barth and Jespersen (1989). +!------------------------------------------------------------------------------ + SUBROUTINE MonotonizeABPGradient(fcubehalo, order, recons, selective) + +! USE selective_limiting + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + LOGICAL, INTENT(IN) :: selective + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n, skip + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi + REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & + gamma + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + +! +! xxxxx +! +! IF (selective) THEN +! CALL smoothness2D(fcubehalo, gamma, 2) +! WRITE(*,*) 'gamma range: max ', MAXVAL(gamma), " min ", MINVAL(gamma) +! DO i=1,ncube_reconstruct-1 +! WRITE(*,*) gamma(i, i, 3) +! ENDDO +! skip = 0 +! END IF + + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + + + IF (selective) THEN + + CALL ABPHaloMinMax(gamma, i, j, k, gamma_min, gamma_max, .FALSE.) + + IF (gamma_max/(gamma_min + tiny) < lammax) THEN + skip = skip + 1 + CYCLE + END IF + + END IF + + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + ENDIF + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + IF (order > 2) THEN + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + ENDDO + ENDDO + ENDDO + + IF (selective) WRITE(*,*) 'skipped ', skip, ' points out of ', 6*(ncube_reconstruct-1)**2 + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE PosDefABPGradient +! +! Description: +! Scale the reconstructions so they are positive definite +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! This monotonizing scheme is based on the monotone scheme for unstructured +! grids of Barth and Jespersen (1989), but simpler. This simply finds the +! minimum and then scales the reconstruction so that it is 0. +!------------------------------------------------------------------------------ + SUBROUTINE PosDefABPGradient(fcubehalo, order, recons) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi + REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & + gamma + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + + !If the average value in the cell is 0.0, then we should skip + !all of the scaling and just set the reconstruction to 0.0 +! IF (ABS(fcubehalo(i,j,k)) < tiny) THEN +! recons(:,i,j,k) = 0.0 +! CYCLE +! END IF + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + + !This allowance for miniscule negative values appearing around the cell being + !filtered/limited. Before this, negative values would be caught in adjust_limiter + !and would stop the model. Doing this only causes minor negative values; no blowing + !up is observed. The rationale is the same as for the monotone filter, which does + !allow miniscule negative values due to roundoff error --- of the order E-10 --- + !in flux-form methods (and E-17 in the s-L method, indicating that roundoff error + !is more severe in the flux-form method, as we expect since we are often subtracting + !2.0 values which are very close together. + local_min = MIN(0.0,local_min) + local_max = bignum !prevents scaling upward; for positive + !definite limiting we don't care about the upper bound + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + ENDIF + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + IF (order > 2) THEN + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + + ENDDO + ENDDO + ENDDO + + + END SUBROUTINE PosDefABPGradient + +!------------------------------------------------------------------------------ +! SUBROUTINE MonotonizeABPGradient_New +! +! Description: +! Apply a monotonic filter to the calculated ABP gradient. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! This monotonizing scheme is similar to the one in MonotonizeABPGradient, +! except the second order derivatives are limited after the first order +! derivatives. +!------------------------------------------------------------------------------ + SUBROUTINE MonotonizeABPGradient_New(fcubehalo, order, recons) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, linval + REAL (KIND=dbl_kind) :: disc, mx, my + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max, .FALSE.) + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point, only taking into + ! account the linear component of the reconstruction. + value = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! Apply monotone limiter to all reconstruction coefficients + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + ! Reset the limiter + min_phi = one + + ! Calculate discriminant, which we use to determine the absolute + ! minima/maxima of the paraboloid + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDDO + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + WRITE (*,*) '2: ', min_phi + + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_NEL +! +! Description: +! Construct a non-equidistant linear reconstruction of the gradient +! within each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_NEL(fcubehalo, recons, order) + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: alpha1, alpha2, beta1, beta2 + REAL (KIND=dbl_kind) :: dx_left, dx_right, top_value, bot_value + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + + recons(1,i,j,p) = & + (+ fcubehalo(i-1,j,p) * dx_right**2 & + - fcubehalo(i+1,j,p) * dx_left**2 & + - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(2,i,j,p) = & + (+ fcubehalo(i,j-1,p) * dx_right**2 & + - fcubehalo(i,j+1,p) * dx_left**2 & + - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + IF (order > 2) THEN + dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + + recons(3,i,j,p) = & + (+ fcubehalo(i-1,j,p) * dx_right & + - fcubehalo(i+1,j,p) * dx_left & + - fcubehalo(i,j,p) * (dx_right - dx_left)) / & + (dx_right * dx_left * (dx_left - dx_right)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(4,i,j,p) = & + (+ fcubehalo(i,j-1,p) * dx_right & + - fcubehalo(i,j+1,p) * dx_left & + - fcubehalo(i,j,p) * (dx_right - dx_left)) / & + (dx_right * dx_left * (dx_left - dx_right)) + ENDIF + ENDDO + ENDDO + + IF (order > 2) THEN + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + dx_left = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) + dx_right = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) + + top_value = & + (+ fcubehalo(i-1,j+1,p) * dx_right**2 & + - fcubehalo(i+1,j+1,p) * dx_left**2 & + - fcubehalo(i,j+1,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) + dx_right = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) + + bot_value = & + (+ fcubehalo(i-1,j-1,p) * dx_right**2 & + - fcubehalo(i+1,j-1,p) * dx_left**2 & + - fcubehalo(i,j-1,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(5,i,j,p) = & + (+ bot_value * dx_right**2 & + - top_value * dx_left**2 & + - recons(1,i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + ENDDO + ENDDO + ENDIF + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_NEP +! +! Description: +! Construct a non-equidistant parabolic reconstruction of the gradient +! within each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_NEP(fcubehalo, recons, order) + + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: x1, x2, x4, x5, y1, y2, y3, y4, y5 + + REAL (KIND=dbl_kind), DIMENSION(5) :: t, pa, denom + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! X-direction reconstruction + x1 = abp_centroid(1,i-2,j) - abp_centroid(1,i,j) + x2 = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + x4 = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + x5 = abp_centroid(1,i+2,j) - abp_centroid(1,i,j) + + !IF (i == 1) THEN + ! x1 = piq + !ELSEIF (i == ncube_reconstruct-1) THEN + ! x5 = -piq + !ENDIF + + y1 = fcubehalo(i-2,j,p) + y2 = fcubehalo(i-1,j,p) + y3 = fcubehalo(i,j,p) + y4 = fcubehalo(i+1,j,p) + y5 = fcubehalo(i+2,j,p) + + denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 + denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 + denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 + denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 + + t(1) = x5 * x4 * x2 + t(2) = x5 * x4 * x1 + t(4) = x5 * x2 * x1 + t(5) = x4 * x2 * x1 + t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) + + pa(1) = x2 * x4 + x2 * x5 + x4 * x5 + pa(2) = x1 * x4 + x1 * x5 + x4 * x5 + pa(4) = x1 * x2 + x1 * x5 + x2 * x5 + pa(5) = x1 * x2 + x1 * x4 + x2 * x4 + pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) + + recons(1,i,j,p) = & + + y1 * t(1) / denom(1) & + + y2 * t(2) / denom(2) & + - y3 * t(3) & + + y4 * t(4) / denom(4) & + + y5 * t(5) / denom(5) + + IF (order > 2) THEN + recons(3,i,j,p) = & + - y1 * pa(1) / denom(1) & + - y2 * pa(2) / denom(2) & + + y3 * pa(3) & + - y4 * pa(4) / denom(4) & + - y5 * pa(5) / denom(5) + ENDIF + + ! Y-direction reconstruction + x1 = abp_centroid(2,i,j-2) - abp_centroid(2,i,j) + x2 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + x4 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + x5 = abp_centroid(2,i,j+2) - abp_centroid(2,i,j) + + !IF (j == 1) THEN + ! x1 = piq + !ELSEIF (j == ncube_reconstruct-1) THEN + ! x5 = -piq + !ENDIF + + y1 = fcubehalo(i,j-2,p) + y2 = fcubehalo(i,j-1,p) + y3 = fcubehalo(i,j,p) + y4 = fcubehalo(i,j+1,p) + y5 = fcubehalo(i,j+2,p) + + denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 + denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 + denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 + denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 + + t(1) = x5 * x4 * x2 + t(2) = x5 * x4 * x1 + t(4) = x5 * x2 * x1 + t(5) = x4 * x2 * x1 + t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) + + pa(1) = x2 * x4 + x2 * x5 + x4 * x5 + pa(2) = x1 * x4 + x1 * x5 + x4 * x5 + pa(4) = x1 * x2 + x1 * x5 + x2 * x5 + pa(5) = x1 * x2 + x1 * x4 + x2 * x4 + pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) + + recons(2,i,j,p) = & + + y1 * t(1) / denom(1) & + + y2 * t(2) / denom(2) & + - y3 * t(3) & + + y4 * t(4) / denom(4) & + + y5 * t(5) / denom(5) + + IF (order > 2) THEN + recons(4,i,j,p) = & + - y1 * pa(1) / denom(1) & + - y2 * pa(2) / denom(2) & + + y3 * pa(3) & + - y4 * pa(4) / denom(4) & + - y5 * pa(5) / denom(5) + recons(5,i,j,p) = 0.0 + ENDIF + + ENDDO + ENDDO + IF (order > 2) THEN + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + x1 = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) + x2 = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) + + y2 = (+ fcubehalo(i-1,j+1,p) * x2**2 & + - fcubehalo(i+1,j+1,p) * x1**2 & + - fcubehalo(i,j+1,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + x1 = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) + x2 = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) + + y1 = (+ fcubehalo(i-1,j-1,p) * x2**2 & + - fcubehalo(i+1,j-1,p) * x1**2 & + - fcubehalo(i,j-1,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + x1 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + x2 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(5,i,j,p) = & + (+ y1 * x2**2 & + - y2 * x1**2 & + - recons(1,i,j,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + ENDDO + ENDDO + ENDIF + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_PLM +! +! Description: +! Construct a piecewise linear reconstruction of the gradient within +! each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_PLM(fcubehalo, recons, order) + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: width + + ! ABP width between elements + width = pih / DBLE(ncube_reconstruct-1) + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! df/dx + recons(1,i,j,p) = (fcubehalo(i+1,j,p) - fcubehalo(i-1,j,p)) / & + (2.0 * width) + + ! df/dy + recons(2,i,j,p) = (fcubehalo(i,j+1,p) - fcubehalo(i,j-1,p)) / & + (2.0 * width) + + ! Stretching + recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) + recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) + + ! Third order scheme + IF (order > 2) THEN + ! d^2f/dx^2 + recons(3,i,j,p) = & + (fcubehalo(i+1,j,p) - 2.0 * fcubehalo(i,j,p) & + + fcubehalo(i-1,j,p)) / (width * width) + + ! d^2f/dy^2 + recons(4,i,j,p) = & + (fcubehalo(i,j+1,p) - 2.0 * fcubehalo(i,j,p) & + + fcubehalo(i,j-1,p)) / (width * width) + + ! d^2f/dxdy + recons(5,i,j,p) = & + (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & + - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & + ) / (4.0 * width * width) + + ! Stretching + recons(3,i,j,p) = & + (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & + + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 + + recons(4,i,j,p) = & + (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & + + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 + + recons(5,i,j,p) = recons(5,i,j,p) / & + ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) + + ! Scaling + recons(3,i,j,p) = 0.5 * recons(3,i,j,p) + recons(4,i,j,p) = 0.5 * recons(4,i,j,p) + + ENDIF + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_PPM +! +! Description: +! Construct a piecewise parabolic reconstruction of the gradient within +! each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_PPM(fcubehalo, recons, order) + + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: width + + ! ABP width between elements + width = pih / DBLE(ncube_reconstruct-1) + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! df/dalfa + recons(1,i,j,p) = & + (+ fcubehalo(i+2,j,p) - 8.0 * fcubehalo(i+1,j,p) & + + 8.0 * fcubehalo(i-1,j,p) - fcubehalo(i-2,j,p)) / & + (- 12.0 * width) + + ! df/dbeta + recons(2,i,j,p) = & + (+ fcubehalo(i,j+2,p) - 8.0 * fcubehalo(i,j+1,p) & + + 8.0 * fcubehalo(i,j-1,p) - fcubehalo(i,j-2,p)) / & + (- 12.0 * width) + + ! Stretching + recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) + recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) + + ! Third order scheme + IF (order > 2) THEN + ! d^2f/dx^2 + recons(3,i,j,p) = (- fcubehalo(i+2,j,p) & + + 16_dbl_kind * fcubehalo(i+1,j,p) & + - 30_dbl_kind * fcubehalo(i,j,p) & + + 16_dbl_kind * fcubehalo(i-1,j,p) & + - fcubehalo(i-2,j,p) & + ) / (12_dbl_kind * width**2) + + ! d^2f/dy^2 + recons(4,i,j,p) = (- fcubehalo(i,j+2,p) & + + 16_dbl_kind * fcubehalo(i,j+1,p) & + - 30_dbl_kind * fcubehalo(i,j,p) & + + 16_dbl_kind * fcubehalo(i,j-1,p) & + - fcubehalo(i,j-2,p) & + ) / (12_dbl_kind * width**2) + + ! d^2f/dxdy + recons(5,i,j,p) = & + (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & + - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & + ) / (4.0 * width * width) + + ! Stretching + recons(3,i,j,p) = & + (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & + + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 + + recons(4,i,j,p) = & + (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & + + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 + + recons(5,i,j,p) = recons(5,i,j,p) / & + ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) + + ! Scaling + recons(3,i,j,p) = 0.5 * recons(3,i,j,p) + recons(4,i,j,p) = 0.5 * recons(4,i,j,p) + ENDIF + ENDDO + ENDDO + ENDDO + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient +! +! Description: +! Compute the reconstructed gradient in gnomonic coordinates for each +! ABP element. +! +! Parameters: +! fcube - Scalar field on the cubed sphere to use in reconstruction +! halomethod - Method for computing halo elements +! (0) Piecewise constant +! (1) Piecewise linear +! (3) Piecewise cubic +! recons_method - Method for computing the sub-grid scale gradient +! (0) Non-equidistant linear reconstruction +! (1) Non-equidistant parabolic reconstruction +! (2) Piecewise linear reconstruction with stretching +! (3) Piecewise parabolic reconstruction with stretching +! order - Order of the method being applied +! kmono - Apply monotone limiting (1) or not (0) +! recons (INOUT) - Array of reconstructed coefficients +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient( & + fcube, halomethod, recons_method, order, kmono, recons, kpd, kscheme) + +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(1:ncube_reconstruct-1, 1:ncube_reconstruct-1, 6), INTENT(IN) :: fcube + + INTEGER (KIND=int_kind), INTENT(IN) :: halomethod, recons_method + INTEGER (KIND=int_kind), INTENT(IN) :: order, kmono, kpd, kscheme + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: fcubehalo + + ! Report status + WRITE (*,*) '...Performing sub-grid scale reconstruction on ABP grid' + + ! Compute element haloes + WRITE(*,*) "fill cubed-sphere halo for reconstruction" + DO p = 1, 6 + IF (halomethod == 0) THEN + CALL CubedSphereFillHalo(fcube, fcubehalo, p, ncube_reconstruct, 2) + + ELSEIF (halomethod == 1) THEN + CALL CubedSphereFillHalo_Linear(fcube, fcubehalo, p, ncube_reconstruct) + + ELSEIF (halomethod == 3) THEN + !halomethod is always 3 in the standard CSLAM setup + CALL CubedSphereFillHalo_Cubic(fcube, fcubehalo, p, ncube_reconstruct) + ELSE + WRITE (*,*) 'Fatal Error: In ReconstructABPGradient' + WRITE (*,*) 'Invalid halo method: ', halomethod + WRITE (*,*) 'Halo method must be 0, 1 or 3.' + STOP + ENDIF + ENDDO + + ! Nonequidistant linear reconstruction + IF (recons_method == 1) THEN + CALL ReconstructABPGradient_NEL(fcubehalo, recons, order) + + ! Nonequidistant parabolic reconstruction (JCP paper) + ELSEIF (recons_method == 2) THEN + WRITE(*,*) "Nonequidistant parabolic reconstruction" + CALL ReconstructABPGradient_NEP(fcubehalo, recons, order) + + ! Piecewise linear reconstruction with rotation + ELSEIF (recons_method == 3) THEN + CALL ReconstructABPGradient_PLM(fcubehalo, recons, order) + + ! Piecewise parabolic reconstruction with rotation + ELSEIF (recons_method == 4) THEN + CALL ReconstructABPGradient_PPM(fcubehalo, recons, order) + + ELSE + WRITE(*,*) 'Fatal Error: In ReconstructABPGradient' + WRITE(*,*) 'Specified recons_method out of range. Given: ', recons_method + WRITE(*,*) 'Valid values: 1, 2, 3, 4' + STOP + ENDIF + + ! Apply monotone filtering + SELECT CASE (kmono) + CASE (0) !Do nothing + WRITE(*,*) "no filter applied to the reconstruction" + CASE (1) + + !Simplest filter: just scales the recon so it's extreme value + !is no bigger than the original values of this point and its neighbors + CALL MonotonizeABPGradient(fcubehalo, order, recons, .FALSE.) + + CASE (2) + + !Applies a more sophisticated Van Leer limiter (or, to be consistent, a filter) + CALL VanLeerLimit(fcubehalo, order, recons) + + CASE (3) + + !Applies a selective filter + CALL MonotonizeABPGradient(fcubehalo, order, recons, .TRUE.) + + CASE (4) + + !A filter that filters the linear part first + CALL MonotonizeABPGradient_New(fcubehalo, order, recons) + + CASE DEFAULT + WRITE(*,*) "Limiter kmono = ", kmono, " does not exist." + STOP 1201 + + END SELECT + + !Apply positive-definite filtering, if desired. This should + !ONLY be applied to the S-L method, since the flux-form + !method needs something different done. (In particular, using + !positive-definite reconstructions does not ensure that a flux- + !form scheme is positive definite, since we could get negatives + !when subtracting the resulting fluxes.) + !HOWEVER...we will allow this to be enabled, for testing purposes + IF ( (kpd > 0 .AND. kscheme == 2) .OR. (kpd == 2 .AND. kscheme == 4) ) THEN + WRITE(*,*) "applying positive deifnite constraint" + CALL PosDefABPGradient(fcubehalo, order, recons) + END IF + + + END SUBROUTINE + + + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! SUBROUTINE AdjustLimiter +! +! Description: +! Adjust the slope limiter based on new point values. +! +! Parameters: +! value - Point value +! element_value - Value at the center of the element +! local_max - Local maximum value of the function (from neighbours) +! local_min - Local minimum value of the function (to neighbours) +! min_phi (INOUT) - Slope limiter +!------------------------------------------------------------------------------ + SUBROUTINE AdjustLimiter(value, element_value, local_min, local_max, min_phi) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), INTENT(IN) :: value, element_value + REAL (KIND=dbl_kind), INTENT(IN) :: local_min, local_max + REAL (KIND=dbl_kind), INTENT(INOUT) :: min_phi + + ! Local variables + REAL (KIND=dbl_kind) :: phi = 0.0 + + IF ((local_min > element_value ) .OR. (local_max < element_value )) THEN + WRITE (*,*) 'Fatal Error: In AdjustLimiter' + WRITE (*,*) 'Local min: ', local_min, ' max: ', local_max + WRITE (*,*) 'Elemn: ', element_value + STOP + ENDIF + + ! Check against the minimum bound on the reconstruction + IF (value - element_value > tiny * value) THEN + phi = (local_max - element_value) / & + (value - element_value) + + min_phi = MIN(min_phi, phi) + + ! Check against the maximum bound on the reconstruction + ELSEIF (value - element_value < -tiny * value) THEN + phi = (local_min - element_value) / & + (value - element_value) + + min_phi = MIN(min_phi, phi) + + ENDIF + + IF (min_phi < 0.0) THEN + WRITE (*,*) 'Fatal Error: In AdjustLimiter' + WRITE (*,*) 'Min_Phi: ', min_phi + WRITE (*,*) 'Phi: ', phi + WRITE (*,*) 'Value: ', value + WRITE (*,*) 'Elemn: ', element_value + WRITE (*,*) 'Val-E: ', value - element_value + STOP + ENDIF + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE VanLeerLimit +! +! Description: +! Apply a 2D Van Leer-type limiter to a reconstruction. This acts ONLY +! on the linear part of the reconstruction , if any. If passed a PCoM +! reconstruction, this just returns without altering the recon. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! The Van Leer Limiter described here is given on pages 328--329 +! of Dukowicz and Baumgardner (2000). There are no guarantees +! on what it will do to PPM. +!------------------------------------------------------------------------------ + SUBROUTINE VanLeerLimit(fcubehalo, order, recons) + + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, & + recon_min, recon_max + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element. For the Van Leer limiter, we + !wish to find BOTH of the reconstruction extrema. + recon_min = bignum + recon_max = -bignum + + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + recon_min = MIN(recon_min, value) + recon_max = MAX(recon_max, value) + + ENDDO + ENDDO + + !This is equation 27 in Dukowicz and Baumgardner 2000 + min_phi = MIN(one, MAX(0.0, (local_min - fcubehalo(i,j,k))/(recon_min - fcubehalo(i,j,k))), & + MAX(0.0, (local_max - fcubehalo(i,j,k))/(recon_max - fcubehalo(i,j,k))) ) + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + END DO + END DO + END DO + + + + + END SUBROUTINE VanLeerLimit + + !------------------------------------------------------------------------------ + ! SUBROUTINE EquiangularElementArea + ! + ! Description: + ! Compute the area of a single equiangular cubed sphere grid cell. + ! + ! Parameters: + ! alpha - Alpha coordinate of lower-left corner of grid cell + ! da - Delta alpha + ! beta - Beta coordinate of lower-left corner of grid cell + ! db - Delta beta + !------------------------------------------------------------------------------ + REAL(KIND=dbl_kind) FUNCTION EquiangularElementArea(alpha, da, beta, db) + + IMPLICIT NONE + +! REAL (kind=dbl_kind) :: EquiangularElementArea + REAL (kind=dbl_kind) :: alpha, da, beta, db + REAL (kind=dbl_kind) :: a1, a2, a3, a4 + + ! Calculate interior grid angles + a1 = EquiangularGridAngle(alpha , beta ) + a2 = pi - EquiangularGridAngle(alpha+da, beta ) + a3 = pi - EquiangularGridAngle(alpha , beta+db) + a4 = EquiangularGridAngle(alpha+da, beta+db) + + ! Area = r*r*(-2*pi+sum(interior angles)) + EquiangularElementArea = -pi2 + a1 + a2 + a3 + a4 + + END FUNCTION EquiangularElementArea + + !------------------------------------------------------------------------------ + ! FUNCTION EquiangularGridAngle + ! + ! Description: + ! Compute the angle between equiangular cubed sphere projection grid lines. + ! + ! Parameters: + ! alpha - Alpha coordinate of evaluation point + ! beta - Beta coordinate of evaluation point + !------------------------------------------------------------------------------ + REAL(KIND=dbl_kind) FUNCTION EquiangularGridAngle(alpha, beta) + IMPLICIT NONE + REAL (kind=dbl_kind) :: alpha, beta + EquiangularGridAngle = ACOS(-SIN(alpha) * SIN(beta)) + END FUNCTION EquiangularGridAngle + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! halo region around the specified panel. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +! nhalo - Number of halo/ghost elements around each panel +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo(parg, zarg, np, ncube, nhalo) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube,nhalo + + ! Local variables + INTEGER (KIND=int_kind) :: jh,jhy + + !zarg = 0.0 !DBG + zarg(1:ncube-1,1:ncube-1,np) = parg(1:ncube-1,1:ncube-1,np) + + zarg(1-nhalo:0,1-nhalo:0,np) = 0.0 + zarg(1-nhalo:0,ncube:ncube+nhalo-1,np) = 0.0 + zarg(ncube:ncube+nhalo-1,1-nhalo:0,np) = 0.0 + zarg(ncube:ncube+nhalo-1,ncube:ncube+nhalo-1,np) = 0.0 + + ! Equatorial panels + IF (np==1) THEN + DO jh=1,nhalo + zarg(ncube+jh-1,1:ncube-1 ,1) = parg(jh ,1:ncube-1 ,2) !exchange right + zarg(1-jh ,1:ncube-1 ,1) = parg(ncube-jh ,1:ncube-1 ,4) !exchange left + zarg(1:ncube-1 ,1-jh ,1) = parg(1:ncube-1 ,ncube-jh ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,1) = parg(1:ncube-1 ,jh ,6) !exchange over + ENDDO + + ELSE IF (np==2) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,2) = parg(ncube-jh,1:ncube-1 ,1) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,2) = parg(jh ,1:ncube-1 ,3) !exchange right + zarg(1:ncube-1 ,1-jh ,2) = parg(ncube-jh,ncube-1:1:-1,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,2) = parg(ncube-jh,1:ncube-1 ,6) !exchange over + ENDDO + + ELSE IF (np==3) THEN + DO jh=1,nhalo + zarg(ncube+jh-1,1:ncube-1 ,3) = parg(jh ,1:ncube-1,4) !exchange right + zarg(1-jh ,1:ncube-1 ,3) = parg(ncube-jh ,1:ncube-1,2) !exchange left + zarg(1:ncube-1 ,1-jh ,3) = parg(ncube-1:1:-1,jh ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,3) = parg(ncube-1:1:-1,ncube-jh ,6) !exchange over + ENDDO + + ELSE IF (np==4) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,4) = parg(ncube-jh,1:ncube-1 ,3) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,4) = parg(jh ,1:ncube-1 ,1) !exchange right + zarg(1:ncube-1 ,1-jh ,4) = parg(jh ,1:ncube-1 ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,4) = parg(jh ,ncube-1:1:-1,6) !exchange over + ENDDO + + ! Bottom panel + ELSE IF (np==5) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,5) = parg(1:ncube-1 ,jh ,4) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,5) = parg(ncube-1:1:-1,jh ,2) !exchange right + zarg(1:ncube-1 ,1-jh ,5) = parg(ncube-1:1:-1,jh ,3) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,5) = parg(1:ncube-1 ,jh ,1) !exchange over + ENDDO + + ! Top panel + ELSE IF (np==6) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,6) = parg(ncube-1:1:-1,ncube-jh,4) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,6) = parg(1:ncube-1 ,ncube-jh,2) !exchange right + zarg(1:ncube-1 ,1-jh ,6) = parg(1:ncube-1 ,ncube-jh,1) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,6) = parg(ncube-1:1:-1,ncube-jh,3) !exchange over + ENDDO + + ELSE + WRITE (*,*) 'Fatal error: In CubedSphereFillHalo' + WRITE (*,*) 'Invalid panel id ', np + STOP + ENDIF + + END SUBROUTINE CubedSphereFillHalo + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo_Linear +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! 2-element halo region around the specified panel. Use linear order +! interpolation to translate between panels. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo_Linear(parg, zarg, np, ncube) + +! USE CubedSphereTrans ! Cubed sphere transforms + + IMPLICIT NONE + + INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube + + ! Local variables + INTEGER (KIND=int_kind) :: ii, iref, jj, ipanel, imin, imax + REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta + + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg + + ! Use 0.0 order interpolation to begin + CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) + + zarg(:,:,np) = yarg(:,:,np) + + ! Calculate the overlapping alpha coordinates + width = pih / DBLE(ncube-1) + + DO jj = 1, nhalo + DO ii = 0, ncube + prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq + beta = - width * (DBLE(jj-1) + 0.5) - piq + + CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & + newalpha(ii,jj), newbeta) + ENDDO + ENDDO + + ! Now apply linear interpolation to obtain edge components + DO jj = 1, nhalo + ! Reset the reference index + iref = 2 + + ! Interpolation can be applied to more elements after first band + IF (jj == 1) THEN + imin = 1 + imax = ncube-1 + ELSE + imin = 0 + imax = ncube + ENDIF + + ! Apply linear interpolation + DO ii = imin, imax + DO WHILE ((iref .NE. ncube-1) .AND. & + (newalpha(ii,jj) > prealpha(iref,jj))) + iref = iref + 1 + ENDDO + + IF ((newalpha(ii,jj) > prealpha(iref-1,jj)) .AND. & + (newalpha(ii,jj) .LE. prealpha(iref ,jj))) & + THEN + a = (newalpha(ii,jj) - prealpha(iref-1,jj)) / & + (prealpha(iref,jj) - prealpha(iref-1,jj)) + + IF ((a < 0.0) .OR. (a > one)) THEN + WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' + WRITE (*,*) 'a out of bounds' + STOP + ENDIF + + ! Bottom edge of panel + zarg(ii, 1-jj, np) = & + (one - a) * yarg(iref-1, 1-jj, np) + & + a * yarg(iref, 1-jj, np) + + ! Left edge of panel + zarg(1-jj, ii, np) = & + (one - a) * yarg(1-jj, iref-1, np) + & + a * yarg(1-jj, iref, np) + + ! Top edge of panel + zarg(ii, ncube+jj-1, np) = & + (one - a) * yarg(iref-1, ncube+jj-1, np) + & + a * yarg(iref, ncube+jj-1, np) + + ! Right edge of panel + zarg(ncube+jj-1, ii, np) = & + (one - a) * yarg(ncube+jj-1, iref-1, np) + & + a * yarg(ncube+jj-1, iref, np) + + ELSE + WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' + WRITE (*,*) 'ii: ', ii, ' jj: ', jj + WRITE (*,*) 'newalpha: ', newalpha(ii,jj) + WRITE (*,*) 'prealpha: ', prealpha(iref-1,jj), '-', prealpha(iref,jj) + STOP + ENDIF + ENDDO + ENDDO + + ! Fill in corner bits + zarg(0, 0, np) = & + 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & + zarg(-1,0,np) + zarg(0,-1,np)) + zarg(0, ncube, np) = & + 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & + zarg(-1,ncube,np) + zarg(1,ncube,np)) + zarg(ncube, 0, np) = & + 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & + zarg(ncube,-1,np) + zarg(ncube,1,np)) + zarg(ncube, ncube, np) = & + 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & + zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) + + END SUBROUTINE CubedSphereFillHalo_Linear + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo_Cubic +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! 2-element halo region around the specified panel. Use higher order +! interpolation to translate between panels. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo_Cubic(parg, zarg, np, ncube) + +! USE CubedSphereTrans ! Cubed sphere transforms +! USE MathUtils ! Has function for 1D cubic interpolation + + IMPLICIT NONE + + INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube + + ! Local variables + INTEGER (KIND=int_kind) :: ii, iref, ibaseref, jj, ipanel, imin, imax + REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta + + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha + REAL (KIND=dbl_kind), DIMENSION(1:4) :: C, D, X + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg + + ! Use 0.0 order interpolation to begin + CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) + + zarg(:,:,np) = yarg(:,:,np) + + ! Calculate the overlapping alpha coordinates + width = pih / DBLE(ncube-1) + + DO jj = 1, nhalo + DO ii = 0, ncube + ! + ! alpha,beta for the cell center (extending the panel) + ! + prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq + beta = - width * (DBLE(jj-1) + 0.5) - piq + + CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & + newalpha(ii,jj), newbeta) + ENDDO + ENDDO + + ! Now apply cubic interpolation to obtain edge components + DO jj = 1, nhalo + ! Reset the reference index, which gives the element in newalpha that + ! is closest to ii, looking towards larger values of alpha. + iref = 2 + + ! Interpolation can be applied to more elements after first band +! IF (jj == 1) THEN +! imin = 1 +! imax = ncube-1 +! ELSE + imin = 0 + imax = ncube +! ENDIF + + ! Apply cubic interpolation + DO ii = imin, imax + DO WHILE ((iref .NE. ncube-1) .AND. & + (newalpha(ii,jj) > prealpha(iref,jj))) + iref = iref + 1 + ENDDO + + ! Smallest index for cubic interpolation - apply special consideration + IF (iref == 2) THEN + ibaseref = iref-1 + + ! Largest index for cubic interpolation - apply special consideration + ELSEIF (iref == ncube-1) THEN + ibaseref = iref-3 + + ! Normal range + ELSE + ibaseref = iref-2 + ENDIF + + ! Bottom edge of panel + zarg(ii, 1-jj, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ibaseref:ibaseref+3, 1-jj, np)) + + ! Left edge of panel + zarg(1-jj, ii, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(1-jj, ibaseref:ibaseref+3, np)) + + ! Top edge of panel + zarg(ii, ncube+jj-1, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ibaseref:ibaseref+3, ncube+jj-1, np)) + + ! Right edge of panel + zarg(ncube+jj-1, ii, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ncube+jj-1, ibaseref:ibaseref+3, np)) + + ENDDO + ENDDO + + ! Fill in corner bits + zarg(0, 0, np) = & + 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & + zarg(-1,0,np) + zarg(0,-1,np)) + zarg(0, ncube, np) = & + 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & + zarg(-1,ncube,np) + zarg(1,ncube,np)) + zarg(ncube, 0, np) = & + 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & + zarg(ncube,-1,np) + zarg(ncube,1,np)) + zarg(ncube, ncube, np) = & + 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & + zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) + + END SUBROUTINE CubedSphereFillHalo_Cubic + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromABP +! +! Description: +! Determine the (alpha,beta,idest) coordinate of a source point on +! panel isource. +! +! Parameters: +! alpha_in - Alpha coordinate in +! beta_in - Beta coordinate in +! isource - Source panel +! idest - Destination panel +! alpha_out (OUT) - Alpha coordinate out +! beta_out (OUT) - Beta coordiante out +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereABPFromABP(alpha_in, beta_in, isource, idest, & + alpha_out, beta_out) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), INTENT(IN) :: alpha_in, beta_in + INTEGER (KIND=int_kind), INTENT(IN) :: isource, idest + REAL (KIND=dbl_kind), INTENT(OUT) :: alpha_out, beta_out + + ! Local variables + REAL (KIND=dbl_kind) :: a1, b1 + REAL (KIND=dbl_kind) :: xx, yy, zz + REAL (KIND=dbl_kind) :: sx, sy, sz + + ! Convert to relative Cartesian coordinates + a1 = TAN(alpha_in) + b1 = TAN(beta_in) + + sz = (one + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + + ! Convert to full Cartesian coordinates + IF (isource == 6) THEN + yy = sx; xx = -sy; zz = sz + + ELSEIF (isource == 5) THEN + yy = sx; xx = sy; zz = -sz + + ELSEIF (isource == 1) THEN + yy = sx; zz = sy; xx = sz + + ELSEIF (isource == 3) THEN + yy = -sx; zz = sy; xx = -sz + + ELSEIF (isource == 2) THEN + xx = -sx; zz = sy; yy = sz + + ELSEIF (isource == 4) THEN + xx = sx; zz = sy; yy = -sz + + ELSE + WRITE(*,*) 'Fatal Error: Source panel invalid in CubedSphereABPFromABP' + WRITE(*,*) 'panel = ', isource + STOP + ENDIF + + ! Convert to relative Cartesian coordinates on destination panel + IF (idest == 6) THEN + sx = yy; sy = -xx; sz = zz + + ELSEIF (idest == 5) THEN + sx = yy; sy = xx; sz = -zz + + ELSEIF (idest == 1) THEN + sx = yy; sy = zz; sz = xx + + ELSEIF (idest == 3) THEN + sx = -yy; sy = zz; sz = -xx + + ELSEIF (idest == 2) THEN + sx = -xx; sy = zz; sz = yy + + ELSEIF (idest == 4) THEN + sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: Dest panel invalid in CubedSphereABPFromABP' + WRITE(*,*) 'panel = ', idest + STOP + ENDIF + IF (sz < 0) THEN + WRITE(*,*) 'Fatal Error: In CubedSphereABPFromABP' + WRITE(*,*) 'Invalid relative Z coordinate' + STOP + ENDIF + + ! Use panel information to calculate (alpha, beta) coords + alpha_out = ATAN(sx / sz) + beta_out = ATAN(sy / sz) + + END SUBROUTINE + + +!------------------------------------------------------------------------------ +! FUNCTION CUBIC_EQUISPACE_INTERP +! +! Description: +! Apply cubic interpolation on the specified array of values, where all +! points are equally spaced. +! +! Parameters: +! dx - Spacing of points +! x - X coordinate where interpolation is to be applied +! y - Array of 4 values = f(x + k * dx) where k = 0,1,2,3 +!------------------------------------------------------------------------------ + FUNCTION CUBIC_EQUISPACE_INTERP(dx, x, y) + + IMPLICIT NONE + + REAL (KIND=dbl_kind) :: CUBIC_EQUISPACE_INTERP + REAL (KIND=dbl_kind) :: dx, x + REAL (KIND=dbl_kind), DIMENSION(1:4) :: y + + CUBIC_EQUISPACE_INTERP = & + (-y(1) / (6.0 * dx**3)) * (x - dx) * (x - 2.0 * dx) * (x - 3.0 * dx) + & + ( y(2) / (2.0 * dx**3)) * (x) * (x - 2.0 * dx) * (x - 3.0 * dx) + & + (-y(3) / (2.0 * dx**3)) * (x) * (x - dx) * (x - 3.0 * dx) + & + ( y(4) / (6.0 * dx**3)) * (x) * (x - dx) * (x - 2.0 * dx) + + END FUNCTION CUBIC_EQUISPACE_INTERP + +! FUNCTION I_10_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind) :: I_10_AB +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! I_10_ab = -ASINH(COS(alpha) * TAN(beta)) +! END FUNCTION I_10_AB +!! +! +! REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! I_01_ab = -ASINH(COS(beta) * TAN(alpha)) +! END FUNCTION I_01_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) +! END FUNCTION I_20_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) +! END FUNCTION I_02_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_11_ab = -SQRT(1.0+TAN(alpha)**2+TAN(beta)**2) +! END FUNCTION I_11_AB +! + + +END MODULE reconstruct + diff --git a/tools/topo_tool/cube_to_target/remap.F90 b/tools/topo_tool/cube_to_target/remap.F90 new file mode 100644 index 0000000000..b56b7fd493 --- /dev/null +++ b/tools/topo_tool/cube_to_target/remap.F90 @@ -0,0 +1,1561 @@ +MODULE remap + INTEGER, PARAMETER :: & + int_kind = KIND(1), & + real_kind = SELECTED_REAL_KIND(p=14,r=100),& + dbl_kind = selected_real_kind(13) + + INTEGER :: nc,nhe + +! LOGICAL, PARAMETER:: ldbgr_r = .FALSE. + LOGICAL :: ldbgr + LOGICAL :: ldbg_global + + REAL(kind=real_kind), PARAMETER :: & + one = 1.0 ,& + aa = 1.0 ,& + tiny= 1.0E-9 ,& + bignum = 1.0E20 + REAL (KIND=dbl_kind), parameter :: fuzzy_width = 10.0*tiny !CAM-SE add + + contains + + + subroutine compute_weights_cell(xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,& + jx_min, jx_max, jy_min, jy_max,tmp,& + ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& + nc_in,nhe_in,nvertex,ldbg) + + implicit none + integer (kind=int_kind) , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments + real (kind=real_kind) , dimension(0:nvertex+1) :: xcell_in,ycell_in +! real (kind=real_kind) , dimension(0:5), intent(in):: xcell_in,ycell_in + integer (kind=int_kind), intent(in) :: nc_in,nhe_in,nvertex + logical, intent(in) :: ldbg + ! + ! ipanel is just for debugging + ! + integer (kind=int_kind), intent(in) :: jx_min, jy_min, jx_max, jy_max + real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: xgno + real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: ygno + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + ! + ! boundaries of domain + ! + real (kind=real_kind):: tmp + ! + ! Number of Eulerian sub-cell integrals for the cell in question + ! + integer (kind=int_kind), intent(out) :: jcollect + ! + ! local workspace + ! + ! + ! max number of line segments is: + ! + ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 + ! + real (kind=real_kind) , & + dimension(jmax_segments,nreconstruction), intent(out) :: weights + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(out) :: weights_eul_index + + real (kind=real_kind), dimension(0:3) :: x,y + integer (kind=int_kind),dimension(0:5) :: jx_eul, jy_eul + integer (kind=int_kind) :: jsegment,i + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer (kind=int_kind) :: jcross_lat, iter + ! + ! max. crossings per side is 2*nhe + ! + real (kind=real_kind), & + dimension(jmax_segments,2) :: r_cross_lat + integer (kind=int_kind), & + dimension(jmax_segments,2) :: cross_lat_eul_index + real (kind=real_kind) , dimension(1:nvertex) :: xcell,ycell + + real (kind=real_kind) :: eps + + ldbg_global = ldbg + ldbgr = ldbg + + nc = nc_in + nhe = nhe_in + + xcell = xcell_in(1:nvertex) + ycell = ycell_in(1:nvertex) + + + ! + ! this is to avoid ill-conditioning problems + ! + eps = 1.0E-9 + + jsegment = 0 + weights = 0.0D0 + jcross_lat = 0 + ! + !********************** + ! + ! Integrate cell sides + ! + !********************** + + + IF (jx<-nhe.OR.jx>nc+1+nhe.OR.jy<-nhe.OR.jy>nc+1+nhe) THEN + WRITE(*,*) "jx,jy,-nhe,nc+1+nhe",jx,jy,-nhe,nc+1+nhe + STOP + END IF + + + call side_integral(xcell,ycell,nvertex,jsegment,jmax_segments,& + weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,jx_min, jx_max, jy_min, jy_max,& + ngauss,gauss_weights,abscissae,& + jcross_lat,r_cross_lat,cross_lat_eul_index) + + ! + !********************** + ! + ! Do inner integrals + ! + !********************** + ! + call compute_inner_line_integrals_lat_nonconvex(r_cross_lat,cross_lat_eul_index,& + jcross_lat,jsegment,jmax_segments,xgno,jx_min, jx_max, jy_min, jy_max,& + weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae) + ! + ! collect line-segment that reside in the same Eulerian cell + ! + if (jsegment>0) then + call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + ! + ! DBG + ! + tmp=0.0 + do i=1,jcollect + tmp=tmp+weights(i,1) + enddo + + IF (abs(tmp)>0.01) THEN + WRITE(*,*) "sum of weights too large",tmp + stop + END IF + IF (tmp<-1.0E-9) THEN + WRITE(*,*) "sum of weights is negative - negative area?",tmp,jx,jy + ! ldbgr=.TRUE. + stop + END IF + else + jcollect = 0 + end if + end subroutine compute_weights_cell + + + ! + !**************************************************************************** + ! + ! organize data and store it + ! + !**************************************************************************** + ! + subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + implicit none + integer (kind=int_kind) , intent(in) :: nreconstruction + real (kind=real_kind) , dimension(jmax_segments,nreconstruction), intent(inout) :: weights + integer (kind=int_kind), dimension(jmax_segments,2 ), intent(inout) :: weights_eul_index + integer (kind=int_kind), INTENT(OUT ) :: jcollect + integer (kind=int_kind), INTENT(IN ) :: jsegment,jmax_segments + ! + ! local workspace + ! + integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k,h + logical :: ltmp + + real (kind=real_kind) , dimension(jmax_segments,nreconstruction) :: weights_out + integer (kind=int_kind), dimension(jmax_segments,2 ) :: weights_eul_index_out + + weights_out = 0.0D0 + weights_eul_index_out = -100 + + imin = MINVAL(weights_eul_index(1:jsegment,1)) + imax = MAXVAL(weights_eul_index(1:jsegment,1)) + jmin = MINVAL(weights_eul_index(1:jsegment,2)) + jmax = MAXVAL(weights_eul_index(1:jsegment,2)) + + ltmp = .FALSE. + + jcollect = 1 + + do j=jmin,jmax + do i=imin,imax + do k=1,jsegment + if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then + weights_out(jcollect,1:nreconstruction) = & + weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) + ltmp = .TRUE. + h = k + endif + enddo + if (ltmp) then + weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) + jcollect = jcollect+1 + endif + ltmp = .FALSE. + enddo + enddo + jcollect = jcollect-1 + weights = weights_out + weights_eul_index = weights_eul_index_out + end subroutine collect + ! + !***************************************************************************************** + ! + ! + ! + !***************************************************************************************** + ! + subroutine compute_inner_line_integrals_lat(r_cross_lat,cross_lat_eul_index,& + jcross_lat,jsegment,jmax_segments,xgno,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae)!phl add jx_min etc. + implicit none + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer (kind=int_kind), intent(in):: jcross_lat, jmax_segments,nreconstruction,ngauss + integer (kind=int_kind), intent(inout):: jsegment + ! + ! max. crossings per side is 2*nhe + ! + real (kind=real_kind), & + dimension(jmax_segments,2), intent(in):: r_cross_lat + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(in):: cross_lat_eul_index + integer (kind=int_kind), intent(in) ::jx_min, jx_max, jy_min, jy_max + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: xgno + real (kind=real_kind) , & + dimension(jmax_segments,nreconstruction), intent(inout) :: weights + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(inout) :: weights_eul_index + real (kind=real_kind) , dimension(nreconstruction) :: weights_tmp + + integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k, isgn, h, eul_jx, eul_jy + integer (kind=int_kind) :: idx_start_y,idx_end_y + logical :: ltmp,lcontinue + real (kind=real_kind), dimension(2) :: rstart,rend,rend_tmp + real (kind=real_kind), dimension(2) :: xseg, yseg +5 FORMAT(10e14.6) + + + if (jcross_lat>0) then + do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) + ! + ! find "first" crossing with Eulerian cell i + ! + do k=1,jcross_lat + if (cross_lat_eul_index(k,2)==i) exit + enddo + do j=k+1,jcross_lat + ! + ! find "second" crossing with Eulerian cell i + ! + if (cross_lat_eul_index(j,2)==i) then + if (r_cross_lat(k,1)0) then + do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) + ! WRITE(*,*) "looking at latitude ",i !xxxx + count = 1 + ! + ! find all crossings with Eulerian latitude i + ! + do k=1,jcross_lat + if (cross_lat_eul_index(k,2)==i) then + ! WRITE(*,*) "other crossings with latitude",i ," is ",k!xxxx + r_cross_lat_seg (count,:) = r_cross_lat (k,:) + cross_lat_eul_index_seg(count,:) = cross_lat_eul_index(k,:) + + IF (ldbg_global) then + WRITE(*,*) r_cross_lat_seg(count,1),r_cross_lat_seg(count,2) + WRITE(*,*) " " + END IF + count = count+1 + end if + enddo + count = count-1 + IF (ABS((count/2)-DBLE(count)/2.0)1000) THEN + WRITE(*,*) "search not converging",iter + STOP + END IF + lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) + lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) +! IF (ldbgr) WRITE(*,*) "lsame_cell_x,lsame_cell_y=",lsame_cell_x,lsame_cell_y + IF (lsame_cell_x.AND.lsame_cell_y) THEN + ! + !**************************** + ! + ! same cell integral + ! + !**************************** + ! +! IF (ldbgr) WRITE(*,*) "same cell integral",jx_eul,jy_eul + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + lcontinue = .FALSE. + ! + ! prepare for next side if (x(2),y(2)) is on a grid line + ! + IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN + ! + ! cross longitude jx_eul+1 + ! +! IF (ldbgr) WRITE(*,*) "cross longitude",jx_eul+1 + jx_eul=jx_eul+1 + ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN + ! + ! register crossing with latitude: line-segments point Northward + ! + jcross_lat = jcross_lat + 1 + jy_eul = jy_eul + 1 +! IF (ldbgr) WRITE(*,*) "cross latitude",jy_eul + cross_lat_eul_index(jcross_lat,1) = jx_eul + cross_lat_eul_index(jcross_lat,2) = jy_eul + r_cross_lat(jcross_lat,1) = x(2) + r_cross_lat(jcross_lat,2) = y(2) + ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" + ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + ! + !******************************************************************************* + ! + ! there is at least one crossing with latitudes but no crossing with longitudes + ! + !******************************************************************************* + ! + yeul = ygno(jy_eul+ysgn1) + IF (x(1).EQ.x(2)) THEN + ! + ! line segment is parallel to longitude (infinite slope) + ! +! IF (ldbgr) WRITE(*,*) "line segment parallel to longitude" + xcross = x(1) + ELSE + slope = (y(2)-y(1))/(x(2)-x(1)) + xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) + ! + ! constrain crossing to be "physically" possible + ! + xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) + + +! IF (ldbgr) WRITE(*,*) "cross latitude" + ! + ! debugging + ! + IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN + WRITE(*,*) "xcross is out of range",jx,jy + WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& + xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) + STOP + END IF + END IF + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul + ELSE IF (lsame_cell_y) THEN +! IF (ldbgr) WRITE(*,*) "same cell y" + ! + !******************************************************************************* + ! + ! there is at least one crossing with longitudes but no crossing with latitudes + ! + !******************************************************************************* + ! + xsgn1 = (1+INT(SIGN(1.0D0,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" + xsgn2 = INT(SIGN(1.0D0,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" + xeul = xgno(jx_eul+xsgn1) +! IF (ldbgr) WRITE(*,*) " crossing longitude",jx_eul+xsgn1 + IF (ABS(x(2)-x(1))x(1) else "0" + xsgn2 = (INT(SIGN(1.0D0,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" + xeul = xgno(jx_eul+xsgn1) + ysgn1 = (1+INT(SIGN(1.0D0,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" + ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + yeul = ygno(jy_eul+ysgn1) + + slope = (y(2)-y(1))/(x(2)-x(1)) + IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN + ! + ! cross latitude + ! +! IF (ldbgr) WRITE(*,*) "crossing latitude",jy_eul+ysgn1 + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul + ELSE + ! + ! cross longitude + ! +! IF (ldbgr) WRITE(*,*) "crossing longitude",jx_eul+xsgn1 + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 + END IF + + END IF + END IF + ! + ! register line-segment (don't register line-segment if outside of panel) + ! + if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& + jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then + ! jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1.AND.side_count<3) then + jsegment=jsegment+1 + weights_eul_index(jsegment,1) = jx_eul_tmp + weights_eul_index(jsegment,2) = jy_eul_tmp + call get_weights_gauss(weights(jsegment,1:nreconstruction),& + xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + +! if (ldbg_global) then +! OPEN(unit=40, file='side_integral.dat',status='old',access='append') +! WRITE(40,*) xseg(1),yseg(1) +! WRITE(40,*) xseg(2),yseg(2) +! WRITE(40,*) " " +! CLOSE(40) +! end if + + + jdbg=jdbg+1 + + if (xseg(1).EQ.xseg(2))then + slope = bignum + else if (abs(yseg(1) -yseg(2))0) THEN + compute_slope = (y(2)-y(1))/(x(2)-x(1)) + else + compute_slope = bignum + end if + end function compute_slope + + real (kind=real_kind) function y_cross_eul_lon(x,y,xeul,slope) + implicit none + real (kind=real_kind), intent(in) :: x,y + real (kind=real_kind) , intent(in) :: xeul,slope + ! line: y=a*x+b + real (kind=real_kind) :: a,b + b = y-slope*x + y_cross_eul_lon = slope*xeul+b + end function y_cross_eul_lon + + real (kind=real_kind) function x_cross_eul_lat(x,y,yeul,slope) + implicit none + real (kind=real_kind), intent(in) :: x,y + real (kind=real_kind) , intent(in) :: yeul,slope + + if (fuzzy(ABS(slope),fuzzy_width)>0) THEN + x_cross_eul_lat = x+(yeul-y)/slope + ELSE + ! WRITE(*,*) "WARNING: slope is epsilon - ABORT" + x_cross_eul_lat = bignum + END IF + end function x_cross_eul_lat + + subroutine get_weights_exact(weights,xseg,yseg,nreconstruction) +! use cslam_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 + implicit none + integer (kind=int_kind), intent(in) :: nreconstruction + real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights + real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg + ! + ! compute weights + ! + real (kind=real_kind) :: tmp,slope,b,integral,dx2,xc + integer (kind=int_kind) :: i +! weights(:) = -half*(xseg(1)*yseg(2)-xseg(2)*yseg(1)) !dummy for testing + + weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) + if (ABS(weights(1))>1.0) THEN + WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg + stop + end if + if (nreconstruction>1) then + weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) + weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) + endif + if (nreconstruction>3) then + weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) + weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) + weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) + endif + + end subroutine get_weights_exact + + + + subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + implicit none + integer (kind=int_kind), intent(in) :: nreconstruction,ngauss + real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights + real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg + real (kind=real_kind) :: slope + ! + ! compute weights + ! + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + + ! if line-segment parallel to x or y use exact formulaes else use qudrature + ! + real (kind=real_kind) :: tmp,b,integral,dx2,xc,x,y + integer (kind=int_kind) :: i + + + + +! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then + if (xseg(1).EQ.xseg(2))then + weights = 0.0D0 + else if (abs(yseg(1) -yseg(2))1) then + weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) + weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) + endif + if (nreconstruction>3) then + weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) + weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) + weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) + endif + else + + + slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) + b = yseg(1)-slope*xseg(1) + dx2 = 0.5D0*(xseg(2)-xseg(1)) + if (ldbgr) WRITE(*,*) "dx2 and slope in gauss weight",dx2,slope + xc = 0.5D0*(xseg(1)+xseg(2)) + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_00(x,y) + enddo + weights(1) = integral*dx2 + if (nreconstruction>1) then + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_10(x,y) + enddo + weights(2) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_01(x,y) + enddo + weights(3) = integral*dx2 + endif + if (nreconstruction>3) then + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_20(x,y) + enddo + weights(4) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_02(x,y) + enddo + weights(5) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_11(x,y) + enddo + weights(6) = integral*dx2 + endif + end if + end subroutine get_weights_gauss + + real (kind=real_kind) function F_00(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_00 =y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_00 + + real (kind=real_kind) function F_10(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_10 =x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_10 + + real (kind=real_kind) function F_01(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_01 =-1.0D0/(SQRT(1.0D0+x*x+y*y)) + end function F_01 + + real (kind=real_kind) function F_20(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_20 =x*x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_20 + + real (kind=real_kind) function F_02(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,alpha, tmp + + x = x_in + y = y_in + + alpha = ATAN(x) + tmp=y*COS(alpha) + F_02 =-y/SQRT(1.0D0+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) + + ! + ! cos(alpha) = 1/sqrt(1+x*x) + ! + end function F_02 + + real (kind=real_kind) function F_11(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_11 =-x/(SQRT(1.0D0+x*x+y*y)) + end function F_11 + + subroutine which_eul_cell(x,j_eul,gno) + implicit none + integer (kind=int_kind) , intent(inout) :: j_eul + real (kind=real_kind), dimension(3) , intent(in) :: x + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl +! real (kind=real_kind), intent(in) :: eps + + real (kind=real_kind) :: d1,d2,d3,d1p1 + logical :: lcontinue + integer :: iter + + + ! + ! this is not needed in transport code search + ! +! IF (x(1)gno(nc+2+nhe)) j_eul=nc+1+nhe +! RETURN + +! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added + + lcontinue = .TRUE. + iter = 0 + IF (ldbgr) WRITE(*,*) "from which_eul_cell",x(1),x(2),x(3) + DO WHILE (lcontinue) + iter = iter+1 + IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN + lcontinue = .FALSE. + ! + ! special case when x(1) is on top of grid line + ! + IF (x(1).EQ.gno(j_eul)) THEN +! IF (ABS(x(1)-gno(j_eul))1000.OR.j_eul<-nhe.OR.j_eul>nc+2+nhe) THEN + WRITE(*,*) "search in which_eul_cell not converging!", iter,j_eul + WRITE(*,*) "input", x + WRITE(*,*) "gno", gno(nc),gno(nc+1),gno(nc+2),gno(nc+3) + STOP + END IF + END DO + END subroutine which_eul_cell + + + subroutine truncate_vertex(x,j_eul,gno) + implicit none + integer (kind=int_kind) , intent(inout) :: j_eul + real (kind=real_kind) , intent(inout) :: x + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl +! real (kind=real_kind), intent(in) :: eps + + logical :: lcontinue + integer :: iter + real (kind=real_kind) :: xsgn,dist,dist_new,tmp + + ! + ! this is not needed in transport code search + ! +! IF (xgno(nc+2+nhe)) j_eul=nc+1+nhe +! +! RETURN + + + lcontinue = .TRUE. + iter = 0 + dist = bignum +! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added + xsgn = INT(SIGN(1.0_dbl_kind,x-gno(j_eul))) + DO WHILE (lcontinue) + iter = iter+1 + tmp = x-gno(j_eul) + dist_new = ABS(tmp) + IF (dist_new>dist) THEN + lcontinue = .FALSE. +! ELSE IF (ABS(tmp)<1.0E-11) THEN + ELSE IF (ABS(tmp)<1.0E-9) THEN +! ELSE IF (ABS(tmp)<1.0E-4) THEN + x = gno(j_eul) + lcontinue = .FALSE. + ELSE + j_eul = j_eul+xsgn + dist = dist_new + END IF + IF (iter>10000) THEN + WRITE(*,*) "truncate vertex not converging" + STOP + END IF + END DO + END subroutine truncate_vertex + + + + +!******************************************************************************** +! +! Gauss-Legendre quadrature +! +! Tabulated values +! +!******************************************************************************** +subroutine gauss_points(n,weights,points) + implicit none + real (kind=real_kind), dimension(n), intent(out) :: weights, points + integer (kind=int_kind) , intent(in ) :: n + + select case (n) +! CASE(1) +! abscissae(1) = 0.0D0 +! weights(1) = 2.0D0 + case(2) + points(1) = -sqrt(1.0D0/3.0D0) + points(2) = sqrt(1.0D0/3.0D0) + weights(1) = 1.0D0 + weights(2) = 1.0D0 + case(3) + points(1) = -0.774596669241483377035853079956D0 + points(2) = 0.0D0 + points(3) = 0.774596669241483377035853079956D0 + weights(1) = 0.555555555555555555555555555556D0 + weights(2) = 0.888888888888888888888888888889D0 + weights(3) = 0.555555555555555555555555555556D0 + case(4) + points(1) = -0.861136311594052575223946488893D0 + points(2) = -0.339981043584856264802665659103D0 + points(3) = 0.339981043584856264802665659103D0 + points(4) = 0.861136311594052575223946488893D0 + weights(1) = 0.347854845137453857373063949222D0 + weights(2) = 0.652145154862546142626936050778D0 + weights(3) = 0.652145154862546142626936050778D0 + weights(4) = 0.347854845137453857373063949222D0 + case(5) + points(1) = -(1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) + points(2) = -(1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) + points(3) = 0.0D0 + points(4) = (1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) + points(5) = (1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) + weights(1) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 + weights(2) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 + weights(3) = 128.0D0/225.0D0 + weights(4) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 + weights(5) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 + case default + write(*,*) 'n out of range in glwp of module gll. n=',n + write(*,*) '0 0.0D0) THEN + signum = 1.0D0 + ELSEIF (x < 0.0D0) THEN + signum = -1.0D0 + ELSE + signum = 0.0D0 + ENDIF + end function + +!------------------------------------------------------------------------------ +! FUNCTION SIGNUM_FUZZY +! +! Description: +! Gives the sign of the given real number, returning zero if x is within +! a small amount from zero. +!------------------------------------------------------------------------------ + function signum_fuzzy(x) + implicit none + + real (kind=real_kind) :: signum_fuzzy + real (kind=real_kind) :: x + + IF (x > fuzzy_width) THEN + signum_fuzzy = 1.0D0 + ELSEIF (x < fuzzy_width) THEN + signum_fuzzy = -1.0D0 + ELSE + signum_fuzzy = 0.0D0 + ENDIF + end function + + function fuzzy(x,epsilon) + implicit none + + integer (kind=int_kind) :: fuzzy + real (kind=real_kind), intent(in) :: epsilon + real (kind=real_kind) :: x + + IF (ABS(x)epsilon) THEN + fuzzy = 1 + ELSE !IF (x < fuzzy_width) THEN + fuzzy = -1 + ENDIF + end function + +! +! see, e.g., http://local.wasp.uwa.edu.au/~pbourke/geometry/lineline2d/ +! +subroutine check_lines_cross(x1,x2,x3,x4,y1,y2,y3,y4,lcross) + implicit none + real (kind=real_kind), INTENT(IN) :: x1,x2,x3,x4,y1,y2,y3,y4 + LOGICAL, INTENT(OUT) :: lcross + ! + ! local workspace + ! + real (kind=real_kind) :: cp,tx,ty + + cp = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1) + IF (ABS(cp)-tiny.AND.tx<1.0D0+tiny.AND.& + ty>-tiny.AND.ty<1.0D0+tiny) THEN + lcross = .TRUE. + ELSE + lcross = .FALSE. +! WRITE(*,*) "not parallel but not crossing,",tx,ty + ENDIF + ENDIF +end subroutine check_lines_cross + + + REAL (KIND=dbl_kind) FUNCTION I_00(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y + + x = x_in/aa + y = y_in/aa +! x = x_in +! y = y_in + I_00 = ATAN(x*y/SQRT(one+x*x+y*y)) + END FUNCTION I_00 + + REAL (KIND=dbl_kind) FUNCTION I_10(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y,tmp + + x = x_in/aa + y = y_in/aa + tmp = ATAN(x) + I_10 = -ASINH(y*COS(tmp)) + ! + ! = -arcsinh(y/sqrt(1+x^2)) + ! + END FUNCTION I_10 + + REAL (KIND=dbl_kind) FUNCTION I_10_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + I_10_ab = -ASINH(COS(alpha) * TAN(beta)) + END FUNCTION I_10_AB + + REAL (KIND=dbl_kind) FUNCTION I_01(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y!,beta + + x = x_in/aa + y = y_in/aa +! beta = ATAN(y) +! I_01 = -ASINH(x*COS(beta)) + I_01 = -ASINH(x/SQRT(1+y*y)) + END FUNCTION I_01 + + REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + I_01_ab = -ASINH(COS(beta) * TAN(alpha)) + END FUNCTION I_01_AB + + REAL (KIND=dbl_kind) FUNCTION I_20(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta + + x = x_in/aa + y = y_in/aa +! alpha = aa*ATAN(x) +! beta = aa*ATAN(y) + + tmp = one+y*y + +! I_20 = y*ASINH(COS(beta)*x)+ACOS(SIN(alpha)*SIN(beta)) + I_20 = y*ASINH(x/SQRT(tmp))+ACOS(x*y/(SQRT((one+x*x)*tmp))) + END FUNCTION I_20 + + REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) + END FUNCTION I_20_AB + + REAL (KIND=dbl_kind) FUNCTION I_02(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta + + x = x_in/aa + y = y_in/aa +! alpha = aa*ATAN(x) +! beta = aa*ATAN(y) + + tmp=one+x*x + + I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) + END FUNCTION I_02 + + REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) + END FUNCTION I_02_AB + + + REAL (KIND=dbl_kind) FUNCTION I_11(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y + + x = x_in/aa + y = y_in/aa + + I_11 = -SQRT(1+x*x+y*y) + END FUNCTION I_11 + + REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_11_ab = -SQRT(one+TAN(alpha)**2+TAN(beta)**2) + END FUNCTION I_11_AB +!------------------------------------------------------------------------------ +! FUNCTION ASINH +! +! Description: +! Hyperbolic arcsin function +!------------------------------------------------------------------------------ + FUNCTION ASINH(x) + IMPLICIT NONE + + REAL (KIND=dbl_kind) :: ASINH + REAL (KIND=dbl_kind) :: x + + ASINH = LOG(x + SQRT(x * x + one)) + END FUNCTION + + + !******************************************************************************** + ! + ! Gauss-Legendre quadrature + ! + ! Tabulated values + ! + !******************************************************************************** + SUBROUTINE glwp(n,weights,abscissae) + IMPLICIT NONE + REAL (KIND=dbl_kind), DIMENSION(n), INTENT(OUT) :: weights, abscissae + INTEGER (KIND=int_kind) , INTENT(IN ) :: n + + SELECT CASE (n) + CASE(1) + abscissae(1) = 0.0 + weights(1) = 2.0 + CASE(2) + abscissae(1) = -SQRT(1.0/3.0) + abscissae(2) = SQRT(1.0/3.0) + weights(1) = 1.0 + weights(2) = 1.0 + CASE(3) + abscissae(1) = -0.774596669241483377035853079956_dbl_kind + abscissae(2) = 0.0 + abscissae(3) = 0.774596669241483377035853079956_dbl_kind + weights(1) = 0.555555555555555555555555555556_dbl_kind + weights(2) = 0.888888888888888888888888888889_dbl_kind + weights(3) = 0.555555555555555555555555555556_dbl_kind + CASE(4) + abscissae(1) = -0.861136311594052575223946488893_dbl_kind + abscissae(2) = -0.339981043584856264802665659103_dbl_kind + abscissae(3) = 0.339981043584856264802665659103_dbl_kind + abscissae(4) = 0.861136311594052575223946488893_dbl_kind + weights(1) = 0.347854845137453857373063949222_dbl_kind + weights(2) = 0.652145154862546142626936050778_dbl_kind + weights(3) = 0.652145154862546142626936050778_dbl_kind + weights(4) = 0.347854845137453857373063949222_dbl_kind + CASE(5) + abscissae(1) = -(1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) + abscissae(2) = -(1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) + abscissae(3) = 0.0 + abscissae(4) = (1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) + abscissae(5) = (1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) + weights(1) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(2) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(3) = 128.0_dbl_kind/225.0_dbl_kind + weights(4) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(5) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + CASE DEFAULT + WRITE(*,*) 'n out of range in glwp of module gll. n=',n + WRITE(*,*) '0 shr_kind_r8 + implicit none +! + integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset + integer, parameter :: im = 43200 ! total grids in x direction of 30-sec global dataset + integer, parameter :: jm = 21600 ! total grids in y direction of 30-sec global dataset + real(r8), parameter :: dx = 1.0/120.0 ! space interval for 30-sec data (in degree) + + character (len=7) :: nmtile(ntile) ! name of each tile + integer :: ncols,nrows ! number of columns and rows for 30-sec tile + integer :: nodata ! integer for ocean point + real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile + real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile + real(r8):: lon_start ! longitude at the center of grid (1,1) in the 30-sec netCDF global data + real(r8):: lat_start ! latitude at the center of grid (1,1) in the 30-sec netCDF global data + real(r8):: lonsw ! longitude at the center of southwest corner cell in the 30-sec tile + real(r8):: latsw ! latitude at the center of southwest corner cell in the 30-sec tile + integer :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile in the global grid + + integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data + integer*1, allocatable, dimension(:,:) :: land_fraction ! global 30-sec land fraction + + integer :: alloc_error,dealloc_error + integer :: i,j,n ! index + integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile + integer*2, allocatable, dimension(:,:) :: terr_tile ! terrain data for 30-sec tile + integer*1, allocatable, dimension(:,:) :: land_fraction_tile +! + lat_start=-90.0 + 0.5 * dx + lon_start=0.5*dx + ! + ! Initialize each tile name + ! + nmtile(1) = 'W180N90' + nmtile(2) = 'W140N90' + nmtile(3) = 'W100N90' + nmtile(4) = 'W060N90' + nmtile(5) = 'W020N90' + nmtile(6) = 'E020N90' + nmtile(7) = 'E060N90' + nmtile(8) = 'E100N90' + nmtile(9) = 'E140N90' + + nmtile(10) = 'W180N40' + nmtile(11) = 'W140N40' + nmtile(12) = 'W100N40' + nmtile(13) = 'W060N40' + nmtile(14) = 'W020N40' + nmtile(15) = 'E020N40' + nmtile(16) = 'E060N40' + nmtile(17) = 'E100N40' + nmtile(18) = 'E140N40' + + nmtile(19) = 'W180S10' + nmtile(20) = 'W140S10' + nmtile(21) = 'W100S10' + nmtile(22) = 'W060S10' + nmtile(23) = 'W020S10' + nmtile(24) = 'E020S10' + nmtile(25) = 'E060S10' + nmtile(26) = 'E100S10' + nmtile(27) = 'E140S10' + + nmtile(28) = 'W180S60' + nmtile(29) = 'W120S60' + nmtile(30) = 'W060S60' + nmtile(31) = 'W000S60' + nmtile(32) = 'E060S60' + nmtile(33) = 'E120S60' + + + allocate ( land_fraction(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for land_fraction' + stop + end if + + allocate ( terr(im,jm),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr' + stop + end if + + do j = 1, jm + do i = 1, im + terr(i,j) = -999999.0 + land_fraction(i,j) = -99.0 + end do + end do + + do n = 1,ntile +! +! Read header for each tile +! + call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) + +! +! Allocate space for array iterr +! + allocate ( iterr(ncols,nrows),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for iterr' + stop + end if +! +! Read terr data for each tile +! + call rdterr(nmtile(n),nrows,ncols,iterr) +! +! Allocate space for arrays terr_tile and psea10m +! + allocate ( terr_tile(ncols,nrows),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_tile' + stop + end if + allocate ( land_fraction_tile(ncols,nrows),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for land_fraction_tile' + stop + end if +! +! Expand Caspian Sea for tiles 6 and 15 +! + if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) + if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) + if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) + print *, "min and maxiterr: ", minval(iterr), maxval(iterr) +! +! area average of 30-sec tile to 30-sec tile +! + call avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) + +! +! Print some info on the fields + print *, "min and max elevations: ", minval(terr_tile), maxval(terr_tile) + print *, "min and max land_fraction: ", minval(land_fraction_tile), maxval(land_fraction_tile) +! +! fit the 30-sec tile into global 30-sec dataset +! + + latsw= ulymap - (nrows-1) * dx + lonsw = ulxmap + if( lonsw < 0.0 ) lonsw=360.0+lonsw + i1 = nint( (lonsw - lon_start) / dx )+1 + if( i1 <= 0 ) i1 = i1 + im + if( i1 > im ) i1 = i1 - im + j1 = nint( (latsw- lat_start) / dx )+1 + +! print*,'ulymap,ulxmap,latsw10,lonsw = ',ulymap,ulxmap,latsw10,lonsw +! print*,'i1,j1 = ', i1,j1 + + call fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) +! +! Deallocate working space for arrays iterr, terr_tile and psea10m +! + deallocate ( iterr,terr_tile,land_fraction_tile,stat=dealloc_error ) + if( dealloc_error /= 0 ) then + print*,'Unexpected deallocation error for arrays iterr,terr_tile' + stop + end if + + end do + WRITE(*,*) 'done reading in USGS data' +! +! Print some info on the fields + print *, "min and max elevations: ", minval(terr), maxval(terr) + print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) +! +! Write 30-sec terrain dataset, and land_fraction to NetCDF file +! +! call wrtncdf(im,jm,terr,land_fraction,dx) + call wrtncdf(im,jm,terr,land_fraction,dx,100) + end program convterr + + subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine read the header of USGA Global30 sec TOPO data set. +! + implicit none +! +! Dummy arguments +! + character (len=7), intent(in) :: nmtile ! name of the tile + integer, intent(out) :: nrows ! number of rows + integer, intent(out) :: ncols ! number of column + integer, intent(out) :: nodata ! integer for ocean data point + real(r8), intent(out) :: ulxmap + real(r8), intent(out) :: ulymap +! +! Local variables +! + character (len=11) :: flheader ! file name of the header + character (len=13) :: chars ! dummy character + + flheader=nmtile//'.HDR' + + print*,'flheader = ', flheader +! +! Open GTOPO30 Header File +! + open(unit=10,file=flheader,status='old',form='formatted') +! +! Read GTOPO30 Header file +! + read (10, *) + read (10, *) + read (10, *) chars,nrows + print*,chars,' = ',nrows + read (10, *) chars,ncols + print*,chars,' = ',ncols + read (10, *) + read (10, *) + read (10, *) + read (10, *) + read (10, *) + read (10, *) chars,nodata + print*,chars,' = ',nodata + read (10, *) chars,ulxmap + print*,chars,' = ',ulxmap + read (10, *) chars,ulymap + print*,chars,' = ',ulymap + close(10) + + end subroutine rdheader + + subroutine rdterr(nmtile,nrows,ncols,iterr) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine read the USGS Global 30-sec terrain data for each tile. +! + implicit none +! +! Dummy arguments +! + character (len=7), intent(in) :: nmtile ! name of the tile + integer, intent(in) :: nrows ! number of rows + integer, intent(in) :: ncols ! number of column + integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data +! +! Local variables +! + character (len=11) :: flterr ! file name for each terr dataset + integer :: io_error ! I/O status + integer :: i,j ! Index + integer :: length ! record length + + flterr=nmtile//'.DEM' + +! print*,'flterr = ', flterr +! print*,'nrows,ncols = ',nrows,ncols +! +! Open GTOPO30 Terrain dataset File +! + + length = 2 * ncols * nrows + io_error=0 + open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) + if( io_error /= 0 ) then + print*,'Open file error in subroutine rdterr' + print*,'iostat = ', io_error + stop + end if +! +! Read GTOPO30 Terrain data file +! + read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) +! + if( io_error /= 0 ) then + print*,'Data file error in subroutine rdterr' + print*,'iostat = ', io_error + stop + end if +! +! Print some info on the fields + print *, "min and max elevations: ", minval(iterr), maxval(iterr) +! +! Correct missing data in source files +! +! Missing data near dateline + + if( nmtile == 'W180S60' ) then + do j = 1, nrows + iterr(1,j) = iterr(2,j) + end do + else if (nmtile == 'E120S60') then + do j = 1, nrows + iterr(ncols-1,j) = iterr(ncols-2,j) + iterr(ncols,j) = iterr(ncols-2,j) + end do + end if +! +! Missing data at the southermost row near South pole +! + if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & + nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then + do i=1,ncols + iterr(i,nrows) = iterr(i,nrows-1) + end do + end if +! +! print*,'iterr(1,1),iterr(ncols,nrows) = ', & +! iterr(1,1),iterr(ncols,nrows) + + close (11) + end subroutine rdterr + + subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncols ! number of column for 30-sec tile + integer, intent(in) :: nrows ! number of rows for 30-sec tile + integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile + integer, intent(in) :: nodata ! integer for ocean data point + real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile + real(r8),intent(in) :: dx ! spacing interval for 30-sec data (in degree) + integer*2, dimension(ncols,nrows), intent(out) :: terr_tile ! terrain data for 30-sec tile + integer*1, dimension(ncols,nrows), intent(out) :: land_fraction_tile +! +! Local variables +! + real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell + real(r8) :: wt ! area weighting of each 30-sec cell + real(r8) :: wt_tot ! total weighting of each 30-sec cell + real(r8) :: sumterr ! summation of terrain height of each 30-sec cell + real(r8) :: sumsea ! summation of sea coverage of each 30-sec cell + real(r8) :: pi ! pi=3.1415 + real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile + integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces + integer :: i,j,ii,jj ! index + logical, dimension(ncols,nrows) :: oflag + + pi = 4.0 * atan(1.0) +! + n1 = ncols / ncols + print*,'ncols,ncols,n1 = ',ncols,ncols,n1 + + itmp = nint( ulymap + 0.5 * dx ) + latul = itmp + print*,'ulymap,latul = ', ulymap,latul + oflag = .false. + + do j = 1, nrows + j1 = j + j2 = j + do i = 1, ncols + i1 = i + i2 = i + terr_tile(i,j) = 0 + land_fraction_tile(i,j) = 1 + if ( iterr(i,j) == nodata ) then + land_fraction_tile(i,j) = 0 + else + if ( iterr(i,j) .lt.nodata ) then + ! this can only happen in the expand_sea routine + land_fraction_tile(i,j) = 0 + iterr(i,j) = iterr(i,j) - nodata - nodata + endif + terr_tile(i,j) = iterr(i,j) + end if + end do + end do + + end subroutine avg + + subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine reduces the resolution of the terrain data from 30-sec to 30-sec and +! compute the percentage of ocean cover (psea10m) +! + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncols ! number of column for 30-sec tile + integer, intent(in) :: nrows ! number of rows for 30-sec tile + integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile + integer, intent(in) :: nodata ! integer for ocean data point + integer, intent(in) :: startx, starty ! where to begin the sea +! +! Local variables +! + real(r8):: maxh + integer :: i,j,per,ii,jj ! index + logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile + logical :: found + + flag = .false. + + maxh = iterr(startx,starty) + + iterr(startx,starty) = iterr(startx,starty) + nodata + nodata + flag(startx-1:startx+1,starty-1:starty+1) = .true. + + per = 0 + print *, 'expanding sea at ',maxh,' m ' + +2112 per = per + 1 + found = .false. + do j = starty - per, starty + per, per*2 + do i = startx - per, startx + per + if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then + if( iterr(i,j).eq.maxh .and. flag(i,j) ) then + iterr(i,j) = iterr(i,j) + nodata + nodata + flag(i-1:i+1,j-1:j+1) = .true. + found = .true. + endif + endif + end do + end do + + do i = startx - per, startx + per, per*2 + do j = starty - per + 1, starty + per - 1 + if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then + if( iterr(i,j).eq.maxh .and. flag(i,j) ) then + iterr(i,j) = iterr(i,j) + nodata + nodata + flag(i-1:i+1,j-1:j+1) = .true. + found = .true. + endif + endif + end do + end do + if (found)goto 2112 + print *, 'done with expand_sea' + return + + end subroutine expand_sea + + subroutine fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine put 30-sec tile into the global dataset +! + implicit none +! +! Dummy arguments +! + integer, intent(in) :: ncols ! number of columns for 30-sec tile + integer, intent(in) :: nrows ! number of rows for 30-sec tile + integer*2, dimension(ncols,nrows), intent(in) :: terr_tile ! terrain data for 30-sec tile + integer*1, dimension(ncols,nrows), intent(in) :: land_fraction_tile + integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile + ! in the global grid + integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset + integer*2,dimension(im,jm), intent(out) :: terr ! global 30-sec terrain data + integer*1,dimension(im,jm), intent(out) :: land_fraction ! global 30-sec land fraction +! +! Local variables +! + integer :: i,j,ii,jj ! index + + do j = 1, nrows + jj = j1 + (nrows - j) + do i = 1, ncols + ii = i1 + (i-1) + + if( i == 1 .and. j == 1 ) & + print*,'i,j,ii,jj = ',i,j,ii,jj + if( i == ncols .and. j == nrows ) & + print*,'i,j,ii,jj = ',i,j,ii,jj + + if( ii > im ) ii = ii - im + terr(ii,jj) = terr_tile(i,j) + land_fraction(ii,jj) = land_fraction_tile(i,j) + end do + end do + end subroutine fitin + + subroutine wrtncdf(im,jm,terr,land_fraction,dx) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine save 30-sec terrain data, land fraction to NetCDF file +! + implicit none + +# include + +! +! Dummy arguments +! + integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset + integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data + integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction + real(r8), intent(in) :: dx +! +! Local variables +! + real(r8),dimension(im) :: lonar ! longitude array + real(r8),dimension(im) :: latar ! latitude array + character (len=32) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: htopoid + integer :: landfid + integer, dimension(2) :: htopodim,landfdim + integer :: status ! return value for error control of netcdf routin + integer :: i,j + character (len=8) :: datestring + + integer*2,dimension(im,jm) :: h ! global 30-sec terrain data + integer*1,dimension(im,jm) :: lnd + + +! +! Fill lat and lon arrays +! + do i = 1,im + lonar(i)= dx * (i-0.5) + enddo + do j = 1,jm + latar(j)= -90.0 + dx * (j-0.5) + enddo + + do j=1,jm + do i=1,im + h(i,j) = terr(i,j) + lnd(i,j) = land_fraction(i,j) + end do + end do + + fout='usgs-rawdata.nc' +! +! Create NetCDF file for output +! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create dimensions for output +! + print *,"Create dimensions for output" + status = nf_def_dim (foutid, 'lon', im, lonid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'lat', jm, latid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create variable for output +! + print *,"Create variable for output" + htopodim(1)=lonid + htopodim(2)=latid + status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) + if (status .ne. NF_NOERR) call handle_err(status) +! + landfdim(1)=lonid + landfdim(2)=latid + status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! Create attributes for output variables +! + status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') + if (status .ne. NF_NOERR) call handle_err(status) +! + status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') + if (status .ne. NF_NOERR) call handle_err(status) +! + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! End define mode for output file +! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Write variable for output +! + print*,"writing terrain data" + status = nf_put_var_int2 (foutid, htopoid, h) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" +! + status = nf_put_var_int1 (foutid, landfid, lnd) + if (status .ne. NF_NOERR) call handle_err(status) +! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, latar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lonar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" +! +! Close output file +! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + + end subroutine wrtncdf + + + ! + ! same as wrtncdf but the output is coarsened + ! + subroutine wrtncdf_coarse(im,jm,terr,land_fraction,dx,ic) + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! This subroutine save 30-sec terrain data, land fraction to NetCDF file +! + implicit none + +# include + +! +! Dummy arguments +! + integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset + integer, intent(in) :: ic ! coarsening factor + integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data + integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction + real(r8), intent(in) :: dx +! +! Local variables +! + real(r8),dimension(im/ic) :: lonar ! longitude array + real(r8),dimension(im/ic) :: latar ! latitude array + character (len=32) :: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: htopoid + integer :: landfid + integer, dimension(2) :: htopodim,landfdim + integer :: status ! return value for error control of netcdf routin + integer :: i,j + character (len=8) :: datestring + + integer*2,dimension(im/ic,jm/ic) :: h ! global 30-sec terrain data + integer*1,dimension(im/ic,jm/ic) :: lnd + + +! +! Fill lat and lon arrays +! + do i = 1,im/ic + lonar(i)= real(ic)*dx * (i-0.5) + enddo + do j = 1,jm/ic + latar(j)= -90.0 + real(ic)*dx * (j-0.5) + enddo + + do j=1,jm/ic + do i=1,im/ic + h(i,j) = terr(i*ic,j*ic) + lnd(i,j) = land_fraction(i*ic,j*ic) + end do + end do + + fout='usgs-lowres.nc' +! +! Create NetCDF file for output +! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create dimensions for output +! + print *,"Create dimensions for output" + status = nf_def_dim (foutid, 'lon', im/ic, lonid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'lat', jm/ic, latid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Create variable for output +! + print *,"Create variable for output" + htopodim(1)=lonid + htopodim(2)=latid + status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) + if (status .ne. NF_NOERR) call handle_err(status) +! + landfdim(1)=lonid + landfdim(2)=latid + status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! Create attributes for output variables +! + status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') + if (status .ne. NF_NOERR) call handle_err(status) +! + status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') + if (status .ne. NF_NOERR) call handle_err(status) +! + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + +! +! End define mode for output file +! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +! +! Write variable for output +! + print*,"writing terrain data" + status = nf_put_var_int2 (foutid, htopoid, h) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" +! + status = nf_put_var_int1 (foutid, landfid, lnd) + if (status .ne. NF_NOERR) call handle_err(status) +! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, latar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lonar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" +! +! Close output file +! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + + end subroutine wrtncdf_coarse +!************************************************************************ +!!handle_err +!************************************************************************ +! +!!ROUTINE: handle_err +!!DESCRIPTION: error handler +!-------------------------------------------------------------------------- + + subroutine handle_err(status) + + implicit none + +# include + + integer status + + if (status .ne. nf_noerr) then + print *, nf_strerror(status) + stop 'Stopped' + endif + + end subroutine handle_err + + + diff --git a/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 b/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 new file mode 100644 index 0000000000..fc1ed8e94a --- /dev/null +++ b/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 @@ -0,0 +1,20 @@ +!=============================================================================== +! CVS: $Id$ +! CVS: $Source$ +! CVS: $Name$ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + +END MODULE shr_kind_mod